~~~ c ============================================================ c Poraka BASIC Interpreter c for the ilo virtual computer c ============================================================ c ------------------------------------------------------------ c ENTRY POINT c ilo begins execution at address 0. c ------------------------------------------------------------ : start i lica.... r init c top of the read-eval-print loop: read lines until BYE/EOF : repl i lica.... r load-program i liju.... r repl c ------------------------------------------------------------ c INITIALISATION c Called once at startup. Clears the program buffer and c zeroes all 26 BASIC variables (A-Z), then displays the c banner. c ------------------------------------------------------------ : init i lica.... r clear-program i lica.... r clear-variables i liju.... r startup-message : startup-message i lili.... r StartupTitle r StringPtr i stlica.. r print-string i lica.... r newline c ProgramBufferEnd - ProgramWrite is the remaining source c capacity. i lilifesu r ProgramBufferEnd r ProgramWrite i listlica r NumberTemp r print-number i lilist.. r StartupFree r StringPtr i lica.... r print-string i lica.... r newline i lilist.. r StartupReady r StringPtr i lica.... r print-string i liju.... r newline c ------------------------------------------------------------ c CLEAR VARIABLES c Writes 0 into each of the 26 variable cells (A-Z). c Uses ClearPtr (write cursor) and ClearCount (countdown). c ------------------------------------------------------------ : clear-variables c set ClearPtr = start of Variables array; ClearCount = 26 i lilist.. r Variables r ClearPtr i lilist.. d 26 r ClearCount : clear-variables-loop c loop while ClearCount > 0 i lifeligt r ClearCount d 0 i licj.... r clear-variables-body i re...... : clear-variables-body c write 0 to memory[ClearPtr] c ClearPtr += 1 c ClearCount -= 1; loop i lilifest d 0 r ClearPtr i lifeliad r ClearPtr d 1 i listlife r ClearPtr r ClearCount i lisuli.. d 1 r ClearCount i stliju.. r clear-variables-loop c ------------------------------------------------------------ c CLEAR PROGRAM c Resets program storage to empty: c ProgramWrite <- start of ProgramBuffer c LineCount, CurrentIndex, EofFlag <- 0 c ------------------------------------------------------------ : clear-program i lilistli r ProgramBuffer r ProgramWrite d 0 i listlili r LineCount d 0 r CurrentIndex i stlilist d 0 r EofFlag i re...... c ------------------------------------------------------------ c HALT c I/O device 6 terminates execution. c ------------------------------------------------------------ : halt i liio.... d 6 c ------------------------------------------------------------ c LOAD PROGRAM (interactive line handler / REPL body) c c Reads one line. Dispatches on the first character: c EOF -> halt c empty line -> ignore c 'B' -> BYE: halt c 'N' -> NEW: clear program, loop c 'R' -> RUN: execute program, loop c 'L''I' -> LIST: display stored program lines c 'S' -> SAVE : write a five-block program c image c 'L''O' -> LOAD : restore a five-block program c image c digit -> numbered line: store it c other -> display an error c ------------------------------------------------------------ : load-program : lp-loop i lica.... r read-line c halt on EOF i life.... r EofFlag i lieqlicj d -1 r halt c point SrcPtr at InputBuffer and skip leading spaces i lilist.. r InputBuffer r SrcPtr i lica.... r skip-spaces c load TempChar = first non-space character i lifefeli r SrcPtr r TempChar i st...... c empty line (null terminator): loop i lifelieq r TempChar d 0 i licj.... r lp-loop c check for BYE ('B' = 66) i lica.... r is-bye-command i life.... r ByeFlag i lieqlicj d -1 r halt c check for NEW ('N' = 78) i lica.... r is-new-command i life.... r NewFlag i lieqlicj d -1 r lp-new c check for RUN ('R' = 82) i lica.... r is-run-command i lifelieq r RunFlag d -1 i licj.... r lp-run c check for LIST i lica.... r is-list-command i lifelieq r ListFlag d -1 i licj.... r lp-list c check for SAVED (must precede SAVE) i lica.... r is-saved-command i lifelieq r SavedFlag d -1 i licj.... r lp-saved c check for SAVE i lica.... r is-save-command i lifelieq r SaveFlag d -1 i licj.... r lp-save c check for LOAD i lica.... r is-load-command i lifelieq r LoadFlag d -1 i licj.... r lp-load c check for ERASE i lica.... r is-erase-command i lifelieq r EraseFlag d -1 i licj.... r lp-erase c ignore if first char is not a decimal digit ('0'=48 .. '9'=57) i lifelilt r TempChar d 48 i licj.... r error-unknown-command i lifeligt r TempChar d 57 i licj.... r error-unknown-command c store numbered program line then loop i lica.... r store-line i liju.... r lp-loop : lp-new i lica.... r clear-program i liju.... r lp-loop : lp-run c clear variables then execute; return brings us back to repl i lica.... r clear-variables i liju.... r execute-program : lp-list i lica.... r list-program i liju.... r lp-loop : lp-save i lica.... r save-program i liju.... r lp-loop : lp-saved i lica.... r list-saved-programs i liju.... r lp-loop : lp-load i lica.... r load-saved-program i liju.... r lp-loop : lp-erase i lica.... r erase-saved-program i liju.... r lp-loop c ------------------------------------------------------------ c COMMAND RECOGNISERS c Each clears its flag, then recognizes the required leading c characters at SrcPtr. c A matching command sets its flag to -1 (true); otherwise it c remains 0 (false). c c is-run-command -> RunFlag ('R' = 82) c is-new-command -> NewFlag ('N' = 78) c is-bye-command -> ByeFlag ('B' = 66) c ------------------------------------------------------------ : is-run-command c RunFlag = 0 (default false) i lilistli d 0 r RunFlag r SrcPtr i fefelieq d 82 i licj.... r ir-match i re...... : ir-match c RunFlag = -1 (true), return i lilistre d -1 r RunFlag : is-new-command i lilistli d 0 r NewFlag r SrcPtr i fefelieq d 78 i licj.... r in-match i re...... : in-match i lilistre d -1 r NewFlag : is-bye-command i lilistli d 0 r ByeFlag r SrcPtr i fefelieq d 66 i licj.... r ib-match i re...... : ib-match i lilistre d -1 r ByeFlag c LIST and LOAD share their first letter, so inspect the second. : is-list-command i lilistli d 0 r ListFlag r SrcPtr i fefelieq d 76 i licj.... r il-second i re...... : il-second i lifeliad r SrcPtr d 1 i felieqli d 73 r il-match i cj...... i re...... : il-match i lilistre d -1 r ListFlag : is-save-command i lilistli d 0 r SaveFlag r SrcPtr i fefelieq d 83 i licj.... r isa-match i re...... : isa-match i lilistre d -1 r SaveFlag c SAVED must be recognized before SAVE, since both start with S. : is-saved-command i lilistli d 0 r SavedFlag r SrcPtr i fefelieq d 83 i licj.... r isav-a i re...... : isav-a i lifeliad r SrcPtr d 1 i felieqli d 65 r isav-v i cj...... i re...... : isav-v i lifeliad r SrcPtr d 2 i felieqli d 86 r isav-e i cj...... i re...... : isav-e i lifeliad r SrcPtr d 3 i felieqli d 69 r isav-d i cj...... i re...... : isav-d i lifeliad r SrcPtr d 4 i felieqli d 68 r isav-match i cj...... i re...... : isav-match i lilistre d -1 r SavedFlag : is-erase-command i lilistli d 0 r EraseFlag r SrcPtr i fefelieq d 69 i licj.... r ier-match i re...... : ier-match i lilistre d -1 r EraseFlag : is-load-command i lilistli d 0 r LoadFlag r SrcPtr i fefelieq d 76 i licj.... r ilo-second i re...... : ilo-second i lifeliad r SrcPtr d 1 i felieqli d 79 r ilo-match i cj...... i re...... : ilo-match i lilistre d -1 r LoadFlag c ------------------------------------------------------------ c READ LINE c Reads characters from stdin (device 1) into InputBuffer, c stopping at LF (10), CR (13), or EOF (-1). c Sets EofFlag = -1 if EOF arrives on an otherwise empty line. c Null-terminates the buffer and leaves InputPtr past the end. c ------------------------------------------------------------ : read-line c InputPtr = start of InputBuffer; ReadLen = 0; EofFlag = 0 i lilistli r InputBuffer r InputPtr d 0 i listlili r ReadLen d 0 r EofFlag i st...... : rl-loop c read one character from stdin c test for EOF (-1) i liioduli d 1 d -1 i eqlicj.. r rl-eof c test for LF (10) i dulieqli d 10 r rl-finish i cj...... c test for CR (13) i dulieqli d 13 r rl-finish i cj...... c store character at InputPtr; advance InputPtr; increment c ReadLen i lifestli r InputPtr r InputPtr i feliadli d 1 r InputPtr i stlifeli r ReadLen d 1 i adlist.. r ReadLen i liju.... r rl-loop : rl-eof c EOF on empty buffer -> set EofFlag; else treat as end of line i lifelieq r ReadLen d 0 i licj.... r rl-set-eof i liju.... r rl-finish : rl-set-eof i lilist.. d -1 r EofFlag : rl-finish c drop the delimiter still on the stack; write null terminator i drlilife d 0 r InputPtr i stre.... c ------------------------------------------------------------ c STORE LINE c Parses the leading line number, then either overwrites the c existing entry for that number or appends a new one. c c Parallel arrays: c LineNumbers[i] -- integer line number for slot i c LineAddrs[i] -- address of that line's text in c ProgramBuffer c The text is a null-terminated copy of the raw input line c (including the line-number digits). c ------------------------------------------------------------ : store-line c parse leading line number -> ParseResult; save as TargetLine i lili.... r InputBuffer r SrcPtr i stlica.. r parse-number i lifeli.. r ParseResult r TargetLine i stlica.. r find-line c A bare line number deletes that line, as in traditional BASIC. i lica.... r skip-spaces i lifefeli r SrcPtr r TempChar i stlifeli r TempChar d 0 i eqlicj.. r sl-delete c Check entry and source capacity before altering line metadata c or text. i lica.... r check-line-storage i lifelieq r StorageError d 0 i licj.... r sl-storage-ok i re...... : sl-storage-ok c if line already exists overwrite its slot, otherwise append i lifelieq r FoundFlag d 0 i licj.... r sl-new c overwrite: aim ProgramWrite at the existing slot's address c cell i lifelife r ProgramWrite r FoundIndex i liadst.. r LineAddrs i liju.... r sl-copy-setup : sl-delete c A missing line is already absent. Mark a match as deleted; its c source c space remains available only after NEW, but LIST and RUN skip c the entry. i lifelieq r FoundFlag d 0 i licj.... r sl-delete-done i lilifeli d -1 r FoundIndex r LineNumbers i adst.... : sl-delete-done i re...... : sl-new c append: record line number in LineNumbers[LineCount] c record text address in LineAddrs[LineCount] i lifelife r TargetLine r LineCount i liadstli r LineNumbers r ProgramWrite i felifeli r LineCount r LineAddrs i adst.... : sl-copy-setup c DstPtr = current ProgramWrite; SrcPtr = start of InputBuffer i lifelist r ProgramWrite r DstPtr i lilist.. r InputBuffer r SrcPtr : sl-copy c copy one character; advance both pointers; stop at null i lifefeli r SrcPtr r TempChar i stlifeli r TempChar r DstPtr i festlife r SrcPtr i liadlist d 1 r SrcPtr i lifeliad r DstPtr d 1 i listlife r DstPtr r TempChar i lieqlicj d 0 r sl-done i liju.... r sl-copy : sl-done c advance ProgramWrite to one past the null terminator (= c DstPtr) c bump LineCount only for newly appended lines i lifelist r DstPtr r ProgramWrite i lifelieq r FoundFlag d 0 i licj.... r sl-bump-count i re...... : sl-bump-count i lifeliad r LineCount d 1 i listre.. r LineCount c Check the 512-entry line index and the 30,720-cell source c buffer. c ReadLen excludes the null terminator, which must also fit. : check-line-storage c Replacements reuse an existing index entry; new entries do c not. i lilistli d 0 r StorageError r FoundFlag i felieqli d 0 r cls-new-entry i cj...... i liju.... r cls-source-space : cls-new-entry i lifelilt r LineCount d 512 i licj.... r cls-source-space i lica.... r error-too-many-lines i re...... : cls-source-space c RequiredEnd = ProgramWrite + ReadLen + 1. i lifelife r ProgramWrite r ReadLen i adliadli d 1 r RequiredEnd i stlilife r ProgramBufferEnd r RequiredEnd i ltlicj.. r cls-out-of-space i re...... : cls-out-of-space i liju.... r error-out-of-program-space c ------------------------------------------------------------ c EXECUTE PROGRAM c Walks stored lines in index order (not sorted by line c number). c For each line: consume the line-number prefix, then dispatch c on the first keyword character. c c Dispatch table (ASCII value of first letter): c P (80) -- PRINT c L (76) -- LET c I (73) -- IF or INPUT (second char disambiguates) c G (71) -- GOTO or GOSUB c O (79) -- ON ... GOTO or ON ... GOSUB c R (82) -- READ, REM, RESTORE, or RETURN c D (68) -- DATA (inert during execution) c E (69) -- END c ------------------------------------------------------------ : execute-program i lilistli d 0 r CurrentIndex d 0 i listlili r ErrorCode d 0 r ErrorLine i stlilist d 0 r ForDepth i lilistli d 0 r GosubDepth d 0 i listlili r DataIndex d 0 r DataActive i st...... : ep-loop c Stop a RUN after a parser or statement error has been c reported. i lifelieq r ErrorCode d 0 i licj.... r ep-continue i re...... : ep-continue c stop when CurrentIndex >= LineCount i lifelife r CurrentIndex r LineCount i ltlicj.. r ep-body i re...... : ep-body c Ignore source slots deleted by a bare line-number entry. i lifeliad r CurrentIndex r LineNumbers i felieqli d -1 r ep-deleted i cj...... c Record the BASIC line number for diagnostics raised by this c statement. c SrcPtr = text of line at CurrentIndex i lifeliad r CurrentIndex r LineNumbers i felistli r ErrorLine r CurrentIndex i feliadfe r LineAddrs i li...... r SrcPtr i stlica.. r parse-number i lica.... r skip-spaces c fetch first keyword character into TempChar c dispatch on first keyword character i lifefeli r SrcPtr r TempChar i stlifeli r TempChar d 80 i eqlicj.. r stmt-print i lifelieq r TempChar d 76 i licj.... r stmt-let i lifelieq r TempChar d 73 i licj.... r stmt-i i lifelieq r TempChar d 71 i licj.... r stmt-g i lifelieq r TempChar d 79 i licj.... r stmt-on i lifelieq r TempChar d 68 i licj.... r stmt-data i lifelieq r TempChar d 70 i licj.... r stmt-for i lifelieq r TempChar d 78 i licj.... r stmt-next i lifelieq r TempChar d 82 i licj.... r stmt-r i lifelieq r TempChar d 69 i licj.... r stmt-end c unrecognised keyword i lica.... r error-syntax i liju.... r ep-loop : ep-deleted i lica.... r next-line i liju.... r ep-loop c ------------------------------------------------------------ c STMT-I -- disambiguate IF vs INPUT c Second character 'N' (78) -> INPUT; otherwise -> IF. c ------------------------------------------------------------ : stmt-i i lifeliad r SrcPtr d 1 i felieqli d 78 r stmt-input i cj...... i liju.... r stmt-if c ------------------------------------------------------------ c STMT-G -- disambiguate GOTO vs GOSUB. c A third character of S (83) selects GOSUB; other spellings c take the GOTO path. c ------------------------------------------------------------ : stmt-g i lifeliad r SrcPtr d 2 i felieqli d 83 r stmt-gosub i cj...... i liju.... r stmt-goto c ------------------------------------------------------------ c STMT-ON c Syntax: ON GOTO [,]... c ON GOSUB [,]... c The expression is a one-based selector. Zero, negative, and c out-of-range c selectors fall through to the next source line. Only the c selected target c is looked up; a missing selected target is an error. c ------------------------------------------------------------ : stmt-on c skip "ON" and evaluate the selector expression i lifeliad r SrcPtr d 2 i listlica r SrcPtr r parse-expression i lifelieq r ErrorCode d 0 i licj.... r on-selector-ok i liju.... r ep-loop : on-selector-ok i lifeli.. r ExprResult r OnSelector i stlica.. r skip-spaces c accept GOTO (third char T) or GOSUB (third char S) i lifeliad r SrcPtr d 2 i felieqli d 84 r on-goto-keyword i cj...... i lifeliad r SrcPtr d 2 i felieqli d 83 r on-gosub-keyword i cj...... i lica.... r error-syntax i liju.... r ep-loop : on-goto-keyword i lili.... d 0 r OnGosub i stliju.. r on-after-keyword : on-gosub-keyword i lilist.. d -1 r OnGosub : on-after-keyword c GOTO is four characters and GOSUB five; both have their first c four here. i lifeliad r SrcPtr d 4 i listlife r SrcPtr r OnGosub i lieqlicj d 0 r on-target-loop c consume the final B in GOSUB i lifeliad r SrcPtr d 1 i list.... r SrcPtr : on-target-loop i lica.... r parse-number i lifelieq r ErrorCode d 0 i licj.... r on-target-parsed i liju.... r ep-loop : on-target-parsed c Each target consumes one selector position. Record only a c match. i lifelieq r OnSelector d 1 i licj.... r on-selected i lifelilt r OnSelector d 1 i licj.... r on-after-target i lifelisu r OnSelector d 1 i list.... r OnSelector : on-after-target i lica.... r skip-spaces i lifefeli r SrcPtr r TempChar i stlifeli r TempChar d 44 i eqlicj.. r on-more-targets c End of the list without a match falls through. i lifelieq r TempChar d 0 i licj.... r on-fall-through i lica.... r error-syntax i liju.... r ep-loop : on-more-targets i life.... r SrcPtr i liadli.. d 1 r SrcPtr i stliju.. r on-target-loop : on-selected i lifeli.. r ParseResult r TargetLine i stlica.. r find-line i lifelieq r FoundFlag d 0 i licj.... r on-not-found i lifelieq r OnGosub d 0 i licj.... r on-goto-selected i liju.... r on-gosub-selected : on-goto-selected i lifeli.. r FoundIndex r CurrentIndex i stliju.. r ep-loop : on-gosub-selected c Reuse GOSUB's fixed return stack discipline. i lifelilt r GosubDepth d 16 i licj.... r on-gosub-room i lica.... r error-syntax i liju.... r ep-loop : on-gosub-room i lifeliad r CurrentIndex d 1 i lifeliad r GosubDepth r GosubReturns i stlifeli r GosubDepth d 1 i adlistli r GosubDepth r FoundIndex i feli.... r CurrentIndex i stliju.. r ep-loop : on-not-found i lica.... r error-line-not-found i re...... : on-fall-through i lica.... r next-line i liju.... r ep-loop c ------------------------------------------------------------ c STMT-R -- disambiguate READ, REM, RESTORE, and RETURN. c Their third characters are A (65), M (77), S (83), and T c (84). c ------------------------------------------------------------ : stmt-r i lifeliad r SrcPtr d 2 i felieqli d 65 r stmt-read i cj...... i lifeliad r SrcPtr d 2 i felieqli d 83 r stmt-restore i cj...... i lifeliad r SrcPtr d 2 i felieqli d 84 r stmt-return i cj...... i liju.... r stmt-rem c ------------------------------------------------------------ c STMT-PRINT c Syntax: PRINT "string" or PRINT c Advances past the 5-char keyword, then checks for '"': c '"' -> print-string-stmt c else -> evaluate and print integer c A trailing ';' suppresses the newline. c ------------------------------------------------------------ : stmt-print c skip "PRINT" (5 chars) and any following spaces i life.... r SrcPtr i liadli.. d 5 r SrcPtr i stlica.. r skip-spaces c load next char to distinguish string vs numeric c '"' (34) -> string literal i lifefeli r SrcPtr r TempChar i stlifeli r TempChar d 34 i eqlicj.. r print-string-stmt c numeric expression: evaluate, print, newline i lica.... r parse-expression i lifelieq r ErrorCode d 0 i licj.... r print-expression-ok i liju.... r ep-loop : print-expression-ok i lifeli.. r ExprResult r NumberTemp i stlica.. r print-number i lica.... r print-line-end i lica.... r next-line i liju.... r ep-loop c ------------------------------------------------------------ c PRINT STRING STMT c Skip the opening '"', output characters until '"' or null. c ------------------------------------------------------------ : print-string-stmt c advance SrcPtr past opening quote i lifeliad r SrcPtr d 1 i list.... r SrcPtr : pss-loop c stop at closing '"' (34) or null terminator (0) i lifefeli r SrcPtr r TempChar i stlifeli r TempChar d 34 i eqlicj.. r pss-done i lifelieq r TempChar d 0 i licj.... r pss-unterminated c output character to device 0; advance SrcPtr i lifeliio r TempChar d 0 i lifeliad r SrcPtr d 1 i li...... r SrcPtr i stliju.. r pss-loop : pss-unterminated i lica.... r error-syntax i liju.... r ep-loop : pss-done c advance past closing quote, then handle newline suppression i life.... r SrcPtr i liadli.. d 1 r SrcPtr i stlica.. r print-line-end i lica.... r next-line i liju.... r ep-loop c ------------------------------------------------------------ c STMT-LET c Syntax: LET A = c Advances past "LET", reads the variable letter, skips '=', c evaluates the expression, stores into Variables[index]. c ------------------------------------------------------------ : validate-target-variable c TempChar must name one of the 26 single-letter variables A-Z. i lifelilt r TempChar d 65 i licj.... r vtv-bad i lifeligt r TempChar d 90 i licj.... r vtv-bad i re...... : vtv-bad i lica.... r error-bad-variable i re...... : stmt-let c skip "LET" (3 chars) and spaces i life.... r SrcPtr i liadli.. d 3 r SrcPtr i stlica.. r skip-spaces c read variable letter; TargetVar = letter - 'A' (0-based index) i lifefeli r SrcPtr r TempChar i stlica.. r validate-target-variable i lifelieq r ErrorCode d 0 i licj.... r let-variable-ok i liju.... r ep-loop : let-variable-ok c advance past variable letter and spaces to '=' i lifelisu r TempChar d 65 i listlife r TargetVar r SrcPtr i liadli.. d 1 r SrcPtr i stlica.. r skip-spaces c consume '=' (61) i lifefeli r SrcPtr r TempChar i stlifeli r TempChar d 61 i eqlicj.. r let-have-eq i lica.... r error-syntax i liju.... r ep-loop : let-have-eq i life.... r SrcPtr i liadli.. d 1 r SrcPtr i stlica.. r parse-expression i lifelieq r ErrorCode d 0 i licj.... r let-expression-ok i liju.... r ep-loop : let-expression-ok c store ExprResult into Variables[TargetVar] i lifelife r ExprResult r TargetVar i liad.... r Variables i stlica.. r next-line i liju.... r ep-loop c ------------------------------------------------------------ c STMT-INPUT c Syntax: INPUT A c Prints "? " prompt, reads a line, parses integer, stores c the result in the named variable. c ------------------------------------------------------------ : stmt-input c skip "INPUT" (5 chars) and spaces i life.... r SrcPtr i liadli.. d 5 r SrcPtr i stlica.. r skip-spaces c read variable letter; TargetVar = letter - 'A' i lifefeli r SrcPtr r TempChar i stlica.. r validate-target-variable i lifelieq r ErrorCode d 0 i licj.... r input-variable-ok i liju.... r ep-loop : input-variable-ok c print '?' (63) then space (32) c read input line and parse it as an integer i lifelisu r TempChar d 65 i listlili r TargetVar d 63 d 0 i ioliliio d 32 d 0 i lica.... r read-line i lili.... r InputBuffer r SrcPtr i stlica.. r parse-number i lifelieq r ErrorCode d 0 i licj.... r input-number-ok i liju.... r ep-loop : input-number-ok c store ParseResult into Variables[TargetVar] i lifelife r ParseResult r TargetVar i liad.... r Variables i stlica.. r next-line i liju.... r ep-loop c ------------------------------------------------------------ c STMT-READ / STMT-DATA / STMT-RESTORE c READ A[,B...] assigns numeric items from DATA lines in source c order. c DATA lines are inert when executed. RESTORE rewinds to the c first item. c ------------------------------------------------------------ : stmt-read c skip "READ" and parse one or more comma-separated variable c names i life.... r SrcPtr i liadli.. d 4 r ReadPtr i stliju.. r read-variable : read-variable i lifelist r ReadPtr r SrcPtr i lica.... r skip-spaces i lifefeli r SrcPtr r TempChar i stlica.. r validate-target-variable i lifelieq r ErrorCode d 0 i licj.... r read-variable-ok i liju.... r ep-loop : read-variable-ok i lifelisu r TempChar d 65 i listlife r TargetVar r SrcPtr i liadli.. d 1 r ReadPtr i stlica.. r read-data-item i lifelieq r ErrorCode d 0 i licj.... r read-item-ok i liju.... r ep-loop : read-item-ok c Resume the READ statement after the variable, then accept a c comma or end. i lifelife r ParseResult r TargetVar i liadstli r Variables r ReadPtr i feli.... r SrcPtr i stlica.. r skip-spaces i lifefeli r SrcPtr r TempChar i stlifeli r TempChar d 44 i eqlicj.. r read-more-variables i lifelieq r TempChar d 0 i licj.... r read-done i lica.... r error-syntax i liju.... r ep-loop : read-more-variables i life.... r SrcPtr i liadli.. d 1 r ReadPtr i stliju.. r read-variable : read-done i lica.... r next-line i liju.... r ep-loop : stmt-data c DATA is a source-only statement; values are consumed by READ. i lica.... r next-line i liju.... r ep-loop : stmt-restore c RESTORE currently accepts no line argument and rewinds all c DATA. i life.... r SrcPtr i liadli.. d 7 r SrcPtr i stlica.. r skip-spaces i lifefeli r SrcPtr r TempChar i stlifeli r TempChar d 0 i eqlicj.. r restore-done i lica.... r error-syntax i liju.... r ep-loop : restore-done i lili.... d 0 r DataIndex i stlili.. d 0 r DataActive i stlica.. r next-line i liju.... r ep-loop c Return one numeric DATA item in ParseResult. DataIndex c identifies the candidate source line and DstPtr identifies c the next item in that line. : read-data-item i lifelieq r DataActive d 0 i licj.... r read-find-data i liju.... r read-parse-data : read-find-data i lifelife r DataIndex r LineCount i ltlicj.. r read-check-line i lica.... r error-out-of-data i re...... : read-check-line c Skip deleted source slots. i lifeliad r DataIndex r LineNumbers i felieqli d -1 r read-next-candidate i cj...... c Read the first statement character after this line's number. i lifeliad r DataIndex r LineAddrs i feli.... r SrcPtr i stlica.. r parse-number i lica.... r skip-spaces i lifefeli r SrcPtr r TempChar i stlifeli r TempChar d 68 i eqlicj.. r read-data-line : read-next-candidate i life.... r DataIndex i liadli.. d 1 r DataIndex i stliju.. r read-find-data : read-data-line c Skip "DATA". The dispatcher uses the same lightweight keyword c convention. i lifeliad r SrcPtr d 4 i listlili r DstPtr d -1 r DataActive i st...... : read-parse-data i lifeli.. r DstPtr r SrcPtr i stlica.. r parse-number i lifelieq r ErrorCode d 0 i licj.... r read-data-number-ok i re...... : read-data-number-ok i lica.... r skip-spaces i lifefeli r SrcPtr r TempChar i stlifeli r TempChar d 44 i eqlicj.. r read-data-comma i lifelieq r TempChar d 0 i licj.... r read-data-line-done i lica.... r error-syntax i re...... : read-data-comma i lifeliad r SrcPtr d 1 i listre.. r DstPtr : read-data-line-done i lilistli d 0 r DataActive r DataIndex i feliadli d 1 r DataIndex i stre.... c ------------------------------------------------------------ c STMT-GOTO c Syntax: GOTO c Parses target line number, finds it, sets CurrentIndex. c Halts if the line is not found. c ------------------------------------------------------------ : stmt-goto c skip "GOTO" (4 chars) and spaces; parse line number i life.... r SrcPtr i liadli.. d 4 r SrcPtr i stlica.. r parse-number i lifelieq r ErrorCode d 0 i licj.... r goto-target-ok i liju.... r ep-loop : goto-target-ok i lifeli.. r ParseResult r TargetLine i stlica.. r find-line c report the missing target and end this RUN if it is not found i lifelieq r FoundFlag d 0 i licj.... r goto-not-found c jump: set CurrentIndex to the found index and re-enter loop i lifeli.. r FoundIndex r CurrentIndex i stliju.. r ep-loop : goto-not-found i liju.... r error-line-not-found c ------------------------------------------------------------ c STMT-GOSUB / STMT-RETURN c GOSUB stores the next line index in a fixed 16-entry return c stack, c then transfers to its target. RETURN resumes the most recent c caller. c ------------------------------------------------------------ : stmt-gosub c skip "GOSUB" (5 chars) and parse the target line number i life.... r SrcPtr i liadli.. d 5 r SrcPtr i stlica.. r parse-number i lifelieq r ErrorCode d 0 i licj.... r gosub-target-ok i liju.... r ep-loop : gosub-target-ok i lifeli.. r ParseResult r TargetLine i stlica.. r find-line i lifelieq r FoundFlag d 0 i licj.... r gosub-not-found c reject nesting beyond the fixed 16-entry return stack i lifelilt r GosubDepth d 16 i licj.... r gosub-room i lica.... r error-syntax i liju.... r ep-loop : gosub-room c Return index is the line immediately after this GOSUB. i lifeliad r CurrentIndex d 1 i lifeliad r GosubDepth r GosubReturns i stlifeli r GosubDepth d 1 i adlistli r GosubDepth r FoundIndex i feli.... r CurrentIndex i stliju.. r ep-loop : gosub-not-found i liju.... r error-line-not-found : stmt-return c RETURN without a matching GOSUB is a syntax error. i lifelieq r GosubDepth d 0 i licj.... r return-no-frame c Pop the return stack and resume the saved line index. i lifelisu r GosubDepth d 1 i listlife r GosubDepth r GosubDepth i liadfeli r GosubReturns r CurrentIndex i stliju.. r ep-loop : return-no-frame i lica.... r error-syntax i liju.... r ep-loop c ------------------------------------------------------------ c FOR / NEXT c FOR A = start TO limit [STEP increment] c NEXT [A] c Up to 16 nested loops are retained in parallel loop-frame c arrays. c ------------------------------------------------------------ : for-expect-to i lica.... r skip-spaces i lifefeli r SrcPtr d 84 i eqlicj.. r fet-second i lica.... r error-syntax i re...... : fet-second i lifeliad r SrcPtr d 1 i felieqli d 79 r fet-ok i cj...... i liju.... r error-syntax : fet-ok i lifeliad r SrcPtr d 2 i listre.. r SrcPtr : for-optional-step c Default step is +1; consume STEP when present. i lili.... d 1 r ForStepTemp i stlica.. r skip-spaces i lifefeli r SrcPtr d 83 i eqlicj.. r fos-step i re...... : fos-step i lifeliad r SrcPtr d 1 i felieqli d 84 r fos-e i cj...... i liju.... r error-syntax : fos-e i lifeliad r SrcPtr d 2 i felieqli d 69 r fos-p i cj...... i liju.... r error-syntax : fos-p i lifeliad r SrcPtr d 3 i felieqli d 80 r fos-parse i cj...... i lica.... r error-syntax i re...... : fos-parse i life.... r SrcPtr i liadli.. d 4 r SrcPtr i stlica.. r parse-expression i lifelieq r ErrorCode d 0 i licj.... r fos-value i re...... : fos-value i lifelist r ExprResult r ForStepTemp i lifelieq r ForStepTemp d 0 i licj.... r fos-zero i re...... : fos-zero i lica.... r error-syntax i re...... : stmt-for c Skip FOR and read its single-letter control variable. i life.... r SrcPtr i liadli.. d 3 r SrcPtr i stlica.. r skip-spaces i lifefeli r SrcPtr r TempChar i stlica.. r validate-target-variable i lifelieq r ErrorCode d 0 i licj.... r sf-var-ok i liju.... r ep-loop : sf-var-ok c Consume '=' then parse the starting expression. i lifelisu r TempChar d 65 i listlife r ForVarTemp r SrcPtr i liadli.. d 1 r SrcPtr i stlica.. r skip-spaces i lifefeli r SrcPtr r TempChar i stlifeli r TempChar d 61 i eqlicj.. r sf-equals-ok i lica.... r error-syntax i liju.... r ep-loop : sf-equals-ok i life.... r SrcPtr i liadli.. d 1 r SrcPtr i stlica.. r parse-expression i lifelieq r ErrorCode d 0 i licj.... r sf-start-ok i liju.... r ep-loop : sf-start-ok i lifeli.. r ExprResult r ForStartTemp i stlica.. r for-expect-to i lifelieq r ErrorCode d 0 i licj.... r sf-to-ok i liju.... r ep-loop : sf-to-ok i lica.... r parse-expression i lifelieq r ErrorCode d 0 i licj.... r sf-limit-ok i liju.... r ep-loop : sf-limit-ok i lifeli.. r ExprResult r ForLimitTemp i stlica.. r for-optional-step i lifelieq r ErrorCode d 0 i licj.... r sf-step-ok i liju.... r ep-loop : sf-step-ok c An initially out-of-range loop skips through its matching c NEXT. i lifeligt r ForStepTemp d 0 i licj.... r sf-positive-initial c Negative STEP: empty when start < limit. i lifelife r ForStartTemp r ForLimitTemp i ltlicj.. r sf-empty i liju.... r sf-room : sf-positive-initial c Positive STEP: empty when start > limit. i lifelife r ForStartTemp r ForLimitTemp i gtlicj.. r sf-empty i liju.... r sf-room : sf-empty c Find this FOR's matching NEXT, accounting for nested FORs. i lilistli d 0 r ForScanDepth r CurrentIndex i feliadli d 1 r SearchIndex i st...... : sfe-loop i lifelife r SearchIndex r LineCount i ltlicj.. r sfe-line i lica.... r error-syntax i liju.... r ep-loop : sfe-line c Ignore deleted line-table entries. i lifeliad r SearchIndex r LineNumbers i felieqli d -1 r sfe-advance i cj...... c Point SrcPtr at the first statement character after the line c number. i lifeliad r SearchIndex r LineAddrs i feli.... r SrcPtr i stlica.. r parse-number i lica.... r skip-spaces i lifefeli r SrcPtr r ForScanChar i stlifeli r ForScanChar d 70 i eqlicj.. r sfe-for i lifelieq r ForScanChar d 78 i licj.... r sfe-next i liju.... r sfe-advance : sfe-for i life.... r ForScanDepth i liadli.. d 1 r ForScanDepth i stliju.. r sfe-advance : sfe-next i lifelieq r ForScanDepth d 0 i licj.... r sfe-found i lifelisu r ForScanDepth d 1 i list.... r ForScanDepth : sfe-advance i life.... r SearchIndex i liadli.. d 1 r SearchIndex i stliju.. r sfe-loop : sfe-found i life.... r SearchIndex i liadli.. d 1 r CurrentIndex i stliju.. r ep-loop c Reject nesting beyond the fixed 16-frame loop stack. i lifelilt r ForDepth d 16 i licj.... r sf-room i lica.... r error-syntax i liju.... r ep-loop : sf-room c Set variable and frame fields at the current depth. i lifelife r ForStartTemp r ForVarTemp i liadstli r Variables r ForVarTemp i felifeli r ForDepth r ForVars i adstlife r ForLimitTemp i lifeliad r ForDepth r ForLimits i stlifeli r ForStepTemp r ForDepth i feliadst r ForSteps i lifeliad r CurrentIndex d 1 i lifeliad r ForDepth r ForResumes i stlifeli r ForDepth d 1 i adli.... r ForDepth i stlica.. r next-line i liju.... r ep-loop : stmt-next c NEXT may omit its variable name; when supplied it must match c the frame. i lifelieq r ForDepth d 0 i licj.... r sn-no-frame i lifelisu r ForDepth d 1 i listlife r LoopIndex r SrcPtr i liadli.. d 4 r SrcPtr i stlica.. r skip-spaces i lifefeli r SrcPtr r TempChar i stlifeli r TempChar d 0 i eqlicj.. r sn-variable-ok i lica.... r validate-target-variable i lifelieq r ErrorCode d 0 i licj.... r sn-check-variable i liju.... r ep-loop : sn-check-variable i lifelisu r TempChar d 65 i listlife r Temp r LoopIndex i liadfeli r ForVars r Temp i feeqlicj r sn-variable-ok i lica.... r error-syntax i liju.... r ep-loop : sn-variable-ok c Fetch the frame's variable and advance it by its STEP value. c Read the updated variable value and test the inclusive loop c bound. i lifeliad r LoopIndex r ForVars i felistli r ForVarTemp r ForVarTemp i feliadfe r Variables i lifeliad r LoopIndex r ForSteps i felistli r ForStepTemp r ForStepTemp i feadlife r ForVarTemp i liadstli r Variables r ForVarTemp i feliadfe r Variables i listlife r ForCurrentTemp r ForStepTemp i ligtlicj d 0 r sn-positive c Negative STEP: finish when value < limit. i lifelife r ForCurrentTemp r LoopIndex i liadfelt r ForLimits i licj.... r sn-finish i liju.... r sn-resume : sn-positive c Positive STEP: finish when value > limit. i lifelife r ForCurrentTemp r LoopIndex i liadfegt r ForLimits i licj.... r sn-finish : sn-resume i lifeliad r LoopIndex r ForResumes i feli.... r CurrentIndex i stliju.. r ep-loop : sn-finish i life.... r ForDepth i lisuli.. d 1 r ForDepth i stlica.. r next-line i liju.... r ep-loop : sn-no-frame i lica.... r error-syntax i liju.... r ep-loop c ------------------------------------------------------------ c STMT-IF c Syntax: IF [AND|OR ]* c followed by GOTO or THEN . c is one of: =, <, >, <=, >=, or <>. Conditions combine c left-to-right; both sides of AND and OR are evaluated. c ------------------------------------------------------------ : stmt-if c no condition has been accumulated yet c skip "IF" (2 chars); evaluate left expression i lilistli d 0 r IfHasResult r SrcPtr i feliadli d 2 r SrcPtr i stlica.. r parse-expression i lifelieq r ErrorCode d 0 i licj.... r if-left-ok i liju.... r ep-loop : if-left-ok i lifeli.. r ExprResult r LeftValue i stlica.. r skip-spaces c read the comparison operator character c Dispatch on the first comparison character. Compound operators c use c internal codes: <= is 1, >= is 2, and <> is 3. i lifefeli r SrcPtr r CompChar i stlifeli r CompChar d 61 i eqlicj.. r if-equal-operator i lifelieq r CompChar d 60 i licj.... r if-less-operator i lifelieq r CompChar d 62 i licj.... r if-greater-operator i lica.... r error-syntax i liju.... r ep-loop : if-equal-operator c '=' is always a one-character operator. i life.... r SrcPtr i liadli.. d 1 r SrcPtr i stliju.. r if-parse-right : if-less-operator c '<=' and '<>' consume two characters; '<' consumes one. i lifeliad r SrcPtr d 1 i felieqli d 61 r if-less-equal-operator i cj...... i lifeliad r SrcPtr d 1 i felieqli d 62 r if-not-equal-operator i cj...... i liju.... r if-single-operator : if-greater-operator c '>=' consumes two characters; '>' consumes one. i lifeliad r SrcPtr d 1 i felieqli d 61 r if-greater-equal-operator i cj...... i liju.... r if-single-operator : if-less-equal-operator i lili.... d 1 r CompChar i stliju.. r if-compound-operator : if-greater-equal-operator i lili.... d 2 r CompChar i stliju.. r if-compound-operator : if-not-equal-operator i lili.... d 3 r CompChar i stliju.. r if-compound-operator : if-single-operator i life.... r SrcPtr i liadli.. d 1 r SrcPtr i stliju.. r if-parse-right : if-compound-operator i lifeliad r SrcPtr d 2 i list.... r SrcPtr : if-parse-right i lica.... r parse-expression i lifelieq r ErrorCode d 0 i licj.... r if-right-ok i liju.... r ep-loop : if-right-ok c dispatch on operator character i lifelist r ExprResult r RightValue i lifelieq r CompChar d 61 i licj.... r if-eq i lifelieq r CompChar d 60 i licj.... r if-lt i lifelieq r CompChar d 62 i licj.... r if-gt i lifelieq r CompChar d 1 i licj.... r if-le i lifelieq r CompChar d 2 i licj.... r if-ge i liju.... r if-ne : if-eq i lifelife r LeftValue r RightValue i eq...... i liju.... r if-after-compare : if-lt i lifelife r LeftValue r RightValue i lt...... i liju.... r if-after-compare : if-gt i lifelife r LeftValue r RightValue i gt...... i liju.... r if-after-compare : if-le c left <= right is the inverse of right < left. i lifelife r RightValue r LeftValue i ltli.... d 0 i eqliju.. r if-after-compare : if-ge c left >= right is the inverse of right > left. i lifelife r RightValue r LeftValue i gtli.... d 0 i eqliju.. r if-after-compare : if-ne i lifelife r LeftValue r RightValue i ne...... : if-after-compare c retain this comparison result, then accumulate it with any c prior one i listlife r CompareResult r IfHasResult i lieqlicj d 0 r if-first-comparison i lifelieq r LogicChar d 65 i licj.... r if-combine-and i lifelife r IfResult r CompareResult i orli.... r IfResult i stliju.. r if-scan-tail : if-combine-and i lifelife r IfResult r CompareResult i anli.... r IfResult i stliju.. r if-scan-tail : if-first-comparison i lifelist r CompareResult r IfResult i lilist.. d -1 r IfHasResult : if-scan-tail i lica.... r skip-spaces c A begins AND, O begins OR; GOTO and THEN end the condition c list. i lifefeli r SrcPtr r TempChar i stlifeli r TempChar d 65 i eqlicj.. r if-and-keyword i lifelieq r TempChar d 79 i licj.... r if-or-keyword i lifelieq r TempChar d 71 i licj.... r if-goto-keyword i lifelieq r TempChar d 84 i licj.... r if-then-keyword i lica.... r error-syntax i liju.... r ep-loop : if-and-keyword c require the complete AND keyword i lifeliad r SrcPtr d 1 i felieqli d 78 r if-and-second-ok i cj...... i lica.... r error-syntax i liju.... r ep-loop : if-and-second-ok i lifeliad r SrcPtr d 2 i felieqli d 68 r if-next-condition-3 i cj...... i lica.... r error-syntax i liju.... r ep-loop : if-or-keyword c require the complete OR keyword i lifeliad r SrcPtr d 1 i felieqli d 82 r if-next-condition-2 i cj...... i lica.... r error-syntax i liju.... r ep-loop : if-next-condition-3 i lili.... d 65 r LogicChar i stlili.. d 3 r LogicLength i stliju.. r if-advance-condition : if-next-condition-2 i lilistli d 79 r LogicChar d 2 i list.... r LogicLength : if-advance-condition i lifelife r SrcPtr r LogicLength i adli.... r SrcPtr i stlica.. r parse-expression i lifelieq r ErrorCode d 0 i licj.... r if-left-ok i liju.... r ep-loop : if-goto-keyword i liju.... r if-skip-branch-keyword : if-then-keyword : if-skip-branch-keyword c accept either GOTO or THEN, then parse the target line number i life.... r SrcPtr i liadli.. d 4 r SrcPtr i stlica.. r parse-number i lifelieq r ErrorCode d 0 i licj.... r if-target-ok i liju.... r ep-loop : if-target-ok c accumulated condition is on the stack; if zero it is false i lifelist r ParseResult r TargetLine i lifelieq r IfResult d 0 i licj.... r if-false c condition true: find and jump to target line i lica.... r find-line i lifelieq r FoundFlag d 0 i licj.... r if-line-not-found i lifeli.. r FoundIndex r CurrentIndex i stliju.. r ep-loop : if-line-not-found i lica.... r error-line-not-found i re...... : if-false i lica.... r next-line i liju.... r ep-loop c ------------------------------------------------------------ c STMT-REM -- comment line, do nothing. c ------------------------------------------------------------ : stmt-rem i lica.... r next-line i liju.... r ep-loop c ------------------------------------------------------------ c STMT-END c Sets CurrentIndex = LineCount so ep-loop exits cleanly. c ------------------------------------------------------------ : stmt-end i lifeli.. r LineCount r CurrentIndex i stliju.. r ep-loop c ------------------------------------------------------------ c NEXT LINE c Increments CurrentIndex by 1. c ------------------------------------------------------------ : next-line i lifeliad r CurrentIndex d 1 i listre.. r CurrentIndex c ------------------------------------------------------------ c SKIP SPACES c Advances SrcPtr past ASCII space (32) characters. c ------------------------------------------------------------ : skip-spaces : ss-loop i lifefeli r SrcPtr r TempChar i stlifeli r TempChar d 32 i eqlicj.. r ss-advance i re...... : ss-advance i life.... r SrcPtr i liadli.. d 1 r SrcPtr i stliju.. r ss-loop c ------------------------------------------------------------ c PARSE NUMBER c Reads an optional '-', then decimal digit characters from c SrcPtr. Result in ParseResult. Advances SrcPtr past digits. c ------------------------------------------------------------ : parse-number i lica.... r skip-spaces c NumSign = 1 (positive); ParseResult = 0; peek at first char c check for leading '-' (45) i lilistli d 1 r NumSign d 0 i listlili r ParseResult d 0 r ParseDigits i stlifefe r SrcPtr i listlife r TempChar r TempChar i lieqlicj d 45 r pn-neg i liju.... r pn-digits : pn-neg c set NumSign = -1; advance SrcPtr past '-' i lilistli d -1 r NumSign r SrcPtr i feliadli d 1 r SrcPtr i st...... : pn-digits c stop if char < '0' (48) or > '9' (57) i lifefeli r SrcPtr r TempChar i stlifeli r TempChar d 48 i ltlicj.. r pn-done i lifeligt r TempChar d 57 i licj.... r pn-done c ParseResult = ParseResult * 10 + (TempChar - '0') c advance SrcPtr; loop i lifeliad r ParseDigits d 1 i listlife r ParseDigits r ParseResult i limulist d 10 r ParseResult i lifelisu r TempChar d 48 i listlife r Temp r ParseResult i lifeadli r Temp r ParseResult i stlifeli r SrcPtr d 1 i adli.... r SrcPtr i stliju.. r pn-digits : pn-done i lifelieq r ParseDigits d 0 i licj.... r pn-missing-digits i lifelieq r NumSign d -1 i licj.... r pn-apply-sign i re...... : pn-missing-digits i lica.... r error-bad-expression i re...... : pn-apply-sign c negate: ParseResult = 0 - ParseResult i lilifesu d 0 r ParseResult i listre.. r ParseResult c ------------------------------------------------------------ c PARSE VALUE c Reads one operand: a variable name (A-Z) or a numeric c literal. Result in ParseResult; SrcPtr advanced. c c A letter in A-Z (65-90) is a variable reference. c Anything outside that range falls through to parse-number. c ------------------------------------------------------------ : parse-value i lica.... r skip-spaces c if TempChar < 'A' (65), it's a number literal i lifefeli r SrcPtr r TempChar i stlifeli r TempChar d 65 i ltlicj.. r pv-number c if TempChar > 'Z' (90), it's a number literal i lifeligt r TempChar d 90 i licj.... r pv-number c variable reference: index = TempChar - 'A'; fetch c Variables[index] c advance SrcPtr past the letter i lifelisu r TempChar d 65 i listlife r Temp r Temp i liadfeli r Variables r ParseResult i stlifeli r SrcPtr d 1 i adlistre r SrcPtr : pv-number i liju.... r parse-number c ------------------------------------------------------------ c PARSE EXPRESSION c Left-to-right evaluation of: value ( op value )* c Operators: + (43) - (45) * (42) / (47) c Result accumulates in ExprResult. c Division uses ilo's symmetric 'di'; remainder is discarded. c ------------------------------------------------------------ : parse-expression i lica.... r parse-value i lifelieq r ErrorCode d 0 i licj.... r pe-initial-ok i re...... : pe-initial-ok i lifelist r ParseResult r ExprResult : pe-loop i lica.... r skip-spaces c return if the next character is not a known operator i lifefeli r SrcPtr r OpChar i stlifeli r OpChar d 43 i eqlicj.. r pe-plus i lifelieq r OpChar d 45 i licj.... r pe-minus i lifelieq r OpChar d 42 i licj.... r pe-mul i lifelieq r OpChar d 47 i licj.... r pe-div i re...... : pe-plus i life.... r SrcPtr i liadli.. d 1 r SrcPtr i stlica.. r parse-value i lifelieq r ErrorCode d 0 i licj.... r pe-plus-ok i re...... : pe-plus-ok i lifelife r ExprResult r ParseResult i adli.... r ExprResult i stliju.. r pe-loop : pe-minus i life.... r SrcPtr i liadli.. d 1 r SrcPtr i stlica.. r parse-value i lifelieq r ErrorCode d 0 i licj.... r pe-minus-ok i re...... : pe-minus-ok i lifelife r ExprResult r ParseResult i suli.... r ExprResult i stliju.. r pe-loop : pe-mul i life.... r SrcPtr i liadli.. d 1 r SrcPtr i stlica.. r parse-value i lifelieq r ErrorCode d 0 i licj.... r pe-mul-ok i re...... : pe-mul-ok i lifelife r ExprResult r ParseResult i muli.... r ExprResult i stliju.. r pe-loop : pe-div i life.... r SrcPtr i liadli.. d 1 r SrcPtr i stlica.. r parse-value i lifelieq r ErrorCode d 0 i licj.... r pe-div-ok i re...... : pe-div-ok c di yields (remainder, quotient); swap+drop to keep quotient i lifelife r ExprResult r ParseResult i diswdrli r ExprResult i stliju.. r pe-loop c ------------------------------------------------------------ c FIND LINE c Linear search of LineNumbers[0..LineCount-1] for TargetLine. c Sets FoundFlag = -1 and FoundIndex = i if found, c or FoundFlag = 0 if not found. c ------------------------------------------------------------ : find-line i lilistli d 0 r SearchIndex d 0 i list.... r FoundFlag : fl-loop i lifelife r SearchIndex r LineCount i ltlicj.. r fl-body i re...... : fl-body c compare LineNumbers[SearchIndex] with TargetLine i lifeliad r SearchIndex r LineNumbers i felifeeq r TargetLine i licj.... r fl-found i life.... r SearchIndex i liadli.. d 1 r SearchIndex i stliju.. r fl-loop : fl-found c record result: FoundFlag = -1, FoundIndex = SearchIndex i lilistli d -1 r FoundFlag r SearchIndex i felistre r FoundIndex c ------------------------------------------------------------ c PRINT NUMBER c Outputs the integer in NumberTemp to stdout (device 0). c Handles zero (special case), negatives (prefix '-'), c and positives (extract digits by repeated division by 10). c ------------------------------------------------------------ : print-number i lifelieq r NumberTemp d 0 i licj.... r pn-zero i lifelilt r NumberTemp d 0 i licj.... r pn-neg-out i liju.... r pn-prepare : pn-neg-out c output '-' (45) then negate NumberTemp i liliioli d 45 d 0 d 0 i lifesuli r NumberTemp r NumberTemp i st...... : pn-prepare i lilist.. d 0 r DigitCount : pn-split c divide NumberTemp by 10; store remainder digit in c Digits[DigitCount] c loop while NumberTemp > 0 i lifelidi r NumberTemp d 10 i swlistli r Remainder r NumberTemp i stlifeli r Remainder r DigitCount i feliadst r Digits i lifeliad r DigitCount d 1 i listlife r DigitCount r NumberTemp i ligtlicj d 0 r pn-split : pn-emit-loop c emit digits from most-significant to least-significant i lifelieq r DigitCount d 0 i licj.... r pn-done-emit i lifelisu r DigitCount d 1 i listlife r DigitCount r DigitCount i liadfeli r Digits d 48 i adliio.. d 0 i liju.... r pn-emit-loop : pn-zero c special case: output '0' (48) i liliiore d 48 d 0 : pn-done-emit i re...... c ------------------------------------------------------------ c NEWLINE c Outputs ASCII 10 (line feed) to device 0. c ------------------------------------------------------------ : newline i liliiore d 10 d 0 c ------------------------------------------------------------ c PRINT LINE END c Checks the next non-space character. If it is ';' (59), c suppresses the newline (classic BASIC semicolon behaviour). c Otherwise outputs a newline. c ------------------------------------------------------------ : print-line-end i lica.... r skip-spaces c ';' (59) -> suppress newline i lifefeli r SrcPtr r TempChar i stlifeli r TempChar d 59 i eqlicj.. r ple-no-newline i lica.... r newline i re...... : ple-no-newline i re...... c ------------------------------------------------------------ c PROGRAM LISTING AND BLOCK STORAGE c c LIST prints the stored source lines. Program slots are 32 c blocks: c block 0 is a signed directory for programs 0 through 1022, c and n uses blocks c 1 + (n * 32) through 32 + (n * 32). Each slot has two c metadata c blocks followed by 30 ProgramBuffer blocks. The fixed c ProgramBuffer c address makes the saved line-address table valid after c loading. c ------------------------------------------------------------ : list-program i lilist.. d 0 r ListIndex : list-loop i lifelife r ListIndex r LineCount i ltlicj.. r list-line i re...... : list-line c Suppress tombstoned entries left by line deletion. i lifeliad r ListIndex r LineNumbers i felieqli d -1 r list-next i cj...... i lifeliad r ListIndex r LineAddrs i feli.... r StringPtr i stlica.. r print-string i lica.... r newline : list-next i life.... r ListIndex i liadli.. d 1 r ListIndex i stliju.. r list-loop : parse-program-number c Skip the four-character SAVE or LOAD keyword and parse its c number. i life.... r SrcPtr i liadli.. d 4 r SrcPtr i stlica.. r skip-spaces i lica.... r parse-number i lifelist r ParseResult r ProgramNumber i lifelilt r ProgramNumber d 0 i licj.... r ppn-bad i lifeligt r ProgramNumber d 1022 i licj.... r ppn-bad i re...... : ppn-bad i lilist.. d -1 r ProgramNumber i lica.... r error-bad-block i re...... : copy-save-description c SrcPtr follows the slot number. Copy the remaining text into c metadata. i lica.... r skip-spaces i lilist.. r SaveDescription r DstPtr : csd-loop i lifefeli r SrcPtr r TempChar i stlifeli r TempChar r DstPtr i festlife r SrcPtr i liadlist d 1 r SrcPtr i lifeliad r DstPtr d 1 i listlife r DstPtr r TempChar i lieqlicj d 0 r csd-done i liju.... r csd-loop : csd-done i re...... : parse-erase-number c ERASE has a five-character keyword. i life.... r SrcPtr i liadli.. d 5 r SrcPtr i stliju.. r parse-program-number-tail : parse-program-number-tail i lica.... r skip-spaces i lica.... r parse-number i lifelist r ParseResult r ProgramNumber i lifelilt r ProgramNumber d 0 i licj.... r ppnt-bad i lifeligt r ProgramNumber d 1022 i licj.... r ppnt-bad i re...... : ppnt-bad i lilist.. d -1 r ProgramNumber i lica.... r error-bad-block i re...... c Set SaveBlock to the first physical block in ProgramNumber's c slot. : set-program-start-block i lifelimu r ProgramNumber d 32 i listlife r SaveBlock r SaveBlock i liadlist d 1 r SaveBlock i re...... : read-directory i lili.... d 0 r SaveBlock i stlili.. r ProgramDirectory r BufferPtr i stlica.. r read-block i re...... : write-directory i lili.... d 0 r SaveBlock i stlili.. r ProgramDirectory r BufferPtr i stlica.. r write-block i re...... c The final directory cell is a signature. This prevents an c ordinary c Konilo block 0 from being treated as a Poraka program c directory. : directory-is-valid i liliadfe d 1023 r ProgramDirectory i lieqlist d 134756898 r DirectoryFlag i re...... : initialize-directory i lilist.. d 0 r ListIndex : id-loop i lifelilt r ListIndex d 1023 i licj.... r id-clear i liliadli r ProgramDirectory d 1023 d 134756898 i swstre.. : id-clear i lifeliad r ListIndex r ProgramDirectory i liswstli d 0 r ListIndex i feliadli d 1 r ListIndex i stliju.. r id-loop : program-is-saved i lifeliad r ProgramNumber r ProgramDirectory i felistre r DirectoryFlag : mark-program-saved i lifeliad r ProgramNumber r ProgramDirectory i liswstre d 1 : mark-program-erased i lifeliad r ProgramNumber r ProgramDirectory i liswstre d 0 : save-program i lica.... r parse-program-number i lifelilt r ProgramNumber d 0 i licj.... r save-done i lica.... r copy-save-description i lica.... r read-directory i lica.... r directory-is-valid i lifelieq r DirectoryFlag d 0 i licj.... r save-initialize-directory i lica.... r set-program-start-block : save-after-start c Prepare metadata and preserve the two line-index arrays. i lifelist r LineCount r SaveLineCount i lifelist r ProgramWrite r SaveProgramWrite i lililicy r LineNumbers r SaveLineNumbers d 512 i lililicy r LineAddrs r SaveLineAddrs d 512 i lili.... r SaveMeta r BufferPtr i stlica.. r write-block i lili.... r SaveMeta2 r BufferPtr i stlica.. r write-block i lilistli r ProgramBuffer r BufferPtr d 30 i list.... r BufferCount : save-data-loop i lifelieq r BufferCount d 0 i licj.... r save-mark-directory i lica.... r write-block i lifeliad r BufferPtr d 1024 i listlife r BufferPtr r BufferCount i lisuli.. d 1 r BufferCount i stliju.. r save-data-loop : save-mark-directory i lica.... r mark-program-saved i lica.... r write-directory : save-done i re...... : save-initialize-directory i lica.... r initialize-directory i lica.... r set-program-start-block i liju.... r save-after-start : load-saved-program i lica.... r parse-program-number i lifelilt r ProgramNumber d 0 i licj.... r load-done i lica.... r read-directory i lica.... r directory-is-valid i lifelieq r DirectoryFlag d 0 i licj.... r load-not-saved i lica.... r program-is-saved i lifelieq r DirectoryFlag d 0 i licj.... r load-not-saved i lica.... r set-program-start-block i lili.... r SaveMeta r BufferPtr i stlica.. r read-block c Verify that this is a Poraka program image before replacing c memory. i lifeline r SaveMagic d 134756897 i licj.... r load-bad-image i lifeline r SaveVersion d 3 i licj.... r load-bad-image i lifeline r SaveProgramBlocks d 30 i licj.... r load-bad-image i lili.... r SaveMeta2 r BufferPtr i stlica.. r read-block i lilistli r ProgramBuffer r BufferPtr d 30 i list.... r BufferCount : load-data-loop i lifelieq r BufferCount d 0 i licj.... r load-metadata i lica.... r read-block i lifeliad r BufferPtr d 1024 i listlife r BufferPtr r BufferCount i lisuli.. d 1 r BufferCount i stliju.. r load-data-loop : load-metadata i lifelist r SaveLineCount r LineCount i lifelist r SaveProgramWrite r ProgramWrite i lililicy r SaveLineNumbers r LineNumbers d 512 i lililicy r SaveLineAddrs r LineAddrs d 512 i re...... : load-bad-image i lica.... r error-bad-image : load-done i re...... : load-not-saved i lica.... r error-not-saved i re...... : list-saved-programs i lica.... r read-directory i lica.... r directory-is-valid i lifelieq r DirectoryFlag d 0 i licj.... r lsp-none i lilistli d 0 r ListIndex d 0 i list.... r SavedAny : lsp-loop i lifelilt r ListIndex d 1023 i licj.... r lsp-check i lifelieq r SavedAny d 0 i licj.... r lsp-none i re...... : lsp-check i lifeliad r ListIndex r ProgramDirectory i felieqli d 0 r lsp-next i cj...... i lifeli.. r ListIndex r NumberTemp i stlica.. r print-number i liliioli d 32 d 0 r ListIndex i feli.... r ProgramNumber i stlica.. r set-program-start-block i lili.... r SaveMeta r BufferPtr i stlica.. r read-block i lili.... r SaveDescription r StringPtr i stlica.. r print-string i lica.... r newline i lilist.. d -1 r SavedAny : lsp-next i life.... r ListIndex i liadli.. d 1 r ListIndex i stliju.. r lsp-loop : lsp-none i lica.... r error-no-saved i re...... : erase-saved-program i lica.... r parse-erase-number i lifelilt r ProgramNumber d 0 i licj.... r erase-done i lica.... r read-directory i lica.... r directory-is-valid i lifelieq r DirectoryFlag d 0 i licj.... r erase-not-saved i lica.... r program-is-saved i lifelieq r DirectoryFlag d 0 i licj.... r erase-not-saved i lica.... r mark-program-erased i lica.... r write-directory i lica.... r set-program-start-block i lilistli r ZeroBlock r BufferPtr d 32 i list.... r BufferCount : erase-data-loop i lifelieq r BufferCount d 0 i licj.... r erase-done i lica.... r write-block i life.... r BufferCount i lisuli.. d 1 r BufferCount i stliju.. r erase-data-loop : erase-not-saved i lica.... r error-not-saved : erase-done i re...... c BufferPtr selects a complete 1024-cell ilo block. write-block c and c read-block advance SaveBlock, making a 32-block image c sequential. : write-block i lifelife r SaveBlock r BufferPtr i liiolife d 3 r SaveBlock i liadlist d 1 r SaveBlock i re...... : read-block i lifelife r SaveBlock r BufferPtr i liiolife d 2 r SaveBlock i liadlist d 1 r SaveBlock i re...... c Print the null-terminated cell string selected by StringPtr. : print-string : ps-loop i lifefeli r StringPtr r TempChar i stlifedu r TempChar i lieqlicj d 0 r ps-done i liiolife d 0 r StringPtr i liadli.. d 1 r StringPtr i stliju.. r ps-loop : ps-done i drre.... : error-unknown-command i lili.... r ErrorUnknown r StringPtr i stlica.. r print-string i lica.... r newline i re...... : error-too-many-lines i lili.... d -1 r StorageError i stlili.. r ErrorTooManyLines r StringPtr i stlica.. r print-string i lica.... r newline i re...... : error-out-of-program-space i lili.... d -1 r StorageError i stlili.. r ErrorOutOfProgramSpace r StringPtr i stlica.. r print-string i lica.... r newline i re...... : error-bad-block i lili.... r ErrorBadBlock r StringPtr i stlica.. r print-string i lica.... r newline i re...... : error-bad-image i lili.... r ErrorBadImage r StringPtr i stlica.. r print-string i lica.... r newline i re...... : error-not-saved i lili.... r ErrorNotSaved r StringPtr i stlica.. r print-string i lica.... r newline i re...... : error-no-saved i lili.... r ErrorNoSaved r StringPtr i stlica.. r print-string i lica.... r newline i re...... : error-line-not-found i lili.... d 4 r ErrorCode i stlica.. r report-runtime-error i re...... c Runtime errors are raised while executing a numbered BASIC c line. The c parser will use the syntax, expression, and variable c categories later. : error-syntax i lili.... d 1 r ErrorCode i stlica.. r report-runtime-error i re...... : error-bad-expression i lili.... d 2 r ErrorCode i stlica.. r report-runtime-error i re...... : error-bad-variable i lili.... d 3 r ErrorCode i stlica.. r report-runtime-error i re...... : error-out-of-data i lili.... d 5 r ErrorCode i stlica.. r report-runtime-error i re...... : report-runtime-error c Select a prefix from ErrorCode, append the active BASIC line, c and newline. i lifelieq r ErrorCode d 1 i licj.... r rre-syntax i lifelieq r ErrorCode d 2 i licj.... r rre-expression i lifelieq r ErrorCode d 3 i licj.... r rre-variable i lifelieq r ErrorCode d 5 i licj.... r rre-out-of-data i liju.... r rre-line-not-found : rre-syntax i lili.... r ErrorSyntax r StringPtr i stliju.. r rre-print : rre-expression i lili.... r ErrorBadExpression r StringPtr i stliju.. r rre-print : rre-variable i lili.... r ErrorBadVariable r StringPtr i stliju.. r rre-print : rre-out-of-data i lili.... r ErrorOutOfData r StringPtr i stliju.. r rre-print : rre-line-not-found i lili.... r ErrorLineNotFound r StringPtr i stlica.. r print-string i liliioli d 32 d 0 r TargetLine i feli.... r NumberTemp i stlica.. r print-number i lili.... r ErrorLineNotFoundIn r StringPtr i stlica.. r print-string i liju.... r rre-line : rre-print i lica.... r print-string : rre-line i liliioli d 32 d 0 r ErrorLine i feli.... r NumberTemp i stlica.. r print-number i lica.... r newline i re...... c ============================================================ c DATA SECTION c The assembler places data after code, leaving the remaining c upper memory available for future interpreter expansion. c ============================================================ c 26 cells, one per BASIC variable A-Z : Variables * 26 c up to 512 stored lines: integer line number for each slot : LineNumbers * 512 c up to 512 stored lines: ProgramBuffer address of each slot's c text : LineAddrs * 512 c scratch buffer for digit extraction in print-number : Digits * 16 c raw storage for all line text (null-terminated, packed c end-to-end). c This is 30 ilo blocks (30,720 cells). : ProgramBuffer * 30720 : ProgramBufferEnd c raw input from stdin for one line : InputBuffer * 256 c --- scalar variables (one cell each) --- c next free write address within ProgramBuffer : ProgramWrite d 0 c number of lines currently stored : LineCount d 0 c index of the line currently executing : CurrentIndex d 0 c runtime error category and numbered BASIC line currently c executing : ErrorCode d 0 : ErrorLine d 0 c general-purpose read pointer into any buffer : SrcPtr d 0 c general-purpose write pointer : DstPtr d 0 c write cursor into InputBuffer during read-line : InputPtr d 0 c number of characters read by read-line : ReadLen d 0 c line-storage preflight state : StorageError d 0 : RequiredEnd d 0 c set to -1 by read-line when EOF arrives on an empty line : EofFlag d 0 c result of parse-number / parse-value / parse-expression : ParseResult d 0 c number of decimal digits consumed by parse-number : ParseDigits d 0 c accumulated result during parse-expression : ExprResult d 0 c line number to locate or branch to : TargetLine d 0 c index in LineNumbers where TargetLine was found : FoundIndex d 0 c -1 if find-line succeeded, 0 otherwise : FoundFlag d 0 c loop counter used inside find-line : SearchIndex d 0 c sign during parse-number: +1 or -1 : NumSign d 0 c general-purpose scratch cell : Temp d 0 c character temporarily fetched from a buffer : TempChar d 0 c operator character read during parse-expression : OpChar d 0 c 0-based index of the variable being assigned or read (0=A, c 25=Z) : TargetVar d 0 c left-hand operand of an IF comparison : LeftValue d 0 c right-hand operand of an IF comparison : RightValue d 0 c comparison operator in IF: '=' (61), '<' (60), '>' (62), or c internal c codes 1 (<=), 2 (>=), and 3 (<>). : CompChar d 0 c accumulated IF condition and pending logical operator state : IfResult d 0 : CompareResult d 0 : IfHasResult d 0 : LogicChar d 0 : LogicLength d 0 c FOR/NEXT temporary values and a 16-frame nested-loop stack. : ForDepth d 0 : LoopIndex d 0 : ForVarTemp d 0 : ForStartTemp d 0 : ForLimitTemp d 0 : ForStepTemp d 0 : ForCurrentTemp d 0 : ForScanDepth d 0 : ForScanChar d 0 : ForVars * 16 : ForLimits * 16 : ForSteps * 16 : ForResumes * 16 c GOSUB/RETURN state. Each entry is the CurrentIndex to resume c after RETURN. : GosubDepth d 0 : GosubReturns * 16 c ON dispatch selector and mode (-1 for GOSUB, 0 for GOTO). : OnSelector d 0 : OnGosub d 0 c READ/DATA state. DataIndex scans stored source lines in order; c DstPtr is c reused as the pointer to the next numeric item in the active c DATA line. : DataIndex d 0 : DataActive d 0 : ReadPtr d 0 c value to be printed, passed into print-number : NumberTemp d 0 c number of digits extracted in print-number : DigitCount d 0 c remainder from division during print-number digit extraction : Remainder d 0 c -1 if the current input line begins with 'R' (RUN) : RunFlag d 0 c -1 if the current input line begins with 'N' (NEW) : NewFlag d 0 c -1 if the current input line begins with 'B' (BYE) : ByeFlag d 0 c write cursor used in clear-variables loop : ClearPtr d 0 c countdown used in clear-variables loop : ClearCount d 0 c command flags and storage-operation pointers : ListFlag d 0 : SaveFlag d 0 : SavedFlag d 0 : LoadFlag d 0 : EraseFlag d 0 : ListIndex d 0 : SavedAny d 0 : ProgramNumber d 0 : DirectoryFlag d 0 : SaveBlock d 0 : BufferPtr d 0 : BufferCount d 0 : StringPtr d 0 c Block 0 is a signed directory for logical program numbers 0 c through 1022. c Each saved program has 32 blocks: two metadata blocks plus 30 c source blocks. : SaveMeta : SaveMagic d 134756897 : SaveVersion d 3 : SaveLineCount d 0 : SaveProgramWrite d 0 : SaveProgramBlocks d 30 * 11 : SaveLineNumbers * 512 c Null-terminated SAVE description in the first metadata block. : SaveDescription * 256 * 240 c The second metadata block holds the 512-entry address index. : SaveMeta2 : SaveLineAddrs * 512 * 512 c Null-terminated diagnostic strings. : StartupTitle z Poraka BASIC : StartupFree z free : StartupReady z Ready. : ErrorUnknown z ? UNKNOWN COMMAND : ErrorTooManyLines z ? TOO MANY PROGRAM LINES : ErrorOutOfProgramSpace z ? OUT OF PROGRAM SPACE : ErrorBadBlock z ? BAD BLOCK NUMBER : ErrorBadImage z ? BAD PROGRAM IMAGE : ErrorNotSaved z ? PROGRAM NOT SAVED : ErrorNoSaved z ? NO SAVED PROGRAMS : ErrorSyntax z ? SYNTAX ERROR IN : ErrorBadExpression z ? BAD EXPRESSION IN : ErrorBadVariable z ? BAD VARIABLE IN : ErrorOutOfData z ? OUT OF DATA IN : ErrorLineNotFound z ? LINE : ErrorLineNotFoundIn z NOT FOUND IN c The directory occupies physical block 0. ZeroBlock is used by c ERASE to c overwrite all 32 blocks in a program slot. : ProgramDirectory * 1024 : ZeroBlock * 1024 ~~~