From 12bc57e143a66f865b37e33fae5647c636ade3a7 Mon Sep 17 00:00:00 2001 From: Jeremiah Orians Date: Sun, 30 Oct 2016 20:11:27 -0400 Subject: [PATCH] Added Codewords to forth assembly primatives --- stage2/forth.s | 244 ++++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 209 insertions(+), 35 deletions(-) diff --git a/stage2/forth.s b/stage2/forth.s index 3cd3d60..080e19a 100644 --- a/stage2/forth.s +++ b/stage2/forth.s @@ -17,18 +17,31 @@ ;; Forth LATEST (Pointer to last defined function) [R9] ;; Forth HERE (Pointer to next free byte in HEAP) [R8] ;; IO source [R7] + ;; + ;; Constants to make note of: + ;; F_IMMED 0x2 + ;; F_HIDDEN 0x1 + ;; + ;; Modes to make note of: + ;; COMPILING 0x1 + ;; INTERPRETING 0x0 ;; Start function ;; Loads contents of tape_01 ;; Starts interface until Halted :start - LOADR R14 @PARAMETER_BASE ; Load Base of Parameter Stack LOADR R15 @RETURN_BASE ; Load Base of Return Stack + LOADR R14 @PARAMETER_BASE ; Load Base of Parameter Stack LOADUI R11 $NEXT ; Get Address of Next - LOADUI R8 $HEAP ; Get Address of HEAP - LOADUI R9 $Interpret_Entry ; Get Address of last defined function - CALLI R15 @cold_start - HALT + FALSE R10 ; Current state is Interpreting + LOADUI R9 $CR_Entry ; Get Address of last defined function +# LOADUI R8 $HEAP ; Get Address of HEAP +# LOADUI R0 0x1100 ; Need number to engage tape_01 +# FOPEN_READ ; Load Tape_01 for Reading + MOVE R7 R0 ; Make Tape_01 Default IO + LOADUI R13 $Quit_Code ; Intialize via QUIT + JSR_COROUTINE R11 ; NEXT + HALT ; If anything ever returns to here HALT :RETURN_BASE '00040000' @@ -56,7 +69,7 @@ ;; Jumps to NEXT :DOCOL PUSHR R13 R15 ; Push NEXT onto Return Stack - ADDUI R13 R12 4 ; Update NEXT to point to the instruction after itself + ADDUI R13 R13 4 ; Update NEXT to point to the instruction after itself JUMP @NEXT ; Use NEXT ;; Some Forth primatives @@ -68,6 +81,8 @@ NOP ; No previous link elements &Drop_Text ; Pointer to Name NOP ; Flags + &Drop_Code ; Where assembly is Stored +:Drop_Code POPR R0 R14 ; Drop Top of stack JSR_COROUTINE R11 ; NEXT @@ -78,6 +93,8 @@ &Drop_Entry ; Pointer to Drop &Swap_Text ; Pointer to Name NOP ; Flags + &Swap_Code ; Where assembly is Stored +:Swap_Code POPR R0 R14 POPR R1 R14 PUSHR R0 R14 @@ -91,6 +108,8 @@ &Swap_Entry ; Pointer to Swap &Dup_Text ; Pointer to Name NOP ; Flags + &Dup_Code ; Where assembly is Stored +:Dup_Code LOAD R0 R14 0 ; Get top of stack PUSHR R0 R14 ; Push copy onto it JSR_COROUTINE R11 ; NEXT @@ -102,6 +121,8 @@ &Dup_Entry ; Pointer to DUP &Over_Text ; Pointer to Name NOP ; Flags + &Over_Code ; Where assembly is Stored +:Over_Code LOAD R0 R14 -4 ; Get second from Top of stack PUSHR R0 R14 ; Push it onto top of stack JSR_COROUTINE R11 ; NEXT @@ -113,6 +134,8 @@ &Over_Entry ; Pointer to Over &Rot_Text ; Pointer to Name NOP ; Flags + &Rot_Code ; Where assembly is Stored +:Rot_Code POPR R0 R14 POPR R1 R14 POPR R2 R14 @@ -128,6 +151,8 @@ &Rot_Entry ; Pointer to ROT &-Rot_Text ; Pointer to Name NOP ; Flags + &-Rot_Code ; Where assembly is Stored +:-Rot_Code POPR R0 R14 POPR R1 R14 POPR R2 R14 @@ -143,6 +168,8 @@ &-Rot_Entry ; Pointer to -ROT &2Drop_Text ; Pointer to Name NOP ; Flags + &2Drop_Code ; Where assembly is Stored +:2Drop_Code POPR R0 R14 POPR R0 R14 JSR_COROUTINE R11 ; NEXT @@ -154,6 +181,8 @@ &2Drop_Entry ; Pointer to 2Drop &2Dup_Text ; Pointer to Name NOP ; Flags + &2Dup_Code ; Where assembly is Stored +:2Dup_Code LOAD R0 R14 0 ; Get top of stack LOAD R1 R14 -4 ; Get second on stack PUSHR R1 R14 @@ -167,6 +196,8 @@ &2Dup_Entry ; Pointer to 2Dup &2Swap_Text ; Pointer to Name NOP ; Flags + &2Swap_Code ; Where assembly is Stored +:2Swap_Code POPR R0 R14 POPR R1 R14 POPR R2 R14 @@ -185,6 +216,8 @@ &2Swap_Entry ; Pointer to 2Swap &QDup_Text ; Pointer to Name NOP ; Flags + &QDup_Code ; Where assembly is Stored +:QDup_Code LOAD R0 R14 0 ; Get Top of stack CMPSKIPI.E R0 0 ; Skip if Zero PUSHR R0 R14 ; Duplicate value @@ -197,6 +230,8 @@ &QDup_Entry ; Pointer to ?Dup &Add_Text ; Pointer to Name NOP ; Flags + &Add_Code ; Where assembly is Stored +:Add_Code POPR R0 R14 ; Get top of stack POPR R1 R14 ; Get second item on Stack ADD R0 R0 R1 ; Perform the addition @@ -210,6 +245,8 @@ &Add_Entry ; Pointer to + &Sub_Text ; Pointer to Name NOP ; Flags + &Sub_Code ; Where assembly is Stored +:Sub_Code POPR R0 R14 ; Get top of stack POPR R1 R14 ; Get second item on Stack SUB R0 R0 R1 ; Perform the subtraction @@ -223,6 +260,8 @@ &Sub_Entry ; Pointer to - &MUL_Text ; Pointer to Name NOP ; Flags + &MUL_Code ; Where assembly is Stored +:MUL_Code POPR R0 R14 ; Get top of stack POPR R1 R14 ; Get second item on Stack MUL R0 R0 R1 ; Perform the multiplication and keep bottom half @@ -236,6 +275,8 @@ &MUL_Entry ; Pointer to * &MULH_Text ; Pointer to Name NOP ; Flags + &MULH_Code ; Where assembly is Stored +:MULH_Code POPR R0 R14 ; Get top of stack POPR R1 R14 ; Get second item on Stack MULH R0 R0 R1 ; Perform multiplcation and keep top half @@ -249,6 +290,8 @@ &MULH_Entry ; Pointer to MULH &DIV_Text ; Pointer to Name NOP ; Flags + &DIV_Code ; Where assembly is Stored +:DIV_Code POPR R0 R14 ; Get top of stack POPR R1 R14 ; Get second item on Stack DIV R0 R0 R1 ; Perform division and keep top half @@ -262,6 +305,8 @@ &DIV_Entry ; Pointer to / &MOD_Text ; Pointer to Name NOP ; Flags + &MOD_Code ; Where assembly is Stored +:MOD_Code POPR R0 R14 ; Get top of stack POPR R1 R14 ; Get second item on Stack MOD R0 R0 R1 ; Perform division and keep remainder @@ -275,6 +320,8 @@ &MOD_Entry ; Pointer to % &Equal_Text ; Pointer to Name NOP ; Flags + &Equal_Code ; Where assembly is Stored +:Equal_Code POPR R1 R14 ; Get top of stack POPR R2 R14 ; Get second item on Stack FALSE R0 ; Assume comparision is True @@ -290,6 +337,8 @@ &Equal_Entry ; Pointer to = &NEqual_Text ; Pointer to Name NOP ; Flags + &NEqual_Code ; Where assembly is Stored +:NEqual_Code POPR R1 R14 ; Get top of stack POPR R2 R14 ; Get second item on Stack FALSE R0 ; Assume comparision is True @@ -305,6 +354,8 @@ &NEqual_Entry ; Pointer to != &Less_Text ; Pointer to Name NOP ; Flags + &Less_Code ; Where assembly is Stored +:Less_Code POPR R1 R14 ; Get top of stack POPR R2 R14 ; Get second item on Stack FALSE R0 ; Assume comparision is True @@ -320,6 +371,8 @@ &Less_Entry ; Pointer to < &LEqual_Text ; Pointer to Name NOP ; Flags + &LEqual_Code ; Where assembly is Stored +:LEqual_Code POPR R1 R14 ; Get top of stack POPR R2 R14 ; Get second item on Stack FALSE R0 ; Assume comparision is True @@ -335,6 +388,8 @@ &LEqual_Entry ; Pointer to <= &Greater_Text ; Pointer to Name NOP ; Flags + &Greater_Code ; Where assembly is Stored +:Greater_Code POPR R1 R14 ; Get top of stack POPR R2 R14 ; Get second item on Stack FALSE R0 ; Assume comparision is True @@ -350,6 +405,8 @@ &Greater_Entry ; Pointer to > &GEqual_Text ; Pointer to Name NOP ; Flags + &GEqual_Code ; Where assembly is Stored +:GEqual_Code POPR R1 R14 ; Get top of stack POPR R2 R14 ; Get second item on Stack FALSE R0 ; Assume comparision is True @@ -365,6 +422,8 @@ &GEqual_Entry ; Pointer to >= &AND_Text ; Pointer to Name NOP ; Flags + &AND_Code ; Where assembly is Stored +:AND_Code POPR R0 R14 ; Get top of stack POPR R1 R14 ; Get second item on Stack AND R0 R0 R1 ; Perform AND @@ -378,6 +437,8 @@ &AND_Entry ; Pointer to AND &OR_Text ; Pointer to Name NOP ; Flags + &OR_Code ; Where assembly is Stored +:OR_Code POPR R0 R14 ; Get top of stack POPR R1 R14 ; Get second item on Stack OR R0 R0 R1 ; Perform OR @@ -391,6 +452,8 @@ &OR_Entry ; Pointer to OR &XOR_Text ; Pointer to Name NOP ; Flags + &XOR_Code ; Where assembly is Stored +:XOR_Code POPR R0 R14 ; Get top of stack POPR R1 R14 ; Get second item on Stack XOR R0 R0 R1 ; Perform XOR @@ -404,6 +467,8 @@ &XOR_Entry ; Pointer to XOR &NOT_Text ; Pointer to Name NOP ; Flags + &NOT_Code ; Where assembly is Stored +:NOT_Code POPR R0 R14 ; Get top of stack NOT R0 R0 ; Bit flip it PUSHR R0 R14 ; Store it back onto stack @@ -416,6 +481,8 @@ &NOT_Entry ; Pointer to NOT &LIT_Text ; Pointer to Name NOP ; Flags + &LIT_Code ; Where assembly is Stored +:LIT_Code LOAD R0 R13 0 ; Get contents of NEXT ADDUI R13 R13 4 ; Increment NEXT PUSHR R0 R14 ; Put immediate onto stack @@ -430,6 +497,8 @@ &LIT_Entry ; Pointer to LIT &Store_Text ; Pointer to Name NOP ; Flags + &Store_Code ; Where assembly is Stored +:Store_Code POPR R0 R14 ; Destination POPR R1 R14 ; Contents STORE R1 R0 0 ; Write out @@ -442,6 +511,8 @@ &Store_Entry ; Pointer to Store &Fetch_Text ; Pointer to Name NOP ; Flags + &Fetch_Code ; Where assembly is Stored +:Fetch_Code POPR R0 R14 ; Source address LOAD R0 R0 0 ; Get Contents PUSHR R0 R14 ; Push Contents @@ -454,6 +525,8 @@ &Fetch_Entry ; Pointer to Fetch &AStore_Text ; Pointer to Name NOP ; Flags + &AStore_Code ; Where assembly is Stored +:AStore_Code POPR R0 R14 ; Destination POPR R1 R14 ; How much to add LOAD R2 R0 0 ; Get contents of address @@ -468,6 +541,8 @@ &AStore_Entry ; Pointer to ADDSTORE &SStore_Text ; Pointer to Name NOP ; Flags + &SStore_Code ; Where assembly is Stored +:SStore_Code POPR R0 R14 ; Destination POPR R1 R14 ; How much to sub LOAD R2 R0 0 ; Get contents of address @@ -482,6 +557,8 @@ &SStore_Entry ; Pointer to SUBSTORE &SByte_Text ; Pointer to Name NOP ; Flags + &SByte_Code ; Where assembly is Stored +:SByte_Code POPR R0 R14 ; Destination POPR R1 R14 ; Contents STORE8 R1 R0 0 ; Write out @@ -494,6 +571,8 @@ &SByte_Entry ; Pointer to STOREBYTE &FByte_Text ; Pointer to Name NOP ; Flags + &FByte_Code ; Where assembly is Stored +:FByte_Code POPR R0 R14 ; Source address LOADU8 R0 R0 0 ; Get Contents PUSHR R0 R14 ; Push Contents @@ -506,6 +585,8 @@ &FByte_Entry ; Pointer to FETCHBYTE &CMove_Text ; Pointer to Name NOP ; Flags + &CMove_Code ; Where assembly is Stored +:CMove_Code POPR R0 R14 ; Get number of bytes to Move POPR R1 R14 ; Where to put the result POPR R2 R14 ; Where it is coming from @@ -545,6 +626,8 @@ &CMove_Entry ; Pointer to CMOVE &State_Text ; Pointer to Name NOP ; Flags + &State_Code ; Where assembly is Stored +:State_Code PUSHR R10 R14 ; Put STATE onto stack JSR_COROUTINE R11 ; NEXT @@ -555,6 +638,8 @@ &State_Entry ; Pointer to STATE &Latest_Text ; Pointer to Name NOP ; Flags + &Latest_Code ; Where assembly is Stored +:Latest_Code PUSHR R9 R14 ; Put LATEST onto stack JSR_COROUTINE R11 ; NEXT @@ -565,6 +650,8 @@ &Latest_Entry ; Pointer to LATEST &Here_Text ; Pointer to Name NOP ; Flags + &Here_Code ; Where assembly is Stored +:Here_Code PUSHR R8 R14 ; Put HERE onto stack JSR_COROUTINE R11 ; NEXT @@ -577,6 +664,8 @@ &Here_Entry ; Pointer to HERE &TOR_Text ; Pointer to Name NOP ; Flags + &TOR_Code ; Where assembly is Stored +:TOR_Code POPR R0 R14 ; Get top of Parameter stack PUSHR R0 R15 ; Shove it onto return stack JSR_COROUTINE R11 ; NEXT @@ -588,6 +677,8 @@ &TOR_Entry ; Pointer to >R &FROMR_Text ; Pointer to Name NOP ; Flags + &FROMR_Code ; Where assembly is Stored +:FROMR_Code POPR R0 R15 ; Get top of Return stack PUSHR R0 R14 ; Shove it onto parameter stack JSR_COROUTINE R11 ; NEXT @@ -599,6 +690,8 @@ &FROMR_Entry ; Pointer to R> &RSPFetch_Text ; Pointer to Name NOP ; Flags + &RSPFetch_Code ; Where assembly is Stored +:RSPFetch_Code PUSHR R14 R15 ; Push Return stack pointer onto Parameter stack JSR_COROUTINE R11 ; NEXT @@ -609,15 +702,18 @@ &RSPFetch_Entry ; Pointer to RSP@ &RSPStore_Text ; Pointer to Name NOP ; Flags + &RSPStore_Code ; Where assembly is Stored +:RSPStore_Code POPR R15 R14 ; Replace Return stack pointer from parameter stack JSR_COROUTINE R11 ; NEXT +;; Clear out the return stack :RETURN_CLEAR LOADR R1 @RETURN_BASE ; Get Base of Return Stack CMPJUMPI.LE R15 R1 @RETURN_Done ; If Return stack is empty skip clearing :Clear_Return - POPRR R0 R15 ; Remove entry from Return Stack + POPR R0 R15 ; Remove entry from Return Stack CMPSKIP.LE R15 R1 ; While Return stack isn't empty JUMP @Clear_Return ; Keep looping to clear it out :RETURN_Done @@ -632,6 +728,8 @@ &RSPStore_Entry ; Pointer to RSP! &DSPFetch_Text ; Pointer to Name NOP ; Flags + &DSPFetch_Code ; Where assembly is Stored +:DSPFetch_Code PUSHR R14 R14 ; Push current parameter pointer onto parameter stack JSR_COROUTINE R11 ; NEXT @@ -642,6 +740,8 @@ &DSPFetch_Entry ; Pointer to DSP@ &DSPStore_Text ; Pointer to Name NOP ; Flags + &DSPStore_Code ; Where assembly is Stored +:DSPStore_Code POPR R14 R14 ; Replace parameter stack pointer from parameter stack JSR_COROUTINE R11 ; NEXT @@ -654,6 +754,8 @@ &DSPStore_Entry ; Pointer to DSP! &Key_Text ; Pointer to Name NOP ; Flags + &Key_Code ; Where assembly is Stored +:Key_Code COPY R1 R7 ; Using designated IO FGETC ; Get a byte PUSHR R0 R14 ; And push it onto the stack @@ -666,7 +768,10 @@ &Key_Entry ; Pointer to Key &Emit_Text ; Pointer to Name NOP ; Flags + &Emit_Code ; Where assembly is Stored +:Emit_Code POPR R0 R14 ; Get value off the parameter stack + ANDI R0 R0 0xFF ; Ensure only bottom Byte COPY R1 R7 ; Using designated IO FPUTC ; Write out the byte JSR_COROUTINE R11 ; NEXT @@ -678,6 +783,8 @@ &Emit_Entry ; Pointer to Emit &Word_Text ; Pointer to Name NOP ; Flags + &Word_Code ; Where assembly is Stored +:Word_Code CALLI R15 @Word_Direct ; Trick for direct calls JSR_COROUTINE R11 ; NEXT @@ -687,6 +794,7 @@ :Word_Start FGETC ; Read a byte + CMPSKIPI.NE R1 0 ; Don't output unless TTY FPUTC ; Make it visible CMPSKIPI.NE R0 9 ; If Tab JUMP @Word_Start ; Get another byte @@ -701,6 +809,9 @@ CMPSKIPI.NE R0 9 ; If Tab JUMP @Word_Done ; Be done + CMPSKIPI.NE R0 10 ; If LF + JUMP @Word_Done ; Be done + CMPSKIPI.NE R0 32 ; If space JUMP @Word_Done ; Be done @@ -710,6 +821,9 @@ STOREX8 R0 R8 R2 ; Store byte onto HEAP ADDUI R2 R2 1 ; Increment index FGETC ; Read a byte + CMPSKIPI.NE R0 13 ; IF CR + LOADUI R0 10 ; Convert to LF + CMPSKIPI.NE R1 0 ; Don't output unless TTY FPUTC ; Make it visible JUMP @Word_Main ; Keep looping @@ -717,6 +831,7 @@ FGETC ; Get another byte CMPSKIPI.NE R0 13 ; If CR LOADUI R0 10 ; Convert to LF + CMPSKIPI.NE R1 0 ; Don't output unless TTY FPUTC ; Make it visible CMPSKIPI.NE R0 4 ; IF EOF JUMP @Word_Done ; Be done @@ -739,6 +854,8 @@ &Word_Entry ; Pointer to Word &Number_Text ; Pointer to Name NOP ; Flags + &Number_Code ; Where assembly is Stored +:Number_Code CALLI R15 @Number_Direct ; Trick for direct access JSR_COROUTINE R11 ; NEXT @@ -811,6 +928,8 @@ &Number_Entry ; Pointer to NUMBER &Strcmp_Text ; Pointer to Name NOP ; Flags + &Strcmp_Code ; Where assembly is Stored +:Strcmp_Code CALLI R15 @Strcmp_Direct ; Trick to allow direct calls JSR_COROUTINE R11 ; NEXT :Strcmp_Direct @@ -834,6 +953,8 @@ &Strcmp_Entry ; Pointer to STRCMP &Find_Text ; Pointer to Name NOP ; Flags + &Find_Code ; Where assembly is Stored +:Find_Code CALLI R15 @Find_Direct ; Allow Direct access JSR_COROUTINE R11 ; NEXT @@ -866,6 +987,8 @@ &Find_Entry ; Pointer to Find &TCFA_Text ; Pointer to Name NOP ; Flags + &TCFA_Code ; Where assembly is Stored +:TCFA_Code POPR R0 R14 ; Get Node pointer ADDUI R0 R0 12 ; Move to CFA PUSHR R0 R14 ; Push the result @@ -878,6 +1001,8 @@ &TCFA_Entry ; Pointer to >CFA &TDFA_Text ; Pointer to Name NOP ; Flags + &TDFA_Code ; Where assembly is Stored +:TDFA_Code POPR R0 R14 ; Get Node pointer ADDUI R0 R0 16 ; Move to DFA PUSHR R0 R14 ; Push the result @@ -890,6 +1015,8 @@ &TDFA_Entry ; Pointer to >DFA &Create_Text ; Pointer to Name NOP ; Flags + &Create_Code ; Where assembly is Stored +:Create_Code COPY R0 R8 ; Preserve HERE for next LATEST PUSHR R9 R8 ; Store LATEST onto HEAP POPR R1 R14 ; Get pointer to string @@ -901,26 +1028,26 @@ ;; DEFINE :Define_Text -"DEFINE" +":" :Define_Entry &Create_Entry ; Pointer to Create &Define_Text ; Pointer to Name NOP ; Flags + &Define_Code ; Where assembly is Stored +:Define_Code CALLI R15 @Word_Direct ; Get Word COPY R0 R8 ; Preserve HERE for next LATEST PUSHR R9 R8 ; Store LATEST onto HEAP + POPR R1 R14 ; Get rid of string length POPR R1 R14 ; Get pointer to string PUSHR R1 R8 ; Store string pointer onto HEAP - TRUE R1 ; Prepare HIDDEN for Flag + LOADUI R1 1 ; Prepare HIDDEN for Flag PUSHR R1 R8 ; Push HIDDEN Flag - LOADR R1 @Define_DOCOL ; Get address of DOCOL + LOADUI R1 $DOCOL ; Get address of DOCOL PUSHR R1 R8 ; Push DOCOL Address onto HEAP MOVE R9 R0 ; Set LATEST LOADUI R10 1 ; Set STATE to Compile Mode - LOADUI R0 $EXIT ; Load pointer to EXIT - JSR_COROUTINE R0 ; EXIT -:Define_DOCOL - &DOCOL ; Store the address of DOCOL + JSR_COROUTINE R11 ; NEXT ;; COMA :Comma_Text @@ -929,6 +1056,8 @@ &Define_Entry ; Pointer to DEFINE &Comma_Text ; Pointer to Name NOP ; Flags + &Comma_Code ; Where assembly is Stored +:Comma_Code POPR R0 R14 ; Get top of parameter stack PUSHR R0 R8 ; Push onto HEAP and increment HEAP pointer JSR_COROUTINE R11 ; NEXT @@ -939,7 +1068,9 @@ :LBRAC_Entry &Comma_Entry ; Pointer to Comma &LBRAC_Text ; Pointer to Name - NOP ; Flags + '00000002' ; Flags [F_IMMED] + &LBRAC_Code ; Where assembly is Stored +:LBRAC_Code FALSE R10 ; Set STATE to Interpret Mode JSR_COROUTINE R11 ; NEXT @@ -950,6 +1081,8 @@ &LBRAC_Entry ; Pointer to LBRAC &RBRAC_Text ; Pointer to Name NOP ; Flags + &RBRACK_Code ; Where assembly is Stored +:RBRACK_Code LOADUI R10 1 ; Set State to Compile Mode JSR_COROUTINE R11 ; NEXT @@ -959,14 +1092,15 @@ :SEMICOLON_Entry &RBRACK_Entry ; Pointer to RBRAC &SEMICOLON_Text ; Pointer to Name - NOP ; Flags + '00000002' ; Flags [F_IMMED] + &SEMICOLON_Code ; Where assembly is Stored +:SEMICOLON_Code LOADUI R0 $EXIT ; Get EXIT Pointer PUSHR R0 R8 ; Push EXIT onto HEAP and increment HEAP pointer FALSE R0 ; Prep NULL for Flag STORE R0 R9 8 ; Set Flag FALSE R10 ; Set State to Interpret Mode - LOADUI R0 $EXIT ; Load pointer to EXIT - JSR_COROUTINE R0 ; EXIT + JSR_COROUTINE R11 ; NEXT ;; Branching @@ -977,6 +1111,7 @@ &SEMICOLON_Entry ; Pointer to Semicolon &Branch_Text ; Pointer to Name NOP ; Flags +:Branch_Code LOAD R0 R13 0 ; Get Contents of NEXT ADD R13 R13 R0 ; Update NEXT with offset JSR_COROUTINE R11 ; NEXT @@ -988,6 +1123,8 @@ &Branch_Entry ; Pointer to Branch &0Branch_Text ; Pointer to Name NOP ; Flags + &0Branch_Code ; Where assembly is Stored +:0Branch_Code POPR R1 R14 ; Get value off parameter stack LOADUI R0 4 ; Default offset of 4 CMPSKIPI.NE R1 0 ; If not Zero use default offset @@ -1005,9 +1142,12 @@ &Quit_Text ; Pointer to Name NOP ; Flags :Quit_Code + &DOCOL ; Use DOCOL &RETURN_CLEAR ; Clear the return stack &Interpret_Loop ; INTERPRET - &Quit_Code ; Loop forever + &Branch_Code ; Loop forever + 'FFFFFFF4' ; -12 + ;; INTERPRET :Interpret_Text @@ -1016,6 +1156,7 @@ &Quit_Entry ; Pointer to QUIT &Interpret_Text ; Pointer to Name NOP ; Flags + &Interpret_Loop ; Where assembly is Stored :Interpret_Loop CALLI R15 @Word_Direct ; Get the Word POPR R0 R14 ; Remove Length @@ -1025,30 +1166,63 @@ CALLI R15 @Find_Direct ; Try to Find it POPR R0 R14 ; Get result of Search JUMP.Z R0 @Interpret_Literal ; Since it wasn't found assume it is a literal - ADDUI R13 R0 12 ; Update NEXT Found Node - CALL R13 R15 ; Call function - JUMP @Interpret_Loop + +;; Found Node + LOAD R1 R0 8 ; Get Flags of found node + ANDI R1 R1 0x2 ; Check if F_IMMED is set + JUMP.Z R1 @Interpret_Compile ; Its not immediate so I might have to compile + +:Interpret_Execute + LOAD R0 R0 12 ; Update NEXT Found Node + JSR_COROUTINE R0 ; EXECUTE Directly + +:Interpret_Compile + ANDI R1 R10 1 ; Check if we are in compile mode + JUMP.Z R1 @Interpret_Execute ; If not execute the node + ADDUI R0 R0 12 ; Adjust pointer to body of Node + PUSHR R0 R8 ; Append to HEAP + JSR_COROUTINE R11 ; NEXT :Interpret_Literal CALLI R15 @Number_Direct ; Attempt to process string as number - JUMP @Interpret_Loop + ANDI R0 R10 1 ; Check if we are in compile mode + CMPSKIPI.NE R0 0 ; If not compiling + JSR_COROUTINE R11 ; Simply leave on stack and NEXT -;; Cold start function + LOADUI R0 $LIT_Entry ; Get address of LIT + ADDUI R0 R0 12 ; Adjust to point to direct code + PUSHR R0 R8 ; Append pointer to HEAP + POPR R0 R14 ; Get Immediate value + PUSHR R0 R8 ; Append Immediate to HEAP + JSR_COROUTINE R11 ; NEXT + +;; CR +:CR_Text +"CR" +:CR_Entry + &Interpret_Entry ; Pointer to INTERPRET + &CR_Text ; Pointer to Name + NOP ; Flags + &CR_Code ; Where assembly is Stored +:CR_Code + &DOCOL ; Use DOCOL + &LIT_Code ; Read next word + '0000000A' ; ASCII CHAR + &Emit_Code ; EMIT the CHAR + &EXIT ; EXIT + +;; Cold done function ;; Reads Tape_01 until EOF ;; Then switches into TTY Mode -:cold_start -;; Prep TAPE_01 - LOADUI R0 0x1100 - FOPEN_READ - MOVE R7 R0 - LOADUI R13 $Quit_Code - JSR_COROUTINE R11 ; NEXT - :cold_done + ;; IF TTY Recieves EOF call it quits + CMPSKIPI.NE R7 0 ; Check if TTY + HALT ; User is done + ;; Prep TTY - FALSE R7 - LOADUI R13 $Quit_Code - JSR_COROUTINE R11 ; NEXT + FALSE R7 ; Set TTY ID + LOADUI R13 $Quit_Code ; Prepare to return to QUIT LOOP + JSR_COROUTINE R11 ; NEXT ;; Where our HEAP Starts :HEAP