3-character language made for bracket challenge @12Me21 @ajc2

brak.PRG

DIM STACK0[0],STACK1[0]
DIM STACK2[0],STACK3[0]
DIM STACK4[0],STACK5[0]
DIM STACK6[0],STACK7[0]
DIM STACK8[0]
'Registers
VAR r0%, r1%, r2%, r3%, r4%, r5%, r6%
VAR r7% 'pc
VAR NUMERIC% 'special fake register for numeric literals
VAR CYCLES%
VAR len% 'program length
VAR A$ 'input temporary
VAR A% 'compare temporary
VAR SF%,ZF%

'menu
VAR INTERACTIVE
IF PROGRAM$ == "" THEN
  INTERACTIVE = TRUE
  VAR INS$, CMD$
  ?
  ?"BRAK INTERFACE"
  ?"--------------"
  ?"Type ";:COLOR #TCYAN ?"?";:COLOR #TWHITE?" for help"
  WHILE TRUE
    COLOR #TGREEN
    ?">";
    COLOR #TCYAN
    LINPUT INS$
    COLOR #TWHITE
    CMD$ = TOLOWER$(TRIMSPC$(INS$))
    INS$ = MID$(CMD$,0,INSTR(CMD$+" "," "))

    IF INS$ == "?" || INS$ == "help" THEN
      ?"help         - display this info"    ?"               alias: ?"
      ?"load <file>  - run program from file"?"               alias: run, exec, ."
      ?"input        - enter and run program"?"               alias: >"
      ?"zorak <file> - run zorak on file"    ?"               alias: edit"
      ?"quit         - exit this program"    ?"               alias: exit, q" 
    ELSEIF INS$ == "input" || INS$ == ">" THEN
      LINPUT PROGRAM$
      GOSUB @EXECUTE
    ELSEIF INS$ == "load" || INS$ == "run" || INS$ == "exec" || INS$ == "." THEN
      FILENAME$ = "TXT:" + RIGHT$(CMD$,LEN(CMD$) - LEN(INS$) - 1)
      LOAD FILENAME$, 0 OUT PROGRAM$
      GOSUB @EXECUTE
    ELSEIF INS$ == "quit" || INS$ == "exit" || INS$ == "q" THEN
      END
    ENDIF
    PROGRAM$ = ""
  WEND
ENDIF

DEF TOLOWER$(S$)
  VAR I%,LET%
  FOR I%=LEN(S$)-1 TO 0 STEP -1
    LET%=ASC(S$[I%])
    IF LET% >= 65 && LET% <= 90 THEN S$[I%] = CHR$(LET%+32)
  NEXT
  RETURN S$
END
DEF TRIMSPC$(S$)
  VAR I% = 0
  WHILE I% < LEN(S$) && S$[I%] == " "
    S$[I%] = ""
    INC I%
  WEND
  I% = LEN(S$) -1
  WHILE I% > 0 && S$[I%] == " "
    S$[I%] = ""
    DEC I%
  WEND
  RETURN S$
END

@EXECUTE
'trim invalid characters
I% = 0
WHILE I% < LEN(PROGRAM$)
  WHILE I% < LEN(PROGRAM$) && PROGRAM$[I%] != "[" && PROGRAM$[I%] != "]" && PROGRAM$[I%] != "="
    PROGRAM$[I%] = ""
  WEND
INC I%
WEND

len% = Len(Program$)
IF len% MOD 2 != 0 THEN ABORT "Uneven instruction count; Check input"
'FINALLY
r7% = 0 'offset instruction increment
WHILE r7% < len% - 3
  'jumping to negative indexes execute system calls
  IF r7% < -2 THEN IF !syscall(r7%) THEN ABORT "Jump out of bounds"
  IF r7% MOD 2 != 0 THEN ABORT "Address unaligned"

  IF CYCLES% > 0 THEN INC r7%, 2 'do this after checks

  INSN$ = PROGRAM$[r7%] + PROGRAM$[r7%+1]
  IF INSN$ == "==" THEN
    'get arguments
    INC r7%, 2
    A% = VAR(GET_ARG())
    INC r7%, 2
    'do comparison
    A% = A% - VAR(GET_ARG())
    SF% = A% < 0
    ZF% = A% == 0
  ELSEIF INSN$ == "=[" THEN
    'manipulated register
    INC r7%, 2
    A$ = GET_ARG()
    'decrement by
    INC r7%, 2
    DEC VAR(A$), VAR(GET_ARG())
  ELSEIF INSN$ == "=]" THEN
    'manipulated register
    INC r7%, 2
    A$ = GET_ARG()
    'increment by
    INC r7%, 2
    INC VAR(A$), VAR(GET_ARG())
  ELSEIF INSN$ == "[=" THEN
    DO_JUMP 1
  ELSEIF INSN$ == "]=" THEN
    'doesn't work
    DO_JUMP -1
  ELSEIF INSN$ == "[[" THEN
    'get stack id
    INC r7%, 2
    A% = PARSENUMBER(MID$(PROGRAM$,r7%,2))
    'push specified register
    INC r7%, 2
    PUSH VAR("STACK"+STR$(A%)), VAR(GET_ARG())
  ELSEIF INSN$ == "]]" THEN
    'get stack id
    INC r7%, 2
    A% = PARSENUMBER(MID$(PROGRAM$,r7%,2))
    'check its length
    IF LEN(VAR("STACK"+STR$(A%))) < 1 THEN ABORT "Stack (" + STR$(A%) + ") underflow"
    'pop value into specified register
    INC r7%, 2
    VAR(GET_ARG()) = POP(VAR("STACK"+STR$(A%)))
  ELSEIF INSN$ == "[]" THEN
    INPUT A$
    r0% = ASC(A$)
  ELSEIF INSN$ == "][" THEN
    PRINT CHR$(r0%);
  ENDIF

  INC CYCLES%
  IF BUTTON() AND #B THEN ABORT "User break"
