; > Commands ; BASIC commands ; 09-Feb-2008: Removed 80-BF from command table, OFF/ERROR/EXT checked for explicitly ; Started writing cmdON to split between subfunctions ; Started work on PRINT - comma doesn't work, rest untested ; 12-Feb-2008: PRINT works, including all print formatters! ; 04-Sep-2008: LIST, REPEAT/UNTIL, GOTO/GOSUB/RETURN, RESTORE, IF, TRACE ; 09-Mar-2009: GOTO/GOSUB/RESTORE search for destination line ; 05-Nov-2009: RESTORE [DATA|ERROR], LOCAL [DATA|ERROR], ENDPROC, = ; 08-Nov-2009: PROC(addr%), FN(addr%) ; Command address table ; ===================== ; On entry to command subroutines, ; r5=>first non-space after command token ; r0=first non-space character after command token, ie (r5) ; .CommandTable EQUW cmdLEFT-$ ; &C0 - LEFT$( EQUW cmdMID-$ ; &C1 - MID$( EQUW cmdRIGHT-$ ; &C2 - RIGHT$( EQUW cmdSTR-$ ; &C3 - STR$( EQUW cmdSTRING-$ ; &C4 - STRING$( EQUW cmdEOF-$ ; &C5 - EOF EQUW cmdAUTO-$ ; &C6 - AUTO EQUW cmdDELETE-$ ; &C7 - DELETE EQUW cmdLOAD-$ ; &C8 - LOAD EQUW cmdLIST-$ ; &C9 - LIST EQUW cmdNEW-$ ; &CA - NEW EQUW cmdOLD-$ ; &CB - OLD EQUW cmdRENUMBER-$ ; &CC - RENUMBER EQUW cmdSAVE-$ ; &CD - SAVE EQUW cmdPUT-$ ; &CE - PUT EQUW cmdPTR-$ ; &CF - PTR EQUW cmdPAGE-$ ; &D0 - PAGE EQUW cmdTIME-$ ; &D1 - TIME EQUW cmdLOMEM-$ ; &D2 - LOMEM EQUW cmdHIMEM-$ ; &D3 - HIMEM EQUW cmdSOUND-$ ; &D4 - SOUND EQUW cmdBPUT-$ ; &D5 - BPUT EQUW cmdCALL-$ ; &D6 - CALL EQUW cmdCHAIN-$ ; &D7 - CHAIN EQUW cmdCLEAR-$ ; &D8 - CLEAR EQUW cmdCLOSE-$ ; &D9 - CLOSE EQUW cmdCLG-$ ; &DA - CLG EQUW cmdCLS-$ ; &DB - CLS EQUW cmdDATA-$ ; &DC - DATA EQUW cmdDEF-$ ; &DD - DEF EQUW cmdDIM-$ ; &DE - DIM EQUW cmdDRAW-$ ; &DF - DRAW EQUW cmdEND-$ ; &E0 - END EQUW cmdENDPROC-$ ; &E1 - ENDPROC EQUW cmdENVELOPE-$ ; &E2 - ENVELOPE EQUW cmdFOR-$ ; &E3 - FOR EQUW cmdGOSUB-$ ; &E4 - GOSUB EQUW cmdGOTO-$ ; &E5 - GOTO EQUW cmdGCOL-$ ; &E6 - GCOL EQUW cmdIF-$ ; &E7 - IF EQUW cmdINPUT-$ ; &E8 - INPUT EQUW cmdLET-$ ; &E9 - LET EQUW cmdLOCAL-$ ; &EA - LOCAL EQUW cmdMODE-$ ; &EB - MODE EQUW cmdMOVE-$ ; &EC - MOVE EQUW cmdNEXT-$ ; &ED - NEXT EQUW cmdON-$ ; &EE - ON EQUW cmdVDU-$ ; &EF - VDU EQUW cmdPLOT-$ ; &F0 - PLOT EQUW cmdPRINT-$ ; &F1 - PRINT EQUW cmdPROC-$ ; &F2 - PROC EQUW cmdREAD-$ ; &F3 - READ EQUW cmdREM-$ ; &F4 - REM EQUW cmdREPEAT-$ ; &F5 - REPEAT EQUW cmdREPORT-$ ; &F6 - REPORT EQUW cmdRESTORE-$ ; &F7 - RESTORE EQUW cmdRETURN-$ ; &F8 - RETURN EQUW cmdRUN-$ ; &F9 - RUN EQUW cmdSTOP-$ ; &FA - STOP EQUW cmdCOLOUR-$ ; &FB - COLOUR EQUW cmdTRACE-$ ; &FC - TRACE EQUW cmdUNTIL-$ ; &FD - UNTIL EQUW cmdWIDTH-$ ; &FE - WIDTH EQUW cmdOSCLI-$ ; &FF - OSCLI .cmdSTR .cmdSTRING .cmdEOF .errSyntax jsr pc,Error equb 16,"Syntax error",0 align ; Not a command, must be a variable assignment ; -------------------------------------------- .cmdAssign .cmdLET jsr pc,VarFind ; Look for variable, create if nonexistant bcs errSyntax ; Bad variable name, give error ; r4=address, r3=data size, r2=type jsr pc,CheckEqual ; Check for and step past '=' mov r4,-(sp) ; Stack destination mov r3,-(sp) mov r2,-(sp) jsr pc,Evaluate ; Evalute following expression ; r4/r3/r2=value mov (sp)+,r0 ; Get destination type ;;;cmp r0,r2 ;;;beq cmdAssign2 ; Types match, do the assignment mov (sp)+,r0 ; Size mov (sp)+,r1 ; Dest movb r4,(r1)+ ; Store first byte dec r0 beq cmdAssignDone ; Byte store swab r4 movb r4,(r1)+ ; Store three more bytes movb r3,(r1)+ swab r3 movb r3,(r1)+ cmp r0,#4 bne cmdAssignDone ; Not float store movb r2,(r1) ; Store fifth byte to float dest .cmdAssignDone rts pc ; STOP ; ==== .cmdSTOP jsr pc,Error equb 0,"STOP",0 align ; ERROR [EXT] errnum,errstr$ ; ========================== .cmdERROR cmpb r0,#tknEXT ; ERROR EXT? bne cmdERROR1 inc r5 ; Step past EXT .cmdERROR1 jsr pc,EvalNumeric ; Get error number jsr pc,CheckComma ; Step past comma movb r4,-(sp) ; Save error number jsr pc,EvalString ; Get error string adr SV_INPUT,r0 ; Use command input buffer to hold error movb (sp)+,(r0)+ ; Pop error number to buffer tst r3 ; Zero-length string? beq cmdERRORdone ; Jump to finish .cmdERRORlp movb (r4)+,(r0)+ ; Copy character to error buffer dec r3 ; Decrement string count bne cmdERRORlp ; Loop to copy whole string .cmdERRORdone movb r3,(r0) ; Put terminating zero in adr SV_INPUT,r0 ; Point to error block mov r0,-(sp) ; Stack it jmp Error ; Jump to error handler ; Program environment commands ; ============================ ; PAGE= - Set default program start ; --------------------------------- ; Check for '=', evaluate integer ; Set PAGE .cmdPAGE jsr pc,EvalEqual ; Check for '=', get integer inc r4 bic #1,r4 ; Ensure word aligned mov r4,SV_PAGE ; Set PAGE rts pc ; LOMEM= - Set heap start, clearing heap ; -------------------------------------- ; Check for '=', evaluate integer ; Set LOMEM ; Set VAREND=LOMEM ; Clear dynamic variables .cmdLOMEM jsr pc,EvalEqual ; Check for '=', get integer inc r4 bic #1,r4 ; Ensure word aligned mov r4,SV_LOMEM ; Set LOMEM mov r4,SV_VAREND ; Set VAREND=LOMEM, clearing heap jsr pc,VarsClear ; Clear dynamic variables rts pc ; HIMEM= - Set top of BASIC memory, clearing stack ; ------------------------------------------------ ; Check for '=', evaluate integer ; Set HIMEM ; Set STACK=HIMEM ; Set machine stack = HIMEM ; Jump to execution loop as stack cleared .cmdHIMEM jsr pc,EvalEqual ; Check for '=', get integer bic #1,r4 ; Ensure word aligned mov r4,SV_HIMEM ; Set HIMEM mov r4,SV_STACK ; Set STACK=HIMEM, clearing BASIC stack mov r4,sp ; Reset machine stack jmp Execute ; WIDTH - Set output width ; ------------------------ ; Evaluate integer ; Set WIDTH .cmdWIDTH jsr pc,EvalInteger ; Get integer mov r4,SV_WIDTH ; Set WIDTH rts pc ; TRACE [ON|OFF|] ; ------------------------ .cmdTRACE clr r4 ; TRACE OFF is same as TRACE 0 cmpb r0,#tknOFF ; Is it TRACE OFF? beq cmdTRACEon ; Yes, jump to turn TRACE OFF mov #&FFFF,r4 ; TRACE ON is same as TRACE 65535 cmpb r0,#tknON ; Is it TRACE ON? beq cmdTRACEon jsr pc,EvalInteger ; Get line number .cmdTRACEon mov r4,SV_TRACE rts pc ; Program Editing commands ; ======================== ; NEW - Terminate program in memory ; ================================= ; TOP=PAGE+2 ; PAGE?0=13 ; PAGE?1=255 ; LOMEM=TOP ; VAREND=TOP ; DATAPTR=PAGE ; STACK=HIMEM ; Clear dynamic variables ; Jump to immediate mode .cmdNEW mov SV_PAGE,r0 ; Get start of program mov #&FF0D,(r0) ; Put in program terminator add #2,r0 ; TOP=PAGE+2 mov r0,SV_TOP ; Set TOP jsr pc,VarsHeapInit ; LOMEM=TOP, VAREND=TOP, DATAPTR=PAGE, STACK=HIMEM jmp Immediate ; Jump to immediate mode ; OLD - Attempt to recover program in memory ; ========================================== ; PAGE?0=13 ; PAGE?1=0 ; Find TOP ; LOMEM=TOP ; VAREND=TOP ; DATAPTR=PAGE ; STACK=HIMEM ; Clear dynamic variables ; Jump to immediate mode .cmdOLD mov SV_PAGE,r0 ; Get start of program mov #&000D,(r0) ; Remove program terminator jsr pc,FindTOP jsr pc,VarsHeapInit ; LOMEM=TOP, VAREND=TOP, DATAPTR=PAGE, STACK=HIMEM jmp Immediate ; Jump to immediate mode ; LIST - List program in memory ; ============================= .cmdLIST ; should parse parameters for start,end mov SV_PAGE,r5 ; Point to start of program inc r5 ; Point to line number high byte .cmdLISTlp movb (r5)+,r4 ; Get line high/terminator cmpb r4,#&FF beq cmdLISTend ; End of program swab r4 ; Put high byte right way around movb (r5)+,r0 ; Get line number low byte inc r5 ; Step past length byte bic #&00FF,r4 bic #&FF00,r0 bis r0,r4 ; Merge each byte together mov #5,r1 ; Pad decimal with 5 spaces .cmdLISTnumber jsr pc,PrintLineNumber ; Output R4 as line number .cmdLISTbyte movb (r5)+,r0 ; Get character from line cmpb r0,#13 ; End of line? beq cmdLISTcr cmpb r0,#tknLINENUM ; Inline line number? beq cmdLISTline jsr pc,PrintR0Token ; Print character or token, corrupts r0,r1,r2 br cmdLISTbyte ; Loop for next byte .cmdLISTline jsr pc,fnLineNum ; Get inline line number clr r1 ; Decimal, no padding br cmdLISTnumber .cmdLISTcr jsr pc,cmdPrintNewline ; Print newline jsr pc,IO_Escape ; Check for Escape br cmdLISTlp ; Loop for next line .cmdLISTend jmp Immediate ; Jump to immediate mode ; Pop stacked localised data and return from subroutine calls ; =========================================================== ; Stack holds ; Bottom of stack, looping structures ; cmdret, tknFOR, ^variable, step[5], limit[5], saved r5, cmdret ; cmdret, tknREPEAT, saved r5, cmdret ; cmdret, tkkGOSUB, saved r5, cmdret ; cmdret, tknERROR, saved error r5, cmdret ; cmdret, tknDATA, saved data r5, cmdret ; Next up stack, subroutine structures ; cmdret, tknPROC, {addr, data...}, &0000, saved r5, cmdret ; cmdret, tknFN, {addr, data...}, &0000, saved r5, cmdret ; cmdret, &0000 ; ; In future, also ; cmdret, tknDIM, DIM LOCAL data ; ; stacked local data ; ^variable, &01nn - byte ; ^variable, &0000, b0-b15, b16-b31 - integer ; ^variable, &00ee, mantis, mantis - real ; ^variable, &80nn, string, align - string ; address, &81nn, string, align - $address ; address, &82nn, string, align - $$address ; = ; ======== ; On entry, sp=> cmdret, tknFN, {locals... } &0000, saved r5, fnret, ... ; If empty, sp=> cmdret, &0000 .cmdEquals jsr pc,Evaluate ; r4/r3/r2=return value mov r4,-(sp) mov r3,-(sp) mov r2,-(sp) ; Save return value mov #tknFN,r0 ; Within FN call br cmdFNENDPROC ; ENDPROC ; ======= ; On entry, sp=> cmdret, tknPROC, {locals... } &0000, saved r5, cmdret, ... ; If empty, sp=> cmdret, &0000 .cmdENDPROC tst -(sp) tst -(sp) tst -(sp) ; Push dummy value to balance later restore mov #tknPROC,r0 .cmdFNENDPROC mov sp,r1 ; r1=>rettype, retval, retval, cmdret, tknXX, ... add #8,r1 ; r1=>tknXXX, any stacked data mov r0,-(sp) ; (sp)=subroutine token .cmdPopLoop mov (r1)+,r0 ; Get token from bottom of stack cmpb r0,(sp) beq cmdPopCall ; Matching subroutine token cmpb r0,#tknFOR beq cmdPopFor cmpb r0,#tknREPEAT beq cmdPopRepeat cmpb r0,#tknERROR beq cmdPopError cmpb r0,#tknDATA beq cmdPopData cmpb (sp)+,#tknFN beq errNoFN jsr pc,Error equb 13,"Not in a PROC",0 align .errNoFN jsr pc,Error equb 7,"Not in a function",0 align .cmdPopError mov (sp)+,SV_ONERR br cmdPopLoop .cmdPopData mov (sp)+,SV_DATA br cmdPopLoop .cmdPopFor add #12,r1 ; Drop variable, step, limit .cmdPopRepeat tst (r1)+ ; Drop savedR5 tst (r1)+ ; Drop cmdret br cmdPopLoop ; Loop to pop any more data ; Localised ERROR and DATA pointers popped off stack ; Localised loop structures popped off stack ; r1=>{ addr, type, data}, &0000, savedR5, cmdret .cmdPopCall mov (r1)+,r0 ; r0=&0000 or address of variable tst r0 beq cmdPopDone ; No more localised items mov (r1)+,r2 ; r2=stacked type tst r2 bmi cmdPopString ; &8xnn -> string beq cmdPopInteger ; &0000 -> integer bit #&0100,r2 bne cmdPopByte ; &01nn -> byte movb r2,(r0)+ ; Real exponent .cmdPopInteger movb (r1)+,(r0)+ ; Real mantissa or 32-bit integer movb (r1)+,(r0)+ movb (r1)+,(r0)+ movb (r1)+,(r0)+ br cmdPopCall ; Loop to pop any more .cmdPopByte movb r2,(r0) br cmdPopCall ; Loop to pop any more .cmdPopString bit r2,#&0300 bne cmdPopAbsString ; $addr or $$addr bic #&FF00,r2 ; r2=length mov (r0),r4 ; r4=>string data movb r2,3(r0) ; Set string length tst r2 beq cmdPopCall ; Zero-length string, loop for any more .cmdPopStringLp movb (r1)+,(r4)+ ; Copy characters to string data dec r2 bne cmdPopStringLp ; Loop until all done .cmdPopAlign inc r1 bic #1,r1 ; Ensure r1 evenly aligned br cmdPopCall ; Loop for any more .cmdPopAbsString bit r2,#&00FF beq cmdPopAbsDone ; Zero-length string movb (r1)+,(r0)+ ; Copy character dec r2 br cmdPopAbsString ; Loop for all characters .cmdPopAbsDone bit #&0100,r2 beq cmdPopStringZero movb #13,(r0) ; $addr terminated with br cmdPopAlign .cmdPopStringZero clrb (r0) ; $$addr terminated with <00> br cmdPopAlign ; All localised items popped from stack ; r1=>savedR5, cmdret ; sp=>token, r4, r3, r2 .cmdPopDone tst (sp)+ ; Drop token mov (sp)+,r2 mov (sp)+,r3 mov (sp)+,r4 ; Fetch any return value mov r1,sp ; Point to new stack top mov (sp)+,r5 ; Get stacked program pointer tst r2 ; Set return value flags rts pc ; ...and return .errNoSuchPROC jsr pc,Error equb 29,"No such FN/PROC",0 align .errBadCall jsr pc,Error equb 30,"Bad call",0 align .errArguments jsr pc,Error equb 31,"Arguments",0 align ; PROC[()] ; ==================================== .cmdPROC mov #tknPROC,r0 br cmdSubroutine ; =FN[(parameters)] ; ================================= .fnFN mov #tknFN,r0 ; Call FN/PROC subroutine ; ----------------------- ; On entry, ; r0=FN or PROC token ; r5=>start of FN/PROC name ; sp=>fnret/cmdret ; On return to Execute loop, ; sp=>token, {local data}, &0000, savedR5, fnret/cmdret ; .cmdSubroutine cmpb (r5),#ASC"(" ; PROC( or FN( ? beq cmdSubIndir ; Indirect FN/PROC call br errBadCall ;; dec r5 ; r5=>FN/PROC, start of fully-qualified name ;; jsr pc,VarFindVariable ; Look for FN/PROC in heap ;; bcs errBadCall ; Bad identifier, does this catch eg 'PROCfred'? ;; bne cmdSubFound ; r4=>data block ;; ; ;; ; scan program for FN/PROC start ;; ; add it to heap ;; ;; mov r5,r4 ; Save line pointer ;; mov SV_PAGE,r1 ; r1=>start of program ;; inc r1 ; r1=>first line ;; ;; movb (r1)+,r0 ; Get line high/end marker ;; cmpb r0,#&FF ;; beq errNoSuchPROC ; End of program ;; ; Also use this code to find DATA lines ;; tstb (r1)+ ; Step past line low ;; tstb (r1)+ ; Step past line length ;; ;; .cmdSubLp1 ;; movb (r1)+,r0 ;; cmpb r0,#32 ;; beq cmdSubLp1 ; Step past spaces ;; cmpb r0,#tknDEF ;; bne cmdSubNext ; Step to next line ;; .cmdSubLp2 ;; movb (r1)+,r0 ;; cmpb r0,#32 ;; beq cmdSubLp2 ; Step past spaces ;; dec r1 ; r1=>PROC or FN ;; ; r5=>PROC or FN ;; .cmdSubLp3 ;; movb (r1)+,r0 ; Get character from DEF ;; ;;jsr pc,VarValidChar ;; ;;bxx --> ;; ;;cmpb r0,(r4)+ ;; ;;beq cmdSubLp3 ; Compare call and definition ;; ;;<-- ;; ; r4=>end of FN/PROC name, =>any opening '(' ;; ; need to add name to heap ;; .cmdSubNext ;; ;; ; r5=>line pointer ;; ;; ; r4=> ;; ; ; Indirect subroutine call ; ------------------------ ; Syntax is A%=^PROCfred:PROC(A%) ; A%=^PROCfred sets A%=>PROCfred's data block ; PROC(A%) fetches destination address from location A% ; .cmdSubIndir mov r0,-(sp) ; Save FN/PROC token jsr pc,Evaluate ; Get indirect address, also parse ')' ; r4=>FN/PROC info block ; .cmdSubFound ; r4=>word holding start of subroutine ; DEFPROCfred ; DEFPROCfred:... ; DEFPROCfred(... ; (r4)=>-----^ mov (r4),r4 ; r4=>start of subroutine mov (sp)+,r0 ; Get FN/PROC token back mov r5,-(sp) ; Push line pointer clr -(sp) ; Push end of locals cmpb (r5),#ASC"(" ; Any parameters in the call? bne cmdSubCall ; No calling parameters cmpb (r4),#ASC"(" ; Any definition parameters? bne errArguments ; Calling parameters, but no definition parameters ; scan and localise parameters and variables br errBadCall .cmdSubCall cmpb (r4),#ASC"(" ; Any definition parameters? beq errArguments ; No calling parameters, but definition has parameters mov r0,-(sp) ; Stack subroutine token mov r4,r5 ; Set line pointer to start of subroutine ; mov sp,SV_STACK ; Debug - note bottom of stack jmp Execute ; And start executing ; REPEAT ; ====== ; On entry, sp=>cmdret ; On exit, sp=>tknREPEAT, saved r5, cmdret .cmdREPEAT mov r5,-(sp) ; Save line pointer mov #tknREPEAT,-(sp) ; Stack REPEAT token jmp Execute ; Return to execution code ; UNTIL x ; ======= ; On entry, sp=> cmdret, tknREPEAT, saved r5, cmdret .cmdUNTIL cmpb 2(sp),#tknREPEAT beq cmdUNTILtest jsr pc,Error equb 43,"No REPEAT",0 align .cmdUNTILtest jsr pc,EvalInteger bis r3,r4 ; Is it zero? beq cmdUNTILfalse ; UNTIL FALSE, return to REPEAT routine .cmdUNTILtrue ; UNTIL TRUE, drop stacked REPEAT add #6,sp ; Drop cmdret, tknREPEAT, savedR5 ;tst (sp)+ ; Drop UNTIL return address ;tst (sp)+ ; Drop tknREPEAT address ;tst (sp)+ ; Drop saved R5 rts pc .cmdUNTILfalse mov 4(sp),r5 ; Get saved r5 rts pc ; Return to continue executing ; LOCAL [DATA][ERROR] ; ================================= .cmdLOCAL mov 2(sp),r1 ; Are with within a subroutine? cmpb r1,#tknFN beq cmdLocal2 ; Within a FN cmpb r1,#tknPROC beq cmdLocal2 ; Within a PROC cmpb r1,#tknERROR beq cmdLocal2 ; Within a FN/PROC and a localised ERROR cmpb r1,#tknDATA beq cmdLocal2 ; Within a FN/PROC and a localised DATA ; So, the following gives an error ; DEFPROCfred : FOR a=1 TO 2 : LOCAL .... ; DEFPROCfred : REPEAT : LOCAL ... ; (destination of GOSUB) : LOCAL ... jsr pc,Error equb 12,"Not LOCAL",0 align .cmdLocal2 cmpb r0,#tknERROR beq cmdLocal1 ; LOCAL ERROR cmpb r0,#tknDATA beq cmdLocal2 ; LOCAL DATA jmp cmdLocalVariable .cmdLocal1 mov SV_ONERR,-(sp) mov r0,-(sp) jmp Execute .cmdLocal2 mov SV_DATA,-(sp) mov r0,-(sp) jmp Execute ; This should be sharable with FN/PROC() ; -------------------------------------------------- .cmdLocalVariable tst (sp)+ ; Drop cmdret ; r5=>variable jsr pc,VarFind ; Find a variable, create it if not present ; stacked local data looks like this ; ^variable, &01nn - byte ; ^variable, &0000, b0-b15, b16-b31 - integer ; ^variable, &00ee, mantis, mantis - real ; ^variable, &80nn, string, align - string ; address, &81nn, string, align - $address ; address, &82nn, string, align - $$address ; r4=>data block ; r3=>data block size ; r2=>type ; sp=>tknFN/PROC, {any local data}, &000, ... ;;mov (sp)+,r1 ; r1=FN/PROC token ;;mov r4,r0 ; r0=>data block ;;jsr pc,StringFindLength ; Ensure r3 holds string length if needed ;;jsr pc,StackValAndOp jmp cmdUnimplemented ; RESTORE [DATA][ERROR]() ; ================================ .cmdRESTORE cmpb r0,#tknERROR beq cmdRestore1 ; RESTORE ERROR cmpb r0,#tknDATA beq cmdRestore1 ; RESTORE DATA jsr pc,CheckEndToken bne cmdRestoreLine mov SV_PAGE,SV_DATA rts pc .cmdRestoreLine jsr pc,GetLineNumber ; Evaluate and look for line mov r1,SV_DATA rts pc .cmdRestore1 cmpb 2(sp),r0 bne errNoRestore tst (sp)+ ; Pop cmdret tst (sp)+ ; Pop token cmpb r0,#tknERROR beq cmdRestore2 mov (sp)+,SV_DATA ; Pop DATA pointer rts pc .cmdRestore2 mov (sp)+,SV_ONERR ; Pop ON ERROR pointer rts pc .errNoRestore jsr pc,Error equb 255,"No stacked ERROR/DATA",0 align ; GOTO ; ============== .cmdGOTO jsr pc,GetLineNumber ; Evaluate and look for line mov r1,r5 ; Point to GOTO destination rts pc ; Continue executing ; GOSUB ; =============== ; On exit, sp=>tknGOSUB, saved r5, cmdret .cmdGOSUB jsr pc,GetLineNumber ; Evaluate and look for line mov r5,-(sp) ; Save current program pointer mov #tknGOSUB,-(sp) ; Stack GOSUB token mov r1,r5 ; Point to GOSUB destination jmp Execute ; Jump to execution code .GetLineNumber jsr pc,EvalInteger ; r4/r3=destination line number tst r3 bne errNoSuchLine jsr pc,LineFind ; r1=> before destination line if found bne errNoSuchLine rts pc .errNoSuchLine jsr pc,Error equb 41,"No such line",0 align ; RETURN ; ====== ; On entry, sp=> cmdret, tknGOSUB, saved r5, cmdret .cmdRETURN cmpb 2(sp),#tknGOSUB beq cmdRETURNok jsr pc,Error equb 38,"No GOSUB",0 align .cmdRETURNok tst (sp)+ ; Drop RETURN return address tst (sp)+ ; Drop tknGOSUB mov (sp)+,r5 ; Pop line pointer .cmdIFexit rts pc ; Return to calling GOSUB ; IF [THEN ...] [ELSE ...] ; ================================== .cmdIF JSR pc,EvalInteger bis r3,r4 ; Is it zero? bne cmdIFexit ; Continue .cmdIFelse movb (r5),r0 cmpb r0,#13 beq cmdIFexit ; No ELSE found, continue on next line inc r5 cmpb r0,#tknELSE beq cmdIFexit ; ELSE found, continue from here cmpb r0,#34 bne cmdIFelse ; Not a quote, keep looking for ELSE .cmdIFquote movb (r5),r0 ; Look for closing quote cmpb r0,#13 beq cmdIFexit ; End of line found, continue on next line inc r5 cmpb r0,#34 bne cmdIFquote ; Loop until closing quote found br cmdIFelse ; Loop back to look for ELSE ; ON, ON ERROR, ON x GOTO, ON x GOSUB, ON x PROC ; ============================================== .cmdON jsr pc,CheckEndToken bne cmdON1 jmp cmdOFFon ; ON - turn on cursor .cmdON1 cmp r0,#tknERROR ; Is it ON ERROR? bne cmdONswitch ; No, jump to ON x [GOTO|PROC] jsr pc,SkipSpaces cmp r0,#tknOFF ; Is it ON ERROR OFF? beq cmdONErrorOff ; Yes, jump to turn ON ERROR OFF mov r5,SV_ONERR ; Point ON ERROR to here jmp SkipLine ; Skip rest of line and continue .cmdONErrorOff clr SV_ONERR ; ON ERROR OFF rts pc .cmdONswitch ; ON x [GOTO|PROC] ; fall through ; UNIMPLEMENTED COMMANDS ; ====================== .cmdLEFT .cmdMID .cmdRIGHT .cmdPUT .cmdDIM .cmdINPUT .cmdFOR .cmdNEXT .cmdREAD .cmdPRINTchn .cmdAUTO .cmdDELETE .cmdRENUMBER .cmdUnimplemented JSR PC,PrintInline EQUS "Unimplemented command",13,0 ALIGN JSR pc,SkipLine RTS PC ; PRINT - Print to output stream or to file ; ========================================= .cmdPRINT cmp r0,#ASC"#" ; Is it PRINT # ? bne cmdPrintLoop ; Jump for normal PRINT br cmdPRINTchn ; Jump to print to file ; PRINT main code ; --------------- .cmdPrintComma movb SV_VARS,r0 ; Get field width beq cmdPrintLoop ; Zero, no padding needed, return to main loop bic #&FF00,r0 ; Remove any sign-extension movb SV_COUNT,r1 ; Get field width bic #&FF00,r1 ; Remove any sign-extension .cmdPrintCommaLp beq cmdPrintLoop ; Zero, start of new line or field, no padding needed, return to main loop sub r0,r1 ; r1=COUNT-width bcc cmdPrintCommaLp ; Loop until reduced below zero mov #32,r0 .cmdPrintCommaSpc jsr pc,PrintR0 ; Print padding spaces inc r1 bne cmdPrintCommaSpc ; Loop until reached next field ; .cmdPrintLoop movb SV_VARS,r1 ; Get field width from @% bic #&FF00,r1 ; b7=0 - decimal .cmdPrintNext jsr pc,SkipSpaces ; Get next char jsr pc,CheckEndToken ; End of statement? bne cmdPrintItem ; No, jump to process items .cmdPrintNewline clrb SV_COUNT ; Clear COUNT jsr pc,IO_NEWL ; Finish with newline clc ; Signal print item done rts pc ; .cmdPrintSemi clr r1 ; Set field width=0, flag=dec jsr pc,SkipSpaces ; Get next char jsr pc,CheckEndToken ; End of statement? beq cmdPrintDone ; Exit without printing newline .cmdPrintItem jsr pc,fnConversion bcs cmdPrintNext ;inc r5 ; Step past current character ;cmp r0,#ASC"~" ; Hex output prefix? ;beq cmdPrintHex ; Jump to set hex flag inc r5 ; Step past current character cmp r0,#ASC"," ; Print comma? beq cmdPrintComma ; Jump to pad to next field cmp r0,#&3B ; Semicolon? beq cmdPrintSemi ; Jump to check for end of print statement ; jsr pc,cmdPrintFormat ; Check for ' TAB SPC print formatting bcc cmdPrintNext ; Formatting item printed, check next item mov r1,-(sp) ; Save print flag (as evaluation may call print) jsr pc,Evaluate ; Evalute current item mov (sp)+,r1 ; Get print flag back jsr pc,cmdPrintResult br cmdPrintNext .PrintLineNum clr r1 ; No space padding ; .PrintLineNumber ; On entry, r4=line number ; r1=max number of padding spaces ; clr r3 ; 16-bit number clr r2 ; type=integer .cmdPrintResult ; On entry, r2/r3/r4=value ; r1=field width+hex flag ; On exit, r0/r2/r3/r4 corrupted ; tst r2 ; Check result type bmi cmdPrintString ; String, print it jsr pc,NumberToString ; Convert numeric to string ; r4=>string, r3=length, r1=field width+hex flag mov r1,r2 ; r2=field width bic #&FF00,r2 ; Remove any sign extension sub r3,r2 ; r2=width-length bcs cmdPrintString ; Item wider than width, no padding beq cmdPrintString ; Item same as width, no padding mov r1,-(sp) ; Save field width/hex flag mov r2,r1 jsr pc,PrintR1Spaces ; Print spaces to pad to number mov (sp)+,r1 ; Get field/hex flag back .cmdPrintString tst r3 ; Check string length beq cmdPrintResultDone ; Null string, nothing to print .cmdPrintStrLp movb (r4)+,r0 ; Get a character jsr pc,PrintR0 ; Print it dec r3 bne cmdPrintStrLp ; Loop for all characters .cmdPrintResultDone rts pc ; PRINT formatting item - ', TAB, SPC ; ----------------------------------- .cmdPrintFormat cmp r0,#ASC"'" ; It it single quote? beq cmdPrintNewline ; Jump to print newline cmp r0,#tknTAB ; Is it TAB? beq cmdPrintTAB ; Jump to do TAB(x) or TAB(x,y) cmp r0,#tknSPC ; Is it SPC? beq cmdPrintSPC ; Jump to do SPCx dec r5 ; Point back to current item sec ; Signal 'not print item' rts pc ; PRINT TAB() ; ----------- .cmdPrintTAB jsr pc,EvalInteger ; Get first parameter jsr pc,SkipSpaces ; Check next character cmp r0,#ASC"," ; Is there a comma? beq cmdPrintTABXY ; Jump to do TAB(x,y) jsr pc,CheckClose1 ; Check for closing bracket movb SV_COUNT,r0 ; Get COUNT mov r4,r1 ; r1=required column sub r0,r1 ; r1=r1-r0 - r1=tab-COUNT beq cmdPrintDone ; No spaces needed bcc PrintR1Spaces ; Jump to output required spaces jsr pc,cmdPrintNewline ; Output newline, zero count, signal done mov r4,r1 ; R1=number of spaces br PrintR1Spaces ; Jump to output required spaces ; PRINT TAB(x,y) ; -------------- .cmdPrintTABXY inc r5 ; Step past comma mov r4,-(sp) ; Save current value jsr pc,EvalInteger ; Get next integer jsr pc,CheckClose ; Step past ')' mov #31,r0 jsr pc,IO_WRCH ; Send TAB mov (sp)+,r0 jsr pc,IO_WRCH ; Send X mov r4,r0 jsr pc,IO_WRCH ; Send Y .cmdPrintDone clc ; Signal print formatting item rts pc ; PRINT SPC(n) ; ------------ .cmdPrintSPC jsr pc,EvalInteger ; Get next integer mov r4,r1 ; Move to R1 beq cmdPrintDone ; Zero - clear carry and return .PrintR1Spaces mov #32,r0 .PrintR1SpcLp jsr pc,PrintR0 ; Print space dec r1 bne PrintR1SpcLp ; Loop until required spaces printed br cmdPrintDone ; Clear carry and return