;boot;
;ORG 0000H
LD A, 0FH ; PIO A OUT MODE OUT (02H),A LD A, 00H ; PIO A OUT OUT (00H),A
; init Z80 SIO A; Z80 SIO Register Mnemonics
DEFC SIOA_D = $40 ;SIO CHANNEL A DATA REGISTERDEFC SIOA_C = $42 ;SIO CHANNEL A CONTROL REGISTERDEFC SIOB_D = $41 ;SIO CHANNEL B DATA REGISTERDEFC SIOB_C = $43 ;SIO CHANNEL B CONTROL REGISTER;// initialize SIO port A CLK 1X 8N1
LD A,00H ;REQUEST REGISTER #0 OUT (SIOA_C),A LD A,18H ;LOAD #0 WITH 18H - CHANNEL RESET OUT (SIOA_C),A
LD A,01H OUT (SIOA_C),A LD A,00H OUT (SIOA_C),A
LD A,04H ;REQUEST TRANSFER TO REGISTER #4 OUT (SIOA_C),A LD A,0C4H ;WRITE #4 WITH X/0 CLOCK 1X STOP BIT OUT (SIOA_C),A ; AND NO PARITY
LD A,03H ;REQUEST TRANSFER TO REGISTER #3 OUT (SIOA_C),A LD A,0C1H OUT (SIOA_C),A ;WRITE #3 WITH COH - RECEIVER 8 BITS & RX ENABLE
LD A,05H ;REQUEST TRANSFER TO REGISTER #5 OUT (SIOA_C),A LD A,068H OUT (SIOA_C),A ;WRITE #5 WITH 60H - TRANSMIT 8 BITS & TX ENABLE
;SETUP PORT B LD A,00H ;REQUEST REGISTER #0 OUT (SIOB_C),A LD A,018H ;LOAD #0 WITH 18H - CHANNEL RESET OUT (SIOB_C),A
JP START
MONOUT: OUT (SIOA_D), A CP CR JP NZ, MEXT LD A, LF OUT (SIOA_D), AMEXT: RET
TIN: IN A, (SIOA_C) AND 01H RET Z IN A, (SIOA_D)TEND: RET
RINPUT: ;PUSH HL LD HL, BUFFER LD B, 080HRI1: CALL TIN AND A JP Z, RI1 CP 0 ; End of line? JP Z, ENDL LD C, A CALL MONOUT INC HL DEC B JP NZ, RI1ENDL: LD A, LF LD (HL), A INC HL LD A, 0 LD (HL), A ;POP HL RET
; NASCOM ROM BASIC Ver 4.7, (C) 1978 Microsoft; Scanned from source published in 80-BUS NEWS from Vol 2, Issue 3; (May-June 1983) to Vol 3, Issue 3 (May-June 1984); Adapted for the freeware Zilog Macro Assembler 2.10 to produce; the original ROM code (checksum A934H). PA
; MONITOR EQUATES (RESTART INSTRUCTIONS); removed since we are not using the NAS monitor routines;;_ROUT EQU 0F7H ; ROUT - Output char in A;_BLNK EQU 07BDFH ; SCAL BLINK - Get input char in A;_INLN EQU 063DFH ; SCAL INLIN - Get input line;_MFLP EQU 05FDFH ; SCAL MFLP - Toggle tape drv LED;_MRET EQU 05BDFH ; SCAL MRET - Return to monitor;_READ EQU 052DFH ; SCAL READ;_RIN EQU 062DFH ; SCAL RIN - Scan for input char;_VRFY EQU 056DFH ; SCAL VERIFY;_WRIT EQU 057DFH ; SCAL WRITE
; GENERAL EQUATES
UARTD EQU 40H ; UART data portUARTS EQU 42H ; UART status portCTRLC EQU 03H ; Control "C"CTRLG EQU 07H ; Control "G"BKSP EQU 08H ; Back spaceLF EQU 0AH ; Line feedCS EQU 0CH ; Clear screenCR EQU 0DH ; Carriage returnCTRLO EQU 0FH ; Control "O"CTRLR EQU 12H ; Control "R"CTRLS EQU 13H ; Control "S"CTRLU EQU 15H ; Control "U"CTRLZ EQU 1AH ; Control "Z"ESC EQU 1BH ; EscapeTBRK EQU 1CH ; "T" monitor breakTBS EQU 1DH ; "T" monitor back spaceTCS EQU 1EH ; "T" monitor clear screenTCR EQU 1FH ; "T" monitor carriage returnDEL EQU 7FH ; Delete
; MONITOR LOCATIONS; More NAS monitor and computer addresses we are not using;;MONSTT EQU 0000H ; Start of monitor;STMON EQU 0000H ; NAS-SYS initialisation;MFLP EQU 0000H ; Flip tape LED ("T");MONTYP EQU 0000H ; Type of "T" monitor;T2DUMP EQU 0000H ; "T2" Dump routine;T4WR EQU 0000H ; "T4" Write routine;T4READ EQU 0000H ; "T4" Read routineVDU EQU 08000H ; NASCOM Video RAM base
; MONITOR WORK SPACE LOCATIONS
;PORT0 EQU 0C00H ; Copy of output port 0;ARG1 EQU 0C0CH ; Argument 1;ARG2 EQU 0C0EH ; Argument 2;TCUR EQU 0C18H ; "T" monitor cursor;CURSOR EQU 0C29H ; NAS-SYS Cursor;ARGN EQU 0C2BH ; Number of ARGS;TOUT EQU 0C4AH ; "T" Output reflection;TIN EQU 0C4DH ; "T" Input reflection;CIN EQU 0C75H ; NAS-SYS Input table;NMI EQU 0C7EH ; NAS-SYS NMI Jump
; New Display informationDISCOL EQU 20H ; 32 ColumnsDISROW EQU 0FH ; 16 Rows
; BASIC WORK SPACE LOCATIONS
WRKSPC EQU 2000H ; BASIC Work spaceUSR EQU WRKSPC+03H ; "USR (x)" jumpOUTSUB EQU WRKSPC+006H ; "OUT p,n"OTPORT EQU WRKSPC+007H ; Port (p)DIVSUP EQU WRKSPC+009H ; Division support routineDIV1 EQU WRKSPC+00AH ; <- ValuesDIV2 EQU WRKSPC+00EH ; <- toDIV3 EQU WRKSPC+012H ; <- beDIV4 EQU WRKSPC+015H ; <-insertedSEED EQU WRKSPC+017H ; Random number seedLSTRND EQU WRKSPC+03AH ; Last random numberINPSUB EQU WRKSPC+03EH ; #INP (x)" RoutineINPORT EQU WRKSPC+03FH ; PORT (x)NULLS EQU WRKSPC+041H ; Number of nullsLWIDTH EQU WRKSPC+042H ; Terminal widthCOMMAN EQU WRKSPC+043H ; Width for commasNULFLG EQU WRKSPC+044H ; Null after input byte flagCTLOFG EQU WRKSPC+045H ; Control "O" flagLINESC EQU WRKSPC+046H ; Lines counterLINESN EQU WRKSPC+048H ; Lines numberCHKSUM EQU WRKSPC+04AH ; Array load/save check sumNMIFLG EQU WRKSPC+04CH ; Flag for NMI break routineBRKFLG EQU WRKSPC+04DH ; Break flag;RINPUT EQU WRKSPC+04EH ; Input reflectionPOINT EQU WRKSPC+051H ; "POINT" reflection (unused)PSET EQU WRKSPC+054H ; "SET" reflectionRESET EQU WRKSPC+057H ; "RESET" reflectionSTRSPC EQU WRKSPC+05AH ; Bottom of string spaceLINEAT EQU WRKSPC+05CH ; Current line numberBASTXT EQU WRKSPC+05EH ; Pointer to start of programBUFFER EQU WRKSPC+061H ; Input bufferSTACK EQU WRKSPC+066H ; Initial stackCURPOS EQU WRKSPC+0ABH ; Character position on lineLCRFLG EQU WRKSPC+0ACH ; Locate/Create flagTYPE EQU WRKSPC+0ADH ; Data type flagDATFLG EQU WRKSPC+0AEH ; Literal statement flagLSTRAM EQU WRKSPC+0AFH ; Last available RAMTMSTPT EQU WRKSPC+0B1H ; Temporary string pointerTMSTPL EQU WRKSPC+0B3H ; Temporary string poolTMPSTR EQU WRKSPC+0BFH ; Temporary stringSTRBOT EQU WRKSPC+0C3H ; Bottom of string spaceCUROPR EQU WRKSPC+0C5H ; Current operator in EVALLOOPST EQU WRKSPC+0C7H ; First statement of loopDATLIN EQU WRKSPC+0C9H ; Line of current DATA itemFORFLG EQU WRKSPC+0CBH ; "FOR" loop flagLSTBIN EQU WRKSPC+0CCH ; Last byte enteredREADFG EQU WRKSPC+0CDH ; Read/Input flagBRKLIN EQU WRKSPC+0CEH ; Line of breakNXTOPR EQU WRKSPC+0D0H ; Next operator in EVALERRLIN EQU WRKSPC+0D2H ; Line of errorCONTAD EQU WRKSPC+0D4H ; Where to CONTinuePROGND EQU WRKSPC+0D6H ; End of programVAREND EQU WRKSPC+0D8H ; End of variablesARREND EQU WRKSPC+0DAH ; End of arraysNXTDAT EQU WRKSPC+0DCH ; Next data itemFNRGNM EQU WRKSPC+0DEH ; Name of FN argumentFNARG EQU WRKSPC+0E0H ; FN argument valueFPREG EQU WRKSPC+0E4H ; Floating point registerFPEXP EQU FPREG+3 ; Floating point exponentSGNRES EQU WRKSPC+0E8H ; Sign of resultPBUFF EQU WRKSPC+0E9H ; Number print bufferMULVAL EQU WRKSPC+0F6H ; MultiplierPROGST EQU WRKSPC+0F9H ; Start of program text areaSTLOOK EQU WRKSPC+015DH ; Start of memory test
; BASIC ERROR CODE VALUES
NF EQU 00H ; NEXT without FORSN EQU 02H ; Syntax errorRG EQU 04H ; RETURN without GOSUBOD EQU 06H ; Out of DATAFC EQU 08H ; Function call errorOV EQU 0AH ; OverflowOM EQU 0CH ; Out of memoryUL EQU 0EH ; Undefined line numberBS EQU 10H ; Bad subscriptDD EQU 12H ; Re-DIMensioned arrayDZ EQU 14H ; Division by zero (/0)ID EQU 16H ; Illegal directTM EQU 18H ; Type miss-matchOS EQU 1AH ; Out of string spaceLS EQU 1CH ; String too longST EQU 1EH ; String formula too complexCN EQU 20H ; Can't CONTinueUF EQU 22H ; UnDEFined FN functionMO EQU 24H ; Missing operand
; ORG 0240H
START: JP STARTB ; Jump for restart jumpSTARTB: DI ; No interrupts LD IX,0 ; Flag cold start JP CSTART ; Jump to initialise
DEFW DEINT ; Get integer -32768 to 32767 DEFW ABPASS ; Return integer in AB
JP LDNMI1 ; << NO REFERENCE TO HERE >>
CSTART: LD HL,WRKSPC ; Start of workspace RAM LD SP,HL ; Set up a temporary stack JP INITST ; Go to initialise
INIT: LD DE,INITAB ; Initialise workspace LD B,INITBE-INITAB+3; Bytes to copy LD HL,WRKSPC ; Into workspace RAMCOPY: LD A,(DE) ; Get source LD (HL),A ; To destination INC HL ; Next destination INC DE ; Next source DEC B ; Count bytes JP NZ,COPY ; More to move LD SP,HL ; Temporary stack CALL CLREG ; Clear registers and stack CALL PRNTCR ; Output CRLF LD (BUFFER+72+1),A ; Mark end of buffer LD (PROGST),A ; Initialise program areaMSIZE: ;LD HL,MEMMSG ; Point to message ;CALL PRS ; Output "Memory size" ;CALL PROMPT ; Get input with "?" ;CALL GETCHR ; Get next character ;OR A ; Set flags JP NZ,TSTMEM ; If number - Test if RAM there LD HL,STLOOK ; Point to start of RAMMLOOP: INC HL ; Next byte LD A,H ; Above address FFFF ? OR L JP Z,SETTOP ; Yes - 64K RAM LD A,(HL) ; Get contents LD B,A ; Save it CPL ; Flip all bits LD (HL),A ; Put it back CP (HL) ; RAM there if same LD (HL),B ; Restore old contents JP Z,MLOOP ; If RAM - test next byte JP SETTOP ; Top of RAM found
TSTMEM: CALL ATOH ; Get high memory into DE OR A ; Set flags on last byte JP NZ,SNERR ; ?SN Error if bad character EX DE,HL ; Address into HL DEC HL ; Back one byte LD A,11011001B ; Test byte LD B,(HL) ; Get old contents LD (HL),A ; Load test byte CP (HL) ; RAM there if same LD (HL),B ; Restore old contents JP NZ,MSIZE ; Ask again if no RAM
SETTOP: DEC HL ; Back one byte LD DE,STLOOK-1 ; See if enough RAM CALL CPDEHL ; Compare DE with HL JP C,MSIZE ; Ask again if not enough RAM LD DE,0-50 ; 50 Bytes string space LD (LSTRAM),HL ; Save last available RAM ADD HL,DE ; Allocate string space LD (STRSPC),HL ; Save string space CALL CLRPTR ; Clear program area LD HL,(STRSPC) ; Get end of memory LD DE,0-17 ; Offset for free bytes ADD HL,DE ; Adjust HL LD DE,PROGST ; Start of program text LD A,L ; Get LSB SUB E ; Adjust it LD L,A ; Re-save LD A,H ; Get MSB SBC A,D ; Adjust it LD H,A ; Re-save PUSH HL ; Save bytes free LD HL,SIGNON ; Sign-on message CALL PRS ; Output string POP HL ; Get bytes free back CALL PRNTHL ; Output amount of free memory LD HL,BFREE ; " Bytes free" message CALL PRS ; Output string
WARMST: LD SP,STACK ; Temporary stackBRKRET: CALL CLREG ; Clear registers and stack JP PRNTOK ; Go to get command line
BFREE: DEFB " Bytes free",CR,0,0
SIGNON: DEFB "NASCOM ROM BASIC Ver 4.7 ",CR DEFB "Copyright (C) 1978 by Microsoft",CR,0,0
MEMMSG: DEFB "Memory size",0
; FUNCTION ADDRESS TABLE
FNCTAB: DEFW SGN DEFW INT DEFW ABS DEFW USR DEFW FRE DEFW INP DEFW POS DEFW SQR DEFW RND DEFW LOG DEFW EXP DEFW COS DEFW SIN DEFW TAN DEFW ATN DEFW PEEK DEFW DEEK DEFW POINT DEFW LEN DEFW STR DEFW VAL DEFW ASC DEFW CHR DEFW LEFT DEFW RIGHT DEFW MID
; RESERVED WORD LIST
WORDS: DEFB 'E'+80H,"ND" DEFB 'F'+80H,"OR" DEFB 'N'+80H,"EXT" DEFB 'D'+80H,"ATA" DEFB 'I'+80H,"NPUT" DEFB 'D'+80H,"IM" DEFB 'R'+80H,"EAD" DEFB 'L'+80H,"ET" DEFB 'G'+80H,"OTO" DEFB 'R'+80H,"UN" DEFB 'I'+80H,"F" DEFB 'R'+80H,"ESTORE" DEFB 'G'+80H,"OSUB" DEFB 'R'+80H,"ETURN" DEFB 'R'+80H,"EM" DEFB 'S'+80H,"TOP" DEFB 'O'+80H,"UT" DEFB 'O'+80H,"N" DEFB 'N'+80H,"ULL" DEFB 'W'+80H,"AIT" DEFB 'D'+80H,"EF" DEFB 'P'+80H,"OKE" DEFB 'D'+80H,"OKE" DEFB 'S'+80H,"CREEN" DEFB 'L'+80H,"INES" DEFB 'C'+80H,"LS" DEFB 'W'+80H,"IDTH" DEFB 'M'+80H,"ONITOR" DEFB 'S'+80H,"ET" DEFB 'R'+80H,"ESET" DEFB 'P'+80H,"RINT" DEFB 'C'+80H,"ONT" DEFB 'L'+80H,"IST" DEFB 'C'+80H,"LEAR" DEFB 'C'+80H,"LOAD" DEFB 'C'+80H,"SAVE" DEFB 'N'+80H,"EW" DEFB 'T'+80H,"AB(" DEFB 'T'+80H,"O" DEFB 'F'+80H,"N" DEFB 'S'+80H,"PC(" DEFB 'T'+80H,"HEN" DEFB 'N'+80H,"OT" DEFB 'S'+80H,"TEP"
DEFB '+'+80H DEFB '-'+80H DEFB '*'+80H DEFB '/'+80H DEFB '^'+80H DEFB 'A'+80H,"ND" DEFB 'O'+80H,"R" DEFB '>'+80H DEFB '='+80H DEFB '<'+80H
DEFB 'S'+80H,"GN" DEFB 'I'+80H,"NT" DEFB 'A'+80H,"BS" DEFB 'U'+80H,"SR" DEFB 'F'+80H,"RE" DEFB 'I'+80H,"NP" DEFB 'P'+80H,"OS" DEFB 'S'+80H,"QR" DEFB 'R'+80H,"ND" DEFB 'L'+80H,"OG" DEFB 'E'+80H,"XP" DEFB 'C'+80H,"OS" DEFB 'S'+80H,"IN" DEFB 'T'+80H,"AN" DEFB 'A'+80H,"TN" DEFB 'P'+80H,"EEK" DEFB 'D'+80H,"EEK" DEFB 'P'+80H,"OINT" DEFB 'L'+80H,"EN" DEFB 'S'+80H,"TR$" DEFB 'V'+80H,"AL" DEFB 'A'+80H,"SC" DEFB 'C'+80H,"HR$" DEFB 'L'+80H,"EFT$" DEFB 'R'+80H,"IGHT$" DEFB 'M'+80H,"ID$" DEFB 80H ; End of list marker
; KEYWORD ADDRESS TABLE
WORDTB: DEFW PEND DEFW FOR DEFW NEXT DEFW DATA DEFW INPUT DEFW DIM DEFW READ DEFW LET DEFW GOTO DEFW RUN DEFW IF DEFW RESTOR DEFW GOSUB DEFW RETURN DEFW REM DEFW STOP DEFW POUT DEFW ON DEFW NULL DEFW WAIT DEFW DEF DEFW POKE DEFW DOKE DEFW SCREEN DEFW LINES DEFW CLS DEFW WIDTH DEFW MONITR DEFW PSET DEFW RESET DEFW PRINT DEFW CONT DEFW LIST DEFW CLEAR DEFW CLOAD DEFW CSAVE DEFW NEW
; RESERVED WORD TOKEN VALUES
ZEND EQU 080H ; ENDZFOR EQU 081H ; FORZDATA EQU 083H ; DATAZGOTO EQU 088H ; GOTOZGOSUB EQU 08CH ; GOSUBZREM EQU 08EH ; REMZPRINT EQU 09EH ; PRINTZNEW EQU 0A4H ; NEW
ZTAB EQU 0A5H ; TABZTO EQU 0A6H ; TOZFN EQU 0A7H ; FNZSPC EQU 0A8H ; SPCZTHEN EQU 0A9H ; THENZNOT EQU 0AAH ; NOTZSTEP EQU 0ABH ; STEP
ZPLUS EQU 0ACH ; +ZMINUS EQU 0ADH ; -ZTIMES EQU 0AEH ; *ZDIV EQU 0AFH ; /ZOR EQU 0B2H ; ORZGTR EQU 0B3H ; >ZEQUAL EQU 0B4H ; MZLTH EQU 0B5H ; <ZSGN EQU 0B6H ; SGNZPOINT EQU 0C7H ; POINTZLEFT EQU 0CDH ; LEFT$
; ARITHMETIC PRECEDENCE TABLE
PRITAB: DEFB 79H ; Precedence value DEFW PADD ; FPREG = <last> + FPREG
DEFB 79H ; Precedence value DEFW PSUB ; FPREG = <last> - FPREG
DEFB 7CH ; Precedence value DEFW MULT ; PPREG = <last> * FPREG
DEFB 7CH ; Precedence value DEFW DIV ; FPREG = <last> / FPREG
DEFB 7FH ; Precedence value DEFW POWER ; FPREG = <last> ^ FPREG
DEFB 50H ; Precedence value DEFW PAND ; FPREG = <last> AND FPREG
DEFB 46H ; Precedence value DEFW POR ; FPREG = <last> OR FPREG
; BASIC ERROR CODE LIST
ERRORS: DEFB "NF" ; NEXT without FOR DEFB "SN" ; Syntax error DEFB "RG" ; RETURN without GOSUB DEFB "OD" ; Out of DATA DEFB "FC" ; Illegal function call DEFB "OV" ; Overflow error DEFB "OM" ; Out of memory DEFB "UL" ; Undefined line DEFB "BS" ; Bad subscript DEFB "DD" ; Re-DIMensioned array DEFB "/0" ; Division by zero DEFB "ID" ; Illegal direct DEFB "TM" ; Type mis-match DEFB "OS" ; Out of string space DEFB "LS" ; String too long DEFB "ST" ; String formula too complex DEFB "CN" ; Can't CONTinue DEFB "UF" ; Undefined FN function DEFB "MO" ; Missing operand
; INITIALISATION TABLE
INITAB: JP WARMST ; Warm start jump JP FCERR ; "USR (X)" jump (Set to Error)
OUT (0),A ; "OUT p,n" skeleton RET
SUB 0 ; Division support routine LD L,A LD A,H SBC A,0 LD H,A LD A,B SBC A,0 LD B,A LD A,0 RET
DEFB 0,0,0 ; Random number seed ; Table used by RND DEFB 035H,04AH,0CAH,099H ;-2.65145E+07 DEFB 039H,01CH,076H,098H ; 1.61291E+07 DEFB 022H,095H,0B3H,098H ;-1.17691E+07 DEFB 00AH,0DDH,047H,098H ; 1.30983E+07 DEFB 053H,0D1H,099H,099H ;-2-01612E+07 DEFB 00AH,01AH,09FH,098H ;-1.04269E+07 DEFB 065H,0BCH,0CDH,098H ;-1.34831E+07 DEFB 0D6H,077H,03EH,098H ; 1.24825E+07 DEFB 052H,0C7H,04FH,080H ; Last random number
IN A,(0) ; INP (x) skeleton RET
DEFB 1 ; POS (x) number (1) DEFB 48 ; Terminal width (47) DEFB 28 ; Width for commas (3 columns) DEFB 0 ; No nulls after input bytes DEFB 0 ; Output enabled (^O off)
DEFW 5 ; Initial lines counter DEFW 5 ; Initial lines number DEFW 0 ; Array load/save check sum
DEFB 0 ; Break not by NMI DEFB 0 ; Break flag
JP TTYLIN ; Input reflection (set to TTY) JP POINTB ; POINT reflection unused JP SETB ; SET reflection JP RESETB ; RESET reflection
DEFW STLOOK ; Temp string space DEFW -2 ; Current line number (cold) DEFW PROGST+1 ; Start of program textINITBE: ; END OF INITIALISATION TABLE
ERRMSG: DEFB " Error",0INMSG: DEFB " in ",0ZERBYT EQU $-1 ; A zero byteOKMSG: DEFB "Ok",CR,0,0BRKMSG: DEFB "Break",0
BAKSTK: LD HL,4 ; Look for "FOR" block with ADD HL,SP ; same index as specifiedLOKFOR: LD A,(HL) ; Get block ID INC HL ; Point to index address CP ZFOR ; Is it a "FOR" token RET NZ ; No - exit LD C,(HL) ; BC = Address of "FOR" index INC HL LD B,(HL) INC HL ; Point to sign of STEP PUSH HL ; Save pointer to sign LD L,C ; HL = address of "FOR" index LD H,B LD A,D ; See if an index was specified OR E ; DE = 0 if no index specified EX DE,HL ; Specified index into HL JP Z,INDFND ; Skip if no index given EX DE,HL ; Index back into DE CALL CPDEHL ; Compare index with one givenINDFND: LD BC,16-3 ; Offset to next block POP HL ; Restore pointer to sign RET Z ; Return if block found ADD HL,BC ; Point to next block JP LOKFOR ; Keep on looking
MOVUP: CALL ENFMEM ; See if enough memoryMOVSTR: PUSH BC ; Save end of source EX (SP),HL ; Swap source and dest" end POP BC ; Get end of destinationMOVLP: CALL CPDEHL ; See if list moved LD A,(HL) ; Get byte LD (BC),A ; Move it RET Z ; Exit if all done DEC BC ; Next byte to move to DEC HL ; Next byte to move JP MOVLP ; Loop until all bytes moved
CHKSTK: PUSH HL ; Save code string address LD HL,(ARREND) ; Lowest free memory LD B,0 ; BC = Number of levels to test ADD HL,BC ; 2 Bytes for each level ADD HL,BC DEFB 3EH ; Skip "PUSH HL"ENFMEM: PUSH HL ; Save code string address LD A, 0D0H ;LOW -48 ; 48 Bytes minimum RAM SUB L LD L,A LD A, 0FFH ;HIGH -48 ; 48 Bytes minimum RAM SBC A,H JP C,OMERR ; Not enough - ?OM Error LD H,A ADD HL,SP ; Test if stack is overflowed POP HL ; Restore code string address RET C ; Return if enough mmoryOMERR: LD E,OM ; ?OM Error JP ERROR
DATSNR: LD HL,(DATLIN) ; Get line of current DATA item LD (LINEAT),HL ; Save as current lineSNERR: LD E,SN ; ?SN Error DEFB 01H ; Skip "LD E,DZ"DZERR: LD E,DZ ; ?/0 Error DEFB 01H ; Skip "LD E,NF"NFERR: LD E,NF ; ?NF Error DEFB 01H ; Skip "LD E,DD"DDERR: LD E,DD ; ?DD Error DEFB 01H ; Skip "LD E,UF"UFERR: LD E,UF ; ?UF Error DEFB 01H ; Skip "LD E,OVOVERR: LD E,OV ; ?OV Error DEFB 01H ; Skip "LD E,TM"TMERR: LD E,TM ; ?TM Error
ERROR: CALL CLREG ; Clear registers and stack LD (CTLOFG),A ; Enable output (A is 0) CALL STTLIN ; Start new line LD HL,ERRORS ; Point to error codes LD D,A ; D = 0 (A is 0) LD A,'?' CALL OUTC ; Output "?" ADD HL,DE ; Offset to correct error code LD A,(HL) ; First character CALL OUTC ; Output it CALL GETCHR ; Get next character CALL OUTC ; Output it LD HL,ERRMSG ; "Error" messageERRIN: CALL PRS ; Output message LD HL,(LINEAT) ; Get line of error LD DE,-2 ; Cold start error if -2 CALL CPDEHL ; See if cold start error JP Z,CSTART ; Cold start error - Restart LD A,H ; Was it a direct error? AND L ; Line = -1 if direct error INC A CALL NZ,LINEIN ; No - output line of error DEFB 3EH ; Skip "POP BC"POPNOK: POP BC ; Drop address in input buffer
PRNTOK: XOR A ; Output "Ok" and get command LD (CTLOFG),A ; Enable output CALL STTLIN ; Start new line LD HL,OKMSG ; "Ok" message CALL PRS ; Output "Ok"GETCMD: LD HL,-1 ; Flag direct mode LD (LINEAT),HL ; Save as current line CALL GETLIN ; Get an input line JP C,GETCMD ; Get line again if break CALL GETCHR ; Get first character INC A ; Test if end of line DEC A ; Without affecting Carry JP Z,GETCMD ; Nothing entered - Get another PUSH AF ; Save Carry status CALL ATOH ; Get line number into DE PUSH DE ; Save line number CALL CRUNCH ; Tokenise rest of line LD B,A ; Length of tokenised line POP DE ; Restore line number POP AF ; Restore Carry JP NC,EXCUTE ; No line number - Direct mode PUSH DE ; Save line number PUSH BC ; Save length of tokenised line XOR A LD (LSTBIN),A ; Clear last byte input CALL GETCHR ; Get next character OR A ; Set flags PUSH AF ; And save them CALL SRCHLN ; Search for line number in DE JP C,LINFND ; Jump if line found POP AF ; Get status PUSH AF ; And re-save JP Z,ULERR ; Nothing after number - Error OR A ; Clear CarryLINFND: PUSH BC ; Save address of line in prog JP NC,INEWLN ; Line not found - Insert new EX DE,HL ; Next line address in DE LD HL,(PROGND) ; End of programSFTPRG: LD A,(DE) ; Shift rest of program down LD (BC),A INC BC ; Next destination INC DE ; Next source CALL CPDEHL ; All done? JP NZ,SFTPRG ; More to do LD H,B ; HL - New end of program LD L,C LD (PROGND),HL ; Update end of program
INEWLN: POP DE ; Get address of line, POP AF ; Get status JP Z,SETPTR ; No text - Set up pointers LD HL,(PROGND) ; Get end of program EX (SP),HL ; Get length of input line POP BC ; End of program to BC ADD HL,BC ; Find new end PUSH HL ; Save new end CALL MOVUP ; Make space for line POP HL ; Restore new end LD (PROGND),HL ; Update end of program pointer EX DE,HL ; Get line to move up in HL LD (HL),H ; Save MSB POP DE ; Get new line number INC HL ; Skip pointer INC HL LD (HL),E ; Save LSB of line number INC HL LD (HL),D ; Save MSB of line number INC HL ; To first byte in line LD DE,BUFFER ; Copy buffer to programMOVBUF: LD A,(DE) ; Get source LD (HL),A ; Save destinations INC HL ; Next source INC DE ; Next destination OR A ; Done? JP NZ,MOVBUF ; No - RepeatSETPTR: CALL RUNFST ; Set line pointers INC HL ; To LSB of pointer EX DE,HL ; Address to DEPTRLP: LD H,D ; Address to HL LD L,E LD A,(HL) ; Get LSB of pointer INC HL ; To MSB of pointer OR (HL) ; Compare with MSB pointer JP Z,GETCMD ; Get command line if end INC HL ; To LSB of line number INC HL ; Skip line number INC HL ; Point to first byte in line XOR A ; Looking for 00 byteFNDEND: CP (HL) ; Found end of line? INC HL ; Move to next byte JP NZ,FNDEND ; No - Keep looking EX DE,HL ; Next line address to HL LD (HL),E ; Save LSB of pointer INC HL LD (HL),D ; Save MSB of pointer JP PTRLP ; Do next line
SRCHLN: LD HL,(BASTXT) ; Start of program textSRCHLP: LD B,H ; BC = Address to look at LD C,L LD A,(HL) ; Get address of next line INC HL OR (HL) ; End of program found? DEC HL RET Z ; Yes - Line not found INC HL INC HL LD A,(HL) ; Get LSB of line number INC HL LD H,(HL) ; Get MSB of line number LD L,A CALL CPDEHL ; Compare with line in DE LD H,B ; HL = Start of this line LD L,C LD A,(HL) ; Get LSB of next line address INC HL LD H,(HL) ; Get MSB of next line address LD L,A ; Next line to HL CCF RET Z ; Lines found - Exit CCF RET NC ; Line not found,at line after JP SRCHLP ; Keep looking
NEW: RET NZ ; Return if any more on lineCLRPTR: LD HL,(BASTXT) ; Point to start of program XOR A ; Set program area to empty LD (HL),A ; Save LSB = 00 INC HL LD (HL),A ; Save MSB = 00 INC HL LD (PROGND),HL ; Set program end
RUNFST: LD HL,(BASTXT) ; Clear all variables DEC HL
INTVAR: LD (BRKLIN),HL ; Initialise RUN variables LD HL,(LSTRAM) ; Get end of RAM LD (STRBOT),HL ; Clear string space XOR A CALL RESTOR ; Reset DATA pointers LD HL,(PROGND) ; Get end of program LD (VAREND),HL ; Clear variables LD (ARREND),HL ; Clear arrays
CLREG: POP BC ; Save return address LD HL,(STRSPC) ; Get end of working RAN LD SP,HL ; Set stack LD HL,TMSTPL ; Temporary string pool LD (TMSTPT),HL ; Reset temporary string ptr XOR A ; A = 00 LD L,A ; HL = 0000 LD H,A LD (CONTAD),HL ; No CONTinue LD (FORFLG),A ; Clear FOR flag LD (FNRGNM),HL ; Clear FN argument PUSH HL ; HL = 0000 PUSH BC ; Put back returnDOAGN: LD HL,(BRKLIN) ; Get address of code to RUN RET ; Return to execution driver
PROMPT: LD A,'?' ; "?" CALL OUTC ; Output character LD A,' ' ; Space CALL OUTC ; Output character JP RINPUT ; Get input line
CRUNCH: XOR A ; Tokenise line @ HL to BUFFER LD (DATFLG),A ; Reset literal flag LD C,2+3 ; 2 byte number and 3 nulls LD DE,BUFFER ; Start of input bufferCRNCLP: LD A,(HL) ; Get byte CP ' ' ; Is it a space? JP Z,MOVDIR ; Yes - Copy direct LD B,A ; Save character CP '"' ; Is it a quote? JP Z,CPYLIT ; Yes - Copy literal string OR A ; Is it end of buffer? JP Z,ENDEFBUF ; Yes - End buffer LD A,(DATFLG) ; Get data type OR A ; Literal? LD A,(HL) ; Get byte to copy JP NZ,MOVDIR ; Literal - Copy direct CP '?' ; Is it "?" short for PRINT LD A,ZPRINT ; "PRINT" token JP Z,MOVDIR ; Yes - replace it LD A,(HL) ; Get byte again CP '0' ; Is it less than "0" JP C,FNDEFWRD ; Yes - Look for reserved words CP ';'+1 ; Is it "0123456789:;" ? JP C,MOVDIR ; Yes - copy it directFNDEFWRD: PUSH DE ; Look for reserved words LD DE,WORDS-1 ; Point to table PUSH BC ; Save count LD BC,RETNAD ; Where to return to PUSH BC ; Save return address LD B,ZEND-1 ; First token value -1 LD A,(HL) ; Get byte CP 'a' ; Less than "a" ? JP C,SEARCH ; Yes - search for words CP 'z'+1 ; Greater than "z" ? JP NC,SEARCH ; Yes - search for words AND 01011111B ; Force upper case LD (HL),A ; Replace byteSEARCH: LD C,(HL) ; Search for a word EX DE,HLGETNXT: INC HL ; Get next reserved word OR (HL) ; Start of word? JP P,GETNXT ; No - move on INC B ; Increment token value LD A, (HL) ; Get byte from table AND 01111111B ; Strip bit 7 RET Z ; Return if end of list CP C ; Same character as in buffer? JP NZ,GETNXT ; No - get next word EX DE,HL PUSH HL ; Save start of word
NXTBYT: INC DE ; Look through rest of word LD A,(DE) ; Get byte from table OR A ; End of word ? JP M,MATCH ; Yes - Match found LD C,A ; Save it LD A,B ; Get token value CP ZGOTO ; Is it "GOTO" token ? JP NZ,NOSPC ; No - Don't allow spaces CALL GETCHR ; Get next character DEC HL ; Cancel increment from GETCHRNOSPC: INC HL ; Next byte LD A,(HL) ; Get byte CP 'a' ; Less than "a" ? JP C,NOCHNG ; Yes - don't change AND 01011111B ; Make upper caseNOCHNG: CP C ; Same as in buffer ? JP Z,NXTBYT ; Yes - keep testing POP HL ; Get back start of word JP SEARCH ; Look at next word
MATCH: LD C,B ; Word found - Save token value POP AF ; Throw away return EX DE,HL RET ; Return to "RETNAD"RETNAD: EX DE,HL ; Get address in string LD A,C ; Get token value POP BC ; Restore buffer length POP DE ; Get destination addressMOVDIR: INC HL ; Next source in buffer LD (DE),A ; Put byte in buffer INC DE ; Move up buffer INC C ; Increment length of buffer SUB ':' ; End of statement? JP Z,SETLIT ; Jump if multi-statement line CP ZDATA-3AH ; Is it DATA statement ? JP NZ,TSTREM ; No - see if REMSETLIT: LD (DATFLG),A ; Set literal flagTSTREM: SUB ZREM-3AH ; Is it REM? JP NZ,CRNCLP ; No - Leave flag LD B,A ; Copy rest of bufferNXTCHR: LD A,(HL) ; Get byte OR A ; End of line ? JP Z,ENDEFBUF ; Yes - Terminate buffer CP B ; End of statement ? JP Z,MOVDIR ; Yes - Get next oneCPYLIT: INC HL ; Move up source string LD (DE),A ; Save in destination INC C ; Increment length INC DE ; Move up destination JP NXTCHR ; Repeat
ENDEFBUF: LD HL,BUFFER-1 ; Point to start of buffer LD (DE),A ; Mark end of buffer (A = 00) INC DE LD (DE),A ; A = 00 INC DE LD (DE),A ; A = 00 RET
DODEL: LD A,(NULFLG) ; Get null flag status OR A ; Is it zero? LD A,0 ; Zero A - Leave flags LD (NULFLG),A ; Zero null flag JP NZ,ECHDEL ; Set - Echo it DEC B ; Decrement length JP Z,GETLIN ; Get line again if empty CALL OUTC ; Output null character DEFB 3EH ; Skip "DEC B"ECHDEL: DEC B ; Count bytes in buffer DEC HL ; Back space buffer JP Z,OTKLN ; No buffer - Try again LD A,(HL) ; Get deleted byte CALL OUTC ; Echo it JP MORINP ; Get more input
DELCHR: DEC B ; Count bytes in buffer DEC HL ; Back space buffer CALL OUTC ; Output character in A JP NZ,MORINP ; Not end - Get moreOTKLN: CALL OUTC ; Output character in AKILIN: CALL PRNTCR ; Output CRLF JP TTYLIN ; Get line again
GETLIN: ;CALL MONTST ; Is it NAS-SYS? JP TTYLIN ; Z,TTYLIN ; No - Character input ; LD HL,(CIN) ; Point to NAS-SYS input table ;LD A,(HL) ; Get input mode ;CP 74H ; Is it "X" mode? ;JP Z,TTYLIN ; Yes - Teletype line input ;CALL INLINE ; Get a line from NAS-SYS ; JP DONULL ; POS(X)=0 and do nulls
TTYLIN: LD HL,BUFFER ; Get a line by character LD B,1 ; Set buffer as empty XOR A LD (NULFLG),A ; Clear null flagMORINP: CALL CLOTST ; Get character and test ^O LD C,A ; Save character in C CP DEL ; Delete character? JP Z,DODEL ; Yes - Process it LD A,(NULFLG) ; Get null flag OR A ; Test null flag status JP Z,PROCES ; Reset - Process character LD A,0 ; Set a null CALL OUTC ; Output null XOR A ; Clear A LD (NULFLG),A ; Reset null flagPROCES: LD A,C ; Get character CP CTRLG ; Bell? JP Z,PUTCTL ; Yes - Save it CP CTRLC ; Is it control "C"? CALL Z,PRNTCR ; Yes - Output CRLF SCF ; Flag break RET Z ; Return if control "C" CP CR ; Is it enter? JP Z,ENDINP ; Yes - Terminate input CP CTRLU ; Is it control "U"? JP Z,KILIN ; Yes - Get another line CP '@' ; Is it "kill line"? JP Z,OTKLN ; Yes - Kill line CP '_' ; Is it delete? JP Z,DELCHR ; Yes - Delete character CP BKSP ; Is it backspace? JP Z,DELCHR ; Yes - Delete character CP CTRLR ; Is it control "R"? JP NZ,PUTBUF ; No - Put in buffer PUSH BC ; Save buffer length PUSH DE ; Save DE PUSH HL ; Save buffer address LD (HL),0 ; Mark end of buffer CALL OUTNCR ; Output and do CRLF LD HL,BUFFER ; Point to buffer start CALL PRS ; Output buffer POP HL ; Restore buffer address POP DE ; Restore DE POP BC ; Restore buffer length JP MORINP ; Get another character
PUTBUF: CP ' ' ; Is it a control code? JP C,MORINP ; Yes - IgnorePUTCTL: LD A,B ; Get number of bytes in buffer CP 72+1 ; Test for line overflow LD A,CTRLG ; Set a bell JP NC,OUTNBS ; Ring bell if buffer full LD A,C ; Get character LD (HL),C ; Save in buffer LD (LSTBIN),A ; Save last input byte INC HL ; Move up buffer INC B ; Increment lengthOUTIT: CALL OUTC ; Output the character entered JP MORINP ; Get another character
OUTNBS: CALL OUTC ; Output bell and back over it LD A,BKSP ; Set back space JP OUTIT ; Output it and get more
CPDEHL: LD A,H ; Get H SUB D ; Compare with D RET NZ ; Different - Exit LD A,L ; Get L SUB E ; Compare with E RET ; Return status
CHKSYN: LD A,(HL) ; Check syntax of character EX (SP),HL ; Address of test byte CP (HL) ; Same as in code string? INC HL ; Return address EX (SP),HL ; Put it back JP Z,GETCHR ; Yes - Get next character JP SNERR ; Different - ?SN Error
OUTC: PUSH AF ; Save character LD A,(CTLOFG) ; Get control "O" flag OR A ; Is it set? JP NZ,POPAF ; Yes - don't output POP AF ; Restore character PUSH BC ; Save buffer length PUSH AF ; Save character CP ' ' ; Is it a control code? JP C,DINPOS ; Yes - Don't INC POS(X) LD A,(LWIDTH) ; Get line width LD B,A ; To B LD A,(CURPOS) ; Get cursor position INC B ; Width 255? JP Z,INCLEN ; Yes - No width limit DEC B ; Restore width CP B ; At end of line? CALL Z,PRNTCR ; Yes - output CRLFINCLEN: INC A ; Move on one character LD (CURPOS),A ; Save new positionDINPOS: POP AF ; Restore character POP BC ; Restore buffer length PUSH AF ; << This sequence >> POP AF ; << is not needed >> PUSH AF ; Save character PUSH BC ; Save buffer length LD C,A ; Character to C CALL CONMON ; Send it POP BC ; Restore buffer length POP AF ; Restore character RET
CLOTST: CALL GETINP ; Get input character AND 01111111B ; Strip bit 7 CP CTRLO ; Is it control "O"? RET NZ ; No don't flip flag LD A,(CTLOFG) ; Get flag CPL ; Flip it LD (CTLOFG),A ; Put it back XOR A ; Null character RET
LIST: CALL ATOH ; ASCII number to DE RET NZ ; Return if anything extra POP BC ; Rubbish - Not needed CALL SRCHLN ; Search for line number in DE PUSH BC ; Save address of line CALL SETLIN ; Set up lines counterLISTLP: POP HL ; Restore address of line LD C,(HL) ; Get LSB of next line INC HL LD B,(HL) ; Get MSB of next line INC HL LD A,B ; BC = 0 (End of program)? OR C JP Z,PRNTOK ; Yes - Go to command mode CALL COUNT ; Count lines CALL TSTBRK ; Test for break key PUSH BC ; Save address of next line CALL PRNTCR ; Output CRLF LD E,(HL) ; Get LSB of line number INC HL LD D,(HL) ; Get MSB of line number INC HL PUSH HL ; Save address of line start EX DE,HL ; Line number to HL CALL PRNTHL ; Output line number in decimal LD A,' ' ; Space after line number POP HL ; Restore start of line addressLSTLP2: CALL OUTC ; Output character in ALSTLP3: LD A,(HL) ; Get next byte in line OR A ; End of line? INC HL ; To next byte in line JP Z,LISTLP ; Yes - get next line JP P,LSTLP2 ; No token - output it SUB ZEND-1 ; Find and output word LD C,A ; Token offset+1 to C LD DE,WORDS ; Reserved word listFNDTOK: LD A,(DE) ; Get character in list INC DE ; Move on to next OR A ; Is it start of word? JP P,FNDTOK ; No - Keep looking for word DEC C ; Count words JP NZ,FNDTOK ; Not there - keep lookingOUTWRD: AND 01111111B ; Strip bit 7 CALL OUTC ; Output first character LD A,(DE) ; Get next character INC DE ; Move on to next OR A ; Is it end of word? JP P,OUTWRD ; No - output the rest JP LSTLP3 ; Next byte in line
SETLIN: PUSH HL ; Set up LINES counter LD HL,(LINESN) ; Get LINES number LD (LINESC),HL ; Save in LINES counter POP HL RET
LDNMI1: LD HL,BREAK ; Break routine ; LD (NMI),HL ; NMI forces break JP PRNTOK ; Go to command mode
DEFB 0FEH ; <<< NO REFERENCE TO HERE >>>
COUNT: PUSH HL ; Save code string address PUSH DE LD HL,(LINESC) ; Get LINES counter LD DE,-1 ADC HL,DE ; Decrement LD (LINESC),HL ; Put it back POP DE POP HL ; Restore code string address RET P ; Return if more lines to go PUSH HL ; Save code string address LD HL,(LINESN) ; Get LINES number LD (LINESC),HL ; Reset LINES counter LD A,(NMIFLG) ; Break by NMI? OR A JP NZ,ARETN ; Yes - "RETN" CALL GETINP ; Get input character CP CTRLC ; Is it control "C"? JP Z,RSLNBK ; Yes - Reset LINES an break POP HL ; Restore code string address JP COUNT ; Keep on counting
RSLNBK: LD HL,(LINESN) ; Get LINES number LD (LINESC),HL ; Reset LINES counter JP BRKRET ; Go and output "Break"
FOR: LD A,64H ; Flag "FOR" assignment LD (FORFLG),A ; Save "FOR" flag CALL LET ; Set up initial index POP BC ; Drop RETurn address PUSH HL ; Save code string address CALL DATA ; Get next statement address LD (LOOPST),HL ; Save it for start of lo6p LD HL,2 ; Offset for "FOR" block ADD HL,SP ; Point to itFORSLP: CALL LOKFOR ; Look for existing "FOR" block POP DE ; Get code string address JP NZ,FORFND ; No nesting found ADD HL,BC ; Move into "FOR" block PUSH DE ; Save code string address DEC HL LD D,(HL) ; Get MSB of loop statement DEC HL LD E,(HL) ; Get LSB of loop statement INC HL INC HL PUSH HL ; Save block address LD HL,(LOOPST) ; Get address of loop statement CALL CPDEHL ; Compare the FOR loops POP HL ; Restore block address JP NZ,FORSLP ; Different FORs - Find another POP DE ; Restore code string address LD SP,HL ; Remove all nested loops
FORFND: EX DE,HL ; Code string address to HL LD C,8 CALL CHKSTK ; Check for 8 levels of stack PUSH HL ; Save code string address LD HL,(LOOPST) ; Get first statement of loop EX (SP),HL ; Save and restore code string PUSH HL ; Re-save code string address LD HL,(LINEAT) ; Get current line number EX (SP),HL ; Save and restore code string CALL TSTNUM ; Make sure it's a number CALL CHKSYN ; Make sure "TO" is next DEFB ZTO ; "TO" token CALL GETNUM ; Get "TO" expression value PUSH HL ; Save code string address CALL BCDEFP ; Move "TO" value to BCDE POP HL ; Restore code string address PUSH BC ; Save "TO" value in block PUSH DE LD BC,8100H ; BCDE - 1 (default STEP) LD D,C ; C=0 LD E,D ; D=0 LD A,(HL) ; Get next byte in code string CP ZSTEP ; See if "STEP" is stated LD A,1 ; Sign of step = 1 JP NZ,SAVSTP ; No STEP given - Default to 1 CALL GETCHR ; Jump over "STEP" token CALL GETNUM ; Get step value PUSH HL ; Save code string address CALL BCDEFP ; Move STEP to BCDE CALL TSTSGN ; Test sign of FPREG POP HL ; Restore code string addressSAVSTP: PUSH BC ; Save the STEP value in block PUSH DE PUSH AF ; Save sign of STEP INC SP ; Don't save flags PUSH HL ; Save code string address LD HL,(BRKLIN) ; Get address of index variable EX (SP),HL ; Save and restore code stringPUTFID: LD B,ZFOR ; "FOR" block marker PUSH BC ; Save it INC SP ; Don't save C
RUNCNT: CALL CHKBRK ; Execution driver - Test break OR A ; Break key hit? CALL NZ,STALL ; Yes - Pause for a key LD (BRKLIN),HL ; Save code address for break LD A,(HL) ; Get next byte in code string CP ':' ; Multi statement line? JP Z,EXCUTE ; Yes - Execute it OR A ; End of line? JP NZ,SNERR ; No - Syntax error INC HL ; Point to address of next line LD A,(HL) ; Get LSB of line pointer INC HL OR (HL) ; Is it zero (End of prog)? JP Z,ENDPRG ; Yes - Terminate execution INC HL ; Point to line number LD E,(HL) ; Get LSB of line number INC HL LD D,(HL) ; Get MSB of line number EX DE,HL ; Line number to HL LD (LINEAT),HL ; Save as current line number EX DE,HL ; Line number back to DEEXCUTE: CALL GETCHR ; Get key word LD DE,RUNCNT ; Where to RETurn to PUSH DE ; Save for RETurnIFJMP: RET Z ; Go to RUNCNT if end of STMTONJMP: SUB ZEND ; Is it a token? JP C,LET ; No - try to assign it CP ZNEW+1-ZEND ; END to NEW ? JP NC,SNERR ; Not a key word - ?SN Error RLCA ; Double it LD C,A ; BC = Offset into table LD B,0 EX DE,HL ; Save code string address LD HL,WORDTB ; Keyword address table ADD HL,BC ; Point to routine address LD C,(HL) ; Get LSB of routine address INC HL LD B,(HL) ; Get MSB of routine address PUSH BC ; Save routine address EX DE,HL ; Restore code string address
GETCHR: INC HL ; Point to next character LD A,(HL) ; Get next code string byte CP ':' ; Z if ":" RET NC ; NC if > "9" CP ' ' JP Z,GETCHR ; Skip over spaces CP '0' CCF ; NC if < "0" INC A ; Test for zero - Leave carry DEC A ; Z if Null RET
RESTOR: EX DE,HL ; Save code string address LD HL,(BASTXT) ; Point to start of program JP Z,RESTNL ; Just RESTORE - reset pointer EX DE,HL ; Restore code string address CALL ATOH ; Get line number to DE PUSH HL ; Save code string address CALL SRCHLN ; Search for line number in DE LD H,B ; HL = Address of line LD L,C POP DE ; Restore code string address JP NC,ULERR ; ?UL Error if not foundRESTNL: DEC HL ; Byte before DATA statementUPDATA: LD (NXTDAT),HL ; Update DATA pointer EX DE,HL ; Restore code string address RET
TSTBRK: CALL CHKBRK ; Test for interrupts OR A RET Z ; Return if no key pressedSTALL: CALL CLOTST ; Get input and test for ^O CP CTRLS ; Is it control "S" CALL Z,CLOTST ; Yes - Get another character CP CTRLC ; Return if not control "C"STOP: RET NZ ; Exit if anything else DEFB 0F6H ; Flag "STOP"PEND: RET NZ ; Exit if anything else LD (BRKLIN),HL ; Save point of break DEFB 21H ; Skip "OR 11111111B"INPBRK: OR 11111111B ; Flag "Break" wanted POP BC ; Return not needed and moreENDPRG: LD HL,(LINEAT) ; Get current line number PUSH AF ; Save STOP / END status LD A,L ; Is it direct break? AND H INC A ; Line is -1 if direct break JP Z,NOLIN ; Yes - No line number LD (ERRLIN),HL ; Save line of break LD HL,(BRKLIN) ; Get point of break LD (CONTAD),HL ; Save point to CONTinueNOLIN: XOR A LD (CTLOFG),A ; Enable output CALL STTLIN ; Start a new line POP AF ; Restore STOP / END status LD HL,BRKMSG ; "Break" message JP NZ,ERRIN ; "in line" wanted? JP PRNTOK ; Go to command mode
CONT: LD HL,(CONTAD) ; Get CONTinue address LD A,H ; Is it zero? OR L LD E,CN ; ?CN Error JP Z,ERROR ; Yes - output "?CN Error" EX DE,HL ; Save code string address LD HL,(ERRLIN) ; Get line of last break LD (LINEAT),HL ; Set up current line number EX DE,HL ; Restore code string address RET ; CONTinue where left off
NULL: CALL GETINT ; Get integer 0-255 RET NZ ; Return if bad value LD (NULLS),A ; Set nulls number RET
ARRLD1: LD B,-1 ; Flag array loadARRSV1: CALL GETCHR ; Skip "*" LD A,B ; CLOAD* or CSAVE* LD (BRKLIN),A ; Save it LD A,1 ; It's an array LD (FORFLG),A ; Flag array name CALL GETVAR ; Get address of array name PUSH HL ; Save code string address LD (FORFLG),A ; Clear flag LD H,B ; Address of array to HL LD L,C DEC BC ; Back space DEC BC ; to point DEC BC ; to the DEC BC ; array name LD A,(BRKLIN) ; CLOAD* or CSAVE* ? OR A PUSH AF ; Save CLOAD* / CSAVE* status EX DE,HL ; Array data length ADD HL,DE ; End of data EX DE,HL ; To DE LD C,(HL) ; Get dimension bytes LD B,0 ADD HL,BC ; 2 Bytes each dimension ADD HL,BC INC HL ; Over number of dimensions PUSH HL ; Address of array data PUSH DE ; End of array data PUSH BC ; Number of dimensions LD A,(BRKLIN) ; CLOAD* or CSAVE* ? CP -1 CALL Z,CASFF ; CLOAD* - Cassette on LD A,(BRKLIN) ; CLOAD* or CSAVE* ? CP -1 CALL NZ,CASFFW ; CSAVE* - Cassette on and wait NOP NOP NOP LD HL,0 LD (CHKSUM),HL ; Zero check sum POP BC ; Number of dimensions POP DE ; End of array data POP HL ; Address of array data LD B,11010010B ; Header byte JP JPLDSV ; CSAVE-SNDHDR , CLOAD-GETHDR
SNDHDR: LD A,B ; Get header byte CALL WUART2 ; Send 2 bytes to UART CALL WUART2 ; Send 2 bytes to UART JP SNDARY ; Send array data
GETHDR: LD C,4 ; 4 Bytes to checkHDRLP: CALL RUART ; Read byte from UART CP B ; Same as header? JP NZ,GETHDR ; No - Wait for another DEC C ; Count bytes JP NZ,HDRLP ; More neededSNDARY: CALL TSTNUM ; Check it's a numerical arrayARYLP: CALL CPDEHL ; All array data done JP Z,SUMOFF ; Yes - Do check sum POP AF ; CLOAD* or CSAVE* ? PUSH AF ; Re-save flags LD A,(HL) ; Get byte CALL P,WUART ; CSAVE* - Write byte CALL M,RUART ; CLOAD* - Read byte LD (HL),A ; Save byte in case of CLOAD* CALL ACCSUM ; Accumulate check sum INC HL ; Next byte JP ARYLP ; Repeat
SUMOFF: CALL DOSUM ; Do check sum CALL CASFF ; Cassette off POP AF ; Not needed any more POP HL ; Restore code string address RET
ACCSUM: PUSH HL ; Save address in array LD HL,(CHKSUM) ; Get check sum LD B,0 ; BC - Value of byte LD C,A ADD HL,BC ; Add byte to check sum LD (CHKSUM),HL ; Re-save check sum POP HL ; Restore address in array RET
DOSUM: LD A,(BRKLIN) ; CLOAD* or CSAVE* ? OR A JP M,CHSUMS ; CLOAD* - Check if sums match LD A,(CHKSUM) ; Get LSB of check sum CALL WUART ; Write to UART LD A,(CHKSUM+1) ; Get MSB of check sum JP WUART ; Write to UART and return
CHSUMS: CALL RUART ; Read LSB of check sum PUSH AF ; Save it CALL RUART ; Read MSB of check sum POP BC ; LSB to B LD E,B ; LSB to E LD D,A ; MSB to D LD HL,(CHKSUM) ; Get accumulated check sum CALL CPDEHL ; Are they the same? RET Z ; Yes - End CLOAD* CALL CASFF ; Cassette off JP OUTBAD ; Different - Output "Bad"
CHKLTR: LD A,(HL) ; Get byte CP 'A' ; < "A" ? RET C ; Carry set if not letter CP 'Z'+1 ; > "Z" ? CCF RET ; Carry set if not letter
FPSINT: CALL GETCHR ; Get next characterPOSINT: CALL GETNUM ; Get integer 0 to 32767DEPINT: CALL TSTSGN ; Test sign of FPREG JP M,FCERR ; Negative - ?FC ErrorDEINT: LD A,(FPEXP) ; Get integer value to DE CP 80H+16 ; Exponent in range (16 bits)? JP C,FPINT ; Yes - convert it LD BC,9080H ; BCDE = -32768 LD DE,0000 PUSH HL ; Save code string address CALL CMPNUM ; Compare FPREG with BCDE POP HL ; Restore code string address LD D,C ; MSB to D RET Z ; Return if in rangeFCERR: LD E,FC ; ?FC Error JP ERROR ; Output error-
ATOH: DEC HL ; ASCII number to DE binaryGETLN: LD DE,0 ; Get number to DEGTLNLP: CALL GETCHR ; Get next character RET NC ; Exit if not a digit PUSH HL ; Save code string address PUSH AF ; Save digit LD HL,65529/10 ; Largest number 65529 CALL CPDEHL ; Number in range? JP C,SNERR ; No - ?SN Error LD H,D ; HL = Number LD L,E ADD HL,DE ; Times 2 ADD HL,HL ; Times 4 ADD HL,DE ; Times 5 ADD HL,HL ; Times 10 POP AF ; Restore digit SUB '0' ; Make it 0 to 9 LD E,A ; DE = Value of digit LD D,0 ADD HL,DE ; Add to number EX DE,HL ; Number to DE POP HL ; Restore code string address JP GTLNLP ; Go to next character
CLEAR: JP Z,INTVAR ; Just "CLEAR" Keep parameters CALL POSINT ; Get integer 0 to 32767 to DE DEC HL ; Cancel increment CALL GETCHR ; Get next character PUSH HL ; Save code string address LD HL,(LSTRAM) ; Get end of RAM JP Z,STORED ; No value given - Use stored POP HL ; Restore code string address CALL CHKSYN ; Check for comma DEFB ',' PUSH DE ; Save number CALL POSINT ; Get integer 0 to 32767 DEC HL ; Cancel increment CALL GETCHR ; Get next character JP NZ,SNERR ; ?SN Error if more on line EX (SP),HL ; Save code string address EX DE,HL ; Number to DESTORED: LD A,L ; Get LSB of new RAM top SUB E ; Subtract LSB of string space LD E,A ; Save LSB LD A,H ; Get MSB of new RAM top SBC A,D ; Subtract MSB of string space LD D,A ; Save MSB JP C,OMERR ; ?OM Error if not enough mem PUSH HL ; Save RAM top LD HL,(PROGND) ; Get program end LD BC,40 ; 40 Bytes minimum working RAM ADD HL,BC ; Get lowest address CALL CPDEHL ; Enough memory? JP NC,OMERR ; No - ?OM Error EX DE,HL ; RAM top to HL LD (STRSPC),HL ; Set new string space POP HL ; End of memory to use LD (LSTRAM),HL ; Set new top of RAM POP HL ; Restore code string address JP INTVAR ; Initialise variables
RUN: JP Z,RUNFST ; RUN from start if just RUN CALL INTVAR ; Initialise variables LD BC,RUNCNT ; Execution driver loop JP RUNLIN ; RUN from line number
GOSUB: LD C,3 ; 3 Levels of stack needed CALL CHKSTK ; Check for 3 levels of stack POP BC ; Get return address PUSH HL ; Save code string for RETURN PUSH HL ; And for GOSUB routine LD HL,(LINEAT) ; Get current line EX (SP),HL ; Into stack - Code string out LD A,ZGOSUB ; "GOSUB" token PUSH AF ; Save token INC SP ; Don't save flags
RUNLIN: PUSH BC ; Save return addressGOTO: CALL ATOH ; ASCII number to DE binary CALL REM ; Get end of line PUSH HL ; Save end of line LD HL,(LINEAT) ; Get current line CALL CPDEHL ; Line after current? POP HL ; Restore end of line INC HL ; Start of next line CALL C,SRCHLP ; Line is after current line CALL NC,SRCHLN ; Line is before current line LD H,B ; Set up code string address LD L,C DEC HL ; Incremented after RET C ; Line foundULERR: LD E,UL ; ?UL Error JP ERROR ; Output error message
RETURN: RET NZ ; Return if not just RETURN LD D,-1 ; Flag "GOSUB" search CALL BAKSTK ; Look "GOSUB" block LD SP,HL ; Kill all FORs in subroutine CP ZGOSUB ; Test for "GOSUB" token LD E,RG ; ?RG Error JP NZ,ERROR ; Error if no "GOSUB" found POP HL ; Get RETURN line number LD (LINEAT),HL ; Save as current INC HL ; Was it from direct statement? LD A,H OR L ; Return to line JP NZ,RETLIN ; No - Return to line LD A,(LSTBIN) ; Any INPUT in subroutine? OR A ; If so buffer is corrupted JP NZ,POPNOK ; Yes - Go to command modeRETLIN: LD HL,RUNCNT ; Execution driver loop EX (SP),HL ; Into stack - Code string out DEFB 3EH ; Skip "POP HL"NXTDTA: POP HL ; Restore code string address
DATA: DEFB 01H,3AH ; ":" End of statementREM: LD C,0 ; 00 End of statement LD B,0NXTSTL: LD A,C ; Statement and byte LD C,B LD B,A ; Statement end byteNXTSTT: LD A,(HL) ; Get byte OR A ; End of line? RET Z ; Yes - Exit CP B ; End of statement? RET Z ; Yes - Exit INC HL ; Next byte CP '"' ; Literal string? JP Z,NXTSTL ; Yes - Look for another '"' JP NXTSTT ; Keep looking
LET: CALL GETVAR ; Get variable name CALL CHKSYN ; Make sure "=" follows DEFB ZEQUAL ; "=" token PUSH DE ; Save address of variable LD A,(TYPE) ; Get data type PUSH AF ; Save type CALL EVAL ; Evaluate expression POP AF ; Restore type EX (SP),HL ; Save code - Get var addr LD (BRKLIN),HL ; Save address of variable RRA ; Adjust type CALL CHKTYP ; Check types are the same JP Z,LETNUM ; Numeric - Move valueLETSTR: PUSH HL ; Save address of string var LD HL,(FPREG) ; Pointer to string entry PUSH HL ; Save it on stack INC HL ; Skip over length INC HL LD E,(HL) ; LSB of string address INC HL LD D,(HL) ; MSB of string address LD HL,(BASTXT) ; Point to start of program CALL CPDEHL ; Is string before program? JP NC,CRESTR ; Yes - Create string entry LD HL,(STRSPC) ; Point to string space CALL CPDEHL ; Is string literal in program? POP DE ; Restore address of string JP NC,MVSTPT ; Yes - Set up pointer LD HL,TMPSTR ; Temporary string pool CALL CPDEHL ; Is string in temporary pool? JP NC,MVSTPT ; No - Set up pointer DEFB 3EH ; Skip "POP DE"CRESTR: POP DE ; Restore address of string CALL BAKTMP ; Back to last tmp-str entry EX DE,HL ; Address of string entry CALL SAVSTR ; Save string in string areaMVSTPT: CALL BAKTMP ; Back to last tmp-str entry POP HL ; Get string pointer CALL DETHL4 ; Move string pointer to var POP HL ; Restore code string address RET
LETNUM: PUSH HL ; Save address of variable CALL FPTHL ; Move value to variable POP DE ; Restore address of variable POP HL ; Restore code string address RET
ON: CALL GETINT ; Get integer 0-255 LD A,(HL) ; Get "GOTO" or "GOSUB" token LD B,A ; Save in B CP ZGOSUB ; "GOSUB" token? JP Z,ONGO ; Yes - Find line number CALL CHKSYN ; Make sure it's "GOTO" DEFB ZGOTO ; "GOTO" token DEC HL ; Cancel incrementONGO: LD C,E ; Integer of branch valueONGOLP: DEC C ; Count branches LD A,B ; Get "GOTO" or "GOSUB" token JP Z,ONJMP ; Go to that line if right one CALL GETLN ; Get line number to DE CP ',' ; Another line number? RET NZ ; No - Drop through JP ONGOLP ; Yes - loop
IF: CALL EVAL ; Evaluate expression LD A,(HL) ; Get token CP ZGOTO ; "GOTO" token? JP Z,IFGO ; Yes - Get line CALL CHKSYN ; Make sure it's "THEN" DEFB ZTHEN ; "THEN" token DEC HL ; Cancel incrementIFGO: CALL TSTNUM ; Make sure it's numeric CALL TSTSGN ; Test state of expression JP Z,REM ; False - Drop through CALL GETCHR ; Get next character JP C,GOTO ; Number - GOTO that line JP IFJMP ; Otherwise do statement
MRPRNT: DEC HL ; DEC 'cos GETCHR INCs CALL GETCHR ; Get next characterPRINT: JP Z,PRNTCR ; CRLF if just PRINTPRNTLP: RET Z ; End of list - Exit CP ZTAB ; "TAB(" token? JP Z,DOTAB ; Yes - Do TAB routine CP ZSPC ; "SPC(" token? JP Z,DOTAB ; Yes - Do SPC routine PUSH HL ; Save code string address CP ',' ; Comma? JP Z,DOCOM ; Yes - Move to next zone CP ';' ; Semi-colon? JP Z,NEXITM ; Do semi-colon routine POP BC ; Code string address to BC CALL EVAL ; Evaluate expression PUSH HL ; Save code string address LD A,(TYPE) ; Get variable type OR A ; Is it a string variable? JP NZ,PRNTST ; Yes - Output string contents CALL NUMASC ; Convert number to text CALL CRTST ; Create temporary string LD (HL),' ' ; Followed by a space LD HL,(FPREG) ; Get length of output INC (HL) ; Plus 1 for the space LD HL,(FPREG) ; < Not needed > LD A,(LWIDTH) ; Get width of line LD B,A ; To B INC B ; Width 255 (No limit)? JP Z,PRNTNB ; Yes - Output number string INC B ; Adjust it LD A,(CURPOS) ; Get cursor position ADD A,(HL) ; Add length of string DEC A ; Adjust it CP B ; Will output fit on this line? CALL NC,PRNTCR ; No - CRLF firstPRNTNB: CALL PRS1 ; Output string at (HL) XOR A ; Skip CALL by setting "Z" flagPRNTST: CALL NZ,PRS1 ; Output string at (HL) POP HL ; Restore code string address JP MRPRNT ; See if more to PRINT
STTLIN: LD A,(CURPOS) ; Make sure on new line OR A ; Already at start? RET Z ; Yes - Do nothing JP PRNTCR ; Start a new line
ENDINP: LD (HL),0 ; Mark end of buffer LD HL,BUFFER-1 ; Point to bufferPRNTCR: LD A,CR ; Load a CR CALL OUTC ; Output characterDONULL: XOR A ; Set to position 0 LD (CURPOS),A ; Store it LD A,(NULLS) ; Get number of nullsNULLP: DEC A ; Count them RET Z ; Return if done PUSH AF ; Save count XOR A ; Load a null CALL OUTC ; Output it POP AF ; Restore count JP NULLP ; Keep counting
DOCOM: LD A,(COMMAN) ; Get comma width LD B,A ; Save in B LD A,(CURPOS) ; Get current position CP B ; Within the limit? CALL NC,PRNTCR ; No - output CRLF JP NC,NEXITM ; Get next itemZONELP: SUB 14 ; Next zone of 14 characters JP NC,ZONELP ; Repeat if more zones CPL ; Number of spaces to output JP ASPCS ; Output them
DOTAB: PUSH AF ; Save token CALL FNDNUM ; Evaluate expression CALL CHKSYN ; Make sure ")" follows DEFB ')' DEC HL ; Back space on to ")" POP AF ; Restore token SUB ZSPC ; Was it "SPC(" ? PUSH HL ; Save code string address JP Z,DOSPC ; Yes - Do "E" spaces LD A,(CURPOS) ; Get current positionDOSPC: CPL ; Number of spaces to print to ADD A,E ; Total number to print JP NC,NEXITM ; TAB < Current POS(X)ASPCS: INC A ; Output A spaces LD B,A ; Save number to print LD A,' ' ; SpaceSPCLP: CALL OUTC ; Output character in A DEC B ; Count them JP NZ,SPCLP ; Repeat if moreNEXITM: POP HL ; Restore code string address CALL GETCHR ; Get next character JP PRNTLP ; More to print
REDO: DEFB "?Redo from start",CR,LF,0
BADINP: LD A,(READFG) ; READ or INPUT? OR A JP NZ,DATSNR ; READ - ?SN Error POP BC ; Throw away code string addr LD HL,REDO ; "Redo from start" message CALL PRS ; Output string JP DOAGN ; Do last INPUT again
INPUT: CALL IDTEST ; Test for illegal direct LD A,(HL) ; Get character after "INPUT" CP '"' ; Is there a prompt string? LD A,0 ; Clear A and leave flags LD (CTLOFG),A ; Enable output JP NZ,NOPMPT ; No prompt - get input CALL QTSTR ; Get string terminated by '"' CALL CHKSYN ; Check for ";" after prompt DEFB ';' PUSH HL ; Save code string address CALL PRS1 ; Output prompt string DEFB 3EH ; Skip "PUSH HL"NOPMPT: PUSH HL ; Save code string address CALL PROMPT ; Get input with "? " prompt POP BC ; Restore code string address JP C,INPBRK ; Break pressed - Exit INC HL ; Next byte LD A,(HL) ; Get it OR A ; End of line? DEC HL ; Back again PUSH BC ; Re-save code string address JP Z,NXTDTA ; Yes - Find next DATA stmt LD (HL),',' ; Store comma as separator JP NXTITM ; Get next item
READ: PUSH HL ; Save code string address LD HL,(NXTDAT) ; Next DATA statement DEFB 0F6H ; Flag "READ"NXTITM: XOR A ; Flag "INPUT" LD (READFG),A ; Save "READ"/"INPUT" flag EX (SP),HL ; Get code str' , Save pointer JP GTVLUS ; Get values
NEDMOR: CALL CHKSYN ; Check for comma between items DEFB ','GTVLUS: CALL GETVAR ; Get variable name EX (SP),HL ; Save code str" , Get pointer PUSH DE ; Save variable address LD A,(HL) ; Get next "INPUT"/"DATA" byte CP ',' ; Comma? JP Z,ANTVLU ; Yes - Get another value LD A,(READFG) ; Is it READ? OR A JP NZ,FDTLP ; Yes - Find next DATA stmt LD A,'?' ; More INPUT needed CALL OUTC ; Output character CALL PROMPT ; Get INPUT with prompt POP DE ; Variable address POP BC ; Code string address JP C,INPBRK ; Break pressed INC HL ; Point to next DATA byte LD A,(HL) ; Get byte OR A ; Is it zero (No input) ? DEC HL ; Back space INPUT pointer PUSH BC ; Save code string address JP Z,NXTDTA ; Find end of buffer PUSH DE ; Save variable addressANTVLU: LD A,(TYPE) ; Check data type OR A ; Is it numeric? JP Z,INPBIN ; Yes - Convert to binary CALL GETCHR ; Get next character LD D,A ; Save input character LD B,A ; Again CP '"' ; Start of literal sting? JP Z,STRENT ; Yes - Create string entry LD A,(READFG) ; "READ" or "INPUT" ? OR A LD D,A ; Save 00 if "INPUT" JP Z,ITMSEP ; "INPUT" - End with 00 LD D,':' ; "DATA" - End with 00 or ":"ITMSEP: LD B,',' ; Item separator DEC HL ; Back space for DTSTRSTRENT: CALL DTSTR ; Get string terminated by D EX DE,HL ; String address to DE LD HL,LTSTND ; Where to go after LETSTR EX (SP),HL ; Save HL , get input pointer PUSH DE ; Save address of string JP LETSTR ; Assign string to variable
INPBIN: CALL GETCHR ; Get next character CALL ASCTFP ; Convert ASCII to FP number EX (SP),HL ; Save input ptr, Get var addr CALL FPTHL ; Move FPREG to variable POP HL ; Restore input pointerLTSTND: DEC HL ; DEC 'cos GETCHR INCs CALL GETCHR ; Get next character JP Z,MORDT ; End of line - More needed? CP ',' ; Another value? JP NZ,BADINP ; No - Bad inputMORDT: EX (SP),HL ; Get code string address DEC HL ; DEC 'cos GETCHR INCs CALL GETCHR ; Get next character JP NZ,NEDMOR ; More needed - Get it POP DE ; Restore DATA pointer LD A,(READFG) ; "READ" or "INPUT" ? OR A EX DE,HL ; DATA pointer to HL JP NZ,UPDATA ; Update DATA pointer if "READ" PUSH DE ; Save code string address OR (HL) ; More input given? LD HL,EXTIG ; "?Extra ignored" message CALL NZ,PRS ; Output string if extra given POP HL ; Restore code string address RET
EXTIG: DEFB "?Extra ignored",CR,LF,0
FDTLP: CALL DATA ; Get next statement OR A ; End of line? JP NZ,FANDT ; No - See if DATA statement INC HL LD A,(HL) ; End of program? INC HL OR (HL) ; 00 00 Ends program LD E,OD ; ?OD Error JP Z,ERROR ; Yes - Out of DATA INC HL LD E,(HL) ; LSB of line number INC HL LD D,(HL) ; MSB of line number EX DE,HL LD (DATLIN),HL ; Set line of current DATA item EX DE,HLFANDT: CALL GETCHR ; Get next character CP ZDATA ; "DATA" token JP NZ,FDTLP ; No "DATA" - Keep looking JP ANTVLU ; Found - Convert input
NEXT: LD DE,0 ; In case no index givenNEXT1: CALL NZ,GETVAR ; Get index address LD (BRKLIN),HL ; Save code string address CALL BAKSTK ; Look for "FOR" block JP NZ,NFERR ; No "FOR" - ?NF Error LD SP,HL ; Clear nested loops PUSH DE ; Save index address LD A,(HL) ; Get sign of STEP INC HL PUSH AF ; Save sign of STEP PUSH DE ; Save index address CALL PHLTFP ; Move index value to FPREG EX (SP),HL ; Save address of TO value PUSH HL ; Save address of index CALL ADDPHL ; Add STEP to index value POP HL ; Restore address of index CALL FPTHL ; Move value to index variable POP HL ; Restore address of TO value CALL LOADFP ; Move TO value to BCDE PUSH HL ; Save address of line of FOR CALL CMPNUM ; Compare index with TO value POP HL ; Restore address of line num POP BC ; Address of sign of STEP SUB B ; Compare with expected sign CALL LOADFP ; BC = Loop stmt,DE = Line num JP Z,KILFOR ; Loop finished - Terminate it EX DE,HL ; Loop statement line number LD (LINEAT),HL ; Set loop line number LD L,C ; Set code string to loop LD H,B JP PUTFID ; Put back "FOR" and continue
KILFOR: LD SP,HL ; Remove "FOR" block LD HL,(BRKLIN) ; Code string after "NEXT" LD A,(HL) ; Get next byte in code string CP ',' ; More NEXTs ? JP NZ,RUNCNT ; No - Do next statement CALL GETCHR ; Position to index name CALL NEXT1 ; Re-enter NEXT routine; < will not RETurn to here , Exit to RUNCNT or Loop >
GETNUM: CALL EVAL ; Get a numeric expressionTSTNUM: DEFB 0F6H ; Clear carry (numeric)TSTSTR: SCF ; Set carry (string)CHKTYP: LD A,(TYPE) ; Check types match ADC A,A ; Expected + actual OR A ; Clear carry , set parity RET PE ; Even parity - Types match JP TMERR ; Different types - Error
; <<< NO REFERENCE TO HERE >>>
CALL CHKSYN ; Make sure "=" follows DEFB ZEQUAL ; "=" JP EVAL ; Evaluate expression
OPNPAR: CALL CHKSYN ; Make sure "(" follows DEFB '('EVAL: DEC HL ; Evaluate expression & save LD D,0 ; Precedence valueEVAL1: PUSH DE ; Save precedence LD C,1 CALL CHKSTK ; Check for 1 level of stack CALL OPRND ; Get next expression valueEVAL2: LD (NXTOPR),HL ; Save address of next operatorEVAL3: LD HL,(NXTOPR) ; Restore address of next opr POP BC ; Precedence value and operator LD A,B ; Get precedence value CP 78H ; "AND" or "OR" ? CALL NC,TSTNUM ; No - Make sure it's a number LD A,(HL) ; Get next operator / function LD D,0 ; Clear Last relationRLTLP: SUB ZGTR ; ">" Token JP C,FOPRND ; + - * / ^ AND OR - Test it CP ZLTH+1-ZGTR ; < = > JP NC,FOPRND ; Function - Call it CP ZEQUAL-ZGTR ; "=" RLA ; <- Test for legal XOR D ; <- combinations of < = > CP D ; <- by combining last token LD D,A ; <- with current one JP C,SNERR ; Error if "<<" "==" or ">>" LD (CUROPR),HL ; Save address of current token CALL GETCHR ; Get next character JP RLTLP ; Treat the two as one
FOPRND: LD A,D ; < = > found ? OR A JP NZ,TSTRED ; Yes - Test for reduction LD A,(HL) ; Get operator token LD (CUROPR),HL ; Save operator address SUB ZPLUS ; Operator or function? RET C ; Neither - Exit CP ZOR+1-ZPLUS ; Is it + - * / ^ AND OR ? RET NC ; No - Exit LD E,A ; Coded operator LD A,(TYPE) ; Get data type DEC A ; FF = numeric , 00 = string OR E ; Combine with coded operator LD A,E ; Get coded operator JP Z,CONCAT ; String concatenation RLCA ; Times 2 ADD A,E ; Times 3 LD E,A ; To DE (D is 0) LD HL,PRITAB ; Precedence table ADD HL,DE ; To the operator concerned LD A,B ; Last operator precedence LD D,(HL) ; Get evaluation precedence CP D ; Compare with eval precedence RET NC ; Exit if higher precedence INC HL ; Point to routine address CALL TSTNUM ; Make sure it's a number
STKTHS: PUSH BC ; Save last precedence & token LD BC,EVAL3 ; Where to go on prec' break PUSH BC ; Save on stack for return LD B,E ; Save operator LD C,D ; Save precedence CALL STAKFP ; Move value to stack LD E,B ; Restore operator LD D,C ; Restore precedence LD C,(HL) ; Get LSB of routine address INC HL LD B,(HL) ; Get MSB of routine address INC HL PUSH BC ; Save routine address LD HL,(CUROPR) ; Address of current operator JP EVAL1 ; Loop until prec' break
OPRND: XOR A ; Get operand routine LD (TYPE),A ; Set numeric expected CALL GETCHR ; Get next character LD E,MO ; ?MO Error JP Z,ERROR ; No operand - Error JP C,ASCTFP ; Number - Get value CALL CHKLTR ; See if a letter JP NC,CONVAR ; Letter - Find variable CP ZPLUS ; "+" Token ? JP Z,OPRND ; Yes - Look for operand CP '.' ; "." ? JP Z,ASCTFP ; Yes - Create FP number CP ZMINUS ; "-" Token ? JP Z,MINUS ; Yes - Do minus CP '"' ; Literal string ? JP Z,QTSTR ; Get string terminated by '"' CP ZNOT ; "NOT" Token ? JP Z,EVNOT ; Yes - Eval NOT expression CP ZFN ; "FN" Token ? JP Z,DOFN ; Yes - Do FN routine SUB ZSGN ; Is it a function? JP NC,FNOFST ; Yes - Evaluate functionEVLPAR: CALL OPNPAR ; Evaluate expression in "()" CALL CHKSYN ; Make sure ")" follows DEFB ')' RET
MINUS: LD D,7DH ; "-" precedence CALL EVAL1 ; Evaluate until prec' break LD HL,(NXTOPR) ; Get next operator address PUSH HL ; Save next operator address CALL INVSGN ; Negate valueRETNUM: CALL TSTNUM ; Make sure it's a number POP HL ; Restore next operator address RET
CONVAR: CALL GETVAR ; Get variable address to DEFRMEVL: PUSH HL ; Save code string address EX DE,HL ; Variable address to HL LD (FPREG),HL ; Save address of variable LD A,(TYPE) ; Get type OR A ; Numeric? CALL Z,PHLTFP ; Yes - Move contents to FPREG POP HL ; Restore code string address RET
FNOFST: LD B,0 ; Get address of function RLCA ; Double function offset LD C,A ; BC = Offset in function table PUSH BC ; Save adjusted token value CALL GETCHR ; Get next character LD A,C ; Get adjusted token value CP 2*(ZPOINT-ZSGN) ; Adjusted "POINT" token? JP Z,POINTB ; Yes - Do "POINT" (not POINTB) CP 2*(ZLEFT-ZSGN)-1; Adj' LEFT$,RIGHT$ or MID$ ? JP C,FNVAL ; No - Do function CALL OPNPAR ; Evaluate expression (X,... CALL CHKSYN ; Make sure "," follows DEFB ',' CALL TSTSTR ; Make sure it's a string EX DE,HL ; Save code string address LD HL,(FPREG) ; Get address of string EX (SP),HL ; Save address of string PUSH HL ; Save adjusted token value EX DE,HL ; Restore code string address CALL GETINT ; Get integer 0-255 EX DE,HL ; Save code string address EX (SP),HL ; Save integer,HL = adj' token JP GOFUNC ; Jump to string function
FNVAL: CALL EVLPAR ; Evaluate expression EX (SP),HL ; HL = Adjusted token value LD DE,RETNUM ; Return number from function PUSH DE ; Save on stackGOFUNC: LD BC,FNCTAB ; Function routine addresses ADD HL,BC ; Point to right address LD C,(HL) ; Get LSB of address INC HL ; LD H,(HL) ; Get MSB of address LD L,C ; Address to HL JP (HL) ; Jump to function
SGNEXP: DEC D ; Dee to flag negative exponent CP ZMINUS ; "-" token ? RET Z ; Yes - Return CP '-' ; "-" ASCII ? RET Z ; Yes - Return INC D ; Inc to flag positive exponent CP '+' ; "+" ASCII ? RET Z ; Yes - Return CP ZPLUS ; "+" token ? RET Z ; Yes - Return DEC HL ; DEC 'cos GETCHR INCs RET ; Return "NZ"
POR: DEFB 0F6H ; Flag "OR"PAND: XOR A ; Flag "AND" PUSH AF ; Save "AND" / "OR" flag CALL TSTNUM ; Make sure it's a number CALL DEINT ; Get integer -32768 to 32767 POP AF ; Restore "AND" / "OR" flag EX DE,HL ; <- Get last POP BC ; <- value EX (SP),HL ; <- from EX DE,HL ; <- stack CALL FPBCDE ; Move last value to FPREG PUSH AF ; Save "AND" / "OR" flag CALL DEINT ; Get integer -32768 to 32767 POP AF ; Restore "AND" / "OR" flag POP BC ; Get value LD A,C ; Get LSB LD HL,ACPASS ; Address of save AC as current JP NZ,POR1 ; Jump if OR AND E ; "AND" LSBs LD C,A ; Save LSB LD A,B ; Get MBS AND D ; "AND" MSBs JP (HL) ; Save AC as current (ACPASS)
POR1: OR E ; "OR" LSBs LD C,A ; Save LSB LD A,B ; Get MSB OR D ; "OR" MSBs JP (HL) ; Save AC as current (ACPASS)
TSTRED: LD HL,CMPLOG ; Logical compare routine LD A,(TYPE) ; Get data type RRA ; Carry set = string LD A,D ; Get last precedence value RLA ; Times 2 plus carry LD E,A ; To E LD D,64H ; Relational precedence LD A,B ; Get current precedence CP D ; Compare with last RET NC ; Eval if last was rel' or log' JP STKTHS ; Stack this one and get next
CMPLOG: DEFW CMPLG1 ; Compare two values / stringsCMPLG1: LD A,C ; Get data type OR A RRA POP BC ; Get last expression to BCDE POP DE PUSH AF ; Save status CALL CHKTYP ; Check that types match LD HL,CMPRES ; Result to comparison PUSH HL ; Save for RETurn JP Z,CMPNUM ; Compare values if numeric XOR A ; Compare two strings LD (TYPE),A ; Set type to numeric PUSH DE ; Save string name CALL GSTRCU ; Get current string LD A,(HL) ; Get length of string INC HL INC HL LD C,(HL) ; Get LSB of address INC HL LD B,(HL) ; Get MSB of address POP DE ; Restore string name PUSH BC ; Save address of string PUSH AF ; Save length of string CALL GSTRDE ; Get second string CALL LOADFP ; Get address of second string POP AF ; Restore length of string 1 LD D,A ; Length to D POP HL ; Restore address of string 1CMPSTR: LD A,E ; Bytes of string 2 to do OR D ; Bytes of string 1 to do RET Z ; Exit if all bytes compared LD A,D ; Get bytes of string 1 to do SUB 1 RET C ; Exit if end of string 1 XOR A CP E ; Bytes of string 2 to do INC A RET NC ; Exit if end of string 2 DEC D ; Count bytes in string 1 DEC E ; Count bytes in string 2 LD A,(BC) ; Byte in string 2 CP (HL) ; Compare to byte in string 1 INC HL ; Move up string 1 INC BC ; Move up string 2 JP Z,CMPSTR ; Same - Try next bytes CCF ; Flag difference (">" or "<") JP FLGDIF ; "<" gives -1 , ">" gives +1
CMPRES: INC A ; Increment current value ADC A,A ; Double plus carry POP BC ; Get other value AND B ; Combine them ADD A,-1 ; Carry set if different SBC A,A ; 00 - Equal , FF - Different JP FLGREL ; Set current value & continue
EVNOT: LD D,5AH ; Precedence value for "NOT" CALL EVAL1 ; Eval until precedence break CALL TSTNUM ; Make sure it's a number CALL DEINT ; Get integer -32768 - 32767 LD A,E ; Get LSB CPL ; Invert LSB LD C,A ; Save "NOT" of LSB LD A,D ; Get MSB CPL ; Invert MSB CALL ACPASS ; Save AC as current POP BC ; Clean up stack JP EVAL3 ; Continue evaluation
DIMRET: DEC HL ; DEC 'cos GETCHR INCs CALL GETCHR ; Get next character RET Z ; End of DIM statement CALL CHKSYN ; Make sure "," follows DEFB ','DIM: LD BC,DIMRET ; Return to "DIMRET" PUSH BC ; Save on stack DEFB 0F6H ; Flag "Create" variableGETVAR: XOR A ; Find variable address,to DE LD (LCRFLG),A ; Set locate / create flag LD B,(HL) ; Get First byte of nameGTFNAM: CALL CHKLTR ; See if a letter JP C,SNERR ; ?SN Error if not a letter XOR A LD C,A ; Clear second byte of name LD (TYPE),A ; Set type to numeric CALL GETCHR ; Get next character JP C,SVNAM2 ; Numeric - Save in name CALL CHKLTR ; See if a letter JP C,CHARTY ; Not a letter - Check typeSVNAM2: LD C,A ; Save second byte of nameENDNAM: CALL GETCHR ; Get next character JP C,ENDNAM ; Numeric - Get another CALL CHKLTR ; See if a letter JP NC,ENDNAM ; Letter - Get anotherCHARTY: SUB '$' ; String variable? JP NZ,NOTSTR ; No - Numeric variable INC A ; A = 1 (string type) LD (TYPE),A ; Set type to string RRCA ; A = 80H , Flag for string ADD A,C ; 2nd byte of name has bit 7 on LD C,A ; Resave second byte on name CALL GETCHR ; Get next characterNOTSTR: LD A,(FORFLG) ; Array name needed ? DEC A JP Z,ARLDSV ; Yes - Get array name JP P,NSCFOR ; No array with "FOR" or "FN" LD A,(HL) ; Get byte again SUB '(' ; Subscripted variable? JP Z,SBSCPT ; Yes - Sort out subscript
NSCFOR: XOR A ; Simple variable LD (FORFLG),A ; Clear "FOR" flag PUSH HL ; Save code string address LD D,B ; DE = Variable name to find LD E,C LD HL,(FNRGNM) ; FN argument name CALL CPDEHL ; Is it the FN argument? LD DE,FNARG ; Point to argument value JP Z,POPHRT ; Yes - Return FN argument value LD HL,(VAREND) ; End of variables EX DE,HL ; Address of end of search LD HL,(PROGND) ; Start of variables addressFNDVAR: CALL CPDEHL ; End of variable list table? JP Z,CFEVAL ; Yes - Called from EVAL? LD A,C ; Get second byte of name SUB (HL) ; Compare with name in list INC HL ; Move on to first byte JP NZ,FNTHR ; Different - Find another LD A,B ; Get first byte of name SUB (HL) ; Compare with name in listFNTHR: INC HL ; Move on to LSB of value JP Z,RETADR ; Found - Return address INC HL ; <- Skip INC HL ; <- over INC HL ; <- F.P. INC HL ; <- value JP FNDVAR ; Keep looking
CFEVAL: POP HL ; Restore code string address EX (SP),HL ; Get return address PUSH DE ; Save address of variable LD DE,FRMEVL ; Return address in EVAL CALL CPDEHL ; Called from EVAL ? POP DE ; Restore address of variable JP Z,RETNUL ; Yes - Return null variable EX (SP),HL ; Put back return PUSH HL ; Save code string address PUSH BC ; Save variable name LD BC,6 ; 2 byte name plus 4 byte data LD HL,(ARREND) ; End of arrays PUSH HL ; Save end of arrays ADD HL,BC ; Move up 6 bytes POP BC ; Source address in BC PUSH HL ; Save new end address CALL MOVUP ; Move arrays up POP HL ; Restore new end address LD (ARREND),HL ; Set new end address LD H,B ; End of variables to HL LD L,C LD (VAREND),HL ; Set new end address
ZEROLP: DEC HL ; Back through to zero variable LD (HL),0 ; Zero byte in variable CALL CPDEHL ; Done them all? JP NZ,ZEROLP ; No - Keep on going POP DE ; Get variable name LD (HL),E ; Store second character INC HL LD (HL),D ; Store first character INC HLRETADR: EX DE,HL ; Address of variable in DE POP HL ; Restore code string address RET
RETNUL: LD (FPEXP),A ; Set result to zero LD HL,ZERBYT ; Also set a null string LD (FPREG),HL ; Save for EVAL POP HL ; Restore code string address RET
SBSCPT: PUSH HL ; Save code string address LD HL,(LCRFLG) ; Locate/Create and Type EX (SP),HL ; Save and get code string LD D,A ; Zero number of dimensionsSCPTLP: PUSH DE ; Save number of dimensions PUSH BC ; Save array name CALL FPSINT ; Get subscript (0-32767) POP BC ; Restore array name POP AF ; Get number of dimensions EX DE,HL EX (SP),HL ; Save subscript value PUSH HL ; Save LCRFLG and TYPE EX DE,HL INC A ; Count dimensions LD D,A ; Save in D LD A,(HL) ; Get next byte in code string CP ',' ; Comma (more to come)? JP Z,SCPTLP ; Yes - More subscripts CALL CHKSYN ; Make sure ")" follows DEFB ')' LD (NXTOPR),HL ; Save code string address POP HL ; Get LCRFLG and TYPE LD (LCRFLG),HL ; Restore Locate/create & type LD E,0 ; Flag not CSAVE* or CLOAD* PUSH DE ; Save number of dimensions (D) DEFB 11H ; Skip "PUSH HL" and "PUSH AF'
ARLDSV: PUSH HL ; Save code string address PUSH AF ; A = 00 , Flags set = Z,N LD HL,(VAREND) ; Start of arrays DEFB 3EH ; Skip "ADD HL,DE"FNDARY: ADD HL,DE ; Move to next array start EX DE,HL LD HL,(ARREND) ; End of arrays EX DE,HL ; Current array pointer CALL CPDEHL ; End of arrays found? JP Z,CREARY ; Yes - Create array LD A,(HL) ; Get second byte of name CP C ; Compare with name given INC HL ; Move on JP NZ,NXTARY ; Different - Find next array LD A,(HL) ; Get first byte of name CP B ; Compare with name givenNXTARY: INC HL ; Move on LD E,(HL) ; Get LSB of next array address INC HL LD D,(HL) ; Get MSB of next array address INC HL JP NZ,FNDARY ; Not found - Keep looking LD A,(LCRFLG) ; Found Locate or Create it? OR A JP NZ,DDERR ; Create - ?DD Error POP AF ; Locate - Get number of dim'ns LD B,H ; BC Points to array dim'ns LD C,L JP Z,POPHRT ; Jump if array load/save SUB (HL) ; Same number of dimensions? JP Z,FINDEL ; Yes - Find elementBSERR: LD E,BS ; ?BS Error JP ERROR ; Output error
CREARY: LD DE,4 ; 4 Bytes per entry POP AF ; Array to save or 0 dim'ns? JP Z,FCERR ; Yes - ?FC Error LD (HL),C ; Save second byte of name INC HL LD (HL),B ; Save first byte of name INC HL LD C,A ; Number of dimensions to C CALL CHKSTK ; Check if enough memory INC HL ; Point to number of dimensions INC HL LD (CUROPR),HL ; Save address of pointer LD (HL),C ; Set number of dimensions INC HL LD A,(LCRFLG) ; Locate of Create? RLA ; Carry set = Create LD A,C ; Get number of dimensionsCRARLP: LD BC,10+1 ; Default dimension size 10 JP NC,DEFSIZ ; Locate - Set default size POP BC ; Get specified dimension size INC BC ; Include zero elementDEFSIZ: LD (HL),C ; Save LSB of dimension size INC HL LD (HL),B ; Save MSB of dimension size INC HL PUSH AF ; Save num' of dim'ns an status PUSH HL ; Save address of dim'n size CALL MLDEBC ; Multiply DE by BC to find EX DE,HL ; amount of mem needed (to DE) POP HL ; Restore address of dimension POP AF ; Restore number of dimensions DEC A ; Count them JP NZ,CRARLP ; Do next dimension if more PUSH AF ; Save locate/create flag LD B,D ; MSB of memory needed LD C,E ; LSB of memory needed EX DE,HL ADD HL,DE ; Add bytes to array start JP C,OMERR ; Too big - Error CALL ENFMEM ; See if enough memory LD (ARREND),HL ; Save new end of array
ZERARY: DEC HL ; Back through array data LD (HL),0 ; Set array element to zero CALL CPDEHL ; All elements zeroed? JP NZ,ZERARY ; No - Keep on going INC BC ; Number of bytes + 1 LD D,A ; A=0 LD HL,(CUROPR) ; Get address of array LD E,(HL) ; Number of dimensions EX DE,HL ; To HL ADD HL,HL ; Two bytes per dimension size ADD HL,BC ; Add number of bytes EX DE,HL ; Bytes needed to DE DEC HL DEC HL LD (HL),E ; Save LSB of bytes needed INC HL LD (HL),D ; Save MSB of bytes needed INC HL POP AF ; Locate / Create? JP C,ENDDIM ; A is 0 , End if createFINDEL: LD B,A ; Find array element LD C,A LD A,(HL) ; Number of dimensions INC HL DEFB 16H ; Skip "POP HL"FNDELP: POP HL ; Address of next dim' size LD E,(HL) ; Get LSB of dim'n size INC HL LD D,(HL) ; Get MSB of dim'n size INC HL EX (SP),HL ; Save address - Get index PUSH AF ; Save number of dim'ns CALL CPDEHL ; Dimension too large? JP NC,BSERR ; Yes - ?BS Error PUSH HL ; Save index CALL MLDEBC ; Multiply previous by size POP DE ; Index supplied to DE ADD HL,DE ; Add index to pointer POP AF ; Number of dimensions DEC A ; Count them LD B,H ; MSB of pointer LD C,L ; LSB of pointer JP NZ,FNDELP ; More - Keep going ADD HL,HL ; 4 Bytes per element ADD HL,HL POP BC ; Start of array ADD HL,BC ; Point to element EX DE,HL ; Address of element to DEENDDIM: LD HL,(NXTOPR) ; Got code string address RET
FRE: LD HL,(ARREND) ; Start of free memory EX DE,HL ; To DE LD HL,0 ; End of free memory ADD HL,SP ; Current stack value LD A,(TYPE) ; Dummy argument type OR A JP Z,FRENUM ; Numeric - Free variable space CALL GSTRCU ; Current string to pool CALL GARBGE ; Garbage collection LD HL,(STRSPC) ; Bottom of string space in use EX DE,HL ; To DE LD HL,(STRBOT) ; Bottom of string spaceFRENUM: LD A,L ; Get LSB of end SUB E ; Subtract LSB of beginning LD C,A ; Save difference if C LD A,H ; Get MSB of end SBC A,D ; Subtract MSB of beginningACPASS: LD B,C ; Return integer ACABPASS: LD D,B ; Return integer AB LD E,0 LD HL,TYPE ; Point to type LD (HL),E ; Set type to numeric LD B,80H+16 ; 16 bit integer JP RETINT ; Return the integr
POS: LD A,(CURPOS) ; Get cursor positionPASSA: LD B,A ; Put A into AB XOR A ; Zero A JP ABPASS ; Return integer AB
DEF: CALL CHEKFN ; Get "FN" and name CALL IDTEST ; Test for illegal direct LD BC,DATA ; To get next statement PUSH BC ; Save address for RETurn PUSH DE ; Save address of function ptr CALL CHKSYN ; Make sure "(" follows DEFB '(' CALL GETVAR ; Get argument variable name PUSH HL ; Save code string address EX DE,HL ; Argument address to HL DEC HL LD D,(HL) ; Get first byte of arg name DEC HL LD E,(HL) ; Get second byte of arg name POP HL ; Restore code string address CALL TSTNUM ; Make sure numeric argument CALL CHKSYN ; Make sure ")" follows DEFB ')' CALL CHKSYN ; Make sure "=" follows DEFB ZEQUAL ; "=" token LD B,H ; Code string address to BC LD C,L EX (SP),HL ; Save code str , Get FN ptr LD (HL),C ; Save LSB of FN code string INC HL LD (HL),B ; Save MSB of FN code string JP SVSTAD ; Save address and do function
DOFN: CALL CHEKFN ; Make sure FN follows PUSH DE ; Save function pointer address CALL EVLPAR ; Evaluate expression in "()" CALL TSTNUM ; Make sure numeric result EX (SP),HL ; Save code str , Get FN ptr LD E,(HL) ; Get LSB of FN code string INC HL LD D,(HL) ; Get MSB of FN code string INC HL LD A,D ; And function DEFined? OR E JP Z,UFERR ; No - ?UF Error LD A,(HL) ; Get LSB of argument address INC HL LD H,(HL) ; Get MSB of argument address LD L,A ; HL = Arg variable address PUSH HL ; Save it LD HL,(FNRGNM) ; Get old argument name EX (SP),HL ; ; Save old , Get new LD (FNRGNM),HL ; Set new argument name LD HL,(FNARG+2) ; Get LSB,NLSB of old arg value PUSH HL ; Save it LD HL,(FNARG) ; Get MSB,EXP of old arg value PUSH HL ; Save it LD HL,FNARG ; HL = Value of argument PUSH DE ; Save FN code string address CALL FPTHL ; Move FPREG to argument POP HL ; Get FN code string address CALL GETNUM ; Get value from function DEC HL ; DEC 'cos GETCHR INCs CALL GETCHR ; Get next character JP NZ,SNERR ; Bad character in FN - Error POP HL ; Get MSB,EXP of old arg LD (FNARG),HL ; Restore it POP HL ; Get LSB,NLSB of old arg LD (FNARG+2),HL ; Restore it POP HL ; Get name of old arg LD (FNRGNM),HL ; Restore it POP HL ; Restore code string address RET
IDTEST: PUSH HL ; Save code string address LD HL,(LINEAT) ; Get current line number INC HL ; -1 means direct statement LD A,H OR L POP HL ; Restore code string address RET NZ ; Return if in program LD E,ID ; ?ID Error JP ERROR
CHEKFN: CALL CHKSYN ; Make sure FN follows DEFB ZFN ; "FN" token LD A,80H LD (FORFLG),A ; Flag FN name to find OR (HL) ; FN name has bit 7 set LD B,A ; in first byte of name CALL GTFNAM ; Get FN name JP TSTNUM ; Make sure numeric function
STR: CALL TSTNUM ; Make sure it's a number CALL NUMASC ; Turn number into text CALL CRTST ; Create string entry for it CALL GSTRCU ; Current string to pool LD BC,TOPOOL ; Save in string pool PUSH BC ; Save address on stack
SAVSTR: LD A,(HL) ; Get string length INC HL INC HL PUSH HL ; Save pointer to string CALL TESTR ; See if enough string space POP HL ; Restore pointer to string LD C,(HL) ; Get LSB of address INC HL LD B,(HL) ; Get MSB of address CALL CRTMST ; Create string entry PUSH HL ; Save pointer to MSB of addr LD L,A ; Length of string CALL TOSTRA ; Move to string area POP DE ; Restore pointer to MSB RET
MKTMST: CALL TESTR ; See if enough string spaceCRTMST: LD HL,TMPSTR ; Temporary string PUSH HL ; Save it LD (HL),A ; Save length of string INC HLSVSTAD: INC HL LD (HL),E ; Save LSB of address INC HL LD (HL),D ; Save MSB of address POP HL ; Restore pointer RET
CRTST: DEC HL ; DEC - INCed afterQTSTR: LD B,'"' ; Terminating quote LD D,B ; Quote to DDTSTR: PUSH HL ; Save start LD C,-1 ; Set counter to -1QTSTLP: INC HL ; Move on LD A,(HL) ; Get byte INC C ; Count bytes OR A ; End of line? JP Z,CRTSTE ; Yes - Create string entry CP D ; Terminator D found? JP Z,CRTSTE ; Yes - Create string entry CP B ; Terminator B found? JP NZ,QTSTLP ; No - Keep lookingCRTSTE: CP '"' ; End with '"'? CALL Z,GETCHR ; Yes - Get next character EX (SP),HL ; Starting quote INC HL ; First byte of string EX DE,HL ; To DE LD A,C ; Get length CALL CRTMST ; Create string entryTSTOPL: LD DE,TMPSTR ; Temporary string LD HL,(TMSTPT) ; Temporary string pool pointer LD (FPREG),HL ; Save address of string ptr LD A,1 LD (TYPE),A ; Set type to string CALL DETHL4 ; Move string to pool CALL CPDEHL ; Out of string pool? LD (TMSTPT),HL ; Save new pointer POP HL ; Restore code string address LD A,(HL) ; Get next code byte RET NZ ; Return if pool OK LD E,ST ; ?ST Error JP ERROR ; String pool overflow
PRNUMS: INC HL ; Skip leading spacePRS: CALL CRTST ; Create string entry for itPRS1: CALL GSTRCU ; Current string to pool CALL LOADFP ; Move string block to BCDE INC E ; Length + 1PRSLP: DEC E ; Count characters RET Z ; End of string LD A,(BC) ; Get byte to output CALL OUTC ; Output character in A CP CR ; Return? CALL Z,DONULL ; Yes - Do nulls INC BC ; Next byte in string JP PRSLP ; More characters to output
TESTR: OR A ; Test if enough room DEFB 0EH ; No garbage collection doneGRBDON: POP AF ; Garbage collection done PUSH AF ; Save status LD HL,(STRSPC) ; Bottom of string space in use EX DE,HL ; To DE LD HL,(STRBOT) ; Bottom of string area CPL ; Negate length (Top down) LD C,A ; -Length to BC LD B,-1 ; BC = -ve length of string ADD HL,BC ; Add to bottom of space in use INC HL ; Plus one for 2's complement CALL CPDEHL ; Below string RAM area? JP C,TESTOS ; Tidy up if not done else err LD (STRBOT),HL ; Save new bottom of area INC HL ; Point to first byte of string EX DE,HL ; Address to DEPOPAF: POP AF ; Throw away status push RET
TESTOS: POP AF ; Garbage collect been done? LD E,OS ; ?OS Error JP Z,ERROR ; Yes - Not enough string apace CP A ; Flag garbage collect done PUSH AF ; Save status LD BC,GRBDON ; Garbage collection done PUSH BC ; Save for RETurnGARBGE: LD HL,(LSTRAM) ; Get end of RAM pointerGARBLP: LD (STRBOT),HL ; Reset string pointer LD HL,0 PUSH HL ; Flag no string found LD HL,(STRSPC) ; Get bottom of string space PUSH HL ; Save bottom of string space LD HL,TMSTPL ; Temporary string poolGRBLP: EX DE,HL LD HL,(TMSTPT) ; Temporary string pool pointer EX DE,HL CALL CPDEHL ; Temporary string pool done? LD BC,GRBLP ; Loop until string pool done JP NZ,STPOOL ; No - See if in string area LD HL,(PROGND) ; Start of simple variablesSMPVAR: EX DE,HL LD HL,(VAREND) ; End of simple variables EX DE,HL CALL CPDEHL ; All simple strings done? JP Z,ARRLP ; Yes - Do string arrays LD A,(HL) ; Get type of variable INC HL INC HL OR A ; "S" flag set if string CALL STRADD ; See if string in string area JP SMPVAR ; Loop until simple ones done
GNXARY: POP BC ; Scrap address of this arrayARRLP: EX DE,HL LD HL,(ARREND) ; End of string arrays EX DE,HL CALL CPDEHL ; All string arrays done? JP Z,SCNEND ; Yes - Move string if found CALL LOADFP ; Get array name to BCDE LD A,E ; Get type of array PUSH HL ; Save address of num of dim'ns ADD HL,BC ; Start of next array OR A ; Test type of array JP P,GNXARY ; Numeric array - Ignore it LD (CUROPR),HL ; Save address of next array POP HL ; Get address of num of dim'ns LD C,(HL) ; BC = Number of dimensions LD B,0 ADD HL,BC ; Two bytes per dimension size ADD HL,BC INC HL ; Plus one for number of dim'nsGRBARY: EX DE,HL LD HL,(CUROPR) ; Get address of next array EX DE,HL CALL CPDEHL ; Is this array finished? JP Z,ARRLP ; Yes - Get next one LD BC,GRBARY ; Loop until array all doneSTPOOL: PUSH BC ; Save return address OR 80H ; Flag string typeSTRADD: LD A,(HL) ; Get string length INC HL INC HL LD E,(HL) ; Get LSB of string address INC HL LD D,(HL) ; Get MSB of string address INC HL RET P ; Not a string - Return OR A ; Set flags on string length RET Z ; Null string - Return LD B,H ; Save variable pointer LD C,L LD HL,(STRBOT) ; Bottom of new area CALL CPDEHL ; String been done? LD H,B ; Restore variable pointer LD L,C RET C ; String done - Ignore POP HL ; Return address EX (SP),HL ; Lowest available string area CALL CPDEHL ; String within string area? EX (SP),HL ; Lowest available string area PUSH HL ; Re-save return address LD H,B ; Restore variable pointer LD L,C RET NC ; Outside string area - Ignore POP BC ; Get return , Throw 2 away POP AF ; POP AF ; PUSH HL ; Save variable pointer PUSH DE ; Save address of current PUSH BC ; Put back return address RET ; Go to it
SCNEND: POP DE ; Addresses of strings POP HL ; LD A,L ; HL = 0 if no more to do OR H RET Z ; No more to do - Return DEC HL LD B,(HL) ; MSB of address of string DEC HL LD C,(HL) ; LSB of address of string PUSH HL ; Save variable address DEC HL DEC HL LD L,(HL) ; HL = Length of string LD H,0 ADD HL,BC ; Address of end of string+1 LD D,B ; String address to DE LD E,C DEC HL ; Last byte in string LD B,H ; Address to BC LD C,L LD HL,(STRBOT) ; Current bottom of string area CALL MOVSTR ; Move string to new address POP HL ; Restore variable address LD (HL),C ; Save new LSB of address INC HL LD (HL),B ; Save new MSB of address LD L,C ; Next string area+1 to HL LD H,B DEC HL ; Next string area address JP GARBLP ; Look for more strings
CONCAT: PUSH BC ; Save prec' opr & code string PUSH HL ; LD HL,(FPREG) ; Get first string EX (SP),HL ; Save first string CALL OPRND ; Get second string EX (SP),HL ; Restore first string CALL TSTSTR ; Make sure it's a string LD A,(HL) ; Get length of second string PUSH HL ; Save first string LD HL,(FPREG) ; Get second string PUSH HL ; Save second string ADD A,(HL) ; Add length of second string LD E,LS ; ?LS Error JP C,ERROR ; String too long - Error CALL MKTMST ; Make temporary string POP DE ; Get second string to DE CALL GSTRDE ; Move to string pool if needed EX (SP),HL ; Get first string CALL GSTRHL ; Move to string pool if needed PUSH HL ; Save first string LD HL,(TMPSTR+2) ; Temporary string address EX DE,HL ; To DE CALL SSTSA ; First string to string area CALL SSTSA ; Second string to string area LD HL,EVAL2 ; Return to evaluation loop EX (SP),HL ; Save return,get code string PUSH HL ; Save code string address JP TSTOPL ; To temporary string to pool
SSTSA: POP HL ; Return address EX (SP),HL ; Get string block,save return LD A,(HL) ; Get length of string INC HL INC HL LD C,(HL) ; Get LSB of string address INC HL LD B,(HL) ; Get MSB of string address LD L,A ; Length to LTOSTRA: INC L ; INC - DECed afterTSALP: DEC L ; Count bytes moved RET Z ; End of string - Return LD A,(BC) ; Get source LD (DE),A ; Save destination INC BC ; Next source INC DE ; Next destination JP TSALP ; Loop until string moved
GETSTR: CALL TSTSTR ; Make sure it's a stringGSTRCU: LD HL,(FPREG) ; Get current stringGSTRHL: EX DE,HL ; Save DEGSTRDE: CALL BAKTMP ; Was it last tmp-str? EX DE,HL ; Restore DE RET NZ ; No - Return PUSH DE ; Save string LD D,B ; String block address to DE LD E,C DEC DE ; Point to length LD C,(HL) ; Get string length LD HL,(STRBOT) ; Current bottom of string area CALL CPDEHL ; Last one in string area? JP NZ,POPHL ; No - Return LD B,A ; Clear B (A=0) ADD HL,BC ; Remove string from str' area LD (STRBOT),HL ; Save new bottom of str' areaPOPHL: POP HL ; Restore string RET
BAKTMP: LD HL,(TMSTPT) ; Get temporary string pool top DEC HL ; Back LD B,(HL) ; Get MSB of address DEC HL ; Back LD C,(HL) ; Get LSB of address DEC HL ; Back DEC HL ; Back CALL CPDEHL ; String last in string pool? RET NZ ; Yes - Leave it LD (TMSTPT),HL ; Save new string pool top RET
LEN: LD BC,PASSA ; To return integer A PUSH BC ; Save addressGETLEN: CALL GETSTR ; Get string and its length XOR A LD D,A ; Clear D LD (TYPE),A ; Set type to numeric LD A,(HL) ; Get length of string OR A ; Set status flags RET
ASC: LD BC,PASSA ; To return integer A PUSH BC ; Save addressGTFLNM: CALL GETLEN ; Get length of string JP Z,FCERR ; Null string - Error INC HL INC HL LD E,(HL) ; Get LSB of address INC HL LD D,(HL) ; Get MSB of address LD A,(DE) ; Get first byte of string RET
CHR: LD A,1 ; One character string CALL MKTMST ; Make a temporary string CALL MAKINT ; Make it integer A LD HL,(TMPSTR+2) ; Get address of string LD (HL),E ; Save characterTOPOOL: POP BC ; Clean up stack JP TSTOPL ; Temporary string to pool
LEFT: CALL LFRGNM ; Get number and ending ")" XOR A ; Start at first byte in stringRIGHT1: EX (SP),HL ; Save code string,Get string LD C,A ; Starting position in stringMID1: PUSH HL ; Save string block address LD A,(HL) ; Get length of string CP B ; Compare with number given JP C,ALLFOL ; All following bytes required LD A,B ; Get new length DEFB 11H ; Skip "LD C,0"ALLFOL: LD C,0 ; First byte of string PUSH BC ; Save position in string CALL TESTR ; See if enough string space POP BC ; Get position in string POP HL ; Restore string block address PUSH HL ; And re-save it INC HL INC HL LD B,(HL) ; Get LSB of address INC HL LD H,(HL) ; Get MSB of address LD L,B ; HL = address of string LD B,0 ; BC = starting address ADD HL,BC ; Point to that byte LD B,H ; BC = source string LD C,L CALL CRTMST ; Create a string entry LD L,A ; Length of new string CALL TOSTRA ; Move string to string area POP DE ; Clear stack CALL GSTRDE ; Move to string pool if needed JP TSTOPL ; Temporary string to pool
RIGHT: CALL LFRGNM ; Get number and ending ")" POP DE ; Get string length PUSH DE ; And re-save LD A,(DE) ; Get length SUB B ; Move back N bytes JP RIGHT1 ; Go and get sub-string
MID: EX DE,HL ; Get code string address LD A,(HL) ; Get next byte "," or ")" CALL MIDNUM ; Get number supplied INC B ; Is it character zero? DEC B JP Z,FCERR ; Yes - Error PUSH BC ; Save starting position LD E,255 ; All of string CP ')' ; Any length given? JP Z,RSTSTR ; No - Rest of string CALL CHKSYN ; Make sure "," follows DEFB ',' CALL GETINT ; Get integer 0-255RSTSTR: CALL CHKSYN ; Make sure ")" follows DEFB ')' POP AF ; Restore starting position EX (SP),HL ; Get string,8ave code string LD BC,MID1 ; Continuation of MID$ routine PUSH BC ; Save for return DEC A ; Starting position-1 CP (HL) ; Compare with length LD B,0 ; Zero bytes length RET NC ; Null string if start past end LD C,A ; Save starting position-1 LD A,(HL) ; Get length of string SUB C ; Subtract start CP E ; Enough string for it? LD B,A ; Save maximum length available RET C ; Truncate string if needed LD B,E ; Set specified length RET ; Go and create string
VAL: CALL GETLEN ; Get length of string JP Z,RESZER ; Result zero LD E,A ; Save length INC HL INC HL LD A,(HL) ; Get LSB of address INC HL LD H,(HL) ; Get MSB of address LD L,A ; HL = String address PUSH HL ; Save string address ADD HL,DE LD B,(HL) ; Get end of string+1 byte LD (HL),D ; Zero it to terminate EX (SP),HL ; Save string end,get start PUSH BC ; Save end+1 byte LD A,(HL) ; Get starting byte CALL ASCTFP ; Convert ASCII string to FP POP BC ; Restore end+1 byte POP HL ; Restore end+1 address LD (HL),B ; Put back original byte RET
LFRGNM: EX DE,HL ; Code string address to HL CALL CHKSYN ; Make sure ")" follows DEFB ')'MIDNUM: POP BC ; Get return address POP DE ; Get number supplied PUSH BC ; Re-save return address LD B,E ; Number to B RET
INP: CALL MAKINT ; Make it integer A LD (INPORT),A ; Set input port CALL INPSUB ; Get input from port JP PASSA ; Return integer A
POUT: CALL SETIO ; Set up port number JP OUTSUB ; Output data and return
WAIT: CALL SETIO ; Set up port number PUSH AF ; Save AND mask LD E,0 ; Assume zero if none given DEC HL ; DEC 'cos GETCHR INCs CALL GETCHR ; Get next character JP Z,NOXOR ; No XOR byte given CALL CHKSYN ; Make sure "," follows DEFB ',' CALL GETINT ; Get integer 0-255 to XOR withNOXOR: POP BC ; Restore AND maskWAITLP: CALL INPSUB ; Get input XOR E ; Flip selected bits AND B ; Result non-zero? JP Z,WAITLP ; No = keep waiting RET
SETIO: CALL GETINT ; Get integer 0-255 LD (INPORT),A ; Set input port LD (OTPORT),A ; Set output port CALL CHKSYN ; Make sure "," follows DEFB ',' JP GETINT ; Get integer 0-255 and return
FNDNUM: CALL GETCHR ; Get next characterGETINT: CALL GETNUM ; Get a number from 0 to 255MAKINT: CALL DEPINT ; Make sure value 0 - 255 LD A,D ; Get MSB of number OR A ; Zero? JP NZ,FCERR ; No - Error DEC HL ; DEC 'cos GETCHR INCs CALL GETCHR ; Get next character LD A,E ; Get number to A RET
; << NO REFERENCE TO THIS SECTION OF CODE >>; << Set up another program area (can be in ROM) >>
LD HL,(BASTXT) ; Get start of program text LD (PROGND),HL ; Set more variable space LD HL,8000H ; Address of new program LD E,(HL) ; Get LSB of new RAM end INC HL LD D,(HL) ; Get MSB of new RAM end INC HL INC HL ; Null at start of program LD (BASTXT),HL ; New program text area 8003H EX DE,HL ; New RAM end to HL LD (LSTRAM),HL ; Set new RAM end LD (STRSPC),HL ; Clear string space LD BC,RUNCNT ; Execution driver loop PUSH BC ; Save for return JP RUNFST ; Clear variables and continue
RUART: JP GUART ; Get a byte from UART
WUART2: CALL WUART ; Send 2 Bytes to UARTWUART: PUSH AF ; Save byte PUSH BC ; Save BC LD C,A ; Byte to C CALL SUART ; Send byte to UART POP BC ; Restore BC POP AF ; Restore byte RET
CSAVE: LD B,1 ; Flag "CSAVE" CP ZTIMES ; "*" token? ("CSAVE*") JP Z,ARRSV1 ; Yes - Array save CALL EVAL ; Evaluate expression PUSH HL ; Save code string address CALL GTFLNM ; Get file name PUSH DE ; Save file name ;CALL CASFFW ; Turn on motor and wait POP DE ; Restore file name LD A,11010011B ; Header byte ;CALL WUART ; Send byte to UART ; CALL WUART2 ; Send byte twice more ;LD A,(DE) ; Get file name ;CALL WUART ; Send it to UART LD DE, (BASTXT) ; Start of program information ; LD (ARG1),HL ; Save for monitor save routine LD HL, (PROGND) ; End of program information ; LD (ARG2),HL ; Save for monitor save routine ; CALL SAVE ; Save program to tape ; CALL ARET ; Not much there!SLOOP: LD A, (DE) CALL MONOUT INC DE PUSH HL SBC HL, DE POP HL JP NZ, SLOOP
POP HL ; Restore code string address RET
CLOAD: LD A,(HL) ; Get byte after "CLOAD" CP ZTIMES ; "*" token? ("CLOAD*") JP Z,ARRLD1 ; Yes - Array load CALL SMOTOR ; Start motor and get "?" SUB ZPRINT ; "?" ("PRINT" token) Verify? JP Z,FLGVER ; Yes - Flag "verify" XOR A ; Flag "load" DEFB 01H ; Skip "CPL" and "INC HL"FLGVER: CPL ; Flag "verify" INC HL ; Skip over "?" PUSH AF ; Save verify flag DEC HL ; DEC 'cos GETCHR INCs CALL GETCHR ; Get next character LD A,0 ; Any file will do JP Z,ANYNAM ; No name given - Any will do CALL EVAL ; Evaluate expression CALL GTFLNM ; Get file name LD A,(DE) ; Get first byte of nameANYNAM: LD L,A ; Save name to find POP AF ; Get verify flag PUSH AF ; And re-save OR A ; Verify of load? LD H,A LD (FPREG),HL ; Save nam of file to find CALL Z,CLRPTR ; Load - Clear pointers LD HL,(FPREG) ; Get name of program to find EX DE,HL ; Name to DECLOAD1: LD B,3 ; 3 Header bytesCLOAD2: CALL RUART ; Get a byte from UART SUB 11010011B ; Header byte? JP NZ,CLOAD1 ; Look for header DEC B ; Count header bytes JP NZ,CLOAD2 ; More to find? CALL RUART ; Get name of file CALL FILFND ; Display "file X found" INC E ; Any file name given? DEC E JP Z,THSFIL ; No - This file will do CP E ; Has file been found? JP NZ,CLOAD1 ; No - Look for anotherTHSFIL: NOP NOP NOP POP AF ; Get verify flag OR A ; Load or verify? JP NZ,CLOADV ; Verify program CALL MONLD ; Use monitor to load program LD HL,(PROGND) ; Get end of program CALL ENFMEM ; See if enough memory JP CLOADE ; "Ok" and set up pointers
CLOADV: CALL MONVE ; Use monitor to verify programCLOADE: LD HL,OKMSG ; "Ok" message CALL PRS ; Output string CALL ARET ; Not a lot there! JP SETPTR ; Set up line pointers
OUTBAD: LD HL,BAD ; "Bad" message CALL PRS ; Output string JP ERRIN ; In line message
FILFND: PUSH BC ; <- Save PUSH HL ; <- all PUSH DE ; <- the PUSH AF ; <- registers LD HL,FILE ; "File" message CALL PRS ; Output string POP AF ; Get file name PUSH AF ; And re-save CALL CONMON ; Output file name to screen LD HL,FOUND ; "Found" message CALL PRS ; Output string POP AF ; <- Restore POP DE ; <- all POP HL ; <- the POP BC ; <- registers RET
FILE: DEFB "File ",0FOUND: DEFB " Found",CR,LF,0BAD: DEFB "Bad",0,0,0
PEEK: CALL DEINT ; Get memory address LD A,(DE) ; Get byte in memory JP PASSA ; Return integer A
POKE: CALL GETNUM ; Get memory address CALL DEINT ; Get integer -32768 to 3276 PUSH DE ; Save memory address CALL CHKSYN ; Make sure "," follows DEFB "," CALL GETINT ; Get integer 0-255 POP DE ; Restore memory address LD (DE),A ; Load it into memory RET
ROUND: LD HL,HALF ; Add 0.5 to FPREGADDPHL: CALL LOADFP ; Load FP at (HL) to BCDE JP FPADD ; Add BCDE to FPREG
SUBPHL: CALL LOADFP ; FPREG = -FPREG + number at HL DEFB 21H ; Skip "POP BC" and "POP DE"PSUB: POP BC ; Get FP number from stack POP DESUBCDE: CALL INVSGN ; Negate FPREGFPADD: LD A,B ; Get FP exponent OR A ; Is number zero? RET Z ; Yes - Nothing to add LD A,(FPEXP) ; Get FPREG exponent OR A ; Is this number zero? JP Z,FPBCDE ; Yes - Move BCDE to FPREG SUB B ; BCDE number larger? JP NC,NOSWAP ; No - Don't swap them CPL ; Two's complement INC A ; FP exponent EX DE,HL CALL STAKFP ; Put FPREG on stack EX DE,HL CALL FPBCDE ; Move BCDE to FPREG POP BC ; Restore number from stack POP DENOSWAP: CP 24+1 ; Second number insignificant? RET NC ; Yes - First number is result PUSH AF ; Save number of bits to scale CALL SIGNS ; Set MSBs & sign of result LD H,A ; Save sign of result POP AF ; Restore scaling factor CALL SCALE ; Scale BCDE to same exponent OR H ; Result to be positive? LD HL,FPREG ; Point to FPREG JP P,MINCDE ; No - Subtract FPREG from CDE CALL PLUCDE ; Add FPREG to CDE JP NC,RONDUP ; No overflow - Round it up INC HL ; Point to exponent INC (HL) ; Increment it JP Z,OVERR ; Number overflowed - Error LD L,1 ; 1 bit to shift right CALL SHRT1 ; Shift result right JP RONDUP ; Round it up
MINCDE: XOR A ; Clear A and carry SUB B ; Negate exponent LD B,A ; Re-save exponent LD A,(HL) ; Get LSB of FPREG SBC A, E ; Subtract LSB of BCDE LD E,A ; Save LSB of BCDE INC HL LD A,(HL) ; Get NMSB of FPREG SBC A,D ; Subtract NMSB of BCDE LD D,A ; Save NMSB of BCDE INC HL LD A,(HL) ; Get MSB of FPREG SBC A,C ; Subtract MSB of BCDE LD C,A ; Save MSB of BCDECONPOS: CALL C,COMPL ; Overflow - Make it positive
BNORM: LD L,B ; L = Exponent LD H,E ; H = LSB XOR ABNRMLP: LD B,A ; Save bit count LD A,C ; Get MSB OR A ; Is it zero? JP NZ,PNORM ; No - Do it bit at a time LD C,D ; MSB = NMSB LD D,H ; NMSB= LSB LD H,L ; LSB = VLSB LD L,A ; VLSB= 0 LD A,B ; Get exponent SUB 8 ; Count 8 bits CP -24-8 ; Was number zero? JP NZ,BNRMLP ; No - Keep normalisingRESZER: XOR A ; Result is zeroSAVEXP: LD (FPEXP),A ; Save result as zero RET
NORMAL: DEC B ; Count bits ADD HL,HL ; Shift HL left LD A,D ; Get NMSB RLA ; Shift left with last bit LD D,A ; Save NMSB LD A,C ; Get MSB ADC A,A ; Shift left with last bit LD C,A ; Save MSBPNORM: JP P,NORMAL ; Not done - Keep going LD A,B ; Number of bits shifted LD E,H ; Save HL in EB LD B,L OR A ; Any shifting done? JP Z,RONDUP ; No - Round it up LD HL,FPEXP ; Point to exponent ADD A,(HL) ; Add shifted bits LD (HL),A ; Re-save exponent JP NC,RESZER ; Underflow - Result is zero RET Z ; Result is zeroRONDUP: LD A,B ; Get VLSB of numberRONDEFB: LD HL,FPEXP ; Point to exponent OR A ; Any rounding? CALL M,FPROND ; Yes - Round number up LD B,(HL) ; B = Exponent INC HL LD A,(HL) ; Get sign of result AND 10000000B ; Only bit 7 needed XOR C ; Set correct sign LD C,A ; Save correct sign in number JP FPBCDE ; Move BCDE to FPREG
FPROND: INC E ; Round LSB RET NZ ; Return if ok INC D ; Round NMSB RET NZ ; Return if ok INC C ; Round MSB RET NZ ; Return if ok LD C,80H ; Set normal value INC (HL) ; Increment exponent RET NZ ; Return if ok JP OVERR ; Overflow error
PLUCDE: LD A,(HL) ; Get LSB of FPREG ADD A,E ; Add LSB of BCDE LD E,A ; Save LSB of BCDE INC HL LD A,(HL) ; Get NMSB of FPREG ADC A,D ; Add NMSB of BCDE LD D,A ; Save NMSB of BCDE INC HL LD A,(HL) ; Get MSB of FPREG ADC A,C ; Add MSB of BCDE LD C,A ; Save MSB of BCDE RET
COMPL: LD HL,SGNRES ; Sign of result LD A,(HL) ; Get sign of result CPL ; Negate it LD (HL),A ; Put it back XOR A LD L,A ; Set L to zero SUB B ; Negate exponent,set carry LD B,A ; Re-save exponent LD A,L ; Load zero SBC A,E ; Negate LSB LD E,A ; Re-save LSB LD A,L ; Load zero SBC A,D ; Negate NMSB LD D,A ; Re-save NMSB LD A,L ; Load zero SBC A,C ; Negate MSB LD C,A ; Re-save MSB RET
SCALE: LD B,0 ; Clear underflowSCALLP: SUB 8 ; 8 bits (a whole byte)? JP C,SHRITE ; No - Shift right A bits LD B,E ; <- Shift LD E,D ; <- right LD D,C ; <- eight LD C,0 ; <- bits JP SCALLP ; More bits to shift
SHRITE: ADD A,8+1 ; Adjust count LD L,A ; Save bits to shiftSHRLP: XOR A ; Flag for all done DEC L ; All shifting done? RET Z ; Yes - Return LD A,C ; Get MSBSHRT1: RRA ; Shift it right LD C,A ; Re-save LD A,D ; Get NMSB RRA ; Shift right with last bit LD D,A ; Re-save it LD A,E ; Get LSB RRA ; Shift right with last bit LD E,A ; Re-save it LD A,B ; Get underflow RRA ; Shift right with last bit LD B,A ; Re-save underflow JP SHRLP ; More bits to do
UNITY: DEFB 000H,000H,000H,081H ; 1.00000
LOGTAB: DEFB 3 ; Table used by LOG DEFB 0AAH,056H,019H,080H ; 0.59898 DEFB 0F1H,022H,076H,080H ; 0.96147 DEFB 045H,0AAH,038H,082H ; 2.88539
LOG: CALL TSTSGN ; Test sign of value OR A JP PE,FCERR ; ?FC Error if <= zero LD HL,FPEXP ; Point to exponent LD A,(HL) ; Get exponent LD BC,8035H ; BCDE = SQR(1/2) LD DE,04F3H SUB B ; Scale value to be < 1 PUSH AF ; Save scale factor LD (HL),B ; Save new exponent PUSH DE ; Save SQR(1/2) PUSH BC CALL FPADD ; Add SQR(1/2) to value POP BC ; Restore SQR(1/2) POP DE INC B ; Make it SQR(2) CALL DVBCDE ; Divide by SQR(2) LD HL,UNITY ; Point to 1. CALL SUBPHL ; Subtract FPREG from 1 LD HL,LOGTAB ; Coefficient table CALL SUMSER ; Evaluate sum of series LD BC,8080H ; BCDE = -0.5 LD DE,0000H CALL FPADD ; Subtract 0.5 from FPREG POP AF ; Restore scale factor CALL RSCALE ; Re-scale numberMULLN2: LD BC,8031H ; BCDE = Ln(2) LD DE,7218H DEFB 21H ; Skip "POP BC" and "POP DE"
MULT: POP BC ; Get number from stack POP DEFPMULT: CALL TSTSGN ; Test sign of FPREG RET Z ; Return zero if zero LD L,0 ; Flag add exponents CALL ADDEXP ; Add exponents LD A,C ; Get MSB of multiplier LD (MULVAL),A ; Save MSB of multiplier EX DE,HL LD (MULVAL+1),HL ; Save rest of multiplier LD BC,0 ; Partial product (BCDE) = zero LD D,B LD E,B LD HL,BNORM ; Address of normalise PUSH HL ; Save for return LD HL,MULT8 ; Address of 8 bit multiply PUSH HL ; Save for NMSB,MSB PUSH HL ; LD HL,FPREG ; Point to numberMULT8: LD A,(HL) ; Get LSB of number INC HL ; Point to NMSB OR A ; Test LSB JP Z,BYTSFT ; Zero - shift to next byte PUSH HL ; Save address of number LD L,8 ; 8 bits to multiply byMUL8LP: RRA ; Shift LSB right LD H,A ; Save LSB LD A,C ; Get MSB JP NC,NOMADD ; Bit was zero - Don't add PUSH HL ; Save LSB and count LD HL,(MULVAL+1) ; Get LSB and NMSB ADD HL,DE ; Add NMSB and LSB EX DE,HL ; Leave sum in DE POP HL ; Restore MSB and count LD A,(MULVAL) ; Get MSB of multiplier ADC A,C ; Add MSBNOMADD: RRA ; Shift MSB right LD C,A ; Re-save MSB LD A,D ; Get NMSB RRA ; Shift NMSB right LD D,A ; Re-save NMSB LD A,E ; Get LSB RRA ; Shift LSB right LD E,A ; Re-save LSB LD A,B ; Get VLSB RRA ; Shift VLSB right LD B,A ; Re-save VLSB DEC L ; Count bits multiplied LD A,H ; Get LSB of multiplier JP NZ,MUL8LP ; More - Do itPOPHRT: POP HL ; Restore address of number RET
BYTSFT: LD B,E ; Shift partial product left LD E,D LD D,C LD C,A RET
DIV10: CALL STAKFP ; Save FPREG on stack LD BC,8420H ; BCDE = 10. LD DE,0000H CALL FPBCDE ; Move 10 to FPREG
DIV: POP BC ; Get number from stack POP DEDVBCDE: CALL TSTSGN ; Test sign of FPREG JP Z,DZERR ; Error if division by zero LD L,-1 ; Flag subtract exponents CALL ADDEXP ; Subtract exponents INC (HL) ; Add 2 to exponent to adjust INC (HL) DEC HL ; Point to MSB LD A,(HL) ; Get MSB of dividend LD (DIV3),A ; Save for subtraction DEC HL LD A,(HL) ; Get NMSB of dividend LD (DIV2),A ; Save for subtraction DEC HL LD A,(HL) ; Get MSB of dividend LD (DIV1),A ; Save for subtraction LD B,C ; Get MSB EX DE,HL ; NMSB,LSB to HL XOR A LD C,A ; Clear MSB of quotient LD D,A ; Clear NMSB of quotient LD E,A ; Clear LSB of quotient LD (DIV4),A ; Clear overflow countDIVLP: PUSH HL ; Save divisor PUSH BC LD A,L ; Get LSB of number CALL DIVSUP ; Subt' divisor from dividend SBC A,0 ; Count for overflows CCF JP NC,RESDIV ; Restore divisor if borrow LD (DIV4),A ; Re-save overflow count POP AF ; Scrap divisor POP AF SCF ; Set carry to DEFB 0D2H ; Skip "POP BC" and "POP HL"
RESDIV: POP BC ; Restore divisor POP HL LD A,C ; Get MSB of quotient INC A DEC A RRA ; Bit 0 to bit 7 JP M,RONDEFB ; Done - Normalise result RLA ; Restore carry LD A,E ; Get LSB of quotient RLA ; Double it LD E,A ; Put it back LD A,D ; Get NMSB of quotient RLA ; Double it LD D,A ; Put it back LD A,C ; Get MSB of quotient RLA ; Double it LD C,A ; Put it back ADD HL,HL ; Double NMSB,LSB of divisor LD A,B ; Get MSB of divisor RLA ; Double it LD B,A ; Put it back LD A,(DIV4) ; Get VLSB of quotient RLA ; Double it LD (DIV4),A ; Put it back LD A,C ; Get MSB of quotient OR D ; Merge NMSB OR E ; Merge LSB JP NZ,DIVLP ; Not done - Keep dividing PUSH HL ; Save divisor LD HL,FPEXP ; Point to exponent DEC (HL) ; Divide by 2 POP HL ; Restore divisor JP NZ,DIVLP ; Ok - Keep going JP OVERR ; Overflow error
ADDEXP: LD A,B ; Get exponent of dividend OR A ; Test it JP Z,OVTST3 ; Zero - Result zero LD A,L ; Get add/subtract flag LD HL,FPEXP ; Point to exponent XOR (HL) ; Add or subtract it ADD A,B ; Add the other exponent LD B,A ; Save new exponent RRA ; Test exponent for overflow XOR B LD A,B ; Get exponent JP P,OVTST2 ; Positive - Test for overflow ADD A,80H ; Add excess 128 LD (HL),A ; Save new exponent JP Z,POPHRT ; Zero - Result zero CALL SIGNS ; Set MSBs and sign of result LD (HL),A ; Save new exponent DEC HL ; Point to MSB RET
OVTST1: CALL TSTSGN ; Test sign of FPREG CPL ; Invert sign POP HL ; Clean up stackOVTST2: OR A ; Test if new exponent zeroOVTST3: POP HL ; Clear off return address JP P,RESZER ; Result zero JP OVERR ; Overflow error
MLSP10: CALL BCDEFP ; Move FPREG to BCDE LD A,B ; Get exponent OR A ; Is it zero? RET Z ; Yes - Result is zero ADD A,2 ; Multiply by 4 JP C,OVERR ; Overflow - ?OV Error LD B,A ; Re-save exponent CALL FPADD ; Add BCDE to FPREG (Times 5) LD HL,FPEXP ; Point to exponent INC (HL) ; Double number (Times 10) RET NZ ; Ok - Return JP OVERR ; Overflow error
TSTSGN: LD A,(FPEXP) ; Get sign of FPREG OR A RET Z ; RETurn if number is zero LD A,(FPREG+2) ; Get MSB of FPREG DEFB 0FEH ; Test signRETREL: CPL ; Invert sign RLA ; Sign bit to carryFLGDIF: SBC A,A ; Carry to all bits of A RET NZ ; Return -1 if negative INC A ; Bump to +1 RET ; Positive - Return +1
SGN: CALL TSTSGN ; Test sign of FPREGFLGREL: LD B,80H+8 ; 8 bit integer in exponent LD DE,0 ; Zero NMSB and LSBRETINT: LD HL,FPEXP ; Point to exponent LD C,A ; CDE = MSB,NMSB and LSB LD (HL),B ; Save exponent LD B,0 ; CDE = integer to normalise INC HL ; Point to sign of result LD (HL),80H ; Set sign of result RLA ; Carry = sign of integer JP CONPOS ; Set sign of result
ABS: CALL TSTSGN ; Test sign of FPREG RET P ; Return if positiveINVSGN: LD HL,FPREG+2 ; Point to MSB LD A,(HL) ; Get sign of mantissa XOR 80H ; Invert sign of mantissa LD (HL),A ; Re-save sign of mantissa RET
STAKFP: EX DE,HL ; Save code string address LD HL,(FPREG) ; LSB,NLSB of FPREG EX (SP),HL ; Stack them,get return PUSH HL ; Re-save return LD HL,(FPREG+2) ; MSB and exponent of FPREG EX (SP),HL ; Stack them,get return PUSH HL ; Re-save return EX DE,HL ; Restore code string address RET
PHLTFP: CALL LOADFP ; Number at HL to BCDEFPBCDE: EX DE,HL ; Save code string address LD (FPREG),HL ; Save LSB,NLSB of number LD H,B ; Exponent of number LD L,C ; MSB of number LD (FPREG+2),HL ; Save MSB and exponent EX DE,HL ; Restore code string address RET
BCDEFP: LD HL,FPREG ; Point to FPREGLOADFP: LD E,(HL) ; Get LSB of number INC HL LD D,(HL) ; Get NMSB of number INC HL LD C,(HL) ; Get MSB of number INC HL LD B,(HL) ; Get exponent of numberINCHL: INC HL ; Used for conditional "INC HL" RET
FPTHL: LD DE,FPREG ; Point to FPREGDETHL4: LD B,4 ; 4 bytes to moveDETHLB: LD A,(DE) ; Get source LD (HL),A ; Save destination INC DE ; Next source INC HL ; Next destination DEC B ; Count bytes JP NZ,DETHLB ; Loop if more RET
SIGNS: LD HL,FPREG+2 ; Point to MSB of FPREG LD A,(HL) ; Get MSB RLCA ; Old sign to carry SCF ; Set MSBit RRA ; Set MSBit of MSB LD (HL),A ; Save new MSB CCF ; Complement sign RRA ; Old sign to carry INC HL INC HL LD (HL),A ; Set sign of result LD A,C ; Get MSB RLCA ; Old sign to carry SCF ; Set MSBit RRA ; Set MSBit of MSB LD C,A ; Save MSB RRA XOR (HL) ; New sign of result RET
CMPNUM: LD A,B ; Get exponent of number OR A JP Z,TSTSGN ; Zero - Test sign of FPREG LD HL,RETREL ; Return relation routine PUSH HL ; Save for return CALL TSTSGN ; Test sign of FPREG LD A,C ; Get MSB of number RET Z ; FPREG zero - Number's MSB LD HL,FPREG+2 ; MSB of FPREG XOR (HL) ; Combine signs LD A,C ; Get MSB of number RET M ; Exit if signs different CALL CMPFP ; Compare FP numbers RRA ; Get carry to sign XOR C ; Combine with MSB of number RET
CMPFP: INC HL ; Point to exponent LD A,B ; Get exponent CP (HL) ; Compare exponents RET NZ ; Different DEC HL ; Point to MBS LD A,C ; Get MSB CP (HL) ; Compare MSBs RET NZ ; Different DEC HL ; Point to NMSB LD A,D ; Get NMSB CP (HL) ; Compare NMSBs RET NZ ; Different DEC HL ; Point to LSB LD A,E ; Get LSB SUB (HL) ; Compare LSBs RET NZ ; Different POP HL ; Drop RETurn POP HL ; Drop another RETurn RET
FPINT: LD B,A ; <- Move LD C,A ; <- exponent LD D,A ; <- to all LD E,A ; <- bits OR A ; Test exponent RET Z ; Zero - Return zero PUSH HL ; Save pointer to number CALL BCDEFP ; Move FPREG to BCDE CALL SIGNS ; Set MSBs & sign of result XOR (HL) ; Combine with sign of FPREG LD H,A ; Save combined signs CALL M,DCBCDE ; Negative - Decrement BCDE LD A,80H+24 ; 24 bits SUB B ; Bits to shift CALL SCALE ; Shift BCDE LD A,H ; Get combined sign RLA ; Sign to carry CALL C,FPROND ; Negative - Round number up LD B,0 ; Zero exponent CALL C,COMPL ; If negative make positive POP HL ; Restore pointer to number RET
DCBCDE: DEC DE ; Decrement BCDE LD A,D ; Test LSBs AND E INC A RET NZ ; Exit if LSBs not FFFF DEC BC ; Decrement MSBs RET
INT: LD HL,FPEXP ; Point to exponent LD A,(HL) ; Get exponent CP 80H+24 ; Integer accuracy only? LD A,(FPREG) ; Get LSB RET NC ; Yes - Already integer LD A,(HL) ; Get exponent CALL FPINT ; F.P to integer LD (HL),80H+24 ; Save 24 bit integer LD A,E ; Get LSB of number PUSH AF ; Save LSB LD A,C ; Get MSB of number RLA ; Sign to carry CALL CONPOS ; Set sign of result POP AF ; Restore LSB of number RET
MLDEBC: LD HL,0 ; Clear partial product LD A,B ; Test multiplier OR C RET Z ; Return zero if zero LD A,16 ; 16 bitsMLDEFBLP: ADD HL,HL ; Shift P.P left JP C,BSERR ; ?BS Error if overflow EX DE,HL ADD HL,HL ; Shift multiplier left EX DE,HL JP NC,NOMLAD ; Bit was zero - No add ADD HL,BC ; Add multiplicand JP C,BSERR ; ?BS Error if overflowNOMLAD: DEC A ; Count bits JP NZ,MLDEFBLP ; More RET
ASCTFP: CP '-' ; Negative? PUSH AF ; Save it and flags JP Z,CNVNUM ; Yes - Convert number CP '+' ; Positive? JP Z,CNVNUM ; Yes - Convert number DEC HL ; DEC 'cos GETCHR INCsCNVNUM: CALL RESZER ; Set result to zero LD B,A ; Digits after point counter LD D,A ; Sign of exponent LD E,A ; Exponent of ten CPL LD C,A ; Before or after point flagMANLP: CALL GETCHR ; Get next character JP C,ADDIG ; Digit - Add to number CP '.' JP Z,DPOINT ; "." - Flag point CP 'E' JP NZ,CONEXP ; Not "E" - Scale number CALL GETCHR ; Get next character CALL SGNEXP ; Get sign of exponentEXPLP: CALL GETCHR ; Get next character JP C,EDIGIT ; Digit - Add to exponent INC D ; Is sign negative? JP NZ,CONEXP ; No - Scale number XOR A SUB E ; Negate exponent LD E,A ; And re-save it INC C ; Flag end of numberDPOINT: INC C ; Flag point passed JP Z,MANLP ; Zero - Get another digitCONEXP: PUSH HL ; Save code string address LD A,E ; Get exponent SUB B ; Subtract digits after pointSCALMI: CALL P,SCALPL ; Positive - Multiply number JP P,ENDCON ; Positive - All done PUSH AF ; Save number of times to /10 CALL DIV10 ; Divide by 10 POP AF ; Restore count INC A ; Count divides
ENDCON: JP NZ,SCALMI ; More to do POP DE ; Restore code string address POP AF ; Restore sign of number CALL Z,INVSGN ; Negative - Negate number EX DE,HL ; Code string address to HL RET
SCALPL: RET Z ; Exit if no scaling neededMULTEN: PUSH AF ; Save count CALL MLSP10 ; Multiply number by 10 POP AF ; Restore count DEC A ; Count multiplies RET
ADDIG: PUSH DE ; Save sign of exponent LD D,A ; Save digit LD A,B ; Get digits after point ADC A,C ; Add one if after point LD B,A ; Re-save counter PUSH BC ; Save point flags PUSH HL ; Save code string address PUSH DE ; Save digit CALL MLSP10 ; Multiply number by 10 POP AF ; Restore digit SUB '0' ; Make it absolute CALL RSCALE ; Re-scale number POP HL ; Restore code string address POP BC ; Restore point flags POP DE ; Restore sign of exponent JP MANLP ; Get another digit
RSCALE: CALL STAKFP ; Put number on stack CALL FLGREL ; Digit to add to FPREGPADD: POP BC ; Restore number POP DE JP FPADD ; Add BCDE to FPREG and return
EDIGIT: LD A,E ; Get digit RLCA ; Times 2 RLCA ; Times 4 ADD A,E ; Times 5 RLCA ; Times 10 ADD A,(HL) ; Add next digit SUB '0' ; Make it absolute LD E,A ; Save new digit JP EXPLP ; Look for another digit
LINEIN: PUSH HL ; Save code string address LD HL,INMSG ; Output " in " CALL PRS ; Output string at HL POP HL ; Restore code string addressPRNTHL: EX DE,HL ; Code string address to DE XOR A LD B,80H+24 ; 24 bits CALL RETINT ; Return the integer LD HL,PRNUMS ; Print number string PUSH HL ; Save for returnNUMASC: LD HL,PBUFF ; Convert number to ASCII PUSH HL ; Save for return CALL TSTSGN ; Test sign of FPREG LD (HL),' ' ; Space at start JP P,SPCFST ; Positive - Space to start LD (HL),'-' ; "-" sign at startSPCFST: INC HL ; First byte of number LD (HL),'0' ; "0" if zero JP Z,JSTZER ; Return "0" if zero PUSH HL ; Save buffer address CALL M,INVSGN ; Negate FPREG if negative XOR A ; Zero A PUSH AF ; Save it CALL RNGTST ; Test number is in rangeSIXDIG: LD BC,9143H ; BCDE - 99999.9 LD DE,4FF8H CALL CMPNUM ; Compare numbers OR A JP PO,INRNG ; > 99999.9 - Sort it out POP AF ; Restore count CALL MULTEN ; Multiply by ten PUSH AF ; Re-save count JP SIXDIG ; Test it again
GTSIXD: CALL DIV10 ; Divide by 10 POP AF ; Get count INC A ; Count divides PUSH AF ; Re-save count CALL RNGTST ; Test number is in rangeINRNG: CALL ROUND ; Add 0.5 to FPREG INC A CALL FPINT ; F.P to integer CALL FPBCDE ; Move BCDE to FPREG LD BC,0306H ; 1E+06 to 1E-03 range POP AF ; Restore count ADD A,C ; 6 digits before point INC A ; Add one JP M,MAKNUM ; Do it in "E" form if < 1E-02 CP 6+1+1 ; More than 999999 ? JP NC,MAKNUM ; Yes - Do it in "E" form INC A ; Adjust for exponent LD B,A ; Exponent of number LD A,2 ; Make it zero after
MAKNUM: DEC A ; Adjust for digits to do DEC A POP HL ; Restore buffer address PUSH AF ; Save count LD DE,POWERS ; Powers of ten DEC B ; Count digits before point JP NZ,DIGTXT ; Not zero - Do number LD (HL),'.' ; Save point INC HL ; Move on LD (HL),'0' ; Save zero INC HL ; Move onDIGTXT: DEC B ; Count digits before point LD (HL),'.' ; Save point in case CALL Z,INCHL ; Last digit - move on PUSH BC ; Save digits before point PUSH HL ; Save buffer address PUSH DE ; Save powers of ten CALL BCDEFP ; Move FPREG to BCDE POP HL ; Powers of ten table LD B, '0'-1 ; ASCII "0" - 1TRYAGN: INC B ; Count subtractions LD A,E ; Get LSB SUB (HL) ; Subtract LSB LD E,A ; Save LSB INC HL LD A,D ; Get NMSB SBC A,(HL) ; Subtract NMSB LD D,A ; Save NMSB INC HL LD A,C ; Get MSB SBC A,(HL) ; Subtract MSB LD C,A ; Save MSB DEC HL ; Point back to start DEC HL JP NC,TRYAGN ; No overflow - Try again CALL PLUCDE ; Restore number INC HL ; Start of next number CALL FPBCDE ; Move BCDE to FPREG EX DE,HL ; Save point in table POP HL ; Restore buffer address LD (HL),B ; Save digit in buffer INC HL ; And move on POP BC ; Restore digit count DEC C ; Count digits JP NZ,DIGTXT ; More - Do them DEC B ; Any decimal part? JP Z,DOEBIT ; No - Do "E" bitSUPTLZ: DEC HL ; Move back through buffer LD A,(HL) ; Get character CP '0' ; "0" character? JP Z,SUPTLZ ; Yes - Look back for more CP '.' ; A decimal point? CALL NZ,INCHL ; Move back over digit
DOEBIT: POP AF ; Get "E" flag JP Z,NOENED ; No "E" needed - End buffer LD (HL),'E' ; Put "E" in buffer INC HL ; And move on LD (HL),'+' ; Put '+' in buffer JP P,OUTEXP ; Positive - Output exponent LD (HL),'-' ; Put "-" in buffer CPL ; Negate exponent INC AOUTEXP: LD B,'0'-1 ; ASCII "0" - 1EXPTEN: INC B ; Count subtractions SUB 10 ; Tens digit JP NC,EXPTEN ; More to do ADD A,'0'+10 ; Restore and make ASCII INC HL ; Move on LD (HL),B ; Save MSB of exponentJSTZER: INC HL ; LD (HL),A ; Save LSB of exponent INC HLNOENED: LD (HL),C ; Mark end of buffer POP HL ; Restore code string address RET
RNGTST: LD BC,9474H ; BCDE = 999999. LD DE,23F7H CALL CMPNUM ; Compare numbers OR A POP HL ; Return address to HL JP PO,GTSIXD ; Too big - Divide by ten JP (HL) ; Otherwise return to caller
HALF: DEFB 00H,00H,00H,80H ; 0.5
POWERS: DEFB 0A0H,086H,001H ; 100000 DEFB 010H,027H,000H ; 10000 DEFB 0E8H,003H,000H ; 1000 DEFB 064H,000H,000H ; 100 DEFB 00AH,000H,000H ; 10 DEFB 001H,000H,000H ; 1
NEGAFT: LD HL,INVSGN ; Negate result EX (SP),HL ; To be done after caller JP (HL) ; Return to caller
SQR: CALL STAKFP ; Put value on stack LD HL,HALF ; Set power to 1/2 CALL PHLTFP ; Move 1/2 to FPREG
POWER: POP BC ; Get base POP DE CALL TSTSGN ; Test sign of power LD A,B ; Get exponent of base JP Z,EXP ; Make result 1 if zero JP P,POWER1 ; Positive base - Ok OR A ; Zero to negative power? JP Z,DZERR ; Yes - ?/0 ErrorPOWER1: OR A ; Base zero? JP Z,SAVEXP ; Yes - Return zero PUSH DE ; Save base PUSH BC LD A,C ; Get MSB of base OR 01111111B ; Get sign status CALL BCDEFP ; Move power to BCDE JP P,POWER2 ; Positive base - Ok PUSH DE ; Save power PUSH BC CALL INT ; Get integer of power POP BC ; Restore power POP DE PUSH AF ; MSB of base CALL CMPNUM ; Power an integer? POP HL ; Restore MSB of base LD A,H ; but don't affect flags RRA ; Exponent odd or even?POWER2: POP HL ; Restore MSB and exponent LD (FPREG+2),HL ; Save base in FPREG POP HL ; LSBs of base LD (FPREG),HL ; Save in FPREG CALL C,NEGAFT ; Odd power - Negate result CALL Z,INVSGN ; Negative base - Negate it PUSH DE ; Save power PUSH BC CALL LOG ; Get LOG of base POP BC ; Restore power POP DE CALL FPMULT ; Multiply LOG by power
EXP: CALL STAKFP ; Put value on stack LD BC,08138H ; BCDE = 1/Ln(2) LD DE,0AA3BH CALL FPMULT ; Multiply value by 1/LN(2) LD A,(FPEXP) ; Get exponent CP 80H+8 ; Is it in range? JP NC,OVTST1 ; No - Test for overflow CALL INT ; Get INT of FPREG ADD A,80H ; For excess 128 ADD A,2 ; Exponent > 126? JP C,OVTST1 ; Yes - Test for overflow PUSH AF ; Save scaling factor LD HL,UNITY ; Point to 1. CALL ADDPHL ; Add 1 to FPREG CALL MULLN2 ; Multiply by LN(2) POP AF ; Restore scaling factor POP BC ; Restore exponent POP DE PUSH AF ; Save scaling factor CALL SUBCDE ; Subtract exponent from FPREG CALL INVSGN ; Negate result LD HL,EXPTAB ; Coefficient table CALL SMSER1 ; Sum the series LD DE,0 ; Zero LSBs POP BC ; Scaling factor LD C,D ; Zero MSB JP FPMULT ; Scale result to correct value
EXPTAB: DEFB 8 ; Table used by EXP DEFB 040H,02EH,094H,074H ; -1/7! (-1/5040) DEFB 070H,04FH,02EH,077H ; 1/6! ( 1/720) DEFB 06EH,002H,088H,07AH ; -1/5! (-1/120) DEFB 0E6H,0A0H,02AH,07CH ; 1/4! ( 1/24) DEFB 050H,0AAH,0AAH,07EH ; -1/3! (-1/6) DEFB 0FFH,0FFH,07FH,07FH ; 1/2! ( 1/2) DEFB 000H,000H,080H,081H ; -1/1! (-1/1) DEFB 000H,000H,000H,081H ; 1/0! ( 1/1)
SUMSER: CALL STAKFP ; Put FPREG on stack LD DE,MULT ; Multiply by "X" PUSH DE ; To be done after PUSH HL ; Save address of table CALL BCDEFP ; Move FPREG to BCDE CALL FPMULT ; Square the value POP HL ; Restore address of tableSMSER1: CALL STAKFP ; Put value on stack LD A,(HL) ; Get number of coefficients INC HL ; Point to start of table CALL PHLTFP ; Move coefficient to FPREG DEFB 06H ; Skip "POP AF"SUMLP: POP AF ; Restore count POP BC ; Restore number POP DE DEC A ; Cont coefficients RET Z ; All done PUSH DE ; Save number PUSH BC PUSH AF ; Save count PUSH HL ; Save address in table CALL FPMULT ; Multiply FPREG by BCDE POP HL ; Restore address in table CALL LOADFP ; Number at HL to BCDE PUSH HL ; Save address in table CALL FPADD ; Add coefficient to FPREG POP HL ; Restore address in table JP SUMLP ; More coefficients
RND: CALL TSTSGN ; Test sign of FPREG LD HL,SEED+2 ; Random number seed JP M,RESEED ; Negative - Re-seed LD HL,LSTRND ; Last random number CALL PHLTFP ; Move last RND to FPREG LD HL,SEED+2 ; Random number seed RET Z ; Return if RND(0) ADD A,(HL) ; Add (SEED)+2) AND 00000111B ; 0 to 7 LD B,0 LD (HL),A ; Re-save seed INC HL ; Move to coefficient table ADD A,A ; 4 bytes ADD A,A ; per entry LD C,A ; BC = Offset into table ADD HL,BC ; Point to coefficient CALL LOADFP ; Coefficient to BCDE CALL FPMULT ; ; Multiply FPREG by coefficient LD A,(SEED+1) ; Get (SEED+1) INC A ; Add 1 AND 00000011B ; 0 to 3 LD B,0 CP 1 ; Is it zero? ADC A,B ; Yes - Make it 1 LD (SEED+1),A ; Re-save seed LD HL,RNDTAB-4 ; Addition table ADD A,A ; 4 bytes ADD A,A ; per entry LD C,A ; BC = Offset into table ADD HL,BC ; Point to value CALL ADDPHL ; Add value to FPREGRND1: CALL BCDEFP ; Move FPREG to BCDE LD A,E ; Get LSB LD E,C ; LSB = MSB XOR 01001111B ; Fiddle around LD C,A ; New MSB LD (HL),80H ; Set exponent DEC HL ; Point to MSB LD B,(HL) ; Get MSB LD (HL),80H ; Make value -0.5 LD HL,SEED ; Random number seed INC (HL) ; Count seed LD A,(HL) ; Get seed SUB 171 ; Do it modulo 171 JP NZ,RND2 ; Non-zero - Ok LD (HL),A ; Zero seed INC C ; Fillde about DEC D ; with the INC E ; numberRND2: CALL BNORM ; Normalise number LD HL,LSTRND ; Save random number JP FPTHL ; Move FPREG to last and return
RESEED: LD (HL),A ; Re-seed random numbers DEC HL LD (HL),A DEC HL LD (HL),A JP RND1 ; Return RND seed
RNDTAB: DEFB 068H,0B1H,046H,068H ; Table used by RND DEFB 099H,0E9H,092H,069H DEFB 010H,0D1H,075H,068H
COS: LD HL,HALFPI ; Point to PI/2 CALL ADDPHL ; Add it to PPREGSIN: CALL STAKFP ; Put angle on stack LD BC,8349H ; BCDE = 2 PI LD DE,0FDEFBH CALL FPBCDE ; Move 2 PI to FPREG POP BC ; Restore angle POP DE CALL DVBCDE ; Divide angle by 2 PI CALL STAKFP ; Put it on stack CALL INT ; Get INT of result POP BC ; Restore number POP DE CALL SUBCDE ; Make it 0 <= value < 1 LD HL,QUARTR ; Point to 0.25 CALL SUBPHL ; Subtract value from 0.25 CALL TSTSGN ; Test sign of value SCF ; Flag positive JP P,SIN1 ; Positive - Ok CALL ROUND ; Add 0.5 to value CALL TSTSGN ; Test sign of value OR A ; Flag negativeSIN1: PUSH AF ; Save sign CALL P,INVSGN ; Negate value if positive LD HL,QUARTR ; Point to 0.25 CALL ADDPHL ; Add 0.25 to value POP AF ; Restore sign CALL NC,INVSGN ; Negative - Make positive LD HL,SINTAB ; Coefficient table JP SUMSER ; Evaluate sum of series
HALFPI: DEFB 0DBH,00FH,049H,081H ; 1.5708 (PI/2)
QUARTR: DEFB 000H,000H,000H,07FH ; 0.25
SINTAB: DEFB 5 ; Table used by SIN DEFB 0BAH,0D7H,01EH,086H ; 39.711 DEFB 064H,026H,099H,087H ;-76.575 DEFB 058H,034H,023H,087H ; 81.602 DEFB 0E0H,05DH,0A5H,086H ;-41.342 DEFB 0DAH,00FH,049H,083H ; 6.2832
TAN: CALL STAKFP ; Put angle on stack CALL SIN ; Get SIN of angle POP BC ; Restore angle POP HL CALL STAKFP ; Save SIN of angle EX DE,HL ; BCDE = Angle CALL FPBCDE ; Angle to FPREG CALL COS ; Get COS of angle JP DIV ; TAN = SIN / COS
ATN: CALL TSTSGN ; Test sign of value CALL M,NEGAFT ; Negate result after if -ve CALL M,INVSGN ; Negate value if -ve LD A,(FPEXP) ; Get exponent CP 81H ; Number less than 1? JP C,ATN1 ; Yes - Get arc tangnt LD BC,8100H ; BCDE = 1 LD D,C LD E,C CALL DVBCDE ; Get reciprocal of number LD HL,SUBPHL ; Sub angle from PI/2 PUSH HL ; Save for angle > 1ATN1: LD HL,ATNTAB ; Coefficient table CALL SUMSER ; Evaluate sum of series LD HL,HALFPI ; PI/2 - angle in case > 1 RET ; Number > 1 - Sub from PI/2
ATNTAB: DEFB 9 ; Table used by ATN DEFB 04AH,0D7H,03BH,078H ; 1/17 DEFB 002H,06EH,084H,07BH ;-1/15 DEFB 0FEH,0C1H,02FH,07CH ; 1/13 DEFB 074H,031H,09AH,07DH ;-1/11 DEFB 084H,03DH,05AH,07DH ; 1/9 DEFB 0C8H,07FH,091H,07EH ;-1/7 DEFB 0E4H,0BBH,04CH,07EH ; 1/5 DEFB 06CH,0AAH,0AAH,07FH ;-1/3 DEFB 000H,000H,000H,081H ; 1/1
CASFFW: CALL FLPLED ; Turn on cassette LD B,0 ; Set 1 second delayDELAYB: CALL DELAY ; Wait a bit DEC B ; Count JP NZ,DELAYB ; More delay needed RET
CASFF: JP FLPLED ; Flip tape LED
ARET: RET ; A RETurn instruction
CONMON: PUSH HL ; Output character to screen PUSH BC ; PUSH DE ; PUSH AF ; ; CALL MONTST ; See if NAS-SYS ;JP NZ,NASOUT ; NAS-SYS - Output ASCII ;JP NASOUT POP AF ; Get character PUSH AF ; And re-save ;CP LF ; ASCII Line feed? ;JP Z,IGCHR ; Yes - Ignore it ;CP BKSP ; ASCII back space? ;JP NZ,CONOT1 ; No - Test for CR ;LD A,TBS ; NASBUG back spaceCONOT1: CP CR ; ASCII CR? ;JP NZ,OUTCHR ; No - Output character ;LD A,TCR ; NASBUG CR JP OUTCHR ; Output it
NASOUT: POP AF ; Get character PUSH AF ; And re-saveOUTCHR: CALL MONOUT ; Output itIGCHR: POP AF ; Restore character POP DE ; POP BC ; POP HL ; RET
GETINP: PUSH HL ; Get an input character PUSH BC ; PUSH DE ; ;CALL MONTST ; See if NAS-SYS ;JP GETTIN ; JP Z,GETTIN ; "T" monitor - Get input ; DEFW _BLNK ;JP CONVIN ; Convert to ASCII
GETTIN: CALL TIN ; "T" input a character AND A JP Z,GETTIN ; No input - waitCONVIN: CP TBS ; NASBUG back space? JP NZ,CNVIN1 ; No - Test for break LD A,BKSP ; ASCII back spaceCNVIN1: CP TBRK ; NASBUG break? JP NZ,CNVIN2 ; No - Test for control Z LD A,CTRLC ; Control CCNVIN2: CP CTRLZ ; ^Z? JP NZ,CNVIN3 ; No - Test for escape LD A,DEL ; DeleteCNVIN3: CP ESC ; "ESC" ? JP NZ,CNVIN4 ; No - Test for CR LD A,CTRLC ; Control CCNVIN4: CP TCR ; NASBUG CR? JP NZ,CNVIN5 ; No - Return character LD A,CR ; ASCII CRCNVIN5: POP DE POP BC POP HL RET
CHKBRK: CALL TIN ; "T" input a character AND A JP Z, CHKRNT ; No input - wait ;IN A, (40H) CP CTRLZ JP NZ,CHKRNT LD (BRKFLG), A ;XOR A ; Check for break ;CALL SFTENT ; Test for shift/enter
JP Z,TBRK2 ; Yes - Test for second break LD A,(BRKFLG) ; Get break flag OR A ; Break flag set? JP NZ,TBRK2 ; Yes - Test for second break XOR A ; Flag no breakCHKRNT: RET
TBRK2: CALL BREAK2 ; Second break? LD A,-1 ; Flag break RET
GUART: IN A,(UARTS) ; Get UART status RLA ; Any data ready? JP NC,GUART ; No - wait until there is IN A,(UARTD) ; Get data from UART RET
UARTOT: OUT (UARTD),A ; Send data to UARTURTOLP: IN A,(UARTS) ; Get status ADD A,A ; Byte sent? RET M ; Yes - Return JP URTOLP ; Keep waiting
SUART: PUSH AF ; Save A CALL UARTOT ; Send it to UART POP AF ; Restore A RET
NOP NOP
SFTENT: PUSH HL ; Test for Shift Enter from KBD LD A,00000010B ; Reset KBD counter mask ;LD HL,PORT0 ; Get old contents XOR (HL) ; Toggle bit OUT (0),A ; Reset KBD counter XOR 00000001B ; Toggle bit OUT (0),A ; Next row XOR 00000010B OUT (0),A ; Clear "clear" strobe LD A,(HL) ; Get old value OUT (0),A ; Original contents ADD HL,DE ; ?? WHAT ?? POP HL ; Restore HL IN A,(0) ; Read in row AND 00010010B ; Mask SHIFT and ENTER RET
CLS: ;CALL MONTST ; See if NAS-SYS ;JP Z,TCLS ; "T" CLS LD A,CS ; ASCII Clear screen JP CONMON ; Output character
TCLS: LD A,TCS ; NASBUG Clear screen JP CONMON ; Output character
DELAY: XOR A ; Delay routineDELAY1: PUSH AF ; PUSHes and POPs delay POP AF PUSH AF POP AF DEC A ; Count delays JP NZ,DELAY1 ; More delay RET
WIDTH: CALL GETINT ; Get integer 0-255 LD A,E ; Width to A LD (LWIDTH),A ; Set width RET
LINES: CALL GETNUM ; Get a number CALL DEINT ; Get integer -32768 to 32767 LD (LINESC),DE ; Set lines counter LD (LINESN),DE ; Set lines number RET
DEEK: CALL DEINT ; Get integer -32768 to 32767 PUSH DE ; Save number POP HL ; Number to HL LD B,(HL) ; Get LSB of contents INC HL LD A,(HL) ; Get MSB of contents JP ABPASS ; Return integer AB
DOKE: CALL GETNUM ; Get a number CALL DEINT ; Get integer -32768 to 32767 PUSH DE ; Save address CALL CHKSYN ; Make sure "," follows DEFB ',' CALL GETNUM ; Get a number CALL DEINT ; Get integer -32768 to 32767 EX (SP),HL ; Save value,get address LD (HL),E ; Save LSB of value INC HL LD (HL),D ; Save MSB of value POP HL ; Restore code string address RET
JJUMP1: DI ; Disable interrupts LD IX,-1 ; Flag cold start JP CSTART ; Go and initialise
SCREEN: CALL GETINT ; Get integer 0 to 255 PUSH AF ; Save column CALL CHKSYN ; Make sure "," follows DEFB ',' CALL GETINT ; Get integer 0 to 255 POP BC ; Column to B PUSH HL ; Save code string address PUSH BC ; Save column CALL SCRADR ; Calculate screen address PUSH HL ; Save screen address ;CALL MONTST ; See if NAS-SYS ;JP Z,TMNCUR ; "T" monitor - "T" cursor ;POP HL ; Restore screen address ;LD (CURSOR),HL ; Set new cursor position ;POP HL ; Rstore code string address RET
TMNCUR: ;LD HL,(TCUR) ; Get address or cursor LD (HL),' ' ; Remove cursor POP HL ; Get new cursor address ;LD (TCUR),HL ; Set new cursor LD (HL),'_' ; Put it on screen POP HL ; Restore code string address RET
SCRADR: ;LD HL,VDU+10-65 ; SCREEN VDU address (0,0) LD B,0 LD C,A ; Line to BC OR A ; Test it JP Z,FCERR ; Zero - ?FC Error CP 16+1 ; 16 lines JP P,FCERR ; > 16 - ?FC Error POP DE ; RETurn address POP AF ; Get column PUSH DE ; Re-save RETurn LD D,0 LD E,A ; Column to DE OR A ; Test it JP Z,FCERR ; Zero - ?FC Error CP 48+1 ; 48 characters per line JP P,FCERR ; > 48 - ?FC Error ADD HL,DE ; Add column to address LD D,0 LD E,C ; Line to DE LD B,64 ; 64 Bytes per lineADD64X: ADD HL,DE ; Add line DJNZ ADD64X ; SIXTY FOUR TIMES!!! RET
FLPLED: ;CALL MONTST ; See if NAS-SYS ;JP Z,TMFLP ; "T" MFLP ;DEFW _MFLP RET
TMFLP: RET ;JP MFLP ; Flip drive LED
;MONOUT: PUSH AF ; Save character ;CALL MONTST ; See if NAS-SYS ;JP Z,TMNOUT ; "T" output ; POP AF ; Restore character ;DEFB _ROUT ; Output it RET
TMNOUT: ;POP AF ; Restore character RET ;JP TOUT ; "T" output
BREAK2: LD A,(BRKFLG) ; Break flag set? JP NZ,RETCTC ; Yes - Return ^C ;CALL MONTST ; See if NAS-SYS ;JP Z,TCHINP ; Get "T" character input ;DEFW _RIN ; Scan for a character RET
TCHINP: JP TIN ; "T" input a character
RETCTC: LD A,0 ; Clear Break flag LD (BRKFLG),A LD A,CTRLC ; Return ^C RET
;MONTST: LD A,(MONSTT+1) ; "T" monitor or NAS-SYS? CP 33H ; 31 00 10 / 31 33 0C RET
SAVE: ;CALL FLPLED ; Flip tape LED ;CALL MONTST ; See if NAS-SYS ;JP Z,TSAVE ; "T" save ;DEFW _WRIT ; Save program RET
TSAVE: RET ;LD A,(MONTYP) ; "T2" or "T4" (FLAGS!!!) ;JP Z,T4WR ; T4 Write ;JP T2DUMP ; T2 Dump
MONLD: ;CALL FLPLED ; Flip tape LED ;CALL MONTST ; See if NAS-SYS ;JP Z,TLOAD ; "T" load ;LD A,'R' ; Set READ ;LD (ARGN),A ;DEFW _READ ; Load program RET
TLOAD: RET ;LD A,(MONTYP) ; "T2" or "T4" (FLAGS!!!) ;JP Z,T4READ ; T4 Read ;JP T2DUMP ; T2 Dump ??????????
MONITR: ;CALL MONTST ; See if NAS-SYS ;JP Z,MONSTT ; Jump to zero if "T" ;DEFW _MRET ; Return to NAS-SYS
MONVE: ;CALL FLPLED ; Flip tape LED ;CALL MONTST ; See if NAS-SYS ;JP Z,FCERR ; Verify not available on "T" ;LD A,'V' ; Set VERIFY ;LD (ARGN),A ;DEFW _VRFY ; Verify tape RET
INITST: LD A,0 ; Clear break flag LD (BRKFLG),A ;CALL MONTST ; See if NAS-SYS ;JP Z,INIT ; "T" - No NMI vector LD HL,BREAK ; Set NMI gives break ;LD (NMI),HL PUSH IX ; Get start up condition POP AF ; "Z" set if cold , Else clear OR A ; "Cold" or "Cool" start? JP NZ,INIT ; "Cool" don't init NAS-SYS LD B,15 ; Delay for keyboard clear CALL DELAYB ; Allow time for key release ;CALL STMON ; Initialise NAS-SYS JP INIT ; Initialise BASIC
BREAK: PUSH AF ; Save character LD A,-1 LD (BRKFLG),A ; Flag break POP AF ; Restore characterARETN: RETN ; Return from NMI
NOP
INLINE: ;DEFW _INLN ; Get an input line PUSH DE ; Save cursor address PUSH DE ; Cursor address to HL POP HL LD DE,48-1 ; Length of line-1 ADD HL,DE ; Point to end of lineENDLIN: LD A,(HL) ; Get end of line CP ' ' ; Space? JP NZ,LINTBF ; No - Copy to buffer DEC E ; Back 1 character LD A,0 ; Wasteful test on E OR E JP Z,LINTBF ; Start of line - Copy it DEC HL ; Back 1 character JP ENDLIN ; Keep looking for end
LINTBF: PUSH DE ; Line length to BC POP BC INC BC ; Length +1 LD DE,BUFFER ; Input buffer POP HL ; Line start PUSH BC ; Save length LDIR ; Move line to buffer LD A,0 LD (DE),A ; Mark end of buffer with 00 POP BC ; Restore buffer length LD B,C ; Length returned in B LD HL,BUFFER-1 ; Point to start of buffer-1 RET
GETXYA: CALL CHKSYN ; Make sure "(" follows DEFB '(' CALL GETNUM ; Get a number CALL DEINT ; Get integer -32768 to 32767 PUSH DE ; Save "X" CALL CHKSYN ; Make sure "," follows DEFB ',' CALL GETNUM ; Get a number CALL CHKSYN ; Make sure ")" follows DEFB ')' CALL DEINT ; Get integer -32768 to 32767 PUSH HL ; Save code string address POP IY ; In IY CALL XYPOS ; Address and bit mask PUSH AF ; Save mask CALL ADJCOL ; Adjust column CALL SCRADR ; Get VDU address POP AF ; Restore bit mask LD B,11000000B ; Block graphics base OR B ; Set bits 7 & 6 RET
SETB: CALL GETXYA ; Get co-ords and VDU address PUSH AF ; Save bit mask LD A,(HL) ; Get character from screen CP 11000000B ; Is it a block graphic? JP NC,SETOR ; Yes - OR new bit POP AF ; Restore bit maskPUTBIT: LD (HL),A ; Put character on screenRESCSA: PUSH IY ; Restore code string address POP HL ; From IY RET
SETOR: POP BC ; Restore bit mask OR B ; Merge the bits JP PUTBIT ; Save on screen
RESETB: CALL GETXYA ; Get co-ords and VDU address PUSH AF ; Save bit mask LD A,(HL) ; Get byte from screen CP 11000000B ; Is it a block graphic? JP C,NORES ; No - Leave it LD B,00111111B ; Six bits per block AND B ; Clear bits 7 & 6 POP BC ; Get bit mask AND B ; Test for common bit JP Z,RESCSA ; None - Leave it LD A,(HL) ; Get byte from screen AND 00111111B ; Isolate bit XOR B ; Clear that bit CP 11000000B ; Is it a graphic blank? JP NZ,PUTBIT ; No - Save character LD A,' ' ; Put a space there JP PUTBIT ; Save the space
NORES: POP BC ; Drop bit mask JP RESCSA ; Restore code string address
POINTB: CALL GETXYA ; Get co-ords and VDU address LD B,(HL) ; Get character from screen CALL TSTBIT ; Test if bit is set JP NZ,POINT0 ; Different - Return zero LD A,0 LD B,1 ; Integer AB = 1POINTX: POP HL ; Drop return PUSH IY ; PUSH code string address LD DE,RETNUM ; To return a number PUSH DE ; Save for return JP ABPASS ; Return integer AB
POINT0: LD B,0 ; Set zero JP POINTX ; Return value
XYPOS: POP BC ; Get return address POP HL ; Get column PUSH HL ; And re-save PUSH BC ; Put back return address LD A,L ; Get column LD B,00000001B ; 2 bits per character AND B ; Odd or even bit PUSH AF ; Save it PUSH DE ; Get row POP HL ; to HL LD DE,0 ; Zero line count LD BC,3 ; 3 blocks per line INC HLDIV3LP: SBC HL,BC ; Subtract 3 INC DE ; Count the subtractions JP Z,DIV3EX ; Exactly - Exit JP P,DIV3LP ; More to do
DIV3EX: ADD HL,BC ; Restore number POP AF ; Restore column and odd/even OR A ; Set flags (NZ or Z) LD A,L ; Get remainder from /3 JP Z,NOREMD ; No remainder ADD A,3 ; Adjust remainderNOREMD: LD B,A ; Bit number+1 to B LD A,00000001B ; Bit to rotateSHFTBT: RLCA ; Shift bit left DJNZ SHFTBT ; Count shifts RRA ; Restore correct place RET
ADJCOL: POP BC ; Restore return address POP AF ; Get bit mask POP HL ; Get column PUSH AF ; Re-save but mask LD A,L ; Get column RRA ; Divide by 2 ADD A,1 ; Start at column 1 AND 00111111B ; 0 to 63 LD H,A ; Save column in H PUSH HL ; Re-save column PUSH BC ; Put back return LD A,E ; Get row RET
SMOTOR: CALL CASFF ; Flip tape drive LD A,(HL) ; Get byte RET
JPLDSV: LD A,(BRKLIN) ; CLOAD or CSAVE? CP -1 JP NZ,SNDHDR ; CSAVE - Send header JP GETHDR ; CLOAD - Get header
CRLIN1: CALL PRNTCR ; Output CRLF JP GETLIN ; Get an input line
CRLIN: CALL PRNTCR ; Output CRLF JP GETLIN ; Get an input line
TSTBIT: PUSH AF ; Save bit mask AND B ; Get common bits POP BC ; Restore bit mask CP B ; Same bit set? LD A,0 ; Return 0 in A RET
OUTNCR: CALL OUTC ; Output character in A JP PRNTCR ; Output CRLF
JJUMP: JP JJUMP1 ; "Cool" start
ZJUMP: JP BRKRET ; Warm start ;END