WEND
'reached end of program
IF !INTERACTIVE THEN END
PRINT
PRINT "DONE"
RETURN 'to menu

'SYSCALL
'various system routines
'take input from stack 1
'puts output on stack 1
'return address on stack 0
DEF SYSCALL(code%)
  IF code% >= 0 THEN
    ABORT "Bad system call " + STR$(code%)
  ELSEIF code% == -3 THEN
    'CharToDigit
    PUSH STACK1,POP(STACK1)-48
    r7% = POP(STACK0)
    RETURN 1
  ELSEIF code% == -5 THEN
    'DigitToChar
    PUSH STACK1,POP(STACK1)+48
    r7% = POP(STACK0)
    RETURN 1
  ELSEIF code% == -8 THEN
    'Sign Flip
    PUSH STACK1, 0 - POP(STACK1)
    r7% = POP(STACK0)
    RETURN 1
  ELSEIF code% == -9 THEN
    'Abs
    PUSH STACK1,ABS(POP(STACK1))
    r7% = POP(STACK0)
    RETURN 1
  ELSEIF code% == -11 THEN
    'Multiply
    PUSH STACK1, POP(STACK1) * POP(STACK1)
    r7% = POP(STACK0)
    RETURN 1
  ELSEIF code% == -13 THEN
    'Division
    PUSH STACK1, POP(STACK1) DIV POP(STACK1)
    r7% = POP(STACK0)
    RETURN 1
  ELSEIF code% == -15 THEN
    'Modulo
    PUSH STACK1, POP(STACK1) MOD POP(STACK1)
    r7% = POP(STACK0)
    RETURN 1
  ELSEIF code% == -23 THEN
    'NumberToString
    VALUE$ = STR$(POP(STACK1))
    PUSH STACK1, 0
    WHILE VALUE$>"" PUSH STACK1,ASC(POP(VALUE$)) WEND
    r7% = POP(STACK0)
    RETURN 1
  ENDIF

  RETURN 0 'undefined code, probably a bad jump
END

DEF GET_ARG()
  VAR register%, register$
  register% = PARSENUMBER(MID$(PROGRAM$,r7%,2))
  IF register% == 8 THEN
    INC r7%, 2
    'special numeric immediate
    NUMERIC% = READNUMBER()
    RETURN "NUMERIC%"
  ENDIF
  register$ = "r"+STR$(register%)+"%"
  IF !CHKVAR(register$) THEN ABORT "Internal error: register"
  RETURN register$
END

'perform relative jump
DEF DO_JUMP direction%
  VAR L%, ofs%, register$
  INC r7%, 2
  VAR condition$ = PROGRAM$[r7%] + PROGRAM$[r7%+1]

  INC r7%, 2
  register$ = GET_ARG()
  'multiply offset if an immediate value
  ofs% = VAR(register$)
  IF register$ == "NUMERIC%" THEN ofs% = ofs% * 2
  
  'jump if zero
  IF condition$ == "==" THEN
    IF ZF% THEN
      r7% = r7% + ofs% * direction%
    ELSE
      INC r7%, L%
    ENDIF
  'jump if not zero
  ELSEIF condition$ == "=[" THEN
    IF !ZF% THEN
      r7% = r7% + ofs% * direction%
    ELSE
      INC r7%, L%
    ENDIF
  'jump if sign   
  ELSEIF condition$ == "[=" THEN
    IF SF% THEN
      r7% = r7% + ofs% * direction%
    ELSE
      INC r7%, L%
    ENDIF
  'jump if not sign
  ELSEIF condition$ == "[[" THEN
    IF !SF% THEN
      r7% = r7% + ofs% * direction%
    ELSE
      INC r7%, L%
    ENDIF
  'jump always
  ELSEIF condition$ == "=]" THEN
    r7% = r7% + ofs% * direction%
  'CALL
  ELSEIF condition$ == "]=" THEN
    PUSH STACK0, r7% + L%
    'this is messy but what isn't
    'syscalls need to be exact but
    'real addresses will be messed up by pc inc
    IF ofs% >=0 THEN ofs% = ofs - 2
    r7% = ofs%
  ELSE
    ABORT "Bad jump condition " + condition$
  ENDIF

END

'PARSENUMBER including length
DEF READNUMBER()
  VAR L%, N%
  L% = PARSENUMBER(MID$(PROGRAM$, r7%, 2)) * 2
  INC r7%, 2
  N% = PARSENUMBER(MID$(PROGRAM$, r7%, L%))
  INC r7%, L% - 2 'need to account for step
  RETURN N%
END

DEF PARSENUMBER(trinary$)
  VAR I% = LEN(trinary$), A% = 0, D$ = "=[]"
  
  WHILE I% > 0
    'IF I% >= LEN(trinary$) THEN ABORT "Malformed number " + trinary$

    INC A%, INSTR(D$, trinary$[LEN(trinary$) - I%]) * POW(3,I% - 1)
    DEC I%
  WEND
  RETURN A%
END

DEF ABORT msg$
  PRINT
  PRINT "Error: " + msg$ + " @" + Str$(r7%)
  IF r7% >= 0 && r7% < LEN(PROGRAM$) - 1 THEN
    IF r7% > 1 THEN  ?MID$(PROGRAM$,r7%-2,2);
    COLOR #TRED      ?MID$(PROGRAM$,r7%,  2);
    COLOR #TWHITE    ?MID$(PROGRAM$,r7%+2,2)
  ENDIF 
  PRINT "r0: " + STR$(r0%),"","r4: " + STR$(r4%)
  PRINT "r1: " + STR$(r1%),"","r5: " + STR$(r5%)
  PRINT "r2: " + STR$(r2%),"","r6: " + STR$(r6%)
  PRINT "r3: " + STR$(r3%),"","pc: " + STR$(r7%)
  PRINT "NUMERICREG: ",NUMERIC%
  PRINT
    INPUT "Print Stack? (#) ",ANS%
    IF ANS% <= 8 && ANS% >= 0 THEN
      VAR I%, TEMP$
      FOR I% = LEN(VAR("STACK" + STR$(ANS%))) - 1 TO 0 STEP -1
        PRINT FORMAT$("%02D : % 2D", I%, VAR("STACK"+STR$(I%))[I%])
        IF I% && I% MOD 39 == 0 THEN INPUT "-- Press Enter to continue --",TEMP$
      NEXT
    ENDIF
  PRINT
  STOP
END

REM * instruction guide
REM == | cmp <reg1> <reg2>
REM =[ | dec <reg1> <reg2>
REM =] | inc <reg1> <reg2>
REM [= | positive jmp (see jump syntax)
REM ]= | negative jmp
REM [[ | push <stack id> <reg>
REM ]] | pop <stack id> <reg>
REM [] | input (ascii, to r0%)
REM ][ | output (ascii, to r0%)

REM * stack specification
REM trinary value corresponding to stack 0-8

REM * register specification
REM 2-symbol trinary value
REM r0 ==; r1 =[; r2 =]; r3 [=; r4 [[; r5 []; r6 ]=
REM ][ - pc/r7 is program counter
REM ]] - special numeric immediate register

REM * trinary values
REM = | 0
REM [ | 1
REM ] | 2

REM * numeric immediate
REM <length/2> <trinary string>

REM * lengths
REM specifies # digits for argument
REM 2-trit value
REM CAUTION! this is the length divided by 2

REM * jump syntax 
REM <[= or ]=> <condition> <reg>
REM REGISTER offsets will not be multiplied by 2
REM IMMEDIATE VALUE offsets will be * 2
REM Note: all offsets start from the end of the
REM   jump arguments, thus both + and - 0 jump
REM   proceeds with next instruction.
REM   be careful when writing negative jumps!
REM * jump conditions
REM == | JZ
REM =[ | JNZ
REM [= | JS
REM [[ | JNS
REM =] | JMP (unconditional)
REM ]= | CALL (unconditional, push pc)

REM * examples
REM ]= =] ]] =[ =[       ; jmp -2
REM ]=                   ; negative jump
REM =]                   ; unconditional
REM ]]                   ; numeric immediate "register"
REM =[                   ; length 1 * 2
REM =[                   ; 01 (* 2)

REM [= =[ ==             ;(jnz+ r0)
REM [=                   ;positive jump
REM =[                   ;jump if zero flag not set
REM ==                   ;to address specified by r0

REM [= == ]] ]] ]]]]]]]] ; (jz+ 13120)
REM [=                   ; positive jump
REM ==                   ; jump if zero flag set
REM ]]                   ; numeric immediate
REM [[                   ; length 4 * 2
REM ]]]]]]]]             ; 6560 (* 2)

;' output robust sum of two (single-digit) numbers
[]                  ;' input
=] =[ ==            ;' inc r1, r0
[]                  ;' input
=] == =[            ;' inc r0, r1
=[ == ]] [= =[=[]=  ;' dec r0, #96
[[ =[ ==            ;' push s1, r0
=[ == ==            ;' dec r0, r0
=[ == ]] =] =][]    ;' dec r0, 23
]= ]= ==            ;' call r0 (STR$)

]] =[ ==            ;' pop s1, r0
== == ]] ==         ;' cmp r0, #0
][                  ;' output
]= =[ ]] =] =[[]    ;' jnz- 14