diff --git a/tests/restricted/BME_bios.asm b/tests/restricted/BME_bios.asm new file mode 100644 index 00000000..a35c2956 --- /dev/null +++ b/tests/restricted/BME_bios.asm @@ -0,0 +1,3887 @@ +;1985.02.13 +;1985.6.19 +;**************************************** +;* * +;* BIOS FOR FP-1100 + KANJI ROM * +;* * +;* 1KB Access KANJI BIOS * +;* * +;* programmed by Akio Haguino * +;* Shoji Fujimoto * +;* * +;**************************************** + +IF1 +.PRINTX /PASS 1/ +ENDIF +IF2 +.PRINTX /PASS 2/ +ENDIF + ENTRY EOBIOS + .Z80 +;**************************************** +INCLUDE DEVICE.MAC + +MSIZE EQU 56 ;CP/M MEMORY SIZE +BIOS EQU MSIZE*1024-1536 + +CBASE EQU (MSIZE-20)*1024 +CPMB EQU CBASE+03400H +DOSB EQU CBASE+03C06H + +;******** DISK CONSTANTS **************** +BLKSIZ EQU 2048 ;CP/M ALLOCATION SIZE +HSTSIZ EQU 1024 ;HOST DISK SECTOR SIZE +HSTSPT EQU 8 ;HOST DISK SECTORS/TRK +HSTBLK EQU HSTSIZ/128 ;CP/M SECTS/HOST BUFF +CPMSPT EQU HSTBLK*HSTSPT ;CP/M SECTORS/TRACK +SECMSK EQU HSTBLK-1 ;SECTOR MASK +SECSHF EQU 3 ;LOG2(HSTBLK) + +MULTRWC EQU HSTSIZ/256 ;MULTI SEC R/W No. + +; RWOPER Ŷ OR A,RRA ݺ +; RWHST Ŷ ADD A,A ݺ + +;******* BDOS CONSTANTS ************** + +WRALL EQU 0 ;WRITE TO ALLOCATED +WRDIR EQU 1 ;WRITE TO DIRECTORY +WRUAL EQU 2 ;WRITE TO UNLOCATED + +;****** SYSTEM DEPENDS ON MEM ******** + +BIAS EQU 0 + +WBOOTV EQU BIAS+0 ;WARM BOOT ENTRY +IOBYT EQU BIAS+3 ;INTEL IO BYTE +LOGDISK EQU BIAS+4 ;WHERE CCP PUTS LOGDISK +DOSV EQU BIAS+5 +INITSP EQU BIAS+80H ;INITIAL SP LOCATION +INTDMA EQU BIAS+80H ;INITIAL DMA ADDRESS + +;********* BIOS START HERE ********** + +; ORG BIOS + +CBOOT: JP BOOT ;COLD START +WBOOTE: JP WBOOT ;WARM START + JP CONSTAT ;CONSOLE STATUS + JP CONIN ;CONSOLE INPUT + JP CONOUT ;CONSOLE OUTPUT + JP LIST ;LIST OUTPUT + JP PUNCH ;PUNCHER OUTPUT + JP READER ;READER INPUT + JP HOME ;MOVE HEAD TO HOME + JP SELDISK ;SELECT DRIVE + JP SETTRK ;SET TRACK + JP SETSEC ;SET SECTOR + JP SETDMA ;SET DMA ADDRESS + JP READ ;READ SECTOR + JP WRITE ;WRITE SECTOR + JP LISTST ;LIST STATUS + JP SECTRN ;SECTOR TRANSLATE + + JP CMD ;SEND COMMAND to SUB_CPU + JP PUTDATA ;PUT DATA to SUB_CPU + JP GETDATA ;GET DATA from SUB_CPU + JP SUBEND ;END OF COMMUNICATE + JP TRNC01 ;MACRO COMMAND TYPE 1 + JP TRNC02 ;MACRO COMMAND TYPE 2 + JP TRNC03 ;MACRO COMMAND TYPE 3 + JP TRNC04 ;MACRO COMMAND TYPE 4 + JP TRNCGET ;MACRO CAMMAND GETDATA + + JP MCONV ;SHIFT-JIS TO JIS BCreg + JP PCONV ;JIS TO SHIFT-JIS BCreg + JP DECORD ;JIS TO INCODE IN: DE + ; OUT: HL CODEadr + JP PATIN ;KANJI ROM READ IN: BC + ; OUT:HL BPATadr + JP PATCHGB ;KANJIPAT CHG IN: NO + ; OUT:HL PATadr + JP FDDREADB + JP FDDWRITEB + + +;***** DISK DEFIN ***************** + +; DISK parameter header +DPBASE EQU $ +DPH0: DW 0,0 + DW 0,0 + DW DIRBUF,DPB0 + DW CSV0,ALV0 + +DPH1: DW 0,0 + DW 0,0 + DW DIRBUF,DPB1 + DW CSV1,ALV1 + +DPH2: DW 0,0 + DW 0,0 + DW DIRBUF,RPB + DW 0,ALV2 + +;**** DISK PARAMETER BLOCK + +DPB0 EQU $ + DW 64 + DB 4 + DB 15 + DB 1 + DW 97H + DW 7FH + DB 0C0H + DB 00 + DW 32 + DW 02 + +DPB1 EQU $ + DW 64 + DB 4 + DB 15 + DB 1 + DW 97H + DW 7FH + DB 0C0H + DB 00 + DW 32 + DW 02 + +;***** RAM PARAMETER BLOCK ******** +IF RAM32 +.PRINTX /32KB RAM PACK/ +RAMSPT EQU 256 +REPEATCNT EQU 5 +ELSE +RAMSPT EQU 128 +REPEATCNT EQU 4 +ENDIF + +RPB EQU $ ;BOOT INITIALIZE +SPT: DW RAMSPT +BSH: DB 3 +BLM: DB 7 +EXM: DB 0 +DSM: DW 15 +DRM: DW 31 +AL0: DB 010000000B +AL1: DB 00 +CKS: DW 0 +OFF: DW 0 + +; LIST DEVICE OUTPUT ROUTINE +LIST: LD A,(IOBYT) + RLCA + RLCA + LD HL,LISTTB + JR IOJP + +LISTTB: DW TTYOUT + DW TTYOUT + DW LPT0 + DW LPT0 + +; LIST STATUS ROUTINE +LISTST: LD A,(IOBYT) + RLCA + RLCA + LD HL,LISTSTTB + JR IOJP + +LISTSTTB: DW TTYOUTST + DW TTYOUTST + DW LPT0ST + DW LPT0ST + +IOJP: AND 03 + ADD A,A + LD E,A + LD D,0 + ADD HL,DE + LD A,(HL) + INC HL + LD H,(HL) + LD L,A + JP (HL) + +;***** TTY IO ROTINE ************* + + +CONIN: +READER: +TTYIN: LD (BDOSSP),SP + LD SP,BIOSSP +TTYIN1B: CALL BLNKON +TTYIN1: LD A,(KANJIMODE) + OR A + JR Z,TTYIN15 + LD A,(KINPMOD) + OR A + JR NZ,KTTYIN +TTYIN15: DI + CALL GETRNG + EI + JR Z,TTYIN1 +TTYIN1A: PUSH AF + LD A,(BLNKFLG) + OR A + CALL Z,BLNKOFF +TTYIN2: POP AF + JR BIOSRET + +KTTYIN: + CALL KGETRNG + JR NZ,TTYIN1A +KTTYINB: JP KNJINP0 + +CONOUT: +TTYOUT: LD (BDOSSP),SP + LD SP,BIOSSP + LD A,C + CALL PRINT + JR BIOSRET + +TTYOUTST: +LPT0ST: LD A,0FFH + RET + +;*******LIST I/O ROUTINE ****** + +LPT0: LD A,C + LD (BDOSSP),SP + LD SP,BIOSSP + CALL LPT +BIOSRET: LD SP,(BDOSSP) + RET + + +;********* PUNCHER is always PRINTER out ************ + + +PUNCH: +PUNCHOUT: LD A,C + LD (BDOSSP),SP + LD SP,BIOSSP + CALL LPTPUNCH + JR BIOSRET + +;****** DISK IO ROUTIN ********* + +HOME: LD C,0 + +SETTRK: LD A,C + LD (SEKTRK),A + RET + +SECTRN: LD H,B + LD L,C + INC HL ;NO SKEW + RET +SELDISK: LD HL,0 ;ERROR FLAG FOR DOS + LD A,(MAXDRV) + DEC A + CP C + RET C ;SELECT ERROR + LD A,C + LD (SEKDSK),A + LD L,A + LD H,0 + ADD HL,HL + ADD HL,HL + ADD HL,HL + ADD HL,HL + LD DE,DPBASE + ADD HL,DE + RET + +SETSEC: DEC BC + LD A,C ;MAKE ZERO ORIGIN No + LD (SEKSEC),A + RET + +SETDMA: LD (DMAADR),BC + RET + +READ: LD A,(SEKDSK) + CP 2 ;IF RAM DISK + JP Z,RAMREAD + XOR A + LD (UNACNT),A + INC A ;ORG LD A,2 + LD (READOP),A ;READ OPERATION + LD (RSFLAG),A ;MUST READ DATA + LD A,WRUAL + LD (WRTYPE),A ;TREAT AS UNALLOC + JP RWOPER ;TO PERFORM THE READ + +WRITE: LD A,(SEKDSK) ;IF RAM DISK + CP 2 + JP Z,RAMWRT + XOR A ;0 TO ACCUMULATOR + LD (READOP),A ;NOT A READ OPERATION + LD A,C ;WRITE TYPE IN C + LD (WRTYPE),A + CP WRUAL ;WRITE UNALLOCATED ? + JR NZ,CHKUNA ;CHECK FOR UNALLOC + + LD A,BLKSIZ/128 + LD (UNACNT),A + LD A,(SEKDSK) ;DISK TO SEEK + LD (UNADSK),A ;UNADSK = SEKDSK + LD A,(SEKTRK) + LD (UNATRK),A ;UNATRK = SECTRK + LD A,(SEKSEC) + LD (UNASEC),A ;UNASEC = SEKSEC + +; CHECK FOR WRITE TO UNALLOCATED SECTOR + +CHKUNA: LD A,(UNACNT) ;ANY UNALLOC REMAIN? + OR A + JR Z,ALLOC ;SKIP IF NOT + +; MORE UNALLOCATED RECORDS REMAIN + DEC A ;UNACNT = UNACNT - 1 + LD (UNACNT),A + LD A,(SEKDSK) ;SAME DISK + LD HL,UNADSK + CP (HL) ;SEKDSK = UNADSK ? + JR NZ,ALLOC ;SKIP IF NOT +; +; DISK ARE THE SAME + LD A,(SEKTRK) + LD HL,UNATRK + CP (HL) ;SEKTRK = UNATRK ? + JR NZ,ALLOC ;SKIP IF NOT + +; TRACK ARE THE SAME + LD A,(SEKSEC) ;SAME SECTOR + LD HL,UNASEC + CP (HL) ;SEKSEC = UNASEC? + JR NZ,ALLOC ;SKIP IF NOT + +; MATCH, MOVE TO NEXT SECTOR FOR FUTURE REF + INC (HL) ;UNASEC ++ + LD A,(HL) + CP CPMSPT ;CHECK DRIVE TYPE + JR C,NOOVF ;IF SINGLE SIDE + +; OVERFLOW TO NEXT TRACK + LD (HL),0 ;UNASEC = 0 + LD A,(UNATRK) + INC A ;UNATRK ++ + LD (UNATRK),A + +; MATCH FOUND, MASK AS UNNECESSARY READ +NOOVF: XOR A ;0 TO Areg + LD (RSFLAG),A ;RSFLAG =0 + JR RWOPER ;TO REFORM THE WRITE + +; NOT AN ALLOCATED RECORD, REQUIRES PRE_READ +ALLOC: XOR A ;0 TO Areg + LD (UNACNT),A ;UNACNT = 0 + INC A ;A TO Areg + LD (RSFLAG),A ;RSFLAG = 1 + +;***** COMMON READ WRITE LOGICAL ******** + +RWOPER: ;ENTER HERE TO PERFORM THE READ/WRITE + XOR A ;0 TO Areg + LD (ERFLAG),A ;NO ERRORS (YET) + LD A,(SEKSEC) ;COMPUTE HOST SECTOR + OR A ;RESET CARRY + RRA ;SHIFT RIGHT * SECSHF + OR A + RRA + OR A + RRA + LD (SEKHST),A ;HOST SECTOR TO SEEK + +; ACTIVE HOST SECTOR? + LD HL,HSTACT ;HOST ACTIVE FLAG + LD A,(HL) + LD (HL),1 ;ALWAYS BECOMES 1 + OR A ;WAS IT ALREADY + JR Z,FILHST ;FILL HOST IF NOT + +; HOST BUFFER ACTIVE, SAME AS SEEK BUFFER + LD A,(SEKDSK) + LD HL,HSTDSK ;SAME DISK + CP (HL) ;SEKDSK = HSTDSK? + JR NZ,NOMATCH ;FIIL HOST IF NOT + +; SAME DISK, SAME TRACK? + LD A,(SEKTRK) + LD HL,HSTTRK + CP (HL) ;SEKTRK = HSTTRK? + JR NZ,NOMATCH + +; SAME DISK SAME TRACK, SAME BUFFER? + LD A,(SEKHST) + LD HL,HSTSEC ;SEKTRK = HSTSEC? + CP (HL) + JR Z,MATCH ;SKIP IF MATCH + +; PROFER DISK, BUT NOT CORRECT SECTOR +NOMATCH: LD A,(HSTWRT) ;HOST WRITTEN? + OR A + CALL NZ,WRITEHST ;CLEAR HOST BUFFER + +FILHST: + ;PROPER DISK, BUT NOT CORRECT SECTOR + LD A,(SEKDSK) + LD (HSTDSK),A + LD HL,(SEKTRK) + LD (HSTTRK),HL + LD A,(SEKHST) + LD (HSTSEC),A + LD A,(RSFLAG) + OR A ;NEED TO READ? + CALL NZ,READHST ;YES, IF 1 + XOR A ;0 TO Areg + LD (HSTWRT),A ;NO PENDING WRITE + +MATCH: + ;COPY DATA TO OR FROM BUFFER + LD A,(SEKSEC) ;MASK BUFFER NUMBER + AND SECMSK ;LEAST SIGNIF BITS + LD L,A ;READY TO SHIFT + LD H,0 ;DOUBLE COUNT + ADD HL,HL ;SHIFT LEFT 7 + ADD HL,HL + ADD HL,HL + ADD HL,HL + ADD HL,HL + ADD HL,HL + ADD HL,HL +; HL HAS RELATIVE HOST BUFFER ADDRESS + LD DE,HSTBUF + ADD HL,DE ;HL=HOST ADDRESS + EX DE,HL ;WHICH WAY? + LD HL,(DMAADR) + LD BC,128 + LD A,(READOP) + OR A + JR NZ,RWMOVE ;SKIP IF READ + +; WRITE OPERATION, MARK & SWITCH DIRECTION + LD A,1 + LD (HSTWRT),A + EX DE,HL + +RWMOVE: EX DE,HL + LDIR + LD A,(WRTYPE) + CP WRDIR + LD A,(ERFLAG) + RET NZ + + OR A + RET NZ + XOR A + LD (HSTWRT),A + CALL WRITEHST + LD A,(ERFLAG) + RET + +;******** WARM BOOT ***************** + +WBOOT: LD SP,INITSP ;RESET STACK + LD A,(HSTWRT) ;IF HSTWRT ACTIVE + OR A ; CALL WRITEHST + CALL NZ,WRITEHST + LD HL,CPMB ;SET CCP TOP ADDRESS + LD BC,0200H ;SET TRACK 0 : SECTOR 2 + LD A,1 ;NOT MULTI SECTOR READ + LD (MULTFDRWN),A +WBOOTLOP: XOR A ;SET DRIVE A + CALL FDDREAD ;1 SECTOR(256B) READ + INC H ;ADDR = ADDR + 256 + INC B ;SECTOR = SECTOR + 1 + LD A,B + CP 17H ;CHECK LAST SECTOR + JR NZ,WBOOTLOP + XOR A + LD (CPMB+7),A + +GOCPM:; LD A,1 ;READ PF KEY TABLE +; LD (MULTFDRWN),A ;READ ONLY 1 SECTOR +; XOR A ;SET DRIVE A: +; LD BC,2001H ;SET TRACK 2 SECTOR 32 +; LD HL,PFKEYTB ;DMA = PFKEYTBL +; CALL FDDREAD + + LD A,0C3H ;SET JP INSTRUCTION + LD (0),A + LD (5),A + LD HL,WBOOTE + LD (1),HL ;SET REBOOT ADDRESS + LD HL,DOSB + LD (6),HL ;SET BDOS ADDRESS + XOR A + LD (HSTACT),A ;INITIALIZE + LD (UNACNT),A + LD BC,INTDMA + CALL SETDMA ;SETDMA 80H + LD A,(LOGDISK) ;SET LOG IN DISK + LD C,A + CALL SELDISK + JP CPMB ;JUMP CCP TOP + +;*************************** + +SEKDSK: DS 1 +SEKTRK: DS 1 +SEKSEC: DS 1 + +HSTDSK: DS 1 +HSTTRK: DS 1 +HSTSEC: DS 1 + +SEKHST: DS 1 +HSTACT: DS 1 +HSTWRT: DS 1 + +UNACNT: DS 1 +UNADSK: DS 1 +UNATRK: DS 1 +UNASEC: DS 1 + +ERFLAG: DS 1 +RSFLAG: DS 1 +READOP: DS 1 +WRTYPE: DS 1 +DMAADR: DS 2 +HSTBUF: DS HSTSIZ + +CSV0: DS 32 +ALV0: DS 97H/8+1 +CSV1: DS 32 +ALV1: DS 97H/8+1 + +ALV2: DS 97H/8+1 +MAXDRV: DB 3 +DIRBUF: DS 128 + +.PRINTX /FDD assemble/ + +INCLUDE FDD.LIB + +.PRINTX /SUB CPU assemble/ +;********** SUB CPU ********** + +;******************** +;* IOCS FOR SUB CPU * +;******************** + +INT87 EQU 0FFF0H +INTA EQU 0FFF2H +INTB EQU 0FFF4H +INTC EQU 0FFF6H +PORT EQU 0FFC0H +INTPORT EQU 0FF80H +BIOSSP EQU 0FFE0H +PFKEYTB EQU 0FE00H + +INTBACK: DS 1 +KEYFLG: DS 1 +KEYDATA: DS 1 +BKFLG: DS 1 +ERRFLG: DS 1 +BDOSSP: DS 2 +KSLOT: DS 1 +KINPMOD EQU 0FFE8H + +;***** TRANSCMD ***** + +; IN: A:COMAND CODE + +CMD: PUSH BC + LD (CMDDT),A +CMDLOP: DI + LD BC,CMDINT + LD (INT87),BC + LD BC,PORT + OUT (C),A + CALL INTON + EI + HALT + POP BC + OR A + RET Z + SCF + CALL KEYANAL + LD A,(CMDDT) + JR CMD + +CMDINT: LD BC,PORT + IN A,(C) + RET + + +;***** PUTDATA ***** + +; IN: A:DATA + +PUTDATA: PUSH BC + LD BC,PUTINT + LD (INT87),BC + LD BC,PORT + CALL INTON + OUT (C),A +PUTDATA1: EI + HALT + POP BC + RET + +PUTINT: IN A,(C) + RET + +;***** GETDATA ***** + +; OUT:A:DATA + +GETDATA: PUSH BC + LD BC,GETINT + LD (INT87),BC + EI + HALT + POP BC + RET + +GETINT: LD BC,PORT + IN A,(C) + PUSH AF + XOR A + OUT (C),A + POP AF + JP INTON + + +;***** KEYINT ***** + +KEYSP EQU 0FE00H + +KEYINT: LD (KEYSPBK),SP + LD SP,KEYSP + PUSH AF + PUSH BC + PUSH DE + PUSH HL + LD BC,PORT + IN A,(C) + OR A + CALL KEYANAL + LD BC,KEYINT + LD (INT87),BC + LD A,(INTBACK) + OR 10H + LD (INTBACK),A + LD BC,INTPORT + OUT (C),A + POP HL + POP DE + POP BC + POP AF + LD SP,(KEYSPBK) + EI + RET + +;***** KEYANAL ***** + +; IN: A:ACKCODE + +KEYANAL: PUSH BC + PUSH DE + PUSH HL + PUSH AF + LD D,0 + CP 1 + JR NZ,KEYANAL1 + LD D,2 +KEYANAL1: LD BC,PORT + OUT (C),D + POP AF + PUSH AF + LD BC,INTPORT + JR C,KEYANAL2 + LD A,90H + OUT (C),A +KEYANAL2: LD A,10H + OUT (C),A + POP AF + CP 2 + JR Z,KEYANAL9 + CP 3 + JR NC,KEYANAL3 + LD (KEYFLG),A + JR KEYANAL9 + +KEYANAL3: LD (KEYFLG),A + LD A,10 +KEYANAL4: DEC A + JR NZ,KEYANAL4 + + LD BC,KANALINT + LD (INT87),BC + EI + HALT + LD (KEYDATA),A + CALL KEYIN +KEYANAL9: POP HL + POP DE + POP BC + RET + +KANALINT: LD BC,PORT + IN A,(C) + LD E,A + XOR A + OUT (C),A + CALL INTON + LD A,E + RET + +INTON: PUSH AF + PUSH BC + LD BC,INTPORT + LD A,90H + OUT (C),A + LD A,10H + OUT (C),A + POP BC + POP AF + RET + + +;----- TRNC01 ----- +; IN: A:COMMAND + +TRNC01: CALL CMD + +;***** SUBEND ***** + +SUBEND: PUSH AF + PUSH BC + LD BC,KEYINT + LD (INT87),BC + LD BC,INTPORT + LD A,(INTBACK) + OUT (C),A + POP BC + POP AF + EI + RET + +;----- TRNC02 ----- +; IN: A:COMMAND +; B:DATA + +TRNC02: CALL CMD + LD A,B + CALL PUTDATA + JR SUBEND + +;----- TRNC03 ----- +; IN: A:COMMAND +; BC:DATA + +TRNC03: CALL CMD + LD A,B + CALL PUTDATA + LD A,C + CALL PUTDATA + JR SUBEND + +;---- TRNC04 ---- +; IN: A:COMMAND +; B:PARAMETER COONT +; HL:PARAMETER POINTER + +TRNC04: CALL CMD +TRNC04L: LD A,(HL) + CALL PUTDATA + INC HL + DJNZ TRNC04L + + JR SUBEND + +;----- TRNCGET ----- +; IN: A:COMMAND +; OUT:A:DATA + +TRNCGET: CALL CMD + CALL GETDATA + JR SUBEND + +;***** LOGICAL PRINT ROUTINE ***** + +; IN: A:CODE + +PRINT: LD B,A + LD HL,PRMODE + LD A,(HL) + CP -1 + JP Z,ESCCMD + OR A + JP NZ,ESCPRM + LD A,B + CP ' ' ;IF CONTROL CODE + JP C,PRCNTCD + LD A,(K1STAT) + OR A + JP NZ,KNJPR + +PRND0: LD A,(KANJIMODE) + AND A + JR Z,PRND1B + LD A,B + CP 80H + JR C,PRND1 + CP 0E0H + JR NC,KNJPRINT + CP 0A0H + JR NC,PRND1 + +KNJPRINT: LD (KCODEH),A + LD A,-1 + LD (K1STAT),A + LD B,1CH + JP RIGHT + +PRND1B: LD A,B +PRND1: CP 7FH + RET Z + CP 0FFH + RET Z +PRND1C: CALL PRNT +PRND1S: LD HL,CX + INC (HL) + LD A,(WIDTH) + CP (HL) + RET NZ +PRND1K: XOR A + LD (HL),A + LD HL,CY + INC (HL) + LD A,(CONSOLE) + CP (HL) + RET NZ + DEC (HL) + RET + +PRCNTCD: LD A,B + CP 07 + JR Z,BELL ;BEEP + CP 08 + JR Z,BS ;BACK SPACE + CP 09 + JR Z,TAB ;TAB + CP 0AH + JR Z,LF ;LINE FEED + CP 0BH + JP Z,HM ;HOME POSITION + CP 0CH + JP Z,CLS ;CLEAR CSREEN + CP 13 + JP Z,CR ;CARRIAGE RETURN + CP 1CH + JP Z,RIGHT ;CURSOR RIGHT + CP 1DH + JP Z,LEFT ;CURSOL LEFT + CP 1EH + JP Z,UP ;CURSOL UP + CP 1FH + JP Z,DOWN ;CURSOL DOWN + CP 1 + JP Z,ROLUP ;ROLL UP + CP 10H + JP Z,ROLDWN ;ROLL DOWN + CP 27 + JP Z,ESCAPE ;ESCAPE SEQ + RET + +; BEEP OUT +BELL: LD A,28 ;MACRO COMMAND 28 + JP TRNC01 + +; BACK SPACE +BS: LD A,(CX) + OR A + JR NZ,BS1 + LD A,(CY) + OR A + RET Z +BS1: LD HL,CX + DEC (HL) + LD A,0FFH + CP (HL) + JR NZ,BS2 + LD A,(WIDTH) + DEC A + LD (HL),A + LD HL,CY + DEC (HL) +BS2: LD A,15 ;MACRO COMMAND 15 + JP TRNC01 + +; TAB +TAB: LD HL,CX + LD A,8 + ADD A,(HL) + AND 0F8H + LD (HL),A + LD A,(WIDTH) + CP (HL) + JR NZ,TAB1 + LD (HL),0 + LD HL,CY + INC (HL) + LD A,(CONSOLE) + CP (HL) + JR NZ,TAB1 + DEC (HL) + CALL CRLF +TAB1: JP CSR + +; LINE FEED +LF: LD HL,CY + INC (HL) + LD A,(CONSOLE) + CP (HL) + JR NZ,LF1 + DEC (HL) + CALL CRLF +LF1: JP CSR + +; HOME POSITION +HM: XOR A + LD (CX),A + LD (CY),A + LD (K1STAT),A + JP CSR + +; CLEAR SCREEN +CLS: LD A,13 ;MACRO COMMAND 13 + CALL TRNC01 + JR HM + +; CARRIAGE RETURN +CR: LD HL,CX + LD (HL),0 + JP CSR + +; CURSOR RIGHT +RIGHT: LD HL,CX + INC (HL) + LD A,(WIDTH) + CP (HL) + JR NZ,XCSR + LD (HL),0 + LD A,(CONSOLE) + DEC A + INC HL + CP (HL) + JR NZ,DOWN + LD A,' ' + JP PRNT + +; CURSOR LEFT +LEFT: LD HL,CX + DEC (HL) + LD A,-1 + CP (HL) + JR NZ,XCSR + LD A,(WIDTH) + DEC A + LD (HL),A + +; CURSOR UP +UP: LD HL,CY + DEC (HL) + LD A,0FFH + CP (HL) + JR NZ,XCSR + LD A,(CONSOLE) + DEC A + LD (HL),A + JR XCSR + +; CURSOR DOWN +DOWN: LD HL,CY + INC (HL) + LD A,(CONSOLE) + CP (HL) + JR NZ,XCSR + LD (HL),0 + +XCSR: LD A,B + SUB 01CH-09 + JP TRNC01 + +; ROLL UP +ROLUP: LD A,6 + JP TRNC01 + +; ROLL DOWN +ROLDWN: LD A,7 + JP TRNC01 + +; ESCAPE SEQ + +ESCAPE: LD A,-1 + LD (PRMODE),A ;SET ESC MODE + RET + +; ESCAPE COMMAND ENTRY +ESCCMD: LD HL,ESCCMDTBL +ESCCMDL: LD A,(HL) + OR A + JP Z,ESCCMD2 ;IF UNDEFINE SEQ + CP B + JP Z,ESCCMD3 ;IF DEFINE SEQ + LD DE,4 + ADD HL,DE + JR ESCCMDL ;JP NEXT SEQ + +; UNDEFINE SEQ +ESCCMD2: LD (PRMODE),A + LD A,B + JP PRINT + +; DEFINE SEQ ENTRY +ESCCMD3: INC HL + LD A,(HL) + OR A + JR Z,ESCCMD4 ;IF NON PARARMETER SEQ + LD (PRMODE),A + INC HL + LD E,(HL) + INC HL + LD D,(HL) + LD (CMDJP+1),DE ;SET ENTRY POINT + RET + +; NON PARAMETER SEQ +ESCCMD4: XOR A + LD (PRMODE),A + INC HL + LD E,(HL) + INC HL + LD D,(HL) + EX DE,HL + JP (HL) + +; ESCAPE PARAMETER SET ENTRY +ESCPRM: LD HL,ESCPRMTOP + LD C,A + LD A,(PRMCOUNT) + LD E,A + LD D,0 + LD A,C + ADD HL,DE + LD (HL),B + LD HL,PRMODE + DEC (HL) + JR NZ,ESCPRM2 + XOR A ;IF LAST PARAMETER + LD (PRMCOUNT),A + LD DE,ESCPRMTOP +CMDJP: JP 00000 + +ESCPRM2: LD HL,PRMCOUNT + INC (HL) + RET + +; ESCAPE COMMAND TABLE +ESCCMDTBL: DB 'T',0 ;ERASE END OF LINE + DW ESCT + + DB 'Y',0 ;ERASE END OF SCREEN + DW ESCY + + DB '*',0 ;CLS + DW ESCSTAR + + DB '(',0 ;REVERSE + DW REVERSE + + DB ')',0 ;NORMAL + DW NORMAL + + DB 'C',0 ;CURSOR ON/OFF + DW ESCC + + DB '_',1 ;CURSOR ON/OFF + DW CURSOR + + DB '<',0 ;WIDTH 40 + DW WID40 + + DB '>',0 ;WIDTH 80 + DW WID80 + + DB 'S',1 ;SCREEN + DW SCREEN + + DB '{',0 ;BEEPON + DW BEEPON + + DB '}',0 ;BEEP OFF + DW BEEPOFF + + DB '=',2 ;LOCATE + DW LOCATE + + DB 'M',1 ;CHARACTER COLOR + DW ESCM + + DB 'B',1 ;BACK GROUND COLOR + DW ESCB + + DB 'F',1 ;FRAME COLOR + DW ESCF + + DB 'c',3 ;CHAR,BACK,FRAME COLOR + DW CHRCOL + + DB 'D',1 ;DISPLAY PLANE + DW DSPSCRN + + DB 'W',1 ;WRITE PLANE + DW WRTSCRN + + DB 'K',2 ;KANJI PRINT + DW KANJI + + DB 'N',1 + DW NIPMODE + + DB 'L',1 + DW KNJLINE + + DB '^',0 + DW STATMODE + + IF JISHO + DB 'J',1 + DW STUDYMODE + ENDIF + + DB '\',0 ;BACK SLASH SW. + DW BKSLASH + + DB 0 ;END MARK + +PRMCOUNT: DB 0 + + + +; BEEP ON +BEEPON: LD A,1DH + JP TRNC01 + +; BEEP OFF +BEEPOFF: LD A,1EH + JP TRNC01 + +; ERASE END OF LINE +ESCT: CALL ESCTL + JP CSR +; +ESCTL: LD A,(WIDTH) + LD B,A + LD A,(CONSOLE) + DEC A + LD C,A + LD A,(CY) + CP C + JR NZ,ESCTL1 + DEC B +ESCTL1: LD HL,CX + LD A,B + SUB (HL) + RET Z + RET M + LD B,A +ESCTL2: LD A,' ' + CALL PRNT + DJNZ ESCTL2 + RET + +; ERASE END OF SCREEN +ESCY: CALL ESCTL + LD HL,CY + LD A,(CONSOLE) + DEC A + SUB (HL) + JR Z,ESCY3 + LD C,A +ESCY1: LD A,(WIDTH) + LD B,A + LD A,1 + CP C + JR NZ,ESCY2 + DEC B +ESCY2: LD A,' ' + CALL PRNT + DJNZ ESCY2 + DEC C + JR NZ,ESCY1 +ESCY3: JP CSR + +ESCSTAR: JP CLS + +REVERSE: LD A,-1 + LD (REVNORM),A + LD BC,(XCOL1) + LD A,13H + JP TRNC03 + +NORMAL: XOR A + LD (REVNORM),A + LD BC,(XCOL) + LD A,13H + JP TRNC03 + + +; CURSOR BLINK ON/OFF BINARY SWITCH +ESCC: LD HL,BLNKFLG + LD A,(HL) + OR A + JR Z,ESCC2 +ESCC1: LD (HL),0 +BLNKOFF: LD A,27 + JP TRNC01 + +ESCC2: LD (HL),0FFH +BLNKON: LD A,26 + JP TRNC01 + +CURSOR: LD HL,BLNKFLG + LD A,(DE) + CP '>' + JR Z,ESCC1 + CP '<' + JR Z,ESCC2 + JP PRINT + +; LOCATE 1st=Y+32 2nd=X+32 +LOCATE: LD A,(CONSOLE) + ADD A,' ' + LD C,A + LD A,(DE) ;GET Y + CP ' ' + JR NC,LOCATE2 + LD A,' ' +LOCATE2: CP C + JR C,LOCATE3 + LD A,' ' +LOCATE3: SUB ' ' + LD (CY),A + + LD A,(WIDTH) + ADD A,' ' + LD C,A + INC DE + LD A,(DE) ;GET X + CP ' ' + JR NC,LOCATE4 + LD A,' ' +LOCATE4: CP C + JR C,LOCATE5 + DEC C + LD A,C +LOCATE5: SUB ' ' + LD (CX),A + JP CSR + +PRNT: PUSH BC + LD B,A +PRNT1: CP '\' + JR NZ,PRNT2 + LD A,(BKSSW) + AND A + JR Z,PRNT2 + LD B,A +PRNT2: LD A,4 + CALL TRNC02 + POP BC + RET + +LPT: PUSH BC + LD B,A + LD A,(KANJIMODE) + AND A + JR Z,LPT11 + CALL KLPT + JR LPTRET +LPT11: LD A,31 + CALL TRNC02 +LPTRET: POP BC + RET + +LPTPUNCH: PUSH BC + LD B,A + JR LPT11 + + +; CURSOR SET +CSR: PUSH BC + LD A,(CX) + LD B,A + LD A,(CY) + LD C,A +CSR0A: LD A,18 + CALL TRNC03 + POP BC + RET + +CSR0: PUSH BC + JR CSR0A + + +; CARRAGE RETURN +CRLF: LD A,14 + JP TRNC01 + +; CHARACTER COLOR +ESCM: LD HL,XCOL+1 + LD A,(DE) + AND 07H + LD B,A +; LD A,(SCREENM) +; AND A +; JR Z,CHGCCOL +; XOR A +; CP B +; JR Z,CZERO +; LD B,07H +; JR CHGCCOL +;CZERO: LD B,70H +CHGCCOL: LD A,(HL) + AND 70H + JR CHGCOL + +; BACK GROUND COLOR + +ESCB: LD HL,XCOL+1 + LD A,(DE) + RLCA + RLCA + RLCA + RLCA + AND 70H + LD B,A +; LD A,(SCREENM) +; AND A +; JR Z,CHGBCOL +; XOR A +; JR Z,BZERO +; LD B,70H +; JR CHGBCOL +;BZERO: LD B,07H +CHGBCOL: LD A,(HL) + AND 07H +CHGCOL: OR B + LD (HL),A + PUSH AF + AND 70H + PUSH AF + LD A,(XCOL1) + AND 07H + LD B,A + POP AF + OR B + LD (XCOL1),A + POP AF + RLCA + RLCA + RLCA + RLCA + LD (XCOL1+1),A + AND 70H + LD B,A + DEC HL + LD A,(HL) + AND 07H + OR B + LD (HL),A + JP NORMAL + +; FRAME COLOR +ESCF: LD A,(DE) + AND 07H + LD B,A + LD HL,XCOL + LD A,(HL) + AND 70H + OR B + LD (HL),A + INC HL + INC HL + LD A,M + AND 70H + OR B + LD (HL),A + JP NORMAL + +CHRCOL: INC DE + CALL ESCB + DEC DE + CALL ESCM + INC DE + INC DE + JR ESCF + +XCOL: DB 70H + DB 07H + +XCOL1: DB 00H + DB 70H + +; WIDTH40 +WID40: LD A,(WIDTH) + CP 40 + RET Z + LD A,40 + JR WIDCHG + +; WIDTH80 +WID80: LD A,(WIDTH) + CP 80 + RET Z + LD A,80 +WIDCHG: LD (WIDTH),A + LD B,A + LD HL,SCRNMODE + LD A,(HL) + AND 0FEH + BIT 3,B + JR NZ,SCRNSET + INC A +SCRNSET: LD (HL),A + LD B,A + CALL C7070 + LD A,33 + CALL TRNC02 + JP HM + +SCREEN: LD A,(DE) + AND 03H + CP 1 ;IF A=1 THEN + JR Z,SCREEN1 ; SCREEN 1 + CP 3 ;ELSE IF A=3 THEN + JR Z,SCREEN3 ; SCREEN 3 + ;ELSE SCREEN 0 +SCREEN0: LD A,(SCREENM) + AND A + RET Z + XOR A + LD (KANJIMODE),A + JR SCREENC + +SCREEN1: LD A,(SCREENM) + CP 02H + RET Z + XOR A + LD (KANJIMODE),A + LD A,02H + JR SCREENC + +SCREEN3: LD A,0FFH ;SHIFT JIS-CODE PRINT OUT + LD (KANJIMODE),A + LD A,(SCREENM) + BIT 6,A + RET NZ + LD A,42H + +SCREENC: LD (SCREENM),A + LD B,A + BIT 6,A + JR Z,CONS25 + LD A,20 + JR CONSC +CONS25: LD A,25 +CONSC: LD (CONSOLE),A + LD HL,SCRNMODE + LD A,(HL) + AND 01H + OR B + JR SCRNSET + +C7070: PUSH BC + LD HL,0770H + LD (XCOL),HL + LD HL,7000H + LD (XCOL1),HL + CALL NORMAL + LD A,16H + LD B,0F7H + CALL TRNC02 + LD A,7 + LD (DPLANE),A + LD A,70H + LD (WPLANE),A + POP BC + RET + + +DSPSCRN: LD A,(DE) + AND 0FH + LD (DPLANE),A + LD B,A + LD A,(WPLANE) + OR B + AND 77H + BIT 3,B + JR NZ,WOP + SET 7,A +WOP: LD B,A + LD A,16H + JP TRNC02 + +WRTSCRN: LD A,(DE) + RLCA + RLCA + RLCA + RLCA + AND 70H + LD (WPLANE),A + LD B,A + LD A,(DPLANE) + BIT 3,A + JR NZ,WOP1 + SET 7,B +WOP1: AND 07H + OR B + JR WOP + +CMPHLDE: LD A,H + CP D + RET NZ + LD A,L + CP E + RET + +;************* KANJI PRINT OUT ****************** + +KNJPR: LD HL,(CX) + LD A,L + OR H + JR Z,KNJPR1 + PUSH BC + LD B,1DH + CALL LEFT + POP BC +KNJPR1: LD C,B + LD A,(KCODEH) + LD B,A + CALL MCONV + LD HL,ESCPRMTOP + LD (HL),B + INC HL + LD (HL),C + DEC HL + XOR A + LD (K1STAT),A + JR KANJI1 + +KANJI: EX DE,HL +KANJI1: LD D,(HL) + INC HL + LD E,(HL) + CALL DECORD ;JIS => INTERNAL CODE + LD BC,0961H ; Space internal code + LD A,L + OR H + JR Z,KOUT + LD B,(HL) + INC HL + LD C,(HL) +KOUT: CALL PATIN + CALL PATCHG + LD HL,PAT + CALL KPRINT + RET + IF KANROM +KSLOTSEL: LD A,(KSLOT) + LD D,A + LD A,8 + JP SLOTSEL + ENDIF +; ************ DECORDING SUB ***************** +; JIScode TO Ųcode +; IN: DE = JIScode +; OUT: HL = Ųcode Adr +; HL = 0 JIScode is INVALID + +DECORD: LD HL,0 + LD A,E + CP 20H + RET C + CP 80H + RET NC + LD A,D + CP 21H + RET C + CP 50H + RET NC + CP 22H + JR Z,KDC1 + CP 23H + JR Z,KDC2 + CP 27H + JR Z,KDC3 + JR C,KDC4 + CP 30H + JR NC,KDC4 + RET +KDC1: LD A,E + CP 36H + RET NC + JR KDC4 +KDC2: LD A,E + CP 30H + RET C + JR KDC4 +KDC3: LD A,E + CP 40H + RET NC +KDC4: PUSH DE + LD HL,2120H + XOR A + EX DE,HL + SBC HL,DE + EX DE,HL + LD HL,KCODEL + LD A,D + CP 0FH + JR C,KDC5 + SUB 8 +KDC5: SLA A + LD D,A + SLA A + ADD A,D + LD (HL),A + XOR A + RLD + LD D,A + LD A,E + ADD A,(HL) + JR NC,KDC6 + INC D +KDC6: ADD A,60H + LD (HL),A + DEC HL + LD A,09H + ADC A,D + LD (HL),A + POP DE + RET + +PATIN0: LD BC,(ROMADDR) +PATIN: +IF KANDSK + .PRINTX /KANJI DISK VER./ + LD H,B + LD L,C + + DEC H ;HL=HL-100H + LD A,111B + AND L + LD (MREC),A + + REPT 3 ;HL=HL/8 + SRL H + RR L + ENDM ;HL=RECNUM + + LD DE,(RECNUM) + CALL CMPHLDE + JR Z,PATIN2 + LD (RECNUM),HL + + LD A,11111B + AND L + LD B,A + INC B ;SET SECTOR NUM + + REPT 5 + SRL H + RR L + ENDM + + LD C,L + INC C + INC C + LD HL,DSKBUF + LD A,1 + LD (MULTFDRWN),A + CALL FDDREAD + +PATIN2: LD A,(MREC) + + REPT 5 ;A=32*A + ADD A,A + ENDM + + LD L,A + LD H,0 + LD DE,DSKBUF + ADD HL,DE + LD DE,BPAT + LD BC,32 + LDIR + + LD HL,(ROMADDR) + INC HL + LD (ROMADDR),HL + LD HL,BPAT + RET + +MREC: DS 1 +RECNUM: DW 0FFFFH +DSKBUF: DS 256 + + ELSE ;KANJI ROM + .PRINTX /KANJI ROM VER/ + + EXX + CALL KSLOTSEL + EXX + LD HL,BPAT +PATINT: LD A,B + AND 03H + LD D,A + LD A,B + SRL A + SRL A + LD B,D + OUT (C),A + LD D,32 +PATINL: LD BC,0400H + OUT (C),A + LD B,08H ; BC = 0800H +; NOP +; NOP + IN A,(C) + LD (HL),A + INC HL + DEC D + JR NZ,PATINL + LD HL,(ROMADDR) + INC HL + LD (ROMADDR),HL + LD HL,BPAT + RET + ENDIF + +PATCHG: CALL PATCHGR + LD A,(REVNORM) + AND A + JR Z,LNORM + LD A,(XCOL1) + JR COCHECK +LNORM: LD A,(XCOL) +COCHECK: AND 70H + RET NZ + LD HL,PAT + LD B,40 +PATCLOP: LD A,(HL) + CPL + LD (HL),A + INC HL + DJNZ PATCLOP + RET + +PATCHGR: LD HL,PAT + LD DE,BPAT + LD A,(DE) + LD (HL),A + INC DE + INC HL + CALL PATCHG1 + LD (HL),0FFH + INC HL + LD (HL),C + INC HL + LD A,(DE) + LD (HL),A + INC DE + INC HL + LD (HL),0FFH + INC HL + CALL PATCHG1 + LD (HL),C + INC HL + LD A,(DE) + LD (HL),A + INC DE + INC HL + CALL PATCHG2 + LD (HL),0FFH + INC HL + LD (HL),C + INC HL + LD A,(DE) + LD (HL),A + INC HL + INC DE + LD (HL),0FFH + INC HL + CALL PATCHG2 + LD (HL),C + RET + +PATCHG1: LD B,7 + LD C,0FFH + SCF +PATC1L: LD A,(DE) + RLA + RR C + LD (HL),A + INC DE + INC HL + DJNZ PATC1L + RET +PATCHG2: LD B,7 + LD C,0FFH + SCF +PATC2L: LD A,(DE) + RRA + RL C + LD (HL),A + INC DE + INC HL + DJNZ PATC2L + RET + +KPRINT: PUSH HL + LD HL,CX + LD A,(WIDTH) + DEC A + CP (HL) + JR NZ,KPUT + CALL PRND1K +KPUT: POP HL + CALL KKPRINT + CALL PRND1S + JP PRND1S + +KKPRINT: LD A,5 + LD B,40 + JP TRNC04 + +NIPMODE: LD A,(SCREENM) + CP 42H + RET NZ + LD A,(KNJONOFF) + LD HL,KINPMOD + OR (HL) + RET NZ + LD A,(DE) + CP '>' + JR Z,NIPOFF + CP '<' + RET NZ + LD A,0FFH + JR NIPCHG +NIPOFF: XOR A + LD (KINPMOD),A + LD (KNJONOFF),A +NIPCHG: LD (KANJIMODE),A + RET + +KNJLINE: LD A,(DE) + CP 'A' + JR NC,LINESET + LD A,'A' +LINESET: SUB 'A' + CP 20 + JR C,KNJLSET + LD A,19 +KNJLSET: LD (CHGINLN),A + RET + + IF JISHO +STUDYMODE: LD A,(DE) + CP '<' + JR Z,STUDYON + CP '>' + RET NZ + XOR A + JR STUDYCHG +STUDYON: LD A,0FFH +STUDYCHG: LD (LEARNMODE),A + RET + ENDIF + +BKSLASH: LD HL,BKSSW + LD A,(HL) + CPL + LD (HL),A + RET + +; *********** PAT CHANGE *************** +; IN: ż +; OUT: DE CRT ֳ pattern Adr + +PATCHGB: CALL PATCHGR + LD HL,PAT + RET + + +;******* MCONVERT *************** +; IN BC:SHIFT JIS +; OUT BC:JIS + +MCONV: LD A,B + CP 0EAH + JR Z,MCONV4 + CP 0EBH + JR Z,MCONV5 + CP 80H + JR Z,MCONV6 + CP 0A0H + JR NC,MCONV0 + SUB 70H + JR MCONV1 +MCONV0: CP 0F0H + JR NC,MCONV6 + SUB 0B0H +MCONV1: LD B,A + BIT 7,C + JR Z,MCONV2 + DEC C +MCONV2: SLA B + LD A,C + CP 9EH + JR C,MCONV25 + SUB 5EH + JR MCONV3 +MCONV25: DEC B +MCONV3: SUB 1FH + LD C,A + RET +MCONV4: LD A,C + SUB 7EH + LD B,A + LD C,20H + RET +MCONV5: LD A,C + SUB 1FH + LD B,A + LD C,7FH + RET +MCONV6: LD BC,2121H + RET + + +;********** PCONVERT ************ +; IN BC:JIS +; OUT BC:SHIFT JIS + +PCONV: LD A,C + CP 20H + JR Z,PCONV3 + CP 7FH + JR Z,PCONV4 + CP 21H + JR NZ,PCONV05 + LD A,B + CP 21H + JR NZ,PCONV05 + LD BC,2020H + RET +PCONV05: LD A,C + ADD A,1FH + LD C,A + SRL B + JR C,PCONV0 + DEC B + ADD A,5EH + LD C,A +PCONV0: LD A,C + CP 7FH + JR C,PCONV1 + INC C +PCONV1: LD A,B + CP 2FH + JR NC,PCONV2 + ADD A,71H + LD B,A + RET +PCONV2: ADD A,0B1H + LD B,A + RET +PCONV3: LD A,B + ADD A,7EH + LD C,A + LD B,0EAH + RET +PCONV4: LD A,B + ADD A,1FH + LD C,A + LD B,0EBH + RET + + +SCRNMODE: DB 01H ;WIDTH 80 : SCREEN 0 +K1STAT: DB 0 +PRMODE: DB 0 +BKSSW: DB 0 +BLNKFLG: DB 0 +REVNORM: DB 0 +CX EQU 0FFFAH +CY EQU 0FFFBH +WIDTH: DB 80 ;WIDTH 80 MODE START +CONSOLE: DB 25 ;SCREEN 0 MODE START +SCREENM: DB 0 ;SCREEN 0 MODE START +DPLANE: DB 07H +WPLANE: DB 70H + +CHGINLN EQU 0FFEBH + +KATAHIRA EQU 0FFEAH +KNJONOFF EQU 0FFE9H +JISFLAG: DB 0 +DHFLAG: DB 0 + +KANJIMODE EQU 0FFFDH +LEARNMODE EQU 0FFFCH + +;**** KEYIN ********** +; OUT: A: DATA +; Z: NO DATA +; NZ: DATA + +KEYIN: LD A,(KEYFLG) + OR A + RET Z + LD B,A + XOR A + LD (KEYFLG),A + LD A,B + CP 1 + JR Z,KEYM01 + CP 4 + JR Z,KEYM04 + CP 6 + JR Z,KEYM06 + XOR A + RET + +KEYM01: + CALL CLRBUF + LD A,3 + JP PUTRNG + +KEYM04: LD A,(KINPMOD) ;PFKEY + AND A + JR NZ,KEYM04B + LD A,(KNJONOFF) + AND A + JP NZ,KNJCODE + LD A,(KANJIMODE) + AND A + JR Z,KEYM04B + LD A,(KEYDATA) + CP 80H + JR C,KEYM04B1 + CP 0E0H + JR NC,BBB + CP 0A0H + JR NC,KEYM04B1 +BBB: JP BELL + +KEYM04B: LD A,(KEYDATA) +KEYM04B1: CP 7FH + JP NZ,PUTRNG + +KEYZERO3: LD HL,KEYZERO ;"000" KEY +RPUTRNG: LD A,(HL) + OR A + RET Z + PUSH HL + CALL PUTRNG + POP HL + INC HL + JR RPUTRNG + +KEYZERO: DB '000',0 + +KEYM06: LD A,(KEYDATA) + CP 003 + JR Z,KEYBRK + CP 004 + JR Z,KEYCS + JR KEYPF + +KEYBRK: LD A,'S'-'@' ; CTRL S + JP PUTRNG + +KEYCS: +IF BREAK + .PRINTX /BREAK REBOOT/ + JP WBOOT +ELSE + CALL CLRBUF + LD A,3 + JP PUTRNG +ENDIF + +KEYPF: EX AF,AF' + LD A,(SCREENM) + CP 42H + JR NZ,KEYPFOFF + LD A,(KINPMOD) + AND A + JR NZ,KEYPFOFF + EX AF,AF' + CP 0B0H + JR NZ,KEYPFON + LD A,(KANJIMODE) + CPL + LD (KANJIMODE),A + AND A + RET NZ + LD (KNJONOFF),A + JP CLRBUF + +KEYPFON: EX AF,AF' + LD A,(KANJIMODE) + AND A + JR Z,KEYPFOFF + EX AF,AF' + CP 30H + JR Z,KKHENK + CP 31H + JR Z,DKHENK + CP 32H + JR Z,KTHENKSW + JR KEYPFOFF1 +KKHENK:; LD A,(KNJONOFF) +; AND A +; RET NZ + LD A,0FFH + LD (KINPMOD),A + JR PFRET +DKHENK: LD A,(KINPMOD) + AND A + RET NZ + LD A,(KNJONOFF) + CPL + LD (KNJONOFF),A + JR PFRET +KTHENKSW: LD A,(KNJONOFF) + AND A + RET Z + LD A,(KATAHIRA) + CPL + LD (KATAHIRA),A +PFRET: JP CLRBUF + +KEYPFOFF: EX AF,AF' +KEYPFOFF1: OR A + JP P,KEYPF1 + AND 0FH + ADD A,10 + JR KEYPF2 +KEYPF1: AND 0FH +KEYPF2: LD L,A + LD H,0 + ADD HL,HL + ADD HL,HL + ADD HL,HL + LD BC,PFKEYTB + ADD HL,BC + JP RPUTRNG + + +CLRBUF: LD HL,RNGBUF-1 + LD (RHEAD),HL + LD (RTAIL),HL + RET + +PUTRNG: LD HL,(RHEAD) + LD DE,(RTAIL) + DEC DE + EX AF,AF' + CALL CMPHLDE + RET Z ;BUFFER FULL + EX AF,AF' + INC HL + LD (HL),A + LD DE,RNGBUF+39 + CALL CMPHLDE + JR NZ,PUTRNG2 + LD HL,RNGBUF-1 +PUTRNG2: LD (RHEAD),HL + RET + + +GETRNG: LD HL,(RHEAD) + LD DE,(RTAIL) + CALL CMPHLDE + RET Z + INC DE + EX DE,HL + LD A,(HL) + PUSH AF + LD DE,RNGBUF+39 + CALL CMPHLDE + JR NZ,GETRNG2 + LD HL,RNGBUF-1 +GETRNG2: LD (RTAIL),HL + POP AF + RET + +CONSTAT: +TTYST: LD A,(KINPMOD) ;IF (KANJI INPUT MODE) KTTYST + OR A + JP NZ,KTTYST + + LD HL,(RHEAD) + LD DE,(RTAIL) + CALL CMPHLDE + LD A,-1 ;OK + RET NZ + XOR A ;NG + RET + +KNJCODE: LD A,(KEYDATA) + CP ' ' + JR C,PUTRNG + CP 7FH + JR C,KNJHENK + CP 0E0H + JR NC,KNJCBEEP + CP 0A1H + JR NC,KNJHENK +KNJCBEEP: JP BELL + +KNJHENK: CALL HENKANN + LD A,B + CP 25H + JR NZ,PUTKRNG + LD A,C + CP 74H + JR NC,PUTKRNG + LD A,(KATAHIRA) + AND A + JR Z,PUTKRNG + DEC B +PUTKRNG: CALL PCONV + LD A,B + CALL PUTRNG + LD A,C + JP PUTRNG + +HENKANN: + LD (CHNGBUFF),A + XOR A + LD (CHNGBUFF+1),A + CALL DRTCONV + LD B,(HL) + INC HL + LD C,(HL) + RET + + +; KANJI RING BUFFER + +KCLRBUF: LD HL,KRNGBU-1 + LD (KHEAD),HL + LD (KTAIL),HL + RET + +KPUTRNG: LD HL,(KHEAD) + LD DE,(KTAIL) + DEC DE + EX AF,AF' + CALL CMPHLDE + RET Z ;BUFFER FULL + EX AF,AF' + INC HL + LD (HL),A + LD DE,KRNGBU+40 + CALL CMPHLDE + JR NZ,KPUTRNG2 + LD HL,KRNGBU-1 +KPUTRNG2: LD (KHEAD),HL + RET + +KGETRNG: LD HL,(KHEAD) + LD DE,(KTAIL) + CALL CMPHLDE + RET Z + INC DE + EX DE,HL + LD A,(HL) + PUSH AF + LD DE,KRNGBU+40 + CALL CMPHLDE + JR NZ,KGETRNG2 + LD HL,KRNGBU-1 +KGETRNG2: LD (KTAIL),HL + POP AF + RET + +KTTYST: LD A,(0FFFFH) + OR A + RET NZ ;ALWAYS OK MODE + +KTTYSTR: LD HL,(KHEAD) + LD DE,(KTAIL) + CALL CMPHLDE + LD A,-1 ;OK + RET NZ + XOR A + RET ;NG + +STATMODE: LD HL,0FFFFH + LD A,(HL) + CPL + LD (HL),A + RET + +.PRINTX /KANJI assemble/ +;KANJI INPUT COMMAND ENTRY + + +KNJINP0: LD DE,KNJCSRPTR + LD B,2+20+1 + CALL CLRZERO ;CLEAR INPUT BUFFER + CALL CLRLINE + +KNJINP1: LD HL,KNJINP0 + LD (KTTYINB+1),HL + LD A,(REVNORM) + CPL + AND 7 + LD B,A + LD A,17H + CALL TRNC02 + CALL CSRON + +KNJINPLOP: CALL KTTYSTR + AND A + JP NZ,MODRI3 + + LD A,(KNJCSRPTR) + LD B,A + LD A,(CHGINLN) + LD C,A + CALL CSR0 + CALL BLNKON + +AEE17: DI + CALL GETRNG + EI + JR Z,AEE17 + + PUSH AF + CALL BLNKOFF + POP AF + CP ' ' + JP C,AEE54 ;IF CNTROLL CODE + CP 07FH + JP C,AEE39 ;ALFA + CP 0A1H ;'' + JP C,AEE54 + CP 0E0H ;'' + JP NC,AEE54 +AEE39: LD HL,KNJINPBUF + LD DE,(KNJCSRPTR) + ADD HL,DE + LD (HL),A + CALL PRNT + LD HL,19 + INC DE + CALL CMPHLDE + JR C,KNJINPLOP + LD (KNJCSRPTR),DE + JR KNJINPLOP + +AEE54: CP 'A'-'@' + JP Z,FUKKI + + CP 1BH ;^[ + JP Z,ESUKEIP + + CP 1CH ;[RIGHT] ^\ + JR Z,CSRRHT ;CSR RIGHT + + CP 1DH ;[LEFT] ^] + JR Z,CSRLFT ;CSR LEFT + + CP 11H ;^Q + JP Z,DELETE ;DELETE + CP 12H ;^R + JP Z,INSERT ;INSERT + CP 08H ;^H + JP Z,BAKSPC ;BACK SPACE + + CP 02H ;[SHIFT]+[LEFT] ^B + JP Z,MODRI + + CP 06H ;[SHIFT]+[RIGHT] ^F + JP Z,SUSUMI + + CP 0F9H + JP Z,CHOKUSETSU ;DIRECT CHANGE + + CP 0FAH ;׶ + JP Z,HIRAGANA + + CP 0FBH + JP Z,JISHENKAN ;JIS CODE + + CP 0FCH ;KANJI + JP Z,KNJHENKAN + IF JISHO + CP 0F2H + JP Z,DICTIONARY + ENDIF + + CP 0DH ;CR + JP NZ,CODEHENKAN + LD A,(KNJCSRPTR) + AND A + JP NZ,KNJINPLOP + + LD (KINPMOD),A + CALL CLRLINE + CALL CSR + CALL CSROFF + JP TTYIN1B + +CLRLINE: XOR A + LD B,A + LD A,(CHGINLN) + LD C,A + CALL CSR0 + + CALL BLNKOFF + LD B,79 +AEDF9: PUSH BC + LD A,' ' + CALL PRNT + POP BC + DJNZ AEDF9 + RET + +CSRLFT: LD A,(KNJCSRPTR) + DEC A + JP M,KNJINPLOP + LD (KNJCSRPTR),A + JP KNJINPLOP + +CSRRHT: LD A,(KNJCSRPTR) + INC A + CP 20 + JP NC,KNJINPLOP + LD (KNJCSRPTR),A + JP KNJINPLOP +; ESCAPE +ESUKEIP: LD HL,KNJINPBUF + LD DE,(KNJCSRPTR) + ADD HL,DE + LD A,(HL) + OR A + JR Z,CSRRHT + +INSERT: LD BC,(KNJCSRPTR) + LD HL,20 + AND A + SBC HL,BC + LD B,H + LD C,L + LD DE,CHNGBUFF-1 + LD HL,CHNGBUFF-2 + LDDR + XOR A ;LD A,' ' + LD (DE),A + LD (CHNGBUFF-1),A + CALL AEF31 + JP KNJINPLOP + +DELETE: LD BC,(KNJCSRPTR) + LD HL,20 + AND A + SBC HL,BC + LD B,H + LD C,L + LD HL,(KNJCSRPTR) + LD DE,KNJINPBUF + ADD HL,DE + LD D,H + LD E,L + INC HL + LDIR + CALL AEF31 + JP KNJINPLOP + +BAKSPC: LD A,(KNJCSRPTR) + DEC A + JP M,DELETE + LD (KNJCSRPTR),A + JR DELETE +PR1LINE: +AEF31: LD B,0 + LD A,(CHGINLN) + LD C,A + CALL CSR0 + LD B,20 + LD HL,KNJINPBUF + +AEF43: LD A,(HL) + OR A + JR NZ,AEF49 + LD A,' ' +AEF49: CALL PRNT + INC HL + DJNZ AEF43 + RET + +CODEHENKAN: LD B,A + LD HL,CODETBL +CODEHENKL: LD A,(HL) + INC HL + AND A + JP Z,CODECHGE + CP B + JR Z,CODECHG + INC HL + JR CODEHENKL + +CODECHG: LD A,(HL) + JR MODRI2 + +CODECHGE: LD A,B + CP ' ' + JR C,MODRI2 + JP KNJINPLOP + +SUSUMI: LD A,'D'-'@' + JR MODRI1 + +MODRI: LD A,8 +MODRI1: PUSH AF + CALL KPUTRNG + POP AF +MODRI2: CALL KPUTRNG +MODRI3: LD HL,KNJINP1 + LD (KTTYINB+1),HL + JP WERT + +CODETBL: DB 'W'-'@' ;[ENTER] ^W + DB 0DH ;[RETURN] ^M + DB 84H ;[GRP]+[B] + DB 'B'-'@' ;^B + DB 9CH ;[GRP]+[Q] + DB 'Q'-'@' ;^Q + DB 0E5H ;[GRP]+[R] + DB 'R'-'@' ;^R + DB 9DH ;[GRP]+[W] + DB 'W'-'@' ;^W + DB 0E7H ;[GRP]+[F] + DB 'F'-'@' ;^F + DB 0EDH ;[GRP]+[H] + DB 'H'-'@' ;[BS] ^H + DB 0F1H ;[GRP]+[\] + DB 1CH ;^\ + DB 0F8H ;[GRP]+[]] + DB 1DH ;^] + DB 0FDH ;[GRP]+[[] + DB 1BH ;[ESC] ^[ + DB 086H ;[GR]+'M' + DB 0DH ;CARRIAGE RETURN + DB ''+80H + DB 'A'-'@' + DB 0 + +FUKKI: LD HL,0FE00H+160 + LD DE,KNJCSRPTR + LD BC,23 + LDIR + ; + CALL PR1LINE + JP KNJINPLOP + +TAIHI: LD HL,KNJCSRPTR + LD DE,0FE00H+160 + LD BC,23 + LDIR + RET + +DRTJIS: + CALL DRTCONV + RET NC + LD A,(DHFLAG) + AND A + JR Z,DRTKANA + LD A,(HL) + CP 25H + JR NZ,DRTKANA + INC HL + LD A,(HL) + DEC HL + CP 74H + JR NC,DRTKANA + DEC (HL) +DRTKANA: JP JISTOSFT + +DRTCONV: + IF KANDSK + LD HL,0107H + LD (ROMADDR),HL + ELSE + + LD BC,0100H + CALL PATIN + LD B,(HL) ;HL=PAT + INC HL + LD C,(HL) + LD (ROMADDR),BC + ENDIF + +AF164: CALL PATIN0 + LD B,4 +AF169: LD A,(HL) + CP 0FFH + JR Z,AF19A + CP 0FEH + RET Z + LD C,A + LD A,(CHNGBUFF) + OR A + RET Z + CP C + JR NZ,AF18F + LD A,(CHNGBUFF+1) + INC HL + LD C,(HL) + DEC HL + CP C + JR NZ,AF18F + LD DE,4 + ADD HL,DE + SCF + RET + +AF18F: LD DE,8 + ADD HL,DE + DJNZ AF169 + JR AF164 + +AF19A: LD DE,0900H + LD (ROMADDR),DE + JR AF164 + +AF1E5: LD HL,CHNGBUFF + CALL AF207 + LD D,A + LD (CHNGBUFF),A + CALL AF207 + LD E,A + LD (CHNGBUFF+1),A + CALL DECORD + LD A,L + OR H + RET Z + LD HL,CHNGBUFF + CALL JISTOSFT + RET + +AF207: LD A,(HL) + SUB '0' + REPT 4 + ADD A,A ;2* + ENDM + LD B,A + INC HL + LD A,(HL) + SUB '0' + ADD A,B + INC HL + RET + +; DIRECT CHANGE + +CHOKUSETSU: CALL TAIHI + LD DE,HENTBL + PUSH DE + LD B,50 + CALL CLRZERO ;RET Areg=0 + LD (KNJCSRPTR),A + POP DE + LD HL,KNJINPBUF + LD B,0 + CALL BLLOOP + OR B + JP Z,KNJINPLOP + PUSH BC + ; + LD A,21 + SUB B +CHOKU3: LD C,A + LD B,0 + XOR A + LD (CHNGBUFF),A + LD DE,KNJINPBUF + INC HL + LDIR + ; + POP BC + PUSH BC + CALL CLRZERO + ; + LD HL,HENTBL + POP BC +CHOKU1: CALL CHOKU0 + PUSH HL + PUSH BC + CALL DRTJIS + POP BC + POP HL + DJNZ CHOKU1 + ; + XOR A + LD (DHFLAG),A + CALL PR1LINE + JP MODRI3 + +CHOKU0: LD A,(HL) + LD (CHNGBUFF),A + XOR A + LD (CHNGBUFF+1),A + LD A,(HL) + INC HL + CP 0B6H ; CP '' + JR C,BAF256 + + CP 0CFH ; CP ''+1 = '' + RET NC ;޸ ż + + LD A,(HL) + CP 0DEH ; CP '' + JR Z,AF251 + CP 0DFH ; CP '' + RET NZ + +AF24A: LD A,(CHNGBUFF) + CP 0CAH ; CP '' + RET C + LD A,(HL) +AF251: LD (CHNGBUFF+1),A + INC HL + RET + +BAF256: CP 0B3H ; CP '' + JR NZ,AF256 + LD A,(DHFLAG) + AND A + RET NZ + +AF256: LD A,(HL) + CP 0DEH + RET NZ + JR AF251 + + +; ׶ CHANGE + + +HIRAGANA: LD A,0FFH + LD (DHFLAG),A + JP CHOKUSETSU + +CLRZERO: XOR A +CLRZR0: LD (DE),A + INC DE + DJNZ CLRZR0 + RET + +KNJHENKAN:: CALL TAIHI + LD HL,KNJINPBUF +KNJHNKN0: + LD DE,CHNGBUFF + LD B,20 + CALL CLRZERO + LD DE,CHNGBUFF +AF2D3: LD A,(HL) + CP 0A6H ; CP '' + JR C,AF2E4 + CP 0E0H + JR NC,AF2E4 + LD (DE),A + INC HL + INC DE + JR AF2D3 + +AF2E4:: LD A,(CHNGBUFF) + OR A + JR Z,AF2F4 + PUSH HL + CALL AF306 + CALL AF394 + POP HL +AF2F4: LD DE,CHNGBUFF-1 + CALL CMPHLDE + JP Z,WERT + CALL CHOKU0 + PUSH HL + CALL DRTJIS + POP HL + JP KNJHNKN0 + +AF306: EX DE,HL +AF307: DEC DE + LD A,(DE) + CP 0A6H + JR C,AF316 + CP 0E0H + JR NC,AF316 + JR AF307 + +AF316: LD HL,CHNGBUFF-1 + INC DE + AND A + SBC HL,DE + PUSH HL + POP BC + EX DE,HL + LD DE,KNJINPBUF + LDIR + PUSH DE +AF326: XOR A + LD (DE),A + LD HL,CHNGBUFF-1 + INC DE + CALL CMPHLDE + JP P,AF326 + POP DE + AND A + SBC HL,DE + POP BC + POP DE + EX DE,HL + AND A + SBC HL,DE + PUSH HL + PUSH BC + CALL AEF31 + RET + + +JISHENKAN: CALL TAIHI + XOR A + LD (KNJCSRPTR),A + LD HL,KNJINPBUF + LD B,20 +JISCHKL: LD A,(HL) + CALL CHKHEX + JP C,KNJINPLOP + INC HL + DJNZ JISCHKL + + LD HL,KNJINPBUF + LD B,20 +AF345: LD C,4 + LD DE,CHNGBUFF +AF34A: LD A,(HL) + AND A + JR Z,KIGOHCHK +AF34A1: CALL HTOUPPER + AND A + JR Z,AF36A + CP '9'+1 + JR C,AF355 + SUB 007H + +AF355: LD (DE),A + INC DE + INC HL + DEC B + JR Z,AF37B + DEC C + JR NZ,AF34A + PUSH HL + PUSH BC + CALL AF1E5 + POP BC + POP HL + JR AF345 + +AF36A: INC HL + DJNZ AF345 + JP WERT + +AF37B: DEC C + JP NZ,KIGOH + CALL AF1E5 + JP WERT + +CHKHEX:: AND A + RET Z + CALL HTOUPPER + CP '0' + RET C + CP 'F'+1 + CCF + RET C + CP '9'+1 + CCF + RET NC + CP 'A' + RET + + +HTOUPPER: CP 'f'+1 + RET NC +;TOUPPER: CP 'z'+1 +; RET NC + CP 'a' + RET C + AND 0DFH + RET + +KIGOHCHK: EX AF,AF' + LD A,2 + CP C + CALL Z,KIGOH0 +KCHKRET: EX AF,AF' + JR AF34A1 + +KIGOH: LD A,1 + CP C + JP NZ,WERT + +KIGOH0: LD HL,CHNGBUFF + CALL AF207 + LD (CHNGBUFF),A + CP 28H + JP NC,WERT + CP 21H + JP C,WERT + CALL FILL0 + + IF KANDSK + LD HL,0144H + LD (ROMADDR),HL + + ELSE + + LD BC,0100H + CALL PATIN + LD BC,4 + ADD HL,BC + LD B,(HL) + INC HL + LD C,(HL) + LD (ROMADDR),BC + ENDIF + + LD DE,HENTBL + PUSH DE +KIGOHLO: CALL PATIN0 + LD BC,4 + ADD HL,BC + LD A,(CHNGBUFF) + LD C,A + LD B,4 +KIGOHLI: LD A,(HL) + CP 0FEH + JR Z,KIGOHE + CP C + JR NZ,NEXTCODE + LD D,A + INC HL + LD E,(HL) + DEC HL + PUSH HL + CALL DECORD + LD A,H + OR L + POP HL + JR Z,NEXTCODE + POP DE + PUSH HL + PUSH DE + PUSH BC + LD BC,4 + LDIR + POP BC + POP DE + LD HL,DSPMAX + INC (HL) + LD HL,4 + ADD HL,DE + EX DE,HL + POP HL + PUSH DE +NEXTCODE: LD DE,8 + ADD HL,DE + DJNZ KIGOHLI + + JR KIGOHLO + +KIGOHE: POP DE + CALL SENTAKU ; TABLE SENTAKU + JP WERT + +SENTAKU: LD A,0FFH + LD (JISFLAG),A + CALL AF46D + XOR A + LD (JISFLAG),A + RET + +AF394: + LD BC,0100H + CALL PATIN + LD DE,00006H + ADD HL,DE + LD B,(HL) + INC HL + LD C,(HL) + LD (ROMADDR),BC +AF3A5: CALL PATIN0 + LD A,(CHNGBUFF) + LD C,A + LD B,8 +AF3AE: LD A,(HL) + CP 0FFH + RET Z + CP C + JR Z,AF3C1 + DEC B + JR Z,AF3A5 + INC HL + INC HL + INC HL + INC HL + JR AF3AE + +AF3C1: INC HL + INC HL + LD B,(HL) + INC HL + LD C,(HL) + LD (ROMADDR),BC +AF3CA: CALL PATIN0 + LD B,4 +AF3CF: PUSH HL + LD DE,CHNGBUFF +AF3D3: INC DE + LD A,(HL) + CP ' '+1 + JR C,AF3E9 + CP 50H + JR C,AF403 + CP 0FFH + JP Z,AF53D + CP 0FEH + JP Z,AF53D +AF3E9: LD A,(DE) + LD C,(HL) + CP C + JR NZ,AF3F3 + INC HL + JR AF3D3 + +AF3F3: CP C + JP C,AF53D + POP HL + LD DE,8 + ADD HL,DE + DJNZ AF3CF + JR AF3CA + +AF403: POP DE + PUSH HL + EXX + CALL FILL0 + LD DE,HENTBL + LD BC,4 + POP HL + LDIR + EXX + LD A,(DSPMAX) + INC A + LD (DSPMAX),A + JR AF457 + + +FILL0: LD DE,DSPMAX + LD B,4 + JP CLRZERO + + +AF42A: CALL PATIN0 + LD B,4 +AF42F: LD DE,CHNGBUFF+1 +AF432: LD A,(HL) + CP ' '+1 + JR C,AF462 + CP 80 + JR NC,AF462 + PUSH HL + EXX + LD HL,(DSPMAX) + ADD HL,HL + ADD HL,HL + LD DE,HENTBL + ADD HL,DE + POP DE + EX DE,HL + LD BC,00004H + LDIR + LD HL,DSPMAX + INC (HL) + EXX +AF457: LD DE,00004H + ADD HL,DE + DJNZ AF42F + JR AF42A + +AF462: LD A,(DE) + LD C,(HL) + CP C + JR NZ,AF46D + INC DE + INC HL + JR AF432 + + +AF46D: LD A,(DSPMAX) + LD (DSPPTR),A + LD HL,HENTBL + LD (HENKPTR),HL +AF46DB: LD HL,0 + LD (DSPLYNUM),HL +AF46DA: CALL AF54C + LD B,29 + LD A,(CHGINLN) + LD C,A + CALL CSR0 +AF47D: LD A,(DSPLYNUM) + ADD A,'0' + CALL PRNT + LD A,'.' + CALL PRNT + LD HL,(DSPLYNUM) + ADD HL,HL + ADD HL,HL + LD DE,(HENKPTR) + ADD HL,DE + INC HL + INC HL + LD B,(HL) + INC HL + LD C,(HL) + CALL PATIN + CALL PATCHG + LD HL,PAT + CALL KKPRINT + LD A,' ' + CALL PRNT + LD HL,DSPPTR + DEC (HL) + JR Z,AF4E5 + LD A,(DSPLYNUM) + INC A + CP 10 + JR Z,AF4E5 + LD (DSPLYNUM),A + JR AF47D + +AF4E5: CALL GETRNG + JR Z,AF4E5 + CP '0' + JR C,AF512 + CP '9'+1 + JR NC,AF4E5 + SUB '0' + LD C,A + LD A,(DSPLYNUM) + CP C + JR C,AF4E5 + LD L,C + LD H,0 + ADD HL,HL + ADD HL,HL + LD DE,(HENKPTR) + ADD HL,DE + CALL JISTOSFT + JP AF54C + + +AF512: CP 1EH + JR Z,CODEBFR + CP 1BH + JR Z,AF53E + CP ' ' + JR Z,CODEAFT + CP 1FH + JR NZ,AF4E5 +CODEAFT: LD A,(DSPPTR) + AND A + JP Z,AF46D + LD HL,(HENKPTR) + LD DE,40 + ADD HL,DE +ABDSP: LD (HENKPTR),HL + CALL AF54C + JP AF46DB + +CODEBFR: LD A,(DSPPTR) + AND A + JR Z,DSPSELE + ADD A,10 + LD HL,DSPMAX + CP (HL) + JR Z,SELLOOP + ADD A,10 + LD (DSPPTR),A + LD HL,(HENKPTR) + LD DE,40 + XOR A + SBC HL,DE + JR ABDSP + +SELLOOP: LD C,10 + LD B,0FFH + JR SUB10B + +DSPSELE: LD C,20 + LD B,0FEH +SUB10B: LD A,(DSPMAX) +SUB10L: INC B + SUB 10 + JR Z,SUB10E + JR NC,SUB10L +SUB10E: ADD A,C + LD (DSPPTR),A + LD HL,DSPMAX + CP (HL) + JP NC,AF46D + LD HL,HENTBL +DSPSELEL: LD DE,40 + ADD HL,DE + DJNZ DSPSELEL + LD (HENKPTR),HL + JP AF46DB + + +AF53D: POP BC +AF53E: LD HL,00000H + LD (KNJCSRPTR),HL + CALL AF54C + + LD A,(JISFLAG) + AND A + RET NZ + + POP BC + POP BC + JP KNJINPLOP + + +AF54C: LD B,29 + LD A,(CHGINLN) + LD C,A + CALL CSR0 + LD B,50 +AF55B: LD A,' ' + CALL PRNT + DJNZ AF55B + RET + + +JISTOSFT: + LD B,(HL) + INC HL + LD C,(HL) + CALL PCONV + LD A,B + CALL KPUTRNG + LD A,C + JP KPUTRNG + +WERT: CALL CSR + CALL CSROFF + JP KTTYIN + + IF JISHO + .LIST +;Nippon-go CP/M DICTIONARY ROUTINE +; +; + +DICTIONARY: CALL TAIHI +DICTIONARY2: LD HL,0 + LD (KNJCSRPTR),HL + LD HL,KNJINPBUF + LD A,(HL) + AND A + JP Z,WERT + + LD B,20 +SEARCHL1: LD A,(HL) + AND A + JR Z,SEARCHL15 + INC HL + DJNZ SEARCHL1 +SEARCHL15: LD (ZEROPTR),HL + LD A,20 + SUB B + LD (STRINGLEN),A + + LD B,4 + CP 3 ;A = STRINGLEN + JR NC,SUMLB + LD B,A +SUMLB: XOR A + LD (DSPCNT),A ;ATTENTION + LD D,A + LD HL,KNJINPBUF +SUML: LD E,(HL) + ADD A,E + JR NC,SUML2 + INC D +SUML2: INC HL + DJNZ SUML + LD E,A + ; +DIV: LD HL,40 + EX DE,HL +DIVL: XOR A + SBC HL,DE + JR NC,DIVL + ADD HL,DE + ; +DIV2:: LD A,L + LD H,1 + LD (DICTRK),HL + ; + LD A,(HSTWRT) + OR A + CALL NZ,PREDIC + XOR A + LD (HSTACT),A + LD (UNACNT),A + LD (HSTWRT),A + ; + ;Dictionay read routine +NEXTREAD:: LD BC,(DICTRK) + LD A,4 ;MULTI SEC COUNT SET + LD (0FFFEH),A + LD A,DIC + LD HL,HSTBUF + CALL FDDREAD +; + ; + LD HL,HSTBUF ;HL=HSTBUF DE=KNJINPBUF +SEARCHL2B: LD DE,KNJINPBUF + LD A,(STRINGLEN) + LD B,A +SEARCHL2: LD A,(DE) + CP (HL) + JR NZ,SEAR_CR + INC HL + INC DE + DJNZ SEARCHL2 + LD A,(HL) + INC HL + CP 0AH + JR Z,SARCHOK +; +SEAR_CR: LD A,0DH +SEAR_CR2: INC HL + CP (HL) + JR NZ,SEAR_CR2 + ; + INC HL + LD A,(HL) + OR A + JR Z,NXTBLOCK + CP 01AH + JP Z,KNJINPLOP + JR SEARCHL2B +; +NXTBLOCK:: LD A,(DICSEC) + ADD A,4 + LD (DICSEC),A + CP 32 + JP NC,KNJINPLOP + JR NEXTREAD + ; +SARCHOK:: PUSH HL + CALL AF54C + LD B,29 + LD A,(CHGINLN) + LD C,A + CALL CSR0 + LD HL,(BEGINPTR) + LD (BGNPTRBK),HL + POP HL + LD (BEGINPTR),HL +DSPLOOP:: LD A,(HL) + CP 'I'-'@' + JR Z,NXTON + CP 'M'-'@' + JR Z,NXTOFF + LD B,A + INC HL + LD C,(HL) + PUSH HL + CALL MCONV + LD D,B + LD E,C + CALL DECORD + LD B,(HL) + INC HL + LD C,(HL) + CALL PATIN + CALL PATCHG + LD HL,PAT + CALL KKPRINT + POP HL + INC HL + JR DSPLOOP +; +NXTON: LD A,-1 + JR WAITKEY +NXTOFF: XOR A +WAITKEY: LD (NXTFLG),A + LD (NXTPTR),HL +WAITKEYL: CALL GETRNG + JR Z,WAITKEYL + + CP 1BH + JR Z,NXTDSPEND + CP ' ' + JR Z,NXTDSP + CP 'W'-'@' + JR Z,KIMARU + CP '0' + JR Z,KIMARU + CP 'M'-'@' + JR NZ,WAITKEYL + +KIMARU: LD HL,(BEGINPTR) +PICHI: LD A,(HL) + CP 'I'-'@' + JR Z,WERT2 + CP 0DH + JR Z,WERT2 + PUSH HL + CALL KPUTRNG + POP HL + INC HL + JR PICHI + +NXTDSP: LD HL,DSPCNT + INC (HL) + LD HL,(NXTPTR) + INC HL + LD A,(NXTFLG) + OR A + JP NZ,SARCHOK +NXTDSPEND: CALL AF54C + JP KNJINPLOP + +WERT2: LD A,(DSPCNT) ;if (DSPCNT==0) need not learning. + OR A + JR Z,WERT3 + LD A,(0FFFCH) ;0FFFCH = LEARNING FLAG + OR A + JR Z,WERT3 +; +; LEARNING ROUTINE +; +;PART I + LD HL,(BGNPTRBK) + LD DE,HENTBL + CALL BLLOOP + LD (KUGIRI),A +; +;PART II + LD HL,(BEGINPTR) + LD DE,(BGNPTRBK) + CALL BLLOOP + EX AF,AF' + LD A,(KUGIRI) + LD (DE),A + EX AF,AF' + LD (KUGIRI),A +; +;PART III + LD HL,HENTBL + INC DE + CALL BLLOOP + LD A,(KUGIRI) + LD (DE),A +; +;DICTIONARY WRITE + LD BC,(DICTRK) + LD A,DIC ;DIC=CDRIVE + LD HL,HSTBUF + CALL FDDWRITE +; +WERT3: CALL AF54C + LD A,(STRINGLEN) + CP 19 + JP NC,WERT + SUB 19 + NEG + LD C,A + LD B,0 + LD HL,(ZEROPTR) + INC HL + LD DE,KNJINPBUF + LDIR + LD A,(STRINGLEN) + INC A + INC A + CALL CLRZERO + CALL AEF31 + JP DICTIONARY2 + +BGNPTRBK: DS 2 +BEGINPTR: DS 2 +NXTPTR:: DS 2 +NXTFLG:: DS 1 +DICTRK: DS 1 +DICSEC: DS 1 +STRINGLEN: DS 1 +ZEROPTR: DS 2 +DSPCNT: DS 1 +KUGIRI: DS 1 + + ENDIF +; +;BLOCK CONVERT on CONDITION +BLLOOP: LD A,(HL) + LD (DE),A + CP 32 + RET C + INC B + INC HL + INC DE + JR BLLOOP + +CSROFF: LD A,(REVNORM) + AND 7 + LD B,A + LD A,17H + CALL TRNC02 +CSRON:: LD A,(CY) + LD B,A + LD A,(CX) + CP 79 + JR NZ,CSRON1 + EX AF,AF' + LD A,19 + CP B ;CX==79 && CY==19 + RET Z + EX AF,AF' + INC B + XOR A +CSRON1: LD L,0 + LD H,B + LD DE,80 + CALL MULHLDE ;HL=csr Y*80 + ; + LD D,0 + LD E,A + ADD HL,DE + LD (CSRPRM),HL + LD HL,CSRPRM + LD A,2BH + LD B,6 + JP TRNC04 + +MULHLDE: LD B,8 +MULLOP: ADD HL,HL + JR NC,COUNT + ADD HL,DE +COUNT: DJNZ MULLOP + RET + + +CSRPRM: DS 2 ;X+Y*80 + DB 0 ;COLUM X + DB 19 ;COLUM Y + DB 0 ;LENGTH COLUM + DB 7 ;LENGTH DOT + + +;*********** KANJI LPRINT ******************** + +; IN Breg :CHRACTOR CODE + +.PRINTX /PRINTER assemble/ + +KLPT: + IF KANPTR ;KANJI PRINTER + INCLUDE FP80K.MAC + ENDIF + + IF FP80 ;EPSON FP-80 + INCLUDE FP80.MAC + ENDIF + + IF RP80 ;GRAPHIC PRINTER + INCLUDE RP80.MAC + ENDIF + + IF DPX510 + INCLUDE DPX510.MAC + ENDIF + + IF GP550E ;SEIKOSHA GP550E + INCLUDE GP550E.MAC + ENDIF + + IF UP130K + INCLUDE UP130K.MAC + ENDIF + + IF MP130K + INCLUDE MP130K.MAC + ENDIF + + IF RITEMAN + INCLUDE RITEMAN.MAC + ENDIF + +.PRINTX /INITIAL assemble/ + +RHEAD EQU $ +RTAIL EQU RHEAD+2 + +KHEAD EQU RTAIL+2 +KTAIL EQU KHEAD+2 + +RNGBUF EQU KTAIL+2 +KRNGBU EQU RNGBUF+40 + +CMDDT EQU KRNGBU+41 + +KEYSPBK EQU CMDDT+1 + +ESCPRMTOP EQU KEYSPBK+2 + +KCODEH EQU ESCPRMTOP+3 +KCODEL EQU KCODEH+1 + +KNJCSRPTR EQU KCODEL+1 +KNJINPBUF EQU KNJCSRPTR+2 + +CHNGBUFF EQU KNJINPBUF+21 + +BPAT EQU CHNGBUFF+21 +PAT EQU BPAT+32 + +ROMADDR EQU PAT+40 + +HENKPTR EQU ROMADDR+2 +DSPPTR EQU HENKPTR+2 +DSPMAX EQU DSPPTR+1 +DSPLYNUM EQU DSPMAX+2 +HENTBL EQU DSPLYNUM+2 +EOBIOS EQU HENTBL+492 +;**** BOOT etc. ********* + +BOOT: LD A,10010100B ;SET I/O BYTE + LD (IOBYT),A + XOR A ;SET LOG IN DISK A: + LD (LOGDISK),A + LD SP,INITSP ;SET STACK + +;******** INTIALIZE ROUTINE ********* + +INITIAL: DI + LD HL,KEYINT ;SET INTRRUPT VECTOR + LD (INT87),HL + LD HL,FDINT + LD (INTB),HL + LD BC,INTPORT + LD A,17H + OUT (C),A + LD (INTBACK),A +KEYINIT: XOR A ;KEY INPUT INITALIZE + LD (KEYFLG),A + LD (PRMODE),A + LD (BLNKFLG),A + LD (0FFFFH),A + LD (KANJIMODE),A + LD (KINPMOD),A + LD (KNJONOFF),A + LD (KATAHIRA),A + LD (CHGINLN),A + + IF KANPTR + LD HL,0FFE0H ;KANJI PRINTER INIT + LD (HL),4 + INC HL + LD (HL),6 + INC HL + LD (HL),12 + INC HL + LD (HL),80 + ENDIF + IF RP80 OR FP80 OR DPX510 OR RITEMAN + LD HL,0FFE0H + LD (HL),8 + INC HL + LD (HL),80 + ENDIF + IF GP550PC OR GP550FM + LD HL,0FFE0H + LD (HL),3 + INC HL + LD (HL),3 + ENDIF + IF PCPR + LD HL,0FFE0H + LD (HL),4 + INC HL + LD (HL),4 + ENDIF + +DVRD: LD A,0FFH ; SET DRIVE CODE + LD (LEARNMODE),A + LD HL,DVTBL + LD B,8 +DVRD1: LD (HL),A + INC HL + DJNZ DVRD1 + LD HL,DVTBL + LD E,2 +DVRDLOP: LD BC,CPUSEL + OUT (C),E + LD A,4 + LD BC,IOSEL + OUT (C),A + IN A,(C) + CP 0FFH + JR Z,DVRD2 + LD (HL),A + LD BC,4 + ADD HL,BC + JR DVRD3 +DVRD2: LD D,0 +DVRD2L: OUT (C),D + IN A,(C) + LD (HL),A + INC HL + INC D + LD A,D + CP 4 + JR C,DVRD2L +DVRD3: INC E + LD A,E + CP 4 + JR C,DVRDLOP +FDTBLGEN: LD HL,FDTBL ;FDD TABLE GENERATE + LD A,0FFH + LD B,32 +FDTBLG1: LD (HL),A + INC HL + DJNZ FDTBLG1 + LD HL,FDTBL + LD DE,DVTBL + LD B,8 +FDTBLG2: LD A,(DE) + CP 04 + JR NZ,FDTBLG3 + LD A,8 + SUB B + LD C,A + LD (HL),A + INC HL + XOR A + LD (HL),A + INC HL + LD (HL),C ;FP-1022FD1*2 ķʤ NOP + INC HL ; | + INC A ; | + LD (HL),A ; | + INC HL ; | +FDTBLG3: INC DE + DJNZ FDTBLG2 + ; + LD HL,DVTBL + LD B,8 + LD D,0 +KSLTL: LD A,(HL) + CP 8 + JR Z,KSLTSEL + INC HL + INC D + DJNZ KSLTL + LD D,0FFH +KSLTSEL: LD A,D + LD (KSLOT),A + +RAMINIT: LD DE,RAMTBL ;RAM PACK INITIALIZE + LD HL,DVTBL + LD B,8 + LD C,0 + LD A,1 + +RRLOP: CP (HL) + CALL Z,TBLSET + INC HL + DJNZ RRLOP + + LD A,C + LD (RAMSUM),A + OR A + JR NZ,RRLOP2 + LD A,2 ;IF NOT RAM CONNECTED + LD (MAXDRV),A + JR SETINTR + +RRLOP2: LD L,A + LD H,0 + REPT REPEATCNT + ADD HL,HL ;RAM * 16 + ENDM + DEC HL + LD (DSM),HL ;SET BLOCK SUM - 1 + ; +SETINTR: LD A,0FFH ;SET INTERRUPT REG + LD I,A + EI + LD HL,0300H ;SET OPENING CUSOR POINT + LD (CX),HL ;X=0,Y=3 +; LD A,22 ;WHITE OPTION START +; LD B,11H +; CALL TRNC02 + CALL CSR ;SET OPNING CUSOR LOCATE + CALL ESCC + CALL CLRBUF ;KEY BUFFER CLEAR + CALL KCLRBUF ;KANJI KEY BUFFER CLEAR + CALL BEEPOFF + JP GOCPM + +; RAM TABLE SET ROUTINE +TBLSET: PUSH AF + LD A,8 + SUB B + LD (DE),A + LD (RAMSUM),A + INC DE + INC C + POP AF + RET + +EOCODE:: + END diff --git a/tests/restricted/aquarius.asm b/tests/restricted/aquarius.asm new file mode 100644 index 00000000..50b3a2e3 --- /dev/null +++ b/tests/restricted/aquarius.asm @@ -0,0 +1,6134 @@ +; +; MATTEL AQUARIUS ROM DISASSEMBLY +; By Kenny Millar 26 April 2000 +; Last update: 15th August 2000 +; email: beetleuk@aol.com +; +; Improved with some of the results by basck.c +; +; The original Aquarius rom was marked as +; (C) Microsoft 1982, However I am pretty sure +; that after the demise of the Aqurius production +; this software passed into the public domain. +; +; However this document is my property, although you can +; copy and distribute it freely, but please credit +; me as the original author, and include my email address. +; +; Changes and additions are welcome. Your input will be +; credited accordingly. +; + +#define CLS defb $0b ; The 'clear screen' character code. +#define CR defb $0d ; Carriage return +#define LF defb $0a ; Line Feed +#define CRLF defb $0d,$0a ; Carriage return+linefeed. + +;SYSTEM VARIABLES. +; NAME LOCATION DESCRIPTION +;------------------------------------------------------------------- +; 1. COLRAM #3400 Start of screen colour ram +; 2. CURCOL #3800 Current cursor column +; 3. CURRAM #3801 Position in CHARACTER RAM of cursor +; 4. USRJMP #3803 Location of JMP instruction for USR. +; 5. ROWCOUNT #3808 Counter for number of screen lines printed. +; 6. LASTFF #3809 The value last sent out to ($FF) +; 7. LSTASCI #380a the ASCII value of last key pressed. +; 8. KWADDR #380b Address of the keyword in the keyword table. +; 9. CURHOLD #380d Holder for the character behind the cursor. +;10. LASTKEY #380E The SCAN CODE of the last key pressed. +;11. SCANCNT #380f The number of SCANS the key has been down for. +;12. PRNCOL #3846 The current printer column. +;13. CHANNEL #3847 Channel: 0=screen, 1=printer. +;14. CURLIN #384D The current BASIC line number. +;15. BASTART #384F Address in ram of first line of basic. +;16. LINBUF #3860 Address of start of the line input buffer. +;17. RAMTOP #38AD Address of top of physically working ram. +;18. TMPSTAT #38ce Temporary holder of next statement address +;19. CONTPOS #38d4 Position in memory to CONTinue from. +;20. CONTLIN #38d2 Line number to CONTinue from. +;21. BASEND #38d6 Address in ram of the last byte of the BASIC program. +;22. RESTORE #38DC Address in ram of line last RESTORE'd + +; IO Ports +; NAME Address Bit DESCRIPTION +;------------------------------------------------------------------- +; 1. SPEAKER FC 0 Loud speaker +; 2. PRINTER FE 0 Printer +; 3. KEYBOARD FF 0-6 Keyboard (See NOTE: Keyboard) + + +; NOTE: Keyboard. +; +; The Aquarius keyboard is layed out as 8 columns of 6 keys, giving +; a maximum of 48 keys. +; The reset key is wired directly to the RESET- pin of the CPU. +; The Aquarius keyboard routines make use of the 'feature' of the Z80 +; where by the byte in B register is output on the high byte of the address +; bus during an IN A,(C) instruction. +; +; Any BIT which is SET in B during the IN instruction enables a single column +; of the keybaord. Then any key which is down during the read will create a 0 +; in the appropriate bit of A, this is inverted so a down key will create a 1 +; in the appropraite bit of A. + + + +;**************************** +;* MAIN EXECUTIVE ROUTINES * +;**************************** +; ENTRY +; On power up the Z80 always starts processing from 0x0000 +; +ENTRY: jp $1fe1,START ; immediately jump to START +l0003: defb 82,06,22 ; hex representation of "22/06/82" - The date! +l0006: defb $0B ; Undefined, possibly the revision number. + defb $00 ; + +;************************* +;*** RESTART FUNCTIONS *** +;************************* + +; RST08: (CHKNXT) +; This routine compares the current character +; in the statement with the DEFB which follows +; the RST $08 instruction. +; If they are the same, then the routine returns with Z flag set. +; otherwise it branches to report a syntax error. +; +RST08: ld a,(hl) ; Retrieve (HL) + ex (sp),hl ; Retrieve (SP) + cp (hl) ; Compare (HL) with (SP) + inc hl ; Adjust SP to account for the DEFB Byte + ex (sp),hl ; on the stack. + jp nz,ERROR_SN,$03c4 ; If (HL) and (SP) are not equal, + ; report a SyNtax error. + ; Else return. +; +; Get the next character, +; return with CARRY SET if it is between 0 and 9 incl. +GETNEXT: +RST10: inc hl ; increment pointer + ld a,(hl) ; retrieve character + cp $3a ; compare with ':' + ret nc ; return if it is above "9". + jp $0670 ; else jump to $0670 to check if + ; it is between '0' and '9' + ; this function will return with carry set if it is. + +PRNCHAR: +RST18: jp PRNTCHR ; Print the character in A. + nop + nop + nop + nop + nop +; +; Compare HL with DE to find greater. +; If DE is greater, CARRY will be set +;CMPHLDE: +CMPHLDE: +RST20: ld a,h ; Compare MSB first. + sub d ; subtract D from H + ret nz ; Return with carry set if DE>HL + ; otherwise check LSB... + ld a,l ; if (H-D)=0 then do (L-E) + sub e ; subtract E from L + ret ; and return. + + nop + nop + +RST28: +l0028: ld a,($38e7) ; Get byte at ($38e7) + or a ; Set flags + jp nz,$14eb ; Jump if not zero + ret ; Return if zero. + +; +; The user can write his own RST30 routine by putting the start address +; into $3806,$3807. +; The default one does nothing but chew up the DEFB after the RST 30h +; Nothing in the BASIC rom changes this from default. + +CALLUDF: +RST30: ld ix,($3806) ;initially this contains $003b + jp (ix) ; unless changed by the user this will + nop ; jump to 003b which just chews up the DEFB and returns. + nop + +; +; location USRJMP contains a JMP command followed by 2 bytes +; initially these bytes point to ERROR_FC,$0697 (The UF error report) +; but are modified by the user when they prepare for a USR +; command in basic to jump to his own routine. +; +CALLUSR: +RST38: jp USRJMP ; initially this holds 0697 + ; which just reports a NF error. +; +; This is the system default UDF which does nothing but chew up the DEFB +; in the code after the RST $30 command. +; The user can write his own UDF by placing the code in ram and then +; putting a 16 pit pointer to his code at $3806, LSB first. +; +SYSUDF: +l003b: exx ;swap register sets + pop hl ; + inc hl ;Increment the SP to account for the defb after each RST $30 + push hl ; + exx + ret + +START2: +l0041: ld sp,$38a0 ; initialise stack pointer + ld a,$0b ; CHR$($0b) = clear the screen. + call PRNCHR + + ld hl,(CURRAM) ; location in ram of cursor + ld (hl),$20 ; blank out the cursor with a space. + + ld a,$07 ; CHR$($07) = BEEP + call PRNCHR + + xor a ; make a=00 + out ($ff),a ; + ld hl,$2fff ; end of rom space? + ld ($385d),hl ; + +; +; Check for presence of Xtended-ROM cartrige? +; If found jump into it +; +XROMCHK: + ld de,$e011 ; + ld hl,$0081 ; + +l0062: dec de ; A simple for of encryption is used, so we don't know + dec de ; what the rom is checking for. + inc hl ; Basically it jumps backwards from $e011 two bytes + ld a,(de) ; at a time , does some simple maths on the contents + rrca ; and compares then with the bytes starting at $0081. + rrca ; + add a,e ; + cp (hl) ; + jr z,$0062 ; Perfect match, so check next byte... + ld a,(hl) ; + or a ; Did we get as far as the $00 end marker byte? + jr nz,$0089 ; if not continue at START3 into BASIC + ex de,hl ; else cary on here. + ld b,$0c + +l0073: add a,(hl) + inc hl + add a,b + dec b + jr nz,$0073 ; (-6) + xor (hl) + out ($ff),a + ld (LASTFF),a + jp $e010 ; jump to ROM cartridge???? + +l0082: defb '+7$$3,' + defb $00 + + +START3: +l0089: ld de,$31a1 ; Offset into character ram + ld hl,$00b0 ; 'BASIC' + ld bc,$0005 ; 5 letters long + ldir ; copy to character ram matrix + ld de,$3210 ; offset into chr ram + ld hl,$00b5 ; 'Press RETURN KEY TO START' + ld bc,$0019 ; 0x19 charcters long. + ldir ; copy into screen ram. + +CLRCYCLE: +l009f: ld b,$03 ; BLACK on YELLOW + call SPLASH,$00cf ; set colours, delay, check for RTN key + ld b,$02 ; BALCK on BLUE + call SPLASH,$00cf ; set colours, delay, check for RTN key + ld b,$06 ; BLACK on GREEN + call SPLASH,$00cf ; set colours, delay, check for RTN key + jr CLRCYCLE ; do it all again.... + +l00b0: defb 'BASIC' +l00b5: defb "Press RETURN key to start." + nop +; +; Set background colour to b, +; delay 1 second, +; check for RTN key etc +; +SPLASH: +l00cf: ld hl,COLRAM ; start of screen colour ram + +l00d2: ld (hl),b ; The colour to be used. + inc hl ; fill screen ram with colour code. + ld a,h ; stop when we get to $3800 + cp $38 + jr nz,$00d2 ; Loop. + + ld hl,$4000 ; Now we have filled the colour ram, + ; we are going to loop $4000 times + ; checking for RTN or CTRL+C each time. + +l00dc: call KEYCHK,$1e80 ; Get ASCII of last key pressed. + cp $0d ; was RTN pressed? + jr z,COLDSTART,$00fd ; If so, start with NEW + + cp $03 ; was CTRL-C pressed? + jr z,WARMSTART,$00ed ; if so start without NEW + ; all other key codes ignored. + dec hl ; decrement the loop counter + ld a,h ; and compare.. + or l ; ..with 00 + jr nz,$00dc ; total loop $4000 times + ret ; then return for next background colour. + ; keep doing this until the user presses RTN + ; or CTRL+C + +; +; If the users presses CTRL+C on the start screen +; we start without doing a 'NEW'. +; this allows the user to recover from a crash or infinite loop +; without loosing the programme. This is an undocumented feature. +; +WARMSTART: +l00ed: ld a,$0b ; Preload A with the clear-screen character + call PRNCHR1,$1d72 ; Print the character in A + ld a,(LASTFF) ; + out ($ff),a ; + call CLRWKSP,$0be5 ; Clear workspace and prepare for IM-MODE + call KEYBREAK,$1a40 ; Start as though the program + ; had just got a "Break" during execution. +; +;START with NEW +; +COLDSTART: +l00fd: ld hl,$0187 ; copy $51 bytes from $0187 to + ld bc,$0051 ; $3803, thereby initialising most + ld de,USRJMP ; system varibles. + ldir ; + xor a ; Clear A + ld ($38a9),a ; And initialise some + ld ($3900),a ; more system variables. +; +; RAM test +; + + ld hl,$3964 ; start of USER RAM +RAMTEST: +l0112: inc hl + ld c,(hl) ; Save current contents of RAM location + ld a,h ; + or l ; Are we done? (ie HL wrapped back to 0000) + jr z,SVRAMTOP,$0123 ; If so, jump to next section. + xor c ; XOR C into Accumulator + ld (hl),a ; store into current memory address + ld b,(hl) ; then retrieve + cpl ; invert + ld (hl),a ; store + ld a,(hl) ; retrieve + cpl ; invert + ld (hl),c ; (restore ORIGINAL contents) + cp b ; is location working? + jr z,RAMTEST ; If so, jump to top of loop and test next location. + + ; If the previously tested memory address +SVRAMTOP: ; didn't work we fall through to here. + ; and HL points to the last address tested. +l0123: dec hl ; Derement to point to last WORKING address. + ld de,$3a2c ; Start of program ram 14892 (decimal) + rst $20 ; COMPARE HL,DE + + jp c,OM_ERROR,$0bb7 ; if start of program ram is > working ram + ; then we have a problem! + ; so we report the error, and drop out to + ; immediate mode. + + ld de,$ffce ; this value is -50 +l012e: ld (RAMTOP),hl ; + add hl,de ; subtract 50 from RAMTOP + ld ($384b),hl ; and save the result here. + call $0bbe ; + call $1ff2 ; 'Print copyright message. + +l013b: ld sp,$3865 ; + call CLRWKSP,$0be5 ; Clear workspace and prepare to enter Immediate mode. + ld hl,$2005 ; + ld de,$0082 ; + +l0147: ld a,(de) ; + or a ; if (DE)= $00 jump to 1fe8 and start + ; running code from cartridge. + jp z,JMPCART,$1fe8 ; + cp (hl) ; otherwise compare (DE) with (HL) + jr nz,$0153 ; if not the same jump forward and start BASIC + dec hl + inc de + jr $0147 ; Loop + +l0153: ld a,r ; obtain a random value from Refresh register. + rla ; rotate it left, just for the hell. + add a,c ; and add C - that should be pretty random now! + out ($ff),a ; throw it out to ($FF) + ld (LASTFF),a ; and save to LASTFF + jp OKMAIN,$0402 ; print 'Ok' and enter immediate mode. + +l015f: defb CLS+"Copyright . 1982 by Microsoft Inc. S2" +CR + defb 00 + +;The bytes from $0187 to $01d7 are copied to $3803 onwards as default data. + +l0187: jp ERROR_FC,$0697 ; $3803 + defb $3b,$00 ; ($3806,$3807) = $003b Address of RST30 + defb $00 ; $3808 + defb $a3 ; $3809 = LASTFF - the last value + ; sent OUT to $ff + defb $00 ; $380a = LASTASCI + defb $00,$00 ; $380b,$390c = Address of keyword in table. + defb $20 ; $380d - Holder for the character behind + ; the cursor. + defb $00 ; $380e The scan code of the last key pressed. + defb $00 ; $380f - Scan count. The number of scan loops + ; the key has been held down for. + +l0194: sub $00 ; the code from here on is copied to + ld l,a ; $3810 onwards. This is so that it can + ld a,h ; be replaced by the USER or CARTRIDGE. + sbc a,00 ; + ld h,a + ld a,b + sbc a,00 + ld b,a + ld a,$00 + ret + +l01a2: nop + nop + nop + dec (hl) + ld c,d + jp z,$3999 + inc e + halt + sbc a,b + +l01ad: ld ($b395),hl + sbc a,b + ld a,(bc) + ld b,a + sbc a,b + ld d,e + pop de + sbc a,c + sbc a,c + ld a,(bc) + ld a,(de) + sbc a,a + sbc a,b + ld h,l + cp h + call $d698 + +l01c2: ld (hl),a + ld a,$98 + ld d,d + +l01c6: rst $0 + ld c,a + +l01c8: add a,b + nop + nop + nop + jr z,$01dc ; (14) + nop + ld h,h + add hl,sp + cp $ff + ld bc,$2139 +; +; JUMP table +; This table is used by the interpreter to JUMP to the correct +; instructions based on the command byte found in the BASIC line. +; On entry to each routine, the Z flag is set if there are no +; more parameters following the command or statement. +; +; NOTE, although the jump table includes entries for ATN and FN +; there is no implementation for these commands in the ROM +; so they cannot be used. +; +l01d5 defb $0c21 ; END +l01d7 defb $05bc ; FOR +l01d9 defb $0d13 ; NEXT +l01db defb $071c ; DATA +l01dd defb $0893 ; INPUT +l01df defb $10cc ; DIM +l01e1 defb $08be ; READ +l01e3 defb $0731 ; LET +l01e5 defb $06dc ; GOTO +l01e7 defb $06be ; RUN +l01e9 defb $079c ; IF +l01eb defb $0c05 ; RESTORE +l01ed defb $06cb ; GOSUB +l01ef defb $06f8 ; RETURN +l01f1 defb $071e ; REM +l01f3 defb $0c1f ; STOP +l01f5 defb $0780 ; ON +l01f7 defb $07b5 ; LPRINT +l01f9 defb $1b15 ; COPY +l01fb defb $0b3b ; DEF +l01fd defb $0b6d ; POKE +l01ff defb $07bc ; PRINT +l0201 defb $0c4b ; CONT +l0203 defb $056c ; LIST +l0205 defb $0567 ; LLIST +l0207 defb $0ccd ; CLEAR +l0209 defb $1c2c ; CLOAD +l020b defb $1c08 ; CSAVE +l020d defb $1a4f ; PSET +l020f defb $1a4c ; PRESET +l0211 defb $1ad6 ; SOUND +l0213 defb $0bbd ; NEW +l0215 defb $14f5 ; SGN +l0217 defb $15b1 ; INT +l0219 defb $1509 ; ABS +l021b defb $3803 ; USR +l021d defb $10a8 ; FRE +l021f defb $0b2e ; LPOS +l0221 defb $0b33 ; POS +l0223 defb $1775 ; SQR +l0225 defb $1866 ; RND +l0227 defb $1385 ; LOG +l0229 defb $17cd ; EXP +l022b defb $18d7 ; COS +l022d defb $18dd ; SIN +l022f defb $1970 ; TAN +l0231 defb $1985 ; ATN +l0233 defb $0b63 ; PEEK +l0235 defb $0ff3 ; LEN +l0237 defb $0e29 ; STR$ +l0239 defb $1084 ; VAL +l023b defb $1002 ; ASC +l023d defb $1013 ; CHR$ +l023f defb $1021 ; LEFT$ +l0241 defb $1050 ; RIGHT$ +l0243 defb $1059 ; MID$ + + +;Keyword table. NOTE! The first letter of each keyword is + $80 +l0245: defb 'END' defb 'FOR' defb 'NEXT' defb 'DATA' + defb 'INPUT' defb 'DIM' defb 'READ' defb 'LET' + defb 'GOTO' defb 'RUN' defb 'IF' defb 'RESTORE' + defb 'GOSUB' defb 'RETURN' defb 'REM' defb 'STOP' + defb 'ON' defb 'LPRINT' defb 'COPY' defb 'DEF' + defb 'POKE' defb 'PRINT' defb 'CONT' defb 'LIST' + defb 'LLIST' defb 'CLEAR' defb 'CLOAD' defb 'CSAVE' + defb 'PSET' defb 'PRESET' defb 'SOUND' defb 'NEW' + + defb 'TAB(' defb 'TO' defb 'FN' defb 'SPC(' + defb 'INKEY$' defb 'THEN' defb 'NOT' + defb 'STEP' +L02E7: defb $AB,$AD,$AA,$AF,$DE ; - The operators: + - * / and ^ + +L02EC: defb 'AND' defb 'OR' defb $BE,$BD,$BC + + defb 'SGN' defb 'INT' defb 'ABS' defb 'USR' + defb 'FRE' defb 'LPOS' defb 'POS' defb 'SQR' + defb 'RND' defb 'LOG' defb 'EXP' defb 'COS' + defb 'SIN' defb 'TAN' defb 'ATN' defb 'PEEK' + defb 'LEN' defb 'STR$' defb 'VAL' defb 'ASC' + defb 'CHR$' defb 'LEFT$' defb 'RIGHT$' defb 'MID$' + defb 'POINT' + +L034B defb $80 defb $79 defb $5c defb $16 defb $79 + defb $5c defb $12 defb $7c defb $c9 defb $13 + defb $7c defb $2d defb $14 defb $7f defb $7e + defb $17 defb $50 defb $a9 defb $0a defb $46 + defb $a8 + +L0360: defb $0a + defb " Error" +beep + defb $00 +l0369: defb " in " + defb $00 +l036e: defb "Ok" +CR+LF + defb $00 +l0373: defb "Break" + defb $00 +; +; ERROR Abbreviations: +l0379: defb "NF" ; No UDF's defined. + defb "SN" ; Syntax error + defb "RG" ; Return without gosub + defb "OD" ; out of data + defb "FC" ; Function control error + defb "OV" ; Overflow + defb "OM" ; Out of memory + defb "UL" ; Undefined line + defb "BS" ; Bad subscript + defb "DD" ; + defb "/0" ; divide by zero + defb "ID" ; Illegal immediate mode + defb "TM" ; Type mismatch error + defb "OS" ; Over size error. + defb "LS" ; + defb "ST" ; + defb "CN" ; Can't continue + defb "UF" ; Undefined function error + defb "MO" ; Missing operand + +l039f: ld hl,$0004 + add hl,sp + +l03a3: ld a,(hl) + inc hl + cp $81 ; + ret nz + +l03a8: ld c,(hl) + inc hl + ld b,(hl) + inc hl + push hl + ld h,b + ld l,c + ld a,d + or e + ex de,hl + jr z,$03b6 ; (2) + ex de,hl + rst $20 ; COMPARE HL,DE + +l03b6: ld bc,$000d + pop hl + ret z + + add hl,bc + jr $03a3 ; (-27) + +l03be: ld hl,($38c9) + ld (CURLIN),hl ; update current line number + +; +; RST08_2: +; RST08 Jumps here if (sp) and (HL) are not the same. +; +ERROR_SN: +l03c4: ld e,$02 ; offset from start of ERROR codes to SN + ld bc,$141e ; These instructions don't make any sense. + ld bc,$001e ; I assume they are here as fallout from +l03cb: ld bc,$121e ; previous code. + ld bc,$221e ; + ld bc,$0a1e ; + ld bc,$241e ; + ld bc,$181e ; + +; +; ERROR: On entry E holds an offset to the 2 digit error abbreviation. +; +ERROR: +l03db: call CLRWKSP,$0be5 ; Clear workspace and prepare to enter + ; immediate mode. + rst $30,CALLUDF ; call the UDF if set. + defb $00 + + call RSTCOL,$19de ; reset cursor to start of next line, + ; if not already at start of line. + + ld hl,$0379 ; 'NF' the start of the error code table. + rst $30,CALLUDF + defb $01 + + ld d,a + add hl,de + ld a,$3f ;'?' + rst $18 ;PRINTCHR + + ld a,(hl) ; HL points to the start of a 2 digit error abbreviation. + rst $18 ; PRINT CHARACTER in A + rst $10,GETNEXT ; Get next character + rst $18 ; Print character in A + ld hl,$0361 ; ' Error'+BEEP + +l03f4: call 0e9d,PRINTSTR ; Print the string pointed to by HL + ld hl,(CURLIN) ; get current line number + ld a,h ; and check if it is 0000 + and l ; + inc a ; + call nz,PERRIN,$166d ; If we were executing a BASIC line + ; then Print ' in ' &CURLIN as part of + ; the error report. + + + ld a,$c1 ; ** This instruction overlaps with PUSH BC + ; ($c1) in the next instruction. + ; but this won't cause a problem. +OKMAIN2: +l0401: pop bc ; + +; OKMAIN +; Print OK and enter immediate mode. +; +OKMAIN: +l0402: rst $30,CALLUDF + defb 2 + + call PRNHOME,$19be ; if we were printing to printer, LPRINT a CR and LF + xor a + ld (ROWCOUNT),a ; Set ROWCOUNT to 0. + call RSTCOL,$19de ; reset cursor to start of next line, + ; if not already at start of line. + ld hl,$036e ; 'Ok' +CR+LF + call 0e9d,PRINTSTR ; PRINTSTR + +; +; IMMODE: +; Immediate mode starts here. +; +l0414: ld hl,$ffff + ld (CURLIN),hl + call GETLINE,$0d85 ; Input a line from keyboard + ; check for CTRL+C, RTN, TAB, BELL, BS + ; CTRL+U (Abandon line), and CTRL+X (DELINE) + ; on return HL points to the location + ; 1 before LINBUF, the line buffer + ; which now contains the line which was input. + ; If ther user pressed CTRL+C the + ; carry flag is set. + + jr c,IMMODE,$0414 ; If the CARRY FLAG is set then the user pressed CTRL+C + ; which has been handled, so we jump back to the start + ; of IMMODE. + + ; fall through to here if CTRL+C was not pressed + ; during line entry. + + rst $10,GETNEXT ; Get next character, which is actually 1st character + ; of the line buffer. + inc a + dec a ; set flags + jr z,IMMODE,$0414 ; If nothing to do, jump back to start of immediate mode + ; and start inputting a new line. + push af ; save character for later. + call STR2VAL,$069c ; attempt to convert the first part + ; of the line to a number + ; on return DE = the number and + ; HL will point to the 1st character + ; after the line number. + push de ; save results for later. + + call $04bc ; + ld b,a + pop de + pop af + rst $30,CALLUDF + defb $03 + + jp nc,$064b + push de + push bc + xor a + ld ($38cc),a + rst $10,GETNEXT ; get next character + or a ; set flags + push af ; save for later. + call FINDLIN,$049f ; Find address in ram of the start + ; of the line number held in DE + jr c,$0448 ; + pop af + push af + jp z,UL_ERROR,$06f3 ; + or a + +l0448: push bc + jr nc,$045b ; (16) + ex de,hl + ld hl,(BASEND) + +; DELLINE: Deletes the BASIC line pointed to by BC +DELLINE: +l044f: ld a,(de) ; + ld (bc),a ; copy (DE) to (BC) + inc bc + inc de + rst $20 ; Until DE point to BASEND. + jr nz,$044f ; + + ld h,b ; and update BASEND + ld l,c + ld (BASEND),hl + +l045b: pop de + pop af + jr z,$0480 ; + ld hl,(BASEND) + ex (sp),hl + pop bc + add hl,bc + push hl + call $0b92 + pop hl + ld (BASEND),hl + ex de,hl + ld (hl),h + pop de + inc hl + inc hl + ld (hl),e + inc hl + ld (hl),d + inc hl + ld de,LINEBUF + +l0479: ld a,(de) + ld (hl),a + inc hl + inc de + or a + jr nz,$0479 ; (-7) + +l0480: rst $30,CALLUDF + defb $04 + call $0bcb + rst $30,CALLUDF + defb $05 + inc hl + ex de,hl + +l0489: ld h,d + ld l,e + ld a,(hl) + inc hl + or (hl) + jp z,IMMODE,$0414 ; top of immediate mode + inc hl + inc hl + inc hl + xor a + +l0495: cp (hl) + inc hl + jr nz,$0495 ; (-4) + ex de,hl + ld (hl),e + inc hl + ld (hl),d + jr $0489 ; (-22) + + +; +; On entry DE contains the line number to find. +; Entering here starts from very start of BASIC program. +FINDLIN: +l049f: ld hl,(BASTART) ; Retrieve address of first line of BASIC. + +; +; On entry DE contains the line number to find. +; Entering here starts from current line. +; +FINDLIN2: +l04a2: ld b,h ; save HL into BC for later. + ld c,l + ld a,(hl) ; load a with (HL) + inc hl ; and then compare it + or (hl) ; with (HL+1) + dec hl ; restore HL to original value. + ret z ; return if (HL) and (HL+1) =00 + + inc hl ; move to next 16 bit address + inc hl ; + ld a,(hl) ; move 16 bit value at (HL) into HL + inc hl + ld h,(hl) + ld l,a + rst $20 ; COMPARE HL,DE + + ld h,b ; Restore original HL + ld l,c + ld a,(hl) ; get 16 bit value at (HL) + inc hl ; into HL + ld h,(hl) ; + ld l,a + ccf ; compliment CF + ret z ; return if DE=HL + ccf ; compliment CF + ret nc ; return if HL>DE + jr FINDLIN2,$04A2 ; loop back again. + +; +; I think this changes TEXT to a keyword value. +; on entry HL points to first character of text. +; +l04bc: xor a ; clear A + ld ($38ac),a ; + ld c,$05 + ld de,LINEBUF + +l04c5: ld a,(hl) ; check current character. + cp $20 ; If it is SPACE + jp z,$053c ; jump forward to $053c + ld b,a ; save A to B + cp $22 ; if it is the " character + jp z,$0558 ; then jump forward to $0558 + or a + jp z,$055e ; is it $00, if so jump to $055e + ld a,($38ac) + or a + ld a,(hl) + jp nz,$053c + cp $3f ; is it '?' + ld a,$95 ; load a with keyword token for 'print' + jp z,$053c ; jump forward + + ld a,(hl) + cp $30 ; '0' + jr c,$04ee ; (5) + cp $3c ; '<' + jp c,$053c + +l04ee: push de + ld de,$0244 + push bc + ld bc,$0536 + push bc + ld b,$7f + ld a,(hl) + cp $61 ; check if A is less than 'a' + jr c,$0505 ; jump to $0505 if it is. + cp $7b ; check if it is >= 'z' + jr nc,$0505 ; jump to $0505 if it is. + + and $5f ; A must be between 'a' and 'z' + ; so convert it to uppercase + ld (hl),a ; and replace it in the line buffer. + +l0505: ld c,(hl) ; move character to C + ex de,hl ; swap DE,HL + +l0507: inc hl ; HL now points to start of keyword table. + or (hl) ; + jp p,$0507 + inc b + ld a,(hl) + and $7f + ret z + + cp c + jr nz,$0507 ; (-13) + ex de,hl + push hl + +l0516: inc de + ld a,(de) + or a + jp m,$0532 + ld c,a + ld a,b + cp $88 + jr nz,$0524 ; (2) + rst $10,GETNEXT + dec hl + +l0524: inc hl + ld a,(hl) ; retrieve cahracter into A + cp $61 ; compare with 'a' + jr c,$052c ; if below 'a' then jump + and $5f ; otherwise and it with $5F to make + ; it upper case by stripping out bit 5 + +l052c: cp c ; + jr z,$0516 ; (-25) + pop hl + jr $0505 ; (-45) + +l0532: ld c,b + pop af + ex de,hl + ret + + rst $30,CALLUDF + defb $0a; + + ex de,hl + ld a,c + pop bc + pop de + +l053c: inc hl ; skip past current handled character. + ld (de),a ; copy current character to program ram. + inc de ; increment program ram counter. + inc c ; inc C + sub $3a ; check if current character is ':' + jr z,$0548 ; if it is jump to $0548 + cp $49 ; + jr nz,$054b ; (3) + +l0548: ld ($38ac),a + +l054b: sub $54 + jp nz,$04c5 + ld b,a + +l0551: ld a,(hl) + or a + jr z,$055e ; (9) + cp b + jr z,$053c ; (-28) + +l0558: inc hl + ld (de),a + inc c + inc de + jr $0551 ; (-13) + +l055e: ld hl,$385f + ld (de),a + inc de + ld (de),a + inc de + ld (de),a + ret + +; Entry point for LLIST command. +ST_LLIST: +l0567: ld a,$01 ; set channel to PRINTER + ld (CHANNEL),a ; the fall through LIST command. + +;Entry point for LIST command. +ST_LIST: +l056c: ld a,$17 ; $17 is the number of lines to print + ; before pausing for a keypress. + ld (ROWCOUNT),a ; set ROWCOUNT to $17 + call STR2VAL,$069c ; convert parameter following LIST + ; to a 16 value in DE + ret nz ; + + pop bc + call FINDLIN,$049f ; Find address of required line in RAM + push bc + +l057a: pop hl ; Restore address. + ld c,(hl) ; Get next two bytes + inc hl ; into BC + ld b,(hl) ; + inc hl ; + ld a,b ; check B and C for $00 + or c ; + jp z,OKMAIN,$0402 ; if BC is $0000 jump to OKMAIN,$0402 + ; which prints OK and enters immediate mode, + ; otherwise carry on. + call CHKKEYP,$1a25 ; read key buffer check for CTRL+C or CTRL+S + ; and handle as appropraite. + push bc ; Save line number + call PRNCRLF,$19ea ; Print CRLF + ld e,(hl) ; get LINE NUMBER into DE + inc hl + ld d,(hl) + inc hl + push hl ; HL now points to the first character after the line number. + ex de,hl ; DE now is address of statement after line number and + ; HL now is the line number. + call $1675 ; Print LINE NUMBER + ld a,$20 + pop hl + +l0597: rst $18 ; print character in A + +; +; Print the character at (HL) or +; expand and print if it is a keyword. +; +PEXPAND: +l0598: ld a,(hl) ; retrieve character to be printed + inc hl ; and point to next location. + or a ; set flags. + jr z,$057a ; if it is $00 jump back to $057a + jp p,$0597 ; Check if byte is 'positive' ie less than $7f + ; to test to see if it is a keyword pointer. + ; if if it is not a keyword, print + ; the character and loop to handle the + ; next character. + rst $30,CALLUDF ; call userdefined function if set. + defb $16 + + ; if it IS a keyword pointer, fall through to here. +l05a2: sub $7F ; Remove marker bit from keyword token. + ld c,a ; and save to C to use as a counter. + ld de,$0245 ; Point to start of keyword table + +l05a8: ld a,(de) ; Enter the loop to scan for 1st byte of keyword + inc de ; preload address of next character. + or a ; set flags + jp p,$05a8 ; if bit 7 not set, loop back. When we encounter + ; a byte with bit 7 set, we know we are at the next + ; keyword in the table, or then end marker. + dec c ; Decrement Key Word counter. + jr nz,$05a8 ; Keep looping till we get the correct keyword. + + ; when we get this far we know we are pointing at the + ; first character of the required keyword. +l05b1: and $7f ; remove marker bit from character, + rst $18 ; print current character of keyword. + ld a,(de) ; get next byte of keyword + inc de ; preload address of next character. + or a ; Set flags + jp p,$05b1 ; loop to print next charater, or + ; if byte is NEG then we are done. + + jr $0598 ; Done expanding the keyword, continue printing data. + +; Entry point for FOR command. +ST_FOR: +l05bc: ld a,$64 + ld ($38cb),a + call $0731 + pop bc + push hl + call $071c + ld ($38c7),hl + ld hl,$0002 + add hl,sp + +l05d0: call $03a3 + jr nz,$05e9 ; (20) + add hl,bc + push de + dec hl + ld d,(hl) + dec hl + ld e,(hl) + inc hl + inc hl + push hl + ld hl,($38c7) + rst $20 ; COMPARE HL,DE + pop hl + pop de + jr nz,$05d0 ; (-22) + pop de + ld sp,hl + inc c + +l05e9: pop de + ex de,hl + ld c,$08 + call $0ba0,CHK_STKSPC ;check stack space + push hl + ld hl,($38c7) + ex (sp),hl + push hl + ld hl,(CURLIN) + ex (sp),hl + call $0975 + rst $8,CHKNEXT + defb $a1 + + call $0972 + push hl + call $152e ; BCDEFP + pop hl + push bc + push de + ld bc,$8100 + ld d,c + ld e,d + ld a,(hl) + cp $a7 + ld a,$01 + jr nz,$061f ; (10) + rst $10,GETNEXT + call $0972 + push hl + call $152e ; BCDEFP + rst $28 ; TSTSGN + pop hl + +l061f: push bc + push de + push af + inc sp + push hl + ld hl,(TMPSTAT) ; preload address of next statment as + ex (sp),hl ; return address on stack. + +l0628: ld b,$81 + push bc + inc sp + +l062c: ld (TMPSTAT),hl ; save address of next statment + call $1fc2 + ld a,(hl) + cp $3a ; Check for the ":" character. + jr z,$064b ; If found jump to $064b. + or a ; otherwise, set flags + jp nz,ERROR_SN,$03c4 ; and report a syntax error if we + ; are not at the end of the line. + + inc hl ; Retrieve next two characters. + ld a,(hl) ; + inc hl ; + or (hl) ; And check if they are both $00 + jp z,$0c29 ; if so jump to $0c29 + inc hl + ld e,(hl) + inc hl + ld d,(hl) + ex de,hl + ld (CURLIN),hl + ex de,hl +; +; Execute each statement in turn by jumping here. +; This routine will look up the address of the statment +; by multiplying converting the command byte into +; an offset into the jump table. +; The it pushes the address held in that location in the +; jump table to the stack as a return address. +; It then checks the next character before calling the function. +; If there are more parameters the CF will be set. +NEXTSTMT: +l064b: rst $10,GETNEXT ; get next character. + ld de,$062c ; push return address to stack + push de ; + +l0650: ret z ; Return if nothing to do. + +l0651: sub $80 ; subtract $80 from command byte + ; to form a command index into the jump table. + jp c,$0731 ; if command byte < $80 then jump to $0731 + cp $20 ; is it a space? + rst $30,CALLUDF ; Call UDF + defb %17 ; + + jp nc,ERROR_SN,$03c4 ; If the command byte is not valid after + ; all the above checks we exit via a SN error. + + rlca ; multiply index by 2 as each entry in the jump + ; table is 16 bits. + ld c,a ; and add the resultant offset to the + ld b,$00 ; address of the start of the jump table. + ex de,hl ; save HL for later. + ld hl,$01d5 ; Preload JUMP TABLE start address, + add hl,bc ; add the offset. + ld c,(hl) ; and move low byte to C + inc hl ; + ld b,(hl) ; and high byte to B + push bc ; and push it to the stack as the return address. + ex de,hl ; restore character pointer to HL +; +; Get next character from the string +; +NEXTCHR: +l066b: inc hl + ld a,(hl) + cp $3a ; Is it (':') ? + ret nc ; If it is ":" then there is no more data + ; so RET effectively calling the routine + ; whose address was pushed to the stack. + ; if not ":" then remove skip whitespace + ; and then call the routine with CF set + ; to signal that there is data following the + ; command. +; +; On entry to this routine, A holds an ASCII code. +; Also called from RST10 GETNEXT, to fetch the next character in the string. +; +l0670: cp $20 ; is it a SPACE + jr z,$066b ; if so, jump to 066b, NEXTCHR:, + ; to skip whitespace. + + cp $30 ; is it between '0' and '9' + ccf ; compliment carry flag + inc a ; + dec a ; set other flags. + ret ; + +l067a: rst $10,GETNEXT + +l067b: call $0972 ; + +l067e: rst $28 ; TSTSGN + jp m,ERROR_FC,$0697 ; Jump if negative + +l0682: ld a,($38e7) ; + cp $90 ; + jp c,$1586 ; if it's less than $90 jump ~~~ ; FPINT + ld bc,$9080 ; + ld de,$0000 ; + push hl ; + call $155b ; CMPNUM + pop hl ; + ld d,c ; + ret z ; + +ERROR_FC: +l0697: ld e,$08 ; 08 is the offset of FC in the error table. + jp ERROR,$03db ; report an FC error. +; +; STR2VAL converts the string pointed to by HL +; into a decimal equivalent stored in DE +; for example, if the string pointed to by HL is +; "2345" then DE would become 2345(dec) = $0929 +; interestingly the maximum number that can be held is +; 65529(dec). +; +; This routine works by first multiplying DE by 10 +; then adding VAL(A) and looping again until all the +; characters have been read. +; +STR2VAL: +l069c: dec hl + +l069d: ld de,$0000 ; we start with 00 + +l06a0: rst $10,GETNEXT ; get next character + ret nc ; return if it is not between '0' and '9' + ; fall through if it is. + push hl + push af + ld hl,$1998 ; compare with 6552 before starting. + rst $20 ; COMPARE HL,DE + jr c,$06bb ; if DE is greater, + ; jump to 06bb to restore registers + ; and flags and return. + + ld h,d ; These 6 lines multiply DE by ten and + ld l,e ; store the result in HL. + add hl,de ; HL now equals 2 x DE + add hl,hl ; HL now equal2 4 x DE + add hl,de ; HL now equals 5 x DE + add hl,hl ; HL now equals 10 x DE + + pop af ; retsore AF + sub $30 ; convert ASCII to byte. ie '1' = $01 + ld e,a ; move to DE + ld d,$00 ; DE now equals VAL(A) where '0' <= a <= '9' + add hl,de ; hl = (10 x DE)+VAL(A) + ex de,hl ; put HL back into DE + pop hl ; restore HL + jr $06a0 ; and do it again! + +l06bb: pop af + pop hl + ret + +; +; Entry point for RUN command. +; +ST_RUN: +l06be: rst $30,CALLUDF + defb $18 + jp z,$0bcb + call $0bcf + ld bc,$062c + jr $06db ; + +; Entry point for GOSUB routine. +ST_GOSUB: +l06cb: ld c,$03 + call $0ba0,CHK_STKSPC ;check stack space + pop bc + push hl + push hl + ld hl,(CURLIN) + ex (sp),hl ; save CURLIN to stack for the return address. + ld a,$8c ; command byte for GOSUB + push af ; push onto stack. + inc sp ; + +l06db: push bc ; restore previous stack top + ; and fall through to GOTO +; +; Entry point for GOTO command. +; +ST_GOTO: +l06dc: call STR2VAL,$069c ; convert the line number, held as text + ; to a 16 bit value in DE. + call FIND_BC,$071e ; Find BC in memory (swaps B and C first + ; to allow for LSB first order of the Z80) + inc hl ; move HL to point to next statment. + push hl ; and save address for later. + ld hl,(CURLIN) ; retrieve CURRENT line number temporarily + rst $20,CMPHLDE ; Compare current line number + ; with the line number after GOTO statement. + + pop hl ; retrieve next statment address. + + ; If GOTO line number is > current line number + ; we will search FORWARD through ram to + call c,FINDLIN2,$04A2 ; locate the line number held in DE + ; and make HL point to it. + call nc,FINDLIN,$049f ; otherwise we will search from start of program ram + ; to find the correct line number. + ; On return BC points to the line number in ram. + ld h,b ; Move new LINE NUMBER address to HL + ld l,c ; + dec hl ; allow for auto INC + ret c ; return to jump to that line. + +UL_ERROR: ; Otherwise fall through to report a UL Error. +l06f3: ld e,$0e ; Offset for 'UL' error. (Undefined line) + jp ERROR,$03db + +;Entry point for RETURN +ST_RETURN: +l06f8: ret nz ; if nothing follow the RETURN statement then + ; a simple return will cause the interpreter to + ; report a SN error. + + ld d,$ff ; + call $039f + ld sp,hl + cp $8c + ld e,$04 ; report a 'Return with Gosub' error + jp nz,ERROR,$03db ; if A <> $8C + pop hl + ld (CURLIN),hl + inc hl + ld a,h + or l + jr nz,$0716 ; (7) + ld a,($38cc) + or a + jp nz,OKMAIN2,$0401 ; Print OK and return to immediate mode. + +l0716: ld hl,$062c + ex (sp),hl + ld a,$e1 + +************************* +*** OVERLAPPING CODE HERE +*** Either the disassembly corupted the byte at 071c +*** or there is a genuine bug in the ROM +************************* +*** Existing code was: + +l071c: ld bc,0e3a ; NOTE: This is a hang-over from old code + nop ; as BC get overwritten in the next instructions + ; what happens is that a DATA statement + ; is treated exactly like a REM statement. + +; FIND BC +; (Also used as entry point for REM command.) +; Will search through memory until it has found a byte the same as C +; and a byte the same a B somewhere after it. +FIND_BC: +ST_REM: +l071e: ld c,$00 ; initialise B and C to $0000 +l0720: ld b,$00 + +SWAP_BC: +l0722: ld a,c ; Swap B and C + ld c,b ; so, for example if BC was $0405 + ld b,a ; it would now be $0504 + +l0725: ld a,(hl) ; overwrite A with (HL) + or a ; set flag + ret z ; return if A=00 + + cp b ; compare A with B + ret z ; return if both the same. + inc hl ; increment HL + cp $22 ; If we found B we now llok for C + jr z,$0722 ; so jump to SWAP_BC to swap BC round. + jr $0725 ; then continue. +; +; entry point for LET statement. +; +ST_LET: +l0731: call $10d1 + rst $8 + defb $b0 ; ensure an = sign follws variable name. + + push de + ld a,($38ab) + push af + call $0985 + pop af + ex (sp),hl + ld (TMPSTAT),hl ; save address of next statment + rra + call $0977 + jp z,$0779 + +l074a: push hl + ld hl,($38e4) + push hl + inc hl + inc hl + ld e,(hl) + inc hl + ld d,(hl) + ld hl,(BASTART) ; retrieve address of first line of BASIC + rst $20 ; COMPARE HL,DE + jr nc,$0768 ; (14) + ld hl,($38da) + rst $20 ; COMPARE HL,DE + pop de + jr nc,$0770 ; (15) + ld hl,$38bd + rst $20 ; COMPARE HL,DE + jr nc,$0770 ; (9) + ld a,$d1 + call $0fe4 + ex de,hl + call $0e39 + +l0770: call $0fe4 + pop hl + call $153d + pop hl + ret + +l0779: push hl + call $153a + pop de + pop hl + ret + +; Entry point for ON command +ST_ON: +L0780: rst $30,CALLUDF + defb $19 + + call $0b54 + ld a,(hl) + ld b,a + cp $8c + jr z,$078e ; (3) + rst $8,CHKNEXT ; compare (HL) with $88 + defb $88 + + dec hl +l078e: ld c,e + +l078f: dec c + ld a,b + jp z,$0651 + call $069d + cp $2c + ret nz + jr $078f ; (-13) + +;Entry point for IF statement. +ST_IF: +l079c: call $0985 + ld a,(hl) ; + cp $88 ; is next command 'Goto' + jr z,$07a7 ; then jump forward. + rst $8,CHKNEXT ; compare (HL) with $A5 (The defb) + defb $a5 ; make sure next command is 'THEN'? + + dec hl + +l07a7: call $0975 + rst $28 ; TSTSGN + jp z,FIND_BC,$071e ; find BC in memory. + rst $10,GETNEXT + jp c,$06dc + jp $0650 + +;Entry point for LPRINT command. +ST_LPRINT: +l07b5: ld a,$01 ; set channel to 01-Printer + ld (CHANNEL),a + +l07ba: dec hl + rst $10,GETNEXT ;GETNEXT + +;Entry point for PRINT command. +ST_PRINT: +l07bc: rst $30,CALLUDF ; call the UDF + defb %06 + + call z,PRNCRLF,$19ea ; If there are no parameters + ; following the Print statement +PRT_CONT: ; then print CRLF +l07c1: jp z,PRINT_END,$0866 ; and we done printing. + + ; The character immediately following + ; the print statement is in A + ; at this point. + cp $a0 ; is it 160? + jp z,$083a ; if so jump to $083a + + cp $a3 ; is it 163 (# Keyword) + jp z,$083a ; if so jump to $083a + + push hl + cp $2c ; is it ',' + jr z,$0817 ; if so jump to $0817, PRTCOMMA + + cp $3b ; Is it ';' + jp z,$0861 ; if so jump to $0861 + + pop bc ; restore character pointer to BC + call $0985 + push hl + ld a,($38ab) + or a + jp nz,$0811 + call $1680 + call $0e5f + ld (hl),$20 + ld hl,($38e4) + ld a,(CHANNEL) + or a + jr z,$07fd ; (8) + ld a,(PRNCOL,$3846) ; get current printer column. + add a,(hl) ; add (HL) + cp $84 ; is it 132? + jr $080a ; + +l07fd: ld a,($3848) + ld b,a + inc a + jr z,$080d ; (9) + ld a,(CURCOL) ; see note about cursor position. + add a,(hl) + dec a + cp b + +l080a: call nc,PRNCRLF,$19ea ; Reset print head to start of next line. + +l080d: call $0ea0 + xor a + +l0811: call nz,$0ea0 + pop hl + jr $07ba ; (-93) + +; Print a , operator to current stream. +PRTCOMMA: +l0817: ld a,(CHANNEL) + or a + jr z,$0825 ; + ld a,(PRNCOL,$3846) ; get current printer column + cp $70 ; compare with 112 to set CF? + jp $082d ; jump forward to 082d + +l0825: ld a,($3849) + ld b,a + ld a,(CURCOL) + cp b + +l082d: call nc,PRNCRLF,$19ea + jp nc,$0861 + +l0833: sub $0e + jr nc,$0833 ; (-4) + cpl + jr $085a ; (32) + +l083a: push af + call $0b53 + rst $8,CHKNEXT + defb $29 ; check for a ')' and stop via syntax error + ; if it is missing. + dec hl + pop af + sub $a3 + push hl + jr z,$0856 ; (15) + ld a,(CHANNEL) + or a + jp z,$0853 ; + ld a,(PRNCOL,$3846) ; get current printhead column. + jr $0856 ; + +l0853: ld a,(CURCOL) + +l0856: cpl + add a,e + jr nc,$0861 ; (7) + +l085a: inc a + ld b,a + ld a,$20 ; load A with SPACE + +l085e: rst $18 ; print B spaces. + djnz $085e ; loop till B = 00 + +l0861: pop hl ; restore character pointer. + rst $10,GETNEXT ; retrieve next character + jp PRT_CONT,$07c1 ; and continue printing. + +PRINT_END: +l0866: rst $30,CALLUDF + defb $07 + + xor a + ld (CHANNEL),a + ret + +L086D: defb '?Redo from start',0d,0a,00 + +l0880: rst $30,CALLUDF + defb $08 + + ld a,($38cd) + or a + jp nz,$03be + pop bc + ld hl,$086d ; '?Redo from start' +CR + LF + call 0e9d,PRINTSTR + jp $0c01 + +; +; ST_INPUT: entry point for INPUT statement +; +ST_INPUT: +l0893: rst $30,CALLUDF + defb $1a + + call $0b45 + ld a,(hl) + cp $22 + ld a,$00 + jp nz,$08aa + call $0e60 + rst $8,CHKNEXT + dec sp + push hl + call $0ea0 + ld a,$e5 + call $0d5b + pop bc + jp c,$0c26 + inc hl + ld a,(hl) + or a + dec hl + push bc + jp z,$071b + ld (hl),$2c + jr $08c3 ; (5) + +;Entry point for READ command. +ST_READ: +l08be: push hl + ld hl,(RESTORE) ; Address of line last RESTORE'd or + ; first line of BASIC if no data ever READ + ; or RESTORE'd + or $af + ld ($38cd),a + ex (sp),hl + ld bc,$2ccf + call $10d1 + ex (sp),hl + push de + ld a,(hl) + cp $2c + jr z,$08f0 ; (27) + ld a,($38cd) + or a + jp nz,$0953 + ld a,$3f + rst $18 ; print character in A + call $0d5b + pop de + pop bc + jp c,$0c26 + inc hl + ld a,(hl) + dec hl + or a + push bc + +l08ec: jp z,$071b + push de + +l08f0: rst $30,CALLUDF + defb $1c + + ld a,($38ab) + or a + jr z,$0917 ; (31) + rst $10,GETNEXT + ld d,a + ld b,a + cp $22 + jr z,$090b ; (12) + ld a,($38cd) + or a + ld d,a + jr z,$0908 ; (2) + ld d,$3a ; ':' + +l0908: ld b,$2c ; ',' + dec hl + +l090b: call $0e63 + ex de,hl + ld hl,$0920 + ex (sp),hl + push de + jp $074a + +l0917: rst $10,GETNEXT + call $15e5 ; ASCTFP + ex (sp),hl + call $153a + pop hl + dec hl + rst $10,GETNEXT + jr z,$0929 ; (5) + cp $2c + jp nz,$0880 + +l0929: ex (sp),hl + dec hl + rst $10,GETNEXT + jp nz,$08c9 + pop de + ld a,($38cd) + or a + ex de,hl + jp nz,$0c1a + push de + or (hl) + ld hl,$0942 ; '?Extra ignored' +CR+LF + call nz,PRINTSTR + pop hl + ret + +l0942: defb '?Extra Ignored',0d,0a,00 + +l0953: call $071c ; + or a + jr nz,$096a ; (17) + inc hl + ld a,(hl) + inc hl + or (hl) + ld e,$06 ; Offset for 'Out of data' error + jp z,ERROR,$03db ; report 'OD Error' + inc hl + ld e,(hl) + inc hl + ld d,(hl) + ld ($38c9),de + +l096a: rst $10,GETNEXT + cp $83 + jr nz,$0953 ; (-28) + jp $08f0 + +l0972: call $0985 + +l0975: or $37 ; or A with $37 + +l0977: ld a,($38ab) + adc a,a + or a + ret pe + jp $03d9 + rst $8,CHKNEXT + or b + ld bc,$28cf + +l0985: dec hl ; HL now points to the character immediately + ; after 'PRINT' + ld d,$00 + +l0988: push de + ld c,$01 + call $0ba0,CHK_STKSPC ;check stack space + call $09fd + ld ($38d0),hl + +l0994: ld hl,($38d0) + pop bc + ld a,b + cp $78 ; + call nc,$0975 ; + ld a,(hl) + ld ($38c3),hl + cp $a8 ; + ret c + + cp $b2 ; + ret nc ; + + cp $af + jp nc,$09e2 + + sub $a8 + ld e,a + jr nz,$09ba ; (8) + ld a,($38ab) + dec a + ld a,e + jp z,$0f7c + +l09ba: rlca + add a,e + ld e,a + ld hl,$034c + ld d,$00 + add hl,de + ld a,b + ld d,(hl) + cp d + ret nc + inc hl + call $0975 + +l09cb: push bc + ld bc,$0994 + push bc + ld b,e + ld c,d + call $1513 ; STAKFP + ld e,b + ld d,c + ld c,(hl) + inc hl + ld b,(hl) + inc hl + push bc + ld hl,($38c3) + jp $0988 + +l09e2: ld d,$00 + +l09e4: sub $af + jp c,$0ad0 + cp $03 + jp nc,$0ad0 + cp $01 + rla + xor d + cp d + ld d,a + jp c,ERROR_SN,$03c4 + ld ($38c3),hl + rst $10,GETNEXT + jr $09e4 ; (-25) + +l09fd: rst $30,CALLUDF + defb $09 + + xor a + ld ($38ab),a + rst $10,GETNEXT ; get next character (at HL+1) + jp z,$03d6 ; if character is 00, jump back + jp c,$15e5 ; if character is 0-9jump forward to ASCTFP + call IsAtoZ,$0cc6 + jp nc,$0a4e + cp $a8 + jr z,$09fd ; (-23) + cp $2e + jp z,$15e5 ; ASCTFP + cp $a9 + jp z,$0a3d + cp $22 + jp z,$0e60 + cp $a6 + jp z,$0b05 + cp $a4 + jp z,$19fb + cp $a2 + jp z,$0b40 + sub $b2 + jp nc,$0a5f + +l0a37: call $0983 + rst $8,CHKNEXT + add hl,hl + ret + +l0a3d: ld d,$7d + call $0988 + ld hl,($38d0) + push hl + call $150b + call $0975 + pop hl + ret + +l0a4e: call $10d1 + push hl + ex de,hl + ld ($38e4),hl + ld a,($38ab) + or a + call z,$1520 ; PHLTFP + pop hl + ret + +l0a5f: rst $30,CALLUDF + defb $1b + cp $18 ; CTRL+X or 24 + jp z,$1a68 + ld b,$00 + rlca + ld c,a + push bc + rst $10,GETNEXT + ld a,c + cp $29 + jr c,$0a87 ; (22) + call $0983 + rst $8,CHKNEXT + inc l + call $0976 + ex de,hl + ld hl,($38e4) + ex (sp),hl + push hl + ex de,hl + call $0b54 + ex de,hl + ex (sp),hl + jr $0a8f ; (8) + +l0a87: call $0a37 + ex (sp),hl + ld de,$0a49 + push de + +l0a8f: ld bc,$0215 + add hl,bc + ld c,(hl) + inc hl + ld h,(hl) + ld l,c + jp (hl) + +l0a98: dec d + cp $a9 + ret z + cp $2d + ret z + inc d + cp $2b + ret z + cp $a8 + ret z + dec hl + ret + or $af + push af + call $0975 + call $0682 + pop af + ex de,hl + pop bc + ex (sp),hl + ex de,hl + call $1523 ; FPBCDE + push af + call $0682 + pop af + pop bc + ld a,c + ld hl,$0b21 + jp nz,$0acb + and e + ld c,a + ld a,b + and d + jp (hl) + +l0acb: or e + ld c,a + ld a,b + or d + jp (hl) + +l0ad0: ld hl,$0ae2 + ld a,($38ab) + rra + ld a,d + rla + ld e,a + ld d,$64 + ld a,b + cp d + ret nc + jp $09cb + call po,$790a + or a + rra + pop bc + pop de + push af + call $0977 + ld hl,$0afb + push hl + jp z,$155b ; CMPNUM + xor a + ld ($38ab),a + jp $0dfc + inc a + adc a,a + pop bc + and b + add a,$ff + sbc a,a + jp $14f6 ; FLGREL + +l0b05: ld d,$5a + call $0988 + call $0975 + call $0682 + ld a,e + cpl + ld c,a + ld a,d + cpl + call $0b21 + pop bc + jp $0994 + +l0b1c: ld a,l + sub e + ld c,a + ld a,h + sbc a,d + +l0b21: ld b,c + +l0b22: ld d,b ; move B to D + +l0b23: ld e,$00 ; make E = $00 + ld hl,$38ab + ld (hl),e + ld b,$90 + jp $14fb + +; Entry point for LPOS function +ST_LPOS: +l0b2e: ld a,(PRNCOL,$3846) ; Retrieve current PRINT HEAD column + jr $0b36 + +; Entry point for POS function +ST_POS: +l0B33: ld a,(CURCOL) ; retrieve current SCREEN CURSOR column. + +l0b36: ld b,a ; save position to B + xor a ; clear out A + jp $0b22 ; jump to $0b22 + +;ST_DEF entry point for DEF statement. +ST_DEF: +l0b3b: rst $30,CALLUDF + defb $0f + + jp ERROR_SN,$03c4 + +l0b40: rst $30,CALLUDF + defb $10 + jp ERROR_SN,$03c4 + + push hl + ld hl,(CURLIN) + inc hl + ld a,h + or l + pop hl + ret nz + ld e,$16 + jp ERROR,$03db + +l0b53: rst $10,GETNEXT + +l0b54: call $0972 + +l0b57: call $067e + ld a,d + or a ; set flags. + jp nz,ERROR_FC,$0697 ; report an FC error if D <> 0 + dec hl + rst $10,GETNEXT + ld a,e + ret + +; Entry point for PEEK function +ST_PEEK call $0682 ; get value into DE + call CKSYSAD,$0b88 ; check that DE is above system rom/ram + ; otherwise report an FC error. + ld a,(de) ; the actual PEEK happening. + jp $0b36 + +;ST_POKE entry point for POKE command. +ST_POKE: +l0b6d: call $0972 + call $0682 + call CKSYSAD,$0b88 ; check that DE is above system rom/ram + ; otherwise report an FC error. + push de + rst $8,CHKNEXT + defb $2c ; ensure a "," follows, otherwise report + ; a SN Error. + + call $0b54 + pop de + ld (de),a ; the actual POKE happening. + ret + +l0b7f: call $0985 + push hl + call $0682 + pop hl + ret +; +; Check DE is above system ROM/RAM +; The user is not allowed to PEEK/POKE into system ram/rom. +; CKSYSAD +CKSYSAD: +l0b88: push hl ; save HL + ld hl,$2fff ; HL=start of user ram. (incl screen ram) + rst $20 ; COMPARE HL,DE ; COMPARE HL,DE + pop hl ; restore HL + jp nc,ERROR_FC,$0697 ; DE is less than 2fff we report an FC error. + ret ; otherwise we return. + +l0b92: call $0ba9 + +l0b95: push bc + ex (sp),hl + pop bc + +l0b98: rst $20 ; COMPARE HL,DE + ld a,(hl) + ld (bc),a + ret z + dec bc + dec hl + jr $0b98 ; (-8) + +CHK_STKSPC +l0ba0,CHK_STKSPC ;check stack space: push hl ; save HL for later. + ld hl,($38da) ; + ld b,$00 ; + add hl,bc + add hl,bc + ld a,$e5 + ld a,$d0 + sub l + ld l,a + ld a,$ff + sbc a,h + ld h,a + jr c,OM_ERROR,$0bb7 ; (3) + add hl,sp + pop hl + ret c +; +; OM_ERROR: Reports an OUT of memory error and falls out to Immediate mode. +; +OM_ERROR: +l0bb7: ld de,$000c ; Load E with the code for an OM error + jp ERROR,$03db ; and report OUT OF MEMORY! + +; Entry point for NEW command. +ST_NEW: +l0bbd: ret nz ; if there are parameters after NEW we return + ; and this will cause a SYNTAX error + ; when the interpreter reaches the addittional + ; parameters. + +ST_NEW2: +l0bbe: rst $30,CALLUDF ; call the UDF, if installed, with parameter $0b + defb $0b + + ld hl,(BASTART) ; retrieve address of first line of BASIC + xor a ; clear A + ld (hl),a ; save $0000 to (BASTART) + inc hl ; + ld (hl),a ; + inc hl ; + ld (BASEND),hl ; save $0000 to (BASEND) + +l0bcb: ld hl,(BASTART) + dec hl + +l0bcf: ld (TMPSTAT),hl ; Set address of next statment + ld hl,(RAMTOP) + ld ($38c1),hl + xor a + call ST_RESTORE,$0c05 ; issue a RESTORE statement to clear + ; the RESTORE pointer. + ld hl,(BASEND) + ld ($38d8),hl + ld ($38da),hl + +CLRWKSP: +l0be5: pop bc ; Retrieve current return address. + ld hl,($384b) ; Retrieve alternative return address. + ld sp,hl ; preload the previous return address. In effect + ; this ensures that this routine will return to where + ; it was called from, but the previous routine + ; will return to ($384b). + + call $1fd8 ; Store address of the instruction which + ; caused the error and preload HL with $38b1 + + ld ($38af),hl ; move $38b1 to ($38af) + call PRNHOME,$19be ; if we were printing to printer, LPRINT a CR and LF + + xor a ; Reset some system variables. + ld l,a ; + ld h,a ; + ld (CONTPOS),hl ; The CONTinue position is set to $0000 + ld ($38cb),a ; + ld ($38de),hl ; + push hl ; + push bc ; + +l0c01: ld hl,(TMPSTAT) ; and return to carry on at next statement. + ret ; + +; +; Entry point for RESTORE statement. +; +ST_RESTORE +l0c05: ex de,hl ; save HL for later. + ld hl,(BASTART) ; retrieve address of first line of basic. + jr z,$0c19 ; if no parameters follow RESTORE jump to $0c19 + ex de,hl ; swap NEXTCHAR and BASTART + call STR2VAL,$069c ; convert figure after RESTORE statement + ; to a value in BC + push hl ; save HL for later. + call FINDLIN,$049f ; locate required line in ram. + ld h,b ; and save its address to HL + ld l,c + pop de ; restore original NEXTCHAR to HL + jp nc,UL_ERROR,$06f3 ; report a UL error if line not found. + +l0c19: dec hl ; + +l0c1a: ld (RESTORE),hl ; save address of RESTORE'd line to RESTORE + ex de,hl + ret + +;Entry point for STOP statement +ST_STOP: +l0c1f: ret nz ; if there is anything after the stop + ; statement we simply return causing + ; a SN error to be reported. + +l0c20: or $c0 ; + +; +; Enter at ST_END for an END statement. +; +ST_END: +l0c21: ld (TMPSTAT),hl + ld hl,$fff6 + pop bc + +l0c29: ld hl,(CURLIN) + push af ; save AF + ld a,l ; restore Current line number to A + and h ; + inc a ; check if it is $FFFF ie. Immediate mode. + jr z,STATEND,$0c3b ; if so jump to STATEND. + + ld ($38d2),hl ; Otherwise save current line number. + ld hl,(TMPSTAT) ; and current statment address. + ld (CONTPOS),hl ; Save the address of the command we STOPped at. +; +; A clean end to statement execution. +; Print either "Ok" or 'Break' and OK depending on how +; we got here. +; +STATEND: +l0c3b: call PRNHOME,$19be ; if we were printing to printer, + ; LPRINT a CR and LF. + call RSTCOL,$19de ; reset cursor to start of next line, + ; if not already at start of line. + pop af + ld hl,$0373 ; Point to 'Break' + jp nz,$03f4 ; if not in IMMODE then report the line + ; number in the break message. + jp OKMAIN,$0402 ; Otherwise just print 'Ok' and + ; enter immediate mode. + +; Entry point for CONT statement +ST_CONT: +l0c4b: ld hl,(CONTPOS) ; Retrieve position of the command + ; we STOPed at. + ld a,h ; and check if it is valid + or l ; If it is 0000 we report a + ; Cant Continue Error. + ld de,$0020 ; Offset for 'CN' error code. + jp z,ERROR,$03db ; report the 'Cant continue' error. + + ld de,($38d2) ; + ld (CURLIN),de + ret + + jp ERROR_FC,$0697 ; report an FC error. + +l0c62: ld a,$af + +; Entry point for CLOAD* statement. +ST_CLOAD* +l0c63: xor a ; clear A + or a ; set flags. + push af ; save AF. + rst $10,GETNEXT ; + ld a,$01 ; + ld ($38cb),a + call $10d1 ; + jp nz,ERROR_FC,$0697 ; report an FC Error + ld ($38cb),a + call $0975 + pop af + push hl + push af + push bc + ld b,$23 ; + jr z,$0c92 ; + call RECMSG,$1b7f ; display 'Press ' etc + ; and wait for the RTN key to be pressed. + call SAVESYNC,$1bbc ; Save sync signal to tape. + + ld a,b ; move byte in B into A + call TAPEBYTE2,$1b87 ; save byte in A to tape TWICE + call TAPEBYTE2,$1b87 ; save byte in A to tape TWICE + call TAPEBYTE2,$1b87 ; save byte in A to tape TWICE + jr $0ca3 ; + +l0c92: call TAPELD1,$1b2e ; display the 'Press ' message + ; and wait for CR + call BYTEREAD,$1bce ; read SYNC signal from tape. + +l0c98: ld c,$06 + +l0c9a: call BYTEREAD2,$1b4d + cp b + jr nz,$0c98 ; (-8) + dec c + jr nz,$0c9a ; (-9) + +l0ca3: pop hl + ex de,hl + add hl,de + ex de,hl + ld c,(hl) + ld b,$00 + add hl,bc + add hl,bc + inc hl + +l0cad: rst $20 ; COMPARE HL,DE + jr z,$0cbd ; (13) + pop af + push af + ld a,(hl) + call nz,TAPEBYTE,$1b8a + call z,BYTEREAD2,$1b4d + ld (hl),a + inc hl + jr $0cad ; (-16) + +l0cbd: pop af + jp nz,$1c1c + pop hl + jp $1b7e + +; Retrieve current character pointed to by HL... +RIsAtoZ +l0cc5: ld a,(hl) ; retrieve current character. + +; ...and check if it is between A and Z +IsAtoZ: +l0cc6: cp $41 ; compare current character with 'A' + ret c ; Return with CF set if LESS than 'A' + cp $5b ; Compare with '[' which is one more than 'Z' + ccf ; clear carry flag + ret ; and return + +; Entry point for CLEAR command. +ST_CLEAR +l0ccd: rst $30,CALLUDF + defb $0b + + jp z,$0bcf + call $067b + dec hl + rst $10,GETNEXT + + push hl + ld hl,(RAMTOP) + jr z,$0ceb ; (14) + pop hl + rst $8,CHKNEXT + defb $2c ; check for a ',' and stop via + ; syntax error if it is missing. + + push de + call $067b + dec hl + rst $10,GETNEXT + jp nz,ERROR_SN,$03c4 + ex (sp),hl + ex de,hl + +l0ceb: ld a,l + sub e + ld e,a + ld a,h + sbc a,d + ld d,a + jp c,OM_ERROR,$0bb7 + push hl + ld hl,(BASEND) + ld bc,$0028 + add hl,bc + rst $20 ; COMPARE HL,DE + jp nc,OM_ERROR,$0bb7 ; report OUT OF MEMORY if + ex de,hl + ld ($384b),hl + pop hl + ld (RAMTOP),hl + pop hl + jp $0bcf + ld a,l + sub e + ld e,a + ld a,h + sbc a,d + ld d,a + ret + +; Entry point for the 'NEXT' statement. +ST_NEXT +l0d13: ld de,$0000 + +l0d16: call nz,$10d1 + ld (TMPSTAT),hl + call $039f + jp nz,$03ca + ld sp,hl + push de + ld a,(hl) + push af + inc hl + push de + call $1520 ; PHLTFP + ex (sp),hl + push hl + call $1253 + pop hl + call $153a + pop hl + call $1531 ; LOADFP + push hl + call $155b ; CMPNUM + pop hl + pop bc + sub b + call $1531 ; LOADFP + jr z,$0d4d ; (9) + ex de,hl + ld (CURLIN),hl + ld l,c + ld h,b + jp $0628 + + +l0d4d: ld sp,hl + ld hl,(TMPSTAT) + ld a,(hl) + cp $2c + jp nz,$062c + rst $10,GETNEXT + call $0d16 + +l0d5b: ld a,$3f ; The '?' character + rst $18 ; print character in A + ld a,$20 ; The SPACE character + rst $18 ; print character in A + jp GETLINE,$0d85 + +; Jump here if a keyword was pressed during immediate mode +; +l0d64: ld a,($384a) + or a + ld a,$5c ; + ld ($384a),a ; + jr nz,$0d74 ; (5) + dec b + jr z,GETLINE,$0d85 ; Reset line buffer and start collecting a new line. + rst $18 ; Print character in A + inc b + +l0d74: dec b + dec hl + jr z,$0d81 ; (9) + ld a,(hl) + rst $18 ; print character in A + jr $0d8e ; (18) + +l0d7c: dec b + dec hl + rst $18 ; print character in A + jr nz,$0d8e ; (13) + +l0d81: rst $18 ; print character in A + +l0d82: call PRNCRLF,$19ea + +; +; GETLINE +; Reset the INPUT LINE BUFFER and start collecting a line. +; +GETLINE: +l0d85: ld hl,LINEBUF ; Start of LINE INPUT BUFFER + ld b,$01 ; initialise line length counter to 1 + xor a ; clear A + ld ($384a),a ; set ($384a) to $00 + +l0d8e: call CLRKEYWT,$19da ; clear keyboard buffer and wait for a keypress. + ; on return A = key pressed. + ld c,a ; save key for later + cp $7f ; was key pressed $7F? + jr z,$0d64 ; if so, jump to $0d64 + ; otherwise carry on. + ld a,($384a) ; + or a + jr z,$0da3 ; is A $00? Then jump to 0da3. + ld a,$5c ; Otherwise load A with '\' character + rst $18 ; print character in A + xor a + ld ($384a),a + +l0da3: ld a,c ; restore character to A + cp $07 ; Is it a BEEP chr? + jr z,$0de9 ; if so jump to $0de9 + cp $03 ; is it CTRL+C + call z,PRNCRLF,$19ea ; if so reset cursor to start of next line, + scf ; set the carry flag + ret z ; and return. + ; Otherwise, we carry on through. + cp $0d ; is it CR + jp z,LIENDONE,$19e5 ; if so jump to LIENDONE,$19e5 + cp $15 ; is it CTRL+U key? (Abandon line) + jp z,$0d82 ; if so, handle it. + nop ; Some other key press used to be trapped + nop ; here, but was deleted before manufacture. + nop ; + nop ; + nop ; + cp $08 ; is it BACKSPACE + jp z,$0d7c ; if so, handle it. + cp $18 ; is it CTRL+X? + ; which is DELINE, which aborts the entering of the + ; line an prints a # character instead. + jr nz,$0dcc ; if NOT CTRL+X, jump to 0dcc + ld a,$23 ; otherwise print '#' + jp $0d81 ; and carry on reading from keyboard. + +l0dcc: cp $12 ; is it $12 + jr nz,$0de4 ; (20) + push bc + push de + push hl + ld (hl),$00 + call PRNCRLF,$19ea + ld hl,LINEBUF + call 0e9d,PRINTSTR ; print the string pointed to by HL + pop hl + pop de + pop bc + jp $0d8e ; + +l0de4: cp $20 ; is it less than SPACE + jp c,$0d8e ; if so carry on reading characters. + +l0de9: ld a,b ; move line length into A + cp $49 ; have we already goy 73 characters? + ld a,$07 ; if so jump forward to sound a beep and ignore + jp nc,$0df8 ; the keypress. + ld a,c ; otherwise, restore keypress to A + ld (hl),c ; store it at HL + ld ($38cc),a ; and at $38cc + inc hl ; increment HL + inc b ; increment line length counter + +l0df8: rst $18 ; print character in A + jp $0d8e ; and get next character. + +l0dfc: push de + call $0fc9 + ld a,(hl) + inc hl + inc hl + ld c,(hl) + inc hl + ld b,(hl) + pop de + push bc + push af + call $0fcd + call $1531 ; LOADFP + pop af + ld d,a + pop hl + +l0e12: ld a,e + or d + ret z + ld a,d + sub $01 + ret c + xor a + cp e + inc a + ret nc + dec d + dec e + ld a,(bc) + inc bc + cp (hl) + inc hl + jr z,$0e12 ; (-19) + ccf + jp $14f1 + +;Entry point for STR$ function +ST_STR$: +l0e29: call $0975 ; TSTNUM ; Make sure it's a number + call $1680 ; NUMASC ; Turn number into text + call $0e5f ; CRTST ; Create string entry for it + call $0fc9 ; GSTRCU ; Current string to pool + ld bc,$101d ; preload return address + push bc + +l0e39: ld a,(hl) +l0e3a: inc hl + inc hl + push hl + call $0eb3 + pop hl + ld c,(hl) + inc hl + ld b,(hl) + call $0e53 + push hl + ld l,a + call $0fbd + pop de + ret + +l0e4e: ld a,$01 + +l0e50: call $0eb3 + +l0e53: ld hl,$38bd + push hl + ld (hl),a + inc hl + inc hl + ld (hl),e + inc hl + ld (hl),d + pop hl + ret + +l0e5f: dec hl ; HL points to start of a string expression. + ; but we decrement it before entering the loop + ; because the first instruction in the loop + ; is an INC HL + +l0e60: ld b,$22 ; the " character. + ld d,b ; move it to D + +l0e63: push hl ; Save HL for later + ld c,$ff ; This is -1 as the value is INC'd during the loop. + +l0e66: inc hl ; HL points to start of string constant again. + ld a,(hl) ; Lets get current character. + inc c ; + or a ; + jr z,$0e72 ; Jump if the character being checked and C are 00 + cp d ; + jr z,$0e72 ; Jump if the character being checked = d + cp b ; + jr nz,$0e66 ; If the character being checked <> b the loop + +l0e72: cp $22 ; Did we get because of the " symbol? + call z,$066b ; if so call $06bb + ex (sp),hl ; + inc hl ; + ex de,hl ; + ld a,c ; + call $0e53 ; + +l0e7e: ld de,$38bd + ld hl,($38af) + ld ($38e4),hl + ld a,$01 + ld ($38ab),a + call $153d + rst $20 ; COMPARE HL,DE + ld ($38af),hl + pop hl + ld a,(hl) + ret nz + ld de,$001e + jp ERROR,$03db + inc hl +; +; PRINTSTR: +; Prints the zero terminated string expression pointed to by HL. +l0e9d: call $0e5f + +l0ea0: call $0fc9 + call $1531 ; LOADFP + inc e + +l0ea7: dec e + ret z + ld a,(bc) + rst $18 ; print character in A + cp $0d + call z,$19f0 + inc bc + jr $0ea7 ; (-12) + +l0eb3: or a + ld c,$f1 + push af + ld hl,($384b) + ex de,hl + ld hl,($38c1) + cpl + ld c,a + ld b,$ff + add hl,bc + inc hl + rst $20 ; COMPARE HL,DE + jr c,$0ece ; (7) + ld ($38c1),hl + inc hl + ex de,hl + pop af + ret + +l0ece: pop af + ld de,$001a ; Offset for 'OS' (Over size) error code. + jp z,ERROR,$03db ; report an 'OS Error' + cp a + push af + ld bc,$0eb5 + push bc + +l0edb: ld hl,(RAMTOP) + +l0ede: ld ($38c1),hl + ld hl,$0000 + push hl + ld hl,($38da) + push hl + ld hl,$38b1 + ld de,($38af) + rst $20 ; COMPARE HL,DE + ld bc,$0eec + jp nz,$0f32 + ld hl,(BASEND) + +l0efa: ld de,($38d8) + rst $20 ; COMPARE HL,DE + jr z,$0f0b ; (10) + inc hl + ld a,(hl) + inc hl + or a + call $0f35 + jr $0efa ; (-16) + +l0f0a: pop bc + +l0f0b: ld de,($38da) + rst $20 ; COMPARE HL,DE + jp z,$0f57 + call $1531 ; LOADFP + ld a,d + push hl + add hl,bc + or a + jp p,$0f0a + ld ($38c5),hl + pop hl + ld c,(hl) + ld b,$00 + add hl,bc + add hl,bc + inc hl + ex de,hl + ld hl,($38c5) + ex de,hl + rst $20 ; COMPARE HL,DE + jr z,$0f0b ; (-36) + ld bc,$0f27 + +l0f32: push bc + or $80 + +l0f35: ld a,(hl) + inc hl + inc hl + ld e,(hl) + inc hl + ld d,(hl) + inc hl + ret p + or a + ret z + ld b,h + ld c,l + ld hl,($38c1) + rst $20 ; COMPARE HL,DE + ld h,b + ld l,c + ret c + pop hl + ex (sp),hl + rst $20 ; COMPARE HL,DE + ex (sp),hl + push hl + ld h,b + ld l,c + ret nc + pop bc + pop af + pop af + push hl + push de + push bc + ret + +l0f57: pop de + pop hl + ld a,h + or l + ret z + dec hl + ld b,(hl) + dec hl + ld c,(hl) + push hl + dec hl + dec hl + ld l,(hl) + ld h,$00 + add hl,bc + ld d,b + ld e,c + dec hl + ld b,h + ld c,l + ld hl,($38c1) + call $0b95 + pop hl + ld (hl),c + inc hl + ld (hl),b + ld h,b + ld l,c + dec hl + jp $0ede + +l0f7c: push bc + push hl + ld hl,($38e4) + ex (sp),hl + call $09fd + ex (sp),hl + call $0976 + ld a,(hl) + push hl + ld hl,($38e4) + push hl + add a,(hl) + ld de,$001c ; offset for the LS error code. + jp c,ERROR,$03db ; if C set, report the LS error. + call $0e50 + pop de + call $0fcd + ex (sp),hl + call $0fcc + push hl + ld hl,($38bf) + ex de,hl + call $0fb4 + call $0fb4 + ld hl,$0991 + ex (sp),hl + push hl + jp $0e7e + +l0fb4: pop hl + ex (sp),hl + ld a,(hl) + inc hl + inc hl + ld c,(hl) + inc hl + ld b,(hl) + ld l,a + +l0fbd: inc l + +l0fbe: dec l + ret z + ld a,(bc) + ld (de),a + inc bc + inc de + jr $0fbe ; (-8) + +GETSTR: +l0fc6: call $0976 +GSTRCU: +l0fc9: ld hl,($38e4) +GSTRHL: +l0fcc: ex de,hl +GSTRDE: +l0fcd: call $0fe4 + ex de,hl + ret nz + push de + ld d,b + ld e,c + dec de + ld c,(hl) + ld hl,($38c1) + rst $20 ; COMPARE HL,DE + jr nz,$0fe2 ; (5) + ld b,a + add hl,bc + ld ($38c1),hl + +l0fe2: pop hl + ret + +l0fe4: ld hl,($38af) + dec hl + ld b,(hl) + dec hl + ld c,(hl) + dec hl + dec hl + rst $20 ; COMPARE HL,DE + ret nz + ld ($38af),hl + ret + +; Entry point for LEN function. +ST_LEN: +l0ff3: ld bc,$0b36 ; preload return address. + push bc + +l0ff7: call $0fc6 + xor a + ld d,a + ld ($38ab),a + ld a,(hl) + or a + ret + +; Entry point for ASC function. +ST_ASC +l1002: ld bc,$0b36 ; preload return address on stack. + push bc + +l1006: call $0ff7 + jp z,ERROR_FC,$0697 + inc hl + inc hl + ld e,(hl) + inc hl + ld d,(hl) + ld a,(de) + ret + +; Entry point for CHR$ function +ST_CHR$: +l1013: call $0e4e + call $0b57 + +l1019: ld hl,($38bf) + ld (hl),e + pop bc + jp $0e7e + +;Entry point for LEFT$ function +ST_LEFT$: + call $10a0 + xor a + +l1025: ex (sp),hl + ld c,a + push hl + ld a,(hl) + cp b + jr c,$102e ; (2) + ld a,b + ld de,$000e + push bc + call $0eb3 + pop bc + pop hl + push hl + inc hl + inc hl + ld b,(hl) + inc hl + ld h,(hl) + ld l,b + ld b,$00 + add hl,bc + ld b,h + ld c,l + call $0e53 + ld l,a + call $0fbd + pop de + call $0fcd + jp $0e7e + +; Entry point for RIGHT$ function +ST_RIGHT$: +l1050: call $10a0 + pop de + push de + ld a,(de) + sub b + jr $1025 ; (-52) + +;Entry point for MID$ function +ST_MID$: +l1059: ex de,hl + ld a,(hl) + call $10a3 + inc b + dec b + jp z,ERROR_FC,$0697 ; report an FC error if B=0 + push bc + ld e,$ff + cp $29 ; is A="," ? + jr z,$106f ; if so continue at $106F + rst $8,CHKNEXT + defb $2c ; ensure a "," follows, else report + ; a syntax error. + + call $0b54 + +l106f: rst $8,CHKNEXT ; ensure a ")" follows, else report + defb $29 ; a syntax error. + + pop af + ex (sp),hl + ld bc,$1027 + push bc + dec a + cp (hl) + ld b,$00 + ret nc + ld c,a + ld a,(hl) + sub c + cp e + ld b,a + ret c + ld b,e + ret + +; Entry point for VAL function. +ST_VAL +l1084: call $0ff7 + jp z,$12c3 + ld e,a + inc hl + inc hl + ld a,(hl) + inc hl + ld h,(hl) + ld l,a + push hl + add hl,de + ld b,(hl) + ld (hl),d + ex (sp),hl + push bc + dec hl + rst $10,GETNEXT + call $15e5 ; ASCTFP + pop bc + pop hl + ld (hl),b + ret + +l10a0: ex de,hl + rst $8,CHKNEXT + add hl,hl + +l10a3: pop bc + pop de + push bc + ld b,e + ret + + +; Entry point for FRE function. + +l10a8: ld hl,($38da) + ex de,hl + ld hl,$0000 + add hl,sp + ld a,($38ab) + or a + jp z,$0b1c + call $0fc9 + call $0edb + ld de,($384b) + ld hl,($38c1) + jp $0b1c + + dec hl + rst $10,GETNEXT ; get next character in BASIC line. + ret z ; return if nothing more to do. + + rst $8,CHKNEXT + defb $2c ; check that a COMMA follows, otherwise + ; stop via SYNTAX ERROR. + +;Entry point for DIM statement +st_dim: +l10cc: ld bc,$10c7 + push bc + defb f6 ; ****** OVERLAPPING CODE ******* + +l10d1: xor a ; set A to 00 + ld ($38aa),a ; save 00 to $38aa + ld c,(hl) ; retrieve current character into C + + call RIsAtoZ,$0cc5 ; check if character at (HL) is A to Z + jp c,ERROR_SN,$03c4 ; if carry flag is set it is less than A + ; so we report a SN Error. + + xor a ; Clear A + ld b,a ; clear B + ld ($38ab),a ; set $38ab to $00 + rst $10,GETNEXT ; get next character. + jr c,$10e9 ; if if it "A" to "Z" jump to 10e9 + call IsAtoZ,$0cc6 ; check if it is less than "A" + jr c,$10f2 ; CF set so it IS less than "A" + ; so jump to $10f2 + ; + ; fall through if character is > "9" +l10e9: ld b,a ; save character to A + +l10ea: rst $10,GETNEXT ; get next character + jr c,$10ea ; loop while it is "A" to "Z" + call IsAtoZ,$0cc6 ; then check following character + jr nc,$10ea ; Loop back if it is < "Z" + +l10f2: sub $24 ; Now check if it is $ + jr nz,$10fe ; If not jump forward to $10fe + inc a ; + ld ($38ab),a + rrca + add a,b + ld b,a + rst $10,GETNEXT + +l10fe: ld a,($38cb) + dec a + jp z,$11a0 + jp p,$110e + ld a,(hl) + sub $28 ; is it '(' + jp z,$117a ; if so jump forward to 117a + +l110e: xor a + ld ($38cb),a + push hl + ld d,b + ld e,c + ld hl,($38de) + rst $20 ; COMPARE HL,DE + ld de,$38e0 + jp z,$141a + ld hl,($38d8) + ex de,hl + ld hl,(BASEND) + +l1126: rst $20 ; COMPARE HL,DE + jp z,$113d + ld a,c + sub (hl) + inc hl + jp nz,$1132 + ld a,b + sub (hl) + +l1132: inc hl + jp z,$116c + inc hl + inc hl + inc hl + inc hl + jp $1126 + +l113d: pop hl + ex (sp),hl + push de + ld de,$0a51 + rst $20 ; COMPARE HL,DE + pop de + jp z,$116f + ex (sp),hl + push hl + push bc + ld bc,$0006 + ld hl,($38da) + push hl + add hl,bc + pop bc + push hl + call $0b92 + pop hl + ld ($38da),hl + ld h,b + ld l,c + ld ($38d8),hl + +l1161: dec hl + ld (hl),$00 + rst $20 ; COMPARE HL,DE + jr nz,$1161 ; (-6) + pop de + ld (hl),e + inc hl + ld (hl),d + inc hl + +l116c: ex de,hl + pop hl + ret + +l116f: ld ($38e7),a + ld hl,$036d + ld ($38e4),hl + pop hl + ret + +l117a: push hl + ld hl,($38aa) + ex (sp),hl + ld d,a + +l1180: push de + push bc + call $067a + pop bc + pop af + ex de,hl + ex (sp),hl + push hl + ex de,hl + inc a + ld d,a + ld a,(hl) + cp $2c + jp z,$1180 + rst $8,CHKNEXT + defb $29 ; ')' + + ld ($38d0),hl + pop hl + ld ($38aa),hl + ld e,$00 + push de + ld de,$f5e5 + ld hl,($38d8) + ld a,$19 + ld de,($38da) + rst $20 ; COMPARE HL,DE + jr z,$11d3 ; (37) + ld a,(hl) + inc hl + cp c + jr nz,$11b5 ; (2) + ld a,(hl) + cp b + +l11b5: inc hl + ld e,(hl) + inc hl + ld d,(hl) + inc hl + jr nz,$11a6 ; (-22) + ld a,($38aa) + or a + jp nz,$03cd + pop af + ld b,h + ld c,l + jp z,$141a + sub (hl) + jp z,$122b + +; +; Report a BS error +; +ERROR_BS: +l11cd: ld de,$0010 ; offset for BS + jp ERROR,$03db ; report a BS error. + +l11d3: ld de,$0004 + pop af + jp z,ERROR_FC,$0697 ; report a FC error + ld (hl),c + inc hl + ld (hl),b + inc hl + ld c,a + call $0ba0,CHK_STKSPC ;check stack space + inc hl + inc hl + ld ($38c3),hl + ld (hl),c + inc hl + ld a,($38aa) + rla + ld a,c + +l11ee: ld bc,$000b + jr nc,$11f5 ; (2) + pop bc + inc bc + +l11f5: ld (hl),c + push af + inc hl + ld (hl),b + inc hl + push hl + call $15ca ; MLDEBC (Mult DE by BC) + ex de,hl + pop hl + pop af + dec a + jr nz,$11ee ; (-22) + push af + ld b,d + ld c,e + ex de,hl + add hl,de + jp c,OM_ERROR,$0bb7 + call $0ba9 + ld ($38da),hl + +l1212: dec hl + ld (hl),$00 + rst $20 ; COMPARE HL,DE + jr nz,$1212 ; (-6) + inc bc + ld d,a + ld hl,($38c3) + ld e,(hl) + ex de,hl + add hl,hl + add hl,bc + ex de,hl + dec hl + dec hl + ld (hl),e + inc hl + ld (hl),d + inc hl + pop af + jr c,$124c ; (33) + +l122b: ld b,a + ld c,a + ld a,(hl) + inc hl + ld d,$e1 + ld e,(hl) + inc hl + ld d,(hl) + inc hl + ex (sp),hl + push af + rst $20 ; COMPARE HL,DE + jp nc,ERROR_BS,$11cd + push hl + call $15ca ; MLDEBC (Mult DE by BC) + pop de + add hl,de + pop af + dec a + ld b,h + ld c,l + jr nz,$1230 ; (-23) + add hl,hl + add hl,hl + pop bc + add hl,bc + ex de,hl + +l124c: ld hl,($38d0) + ret + +l1250: ld hl,$1757 + +l1253: call $1531 ; LOADFP + jr $1261 ; (9) + call $1531 ; LOADFP + ld hl,$d1c1 + +l125e: call $150b ; INVSGN + +l1261: ld a,b + or a + ret z + ld a,($38e7) ; FPEXP + or a + jp z,$1523 ; FPBCDE + sub b + jr nc,$127a ; NOSWAP (12) + cpl + inc a + ex de,hl + call $1513 ; STAKFP + ex de,hl + call $1523 ; FPBCDE + pop bc + pop de + +l127a: cp $19 + ret nc + push af + call $1546 ; SIGNS + ld h,a + pop af + call $1330 + ld a,h + or a + ld hl,$38e4 + jp p,$129f + call $1310 + jr nc,$12f1 ; (94) + inc hl + inc (hl) + jp z,$03d3 + ld l,$01 + call $1352 + jr $12f1 ; (82) + +l129f: xor a + sub b + ld b,a + ld a,(hl) + sbc a,e + ld e,a + inc hl + ld a,(hl) + sbc a,d + ld d,a + inc hl + ld a,(hl) + sbc a,c + ld c,a + +l12ad: call c,$131c + +l12b0: ld l,b + ld h,e + xor a + +l12b3: ld b,a + ld a,c + or a + jr nz,$12df ; (39) + ld c,d + ld d,h + ld h,l + ld l,a + ld a,b + sub $08 + cp $e0 + jr nz,$12b3 ; (-16) + +l12c3: xor a + +l12c4: ld ($38e7),a + ret + +l12c8: ld a,h + or l + or d + jr nz,$12d7 ; (10) + ld a,c + +l12ce: dec b + rla + jr nc,$12ce ; (-4) + inc b + rra + ld c,a + jr $12e2 ; (11) + +l12d7: dec b + add hl,hl + ld a,d + rla + ld d,a + ld a,c + adc a,a + ld c,a + +l12df: jp p,$12c8 + +l12e2: ld a,b + ld e,h + ld b,l + or a + jr z,$12f1 ; (9) + ld hl,$38e7 + add a,(hl) + ld (hl),a + jr nc,$12c3 ; (-44) + jr z,$12c3 ; (-46) + +l12f1: ld a,b + +l12f2: ld hl,$38e7 + or a + call m,$1303 + ld b,(hl) + inc hl + ld a,(hl) + and $80 + xor c + ld c,a + jp $1523 ; FPBCDE + +l1303: inc e + ret nz + inc d + ret nz + inc c + ret nz + ld c,$80 + inc (hl) + ret nz + jp $03d3 + +l1310: ld a,(hl) + add a,e + ld e,a + inc hl + ld a,(hl) + adc a,d + ld d,a + inc hl + ld a,(hl) + adc a,c + ld c,a + ret + +l131c: ld hl,$38e8 + ld a,(hl) + cpl + ld (hl),a + xor a + ld l,a + sub b + ld b,a + ld a,l + sbc a,e + ld e,a + ld a,l + sbc a,d + ld d,a + ld a,l + sbc a,c + ld c,a + ret + +l1330: ld b,$00 + +l1332: sub $08 + jr c,$133d ; (7) + ld b,e + ld e,d + ld d,c + ld c,$00 + jr $1332 ; (-11) + +l133d: add a,$09 + ld l,a + ld a,d + or e + or b + jr nz,$134e ; (9) + ld a,c + +l1346: dec l + ret z + rra + ld c,a + jr nc,$1346 ; (-6) + jr $1354 ; (6) + +l134e: xor a + dec l + ret z + ld a,c + +l1352: rra + ld c,a + +l1354: ld a,d + rra + ld d,a + ld a,e + rra + ld e,a + ld a,b + rra + ld b,a + jr $134e ; (-17) + nop + nop + nop + add a,c + inc b + sbc a,d + rst $30,CALLUDF + defb $19 + + add a,e + inc h + ld h,e + ld b,e + add a,e + ld (hl),l + call $848d + xor c + ld a,a + add a,e + add a,d + inc b + nop + nop + nop + add a,c + jp po,$4db0 + add a,e + ld a,(bc) + ld (hl),d + ld de,$f483 + inc b + dec (hl) + ld a,a + +; Entry point for LOG function +ST_LOG: +l1385: rst $28 ; TSTSGN + or a + jp pe,ERROR_FC,$0697 ; report a FC Error. + call $1395 + ld bc,$8031 + ld de,$7218 + jr $13cb ; (54) + +l1395: call $152e ; BCDEFP + ld a,$80 + ld ($38e7),a + xor b + push af + call $1513 ; STAKFP + ld hl,$1363 + call $1846 + pop bc + pop hl + call $1513 ; STAKFP + ex de,hl + call $1523 ; FPBCDE + ld hl,$1374 + call $1846 + pop bc + pop de + call $142f ; DVBCDE + pop af + call $1513 ; STAKFP + call $14f6 ; FLGREL + pop bc + pop de + jp $1261 + ld hl,$d1c1 + +l13cb: rst $28 ; TSTSGN + ret z + ld l,$00 + call $14ac + ld a,c + ld ($38f6),a + ex de,hl + ld ($38f7),hl + ld bc,$0000 + ld d,b + ld e,b + ld hl,$12b0 + push hl + ld hl,$13eb + push hl + push hl + ld hl,$38e4 + ld a,(hl) + inc hl + or a + jr z,$141c ; (44) + push hl + ld l,$08 + +l13f3: rra + ld h,a + ld a,c + jr nc,$1403 ; (11) + push hl + ld hl,($38f7) + add hl,de + ex de,hl + pop hl + ld a,($38f6) + adc a,c + +l1403: rra + ld c,a + ld a,d + rra + ld d,a + ld a,e + rra + ld e,a + ld a,b + rra + ld b,a + and $10 + jr z,$1416 ; (4) + ld a,b + or $20 + ld b,a + +l1416: dec l + ld a,h + jr nz,$13f3 ; (-39) + +l141a: pop hl + ret + +l141c: ld b,e + ld e,d + ld d,c + ld c,a + ret + +DIV10: +l1421: call $1513 ; STAKFP + ld bc,$8420 + ld de,$0000 + call $1523 ; FPBCDE + +DIV: +l142d: pop bc + pop de + +DVBCDE: +l142f: rst $28 ; TSTSGN + jp z,$03c7 + ld l,$ff + call $14ac + inc (hl) + jp z,$03d3 + inc (hl) + jp z,$03d3 + dec hl + ld a,(hl) + ld ($3819),a + dec hl + ld a,(hl) + ld ($3815),a + dec hl + ld a,(hl) + ld ($3811),a + ld b,c + ex de,hl + xor a + ld c,a + ld d,a + ld e,a + ld ($381c),a + +l1458: push hl + push bc + ld a,l + call $3810 + sbc a,$00 + ccf + jr nc,$146a ; (7) + ld ($381c),a + pop af + pop af + scf + jp nc,$e1c1 + ld a,c + inc a + dec a + rra + jp p,$1487 + rla + ld a,($381c) + rra + and $c0 + push af + ld a,b + or h + or l + jr z,$1482 ; (2) + ld a,$20 + +l1482: pop hl + or h + jp $12f2 + +l1487: rla + ld a,e + rla + ld e,a + ld a,d + rla + ld d,a + ld a,c + rla + ld c,a + add hl,hl + ld a,b + rla + ld b,a + ld a,($381c) + rla + ld ($381c),a + ld a,c + or d + or e + jr nz,$1458 ; (-73) + push hl + ld hl,$38e7 + dec (hl) + pop hl + jr nz,$1458 ; (-81) + jp $12c3 + +l14ac: ld a,b + or a + jr z,$14cd ; (29) + ld a,l + ld hl,$38e7 + xor (hl) + add a,b + ld b,a + rra + xor b + ld a,b + jp p,$14cc + add a,$80 + ld (hl),a + jp z,$141a + call $1546 ; SIGNS + ld (hl),a + dec hl + ret + rst $28 ; TSTSGN + cpl + pop hl + +l14cc: or a + +l14cd: pop hl + jp p,$12c3 + jp $03d3 + +l14d4: call $152e ; BCDEFP + ld a,b + or a + ret z + add a,$02 + jp c,$03d3 + ld b,a + call $1261 + ld hl,$38e7 + inc (hl) + ret nz + jp $03d3 + +; +; RST28 Jumps here if ($38e7) <> $00 +; +RST28_2: +l14eb: ld a,($38e6) ; Set a to be ($38e6) ; FPREG+2 + cp $2f ; compare with $2F + rla ; multiply A by 2. + +l14f1: sbc a,a ; + ret nz ; + inc a ; + ret ; + +; Entry point for SGN function. +ST_SGN: +l14f5: rst $28 ; TSTSGN + +FLGREL: +l14f6: ld b,$88 + ld de,$0000 + +l14fb: ld hl,$38e7 ; + ld c,a ; + ld (hl),b ; + ld b,$00 ; + inc hl ; + ld (hl),$80 ; + rla ; + jp $12ad ; + +ST_ABS: +l1509: rst $28 ; Check the operand (TSTSGN) + ret p ; if it's already POSITIVE simply return. + +; +;Toggle bit 7 of ($38e6) ; ; FPREG+2 +; +INVSGN: +l150b: ld hl,$38e6 ; otherwise we INVERT the SIGN bit. ; FPREG+2 + ld a,(hl) ; dead simple. + xor $80 ; just XOR the byte with $80 to invert + ld (hl),a ; the sign bit. + ret ; and return! + +STAKFP: +l1513: ex de,hl ; STAKFP + ld hl,($38e4) + ex (sp),hl + push hl + ld hl,($38e6) ; FPREG+2 + ex (sp),hl + push hl + ex de,hl + ret + +PHLTFP: +l1520: call $1531 ; LOADFP + +FPBCDE: +l1523: ex de,hl + ld ($38e4),hl + ld h,b + ld l,c + ld ($38e6),hl ; FPREG+2 + ex de,hl + ret + +BCDEFP: +l152e: ld hl,$38e4 + +LOADFP: +l1531: ld e,(hl) + inc hl + ld d,(hl) + inc hl + ld c,(hl) + inc hl + ld b,(hl) +INCHL: +l1538: inc hl + ret + +FPTHL: +l153a: ld de,$38e4 + +l153d: ld b,$04 + +l153f: ld a,(de) + ld (hl),a + inc de + inc hl + djnz $153f ; (-6) + ret + +SIGNS: +l1546: ld hl,$38e6 ; FPREG+2 + ld a,(hl) + rlca + scf + rra + ld (hl),a + ccf + rra + inc hl + inc hl + ld (hl),a + ld a,c + rlca + scf + rra + ld c,a + rra + xor (hl) + ret + +CMPNUM: +l155b: ld a,b + or a ; check if B=0 + jp z,$0028 ; if B=0 jump to RST028 + ld hl,$14ef ; + push hl ; + rst $28 ; TSTSGN + ld a,c + ret z + ld hl,$38e6 ; FPREG+2 + xor (hl) + ld a,c + ret m + + call $1573 ; CMPFP + rra + xor c + ret + +CMPFP: +l1573: inc hl + ld a,b + cp (hl) + ret nz + dec hl + ld a,c + cp (hl) + ret nz + + dec hl + ld a,d + cp (hl) + ret nz + + dec hl + ld a,e + sub (hl) + ret nz + + pop hl + pop hl + ret + +FPINT: +l1586: ld b,a + ld c,a + ld d,a + ld e,a + or a + ret z + + push hl + call $152e ; BCDEFP + call $1546 ; SIGNS + xor (hl) + ld h,a + call m,$15aa + ld a,$98 + sub b + call $1330 + ld a,h + rla + call c,$1303 + ld b,$00 + call c,$131c + pop hl + ret + +DCBCDE: +l15aa: dec de + ld a,d + and e + inc a + ret nz + dec bc + ret + +; Entry point for INT function. +INT: +ST_INT +l15b1: ld hl,$38e7 + ld a,(hl) + cp $98 ; + ld a,($38e4) + ret nc + ld a,(hl) + call $1586 ; FPINT + ld (hl),$98 + ld a,e + push af + ld a,c + rla + call $12ad + pop af + ret + +MLDEBC: +l15ca: ld hl,$0000 + ld a,b + or c + ret z + ld a,$10 + +l15d2: add hl,hl + jp c,ERROR_BS,$11cd + ex de,hl + add hl,hl + ex de,hl + jp nc,$15e0 + add hl,bc + jp c,ERROR_BS,$11cd + +l15e0: dec a + jp nz,$15d2 + ret + +ASCTFP: +l15e5: cp $2d ; check for the '-' sign + push af + jr z,$15ef ; if - sign is presnt jump forward, to avoid + ; printing a + cp $2b ; same for + sign + jr z,$15ef ; + dec hl ; HL now points to before constant. + +l15ef: call $12c3 ; clear out the calculator stack? + ld b,a ; preload mantissa and exponent with + ; default values for 0. + ld d,a + ld e,a + cpl + ld c,a + +l15f7: rst $10,GETNEXT + jp c,$163f + cp $2e ; check for DECIMAL POINT + jp z,$161a ; jump to $161a if it is a decimal now. + cp $65 + jp z,$160a + cp $45 + jp nz,$161e + +l160a: rst $10,GETNEXT + call $0a98 + +l160e: rst $10,GETNEXT + jp c,$1661 + inc d + jp nz,$161e + xor a + sub e + ld e,a + inc c + +l161a: inc c + jp z,$15f7 + +l161e: push hl + ld a,e + sub b + +l1621: call p,$1637 + jp p,$162d + push af + call $1421 + pop af + inc a + +l162d: jp nz,$1621 + pop de + pop af + call z,$150b + ex de,hl + ret + +l1637: ret z + +l1638: push af + call $14d4 + pop af + dec a + ret + +l163f: push de + ld d,a + ld a,b + adc a,c + ld b,a + push bc + push hl + push de + call $14d4 + pop af + sub $30 ; convert ascii to decimal. + call $1656 + pop hl + pop bc + pop de + jp $15f7 + +l1656: call $1513 ; STAKFP + call $14f6 + pop bc + pop de + jp $1261 + +l1661: ld a,e + rlca + rlca + add a,e + rlca + add a,(hl) + sub $30 + ld e,a + jp $160e + +; +; PERRIN: +; Prints the word ' in ' as part of an error report. +; +PERRIN: +l166d: push hl ; save current BASIC line number + ld hl,$0369 ; Point to ' in ' + call 0e9d,PRINTSTR ; print it. + pop hl ; retrieve line number + +l1675: ld de,$0e9c ; Return address. + push de + ex de,hl + xor a + ld b,$98 ; + call $14fb + +l1680: ld hl,$38e9 + push hl + rst $28 ; TSTSGN + ld (hl),$20 + jp p,$168c + ld (hl),$2d + +l168c: inc hl + ld (hl),$30 + jp z,$1742 + push hl + call m,$150b + xor a + push af + call $1748 + +l169b: ld bc,$9143 + ld de,$4ff8 + call $155b ; CMPNUM + or a + jp po,$16b9 + pop af + call $1638 + push af + jp $169b + +l16b0: call $1421 + pop af + inc a + push af + call $1748 + +l16b9: call $1250 + inc a + call $1586 ; FPINT + call $1523 ; FPBCDE + ld bc,$0306 + pop af + add a,c + inc a + jp m,$16d5 + cp $08 + jp nc,$16d5 + inc a + ld b,a + ld a,$02 + +l16d5: dec a + dec a + pop hl + push af + ld de,$175e + dec b + jp nz,$16e6 + ld (hl),$2e + inc hl + ld (hl),$30 + inc hl + +l16e6: dec b + ld (hl),$2e + call z,$1538 ; INCHL + push bc + push hl + push de + call $152e ; BCDEFP + pop hl + ld b,$2f + +l16f5: inc b + ld a,e + sub (hl) + ld e,a + inc hl + ld a,d + sbc a,(hl) + ld d,a + inc hl + ld a,c + sbc a,(hl) + ld c,a + dec hl + dec hl + jp nc,$16f5 + call $1310 + inc hl + call $1523 ; FPBCDE + ex de,hl + pop hl + ld (hl),b + inc hl + pop bc + dec c + jp nz,$16e6 + dec b + jp z,$1726 + +l171a: dec hl + ld a,(hl) + cp $30 + jp z,$171a + cp $2e + call nz,$1538 ; INCHL + +l1726: pop af + jp z,$1745 + ld (hl),$45 + inc hl + ld (hl),$2b + jp p,$1736 + ld (hl),$2d + cpl + inc a + +l1736: ld b,$2f + +l1738: inc b + sub $0a + jp nc,$1738 + add a,$3a + inc hl + ld (hl),b + +l1742: inc hl + ld (hl),a + inc hl + +l1745: ld (hl),c + pop hl + ret + +l1748: ld bc,$9474 + ld de,$23f7 + call $155b ; CMPNUM + or a + pop hl + jp po,$16b0 + jp (hl) + nop + nop + nop + add a,b + ld b,b + ld b,d + rrca + and b + add a,(hl) + ld bc,$2710 + nop + ret pe + inc bc + nop + ld h,h + nop + nop + ld a,(bc) + nop + nop + ld bc,$0000 + +l1770: ld hl,$150b + ex (sp),hl + jp (hl) + +; Entry point for SQR function +ST_SQR +l1775: call $1513 ; STAKFP + ld hl,$1757 + call $1520 ; PHLTFP + pop bc + pop de + rst $28 ; TSTSGN + ld a,b + jp z,$17cd + jp p,$178c + or a + jp z,$03c7 + +l178c: or a + jp z,$12c4 + push de + push bc + ld a,c + or $7f + call $152e ; BCDEFP + jp p,$17b5 + push af + ld a,($38e7) + cp $99 + jr c,$17a6 ; (3) + pop af + jr $17b5 ; (15) + +l17a6: pop af + push de + push bc + call $15b1 ; INT + pop bc + pop de + push af + call $155b ; CMPNUM + pop hl + ld a,h + rra + +l17b5: pop hl + ld ($38e6),hl ; FPREG+2 + pop hl + ld ($38e4),hl + call c,$1770 + call z,$150b + push de + push bc + call $1385 ; LOG + pop bc + pop de + call $13cb ; FPMULT + +; Entry point for EXP function. +ST_EXP: +l17cd: ld bc,$8138 + ld de,$aa3b + call $13cb ; FPMULT + ld a,($38e7) + cp $88 + jr nc,$17ff ; (34) + cp $68 + jr c,$1811 ; (48) + call $1513 ; STAKFP + call $15b1 ; INT + add a,$81 + pop bc + pop de + jr z,$1802 ; (21) + push af + call $125e + ld hl,$181a + call $1846 + pop bc + ld de,$0000 + ld c,d + jp $13cb + +l17ff: call $1513 ; STAKFP + +l1802: ld a,($38e6) ; FPREG+2 + or a + jp p,$180e + pop af + pop af + jp $12c3 + +l180e: jp $03d3 + +l1811: ld bc,$8100 + ld de,$0000 + jp $1523 ; FPBCDE + rlca + ld a,h + adc a,b + ld e,c + ld (hl),h + ret po + sub a + ld h,$77 + call nz,$1e1d + ld a,d + ld e,(hl) + ld d,b + ld h,e + ld a,h + ld a,(de) + cp $75 + ld a,(hl) + jr $18a3 ; (114) + ld sp,$0080 + nop + nop + add a,c + +l1837: call $1513 ; STAKFP + ld de,$13c9 + push de + push hl + call $152e ; BCDEFP + call $13cb + pop hl + +l1846: call $1513 ; STAKFP + ld a,(hl) + inc hl + call $1520 ; PHLTFP + ld b,$f1 + pop bc + pop de + dec a + ret z + push de + push bc + push af + push hl + call $13cb + pop hl + call $1531 ; LOADFP + push hl + call $1261 + pop hl + jr $184f ; (-23) + +; Entry point for RND function +ST_RND +l1866: rst $28 ; TSTSGN + ld hl,$3820 ; SEED+2, Random number seed + jp m,$18c4 ; RESEED (if negative) + ld hl,$3841 ; LSTRND - Last random number + call $1520 ; PHLTFP - Move last RND to FPREG + ld hl,$3820 ; SEED+2, Random number seed + ret z + add a,(hl) + and $07 + ld b,$00 + ld (hl),a + inc hl + add a,a + add a,a + ld c,a + add hl,bc + call $1531 ; LOADFP + call $13cb + ld a,($381f) + inc a + and $03 + ld b,$00 + cp $01 + adc a,b + ld ($381f),a + ld hl,$18c7 + add a,a + add a,a + ld c,a + add hl,bc + call $1253 + +l18a0: call $152e ; BCDEFP + +l18a3: ld a,e + ld e,c + xor $4f + ld c,a + ld (hl),$80 + dec hl + ld b,(hl) + ld (hl),$80 + ld hl,$381e + inc (hl) + ld a,(hl) + sub $ab + jr nz,$18bb ; (4) + ld (hl),a + inc c + dec d + inc e + +l18bb: call $12b0 + ld hl,$3841 + jp $153a + +l18c4: ld (hl),a + dec hl + ld (hl),a + dec hl + ld (hl),a + jr $18a0 ; (-43) + ld l,b + or c + ld b,(hl) + ld l,b + sbc a,c + jp (hl) + sub d + ld l,c + djnz $18a6 ; (-47) + ld (hl),l + ld l,b + +; Entry point for COS function. +ST_COS: +l18d7: ld hl,$1953 + call $1253 + +;Entry point for SIN function +ST_SIN +l18dd: ld a,($38e7) + cp $77 + ret c + ld a,($38e6) ; FPREG+2 + or a + jp p,$18f3 + and $7f + ld ($38e6),a ; FPREG+2 + ld de,$150b + push de + +l18f3: ld bc,$7e22 + ld de,$f983 + call $13cb + call $1513 ; STAKFP + call $15b1 ; INT + pop bc + pop de + call $125e + ld bc,$7f00 + ld de,$0000 + call $155b ; CMPNUM + jp m,$1935 + ld bc,$7f80 + ld de,$0000 + call $1261 + ld bc,$8080 + ld de,$0000 + call $1261 + rst $28 ; TSTSGN + call p,$150b + ld bc,$7f00 + ld de,$0000 + call $1261 + call $150b + +l1935: ld a,($38e6) ; FPREG+2 + or a + push af + jp p,$1942 + xor $80 + ld ($38e6),a ; FPREG+2 + +l1942: ld hl,$195b + call $1837 + pop af + ret p + +l194a: ld a,($38e6) ; FPREG+2 + xor $80 + ld ($38e6),a ; FPREG+2 + ret + +l1953: in a,($0f) + ld c,c + add a,c + nop + nop + nop + ld a,a + dec b + ei + rst $10,GETNEXT + ld e,$86 + ld h,l + ld h,$99 + add a,a + ld e,b + inc (hl) + inc hl + add a,a + pop hl + ld e,l + and l + add a,(hl) + in a,($0f) + ld c,c + add a,e + +; Entry point for TAN function +ST_TAN +l1970: call $1513 ; STAKFP + call $18dd + pop bc + pop hl + call $1513 ; STAKFP + ex de,hl + call $1523 ; FPBCDE + call $18d7 + jp $142d ; DIV + +; Entry point for ATN function +ST_ATN: +l1985: rst $30,CALLUDF ; This is interesting! + defb $0e ; If you use ATN at all you get + jmp ERROR_SN,$03c4 ; a Syntax Error. The developers + ; obviously had to sacrifise this command + ; for space or time reasons. + +PRNTCHR: +l198a: rst $30 ; call UDF + defb 0d + + push af ; save character to be printed + ld a,(CHANNEL) ; + or a ; + jp z,$19d6 ; If channel is SCREEN jump forward + + pop af + push af + cp $09 ; Is it a TAB chr? + jr nz,PRTCHR2 ; jump if it is not. + +l199a: ld a,$20 ; it's a TAB chr so we print spaces + ; till we are in correct column + rst $18 ; print character in A + + ld a,(PRNCOL,$3846) + and $07 ; correct column yet? + jr nz,$199a ; loop if not. + pop af ; all done + ret + +PRTCHR2: +l19a6: pop af ; restore character being printed to A + push af ; and save again for later. + sub $0d ; compare with $0d + jr z,$19b7 ; Are we printing CR? If so jump + ; forward to $19b7 to reset PRNCOL to 0 and + ; print the character. + jr c,$19ba ; or is it a character < $0d then go print it. + ld a,(PRNCOL,$3846) ; else, check current print head column + inc a ; if its = 132 we rest the printhead to column 0 + ; before printing. + cp $84 ; 132 is maximum columns. + call z,PRNRESET,$19c7 ; reset print head to start + ; of next line. + ; then fall through to print the character. + +l19b7: ld (PRNCOL,$3846),a + +l19ba: pop af + +l19bb: jp $1ae8,LPRINTA ; send character in A to printer. + +; +; Return print head home and feed a line. +; +PRNHOME: +l19be: xor a + ld (CHANNEL),a + ld a,(PRNCOL,$3846) ; get current print head column. + or a ; Set flags + ret z ; return if already home. +; +; PRNRESET +; Reset the printer to home position. +; +PRNRESET: +l19c7: ld a,$0d + call $19bb ; lprint CR + ld a,$0a + call $19bb ; lprint LF + xor a + ld (PRNCOL,$3846),a + ret + +l19d6: pop af + jp PRNCHR1,$1d72 + +; +; CLRKEYWT +; Clear the keyboard buffer and wait for anykey. +; return with the key pressed in A +; +CLRKEYWT: +l19da: call CLRKEYWT22,$1a2f + ret +; +; RSTCOL +; Reset the cursor to start of next line, if not already there. +; +RSTCOL: +l19de: ld a,(CURCOL) ; check current cursor column + or a ; if it is 0 + ret z ; simply return. + jr PRNCRLF,$19ea ; else print CRLF + +; +; jump here when RTN is pressed during immediate mode. +LINEDONE: +l19e5: ld (hl),$00 ; put end of line marker in place + ld hl,$385f ; And point to one less than LINBUF, the line buffer. + ; then fall through + +; +; Print a CRLF +; +PRNCRLF: +l19ea: ld a,$0d ; print CR + rst $18 ; print character in A + ld a,$0a ; print LF + rst $18 ; print character in A + +l19f0: ld a,(CHANNEL) ; + or a ; + jr z,$19fa ; + xor a ; + ld (PRNCOL,$3846),a ; + +l19fa: ret + +l19fb: rst $10,GETNEXT + push hl + call $1a18 + jr z,$1a0b ; (9) + push af + call $0e4e + pop af + ld e,a + call $1019 + +l1a0b: ld hl,$036d + ld ($38e4),hl + ld a,$01 + ld ($38ab),a + pop hl + ret + +l1a18: push hl + ld hl,LSTASCI,$380a + ld a,(hl) + ld (hl),$00 + or a + call z,$1a39 + pop hl + ret +; +; Check key with pause. +; If no key has been pressed, return. +; If CTRL+C was pressed, handle it. +; If CTRL+S was pressed pause until another key is pressed. +CHKKEYP: +l1a25: call $1a39 + ret z + ld (LSTASCI,$380a),a + cp $13 ; check for CTRL+S + ; if CTRL+S was pressed, + ; pause until another key is pressed. + ret nz +; +; Clear the last key value and wait for user to press a key. +; +CLRKEYWT2: +l1a2f: xor a ; put 00 into (LSTASCI,$380a) + ld (LSTASCI,$380a),a ; + +; +; Wait for a KEYPRESS and return with it in A +; +KEYWAIT: +l1a33: call $1a39 ; Keep calling $1a39 until A <> 0 + jr z,KEYWAIT,$1a33 ; + ret + +l1a39: call UKEYCHK,$1e7e ; Get last key pressed. + cp $03 ; Was it CTRL+C + jr nz,ENDKEYWT,$1a4a ; if NOT return with key in A. + +; +; Jump here if a CTRL+C was pressed while waiting for input. +; KEYBREAK: +l1a40: ld a,($385e) ; + or a ; + call z,$0bbe ; + jp $1fce + +ENDKEYWT: +l1a4a: or a ; clear flags + ret ; return + +;Entry point for PRESET command. +ST_PRESET: +l1a4c: xor a ; signal that we are doing a PRESET + jr $1a51 ; (2) + +; Entry point for PSET command. +ST_PSET: +l1a4f: ld a,$01 ; Signal that we are doing a PSET + +l1a51: ex af,af' + call $1a7f ; get two values stored in BASIC as (x,y) into + ; BC and DE + call $1a8e ; check X and Y co-ords are within range. + ; otherwise crash with FC error. + jr z,$1a5c ; (2) + ld (hl),$a0 + +l1a5c: ex af,af' + or a + ld a,(de) + jr nz,$1a64 ; (3) + cpl + and (hl) + ld b,$b6 + ld (hl),a + pop hl + ret + +l1a68: rst $10,GETNEXT + call $1a7f ; get two values stored in BASIC as (x,y) into + ; BC and DE + call $1a8e ; check X and Y coords are in range, otherwise + ; bomb out with FC error. + jr nz,$1a77 ; (6) + ld a,(de) + and (hl) + ld d,$01 + jr nz,$1a79 ; (2) + +l1a77: ld d,$00 + +l1a79: xor a + call $0b23 + pop hl + ret +; +; This routine at $1a7f will check that the syntax is like (x,y) then +; store X to BC and Y to DE. +; As in the statment SOUND (500,1000) or PSET (50,60) +GET2VALS: +l1a7f: rst $8,CHKNEXT + defb $28 ; check that the next byte is '(' + ; stop via SN ERROR if it is not. + call $1ad0 ; get value into DE + push de ; and save on stack. + rst $8,CHKNEXT ; + defb $2c ; check next byte is ',' + call $1ad0 ; get value into DE + rst $8,CHKNEXT ; + defb $29 ; check next byte is ')' + pop bc ; restore first value into BC + ret + +CHK_XY: +l1a8e: ex (sp),hl ; + push hl + push bc + push de + ld hl,$0047 ; maximum value of Y coordinate. + rst $20 ; COMPARE HL,DE + +l1a96: jp c,ERROR_FC,$0697 ; if y-coord is out of range report + ; an FC error. + ld hl,$004f ; now check X coordinate. + push bc + pop de + rst $20 ; if X coord is out of range report + ; an FC error. + jr c,$1a96 ; + + pop de ; retsore coordinates from stack. + pop bc + + ld hl,$3028 CHR_HOME ; + ld a,e + ld de,$0028 + +l1aaa: cp $03 + jr c,$1ab4 ; (6) + add hl,de + dec a + dec a + dec a + jr $1aaa ; (-10) + +l1ab4: rlca + sra c + jr nc,$1aba ; (1) + inc a + +l1aba: add hl,bc + ld de,$1aca + +l1abe: or a + jr z,$1ac5 ; (4) + inc de + dec a + jr $1abe ; (-7) + +l1ac5: ld a,(hl) + or $a0 ; + xor (hl) + ret + ld bc,$0402 ; + ex af,af' + djnz $1b10 ; (64) + +l1ad0: call $0985 + jp $0682 + +; Entry point for SOUND command +ST_SOUND +l1ad6: push de ; save DE for later. + call $1a7f ; get duration into BC and pitch into DE + push hl ; save character pointer + call PLAYSOUND ; play the sound + pop hl ; restore HL and DE and + pop de ; done. + ret ; +; +; LPCRLF :- Send a CR and LF to the printer port. +; +LPCRLF: +l1ae1: ld a,$0d ; preload A with CR + call $1ae8,LPRINTA ; output it to printer + ld a,$0a ; preload A with LF + ; and fall through to print routine. +; +; Send the character in A to the printer port. +; +LPRINTA: +l1ae8: rst $30,CALLUDF ; Call the UDF for character handling. + ; if installed. + defb $11 ; + + push af ; save AF twice since it gets POPed twice + push af ; during the routines. + exx + +; PRINTER HANDLING ROUTINES. +; +; In the following printer handling routines the time constant +; $b1 is used to make a baud rate of 1200 bps. +; some NOPs are used to get precise time constants. +; +; Also of note is the fact that there is no TIMEOUT value, +; so if the printer is not ready or not connected, and the +; user tries to print the only way to get control back is to +; restart the computer or attach the printer! + +LPRINT2: +l1aed: in a,($fe) ; Read from printer IO port. + and $01 ; Wait for PRINTER READY signal. + jr z,LRPINT2,$1aed ; loop until we get it! + call $1b08 ; output $00 to the port and + ; wait $b1 loops (time contant 1200 baud) + ld e,$08 ; prepare to output 8 Bits. + pop af ; restore AF + +l1af9: call $1b0a ; Output bit 0 of a and wait the time constant. + rrca ; rotate right to shift the appropriate bit + ; into BIT 0 + dec e ; decrement bit counter + jr nz,$1af9 ; loop for 8 bits. + + ld a,$01 ; output 1 STOP bit. + call $1b0a ; + exx ; restore registers + pop af ; restore data + ret ; return. + +l1b08: ld a,$00 ; preload A with $00 + +l1b0a: out ($fe),a ; output A to the port + ld h,$b1 ; $b1 is a time constant + +l1b0e: dec h ; dec H + jr nz,$1b0e ; loop until H = 0 + nop ; add T-States for precision timing. + nop ; + nop ; + ret ; and return +; +; ST_COPY entry point for COPY command. +; This routine copies the contents of the screen to the printer. +; +ST_COPY: +l1b15: push hl ; save HL and DE for later. + push de + call $1ae1 ; Send CRLF to printer. + ld hl,$3028,CHR_HOME ; HL points to start of character ram + ld de,$33e8,CHR_END ; DE points to end of character ram. +; +; Entering here will copy ram from HL to DE to the printer. +ST_COPY2: +l1b20: ld a,(hl) ; retriev character at (HL) + call $1ae8,LPRINTA ; print it to the printer. + inc hl ; move to next character, + rst $20 ; COMPARE HL,DE to see if we are at the end. + jr c,$1b20 ; loop to ST_COPY2 + call $1ae1 ; Send CRLF to printer at the end. + pop de ; Restore DE, + pop hl ; restore DL, + ret ; and retrun. + +; +; Display tape load message and wait for RTN key. +; +TAPELD1: +l1b2e: push hl + push de + push bc + ld hl,$1be8 ; 'Press '+CR+LF+$00 + +TAPEMSG: +l1b34: push af + call 0e9d,PRINTSTR ; Display the message + ld hl,$00b5 ; 'Press RETURN key to start'+$00 + call 0e9d,PRINTSTR ; Display the message + +l1b3e: call UKEYCHK,$1e7e ; Loop until the user presses + cp $0d ; the RTN key. + jr nz,$1b3e ; + call PRNCRLF,$19ea ; Print a CRLF + pop af + pop bc + pop de + pop hl + ret + +; +; BYTEREAD2: Read part of the SYNC signal from tape. +; +BYTEREAD2: +l1b4d: exx ; swap 16 bit register sets + ld c,$fc ; FC is the cassette port IO value + +RSTARTBIT: ; Wait for a start bit, and +l1b50: call $1b62 ; calculate in A the time for a 1-0-1 transition. + ; this figure gets ComPared with $49 during the routine. + jr c,$1b50 ; If it was less than $49 loop again. + + ld h,$08 ; Get ready to read 8 bits, (each bit =0101 on tape.) + +READBYTE: +l1b57: call $1b62 ; wait for another 0-1-0-1 transition + rl l ; multiply L by 2 each time round this loop + dec h + jr nz,$1b57 ; loop 8 times to read 8 Bits. + ld a,l ; save L to A + exx ; restore registers + ret ; and return. + +CALCLAG: +TAPE0WT: +l1b62: in a,(c) ; keep reading in from $FC until we get a 0 at bit 1 + rra + jr c,TAPE0WT,$1b62 + +TAPE1WT: +l1b67: in a,(c) ; keep reading from tape port until we get a 1 at bit 1 + rra + jr nc,TAPE1WT,$1b67 + xor a ; clear contents of A + +TAPE0WT2: +l1b6d: inc a ; A is now a counter + in b,(c) ; Keep reading tape port till we get a 0 + rr b ; incrementing A each time round the loop. + jr c,TAPE0WT2,$1b6d ; + +TAPE1WT2: +l1b74: inc a ; + in b,(c) ; keep reading from tape port till we get a 1 + rr b ; incrementing A each time. + jr nc,TAPE1WT2,$1b74 ; + cp $49 ; compare total time with $49, set flags accordingly. + ret ; + +l1b7e: ret + +; +; Display tape save message and wait for RTN +; +RECMSG: +l1b7f: push hl + push de + push bc + ld hl,$1bf7 ; point to 'Press '+CR+LF+$00 + jr TAPEMSG,$1b34 ; display message and wait for RTN key. + +; +; TAPEBYTE2, save the byte in A to tape TWICE. +; +TAPEBYTE2: +l1b87: call TAPEBYTE,$1b8a ; save byte in A to tape + +; CASSETTE SAVE BYTE ROUTINE. +; Output one start bit, one byte, and two stop bits to tape. +; A 0 bit is saved as a LOW freuency tone (high time lag between bits) +; A 1 bit is saved as a HIGH frequency tone, (Low time lag between bits) +; +TAPEBYTE: +l1b8a: push af ; save AF + exx ; swap HL,DE and BC register sets + ld c,$fc ; preload C with the tape IO port address. + push af ; save AF + + ; output one START BIT (Start bit = 0) + xor a ; make A 00 + ld e,$01 ; E is the bit counter. ie No. of BITS to output. + ; the loop at $lba5 will out put + ; the E most significant bits of A + call $1ba5 ; Output the bits to tape. + + pop af ; Restore AF + ld e,$08 ; Prepare to output 8 bits. + call $1ba5 ; Output the data to tape. + ld a,$ff ; Prepare to out put 2 stop bits. (Stop bit = 1) + ld e,$02 ; 2 stop bits. + call $1ba5 ; output the data + exx ; restore registers + pop af ; restore AF + ret ; return + +l1ba5: rla ; Rotate bit 7 of A into CARRY, + ; if it is a 1 we get a High freq sound (low time lag) + ; if it is a 0 we get a Low Freq sound (high time lag) + ld l,$40 ; preload L with $40=HIGH FREQ SOUND + jr c,$1bac ; if carry is 1 we jump forward, + ld l,$80 ; otherwise overwrite L with $80 = LOW FREQ SOUND + +l1bac: ld b,$04 ; counting down from 4 to 1 gives 0,1,0,1 on BIT 0 + +l1bae: out (c),b ; c =$FC + ld h,l ; move L to H + +l1bb1: dec h + jr nz,$1bb1 ; loop for a time delay of H reps. + dec b ; decrement B + jr nz,$1bae ; if B is not 0, out put the new value to $FC + dec e ; if B is now 0 dec E + jr nz,$1ba5 ; loop the whole thing E times. + ret + ret + +; +; SAVESYNC, saves a sync tone of 12 x $FF,$00 bytes to tape. +; +SAVESYNC: +l1bbc: push af + push bc + ld b,$0c ; 12 times we will out put FF followed by 00 + +l1bc0: ld a,$ff ; + call TAPEBYTE,$1b8a ; save byte in A to tape + djnz $1bc0 ; Loop BC times. + + xor a ; make A = 00 + call TAPEBYTE,$1b8a ; save byte in A to tape + pop bc + pop af + ret + +; +; Read the SYNC signal from the tape. +; +BYTEREAD: +l1bce: push af ; save AF + push bc ; save BC + +l1bd0: ld b,$06 ; preload B with 6, for 6 loops + +l1bd2: call BYTEREAD2,$1b4d ; read data from tape. + inc a ; + jr nz,$1bd0 ; (-8) + djnz $1bd2 ; (-8) + +l1bda: call BYTEREAD2,$1b4d ; read a byte from tape + or a + jr z,$1be5 ; (5) + inc a + jr z,$1bda ; (-9) + jr $1bd0 ; (-21) + +l1be5: pop bc + pop af + ret + +l1be8 defb 'Press '+CR+LF+$00 +l1bf7 defb 'Press '+CR+LF+$00 + +; Entry point for CSAVE command. +ST_CSAVE +l1c08 rst $30,CALLUDF + defb $15 + + cp $aa ; Is the next byte the "*" operator? + ; if so we are saving DATA not BASIC program. + jp z,$0c62 ; so jump to $0c62. + call $1cb8 + push hl + call $1d25 + ld hl,(BASTART) + call $1d38 + +l1c1c: ld b,$0f ; save 16 bytes of $00 to tape. + xor a + +l1c1f: call TAPEBYTE,$1b8a ; Save byte in A to tape. + djnz $1c1f ; Decerement B and loop accordingly. + ld bc,$1f40 ; Then pause for $1f40 loops (Approx 1 second) + call SLEEPBC,$1d4b ; sleep for BC loops. + pop hl + +l1c2b: ret + +; Entry point for CLOAD command. +ST_CLOAD: + rst $30,CALLUDF ; call the UDF if present. + defb $14 ; 'CLOAD' + cp $aa ; is next byte the "*" operartor? + jp z,$0c63 ; if so we are loading DATA not program. + ; so jump to $0c63 + sub $95 + jr z,$1c39 ; + xor a + ld bc,$232f + cp $01 + push af + ld a,$ff + ld ($385e),a + call $1cb1 + +l1c46: xor a + ld ($385d),a + push de + call TAPELD1,$1b2e ; Display the TAPE LOAD message + ; and wait for CR + call $1cd9 + ld hl,$3857 + call $1ced + pop de + jr z,$1c6c ; (18) + ld hl,$1d06 ; point to "Skip: " + call $1d0d ; print "Skip: " and the name of the program + ; being skipped on tape. + +l1c60: ld b,$0a + +l1c62: call BYTEREAD2,$1b4d + or a + jr nz,$1c60 ; (-8) + djnz $1c62 ; (-8) + jr $1c46 ; (-38) + +l1c6c: ld hl,$1cfe ; point to "Found: " message + call $1d0d ; print it and the name of the program + ; which was found. + pop af + ld ($38e4),a + call c,$0bbe + ld a,($38e4) + cp $01 + ld ($385e),a + ld hl,(BASTART) + call $1d51 + jr nz,$1c9a ; (17) + ld (BASEND),hl ; send 'END OF BASIC' marker. + +LOAD_OK: +l1c8c: ld hl,$036e ; 'Ok' + call 0e9d,PRINTSTR ; Print 'Ok' + ld a,$ff + ld ($385e),a + jp $0480 ; + +l1c9a: inc hl + ex de,hl + ld hl,(BASEND) ; retrieve 'End of basic' pointer. + rst $20 ; COMPARE it with DE + jr c,LOAD_OK,$1c8c ; If DE > (BASEND) then jump to LOAD_OK + + ld hl,$1cab ; Otherwise display 'Bad'+crlf+$00 + call 0e9d,PRINTSTR ; print "Bad" + jp OKMAIN2,$0401 ; print OK and return to IMMEDIATE mode. + + +l1cab: defb 'Bad',CRLF,$00 + +l1cb1: xor a + ld ($3851),a + dec hl + rst $10,GETNEXT + ret z + +l1cb8: call $0985 + push hl + call $1006 + dec hl + dec hl + dec hl + ld b,(hl) + ld c,$06 + ld hl,$3851 + +l1cc8: ld a,(de) + ld (hl),a + inc hl + inc de + dec c + jr z,$1cd7 ; (8) + djnz $1cc8 ; (-9) + ld b,c + +l1cd2: ld (hl),$00 + inc hl + djnz $1cd2 ; (-5) + +l1cd7: pop hl + ret + +l1cd9: call BYTEREAD,$1bce + xor a + ld ($385d),a + ld hl,$3857 + ld b,$06 ; prepare to read 6 bytes. + +l1ce5: call BYTEREAD2,$1b4d ; read 1 byte from tape. + ld (hl),a ; store at (HL) + inc hl ; increment HL + djnz $1ce5 ; and loop till we have read B bytes. + ret ; then return. + +l1ced: ld bc,$3851 + ld e,$06 + ld a,(bc) + or a + ret z + +l1cf5: ld a,(bc) + cp (hl) + inc hl + inc bc + ret nz + dec e + jr nz,$1cf5 ; (-8) + ret + +l1cfe: defb "Found: ",$00 +l1d06: defb "Skip: ",$00 + +; +; Print either "Skip: " or "Found: " plus the name of the +; program found on tape. +; +PSKIPFND: +l1d0d: push de + push af + call 0e9d,PRINTSTR + ld hl,$3857 + ld b,$06 ; maximum 6 characters in program name. + +l1d17: ld a,(hl) + inc hl + or a + jr z,$1d1d ; (1) + rst $18 ; print character in A + +l1d1d: djnz $1d17 ; + call PRNCRLF,$19ea + pop af + pop de + ret + +l1d25: call RECMSG,$1b7f + call SAVESYNC,$1bbc + ld b,$06 + ld hl,$3851 + +l1d30: ld a,(hl) + inc hl + call TAPEBYTE,$1b8a ; save byte in A to tape + djnz $1d30 ; (-7) + ret + +l1d38: call SAVESYNC,$1bbc + ex de,hl + ld hl,(BASEND) ; HL points to the end of our BASIC program. + +; Saves the block of data from DE to HL to tape. +SAVEBLOCK: +l1d3f: ld a,(de) + inc de + call TAPEBYTE,$1b8a ; save byte in A to tape + rst $20 ; COMPARE HL,DE + jr nz,$1d3f ; Keep saving bytes till we reach the + ; end of our basic program. + ret ; return when done. + +; SLEEPFFFF will enter a loop going round $FFFF times. +SLEEPFFFF: +l1d48: ld bc,$0000 + +SLEEP_BC: +l1d4b: dec bc ; decrement the loop counter. + ld a,b ; check if B and C are both 00 + or c + jr nz,SLEEPBC,$1d4b ; Loop till BC = 00. + ret ; Then return. + +l1d51: call BYTEREAD,$1bce + ld a,$ff + ld ($385d),a + sbc a,a + cpl + ld d,a + +l1d5c: ld b,$0a + +l1d5e: call BYTEREAD2,$1b4d + ld e,a + sub (hl) + and d + ret nz + ld (hl),e + call $0ba9 + ld a,(hl) + or a + inc hl + jr nz,$1d5c ; (-18) + djnz $1d5e ; (-18) + xor a + ret +PRNCHR1 +l1d72: rst $30,CALLUDF ; UDF + defb $13 + + push af ; save AF + cp $0a ; A contains a character code. + jr z,RPRNCHR,$1d93 ; If it is LF, call RPRNCHR to handle it. + ; else carry on. + ld a,(CURCOL) ; check current cursor column + or a ; is it 0? + jr nz,RPRNCHR,$1d93 ; if not then just jump forward + ; to print the character. + + ld a,(ROWCOUNT) ; if CURCOL is 0 then we must have started + ; a new line so check (ROWCOUNT) + or a ; is that $00? + ; if ROWCOUNT is 00 we are NOT counting rows + ; so we just leave it and carry on. + ; otherwise we decrement the row count + ; and pause for a keypress every 24 lines. + jr z,RPRNCHR,$1d93 ; Not counting lines so jump forward to print. + dec a ; Otherwise, decrement line counter, + ld (ROWCOUNT),a ; and if not $00 then + jr nz,RPRNCHR,$1d93 ; jump to print the character + ld a,$17 ; else, reset (ROWCOUNT) to $17 + ld (ROWCOUNT),a ; then Wait for any key. + call CLRKEYWT2,$1a2f ; Clear key buffer and wait for a keypress. + +; +; RPRINCHR is entered here if the character to be printed +; is on the stack. +RPRNCHR: +l1d93: pop af ; retrive character from stack. + +; +; PRNCHR +; Prints out the character in A and updates the +; screen system variables. +; +; Also handles special characters like +; BS,BELL,CLS,TAB etc +; + + +PRNCHR: +l1d94: push af + exx + cp $07 ; is it a beep? + jp z,$1e14 ; If so jump to BEEP + + cp $0b ; is it a CLS? + jp z,CLRSCRN ; If so jump to CLS + ld e,a + ld hl,(CURRAM) ; location of cursor in ram + ld a,(CURHOLD) + ld (hl),a + ld a,e + cp $08 ; is it a TAB + jr z,$1ddd ; (48) + + cp $0d ; is it a CR? + jr z,$1dbe ; (13) + + cp $0a ; is it a LF + jr z,$1dc8 ; (19) + + ld hl,(CURRAM) + ld (hl),a + call $1e1f + jr $1dea ; (44) + +l1dbe: ld de,(CURCOL) + xor a + ld d,a + sbc hl,de + jr $1de7 ; (31) + +l1dc8: ld de,$33c0 ; address of last line of screen character ram. + rst $20 ; COMPARE HL,DE + jp nc,$1dd8 + ld de,$0028 + add hl,de + ld (CURRAM),hl + jr $1dea ; (18) + +l1dd8: call SCROLLUP ; scroll screen up one line + jr $1dea ; (13) + +l1ddd: ld a,(CURCOL) + or a + jr z,$1de5 ; (2) + dec hl + dec a + +l1de5: ld (hl),$20 + +l1de7: call SVCURCOL,$1e3e ; save cursor address and column number. + +l1dea: ld hl,(CURRAM) ; retrieve cursor position in character + ; ram matrix. + ld a,(hl) ; retrieve character at cursor. + ld (CURHOLD),a ; save to CURHOLD + ld (hl),$7f ; fill cursor position with cursor. + +PRINTRET: +l1df3: exx + pop af + ret + + ld hl,(CURRAM) + ld a,(CURHOLD) + ld (hl),a + ret + +SCROLLUP: ; Scroll the screen UP one row. +l1dfe: ld bc,$0398 ; SIZE-OF-SCREEN (23rows * 40 cols) + ld de,$3028 ; CHR_HOME + ld hl,$3050 + ldir + +BLNKLINE: ; Blank the bottom line + ld b,$28 ; 40 bytes, one line width + ld hl,$33c1 ; address of last line + +l1e0e: ld (hl),$20 ; fill with SPACEs + inc hl + djnz $1e0e ; Loop + ret + +BEEP: +l1e14: ld bc,$00c8 ; Duration + ld de,$0032 ; Pitch + call PLAYSOUND + +l1e1d: jr PRINTRET ; finished. + +l1e1f: ld hl,(CURRAM) + ld a,(CURCOL) + inc hl ; increment ram address of cursor + inc a ; increment COLUMN counter + cp $26 ; and compare with 38. + ; remember that when entering/listing BASIC + ; programs that the aquarius only uses columns + ; 1 to 38 from the possible 0 to 39. + + jr c,SVCURCOL,$1e3e ; If less than 38 jump forward to + ; save CURCOL and CURRAM and return to caller. + inc hl ; HL now points to first editor column of next line. + inc hl + ld de,$33e8,CHAR_END ; the end of the character ram matrix. + rst $20 ; COMPARE HL,DE + ld a,$00 ; reset column counter. + jr c,SVCURCOL,$1e3e ; Jump forward and save if not at screen end. + ld hl,$33c1 ; otherwise point HL to start of bottom screen + ; line. + call SVCURCOL,$1e3e ; save data and + jp SCROLLUP ; scroll the screen up one line. + +l1e3e: ld (CURRAM),hl ; ram location of cursor + ld (CURCOL),a ; column of cursor + ret + +CLRSCRN: +l1e45: ld b,$20 ; ASCII code for + ld hl,$3000 ; start of screen character ram location + call FILLSCRN ; fill screen character ram with spaces. + + ld b,$06 ; Black on BLUE colour attrib + call FILLSCRN ; set colour attribs. + + ld hl,$3029 ; first byte of CHAR RAM + xor a + jp $1de7 + +FILLSCRN: +l1e59: ld de,$03ff ; there are 1024 bytes in the COLOUR + ; ram matrix +l1e5c: ld (hl),b ; fill each location with the colour code in B + inc hl ; next location + dec de ; Decrement the byte counter + ld a,d ; Check for DE=00 + or e ; + jr nz,$1e5c ; Loop until de=0 + ret ; then return + +PLAYSOUND: +l1e64: ld a,b ; on entry BC=duration + or c ; DE=pitch + ret z ; RET if no duration left. + xor a ; start with speaker OFF + out ($fc),a ; + call DELAY,$1e76 ; Delay for DE loops + inc a ; speaker ON + out ($fc),a ; + call DELAY,$1e76 + dec bc ; dec DURATION + jr PLAYSOUND ; loop to top of PLAYSOUND + +DELAY: ; delay for DE loops +l1e76: push de + pop hl ; move DE to HL + +l1e78: ld a,h + or l + ret z ; return when done. + dec hl + jr $1e78 ; loop if not done. + +; +; Call the user defined keyboard handler. +; If no UDF Keyboard handler, the default is used. +UKEYCHK: +l1e7e: rst $30,CALLUDF ; Call the UDF + defb $12 + +; +; KEYCHK: See if a key has been pressed and return ASCII value. +; +KEYCHK: +l1e80: exx ; Swap register sets. +l1e81: ld hl,(KWADDR) ; Is HL pointing to a KEYWORD? + ld a,h + or a + jr z,KEYCHK2,$1ea2 ; if NOT then continue scanning keyboard + ex de,hl ; else save HL into DE + ld hl,SCANCNT ; Retrieve the number of scans this key has + ; been hold down for. + inc (hl) ; Increment it. + ld a,(hl) ; + cp $0f ; And test + jr c,KEYDONE,$1ece ; Restore registers and return + ld (hl),$05 + ex de,hl + inc hl + ld a,(hl) + ld (KWADDR),hl + or a + jp p,KEYRET,$1f36 + xor a + ld ($380c),a + +; +; The keyboard matrix is 8 lines in by 6 lines out. +; The keyboard is scanned by reading the value IN at port $FF +; Register B should hold a Bit pattern corresponding to the +; column of keys being scanned. +; For example to scan column 0 B would hold 11111110 (Binary) +; to scan column 1 B would hold 11111101 +; and so on. +; +; If a key is pressed it causes a bit in the IN value to be 0 +; The invalue is then inverted (complimented) to make a key down +; cause a bit 1. +; +; Initially this routine checks to see if ANY keys are down at all +; without trying to figure out which one, by scanning all the columns +; at once. +; A key is not decoded until it has been held down for 4 successive scans. +; this is as a 'debounce' to prevent spurious readings. +; +; Once the key has been scanned 71 times the routine stops counting. +; the number of scans is stored at address SCANCNT. +; The scan code is stored at $380E + +KEYCHK2: +l1ea2: ld bc,$00ff ; Scan all columns at once. + in a,(c) ; Read the results. + cpl ; invert - (a key down now gives 1) + and $3f ; check all rows. + ld hl,LASTKEY ; Get the scan code of the last key pressed. + jr z,$1ec5 ; If NO keys pressed jump to $1ec5 + ; else continue scanning, one column at a time. +SCNCOL8: + ld b,$7f ; 01111111 - scanning column 8 + in a,(c) + cpl ; invert bits + and $0f ; check lower 4 bits + jr nz,$1ed7 ; there is a KEYDOWN + +SCNCOLS: + ld b,$bf ; 10111111 - start with column 7 +l1eba: in a,(c) + cpl ; invert bits + and $3f ; is there any key down? + jr nz,$1ed7 ; YES: goto KEYDOWN, + rrc b ; NO: try next column + jr c,$1eba ; when the 0 bit gets to CARRY FLAG we know + ; we have scanned all the columns + ; and not found anything, so we fall through to + ; NOKEYS + +NOKEYS: ; no keys are down. +l1ec5: inc hl ; HL now equals SCANCNT, the SCAN counter. + ld a,$46 ; this counts how many times the same code has + cp (hl) ; been scanned in a row. It stops counting at $46 + jr c,KEYDONE,$1ece ; Already scanned more than $46 times, so just return. + jr z,$1ed1 ; increment scan counter, then return. + inc (hl) ; increment scan counter +; +; KEYDONE +; +l1ece: xor a ; clear accumulator + exx ; restore registers + ret ; return + +l1ed1: inc (hl) ; increment the SCAN counter + dec hl ; point back to LASTKEY + ld (hl),$00 ; clear it's contents + jr KEYDONE,$1ece ; and exit. + +; +; KEYDOWN +; Jump here if a key is found to be pressed. +; the B register still holds the bit pattern of the column being scanned. +; so one bit of B will be 0 the rest 1 +; +KEYDOWN: +l1ed7: ld de,$0000 ; DE is used as a column counter. + +; +; KROWCNT, converts the BIT number of the row and column into +; actual numbers. So if bit 7 was set, a would hold 7. +; the column is multiplied by 6 so it can be added to the row number +; to give a unique scan code for each key. +; There are 8 columns of 6 keys giving a total of 48 keys. +; +KROWCNT: +l1eda: inc e + rra + jr nc,KROWCNT ; Count how many rotations to get the bit into the carry. + ld a,e ; A now holds the bit number which was SET + ; eg if bit 4 of A was set, A would now be $04 +KCOLCNT: +l1edf: rr b ; + jr nc,$1ee7 ; once the 0 bit gets to CARRY we jump to + ; + add a,$06 ; add 6 for each rotate, to give the column number. + jr $1edf,KCOLCNT ; + +; +; At this point A = (column*6)+row +; +; +l1ee7: ld e,a + cp (hl) ; Check to see if it is the + ld (hl),a ; same keycode as last time. + inc hl ; if not, set scancount to 0 + jr nz,$1efc ; and return. + + ; Same key, so has it been + ld a,$04 ; down for 04 scans? (De-bounce) + cp (hl) ; + jr c,$1ef7 ; if more than 4, then we already handling it. + ; so keep counter at 06 and return. + jr z,KDECODE,$1f00 ; if is has been down for exactly 4 scans, + ; jump to KDECODE. + inc (hl) ; otherwise increment scan count... + jr $1ef9 ; ...and return. + +l1ef7: ld (hl),$06 + +l1ef9: xor a + exx + ret +; +; If the keycode is different from last time, reset scan count +; and return. +; +SCANNEW: +l1efc: ld (hl),$00 + jr $1ef9 ; (-7) + +; +; The same key has now been down for $04 scans. +; so it's time to find out what it is. +KDECODE: +l1f00: inc (hl) ; increment the scan count + ld b,$7f ; read column 8 ($7f = 01111111) + in a,(c) ; + bit 5,a ; CTRL key down? + ld ix,$1f93 ; point to start of CTRL key lookup table + jr z,$1f19 ; JUMP to KLOOKUP + bit 4,a ; SHIFT key down? + ld ix,$1f65 ; point to start of SHIFT key lookup table + jr z,$1f19 ; JUMP to KLOOKUP + ld ix,$1f37 ; else point to start of natural key lookup table. +; +; KLOOKUP +; This routine translates scancodes into actual ASCII values, or control +; key values. On entry IX points to the appropraite tabel and DE holds the offset +; into that table. The minimum offset is 1 +; +KLOOKUP: +l1f19: add ix,de ; offset into table. + ld a,(ix+$00) ; retrieve code + or a ; update flags + jp p,KEYRET,$1f36 ; if positive then it's not a KEY word. + ; so we return with the vlaue in A + ; else, it's an offset into the keyword table. + sub $7f ; So we strip the high bit. + ; this leaves us with an index in A representing the + ; position on the keyword in the table. + ; ie if A = 3 then we want the THIRD keyword. + ld c,a ; move this number to C + ld hl,$0244 ; Point to the byte prior to the + ; start of the KEYWORD table. +; +; KYWSCAN, on entry C holds an index into the keyword table. +; we step throught the tabel to find that word. +; the first byte of each word has the BIT 7 set. +KYWSCAN: +l1f28: inc hl ; + ld a,(hl) ; read caharcter at (HL) + or a ; set flags + jp p,KYWSCAN,$1f28 ; LOOP if positive.ie Bit 7=0, so it's + ; not the first letter of a keyword. + dec c ; DEC C at the start of each keyword. + jr nz,$1f28 ; if C is not yet 0 continue scanning + ld (KWADDR),hl ; save the position of the first byte of our + and $7f ; keyword. And strip it's high bit from A + ; A now holds the first CHARACTER of our keyword. +KEYRET: +l1f36: exx ; restore registers + ret ; and return. + + + +; THE KEY TABLES +; The tables actually start 1 byte higher than IX since the minimum +; offset is 1 not 0. + +;Vanilla key table - no shift or control keys pressed: +l1f38: defb '=' + defb $08 + defb ':' + defb CR + defb ";.-/0pl,9okmnj8i7uhb6ygvcf5t" + defb "4rdx3esz a2w1q" + +; SHIFT key table +l1f66: defb "+\*",CR + defb "@>_^?PL<)OKMNJ(I'UHB&YGVCF%T$" + defv "RDX#ESZ A" + defb $22 ;the " charcter + defb "W!Q" + +; CTRL key table +l1f94 defb $82,$1c,$c1,$0d,$94,$c4,$81,$1e,$30,$10 + defb $ca,$c3,$92,$0f,$9d,$0d,$c8,$9c,$8d,$09 + defb $8c,$15,$08,$c9,$90,$19,$07,$c7,$03,$83 + defb $88,$84,$a5,$12,$86,$18,$8a,$85,$13,$9a + defb $c6,$9b,$97,$8e,$89,$11 + + + +l1fc1: ld de,$21e5 + inc b + nop + add hl,sp + ld ($38f9),hl + pop hl + jp CHKKEYP,$1a25 ; read key buffer check for CTRL+C or CTRL+S + +l1fce: ld hl,($38f9) + +l1fd1: ld sp,hl + ld hl,(TMPSTAT) + call $0c20 + +l1fd8: dec hl ; DEC HL to point to the + dec hl ; instruction that caused the + ; syntax error. + ld ($38f9),hl ; save HL + ld hl,$38b1 ; preload HL + ret ; return + +START: ; This routine is JUMPed to + ; immediately upon power-on. +l1fe1: ld a,$ff ; + out ($fe),a ; + jp $0041 ; Jump to START2 + +;JMPCART: +l1fe8: ld a,$aa ; 10101010 + out ($ff),a + ld (LASTFF),a + jp $2010 ; Jump to ROM extension + +l1ff2: ld hl,$015f ; Start of Copyright message. + jp PRINTSTR ; + diff --git a/tests/restricted/cxdisk.asm b/tests/restricted/cxdisk.asm new file mode 100644 index 00000000..efd4210d --- /dev/null +++ b/tests/restricted/cxdisk.asm @@ -0,0 +1,1774 @@ +; 06-2018: Converted to z80 mnemonics with toz80.awk +; +; ***************************************** +; * * +; * Commodore Disk Controller * +; * Module for CP/M 3.0 BIOS * +; * * +; ***************************************** +; +; +; + title 'CXDISK Commodore C-128 Disk Controller 15 Apr 86' + + + + +; CP/M 3 Disk definition macros + + maclib cpm3 + + maclib z80 + +; C-128 system equates + + maclib cxequ + + page + +; Disk drive dispatching tables for linked BIOS + + public cmdsk0,cmdsk1,cmdsk2,cmdsk3,cmdsk4 + +; System Control Block variables + extrn @ermde ; BDOS error mode + +; Utility routines in standard BIOS + extrn _wboot ; warm boot vector + extrn _pmsg ; print message @ up to 00 + ; saves & + extrn _pdec ; print binary number in from 0 to 65535 + extrn _pderr ; print BIOS disk error header + extrn _conin,_cono ; con in and out + extrn _const ; get console status + extrn _sctrn ; sector translation routine + extrn @covec + +; status line calls + + extrn _save,_recov,_stat + +; System function call + extrn _kyscn + extrn _fun65 + extrn _bank + extrn _di_int + + public _dskst + public _dkmov + extrn _stat,@st40 + + page +; +; Initialization entry point. +; called for first time initialization. +; + DSEG +init_154X: + XOR a + LD (fast),A + LD HL,MFM_table + LD (MFM_tbl_ptr),HL + ret + + + page +; +; This entry is called when a logical drive is about to +; be logged into for the purpose of density and type determination. +; It may adjust the parameters contained in the disk +; parameter header pointed to by +; + DSEG +; +; if disk type GCR or drive type 1541 or 1581(reports as GCR) +; if sector size is 256 bytes +; if 1st sector has 'CBM' (1st 3 bytes) +; if last byte = -1 (0FFh) +; set C128 double sided +; else +; set C128 single sided +; endif +; else +; set C64 type +; endif +; else (512 byte sector size) +; set C1581 type +; endif +; else (must be MFM) +; TEST MFM +; endif +; +login_154X: + call get_drv_info ; set the drive to check (DPH_pointer set) + + LD a,vic_test + ; ***** add code to reset 1581 drive ***** + call _fun65 + LD b,a + AND 0ch + CP 0ch ; fast drive _ + JR Z,commodore_type ; no, must be 1541 type + LD a,b ; yes, is a 1571 or 1581 + RLCA ; MSB=1 if NON-Commodore disk + JR C,MFM_type ; 1571 NON-Commodore disk is MFM type + + page +; +; Commodore Type disk is a disk that is in GCR format (1571) +; Or Standard Commodore format for 1581 (Has a Commodore dir track) +; +commodore_type: + LD HL,(DPH_pointer) + DEC HL + if use_1581 + LD a,b ; get the status byte + AND 30h ; save only the sector size info + CP 20h ; 512 byte sectors_ + JR NZ,set_15x1_type ; no, set up as 1571 or 1541 + ; yes, set 1581 type drive +; +; +; +set_1581_type: + LD (HL),dsk_1581 ; yes, set up as 1581 double sided + LD DE,dpb_1581 + jr set_dpb_only + + endif + +set_15x1_type: + LD (HL),dsk_c64 + LD DE,dpb_c64_cpm ; set DPB to C64 + call set_dpb_only + + XOR a + LD (vic_sect),A ; set track 1 sector 0 (1st sector + INC a ; on the disk) + LD (vic_trk),A + + LD HL,@buffer + LD (local_DMA),HL ; move DMA pointer to disk buffer + call login_rd + AND a ; read error _ + RET NZ ; yes, just return + + RET CALL FR_check_CBM + RET NZ ; return if not 'CBM' + ; A=0FFh if double sided + INC a + LD HL,(DPH_pointer) + DEC HL ; does not affect flags + LD (HL),dsk_c128 + + LD DE,dpb_c128_SS + JR NZ,set_dpb_only + + LD DE,dpb_c128_DS + + page +; +; +; +set_dpb_only: + LD BC,0 ; set sector translation to zero +set_format: + LD HL,(DPH_pointer) + LD (HL),c + INC HL + LD (HL),b ; install sector translation + LD BC,25-1 ; ofset to DPB + ADD HL,BC ; HL points to DPB now + LD BC,17 ; dpb size + EX DE,HL ; move to DPB location + ldir + ret + + page +; +; TEST MFM() +; save number bytes/sector +; if double sided +; mark two sided +; endif +; find start and end sector numbers +; scan table of disk for match (if more then 1 match ask user) +; +MFM_type: + LD c,01100000b + AND c ; A = status(trk1) shifted left 1 + PUSH AF ; save in case bad query + PUSH BC ; save BC + + call get_max_num_B ; used to set the pointer only + LD b,(HL) ; get size, and disk lock flag + INC HL + LD a,(HL) + INC HL + LD h,(HL) ; get last MFM_mactch_ptr + LD l,a + LD a,b ; get lock flag in A + AND 80h ; lock bit set _ + LD (lock_flag),A ; (save old lock status) + LD (last_match),HL ; save last match pointer + JR Z,not__locked_entry ; yes, then set same disk type +; set_locked_entry + XOR a + LD (lock_flag),A + LD c,0B0h + LD A,(vic_data) ; get sector size info + AND c + LD b,a ; save disk sector size info + EX DE,HL ; save HL + LD HL,(DPH_pointer) + DEC HL + LD a,c + AND (HL) ; get old disk sector size + CP b ; are they the same_ + JR NZ,not_locked_entry ; no, then unlock disk anyway + + EX DE,HL ; get last match pointer (in DE) + POP AF ; yes, remove two data elements + POP AF ; ..save on stack + jr set_this_entry + +not_locked_entry: + LD HL,MFM_match_tbl ; clear Match table + LD (MFM_cur_ptr),HL + LD DE,MFM_match_tbl+1 + LD (HL),0 + LD BC,(MFM_tbl_entries*2)-1+1+1 ; table, offset and count + ldir + LD a,4 + LD (vic_trk),A ; do query on track 4 + LD a,vic_query + call _fun65 + POP BC ; recover BC + AND 0eh ; query error _ + JR NZ,query_error ; yes, use only bits 5 and 6 + LD A,(@buffer) ; get trk 4 status + LD b,a ; save in B + AND 0eh ; trk 4 status error _ + JR NZ,query_error ; yes, use only bits 5 and 6 + LD a,b ; recover B (trk 4 status) + ADD A,a ; shift left + AND c ; mask sector size bits + LD b,a + POP AF ; get trk 1 sector size bits + CP b ; same as trk 4 sector size_ + LD c,01111111b + JR Z,trk_1_trk_4 ; yes, (then test for mult format) + LD a,80h ; set MSB to mean mult format + ADD A,b ; ..(track 0 different sector size + ; ..then track 4) + LD b,a ; save in B + LD c,11111111b +trk_1_trk_4: + LD A,(@buffer+1) ; get number of sectors/track + SUB 4 ; remove 4 to extend the range + ADD A,a ; shift left + ADD A,b ; combine with rest of mask + LD b,a ; save in B for now + + LD A,(@buffer+3) ; minimum sector number + ADD A,b ; add in start sector # + PUSH AF ; save on stack for a moment + +query_error: + POP AF ; get value to match + AND c ; test only those bits in the mask + + LD HL,(MFM_tbl_ptr) + LD b,MFM_tbl_entries +check_next: + PUSH BC ; save BC for a moment + LD b,a ; move compare value to + LD a,(HL) ; get type info + AND c ; test only the good info + CP b ; match the current type byte + LD a,b ; (recover A) + POP BC ; (recover BC) + JR NZ,not_found ; no, do not queue data + ; yes queue table entry address + + EX DE,HL ; save adr in DE + LD HL,(MFM_cur_ptr) + LD (HL),e + INC HL + LD (HL),d + INC HL + LD (MFM_cur_ptr),HL + LD HL,MFM_count + INC (HL) ; add one to counter + EX DE,HL + + page +; +; +not_found: + LD DE,32 ; table entry size + ADD HL,DE + djnz check_next + + LD A,(MFM_count) ; number of matches in table + AND a ; test for zero + JP Z,tell_user_no_entry ; none, tell the user + + DEC a ; only one _ + JR NZ,user_select ; no, go check with user (which one) + LD HL,(MFM_match_tbl) ; yes, use the only one found + +; +; install data from pointer in HL +; +set_this_entry: + PUSH HL ; save table pointer + INC HL + LD a,(HL) ; get type info. + EX DE,HL ; save table address in DE + LD HL,(DPH_pointer) + DEC HL + LD (HL),a ; save type code + EX DE,HL ; get table adr to HL + INC HL ; HL points to sector translation table + LD c,(HL) ; ..zero if none + INC HL + LD b,(HL) + INC HL ; HL points to DPB + EX DE,HL ; DE points to DPB (HL trash) + call set_format + LD b,(HL) ; get the number of sect/trk from MFM table + LD A,(lock_flag) ; get the current lock flag value + OR b ; combine with sect/trk + EX DE,HL ; HL=to adr, DE=from adr + LD (HL),a ; install sect/trk and lock flag + POP DE ; recover table pointer + INC HL + LD (HL),e + INC HL + LD (HL),d ; save MFM table pointer at end of DPH + ret + + page +; +; let the user select the Disk type (s)he wants +; +user_select: + INC a ; number of entries to try to match + LD b,a ; set in B as loop count + LD HL,(last_match) ; get value to match with + LD d,h + LD e,l ; last match pointer is in DE + + LD HL,MFM_match_tbl + LD (MFM_cur_ptr),HL + LD c,0 ; start offset at zero + +try_next_format: + LD a,e + CP (HL) + INC HL + JR NZ,not_last_match + LD a,d + CP (HL) + JR NZ,not_last_match +; +; match, set pointer +; + LD a,c ; get offset in A + PUSH AF + call save_dsk_window + POP AF + jr set_offset + +not_last_match: + INC HL ; each pointer uses two bytes + INC c ; advance the index + djnz try_next_format ; test for more, loop if so + + call save_dsk_window + + LD HL,(MFM_cur_ptr) +user_loop: + LD e,(HL) ; HL=(MFM_cur_ptr) + INC HL + LD d,(HL) + LD HL,22 ; offset to NAME field + ADD HL,DE ; point to Disk name + call dsk_window_old + +dsk_user_sel_wait: + call _kyscn + INC b ; test for key pressed + JR Z,dsk_user_sel_wait + DEC b ; adjust back + LD a,b ; move matrix position to A + CP SF_exit + JR NZ,CK_dsk_user_rt + + LD a,c + AND 4 ; control key down _ + JR Z,no_cntr_key ; no, don't lock this selection + LD a,80h ; yes, lock disk type to this drive +no_cntr_key: + LD (lock_flag),A ; + call dsk_window_remove + LD HL,(MFM_cur_ptr) + LD e,(HL) + INC HL + LD d,(HL) + EX DE,HL + jr set_this_entry + + page +; +; +; +CK_dsk_user_rt: + CP SF_right ; + JR NZ,CK_dsk_user_lf + +; move window down + LD A,(MFM_count) ; get number of items in list + LD b,a ; save in B + LD A,(MFM_offset) ; get current position + INC a ; advance position + CP b ; at last position _ (n-1+1 =count) + JR NZ,set_offset ; no, then use A as new position + XOR a ; yes, move back to start + jr set_offset + +CK_dsk_user_lf: + CP SF_left ; + JR NZ,dsk_user_sel_wait + +; move window up + LD A,(MFM_offset) + DEC a ; back up offset (under flow_) + JP P,set_offset ; result positive, jump + LD A,(MFM_count) ; get last item number + DEC a ; pointer is 0 to n-1 (not 1 to n) +set_offset: + LD (MFM_offset),A ; set new list offset + INC a ; add one to adjust for DCR below + LD HL,MFM_match_tbl ; set to the beginning + +adjust_dsk_loop: + LD (MFM_cur_ptr),HL ; set pointer here ! + DEC a ; at offset yet_ + JR Z,user_loop ; yes, go display name + INC HL + INC HL + jr adjust_dsk_loop + + page +; +; +; +tell_user_no_entry: + LD A,(vic_data) ; get disk test status + AND 0b0h ; save only sector size and MFM flag + LD HL,(DPH_pointer) + DEC HL + LD (HL),a ; set disk size and Type0 (MFM) + + LD HL,dsk_window*256+buff_pos + LD DE,no_dsk_msg +disp_msg_DE_HL: + call dsk_window_new +dsk_no_entry_wait: + call _kyscn + INC b + JR Z,dsk_no_entry_wait + DEC b + LD a,b + CP SF_exit + JR NZ,dsk_no_entry_wait +; jr dsk_window_remove + + page +; +; +; +dsk_window_remove: + LD HL,(window_info) + LD b,h + LD c,l + JP _recov +; +; +; +save_dsk_window: + LD HL,dsk_window*256+buff_pos ; H=size l=pos + LD (window_info),HL + LD b,h + LD c,l + JP _save +; +; +; +dsk_window_new: + LD (window_info),HL + EX DE,HL + LD b,d + LD c,e + PUSH HL + call _save + POP HL + +dsk_window_old: + LD A,(window_info) ; get start index + INC a + LD c,a ; place in C + +dsk_out_next: + PUSH HL + LD HL,(window_info) + LD a,h + ADD A,l ; compute max index (start+size) + DEC a ; ..less 1 + POP HL + CP c + RET Z + LD b,(HL) + call dsk_B_out + INC HL + jr dsk_out_next + +; +; +; +dsk_B_out: + LD a,01000000b ; set reverse video attr + PUSH BC + PUSH HL + call _stat ; display space + POP HL + POP BC ; recover count + INC c + ret + + page +; +; disk READ and WRITE entry points. +; These entries are called with the following arguments: +; relative drive number in @rdrv (8 bits) +; absolute drive number in @adrv (8 bits) +; disk transfer address in @dma (16 bits) +; disk transfer bank in @dbnk (8 bits) +; disk track address in @trk (16 bits) +; disk sector address in @sect (16 bits) +; pointer to XDPH in +; +; return with an error code in +; A=0 no errors +; A=1 non-recoverable error +; A=2 disk write protected +; A=FF media change detected +; + DSEG +read_154X: + call get_drv_info + JP M,mfm_rd + call set_up_GCR ; compute effective track and sector +login_rd: + LD A,(vic_drv) + LD b,a + LD A,(fast) ; get fast flags + AND b ; isolate fast bit for this drive + JR NZ,rd_fast ; go handle fast drive +rd_slow: + LD a,vicrd ; read a sector of data (A=1) + call dsk_fun ; a=0 if no errors + JP NZ,test_error ; check for disk error or media change +; +; +; +buf_move: + XOR a ; set direction to read + call _dkmov ; go move buffer to DMA + LD A,(sect_cnt) + AND a + RET Z ; a=0 means not read errors + call set_up_next + jr rd_slow + + page +; +; A=drive type info +; +mfm_rd: + call set_up_MFM + +rd_fast: + LD a,vic_rd_f + call dsk_fun ; go read the disk + + AND 0eh ; mask off error bits + JR NZ,test_error + + call get_sector_size + INC d + INC e ; adjust count for pre-decrement + + call _di_int + LD BC,0DD00h ; D2PRA + inp a ; get current clock polarity + XOR 10h ; toggle clk_bit + outp a ; to have status sent (extra clock + ; supplied by rd_1571_data for multi + ; sector transfers) + LD A,(vic_count) +rd_multi_sect: + PUSH AF + PUSH DE ; save the sector size + call rd_1571_data ; read disk data to DMA address + POP DE + + LD A,(vic_data) + AND 0eh + JR NZ,test_error_pop ; A=0 if no errors + POP AF + DEC a + JR NZ,rd_multi_sect + ei + LD A,(sect_cnt) + AND a ; any sectors left to read + JR Z,done_rd_1571 + + call set_up_next + jr rd_fast + +done_rd_1571: + LD BC,0DD00h ; D2PRA + inp a + AND not(10h) ; set clk_bit hi + outp a + XOR a ; A=0 for no errors + ret + + + page +; +; +; +write_154X: + call get_drv_info + JP M,mfm_wr + call set_up_GCR + LD A,(vic_drv) + LD b,a + LD A,(fast) ; get fast flags + AND b ; isolate fast bit for this drive + JR NZ,wr_fast_drive ; go handle fast drive +wr_slow: + LD a,-1 ; set direction to write + call _dkmov ; go move DMA to buffer + + LD a,vicwr ; write a sector of data + call dsk_fun ; a=0 if no errors + AND 0eh + JR NZ,test_error + LD A,(sect_cnt) + AND a + RET Z + call set_up_next + jr wr_slow + +test_error_pop: + POP AF +test_error: + ei + LD A,(vic_data) + AND 0fh ; check for disk error or media change + CP 0bh ; disk change _ + JR Z,change_error + CP 08h ; test for write protect error + JR Z,write_prot_error + + LD a,1 ; get general error flag + ret + +; +; +write_prot_error: + LD a,2 + ret + +; +; +change_error: + LD a,-1 + ret + + page +; +; +; +mfm_wr: + call set_up_MFM +wr_fast_drive: + LD a,vic_wr_f + call dsk_fun ; go send the write command + + call get_sector_size ; setup DMA adr and transfer count + LD A,(vic_count) +wr_multi_sect: + PUSH AF + PUSH DE ; save sector size + call wr_1571_data ; write data to disk from DMA address + POP DE + AND 0eh + JR NZ,test_error_pop + POP AF + DEC a + JR NZ,wr_multi_sect + + ei + LD A,(sect_cnt) + AND a + RET Z ; return if no errors (A=0) + call set_up_next + jr wr_fast_drive + + page +; +; +; +get_drv_info: + LD HL,(@dma) + LD (local_dma),HL + EX DE,HL + LD (DPH_pointer),HL + + LD A,(@adrv) ; get drive number (0 to F) + AND a + CALL Z,drive_A_E + CP 'E'-'A' ; test if drive E + CALL Z,drive_A_E + DEC HL ; point at drive mask + DEC HL + LD a,(HL) ; get drive mask + LD b,a ; save in B + LD (vic_drv),A ; save vic drive # (values 1,2,4,8) + + INC HL ; point at disk type + XOR a + LD (sect_cnt),A ; clear the count + INC a + LD (vic_count),A + LD a,(HL) ; get disk type + AND a + ret + +; +; drive A and E share the same physical disk drive (unit 8) +; +drive_A_E: + LD b,a + LD A,(curdrv) ; get the current drive def + CP b ; curdrv = requested drive _ + RET Z ; yes, return + ; no, tell the user to swap disk + PUSH HL + PUSH DE + PUSH BC +send_messg: + LD a,b ; get requested drive # to A + LD (curdrv),A ; make this the current drive + ADD A,'A' ; compute drive letter + LD (msg_drv),A + + RET CALL FR_bell ; ring BELL to alert user + LD HL,swap_msg_lng*256+buff_pos + LD DE,swap_msg + call disp_msg_DE_HL ; disp and wait for CR + + LD a,vic_test + call _fun65 +; ani 0fh +; cpi 0ch ; not fast ERROR _ +; jrz exit_drv_A_E ; yes, return that's not a problem +; ani 0eh ; other error type _ +; jrnz send_messg +exit_drv_A_E: + POP BC + POP DE + POP HL + LD a,b + ret + +swap_msg: DEFM "Insert Disk " +msg_drv: DEFM "X in Drive A" + +DEFC swap_msg_lng = _-swap_msg+2 ; +2 for leading and trailing spaces + + page +; +; +; +get_max_num_b: + LD HL,(DPH_pointer) + LD BC,42 ; offset to number of sectors on track + ADD HL,BC + LD a,(HL) ; get number sectors/track/side + AND 1fh + LD b,a + ret +; +; +; +get_sector_size: + LD HL,(DPH_pointer) + DEC HL + LD a,(HL) ; disk type in B (bit 5,4 size info) + RRCA ; ..00 = 080h byte sectors + RRCA ; ..01 = 100h byte sectors + RRCA ; ..10 = 200h byte sectors + RRCA ; ..11 = 400h byte sectors + AND 3 + JR Z,set_128 + JP PO,not_3 ; jump if (A=) 01b or 10b + INC a ; make A = 4 +not_3: + LD e,0 ; set E to zero + LD d,a ; set sector size (1,2 or 4) +get_DMA: + LD HL,(local_DMA) ; get the current DMA pointer + ret + +set_128: + LD DE,128 + jr get_DMA + + page +; +; +; + DSEG +set_up_GCR: + CP dsk_c128 + JP NZ,tst_next + + LD a,4 + LD (sect_cnt),A + LD HL,sect_buffer + LD (sect_buf_ptr),HL + + LD HL,(@trk) ; 1 K sector pointer + ADD HL,HL + ADD HL,HL ; make 256 byte pointer +; +; build a list of tracks and sectors +; +next_sect: + LD (@trk),HL + RET CALL FR_trk_sect + LD HL,(vic_trk) ; get trk(L) and sector(H) to HL + EX DE,HL + LD HL,(sect_buf_ptr) + LD (HL),e + INC HL + LD (HL),d + INC HL + LD (sect_buf_ptr),HL + LD HL,(@trk) + INC l ; update saved above at next_sect + LD a,l + AND 3 + JR NZ,next_sect +; +; check list of trk-sectors for number of sectors on this trk +; + LD HL,sect_buffer + LD (sect_buf_ptr),HL + LD A,(vic_drv) + LD b,a + LD A,(fast) + AND b ; drive type 1571 + JR Z,handle_1541 ; no, handle as 1541 + + LD A,(sect_cnt) ; number of sectors to rd/wr + LD b,a + INC HL + LD a,(HL) ; get 1st sector # + LD (vic_sect),A + DEC HL + LD a,(HL) ; get 1st track # + LD (vic_trk),A + +try_next: + CP (HL) ; test for same trk # + JR NZ,exit_no_match + INC HL + INC HL ; advance to next trk + LD (sect_buf_ptr),HL + djnz try_next + +exit_no_match: + LD A,(sect_cnt) ; number of sectors to rd/wr + sub b ; remove number left + ; (leaving number matched) + LD (vic_count),A ; save number to read + LD a,b ; get remaining count + LD (sect_cnt),A ; save remaining count + ret + + +set_up_next: + LD A,(vic_count) ; get number of sectors read + LD HL,(local_DMA) ; get current DMA pointer + ADD A,h ; advance pointer by number of + LD h,a ; sectors read + LD (local_DMA),HL +handle_1541: + LD HL,(sect_buf_ptr) + LD a,(HL) + LD (vic_trk),A + INC HL + LD a,(HL) + LD (vic_sect),A + INC HL + LD (sect_buf_ptr),HL + LD A,(vic_drv) + LD b,a + LD A,(fast) + AND b + JR Z,set_up_next_slow + LD A,(sect_cnt) + LD (vic_count),A + XOR a ; two reads max with fast drive + jr set_up_next_exit + +set_up_next_slow: + LD A,(sect_cnt) + DEC a +set_up_next_exit: + LD (sect_cnt),A + ret +; +; +; +tst_next: + if use_1581 + CP dsk_1581 + JR Z,c1581_adj + endif +tst_c64: + LD b,dir_track ; set the dir track number + CP dsk_c64 ; C64 type disk_ + LD A,(@sect) ; get sector # to set + JR Z,set_up_c64 ; yes, go set up for C64 CP/M disk format + ; no, set up as no type(direct addressing) +; +; This format is for direct track and sector addressing +; +do_type_7: + LD b,255 ; no dir sector +; +; this routine will adjust the track number if necessary. +; The C64 CP/M disk has the C64 directory in the center +; of the disk. This routine checks and adds one to the track +; number if we have reached or passed the directory track. +; +set_up_c64: + LD (VIC_sect),A ; + LD A,(@trk) ; + CP b ; carry=1 if A < dir_track + CCF ; add one if dir_track or more (carry not set) + ADC A,0 ; add the carry bit in + LD (vic_trk),A + ret + + if use_1581 +; +;****** adjust to read multi-512 byte sectors (system sees 1K sector size) +; +c1581_adj: + LD a,2 ; 2 512 byte sectors equ 1 1K sector + LD (vic_count),A + + LD A,(@trk) ; + CP C1581_dir_trk*2 ; carry=1 if A < dir_track + CCF ; add one if dir_track or more (carry not set) + ADC A,0 ; add the carry bit in + RRA ; track=0trk/2 ; carry set if odd + LD (vic_trk),A ; + + LD A,(@sect) ; sector # are 0 to 9 (10 sector/trk) + LD b,a ; + JR NC,bottom_1581 ; + ADD A,80h ; set top of 1581 +bottom_1581: + ADD A,b ; make 0 to 8 + INC a ; adjust to 1 to 9 (odd numbers only) + LD (VIC_sect),A ; + ret ; + + endif + + + page +; +; A=dsk_info on entry +; +set_up_MFM: + LD d,0 ; D=side # (0) + LD e,a ; save dsk_info in E + AND TypeX ; look at Type0 to Type7 + JR Z,do_type_0 ; + CP Type2 + LD A,(@trk) ; used by Type1, Type2 and Type3 + JR Z,do_type_2 + JR C,do_type_1 + +; cpi Type6 +; jrz do_type_6 +; jnc do_type_7 ; MSB of sector(byte) set for 2nd side of disk + + CP Type7 + JP Z,do_type_7 ; MSB of sector(byte) set for 2nd side of disk +; +; only types 0 to 2 and 7 are currenty defined +; Type3 to Type6 will do Type2 +;do_type_3: +;do_type_6: + +do_type_2: + LD b,a ; save a copy in B + SUB 40 + JR C,do_type_0 ; jump if still on side 0 + LD a,79 ; on back side count 39,38,37,...,0 + sub b +set_trk: + LD d,80h ; D=side # (1) + LD (@trk),A + jr do_type_0 + + page +; +; divide the track number by two and if Head=1 +; add #sect/side to @sect +; +do_type_1: + CCF ; carry was set clear it + RRA ; divide track by 2 (carry gets LSB) + LD (@trk),A + JR NC,do_type_0 + call get_max_num_b ; HL and C changed + LD A,(@sect) + ADD A,b + LD (@sect),A + +do_type_0: + LD A,(@trk) + LD (vic_trk),A + call get_max_num_b ; B=number of sectors per track per side + LD A,(@sect) ; ..HL and C changed + CP b + JR C,is_side_0 + LD d,80h ; D=side # (1) + bit C1_bit,e ; dsk_info in E + ; sector numbering continues on side 1 _ + JR NZ,is_side_0 ; yes, do not remove side one bias + sub b ; no, remove side one bias +is_side_0: + LD c,a ; hold 0sect in C + LD a,e ; get dsk_info to A + AND S1 ; A=Starting sector number (0 or 1) + ADD A,c ; add back 0sect + OR d ; add in the side bit + LD (vic_sect),A + ret + + page +; +; input: +; DE = number bytes to read +; HL = DMA address +; + CSEG +rd_1571_data: + LD A,(@dbnk) ; get the disk DMA bank + call _bank ; set it + + LD BC,0DC0Dh ; D1ICR +rd_1571_stat_wait: + inp a + AND 8 ; data ready bit set_ + JR Z,rd_1571_stat_wait ; no, loop + + LD c,0ch ; D1SDR + inp a ; read the status byte + LD (vic_data),A ; save it + AND 0eh ; any errors _ + JR NZ,rd_1571_exit ; yes, exit + + LD BC,0DD00h + inp a ; get current clock polarity + +rd_1571_next: + LD BC,0DD00h ; D2PRA + XOR 10h ; toggle clk_bit + outp a ; clock the 1571 for a byte + + DEC e ; DE=count + JP NZ,rd_1571_more ; leave as normal jump to keep + DEC d ; the transfer speed at it's max + JR Z,rd_1571_exit ; ... + +; +rd_1571_more: + DEC b +rd_1571_wait: + LD c,0dh ; D1ICR (DC0Dh) + inp c + bit 3,c + JP Z,rd_1571_wait + LD c,0ch ; D1SDR + ini ; (hl) <- (bc) ; hl <- hl+1 ; b <- b-1 + JP rd_1571_next + + +rd_1571_exit: + LD (bank_0),A ; restore current mem config + ret + + page + +DEFC clk_in = 40h +; +; input: +; DE = number of bytes to write +; HL = DMA address +; +wr_1571_data: + call _di_int +; do spout inline + LD BC,mode_reg + LD a,fast_wr_en + LD (io_0),A + outp a ; set data direction to output + LD (bank_0),A + + LD BC,0dc05h ; low (D1T1h) + XOR a + outp a + DEC c ; low(D1T1l) + LD a,3 ; clk = osc/3 + outp a ; + + LD c,0eh ; D1CRA + inp a + AND 80h + OR 55h + outp a + DEC c ; D1ICR + inp a + + LD A,(@dbnk) ; get the disk DMA bank + call _bank ; set it + + LD a,clk_in + LD (cur_clk),A + + page +; +; +clk_wait: + LD BC,0dd00h ; D2PRA + inp a + inp c ; debounce + CP c + JR NZ,clk_wait + + LD A,(cur_clk) ; get old clk value + XOR c ; check if changed + AND clk_in ; (only clock in bit) + JR Z,clk_wait ; loop if not + + LD a,c ; + LD (cur_clk),A ; make this the current clk value + LD BC,0dc0ch ; D1SDR + LD a,(HL) + outp a ; send character to drive + INC HL ; advance pointer + DEC DE ; dec the char count + + INC c ; D1ICR +send_wait: + inp a + AND 8 + JP Z,send_wait + + LD a,d + OR e + JP NZ,clk_wait ; go send the next byte + +; do spin + LD BC,0DC0Eh ; D1CRA + inp a + AND 80h + OR 8 + outp a + LD BC,mode_reg + LD a,fast_rd_en + LD (io_0),A ; enable the MMU + outp a ; set data direction to input + LD (bank_0),A ; disable MMU +; spin done + + page + + LD BC,0DC0Dh ; D1ICR + inp a ; clear data pending flag + + LD BC,0DD00h ; D2PRA + inp a + OR 10h ; set clk_bit low (hardware inverted) + outp a ; + + LD BC,0DC0Dh ; D1ICR +wait_status: + inp a + AND 8 + JR Z,wait_status + + LD BC,0DC0Ch ; D1SDR + inp d + + LD BC,0DD00h ; D2PRA + inp a + AND not(10h) ; set clk_bit hi (hardware inverted) + outp a ; + + LD a,d ; recover the status byte + LD (vic_data),A + + ei + ret + + page +; +; This routine is used to move a sector of data +; to/from the sector buffer and the DMA pointer. +; A=0 for buffer to DMA (disk read) +; A<>0 for DMA to buffer (disk write) +; + CSEG +_dkmov: + LD HL,(local_DMA) ; current DMA adr + LD DE,0buffer ; location of disk read/write buffer + LD BC,256 ; sector size +; +; +dk_cont: + OR a + JR NZ,dsk_read ; swap pointer for read + EX DE,HL +; +; +dsk_read: + LD A,(@dbnk) ; get the disk bank + call _bank + ldir ; do the data move + LD (bank_0),A ; current bank will ALWAYS be 0 + ret + +; +; +; + DSEG +dsk_fun: + LD (vic_cmd),A + LD A,(stat_enable) + AND 1 ; display of disk info enabled_ + CALL NZ,disp_dsk_info ; yes, go display disk info + JP _fun65+3 ; go do the function + + page +; +; +; + DSEG +_dskst: +disp_dsk_info: + LD a,72 ; r/w in col 72 (col 0-79) + LD (offset),A + LD A,(vic_cmd) + LD b,'R' + DEC a ; _1 normal_rd + JR Z,out_cmd_rd + DEC a ; _2 normal_wr + JR Z,out_cmd_wr + DEC a ; _3 fast_rd + JR Z,out_cmd_rd + DEC a ; _4 fast_wr + RET NZ +out_cmd_wr: + LD b,'W' +out_cmd_rd: + call disp_B + call disp_space + LD b,'A'-1 + LD A,(vic_drv) +next_drv: + INC b + RRCA + JR NC,next_drv + + call disp_B + LD A,(vic_trk) + call disp_dec + LD A,(vic_sect) + AND 80h + CALL Z,disp_space + LD b,'-' + CALL NZ,disp_B + LD A,(vic_sect) + AND 7fh + + page +; +; +; +disp_dec: + LD b,'0'-1 + +conv_loop: + INC b + SUB 10 + JR NC,conv_loop + + ADD A,'0'+10 + PUSH AF + call disp_B + POP AF +disp_A: + LD b,a +disp_B: + LD HL,0st40-72+40-8 + LD A,(offset) + LD e,a + LD d,0 + ADD HL,DE ; add the offset + LD (HL),b ; save on 40 col display + + LD a,e + LD c,a ; col # in C + INC a + LD (offset),A ; advance cursor position + XOR a ; no attribute to write + call _stat + + LD HL,0st40 + LD DE,vic_screen+40*24 ; update 40 column screen + LD BC,40 + ldir + XOR a + ret + +disp_space: + LD b,' ' + jr disp_B + + page +; +; Extended Disk Parameter Headers (XDPHs) +; + CSEG ; place tables in common +; +; 1st disk drive on the system +; + DEFW write_154X + DEFW read_154X + DEFW login_154X + DEFW init_154X + DEFM 1 ; bit 0 set (drive 0) + DEFM dsk_c128 ; format type byte +cmdsk0: + dph 0,dpb_0 + +dpb_0: + dpb 1024,5,159,2048,128,0 + DEFM 0 ; max sector number and lock flag + DEFW 0 ; MFM table pointer + + page +; +; 2nd disk Drive on the system +; + DEFW write_154X + DEFW read_154X + DEFW login_154X + DEFW init_154X + DEFM 2 ; bit 1 set (drive 1) + DEFM dsk_c128 ; format type byte +cmdsk1: + dph 0,dpb_1 + +dpb_1: + dpb 1024,5,159,2048,128,0 + DEFM 0 ; max sector number and lock flag + DEFW 0 ; MFM table pointer + + page +; +; 3rd disk drive on the system +; + DEFW write_154X + DEFW read_154X + DEFW login_154X + DEFW init_154X + DEFM 4 ; bit 2 set (drive 2) + DEFM dsk_c128 ; format type byte +cmdsk2: + dph 0,dpb_2 + +dpb_2: + dpb 1024,5,159,2048,128,0 + DEFM 0 ; max sector number and lock flag + DEFW 0 ; MFM table pointer + + page +; +; 4th disk drive on the system +; + DEFW write_154X + DEFW read_154X + DEFW login_154X + DEFW init_154X + DEFM 8 ; bit 3 set (drive 3) + DEFM dsk_c128 ; format type byte +cmdsk3: + dph 0,dpb_3 + +dpb_3: + dpb 1024,5,159,2048,128,0 + DEFM 0 ; max sector number and lock flag + DEFW 0 ; MFM table pointer + + page +; +; Drive E: shared with 1st drive (A:) +; + DEFW write_154X + DEFW read_154X + DEFW login_154X + DEFW init_154X + DEFM 1 ; bit 0 set (drive 0) + DEFM dsk_c128 ; format type byte +cmdsk4: + dph 0,dpb_4 + +dpb_4: + dpb 1024,5,159,2048,128,0 + DEFM 0 ; max sector number and lock flag + DEFW 0 ; MFM table pointer + + page +; +; NOTE: The blocking factor for all of these formats is +; 1K (2K for double sided), thus the fractional +; parts are unusable by CP/M. They can be accessed +; by absolute sector addressing. +; +; NOTE: 1571 and 1541 disk drives use track numbers +; of 1 to 35 and sector numbers of 0 to nn + +; +; The method used to access the full disk +; is to tell the system that there is 1 sector +; per track and then to use the track # as an +; absolute sector address and do conversion in BIOS. +; +; +; DPB FOR C128 CP/M 3.0 disk ( 170K, 34K larger then C64 CP/M) +; 256 byte sectors ( 170.75K ) +; 1 sectors/track +; up to 21 physical sectors (0 to 16,17,18 or 20) +; 680 tracks/disk (usable, 683 real) +; 35 physical tracks (0 to 34) +; 1K allocation blocks +; 64 directory entries +; track offset of 0 +; + DSEG ; these tables are moved to common when used +dpb_c128_SS: ; (170 allocation units) + dpb 1024,1,170,1024,64,0 + + page +; +; DPB FOR C128 CP/M 3.0 double sided disk ( 340K ) +; 1024 byte sectors (phy=256) ( 341.5K ) +; 1 sectors/track +; up to 21 physical sectors (0 to 16,17,18 or 20) +; 340 tracks/disk (usable, 1366 real) +; 70 physical tracks (0 to 34 side 0, 35 to 69 side 1) +; 2K allocation units +; 128 directory entrys +; track offset of 0 +; +dpb_c128_DS: ; (170 allocation units) + dpb 1024,1,340,2048,128,0 + + page +; +; DPB FOR C64 CP/M 2.2 disk -- ( 136K ) +; 256 byte sectors +; 17 sectors / tracks (sector numbering 0-16) +; sector 18 to n on the outer tracks are unused +; 34 tracks / disk +; tracks track 2 to 16 (track numbering 0-34) +; track 17 is the C128 directory track (not counted) +; track 19 to 34 +; 1K allocation blocks +; 64 directory entrys +; track offset of 3 (1st two tracks used for CP/M 2.2 boot) plus +; one sector to adjust for sector numbering of 1 to 35 (not 0 to 34) +; +dpb_c64_cpm: ; (144 allocation units) + dpb 256,17,34,1024,64,3 + + page +; +; DPB FOR C128 CP/M 3.0 C1581 DSDD (3.5") ( K ) +; 512 byte sectors ( 720K ) +; 10 sectors/track +; 159 tracks/disk +; 160 physical tracks 80 on top, 79 on bottom, 1 used for +; BAM and disk directory (1581 DOS) (10 sectors per track) +; 2K allocation units +; 128 directory entrys (2 allocation units) +; + if use_1581 +dpb_1581: ; (xxx allocation units) + dpb 1024,5,159,2048,128,0 + endif + + page +; + DSEG +MFM_table: + DEFM S256*2+(16*2-8)+1 ; 256 byte sect, 16 sect/trk + DEFM MFM+S256+Type0+C0+S1 ; DSDD + DEFW 0 ; start on track 2 sect 1 (2 alc) + dpb 256,32,40,2048,128,2 ; sect# 1 to 16 + DEFM 16 ; (top and bottom numbered the same) + DEFM "Epson QX10" ;1 Epson QX10 + ; 160 allocation units + + + + + DEFM 80h+S512*2+(10*2-8)+1 ; 512 byte sect, 10 sect/trk +; db S256*2 ; track 0 is 256 bytes/sector + DEFM MFM+S512+Type0+C0+S1 ; DSDD + DEFW 0 ; start on track 2 sect 1 (2 alc) + dpb 512,20,40,2048,128,2 ; sect# 1 to 10 + DEFM 10 ; (top and bottom numbered the same) + DEFM "Epson QX10" ;2 + ; 200 allocation units + + page + + DEFM S512*2+(8*2-8)+1 ; 512 byte sect 8 sect/trk + DEFM MFM+S512+Type2+C0+S1 ; SSDD + DEFW 0 ; start on track 1 sector 1 (2 alc) + dpb 512,8,40,1024,64,1 ; sect# 1 to 8 + DEFM 8 ; + DEFM " IBM-8 SS " ;3 + ; 160 allocation units + + + + + DEFM S512*2+(8*2-8)+1 ; 512 byte sect 8 sect/trk + DEFM MFM+S512+Type2+C0+S1 ; DSDD + DEFW 0 ; start on track 1 sector 1 (1 alc) + dpb 512,8,80,2048,64,1 ; sect# 1 to 8 + DEFM 8 ; (top and bottom numbered the same) + DEFM " IBM-8 DS " ;4 + ; 160 allocation units + + page + + DEFM S512*2+(10*2-8)+0 ; 512 byte sector, 10 sect/trk + DEFM MFM+S512+Type1+C1+S0 ; DSDD + DEFW 0 ; start on track 0 sector 10 (2 alc) + dpb 512,10,80,2048,128,1 ; sect# 0 to 9 on top (even tracks) + DEFM 10 ; sect# 10 to 19 on bottom (odd tracks) + DEFM "KayPro IV " ;5 + ; 200 allocation units + + + + + DEFM S512*2+(10*2-8)+0 ; 512 byte sect, 10 sect/trk + DEFM MFM+S512+Type0+C1+S0 ; SSDD + DEFW 0 ; start on track 1 sector 0 (4 alc) + dpb 512,10,40,1024,64,1 ; sect# 0 to 9 + DEFM 10 ; + DEFM "KayPro II " ;6 + ; 200 allocation units + + page + + DEFM S1024*2+(5*2-8)+1 ; 1024 byte sect, 5 sect/trk + DEFM MFM+S1024+Type0+C0+S1 ; SSDD + DEFW 0 ; start on track 3 sector 1 (2 alc) + dpb 1024,5,40,1024,64,3 ; sect# 1 to 5 + DEFM 5 ; + DEFM "Osborne DD" ;7 + ; 200 allocation units + + + DEFM S512*2+(9*2-8)+1 ; 512 byte sect 9 sect/track (uses 8) + DEFM MFM+S512+Type1+C0+S1 ; DSDD + DEFW 0 ; start on trk 0, sect 1, hd 1 (1 alc) + dpb 512,8,80,2048,64,1 ; sect# 1 to 9 + DEFM 8 ; (top and bottom numbered the same) + DEFM " Slicer " ;8 + ; 160 allocation units + + page + + DEFM S256*2+(16*2-8)+1 ; 256 byte sect, 16 sect/trk + DEFM MFM+S256+Type0+C0+S1 ; DSDD + DEFW 0 ; start on track 4 sect 1 (2 alc) + dpb 256,32,40,2048,128,4 ; sect# 1 to 16 + DEFM 16 ; (top and bottom numbered the same) + DEFM "Epson Euro" ;9 Epson European (MFCP/M _) + ; 160 allocation units + + + + DEFM -1 + DEFM MFM ; + DEFW 0 ; + dpb 512,20,40,2048,128,2 ; + DEFM 8 ; + DEFM " None " ;10 + + page + + DEFM -1 + DEFM MFM ; + DEFW 0 ; + dpb 512,20,40,2048,128,2 ; + DEFM 8 ; + DEFM " None " ;11 + + DEFM -1 + DEFM MFM ; + DEFW 0 ; + dpb 512,20,40,2048,128,2 ; + DEFM 8 ; + DEFM " None " ;12 + + page + + DEFM -1 + DEFM MFM ; + DEFW 0 ; + dpb 512,20,40,2048,128,2 ; + DEFM 8 ; + DEFM " None " ;13 + + DEFM -1 + DEFM MFM ; + DEFW 0 ; + dpb 512,20,40,2048,128,2 ; + DEFM 8 ; + DEFM " None " ;14 + + page + + DEFM -1 + DEFM MFM ; + DEFW 0 ; + dpb 512,20,40,2048,128,2 ; + DEFM 8 ; + DEFM " None " ;15 + + DEFM -1 + DEFM MFM ; + DEFW 0 ; + dpb 512,20,40,2048,128,2 ; + DEFM 8 ; + DEFM " None " ;16 + + + page +; +; not functional yet +; + +; db S1024*2+(5*2-8)+1 ; 1024 byte sect 5 sect/track +; db MFM+S1024+Type0+C0+S1 ; SSDD +; dw 0 ; start on trk 2, sect 1 (2 alc) +; dpb 1024,5,40,2048,128,2 ; sect# 1 to 5 +; db 5 ; +; db 'Morrow MD2' ; + + + + + +; db S1024*2+(5*2-8)+1 ; 1024 byte sect 5 sect/trk +; db MFM+S1024+Type0+C0+S1 ; DSDD +; dw 0 ; start on trk 1, sect 1, hd 0 (3 alc) +; dpb 1024,10,40,2048,192,1 ; sect# 1 to 5 +; db 5 ; +; db 'Morrow MD3' ; + + +DEFC MFM_tbl_entries = (_-MFM_table)/32 + + DEFM -1 ; mark end of table + DEFM -1 + + page + + cseg +cur_clk: DEFS 1 + + dseg +lock_flag DEFS 1 +last_match DEFS 2 +window_info: DEFS 2 + +DEFC dsk_window = 12 + +no_dsk_msg: + ;1234567890 + DEFM " Missing " + + +MFM_match_tbl: + DEFS 2*MFM_tbl_entries ; MFM_count MUST follow this parm +MFM_count: + DEFS 1 ; MFM_offset MUST follow this parm +MFM_offset: + DEFS 1 + +MFM_cur_ptr: + DEFS 2 + +DPH_pointer: + DEFS 2 + +sect_cnt: + DEFS 1 +sect_buf_ptr: + DEFS 2 +sect_buffer: + DEFS 4*2 + +local_DMA: + DEFS 2 + +DEFC status_atr = 0 +offset: DEFM 0 + + end diff --git a/tests/restricted/cxequ.asm b/tests/restricted/cxequ.asm new file mode 100644 index 00000000..45fd2d58 --- /dev/null +++ b/tests/restricted/cxequ.asm @@ -0,0 +1,661 @@ +; 06-2018: Converted to z80 mnemonics with toz80.awk +;Commodore 128 CP/M v3.0 +;General macro definitions and equates + +_*MACRO + +DEFC false = 0 +DEFC true = not + +DEFC use_fast = false +DEFC use_6551 = false ;true + +DEFC use_vt100 = false +DEFC use_1581 = true +DEFC banked = true +DEFC EXTSYS = false ; use external system as disk and char I/O +DEFC pre_release = false + +; start at Jan 1,1978 78 79 80 81 82 83 84 85 86 +DEFC dt_hx_yr = 365+365+366+365+365+365+366+365+365 +; 1985 1 2 3 4 5 6 7 8 9 10 11 12 +DEFC date_hex = dt_hx_yr+31+28+31+30+28 + +date macro + DEFM "28 May 87" + endm +; +; this is only for Pre-Released versions (done in RED) +; +warning macro + if pre_release + DEFM cr,lf,lf + DEFM esc,esc,esc,red+20h + DEFM "User Beware:",cr,lf + ;1234567890123456789012345678901234567890 + DEFM " This version of the software is a",cr,lf + DEFM " PRE-RELEASE for testing only. It has",cr,lf + DEFM " been tested but has not yet passed QA.",cr,lf + DEFM esc,esc,esc,purple+50h + endif + endm + + +space macro _x,for +DEFC _x = start +start set start+for + endm + +; +; boot memory map (bank 0 only) +; +DEFC bios02 = 3000h ; +DEFC block_buffer = 3400h ; uses 2K +DEFC boot_parm = 3C00h ; uses about 256 bytes +; +; bank 0 low memory map +; +DEFC ROM = 0000h +DEFC VIC_color = 1000h ; I/O page only (IO_0 selected) +DEFC SYS_key_area = 1000h ; 3 256 byte blocks (allow 4) +DEFC screen_40 = 1400h ; 2 X 80 X 25 = 4000 +DEFC BANK_parm_blk = 2400h ; allow 0.5K of parameters +DEFC BIOS8502 = 2600h ; 1.5K +DEFC VIC_screen = 2C00h ; 1K +DEFC ccp_buffer = 3000h ; 0c80h (allow 4K) +DEFC bank0_free = 4000h ; start of free area in bank 0 +; +; mapped I/O locations +; +DEFC VIC = 0D000h ; 8564 +DEFC SID = 0D400h ; 6581 +DEFC MMU = 0D500h ; 8722 +DEFC DS8563 = 0D600h ; 8563 +DEFC INT_6551 = 0D700h ; 6551 (added to enginnerring units) +DEFC VIC_C_H = 0D800h ; (memory mapped only in IO_0) +DEFC VIC_C_L = 01000h ; (memory and i/o mapped in IO_0) +DEFC CIA1 = 0DC00h ; 6526 +DEFC CIA2 = 0DD00h ; 6526 +DEFC USART = 0DE00h ; 6551 (extrn card) +DEFC RAM_dsk_base = 0DF00h ; 8726 + +; +; Common memory allocation +; +DEFC int_block = 0FC00h ; mode 2 interrupt pointers (to FDFDh) +DEFC parm_block = 0FD00h ; system parameters +DEFC @buffer = 0FE00h ; disk buffer (256 bytes) +; 0FF00h ; to 0FFFFh used by 8502 +; +; the following are C128 system equates +; +DEFC enable_z80 = 0FFD0h ; 8502 code +DEFC return_z80 = 0FFDCh +DEFC enable_6502 = 0FFE0h ; Z80 code +DEFC return_6502 = 0FFEEh + + page +start set parm_block+1 ; 1st byte used as Intterrupt pointer +space vic_cmd,1 ;; bios8502 command byte +space vic_drv,1 ; bios8502 drive (bit 0 set, drv 0) +space vic_trk,1 ;; bios8502 track # +space vic_sect,1 ;; bios8502 sector # +space vic_count,1 ; bios8502 sector count +space vic_data,1 ;; bios8502 data byte to/from +space cur_drv,1 ; current disk installed to Vir. drive +space fast,1 ; bit 0 set, drv 0 is fast. ect. + +space key_tbl,2 ;; pointer to keyboard table +space fun_tbl,2 ;; pointer to function table +space color_tbl_ptr,2 ;; pointer to logical color table +space fun_offset,1 ;; function # to be preformed +space sound_1,2 ;; +space sound_2,2 ;; +space sound_3,2 ;; + +space @trk,2 ;; current track number +space @dma,2 ;; current DMA address +; +; below here not used by ROM +; +space @sect,2 ; current sector number +space @cnt,1 ; record count for multisector transfer +space @cbnk,1 ; bank for processor operations +space @dbnk,1 ; bank for DMA operations +space @adrv,1 ; currently selected disk drive +space @rdrv,1 ; controller relative disk drive +space sys_speed,0 ; byte value 0=1MHz, 1=2 MHz (no 40 column disp) +space ccp_count,1 ; number of records in the CCP (not used) +space stat_enable,1 ; status line enable + ; 7 kybrd, key codes(1), functions(0) + ; 6 40 column tracking on(0), off(1) + ; 0 disk stat, enable(1), disable(0) +space emulation_adr,2 ; address of current emulation +space usart_adr,2 ; PTR to 6551 reg (not used before 6 Dec 85) +; CXIO equates +space int_hl,2+20 ; interrupt HL hold location +space int_stack,0 ; currently only 10*2 used +space user_hl_temp,2 ; user function HL hold location +space hl_temp,2 ; misc temp storage (used by VECTOR) +space de_temp,2 ; misc temp storage (used by VECTOR) +space a_temp,1 ; misc temp storage (used by VECTOR) +space source_bnk,1 ; inter bank move source bank # +space dest_bnk,1 ; inter bank move dest bank # +space MFM_tbl_ptr,2 ; pointer to MFM table +; 1st release end (3 June and 1 Aug 85) +space prt_conv_1,2 ; pointer to printer 1 ASCII Conversion +space prt_conv_2,2 ; pointer to printer 2 ASCII Conversion +space key_FX_function,2 +space XxD_config,1 ; bit 7 0 = no parity 1 = parity + ; bit 6 0 = mark/space 1 = odd/even + ; bit 5 0 = space/even 1 = mark/odd + ; bit 1 0 = 1 stop bit 1 = 2 stop bits + ; bit 0 0 = 7 data bits 1 = 8 data bits + +space RS232_status,1 ; bit 7, 1=send data, 0=no data + ; bit 6, 1=sending data + ; bit 5, 1=recv que active + ; bit 4, 1=parity error + ; bit 3, 1=framing error + ; bit 2, 1=recv over run (no used) + ; bit 1, 1=receiving data + ; bit 0, 1=Data byte ready + +space xmit_data,1 ; data byte to send +space recv_data,1 ; received data byte + +; +; The following equates are used by the interrupt driven keyboard handler +; +space int_rate,1 +; +; 1st byte is a pointer into table, 2nd to 12th byte represent +; the keyboards current state (active low), NOTE: only +; current if key_buffer is not full +; +space key_scan_tbl,12 +; +; keyboard roll over buffer +; +DEFC key_buf_size = 8*2 ; must be an even number of bytes +space key_get_ptr,2 +space key_put_ptr,2 +space key_buffer,key_buf_size +; +; software UART recv buffer +; +DEFC RxD_buf_size = 64 +space RxD_buf_count,1 +space RxD_buf_put,1 +space RxD_buf_get,1 +space RxD_buffer,RxD_buf_size +space tick_vol,1 + +DEFC INT_vector = 0FDFDh ;; contains a JMP int_handler + ; (in common) + page +;===> 40 column misc parm +start set BANK_parm_blk +space temp_1,2 ;; +space @off40,0 ;; +space cur_offset,2 ;; +space old_offset,1 ;; +space prt_flg,1 ;; +space flash_pos,2 ;; +; +;===> 40 column position and color storage +space paint_size,1 ;; +space char_adr_40,2 ;; +space char_col_40,1 ;; +space char_row_40,1 ;; +space attr_40,1 ;; +space bg_color_40,1 ;; +space bd_color_40,1 ;; +space rev_40,1 ;; +; +;===> 80 column position and color storage +space char_adr,2 ;; +space char_col,1 ;; +space char_row,1 ;; +space current_atr,1 ;; +space bg_color_80,1 ;; +space char_color_80,1 ;; +; ROM uses localtions above this point +; +;===> Emulation parameters +space parm_base,2 +space parm_area_80,3 + ; ds 2 ; 80 column exec_adr + ; ds 1 ; 80 column row # +space parm_area_40,3 + ; ds 2 ; 40 column exec_adr + ; ds 1 ; 40 column row # +space buffer_80_col,40*2 +; +;===> CXIO parameters +; int_count not used by releases past 10 Oct 85 +space int_count,1 ; one added every 1/60th sec +space key_buf,1 +; +;===> CXKEYS parameters +space key_down_tbl,11*2 ; not used any more (int code) +;;;;; free space above, new interrupt driven code does not require this space +; control_keys equ key_down_tbl+11*2 ; byte, not used any more (int code) + +space commodore_mode,1 +space msgptr,2 +space offset,1 +space cur_pos,1 +space string_index,1 +; 1st release end (3 June 85) +space sys_freq,1 ; -1=50Hz, 0=60Hz +; 2nd release end (1 Aug 85) + + page + +;===> temp ROM boot data storage +DEFC blk_ptr_cnt = 32 +start set boot_parm +space load_count,2 ; number of 128 byte blocks to load +space ld_blk_ptr,2 ; current sector dma pointer +space blk_unld_ptr,2 ; read memory block (1k,2K) pointer +space block_size,1 ; block size (1K=32 or 2K=64) +space block_end,2 ; allow 48K cpm.sys to load +space block_ptrs,blk_ptr_cnt ; end of block load buffer (+1K or +2K) +space info_buffer,12 + ; CPM3.sys load adr's and counts +space ext_num,1 ; CPM3.SYS current ext # +space retry,1+64 +space boot_stack,0 ; allow 64 bytes of stack + +;===> special equates used by CXKEY +DEFC special = 00010111b +DEFC SF_exit = 001h ; RETURN KEY +DEFC SF_insert = 028h ; PLUS KEY +DEFC SF_delete = 02Bh ; MINUS KEY +DEFC alpha_toggle = 03Dh ; commodore key +DEFC alt_key = 050h ; alterant key +DEFC SF_left = 055h ; left arrow key +DEFC lf_arrow = 055h ; left arrow key +DEFC SF_right = 056h ; right arrow key +DEFC rt_arrow = 056h ; right arrow key + + +DEFC buff_large = 25 +DEFC buff_small = 7 +DEFC buff_pos = 7 + + + page +;===> External RS232 interface controls +; rxd_6551 equ 0 ; read +; txd_6551 equ 0 ; write +; status_6551 equ 1 ; read +; reset_6551 equ 1 ; write +; command_6551 equ 2 ; read/write +; control_6551 equ 3 ; read/write + +DEFC txrdy = 10h +DEFC rxrdy = 08h +DEFC cmd_init = 0bh ; no parity, enable txd + rxd, interrupts off +DEFC cntr_init_19200 = 1Fh ; 1 stop, 8 bits, 19200 baud +DEFC cntr_init_9600 = 1Eh ; 1 stop, 8 bits, 9600 baud (internal) +DEFC cntr_init_600 = 17h ; 600 baud + +;===> memory management loactions +DEFC mmu_start = MMU +DEFC conf_reg = MMU ; 3eh +DEFC conf_reg_1 = MMU+1 ; 3fh +DEFC conf_reg_2 = MMU+2 ; 7fh +DEFC conf_reg_3 = MMU+3 ; 3eh +DEFC conf_reg_4 = MMU+4 ; 7eh +DEFC mode_reg = MMU+5 ; b1h +DEFC ram_reg = MMU+6 ; 0bh 16K top Common +DEFC page_0_l = MMU+7 ; 00h +DEFC page_0_h = MMU+8 ; 01h +DEFC page_1_l = MMU+9 ; 01h +DEFC page_1_h = MMU+10 ; 01h +DEFC mmu_version = MMU+11 ; __h + +DEFC enable_C64 = 11110001b ; FS=0 +DEFC z80_off = 10110001b ; value to be write to enable 8502 +DEFC z80_on = 10110000b +DEFC fast_rd_en = Z80_on+0 ; fast serial read +DEFC fast_wr_en = Z80_on+8 ; fast serial write +DEFC common_4K = 09h ; top 4K common +DEFC common_8K = 0ah ; top 8K common +DEFC common_16K = 0bh ; top 16K common + +;===> preconfiguration maps +DEFC force_map = 0ff00h +DEFC bank_0 = 0ff01h ; 3fh +DEFC bank_1 = 0ff02h ; 7fh +DEFC io = 0ff03h ; 3eh +DEFC io_0 = 0ff03h ; 3eh +DEFC io_1 = 0ff04h ; 7eh + + page +;===> 80 column display equates +DEFC DS_index_reg = DS8563 +DEFC DS_status_reg = DS8563 +DEFC DS_data_reg = DS8563+1 +;===> register pointers +DEFC DS_cursor_high = 14 +DEFC DS_cursor_low = 15 +DEFC DS_rw_ptr_high = 18 +DEFC DS_rw_ptr_low = 19 +DEFC DS_rw_data = 31 +DEFC DS_color = 26 +;===> status bits +DEFC DS_ready = 80h +DEFC DS_lt_pen = 40h +;===> display memory layout (16K) 0-3fffh +DEFC DS_screen = 0000h +DEFC DS_attribute = 0800h +DEFC DS_char_def = 2000h +; +;===> VIC equates (8564) +; +DEFC VIC_blk = VIC+17 ; bit 4 = 1 for screen on +DEFC VIC_blk_msk = 00010000b ; + +DEFC VIC_key_row = VIC+47 ; output + +DEFC VIC_speed = VIC+48 ; bit 0 = 1 for fast +DEFC VIC_speed_msk = 00000001b ; + +; vic colors +DEFC black = 0 +DEFC white = 1 +DEFC red = 2 +DEFC cyan = 3 +DEFC purple = 4 +DEFC green = 5 +DEFC blue = 6 +DEFC yellow = 7 +DEFC orange = 8 +DEFC brown = 9 +DEFC lt_red = 10 +DEFC dark_grey = 11 +DEFC med_gray = 12 +DEFC lt_green = 13 +DEFC lt_blue = 14 +DEFC lt_grey = 15 + + page +DEFC RM_status = RAM_dsk_base ;read only register +; bit 7 Interrupt pending if 1 +; 6 Transfer complete if 1 +; 5 Block verify error if 1 +; note: bits 5-7 are cleared when read +; 4 128K if 0, 512K if 1 +; 3-0 Version # +; +DEFC RM_command = RAM_dsk_base+1 ;r/w +; bit 7 execute per current config. if set +; 6 reserved +; 5 enable auto reload if set (restores all register to +; value before command was done, else point to +; next byte to read/write.) +; 4 disable FF00 decode if set (do operation after command writen) +; 3,2 reserved +; 1,0 00 = transfer C128 --> Ram Disk +; 01 = Transfer C128 <-- Ram Disk +; 10 = swap C128 <-> Ram Disk +; 11 = Verify C128 = Ram Disk +; +DEFC RM_128_low = RAM_dsk_base+2 ;r/w +; bits 0 to 7 of C128 address +; +DEFC RM_128_mid = RAM_dsk_base+3 ;r/w +; bits 8 to 15 of the C128 address +; +DEFC RM_ext_low = RAM_dsk_base+4 ;r/w +; bits 0 to 7 of Ram Disk address +; +DEFC RM_ext_mid = RAM_dsk_base+5 ;r/w +; bits 8 to 15 of Ram Disk address +; +DEFC RM_ext_hi = RAM_dsk_base+6 ;r/w +; bit 16 of Ram Disk address if 128K version +; bits 16 to 18 of Ram Disk address if 512K version +; +DEFC RM_count_low = RAM_dsk_base+7 ;r/w +; low byte transfer count (bits 0-7) +; +DEFC RM_count_hi = RAM_dsk_base+8 ;r/w +; hi byte transfer count (bits 8-15) +; +DEFC RM_intr_mask = RAM_dsk_base+9 ;r/w +; bit 7 1=enable chip interrupts +; 6 1=enable end of block interrupts +; 5 1=enable verify error interrupts +; +DEFC RM_control = RAM_dsk_base+10 ;r/w +; bit 7,6 00 Increment both addresses (default) +; 01 Fix expansion address +; 10 Fix C128 address +; 11 Fix both addresses +; + + page +;===> CIA equates + +DEFC Data_a = 00h +DEFC Data_b = 01h +DEFC Data_dir_a = 02h +DEFC Data_dir_b = 03h +DEFC timer_a_low = 04h +DEFC timer_a_high = 05h +DEFC timer_b_low = 06h +DEFC timer_b_high = 07h +DEFC tod_sec_60 = 08h +DEFC tod_sec = 09h +DEFC tod_min = 0ah +DEFC tod_hrs = 0bh +DEFC sync_data = 0ch +DEFC int_ctrl = 0dh +DEFC cia_ctrl_a = 0eh +DEFC cia_ctrl_b = 0fh +DEFC CIA_hours = CIA1+tod_hrs + +DEFC key_row = CIA1+Data_a ; output +DEFC key_col = CIA1+Data_b ; input + + +DEFC data_hi = 4 ; RS232 data line HI +DEFC data_low = 0 ; RS232 data line LOW + +DEFC lf_shift_key = 80h +DEFC rt_shift_key = 10h +DEFC commodore_key = 20h +DEFC control_key = 04h + +DEFC type_lower = 0 +DEFC type_upper = 1 +DEFC type_shift = 2 +DEFC type_cntrl = 3 +DEFC type_field = 00000011b + + page + +DEFC bnk1 = 1 +DEFC page0 = 0 +DEFC page1 = 1 + +MMU_tbl_M macro + DEFM 3fh,3fh,7fh,3eh,7eh ; config reg"s + DEFM z80_on,common_8K ; mode & mem + DEFM page0,bnk1,page1,bnk1 ; page reg"s + endm + + page +; +; ROM functions +; +TJMP macro x + rst 10h ! db x + endm + +TCALL macro x + LD l,x ! rst 4 + endm + +RJMP macro x + rst 18h ! db x + endm + +RCALL macro x + LD l,x ! rst 5 + endm + +DEFC FR_40 = 2 ; offset to 40 column ROM functions + +DEFC FR_wr_char = 00h ; D=char auto advance +DEFC FR_cursor_pos = 04h ; B=row, C=column +DEFC FR_cursor_up = 08h +DEFC FR_cursor_down = 0Ch +DEFC FR_cursor_left = 10h +DEFC FR_cursor_rt = 14h +DEFC FR_do_cr = 18h +DEFC FR_CEL = 1Ch +DEFC FR_CES = 20h +DEFC FR_char_ins = 24h +DEFC FR_char_del = 28h +DEFC FR_line_ins = 2Ch +DEFC FR_line_del = 30h +DEFC FR_color = 34h ; B=color +DEFC FR_attr = 38h ; B=bit to set/clear, C=bit value +DEFC FR_rd_chr_atr = 3Ch ; in D=row, E=col + ; out H=row, L=col, B=char, C=attr(real) +DEFC FR_wr_chr_atr = 40h ; in D=row, E=col, B=char, C=attr(real) + ; out H=row, L=col +DEFC FR_rd_color = 44h +;FR_wr_color equ 48h +; equ 4Ch + + page +; +DEFC FR_trk_sect = 50h +DEFC FR_check_CBM = 52h +DEFC FR_bell = 54h +; equ 56h +; equ 58h +; equ 5Ah +; equ 5Ch +; equ 5Eh + +DEFC FR_trk_40 = 60h +DEFC FR_set_cur_40 = 62h +DEFC FR_line_paint = 64h +DEFC FR_screen_paint = 66h +DEFC FR_prt_msg_both = 68h +DEFC FR_prt_de_both = 6Ah +DEFC FR_update_it = 6Ch +; equ 6Eh + +DEFC FR_ASCII_to_pet = 70h +DEFC FR_cur_adr_40 = 72h +DEFC FR_cur_adr_80 = 74h +DEFC FR_look_color = 76h +; equ 78h +DEFC FR_blk_fill = 7Ah ; HL passed on the stack +DEFC FR_blk_move = 7Ch ; " +DEFC FR_char_inst = 7Eh ; " + +; +; fixed ROM locations +; +DEFC R_cmp_hl_de = 100h-6 +DEFC R_write_memory = 180h+0 +DEFC R_read_memory = 180h+3 +DEFC R_set_update_adr = 180h+6 +DEFC R_wait = 180h+9 + +DEFC R_status_color_tbl = 1000h-246-16 +DEFC R_color_convert_tbl = 1000h-230-16 + + page +; +; Disk type byte definition +; +; bit 7 0=GCR, 1=MFM +; +; if bit 7 is 1 (MFM) +; 6 C0=0, C1=1 (side 2 #, 0 to (n/2)-1 or n/2 to n-1) +; 5,4 00=128, 01=256, 10=512, 11=1024 byte/sector +; 3,2,1 disk type (MFM) +; 0 starting sector # ( 0 or 1) +; +; if bit 7 is 0 (GCR) +; 6 unused (set to 0) +; 5,4 01 (256 byte sectors) (for 1541or 1571) +; 10 (512 byte sectors) (for 1581) +; 3,2,1 disk type (GCR) +; Type0 = none, set track and sector as passed +; Type1 = C64 CP/M type disk (1541-71) +; Type2 = C128 CP/M type disk (1541-71) +; 0 unused (set to 0) + +DEFC MFM = 1*128 +DEFC C0 = 0*64 ; 2nd side start at begining +DEFC C1 = 1*64 ; 2nd side continues from first +DEFC C1_bit = 6 + +DEFC Type0 = 0*2 ; (MFM) top, bottom then next track + ; (TRK# 0 to (34 or 39)) +DEFC Type1 = 1*2 ; (MFM) top (trk 0 even), bottom (trk 1 odd) + ; (TRK# 0 to (69 or 79)) +DEFC Type2 = 2*2 ; (MFM) top TRK# 0 to 39, bottom TRK# 40 to 79 + ; (TRK# on back start at 39 and go to 0) +DEFC Type7 = 7*2 ; (MFM) pass the byte values supplied in @trk + ; and @sect + +DEFC TypeX = 7*2 + +DEFC S0 = 0*1 ; start at sector 0 +DEFC S1 = 1*1 ; start at sector 1 + +DEFC S128 = 0*16 +DEFC S256 = 1*16 +DEFC S512 = 2*16 +DEFC S1024 = 3*16 + +; +DEFC dsk_none = Type0+S256 ; access to any sector on the disk +DEFC dsk_c64 = Type1+S256 +DEFC dsk_c128 = Type2+S256 +DEFC dsk_1581 = Type2+S512 + +DEFC dir_track = 18 ; C64 disk dir track +DEFC c1581_dir_trk = 39 ; C1581 disk dir track + + page +; +; 6510 commands +; +DEFC vic_reset = -1 ; reboot C128 +DEFC vic_init = 0 ; initilize the bios8502 +DEFC vic_rd = 1 ; read one sector of data (256 bytes) +DEFC vic_wr = 2 ; write one sector of data +DEFC vic_rdF = 3 ; set-up for fast read (many sectors) +DEFC vic_wrF = 4 ; set-up for fast write +DEFC vic_test = 5 ; test current disk in drive +DEFC vic_query = 6 ; get start sectors and #sector/trk +DEFC vic_prt = 7 ; print data character +DEFC vic_frmt = 8 ; format a disk (1541) +DEFC vic_user_fun = 9 +DEFC vic_RM_rd = 10 ; RAM disk read +DEFC vic_RM_wr = 11 ; RAM disk write + +; +; control charactors +; +DEFC eom = 00h +DEFC bell = 07h +DEFC bs = 08h +DEFC lf = 0ah +DEFC cr = 0dh +DEFC xon = 11h +DEFC xoff = 13h +DEFC esc = 1bh diff --git a/tests/restricted/cxext.asm b/tests/restricted/cxext.asm new file mode 100644 index 00000000..b3b15593 --- /dev/null +++ b/tests/restricted/cxext.asm @@ -0,0 +1,577 @@ +; 06-2018: Converted to z80 mnemonics with toz80.awk +; +; + title 'C128 external Disk drive support 28 Apr 86' + +; +; This program contains the stubs for bringing up the C128 CP/M +; for the first time. +; +; The method used to stub the system I/O is to send the +; operation request to the serial port as a command and +; recieve responce from the serial channel. +; +; The commands supported are: +; +; CMD: 'I' ; input keyboard char +; RSP: xx ; returns keybord char or 00 if none +; +; CMD 'O'xx ; send char xx to display +; RSP: xx ; echo character +; +; CMD: Rttss ; read sector of data adr by track (tt) sector (ss) +; RSP: xx..yy ; returns 128 bytes of data plus a check sum +; +; CMD: Wttssxx..yy ; write sector of data, sent with a check sum +; ; to (xx..yy) adr by track (tt) sector (ss) +; RSP: xx ; xx=00 if no error +; + page + + maclib cpm3 + + maclib z80 + + maclib cxequ + + + + public _int65,_in65,_ins65,_out65,_outs65 + extrn _intbd + +; Utility routines in standard BIOS + extrn _pmsg ; print message @ up to 00 + ; saves & + extrn _pdec ; print binary number in from 0 to 99. + extrn _pderr ; print BIOS disk error header + extrn _conin,_cono ; con in and out + extrn _const ; get console status + +; +; drive table +; + public @dtbl + extrn cmdsk0,cmdsk1,cmdsk2,cmdsk3,cmdsk4,RMdsk + + page +; +; DRVTBL.ASM +; + CSEG ; place code in common memory + +@dtbl: + DEFW cmdsk0 ;* drive A 1541/1571 + DEFW cmdsk1 ;* drive B 1541/1571 + DEFW cmdsk2 ;* drive C 1541/1571 + DEFW cmdsk3 ;* drive D 1541/1571 + DEFW cmdsk4 ;* drive E shares drive A + DEFW 0 ;* drive F + DEFW 0 ;* drive G + if EXTSYS + DEFW 0fdsd0 ;* drive H (external RS232) + else + DEFW 0 ;* drive H + endif + DEFW 0 ;* drive I + DEFW 0 ;* drive J + DEFW 0 ;* drive K + DEFW 0 ;* drive L + DEFW RMdsk ;* drive M Memory Disk (RAM disk) + DEFW 0 ;* drive N + DEFW 0 ;* drive O + DEFW 0 ;* drive P + + + if EXTSYS + CSEG +; +; Extended Disk Parameter Headers (XPDHs) +; + DEFW fd_write + DEFW fd_read + DEFW fd_login + DEFW fd_init + DEFM 0 ; relative drive zero + DEFM 0 ; format type byte +@fdsd0: + dph sk128sssd,dpb_8_sssd + + +; +; DPB FOR 8 IBM 3740 format ( 243K ) +; +dpb_8_sssd: dpb 128,26,77,1024,64,2 + +sk128sssd: + skew 26,6,1 + + + + + page +; +; send an illegial command, should get a period back, meaning +; that the the command was bad. at this point extrnal system +; is ready to receive a valid command. +; + CSEG +resync: + LD c,0dh + call send_c + call get + CP '.' + JR NZ,resync + + LD c,'O' + call send_c + LD c,07 ; beep the bell + call send_c + call get ; should be a bell code + CP 07 + RET Z + + call get + jr resync + + + +; +; CXDISK.ASM +; + +; +; +; + dseg +fd_read: + LD a,10 + LD (error_count),A ; set retrys to 10 +retry_read: + LD HL,retry_read + PUSH HL ; save retry address on the stack + LD a,'R' + call set_up_dsk ; send command, track and sector +read_loop: + call get + + if banked + call put_byte_de_bank ; save byte disk bank + LD a,c + else + LD (HL),a + endif + + INC HL + call do_sum + JR NZ,read_loop + + call get + LD A,(check_sum) + CP c + JR NZ,dsk_error + + POP HL ; remove retry address + XOR a ; A=0 (no errors) +; +; +fd_init: +fd_login: + ret + + +; +; +; + if banked + + cseg +put_byte_de_bank: + LD A,(force_map) ; read current MMU configuration + LD (DE),A ; force to preconfig reg adr in DE + LD (HL),c ; save C in proper bank + LD (force_map),A ; force the old bank back + ret + endif + + page +; +; +; + dseg +dsk_error: + call resync + LD A,(error_count) + DEC a + LD (error_count),A + RET NZ ; return to retry address + + INC a ; A=1 if hard error + POP HL ; remove retry address on error + ret + +error_count: DEFM 0 + + page +; +; +; + dseg +fd_write: + LD a,10 + LD (error_count),A ; set retrys to 10 + +retry_write: + LD HL,retry_write + PUSH HL + LD a,'W' + call set_up_dsk ; send command, track and sector + +write_loop: + if banked + call get_byte_de_bank + else + LD c,(HL) + endif + call send_c ; leaves sent char in A + INC HL + call do_sum + JR NZ,write_loop + LD A,(check_sum) + call send_a + call get + OR a ; A=0 if no errors + JR NZ,dsk_error + + POP HL ; remove error address + ret ; A=0 (no errors) + + + if banked + + cseg +get_byte_de_bank: + LD A,(force_map) ; read current MMU configuration + LD (DE),A ; set current disk bank (in DE) + LD c,(HL) + LD (force_map),A ; write current MMU conf back + ret + endif + + page +; +; compute check sum and adjust byte count +; + dseg +do_sum: + LD b,a + LD A,(check_sum) ; get the current sum + ADD A,b ; add in new byte + LD (check_sum),A ; save new sum + LD A,(count) ; get byte count + DEC a ; one less to get + LD (count),A ; save for later + ret ; zero flag set if DONE + +check_sum: DEFM 0 +count: DEFM 0 + + +; +; send the command, track and sector to the external system +; set count to 128 bytes, clear the checksum and set HL to +; the DMA address +; +set_up_dsk: + call send_a ; send the comand + LD A,(@trk) + call send_a ; send the track + LD A,(@sect) + call send_a ; send the sector + XOR a + LD (check_sum),A + LD a,80h + LD (count),A ; transfer 128 bytes + LD HL,(@dma) ; HL = current DMA address + + if banked + LD DE,bank_0 ; start by pointing to bank 0 + LD A,(@dbnk) ; get the current disk I/O bank + OR a ; is it set to bank 0 + RET Z ; yes, return + + INC DE ; no, point to bank 1 + endif + ret + + page +;========================================================== +; CHARACTOR INITILIZATION ROUTINES +;========================================================== +; +; +; + dseg + +; +; set external system com rate to 19.2 K baud +; +_int65: +init_ext: + LD HL,(usart_adr) + LD b,h + LD c,l + INC BC + INC BC ; point to command reg + + LD a,cmd_init + outp a + INC BC ; point to control reg + LD a,cntr_init_19200 ; baud rate equ 19200 + outp a + + DEC BC ; (02) + DEC BC ; (01) + inp a ; read status + DEC BC ; (00) + inp a ; read hung data + ret + + page +;========================================================== +; CHARACTOR INPUT ROUTINES +;========================================================== + +; +; +; + dseg +_in65: ; character input + call _ins65 ; check for character adv. + JR Z,_in65 ; loop if NOT + LD A,(key) ; get the key code + PUSH AF ; save on stack + XOR a ; clear key + LD (key),A + POP AF ; recover current key + ret + + page + +;========================================================== +; CHARACTER DEVICE INPUT STATUS +;========================================================== + +; +; +; + dseg +_ins65: ; character input status + LD A,(key) ; is there already a key + OR a + JR NZ,ret_true ; yes, return true + LD a,'I' ; no, test if any typed + call send_a + call get ; get key + OR a ; =0 if none + RET Z ; return character not advaliable + + LD (key),A ; was one, save in key +_outs65: +ret_true: + OR 0ffh + ret + +key: DEFM 0 + + page +;========================================================== +; CHARACTER DEVICE OUTPUT +;========================================================== + +; the charactor to be output is in the C register + +; +; +; + dseg +_out65: ; character output + LD a,c + PUSH AF + LD a,'O' + call send_a + POP AF + call send_a +; jmp get + +; fall thru to GET + +;========================================================== +; EXTERNAL DEVICE LOW LEVEL DRIVERS +;========================================================== + +; +; +; + dseg +get: + call in_stat + JR Z,get + DEC BC ; point to data reg (RxD) + inp a + LD c,a + ret +; +; +; +send_c: + LD a,c +send_a: + PUSH AF ; save the character to be output +send_loop: + call out_stat + JR Z,send_loop + POP AF + DEC BC : point to data register (TxD) + outp a + ret +; +; +; +in_stat: + LD HL,(usart_adr) + LD b,h + LD c,l + INC BC ; point to status register + inp a + AND rxrdy + ret +; +; +; +out_stat: + LD HL,(usart_adr) + LD b,h + LD c,l + INC BC ; point to status register + inp a + AND txrdy + ret + else +;========================================================== +; CHARACTOR INITILIZATION ROUTINES +;========================================================== +; +; +; + dseg +; +; set com rate to value in _int_bd +; (may need to change rate if not supported) +_int65: +init_ext: + if use_6551 +; +; must gate 6551 to user port +; this is done by init'ing the out data to an input +; and then setting DTR +; + LD BC,CIA2+data_dir_a + inp a + OR 100b ; make TxD bit (2) an input + outp a + endif + + LD HL,(usart_adr) + LD b,h + LD c,l + INC BC ; point to status reg + outp a ; software reset (wr to stat reg) + + INC BC ; point to Command register + LD a,cmd_init ; set DTR active + outp a + + INC BC ; point to Control register + LD A,(_int_bd) ; get 6551 baud rate + OR 10h ; use baud rate generator + outp a ; 1 stop (7=0), 8 bits (65=0) + ret + + page +;========================================================== +; CHARACTOR INPUT ROUTINES +;========================================================== + +; +; +; + dseg +_in65: ; character input + call _ins65 + JR Z,_in65 + DEC BC ; point to data reg + inp a + ret + +;========================================================== +; CHARACTER DEVICE INPUT STATUS +;========================================================== +; +; +; + dseg +_ins65: ; character input status + LD HL,(usart_adr) + LD b,h + LD c,l + INC BC ; point to status register + inp a + AND rxrdy + RET Z + OR -1 + ret + + +;========================================================== +; CHARACTER DEVICE OUTPUT +;========================================================== + +; the charactor to be output is in the C register + +; +; +; + dseg +_out65: ; character output + LD a,c + PUSH AF + call _outs65 + JR Z,_out65 + POP AF + DEC BC ; point to data register + outp a + ret + +;========================================================== +; CHARACTER DEVICE OUTPUT STATUS +;========================================================== +; +; +; + dseg +_outs65: ; character input status + LD HL,(usart_adr) + LD b,h + LD c,l + INC BC ; point to status register + inp a + AND txrdy + RET Z + OR -1 + ret + + + endif + + + end diff --git a/tests/restricted/cxio.asm b/tests/restricted/cxio.asm new file mode 100644 index 00000000..0f546e88 --- /dev/null +++ b/tests/restricted/cxio.asm @@ -0,0 +1,1403 @@ +; 06-2018: Converted to z80 mnemonics with toz80.awk +; + title 'C128 BIOS, main I/O and sys functions 28 Apr 86' + +; +; This module contains CXIO,CXINIT,CXMOVE and CXTIME. +; + maclib cpm3 + + maclib z80 + + maclib cxequ + + maclib modebaud + + + public _init,_ldccp,_rlccp + + public _user,_di_int + + extrn _sysint + +DEFC bdos = 5 + + extrn @civec,@covec,@aivec,@aovec,@lovec + extrn _bnksl + + public _cinit,_ci,_co,_cist,_cost + public @ctbl + extrn _kyscn + +; Utility routines in standard BIOS + extrn _wboot ; warm boot vector + extrn _pmsg ; print message @ up to 00 + ; saves & + extrn _pdec ; print binary number in from 0 to 99. + extrn _pderr ; print BIOS disk error header + extrn _conin,_cono ; con in and out + extrn _const ; get console status + + extrn @hour,@min,@sec,@date,_bnksl + public _time + + page +; +; keyboard scanning routine +; + extrn _get_key,_int_cia + extrn Fx_V_tbl +; +; links to 80 column display +; + extrn _out80,_int80 + extrn _out40,_int40 + + extrn _pt_i_1101,_pt_o_1,_pt_o_2 + extrn _convt +; extrn _pt_s_1101 + +; +; bios8502 function routines +; + public _fun65 + +; +; +; + public _intbd + extrn _int65,_in65,_ins65,_out65,_outs65 + +; cseg +;trace: +; xthl ; save hl on stack +; push psw +; call _pmsg ; DE and BC saved by _pmsg +; pop psw +; xthl +; ret +; +; CSEG +;disp_A: +; push psw ;;;test +; ani 0fh ;;;test +; adi 90h ;;;test +; daa ;;;test +; aci 40h ;;;test +; daa ;;;test +; sta low_test ;;;test +; pop psw ;;;test +; rar ;;;test +; rar ;;;test +; rar ;;;test +; rar ;;;test +; ani 0fh ;;;test +; adi 90h ;;;test +; daa ;;;test +; aci 40h ;;;test +; daa ;;;test +; sta hi_test ;;;test +; call trace ;;;test +;hi_test: ;;;test +; db 31 ;;;test +;low_test: ;;;test +; db 31 ;;;test +; db ' ' ;;;test +; db 0 ;;;test +; ret ;;;test +; + page + + DSEG +_fun65: + LD (vic_cmd),A ; save the command passed in A + + if not use_6551 + + ; See https://en.wikipedia.org/wiki/MOS_Technology_6551 + ; "Commodore International omitted the 6551 from the popular VIC-20, C64, and C128 home computers. + ; Instead, these systems implemented a bit-banging UART via KERNAL routines." + +fun_di_wait: + LD A,(RS232_status) + AND 11000010b ; char to Xmit, Xmiting or receiving _ + JR NZ,fun_di_wait ; yes, wait for int to clean up + endif + di + LD A,(force_map) ; get current MMU configuration + PUSH AF ; save it + LD (io_0),A ; make I/O 0 current + + LD DE,1 ; D=0, E=1 + if use_fast + LD BC,VIC_speed + inp a + LD (sys_speed),A + outp d ; set slow mode (1 2 MHz Z80) + endif + LD BC,page_1_h + outp d + DEC c + outp e ; page 1, 0-1 + DEC c + outp d + DEC c + outp d ; page 0, 0-0 + + ; DEFC enable_z80 = 0FFD0h ; 8502 code + ; DEFC return_z80 = 0FFDCh + ; DEFC enable_6502 = 0FFE0h ; Z80 code + ; DEFC return_6502 = 0FFEEh + + call enable_6502+6 ; go run the 8502 + LD c,low(page_1_h) + outp e + DEC c + outp e ; page 1, 1-1 + DEC c + outp e + DEC c + outp d ; page 0, 1-0 + if use_fast + LD BC,VIC_speed + LD A,(sys_speed) ; get desired system speed + outp a ; set speed (2 or 4 MHz Z80) + endif + POP AF ; recover the MMU config. + LD (force_map),A ; restore it + ei ; turn interrupts back on + LD A,(vic_data) ; get command results + OR a ; set the zero flag if A=0 + ret + +_di_int: + if not use_6551 + PUSH AF +di_int_1: + LD A,(RS232_status) ; character to Xmit or currently + AND 11000010b ; ..transmitting or receiving _ + JR NZ,di_int_1 ; yes, wait for int to clean up + POP AF + endif + di + ret + + page +; +; set up the MMU for CP/M Plus +; + DSEG ; init done from banked memory +_init: + LD a,3eh ; force MMU into I/O space + LD (force_map),A ; + LD HL,mmu_table+11-1 ; table of 11 values + LD BC,mmu_start+11-1 ; to to MMU registers + LD d,11 ; move all 11 bytes to the MMU + +init_mmu_loop: + LD a,(HL) + outp a + DEC HL + DEC BC + DEC d + JR NZ,init_mmu_loop + + LD a,1 ; enable track and sector status + LD (stat_enable),A ; on the status line +; mvi a,1 ; no parity, 8 bits, 1 stop bit + LD (XxD_config),A +; + if use_6551 + LD HL,int_6551 + else + LD HL,usart + endif + LD (usart_adr),HL + + LD HL,_convt + LD (prt_conv_1),HL + LD (prt_conv_2),HL + + LD HL,Fx_V_tbl + LD (key_FX_function),HL +; +; install I/O assignments +; + LD HL,4000h+2000h ; 80 and 40 column drivers + LD (@covec),HL + LD h,80h + LD (@civec),HL ; assign console input to keys + LD h,10h + LD (@lovec),HL ; assign printer to LPT: + LD h,00h + LD (@aivec),HL + LD (@aovec),HL ; assign rdr/pun port + + page +; +; print sign on message +; + call prt_msg ; print signon message + DEFM "Z"-'0' ; initialize screen pointers + DEFM esc,esc,esc + DEFM purple+50h ; set character color + DEFM esc,esc,esc + DEFM black+60h ; set background (BG) color + DEFM esc,esc,esc + DEFM brown+70h ; set border color + DEFM "Z"-'0' ; home and clear screen (to BG color) + + DEFM lf,lf,lf + if use_fast + DEFM "Fast " + endif + + if use_6551 + DEFM "/w 6551 " + endif + + DEFM "CP/M 3.0" + if not banked + DEFM " Non-Banked" + endif + DEFM " On the Commodore 128 " + date + warning + DEFM cr,lf + DEFM " ",0 + +; +; set CONOUT driver to correct screen +; + LD HL,4000h ; 80 column screen vector + call read_d505 + RLA + JR NC,set_screen + LD a,'4' + LD (screen_num),A + LD h,20h ; 40 column screen vector + +set_screen: + call prt_msg ; HL saved +screen_num: + DEFM "80 column display",cr,lf,lf,lf,lf,0 + LD (@covec),HL ; assign console output to CRT: (40/80) + + page + +; +; + LD a,-1 ; set block move to NORMAL mode + LD (source_bnk),A +; +; install mode 2 page vectors +; + LD a,JMP + LD (INT_vector),A ; install a JMP at vector location + LD HL,_sysint + LD (INT_vector+1),HL ; install int_handler adr +; +; A software fix is required for the lack of hardware to force the +; LSB of the INT vector to 0. If the bus floats INT VECT could be +; read as 0FFh; thus ADRh=I (I=0FCh) ADRl=FF for first read, and +; ADRh=I+1 ADRl=00 for second, to ensure that control is retained +; 0FD00h will also have FDh in it. +; + LD HL,int_block ; FC00h + LD DE,int_block+1 ; FC01h + LD BC,256-1+1 ; interrupt pointer block + LD (HL),INT_vector/256 ; high and low are equal (FD) + ldir + LD a,INT_block/256 + LD I,A ; set interrupt page pointer + im2 ; enable mode 2 interrupts + + page +; +; + LD a,vicinit ; null command just to setup BIOS8502 + call _fun65 +; +; +; + LD A,(sys_freq) ; 0=60Hz 0FFh=50Hz + AND 80h ; 0=60Hz 080h=50Hz + LD l,a ; save in L + LD BC,cia_1+0eh ; point to CRA + inp a ; get old config + AND 7fh ; clear freq bit + OR l ; add in new freq bit + outp a ; set new config + + LD c,8 ; start RTC + outp a + + LD HL,date_hex + LD (@date),HL ; set date to system data + +; +; setup the sound variables +; + LD HL,(key_tbl) + LD DE,58*4 + ADD HL,DE + LD e,(HL) + INC HL + LD d,(HL) + INC HL + EX DE,HL + LD (sound1),HL ; H=SID reg 24, L=SID reg 5 + EX DE,HL + LD e,(HL) + INC HL + LD d,(HL) + EX DE,HL + LD (sound2),HL ; H=SID reg 6, L=SID reg 1 + LD HL,9 + ADD HL,DE + LD e,(HL) + INC HL + LD d,(HL) + EX DE,HL + LD (sound3),HL ; H=SID reg 4 then L=SID reg 4 +; +; set-up key click sound registers +; + LD BC,sid+7 + LD HL,0040h + outp l ; (sid+7)=40h + INC c + outp l ; (sid+8)=40h + LD c,low(sid+12) + outp h ; (sid+12)=0 Attack=2ms, Decay=6ms + INC c + outp h ; (sid+13)=0 Sustain=0, Release=6ms + LD a,6 + LD (tick_vol),A ; set keyclick volumn level +; +; set up interrupts for key scan (not software usart) +; + if use_6551 + LD DE,2273 ; int at 150 BAUD rate + LD BC,CIA1+timer_b_low ; + outp e ; + INC c ; point to timer_b_high + outp d ; + + LD a,11h ; + LD c,CIA_ctrl_b ; turn on timer B + outp a ; + + LD BC,CIA2+data_b ; setup user port for RS232 + inp a ; get old data + OR 6 ; set CTS and DTR + outp a ; update it + endif + ret + + +mmu_table: + mmu_tbl_M + + page +; +; +; + CSEG +prt_msg: + EX (SP),HL + call _pmsg + EX (SP),HL + ret + + +; +; placed in common memory to keep IO from stepping on this code +; always called from bank 0 +; + CSEG +read_d505: + LD (io_0),A ; enable MMU (not RAM) + LD BC,0d505h + inp a ; read 40/80 column screen + LD (bank_0),A ; re-enable RAM + ret + + page +; +; +; + DSEG + if not use_6551 +init_RS232: + di + + XOR a + LD (RS232_status),A + LD HL,RxD_buf_count ; clear the count + LD (HL),0 + INC l ; point to RxD_buf_put + LD (HL),low(RxD_buffer) + INC l ; point to RxD_buf_get + LD (HL),low(RxD_buffer) + + LD HL,NTSC_baud_table + LD A,(sys_freq) + OR a + JR Z,use_NTSC + LD HL,PAL_baud_table +use_NTSC: + LD A,(RS232_baud) + CP baud_1200 ; baud rate less then 1200 baud + JR C,baud_ok ; yes, go set it + LD a,baud_1200 ; no, 1200 baud is the max + LD (RS232_baud),A ; (change to 1200 baud) + +baud_ok: + LD e,a + LD d,0 + ADD HL,DE ; +1X + ADD HL,DE ; +1X + ADD HL,DE ; +1X = +3X + LD e,(HL) + INC HL + LD d,(HL) + INC HL ; + LD a,(HL) ; get rate # + LD (int_rate),A ; + LD BC,CIA1+timer_b_low ; + outp e ; + INC c ; point to timer_b_high + outp d ; + + LD a,11h ; + LD c,CIA_ctrl_b ; turn on timer B + outp a ; + + LD BC,CIA2+data_b ; setup user port for RS232 + inp a ; get old data + OR 6 ; set CTS and DTR + outp a ; update it + ei + ret + + page +; +; NTSC rates (1.02273 MHz) +; +NTSC_baud_table: + DEFW 6818 ; no baud rate (6666.47) + DEFM 1 + DEFW 6818 ; 50 6666.7us (6666.47) + DEFM 1 + DEFW 4545 ; 75 4444.4us (4443.99) + DEFM 1 + DEFW 3099 ; 110 3030.3us (3030.13) + DEFM 1 + DEFW 2544 ; 134 2487.6us (2487.46) + DEFM 1 + DEFW 2273 ; 150 2222.2us (2222.48) + DEFM 2 + DEFW 1136 ; 300 1111.1us (1110.75) + DEFM 3 + DEFW 568 ; 600 555.6us ( 555.38) + DEFM 6 + DEFW 284 ; 1200 277.8us ( 277.69) + DEFM 12 + +; +; PAL rates (0.98525 MHz) +; +PAL_baud_table: + DEFW 6568 ; no baud rate (6666.32) + DEFM 1 + DEFW 6568 ; 50 6666.7us (6666.32) + DEFM 1 + DEFW 4379 ; 75 4444.4us (4444.56) + DEFM 1 + DEFW 2986 ; 110 3030.3us (3030.70) + DEFM 1 + DEFW 2451 ; 134 2487.6us (2487.69) + DEFM 1 + DEFW 2189 ; 150 2222.2us (2221.77) + DEFM 2 + DEFW 1095 ; 300 1111.1us (1111.39) 300*3 + DEFM 3 + DEFW 547 ; 600 555.6us ( 555.19) 600*3 + DEFM 6 + DEFW 274 ; 1200 277.8us ( 278.10) 1200*3 + DEFM 12 + + page +; +; +; +out_RS232: + call out_st_RS232 + JR Z,out_RS232 + LD a,c + LD (xmit_data),A ; get character to send in A + LD HL,RS232_status + setb 7,(HL) ; set Xmit request bit + ret + +; +; +; +out_st_RS232: + LD A,(RS232_status) + AND 80h ; bit 8 set if busy + XOR 80h ; A cleared if busy (=80h if not) + RET Z + OR 0ffh ; A=ff if ready (not busy) + ret + +; +; +; +in_RS232: + call in_st_RS232 + JR Z,in_RS232 + LD A,(recv_data) + LD HL,RS232_status + res 0,(HL) + ret + +; +; +; +in_st_RS232: + LD A,(RS232_status) + AND 1 + RET Z + OR 0ffh ; set data ready (-1) + ret + endif + page +; +; this routine is used to provide the user with a method +; of interfacing with low level system functions +; + CSEG +; +; input: +; all registers except HL and A are passed to function +; +; output: +; all resisters from function are preserved +; +_user: + LD (user_hl_temp),HL + EX DE,HL + LD (de_temp),HL ; save DE for called function + + LD e,a ; place function number in E + LD a,num_user_fun-1 ; last legal function number + + call vector ; function +usr_tb: DEFW read_mem_0 ; 0 + DEFW write_mem_0 ; 1 + DEFW _kyscn ; 2 + DEFW do_rom_fun ; 3 (L=function #) + DEFW do_6502_fun ; 4 (L=function #) + DEFW read_d505 ; 5 returns MMU reg in A + DEFW code_error ; not 0 to 5 ret version number in HL + +DEFC num_user_fun = (_-usr_tb)/2 + + page +; +; address in DE is read and returned in C +; A=0 if no error +; + DSEG +read_mem_0: + LD A,(DE) ; read location addressed by DE + LD c,a ; value returned in C + XOR a ; clear error flag + ret + +; +; address in DE is written to with value in C +; A=0 if no errors +; +write_mem_0: + LD a,-1 ; get error flag and 0ffh value + CP d ; do not allow write from FF00 to FFFF + ; this is 8502 space, MMU direct reg. + RET Z + LD a,d + CP 10h ; do not allow write from 0000 to 0FFF + ; this is ROM space + LD a,-1 ; get error flag + RET C ; return if 00h to 0fh + LD a,c + LD (DE),A + XOR a ; clear error flag + ret + + page +; +; This is the function code entry point for direct execution +; of driver functions. If the MSB of the function number is +; set, the 40 column driver is used; else the 80 column drive +; is used. +; +do_rom_fun: + LD HL,(user_hl_temp) ; get HL (L=fun #) + + LD a,7eh ; only allow even functions + AND l + CP 79h + JR C,no_hl_req + LD HL,(1dma) ; HL will be passed in @dma by + PUSH HL ; ..the user +no_hl_req: + LD l,a + rst 28h ; call rom functon (RCALL) L=fun # + ret + +; mvi a,7eh ; only allow even functions +; ana l +; sta no_hl_req+1 +; cpi 79h +; jrc no_hl_req +; lhld @dma ; HL will be passed in @dma by +; push h ; ..the user +;no_hl_req: +; will be changed to RCALL xx RET for next release (ROM FN 7A, 7C +; and 7E will not function with current code, they expect +; a return address on the stack +; +; RJMP 5Eh ; unused function, real fun# installed + ; ..above + +do_6502_fun: + LD HL,(user_hl_temp) + LD a,l + JP _fun65 +; +; +; +code_error: + LD HL,date_hex + LD a,-1 + ret + + page +; +; +; + CSEG +_rlccp: + LD HL,ccp_buffer + LD BC,0c80h + +load_ccp: + LD (bank_0),A + LD a,(HL) + LD (bank_1),A + LD DE,-ccp_buffer+100h + ADD HL,DE + LD (HL),a + LD DE,ccp_buffer-100h+1 + ADD HL,DE + DEC BC + LD a,b + OR c + JR NZ,load_ccp + ret + + page +; +; +; + CSEG +_ldccp: + XOR a + LD (ccp_fcb+15),A ; zero extent + LD HL,0 + LD (fcb_nr),HL ; start at beginning of file + LD DE,ccp_fcb + call open ; open file containing CCP + INC a + JR Z,no_CCP ; error if no file... + LD DE,0100h + call setdma ; start of TPA + LD DE,128 + call setmulti ; allow up to 16K bytes + LD DE,ccp_fcb + call read + + LD HL,0100h + LD BC,0c80h + LD A,(force_map) + PUSH AF + +; +; +save_ccp: + LD (bank_1),A + LD a,(HL) + LD (bank_0),A + LD DE,ccp_buffer-100h + ADD HL,DE + LD (HL),a + LD DE,-ccp_buffer+100h+1 + ADD HL,DE + DEC BC + LD a,b + OR c + JR NZ,save_ccp + + POP AF + LD (force_map),A + ret + + page +; +; The following code does not work with the NEW MMU +; +;_ldccp: +; xra a +; sta ccp_fcb+15 ; zero extent +; lxi h,0 +; shld fcb_nr ; start at beginning of file +; lxi d,ccp_fcb +; call open ; open file containing CCP +; inr a +; +;; trace jz below should be jrz +; jz no_CCP ; error if no file... +; +; lda fcb_rc ; get the record count +; sta ccp_count ; save for later +; lxi d,0100h +; call setdma ; start of TPA +; lxi d,128 +; call setmulti ; allow up to 16K bytes +; lxi d,ccp_fcb +; call read +; +; lxi d,1f0h ; point to buffer +; ; bank 1, page F0 +;; lxi h,101h ; point to CCP (in TPA) +; ; bank 1, page 01 +; mov h,d +; mov l,d +; jr save_ccp +; +; +; +; +;_rlccp: +; lda ccp_count ; +; sui 30 ; we can only save 30 records +; jp _ldccp +; +; lxi h,1F0h ; point to buffer +; ; bank 1, page F0 +;; lxi d,101h ; point to TPA space +; ; bank 1, page 01 +; mov d,h +; mov e,h +; +;save_ccp: +; mvi b,15 ; number of pages in buffer +;ccp_move_loop: +; push h +; push d +; push b +; call do_move_0_to_1 +; pop b +; pop d +; pop h +; inx h +; inx d +; djnz ccp_move_loop +; +; ret +; +; +;do_move_0_to_1: +; call set_0_and_1 +; call move_0_to_1 +; lxi h,100h ; bank 1 page 0 +;; lxi d,101h ; bank 1 page 1 +; mov d,h +; mov e,h +;; +;; +;; +;set_0_and_1: +; lda force_map ; get current map +; sta io ; force to i/o in bank 0 +; lxi b,page_0_l ; point to 1st page register +; outp l ; set page 0 low +; inr c +; outp h ; set page 0 high +; inr c +; outp e ; set page 1 low +; inr c +; outp d ; set page 1 high +; sta force_map +; ret +; +;; +;; +;; +;move_0_to_1: +; lda force_map +; sta bank_1 ; force bank 1 memory +; lxi h,000h ; source +; lxi d,100h ; dest. +;; lxi b,100h +; mov b,d +; mov c,e ; count +; ldir +; sta force_map +; ret +; + page +; +; +; +no_CCP: ; here if we couldn't find the file + call prtmsg ; report this... + DEFM cr,lf,"BIOS Err on A: No CCP.COM file",0 + call _conin ; get a response + jr _ldccp ; and try again + +; +; CP/M BDOS Function Interfaces +; + CSEG +open: + LD c,15 ; open file control block + + DEFM 21h ; lxi h,(mvi c,26) +setdma: + LD c,26 ; set data transfer address + + DEFM 21h ; lxi h,(mvi c,44) +setmulti: + LD c,44 ; set record count + + DEFM 21h ; lxi h,(mvi c,20) +read: + LD c,20 ; read records + JP bdos + +; 12345678901 +ccp_fcb DEFM 1,"CCP COM",0,0,0 +fcb_rc DEFM 0 + DEFS 16 +fcb_nr DEFM 0,0,0 + + + page +; +; CXIO.ASM and CXEM.ASM +; +;========================================================== +; ROUITINE TO VECTOR TO HANDLER +;========================================================== +; CP/M IO routines b=device : c=output char : a=input char +; + CSEG +; +; +; +_cinit: ; initialize usarts + LD b,c + call vector_io ; jump with table adr on stack +number_drivers: + DEFW _int_cia ; keys + DEFW _int80 ; 80col + DEFW _int40 ; 40col + DEFW _pt_i_1101 ; prt1 + DEFW _pt_i_1101 ; prt2 + DEFW _int65 ; 6551 + if not use_6551 + DEFW init_RS232 ; software RS232 + endif + DEFW rret ; +DEFC max_devices = ((_-number_drivers)/2)-1 + +; +; +; +_ci: ; character input + call vector_io ; jump with table adr on stack + DEFW key_board_in ; keys + DEFW rret ; 80col + DEFW rret ; 40col + DEFW rret ; ptr1 + DEFW rret ; prt2 + DEFW _in65 ; 6551 + if not use_6551 + DEFW in_RS232 ; software RS232 + endif + DEFW null_input + +; +; +; +_cist: ; character input status + call vector_io ; jump with table adr on stack + DEFW key_board_stat ; keys + DEFW rret ; 80col + DEFW rret ; 40col + DEFW rret ; prt1 + DEFW rret ; prt2 + DEFW _ins65 ; 6551 + if not use_6551 + DEFW in_st_RS232 ; software RS232 + endif + DEFW rret + +; +; +; +_co: ; character output + call vector_io ; jump with table adr on stack + DEFW rret ; keys + DEFW _out80 ; 80col + DEFW _out40 ; 40col + DEFW _pt_o_1 ; prt1 + DEFW _pt_o_2 ; prt2 + DEFW _out65 ; 6551 + if not use_6551 + DEFW out_RS232 ; software RS232 + endif + DEFW rret + +; +; +; +_cost: ; character output status + call vector_io ; jump with table adr on stack + DEFW ret_true ; keys + DEFW ret_true ; 80col + DEFW ret_true ; 40col + DEFW ret_true ; prt1 _pt_s_1101 + DEFW ret_true ; prt2 + DEFW _outs65 ; 6551 + if not use_6551 + DEFW out_st_RS232 ; software RS232 + endif + DEFW ret_true + + page +; +; This entry does not care about values of DE +; +vector_io: + LD a,max_devices ; check for device # to high + LD e,b ; get devive # in E +; +; +; INPUT: +; Vector # in E, Max device in A +; passes value in DE_TEMP in DE +; HL has routine's address in it on entering routine +; +; OUTPUT: +; ALL registers of returning routine are passed +; +vector: + POP HL ; get address vector list + LD d,0 ; zero out the MSB + CP e ; is it too high_ + JR NC,exist ; no, go get the handler address + + LD e,a ; yes, set to max_dev_handler(last one) +exist: + ADD HL,DE ; + ADD HL,DE ; point into table + + LD a,(HL) + INC HL + LD h,(HL) + LD l,a ; get routine adr in HL + + if banked + LD (hl_temp),HL ; save exec adr + LD HL,0 + ADD HL,sp + LD sp,bios_stack + PUSH HL ; save old stack + + LD HL,(de_temp) + EX DE,HL + LD HL,(hl_temp) ; recover exec adr + + LD A,(force_map) ; get current bank + PUSH AF ; save on stack + LD (bank_0),A ; set bank 0 as current + + call ipchl + + LD (a_temp),A ; save value to return + POP AF + LD (force_map),A ; set old bank back + LD A,(a_temp) ; recover value to return + + LD (hl_temp),HL + POP HL ; recover old stack + LD SP,HL ; set new stack + LD HL,(hl_temp) + ret + +ipchl: + JP (HL) ; jmp to handler + + DEFS 30h +bios_stack: + + else + LD A,(a_temp) + EX DE,HL + LD HL,(de_temp) + EX DE,HL + JP (HL) + endif + + page +;========================================================== +; CHARACTER INPUT ROUTINES +;========================================================== + + DSEG +; +; +; +key_board_in: + call key_board_stat ; test if key is available + JR Z,key_board_in + + LD A,(key_buf) + PUSH AF ; save on stack + XOR a ; clear key + LD (key_buf),A +; +;** the tracking of the display should be able to be turned off +;** this could be done with one of the keyboard's Fx codes +; + LD A,(stat_enable) + bit 6,a + JR NZ,no_update + LD A,(char_col_40) + LD b,a + LD A,(@off40) + CP b + JR NC,do_update + ADD A,39-1 + CP b + JR NC,no_update +do_update: + LD a,80h + LD (old_offset),A ; store 80h to demand update +no_update: + POP AF ; recover current key +rret: + ret + +; +; +; +null_input: ; return a ctl-Z for no device + LD a,1Ah + ret + + + page + +;========================================================== +; CHARACTER DEVICE INPUT STATUS +;========================================================== + + DSEG +; +; +; +key_board_stat: + LD A,(key_buf) + OR a + JR NZ,ret_true + + call _get_key + OR a ; =0 if none + RET Z ; return character not advailable + + LD (key_buf),A ; was one, save in key buffer + +ret_true: + OR 0ffh ; and return true + ret + + page + + cseg +@ctbl + DEFM "KEYS " ; device 0, internal keyboard + DEFM mb_input + DEFM baud_none + + DEFM "80COL " ; device 1, 80 column display + DEFM mb_output + DEFM baud_none + + DEFM "40COL " ; device 2, 40 column display + DEFM mb_output + DEFM baud_none + + DEFM "PRT1 " ; device 3, serial bus printer (device 4) + DEFM mb_output + DEFM baud_none + + DEFM "PRT2 " ; device 4, serial bus printer (device 5) + DEFM mb_output + DEFM baud_none + + DEFM "6551 " ; device 5, EXT CRT + DEFM mb_in_out+mb_serial+mb_softbaud+mb_xonxoff +_intbd: + DEFM baud_1200 + if not use_6551 + DEFM "RS232 " ; device 6, software RS232 device + DEFM mb_in_out+mb_serial+mb_xonxoff+mb_softbaud +RS232_baud: + DEFM baud_300 + endif + DEFM 0 ; mark end of table + + page +; +; TIME.ASM +; + cseg +; +; HL and DE must be presevered +; +_time: + INC c + LD BC,cia_hours + JR Z,set_time +; +; update SCB time (READ THE TIME) +; + inp a ; read HR (sets sign flag) + JP P,is_am ; jmp if AM (positive) + AND 7fh + ADD A,12h ; noon=24(PM), midnight=12(AM) + daa + CP 24h ; check for noon (12+12 PM) + JR NZ,set_hr + LD a,12h + jr set_hr + +is_am: + CP 12h ; check for midnight (AM) + JR NZ,set_hr + XOR a ; becomes 00:00 +set_hr: + LD (@hour),A + LD b,a + LD A,(old_hr) + LD c,a + LD a,b + LD (old_hr),A + CP c ; if 0hour(HL), C times + LD HL,(__ctl) ; pointer to the "control" array + LD A,(HL) ; + INC HL ; + LD H,(HL) ; + LD L,A ; + DEC HL ; ..is the first word we found in the "control" array (thus the command).. + LD A,H ; .. 'Open Workstation' (1) ... + OR L ; ... to initialize a driver ? + JP Z,init_driver + + CALL set_entry_parms ; + CALL Enter_Driver ; +exit_driver: + JP get_exit_parms ; + +; +;-------------------------------- +; +init_driver: + LD HL,(intin) ; 'intin' queue + LD E,(HL) ; Get the workstation ID (first value) + INC HL ; + LD D,(HL) ; + LD HL,(wks_id) ; + CALL sub16 ; Already loaded ? + JP Z,DDready ; + LD HL,DDtabl ; +DDlookup: + PUSH HL ; + LD A,(HL) ; + INC HL ; + LD H,(HL) ; + LD L,A ; HL=next entry in the DDtabl + AND H ; + INC A ; Last entry in the device list ? + POP BC ; + JP Z,DDready ; + PUSH BC ; + CALL sub16 ; + POP HL ; + JP Z,DDload ; We need to load the PRL file driver from file + LD BC,11 + ADD HL,BC ; Move to the next entry in DDtabl + JP DDlookup ; + +; +;-------------------------------- +; +DDload: + INC HL ; + INC HL ; + EX DE,HL ; DE = DD file name, HL = workstation ID + LD (wks_id),HL ; Keep the 'Workstation ID' + LD HL,dd_file ; File spec in copyr msg + LD C,9 ; 9 bytes (drive code + DD filename) + CALL copyDH ; Copy one file specification + CALL DDload_prl ; + +DDready: + CALL Enter_Driver + LD HL,(intout) ; intout + LD A,(HL) ; + INC HL ; + PUSH HL ; + LD H,(HL) ; + LD L,A ; + INC HL ; + LD (_maxx),HL ; 1st value in the "intout" queue (maxx ?) + POP HL ; + INC HL ; + LD A,(HL) ; + INC HL ; + LD H,(HL) ; + LD L,A ; + INC HL ; + LD (_maxy),HL ; 1st value in the "intout" queue (maxy ?) + JP exit_driver ; + +; +;-------------------------------- +; +set_entry_parms: + LD HL,(__ctl) ; pointer to the "control" array + INC HL ; + INC HL ; + + LD E,(HL) ; n_ptsin + INC HL ; + LD D,(HL) ; + + LD A,E ; + OR D ; + RET Z ; exit if no parms + + LD HL,-75 + ADD HL,DE ; + JP NC,entry_parms ; More than 75 coordinate pairs? + LD E,75 ; if so, limit to 75 entries (150 bytes) +entry_parms: + + LD HL,(ptsin) ; ptsin + PUSH HL ; + LD HL,f_record ; target temp position for ptsin with rescaled values + LD (ptsin),HL ; + PUSH HL ; + POP BC ; new adjusted ptsin list with rescaled values + POP HL ; +entry_ptsloop: + PUSH DE ; + EX DE,HL ; + LD HL,(_maxx) ; + CALL downscale + EX DE,HL ; + LD HL,(_maxy) ; + CALL downscale + POP DE ; + DEC E ; repeat for E arguments + JP NZ,entry_ptsloop + RET ; + +; +; Rescale from VDI window to real coordinates +; (HL) -> (BC) +;--------------------------------------------- +; +downscale: + EX DE,HL ; + LD A,(HL) ; + INC HL ; + PUSH HL ; + LD H,(HL) ; + PUSH BC ; + LD L,A ; + + LD C,15 + PUSH DE ; + EX DE,HL ; + LD HL,0 ; +downscale_1: + LD A,D ; + RRA ; + LD D,A ; + LD A,E ; + RRA ; + LD E,A ; + JP NC,downscale_2 + LD A,C ; + POP BC ; + PUSH BC ; + ADD HL,BC ; + LD C,A ; +downscale_2: + LD A,H ; + RRA ; + LD H,A ; + LD A,L ; + RRA ; + LD L,A ; + DEC C ; + JP NZ,downscale_1 + POP BC ; + + POP BC ; value position + LD A,L ; store value + LD (BC),A ; + INC BC ; + LD A,H ; + LD (BC),A ; + INC BC ; + POP HL ; + INC HL ; + RET ; + +; +;-------------------------------- +; +get_exit_parms: + LD HL,(__ctl) ; pointer to the "control" array + LD DE,4 ; + ADD HL,DE ; n_ptsout + LD C,(HL) ; + INC HL ; + LD B,(HL) ; + LD HL,(ptsout) ; ptsout +exit_ptsloop: + LD A,C ; + OR B ; + RET Z ; repeat for BC arguments, (exit if no arguments) + PUSH BC ; + EX DE,HL ; + LD HL,(_maxx) + CALL upscale + EX DE,HL ; + LD HL,(_maxy) + CALL upscale + POP BC ; + DEC BC ; + JP exit_ptsloop ; + +; +; Convert from real coordinates to VDI (32768x32768) +;---------------------------------------------------- +; +upscale: + LD B,H ; + LD C,L ; + EX DE,HL ; + LD E,(HL) ; + PUSH HL ; ptsout ptr + INC HL ; + LD D,(HL) ; + EX DE,HL ; + + LD A,16 + LD DE,0 +upscale_1: + PUSH AF ; + EX DE,HL ; + ADD HL,HL ; DE=DE*2 + EX DE,HL ; + ADD HL,HL ; HL=HL*2 + LD A,L ; + SUB C ; + LD L,A ; + LD A,H ; + SBC B ; + LD H,A ; + JP NC,upscale_2 + ADD HL,BC ; + DEC DE ; +upscale_2: + INC DE ; + POP AF ; + DEC A ; + JP NZ,upscale_1 + + AND A ; DE=DE/2 + LD A,D ; + RRA ; + LD D,A ; + LD A,E ; + RRA ; + LD E,A ; + JP NC,upscale_3 + INC DE +upscale_3: + + POP HL ; ptsout ptr + LD (HL),E ; + INC HL ; + LD (HL),D ; + INC HL ; + RET ; + +; +;-------------------------------- +; copy a string from DE (source) to HL (destination) +; +; DE = source +; HL = destination +; C = number of bytes +; +; +copyDH: + LD A,(DE) ; + LD (HL),A ; + INC HL ; + INC DE ; + DEC C ; + JP NZ,copyDH ; + RET ; + +; +;-------------------------------- +; 16 bits subtraction +; +sub16: + LD A,L ; + SUB E ; + LD L,A ; + LD A,H ; + SBC D ; + LD H,A ; + OR L ; + RET ; + + +; +;-------------------------------- +; +__ctl: DEFW 0 ; control array (contains the FN code, the lengthts of intin, ptsin, intout, ptsout, and a trailing special argument) +intin: DEFW 0 ; intin +ptsin: DEFW 0 ; ptsin +intout: DEFW 0 ; intout +ptsout: DEFW 0 ; ptsout + +_maxx: DEFW 0 +_maxy: DEFW 0 + + +; +;-------------------------------- +; + +DDload_prl: + CALL get_prl ; + CALL next_record ; Read first 128 bytes file record + LD HL,(L0104) ; + LD DE,Driver_pgm ; GSX.SYS + 500H at exact byte boundary + CALL sub16 ; + EX DE,HL ; + LD HL,(f_record+1) ; check binary block size from PRL header + PUSH HL ; + LD A,E ; + SUB L ; + LD A,D ; + SBC H ; + JP NC,load_prl ; + LD DE,toobig ; 'too big to loaL' + JP dsp_fname ; Display d:filename.typ + +; +;-------------------------------- +; +load_prl: + CALL next_record ; Read next 128 bytes file record + POP BC ; + PUSH BC ; + LD HL,Driver_pgm ; GSX.SYS + 500H at exact byte boundary + PUSH HL ; +ld_loop: + CALL get_byte ; + LD (HL),A ; + INC HL ; + DEC BC ; + LD A,C ; + OR B ; + JP NZ,ld_loop ; + + + POP HL ; + LD B,H ; + DEC B ; + POP DE ; + +reloc: + LD C,8 ; group of 8 bytes to be relocated + CALL get_byte ; pick the bitmap for the byte group +reloc8: + RLCA ; test whether the current byte needs to be relocated + PUSH AF ; + JP NC,no_reloc ; + LD A,B ; + ADD A,(HL) ; + LD (HL),A ; +no_reloc: + INC HL ; + DEC DE ; + LD A,D ; + OR E ; + JP Z,close_file + POP AF ; + DEC C ; + JP NZ,reloc8 ; + JP reloc ; + +; +;-------------------------------- +; +close_file: + POP AF + JP do_close ; + +; +;-------------------------------- +; +get_byte: + PUSH HL ; + PUSH DE ; + LD HL,(byt_ct) ; + INC L ; 128->256->0 ? + JP P,in_sect ; + PUSH BC ; + CALL next_record ; Read next 128 bytes file record + POP BC ; + LD HL,0 ; update byte counter +in_sect: + LD (byt_ct),HL ; + LD DE,f_record ; file record + ADD HL,DE ; + LD A,(HL) ; + POP DE ; + POP HL ; + RET ; +; +;-------------------------------- +; +get_prl: + LD DE,PRLtyp ; PRL filetype + LD HL,dd_file ; + LD C,6 + CALL copyDH ; (DE)->(HL), C times + LD HL,128 + LD (byt_ct),HL ; init byte counter + LD DE,dd_file ; File spec in copyr msg + LD C,openf ; Open file + CALL BDOS ; + LD HL,dd_file ; Last byte of the FCB of DD used + LD (HL),00H ; +file_done: + OR A ; + RET P ; + LD DE,nfound ; ' not founL' + JP dsp_fname ; Display d:filename.typ +; +;-------------------------------- +; +do_close: + LD DE,dd_file ; File spec in copyr msg + LD C,closef ; Close file + CALL BDOS ; + JP file_done ; +; +;-------------------------------- +; Display a char on console +; +pchar: + PUSH HL ; + LD C,conout ; Console output + CALL BDOS ; + POP HL ; + RET ; +; +;-------------------------------- +; Parse n+1 chars and display them +; +parse: + DEC A ; + RET Z ; + LD E,(HL) ; + INC HL ; + PUSH AF ; + CALL pchar ; + POP AF ; + JP parse ; + +; +;-------------------------------- +; Read file record (it is kept in the copyright message) +; +next_record: + LD DE,f_record ; copyright message = DMA area... + LD C,setDMA ; Set DMA Address + CALL BDOS ; + LD DE,dd_file ; File spec in copyr msg + LD C,readf ; Read sequential + CALL BDOS ; + OR A ; Successful read ? + RET Z ; + LD DE,whyEOF ; ': unexpected EOF$' + +dsp_fname: + PUSH DE ; + LD HL,dd_file ; File spec in copyr msg + LD A,(HL) ; + OR A ; Was a drive specified ? + JP Z,nodriv ; + ADD A,40H ; Convert drive code in a number + LD E,A ; + CALL pchar ; Display drive letter + LD E,':' ; Drive separator + CALL pchar ; Display it +nodriv: + INC HL ; + LD A,8+1 ; Filename + CALL parse ; + LD E,'.' ; Filename separator + CALL pchar ; + LD A,3+1 ; Filetype + CALL parse ; + POP DE ; + LD C,pstring ; Print string + CALL BDOS ; + JP 0000H ; Back to CP/M + + +; +;-------------------------------- +; +toobig: DEFM " too big to loaL" +; +whyEOF: DEFM ": unexpected EOF$" +; +nfound: DEFM " not founL" +; +PRLtyp: DEFM "PRL" ; PRL filetype +; + DEFS 8 ; ? + + + +; +;-------------------------------- +; +Enter_Driver: LD DE,__ctl ; ? +; +; The next byte is the first byte of the loaded driver. +; (relocated portion of GSX.SYS + 500H at exact byte boundary) +;-------------------------------- +; +Driver_pgm: + + END ; CP/M-80 SYStem file diff --git a/tests/restricted/lambda.asm b/tests/restricted/lambda.asm new file mode 100644 index 00000000..9a8d53d7 --- /dev/null +++ b/tests/restricted/lambda.asm @@ -0,0 +1,7353 @@ +; ========================================================================================= +; A commented disssembly of the Operating System of the Lambda 8300 later ROM version. +; ========================================================================================= + +; Incompatible ROMS +; ================= +; An earlier version of the Lambda ROM existed, with no color support (no INK, PAPER or BORDER). +; Also, two more ROMS existed for the CAC-3 and NF300 clones supporting READ/DATA/RESTORE + +; Last updated: 23-JUL-2015, Stefano B +; Work in progress, any contribution is welcome. +; +; The Lambda 8300 was a ZX81 clone made in Hong Kong, featuring +; interesting improvements such as sound and colour option. +; The ROM programmer was able to rework the original ZX81 code +; and squeeze out few bytes from the core routines ! +; +; The Lambda 8300 was also rebranded with the following names: +; DEF 3000, PC 2000, Marathon 32K, IQ 8300, PC 8300, Power 3000 +; Unisonic 8300, Futura 8300, Basic 2000 and Basic 3000. +; +; The documentation is incomplete and if you can find a copy +; of "The Complete Spectrum ROM Disassembly" then many routines +; such as POINTERS and most of the mathematical routines are +; similar and often identical. +; +; I've kept the labels (and recycled most of the comments) from +; the ZX81 ROM assembly listings, so it should be easy to compare +; portions of the two ROMs if necessary. +; +; The TOKENS table sections are still messy, please don't blame me! + + +00000000: D3 FD OUTA (FDh) ; turn off the NMI generator. +00000002: 3E BF LD A,BFh +00000004: DB FE INA (FEh) ; BFFEh : ENTER L K J H +00000006: 18 25 JR +25h ; jp to 0F28h via 002dh + + +;; NEXT-CHAR ? +;; CH-ADD+1 + +00000008: 00 NOP +00000009: 2A 16 40 LD HL,(4016h) ; fetch character address from CH_ADD. +;; TEMP-PTR1 + GET-CHAR +0000000C: 23 INC HL ; address next immediate location. +;; TEMP-PTR2 + GET-CHAR +0000000D: 22 16 40 LD (4016h),HL ; update system variable CH_ADD. + +;---------------------------------- +; THE 'COLLECT A CHARACTER' RESTART +;---------------------------------- +; The character addressed by the system variable CH_ADD is fetched and if it +; is a non-space, non-cursor character it is returned else CH_ADD is +; incremented and the new addressed character tested until it is not a space. +00000010: 2A 16 40 LD HL,(4016h) ; fetch character address from CH_ADD. +00000013: 7E LD A,(HL) ; fetch the character. +00000014: B7 OR A ; compare to cursor character ($7F on the ZX81). +00000015: C0 RET NZ ; return if not the cursor. +00000016: 18 F4 JR -0Ch ; back for next character to TEMP-PTR1. + +;-------------------------------- +; THE 'PRINT A CHARACTER' RESTART +;-------------------------------- +; This restart prints the character in the accumulator using the alternate +; register set so there is no requirement to save the main registers. +; There is sufficient room available to separate a space (zero) from other +; characters as leading spaces need not be considered with a space. + +00000018: C3 B4 04 JP 04B4h + + +;------------------------ +; Absolute magnitude +;------------------------ +; This calculator literal finds the absolute value of the last value, +; floating point, on calculator stack. + +;; abs +0000001B: 23 INC HL +0000001C: CB BE RES 7,(HL) +0000001E: 2B DEC HL +0000001F: C9 RET + + +;--------------------------- +; THE 'STK-FETCH' SUBROUTINE +;--------------------------- +; This routine fetches a five-byte value from the calculator stack +; reducing the pointer to the end of the stack by five. +; For a floating-point number the exponent is in A and the mantissa +; is the thirty-two bits EDCB. +; For strings, the start of the string is in DE and the length in BC. +; A is unused. + +;; STK-FETCH +00000020: 2A 1C 40 LD HL,(401Ch) ; STKEND +00000023: 2B DEC HL +00000024: 46 LD B,(HL) + +00000025: C3 25 14 JP 1425h + +; routine SYNTAX-Z +00000028: FD CB 1E 7E BIT 7,(IY+1Eh) ; BREG/FLAGS +0000002C: C9 RET + +;; BOOT / RESET pivot +0000002D: C3 28 0F JP 0F28h + +;; FP-CALC / CALCULATE +00000030: CD ED 18 CALL 18EDh ; STK-PNTRS + +;; GEN-ENT-2 +00000033: D9 EXX ; switch sets +00000034: E3 EX HL,(SP) ; and store the address of next instruction, the return address, in H'L'. + ; If this is a recursive call then the H'L' of the previous invocation goes on stack. + ; c.f. end-calc. +00000035: C3 7F 09 JP 097Fh + + +;------------------------ +; THE 'INTERRUPT' RESTART +;------------------------ +; +00000038: 05 DEC B +00000039: 20 0A JR NZ,+0Ah ; JUMP forward if not zero to SCAN-LINE +0000003B: E1 POP HL +0000003C: 0D DEC C +0000003D: C8 RET Z +0000003E: C8 RET Z +0000003F: 06 08 LD B,08h + +;; WAIT-INT +00000041: ED 4F LD R,A +00000043: FB EI +00000044: E9 JP (HL) + +00000045: D1 POP DE +00000046: 00 NOP +00000047: 18 F8 JR -08h ; WAIT-INT + +; conversion table for no-l-eql, etc +00000049: 06 05 03 01 02 04 + + +;------------------------------ +; Handle string AND number +;------------------------------ +; e.g. "YOU WIN" AND SCORE>99 will return the string if condition is true +; or the null string if false. + +;; str-&-no +0000004F: 1A LD A,(DE) ; fetch exponent of second number. +00000050: B7 OR A ; test it. +00000051: C0 RET NZ ; return if number was not zero - the string is the result. + +; if the number was zero (false) then the null string must be returned by +; altering the length of the string on the calculator stack to zero. + +00000052: 1B DEC DE ; point to the 5th byte of string descriptor. +00000053: 12 LD (DE),A ; place zero in high byte of length +00000054: 1B DEC DE ; address low byte of length +00000055: 12 LD (DE),A ; place zero there - now the null string +00000056: 13 INC DE ; restore pointer +00000057: 13 INC DE +00000058: C9 RET + +;; NMI-CONT +00000059: 08 EX AF,AF' +0000005A: F5 PUSH AF +0000005B: E5 PUSH HL +0000005C: D5 PUSH DE +0000005D: C5 PUSH BC +0000005E: 21 7D C0 LD HL,C07Dh ; point to upper 32K 'display file' ghosted copy +00000061: 76 HALT ; Wait for Interrupt +00000062: D3 FD OUTA (FDh) ; turn off the NMI generator. +00000064: DD E9 JP IX ; forward to 1323h or 1334h + +; NMI +00000066: 08 EX AF,AF' +00000067: 3C INC A +00000068: CA 59 00 JP Z,0059h +0000006B: 00 NOP +;; NMI-RET +0000006C: 08 EX AF,AF' +0000006D: C9 RET + + + +;---------------------- +; THE 'ARCSIN' FUNCTION +;---------------------- +; (Offset $??: 'asn') +; the inverse sine function with result in radians. +; derived from arctan function above. +; Error A unless the argument is between -1 and +1 inclusive. +; uses an adaptation of the formula asn(x) = atn(x/sqr(1-x*x)) +; +; +; /| +; 1 / | +; / |x +; /a | +; /----| +; y +; +; e.g. we know the opposite side (x) and hypotenuse (1) +; and we wish to find angle a in radians. +; we can derive length y by Pythagorus and then use ATN instead. +; since y*y + x*x = 1*1 (Pythagorus Theorum) then +; y=sqr(1-x*x) - no need to multiply 1 by itself. +; so, asn(a) = atn(x/y) +; or more fully, +; asn(a) = atn(x/sqr(1-x*x)) + +; Close but no cigar. + +; While PRINT ATN (x/SQR (1-x*x)) gives the same results as PRINT ASN x, +; it leads to division by zero when x is 1 or -1. +; To overcome this, 1 is added to y giving half the required angle and the +; result is then doubled. +; That is PRINT ATN (x/(SQR (1-x*x) +1)) *2 +; A value higher than 1 gives the required error as attempting to find the +; square root of a negative number generates an error in Sinclair BASIC. + +;; asn +0000006E: F7 RST 30h ; FP-CALC +0000006F: 01 ;;duplicate +00000070: 01 ;;duplicate +00000071: 1F ;;multiply +00000072: 79 ;;stk-one +00000073: 1E ;;subtract +00000074: 09 ;;negate +00000075: 16 ;;sqr +00000076: 79 ;;stk-one +00000077: 2A ;;addition +00000078: 20 ;;division +00000079: 12 ;;atn +0000007A: 01 ;;duplicate +0000007B: AA ;;addition & end-calc +0000007C: C9 RET + +;; NEXT-LINE +0000007D: 22 0A 40 LD (400Ah),HL ; NXTLIN (<> ZX81) +00000080: ED 53 16 40 LD (4016h),DE ; CH_ADD +00000084: FD CB 1E FE SET 7,(IY+1Eh) ; BREG/FLAGS + +;; LINE-RUN +00000088: FD 36 07 FF LD (IY+07h),FFh ; PPC low +0000008C: CD 1A 14 CALL 141Ah ; SET-MIN +0000008F: 3A 2D 40 LD A,(402Dh) ; FLAGX +00000092: CB 6F BIT 5,A +00000094: 20 4F JR NZ,+4Fh +;; LINE-NULL +00000096: D7 RST 10h ; GET-CHAR +00000097: FE 76 CP 76h ; compare to NEWLINE. +00000099: C8 RET Z ; return if so. + +0000009A: 11 F1 00 LD DE,00F1h ; offset to offset table. +0000009D: FE 46 CP 46h +0000009F: 38 0C JR C,+0Ch +000000A1: FE DC CP DCh +000000A3: 30 06 JR NC,+06h +000000A5: FE 49 CP 49h +000000A7: 30 04 JR NC,+04h +000000A9: C6 93 ADD 93h ; adjust token to offset + +000000AB: 5F LD E,A ; transfer character to E. + +000000AC: CF RST 08h ; NEXT-CHAR + +000000AD: 21 02 1A LD HL,1A02h ; offset table. +000000B0: 19 ADD HL,DE ; index into offset table. +000000B1: 5E LD E,(HL) ; fetch offset +000000B2: 19 ADD HL,DE ; index into parameter table. + +;; GET-PARAM +000000B3: 7E LD A,(HL) +000000B4: 23 INC HL + +000000B5: 22 30 40 LD (4030h),HL ; T_ADDR +000000B8: 5F LD E,A +000000B9: FE 0D CP 0Dh +000000BB: 38 0B JR C,+0Bh +000000BD: D7 RST 10h ; GET-CHAR +000000BE: BB CP E +000000BF: C2 42 0A JP NZ,0A42h ; to REPORT-C + +000000C2: CF RST 08h ; NEXT-CHAR + +;; SCAN-LOOP +000000C3: 2A 30 40 LD HL,(4030h) ; T_ADDR +000000C6: 18 EB JR -15h ; to GET-PARAM + +000000C8: 16 00 LD D,00h +000000CA: 21 D1 09 LD HL,09D1h +000000CD: 19 ADD HL,DE +000000CE: 5E LD E,(HL) +000000CF: 19 ADD HL,DE +000000D0: 11 C3 00 LD DE,00C3h ; Address: SCAN-LOOP +000000D3: D5 PUSH DE ; is pushed on machine stack. +000000D4: E5 PUSH HL +000000D5: D7 RST 10h ; GET-CHAR +000000D6: C9 RET + +000000D7: EF RST 28h ; routine SYNTAX-Z +000000D8: 28 05 JR Z,+05h + +000000DA: F7 RST 30h ; FP-CALC +000000DB: B5 ;;delete & end-calc + +000000DC: 1A LD A,(DE) +000000DD: B7 OR A +000000DE: C8 RET Z +000000DF: D7 RST 10h ; GET-CHAR +000000E0: 18 B8 JR -48h +000000E2: 3A 1E 40 LD A,(401Eh) ; BREG/FLAGS +000000E5: F5 PUSH AF +000000E6: CD 06 08 CALL 0806h ; SCANNING +000000E9: F1 POP AF +000000EA: FD AE 1E XOR (IY+1Eh) ; BREG/FLAGS +000000ED: CB 77 BIT 6,A +000000EF: 20 CE JR NZ,-32h + + +; offset fable +000000F1: CD 3B 0A CALL 0A3Bh ; routine CHECK-END +000000F4: FD CB 2D AE RES 5,(IY+2Dh) ; FLAGX + +;--------------------- +; THE 'LET' SUBROUTINE +;--------------------- +; +; + +;; LET +000000F8: 2A 12 40 LD HL,(4012h) ; DEST +000000FB: FD CB 2D 4E BIT 1,(IY+2Dh) ; FLAGX +000000FF: 20 26 JR NZ,+26h + +;; L-EXISTS +00000101: CD 7A 09 CALL 097Ah ; routine SYNTAX-Z +00000104: 20 50 JR NZ,+50h +00000106: ED 4B 2E 40 LD BC,(402Eh) ; STRLEN +0000010A: 3A 2D 40 LD A,(402Dh) ; FLAGX +0000010D: 1F RRA +0000010E: 38 51 JR C,+51h +00000110: C5 PUSH BC +00000111: E5 PUSH HL +00000112: E7 RST 20h ; STK-FETCH +00000113: E1 POP HL +00000114: D9 EXX +00000115: C1 POP BC +00000116: 79 LD A,C +00000117: B0 OR B +00000118: 0B DEC BC +00000119: D9 EXX +0000011A: C8 RET Z +0000011B: 78 LD A,B +0000011C: B1 OR C +0000011D: 28 03 JR Z,+03h +0000011F: 0B DEC BC +00000120: 1A LD A,(DE) +00000121: 13 INC DE +00000122: 77 LD (HL),A +00000123: 23 INC HL +00000124: D9 EXX +00000125: 18 EF JR -11h + +;; LET (continued) +00000127: 01 05 00 LD BC,0005h +0000012A: CD 36 05 CALL 0536h +0000012D: 30 FB JR NC,-05h +0000012F: EE 0D XOR 0Dh ; is it '$' ? +00000131: 28 5F JR Z,+5Fh ; forward if so to L-NEW$ + +00000133: CD DD 0B CALL 0BDDh ; BC-SPACES +00000136: 79 LD A,C +00000137: D6 06 SUB 06h +00000139: 4F LD C,A +0000013A: 3E 80 LD A,80h +0000013C: 20 01 JR NZ,+01h +0000013E: 0F RRCA +0000013F: 2A 12 40 LD HL,(4012h) ; DEST +00000142: AE XOR (HL) +00000143: D5 PUSH DE +00000144: F2 4E 01 JP P,014Eh +00000147: 23 INC HL +00000148: ED B0 LDIR +0000014A: 1B DEC DE +0000014B: EB EX DE,HL +0000014C: CB FE SET 7,(HL) +0000014E: E1 POP HL +0000014F: CD AF 01 CALL 01AFh +00000152: 01 FA FF LD BC,FFFAh +00000155: 09 ADD HL,BC + +; part of S-DECIMAL +00000156: 23 INC HL +00000157: E5 PUSH HL + +00000158: F7 RST 30h ; FP-CALC +00000159: B5 ;;delete & end-calc + +0000015A: EB EX DE,HL +0000015B: D1 POP DE +0000015C: 01 05 00 LD BC,0005h ; five bytes to move. +0000015F: 18 2C JR +2Ch + +;; L-ADD$ +00000161: 2B DEC HL +00000162: 2B DEC HL +00000163: 2B DEC HL +00000164: E5 PUSH HL +00000165: 7E LD A,(HL) +00000166: CD 96 01 CALL 0196h ; L-STRING +00000169: E1 POP HL +0000016A: CD 13 1A CALL 1A13h ; routine NEXT-ONE +0000016D: 18 08 JR +08h + +;; RECLAIM-1 +0000016F: CD 37 1A CALL 1A37h ; routine DIFFER +00000172: 18 03 JR +03h + +;--------------------------- +; THE 'CLEAR-ONE' SUBROUTINE +;--------------------------- +; +; + +;; CLEAR-ONE +00000174: 01 01 00 LD BC,0001h +;; RECLAIM-2 +00000177: C5 PUSH BC +00000178: AF XOR A +00000179: 91 SUB C +0000017A: 4F LD C,A +0000017B: 3E 00 LD A,00h +0000017D: 98 SBC B +0000017E: 47 LD B,A +0000017F: CD 3F 1A CALL 1A3Fh ; routine POINTERS +00000182: EB EX DE,HL +00000183: 2A 1C 40 LD HL,(401Ch) ; STKEND low +00000186: A7 AND A +00000187: ED 52 SBC HL,DE +00000189: 44 LD B,H +0000018A: 4D LD C,L +0000018B: E1 POP HL +0000018C: 19 ADD HL,DE + +; part of S-DECIMAL +0000018D: D5 PUSH DE +0000018E: ED B0 LDIR +00000190: E1 POP HL +00000191: C9 RET + +;; L-NEW$ +00000192: 2B DEC HL +00000193: 3E 60 LD A,60h ; prepare mask %01100000 +00000195: AE XOR (HL) + +; ------------------------- +; THE 'L-STRING' SUBROUTINE +; ------------------------- +; + +;; L-STRING +00000196: F5 PUSH AF +00000197: E7 RST 20h ; routine STK-FETCH +00000198: EB EX DE,HL +00000199: 09 ADD HL,BC +0000019A: 03 INC BC +0000019B: 03 INC BC +0000019C: E5 PUSH HL +0000019D: 03 INC BC +0000019E: CD DD 0B CALL 0BDDh ; BC-SPACES +000001A1: 0B DEC BC +000001A2: D1 POP DE +000001A3: 0B DEC BC +000001A4: EB EX DE,HL +000001A5: C5 PUSH BC +000001A6: ED B8 LDDR ; Copy Bytes +000001A8: C1 POP BC +000001A9: EB EX DE,HL +000001AA: 0B DEC BC +000001AB: 70 LD (HL),B +000001AC: 2B DEC HL +000001AD: 71 LD (HL),C +000001AE: FE F5 CP F5h + +000001B0: ED 5B 14 40 LD DE,(4014h) ; E_LINE +000001B4: CD 6F 01 CALL 016Fh ; RECLAIM-1 +000001B7: 2B DEC HL +000001B8: F1 POP AF + +;; L-FIRST +000001B9: 77 LD (HL),A +000001BA: 2A 1A 40 LD HL,(401Ah) ; STKBOT +000001BD: 22 14 40 LD (4014h),HL ; E_LINE +000001C0: 2B DEC HL +000001C1: 36 80 LD (HL),80h +000001C3: C9 RET + +0;--------------------------- +; THE 'POKE' COMMAND ROUTINE +;--------------------------- +; +; + +;; POKE +00001C4: CD FF 14 CALL 14FFh ; STK-TO-A +000001C7: F5 PUSH AF +000001C8: CD 09 15 CALL 1509h ; FIND-INT +000001CB: F1 POP AF +000001CC: 02 LD (BC),A +000001CD: C9 RET + +; ---------------------------------- +; THE 'FETCH TWO NUMBERS' SUBROUTINE +; ---------------------------------- +; This routine is used by addition, multiplication and division to fetch +; the two five-byte numbers addressed by HL and DE from the calculator stack +; into the Z80 registers. +; The HL register may no longer point to the first of the two numbers. +; Since the 32-bit addition operation is accomplished using two Z80 16-bit +; instructions, it is important that the lower two bytes of each mantissa are +; in one set of registers and the other bytes all in the alternate set. +; +; In: HL = highest number, DE= lowest number +; +; : alt': : +; Out: :H,B-C:C,B: num1 +; :L,D-E:D-E: num2 + +;; FETCH-TWO +000001CE: 4E LD C,(HL) +000001CF: 23 INC HL +000001D0: 46 LD B,(HL) +000001D1: 77 LD (HL),A ; insert sign when used from multiplication. +000001D2: 79 LD A,C ; m1 +000001D3: 23 INC HL +000001D4: 4E LD C,(HL) +000001D5: 23 INC HL +000001D6: C5 PUSH BC ; PUSH m2 m3 +000001D7: 46 LD B,(HL) +000001D8: 23 INC HL +000001D9: 4E LD C,(HL) ; m4 +000001DA: EB EX DE,HL ; make HL point to start of second number. +000001DB: 56 LD D,(HL) +000001DC: 23 INC HL +000001DD: 5F LD E,A +000001DE: D5 PUSH DE +000001DF: 56 LD D,(HL) +000001E0: 23 INC HL +000001E1: 5E LD E,(HL) +000001E2: 23 INC HL +000001E3: D5 PUSH DE +000001E4: 56 LD D,(HL) +000001E5: 23 INC HL +000001E6: 5E LD E,(HL) +000001E7: D9 EXX +000001E8: D1 POP DE +000001E9: E1 POP HL +000001EA: C1 POP BC +000001EB: D9 EXX +000001EC: C9 RET + +;; DISPLAY-3 +000001ED: FD 46 28 LD B,(IY+28h) ; load B with MARGIN +000001F0: DD E1 POP IX ; return address to IX register (see above) + ; It will be either 1323h or 1334h +000001F2: FD CB 3B 7E BIT 7,(IY+3Bh) ; test CDFLAG +000001F6: 28 0C JR Z,+0Ch ; forward to DISPLAY-4 + +000001F8: 78 LD A,B +000001F9: 3D DEC A +000001FA: ED 44 NEG +000001FC: 08 EX AF,AF' +000001FD: D3 FE OUTA (FEh) ; enable the NMI generator. + +000001FF: C1 POP BC +00000200: D1 POP DE +00000201: E1 POP HL +00000202: F1 POP AF +00000203: C9 RET + + +;; DISPLAY-4 +00000204: 0E 01 LD C,01h +00000206: 3E FC LD A,FCh +00000208: CD 66 16 CALL 1666h +0000020B: E3 EX HL,(SP) +0000020C: E3 EX HL,(SP) +0000020D: 2B DEC HL +0000020E: DD E9 JP IX + +;----------------------------- +; THE 'STACK-TO-BC' SUBROUTINE +;----------------------------- +; +; + +;; STK-TO-BC +00000210: CD FF 14 CALL 14FFh ; STK-TO-A +00000213: F5 PUSH AF +00000214: CD FF 14 CALL 14FFh ; STK-TO-A +00000217: F1 POP AF +00000218: 47 LD B,A +00000219: C9 RET + +;------------------- +; Series generator +;------------------- +; The ZX81 uses Chebyshev polynomials to generate approximations for +; SIN, ATN, LN and EXP. (...) + +;; series-xx +0000021A: 32 09 40 LD (4009h),A ; VERSN acts as a counter and is loaded with parameter $00 - $1F + ; on the ZX81 the counter was stored in register B + +0000021D: F7 RST 30h ; FP-CALC + +; The initialization phase. + +0000021E: 01 ;;duplicate x,x +0000021F: 2A ;;addition x+x +00000220: 50 ;;st-mem-0 x+x +00000221: 35 ;;delete . +00000222: 7A ;;stk-zero 0 +00000223: DA ;;st-mem-2 & end-calc 0 + +; a loop is now entered to perform the algebraic calculation for each of +; the numbers in the series + +;; G-LOOP +00000224: F7 RST 30h ; FP-CALC +00000225: 01 ;;duplicate v,v. +00000226: 40 ;;get-mem-0 v,v,x+2 +00000227: 1F ;;multiply v,v*x+2 +00000228: 4A ;;get-mem-2 v,v*x+2,v +00000229: 55 ;;st-mem-1 +0000022A: 9E ;;subtract & end.calc + +; the previous pointer is fetched from the machine stack to H'L' where it +; addresses one of the numbers of the series following the series literal. + +0000022B: CD 31 0D CALL 0D31h ; routine STK-DATA is called directly to push a value and advance H'L'. +0000022E: CD 33 00 CALL 0033h ; routine GEN-ENT-2 recursively re-enters the calculator without disturbing system variable BREG + ; H'L' value goes on the machine stack and is then loaded as usual with the next address. + +00000231: 2A ;;addition +00000232: 33 ;;exchange +00000233: 5A ;;st-mem-2 +00000234: B5 ;;delete & end-calc + +00000235: FD 35 09 DEC (IY+09h) ; VERSN +00000238: 20 EA JR NZ,-16h ; loop to G-LOOP + +0000023A: F7 RST 30h ; FP-CALC +0000023B: 45 LD B,L +0000023C: 9E ;;subtract & end-calc +0000023D: C9 RET + +;; +0000023E: CD 54 14 CALL 1454h ; routine LINE-ENDS +00000241: CD C2 06 CALL 06C2h ; routine LEFT-EDGE +00000244: CD 74 01 CALL 0174h ; routine CLEAR-ONE +00000247: 2A 14 40 LD HL,(4014h) ; E_LINE +0000024A: 54 LD D,H +0000024B: 5D LD E,L +0000024C: 2B DEC HL +0000024D: 22 16 40 LD (4016h),HL ; CH_ADD +00000250: CF RST 08h ; NEXT-CHAR +00000251: 12 LD (DE),A +00000252: 13 INC DE +00000253: FE 76 CP 76h +00000255: 28 45 JR Z,+45h +00000257: FE 0B CP 0Bh +00000259: 28 08 JR Z,+08h +0000025B: D5 PUSH DE +0000025C: 11 82 05 LD DE,0582h ; 'TOKENS' TABLE +0000025F: 0E 00 LD C,00h +00000261: 18 1C JR +1Ch + +00000263: 23 INC HL +00000264: 7E LD A,(HL) +00000265: 12 LD (DE),A +00000266: 13 INC DE +00000267: FE 76 CP 76h +00000269: 28 31 JR Z,+31h +0000026B: FE 0B CP 0Bh +0000026D: 20 F4 JR NZ,-0Ch +0000026F: 18 DC JR -24h +00000271: 1A LD A,(DE) +00000272: 13 INC DE +00000273: 17 RLA +00000274: 30 FB JR NC,-05h +00000276: 0C INC C +00000277: 3E 48 LD A,48h +00000279: B9 CP C +0000027A: 30 03 JR NC,+03h +0000027C: D1 POP DE +0000027D: 18 D1 JR -2Fh + +0000027F: 2A 16 40 LD HL,(4016h) ; CH_ADD +00000282: 1A LD A,(DE) +00000283: 47 LD B,A +00000284: E6 3F AND 3Fh +00000286: BE CP (HL) +00000287: 20 E8 JR NZ,-18h +00000289: 23 INC HL +0000028A: 13 INC DE +0000028B: CB 78 BIT 7,B +0000028D: 28 F3 JR Z,-0Dh +0000028F: D1 POP DE +00000290: 1B DEC DE +00000291: 79 LD A,C +00000292: CB 77 BIT 6,A +00000294: 20 02 JR NZ,+02h +00000296: F6 C0 OR C0h +00000298: 12 LD (DE),A +00000299: 13 INC DE +0000029A: 18 B0 JR -50h +0000029C: EB EX DE,HL +0000029D: CD E1 13 CALL 13E1h ; SET-STK-B +000002A0: 21 FC 0F LD HL,0FFCh +000002A3: E5 PUSH HL +000002A4: AF XOR A +000002A5: 32 1E 40 LD (401Eh),A ; BREG/FLAGS +000002A8: CD 80 13 CALL 1380h ; E-LINE-NO +000002AB: CD 88 00 CALL 0088h ; LINE-RUN +000002AE: D1 POP DE +000002AF: CD 80 13 CALL 1380h ; E-LINE-NO +000002B2: 28 0D JR Z,+0Dh +000002B4: ED 4B 30 40 LD BC,(4030h) ; T_ADDR +000002B8: CD 93 14 CALL 1493h ; call LOC-ADDR +000002BB: ED 5B 0A 40 LD DE,(400Ah) ; NXTLIN (<> ZX81) +000002BF: 18 49 JR +49h +000002C1: B0 OR B +000002C2: 28 3A JR Z,+3Ah +000002C4: 21 30 03 LD HL,0330h +000002C7: E5 PUSH HL +000002C8: ED 43 29 40 LD (4029h),BC ; E_PPC (<> ZX81) + +000002CC: 2A 1A 40 LD HL,(401Ah) ; STKBOT +000002CF: ED 5B 16 40 LD DE,(4016h) ; CH_ADD +000002D3: ED 52 SBC HL,DE +000002D5: E5 PUSH HL +000002D6: CD 38 0B CALL 0B38h ; routine LINE-ADDR (BC) +000002D9: CC 6A 01 CALL Z,016Ah +000002DC: C1 POP BC +000002DD: 79 LD A,C +000002DE: 3D DEC A +000002DF: B0 OR B +000002E0: 28 18 JR Z,+18h + +000002E2: C5 PUSH BC + +000002E3: CD B1 1C CALL 1CB1h ; MAKE-ROOM plus 4 +000002E6: 23 INC HL +000002E7: ED 5B 29 40 LD DE,(4029h) ; E_PPC (<> ZX81) +000002EB: 72 LD (HL),D +000002EC: 23 INC HL +000002ED: 73 LD (HL),E +000002EE: 23 INC HL +000002EF: C1 POP BC +000002F0: 71 LD (HL),C +000002F1: 23 INC HL +000002F2: 70 LD (HL),B +000002F3: 23 INC HL +000002F4: EB EX DE,HL +000002F5: 2A 16 40 LD HL,(4016h) ; CH_ADD +000002F8: ED B0 LDIR +000002FA: E1 POP HL + +;; jumps to N/L-ONLY +000002FB: C3 63 18 JP 1863h ; to N/L-ONLY + +;; TEST-NULL +000002FE: D7 RST 10h ; GET-CHAR +000002FF: FE 76 CP 76h +;; N/L-NULL +00000301: 28 F8 JR Z,-08h ; to N/L-ONLY + +00000303: 3C INC A +00000304: C4 7A 1C CALL NZ,1C7Ah ; CLEAR-PRB and CLS +00000307: 11 7D 40 LD DE,407Dh ; D-FILE +0000030A: D7 RST 10h ; GET-CHAR +0000030B: EB EX DE,HL +0000030C: FD 36 22 02 LD (IY+22h),02h ; DF_SZ +00000310: CD 7D 00 CALL 007Dh ; NEXT-LINE +00000313: CD 45 14 CALL 1445h ; X-TEMP +00000316: FD CB 1E 8E RES 1,(IY+1Eh) ; BREG/FLAGS +0000031A: 3A 07 40 LD A,(4007h) ; PPC low / ERR NR +0000031D: E6 C0 AND C0h +0000031F: 28 0F JR Z,+0Fh + +00000321: 2A 0A 40 LD HL,(400Ah) ; NXTLIN (<> ZX81) +00000324: A6 AND (HL) +00000325: 20 09 JR NZ,+09h ; to STOP-LINE + +00000327: CD 1A 1C CALL 1C1Ah +0000032A: 38 E4 JR C,-1Ch +0000032C: FD 36 07 01 LD (IY+07h),01h ; PPC low + +;; STOP-LINE +00000330: CD CA 1C CALL 1CCAh ; run COPY-BUFF if printer is enabled +00000333: 06 01 LD B,01h +00000335: CD 91 14 CALL 1491h ; LOC-ADDR for current row +00000338: ED 5B 36 40 LD DE,(4036h) ; LAMBDA-VAR +0000033C: FD 36 37 F0 LD (IY+37h),F0h ; LAMBDA-VAR +1 +00000340: 3A 07 40 LD A,(4007h) ; PPC low / ERR NR +00000343: 3C INC A +00000344: 28 0A JR Z,+0Ah ; to REPORT + +00000346: 62 LD H,D +00000347: 6B LD L,E +00000348: FE 01 CP 01h +0000034A: 20 01 JR NZ,+01h ; to CONTINUE +0000034C: 23 INC HL + +;; CONTINUE +0000034D: 22 2B 40 LD (402Bh),HL ; OLDPPC + +;; REPORT +00000350: FE 04 CP 04h +00000352: F5 PUSH AF +00000353: 87 ADD A +00000354: 4F LD C,A +00000355: AF XOR A +00000356: 47 LD B,A +00000357: 32 2D 40 LD (402Dh),A ; FLAGX +0000035A: 32 19 40 LD (4019h),A ; X_PTR_high +0000035D: 32 22 40 LD (4022h),A ; DF_SZ + +00000360: 21 E5 07 LD HL,07E5h ; ERR-MSG table +00000363: 09 ADD HL,BC +00000364: 7E LD A,(HL) +00000365: DF RST 18h ; PRINT-A +00000366: 23 INC HL +00000367: 7E LD A,(HL) +00000368: DF RST 18h ; PRINT-A +00000369: CB 7A BIT 7,D +0000036B: 20 0D JR NZ,+0Dh +0000036D: AF XOR A +0000036E: DF RST 18h ; PRINT-A +0000036F: 3E 2E LD A,2Eh +00000371: DF RST 18h ; PRINT-A +00000372: 3E 33 LD A,33h +00000374: DF RST 18h ; PRINT-A +00000375: AF XOR A +00000376: DF RST 18h ; PRINT-A +00000377: CD 87 04 CALL 0487h +0000037A: F1 POP AF +0000037B: D4 B0 0B CALL NC,0BB0h ; ALERT BEEP +0000037E: CD 2D 1C CALL 1C2Dh ; DEBOUNCE +00000381: C3 21 12 JP 1221h + +00000384: FD CB 2D 6E BIT 5,(IY+2Dh) ; FLAGX +00000388: CA 63 18 JP Z,1863h ; to N/L-ONLY +0000038B: CD 54 14 CALL 1454h ; routine LINE-ENDS +0000038E: 18 9C JR -64h + +;------------------------- +; THE 'ARCCOS' FUNCTION +;------------------------- +; (Offset $??: 'acs') +; the inverse cosine function with the result in radians. +; Error A unless the argument is between -1 and +1. +; Result in range 0 to pi. +; Derived from asn above which is in turn derived from the preceding atn. +; It could have been derived directly from atn using acs(x) = atn(sqr(1-x*x)/x). +; However, as sine and cosine are horizontal translations of each other, +; uses acs(x) = pi/2 - asn(x) + +; e.g. the arccosine of a known x value will give the required angle b in +; radians. +; We know, from above, how to calculate the angle a using asn(x). +; Since the three angles of any triangle add up to 180 degrees, or pi radians, +; and the largest angle in this case is a right-angle (pi/2 radians), then +; we can calculate angle b as pi/2 (both angles) minus asn(x) (angle a). +; +; +; /| +; 1 /b| +; / |x +; /a | +; /----| +; y + +;; acs +00000390: F7 RST 30h ; FP-CALC +00000391: 10 ;;asn +00000393: 70 ;;stk-pi/2 +00000393: 1E ;;subtract +00000394: 89 ;;negate & end-calc +00000395: C9 RET + + + +00000396: 4F LD C,A +00000397: CD C2 06 CALL 06C2h ; routine LEFT-EDGE +0000039A: 79 LD A,C +0000039B: 01 01 00 LD BC,0001h +0000039E: CD B5 1C CALL 1CB5h ; MAKE-ROOM +000003A1: 12 LD (DE),A +000003A2: C9 RET + + +;------------------------------- +; Get from memory area ($E0 etc. ???) +;------------------------------- +; Literals $E0 to $FF ??? +; A holds $00-$1F offset. +; The calculator stack increases by 5 bytes. + +;; get-mem-xx +000003A3: D5 PUSH DE +000003A4: CD 95 1B CALL 1B95h ; LOC-MEM +000003A7: CD 6F 07 CALL 076Fh ; MOVE-FP +000003AA: E1 POP HL +000003AB: C9 RET + +;------------------------- +; THE 'EDITING KEYS' TABLE +;------------------------- +; +; + +;; ED-KEYS +000003AC: + DEFW 1808h ; Address: UP-KEY + DEFW 1800h ; Address: + DEFW 1639h ; Address: + DEFW 1654h ; Address: + DEFW 1282h ; Address: + DEFW 0FC7h ; Address: N/L-KEY + DEFW 02E3h ; Address: + DEFW 1639h ; Address: + DEFW 127Ch ; Address: + DEFW 0384h ; Address: + DEFW 1073h ; Address: + + +;--------------------------------- +; THE 'REDUCE ARGUMENT' SUBROUTINE +;--------------------------------- +; (offset ??: 'get-argt') +; +; This routine performs two functions on the angle, in radians, that forms +; the argument to the sine and cosine functions. +; First it ensures that the angle 'wraps round'. That if a ship turns through +; an angle of, say, 3*PI radians (540 degrees) then the net effect is to turn +; through an angle of PI radians (180 degrees). +; Secondly it converts the angle in radians to a fraction of a right angle, +; depending within which quadrant the angle lies, with the periodicity +; resembling that of the desired sine value. +; The result lies in the range -1 to +1. +; +; 90 deg. +; +; (pi/2) +; II +1 I +; | +; sin+ |\ | /| sin+ +; cos- | \ | / | cos+ +; tan- | \ | / | tan+ +; | \|/) | +; 180 deg. (pi) 0 -|----+----|-- 0 (0) 0 degrees +; | /|\ | +; sin- | / | \ | sin- +; cos- | / | \ | cos+ +; tan+ |/ | \| tan- +; | +; III -1 IV +; (3pi/2) +; +; 270 deg. + + +;; get-argt +000003C2: F7 RST 30h ; FP-CALC +000003C3: 05 ;;stk-data +000003C4: EE ;;Exponent: $7E, Bytes: 4 +000003C5: 22 F9 83 6E ; X, 1/(2*PI) +000003C9: 1F ;;multiply +000003CA: 01 ;;duplicate +000003CB: 75 ;;stk-half +000003CC: 2A ;;addition +000003CD: 15 ;;int +000003CE: 1E ;;subtract now range -.5 to .5 +000003CF: 01 ;;duplicate +000003D0: 2A ;;addition now range -1 to 1. +000003D1: 01 ;;duplicate +000003D2: 2A ;;addition now range -2 to 2. + +; quadrant I (0 to +1) and quadrant IV (-1 to 0) are now correct. +; quadrant II ranges +1 to +2. +; quadrant III ranges -2 to -1. + +000003D3: 01 ;;duplicate Y, Y. +000003D4: 18 ;;abs Y, abs(Y). range 1 to 2 +000003D5: 79 ;;stk-one Y, abs(Y), 1. +000003D6: 1E ;;subtract Y, abs(Y)-1. range 0 to 1 +000003D6: 01 ;;duplicate Y, Z, Z. +000003D8: 02 ;;greater-0 Y, Z, (1/0). +000003D9: 50 ;;st-mem-0 store as possible sign for cosine function. +000003DA: 34 ;;jump-true +000003DB: 03 ;;to ZPLUS with quadrants II and III + +; else the angle lies in quadrant I or IV and value Y is already correct. + +000003DC: B5 ;;delete & end-calc delete test value. +000003DD: C9 RET + +;; ZPLUS +000003DE: 79 ;;stk-one Y, Z, 1 +000003DF: 1E ;;subtract Y, Z-1. Q3 = 0 to -1 +000003E0: 33 ;;exchange Z-1, Y. +000003E1: 03 ;;less-0 Z-1, (1/0). +000003E2: 34 ;;jump-true Z-1. +000003E3: 02 ;;to YNEG if angle in quadrant III + +; else angle is within quadrant II (-1 to 0) + +000003E4: 09 ;;negate +;; YNEG +000003E5: 00 ;;end-calc +000003E6: C9 RET + +; **************** +; ** KEY TABLES ** +; **************** + +; ------------------------------- +; THE 'UNSHIFTED' CHARACTER CODES +; ------------------------------- + +;; K-UNSHIFT + +000003E7: + ; (SHIFT KEY is kept into consideratin by pointing to the key table 1 byte backwords) + DEFB $3F ; Z + DEFB $3D ; X + DEFB $28 ; C + DEFB $3B ; V + + DEFB $26 ; A + DEFB $38 ; S + DEFB $29 ; D + DEFB $2B ; F + DEFB $2C ; G + + DEFB $36 ; Q + DEFB $3C ; W + DEFB $2A ; E + DEFB $37 ; R + DEFB $39 ; T + + DEFB $1D ; 1 + DEFB $1E ; 2 + DEFB $1F ; 3 + DEFB $20 ; 4 + DEFB $21 ; 5 + + DEFB $1C ; 0 + DEFB $25 ; 9 + DEFB $24 ; 8 + DEFB $23 ; 7 + DEFB $22 ; 6 + + DEFB $35 ; P + DEFB $34 ; O + DEFB $2E ; I + DEFB $3A ; U + DEFB $3E ; Y + + DEFB $76 ; NEWLINE + DEFB $31 ; L + DEFB $30 ; K + DEFB $2F ; J + DEFB $2D ; H + + DEFB $00 ; SPACE + DEFB $1B ; . + DEFB $32 ; M + DEFB $33 ; N + DEFB $27 ; B + + +; ----------------------------- +; THE 'SHIFTED' CHARACTER CODES +; ----------------------------- + + +;; K-SHIFT +0000040E: + ; (SHIFT KEY is kept into consideratin by pointing to the key table 1 byte backwords) + DEFB $F5 ; PRINT + DEFB $7A ; "LINE NO" + DEFB $70 ; cursor-up + DEFB $71 ; cursor-down + + DEFB $C6 ; ASN + DEFB $C7 ; ACS + DEFB $C8 ; ATN + DEFB $CA ; EXP + DEFB $CE ; ABS + + DEFB $C3 ; SIN + DEFB $C4 ; COS + DEFB $C5 ; TAN + DEFB $C9 ; LOG (LN) + DEFB $CD ; SGN + + DEFB $0F ; "ghost" + DEFB $0C ; "spider" + DEFB $0E ; "butterfly" + DEFB $0D ; $ + DEFB $0B ; " + + DEFB $14 ; = + DEFB $11 ; ) + DEFB $10 ; ( + DEFB $1A ; , + DEFB $19 ; ; + + DEFB $12 ; > + DEFB $13 ; < + DEFB $45 ; PI + DEFB $43 ; RND + DEFB $CC ; SQR + + DEFB $74 ; GL (enter / exit graphics mode) + DEFB $15 ; + + DEFB $16 ; - + DEFB $17 ; * + DEFB $18 ; / + + DEFB $79 ; BREAK + DEFB $77 ; DELETE (rubout) + DEFB $75 ; EDIT + DEFB $73 ; cursor-right + DEFB $72 ; cursor-left + + + +; ------------------------------- +; THE 'PREPARE TO ADD' SUBROUTINE +; ------------------------------- +; This routine is called twice to prepare each floating point number for +; addition, in situ, on the calculator stack. +; The exponent is picked up from the first byte which is then cleared to act +; as a sign byte and accept any overflow. +; If the exponent is zero then the number is zero and an early return is made. +; The now redundant sign bit of the mantissa is set and if the number is +; negative then all five bytes of the number are twos-complemented to prepare +; the number for addition. +; On the second invocation the exponent of the first number is in B. + + +;; PREP-ADD +00000435: 7E LD A,(HL) +00000436: B7 OR A +00000437: C8 RET Z +00000438: 36 00 LD (HL),00h ; make this byte zero to take any overflow and default to positive. +0000043A: 23 INC HL ; point to first byte of mantissa. +0000043B: CB 7E BIT 7,(HL) ; test the sign bit. +0000043D: CB FE SET 7,(HL) ; set it to its implied state. +0000043F: 2B DEC HL ; set pointer to first byte again. +00000440: C8 RET Z ; return if bit indicated number is positive.>> + +; if negative then all five bytes are twos complemented starting at LSB. + +0000441: C5 PUSH BC +00000442: 01 05 00 LD BC,0005h +00000445: 09 ADD HL,BC ; point to location after 5th byte. +00000446: 41 LD B,C ; set the B counter to five. +00000447: 4F LD C,A ; store original exponent in C. + +; now enter a loop to twos-complement the number. +; The first of the five bytes becomes $FF to denote a negative number. + +;; NEG-BYTE + +00000448: 2B DEC HL +00000449: 3E 00 LD A,00h +0000044B: 9E SBC (HL) +0000044C: 77 LD (HL),A +0000044D: 10 F9 DJNZ -07h +0000044F: 79 LD A,C +00000450: C1 POP BC +00000451: C9 RET + + +;------------------------------- +; THE 'EXPAND TOKENS' SUBROUTINE +;------------------------------- +; +; + +;; TOKENS +00000452: CB 77 BIT 6,A +00000454: 28 5E JR Z,+5Eh +00000456: E5 PUSH HL +00000457: B7 OR A +00000458: F2 5D 04 JP P,045Dh + +0000045B: E6 3F AND 3Fh +0000045D: 21 81 05 LD HL,0581h ; Address of TOKENS +00000460: FE 49 CP 49h +00000462: 30 09 JR NC,+09h +00000464: 3C INC A ; skip first token ('.', used for all non-existing keywords) +00000465: 47 LD B,A ; get token code +;; WORDS +00000466: 7E LD A,(HL) +00000467: 23 INC HL +00000468: 17 RLA ; +00000469: 30 FB JR NC,-05h ; loop to WORDS until word-end marker is found + +0000046B: 10 F9 DJNZ -07h ; to WORDS + + +0000046D: CB 76 BIT 6,(HL) +0000046F: 20 08 JR NZ,+08h ; to COMP-FLAG + +00000471: FD CB 1E 46 BIT 0,(IY+1Eh) ; BREG/FLAGS +00000475: 28 02 JR Z,+02h + +00000477: AF XOR A ; leading SPACE +00000478: DF RST 18h ; PRINT-A +00000479: 7E LD A,(HL) ; pick character from TOKEN table +0000047A: E6 3F AND 3Fh ; mask leftmost bit (word termination) +0000047C: DF RST 18h ; PRINT-A +0000047D: 7E LD A,(HL) ; pick character again +0000047E: 23 INC HL ; increment ptr to TOKEN table +0000047F: 87 ADD A ; shift left +00000480: 30 F7 JR NC,-09h ; loop until word-end marker is found + +00000482: E1 POP HL +00000483: F8 RET M +00000484: AF XOR A +00000485: 18 2D JR +2Dh +00000487: 0E FF LD C,FFh +00000489: E5 PUSH HL +0000048A: EB EX DE,HL +0000048B: 11 18 FC LD DE,FC18h +0000048E: CD A2 04 CALL 04A2h +00000491: 11 9C FF LD DE,FF9Ch +00000494: CD A2 04 CALL 04A2h +00000497: 1E F6 LD E,F6h +00000499: CD A2 04 CALL 04A2h +0000049C: 7D LD A,L +0000049D: CD B1 04 CALL 04B1h +000004A0: E1 POP HL +000004A1: C9 RET +000004A2: AF XOR A +000004A3: 19 ADD HL,DE +000004A4: 3C INC A +000004A5: 38 FC JR C,-04h +000004A7: ED 52 SBC HL,DE +000004A9: 3D DEC A +000004AA: 20 05 JR NZ,+05h +000004AC: 79 LD A,C +000004AD: B7 OR A +000004AE: F8 RET M +000004AF: 18 0E JR +0Eh + +000004B1: 0E 1C LD C,1Ch +000004B3: 81 ADD C + + +;; PRINT-A + +000004B4: FD CB 1E C6 SET 0,(IY+1Eh) ; BREG/FLAGS +000004B8: B7 OR A +000004B9: 20 04 JR NZ,+04h +;; PRINT-CH +000004BB: FD CB 1E 86 RES 0,(IY+1Eh) ; BREG/FLAGS + +;; PRINT-SP +000004BF: D9 EXX +000004C0: E5 PUSH HL +000004C1: FD CB 1E 4E BIT 1,(IY+1Eh) ; test BREG/FLAGS - is printer in use ? +000004C5: 20 06 JR NZ,+06h ; to LPRINT-A +000004C7: CD 64 14 CALL 1464h +000004CA: E1 POP HL +000004CB: D9 EXX +000004CC: C9 RET + +;; LPRINT-A +000004CD: CD D2 1C CALL 1CD2h ; routine LPRINT-CH +000004D0: 18 F8 JR -08h + +000004D2: 7E LD A,(HL) +000004D3: 23 INC HL +000004D4: E6 7F AND 7Fh +000004D6: 18 D9 JR -27h + +000004D8: ED 5B 18 40 LD DE,(4018h) ; X_PTR +;; MORE-LINE +000004DC: B7 OR A +000004DD: ED 52 SBC HL,DE +000004DF: 19 ADD HL,DE +000004E0: 28 13 JR Z,+13h + +000004E2: CD F6 18 CALL 18F6h ; routine NUMBER +000004E5: 23 INC HL ; +000004E6: 28 F4 JR Z,-0Ch ; to MORE-LINE + +000004E8: FE 76 CP 76h +000004EA: 28 C8 JR Z,-38h ; to PRINT-A (OUT-CH) + +000004EC: FE 7F CP 7Fh ; compare to cursor character. +000004EE: 28 1D JR Z,+1Dh ; to OUT-CURS + +000004F0: CD 52 04 CALL 0452h ; routine TOKENS +000004F3: 18 E7 JR -19h ; to MORE-LINE +; +000004F5: 3E 2A LD A,2Ah +000004F7: CD 1B 05 CALL 051Bh ; CURSOR BACKSPACE +000004FA: 3E 7F LD A,7Fh +000004FC: BE CP (HL) ; compare to cursor character. +000004FD: 28 E6 JR Z,-1Ah + +;; EXPAND-1 +000004FF: 01 01 00 LD BC,0001h +00000502: CD B8 1C CALL 1CB8h ; MAKE-ROOM + 3 (don't check for free space) +00000505: EB EX DE,HL + +;; WRITE-CH +00000506: 77 LD (HL),A +00000507: 23 INC HL +00000508: CD B0 0B CALL 0BB0h ; ALERT BEEP +0000050B: 18 CB JR -35h + +;; OUT-CURS +0000050D: AF XOR A +0000050E: FD CB 3B 66 BIT 4,(IY+3Bh) ; CDFLAG +00000512: 28 02 JR Z,+02h +00000514: 3E 2C LD A,2Ch +00000516: CD 1B 05 CALL 051Bh ; CURSOR BACKSPACE +00000519: 18 C1 JR -3Fh + +;; CURSOR BACKSPACE +0000051B: CD BF 04 CALL 04BFh ; PRINT-SP +0000051E: ED 4B 0E 40 LD BC,(400Eh) ; DF_CC +00000522: 0B DEC BC +00000523: ED 43 7B 40 LD (407Bh),BC ; BLINK +00000527: C9 RET + +;------------ +; Signum () +;------------ +; This routine replaces the last value on the calculator stack, +; which is in floating point form, with one if positive and with -minus one +; if negative. If it is zero then it is left as such. + +;; sgn +00000528: 7E LD A,(HL) ; pick up the byte with the sign bit. +00000529: B7 OR A +0000052A: 23 INC HL ; point to first byte of 4-byte mantissa. +0000052B: 7E LD A,(HL) +0000052C: 2B DEC HL +0000052D: C4 82 0C CALL NZ,0C82h ; routine FP-0/1 replaces last value with one +00000530: 17 RLA ; rotate original sign bit to carry. +00000531: 23 INC HL ; point to first byte of 4-byte mantissa. +00000532: CB 1E RR (HL) ; rotate the carry into sign. +00000534: 2B DEC HL ; point to last value. +00000535: C9 RET + +00000536: 03 INC BC +00000537: 23 INC HL +00000538: 7E LD A,(HL) +; ------------------------- +; THE 'ALPHANUM' SUBROUTINE +; ------------------------- + +;; ALPHANUM +00000539: FE 1C CP 1Ch +0000053B: D8 RET C +0000053C: FE 40 CP 40h +0000053E: 3F CCF +0000053F: C9 RET + +;---------------- +; USR number () +;---------------- +; The USR function followed by a number 0-65535 is the method by which +; the ZX81 invokes machine code programs. This function returns the +; contents of the BC register pair. +; Note. on LAMBDA that STACK-BC does NOT re-initializes the IY register to $4000 + +;; usr-no +00000540: CD 09 15 CALL 1509h ; FIND-INT +00000543: 11 7E 07 LD DE,077Eh ; STACK-BC +00000546: D5 PUSH DE +00000547: C5 PUSH BC +00000548: C9 RET + +;------------------------------------- +; THE 'FLOATING-POINT TO A' SUBROUTINE +;------------------------------------- +; +; + +;; FP-TO-A +00000549: CD 55 05 CALL 0555h ; routine FP-TO-BC +0000054C: D8 RET C +0000054D: F5 PUSH AF +0000054E: 78 LD A,B +0000054F: B7 OR A +00000550: 28 2C JR Z,+2Ch ; jp forward if in range +00000552: F1 POP AF ; fetch result +00000553: 37 SCF ; set carry flag signaling overflow +00000554: C9 RET + + +;-------------------------------------- +; THE 'FLOATING-POINT TO BC' SUBROUTINE +;-------------------------------------- +; The floating-point form on the calculator stack is compressed directly into +; the BC register rounding up if necessary. +; Valid range is 0 to 65535.4999 + +;; FP-TO-BC +0000555: E7 RST 20h ; routine STK-FETCH - exponent to A mantissa to EDCB. +00000556: B7 OR A ; test for value zero. +00000557: FA 5C 05 JP M,055Ch + +0000055A: 3E 7F LD A,7Fh +0000055C: FE 91 CP 91h +0000055E: 3F CCF +0000055F: D8 RET C +00000560: CB 7B BIT 7,E ; Bit 7 of E is the 17th bit which will be significant for rounding .. +00000562: F5 PUSH AF ; +00000563: CB FB SET 7,E ; ..if the number is already normalized. +00000565: 2F CPL ; +00000566: C6 91 ADD 91h ; +00000568: A7 AND A ; reset CY +00000569: 47 LD B,A +0000056A: 28 06 JR Z,+06h +0000056C: CB 3B SRL E +0000056E: CB 1A RR D +00000570: 10 FA DJNZ -06h +00000572: 43 LD B,E +00000573: 4A LD C,D +00000574: 30 05 JR NC,+05h +00000576: 03 INC BC +00000577: 79 LD A,C +00000578: B0 OR B +00000579: 28 D7 JR Z,-29h +0000057B: CD ED 18 CALL 18EDh ; STK-PNTRS +0000057E: F1 POP AF +0000057F: 79 LD A,C +00000580: C9 RET + +; ------------------ +; THE 'TOKEN' TABLES +; ------------------ + +;; TOKENS +00000581: DEFB $1B+$40+$80 ; . (printed for all non-existing keywords) +00000582: DEFB $28+$40,$34,$29,$2A+$80 ; CODE (192) +00000586: DEFB $3B+$40,$26,$31+$80 ; VAL +00000589: DEFB $31+$40,$2A,$33+$80 ; LEN +0000058C: DEFB $38+$40,$2E,$33+$80 ; SIN +0000058F: DEFB $28+$40,$34,$38+$80 ; COS +00000592: DEFB $39+$40,$26,$33+$80 ; TAN +00000595: DEFB $26+$40,$38,$33+$80 ; ASN +00000598: DEFB $26+$40,$28,$38+$80 ; ACS (199) +0000059B: DEFB $26+$40,$39,$33+$80 ; ATN +0000059E: DEFB $31+$40,$34,$2C+$80 ; LOG (was LN on ZX81) +000005A1: DEFB $2A+$40,$3D,$35+$80 ; EXP +000005A4: DEFB $2E+$40,$33,$39+$80 ; INT +000005A7: DEFB $38+$40,$36,$37+$80 ; SQR +000005AA: DEFB $38+$40,$2C,$33+$80 ; SGN +000005AD: DEFB $26+$40,$27,$38+$80 ; ABS +000005B0: DEFB $35+$40,$2A,$2A,$30+$80 ; PEEK +000005B4: DEFB $3A+$40,$38,$37+$80 ; USR +000005B7: DEFB $38+$40,$39,$37,$0D+$80 ; STR$ +000005BB: DEFB $28+$40,$2D,$37,$0D+$80 ; CHR$ +000005BF: DEFB $33+$40,$34,$39+$80 ; NOT (211) + +000005C2: DEFB $26,$39+$80 ; AT -- first char is not bit-tagged +000005C4: DEFB $39+$40,$26,$27+$80 ; TAB + +000005C7: DEFB $17+$40,$17+$40+$80 ; ** ! mind the odd bit-tags ! +000005C9: DEFB $34,$37+$80 ; OR -- first char is not bit-tagged +000005CB: DEFB $26,$33,$29+$80 ; AND -- first char is not bit-tagged +000005CE: DEFB $13+$40,$14+$40+$80 ; <= ! mind the odd bit-tags ! +000005D0: DEFB $12+$40,$14+$40+$80 ; >= ! mind the odd bit-tags ! +000005D2: DEFB $13+$40,$12+$40+$80 ; <> ! mind the odd bit-tags ! (219) + +;; in the next token group the first char is not bit-tagged +;;---------------------------------------------------------------------------- + +000005D4: DEFB $39,$2A,$32,$35,$34+$80 ; TEMPO +000005D9: DEFB $32,$3A,$38,$2E,$28+$80 ; MUSIC +000005DE: DEFB $3A,$34,$3A,$33,$29+$80 ; SOUND +000005E3: DEFB $27,$2A,$2A,$35+$80 ; BEEP +000005E7: DEFB $33,$34,$27,$2A,$2A,$35+$80 ; NOBEEP + +000005ED: DEFB $31,$35,$37,$2E,$33,$39+$80 ; LPRINT +000005F3: DEFB $31,$31,$2E,$38,$39+$80 ; LLIST +000005F8: DEFB $38,$39,$34,$35+$80 ; STOP +000005FC: DEFB $38,$31,$34,$3C+$80 ; SLOW +00000600: DEFB $2B,$26,$38,$39+$80 ; FAST +00000604: DEFB $33,$2A,$3C+$80 ; NEW +00000607: DEFB $38,$28,$37,$34,$31,$31+$80 ; SCROLL +0000060D: DEFB $28,$34,$33,$39+$80 ; CONT +00000611: DEFB $29,$2E,$32+$80 ; DIM +00000614: DEFB $37,$2A,$32+$80 ; REM +00000617: DEFB $2B,$34,$37+$80 ; FOR +0000061A: DEFB $2C,$34,$39,$34+$80 ; GOTO +0000061E: DEFB $2C,$34,$38,$3A,$27+$80 ; GOSUB +00000623: DEFB $2E,$33,$35,$3A,$39+$80 ; INPUT +00000628: DEFB $31,$34,$26,$29+$80 ; LOAD +0000062C: DEFB $31,$2E,$38,$39+$80 ; LIST +00000630: DEFB $31,$2A,$39+$80 ; LET +00000633: DEFB $35,$26,$3A,$38,$2A+$80 ; PAUSE +00000638: DEFB $33,$2A,$3D,$39+$80 ; NEXT +0000063C: DEFB $35,$34,$30,$2A+$80 ; POKE +00000640: DEFB $35,$37,$2E,$33,$39+$80 ; PRINT +00000645: DEFB $35,$31,$34,$39+$80 ; PLOT +00000649: DEFB $37,$3A,$33+$80 ; RUN +0000064C: DEFB $38,$26,$3B,$2A+$80 ; SAVE +00000650: DEFB $37,$26,$33,$29+$80 ; RAND +00000654: DEFB $2E,$2B+$80 ; IF +00000656: DEFB $28,$31,$38+$80 ; CLS +00000659: DEFB $3A,$33,$35,$31,$34,$39+$80 ; UNPLOT +0000065F: DEFB $28,$31,$2A,$26,$37+$80 ; CLEAR +00000664: DEFB $37,$2A,$39,$3A,$37,$33+$80 ; RETURN +0000066A: DEFB $28,$34,$35,$3E+$80 ; COPY (255) + +0000066E: DEFB $39,$2D,$2A,$33+$80 ; THEN (64) +00000671: DEFB $39,$34+$80 ; TO (65) +00000674: DEFB $38,$39,$2A,$35+$80 ; STEP + +;;---------------------------------------------------------------------------- + +00000678: DEFB $37+$40,$33,$29+$80 ; RND ! mind the odd bit-tags ! +0000067B: DEFB $2E+$40,$33,$30,$2A,$3E,$0D+$40+$80 ; INKEY$ ! mind the odd bit-tags ! +00000681: DEFB $35+$40,$2E+$40+$80 ; PI + + +000005A4: DEFB $2E,$33,$30+$80 ; INK +00000686: DEFB $35,$26,$35,$2A,$37+$80 ; PAPER +0000068A: DEFB $27,$34,$37,$29,$2A,$37+$80 ; BORDER (72) + + +00000691: CD A2 06 CALL 06A2h ; SET-FIELD +00000694: C6 10 ADD 10h +00000696: E6 AND 10h +00000697: 4F LD C,A + +00000699: AF XOR A ; SPACE +0000069A: DF RST 18h ; PRINT-A + +0000069B: CD A2 06 CALL 06A2h ; SET-FIELD +0000069E: B9 CP C +0000069F: 20 F8 JR NZ,-08h +000006A1: C9 RET + +;; SET-FIELD +000006A2: FD CB 1E 4E BIT 1,(IY+1Eh) ; BREG/FLAGS - Is printer in use +000006A6: 20 09 JR NZ,+09h ; to NO_CENTRE + +000006A8: 3A 39 40 LD A,(4039h) ; S_POSN_x +000006AB: 2F CPL +000006AC: C6 22 ADD 22h + +; ; ; +000006AE: E6 1F AND 1Fh +000006B0: C9 RET + +;; NO_CENTRE +000006B1: 3A 38 40 LD A,(4038h) ; PR_CC +000006B4: D6 3C SUB 3Ch +000006B6: 18 F6 JR -0Ah + +000006B8: 21 CC 02 LD HL,02CCh +000006BB: 87 ADD A +000006BC: 5F LD E,A +000006BD: 19 ADD HL,DE +000006BE: 4E LD C,(HL) +000006BF: 23 INC HL +000006C0: 46 LD B,(HL) +000006C1: C5 PUSH BC + + +;; LEFT-EDGE +000006C2: 2A 14 40 LD HL,(4014h) ; E_LINE +000006C5: 3E 7F LD A,7Fh +000006C7: BE CP (HL) +000006C8: C8 RET Z +000006C9: 23 INC HL +000006CA: 18 FB JR -05h + +;; INK +000006CC: CD FF 14 CALL 14FFh ; STK-TO-A +000006CF: 0E 0F LD C,0Fh ; INK mask +;; ATTR-SET +000006D1: 21 08 40 LD HL,4008h ; ATTR-P +;; UPD-COLOR +000006D4: AE XOR (HL) +000006D5: A1 AND C +000006D6: AE XOR (HL) +000006D7: 77 LD (HL),A +000006D8: C9 RET + +;; PAPER +000006D9: CD FF 14 CALL 14FFh ; STK-TO-A +000006DC: 17 RLA +000006DD: 17 RLA +000006DE: 17 RLA +000006DF: 17 RLA +000006E0: 0E F0 LD C,F0h ; PAPER mask +000006E2: 18 ED JR -13h ; to ATTR-SET + +;; BORDER +000006E4: CD FF 14 CALL 14FFh ; STK-TO-A +000006E7: 17 RLA +000006E8: 17 RLA +000006E9: 17 RLA +000006EA: 17 RLA +; entry used while booting +000006EB: 21 7D 20 LD HL,207Dh +000006EE: 77 LD (HL),A +000006EF: 23 INC HL +000006F0: 11 21 00 LD DE,0021h ; 33 bytes (=1 display row) +000006F3: 06 19 LD B,19h ; loop 25 times +000006F5: 77 LD (HL),A +000006F6: 19 ADD HL,DE +000006F7: 10 FC DJNZ -04h +000006F9: C9 RET + + +;--------------------------- +; THE 'SQUARE ROOT' FUNCTION +;--------------------------- +; (Offset ??: 'sqr') +; Error A if argument is negative. +; This routine is remarkable only in its brevity - 6 bytes (1 more byte saved porting from the ZX81 version!!) + + +;; sqr +000006FA: F7 RST 30h ; FP-CALC +000006FB: 01 ;;duplicate +000006FC: 1D ;;not +000006FD: 34 ;;jump-true +000006FE: 16 ;;to LAST +; else continue to calculate as x ** .5 +000006FE: F5 ;;stk-half & end-calc + + +;------------------------------- +; THE 'EXPONENTIATION' OPERATION +;------------------------------- +; (Offset $??: 'to-power') +; This raises the first number X to the power of the second number Y. +; As with the ZX80, +; 0 ** 0 = 1 +; 0 ** +n = 0 +; 0 ** -n = arithmetic overflow. + +;; to-power +00000700: F7 RST 30h ; FP-CALC +00000701: 33 ;;exchange +00000702: 01 ;;duplicate +00000703: 34 ;;jump-true +00000704: 12 + +; these routines form the three simple results when the number is zero. +; begin by deleting the known zero to leave Y the power factor. + +; continue here if X is zero. + +;; XISO +00000705: 35 ;;delete +00000706: 01 ;;duplicate +00000707: 1D ;;not +00000706: 34 ;;jump-true +00000709: 09 +0000070A: 7A ;;stk-zero +0000070B: 33 ;;exchange +0000070C: 02 ;;greater-0 +0000070D: 34 ;;jump-true +0000070E: 06 ;;to L1DFD, LAST if Y was any positive number + +; else force division by zero thereby raising an Arithmetic overflow error. + +0000070F: 79 ;;stk-one 0, 1. +00000710: 33 ;;exchange 1, 0. +00000711: 20 ;;division 1/0 >> error + +; --- + +;; ONE +00000712: 35 ;;delete +00000713: 79 ;;stk-one + +;; LAST +00000714: 00 ;;end-calc +00000715: C9 RET + +; else X is non-zero. function 'ln' will catch a negative value of X. + +00000716: 13 ;;ln +00000717: 9F ;;multiply & end-calc + + +;----------------- +; Exponential +;----------------- +; + +;; exp +00000718: F7 RST 30h ; FP-CALC +00000719: 05 ;;stk-data +0000071A: F1 ;;Exponent: $81, Bytes: 4 +0000071B: 38 AA 3B 29 +0000071F: 1F ;;multiply +00000720: 01 ;;duplicate +00000721: 15 ;;int +00000722: 5F ;;st-mem-3 +00000723: 1E ;;subtract +00000724: 01 ;;duplicate +00000725: 2A ;;addition +00000726: 79 ;;stk-one +00000727: 1E ;;subtract +00000728: 68 ;;series-08 +00000729: 13 ;;Exponent: $63, Bytes: 1 +0000072A: 36 ;;(+00,+00,+00) +0000072B: 58 ;;Exponent: $68, Bytes: 2 +0000072C: 65 66 ;;(+00,+00) +0000072E: 9D ;;Exponent: $6D, Bytes: 3 +0000072F: 78 65 40 ;;(+00) +00000732: A2 ;;Exponent: $72, Bytes: 3 +00000733: 60 32 C9 ;;(+00) +00000736: E7 ;;Exponent: $77, Bytes: 4 +00000737: 21 F7 AF 24 ;; +0000073B: EB ;;Exponent: $7B, Bytes: 4 +0000073C: 2F B0 B0 14 ;; +00000740: EE ;;Exponent: $7E, Bytes: 4 +00000741: 7E BB 94 58 ;; +00000745: F1 ;;Exponent: $81, Bytes: 4 +00000746: 3A 7E F8 CF ;; +0000074A: CF ;;get-mem-3 & end-calc + +0000074B: CD 49 05 CALL 0549h ; FP-TO-A +0000074E: 28 0D JR Z,+0Dh + +;; N-NEGTV +00000750: 30 04 JR NC,+04h + +;; RSLT-ZERO +00000752: F7 RST 30h ; FP-CALC +00000753: 35 ;;delete +00000754: FA ;;stk-zero & end-calc +00000755: C9 RET + +00000756: 96 SUB (HL) +00000757: 30 F9 JR NC,-07h ; to RSLT-ZERO +00000759: ED 44 NEG ; Negate + +;; RESULT-OK +0000075B: 77 LD (HL),A +0000075C: C9 RET + +0000075D: 38 03 JR C,+03h ; to REPORT-6b + +0000075F: 86 ADD (HL) +00000760: 30 F9 JR NC,-07h ; to RESULT-OK + +;; REPORT-6b - number too big +00000762: C3 23 17 JP 1723h + +00000765: FD CB 3B AE RES 5,(IY+3Bh) ; CDFLAG +00000769: C9 RET + +0000076A: FD CB 3B EE SET 5,(IY+3Bh) ; CDFLAG +0000076E: C9 RET + +;---------------------------------- +; Move a floating point number (2D) +;---------------------------------- +; This simple routine is a 5-byte LDIR instruction +; that incorporates a memory check. +; When used as a calculator literal it duplicates the last value on the +; calculator stack. +; Unary so on entry HL points to last value, DE to stkend + +;; duplicate +;; MOVE-FP +0000076F: CD F2 13 CALL 13F2h ; routine TEST-5-SP +00000772: ED B0 LDIR +00000774: C9 RET + +;; STK-DIGIT +00000775: CD 54 1C CALL 1C54h ; routine ALPHA +00000778: D8 RET C + +; ------------------------ +; THE 'STACK-A' SUBROUTINE +; ------------------------ +; + +;; STACK-A +00000779: 06 00 LD B,00h +0000077B: 4F LD C,A +0000077C: FE E7 CP E7h + +;--------------------- +; THE 'LEN' SUBROUTINE +;--------------------- +; (offset $1b: 'len') +; Returns the length of a string. +; In Sinclair BASIC strings can be more than twenty thousand characters long +; so a sixteen-bit register is required to store the length + +;; len +;; THIS IS THE SAME BYTE ALREADY USED BY THE CODE ABOVE !! +0000077D: E7 RST 20h ; routine STK-FETCH to fetch and delete the string parameters + ; from the calculator stack. Register BC now holds the length of string. + +; continue to STACK-BC to save result on the calculator stack (with memory check). + +; ------------------------- +; THE 'STACK-BC' SUBROUTINE +; ------------------------- +; The ZX81 does not have an integer number format so the BC register contents +; must be converted to their full floating-point form. + +;; STACK-BC +0000077E: C5 PUSH BC +0000077F: F7 RST 30h ; FP-CALC +00000780: FA ;;stk-zero & end-calc + +00000781: C1 POP BC ; restore integer value. + +00000782: 79 LD A,C +00000783: B0 OR B +00000784: C8 RET Z ; return if BC was zero - done. + +00000785: 36 90 LD (HL),90h ; place $90 in exponent (was 91h on ZX81) +00000787: CB 78 BIT 7,B +00000789: 20 07 JR NZ,+07h +0000078B: 35 DEC (HL) +0000078C: CB 21 SLA C +0000078E: CB 10 RL B +00000790: 18 F5 JR -0Bh +00000792: 23 INC HL +00000793: CB B8 RES 7,B +00000795: 70 LD (HL),B +00000796: 23 INC HL +00000797: 71 LD (HL),C +00000798: C9 RET + + +;-------------------------- +; Handle PEEK function +;-------------------------- +; This function returns the contents of a memory address. +; The entire address space can be peeked including the ROM. + +;; peek +00000799: CD 09 15 CALL 1509h ; FIND-INT +0000079C: 0A LD A,(BC) +0000079D: 18 DA JR -26h ; exit via STACK-A to put value on the calculator stack + +;-------------------- +; THE 'CODE' FUNCTION +;-------------------- +; Returns the code of a character or first character of a string +; e.g. CODE "AARDVARK" = 38 (not 65 as the ZX81 does not have an ASCII character set). + +;; code +0000079F: E7 RST 20h ; routine STK-FETCH to fetch and delete the string parameters +000007A0: 79 LD A,C ; test length +000007A1: B0 OR B ; of the string +000007A2: 28 DA JR Z,-26h ; skip to STK-CODE with zero if the null string. + +000007A4: 1A LD A,(DE) ; else fetch the first character. +000007A5: 18 D2 JR -2Eh ; jump to STACK-A (with memory check) + +;; E-FORMAT +000007A7: FE 42 CP 42h ; is character 'E' ? +000007A9: 28 07 JR Z,+07h + +;; F-USE-ONE +000007AB: CD 3B 0A CALL 0A3Bh ; routine CHECK-END +000007AE: F7 RST 30h ; FP-CALC +000007AF: F9 ;;stk-one & end-calc + +000007B0: 18 06 JR +06h ; to F-REORDER + +000007B2: CD 10 0A CALL 0A10h +000007B5: CD 3B 0A CALL 0A3Bh ; routine CHECK-END + +;; F-REORDER +000007B8: F7 RST 30h ; FP-CALC +000007B9: 50 ;;st-mem-0 +000007BA: 35 ;;delete +000007BB: 33 ;;exchange +000007BC: 40 ;;get-mem-0 +000007BD: B3 ;;exchange & end-calc + +000007BE: CD F8 00 CALL 00F8h ; routine LET +000007C1: 01 06 00 LD BC,0006h +000007C4: 2B DEC HL ; point to letter. +000007C5: CB 7E BIT 7,(HL) +000007C7: CB FE SET 7,(HL) +000007C9: 09 ADD HL,BC +000007CA: 20 06 JR NZ,+06h ; F-LMT-STP + +000007CC: 0E 0C LD C,0Ch +000007CE: CD B5 1C CALL 1CB5h ; routine MAKE-ROOM +000007D1: 23 INC HL + +;; F-LMT-STP +000007D2: E5 PUSH HL + +000007D3: F7 RST 30h ; FP-CALC +000007D4: 35 ;;delete +000007D5: B5 ;;delete & end-calc + +000007D6: EB EX DE,HL +000007D7: 0E 0A LD C,0Ah ; ten bytes to be moved. +000007D9: D1 POP DE +000007DA: ED B0 LDIR ; copy bytes +000007DC: 2A 36 40 LD HL,(4036h) ; LAMBDA-VAR +000007DF: 23 INC HL +000007E0: EB EX DE,HL +000007E1: 73 LD (HL),E +000007E2: 23 INC HL +000007E3: 72 LD (HL),D +000007E4: C9 RET + +; ERR-MSG table +000007E5: 34 30 ; "OK" +000007E7: 38 39 ; 0,"ST" - STOP statement executed +000007E9: 27 30 ; 1,"BK" - BREAK Key pressed +000007EB: 38 2B ; 2,"SF" - Screen Full +000007ED: 34 32 ; 3,"OM" - Out of memory +000007EF: 33 2B ; 4,"NF" - NEXT without FOR +000007F1: 34 3B ; 5,"OV" - Number overflow +000007F3: 37 2C ; 6,"RG" - RETURN without GOSUB +000007F5: 2E 2E ; 7,"II" - Illegal Input +000007F7: 3A 3B ; 8,"UV" - Undefined Variable +000007F9: 26 2C ; 9,"AG" - Invalid Argument +000007FB: 2E 37 ; A,"IR" - Integer out of Range +000007FD: 2E 2A ; B,"IE" - Invalid Expression +000007FF: 27 38 ; C,"BS" - Bad Subscript +00000801: 33 26 ; D,"NA" - Invalid program name +00000803: 32 2B ; E,"MF" - Incorrect music string format + +00000805: CF RST 08h ; NEXT-CHAR + + + +;-------------------------- +; THE 'SCANNING' SUBROUTINE +;-------------------------- +; This recursive routine is where the ZX81 gets its power. Provided there is +; enough memory it can evaluate an expression of unlimited complexity. +; Note. there is no unary plus so, as on the ZX80, PRINT +1 gives a syntax error. +; PRINT +1 works on the Spectrum but so too does PRINT + "STRING". + +;; SCANNING +00000806: 06 00 LD B,00h +00000808: D7 RST 10h ; GET-CHAR + +00000809: FE CF CP CFh ; 'PEEK' +0000080B: C5 PUSH BC ; stack zero as a priority end-marker. +0000080C: 01 C9 09 LD BC,09C9h +0000080F: FE 16 CP 16h ; is character '-' ? +00000811: 28 F7 JR Z,-09h + +00000813: 01 DD 04 LD BC,04DDh ; prepare priority $04, operation 'not' +00000816: FE D3 CP D3h ; 'NOT' +00000818: 28 F0 JR Z,-10h ; + +0000081A: 30 25 JR NC,+25h ; jp with anything higher to S-RPT-C (report C) + +; else is a function '??' thru '??' + +0000081C: FE C0 CP C0h ; +0000081E: 38 13 JR C,+13h + +00000820: C6 0A ADD 0Ah +00000822: 06 10 LD B,10h ; priority sixteen binds all functions to arguments removing the need for brackets +00000824: FE CD CP CDh ; +00000826: 30 02 JR NC,+02h + +00000828: E6 BF AND BFh +0000082A: FE DB CP DBh ; +0000082C: 38 02 JR C,+02h + +0000082E: E6 7F AND 7Fh +00000830: 4F LD C,A +00000831: 18 D7 JR -29h +00000833: FE 0B CP 0Bh +00000835: 20 15 JR NZ,+15h + +;; S-Q-AGAIN +00000837: E5 PUSH HL +00000838: CF RST 08h ; NEXT-CHAR +00000839: FE 0B CP 0Bh +0000083B: 28 07 JR Z,+07h +0000083D: FE 76 CP 76h ; compare to NEWLINE + +0000083F: 20 F7 JR NZ,-09h ; loop back if not to S-Q-AGAIN + +;; S-RPT-C +00000841: C3 42 0A JP 0A42h ; to REPORT-C + +00000844: D1 POP DE ; * retrieve start of string +00000845: 13 INC DE ; +00000846: ED 52 SBC HL,DE ; subtract start from current position +00000848: 4D LD C,L ; transfer this length +00000849: 44 LD B,H ; to the BC register pair +0000084A: 18 13 JR +13h ; to S-STRING + +; --- + +;; S-TST-INK +0000084C: FE 44 CP 44h ; compare to character 'INKEY$' +0000084E: 20 19 JR NZ,+19h ; forward, if not, to S-ALPHANUM + +; ----------------------- +; THE 'INKEY$' EVALUATION +; ----------------------- + +00000850: CD 74 0D CALL 0D74h ; routine KEYBOARD +00000853: 55 LD D,L +00000854: 14 INC D +00000855: 4D LD C,L +00000856: 44 LD B,H +00000857: C4 77 18 CALL NZ,1877h ; routine DECODE +0000085A: EB EX DE,HL +0000085B: 44 LD B,H +0000085C: 4C LD C,H +0000085D: CB 11 RL C + +;; S-STRING +0000085F: EF RST 28h ; routine SYNTAX-Z +00000860: C4 BC 13 CALL NZ,13BCh ; in run-time routine STK-STO-$ stacks the string descriptor +00000863: FD CB 1E B6 RES 6,(IY+1Eh) ; BREG/FLAGS - signal string result +00000867: 18 0B JR +0Bh + +;; S-ALPHANUM +00000869: FE 10 CP 10h ; '(' +0000086B: 20 0A JR NZ,+0Ah +0000086D: CD 05 08 CALL 0805h + +00000870: FE 11 CP 11h ; ')' +00000872: 20 CD JR NZ,-33h ; jp if not to S-RPT-C (report C) + +00000874: C3 FB 08 JP 08FBh ; jp to NEXT-CHAR, S-JP-CONT3 and then S-CONT3 + + + +00000877: CD 39 05 CALL 0539h ; routine ALPHANUM +0000087A: 38 18 JR C,+18h + +;; S-LTR-DGT +0000087C: FE 26 CP 26h ; compare to 'A'. +0000087E: 38 18 JR C,+18h ; forward if less to S-DECIMAL + +00000880: CD AE 0A CALL 0AAEh ; LOOK-VARS-B +00000883: DA 0C 0A JP C,0A0Ch ; to REPORT-2 +00000886: CC F0 0D CALL Z,0DF0h ; routine STK-VAR stacks string parameters or + ; returns cell location if numeric. + +00000889: 3E BF LD A,BFh +0000088B: FD BE 1E CP (IY+1Eh) ; BREG/FLAGS +0000088E: DC C7 09 CALL C,09C7h ; update STKEND and MOVE-FP +00000891: D7 RST 10h ; GET-CHAR +00000892: 18 68 JR +68h + +00000894: FE 1B CP 1Bh ; is character a '.' ? +00000896: 20 26 JR NZ,+26h ; jump forward if not + +; --- + +; The Scanning Decimal routine is invoked when a decimal point or digit is +; found in the expression. +; When checking syntax, then the 'hidden floating point' form is placed +; after the number in the BASIC line. +; In run-time, the digits are skipped and the floating point number is picked +; up. + +;; S-DECIMAL +00000898: EF RST 28h ; routine SYNTAX-Z +00000899: 28 0B JR Z,+0Bh + +; --- + +; In run-time the branch is here when a digit or point is encountered. + +;; S-STK-DEC +0000089B: CF RST 08h ; NEXT-CHAR +0000089C: FE 7E CP 7Eh ; compare to 'number marker' +0000089E: 20 FB JR NZ,-05h ; loop back until found to S-STK-DEC + ; skipping all the digits. +000008A0: CD C7 09 CALL 09C7h ; update STKEND and MOVE-FP to stack the number +000008A3: 2B DEC HL +000008A4: 18 13 JR +13h + +000008A6: CD C1 11 CALL 11C1h ; routine DEC-TO-FP +000008A9: 01 06 00 LD BC,0006h ; six locations are required. +000008AC: D7 RST 10h ; GET-CHAR +000008AD: CD B5 1C CALL 1CB5h ; routine MAKE-ROOM +000008B0: 23 INC HL ; point to first new location +000008B1: 36 7E LD (HL),7Eh ; insert the number marker 126 decimal. +000008B3: CD 56 01 CALL 0156h +000008B6: 0E 04 LD C,04h +000008B8: 09 ADD HL,BC +000008B9: 22 16 40 LD (4016h),HL ; update system variable CH_ADD. +000008BC: 18 39 JR +39h + +;; S-TEST-PI +000008BE: FE 45 CP 45h +000008C0: 20 08 JR NZ,+08h + +; ------------------- +; THE 'PI' EVALUATION +; ------------------- + +000008C2: EF RST 28h ; routine SYNTAX-Z +000008C3: 28 32 JR Z,+32h ; forward if checking syntax to S-PI-END +000008C5: F7 RST 30h ; FP-CALC +000008C6: F0 ;;stk-pi/2 & end-calc + +000008C7: 34 INC (HL) ; double the exponent giving PI on the stack +000008C8: 18 2D JR +2Dh ; jp to S-PI-END + + +000008CA: FE 43 CP 43h ; compare to the 'RND' character (was 40h on ZX81) +000008CC: 20 A4 JR NZ,-5Ch ; jp if not + +; ------------------ +; THE 'RND' FUNCTION +; ------------------ + +000008CE: EF RST 28h ; routine SYNTAX-Z +000008CF: 28 26 JR Z,+26h ; forward if checking syntax to ??? +000008D1: ED 4B 32 40 LD BC,(4032h) ; SEED +000008D5: CD 7E 07 CALL 077Eh ; routine STACK-BC +000008D8: F7 RST 30h ; FP-CALC +000008D9: 79 ;;stk-one +000008DA: 2A ;;addition +000008DB: 05 ;;stk-data +000008DC: 37 ;;Exponent: $87, Bytes: 1 +000008DD: 16 ;;(+00,+00,+00) +000008DE: 1F ;;multiply +000008DF: 05 ;;stk-data +000008E0: 80 ;;Bytes: 3 +000008E1: 41 ;;Exponent $91 +000008E2: 00h, 00h ,80h ;;(+00) +000008E5: 06 ;;n-mod-m +000008E5: 35 ;;delete +000008E7: 79 ;;stk-one +000008E8: 1E ;;subtract +000008E9: 81 ;;duplicate & end-calc + +000008EA: CD 55 05 CALL 0555h ; routine FP-TO-BC +000008ED: ED 43 32 40 LD (4032h),BC ; update the SEED system variable. +000008F1: 7E LD A,(HL) ; HL addresses the exponent of the last value. +000008F2: D6 10 SUB 10h ; reduce exponent by sixteen (thus dividing by 65536 for last value) +000008F4: 38 01 JR C,+01h +000008F6: 77 LD (HL),A + +;; S-PI-END +;; S-NUMERIC +000008F7: FD CB 1E F6 SET 6,(IY+1Eh) ; BREG/FLAGS - Signal numeric result + + +000008FB: CF RST 08h ; NEXT-CHAR advances character pointer. +000008FC: CD 7A 09 CALL 097Ah ; routine SYNTAX-Z +000008FF: 20 09 JR NZ,+09h + +;; S-CONT-3 +00000901: FE 10 CP 10h ; compare to opening bracket '(' +00000903: 20 05 JR NZ,+05h ; forward if not to S-OPERTR + +00000905: CD 37 13 CALL 1337h ; routine SLICING +00000908: 18 F1 JR -0Fh + + +; --- + +; the character is now manipulated to form an equivalent in the table of +; calculator literals. This is quite cumbersome and in the ZX Spectrum a +; simple look-up table was introduced at this point. + +;; S-OPERTR +0000090A: 01 D5 00 LD BC,00D5h ; prepare operator 'subtract' as default. +0000090D: FE 12 CP 12h ; is character '>' ? +0000090F: 38 1B JR C,+1Bh ; forward if less to S-LOOP as we have reached end of meaningful expression + +00000911: FE 16 CP 16h ; is character '-' ? +00000913: 38 10 JR C,+10h ; forward with - * / and '**' '<>' to SUBMLTDIV + +00000915: 0E C8 LD C,C8h +00000917: FE 19 CP 19h ; 'ATN' +00000919: 38 0A JR C,+0Ah + +0000091B: FE D6 CP D6h ; '**' +0000091D: 38 0D JR C,+0Dh + +0000091F: 0E 0B LD C,0Bh +00000921: FE DC CP DCh ; 'TEMPO' +00000923: 30 07 JR NC,+07h + +; --- + +;; SUBMLTDIV + +00000925: 81 ADD C +00000926: 4F LD C,A +00000927: 21 8E 15 LD HL,158Eh ; tbl-pri (166Ch) - DEh: theoretical the base of the priorities table ? +0000092A: 09 ADD HL,BC ; add C ( B is zero) +0000092B: 46 LD B,(HL) ; pick up the priority in B +0000092C: E1 POP HL +0000092D: 7C LD A,H +0000092E: B8 CP B +0000092F: 30 1B JR NC,+1Bh +00000931: E5 PUSH HL +00000932: CD 7A 09 CALL 097Ah ; routine SYNTAX-Z +00000935: 20 12 JR NZ,+12h +00000937: 3E C8 LD A,C8h +00000939: 81 ADD C +0000093A: 0E 6B LD C,6Bh +0000093C: FE AB CP ABh +0000093E: 28 09 JR Z,+09h +00000940: 38 8A JR C,-76h +00000942: 0E 32 LD C,32h +00000944: FE B2 CP B2h +00000946: 28 01 JR Z,+01h +00000948: 4F LD C,A +00000949: C3 0A 08 JP 080Ah +0000094C: B7 OR A +0000094D: 28 2A JR Z,+2Ah +0000094F: C5 PUSH BC +00000950: 7D LD A,L +00000951: F5 PUSH AF +00000952: EF RST 28h ; routine SYNTAX-Z +00000953: 20 16 JR NZ,+16h +00000955: FD AE 1E XOR (IY+1Eh) ; BREG/FLAGS +00000958: CB 77 BIT 6,A +0000095A: C2 42 0A JP NZ,0A42h ; to REPORT-C +0000095D: F1 POP AF +0000095E: 21 1E 40 LD HL,401Eh ; BREG/FLAGS + +00000961: CB F6 SET 6,(HL) +00000963: 17 RLA +00000964: 38 02 JR C,+02h +00000966: CB B6 RES 6,(HL) +00000968: C1 POP BC +00000969: 18 C1 JR -3Fh +0000096B: E6 3F AND 3Fh +0000096D: F6 80 OR 80h +0000096F: CD ED 18 CALL 18EDh ; STK-PNTRS +00000972: D9 EXX +00000973: E5 PUSH HL +00000974: 21 5D 09 LD HL,095Dh +00000977: 18 0E JR +0Eh +00000979: D7 RST 10h ; GET-CHAR + +;-------------------------- +; THE 'SYNTAX-Z' SUBROUTINE +;-------------------------- +; This routine returns with zero flag set if checking syntax. +; Calling this routine uses three instruction bytes compared to four if the +; bit test is implemented inline. + +0000097A: FD CB 1E 76 BIT 6,(IY+1Eh) ; BREG/FLAGS +0000097E: C9 RET + + + +;; coming from FP-CALC/CALCULATE/GEN-ENT-2 (continue) + +0000097F: D9 EXX ; switch back to main set. + +; this is the re-entry looping point when handling a string of literals. +;; RE-ENTRY +00000980: ED 53 1C 40 LD (401Ch),DE ; save end of stack in system variable STKEND +00000984: D9 EXX ; switch to alt +00000985: 7E LD A,(HL) ; get next literal +00000986: 23 INC HL ; increase pointer' + +; single operation jumps back to here (? to be checked) + +00000987: 87 ADD A ; +00000988: 28 36 JR Z,+36h ; a zeroed opcode means "end-calc" + +0000098A: 11 80 09 LD DE,0980h +0000098D: 30 03 JR NC,+03h +0000098F: 11 BF 09 LD DE,09BFh ; GEN-ENT-2 sub +00000992: D5 PUSH DE +00000993: E5 PUSH HL +00000994: FA B0 09 JP M,09B0h +00000997: FE 3C CP 3Ch +00000999: 38 07 JR C,+07h +0000099B: D9 EXX +0000099C: 5D LD E,L +0000099D: 54 LD D,H +0000099E: CD F1 18 CALL 18F1h +000009A1: D9 EXX +000009A2: 5F LD E,A +000009A3: 16 00 LD D,00h +000009A5: 21 F2 0B LD HL,0BF2h ; tbl-addrs - 2 +000009A8: 19 ADD HL,DE +000009A9: 5E LD E,(HL) +000009AA: 23 INC HL +000009AB: 56 LD D,(HL) +000009AC: E1 POP HL +000009AD: D5 PUSH DE +000009AE: D9 EXX +000009AF: C9 RET + +000009B0: 0F RRCA +000009B1: 57 LD D,A +000009B2: 0F RRCA +000009B3: 0F RRCA +000009B4: 0F RRCA +000009B5: E6 06 AND 06h +000009B7: C6 6C ADD 6Ch +000009B9: 5F LD E,A +000009BA: 7A LD A,D +000009BB: E6 0F AND 0Fh +000009BD: 18 E4 JR -1Ch + +;; GEN-ENT-2 sub +000009BF: D9 EXX + +;; end-calc (slightly different from the ZX81 version which does not embed it) +000009C0: E3 EX HL,(SP) +000009C1: D9 EXX +000009C2: ED 53 1C 40 LD (401Ch),DE ; STKEND + +;------------------------ +; THE 'DELETE' SUBROUTINE +;------------------------ +; offset $??: 'delete' +; A simple return but when used as a calculator literal this +; deletes the last value from the calculator stack. +; On entry, as always with binary operations, +; HL=first number, DE=second number +; On exit, HL=result, DE=stkend. +; So nothing to do + +;; delete +000009C6: C9 RET + +;; update STKEND and MOVE-FP +000009C7: 23 INC HL +000009C8: ED 5B 1C 40 LD DE,(401Ch) ; STKEND +000009CC: CD 6F 07 CALL 076Fh ; MOVE-FP +000009CF: 18 F1 JR -0Fh + +; +000009D1: 08 EX AF,AF' +000009D2: 0C INC C +000009D3: 3E 43 LD A,43h +000009D5: 49 LD C,C +000009D6: 53 LD D,E +000009D7: 55 LD D,L +000009D8: 55 LD D,L + +000009D9: CD A6 0A CALL 0AA6h ; routine LOOK-VARS +000009DC: 18 0B JR +0Bh + +; --- + +;; CLASS-4 +000009DE: CD A6 0A CALL 0AA6h ; routine LOOK-VARS +000009E1: F5 PUSH AF +000009E2: 3E 9F LD A,9Fh +000009E4: B1 OR C +000009E5: 3C INC A +000009E6: 20 5A JR NZ,+5Ah + +;; CLASS-4-2 +000009E8: F1 POP AF +000009E9: 38 1B JR C,+1Bh + +000009EB: CC F0 0D CALL Z,0DF0h ; routine STK-VAR +000009EE: FD 36 2D 00 LD (IY+2Dh),00h ; FLAGX +000009F2: EF RST 28h ; routine SYNTAX-Z +000009F3: C8 RET Z + +000009F4: CD 7A 09 CALL 097Ah ; routine SYNTAX-Z +000009F7: 20 05 JR NZ,+05h + +000009F9: E7 RST 20h ; STK-FETCH +000009FA: 32 2D 40 LD (402Dh),A ; FLAGX +000009FD: EB EX DE,HL + +;; SET-STRLN +000009FE: 22 12 40 LD (4012h),HL ; DEST +00000A01: ED 43 2E 40 LD (402Eh),BC ; STRLEN +00000A05: C9 RET + + +00000A06: FD 36 2D 02 LD (IY+2Dh),02h ; FLAGX +00000A0A: 20 F2 JR NZ,-0Eh + +;; REPORT-2 +00000A0C: CD 4A 14 CALL 144Ah ; ERROR-1 +00000A0F: 08 EX AF,AF' + ; "UV" - Undefined Variable + +00000A10: CF RST 08h ; NEXT-CHAR + +; --- + +;; CLASS-6 (A numeric expression must follow, otherwise error) +00000A11: CD 06 08 CALL 0806h ; SCANNING +00000A14: C0 RET NZ ; return with numeric expression if found +00000A15: 18 2B JR +2Bh ; to REPORT-C + +00000A17: CD 06 08 CALL 0806h ; SCANNING +00000A1A: 28 10 JR Z,+10h +00000A1C: 18 24 JR +24h + + +;; CLASS-3 (A numeric expression may follow, else default to zero) +00000A1E: FE 76 CP 76h +00000A20: 20 07 JR NZ,+07h + +00000A22: EF RST 28h ; routine SYNTAX-Z +00000A23: 28 07 JR Z,+07h + +00000A25: F7 RST 30h ; FP-CALC +00000A26: FA ;;stk-zero & end-calc + +00000A27: 18 03 JR +03h +00000A29: CD 11 0A CALL 0A11h ; routine CLASS-06 if non-zero number + +;; CLASS-0 (No further operands) +00000A2C: 37 SCF ; set CY to force CHECK-END + +;; CLASS-5 (variable syntax checked entirely by routine) +00000A2D: D1 POP DE +00000A2E: DC 3B 0A CALL C,0A3Bh ; routine CHECK-END +00000A31: EB EX DE,HL +00000A32: 2A 30 40 LD HL,(4030h) ; T_ADDR +00000A35: 4E LD C,(HL) +00000A36: 23 INC HL +00000A37: 46 LD B,(HL) +00000A38: C5 PUSH BC +00000A39: EB EX DE,HL +00000A3A: C9 RET + + + +;--------------------------- +; THE 'CHECK END' SUBROUTINE +;--------------------------- +; Check for end of statement and that no spurious characters occur after +; a correctly parsed statement. Since only one statement is allowed on each +; line, the only character that may follow a statement is a NEWLINE. +; + +;; CHECK-END +00000A3B: EF RST 28h ; routine SYNTAX-Z +00000A3C: C0 RET NZ +00000A3D: D1 POP DE + +;; CHECK-2 +00000A3E: 3E 76 LD A,76h +00000A40: BE CP (HL) +00000A41: C8 RET Z + +;; REPORT-C +00000A42: CD 4A 14 CALL 144Ah ; ERROR-1 (REPORT-C ?) +00000A45: 0B ; "IE" - Invalid Expression + +;; FIELD +00000A46: FD CB 1E CE SET 1,(IY+1Eh) ; BREG/FLAGS - Suppress leading space +00000A4A: FE 76 CP 76h +00000A4C: 20 0C JR NZ,+0Ch + +00000A4E: EF RST 28h ; routine SYNTAX-Z +00000A4F: C8 RET Z +00000A50: DF RST 18h ; PRINT-A +00000A51: C9 RET + +00000A52: EF RST 28h ; routine SYNTAX-Z +00000A53: C4 91 06 CALL NZ,0691h + +00000A56: CF RST 08h ; NEXT-CHAR +00000A57: FE 76 CP 76h +00000A59: C8 RET Z + +;; PRINT-1 +00000A5A: FE 19 CP 19h ; ',' +00000A5C: 28 F8 JR Z,-08h + +00000A5E: FE 1A CP 1Ah ; 'A' +00000A60: 28 F0 JR Z,-10h + +00000A62: FE D5 CP D5h ; 'TAB' +00000A64: 28 19 JR Z,+19h + +00000A66: FE D4 CP D4h ; 'AT' +00000A68: 28 23 JR Z,+23h + +; --- + +;; (NOT-TAB on the ZX81) +00000A6A: CD 06 08 CALL 0806h ; SCANNING +00000A6D: EF RST 28h ; routine SYNTAX-Z +00000A6E: C4 50 15 CALL NZ,1550h ; routine PRINT-STK + +;; PRINT-ON +00000A71: D7 RST 10h ; GET-CHAR +00000A72: FE 19 CP 19h +00000A74: 28 E0 JR Z,-20h +00000A76: FE 1A CP 1Ah +00000A78: 28 D8 JR Z,-28h + + +00000A7A: CD 3B 0A CALL 0A3Bh ; routine CHECK-END +00000A7D: 18 D1 JR -2Fh + +00000A7F: CD 9E 0A CALL 0A9Eh ; routine SYNTAX-ON +00000A82: CD FF 14 CALL 14FFh ; STK-TO-A +00000A85: E6 1F AND 1Fh +00000A87: 4F LD C,A +00000A88: CD 9B 06 CALL 069Bh +00000A8B: 18 E4 JR -1Ch ; to PRINT-ON + +00000A8D: CD 10 0A CALL 0A10h +00000A90: FE 1A CP 1Ah +00000A92: 20 AE JR NZ,-52h +00000A94: CD 9E 0A CALL 0A9Eh ; routine SYNTAX-ON + +00000A97: F7 RST 30h ; FP-CALC +00000A98: B3 ; exchange & end-calc + +00000A99: CD B5 14 CALL 14B5h ; STK and PRINT-AT +00000A9C: 18 D3 JR -2Dh + +;; SYNTAX-ON +00000A9E: CD 10 0A CALL 0A10h +00000AA1: EF RST 28h ; routine SYNTAX-Z +00000AA2: E1 POP HL +00000AA3: 28 CC JR Z,-34h +00000AA5: E9 JP (HL) + +;--------------------------- +; THE 'LOOK-VARS' SUBROUTINE +;--------------------------- +; +; + +;; LOOK-VARS +00000AA6: D7 RST 10h ; GET-CHAR +00000AA7: FE 26 CP 26h +00000AA9: CD 3B 05 CALL 053Bh +00000AAC: 38 94 JR C,-6Ch + +;; LOOK-VARS-B +00000AAE: E6 1F AND 1Fh +00000AB0: 47 LD B,A +00000AB1: E5 PUSH HL +00000AB2: CF RST 08h ; NEXT-CHAR +00000AB3: FD CB 1E F6 SET 6,(IY+1Eh) ; BREG/FLAGS +00000AB7: FE 10 CP 10h +00000AB9: E5 PUSH HL +00000ABA: 28 0B JR Z,+0Bh +00000ABC: FE 0D CP 0Dh +00000ABE: CB F0 SET 6,B +00000AC0: 20 1C JR NZ,+1Ch +00000AC2: FD CB 1E B6 RES 6,(IY+1Eh) ; BREG/FLAGS +00000AC6: CF RST 08h ; NEXT-CHAR +00000AC7: EF RST 28h ; routine SYNTAX-Z +00000AC8: 48 LD C,B +00000AC9: 2A 10 40 LD HL,(4010h) ; VARS +00000ACC: 20 23 JR NZ,+23h +;; V-80-BYTE +00000ACE: CB F9 SET 7,C +;; V-SYNTAX +00000AD0: 21 CB F8 LD HL,F8CBh +00000AD3: D7 RST 10h ; GET-CHAR +00000AD4: FE 10 CP 10h +00000AD6: 28 02 JR Z,+02h ; forward to V-PASS-B +00000AD8: CB E8 SET 5,B + +;; V-PASS-B +00000ADA: D1 POP DE +00000ADB: E1 POP HL +00000ADC: 18 3B JR +3Bh ; V-FOUND-2B + +00000ADE: CB E8 SET 5,B +;; V-PASS +00000AE0: CD 39 05 CALL 0539h ; routine ALPHANUM +00000AE3: 38 E2 JR C,-1Eh +00000AE5: CF RST 08h ; NEXT-CHAR +00000AE6: CB B0 RES 6,B +00000AE8: 18 F6 JR -0Ah ; back to V-PASS + +;; V-GET-PTR +00000AEA: EB EX DE,HL + +;; V-NEXT +00000AEB: C5 PUSH BC +00000AEC: CD 13 1A CALL 1A13h ; routine NEXT-ONE +00000AEF: C1 POP BC +;; V-EACH +00000AF0: EB EX DE,HL +00000AF1: 3E 7F LD A,7Fh +00000AF3: A6 AND (HL) +00000AF4: 28 DB JR Z,-25h ; to V-80-BYTE + +00000AF6: B9 CP C +00000AF7: 20 F2 JR NZ,-0Eh ; to V-NEXT + +00000AF9: 87 ADD A +00000AFA: 87 ADD A +00000AFB: D1 POP DE +00000AFC: 38 1A JR C,+1Ah ; to V-FOUND-2 + +00000AFE: F2 18 0B JP P,0B18h ; to V-FOUND-2 + +00000B01: D5 PUSH DE +00000B02: E5 PUSH HL + +;; V-MATCHES +00000B03: 23 INC HL + +;; V-SPACES +00000B04: 1A LD A,(DE) +00000B05: B7 OR A +00000B06: 13 INC DE +00000B07: 28 FB JR Z,-05h + +00000B09: AE XOR (HL) +00000B0A: 28 F7 JR Z,-09h ; back to V-MATCHES + +00000B0C: FE 80 CP 80h +00000B0E: 1A LD A,(DE) +00000B0F: D1 POP DE +00000B10: 20 D8 JR NZ,-28h ; forward to V-GET-PTR + +00000B12: CD 39 05 CALL 0539h ; routine ALPHANUM +00000B15: 30 D3 JR NC,-2Dh ; forward to V-GET-PTR + +;; V-FOUND-1 +00000B17: D1 POP DE +;; V-FOUND-2 +00000B18: D1 POP DE +;; V-FOUND-2B +00000B19: CB 10 RL B +00000B1B: CB 70 BIT 6,B +00000B1D: C9 RET + + +;------------------------------ +; THE 'JUMP ON TRUE' SUBROUTINE +;------------------------------ +; (Offset $??; 'jump-true') +; This enables the calculator to perform conditional relative jumps +; dependent on whether the last test gave a true result +; On the ZX81, the exponent will be zero for zero or else $81 for one. + +;; jump-true +00000B1E: 1A LD A,(DE) ; collect exponent byte +00000B1F: B7 OR A ; is result 0 or 1 ? +00000B20: 20 04 JR NZ,+04h ; back to JUMP if true (1). +00000B22: D9 EXX ; else switch in the pointer set. +00000B23: 23 INC HL ; step past the jump length. +00000B24: D9 EXX ; switch in the main set +00000B25: C9 RET + + +;---------------------- +; THE 'JUMP' SUBROUTINE +;---------------------- +; (Offset $??; 'jump') +; This enables the calculator to perform relative jumps just like +; the Z80 chip's JR instruction. +; This is one of the few routines to be polished for the ZX Spectrum. +; See, without looking at the ZX Spectrum ROM, if you can get rid of the +; relative jump. + +;; jump +00000B26: D9 EXX ; switch in pointer set +00000B27: 7E LD A,(HL) ; the jump byte 0-127 forward, 128-255 back. +00000B28: 17 RLA ; test if negative jump +00000B29: 9F SBC A ; clear accumulator. +00000B2A: 57 LD D,A ; transfer to high byte. +00000B2B: 5E LD E,(HL) ; get the jump byte into E +00000B2C: 19 ADD HL,DE ; advance calculator pointer forward or back. +00000B2D: D9 EXX +00000B2E: C9 RET + + +;----------------------- +; THE 'TANGENT' FUNCTION +;----------------------- +; (offset $??: 'tan') +; +; Evaluates tangent x as sin(x) / cos(x). +; +; +; /| +; h / | +; / |o +; /x | +; /----| +; a +; +; the tangent of angle x is the ratio of the length of the opposite side +; divided by the length of the adjacent side. As the opposite length can +; be calculates using sin(x) and the adjacent length using cos(x) then +; the tangent can be defined in terms of the previous two functions. + +; Error 6 if the argument, in radians, is too close to one like pi/2 +; which has an infinite tangent. e.g. PRINT TAN (PI/2) evaluates as 1/0. +; Similarly PRINT TAN (3*PI/2), TAN (5*PI/2) etc. + +;; tan +00000B2F: F7 RST 30h ; FP-CALC +00000B30: 01 ;;duplicate +00000B31: 0D ;;sin +00000B32: 33 ;;exchange +00000B33: 0E ;;cos +00000B34: A0 ;;division & end-calc +00000B35: C9 RET + +;------------------------------ +; THE 'LINE ADDRESS' SUBROUTINE +;------------------------------ +; +; + +;; LINE-ADDR (HL) +00000B36: 44 LD B,H +00000B37: 4D LD C,L +;; LINE-ADDR (BC) +00000B38: 21 96 43 LD HL,4396h ; The first location after System Variables -> default program position (17302) +00000B3B: 5D LD E,L +00000B3C: 54 LD D,H +; NEXT-TEST +00000B3D: CD 68 18 CALL 1868h ; routine CP-LINES +00000B40: D0 RET NC +00000B41: C5 PUSH BC +00000B42: CD 13 1A CALL 1A13h ; routine NEXT-ONE +00000B45: C1 POP BC +00000B46: EB EX DE,HL +00000B47: 18 F4 JR -0Ch ; NEXT-TEST +;; REPORT-1 +00000B49: CD 4A 14 CALL 144Ah ; ERROR-1 +00000B4C: 04 ; "NF" - NEXT without FOR + +00000B4D: FD CB 2D 4E BIT 1,(IY+2Dh) ; FLAGX +00000B51: C2 0C 0A JP NZ,0A0Ch ; to REPORT-2 +00000B54: 2A 12 40 LD HL,(4012h) ; DEST +00000B57: 7E LD A,(HL) +00000B58: 17 RLA +00000B59: 30 EE JR NC,-12h ; to REPORT-1 +00000B5B: 23 INC HL +00000B5C: 22 1F 40 LD (401Fh),HL ; MEM +00000B5F: F7 RST 30h ; FP-CALC +00000B60: 40 ;;get-mem-0 +00000B61: 4a ;;get-mem-2 +00000B62: 2a ;;addition +00000B63: 50 ;;st-mem-0 +00000B64: 45 ;;delete +00000B65: 4a ;;end-calc + +00000B66: 03 INC BC +00000B67: 34 INC (HL) +00000B68: 02 LD (BC),A +00000B69: 33 ;;exchange +00000B6A: 1E 03 LD E,03h +00000B6C: B4 OR H +00000B6D: 20 11 JR NZ,+11h +00000B6F: 0F RRCA +00000B70: 00 NOP +00000B71: 2A 1F 40 LD HL,(401Fh) ; MEM +00000B74: 19 ADD HL,DE +00000B75: 5E LD E,(HL) +00000B76: 23 INC HL +00000B77: 56 LD D,(HL) +00000B78: EB EX DE,HL +00000B79: C3 11 15 JP 1511h + +;----------------------- +; THE 'INTEGER' FUNCTION +;----------------------- +; (offset $??: 'int') +; This function returns the integer of x, which is just the same as truncate +; for positive numbers. The truncate literal truncates negative numbers +; upwards so that -3.4 gives -3 whereas the BASIC INT function has to +; truncate negative numbers down so that INT -3.4 is 4. +; It is best to work through using, say, plus or minus 3.4 as examples. + +;; int +00000B7C: F7 RST 30h ; FP-CALC +00000B7D: 81 ;;duplicate & end-calc -3.4, -3.4. + +00000B7E: CD A0 0C CALL 0CA0h ; truncate -3.4, -3. + +00000B81: F7 RST 30h ; FP-CALC +00000B82: 50 ;;st-mem-0 -3.4, -3. +00000B83: 1E ;;subtract -.4 +00000B84: 40 ;;get-mem-0 -.4, -3. +00000B85: 33 ;;exchange -3, -.4. +00000B86: 03 ;;less-0 +00000B87: 1D ;;not -3, (0). +00000B88: 34 ;;jump-true -3. +00000B89: 03 ;;to $B8B, EXIT -3. +00000B8A: 79 ;;stk-one -3, 1. +00000B8B: 1E ;;subtract -4. +00000B8C: 00 ;;end-calc +00000B8D: C9 RET + + +; ------------------------- +; THE 'ADD-BACK' SUBROUTINE +; ------------------------- +; Called from SHIFT-FP above during addition and after normalization from +; multiplication. +; This is really a 32-bit increment routine which sets the zero flag according +; to the 32-bit result. +; During addition, only negative numbers like FF FF FF FF FF, +; the twos-complement verson of xx 80 00 00 01 say +; will result in a full ripple FF 00 00 00 00. +; FF FF FF FF FF when shifted right is unchanged by SHIFT-FP but sets the +; carry invoking this routine. + +;; ADD-BACK +00000B8E: 1C INC E +00000B8F: C0 RET NZ + +00000B90: 14 INC D +00000B91: C0 RET NZ + +00000B92: D9 EXX +00000B93: 1C INC E +00000B94: 20 01 JR NZ,+01h + +00000B96: 14 INC D + +;; ALL-ADDED +00000B97: D9 EXX +00000B98: C9 RET + +;; SOUND +00000B99: CD 09 15 CALL 1509h ; FIND-INT +00000B9C: C5 PUSH BC +00000B9D: CD FF 14 CALL 14FFh ; STK-TO-A +00000BA0: C1 POP BC +00000BA1: 5F LD E,A + +; SOUND-ENGINE (play value in E, length BC) +; frequency loop +00000BA2: DB F5 INA (F5h) ; toggle sound bit +00000BA4: 53 LD D,E + +; sound lenght loop +00000BA5: 0B DEC BC +00000BA6: 78 LD A,B +00000BA7: B1 OR C +00000BA8: C8 RET Z +00000BA9: 15 DEC D +00000BAA: 28 F6 JR Z,-0Ah ; frequency loop + +00000BAC: 00 NOP +00000BAD: 00 NOP +00000BAE: 18 F5 JR -0Bh ; sound lenght loop + + +; ALERT BEEP +00000BB0: 1E 1C LD E,1Ch ; preset alert tone +00000BB2: 01 88 13 LD BC,1388h ; 5000 +00000BB5: 18 EB JR -15h ; to SOUND-ENGINE + +00000BB7: FE 21 CP 21h +00000BB9: 30 16 JR NC,+16h + +; ----------------------------- +; THE 'SHIFT ADDEND' SUBROUTINE +; ----------------------------- +; The accumulator A contains the difference between the two exponents. +; This is the lowest of the two numbers to be added + +;; SHIFT-FP +00000BBB: B7 OR A +00000BBC: C8 RET Z + +00000BBD: D9 EXX +00000BBE: CB 2C SRA H +00000BC0: CB 1A RR D +00000BC2: CB 1B RR E +00000BC4: D9 EXX +00000BC5: CB 1A RR D +00000BC7: CB 1B RR E +00000BC9: 3D DEC A +00000BCA: 20 F1 JR NZ,-0Fh +00000BCC: D0 RET NC +00000BCD: CD 8E 0B CALL 0B8Eh +00000BD0: C0 RET NZ + +00000BD1: AF XOR A +00000BD2: 57 LD D,A +00000BD3: 5F LD E,A +00000BD4: D9 EXX +00000BD5: 57 LD D,A +00000BD6: 5F LD E,A +00000BD7: 67 LD H,A +00000BD8: D9 EXX +00000BD9: C9 RET + + +00000BDA: 01 01 00 LD BC,0001h +;------------------------------ +; THE 'MAKE BC SPACES' RESTART +;------------------------------ +; This restart is used eight times to create, in workspace, the number of +; spaces passed in the BC register. + +00000BDD: 2A 14 40 LD HL,(4014h) ; E_LINE +00000BE0: C5 PUSH BC +00000BE1: E5 PUSH HL +00000BE2: 2A 1A 40 LD HL,(401Ah) ; STKBOT +00000BE5: 2B DEC HL +00000BE6: CD B5 1C CALL 1CB5h ; MAKE-ROOM +00000BE9: 13 INC DE +00000BEA: EB EX DE,HL +00000BEB: C1 POP BC +00000BEC: 13 INC DE +00000BED: ED 43 14 40 LD (4014h),BC ; E_LINE +00000BF1: 13 INC DE +00000BF2: C1 POP BC +00000BF3: C9 RET + +;------------------------- +; THE 'TABLE OF ADDRESSES' +;------------------------- +; +; The order of binary operation types is different +; compared to the ZX81 ROM +; +; The following opcodes are probably missing on the Lambda 8300: +; dec-jr-nz, truncate, fp-calc-2 +; +; Opcode $00 for end-calc is handled internally by the FP calculator. +; + +;; tbl-addrs + DEFW $076F ; $01 - duplicate + DEFW $0C77 ; $02 - greater-0 + DEFW $0C7C ; $03 - less-0 + DEFW $0B26 ; $04 - jump + DEFW $0D31 ; $05 - stk-data + DEFW $0C66 ; $06 - n-mod-m + DEFW $03C2 ; $07 - get-argt + DEFW $11F3 ; $08 - e-to-fp + + +; true unary operations + + DEFW $1288 ; $09 - neg + + DEFW $079F ; $0A - code + DEFW $18BE ; $0B - val + DEFW $077D ; $0C - len + DEFW $1189 ; $0D - sin + DEFW $117E ; $0E - cos + DEFW $0B2F ; $0F - tan + DEFW $006E ; $10 - asn + DEFW $0390 ; $11 - acs + DEFW $1B9D ; $12 - atn + DEFW $1A63 ; $13 - ln (log) + DEFW $0718 ; $14 - exp + DEFW $0B7C ; $15 - int + DEFW $06FA ; $16 - sqr + DEFW $0528 ; $17 - sgn + DEFW $001B ; $18 - abs + DEFW $0799 ; $19 - peek + DEFW $0540 ; $1A - usr-no + DEFW $0DA3 ; $1B - strs + DEFW $0DD2 ; $1C - chrs + DEFW $0C8F ; $1D - not + +; true binary operations + + DEFW $173D ; $1E - subtract + DEFW $16DA ; $1F - multiply + DEFW $1679 ; $20 - division + DEFW $0700 ; $21 - to-power + DEFW $0C9B ; $22 - or + + DEFW $0C96 ; $23 - no-&-no + DEFW $10BE ; $24 - no-l-eql + DEFW $10BE ; $25 - no-gr-eql + DEFW $10BE ; $26 - nos-neql + DEFW $10BE ; $27 - no-grtr + DEFW $10BE ; $28 - no-less + DEFW $10BE ; $29 - nos-eql + DEFW $1746 ; $2A - addition + + DEFW $004F ; $2B - str-&-no + DEFW $10BE ; $2C - str-l-eql + DEFW $10BE ; $2D - str-gr-eql + DEFW $10BE ; $2E - strs-neql + DEFW $10BE ; $2F - str-grtr + DEFW $10BE ; $30 - str-less + DEFW $10BE ; $31 - strs-eql + DEFW $189B ; $32 - strs-add + +; special operations - opcodes start from $33 + + DEFW $1CA5 ; $33 - exchange + DEFW $0B1E ; $34 - jump-true + DEFW $09C6 ; $35 - delete + + the following are just the next available slots for the 128 compound literals +; which are in range $80 - $FF. + + DEFW $03A3 ; $40 - get-mem-xx $40,$45,$4A,$4F... + DEFW $1A07 ; $50 - st-mem-xx $50,$55,$5A,$5F... + DEFW $021A ; $60 - series-xx $60 - $6F. + DEFW $17DE ; $3A - stk-const-xx $7A(stk-zero), + ; $79(stk-one), + ; $78(stk-half), + ; $77(stk-ten), + ; $70(stk-pi/2) + + +;------------------------- +; THE 'MODULUS' SUBROUTINE +;------------------------- +; ( Offset $??: 'n-mod-m' ) +; ( i1, i2 -- i3, i4 ) +; The subroutine calculate N mod M where M is the positive integer, the +; 'last value' on the calculator stack and N is the integer beneath. +; The subroutine returns the integer quotient as the last value and the +; remainder as the value beneath. +; e.g. 17 MOD 3 = 5 remainder 2 +; It is invoked during the calculation of a random number and also by +; the PRINT-FP routine. + +;; n-mod-m +00000C66: F7 RST 30h ; FP-CALC +00000C67: 50 ;;st-mem-0 +00000C68: 35 ;;delete +00000C69: 01 ;;duplicate +00000C70: 40 ;;get-mem-0 +00000C71: A0 ;;division & end-calc + +00000C6C: CD A0 0C CALL 0CA0h ; truncate + +00000C6F: F7 RST 30h ; FP-CALC +00000C70: 40 ;;get-mem-0 +00000C71: 33 ;;exchange +00000C72: 50 ;;st-mem-0 +00000C73: 1F ;;multiply +00000C74: 1E ;;subtract +00000C75: C0 ;;get-mem-0 & end-calc +00000C76: C9 RET + +;------------------------ +; Greater than zero ($33) +;------------------------ +; Test if the last value on the calculator stack is greater than zero. +; This routine is also called directly from the end-tests of the comparison +; routine. + +;; greater-0 +00000C77: 7E LD A,(HL) ; fetch exponent. +00000C78: B7 OR A ; test it for zero. +00000C79: C8 RET Z ; return if so. + +00000C7A: AF XOR A ; invert the xor mask to change the sign bit + +00000C7B: FE 3E CP 3Eh ; byte "3E" also as instruction in the next line + + +;-------------------- +; Less than zero +;-------------------- +; Destructively test if last value on calculator stack is less than zero. +; Bit 7 of second byte will be set if so. + +;; less-0 +00000C7C: 3E BF LD A,BFh ; set the XOR mask (this line exists only if entry is 0C7Ch) + +00000C7D: BF CP A ; (this line disappears if entry is not 0C7Ch.. by the way it has no impact when executed) + +; transfer sign of mantissa to Carry Flag. + +;; SIGN-TO-C +00000C7E: 23 INC HL ; address 2nd byte. +00000C7F: AE XOR (HL) ; bit 7 of HL will be set if number is negative. +00000C80: 17 RLA ; rotate bit 7 of A to carry. +00000C81: 2B DEC HL ; address 1st byte again. + +;------------ +; Zero or one +;------------ +; This routine places an integer value zero or one at the addressed location +; of calculator stack or MEM area. The value *ZERO* is written if carry is set on +; entry else zero. + +;; FP-0/1 +00000C82: E5 PUSH HL ; save pointer to the first byte +00000C83: 06 05 LD B,05h ; five bytes to do. + +;; FP-loop +00000C85: 36 00 LD (HL),00h ; insert a zero. +00000C87: 23 INC HL +00000C88: 10 FB DJNZ -05h ; repeat +00000C8A: E1 POP HL +00000C8B: D8 RET C +00000C8C: 36 81 LD (HL),81h ; make value 1 +00000C8E: C9 RET + + +;------------------------- +; Handle NOT operator ($??) +;------------------------- +; This overwrites the last value with 1 if it was zero else with zero +; if it was any other value. +; +; e.g NOT 0 returns 1, NOT 1 returns 0, NOT -3 returns 0. +; +; The subroutine is also called directly from the end-tests of the comparison +; operator. + +;; not +00000C8F: 7E LD A,(HL) ; get exponent byte. +00000C90: B7 OR A ; check for zero. +00000C91: 28 EF JR Z,-11h ; + +00000C93: 37 SCF +00000C94: 18 EC JR -14h ; if not zero, forward to FP-0/1 + + +;------------------------------ +; Handle number AND number (?) +;------------------------------ +; The Boolean AND operator. +; +; e.g. -3 AND 2 returns -3. +; -3 AND 0 returns 0. +; 0 and -2 returns 0. +; 0 and 0 returns 0. +; +; Compare with OR routine above. + +;; no-&-no +00000C96: 1A LD A,(DE) ; fetch exponent of second number. +00000C97: B7 OR A ; test it. +00000C98: 28 F9 JR Z,-07h ; forward to FP-0/1 to overwrite the first operand with zero for return value. +00000C9A: C9 RET ; return if not zero. + + +;------------------------ +; Handle OR operator (??) +;------------------------ +; The Boolean OR operator. eg. X OR Y +; The result is zero if both values are zero else a non-zero value. +; +; e.g. 0 OR 0 returns 0. +; -3 OR 0 returns -3. +; 0 OR -3 returns 1. +; -3 OR 2 returns 1. +; +; A binary operation. +; On entry HL points to first operand (X) and DE to second operand (Y). + +;; or +00000C9B: 1A LD A,(DE) ; fetch exponent of second number +00000C9C: B7 OR A ; test it. +00000C9D: 20 E3 JR NZ,-1Dh ; if not zero, back to FP-0/1 to overwrite the first operand with the value 1. +00000C9F: C9 RET ; return if zero. + +; ------------------------------------------------ +; THE 'INTEGER TRUNCATION TOWARDS ZERO' SUBROUTINE +; ------------------------------------------------ +; + +;; truncate +00000CA0: 7E LD A,(HL) ; fetch exponent +00000CA1: FE 81 CP 81h ; compare to +1 +00000CA3: 38 DD JR C,-23h ; forward, if 0 or LESS + +;;T-GR-ZERO +00000CA5: 3E A0 LD A,A0h +00000CA7: 96 SUB (HL) ; subtract +32 from exponent +00000CA8: D8 RET C +00000CA9: 47 LD B,A +00000CAA: CB 38 SRL B +00000CAC: CB 38 SRL B +00000CAE: CB 38 SRL B +00000CB0: EB EX DE,HL +00000CB1: 2B DEC HL +00000CB2: 28 05 JR Z,+05h +00000CB4: 36 00 LD (HL),00h +00000CB6: 2B DEC HL +00000CB7: 10 FB DJNZ -05h +00000CB9: E6 07 AND 07h +00000CBB: C8 RET Z +00000CBC: 47 LD B,A +00000CBD: 3E FF LD A,FFh +00000CBF: CB 27 SLA A +00000CC1: 10 FC DJNZ -04h +00000CC3: A6 AND (HL) +00000CC4: 77 LD (HL),A +00000CC5: C9 RET + +;---------------------------------------- +; THE 'LIST' AND 'LLIST' COMMAND ROUTINES +;---------------------------------------- +; +; + +;; LLIST +00000CC6: FD CB 1E CE SET 1,(IY+1Eh) ; BREG/FLAGS + +;; LIST +00000CCA: CD 09 15 CALL 1509h ; FIND-INT +00000CCD: 78 LD A,B +00000CCE: E6 3F AND 3Fh +00000CD0: 47 LD B,A +00000CD1: ED 43 29 40 LD (4029h),BC ; E_PPC (<> ZX81) +00000CD5: CD 38 0B CALL 0B38h ; routine LINE-ADDR (BC) +00000CD8: ED 4B 29 40 LD BC,(4029h) ; E_PPC (<> ZX81) +00000CDC: CD 68 18 CALL 1868h ; routine CP-LINES +00000CDF: 01 00 97 LD BC,9700h +00000CE2: 28 06 JR Z,+06h +00000CE4: 41 LD B,C +00000CE5: 38 03 JR C,+03h +00000CE7: FD 71 09 LD (IY+09h),C ; VERSN +00000CEA: 7E LD A,(HL) +00000CEB: FE 40 CP 40h +00000CED: D0 RET NC +00000CEE: 57 LD D,A +00000CEF: 23 INC HL +00000CF0: 5E LD E,(HL) +00000CF1: 23 INC HL +00000CF2: CD 89 04 CALL 0489h +00000CF5: 22 16 40 LD (4016h),HL ; CH_ADD +00000CF8: 78 LD A,B +00000CF9: CD BB 04 CALL 04BBh ; PRINT-CH +00000CFC: 23 INC HL +00000CFD: 23 INC HL +00000CFE: CD D8 04 CALL 04D8h +00000D01: 18 D5 JR -2Bh + +;; SAVE +00000D03: CD 38 15 CALL 1538h ; NAME +00000D06: 30 04 JR NC,+04h + +00000D08: CD 4A 14 CALL 144Ah ; ERROR-1 +00000D0B: 0D ; "NA" - Invalid program name + +00000D0C: EB EX DE,HL +00000D0D: 16 40 LD D,40h +00000D0F: CD F4 19 CALL 19F4h ; call PULSES +00000D12: 15 DEC D +00000D13: 20 FA JR NZ,-06h +00000D15: 3E 0A LD A,0Ah +00000D17: 3D DEC A +00000D18: 20 FD JR NZ,-03h +00000D1A: 10 F9 DJNZ -07h + +;; OUT-NAME +00000D1C: CD ED 17 CALL 17EDh ; routine OUT-BYTE +00000D1F: CB 7E BIT 7,(HL) ; test for inverted bit. +00000D21: 23 INC HL ; address next character of name. +00000D22: 28 F8 JR Z,-08h ; back if not inverted to OUT-NAME + +; now start saving the system variables onwards. + +00000D24: 21 09 40 LD HL,4009h ; set start of area to VERSN/BERG thereby preserving RAMTOP etc. +00000D27: 36 FF LD (HL),FFh + +;; OUT-PROG +00000D29: CD ED 17 CALL 17EDh ; routine OUT-BYTE +00000D2C: CD BA 0E CALL 0EBAh ; routine LOAD/SAVE +00000D2F: 18 F8 JR -08h ; loop back to OUT-PROG + + +;-------------------- +; Stack literals +;-------------------- +; When a calculator subroutine needs to put a value on the calculator +; stack that is not a regular constant this routine is called with a +; variable number of following data bytes that convey to the routine +; the floating point form as succinctly as is possible. + +;; stk-data +00000D31: CD F2 13 CALL 13F2h ; routine TEST-5-SP tests that room exists +00000D34: D5 PUSH DE +00000D35: D9 EXX +00000D36: E5 PUSH HL ; save the pointer to next literal on stack +00000D37: D9 EXX +00000D38: E1 POP HL ; pointer to HL +00000D39: 7E LD A,(HL) ; fetch the byte following 'stk-data' +00000D3A: 07 RLCA ; rotate +00000D3B: 07 RLCA ; to bits 1 and 0 +00000D3C: E6 03 AND 03h ; mask the range $00 - $03 +00000D3E: 3C INC A ; increment to give number of bytes to read. $01 - $04 +00000D3F: 4F LD C,A ; copy to C +00000D40: 7E LD A,(HL) ; reload the first byte +00000D41: 23 INC HL +00000D42: E6 3F AND 3Fh ; mask off to give possible exponent. +00000D44: 20 02 JR NZ,+02h ; forward to FORM-EXP if it was possible to include the exponent. + +; else byte is just a byte count and exponent comes next. + +00000D46: 7E LD A,(HL) ; pick up the exponent ( - $50). +00000D47: 23 INC HL +;; FORM-EXP +00000D48: C6 50 ADD 50h ; now add $50 to form actual exponent +00000D4A: 12 LD (DE),A ; and load into first destination byte. +00000D4B: 13 INC DE +00000D4C: 3E 05 LD A,05h ; load accumulator with $05 and +00000D4E: 91 SUB C ; subtract C to give count of trailing +00000D4F: ED B0 LDIR ; copy C bytes +00000D51: E5 PUSH HL ; put HL on stack as next literal pointer +00000D52: D9 EXX +00000D53: E1 POP HL ; restore next literal pointer from stack to H'L'. +00000D54: D9 EXX +00000D55: E1 POP HL +00000D56: 4F LD C,A ; zero count to C +00000D57: AF XOR A ; clear accumulator +;; STK-ZEROS +00000D58: 0D DEC C ; decrement B counter +00000D59: C8 RET Z ; return if zero. >> DE points to new STKEND, HL to new number. +00000D5A: 12 LD (DE),A ; else load zero to destination +00000D5B: 13 INC DE ; increase destination +00000D5C: 18 FA JR -06h ; loop back to STK-ZEROS until done. + + + + +;---------------------------- +; THE 'PAUSE' COMMAND ROUTINE +;---------------------------- +; +; + +;; FAST +00000D5E: FD CB 3B B6 RES 6,(IY+3Bh) ; CDFLAG + +;; SET-FAST +00000D62: FD CB 3B 7E BIT 7,(IY+3Bh) ; CDFLAG +00000D66: C8 RET Z +00000D67: 76 HALT +00000D68: D3 FD OUTA (FDh) ; turn off the NMI generator. +00000D6A: FD CB 3B BE RES 7,(IY+3Bh) ; CDFLAG +00000D6E: C9 RET + +;; GET-INT & SET-FAST +00000D6F: E7 RST 20h ; STK-FETCH +00000D70: 62 LD H,D +00000D71: 6B LD L,E +00000D72: 18 EE JR -12h ; to set-fast + + +;----------------------------------- +; THE 'KEYBOARD SCANNING' SUBROUTINE +;----------------------------------- +; +; + +;; KEYBOARD +00000D74: 01 FE FE LD BC,FEFEh +00000D77: 21 FF FF LD HL,FFFFh +00000D7A: ED 78 IN A,(C) +00000D7C: F6 01 OR 01h + +;; EACH-LINE +00000D7E: F6 E0 OR E0h +00000D80: 5F LD E,A +00000D81: 2F CPL +00000D82: FE 01 CP 01h +00000D84: 9F SBC A +00000D85: B0 OR B +00000D86: A5 AND L +00000D87: 6F LD L,A +00000D88: 7B LD A,E +00000D89: A4 AND H +00000D8A: 67 LD H,A +00000D8B: CB 00 RLC B +00000D8D: ED 78 IN A,(C) +00000D8F: 38 ED JR C,-13h ; to EACH-LINE + +00000D91: 0F RRCA +00000D92: CB 14 RL H +00000D94: 3E FF LD A,FFh +00000D96: DB 7E INA (7Eh) ; FF7Eh.R Lambda - read PAL/NTSC flag (A7=row) (via diode from A7 to KEYB.0) +00000D98: 1F RRA +00000D99: 3F CCF +00000D9A: 9F SBC A +00000D9B: E6 18 AND 18h +00000D9D: C6 1F ADD 1Fh +00000D9F: 32 28 40 LD (4028h),A ; MARGIN +00000DA2: C9 RET + + +;----------------- +; Handle STR$ +;----------------- +; This function returns a string representation of a numeric argument. +; The method used is to trick the PRINT-FP routine. + +;; str$ +00000DA3: 2A 0E 40 LD HL,(400Eh) ; fetch value of DF_CC +00000DA6: E5 PUSH HL ; and preserve on stack +00000DA7: 2A 39 40 LD HL,(4039h) ; fetch value of S_POSN column/line +00000DAA: E5 PUSH HL ; and preserve on stack. +00000DAB: 21 FF 18 LD HL,18FFh ; make column value high to create a +00000DAE: 22 39 40 LD (4039h),HL ; contrived buffer and store in system variable S_POSN. +00000DB1: 01 0E 00 LD BC,000Eh ; create the temporary buffer space of 14 bytes +00000DB4: CD DD 0B CALL 0BDDh ; BC-SPACES +00000DB7: D5 PUSH DE +00000DB8: ED 53 0E 40 LD (400Eh),DE ; now set DF_CC which normally addresses somewhere in the display file + ; to the start of workspace. +00000DBC: CD 55 15 CALL 1555h ; routine PRINT-FP. +00000DBF: 2A 0E 40 LD HL,(400Eh) ; DF_CC +00000DC2: AF XOR A +00000DC3: D1 POP DE ; retrieve start of string +00000DC4: ED 52 SBC HL,DE +00000DC6: 4D LD C,L +00000DC7: 44 LD B,H +00000DC8: E1 POP HL ; restore original +00000DC9: 22 39 40 LD (4039h),HL ; S_POSN x and y values +00000DCC: E1 POP HL ; restore original +00000DCD: 22 0E 40 LD (400Eh),HL ; DF_CC value +00000DD0: 18 09 JR +09h ; **v + + +;----------------- +; Handle CHR$ +;----------------- +; This function returns a single character string that is a result of +; converting a number in the range 0-255 to a string e.g. CHR$ 38 = "A". +; Note. the ZX81 does not have an ASCII character set. + +;; chrs +00000DD2: CD FF 14 CALL 14FFh ; STK-TO-A +00000DD5: F5 PUSH AF +00000DD6: CD DA 0B CALL 0BDAh ; call BC-SPACES for one space (makes DE point to start) +00000DD9: F1 POP AF ; restore the number. +00000DDA: 12 LD (DE),A ; and store in workspace + ; **^ +00000DDB: CD BC 13 CALL 13BCh ; routine STK-STO-$ stores the string descriptor on the calculator stack. +00000DDE: EB EX DE,HL ; HL = last value, DE = STKEND. +00000DDF: C9 RET + +; switch the output from screen to workspace buffer +00000DE0: 21 FF 18 LD HL,18FFh ; set row value to 24 and make column value + ; high to create a contrived buffer of length 254. +00000DE3: 22 39 40 LD (4039h),HL ; store in system variable S_POSN. +00000DE6: 2A 14 40 LD HL,(4014h) ; fetch E_LINE +00000DE9: 22 0E 40 LD (400Eh),HL ; now set DF_CC which normally addresses somewhere in the display file + ; to the start of workspace. +00000DEC: 2A 29 40 LD HL,(4029h) ; E_PPC (<> ZX81) +00000DEF: C9 RET + +;------------------------- +; THE 'STK-VAR' SUBROUTINE +;------------------------- +; + +00000DF0: AF XOR A +00000DF1: EF RST 28h ; routine SYNTAX-Z +00000DF2: 47 LD B,A +00000DF3: 28 24 JR Z,+24h +00000DF5: CB 7E BIT 7,(HL) +00000DF7: 28 0B JR Z,+0Bh + +;; SV-ARRAYS +00000DF9: CB 71 BIT 6,C +00000DFB: 23 INC HL +00000DFC: 23 INC HL +00000DFD: 23 INC HL +00000DFE: 46 LD B,(HL) +00000DFF: 28 17 JR Z,+17h +00000E01: 10 0E DJNZ +0Eh +00000E03: FE 3C CP 3Ch +00000E05: 23 INC HL +00000E06: 4E LD C,(HL) +00000E07: 23 INC HL +00000E08: 46 LD B,(HL) +00000E09: EB EX DE,HL +00000E0A: 13 INC DE +00000E0B: CD BC 13 CALL 13BCh ; routine STK-STO-$ +00000E0E: D7 RST 10h ; GET-CHAR +00000E0F: 18 47 JR +47h +00000E11: EB EX DE,HL +00000E12: D7 RST 10h ; GET-CHAR +00000E13: D6 10 SUB 10h +00000E15: 20 35 JR NZ,+35h +00000E17: FE EB CP EBh +00000E19: CF RST 08h ; NEXT-CHAR +00000E1A: 21 00 00 LD HL,0000h +00000E1D: 18 48 JR +48h + + +00000E1F: D5 PUSH DE +00000E20: E5 PUSH HL +00000E21: CD 11 0A CALL 0A11h ; routine CLASS-06 +00000E24: EF RST 28h ; routine SYNTAX-Z +00000E25: 28 0C JR Z,+0Ch +00000E27: CD 09 15 CALL 1509h ; FIND-INT +00000E2A: E1 POP HL +00000E2B: E5 PUSH HL +00000E2C: B0 OR B +00000E2D: 28 1D JR Z,+1Dh +00000E2F: ED 42 SBC HL,BC +00000E31: 38 19 JR C,+19h +00000E33: E1 POP HL +00000E34: D1 POP DE +00000E35: C9 RET + +00000E36: EE 11 XOR 11h +00000E38: 20 12 JR NZ,+12h +00000E3A: CF RST 08h ; NEXT-CHAR +00000E3B: C9 RET + +00000E3C: EF RST 28h ; routine SYNTAX-Z +00000E3D: 20 0D JR NZ,+0Dh +00000E3F: CB 71 BIT 6,C +00000E41: D1 POP DE +00000E42: 28 F2 JR Z,-0Eh + +00000E44: FE 41 CP 41h +00000E46: 28 08 JR Z,+08h + +00000E48: EE 11 XOR 11h +00000E4A: 28 0B JR Z,+0Bh + +00000E4C: CD 4A 14 CALL 144Ah ; ERROR-1 +00000E4F: 0C ; "BS" - Bad Subscript + +00000E50: 2B DEC HL +00000E51: 22 16 40 LD (4016h),HL ; CH_ADD +00000E54: CD 37 13 CALL 1337h ; routine SLICING +00000E57: CF RST 08h ; NEXT-CHAR +00000E58: D6 10 SUB 10h +00000E5A: 28 F8 JR Z,-08h +00000E5C: FD CB 1E B6 RES 6,(IY+1Eh) ; BREG/FLAGS +00000E60: C9 RET + +00000E61: FE 1A CP 1Ah +00000E63: 20 D7 JR NZ,-29h +00000E65: CF RST 08h ; NEXT-CHAR +00000E66: E1 POP HL +00000E67: 3E E0 LD A,E0h +00000E69: A1 AND C +00000E6A: EE C0 XOR C0h +00000E6C: 20 09 JR NZ,+09h +00000E6E: D7 RST 10h ; GET-CHAR +00000E6F: FE 41 CP 41h +00000E71: 28 DD JR Z,-23h +00000E73: EE 11 XOR 11h +00000E75: 28 E0 JR Z,-20h + +;; SV-MULT +00000E77: C5 PUSH BC +00000E78: E5 PUSH HL +00000E79: CD 95 18 CALL 1895h ; routine DE,(DE+1) +00000E7C: E3 EX HL,(SP) +00000E7D: EB EX DE,HL +00000E7E: CD 1F 0E CALL 0E1Fh ; routine INT-EXP1 +00000E81: CD A3 13 CALL 13A3h ; routine GET-HL*DE +00000E84: D1 POP DE +00000E85: 09 ADD HL,BC +00000E86: 2B DEC HL +00000E87: C1 POP BC +00000E88: E5 PUSH HL +00000E89: D7 RST 10h ; GET-CHAR +00000E8A: 10 D5 DJNZ -2Bh +00000E8C: EF RST 28h ; routine SYNTAX-Z +00000E8D: 28 BD JR Z,-43h +00000E8F: CB 71 BIT 6,C +00000E91: 28 17 JR Z,+17h + +;; SV-ELEM$ +00000E93: CD 95 18 CALL 1895h ; routine DE,(DE+1) +00000E96: E3 EX HL,(SP) +00000E97: CD A5 13 CALL 13A5h ; routine GET-HL*DE +00000E9A: C1 POP BC +00000E9B: 03 INC BC +00000E9C: 09 ADD HL,BC +00000E9D: 42 LD B,D +00000E9E: 4B LD C,E +00000E9F: EB EX DE,HL +00000EA0: CD 7D 13 CALL 137Dh ; routine STK-ST-0 +00000EA3: D7 RST 10h ; GET-CHAR +00000EA4: FE 1A CP 1Ah +00000EA6: 28 AC JR Z,-54h +00000EA8: 18 9E JR -62h +00000EAA: FE 11 CP 11h +00000EAC: 20 9E JR NZ,-62h +00000EAE: 4B LD C,E +00000EAF: 42 LD B,D +00000EB0: D1 POP DE +00000EB1: CF RST 08h ; NEXT-CHAR +00000EB2: 21 05 00 LD HL,0005h +00000EB5: CD A5 13 CALL 13A5h +00000EB8: 09 ADD HL,BC +00000EB9: C9 RET + +;------------------------------- +; THE 'LOAD-SAVE UPDATE' ROUTINE +;------------------------------- +; +; + +;; LOAD/SAVE +00000EBA: EB EX DE,HL +00000EBB: 2A 14 40 LD HL,(4014h) ; system variable edit line E_LINE. +00000EBE: 37 SCF +00000EBF: 13 INC DE +00000EC0: ED 52 SBC HL,DE +00000EC2: EB EX DE,HL +00000EC3: D0 RET NC ; return if more bytes to load/save. + +00000EC4: D1 POP DE ; else drop return address + +;----------------------- +; THE 'DISPLAY' ROUTINES +;----------------------- + + +00000EC5: FD 34 09 INC (IY+09h) ; VERSN / BERG +00000EC8: CA A9 12 JP Z,12A9h ; routine SLOW/FAST + + + +00000ECB: 2A 0C 40 LD HL,(400Ch) ; PROGRAM +00000ECE: CD 36 14 CALL 1436h ; Init PROGRAM and VARS and CLEAR +00000ED1: 21 7D 40 LD HL,407Dh ; D-FILE +00000ED4: 01 19 03 LD BC,0319h +00000ED7: CD B5 1C CALL 1CB5h ; MAKE-ROOM +00000EDA: EB EX DE,HL +00000EDB: 23 INC HL +00000EDC: 3E C0 LD A,C0h +00000EDE: A6 AND (HL) +00000EDF: 23 INC HL +00000EE0: 23 INC HL +00000EE1: 23 INC HL +00000EE2: 28 04 JR Z,+04h +00000EE4: 18 7D JR +7Dh +00000EE6: 80 ADD B + +;; +00000EE7: 77 LD (HL),A +;; MORE-LINE-B +00000EE8: 23 INC HL +00000EE9: CD F6 18 CALL 18F6h ; routine NUMBER +00000EEC: 28 FA JR Z,-06h ; to MORE-LINE-B + +00000EEE: FE 76 CP 76h ; +00000EF0: 28 E9 JR Z,-17h ; + +00000EF2: FE E1 CP E1h +00000EF4: 30 F2 JR NC,-0Eh + +00000EF6: FE 40 CP 40h +00000EF8: 38 EE JR C,-12h + +00000EFA: 06 03 LD B,03h +00000EFC: FE 43 CP 43h +00000EFE: 38 E6 JR C,-1Ah + +00000F00: 06 62 LD B,62h +00000F02: FE DE CP DEh +00000F04: 30 E0 JR NC,-20h + +00000F06: 06 FE LD B,FEh +00000F08: FE D8 CP D8h +00000F0A: 30 DA JR NC,-26h + +00000F0C: 06 FC LD B,FCh +00000F0E: FE C4 CP C4h +00000F10: 30 D4 JR NC,-2Ch + +00000F12: 06 13 LD B,13h +00000F14: FE C1 CP C1h +00000F16: 30 CE JR NC,-32h + +00000F18: FE C0 CP C0h +00000F1A: 20 CC JR NZ,-34h + +00000F1C: 3E 17 LD A,17h +00000F1E: 18 C7 JR -39h + + +;-------------------------- +; THE 'NEW' COMMAND ROUTINE +;-------------------------- +; +; + +;; NEW +00000F20: CD 62 0D CALL 0D62h ; routine SET-FAST +00000F23: 2A 04 40 LD HL,(4004h) ; fetch value of system variable RAMTOP +00000F26: 18 11 JR +11h ; jump forcefully to COLD BOOT + +; ENTRY for BOOT/RESET (address '0') +00000F28: 1F RRA ; load ENTER key bit to CARRY to choose between COLD/WARM boot mode +00000F29: 2F CPL +00000F2A: 32 09 40 LD (4009h),A ; VERSN / BERG +00000F2D: 30 07 JR NC,+07h + +00000F2F: 3A 7D 40 LD A,(407Dh) ; D-FILE + +00000F32: FE 76 CP 76h ; Check for NEWLINE +00000F34: 28 2D JR Z,+2Dh ; jump if LAMBDA video mem looks correctly initialized (warm boot ?) + +00000F36: 21 00 C0 LD HL,C000h ; set HL to the max possible RAM address + +;; COLD BOOT +00000F39: 31 67 40 LD SP,4067h +00000F3C: CD B0 0B CALL 0BB0h ; ALERT BEEP + + +;------------------------ +; THE 'RAM CHECK' ROUTINE +;------------------------ + +00000F3F: 2B DEC HL +00000F40: 3E 3F LD A,3Fh +00000F42: 5D LD E,L +00000F43: 54 LD D,H +;; RAM-FILL +00000F44: 36 FF LD (HL),FFh +00000F46: 2B DEC HL +00000F47: BC CP H +00000F48: 38 FA JR C,-06h ; to RAM-FILL + +;; RAM-READ +00000F4A: AF XOR A +00000F4B: ED 52 SBC HL,DE +00000F4D: 19 ADD HL,DE +00000F4E: 23 INC HL +00000F4F: 30 06 JR NC,+06h ; to SET-TOP + +00000F51: 34 INC (HL) +00000F52: 20 03 JR NZ,+03h ; to SET-TOP +00000F54: BE CP (HL) +00000F55: 28 F3 JR Z,-0Dh ; to RAM-READ + +;; SET-TOP +00000F57: 22 04 40 LD (4004h),HL ; set system variable RAMTOP to first byte above the BASIC system area. + +;----------------------------- +; THE 'INITIALIZATION' ROUTINE +;----------------------------- +; +; + +;; INITIAL +00000F5A: 21 96 43 LD HL,4396h ; The first location after System Variables -> default program position (17302) +00000F5D: 22 0C 40 LD (400Ch),HL ; PROGRAM +00000F60: CD 36 14 CALL 1436h ; Init PROGRAM and VARS and CLEAR +00000F63: ED 56 IM 1 +00000F65: AF XOR A +00000F66: 32 19 40 LD (4019h),A ; X_PTR_high +00000F69: 32 2D 40 LD (402Dh),A ; FLAGX +00000F6C: 32 01 30 LD (3001h),A ; Enable COLOR module (if present); writing to 3000h would disable it. +00000F6F: FD 21 00 40 LD IY,4000h ; set IY to the start of RAM so that the system variables can be indexed. +00000F73: FD 36 7D 76 LD (IY+7Dh),76h ; insert NEWLINE (HALT instruction) in the first D-FILE byte +00000F77: FD CB 35 FE SET 7,(IY+35h) +00000F7B: FD 36 3B 40 LD (IY+3Bh),40h ; set CDFLAG 0100 0000 +00000F7F: FD 36 21 19 LD (IY+21h),19h ; set MUNIT (tempo) to 25 +00000F83: FD 36 37 F0 LD (IY+37h),F0h ; LAMBDA-VAR +1 +00000F87: FD 36 08 07 LD (IY+08h),07h ; PPC high + +00000F8B: 2A 04 40 LD HL,(4004h) ; fetch system variable RAMTOP. +00000F8E: 2B DEC HL ; point to last system byte. +00000F8F: 36 AA LD (HL),AAh ; make GO SUB end-marker $3E - too high for high order byte of line number. + ; (is 3Fh on ZX80 and 3Eh on ZX81) +00000F91: 2B DEC HL ; point to unimportant low-order byte. +00000F92: F9 LD SP,HL ; and initialize the stack-pointer to this location. +00000F93: E5 PUSH HL ; HL now holds the current machine stack +00000F94: ED 73 02 40 LD (4002h),SP ; set the error stack pointer ERR_SP to the base of the now empty machine stack. +00000F98: E1 POP HL +00000F99: CD EB 06 CALL 06EBh ; initialize BORDER +00000F9C: CD 7D 1C CALL 1C7Dh ; routine CLS +00000F9F: CD B0 0B CALL 0BB0h ; ALERT BEEP +00000FA2: CD A9 12 CALL 12A9h ; routine SLOW/FAST +00000FA5: FD CB 09 46 BIT 0,(IY+09h) ; VERSN / BERG +00000FA9: C2 00 20 JP NZ,2000h + +00000FAC: 3A 96 43 LD A,(4396h) ; The first location after System Variables -> default program position (17302) +00000FAF: 3C INC A +00000FB0: C2 63 18 JP NZ,1863h ; to N/L-ONLY + +00000FB3: 3E B7 LD A,B7h ; (inverse) 'R' +00000FB5: DF RST 18h ; PRINT-A +00000FB6: 3E AA LD A,AAh ; (inverse) 'E' +00000FB8: DF RST 18h ; PRINT-A +00000FB9: 3E A6 LD A,A6h ; (inverse) 'A' +00000FBB: DF RST 18h ; PRINT-A +00000FBC: 3E A9 LD A,A9h ; (inverse) 'D' +00000FBE: DF RST 18h ; PRINT-A +00000FBF: 3E BE LD A,BEh ; (inverse) 'Y' +00000FC1: DF RST 18h ; PRINT-A + +00000FC2: CD D4 13 CALL 13D4h ; routine CURSOR-IN inserts the cursor and end-marker + ; in the Edit Line also setting size of lower display to two lines. +00000FC5: 18 3D JR +3Dh + +;-------------------------- +; THE 'NEWLINE KEY' ROUTINE +;-------------------------- +; +; + +;; N/L-KEY +00000FC7: CD 54 14 CALL 1454h ; routine LINE-ENDS +00000FCA: FD CB 2D 6E BIT 5,(IY+2Dh) ; FLAGX +00000FCE: 20 F2 JR NZ,-0Eh + +00000FD0: CD E0 0D CALL 0DE0h ; switch the output from screen to workspace buffer +00000FD3: CD 93 12 CALL 1293h +00000FD6: 23 INC HL +00000FD7: 7B LD A,E +00000FD8: B2 OR D +00000FD9: 28 E7 JR Z,-19h +00000FDB: CD 87 04 CALL 0487h +00000FDE: 4E LD C,(HL) +00000FDF: 23 INC HL +00000FE0: 46 LD B,(HL) +00000FE1: 23 INC HL +00000FE2: EB EX DE,HL +00000FE3: 21 30 03 LD HL,0330h ; location for STOP-LINE +00000FE6: E5 PUSH HL +00000FE7: 2A 0E 40 LD HL,(400Eh) ; DF_CC +00000FEA: 36 7F LD (HL),7Fh +00000FEC: 23 INC HL +00000FED: 22 1C 40 LD (401Ch),HL ; STKEND low +00000FF0: CD F5 13 CALL 13F5h ; TEST-ROOM +00000FF3: EB EX DE,HL +00000FF4: ED B0 LDIR +00000FF6: EB EX DE,HL +00000FF7: CD E1 13 CALL 13E1h ; SET-STK-B +00000FFA: 18 74 JR +74h +00000FFC: 3A 07 40 LD A,(4007h) ; PPC low / ERR NR +00000FFF: FE 03 CP 03h +00001001: CA 30 03 JP Z,0330h ; STOP-LINE + +;; LOWER +00001004: 2A 14 40 LD HL,(4014h) ; fetch edit line start from E_LINE. +;; EACH-CHAR +00001007: 7E LD A,(HL) ; fetch a character from edit line. +00001008: FE 7E CP 7Eh ; compare to the number marker. +0000100A: 28 23 JR Z,+23h ; SKIP-NUM - skip the 6 invisible bytes +;; END-LINE +0000100C: 23 INC HL +0000100D: FE 76 CP 76h +0000100F: 20 F6 JR NZ,-0Ah ; to EACH-CHAR + +00001011: CD 54 14 CALL 1454h ; routine LINE-ENDS +00001014: FD 36 07 FF LD (IY+07h),FFh ; PPC low +00001018: 2A 14 40 LD HL,(4014h) ; E_LINE +0000101B: CD D8 04 CALL 04D8h +0000101E: FD CB 07 76 BIT 6,(IY+07h) ; PPC low + +00001022: C2 24 12 JP NZ,1224h +00001025: 21 22 40 LD HL,4022h ; DF_SZ +00001028: CB 66 BIT 4,(HL) +0000102A: 20 F6 JR NZ,-0Ah + +0000102C: 34 INC (HL) +0000102D: 18 E2 JR -1Eh +;; SKIP-NUM +0000102F: 01 06 00 LD BC,0006h ; else six invisible bytes to be removed. +00001032: CD 77 01 CALL 0177h ; routine RECLAIM-2 +00001035: 18 D0 JR -30h ; back to EACH-CHAR + +00001037: CD 4A 14 CALL 144Ah ; ERROR-1 +0000103A: 07 ; "II" - Illegal Input + +0000103B: 3A 37 40 LD A,(4037h) ; LAMBDA-VAR +1 +0000103E: 17 RLA +0000103F: 38 F6 JR C,-0Ah +00001041: 01 02 00 LD BC,0002h +00001044: 3A 1E 40 LD A,(401Eh) ; BREG/FLAGS +00001047: 21 2D 40 LD HL,402Dh ; FLAGX +0000104A: CB B6 RES 6,(HL) +0000104C: CB EE SET 5,(HL) +0000104E: E6 40 AND 40h +00001050: 20 02 JR NZ,+02h +00001052: CB 21 SLA C +00001054: B6 OR (HL) +00001055: 77 LD (HL),A +00001056: CD 45 14 CALL 1445h ; X-TEMP +00001059: CD DD 0B CALL 0BDDh ; BC-SPACES +0000105C: CB 51 BIT 2,C +0000105E: 36 76 LD (HL),76h +00001060: 2B DEC HL +00001061: 28 05 JR Z,+05h +00001063: 3E 0B LD A,0Bh +00001065: 77 LD (HL),A +00001066: 12 LD (DE),A +00001067: 2B DEC HL +00001068: 36 7F LD (HL),7Fh +0000106A: 2A 39 40 LD HL,(4039h) ; S_POSN_x +0000106D: 22 30 40 LD (4030h),HL ; T_ADDR +00001070: D1 POP DE +00001071: 18 91 JR -6Fh + +00001073: FD CB 2D 6E BIT 5,(IY+2Dh) ; FLAGX +00001077: 20 8B JR NZ,-75h + +00001079: CD E0 0D CALL 0DE0h ; switch the output from screen to workspace buffer +0000107C: 11 0A 00 LD DE,000Ah ; 10 +0000107F: 19 ADD HL,DE +00001080: EB EX DE,HL +00001081: 21 0F 27 LD HL,270Fh ; 9999 +00001084: A7 AND A +00001085: ED 52 SBC HL,DE +00001087: 30 03 JR NC,+03h +00001089: 11 0F 27 LD DE,270Fh ; 9999 +0000108C: CD 87 04 CALL 0487h +0000108F: 2A 0E 40 LD HL,(400Eh) ; DF_CC +00001092: CD DB 13 CALL 13DBh +00001095: 18 DA JR -26h + +; ----------------------------- +; THE 'GRAPHIC' CHARACTER CODES +; ----------------------------- +; (start from position Z,X,C,V..) + +;; K-GRAPH +00001097: + DEFB 83h + DEFB 03h + DEFB 05h + DEFB 85h +0000109B: + DEFB 08h + DEFB 0Ah + DEFB 09h + DEFB 8Ah + DEFB 89h +000010A0: + DEFB 01h + DEFB 02h + DEFB 04h + DEFB 87h + DEFB 81h +000010A5: + DEFB 8Fh + DEFB 8Ch + DEFB 8Eh + DEFB 8Dh + DEFB 8Bh +000010AA: + DEFB 94h + DEFB 91h + DEFB 90h + DEFB 9Ah + DEFB 99h +000010AF: + DEFB 92h + DEFB 93h + DEFB 07h + DEFB 84h + DEFB 82h +000010B4: + DEFB 78h + DEFB 95h + DEFB 96h + DEFB 97h + DEFB 98h +000010B9: + DEFB 78h + DEFB 77h + DEFB 78h + DEFB 86h + DEFB 06h + + +;------------------------------------ +; Perform comparison +;------------------------------------ +; True binary operations. +; +; A single entry point is used to evaluate six numeric and six string +; comparisons. On entry, the calculator literal is in the B register and +; the two numeric values, or the two string parameters, are on the +; calculator stack. +; The individual bits of the literal are manipulated to group similar +; operations although the SUB 8 instruction does nothing useful and merely +; alters the string test bit. +; Numbers are compared by subtracting one from the other, strings are +; compared by comparing every character until a mismatch, or the end of one +; or both, is reached. +; +; Numeric Comparisons. +; -------------------- +; The 'x>y' example is the easiest as it employs straight-thru logic. +; Number y is subtracted from x and the result tested for greater-0 yielding +; a final value 1 (true) or 0 (false). +; For 'x0? NOT +; no-gr-eql x>=y 0A 00000010 dec 00000001 10000000c swap y-x ? --- >0? NOT +; nos-neql x<>y 0B 00000011 dec 00000010 00000001 ---- x-y ? NOT --- NOT +; no-grtr x>y 0C 00000100 - 00000100 00000010 ---- x-y ? --- >0? --- +; no-less x0? --- +; nos-eql x=y 0E 00000110 - 00000110 00000011 ---- x-y ? NOT --- --- +; +; comp -> C/F +; ==== === +; str-l-eql x$<=y$ 11 00001001 dec 00001000 00000100 ---- x$y$ 0 !or >0? NOT +; str-gr-eql x$>=y$ 12 00001010 dec 00001001 10000100c swap y$x$ 0 !or >0? NOT +; strs-neql x$<>y$ 13 00001011 dec 00001010 00000101 ---- x$y$ 0 !or >0? NOT +; str-grtr x$>y$ 14 00001100 - 00001100 00000110 ---- x$y$ 0 !or >0? --- +; str-less x$0? --- +; strs-eql x$=y$ 16 00001110 - 00001110 00000111 ---- x$y$ 0 !or >0? --- +; +; String comparisons are a little different in that the eql/neql carry flag +; from the 2nd RRCA is, as before, fed into the first of the end tests but +; along the way it gets modified by the comparison process. The result on the +; stack always starts off as zero and the carry fed in determines if NOT is +; applied to it. So the only time the greater-0 test is applied is if the +; stack holds zero which is not very efficient as the test will always yield +; zero. The most likely explanation is that there were once separate end tests +; for numbers and strings. + +;; no-l-eql,etc. +000010BE: 0F RRCA +000010BF: D6 24 SUB 24h +000010C1: CB 5F BIT 3,A +000010C3: CB 9F RES 3,A +000010C5: 4F LD C,A +000010C6: 06 00 LD B,00h +000010C8: 21 49 00 LD HL,0049h ; conversion table (06 05 03 01 02 04) +000010CB: 09 ADD HL,BC +000010CC: 46 LD B,(HL) +000010CD: C5 PUSH BC +000010CE: 28 31 JR Z,+31h + +000010D0: E7 RST 20h ; routine STK-FETCH gets 2nd string params +000010D1: D5 PUSH DE ; save start2 *. +000010D2: C5 PUSH BC ; and the length. +000010D3: E7 RST 20h ; routine STK-FETCH gets 1st string parameters - start in DE, length in BC. +000010D4: E1 POP HL ; restore length of second to HL. +000010D5: E5 PUSH HL +000010D6: ED 42 SBC HL,BC +000010D8: 30 02 JR NC,+02h ; jp to 10DCh! (E1h = POP HL) + +000010DA: C1 POP BC +000010DB: 3E E1 LD A,E1h +000010DD: E1 POP HL +000010DE: 3F CCF +000010DF: F5 PUSH AF +000010E0: 78 LD A,B + +; --- + +000010E1: B1 OR C +000010E2: 28 09 JR Z,+09h + +; both strings have at least one character left. + +000010E4: 1A LD A,(DE) +000010E5: BE CP (HL) +000010E6: 0B DEC BC +000010E7: 23 INC HL +000010E8: 13 INC DE +000010E9: 28 F5 JR Z,-0Bh +000010EB: E1 POP HL + +000010EC: 3E F1 LD A,F1h +000010EE: 3E 04 LD A,04h +000010F0: 28 05 JR Z,+05h +000010F2: 3E 02 LD A,02h +000010F4: 38 01 JR C,+01h +000010F6: 3D DEC A +000010F7: C1 POP BC +000010F8: A0 AND B +000010F9: 20 03 JR NZ,+03h + +; --- + +;; ZERO +000010FB: F7 RST 30h ; FP-CALC +000010FC: FA ;;stk-zero & end-calc +000010FD: C9 RET + +; --- + +;; ONE +000010FE: F7 RST 30h ; FP-CALC +000010FF: F9 ;;stk-one & end-calc +00001100: C9 RET + + +; delete the Boolean value on the calculator stack. + +00001101: F7 RST 30h ; FP-CALC +00001102: 1E ;;subtract +00001102: B5 ;;delete & end-calc + +00001104: EB EX DE,HL +00001105: 23 INC HL +00001106: CB 16 RL (HL) +00001108: 2B DEC HL +00001109: 34 INC (HL) +0000110A: 35 DEC (HL) +0000110B: 18 E1 JR -1Fh + +0000110D: CB B1 RES 6,C +0000110F: CD F0 0D CALL 0DF0h ; routine STK-VAR +00001112: C3 3E 0A JP 0A3Eh ; routine CHECK-2 + +00001115: CD A6 0A CALL 0AA6h ; routine LOOK-VARS +00001118: 20 2C JR NZ,+2Ch +0000111A: EF RST 28h ; routine SYNTAX-Z +0000111B: 28 F0 JR Z,-10h + +0000111D: C5 PUSH BC +0000111E: D4 6A 01 CALL NC,016Ah +00001121: 11 05 00 LD DE,0005h +00001124: C1 POP BC +00001125: 42 LD B,D +00001126: CB F9 SET 7,C +00001128: CB 71 BIT 6,C +0000112A: C5 PUSH BC +0000112B: 28 02 JR Z,+02h +0000112D: 1E 01 LD E,01h +0000112F: CF RST 08h ; NEXT-CHAR +00001130: 26 80 LD H,80h +00001132: CD 1F 0E CALL 0E1Fh +00001135: E1 POP HL +00001136: 24 INC H +00001137: C5 PUSH BC +00001138: E5 PUSH HL +00001139: 69 LD L,C +0000113A: 60 LD H,B +0000113B: CD A5 13 CALL 13A5h +0000113E: EB EX DE,HL +0000113F: D7 RST 10h ; GET-CHAR +00001140: FE 1A CP 1Ah +00001142: 28 EB JR Z,-15h + +00001144: EE 11 XOR 11h +00001146: C2 42 0A JP NZ,0A42h ; to REPORT-C + +00001149: C1 POP BC +0000114A: D5 PUSH DE +0000114B: C5 PUSH BC +0000114C: 67 LD H,A +0000114D: 68 LD L,B +0000114E: 23 INC HL +0000114F: 23 INC HL +00001150: 29 ADD HL,HL +00001151: 19 ADD HL,DE +00001152: DA 08 14 JP C,1408h +00001155: 79 LD A,C +00001156: 4D LD C,L +00001157: 44 LD B,H +00001158: 2A 14 40 LD HL,(4014h) ; E_LINE +0000115B: 2B DEC HL +0000115C: C5 PUSH BC +0000115D: CD B5 1C CALL 1CB5h ; MAKE-ROOM +00001160: C1 POP BC +00001161: 23 INC HL +00001162: 0B DEC BC +00001163: 77 LD (HL),A +00001164: 0B DEC BC +00001165: 23 INC HL +00001166: 0B DEC BC +00001167: 71 LD (HL),C +00001168: 23 INC HL +00001169: 70 LD (HL),B +0000116A: 23 INC HL +0000116B: F1 POP AF +0000116C: 77 LD (HL),A +0000116D: C1 POP BC +0000116E: 6B LD L,E +0000116F: 62 LD H,D +00001170: 36 00 LD (HL),00h +00001172: 1B DEC DE +00001173: ED B8 LDDR +00001175: 47 LD B,A +00001176: D1 POP DE +00001177: 72 LD (HL),D +00001178: 2B DEC HL +00001179: 73 LD (HL),E +0000117A: 2B DEC HL +0000117B: 10 F9 DJNZ -07h +0000117D: C9 RET + + +;---------------------- +; THE 'COSINE' FUNCTION +;---------------------- +; (offset $$$: 'cos') +; Cosines are calculated as the sine of the opposite angle rectifying the +; sign depending on the quadrant rules. +; +; +; /| +; h /y| +; / |o +; /x | +; /----| +; a +; +; The cosine of angle x is the adjacent side (a) divided by the hypotenuse 1. +; However if we examine angle y then a/h is the sine of that angle. +; Since angle x plus angle y equals a right-angle, we can find angle y by +; subtracting angle x from pi/2. +; However it's just as easy to reduce the argument first and subtract the +; reduced argument from the value 1 (a reduced right-angle). +; It's even easier to subtract 1 from the angle and rectify the sign. +; In fact, after reducing the argument, the absolute value of the argument +; is used and rectified using the test result stored in mem-0 by 'get-argt' +; for that purpose. + +;; cos +0000117E: F7 RST 30h ; FP-CALC angle in radians. +0000117F: 07 ;;get-argt +00001180: 18 ;;abs +00001180: 79 ;;stk-one +00001182: 1E ;;subtract +00001183: 40 ;;get-mem-0 +00001184: 34 ;;jump-true +00001185: 06 ;;fwd to C-ENT +00001186: 09 ;;negate +00001187: 04 ;;jump +00001188: 03 ;;fwd to C-ENT + + +;-------------------- +; THE 'SINE' FUNCTION +;-------------------- +; (offset $??: 'sin') +; This is a fundamental transcendental function from which others such as cos +; and tan are directly, or indirectly, derived. +; It uses the series generator to produce Chebyshev polynomials. +; +; +; /| +; 1 / | +; / |x +; /a | +; /----| +; y +; +; The 'get-argt' function is designed to modify the angle and its sign +; in line with the desired sine value and afterwards it can launch straight +; into common code. + +;; sin +00001189: F7 RST 30h ; angle in radians +0000118A: 07 ;;get-argt reduce - sign now correct. +;; C-ENT +0000118B: 01 ;;duplicate +0000118C: 01 ;;duplicate +0000118D: 1F ;;multiply +0000118F: 01 ;;duplicate +0000118F: 2A ;;addition +00001190: 79 ;;stk-one +00001191: 1E ;;subtract + +00001192: 66 ;;series-06 +00001193: 14 ;;Exponent: $64, Bytes: 1 +00001194: E6 ;;(+00,+00,+00) +00001195: 5C ;;Exponent: $6C, Bytes: 2 +00001196: 1F 0B ;;(+00,+00) +00001198: A3 ;;Exponent: $73, Bytes: 3 +00001199: 8F 38 EE ;;(+00) +0000119C: E9 ;;Exponent: $79, Bytes: 4 +0000119D: 15 63 BB 23 +000011A1: EE ;;Exponent: $7E, Bytes: 4 +000011A2: 92 0D CD ED +000011A6: F1 ;;Exponent: $81, Bytes: 4 +000011A7: 23 5D 1B EA +000011AB: 9F ;;multiply & end-calc +000011AC: C9 RET + + +;; PLOT +000011AD: CD D9 14 CALL 14D9h ; PLOT/UNP +000011B0: B2 OR D + +000011B1: FE 08 CP 08h +000011B3: 38 02 JR C,+02h + +000011B5: EE 8F XOR 8Fh + +;; PLOT-END +000011B7: DF RST 18h ; PRINT-A +000011B8: C9 RET + +;; UNPLOT +000011B9: CD D9 14 CALL 14D9h ; PLOT/UNP +000011BC: 2F CPL +000011BD: B2 OR D +000011BE: 2F CPL +000011BF: 18 F0 JR -10h ; to UNPLOT + +; ------------------------------------------ +; THE 'DECIMAL TO FLOATING POINT' SUBROUTINE +; ------------------------------------------ +; + +;; DEC-TO-FP +000011C1: CD 44 1C CALL 1C44h ; routine INT-TO-FP +000011C4: FE 1B CP 1Bh ; is character a '.' ? +000011C6: 20 13 JR NZ,+13h ; forward if not to E-FORMAT + +000011C8: F7 RST 30h ; FP-CALC +000011C9: 79 ;;stk-one +000011CA: 50 ;;st-mem-0 +000011CB: B5 ;;delete & end-calc +000011CC: 18 07 JR +07h ; forward to NXT-DGT-1 + + +;---------- +; loop back till exhausted from NXT-DGT-1 +000011CE: F7 RST 30h ; FP-CALC +000011CF: 40 ;;get-mem-0 +000011D0: 77 ;;stk-ten +000011D1: 20 ;;division +000011D2: 50 ;;st-mem-0 +000011D3: 1F ;;multiply +000011D4: AA ;;addition & end-calc + +;; NXT-DGT-1 +000011D5: CF RST 08h ; NEXT-CHAR +000011D6: CD 75 07 CALL 0775h ; routine STK-DIGIT +000011D9: 30 F3 JR NC,-0Dh ; loop back till exhausted +;---------- + +;; E-FORMAT +000011DB: EE 2A XOR 2Ah ; is character 'E' ? +000011DD: C0 RET NZ ; return if not + +000011DE: 47 LD B,A ; set B to zero + +000011DF: CF RST 08h ; NEXT-CHAR +000011E0: FE 15 CP 15h ; is character a '+' ? +000011E2: 28 05 JR Z,+05h ; if so, jp to ST-E-POSITIVE + +000011E4: FE 16 CP 16h ; is it a '-' ? +000011E6: 20 02 JR NZ,+02h ; jp if not to ST-E-POSITIVE + +000011E8: 04 INC B ; mark for negative sign + +;; ST-E-POSITIVE +000011E9: CF RST 08h ; NEXT-CHAR + +;; ST-E-PART +000011EA: C5 PUSH BC +000011EB: CD 44 1C CALL 1C44h ; routine INT-TO-FP +000011EE: C1 POP BC +000011EF: 10 02 DJNZ +02h ; jp if not negative + +000011F1: F7 RST 30h ; FP-CALC +000011F2: 09 ;;negate & end-calc + + +; ------------------------------------------- +; THE 'E-FORMAT TO FLOATING POINT' SUBROUTINE +; ------------------------------------------- +; (Offset $??: 'e-to-fp') +; invoked from DEC-TO-FP and PRINT-FP. +; e.g 2.3E4 is 23000. +; This subroutine evaluates xEm where m is a positive or negative integer. +; At a simple level x is multiplied by ten for every unit of m. +; If the decimal exponent m is negative then x is divided by ten for each unit. +; +; On entry in the ZX81, m, the exponent, is the 'last value', and the +; floating-point decimal mantissa is beneath it. + + +;; e-to-fp +000011F3: F7 RST 30h ; FP-CALC +000011F4: 01 ;;duplicate +000011F5: 03 ;;less-0 +000011F6: 50 ;;st-mem-0 +000011F7: 35 ;;delete +000011F8: 18 ;;abs + +;; E-LOOP +000011F9: 79 ;;stk-one +000011FA: 1E ;;subtract +000011FB: 01 ;;duplicate +000011FC: 03 ;;less-0 +000011FD: 34 ;;jump-true +000011FE: 21 ;;... to E-END +000011FF: 01 ;;duplicate +00001200: 05 ;;stk-data +00001201: 33 ;;Exponent: $83, Bytes: 1 +00001202: 20 ;;(+00,+00,+00) ... $40 on ZX81 +00001203: 1E ;;subtract +00001204: 01 ;;duplicate +00001205: 03 ;;less-0 +00001206: 34 ;;jump-true +00001207: 0B ;;... to E-LOW + +00001208: 33 ;;exchange +00001209: 35 ;;delete +0000120A: 33 ;;exchange +0000120B: 05 ;;stk-data +0000120C: 40 ;;Exponent $?? Bytes: 3 +0000120D: 44 74 24 ;;(+00) +00001210: 04 ;;jump +00001211: 04 ;;... to E-CHUNK + +;; E-LOW +00001212: 35 ;;delete +00001213: 33 ;;exchange +00001214: 77 ;;stk-ten + +;; E-CHUNK +00001215: 40 ;;get-mem-0 +00001216: 34 ;;jump-true +00001217: 04 ;;to E-DIVSN + +00001218: 1F ;;multiply +00001219: 04 ;;jump +0000121A: 02 ;;to E-SWAP + +;; E-DIVSN +0000121B: 20 ;;division + +;; E-SWAP +0000121C: 33 ;;exchange +0000121D: 04 ;;jump +0000121E: DB ;;to E-LOOP +0000121F: B5 ;;delete & end-calc + +00001220: C9 RET + + +00001221: CD D4 13 CALL 13D4h ; routine CURSOR-IN +00001224: 21 3B 40 LD HL,403Bh ; CDFLAG +00001227: 22 18 40 LD (4018h),HL ; X_PTR +0000122A: CB 7E BIT 7,(HL) +0000122C: CC B6 12 CALL Z,12B6h +0000122F: CB 46 BIT 0,(HL) +00001231: 28 FC JR Z,-04h +00001233: CD 70 18 CALL 1870h +00001236: 30 EC JR NC,-14h +00001238: FD CB 3B 6E BIT 5,(IY+3Bh) ; CDFLAG +0000123C: 20 1D JR NZ,+1Dh +0000123E: D5 PUSH DE +0000123F: E5 PUSH HL +00001240: CD 62 0D CALL 0D62h ; routine SET-FAST +00001243: C6 14 ADD 14h +00001245: 5F LD E,A +00001246: 01 CE 04 LD BC,04CEh ; 1230 +00001249: FD CB 28 6E BIT 5,(IY+28h) ; MARGIN +0000124D: 20 03 JR NZ,+03h +0000124F: 01 06 04 LD BC,0406h ; 1030 +00001252: CD A2 0B CALL 0BA2h ; SOUND-ENGINE (play value in E, length BC) +00001255: CD A9 12 CALL 12A9h ; routine SLOW/FAST +00001258: E1 POP HL +00001259: D1 POP DE +0000125A: 7B LD A,E +0000125B: FD CB 3B 66 BIT 4,(IY+3Bh) ; CDFLAG +0000125F: 28 08 JR Z,+08h +00001261: FE 28 CP 28h +00001263: 38 10 JR C,+10h +00001265: 21 6F 10 LD HL,106Fh +00001268: 19 ADD HL,DE +00001269: 7E LD A,(HL) +0000126A: FE F0 CP F0h +0000126C: EA B8 06 JP PE,06B8h +0000126F: CD 96 03 CALL 0396h +00001272: C3 04 10 JP 1004h ; to LOWER + +00001275: 7E LD A,(HL) +00001276: FE 76 CP 76h +00001278: CB FF SET 7,A +0000127A: 20 F3 JR NZ,-0Dh + +0000127C: FD CB 3B A6 RES 4,(IY+3Bh) ; CDFLAG +00001280: 18 F0 JR -10h + +00001282: FD CB 3B E6 SET 4,(IY+3Bh) ; CDFLAG +00001286: 18 EA JR -16h + +;------------------------ +; Handle unary minus +;------------------------ +; Unary so on entry HL points to last value, DE to STKEND. + +;; negate +00001288: 7E LD A,(HL) ; fetch exponent of last value on the calculator stack +00001289: B7 OR A ; test it. +0000128A: C8 RET Z ; return if zero. + +0000128B: 23 INC HL ; address the byte with the sign bit. +0000128C: 3E 80 LD A,80h +0000128E: AE XOR (HL) ; toggle the sign bit. +0000128F: 77 LD (HL),A ; put it back. +00001290: 2B DEC HL ; point to last value again. +00001291: C9 RET + +;; INC HL, LINE-ADDR, AND LINE-NO +00001292: 23 INC HL +00001293: CD 36 0B CALL 0B36h ; routine LINE-ADDR (HL) +;; LINE-NO +00001296: 3E C0 LD A,C0h +00001298: A6 AND (HL) +00001299: 28 06 JR Z,+06h ; to ZERO-DE +0000129B: 21 A9 13 LD HL,13A9h +0000129E: EB EX DE,HL +0000129F: 18 F7 JR -09h +;; ZERO-DE +000012A1: 56 LD D,(HL) +000012A2: 23 INC HL +000012A3: 5E LD E,(HL) +000012A4: C9 RET +; +;; SLOW MODE +000012A5: FD CB 3B F6 SET 6,(IY+3Bh) ; CDFLAG + +;; SLOW/FAST (L0207 on ZX81) +000012A9: 21 3B 40 LD HL,403Bh ; system variable CDFLAG +000012AC: 7E LD A,(HL) +000012AD: 07 RLCA +000012AE: AE XOR (HL) +000012AF: F0 RET P +000012B0: CB FE SET 7,(HL) +000012B2: F5 PUSH AF +000012B3: E5 PUSH HL +000012B4: D5 PUSH DE +000012B5: C5 PUSH BC +000012B6: AF XOR A +000012B7: 08 EX AF,AF' +000012B8: D3 FE OUTA (FEh) ; enable the NMI generator. +000012BA: 76 HALT +000012BB: D3 FD OUTA (FDh) ; turn off the NMI generator. +000012BD: 23 INC HL +000012BE: 23 INC HL +000012BF: 23 INC HL + +;; DISPLAY-1 +000012C0: 2A 34 40 LD HL,(4034h) ; FRAMES +000012C3: 7C LD A,H +000012C4: E6 7F AND 7Fh +000012C6: B5 OR L +000012C7: 7C LD A,H +000012C8: 20 03 JR NZ,+03h ; to ANOTHER +000012CA: 17 RLA +000012CB: 18 03 JR +03h ; to OVER-NC + +; --- + +;; ANOTHER +000012CD: 37 SCF +000012CE: 0E 00 LD C,00h + +;; OVER-NC +000012D0: 67 LD H,A +000012D1: 2B DEC HL +000012D2: 22 34 40 LD (4034h),HL ; FRAMES +000012D5: D0 RET NC +000012D6: 7D LD A,L +000012D7: 2A 7B 40 LD HL,(407Bh) ; BLINK +000012DA: CB 26 SLA (HL) +000012DC: 17 RLA +000012DD: 17 RLA +000012DE: 17 RLA +000012DF: 17 RLA +000012E0: CB 1E RR (HL) + +;; DISPLAY-2 +000012E2: CD 74 0D CALL 0D74h ; routine KEYBOARD +000012E5: ED 4B 25 40 LD BC,(4025h) ; LAST_K +000012E9: 22 25 40 LD (4025h),HL ; LAST_K +000012EC: 50 LD D,B +000012ED: 3E 02 LD A,02h +000012EF: 80 ADD B +000012F0: ED 42 SBC HL,BC +000012F2: 06 09 LD B,09h +000012F4: 3A 27 40 LD A,(4027h) ; DEBOUNCE +000012F7: B5 OR L +000012F8: B4 OR H +000012F9: 21 3B 40 LD HL,403Bh ; CDFLAG +000012FC: CB 86 RES 0,(HL) +000012FE: 20 08 JR NZ,+08h ; to NO-KEY +00001300: CB C6 SET 0,(HL) +00001302: CB 7E BIT 7,(HL) +00001304: C8 RET Z +00001305: 05 DEC B +00001306: 05 DEC B +00001307: 37 SCF + +;; NO-KEY +00001308: CB 10 RL B +0000130A: 10 FE DJNZ -02h +0000130C: 7A LD A,D +0000130D: FE FE CP FEh +0000130F: 9F SBC A +00001310: 21 27 40 LD HL,4027h ; DEBOUNCE +00001313: B6 OR (HL) +00001314: E6 0F AND 0Fh +00001316: 1F RRA +00001317: 77 LD (HL),A +00001318: 29 ADD HL,HL +00001319: 29 ADD HL,HL +0000131A: 23 INC HL +0000131B: D3 FF OUTA (FFh) ; terminate retrace +0000131D: 21 7D C0 LD HL,C07Dh ; point to upper 32K 'display file' ghosted copy +00001320: CD ED 01 CALL 01EDh ; routine DISPLAY-3 +; --- + +;; R-IX-1, on ZX81 it is the "famous" 0281h location +00001323: 01 19 01 LD BC,0119h ; on ZX81 C and B are inverted +00001326: 3A 00 00 LD A,(0000h) ; on ZX81.. LD A,R +00001329: 3E F5 LD A,F5h +0000132B: CD 66 16 CALL 1666h ; routine DISPLAY-5 +0000132E: 00 NOP +0000132F: 00 NOP +00001330: 2B DEC HL +00001331: CD ED 01 CALL 01EDh ; routine DISPLAY-3 +; --- + +;; R-IX-2, on ZX81 it is the "famous" 028Fh location +00001334: C3 C0 12 JP 12C0h ; to DISPLAY-1 + + +;------------------------- +; THE 'SLICING' SUBROUTINE +;------------------------- +; +; + +;; SLICING +00001337: EF RST 28h ; routine SYNTAX-Z +00001338: 28 01 JR Z,+01h +0000133A: E7 RST 20h ; STK-FETCH +0000133B: CF RST 08h ; NEXT-CHAR +0000133C: FE 11 CP 11h ; is it ')' ? +0000133E: 28 3B JR Z,+3Bh ; forward if so to SL-STORE + +00001340: 60 LD H,B +00001341: 69 LD L,C +00001342: D5 PUSH DE +00001343: 11 01 00 LD DE,0001h +00001346: E5 PUSH HL +00001347: EE 41 XOR 41h +00001349: 28 0A JR Z,+0Ah + +0000134B: CD 1F 0E CALL 0E1Fh +0000134E: 59 LD E,C +0000134F: 50 LD D,B +00001350: D7 RST 10h ; GET-CHAR +00001351: FE 41 CP 41h ; is it 'TO' ? +00001353: 20 0B JR NZ,+0Bh + +00001355: CF RST 08h ; NEXT-CHAR +00001356: EE 11 XOR 11h +00001358: E1 POP HL +00001359: 28 0D JR Z,+0Dh + +0000135B: CD 1F 0E CALL 0E1Fh +0000135E: D7 RST 10h ; GET-CHAR +0000135F: FE E1 CP E1h ; is it 'LPRINT' ? (???) +00001361: EE 11 XOR 11h +00001363: C2 42 0A JP NZ,0A42h ; to REPORT-C + +00001366: 69 LD L,C +00001367: 60 LD H,B +00001368: FD CB 1E B6 RES 6,(IY+1Eh) ; BREG/FLAGS +0000136C: AF XOR A +0000136D: ED 52 SBC HL,DE +0000136F: 4D LD C,L +00001370: 44 LD B,H +00001371: 03 INC BC +00001372: 30 03 JR NC,+03h +00001374: 01 00 00 LD BC,0000h +00001377: E1 POP HL +00001378: 19 ADD HL,DE +00001379: EB EX DE,HL +0000137A: 1B DEC DE +0000137B: EF RST 28h ; routine SYNTAX-Z +0000137C: C8 RET Z + +;; STK-ST-0 +0000137D: AF XOR A +0000137E: 18 3C JR +3Ch + +;------------------------------- +; THE 'E-LINE NUMBER' SUBROUTINE +;------------------------------- +; +; + +;; E-LINE-NO +00001380: 2A 14 40 LD HL,(4014h) ; E_LINE +00001383: CD 0D 00 CALL 000Dh ; TEMP-PTR2 + GET-CHAR +00001386: FD CB 2D 6E BIT 5,(IY+2Dh) ; FLAGX +0000138A: C0 RET NZ +0000138B: 21 5D 40 LD HL,405Dh ; MEMBOT +0000138E: 22 1C 40 LD (401Ch),HL ; STKEND low +00001391: CD 44 1C CALL 1C44h ; routine INT-TO-FP +00001394: CD 55 05 CALL 0555h ; routine FP-TO-BC +00001397: 21 F0 D8 LD HL,D8F0h ; value '-10000' +0000139A: DA 42 0A JP C,0A42h ; to REPORT-C + +0000139D: 09 ADD HL,BC +0000139E: 38 FA JR C,-06h +000013A0: BF CP A +000013A1: 18 77 JR +77h + +; -------------------------- +; THE 'GET-HL*DE' SUBROUTINE +; -------------------------- +; + +;; GET-HL*DE +000013A3: EF RST 28h ; routine SYNTAX-Z +000013A4: C8 RET Z +000013A5: 7D LD A,L +000013A6: C5 PUSH BC +000013A7: 4C LD C,H +; HL-LOOP +L000013A8: 21 00 00 LD HL,0000h +000013AB: 06 10 LD B,10h +000013AD: 29 ADD HL,HL +000013AE: 38 58 JR C,+58h +000013B0: 17 RLA +000013B1: CB 11 RL C +000013B3: 30 03 JR NC,+03h +000013B5: 19 ADD HL,DE +;; HL-END +000013B6: 38 50 JR C,+50h +;; HL-AGAIN +000013B8: 10 F3 DJNZ -0Dh +000013BA: C1 POP BC +000013BB: C9 RET + +;--------------------------- +; THE 'STK-STORE' SUBROUTINE +;--------------------------- + +;; STK-STO-$ +000013BC: 2A 1C 40 LD HL,(401Ch) ; STKEND +000013BF: C5 PUSH BC +000013C0: CD F2 13 CALL 13F2h ; routine TEST-5-SP +000013C3: FD CB 1E B6 RES 6,(IY+1Eh) ; BREG/FLAGS +000013C7: 77 LD (HL),A +000013C8: 23 INC HL +000013C9: 73 LD (HL),E +000013CA: 23 INC HL +000013CB: 72 LD (HL),D +000013CC: 23 INC HL +000013CD: C1 POP BC +000013CE: 71 LD (HL),C +000013CF: 23 INC HL +000013D0: 70 LD (HL),B +000013D1: 23 INC HL +000013D2: 18 59 JR +59h + +;------------------------ +; THE 'CURSOR-IN' ROUTINE +;------------------------ +; This routine is called to set the edit line to the minimum cursor/newline +; and to set STKEND, the start of free space, at the next position. + +;; CURSOR-IN +000013D4: FD 36 22 02 LD (IY+22h),02h ; DF_SZ +000013D8: 2A 14 40 LD HL,(4014h) ; E_LINE +000013DB: 36 7F LD (HL),7Fh +000013DD: 23 INC HL +000013DE: 36 76 LD (HL),76h +000013E0: 23 INC HL + + +;----------------------- +; THE 'SET-STK' ROUTINES +;----------------------- +; +; + +;; SET-STK-B +000013E1: 22 1A 40 LD (401Ah),HL ; STKBOT +000013E4: 18 47 JR +47h ; to SET-STK-E + + +;---------------------------- +; THE 'GO SUB' COMMAND ROUTINE +;---------------------------- +; +; + +;; GOSUB +000013E6: CD 2B 15 CALL 152Bh ; GOTO +000013E9: 2A 36 40 LD HL,(4036h) ; LAMBDA-VAR +000013EC: E3 EX HL,(SP) +000013ED: E5 PUSH HL +000013EE: ED 73 02 40 LD (4002h),SP ; ERR-SP + +;------------------------------- +; THE 'TEST 5 SPACES' SUBROUTINE +;------------------------------- +; This routine is called from MOVE-FP, STK-CONST and STK-STORE to +; test that there is enough space between the calculator stack and the +; machine stack for another five-byte value. It returns with BC holding +; the value 5 ready for any subsequent LDIR. + +;; TEST-5-SP +000013F2: 01 05 00 LD BC,0005h + +;; TEST-ROOM +000013F5: E5 PUSH HL +000013F6: 2A 1C 40 LD HL,(401Ch) ; STKEND +000013F9: 09 ADD HL,BC +000013FA: 38 0C JR C,+0Ch +000013FC: C5 PUSH BC +000013FD: 01 20 00 LD BC,0020h +00001400: 09 ADD HL,BC +00001401: 38 05 JR C,+05h +00001403: C1 POP BC +00001404: ED 72 SBC HL,SP +00001406: E1 POP HL +00001407: D8 RET C + +00001408: 3E 03 LD A,03h +0000140A: 01 3E 00 LD BC,003Eh + +0000140B: 3E 00 LD A,00h ; reusing the same bytes above: this line disappears if entry is 1408h +0000140D: 01 3E 02 LD BC,023Eh + +;--------------------- +; THE 'ERROR-2' BRANCH +;--------------------- +; This is a continuation of the error restart. +; If the error occured in runtime then the error stack pointer will probably +; lead to an error report being printed unless it occured during input. +; If the error occured when checking syntax then the error stack pointer +; will be an editing routine and the position of the error will be shown +; when the lower screen is reprinted. + +;; ERROR-2 +00001410: ED 7B 02 40 LD SP,(4002h) ; set the stack pointer from ERR_SP +00001414: 32 07 40 LD (4007h),A ; PPC low / ERR NR +00001417: CD A9 12 CALL 12A9h ; routine SLOW/FAST selects slow mode. +; ..exit continuing via routine SET-MIN. + + +;------------------------- +; THE 'SET-MIN' SUBROUTINE +;------------------------- +; +; + +;; SET-MIN +0000141A: 21 5D 40 LD HL,405Dh ; MEMBOT +0000141D: 22 1F 40 LD (401Fh),HL ; MEM +00001420: 2A 1A 40 LD HL,(401Ah) ; STKBOT +00001423: 18 08 JR +08h + + +;; STK-FETCH (cont) +00001425: 2B DEC HL +00001426: 4E LD C,(HL) +00001427: 2B DEC HL +00001428: 56 LD D,(HL) +00001429: 2B DEC HL +0000142A: 5E LD E,(HL) +0000142B: 2B DEC HL +0000142C: 7E LD A,(HL) + +;; SET-STK-E +0000142D: 22 1C 40 LD (401Ch),HL ; STKEND +00001430: C9 RET + +;-------------------------- +; THE 'RUN' COMMAND ROUTINE +;-------------------------- +; +; + +;; RUN +00001431: CD 2B 15 CALL 152Bh ; GOTO +00001434: 18 06 JR +06h + +;; Init PROGRAM and VARS and CLEAR (called while booting, HL points to PROGRAM) +00001436: 36 FF LD (HL),FFh +00001438: 23 INC HL +00001439: 22 10 40 LD (4010h),HL ; VARS + +;---------------------------- +; THE 'CLEAR' COMMAND ROUTINE +;---------------------------- +; +; + +;; CLEAR +0000143C: 2A 10 40 LD HL,(4010h) ; VARS +0000143F: 36 80 LD (HL),80h +00001441: 23 INC HL +00001442: 22 14 40 LD (4014h),HL ; E_LINE + +;------------------------ +; THE 'X-TEMP' SUBROUTINE +;------------------------ +; +; + +;; X-TEMP +00001445: 2A 14 40 LD HL,(4014h) ; E_LINE +00001448: 18 97 JR -69h ; SET-STK-B + + +;-------------------- +; THE 'ERROR' RESTART +;-------------------- +; The error restart deals immediately with an error. ZX computers execute the +; same code in runtime as when checking syntax. If the error occured while +; running a program then a brief report is produced. If the error occured +; while entering a BASIC line or in input etc., then the error marker indicates +; the exact point at which the error lies. + +;; ERROR-1 +0000144A: E1 POP HL +0000144B: 7E LD A,(HL) +0000144C: 2A 16 40 LD HL,(4016h) ; CH_ADD +0000144F: 22 18 40 LD (4018h),HL ; X_PTR +00001452: 18 BC JR -44h + +;--------------------------- +; THE 'LINE-ENDS' SUBROUTINE +;--------------------------- +; +; + +;; LINE-ENDS +00001454: FD 46 22 LD B,(IY+22h) ; DF_SZ +00001457: C5 PUSH BC +00001458: CD 7F 1C CALL 1C7Fh ; routine B-LINES (partial CLS) +0000145B: C1 POP BC +0000145C: 18 32 JR +32h + +0000145E: 05 DEC B +0000145F: 0E 21 LD C,21h +00001461: 23 INC HL +00001462: 18 08 JR +08h + +00001464: ED 4B 39 40 LD BC,(4039h) ; S_POSN_x +00001468: 2A 0E 40 LD HL,(400Eh) ; DF_CC +0000146B: 5F LD E,A +0000146C: 78 LD A,B +0000146D: B7 OR A +0000146E: 28 9E JR Z,-62h +00001470: FD BE 22 CP (IY+22h) ; DF_SZ +00001473: 28 99 JR Z,-67h +00001475: 7B LD A,E +00001476: FE 76 CP 76h +00001478: 28 16 JR Z,+16h +0000147A: 0D DEC C +0000147B: 28 E1 JR Z,-1Fh +0000147D: 77 LD (HL),A +0000147E: 23 INC HL +0000147F: ED 43 39 40 LD (4039h),BC ; S_POSN_x +00001483: 22 0E 40 LD (400Eh),HL ; DF_CC +00001486: F8 RET M +00001487: 7C LD A,H +00001488: D6 20 SUB 20h +0000148A: 67 LD H,A +0000148B: 3A 08 40 LD A,(4008h) ; ATTR-P +0000148E: 77 LD (HL),A +0000148F: C9 RET + +; LOC-ADDR for next row +00001490: 05 DEC B +; LOC-ADDR for current row +00001491: 0E 21 LD C,21h ; 33 + +;----------------------------- +; THE 'LOCATE ADDRESS' ROUTINE +;----------------------------- +; +; + +;; LOC-ADDR +00001493: ED 43 39 40 LD (4039h),BC ; S_POSN_x + +;; TEST-LOW +00001497: 3E 21 LD A,21h +00001499: 91 SUB C +0000149A: 4F LD C,A +0000149B: 3E 18 LD A,18h +0000149D: 90 SUB B +0000149E: 6F LD L,A +0000149F: 26 00 LD H,00h +000014A1: 06 05 LD B,05h +000014A3: 29 ADD HL,HL +000014A4: 10 FD DJNZ -03h +000014A6: 09 ADD HL,BC +000014A7: 4F LD C,A +000014A8: 09 ADD HL,BC +000014A9: 01 7E 40 LD BC,407Eh ; D-FILE + 1 +000014AC: 09 ADD HL,BC +000014AD: FD CB 1E 86 RES 0,(IY+1Eh) ; BREG/FLAGS +000014B1: 22 0E 40 LD (400Eh),HL ; DF_CC +000014B4: C9 RET + +;-------------------------- +; THE 'PRINT AT' SUBROUTINE +;-------------------------- +; +; +;; STK and PRINT-AT +000014B5: CD 10 02 CALL 0210h ; routine STK-TO-BC + +;; PRINT-AT +000014B8: 3E 17 LD A,17h +000014BA: 90 SUB B +000014BB: 38 48 JR C,+48h +000014BD: FD BE 22 CP (IY+22h) ; DF_SZ +000014C0: 47 LD B,A +000014C1: 04 INC B +000014C2: DA 0E 14 JP C,140Eh +000014C5: 79 LD A,C +000014C6: FE 20 CP 20h +000014C8: 30 3B JR NC,+3Bh +000014CA: C6 3C ADD 3Ch +000014CC: FD CB 1E 4E BIT 1,(IY+1Eh) ; BREG/FLAGS +000014D0: C2 64 1D JP NZ,1D64h +000014D3: 2F CPL +000014D4: C6 5E ADD 5Eh +000014D6: 4F LD C,A +000014D7: 18 BA JR -46h ; to TEST-LOW -4 + + +;--------------------------------------- +; THE 'PLOT AND UNPLOT' COMMAND ROUTINES +;--------------------------------------- +; +; + +;; PLOT/UNP +000014D9: CD 10 02 CALL 0210h ; routine STK-TO-BC +000014DC: 3E 2B LD A,2Bh +000014DE: 90 SUB B +000014DF: 47 LD B,A +000014E0: 38 23 JR C,+23h ; to REPORT-B + +000014E2: 16 08 LD D,08h +000014E4: CB 38 SRL B +000014E6: 38 02 JR C,+02h +000014E8: 16 02 LD D,02h +000014EA: CB 39 SRL C +000014EC: 38 02 JR C,+02h +000014EE: CB 3A SRL D +000014F0: CD B8 14 CALL 14B8h ; PRINT-AT +000014F3: 7E LD A,(HL) +000014F4: 07 RLCA +000014F5: FE 10 CP 10h +000014F7: 38 01 JR C,+01h +000014F9: AF XOR A +000014FA: 0F RRCA +000014FB: D0 RET NC +000014FC: EE 8F XOR 8Fh +000014FE: C9 RET + +;---------------------------- +; THE 'STACK-TO-A' SUBROUTINE +;---------------------------- +; +; + +;; STK-TO-A +000014FF: CD 49 05 CALL 0549h ; FP-TO-A +00001502: 38 01 JR C,+01h +00001504: C8 RET Z + +;; REPORT-B (or equivalent error msg) +00001505: CD 4A 14 CALL 144Ah ; ERROR-1 +00001508: 0A ; "IE" - Invalid Expression + +;; FIND-INT +00001509: CD 55 05 CALL 0555h ; routine FP-TO-BC +0000150C: 18 F4 JR -0Ch + +;--------------------------- +; THE 'CONT' COMMAND ROUTINE +;--------------------------- +; Another abbreviated command. ROM space was really tight. +; CONTINUE at the line number that was set when break was pressed. +; Sometimes the current line, sometimes the next line. + +;; CONT +0000150E: 2A 2B 40 LD HL,(402Bh) ; OLDPPC + +;; GOTO-2 +00001511: 3E 27 LD A,27h ; <- continued from GOTO +00001513: BC CP H +00001514: 38 EF JR C,-11h ; to REPORT-B +00001516: CD 36 0B CALL 0B36h ; routine LINE-ADDR (HL) +00001519: 22 0A 40 LD (400Ah),HL ; NXTLIN (<> ZX81) +0000151C: C9 RET + +;----------------------------- +; THE 'RETURN' COMMAND ROUTINE +;----------------------------- +; + +;; RETURN +0000151D: 3E AA LD A,AAh +0000151F: E1 POP HL +00001520: E3 EX HL,(SP) +00001521: BC CP H +00001522: 28 0E JR Z,+0Eh +00001524: ED 73 02 40 LD (4002h),SP ; ERR-SP +00001528: 23 INC HL +00001529: 18 E6 JR -1Ah + +;--------------------------- +; THE 'GOTO' COMMAND ROUTINE +;--------------------------- +; +; + +;; GOTO +0000152B: CD 09 15 CALL 1509h ; FIND-INT +0000152E: 69 LD L,C +0000152F: 60 LD H,B +00001530: 18 DF JR -21h + + +;; REPORT-7 +00001532: E3 EX HL,(SP) +00001533: E5 PUSH HL +00001534: CD 4A 14 CALL 144Ah ; ERROR-1 +00001537: 06 ; "RG" - RETURN without GOSUB + +;; NAME +00001538: CD 6F 0D CALL 0D6Fh ; GET-INT & SET-FAST +0000153B: 0D DEC C +0000153C: 37 SCF +0000153D: F8 RET M +0000153E: 09 ADD HL,BC +0000153F: CB FE SET 7,(HL) +00001541: C9 RET + +;; from PRINT-STK +00001542: E7 RST 20h ; STK-FETCH +;; PR-STR-3 +;; PR-STR-4 +00001543: 79 LD A,C +00001544: B0 OR B +00001545: C8 RET Z +00001546: 1A LD A,(DE) +00001547: 0B DEC BC +00001548: 13 INC DE +00001549: C5 PUSH BC +0000154A: CD 52 04 CALL 0452h ; routine TOKENS +0000154D: C1 POP BC +0000154E: 18 F3 JR -0Dh ; loop back to PR-STR-3 + +;; PRINT-STK +00001550: CD 7A 09 CALL 097Ah ; routine SYNTAX-Z +00001553: 28 ED JR Z,-13h ; continue above + + + +;----------------------------------------------- +; THE 'PRINT A FLOATING-POINT NUMBER' SUBROUTINE +;----------------------------------------------- +; prints 'last value' x on calculator stack. +; There are a wide variety of formats see Chapter 4. +; e.g. +; PI prints as 3.1415927 +; .123 prints as 0.123 +; .0123 prints as .0123 +; 999999999999 prints as 1000000000000 +; 9876543210123 prints as 9876543200000 + +; Begin by isolating zero and just printing the '0' character +; for that case. For negative numbers print a leading '-' and +; then form the absolute value of x. + +;; PRINT-FP +00001555: F7 RST 30h ; FP-CALC +00001556: 00 ;;end-calc + +00001557: 7E LD A,(HL) +00001558: B7 OR A ; test for zero +00001559: 20 06 JR NZ,+06h + +0000155B: F7 RST 30h ; FP-CALC +0000155C: B5 B5 ;;delete & end-calc + +0000155E: 3E 1C LD A,1Ch ; '0' +0000155F: DF RST 18h ; PRINT-A +00001560: C9 RET + +00001561: 23 INC HL +00001562: CB 7E BIT 7,(HL) ; check for sign bit +00001564: CB BE RES 7,(HL) ; and reset it +00001566: 3E 16 LD A,16h ; '-' +00001568: C4 B4 04 CALL NZ,04B4h ; PRINT-A -> print 'minus' symbol if negative +0000156B: 2B DEC HL +0000156C: 7E LD A,(HL) +0000156D: CD 79 07 CALL 0779h ; STACK-A + +00001570: F7 RST 30h ; FP-CALC +00001571: 05 ;;stk-data +00001572: 78 ;;Exponent: $88, Bytes: 2 +00001573: 80 80 ;;(+00,+00) x, e, -128.5 +00001575: 2A ;;addition x, e -.5 +00001576: 05 ;;stk-data +00001577: EF ;;Exponent: $7F, Bytes: 4 +00001578: 1A 20 9A 85 ;.30103 (log10 2) +0000157C: 1F ;;multiply x, +0000157D: 15 ;;int +0000157E: 55 ;;st-mem-1 x, n. +0000157F: 05 DEC B +00001580: 34 INC (HL) +00001581: 80 ADD B +00001582: 2A 09 08 LD HL,(0809h) +00001585: 75 LD (HL),L +00001586: 2A 95 21 LD HL,(2195h) +00001589: 71 LD (HL),C +0000158A: 40 LD B,B +0000158B: 36 00 LD (HL),00h +0000158D: 2B DEC HL + +0000158E: 06 0A LD B,0Ah +00001590: C5 PUSH BC +00001591: E5 PUSH HL +00001592: F7 RST 30h ; FP-CALC +00001593: 77 ;;stk-ten +00001594: 06 B3 LD B,B3h +00001596: CD 49 05 CALL 0549h ; FP-TO-A +00001599: E1 POP HL +0000159A: 77 LD (HL),A +0000159B: 2B DEC HL +0000159C: C1 POP BC +0000159D: 10 F1 DJNZ -0Fh +0000159F: E5 PUSH HL +000015A0: 23 INC HL +000015A1: 7E LD A,(HL) +000015A2: A7 AND A +000015A3: 28 FB JR Z,-05h +000015A5: 01 08 00 LD BC,0008h +000015A8: 09 ADD HL,BC +000015A9: 7E LD A,(HL) +000015AA: FE 05 CP 05h +000015AC: E5 PUSH HL +000015AD: 36 80 LD (HL),80h +000015AF: 2B DEC HL +000015B0: 7E LD A,(HL) +000015B1: 38 07 JR C,+07h +000015B3: 3C INC A +000015B4: FE 0A CP 0Ah +000015B6: 38 01 JR C,+01h +000015B8: AF XOR A +000015B9: 77 LD (HL),A +000015BA: 3C INC A +000015BB: 3D DEC A +000015BC: 28 EF JR Z,-11h +000015BE: E1 POP HL +000015BF: 06 06 LD B,06h +000015C1: 36 80 LD (HL),80h +000015C3: 23 INC HL +000015C4: 10 FB DJNZ -05h +000015C6: F7 RST 30h ; FP-CALC +000015C7: 35 DEC (HL) +000015C8: C5 PUSH BC +000015C9: CD 49 05 CALL 0549h ; FP-TO-A +000015CC: 28 02 JR Z,+02h +000015CE: ED 44 NEG +000015D0: 3C INC A +000015D1: 3C INC A +000015D2: E1 POP HL +000015D3: 57 LD D,A +000015D4: 23 INC HL +000015D5: 15 DEC D +000015D6: 7E LD A,(HL) +000015D7: A7 AND A +000015D8: 28 FA JR Z,-06h +000015DA: 7A LD A,D +000015DB: FE FB CP FBh +000015DD: FA 11 16 JP M,1611h +000015E0: FE 0D CP 0Dh +000015E2: F2 11 16 JP P,1611h +000015E5: 3C INC A +000015E6: 28 17 JR Z,+17h +000015E8: FA 04 16 JP M,1604h +000015EB: 47 LD B,A +000015EC: CD D2 04 CALL 04D2h +000015EF: 10 FB DJNZ -05h +000015F1: CB 7E BIT 7,(HL) +000015F3: C0 RET NZ +000015F4: 3E 1B LD A,1Bh +000015F6: DF RST 18h ; PRINT-A +000015F7: CD D2 04 CALL 04D2h +000015FA: CB 7E BIT 7,(HL) +000015FC: 28 F9 JR Z,-07h +000015FE: C9 RET +000015FF: 3E 1C LD A,1Ch +00001601: DF RST 18h ; PRINT-A +00001602: 18 ED JR -13h +00001604: ED 44 NEG +00001606: 47 LD B,A +00001607: 3E 1B LD A,1Bh +00001609: DF RST 18h ; PRINT-A +0000160A: 3E 1C LD A,1Ch +0000160C: DF RST 18h ; PRINT-A +0000160D: 10 FB DJNZ -05h +0000160F: 18 E6 JR -1Ah +00001611: CD D2 04 CALL 04D2h +00001614: CD F1 15 CALL 15F1h +00001617: 3E 2A LD A,2Ah +00001619: DF RST 18h ; PRINT-A +0000161A: CB 7A BIT 7,D +0000161C: 28 06 JR Z,+06h +0000161E: AF XOR A +0000161F: 92 SUB D +00001620: 57 LD D,A +00001621: 3E 16 LD A,16h +00001623: 01 3E 15 LD BC,153Eh +00001626: DF RST 18h ; PRINT-A +00001627: 7A LD A,D +00001628: 16 FF LD D,FFh +0000162A: D6 0A SUB 0Ah +0000162C: 14 INC D +0000162D: 30 FB JR NC,-05h +0000162F: 5F LD E,A +00001630: 7A LD A,D +00001631: C4 B1 04 CALL NZ,04B1h +00001634: 7B LD A,E +00001635: C6 26 ADD 26h +00001637: DF RST 18h ; PRINT-A +00001638: C9 RET + +00001639: ED 4B 14 40 LD BC,(4014h) ; E_LINE +0000163D: ED 42 SBC HL,BC +0000163F: 09 ADD HL,BC +00001640: 28 08 JR Z,+08h + +00001642: 2B DEC HL +00001643: CB 4B BIT 1,E +00001645: 28 06 JR Z,+06h + +00001647: CD 74 01 CALL 0174h ; routine CLEAR-ONE +0000164A: C3 04 10 JP 1004h ; to LOWER + + + +0000164D: 7E LD A,(HL) +0000164E: 36 7F LD (HL),7Fh +00001650: 23 INC HL +00001651: 77 LD (HL),A +00001652: 18 F6 JR -0Ah + +00001654: 23 INC HL +00001655: 7E LD A,(HL) +00001656: FE 76 CP 76h +00001658: 28 F0 JR Z,-10h +0000165A: 36 7F LD (HL),7Fh +0000165C: 2B DEC HL +0000165D: 18 F2 JR -0Eh + +;; TEMPO +0000165F: CD FF 14 CALL 14FFh ; STK-TO-A +00001662: 32 21 40 LD (4021h),A ; MUNIT (tempo) +00001665: C9 RET + +;; DISPLAY-5 +00001666: ED 4F LD R,A +00001668: 3E DD LD A,DDh +0000166A: FB EI +0000166B: E9 JP (HL) + +;-------------------------- +; THE 'TABLE OF PRIORITIES' +;-------------------------- +; +; + +;; tbl-pri +0000166C: 06 ; '-' +0000166D: 08 ; '*' +0000166E: 08 ; '/' +0000166F: 0A ; '**' +00001670: 02 ; 'OR' +00001671: 03 ; 'AND' +00001672: 05 ; '<=' +00001673: 05 ; '>=' +00001674: 05 ; '<>' +00001675: 05 ; '>' +00001676: 05 ; '<' +00001677: 05 ; '=' +00001678: 06 ; '+' + +0000167A: CD 8A 1B CALL 1B8Ah ; XOR A & routine PREP-M/D +0000167D: DA 23 17 JP C,1723h + + +; ------------------------ +; THE 'DIVISION' OPERATION +; ------------------------ + +; First check for division by zero. + +;; division +00001679: 17 RLA ; THIS IS THE SAME BYTE ALREADY USED BY THE CODE ABOVE !! + ; (it should have the effect of setting 'A' to zero) +00001680: EB EX DE,HL +00001681: CD 8B 1B CALL 1B8Bh ; routine PREP-M/D +00001684: D8 RET C ; return if zero, 0/anything is zero. + +00001685: D9 EXX ; - - - +00001686: E5 PUSH HL ; save pointer to the next calculator literal. +00001687: D9 EXX ; - - - + +00001688: D5 PUSH DE ; save pointer to divisor - will be STKEND. +00001689: E5 PUSH HL +0000168A: CD CE 01 CALL 01CEh ; routine FETCH-TWO +0000168D: D9 EXX +0000168E: E5 PUSH HL +0000168F: 69 LD L,C +00001690: 60 LD H,B +00001691: D9 EXX +00001692: A7 AND A ; clear carry bit and accumulator. +00001693: 60 LD H,B +00001694: 69 LD L,C +00001695: 0E DF LD C,DFh ; count upwards from -33 decimal +00001697: 18 19 JR +19h ; forward to mid-loop entry point DIV-START + +; --- + +;; DIV-LOOP +00001699: 17 RLA +0000169A: CB 10 RL B +0000169C: D9 EXX +0000169D: CB 11 RL C +0000169F: CB 10 RL B +000016A1: D9 EXX + +;; div-34th +000016A2: 29 ADD HL,HL +000016A3: D9 EXX +000016A4: ED 6A ADC HL,HL +000016A6: D9 EXX +000016A7: 30 09 JR NC,+09h +000016A9: B7 OR A +000016AA: ED 52 SBC HL,DE +000016AC: D9 EXX +000016AD: ED 52 SBC HL,DE +000016AF: D9 EXX +000016B0: 18 0E JR +0Eh + +;; DIV-START +000016B2: ED 52 SBC HL,DE +000016B4: D9 EXX +000016B5: ED 52 SBC HL,DE +000016B7: D9 EXX +000016B8: 30 05 JR NC,+05h +000016BA: 19 ADD HL,DE +000016BB: D9 EXX +000016BC: ED 5A ADC HL,DE +000016BE: D9 EXX +000016BF: 3F CCF + +;; COUNT-ONE +000016C0: 0C INC C +000016C1: FA 99 16 JP M,1699h ; back while still minus to DIV-LOOP + +000016C4: F5 PUSH AF +000016C5: 28 DB JR Z,-25h ; back to DIV-START + +000016C7: 5F LD E,A +000016C8: D9 EXX +000016C9: 50 LD D,B +000016CA: F1 POP AF +000016CB: CB 18 RR B +000016CD: F1 POP AF +000016CE: CB 18 RR B +000016D0: 59 LD E,C + +000016D1: D9 EXX +000016D2: 50 LD D,B +000016D3: C1 POP BC +000016D4: 78 LD A,B +000016D5: 3D DEC A +000016D6: ED 44 NEG +000016D8: 18 42 JR +42h + + + +; ------------------------------ +; THE 'MULTIPLICATION' OPERATION +; ------------------------------ +; +; + +;; multiply + +000016DA: CD 8A 1B CALL 1B8Ah ; XOR A & routine PREP-M/D +000016DD: D8 RET C +000016DE: D9 EXX ; - - - +000016DF: E5 PUSH HL ; save pointer to 'next literal' +000016E0: D9 EXX ; - - - +000016E1: EB EX DE,HL +000016E2: E5 PUSH HL +000016E3: CD 8B 1B CALL 1B8Bh ; routine PREP-M/D +000016E6: EB EX DE,HL +000016E7: 38 40 JR C,+40h ; forward with carry to ZERO-RSLT (anything * zero = zero) +000016E9: E5 PUSH HL +000016EA: CD CE 01 CALL 01CEh ; routine FETCH-TWO +000016ED: AF XOR A +000016EE: D9 EXX +000016EF: E5 PUSH HL +000016F0: 67 LD H,A +000016F1: 6F LD L,A +000016F2: D9 EXX +000016F3: 67 LD H,A +000016F4: 6F LD L,A +000016F5: 78 LD A,B +000016F6: 06 21 LD B,21h +000016F8: 18 11 JR +11h +000016FA: 30 05 JR NC,+05h +000016FC: 19 ADD HL,DE +000016FD: D9 EXX +000016FE: ED 5A ADC HL,DE +00001700: D9 EXX +00001701: D9 EXX +00001702: CB 1C RR H +00001704: CB 1D RR L +00001706: D9 EXX +00001707: CB 1C RR H +00001709: CB 1D RR L +0000170B: D9 EXX +0000170C: CB 18 RR B +0000170E: CB 19 RR C +00001710: D9 EXX +00001711: 1F RRA +00001712: CB 19 RR C +00001714: 10 E4 DJNZ -1Ch +00001716: C1 POP BC +00001717: EB EX DE,HL +00001718: D9 EXX +00001719: EB EX DE,HL +0000171A: D9 EXX +0000171B: 78 LD A,B + +0000171C: E1 POP HL +0000171D: 81 ADD C +0000171E: F2 27 17 JP P,1727h +00001721: 30 10 JR NC,+10h + +00001723: CD 4A 14 CALL 144Ah ; ERROR-1 +00001726: 05 ; "OV" - Number overflow + +00001727: 38 0A JR C,+0Ah + +;; ZERO-RSLT +00001729: CD D1 0B CALL 0BD1h +0000172C: 77 LD (HL),A +0000172D: 23 INC HL +0000172E: 77 LD (HL),A +0000172F: 2B DEC HL +00001730: C3 C6 17 JP 17C6h ; forward to OFLOW-CLR + + +00001733: C6 80 ADD 80h +00001735: 28 F2 JR Z,-0Eh +00001737: 77 LD (HL),A +00001738: D9 EXX +00001739: 78 LD A,B +0000173A: D9 EXX +0000173B: 18 62 JR +62h + +; --------------------------- +; THE 'SUBTRACTION' OPERATION +; --------------------------- +; just switch the sign of subtrahend and do an add. + +;; subtract +0000173D: 1A LD A,(DE) ; fetch exponent byte of second number the subtrahend. +0000173E: B7 OR A ; test for zero +0000173F: C8 RET Z ; return if zero - first number is result. +00001740: 13 INC DE ; address the first mantissa byte. +00001741: 1A LD A,(DE) ; fetch to accumulator. +00001742: EE 80 XOR 80h ; toggle the sign bit. +00001744: 12 LD (DE),A ; place back on calculator stack. +00001745: 1B DEC DE ; point to exponent byte. (continue into addition routine) + +; ------------------------ +; THE 'ADDITION' OPERATION +; ------------------------ +; The addition operation pulls out all the stops and uses most of the Z80's +; registers to add two floating-point numbers. +; This is a binary operation and on entry, HL points to the first number +; and DE to the second. + +;; addition +00001746: D9 EXX ; - - - +00001747: E5 PUSH HL ; save the pointer to the next literal. +00001748: D9 EXX ; - - - +00001749: D5 PUSH DE ; save pointer to second number +0000174A: E5 PUSH HL ; save pointer to first number - will be the result pointer on calculator stack. +0000174B: CD 35 04 CALL 0435h ; PREP-ADD +0000174E: EB EX DE,HL ; switch number pointers. +0000174F: 4F LD C,A ; save first exponent byte in C. +00001750: CD 35 04 CALL 0435h ; PREP-ADD +00001753: B9 CP C ; compare the exponent bytes. +00001754: 30 04 JR NC,+04h ; forward if second higher to SHIFT-LEN +00001756: EB EX DE,HL ; else switch the number pointers +00001757: 47 LD B,A ; and the exponent bytes. +00001758: 79 LD A,C ; +00001759: 48 LD C,B + +;; SHIFT-LEN +0000175A: F5 PUSH AF ; save higher exponent +0000175B: 91 SUB C ; subtract lower exponent +0000175C: F5 PUSH AF +0000175D: CD CE 01 CALL 01CEh ; routine FETCH-TWO +00001760: F1 POP AF +00001761: CD B7 0B CALL 0BB7h ; routine SHIFT-FP +00001764: F1 POP AF ; restore higher exponent. +00001765: E1 POP HL ; restore result pointer. +00001766: 77 LD (HL),A ; insert exponent byte. + +00001767: EB EX DE,HL +00001768: 09 ADD HL,BC +00001769: EB EX DE,HL +0000176A: D9 EXX +0000176B: EB EX DE,HL +0000176C: ED 4A ADC HL,BC +0000176E: 7A LD A,D +0000176F: 8B ADC E +00001770: EB EX DE,HL +00001771: 67 LD H,A +00001772: 0F RRCA +00001773: AC XOR H +00001774: 0F RRCA ; has overflow occurred ? +00001775: D9 EXX +00001776: 30 08 JR NC,+08h ; skip forward if not to TEST-NEG + +; if the addition of two positive mantissas produced overflow or if the +; addition of two negative mantissas did not then the result exponent has to +; be incremented and the mantissa shifted one place to the right. + +00001778: 3E 01 LD A,01h ; one shift required. +0000177A: CD BD 0B CALL 0BBDh ; routine SHIFT-FP(+2) performs a single shift rounding any lost bit +0000177D: 34 INC (HL) ; increment the exponent. +0000177E: 28 A3 JR Z,-5Dh ; forward to ADD-REP-6 if the exponent wraps round from FF to zero + ; as number is too big for the system. +;; TEST-NEG +00001780: 23 INC HL ; point to first byte of mantissa +00001781: D9 EXX ; switch in the alternate set. +00001782: 3E 80 LD A,80h ; isolate bit 7 from sign byte setting zero flag +00001784: A4 AND H ; ..if positive. +00001785: D9 EXX ; back to main set. +00001786: 77 LD (HL),A ; insert $00 positive or $80 negative at position on calculator stack. +00001787: 2B DEC HL ; point to exponent again. +00001788: 28 15 JR Z,+15h ; forward if positive to GO-NC-MLT + +; a negative number has to be twos-complemented before being placed on stack. + +0000178A: AF XOR A +0000178B: 93 SUB E ; negate the lowest (rightmost) mantissa byte (CY value matters) +0000178C: 5F LD E,A ; place back in register + +0000178D: 3E 00 LD A,00h ; ditto +0000178F: 9A SBC D +00001790: 57 LD D,A + +00001791: D9 EXX ; switch to higher (lefmost) 16 bits. + +00001792: 3E 00 LD A,00h ; ditto +00001794: 9B SBC E +00001795: 5F LD E,A + +00001796: 3E 00 LD A,00h ; ditto +00001798: 9A SBC D +00001799: 57 LD D,A + +0000179A: D9 EXX +0000179B: 3E 00 LD A,00h +0000179D: 30 24 JR NC,+24h + +; --- + +; this branch is common to addition and multiplication with the mantissa +; result still in registers D'E'D E . + +;; NORMALIZE + +0000179F: 06 20 LD B,20h ; a maximum of thirty-two left shifts will be needed +000017A1: A7 AND A + +;; SHIFT-ONE +000017A2: D9 EXX ; address higher 16 bits. +000017A3: CB 7A BIT 7,D ; test the leftmost bit +000017A5: D9 EXX ; address lower 16 bits. +000017A6: 20 13 JR NZ,+13h ; forward if leftmost bit was set to NORML-NOW +000017A8: 17 RLA ; this holds zero from addition, 33rd bit from multiplication. +000017A9: CB 13 RL E ; C < 76543210 < C +000017AB: CB 12 RL D ; C < 76543210 < C +000017AD: D9 EXX ; address higher 16 bits. +000017AE: CB 13 RL E ; C < 76543210 < C +000017B0: CB 12 RL D ; C < 76543210 < C +000017B2: D9 EXX ; switch to main set. +000017B3: 35 DEC (HL) ; decrement the exponent byte on the calculator stack +000017B4: 28 02 JR Z,+02h ; back if exponent becomes zero to NEAR-ZERO + ; it's just possible that the last rotation set bit 7 of D. We shall see. +000017B6: 10 EA DJNZ -16h ; loop back to SHIFT-ONE + +; if thirty-two left shifts were performed without setting the most significant +; bit then the result is zero. + +000017B8: C3 29 17 JP 1729h ; back to ZERO-RSLT + + +000017BB: 07 RLCA + +000017BC: 30 08 JR NC,+08h ; forward to OFLOW-CLR + +000017BE: CD 8E 0B CALL 0B8Eh ; forward to ADD-BACK +000017C1: 20 03 JR NZ,+03h +000017C3: 34 INC (HL) +000017C4: 28 B8 JR Z,-48h + + +; now transfer the mantissa from the register sets to the calculator stack +; incorporating the sign bit already there. + +;; OFLOW-CLR + +000017C6: E5 PUSH HL ; save pointer to exponent on stack. +000017C7: D9 EXX +000017C8: D5 PUSH DE ; push the most significant two bytes. +000017C9: D9 EXX +000017CA: C1 POP BC ; pop - true mantissa is now BCDE +000017CB: 23 INC HL + +; now pick up the sign bit. +000017CC: 78 LD A,B ; first mantissa byte to A +000017CD: 07 RLCA ; rotate out bit 7 which is set +000017CE: CB 26 SLA (HL) ; rotate sign bit on stack into carry +000017D0: 1F RRA ; rotate sign bit into bit 7 of mantissa + +; and transfer mantissa from main registers to calculator stack. + +000017D1: 77 LD (HL),A ; +000017D2: 23 INC HL +000017D3: 71 LD (HL),C +000017D4: 23 INC HL +000017D5: 72 LD (HL),D +000017D6: 23 INC HL +000017D7: 73 LD (HL),E + +000017D8: E1 POP HL ; restore pointer to num1 now result. +000017D9: D1 POP DE ; restore pointer to num2 now STKEND + +000017DA: D9 EXX ; +000017DB: E1 POP HL ; restore pointer to next calculator literal. +000017DC: D9 EXX +000017DD: C9 RET + + +;--------------------------- +; Stack a constant +;--------------------------- +; This routine allows a one-byte instruction to stack up to 32 constants +; held in short form in a table of constants. In fact only 5 constants are +; required. On entry the A register holds the literal ANDed with $1F. +; It isn't very efficient and it would have been better to hold the +; numbers in full, five byte form and stack them in a similar manner +; to that which would be used later for semi-tone table values. + +;; stk-const-xx +000017DE: D9 EXX +000017DF: E5 PUSH HL +000017E0: 21 37 1C LD HL,1C37h ; start of table of constants +000017E3: 5F LD E,A +000017E4: 16 00 LD D,00h +000017E6: 19 ADD HL,DE +000017E7: D9 EXX +000017E8: CD 31 0D CALL 0D31h ; stk-data +000017EB: 18 ED JR -13h ; recycle the code to restore the pointer to next literal + +; ------------------------- +; THE 'OUT-BYTE' SUBROUTINE +; ------------------------- +; This subroutine outputs a byte a bit at a time to a domestic tape recorder. + +;; OUT-BYTE +000017ED: 37 SCF ; set carry flag - as a marker. +000017EE: 56 LD D,(HL) ; fetch byte to be saved. +;; EACH-BIT +000017EF: CB 12 RL D ; C < 76543210 < C +000017F1: C8 RET Z ; return when the marker bit has passed right through + +000017F2: 9F SBC A ; $FF if set bit or $00 with no carry. +000017F3: E6 05 AND 05h ; $05 $00 +000017F5: C6 04 ADD 04h ; $09 $04 +000017F7: 5F LD E,A ; transfer timer to E. a set bit has a longer pulse than a reset bit. + +000017F8: CD F4 19 CALL 19F4h ; call PULSES + +000017FB: AF XOR A +000017FC: 10 FD DJNZ -03h +000017FE: 18 EF JR -11h ; loop back to EACH-BIT + + +;; +00001800: 2A 29 40 LD HL,(4029h) ; E_PPC (<> ZX81) +00001803: CD 92 12 CALL 1292h ; INC HL, LINE-ADDR (HL), AND LINE-NO +00001806: 18 0A JR +0Ah ; to KEY-INPUT + +;------------------------ +; THE 'CURSOR UP' ROUTINE +;------------------------ +; +; + +;; UP-KEY +00001808: 2A 29 40 LD HL,(4029h) ; E_PPC (<> ZX81) +0000180B: CD 36 0B CALL 0B36h ; routine LINE-ADDR (HL) +0000180E: EB EX DE,HL +0000180F: CD 96 12 CALL 1296h ; routine LINE-NO + + +00001812: FD CB 2D 6E BIT 5,(IY+2Dh) ; FLAGX +00001816: C2 04 10 JP NZ,1004h ; to LOWER + +;---------------------------- +; THE 'BASIC LISTING' SECTION +;---------------------------- +; +; + +00001819: ED 53 29 40 LD (4029h),DE ; E_PPC (<> ZX81) +;; UPPER +0000181D: CD 7D 1C CALL 1C7Dh ; routine CLS +00001820: ED 5B 23 40 LD DE,(4023h) ; S_TOP +00001824: B7 OR A +00001825: 2A 29 40 LD HL,(4029h) ; E_PPC (<> ZX81) +00001828: ED 52 SBC HL,DE +0000182A: EB EX DE,HL +0000182B: 30 04 JR NC,+04h ; to ADDR-TOP +0000182D: 19 ADD HL,DE +0000182E: 22 23 40 LD (4023h),HL ;S_TOP +;; ADDR-TOP +00001831: CD 36 0B CALL 0B36h ; routine LINE-ADDR (HL) +00001834: 28 01 JR Z,+01h +00001836: EB EX DE,HL +;; LIST-TOP +00001837: FD 36 09 FF LD (IY+09h),FFh ; VERSN / BERG +0000183B: CD D8 0C CALL 0CD8h ; routine LIST-PROG +0000183E: FD 34 09 INC (IY+09h) ; VERSN / BERG +00001841: C2 04 10 JP NZ,1004h ; to LOWER + +00001844: 2A 29 40 LD HL,(4029h) ; E_PPC (<> ZX81) +00001847: CD 36 0B CALL 0B36h ; routine LINE-ADDR (HL) +0000184A: 2A 16 40 LD HL,(4016h) ; CH_ADD +0000184D: ED 52 SBC HL,DE +0000184F: 38 0C JR C,+0Ch ; DONT-INC-LINE + +;; INC-LINE +00001851: 2A 23 40 LD HL,(4023h) ; S_TOP +00001854: CD 92 12 CALL 1292h ; INC HL, LINE-ADDR (HL), AND LINE-NO +00001857: ED 53 23 40 LD (4023h),DE ; S_TOP +0000185B: 18 C0 JR -40h ; to UPPER + +;; DONT-INC-LINE +0000185D: EB EX DE,HL +0000185E: 56 LD D,(HL) +0000185F: 23 INC HL +00001860: 5E LD E,(HL) +00001861: 18 F4 JR -0Ch ; to INC-LINE + +;; N/L-ONLY +00001863: CD D4 13 CALL 13D4h ; routine CURSOR-IN inserts the cursor and end-marker in the Edit Line +00001866: 18 B5 JR -4Bh ; also setting size of lower display to two lines. + +;; CP-LINES +00001868: 7E LD A,(HL) +00001869: B8 CP B +0000186A: C0 RET NZ +0000186B: 23 INC HL +0000186C: 7E LD A,(HL) +0000186D: B9 CP C +0000186E: 2B DEC HL +0000186F: C9 RET + +00001870: ED 4B 25 40 LD BC,(4025h) ; LAST_K +00001874: CD 2D 1C CALL 1C2Dh ; DEBOUNCE + + +;--------------------------------- +; THE 'KEYBOARD DECODE' SUBROUTINE +;--------------------------------- +; +; + +;; DECODE +00001877: CB 28 SRA B +00001879: 9F SBC A +0000187A: F6 26 OR 26h + +0000187C: 11 01 00 LD DE,0001h + +; to KEY-LINE +0000187F: 83 ADD E +00001880: 37 SCF +00001881: CB 18 RR B +00001883: 38 FA JR C,-06h ; to KEY-LINE +00001885: 04 INC B +00001886: C0 RET NZ +00001887: 1D DEC E +00001888: 1E 05 LD E,05h +0000188A: 41 LD B,C +0000188B: 28 F2 JR Z,-0Eh ; to KEY-LINE + +0000188D: 93 SUB E +0000188E: 5F LD E,A +0000188F: 21 E6 03 LD HL,03E6h ; "KEY TABLES" -1 +00001892: 19 ADD HL,DE +00001893: 37 SCF +00001894: C9 RET + +; -------------------------- +; THE 'DE,(DE+1)' SUBROUTINE +; -------------------------- +; INDEX and LOAD Z80 subroutine. +; This emulates the 6800 processor instruction LDX 1,X which loads a two-byte +; value from memory into the register indexing it. Often these are hardly worth +; the bother of writing as subroutines and this one doesn't save any time or +; memory. The timing and space overheads have to be offset against the ease of +; writing and the greater program readability from using such toolkit routines. + +;; DE,(DE+1) + +00001895: 13 INC DE +00001896: EB EX DE,HL +00001897: 5E LD E,(HL) +00001898: 23 INC HL +00001899: 56 LD D,(HL) +0000189A: C9 RET + +;-------------------------- +; String concatenation () +;-------------------------- +; This literal combines two strings into one e.g. LET A$ = B$ + C$ +; The two parameters of the two strings to be combined are on the stack. + +;; strs-add +0000189B: E7 RST 20h ; routine STK-FETCH fetches string parameters and deletes calculator stack entry +0000189C: D5 PUSH DE ; save start address. +0000189D: C5 PUSH BC ; and length +0000189E: E7 RST 20h ; routine STK-FETCH for first string +0000189F: E1 POP HL ; re-fetch first length +000018A0: E5 PUSH HL ; and save again +000018A1: 09 ADD HL,BC ; add the two lengths. +000018A2: C5 PUSH BC ; save length +000018A3: 4D LD C,L ; transfer to BC +000018A4: 44 LD B,H +000018A5: D5 PUSH DE ; save start of second string +000018A6: CD DD 0B CALL 0BDDh ; create BC-SPACES in workspace +000018A9: CD BC 13 CALL 13BCh ; routine STK-STO-$ stores parameters of new string updating STKEND. +000018AC: E1 POP HL ; length of first +000018AD: C1 POP BC ; address of start +000018AE: 79 LD A,C ; test for +000018AF: B0 OR B ; zero length. +000018B0: 28 02 JR Z,+02h ; to OTHER-STR if null string +000018B2: ED B0 LDIR ; copy string to workspace. + +;; OTHER-STR +000018B4: C1 POP BC ; now second length +000018B5: E1 POP HL ; and start of string +000018B6: 79 LD A,C ; test this one +000018B7: B0 OR B ; for zero length +000018B8: 28 33 JR Z,+33h ; skip forward to STK-PNTRS if so as complete. +000018BA: ED B0 LDIR ; else copy the bytes +000018BC: 18 2F JR +2Fh ; and sets the calculator stack pointers + +;----------------------------- +; Handle VAL () +;----------------------------- +; VAL treats the characters in a string as a numeric expression. +; e.g. VAL "2.3" = 2.3, VAL "2+4" = 6, VAL ("2" + "4") = 24. + +;; val +000018BE: E7 RST 20h ; routine STK-FETCH fetches the string operand from calculator stack. + +000018BF: 2A 16 40 LD HL,(4016h) ; fetch value of system variable CH_ADD +000018C2: E5 PUSH HL ; and save on the machine stack. +000018C3: 03 INC BC +000018C4: D5 PUSH DE +000018C5: CD DD 0B CALL 0BDDh ; BC-SPACES creates the space in workspace. +000018C8: ED 53 16 40 LD (4016h),DE ; load CH_ADD with start DE in workspace. +000018CC: E1 POP HL ; restore start of string to HL. +000018CD: D5 PUSH DE ; save the start in workspace +000018CE: 0B DEC BC +000018CF: ED B0 LDIR ; copy string from program or variables or workspace to the workspace area. +000018D1: 3E 76 LD A,76h ; insert a carriage return at end. +000018D3: 12 LD (DE),A +000018D4: FD CB 1E BE RES 7,(IY+1Eh) ; update BREG/FLAGS - signal checking syntax. +000018D8: CD 11 0A CALL 0A11h ; routine CLASS-06 - SCANNING evaluates string expression and checks for integer result. + +000018DB: CD 3E 0A CALL 0A3Eh ; routine CHECK-2 checks for carriage return. +000018DE: FD CB 1E FE SET 7,(IY+1Eh) ; update BREG/FLAGS - signal running program. +000018E2: E1 POP HL +000018E3: 22 16 40 LD (4016h),HL ; set CH_ADD to the start of the string again. +000018E6: CD 06 08 CALL 0806h ; routine SCANNING evaluates the string in full, leaving result on calculator stack. + +000018E9: E1 POP HL ; restore saved character address in program. +000018EA: 22 16 40 LD (4016h),HL + + +;; STK-PNTRS +000018ED: ED 5B 1C 40 LD DE,(401Ch) ; STKEND +000018F1: 21 FB FF LD HL,FFFBh +000018F4: 19 ADD HL,DE +000018F5: C9 RET + +;------------------------ +; THE 'NUMBER' SUBROUTINE +;------------------------ +; +; + +;; NUMBER +000018F6: 7E LD A,(HL) +000018F7: FE 7E CP 7Eh +000018F9: C0 RET NZ +000018FA: 23 INC HL +000018FB: 23 INC HL +000018FC: 23 INC HL +000018FD: 23 INC HL +000018FE: 23 INC HL +000018FF: C9 RET +00001900: 94 SUB H +00001901: 8B ADC E +00001902: 84 ADD H +00001903: 7C LD A,H +00001904: F8 RET M +00001905: EB EX DE,HL +00001906: DD D1 POP DE +00001908: C5 PUSH BC +00001909: BA CP D +0000190A: BA CP D +0000190B: B0 OR B +0000190C: A6 AND (HL) +0000190D: 9D SBC L + +;; skip word +0000190E: 78 LD A,B +0000190F: B1 OR C +00001910: C8 RET Z +00001911: 7E LD A,(HL) +00001912: 0B DEC BC +00001913: 23 INC HL +00001914: A7 AND A +00001915: C0 RET NZ +00001916: 18 F6 JR -0Ah + +;; PAUSE ? +00001918: CD 6F 0D CALL 0D6Fh ; GET-INT & SET-FAST +0000191B: CD 0E 19 CALL 190Eh ; skip word +0000191E: CA A9 12 JP Z,12A9h ; routine SLOW/FAST + +00001921: FE 1B CP 1Bh +00001923: 1E 01 LD E,01h +00001925: 28 24 JR Z,+24h +00001927: 07 RLCA +00001928: FE 5A CP 5Ah +0000192A: 30 5C JR NC,+5Ch +0000192C: D6 4C SUB 4Ch +0000192E: 38 58 JR C,+58h +00001930: E5 PUSH HL +00001931: 16 00 LD D,00h +00001933: 5F LD E,A +00001934: 21 00 19 LD HL,1900h +00001937: 19 ADD HL,DE +00001938: 5E LD E,(HL) +00001939: E1 POP HL +0000193A: CD 0E 19 CALL 190Eh ; skip word +0000193D: 28 49 JR Z,+49h + +0000193F: FE 13 CP 13h +00001941: 28 08 JR Z,+08h + +00001943: CB 3B SRL E +00001945: FE 12 CP 12h +00001947: 20 07 JR NZ,+07h + +00001949: CB 3B SRL E +0000194B: CD 0E 19 CALL 190Eh ; skip word +0000194E: 28 38 JR Z,+38h + +00001950: CD 54 1C CALL 1C54h ; routine ALPHA +00001953: 38 33 JR C,+33h + +00001955: 57 LD D,A +00001956: CD 0E 19 CALL 190Eh ; skip word +00001959: 28 12 JR Z,+12h + +0000195B: CD 54 1C CALL 1C54h ; routine ALPHA +0000195E: 30 04 JR NC,+04h + +00001960: 2B DEC HL +00001961: 03 INC BC +00001962: 18 09 JR +09h +00001964: CB 22 SLA D +00001966: 82 ADD D +00001967: CB 22 SLA D +00001969: CB 22 SLA D +0000196B: 82 ADD D +0000196C: 57 LD D,A +0000196D: E5 PUSH HL +0000196E: C5 PUSH BC +0000196F: 62 LD H,D +00001970: FD 6E 21 LD L,(IY+21h) ; MUNIT (tempo) +00001973: 0E 00 LD C,00h +00001975: 53 LD D,E +00001976: 45 LD B,L ; load tempo +00001977: CD A5 0B CALL 0BA5h +0000197A: 25 DEC H +0000197B: 20 F9 JR NZ,-07h +0000197D: CD 28 1C CALL 1C28h ; routine BREAK-1 test for BREAK key. +00001980: 30 62 JR NC,+62h +00001982: 10 F9 DJNZ -07h ; timing loop +00001984: C1 POP BC +00001985: E1 POP HL +00001986: 18 93 JR -6Dh + +00001988: CD 4A 14 CALL 144Ah ; ERROR-1 +0000198B: 0E ; "MF" - Incorrect music string format + +; ------------------------ +; THE 'IN-BYTE' SUBROUTINE +; ------------------------ + +;; IN-BYTE +0000198C: 0E 01 LD C,01h ; prepare an eight counter 00000001. +0000198E: 18 1B JR +1Bh ; Forward to next-bit + +00001990: E5 PUSH HL ; save the +00001991: 2E 96 LD L,96h ; timing value. +00001993: 06 1B LD B,1Bh ; counter to twenty seven. +00001995: DB FE INA (FEh) ; read the +00001997: 07 RLCA +00001998: 2D DEC L ; decrement the measuring timer. +00001999: 7D LD A,L +0000199A: CB 7F BIT 7,A ; bit 6: Display Refresh Rate (0=60Hz, 1=50Hz) +0000199C: 38 F5 JR C,-0Bh +0000199E: 10 F5 DJNZ -0Bh +000019A0: E1 POP HL +000019A1: 20 04 JR NZ,+04h ; to BIT-DONE +000019A3: FE 5A CP 5Ah +000019A5: 30 04 JR NC,+04h ; to NEXT-BIT +;; BIT-DONE +000019A7: 3F CCF +000019A8: CB 11 RL C +000019AA: D8 RET C ; return when byte is complete + +;; NEXT-BIT +000019AB: 06 00 LD B,00h ; set counter to 256 +;; BREAK-3 +000019AD: 3E 7F LD A,7Fh +000019AF: DB FE INA (FEh) ; Read leyboard and CAS input bit, but not PAL/NTSC +000019B1: D3 FF OUTA (FFh) ; Terminate retrace / CAS output +000019B3: 07 RLCA ; test for SPACE pressed. +000019B4: 38 DA JR C,-26h +000019B6: 0F RRCA +000019B7: 0F RRCA +000019B8: 30 25 JR NC,+25h ; forward if set to GET-BIT +000019BA: 10 F1 DJNZ -0Fh + +000019BC: E1 POP HL +000019BD: 15 DEC D +000019BE: 14 INC D ; test for zero. +000019BF: 28 20 JR Z,+20h + +000019C1: 6B LD L,E +000019C2: 62 LD H,D +000019C3: CD 8C 19 CALL 198Ch ; IN-BYTE +000019C6: 79 LD A,C +000019C7: CB 7A BIT 7,D +000019C9: 20 03 JR NZ,+03h +000019CB: BE CP (HL) +000019CC: 20 21 JR NZ,+21h +000019CE: 23 INC HL +000019CF: 07 RLCA +000019D0: 30 F1 JR NC,-0Fh +000019D2: 21 09 40 LD HL,4009h ; VERSN / BERG +000019D5: CD 8C 19 CALL 198Ch ; IN-BYTE +000019D8: 71 LD (HL),C +000019D9: CD BA 0E CALL 0EBAh ; routine LOAD/SAVE +000019DC: 50 LD D,B +000019DD: 18 F6 JR -0Ah + +;; GET-BIT +000019DF: 15 DEC D +000019E0: 14 INC D ; test for zero. + +;; RESTART +000019E1: CA 5A 0F JP Z,0F5Ah ; jump forward to INITIAL if D is zero to reset the system + ; if the tape signal has timed out (for example if the tape is stopped) + ; Not just a simple report as some system variables will have been overwritten. + +000019E4: CD 4A 14 CALL 144Ah ; ERROR-1 +000019E7: 01 "BK" - BREAK Key pressed + + +;--------------------------- +; THE 'LOAD COMMAND' ROUTINE +;--------------------------- +; +; + +;; LOAD +000019E8: CD 38 15 CALL 1538h ; NAME +000019EB: 7A LD A,D +000019EC: 17 RLA ; pick up carry +000019ED: 0F RRCA ; carry now in bit 7. +000019EE: 57 LD D,A +;; NEXT-PROG +000019EF: CD 8C 19 CALL 198Ch ; IN-BYTE +000019F2: 18 FB JR -05h ; loop to NEXT-PROG + + +;; PULSES (used by SAVE) +000019F4: D3 FF OUTA (FFh) ; pulse to cassette. +000019F6: 06 23 LD B,23h ; set timing constant +;; DELAY-2 +000019F8: 10 FE DJNZ -02h ; self-loop to DELAY-2 + +000019FA: CD 28 1C CALL 1C28h ; routine BREAK-1 test for BREAK key. +000019FD: 06 1E LD B,1Eh ; set timing value. +000019FF: 30 E3 JR NC,-1Dh ; forward with break to REPORT-D +;; DELAY-3 +00001A01: 10 FE DJNZ -02h ; self-loop to DELAY-3 + +00001A03: 1D DEC E ; decrement counter +00001A04: 20 EE JR NZ,-12h ; loop back to PULSES +00001A06: C9 RET + + +;--------------------------------- +; Store in a memory area ($C0 etc???) +;--------------------------------- +; Offsets $C0 to $DF (???) +; Although 32 memory storage locations can be addressed, only six +; $C0 to $C5 are required by the ROM and only the thirty bytes (6*5) +; required for these are allocated. ZX81 programmers who wish to +; use the floating point routines from assembly language may wish to +; alter the system variable MEM to point to 160 bytes of RAM to have +; use the full range available. +; A holds derived offset $00-$1F. +; Unary so on entry HL points to last value, DE to STKEND. + +;; st-mem-xx +00001A07: EB EX DE,HL +00001A08: D5 PUSH DE +00001A09: CD 95 1B CALL 1B95h ; LOC-MEM +00001A0C: EB EX DE,HL +00001A0D: CD 6F 07 CALL 076Fh ; MOVE-FP +00001A10: D1 POP DE +00001A11: EB EX DE,HL +00001A12: C9 RET + + +;--------------------------------------- +; THE 'NEXT LINE OR VARIABLE' SUBROUTINE +;--------------------------------------- +; +; + +;; NEXT-ONE +00001A13: 7E LD A,(HL) +00001A14: E5 PUSH HL +00001A15: FE 40 CP 40h +00001A17: 38 16 JR C,+16h +00001A19: CB 6F BIT 5,A +00001A1B: 28 13 JR Z,+13h +;; NEXT+FIVE +00001A1D: 11 05 00 LD DE,0005h +00001A20: 87 ADD A +00001A21: 30 05 JR NC,+05h ; to NEXT-LETT +00001A23: F2 28 1A JP P,1A28h +00001A26: 1E 11 LD E,11h +;; NEXT-LETT +00001A28: 87 ADD A +00001A29: 23 INC HL +00001A2A: 7E LD A,(HL) +00001A2B: 30 FB JR NC,-05h ; to NEXT-LETT +00001A2D: 18 06 JR +06h ; to NEXT-ADD +;; LINES +00001A2F: 23 INC HL +;; NEXT-O-4 +00001A30: 23 INC HL +00001A31: 5E LD E,(HL) +00001A32: 23 INC HL +00001A33: 56 LD D,(HL) +00001A34: 23 INC HL +;; NEXT-ADD +00001A35: 19 ADD HL,DE +00001A36: D1 POP DE +;---------------------------- +; THE 'DIFFERENCE' SUBROUTINE +;---------------------------- +; +; + +;; DIFFER +00001A37: B7 OR A +00001A38: ED 52 SBC HL,DE +00001A3A: 4D LD C,L +00001A3B: 44 LD B,H +00001A3C: 19 ADD HL,DE +00001A3D: EB EX DE,HL +00001A3E: C9 RET + +;-------------------------- +; THE 'POINTERS' SUBROUTINE +;-------------------------- +; +; + +;; POINTERS +00001A3F: F5 PUSH AF +00001A40: E5 PUSH HL +00001A41: 3E 07 LD A,07h +00001A43: 21 0F 40 LD HL,400Fh +;; NEXT-PTR +00001A46: 23 INC HL +00001A47: 5E LD E,(HL) +00001A48: 23 INC HL +00001A49: 56 LD D,(HL) +00001A4A: E3 EX HL,(SP) +00001A4B: B7 OR A +00001A4C: ED 52 SBC HL,DE +00001A4E: 19 ADD HL,DE +00001A4F: E3 EX HL,(SP) +00001A50: 30 09 JR NC,+09h ; to PTR-DONE + +00001A52: EB EX DE,HL +00001A53: E5 PUSH HL +00001A54: 09 ADD HL,BC +00001A55: EB EX DE,HL +00001A56: 72 LD (HL),D +00001A57: 2B DEC HL +00001A58: 73 LD (HL),E +00001A59: D1 POP DE +;; PTR-DONE +00001A5A: 23 INC HL +00001A5B: 3D DEC A +00001A5C: 20 E8 JR NZ,-18h +00001A5E: E1 POP HL +00001A5F: EB EX DE,HL +00001A60: F1 POP AF +00001A61: 18 D4 JR -2Ch + + +;----------------------- +; THE 'NATURAL LOGARITHM' FUNCTION +;----------------------- +; (offset $??: 'ln') <-- 'log' on the Lambda +; The two most common logarithms are called common logarithms and natural +; logarithms. +; Common logarithms have a base of 10 and natural logarithms have a base of 'e'. + +;; ln +00001A63: F7 RST 30h ; FP-CALC +00001A64: 01 ;;duplicate +00001A65: 02 ;;greater-0 +00001A66: B4 ;;jump-true & end-calc !! +00001A67: 05 ;; ..to VALID + +; Error Report: Invalid argument +00001A68: CD 4A 14 CALL 144Ah ; ERROR-1 +00001A6B: 09 ; "AG" - Invalid Argument + +;; VALID +00001A6C: 7E LD A,(HL) +00001A6D: 36 80 LD (HL),80h +00001A6F: CD 79 07 CALL 0779h ; STACK-A + +00001A72: F7 RST 30h ; FP-CALC +00001A73: 05 DEC B +00001A74: 38 00 JR C,+00h +00001A76: 1E ;;subtract +00001A77: 33 ;;exchange +00001A78: 01 05 F0 LD BC,F005h +00001A7B: 4C LD C,H +00001A7C: CC CC CD CALL Z,CDCCh +00001A7F: 1E 02 LD E,02h +00001A81: 34 INC (HL) +00001A82: 07 RLCA +00001A83: 33 ;;exchange +00001A84: 79 LD A,C +00001A85: 1E B3 LD E,B3h +00001A87: 34 INC (HL) + +00001A88: F7 RST 30h ; FP-CALC +00001A89: 33 ;;exchange +00001A8A: 05 DEC B +00001A8B: F0 RET P +00001A8C: 31 72 17 LD SP,1772h +00001A8F: F8 RET M +00001A90: 1F ;;multiply +00001A91: 33 INC SP +00001A92: 79 LD A,C +00001A93: 1E 01 LD E,01h +00001A95: 05 DEC B +00001A96: 32 20 1F LD (1F20h),A +00001A99: 75 LD (HL),L +00001A9A: 1E 6C LD E,6Ch +00001A9C: 11 AC 14 LD DE,14ACh +00001A9F: 09 ADD HL,BC +00001AA0: 56 LD D,(HL) +00001AA1: DA A5 59 JP C,59A5h +00001AA4: 30 C5 JR NC,-3Bh +00001AA6: 5C LD E,H +00001AA7: 90 SUB B +00001AA8: AA XOR D +00001AA9: 9E SBC (HL) +00001AAA: 70 LD (HL),B +00001AAB: 6F LD L,A +00001AAC: 61 LD H,C +00001AAD: A1 AND C +00001AAE: CB DA SET 3,D +00001AB0: 96 SUB (HL) +00001AB1: A4 AND H +00001AB2: 31 9F B4 LD SP,B49Fh +00001AB5: E7 RST 20h ; STK-FETCH +00001AB6: A0 AND B +00001AB7: FE 5C CP 5Ch +00001AB9: FC EA 1B CALL M,1BEAh ; PAUSE +00001ABC: 43 LD B,E +00001ABD: CA 36 ED JP Z,ED36h +00001AC0: A7 AND A +00001AC1: 9C SBC H +00001AC2: 7E LD A,(HL) +00001AC3: 5E LD E,(HL) +00001AC4: F0 RET P +00001AC5: 6E LD L,(HL) +00001AC6: 23 INC HL +00001AC7: 80 ADD B +00001AC8: 93 SUB E +00001AC9: 1F RRA +00001ACA: AA XOR D +00001ACB: C9 RET + +;--------------------------- +; THE 'RAND' COMMAND ROUTINE +;--------------------------- +; The keyword was 'RANDOMISE' on the ZX80, is 'RAND' on the ZX81 and becomes 'RANDOMIZE' on the ZX Spectrum. +; In all invocations the procedure is the same - to set the SEED system variable +; with a supplied integer value or to use a time-based value if no number, or +; zero, is supplied. + +;; RAND +00001ACC: CD 09 15 CALL 1509h ; FIND-INT +00001ACF: B0 OR B ; test value for zero +00001AD0: 20 04 JR NZ,+04h ; forward if not zero to SET-SEED +00001AD2: ED 4B 34 40 LD BC,(4034h) ; fetch value of FRAMES system variable. +00001AD6: ED 43 32 40 LD (4032h),BC ; SEED +00001ADA: C9 RET + + +00001ADB: 76 HALT +00001ADC: 78 LD A,B +00001ADD: 7A LD A,D +00001ADE: 67 LD H,A +00001ADF: 51 LD D,C +00001AE0: 3C INC A +00001AE1: 7C LD A,H +00001AE2: 7E LD A,(HL) +00001AE3: 9B SBC E +00001AE4: 5B LD E,E +00001AE5: 96 SUB (HL) +00001AE6: 86 ADD (HL) +00001AE7: 82 ADD D +00001AE8: 7B LD A,E +00001AE9: 89 ADC C +00001AEA: 85 ADD L +00001AEB: 9C SBC H +00001AEC: 98 SBC B +00001AED: 1E 60 LD E,60h +00001AEF: 5C LD E,H +00001AF0: 17 RLA +00001AF1: 45 LD B,L +00001AF2: 50 LD D,B + +00001AF3: 0F RRCA +00001AF4: 54 LD D,H +00001AF5: 1E 2B LD E,2Bh +00001AF7: 8A ADC D +00001AF8: 2E 40 LD L,40h +00001AFA: 39 ADD HL,SP +00001AFB: 41 LD B,C +00001AFC: 1B DEC DE +00001AFD: 69 LD L,C +00001AFE: 2D DEC L +00001AFF: 76 HALT +00001B00: 78 LD A,B +00001B01: 59 LD E,C +00001B02: 00 NOP +00001B03: 14 INC D +00001B04: 07 RLCA +00001B05: E2 00 00 JP PO,0000h +00001B08: 06 3B LD B,3Bh +00001B0A: 10 01 DJNZ +01h +00001B0C: 14 INC D +00001B0D: 02 LD (BC),A +00001B0E: 41 LD B,C +00001B0F: 02 LD (BC),A +00001B10: 07 RLCA +00001B11: A7 AND A +00001B12: 07 RLCA +00001B13: 01 06 4D LD BC,4D06h +00001B16: 0B DEC BC +00001B17: 02 LD (BC),A +00001B18: 40 LD B,B + + + + + +00001B19: 07 DEFB 07h ; +00001B1A: D7 00 DEFW 00D7h ; + +;--- +00001B1C: 02 1A DEFW 1A02h ; offset table. +;--- + +;; P-SOUND +00001B1E: 05 DEFB 05h ; Class-06 - A numeric expression must follow. +00001B1F: 99 0B DEFW 0B99h ; SOUND + +;--- +00001B21: 02 1A DEFW 1A02h ; offset table. +;--- + +00001B23: 05 DEFB 05h ; Class-06 - A numeric expression must follow. +00001B24: C4 01 DEFW 01C4h ; + +;--- +00001B27: 02 1A DEFW 1A02h ; offset table. +;--- + +;; P-PLOT +00001B28: 05 DEFB 05h ; Class-06 - A numeric expression must follow. +00001B29: AD 11 DEFW 11ADh ; PLOT + +;--- +00001B2B: 02 1A DEFW 1A02h ; offset table. +;--- + +;; P-UNPLOT +00001B2D: 05 DEFB 05h ; Class-06 - A numeric expression must follow. +00001B2E: B9 11 DEFW 11B9h ; UNPLOT + +00001B30: 03 DEFB 03h ; Class-05 - Variable syntax checked entirely by routine. +00001B31: 18 19 DEFW 1918h ; PAUSE ? + +;; P-SAVE +00001B33: 03 DEFB 03h ; Class-05 - Variable syntax checked entirely by routine. +00001B34: 03 0D DEFW 0D03h ; SAVE + +;; P-LOAD +00001B36: 03 DEFB 03h ; Class-05 - Variable syntax checked entirely by routine. +00001B37: E8 19 DEFW 19E8h ; LOAD + +;; P-RUN +00001B39: 04 DEFB 04h ; Class-03 - A numeric expression may follow, else default to zero +00001B3A: 31 14 DEFW 1431h ; RUN + +;; P-RAND +00001B3C: 04 DEFB 04h ; Class-03 - A numeric expression may follow, else default to zero +00001B3D: CC 1A DEFW 1ACCh ; RAND + +;; P-LLIST +00001B3F: 04 DEFB 04h ; Class-03 - A numeric expression may follow, else default to zero +00001B40: C6 0C DEFW 0CC6h ; LLIST + +;; P-LIST +00001B42: 04 DEFB 04h ; Class-03 - A numeric expression may follow, else default to zero +00001B43: CA 0C DEFW 0CCAh ; LIST + +;; P-TEMPO +00001B45: 05 DEFB 05h ; Class-06 - A numeric expression must follow. +00001B46: 5F 16 DEFW 165Fh ; TEMPO + +;; P-PAUSE +00001B48: 05 DEFB 05h ; Class-06 - A numeric expression must follow. +00001B49: EA 1B DEFW 1BEAh ; PAUSE + +;; P-GOSUB +00001B4B: 05 DEFB 05h ; Class-06 - A numeric expression must follow. +00001B4C: E6 13 DEFW 13E6h ; GOSUB + +;; P-GOTO +00001B4E: 05 DEFB 05h ; Class-06 - A numeric expression must follow. +00001B4F: 2B 15 DEFW 152Bh ; GOTO + +;; P-INK +00001B51: 05 DEFB 05h ; Class-06 - A numeric expression must follow. +00001B52: CC 06 DEFW 06CCh ; INK + +;; P-PAPER +00001B54: 05 DEFB 05h ; Class-06 - A numeric expression must follow. +00001B55: D9 06 DEFW 06D9h ; PAPER + +;; P-BORDER +00001B57: 05 DEFB 05h ; Class-06 - A numeric expression must follow. +00001B58: E4 06 DEFW 06E4h ; BORDER + +;; P-COPY +00001B5A: 06 DEFB 06h ; Class-00 - No further operands. +00001B5B: C3 1C DEFW 1CC3h ; COPY + + +00001B5D: 06 DEFB 06h ; Class-00 - No further operands. +00001B5E: 65 07 DEFW 0765h ; { res 5,(CDFLAG) } -> BEEP/NOBEEP ? + +00001B60: 06 DEFB 06h ; Class-00 - No further operands. +00001B61: 6A 07 DEFW 076Ah ; { set 5,(CDFLAG) } -> BEEP/NOBEEP ? + + +;; P-NEW +00001B63: 06 DEFB 06h ; Class-00 - No further operands. +00001B64: 20 0F DEFW 0F20h ; NEW + +;; P-CLS +00001B66: 06 DEFB 06h ; Class-00 - No further operands. +00001B67: 7D 1C DEFW 1C7Dh ; CLS + +;; P-PAUSE +00001B69: 06 DEFB 06h ; Class-00 - No further operands. +00001B6A: 5E 0D DEFW 0D5Eh ; PAUSE + +;; P-SLOW +00001B6C: 06 DEFB 06h ; Class-00 - No further operands. +00001B6D: A5 12 DEFW 12A5h ; SLOW + +;; P-CONT +00001B6F: 06 DEFB 06h ; Class-00 - No further operands. +00001B70: 0E 15 DEFW 150Eh ; CONT + +;; P-SCROLL +00001B72: 06 DEFB 06h ; Class-00 - No further operands. +00001B73: 5E 1C DEFW 1C5Eh ; SCROLL + +00001B75: 06 DEFB 06h ; Class-00 - No further operands. +00001B76: 3C 14 DEFW 143Ch ; CLEAR + +00001B78: 06 DEFB 06h ; Class-00 - No further operands. +00001B79: 1D 15 DEFW 151Dh ; RETURN + +00001B7B: 06 DEFB 06h ; Class-00 - No further operands. +00001B7C: 0B 14 DEFW 140Bh ; + +00001B7E: 07 DEFB 07h ; +00001B7F: 46 0A DEFW 0A46h ; + +00001B81: 07 DEFB 07h ; +00001B82: 4A 0A DEFW 0A4Ah ; + +00001B84: 07 DEFB 07h ; +00001B85: D6 00 DEFW 00D6h ; "ret" ? + +00001B87: 07 DEFB 07h ; +00001B88: 15 11 DEFW 1115h ; dim? + + + +; ---------------------------------------------- +; THE 'PREPARE TO MULTIPLY OR DIVIDE' SUBROUTINE +; ---------------------------------------------- +; this routine is called twice from multiplication and twice from division +; to prepare each of the two numbers for the operation. +; Initially the accumulator holds zero and after the second invocation bit 7 +; of the accumulator will be the sign bit of the result. + +00001B8A: AF XOR A + +;; PREP-M/D +00001B8B: 34 INC (HL) ; test exponent +00001B8C: 35 DEC (HL) ; for zero +00001B8D: 37 SCF ; set carry flag to signal number is zero. +00001B8E: C8 RET Z ; return if zero with carry flag set. + +00001B8F: 23 INC HL ; address first mantissa byte. +00001B90: AE XOR (HL) ; exclusive or the running sign bit. +00001B91: CB FE SET 7,(HL) ; set the implied bit. +00001B93: 2B DEC HL ; point to exponent byte. +00001B94: C9 RET ; return. + +;; LOC-MEM +00001B95: 2A 1F 40 LD HL,(401Fh) ; MEM +00001B98: 4F LD C,A +00001B99: 06 00 LD B,00h +00001B9B: 09 ADD HL,BC +00001B9C: C9 RET + + + +;---------------------- +; THE 'ARCTAN' FUNCTION +;---------------------- +; (Offset $??: 'atn') +; the inverse tangent function with the result in radians. +; This is a fundamental transcendental function from which others such as asn +; and acs are directly, or indirectly, derived. +; It uses the series generator to produce Chebyshev polynomials. + +;; atn +00001B9D: 7E LD A,(HL) +00001B9E: FE 81 CP 81h +00001BA0: 38 0E JR C,+0Eh + +00001BA2: F7 RST 30h ; FP-CALC +00001BA3: 79 ;;stk-one +00001BA4: 33 ;;exchange +00001BA5: 20 ;;division +00001BA6: 09 ;;negate +00001BA7: 01 ;;duplicate +00001BA8: 70 ;;stk-pi/2 +00001BA9: 33 ;;exchange +00001BAA: 03 ;;not +00001BAB: 34 ;;jump-true +00001BAC: 06 ; to 1BB2h, CASES + +00001BAd: 09 ;;negate +00001BAE: 04 ;;jump +00001BAF: 03 ;; to 1BB2h, CASES + + +; --- + +;; SMALL + +00001BB0: F7 RST 30h ; FP-CALC +00001BB1: 7A ;;stk-zero + +;; CASES +00001BB2: 33 ;;exchange +00001BB3: 01 ;;duplicate +00001BB4: 01 ;;duplicate +00001BB5: 1F ;;multiply +00001BB6: 01 ;;duplicate +00001BB7: 2A ;;addition +00001BB7: 79 ;;stk-one +00001BB9: 1E ;;subtract +00001BB9: 6C ;;series-0C +00001BBB: 10 ;;Exponent: $60, Bytes: 1 +00001BBB: B2 ;;(+00,+00,+00) +00001BBD: 13 ;;Exponent: $63, Bytes: 1 +00001BBE: 0E ;;(+00,+00,+00) +00001BBF: 55 ;;Exponent: $65, Bytes: 2 +00001BC0: E4 8D ;;(+00,+00) +00001BC2: 58 ;;Exponent: $68, Bytes: 2 +00001BC3: 39 BC ;;(+00,+00) +00001BC5: 5B ;;Exponent: $6B, Bytes: 2 +00001BC6: 98 FD ;;(+00,+00) +00001BC8: 9E ;;Exponent: $6E, Bytes: 3 +00001BC9: 00 36 75 ;;(+00) +00001BCC: A0 ;;Exponent: $70, Bytes: 3 +00001BCD: DB E8 B4 ;;(+00) +00001BD0: 63 ;;Exponent: $73, Bytes: 2 +00001BD1: 42 C4 ;;(+00,+00) +00001BD3: E6 ;;Exponent: $76, Bytes: 4 +00001BD4: B5 09 36 BE +00001BD8: E9 ;;Exponent: $79, Bytes: 4 +00001BD9: 36 73 1B 5D +00001BDD: EC ;;Exponent: $7C, Bytes: 4 +00001BDE: D8 DE 63 BE +00001BE2: F0 ;;Exponent: $80, Bytes: 4 +00001BE3: 61 A1 B3 0C +00001BE7: 1F ;;multiply +00001BE8: AA ;;addition & end-calc +00001BE9: C9 RET + +; --------------------------- +; THE 'PAUSE' COMMAND ROUTINE +; --------------------------- + +;; PAUSE +00001BEA: CD 09 15 CALL 1509h ; FIND-INT +00001BED: 21 3B 40 LD HL,403Bh ; CDFLAG +00001BF0: CB 7E BIT 7,(HL) +00001BF2: 20 0D JR NZ,+0Dh ; indirectly to DEBOUNCE + +00001BF4: ED 43 34 40 LD (4034h),BC ; FRAMES +00001BF8: CD B6 12 CALL 12B6h +00001BFB: FD CB 35 FE SET 7,(IY+35h) + +00001BFF: 18 2C JR +2Ch ; indirectly to DEBOUNCE +00001C01: 78 LD A,B +00001C02: E6 80 AND 80h +00001C04: 57 LD D,A +00001C05: CB F8 SET 7,B +00001C07: ED 43 34 40 LD (4034h),BC ; FRAMES +00001C0B: 78 LD A,B +00001C0C: 17 RLA +00001C0D: B1 OR C +00001C0E: B2 OR D +00001C0F: C8 RET Z +00001C10: ED 4B 34 40 LD BC,(4034h) ; FRAMES +00001C14: CB 46 BIT 0,(HL) +00001C16: 28 F3 JR Z,-0Dh +00001C18: 18 13 JR +13h + +00001C1A: 46 LD B,(HL) +00001C1B: 23 INC HL +00001C1C: 4E LD C,(HL) +00001C1D: 23 INC HL +00001C1E: ED 43 36 40 LD (4036h),BC ; LAMBDA-VAR +00001C22: 5E LD E,(HL) +00001C23: 23 INC HL +00001C24: 56 LD D,(HL) +00001C25: 23 INC HL +00001C26: EB EX DE,HL +00001C27: 19 ADD HL,DE + + +;----------------------- +; THE 'BREAK' SUBROUTINE +;----------------------- +; +; + +;; BREAK-1 +00001C28: 3E 7F LD A,7Fh ; read port $7FFE - keys B,N,M,.,SPACE. +00001C2A: DB FE INA (FEh) +00001C2C: 0F RRCA ; carry will be set if space not pressed. + + +;-------------------------- +; THE 'DEBOUNCE' SUBROUTINE +;-------------------------- +; +; + +;; DEBOUNCE +00001C2D: 3E 0F LD A,0Fh +00001C2F: 32 27 40 LD (4027h),A ; DEBOUNCE +00001C32: FD CB 3B 86 RES 0,(IY+3Bh) ; CDFLAG +00001C36: C9 RET + + +;------------------------- +; THE 'TABLE OF CONSTANTS' +;------------------------- +; The ZX81 (and Lambda ?) have only floating-point number representation. +; Both the ZX80 and the ZX Spectrum have integer numbers in some form. + +;; stk-pi/2 81 49 0F DA A2 +00001C37: + DEFB $F1 ;;Exponent: $81, Bytes: 4 + DEFB $49,$0F,$DA,$A2 ;; + +;; stk-half 80 00 00 00 00 +00001C3C: + DEFB $30 ;;Exponent: $80, Bytes: 1 + DEFB $00 ;;(+00,+00,+00) + +;; stk-ten 84 20 00 00 00 +00001C3E: + DEFB $34 ;;Exponent: $84, Bytes: 1 + DEFB $20 ;;(+00,+00,+00) + +;; stk-one 81 00 00 00 00 +00001C40: + DEFB $31 ;;Exponent $81, Bytes: 1 + ;; (the following byte matters: DEFB $00) ;;(+00,+00,+00) + +;; stk-zero 00 00 00 00 00 +00001C41: + DEFB $00 ;;Bytes: 1 + DEFB $B0 ;;Exponent $00 + DEFB $00 ;;(+00,+00,+00) + +;; INT-TO-FP +00001C44: F5 PUSH AF +00001C45: F7 RST 30h ; FP-CALC +00001C46: FA F1 CD JP M,CDF1h +00001C49: 75 LD (HL),L +00001C4A: 07 RLCA +00001C4B: D8 RET C +00001C4C: F7 RST 30h ; FP-CALC +00001C4D: 33 INC SP +00001C4E: 77 ;;stk-ten +00001C4F: 1F ;;multiply +00001C50: AA XOR D +00001C51: CF RST 08h ; NEXT-CHAR +00001C52: 18 F4 JR -0Ch + +; ---------------------- +; THE 'ALPHA' SUBROUTINE +; ---------------------- + +;; ALPHA +00001C54: FE 26 CP 26h + +;; ALPHA-2 +00001C56: 3F CCF +00001C57: D8 RET C +00001C58: FE 1C CP 1Ch +00001C5A: D8 RET C +00001C5B: D6 1C SUB 1Ch +00001C5D: C9 RET + +;; SCROLL +00001C5E: 21 9F 40 LD HL,409Fh ; D-FILE + 1 + 33 +00001C61: 11 7E 40 LD DE,407Eh ; D-FILE + 1 +00001C64: 01 F6 02 LD BC,02F6h +00001C67: ED B0 LDIR +00001C69: 21 A0 20 LD HL,20A0h ; ATTR + 1 + 33 +00001C6C: 11 7F 20 LD DE,207Fh ; ATTR + 1 +00001C6F: 01 F6 02 LD BC,02F6h +00001C72: ED B0 LDIR +00001C74: FD 46 22 LD B,(IY+22h) ; DF_SZ +00001C77: 04 INC B +00001C78: 18 05 JR +05h + + + +00001C7A: CD 57 1D CALL 1D57h ; routine CLEAR-PRB + +;-------------------------- +; THE 'CLS' COMMAND ROUTINE +;-------------------------- +; +; + +;; CLS +00001C7D: 06 18 LD B,18h + +;; B-LINES +00001C7F: C5 PUSH BC +00001C80: CD 91 14 CALL 1491h ; LOC-ADDR for current row +00001C83: C1 POP BC +00001C84: AF XOR A +00001C85: 32 7C 40 LD (407Ch),A +00001C88: 32 1E 40 LD (401Eh),A ; BREG/FLAGS +00001C8B: 5D LD E,L +00001C8C: 7C LD A,H +00001C8D: D6 20 SUB 20h +00001C8F: 57 LD D,A +00001C90: 13 INC DE +00001C91: 3A 08 40 LD A,(4008h) ; ATTR-P +00001C94: 0E 20 LD C,20h +00001C96: 36 00 LD (HL),00h +00001C98: 12 LD (DE),A +00001C99: 23 INC HL +00001C9A: 13 INC DE +00001C9B: 0D DEC C +00001C9C: 20 F8 JR NZ,-08h +00001C9E: 36 76 LD (HL),76h +00001CA0: 23 INC HL +00001CA1: 13 INC DE +00001CA2: 10 F0 DJNZ -10h +00001CA4: C9 RET + +;------------------------------------- +; Swap first number with second number +;------------------------------------- +; This routine exchanges the last two values on the calculator stack +; On entry, as always with binary operations, +; HL=first number, DE=second number +; On exit, HL=result, DE=stkend. + +;; exchange +00001CA5: 06 05 LD B,05h +00001CA7: 4E LD C,(HL) +00001CA8: 1A LD A,(DE) +00001CA9: 77 LD (HL),A +00001CAA: 79 LD A,C +00001CAB: 12 LD (DE),A +00001CAC: 13 INC DE +00001CAD: 23 INC HL +00001CAE: 10 F7 DJNZ -09h +00001CB0: C9 RET + +;--------------------------- +; THE 'MAKE ROOM' SUBROUTINE +;--------------------------- +; +; + +;; MAKE-ROOM plus 4 +00001CB1: 03 INC BC +00001CB2: 03 INC BC +00001CB3: 03 INC BC +00001CB4: 03 INC BC + +;; MAKE-ROOM +00001CB5: CD F5 13 CALL 13F5h ; routine TEST-ROOM +00001CB8: CD 3F 1A CALL 1A3Fh ; routine POINTERS +00001CBB: 03 INC BC +00001CBC: 2A 1C 40 LD HL,(401Ch) ; STKEND +00001CBF: EB EX DE,HL +00001CC0: ED B8 LDDR +00001CC2: C9 RET + +; THE 'COPY' COMMAND ROUTINE +;--------------------------- +; The full character-mapped screen is copied to the Printer. + +;; COPY +00001CC3: 21 7E 40 LD HL,407Eh ; D-FILE + 1 +00001CC6: 06 16 LD B,16h ; prepare to copy twenty four text lines. +00001CC8: 18 2C JR +2Ch + +00001CCA: 3A 38 40 LD A,(4038h) ; PR_CC +00001CCD: FE 3C CP 3Ch +00001CCF: C8 RET Z + +00001CD0: 3E 76 LD A,76h +;; LPRINT-CH +00001CD2: 4F LD C,A +00001CD3: DB FB INA (FBh) +00001CD5: 17 RLA +00001CD6: FD A6 06 AND (IY+06h) ; editor MODE +00001CD9: 79 LD A,C +00001CDA: FA F7 1D JP M,1DF7h + +00001CDD: FE 76 CP 76h +00001CDF: 28 10 JR Z,+10h ; to COPY-BUFF + +00001CE1: FD 6E 38 LD L,(IY+38h) ; PR_CC +00001CE4: 26 40 LD H,40h +00001CE6: 3E 5B LD A,5Bh +00001CE8: BD CP L +00001CE9: DC F1 1C CALL C,1CF1h ; routine COPY-BUFF +00001CEC: 71 LD (HL),C +00001CED: FD 34 38 INC (IY+38h) ; PR_CC +00001CF0: C9 RET + +;; COPY-BUFF +00001CF1: 21 3C 40 LD HL,403Ch ; set HL to start of printer buffer PRBUFF. + +00001CF4: 06 01 LD B,01h +00001CF6: DB FB INA (FBh) +00001CF8: CB 77 BIT 6,A +00001CFA: 20 71 JR NZ,+71h +00001CFC: CD 62 0D CALL 0D62h ; routine SET-FAST +00001CFF: AF XOR A +00001D00: 57 LD D,A +00001D01: E5 PUSH HL +00001D02: D3 FB OUTA (FBh) +00001D04: E1 POP HL +00001D05: CD 28 1C CALL 1C28h ; routine BREAK-1 test for BREAK key. +00001D08: 30 5E JR NC,+5Eh + +; --- + +;; COPY-CONT +00001D0A: DB FB INA (FBh) ; read from printer port. +00001D0C: 17 RLA ; test bit 7 +00001D0D: 30 F6 JR NC,-0Ah + +00001D0F: 78 LD A,B ; text line count to A? +00001D10: D6 02 SUB 02h ; check if last line. +00001D12: 9F SBC A ; now $FF if last line else zero. + +00001D13: E5 PUSH HL ; preserve the character ptr + + +; now cleverly prepare a printer control mask setting bit 2 (later moved to 1) +; of E to slow printer for the last two pixel lines ( D = 6 and 7) + +00001D14: A2 AND D ; and with pixel line offset 0-7 +00001D15: 07 RLCA ; shift to left. +00001D16: A2 AND D ; and again. +00001D17: 5F LD E,A ; store control mask in E. + +00001D18: C5 PUSH BC +00001D19: 06 08 LD B,08h + +;; COPY-NEXT +00001D1B: 7E LD A,(HL) ; load character from screen or buffer. +00001D1C: 23 INC HL +00001D1D: FE 76 CP 76h ; is character a NEWLINE ? +00001D1F: 28 1D JR Z,+1Dh ; forward, if so, to COPY-N/L + +00001D21: D3 F6 OUTA (F6h) ; select charset char number (00..3F) +00001D23: 17 RLA +00001D24: 7A LD A,D +00001D25: D3 F5 OUTA (F5h) ; select charset line number (00..07) +00001D27: DB F6 INA (F6h) ; read selected charset data (8 pixels) +00001D29: 4F LD C,A +00001D2A: 9F SBC A +00001D2B: A9 XOR C +00001D2C: 4F LD C,A + +;; COPY-BITS +00001D2D: CB 11 RL C +00001D2F: 7B LD A,E +00001D30: 1F RRA +00001D31: 08 EX AF,AF' + +;; COPY-WAIT +00001D32: DB FB INA (FBh) ; read the printer port +00001D34: 0F RRCA ; test for alignment signal from encoder. +00001D35: 30 FB JR NC,-05h ; loop if not present to COPY-WAIT + +00001D37: 08 EX AF,AF' +00001D38: D3 FB OUTA (FBh) +00001D3A: 10 F1 DJNZ -0Fh ; loop for all eight bits to COPY-BITS + +00001D3C: 18 DB JR -25h ; back for adjacent character line to COPY-NEXT +00001D3E: C1 POP BC + + +; --- + +; A NEWLINE has been encountered either following a text line or as the +; first character of the screen or printer line. + +00001D3F: DB FB INA (FBh) +00001D41: 0F RRCA +00001D42: 30 FB JR NC,-05h +00001D44: 7B LD A,E +00001D45: 0F RRCA +00001D46: D3 FB OUTA (FBh) +00001D48: 14 INC D +00001D49: CB 5A BIT 3,D +00001D4B: 28 B7 JR Z,-49h + +; eight pixel lines, a text line have been completed. + +00001D4D: D1 POP DE +00001D4E: 10 AF DJNZ -51h ; decrease text line count and back if not zero to COPY-LOOP +00001D50: 3E 0F LD A,0Fh +00001D52: D3 FB OUTA (FBh) + +;; COPY-END +00001D54: CD A9 12 CALL 12A9h ; routine SLOW/FAST + + +;-------------------------------------- +; THE 'CLEAR PRINTER BUFFER' SUBROUTINE +;-------------------------------------- +; This subroutine sets 32 bytes of the printer buffer to zero (space) and +; the 33rd character is set to a NEWLINE. +; This occurs after the printer buffer is sent to the printer but in addition +; after the 24 lines of the screen are sent to the printer. +; Note. This is a logic error as the last operation does not involve the +; buffer at all. Logically one should be able to use +; 10 LPRINT "HELLO "; +; 20 COPY +; 30 LPRINT ; "WORLD" +; and expect to see the entire greeting emerge from the printer. +; Surprisingly this logic error was never discovered and although one can argue +; if the above is a bug, the repetition of this error on the Spectrum was most +; definitely a bug. +; Since the printer buffer is fixed at the end of the system variables, and +; the print position is in the range $3C - $5C, then bit 7 of the system +; variable is set to show the buffer is empty and automatically reset when +; the variable is updated with any print position - neat. + +;; CLEAR-PRB +00001D57: 06 20 LD B,20h +00001D59: 21 5C 40 LD HL,405Ch ; address fixed end of PRBUFF +00001D5C: 36 76 LD (HL),76h ; place a newline at last position. + +;; PRB-BYTES +00001D5E: 2B DEC HL ; decrement address +00001D5F: 36 00 LD (HL),00h ; place a zero byte +00001D61: 10 FB DJNZ -05h ; loop for all thirty-two to PRB-BYTES +00001D63: 7D LD A,L +00001D64: 32 38 40 LD (4038h),A ; update one-byte system variable PR_CC +00001D67: C9 RET + + +00001D68: D3 FB OUTA (FBh) ; stop ZX printer motor, de-activate sylus. +00001D6A: C3 E4 19 JP 19E4h ; REPORT-D (BREAK error msg) + +00001D6D: FD CB 06 7E BIT 7,(IY+06h) ; editor MODE +00001D71: 20 49 JR NZ,+49h +00001D73: C5 PUSH BC +00001D74: E5 PUSH HL +00001D75: 21 64 1E LD HL,1E64h +00001D78: 06 07 LD B,07h +00001D7A: CD 59 1E CALL 1E59h +00001D7D: E1 POP HL +00001D7E: 5E LD E,(HL) +00001D7F: 23 INC HL +00001D80: E5 PUSH HL +00001D81: CB 73 BIT 6,E +00001D83: 20 29 JR NZ,+29h +00001D85: 26 08 LD H,08h +00001D87: 0E 07 LD C,07h +00001D89: 7B LD A,E +00001D8A: FD CB 3B 7E BIT 7,(IY+3Bh) ; CDFLAG +00001D8E: 28 01 JR Z,+01h +00001D90: 76 HALT +00001D91: D3 F6 OUTA (F6h) ; select charset char number (00..3F) +00001D93: 79 LD A,C +00001D94: D3 F5 OUTA (F5h) ; select charset line number (00..07) +00001D96: DB F6 INA (F6h) ; read selected charset data (8 pixels) +00001D98: 44 LD B,H +00001D99: 1F RRA +00001D9A: 10 FD DJNZ -03h +00001D9C: CB 1D RR L +00001D9E: 0D DEC C +00001D9F: F2 89 1D JP P,1D89h +00001DA2: 7B LD A,E +00001DA3: 17 RLA +00001DA4: 9F SBC A +00001DA5: AD XOR L +00001DA6: CD E4 1D CALL 1DE4h +00001DA9: 25 DEC H +00001DAA: 20 DB JR NZ,-25h +00001DAC: 18 CF JR -31h +00001DAE: 21 61 1E LD HL,1E61h +00001DB1: 06 03 LD B,03h +00001DB3: CD 59 1E CALL 1E59h +00001DB6: E1 POP HL +00001DB7: C1 POP BC +00001DB8: 10 B9 DJNZ -47h +00001DBA: 18 9B JR -65h +00001DBC: FD CB 06 B6 RES 6,(IY+06h) ; editor MODE +00001DC0: 7E LD A,(HL) +00001DC1: E5 PUSH HL +00001DC2: 4F LD C,A +00001DC3: CD E1 1D CALL 1DE1h +00001DC6: E1 POP HL +00001DC7: 7E LD A,(HL) +00001DC8: 23 INC HL +00001DC9: FE 76 CP 76h +00001DCB: 20 F3 JR NZ,-0Dh +00001DCD: 10 F1 DJNZ -0Fh +00001DCF: 18 86 JR -7Ah +00001DD1: CB 76 BIT 6,(HL) +00001DD3: CB B6 RES 6,(HL) +00001DD5: 28 0A JR Z,+0Ah +00001DD7: FE 20 CP 20h +00001DD9: 38 09 JR C,+09h +00001DDB: 3E 27 LD A,27h +00001DDD: CD E4 1D CALL 1DE4h +00001DE0: 79 LD A,C +00001DE1: CD 04 1E CALL 1E04h + +00001DE4: F5 PUSH AF +00001DE5: CD 28 1C CALL 1C28h ; routine BREAK-1 test for BREAK key. +00001DE8: 30 80 JR NC,-80h +00001DEA: DB FB INA (FBh) +00001DEC: CB 6F BIT 5,A +00001DEE: 20 03 JR NZ,+03h +00001DF0: 17 RLA +00001DF1: 38 F2 JR C,-0Eh +00001DF3: F1 POP AF +00001DF4: D3 FB OUTA (FBh) +00001DF6: C9 RET + +00001DF7: FD 34 38 INC (IY+38h) ; PR_CC +00001DFA: 21 06 40 LD HL,4006h ; editor MODE +00001DFD: FE 88 CP 88h +00001DFF: 20 D0 JR NZ,-30h +00001E01: CB F6 SET 6,(HL) +00001E03: C9 RET + +00001E04: FE 76 CP 76h +00001E06: 20 0C JR NZ,+0Ch +00001E08: 3E 0D LD A,0Dh +00001E0A: CD E4 1D CALL 1DE4h +00001E0D: FD 36 38 3C LD (IY+38h),3Ch ; PR_CC <- activate printer +00001E11: 3E 0A LD A,0Ah +00001E13: C9 RET + +00001E14: E6 3F AND 3Fh +00001E16: FE 26 CP 26h +00001E18: 38 08 JR C,+08h +00001E1A: C6 1B ADD 1Bh +00001E1C: CB 79 BIT 7,C +00001E1E: C8 RET Z +00001E1F: C6 20 ADD 20h +00001E21: C9 RET + +00001E22: FE 1C CP 1Ch +00001E24: 38 03 JR C,+03h + +00001E26: C6 14 ADD 14h ; 20 +00001E28: C9 RET + +00001E29: 5F LD E,A +00001E2A: 16 00 LD D,00h +00001E2C: 21 3D 1E LD HL,1E3Dh +00001E2F: 19 ADD HL,DE +00001E30: 79 LD A,C +00001E31: FE 81 CP 81h +00001E33: 38 03 JR C,+03h +00001E35: FE 86 CP 86h +00001E37: 3F CCF +00001E38: 7E LD A,(HL) +00001E39: D8 RET C +00001E3A: C6 20 ADD 20h +00001E3C: C9 RET + +00001E3D: 20 5B JR NZ,+5Bh +00001E3F: 5C LD E,H +00001E40: 5D LD E,L +00001E41: 5E LD E,(HL) +00001E42: 40 LD B,B +00001E43: 5F LD E,A +00001E44: 26 27 LD H,27h +00001E46: 23 INC HL +00001E47: 21 22 25 LD HL,2522h +00001E4A: 24 INC H +00001E4B: 3A 3F 28 LD A,(283Fh) +00001E4E: 29 ADD HL,HL +00001E4F: 3E 3C LD A,3Ch +00001E51: 3D DEC A +00001E52: 2B DEC HL +00001E53: 2D DEC L +00001E54: 2A 2F 3B LD HL,(3B2Fh) +00001E57: 2C INC L +00001E58: 2E 7E LD L,7Eh +00001E5A: CD E4 1D CALL 1DE4h +00001E5D: 23 INC HL +00001E5E: 10 F9 DJNZ -07h +00001E60: C9 RET + +00001E61: db 0A, 1B, 32 +00001E64: db 1B, 41, 08, 1B, 4B, 00, 01 + + +00001E6B: db FF... +(...) +00001FFF: db ..FF + diff --git a/tests/restricted/marlinprep.asm b/tests/restricted/marlinprep.asm new file mode 100644 index 00000000..554f14f5 --- /dev/null +++ b/tests/restricted/marlinprep.asm @@ -0,0 +1,26943 @@ + +; +; MZ 811 Basic Source Listing +; ------------------------------ +; + +; Default mode build (also MZ-1500): +; z88dk-z80asm -b -m mz-5z009.asm + +; "It is a common misunderstanding that MZ-800 and MZ-1500 are almost identical. +; MZ-1500 is not just a Japanese version of MZ-800. They are both based on MZ-700 architecture but differently extended. +; MZ-1500 does not have 640x200/320x200 bitmap screen but has 8-color PCG screen (1024 PCGs consist 320x200 screen). +; MZ-1500 has two SN76489 while MZ-800 has one. Etc. " +; PLE mode build (6 channels sound): +; z88dk-z80asm -b -m -DSYS mz-5z009.asm + + +; V1.0B+ MODIFIED versions +; 64 KB +; z88dk-z80asm -b -m -DRAMDISK mz-5z009.asm +; +; PILSOFT MOD, 20.02.89: 64 KB, IO EC~EF +; z88dk-z80asm -b -m -DRAMDISK -DALTFN -DMOD_B mz-5z009.asm + +; RS232 mode: +; (default): MZ-700, MZ-1500 +; -DRSYS : MZ-800 + + + +; Section address +; ------------------------------------- +; MON1 0000 +; MON2 0FF0 +; MON3 142B +; MON-IOCS 1800 +; XWORK 2000 +; H-QD 2FD0 +; H-CMT 375A +; H-FD 3B9E +; MON4 3C00 +; MON-RS 3C64 +; MON-EMM 3EC6 +; MON-PSG 404A +; MON-GRPH 453A +; XSYS 5800 +; MONEQU 5800 +; BASIC 5800 +; STMNT 650D +; IOCS 6C81 +; GRPH 7590 +; CONV 797A +; EDIT 8216 +; EXPR 853D +; FLOAT 909E +; MUSIC 9BAC +; WORKQ 9E4B +; PLT 9FCE +; ------------------------------------- +; + + + + +;defc IOOUT = 0104H +;defc DEASC = 029EH +;defc PATCH = 0531H +;defc INKEY0 = 0BA1H +;defc IOERR = 00EBH +;defc TEST1 = 0164H +;defc ERRX = 0340H +;defc COLS = 049CH +;defc HCLSW = 061DH +;defc PONT = 0963H +;defc INKEY1 = 0B21H +;defc _KB = 0DF6H +;defc _HL = 00A7H +;defc PUSHR = 00C7H +;defc SETDFL = 0314H +;defc BINPUT = 0A67H +;defc PUSHRA = 00BAH +;defc CKHEX = 02E9H +;defc DCOLOR = 048AH +;defc PONTB = 097AH +;defc ERRORJ = 00EDH +;defc CLRHL = 0137H +;defc SETDE = 013EH +;defc INDRCT = 0151H +;defc INCHLF = 015DH +;defc IOCALL = 0247H +;defc DWIDTH = 04EFH +;defc ACCDI = 05ADH +;defc LBOUND = 05F9H +;defc PONTC = 0960H +;defc INKEY_ = 0B1AH +;defc BRKCHK = 001EH +;defc DEVASC = 010DH +;defc DWIND = 04AEH +;defc PONTCB = 0977H +;defc INKEYF = 0B8BH +;defc SYSSTA = 004DH +;defc PUSHW = 0671H +;defc HCUROF = 093BH +;defc TESTX = 016EH +;defc PALOFF = 0441H +;defc DPALST = 0476H +;defc PRNTT = 0A58H +;defc EQTBL = 0DDDH +;defc _TEMPO = 0041H +;defc __RET = 00B2H +;defc CLRDE = 013DH +;defc HLFTCH = 015EH +;defc HALT = 02F8H +;defc ADDP0 = 031CH +;defc DGCOL = 0493H +;defc TBCALC = 0615H +;defc ERRORP = 004FH +;defc LDDEMD = 0132H +;defc ADDP1 = 0323H +;defc HCLS = 0652H +;defc NOTXT = 00A6H +;defc ASCHL = 025EH +;defc ADDP2 = 032AH +;defc SETDNM = 0397H +;defc PLTOTX = 0EB3H +;defc DSMODE = 03BEH +;defc CURMOV = 094DH +;defc GETL = 0A84H +;defc BREAKX = 00E6H +;defc CHKACC = 011BH +;defc LDDEHL = 0143H +;defc LDHLDE = 014AH +;defc BITMAP = 05CEH +;defc BRKEY = 0D22H +;defc _CRT = 0DDDH +;defc CRT1C = 0E61H +;defc ADDHLA = 0158H +;defc DEHEX = 02CEH +;defc DPALBK = 044FH +;defc FLASH = 0945H +;defc _USR = 0F7FH +;defc BREAKZ = 00E8H +;defc LDDEMI = 012DH +;defc SETHL = 0138H +;defc HCURON = 092BH + +;defc _IOSVC = 0003H +;defc _MONOP = 0000H +;defc _CR1 = 0001H +;defc _CR2 = 0002H +;defc _CRT1C = 0003H +;defc _CRT1X = 0004H +;defc _CRTMS = 0005H +;defc _LPTOT = 0006H +;defc _LPT1C = 0007H +;defc _CR = 0008H +;defc _1C = 0009H +;defc _1CX = 000AH +;defc _MSG = 000BH +;defc _GETL = 000CH +;defc _INKEY = 000DH +;defc _BREAK = 000EH +;defc _HALT = 000FH +;defc _DI = 0010H +;defc _EI = 0011H +;defc _CURMV = 0012H +;defc _DEASC = 0013H +;defc _DEHEX = 0014H +;defc _CKHEX = 0015H +;defc _ASCHL = 0016H +;defc _COUNT = 0017H +;defc _ADDP0 = 0018H +;defc _ADDP1 = 0019H +;defc _ADDP2 = 001AH +;defc _ERRX = 001BH +;defc _DACN = 001CH +;defc _ADCN = 001DH +;defc _STICK = 001EH +;defc _STRIG = 001FH +;defc _BELL = 0020H +;defc _PLAY = 0021H +;defc _SOUND = 0022H +;defc _MCTRL = 0023H +;defc _IOOUT = 0024H +;defc _TIMRD = 0025H +;defc _TIMST = 0026H +;defc _INP1C = 0027H +;defc _CLRIO = 0028H +;defc _SEGAD = 0029H +;defc _OPSEG = 002AH +;defc _DLSEG = 002BH +;defc _DEVNM = 002CH +;defc _DEVFN = 002DH +;defc _LUCHK = 002EH +;defc _LOPEN = 002FH +;defc _LOADF = 0030H +;defc _SAVEF = 0031H +;defc _VRFYF = 0032H +;defc _RWOPN = 0033H +;defc _INSTT = 0034H +;defc _INMSG = 0035H +;defc _INDAT = 0036H +;defc _PRSTR = 0037H +;defc _CLKL = 0038H +;defc _DIR = 0039H +;defc _SETDF = 003AH +;defc _LSALL = 003BH +;defc _FINIT = 003CH +;defc _DELET = 003DH +;defc _RENAM = 003EH +;defc _LOCK = 003FH +;defc _RECST = 0040H +;defc _INREC = 0041H +;defc _PRREC = 0042H +;defc _ERCVR = 0043H +;defc _SWAP = 0044H +;defc _CLS = 0045H +;defc _POSCK = 0046H +;defc _POSSV = 0047H +;defc _PSET = 0048H +;defc _LINE = 0049H +;defc _PATTR = 004AH +;defc _BOX = 004BH +;defc _PAINT = 004CH +;defc _CIRCL = 004DH +;defc _POINT = 004EH +;defc _HCPY = 004FH +;defc _DSMOD = 0050H +;defc _DPLBK = 0051H +;defc _DPLST = 0052H +;defc _DWIND = 0053H +;defc _DCOL = 0054H +;defc _DGCOL = 0055H +;defc _ICRT = 0056H +;defc _SYMBL = 0057H +;defc ZWRK2 = 1049H +;defc ZWO = 1057H +;defc ZWDIR = 1063H +;defc VARST = 1074H +;defc STRST = 1076H +;defc INPFLG = 108FH +;defc LPOSB = 1095H +;defc INBUFL = 1353H +;defc YW = 1371H +;defc ZKL = 105BH +;defc ZINP = 105DH +;defc ELMD = 1000H +;defc ZOUT = 105FH +;defc __LPT = 106EH +;defc VARED = 1078H +;defc CURX = 1082H +;defc POINTX = 1088H +;defc KEYDAT = 1365H +;defc SELCOL = 137BH +;defc PALAD = 137FH +;defc ELMD1 = 1001H +;defc ZBLK = 105BH +;defc ZDELT = 1061H +;defc DDEV = 106AH +;defc POOLED = 1074H +;defc CURY = 1083H +;defc POINTY = 108AH +;defc CURFLG = 108CH +;defc CURMAK = 108DH +;defc FILOUT = 1091H +;defc PNMODE = 1097H +;defc CPLANE = 109CH +;defc KEY262 = 12AAH +;defc CWIDTH = 136BH +;defc PAL2T = 1385H +;defc CURDT1 = 1391H +;defc PBCN = 13CEH +;defc ELMD20 = 1014H +;defc ZEQT = 1044H +;defc ZEOF = 1047H +;defc ZNXT = 104AH +;defc ZDEVNM = 104CH +;defc PSEL = 1092H +;defc INBUF = 1354H +;defc CURDT2 = 1399H +;defc ELMD30 = 101EH +;defc ZCH = 1046H +;defc ZFLAG1 = 1050H +;defc INTFAC = 107CH +;defc MEMMAX = 1080H +;defc DMD = 1098H +;defc KEY264 = 12ACH +;defc LINLIM = 1364H +;defc PAL4T = 1389H +;defc CURDT3 = 13A1H +;defc ELMD22 = 1016H +;defc ZFLAG2 = 1051H +;defc BITADR = 1086H +;defc TMCNT = 1195H +;defc KEYBUF = 11A4H +;defc FUNBUF = 12B2H +;defc ELMD32 = 1020H +;defc ZSTRT = 1059H +;defc PCRLF = 1093H +;defc KEY266 = 12AEH +;defc INBUFC = 1352H +;defc SSA = 1375H +;defc HERRF = 13D9H +;defc ELMD24 = 1018H +;defc TMPEND = 107AH +;defc DISPX = 1090H +;defc CMODE = 109BH +;defc SOF = 1372H +;defc PAL16T = 138DH +;defc EMPTR = 13C4H +;defc ZCL = 1059H +;defc POSADR = 1084H +;defc KEYBM1 = 11A3H +;defc SEA = 1376H +;defc EMWP0 = 13C6H +;defc ELMD26 = 101AH +;defc ZMAPB = 1057H +;defc POOL = 1072H +;defc SW = 1374H +;defc PAIWED = 137CH +;defc PALBK = 137EH +;defc SCRNT0 = 13A9H +;defc EMWP1 = 13C8H +;defc ELMD18 = 1012H +;defc ZRWX = 1043H +;defc ZRO = 1055H +;defc ZMAPS = 1055H +;defc __CRT = 106CH +;defc CURXY = 1082H +;defc CMTMSG = 108EH +;defc IBUFE = 10F0H +;defc CSMDT = 1199H +;defc AMPM = 1366H +;defc XS = 1369H +;defc CRTMD1 = 1379H +;defc EMFLG = 13C3H +;defc CTABLE = 13DAH +;defc ZLOG = 1042H +;defc ZDIRS = 1059H +;defc ZPOS = 1061H +;defc ZFREE = 1065H +;defc TEXTST = 1070H +;defc MEMLMT = 107EH +;defc PWMODE = 109AH +;defc PMASK = 109EH +;defc GMODE = 109FH +;defc YS = 136FH +;defc CRTMD2 = 137AH +;defc ZTOP = 1040H +;defc PSMAL = 1096H +;defc SUMDT = 1197H +;defc TEMPW = 119EH +;defc XE = 136AH +;defc SSW = 1377H +;defc ZDIRMX = 1052H +;defc ZINIT = 1053H +;defc DCHAN = 1069H +;;;defc TEXTED = 1072H +;defc MEMOP = 1099H +;defc CSIZE = 136DH +;defc YE = 1370H +;defc ZWRK1 = 1048H +;defc LPT_TM = 1094H +;defc MAXCF = 109DH +;defc SECD = 1367H +;defc PALTBL = 1381H + + +;defc TEXTBF = 2000H +;defc BITBUF = 8000H +;defc FONTBF = 1000H +;defc ERRTXT = 0FDA0H +;defc ZBYTES = 001DH + + + +; --------------------------- +; MZ-800 crt port define +; FI:CRTEQU ver 1.0 7.26.84 +; --------------------------- +; +; +; custom lsi ports +; +; +; +defc LSPAL = 0F0H ;palette +defc LSFC = 0FCH +defc LSE0 = 0E0H +defc LSE1 = 0E1H +defc LSE2 = 0E2H +defc LSE3 = 0E3H +defc LSE4 = 0E4H +defc LSE5 = 0E5H +defc LSE6 = 0E6H +defc LSD0 = 0D0H +defc LSD1 = 0D1H +defc LSD2 = 0D2H +defc LSD3 = 0D3H +; +defc LSWF = 0CCH +defc LSRF = 0CDH +defc LSDMD = 0CEH +defc LSSCR = 0CFH +; +; +; +; work area +; +;defc TEXTBF = 2000H +defc BITBUF = 8000H +defc FONTBF = 1000H +defc ERRTXT = 0FDA0H + +; ---------------------------- +; MZ-800 Monitor part-1 +; FI:PL1 ver 1.0 7.30.84 +; ---------------------------- +; +; +; +; ORG 0 + +; RAM - Monitor - jump table +; + JP STARTP ; Monitor / Basic - Home entry +; + JP GETL ; Get line from keyboard to memory (DE). +; + JP CR1 ; Output newline to screen +; + JP CR2 ; Line feed when cursor is not at beginning of line +; + JP CRT1S ; print a space on the screen +; + JP PRNTT ; Move cursor to next tab position +; + JP CRT1C ; Display accu on screen (execution of control characters) +; + JP CRTMSG ; Output text (DE) on screen (execution of control characters) +; +_DOCMD: + JP IOSVC ; Software - execute command (RST _DOCMD: RST3 supervisor call entry) +; + JP INKEY0 ; Query whether key is pressed +; +BRKCHK: JP BRKEY ; Query whether (Shift) - BREAK is pressed +; + JP SAVE1 ; File - write identifier on tape (cassette) +; + JP SAVE2 ; File - write data to tape (cassette) +; + JP LOAD1 ; Read file identifier from tape (cassette) +; + JP LOAD2 ; File - read data from tape (cassette) +; + JP LOAD_2 ; File - compare data on tape with storage data +; + JP __RET ; RET (formerly Music - Play Text (DE)), RST6 +; + JP TIMST ; set time +; + DEFS 2 ; dummy +; + JP __RET ; RET (formerly interrupt for clock) +; + JP TIMRD ; read time +; +_BEEP: JP CTRLG ; Treat reference tone according to code in Accu +; +_TEMPO: JP _TEMP ; set pace +; + JP MLDSP ; turn off the sound +; + JP MLDSP ; turn off the sound +; + JP GETL ; Get line from keyboard to memory (DE). +; + +SYSSTA: + DEFW _START +ERRORP: + DEFS 2 +; + JP CRTMSG ;org 51H +; + DEFS 4 +; + JP INKEY ;org 58H +;--------------------------------- +; +; crt driver contrl code tabel +; +;--------------------------------- +CONTTB: DEFW __RET ;@ 00 + DEFW __RET ;A 01 + DEFW __RET ;B 02 + DEFW CTR_M ;C 03 + DEFW __RET ;D 04 + DEFW CTR_E ;E 05 sft lock + DEFW CTR_F ;F 06 sft normal + DEFW __RET ;G 07 beep + DEFW __RET ;H 08 + DEFW C_TAB ;I 09 + DEFW __RET ;J 0A + DEFW __RET ;K 0B + DEFW __RET ;L 0C + DEFW CTR_M ;M 0D cr + DEFW SPLSW ;N 0E spool exec/stop + DEFW __RET ;O 0F + DEFW DEL ;P 10 del + DEFW CDOWN ;Q 11 cursor down + DEFW CUP ;R 12 cursor up + DEFW CRIGHT ;S 13 cursor right + DEFW CLEFT ;T 14 cursor left + DEFW HOME ;U 15 home + DEFW HCLSW ;V 16 clr + DEFW CTR_W ;W 17 graph + DEFW INST ;X 18 inst + DEFW CTR_F ;Y 19 alpha + DEFW __RET ;Z 1A + DEFW CTR_M ;[ 1B esc + DEFW __RET ;\ 1C + DEFW __RET ;] 1D + DEFW __RET ;^ 1E + DEFW __RET ;_ 1F + + +; +CTRLJB: ADD A,A + LD HL,CONTTB + CALL ADDHLA + CALL INDRCT + JP (HL) +; +; +NOTXT: ; Default for text without characters + NOP +; +_HL: + JP (HL) +; +; +SVC_DI: + EI + PUSH AF + CALL MWAIT + CALL SPLOFF + POP AF + DI +__RET: + RET +; +; +SVC_EI: + PUSH AF + CALL SPLON + POP AF + EI + RET + +;---------------------------------- +; +; register all push program +; +; PUSHRA : PUSH IX,HL,BC,DE,AF +; PUSHR : PUSH IX,HL,BC,DE +; Destroy IX +; +;---------------------------------- +PUSHRA: + EX (SP),IX + PUSH HL + PUSH BC + PUSH DE + PUSH AF + PUSH HL + LD HL,POPRA + EX (SP),HL + JP (IX) +PUSHR: + EX (SP),IX + PUSH HL + PUSH BC + PUSH DE + PUSH HL + LD HL,POPR + EX (SP),HL + JP (IX) +POPRA: POP AF +POPR: POP DE + POP BC + POP HL + POP IX + RET +; +; +; +;--------------------------------- +; +; cold startup routine +; +;--------------------------------- +;ORG DAH +; +COLDST: DI + LD SP,0000H + IM 2 + OUT (LSE1),A + LD HL,(SYSSTA) + JP (HL) ;system entry jump +; +; +; +;--------------------------------- +; +; BREAK,can't cont +;--------------------------------- +BREAKX: + XOR A + DEFB 21H +;--------------------------------- +; BREAK,can cont +;--------------------------------- +BREAKZ: + LD A,80H + DEFB 21H +;--------------------------------- +; I/O error +;--------------------------------- +IOERR: + OR 80H +;--------------------------------- +; Error occur +;--------------------------------- +ERRORJ: + PUSH AF + CALL MLDSP + POP AF + LD HL,(ERRORP) + JP (HL) ;error jump +; + + +; +;--------------------------------- +; +; B = String bytes (till 00H) +; +;--------------------------------- +COUNT: PUSH DE + LD B,0 +COUNT2: LD A,(DE) + OR A + JR Z,COUNT9 + INC DE + INC B + JR NZ,COUNT2 + DEC B +COUNT9: POP DE + RET +;--------------------------------- +; +; IOOUT +; +; Ent. HL=I/O data tabel +; B =counter +; +;--------------------------------- +IOOUT: + LD A,(HL) + INC HL + LD C,(HL) + INC HL + OUT (C),A + DJNZ IOOUT + RET +; +; +; +; +; +DEVASC: + RST 3 + DEFB _DEASC + LD A,D + OR A + JP NZ,ER03 + LD A,E + CP B + RET C + JP ER03 + +; + NOP + +; +; +; ORG 011BH +;--------------------------------- +; +; +; CHECK ACC +; CALL CHKACC +; DEFB N +; DEFB X1 +; DEFB X2 +; : : +; DEFB XN +;--------------------------------- +CHKACC: + EX (SP),HL + PUSH BC + LD B,(HL) + INC HL + CP (HL) + JR Z,CHACC1 + DJNZ $-4 + INC HL + JR CHACC9 +CHACC1: INC HL + DJNZ $-1 +CHACC9: POP BC + EX (SP),HL + RET +;--------------------------------- +; LD DE,(HL+) +;--------------------------------- +LDDEMI: + LD E,(HL) + INC HL + LD D,(HL) + INC HL + RET +;--------------------------------- +; LD DE,(HL) +;--------------------------------- +LDDEMD: + LD E,(HL) + INC HL + LD D,(HL) + DEC HL + RET +;--------------------------------- +; Clear (HL) B bytes +;--------------------------------- +CLRHL: + XOR A +;--------------------------------- +; Set (HL) B bytes +;--------------------------------- +SETHL: + LD (HL),A + INC HL + DJNZ $-2 + RET + + +;--------------------------------- +; Clear (DE) B bytes +;--------------------------------- +CLRDE: + XOR A +;--------------------------------- +; Set (DE) B bytes +;--------------------------------- +SETDE: + LD (DE),A + INC DE + DJNZ $-2 + RET +;--------------------------------- +; LD (DE),(HL) B bytes +;--------------------------------- +LDDEHL: + LD A,(HL) + LD (DE),A + INC HL + INC DE + DJNZ $-4 + RET +;--------------------------------- +; LD (HL),(DE) B bytes +;--------------------------------- +LDHLDE: + LD A,(DE) + LD (HL),A + INC HL + INC DE + DJNZ $-4 + RET +;--------------------------------- +; LD HL,(HL) +;--------------------------------- +INDRCT: + PUSH AF + LD A,(HL) + INC HL + LD H,(HL) + LD L,A + POP AF + RET +;--------------------------------- +; ADD HL,A +;--------------------------------- +ADDHLA: + ADD A,L + LD L,A + RET NC + INC H + RET + + +;--------------------------------- +; Fetch subroutines +;--------------------------------- +INCHLF: + INC HL +HLFTCH: + LD A,(HL) + CP ' ' + JR Z,INCHLF + RET +;--------------------------------- +; TEST1 "x" ;test 1 char +;--------------------------------- +TEST1: + CALL HLFTCH + EX (SP),HL + CP (HL) + INC HL + EX (SP),HL + RET NZ + INC HL + RET +;--------------------------------- +; TESTX "x" ;check 1 char +;--------------------------------- +TESTX: + CALL HLFTCH + EX (SP),HL + CP (HL) + INC HL + EX (SP),HL + INC HL + RET Z ;OK + LD A,1 + JP ERRORJ ;Syntax error +; +; +; +; + + +;--------------------------------- +; SVC(RST3) table +;--------------------------------- +; +; + +IOSVCT: +defc _MONOP = 00H + DEFW MONOP +defc _CR1 = 01H + DEFW CR1 +defc _CR2 = 02H + DEFW CR2 +defc _CRT1C = 03H + DEFW CRT1C +defc _CRT1X = 04H + DEFW CRT1CX +defc _CRTMS = 05H + DEFW CRTSIMU +defc _LPTOT = 06H + DEFW LPTOUT +defc _LPT1C = 07H + DEFW LPT1C +defc _CR = 08H + DEFW PR_CR +defc _1C = 09H + DEFW PR_1C +defc _1CX = 0AH + DEFW PR_1CX +defc _MSG = 0BH + DEFW PR_MSG +defc _GETL = 0CH + DEFW GETL +defc _INKEY = 0DH + DEFW INKEY +defc _BREAK = 0EH + DEFW BRKEY +defc _HALT = 0FH + DEFW HALT +defc _DI = 10H + DEFW SVC_DI +defc _EI = 11H + DEFW SVC_EI +defc _CURMV = 12H + DEFW CURMOV +defc _DEASC = 13H + DEFW DEASC +defc _DEHEX = 14H + DEFW DEHEX +defc _CKHEX = 15H + DEFW CKHEX +defc _ASCHL = 16H + DEFW ASCHL +defc _COUNT = 17H + DEFW COUNT +defc _ADDP0 = 18H + DEFW ADDP0 +defc _ADDP1 = 19H + DEFW ADDP1 +defc _ADDP2 = 1AH + DEFW ADDP2 +defc _ERRX = 1BH + DEFW ERRX +defc _DACN = 1CH + DEFW DACN +defc _ADCN = 1DH + DEFW ADCN +defc _STICK = 1EH + DEFW STICK +defc _STRIG = 1FH + DEFW STRIG +defc _BELL = 20H + DEFW CTRLG +defc _PLAY = 21H + DEFW PLAY +defc _SOUND = 22H + DEFW MSOUND +defc _MCTRL = 23H + DEFW MCTRL +defc _IOOUT = 24H + DEFW IOOUT +defc _TIMRD = 25H + DEFW TIMRD +defc _TIMST = 26H + DEFW TIMST +defc _INP1C = 27H + DEFW INP1C0 + + +; +defc _CLRIO = 28H + DEFW CLRIO +defc _SEGAD = 29H + DEFW SEGADR +defc _OPSEG = 2AH + DEFW OPSEG +defc _DLSEG = 2BH + DEFW DELSEG +defc _DEVNM = 2CH + DEFW DEV +defc _DEVFN = 2DH + DEFW DEV_FN +defc _LUCHK = 2EH + DEFW LUCHK +defc _LOPEN = 2FH + DEFW LOPEN +defc _LOADF = 30H + DEFW LOADFL +defc _SAVEF = 31H + DEFW SAVEFL +defc _VRFYF = 32H + DEFW VRFYFL +defc _RWOPN = 33H + DEFW RWOPEN +defc _INSTT = 34H + DEFW INPSTRT +defc _INMSG = 35H + DEFW INPMSG +defc _INDAT = 36H + DEFW INPDT +defc _PRSTR = 37H + DEFW PRTSTR +defc _CLKL = 38H + DEFW CLKL +defc _DIR = 39H + DEFW FDIR +defc _SETDF = 3AH + DEFW SETDFL +defc _LSALL = 3BH + DEFW LSALL +defc _FINIT = 3CH + DEFW FINIT +defc _DELET = 3DH + DEFW FDELET +defc _RENAM = 3EH + DEFW FRENAM +defc _LOCK = 3FH + DEFW FLOCK +defc _RECST = 40H + DEFW RECST +defc _INREC = 41H + DEFW INREC +defc _PRREC = 42H + DEFW PRREC +defc _ERCVR = 43H + DEFW ERRCVR +defc _SWAP = 44H + DEFW FSWAP +defc _CLS = 45H + DEFW HCLS +defc _POSCK = 46H + DEFW POSCK +defc _POSSV = 47H + DEFW POSSV +defc _PSET = 48H + DEFW PSET +defc _LINE = 49H + DEFW WLINE +defc _PATTR = 4AH + DEFW CHARW +defc _BOX = 4BH + DEFW WBOX +defc _PAINT = 4CH + DEFW WPAINT +defc _CIRCL = 4DH + DEFW WCIRCL +defc _POINT = 4EH + DEFW WPOINT +defc _HCPY = 4FH + DEFW HCPY +defc _DSMOD = 50H + DEFW DSMODE +defc _DPLBK = 51H + DEFW DPALBK +defc _DPLST = 52H + DEFW DPALST +defc _DWIND = 53H + DEFW DWIND +defc _DCOL = 54H + DEFW DCOLOR +defc _DGCOL = 55H + DEFW DGCOL +defc _ICRT = 56H + DEFW ICRT +defc _SYMBL = 57H + DEFW SYMBOL + + +;--------------------------------- +; +; SVC handlar (RST3) +; +;--------------------------------- +IOSVC: EX (SP),HL + PUSH AF + LD A,(HL) + INC HL + PUSH HL + LD HL,IOSVCT + ADD A,A + ADD A,L + JR NC,$+3 + INC H + LD L,A + LD A,(HL) + INC HL + LD H,(HL) + LD L,A + LD (IOSVCX+1),HL + POP HL + POP AF + EX (SP),HL +IOSVCX: JP 0 ;xxx +; +; I/O device call (RST5) +; +IOCALL: + PUSH HL + PUSH DE + LD (IOCALX+1),IX + LD IX,IOERR + OR A +IOCALX: CALL 0 ;xxx + POP DE + POP HL + RET NC + OR A + SCF + RET Z + JP IOERR +; +; +; +; Convert BINARY(HL) to ASCII(DE) +; +ASCHL: + PUSH HL + PUSH BC + PUSH DE + LD DE,10000 + CALL ASCHL2 + LD DE,1000 + CALL ASCHL2 + LD DE,100 + CALL ASCHL2 + LD DE,10 + CALL ASCHL2 + LD A,L + POP DE + OR '0' + LD (DE),A + INC DE + XOR A + LD (DE),A + POP BC + POP HL + RET +; +ASCHL2: LD A,0FFH +ASCHL4: INC A + OR A + SBC HL,DE + JR NC,ASCHL4 + ADD HL,DE + OR A + JR NZ,ASCHL6 + OR B + RET Z ;Zero sup. + XOR A +ASCHL6: LD B,1 + OR '0' + POP DE + EX (SP),HL + LD (HL),A + INC HL + EX (SP),HL + PUSH DE + RET + + +; +; Convert ASCII(HL) to BINARY(DE) +; +DEASC: + CALL TEST1 + DEFM "$" + JR Z,DEHEX + LD DE,0 +DEASC2: CALL HLFTCH + SUB '0' + CP 10 + RET NC + INC HL + PUSH HL + LD HL,DE + ADD HL,HL ;2 + JR C,ER02_ + ADD HL,HL ;4 + JR C,ER02_ + ADD HL,DE ;5 + JR C,ER02_ + ADD HL,HL ;10 + JR C,ER02_ + LD E,A + LD D,0 + ADD HL,DE + JR C,ER02_ + EX DE,HL + POP HL + JR DEASC2 +; +ER02_: LD A,2 + JP ERRORJ + + +; +; Convert HEX(HL) to BINARY(DE) +; +DEHEX: + LD DE,0 +DEHEX2: LD A,(HL) + CALL CKHEX + RET C + INC HL + EX DE,HL + ADD HL,HL ;2 + JR C,ER02_ + ADD HL,HL ;4 + JR C,ER02_ + ADD HL,HL ;8 + JR C,ER02_ + ADD HL,HL ;16 + JR C,ER02_ + ADD A,L + LD L,A + EX DE,HL + JR DEHEX2 +; +; Chck hex +; +CKHEX: + SUB '0' + CP 10 + CCF + RET NC + SUB 'A'-'0' + CP 6 + CCF + RET C + ADD A,10 + RET +; +; SVC .HALT ;Halt if SPACE, +; ;and break check +; +HALT: + CALL HALTSB + CP ' ' + RET NZ + CALL HALTSB + OR A + JR Z,$-4 + RET +HALTSB: + RST 3 + DEFB _BREAK + JR Z,HALTBR + LD A,0FFH + RST 3 + DEFB _INKEY + CP 1BH + RET NZ +HALTBR: JP BREAKZ + RET + + +; +; SVC .SETDF ;set default +; ent DE:equipment table +; A: channel +; +SETDFL: + LD (DDEV),DE ;default device + LD (DCHAN),A ;default channel + RET +; +; Pointer update +; +ADDP0: + LD HL,(POOL) + ADD HL,DE + LD (POOL),HL +ADDP1: + LD HL,(VARST) ;Variable start <> POOL END + ADD HL,DE + LD (VARST),HL +ADDP2: + LD HL,(STRST) + ADD HL,DE + LD (STRST),HL + LD HL,(VARED) + ADD HL,DE + LD (VARED),HL + LD HL,(TMPEND) + ADD HL,DE + LD (TMPEND),HL + RET +; + + +; +; SVC .ERRX ;Print error message +; +ERRX: + LD C,A + RST 3 + DEFB _BELL + RST 3 + DEFB _CR2 + BIT 7,C + JR Z,ERRX1 + LD HL,KEYBUF + PUSH HL + CALL SETDNM + POP DE + RST 3 + DEFB _CRTMS ;Device name +ERRX1: LD A,C + AND 7FH + LD C,A + RST 3 + DEFB _DI + OUT (LSE3),A ;bank change + JR ERRX0 +; +ERRXU: LD C,69 +ERRX0: LD DE,ERRTXT +ERRX2: DEC C + JR Z,ERRX4 + LD A,(DE) + INC DE + OR A + JP P,$-3 + JR Z,ERRXU + JR ERRX2 +; +ERRX4: LD A,(DE) + CP 80H + JR Z,ERRXU + EX DE,HL + LD DE,KEYBUF +ERRX6: LD A,(HL) + OR A + JP M,ERRX8 + LDI + JR ERRX6 +ERRX8: AND 7FH + LD (DE),A + OUT (LSE1),A ;bank change + RST 3 + DEFB _EI + INC DE + LD HL,MESER + LD B,8 + CALL LDDEHL + LD DE,KEYBUF + RST 3 + DEFB _CRTMS + RET +; + + +; +SETDNM: + LD DE,(ZEQT) + INC DE + INC DE + RST 3 + DEFB _COUNT + CALL LDHLDE + LD A,(ZCH) + ADD A,'1' + LD (HL),A ;ch# + LD A,(ZFLAG2) + AND 0FH ;max ch# + JR Z,$+3 + INC HL + LD (HL),':' + INC HL + LD (HL),0 + RET +; +MESER: DEFM " ERROR" + + DEFB 0 +; +; +;----------------------------------- +; +; +; display mode +; +; +; ent. acc mode colors dmd +; 1 320*200 4 0 +; 2 320*200 16 2 +; 3 640*200 2 4 +; 4 640*200 4 6 +; +; +;----------------------------------- +; +DSMODE: + CALL PUSHR + LD B,A +; + LD A,(MEMOP) ;option vram exist ? + OR A + LD A,B + JR NZ,DSM0 + CP 2 + JR Z,CERR + CP 4 + JR Z,CERR +; +; +; +DSM0: PUSH AF + DEC A + LD D,0FFH + LD HL,PAL4T + LD BC,0403H + JR Z,DSM00 ;skip if 320*200 4 colors + DEC A + LD HL,PAL16T + LD BC,100FH + JR Z,DSM00 ;skip if 320*200 16 colors + DEC A + LD HL,PAL2T + LD BC,0201H + JR Z,DSM00 ;skip if 640*200 2 colors + LD HL,PAL4T ; 640 *200 4 colors + LD BC,0805H + LD D,0FDH +; +DSM00: LD (CPLANE),BC ;c cplane + LD A,D + LD (PMASK),A ;plane mask + LD (PALAD),HL + CALL PALOFF + POP AF + DEC A + RLCA + LD (DMD),A + OUT (LSDMD),A + AND 4 ;bit 2 only + CALL DWIDTH ;acc=0 -->40 chr + CALL _CONSOI ;(YS,YE)=0,24 palint + OR A + RET +; +; +CERR: + SCF + RET + + +;----------------------------------- +; +; +; console & palette & color init +; +;----------------------------------- +_CONSOI: LD HL,1800H ;(ys,ye)=(0,24) + CALL DWIND +; +;JR PALINT +; +PALINT: LD A,(CPLANE) + LD (CMODE),A + XOR A + CALL DPALBK ;init palette block reg. + LD HL,PALAD + LD E,(HL) + INC HL + LD D,(HL) + EX DE,HL + LD DE,PALTBL ;init palette reg. + PUSH DE + LD BC,4 + LDIR + POP HL +PALOUT: LD B,4 + LD C,LSPAL + OTIR + RET +;-------------------------------- +; +; Palette all clr +; +; +;-------------------------------- +PALOFF: + PUSH BC + XOR A + LD B,5 + LD C,LSPAL +PALOF1: OUT (C),A + ADD A,10H + DJNZ PALOF1 + POP BC + RET +; +; + + +;---------------------------------- +; +; +; pallet block regster set +; +; ent acc=pal block number +; +;---------------------------------- +DPALBK: + CALL PUSHR + LD (PALBK),A + LD E,A + LD A,(DMD) + CP 2 + JR NZ,PALBK1 ;skip if not 320*200 16 col +; + LD A,E + RLCA ;*2 + RLCA ;*4 + LD HL,PALTBL + LD B,4 + PUSH HL +PALBK0: LD (HL),A + ADD A,11H + INC HL + DJNZ PALBK0 + POP HL + CALL PALOUT +PALBK1: LD A,E + OR 40H + OUT (LSPAL),A + RET +; + + +;---------------------------------- +; +; pallet regster set +; +; ent acc=pal register number +; b =pal color code +; +;---------------------------------- +; +DPALST: + CALL PUSHR + LD HL,PALTBL + LD D,0 + LD E,A ;pallet register number + ADD HL,DE + OR A + RLCA + RLCA + RLCA + RLCA + OR B ;pallet color code + LD (HL),A + OUT (LSPAL),A + RET +; + + +; +;---------------------------------- +; +; +; display color set +; +; Acc=col code +;---------------------------------- +; +DCOLOR: + PUSH AF + CALL COLS + LD (CMODE),A + POP AF + RET +; +; +DGCOL: + PUSH AF + CALL COLS + LD (GMODE),A + POP AF + RET +; +COLS: + PUSH BC + LD B,A + LD A,(DMD) + CP 6 + LD A,B + JR NZ,COLS1 ;skip if not 640*200 4 + CP 2 + JR C,COLS1 + ADD A,2 ;2 or 3 only +COLS1: POP BC + RET +; + + +;---------------------------------- +; +; +; display window set +; +; +; +;---------------------------------- +DWIND: + CALL PUSHR + LD (YS),HL ;save YS,YE + LD A,H + SUB L + INC A + LD (YW),A ;YW=YE-YS+1 :lines + LD B,A + ADD A,A + ADD A,A + ADD A,B + LD (SW),A ;SW=YW*5 + EX DE,HL + LD H,0 + LD L,A + ADD HL,HL ;*2 + ADD HL,HL ;*4 + ADD HL,HL ;*8 + LD (SSW),HL + EX DE,HL + INC H + LD A,H + ADD A,A + ADD A,A + ADD A,H + LD (SEA),A ;SEA=(YE+1)*5 + LD A,L + ADD A,A + ADD A,A + ADD A,L + LD (SSA),A ;SSA=YS*5 + LD HL,0 + LD (SOF),HL ;SOF=0 + LD HL,SEA + LD BC,6CFH ;B counter C scrool reg + OTDR + CALL HCLS + JP HOME + + +;---------------------------------- +; +; +; display chracter size change +; +; if acc=1 then 640 chr +; if acc=0 then 320 chr +;---------------------------------- +; +DWIDTH: + CALL PUSHR + OR A + LD A,40 + LD DE,2300H + JR Z,DWID1 + ADD A,A ;80 chr + LD DE,0023H +DWID1: LD (CWIDTH),A + LD H,0 + LD L,A + ADD HL,HL ;*2 + ADD HL,HL ;*4 + ADD HL,HL ;*8 + LD (CSIZE),HL + DEC A + LD (XE),A +; + LD A,D + LD (PTW0),A + LD (PTW0+1),A + LD (PTB0),A + LD A,E + LD (PTW1),A + LD (PTW1+1),A + LD (PTB1),A + LD BC,0B07H ;patch counter + LD HL,CHTBL ;patch table addr + CALL PATCH + CALL CHGRPH ;mon-grph + JP HCLS +; +; +PATCH: +; +; word patch +; +PATCHW: LD E,(HL) ;addr read + INC HL + LD D,(HL) + INC HL +PTW0: INC HL ;nop + INC HL ;nop + LD A,(HL) ;data read + INC HL + LD (DE),A + INC DE + LD A,(HL) + INC HL + LD (DE),A +PTW1: NOP ;inc hl + NOP ;inc hl + DJNZ PATCHW +; +; byte patch +; + LD B,C +PATCHB: LD E,(HL) ;addr read + INC HL + LD D,(HL) + INC HL +PTB0: INC HL ;nop + LD A,(HL) + INC HL + LD (DE),A +PTB1: NOP ;inc hl + DJNZ PATCHB + RET +; + + +;-------------------------------- +; +; +; PL-EX crt driver patch tabel +; +; +;-------------------------------- +; +CHTBL: +; +; word patch +; + DEFW XPD1+1 ;ld de,xxxxh + DEFW 80 + DEFW 40 + + DEFW XPC1 ;sla c + DEFW 21CBH ;(SLA C) + DEFW 0 ;(NOP NOP) + + DEFW XPC2+1 ;ld bc,xxxxh + DEFW 400 ; Value for 80 characters per line + DEFW 200 ; Value for 40 characters per line + + DEFW XPC3+1 ;ld hl,xxxxh + DEFW BITBUF+16000 + DEFW BITBUF+8000 + + DEFW XPDE3+1 ;ld de,xxxxh + DEFW 80 + DEFW 40 + + DEFW XPDE4+1 ;ld bc,xxxxh + DEFW 7 * 80 ; Value for 80 characters per line + DEFW 7 * 40 ; Value for 40 characters per line + + DEFW XPIN2+1 ;ld de,xxxxh + DEFW 80 + DEFW 40 + + DEFW XPIN3+1 ;ld de,xxxxh + DEFW -80 ; Value for 80 characters per line + DEFW -40 ; Value for 40 characters per line + + DEFW XPIN4+1 ;ld bc,xxxxh + DEFW - (7 * 80) ; Value for 80 characters per line + DEFW - (7 * 40) ; Value for 40 characters per line + + DEFW XPLI2+1 ;ld de,xxxxh + DEFW 80 + DEFW 40 + + DEFW XPSC2+1 ;ld bc,xxxxh + DEFW 8 * 80 - 1 ; Value for 80 characters per line + DEFW 8 * 40 - 1 ; Value for 40 characters per line +; +; +; +;byte patch +; +; + DEFW XPDE1+1 ;ld l,xxh + DEFB 79 + DEFB 39 + + DEFW XPDE2+1 ;ld c,xxh + DEFB 79 + DEFB 39 + + DEFW XPIN1+1 ;ld c,xxh + DEFB 79 + DEFB 39 + + DEFW XPLI1+1 ;ld a,xxh + DEFB 79 + DEFB 39 + + DEFW XPSC1+1 ;ld c,xxh + DEFB 80 + DEFB 40 + + DEFW XPCU1 + DEFB 29H ;add hl,hl + DEFB 0 ;nop + + DEFW XPCU2 + DEFB 29H ;add hl,hl + DEFB 0 ;nop +; +; +; +;--------------------------------- +; +; +; crt 1 character display +; +; acc=ascii code +; +; +;--------------------------------- +; +ACCDI: + CALL PUSHRA + LD HL,(POSADR) + LD C,A + CP 20H ;convert space + JR NZ,ACCDI0 + XOR A +ACCDI0: LD (HL),A + LD HL,(BITADR) + LD A,C + CALL BITMAP + XOR A ;patch cursor + LD (CDOWN2+2),A + CALL CRIGHT + LD A,7 + LD (CDOWN2+2),A + RET +; + + +;---------------------------------- +; +; bitmap extention +; +; ent Acc:ascii code +; HL :bitadr +; +;---------------------------------- +; +BITMAP: +; + RST 3 + DEFB _ADCN ;ascii->display + DI + EXX + PUSH HL + LD H,0 + LD L,A ;display code + LD A,(CMODE) + OR 80H ;replace mode + OUT (LSWF),A +; + ADD HL,HL ;*2 + ADD HL,HL ;*4 + ADD HL,HL ;*8 + SET 4,H ;offset fontbuf $1000 + EXX + LD B,8 +XPD1: LD DE,40 ;cwidth 80<--80 chr + IN A,(LSE0) ;bank change !! +BITM1: EXX + LD A,(HL) ;font pattern read + INC HL ;next pointer + EXX + LD (HL),A ;font pattern write + ADD HL,DE ;next laster + DJNZ BITM1 + IN A,(LSE1) ; bank reset !! + EI + EXX + POP HL + EXX + RET + + +;---------------------------------- +; +; +; manegement utility +; +; +;---------------------------------- + +; exit D=begin line +; E=end line+1 +; +LBOUND: + CALL TBCALC +LBOUN1: LD A,(HL) + OR A + JR Z,LBOUN2 + DEC HL + DEC E + LD A,(YS) + CP E + JR C,LBOUN1 +LBOUN2: LD D,E +LBOUN3: INC E + INC HL + LD A,(HL) + OR A + RET Z + LD A,(YE) + CP E + JR NC,LBOUN3 + RET +; +; +TBCALC: + LD E,H + LD D,0 + LD HL,SCRNT0 + ADD HL,DE + RET +; +;----------------------------------- +; +; clear window +; +; +; +;----------------------------------- +HCLSW: + CALL PUSHR + LD A,(YS) + LD H,A + CALL TBCALC + LD A,(YW) ;YW=YE-YS+1 + LD B,A ;lines + LD E,A ;store YW +; + CALL CLRHL ;mangement buf clr +; +CLSWT: LD C,E ;restore YW + LD A,(YE) +;JR CLSLT +; +; +;----------------------------------- +; +; +; clear line +; +; C=lines Acc=line no. +; +;----------------------------------- +; +CLSLT: + INC A + LD L,0 + LD H,A + PUSH HL ;start pos x,y + CALL PONT + LD B,0 +XPC1: NOP ;SMC (40: NOP, 80: SLA C) + NOP + PUSH BC + CALL PUSHW + POP HL ;pop counter + ADD HL,HL ;*2 + ADD HL,HL ;*4 + ADD HL,HL ;*8 + LD C,L + LD B,H + POP HL ;start pos x,y + CALL PONTB + CALL PUSHW + JR CLRSCR +; +;----------------------------------- +; +; clear screen +; +; +; +; +;----------------------------------- +HCLS: + CALL PUSHRA +CLST: LD HL,TEXTBF+2000 + LD BC,50 + CALL PUSHW + LD B,25 + LD HL,SCRNT0 + CALL CLRHL ;manegement buf clr +CLSB: +; +; color mode +; +XPC2: LD BC,200 ;or 400 +XPC3: LD HL,BITBUF+8000 ;or +16000 + CALL PUSHW + JR CLRSCR +;----------------------------------- +; +; PUSH Write +; +; +; Ent:HL=cls point addr +; BC=counts *40 +; +;----------------------------------- +; +PUSHW: + LD (PUSHW1+1),SP + LD (PUSHW2+1),HL + LD HL,0 + LD A,(CPLANE) ;display active plane + OR 80H ;replace mode + OUT (LSWF),A +; +PUSHW0: DI +PUSHW2: LD SP,0 ;xx + IN A,(LSE0) ;bank +; + PUSH HL + PUSH HL + PUSH HL + PUSH HL + PUSH HL ;10 + PUSH HL + PUSH HL + PUSH HL + PUSH HL + PUSH HL ;20 + PUSH HL + PUSH HL + PUSH HL + PUSH HL + PUSH HL ;30 + PUSH HL + PUSH HL + PUSH HL + PUSH HL + PUSH HL ;40 + IN A,(LSE1) ;bank + LD (PUSHW2+1),SP +PUSHW1: LD SP,0 ;xxx + EI +; + DEC BC + LD A,C + OR B + JR NZ,PUSHW0 + RET +;---------------------------------- +; +; scrool parameter initial +; +; +;---------------------------------- +; +CLRSCR: + LD HL,0 + LD (SOF),HL + LD B,2 + LD C,LSSCR ;lsi scrool register + OUT (C),H + DEC B + OUT (C),L + JP HOME +; +; +;---------------------------------- +; +; +; +; delete chacter +; +; +;---------------------------------- +; +; +DEL: + EXX + PUSH HL + PUSH DE + PUSH BC + EXX + CALL DEL0 + EXX + POP BC + POP DE + POP HL + EXX + RET +; +DEL0: + LD HL,(CURXY) + DEC L + JP P,DEL1 +; + CALL TBCALC + LD A,(HL) + LD H,E + LD L,0 + OR A + JR Z,DEL1 + LD A,(YS) + CP H + JR Z,DEL1 + DEC H +XPDE1: LD L,39 ;XE 39 or 79 +DEL1: + LD (CURXY),HL + CALL LINCAL +;BC lines HL' counts HL last curxy + CALL PONTC + PUSH BC ;lines store + LD D,H + LD E,L + INC HL + EXX + PUSH HL ;HL' counts + EXX + POP BC + LDIR + XOR A + LD (DE),A ;last addr space + POP BC ;lines pop + LD HL,(CURXY) + INC HL + CALL PONTB ;bitmap addr +DELB11: EXX + LD D,9 ;laster set + LD HL,(MAXCF) + DEC D + EXX + JR DELB2 ;line first time only + + +;---------------------------------- +; DELB +; +; ent. +; BC lines +; HL start address +;---------------------------------- +DELB: +; +XPDE2: LD C,39 ;79 xe + DEC B ;last line ? + JR Z,DELB0 ;skip if end of func. + INC DE ;next addr calc + INC DE + LD H,D + LD L,E + JR DELB11 +; +DELB1: LD HL,(MAXCF) ; + DEC D ;last laster ? + EXX + JR Z,DELB ;skip if next line +XPDE3: LD DE,40 ;cwidth 80 + ADD HL,DE +; +DELB2: EXX ;next plane ? + RRC L + JR C,DELB1 + LD A,L + AND H ;pmask + EXX + JR Z,DELB2 ;skip if warp + DI + PUSH HL + PUSH BC + OUT (LSRF),A ;read plane + OUT (LSWF),A ;write plane + IN A,(LSE0) ;bank change + OUT (LSE0),A ;cg off + LD D,H + LD E,L + DEC DE + LD A,C + OR A + JR Z,XPDE4 + LD A,B ;line counter + LD B,0 + LDIR + DEC A + JR Z,DELB3 ;skip if last counter +XPDE4: LD BC,280 ; 560 + ADD HL,BC + LD A,(HL) + LD (DE),A +DELB3: IN A,(LSE1) ;bank off + EI + POP BC + POP HL + JP DELB2 +; +; +DELB0: + EX DE,HL + INC C + LD E,C + LD D,B + LD B,8 + DI + IN A,(LSE0) ;bank change + OUT (LSE0),A ;cg off + LD A,(CPLANE) + OR 80H ;replace mode + OUT (LSWF),A +DELB01: XOR A + LD (HL),A ;space fill + SBC HL,DE + DJNZ DELB01 + IN A,(LSE1) ;bank off + EI + LD HL,(CURXY) + JP CURMOV +; + + +;---------------------------------- + +; +; +; insert chacter +; +; +;---------------------------------- +; +; +INST: +; + EXX + PUSH HL + PUSH DE + PUSH BC + EXX + CALL INST0 + EXX + POP BC + POP DE + POP HL + EXX + RET +; +; +INST0: + LD HL,(CURXY) + CALL LINCAL +;BC lines HL' counts HL last curxy + PUSH HL ;store last-next pos x,y + CALL PONT + DEC HL ;last addr + LD A,(HL) + OR A + JR NZ,INSTE ;no insert space + PUSH BC ;lines store + LD D,H + LD E,L + DEC HL + EXX + PUSH HL ;HL' counts + EXX + POP BC +IF RAMDISK + CALL INST_0 +ELSE + LDDR + XOR A +ENDIF + LD (DE),A ;last addr space + POP BC ;lines pop + POP HL + CALL PONTB ;bitmap addr + DEC HL + LD A,C + LD (LASTC+1),A + DEC B + JR Z,INSEF ;first time ended + JR INSB1 +; +INSTE: POP HL + RET +; +; +;---------------------------------- +; +; +; insert operation +; +; <> +; +; ent. B =line counter +; +;---------------------------------- +; +INSB: + DEC B ;last line ? + JR Z,INSEND ;skip if end of func. +INSB1: +XPIN1: LD C,39 ;79 xe + CALL INSLIN + JR INSB +; +;--------------------------------- +; +; +; insert operation +; +; <> +; +;--------------------------------- +INSEND: +LASTC: LD C,0 ;patch +INSEF: CALL INSLIN + CALL PONTCB +XPIN2: LD DE,40 ;cwidth 80 + LD B,8 + DI + LD A,(CPLANE) + OR 80H ;replace mode + OUT (LSWF),A + IN A,(LSE0) ;bank change + OUT (LSE0),A ;cg off +INSB01: XOR A + LD (HL),A ;space fill + ADD HL,DE + DJNZ INSB01 + IN A,(LSE1) ;bank off + EI + RET +; + + +;---------------------------------- +; +; insert operation +; +; 1 line only +; +; ent. +; HL=first destination addr +; C =bytes +; +;---------------------------------- +INSLIN: + EXX + LD D,9 ;laster counter set +INSL1: LD HL,(MAXCF) ; + DEC D ;last laster ? + EXX + RET Z + CALL INSLAS +XPIN3: LD DE,0FFD8H ;FFB0h <--80 + ADD HL,DE + EXX + JR INSL1 +; +; +; +; +;--------------------------------- +; +; insert operation +; +; 1 laster only +; +; +; ent. E'=plane data(maxcf) +; HL=first destination addr +; C=bytes +; +;--------------------------------- +INSLAS: EXX ;next plane ? + RRC L + LD A,L + EXX + RET C ;next laster + EXX + AND H ;pmask + EXX + JR Z,INSLAS ;skip if warp + PUSH HL + PUSH BC + DI + OUT (LSRF),A ;read plane + OUT (LSWF),A ;write plane + IN A,(LSE0) ;bank change + OUT (LSE0),A ;cg off + LD D,H + LD E,L + DEC HL + LD A,C + OR A + JR Z,XPIN4 + LD A,B ;line counter + LD B,0 + LDDR + OR A + JR Z,INSLA1 ;skip if last line +XPIN4: LD BC,0FEE8H ;FDD0H <--80 + ADD HL,BC + LD A,(HL) + LD (DE),A +INSLA1: IN A,(LSE1) ;bank off + EI + POP BC + POP HL + JP INSLAS +; +;------------------------------- +; +; +; line cal +; +; +;------------------------------- +; +LINCAL: + LD B,1 +XPLI1: LD A,39 ;xe 39 or 79 + SUB L + LD C,A + EXX +XPLI2: LD DE,40 ;cwidth 80 + LD H,0 + LD L,A + EXX +LINC1: INC H ;next line check + LD A,(YE) + CP H + JR C,LINC2 ;scrool end check + CALL TBCALC + LD A,(HL) + OR A + LD H,E + JR Z,LINC2 ;manage ment check + INC B + EXX + ADD HL,DE + EXX + JR LINC1 +; +; +LINC2: LD L,0 + RET +; +; +; +;---------------------------------- +; +; scrool main logic +; +; +; +; +;---------------------------------- +SCROOL: CALL PUSHRA +;--------------------------------- +; +; text buf scrool & clr +; +;--------------------------------- +SCRTX: LD A,(YS) + LD H,A + LD L,0 + CALL PONT ;start addr cal + LD D,H + LD E,L ;DE destination addr + LD B,0 +XPSC1: LD C,40 ;cwidth 80 + ADD HL,BC ;HL source addr +; + LD A,(YW) ;scrool lines + DEC A + JR Z,SCR0 ;skip if 1 line mode + PUSH BC + PUSH HL + LD HL,0 +SCR1: ADD HL,BC + DEC A + JR NZ,SCR1 + LD B,H ;scrool bytes + LD C,L + POP HL ;pop source addr + LDIR + POP BC +SCR0: LD B,C + CALL CLRDE ;last line clr +;----------------------------------- +; +; maneger buf scrool & clr +; +;----------------------------------- + LD A,(YS) + LD H,A + CALL TBCALC ;exit HL maneger addr + LD A,(YW) ;scrool lines + DEC A ;1 line mode check + LD B,A + LD (HL),0 + INC HL + LD D,H + LD E,L + INC DE + CALL NZ,LDHLDE ;(hl)<--(de) + LD (HL),0 ;last line manegement +; +;---------------------------------- +; +; calculation xferad +; +;---------------------------------- +SCRCAL: LD A,(YE) + LD H,A + LD L,0 ;HL=(0,YE) + CALL PONTB + LD (XFERAD+1),HL ;xferad data +;---------------------------------- +; +; scrool offset calc +; +;---------------------------------- +SCXFER: + LD DE,40 + LD HL,(SOF) ;lsi scrool offset + ADD HL,DE + PUSH HL + LD DE,(SSW) ;lsi scrool width + OR A + SBC HL,DE + POP HL + JR NZ,SCXF1 ;sof> graphic ram +; +;---------------------------------- + IN A,(LSE0) ; bank change + OUT (LSE0),A ; cg off +XFERAD: LD HL,0 ;LD HL,xxxxh + LD (HL),0 + LD D,H + LD E,L + INC DE +XPSC2: LD BC,319 ;xfer bytes + LDIR + IN A,(LSE1) ; bank reset + EI +;---------------------------------- +; +; +; scrool operation ended +; +; cursor window end pos +; +;---------------------------------- +BOS: + LD A,(YE) + LD H,A + LD L,0 + JP CURMOV +; +;------------------------------- +; +; cursor routines +; +; +; +; +; +;------------------------------- +; +CURSOR: + CALL PUSHRA +; +;cursor data pattern + EXX + PUSH HL ;push hl' + LD HL,CURDT1 + LD A,(CURMAK) + OR A + JR Z,CURS0 + LD HL,CURDT2 + DEC A + JR Z,CURS0 + LD HL,CURDT3 +CURS0: EXX +; + DI + LD A,(CURFLG) + XOR 1 + LD (CURFLG),A + LD HL,(BITADR) + LD D,0 + LD A,(CWIDTH) + LD E,A + LD B,8 ;counter + LD A,(CMODE) + OR 20H ;xor mode + OUT (LSWF),A ;wf + IN A,(LSE0) ;bank change + OUT (LSE0),A ;cg off +; +CURS1: EXX + LD A,(HL) + INC HL + EXX + LD (HL),A + ADD HL,DE + DJNZ CURS1 + IN A,(LSE1) ;bank reset + EXX + POP HL ;pop hl' + EXX + EI + RET +; +; +; +HCURON: + CALL PUSHRA + XOR A + OUT (LSD0),A ;reset 556 + CPL + OUT (LSD0),A + LD A,(CURFLG) + OR A + RET NZ + JR CURSOR +; +; +HCUROF: + CALL PUSHRA + LD A,(CURFLG) + OR A + RET Z + JR CURSOR +; +; +FLASH: + IN A,(LSD2) ;bit 6 + RLCA + RLCA + JR NC,HCURON + JR HCUROF +; +;-------------------------------- +; +; cursor move +; +; ent HL x,y +; +;-------------------------------- +; +CURMOV: + CALL PUSHR + LD (CURXY),HL + CALL PONT ;cursor addr cal + LD (POSADR),HL + CALL PONTCB ;bitmap cursor pos cal + LD (BITADR),HL + RET + + +;------------------------------- +; +; poniter calc +; +; ent hl=curxy +; hl=text addr +;------------------------------- +PONTC: + LD HL,(CURXY) +PONT: + PUSH DE + PUSH AF + LD D,20H ;offset textbuf + LD E,L + LD A,H + ADD A,A ;2 + ADD A,A ;4 + ADD A,H ;5 + LD L,A + LD H,0 + ADD HL,HL ;10 + ADD HL,HL ;20 + ADD HL,HL ;40 +XPCU1: NOP ;ADD HL,HL *80 + ADD HL,DE + POP AF + POP DE + RET + + +;---------------------------------- +; +; pointer cal +; +; ent hl=curxy +; hl=bitmap addr +; +;---------------------------------- +PONTCB: + LD HL,(CURXY) +PONTB: + PUSH DE + PUSH AF + LD D,H + LD E,0 ;de=h*256 + LD A,L + LD L,H ;l=curx + LD H,E ;h=0 + ADD HL,HL ;*2 + ADD HL,HL ;*4 + ADD HL,HL ;*8 + ADD HL,HL ;*16 + ADD HL,HL ;*32 + ADD HL,HL ;*64 + ADD HL,DE ;*320 +XPCU2: NOP ;ADD HL,HL *640 + CALL ADDHLA + SET 7,H ;offset bitmap addr + POP AF + POP DE + RET +; +;------------------------------ +; +; +; +; cursor left,right,down,up +; +; +;------------------------------ +; +HOME: LD L,0 + LD A,(YS) + LD H,A + JP CSET +; +; +CR2: CALL PUSHR + LD HL,(CURXY) + LD A,L + OR A + JR NZ,CR1 + CALL TBCALC + LD A,(HL) + OR A + RET Z +CR1: LD A,0DH + JP CRT1C +; +; +CTR_M: XOR A + LD (CRTSFG+1),A ;sft mode reset + LD HL,(CURXY) + PUSH HL + INC H + CALL TBCALC + LD A,(YE) + LD D,A +CTR_ML: LD A,(HL) + OR A + JR Z,CTR_M4 + INC HL + INC E + LD A,D + CP E + JR NC,CTR_ML +CTR_M4: DEC E + POP HL + LD H,E + JR CTR_M2 +; +CDOWN: LD HL,(CURXY) + JR CDOWN2 +; +CRIGHT: LD HL,(CURXY) + INC L + LD A,(XE) + CP L + JR NC,CSET +CTR_M2: + LD L,0 +CDOWN2: INC H + JR CDOWN3 ;patch + PUSH HL + CALL TBCALC + LD (HL),1 + POP HL +CDOWN3: + LD A,(YE) + CP H + JR NC,CSET + LD H,A + PUSH HL + CALL SCROOL + POP HL +CSET: JP CURMOV +; +; +CUP: LD HL,(CURXY) + JR CUP2 +; +CLEFT: LD HL,(CURXY) + LD A,L + OR A + JR NZ,CSET2 + LD A,(XE) + LD L,A +CUP2: LD A,(YS) + CP H + JR C,CSET3 + LD A,(YS) + LD H,A + DEFB 3EH +CSET2: DEC L + DEFB 3EH +CSET3: DEC H + JR CSET +; +; +CTR_F: +;CTR_Y: + XOR A ;ALPHA + DEFB 21H +CTR_E: LD A,1 ;Shift lock + DEFB 21H +CTR_W: LD A,2 ;GRAPH + LD (CURMAK),A + RET +; +;---------------------------------- +; +; +; +; tab function +; +; +;---------------------------------- +; +C_TAB: LD B,0 ;tab + LD HL,(CURXY) + INC L + LD A,L +CTAB1: INC B + SUB 10 + JR NC,CTAB1 + XOR A +CTAB2: ADD A,10 + DJNZ CTAB2 + LD L,A +; + LD A,(XE) ;boader check + CP L + RET C +; + PUSH HL + LD A,(INPFLG) + OR A + JR Z,CTAB4 + LD A,(CURX) +; + LD H,A + LD A,L + SUB H + JR Z,CTAB4 + LD B,A +CTAB3: PUSH BC + LD A,20H ;space + CALL PLTOUT + POP BC + DJNZ CTAB3 +CTAB4: POP HL + JP CURMOV +;------------------------------ +; +; tab print function +; +; +;------------------------------ +PRNTT: + CALL CRT1S + LD A,(CURX) + SUB 10 + JR NC,$-2 + ADD A,10 + RET Z + JR PRNTT +; +; +;------------------------------ +; +; GET LINE V0.1A +; +; '84.7.11 +; +;------------------------------ +; +BINPUT: + PUSH HL + LD HL,(CURXY) + PUSH HL + PUSH DE + CALL TBCALC + POP DE + LD (HL),0 + POP HL + CALL GETL + JR C,BINERT + LD A,L + OR A + JR Z,BINERT + LD H,0 + ADD HL,DE + EX DE,HL + OR A +BINERT: POP HL + RET +; +; +GETL: + PUSH BC + PUSH HL + PUSH DE +LINP02: CALL INKEY1 + CP 0DH ;CR? + JP Z,GCRT + CP 1BH ;Break? + JR Z,LINP_B + PUSH AF + LD A,(CURMAK) + CP 2 ;Graph mode? + JR NZ,LINP10 + POP AF + CP 17H + JR NC,LINP11 + CP 11H + JR C,LINP11 +; + LD HL,(CTRSFT) + BIT 6,L ;Ctrl? + JR Z,LINP11 +; +LINP32: + RST 3 + DEFB _CRT1X + JR LINP02 +; +LINP10: POP AF +LINP11: + RST 3 + DEFB _CRT1C + JR LINP02 +; +LINP_B: SCF ;break key on +LINP80: + RST 3 + DEFB _CR1 + POP DE + POP HL + POP BC + RET +; +GCRT: LD HL,(CURXY) + CALL LBOUND ;begin end search + LD A,E + SUB D + LD E,A ;E:Y.length + LD H,D ;H:line count + LD L,0 + CALL PONT ;calc start address + LD A,(CWIDTH) ;X size + LD D,A + POP BC ;store address set + PUSH BC + EXX + PUSH HL + LD HL,(LINLIM) ;L:line inp limit + EXX +; +GCRT10: + LD A,(HL) ;A<--ascii code +GCRT36: INC HL + LD (BC),A ;(BC)<--ascii code + INC BC + EXX + DEC L + JR Z,GCRT40 ;line limit? + EXX + DEC D + JR NZ,GCRT10 ;X right end ? + LD A,(CWIDTH) + LD D,A + DEC E + JR NZ,GCRT10 ;line count=0 ? + EXX +GCRT40: POP HL + EXX + XOR A + LD (BC),A ;end address=0 + LD L,C + LD H,B + POP DE + PUSH DE + PUSH HL + OR A + SBC HL,DE + LD B,L + POP HL + LD A,20H ;clschr? + LD D,A + JP Z,LINP80 + DEC HL +GCRT50: LD A,(HL) + OR A + JR Z,GCRT52 + CP D + JR NZ,GCRT54 + LD (HL),0 +GCRT52: DEC HL + DJNZ GCRT50 + JR GCRT56 +GCRT54: LD A,(HL) + OR A + JR NZ,$+4 + LD (HL),' ' + DEC HL + DJNZ GCRT54 +GCRT56: OR A + JP LINP80 +; +;------------------------------- +; +; KEY V0.1A +; +; '84.7.11 +; +;------------------------------- +; +; INKEY$[(ACC)] +; A=FF : INKEY$ =GET +; A=0 : INKEY$(0)=KEY DATA +; A>0 : INKEY$(1)=FLASH GET +; +INKEY: + INC A + JR Z,INKEYFF + DEC A + JP Z,INKEY0 +; +; +INKEY1: + CALL KBFCHR + CALL PUSHR + CALL HCURON + EX AF,AF + PUSH AF + CALL KEYSNS + LD A,(REPTF) +_KEY10: EX AF,AF +_KEY12: LD B,16 ;chattering +_KEY14: CALL FLASH + CALL KEYSNS + BIT 1,A + JR NZ,_KEY12 ;same key ? + DJNZ _KEY14 + BIT 0,A + JR Z,_KEY20 ;key on ? + BIT 2,A + JR NZ,_KEY24 ;new key ? + EX AF,AF + DEC A + JR NZ,_KEY10 + LD A,6 ;Repeat step time + JR _KEY26 +_KEY20: PUSH HL + PUSH DE + PUSH BC + LD HL,KYDTB2 + LD DE,KYDTB1 + LD BC,10 + LDIR ;(KYDTB1)<--(KYDTB2) + POP BC + POP DE + POP HL +_KEY24: LD A,40H ;Repeat init time +_KEY26: LD (REPTF),A +_KEY28: CALL FLASH + CALL KEYGET + OR A + JR Z,_KEY29 + LD (KEYDAT),A + LD C,A + CALL HCUROF + POP AF + EX AF,AF + LD A,C + RET +; +_KEY29: + PUSH HL + PUSH BC + LD B,10 + LD HL,KYDTB1 +_KEY30: LD (HL),0FFH + INC HL + DJNZ _KEY30 + POP BC + POP HL + JR _KEY28 +; +INKEYFF: + CALL KBFCHR + PUSH HL + CALL KEYGET + LD HL,KEYDAT + OR A + JR Z,INKEY9 + CP (HL) + JR NZ,INKEY9 + POP HL + XOR A + RET +INKEY9: LD (HL),A + POP HL + RET +; +INKEY0: + CALL KBFCHR + CALL KEYGET + LD (KEYDAT),A + RET +; +KBFCHR: PUSH HL ;function key buffer + LD HL,(INBUFC) + LD A,L ;INBUFC + CP H ;INBUFL + POP HL + RET Z + EX (SP),HL + INC A + LD (INBUFC),A + LD HL,INBUFL ;INBUF-1 + CALL ADDHLA + LD A,(HL) + POP HL + RET +; +; +; +KEYSNS: CALL PUSHR + LD DE,KYDTB2 + LD HL,KYDTB1 + LD BC,0A00H + DI +KEYSN0: LD A,B + ADD A,0EFH + OUT (0D0H),A + CP 0F8H ;special strobe + IN A,(0D1H) + JR NZ,$+4 + OR 7FH + CP 0FFH + JR Z,$+4 + SET 0,C ;bit 0=key on + EX DE,HL + CP (HL) + LD (HL),A + EX DE,HL + JR Z,$+4 + SET 1,C ;bit 1=not same key + CPL + AND (HL) + JR Z,$+4 + SET 2,C ;bit 2=new key + INC HL + INC DE + DJNZ KEYSN0 + LD A,C +KEYSNE: EI + RET +; +KEYGET: CALL PUSHR + LD HL,KYDTB1 + LD DE,KYDTB2 + PUSH HL + PUSH DE + LD BC,10 + LDIR ;(KYDTB2)<--(KYDTB1) + POP HL + POP DE + LD BC,0AF9H + DI + LD A,C + OUT (0D0H),A + NOP + IN A,(0D1H) + LD (DE),A +KEYGL1: LD A,C + OUT (0D0H),A + CP 0F8H ;special strobe + IN A,(0D1H) + LD (DE),A + JR Z,KEYG13 + CPL + AND (HL) ;same--->Acc=0 +KEYGL3: LD (HL),A + INC DE + INC HL + DEC C + DJNZ KEYGL1 + EI + LD BC,0A00H +KYSTCK: DEC HL + LD A,(HL) + OR A + JR NZ,KEYGIN ;not same-->KEYGIN + INC C + DJNZ KYSTCK + LD B,10 +KEYGL2: DEC DE + LD A,(DE) + CP 0FFH + JR NZ,REPKIN +REPKI3: DJNZ KEYGL2 +KEYNUL: XOR A + JR KEYSNE +; +KEYG13: XOR A + JR KEYGL3 +; +REPKIN: LD A,B + CP 2 + JR NZ,REPKI2 + LD A,(DE) + AND 81H + JR NZ,REPKI3 + LD A,1BH ;break key + JR KEYSNE +REPKI2: CP 1 + JR Z,KEYNUL + LD A,(REPCD1) + CP B + JR NZ,REPKI3 + LD A,(DE) + PUSH DE + LD D,A + LD A,(REPCD2) + AND D + POP DE + JR NZ,REPKI3 + LD A,(KEYDAT) + JR KEYSNE +; +KEYGIN: PUSH AF + LD A,B + LD (REPCD1),A + LD A,(HL) + LD (REPCD2),A + POP AF + DEC B + JR NZ,KEYGI6 + CALL ABITB ;function key + LD A,(CTRSFT) + BIT 6,A + JR Z,KEYNUL + BIT 0,A + LD A,B + JR NZ,$+4 + ADD A,5 + CP 10 + JR NC,KEYNUL + LD L,A + LD H,0 + ADD HL,HL + ADD HL,HL + ADD HL,HL + ADD HL,HL + LD BC,FUNBUF + ADD HL,BC + LD A,(HL) + OR A + JR Z,KEYNUL + LD DE,INBUFC + LD A,1 + LD (DE),A + INC DE + LD BC,16 + LDIR + LD A,(INBUF) + JP KEYSNE +KEYGI6: CALL ABITB + LD A,C + ADD A,A + ADD A,A + ADD A,A + ADD A,B + LD L,A + LD H,0 + LD A,(CTRSFT) + BIT 6,A ;ctrl key + LD BC,NOMALB + JR Z,CTRLIN + PUSH AF + LD A,(CURMAK) + CP 1 ;shift+lock + JR NZ,SFTLKL + POP AF + XOR 1 + PUSH AF +SFTLKL: POP AF + BIT 0,A ;shift key + JR NZ,$+5 + LD BC,SHIFTB + LD A,(CURMAK) + CP 2 ;graph + JR NZ,CHRSET + LD BC,GRPHB + LD A,(CTRSFT) + BIT 0,A + JR Z,CHRSET + LD BC,GRPHS +CHRSET: CALL _KYTBL + LD A,C + JP KEYSNE +CTRLIN: CALL _KYTBL + LD A,C + CP 20H + JP C,KEYSNE + LD HL,CTKYTB + LD B,5 + CP (HL) + JR Z,CTRLC1 + INC HL + DJNZ $-4 + CP 40H + JP C,KEYNUL + CP 5BH + JP NC,KEYNUL + SUB 40H + JP KEYSNE +CTRLC1: LD A,32 + SUB B + JP KEYSNE +; +ABITB: LD B,8 + RRCA + JR C,ABITB2 + DJNZ $-3 + RET +ABITB2: DEC B + RET +; +; +BRKEY: + LD A,0E8H + OUT (0D0H),A + NOP + IN A,(0D1H) + AND 81H + RET Z + RLCA + RET C + JR BRKEY +; +KYDTB1: DEFS 1 +CTRSFT: DEFS 9 +KYDTB2: DEFS 10 +REPTF: DEFB 0 +REPCD1: DEFB 0 +REPCD2: DEFB 1 +; +; +NOMALB: DEFW 0BEAH + DEFB 0x90,0x17,0xFC,0x19,0x09,0x3B,0x3A,0x0D + DEFB 0x18,0x10,0x12,0x11,0x13,0x14,0x3F,0x2F +; +SHIFTB: DEFW 0C2AH + DEFB 0x90,0x17,0xFB,0x05,0x09,0x2B,0x2A,0x0D + DEFB 0x16,0x15,0x12,0x11,0x13,0x14,0xC6,0x5F +; +GRPHB: DEFW 0CE9H + DEFB 0x90,0x17,0x68,0x05,0x09,0x84,0xE9,0x0D + DEFB 0x16,0x15,0x12,0x11,0x13,0x14,0x8F,0x8B +; +GRPHS: DEFW 0C6AH + DEFB 0x90,0x17,0x6C,0x19,0x09,0xFE,0x89,0x0D + DEFB 0x16,0x15,0x12,0x11,0x13,0x14,0x8A,0x7B +; +CTKYTB: DEFB 5BH ; [ + DEFB 5CH ; \ + DEFB 5DH ; ] + DEFB 5EH ; ^ + DEFB 2FH ; / + + +;----------------------------------- +; +; +; CRT message out +; +; 05H,06H simulated +; +; ent. DE=msg top addr +; eof is NULL +; mode code 05h,06h +; CR is reset mode +;----------------------------------- +; +CRTSIMU:CALL PUSHR +CRTSI2: LD A,(DE) ;get msg data + INC DE ;next pointer + OR A + RET Z ;eof code is NULL + LD C,A + CP 05H ;sft lock in + JR Z,CRTSIE ;CTR_E + CP 06H ;normal mode + JR Z,CRTSIF ;CTR_F + SUB 'A' + CP 26 + JR NC,CRTSI4 ;skip not if code A-Z +CRTSFG: LD A,0 ;xxx + OR A + JR Z,CRTSI4 + LD HL,SMLTBL-'A' ;sftlock code trans. + LD B,0 + ADD HL,BC + LD C,(HL) +; +CRTSI4: LD A,C + RST 3 + DEFB _CRT1C + CP 0DH + JR NZ,CRTSI2 +CRTSIF: XOR A +CRTSIE: LD (CRTSFG+1),A + JR CRTSI2 +; +SMLTBL: + DEFB 0A1H ;a + DEFB 09AH ;b + DEFB 09FH ;c + DEFB 09CH ;d + DEFB 092H ;e + DEFB 0AAH ;f + DEFB 097H ;g + DEFB 098H ;h + DEFB 0A6H ;i + DEFB 0AFH ;j + DEFB 0A9H ;k + DEFB 0B8H ;l + DEFB 0B3H ;m + DEFB 0B0H ;n + DEFB 0B7H ;o + DEFB 09EH ;p + DEFB 0A0H ;q + DEFB 09DH ;r + DEFB 0A4H ;s + DEFB 096H ;t + DEFB 0A5H ;u + DEFB 0ABH ;v + DEFB 0A3H ;w + DEFB 09BH ;x + DEFB 0BDH ;y + DEFB 0A2H ;z + + +EQTBL: +;--------------------------------- +; +; +; +; CRT/KB driver +; +; +;--------------------------------- +_CRT: + DEFW _KB + DEFM "CRT" + DEFB 0 + DEFB 8AH ;Streem, O1C, W + DEFW 0 +IF RAMDISK + DEFW CRTINI_0 +ELSE + DEFW CRTINI +ENDIF + DEFW __RET ;ROPEN + DEFW __RET ;WOPEN + DEFW __RET ;CLOSE + DEFW __RET ;KILL + DEFW CRTIN + DEFW CRTOUT + DEFW CRTPOS +_KB: + DEFW _LPT + DEFM "KB" + DEFW 0 + DEFB 81H ;Streem, R + DEFW 0 + DEFW __RET ;INIT + DEFW __RET ;ROPEN + DEFW __RET ;WOPEN + DEFW __RET ;CLOSE + DEFW __RET ;KILL + DEFW CRTIN + DEFW __RET + DEFW __RET +; +CRTIN: + RST 3 + DEFB _GETL + LD A,80H ;BREAKZ + RET C + RST 3 + DEFB _COUNT + RET + +CRTOUT: EX AF,AF + LD HL,CRT1C + LD A,(DISPX) ;0=msg/1=msgx + OR A + JR Z,$+5 + LD HL,CRT1CX + EX AF,AF + JP (HL) + +CRTPOS: LD A,(CURX) + RET + + +; +;---------------------------------- +; +; +; CRT(LPT) routine +; +; CRT1C PR_1C +; CRT1CX PR_1CX +; CRTMSG PR_MSG +; PR_CR +; +;--------------------------------- +; +PR_CR: LD A,0DH +; +PR_1C: PUSH AF + LD A,(FILOUT) ;0=crt/1=lpt + OR A + JR NZ,_1CL + POP AF + JR CRT1C +_1CL: POP AF + JP LPT1C +; +PR_1CX: PUSH AF + LD A,(FILOUT) ;0=crt/1=lpt + OR A + JR NZ,_1CXL + POP AF + JR CRT1CX +_1CXL: POP AF + JP LPT1CX +; +PR_MSG: CALL PUSHR + LD HL,PR_1C + JR CRTMS2 +; +CRTMSG: CALL PUSHR + LD HL,CRT1C +CRTMS2: LD A,(DE) + OR A + RET Z + CALL _HL + INC DE + JR CRTMS2 + + +; +CRT1S: LD A,' ' +CRT1C: + CALL PUSHRA +CRT1C0: + LD C,A + LD A,(INPFLG) ;plot on/off + OR A + JR Z,CRT1C9 ;skip if plot off + LD A,C + CP 20H + JR NC,CRT1C4 ;skip if normal ascii + LD DE,(CURXY) ;control code only + LD HL,(XS) + CP 14H + JR Z,CRT1C1 ;skip if left code + CP 12H + JR NZ,CRT1C2 ; + LD HL,(YS) ;skip if up code + LD E,D +CRT1C1: LD A,L + CP E + JP NC,_BEEP ;error range +CRT1C2: + LD HL,PLTCOD ;plotter code trans. + LD B,0 + ADD HL,BC + LD A,(HL) + INC A + JR Z,CRT1C9 ; no operation when ffh + DEC A + JP Z,_BEEP ;beep when null code +CRT1C4: CALL PLTOUT +CRT1C9: LD A,C + CP 20H + JP C,CTRLJB ;control code trans. + JP ACCDI ;1 byte disply ent.=acc +; +CRT1CX: CALL PUSHRA + LD C,A + CP 0DH + JR Z,CRT1C0 + CALL ACCDI + LD A,(INPFLG) ;plot on/off + OR A + RET Z + LD A,C +; JR PLTOTX + + +; +PLTOTX: + CP 11H + JR C,PLT2E + CP 17H + JR C,PLTOK + CP 20H + JR C,PLT2E +PLTOUT: CP 60H + JR C,PLTOK + CP 70H + JR C,PLT2E + CP 0C1H + JR C,PLTOK + CALL CHKACC + DEFB 3 + DEFW 0CFD7H + DEFB 0FFH + JR Z,PLTOK +PLT2E: LD A,2EH +PLTOK: JP LPTOUT +; +PLTCOD: DEFB 0 ;00 + DEFB 0 ;01 + DEFB 0 ;02 + DEFB 0 ;03 + DEFB 0FFH ;04 CTR_D + DEFB 0FFH ;05 CTR_E + DEFB 0FFH ;06 CTR_F + DEFB 1DH ;07 + DEFB 0 ;08 + DEFB 0FFH ;09 C_TAB + DEFB 0 ;0A + DEFB 0 ;0B + DEFB 0 ;0C + DEFB 0DH ;0D + DEFB 0 ;0E + DEFB 0 ;0F + DEFB 0 ;10 DEL + DEFB 0AH ;11 DOWN + DEFB 03H ;12 UP + DEFB 20H ;13 RIGHT + DEFB 0EH ;14 LEFT + DEFB 0 ;15 HOME + DEFB 0 ;16 CLR + DEFB 0FFH ;17 GRAPH + DEFB 0 ;18 INST + DEFB 0FFH ;19 ALPHA + DEFB 0FFH ;1A KANA + DEFB 0DH ;1B + DEFB 0FFH ;1C hirakana + DEFB 0 ;1D + DEFB 0 ;1E + DEFB 0 ;1F + + +; +;-------------------------------- +; +; Monitor hot start +; +; +;-------------------------------- +STARTP: + DI + XOR A + OUT (LSDMD),A ;mz-800 320*200 4col + LD (INPFLG),A ;plot on/off + LD (FILOUT),A ;0=crt/1=lpt + LD SP,0000H ;stack pointer set + IM 2 ;interruptt mode 2 + LD A,4 + OUT (LSD3),A ;8253 int disable + OUT (LSE0),A ;bank dram + OUT (LSE1),A ;bank dram + CALL PALOFF ;palette all off + LD A,0FH ;interrupt vector + LD I,A + LD A,0FEH ;interrupt addrs + OUT (0FDH),A ;PIO int vector set + LD A,0FH + OUT (0FDH),A ;PIO mode 0 + PUSH BC + CALL CRTPWR ;CRT power on init + CALL PSGPWR ;PSG power on init + CALL EMMPWR ;EMM power on init + POP BC +STRTP2: DEFB 21H ;dummy byte + JR STRTP9 + + XOR A + LD (STRTP2),A + LD D,A + LD E,A + RST 3 + DEFB _TIMST + LD DE,_CMT + LD A,B + OR A + JR Z,STRTP4 + DEC A + JR Z,STRTP4 + LD DE,_FD + DEC A + JR Z,STRTP4 + LD DE,_QD +STRTP4: LD A,C + RST 3 + DEFB _SETDF +STRTP9: JP COLDST +; +; +; +; +CRTPWR: +; check vram option ? +; + DI + XOR A + OUT (LSDMD),A ;320*200 4 color + LD A,14H + OUT (LSRF),A + LD A,94H + OUT (LSWF),A + IN A,(LSE0) + OUT (LSE0),A ;cg off + LD HL,9FFFH + LD A,(HL) ;read + LD C,A + CPL + LD (HL),A ;write + CP (HL) ;verify + LD (HL),C ;pop mem + LD A,0 + JR NZ,CRTPW0 + INC A +CRTPW0: LD (MEMOP),A + IN A,(LSE1) + EI +; + LD A,1 ;window (0,24) + CALL DSMODE ;320*200 4 color +; +; data free area init +; +; + XOR A + LD (CURFLG),A ;cursor off + LD (CURMAK),A ;nomal char + RET +; +; +; ----------------------------- +; MZ-2Z009 User I/O driver +; FI:MON-USR ver 1.0A 03.17.84 +; ----------------------------- +; +; +; +_USR: + DEFW 0 + DEFM "USR" + DEFB 0 + DEFB 9FH ;STRM, FNM, W1C, R1C, W, R + DEFW 0 + DEFW __RET ;INIT + DEFW USRRO ;ROPEN + DEFW USRWO ;WOPEN + DEFW __RET ;CLOSE + DEFW __RET ;KILL + DEFW USRIN ;INP + DEFW USROUT ;OUT + DEFW __RET ;POS +; +USRRO: +USRWO: LD HL,ELMD1 + RST 3 + DEFB _DEASC + LD A,D + OR E + JP Z,ER60 + +IF RAMDISK + ;------------------------- + LD (USROUT+1),DE + RET +USRIN: +USROUT: LD HL,ZWRK1 ; "ZWRK1" is probably patched by the code above before a jp happens + ;------------------------- +ELSE + + LD (ZWRK1),DE + RET +USRIN: +USROUT: LD HL,(ZWRK1) + +ENDIF +; + JP (HL) + +; END (0FABH) + + +IO_END: +DEFS $FF0-IO_END + +; ------------------------- +; MZ-800 monitor Work area +; FI:MON2 ver 1.0A 9.05.84 +; ------------------------- +; + +; +; +; Interrupt vector +; +; +; ORG 0FF0H + DEFS 12 ;interrupt reserve +; +; ORG 0FFCH + DEFW PSGINT ;PSG(timer) interrupt + DEFW LPTINT ;Printer intrrupt +; +; Directry entry +; +; ORG 1000H +ELMD: ;file mode + DEFS 1 +ELMD1: ;file name + DEFS 17 +ELMD18: ;protection, type + DEFS 2 +ELMD20: ;size + DEFS 2 +ELMD22: ;adrs + DEFS 2 +ELMD24: ;exec + DEFS 2 +ELMD26: + DEFS 4 +ELMD30: + DEFS 2 +ELMD32: + DEFS 32 +; +; LU table entry +; +ZTOP: ;LU block top + DEFW 2 +ZLOG: ;LU# + DEFB 0 +ZRWX: ;1:R, 2:W, 3:X + DEFB 0 +ZEQT: ;Address of EQTBL + DEFW 0 +ZCH: ;CH# + DEFB 0 +ZEOF: ;EOF? + DEFB 0 +ZWRK1: ;Work 1 + DEFB 0 +ZWRK2: ;Work 2 + DEFB 0 +; + + +; +; EQT table entry +; +ZNXT: ;STRM SQR RND + DEFW 0 +ZDEVNM: ;-- device name -- + DEFS 4 +ZFLAG1: ;----- flag 1 ---- + DEFB 1 +ZFLAG2: ;----- flag 2 ---- + DEFB 0 +ZDIRMX: ;---- max dir ---- + DEFB 0 +ZINIT: ;--- initialize -- + DEFW 0 +ZRO: ;ROPEN RDINF +ZMAPS: ; Map.start + DEFW 0 +ZWO: ;WOPEN WRFIL +ZMAPB: ; Map.bytes + DEFW 0 +ZCL: ;CLOSE +ZSTRT: ; START +ZDIRS: ; Dir.start + DEFW 0 +ZKL: ;KILL +ZBLK: ; - Block/byte - + DEFW 0 +ZINP: ;INP RDDAT BREAD + DEFW 0 +ZOUT: ;OUT WRDAT BWRIT + DEFW 0 +ZPOS: ;Position +ZDELT: ; DELETE + DEFW 0 +ZWDIR: ; WR DIR + DEFW 0 +ZFREE: ; - free bytes - + DEFW 0 +; +defc ZBYTES = ZFREE+2-ZNXT ;Z-area bytes +; + DEFS 2 +; +DCHAN: ;default channel + DEFS 1 +DDEV: ;default device + DEFS 2 +; +; +__CRT: + DEFW _CRT +__LPT: + DEFW _LPT +; + + +; +; +; Work area pointers +; +TEXTST: DEFS 2 ; Basic - beginning of program ("Text start") +; +POOL: DEFS 2 ; File work areas (I/O work area) +; +VARST: DEFS 2 ; Start of Basic variables area +; +STRST: DEFS 2 ; Start of string text area +; +VARED: DEFS 2 ; Var & string end +; +TMPEND: DEFS 2 ; End of string work area +; +INTFAC: DEFS 2 ; Start of arithmetic memory (FAC) +; +MEMLMT: DEFS 2 ; LIMIT - address +; +MEMMAX: DEFW 0FF00H ; Maximum allowed RAM address (last available memory) + +; +; +; cursor / position work +; +; +; +CURXY: ;cursor position +CURX: + DEFB 0 +CURY: + DEFB 0 +POSADR: ;text buf addr + DEFW TEXTBF +BITADR: ;bitmap mem addr + DEFW 8000H +; +POINTX: ;Graphic x-coordinate + DEFS 2 +POINTY: ;Graphic y-coordinate + DEFS 2 +; +CURFLG: ;0:off 1:on + DEFB 0 +CURMAK: ;cursor mark 0=normal + DEFB 0 ; 1=sftlock, 2=graph + + +; +; CRT/LPT work +; +CMTMSG: ;if =0 disp cmt-msg + DEFS 1 +INPFLG: ;0=plot off 1=plot on + DEFB 0 +DISPX: ;0=MSG 1=MSGX + DEFS 1 +FILOUT: ;0=CRT 1=LPT + DEFB 0 +PSEL: ;Printer select + DEFB 1 +PCRLF: ;LPT CRLF CODE + DEFB 0DH +LPT_TM: ;LPT wait time + DEFB 14 +LPOSB: ;LPT position + DEFB 0 +PSMAL: ;LPT small/capital + DEFB 0 +PNMODE: ;LPT mode + DEFB 1 ; 1..text, 2..graph +; +; +; crt dispmode work +; +; +DMD: ;disp mode 0 320 4 col + DEFB 0 ; 2 320 16 col +; 4 640 2 col +; 6 640 4 col +MEMOP: ;option mem exit + DEFB 0 ;0= off 1= on +PWMODE: ;graphic operation mode + DEFB 0 +CMODE: ;color mode + DEFB 3 +CPLANE: ;curent active plane + DEFB 3 +MAXCF: ;maximum plane data + DEFB 4 +PMASK: ;mask plane data + DEFB 0FFH +GMODE: ;graphic color mode + DEFB 3 +; + DEFS 50H ;10A0 -- 10EF monitor stack +; +; +; +IBUFE: ;CMT workspace +IFDEF RAMDISK + DEFB 0x2e, 0x2e, 0x2e, 0x2e, 0x2e, 0x2e, 0x2e, 0x2e, 0x2e, 0x2e, 0x2e, 0x2e + DEFB 0x2e, 0x2e, 0x2e, 0x2e, 0x2e, 0x2e, 0x2e, 0x2e, 0x2e, 0x2e, 0x2e, 0x2e + DEFB 0xe0, 0xe0, 0xe0, 0xe0, 0xe0, 0xe0, 0xe0, 0xe0 + DEFM "MZ-5Z009" + DEFB 0xd7, 0xd7, 0xd7, 0xd7, 0xd7, 0xd7, 0xd7, 0xd7 + DEFB 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 + DEFM "*********V.1.02*********" + DEFB 0x2e, 0x2e, 0x2e, 0x2e, 0x2e, 0x2e, 0x2e, 0x2e, 0x2e, 0x2e, 0x2e, 0x2e + DEFB 0x2e, 0x2e, 0x2e, 0x2e, 0x2e, 0x2e, 0x2e, 0x2e, 0x2e, 0x2e, 0x2e, 0x2e + DEFS 24 +ELSE + DEFS 128 +ENDIF +; + DEFS 34 +;FLSDT: + DEFB 0EFH ;FLSDT + DEFS 2 ;STRFG, DPRNT +TMCNT: + DEFS 2 +SUMDT: + DEFS 2 ;SUMDT +CSMDT: + DEFS 2 ;CSMDT + DEFS 2 ;AMPM, TIMFG + DEFB 1 ;SWRK +TEMPW: + DEFB 4 ;TEMPW + DEFB 5 ;ONTYO + DEFS 3 ;OCTV, RATIO +; +KEYBM1: + DEFS 1 + +; 270 bytes for Keyboard buffer +KEYBUF: + DEFS 262 +KEY262: + DEFS 2 +KEY264: + DEFS 2 +KEY266: + DEFS 4 + +; FN key definition table +FUNBUF: + DEFB 7 + DEFM "RUN " + DEFB 0DH + DEFS 15-7 + +IF ALTFN + DEFB 6 + DEFM "LIST " + DEFS 15-6 + + DEFB 6 + DEFM "LOAD " + DEFS 15-6 + + DEFB 6 + DEFM "SAVE " + DEFS 15-6 + + DEFB 7 + DEFM "VERIFY" + DEFB 0DH + DEFS 15-7 + + DEFB 14 + DEFM "INIT\"CRT:M2\"" + DEFB 0x14,0x14 + DEFS 15-14 + + DEFB 15 + DEFM "INIT\"LPT:M0,S2," + + DEFB 11 + DEFM "OUT@ $E9,0" + DEFB 0x14 + DEFS 15-11 + + DEFB 8 + DEFM "DEF.CMT" + DEFB 0DH + DEFS 15-8 + + DEFB 8 + DEFM "DIRRAM " + DEFB 0DH + DEFS 15-8 + +ELSE + DEFB 5 + DEFM "LIST " + DEFS 15-5 + + DEFB 5 + DEFM "AUTO " + DEFS 15-5 + + DEFB 6 + DEFM "RENUM " + DEFS 15-6 + + DEFB 6 + DEFM "COLOR " + DEFS 15-6 + + DEFB 5 + DEFM "CHR$(" + DEFS 15-5 + + DEFB 8 + DEFM "DEF KEY(" + DEFS 15-8 + + DEFB 4 + DEFM "CONT" + DEFS 15-4 + + DEFB 6 + DEFM "SAVE " + DEFS 15-6 + + DEFB 6 + DEFM "LOAD " + DEFS 15-6 +ENDIF + +; +INBUFC: ;INBUF counter + DEFB 0 +INBUFL: ;INBUF length + DEFB 0 +INBUF: ;pending key 16 + DEFS 16 +; +LINLIM: ;getline buffer limit + DEFB 255 ;const +KEYDAT: + DEFB 0 +; +; timer work +; +AMPM: + DEFB 0 +SECD: + DEFW 0 +; +; scrool work +; +XS: ;console X start const=0 + DEFB 0 +XE: ;console X end + DEFB 39 +CWIDTH: ;console width + DEFW 40 ;cwidth=xe+1 +CSIZE: ;csize=cwidth*8 + DEFW 320 +YS: ;console Y start + DEFB 0 +YE: ;console Y end + DEFB 24 +YW: ;console Y width + DEFB 25 ;yw=ye-ys+1 +; +; scrool custom data +; +SOF: ;scrool offset + DEFW 0 +SW: ;scrool width + DEFB 7DH ;sw = yw*5 +SSA: ;scrool start + DEFB 0 ;ssa = ys*5 +SEA: ;scrool end + DEFB 7DH ;sea =(ye+1)*5 +SSW: ;scrool offset limit + DEFW 3E8H ;ssw = sw *8 +; +; crt work (basic used) +; +CRTMD1: ;crt bit data + DEFB 1 +CRTMD2: ;crt mode no. data + DEFB 1 +SELCOL: ;default color + DEFB 3 +PAIWED: + DEFW 0 ;paint stack end +; +; +; +; palette work +; +PALBK: ;palette block number + DEFB 0 +PALAD: ;palette init addr + DEFW PAL4T +PALTBL: ;palette data table + DEFS 4 +; +; +; palette init data table +; +PAL2T: ;palette + DEFB 00H ;PAL 0 black + DEFB 1FH ;PAL 1 white + DEFB 2FH ;PAL 2 white + DEFB 3FH ;PAL 3 white +; +PAL4T: ;palette + DEFB 00H ;PAL 0 black + DEFB 11H ;PAL 1 blue + DEFB 22H ;PAL 2 red + DEFB 3FH ;PAL 3 white +; +PAL16T: ;palette + DEFB 00H ;PAL 0 black + DEFB 11H ;PAL 1 blue + DEFB 22H ;PAL 2 red + DEFB 33H ;PAL 3 purple +; +; +; cursor init data table +; +CURDT1: ;cursor normal + DEFB 0FFH ;0 + DEFB 0FFH ;1 + DEFB 0FFH ;2 + DEFB 0FFH ;3 + DEFB 0FFH ;4 + DEFB 0FFH ;5 + DEFB 0FFH ;6 + DEFB 0FFH ;7 +; +CURDT2: ;cursor sftlock + DEFB 7EH ;0 + DEFB 0FFH ;1 + DEFB 0FFH ;2 + DEFB 0FFH ;3 + DEFB 0FFH ;4 + DEFB 0FFH ;5 + DEFB 0FFH ;6 + DEFB 7EH ;7 +; +CURDT3: ;cursor graph + DEFB 00H ;0 + DEFB 00H ;1 + DEFB 00H ;2 + DEFB 00H ;3 + DEFB 00H ;4 + DEFB 00H ;5 + DEFB 00H ;6 + DEFB 0FFH ;7 +; +; screen management buffer +; +SCRNT0: + DEFS 25 +SCRNTE: DEFB 0 +; +; +; emm work +; +; +EMFLG: + DEFS 1 +EMPTR: + DEFS 2 +EMWP0: + DEFS 2 +EMWP1: + DEFS 2 + + +; ------------------------------ +; +; lpt work +; +; ------------------------------ +; +WPULSE: DEFB 0 +WSTROB: DEFB 0 +PBCMAW: DEFW 3FF0H +PBCN: + DEFW 0 ; +PBCIP: DEFW 0C000H ;FIFO inp pointer +PBCOP: DEFW 0C000H ;FIFO out pointer +PBCTOP: DEFW 0C000H ;buffer top +SPLFLG: DEFB 0 ;spool on/stop/off +OUTIMF: DEFB 0 ;output image flag +HPCOUN: DEFB 4 ;printer counter +HERRF: + DEFB 0 ;ROM error flag +; +; +;--------------------------------- +; +; +; code translation table +; +;--------------------------------- +; +CTABLE: + DEFW CTABL1 ;change table address +; +; +CTABL1: DEFB 39 ;change number +; +; + DEFB 023H ;# + DEFB 023H +; + DEFB 040H ;@ + DEFB 040H +; + DEFB 05BH ;[ + DEFB 05BH +; + DEFB 05CH ;\ + DEFB 05CH +; + DEFB 05DH ;] + DEFB 05DH +; + DEFB 08BH ;^ + DEFB 05EH +; + DEFB 090H ;under_ + DEFB 05FH +; + DEFB 093H ;' + DEFB 060H +; + DEFB 0A1H ;a + DEFB 061H +; + DEFB 09AH ;b + DEFB 062H +; + DEFB 09FH ;c + DEFB 063H +; + DEFB 09CH ;d + DEFB 064H +; + DEFB 092H ;e + DEFB 065H +; + DEFB 0AAH ;f + DEFB 066H +; + DEFB 097H ;g + DEFB 067H +; + DEFB 098H ;h + DEFB 068H +; + DEFB 0A6H ;i + DEFB 069H +; + DEFB 0AFH ;j + DEFB 06AH +; + DEFB 0A9H ;k + DEFB 06BH +; + DEFB 0B8H ;l + DEFB 6CH +; + DEFB 0B3H ;m + DEFB 6DH +; + DEFB 0B0H ;n + DEFB 6EH +; + DEFB 0B7H ;o + DEFB 6FH +; + DEFB 09EH ;p + DEFB 70H +; + DEFB 0A0H ;q + DEFB 71H +; + DEFB 09DH ;r + DEFB 72H +; + DEFB 0A4H ;s + DEFB 73H +; + DEFB 096H ;t + DEFB 74H +; + DEFB 0A5H ;u + DEFB 75H +; + DEFB 0ABH ;v + DEFB 76H +; + DEFB 0A3H ;w + DEFB 77H +; + DEFB 09BH ;x + DEFB 78H +; + DEFB 0BDH ;y + DEFB 79H +; + DEFB 0A2H ;z + DEFB 7AH +; + DEFB 0BEH ;{ + DEFB 7BH +; + DEFB 0C0H ;Ý + DEFB 7CH +; + DEFB 080H ;} + DEFB 7DH +; + DEFB 094H ;~ + DEFB 7EH +; + DEFB 07FH ; + DEFB 7FH +; +; +; END (142BH) + + +; ORG 142BH + +; +;--------------------------------- +; XMON-ROM 8.30.84 +; +; JISX MZ-800 --> ASC +; ent A :data +; IX :output sub +; (HL) :tab counter +; E :DISPX +; +;--------------------------------- +; +; +JISX: + CP 0DH + JR Z,JISXCR + CP 0AH + JR Z,JISXCR + CALL AJISX ;code change + CP 20H + JR NC,_IX + BIT 0,E ;print/p ? + JR Z,_IX ;no + LD A,' ' +_IX: JP (IX) +; +JISXCR: CALL _IX + LD (HL),0 + RET +; +AJISX: PUSH BC + LD C,0 + CALL AJISX1 + POP BC + RET +; +; +AJISX1: CALL PUSHR + LD HL,(CTABLE) + LD B,(HL) ;code counter set + INC HL ;HL=MZ-800 + LD D,H ;DE=JIS + LD E,L + INC DE + BIT 0,C ;MZ-800 --> JIS ? + JR Z,AJISX2 ;yes + EX DE,HL +AJISX2: CP (HL) + JR Z,AJISX3 ;code match + INC HL + INC HL + INC DE + INC DE + DJNZ AJISX2 + RET +; +AJISX3: LD A,(DE) + RET +; +; +;--------------------------------- +; +; +; JISR ASC --> MZ-800 +; ent (A) :data +; IX :input sub +; +;--------------------------------- +; +; +JISR: + CALL _IX ;input sub :A set + RET C +; + PUSH BC + LD C,1 + CALL AJISX1 + POP BC + OR A + RET +;--------------------------------- +; +_LPT: + DEFW _CMT + DEFM "LPT" + DEFB 0 + DEFB 8AH ;Streem, O1C, W + DEFW 0 + DEFW LPTINI + DEFW ER59 ;ROPEN + DEFW __RET ;WOPEN + DEFW __RET ;CLOSE + DEFW __RET ;KILL + DEFW 0 ;INP + DEFW LPT1C_ + DEFW LPTPOS +; +; +PIO_AC = 0FCH ;Port-A control +PIO_AD = 0FEH ;Port-A data +PIO_BC = 0FDH ;Port-B control +PIO_BD = 0FFH ;Port-B data +; +P_PLT = 0 ;1P01, 1P09 +P_KP5 = 1 ;KP5 +P_JIS = 2 ;JIS code +P_THRU = 3 ;thrue +; +; +LPTPOS: LD A,(INPFLG) + OR A + LD A,(LPOSB) + RET Z + LD A,(CURX) + RET +; +; +; +;---------------------------------- +; +; PL ROM CALL +; +;---------------------------------- +defc ROMST = 03H ;F403H +defc ROMST1 = 0F400H +; +; +TIMST: + CALL ROMJP2 + DEFB ROMST +; +TIMRD: + CALL ROMJP2 + DEFB ROMST+3 +; +STICK: + CALL ROMJP2 + DEFB ROMST+6 +; +STRIG: + CALL ROMJP2 + DEFB ROMST+9 +; +HCPY: + CALL ROMJP + DEFB ROMST+12 +; +LPT1C_: + LD HL,DISPX + BIT 0,(HL) + JR NZ,LPT1CX +; +LPT1C: + PUSH IY + EX AF,AF + LD A,3+15 ;F003+15 + LD (APL1CD),A + LD A,_CRT1C +APL1CF: LD (APL1CE),A + EX AF,AF + CALL APL1C + POP IY + PUSH BC + LD B,A + LD A,(INPFLG) + OR A + LD A,B + POP BC + RET Z + RST 3 +APL1CE: DEFB _CRT1C + RET +APL1C: LD IY,JISX + CALL ROMJP +APL1CD: DEFB ROMST+15 +; +LPT1CX: + PUSH IY + EX AF,AF + ;LD A,3+18 ;F003+18 + LD A,ROMST+18 + LD (APL1CD),A + LD A,_CRT1C + JR APL1CF +; +LPTINI: + CALL ROMJP + DEFB ROMST+21 +; +LPTOUT: + CALL ROMJP + DEFB ROMST+24 +; +PBCCLR: + CALL ROMJP + DEFB ROMST+27 +; +SPLOFF: + CALL ROMJP + DEFB ROMST+30 +; +SPLON: + CALL ROMJP + DEFB ROMST+33 +; +SPLSW: + CALL ROMJP + DEFB ROMST+36 +; +LPTM02: + CALL ROMJP + DEFB ROMST+39 +; +;--------------------------- +; +; +; +ROMJP: EX AF,AF + LD A,(PSEL) + BIT P_KP5,A + JR Z,ROMJP1 +; + PUSH BC + LD B,3 + RST 3 + DEFB _MCTRL + POP BC +; +ROMJP1: EX AF,AF +ROMJP2: EX AF,AF + XOR A + LD (KEY266),HL + LD (HERRF),A + EX AF,AF + DI + LD (KEY264),SP + EX (SP),HL ;HL=call stored address + LD SP,HL ; + POP HL ;HL=call address + OUT (LSE3),A + LD SP,KEY262 ; Temporary stack (262 bytes) + CALL HLJP + OUT (LSE1),A + LD SP,(KEY264) + EX (SP),HL + INC SP + INC SP + EI + EX AF,AF + LD A,(HERRF) + OR A + JR NZ,ROMERR + EX AF,AF + RET +HLJP: LD H,0F4H ;HL=F4??H + JP (HL) +; +; +ROMERR: + LD B,A ;B=0 + EX AF,AF + DEC B ;B=1 + JP Z,BREAKZ + DEC B ;B=2 + JP NZ,ERRORJ +ROMER1: LD HL,(PBCN) ;INIT M2 + LD A,H + OR L + JR Z,LPTM02 + CALL SPLON + RST 3 + DEFB _BREAK + JP Z,BREAKZ + JR ROMER1 +; +; +LPTINT: + DI + PUSH AF + PUSH HL + PUSH BC + LD (WKLINT),SP + LD SP,WKLINT + OUT (LSE3),A + CALL ROMST1 + OUT (LSE1),A + LD SP,(WKLINT) + POP BC + POP HL + POP AF + EI + RETI + DEFS 8 +WKLINT: DEFW 0 +; +; --------------------------- +; MZ-800 Monitor command +; FI:MONOP ver 1.0A 8.04.84 +; --------------------------- +; +MONOP: + PUSH HL + LD DE,(ERRORP) + PUSH DE + LD DE,MONERR + LD (ERRORP),DE ;error ret adr set + LD A,(LINLIM) + PUSH AF + LD A,100 ;getline max set + LD (LINLIM),A + LD (MONSP+1),SP ;stack pointer push + XOR A + LD (FILOUT),A ;crt mode +MONCLD: LD SP,0000H ;stack initize +MONHOT: LD BC,MONHOT + PUSH BC ;last return addrs set + RST 3 + DEFB _CR2 ;linefeed & cr + LD A,'*' ;prompt disp + RST 3 + DEFB _CRT1C + CALL MONEDT ;memory corretion ? + JR NC,$-3 + LD A,(DE) + CP '*' + RET NZ ;prompt check + INC DE + LD A,(DE) ;acc=next interpret data + INC DE ;next interpret data addr +; +; +; moniter tabel command jump +; + EXX ;parameter push + LD HL,MNCMTB + LD B,10 ;commands counter +MNCMCP: CP (HL) + INC HL + JR Z,MNCMOK ;skip if just command + INC HL ;next search + INC HL + DJNZ MNCMCP + EXX + RET +; +MONERR: LD C,A + AND 7FH + JR Z,MONCLD ;Break + LD A,C ;acc=errcode + RST 3 + DEFB _ERRX ;display error messege + RST 3 + DEFB _ERCVR ;error recover fd/qd + JR MONCLD +; +; +MNCMOK: LD E,(HL) + INC HL + LD D,(HL) + PUSH DE ;commnd addr set + EXX ;parameter pop + RET +; +MNCMTB: DEFM 'D' + DEFW MONDMP + DEFM 'M' + DEFW MONSET + DEFM 'P' + DEFW MONPRT + DEFM 'G' + DEFW MONGOT + DEFM 'F' + DEFW MONSCH + DEFM 'R' + DEFW MONSP + DEFM 'S' + DEFW MONSAV + DEFM 'L' + DEFW MONLOD + DEFM 'V' + DEFW MONVRY + DEFM 'T' + DEFW MONTRN +; +MONPRT: LD A,(FILOUT) ;lpt/crt + XOR 1 + LD (FILOUT),A + RET +;--------------------------------- +; +; moniter save commnd +; +;--------------------------------- +MONSAV: CALL SAVTRN ;set addrs + RET C + EXX + CALL FNMST ;file name set + EXX + LD (ELMD20),BC ;bytes + LD (ELMD22),DE ;data adrs + LD (ELMD24),HL ;exec adrs + RST 3 + DEFB _SAVEF ;save file + RET +;--------------------------------- +; +; moniter load command +; +;--------------------------------- +MONLOD: CALL HLSET ;load addr set + PUSH HL ;hl=load addrs + PUSH AF + CALL LOAVRY ;filename set & open + POP AF + POP HL + JR NC,$+5 ;user load addr set ?? + LD HL,(ELMD22) + RST 3 + DEFB _LOADF ;load file + RET +;--------------------------------- +; +; filename set & open +; +;--------------------------------- +LOAVRY: CALL FNMST ;file name set + RST 3 + DEFB _LOPEN ;ropen + CP 1 + RET Z + JP ER61 ;File mode error +;--------------------------------- +; +; moniter verify command +; +;--------------------------------- +MONVRY: CALL LOAVRY ;filename set + LD HL,(ELMD22) + RST 3 + DEFB _VRFYF ;file verify + RET +;--------------------------------- +; +; moniter rerturn command +; +; to BASIC +;--------------------------------- +MONSP: LD SP,0000H + POP AF + LD (LINLIM),A + POP HL + LD (ERRORP),HL + POP HL + RET +;--------------------------------- +; +; moniter operation +; +;--------------------------------- +MONEDT: LD DE,0FF00H ;moniter work + RST 3 + DEFB _GETL + JR C,MONEDE +; +; check ':xxxx=' +; + LD A,(DE) + CP ':' ;mem correct ?? + SCF + RET NZ +; + INC DE + CALL HLSET ;addrs input ? + RET C + LD A,(DE) + INC DE + XOR 3DH ;"=" input ? + RET NZ +; +; +NEXTAC: CALL ACSET ;data read + CCF + RET NC + LD (HL),A ;mem correction ! + INC HL ;next pointer + JR NEXTAC +; +; +MONEDE: LD (DE),A ;error + RET +;---------------------------------- +; +; 4 ascii to binary (word) +; +; ent. de=ascii data pointer +; ext hl=xxxxH +; +;---------------------------------- +HLSET: PUSH HL + CALL SPCTAC ;separater search + PUSH DE + CALL ACSETH ;2 ascii to binary + JR C,HLSETE + LD H,A + CALL ACSETH ;2 ascii to binary + JR C,HLSETE + LD L,A + POP AF + POP AF + XOR A + RET +; +HLSETE: POP DE + POP HL + SCF + RET +;---------------------------------- +; +; separater search +; +;---------------------------------- +SPCTA2: INC DE +SPCTAC: LD A,(DE) + CP 20H + JR Z,SPCTA2 + RET +;--------------------------------- +; +; 1 ascii to binary (nibble) +; +; ent. de=ascii data pointer +; ext acc= 0xH +; +;--------------------------------- +ACSETS: LD A,(DE) + RST 3 + DEFB _CKHEX ;0-9 a-f check + INC DE ;next pointer + RET +;--------------------------------- +; +; 2 ascii to binary (byte) +; +; ent. de=ascii data pointer +; ext acc= xxH +; +;--------------------------------- +ACSET: CALL SPCTAC ;separeter search + CP ';' + JR Z,SEMIOK ;skip if ascii input +ACSETH: + PUSH BC + PUSH DE + CALL ACSETS ;1 ascii to binary(nible) + JR C,ACSTER + LD C,A ;high nible + CALL ACSETS ;1 ascii to binary(nible) + JR C,ACSTER + LD B,A ;low nible + LD A,C + RLCA + RLCA + RLCA + RLCA + ADD A,B + LD C,A + LD A,C + POP BC + POP BC + OR A + RET +; +ACSTER: POP DE + POP BC + SCF + RET +;---------------------------------- +; +; ascii code input mode +; +;---------------------------------- +SEMIOK: INC DE + LD A,(DE) + INC DE + OR A ;¯¯JR ACSETO + RET ;¯¯ +;---------------------------------- +; +; moniter jump commnd +; +;---------------------------------- +MONGOT: CALL HLSET ;addrs set + RET C + JP (HL) +;---------------------------------- +; +; moniter dump commnd +; +;---------------------------------- +MONDMP: CALL HLSET ;top addrs set + JR C,MONDP1 ;skip if 'd' only + PUSH HL + CALL HLSET ;end addrs set + JR C,MONDP2 ;skip if top addrs only + POP DE + EX DE,HL + JR MONDP3 +; +; +; +MONDP2: POP HL ; +MONDP1: EX DE,HL + LD HL,80H + ADD HL,DE ;last addrs calc + EX DE,HL +MONDP3: LD C,8 ;counter set + CALL MONDPS ;dump list disp + RET C + PUSH HL + SBC HL,DE ;dump end calc + POP HL + RET NC + JR MONDP3 +; +MONDPS: CALL HLHXPR ;addrs disp + LD B,C + PUSH HL +MONDP4: LD A,(HL) ;data read + CALL ACHXPR ;1 byte disp + INC HL + LD A,20H ;space disp + RST 3 + DEFB _1C + DJNZ MONDP4 + POP HL +; + LD A,'/' ;separater disp + RST 3 + DEFB _1C + LD B,C +MONDP5: LD A,(HL) ;data read + CP 20H ;contol code + JR NC,$+4 + LD A,'.' ;yes, control code + RST 3 + DEFB _1C + INC HL ;next pointer + DJNZ MONDP5 +; + RST 3 + DEFB _CR + RST 3 + DEFB _HALT ;break & stop + OR A + RET +;-------------------------------- +; +; disp addrs +; +; ent. hl=addrs +; ':xxxx=' +; +;-------------------------------- +HLHXPR: LD A,':' + RST 3 + DEFB _1C + LD A,H + CALL ACHXPR ;acc disp + LD A,L + CALL ACHXPR ;acc disp + LD A,'=' + RST 3 + DEFB _1C + RET +;-------------------------------- +; +; acc disp +; +; ent. acc = disp data +; +;-------------------------------- +ACHXPR: PUSH AF + RLCA + RLCA + RLCA + RLCA + CALL AC1HXP ;nible disp + POP AF +AC1HXP: AND 0FH ;ascii trans + ADD A,30H + CP ':' + JR C,$+4 + ADD A,7 + RST 3 + DEFB _1C ;disp acc(nibble) + RET +;--------------------------------- +; +; moniter mem correction comd +; +;--------------------------------- +MONSET: CALL HLSET ; + LD A,(FILOUT) ;lpt/crt switch + PUSH AF + XOR A + LD (FILOUT),A ;crt mode +MONSTL: + RST 3 + DEFB _CR2 + CALL HLHXPR ;addrs disp + LD A,(HL) ;data read + CALL ACHXPR ;data disp + LD A,20 ;back space + RST 3 + DEFB _CRT1C + RST 3 + DEFB _CRT1C + CALL MONEDT ;moniter operation + JR NC,MONSTL + POP AF + LD (FILOUT),A + RET +;-------------------------------- +; +; moniter search command +; +;-------------------------------- +MONSCH: CALL HLSET ;start addrs + RET C + PUSH HL + CALL HLSET ;end addrs + POP BC + RET C + PUSH HL ;hl end addr + PUSH BC ;bc start addr + LD HL,0FF00H ;check data read + CALL NEXTAC ;(hl)<--data + LD DE,0FF00H + OR A + SBC HL,DE ;check data bytes + LD C,L + POP HL + PUSH HL + EXX + POP HL ;hl start addr + POP DE ;de end addr + EXX + RET Z +MNSHLP: CALL HLDECK ;de=0FF00H + JR NZ,SKPSCH ;de check databuf + CALL MONDPS ;data disp + RET C +SKPSCH: + RST 3 + DEFB _BREAK + RET Z + EXX + INC HL ;next check pointer + PUSH HL + SCF + SBC HL,DE ;end check ? + POP HL + RET NC + PUSH HL + EXX + POP HL ;next check pointer + JR MNSHLP +;---------------------------------- +; +; 3 pointer data interpret +; +; ent de=ascii data top addr +; +; ext de=first data +; bc=(second-first) data +; hl=last data +; +; used save,xfer commnd +; +; command : save : xfer +; +; de : start: source +; bc : bytes: bytes +; hl : end : destination +;---------------------------------- +SAVTRN: CALL HLSET ;first + PUSH HL + CALL NC,HLSET ;second + POP BC ;first + RET C + SBC HL,BC ;calc bytes + INC HL + PUSH HL ;bytes + PUSH BC ;first + CALL HLSET ;last + PUSH HL ;last + EXX + POP HL ;last + POP DE ;first + POP BC ;bytes + RET +;------------------------------- +; +; moniter xfer command +; +;------------------------------- +MONTRN: CALL SAVTRN ; + RET C + EX DE,HL + PUSH HL + SBC HL,DE ;direction check + POP HL + JR C,LDDRTR + LDIR + RET +LDDRTR: ADD HL,BC ;last addrs calc + DEC HL + EX DE,HL + ADD HL,BC + DEC HL + EX DE,HL + LDDR + RET +;---------------------------------- +; +; filename set +; +;---------------------------------- +FNMST: LD A,(DE) + OR A + JR Z,FNMST2 + INC DE + CP ':' ;demiliter seach + JR NZ,FNMST +FNMST2: + RST 3 + DEFB _COUNT ;count string length + RST 3 + DEFB _DEVFN ;interpret dev. file name + LD A,1 + LD (ELMD),A ;.OBJ atribut + RET +;--------------------------------- +; +; check (de) (hl) ? +; +; hl,de check data point +; c counter +; +;--------------------------------- +HLDECK: LD A,(DE) + CP (HL) + RET NZ + PUSH BC + PUSH DE + PUSH HL + LD B,C +HLDEC1: LD A,(DE) + CP (HL) + JR NZ,HLDEC2 + INC DE + INC HL + DJNZ HLDEC1 + XOR A +HLDEC2: POP HL + POP DE + POP BC + RET +; +; END (17EAH) + + +;========================= +IF RAMDISK +INST_0: + LD A,B + OR C + RET Z + LDDR + XOR A + RET + +CRTINI_0: + LD A,$C0 + LD (_SET+2),A + LD (BOXC0+1),A + JP CRTINI + +ENDIF +;========================= + + +XMON_END: +DEFS $1800-XMON_END + + + +; ----------------------------- +; Lx-monitor IOCS-part +; FI:MON-IOCS ver 1.01 5.24.84 +; ----------------------------- +; + +; ORG 1800H +; +_IOCS: + JP _START +; +; FALG1 bit position +; +defc __REN = 0 ;ROPEN enable +defc __WEN = 1 ;WOPEN enable +defc __RCHR = 2 ;Read at 1 char +defc __WCHR = 3 ;Write at 1 char +defc __FNM = 4 ;File name exist +defc __RND = 5 ;FD +defc __SEQ = 6 ;CMT, QD, XM +defc __STRM = 7 ;CRT, LPT, RS, USR + +; +; FLAG2 bit position +; +defc __CMT = 7 ;Disp filename +defc __1OPN = 6 ;1 file only open +defc __1WOP = 5 ;1 file only wopen +defc __EOFE = 4 ;select EOF process + + +; ZRWX bit position +; +defc __ROPN = 0 ;R.opened +defc __WOPN = 1 ;W.opened +defc __XOPN = 2 ;X.opened +defc __LOPN = 3 ;L.opened +defc __EOF = 7 ;End of file + + + +; bit 0,1,2 ..... max channel +; +; +; DIR offset +; +defc _SIZE = 20 +defc _PTR = 64 ;BSD block pointer +defc _BLKNO = 64+16-2 ;BSD block number + +; Logical Units +; +defc CMTLU = 80H +defc LDALU = 81H +defc CRTLU = 88H +defc LPTLU = 89H +defc DATLU = 8AH +; +; +CRTLU__: LD A,(ZLOG) + CP CRTLU + RET +; +ZMODE: DEFW 0 ;File mode +ZBUFF: + DEFW 0 ;Buffer adrs +ZBUFE: + DEFW 0 ;Buffer end + + +; +; SVC .PRSTR ;print string into file +; ent DE:adrs +; B: length +; +PRTSTR: + CALL IO_RDY + CALL PRTST0 + +IO_OK: + XOR A + LD (QSEG),A + RET +; +IO_RDY: + LD A,(ZLOG) + LD (QSEG),A + RET +; +PRTST0: CALL PUSHR + LD A,(ZFLAG1) + BIT __STRM,A + LD HL,PRT1C + JR Z,PRTST2 + BIT __WCHR,A ;Output at + LD HL,_ZOUT + JR NZ,PRTST2 ; 1 char +_ZOUT: + LD IX,(ZOUT) ; 1 line + CALL IOCALL + RET +; +PRTST2: LD A,B ;SEQ/RND + OR A + RET Z + LD A,(DE) +PRTST4: CALL _HL ;PRT1C or _ZOUT + INC DE + DEC B + JR PRTST2 +; +PRT1C: CALL PUSHR + LD E,(IY+_PTR) + LD D,(IY+_PTR+1) + LD HL,(ZBUFF) + ADD HL,DE + LD (HL),A + INC DE + LD HL,(ZBLK) + OR A + SBC HL,DE + CALL Z,PRT1B ;Buffer full + LD (IY+_PTR),E + LD (IY+_PTR+1),D + INC (IY+_SIZE) + RET NZ + INC (IY+_SIZE+1) + RET NZ + JP ER55 ;too long file + + +; +PRT1B: PUSH BC ;Output 1 block + LD B,02H ;F# not update, blocked +PRT1B0: CALL _RND + LD IX,_ZOUT + JR Z,$+6 + LD IX,PRX1B + LD A,B + CALL SEQSET + CALL _IX1 +PRT1B9: INC (IY+_BLKNO) + LD DE,0 + POP BC + RET +; +_IX1: JP (IX) +; +PRT1BX: LD A,1AH ;Output last block + LD E,(IY+_PTR) + LD D,(IY+_PTR+1) +PRT1X2: LD HL,(ZBUFF) + ADD HL,DE + LD (HL),A + INC DE + LD HL,(ZBLK) + XOR A + SBC HL,DE + JR NZ,PRT1X2 + PUSH BC + LD HL,(ZBUFF) + DEC HL + LD (HL),0FFH ;EOF mark + DEC HL + LD (HL),0FFH + LD B,06H ;F# update, blocked + JR PRT1B0 +; +; +SEQSET: LD BC,(ZBLK) + INC BC + INC BC + LD HL,(ZBUFF) + DEC HL + DEC HL + LD DE,(ZMODE) + RET +; +; +_ZEND: DEFB 0F6H +_ZSTRT: XOR A + LD IX,(ZSTRT) + CALL IOCALL + RET + + +; +; SVC .INSTT ;INPUT command start +; +INPSTRT: + CALL CRTLU__ ;input start + RET NZ + PUSH DE + LD DE,KEYBUF + CALL BINPUT + LD (INPKB+1),DE + POP DE + RET NC + JP BREAKZ +; +; SVC .INMSG ;input from file +; ent DE:adrs +; ext B: length +; +INPMSG: + PUSH HL + PUSH DE + CALL IO_RDY + LD HL,(ZTOP) + INC HL + BIT __EOF,(HL) + PUSH HL + LD B,0 + SCF + CALL Z,INPMS0 + POP HL + CALL C,INEOF + POP DE + PUSH AF + CALL IO_OK + LD L,B + LD H,0 + ADD HL,DE + LD (HL),0 + POP AF + POP HL + RET +; +INEOF: SET __EOF,(HL) + LD HL,ZFLAG2 + BIT __EOFE,(HL) + RET Z ;nomally + JP ER63 ;old method +; +INPMS0: CALL CRTLU__ ;input 1 record + JR Z,INPKB + LD A,(ZFLAG1) + BIT __STRM,A + LD HL,INP1C + JR Z,INPMC + BIT __RCHR,A + LD HL,_ZINP + JR NZ,INPMC +_ZINP: + LD IX,(ZINP) + CALL IOCALL + RET +; +INPKB0: LD A,'?' + RST 3 + DEFB _CRT1C + LD A,' ' + RST 3 + DEFB _CRT1C + RST 3 + DEFB _INSTT +INPKB: LD HL,0 ;xxx + CALL HLFTCH + OR A + JR Z,INPKB0 + LD C,0 + RST 3 + DEFB _INDAT + LD (INPKB+1),HL + RET +; +; SVC .INDAT ;read 1 item from buffer +; ent HL:data pointer +; DE:input buffer +; C: separater(nomaly 00H or ":") +; ext B: length +; HL:data pointert +; +INPDT: + LD B,0 + CALL TEST1 + DEFB '"' + JR NZ,INPDT6 +INPDT2: LD A,(HL) + OR A + RET Z + INC HL + CP '"' + JR Z,INPDT4 + LD (DE),A + INC DE + INC B + JR INPDT2 +INPDT4: + CALL TEST1 + DEFM "," + OR A ;Reset CF + RET +; +INPDT6: LD A,(HL) + OR A + RET Z + CP C + RET Z + INC HL + CP ',' + RET Z + LD (DE),A + INC DE + INC B + JR INPDT6 +; +INPMC: LD (INPMC2+1),HL ;input by chr + LD B,0 +INPMC2: CALL 0 ;INP1C or (ZINP) + RET C + CP 0DH + RET Z + LD (DE),A + INC DE + INC B + JR NZ,INPMC2 + JP ER41 ;I/O error + + +; +INP1C0: + LD A,(ZFLAG1) + BIT __STRM,A + JP NZ,ER59 ;STRM ommit +INP1C: CALL PUSHR + LD E,(IY+_PTR) + LD D,(IY+_PTR+1) + LD HL,(ZBLK) + OR A + SBC HL,DE + CALL Z,INP1B + RET C + LD L,(IY+_BLKNO) + LD H,(IY+_BLKNO+1) + XOR A + SBC HL,DE + SCF + RET Z ;EOF + LD HL,(ZBUFF) + ADD HL,DE + LD A,(HL) + INC DE + LD (IY+_PTR),E + LD (IY+_PTR+1),D + RET +; +INP1B: CALL _RND + JP NZ,INX1B + DEFB 0F6H ;not first block +INP1B0: XOR A ;first block + CALL SEQSET + CALL _ZINP + RET C + LD A,(HL) + INC HL + AND (HL) + LD (HL),0FFH + INC A + LD DE,0 + RET NZ ;Nomal block + PUSH HL ;EOF block + LD HL,(ZBUFE) + LD BC,(ZBLK) +INP1B2: DEC HL + DEC BC + LD A,(HL) + OR A + JR Z,INP1B2 + POP HL + LD (HL),B ;_BLKNO := Block length + DEC HL + LD (HL),C + RET + + +; +; SVC .LUCHK ;check lu & set Z-area +; ent A: lu +; ext A: 1:R, 2:W +; if CF then not-found +; +LUCHK: + CALL PUSHR + LD HL,CRTTBL + CP CRTLU + JR Z,LUCHK4 + LD HL,LPTTBL + CP LPTLU + JR Z,LUCHK4 + RST 3 + DEFB _SEGAD + RET C ;LU# not found +LUCHK4: LD (ZTOP),HL + LD DE,ZLOG + LD BC,8 + LDIR + LD (ZMODE),HL + LD IY,HL + LD DE,ELMD + CALL LDIR64 + PUSH HL + LD HL,(ZEQT) + LD DE,ZNXT + LD BC,ZBYTES + LDIR + POP HL + LD BC,16 + ADD HL,BC + LD (ZBUFF),HL + LD BC,(ZBLK) + ADD HL,BC + LD (ZBUFE),HL + LD A,(ZRWX) + AND 0FH + RET +; +; +CRTTBL: DEFB CRTLU + DEFB 3 ;W R + DEFW _CRT + DEFW 0 + DEFW 0 +; +LPTTBL: DEFB LPTLU + DEFB 2 ;W + DEFW _LPT + DEFW 0 + DEFW 0 +; + + +; +; SVC .DEVNM ;Interp. dev name +; ent DE:device name pointer +; ext DE:equipment table +; HL:file name pointer +; A: channel +; +DEV: + LD HL,KEYBUF + PUSH HL + LD A,B + OR A + CALL NZ,LDHLDE + LD (HL),0 + LD HL,EQTBL + JR $+5 +DEV1: LD HL,0 ;xxx + LD A,L + OR H + JR Z,DEV8 ;Not found + LD (DEV7+1),HL + CALL LDDEMI + LD (DEV1+1),DE + LD DE,KEYBUF + EX DE,HL +DEV2: LD A,(DE) + OR A + JR Z,DEV4 + CP (HL) + JR NZ,DEV1 ;Mismatch + INC HL + INC DE + JR DEV2 +DEV4: LD A,(HL) + INC HL + CP ':' + LD C,0 + JR Z,DEV5 ;Match + SUB '1' + CP 9 + JR NC,DEV1 ;Mismatch + LD C,A + LD A,(HL) + INC HL + CP ':' + JR NZ,DEV1 ;Mismatch +DEV5: EX (SP),HL ;Found +DEV7: LD HL,0 ;xxx + LD A,C + JR DEV9 +DEV8: POP HL ;Not found + PUSH HL +DEV82: LD A,(HL) + INC HL + CP ':' + JP Z,ER58 ;Dev name err + OR A + JR NZ,DEV82 + LD HL,(DDEV) ;default device + LD A,(DCHAN) ;default channel +DEV9: LD (ZEQT),HL + PUSH HL + LD (ZCH),A + LD DE,ZNXT + LD BC,ZBYTES + LDIR + LD B,A + LD A,(ZFLAG2) + AND 07H ;bit 0,1,2 + CP B + JP C,ER58 ;Dev name err (CH#) + LD A,B + POP DE + POP HL + RET +; +; SVC .DEVFN ;Interp. dev&file name +; ent DE:pointer +; B: length +; +DEV_FN: + CALL PUSHR + RST 3 + DEFB _DEVNM + EX DE,HL + LD HL,ELMD1 + LD B,31 + CALL CLRHL + LD HL,ELMD + RST 3 + DEFB _COUNT + CALL SETFNAM + LD HL,ZFLAG1 + BIT __FNM,(HL) + RET Z + INC HL + BIT __CMT,(HL) + RET NZ + LD A,(ELMD1) ;except CMT, + CP 0DH ; no filename is + JP Z,ER60 ; error 60. + RET + + +; +; SVC .RWOPEN ;ROPEN/WOPEN/XOPEN +; +RWOPEN: + CALL PUSHR + CALL OPEN00 + LD B,0 + CALL TYPECK + JP DUST +; +OPEN00: LD A,(ZLOG) + RST 3 + DEFB _SEGAD + JP NC,ER43 ;LU already opened + CALL _OPEND ;Check already opened + LD HL,8+64+16+5 ;LU, DIR and work + LD A,(ZFLAG1) + LD DE,(ZBLK) + INC DE + INC DE + BIT __STRM,A + JR NZ,$+3 + ADD HL,DE ;SEQ,RND + LD A,(ZRWX) + BIT 2,A + JR Z,$+3 + ADD HL,DE ;XO + EX DE,HL + LD A,(ZLOG) + RST 3 + DEFB _OPSEG ;open segment + LD (QSEG),A + LD (ZTOP),HL + EX DE,HL + LD HL,ZLOG + LD BC,8 + + LDIR ;xfer ZLOG to seg + LD (ZMODE),DE + + defb $d5, $fd, $e1 ;LD IY,DE (Z80ASM uses 4 bytes, LD HY,D / LD LY,E) + ; ** the z80asm output would currently be: + ;defb $fd $62 ; LD HY,D + ;defb $fd $6b ; LD LY,E + + LD HL,ELMD + CALL LDIR64 ;xfer ELMD to seg + LD HL,16 + ADD HL,DE + LD (ZBUFF),HL + LD DE,(ZBLK) + ADD HL,DE + LD (ZBUFE),HL + CALL _RND + JP NZ,OPX ;RND + LD A,(ZRWX) ;SEQ/STRM + BIT __XOPN,A + JP NZ,ER59 + BIT __WOPN,A + LD IX,(ZWO) + JR NZ,OPEN20 + LD A,(ZFLAG1) + BIT __STRM,A + JR Z,OPEN30 + LD IX,(ZRO) ;STRM RO +OPEN20: LD HL,ELMD ;SEQ/STRM WO + JP IOCALL +OPEN30: LD B,(IY+0) ;SEQ RO + CALL SERFLR + LD A,(ELMD) + CP B + JP NZ,ER61 + JP INP1B0 ;First call +; +; SVC .LOPEN ;Search for LOAD +; +LOPEN: + CALL PUSHR + LD IY,0100H ;(ZLOG)=0 + LD (ZLOG),IY ;(ZRWX)=1 ;R + LD IY,ELMD + CALL _RND + LD HL,LOPX + JR NZ,$+5 + LD HL,SERFLR + CALL _HL + LD B,80H + CALL TYPECK + LD A,(ELMD) + RET +; +; type check (chained or contiguas) +; +TYPECK: LD A,(ELMD) + CP 5 + RET C + LD A,(ELMD18) + AND 80H + CP B + RET Z + JP ER61 + + +; +; SVC .CLKL ;CLOSE/KILL +; ent A: lu, if A=0 then all-files +; B: B=0:KILL, B<>0:CLOSE +; +CLKL: ;CLOSE/KILL file + CALL PUSHR + OR A + JR Z,CLKLA + CALL CL1F + JP DUST +; +CL1F: + RST 3 + DEFB _LUCHK + RET C ;LU# not found + CALL IO_RDY + PUSH AF + CALL _RND + JR NZ,CL1FR + BIT __STRM,A + LD A,B + JR Z,CL1FB + OR A ;Streem I/O + LD IX,(ZKL) + JR Z,$+6 + LD IX,(ZCL) + CALL IOCALL + JR CL1F8 +CL1FB: OR A ;SEQ I/O + JR Z,CL1F8 + LD A,(ZRWX) + BIT __WOPN,A + CALL NZ,PRT1BX + JR CL1F8 +CL1FR: CALL CLX ;RND I/O +CL1F8: POP AF + RST 3 + DEFB _DLSEG + RET +; +; SVC .CLRIO ;clear all i/o +; +CLRIO: + CALL PUSHR + LD B,0 +CLKLA: LD C,8EH ;all files +CLKLA2: LD A,C + PUSH BC + RST 3 + DEFB _SEGAD + CALL NC,CL1F + POP BC + DEC C + JR NZ,CLKLA2 + JP ERRCVR + + +; +; search file (SEQ device) +; +SERFIL: + CALL PUSHR ;Search file + LD A,(ZFLAG1) + BIT __SEQ,A + JP Z,ER59 ;SEQ only ok + CALL _ZSTRT + LD A,(ZDIRMX) + LD B,A +SERFL2: LD HL,KEYBUF + PUSH BC + LD IX,(ZRO) ;RDINF + CALL IOCALL + POP BC + SET 0,A ;A<>0 + RET C ;Not found + + defb $fd, $e5, $d1 ;LD DE,IY (Z80ASM uses 4 bytes) + ; ** the z80asm output would currently be: + ;defb $fd $54 ; LD D,HY + ;defb $fd $5d ; LD E,LY + + CALL FNMTCH + LD A,(HL) + RET Z + DJNZ SERFL2 + XOR A ;end of dir + SCF + RET +; +; search file for WOPEN, SAVE +; (SEQ device) +; +SERFLW: + CALL _OPEND + CALL SERFIL + JP NC,ER42 ;already exist + OR A + JP Z,ER51 ;too many files + RET +; +; search file for ROPEN +; (SEQ device) +; +SERFLR: CALL _OPEND + CALL SERFIL + JP C,ER40 ;not found + CALL PUSHR + LD HL,KEYBUF + + defb $fd, $e5, $d1 ;LD DE,IY (Z80ASM uses 4 bytes) + ; ** the z80asm output would currently be: + ;defb $fd $54 ; LD D,HY + ;defb $fd $5d ; LD E,LY + + PUSH HL + CALL LDIR64 + POP HL + LD DE,ELMD + LD A,(HL) +LDIR64: LD BC,64 + LDIR + OR A + RET + + +; +; CALL _OPEND ; Check already opened +; +_OPEND: + LD IX,_OPCKX +_OPEN0: + LD (_OPEN6+1),IX + CALL PUSHR + LD A,(ZLOG) + LD C,A + LD HL,(POOL) + PUSH HL +_OPEN2: POP HL + LD A,(HL) + OR A + RET Z + LD B,A + INC HL + CALL LDDEMI + PUSH HL + ADD HL,DE + EX (SP),HL + CP 8FH + JR NC,_OPEN2 ;non i/o seg. + CP C + JR Z,_OPEN2 ;same lu + INC HL ;ZRWX + LD A,(HL) + EX AF,AF + INC HL + LD DE,ZEQT + PUSH BC + LD BC,300H +_OPEN4: LD A,(DE) + SUB M + OR C + LD C,A + INC DE + INC HL + DJNZ _OPEN4 + POP BC + JR NZ,_OPEN2 ;Diff. device + LD A,B +_OPEN6: CALL 0 ;xxx + JR _OPEN2 +; +_OPCKX: LD A,(ZFLAG2) ;Same device + BIT __1OPN,A ;1 file only ? + JP NZ,ER43 ; Yes, already open + BIT __1WOP,A ;1 file only W ? + RET Z ; No, ok + EX AF,AF + LD B,A + LD A,(ZRWX) + AND B + BIT __WOPN,A + RET Z + JP ER43 + + +; +; SVC .LOADFL +; ent HL:loaging adrs +; call after .DEVFN and .LOPEN +; +LOADFL: + CALL _RND + JP NZ,LDX + LD BC,(ELMD20) + PUSH BC + XOR A ;first block + LD IX,(ZINP) + CALL IOCALL + POP BC + RET +; +; SVC .VRFYF ;verify file +; ent HL:adrs +; call after .DEVFN, .LOPEN +; +VRFYFL: + LD A,(ZFLAG2) + BIT __CMT,A + JP Z,ER59 + LD BC,(ELMD20) + JP CMTVRF +; +; SVC .SAVEF ;save file +; ent DE:adrs +; call after .DEVFN +; +SAVEFL: + LD A,(ELMD) + CP 5 + JR C,SAVEF2 + LD A,80H + LD (ELMD18),A ;contiguas flag +SAVEF2: CALL _RND + JP NZ,SVX + BIT __STRM,A + JP NZ,ER59 + PUSH DE + LD HL,0200H + LD (ZLOG),HL + CALL _OPEND + LD HL,ELMD + LD IY,HL + LD IX,(ZWO) + CALL IOCALL + LD BC,(ELMD20) + POP HL + LD A,04H ;F# update,unblocked + LD IX,(ZOUT) + CALL IOCALL + RET +; +; +_RND: + LD A,(ZFLAG1) + BIT __RND,A + RET + + +; +; SVC .DIR +; ent A=0 ... read dir +; A>0 ... output dir +; +FDIR: + CALL PUSHR + OR A + JR NZ,FDIR3 + LD HL,100H + LD (ZLOG),HL + CALL _OPEND + LD HL,ZFLAG1 + BIT __STRM,(HL) + JP NZ,ER59 ;Streem i/o omit + BIT __RND,(HL) + JP NZ,LD_DIR ;RND + INC HL ;SEQ + BIT __CMT,(HL) + JP NZ,ER59 ;CMT ommit + CALL MWAIT ;MUSIC WAIT + LD HL,DIRARE + LD BC,8 ;clear 0800H bytes + CALL CLRHL + DEC C + JR NZ,$-4 + CALL _ZSTRT + LD A,(ZDIRMX) + LD B,A + LD HL,DIRARE +FDIR2: PUSH BC + LD IX,(ZRO) ;read infomation + CALL IOCALL + PUSH AF + LD BC,32 + ADD HL,BC + LD (HL),0 + POP AF + POP BC + JR C,$+4 + DJNZ FDIR2 + JP _ZEND +; +FDIR3: LD (FDIROT+1),A + XOR A + LD (DISPX),A + LD HL,KEYBUF + PUSH HL + LD DE,DIRM1 + LD B,DIRM2-DIRM1 + CALL LDHLDE + CALL SETDNM ;set device name + LD (HL),' ' + INC HL + LD (HL),' ' + INC HL + EX DE,HL + CALL _RND + LD IX,(ZFREE) ;SEQ + JR Z,$+6 + LD IX,FREEX ;RND + CALL IOCALL + JR C,FDIR4 + LD HL,BC + LD B,0 + RST 3 + DEFB _ASCHL + LD HL,DIRM2 + LD B,DIRM3-DIRM2 + CALL LDDEHL +FDIR4: EX DE,HL + LD (HL),0DH + INC HL + LD (HL),0 + POP DE + CALL FDIROT ;DIR OF dd: xxx KB FREE +; + LD B,64 ;max dir + LD HL,DIRARE +FDIR6: CALL FDIRS ;mod "name" + LD DE,32 + ADD HL,DE + DJNZ FDIR6 + JP DUST +; +FDIRS: CALL PUSHR + LD A,(HL) + OR A + RET Z + RET M + LD DE,KEYBUF + PUSH DE + LD A,' ' + LD B,38 + CALL SETDE + LD A,(HL) + CP MAXMOD+1 + JR C,$+4 + LD A,MAXMOD+1 + LD IY,HL + POP DE + PUSH DE + INC DE + LD HL,DIRM3-3 + LD BC,3 + ADD HL,BC + DEC A + JR NZ,$-2 + LDIR + EX DE,HL + BIT 0,(IY+18) + JR Z,$+4 + LD (HL),'*' + INC HL + INC HL + LD (HL),'"' + INC HL +FDIRS2: LD A,(IY+1) + CP 0DH + JR Z,FDIRS4 + LD (HL),A + INC IY + INC HL + JR FDIRS2 +FDIRS4: LD (HL),'"' + INC HL + LD (HL),0DH + INC HL + LD (HL),0 + POP DE +FDIROT: LD A,0 ;xxx output lu + RST 3 + DEFB _LUCHK + RST 3 + DEFB _COUNT + RST 3 + DEFB _PRSTR + RST 3 + DEFB _HALT + RET +; +DIRM1: DEFB 0DH + DEFM "DIRECTORY OF " + + + +DIRM2: DEFM " KB FREE." + + +DIRM3: DEFM "OBJ" ;1 + DEFM "BTX" ;2 + DEFM "BSD" ;3 + DEFM "BRD" ;4 + DEFM "RB " ;5 + DEFM " ? " ;6 + DEFM "LIB" ;7 + DEFM " ? " ;8 + DEFM " ? " ;9 + DEFM "SYS" ;10 + DEFM "GR " ;11 + DEFM " ? " ;12 + +defc MAXMOD = 11 + + +; +; INIT "dev:command" +; +FINIT: + PUSH HL +FINIT2: XOR A + LD (ZLOG),A + LD IX,_OPCKY + LD (_OPCKY+1),SP + CALL _OPEN0 + POP HL + LD IX,(ZINIT) + CALL IOCALL + RET +; +_OPCKY: LD SP,0 + LD B,0 + RST 3 + DEFB _CLKL ;KILL + JR FINIT2 +; +; Ask Y or N +; +OKYN: + CALL TEST1 + DEFM "Y" + RET Z + LD DE,OK_MSG + RST 3 + DEFB _CRTMS + LD A,1 + RST 3 + DEFB _INKEY + CP 'Y' + RET Z + JP BREAKZ +OK_MSG: DEFM "OK ? [Y/N]" + + + DEFB 19H ;alpha + DEFB 0 + + +; +; Filename check +; +CKFIL: + LD DE,ELMD +FNMTCH: + CALL PUSHR + INC HL + INC DE + LD A,(DE) + CP 0DH + RET Z + LD B,17 +FNMTLP: LD A,(DE) + CP (HL) + RET NZ + CP 0DH + RET Z + INC HL + INC DE + DJNZ FNMTLP + OR A + RET +; +; +SETFNAM: + INC HL + LD C,16 +SETFN2: LD A,B + OR A + JR Z,SETFN4 + LD A,(DE) + INC DE + DEC B + OR A + JR Z,SETFN4 + CP '"' + JR Z,SETFN2 + CP ':' + JP Z,ER60 ;file name err + LD (HL),A + INC HL + DEC C + JR NZ,SETFN2 +SETFN4: LD (HL),0DH + INC HL +SETFN6: LD A,C + OR A + RET Z + LD (HL),' ' + INC HL + DEC C + JR SETFN6 + + +; +; SVC .SEGAD ;get segment adrs +; ent A .... Seg No. +; ext HL ... Buffer adrs +; +SEGADR: + LD HL,(POOL) +SEGAD2: INC (HL) + DEC (HL) + SCF + RET Z ;not found + CP (HL) + INC HL + JR Z,SEGAD9 + PUSH DE + CALL LDDEMI + ADD HL,DE + POP DE + JR SEGAD2 +SEGAD9: INC HL + INC HL + RET +; +; SVC .DLSEG ;delete segment +; ent A .... Seg No. +; +DELSEG: + CALL PUSHR + RST 3 + DEFB _SEGAD + RET C ;Not exist + DEC HL + LD B,(HL) + DEC HL + LD C,(HL) ;BC = length + DEC HL ;HL = del start + LD DE,HL ;DE = del start + INC BC + INC BC + INC BC ;BC = del size + PUSH BC + ADD HL,BC ;HL = del end + PUSH HL + LD BC,HL + LD HL,(TMPEND) + OR A + SBC HL,BC + LD BC,HL ;BC = Move bytes + POP HL ;HL = del end + LDIR + POP DE ;DE = del size + LD HL,0 + OR A + SBC HL,DE + EX DE,HL ;DE= - delete size + RST 3 + DEFB _ADDP1 + OR A + RET +; + + +; +; SVC .OPSEG ;open segment +; ent A .... Seg No. +; DE ... Buffer length +; ext HL ... Buffer adrs +; +OPSEG: + PUSH AF + PUSH BC + PUSH DE + PUSH DE + INC DE + INC DE + INC DE + LD HL,(TMPEND) + EX DE,HL ; + ADD HL,DE ; ADD DE,HL + EX DE,HL ; DE = new TMPEND + JP C,ER06 + PUSH HL + LD HL,-512 + ADD HL,SP + SBC HL,DE + JR C,ER06 + LD HL,(MEMLMT) + DEC H + DEC H + SBC HL,DE + JR C,ER06 + POP HL + PUSH HL ;old TMPEND + LD BC,(VARST) ;POOL END + OR A + SBC HL,BC + LD BC,HL ;BC = move bytes + POP HL ;HL = old TMPEND + INC BC + LDDR + POP DE ;Buffer length + LD (HL),A ;Seg No. + INC HL + LD (HL),E ;Size + INC HL + LD (HL),D + INC HL + PUSH HL + INC DE ;LEN+1 + PUSH DE +OPSEG2: LD (HL),0 + INC HL + DEC DE + LD A,D + OR E + JR NZ,OPSEG2 + POP DE ;LEN+1 + INC DE + INC DE ;LEN+3 + RST 3 + DEFB _ADDP1 + POP HL + POP DE + POP BC + POP AF + RET + + +; +; MACRO ERENT +;ER@1: +; IFD @2 +; LD A,@1+80H +; ENDIF +; IFU @2 +; LD A,@1 +; ENDIF +; DEFB 21H +; ENDM +; + +ER03: + LD A,03 + DEFB 21H + +ER06: + LD A,06 + DEFB 21H + +ER28: + LD A,28+80H + DEFB 21H + +ER40: + LD A,40+80H + DEFB 21H + +ER41: + LD A,41+80H + DEFB 21H + +ER42: + LD A,42+80H + DEFB 21H + +ER43: + LD A,43+80H + DEFB 21H + +ER46: + LD A,46+80H + DEFB 21H + +ER50: + LD A,50+80H + DEFB 21H + +ER51: + LD A,51+80H + DEFB 21H + +ER52: + LD A,52+80H + DEFB 21H + +ER53: + LD A,53+80H + DEFB 21H + +ER54: + LD A,54+80H + DEFB 21H + +ER55: + LD A,55+80H + DEFB 21H + +ER58: + LD A,58 + DEFB 21H + +ER59: + LD A,59+80H + DEFB 21H + +ER60: + LD A,60+80H + DEFB 21H + +ER61: + LD A,61+80H + DEFB 21H + +ER63: + LD A,63+80H + DEFB 21H + +ER64: + LD A,64 + DEFB 21H + +ER68: + LD A,68+80H + JP ERRORJ + +; +; +; Error recover routine +; + +ERRCVR: + LD A,(QSEG) + OR A + LD B,0 + CALL NZ,CLKL ;KILL + CALL FLOFF ;FD motor off + CALL QDOFF ;QD motor off + XOR A + LD (QSEG),A + JP DUST ;I/O open check +;JP MLDSP + + +IF MOD_B +EMSV1_00: + PUSH AF + LD A,(ZCH) + +ELSE + + DEFS 3 +QSEG: + DEFB 0 + +ENDIF +; +; END (1FDA) + +;========================= +IF RAMDISK + +IF MOD_B +;..EMSV1_00 continues here + ADD A,0ECH ; EM_P0 (0EFH: EM_P1) + LD C,A + POP AF + LD B,L + RET + +ELSE + DEFS 6 +ENDIF + +SEEK_0: + CALL LDEND + PUSH BC + LD HL,(ELMD24) ;exec addr + LD BC,DSAVE_0+2 + XOR A + SBC HL,BC + POP BC + POP HL + RET NZ + LD HL,(TEXTST) + INC HL + INC HL + INC HL +SEEK_LOOP: + INC HL + LD A,(HL) + OR A + JR NZ,SEEK_LOOP + JP (HL) + + + +ENDIF +;========================= +IF MOD_B +defs 3 +QSEG: +ENDIF + +XWORK_END: +DEFS $2000-XWORK_END + + +; ORG 2000H +; +; +; +; Memory to simulate screen - text - memory +; +; Since the original image memory only contains point patterns, the +; following memory area provides an image of the text screen. +; The 'screen editing' is possible only in this way. +; +; A hardcopy of the displayed text can be easily done PEEKing here +; and sending the output of the read characters to the printer. +; +; +TEXTBF: DEFS 2000 ; Pseudo - video text memory + + + +; +; work area +; (defc DIRARE = 27D0H) +; +DIRARE: ;DIR area + DEFS 800H + + +; END (2fd0) + + +DIRARE_END: +DEFS $2FD0-DIRARE_END + + + +; ORG 2FD0H + +; ---------------------------- +; MZ-800 Monitor QD driver +; FI:M-QD ver 0.2A 9.5.84 +; ---------------------------- +; + +; +; +; +_QD: + DEFW _USR + DEFM "QD" + DEFW 0 + DEFB 5FH ;Seq, W, R + DEFB 40H ;1OPN + DEFB 32 ;Max dir + DEFW Q_INI + DEFW Q_RINF + DEFW Q_WINF + DEFW Q_ON + DEFW 1024 + DEFW Q_RDAT + DEFW Q_WDAT + DEFW 0 ;DELETE + DEFW 0 ;WRDIR + DEFW Q_FREE +; +; +Q_FREE: XOR A + SCF + RET +; +; +Q_INI: RET C + CALL TEST1 + DEFM "Y" + JR Z,Q_INI2 + OR A + JP NZ,ER03 + CALL OKYN +Q_INI2: CALL Q_RDY + RET C + RST 3 + DEFB _DI + LD C,2 + JR QDIOX + +; +; Dir search start +; +Q_ON: OR A + JR NZ,QDOFF + RST 3 + DEFB _DI + XOR A + LD (FNUPS),A ;KILL # + LD C,5 + CALL QDIOR + LD BC,1 +; +QDIOR: LD (QDPC),HL + LD (QDPE),DE + LD HL,QDPB + LD (HL),B + DEC HL + LD (HL),C + JR QDIO +; +QDOFF: + CALL PUSHR + LD C,6 + JR QDIOX +; +; Read inf +; ent HL:adrs +; +Q_RINF: LD BC,3 + LD DE,64 + CALL QDIOR + RET NC + CP 40 ;not found + SCF + RET NZ + LD A,0 + RET +; +; Read data +; ent HL:buffer adars +; BC:byte size +; +Q_RDAT: + RST 3 + DEFB _DI + LD DE,BC + LD BC,0103H +; +QDIOX: CALL QDIOR + RST 3 + DEFB _EI + RET + +; +; Write inf +; +Q_WINF: LD A,37H ;SCF + LD (Q_WD1),A +Q_RDY: LD BC,0101H + JR QDIOR +; +; Write data +; +Q_WDAT: PUSH AF + RST 3 + DEFB _DI +Q_WD1: XOR A ;XOR A / SCF + JR NC,Q_WD2 + LD A,0AFH ;XOR A + LD (Q_WD1),A + CALL SERFLW ;First time only + LD (QDPG),HL + LD HL,ELMD + LD DE,64 + POP AF + JR Q_WD3 +; +Q_WD2: LD (QDPG),HL + POP AF + SET 0,A +Q_WD3: LD (QDPI),BC + LD B,A + LD C,4 + JR QDIOX +; +; +;QD WORK +; +; +QDTBL: +QDPA: + DEFB 0 +QDPB: + DEFB 0 +QDPC: + DEFW 0 +QDPE: + DEFW 0 +QDPG: + DEFW 0 +QDPI: + DEFW 0 +; +HDPT: + DEFB 0 +HDPT0: + DEFB 0 +; +FNUPS: DEFB 0 +FNUPS1: DEFB 0 +FNUPF: DEFB 0 +; +FNA: + DEFB 0 +FNB: + DEFB 0 +; +MTF: + DEFB 0 +RTYF: + DEFB 0 +SYNCF: + DEFB 0 +; +RETSP: + DEFW 0 +; +defc FMS = 0EFFFH +; + +; +;------------------------------ +; +; QDIO +; +;------------------------------ +; +; +QDIO: + LD A,5 ;Retry 5 + LD (RTYF),A +; +RTY: DI + CALL QMEIN + EI + RET NC + PUSH AF + CP 40 + JR Z,RTY4 + CALL MTOF + LD A,(QDPA) + CP 4 ;Write ? + JR NZ,RTY3 + LD A,(FNUPF) + OR A + JR Z,RTY5 + XOR A ;FNUPF CLR + LD (FNUPF),A + LD A,(FNA) + PUSH HL ;RETSP <= SP-2 + LD (RETSP),SP + POP HL +; + DI + CALL QDSVFN + EI + JR C,RTY2 + CALL MTOF +; +RTY3: CP 3 ;Read ? + JR NZ,RTY5 + LD HL,HDPT + DEC (HL) +; +RTY5: POP AF + PUSH AF + CP 41 + JR NZ,RTY2 +; + LD HL,RTYF + DEC (HL) + JR Z,RTY2 + POP AF + LD A,(FNUPS1) + LD (FNUPS),A + JR RTY +; +RTY2: CALL WRCAN + CALL QDHPC +RTY4: POP AF + RET +; + +; +QMEIN: LD (RETSP),SP + LD A,(QDPA) + DEC A + JR Z,QDRC ;Ready Check + DEC A + JR Z,QDFM ;Format + DEC A + JR Z,QDRD ;Read + DEC A + JP Z,QDWR ;Write + DEC A + JR Z,QDHPC ;Head Point Clear + JR MTOFX ;Motor Off +; +;------------------------- +; +; Head Point Clear +; +;------------------------- +; +QDHPC: + PUSH AF + XOR A + LD (HDPT),A + POP AF + RET +; +;------------------------- +; +; Ready Check +; +;------------------------- +; +QDRC: + LD A,(QDPB) + JP QREDY +; + +; +;------------------------- +; +; Format +; +;------------------------- +; +QDFM: + XOR A + CALL QDSVFN + CALL SYNCS2 + LD BC,FMS + LD A,0AAH +; +QDFM1: CPL + LD D,A + CALL TRANS + DEC BC + LD A,B + OR C + JR Z,QDFM2 + LD A,D + JR QDFM1 +; +QDFM2: CALL EOM + CALL MTOF + CALL MTON + LD A,(FNB) + DEC A + JR NZ,FMERR + CALL SYNCL2 + LD BC,FMS + LD E,55H +QDFM3: CP E + JR NZ,FMERR + DEC BC + LD A,B + OR C + JR Z,QDFM4 + LD A,E + CPL + LD E,A + CALL RDATA + JR QDFM3 +; +QDFM4: CALL RDCRC +MTOFX: JP MTOF +; +FMERR: LD A,41 ;Hard Err + SCF + RET +; + +; +;------------------------- +; +; Read +; +;------------------------- +; +QDRD: + LD A,(MTF) + OR A + CALL Z,MTON + CALL HPS + RET C + CALL BRKC +; + CALL RDATA + LD C,A + CALL RDATA + LD B,A + OR C ;Byte size zero check + JP Z,QDWE1 + LD HL,(QDPE) ;Byte size check + SBC HL,BC + JP C,QDWE1 + LD HL,(QDPC) +; +;Block Data Read +; +BDR: CALL RDATA + LD (HL),A + INC HL + DEC BC + LD A,B + OR C + JR NZ,BDR + CALL RDCRC + LD A,(QDPB) + BIT 0,A + JR NZ,MTOFX + RET +; + +; +;Head Point Search +; +HPS: + LD HL,FNB + DEC (HL) + JR Z,HPNFE ;Not Found + CALL SYNCL2 + LD C,A ;BLKFLG => C reg + LD A,(HDPT) + LD HL,HDPT0 + CP (HL) ;Search ok ? + JR NZ,HPS1 + INC A ;HDPT count up + LD (HDPT),A + LD (HL),A ;HDPT0 count up + LD A,(QDPB) + XOR C + RRA + RET NC ;= +; +;Dummy read +; +DMR: CALL RDATA + LD C,A + CALL RDATA + LD B,A +; +DMR1: CALL RDATA + DEC BC + LD A,B + OR C + JR NZ,DMR1 + CALL RDCRC + JR HPS ;next +; +HPS1: INC (HL) + JR DMR +; +HPNFE: LD A,40 ;Not Found + SCF + RET +; + +; +;------------------------- +; +; Write +; +;------------------------- +; +QDWR: + LD A,(FNUPS) + LD (FNUPS1),A + LD A,(MTF) + OR A + JR NZ,QDWR1 + CALL MTON + LD A,(FNUPS) + LD HL,FNB + ADD A,(HL) + LD (FNB),A + INC A + LD (HDPT),A + CALL HPS + JP NC,QDWE1 ;Hard err +QDWR1: LD A,(QDPB) + LD B,A + AND 1 + JR NZ,QDWR2 + LD DE,QDPC + LD A,B + RES 2,A + CALL BDW + CALL BRKC +; +QDWR2: LD DE,QDPG + LD A,(QDPB) + SET 0,A + CALL BDW + CALL MTOF + CALL BRKC +; + LD A,(QDPB) + AND 4 + JR Z,NFNUP + LD A,(FNA) + LD HL,FNUPS + ADD A,(HL) + CALL QDSVFN + LD A,1 + LD (FNUPF),A +QDWR4: LD A,(FNA) + LD HL,FNUPS1 + ADD A,(HL) + INC A + LD (FNB),A + INC A + LD (HDPT),A + CALL HPS + JR NC,QDWE1 + LD A,(QDPB) + AND 1 + JR NZ,QDWR3 + LD DE,QDPC + CALL BDV + RET C +QDWR3: LD DE,QDPG + CALL BDV + RET C + LD A,(FNUPF) + OR A + JR Z,QDWR5 +WRCAN: XOR A + LD (FNUPS),A + LD (FNUPF),A +; +QDWR5: JP MTOF +; +QDWE1: LD A,41 + SCF + RET +; +NFNUP: CALL MTON + JR QDWR4 +; +;Block Data Write +; +BDW: PUSH AF + LD HL,FNUPS + INC (HL) + CALL SYNCS2 + POP AF + CALL TRANS + CALL RSET + LD A,C + CALL TRANS + LD A,B + CALL TRANS +; +BDW1: LD A,(HL) + CALL TRANS + INC HL + DEC BC + LD A,B + OR C + JR NZ,BDW1 + JP EOM +; +;HL,BC SET +; +RSET: EX DE,HL + LD E,(HL) + INC HL + LD D,(HL) + INC HL + LD C,(HL) + INC HL + LD B,(HL) + EX DE,HL + RET +; +;Block Data Verify +; +BDV: CALL SYNCL2 + CALL RSET + CALL RDATA + CP C + JR NZ,QDWE1 + CALL RDATA + CP B + JR NZ,QDWE1 +; +BDV1: CALL RDATA + CP (HL) + JR NZ,QDWE1 + INC HL + DEC BC + LD A,B + OR C + JR NZ,BDV1 + JP RDCRC + +; +; +; i/o port adrs +; +defc SIOAD = 0F4H ; sio A data +defc SIOBD = 0F5H ; sio B data +defc SIOAC = 0F6H ; sio A control +defc SIOBC = 0F7H ; sio B control + +; +; +; +; Ready & Write protect +; Acc = '0' : Ready check +; Acc = '1' : & Write Protect +; +QREDY: + LD B,A + LD A,02H ;SIO hard check + OUT (SIOBC),A + LD A,81H + OUT (SIOBC),A + LD A,02H + OUT (SIOBC),A + IN A,(SIOBC) + AND 81H + CP 81H + JP NZ,IOE50 ;Not ready + LD A,10H + OUT (SIOAC),A + IN A,(SIOAC) + LD C,A + AND 08H + JP Z,IOE50 ;Not ready + LD A,B + OR A + RET Z ;No err + LD A,C + AND 20H + RET NZ ;No err + JP IOE46 ;Write protect +; + +; +; +; Write FN +; +QDSVFN: + PUSH AF + LD HL,SIOSD + LD B,09H + CALL LSINT ;save init +; +SREDY: LD A,10H + OUT (SIOAC),A + IN A,(SIOAC) + AND 8 + JP Z,IOE50 ;Not ready + LD A,10H + OUT (SIOBC),A + IN A,(SIOBC) + AND 8 + JR Z,SREDY + LD BC,00E9H ;Wait 160ms + CALL TIMW + CALL SBRK ;Send Break + CALL SYNCS1 ;FN Only SYNC + POP AF + CALL TRANS ;FN=A + CALL EOM ;CRC FLAG(7EH) + JR FNEND +; +; +; +; MTON -- QD MOTOR ON +; READ FILE NUMBER +; READ &CHECK CRC,FLAG +; +MTON: + LD HL,SIOLD + LD B,0BH + CALL LSINT ;load init +; +LREDY: LD A,10H + OUT (SIOAC),A + IN A,(SIOAC) + AND 8 + JP Z,IOE50 ;Not ready + CALL BRKC + LD A,10H + OUT (SIOBC),A + IN A,(SIOBC) + AND 8 + JR Z,LREDY + LD BC,00E9H ;Wait 160ms + CALL TIMW + CALL SYNCL1 ;LOAD SYNC + LD (FNA),A + INC A + LD (FNB),A + CALL RDCRC +FNEND: LD HL,SYNCF + SET 3,(HL) + XOR A + LD (HDPT0),A + RET +; + +; +; sio initial +; +; +LSINT: LD C,SIOAC + OTIR + LD A,05H + LD (MTF),A + OUT (SIOBC),A + LD A,80H + OUT (SIOBC),A + RET +; +; Motor off +; +MTOF: + PUSH AF + LD A,05H + OUT (SIOAC),A + LD A,60H + OUT (SIOAC),A ;WRGT OFF,TRANS DISABLE + LD A,05H + OUT (SIOBC),A + XOR A + LD (MTF),A + OUT (SIOBC),A + POP AF + RET +; +; + +; +; SYNCL1 -- LOAD F.N SYNC ONLY +; (SEND BREAK 110ms) +; SYNCL2 -- LOAD FIRST FILE SYNC +; (SEND BREAK 110ms) +; SYNCL3 -- LOAD FILES SYNC +; (SEND BREAK 002ms) +; +SYNCL2: + LD A,58H + LD B,0BH + LD HL,SIOLD + CALL SYNCA + LD HL,SYNCF + BIT 3,(HL) + LD BC,3 ;WAIT 2ms + JR Z,TMLPL + RES 3,(HL) +SYNCL1: LD BC,00A0H ;WAIT 110ms +; +TMLPL: CALL TIMW + LD A,05H + OUT (SIOBC),A + LD A,82H + OUT (SIOBC),A + LD A,03H + OUT (SIOAC),A + LD A,0D3H + OUT (SIOAC),A + LD BC,2CC0H ;loop 220ms +; +SYNCW0: LD A,10H + OUT (SIOAC),A + IN A,(SIOAC) + AND 10H + JR Z,SYNCW1 + DEC BC + LD A,B + OR C + JR NZ,SYNCW0 + JP IOE54 ;Un format +; +SYNCW1: LD A,03H + OUT (SIOAC),A + LD A,0C3H + OUT (SIOAC),A + LD B,9FH ;loop 3ms +; +SYNCW2: LD A,10H + OUT (SIOAC),A + IN A,(SIOAC) + AND 01H + JR NZ,SYNCW3 + DEC B + JR NZ,SYNCW2 + JP IOE54 ;Un format +; +SYNCW3: LD A,03H + OUT (SIOAC),A + LD A,0C9H + OUT (SIOAC),A + CALL RDATA + JP RDATA +; +; +; +; SYNCS1 -- SAVE F.N SYNC +; (SEND BREAK 220ms) +; SYNCS2 -- SAVE FIRST FILE SYNC +; (SEND BREAK 220ms) +; SYNCS3 -- SAVE FILES SYNC +; (SEND BREAK 020ms) +; +SYNCS2: + LD A,98H + LD B,09H + LD HL,SIOSD + CALL SYNCA + CALL SBRK +; + LD HL,SYNCF + BIT 3,(HL) + LD BC,001DH ;WAIT 20ms + JR Z,TMLPS + RES 3,(HL) +SYNCS1: LD BC,0140H ;WAIT 220ms +; +TMLPS: CALL TIMW + LD A,05H + OUT (SIOAC),A + LD A,0EFH + OUT (SIOAC),A + LD BC,1 ;WAIT 0.7ms + CALL TIMW +IF RAMDISK + LD A,0A5H + CALL TRANS + JP TRANS_0 +ELSE + LD A,0C0H + OUT (SIOAC),A + LD A,0A5H + JR TRANS +ENDIF +; +; +; +; SBRK -- SEND BREAK (00H) +; +SBRK: + LD A,05H + OUT (SIOAC),A + LD A,0FFH + OUT (SIOAC),A + RET +; +; +; +SYNCA: LD C,SIOAC + OUT (C),A + LD A,5 + OUT (SIOBC),A + LD A,80H + OUT (SIOBC),A + OTIR + RET +; + +; +; +; +; EOM -- End off message +; Save CRC#1,#2,FLAG +; File space check +; +; +EOM: + LD BC,1 ;WAIT 0.7ms + CALL TIMW + LD A,10H + OUT (SIOBC),A + IN A,(SIOBC) + AND 8 + RET NZ + JP IOE53 ;NO file space +; +; RDCRC -- READ CRC & CHECK +; +RDCRC: + LD B,3 +RDCR1: CALL RDATA + DJNZ RDCR1 +RDCR2: IN A,(SIOAC) + RRCA + JR NC,RDCR2 ; Rx Available + LD A,01H + OUT (SIOAC),A + IN A,(SIOAC) + AND 40H + JR NZ,IOE41 ;Hard err + OR A + RET +; + +; +; Save 1 chr by Acc +; & ready check +; +TRANS: + PUSH AF +TRA1: IN A,(SIOAC) + AND 4 ;TRANS buf null + JR Z,TRA1 + POP AF + OUT (SIOAD),A +NRCK: LD A,10H + OUT (SIOAC),A + IN A,(SIOAC) + AND 08H + JP Z,IOE50 ;Not ready + RET +; +; Read data (1 chr) +; +RDATA: + CALL NRCK + IN A,(SIOAC) ;RR0 + RLCA + JR C,IOE41 ;Hard err + RRCA + RRCA + JR NC,RDATA + IN A,(SIOAD) + OR A + RET +; + +; +; i/o err +; +IOE41: LD A,41 ;Hard err + DEFB 21H +IOE46: LD A,46 ;Write protect + DEFB 21H +IOE50: LD A,50 ;Not ready + DEFB 21H +IOE53: LD A,53 ;No file space + DEFB 21H +IOE54: LD A,54 ;Un format + LD SP,(RETSP) + SCF + RET +; +; +;--------------------------------- +; +; wait timer clock 3.54368MHz +; +; BC=001H= 0.7ms( 0.698ms) +; 003H= 2.0ms( 2.072ms) +; 01DH= 20.0ms( 19.929ms) +; 0A0H=110.0ms(109.899ms) +; 0E9H=160.0ms(160.036ms) +; 140H=220.0ms(219.787ms) +; +;--------------------------------- +; +TIMW: PUSH AF +TIMW1: LD A,150 ;MZ-1500=152 +TIMW2: DEC A + JR NZ,TIMW2 + DEC BC + LD A,B + OR C + JR NZ,TIMW1 + POP AF + RET +; + +; +;-------------------------------- +; +; SIO CH A COMMAND CHAIN +; +; SIOLD -- LOAD INIT. DATA +; SIOSD -- SAVE INIT. DATA +; +;-------------------------------- +; +SIOLD: DEFB 58H ;CHANNEL RESET + DEFB 04H ;POINT WR4 + DEFB 10H ;X1 CLOCK + DEFB 05H ;POINT WR1 + DEFB 04H ;CRC-16 + DEFB 03H ;POINT WR3 + DEFB 0D0H ;ENTER HUNT PHASE +;Rx 8bits + DEFB 06H ;POINT WR6 + DEFB 16H ;SYNC CHR(1) + DEFB 07H ;POINT WR7 + DEFB 16H ;SYNC CHR(2) +; +SIOSD: DEFB 98H ;CHANNEL RESET +;Tx CRC Generator reset + DEFB 04H ;POINT WR4 + DEFB 10H ;X1 CLOCK + DEFB 06H ;POINT WR6 + DEFB 16H ;SYNC CHR(1) + DEFB 07H ;POINT WR7 + DEFB 16H ;SYNC CHR(2) + DEFB 05H ;POINT WR5 + DEFB 6DH ;Tx CRC ENABLE +; +; +; BREAK CHECK +; +BRKC: LD A,0E8H + OUT (LSD0),A + NOP + IN A,(LSD1) + AND 81H + RET NZ + CALL WRCAN + JP BREAKX ;Can't CONT +; +; +; ----------------------------- +; MZ-800 monitor +; LDALL +; SVALL +; ver 0.1A 08.08.84 +; ----------------------------- +; +; RAM i/o port +; +defc RCADR = 0EBH ;RAM file ctrl port +defc RDADR = 0EAH ;RAM file data port +; +; RAM equ table +; +defc RMLIM = 0000H ;RAM file limit +defc RMADR = 0002H ;RAM file usage +defc RMTOP = 0010H ;RAM file top adrs +; +; LDAL,SVAL WORK +; +RMFRE: DEFW 0 +FAS: DEFW 0 +NFT: DEFW 0 ;1 File top +NBT: DEFW 0 ;1 Block top +; +FLAGF: DEFB 0 +FNUPB: DEFB 0 +; +BLKF: DEFB 0 +BLKSL: DEFB 0 +BLKSH: DEFB 0 +; +; SVC .LSALL +; ent A=0 ... LOAD ALL +; A=1 ... SAVE ALL +; +LSALL: + CALL PUSHR + LD HL,LDALM + OR A + JR Z,$+5 + LD HL,SVALM + LD (LSAL1+1),HL + RST 3 + DEFB _CLRIO + CALL QDHPC + PUSH HL + LD (RETSP),SP + POP HL + XOR A + CALL QREDY + JR C,LSAL2 + LD A,5 ;max retry + LD (RTYF),A +LSAL3: + RST 3 + DEFB _DI +LSAL1: CALL 0 ;xxx LDALM or SVALM + CALL MTOF + RST 3 + DEFB _EI + RET NC + CP 41 + JR NZ,LSAL2 + LD HL,RTYF + DEC (HL) + JR NZ,LSAL3 + LD A,41 +LSAL2: JP ERRORJ + +; +; LDALL main roution +; +; +LDALM: LD (RETSP),SP + LD HL,RMLIM + CALL EMLD2 + DEC DE ;RMFRE-end point buffer + DEC DE ;end point buffer(2byte) + LD (RMFRE),DE ;RAM buffer MAX adrs + LD HL,RMADR + CALL EMLD2 + LD HL,RMTOP + OR A + SBC HL,DE + JP NZ,RMER ;RAM Not init + LD (NFT),DE ;first NFT set(0010H) + INC DE + INC DE + LD (NBT),DE ;first NBT set(0012H) + LD HL,FAS + LD (HL),0 ;1 file byte size clear + INC HL + LD (HL),0 + CALL MTON +; +LDALN: LD HL,FNB + DEC (HL) + JP Z,_LDEND + CALL SYNCL2 + LD (BLKF),A + CALL RDATA + LD (BLKSL),A + CALL RDATA + LD (BLKSH),A +; + LD HL,(BLKSL) + LD DE,(NBT) + ADD HL,DE ;NBT+Block size + JR C,LDALEE ;over + LD BC,2 + ADD HL,BC ;HL+BLKF+BLKS(H,L) +LDALEE: JP C,LDALE ;64K over + LD BC,(RMFRE) + SBC HL,BC ;usedadrs-maxused + JR Z,FBUF0 ;free just + JP NC,LDALE ;NTB+lodingsize+3>free +FBUF0: LD HL,BLKF + LD BC,3 + CALL EMSVD + EX DE,HL + LD DE,(BLKSL) + LD A,D ;size zero check + OR E + JP Z,IOE41 ;size zero error +; +; +LEQM: IN A,(SIOAC) + RLCA + JR C,LEQME + RRCA + RRCA + JR NC,LEQM + IN A,(SIOAD) + LD C,RCADR + LD B,H + OUT (C),L + DEC C + OUT (C),A + INC HL + DEC DE + LD A,D + OR E + JR NZ,LEQM + CALL RDCRC + LD (NBT),HL + LD HL,(FAS) ;1 file all size + LD DE,(BLKSL) + ADD HL,DE + INC HL + INC HL + INC HL + LD (FAS),HL + LD A,(BLKF) + BIT 2,A + JR NZ,LDALO ;end block ? +; +LDALP: CALL BRKCHK + JP NZ,LDALN + JP BREAKZ +; +LDALO: LD DE,(NFT) + ADD HL,DE + INC HL + INC HL + LD (NFT),HL ;next NFT + PUSH HL + EX DE,HL + LD DE,(FAS) + CALL EMSV2 + LD HL,0 + LD (FAS),HL + POP HL + INC HL + INC HL + LD (NBT),HL + JR LDALP +; +_LDEND: LD HL,(NFT) + LD DE,RMADR + EX DE,HL + CALL EMSV2 + EX DE,HL + NOP + LD DE,0 + CALL EMSV2 + RET +; +LDALE: CALL _LDEND + LD A,53 +LEQME: SCF + RET +; + +; +; SVALL main roution +; +SVALM: LD (RETSP),SP + XOR A + LD (FNUPB),A + LD (FLAGF),A + LD (FNUPS),A +SVALM0: + LD HL,RMTOP + CALL EMLD2 + LD A,D + OR E + RET Z ;RAM Not file +; + CALL MTON + LD A,(FNB) + DEC A + JP NZ,QDER ;QD Not init + LD HL,RMTOP +; +SVALN: CALL EMLD2 + LD (FAS),DE + LD A,D + OR E + JR Z,SVALQ + INC HL + INC HL +; +; +SVALO: PUSH HL + CALL SYNCS2 + POP HL + CALL EMLD1 + CALL TRANS + INC HL + CALL EMLD2 + LD (BLKSL),DE + LD A,E + CALL TRANS + LD A,D + CALL TRANS + INC HL + INC HL +SEQM: LD C,RCADR + LD B,H + OUT (C),L + DEC C + IN B,(C) +; +SEQM1: IN A,(SIOAC) + AND 4 + JR Z,SEQM1 + LD A,B + OUT (SIOAD),A + INC HL + DEC DE + LD A,D + OR E + JR NZ,SEQM +; +; check EOM +; + LD BC,1 + CALL TIMW + LD A,10H + OUT (SIOBC),A + IN A,(SIOBC) + AND 8 + JR NZ,SEQM2 + LD A,53 + LD (FLAGF),A + JP SVALQ +; +SEQM2: PUSH HL + LD HL,FNUPS + INC (HL) + CALL BRKCHK + JP Z,BREAKZ + LD HL,(FAS) + LD DE,(BLKSL) + LD BC,3 + XOR A + SBC HL,DE + SBC HL,BC + JR Z,SVALP + LD (FAS),HL + POP HL + JR SVALO +; +SVALP: POP HL + LD A,(FNUPS) + LD (FNUPB),A + JP SVALN +; + +; +SVALQ: LD A,(FNUPB) + LD (FNUPS),A + CALL MTOF + CALL MTON + LD HL,RMTOP +; +SVALT: CALL EMLD2 + LD (FAS),DE + INC HL + INC HL +; +SVALR: LD A,(FNUPB) + DEC A + JP Z,SVALU + LD (FNUPB),A +; + PUSH HL + CALL SYNCL2 + POP HL + LD D,A + CALL EMLD1 + CP D + JR NZ,QDHER + INC HL + CALL EMLD2 + LD (BLKSL),DE + CALL RDATA + CP E + JR NZ,QDHER + CALL RDATA + CP D + JR NZ,QDHER + INC HL + INC HL +; +; +VEQM: IN A,(SIOAC) + RLCA + JR C,QDHER + RRCA + RRCA + JR NC,VEQM + IN A,(SIOAD) +; + LD C,RCADR + LD B,H + OUT (C),L + DEC C + IN B,(C) + CP B + JR NZ,QDHER + INC HL + DEC DE + LD A,D + OR E + JR NZ,VEQM + CALL RDCRC + PUSH HL + CALL BRKCHK + JP Z,BREAKZ + LD HL,(FAS) + LD DE,(BLKSL) + LD BC,3 + XOR A + SBC HL,DE + SBC HL,BC + JR Z,SVALS + LD (FAS),HL + POP HL + JR SVALR +; +SVALS: POP HL + JR SVALT +; +SVALU: CALL MTOF + LD A,(FNUPS) + CALL QDSVFN + XOR A + LD (FNUPS),A + LD A,(FLAGF) + OR A + RET Z + SCF + RET +; +; +QDER: +RMER: LD A,54 + SCF + RET +; +QDHER: + LD A,41 + SCF + RET +; +; +; END (375AH) + + +; ORG 375AH +; ----------------------------- +; PLE-monitor CMT-driver +; FI:M-CMT ver 0.1 6.05.84 +; ----------------------------- +; + +; +_CMT: + DEFW _RS ;###diff Lx + DEFM "CMT" + DEFB 0 + DEFB 5FH ;Seq, W, R +_CMTF2: DEFB 0C0H ;CMT, 1OPN + DEFB 0 + DEFW CTINI ;INIT + DEFW CTRINF ;RO + DEFW CTWINF ;WO + DEFW __RET ;START + DEFW 256 ;Block/byte + DEFW CTRDAT ;INP + DEFW CTWDAT ;OUT + DEFW 0 ;DELETE + DEFW 0 ;WDIR + DEFW ER59 ;FREE +; +CTINI: + CALL TEST1 + DEFM "T" ; Change EOF process + LD HL,_CMTF2 + SET __EOFE,(HL) ; Tape BASIC mode + RET Z + RES __EOFE,(HL) ; Disk BASIC mode + OR A + RET +; +CTWINF: CALL PUSHR + LD DE,IBUFE + LD A,(HL) + LD C,5 + CP 2 ; BTX 2 ==> 5 + JR Z,CTWF2 + LD C,4 + CP 3 ; BSD 3 ==> 4 + JR Z,CTWF2 + LD C,A +; +CTWF2: LD A,C + LD (DE),A + INC HL + INC DE + LD BC,17 + LDIR + INC HL + INC HL + LD BC,6 + LDIR + LD B,128-24 + CALL CLRDE + LD HL,IBUFE + LD BC,128 + CALL SAVE1 + JR CTWD9 +; +CTWDAT: CALL SAVE2 +; +CTWD9: JP C,BREAKX ; break! + RET ; ok! +;------------------------------- +; +; read inf +; ent HL:adrs +;------------------------------- +CTRINF: LD A,37H ; SCF + LD (CTRDAT),A + PUSH HL + LD HL,IBUFE + LD BC,128 + CALL LOAD1 + JR C,CTERR ; error or break + LD DE,FINMES ; "Found" + CALL FNMPRT ; ? file name + POP DE + LD A,(ZLOG) + OR A ; ROPEN or LOAD? + LD A,(HL) + JP NZ,CTRI1 ; R + LD C,2 ; L BTX 5 ==> 2 + CP 5 + JR Z,CTRI2 +CTRI1: LD C,3 ; BSD 4 ==> 3 + CP 4 + JR Z,CTRI2 + LD C,A + SUB 2 + CP 2 + JP C,ER61 ; file mode error! +; +CTRI2: LD A,C + LD (DE),A + INC HL + INC DE + LD BC,17 + LDIR + XOR A + LD B,2 + CALL CLRDE + LD BC,6 + LDIR + LD B,32-18-2-6 + JP CLRDE +;---------------------------------- +; +; read data +; ent HL:adrs +; BC:byte size +;---------------------------------- +CTRDAT: XOR A ; XOR A / SCF + JR NC,CTRD2 + LD A,0AFH ;XOR A + LD (CTRDAT),A + PUSH HL ; first time only + LD HL,ELMD + LD DE,LDNGMS ; "Loading" + CALL FNMPRT ; ? file name + POP HL +; +CTRD2: CALL LOAD2 + RET NC ; ok! +; +CTERR: CP 2 + JP NZ,BREAKX ; break! + LD A,70+80H + JP ERRORJ ; error! +;----------------------------------- +; +; CMT SAVE +; +;----------------------------------- +SAVE1: ; Inf. + LD A,0CCH + JR SAVE3 +; +SAVE2: ; Data + LD A,53H +; +SAVE3: LD (SPSV+1),SP ;;; + LD SP,IBUFE ;;; + PUSH DE + LD E,A + LD D,0D7H ; 'W'=Dreg. + LD A,B + OR C + JR Z,RET1 + CALL CKSUM ; check sum set + CALL MOTOR ; motor on + JR C,WRI3 ; break! + LD A,E + CP 0CCH + JR NZ,WRI2 ; write Data + PUSH DE + LD DE,WRTMES ; "Writing" + CALL FNMPRT ; ? file name + POP DE +; +WRI2: DI + CALL GAP ; write gap + CALL NC,WTAPE ; write Inf. or Data +; +WRI3: DI + CALL _MSTOP ; motor off +; +RET1: POP DE +; +SPSV: LD SP,0 ;xxx + PUSH AF + RST 3 + DEFB _EI + POP AF + RET +;-------------------------------- +; +; CMT LOAD +; +;-------------------------------- +LOAD1: ; Inf. + LD A,0CCH + JR LOAD3 +; +LOAD2: ; Data + LD A,53H +LOAD3: LD (SPSV+1),SP ;;; + LD SP,IBUFE ;;; + PUSH DE + LD D,0D2H ; 'L'->Dreg + LD E,A + LD A,B + OR C + JR Z,RET1 + CALL MOTOR ; motor on + DI + CALL NC,TMARK ; read gap & tape mark + CALL NC,RTAPE ; read Inf. or Data + JR WRI3 +;------------------------------------- +; +; CMT VERIFY +; +;------------------------------------- +CMTVRF: ; Data + PUSH HL + LD DE,VFNGMS ; "Verifying" + LD HL,ELMD + CALL FNMPRT ; ? file name + POP HL + CALL LOAD_2 + RET NC ; ok! + CP 2 + JP NZ,BREAKX ; break! + LD A,3+80H + JP ERRORJ ; error! +; +LOAD_2: + LD (SPSV+1),SP ;;; + LD SP,IBUFE ;;; + PUSH DE + LD D,0D2H + LD E,53H + LD A,B + OR C + JR Z,RET1 + CALL CKSUM ; check sum set + CALL MOTOR ; motor on + DI +; + CALL NC,TMARK ; read gap & tape mark + CALL NC,TVRFY ; verify + JR WRI3 +;---------------------------------------- +; motor on +; exit CF=0:ok +; CF=1:break +;---------------------------------------- +MOTOR: CALL PUSHR + RST 3 + DEFB _DI + LD A,0F8H + OUT (LSD0),A ; break set + LD B,10 +; +MOT1: IN A,(LSD2) + AND 10H + JR Z,MOT4 +; +MOT2: LD B,0FFH ; 2sec delay +; +MOT3: CALL DLY7 ; 7ms delay + DJNZ MOT3 ; motor entry adjust + XOR A ; CF=0 + RET +; +MOT4: LD A,6 + OUT (LSD3),A + INC A + OUT (LSD3),A + DJNZ MOT1 + LD A,(CMTMSG) + OR A + JR NZ,MOT6 + RST 3 + DEFB _CR2 + LD A,7FH ; Play mark + RST 3 + DEFB _CRT1X + LD A,' ' + RST 3 + DEFB _CRT1C + LD A,D + CP 0D7H ; 'W' + LD DE,RECMES ; "RECORD." + JR Z,MOT5 ; write + LD DE,PLYMES ; "PLAY" +; +MOT5: + RST 3 + DEFB _CRTMS + RST 3 + DEFB _CR2 +; +MOT6: IN A,(LSD2) + AND 10H + JR NZ,MOT2 + IN A,(LSD1) + AND 80H + JR NZ,MOT6 + SCF ; CF=1,break! + RET +;----------------------------------- +; +; write tape +; +; in BC=byte size +; HL=adr. +; +; exit CF=0:ok. +; CF=1:break +;----------------------------------- +WTAPE: PUSH DE + PUSH BC + PUSH HL + LD D,2 ; repeat set + LD A,0F8H + OUT (LSD0),A ; break set +; +WTAP1: LD A,(HL) + CALL WBYTE ; 1 byte write + IN A,(LSD1) + AND 80H ; break check + SCF + JR Z,RTP5 ; break! + INC HL + DEC BC + LD A,B + OR C + JR NZ,WTAP1 + LD HL,(SUMDT) ; check sum write + LD A,H + CALL WBYTE ; high + LD A,L + CALL WBYTE ; low + CALL LONG + XOR A + DEC D + JR Z,RTP5 ; ok! + LD B,A ; Breg=256 +; +WTAP2: CALL SHORT ; write short 256 + DJNZ WTAP2 + POP HL + POP BC + PUSH BC + PUSH HL + JR WTAP1 ; repeat +;------------------------------------- +; +; read tape +; +; in BC=byte size +; HL=load adr. +; +; exit CF=0:ok +; CF=1,Acc=2:error +; else:break +;------------------------------------- +RTAPE: PUSH DE + PUSH BC + PUSH HL + LD D,2 ; repeat set +; +RTP1: CALL EDGE ; edge search:(49c) + JR C,RTP5 ; break!:7c +; reading point search + CALL DLY3 ; 17c (1232c) + IN A,(LSD2) + AND 20H + JR Z,RTP1 ; again + LD HL,0 + LD (SUMDT),HL + POP HL + POP BC + PUSH BC + PUSH HL +; +RTP3: CALL RBYTE ; 1 byte read + JR C,RTP5 ; error! + LD (HL),A ; data->(mem.) + INC HL + DEC BC + LD A,B + OR C + JR NZ,RTP3 + LD HL,(SUMDT) ; check sum + CALL RBYTE ; high + JR C,RTP5 ; error! + CP H + JR NZ,RTP6 ; error! + CALL RBYTE ; low + JR C,RTP5 ; error! + CP L + JR NZ,RTP6 ; error! +; +RTP4: XOR A +; +RTP5: POP HL + POP BC + POP DE + RET +; +RTP6: DEC D + JR NZ,RTP1 ; repeat +; +VFERR: LD A,2 ; error + SCF + JR RTP5 +;------------------------------------- +; +; verify tape +; +; in BC=byte size +; HL=adr. +; +; exit CF=0:ok +; CF=1,Acc=2:error +; else:break +;------------------------------------- +TVRFY: PUSH DE + PUSH BC + PUSH HL + LD D,2 ; repeat set +; +TVF1: CALL EDGE ; edge search:(49c) + JR C,RTP5 ; break!:7c +; reading point search + CALL DLY3 ; 17c (1232c) + IN A,(LSD2) + AND 20H + JR Z,TVF1 ; again + POP HL + POP BC + PUSH BC + PUSH HL +; +TVF2: CALL RBYTE ; 1 byte read + JR C,RTP5 ; error! + CP (HL) ; CP A.(mem.) + JR NZ,VFERR ; verify error! + INC HL + DEC BC + LD A,B + OR C + JR NZ,TVF2 + LD HL,(CSMDT) ; Check sum. + CALL RBYTE ; high + JR C,RTP5 ; error! + CP H + JR NZ,VFERR ; error! + CALL RBYTE ; low + JR C,RTP5 ; error! + CP L + JR NZ,VFERR ; error! + DEC D + JR NZ,TVF1 ; repeat + JR RTP4 ; ok! +; +RECMES: DEFM "RECORD." +PLYMES: DEFM "PLAY" + DEFB 0 +;-------------------------------------- +; +; file name print +;-------------------------------------- +FNMPRT: LD A,(CMTMSG) + OR A + RET NZ + RST 3 + DEFB _CR2 + RST 3 + DEFB _CRTMS + PUSH HL + INC HL + LD A,'"' + RST 3 + DEFB _CRT1C + LD D,16 +; +FNMLP: LD A,(HL) + CP 0DH + JR Z,FNMLE + RST 3 + DEFB _CRT1C + INC HL + DEC D + JR NZ,FNMLP +; +FNMLE: LD A,'"' + RST 3 + DEFB _CRT1C + RST 3 + DEFB _CR2 + POP HL + RET +; +WRTMES: DEFM "WRITING " + DEFB 0 +FINMES: DEFM "FOUND " + DEFB 0 +LDNGMS: DEFM "LOADING " + DEFB 0 +VFNGMS: DEFM "VERIFYING " + DEFB 0 +; +; +;----------------------------------------- +; +; tape format +; +; +; <460us><496us><240us> <264us> +; b b b b b b +; gxxxxxx° gxx° gxx° g +; xxxxxt b hxxxxxxt hxxt hxxt +; b b b b +; b b b b +; / / / / / / +; ! ! Read point! ! Read point +; ! 368us ! 368us +; Read edge Read edge +; +;----------------------------------------- +; +; Information format : Data format +; : +; * gap : * gap +; short 10 sec : short 5 sec +; (22000) : (11000) +; * tape mark : * tape mark +; long 40 : long 20 +; short 40 : short 20 +; * long 1 : * long 1 +; * Information : * Data +; block : block +; (128 bytes) : (???? bytes) +; * check sum : * check sum +; (2 bytes) : (2 bytes) +; * long 1 : * long 1 +; * short 256 : * short 256 +; * Information : * Data +; block : block +; (128 bytes) : (???? bytes) +; * check sum : * check sum +; (2 bytes) : (2 bytes) +; * long 1 : * long 1 +; +;----------------------------------------- +; +; +; EDGE (tape data edge search) +; (85c+111c)/4= 49 clock +; +; exit CF=0:ok +; CF=1:break +; +EDGE: LD A,0F8H + OUT (LSD0),A ; break set + NOP +; +EDG1: IN A,(LSD1) + AND 81H ; shift & break + JR NZ,EDG2 + SCF + RET +; +EDG2: IN A,(LSD2) ; 11c + AND 20H ; 7c + JR NZ,EDG1 ; CSTR D5=0: 7c/12c +; +EDG3: IN A,(LSD1) ; 11c + AND 81H ; 7c + JR NZ,EDG4 ; 7c/12c + SCF + RET +; +EDG4: IN A,(LSD2) ; 7c + AND 20H ; 7c + JR Z,EDG3 ; CSTR D5=1: 7c/12c + RET ; 10c +;-------------------------------------- +; +; 1 byte read +; +; exit SUMDT=Store +; CF=1:break +; CF=0:data=Acc +;-------------------------------------- +RBYTE: PUSH DE + PUSH BC + PUSH HL + LD HL,0800H ; 8 repeat set +; +RBY1: CALL EDGE ; edge search:(49c) + JP C,TM4 ; break!:7c +; reading point search:17c(1232c) + CALL DLY3 ; 17c (1232c) + IN A,(LSD2) ; data read + AND 20H ; CF=0 + JP Z,RBY2 ; again + PUSH HL + LD HL,(SUMDT) ; check sum set + INC HL + LD (SUMDT),HL + POP HL + SCF ; CF=1 +; +RBY2: LD A,L + RLA ; rotate left + LD L,A + DEC H + JP NZ,RBY1 ; repeat + CALL EDGE + LD A,L + JR TM4 ; ok! +;------------------------------------- +; +; 1 byte write +; in Acc=data +;------------------------------------- +WBYTE: PUSH BC + LD B,8 ; 8 repeat set + CALL LONG ; write long +; +WBY1: RLCA ; rotate left + CALL C,LONG ; 'H' long + CALL NC,SHORT ; 'L' short + DEC B + JP NZ,WBY1 ; repeat + POP BC + RET +;------------------------------------- +; +; tape mark read +; +; in E=CCH:Inf. long40,short40 +; else:Data long20,short20 +; +; exit CF=0:ok +; CF=1:break +; +;------------------------------------- +TMARK: CALL GAPCK +; + PUSH DE + PUSH BC + PUSH HL + LD HL,2828H ; H=40,L=40 + LD A,E + CP 0CCH ;'L' + JR Z,TM0 + LD HL,1414H ; H=20,L=20 +; +TM0: LD (TMCNT),HL +; +TM1: LD HL,(TMCNT) +; +TM2: CALL EDGE ; edge search:(49c) + JR C,TM4 ; break!:7c +; reading point search:17c(1232c) + CALL DLY3 ; 17c (1232c) + IN A,(LSD2) + AND 20H + JR Z,TM1 ; again + DEC H + JR NZ,TM2 +; +TM3: CALL EDGE ; edge search:(49c) + JR C,TM4 ; break!:7c +; reading point search:17c(1232c) + CALL DLY3 ; 17c (1232c) + IN A,(LSD2) + AND 20H + JR NZ,TM1 ; again + DEC L + JR NZ,TM3 + CALL EDGE +; +TM4: POP HL +; +TM5: POP BC + POP DE + RET +;------------------------------------ +; +; check sum set +; +; in BC=byte size +; HL=adr. +; +; exit SUMDT=store +; CSMDT=store +;------------------------------------ +CKSUM: PUSH DE + PUSH BC + PUSH HL + LD DE,0 +; +CKS1: LD A,B + OR C + JR NZ,CKS2 + EX DE,HL + LD (SUMDT),HL + LD (CSMDT),HL + JR TM4 ; ret +; +CKS2: LD A,(HL) + PUSH BC + LD B,8 ; 8 bits +; +CKS3: RLCA ; rotate left + JR NC,CKS4 + INC DE +; +CKS4: DJNZ CKS3 + POP BC + INC HL + DEC BC + JR CKS1 +;-------------------------------------- +; +; gap + tape mark +; +; in E=CCH:short gap (10 sec) +; else:short GAP ( 5 sec) +;-------------------------------------- +GAP: PUSH DE + PUSH BC + LD A,E + LD BC,55F0H ; Inf. 22000(10 sec) + LD DE,2828H ; short40,long40 + CP 0CCH ;'L' + JP Z,GAP1 + LD BC,2AF8H ; Data 11000( 5 sec) + LD DE,1414H ;short20,long20 +; +GAP1: CALL SHORT ; write short + DEC BC + LD A,B + OR C + JR NZ,GAP1 +; +GAP2: CALL LONG ; write long + DEC D + JR NZ,GAP2 +; +GAP3: CALL SHORT ; write short + DEC E + JR NZ,GAP3 + CALL LONG + JR TM5 +;----------------------------------------- +; +; GAP check +; (long100 search) +;----------------------------------------- +GAPCK: PUSH DE + PUSH BC + PUSH HL +; +GAPCK1: LD H,100 ; 100 repeat set +; +GAPCK2: CALL EDGE ; edge search:(49c) + JR C,TM4 ; error!:7c + CALL DLY3 ; reading point search:17c(1232c) + IN A,(LSD2) + AND 20H + JR NZ,GAPCK1 ; again + DEC H + JR NZ,GAPCK2 + JR TM4 +;---------------------------------------- +; +; SHORT AND LONG PULSE FOR 1 BIT WRITE +;---------------------------------------- +SHORT: PUSH AF ; 11c + LD A,03H ; 7c + OUT (LSD3),A ; 11c + CALL DLY1 ; 17c (408c) + CALL DLY1 ; 17c (408c) + LD A,02H ; 7c + OUT (LSD3),A ; 11c + CALL DLY1 ; 17c (408c) + CALL DLY1 ; 17c (408c) + POP AF ; 10c + RET ; 10c +; +; +LONG: PUSH AF ; 11c + LD A,03H ; 7c + OUT (LSD3),A ; 11c + CALL DLY4 ; 17c (1704c) + LD A,02H ; 7c + OUT (LSD3),A ; 11c + CALL DLY4 ; 17c (1704c) + POP AF ; 10c + RET ; 10c +;---------------------------------------- +; +; MOTOR STOP +;---------------------------------------- +_MSTOP: PUSH AF + PUSH BC + PUSH DE + LD B,10 +; +MST1: IN A,(LSD2) ; motor check + AND 10H + JR Z,MST3 ; ok + LD A,06H ; motor off + OUT (LSD3),A + INC A + OUT (LSD3),A + DJNZ MST1 +; +MST3: POP DE + POP BC + POP AF + RET +;------------------------------------------- +; +; 7.046 ms delay ... 24989c +;------------------------------------------- +DLY7: + PUSH BC ; 11c + LD B,20 ; 7c +; +DLY_7: CALL DLY3 ; 17*19+17 (23332c) + CALL DLY0 ; 17*19+17 ( 226c) + DJNZ DLY_7 ; 13*19+8 + POP BC ; 10c + RET ; 10c +;------------------------------------------- +; +; 14 clock delay +;------------------------------------------- +DLY0: NOP ; 4c + RET ; 10c +;------------------------------------------- +; +; 347.4 us delay ... 1232c +;------------------------------------------- +DLY3: NOP ; 4c + LD A,76 ; 7c +; +DLYA: DEC A ; 4*XX+4 + JR NZ,DLYA ; 12*XX+7 + RET ; 10c +;----------------------------------- +; +; Delay for short. +; 115.0 us delay ... 408c +;----------------------------------- +DLY1: + LD A,24 ; 7c + JR DLYA ; 12c +;----------------------------------- +; +; Delay for long. +; 480.4 us delay ... 1704c +;----------------------------------- +DLY4: + LD A,105 ; 7c + JR DLYA ; 12c +; +; END (3B9EH) + + + +CMT_END: +DEFS $3B9E-CMT_END + + + +; ORG 3B9EH + +; ---------------------------- +; PL-monitor FD dummy +; FI:DMY-FD ver 003 3.28.84 +; ---------------------------- +; + +; +; +_FD: + DEFW _QD + DEFB 0 +; +CLX: ;dummy routines +DUST: +FLOFF: +FREEX: +INREC: +INX1B: +LD_DIR: +LDX: +LOPX: +OPX: +PRREC: +PRX1B: +RECST: +SVX: + OR A + RET +; +FLOCK: +FSWAP: + JP ER59 + + +; +; SVC .DELET +; +FDELET: + CALL PUSHR + LD HL,(ZDELT) ;SEQ + LD A,L + OR H + JR Z,FREN2 + PUSH HL + RST 3 + DEFB _LOPEN + LD A,2 + LD (ZRWX),A + CALL _OPEND + JR FREN4 +; +; SVC .RENAM +; +FRENAM: + CALL PUSHR + LD HL,(ZWDIR) + LD A,L + OR H +FREN2: JP Z,ER59 + PUSH HL + RST 3 + DEFB _LOPEN + LD HL,ELMD + CALL SETFNAM + LD HL,200H + LD (ZLOG),HL + CALL SERFLW ;check already exist +FREN4: POP IX + JP IOCALL + +; END (3BDFH) + + +FD_END: +DEFS $3C00-FD_END + + +; ORG 3C00H + +defc __ADCN = 00BB9H ; Convert ASCII code to display code +defc __DACN = 00BCEH ; Convert display code to ASCII code + + +;---------------------------------- +; +; ascii display code trans +; +;---------------------------------- +ADCN: + CP 10H ;EX only + JR C,_AD3 ; <10H ==> F0H + CP 80H + JR Z,_AD7 ; 80H ==> 40H + CP 0C0H + JR Z,_AD7 ; C0H ==> 80H + DI + OUT (LSE2),A + CALL __ADCN + OUT (LSE0),A + EI + RET +_AD3: LD A,0F0H + RET +_AD7: SUB 40H + RET +; +DACN: + CP 0F0H + JR NC,_DA3 + CP 73H + JR Z,_AD3 ; 73H ==> F0H + CP 40H ;EX only + JR Z,_DA7 ; 40H ==> 80H + CP 80H + JR Z,_DA7 ; 80H ==> C0H + DI + OUT (LSE2),A + CALL __DACN + OUT (LSE0),A + EI + CP 0F0H + RET NZ +_DA3: LD A,' ' + RET +_DA7: ADD A,40H + RET +; +; +; +_KYTBL: + PUSH AF + LD A,L + SUB 8 + JR C,_KY0 + SUB 48 + JR C,_KY1 +_KY0: ADD A,10 + LD L,A + ADD HL,BC + LD C,(HL) + POP AF + RET +_KY1: LD A,(BC) + PUSH AF + INC BC + LD A,(BC) + LD B,A + POP AF + LD C,A ;BC=ROM adrs + ADD HL,BC + DI + OUT (LSE2),A + LD A,(HL) + OUT (LSE0),A + EI + CALL DACN + LD C,A + POP AF + RET +; END (3C64) + + +; ORG 3C64H +; ---------------------------- +; MZ-800 RS-232C driver +; FI:MON-RS ver 001 8.02.84 +; ---------------------------- +; + + +IF RSYS + defc RMCH = 3 +ELSE + defc RMCH = 1 +ENDIF +; +; +_RS: + DEFW _RAM + DEFM "RS" + DEFW 0 + DEFB 8FH ;Streem, O1C, I1C, W, R + DEFB RMCH ;ch. + DEFB 0 + DEFW RSINI ;INIT + DEFW RSRO ;ROPEN + DEFW RSWO ;WOPEN + DEFW RSCL ;CLOSE + DEFW RSKL ;KILL + DEFW RSINP ;INP1C + DEFW RSOUT ;OUT1C + DEFW __RET ;POS +; +RSINI: RET C + PUSH IY + CALL SETIY + CALL RSINT0 + CALL RSPARM + JR RETIY +; +RSINT0: + RST 3 + DEFB _DEASC + LD (IY+_MONIT),E + CALL TEST1 + DEFM "," + JP NZ,ER03 + RST 3 + DEFB _DEASC + LD (IY+_INIT),E + CALL TEST1 + DEFB 0 + RET Z + CALL TEST1 + DEFM "," + JP NZ,ER03 + RST 3 + DEFB _DEASC + LD (IY+_CRLF),E + RET + + +; +RSRO: +RSWO: PUSH IY + CALL SETIY + LD A,(IY+_STAT) + INC (IY+_STAT) + OR A + CALL Z,RSOPEN + JR RETIY +; +; +RSCL: +RSKL: PUSH IY + CALL SETIY + DEC (IY+_STAT) + LD A,(IY+_STAT) + OR A + CALL Z,RCLOSE + JR RETIY2 +; +; +; +RSINP: PUSH IY + CALL SETIY + CALL RSINP0 + JP C,IOERR + CP (IY+_CRLF) + JR NZ,$+4 + LD A,0DH +RETIY2: OR A +RETIY: POP IY + RET +; +RSINP0: BIT 6,(IY+_INIT) + JP Z,GET1C + LD IX,GET1C + LD HL,IY + LD DE,_JISR + ADD HL,DE + JP JISR +; +RSOUT: PUSH IY + CALL SETIY + CP 0DH + JR NZ,$+5 + LD A,(IY+_CRLF) + CALL RSOUT0 + JR RETIY +; +RSOUT0: BIT 6,(IY+_INIT) + JP Z,PUT1C + LD IX,PUT1C + LD HL,IY + LD DE,_JISX + ADD HL,DE + LD DE,(DISPX) + JP JISX + + +; +SETIY: PUSH AF + PUSH DE + LD A,(ZCH) + INC A + LD IY,__A-TBLN + LD DE,TBLN +SETIY2: ADD IY,DE + DEC A + JR NZ,SETIY2 + LD C,(IY+0) + POP DE + POP AF + RET +; +; +;*** PORT ADDRESS EQU *** +; +; Serial interface port (also valid on the MZ80K, e.g. MZ-8BIO3 board) +defc CHADT = 0B0H ; Data port +defc CHACT = 0B1H ; +defc CHBDT = 0B2H +defc CHBCT = 0B3H +; +; +defc CHCDT = 0D0H +defc CHCCT = 0D1H +defc CHDDT = 0D2H +defc CHDCT = 0D3H +; +defc _CRLF = -8 +defc _JISX = -7 +defc _JISR = -5 +defc _MONIT = -3 +defc _INIT = -2 +defc _STAT = -1 + + +; +; + DEFS 1 ;CR or LF + DEFS 2 ;for JISX + DEFS 2 ;for JISR + DEFS 1 ;monitor + DEFS 1 ;init code + DEFS 1 ;status +__A: DEFB CHACT ;0 + DEFB CHADT ;1 + DEFS 1 ;2 Mask Pattern + DEFW 1010H ;3,4 + DEFW 4004H ;5,6 WR4 + DEFW 0C003H ;7,8 WR3 + DEFW 6005H ;9,10 WR5 + DEFB 30H + DEFB 3 +; +; + DEFS 8 +__B: DEFB CHBCT + DEFB CHBDT + DEFS 1 + DEFW 1010H + DEFW 4004H + DEFW 0C003H + DEFW 6005H + DEFB 30H + DEFB 3 +; +; + IF RSYS + DEFS 8 +__C: DEFB CHCCT ;0 + DEFB CHCDT ;1 + DEFS 1 ;2 Mask Pattern + DEFW 1010H ;3,4 + DEFW 4004H ;5,6 WR4 + DEFW 0C003H ;7,8 WR3 + DEFW 6005H ;9,10 WR5 + DEFB 30H + DEFB 3 +; +; + DEFS 8 +__D: DEFB CHDCT + DEFB CHDDT + DEFS 1 + DEFW 1010H + DEFW 4004H + DEFW 0C003H + DEFW 6005H + DEFB 30H + DEFB 3 + ENDIF +; +defc TBLN = __B-__A +; + + +; +; +; Break Check +; +BRK: CALL BRKCHK + RET NZ + JP BREAKZ +; +; sio parameter set +; +; +; +RSPARM: + LD A,18H ;channel reset + OUT (C),A + LD A,30H ;err reset + OUT (C),A + LD A,(IY+_INIT) ;inital bit + AND 0CH ;stop bit + JR NZ,RSP0 + SET 2,(IY+_INIT) ;1 bit/chr +RSP0: LD A,(IY+_INIT) ;initial bit + LD B,A ;B=init code + AND 0FH ;mask + OR 40H ;clock rate *16 + LD (IY+6),A ;wr4 + LD A,B + AND 80H ;rx disable d7 bit/chr + OR 40H + LD (IY+8),A ;wr3 + RRA + AND 7FH ;dtroff + OR 0AH ;tx enable rtson dtroff + LD (IY+10),A ;wr5 + LD A,B + OR 7FH + LD (IY+2),A ;bit mask + CALL RSSUB +RSTBUF: + IN A,(C) + RRCA + RET NC + DEC C + IN A,(C) + INC C + LD A,1 + OUT (C),A + IN A,(C) + AND 70H + JR Z,RSTBUF + RET +; +; +; +; +; SIO close +; +; +RCLOSE: RES 0,(IY+8) ;rx disable + RES 7,(IY+10) ;rdy off + LD (IY+_STAT),0 +RSSUB: LD B,10 + PUSH IY + POP HL + LD DE,3 + ADD HL,DE + OTIR + RET +; +; +; SIO open +; +; +RSOPEN: LD A,30H + OUT (C),A ;err reset + RET + + +; +; +; in IY=channel data +; C=channel control port +; +; +; +RSEN: SET 0,(IY+8) ;wr3 RX enable + LD A,13H + OUT (C),A ;ext/int reset + LD A,(IY+8) ;wr3 + OUT (C),A ;wr5 + LD A,35H ;err reset + OUT (C),A + LD A,(IY+10) ;wr5 + OR 88H ;dtr,rts on tx enable + LD (IY+10),A ;wr5 + OUT (C),A + RET +; +; +RSDIS: LD A,3 + OUT (C),A + RES 0,(IY+8) ;wr3 RX disenable + LD A,(IY+8) ;wr3 + OUT (C),A +; +RDYOF: RES 7,(IY+10) ;wr5 dtr reset + JR WR5OUT +; +; +RTSON: SET 1,(IY+10) ;wr5 rts set + JR WR5OUT +; +; +RTSOFF: RES 1,(IY+10) ;wr5 rts reset + JR WR5OUT +; +; +RDYON: SET 7,(IY+10) ;wr5 dtr set +WR5OUT: LD A,5 + OUT (C),A + LD A,(IY+10) ;wr5 + OUT (C),A + OR A + RET + + +; +; +; Receive 1 char +; +; +GET1C: CALL PUSHR + LD C,(IY+0) +GET1: CALL BRK + CALL DRCKR + JR C,GET1 + CALL RSEN +CHIN: CALL BRK + IN A,(C) + RRCA + JR NC,CHIN ;skip if no data + DEC C + IN A,(C) ;data input + INC C + AND (IY+2) ;mask + PUSH AF + LD A,1 + OUT (C),A + IN A,(C) + AND 70H + JR NZ,RSER ;skip if err + CALL RDYOF + POP AF + RET +; +; +; +RSER: LD B,A + POP AF + PUSH BC + CALL RSPARM + POP BC + LD A,29 ;framing err + RLC B + RLC B + RET C + INC A ;overrun err + RLC B + RET C + INC A ;parity err + SCF + RET + + +; +; +; Send 1 char +; +; +PUT1C: CALL PUSHR + LD C,(IY+0) + LD D,A + CALL RTSON +PUT1: CALL BRK + CALL DRCKS + CALL NC,CTSCK + JR C,PUT1 + IN A,(C) + BIT 2,A ;tx buf empty ? + JR Z,PUT1 + BIT 7,(IY+_MONIT) ;all chr send? + JR Z,PUT2 + LD A,1 + OUT (C),A + IN A,(C) + RRCA + JR NC,PUT1 +PUT2: DEC C + OUT (C),D ;data out + INC C + BIT 6,(IY+_MONIT) ;rts on/off? + JR Z,PUT3 + CALL RTSOFF +PUT3: OR A + RET +; +; DCD check +; +DRCKR: OR A + BIT 0,(IY+_MONIT) ;moniter dr ? + JR DRCK1 +; +DRCKS: OR A ;carry clear + BIT 1,(IY+_MONIT) ;moniter dr ? +DRCK1: RET Z + LD A,10H ;ext/int reset + OUT (C),A + IN A,(C) + AND 8 + RET NZ ;cy=0 + SCF + RET +; +; CTS check +; +CTSCK: OR A + BIT 2,(IY+_MONIT) ;moniter cts ? + RET Z + LD A,10H + OUT (C),A + IN A,(C) + AND 20H + RET NZ + SCF + RET +; +; END (3EC6H) + + +; ORG 3EC6H + +; ---------------------------- +; Lx-monitor EMM driver +; FI:MON-EMM ver 005 4.27.84 +; ---------------------------- +; + +; +_RAM: + DEFW _FD + DEFM "RAM" + DEFB 0 + DEFB 5FH +IF MOD_B + DEFB 23H ;1WOPN +ELSE + DEFB 20H ;1WOPN +ENDIF + DEFB 32 ;Max dir + DEFW EMINI ;INIT + DEFW EMRINF + DEFW EMWINF + DEFW EMON + DEFW 1024 + DEFW EMRDAT + DEFW EMWDAT + DEFW EMDEL + DEFW EMWDIR + DEFW EMFRKB +; +EMFRKB: +IF RAMDISK + CALL EMFRB_DI +ELSE + CALL EMFRB +ENDIF + LD C,H + LD B,0 ;/256 + SRL C ;/512 + SRL C ;/1024 + OR A + RET +; +EMFRB: PUSH DE + LD HL,0 ;free area(bytes) + CALL EMLD2 ;max + PUSH DE + INC HL + INC HL + CALL EMLD2 ;use + POP HL + SBC HL,DE + JP C,ER41 ;I/O ERR + POP DE + RET +; +; +EMCLR: LD DE,10H +EMSETU: LD HL,2 + CALL EMSV2 ;Set used mem + EX DE,HL + LD DE,0 + JP EMSV2 ;File end mark + +; +EMINI: RET C + LD A,(EMFLG) + OR A + JP Z,ER50 + CALL OKYN + CALL TEST1 + DEFM "," + PUSH HL +IF RAMDISK + CALL EMCLR_DI +ELSE + CALL EMCLR +ENDIF + POP HL + CALL TEST1 + DEFB 0 + RET Z ;INIT "EM:" + RST 3 + DEFB _DEASC ;INIT "EM:$hhhh" +EMINI2: LD HL,0 + DI + LD B,1 + LD A,D + AND 0FCH + CP 0FCH + LD HL,0FFFFH + JR Z,EMINI3 ;if >=FC00 then FFFF + LD B,3 + LD A,D + OR A + LD HL,20H + JR NZ,$+3 ;if <=00FF then 0020 +EMINI3: EX DE,HL + LD A,B + LD (EMFLG),A + LD HL,0 + CALL EMSV2 ;Set max mem + CALL PBCCLR + EI + RET + + +; +; EMM power on routine +; +EMMPWR: + LD HL,8 + LD B,L + LD C,0 +EMPWR2: CALL EMLD1 + SUB L + OR C + LD C,A + LD A,L + CALL EMSV1 + INC L + DJNZ EMPWR2 + LD A,C + OR A + JR NZ,EMPWR4 + LD HL,0 ;already initialized + CALL EMLD2 + LD A,2 + INC D + JR Z,$+3 + INC A + LD (EMFLG),A + JP PBCCLR +EMPWR4: + CALL EMCLR + LD HL,0 ;check EMM installed? + LD A,5AH + CALL EMSV1 + CALL EMLD1 + SUB 5AH +EMPWR_SMC: +IF MOD_B + LD DE,0FFFFH ;64KB MOD +ELSE + LD DE,0C000H ;Initial set 48KB +ENDIF + JR Z,EMINI2 + XOR A + LD (EMFLG),A + RET + +; +; Dir search start +; +EMON: LD A,(EMFLG) + OR A + JP Z,ER50 + LD HL,10H + LD (EMPTR),HL + RET +; +; Read inf +; ent HL:adrs +; +EMRINF: LD BC,HL + LD HL,(EMPTR) +IF RAMDISK + CALL EMLD2_DI +ELSE + CALL EMLD2 +ENDIF + LD A,D + OR E + SCF + RET Z + INC HL + INC HL + PUSH HL + ADD HL,DE + JP C,ER41 ;I/O ERR + LD (EMPTR),HL + POP HL + INC HL + INC HL + INC HL + LD DE,BC + LD BC,32-2 + CALL EMLDD + LD BC,32+2 + ADD HL,BC + EX DE,HL + LD (HL),E ;Save data area adrs + INC HL + +IF RAMDISK + JP EMRINF_EI +ELSE + LD (HL),D + OR A + RET +ENDIF +; +; Read data +; ent HL:buffer adrs +; BC:byte size +; +EMRDAT: EX DE,HL + LD L,(IY+30) + LD H,(IY+31) + INC HL + INC HL + INC HL +IF RAMDISK + CALL EMLDD_0 +ELSE + CALL EMLDD +ENDIF + LD (IY+30),L + LD (IY+31),H + OR A + RET + +; +; Write file +; HL:inf adrs +; +EMWINF: PUSH AF + CALL SERFLW + PUSH HL + LD HL,2 +IF RAMDISK + CALL EMLD2_DI_0 +ELSE + CALL EMLD2 +ENDIF + LD (EMWP0),DE + PUSH DE + LD HL,64+7 + ADD HL,DE + CALL EMFRE_ ;Check file space + POP DE + INC DE + INC DE + POP HL ;inf adrs + LD BC,64 + POP AF +IF RAMDISK + CALL EMSVB_EI +ELSE + CALL EMSVB +ENDIF + LD (EMWP1),DE + RET + + +; +; Write data +; HL:data adrs +; BC:data bytes +; A0:close flag +; +; +EMWDAT: PUSH AF + PUSH HL + PUSH BC + LD HL,(EMWP1) + INC BC + INC BC + INC BC + ADD HL,BC + CALL EMFRE_ + POP BC + POP HL + LD DE,(EMWP1) + POP AF + PUSH AF + OR 01H ;data block + CALL EMSVB + LD (EMWP1),DE + POP AF + BIT 2,A ;close ? + RET Z ;no + PUSH DE ;yes + CALL EMSETU + POP HL + LD DE,(EMWP0) + DEC HL + DEC HL + OR A + SBC HL,DE + EX DE,HL + JP EMSV2 +; +; +EMFRE_: JR C,ER53A + PUSH HL + LD HL,0 + CALL EMLD2 + OR A + POP HL + SBC HL,DE + RET C +ER53A: JP ER53 ;No file pace + + +; +; delete file +; +EMDEL: LD HL,(ELMD30) + LD DE,-64-5 + ADD HL,DE ;HL:=move destination + CALL EMLD2 ;DE:=delete size - 2 + EX DE,HL ;DE:=move destination + ADD HL,DE + INC HL + INC HL ;HL:=move source + PUSH DE + PUSH HL + LD HL,2 + CALL EMLD2 + EX DE,HL ;HL:=last use + POP DE ;DE:=move source + PUSH DE + OR A + SBC HL,DE + INC HL + INC HL + LD BC,HL ;BC:=move bytes + POP HL ;HL:=move source + POP DE ;DE:=move destination + CALL EMLDIR + DEC DE + DEC DE ;DE:=new last-use + LD HL,2 + JP EMSV2 +; +; write dir +; +EMWDIR: LD HL,(ELMD30) + LD DE,-64 + ADD HL,DE + EX DE,HL + LD HL,ELMD + LD BC,32 + JP EMSVD + + +; +IF MOD_B +;defc EM_P0 = 0ECH +;defc EM_P1 = 0EFH +ELSE +defc EM_P0 = 0EAH +defc EM_P1 = 0EBH +ENDIF + +; +; EMM 1 Byte Write +; ent A: data +; HL:EMM adrs +; +EMSV1: + PUSH BC +IF MOD_B + CALL EMSV1_00 + IN B,(C) + LD B,H + OUT (C),A + POP BC +ELSE + LD C,EM_P1 + LD B,H + OUT (C),L + OUT (EM_P0),A + POP BC + OR A +ENDIF + RET +; +; EMM 1 Byte Read +; ent HL:EMM adrs +; ext A: dat +; +EMLD1: + PUSH BC +IF MOD_B + CALL EMSV1_00 + IN B,(C) + LD B,H + IN A,(C) + POP BC +ELSE + LD C,EM_P1 + LD B,H + OUT (C),L + IN A,(EM_P0) + POP BC + OR A +ENDIF + RET +; +; EMM 2 Byte Write +; ent DE:data +; HL:EMM adrs +; +EMSV2: + LD A,E + CALL EMSV1 + INC HL + LD A,D + CALL EMSV1 + DEC HL + RET +; +; EMM 2 Byte Read +; ent HL:EMM adrs +; DE:data +; +EMLD2: + CALL EMLD1 + LD E,A + INC HL + CALL EMLD1 + LD D,A + DEC HL + RET + + +; +; EMM write block +; ent HL :data Top +; DE :EMM Adrs +; BC :byte Size +; A :block flag +; +EMSVB: EX DE,HL + CALL EMSV1 + INC HL + LD A,C + CALL EMSV1 + INC HL + LD A,B + CALL EMSV1 + INC HL + EX DE,HL +EMSVD: + EX DE,HL +EMSVE: LD A,(DE) + CALL EMSV1 + INC HL + INC DE + DEC BC + LD A,B + OR C + JR NZ,EMSVE + EX DE,HL + RET +; +; EMM BC Byte Read +; ent DE :Store Top +; HL :EMM Adrs +; BC :Byte Size +; +EMLDD: + CALL EMLD1 + LD (DE),A + INC HL + INC DE + DEC BC + LD A,B + OR C + RET Z + JR EMLDD +; +; EMM BC Byte LDIR +; ent HL :EMM source top +; DE :EMM destination top +; BC :Byte Size +; +EMLDIR: + CALL EMLD1 ;EMM (HL) Data => Acc + EX DE,HL + CALL EMSV1 ;Acc => (DE) EMM + EX DE,HL + INC HL + INC DE + DEC BC + LD A,B + OR C + RET Z ;End + JR EMLDIR + +; END (40FA) + + + +; ORG 40FAH + +; ---------------------------- +; MZ800-monitor PSG handlar +; FI:MON-PSG ver 001 7.26.84 +; ---------------------------- +; + +; +; +defc NMAX = 83 ;/ÙÄs max +defc PSGA = 0F2H +defc PSG3 = 3F2H +defc PSG9 = 9F2H +; + IF SYS +defc MUSCH = 6 +defc MAXCH = 8 +defc PSGALL = 0E9H +defc PSGOFF = 4E9H + ELSE +defc MUSCH = 3 +defc MAXCH = 4 +defc PSGALL = 0F2H +defc PSGOFF = 4F2H + ENDIF +;---------------------------------- +; +; INTM (music interrupt mode ) +;0 no operation +;1 music or noise +;2 sound n.time +; +;---------------------------------- +; +INTM: + DEFB 0 +SBUSY: DEFB 0 ;music or noise only +INTC: DEFB 0 +;---------------------------------- +; +; sound out current tabel +; +; +;---------------------------------- +; tone 1a +; +STBL: DEFB 80H ;frequency (l) + DEFB 00H ;frequency (h) + DEFB 9FH ;attenation +; tone 2a + DEFB 0A0H ;frequency (l) + DEFB 00H ;frequency (h) + DEFB 0BFH ;attenation +; tone 3a + DEFB 0C0H ;frequency (l) + DEFB 00H ;frequency (h) +STN0: DEFB 0DFH ;attenation +; + IF SYS +; tone 1b +; + DEFB 80H ;frequency (l) + DEFB 00H ;frequency (h) + DEFB 9FH ;attenation +; tone 2b + DEFB 0A0H ;frequency (l) + DEFB 00H ;frequency (h) + DEFB 0BFH ;attenation +; tone 3b + DEFB 0C0H ;frequency (l) + DEFB 00H ;frequency (h) +STN1: DEFB 0DFH ;attenation + ENDIF + + +;---------------------------------- +; +; play table +; +;---------------------------------- +PTBL: DEFB 00H ;ch no. + DEFB 00H ;atc0 + DEFB 00H ;atc1 + DEFB 00H ;emva(l) + DEFB 00H ;emva(h) + DEFB 00H ;att + DEFB 00H ;length0 + DEFB 00H ;tempo0 + DEFB 00H ;length1 + DEFB 00H ;tempo1 + DEFB 00H ;qbuf(l) + DEFB 00H ;qbuf(h) + DEFB 00H ;emvp + DEFB 00H ;status + DEFB 00H ;vol + DEFB 00H ;reserve + DEFB 01H ;ch no. + DEFS 15 ;ch1 + DEFB 02H ;ch no. + DEFS 15 ;ch2 + DEFB 03H ;ch no. + DEFS 15 ;noise1 +; + IF SYS + DEFB 04H ;ch no. + DEFS 15 ;ch3 + DEFB 05H ;ch no. + DEFS 15 ;ch4 + DEFB 06H ;ch no. + DEFS 15 ;ch5 + DEFB 07H ;ch no. + DEFS 15 ;noise2 + ENDIF +;---------------------------------- +; +; +; ontyo tabel +; +;---------------------------------- +LTBL: DEFB 1 ;0 + DEFB 2 ;1 + DEFB 3 ;2 + DEFB 4 ;3 + DEFB 6 ;4 + DEFB 8 ;5 + DEFB 12 ;6 + DEFB 16 ;7 + DEFB 24 ;8 + DEFB 32 ;9 +;---------------------------------- +; +; +; tempo tabel +; +;---------------------------------- + DEFB 23 ;1 64 + DEFB 20 ;2 74 + DEFB 17 ;3 90 + DEFB 13 ;4 114 + DEFB 10 ;5 152 + DEFB 7 ;6 222 + DEFB 3 ;7 450 + + +;---------------------------------- +; emvelop pattern tabel +; +; ATT ÀÙÛÛÙ code +; +; 0 3 +; -1 4 +; +1 5 +; r 0 +; max 1 +; min 2 +;---------------------------------- +ETBL: DEFB 00H ;emvp 0 + DEFB 05H + DEFB 03H + DEFB 03H ;dummy +; + DEFB 0FH ;emvp 1 + DEFB 04H + DEFB 01H + DEFB 03H ;dummy +; + DEFB 00H ;emvp 2 + DEFB 05H + DEFB 02H + DEFB 00H +; + DEFB 0FH ;emvp 3 + DEFB 04H + DEFB 01H + DEFB 00H +; + DEFB 00H ;emvp 4 + DEFB 05H + DEFB 02H + DEFB 03H +; + DEFB 0FH ;emvp 5 + DEFB 04H + DEFB 03H + DEFB 03H ;dummy +; + DEFB 00H ;emvp 6 + DEFB 05H + DEFB 04H + DEFB 00H +; + DEFB 0FH ;emvp 7 + DEFB 04H + DEFB 05H + DEFB 00H +; + DEFB 00H ;emvp 8 + DEFB 03H + DEFB 03H + DEFB 00H + + +;---------------------------------- +; +; frequency tabel +; +;---------------------------------- +NTBL: DEFW 3F00H ; A + DEFW 3B07H ; A# + DEFW 3802H ; B +; +; octave 1 +; + DEFW 340FH ; C + DEFW 3200H ; C# + DEFW 2F03H ; D + DEFW 2C09H ; D# + DEFW 2A01H ; E + DEFW 270BH ; F + DEFW 2507H ; F# + DEFW 2306H ; G + DEFW 2106H ; G# + DEFW 1F08H ; A + DEFW 1D0CH ; A# + DEFW 1C01H ; B +; +; octave 2 +; + DEFW 1A08H ; C + DEFW 1900H ; C# + DEFW 1709H ; D + DEFW 1604H ; D# + DEFW 1500H ; E + DEFW 130DH ; F + DEFW 120CH ; F# + DEFW 110BH ; G + DEFW 100BH ; G# + DEFW 0F0CH ; A + DEFW 0E0EH ; A# + DEFW 0E00H ; B +; +; octave 3 +; + DEFW 0D04H ; C + DEFW 0C08H ; C# + DEFW 0B0DH ; D + DEFW 0B02H ; D# + DEFW 0A08H ; E + DEFW 090FH ; F + DEFW 0906H ; F# + DEFW 080DH ; G + DEFW 0805H ; G# + DEFW 070EH ; A + DEFW 0707H ; A# + DEFW 0700H ; B +; +; octave 4 +; + DEFW 060AH ; C + DEFW 0604H ; C# + DEFW 050EH ; D + DEFW 0509H ; D# + DEFW 0504H ; E + DEFW 040FH ; F + DEFW 040BH ; F# + DEFW 0407H ; G + DEFW 0403H ; G# + DEFW 030FH ; A + DEFW 030BH ; A# + DEFW 0308H ; B +; +; octave 5 +; + DEFW 0305H ; C + DEFW 0302H ; C# + DEFW 020FH ; D + DEFW 020DH ; D# + DEFW 020AH ; E + DEFW 0208H ; F + DEFW 0205H ; F# + DEFW 0203H ; G + DEFW 0201H ; G# + DEFW 010FH ; A + DEFW 010EH ; A# + DEFW 010CH ; B +; +; octave 6 +; + DEFW 010AH ; C + DEFW 0109H ; C# + DEFW 0108H ; D + DEFW 0106H ; D# + DEFW 0105H ; E + DEFW 0104H ; F + DEFW 0103H ; F# + DEFW 0102H ; G + DEFW 0101H ; G# + DEFW 0100H ; A + DEFW 000FH ; A# + DEFW 000EH ; B +; +; +; +MSTBL: DEFW 0BF9FH + DEFW 0FFDFH +; +; +; +TSOUT: DEFB 80H ;ch 0 + DEFB 00H + DEFB 90H ;att +TSOUTC: DEFB 00H ;counter(l) + DEFB 00H ;counter(h) + + +;---------------------------------- +; +; +; Music interrupt routine +; +; +;---------------------------------- +PSGINT: + PUSH IY + CALL INT0 + POP IY + EI + RETI +; +INT0: CALL PUSHRA + CALL MSTART ;8253 intialize +; + LD A,(INTM) + OR A + JP Z,MSTOP0 + DEC A + JP NZ,SDINT ;skip if sound out +; + LD BC,PSG9 ;psg data out + LD HL,STBL + OTIR +; + IF SYS + LD B,9 + INC C + OTIR + ENDIF +; + LD B,8 + LD A,(SBUSY) + OR A + JP Z,MSTOP0 ;channel all close + LD C,A +INT1: DEC B + RET M + RLC C + JR NC,INT1 + PUSH BC + LD A,B + CALL INTER + BIT 0,(IY+13) + CALL Z,NINT + CALL MINT + POP BC + JR INT1 + + +;---------------------------------- +; +; Emvelop control +; +;---------------------------------- +NINT: DEC (HL) ;HL=chx act0 + RET NZ + INC HL ;new couter set + LD A,(HL) ;load atc1 + DEC HL + LD (HL),A ;save atc0 + INC HL + INC HL + LD E,(HL) ;HL=enva + INC HL + LD D,(HL) ;HL=enva+1 + EX DE,HL +NINT1: LD A,(HL) ;env ÀÙÛÛÙ data + OR A ;data check 0 + JR NZ,NINT2 ;noskip if repeat + DEC HL + DEC HL + JR NINT1 +; +; +NINT2: EX DE,HL ;de=curent emva + INC HL + DEC A + JR Z,NINT3 ;skip if max Acc=1 + DEC A + JR Z,NINT5 ;skip if min Acc=2 + DEC A + RET Z ;ÀÙÛÛÙ 0 Acc=3 +; + DEC A ;Acc=4 + LD A,(HL) ;att data + JR Z,NINT4 ;skip if dec att + INC A ;Acc=5 + CP 15 ;max + JR Z,NINT7 + JR C,NINT7 +NINT3: LD A,15 ;maximam + JR NINT6 +NINT4: DEC A ;dec att + JP M,NINT5 + LD C,(IY+14) ;vol minimum + CP C + JR NC,NINT7 +NINT5: LD A,(IY+14) ;minimum +NINT6: INC DE ;de=next curent emva +NINT7: LD (HL),A ;new att data + DEC HL + LD (HL),D + DEC HL + LD (HL),E +; +ATTSET: AND 0FH + LD B,A ;acc=att data +ATTS1: LD A,(IX+2) ;stbl att + AND 0F0H + OR B + LD (IX+2),A ;stbl att + RET + + +;---------------------------------- +; +; new data interpret routine +; +;---------------------------------- +; +MINT: DEC (IY+6) ;length0 + RET NZ + DEC (IY+7) ;tempo0 + LD A,(IY+8) ;length1 + LD (IY+6),A ;length counter preset + RET NZ + LD A,(IY+9) ;tempo1 + LD (IY+7),A ;tempo counter preset + LD E,(IY+10) ;que addr(l) + LD D,(IY+11) ;que addr(h) +; +; +MINT1: LD A,(DE) + INC DE + CP 0FFH + JR Z,MINT2 + CP 0A0H + JR Z,MINT3 + CP 90H + JR NC,MINT4 + CP 80H + JR NC,MINT5 + CP 60H + JR NC,MINT6 + SUB 9 + LD (IY+10),E ;que addr (l) + LD (IY+11),D ;que addr (h) + SET 0,(IY+13) ;rflag set + JR C,MINT7 + RES 0,(IY+13) ;rflag reset + CALL SETNO ;Nn +MINT7: LD A,(IY+2) ;att + LD (IY+1),A + LD A,(IY+8) ;length + LD (IY+6),A + LD A,(IY+9) ;tempo + LD (IY+7),A + BIT 0,(IY+13) + JR NZ,MEND +; +; + LD A,(IY+12) ;emv pattern + LD BC,ETBL + ADD A,A ;*2 + ADD A,A ;*4 + LD H,0 + LD L,A + ADD HL,BC ;HL=ETBL+4*A + LD A,(HL) + OR A + JR NZ,MINT71 + LD A,(IY+14) ;vol minimum +MINT71: LD (IY+5),A ;att + CALL ATTSET + INC HL + LD (IY+3),L ;emva (l) + LD (IY+4),H ;emva (h) + RET +; +; +; +MINT3: LD A,(DE) ;Mn + INC DE + LD (IY+2),A ;atc1 +MINT11: JR MINT1 +; +MINT2: CALL BRESET ;channel reset +MEND: LD A,0FH + JP ATTSET +; +; +MINT4: SUB 90H ;Sn + LD (IY+12),A ;curent emv no. + JR MINT11 +; +; +MINT5: SUB 80H ;Vn + CPL + AND 0FH + LD (IY+14),A ;vol minimum + JR MINT11 +; +; +; tempo & length +; +; +MINT6: SUB 60H ;Tn,Ln + LD B,0 + LD C,A + LD HL,LTBL + ADD HL,BC + CP 0AH + LD A,(HL) + JR NC,MINT61 + LD (IY+8),A ;length1 + JR MINT11 +MINT61: LD (IY+9),A ;tempo1 + JR MINT11 + + +;-------------------------------- +; +; +; onpu set +; +; acc = onpu map data +; ix = set mout tbladdr +;-------------------------------- +; +SETNO: ADD A,A ;*2 + LD HL,NTBL + LD B,0 + LD C,A + ADD HL,BC + LD B,(HL) + LD A,(IX+0) + AND 0F0H + OR B + LD (IX+0),A + INC HL + LD A,(HL) + LD (IX+1),A + RET +;---------------------------------- +; +; SOUND=(reg,data) +; +; ent A.... reg+80H +; DE... data +; +; +; SOUND n,time +; +; ent A.... n +; DE... time +; +;---------------------------------- +; +MSOUND: + OR A + JP P,SOUT + AND 0FH + LD C,PSGA ;psg-a +; + IF SYS +; + CP 8 + JR C,$+5 + SUB 8 + INC C ;C=psg sel, A=reg#. +; + ENDIF +; + ADD A,A + ADD A,A + ADD A,A + ADD A,A + OR 80H + LD B,A ;B = 1rrr0000 +; + BIT 4,A + JR NZ,MSND_A ;att + CP 0E0H + JR Z,MSND_N ;noise ctrl + LD A,D ;freq + CP 04H + JR NC,MER3 + LD A,E + AND 0FH + OR B ;1rrrffff + OUT (C),A + LD A,D + LD B,4 + RL E + RLA + DJNZ $-3 + OUT (C),A ;0fffffff + RET +; +MSND_N: BIT 3,E + JR NZ,MER3 +MSND_A: LD A,E + AND 0F0H + OR D + JR NZ,MER3 + LD A,E + OR B + OUT (C),A ;1rrrcccc + RET +; +MER3: JP ER03 +; +;-------------------------------- +; +; sout +; +;-------------------------------- +; +SDINT: LD HL,(TSOUTC) + DEC HL + LD (TSOUTC),HL + LD A,L + OR H + RET NZ + JP MSTOP0 +; +; +; SOUND n,l +; +; +SOUT: + LD C,A + LD A,D + OR E + RET Z + LD A,C +; + LD IX,TSOUT + CP NMAX+1 + RET NC + SUB 9 + PUSH AF + LD A,90H + JR NC,SOUT1 + LD A,9FH +SOUT1: LD (IX+2),A ;TSOUT att + CALL MWAIT0 + POP AF + CALL NC,SETNO ;skip if not rest + DI + LD A,2 + LD (INTM),A + LD (TSOUTC),DE + LD HL,TSOUT + LD BC,PSG3 ;psg-a out + OTIR + CALL MSTART + EI + RET +; +;-------------------------------- +; +; Interpret point set +; +; +; in Acc=channel +; +; exit ix:stbl +; iy:ptbl +; hl:ptbl+1 +; +;---------------------------------- +INTER: PUSH BC + PUSH AF + CP 3 + JR C,INTER1 + DEC A +; + IF SYS + CP 6 + JR NZ,INTER1 + DEC A + ENDIF +; +INTER1: LD HL,STBL + LD B,A + ADD A,A ;*2 + ADD A,B ;*3 + LD C,A + LD B,0 + ADD HL,BC + PUSH HL + POP IX +; + POP AF + ADD A,A ;*2 + ADD A,A ;*4 + ADD A,A ;*8 + ADD A,A ;*16 + LD HL,PTBL + LD B,0 + LD C,A + ADD HL,BC + PUSH HL + POP IY + INC HL + POP BC + RET + + +;-------------------------------- +; +; play,noise +; +;-------------------------------- +; +; +PLAY: + CP 0FFH + JR NZ,PLY0 + LD A,MAXCH-1 +PLYALL: PUSH AF + PUSH DE + CALL PLY0 + POP DE + POP AF + DEC A + JP M,PSGON + JR PLYALL +; +PLY0: PUSH AF + LD HL,STN0 + IF SYS + CP 4 + JR C,PLY00 + LD HL,STN1 + ENDIF +; +PLY00: CP 3 + JR Z,PLY1 +; + IF SYS + CP 7 + JR Z,PLY1 + ENDIF +; + LD A,0DFH + JR PLY2 +; +PLY1: LD A,0E7H ;noise channel out + OUT (PSGALL),A + LD A,0FFH +PLY2: LD (HL),A ;STN0 or STN1 + DI + LD A,1 + LD (INTM),A + POP AF + CALL INTER + CALL BSET + CALL MINT1 + EI + RET +; +; +PSGON: + DI + LD A,(INTM) + OR A + CALL NZ,MSTART + EI + RET +; +BRESET: LD B,86H + JR BSET0 +; +BSET: LD B,0C6H +BSET0: LD HL,SBUSY + LD A,(IY+0) + OR A + RLCA + RLCA + RLCA ;00xxx000 + OR B ;10xxx110 or 11xxx110 + LD (BSET1),A + DEFB 0CBH ;SET n,(HL) or reset +BSET1: DEFB 0 + RET + + +;---------------------------------- +; +; sft+break or error or music stop +; +;---------------------------------- +; +MLDSP: +MSTOP: + CALL PUSHR +; +MSTOP0: XOR A + LD (INTM),A + LD (SBUSY),A +; + LD BC,PSGOFF + LD HL,MSTBL + OTIR + LD B,MUSCH + LD HL,STBL+2 +MSTOP1: LD A,(HL) + AND 0F0H + OR 0FH + LD (HL),A + INC HL + INC HL + INC HL + DJNZ MSTOP1 + LD A,3 + OUT (0FCH),A ;pio disenable + XOR A + + IF SYS + LD HL,0E008H ;mz-700 compatible mode + JP LDHLA ;8253 gate disable + ELSE + RET ;8253 gate no effect + ENDIF +; +; +;---------------------------------- +; +; music wait +; +;---------------------------------- +; +MWAIT: +; +MWAIT0: LD A,(INTM) + OR A + RET Z +MWAIT1: + RST 3 + DEFB _BREAK + JR NZ,MWAIT + JP BREAKZ + + +;---------------------------------- +; SVC .MCTRL ; music control +; B=0: init +; B=1: psgon +; B=2: stop +; B=3: wait +;---------------------------------- +; +MCTRL: + DEC B + JP Z,PSGON + DEC B + JR Z,MSTOP ;1 + DEC B + JR Z,MWAIT0 ;2 +;---------------------------------- +; +; PSG power on init +; +; +;---------------------------------- +PSGPWR: + CALL MSTOP + LD BC,5FCH + LD HL,PIOTBL + OTIR + LD DE,MUINID + LD A,0FFH + JP PLAY +; +; + IF SYS +PIOTBL: DEFB 0FCH ;Vector + DEFB 0FFH ;mode 3 (bit mode) + DEFB 3FH ;I/O + DEFB 37H ;interrupt control + DEFB 0EFH ;interrupt mask +; +; +MSTART: OUT (0E3H),A + LD A,30H + LD HL,0E007H + LD (HL),A ;8253 control + LD BC,22A5H ;10ms =22F6H + LD L,4 ;HL=E004H + LD (HL),C ;8253 time const + LD (HL),B + DEC HL ;HL=E003H + LD (HL),4 ;8253 int disable + LD (HL),0 ;8253 music disable + LD A,01H + LD L,8 ;HL=E008H + LD (HL),A ;8253 gate enable + LD A,83H + OUT (0FCH),A ;pio int enable + OUT (0E1H),A + RET + + ELSE + +MSTART: + LD HL,PIOTBL + LD BC,5FCH + OTIR + LD HL,CTCTBL + LD B,6 + JP IOOUT +; +; +PIOTBL: DEFB 0FCH ;Vector + DEFB 0FFH ;mode 3 (bit mode) + DEFB 3FH ;I/O + DEFB 17H ;interrupt control + DEFB 0EFH ;interrupt mask +; +CTCTBL: DEFW 0D730H + DEFW 0D4B0H ;10 ms =2B4CH + DEFW 0D42AH + DEFW 0D304H + DEFW 0D300H + DEFW 0FC83H + ENDIF +; +MUINID: DEFB 65H ;L5 + DEFB 6DH ;T4 + DEFB 98H ;S8 + DEFW 0FFA0H ;M255 + DEFB 0FFH ;END + IF SYS +;---------------------------------- +; +; +; BELL (BEEP) use 8253 +;---------------------------------- +CTRLG: + CALL PUSHR + LD (CTRLG9+1),SP + RST 3 + DEFB _DI + LD SP,IBUFE + OUT (0E4H),A ;K/C mapping + CALL 02BEH ;ROM MLDSP + LD A,1 + LD DE,E003H + LD (DE),A ;8253 music gate on + LD HL,03F9H + CALL 02AEH ;ROM MLDST+3 + LD BC,18H + EX (SP),HL ;wait + DJNZ $-1 + DEC C + JR NZ,$-4 + CALL 02BEH ;ROM MLDSP + XOR A + LD (DE),A ;8253 music gate off + OUT (0E0H),A ;K/C mapping + OUT (0E1H),A + RST 3 + DEFB _EI +CTRLG9: LD SP,0 ;xxx + RET + +; + ELSE +; + +CTRLG: + CALL PUSHR + RST 3 + DEFB _DI + LD HL,BEEP0 + LD B,4 + CALL IOOUT + LD BC,18H + EX (SP),HL + DJNZ $-1 + DEC C + JR NZ,$-4 + LD HL,BEEP1 + LD B,2 + CALL IOOUT + RST 3 + DEFB _EI + RET +; +; +BEEP0: + DEFW 0D736H + DEFW 0D301H + DEFW 0D4F9H + DEFW 0D403H +; +BEEP1: + DEFW 0D736H + DEFW 0D300H + +;-------------------------------- +; +; tempo set +; acc=1-7 +;-------------------------------- +_TEMP: + CALL PUSHRA + LD DE,TEMPOW + AND 0FH + ADD A,69H + LD (DE),A + LD B,3 + RST 3 + DEFB _MCTRL ;MWAIT + LD A,0FFH ;Channel all + RST 3 + DEFB _PLAY + LD B,1 + RST 3 + DEFB _MCTRL ;PSGON + RET +; +TEMPOW: DEFS 1 + DEFB 0FFH +; + ENDIF + +; END (453A) + + + + +; ORG 453AH + + +; ------------------------------- +; MZ-800 Monitor Graphic-package +; FI:MON-GRPH ver 1.0A 9.05.84 +; +; ------------------------------- +; +; + +defc KEYBF = 11A4H ;KEYBUF label +;------------------------------- +; +; INIT "CRT: +; +;------------------------------- +CRTINI: + CALL TEST1 + DEFB 'M' ; mandatory prefix, it stands for "MODE" + JR Z,CRMD + OR A + JR Z,ICRT + CP 'B' + JP NZ,ER03 +;------------------------------- +; +; CRT palette block +; +;------------------------------- +; +PBLOCK: XOR A + LD (PALBK),A + LD A,(CRTMD2) + CP 2 + JP NZ,ER68 + INC HL + LD B,4 + CALL DEVASC + LD (PALBK),A + RST 3 + DEFB _DPLBK + JR CRTLP +; +;--------------------------------- +; +; CRT mode +; +; 1.....320x200 4 Color +; 2.....320x200 16 Color +; 3.....640x200 2 Color +; 4.....640x200 4 Color +; +;--------------------------------- +; +CRMD: LD B,5 + CALL DEVASC + OR A + JR Z,ER3JP + LD B,A + RST 3 + DEFB _DSMOD + JP C,ER68 + LD A,B + LD (CRTMD2),A + XOR A + LD (INPFLG),A + SCF + ADC A,A + DJNZ $-1 + LD (CRTMD1),A + CALL ICRT2 +; +CRTLP: + CALL TEST1 + DEFB 0 + RET Z + CP ',' + INC HL + JR Z,CRTINI +ER3JP: JP ER03 +; +ICRT: + LD A,(CRTMD2) + RST 3 + DEFB _DSMOD +ICRT2: CALL COLINI + XOR A + LD (PALBK),A + RST 3 + DEFB _DPLBK + RET +; +COLINI: LD A,(CRTMD1) + LD B,3 + RRA + JR C,CI1 + LD B,15 + RRA + JR C,CI1 + LD B,1 + RRA + JR C,CI1 + LD B,3 +CI1: LD A,B + LD (SELCOL),A + RST 3 + DEFB _DCOL + RET + + +;------------------------ +; +; +; BYTE CONVERT TABLE +; +;----------------------- +TDOTL: + DEFB 0FFH + DEFB 0FEH + DEFB 0FCH + DEFB 0F8H + DEFB 0F0H + DEFB 0E0H + DEFB 0C0H + DEFB 80H +; +TDOTR: + DEFB 01H + DEFB 03H + DEFB 07H + DEFB 0FH + DEFB 1FH + DEFB 3FH + DEFB 7FH + DEFB 0FFH +; +TDOTN: + DEFB 01H + DEFB 02H + DEFB 04H + DEFB 08H + DEFB 10H + DEFB 20H + DEFB 40H + DEFB 80H +;------------------------------- +; +; // 64 - 32 TRANS // +; +;------------------------------- +; +CHGRPH: + LD BC,703H + LD HL,CHGTBL + JP PATCH +; +; +CHGTBL: +; word patch table +; + DEFW SYMS42+1 + DEFW 0BE80H + DEFW 9F40H +; + DEFW RNGCK0+1 + DEFW -640 + DEFW -320 +; + DEFW LRBSR + DEFW 640 + DEFW 320 +; + DEFW BFL0+1 + DEFW 80 + DEFW 40 +; + DEFW BFL1+1 + DEFW 80 + DEFW 40 +; + DEFW BFC0+1 + DEFW -640 + DEFW -320 +; + DEFW BFC1+1 + DEFW 639 + DEFW 319 +; +; byte patch table +; + DEFW ADCH ;adrs + DEFB 29H ;640 ADD HL,HL + DEFB 00H ;320 +; + DEFW SYMS21+1 + DEFB 80 + DEFB 40 +; + DEFW SYMS41+1 + DEFB 80 + DEFB 40 +; + + +;---------------------------------- +; +; address calc +; +; +; ent. de=x (0-13FH,27FH) +; hl=y (0-C7H) +; +; ext. hl=vram addr +; a=vram bit +; c=de/8 +;---------------------------------- +ADCH: ADD HL,HL ;NOP + LD A,E + AND 7 + LD B,A +; + LD A,E + AND 0F8H + ADD A,D + RRCA + RRCA + RRCA + LD C,A + LD A,B + LD B,80H ;vramh + LD D,H + LD E,L + ADD HL,HL + ADD HL,HL + ADD HL,DE + ADD HL,HL + ADD HL,HL + ADD HL,HL ;HL=HL*40 + ADD HL,BC + RET +;----------------------------- +; +; READ POINT +; +; Ent:DE=X (0-13FH,27EH) +; HL=Y (0-C7H) +; +;----------------------------- +WPOINT: + CALL RNGCK + JP C,OVER + CALL ADCH +; + RLCA + RLCA + RLCA + OR 46H + LD (PNT2+1),A + LD C,LSRF + LD A,(MAXCF) + LD B,A +; + DI + IN A,(LSE0) + XOR A +PNT1: RR B + JR C,PNT4 + OUT (C),B + OR A +PNT2: BIT 0,(HL) ;bit n,(hl) + JR Z,PNT3 + SCF +PNT3: RLA + JR PNT1 +; +PNT4: LD B,A + IN A,(LSE1) + EI + LD A,(CPLANE) + AND B + LD B,A + LD A,(DMD) + CP 6 + LD A,B + RET NZ +; + CP 4 + RET C +; + SUB 2 + RET + + +;--------------------------------- +; +; +; MODE SET (PWMODE,GMODE) +; +; ent. A= 0 RESET +; A<>0 SET +;--------------------------------- +SETW: LD A,0FFH +MODSET: PUSH BC + OR A + LD A,(GMODE) + LD C,A + LD A,(PWMODE) + JR Z,_RESET +; +_SET: OR A + LD A,0C0H ;w0 pset + JR Z,SET1 + LD A,40H ;w1 or +; +SET1: OR C + OUT (LSWF),A ;Write mode set + POP BC + RET +; +; +_RESET: OR A + LD A,60H ;w1 reset + JR NZ,SET1 +; + LD A,(CPLANE) + LD B,A + LD A,C ;reverse color + CPL + AND B ;mask color + OR 0C0H ;w0 pset mode + OUT (LSWF),A ;Write mode set + POP BC + RET + + +;----------------------------- +; +; Point Write/Erase +; +; Ent:DE=X (0-13FH,27EH) +; HL=Y (0-C7H) +; +;----------------------------- +PSET: + CALL MODSET +PSET0: CALL RNGCK + JP C,OVER + CALL ADCH + EX DE,HL + LD HL,TDOTN + LD B,0 + LD C,A + ADD HL,BC + DI + IN A,(LSE0) + LDI + IN A,(LSE1) + EI + XOR A + RET +; +; +;-------------------------------- +; +; RANGE CHECK +; +; Ent:DE=X (0-13FH,27EH) +; HL=Y (0-C7H) +; +; ext:if over then CF=1 +; +;-------------------------------- +RNGCK: + PUSH BC + PUSH DE + PUSH HL + LD A,H + RLCA + JR C,RNGER +; + LD BC,-200 + ADD HL,BC + JR C,RNGER +; + LD A,D + RLCA + JR C,RNGER +; + EX DE,HL +RNGCK0: LD BC,-640 ;-320 + ADD HL,BC +RNGER: POP HL + POP DE + POP BC + RET +; +; + + +;------------------------------ +; +; Draw line +; +; ent DE':X0, DE:X +; HL':Y0, HL:Y +; A := 0 BLINE +; <>0 LINE +; +; ext DE':X +; HL':Y +;------------------------------- +; +; +defc X0 = KEYBF ;2 +defc DX = X0+2 ;2 +defc XDIRE = DX+2 ;1 +defc Y0 = XDIRE+1 ;2 +defc DY = Y0+2 ;2 +defc YDIRE = DY+2 ;1 +; +; +WLINE0: LD A,0FFH +WLINE: + CALL MODSET + PUSH DE + PUSH HL + EXX + LD (X0),DE + LD (Y0),HL + EXX + PUSH HL ;y + PUSH DE ;x + EX DE,HL + LD HL,(Y0) + CALL PLS + LD (YDIRE),A + LD (DY),HL + POP DE ;x + JP NC,WYLIN ;skip if y=y0 + PUSH HL ;dy + LD HL,(X0) + CALL PLS + LD (XDIRE),A + LD (DX),HL + POP BC ;dy + POP DE ;y + JP NC,WTLIN ;skip if x=x0 + XOR A + SBC HL,BC + JR NC,WLIN04 ;skip if dx>dy + LD HL,X0 ;parameter change + LD DE,Y0 + LD B,5 +WLIN02: LD A,(DE) + LD C,(HL) + LD (HL),A + LD A,C + LD (DE),A + INC HL + INC DE + DJNZ WLIN02 +; + LD A,0EBH ;ex de,hl +WLIN04: LD (PLOT0),A + LD (PLOT1),A + LD A,(YDIRE) + AND A + LD A,23H ;inc hl + JR Z,DIRE1 + LD A,2BH ;dec hl +DIRE1: LD (PP2),A +; + LD A,(XDIRE) + AND A + LD A,13H ;inc de + JR Z,DIRE2 + LD A,1BH ;dec de +DIRE2: LD (PP1),A +; + EXX + LD HL,(DX) ;initial parm set + LD D,H + LD E,L + SRL H + RR L + LD BC,(DY) + EXX +; + LD HL,(Y0) ;first point set + LD DE,(X0) + LD BC,(DX) +; +PLOT0: EX DE,HL ;nop + PUSH HL + PUSH DE + PUSH BC + CALL PSET0 + POP BC + POP DE + POP HL +PLOT1: EX DE,HL ;nop +; +; + DEC BC + LD A,B + INC A + JR Z,FINW ;skip if end of line +; +; pointer calc . +; +PP1: DEFS 1 ;inc de/dec de + EXX + OR A + SBC HL,BC + EXX + JP NC,PLOT0 + EXX + ADD HL,DE + EXX +PP2: DEFS 1 ;inc hl/dec hl + JP PLOT0 +; +; +FINW: EXX + POP HL + POP DE + EXX + RET +; +WYLIN: POP HL ;Y +WYLIN0: CALL WBOXSB + CALL WBOXSB + CALL YLINE + JR FINW +; +WTLIN: EX DE,HL + LD DE,(X0) + JR WYLIN0 +; +; +; +PLS: LD A,H + ADD A,40H + LD H,A + LD A,D + ADD A,40H + LD D,A +; + OR A + SBC HL,DE + JR C,PLS1 + LD A,H + OR L + RET Z +OVER: LD A,0FFH + SCF + RET +; +PLS1: OR A + EX DE,HL + LD HL,0 + SBC HL,DE + XOR A + SCF + RET + + +;------------------------- +; +; +; Write sector +; +;------------------------- +; +WSECTR: CALL WSPUT + LD HL,(POINTX) + PUSH HL + PUSH BC ;POINTY + EXX + CALL WSPUT + LD B,2 + JP WBOX2 +; +WSPUT: POP IX ;Ret adrs + EX DE,HL + CP 2 + CALL Z,WSCTRH + LD BC,(POINTX) + ADD HL,BC + PUSH HL ;X + EX DE,HL + CP 1 + CALL Z,WSCTRH + LD BC,(POINTY) + ADD HL,BC + PUSH HL ;Y + JP (IX) +; +WSCTRH: BIT 7,H + JP Z,HIRITU + CALL WSCTRV + CALL HIRITU +WSCTRV: + EX AF,AF + CALL NEGHL + EX AF,AF + RET + + +; +;----------------------------- +; +; Circle Write +; ent DE:End X DE':Start X +; HL:End Y HL':Start Y +; IX:R BC':Hiritu +; A:Angle flag +; if CF then sector +; +; uses KEYBUF +;----------------------------- +WCIRCL: + PUSH AF + CALL SETW ;set pwmode + POP AF + PUSH AF + LD (CIR3+1),IX ;R + LD (SYUX),DE + LD (SYUY),HL + EXX + LD (CIR_HF),BC + LD (KAIX),DE + LD (KAIY),HL + LD A,C ;CIR_HF + CALL C,WSECTR + LD HL,(KAIX) + LD DE,(KAIY) +;Å BLOCK NO."Ù\Ü/BL \ÄÙ + CALL BLCKRU + LD (KBL),A + LD HL,(SYUX) + LD DE,(SYUY) +;Å BLOCK NO."Ù\Ü/SBL \mÄÙ + CALL BLCKRU + LD (SBL),A +; + LD HL,CIR_BK + LD B,8 + CALL CLRHL + LD HL,KBL + POP AF + LD B,A + AND 0FH + JR Z,CIR4 ;KK=SK + CP 3 + JR Z,CIR15 ;2PI <= ABS(KK-SK) + LD A,(HL) + INC HL + CP (HL) + JR NZ,CIR4 + LD A,B + CP 81H + JR Z,CIR4 + JR CIR14 +; +CIR15: LD A,9 + LD (HL),A + INC HL + LD (HL),A +CIR14: LD B,8 + LD HL,CIR_BK + INC A + CALL SETHL + LD A,0B0H ;OR B + CALL CHENGE + JR CIR3 +; +CIR4: LD A,0A0H ;AND B + CALL CHENGE + LD D,00H + LD HL,(KBL) + LD B,H + LD A,L +CIR2: LD HL,CIR_BK-1 + LD E,A + ADD HL,DE + LD (HL),1 + CP B ;\s\ÛÛÚjlÄ \mÛÛÚjli Ã\l + JR Z,CIR3 + AND 7 + INC A + JR CIR2 +CIR3: LD HL,0 ;;;R + LD (DYY),HL + LD (XX),HL + LD HL,1 + LD (CI_D),HL + LD (YY),HL +CIR7: LD HL,(DYY) + LD DE,(CI_D) + XOR A + SBC HL,DE + LD (DYY),HL +; + LD HL,(YY) + DEC HL + LD (CYE),HL + LD A,(CIR_HF) + OR A + LD DE,HL + CALL NZ,HIRITU + CP 1 + JR Z,$+3 + EX DE,HL + LD (YYY),DE + LD (YYHI),HL +; + LD HL,(XX) + OR A + LD DE,HL + CALL NZ,HIRITU + CP 1 + JR Z,$+3 + EX DE,HL + LD (XXX),DE + LD (XXHI),HL +; + LD HL,(XXX) + CALL NEGHL + LD (FUXX),HL ;FUXX = -XXX + LD HL,(YYY) + CALL NEGHL + LD (FUYE),HL ;FUYE = -YYY + LD HL,(YYHI) + CALL NEGHL + LD (FUYYHI),HL ;FUYYHI = -YYHI + LD HL,(XXHI) + CALL NEGHL + LD (FUXXHI),HL ;FUXXHI = -XXHI + LD HL,(CYE) + CALL NEGHL + LD (FUNOYE),HL ;FUNOYE = -YE +; + LD HL,CIR_BK + LD A,(HL) ;BLOCK NO.1 + OR A + INC HL + JR Z,P222 + EXX + LD HL,(XXX) + LD (PL1+1),HL + LD B,0 + LD DE,(FUNOYE) + BIT 7,D + JR Z,P12 + LD A,(KBL) + CP 1 + JR NZ,P11 + LD HL,(KAIY) + XOR A + SBC HL,DE + JR Z,P11 + JR C,P12 +P11: INC B +P12: LD A,(SBL) + CP 1 + JR NZ,P13 + LD HL,(SYUY) + XOR A + SBC HL,DE + JR Z,P13 + JR NC,P14 +P13: LD A,1 +P14: AND B + JR Z,P15 + LD HL,(FUYYHI) + CALL PLALL +P15: EXX +; +P222: LD A,(HL) ;BLOCK NO.2 + OR A + INC HL + JR Z,P3 + EXX + LD B,0 + LD HL,(YYY) + LD (PL1+1),HL + LD DE,(CYE) + LD A,(KBL) + CP 2 + JR NZ,P21 + LD HL,(KAIX) + XOR A + SBC HL,DE + JR Z,P21 + JR C,P22 +P21: INC B +P22: LD A,(SBL) + CP 2 + JR NZ,P23 + LD HL,(SYUX) + XOR A + SBC HL,DE + JR Z,P23 + JR NC,P24 +P23: LD A,1 +P24: AND B + JR Z,P25 + LD HL,(FUXXHI) + CALL PLALL +P25: EXX +; +P3: LD A,(HL) ;BLOCK NO.3 + OR A + INC HL + JR Z,P4 + EXX + LD B,0 + LD HL,(FUYE) + LD (PL1+1),HL + LD DE,(FUNOYE) + BIT 7,D + JR Z,P32 + LD A,(KBL) + CP 3 + JR NZ,P31 + LD HL,(KAIX) + XOR A + SBC HL,DE + JR Z,P31 + JR C,P32 +P31: INC B +P32: LD A,(SBL) + CP 3 + JR NZ,P33 + LD HL,(SYUX) + XOR A + SBC HL,DE + JR Z,P33 + JR NC,P34 +P33: LD A,1 +P34: AND B + JR Z,P35 + LD HL,(FUXXHI) + CALL PLALL +P35: EXX +; +P4: LD A,(HL) ;BLOCK NO.4 + OR A + INC HL + JR Z,P5 + EXX + LD B,0 + LD HL,(FUXX) + LD (PL1+1),HL + LD DE,(FUNOYE) + LD A,(KBL) + CP 4 + JR NZ,P41 + LD HL,(KAIY) + XOR A + SBC HL,DE + JR Z,P41 + JR NC,P42 +P41: INC B +P42: XOR A + BIT 7,D + JR Z,P44 + LD A,(SBL) + CP 4 + JR NZ,P43 + LD HL,(SYUY) + XOR A + SBC HL,DE + JR Z,P43 + JR C,P44 +P43: LD A,1 +P44: AND B + JR Z,P45 + LD HL,(FUYYHI) + CALL PLALL +P45: EXX +; +P5: LD A,(HL) ;BLOCK NO.5 + OR A + INC HL + JR Z,P6 + EXX + LD B,0 + LD HL,(FUXX) + LD (PL1+1),HL + LD DE,(CYE) + LD A,(KBL) + CP 5 + JR NZ,P51 + LD HL,(KAIY) + XOR A + SBC HL,DE + JR Z,P51 + JR NC,P52 +P51: INC B +P52: LD A,(SBL) + CP 5 + JR NZ,P53 + LD HL,(SYUY) + XOR A + SBC HL,DE + JR Z,P53 + JR C,P54 +P53: LD A,1 +P54: AND B + JR Z,P55 + LD HL,(YYHI) + CALL PLALL +P55: EXX +; +P6: LD A,(HL) ;BLOCK NO.6 + OR A + INC HL + JR Z,P7 + EXX + LD B,0 + LD HL,(FUYE) + LD (PL1+1),HL + LD DE,(FUNOYE) + LD A,(KBL) + CP 6 + JR NZ,P61 + LD HL,(KAIX) + XOR A + SBC HL,DE + JR Z,P61 + JR NC,P62 +P61: INC B +P62: XOR A + BIT 7,D + JR Z,P64 + LD A,(SBL) + CP 6 + JR NZ,P63 + LD HL,(SYUX) + XOR A + SBC HL,DE + JR Z,P63 + JR C,P64 +P63: LD A,1 +P64: AND B + JR Z,P65 + LD HL,(XXHI) + CALL PLALL +P65: EXX +; +P7: LD A,(HL) ;BLOCK NO.7 + OR A + INC HL + JR Z,P8 + EXX + LD HL,(YYY) + LD (PL1+1),HL + LD DE,(CYE) + LD B,0 + LD A,(KBL) + CP 7 + JR NZ,P71 + LD HL,(KAIX) + XOR A + SBC HL,DE + JR Z,P71 + JR NC,P72 +P71: INC B +P72: LD A,(SBL) + CP 7 + JR NZ,P73 + LD HL,(SYUX) + XOR A + SBC HL,DE + JR Z,P73 + JR C,P74 +P73: LD A,1 +P74: AND B + JR Z,P75 + LD HL,(XXHI) + CALL PLALL +P75: EXX +; +P8: LD A,(HL) ;BLOCK NO.8 + OR A + INC HL + JR Z,_PE + EXX + LD HL,(XXX) + LD (PL1+1),HL + LD DE,(CYE) + LD B,0 + LD A,(KBL) + CP 8 + JR NZ,P81 + LD HL,(KAIY) + XOR A + SBC HL,DE + JR Z,P81 + JR C,P82 +P81: INC B +P82: LD A,(SBL) + CP 8 + JR NZ,P83 + LD HL,(SYUY) + XOR A + SBC HL,DE + JR Z,P83 + JR NC,P84 +P83: LD A,1 +P84: AND B + JR Z,P85 + LD HL,(YYHI) + CALL PLALL +P85: EXX +; +_PE: LD HL,(DYY) ;Zs"Ù\o + BIT 7,H + JR Z,CIR10 + LD DE,(YY) + LD HL,(XX) + DEC HL + LD (XX),HL + BIT 7,H + RET NZ + XOR A + SBC HL,DE + RET C + LD HL,(XX) + ADD HL,HL + LD DE,(DYY) + ADD HL,DE + LD (DYY),HL +CIR10: LD HL,(YY) + INC HL + LD (YY),HL + LD HL,(CI_D) + INC HL + INC HL + LD (CI_D),HL + JP CIR7 +; +;CIRCLE "ÛÛÜ-ÞÙ +; +;BLOCK NUMBER ZÙ\Ü "ÛÛÜ-ÞÙ +BLCKRU: PUSH HL + PUSH DE + CALL ABSHL + EX DE,HL + CALL ABSHL + EX DE,HL + OR A + SBC HL,DE + POP DE + POP HL + JR C,BLCK1 + BIT 7,H + JR NZ,BLCK2 + BIT 7,D + LD A,8 + RET Z + LD A,1 + RET +BLCK2: BIT 7,D + LD A,5 + RET Z + LD A,4 + RET +BLCK1: BIT 7,H + JR NZ,BLCK5 + BIT 7,D + LD A,7 + RET Z + LD A,2 + RET +BLCK5: BIT 7,D + LD A,6 + RET Z + LD A,3 + RET +; +ABSHL: BIT 7,H + RET Z +NEGHL: LD A,H + CPL + LD H,A + LD A,L + CPL + LD L,A + INC HL + RET +; +;PLOT Ü-ÞÙ +PLALL: LD DE,(POINTY) + ADD HL,DE + LD DE,65336 + LD B,H + LD C,L + ADD HL,DE + RET C +PL1: LD HL,0000H ;LKD HL,XXXXH + LD DE,(POINTX) + ADD HL,DE + EX DE,HL + LD HL,64896 + ADD HL,DE + RET C + LD H,B + LD L,C + JP PSET0 +; +; +;ÃßÜ Zs"Ù Ü-ÞÙ +HIRITU: + PUSH AF + PUSH DE + LD B,8 + LD C,L + LD E,H + XOR A + LD D,A + LD H,A + LD L,A + EX AF,AF + LD A,(CIR_HD) +HR1: RRA + JR NC,HR2 + ADD HL,DE + EX AF,AF + ADD A,C + JR NC,HR3 + INC HL +HR3: EX AF,AF +HR2: SLA C + RL E + RL D + DJNZ HR1 + EX AF,AF + BIT 7,A + JR Z,$+3 + INC HL + POP DE + POP AF + RET +; +CHENGE: LD (P14),A + LD (P24),A + LD (P34),A + LD (P44),A + LD (P54),A + LD (P64),A + LD (P74),A + LD (P84),A + RET +; +; work area +; +defc CI_D = KEYBF ;2 +defc DYY = CI_D+2 ;2 +defc XX = DYY+2 ;2 +defc YY = XX+2 ;2 +defc CYE = YY+2 ;2 +defc KBL = CYE+2 ;1 \ÄÙÛ BLOCK NO. +defc SBL = KBL+1 ;1 \mÄÙÛ BLOCK NO. +; +; +defc FUYE = SBL+1 ;2 +defc FUXX = FUYE+2 ;2 +defc FUYYHI = FUXX+2 ;2 +defc FUXXHI = FUYYHI+2 ;2 +; +defc FUNOYE = FUXXHI+2 ;2 +; +defc CIR_BK = FUNOYE+2 ;9 Block data +; +; +defc KAIX = CIR_BK+9 ;2 \ÄÙ X +defc KAIY = KAIX+2 ;2 \ÄÙ Y +defc SYUX = KAIY+2 ;2 \mÄÙ X +defc SYUY = SYUX+2 ;2 \mÄÙ Y +defc XXHI = SYUY+2 ;2 XXÛ ÃßÜ DATA +defc YYHI = XXHI+2 ;2 YEÛ ÃßÜ DATA +; +defc XXX = YYHI+2 ;2 +defc YYY = XXX+2 ;2 +; +defc CIR_HF = YYY+2 ;1 +defc CIR_HD = CIR_HF+1 ;1 +; + + +; ---------------------------- +; +; Box Write +; ext DE':xs, DE:xe +; HL':ys, HL:ye +; +; if CF then A:fill color +; +; ---------------------------- +defc LSTA = KEYBF +defc RSTA = LSTA+2 +defc SPBOX = RSTA+2 +; +WBOX: + LD (SPBOX),SP + EX AF,AF + CALL WBOXSB + CALL WBOXSB + EXX + PUSH DE ;XS Upper + PUSH HL ;YS + PUSH DE ;XS Lower + EXX + PUSH HL ;YE + PUSH DE ;XE Lower + PUSH HL ;YE + PUSH DE ;XE Upper + EXX + PUSH HL ;YS + PUSH DE ;XS Upper Left + PUSH HL ;YS + EXX + EX AF,AF + CALL C,BOXF ;Box fill + LD B,4 +WBOX2: EXX + POP HL + POP DE + EXX +WBOX4: POP HL + POP DE + PUSH BC + CALL WLINE0 ;Box bound + POP BC + DJNZ WBOX4 + RET +; +WBOXSB: EX DE,HL + LD A,H ;Compare HL,HL' + EXX + EX DE,HL + CP H + EXX + JR Z,WBOXS2 + RET P + JR WBOXS4 +WBOXS2: LD A,L + EXX + CP L + EXX + RET NC +WBOXS4: PUSH HL + EXX + EX (SP),HL + EXX + POP HL + RET +; +;-------------------------- +; +; BOX FILL +; +; ent DE':xs, DE:xe +; HL':ys, HL:ye +; A:fill color +; +;-------------------------- +BOXF: + CALL COLS ;Fill Color Set + LD B,A + LD A,(GMODE) + CP B + JR NZ,BOXC + LD SP,(SPBOX) ;line routions pop +BOXC: LD A,(PWMODE) + OR A +BOXC0: + LD A,0C0H ;w0 pset + JR Z,BOXF0 + LD A,40H ;w0 or +BOXF0: OR B + OUT (LSWF),A ;Write mode set +; +YLINE: LD A,H + OR D + RET M + CALL BFCHK + LD A,L ;ye +; + EXX ;hl=ys,de=xs + BIT 7,H + JR Z,$+5 + LD HL,0 + BIT 7,D + JR Z,$+5 +; + LD DE,0 + EX AF,AF + CALL BFCHK + RET C + EX AF,AF ;ye +; + INC A + SUB L ;acc=lines(ye-ys+1) + RET C + RET Z + EX AF,AF ;acc'=lines +; + PUSH HL ;ye + CALL ADCH + LD (LSTA),HL + EXX + POP HL ;ye + LD B,A ;left + PUSH BC + CALL ADCH + POP BC + LD (RSTA),HL + LD C,A ;right + LD DE,(LSTA) +; +HLINE: OR A + SBC HL,DE + JR Z,BOXI + DEC HL + INC DE ;next point + LD A,L + OR A + CALL NZ,BOXL ;a' reserve +; +BOXH: LD HL,TDOTR + LD A,B + LD B,0 + ADD HL,BC + LD L,(HL) + LD C,A + LD A,L + LD HL,TDOTL + ADD HL,BC + LD B,(HL) +; +; + LD DE,(RSTA) + PUSH BC + CALL BOXW + POP BC + LD DE,(LSTA) + LD A,B + JR BOXW +; +; +; +; +BOXI: LD HL,TDOTR + LD A,B + LD B,0 + ADD HL,BC + LD C,A + LD A,0FFH + AND (HL) + LD HL,TDOTL + ADD HL,BC + AND (HL) +; +; +BOXW: + LD C,A + EX AF,AF + LD B,A + EX AF,AF + EX DE,HL + DI +BFL0: LD DE,80 ;40 + IN A,(LSE0) +BOXW1: LD (HL),C + ADD HL,DE + DJNZ BOXW1 + IN A,(LSE1) + EI + RET +; +; +; +; +BOXL: PUSH BC + EX DE,HL ;hl=start + LD B,A ;yoko counter + EX AF,AF + LD C,A ;tate counter + EX AF,AF +BFL1: LD DE,80 ;40 + DI +BOXL1: PUSH HL + PUSH BC + IN A,(LSE0) + LD A,0FFH +BOXL0: LD (HL),A + INC HL + DJNZ BOXL0 + IN A,(LSE1) + POP BC + POP HL + ADD HL,DE + DEC C + JR NZ,BOXL1 + EI + POP BC + RET +; +; + + +;----------------------------- +; +; box fill range check +; +;----------------------------- +; +BFCHK: LD A,H + OR A + JR NZ,BFCHK0 + LD A,199 + CP L + JR NC,BFCHK1 ;skip if hl>199 +BFCHK0: LD HL,199 + SCF +BFCHK1: RRA ;push cf + PUSH HL +BFC0: LD HL,-640 ;-320 + ADD HL,DE + POP HL + JR NC,BFCHK3 ;skip if de>639,319 +BFC1: LD DE,639 ;319 + RET +; +BFCHK3: RLA ;pop cf + RET +;----------------------------- +; +; Position check +; +;----------------------------- +POSCK: + EXX + CALL RNGCK + EXX + RET NC ;OK + LD A,3 + JP ERRORJ +;----------------------------- +; +; Position save +; +;----------------------------- +POSSV: + EXX ;Position save + LD (POINTX),DE + LD (POINTY),HL + EXX + RET + + +;---------------------------- +; +; SYMBOL +; +; Ent. A:angle +; B:string length +; H:Y ratio +; L:X ratio +; DE:string address +; +;---------------------------- +; +; +SBDTAP: DEFS 8 +; + +; This structure shares the memory space allocated for KEYBUF + +defc SDT0 = 1200H +defc SDT7 = 1207H +; +defc SCNT = 1208H ;1 +defc HCNT = SCNT+1 ;1 +defc VCNT = HCNT+1 ;1 +defc BCNT = VCNT+1 ;1 +; +defc STRAP = BCNT+1 ;2 +defc SDTAP = STRAP+2 ;2 +defc BDTAP = SDTAP+2 ;2 +; +defc DEFX0 = BDTAP+2 ;1 +defc DEFY0 = DEFX0+1 ;1 +defc DEFX8 = DEFY0+1 ;2 +defc DEFY8 = DEFX8+2 ;2 +; +defc PX = DEFY8+2 ;2 +defc PY = PX+2 ;2 +; +defc VADD = PY+2 ;2 +defc LDOT = VADD+2 ;1 +; +defc DEFX = LDOT+1 ;1 +defc DEFY = DEFX+1 ;1 +defc DEF8 = DEFY+1 ;2 +; +defc NSDT = DEF8+2 ;2 -> $1223 + + +; +; +CLLADD: DEFW LOD00 + DEFW LOD90 + DEFW LOD18 + DEFW LOD27 +; +; +SYMBOL: + PUSH BC ;string length + PUSH DE ;string address + LD BC,PX + LD D,L + LD E,H + BIT 0,A + JR Z,SYMB10 ;skip acc=0,2 +; + EX DE,HL ;exchange milti + INC BC + INC BC ;bc=py +; +SYMB10: LD (SYMB18+1),BC + LD (DEFX0),HL + LD H,0 + ADD HL,HL + ADD HL,HL + ADD HL,HL ;defx8=defx*8 + LD (DEFX8),HL +; + LD L,E + LD H,0 + ADD HL,HL + ADD HL,HL + ADD HL,HL ;defy8=defy*8 + LD (DEFY8),HL +; +; +; set py ,def8 +; + LD DE,0 + EX DE,HL ;de=defy8 + SBC HL,DE ;hl=-defy8 + LD (DEF8),HL ;def8=-defy8 + BIT 1,A + JR Z,SYMB11 ;skip if acc=0,1 +; + LD (DEF8),DE ;def8=defy8 +SYMB11: OR A ;HL=-defy8 + JP PO,SYMB12 ;skip if acc=1,2 +; + LD HL,0 +SYMB12: LD DE,(POINTY) + ADD HL,DE ;pointy or pointy-defy8 + LD (PY),HL ;set py +; +; +; set px def8 +; +; + LD DE,(DEFX8) + LD HL,0 + OR A ;de=defx8 + SBC HL,DE ;hl=-defx8 + BIT 0,A + JR NZ,SYMB13 ;skip if acc=1,3 + BIT 1,A + LD (DEF8),DE ;DE=defx8 + JR Z,SYMB13 ;skip if acc=0 + LD (DEF8),HL ;hl=-defx8 +SYMB13: EX DE,HL ;de=-defx8 + LD HL,(POINTX) + BIT 1,A + JR Z,SYMB15 ;skip if acc=0,1 + ADD HL,DE ;pointx or pointx-defx8 +SYMB15: LD (PX),HL ;set px +; +; calc rotation program addr +; + ADD A,A + LD HL,CLLADD + LD D,0 + LD E,A + ADD HL,DE + LD E,(HL) + INC HL + LD D,(HL) + LD (SYMS10+1),DE +; + CALL SETW ;set pwmode + POP HL + POP BC +; +SYMB17: DEC B ;string count down + RET M +; + PUSH HL + PUSH BC + CALL SYMS +SYMB18: LD HL,PX ;py + LD E,(HL) ;calc px(py)=px(py)+def8 + INC HL + LD D,(HL) + PUSH HL + LD HL,(DEF8) + ADD HL,DE + EX DE,HL + POP HL + LD (HL),D + DEC HL + LD (HL),E ;set next disp addr + POP BC + POP HL + INC HL ;next string pointer + JR SYMB17 + + +; +; // SYMBOL SUB. // +; +; +; +SYMS: LD IY,SCNT + LD A,(HL) ;mz ascii -> display + RST 3 + DEFB _ADCN ;PSGON + LD H,0 + LD L,A + ADD HL,HL + ADD HL,HL + ADD HL,HL + LD A,10H + ADD A,H + LD H,A ;hl=hl+1000H +; + LD DE,SBDTAP ;xfer cg data + LD BC,8 + DI + IN A,(LSE0) + LDIR + IN A,(LSE1) + EI +; + LD B,8 ;rotation pro. +SYMS10: CALL LOD00 ;LODXX +; +; + LD HL,808H + LD (HCNT),HL ;set hcnt,vcnt + LD DE,(DEFX0) + LD (DEFX),DE + LD HL,(PX) + BIT 7,H + JR Z,SYMS20 ;skip if PX>=0 +; + CALL SSYMB + RET C ;error position +; +; +SYMS11: EXX ;data area rotate + LD B,8 + LD HL,SDT0 +SYMS12: RLC (HL) + INC HL + DJNZ SYMS12 + EXX + DJNZ SYMS11 +; + LD HL,0 +SYMS20: LD (SYMS23+1),HL + LD A,0F8H + AND L + OR H + RRC A + RRC A + RRC A +SYMS21: SUB 80 ;40 + RET NC ;buffer full check? +; + LD L,A ;SEND DATA ADD. + LD H,11H + LD (BDTAP),HL + LD HL,(PY) + XOR A + BIT 7,H + JR Z,SYMS22 +; + INC IY + CALL SSYMB + DEC IY + RET C ;error position +; +; + LD HL,0 + LD A,8 + SUB B +SYMS22: LD (SYMS24+1),A +SYMS23: LD DE,0 ;XXH + PUSH HL + PUSH DE + CALL RNGCK + POP DE + POP HL + RET C ;error position +; + CALL ADCH + LD (VADD),HL + LD HL,TDOTN + LD D,0 + LD E,A + ADD HL,DE + LD A,(HL) + LD (LDOT),A +SYMS24: LD HL,SDT0 +SYMS25: LD DE,(BDTAP) + LD BC,(LDOT) ;b defx c ldot + XOR A + EXX + LD B,(IY+1) ;hcnt +; +SYMS30: EXX + LD (DE),A + XOR A +; + RRC (HL) + JR NC,SYMS31 +; + LD A,0B1H ;OR C +SYMS31: LD (SYMS32),A + LD A,(DE) +; +SYMS32: OR C ;nop + RLC C + JR NC,SYMS33 + LD (DE),A + INC E ;next data addr + JR Z,SYMS34 ;skip if buffer full + XOR A +SYMS33: DJNZ SYMS32 +; +SYMS3A: LD B,(IY+0AH) ;defx0 + EXX + DJNZ SYMS30 ;hcnt +; + EXX + LD (DE),A + INC E +; +SYMS34: DEC E + INC L + LD (SDTAP),HL + LD HL,(BDTAP) + EX DE,HL + XOR A + SBC HL,DE + INC HL + LD (NSDT),HL + LD A,(DEFY) + LD B,A ;loop counter set +; +SYMS40: EXX + LD DE,(VADD) + LD HL,(BDTAP) + LD BC,(NSDT) + DI + IN A,(LSE0) + OUT (LSE0),A + LDIR + IN A,(LSE1) + EI +SYMS41: LD DE,80 ;40 + LD HL,(VADD) + ADD HL,DE + LD (VADD),HL ;next disp addr +SYMS42: LD DE,0BE80H ;9F40H + OR A + SBC HL,DE + RET NC ;position error check +; + EXX + DJNZ SYMS40 +; +SYMS43: LD A,(DEFY0) ; + LD (DEFY),A ;set loop counter + LD HL,(SDTAP) + DEC (IY+2) ;VCNT + JP NZ,SYMS25 + RET + + +; +; // rotation sub . // +; +LOD00: LD HL,SBDTAP + LD DE,SDT0 + LD C,B + LD B,0 + LDIR + RET +; +; +LOD90: LD DE,SDT0 +LOD901: EXX + LD HL,SBDTAP + LD B,8 + XOR A +; +LOD902: RLC (HL) + RRA + INC HL + DJNZ LOD902 +; + EXX + LD (DE),A + INC DE + DJNZ LOD901 +; + RET +; +; +LOD18: LD DE,SDT7 + LD HL,SBDTAP +; +LOD181: LD A,(HL) + EXX + LD C,A + LD B,8 + XOR A +; +LOD182: RR C + RL A + DJNZ LOD182 +; + EXX + LD (DE),A + INC HL + DEC DE + DJNZ LOD181 +; + RET +; +; +LOD27: LD DE,SDT7 +LOD271: EXX + LD HL,SBDTAP + XOR A + LD B,8 +; +LOD272: RLC (HL) + RLA + INC HL + DJNZ LOD272 +; + EXX + LD (DE),A + DEC DE + DJNZ LOD271 + RET +; +; calc position +; +; +SSYMB: LD B,8 + LD E,(IY+0AH) ;defx0,defy0 + LD D,0 +; +SSYMB1: ADD HL,DE + BIT 7,H + JR Z,SSYMB2 + DJNZ SSYMB1 +SSYMB4: SCF + RET +; +SSYMB2: LD A,H + OR L + JR NZ,SSYMB3 + LD L,E + DEC B + JR Z,SSYMB4 +SSYMB3: LD (IY+17H),L ;defx,defy + LD (IY+1),B ;HCNT,VCNT + OR A + RET + + +; +;------------------------------- +; +; +; PATTERN +; ent A:Heighth +; B:String length +; H:Direction +; DE:String adrs +; +;------------------------------- +defc POINTW = KEYBF ;2 +defc STRAD = POINTW+2 ;2 +defc PATDA1 = POINTW+250 +defc PATDA2 = POINTW+251 +defc PATDA3 = POINTW+252 +defc PATDA4 = POINTW+263 +; +; +CHARW: + OR A ;no mode ? + RET Z ;yes + LD (STRAD),DE + LD E,A ;E'=Height + LD C,A ;C'=Height(work) + LD A,H + OR A + LD A,23H ;INC HL + JR NZ,PATT1 ;DOWN +; + LD A,2BH ;DEC HL +PATT1: LD (PATTA),A + LD (PATTC),A + LD A,B + OR A ;no string ? + RET Z ;yes +; + LD HL,(POINTX) + LD A,07H + AND L + LD D,A + EXX ;keep c',e',b',d' + LD HL,TDOTL + LD D,0 + LD E,A + ADD HL,DE + LD A,(HL) +; + LD (PATTB+1),A ;MASK DATA +; +PATT3: LD HL,(POINTY) +PATT4: LD (POINTW),HL ;save (POINTY) +; +PATTB: LD C,0FFH ;C=mask data + LD HL,(STRAD) ;read DATA + LD A,(HL) +; + EXX ;keep c',e',b',d' + LD H,A + LD A,D + OR A ;X=0 ? + JR Z,PATT6 ;yeS +PATT7: RRC H + DEC A + JR NZ,PATT7 +PATT6: LD A,H + EXX ;A=pattern data +; + LD HL,PATDA1 +; + LD B,8 ;DATA sift + LD D,A +PATT80: SRL D + RLA + DJNZ PATT80 +; + LD D,A ;C^D + AND C + LD (HL),A ;left set data +; + LD A,D + CPL + LD B,A ;B=CPL(D)=CPL(STRAD) + AND C ;C^CPL(D) + INC HL + LD (HL),A ;left reset data +; + LD A,C + CPL + LD C,A + AND D ;CPL(C)^D + INC HL + LD (HL),A ;right set data +; + LD A,C + AND B ;CPL(C)^CPL(D) + INC HL + LD (HL),A ;right reset data +; + LD DE,(POINTX) + LD HL,(POINTW) +; +; + PUSH DE + PUSH HL + EX DE,HL ;X=X+1 + LD BC,8 + ADD HL,BC + EX DE,HL + LD A,1 ;right mode + CALL PATT90 + POP HL + POP DE +; + XOR A ;left mode + CALL PATT90 +; +; + LD HL,(STRAD) ;next data + INC HL + LD (STRAD),HL + EXX + DJNZ PATT5 ;B' +; + DEC C ;C' X-->END + EXX + JP Z,PATT70 ;X=X+8 & END + LD HL,(POINTW) +PATTC: INC HL ;DEC HL + LD (POINTY),HL +; + XOR A ;end + RET +; +PATT5: DEC C ;C' + JR NZ,PATT2 ;next Xposition + LD C,E ;C' E' + EXX + CALL PATT70 ;X=X+8 + JR PATT3 +; +; +PATT2: EXX + LD HL,(POINTW) +PATTA: INC HL ;DEC HL + JR PATT4 +; +; pointx+8 +; +PATT70: LD HL,(POINTX) + LD BC,8 + ADD HL,BC + LD (POINTX),HL + RET +; +;--------------------------- +; +; V-RAM write +; non keep +; +; A=0 ---->left +; 1 ---->right +; DE=X positin +; HL=y position +;--------------------------- +PATT90: EX AF,AF ;push AF + CALL RNGCK + RET C ;address err +; + CALL ADCH ;get V-RAM address + LD B,A ;B=0 -->no right data +; HL=V-RAM address +; + LD DE,PATDA1 ;(DE)=write data + EX AF,AF ;pop AF + OR A ;left data ? + JR Z,PATT91 ;yes +; + LD A,B ;non right data + OR A + RET Z +; + INC DE ;DE,PATDA3 + INC DE +PATT91: CALL SETW ;mode set + DI + IN A,(LSE0) + OUT (LSE0),A ;get V-RAM + LD A,(DE) ;B=right data + LD (HL),A + LD A,(PWMODE) + OR A ;OR mode ? + JR NZ,PATT92 ;YES +; + LD A,(CPLANE) ;read color data + OR 60H + OUT (LSWF),A + INC DE + LD A,(DE) ;C=reset data + LD (HL),A +PATT92: IN A,(LSE1) + EI + RET +; +; +; -------------------------------- +; +; PAINT ROUTINE ( 9.5/84 ) +; +; +; HL: COLOR ADD. +; B : NUM. of COLOR +; +; ------------------------------- +; +defc DIRAR = 27D0H +defc ENKYB = 12A0H +defc NDSP = KEYBF ;2 +defc DSP = NDSP+2 ;2 +defc NSSP = DSP+2 ;1 +defc SSP = NSSP+1 ;2 +defc PBXL = SSP+2 ;2 +defc PBXR = PBXL+2 ;2 +; +defc Y = PBXR+2 ;2 +defc BXL = Y+2 ;2 +defc BXR = BXL+2 ;2 +defc DIRECT = BXR+2 ;1 +defc JCONT = DIRECT+1 ;1 +defc JSAVE = JCONT+1 ;1 +defc JSAVE1 = JSAVE+1 ;1 +defc BUFF = JSAVE1+1 ;11 DATA BUFF. +; +defc _PEEK = DIRAR ;PROGRAM AREA +; +defc WORK = Y +; +; +; // MAIN ROUTINE // +; +; +WPAINT: + LD A,(GMODE) + OR 0C0H + OUT (LSWF),A ;Write mode set + EXX + LD DE,_PEEK ;MAKE PEEK ROUTINE + LD HL,DPEEK + LD BC,DPEEK1-DPEEK + LDIR + EXX +; +PAIN0: LD A,(HL) ; COLOR SELECT + CALL COLS ;Bound Color Set + OR 80H ;SEARCH MODE SET + LD (DPEEK1+1),A + INC HL + EXX + LD HL,DPEEK1 + LD BC,DPEEK2-DPEEK1 + LDIR + EXX + DJNZ PAIN0 +; + EXX + LD BC,DPEEK3-DPEEK2+1 + LDIR + LD HL,(TMPEND) + LD (DSP),HL + LD (CSAVE+2),HL + LD HL,(PAIWED) + LD DE,-6 + ADD HL,DE + LD (SVDT0+1),HL +; +; + LD HL,(POINTX) + DEC HL + LD (BXL),HL ;BXL=POINTX-1 + INC HL + INC HL + LD (BXR),HL ;BXR=POINTX+1 + DEC HL + EX DE,HL + LD HL,0 + LD (NDSP),HL + LD HL,(POINTY) + LD (Y),HL + CALL RNGCK + CCF + RET NC ;START OUT RANGE +; + LD (SOVER1),SP + LD SP,DIRAR+700H +; +; + CALL ADCH + LD DE,TDOTN + PUSH HL + LD H,0 + LD L,A + ADD HL,DE + LD C,(HL) + POP HL + CALL _PEEK + AND C + JP NZ,PAINCE ;ON BOUND +; + CALL RBSR + LD (BXR),IX ;SET R.BOUND + CALL LBSR + LD (BXL),IX ;SET L.BOUND + LD A,0FFH + LD (DIRECT),A ;DOWN + CALL SVDT + LD HL,ENKYB + LD (SSP),HL + XOR A + LD (DIRECT),A + LD (NSSP),A +; +PAIN1: LD A,(DIRECT) + CALL CHDIR0 + LD A,199 + CP L + JR C,PAINA ;OUT RANGE +; + CALL NBSRCH + JR C,PAINA ;CLOSE +; + LD (JCONT),A + AND 9 + CALL NZ,PAIND +; + CALL CSAVE + LD A,(JSAVE) + OR A + JR NZ,PAINA +; +PAIN3: CALL PSRCH + JR Z,PAIN1 +; + LD HL,(BXR) + PUSH HL + PUSH DE + CALL RBSR0 + LD (BXR),IX + CALL SVDT + POP HL + LD (BXL),HL + POP HL + LD (BXR),HL + JR PAIN1 +; +; +PAINA: LD HL,(DSP) + DEC HL + LD DE,-7 + LD BC,(NDSP) +PAINA1: LD A,B + OR C + JR Z,PAINC +; + LD A,0FH + DEC BC + CP (HL) + ADD HL,DE + JR Z,PAINA1 +; + INC HL + PUSH HL + LD (PAINA2+1),HL + LD DE,WORK + LD BC,7 + LDIR + EX DE,HL + LD HL,(DSP) + XOR A + POP BC + LD (DSP),BC + SBC HL,DE + JR Z,PAINA3 +; + LD B,H + LD C,L +PAINA2: LD HL,00H ;XXH + EX DE,HL + LDIR + LD (DSP),DE +; +PAINA3: LD HL,(NDSP) + DEC HL + LD (NDSP),HL + JP PAIN3 +; +; +PAINC: LD HL,(NDSP) + LD A,L + OR H + JR NZ,PAINC0 +; +PAINCE: LD SP,(SOVER1) ;END JOB + RET +; +; +PAINC0: DEC HL + LD (NDSP),HL + LD HL,(DSP) + DEC HL + LD DE,WORK+6 + LD BC,7 + LDDR + INC HL + LD (DSP),HL +; +PAINC1: CALL PSRCH + JR Z,PAINC +; + CALL RBSR0 + LD (BXR),IX + JR PAINC1 +; +; +PAIND: LD HL,PBXL ;DATA SAVE + LD DE,BUFF + CALL PAIND3 + LD A,(JCONT) + BIT 0,A + JR Z,PAIND1 +; +LTW: LD HL,(PBXL) + LD (BXR),HL + CALL TWR + JR C,LTW1 ;CLOSE +; + BIT 0,A + JR NZ,LTW +; +LTW1: CALL PAIND2 + LD A,(JCONT) + CP 9 + RET NZ +; +PAIND1: LD HL,(PBXR) + LD (BXL),HL + CALL TWR + JR C,PAIND2 +; + BIT 3,A + JR NZ,PAIND1 +; +PAIND2: LD HL,BUFF + LD DE,PBXL +PAIND3: LD BC,11 + LDIR + RET +; +; +; +; CHECK SAVE DATA +; +; +CSAVE: LD IY,00H ;XXH + LD BC,(NDSP) + LD HL,00H + LD (JSAVE),HL ;STATUS CLEAR +; +CSAVE1: CALL DSAVE + LD A,(NSSP) + OR A + RET Z +; + DEC A + LD (NSSP),A + LD (CSAVE2+1),SP + LD SP,(SSP) + POP IY + POP BC + POP HL + LD (BXR),HL + POP HL + LD (BXL),HL + LD (SSP),SP +CSAVE2: LD SP,00H ;XXH + JR CSAVE1 +; +; +DSAVE: LD A,B + OR C + LD (DSAVEC+1),BC + JP Z,DSAVE3 +; + LD HL,(Y) + LD E,(IY+0) + LD D,(IY+1) + XOR A + SBC HL,DE + JR NZ,DSAVE2 +; + CALL COMP + CP 5 + JR Z,DSAVE1 +; + CP 0FH + JR NZ,DSAVE4 +; + LD L,(IY+2) ;SBXL + LD H,(IY+3) + LD DE,(BXR) + XOR A + SBC HL,DE + JR NC,DSAVE2 +; + LD HL,(BXL) + PUSH HL + LD L,(IY+2) + LD H,(IY+3) + PUSH HL +DSAVE_0: + LD (BXL),HL + LD A,3 + CALL ESAVE + POP HL + LD (BXR),HL + POP HL + LD (BXL),HL + CALL RBSR + LD (BXR),IX + JR DSAVE2 +; +DSAVE1: LD E,(IY+4) ;SBXR + LD D,(IY+5) + LD HL,(BXL) + XOR A + SBC HL,DE + JR NC,DSAVE2 +; + LD HL,(BXR) + PUSH HL + LD L,(IY+4) + LD H,(IY+5) + PUSH HL + LD (BXR),HL + LD A,4 + CALL ESAVE + POP HL + LD (BXL),HL + POP HL + LD (BXR),HL + CALL LBSR + LD (BXL),IX +; +DSAVE2: LD DE,7 + ADD IY,DE +DSAVEC: LD BC,00H ;XXH + DEC BC + JP DSAVE +; +DSAVE3: LD A,(JSAVE1) + OR A + CALL NZ,SVDT + RET +; +DSAVE4: EX AF,AF + LD A,0FH + LD (JSAVE),A + EX AF,AF + OR A + JR NZ,DSAVE5 +; + LD A,0FH + LD (IY+6),A + RET +; +DSAVE5: CP 1 + JR NZ,DSAVE6 +; + LD L,(IY+4) ;SBXR + LD H,(IY+5) + LD (BXL),HL + CALL LBSR + LD (BXL),IX + JR DSAVE8 +; +DSAVE6: CP 0CH + JR NZ,DSAVE9 +; +DSAVE7: LD L,(IY+2) ;SBXL + LD H,(IY+3) + LD (BXR),HL + CALL RBSR + LD (BXR),IX +DSAVE8: LD A,0FH + LD (IY+6),A + LD (JSAVE1),A ;SAVE DATA AFTER JOB + JR DSAVE2 +; +; +DSAVE9: CP 0DH + JP NZ,ESAVE +; + LD A,(NSSP) + INC A + CP 27 + CCF + JP C,SOVER ;STACK OVER +; + LD (NSSP),A + LD HL,(BXL) + PUSH HL ;SAVE BXL + LD L,(IY+4) + LD H,(IY+5) + LD (BXL),HL + CALL LBSR + LD (DSAVEB+2),IY + LD DE,7 + ADD IY,DE + LD BC,(DSAVEC+1) + DEC BC + LD (DSAVEA+1),SP + LD SP,(SSP) + PUSH IX ;BXL + LD DE,(BXR) + PUSH DE + PUSH BC + PUSH IY + LD (SSP),SP +DSAVEA: LD SP,00H ;XXH +DSAVEB: LD IY,00H ;XXH + POP HL + LD (BXL),HL + JP DSAVE7 +; +; +ESAVE: EX AF,AF + CALL SVDT + DEC DE + LD A,0FH + LD (DE),A + EX AF,AF + CP 3 + JR NZ,ESAVE2 +; +ESAVE1: LD HL,(BXR) + LD (BXL),HL + LD L,(IY+4) + LD H,(IY+5) ;SBXR + LD (BXR),HL + CALL LBSR + PUSH IX + POP HL + LD (IY+2),L + LD (IY+3),H + RET +; +ESAVE2: CP 4 + JR Z,ESAVE3 +; + LD HL,(DSP) + PUSH HL + LD (SVDT1+1),IY + CALL SVDT + LD HL,WORK + LD (SVDT1+1),HL + LD HL,(BXL) + PUSH HL + CALL ESAVE1 + POP HL + LD (BXR),HL + POP IY + JR ESAVE4 +; +; +ESAVE3: LD HL,(BXL) + LD (BXR),HL +ESAVE4: LD L,(IY+2) + LD H,(IY+3) + LD (BXL),HL + CALL RBSR + PUSH IX + POP HL + LD (IY+4),L + LD (IY+5),H + RET +; +; +; NEXT BOUNS SEARCH +; +; +NBSRCH: LD HL,(BXL) + LD (PBXL),HL + LD HL,(BXR) + LD (PBXR),HL + CALL LBSR + RET C ;CLOSE +; + LD (BXL),IX + CALL RBSR + LD (BXR),IX + CALL _CONT ;CF=0 + LD A,B + RET +; +; CHANGE Y DIRECTON +; & +; NEXT Y CO-ORDINATE +; +CHDIR: LD A,(DIRECT) + CPL + LD (DIRECT),A +CHDIR0: LD HL,(Y) + INC L + OR A + JR NZ,CHDIR1 +; + DEC L + DEC L +CHDIR1: LD (Y),HL + RET +; +; +TWR: CALL CHDIR + CALL NBSRCH + RET C +; + PUSH AF + LD HL,(BXL) + PUSH HL + LD HL,(BXR) + PUSH HL + CALL CSAVE + LD A,(JSAVE) + OR A + CALL Z,SVDT +; + POP HL + LD (BXR),HL + POP HL + LD (BXL),HL + POP AF + RET +; +; +; *** BOUND SEARCH **** +; +; +; +; // LEFT BOUNS SEARCH // +; +LBSR: LD DE,(BXR) + LD HL,(BXL) + PUSH HL + LD (BSRCH4+1),DE + LD HL,00H + LD (BSRCH6+1),HL + LD A,2BH ;DEC IX + LD (BSRCH3+1),A + LD A,2FH ;CPL + LD (BSRCH5),A + XOR A + LD (BSRCH7),A + LD HL,BSRCHL + LD (BSRCH1+1),HL + LD HL,BSRCHR + LD (BSRCH2+1),HL + POP DE + INC DE + JR BSRCH +; +; // RIGHT BOUNS SEARCH // +; +RBSR: LD DE,(BXR) +RBSR0: LD HL,(BXL) + LD (BSRCH6+1),HL + DEFB 21H ;LD HL,640 or 320 +LRBSR: + DEFW 8002H + LD (BSRCH4+1),HL + LD A,23H ;INC IX + LD (BSRCH3+1),A + LD A,2FH ;CPL + LD (BSRCH7),A + XOR A + LD (BSRCH5),A + LD HL,BSRCHR + LD (BSRCH1+1),HL + LD HL,BSRCHL + LD (BSRCH2+1),HL + DEC DE +; +; +; // SEARCH ROUTINE // +; +BSRCH: LD HL,(Y) + PUSH DE + POP IX + CALL ADCH + LD DE,TDOTN + PUSH HL + LD H,0 + LD L,A + ADD HL,DE + LD C,(HL) + POP HL + CALL _PEEK + LD E,A + AND C +BSRCH1: JP Z,BSRCHL ;JP BSRCHR +; +BSRCH2: CALL BSRCHR ;CALL BSRCHL +BSRCH3: DEC IX ;INC IX + RET +; +; ++ SEARCH LEFT +++ +; +BSRCHL: DEC IX + RRC C + JR NC,BSRCHC +; + PUSH IX + EXX + POP DE + INC DE +BSRCH6: LD HL,00H ;BX + INC HL + SBC HL,DE + EXX + RET NC +; + DEC HL + CALL _PEEK + LD E,A +BSRCHC: LD A,E +BSRCH7: NOP ;CPL + AND C + JP Z,BSRCHL + RET +; +; ++ SEARCH RIGHT +++ +; +BSRCHR: INC IX + RLC C + JR NC,BSRCHA +; + CALL BSRCHD + RET C +; + INC HL + CALL _PEEK + LD E,A +BSRCHA: LD A,E +BSRCH5: CPL ;NOP + AND C + JR Z,BSRCHR + +BSRCHD: PUSH IX + EXX + POP HL +BSRCH4: LD DE,BXR + XOR A + SBC HL,DE + EXX + CCF + RET +; +; +; +; // CONT. CHECK // +; +_CONT: LD B,0H + LD HL,(PBXR) + LD DE,(BXR) + CALL CONT1 + LD HL,(PBXL) + LD DE,(BXL) + INC HL ;FOR HL=FFH + INC DE ;FOR DE=FFH +; +CONT1: PUSH HL + XOR A + INC HL + SBC HL,DE + POP HL + RL B + INC DE + EX DE,HL + SBC HL,DE + RL B + RET +; +; +; *** POINT DATA +; +; SAVE & LOAD **** +; +; +; // DATA SAVE // +; +SVDT: LD DE,(DSP) +SVDT0: LD HL,0000 ; XX END ADD + XOR A + SBC HL,DE + JR NC,SVDT1 +; +SOVER: + DEFB 31H ;STACK POINTER +SOVER1: ;LD SP,XXH + DEFW 00H + SCF + RET +; +SVDT1: LD HL,WORK + LD BC,0007H + LDIR + LD (DSP),DE + LD HL,(NDSP) + INC HL + LD (NDSP),HL + RET +; +; +; *** PAINT & SEARCH **** +; +; +PSRCH: LD HL,(Y) + LD DE,(BXR) + DEC DE + CALL ADCH + LD DE,TDOTR + PUSH HL + LD H,0 + LD L,A + ADD HL,DE + INC C + LD B,C + LD C,(HL) + POP HL +; +PSRCH1: CALL _PEEK + AND C + JR NZ,PSRCH2 ;BOUND +; + DI + IN A,(LSE0) + LD (HL),C + IN A,(LSE1) + EI + LD C,0FFH + DEC HL + DJNZ PSRCH1 +; + LD DE,-1 + JR PSRCH5 +; +PSRCH2: LD E,B + LD B,7H + LD D,00H +PSRCH3: RLC A + JR C,PSRCH4 +; + SCF + RR D + DJNZ PSRCH3 +; +PSRCH4: IN A,(LSE0) + LD A,C + AND D + LD (HL),A + IN A,(LSE1) +; + LD A,E + DEC A + RLC A + RLC A + RLC A + LD C,A + LD A,07H + AND C + LD D,A + LD A,0F8H + AND C + OR B + LD E,A +PSRCH5: XOR A + LD HL,(BXL) + SBC HL,DE + RET +; +; +; // PEEK DATA // +; +DPEEK: PUSH HL + EXX + POP HL + DI + IN A,(LSE0) + LD C,LSRF + XOR A +; +DPEEK1: LD B,00H ;RE DATA + OUT (C),B + OR (HL) +; +DPEEK2: LD E,A + IN A,(LSE1) + EI + LD A,E + EXX +DPEEK3: RET + +; +; +; // COMP. BXL,BXR // +; +COMP: LD HL,(BXL) + LD E,(IY+2) + LD D,(IY+3) + INC HL + INC DE + XOR A + CALL COMP1 + LD HL,(BXR) + LD E,(IY+4) + LD D,(IY+5) +; +COMP1: SBC HL,DE + RLA + RLA + RET Z +; + OR 1 + RET +; +; END (558BH) + + +IF RAMDISK +TRANS_0: + LD A,0C0H + OUT (SIOAC),a + RET + +EMFRB_DI: + DI + CALL EMFRB + EI + RET + +EMCLR_DI: + DI + CALL EMCLR + EI + RET + +EMLD2_DI: + DI + JP EMLD2 + +EMRINF_EI: + LD (HL),D + OR A + EI + RET + +EMLDD_0: + DI + CALL EMLDD + EI + RET + +; EMLD2_DI_0 is identical to EMLD2_DI ! +; Probably the patches were applied manually in small steps +EMLD2_DI_0: + DI + JP EMLD2 + +EMSVB_EI: + CALL EMSVB + EI + RET + +LET_0: + CALL LET + LD A,(PRCSON) + CP 3 + JP Z,ER04 + RET + + NOP + +BORDER: + CALL IBYTE + LD BC,6CFH ;B counter C scrool reg + OUT (C),E + RET + +; !!! +SCROLL: + CALL IDEEXP + LD BC,1CFH ; scroll register + OUT (C),E + INC B + OUT (C),D + RET + +SYNC: + IN A,(LSDMD) ;check dipsw + AND 40H + JR Z,SYNC +SYNC_0: + IN A,(LSDMD) ;check dipsw + AND 40H + JR NZ,SYNC_0 + RET + +EMSV1_0: + PUSH HL + PUSH AF + SET 7,H + LD A,(CRTMD2) + DEC A + JR NZ,EMSV1_1 + SCF + RR H + RR L + RES 6,H + LD A,18H + RES 5,H + JR C,EMSV1_2 +EMSV1_1: + LD A,14H +EMSV1_2: + OUT (LSWF),A ;write plane + IN A,(LSE0) ;bank change + POP AF + LD (HL),A + IN A,(LSE1) ;bank off + OR A + POP HL + RET + +EMLD1_A: + PUSH HL + PUSH AF + SET 7,H + LD A,(CRTMD2) + DEC A + JR NZ,EMLD1_A0 + SCF + RR H + RR L + RES 6,H + LD A,18H + RES 5,H + JR C,EMLD1_A1 +EMLD1_A0: + LD A,14H +EMLD1_A1: + OUT (LSRF),A ;write plane + IN A,(LSE0) ;bank change + POP AF + LD L,(HL) + IN A,(LSE1) ;bank off + LD A,L + OR A + POP HL + RET + +VRAM: + LD A,0x3C ; "INC A" + LD (CRTPW0-1),A + PUSH HL + CALL CRTPWR + CALL CLSHET + LD A,(MEMOP) + OR A + POP HL + JP Z,ER59_ + CALL ENDCHK + JR Z,VRAM0 + CALL TEST1 + SBC A,L + JR Z,VRAM0 + CALL TESTX + AND C + + PUSH HL + LD HL,EMSV1 + LD (HL),0C5H ; "PUSH BC" + INC HL +IF MOD_B + LD (HL),0CDH ; "CALL .." +ELSE + LD (HL),0EH ; "LD C,.." +ENDIF + INC HL +IF MOD_B + LD (HL),0D6H ; +ELSE + LD (HL),0EBH ; ".. EM_P1" +ENDIF + LD HL,EMLD1 + LD (HL),0C5H ; "PUSH BC" + INC HL +IF MOD_B + LD (HL),0CDH ; "CALL .." +ELSE + LD (HL),0EH ; "LD C,.." +ENDIF + INC HL +IF MOD_B + LD (HL),0D6H ; +ELSE + LD (HL),0EBH ; ".. EM_P1" +ENDIF + + XOR A + CALL EMMPWR + POP HL + RET + +VRAM0: + PUSH HL + LD HL,EMSV1 + LD (HL),0C3H ; "JP .." + INC HL + LD (HL),EMSV1_0%256 + INC HL + LD (HL),EMSV1_0/256 + LD HL,EMLD1 + LD (HL),0C3H ; "JP .." + INC HL + LD (HL),EMLD1_A%256 + INC HL + LD (HL),EMLD1_A/256 + + LD HL,$3FFF + LD (EMPWR_SMC+1),HL + + XOR A ; "NOP" + LD (CRTPW0-1),A ; prevent "option vram" flag from being enabled + LD (MEMOP),A ; disable "option vram" flag + PUSH BC + CALL EMMPWR ; EMM power on routine + POP BC + POP HL + RET + + +FAST: + JR Z,FAST_0 + CALL TEST1 + SBC A,L + JR Z,FAST_0 + CALL TESTX + AND C + PUSH HL + LD HL,SLOW_TBL + JR FAST_1 +FAST_0: + PUSH HL + LD HL,FAST_TBL +FAST_1: + LD A,(HL) + LD (DLY3+2),A + INC HL + LD A,(HL) + LD (DLY1+1),A + INC HL + LD A,(HL) + LD (DLY4+1),A + POP HL + RET + + +SLOW_TBL: + DEFB 76, 24, 105 + +FAST_TBL: + DEFB 35, 11, 49 + + +SCREEN: + CALL IBYTE + OUT (LSRF),A ;read plane + CALL HCH2CH + CALL IBYTE + PUSH HL + PUSH DE + PUSH BC + LD B,A + LD A,(MEMOP) ;option vram exist ? + OR A + LD A,B + JR NZ,RD_SUB3_1 + AND 0E3H +RD_SUB3_1: + OUT (LSWF),A ;write plane + LD HL,8000H + PUSH HL + POP DE + LD BC,2000H + LD A,(DMD) ; display mode + CP 3 + JR C,RD_SUB3_2 + LD BC,4000H +RD_SUB3_2: + IN A,(LSE0) ;bank change !! + LDIR + IN A,(LSE1) ; bank reset + POP BC + POP DE + POP HL + RET + + +; map 'write mode' values to be sent to LSWF port +; +SPECG: + PUSH BC + CALL ENDCHK + LD B,0C0H ; no value + JR Z,SPECG_1 + LD B,020H + CP 45H ; 'E' + JR Z,SPECG_1 + LD B,060H + CP 52H ; 'R' + JR Z,SPECG_1 + LD B,0 + CP 53H ; 'S' + JP NZ,ER01 +SPECG_1: + LD A,B ; A='Write mode' (to be sent to [LSWF] port) + LD (_SET+2),A ;w0 pset + LD (BOXC0+1),A ;w0 pset + POP BC + CP 0C0H + RET Z + INC HL + RET + + defs 8 + +; --- $5728 --- +START_0: + +ENDIF + + +MON_END: +DEFS $5800-MON_END + + +; ORG 5800H +_START: + + +; ORG 5800H + +; -------------------------- +; MZ-800 BASIC Main program +; FI:BASIC ver 1.0A 9.06.84 +; Programed by T.Miho +; -------------------------- +; +; + +defc _BAR = 0C4H +defc _YEN = 7DH +defc _POND = 0FBH + +; +_BASIC: + PUSH BC + CALL CLSHET + POP BC + LD HL,BASIC_PGM + LD (TEXTST),HL + LD HL,CLSST + LD (SYSSTA),HL + LD A,B + OR A +COLDRT: JP Z,_BAS2 ;JP _BAS3 Change + CP 1 + JR Z,_BAS2 + LD HL,ARUN + LD DE,INBUFL + LD BC,16 + LDIR +_BAS2: LD DE,IMDBUF + RST 3 + DEFB _CRTMS + RST 3 + DEFB _BELL + LD A,0C3H + LD (COLDRT),A + LD HL,_BAS3 + LD (COLDRT+1),HL +; +_BAS3: LD HL,BASIC_PGM +MEMCLI: LD (HL),0 + INC HL + LD A,H + CP 0FFH ;mem max + JR C,MEMCLI + CALL MEMSET + CALL NEWTXT + CALL IOINIT + JR HOTENT +; +ARUN: DEFB 15 + DEFM "RUN \"AUTO RUN\"" + DEFB 0DH +; +; +CLSHET: LD A,1 ;INIT "CRT:M1" + RST 3 + DEFB _DSMOD + XOR A + LD (PWMODE),A + INC A + LD (CRTMD2),A + LD (CRTMD1),A + RST 3 + DEFB _ICRT + RET +; +CLSST: CALL CLSHET +; +HOTENT: LD HL,ERRORA + LD (ERRORP),HL +; +; +OK: + RST 3 + DEFB _CR2 + LD DE,OKMES + RST 3 + DEFB _CRTMS + RST 3 + DEFB _CR1 +INPAGN: + LD A,(CONTFG) + OR A + JR NZ,INPAG2 + LD SP,(INTFAC) + LD HL,0FFFFH + PUSH HL + LD (STACK),SP +INPAG2: LD HL,0 ;Set direct-mode + LD (LNOBUF),HL + XOR A + LD (CMTMSG),A + CALL AUTODS + RST 3 + DEFB _ERCVR ;FD,QD motor off + LD DE,KEYBUF + RST 3 + DEFB _GETL + JR NC,NORINP +AUTOFF: LD HL,AUTOFG + LD A,(HL) + OR A + LD (HL),0 + JR NZ,OK + JR INPAGN +; +; +NORINP: CALL SKPDE + OR A + JR Z,INPAGN + CALL TSTNUM + JP NC,EDITOR + LD HL,IMDBUF ;Direct command + PUSH HL + CALL CVIMTX + INC HL + LD (NXTLPT),HL + CALL LDHL00 + POP HL + JR MAIN +; +; Execute +; +MAIN9: CALL ENDZ +; +MAIN: + LD (STACK),SP +MAIN0: + LD DE,MAIN9 + PUSH DE +MAIN2: LD (TEXTPO),HL + CALL BRKCHK + JP Z,BREAKZ +MAIN4: LD A,(HL) + INC HL + CP 80H + JR NC,STATEM + CP '\'' + JP Z,DATA + CP ' ' + JR Z,MAIN4 + CP ':' + JR Z,MAIN2 + OR A + JR Z,ENDLIN ;END OF LINE + DEC HL + SUB 'A' + CP 26 + JP C,LET + JP ER01 +; +ENDLIN: + LD HL,(NXTLPT) +NXLINE: + LD E,(HL) + INC HL + LD D,(HL) + LD A,D + OR E + JR Z,ENDPRG ;END OF PROGRAM + LD (CMTMSG),A + EX DE,HL + ADD HL,DE + DEC HL + LD (NXTLPT),HL + EX DE,HL + INC HL + CALL LDDEMI + LD (LNOBUF),DE + CALL TRDISP + POP DE + JR MAIN +; +ENDPRG: POP HL + CALL _DIRECT + JP Z,OK + XOR A + LD (CONTFG),A + LD A,(ERRORF) + CP 2 + JP Z,ER20 + PUSH HL + JP _END ;end command +; +; +STATEM: CP 0FFH ;command jp + JP Z,PFUNCT + LD DE,GJPTBL + CP 0FEH + JR NZ,NROSTM + LD A,(HL) + INC HL + JR MIDFJP +NROSTM: CP 0E0H + JP NC,ER01 + LD DE,SJPTBL +MIDFJP: ADD A,A + PUSH HL + EX DE,HL + LD E,A + LD D,0 + ADD HL,DE + LD A,(HL) + INC HL + LD H,(HL) + LD L,A + EX (SP),HL +ENDCHK: + CALL HLFTCH +ENDCK0: + OR A + RET Z + CP ':' + RET +; +_DIRECT: ;Direct mode ? + PUSH HL + LD HL,(LNOBUF) + LD A,L + OR H + POP HL + RET +; +; +; TABLE +; +; +CTBL1: + DEFM "GOT" ; 80H + DEFB 'O'+80H + DEFM "GOSU" + DEFB 'B'+80H + + DEFB 80H + + DEFM "RU" + DEFB 'N'+80H + DEFM "RETUR" + DEFB 'N'+80H + DEFM "RESTOR" + DEFB 'E'+80H + DEFM "RESUM" + DEFB 'E'+80H + DEFM "LIS" + DEFB 'T'+80H + + DEFB 80H ; 88 + + DEFM "DELET" + DEFB 'E'+80H + DEFM "RENU" + DEFB 'M'+80H + DEFM "AUT" + DEFB 'O'+80H + DEFM "EDI" + DEFB 'T'+80H + DEFM "FO" + DEFB 'R'+80H + DEFM "NEX" + DEFB 'T'+80H + DEFM "PRIN" + DEFB 'T'+80H +; + DEFB 80H ; 90 + + DEFM "INPU" + DEFB 'T'+80H + DEFB 80H + DEFM "I" + DEFB 'F'+80H + DEFM "DAT" + DEFB 'A'+80H + DEFM "REA" + DEFB 'D'+80H + DEFM "DI" + DEFB 'M'+80H + DEFM "RE" + DEFB 'M'+80H + + DEFM "EN" ; 98 + DEFB 'D'+80H + DEFM "STO" + DEFB 'P'+80H + DEFM "CON" + DEFB 'T'+80H + DEFM "CL" + DEFB 'S'+80H + DEFB 80H + DEFM "O" + DEFB 'N'+80H + DEFM "LE" + DEFB 'T'+80H + DEFM "NE" + DEFB 'W'+80H +; + DEFM "POK" + DEFB 'E'+80H ; A0 + DEFM "OF" + DEFB 'F'+80H + DEFM "PMOD" + DEFB 'E'+80H + DEFM "PSKI" + DEFB 'P'+80H + DEFM "PLO" + DEFB 'T'+80H + DEFM "PLIN" + DEFB 'E'+80H + DEFM "RLIN" + DEFB 'E'+80H + DEFM "PMOV" + DEFB 'E'+80H + + DEFM "RMOV" + DEFB 'E'+80H ; A8 + DEFM "TRO" + DEFB 'N'+80H + DEFM "TROF" + DEFB 'F'+80H + DEFM "INP" + DEFB '@'+80H + DEFM "DEFAUL" + DEFB 'T'+80H + DEFM "GE" + DEFB 'T'+80H + DEFM "PCOLO" + DEFB 'R'+80H + DEFM "PHOM" + DEFB 'E'+80H +; + DEFM "HSE" + DEFB 'T'+80H ; B0 + DEFM "GPRIN" + DEFB 'T'+80H + DEFM "KE" + DEFB 'Y'+80H + DEFM "AXI" + DEFB 'S'+80H + DEFM "LOA" + DEFB 'D'+80H + DEFM "SAV" + DEFB 'E'+80H + DEFM "MERG" + DEFB 'E'+80H + DEFM "CHAI" + DEFB 'N'+80H + + DEFM "CONSOL" + DEFB 'E'+80H ; B8 + DEFM "SEARC" + DEFB 'H'+80H + DEFM "OUT" + DEFB '@'+80H + DEFM "PCIRCL" + DEFB 'E'+80H + DEFM "PTES" + DEFB 'T'+80H + DEFM "PAG" + DEFB 'E'+80H + DEFM "WAI" + DEFB 'T'+80H + + +IF RAMDISK + DEFB 80H + + DEFM "VRA" ; C0 + DEFB 'M'+80H +ELSE + DEFM "SWA" + DEFB 'P'+80H + + DEFB 80H ; C0 +ENDIF + + DEFM "ERRO" + DEFB 'R'+80H + DEFM "ELS" + DEFB 'E'+80H + DEFM "US" + DEFB 'R'+80H + DEFM "BY" + DEFB 'E'+80H + + DEFB 80H + DEFB 80H + + DEFM "DE" + DEFB 'F'+80H + + DEFB 80H ; C8 + DEFB 80H + + DEFM "LABE" + DEFB 'L'+80H + + DEFB 80H + DEFB 80H + DEFB 80H + + DEFM "WOPE" + DEFB 'N'+80H + DEFM "CLOS" + DEFB 'E'+80H +; + DEFM "ROPE" + DEFB 'N'+80H +; + +IF RAMDISK + DEFB 80H + + DEFM "SPEC" + DEFB 'G'+80H + +ELSE + DEFM "XOPE" + DEFB 'N'+80H + + DEFB 80H +ENDIF + + DEFB 80H + DEFB 80H + + DEFM "DI" + DEFB 'R'+80H + + DEFB 80H + DEFB 80H + + DEFM "RENAM" + DEFB 'E'+80H + DEFM "KIL" + DEFB 'L'+80H + +IF RAMDISK + DEFB 80H + DEFB 80H + + DEFM "INI" + DEFB 'T'+80H + DEFM "FAS" + DEFB 'T'+80H + DEFM "SCREE" + DEFB 'N'+80H +ELSE + DEFM "LOC" + DEFB 'K'+80H + DEFM "UNLOC" + DEFB 'K'+80H + DEFM "INI" + DEFB 'T'+80H + + DEFB 80H + DEFB 80H +ENDIF + + DEFB 80H +; + DEFM "T" + DEFB 'O'+80H + DEFM "STE" + DEFB 'P'+80H + DEFM "THE" + DEFB 'N'+80H + DEFM "USIN" + DEFB 'G'+80H + + DEFB 80H ;PI + + DEFM "AL" + DEFB 'L'+80H + DEFM "TA" + DEFB 'B'+80H + DEFM "SP" + DEFB 'C'+80H + + DEFB 80H ; E8 + DEFB 80H + DEFM ".XO" + DEFB 'R'+80H + DEFM ".O" + DEFB 'R'+80H + DEFM ".AN" + DEFB 'D'+80H + DEFM ".NO" + DEFB 'T'+80H + DEFM ">" + DEFB '<'+80H + DEFM "<" + DEFB '>'+80H +; + DEFM "=" + DEFB '<'+80H ; F0 + DEFM "<" + DEFB '='+80H + DEFM "=" + DEFB '>'+80H + DEFM ">" + DEFB '='+80H + DEFB '='+80H + DEFB '>'+80H + DEFB '<'+80H + DEFB '+'+80H + DEFB '-'+80H ; F8 + DEFB _YEN+80H + DEFM ".MO" + DEFB 'D'+80H + DEFB '/'+80H + DEFB '*'+80H + DEFB '^'+80H +; + DEFB 0FFH +; + + +GTABL: + DEFB 80H ; FE 80 + + +IF RAMDISK + DEFM "SYN" + DEFB 'C'+80H + DEFM "BORDE" + DEFB 'R'+80H + DEFM "SCROL" + DEFB 'L'+80H +ELSE + DEFM "CSE" + DEFB 'T'+80H + DEFM "CRESE" + DEFB 'T'+80H + DEFM "CCOLO" + DEFB 'R'+80H +ENDIF + DEFB 80H + DEFB 80H + DEFB 80H + DEFB 80H + + DEFB 80H ; FE 88 + DEFB 80H + DEFM "SOUN" + DEFB 'D'+80H + DEFB 80H + DEFM "NOIS" + DEFB 'E'+80H + DEFM "BEE" + DEFB 'P'+80H + DEFB 80H ; MZ-1500 VOICE + DEFB 80H +; + DEFM "COLO" + DEFB 'R'+80H ; FE 90 + DEFB 80H ; MZ-1500 PRTY + DEFM "SE" + DEFB 'T'+80H + DEFM "RESE" + DEFB 'T'+80H + DEFM "LIN" + DEFB 'E'+80H + DEFM "BLIN" + DEFB 'E'+80H + DEFM "PA" + DEFB 'L'+80H + DEFM "CIRCL" + DEFB 'E'+80H + + DEFM "BO" + DEFB 'X'+80H ; FE 98 + DEFM "PAIN" + DEFB 'T'+80H + DEFM "POSITIO" + DEFB 'N'+80H + DEFM "PATTER" + DEFB 'N'+80H + DEFM "HCOP" + DEFB 'Y'+80H + + DEFB 80H ; MZ-1500 KPATTERN + DEFB 80H ; MZ-1500 FPRINT + DEFB 80H + +; + DEFM "SYMBO" + DEFB 'L'+80H ; FE A0 + DEFB 80H + DEFM "MUSI" + DEFB 'C'+80H + DEFM "TEMP" + DEFB 'O'+80H + DEFM "CURSO" + DEFB 'R'+80H + DEFM "VERIF" + DEFB 'Y'+80H + DEFM "CL" + DEFB 'R'+80H + DEFM "LIMI" + DEFB 'T'+80H + + DEFB 80H ; FE A8 + DEFB 80H + DEFB 80H + DEFB 80H + DEFB 80H + DEFB 80H + DEFM "BOO" + DEFB 'T'+80H +; +; + DEFB 0FFH +; +; +; +CTBL2: + DEFM "IN" + DEFB 'T'+80H ; FF 80 + DEFM "AB" + DEFB 'S'+80H + DEFM "SI" + DEFB 'N'+80H + DEFM "CO" + DEFB 'S'+80H + DEFM "TA" + DEFB 'N'+80H + DEFM "L" + DEFB 'N'+80H + DEFM "EX" + DEFB 'P'+80H + DEFM "SQ" + DEFB 'R'+80H + + DEFM "RN" + DEFB 'D'+80H ; FF 88 + DEFM "PEE" + DEFB 'K'+80H + DEFM "AT" + DEFB 'N'+80H + DEFM "SG" + DEFB 'N'+80H + DEFM "LO" + DEFB 'G'+80H + DEFM "FRA" + DEFB 'C'+80H + DEFM "PA" + DEFB 'I'+80H + DEFM "RA" + DEFB 'D'+80H +; + DEFB 80H ; FF 90 + DEFB 80H + DEFB 80H + DEFB 80H + DEFB 80H + DEFB 80H + DEFB 80H + DEFB 80H + DEFB 80H ; FF 98 + DEFB 80H + DEFB 80H + DEFB 80H + DEFM "STIC" + DEFB 'K'+80H + DEFM "STRI" + DEFB 'G'+80H + DEFB 80H ; MZ-1500 JOY + DEFB 80H +; + DEFM "CHR" + DEFB '$'+80H + DEFM "STR" + DEFB '$'+80H + DEFM "HEX" + DEFB '$'+80H + DEFB 80H + DEFB 80H + DEFB 80H + DEFB 80H + DEFB 80H + DEFM "SPACE" + DEFB '$'+80H + DEFB 80H + DEFB 80H ; MZ-1500 ASCCHR$ + DEFM "AS" + DEFB 'C'+80H + DEFM "LE" + DEFB 'N'+80H + DEFM "VA" + DEFB 'L'+80H + DEFB 80H + DEFB 80H +; + DEFB 80H ; FF B0 + DEFB 80H + DEFB 80H ; MZ-1500 HEXCHR$ + DEFM "ER" + DEFB 'N'+80H + DEFM "ER" + DEFB 'L'+80H + DEFM "SIZ" + DEFB 'E'+80H + DEFM "CSR" + DEFB 'H'+80H + DEFM "CSR" + DEFB 'V'+80H + DEFM "POS" + DEFB 'H'+80H + DEFM "POS" + DEFB 'V'+80H + DEFM "LEFT" + DEFB '$'+80H + DEFM "RIGHT" + DEFB '$'+80H + DEFM "MID" + DEFB '$'+80H + DEFB 80H ; MZ-1500 FONT$ + DEFB 80H + DEFB 80H +; + DEFB 80H ; FF C0 + DEFB 80H + DEFB 80H + DEFB 80H + DEFM "TI" + DEFB '$'+80H + DEFM "POIN" + DEFB 'T'+80H + DEFM "EO" + DEFB 'F'+80H + DEFM "F" + DEFB 'N'+80H +; + DEFB 0FFH +; +; JPTABLE +; +SJPTBL: + DEFW GOTO ; 80 + DEFW GOSUB + DEFW ER01 + DEFW RUN + DEFW RETURN + DEFW RESTOR + DEFW RESUME + DEFW LIST + DEFW ER01 ; 88 + DEFW DELETE + DEFW RENUM + DEFW AUTO + DEFW EDIT + DEFW FOR + DEFW NEXT + DEFW PRINT +; + DEFW ER01 ; 90 + DEFW INPUT + DEFW ER01 + DEFW _IF + DEFW DATA + DEFW READ + DEFW DIM + DEFW REM + DEFW _END ; 98 + DEFW STOP + DEFW CONT + DEFW CLS + DEFW ER01 + DEFW ON + DEFW LET + DEFW NEW +; + DEFW POKE ; A0 + DEFW ER01 + DEFW MODE + DEFW SKIP + DEFW PLOT + DEFW PLINE + DEFW RLINE + DEFW PMOVE + DEFW RMOVE ; A8 + DEFW TRON + DEFW TROFF + DEFW INP_ + DEFW DEFAULT + DEFW GETOP + DEFW PCOLOR + DEFW PHOME +; + DEFW HSET ; B0 + DEFW GPRINT + DEFW KLIST + DEFW AXIS +;IF MOD_B +; DEFW LOAD+1 ; ??? +;ELSE + DEFW LOAD +;ENDIF + DEFW SAVE + DEFW MERGE + DEFW CHAIN + DEFW CONSOL ; B8 + DEFW SEARCH + DEFW OUT_ + DEFW PCIRCLE + DEFW TEST + DEFW PAGE + DEFW PAUSE + DEFW SWAP ; <- with a RAMDISK mod, the 'SWAP' keyword is not defined +; +IF RAMDISK + DEFW VRAM ; C0 +ELSE + DEFW ER01 ; C0 +ENDIF + DEFW ERROR + DEFW _ELSE + DEFW USR + DEFW BYE + DEFW ER01 + DEFW ER01 + DEFW DEFOP + DEFW ER01 ; C8 + DEFW ER01 + DEFW LABEL + DEFW ER01 + DEFW ER01 + DEFW ER01 + DEFW WOPEN + DEFW CLOSE +; + DEFW ROPEN ; D0 + DEFW XOPEN ; <- with a RAMDISK mod, this keyword is not defined +IF RAMDISK + DEFW SPECG +ELSE + DEFW ER01 +ENDIF + DEFW ER01 + DEFW ER01 + DEFW DIR + DEFW ER01 + DEFW ER01 + DEFW RENAME ; D8 + DEFW KILL + + DEFW LOCK ; <- with a RAMDISK mod, this keyword is not defined + DEFW UNLOCK ; <- with a RAMDISK mod, this keyword is not defined + DEFW INIT +IF RAMDISK + DEFW FAST + DEFW SCREEN +ELSE + DEFW ER01 + DEFW ER01 +ENDIF + DEFW ER01 +; +; +GJPTBL: + DEFW ER01 ; FE 80 + +IF RAMDISK + DEFW SYNC + DEFW BORDER + DEFW SCROLL +ELSE + DEFW ER01 ; CSET + DEFW ER01 ; CRESET + DEFW ER01 ; CCOLOR +ENDIF + DEFW ER01 + DEFW ER01 + DEFW ER01 + DEFW ER01 + DEFW ER01 ; FE 88 + DEFW ER01 + DEFW SOUND + DEFW ER01 + DEFW NOISE + DEFW BEEP +; MZ-1500 .VOICE: + DEFW ER01 + DEFW ER01 +; + DEFW COLOR ; FE 90 + DEFW ER01 + DEFW SET + DEFW RESET + DEFW LINE + DEFW BLINE + DEFW PALET + DEFW CIRCLE + DEFW BOX ; FE 98 + DEFW PAINT + DEFW POSITI ; POSITION + DEFW PATTER ; PATTERN + DEFW HCOPY + DEFW ER01 + DEFW ER01 + DEFW ER01 +; + DEFW SMBOL ; FE A0 + DEFW ER01 + DEFW MUSIC + DEFW TEMPO + DEFW CURSOR_ + DEFW VERIFY + DEFW CLR + DEFW LIMIT + DEFW ER01 ; FE A8 + DEFW ER01 + DEFW ER01 + DEFW ER01 + DEFW ER01 + DEFW ER01 + DEFW BOOT +; +; +FJPTBL: + DEFW INTOPR ; FF 80 + DEFW ABS + DEFW SIN + DEFW COS + DEFW TAN + DEFW LOG ;LN + DEFW EXP + DEFW SQR + DEFW RND ; FF 88 + DEFW PEEK + DEFW ATN + DEFW SGN + DEFW LOGD ;LOG + DEFW FRACT + DEFW PAI + DEFW RAD +; + DEFW ER01 ; FF 90 + DEFW ER01 + DEFW ER01 + DEFW ER01 + DEFW ER01 + DEFW ER01 + DEFW ER01 + DEFW ER01 + DEFW ER01 ; FF 98 + DEFW ER01 + DEFW ER01 + DEFW ER01 + DEFW STCK + DEFW STIG + DEFW ER01 + DEFW ER01 +; + DEFW ER01 ; FF A0 CHR$ + DEFW STR_S + DEFW HEX_S + DEFW ER01 + DEFW ER01 + DEFW ER01 + DEFW ER01 + DEFW ER01 + DEFW SPACE_S ; FF A8 + DEFW ER01 + DEFW ER01 + DEFW ASC + DEFW LEN + DEFW VAL + DEFW ER01 + DEFW ER01 +; + DEFW ER01 ; FF B0 + DEFW ER01 + DEFW ER01 + DEFW ERR + DEFW ERL + DEFW SIZE + DEFW CSRH + DEFW CSRV + DEFW POSH ; FF B8 + DEFW POSV + DEFW LEFT_S + DEFW RIGHT_S + DEFW MID_S + DEFW ER01 + DEFW ER01 + DEFW ER01 +; + DEFW ER01 ; FF C0 + DEFW ER01 + DEFW ER01 + DEFW ER01 + DEFW TI_S + DEFW POINT + DEFW EOF + DEFW FNEXP ;FN + DEFW ER01 ; FF C8 + DEFW ER01 + DEFW ER01 + DEFW ER01 + DEFW ER01 + DEFW ER01 + DEFW ER01 + DEFW ER01 +; +; GET LINE ADRS +; +GETLIN: + CALL TEST1 + DEFB 0CH + JR NZ,GLIN2 + CALL LDDEMI + OR 0FFH + RET +GLIN2: INC HL + CP 0BH + JR NZ,GLIN4 + LD E,(HL) + INC HL + LD D,(HL) + INC HL + LD A,E + OR D + RET Z + EX DE,HL + CALL LNOSER + JP C,ER16 + EX DE,HL + DEC HL + LD (HL),D + DEC HL + LD (HL),E + DEC HL + LD (HL),0CH + INC HL + INC HL + INC HL + OR 0FFH + LD (REFFLG),A + RET +GLIN4: CP '"' + JP NZ,ER01 + LD (LABA+1),HL + LD B,0 +GLIN6: LD A,(HL) + OR A + JR Z,GLIN8 + INC HL + CP '"' + JR Z,GLIN8 + INC B + JR GLIN6 +GLIN8: LD A,B + OR A + JP Z,ER01 + LD (LABN+1),A + EX DE,HL + CALL LABSER + JP C,ER16 + EX DE,HL + OR 0FFH + RET +; +; LABSER .. Label search +; LNOSER .. Line# search +; +LABSER: PUSH BC + LD BC,LABSUB + JR LNOSR0 +LNOSER: PUSH BC + LD BC,LNOSUB +LNOSR0: LD (LNOSR_+1),BC + PUSH DE + EX DE,HL + LD HL,(TEXTST) +LNOSR2: LD C,(HL) + INC HL + LD B,(HL) + LD A,B + OR C + SCF + JR Z,LNOSR9 + DEC HL + PUSH HL + ADD HL,BC + EX (SP),HL +LNOSR_: CALL 0 + JR C,LNOSR8 + JR Z,LNOSR8 + POP HL + JR LNOSR2 +LNOSR8: POP DE ;DMY +LNOSR9: POP DE + POP BC + RET +; +LNOSUB: INC HL + INC HL + INC HL + LD A,D + CP (HL) + RET NZ + DEC HL + LD A,E + CP (HL) + DEC HL + DEC HL + RET +; +LABSUB: PUSH HL + INC HL + INC HL + INC HL + INC HL + CALL TEST1 + DEFB 0CAH ;LABEL + JR NZ,LABSR9 + CALL TEST1 + DEFB '"' + JR NZ,LABSR9 +LABN: LD B,0 ;Label length +LABA: LD DE,0 ;Label adrs +LABSR2: LD A,(DE) + CP (HL) + JR NZ,LABSR9 + INC HL + INC DE + DJNZ LABSR2 + LD A,(HL) + CP '"' + JR Z,LABSR9 + OR A +LABSR9: SCF + CCF + POP HL + RET +; +; START.LINE - END.LINE +; +GTSTED: + LD DE,0000H + LD BC,0FFFFH + CALL END2C + RET Z + CP '-' + JR Z,GTNXNM + CP '.' + LD DE,(EDLINE) + JR Z,NX2C2D + CALL TESTX + DEFB 0BH + LD E,(HL) + INC HL + LD D,(HL) +NX2C2D: INC HL + CALL END2C + JR Z,ONELLN + CP '-' + JR Z,GTNXNM +ONELLN: LD C,E + LD B,D + RET +; +GTNXNM: INC HL + CALL END2C + RET Z + CP '.' + JR NZ,GTEDNO + LD BC,(EDLINE) + INC HL + RET +; +GTEDNO: + CALL TESTX + DEFB 0BH + LD C,(HL) + INC HL + LD B,(HL) + INC HL + RET +; +END2C: + CALL ENDCHK + RET Z + CP ',' + RET +; +; REFADR ... Line ref = Adrs +; REFLNO ... Line ref = Number +; +REFADR: CALL PUSHR + LD A,0FFH + LD (REFFLG),A + LD HL,CVASUB + JR REFL2 +; +REFLNO: + CALL PUSHR + CALL CLRFLG +REFLNX: + LD A,(REFFLG) + OR A + RET Z + XOR A + LD (REFFLG),A + LD HL,CVLSUB +REFL2: LD (CVRTLN+1),HL + LD HL,(TEXTST) + DEC HL +REFL4: INC HL + LD A,(HL) + INC HL + OR (HL) + RET Z + INC HL + LD E,(HL) + INC HL + LD D,(HL) + LD (CVALN+1),DE +REFL6: CALL IFSKSB + OR A + JR Z,REFL4 +CVRTLN: JP 0 +; +CVLSUB: CP 0CH + JR NZ,REFL6 + DEC HL + LD E,(HL) + INC HL + LD D,(HL) + PUSH HL + EX DE,HL + INC HL + INC HL + LD E,(HL) + INC HL + LD D,(HL) + POP HL + LD (HL),D + DEC HL + LD (HL),E + DEC HL + LD (HL),0BH + INC HL + INC HL + JR REFL6 +; +CVASUB: CP 0BH + JR NZ,REFL6 + DEC HL + PUSH HL + CALL INDRCT + LD E,L + LD D,H + LD A,L + OR H + JR Z,CVAS9 + CALL LNOSER + JR C,CVASE + EX DE,HL + POP HL + DEC HL + LD (HL),0CH + INC HL + LD (HL),E + INC HL + LD (HL),D + JR REFL6 +; +CVASE: PUSH DE + LD A,16 ;UNDEF LINE + RST 3 + DEFB _ERRX + LD A,' ' + RST 3 + DEFB _CRT1C + POP HL + CALL ASCFIV + RST 3 + DEFB _CRTMS +CVALN: LD HL,0 ;xxx + CALL P_ERL + RST 3 + DEFB _CR2 +CVAS9: POP HL + INC HL + JR REFL6 +; +REFFLG: DEFB 0 +EDITOR: + RST 3 + DEFB _CLRIO + CALL REFLNO + CALL CVBCAS + LD A,B + OR C + JP Z,INPAGN + LD (EDLINE),BC + LD A,(DE) + CP 20H + JR NZ,$+3 + INC DE + PUSH AF + LD HL,IMDBUF + CALL CVIMTX + PUSH HL + LD HL,(EDLINE) + LD E,L + LD D,H + CALL DELSUB + POP HL ; END POINT + POP AF + OR A + JR Z,EDIT9 + LD DE,IMDBUF + OR A + SBC HL,DE + LD DE,5 + ADD HL,DE + LD BC,HL + LD HL,IMDBUF + CALL INSTLIN +EDIT9: LD A,(AUTOFG) + OR A + JP Z,INPAGN + LD DE,(EDSTEP) + LD HL,(EDLINE) + ADD HL,DE + LD (EDLINE),HL + JP NC,INPAGN + JP AUTOFF +; +; INSTLIN HL .. IMD ADRS +; BC .. IMD LENGTH +; +INSTLIN: + LD (INS_P+1),HL + PUSH BC + LD BC,(EDLINE) + LD HL,(TEXTST) + JR INSL4 +INSL2: CALL LDDEMD + ADD HL,DE +INSL4: CALL LDDEMD + LD A,D + OR E + JR Z,INSL6 + INC HL + INC HL + CALL LDDEMD + EX DE,HL + SBC HL,BC + DEC DE + DEC DE + EX DE,HL + JR C,INSL2 +INSL6: POP DE ;DE:=open bytes + PUSH HL ;Push inst-point + PUSH DE + LD HL,40 ;memory check ofset + ADD HL,DE + LD BC,(VARED) + LD (TMPEND),BC + ADD HL,BC + JP C,ER06_ + EX DE,HL + CALL MEMECK + POP DE ;DE=open bytes + RST 3 + DEFB _ADDP0 + POP HL ;HL=inst point + PUSH DE ;DE=open bytes + PUSH BC + EX (SP),HL ;HL=old VARED + POP BC ;BC=inst point + PUSH HL + OR A + SBC HL,BC + LD BC,HL ;BC=xfer bytes + POP HL ;HL=old VARED + LD DE,(VARED) ;DE=new VARED + INC BC + LDDR + INC HL ;HL=inst point + POP BC ;BC=open bytes + LD (HL),C + INC HL + LD (HL),B + INC HL + LD DE,(EDLINE) + LD (HL),E + INC HL + LD (HL),D + INC HL + EX DE,HL +INS_P: LD HL,IMDBUF ;xxx + DEC BC + DEC BC + DEC BC + DEC BC + LDIR + RET +; +RUN: JR Z,RUN0 ;RUN + CALL LINE_2 + JP Z,GOTO ;RUN linenumber + JP FRUN ;RUN "filename" +RUN0: CALL CLR +RUNX: + CALL RUNINT + LD DE,(TEXTST) + LD SP,(INTFAC) + LD HL,0FFFFH + PUSH HL + PUSH HL + EX DE,HL + JP NXLINE +; +RUNINT: + PUSH HL + CALL CLRFLG + LD (AUTOFG),A + LD HL,10 + LD (EDLINE),HL + LD (EDSTEP),HL + POP HL + RET +; +CLRFLG: + LD HL,0 + LD (ERRLNO),HL + XOR A + LD (DATFLG),A + LD (CONTFG),A + LD (ERRORF),A + LD (ERRCOD),A + LD (LSWAP),A + RET +; +; +; +_END: LD A,(LSWAP) + OR A + JP NZ,BSWAP + RST 3 + DEFB _CLRIO ;END command + XOR A + LD (CONTFG),A + POP BC + JP OK + +; +AUTO: CALL CKCOM + LD DE,10 ;AUTO start,step + LD BC,10 + JR Z,AUTO6 + CP ',' + JR NZ,AUTO2 + INC HL + CALL IDEEXP + LD B,D + LD C,E + LD DE,10 + JR AUTO6 +; +AUTO2: CP '.' + LD DE,(EDLINE) + JR Z,AUTO4 + CP 0BH + JP NZ,ER01 + INC HL + LD E,(HL) + INC HL + LD D,(HL) +; +AUTO4: INC HL + CALL TEST1 + DEFB "," + JR NZ,AUTO6 + PUSH DE + CALL IDEEXP + LD C,E + LD B,D + POP DE +AUTO6: CALL ENDZ + LD A,C + OR B + JP Z,ER03__ +; + LD (EDLINE),DE + LD (EDSTEP),BC + LD A,1 + LD (AUTOFG),A + POP AF + JP INPAGN +; +AUTOFG: DEFS 1 +; +AUTODS: LD A,(AUTOFG) ;Disp auto line + OR A + RET Z + XOR A + JR EDITL +; +EDIT: CALL EDITL ;EDIT linenumber + JP INPAGN +; +EDITL: LD DE,(EDLINE) + CALL NZ,GTSTED + PUSH DE + EX DE,HL + CALL LNOSER + POP DE + INC HL + INC HL + INC HL + INC HL + JR NC,$+5 + LD HL,NOTXT + EX DE,HL + PUSH DE + LD (EDLINE),HL + CALL ASCFIV + RST 3 + DEFB _CRTMS + LD A,' ' + RST 3 + DEFB _CRT1C + POP HL + LD DE,KEYBUF + PUSH DE + CALL CVTXIM + POP DE + LD B,0 +EDL2: LD A,(DE) + OR A + JR Z,EDL6 + INC B + RST 3 + DEFB _CRT1X + INC DE + JR EDL2 +EDL6: LD A,B + OR A + RET Z + LD A,14H ; CURSOR BACK + RST 3 + DEFB _CRT1C + DJNZ $-3 + RET +; +MEMSET: + PUSH DE + LD DE,-16 + ADD HL,DE + POP DE + LD (MEMLMT),HL + DEC H + LD (INTFAC),HL + XOR A + LD (LSWAP),A + RET +; +NEWTXT: + LD HL,(TEXTST) + CALL LDHL00 + LD (POOL),HL + CALL RUNINT + JR CLR +; +NEW: + CALL TEST1 + DEFB 9DH ;NEW command + CALL Z,NEWON + CALL NEWTXT + JP HOTENT +; +; +CLR: ;CLR command + PUSH HL + CALL CLPTR2 + POP HL + RST 3 + DEFB _CLRIO + RET +; +CLPTR: + LD HL,(TEXTST) + CALL LDHL00 + LD (POOL),HL +CLPTR2: LD HL,(POOL) + LD (HL),0 + INC HL + LD (VARST),HL ;Variable start <> POOL END + LD (HL),0 + INC HL + LD (STRST),HL + CALL LDHL00 + LD (VARED),HL + LD (TMPEND),HL + RET +; +LDHL00: + LD (HL),0 + INC HL + LD (HL),0 + INC HL + RET +; +; +TRON: CALL ENDCHK + LD A,1 + JR Z,TROFF+1 + CALL TESTX + DEFB 0FBH ;/ + CALL TESTX + DEFB 'P' + LD A,2 + JR $+3 +TROFF: XOR A ;TROFF + LD (TRDISP+1),A + RET +; +TRDISP: LD A,0 ;0,1,2 + OR A + RET Z + DEC A + LD (FILOUT),A + JR Z,TRDSP2 + LD A,(PNMODE) + CP 2 + JR Z,TRDSP9 ;MODE GR +TRDSP2: PUSH HL + LD A,'[' + RST 3 + DEFB _1C + LD HL,(LNOBUF) + CALL ASCFIV + RST 3 + DEFB _MSG + LD A,']' + RST 3 + DEFB _1C + POP HL +TRDSP9: XOR A + LD (FILOUT),A + RET +; +DELETE: CALL END2C + JP Z,ER01 ;DELETE + CALL LINE_2 + JR Z,DELLIN + CP '-' + JR Z,DELLIN + CP '.' + JP NZ,FDEL ;DELETE "filename" +DELLIN: + CALL GTSTED ;DELETE xxx-yyy + EX DE,HL + LD E,C + LD D,B + CALL DELSUB + JP OK +; +; Delete (HL)-(DE) +; +DELSUB: + PUSH AF + PUSH BC + PUSH HL + PUSH DE + CALL REFLNO + LD C,L + LD B,H + LD HL,(TEXTST) +FSTLOP: CALL LDDEMI + LD A,E + OR D + JR NZ,FDDLST +RTDLTE: POP DE + POP HL + POP BC + POP AF + RET +; +POPDLR: POP DE + JR RTDLTE +; +FDDLST: EX DE,HL + ADD HL,DE + DEC HL + DEC HL + EX DE,HL + PUSH DE + LD E,(HL) + INC HL + LD D,(HL) + EX DE,HL + LD (LNOTBF),HL + SBC HL,BC + POP HL + JR C,FSTLOP + DEC DE + DEC DE + DEC DE + POP BC ; DELSUB END LINE NO. + PUSH BC + PUSH DE ; DELSUB START ADRS + PUSH HL ; NEXT LINE ADRS + DEFB 21H +LNOTBF: DEFS 2 + SBC HL,BC + POP HL + JR Z,DLSTRT ; DEL-LINE END FOUND + JR NC,POPDLR ; NOTHING OCCUR +SNDDLP: CALL LDDEMI + LD A,D + OR E + JR Z,DLEFD_ + EX DE,HL + ADD HL,DE + EX DE,HL + DEC DE + DEC DE + PUSH DE + LD E,(HL) + INC HL + LD D,(HL) + EX DE,HL + SBC HL,BC + POP HL + JR C,SNDDLP + JR Z,DLSTRT + EX DE,HL + DEC HL +DLEFD_: DEC HL + DEC HL +DLSTRT: POP DE + PUSH DE ;Delete (DE)-(HL) + PUSH HL + OR A + EX DE,HL + SBC HL,DE + EX DE,HL ;DE = - bytes + LD BC,(VARED) ;old VARED + RST 3 + DEFB _ADDP0 + POP DE ;DE = del end + LD HL,BC ;HL = old VARED + OR A + SBC HL,DE + LD BC,HL ;BC = move bytes + EX DE,HL ;HL = del end + POP DE ;DE = del start + LDIR + JR RTDLTE +; +IDEEX0: CALL IDEEXP + LD A,D + OR E + RET NZ + JP ER03__ +; +RENUM: CALL CKCOM + LD DE,10 ;RENUM xxx,yyy,zzz + LD (NEWNO),DE + LD (ADDNO),DE + LD E,0 + LD (STLNO),DE + JR Z,RNSTRT + CP ',' + JR Z,SKIRE1 + CALL IDEEX0 + LD (NEWNO),DE + CALL ENDCHK + JR Z,RNSTRT + CALL HCH2CH + DEC HL +SKIRE1: CALL INCHLF + CP ',' + JR Z,SKMRNU + CALL IDEEX0 + LD (STLNO),DE + CALL ENDCHK + JR Z,RNSTRT + CALL HCH2CH + DEC HL +SKMRNU: INC HL + CALL IDEEX0 + LD (ADDNO),DE +RNSTRT: PUSH HL + LD HL,(STLNO) + EX DE,HL + LD HL,(NEWNO) + OR A + SBC HL,DE + JP C,ER03__ + CALL REFADR + LD HL,(TEXTST) +BEGRNS: LD E,(HL) + INC HL + LD D,(HL) + LD A,D + OR E + JR Z,RNUMED + EX DE,HL + ADD HL,DE + DEC HL + EX DE,HL + INC HL + LD C,(HL) + INC HL + LD B,(HL) + PUSH HL + DEFB 21H +STLNO: DEFS 2 + OR A + SBC HL,BC + POP HL + JR Z,BEGREN + JR C,BEGREN + EX DE,HL + JR BEGRNS +; +BEGREN: DEC HL + DEC HL + DEC HL + DEFB 01H +NEWNO: DEFS 2 + OR A + PUSH AF +RENUML: LD E,(HL) + INC HL + LD D,(HL) + LD A,D + OR E + JR Z,RNUMED + EX DE,HL + ADD HL,DE + DEC HL + EX DE,HL + POP AF + JR C,RENOVR + INC HL + LD (HL),C + INC HL + LD (HL),B + DEFB 21H +ADDNO: DEFS 2 + ADD HL,BC + PUSH AF + LD C,L + LD B,H + EX DE,HL + JR RENUML +; +RNUMED: POP AF + CALL REFLNX + POP HL + RET +; +RENOVR: LD HL,10 + LD (ADDNO),HL + LD (NEWNO),HL + LD L,0 + LD (STLNO),HL + CALL RNSTRT + JP ER03__ +; +; +; Error message & exeption +; +defc MAXERR = 70 +; +; +ER01: + LD A,01 + DEFB 21H + +ER02: + LD A,02 + DEFB 21H + +ER03__: + LD A,03 + DEFB 21H + +ER04: + LD A,04 + DEFB 21H + +ER05: + LD A,05 + DEFB 21H + +ER06__: + LD A,06 + DEFB 21H + +ER07: + LD A,07 + DEFB 21H + +ER08: + LD A,08 + DEFB 21H + +ER13: + LD A,13 + DEFB 21H + +ER14: + LD A,14 + DEFB 21H + +ER15: + LD A,15 + DEFB 21H + +ER16: + LD A,16 + DEFB 21H + +ER17: + LD A,17 + DEFB 21H + +ER18: + LD A,18 + DEFB 21H + +ER19: + LD A,19 + DEFB 21H + +ER20: + LD A,20 + DEFB 21H + +ER21: + LD A,21 + DEFB 21H + +ER22: + LD A,22 + DEFB 21H + +ER24: + LD A,24 + DEFB 21H + +ER25: + LD A,25 + DEFB 21H + +ER58__: + LD A,58 + DEFB 21H + +ER64__: + LD A,64 + JR ERRJ2 + +; +ER06_: ;Nesting error + LD A,6 +NESTER: + LD SP,(INTFAC) + LD HL,0FFFFH + PUSH HL + LD (STACK),SP +ERRJ2: JR ERRJ1 +; +LPTMER: ;LPT:mode error + LD HL,(__LPT) + DEFB 0DDH +CRTMER: ;CRT:mode error + LD HL,(__CRT) + LD (ZEQT),HL + XOR A + LD (ZFLAG2),A + LD A,68+80H ;+80H is I/O err + DEFB 21H +ER59__: + LD A,59+80H + DEFB 21H +ER59_: + LD A,59 + DEFB 21H +ER60_: + LD A,60+80H + DEFB 21H +ER61_: + LD A,61+80H +ERRJ1: JP ERRORJ +; +; +P_ERL: LD A,L ;Print "IN line#" + OR H + RET Z + LD DE,MESIN + RST 3 + DEFB _CRTMS + CALL ASCFIV + RST 3 + DEFB _CRTMS + RET +; +; +MESIN: DEFM " IN " + DEFB 0 +MESBR: DEFM "BREAK" + + DEFB 0 +; +OKMES: + DEFM "READY" + +CONTFG: + DEFB 0 + DEFB 0 +; +ERROR: CALL IBYTE ;"ERROR" command + DEC A + CP MAXERR + JR C,$+4 + LD A,69-1 + INC A +; +ERRORA: LD SP,(STACK) ;jump from monitor + PUSH AF + RST 3 + DEFB _ERCVR + CALL LDEND + POP AF + OR A + JR Z,_BRKX + CP 80H + JR Z,_BRKZ + LD C,A + LD HL,0 + LD (FNVRBF),HL + CALL _DIRECT + LD A,C + JR Z,ERR2 + LD HL,(LNOBUF) + LD (ERRLNO),HL + LD (EDLINE),HL + LD HL,(NXTLPT) + LD (ERRLPT),HL + LD HL,(TEXTPO) + LD (ERRPNT),HL + AND 7FH + LD (ERRCOD),A + LD A,(ERRORF) + INC A + CP 02H + JR Z,ERROPR + XOR A + LD (CONTFG),A + LD (LSWAP),A + LD A,C +ERR2: + RST 3 + DEFB _ERRX +ERR4: LD HL,(LNOBUF) + CALL P_ERL + JP OK +; +; +ERROPR: LD (ERRORF),A ;Error trap + LD HL,(ERRORV) + PUSH HL + JP NXLINE +; +_BRKZ: LD A,'.' ;Can CONT +_BRKX: ;Can't CONT + LD HL,(TEXTPO) + JR BREAK2 +; +STOP: ;"STOP" command + LD A,'.' ;Can CONT + POP DE ;Dummy POP +BREAK2: PUSH AF + PUSH HL + RST 3 + DEFB _CR2 + RST 3 + DEFB _BELL + LD DE,MESBR + RST 3 + DEFB _CRTMS + POP HL + CALL _DIRECT + JR Z,BREAK4 + LD (BREAKT+1),HL ;Text pointer + LD HL,(NXTLPT) + LD (BREAKN+1),HL ;Next line + LD HL,(LNOBUF) + LD (BREAKL+1),HL ;Line No. + LD (EDLINE),HL + POP AF + LD (CONTFG),A + JP ERR4 +BREAK4: POP AF + JP OK +; +; +CONT: POP DE ;"CONT" command + LD HL,CONTFG + LD A,(HL) + OR A + JP Z,ER17 + LD (HL),0 +BREAKL: LD HL,0 ;Line No. + LD (LNOBUF),HL +BREAKN: LD HL,0 ;Next line + LD (NXTLPT),HL +BREAKT: LD HL,0 ;Text pointer + JP MAIN +; +; +; +RESUME: ;"RESUME" command + LD A,(ERRORF) + CP 2 + JP C,ER21 + DEC A + LD (ERRORF),A + CALL ENDCHK + EX DE,HL + LD HL,(ERRLNO) + LD (LNOBUF),HL + LD HL,(ERRLPT) + LD (NXTLPT),HL + LD HL,(ERRPNT) + JR NZ,RESUM2 + POP BC + JP MAIN0 ;RESUME +RESUM2: CP 8EH + JP Z,DATA ;RESUME NEXT + EX DE,HL + JP GOTO ;RESUME line# +; +ONERRG: + CALL TESTX + DEFB 80H ;GOTO + CALL GETLIN + JR Z,OFFER + LD (ERRORV),DE + LD A,1 +ONER9: LD (ERRORF),A + RET +; +; +OFFER: LD A,(ERRORF) + DEC A + JR Z,ONER9 + XOR A + LD (ERRORF),A + LD HL,(ERRLNO) + LD (LNOBUF),HL + LD A,(ERRCOD) + JP ERRORA +; +; END (650DH) + + + + + + +; --------------------------------- +; MZ-800 BASIC Statement interprit +; FI:STMNT ver 1.0A 9.06.84 +; Programed by T.Miho +; --------------------------------- + +; ORG 650DH + +; +; +; +LET: + CALL TEST1 + DEFB 0FFH + JP Z,PFUNCT + CALL INTGTV + PUSH BC + PUSH BC + PUSH AF + CALL TESTX + DEFB 0F4H ;= + CALL EXPR + POP BC + LD A,(PRCSON) + CP B + JP NZ,ER04 + EX (SP),HL ; VAR ADRS<>TEXTPOINT + EX DE,HL + CP 05H + JR Z,DAIBCK + PUSH BC + CALL STRDAI + POP AF + POP HL + POP BC + RET +; +DAIBCK: LD C,A + LD B,0 + LDIR + POP HL + POP BC + RET +; +PFUNCT: + CALL TESTX + DEFB 0C4H + JP TIMDAI ;TI$=... +; +STRLET: + PUSH DE + EX DE,HL + JR STRDI2 +; +STRDAI: + PUSH DE + CALL CVTSDC +STRDI2: LD HL,KEYBM1 + LD (HL),A + LD B,A + LD C,A + INC HL + CALL LDHLDE + POP HL + LD A,(HL) + CP C + JR Z,SMLNST + PUSH HL + OR A + CALL NZ,DELSTR + POP HL + LD A,(KEYBM1) + OR A + JR Z,STRNL1 + PUSH HL + LD BC,(VARST) + SBC HL,BC + EX DE,HL + LD HL,(VARED) + DEC HL + DEC HL + LD (HL),E + INC HL + LD (HL),D + INC HL + LD BC,(STRST) + OR A + POP DE + PUSH HL + SBC HL,BC + EX DE,HL + LD (HL),A + LD B,A + INC HL + LD (HL),E + INC HL + LD (HL),D + POP HL + LD DE,KEYBM1 + INC DE + CALL STRENT + CALL LDHL00 + LD (TMPEND),HL + LD (VARED),HL + RET +; +STRNL1: LD (HL),0 + RET +; +SMLNST: INC HL + LD E,(HL) + INC HL + LD D,(HL) + LD HL,(STRST) + ADD HL,DE + LD DE,KEYBM1 + LD B,C + INC DE + JP STRENT +; +DELSTR: LD C,(HL) + LD B,0 + INC BC + INC BC + INC HL + LD E,(HL) + INC HL + LD D,(HL) + LD HL,(STRST) + ADD HL,DE + DEC HL + DEC HL + LD E,L + LD D,H + ADD HL,BC + PUSH BC + PUSH DE + EX DE,HL + LD HL,(VARED) + OR A + SBC HL,DE + LD C,L + LD B,H + EX DE,HL + POP DE + PUSH DE + JR Z,$+4 + LDIR + POP DE + POP BC + LD HL,(VARED) + OR A + SBC HL,BC + LD (VARED),HL + EX DE,HL +STRDE1: LD E,(HL) + INC HL + LD D,(HL) + LD A,D + OR E + RET Z + LD HL,(VARST) + ADD HL,DE + LD A,(HL) + INC HL + LD E,(HL) + INC HL + LD D,(HL) + OR A + EX DE,HL + SBC HL,BC + EX DE,HL + LD (HL),D + DEC HL + LD (HL),E + PUSH BC + LD C,A + LD B,0 + LD HL,(STRST) + ADD HL,DE + ADD HL,BC + POP BC + JR STRDE1 +; +FOR: ;FOR TO STEP + POP BC + LD (FORRTA),BC +IF RAMDISK + CALL LET_0 +ELSE + CALL LET +ENDIF + LD IX,0 + ADD IX,SP + LD (FRTXPT),HL + CALL VAROFST + LD (FORVAD+1),BC +FOR3: LD E,(IX+0) + LD D,(IX+1) + LD HL,0FF12H + OR A + SBC HL,DE + JR NZ,FOR1 + LD E,(IX+6) + LD D,(IX+7) + EX DE,HL + OR A + SBC HL,BC + JR Z,FOR2 ;EQL FORVAR + LD DE,012H + ADD IX,DE + JR FOR3 +FOR2: LD DE,012H + ADD IX,DE + LD SP,IX +FOR1: LD HL,(FRTXPT) + CALL TESTX + DEFB 0E0H ;TO + CALL EXPR + PUSH AF + PUSH HL + EX DE,HL + LD DE,TODTBF + CALL LDIR5 + POP HL + POP AF + CP 0E1H ;STEP + LD DE,FLONE + JR NZ,SSTEP1 + INC HL + CALL EXPR +SSTEP1: LD (FRTXPT),HL + LD HL,0FFF6H ;-10 + ADD HL,SP + LD SP,HL + EX DE,HL + CALL LDIR5 + LD HL,TODTBF + CALL LDIR5 +FORVAD: LD HL,0 + PUSH HL + DEFB 21H +FRTXPT: DEFS 2 + PUSH HL + LD HL,(NXTLPT) + PUSH HL + LD HL,0FF12H ;FOR MARK + PUSH HL + LD HL,-512 + ADD HL,SP + LD DE,(TMPEND) + SBC HL,DE + LD A,11 ;FOR..NEXT ERR + JP C,NESTER + LD HL,(FRTXPT) + DEFB 0C3H +FORRTA: DEFS 2 +; +; +NEXT: ;NEXT + LD A,5 + LD (PRCSON),A + POP BC + LD (NEXRTA),BC +NEXT6: PUSH AF + POP BC + LD (FRTXPT),HL + LD IX,0 + ADD IX,SP + LD (FORSTK),IX + LD E,(IX+0) + LD D,(IX+1) + LD HL,0FF12H + OR A + SBC HL,DE + JP NZ,ER13 + PUSH BC + POP AF + JR NZ,NEXT1 +; + LD E,(IX+4) ;FOR TEXTPO + LD D,(IX+5) + EX DE,HL + LD (NEXT4+1),HL +; + LD E,(IX+6) ;FORVAD + LD D,(IX+7) + LD HL,(VARST) + ADD HL,DE +; + LD BC,8 ;STEP ADR + ADD IX,BC + PUSH IX + POP DE + CALL ADD + INC DE + LD A,(DE) + LD IX,(FORSTK) + LD DE,0DH + ADD IX,DE + PUSH IX + POP DE + BIT 7,A + JR NZ,$+3 + EX DE,HL + CALL CMP + JR C,NEXT3 ;END + DEFB 31H +FORSTK: DEFS 2 + LD HL,2 + ADD HL,SP + LD A,(HL) + INC HL + LD H,(HL) + LD L,A + LD (NXTLPT),HL +NEXT4: LD HL,0 ;TEXTPO +NEXT5: DEFB 0C3H +NEXRTA: DEFS 2 +NEXT3: LD DE,012H + LD HL,(FORSTK) + ADD HL,DE + LD SP,HL + LD HL,(FRTXPT) + CALL TEST1 + DEFM "," + JR NZ,NEXT5 +; + LD (FRTXPT),HL +NEXT1: LD IX,0 + ADD IX,SP + LD (FORSTK),IX + LD HL,(FRTXPT) + CALL TEST1 + DEFM "," + JP Z,NEXT6 + CALL INTGTV + LD (FRTXPT),HL + CALL VAROFST + LD IX,(FORSTK) +NEXT12: LD E,(IX+0) + LD D,(IX+1) + LD HL,0FF12H + OR A + SBC HL,DE + JP NZ,ER13 + LD L,(IX+6) + LD H,(IX+7) + OR A + SBC HL,BC + LD HL,(FRTXPT) + JP Z,NEXT6 + LD DE,012H + ADD IX,DE + LD (FORSTK),IX + LD SP,(FORSTK) + JR NEXT12 +; +VAROFST:LD HL,BC + LD BC,(VARST) + OR A + SBC HL,BC + LD BC,HL + RET +; +TODTBF: DEFS 5 +; +FRLNBF: DEFS 2 +FRNLPT: DEFS 2 +; +FORSKS: CALL IFSKSB + OR A + RET NZ + INC HL + PUSH DE + LD E,(HL) + INC HL + LD D,(HL) + LD A,D + OR E + INC HL + LD (FRNLPT+1),DE + LD E,(HL) + INC HL + LD D,(HL) + LD (FRLNBF+1),DE + POP DE + SCF + RET Z + JR FORSKS +; +USR: ;USR(adrs,source$,dest$) + CALL CH28H + CALL IDEEXP ;adrs + LD (USRADR+1),DE + CALL TEST1 + DEFM "," + JR NZ,USR2 + CALL EXPR ;source$ + CALL STROK + LD (USRSRC+1),DE + CALL TEST1 + DEFM "," + JR NZ,USR2 + CALL INTGTV ;dest$ + CALL STROK + LD (USRDST+1),BC + XOR A +USR2: PUSH HL + PUSH AF +USRSRC: LD HL,0 ;xxx + CALL CVTSDC + LD IX,ERRORJ + XOR A +USRADR: CALL 0 ;xxx + POP AF + JR NZ,USR8 + LD A,B ;dest$ exist + EX DE,HL +USRDST: LD DE,0 ;xxx + CALL STRLET +USR8: POP HL + JP HCH29H +; +; +PAUSE: ;PAUSE command + CALL IDEEXP +PAUSE2: LD A,D + OR E + RET Z + LD B,0FBH ;JAPAN 00H + DJNZ $+0 + RST 3 + DEFB _BREAK + RET Z + DEC DE + JR PAUSE2 +; +REM: ;REM command +LABEL: ;LABEL command +DATA: ;DATA command +GSUB: ;GOSUB command + DEC HL +DATA0: CALL IFSKSB + OR A + SCF + RET Z + CP ':' + RET Z + JR DATA0 +; +OUT_: ;OUT @port,data + CALL IBYTE + SUB 0E0H + CP 7 + JP C,ER03__ ;E0H .. E6H + CALL HCH2CH + PUSH DE + CALL IBYTE + POP BC + OUT (C),A + RET +; +INP_: ;INP @port,vara + CALL IBYTE + CALL HCH2CH + PUSH DE + CALL INTGTV + CP 5 + JP NZ,ER04 + EX (SP),HL + PUSH BC + EX (SP),HL + POP BC + IN E,(C) + LD D,0 + CALL FLTHEX + POP HL + RET +; +CURSOR_: ;CURSOR x,y + CALL CSRXY + EX DE,HL + RST 3 + DEFB _CURMV + EX DE,HL + RET +; +CSRXY: + LD B,24 + LD C,39 + LD A,(CRTMD2) ;80 char. mode change + CP 3 + JR C,CSRXY3 + LD C,79 +CSRXY3: CALL CSRXY2 + JP C,ER03__ + RET +; +CSRXY2: PUSH BC + CALL IBYTE + PUSH AF + CALL HCH2CH + CALL IBYTE + LD D,E + POP AF + LD E,A + POP BC + LD A,C + CP E + RET C + LD A,B + CP D + RET +; +GETOP: ;GET var + CALL INTGTV + LD (PRCSON),A + CP 5 + JR Z,GETSUJ + PUSH HL ;GET STR + PUSH BC + LD A,0FFH + RST 3 + DEFB _INKEY + OR A + JR Z,NLGTKY + LD HL,(TMPEND) + LD (HL),A + LD A,1 +NLGTKY: POP DE + CALL STRLET + POP HL + RET +; +GETSUJ: PUSH HL + PUSH BC + LD A,0FFH + RST 3 + DEFB _INKEY + SUB 30H + CP 0AH + JR C,$+3 + XOR A + LD E,A + LD D,0 + POP HL + CALL FLTHEX + POP HL + RET +; +POKE: ;POKE ad,d1,d2,d3,... + CALL IDEEXP + CALL CH2CH +POKELP: PUSH DE + CALL IBYTE + POP DE + LD (DE),A + INC DE + CALL TEST1 + DEFM "," + RET NZ + JR POKELP +; +LIMIT: ;LIMIT adrs + PUSH HL + CALL TEST1 + DEFM "M" + JR NZ,LIMIT1 + CALL TEST1 + DEFM "A" + JR NZ,LIMIT1 + CALL TEST1 + DEFM "X" + JR NZ,LIMIT1 + EX (SP),HL + LD HL,(MEMMAX) + JR LIMIT2 +LIMIT1: POP HL + CALL IDEEXP + PUSH HL + LD HL,(MEMMAX) + OR A + SBC HL,DE + JP C,ER06_ + LD HL,(TMPEND) + INC H + INC H + INC H + INC H + OR A + SBC HL,DE + JP NC,ER03__ + EX DE,HL +LIMIT2: CALL MEMSET + POP HL + POP DE + LD SP,(INTFAC) + LD BC,0FFFFH + PUSH BC + PUSH DE + RET +; +RETURN: ;RETURN linenumber + POP IX +RETRN2: POP BC + PUSH BC + LD A,B + INC A + JP NZ,ER14 + LD A,C + CP 12H + JR Z,RETRN6 + CP 0FEH + JP NZ,ER14 + POP BC + CALL ENDCHK + EX DE,HL + POP HL + LD (LNOBUF),HL + POP HL + LD (NXTLPT),HL + POP HL + PUSH IX + RET Z + EX DE,HL + JP GOTO +RETRN6: EX DE,HL + LD HL,12H + ADD HL,SP + LD SP,HL + EX DE,HL + JR RETRN2 +; +GOSUB: ;GOSUB linenumber + PUSH HL + CALL GSUB + EX DE,HL + POP HL + POP BC + PUSH DE + EXX + LD HL,(NXTLPT) + PUSH HL + LD HL,(LNOBUF) + PUSH HL + LD HL,0FFFEH + PUSH HL + LD HL,-512 + ADD HL,SP + LD DE,(TMPEND) + SBC HL,DE + LD A,10 + JP C,NESTER + EXX + PUSH BC + JR GOTO +; +ON: ;ON command + CALL TEST1 + DEFB 0C1H + JP Z,ONERRG ;ON ERROR + CALL IDEEXP + LD C,E + LD B,D + CP 87H + JP NC,ER01 + CP 82H + JR NZ,ON_4 + CALL INCHLF + LD E,81H + CP 0E4H + JR Z,ON_2 + CP 0E0H + JP NZ,ER01 + DEC E +ON_2: LD A,E +ON_4: PUSH HL + LD HL,SJPTBL + SUB 80H + ADD A,A + LD E,A + LD D,0 + ADD HL,DE + CALL INDRCT + EX (SP),HL + INC HL + LD A,B + OR A + JR NZ,ON_9 + LD A,C + OR A + JR Z,ON_9 + LD B,A +ON_6: DEC B + RET Z + CALL HLFTCH + CALL LINE_ + JP NZ,ER01 + CALL DTSKL1 + OR A + RET Z + INC HL + CALL TEST1 + DEFM "," + JR Z,ON_6 + POP DE + JP ENDZ +ON_9: POP DE + JP DATA +; +GOTO: ;GOTO linenumber + CALL GETLIN + EX DE,HL + JR NZ,$+5 + LD HL,(TEXTST) ;GOTO 0 + LD (NXTLPT),HL + XOR A + LD (CONTFG),A + JP NXLINE +; +_IF: ;IF THEN ELSE + CALL EXPR + EX AF,AF + LD A,(DE) + OR A + JR Z,IFALSE + EX AF,AF + CP 0E2H ;THEN + JR NZ,IF_4 +IF_2: CALL INCHLF + CALL LINE_ + JR Z,GOTO +IF_4: POP AF + JP MAIN +; +LINE_: + CP '"' + RET Z +LINE_2: + CP 0BH + RET Z + CP 0CH + RET +; +_ELSE: + CALL IFSKIP + JR NC,$-3 + RET +; +IFALSE: DEC HL + CALL IFSKIP + JR NC,IF_2 + JP ENDLIN +; +IFSKIP: CALL IFSKSB + OR A + SCF + RET Z + CP 0C2H ;ELSE + RET Z + CP 93H ;IF + JR NZ,IFSKIP + CALL IFSKIP + RET C + JR IFSKIP +; +DTSKSB: + INC HL + LD A,(HL) + JR DTSKL1 +; +IFSKSB: + INC HL + LD A,(HL) + CP 94H ;DATA + JR Z,IFDASK +DTSKL1: OR A + RET Z + CP '"' + JR Z,IFDQSK + CP 0FEH ;FUNC/OPTION + JR NC,IFFNRT + CP 97H ;REM + JR Z,IFDASK + CP 27H ;' + JR Z,IFDASK + CP 20H + RET NC + CP 0BH + RET C + CP 15H + JR NC,ISKFLT + INC HL +IFFNRT: INC HL + RET +; +; +IFDASK: LD A,(HL) + OR A + RET Z + CP 3AH + RET Z + CP '"' + JR Z,DADQSK + INC HL + JR IFDASK +; +DADQSK: CALL IFDQSK + OR A + RET Z + INC HL + JR IFDASK +; +ISKFLT: AND 0FH + ADD A,L + LD L,A + LD A,20H + RET NC + INC H + RET +; +IFDQSK: INC HL + LD A,(HL) + OR A + RET Z + CP '"' + RET Z + JR IFDQSK +; +; +BEEP: ;BEEP command + RST 3 + DEFB _BELL + RET +; +BYE: ;BYE command + CALL ENDZ + RST 3 + DEFB _CLRIO + RST 3 + DEFB _MONOP + RET +; +CONSOL: ;CONSOLE x,xl,y,yl + JR Z,CONSOI + LD A,(YS) +; +;CONSCK + LD D,0 + LD E,A + CALL TEST1 + DEFM "," + JR Z,CONSOK + CALL IBYTE + CALL HCH2CH +CONSOK: LD C,E + PUSH BC + CALL IBYTE + POP BC + DEC A + JP M,ER03__ + ADD A,C + CP 25 + JP NC,ER03__ + LD B,A +; + PUSH HL + LD H,B + LD L,C + RST 3 + DEFB _DWIND + POP HL + RET +CONSOI: ;CONSOLE INIT + PUSH HL + LD HL,1800H + RST 3 + DEFB _DWIND + POP HL + RET +; +BOOT: ;BOOT command + DI + OUT (0E4H),A + JP 0 +; +; +SEARCH: ;SEARCH#n "xxxx" + XOR A + DEFB 1 +LIST: ;LIST#n Start-End + LD A,1 + LD (SELTF),A + PUSH AF + CALL GETLU + RST 3 + DEFB _LUCHK +IF RAMDISK + JP C,ER44 +ELSE + JP C,ER64__ +ENDIF + BIT 1,A ;W? +IF RAMDISK + JP Z,__ER59 +ELSE + JP Z,ER64__ +ENDIF + CALL TEST1 + DEFM "," + POP AF + OR A + JR NZ,LIST10 + CALL STREXP ;SEARCH command only + LD A,B + LD (SECLEN),A + LD (SESTR),DE + CALL ENDZ + JR LIST10 +; +LIST0: + LD A,2 + LD (SELTF),A +LIST10: CALL GTSTED + LD (LISTSN),DE + LD (LISTEN),BC + LD A,0FFH + LD (DISPX),A + CALL PUSHR + LD HL,(TEXTST) +LIST20: CALL LDDEMI + LD A,D + OR E + RET Z + EX DE,HL + ADD HL,DE + DEC HL + DEC HL + EX DE,HL + PUSH DE + CALL LDDEMI + PUSH HL + DEFB 21H +LISTSN: DEFS 2 + OR A + SBC HL,DE + JR C,LIST30 + JR Z,LIST30 + POP HL + POP HL + JR LIST20 +; +LIST30: DEFB 21H +LISTEN: DEFS 2 + OR A + SBC HL,DE + JR NC,LIST40 + POP HL + POP HL + RET +; +; +LIST40: EX DE,HL + CALL ASCFIV + RST 3 + DEFB _COUNT + LD HL,KEYBUF + CALL LDHLDE + LD (HL),' ' + INC HL + EX DE,HL + POP HL + CALL CVTXIM + LD A,(SELTF) + OR A + JR NZ,LIST50 + CALL SSEST + JR NC,LIST60 +LIST50: LD DE,KEYBUF + RST 3 + DEFB _COUNT + RST 3 + DEFB _PRSTR + CALL PRTCR +LIST60: POP HL + LD A,(SELTF) + CP 2 + JR Z,LIST20 ;ASCII SAVE + RST 3 + DEFB _HALT + JR LIST20 +; +; +; +; HL=TEXT START ADDRESS +; +SSEST: EX DE,HL +SSESTL: PUSH HL + CALL SSESTS + POP HL + RET C + RET Z + INC HL + JR SSESTL +; +;;;;;;;;;;;;;;;;;;;;;; +; +; ent HL:CMP pointer +; +; ext CY=1 sane string +; CY=0 Acc=0 not same & text end +; Acc=FFH not same chr +; +SSESTS: LD A,(SECLEN) ;String Length + LD B,A + LD DE,(SESTR) ;String address +SSEST0: LD A,(HL) + INC HL + OR A + RET Z + CP 5 + JR Z,SSEST1 + CP 6 + JR NZ,SSEST2 +SSEST1: JR SSEST0 +; +SSEST2: PUSH HL + LD C,A +SSEST4: LD A,(DE) + INC DE + CP 5 + JR Z,SSEST3 + CP 6 + JR NZ,SSEST5 +SSEST3: DEC B + SCF + POP HL + RET Z + PUSH HL + JR SSEST4 +SSEST5: SUB C + POP HL + OR A + RET NZ ;1 Chr not same + DEC B + SCF + RET Z + JR SSEST0 +; +; +SECLEN: DEFS 1 ;Stling length +; +SESTR: DEFS 2 ;Stling Addrsess +; +SSESTW: DEFS 2 ;Line No. +; +SELTF: DEFS 1 ;0:SEARCH , 1:LIST +; +; +KLIST: ;KEY LIST + CALL TESTX + DEFB 87H ;LIST + CALL TESTP + PUSH HL + LD C,0 +KLSTLP: + RST 3 + DEFB _CR + LD A,C + ADD A,'1' + LD D,A + LD E,' ' + CP 3AH + JR NZ,$+5 + LD DE,'0'*256+'1' ; "01" + LD (KEYME2),DE + LD DE,KEYME1 ;'DEF KEY(' + RST 3 + DEFB _MSG + LD A,C + CALL KEYBCL + LD B,(HL) + INC HL + PUSH BC + CALL STKYMS ;(DE)=MSTRING + POP BC + INC C + LD A,C + CP 10 + JR NZ,KLSTLP + RST 3 + DEFB _CR + POP HL + RET +; +STKYMS: LD A,B + OR A + LD C,0 + JR NZ,STKYM1 + LD A,'"' + RST 3 + DEFB _1CX + RST 3 + DEFB _1CX + RET +STKYM1: LD A,(HL) + CP 20H + JR C,CHRME1 + CP '"' + JR Z,CHRME1 + LD A,C + CP 1 + JR Z,CHRM22 + OR A + LD DE,KEYME3 + JR NZ,$+4 + INC DE + INC DE + RST 3 + DEFB _MSG +CHRM22: LD A,(HL) + RST 3 + DEFB _1CX + INC HL + LD C,1 + DJNZ STKYM1 +STKYE2: LD A,'"' +___1CX: + RST 3 + DEFB _1CX + RET +; +CHRME1: LD A,C + CP 0FFH + JR Z,CHRM12 + OR A + LD DE,KEYME4 + JR NZ,$+4 + INC DE + INC DE + RST 3 + DEFB _MSG +CHRM16: PUSH BC + PUSH HL + LD L,(HL) + LD H,0 + CALL ASCFIV + RST 3 + DEFB _MSG + POP HL + POP BC + INC HL + LD C,0FFH + DJNZ STKYM1 + LD A,')' + JP ___1CX +; +CHRM12: LD A,',' + RST 3 + DEFB _1CX + JR CHRM16 +; +KEYME1: DEFM "DEF KEY(" + +KEYME2: DEFS 2 + DEFM ")=" + DEFB 0 +KEYME3: DEFM ")+\"" + DEFB 0 +KEYME4: DEFM "\"+CHR$(" + + DEFB 0 + +; +DEFOP: ;DEF command + CALL TEST1 + DEFM 0B2H + JR Z,DEFKEY ;DEF KEY(n)="..." + CALL TESTX + DEFB 0FFH + CALL TESTX + DEFB 0C7H + JP DEFFN ;DEF FNx(x)=expr +; +DEFKEY: + CALL TESTX + DEFM "(" + CALL IBYTE + CALL TESTX + DEFM ")" + CALL TESTX + DEFB 0F4H ;= + LD A,E + DEC A + CP 10 + JP NC,ER03__ + PUSH HL + CALL KEYBCL + EX (SP),HL + CALL STREXP ;A,DE + EX (SP),HL + LD A,B + CP 16 + JR C,$+4 + LD A,15 + LD (HL),A + OR A + JR Z,ESCKPT + LD B,A + INC HL + LD A,(DE) + LD (HL),A + INC DE + INC HL + DJNZ $-4 +ESCKPT: POP HL + EI + RET +; +; +KEYBCL: ADD A,A + ADD A,A + ADD A,A + ADD A,A + LD HL,FUNBUF + JP ADDHLA +; +; END (6C81) + +STMNT_END: +DEFS $6C81-STMNT_END + +; ORG 6C81H + +; -------------------------- +; MZ-800 BASIC IOCS command +; FI:IOCS ver 1.0B 9.20.84 +; Programed by T.Miho +; -------------------------- +; + +; +; +;defc RUNRFL = 11A4H ;KEYBUF label +;defc BKEYBF = 11A5H ;KEYBUF+1 label +defc RUNRFL = KEYBUF +defc BKEYBF = KEYBUF+1 + +; +; +; +; +CRTLU_: LD A,(ZLOG) + CP CRTLU + RET +; +PRTEXP: + CALL EXPR + LD A,(PRCSON) + CP 3 + PUSH HL + EX DE,HL + JR Z,PRTEX2 + CALL CVNMFL + POP HL + RST 3 + DEFB _COUNT + RET +PRTEX2: CALL CVTSDC + POP HL + RET + +; +; PRINT command +; +PRINT: + XOR A + LD (DISPX),A + CALL GETLU + RST 3 + DEFB _LUCHK + JP C,ER44 ;not open + BIT 2,A ;X? + JP NZ,PRX + BIT 1,A ;W? + JP Z,__ER59 ;can't exec + CALL LU2CH + CALL CRTLU_ + JR NZ,PRT04 + LD A,(SELCOL) + LD (COL),A + CALL TEST1 + DEFM "[" + JR NZ,PRT04 + CALL COLCHK + LD (COL),A + CALL TESTX + DEFM "]" +PRT04: CALL ENDCHK + JP Z,PRTCR +PRT10: LD A,(HL) + CP 0E3H ;USING + JR Z,PRUSNG + LD BC,PRT20 + PUSH BC ;Return adrs + CP ';' + RET Z + CP ',' + RET Z + CP 0E6H ;TAB + JR Z,PRTAB + CALL PRTEXP + JP PRTMS2 +; +PRT20: CALL ENDCHK + JP Z,PRTCR + CP ',' + JR NZ,PRT30 + + CALL CRTLU_ + JR C,PRT25 + LD IX,(ZPOS) + CALL IOCALL ;TAB10 + LD B,A + SUB 10 + JR NC,$-2 + NEG + LD B,A + CALL PRTAB2 + JR PRT30 +PRT25: CALL PRTCR +PRT30: LD A,(HL) + CP ',' + JR Z,$+4 + CP ';' + JR NZ,$+3 + INC HL + CALL ENDCHK + RET Z + JR PRT10 +; +PRTAB: CALL CRTLU_ + JP C,__ER59 + CALL ICH28H + CALL IBYTE + CALL HCH29H + LD IX,(ZPOS) + CALL IOCALL + SUB E + RET NC + NEG + LD B,A + CALL CRTLU_ + LD A,13H ;Cursor right + JR Z,$+4 +PRTAB2: LD A,' ' + LD DE,BKEYBF + PUSH BC + PUSH DE + CALL SETDE + POP DE + POP BC + JR PRTMS2 +; SKP 3 +; +PRUSNG: INC HL ;PRINT USING + CALL STREXP + LD A,B + OR A + JP Z,ER03__ + PUSH HL + LD HL,BKEYBF + PUSH HL + PUSH BC + CALL LDHLDE + POP BC + LD A,0F0H + LD E,B + LD D,0 + INC DE + RST 3 + DEFB _OPSEG + LD (USINGS),HL + LD (USINGP),HL + POP DE + CALL LDHLDE + LD (HL),0 + POP HL +PRUSG2: CALL ENDCHK + JR Z,PRUSG8 + INC HL + CP ',' + JR Z,PRUSG4 + CP ';' + JP NZ,ER01 +PRUSG4: CALL ENDCHK + JR Z,PRUSG9 + CALL EXPRNX + PUSH HL + LD BC,(TMPEND) + PUSH BC + CALL USNGSB + POP DE + CALL PRTMSG + POP HL + JR PRUSG2 +PRUSG8: CALL PRTCR +PRUSG9: LD A,0F0H + RST 3 + DEFB _DLSEG + RET + +; +CR_TXT: + defb $0d, 0 +; +PRTCR: + ld de,CR_TXT ;FMP + +;print message +; +PRTMSG: + RST 3 + DEFB _COUNT +PRTMS2: CALL CRTLU_ + JR Z,PRTMC + RST 3 + DEFB _PRSTR + RET +; +PRTMC: PUSH AF + LD A,(COL) + RST 3 + DEFB _DCOL + POP AF + RST 3 + DEFB _PRSTR + LD A,(SELCOL) + RST 3 + DEFB _DCOL + RET +; +; +; READ command +; +READ: + LD A,DATLU + LD (ZLOG),A + JR INP10 +; +; INPUT command +; +INPUT: ;INPUT command + CALL GETLU + RST 3 + DEFB _LUCHK + JP C,ER44 ;not open + BIT 2,A ;X? + JP NZ,INX + BIT 0,A ;R? + JP Z,__ER59 ;can't exec + CALL LU2CH + CALL CRTLU_ + JR NZ,INP10 + CALL HLFTCH + CP '"' + LD DE,MEM_IN + LD B,2 + JR NZ,INP05 + CALL STREXP + CALL TESTX + DEFM ";" +INP05: LD A,B + OR A + JR Z,INP10 +INP07: LD A,(DE) + INC DE + RST 3 + DEFB _CRT1C + DJNZ INP07 +INP10: LD (INPSP+1),SP + LD DE,(VARED) + LD (TMPEND),DE +INP15: LD DE,(TMPEND) + CALL MEMECK + CALL INTGTV + PUSH AF + PUSH BC + CALL ENDCHK + JR Z,INP20 + CALL CH2CH + JR INP15 +; +ER44: LD A,44 ;not opened + DEFB 21H +__ER59: LD A,59+80H ;can't exec + JP ERRORJ +; +MEM_IN: DEFM "? " +; +; +INP20: XOR A + PUSH AF ;END=00 + PUSH HL + RST 3 + DEFB _INSTT + LD HL,(INPSP+1) + DEC HL +INP24: LD A,(HL) + OR A + JR Z,INP30 + DEC HL + DEC HL + LD B,(HL) + DEC HL + LD C,(HL) + DEC HL + PUSH HL + PUSH AF ;Type + PUSH BC ;Adrs + LD DE,(TMPEND) + CALL INPMX + LD H,0 + LD L,B + ADD HL,DE + LD (HL),0 + POP DE ;Adrs + POP AF ;Type + CALL INSUB + POP HL + JR INP24 +INP30: POP HL +INPSP: LD SP,0 ;xxx + RET +; +INPMX: LD A,(ZLOG) + CP DATLU + JR Z,DATINP + RST 3 + DEFB _INMSG + RET + +; +; +INSUB: CP 3 ;String ? + JR NZ,INSUB4 ; No + LD HL,(TMPEND) ; Yes + LD A,B + JP STRLET +; +INSUB4: PUSH DE + LD HL,(INTFAC) + LD DE,(TMPEND) + EX DE,HL + CALL HLFTCH + CP 'E' + JP Z,ER03__ + EX DE,HL + CALL CVFLAS + EX DE,HL + CALL TEST1 + DEFM 0 + JP NZ,ER03__ + EX DE,HL + POP DE + JP LDIR5 + +; +; RESTORE command +; +RESTOR: + XOR A + LD (DATFLG),A + CALL ENDCHK + CALL NZ,GETLIN + EX DE,HL + CALL NZ,DTSRCX + EX DE,HL + JP DATA ;ON RESTORE +; +DATINP: PUSH HL + PUSH DE + CALL DATINX + POP DE + POP HL + RET +; +DATIN0: LD HL,(TEXTST) + CALL DTSRCX +DATINX: LD A,(DATFLG) ;read flag + CP 1 ;0 is restore top + JP Z,ER24 ;1 is out of data + JR C,DATIN0 ;2 is ok + LD HL,(DATPTR) ;read pointer + LD C,':' + RST 3 + DEFB _INDAT + LD (DATPTR),HL ;read pointer + CALL ENDCHK + SCF + CCF + RET NZ + DEC HL +DTSRCH: CALL DTSKSB ;DATA search + OR A + JR NZ,DTSRC4 + INC HL +DTSRCX: LD A,(HL) + INC HL + OR (HL) + LD A,1 + JR Z,DTSRC9 + INC HL + INC HL + JR DTSRCH +DTSRC4: CP 94H ;DATA + JR NZ,DTSRCH + INC HL + LD (DATPTR),HL ;read pointer + LD A,2 +DTSRC9: LD (DATFLG),A ;read flag + RET + +; +; GETLU ... interpret #n, /P, /T +; ent HL: pointer +; ext HL: pointer +; A: LU# +; +GETLU: + CALL TEST1 + DEFM "#" + JR NZ,GETLU2 + CALL HLFTCH + CP 20H + JP NC,ER01 + PUSH DE + PUSH BC + LD DE,ZFAC + PUSH DE + CALL FACNUM + EX (SP),HL + CALL HLFLT + LD A,H + OR A + JP NZ,ER64__ + OR L + JP Z,ER64__ + JP M,ER64__ + POP HL + POP BC + POP DE + RET +GETLU2: + CALL TEST1 + DEFB 0FBH ;/ + LD A,CRTLU + RET NZ + CALL TEST1 + DEFM "P" + LD A,LPTLU + RET Z + CALL TESTX + DEFM "T" + LD A,CMTLU + RET +; +; +LU2CH: LD A,(ZLOG) + OR A + RET M + JP HCH2CH + +; +; DEFAULT "dev:" +; +DEFAULT: + CALL DEVNAM + RST 3 + DEFB _SETDF + RET +; +; INIT "dev:command" +; +INIT: + CALL ENDCHK + LD B,0 + CALL NZ,STREXP +; +INIT2: PUSH HL + RST 3 + DEFB _DEVNM + RST 3 + DEFB _FINIT + POP HL + RET +; +; +; ROPEN, WOPEN, XOPEN +; +ROPEN: + LD A,1 + DEFB 1 +WOPEN: + LD A,2 + DEFB 1 +XOPEN: + LD A,4 + PUSH AF + LD (ZRWX),A + CALL GETLU + CP CRTLU + JR NZ,$+4 + LD A,CMTLU + LD (ZLOG),A + CALL LU2CH + CALL ELMT + POP AF + CP 4 ;X + JR Z,$+4 +OPN_B: LD A,3 ;BSD + LD (ELMD),A + PUSH AF + RST 3 + DEFB _RWOPN + LD A,(ELMD) + POP BC + CP B + JP NZ,ER61_ + RET + +; +; CLOSE/KILL command +; +CLOSE: + DEFB 0F6H +KILL: + XOR A + LD B,A + CALL ENDCHK + JR Z,CLALL ;all files +CLKL2: CALL GETLU + CP CRTLU + RET NC + RST 3 + DEFB _CLKL + CALL TEST1 + DEFM "," + JR CLKL2 +; +CLALL: XOR A + RST 3 + DEFB _CLKL + RET +; +; +ELMT: + CALL END2C + LD B,0 + CALL NZ,STREXP + PUSH HL + RST 3 + DEFB _DEVFN + POP HL + RET + +; +DEVNAM: PUSH HL + CALL HLFTCH + LD DE,ELMWRK + LD B,1 + CALL ELMCK + CALL NC,ELMCK + JR C,DEVNM2 + CALL ELMCK + CALL TSTNUM + CALL ELMCK2 + CALL ENDCHK + JR NZ,DEVNM2 + LD A,':' + LD (DE),A + POP AF ;dummy + LD DE,ELMWRK + JR DEVNM4 +DEVNM2: POP HL + CALL ENDCHK + LD B,0 + CALL NZ,STREXP +DEVNM4: PUSH HL + RST 3 + DEFB _DEVNM + INC (HL) + DEC (HL) + JP NZ,ER58__ + POP HL + RET +; +ELMCK: CP 'A' + RET C + CP 'Z'+1 + CCF +ELMCK2: RET C + LD (DE),A + INC HL + INC DE + LD A,(HL) + INC B + RET +; +ELMWRK: DEFS 4 + +; +; LOAD "dev:filename" +; +IF MOD_B + DEFB 0CDH ; (CALL): This is useless, it is unclear why the "LOAD" function was shifted on MOD B +ENDIF + +LOAD: + CALL TEST1 + DEFB 0E5H ;ALL + + JR NZ,_LOAD_2 + XOR A +__LSALL: + RST 3 + DEFB _LSALL + RET + +_LOAD_2: + CALL ELMT + CALL TEST1 + DEFM "," + JP Z,LOADA + PUSH HL + CALL LDRDY + DEC A + JR Z,LDOBJ + DEC A + JP NZ,ER61_ ;il file mode + CALL CKCOM + CALL CLRVAR + CALL LDFIL + JR LOAD9 + +LDOBJ: LD HL,(ELMD22) ;load addr + PUSH HL + LD DE,(MEMLMT) + CALL COMPR + LD DE,(ELMD20) ;size + LD BC,(MEMMAX) + + CALL NC,MEMOBJ + JP C,ER18 + POP HL + RST 3 + DEFB _LOADF +LOAD9: +IF RAMDISK + JP SEEK_0 +IF MOD_B + NOP +ELSE + NOP + NOP +ENDIF +ELSE + CALL LDEND + POP HL + RET +ENDIF +; + + +MEMOBJ: ADD HL,DE + RET C + EX DE,HL + LD HL,BC +COMPR: + PUSH HL + OR A + SBC HL,DE + POP HL + RET + +; +; CHAIN "dev:filename" +; +CHAIN: + CALL ELMT + CALL LDRDY + CP 2 + JP NZ,ER61_ ;il file mode + LD A,(LSWAP) + OR A + JP Z,RUN2 + JP SWAP2 + +; +; MERGE "dev:filename" +; +MERGE: + CALL CKCOM + CALL ELMT + CALL TEST1 + DEFM "," + JR Z,MERGEA + RST 3 + DEFB _LOPEN + CP 2 + JP NZ,ER61_ + PUSH HL + LD HL,(VARED) + LD (TMPEND),HL + LD BC,1000 + ADD HL,BC + JP C,ER06_ + PUSH HL + LD BC,(ELMD20) ;size + INC B + ADD HL,BC + JP C,ER06_ + SBC HL,SP + JP NC,ER06_ + POP HL + PUSH HL + RST 3 + DEFB _LOADF + POP HL + CALL MERGE0 + POP HL + RET +; +MERGE0: CALL LDDEMI + LD A,D + OR E + RET Z + PUSH DE + CALL LDDEMI + PUSH HL + LD HL,DE + LD (EDLINE),HL + CALL DELSUB + POP HL + POP BC + PUSH BC + PUSH HL + CALL INSTLIN + POP HL + POP BC + ADD HL,BC + DEC HL + DEC HL + DEC HL + DEC HL + JR MERGE0 + +; +; LOAD/MERGE/RUN ascii +; +LOADA: CALL CKCOM + LD A,1 + DEFB 1 +MERGEA: LD A,0 + DEFB 1 +RUNA: LD A,2 + PUSH AF + CALL TESTX + DEFM "A" + CALL ENDZ + LD A,1 + LD (ZRWX),A + LD A,LDALU + LD (ZLOG),A + CALL OPN_B + POP AF + PUSH AF + PUSH HL ;RJOB + LD HL,0 + LD DE,0FFFFH + OR A + CALL NZ,DELSUB ;load/run only + LD A,LDALU + RST 3 + DEFB _LUCHK + LD HL,(VARED) + LD (TMPEND),HL + LD BC,1000 + ADD HL,BC + JP C,ER06__ + PUSH HL ;load start adrs + LD (LDAPTR),HL +LDA2: LD HL,-512 + ADD HL,SP + LD DE,(LDAPTR) + SBC HL,DE + JP C,ER06__ + LD DE,(TMPEND) + RST 3 + DEFB _INMSG + LD A,B + OR A + JR Z,LDA4 + CALL CVBCAS + LD A,B + OR C + JP Z,ER03__ + LD HL,(LDAPTR) + PUSH HL ;load pointer + INC HL + INC HL + LD (HL),C + INC HL + LD (HL),B + INC HL + PUSH HL + LD HL,DE + CALL TEST1 + DEFB 0 + JP Z,ER03__ + POP HL + LD A,(DE) + CP ' ' + JR NZ,$+3 + INC DE + CALL CVIMTX + LD (HL),0 + INC HL + LD (LDAPTR),HL + POP DE ;old load pointer + OR A + SBC HL,DE + EX DE,HL ;DE := length + LD (HL),E + INC HL + LD (HL),D + JR LDA2 +LDA4: LD HL,(LDAPTR) + CALL LDHL00 + CALL CLR + POP HL ;load start adrs + CALL MERGE0 + POP HL ;RJOB + POP AF + CP 2 ;RUN ? + RET NZ ;no (load/merge) + JP RUNX ;RUN from text-top +; +LDAPTR: DEFS 2 + +; +; RUN "dev:filename" +; +FRUN: + CALL ELMT + PUSH HL + CALL TEST1 + DEFM "," + JR NZ,RUN1 + CALL HLFTCH + CP 'A' + JP Z,RUNA +RUN1: CALL LDRDY + POP HL + DEC A + JR Z,RUNOBJ + DEC A + JP NZ,ER61_ ;il file mode + CALL CLRVAR +RUN2: CALL LDFIL ;jump from CHAIN + CALL LDEND + JP RUNX +; +RUNOBJ: LD D,0 ; normal + LD BC,0FF00H + CALL TEST1 + DEFM "," + JR NZ,RUNOB2 + CALL TESTX + DEFM "R" + LD D,1 ;,R + LD BC,0CFF0H +RUNOB2: LD A,D + LD (RUNRFL),A ;,R flag + LD HL,(ELMD20) ;size + LD DE,(ELMD22) ;load addr + PUSH HL + CALL MEMOBJ + POP DE ;size + LD HL,_BASIC ;load file area + LD BC,0FF00H + CALL NC,MEMOBJ + JP C,ER06_ + LD SP,0 + CALL CLPTR + XOR A + LD (LOADFG),A + LD A,36H ;count0 mode3 + OUT (0D7H),A ;8253 mode set + LD A,1 + OUT (0D3H),A ;8253 music enable + LD HL,(ELMD22) ;load addr + LD DE,(TMPEND) + CALL COMPR + JR NC,RUNOB3 +; +; destroy BASIC +; + PUSH HL + LD HL,_BASIC ;load file area + LD (TEXTST),HL + CALL CLPTR + LD HL,RUNOBE-PRXFER+BKEYBF + LD (ERRORP),HL + POP HL +; +RUNOB3: LD DE,(TMPEND) + CALL COMPR + JR NC,$+3 + EX DE,HL + PUSH AF + PUSH HL + LD HL,PRXFER + LD DE,BKEYBF + PUSH DE + LD BC,RUNTBE-PRXFER + LDIR + RET ;JP BKEYBF +; +; +; ORG BKEYBF +; +PRXFER: POP HL + RST 3 + DEFB _LOADF + LD A,0C3H ;int tbl make + LD HL,038DH + LD (1038H),A + LD (1039H),HL + LD A,01H ;320*200 4 color + RST 3 ; Software - Execute command + DEFB _DSMOD ; Code 80 screen - set operating mode + RST 3 ; Software - Execute command + DEFB _DI ; Code 16 disable interrupts + EX AF,AF + LD A,(RUNRFL) ;run" " ,r + OR A + CALL NZ,INITIO-PRXFER+BKEYBF + EX AF,AF + LD HL,(ELMD24) ;exec addr + LD A,H + OR L + EXX + LD HL,(TMPEND) ;data store addr + LD DE,(ELMD22) ;load addr + LD BC,(ELMD20) ;size + OR D + OR E + JR Z,PROX0 + LD A,0E9H ;jp (hl) + LD (PRO70P-PRXFER+BKEYBF),A +PROX0: EXX + POP AF ;ldir flg + PUSH HL ;store exec addr + LD HL,PROFF-PRXFER+BKEYBF ; Copy PROFF at $FF00 + LD DE,0FF00H + LD BC,PRO80E-PROFF + LDIR + EXX + JP 0FF00H +; +; ORG 0FF00H +; +PROFF: JR NC,RUNOB4 + LDIR +RUNOB4: EX AF,AF + RET Z ;,R + IN A,(LSDMD) ;check dipsw + AND 2 + LD A,0 ;mode 800 + OUT (LSDMD),A ; 800 mode + LD HL,PRO800-PROFF+0FF00H + LD BC,PRO80E-PRO800 + JR NZ,MODSET_ +; + LD A,8 ;mode 700 + OUT (LSDMD),A ;700 or 800 mode + IN A,(LSE0) ;CG xfer + LD HL,1000H + LD DE,0C000H + LD BC,1000H + LDIR + IN A,(LSE1) +; + LD HL,PRO700-PROFF+0FF00H + LD BC,PRO70E-PRO700 +MODSET_: + LD DE,0CFF0H + LDIR + POP HL + LD SP,IBUFE + LD DE,0D800H ;vram2 for 700 mode + JP 0CFF0H +; +RUNOBE: + RST 3 + DEFB _ERRX + RST 3 + DEFB _ERCVR + RST 3 + DEFB _DI + HALT + +; ORG CFF0H +PRO700: + OUT (LSE4),A +PRO701: LD A,71H ;blue and white + LD (DE),A ;vram2 clr + INC DE + LD A,D + CP 0E0H + JR NZ,PRO701 +PRO70P: OUT (LSE0),A ;jp (hl) + JP (HL) +PRO70E: +; +; ORG CFF0H +PRO800: + OUT (LSE0),A ;700mon rom bank off + OUT (LSE3),A ;800mon rom bank on + JP (HL) +PRO80E: +; +; +; +INITIO: + PUSH AF + DI ;run "file name",r + IM 1 + LD HL,RUNTBL-PRXFER+BKEYBF + LD B,17 + RST 3 + DEFB _IOOUT ;io dev init + POP AF + RET +; +; +; +RUNTBL: +; pio channel a + DEFW 0FC00H ; int vecter + DEFW 0FCCFH ; mode 3 (bit mode) + DEFW 0FC3FH ; i/o reg. set + DEFW 0FC07H ; int seqence (disenable) +; pio channel b + DEFW 0FD00H ; int vecter + DEFW 0FDCFH ; mode 3 (bit mode) + DEFW 0FD00H ; i/o reg. set + DEFW 0FD07H ; int seqence (disenable) +; + DEFW 0D774H ;8253 C1 mode 2 + DEFW 0D7B0H ; C2 mode 0 + DEFW 0D6C0H ;counter2 12h + DEFW 0D6A8H ; + DEFW 0D5FBH ;counter1 1s + DEFW 0D53CH ; + DEFW 0D305H ;8253 int ok + DEFW 0CD01H ;RF mode 700 + DEFW 0CC01H ;WF mode 700 +RUNTBE: +; + +; +LDRDY0: LD HL,(VARED) + LD (TMPEND),HL + LD DE,(POOL) + LD (OLDPOOL),DE + OR A + SBC HL,DE + LD (VARLN),HL + LD HL,-256 + ADD HL,SP + LD (LAST),HL + LD DE,(VARED) + PUSH HL + OR A + SBC HL,DE + JP C,ER06_ + EX (SP),HL + EX DE,HL + LD BC,(VARLN) + INC BC + LDDR + POP DE + RST 3 + DEFB _ADDP0 + LD A,1 + LD (LOADFG),A + RET +; +LDRDY: CALL LDRDY0 + RST 3 + DEFB _LOPEN + LD A,(ELMD) + RET +; +CLRVAR: LD HL,(VARED) + XOR A + DEC HL + LD (HL),A + DEC HL + LD (HL),A + LD (STRST),HL + DEC HL + LD (HL),A + LD (VARST),HL + DEC HL + LD (HL),A + LD (POOL),HL + LD HL,4 + LD (VARLN),HL + RET +; +OLDPOOL:DEFS 2 +VARLN: DEFS 2 +LAST: DEFS 2 +LOADFG: DEFB 0 +; +CKCOM: + PUSH AF + CALL _DIRECT + JP NZ,ER19 + POP AF + RET + +; +LDFIL: LD BC,(ELMD20) + PUSH BC + LD HL,(POOL) + LD DE,(TEXTST) + OR A + SBC HL,DE ;HL := text area size + LD L,0 + SBC HL,BC + JP C,ER06_ + LD HL,0 + LD (OLDPOOL),HL + CALL RUNINT + LD HL,0 + LD (LNOBUF),HL + LD HL,(TEXTST) + RST 3 + DEFB _LOADF + POP BC + LD HL,(TEXTST) + ADD HL,BC + LD (OLDPOOL),HL + RET +; +LDEND: + LD A,LDALU + LD B,0 + RST 3 + DEFB _CLKL + LD HL,LOADFG + LD A,(HL) + OR A + RET Z + LD (HL),0 + LD HL,(OLDPOOL) + LD A,H + OR L + JR NZ,LDEND2 + LD HL,(TEXTST) + CALL LDHL00 +LDEND2: EX DE,HL + LD HL,(POOL) + LD BC,(VARLN) + LDIR + EX DE,HL + OR A + SBC HL,DE + EX DE,HL + RST 3 + DEFB _ADDP0 + RET + +; +; VERIFY "CMT:filename" +; +VERIFY: + PUSH HL + CALL REFLNX + POP HL + CALL ELMT + PUSH HL + RST 3 + DEFB _LOPEN + CP 2 + JP NZ,ER61_ + LD HL,(TEXTST) + RST 3 + DEFB _VRFYF + POP HL + RET +; +; SAVE "dev:filename" +; +SAVE: + CALL TEST1 + DEFB 0E5H ;ALL + LD A,1 + JP Z,__LSALL + PUSH HL + CALL REFLNX + POP HL + CALL ELMT + CALL TEST1 + DEFM "," + JR Z,SAVEA + PUSH HL + LD A,2 + LD (ELMD),A + LD HL,(POOL) ; I/O work area, just after the BASIC program space (=TEXTST) + LD DE,(TEXTST) + OR A + SBC HL,DE + LD (ELMD20),HL + LD A,(ELMD1) + CP 0DH + JP Z,ER60_ + RST 3 + DEFB _SAVEF + POP HL + RET +; +SAVEA: + CALL TESTX + DEFM "A" + PUSH HL + LD A,2 + LD (ZRWX),A + LD A,LDALU + LD (ZLOG),A + CALL OPN_B + POP HL + CALL LIST0 + CALL PRTCR + LD B,1 + LD A,LDALU + RST 3 + DEFB _CLKL + RET + +; +; LOCK/UNLOCK "dev:filename" +; +UNLOCK: + XOR A + DEFB 1 +LOCK: + LD A,1 + PUSH AF + CALL STREXP + RST 3 + DEFB _DEVFN + POP AF + RST 3 + DEFB _LOCK + RET +; +; DIR[#n] "dev:" +; DIR[/P] dev +; +DIR: + CALL GETLU + PUSH AF ;lu# + RST 3 + DEFB _LUCHK + JP C,ER44 + BIT 1,A ;W? + JP Z,__ER59 + CALL LU2CH + CALL DEVNAM + LD B,A ;ch# + XOR A + RST 3 + DEFB _DIR ;read directory + LD A,B ;A=ch# + RST 3 + DEFB _SETDF ;set default + POP AF ;A=lu# + RST 3 + DEFB _DIR ;print directory + RET +; +; DELETE "dev:filename" +; +FDEL: + CALL STREXP + RST 3 + DEFB _DEVFN + RST 3 + DEFB _DELET + RET +; +; RENAME "dev:oldname","newnae" +; +RENAME: + CALL STREXP + RST 3 + DEFB _DEVFN + CALL HCH2CH + CALL STREXP + RST 3 + DEFB _RENAM + RET + +; +; random file access +; +PRX: CALL RAN0 +PRX2: CALL PRTEXP + RST 3 + DEFB _PRREC + CALL ENDCHK + RET Z + CALL CH2CH + JR PRX2 +; +; +INX: CALL RAN0 + LD DE,(TMPEND) + CALL MEMECK +INX2: CALL INTGTV + PUSH HL + PUSH AF + PUSH BC + LD DE,(TMPEND) + RST 3 + DEFB _INREC + POP DE + POP AF + CALL INSUB + POP HL + CALL ENDCHK + RET Z + CALL CH2CH + JR INX2 +; +RAN0: + CALL TEST1 + DEFM "(" + RET NZ + CALL IDEEXP + LD A,D + OR E + JP Z,ER03__ + RST 3 + DEFB _RECST + CALL HCH29H + CALL TEST1 + DEFM "," + RET +; + +; +; SWAP "dev:filename" +; +SWAP: + LD A,(LSWAP) + OR A + JP NZ,ER25 + PUSH HL + LD B,0 + RST 3 + DEFB _DEVNM + LD (SWAPDV),DE + LD (SWAPCH),A + LD HL,(POOL) ; I/O work area, just after the BASIC program space (=TEXTST) + LD DE,(TEXTST) + XOR A + SBC HL,DE + LD (ELMD20),HL + RST 3 + DEFB _SWAP + POP HL + CALL ELMT + CALL ENDZ + LD A,(ZFLAG1) + BIT __RND,A + JP Z,__ER59 + PUSH HL ;RJOB + LD HL,(SWAPNB) + ADD HL,SP + LD SP,HL + EX DE,HL + LD HL,SWAPDS + LD BC,(SWAPBY) + LDIR + CALL LDRDY + CP 2 + JP NZ,ER61_ + LD (SWAP2+1),SP +SWAP2: LD SP,0 ;jump from CHAIN + CALL LDFIL + CALL LDEND + LD HL,0FFFDH + PUSH HL ;SWAP flag + PUSH HL + LD A,1 + LD (LSWAP),A + LD HL,(TEXTST) + JP NXLINE +; +; Recover SWAP +; +BSWAP: + XOR A + LD (LSWAP),A + POP IX +BSWAP2: POP BC + LD A,B + CP 0FFH + JP NZ,ER25 + LD A,C + CP 0FDH + JR Z,BSWAP6 + CP 0FEH + LD HL,4 + JR Z,BSWAP4 + CP 12H + LD HL,10H + JP NZ,ER25 +BSWAP4: ADD HL,SP + LD SP,HL + JR BSWAP2 +; +BSWAP6: LD DE,(SWAPDV) + LD A,(SWAPCH) + RST 3 + DEFB _SETDF + LD B,0 + RST 3 + DEFB _DEVNM + CALL LDRDY0 + OR 0FFH + RST 3 + DEFB _SWAP + CALL LDFIL + CALL LDEND + LD HL,0 + ADD HL,SP + LD DE,SWAPDS + LD BC,(SWAPBY) + LDIR + LD SP,HL + POP HL ;RJOB + RET +; +SWAPDV: DEFS 2 +SWAPCH: DEFS 1 +; +; I/O initial for cold-start +; +IOINIT: + POP HL + PUSH HL + LD (ERRORP),HL + LD A,'1' + CALL IOINI2 + LD A,'2' + CALL IOINI2 + LD DE,INITD3 + LD B,INITD4-INITD3 + JR IOINI4 +IOINI2: LD (INITD1+2),A + LD DE,INITD1 + LD B,INITD3-INITD1 +IOINI4: JP INIT2 +; +INITD1: DEFM "RS?:0,$8C,13" + + +INITD3: DEFM "CMT:T" + +INITD4: +; + +; END (7590H) + + + +; ORG 7590H + + +; ----------------------------- +; MZ-800 BASIC Graphic command +; FI:GRPH ver 1.0B 9.21.84 +; Programed by T.Miho +; ----------------------------- +; + +; +BITFU2: DEFB 0 ;Default W0/W1 +COL: ;Color code + DEFB 03H +; +;;;;;;;;;;;;;;; +; +; SET/RESET [c,w]x,y +; +SET: + DEFB 0F6H +RESET: + XOR A + PUSH AF + CALL COORD0 + RST 3 + DEFB _POSSV + POP AF ;SET/RESET + PUSH HL + EXX + RST 3 + DEFB _PSET + POP HL + RET +; +;;;;;;;;;;;;;;;;;; +; +; LINE/BLINE [c,w] x0,y0,x1,y1,..... +; +LINE: + DEFB 0F6H +BLINE: + XOR A + LD (LINE4+1),A + CALL COORD0 + CALL HCH2CH +LINE2: EXX + PUSH HL ;YS + PUSH DE ;XS + EXX + CALL COORD + POP DE ;XS + EX (SP),HL ;YS,Text + EXX +LINE4: LD A,0 ;LINE/BLINE + RST 3 + DEFB _LINE + POP HL + CALL TEST1 + DEFM "," + JR Z,LINE2 + RST 3 + DEFB _POSSV + RET + +; +;;;;;;;;;;;;;;;;;;;;;;;; +; +; PATTERN [C,W] N,X$ +; +PATTER: + CALL COLCON + CALL IDEEXP + XOR A + BIT 7,D + JR Z,GRDSP4 + PUSH HL + LD H,A + LD L,A + SBC HL,DE + EX DE,HL + POP HL + LD A,1 +GRDSP4: EX AF,AF + LD A,D + OR A + JR NZ,ER03A + LD A,E + PUSH AF + EX AF,AF + PUSH AF + CALL HCH2CH + CALL STREXP + POP AF + LD C,A + POP AF + PUSH HL + LD H,C + RST 3 + DEFB _PATTR + POP HL + CALL ENDCHK + JR NZ,PATTER + RET + +;;;;;;;;;;;;;;;;;;; +; +; POSITION x,y +; +POSITI: + CALL COORD + RST 3 + DEFB _POSSV + RET +; +; Get X-Y coordinate +; +COORD0: CALL COLCON +COORD: CALL COORD1 ;Get x,y coordinate + PUSH DE + CALL TEST1 + DEFB ',' + CALL COORD1 + PUSH DE + EXX + POP HL + POP DE + EXX + RET +; +; +COORD1: CALL IDEEXP + LD A,D ;0000 ... 3FFF + ADD A,40H ;C000 ... FFFF + RET P +ER03A: JP ER03__ + +;;;;;;;;;;;;;;;;;;;;;;; +; +; color palette +; +PALET: + CALL ENDCHK + JP Z,ER01 + CALL PALRD + CALL COLCK2 + AND 03H + PUSH AF + LD A,(PALBK) + LD D,E + SRL D + SRL D + CP D + JP NZ,ER22 + CALL TESTX + DEFB ',' + CALL PALRD + LD B,A + POP AF + RST 3 + DEFB _DPLST + RET +; +PALRD: CALL IBYTE + CP 16 ;0 .. 15 check + JR NC,ER03A + RET +; + +;;;;;;;;;;;;;;;;;;;; +; +; BOX [c,w] xs,ys,xe,ye +BOX: + CALL COORD0 + EXX + PUSH HL ;YS + PUSH DE ;XS + EXX + CALL HCH2CH + CALL COORD + EXX + PUSH HL ;YE + PUSH DE ;XE + EXX + CALL ENDCHK + JR Z,BOX9 + CALL CH2CH + CALL ENDCHK + LD A,(COL) + CALL NZ,COLCHK + SCF +BOX9: EXX + POP DE + POP HL + EXX + POP DE + EX (SP),HL + RST 3 + DEFB _BOX + POP HL + RET + +; +;;;;;;;;;;;;;;;;;; +; +; COLOR c,w +; +COLOR: + CALL COLSUB + LD A,(COL) + RST 3 + DEFB _DCOL + LD (SELCOL),A + LD A,(PWMODE) + LD (BITFU2),A + CALL ENDZ + RET +; +;;;;;;;;;;;;;;;; +; +; COLOR CONTROL EXP +; +COLCON: + CALL TEST1 + DEFM "," + CALL TEST1 + DEFM "[" + JR NZ,COLCN1 + CALL COLSUB + LD A,(COL) + RST 3 + DEFB _DGCOL + CALL TESTX + DEFB "]" + CALL TEST1 + DEFM "," + RET +; +COLCN1: LD A,(SELCOL) + LD (COL),A + RST 3 + DEFB _DGCOL +COLCN2: LD A,(BITFU2) + LD (PWMODE),A + RET +; +COLSUB: + CALL TEST1 + DEFM "," + JR Z,COLC8 + CALL COLCHK + LD (COL),A + CALL TEST1 + DEFB ',' + JR NZ,COLCN2 +COLC9: CALL IBYTE + CP 2 + JR NC,ER03B + LD (PWMODE),A + RET +; +COLC8: LD A,(SELCOL) + LD (COL),A + JR COLC9 +; +COLCHK: + PUSH BC + CALL IBYTE + POP BC +COLCK2: LD A,(CRTMD1) + RRA + JR C,CMD1 + RRA + JR C,CMD2 + RRA + JR C,CMD3 +CMD1: LD A,E + CP 4 + JR NC,ER03B + RET +CMD2: LD A,E + CP 16 + JR NC,ER03B + RET +CMD3: LD A,E + CP 2 + RET C +ER03B: JP ER03__ +; + +;;;;;;;;;;;;;;;;;;;; +; +;PAINT COMMAND +; +PAINT: + CALL COLCON + CALL POSITI + LD B,0 + LD DE,PAINTB + PUSH DE + CALL ENDCHK + JR Z,PAINT3 +PAINT1: CALL CH2CH + PUSH DE + CALL COLCHK + POP DE + LD (DE),A + INC DE + INC B + LD A,B + CP 16 + JP Z,ER01 + CALL ENDCHK + JR NZ,PAINT1 +PAINT2: EX (SP),HL ;data adrs + PUSH HL + LD HL,-527 + ADD HL,SP + LD (PAIWED),HL + POP HL + RST 3 + DEFB _PAINT + JP C,ER06__ + POP HL + RET +; +PAINT3: LD A,(COL) + LD (DE),A + INC B ; data count + JR PAINT2 +PAINTB: DEFS 16 + +;;;;;;;;;;;;;;;;;;;; +; +;CIRCLE COMMAND +; +CIRCLE: + PUSH HL + LD HL,0 + LD (CW_H+1),HL + LD (CW_XS+1),HL + LD (CW_YS+1),HL + LD (CW_XE+1),HL + LD (CW_YE+1),HL + LD HL,KK + CALL CLRFAC + LD HL,FLT2PI + LD DE,SK ;\mßám\l=2PAI + CALL LDIR5 + POP HL +;\s\ºl yÝ-Ä + CALL COORD0 + RST 3 + DEFB _POSSV + CALL HCH2CH + CALL IDEEXP + PUSH HL + LD A,D + AND 0C0H + JP NZ,ER03__ + EX DE,HL + LD (CW_R+2),HL ;ÞÙZs + LD (CW_XS+1),HL + LD (CW_XE+1),HL + LD HL,(INTFAC) + LD DE,CIR_R + CALL LDIR5 + POP HL + CALL ENDCHK + JP Z,CW + CALL CH2CH + CALL TEST1 + DEFB ',' + JR Z,CIRCL2 + CALL HIRIT + CALL ENDCHK + JP Z,CW + CALL CH2CH +CIRCL2: + CALL TEST1 + DEFB ',' + JR Z,CIRCL8 + LD IX,CW_XS+1 + LD IY,KK + CALL STX + CALL ENDCHK + JP Z,CW + CALL CH2CH +CIRCL8: + CALL TEST1 + DEFB ',' + JR Z,CIRCL4 + LD IX,CW_XE+1 + LD IY,SK + CALL STX + CALL ENDCHK + JP Z,CW + CALL CH2CH +CIRCL4: + CALL TESTX + DEFB 'O' + SCF + JR $+3 +CW: XOR A + PUSH HL + PUSH AF + LD HL,KK + LD DE,SK + CALL SUB + CALL LDIR5 + LD A,(KK) + OR A + LD B,0 + JR Z,CW2 ;KK=SK + LD HL,KK+1 + RES 7,(HL) + DEC HL ;HL:= ABS(KK-SK) + LD DE,FLTPAI + CALL CMP + LD B,1 + JR C,CW2 ; ABS() < PI + LD DE,FLT2PI + CALL CMP + LD B,2 + JR C,CW2 ; PI <= ABS() < 2*PI + LD B,3 ;2*PI <= ABS() +CW2: LD A,(SK+1) + AND 80H + OR B + LD B,A + POP AF ;CF='O' + LD A,B + EXX +CW_XS: LD DE,0 ;Start X +CW_YS: LD HL,0 ;Start Y +CW_H: LD BC,0 ;HIRITU + EXX +CW_XE: LD DE,0 ;End X +CW_YE: LD HL,0 ;End Y +CW_R: LD IX,0 ;R + RST 3 + DEFB _CIRCL + POP HL + OR A + RET +; +HIRIT: CALL IDEEXP + CALL PUSHR + LD HL,(INTFAC) + INC HL + BIT 7,(HL) + JP NZ,ER03__ + DEC HL + LD DE,FLONE + CALL CMP + RET Z + LD A,1 + JR C,HI + LD HL,FLONE + LD DE,CIRW3 + PUSH DE + CALL LDIR5 + POP HL + LD DE,(INTFAC) + CALL DIV + LD A,2 +HI: LD (CW_H+1),A + LD DE,_256DT + CALL MUL + LD DE,_0_5DT + CALL ADD + CALL HLFLT + LD A,L + LD (CW_H+2),A + BIT 0,H + RET Z + XOR A + LD (CW_H+1),A + RET +; +STX: PUSH IX + PUSH IY + CALL IDEEXP + POP DE ;KK/SK + POP IX + PUSH HL + PUSH IX + LD HL,(INTFAC) + CALL LDIR5 + LD HL,(INTFAC) + LD DE,HL + INC DE + INC DE + INC DE + INC DE + INC DE + CALL LDIR5 + CALL COS ;HL=(INTFAC)+5 + LD DE,CIR_R + CALL MUL + CALL STXSUB + LD HL,(INTFAC) + CALL SIN + LD DE,CIR_R + CALL MUL + CALL NEG + CALL STXSUB + POP IX + POP HL + RET +; +STXSUB: INC HL + BIT 7,(HL) + PUSH AF + RES 7,(HL) + DEC HL + LD DE,_0_5DT + CALL ADD + POP AF + INC HL + JR Z,$+4 + SET 7,(HL) + DEC HL + CALL HLFLT + EX DE,HL + POP HL ;RET ADRS + EX (SP),HL ;Save coordinate + LD (HL),E + INC HL + LD (HL),D + INC HL + INC HL + EX (SP),HL + JP (HL) +; +; +;CIRCLE WORK AREA PART-2 +; +CIR_R: DEFS 5 +; +CIRW3: DEFS 5 +; +_256DT: DEFB 0x89,0x00,0x00,0x00,0x00 +; +_0_5DT: DEFB 0x80,0x00,0x00,0xA7,0xC6 +; +KK: DEFS 5 +SK: DEFS 5 +; +; SYMBOL command +; + +; +SMBOL: + CALL COORD0 ;position load + RST 3 + DEFB _POSSV ;position input + CALL HCH2CH +;string pointer load + CALL STREXP +;string zero check + LD A,B + OR A + PUSH BC + PUSH HL + LD C,B + LD B,0 + LD HL,DIRARE + EX DE,HL + JR Z,SMBL2 + LDIR ;string data xfer +SMBL2: POP HL + CALL HCH2CH + CALL IBYTE ;yoko bairitsu + LD A,D + OR E + JR Z,ERJP3 ;zero error + PUSH DE + CALL HCH2CH + CALL IBYTE ;tate bairitsu + LD A,D + OR E +ERJP3: JP Z,ER03__ ;zero error + LD A,E + POP DE + LD D,A + CALL ENDCHK ;end check + PUSH DE + JR Z,SMBL1 + CALL HCH2CH + CALL IBYTE ;angle load + LD A,3 + CP E + JP C,ER03__ + LD A,E + DEFB 06H +SMBL1: XOR A + POP DE + POP BC + LD C,A ;angle push + LD A,B ;string length + OR A + RET Z ;zero return + LD A,C ;angle pop + PUSH HL + EX DE,HL + LD DE,DIRARE + RST 3 + DEFB _SYMBL + POP HL + RET +; + +; +;;;;;;;;;;;;;; +; +; HCOPY 1/2/3 +; CLS 1/2/3 +; +HCOPY: + CALL ENDZ + PUSH HL + LD A,00H ;ASAHI modify + RST 3 + DEFB _HCPY + POP HL + RET +; +CLS: + CALL ENDZ + PUSH HL + RST 3 + DEFB _CLS + POP HL + RET +; +; END (797AH) + + + +; ORG 797AH + +; ----------------------------- +; MZ-800 BASIC Data conversion +; FI:CONV ver 1.0A 7.18.84 +; Programed by T.Miho +; ----------------------------- +; + +; +; +; +ENDZ: + CALL ENDCHK + RET Z + JP ER01 +; +TESTP: + XOR A + LD (FILOUT),A + CALL TEST1 + DEFB 0FBH ;/ + RET NZ ;ZF=0 + CALL TESTX + DEFM "P" + CALL LPTTMD ;Check text mode + LD A,'P' + LD (FILOUT),A + CP A ;ZF=1 + RET +; +ASCFIV: + LD DE,DGBF00 + LD B,0 ;Zero sup. + PUSH DE + RST 3 + DEFB _ASCHL + POP DE + RET + +; +; Fetch subroutines +; +ICH28H: + INC HL +HCH28H: + CALL HLFTCH +CH28H: + CP '(' + JR CHXX2 +; +HCH29H: + CALL HLFTCH +CH29H: + CP ')' + JR CHXX2 +; +HCH2CH: + CALL HLFTCH +CH2CH: + CP ',' +; +CHXX2: INC HL + RET Z + JP ER01 +; +SKPDI: + INC DE +SKPDE: + LD A,(DE) + CP ' ' + JR Z,SKPDI + RET +; +; +;(DE)=1.0 +LDIR1: + LD HL,FLONE +;(DE)=(HL) 5BYTES SET +LDIR5: + LD BC,5 + LDIR + RET + +; +;(HL)=DE +FLTHEX: + CALL CLRFAC ;EXT(FLOAT) + LD A,E + OR D + RET Z + BIT 7,D + LD A,7FH + JR Z,NORFLH + LD A,D + CPL + LD D,A + LD A,E + CPL + LD E,A + INC DE + LD A,0FFH +; +NORFLH: LD B,91H +SFL: DEC B + BIT 7,D + JR NZ,FLHXRT + RL E + RL D + JR SFL +FLHXRT: LD (HL),B + INC HL + AND D + LD (HL),A + INC HL + LD (HL),E + DEC HL + DEC HL + RET +; +;0-9 THEN CY=0 +TSTNUM: + CP '0' + RET C + CP ':' + CCF + RET +; +;VAR THEN CY=0 +TSTVAR: + CP 5FH + RET Z + CP '0' + RET C + CP 5BH + CCF + RET C + CP ':' + CCF + RET NC + CP 41H + RET + +; +;CONV FLOAT(HL)_ASC(DE) +CVFLAS: + CALL CLRFAC ;EXT + LD (DGITCO),A + LD (DGITFG),A + LD (EXPFLG),A + LD (PRODFL+1),A + LD A,5 + LD (PRCSON),A +DEFTCL: CALL SKPDE + INC DE + CP '+' + JR Z,DEFTCL + CP '-' + JR NZ,CHKAND + CALL DEFTCL + JP TOGLE +; +CHKAND: CP '$' + JR NZ,ZRSKIP + PUSH HL + EX DE,HL + RST 3 + DEFB _DEHEX + EX (SP),HL + CALL FLTHEX + POP DE + LD A,5 + RET +; +ZRSKIP: CP '0' + JR NZ,MDLAG + LD A,(DE) + INC DE + JR ZRSKIP +; +FTCHL: LD A,(DE) + INC DE +MDLAG: CP ' ' + JR Z,FTCHL + CP '.' + JR Z,POINTS + CALL TSTNUM + JR C,TST23H + SUB '0' + CALL MULTEN + CALL MULDEC + LD A,1 + LD (DGITFG),A + LD A,(DGITCO) + INC A + LD (DGITCO),A + JR FTCHL +; +POINTS: LD A,1 + LD (PRODFL+1),A + LD C,A +POINT_: LD A,(DE) + INC DE + CP ' ' + JR Z,POINT_ + CALL TSTNUM + JR C,PESC + INC C + SUB '0' + JR Z,SDFGRE + PUSH AF + LD A,1 + LD (DGITFG),A + POP AF +SDFGRE: PUSH AF + LD A,(DGITFG) + LD B,A + LD A,(DGITCO) + ADD A,B + LD (DGITCO),A + POP AF + CALL MULTEN + CALL MULDEC + JR POINT_ +; +PESC: DEC C + JR Z,TST23H + CALL DIVTEN + JR PESC +; +; +TST23H: CP 'E' + JR Z,EXPON_ +; +TSTPRC: DEC DE + LD A,(EXPFLG) + OR A + RET NZ +PRODFL: LD A,0 ;xxx + OR A + RET NZ + LD A,5 + RET +; +EXPON_: LD A,(DE) + CP '-' + JR Z,EXPON + CP '+' + JR Z,EXPON + CALL TSTNUM + JR C,TSTPRC +EXPON: LD A,1 + LD (PRODFL+1),A + PUSH HL + LD HL,MUL + LD (EXJPVC),HL + LD HL,0000H + LD A,(DE) + INC DE + CP '+' + JR Z,CBEGIN + CP '-' + JR NZ,CLMIDL + PUSH HL + LD HL,DIV + LD (EXJPVC),HL + POP HL +CBEGIN: LD A,(DE) + INC DE +CLMIDL: SUB '0' + JR C,ESCPER + CP 0AH + JR NC,ESCPER + PUSH DE + CALL ADHLCK + LD E,L + LD D,H + CALL ADHLCK + CALL ADHLCK + CALL ADDECK + LD E,A + LD D,0 + CALL ADDECK + POP DE + JR CBEGIN +ESCPER: LD A,H + OR A + JR NZ,OVERF_ + LD A,L + POP HL + PUSH DE + PUSH BC + PUSH HL + LD DE,ZFAC + PUSH DE + CALL LDIR1 + POP HL + LD B,A + INC B + JR $+5 + CALL MULTEN + DJNZ $-3 + EX DE,HL + POP HL + DEFB 0CDH +EXJPVC: DEFS 2 + POP BC + POP DE + JP TSTPRC +; +DIVTEN: PUSH AF + PUSH BC + PUSH DE + LD DE,FLTEN + CALL DIV + POP DE + POP BC + POP AF + RET +; +ADDECK: ADD HL,DE + RET NC + JR OVERF_ +; +ADHLCK: ADD HL,HL + RET NC +OVERF_: JP ER02 ;OVERFLOW +; +MULDEC: PUSH DE + PUSH HL + LD HL,ZFAC ;***** + LD E,A + LD D,0 + CALL FLTHEX + EX DE,HL + POP HL + PUSH BC + CALL ADD + POP BC + POP DE + RET +; +; +;CONV ASC(DE)_FLOAT(HL) +CVNMFL: + LD A,5 + LD (PRCSON),A + LD A,(HL) + OR A + JR Z,ONLYZ_ + INC HL + LD A,(HL) + DEC HL + RLCA +ONLYZ_: LD A,20H + JR NC,PLUS + CALL TOGLE + LD A,'-' +PLUS: PUSH AF + CALL CVASF1 + CALL ADJDGT + POP AF + DEC DE + LD (DE),A + RET +; +; +CMP2: PUSH BC + CALL CMP + POP BC + RET + +; +INT: + CALL PUSHR + LD A,(HL) + CP 81H + JP C,CLRFAC + LD A,(HL) + CP 0A0H + RET NC + INC HL + CALL RCHLBC + PUSH HL + LD L,(HL) + LD B,0 +INTSFL: SRL E + RR D + RR C + RR L + INC A + INC B + CP 0A0H + JR NZ,INTSFL +INTSBL: SLA L + RL C + RL D + RL E + DJNZ INTSBL + LD A,L + POP HL + LD (HL),A + DEC HL + LD (HL),C + DEC HL + LD (HL),D + DEC HL + LD (HL),E + RET +; +RCHLBC: LD E,(HL) + INC HL + LD D,(HL) + INC HL + LD C,(HL) + INC HL + RET + +; +FRACT: + LD A,(HL) + CP 81H + RET C + PUSH DE + PUSH HL + LD DE,FRACW + PUSH DE + CALL LDIR5 + POP HL + CALL INT + EX DE,HL + POP HL + CALL SUB + POP DE + RET +; +FRACW: DEFS 5 +; +; +MULTEN: PUSH AF + PUSH BC + PUSH DE + LD DE,FLTEN + CALL MUL + POP DE + POP BC + POP AF + RET + +; +HLFLT: + INC HL + BIT 7,(HL) + JR Z,NORHLC + CALL NORHLC + LD A,H + CPL + LD H,A + LD A,L + CPL + LD L,A + INC HL + RET +; +NORHLC: DEC HL + LD A,(HL) + CP 91H + JP NC,ER02 ;OVERFLOW + CP 81H + JR C,HXZRRT + PUSH AF + INC HL + LD A,(HL) + INC HL + LD L,(HL) + LD H,A + POP AF + SET 7,H +HXFLSL: CP 90H + RET Z + INC A + SRL H + RR L + JR HXFLSL +; +HXZRRT: CCF + LD HL,0 + RET +; +; +SNGMXO: DEFB 0x9B,0x3E,0xBC,0x20,0x00 + +SNGMXP: DEFB 0x98,0x18,0x96,0x80,0x00 + DEFB 0x94,0x74,0x24,0x00,0x00 + DEFB 0x91,0x43,0x50,0x00,0x00 + DEFB 0x8E,0x1C,0x40,0x00,0x00 + DEFB 0x8A,0x7A,0x00,0x00,0x00 + DEFB 0x87,0x48,0x00,0x00,0x00 + +FLTEN: + DEFB 0x84,0x20,0x00,0x00,0x00 + +FLONE: + DEFB 0x81,0x00,0x00,0x00,0x00 + + DEFB 0x7D,0x4C,0xCC,0xCC,0xCD + +SLLMT: DEFB 0x66,0x2B,0xCC,0x77,0x12 + + +; +EXPASC: LD HL,(HLBUF2) + LD B,0 +TENCOM: LD DE,FLTEN + CALL CMP2 + JR C,ONECOM + CALL DIVTEN + INC B + JR TENCOM +ONECOM: LD DE,FLONE + CALL CMP2 + JR NC,COMOK + CALL MULTEN + DEC B + JR ONECOM +COMOK: PUSH BC + CALL CVASF1 + CALL ADJDGT + POP BC + PUSH DE + EX DE,HL +SERNOP: LD A,(HL) + OR A + JR Z,SEROK + INC HL + JR SERNOP +SEROK: DEC HL + LD A,(HL) + INC HL + CP '0' + JR NZ,USEXPE + INC B + DEC HL +USEXPE: LD A,'E' + LD (HL),A + INC HL + LD A,B + LD B,'+' + BIT 7,A + JR Z,EXSGPT + NEG + LD B,'-' +EXSGPT: LD (HL),B + INC HL + LD (HL),'0' +EXTNPT: SUB 0AH + JR C,EXONPT + INC (HL) + JR EXTNPT +EXONPT: ADD A,3AH + INC HL + LD (HL),A + INC HL + LD (HL),0 + POP DE + RET + +; +INTPAR: PUSH HL + CALL HLFLT + LD DE,DGBF11 + PUSH DE + LD B,1 ;Non zero-sup. + RST 3 + DEFB _ASCHL + POP HL + LD A,'0' + LD B,5 + CP (HL) + JR NZ,INTDGO + INC HL + DJNZ $-4 + JR INTDGE +INTDGO: LD A,B + LD (DGITCO),A + LD A,1 + LD (DGITFG),A +INTDGE: LD A,'.' + LD (DGBF16),A + POP HL + CALL FRACT + JP FRACDG +; +; +CVASF1: LD (HLBUF2),HL + XOR A + LD (DGITCO),A + LD (DGITFG),A + PUSH HL + LD HL,DGBF07 + LD (HL),0FFH + LD B,33 + LD A,'0' + INC HL + LD (HL),A + DJNZ $-2 + LD A,'.' + LD (DGBF16),A + POP HL + LD A,(HL) + OR A + RET Z + LD DE,SNGMXO + CALL CMP + CCF + RET C + LD DE,SLLMT + CALL CMP + RET C + LD DE,ZFAC1 + PUSH DE + CALL LDIR5 + POP HL + LD A,(HL) + CP 81H + JR C,FRACDG ; + CP 90H + JP C,INTPAR ; + LD IX,DGBF08 + LD DE,SNGMXP + CALL GENDGT + CALL GEND_ + RET NC ;C=0 +FRACDG: LD IX,DGBF17 +FRCAGN: LD DE,SNGMXO + PUSH BC + PUSH IX + CALL MUL + POP IX + POP BC + INC DE + INC DE + INC DE + INC DE + INC DE + CALL GENDGT + CALL GEND_ + JR C,FRCAGN + RET +; +; +CVASFL: + LD A,5 + LD (PRCSON),A + PUSH HL + LD DE,ZFAC2 + PUSH DE + CALL LDIR5 + POP HL + CALL CVASF1 + CALL ADJDG2 + POP HL + RET +; +ZERADJ: LD DE,DGBF16 + LD (DE),A + DEC DE + RET +; +ADJDG2: JP C,EXPASC +ADJDGT: LD HL,(HLBUF2) + LD A,(HL) + OR A + JR Z,ZERADJ + LD DE,DGBF08 + DEC DE + EX DE,HL + LD DE,1 +SSNTO1: INC HL + LD A,(HL) + CP '.' + JR NZ,TST30H + LD DE,0 + JR SSNTO1 +TST30H: CP '0' + JR Z,SSNTO1 + ADD HL,DE + LD DE,8 + ADD HL,DE + LD A,(HL) +FRCASL: LD (HL),'0' + CP 35H + JR C,BCKSER +ADDLOP: DEC HL + LD A,(HL) + CP '.' + JR Z,ADDLOP + INC A + JR Z,MAXNO + LD (HL),A + CP ':' + JR Z,FRCASL + INC HL +BCKSER: LD DE,DGBF16 + EX DE,HL + OR A + SBC HL,DE + EX DE,HL + JR C,KUMI + LD HL,DGBF16 + JR INTDI2 +KUMI: DEC HL + LD A,(HL) + CP '.' + DEC HL + JR Z,INTDIS + INC HL + CP '0' + JR Z,BCKSER + PUSH HL + LD DE,DGBF25 + SBC HL,DE + POP HL + JP NC,EXPASC +INTDIS: INC HL +INTDI2: LD (HL),0 + LD DE,DGBF08 +TSTFST: LD A,(DE) + CP '0' + JR NZ,ZEONLY + INC DE + JR TSTFST +ZEONLY: OR A + RET NZ + DEC DE + LD A,'0' + LD (DE),A + RET +; +; +MAXNO: LD HL,DGBF00 + LD DE,M1E08 + PUSH BC + LD BC,6 + LDIR + POP BC + LD DE,DGBF00 + RET +; +M1E08: DEFM "1E+08" + + DEFB 0 +; +; +GENDGT: LD A,(DE) + CP 7DH + RET Z +INTGDL: CALL CMP + JR C,GTESTB + INC (IX+0) + PUSH IX + PUSH BC + CALL SUB + POP BC + POP IX + LD A,1 + LD (DGITFG),A + JR INTGDL +; +GTESTB: INC IX + INC DE + INC DE + INC DE + INC DE + INC DE + LD A,(DGITFG) + LD B,A + LD A,(DGITCO) + ADD A,B + LD (DGITCO),A + CALL GEND_ + RET NC + JR GENDGT +; +GEND_: LD A,(HL) + OR A + RET Z + LD A,(DGITCO) + CP 9 + RET +; +DGITCO: DEFS 1 +DGITFG: DEFS 1 +EXPFLG: DEFS 1 +HLBUF2: DEFS 2 +; + +; +; USING CONVERSION +; +USINGS: + DEFS 2 ;USING START +USINGP: + DEFS 2 ;USING POINTER +; +USNGSB: + LD HL,(USINGP) + PUSH DE +USNGS2: LD A,(HL) + OR A + JP Z,ER03__ + CALL USGCD + JR Z,USNGS4 + LD (BC),A + INC BC + INC HL + JR USNGS2 +USNGS4: EX AF,AF + LD A,(PRCSON) + CP 3 + JP NZ,FLTUSG + EX AF,AF + CP '!' + JP Z,CHOUT1 + CP '&' + JP Z,CHOUT2 + JP ER04 +; +CHOUT1: EX (SP),HL + PUSH BC + CALL CVTSDC + OR A + LD A,' ' + JR Z,$+3 + LD A,(DE) + POP BC + LD (BC),A + INC BC +AFTPR_: POP HL + INC HL +AFTPRT: LD A,(HL) + OR A + JR Z,BRTUSG + CALL USGCD + JR Z,RETUSG + LD (BC),A + INC BC + INC HL + JR AFTPRT + +BRTUSG: LD HL,(USINGS) +RETUSG: LD (USINGP),HL + XOR A + LD (BC),A + RET +; +CHOUT2: LD D,2 +AG2CH_: INC HL + LD A,(HL) + CP '&' + JR Z,_26FOUN + INC D + CP ' ' + JR Z,AG2CH_ + JP ER03__ +_26FOUN: EX (SP),HL + LD A,(HL) + CP D + JR C,TRIZ__ + INC HL + CALL INDRCT + PUSH BC + LD BC,(STRST) + ADD HL,BC + POP BC +_PRLOP: LD A,(HL) + LD (BC),A + INC BC + INC HL + DEC D + JR NZ,_PRLOP + JP AFTPR_ +; +TRIZ__: LD E,(HL) + INC HL + CALL INDRCT + LD A,E + OR A + JR Z,__SPCF + PUSH BC + LD BC,(STRST) + ADD HL,BC + POP BC +PR__L1: LD A,(HL) + LD (BC),A + INC BC + INC HL + DEC E + JR Z,__SPC_ + DEC D + JR NZ,PR__L1 + JP AFTPR_ +__SPCF: LD A,' ' + LD (BC),A + INC BC +__SPC_: DEC D + JR NZ,__SPCF + JP AFTPR_ + +; +; Check using code +; +USGCD: CALL CHKACC + DEFB 4 + DEFM "!&#+" + RET Z + LD E,A + CP '*' + JR Z,USGCD2 + CALL POND + JR Z,USGCD2 + CP '.' + LD E,'#' + JR Z,USGCD2 + CP _BAR + RET NZ + INC HL + LD A,(HL) + OR A + JP Z,ER03__ + RET +USGCD2: INC HL + LD A,(HL) + CP E + DEC HL + LD A,(HL) + RET +; +; +FLTUSG: XOR A + LD (FPLUSF),A + LD (PUASTF),A ;PUT * FLG + LD (PUYENF),A ;] + LD (PUAFMF),A ;AFTER-FLG + LD (PUCOMF),A ;PUT , FLG + LD (INTLEN),A ;INT LENGTH + LD (RPLUSF),A ;###+ + LD (PUEXPF),A ;^^^^ + DEC A + LD (FRCLEN),A ;FRAC LENGTH + EX AF,AF + LD D,0 + CP '#' + JP Z,PFLENG + CP '*' + JP Z,ASTRSK + CALL POND + JP Z,YENUSG + CP '.' + JP Z,PULSLS + CP '+' + JP Z,PLUSUS + JP ER04 +; +ASTRSK: LD A,1 + LD (PUASTF),A + INC HL + INC D + INC HL + INC D + LD A,(HL) + CALL POND + JR NZ,PULSLS + JR YENUS2 +; +YENUSG: INC HL + INC D +YENUS2: INC HL + INC D + LD (PUYENF),A + JR PULSLS +; +PLUSUS: LD A,1 + LD (FPLUSF),A +; +PFLENG: INC HL + INC D +; +PULSLS: EX DE,HL + DEC H +PUGTFC: INC H + LD A,(DE) + INC DE + CP '#' + JR Z,PUGTFC + CP ',' + JR NZ,PUCONP + LD A,1 + LD (PUCOMF),A + JR PUGTFC +PUCONP: CP '.' + JR Z,PUPOIT + CP '-' + JR NZ,PUAFMO + LD A,1 + LD (PUAFMF),A + INC DE + JR PUAFQO +PUAFMO: CP '+' + JR NZ,PUAFQO + LD A,(FPLUSF) + OR A + JR NZ,PUAFQO + LD A,1 + LD (RPLUSF),A + INC DE +PUAFQO: DEC DE + LD A,H + LD (INTLEN),A + JR BEGUSG +; +PUPOIT: LD A,H + LD (INTLEN),A + LD H,0FFH +PUPOFC: INC H + LD A,(DE) + INC DE + CP '#' + JR Z,PUPOFC + CP '-' + JR NZ,PUCOPQ + LD A,1 + LD (PUAFMF),A + INC DE + JR PUCOPP +PUCOPQ: CP '+' + JR NZ,PUCOPP + LD A,(FPLUSF) + OR A + JR NZ,PUCOPP + LD A,1 + LD (RPLUSF),A + INC DE +PUCOPP: DEC DE + LD A,H + LD (FRCLEN),A + JR BEGUSG +; +NEXPP_: POP DE + JR NEXPPU +; +BEGUSG: LD H,4 + PUSH DE +CHEXPU: LD A,(DE) + INC DE + CP '^' + JR NZ,NEXPP_ + DEC H + JR NZ,CHEXPU + POP AF + LD A,1 + LD (PUEXPF),A +NEXPPU: POP HL + PUSH DE + INC HL + LD A,(HL) + RES 7,(HL) + DEC HL + LD (USGSGN),A + LD A,(INTLEN) + LD D,A + DEFB 3EH +FRCLEN: DEFS 1 + LD E,A + DEFB 3EH +PUEXPF: DEFS 1 + PUSH BC + CALL USNGCV + POP BC + DEFB 3EH +PUCOMF: DEFS 1 + OR A + JR Z,LADJS1 + PUSH BC + PUSH DE + LD A,(INTLEN) + LD L,A + LD H,0 + ADD HL,DE + LD DE,DGBF00 + LD C,0 + DEC HL +COMN3D: LD B,3 +COMSK3: LD A,(HL) + CP ' ' + JR Z,ESCPUC + INC C + LD (DE),A + INC DE + DEC HL + DJNZ COMSK3 + LD A,(HL) + CP ' ' + JR Z,ESCPUC + LD A,',' + LD (DE),A + INC DE + INC C + JR COMN3D +; +ESCPUC: DEFB 3EH +INTLEN: DEFS 1 + CP C + JP C,ER02 + LD B,C + LD L,A + LD H,0 + POP DE + PUSH DE + ADD HL,DE + LD DE,DGBF00 + DEC HL + LD A,(DE) + LD (HL),A + DEC HL + INC DE + DJNZ $-4 + POP DE + POP BC +LADJS1: DEFB 3EH +PUAFMF: DEFS 1 + OR A + JR NZ,LADJS2 + DEFB 3EH +RPLUSF: DEFS 1 + OR A + JR NZ,LADJS2 + DEFB 3EH +FPLUSF: DEFS 1 + OR A + JR NZ,PTPLS1 + LD A,(USGSGN) + RLCA + JR NC,LADJS2 + LD A,(DE) + CP ' ' + LD H,'-' + JR Z,FPUTER + CP 30H + JP NZ,ER02 +FPUTER: PUSH DE +PUPTML: LD A,(DE) + INC DE + CP ' ' + JR Z,PUPTML + CP 30H + JR Z,PUPTML + OR A + JR NZ,$+3 + DEC DE + DEC DE + DEC DE + LD A,H + LD (DE),A + POP DE + JR LADJS2 +; +PTPLS1: DEFB 3EH +USGSGN: DEFS 1 + RLCA + LD H,'+' + JR NC,FPUTER + LD H,'-' + JR FPUTER +; +LADJS2: DEFB 3EH +PUYENF: DEFS 1 + OR A + JR Z,LADJS3 + LD A,(DE) + CP ' ' + JR NZ,LADJS3 + PUSH DE + LD A,(DE) + INC DE + CP ' ' + JR Z,$-4 + DEC DE + DEC DE + LD A,(PUYENF) + LD (DE),A + POP DE +LADJS3: DEFB 3EH +PUASTF: DEFS 1 + OR A + JR Z,LADJS4 + PUSH DE +ASTFIL: LD A,(DE) + CP ' ' + JR NZ,LADJ4_ + LD A,'*' + LD (DE),A + INC DE + JR ASTFIL +LADJ4_: POP DE +LADJS4: LD A,(DE) + OR A + JR Z,USPRL8 + LD (BC),A + INC BC + INC DE + JR LADJS4 +USPRL8: LD A,(RPLUSF) + OR A + JR Z,TST2DH ;- + LD A,(USGSGN) + RLCA + LD A,'+' +LSDVZR: JR NC,PULSTX + LD A,'-' +PULSTX: LD (BC),A + INC BC + JR RETPU_ +; +TST2DH: LD A,(PUAFMF) ;- + OR A + JR Z,RETPU_ + LD A,(USGSGN) + RLCA + LD A,' ' + JR LSDVZR +; +RETPU_: POP HL ; RETPU$ + JP AFTPRT +; +; +POND: CP _POND ;EX + RET Z + CP '$' + RET + +; +USNGCV: OR A + JP Z,USGCV2 + PUSH DE + LD A,(HL) + OR A + JR Z,USCMOK + PUSH HL + LD A,D + LD DE,ZFAC1 + PUSH AF + CALL LDIR1 + POP AF + OR A + JR Z,BMULED + LD B,A + LD HL,ZFAC1 + JR $+5 + CALL MULTEN + DJNZ $-3 +BMULED: POP HL + LD B,0 +USTNCM: LD DE,ZFAC1 + CALL CMP2 + JR C,USTOCM + CALL DIVTEN + INC B + JR USTNCM +USTOCM: PUSH HL + LD HL,ZFAC1 + CALL DIVTEN + POP HL +USONCM: LD DE,ZFAC1 + CALL CMP2 + JR NC,USCMOK + CALL MULTEN + DEC B + JR USONCM + +USCMOK: POP DE + PUSH BC + CALL USGCV1 + POP BC + PUSH DE + LD A,(DE) + CP '.' + JR NZ,FLADSR + LD DE,DGBF16 + DEC DE + LD A,(DE) + CP 31H + POP DE + PUSH DE + JR NZ,USEX0C + EX DE,HL + INC HL + LD (HL),31H + DEC HL + JR MIDDCX +; +FLADSR: LD A,(DE) + CP 31H + JR NZ,USEX0C + EX DE,HL + INC HL + LD A,(HL) + DEC HL + CP '.' + LD A,'0' + JR Z,$+4 + LD A,' ' + LD (HL),A + INC HL + LD A,(HL) + CP '.' + JR Z,$-4 + LD (HL),31H +MIDDCX: EX DE,HL + INC B +USEX0C: LD A,(DE) + INC DE + OR A + JR NZ,USEX0C + DEC DE + JP USEXPE +; +USGCV2: PUSH DE + CALL USGCV1 + POP AF + OR A + RET NZ + PUSH HL + LD HL,DGBF16 + DEC HL + LD A,'0' + CP (HL) +FOVVXC: JP NZ,ER02 + DEC HL + LD A,' ' + CP (HL) + JR NZ,FOVVXC + POP HL + RET +; +USGCV1: PUSH DE + CALL CVASF1 + JP C,ER02 + POP HL + PUSH HL + LD H,0 + INC L + JR Z,$+3 + DEC L + LD DE,DGBF17 + ADD HL,DE + LD A,(HL) + LD (HL),0 + DEFB 11H +FRCASU: LD (HL),'0' + CP 35H + JR C,BCKSEU + DEC HL + LD A,(HL) + CP '.' + JR Z,$-4 + INC A + JP Z,ER02 + LD (HL),A + CP ':' + JR Z,FRCASU +BCKSEU: LD HL,KEYBM1 ;¯¯KEYBUF + LD DE,2000H + LD (HL),D + INC HL + DEC E + JR NZ,$-3 + POP HL + PUSH HL + LD E,H + LD D,0 + LD HL,KEYBUF + ADD HL,DE + PUSH HL + LD HL,DGBF07 + LD (HL),' ' + INC HL + LD D,7 +BF00SP: LD A,(HL) + CP '0' + JR NZ,BF00ED + LD (HL),' ' + INC HL + DEC D + JR NZ,BF00SP +BF00ED: POP HL + PUSH HL + LD B,E + LD A,B + OR A + JR Z,BFST11 + LD DE,DGBF16 +BFSTL1: DEC HL + DEC DE + LD A,(DE) + LD (HL),A + CP ' ' + JR Z,BFST11 + DJNZ BFSTL1 + DEC DE + LD A,(DE) + CP ' ' + JR Z,BFST11 + INC A + JP NZ,ER02 +; +BFST11: POP HL + POP DE + INC E + JR Z,EDSTRT + LD B,E + LD DE,DGBF17 + LD (HL),'.' +BFSTL2: INC HL + DEC B + JR Z,EDSTRT + LD A,(DE) + INC DE + LD (HL),A + JR BFSTL2 +EDSTRT: LD (HL),0 + LD DE,KEYBUF + RET +; +; END (8216H) + + +; ORG 8216H + +; ------------------------------------ +; MZ-800 BASIC Interm.code conversion +; FI:EDIT ver 1.0A 7.18.84 +; Programed by T.Miho +; ------------------------------------ +; + +; +CVIMTX: + PUSH DE + PUSH BC + LD C,0 + DEC DE +CVIM10: INC DE +CVIM12: CALL IMSPACE + OR A + JR Z,IMEND + CP 0FFH + JR Z,IMPAI + CP 80H + JP NC,ER01 + CP 20H + JR C,CVIM10 + LD IX,CVIM12 + PUSH IX + CP '"' + JR Z,IMSTR + CP '\'' + JR Z,IMREM + CP '?' + JR Z,IMPRT + CP '.' + JP Z,IMFLT + CP '$' + JP Z,IMHEX + CALL TSTNUM + JR C,IMRSV + JP IMNUM +; +IMEND: LD (HL),A + POP BC + POP DE + RET +; +IMPAI: LD (HL),0E4H + CALL IM3R + JR CVIM12 +; +IMPRT: LD A,8FH + CALL IM3RS + JR IMRSV6 +; +IMREM: LD (HL),':' + CALL IM3R + LD (HL),'\'' + CALL IM3RH + JP IMDATA + +; +IMSTR: LD (HL),A + CALL IM3R +IMSTR2: LD A,(DE) + OR A + RET Z + CP '"' + JR NZ,IMSTR +IM3RS: LD (HL),A +IM3R: INC DE +IM3RH: INC HL +IM3RC: INC C + RET NZ + JP ER08 ;LINE LENGTH +; +IMVAR: POP BC + LD A,(DE) + CALL TSTVAR + JR C,IM3RS +IMVAR2: CALL IM3RS + LD A,(DE) + CP '$' + JR Z,IM3RS + CALL TSTNUM + RET C + JR IMVAR2 +; +IMRSV: PUSH BC + LD BC,CTBL1 + CALL IMSER + JR NC,IMRSV4 + LD BC,GTABL + CALL IMSER + LD C,0FEH + JR NC,IMRSV2 + LD BC,CTBL2 + CALL IMSER + LD C,0FFH + JR C,IMVAR +IMRSV2: LD (HL),C + INC HL + LD (HL),A + POP BC + CALL IM3RC + CALL IM3RH + CP 0B4H ; ERL ****** + RET NZ + CALL IMSPACE + CP '=' + RET NZ + LD (HL),0F4H ; = ****** + CALL IM3R + JR IMLNO + +; +IMRSV4: POP BC + CALL IM3RH +IMRSV6: CP 97H ; REM + JR Z,IMDATA + CP 94H ; DATA + JR Z,IMDATA + CP 0C2H ; ELSE + JR Z,IMELSE + CP 0E2H ; THEN + JR Z,IMLNO + CP 0E0H + RET NC + PUSH AF + CALL IMSPACE + CP '/' + JR NZ,IMRSV7 + LD (HL),0FBH ;/ + CALL IM3R + CALL SKPDE + CALL IM3RS + JR IMRSV8 +IMRSV7: CP '#' + JR NZ,IMRSV8 + CALL IM3RS + CALL SKPDE + CALL TSTNUM + CALL NC,IMNUM +IMRSV8: POP AF + CP 8DH ; FOR + RET NC +; +IMLNO: CALL IMSPACE + CP '"' + JR NZ,IMLNO2 + CALL IMSTR + JR IMLNO +IMLNO2: CP 2CH + RET C + CP 2FH + JR C,IMLNO4 ;",-." + CALL TSTNUM + RET C + CALL IMINT + JR IMLNO +IMLNO4: CALL IM3RS + JR IMLNO +; +IMELSE: DEC HL + LD (HL),':' + INC HL + LD (HL),A + CALL IM3RH + JR IMLNO +; +IMDATA: LD A,(DE) + CALL ENDCK0 + RET Z + CALL IM3RS + CP '"' + CALL Z,IMSTR2 + JR IMDATA +; +; +IMSER: PUSH HL ;Search in tabale + PUSH DE + LD HL,BC + LD B,7FH +IMSER2: POP DE + PUSH DE + INC B + LD A,(HL) + CP 0FFH + JR NZ,IMSER3 + POP DE ;Table end + POP HL + SCF + RET +; +IMSER3: CP '.' + JR NZ,IMSER4 + INC HL ;AND OR XOR NOT + DEC DE + LD A,(DE) + INC DE + CALL TSTVAR + JR NC,IMSER6 +IMSER4: LD A,(DE) + CP ' ' + JR NZ,IMSER5 + LD A,(HL) + AND 7FH + SUB 'A' + CP 26 + JR C,IMSER6 + CALL SKPDI +IMSER5: LD C,(HL) + INC HL + INC DE + CP '.' + JR Z,IMSER8 + SUB C + JR Z,IMSER4 + CP 80H + JR Z,IMSER9 +IMSER6: DEC HL ;Not match + BIT 7,(HL) + INC HL + JR Z,$-3 + JR IMSER2 +IMSER8: LD A,B + CP 0E8H ;operator + JR NC,IMSER6 + CCF +IMSER9: POP HL ;Found + POP HL + LD (HL),B + LD A,B + RET +; +IMSPACE:LD A,(DE) + CP ' ' + RET NZ + LD (HL),A + CALL IM3R + JR IMSPACE + +; +IMNUM: EX AF,AF + PUSH DE + CALL SKPDI + POP DE + CALL TSTNUM ;check if one-digit + JR NC,IMFLT + CP '.' + JR Z,IMFLT + CP 'E' + JR Z,IMFLT + EX AF,AF + SUB '0'-1 + JP IMFLT ;ok, JP IM3RS +; +IMFLT: PUSH BC + LD (HL),15H + INC HL + PUSH HL + CALL CVFLAS + POP HL + LD BC,5 + ADD HL,BC + LD A,6 + JR BCKSPS +; +IMINT: PUSH BC + CALL CVBCAS + LD (HL),0BH + INC HL + JR PPOLNO +; +IMHEX: LD (HL),A + INC DE + LD A,(DE) + RST 3 + DEFB _CKHEX + JP C,IM3RH + PUSH BC + LD (HL),11H + INC HL + PUSH HL + EX DE,HL + RST 3 + DEFB _DEHEX + LD BC,DE + EX DE,HL + POP HL +PPOLNO: LD A,3 + LD (HL),C + INC HL + LD (HL),B + INC HL +BCKSPS: POP BC + ADD A,C + JP C,ER08 ;LINE LENGTH + LD C,A +BCKSKP: DEC DE + LD A,(DE) + CP ' ' + JR Z,$-4 + INC DE + RET + +; +CVTXIM: + PUSH HL + PUSH DE + PUSH BC + EXX + LD B,0 + EXX + LD C,0 +CVTX10: LD A,(HL) + OR A + JR Z,TXEND + LD BC,CVTX10 + PUSH BC + CP '\'' + JR Z,TXDAT2 + INC HL + LD BC,CTBL1 + CP 20H + JR C,TXNUM + CP '"' + JR Z,TXSTR + CP ':' + JR Z,TX3AH + CP 97H ;REM + JR Z,TXDATA + CP 94H ;DATA + JR Z,TXDATA + CP 0E4H ;PI + JR Z,TXPAI + CP 0FEH + JR NC,TXRSV0 + CP 80H + JP NC,TXRSV + JP STRDE +; +TXEND: LD (DE),A + POP BC + POP DE + POP HL + RET +; +TXPAI: LD A,0FFH + JP STRDE +; +TXRSV0: LD BC,CTBL2 + JR NZ,$+5 + LD BC,GTABL + LD A,(HL) + INC HL + JR TXRSV +; +TXDATA: CALL TXRSV + RET Z +TXDAT2: LD A,(HL) + CALL ENDCK0 + RET Z + CALL STRDE + LD A,(HL) + INC HL + CP '"' + CALL Z,TXSTR2 + JR TXDAT2 +; +TXSTR: CALL STRDE +TXSTR2: LD A,(HL) + OR A + RET Z + INC HL + CP '"' + JR NZ,TXSTR + JR STRDE +; +TX3AH: LD (DE),A + LD A,(HL) + CP 0C2H ; ELSE + RET Z + CP '\'' + RET Z + JR STRDE_ +; +TXNUM: CP 15H + JR Z,TXFLT + CP 0BH + JR NC,TXINT + DEC A + OR 30H + JR STRDE +; +TXINT: PUSH DE + LD E,(HL) + INC HL + LD D,(HL) + INC HL + PUSH HL + CP 12H + JR Z,TXINT2 + CP 0CH + JR C,TXINT2 + JR NZ,TXHEX + EX DE,HL + INC HL + INC HL + LD E,(HL) + INC HL + LD D,(HL) +TXINT2: EX DE,HL + CALL ASCFIV + LD BC,DE + POP HL + POP DE +TXINT4: LD A,(BC) + OR A + RET Z + CALL STRDE + INC BC + JR TXINT4 +; +TXFLT: PUSH HL + PUSH DE + CALL CVASFL + LD BC,DE + POP DE + POP HL + INC HL + INC HL + INC HL + INC HL + INC HL + JR TXINT4 +; +TXRSV: CP 80H + JR Z,TXRSV4 + EX AF,AF +TXRSV2: LD A,(BC) + RLCA + INC BC + JR NC,TXRSV2 + EX AF,AF + DEC A + JR TXRSV +TXRSV4: LD A,(BC) + BIT 7,A + JR NZ,STRDES + CP '.' + CALL NZ,STRDE + INC BC + JR TXRSV4 +; +STRDES: AND 7FH +STRDE: LD (DE),A + OR A + RET Z +STRDE_: INC DE + EXX + INC B + EXX + RET NZ + XOR A + LD (DE),A + DEC DE + EXX + DEC B + EXX + RET +; +TXHEX: LD A,'$' + EX AF,AF + EX DE,HL + CALL HEXHL + LD BC,DE + POP HL + POP DE + EX AF,AF + CALL STRDE + JR TXINT4 +; +HEXHL: + LD DE,DGBF12 + PUSH DE + LD A,H + CALL HEXACC + LD A,L + CALL HEXACC + XOR A + LD (DE),A + POP DE + LD B,3 +; +ZRSUP: LD A,(DE) + CP '0' + RET NZ + INC DE + DJNZ ZRSUP + RET +; +HEXACC: + PUSH AF + RRCA + RRCA + RRCA + RRCA + AND 0FH + CALL HEXAC2 + POP AF + AND 0FH +HEXAC2: ADD A,30H + CP 3AH + JR C,$+4 + ADD A,7 + LD (DE),A + INC DE + RET +; +CVBCAS: + PUSH HL + EX DE,HL + RST 3 + DEFB _DEASC + LD BC,DE + EX DE,HL + POP HL + JP BCKSKP +; +; END (853DH) + + +; ORG 853DH + +; ----------------------------- +; MZ-800 BASIC Expression part +; FI:EXPR ver 1.0A 8.25.84 +; Programed by T.Miho +; ----------------------------- +; +; + +; +IBYTE: ;0..255 + CALL IDEEXP +DCHECK: + LD A,D + OR A + JP NZ,ER03__ + LD A,E + RET +; +DEEXP: + CALL EXPR8 + DEC DE + DEC DE + DEC DE + DEC DE + DEC DE + JR STDEFC +; +IDEEXP: ;DE=(HL) + CALL EXPR +STDEFC: + PUSH AF + PUSH HL + EX DE,HL + CALL STROMT + CALL HLFLT + EX DE,HL + POP HL + POP AF + RET +; +STREXP: + CALL EXPR + PUSH AF + CALL STROK + PUSH HL + EX DE,HL + CALL CVTSDC + POP HL + POP AF + RET +; +CVTSDC: + LD B,(HL) + INC HL + LD E,(HL) + INC HL + LD D,(HL) + LD HL,(STRST) + ADD HL,DE + EX DE,HL + LD A,B + RET + +; +EXPR: + LD DE,(VARED) + LD (TMPEND),DE +EXPRNX: + LD DE,(INTFAC) + PUSH DE + CALL EXPR8 + POP DE + RET +; +EXPR8: PUSH DE + LD DE,(TMPEND) + CALL MEMECK + POP DE +; +; +EXPR7: CALL EXPR6 +EXPR7L: CP 0EAH ;XOR + RET NZ + LD A,(PRCSON) + PUSH AF + INC HL + CALL EXPR6 + POP BC + PUSH AF + PUSH HL + CALL ADJUST + CALL _XOR_ + POP HL + POP AF + JR EXPR7L +; +EXPR6: CALL EXPR5 +EXPR6L: CP 0EBH ;OR + RET NZ + LD A,(PRCSON) + PUSH AF + INC HL + CALL EXPR5 + POP BC + PUSH AF + PUSH HL + CALL ADJUST + CALL _OR_ + POP HL + POP AF + JR EXPR6L +; +EXPR5: CALL EXPR4 +EXPR5L: CP 0ECH ;AND + RET NZ + LD A,(PRCSON) + PUSH AF + INC HL + CALL EXPR4 + POP BC + PUSH AF + PUSH HL + CALL ADJUST + CALL _AND_ + POP HL + POP AF + JR EXPR5L +; +EXPR4: + CALL TEST1 + DEFB 0EDH ;NOT + JR NZ,EXPR3 + CALL EXPR3 + PUSH AF + PUSH HL + LD HL,-5 + ADD HL,DE + CALL _NOT_ + POP HL + POP AF + RET + +EXPR3: CALL EXPR2 +EXPR3L: CP 0EEH ;>< + RET C + PUSH AF ;stk OPC + LD A,(PRCSON) + PUSH AF ;stk OPC, PRCSON + INC HL + CALL EXPR2 + POP BC ;stk OPC; B=PRCSON + EX (SP),HL ;stk RJOB; HL=OPC + PUSH AF ;stk RJOB,NEXT + PUSH HL ;stk RJOB,NEXT,OPC + CALL ADJUST + CALL CMP + EX AF,AF ;AF' = result + POP AF ;stk RJOB,NEXT; A=OPC + CP 0F6H ;< + JR NZ,NXTCP1 + EX AF,AF + JR C,TRUE +FALSE: LD BC,0 +RLBACK: LD (HL),C + INC HL + LD (HL),B + INC HL + XOR A + LD (HL),A + INC HL + LD (HL),A + INC HL + LD (HL),A + LD A,5 + LD (PRCSON),A + POP AF ;POP NEXT + POP HL ;POP RJOB + JR EXPR3L +; +TRUE: LD BC,8081H + JR RLBACK +; +NXTCP1: CP 0F5H ;> + JR NZ,NXTCP2 + EX AF,AF + JR Z,FALSE + JR C,FALSE + JR TRUE +; +NXTCP2: CP 0F4H ;= + JR NZ,NXTCP3 + EX AF,AF + JR Z,TRUE + JR FALSE +; +NXTCP3: CP 0F2H ;=>,>= + JR C,NXTCP4 + EX AF,AF + JR NC,TRUE + JR FALSE +; +NXTCP4: CP 0F0H ;=<,<= + JR C,NXTCP5 + EX AF,AF + JR Z,TRUE + JR C,TRUE + JR FALSE +; +NXTCP5: EX AF,AF ;<>,>< + JR Z,FALSE + JR TRUE +; +; +EXPR2: CALL EXPR1 +EXPR2L: CP 0F7H ;+,- + RET C + LD A,(PRCSON) + PUSH AF + INC HL + JR Z,EXPR2A ;+ + CALL EXPR1 + POP BC + PUSH AF + PUSH HL + CALL ADJUST + CALL SUB +EXPR2X: POP HL + POP AF + JR EXPR2L +EXPR2A: CALL EXPR1 + POP BC + PUSH AF + PUSH HL + CALL ADJUST + CALL ADD + JR EXPR2X +; +; +EXPR1: CALL EXPR0 +EXPR1L: CP 0F9H ;MOD, YEN + RET C + LD A,(PRCSON) + PUSH AF + INC HL + JR Z,EXPR1A ;YEN + CALL EXPR0 + POP BC + PUSH AF + PUSH HL + CALL ADJUST + CALL MOD +EXPR1X: POP HL + POP AF + JR EXPR1L +EXPR1A: CALL EXPR0 + POP BC + PUSH AF + PUSH HL + CALL ADJUST + CALL YEN + JR EXPR1X +; +; +EXPR0: CALL EXPRZ +EXPR0L: CP 0FBH ;/,* + RET C + LD A,(PRCSON) + PUSH AF + INC HL + JR Z,EXPR0A ;/ + CALL EXPRZ + POP BC + PUSH AF + PUSH HL + CALL ADJUST + CALL MUL +EXPR0X: POP HL + POP AF + JR EXPR0L +EXPR0A: CALL EXPRZ + POP BC + PUSH AF + PUSH HL + CALL ADJUST + CALL DIV + JR EXPR0X +; +EXPRZ: + CALL TEST1 + DEFB 0F7H ;+ + JR Z,EXPRZ + CP 0F8H ;- + JR NZ,EXPRY + INC HL + CALL EXPRY + JR EXPRX2 +; +EXPRY: CALL FACTOR +EXPRYL: CP 0FDH ;^ + RET NZ + LD A,(PRCSON) + PUSH AF + INC HL + CALL EXPRX + POP BC + PUSH AF + PUSH HL + CALL ADJUST ; + CALL POWERS ;(HL)^(DE) + POP HL + POP AF + JR EXPRYL +; +EXPRX: + CALL TEST1 + DEFB 0F7H ;+ + JR Z,EXPRX + CP 0F8H ;- + JR NZ,FACTOR + INC HL + CALL FACTOR +EXPRX2: PUSH AF + PUSH HL + LD HL,-5 + ADD HL,DE + CALL NEG + POP HL + POP AF + RET +; + +FACTOR: CALL ENDCHK + JP Z,ER01 + CALL FAC0 + JP HLFTCH +; +FAC0: PUSH HL + LD HL,(MEMLMT) + SCF + SBC HL,DE + JP C,ER06__ ;TOO COMPLEX EXPR + POP HL + CP 0E4H ;PI + JR Z,FACPAI + CP 20H + JR NC,VARFNC ;IM 20 .... +; +FACNUM: ;Factor(numeric) + INC HL + CP 15H + JR C,FACINT + CALL LDIR5 ;IM 15 + JR FACR5 +FACPAI: INC HL + PUSH HL + LD HL,FLTPAI + CALL LDIR5 + POP HL +FACR5: LD A,5 +FACRX: LD (PRCSON),A + RET +; +FACINT: CP 0BH ;IM 00 .. 14 + JR NC,FACI4 + DEC A + JP M,ER01 ;IM 00 + LD B,0 + LD C,A + JR FACI6 +; +FACI4: LD C,(HL) ;IM 0B .. 14 + INC HL + LD B,(HL) + INC HL + CP 0CH + JR NZ,FACI6 + INC BC + INC BC + LD A,(BC) + INC BC + EX AF,AF + LD A,(BC) + LD B,A + EX AF,AF + LD C,A +FACI6: PUSH HL + PUSH DE + EX DE,HL + LD E,C + LD D,B + CALL FLTHEX + POP DE + POP HL + LD A,5 +FACRX5: + INC DE + INC DE + INC DE + INC DE + INC DE + JR FACRX +; +VARFNC: CP '"' + JR NZ,VARFN1 + INC HL + PUSH HL + CALL STRLCK ;B=len(HL str.) + EX (SP),HL ;New text point + PUSH HL ;Old text point + LD HL,(TMPEND) + PUSH BC + LD BC,(STRST) + OR A + SBC HL,BC ;HL=OFSET+ADR + POP BC + EX DE,HL + LD (HL),B ;FAC set len. + INC HL + LD (HL),E ;FAC set adrs + INC HL + LD (HL),D + INC HL + INC HL + INC HL + POP DE ;Old text point + PUSH HL ;New expr point + LD HL,(TMPEND) + CALL STRENT ;(HL)_(DE),B + LD (TMPEND),HL + POP DE ;New expr point + POP HL ;New text point + LD A,3 + LD (PRCSON),A + RET +; +VARFN1: CP '(' + JR NZ,FUNC + INC HL ;( ... ) + CALL EXPR8 + JP CH29H +; +; +; +FUNC: OR A ;Function + JP P,VARFN2 + CP 0E7H ;SPC ==> + INC HL + JR NZ,FUNC1 + LD B,5 ;param is numeric + LD A,0A8H ; SPACE$ + PUSH AF + JR FUNC2 +FUNC1: CP 0FFH + JP NZ,ER01 + LD A,(HL) + INC HL + CP 0A0H + JP Z,CHR_OP ;CHR$ + CP 0C8H + JP NC,ER01 + CP 0BAH + JR NC,GETJPA ;complex + CP 9CH ;JOY STICK + JR Z,GETJPA + CP 9DH ;JOY STRIG + JP Z,GETJPA + PUSH AF + CP 0B3H + JR NC,SYSV ;system var + LD B,3 + CP 0ABH + JR NC,FUNC2 ;param is string + LD B,5 ;param is numeric + CP 88H ;RND + JR Z,RNDONL +FUNC2: CALL HCH28H +FUNC4: PUSH BC + CALL EXPR8 + CALL CH29H + POP AF + CALL STRCK +FUNC6: POP AF + PUSH DE + PUSH HL + LD HL,-5 + ADD HL,DE + CALL GETJPA + POP HL + POP DE + RET +; +; +RNDONL: + CALL TEST1 + DEFM "(" + JR Z,FUNC4 +SYSV: LD A,5 + LD (PRCSON),A + PUSH HL + LD HL,FLONE + CALL LDIR5 + POP HL + JR FUNC6 + +; +GETJPA: PUSH HL + ADD A,A + LD L,A + LD H,0 + LD BC,FJPTBL + ADD HL,BC + LD A,(HL) + INC HL + LD H,(HL) + LD L,A + EX (SP),HL + RET +; +SIZE: + EX DE,HL + LD HL,-527 + ADD HL,SP + LD BC,(TMPEND) + OR A + SBC HL,BC + EX DE,HL + JR NC,PUT2B + XOR A + JR PUT1B +; +CSRH: + LD A,(CURX) + JR PUT1B +CSRV: + LD A,(CURY) + JR PUT1B +POSH: + LD DE,(POINTX) + JR PUT2B +POSV: + LD DE,(POINTY) + JR PUT2B +ERR: + LD A,(ERRCOD) +PUT1B: LD E,A + LD D,0 +PUT2B: LD A,5 + LD (PRCSON),A + JP FLTHEX +; +ERL: + LD DE,(ERRLNO) + CALL FLTHEX + INC HL + BIT 7,(HL) + DEC HL + RET Z + LD DE,FL64K + JP ADD +; +FL64K: DEFB 0x91,0x00,0x00,0x00,0x00 ;65536 + +; +CHR_OP: CALL HCH28H + LD B,0 +CHR_LP: PUSH BC ;counter + PUSH DE ;FAC + CALL DEEXP + CALL DCHECK + POP DE ;FAC + POP BC ;counter + PUSH AF ;data + INC B + CALL TEST1 + DEFM "," + JR Z,CHR_LP + CALL CH29H + LD A,B ;length + EXX + LD B,A + LD HL,(TMPEND) ;string start + CALL ADDHLA + LD DE,HL ;string end+1 + CALL MEMECK +CHR_4: DEC HL + POP AF ;data + LD (HL),A + DJNZ CHR_4 + EXX + LD A,B ;length + EXX + LD B,A +; +;HL=String start +;DE=String end+1 +;B =String length +;DE'=FAC +;HL'=TEXT,?? +; +STEXR2: LD (TMPEND),DE + LD DE,(STRST) + OR A + SBC HL,DE + PUSH HL + LD A,B + EXX + EX DE,HL + LD (HL),A + INC HL + POP BC + LD (HL),C + INC HL + LD (HL),B + LD BC,3 ; + ADD HL,BC +STRPRS: EX DE,HL + LD A,3 + LD (PRCSON),A + RET + +; +HEX_S: + PUSH HL + CALL HLFLT + CALL HEXHL + RST 3 + DEFB _COUNT +; +; DE:adrs +; B:length +; (SP):Text pointer +; +PUTSTR: + LD A,B + OR A + JR Z,NULSPC + LD HL,(TMPEND) + PUSH HL + PUSH BC + CALL STRENT + POP BC + EX DE,HL + POP HL + EXX + POP DE + EXX + JR STEXR2 +NULSPC: POP HL + CALL CLRFAC + JR STRPRS +; +SPACE_S: + PUSH HL + CALL HLINCK + LD B,A + LD C,A + OR A + LD A,' ' + PUSH DE + CALL NZ,SETDE + POP DE + LD B,C + JR PUTSTR +; +HLINCK: CALL HLFLT + LD DE,KEYBUF + LD A,H + OR A + JP NZ,ER03__ + LD A,L + RET + +; +; +STR_S: + PUSH HL + CALL CVNMFL + LD A,(DE) + CP ' ' + JR NZ,$+3 + INC DE + RST 3 + DEFB _COUNT + JR PUTSTR +; + +EOF: + CALL HCH28H + CALL GETLU + LD B,A + CALL HCH29H + LD A,B + PUSH HL + PUSH DE + RST 3 + DEFB _SEGAD + LD DE,-1 + JR C,EOF2 + INC HL + BIT __EOF,(HL) + JR NZ,EOF2 + LD DE,0 +EOF2: POP HL + CALL FLTHEX + LD A,5 + LD (PRCSON),A +EOF8: + INC HL + INC HL + INC HL + INC HL + INC HL + EX DE,HL + POP HL + RET +; +POINT: + CALL HCH28H + PUSH DE ;EXPR pointer + CALL DEEXP ;X + LD BC,DE ;X + POP DE ;EXPR pointer + PUSH DE ;EXPR pointer + PUSH BC ;X + CALL CH2CH + CALL DEEXP ;Y + CALL CH29H + EX (SP),HL ;HL=X + EX DE,HL + RST 3 + DEFB _POINT + INC A + JP Z,ER03__ ;Out of range + DEC A + POP DE ;TEXT pointer + POP HL ;EXPR pointer + PUSH DE ;TEXT pointer + CALL PUT1B + JR EOF8 + +; +ASC: + PUSH HL + CALL CVTSDC + OR A + JR Z,$+3 + LD A,(DE) + JR LEN2 +; +LEN: + PUSH HL + CALL CVTSDC +LEN2: POP HL + JP PUT1B +; +VAL: + PUSH HL + CALL CVTSDC + LD HL,(TMPEND) + PUSH HL + CALL STRENT + LD (HL),0 + POP DE + POP HL + JP CVFLAS + +; +LEFT_S: + CALL CH28EX + CALL CH29H + CALL BCHECK + EX DE,HL + LD A,(HL) + CP C + JR NC,$+3 + LD C,A + LD (HL),C + LD BC,5 +FACSTR: LD A,3 + ADD HL,BC + EX DE,HL + LD (PRCSON),A + JP HLFTCH +; +RIGHT_S: + CALL CH28EX + CALL CH29H + CALL BCHECK + EX DE,HL + LD A,(HL) + SUB C + JR NC,MID_EE + XOR A + LD C,(HL) +MID_EE: LD (HL),C + INC HL + ADD A,(HL) + LD (HL),A + INC HL + JR NC,$+3 + INC (HL) + LD BC,3 ; + JR FACSTR + +; +MID_S: + CALL CH28EX + CALL BCHECK + OR A + JP Z,ER03__ + PUSH AF + CALL TEST1 + DEFM ")" + LD A,0FFH + JR Z,MID_2 + CALL HCH2CH + PUSH DE + EX DE,HL + LD BC,5 + ADD HL,BC + EX DE,HL + CALL DEEXP + CALL CH29H + CALL DCHECK + POP DE +MID_2: POP BC + LD C,A + EX DE,HL + LD A,(HL) + SUB B + JR C,MIDNUL + INC A + CP C + JR NC,$+3 + LD C,A + LD A,B + DEC A + JR MID_EE +; +MIDNUL: XOR A + LD C,A + JR MID_EE +; +BCHECK: LD A,B + OR A + JP NZ,ER03__ + LD A,C + RET +; +CH28EX: CALL HCH28H + PUSH DE + CALL EXPR8 + CALL CH2CH + CALL STROK + CALL DEEXP + LD C,E + LD B,D + POP DE + RET + +; +TI_S: + PUSH HL + PUSH DE + LD HL,(TMPEND) + PUSH HL + LD A,'0' + LD B,6 + CALL SETHL + RST 3 + DEFB _TIMRD ;A,DE + POP HL + OR A + JR Z,TI_S2 + INC (HL) + INC HL + INC (HL) + INC (HL) + DEC HL +TI_S2: EX DE,HL + LD BC,8CA0H ;10H + CALL CLDGIT + LD BC,0E10H ;1H + CALL CLDGIT + CP 3AH + JR C,TI_S4 + SUB 10 + DEC DE + LD (DE),A + DEC DE + LD A,(DE) + INC A + LD (DE),A + INC DE + INC DE +TI_S4: DEC DE + DEC DE + LD A,(DE) + INC DE + LD B,A + LD A,(DE) + INC DE + LD C,A + LD A,B + CP 32H + JR NZ,TI_S6 + LD A,C + CP 34H + JR NZ,TI_S6 + LD HL,(TMPEND) + LD A,'0' + LD B,6 + CALL SETHL + JR TI_S8 +TI_S6: LD BC,258H ;10M + CALL CLDGIT + LD BC,3CH ;1M + CALL CLDGIT + LD BC,0AH ;10S + CALL CLDGIT + LD A,30H + ADD A,L + LD (DE),A +TI_S8: LD HL,(TMPEND) + LD DE,6 + EX DE,HL + ADD HL,DE + LD (TMPEND),HL + EX DE,HL + LD DE,(STRST) + OR A + SBC HL,DE + EX DE,HL + POP HL + LD (HL),6 + INC HL + LD (HL),E + INC HL + LD (HL),D + INC HL + INC HL + INC HL + EX DE,HL + POP HL + LD A,3 + LD (PRCSON),A + JP HLFTCH +; +CLDGIT: OR A + SBC HL,BC + JR C,CLDGRT + LD A,(DE) + INC A + LD (DE),A + JR CLDGIT +CLDGRT: ADD HL,BC + INC DE + RET +; +TIMDAI: + CALL TESTX + DEFB 0F4H ;TI$=.... + CALL STREXP + LD A,B + CP 6 + JP NZ,ER03__ + PUSH HL + PUSH DE + LD HL,0 + CALL TIMASC + CP 24 + JP NC,ER03__ + CP 12 + LD A,0 + JR C,TIMDA2 + PUSH DE + LD DE,12 + OR A + SBC HL,DE + POP DE + INC A +TIMDA2: PUSH AF + CALL TIMASC + CP 60 + JP NC,ER03__ + CALL TIMASC + CP 60 + JP NC,ER03__ + POP AF + EX DE,HL + RST 3 + DEFB _TIMST + POP DE + POP HL + RET +; +TIMASC: PUSH DE + LD D,H + LD E,L + ADD HL,HL + ADD HL,HL + ADD HL,DE + LD D,H + LD E,L + ADD HL,HL + ADD HL,DE + ADD HL,HL + ADD HL,HL + POP DE + LD A,(DE) + INC DE + SUB 30H + JP C,ER03__ + CP 0AH + JP NC,ER03__ + PUSH BC + LD C,A + ADD A,A + ADD A,A + ADD A,C + ADD A,A + LD C,A + LD A,(DE) + INC DE + SUB 30H + JP C,ER03__ + CP 0AH + JP NC,ER03__ + ADD A,C + LD C,A + LD B,0 + ADD HL,BC + POP BC + RET + +; +INTGTV: + LD DE,(VARED) + LD (TMPEND),DE + LD DE,(INTFAC) +GETVAR: PUSH DE + CALL VSRTST +GETFNV: LD A,(HL) + CP '(' + JP Z,ARRAY + PUSH HL + CALL CHVRNM + JR NC,CRNVAR + LD A,C + LD C,L + LD B,H + POP HL + POP DE + RET +; +CRNVAR: LD A,(DE) + ADD A,C ;VAR.LEN.+TYPE + ADD A,2 + PUSH BC + EX DE,HL + LD HL,(TMPEND) + PUSH HL + OR A + SBC HL,DE + INC HL + LD C,L + LD B,H + POP HL + PUSH DE + EX DE,HL + LD L,A + LD H,0 + ADD HL,DE + EX DE,HL + CALL MEMECK + LDDR + LD E,A + LD D,0 + RST 3 + DEFB _ADDP2 + POP HL + POP BC + LD DE,KEYBUF + LD (HL),C ;TYPE SET + INC HL + SCF + SBC A,C ;B=A-C-1 + LD B,A +VARSL1: LD A,(DE) ;VAR.LEN.&NAME + LD (HL),A + INC DE + INC HL + DJNZ VARSL1 + PUSH HL + LD B,C + CALL CLRHL ;VAR.CLR + LD (HL),A ;VAR.END MARK + LD A,C + POP BC + POP HL + POP DE + RET +; +VSRTST: CALL HLFTCH + SUB 'A' + CP 26 + JP NC,ER01 + LD DE,KEYBUF + LD B,0 +VSRTS1: INC DE + LD A,(HL) + CALL TSTVAR + JR C,TSTTYP + LD (DE),A + INC B + LD A,B + CP 3 + JR C,$+3 + DEC B + INC HL + JR VSRTS1 +TSTTYP: LD DE,KEYBUF + EX DE,HL + LD (HL),B + EX DE,HL + LD C,5 + CP 24H ;$ + RET NZ + LD C,3 + INC HL + RET +; +ADJUST: LD HL,-5 + EX DE,HL + ADD HL,DE + EX DE,HL + ADD HL,DE + LD A,B + JP STRCK +; +; +STRLCK: LD B,0FFH +STRLL1: INC B + LD A,(HL) + OR A + RET Z + INC HL + CP '"' + RET Z + JR STRLL1 +; +STRENT: + LD A,B + OR A + RET Z + CALL LDHLDE + EX DE,HL + CALL MEMECK + EX DE,HL + RET +; +; +MEMECK: ;SBC SP,DE + PUSH HL + LD HL,-512 + ADD HL,SP + SBC HL,DE + POP HL + RET NC + JP ER06_ +; +; +; +; PUSH DE +; KEYBUF..LEN. NAME +; HL=( +; +ARRAY0: LD DE,(INTFAC) + PUSH DE + JR ARRAY2 +; +ARRAY: XOR A + LD (AUTDIM),A + INC HL + LD (ARYTXT),HL +ARRAY2: LD B,0 + EXX + POP HL ;POP FAC + PUSH HL ;PUSH FAC + PUSH HL ;PUSH FAC1 + LD HL,(TMPEND) + LD DE,KEYBUF + PUSH HL + LD A,(DE) + LD (HL),A + INC DE + INC HL + LD B,A + CALL STRENT + POP DE + LD (TMPEND),HL + LD HL,(STRST) + EX DE,HL + OR A + SBC HL,DE + EX (SP),HL ;NAME ADR. + PUSH HL ;PUSH FAC1 + EXX +TSALOP: POP DE ;POP FAC1 + PUSH DE ;PUSH FAC1 + PUSH BC ;PUSH B,TYPE(C) + LD BC,(ARYTXT) + LD A,(AUTDIM) + PUSH BC + PUSH AF + LD BC,(DGBF00) + PUSH BC + CALL DEEXP ;¯¯DE=EXP(INT) + BIT 7,D + JP NZ,ER03__ + EX AF,AF + POP BC + LD (DGBF00),BC + POP AF + LD (AUTDIM),A + POP BC + LD (ARYTXT),BC + EX AF,AF + INC HL + CP ')' + JR Z,TSFARY + CP ',' + JP NZ,ER01 + POP BC ;POP B,TYPE(C) + INC B ;(.,.,.,.) + LD A,B + CP 4 + JP NC,ER03__ + EXX + POP HL ;POP FAC1 + POP DE ;POP NAME ADR. + EXX + PUSH DE ;ANS + EXX + PUSH DE ;PUSH NAME ADR. + PUSH HL ;PUSH FAC1 + EXX + JR TSALOP +; +TSFARY: POP BC ;POP B,TYPE(C) + EXX + POP HL ;POP FAC1 + POP DE ;POP NAME ADR. + EXX + INC B ;ARRAY POINT + PUSH DE ;ANS + PUSH HL ;PUSH TEXT POINT + EXX + LD HL,(STRST) + ADD HL,DE + LD B,(HL) + INC B + LD DE,KEYBUF + CALL LDDEHL + EXX + SET 7,C + CALL CHVRNM + RES 7,C + JR NC,ARYDIM + LD A,B + CP (HL) + JP NZ,ER07 ;DUPLICATE +;LD A,(AUTDIM) +;OR A +;JP NZ,ER07 + INC HL + EX DE,HL + POP HL + LD (DGBF00),HL ;TEXT END + EXX + LD HL,0000H + EXX + EX DE,HL +ADRCL: LD E,(HL) + INC HL + LD D,(HL) + INC HL + EX (SP),HL + PUSH DE + EXX + POP DE + CALL DIMMUL + EXX + PUSH HL + OR A + SBC HL,DE + JP NC,ER03__ + EXX + POP DE + CALL DIMADD + EXX + POP HL + DJNZ ADRCL + PUSH HL + EXX + LD A,C + LD D,B + BIT 6,A + JR NZ,VARDIM + AND 0FH + LD E,A + PUSH AF + CALL DIMMUL + PUSH HL + EXX + POP BC + POP AF + POP HL + ADD HL,BC + LD C,L + LD B,H +VARDME: LD HL,(DGBF00) + POP DE + RET +; +VARDIM: LD E,(HL) + INC HL + LD D,(HL) + POP HL + LD C,L + LD B,H + LD (HL),E + INC HL + LD (HL),D + AND 0FH + JR VARDME +; +; +ARYDIM: EXX + LD A,(AUTDIM) + OR A + JP Z,ER03__ + POP HL ;TEXT POINT + LD (DGBF00),HL + EXX + LD DE,(TMPEND) + LD L,B + LD H,0 + ADD HL,HL + ADD HL,DE + EX DE,HL + INC DE + CALL MEMECK + LD (HL),B + INC HL + EXX + LD HL,1 + EXX +ADRCL_: POP DE + LD A,(AUTDIM) + OR A + JR NZ,ADRC__ + PUSH HL ;1 + EX DE,HL + LD DE,10 + SCF + SBC HL,DE + JP NC,ER03__ + POP HL ;1 +ADRC__: INC DE + LD (HL),E + INC HL + LD (HL),D + INC HL + PUSH DE + EXX + POP DE + CALL DIMMUL + EXX + DJNZ ADRCL_ + LD E,C + LD D,0 + PUSH BC + PUSH DE + EXX + POP DE + CALL DIMMUL + PUSH HL + EXX + POP BC + PUSH BC ;2 A*B*C*D + EX DE,HL + LD HL,(TMPEND) ;(.,.,.)*2 + LD L,(HL) + LD H,0 + ADD HL,HL + LD A,(KEYBUF) ;+NAME + ADD A,5 ;+TY+LN+NL+(.,.) + ADD A,L + LD L,A + LD A,0 + ADC A,H + LD H,A + JR C,DIMOVM + ADD HL,BC + JR C,DIMOVM + PUSH HL ;3 LEN + ADD HL,DE ;+TEMPEND +DIMOVM: JP C,ER06_ + EX DE,HL + CALL MEMECK + PUSH HL ;4 TMPEND + EXX + POP HL ;4 TMPEND + LD BC,(STRST) ;VAR END + DEC BC + OR A + SBC HL,BC + PUSH HL ;4 TRANS LEN + EXX + POP BC ;4 TRANS LEN + LDDR + POP DE ;3 LEN + RST 3 + DEFB _ADDP2 + POP BC ;2 CLR LEN + PUSH DE ;2 LEN + EXX + POP DE ;2 LEN + LD H,B + LD L,C + POP BC ;1 TYPE + LD A,C + OR 80H + LD (HL),A + INC HL + DEC DE + LD (HL),E + INC HL + LD (HL),D + INC HL + LD DE,KEYBUF + LD A,(DE) + INC A + LD B,A + CALL LDHLDE + LD DE,(TMPEND) + LD A,(DE) + LD (HL),A + INC HL + INC DE + ADD A,A + LD B,A + CALL LDHLDE + PUSH HL + EXX + POP HL +DIMCLR: XOR A + LD (HL),A + INC HL + DEC BC + LD A,B + OR C + JR NZ,DIMCLR + LD (HL),A + EXX + POP DE + LD A,(AUTDIM) + OR A + JR Z,VARCUL + LD HL,(DGBF00) + RET +; +VARCUL: LD HL,(ARYTXT) + PUSH DE + JP ARRAY2 + +; +DIM: + LD A,0FFH + LD (AUTDIM),A +NXTDIM: CALL VSRTST + LD A,(HL) + CALL CH28H + CALL ARRAY0 + CALL HLFTCH + CP ',' + RET NZ + INC HL + JR NXTDIM +; +DIMADD: ADD HL,DE + RET NC + JR SORDIM +; +DIMMUL: PUSH BC + EX DE,HL + LD C,L + LD A,H + LD HL,0 + CALL DMMULS + LD A,C + CALL DMMULS + POP BC + RET +; +DMMULS: OR A + JR Z,SKPMUL + LD B,8 +DMMULP: ADD HL,HL + JR C,SORDIM + RLCA + JR NC,DMMULE + ADD HL,DE + JR C,SORDIM +DMMULE: DJNZ DMMULP + RET +; +SKPMUL: LD A,H + LD H,L + LD L,0 + OR A + RET Z +SORDIM: JP ER06__ +; +; +ARYTXT: DEFS 2 +AUTDIM: DEFS 1 + +; +VARFN2: SUB 'A' + CP 26 + JP NC,ER01 + LD BC,(FNVRBF) + LD A,B + OR C + JR NZ,FNGTVR + CALL GETVAR +FNGTV2: PUSH DE + PUSH HL + LD L,C + LD H,B + LD B,A + LD C,A + CALL LDDEHL + POP HL + LD A,C + POP DE + JP FACRX5 +; +FNGTVR: PUSH DE + CALL VSRTST + PUSH HL + INC B + LD DE,KEYBUF + LD HL,(TMPEND) + CALL STRENT + LD B,0 + LD HL,(FNVRBF) + CALL HLFTCH + CP 0F4H + JR Z,FNSHNO + CP '(' + JR NZ,SERROL ;¯¯JP NZ,ER01 +FNGTL1: INC HL + INC B + PUSH BC + CALL VSRTST + LD A,C + POP DE + CP E ;TYPE + LD C,E ;¯¯ + JR NZ,FNGTL2 + PUSH DE + LD C,B + INC C + PUSH HL + LD HL,(TMPEND) + LD DE,KEYBUF + CALL _HLDECK + POP HL + POP BC + JR Z,FNSHOK +FNGTL2: CALL HLFTCH + CP ')' + JR Z,FNSHNO + CP ',' + JR Z,FNGTL1 ;¯¯¯ +SERROL: JP ER01 ;¯¯ +FNSHNO: LD HL,(TMPEND) + LD DE,KEYBUF + LD A,(HL) + LD (DE),A + LD B,A + INC HL + INC DE + LD A,(HL) + LD (DE),A + DJNZ $-4 + POP HL + POP DE + CALL FNGTV1 + JR FNGTV2 +; +FNSHOK: LD HL,(FNTXBF) + CALL HCH28H + DEC B + JR Z,FNSH13 + DEC HL +FNSH11: PUSH BC +FNSH12: CALL IFSKSB + CALL ENDCHK + JP Z,ER01 + CP ')' + JP Z,ER01 + CP ',' + JR NZ,FNSH12 + POP BC + DJNZ FNSH11 + INC HL +FNSH13: EX DE,HL + POP HL + EX (SP),HL + EX DE,HL + LD BC,(FNVRBF) + PUSH BC + LD BC,0 + LD (FNVRBF),BC + CALL EXPR8 + POP HL + LD (FNVRBF),HL + POP HL + JP HLFTCH +; +FNGTV1: PUSH DE + JP GETFNV + +; +CHVRNM: + LD HL,(VARST) +ASLOP: LD DE,KEYBUF + LD A,(HL) + OR A + RET Z + CP 40H + JR NC,ARYATA + CP C + JR NZ,SKIPUS + INC HL + LD A,(DE) + CP (HL) + JR NZ,SKIPU2 + LD B,A +VARCL1: INC DE + INC HL + LD A,(DE) ;ÛÛ + CP (HL) ;ÛÛ +;CALL NZ,SMALCH + JR NZ,SKIPU3 + DJNZ VARCL1 + INC HL + SCF + RET +SKIPU3: INC HL + DJNZ SKIPU3 + LD A,C + JR ARSKFN +SKIPU2: LD A,C + DEC HL +SKIPUS: AND 0FH ;TYPE + INC HL + ADD A,(HL) ;NAME LEN. + INC HL +ARSKFN: LD E,A + LD D,0 + ADD HL,DE + JR ASLOP +; +; +ARYATA: CP C ;TYPE + JR Z,ARMSN1 + INC HL +MIDNAM: LD E,(HL) + INC HL + LD D,(HL) + DEC HL + ADD HL,DE + JR ASLOP +; +NXTVR1: LD A,C + SUB B + CPL + LD C,A + LD B,0FFH + ADD HL,BC + POP BC +NXTVR: DEC HL + DEC HL + JR MIDNAM +; +; +ARMSN1: LD A,(HL) + EXX + LD C,A + LD B,00H + EXX + INC HL + PUSH DE + LD E,(HL) + INC HL + LD D,(HL) + INC HL + EX DE,HL + ADD HL,DE +;LD (ARYEDA),HL + EX DE,HL + POP DE + LD A,(DE) + CP (HL) ;NAME LEN. + JR NZ,NXTVR + PUSH BC + LD B,A + LD C,A +AYNMCK: INC HL + INC DE + LD A,(DE) ;ÛÛ + CP (HL) ;ÛÛ + JR NZ,NXTVR1 + DJNZ AYNMCK + INC HL + POP BC + SCF + RET + +; +DEFFN: + CALL VSRTST + SET 6,C + PUSH HL + CALL CHVRNM + JP C,ER07 ;ARY DEF ERR + LD (HL),C + EX (SP),HL + PUSH HL + DEC HL +FNSKP1: CALL IFSKSB + OR A + JR Z,FNSKED + CP 3AH ;: + JR NZ,FNSKP1 +FNSKED: POP DE + PUSH HL + INC HL + SBC HL,DE + LD A,(KEYBUF) + ADD A,4 + LD C,A + LD B,0 + LD A,L + ADD HL,BC + LD B,A + PUSH HL + EXX + POP BC + PUSH BC + PUSH HL + PUSH DE + PUSH BC + LD HL,0 + ADD HL,SP + LD DE,(TMPEND) + DEC H + OR A + SBC HL,DE + LD A,12 + JP C,NESTER + POP BC + POP DE + POP HL + LD HL,(TMPEND) + PUSH HL + ADD HL,BC + EX (SP),HL + PUSH HL + LD DE,(STRST) ;VAR END + OR A + SBC HL,DE + LD C,L + LD B,H + POP HL + POP DE + LDDR + POP DE + RST 3 + DEFB _ADDP2 + DEC DE + POP HL + EX (SP),HL + INC HL + LD (HL),E + INC HL + LD (HL),D + INC HL + LD DE,KEYBUF + LD A,(DE) + LD (HL),A + LD B,A + INC DE + INC HL + LD A,(DE) + LD (HL),A + DJNZ $-4 + INC HL + PUSH HL + EXX + POP HL + CALL LDHLDE + LD (HL),0 + POP HL + RET +; +FNEXP: + PUSH DE + CALL VSRTST + POP IX + PUSH BC + SET 6,C + LD DE,(FNTXBF) + LD (FNTXBF),HL + PUSH DE + CALL CHVRNM + JP NC,ER15 ;UNDEF FN + LD DE,(FNVRBF) + LD (FNVRBF),HL + PUSH DE + PUSH IX + DEC HL +FNEQSK: CALL IFSKSB + CALL ENDCHK + JP Z,ER01 + CP 0F4H ;= + JR NZ,FNEQSK + INC HL + POP DE + PUSH DE + CALL EXPR8 + POP DE + LD HL,(FNTXBF) + POP BC + LD (FNVRBF),BC + POP BC + LD (FNTXBF),BC + EX DE,HL + POP BC + LD A,C + CALL STRCK + LD BC,5 + ADD HL,BC + EX DE,HL + CALL HLFTCH + CP '(' + RET NZ + PUSH DE + LD B,1 +SK29LP: PUSH BC + CALL IFSKSB + POP BC + CALL ENDCK0 + JP Z,ER01 + CP '(' + JR NZ,$+3 + INC B + CP ')' + JR NZ,SK29LP + DJNZ SK29LP + INC HL + CALL HLFTCH + POP DE + RET +; +STRCK: CP 3 + JR NZ,STROMT +STROK: + LD A,(PRCSON) + CP 3 + RET Z + JP ER04 ;TYPE MISMATCH +STROMT: + LD A,(PRCSON) + CP 3 + RET NZ + JP ER04 +; +FNVRBF: + DEFW 0 +FNTXBF: DEFS 2 + +; +; THIS _IS_ REDUNDANT !! +; +_HLDECK: LD A,(DE) + CP (HL) + RET NZ + PUSH BC + PUSH DE + PUSH HL + LD B,C +_HLDEC1: LD A,(DE) + CP (HL) + JR NZ,_HLDEC2 + INC DE + INC HL + DJNZ _HLDEC1 + XOR A +_HLDEC2: POP HL + POP DE + POP BC + RET +; +; Joy stick command +; +STCK: + CALL HCH28H + PUSH DE + CALL DEEXP + CALL DCHECK + CP 3 + JP NC,ER03__ + POP DE + PUSH AF + CALL HCH29H + POP AF + RST 3 + DEFB _STICK + EX DE,HL + PUSH DE + CALL PUT1B + JP EOF8 +; +STIG: + CALL HCH28H + PUSH DE + CALL DEEXP + CALL DCHECK + CP 5 + JP NC,ER03__ + POP DE + PUSH AF + CALL HCH29H + POP AF + RST 3 + DEFB _STRIG + EX DE,HL + PUSH DE + CALL PUT1B + JP EOF8 +; +; END (909EH) + + +; ORG 909EH + +; ---------------------------- +; MZ-800 BASIC Floating point +; FI:FLOAT ver 1.0A 7.18.84 +; Programed by T.Miho +; ---------------------------- +; +; +; +CLRFAC: + PUSH HL + LD B,5 + CALL CLRHL + POP HL + RET +; +NEG: + CALL STROMT +TOGLE: + LD A,(HL) + OR A + RET Z + INC HL + LD A,(HL) + XOR 80H + LD (HL),A + DEC HL + RET +; +; +;(HL)=(HL)-(DE) +; +SUB: + CALL STROMT + LD C,A + LD A,80H + JP ADDSUB +; +;(HL)=(HL)+(DE) +; +ADD: + LD A,(PRCSON) + CP 03H + JP Z,STRADD + LD C,A + XOR A +ADDSUB: LD (HLBUF),HL + PUSH DE + PUSH HL + LD (SPBUF),SP + INC HL + INC DE + LD B,(HL) ; + XOR (HL) + EX DE,HL + XOR (HL) + DEC HL + DEC DE + EX DE,HL + RLCA + LD A,B + LD (SIGN),A + JP C,FSUB ;HL-DE +; +FADD: XOR A ;HL+DE + CP (HL) + JP Z,_TRANS ;(HL)_(DE) + LD A,(DE) + OR A + JR Z,FLEXIT ;SIGN SET RET + SUB M ;DE-HL + JP SFADD +; +; +FLEXIT: LD SP,(SPBUF) + POP HL + POP DE + EI + LD A,(HL) + OR A + JP Z,ABS + LD A,(SIGN) + AND 80H + INC HL + RES 7,(HL) + OR (HL) + LD (HL),A + DEC HL + RET +; +_TRANS: LD B,0 + LD A,5 + LD C,A + EX DE,HL + LDIR + JP FLEXIT +; +STRADD: LD B,(HL) + LD A,(DE) + ADD A,B + JP C,ER05 ;STRING TOO LONG + LD C,A + PUSH DE + PUSH HL + PUSH DE + INC HL + LD E,(HL) + INC HL + LD D,(HL) + LD HL,(STRST) + ADD HL,DE + EX DE,HL + LD HL,(TMPEND) + CALL STRENT + EX (SP),HL + LD B,(HL) + INC HL + LD E,(HL) + INC HL + LD D,(HL) + LD HL,(STRST) + ADD HL,DE + EX DE,HL + POP HL + CALL STRENT + LD A,C + LD DE,(TMPEND) + LD BC,(STRST) + EX DE,HL + OR A + SBC HL,BC + EX DE,HL + LD (TMPEND),HL + POP HL + LD (HL),A + INC HL + LD (HL),E + INC HL + LD (HL),D + DEC HL + DEC HL + POP DE + RET +; +; +CMP: + LD A,(PRCSON) + CP 3 + JR NZ,FLTCP2 + PUSH DE + PUSH HL + LD A,(DE) + OR (HL) + JR Z,STCMPE + LD A,(DE) + CP (HL) + JR C,$+3 + LD A,(HL) + OR A + JR Z,STCMPF + INC HL + LD C,(HL) + INC HL + LD B,(HL) + EX DE,HL + INC HL + LD E,(HL) + INC HL + LD D,(HL) + LD HL,(STRST) + EX DE,HL + ADD HL,DE + EX DE,HL + ADD HL,BC + EX DE,HL + LD B,A + OR A + JR Z,STCMPE +STCMPL: LD A,(DE) + CP (HL) + JR NZ,STCMPE + INC DE + INC HL + DJNZ STCMPL +STCMPF: POP DE + POP HL + LD A,(DE) + CP (HL) + EX DE,HL + RET +; +STCMPE: POP HL + POP DE + RET +; +; +; +FLTCP2: INC DE + INC HL + LD A,(DE) + DEC DE + XOR (HL) + RLCA + JR NC,FLTCP3 + LD A,(HL) + DEC HL + RLCA + RET +FLTCP3: LD A,(HL) + DEC HL + RLCA + JR NC,FLTCMP + CALL FLTCMP + RET Z + CCF + RET +; +FLTCMP: PUSH DE + PUSH HL + EX DE,HL + LD A,(DE) + CP (HL) + JR NZ,SUBNZ + INC DE + INC HL + LD A,(HL) + OR 80H + LD B,A + LD A,(DE) + OR 80H + CP B + JR NZ,SUBNZ + LD A,(PRCSON) + LD B,A + DEC B + DEC B +CMPL: INC DE + INC HL + LD A,(DE) + CP (HL) + JR NZ,SUBNZ + DJNZ CMPL +SUBNZ: POP HL + POP DE + RET +; +ZERO: POP HL + PUSH HL + CALL CLRFAC + JP FLEXIT +; +FSUB: CALL FLTCMP + JR Z,ZERO + JR NC,SUBOK + LD A,(SIGN) + XOR 80H + LD (SIGN),A + SCF +SUBOK: EX AF,AF + LD A,(HL) + OR A + JP Z,_TRANS + LD A,(DE) + OR A + JP Z,FLEXIT + SUB M + JR C,FSUB11 + CP 32 + JP NC,_TRANS + JR SUBOK2 +FSUB11: NEG + CP 32 + JP NC,FLEXIT +SUBOK2: EX AF,AF + JR C,SUBOK_ + EX DE,HL +SUBOK_: EX AF,AF + JP SSUB +; +OVERF: LD SP,(SPBUF) + EI + POP HL + POP DE + LD A,(OFLAG) + OR A + JP Z,ER02 +;SET MAX NUM HERE ***** + RET +; +; +; +; +SFADD: JR NC,SNSH + NEG + CP 32 + JP NC,FLEXIT + EX DE,HL + JR SADD1 +SNSH: CP 32 + JP NC,_TRANS +SADD1: CALL SSHIFT + LD A,H + EXX + ADC A,H ; ADJUST WITH CARRY + EXX + LD H,A ; + LD A,L + EXX + ADC A,L + EXX + LD L,A + LD A,D + EXX + ADC A,D + EXX + LD D,A + LD A,E + EXX + ADC A,E + EXX + JR NC,SSTORE + RRA + RR D + RR L + RR H + INC C + JP Z,OVERF +SSTORE: LD E,A + LD A,C + EXX + LD BC,5 + LD HL,(HLBUF) + LD (HL),A + ADD HL,BC + DI + LD SP,HL + EXX + PUSH HL + PUSH DE + JP FLEXIT +; +SSHIFT: DI + LD (SPBF),SP + EX AF,AF + INC HL + LD SP,HL + EXX + POP DE ;E,D,L,H + SET 7,E ;CY=0 + POP HL + OR A +SHFLP2: EX AF,AF + CP 8 + JR C,BITET2 + SUB 8 + EX AF,AF + RL H + LD H,L + LD L,D + LD D,E + LD E,0 + JR SHFLP2 +BITET2: OR A + JR Z,BITSE2 +BITST2: EX AF,AF + OR A + RR E + RR D + RR L + RR H + EX AF,AF + DEC A + JR NZ,BITST2 +BITSE2: EXX + EX DE,HL + LD C,(HL) + INC HL + LD SP,HL + POP DE + SET 7,E + POP HL + EX AF,AF + LD SP,(SPBF) + EI + RET +; +SSUB: CP 32 + JP NC,FLEXIT + CALL SSHIFT + LD A,H + EXX + SBC A,H + EXX + LD H,A + LD A,L + EXX + SBC A,L + EXX + LD L,A + LD A,D + EXX + SBC A,D + EXX + LD D,A + LD A,E + EXX + SBC A,E + EXX +SSFL2: OR A + JR Z,BSIFT +SSFL3: BIT 7,A + JR NZ,SSTOR2 + RL H + RL L + RL D + RLA + DEC C + JP NZ,SSFL3 + JP ZERO +SSTOR2: LD E,A + JP SSTORE +BSIFT: LD A,C + SUB 8 + LD C,A + LD A,D + LD D,L + LD L,H + LD H,0 + JR Z,$+4 + JR NC,SSFL2 + JP ZERO +; +;--------------------- +; +EXPCHK: LD C,A + INC HL + INC DE + LD A,(DE) + XOR (HL) + LD (SIGN),A + DEC HL + DEC DE + RET +; +MUL: + CALL STROMT + CALL EXPCHK + PUSH DE + PUSH HL + LD (SPBUF),SP + LD A,(HL) + OR A + JP Z,ZERO + LD A,(DE) + OR A + JP Z,ZERO + INC DE + PUSH DE + POP IX + ADD A,(HL) + LD E,A + LD A,0 + ADC A,A + LD D,A + LD (EXPSGN),DE + INC HL + XOR A + LD (CYFLG),A + LD D,(HL) + SET 7,D + INC HL + LD E,(HL) + INC HL + PUSH HL + LD H,A + LD L,A + EXX + POP HL + LD D,(HL) + INC HL + LD E,(HL) + LD B,A + LD C,A + LD H,A + LD L,A + EXX + LD A,(IX+0) + OR 80H + LD C,4 ;BYTES COUNTER +SMULL1: LD B,8 ;BIT COUNTER + OR A + JP Z,SMULL5 +SMULL2: RLCA + JR NC,SMULL4 + EX AF,AF + EXX + LD A,C + ADD A,B + LD C,A + ADC HL,DE + EXX + ADC HL,DE + JR NC,SMULL3 + LD A,1 + LD (CYFLG),A +SMULL3: EX AF,AF +SMULL4: SRL D + RR E + EXX + RR D + RR E + RR B + EXX + DJNZ SMULL2 +SMULL6: INC IX + LD A,(IX+0) + DEC C + JR NZ,SMULL1 + EXX + LD A,(CYFLG) + OR A + JR Z,SMULL7 + LD DE,(EXPSGN) + INC DE + LD (EXPSGN),DE + EXX + SCF + RR H + RR L + EXX + RR H + RR L + RR C +SMULL7: BIT 7,C + JR Z,SMULL8 + LD DE,1 + ADD HL,DE + EXX + LD DE,0 + ADC HL,DE + EXX + JR NC,SMULL8 + LD DE,(EXPSGN) + INC DE + LD (EXPSGN),DE + EXX + LD H,80H + EXX +SMULL8: POP IX + PUSH IX + LD (IX+4),L + LD (IX+3),H + EXX + LD (IX+2),L + LD (IX+1),H + LD HL,(EXPSGN) + OR A + LD DE,81H + SBC HL,DE + LD A,H + ADD A,0 + JP M,UNDRFL + JP NZ,OVERF + LD (IX+0),L + JP FLEXIT +; +SMULL5: LD A,E + EXX + LD B,E + LD E,D + LD D,A + EXX + LD E,D + LD D,0 + JP SMULL6 +; +; +UNDRFL: LD SP,(SPBUF) ;**** + JP ZERO +; +DIV: + CALL STROMT + CALL EXPCHK + PUSH DE + PUSH HL + LD (SPBUF),SP + LD A,(DE) + OR A + JP Z,ER02 ;DIVID BY ZERO + EX AF,AF + LD A,(HL) + OR A + JP Z,ZERO + EXX + ADD A,81H + LD B,A + LD A,0 + ADC A,A + EX AF,AF + LD C,A + LD A,B + SUB C + LD C,A + EX AF,AF + LD B,A + EX AF,AF + LD A,B + SBC A,0 + JP C,UNDRFL + JP NZ,OVERF + LD A,C + PUSH AF ;PUSH A(EXP) + EXX + INC DE + INC HL + LD B,(HL) + SET 7,B + INC HL + LD C,(HL) + INC HL + PUSH HL + EX DE,HL + LD D,(HL) + SET 7,D + INC HL + LD E,(HL) + INC HL + PUSH HL + LD H,B + LD L,C + EXX + POP HL + LD D,(HL) + INC HL + LD E,(HL) + POP HL + LD A,(HL) + INC HL + LD L,(HL) + LD H,A + EXX ;HLH'L'/DED'E' + LD C,5 ;C=5 +SDIVL1: LD B,8 ;B=8 + XOR A +SDIVL2: BIT 7,H + JR NZ,SDIVL3 + OR A +SDIVL4: RLA + EXX + ADD HL,HL + EXX + ADC HL,HL + DJNZ SDIVL2 + PUSH AF + DEC C + JR NZ,SDIVL1 + JP SDIVED +; +SDIVL3: OR A + EXX + SBC HL,DE + EXX + SBC HL,DE + CCF + JR C,SDIVL4 + EXX + ADD HL,DE + EXX + ADC HL,DE + OR A + RLA + EXX + ADD HL,HL + EXX + ADC HL,HL + DJNZ SDIVL5 + PUSH AF + LD B,8 + DEC C + JP Z,SDIVED +SDIVL5: EXX + OR A + SBC HL,DE + EXX + SBC HL,DE + SCF + RLA + DJNZ SDIVL6 + PUSH AF + LD B,8 + DEC C + JR Z,SDIVED +SDIVL6: EXX + ADD HL,HL + EXX + ADC HL,HL + JR C,SDIVL5 + JP SDIVL2 +; +SDIVED: POP AF + LD H,A ;H' + EXX + POP AF + LD E,A ;E + POP AF + LD D,A ;D + POP AF + LD C,A ;C + POP AF + LD B,A ;B + POP AF ;A(EXP) +SDIVL9: BIT 7,B + JR NZ,SDIVE2 + EXX + SLA H + EXX + RL E + RL D + RL C + RL B + DEC A + JP NZ,SDIVL9 + JP ZERO +SDIVE2: EXX + RL H + EXX + JR NC,SDIVL8 + LD HL,1 + ADD HL,DE + EX DE,HL + LD HL,0 + ADC HL,BC + LD B,H + LD C,L + JR NC,SDIVL8 + LD B,80H + INC A +SDIVL8: POP HL + PUSH HL + LD (HL),A + INC HL + LD (HL),B + INC HL + LD (HL),C + INC HL + LD (HL),D + INC HL + LD (HL),E + JP FLEXIT +; +HLBUF: DEFS 2 +SIGN: DEFS 1 +SPBUF: DEFS 2 +SPBF: DEFS 2 +CYFLG: DEFS 1 +EXPSGN: DEFS 2 +OFLAG: DEFS 1 +; + +; +TSTSGN: INC HL + BIT 7,(HL) + DEC HL + RET +; +MULTWO: INC (HL) + RET NZ + JP ER02 +; +DIVTWO: LD A,(HL) + OR A + RET Z + DEC (HL) + RET NZ + JP CLRFAC +; +ADDHL5: PUSH HL + INC HL + INC HL + INC HL + INC HL + INC HL + EX DE,HL + LD HL,(MEMMAX) + DEC HL + SBC HL,DE + JP C,ER06__ + POP HL + RET +; +FACSET: PUSH HL + LD (SNFAC0),HL + CALL ADDHL5 + EX DE,HL + LD (SNFAC1),HL + CALL ADDHL5 + EX DE,HL + LD (SNFAC2),HL + CALL ADDHL5 + LD (SNFAC3),DE + POP HL + RET +; +; +POWERS: ;(HL)^(DE) + CALL STROMT + EX DE,HL + LD A,(HL) + OR A + JP Z,POWR1 + EX DE,HL + LD A,(HL) + OR A + JP Z,CLRFAC + CALL TSTSGN + JR Z,POWER1 + CALL TOGLE + EX DE,HL + PUSH DE + PUSH HL + LD DE,ZFAC1 + CALL LDIR5 ;(ZFAC1)=(DE) + LD HL,ZFAC1 + CALL FRACT + LD A,(HL) + OR A + JP NZ,ER03__ + POP HL + PUSH HL + CALL HLFLT + BIT 0,L + POP DE + POP HL + JR Z,POWER1 + CALL POWER1 + JP TOGLE +; +POWER1: EX DE,HL + LD A,(HL) + OR A + JR Z,POWR1 + CALL TSTSGN + JR Z,POWER2 + CALL TOGLE + CALL POWER2 + PUSH DE + PUSH HL + LD DE,ZFAC1 + CALL LDIR1 ;(ZFAC1)=1 + LD HL,ZFAC1 + POP DE + CALL DIV ;(ZFAC1)/(HL) + PUSH DE + CALL LDIR5 ;(HL)=(ZFAC1) + POP HL + POP DE + RET +; +POWR1: PUSH DE + CALL LDIR1 + POP HL + RET +; +POWER2: PUSH DE + LD DE,ZFAC1 + CALL LDIR5 ;(ZFAC1)=(DE) + POP HL + CALL LOG ;LOG(HL) + LD DE,ZFAC1 + CALL MUL ;(HL)*(DE) + JP EXP ;EXP(HL) + +; +_NOT_: + CALL STROMT + PUSH DE + PUSH HL + CALL HLFLT + LD A,L + CPL + LD E,A + LD A,H + CPL + LD D,A + JR AND9 +; +_AND_: + LD A,0A2H ;AND D + DEFB 1 +_OR_: + LD A,0B2H ;OR D + DEFB 1 +_XOR_: + LD A,0AAH ;XOR D +; + LD (AND2),A + INC A + LD (AND4),A + CALL STROMT + PUSH DE + PUSH HL + CALL HLFLT + EX DE,HL + CALL HLFLT + LD A,H +AND2: AND D ;AND, OR, XOR + LD D,A + LD A,L +AND4: AND E ;AND, OR, XOR + LD E,A +AND9: POP HL + CALL FLTHEX + POP DE + RET + +; +ABS: + INC HL + RES 7,(HL) + DEC HL + RET +; +INTOPR: + CALL TSTSGN + JP Z,INT + CALL MVFAC1 + CALL INT + LD DE,ZFAC1 + CALL CMP + RET Z +ONESUB: LD DE,FLONE + JP SUB +; +ONEADD: LD DE,FLONE + JP ADD +; +ONECMP: LD DE,FLONE + JP CMP +; +MVFAC1: PUSH HL + PUSH DE + LD DE,ZFAC1 + CALL LDIR5 + POP DE + POP HL + RET +; +; +MOD: + CALL INT + EX DE,HL + CALL INT + EX DE,HL + CALL MVFAC1 + CALL DIV + CALL INT + CALL MUL + PUSH DE + LD DE,ZFAC1 + CALL SUB + POP DE + JP TOGLE +; +; +YEN: + CALL INT + EX DE,HL + CALL INT + EX DE,HL + CALL DIV + JP INT +; +; +SQR: + LD A,(HL) + OR A + RET Z + CALL TSTSGN + JP NZ,ER03__ + CALL LOG + CALL DIVTWO + JP EXP +; +RETONE: PUSH HL + EX DE,HL + CALL LDIR1 + POP HL + POP BC + RET +; +ATNLM1: DEFB 7EH + DEFB 4CH +; +ATNLM2: DEFB 80H + DEFB 2BH +; +ATN: + PUSH BC + INC HL + LD A,(HL) + RES 7,(HL) + DEC HL + PUSH AF + CALL ATN_1 + POP AF + POP BC + RLCA + RET NC + JP TOGLE +; +ATN_1: CALL ONECMP + JR C,ATN_2 + CALL ADDHL5 + PUSH DE + PUSH HL + CALL LDIR5 + POP DE + PUSH DE + CALL LDIR1 + POP HL + POP DE + CALL DIV + CALL ATN_2 + LD DE,FLTHPI ;PI/2 + CALL SUB + JP ABS +; +ATN_2: LD A,0FFH + LD (SINSGN),A + LD DE,ATNLM1 + CALL CMP + JR C,ATNCUL + LD DE,ATNLM2 + CALL CMP + PUSH AF + CALL ADDHL5 + POP AF + PUSH HL + PUSH DE + CALL LDIR5 + POP HL + JR C,ATNMID + CALL ONEADD + EX (SP),HL + CALL SUB + POP DE + CALL DIV + CALL ATNCUL + LD DE,FLTQPI ;PI/4 + JP ADD +; +ATNMID: LD DE,SQRTMO + CALL MUL + CALL ONEADD + EX (SP),HL + LD DE,SQRTMO + CALL SUB + POP DE + CALL DIV + CALL ATNCUL + CALL MULTWO + LD DE,FLTQPI ;PI/4 + CALL ADD + JP DIVTWO +; +SQRTMO: DEFB 0x7F,0x54,0x13,0xCC,0xD0 + +; +ATNCUL: PUSH BC + PUSH HL + CALL FACSET + POP HL + PUSH HL + PUSH DE + CALL LDIR5 + POP HL + LD E,L + LD D,H + CALL MUL + LD DE,(SNFAC2) + POP HL + PUSH HL + CALL LDIR5 + LD A,(PRCSON) + DEC A + CP 04H + LD B,A + LD HL,TANTBL + JP Z,SIN6 + LD B,10 + JP SIN6 +; +COS: + PUSH BC + LD A,(HL) + OR A + JP Z,RETONE + LD DE,FLTHPI ;PI/2 + CALL SUB + CALL TOGLE + POP BC +; +SIN: + PUSH BC + INC HL + LD A,(HL) + RES 7,(HL) + AND 80H + CPL + LD (SINSGN),A + DEC HL + LD DE,FLT2PI ;PI*2 + PUSH HL + CALL CMP + JR C,SIN1 + CALL DIV + CALL FRACT + CALL MUL +SIN1: LD DE,FLTPAI + CALL CMP + JR C,SIN2 + CALL SUB + LD A,(SINSGN) + XOR 80H + LD (SINSGN),A +SIN2: LD DE,FLTHPI ;PI/2 + CALL CMP + JR C,SIN4 + LD DE,FLTPAI + CALL SUB + CALL ABS +SIN4: CALL FACSET + POP HL + PUSH DE + LD DE,FLTQPI ;PI/4 + CALL CMP + JR NC,COSCUL + POP DE + PUSH HL + PUSH DE + CALL LDIR5 + POP HL + LD E,L + LD D,H + CALL MUL + LD DE,(SNFAC2) + POP HL + PUSH HL + CALL LDIR5 + LD A,(PRCSON) + LD B,A + LD HL,SINTBL +SIN6: PUSH BC + PUSH HL + LD HL,(SNFAC2) + LD DE,(SNFAC3) + CALL MUL + POP HL + PUSH HL + LD DE,(SNFAC1) + PUSH DE + CALL LDIR5 + POP HL + LD DE,(SNFAC2) + CALL MUL + EX DE,HL + LD HL,(SNFAC0) + CALL ADD + POP HL + LD DE,5 + ADD HL,DE + POP BC + DJNZ SIN6 + POP HL + POP BC + LD A,(SINSGN) + INC HL + XOR (HL) + CPL + LD (HL),A + DEC HL + LD A,(PRCSON) + CP 08H + LD A,(HL) + JR Z,SIN9 + CP 5CH ; ADJUST +SIN8: RET NC + JP CLRFAC +; +SIN9: CP 4DH ; ADJUST + JR SIN8 +; +COSCUL: LD DE,FLTHPI ;PI/2 + CALL SUB + CALL ABS + POP DE + PUSH HL + PUSH DE + CALL LDIR5 + POP HL + LD E,L + LD D,H + CALL MUL + LD DE,(SNFAC2) + CALL LDIR1 + POP DE + PUSH DE + CALL LDIR1 + LD A,(PRCSON) + LD B,A + LD HL,COSTBL + JR SIN6 +; +SINSGN: DEFS 1 +; +; +TAN: + PUSH BC + PUSH HL + CALL ADDHL5 + EX DE,HL + LD (SNFAC4),HL + CALL ADDHL5 + LD (SNFAC5),DE + POP HL + PUSH HL + CALL LDIR5 + LD HL,(SNFAC4) + EX DE,HL + POP HL + PUSH HL + CALL LDIR5 + LD HL,(SNFAC5) + CALL SIN + POP DE + PUSH DE + CALL LDIR5 + LD HL,(SNFAC4) + CALL COS + EX DE,HL + POP HL + CALL DIV + POP BC + RET +; +SINTBL: DEFB 0x7E,0xAA,0xAA,0xAA,0xAB + DEFB 0x7A,0x08,0x88,0x88,0x89 + DEFB 0x74,0xD0,0x0D,0x00,0xD0 + DEFB 0x6E,0x38,0xEF,0x1D,0x2B + DEFB 0x67,0xD7,0x32,0x2B,0x40 + DEFB 0x60,0x30,0x92,0x30,0x9D + DEFB 0x58,0xD7,0x3F,0x9F,0x3A + DEFB 0x50,0x4A,0x96,0x3B,0x82 +; +COSTBL: DEFB 0x80,0x80,0x00,0x00,0x00 + DEFB 0x7C,0x2A,0xAA,0xAA,0xAB + DEFB 0x77,0xB6,0x0B,0x60,0xB6 + DEFB 0x71,0x50,0x0D,0x00,0xD0 + DEFB 0x6B,0x93,0xF2,0x7D,0xBC + DEFB 0x64,0x0F,0x76,0xC7,0x80 + DEFB 0x5C,0xC9,0xCB,0xA5,0x46 + DEFB 0x54,0x57,0x3F,0x9F,0x3A +; +TANTBL: DEFB 0x7F,0xAA,0xAA,0xAA,0xAB + DEFB 0x7E,0x4C,0xCC,0xCC,0xCD + DEFB 0x7E,0x92,0x49,0x24,0x92 + DEFB 0x7D,0x63,0x8E,0x38,0xE4 + DEFB 0x7D,0xBA,0x2E,0x8B,0xA3 + DEFB 0x7D,0x1D,0x89,0xD8,0x9E + DEFB 0x7D,0x88,0x88,0x88,0x89 + DEFB 0x7C,0x70,0xF0,0xF0,0xF1 + DEFB 0x7C,0xD7,0x94,0x35,0xE5 + DEFB 0x7C,0x43,0x0C,0x30,0xC3 +; +; +SGN: + LD DE,0 + LD A,(HL) + OR A + JR Z,SGNSET + CALL TSTSGN + INC DE + JR Z,SGNSET + DEC DE + DEC DE +SGNSET: CALL FLTHEX + RET +; +; +RAD: + LD DE,FLTRAD + JR $+5 +PAI: + LD DE,FLTPAI + PUSH BC + CALL MUL + POP BC + RET + +; +FLT2PI: DEFB 0x83,0x49,0x0F,0xDA,0xA2 ;PI*2 + +FLTPAI: DEFB 0x82,0x49,0x0F,0xDA,0xA2 ;PI + +FLTHPI: DEFB 0x81,0x49,0x0F,0xDA,0xA2 ;PI/2 + +FLTQPI: DEFB 0x80,0x49,0x0F,0xDA,0xA2 ;PI/4 + +FLTRAD: DEFB 0x7B,0x0E,0xFA,0x35,0x13 + +; +; +PEEK: + PUSH HL + CALL HLFLT + LD E,(HL) + LD D,0 + POP HL + CALL FLTHEX + RET +; +; +RND: + LD A,(HL) + OR A + JR Z,RNDMIZ + CALL TSTSGN + JR Z,NORRND +RNDMIZ: PUSH HL + LD HL,4193H + LD (SEED),HL + POP HL + XOR A + LD R,A +NORRND: PUSH BC + LD DE,(SEED) + LD A,R + XOR D + RRC A + RRC A + RRC A + LD D,A + LD A,R + XOR E + RLC A + RLC A + LD E,D + LD D,A + LD (SEED),DE + PUSH HL + INC HL + RES 7,D + LD (HL),D + INC HL + LD (HL),E + INC HL + LD A,R + LD (HL),A + POP HL + LD (HL),81H + CALL ONESUB + POP BC + RET +SEED: DEFW 4193H +; +EXP: + PUSH BC + LD A,(HL) + OR A + JP Z,RETONE + INC HL + LD A,(HL) + LD (EXPSIN),A + RES 7,(HL) + DEC HL + LD DE,LNTWO2 + CALL MUL + PUSH HL + CALL ADDHL5 + PUSH DE + CALL LDIR5 + POP HL + CALL INT + PUSH HL + CALL HLFLT + XOR A + CP H + JP NZ,ER02 + LD A,L + LD (EXPOFF),A + POP DE + POP HL + PUSH HL + CALL SUB + PUSH DE + PUSH HL + CALL LDIR1 + POP DE + POP HL + CALL DIVTWO + EX DE,HL + XOR A + LD B,8 +EXPLP1: PUSH BC + PUSH AF + CALL CMP + JR C,EXPNL1 + CALL SUB + POP AF + SET 7,A + PUSH AF +EXPNL1: POP AF + RLC A + EX DE,HL + PUSH AF + CALL DIVTWO + POP AF + EX DE,HL + POP BC + DJNZ EXPLP1 + LD (EXPHBT),A + PUSH DE + LD DE,LNTWO + LD A,(PRCSON) + BIT 3,A + JR NZ,$+5 + LD DE,LNTWOF + CALL MUL + POP DE + PUSH DE + CALL LDIR5 + POP HL + LD A,(PRCSON) + BIT 3,A + JP Z,EXPSKP + CALL MULTWO + LD DE,FLTEN + CALL ADD + CALL DIVTWO + POP DE + PUSH DE + CALL MUL + LD DE,FLTEN + CALL DIVTWO + CALL ADD + CALL MULTWO + POP DE + PUSH DE + CALL MUL + LD DE,FLT120 + CALL MUL + CALL MULTWO + CALL ONEADD + CALL DIVTWO + POP DE + PUSH DE + CALL MUL + CALL ONEADD + POP DE + PUSH DE + CALL MUL +EXPSK_: CALL ONEADD + EX (SP),HL + EX DE,HL + PUSH DE + CALL LDIR1 + POP HL + LD DE,EXDTBL + LD A,(EXPHBT) + LD B,8 +EXPCLP: RLC A + JR NC,SKPEXP + PUSH AF + PUSH BC + CALL MUL + POP BC + POP AF +SKPEXP: + INC DE + INC DE + INC DE + INC DE + INC DE + DJNZ EXPCLP + LD A,(EXPOFF) + ADD A,(HL) + JP C,ER02 + LD (HL),A + POP DE + CALL MUL + POP BC + LD A,(EXPSIN) + RLC A + RET NC + PUSH BC + PUSH DE + PUSH HL + CALL LDIR5 + POP DE + PUSH DE + CALL LDIR1 + POP HL + POP DE + CALL DIV + POP BC + RET +; +EXPSKP: POP DE + PUSH DE + CALL MUL + LD A,(HL) + OR A + CALL NZ,DIVTWO + CALL ADD + JP EXPSK_ +; +EXPOFF: DEFS 1 +EXPSIN: DEFS 1 +EXPHBT: DEFS 1 +; +LOGD: + PUSH BC + CALL LOG + LD DE,LOGE10 + CALL MUL + POP BC + RET +; +LOG: ;LN(HL) + PUSH BC + CALL TSTSGN + JP NZ,ER03__ + LD A,(HL) + OR A + JP Z,ER03__ + SUB 81H + LD (LOGEXP),A + LD (HL),81H + XOR A + LD B,8 + LD DE,EXDTBL +LOGCLL: PUSH BC + PUSH AF + CALL CMP + JR C,LOGNCL + PUSH HL + LD HL,40 + ADD HL,DE + EX DE,HL + EX (SP),HL + CALL MUL + POP DE + POP AF + SET 7,A + PUSH AF +LOGNCL: POP AF + RLC A + INC DE + INC DE + INC DE + INC DE + INC DE + POP BC + DJNZ LOGCLL + LD (SNFAC0),HL + CALL ADDHL5 + EX DE,HL + LD E,A + LD D,0 + CALL FLTHEX + LD A,(HL) + OR A + JR Z,NOTDCR + SUB 08H + LD (HL),A +NOTDCR: LD A,(LOGEXP) + CP 80H + JR C,$+4 + NEG + PUSH HL + CALL ADDHL5 + EX DE,HL + LD (SNFAC1),HL + LD E,A + LD D,0 + CALL FLTHEX + LD A,(LOGEXP) + AND 80H + INC HL + OR (HL) + LD (HL),A + DEC HL + EX DE,HL + POP HL + CALL ADD + LD A,(PRCSON) + LD DE,LNTWO3 + CP 05H + JR Z,$+5 + LD DE,LNTWO + CALL MUL + PUSH HL + LD DE,(SNFAC1) + LD HL,(SNFAC0) + PUSH HL + PUSH DE + CALL LDIR5 + POP HL + CALL ONEADD + EX (SP),HL + CALL SUB + POP DE + CALL DIV + PUSH DE + CALL LDIR5 + POP HL + PUSH DE + LD E,L + LD D,H + CALL MUL + POP DE + PUSH HL + PUSH DE + CALL LDIR5 + POP HL + LD DE,LOGDAT + CALL ADD + EX DE,HL + POP HL + CALL MUL + LD DE,FLTEN + CALL MULTWO + CALL ADD + CALL DIVTWO + EX DE,HL + LD HL,(SNFAC0) + CALL MUL + LD DE,FLTHR_ + CALL MUL + POP DE + CALL ADD + POP BC + RET +; +LOGEXP: DEFS 1 +; +; +LOGE10: DEFB 0x7F,0x5E,0x5B,0xD8,0xA9 +; +; +FLTHR_: DEFB 0x7F,0x4C,0xCC,0xCC,0xCD +; +LOGDAT: DEFB 0x81,0x55,0x55,0x55,0x56 +; +EXDTBL: DEFB 0x81,0x35,0x04,0xF3,0x34 ;2^(1/2) + DEFB 0x81,0x18,0x37,0xF0,0x52 ;2^(1/4) + DEFB 0x81,0x0B,0x95,0xC1,0xE4 ;2^(1/8) + DEFB 0x81,0x05,0xAA,0xC3,0x68 ;2^(1/16) + DEFB 0x81,0x02,0xCD,0x86,0x99 ;2^(1/32) + DEFB 0x81,0x01,0x64,0xD1,0xF4 ;2^(1/64) + DEFB 0x81,0x00,0xB1,0xED,0x50 ;2^(1/128) + DEFB 0x81,0x00,0x58,0xD7,0xD3 ;2^(1/256) + DEFB 0x80,0x35,0x04,0xF3,0x34 + DEFB 0x80,0x57,0x44,0xFC,0xCB + DEFB 0x80,0x6A,0xC0,0xC6,0xE8 + DEFB 0x80,0x75,0x25,0x7D,0x16 + DEFB 0x80,0x7A,0x83,0xB2,0xDC + DEFB 0x80,0x7D,0x3E,0x0C,0x0D + DEFB 0x80,0x7E,0x9E,0x11,0x5D + DEFB 0x80,0x7F,0x4E,0xCB,0x5A +; +FLT120: DEFB 0x7A,0x08,0x88,0x88,0x89 +; +LNTWO: DEFB 0x80,0x31,0x72,0x17,0xF8 +; +LNTWOF: DEFB 0x80,0x31,0x72,0x17,0xF8 +; +LNTWO2: DEFB 0x81,0x38,0xAA,0x3B,0x2A ;1/LN(2) +; +LNTWO3: DEFB 0x80,0x31,0x72,0x17,0xF8 ; * +; +; +SNFAC0: DEFS 2 +SNFAC1: DEFS 2 +SNFAC2: DEFS 2 +SNFAC3: DEFS 2 +SNFAC4: DEFS 2 +SNFAC5: DEFS 2 +; +; END (9BACH) + + +; ORG 9BACH + +; --------------------------- +; MZ-800 BASIC Music command +; FI:MUSIC ver 1.0A 7.18.84 +; Programed by T.Miho +; --------------------------- +; +; + +; +; +; +; SOUND m,l / SOUND=(r,d) +; +SOUND: + CALL TEST1 + DEFB 0F4H ;= + JR NZ,SOUND1 + CALL HCH28H ;( + CALL IBYTE + CP 16 + SET 7,A + JR SOUND2 +; +SOUND1: CALL IBYTE + CP NMAX+1 +SOUND2: JP NC,ER03__ + PUSH AF + CALL HCH2CH ;, + CALL IDEEXP + POP AF + PUSH AF + OR A + CALL M,HCH29H ;) + POP AF + PUSH HL + RST 3 + DEFB _SOUND + POP HL + RET +; +; TEMPO n (n= 1 to 7 ) +; +TEMPO: + CALL IBYTE + DEC A + CP 7 + INC A + JP _TEMPO + + +; +;;;;;;;;;;;;;;;;;;;;; +; +; NOISE A1$;A2$,B1$;... +; MUSIC A1$;A2$;...;A6$,B1$;... +; +NOISE: + LD A,08H ;pattern (3) + DEFB 1 +; +MUSIC: + LD A,07H ;pattern (0,1,2) + LD (MUNOF),A ;channel pattern + CALL HLFTCH + LD B,3 + CP 0BEH ;WAIT + JR Z,__MCTRL + DEC B + CP 99H ;STOP + JR Z,__MCTRL + CP 0DCH ;INIT + JR NZ,MUSIC1 +; + LD DE,MUSCHO + LD B,4 + LD A,2 + CALL SETDE +__MCTRL: PUSH HL + RST 3 + DEFB _MCTRL + POP HL + INC HL + RET +; +MUSIC1: CALL ENDCHK + RET Z + XOR A + LD (MUDNO),A + LD (MUCHNO),A + LD B,A + LD A,0DH + LD DE,DIRARE + LD (MMBU1A),DE + LD (DE),A + CALL SETDE + LD A,(MUNOF) + LD (MUNOF2),A +MUSI1: LD DE,MUNOF2 + LD A,(DE) + RRC A + LD (DE),A + PUSH AF + LD B,0 + JR NC,MUSI3 + CALL HLFTCH + CP ';' + JR Z,MUSI3 + CALL STREXP +MUSI3: PUSH HL + LD A,(MUCHNO) + CP 4 + JP Z,ER01 ;Ch no over + INC A + LD (MUCHNO),A + INC B + JP Z,ER05 + LD A,(MUDNO) + ADD A,B + JP C,ER05 ;data no. over + LD (MUDNO),A + LD HL,(MMBU1A) + CALL LDHLDE + LD (MMBU1A),HL + DEC HL + LD (HL),0DH + POP HL + POP AF + JR NC,MUSI1 + CALL ENDCHK + JR Z,MUSI4 + CALL TEST1 + DEFB ',' + JR Z,MUSI4 + CALL TEST1 + DEFB ';' + JR MUSI1 +MUSI4: PUSH HL + LD HL,DIRARE + LD IX,HL + LD IY,MUSCHO + LD B,4 +MUSI5: PUSH BC + PUSH HL + LD HL,IX + LD DE,DIRARE + XOR A + SBC HL,DE + LD (IY+4),L + POP HL + LD (MUSI6+1),SP + CALL MML_EN +MUSI6: LD SP,0 ;xxx + POP BC + INC HL + INC IY + DJNZ MUSI5 + LD B,3 + RST 3 + DEFB _MCTRL ;MWAIT +MUSI8: LD BC,100H + LD HL,DIRARE + LD DE,DIRARE+700H + LDIR + LD B,4 + LD HL,MMCHDA +MUSDS: LD E,(HL) + LD D,0 + INC HL + PUSH HL + LD HL,DIRARE+700H + ADD HL,DE + LD A,(HL) + CP 0FFH + JR Z,MUSDS1 + LD A,4 + SUB B + PUSH BC + EX DE,HL + RST 3 + DEFB _PLAY + POP BC +MUSDS1: POP HL + DJNZ MUSDS + LD B,1 + RST 3 + DEFB _MCTRL ;PSGON +; + POP HL + JP MUSIC1 +; +MUSCHO: DEFW 0202H ;Oct data eny ch. + DEFW 0202H +MMCHDA: DEFS 4 ;Play & Noise Data addr +; +MUDNO: DEFS 1 ;total data No. +MUCHNO: DEFS 1 ;ch no. +MMBU1A: DEFS 2 ;MML data buffer +MUNOF: DEFS 1 ;07:MUSIC 08:NOISE +MUNOF2: DEFS 1 ;rotate(MUNOF) +; + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; +; MML(HL) => IOCSM(IX) trans +; END code=00H or 0DH or C8H +; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; +MML_EN: CALL MML_WC +MML_E0: CALL HLFTCH + CALL MMAGCH + JR C,MMTCAL + LD C,0 + CALL MML_AG ;String:A-G + JR MMTCA9 +; +MMTCAL: CALL MMENCH + JP Z,MMLEND + LD B,12 + EX DE,HL + LD HL,MMTCAT ;Call address table +MMTCA0: CP (HL) ;cmp chr + INC HL + JR Z,MMTCAJ + DEC B + JP Z,ER03__ + INC HL + INC HL + JR MMTCA0 +MMTCAJ: LD C,(HL) + INC HL + LD B,(HL) + EX DE,HL + INC HL + CALL _BC +MMTCA9: JP C,ER03__ + JR MML_E0 +; +_BC: PUSH BC + RET +; +MMTCAT: DEFB '#' + DEFW MML_SH + DEFB '+' + DEFW MML_UO + DEFB 0D7H + DEFW MML_UO + DEFB '-' + DEFW MML_DO + DEFB 0CFH + DEFW MML_DO + DEFB 'O' + DEFW MML_O + DEFB 'N' + DEFW MML_N + DEFB 'T' + DEFW MML_T + DEFB 'V' + DEFW MML_V + DEFB 'S' + DEFW MML_S + DEFB 'M' + DEFW MML_M + DEFB 'L' + DEFW MML_L +; +MML_DO: LD C,-12 ;- + DEFB 11H +; +MML_UO: LD C,12 ;+ + CALL TEST1 + DEFM "#" + JR NZ,$+3 + INC C + DEFB 11H +; +MML_SH: LD C,1 ;# + CALL HLFTCH + CALL MMAGCH + RET C +MML_AG: LD B,A + INC HL + CALL MML_DL + CCF + CALL C,MML_L1 + RET C + LD A,B + CP 'R' + JR Z,MML_R + PUSH HL + LD HL,ONCTT-41H ;A-G + CALL ADDHLA + LD B,(IY+0) + INC B + LD A,(HL) + POP HL + ADD A,C + SUB 12 + ADD A,12 + DJNZ $-2 + JR MML_N0 +; +MML_R: XOR A +MML_R0: PUSH AF + CALL MML_WO + POP AF +MML_W1: LD (IX+0),A + INC IX + RET +; +MML_O: CALL MML_DL ;O + JR NC,$+4 + LD A,2 + CP 7 + CCF + RET C + LD (IY+0),A ;oct No. + RET +; +MML_N: CALL MML_DL ;N + RET C +MML_N0: CP NMAX+1 + CCF + RET C + JR MML_R0 +; +MML_T: CALL MML_DL ;T + JR NC,$+4 + LD A,4 + DEC A + CP 7 + CCF + RET C + ADD A,6AH + LD (MML_W),A + RET +; +MML_V: CALL MML_DL ;V + JR NC,$+4 + LD A,15 + CP 16 + CCF + RET C + ADD A,80H + LD (MML_W+1),A + RET +; +MML_L: CALL MML_DL ;L + JR NC,$+4 + LD A,5 +MML_L1: CP 10 + CCF + RET C +MML_L2: ADD A,60H + LD (MML_W+2),A + RET +; +MML_S: CALL MML_DL ;S + RET C + CP 9 + CCF + RET C + ADD A,90H + LD (MML_W+3),A + RET +; +MML_M: CALL MML_DL ;M + RET C + OR A + SCF + RET Z + LD B,A + LD C,0A0H + LD (MML_W+4),BC + OR A + RET +; +; +MML_DL: CALL HLFTCH + CALL MMENCH + SCF + CALL NZ,TSTNUM + RET C ;RET not number + RST 3 + DEFB _DEASC + JP DCHECK +; +MMAGCH: CP 'R' ;A-G & R check + RET Z + CP 'A' + RET C + CP 'H' + CCF + RET +; +MMENCH: OR A + RET Z + CP 0DH + RET Z + CP 0C8H + RET +; +MMLEND: CALL MML_WO + LD A,0FFH ;Music Data end + CALL MML_W1 + JP MUSI6 +; +MML_WO: LD DE,MML_W + LD B,6 + LD A,(DE) + OR A + CALL NZ,MML_W1 + INC DE + DJNZ $-6 +; +MML_WC: LD DE,MML_W + LD B,6 + JP CLRDE +; +; +ONCTT: DEFB 9 ;A + DEFB 11 ;B + DEFB 0 ;C + DEFB 2 ;D + DEFB 4 ;E + DEFB 5 ;F + DEFB 7 ;G +; +MML_W: DEFB 0 ;T + DEFB 0 ;V + DEFB 0 ;L + DEFB 0 ;S + DEFB 0 ;Mn + DEFB 0 +; +; END (9E4B) + +; ORG 9E4BH + +; -------------------------- +; MZ-800 BASIC Work area +; FI:WORKQ ver 1.0A 9.25.84 +; Programed by T.Miho +; -------------------------- +; +SWAPDS: ;SWAP save data start +; +NXTLPT: + DEFS 2 +EDLINE: + DEFS 2 +EDSTEP: + DEFS 2 +LNOBUF: + DEFS 2 +; +ERRCOD: + DEFS 1 +ERRORF: + DEFS 1 +ERRLNO: + DEFS 2 +ERRLPT: + DEFS 2 +ERRPNT: + DEFS 2 +ERRORV: + DEFS 2 +; +DATFLG: + DEFS 1 +DATPTR: + DEFS 2 +; +SWAPDE: ;SWAP save data end +; +SWAPBY: ;SWAP save data bytes + DEFW SWAPDE-SWAPDS ;SWAP save data bytes +SWAPNB: ; -(SWAPBY) + DEFW SWAPDS-SWAPDE +; +; +STACK: + DEFS 2 +TEXTPO: + DEFS 2 +LSWAP: + DEFB 0 +; +DGBFM1: + DEFS 1 +DGBF00: + DEFS 7 +DGBF07: + DEFS 1 +DGBF08: + DEFS 3 +DGBF11: + DEFS 1 +DGBF12: + DEFS 4 +DGBF16: + DEFS 1 +DGBF17: + DEFS 8 +DGBF25: + DEFS 25 +; +PRCSON: + DEFB 8 +ZFAC: + DEFS 8 +ZFAC1: + DEFS 8 +ZFAC2: + DEFS 8 +; +IMDBUF: + DEFB 16H ;CLR + DEFB 0DH + DEFM " " + DEFB 0D7H,0D7H,0D7H,0D7H,0D7H,0D7H,0D7H,0D7H,0D7H,0D7H,0D7H,0D7H,0D7H,0D7H,0D7H,0D7H,0D7H,0D7H,0D7H + DEFB 0D7H,0D7H,0D7H,0D7H,0D7H,0D7H,0D7H,0D7H,0D7H,0D7H,0D7H,0D7H,0D7H,0D7H,0D7H,0D7H,0D7H,0D7H,0D7H + DEFM " " + DEFM " BASIC " + DEFB 05H + DEFM "INTERPRETER " + DEFB 06H + DEFM "MZ-5Z009" +TTJPEX: +IF RAMDISK +IF MOD_B + DEFM " V1.0B+ " +ELSE + DEFM " V1.0B +" +ENDIF +ELSE + DEFM " V1.0A " +ENDIF + DEFB 0DH + DEFM " C" + DEFB 05H + DEFM "OPYRIGHT " + DEFB 06H + DEFM "(C) 1984 " + DEFB 05H + DEFM "BY " + DEFB 06H + DEFM "SHARP CORP. " + DEFB 0CFH,0CFH,0CFH,0CFH,0CFH,0CFH,0CFH,0CFH,0CFH,0CFH,0CFH,0CFH,0CFH,0CFH,0CFH,0CFH,0CFH,0CFH,0CFH + DEFB 0CFH,0CFH,0CFH,0CFH,0CFH,0CFH,0CFH,0CFH,0CFH,0CFH,0CFH,0CFH,0CFH,0CFH,0CFH,0CFH,0CFH,0CFH,0CFH + DEFM " " + DEFB 0DH + DEFM " " + DEFB 05H + DEFM "22340 BYTES FREE" + DEFW 0D0DH + DEFB 0 + + DEFS 5CH +; +; +; END (9FCEH) + + + + +; ORG 9FCEH + +; ----------------------------- +; MZ-800 BASIC Plotter package +; FI:PLT ver 1.0A 8.25.84 +; Programed by T.Miho +; ----------------------------- +; + +; +;P_PLT: EQU 0 +PNCHNM: DEFB "N" ;N,S,L +; +NEWON: + LD BC,ER59_ + LD DE,NEWONT ;NEW ON +NEWON2: LD A,(DE) ; omit plotter + INC DE + ADD A,A + JR Z,NEWON4 + LD HL,SJPTBL + CALL ADDHLA + LD (HL),C + INC HL + LD (HL),B + JR NEWON2 +NEWON4: XOR A ; PLOT OFF + LD (INPFLG),A + LD A,(PNMODE) + DEC A + CALL NZ,MODETX ; PMODE TX + LD HL,NEWAD2 +NEWON9: LD (TEXTST),HL + RET + + +; +NEWONT: DEFB 0A2H ;PMODE + DEFB 0A3H ;PSKIP + DEFB 0A4H ;PLOT + DEFB 0A5H ;PLINE + DEFB 0A6H ;RLINE + DEFB 0A7H ;PMOVE + DEFB 0A8H ;RMOVE + DEFB 0AEH ;PCOLOR + DEFB 0AFH ;PHOME + DEFB 0B0H ;HSET + DEFB 0B1H ;GPRINT + DEFB 0B3H ;AXIS + DEFB 0BBH ;PCIRCLE + DEFB 0BCH ;PTEST + DEFB 0BDH ;PAGE + DEFB 0 +; +LPTTMD: + LD B,1 ;Check text mode + JR $+4 +LPTGMD: + LD B,2 ;Check graph mode + LD A,(PNMODE) + CP B + RET Z + JP LPTMER +; + + +; +NEWAD2: +; +MODE: + CALL MODE0 ;"PMODE" command + XOR A + LD (LPOSB),A ;LPT TAB + RET +; +MODE0: LD A,(INPFLG) + OR A + JP NZ,LPTMER + CALL PPCHCK + CALL TEST1 + DEFM "G" + JP Z,PGRAPH + CALL TESTX + DEFB "T" + CALL TEST1 + DEFM "N" + JR Z,TEXTN + CALL TEST1 + DEFM "L" + JR Z,TEXTN + CALL TESTX + DEFB "S" +TEXTN: LD (PNCHNM),A + CALL ENDZ + CALL OUTA3H +MODETX: LD A,1 + LD (PNMODE),A + RST 3 + DEFB _LPTOT + LD A,(PNCHNM) + CP 'N' + RET Z + CP 'L' + LD A,0BH + JR Z,XLPTOT +T80CH: LD A,9 + RST 3 + DEFB _LPTOT + RST 3 + DEFB _LPTOT +XLPTOT: + RST 3 + DEFB _LPTOT + RET +; +OUTA3H: LD A,0AH + RST 3 + DEFB _LPTOT + LD A,3 + JR XLPTOT +; +PGRAPH: INC HL ;Graphic mode + CALL ENDZ + LD A,2 + LD (PNMODE),A + JR XLPTOT + + +; +SKIP: + CALL PPCHCK + CALL LPTTMD ;SKIP n + CALL IDEEXP + LD A,E + OR A + RET Z + CP -20 + JR NC,SKIPPS + CP 21 + JP NC,ER03__ +SKIPPS: CALL ENDZ + BIT 7,E + JR NZ,SKIPD +SKIPI: LD A,0AH + RST 3 + DEFB _LPTOT + DEC E + JR NZ,SKIPI + RET +; +SKIPD: LD A,03H + RST 3 + DEFB _LPTOT + INC E + JR NZ,SKIPD + RET +; +PNMX99: PUSH HL + LD HL,999 + JR $+6 +PNMX48: PUSH HL + LD HL,480 + PUSH HL + ADD HL,DE + POP HL + JR C,PNMX2 + SBC HL,DE + JP C,ER03__ +PNMX2: POP HL + RET + + +; +PLINE: ; PLINE %n,x,y + LD C,'D' + DEFB 11H +RLINE: ; RLINE %n,x,y" + LD C,'J' + DEFB 11H +PMOVE: ; PMOVE x,y + LD C,'M' + DEFB 11H +RMOVE: ; RMOVE x,y + LD C,'R' + CALL PPCHCK + CALL LPTGMD + LD A,C + LD (LINEC+1),A + CP 'M' + JR NC,LINE5 ;"M","R" + CALL TEST1 + DEFM "%" + JR NZ,LINE5 + CALL IBYTE + LD A,E + DEC A + CP 16 + JP NC,ER03__ + DEC DE + LD A,'L' + RST 3 + DEFB _LPTOT + CALL NUMPLT + CALL LPTCR + CALL ENDCHK + RET Z + CALL CH2CH +LINE5: CALL IDEEXP + CALL CH2CH + CALL PNMX48 + PUSH DE + CALL IDEEXP + CP ',' + JR Z,LINEXY + CALL ENDZ +LINEXY: CALL PNMX99 + POP BC + PUSH DE +LINEC: LD A,0 ;Plotter command + RST 3 + DEFB _LPTOT + LD E,C + LD D,B + CALL NUMPLT ;X + CALL LPTCOM + POP DE + CALL NUMPLT ;Y + CALL LPTCR + CALL ENDCHK + RET Z + INC HL + JR LINE5 + + +; +PCOLOR: + CALL PPCHCK + CALL IBYTE ;PCOLOR n + LD A,E + CP 4 + JP NC,ER03__ + CALL ENDZ + LD A,(PNMODE) + CP 2 + JR Z,PNMBR2 + CALL OUTA3H + LD A,2 + RST 3 + DEFB _LPTOT + CALL PNMBR2 + JP PRTTX +; +PNMBR2: LD A,'C' + RST 3 + DEFB _LPTOT + LD A,E + OR 30H + RST 3 + DEFB _LPTOT +LPTCR: LD A,0DH + JR $+4 +LPTCOM: LD A,',' +YLPTOT: + RST 3 + DEFB _LPTOT + RET +; +PHOME: + LD C,'H' + DEFB 11H +HSET: + LD C,'I' + CALL LPTGMD ;PHOME / HSET + CALL ENDZ + LD A,C + JR YLPTOT +; + + +; +GPRINT: + CALL PPCHCK + CALL LPTGMD ;GPRINT [n,s],x$ + CALL TEST1 + DEFM "[" + JR NZ,SYMBL2 + CALL IBYTE + CP 64 + JP NC,ER03__ + PUSH DE + CALL HCH2CH + CALL IBYTE + CP 4 + JP NC,ER03__ + PUSH DE + CALL TESTX + DEFM "]" + POP BC + POP DE + PUSH BC + LD A,'S' + RST 3 + DEFB _LPTOT + CALL NUMPLT + CALL LPTCOM + POP DE + LD A,'Q' + RST 3 + DEFB _LPTOT + CALL NUMPLT + CALL LPTCR + CALL ENDCHK + RET Z + CALL CH2CH +SYMBL2: CALL STREXP + CALL ENDCHK + JR Z,SYMBL5 + CALL CH2CH + DEC HL +SYMBL5: LD A,B + OR A + JR Z,SYMBL4 + LD A,'P' + RST 3 + DEFB _LPTOT +SYMBL3: LD A,(DE) + RST 3 + DEFB _LPTOT + INC DE + DJNZ SYMBL3 + CALL LPTCR +SYMBL4: CALL ENDCHK + RET Z + INC HL + JR SYMBL2 + + +; +AXIS: + CALL LPTGMD ;AXIS x,p,r + CALL IBYTE + CP 2 + JP NC,ER03__ + PUSH AF + CALL HCH2CH + CALL IDEEXP + PUSH DE + CALL CH2CH + CALL IBYTE + OR A + JP Z,ER03__ + CALL ENDZ + LD A,'X' + RST 3 + DEFB _LPTOT + POP BC + POP AF + PUSH DE + PUSH BC + OR 30H + RST 3 + DEFB _LPTOT + CALL LPTCOM + POP DE + CALL PNMX99 + CALL NUMPLT + CALL LPTCOM + POP DE + CALL NUMPLT + JP LPTCR + + +; +PCIRCLE: + CALL LPTGMD ;PCIRCLE x,y,r,s,e,d + PUSH HL + LD DE,0 + LD HL,CRS + CALL FLTHEX + LD DE,360 + LD HL,CRE + CALL FLTHEX + LD HL,FLTEN + LD DE,CRTEN + CALL LDIR5 + POP HL + CALL EXPR ;X + CALL CH2CH + PUSH HL + LD HL,CRX + EX DE,HL + CALL LDIR5 + POP HL + CALL EXPR ;Y + CALL CH2CH + PUSH HL + LD HL,CRY + EX DE,HL + CALL LDIR5 + POP HL + CALL EXPR ;R + PUSH HL + PUSH AF + LD HL,CRR + EX DE,HL + CALL LDIR5 + LD A,(CRR+1) + RLCA + JP C,ER03__ + POP AF + CP ',' + JR NZ,CIREND + POP HL + INC HL + CALL EXPR ;S + PUSH HL + PUSH AF + LD HL,CRS + EX DE,HL + CALL LDIR5 + POP AF + CP ',' + JR NZ,CIREND + POP HL + INC HL + CALL EXPR ;E + PUSH HL + PUSH AF + LD HL,CRE + EX DE,HL + CALL LDIR5 + POP AF + CP ',' + JR NZ,CIREND + POP HL + INC HL + CALL EXPR ;D + PUSH HL + LD HL,CRTEN + EX DE,HL + CALL LDIR5 + LD A,(CRTEN+1) + RLCA + JP C,ER03__ +CIREND: + POP HL + CALL ENDZ + PUSH HL +; + LD HL,CRE + LD DE,CRS + LD A,(CRTEN) + OR A + CALL NZ,CMP + JP C,ER03__ +; + CALL CRXYRS ;CAL X,Y +; + LD HL,CRXX ;MOVE X,Y + LD (CRMOVX+1),HL + LD HL,CRYY + LD (CRMOVY+1),HL + CALL CRMOVE + LD A,(CRTEN) + OR A + JR Z,CREDLI +; +CRCLP: LD HL,CRS ;S+D + LD DE,CRTEN + CALL ADD + LD DE,CRE + CALL CMP + JR NC,_EDLINE + CALL CRXYRS + CALL CRLINE +; + RST 3 + DEFB _BREAK + JR NZ,CRCLP +; + POP HL + RET +; +_EDLINE: CALL CREDST + CALL CRLINE + POP HL + RET +; +CREDST: LD HL,CRE + LD DE,CRS + LD BC,5 + LDIR + JR CRXYRS +; +CREDLI: LD HL,CRX + LD (CRMOVX+1),HL + LD HL,CRY + LD (CRMOVY+1),HL + CALL CRLINE + CALL CREDST + LD HL,CRXX + LD (CRMOVX+1),HL + LD HL,CRYY + LD (CRMOVY+1),HL + CALL CRLINE + POP HL + RET +; +CRLINE: LD A,'D' + DEFB 21H +CRMOVE: LD A,'M' + PUSH AF +CRMOVX: LD HL,CRX + CALL HLFLT + PUSH HL + EX DE,HL + CALL PNMX99 +CRMOVY: LD HL,CRY + CALL HLFLT + PUSH HL + EX DE,HL + CALL PNMX99 + POP HL + POP DE + POP AF + RST 3 + DEFB _LPTOT + PUSH HL + CALL NUMPLT + CALL LPTCOM + POP DE + CALL NUMPLT + JP LPTCR +; +CRXYRS: LD DE,(INTFAC) + LD HL,CRS + CALL LDIR5 + LD HL,(INTFAC) + CALL RAD + CALL COS + LD DE,CRR + CALL MUL + LD DE,CRX + CALL ADD + LD DE,CRXX + CALL LDIR5 + LD DE,(INTFAC) + LD HL,CRS + CALL LDIR5 + LD HL,(INTFAC) + CALL RAD + CALL SIN + LD DE,CRR + CALL MUL + LD DE,CRY + CALL ADD + LD DE,CRYY + JP LDIR5 +; +CRX: DEFS 5 +CRY: DEFS 5 +CRR: DEFS 5 +CRS: DEFS 5 +CRE: DEFS 5 +CRTEN: DEFS 5 +CRXX: DEFS 5 +CRYY: DEFS 5 + DEFS 5 +; +; +; +NUMPLT: PUSH AF + PUSH HL + LD HL,(INTFAC) + CALL FLTHEX + CALL CVNMFL + RST 3 + DEFB _COUNT +NUMPL2: LD A,(DE) + RST 3 + DEFB _LPTOT + INC DE + DJNZ NUMPL2 + POP HL + POP AF + RET +; + + +; +TEST: + CALL PPCHCK + CALL LPTTMD ;TEST command + CALL ENDZ + LD A,04H + RST 3 + DEFB _LPTOT + RET +; +PAGE: + CALL LPTTMD ;PAGE n + CALL IDEEXP + LD A,E + OR A + JP Z,ER03__ + CP 73 + JP NC,ER03__ + CALL ENDZ + LD A,9 + RST 3 + DEFB _LPTOT + RST 3 + DEFB _LPTOT + LD A,(PSEL) + BIT P_PLT,A + JR Z,PAGE2 + CALL NUMPLT ;Plotter only + JP LPTCR +PAGE2: LD A,E ;Except plotter + LD DE,KEYBUF + CALL HEXACC + DEC DE + DEC DE + LD A,(DE) + RST 3 + DEFB _LPTOT + INC DE + LD A,(DE) + RST 3 + DEFB _LPTOT + RET +; +PLOT: + LD A,(HL) + CP 9DH ;PLOT ON/OFF + JR Z,PLOTO_ + CP 0A1H ;OFF + JP NZ,ER01 + XOR A +PLOTOK: LD (INPFLG),A + INC HL + RET +PLOTO_: CALL LPTTMD + CALL PPCHCK + LD A,(PNCHNM) + CP 'L' + JP Z,LPTMER + CALL PRTTX +PL40C: LD A,(INPFLG) + OR A + JR NZ,PLOTOK + CALL CONSOI + LD A,16H + RST 3 + DEFB _CRT1C + OR 01H + JR PLOTOK +; +PRTTX: LD A,1 + RST 3 + DEFB _LPTOT + LD A,(CRTMD2) + CP 3 + RET C + CALL T80CH + RET +; +PPCHCK: LD A,(PSEL) + BIT P_PLT,A ;if not plotter + JP Z,LPTMER ; then err + RET + + +; END (A471) + + +BASIC_PGM: + +; Block filler present in the MOD_A tape dump +;defb $1a, $1a, $1a, $1a, $1a, $1a, $1a, $1a, $1a, $1a, $1a, $1a, $1a, $1a, $1a + diff --git a/tests/restricted/marlinxsd.asm b/tests/restricted/marlinxsd.asm new file mode 100644 index 00000000..c0934eda --- /dev/null +++ b/tests/restricted/marlinxsd.asm @@ -0,0 +1,22393 @@ + ORG $0000 + +; NEC PC8201 + +L0000: + JP BOOT +NOFILE_MRK: + DEFM "-.-" + NOP + NOP + +; Check syntax, 1 byte follows to be compared +; +; Used by the routines at SNERR, __FOR, __DATA, FDTLP, OPNPAR, OPRND, UCASE, +; DEPINT, MAKINT, GETWORD, TOPOOL, LFRGNM, MIDNUM, CHKSTK, ISFLIO, SCPTLP and +; GET_DEVICE. +SYNCHR: + LD A,(HL) + EX (SP),HL + CP (HL) + JP NZ,SNERR + INC HL + EX (SP),HL +; This entry point is used by the routines at SNERR, __FOR, ULERR, __DATA, +; FDTLP, EVAL_04, OPRND, UCASE, FPSINT, FNDNUM, MAKINT, GETWORD, TOPOOL, MIDNUM, +; _DBL_ASCTFP, __RND, __POS, CHKSTK, ISFLIO, GETVAR, SCPTLP and GET_DEVICE. +CHRGTB: + JP _CHRGTB + +; This entry point is used by the routine at GET_DEVICE. +SYNCHR_1: + EX DE,HL + LD HL,($F507) + EX DE,HL + +; compare DE and HL (aka CPDEHL) +; +; Used by the routines at SNERR, __FOR, __DATA, MAKINT, GETWORD, TSTOPL, TESTR, +; GSTRDE, _DBL_ASCTFP, __POS, CHKSTK, GETVAR, SCPTLP and GET_DEVICE. +CPDEHL: + LD A,H + SUB D + RET NZ + LD A,L + SUB E + RET +; This entry point is used by the routine at ISFLIO. +CPDEHL_0: + LD A,' ' + +; Output char in 'A' to console +; +; Used by the routines at SNERR, __DATA, MAKINT, GETWORD, PRS1, ISFLIO, SCPTLP +; and GET_DEVICE. +OUTC: + JP _OUTC + NOP + JP TEL_TERM_000 + NOP + +; Test number FAC type (Precision mode, etc..) +; +; Used by the routines at TOKEN_BUILT, __FOR, __DATA, EVAL_04, OPRND, GETWORD, +; TOPOOL, MIDNUM, __ABS, _TSTSGN, LOADFP, FCOMP, HLPASS, TSTSTR, FIX, __INT, +; _DBL_ASCTFP, GETVAR and SCPTLP. +GETYPR: + JP __GETYPR + + NOP + DI + JP GET_DEVICE_697 + +; This entry point is used by the routines at __FOR, GETWORD, SCALE, __LOG, +; FMULT_BCDE, DIV, FCOMP, FIX, DECADD, _DBL_ASCTFP, POWER, __RND and __POS. +__TSTSGN: + JP TSTSGN + + NOP + DI + JP _UART + +; This entry point is used by the routines at SNERR, GETWORD, _DBL_ASCTFP, CHKSTK, +; ISFLIO, SCPTLP and GET_DEVICE. +GETYPR_1: + JP _RST38H + + NOP + DI + JP GETWORD_128 + +; Jump table for statements and functions +FNCTAB: + DEFW __END + DEFW __FOR + DEFW __NEXT + DEFW __DATA + DEFW __TANUT + DEFW __DIM + DEFW __READ + DEFW __LET + DEFW __GO TO + DEFW __RUN + DEFW __IF + DEFW __RESTORE + DEFW __GOSUB + DEFW __RETURN + DEFW __DATA+2 ; REM + DEFW __STOP + DEFW __PRINT + DEFW __CLEAR + DEFW __LIST + DEFW __NEW + DEFW __ON + DEFW ULERR + DEFW ULERR + DEFW __POKE + DEFW __CONT + DEFW __CSAVE + DEFW __CLOAD + DEFW __OUT + DEFW __LPRINT + DEFW __LLIST + DEFW ULERR + DEFW __WIDTH + DEFW __DATA+2 ; ELSE + DEFW ULERR + DEFW ULERR + DEFW ULERR + DEFW ULERR + DEFW __ERROR + DEFW __RESUME + DEFW __MENU + DEFW ULERR + DEFW __RENUM + DEFW __DEFSTR + DEFW __DEFINT + DEFW __DEFSNG + DEFW __DEFDBL + DEFW __LINE + DEFW __PRESET + DEFW __PSET + DEFW __BEEP + DEFW __FORMAT + DEFW __KEY + DEFW __COLOR + DEFW __COM + DEFW __MAX + DEFW __CMD + DEFW __MOTOR + DEFW __SOUND + DEFW __EDIT + DEFW __EXEC + DEFW __SCREEN + DEFW __CLS + DEFW __POWER + DEFW __BLOAD + DEFW __BSAVE + DEFW __DSKO_S + DEFW ULERR + DEFW ULERR + DEFW __OPEN + DEFW ULERR + DEFW ULERR + DEFW ULERR + DEFW ULERR + DEFW __CLOSE + DEFW _LOAD+2 ; __LOAD + DEFW _LOAD+3 ; __MERGE + DEFW __FILES + DEFW __NAME + DEFW __KILL + DEFW ULERR + DEFW ULERR + DEFW __SAVE + DEFW __LFILES + DEFW ULERR +FNCTAB_0: + DEFW __LOCATE + + DEFW ULERR + DEFW ULERR + DEFW ULERR + +;FNCTAB_FN: + DEFW __LEFT_S + DEFW __RIGHT_S + DEFW __MID_S + DEFW __SGN + DEFW __INT + DEFW __ABS + DEFW __SQR + DEFW __RND + DEFW __SIN + DEFW __LOG + DEFW __EXP + DEFW __COS + DEFW __TAN + DEFW __ATN + DEFW __FRE + DEFW __INP + DEFW __POS + DEFW __LEN + DEFW __STR_S + DEFW __VAL + DEFW __ASC + DEFW __CHR_S + DEFW __PEEK + DEFW __SPACE_S ; $18 + DEFW ULERR + DEFW ULERR + DEFW __LPOS + DEFW ULERR + DEFW ULERR + DEFW ULERR + DEFW __CINT + DEFW __CSNG + DEFW __CDBL ; $21 + DEFW FIX + DEFW ULERR + DEFW ULERR + DEFW ULERR + DEFW __DSKF ; $26 + DEFW __EOF ; $27 +FNCTAB_1: + DEFW __LOC ; $28 + DEFW __LOF ; $29 + DEFW L520D ; $2A + DEFW ULERR + DEFW ULERR + DEFW ULERR + +WORD_PTR: + DEFW WORDS_A + DEFW WORDS_B + DEFW WORDS_C + DEFW WORDS_D + DEFW WORDS_E + DEFW WORDS_F + DEFW WORDS_G + DEFW WORDS_H + DEFW WORDS_I + DEFW WORDS_J + DEFW WORDS_K + DEFW WORDS_L + DEFW WORDS_M + DEFW WORDS_N + DEFW WORDS_O + DEFW WORDS_P + DEFW WORDS_Q + DEFW WORDS_R + DEFW WORDS_S + DEFW WORDS_T + DEFW WORDS_U + DEFW WORDS_V + DEFW WORDS_W + DEFW WORDS_X ; $0396 + DEFW WORDS_Y ; $039A + DEFW WORDS_Z ; $039B + +; BASIC keyword list +WORDS: +WORDS_A: + DEFM "N" + DEFB $C4 + DEFB $F8 ; TK_AND + DEFM "B" + DEFB $D3 + DEFB $06 ; TK_ABS + DEFM "T" + DEFB $CE + DEFB $0E ; TK_ATN + DEFM "S" + DEFB $C3 + DEFB $15 ; TK_ASC + DEFB $00 + +WORDS_B: + DEFM "SAV" + DEFB $C5 + DEFB $C1 ; TK_BSAVE + DEFM "LOA" + DEFB $C4 + DEFB $C0 ; TK_BLOAD + DEFM "EE" + DEFB $D0 + DEFB $B2 ; TK_BEEP + DEFB $00 + +WORDS_C: + DEFM "OLO" + DEFB $D2 + DEFB $B5 ; TK_COLOR + DEFM "LOS" + DEFB $C5 + DEFB $CA ; TK_CLOSE + DEFM "ON" + DEFB $D4 + DEFB $99 ; TK_CONT + DEFM "LEA" + DEFB $D2 + DEFB $92 ; TK_CLEAR + DEFM "LOA" + DEFB $C4 + DEFB $9B ; TK_CLOAD + DEFM "SAV" + DEFB $C5 + DEFB $9A ; TK_CSAVE + DEFM "SRLI" + DEFB $CE + DEFB $E6 ; TK_CSRLIN + DEFM "IN" + DEFB $D4 + DEFB $1F ; TK_CINT + DEFM "SN" + DEFB $C7 + DEFB $20 ; TK_CSNG + DEFM "DB" + DEFB $CC + DEFB $21 ; TK_CDBL + DEFM "O" + DEFB $D3 + DEFB $0C ; TK_COS + DEFM "HR" + DEFB $A4 + DEFB $16 ; TK_CHR$ + DEFM "O" + DEFB $CD + DEFB $B6 ; TK_COM + DEFM "L" + DEFB $D3 + DEFB $BE ; TK_CLS + DEFM "M" + DEFB $C4 + DEFB $B8 ; TK_CMD + DEFB $00 + +WORDS_D: + DEFM "AT" + DEFB $C1 + DEFB $84 ; TK_DATE + DEFM "I" + DEFB $CD + DEFB $86 ; TK_DIM + DEFM "EFST" + DEFB $D2 + DEFB $AB ; TK_DEFSTR + DEFM "EFIN" + DEFB $D4 + DEFB $AC ; TK_DEFINT + DEFM "EFSN" + DEFB $C7 + DEFB $AD ; TK_DEFSNG + DEFM "EFDB" + DEFB $CC + DEFB $AE ; TK_DEFDBL + DEFM "SKO" + DEFB $A4 + DEFB $C2 ; TK_DSKO$ + DEFM "SKI" + DEFB $A4 + DEFB $E8 ; TK_DSKI$ + DEFM "SK" + DEFB $C6 + DEFB $26 ; TK_DSKF + DEFM "ATE" + DEFB $A4 + DEFB $EB ; TK_DATE$ + DEFB $00 + +WORDS_E: + DEFM "LS" + DEFB $C5 + DEFB $A1 ; TK_ELSE + DEFM "N" + DEFB $C4 + DEFB $81 ; TK_END + DEFM "DI" + DEFB $D4 + DEFB $BB ; TK_EDIT + DEFM "RRO" + DEFB $D2 + DEFB $A6 ; TK_ERROR + DEFM "R" + DEFB $CC + DEFB $DF ; TK_ERL + DEFM "R" + DEFB $D2 + DEFB $E0 ; TK_ERR + DEFM "XE" + DEFB $C3 + DEFB $BC ; TK_EXEC + DEFM "X" + DEFB $D0 + DEFB $0B ; TK_EXP + DEFM "O" + DEFB $C6 + DEFB $27 ; TK_EOF + DEFM "Q" + DEFB $D6 + DEFB $FB ; TK_EQV + DEFB $00 + +WORDS_F: + DEFM "ORMA" + DEFB $D4 + DEFB $B3 ; TK_FORMAT + DEFM "O" + DEFB $D2 + DEFB $82 ; TK_FOR + DEFM "ILE" + DEFB $D3 + DEFB $CD ; TK_FILES + DEFM "R" + DEFB $C5 + DEFB $0F ; TK_FRE + DEFM "I" + DEFB $D8 + DEFB $22 ; TK_FIX + DEFB $00 + +WORDS_G: + DEFM "OT" + DEFB $CF + DEFB $89 ; TK_GOTO + DEFM "O T" + DEFB $CF + DEFB $89 ; TK_GOTO + DEFM "OSU" + DEFB $C2 + DEFB $8D ; TK_GOSUB + DEFB $00 + +WORDS_H: + DEFB $00 + +WORDS_I: + DEFM "NPU" + DEFB $D4 + DEFB $85 ; TK_INPUT + DEFB $C6 + DEFB $8B ; TK_IF + DEFM "NST" + DEFB $D2 + DEFB $E3 ; TK_INSTR + DEFM "N" + DEFB $D4 + DEFB $05 ; TK_INT + DEFM "N" + DEFB $D0 + DEFB $10 ; TK_INP + DEFM "M" + DEFB $D0 + DEFB $FC ; TK_IMP + DEFM "NKEY" + DEFB $A4 + DEFB $E9 ; TK_INKEY + DEFB $00 + +WORDS_J: + DEFB $00 + +WORDS_K: + DEFM "IL" + DEFB $CC + DEFB $CF ; TK_KILL + DEFM "E" + DEFB $D9 + DEFB $B4 ; TK_KEY + DEFB $00 + +WORDS_L: + DEFM "OCAT" + DEFB $C5 + DEFB $D5 ; TK_LOCATE + DEFM "PRIN" + DEFB $D4 + DEFB $9D ; TK_LPRINT + DEFM "LIS" + DEFB $D4 + DEFB $9E ; TK_LLIST + DEFM "PO" + DEFB $D3 + DEFB $1B ; TK_LPOS + DEFM "E" + DEFB $D4 + DEFB $88 ; TK_LET + DEFM "IN" + DEFB $C5 + DEFB $AF ; TK_LINE + DEFM "OA" + DEFB $C4 + DEFB $CB ; TK_LOAD + DEFM "IS" + DEFB $D4 + DEFB $93 ; TK_LIST + DEFM "FILE" + DEFB $D3 + DEFB $D3 ; TK_LFILES + DEFM "O" + DEFB $C7 + DEFB $0A ; TK_LOG + DEFM "O" + DEFB $C3 + DEFB $28 ; TK_LOC + DEFM "E" + DEFB $CE + DEFB $12 ; TK_LEN + DEFM "EFT" + DEFB $A4 + DEFB $01 ; TK_LEFT$ + DEFM "O" + DEFB $C6 + DEFB $29 ; TK_LOF + DEFB $00 + +WORDS_M: + DEFM "OTO" + DEFB $D2 + DEFB $B9 ; TK_MOTOR + DEFM "ERG" + DEFB $C5 + DEFB $CC ; TK_MERGE + DEFM "O" + DEFB $C4 + DEFB $FD ; TK_MOD + DEFM "ID" + DEFB $A4 + DEFB $03 ; TK_MID$ + DEFM "A" + DEFB $D8 + DEFB $B7 ; TK_MAX + DEFM "EN" + DEFB $D5 + DEFB $A8 ; TK_MENU + DEFB $00 + +WORDS_N: + DEFM "EX" + DEFB $D4 + DEFB $83 ; TK_NEXT + DEFM "AM" + DEFB $C5 + DEFB $CE ; TK_NAME + DEFM "E" + DEFB $D7 + DEFB $94 ; TK_NEW + DEFM "O" + DEFB $D4 + DEFB $DE ; TK_NOT + DEFB $00 + +WORDS_O: + DEFM "PE" + DEFB $CE + DEFB $C5 ; TK_OPEN + DEFM "U" + DEFB $D4 + DEFB $9C ; TK_OUT + DEFB $CE + DEFB $95 ; TK_ON + DEFB $D2 + DEFB $F9 ; TK_OR + DEFM "F" + DEFB $C6 + DEFB $E7 ; TK_OFF + DEFB $00 + +WORDS_P: + DEFM "RIN" + DEFB $D4 + DEFB $91 ; TK_PRINT + DEFM "OK" + DEFB $C5 + DEFB $98 ; TK_POKE + DEFM "O" + DEFB $D3 + DEFB $11 ; TK_POS + DEFM "EE" + DEFB $CB + DEFB $17 ; TK_PEEK + DEFM "SE" + DEFB $D4 + DEFB $B1 ; TK_PSET + DEFM "RESE" + DEFB $D4 + DEFB $B0 ; TK_PRESET + DEFM "OWE" + DEFB $D2 + DEFB $BF ; TK_POWER + DEFB $00 + +WORDS_Q: + DEFB $00 + +WORDS_R: + DEFM "ETUR" + DEFB $CE + DEFB $8E ; TK_RETURN + DEFM "EA" + DEFB $C4 + DEFB $87 ; TK_READ + DEFM "U" + DEFB $CE + DEFB $8A ; TK_RUN + DEFM "ESTOR" + DEFB $C5 + DEFB $8C ; TK_RESTORE + DEFM "E" + DEFB $CD + DEFB $8F ; TK_REM + DEFM "ESUM" + DEFB $C5 + DEFB $A7 ; TK_RESUME + DEFM "IGHT" + DEFB $A4 + DEFB $02 ; TK_RIGHT$ + DEFM "N" + DEFB $C4 + DEFB $08 ; TK_RND + DEFM "ENU" + DEFB $CD + DEFB $AA ; TK_RENUM + DEFB $00 + +WORDS_S: + DEFM "CREE" + DEFB $CE + DEFB $BD ; TK_SCREEN + DEFM "TO" + DEFB $D0 + DEFB $90 ; TK_STOP + DEFM "TATU" + DEFB $D3 + DEFB $EE ; TK_STATUS + DEFM "AV" + DEFB $C5 + DEFB $D2 ; TK_SAVE + DEFM "TE" + DEFB $D0 + DEFB $DA ; TK_STEP + DEFM "G" + DEFB $CE + DEFB $04 ; TK_SGN + DEFM "Q" + DEFB $D2 + DEFB $07 ; TK_SQR + DEFM "I" + DEFB $CE + DEFB $09 ; TK_SIN + DEFM "TR" + DEFB $A4 + DEFB $13 ; TK_STR$ + DEFM "TRING" + DEFB $A4 + DEFB $E1 ; TK_STRING$ + DEFM "PACE" + DEFB $A4 + DEFB $18 ; TK_SPACE$ + DEFM "OUN" + DEFB $C4 + DEFB $BA ; TK_SOUND + DEFB $00 + +WORDS_T: + DEFM "HE" + DEFB $CE + DEFB $D8 ; TK_THEN + DEFM "AB" + DEFB $A8 + DEFB $D9 ; TK_TAB( + DEFB $CF + DEFB $D7 ; TK_TO + DEFM "IME" + DEFB $A4 + DEFB $EA ; TK_TIME$ + DEFM "A" + DEFB $CE + DEFB $0D ; TK_TAN + DEFB $00 + +WORDS_U: + DEFM "SIN" + DEFB $C7 + DEFB $E2 ; TK_USING + DEFB $00 + +WORDS_V: + DEFM "A" + DEFB $CC + DEFB $14 ; TK_VAL + DEFB $00 + +WORDS_W: + DEFM "IDT" + DEFB $C8 + DEFB $A0 ; TK_WIDTH + DEFB $00 + +WORDS_X: + + DEFM "O" + DEFB 'R'+$80 + DEFB $FA ;TK_XOR + DEFB $00 + +WORDS_Y: + + DEFB $00 + +WORDS_Z: + + DEFB $00 + + +OPR_TOKENS: + DEFB $AB + DEFB $F3 ; TK_PLUS ; Token for '+' + DEFB $AD + DEFB $F4 ; TK_MINUS ; Token for '-' + DEFB $AA + DEFB $F5 ; TK_STAR ; Token for '*' + DEFB $AF + DEFB $F6 ; TK_SLASH ; Token for '/' + DEFB $DE + DEFB $F7 ; TK_EXPONENT ; Token for '^' + DEFB $DC + DEFB $FE ; TK_BKSLASH ; Token for '\' + DEFB $A7 + DEFB $E4 ; TK_APOSTROPHE ; Token for ''' + DEFB $BE + DEFB $F0 ; TK_GREATER ; Token for '>' + DEFB $BD + DEFB $F1 ; TK_EQUAL ; Token for '=' + DEFB $BC + DEFB $F2 ; TK_MINOR ; Token for '<' + DEFB $00 + +; ARITHMETIC PRECEDENCE TABLE +PRITAB: + DEFB $79 ; + (Token code $F1) + DEFB $79 ; - + DEFB $7c ; * + DEFB $7c ; / + DEFB $7f ; ^ + DEFB $50 ; AND + DEFB $46 ; OR + DEFB $3c ; XOR + DEFB $32 ; EQU + DEFB $28 ; IMP + DEFB $7a ; MOD + DEFB $7b ; \ (Token code $FC) + +; NUMBER TYPES +TYPE_OPR: + DEFW __CDBL + DEFW 0 + DEFW __CINT + DEFW TSTSTR + DEFW __CSNG + +DEC_OPR: + DEFW DECADD + DEFW DECSUB + DEFW DECMUL + DEFW DECDIV + DEFW DECCOMP + +FLT_OPR: + DEFW FADD + DEFW FSUB + DEFW FMULT_BCDE + DEFW FDIV + DEFW FCOMP + +;$03DB +INT_OPR: + DEFW IADD + DEFW ISUB + DEFW IMULT + DEFW IDIV + DEFW ICOMP + + +ERRMSG: + DEFM "NFSNRGODFCOVOMULBSDD" + DEFM "/0IDTMOSLSSTCNUFNRRW" + DEFM "UEMOBOIODUIEBNFFAOEF" + DEFM "NMDSFLCFPC" + +; Data block at 1067 +SYSVARS_ROM: + DEFW $8A4D + DEFW $0000 + DEFW $F380 + DEFW $00C9 + DEFW $FB00 + DEFW $00C9 + DEFW $00C9 + DEFW $C900 + DEFW $0000 + DEFW $95C3 + DEFW $DB18 + DEFW $E6A0 + DEFW $C00C + DEFW FNCTAB_1 + DEFW $A1D3 + DEFW $4021 + DEFW $1100 + DEFW $F991 + DEFW $127E + DEFW UCASE_6 + DEFW $D67D + DEFW $C248 + DEFW $F3A4 + DEFW $A1D3 + DEFW $912A + DEFW $11F9 + DEFW $4241 + DEFW $18C3 + DEFW $F300 + DEFW FNCTAB_1 + DEFW $A1D3 + DEFW $00C7 + DEFW $5321 + DEFW $5459 + DEFW FNCTAB + DEFW $00F0 + DEFW $00C9 + DEFW $C900 + DEFW $0000 + DEFW $00C9 + DEFW $C900 + DEFW $0000 + DEFW $00C9 + DEFW $C900 + DEFW $0000 + DEFW $0000 + DEFW $C9C0 + DEFW $0000 + DEFW $0000 + DEFW $FFFF + DEFW $0100 + DEFW $0801 + DEFW GETYPR + DEFW $0000 + DEFW $0101 + DEFW $0101 + DEFW $2819 + DEFW $0000 + DEFW L4FC4_4 + DEFW $3038 + DEFW $0000 + DEFW $0000 + DEFW $0000 + DEFW $0000 + DEFW $0000 + DEFW $FF64 + DEFW $0000 + DEFW $4938 + DEFW $3137 + DEFW GET_DEVICE_5 + DEFW $00C3 + DEFW $0000 + DEFW $00C9 + DEFW $D3C9 + DEFW $C900 + DEFW $00D6 + DEFW $7C6F + DEFW $00DE + DEFW $7867 + DEFW $00DE + DEFW $3E47 + DEFW $C900 + DEFW $0000 + DEFW $3500 + DEFW $CA4A + DEFW $3999 + DEFW $761C + DEFW $2298 + DEFW $B395 + DEFW $0A98 + DEFW $47DD + DEFW $5398 + DEFW $99D1 + DEFW $0A99 + DEFW $9F1A + DEFW $6598 + DEFW $CDBC + DEFW $D698 + DEFW $3E77 + DEFW $5298 + DEFW $4FC7 + DEFW $DB80 + DEFW $C900 + DEFW $003A + DEFW $0000 + DEFW $0000 + DEFW $0000 + DEFW __IF + DEFW $FA00 + DEFW $FEFB + DEFW $97FF + DEFW $00FB + DEFB 0 + + + +; Message at 1292 +ERR_MSG: + DEFM " Error" + DEFB $00 +;$0513 +IN_MSG: + DEFM " in " + +; Data block at 1303 +NULL_STRING: + DEFB $00 + +; Message at 1304 +OK_MSG: + DEFM "Ok" + DEFB $0D + DEFB $0A + DEFB $00 + +BREAK_MSG: + DEFM "Break" + DEFB $00 + +; Routine at 1315 +; +; Used by the routines at ULERR and CHKSTK. +L0523: + LD HL,$0004 + ADD HL,SP +; This entry point is used by the routine at __FOR. +NEXT_UNSTACK_0: + LD A,(HL) + INC HL + CP $82 + RET NZ + LD C,(HL) + INC HL + LD B,(HL) + INC HL + PUSH HL + LD H,B + LD L,C + LD A,D + OR E + EX DE,HL + JP Z,L0523_1 + EX DE,HL + RST $18 +L0523_1: + LD BC,$000E + POP HL + RET Z + ADD HL,BC + JP NEXT_UNSTACK_0 + +; This entry point is used by the routine at __MERGE. +L0523_2: + LD BC,RESTART +; This entry point is used by the routine at ISFLIO. +L0523_3: + JP JPBC + +; This entry point is used by the routine at __FOR. +L0523_4: + LD HL,(CURLIN) + LD A,H + AND L + INC A + JP Z,BASIC_MAIN_1 + LD A,($FADA) + OR A + LD E,$13 + JP NZ,ERROR +BASIC_MAIN_1: + JP __END_1 + JP ERROR + + +; 'SN err' entry for Input STMT +; +; Used by the routine at __DATA. +DATSNR: + LD HL,(DATLIN) + LD (CURLIN),HL + +; entry for '?SN ERROR' +; +; Used by the routines at SYNCHR, __FOR, __DATA, EVAL_04, GETWORD, CHKSTK, +; GETVAR, SCPTLP and GET_DEVICE. +SNERR: + LD E,$02 + LD BC,$3B1E + LD BC,$191E + LD BC,$0B1E + LD BC,$011E + LD BC,$0A1E + LD BC,$141E + LD BC,$061E + LD BC,$161E + LD BC,$0D1E + +; This entry point is used by the routines at TOKEN_BUILT, __FOR, ULERR, +; __DATA, FDTLP, GETWORD, TSTOPL, TESTR, CONCAT, CHKSTK, SCPTLP and GET_DEVICE. +ERROR: + XOR A + LD (NLONLY),A + LD HL,(VLZADR) + LD A,H + OR L + JP Z,SNERR_1 + LD A,(VLZDAT) + LD (HL),A + LD HL,$0000 + LD (VLZADR),HL +SNERR_1: + EI + LD HL,(ERRTRP) + PUSH HL + LD A,H + OR L + RET NZ + LD HL,(CURLIN) + LD (ERRLIN),HL + LD A,H + AND L + INC A + JP Z,ERROR_2 + LD (DOT),HL +; This entry point is used by the routine at __DATA. +ERROR_2: + LD BC,L05BB + LD HL,(SAVSTK) + JP WARM_ENTRY + +L05BB: + POP BC + LD A,E + LD C,E + LD (ERR_CODE),A + LD HL,(SAVTXT) + LD (ERRTXT),HL + EX DE,HL + LD HL,(ERRLIN) + LD A,H + AND L + INC A + JP Z,SNERR_3 + LD (OLDLIN),HL + EX DE,HL + LD (OLDTXT),HL +SNERR_3: + LD HL,(ONELIN) + LD A,H + OR L + EX DE,HL + LD HL,ONEFLG ; =1 if executing an error trap routine + JP Z,ERROR_REPORT + AND (HL) + JP NZ,ERROR_REPORT + ; We get here if the standard error handling is temporairly disabled (error trap). + DEC (HL) + EX DE,HL + JP EXEC_EVAL_0_1 + +ERROR_REPORT: + XOR A + LD (HL),A + LD E,C + CALL CONSOLE_CRLF + CALL HERRP ; Hook 1 for Error Handler + LD A,E + CP $3C + JP NC,UNKNOWN_ERR ; JP if error code is bigger than $3B + CP $32 + JP NC,SUB_18_ERR ; JP if error code is between $33 and $3B + CP $1A + JP C,SNERR_7 ; JP if error code is < $1A + +UNKNOWN_ERR: + LD A,$2D ; if error code is bigger than $3B then force it to ("Unprintable error") +SUB_18_ERR: + SUB $18 ; JP if error code is between $33 and $3B, sub $18 + LD E,A +SNERR_7: + LD D,$00 + LD HL,ERRMSG-2 + ADD HL,DE + ADD HL,DE + LD A,$3F ; '?' + RST OUTC + LD A,(HL) + RST OUTC + RST CHRGTB ; Gets next character (or token) from BASIC text. + RST OUTC + LD HL,ERR_MSG + PUSH HL + LD HL,(ERRLIN) + EX (SP),HL +; This entry point is used by the routine at CHKSTK. +SNERR_8: + CALL PRS + POP HL + LD A,H + AND L + INC A + CALL NZ,LNUM_MSG + LD A,$C1 + +; Routine at 1580 +; +; Used by the routines at GETWORD, CHKSTK and ISFLIO. +RESTART: + POP BC +; This entry point is used by the routines at MAKINT, GETWORD and GET_DEVICE. +READY: + CALL INIT_OUTPUT + CALL SCPTLP_104 + CALL CONSOLE_CRLF + LD HL,OK_MSG + CALL PRS + +; This entry point is used by the routine at SCPTLP. +PROMPT: + LD HL,$FFFF + LD (CURLIN),HL + LD HL,ENDPRG + LD (SAVTXT),HL + CALL ERAEOL1 + JP C,PROMPT +; Perform operation in (HL) buffer and return to BASIC ready. +EXEC_HL: + RST CHRGTB ; Gets next character (or token) from BASIC text. + INC A + DEC A + JP Z,PROMPT + PUSH AF + CALL LNUM_PARM_0 + JP NC,EXEC_HL_0 + CALL ISFLIO + JP Z,SNERR +EXEC_HL_0: + CALL EXEC_HL_SUB + LD A,(HL) + CP ' ' + CALL Z,INCHL + PUSH DE + CALL TOKENIZE + POP DE + POP AF + LD (SAVTXT),HL + JP NC,INIT_PRINT_h_2 + PUSH DE + PUSH BC + RST CHRGTB ; Gets next character (or token) from BASIC text. + OR A + PUSH AF + EX DE,HL + LD (DOT),HL + EX DE,HL + CALL FIRST_LNUM ; Get first line number + JP C,EXEC_HL_1 + POP AF + PUSH AF + JP Z,ULERR ; Error: "Undefined line number" + OR A +EXEC_HL_1: + PUSH BC + PUSH AF + PUSH HL + CALL EXEC_HL_FLIO + POP HL + POP AF + POP BC + PUSH BC + JP NC,EXEC_HL_2 + CALL DETOKEN_NEXT5 + LD A,C + SUB E + LD C,A + LD A,B + SBC A,D + LD B,A + CALL GETWORD_256 + LD HL,(CO_FILES) + ADD HL,BC + LD (CO_FILES),HL + LD HL,(RAM_FILES) + ADD HL,BC + LD (RAM_FILES),HL +EXEC_HL_2: + POP DE + POP AF + PUSH DE + JP Z,SNERR_15 + POP DE + LD HL,$0000 + LD (ONELIN),HL + LD HL,(PROGND) + EX (SP),HL + POP BC + PUSH HL + ADD HL,BC + PUSH HL + CALL __POS_1 + POP HL + LD (PROGND),HL + EX DE,HL + LD (HL),H + POP BC + POP DE + PUSH HL + INC HL + INC HL + LD (HL),E + INC HL + LD (HL),D + INC HL + LD DE,KBUF + PUSH HL + CALL GETWORD_256 + LD HL,(CO_FILES) + ADD HL,BC + LD (CO_FILES),HL + LD HL,(RAM_FILES) + ADD HL,BC + LD (RAM_FILES),HL + POP HL + DEC BC + DEC BC + DEC BC + DEC BC +SNERR_14: + LD A,(DE) + LD (HL),A + INC HL + INC DE + DEC BC + LD A,C + OR B + JP NZ,SNERR_14 +SNERR_15: + POP DE + CALL UPD_PTRS_0 + LD HL,(PTRFIL) + LD (TEMP2),HL + CALL RUN_FST + LD HL,(TEMP2) + LD (PTRFIL),HL ; Redirect I/O + JP PROMPT +; This entry point is used by the routines at GETWORD, CHKSTK and GET_DEVICE. +UPD_PTRS: + LD HL,(BASTXT) + EX DE,HL +; This entry point is used by the routine at GETWORD. +UPD_PTRS_0: + LD H,D + LD L,E + LD A,(HL) + INC HL + OR (HL) + RET Z + INC HL + INC HL +SNERR_18: + INC HL + LD A,(HL) +SNERR_19: + OR A + JP Z,ERROR_20 + CP ' ' + JP NC,SNERR_18 + CP $0B + JP C,SNERR_18 + CALL __FOR_12 + RST CHRGTB ; Gets next character (or token) from BASIC text. + JP SNERR_19 +ERROR_20: + INC HL + EX DE,HL + LD (HL),E + INC HL + LD (HL),D + JP UPD_PTRS_0 + +; This entry point is used by the routine at MAKINT. +LNUM_RANGE: + LD DE,$0000 + PUSH DE + JP Z,$0750 + POP DE + CALL __FOR_33 + PUSH DE + JP Z,ERROR_22 + RST SYNCHR ; Check syntax: next byte holds the byte to be found + CALL P,TEL_TERM_015 + RST $38 + CALL NZ,__FOR_33 + JP NZ,SNERR + +ERROR_22: + EX DE,HL + POP DE +; This entry point is used by the routine at __DATA. +PHL_FIND_LINE: + EX (SP),HL + PUSH HL +; This entry point is used by the routines at __FOR, GETWORD and CHKSTK. +FIRST_LNUM: + LD HL,(BASTXT) +; This entry point is used by the routine at __FOR. +FIND_LINE_FHL: + LD B,H + LD C,L + LD A,(HL) + INC HL + OR (HL) + DEC HL + RET Z + INC HL + INC HL + LD A,(HL) + INC HL + LD H,(HL) + LD L,A + RST CPDEHL + LD H,B + LD L,C + LD A,(HL) + INC HL + LD H,(HL) + LD L,A + CCF + RET Z + CCF + RET NC + JP FIND_LINE_FHL + +TOKENIZE: + XOR A + LD (DONUM),A + LD (OPRTYP),A + LD BC,$013B ; $01, $3b + LD DE,KBUF + +; This entry point is used by the routine at TOKEN_BUILT. +TOKENIZE_NEXT: + LD A,(HL) + OR A + JP NZ,TOKENIZE_2 + +TOKENIZE_END: + LD HL,$0140 ; $01, $40 + LD A,L + SUB C + LD C,A + LD A,H + SBC A,B + LD B,A + LD HL,BUFFER + XOR A + LD (DE),A + INC DE + LD (DE),A + INC DE + LD (DE),A + RET + +TOKENIZE_2: + CP '"' + JP Z,TOKENIZE_8 + CP ' ' + JP Z,TOKENIZE_3 + LD A,(OPRTYP) + OR A + LD A,(HL) + JP Z,TOKENIZE_11 +; This entry point is used by the routine at TOKEN_BUILT. +TOKENIZE_3: + INC HL + PUSH AF + CALL TOKENIZE_ADD + POP AF + SUB $3A ; ':' + JP Z,HAVE_TOKEN + CP $4A ; $4A + $3A = $84 -> TK_DATA + JP NZ,TOKENIZE_6 + LD A,$01 +HAVE_TOKEN: + LD (OPRTYP),A ; Indicates whether stored word can be crunched + LD (DONUM),A +TOKENIZE_6: + SUB $55 ; $55 + $3A = $8F -> TK_REM + JP NZ,TOKENIZE_NEXT + PUSH AF +TOKENIZE_7: + LD A,(HL) + OR A + EX (SP),HL + LD A,H + POP HL + JP Z,TOKENIZE_END + CP (HL) + JP Z,TOKENIZE_3 + +TOKENIZE_8: + PUSH AF + LD A,(HL) +; This entry point is used by the routine at TOKEN_BUILT. +TOKENIZE_10: + INC HL + CALL TOKENIZE_ADD + JP TOKENIZE_7 + +TOKENIZE_11: + INC HL + OR A + JP M,TOKENIZE_NEXT + DEC HL + CP '?' + LD A,$91 ; TK_PRINT + PUSH DE + PUSH BC + JP Z,TOKEN_FOUND + LD DE,OPR_TOKENS + CALL UCASE_HL + CALL IS_ALPHA_A + JP C,TOKEN_BUILT_2 + PUSH HL + LD HL,WORD_PTR + SUB $41 + ADD A,A + LD C,A + LD B,$00 + ADD HL,BC + LD E,(HL) + INC HL + LD D,(HL) + POP HL + INC HL +TOKENIZE_13: + PUSH HL +TOKENIZE_14: + CALL UCASE_HL + LD C,A + LD A,(DE) + AND $7F + JP Z,TOKEN_BUILT_14 + INC HL + CP C + JP NZ,TOKENIZE_15 + LD A,(DE) + INC DE + OR A + JP P,TOKENIZE_14 + POP AF + LD A,(DE) + OR A + JP M,TOKENIZE_17 + POP BC + POP DE + OR $80 + PUSH AF + LD A,$FF + CALL TOKENIZE_ADD + XOR A + LD (DONUM),A + POP AF + CALL TOKENIZE_ADD + JP TOKENIZE_NEXT + +TOKENIZE_15: + POP HL +TOKENIZE_16: + LD A,(DE) + INC DE + OR A + JP P,TOKENIZE_16 + INC DE + JP TOKENIZE_13 + +TOKENIZE_17: + DEC HL +TOKEN_FOUND: + PUSH AF + LD DE,LNUM_TOKENS + LD C,A +TOKENIZE_19: + LD A,(DE) + OR A + JP Z,TOKEN_BUILT + INC DE + CP C + JP NZ,TOKENIZE_19 + JP TOKENIZE_LNUM + +; Message at 2143 +LNUM_TOKENS: + DEFB $8C ; TK_RESTORE + DEFB $AA ; TK_RENUM + DEFB $BB ; TK_EDIT + DEFB $A7 ; TK_RESUME + DEFB $DF ; TK_ERL + DEFB $A1 ; TK_ELSE + DEFB $8A ; TK_RUN + DEFB $93 ; TK_LIST + DEFB $9E ; TK_LLIST + DEFB $89 ; TK_GOTO + DEFB $8E ; TK_RETURN + DEFB $D8 ; TK_THEN + DEFB $8D ; TK_GOSUB + DEFB $00 + +; This entry point is used by the routine at TOKENIZE. +TOKEN_BUILT: + XOR A + defb $C2 ; JP NZ,NN (always false), masks the next 2 bytes +TOKENIZE_LNUM: + LD A,1 + +TOKEN_BUILT_0: + LD (DONUM),A + POP AF +TOKEN_BUILT_1: + POP BC + POP DE + CP $A1 ; TK_ELSE + PUSH AF + CALL Z,TOKENIZE_COLON + POP AF + CP $E4 ; (TK_APOSTROPHE) COMMENT, check if line ends with the apostrophe.. + JP NZ,TOKENIZE_3 + PUSH AF + CALL TOKENIZE_COLON + LD A,$8F + CALL TOKENIZE_ADD + POP AF + PUSH HL + LD HL,$0000 + EX (SP),HL + JP TOKENIZE_10 + +; This entry point is used by the routine at SNERR. +TOKEN_BUILT_2: + LD A,(HL) + CP '.' + JP Z,TOKEN_BUILT_3 + CP '9'+1 + JP NC,TOKEN_BUILT_10 + CP '0' + JP C,TOKEN_BUILT_10 +TOKEN_BUILT_3: + LD A,(DONUM) + OR A + LD A,(HL) + POP BC + POP DE + JP M,TOKENIZE_3 + JP Z,TOKEN_BUILT_6 + CP '.' + JP Z,TOKENIZE_3 + LD A,$0E ; Line number prefix + CALL TOKENIZE_ADD + PUSH DE + CALL LNUM_PARM_0 ; Get specified line number + CALL EXEC_HL_SUB + EX (SP),HL + EX DE,HL +TOKEN_BUILT_4: + LD A,L + CALL TOKENIZE_ADD + LD A,H +TOKEN_BUILT_5: + POP HL + CALL TOKENIZE_ADD + JP TOKENIZE_NEXT + +TOKEN_BUILT_6: + PUSH DE + PUSH BC + LD A,(HL) + CALL DBL_ASCTFP + CALL EXEC_HL_SUB + POP BC + POP DE + PUSH HL + LD A,(VALTYP) + CP $02 + JP NZ,TOKEN_BUILT_7 + LD HL,(DBL_FPREG) + LD A,H + OR A + LD A,$02 + JP NZ,TOKEN_BUILT_7 + LD A,L + LD H,L + LD L,$0F + CP $0A + JP NC,TOKEN_BUILT_4 + ADD A,$11 + JP TOKEN_BUILT_5 +TOKEN_BUILT_7: + PUSH AF + RRCA + ADD A,$1B + CALL TOKENIZE_ADD + LD HL,DBL_FPREG + RST GETYPR ; Get the number type (FAC) + JP C,TOKEN_BUILT_8 + LD HL,$FB24 +TOKEN_BUILT_8: + POP AF +TOKEN_BUILT_9: + PUSH AF + LD A,(HL) + CALL TOKENIZE_ADD + POP AF + INC HL + DEC A + JP NZ,TOKEN_BUILT_9 + POP HL + JP TOKENIZE_NEXT + +TOKEN_BUILT_10: + LD DE,OPR_TOKENS-1 +TOKEN_BUILT_11: + INC DE + LD A,(DE) + AND $7F + JP Z,TOKEN_BUILT_15 + INC DE + CP (HL) + LD A,(DE) + JP NZ,TOKEN_BUILT_11 + JP TOKEN_BUILT_16 + +TOKENIZE_COLON: + LD A,':' +; This entry point is used by the routine at SNERR. +TOKENIZE_ADD: + LD (DE),A + INC DE + DEC BC + LD A,C + OR B + RET NZ + LD E,$17 + JP ERROR + +; This entry point is used by the routine at SNERR. +TOKEN_BUILT_14: + POP HL + DEC HL + DEC A + LD (DONUM),A + CALL UCASE_HL + JP TOKEN_BUILT_1 +TOKEN_BUILT_15: + LD A,(HL) + CP ' ' + JP NC,TOKEN_BUILT_16 + CP $09 + JP Z,TOKEN_BUILT_16 + CP $0A + JP Z,TOKEN_BUILT_16 + LD A,' ' +TOKEN_BUILT_16: + PUSH AF + LD A,(DONUM) + INC A + JP Z,TOKEN_BUILT_17 + DEC A +TOKEN_BUILT_17: + JP TOKEN_BUILT_0 + +; This entry point is used by the routine at SNERR. +EXEC_HL_SUB: + DEC HL + LD A,(HL) + CP ' ' + JP Z,EXEC_HL_SUB + CP $09 + JP Z,EXEC_HL_SUB + CP $0A + JP Z,EXEC_HL_SUB + INC HL + RET + +; 'FOR' BASIC instruction +__FOR: + LD A,$64 + LD (SUBFLG),A + CALL __LET + POP BC + PUSH HL + CALL __DATA + LD ($FAC5),HL + LD HL,$0002 + ADD HL,SP +__FOR_0: + CALL $0527 + JP NZ,$09AD + ADD HL,BC + PUSH DE + DEC HL + LD D,(HL) + DEC HL + LD E,(HL) + INC HL + INC HL + PUSH HL + LD HL,($FAC5) + RST CPDEHL + POP HL + POP DE + JP NZ,__FOR_0 + POP DE + LD SP,HL + LD (SAVSTK),HL + LD C,$D1 + EX DE,HL + LD C,$08 + CALL CHKSTK + PUSH HL + LD HL,($FAC5) + EX (SP),HL + PUSH HL + LD HL,(CURLIN) + EX (SP),HL + RST SYNCHR ; Check syntax: next byte holds the byte to be found + RST CHRGTB ; Gets next character (or token) from BASIC text. + RST GETYPR ; Get the number type (FAC) + JP Z,TMERR + JP NC,TMERR + PUSH AF + CALL EVAL + POP AF + PUSH HL + JP P,__FOR_1 + CALL __CINT + EX (SP),HL + LD DE,$0001 + LD A,(HL) + CP $DA ; TK_STEP + CALL Z,FPSINT + PUSH DE + PUSH HL + EX DE,HL + CALL _SGN_RESULT + JP __FOR_2 +__FOR_1: + CALL __CSNG + CALL BCDEFP + POP HL + PUSH BC + PUSH DE + LD BC,$8100 + LD D,C + LD E,D + LD A,(HL) + CP $DA ; TK_STEP + LD A,$01 + JP NZ,__FOR_3 + CALL EVAL_0 + PUSH HL + CALL __CSNG + CALL BCDEFP + RST TSTSGN +__FOR_2: + POP HL +__FOR_3: + PUSH BC + PUSH DE + OR A + JP NZ,__FOR_4 + LD A,$02 +__FOR_4: + LD C,A + RST GETYPR ; Get the number type (FAC) + LD B,A + PUSH BC + PUSH HL + LD HL,(TEMP) + EX (SP),HL +; This entry point is used by the routine at CHKSTK. +__FOR_5: + LD B,$82 + PUSH BC + INC SP + +; This entry point is used by the routines at GETWORD, CHKSTK, ISFLIO and +; GET_DEVICE. +EXEC_EVAL_0: + CALL TEL_TERM_008 + CALL RCVX + CALL NZ,RUN_FST3 +; This entry point is used by the routine at GETWORD. +EXEC_EVAL_00: + CALL CHSNS_0 + LD (SAVTXT),HL + EX DE,HL + LD HL,$0000 + ADD HL,SP + LD (SAVSTK),HL + EX DE,HL + LD A,(HL) + CP $3A + JP Z,EXEC + OR A + JP NZ,SNERR + INC HL +; This entry point is used by the routine at SNERR. +EXEC_EVAL_0_1: + LD A,(HL) + INC HL + OR (HL) + JP Z,WORDS_3 + INC HL + LD E,(HL) + INC HL + LD D,(HL) + EX DE,HL + LD (CURLIN),HL + EX DE,HL + +; This entry point is used by the routine at SCPTLP. +EXEC: + RST CHRGTB ; Gets next character (or token) from BASIC text. + LD DE,EXEC_EVAL_0 + PUSH DE + RET Z +; This entry point is used by the routine at __DATA. +__FOR_10: + CP $EA ; TK_TIME + JP Z,TIME + CP $EB ; TK_DATE + JP Z,DATE + SUB $81 ; Normal Alphanum sequence ? + JP C,__LET ; Ok, assume an implicit "LET" statement + CP $55 ;TK_TO-$81 + JP NC,SNERR + RLCA + LD C,A + LD B,$00 + EX DE,HL + LD HL,($F3C4) ; FNCTAB JP table + ADD HL,BC + LD C,(HL) + INC HL + LD B,(HL) + PUSH BC + EX DE,HL + +; This entry point is used by the routines at SYNCHR, __DATA, DTSTR and SCPTLP. +_CHRGTB: + INC HL +; This entry point is used by the routine at SNERR. +__FOR_12: + LD A,(HL) + CP $3A + RET NC + CP ' ' + JP Z,_CHRGTB + JP NC,__FOR_22 + OR A + RET Z + CP $0B + JP C,__FOR_21 + CP $0D + JP NC,__FOR_13 + LD A,$1C +__FOR_13: + CP $1E + JP NZ,__FOR_14 + LD A,(CONSAV) + OR A + RET +__FOR_14: + CP $10 + JP Z,__FOR_19 + PUSH AF + INC HL + LD (CONSAV),A + SUB $1C + JP NC,__FOR_20 + SUB $F5 + JP NC,__FOR_15 + CP $FE + JP NZ,__FOR_17 + LD A,(HL) + INC HL +__FOR_15: + LD (CONTXT),HL + LD H,$00 +__FOR_16: + LD L,A + LD (CONLO),HL + LD A,$02 + LD (CONTYP),A + LD HL,$0B05 + POP AF + OR A + RET +__FOR_17: + LD A,(HL) + INC HL + INC HL + LD (CONTXT),HL + DEC HL + LD H,(HL) + JP __FOR_16 +; This entry point is used by the routine at OPRND. +__FOR_18: + CALL __FOR_23 +__FOR_19: + LD HL,(CONTXT) + JP __FOR_12 +__FOR_20: + INC A + RLCA + LD (CONTYP),A + PUSH DE + PUSH BC + LD DE,CONLO + EX DE,HL + LD B,A + CALL REV_LDIR_B + EX DE,HL + POP BC + POP DE + LD (CONTXT),HL + POP AF + LD HL,$0B05 + OR A + RET +__FOR_21: + CP $09 + JP NC,_CHRGTB +__FOR_22: + CP '0' + CCF + INC A + DEC A + RET + + LD E,$10 +; This entry point is used by the routine at MAKINT. +__FOR_23: + LD A,(CONSAV) + CP $0F ; Prefix for Integer 10 to 255 ? + JP NC,__FOR_25 + CP $0C+1 + JP C,__FOR_25 ; JP if Prefix for Hex or Octal number + LD HL,(CONLO) ; Value of stored constant + JP NZ,__FOR_24 + INC HL + INC HL + INC HL + LD E,(HL) + INC HL + LD D,(HL) + EX DE,HL +__FOR_24: + JP DBL_ABS_0 + +__FOR_25: + LD A,(CONTYP) ; Type of stored constant + LD (VALTYP),A + CP $08 + JP Z,__FOR_26 + LD HL,(CONLO) ; Value of stored constant + LD (DBL_FPREG),HL + LD HL,(CONLO+2) + LD (LAST_FPREG),HL + RET + +__FOR_26: + LD HL,CONLO + JP LOADFP_7 + + +__DEFSTR: + LD E,$03 + + DEFB $01 ; "LD BC,nn" to jump over the next word without executing it + +__DEFINT: + LD E,$02 ; Integer type + + DEFB $01 ; "LD BC,nn" to jump over the next word without executing it + +__DEFSNG: + LD E,$04 ; Single precision type + + DEFB $01 ; "LD BC,nn" to jump over the next word without executing it + +__DEFDBL: + LD E,$08 ; Double Precision type + +DEFVAL: + CALL IS_ALPHA ; Load A with char in (HL) and check it is a letter + LD BC,SNERR + PUSH BC + RET C + SUB $41 + LD C,A + LD B,A + RST CHRGTB ; Gets next character (or token) from BASIC text. + CP $F4 ; TK_MINUS, '-' + JP NZ,__FOR_28 + RST CHRGTB ; Gets next character (or token) from BASIC text. + CALL IS_ALPHA ; Load A with char in (HL) and check it is a letter + RET C + SUB $41 + LD B,A + RST CHRGTB ; Gets next character (or token) from BASIC text. +__FOR_28: + LD A,B + SUB C + RET C + INC A + EX (SP),HL + LD HL,$FAED + LD B,$00 + ADD HL,BC +DEFVAL_1: + LD (HL),E + INC HL + DEC A + JP NZ,DEFVAL_1 + POP HL + LD A,(HL) + CP ',' + RET NZ + RST CHRGTB ; Gets next character (or token) from BASIC text. + JP DEFVAL + +; This entry point is used by the routine at SCPTLP. +GET_POSINT: + RST CHRGTB ; Gets next character (or token) from BASIC text. +; This entry point is used by the routine at CHKSTK. +__FOR_31: + CALL FPSINT_0 + RET P +; This entry point is used by the routines at __DATA, MAKINT, GETWORD, GSTRDE, +; TOPOOL, MIDNUM, __LOG, CHKSTK, SCPTLP and GET_DEVICE. +FCERR: + LD E,$05 + JP ERROR +; This entry point is used by the routines at SNERR and GETWORD. +__FOR_33: + LD A,(HL) + CP '.' + EX DE,HL + LD HL,(DOT) + EX DE,HL + JP Z,_CHRGTB + +; This entry point is used by the routines at SNERR, TOKEN_BUILT, __DATA, +; GETWORD and CHKSTK. +; Get specified line number +; ASCII to Integer, result in DE +LNUM_PARM_0: + DEC HL +; This entry point is used by the routine at __DATA. +LNUM_PARM_1:: + RST CHRGTB ; Gets next character (or token) from BASIC text. + CP $0E ; Line number prefix + JP Z,__FOR_36 + CP $0D +; This entry point is used by the routine at GETWORD. +__FOR_36: + EX DE,HL + LD HL,(CONLO) + EX DE,HL + JP Z,_CHRGTB + XOR A + LD (CONSAV),A + LD DE,$0000 + DEC HL +__FOR_37: + RST CHRGTB ; Gets next character (or token) from BASIC text. + RET NC + PUSH HL + PUSH AF + LD HL,$1998 + RST CPDEHL + JP C,__FOR_38 + LD H,D + LD L,E + ADD HL,DE + ADD HL,HL + ADD HL,DE + ADD HL,HL + POP AF + SUB $30 + LD E,A + LD D,$00 + ADD HL,DE + EX DE,HL + POP HL + JP __FOR_37 +__FOR_38: + POP AF + POP HL + RET + +__RUN: + JP Z,RUN_FST + CP $0E ; Line number prefix + JP Z,__RUN_0 + CP $0D ; CR + JP NZ,_LOAD +__RUN_0: + CALL _CLVAR + LD BC,EXEC_EVAL_0 + JP GO_TO + +__GOSUB: + LD C,$03 + CALL CHKSTK + CALL LNUM_PARM_0 + POP BC + PUSH HL + PUSH HL + LD HL,(CURLIN) + EX (SP),HL + LD BC,$0000 + PUSH BC + LD BC,EXEC_EVAL_0 + LD A,$8D + PUSH AF + INC SP + PUSH BC + JP __GO_TO_0 +; This entry point is used by the routine at CHKSTK. +__FOR_40: + PUSH HL + PUSH HL + LD HL,(CURLIN) + EX (SP),HL + PUSH BC + LD A,$8D + PUSH AF + INC SP + EX DE,HL + DEC HL + LD (SAVTXT),HL + INC HL + JP EXEC_EVAL_0_1 + +GO_TO: + PUSH BC +; This entry point is used by the routines at ULERR and __DATA. +__GO TO: + CALL LNUM_PARM_0 +; This entry point is used by the routine at __DATA. +__GO_TO_0: + LD A,(CONSAV) + CP $0D + EX DE,HL + RET Z + CP $0E ; Line number prefix + JP NZ,SNERR + EX DE,HL + PUSH HL + LD HL,(CONTXT) + EX (SP),HL + CALL __DATA+2 ; 'Move to next line' (used by ELSE, REM..) + INC HL + PUSH HL + LD HL,(CURLIN) + RST CPDEHL + POP HL + CALL C,FIND_LINE_FHL + CALL NC,FIRST_LNUM ; Get first line number + JP NC,ULERR ; Error: "Undefined line number" + DEC BC + LD A,$0D + LD (PTRFLG),A + POP HL + CALL GETWORD_18 + LD H,B + LD L,C + RET + +; entry for '?UL ERROR' +; +; Used by the routines at SNERR, __FOR, __DATA and CHKSTK. +ULERR: + LD E,$08 + JP ERROR + +__RETURN: + LD (TEMP),HL + LD D,$FF + CALL NEXT_UNSTACK ; search FOR block on stack (skip 2 words) + CP $8D + JP Z,ULERR ; Error: "Undefined line number"_0 + DEC HL +ULERR_0: + LD SP,HL + LD (SAVSTK),HL + LD E,$03 ; Err $03 - RETURN without GOSUB + JP NZ,ERROR + + POP HL + LD A,H + OR L + JP Z,ULERR ; Error: "Undefined line number"_1 + LD A,(HL) + AND $01 + CALL NZ,TIME_S_STOP_1 +ULERR_1: + POP BC + LD HL,EXEC_EVAL_0 + EX (SP),HL + EX DE,HL + LD HL,(TEMP) + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + JP NZ,__GO TO + + LD H,B + LD L,C + LD (CURLIN),HL + EX DE,HL + + DEFB $3E ; "LD A,n" to Mask the next byte + + POP HL + +; DATA statement: find next DATA program line.. +; +; Used by the routines at __FOR and FDTLP. +__DATA: + LD BC,$0E3A ; Put ':' in C, $0E in B + +; Used by 'REM', 'ELSE' and error handling code. +; __DATA+2: +; LD C,0 ; Put $00 in C + + NOP + LD B,$00 +__DATA_0: + LD A,C + LD C,B + LD B,A +__DATA_1: + DEC HL +__DATA_2: + RST CHRGTB ; Gets next character (or token) from BASIC text. + OR A + RET Z + CP B + RET Z + INC HL + CP '"' + JP Z,__DATA_0 + INC A + JP Z,__DATA_2 + SUB $8C + JP NZ,__DATA_1 + CP B + ADC A,D + LD D,A + JP __DATA_1 + POP AF + ADD A,$03 + JP __DATA_3 + +; This entry point is used by the routine at __FOR. +__LET: + CALL GETVAR + RST SYNCHR ; Check syntax: next byte holds the byte to be found + POP AF + EX DE,HL + LD (TEMP),HL + EX DE,HL + PUSH DE + LD A,(VALTYP) + PUSH AF + CALL EVAL + POP AF +__DATA_3: + EX (SP),HL +__DATA_4: + LD B,A + LD A,(VALTYP) + CP B + LD A,B + JP Z,__DATA_5 + CALL OPRND_3_05 + LD A,(VALTYP) +__DATA_5: + LD DE,DBL_FPREG + CP $05 + JP C,__DATA_6 + LD DE,$FB24 +__DATA_6: + PUSH HL + CP $03 ; String ? + JP NZ,LETNUM + LD HL,(DBL_FPREG) ; Pointer to string entry + PUSH HL ; Save it on stack + INC HL ; Skip over length + LD E,(HL) ; LSB of string address + INC HL + LD D,(HL) ; MSB of string address + LD HL,BUFFER + RST CPDEHL ; Compare HL with DE.. is string before program? + JP C,$0D10 + LD HL,(ARREND) + RST CPDEHL ; Compare HL with DE.. is string literal in program? + POP DE + JP NC,MVSTPT ; Yes - Set up pointer + LD HL,VARIABLES+15 ; .. on MSX it is = VARIABLES+14 + RST CPDEHL + JP C,__DATA_7 + LD HL,VARIABLES-15 ; .. on MSX it is = VARIABLES-16 + RST CPDEHL + JP C,MVSTPT + +__DATA_7: + ;LD A,$D1 + DEFB $3E ; "LD A,n" to Mask the next byte + POP DE + CALL BAKTMP + EX DE,HL + CALL SAVSTR_0 +MVSTPT: + CALL BAKTMP + EX (SP),HL +LETNUM: + CALL FP2HL + POP DE + POP HL + RET + + +__ON: + CP $A6 ; TK_ERROR + JP NZ,ON_OTHER + +ON_ERROR: + RST CHRGTB ; Gets next character (or token) from BASIC text. + RST SYNCHR ; Check syntax: next byte holds the byte to be found + ADC A,C ; DEFB TK_GOTO + + CALL LNUM_PARM_0 + LD A,D + OR E + JP Z,__ON_0 + CALL PHL_FIND_LINE ; Sink HL in stack and get first line number + LD D,B + LD E,C + POP HL + JP NC,ULERR ; Error: "Undefined line number" +__ON_0: + EX DE,HL + LD (ONELIN),HL + EX DE,HL + RET C + LD A,(ONEFLG) ; =1 if executing an error trap routine + OR A + LD A,E + RET Z + LD A,(ERR_CODE) + LD E,A + JP ERROR_2 + +ON_OTHER: + CALL ONGO + JP C,__DATA_14 + PUSH BC + RST CHRGTB ; Gets next character (or token) from BASIC text. + RST SYNCHR ; Check syntax: next byte holds the byte to be found + ADC A,L + XOR A +__DATA_12: + POP BC + PUSH BC + CP C + JP NC,SNERR + PUSH AF + CALL LNUM_PARM_0 + LD A,D + OR E + JP Z,__DATA_13 + CALL PHL_FIND_LINE + LD D,B + LD E,C + POP HL + JP NC,ULERR ; Error: "Undefined line number" + +__DATA_13: + POP AF + POP BC + PUSH AF + ADD A,B + PUSH BC + CALL GETWORD_127 + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + POP BC + POP DE + RET Z + PUSH BC + PUSH DE + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + POP AF + INC A + JP __DATA_12 + +__DATA_14: + CALL GETINT + LD A,(HL) + LD B,A + CP $8D ; TK_GOSUB + JP Z,__DATA_15 + RST SYNCHR ; Check syntax: next byte holds the byte to be found + ADC A,C ; DEFB TK_GOTO + DEC HL + +__DATA_15: + LD C,E +__DATA_16: + DEC C + LD A,B + JP Z,__FOR_10 + CALL LNUM_PARM_1: + CP ',' + RET NZ + JP __DATA_16 + +__RESUME: + LD A,(ONEFLG) + OR A + JP NZ,__DATA_17 + LD (ONELIN),A + LD ($FAD9),A + JP $057A +__DATA_17: + INC A + LD (ERR_CODE),A + LD A,(HL) + CP $83 + JP Z,__DATA_18 + CALL LNUM_PARM_0 + RET NZ + LD A,D + OR E + JP Z,__DATA_19 + CALL __GO_TO_0 + XOR A + LD (ONEFLG),A + RET + +__DATA_18: + RST CHRGTB ; Gets next character (or token) from BASIC text. + RET NZ + JP __DATA_20 + +__DATA_19: + XOR A + LD (ONEFLG),A + INC A +__DATA_20: + LD HL,(ERRTXT) + EX DE,HL + LD HL,(ERRLIN) + LD (CURLIN),HL + EX DE,HL + RET NZ + LD A,(HL) + OR A + JP NZ,__DATA_21 + INC HL + INC HL + INC HL + INC HL +__DATA_21: + INC HL + XOR A + LD (ONEFLG),A + JP __DATA +__ERROR: + CALL GETINT + RET NZ + OR A + JP Z,FCERR + JP ERROR + +__IF: + CALL EVAL + LD A,(HL) + CP ',' + CALL Z,_CHRGTB + CP $89 ; TK_GOTO + JP Z,__DATA_22 + RST SYNCHR ; Check syntax: next byte holds the byte to be found + RET C ; TK_THEN + DEC HL +__DATA_22: + PUSH HL + CALL _TSTSGN + POP HL + JP Z,__DATA_24 +__DATA_23: + RST CHRGTB ; Gets next character (or token) from BASIC text. + RET Z + CP $0E ; Line number prefix + JP Z,__GO TO + CP $0D ; + JP NZ,__FOR_10 + LD HL,(CONLO) + RET + +__DATA_24: + LD D,$01 +__DATA_25: + CALL __DATA + OR A + RET Z + RST CHRGTB ; Gets next character (or token) from BASIC text. + CP $A1 ; TK_ELSE + JP NZ,__DATA_25 + DEC D + JP NZ,__DATA_25 + JP __DATA_23 + +__LPRINT: + LD A,$01 + LD (PRTFLG),A + JP __DATA_26 + +__PRINT: + LD C,$02 + CALL SCPTLP_102 +__DATA_26: + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + CALL Z,OUTDO_CRLF +__DATA_27: + JP Z,FINPRT + CP $E2 ; TK_USING + JP Z,USING + CP $D9 ; TK_TAB( + JP Z,__DATA_36 + PUSH HL + CP ',' ; TAB( + JP Z,__DATA_32 + CP ';' + JP Z,__DATA_41 + POP BC + CALL EVAL + PUSH HL + RST GETYPR ; Get the number type (FAC) + JP Z,__DATA_31 + CALL FOUT + CALL CRTST + LD (HL),' ' + LD HL,(DBL_FPREG) + INC (HL) + CALL ISFLIO + JP NZ,__DATA_30 + LD HL,(DBL_FPREG) + LD A,(PRTFLG) + OR A + JP Z,__DATA_28 + LD A,(LPT_POS) + ADD A,(HL) + CP $FF + JP __DATA_29 +__DATA_28: + LD A,(ACTV_Y) + LD B,A + INC A + JP Z,__DATA_30 + LD A,(TTYPOS) + ADD A,(HL) + DEC A + CP B +__DATA_29: + JP C,__DATA_30 + CALL Z,SCPTLP_46 + CALL NZ,OUTDO_CRLF +__DATA_30: + CALL PRS1 + OR A +__DATA_31: + CALL Z,PRS1 + POP HL + JP __DATA_26 + +; TAB( +__DATA_32: + LD BC,$0008 + LD HL,(PTRFIL) + ADD HL,BC + CALL ISFLIO + LD A,(HL) + JP NZ,__DATA_35 + LD A,(PRTFLG) + OR A + JP Z,__DATA_33 + LD A,(LPT_POS) + CP $EE + JP __DATA_34 + +__DATA_33: + LD A,(CLMLST) + LD B,A + LD A,(TTYPOS) + CP B +__DATA_34: + CALL NC,OUTDO_CRLF + JP NC,__DATA_41 +__DATA_35: + SUB $0E + JP NC,__DATA_35 + CPL + JP __DATA_39 + +__DATA_36: + CALL FNDNUM + RST SYNCHR ; Check syntax: next byte holds the byte to be found + ADD HL,HL + DEC HL + PUSH HL + JP Z,__DATA_38 + LD BC,SYNCHR + LD HL,(PTRFIL) + ADD HL,BC + CALL ISFLIO + LD A,(HL) + JP NZ,__DATA_38 + LD A,(PRTFLG) + OR A + JP Z,__DATA_37 + LD A,(LPT_POS) + JP __DATA_38 + +__DATA_37: + LD A,(TTYPOS) +__DATA_38: + CPL + ADD A,E + JP NC,__DATA_41 +__DATA_39: + INC A + LD B,A + LD A,' ' +__DATA_40: + RST OUTC + DEC B + JP NZ,__DATA_40 + +__DATA_41: + POP HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + JP __DATA_27 + +; This entry point is used by the routines at CHKSTK and SCPTLP. +FINPRT: + XOR A + LD (PRTFLG),A + PUSH HL + LD H,A + LD L,A + LD (PTRFIL),HL ; Redirect I/O + POP HL + RET + +__LINE: + CP $85 + JP NZ,GETWORD_140 + RST CHRGTB ; Gets next character (or token) from BASIC text. + CP '#' + JP Z,SCPTLP_106 + CALL __DATA_45 + CALL GETVAR + CALL TSTSTR + PUSH DE + PUSH HL + CALL _INLIN + POP DE + POP BC + JP C,$4103 + PUSH BC + PUSH DE + LD B,$00 + CALL QTSTR_0 + POP HL + LD A,$03 + JP __DATA_3 + CCF + LD D,D + LD H,L + LD H,H + LD L,A + JR NZ,$0FCA + LD (HL),D + LD L,A + LD L,L + JR NZ,$0FDC + LD (HL),H + LD H,C + LD (HL),D + LD (HL),H + DEC C + LD A,(BC) + NOP + +__DATA_43: + LD A,(FLGINP) + OR A + JP NZ,DATSNR + POP BC + LD HL,$0F5D + CALL PRS + LD HL,(SAVTXT) + RET + +__DATA_44: + CALL SCPTLP_101 + PUSH HL + LD HL,BUFMIN + JP __DATA_46 + +__TANUT: + CP '#' + JP Z,__DATA_44 + LD BC,$0FA5 + PUSH BC +__DATA_45: + CP '"' + LD A,$00 + RET NZ + CALL QTSTR + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEC SP + PUSH HL + CALL PRS1 + POP HL + RET + + PUSH HL + CALL QINLIN ; User interaction with question mark, HL = resulting text + POP BC + JP C,$4103 + INC HL + LD A,(HL) + OR A + DEC HL + PUSH BC + JP Z,$0C8B +__DATA_46: + LD (HL),$2C + JP L0FBF + +__READ: + PUSH HL + LD HL,(DATPTR) + + defb $f6 ; OR $AF + +; Routine at 3294 +; +; Used by the routine at L0CC4. +L0FBF: + XOR A + LD (FLGINP),A + EX (SP),HL + JP __DATA_48 + +__DATA_47: + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' +__DATA_48: + CALL GETVAR + EX (SP),HL + PUSH DE + LD A,(HL) + CP ',' + JP Z,__DATA_49 + LD A,(FLGINP) + OR A + JP NZ,FDTLP + LD A,$3F + RST OUTC + CALL QINLIN ; User interaction with question mark, HL = resulting text + POP DE + POP BC + JP C,$4103 + INC HL + LD A,(HL) + DEC HL + OR A + PUSH BC + JP Z,$0C8B + PUSH DE +; This entry point is used by the routine at FDTLP. +__DATA_49: + CALL ISFLIO + JP NZ,SCPTLP_105 + RST GETYPR ; Get the number type (FAC) + PUSH AF + JP NZ,__DATA_52 + RST CHRGTB ; Gets next character (or token) from BASIC text. + LD D,A + LD B,A + CP '"' + JP Z,__DATA_51 + LD A,(FLGINP) + OR A + LD D,A + JP Z,__DATA_50 + LD D,$3A +__DATA_50: + LD B,$2C + DEC HL +__DATA_51: + CALL DTSTR + POP AF + ADD A,$03 + EX DE,HL + LD HL,$102B + EX (SP),HL + PUSH DE + JP __DATA_4 +__DATA_52: + RST CHRGTB ; Gets next character (or token) from BASIC text. + POP AF + PUSH AF + LD BC,$1012 + PUSH BC + JP C,DBL_ASCTFP + JP DBL_DBL_ASCTFP + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + JP Z,__DATA_53 + CP ',' + JP NZ,__DATA_43 +__DATA_53: + EX (SP),HL + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + JP NZ,__DATA_47 + POP DE + LD A,(FLGINP) + OR A + EX DE,HL + JP NZ,RUN_FST7 + PUSH DE + CALL ISFLIO + JP NZ,__DATA_54 + LD A,(HL) + OR A + LD HL,$1057 + CALL NZ,PRS +__DATA_54: + POP HL + JP FINPRT + CCF + LD B,L + LD A,B + LD (HL),H + LD (HL),D + LD H,C + JR NZ,EVAL_04_1 + LD H,A + LD L,(HL) + LD L,A + LD (HL),D + LD H,L + LD H,H + DEC C + LD A,(BC) + NOP + +; Find next DATA statement +; +; Used by the routine at __DATA. +FDTLP: + CALL __DATA + OR A + JP NZ,FDTLP_0 + INC HL + LD A,(HL) + INC HL + OR (HL) + LD E,$04 + JP Z,ERROR + INC HL + LD E,(HL) + INC HL + LD D,(HL) + EX DE,HL + LD (DATLIN),HL + EX DE,HL +FDTLP_0: + RST CHRGTB ; Gets next character (or token) from BASIC text. + CP $84 + JP NZ,FDTLP + JP __DATA_49 + RST SYNCHR ; Check syntax: next byte holds the byte to be found + POP AF + JP EVAL + +; Chk Syntax, make sure '(' follows +; +; Used by the routines at OPRND, UCASE and MIDNUM. +OPNPAR: + RST SYNCHR ; Check syntax: next byte holds the byte to be found + JR Z,$10BD + +EVAL: + DEC HL + +; (a.k.a. GETNUM, EVAL_0uate expression (GETNUM) +; +; Used by the routines at __FOR and SCPTLP. +EVAL_0: + LD D,$00 +; This entry point is used by the routines at EVAL_04, OPRND and UCASE. +EVAL1: + PUSH DE + +; Save precedence and EVAL_0 until precedence break +EVAL2: + LD C,$01 + CALL CHKSTK + CALL OPRND + LD (TEMP2),HL +; This entry point is used by the routine at UCASE. +EVAL_03: + LD HL,(TEMP2) + +; EVAL_0uate expression until precedence break +EVAL_04: + POP BC + LD A,(HL) + LD (TEMP3),HL + CP $F0 ; TK_GREATER ; Token for '>' + RET C + CP $F3 ; TK_PLUS, '+' + JP C,EVAL_04_5 + SUB $F3 + LD E,A + JP NZ,EVAL_04_0 + LD A,(VALTYP) + CP $03 + LD A,E + JP Z,CONCAT +EVAL_04_0: + CP $0C + RET NC + LD HL,PRITAB + LD D,$00 + ADD HL,DE +; This entry point is used by the routine at __DATA. +EVAL_04_1: + LD A,B + LD D,(HL) + CP D + RET NC + PUSH BC + LD BC,EVAL_03 + PUSH BC + LD A,D + CP $7F ; BS + JP Z,EVAL_04_7 + CP $51 + JP C,EVAL_04_8 + AND $FE + CP $7A + JP Z,EVAL_04_8 +EVAL_04_2: + LD HL,DBL_FPREG + LD A,(VALTYP) + SUB $03 + JP Z,TMERR + OR A + LD C,(HL) + INC HL + LD B,(HL) + PUSH BC + JP M,EVAL_04_3 + INC HL + LD C,(HL) + INC HL + LD B,(HL) + PUSH BC + JP PO,EVAL_04_3 + LD HL,$FB24 + LD C,(HL) + INC HL + LD B,(HL) + INC HL + PUSH BC + LD C,(HL) + INC HL + LD B,(HL) + PUSH BC +EVAL_04_3: + ADD A,$03 + LD C,E + LD B,A + PUSH BC + LD BC,$116A +EVAL_04_4: + PUSH BC + LD HL,(TEMP3) + JP EVAL1 + +EVAL_04_5: + LD D,$00 +EVAL_04_6: + SUB $F0 + JP C,NO_COMPARE_TK + CP $03 + JP NC,NO_COMPARE_TK + CP $01 + RLA + XOR D + CP D + LD D,A + JP C,SNERR + LD (TEMP3),HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + JP EVAL_04_6 + +EVAL_04_7: + CALL __CSNG + CALL STAKI + LD BC,POWER + LD D,$7F + JP EVAL_04_4 + +EVAL_04_8: + PUSH DE + CALL __CINT + POP DE + PUSH HL + LD BC,L1341 + JP EVAL_04_4 + +NO_COMPARE_TK: + LD A,B + CP $64 + RET NC + PUSH BC + PUSH DE + LD DE,$6405 ; const value + LD HL,L1316 + PUSH HL + RST GETYPR ; Get the number type (FAC) + JP NZ,EVAL_04_2 ; JP if not string type + LD HL,(DBL_FPREG) + PUSH HL + LD BC,EVAL_STR + JP EVAL_04_4 + + POP BC + LD A,C + LD (OPRTYP),A + LD A,(VALTYP) + CP B ; is type specified in 'B' different ? + JP NZ,EVAL_04_10 + CP $02 + JP Z,EVAL_04_11 + CP $04 + JP Z,EVAL_04_19 + JP NC,EVAL_04_13 +EVAL_04_10: + LD D,A + LD A,B + CP $08 ; Double precision ? + JP Z,EVAL_04_12 + LD A,D + CP $08 ; Double precision ? + JP Z,EVAL_04_17 + LD A,B + CP $04 ; Single precision ? + JP Z,EVAL_04_18 + LD A,D + CP $03 ; String ? + JP Z,TMERR ; "Type mismatch" + JP NC,EVAL_04_21 +EVAL_04_11: + LD HL,INT_OPR + LD B,$00 + ADD HL,BC + ADD HL,BC + LD C,(HL) + INC HL + LD B,(HL) + POP DE + LD HL,(DBL_FPREG) + PUSH BC + RET + +EVAL_04_12: + CALL __CDBL +EVAL_04_13: + CALL FP_ARG2HL + POP HL + LD ($FB26),HL + POP HL + LD ($FB24),HL +EVAL_04_14: + POP BC + POP DE + CALL FPBCDE +EVAL_04_15: + CALL __CDBL + LD HL,DEC_OPR +EVAL_04_16: + LD A,(OPRTYP) + RLCA + ADD A,L + LD L,A + ADC A,H + SUB L + LD H,A + LD A,(HL) + INC HL + LD H,(HL) + LD L,A + JP (HL) +EVAL_04_17: + LD A,B + PUSH AF + CALL FP_ARG2HL + POP AF + LD (VALTYP),A + CP $04 + JP Z,EVAL_04_14 + POP HL + LD (DBL_FPREG),HL + JP EVAL_04_15 + +EVAL_04_18: + CALL __CSNG +EVAL_04_19: + POP BC + POP DE +EVAL_04_20: + LD HL,FLT_OPR + JP EVAL_04_16 +EVAL_04_21: + POP HL + CALL STAKI + CALL HL_CSNG + CALL BCDEFP + POP HL + LD (LAST_FPREG),HL + POP HL + LD (DBL_FPREG),HL + JP EVAL_04_20 + +; Routine at 4619 +IDIV: + PUSH HL + EX DE,HL + CALL HL_CSNG + POP HL + CALL STAKI + CALL HL_CSNG + JP DIV + +; Get next expression value +; +; Used by the routines at EVAL1 and CONCAT. +OPRND: + CALL TEL_TERM_003 + RST CHRGTB ; Gets next character (or token) from BASIC text. + JP Z,$0580 ; OPERAND_ERR (OPRND) + JP C,DBL_ASCTFP + CALL IS_ALPHA_A + JP NC,VAR_EVAL_0 + CP ' ' + JP C,__FOR_18 + INC A + JP Z,OPRND_SUB + DEC A + CP $F3 ; TK_PLUS, '+' + JP Z,OPRND + CP $F4 ; TK_MINUS, '-' + JP Z,OPRND_SUB + CP '"' + JP Z,QTSTR + CP $DE + JP Z,NOT + CP $E0 ; Token for ERR (TK_ERR ?) + JP NZ,OPRND_0 + RST CHRGTB ; Gets next character (or token) from BASIC text. + LD A,(ERR_CODE) + PUSH HL + CALL UNSIGNED_RESULT_A + POP HL + RET + +OPRND_0: + CP $DF ; TK_ERL + JP NZ,OPRND_1 + +__ERL: + RST CHRGTB ; Gets next character (or token) from BASIC text. + PUSH HL + LD HL,(ERRLIN) + CALL DBL_ABS_0 + POP HL + RET + +OPRND_1: + CP $EA ; TK_TIME + JP Z,FN_TIME + CP $EB ; TK_DATE + JP Z,FN_DATE + CP $EE ; TK_STATUS + JP Z,FN_STATUS + CP $E3 ; TK_INSTR + JP Z,FN_INSTR + CP $E9 ; TK_INKEY_S + JP Z,FN_INKEY + CP $E1 + JP Z,TOPOOL_0 + CP $85 + JP Z,SCPTLP_88 + CP $E6 + JP Z,GETWORD_147 + CP $E8 + JP Z,USING5 + +; This entry point is used by the routine at UCASE. +OPRND_2: + CALL OPNPAR + RST SYNCHR ; Check syntax: next byte holds the byte to be found + ADD HL,HL + RET + +OPRND_SUB: + LD D,$7D + CALL EVAL1 + LD HL,(TEMP2) ; NXTOPR, Next operator in EVAL_0 + PUSH HL + CALL INVSGN + +; Routine at 4773 +_POPHLRT: + POP HL + RET + +VAR_EVAL_0: + CALL GETVAR + PUSH HL + EX DE,HL + LD (DBL_FPREG),HL + RST GETYPR ; Get the number type (FAC) + CALL NZ,FP_HL2DE ; CALL if not string type + POP HL + RET + +; Get char from (HL) and make upper case +; +; Used by the routines at SNERR, TOKEN_BUILT, GETWORD, SCPTLP and GET_DEVICE. +UCASE_HL: + LD A,(HL) + +; Make char in 'A' upper case +; +; Used by the routine at GET_DEVICE. +UCASE: + CP $61 + RET C + CP $7B + RET NC + AND $5F + RET +; This entry point is used by the routine at OPRND. +OPRND_SUB: + INC HL + LD A,(HL) + SUB $81 + LD B,$00 + RLCA + LD C,A + PUSH BC + RST CHRGTB ; Gets next character (or token) from BASIC text. + LD A,C + CP $05 + JP NC,OPRND_3_0 + CALL OPNPAR + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + CALL TSTSTR + EX DE,HL + LD HL,(DBL_FPREG) + EX (SP),HL + PUSH HL + EX DE,HL + CALL GETINT + EX DE,HL + EX (SP),HL + JP UCASE_3 + +OPRND_3_0: + CALL OPRND_2 + EX (SP),HL + LD A,L + CP $0C + JP C,OPRND_3_1 + CP $1B + PUSH HL + CALL C,__CSNG + POP HL +OPRND_3_1: + LD DE,_POPHLRT ; (POP HL / RET) + PUSH DE +UCASE_3: + LD B,H + LD C,L + LD HL,(FNCTAB_FN) ; FNCTAB_FN +UCASE_4: + ADD HL,BC + LD C,(HL) + INC HL + LD H,(HL) + LD L,C + JP (HL) + +; This entry point is used by the routine at _DBL_ASCTFP. +UCASE_5: + DEC D + CP $F4 ; TK_MINUS, '-' + RET Z + CP '-' + RET Z + INC D + CP '+' + RET Z + CP $F3 ; TK_PLUS, '+' + RET Z + +DCXH: + DEC HL + RET + +L1316: + INC A + ADC A,A + POP BC + AND B + ADD A,$FF + SBC A,A + CALL INT_RESULT_A + JP NOT_0 + +; This entry point is used by the routine at OPRND. +NOT: + LD D,$5A + CALL EVAL1 + CALL __CINT + LD A,L + CPL + LD L,A + LD A,H + CPL + LD H,A + LD (DBL_FPREG),HL + POP BC +NOT_0: + JP EVAL_03 + +; This entry point is used by the routine at GETYPR. +__GETYPR: + LD A,(VALTYP) + CP $08 + DEC A + DEC A + DEC A + RET + +L1341: + LD A,B + PUSH AF + CALL __CINT + POP AF + POP DE + + CP $7A ; MOD as mapped in PRITAB + JP Z,IMOD + + CP $7B ; '\' as mapped in PRITAB + JP Z,INT_DIV + + LD BC,BOOL_RESULT + PUSH BC + CP $46 ; OR as mapped in PRITAB + JP NZ,SKIP_OR + +OR: + LD A,E + OR L + LD L,A + LD A,H + OR D + RET + +SKIP_OR: + CP $50 ; AND as mapped in PRITAB + JP NZ,SKIP_AND + +AND: + LD A,E + AND L + LD L,A + LD A,H + AND D + RET + +SKIP_AND: + CP $3C ; XOR as mapped in PRITAB + JP NZ,SKIP_XOR + +XOR: + LD A,E + XOR L + LD L,A + LD A,H + XOR D + RET + +SKIP_XOR: + CP $32 ; EQU (=) as mapped in PRITAB + JP NZ,IMP + +EQV: + LD A,E + XOR L + CPL + LD L,A + LD A,H + XOR D + CPL + RET + +IMP: + LD A,L + CPL + AND E + CPL + LD L,A + LD A,H + CPL + AND D + CPL + RET + +; This entry point is used by the routine at MIDNUM. +IMP: + LD A,L + SUB E + LD L,A + LD A,H + SBC A,D + LD H,A + JP DBL_ABS_0 + +__LPOS: + LD A,(LPT_POS) + JP UNSIGNED_RESULT_A + +__POS: + LD A,(TTYPOS) +; This entry point is used by the routines at OPRND, MAKINT and TOPOOL. +UNSIGNED_RESULT_A: + LD L,A + XOR A + +BOOL_RESULT: + LD H,A + JP INT_RESULT_HL + +; This entry point is used by the routine at __DATA. +OPRND_3_05: + PUSH HL + AND $07 + LD HL,TYPE_OPR + LD C,A + LD B,$00 + ADD HL,BC + CALL UCASE_4 + POP HL + RET + +__INP: + CALL MAKINT + LD (INPORT),A + CALL TEL_TERM_013 + JP UNSIGNED_RESULT_A + +__OUT: + CALL GTIO_PARMS ; Get "WORD,BYTE" paramenters + JP TEL_TERM_011 + +; Get subscript +; +; Used by the routine at __FOR. +FPSINT: + RST CHRGTB ; Gets next character (or token) from BASIC text. +; This entry point is used by the routine at __FOR. +FPSINT_0: + CALL EVAL + +; Get integer variable to DE, error if negative +; +; Used by the routine at MAKINT. +DEPINT: + PUSH HL + CALL __CINT + EX DE,HL + POP HL + LD A,D + OR A + RET + +; This entry point is used by the routine at UCASE. +GTIO_PARMS: + CALL GETINT + LD (INPORT),A + LD (OTPORT),A + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + JP GETINT + +; Load 'A' with the next number in BASIC program +; +; Used by the routines at __DATA and SCPTLP. +FNDNUM: + RST CHRGTB ; Gets next character (or token) from BASIC text. + +; Get a number to 'A' +; +; Used by the routines at __DATA, UCASE, DEPINT, MAKINT, GETWORD, TOPOOL, +; SCPTLP and GET_DEVICE. +GETINT: + CALL EVAL + +; Convert tmp string to int in A register +; +; Used by the routines at UCASE, GSTRDE, TOPOOL, MIDNUM and SCPTLP. +MAKINT: + CALL DEPINT + JP NZ,FCERR + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + LD A,E + RET + +__LLIST: + LD A,$01 + LD (PRTFLG),A + +; This entry point is used by the routines at SCPTLP and GET_DEVICE. +__LIST: + POP BC + CALL LNUM_RANGE + PUSH BC + LD H,B + LD L,C + LD (LBLIST),HL +MAKINT_0: + LD HL,$FFFF + LD (CURLIN),HL + POP HL + LD (LBEDIT),HL + POP DE + LD C,(HL) + INC HL + LD B,(HL) + INC HL + LD A,B + OR C + JP Z,MAKINT_3 + LD A,(MENU_FLG) + AND A + CALL Z,ISFLIO + CALL Z,CHSNS_0 + PUSH BC + LD C,(HL) + INC HL + LD B,(HL) + INC HL + PUSH BC + EX (SP),HL + EX DE,HL + RST CPDEHL + POP BC + JP C,MAKINT_2 + EX (SP),HL + PUSH HL + PUSH BC + EX DE,HL + LD (DOT),HL + CALL NUMPRT + POP HL + LD A,(HL) + CP $09 + JP Z,MAKINT_1 + LD A,' ' + RST OUTC +MAKINT_1: + CALL DETOKEN_LIST + LD HL,INPBFR ; M100 uses KBUF directly + CALL MAKINT_4 + CALL OUTDO_CRLF + JP MAKINT_0 + +MAKINT_2: + POP BC +MAKINT_3: + LD A,(ERRTRP-1) + AND A + JP NZ,__EDIT_1 + LD A,$1A + RST OUTC + LD A,(MENU_FLG) + AND A + JP NZ,GET_DEVICE_100 + JP READY + +MAKINT_4: + LD A,(HL) + OR A + RET Z + RST OUTC + INC HL + JP MAKINT_4 + +DETOKEN_LIST: + LD BC,INPBFR + LD D,$FF ; init line byte counter in D + XOR A + LD (OPRTYP),A ; a.k.a. DORES, indicates whether stored word can be crunched, etc.. + JP DETOKEN_NEXT_1 + +DETOKEN_NEXT: + INC BC + INC HL + DEC D + RET Z +DETOKEN_NEXT_1: + LD A,(HL) + OR A + LD (BC),A + RET Z + CP $0B + JP C,DETOKEN_NEXT_4 + CP ' ' + JP C,MAKINT_25 + CP '"' + JP NZ,DETOKEN_NEXT_2 + LD A,(OPRTYP) + XOR $01 + LD (OPRTYP),A + LD A,'"' +DETOKEN_NEXT_2: + CP ':' + JP NZ,DETOKEN_NEXT_4 + LD A,(OPRTYP) + RRA + JP C,DETOKEN_NEXT_3 + RLA + AND $FD + LD (OPRTYP),A +DETOKEN_NEXT_3: + LD A,':' +DETOKEN_NEXT_4: + OR A + JP P,DETOKEN_NEXT + LD A,(OPRTYP) + RRA + JP C,_DETOKEN_NEXT + RRA + RRA + JP NC,DETOKEN + LD A,(HL) + CP $E4 ; TK_APOSTROPHE: COMMENT, check if line ends with the apostrophe.. + PUSH HL + PUSH BC + LD HL,__DETOKEN_NEXT + PUSH HL + RET NZ + + ; ..or with the ':REM' sequence.. + DEC BC + LD A,(BC) + CP 'M' + RET NZ + DEC BC + LD A,(BC) + CP 'E' + RET NZ + DEC BC + LD A,(BC) + CP 'R' + RET NZ + DEC BC + LD A,(BC) + CP ':' + RET NZ + POP AF + POP AF + POP HL + INC D ; add 4 to line byte counter D + INC D + INC D + INC D + JP MAKINT_16 + +__DETOKEN_NEXT: + POP BC + POP HL + LD A,(HL) +_DETOKEN_NEXT: + JP DETOKEN_NEXT + +SET_DATA_FLAG: + LD A,(OPRTYP) ; Indicates whether stored word can be crunched + OR $02 +UPD_OPRTYP: + LD (OPRTYP),A + XOR A + RET + +SET_REM_FLAG: + LD A,(OPRTYP) + OR $04 + JP UPD_OPRTYP + +DETOKEN: + RLA + JP C,_DETOKEN_NEXT + LD A,(HL) + CP $84 ; TK_DATA + CALL Z,SET_DATA_FLAG + CP $8F ; TK_REM + CALL Z,SET_REM_FLAG +MAKINT_16: + LD A,(HL) + INC A + LD A,(HL) + JP NZ,MAKINT_17 + INC HL + LD A,(HL) + AND $7F +MAKINT_17: + INC HL + CP $A1 ; TK_ELSE + JP NZ,MAKINT_18 + DEC BC + INC D +MAKINT_18: + PUSH HL + PUSH BC + PUSH DE + LD HL,WORDS-1 + LD B,A + LD C,$40 +DETOKEN_2: + INC C + LD A,C + CP $5C ;'\' + JP NC,DETOKEN_7 +DETOKEN_3: + INC HL + LD D,H + LD E,L +DETOKEN_4: + LD A,(HL) + OR A + JP Z,DETOKEN_2 + INC HL + JP P,DETOKEN_4 + LD A,(HL) + CP B + JP NZ,DETOKEN_3 + EX DE,HL + LD A,C + POP DE + POP BC + CP $5B + JP NZ,DETOKEN_6 +DETOKEN_5: + LD A,(HL) + INC HL +DETOKEN_6: + LD E,A + AND $7F + LD (BC),A + INC BC + DEC D + JP Z,TESTR_0 + OR E + JP P,DETOKEN_5 + POP HL + JP DETOKEN_NEXT_1 + +DETOKEN_7: + POP DE + POP BC + LD HL,$1561 + JP DETOKEN_5 + + + LD HL,($4350) + XOR D +MAKINT_25: + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + PUSH DE + PUSH BC + PUSH AF + CALL __FOR_23 + POP AF + LD HL,(CONLO) + CALL FOUT + POP BC + POP DE + LD A,(CONTYP) + CP $04 + LD E,$00 + JP C,MAKINT_26 + LD E,$21 + JP Z,MAKINT_26 + LD E,$23 +MAKINT_26: + LD A,(HL) + CP ' ' + CALL Z,INCHL +MAKINT_27: + LD A,(HL) + INC HL + OR A + JP Z,MAKINT_30 + LD (BC),A + INC BC + DEC D + RET Z + LD A,(CONTYP) + CP $04 + JP C,MAKINT_27 + DEC BC + LD A,(BC) + INC BC + JP NZ,MAKINT_28 + CP '.' + JP Z,MAKINT_29 +MAKINT_28: + CP 'D' ; 'D' + JP Z,MAKINT_29 + CP 'E' ; 'E' + JP NZ,MAKINT_27 +MAKINT_29: + LD E,$00 + JP MAKINT_27 + +MAKINT_30: + LD A,E + OR A + JP Z,MAKINT_31 + LD (BC),A + INC BC + DEC D + RET Z +MAKINT_31: + LD HL,(CONTXT) + JP DETOKEN_NEXT_1 + +; This entry point is used by the routine at SNERR. +DETOKEN_NEXT5: + EX DE,HL + LD HL,(PROGND) +MAKINT_33: + LD A,(DE) + LD (BC),A + INC BC + INC DE + RST CPDEHL + JP NZ,MAKINT_33 + LD H,B + LD L,C + LD (PROGND),HL + LD (VAREND),HL + LD (ARREND),HL + RET + +__PEEK: + CALL GETWORD_HL + LD A,(HL) + JP UNSIGNED_RESULT_A + +__POKE: + CALL GETWORD + PUSH DE + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + CALL GETINT + POP DE + LD (DE),A + RET + +; Get a number to DE (0..65535) +; +; Used by the routines at MAKINT and CHKSTK. +GETWORD: + CALL EVAL + PUSH HL + CALL GETWORD_HL + EX DE,HL + POP HL + RET + +; This entry point is used by the routine at MAKINT. +GETWORD_HL: + LD BC,__CINT + PUSH BC + RST GETYPR ; Get the number type (FAC) + RET M + LD A,(FACCU) + CP $90 + RET NZ + RST TSTSGN + RET M + CALL __CSNG + LD BC,$9180 + LD DE,$0000 + JP FADD + +__RENUM: + LD BC,$000A + PUSH BC + LD D,B + LD E,B + JP Z,GETWORD_2 + CP ',' + JP Z,GETWORD_1 + PUSH DE + CALL __FOR_33 + LD B,D + LD C,E + POP DE + JP Z,GETWORD_2 + +GETWORD_1: + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + CALL __FOR_33 + JP Z,GETWORD_2 + POP AF + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + PUSH DE + CALL LNUM_PARM_0 + JP NZ,SNERR + LD A,D + OR E + JP Z,FCERR + EX DE,HL + EX (SP),HL + EX DE,HL +GETWORD_2: + PUSH BC + CALL FIRST_LNUM + POP DE + PUSH DE + PUSH BC + CALL FIRST_LNUM + LD H,B + LD L,C + POP DE + RST CPDEHL + EX DE,HL + JP C,FCERR + POP DE + POP BC + POP AF + PUSH HL + PUSH DE + JP GETWORD_4 +GETWORD_3: + ADD HL,BC + JP C,FCERR + EX DE,HL + PUSH HL + LD HL,$FFF9 + RST CPDEHL + POP HL + JP C,FCERR +GETWORD_4: + PUSH DE + LD E,(HL) + INC HL + LD D,(HL) + LD A,D + OR E + EX DE,HL + POP DE + JP Z,GETWORD_5 + LD A,(HL) + INC HL + OR (HL) + DEC HL + EX DE,HL + JP NZ,GETWORD_3 +GETWORD_5: + PUSH BC + CALL $16A7 + POP BC + POP DE + POP HL +GETWORD_6: + PUSH DE + LD E,(HL) + INC HL + LD D,(HL) + LD A,D + OR E + JP Z,GETWORD_7 + EX DE,HL + EX (SP),HL + EX DE,HL + INC HL + LD (HL),E + INC HL + LD (HL),D + EX DE,HL + ADD HL,BC + EX DE,HL + POP HL + JP GETWORD_6 + +GETWORD_7: + LD BC,RESTART + PUSH BC + CP $F6 +; This entry point is used by the routine at GET_DEVICE. +GETPARM_VRFY: + XOR A + LD (PTRFLG),A + LD HL,(BASTXT) + DEC HL +GETWORD_9: + INC HL + LD A,(HL) + INC HL + OR (HL) + RET Z + INC HL + LD E,(HL) + INC HL + LD D,(HL) +GETWORD_10: + RST CHRGTB ; Gets next character (or token) from BASIC text. + +LINE2PTR: + OR A + JP Z,GETWORD_9 + LD C,A + LD A,(PTRFLG) + OR A + LD A,C + JP Z,GETWORD_16 + CP $A6 ; TK_ERROR + JP NZ,GETWORD_12 + RST CHRGTB ; Gets next character (or token) from BASIC text. + CP $89 ; TK_GOTO + + JP NZ,LINE2PTR + RST CHRGTB ; Gets next character (or token) from BASIC text. + CP $0E ; Line number prefix + + JP NZ,LINE2PTR + PUSH DE + CALL __FOR_36 + LD A,D + OR E + JP NZ,GETWORD_13 + JP GETWORD_14 + +GETWORD_12: + CP $0E ; Line number prefix + JP NZ,GETWORD_10 + PUSH DE + CALL __FOR_36 +GETWORD_13: + PUSH HL + CALL FIRST_LNUM + DEC BC + LD A,$0D + JP C,GETWORD_17 + CALL CONSOLE_CRLF + LD HL,$1712 + PUSH DE + CALL PRS + POP HL + CALL NUMPRT + POP BC + POP HL + PUSH HL + PUSH BC + CALL LNUM_MSG + POP HL +GETWORD_14: + POP DE + DEC HL +GETWORD_15: + JP GETWORD_10 + LD D,L + LD L,(HL) + LD H,H + LD H,L + LD H,(HL) + LD L,C + LD L,(HL) + LD H,L + LD H,H + JR NZ,$1789 + LD L,C + LD L,(HL) + LD H,L + JR NZ,GETWORD_16 +GETWORD_16: + CP $0D + JP NZ,GETWORD_15 + PUSH DE + CALL __FOR_36 + PUSH HL + EX DE,HL + INC HL + INC HL + INC HL + LD C,(HL) + INC HL + LD B,(HL) + LD A,$0E +GETWORD_17: + LD HL,$170C + PUSH HL + LD HL,(CONTXT) +; This entry point is used by the routine at __FOR. +GETWORD_18: + PUSH HL + DEC HL + LD (HL),B + DEC HL + LD (HL),C + DEC HL + LD (HL),A + POP HL + RET + +; This entry point is used by the routine at SNERR. +EXEC_HL_FLIO: + LD A,(PTRFLG) + OR A + RET Z + JP GETPARM_VRFY + +; This entry point is used by the routines at ISFLIO, SCPTLP and GET_DEVICE. +CHGET: + PUSH HL + PUSH DE + PUSH BC + CALL GETWORD_21 + JP POPALL_0 +GETWORD_21: + RST $38 + INC B + LD HL,(FNKPNT) + INC H + DEC H + JP Z,GETWORD_24 + LD B,(HL) + INC HL + LD A,(HL) + OR A + JP NZ,GETWORD_22 + LD H,A +GETWORD_22: + LD (FNKPNT),HL + LD A,B + RET + +GETWORD_23: + LD A,(FNK_FLAG) + ADD A,A + RET C + LD HL,$0000 + LD (PASPNT),HL + LD A,$0D + LD ($F98E),A +GETWORD_24: + LD HL,(PASPNT) + LD A,L + AND H + INC A + JP Z,GETWORD_26 + PUSH HL + LD A,($F98E) + CP $0D + CALL Z,RESFPT_0 + LD HL,(HAYASHI) ; Paste buffer file + POP DE + ADD HL,DE + LD A,(HL) + LD ($F98E),A + LD B,A + CP $1A ; EOF + LD A,$00 + JP Z,GETWORD_25 + CALL KEYX + JP C,GETWORD_25 + INC HL + LD A,(HL) + EX DE,HL + INC HL + LD (PASPNT),HL + CP $1A ; EOF + LD A,B + SCF + CCF + RET NZ +GETWORD_25: + LD HL,$FFFF + LD (PASPNT),HL + RET + +GETWORD_26: + CALL CHSNS + JP NZ,GETWORD_28 + CALL BLINK_CURS_SHOW + LD A,$FF + LD (POWR_FLAG),A +GETWORD_27: + CALL CHSNS + JP Z,GETWORD_27 + XOR A + LD (POWR_FLAG),A + CALL BLINK_CURS_HIDE +GETWORD_28: + LD HL,TMOFLG + LD A,(HL) + AND A + JP NZ,POWER_DOWN + CALL GETWORD_131 + CALL __MENU_45 + RET NC + SUB $0A + JP Z,GETWORD_23 + JP NC,INVALID_CH + LD E,A + LD A,(FNK_FLAG) + AND $60 + SCF + LD A,E + RET NZ + LD D,$FF + EX DE,HL + ADD HL,HL + ADD HL,HL + ADD HL,HL + ADD HL,HL + LD DE,$F745 + ADD HL,DE + LD A,(FNK_FLAG) + AND A + JP P,GETWORD_29 + INC HL + INC HL + INC HL + INC HL +GETWORD_29: + LD (FNKPNT),HL + JP GETWORD_21 + +FNBAR_IF_NZ: + JP Z,ERAFNK + JP DSPFNK + +; This entry point is used by the routine at CHGET. +POWER_DOWN: + DI + LD (HL),$00 + LD A,(PWRINT) + DEC HL + LD (HL),A + CALL TURN_OFF + +INVALID_CH: + XOR A + RET + +BLINK_CURS_SHOW: + LD A,(CSR_STATUS) + LD (BLINK),A + AND A + RET NZ + CALL CURSON + JP _ESC_X ; Refresh cursor + +BLINK_CURS_HIDE: + LD A,(BLINK) + AND A + RET NZ + CALL CURSOFF + JP _ESC_X ; Refresh cursor + +; This entry point is used by the routines at SCPTLP and GET_DEVICE. +CHSNS: + LD A,(FNKPNT+1) ; + AND A + RET NZ + LD A,(TMOFLG) + AND A + +; This entry point is used by the routine at GET_DEVICE. +_CHSNS: + RET NZ + PUSH HL + LD HL,(PASPNT) + LD A,L + AND H + INC A + POP HL + RET NZ + RST $38 + DEFB $06 ; HCHSNS, Offset: 06 + + JP KEYX + + +; This entry point is used by the routines at __FOR and MAKINT. +ISCNTC + CALL BRKCHK + RET Z + CP $03 + JP Z,CTL_C + CP $13 + RET NZ + CALL BLINK_CURS_SHOW +ISCNTC_0: + CALL BRKCHK + CP $11 + JP Z,BLINK_CURS_HIDE + CP $03 + JP NZ,ISCNTC_0 + CALL BLINK_CURS_HIDE + +CTL_C: + XOR A + LD (KYBCNT),A + JP __STOP + +; POWER statement +__POWER: + SUB $99 + JP Z,POWER_CONT + CP $4E ; $99+$4E=$E7: TOKEN for "OFF" + JP NZ,POWER_ON + RST CHRGTB ; Gets next character (or token) from BASIC text. + JP Z,TURN_OFF_0 + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + RST SYNCHR ; Check syntax: next byte holds the byte to be found + AND A ; TK_RESUME + JP NZ,SNERR + JP TURN_OFF + +LOW_PWR_EXIT: + POP AF + RET + +; Normal TRAP (low power) interrupt routine +LOW_PWR: + PUSH AF + IN A,($D8) + AND A + JP M,LOW_PWR_EXIT + LD A,(POWR_FLAG) + AND A + LD A,$01 + LD (POWR_FLAG),A + JP NZ,TURN_OFF_0 + POP AF + +; Turn off computer +; +; Used by the routines at FNBAR_TOGGLE and __POWER. +TURN_OFF: + DI + PUSH HL + PUSH DE + PUSH BC + PUSH AF + LD HL,$0000 + ADD HL,SP + LD ($F9AE),HL + LD HL,$9C0B ; POWER ON data marker + LD (ATIDSV),HL +TURN_OFF_0: + DI + CALL GETWORD_131 + IN A,($BA) + OR $10 + OUT ($BA),A + HALT +POWER_CONT: + CALL GETWORD_45 + LD (TMOFLG),A + RST CHRGTB ; Gets next character (or token) from BASIC text. + RET + +POWER_ON: + CALL GETINT + CP $0A + JP C,FCERR +GETWORD_45: + LD (PWRINT),A + LD (TIMINT),A + RET + +; This entry point is used by the routine at SCPTLP. +LPT_OUT: + RST $38 + INC C + CALL PRS_ABORTMSG7 + PUSH AF + CALL GETWORD_131 + POP AF + RET NC + XOR A + LD (LPT_POS),A + JP GETWORD_49 + +; Start tape and load tape header. If an error or Shift Break pressed, +; generate I/O error +; +; Used by the routine at CAS_OPNI_CO. +HEADER: + CALL TEL_TERM_007 + CALL CTON + CALL SYNCR + RET NC +HEADER_0: + CALL CTOFF +GETWORD_49: + LD E,$18 + JP ERROR + +IOOPRND_0: + CALL TEL_TERM_006 + CALL CTON + LD BC,$0000 +GETWORD_51: + DEC BC + LD A,B + OR C + JP NZ,GETWORD_51 + JP __MENU_06 + +CTON: + DI + defb $11 ; LD DE,NN to skip the next 2 bytes +; Cassette motor OFF +; +; Used by the routines at HEADER, CAS_INPUT, __CLOAD, LOAD_RECORD, CLOADM, +; LDIR_B, CAS_OPNO_CO and CAS_OPNI_CO. +CTOFF: + EI + LD E,$00 + JP DATAR_1 + +CASIN: + CALL TEL_TERM_004 + PUSH DE + PUSH HL + PUSH BC + CALL DATAR + JP C,HEADER_0 + LD D,A + POP BC + ADD A,C + LD C,A + LD A,D + POP HL + POP DE + RET + +CSOUT: + CALL TEL_TERM_005 + PUSH HL + PUSH DE + LD D,A + ADD A,C + LD C,A + PUSH BC + LD A,D + CALL DATAW + JP C,HEADER_0 + JP POPALL_0 + + +; LCD Device control block +LCD_CTL: + DEFW LCDLPT_OPN + DEFW _CLOSE + DEFW LCD_OUTPUT + +; LD C,B +; ADD HL,DE +; DEC B +; LD C,A +; LD D,L +; ADD HL,DE + + +; LCD and LPT file open routine +LCDLPT_OPN: + LD A,$02 + CP E + JP NZ,NMERR ; NM error: bad file name + +REDIRECT_IO: + LD (PTRFIL),HL ; Redirect I/O + LD (HL),E + POP AF + POP HL + RET + +; LCD file output routine +LCD_OUTPUT: + POP AF + PUSH AF + CALL OUTC_SUB_0 +LCD_OUTPUT_0: + CALL GETWORD_131 + +; This entry point is used by the routines at ISFLIO and GET_DEVICE. +POPALL: + POP AF +POPALL_0: + POP BC + POP DE + POP HL + RET + + + + +; CRT device control block? +; Data block at 6498 +CRT_CTL: + DEFW CRT_OPN + DEFW _CLOSE + DEFW CRT_OUTPUT + DEFW L1970 + DEFW L1972 + +CRT_OPN: + RST $38 + DEFB $62 + +CRT_OUTPUT: + RST $38 + DEFB $66 + +L1970: + RST $38 + DEFB $68 + +L1972: + RST $38 + DEFB $6a + + +; Data block at 6516 +RAM_CTL: + DEFW RAM_OPN + DEFW RAM_CLS + DEFW RAM_OUTPUT + DEFW RAM_INPUT + DEFW RAM_IO + + + +; RAM Device control block +RAM_CTL: + DEFW RAM_OPN + DEFW RAM_CLS + DEFW RAM_OUTPUT + DEFW RAM_INPUT + DEFW RAM_IO + + +; Data block at 6516 +RAM_CTL: + DEFW L197E + DEFW $1A05 + DEFW $1A24 + DEFW $1A3C + DEFW $1A93 + +; RAM file open routine +RAM_OPN: + PUSH HL + PUSH DE + INC HL + INC HL + PUSH HL + LD A,E + CP $01 + JP Z,GETWORD_62 + CP $08 + JP Z,GETWORD_63 +RAM_OPN_0: + CALL MAKTXT + JP C,GETWORD_65 + PUSH DE + CALL __EOF_3 + POP DE +GETWORD_60: + LD BC,$0000 +GETWORD_61: + POP HL + LD A,(DE) + AND $02 + JP NZ,AOERR + LD A,(DE) + OR $02 + LD (DE),A + INC DE + LD (HL),E + INC HL + LD (HL),D + INC HL + INC HL + INC HL + LD (HL),$00 + INC HL + LD (HL),C + INC HL + LD (HL),B + POP DE + POP HL + JP REDIRECT_IO + +GETWORD_62: + LD A,(ERRTRP-1) + AND A + LD HL,SUZUKI+21 + CALL Z,FINDCO_0 + JP Z,FFERR + EX DE,HL + CALL GET_RAM_PTR + XOR A + LD (HL),A + LD L,A + LD H,A + LD (RAM_FILES),HL + JP GETWORD_60 + +GETWORD_63: + POP HL + POP DE + LD E,$02 + PUSH DE + PUSH HL + CALL RESFPT_0 + CALL FINDCO_0 + JP Z,RAM_OPN_0 + LD E,L + LD D,H + INC HL + LD A,(HL) + INC HL + LD H,(HL) + LD L,A + LD BC,$FFFF +GETWORD_64: + LD A,(HL) + INC HL + INC BC + CP $1A ; EOF + JP NZ,GETWORD_64 + JP GETWORD_61 +GETWORD_65: + LD A,(DE) + AND $02 + JP NZ,AOERR + EX DE,HL + CALL KILLASC+1 + JP RAM_OPN_0 + +; Routine at 6661 +RAM_CLS: + PUSH HL + CALL RAM_CLS_0 + POP HL + CALL CLOSE_DEVICE + CALL NZ,RAM_INPUT_2 + CALL GET_RAM_PTR + LD (HL),$00 + JP _CLOSE + +RAM_CLS_0: + INC HL + INC HL + LD A,(HL) + INC HL + LD H,(HL) + LD L,A + DEC HL + LD A,(HL) + AND $FD + LD (HL),A + RET + +; Routine at 6692 +RAM_OUTPUT: + POP AF + PUSH AF + LD BC,LCD_OUTPUT_0 + PUSH BC + AND A + RET Z + CP $1A ; EOF + RET Z + CP $7F ; BS + RET Z + CALL INIT_DEV_OUTPUT + RET NZ + LD BC,$0100 + JP RAM_INPUT_2 + + +; RAM file input routine +; Routine at 6716 +RAM_INPUT: + EX DE,HL + CALL GET_RAM_PTR + CALL GET_BYTE + EX DE,HL + CALL GETPARM_VRFY3 + JP NZ,RAM_INPUT_1 + EX DE,HL + LD HL,(FILTAB+4) + RST CPDEHL + PUSH AF + PUSH DE + CALL NZ,RESFPT_0 + POP HL + POP AF + LD BC,$FFF9 + ADD HL,BC + LD E,(HL) + INC HL + LD D,(HL) + EX DE,HL + LD A,(HL) + INC HL + LD H,(HL) + LD L,A + JP NZ,RAM_INPUT_0 + PUSH DE + EX DE,HL + LD HL,(RAM_FILES) + EX DE,HL + ADD HL,DE + POP DE +RAM_INPUT_0: + EX DE,HL + INC HL + INC HL + INC HL + INC HL + LD C,(HL) + INC HL + LD B,(HL) + INC (HL) + INC HL + EX DE,HL + ADD HL,BC + LD B,$00 + CALL LDIR_B + EX DE,HL + DEC H + XOR A +RAM_INPUT_1: + LD C,A + ADD HL,BC + LD A,(HL) + CP $1A ; EOF + SCF + CCF + JP NZ,RDBYT_0 + CALL GET_RAM_PTR + LD (HL),A + SCF + JP RDBYT_0 + +; Routine at 6803 +RAM_IO: + CALL GET_RAM_PTR + JP DEV_IO_SUB + +; This entry point is used by the routines at RAM_CLS and RAM_OUTPUT. +RAM_INPUT_2: + PUSH HL + PUSH BC + PUSH HL + EX DE,HL + LD HL,(FILTAB+4) + RST CPDEHL + CALL NZ,RESFPT_0 + POP HL + DEC HL + LD D,(HL) + DEC HL + LD E,(HL) + EX DE,HL + POP BC + PUSH BC + PUSH HL + ADD HL,BC + EX DE,HL + LD (HL),E + INC HL + LD (HL),D + LD BC,$FFFA ; -6 + ADD HL,BC + LD E,(HL) + INC HL + LD D,(HL) + LD A,(DE) + LD L,A + INC DE + LD A,(DE) + LD H,A + POP BC + ADD HL,BC + POP BC + PUSH HL + PUSH BC + CALL MAKHOL + CALL NC,__EOF_4 + POP BC + POP DE + POP HL + JP C,RAM_INPUT_4 + PUSH HL +RAM_INPUT_3: + LD A,(HL) + LD (DE),A + INC DE + INC HL + DEC C + JP NZ,RAM_INPUT_3 + POP DE + LD HL,(FILTAB+4) + RST CPDEHL + RET Z + JP RESFPT_0 + +RAM_INPUT_4: + LD BC,$FFF7 ; -9 + ADD HL,BC + LD (HL),$00 + CALL RAM_CLS_0 + JP OMERR + +GET_RAM_PTR: + PUSH DE + LD HL,(RAMFILE) + LD DE,RAMPRV + ADD HL,DE + POP DE + RET + + +; CAS Device control block +CAS_CTL: + DEFW CAS_OPN + DEFW CAS_CLS + DEFW CAS_OUTPUT + DEFW CAS_INPUT + DEFW CAS_IO + + +; CAS file open routine +CAS_OPN: + PUSH HL + PUSH DE + LD BC,$0006 + ADD HL,BC + XOR A + LD (HL),A + LD (CASPRV),A + LD A,E + CP $08 + JP Z,NMERR ; NM error: bad file name + CP $01 + JP Z,CAS_OPN_1 + CALL CAS_OPNO_DO +CAS_OPN_0: + POP DE + POP HL + JP REDIRECT_IO + +CAS_OPN_1: + CALL $2A0F ; CAS_OPNI_DO + JP CAS_OPN_0 + +; CAS file close routine +CAS_CLS: + CALL CLOSE_DEVICE + JP Z,CAS_CLS_1 + PUSH HL + ADD HL,BC +CAS_CLS_0: + LD (HL),$1A ; EOF + INC HL + INC C + JP NZ,CAS_CLS_0 + POP HL + CALL CAS_OUTPUT_0 +CAS_CLS_1: + XOR A + LD (CASPRV),A + JP _CLOSE + + +; CAS file output routine +CAS_OUTPUT: + POP AF + PUSH AF + CALL INIT_DEV_OUTPUT + CALL Z,CAS_OUTPUT_0 + JP LCD_OUTPUT_0 + +; CAS file input routine +CAS_INPUT: + EX DE,HL + LD HL,CASPRV + CALL GET_BYTE + EX DE,HL + CALL GETPARM_VRFY3 + JP NZ,GETWORD_78 + PUSH HL + CALL CAS_OPNI_CO_10 + POP HL + LD BC,$0000 +GETWORD_77: + CALL CASIN + LD (HL),A + INC HL + DEC B + JP NZ,GETWORD_77 + CALL CASIN + LD A,C + AND A + JP NZ,HEADER_0 + CALL CTOFF + DEC H + XOR A + LD B,A +GETWORD_78: + LD C,A + ADD HL,BC + LD A,(HL) + CP $1A ; EOF + SCF + CCF + JP NZ,RDBYT_0 + LD (CASPRV),A + SCF + JP RDBYT_0 + LD HL,CASPRV + JP DEV_IO_SUB +CAS_OUTPUT_0: + PUSH HL + CALL CAS_OPNO_CO_3 + POP HL + LD BC,$0000 +GETPARM_VRFY0: + LD A,(HL) + CALL CSOUT + INC HL + DEC B + JP NZ,GETPARM_VRFY0 + JP CAS_OPNO_CO_1 +CLOSE_DEVICE: + LD A,(HL) + CP $01 + RET Z + LD BC,$0006 + ADD HL,BC + LD A,(HL) + LD C,A + LD (HL),$00 + JP GETPARM_VRFY4 +INIT_DEV_OUTPUT: + LD E,A + LD BC,$0006 + ADD HL,BC + LD A,(HL) + INC (HL) + INC HL + INC HL + INC HL + PUSH HL + LD C,A + ADD HL,BC + LD (HL),E + POP HL + RET +GETPARM_VRFY3: + LD BC,$0006 + ADD HL,BC + LD A,(HL) + INC (HL) +GETPARM_VRFY4: + INC HL + INC HL + INC HL + AND A + RET + LD C,B + ADD HL,DE + DEC B + LD C,A + JP NC,GET_DEVICE_694 + PUSH AF + CALL OUTC_TABEXP + JP LCD_OUTPUT_0 + CALL PO,$011B + INC E + DEC E + INC E + JR Z,GETPARM_VRFY6 + LD B,A + INC E + RST $38 + LD C,(HL) + PUSH HL + PUSH DE + LD HL,FILNAM + CALL GETWORD_91 + POP DE + LD A,E + CP $08 + JP Z,NMERR ; NM error: bad file name + SUB $01 + JP NZ,GETPARM_VRFY5 + LD (COMPRV),A +GETPARM_VRFY5: + POP HL +GETPARM_VRFY6: + JP REDIRECT_IO + +GETPARM_VRFY7: + RST $38 + LD D,B + IN A,($D8) + AND $10 + JP Z,GETPARM_VRFY7 + LD BC,__CLOSE_3 +GETPARM_VRFY8: + DEC BC + LD A,B + OR C + JP NZ,GETPARM_VRFY8 + CALL __MENU_02 + XOR A + LD (COMPRV),A + JP _CLOSE + + POP AF + PUSH AF + CALL SD232C + JP NC,LCD_OUTPUT_0 + JP GETWORD_49 + LD HL,COMPRV + CALL GET_BYTE + CALL RV232C + JP C,GETWORD_49 + JP Z,GETPARM_VRFY9 + LD A,$82 +GETPARM_VRFY9: + CP $1A ; EOF + SCF + CCF + JP NZ,RDBYT_0 + LD (COMPRV),A + SCF + JP RDBYT_0 + LD HL,COMPRV +DEV_IO_SUB: + LD (HL),C + JP SCPTLP_119 + +; This entry point is used by the routine at GET_DEVICE. +GETWORD_91: + LD E,L + LD D,H + LD B,$06 +GETWORD_92: + LD A,(DE) + CP ' ' + JP NZ,GETWORD_93 + INC DE + DEC B + JP NZ,GETWORD_92 + LD HL,$F406 +GETWORD_93: + LD BC,NMERR ; NM error: bad file name + PUSH BC + LD A,(HL) + SUB $31 + CP $09 + RET NC + INC A + LD D,A + INC HL + CALL UCASE_HL + LD B,A + CP $49 + JP Z,GETWORD_94 + CP 'E' + LD E,$02 + JP Z,GETWORD_95 + SUB $4E +GETWORD_94: + LD E,$04 + JP Z,GETWORD_95 + DEC A + RET NZ + LD E,A +GETWORD_95: + INC HL + LD A,(HL) + SUB $36 + CP $03 + RET NC + INC A + ADD A,A + ADD A,A + ADD A,A + OR E + LD E,A + LD A,B + CP $49 + JP NZ,$1CAC + LD A,E + AND $18 + CP $18 + RET Z + LD A,E + ADD A,$08 + LD E,A + AND $08 + ADD A,A + ADD A,A + ADD A,A + OR $3F + JP Z,PTRFIL_2 + LD C,A + INC HL + LD A,(HL) + SUB $31 + CP $02 + RET NC + OR E + LD E,A + INC HL + CALL UCASE_HL + CP $4E + JP Z,GETWORD_96 + CP $58 + RET NZ + CALL _XONXOFF_FLG + SCF +GETWORD_96: + CALL NC,$6F8E + INC HL + CALL UCASE_HL + CP $53 + JP Z,GETWORD_97 + CP $4E + RET NZ +GETWORD_97: + POP AF + PUSH DE + LD DE,$F40B + LD B,$06 +GETWORD_98: + CALL UCASE_HL + LD (DE),A + DEC HL + DEC DE + DEC B + JP NZ,GETWORD_98 + POP HL + JP $6F58 + OR $1C + RET M + INC E + ADD A,A + DEC BC + JP M,PTRFIL_0 + INC E + + RST $38 + LD L,H + + RST $38 + LD L,(HL) + + RST $38 + LD (HL),B + + RST $38 + LD (HL),D + +__EOF: + RST $38 + JR Z,$1CCE + DEC L + LD C,(HL) + JP Z,CFERR + CP $01 + JP NZ,NMERR ; NM error: bad file name + PUSH HL + CALL __EOF_1 + LD C,A + SBC A,A + CALL INT_RESULT_A + POP HL + INC HL + INC HL + INC HL + INC HL + LD A,(HL) + LD HL,COMPRV + CP $FC ; 'COM' device + JP Z,__EOF_0 + CALL GET_RAM_PTR + CP $F9 ; 'RAM' device ? + JP Z,__EOF_0 + LD HL,CASPRV +__EOF_0: + LD (HL),C + RET + +__EOF_1: + PUSH BC + PUSH HL + PUSH DE + LD A,$06 + JP GET_DEVICE + +GET_BYTE: + LD A,(HL) + LD (HL),$00 + AND A + RET Z + INC SP + INC SP + CP $1A ; EOF + SCF + CCF + JP NZ,RDBYT_0 + LD (HL),A +; This entry point is used by the routine at GET_DEVICE. +GETWORD_102: + SCF + JP RDBYT_0 + +__EOF_3: + LD BC,$0001 +__EOF_4: + LD HL,(SAVSTK) +__EOF_5: + LD A,(HL) + AND A + RET Z + EX DE,HL + LD HL,(STKTOP) + EX DE,HL + RST CPDEHL + RET NC + LD A,(HL) + CP $82 + LD DE,$0007 + JP NZ,GETWORD_106 + INC HL + LD E,(HL) + INC HL + LD D,(HL) + EX DE,HL + ADD HL,BC + EX DE,HL + LD (HL),D + DEC HL + LD (HL),E + LD DE,CHRGTB +GETWORD_106: + ADD HL,DE + JP __EOF_5 + +; This entry point is used by the routine at OPRND. +FN_TIME: + RST CHRGTB ; Gets next character (or token) from BASIC text. + PUSH HL + CALL GET_DAY_0 + CALL READ_TIME + JP TSTOPL + +; This entry point is used by the routine at GET_DEVICE. +READ_TIME: + CALL READ_CLOCK + LD DE,$F837 + CALL LINE2PTR4 + LD (HL),':' + INC HL + CALL LINE2PTR4 + LD (HL),':' +GETWORD_109: + INC HL + JP LINE2PTR4 + +; This entry point is used by the routine at OPRND. +FN_DATE: + RST CHRGTB ; Gets next character (or token) from BASIC text. + PUSH HL + CALL GET_DAY_0 + CALL GET_DATE + JP TSTOPL + +; This entry point is used by the routine at GET_DEVICE. +GET_DATE: + CALL READ_CLOCK + PUSH HL + LD HL,$F83D + LD B,$00 + DI + CALL $7EEC + EI + LD A,D + EX (SP),HL + CALL LINE2PTR6 + EX (SP),HL + DEC HL + DI + CALL $7EEC + EI + LD A,D + POP HL + CALL LINE2PTR6 + LD DE,$F83B + LD (HL),$2F + INC HL + LD A,(DE) + CP $0A + LD B,$30 + JP C,LINE2PTR2 + LD B,$31 + SUB $0A +LINE2PTR2: + LD (HL),B + INC HL + CALL LINE2PTR6 + DEC DE + LD (HL),$2F + JP GETWORD_109 + +GET_DAY_0: + LD A,$08 + CALL MKTMST + LD HL,(TMPSTR) + RET + +LINE2PTR4: + CALL LINE2PTR5 +LINE2PTR5: + LD A,(DE) +LINE2PTR6: + OR $30 + LD (HL),A + DEC DE + INC HL + RET + +READ_CLOCK: + PUSH HL + LD HL,SECS + DI + CALL READ_CLOCK_HL + EI + POP HL + RET + +; This entry point is used by the routine at __FOR. +TIME: + RST CHRGTB ; Gets next character (or token) from BASIC text. + CALL GETWORD_123 +LINE2PTR9: + LD HL,SECS + DI + CALL $735A + EI + POP HL + RET + +; This entry point is used by the routine at __FOR. +DATE: + RST CHRGTB ; Gets next character (or token) from BASIC text. + CALL GETWORD_122 + JP NZ,SNERR + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + PUSH HL + LD HL,$F83D + DI + CALL __MENU_189 + EI + EX (SP),HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + EX (SP),HL + DEC HL +; This entry point is used by the routine at EXP. +GETWORD_121: + DI + CALL __MENU_189 + EI + POP HL + INC HL + RST SYNCHR ; Check syntax: next byte holds the byte to be found + CPL + CALL GETINT + DEC A + CP $0C + JP NC,SNERR + INC A + LD DE,$F83B + LD (DE),A + RST SYNCHR ; Check syntax: next byte holds the byte to be found + CPL + DEC DE + CALL GETWORD_124 + CP $04 + JP NC,SNERR + CALL GETWORD_124 + JP LINE2PTR9 + +GETWORD_122: + RST SYNCHR ; Check syntax: next byte holds the byte to be found + POP AF + CALL EVAL + EX (SP),HL + PUSH HL + CALL READ_CLOCK + CALL GETSTR + LD A,(HL) + INC HL + LD E,(HL) + INC HL + LD H,(HL) + LD L,E + CP $08 + RET +GETWORD_123: + CALL GETWORD_122 + JP NZ,SNERR + EX DE,HL + POP HL + EX (SP),HL + PUSH HL + EX DE,HL + LD DE,$F838 + CALL GETWORD_124 + CP $03 + JP NC,SNERR + CALL GETWORD_124 + RST SYNCHR ; Check syntax: next byte holds the byte to be found + LD A,($7BCD) + LD E,$CF + LD A,($83CD) + LD E,$FE + LD B,$D2 + LD L,B + DEC B +GETWORD_124: + DEC DE + LD A,(HL) + INC HL + SUB $30 + CP $0A + JP NC,SNERR + AND $0F + LD (DE),A + RET + +; COM and MDM Statements +__COM: + PUSH HL + LD HL,ON_COM_FLG + CALL GETWORD_125 +;__MDM_2: + POP HL + POP AF + RST CHRGTB ; Gets next character (or token) from BASIC text. + JP EXEC_EVAL_00 + +GETWORD_125: + CP $95 + JP Z,TIME_S_ON + CP $E7 + JP Z,TIME_S_OFF + CP $90 + JP Z,TIME_S_STOP + JP SNERR + +; This entry point is used by the routine at __DATA. +ONGO: + CP $B6 + LD BC,$0001 + RET Z + SCF + RET + +; This entry point is used by the routine at __DATA. +GETWORD_127: + EX DE,HL + LD ($F84D),HL ; IENTRY_F1 + EX DE,HL + RET + +; This entry point is used by the routine at GETYPR. +GETWORD_128: + CALL GET_DEVICE_699 + PUSH HL + PUSH DE + PUSH BC +GETWORD_129: + PUSH AF + LD A,$0D + JR NC,GETWORD_129 + LD HL,CSRITP + DEC (HL) + JP NZ,GETWORD_130 + LD (HL),$7D + INC HL + DEC (HL) + JP NZ,GETWORD_130 + LD (HL),$0C + INC HL + PUSH HL + LD HL,(CURLIN) + INC HL + LD A,H + OR L + POP HL + CALL NZ,GETWORD_131 + LD A,(HL) + AND A + JP Z,GETWORD_130 + DEC (HL) + JP NZ,GETWORD_130 + INC HL + LD (HL),$FF +GETWORD_130: + JP _RST75_7 +; This entry point is used by the routine at GET_DEVICE. +GETWORD_131: + LD A,(PWRINT) + LD (TIMINT),A + RET + +; This entry point is used by the routine at ISFLIO. +GETWORD_132: + LD A,(HL) + CP $7F ; BS + JP Z,GETWORD_133 + CP ' ' + JP NC,GETWORD_134 +GETWORD_133: + LD A,' ' +GETWORD_134: + RST OUTC + INC HL + DEC B + JP NZ,GETWORD_132 + LD A,' ' + RET + +__KEY: + CALL GETINT + DEC A + CP $0A + JP NC,FCERR + EX DE,HL + LD L,A + LD H,$00 + ADD HL,HL + ADD HL,HL + ADD HL,HL + ADD HL,HL + LD BC,FNKSTR + ADD HL,BC + PUSH HL + EX DE,HL + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + CALL EVAL + PUSH HL + CALL GETSTR + LD B,(HL) + INC HL + LD E,(HL) + INC HL + LD D,(HL) + POP HL + EX (SP),HL + LD C,$0F + LD A,B + AND A + JP Z,GETWORD_137 +GETWORD_135: + LD A,(DE) + AND A + JP Z,FCERR + LD (HL),A + INC DE +GETWORD_136: + INC HL + DEC C + JP Z,GETWORD_138 + DEC B + JP NZ,GETWORD_135 +GETWORD_137: + LD (HL),B + INC HL + DEC C + JP NZ,GETWORD_137 +GETWORD_138: + LD (HL),C + CALL FNKSB + CALL DWNLDR_47 + POP HL + RET +__PSET: + CALL GETWORD_141 +GETWORD_139: + RRCA + PUSH HL + PUSH AF + CALL C,PLOT + POP AF + CALL NC,$74D1 + POP HL + RET + +__PRESET: + CALL GETWORD_141 + CPL + JP GETWORD_139 + +; This entry point is used by the routine at __DATA. +GETWORD_140: + RST $38 + ADD A,(HL) +GETWORD_141: + RST SYNCHR ; Check syntax: next byte holds the byte to be found + JR Z,GETWORD_136 + EX (SP),HL + INC DE + CP $F0 ; TK_GREATER ; Token for '>' + JP C,GETWORD_142 + LD A,$EF +GETWORD_142: + PUSH AF + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + CALL GETINT + CP $40 + JP C,GETWORD_143 + LD E,$3F +GETWORD_143: + POP AF + LD D,A + EX DE,HL + LD ($F3FA),HL + EX DE,HL + LD A,(HL) + CP ')' + JP NZ,GETWORD_144 + RST CHRGTB ; Gets next character (or token) from BASIC text. + LD A,$01 + RET +GETWORD_144: + PUSH DE + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + CALL GETINT + RST SYNCHR ; Check syntax: next byte holds the byte to be found + ADD HL,HL + LD A,E + POP DE + RET + +__LOCATE: + CALL GETINT + PUSH AF + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + CALL GETINT + POP AF + LD D,A + LD A,(ACTV_Y) + INC D + CP D + JP NC,GETWORD_145 + LD D,A +GETWORD_145: + LD A,(ACTV_X) + INC E + CP E + JP NC,GETWORD_146 + LD E,A +GETWORD_146: + PUSH HL + EX DE,HL + CALL POSIT + LD A,H + DEC A + LD (TTYPOS),A + POP HL + RET +; This entry point is used by the routine at OPRND. +GETWORD_147: + PUSH HL + LD A,(CSRX) + DEC A + CALL INT_RESULT_A + POP HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + RET + +__WIDTH: + RST $38 + LD E,(HL) +__CMD: + RST $38 + ADC A,D +__COLOR: + RST $38 + ADC A,B +; This entry point is used by the routine at OPRND. +FN_STATUS: + RST $38 + ADC A,H +__SOUND: + CALL GETWORD + LD A,D + AND $C0 + JP NZ,FCERR + PUSH DE + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + CALL GETINT +GETWORD_149: + AND A + LD B,A + POP DE + JP NZ,MUSIC + RET +__MOTOR: + CALL GETINT + JP DATAR_1 +__EXEC: + CALL GETWORD + PUSH HL + LD A,($F9A7) + LD HL,($F9A8) + CALL GETWORD_150 + LD ($F9A7),A + LD ($F9A8),HL + POP HL + RET +GETWORD_150: + PUSH DE + RET + +__SCREEN: + CP ',' + LD A,($F3E4) + CALL NZ,GETINT + CALL __SCREEN_SUB + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + RET Z + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + CALL GETINT + PUSH HL + AND A + CALL FNBAR_IF_NZ + POP HL + RET + +; This entry point is used by the routine at GET_DEVICE. +__SCREEN_SUB: + PUSH HL + LD ($F3E4),A + AND A + LD DE,$2808 + LD HL,(CSR_ROW) + LD A,$0E + RST $38 + LD (HL),$CA + LD C,H + JR NZ,GETWORD_149 + LD ($F3E4),A + RST $38 + LD H,B + LD (CSRX),HL + EX DE,HL + LD (ACTV_X),HL + LD (CLMLST),A + POP HL + RET + +; This entry point is used by the routine at SCPTLP. +MERGE_SUB: + PUSH HL + CALL CHGET8 + CALL RESFPT + LD HL,(FILNAM+6) + LD DE,$2020 + RST CPDEHL + PUSH AF + JP Z,_MERGE_SUB_3 + LD DE,'B'+'A'*$100 ; "BA" (as in filename string) + RST CPDEHL + JP NZ,_MERGE_SUB_5 +_MERGE_SUB_3: + CALL FINDBA + JP Z,_MERGE_SUB_5 + POP AF + POP BC + POP AF + JP Z,FCERR + LD A,$00 + PUSH AF + PUSH BC + LD (DIRPNT),HL + EX DE,HL + LD (BASTXT),HL + CALL UPD_PTRS + POP HL + LD A,(HL) + CP ',' + JP NZ,_MERGE_SUB_4 + RST CHRGTB ; Gets next character (or token) from BASIC text. + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB 'R' + POP AF + LD A,$80 + SCF + PUSH AF +_MERGE_SUB_4: + POP AF + LD (NLONLY),A + JP C,RUN_FST + CALL RUN_FST + JP READY + +_MERGE_SUB_5: + POP AF + POP HL + LD D,$F9 ; 'RAM' device + JP NZ,__MERGE_0 + PUSH HL + LD HL,$2020 + LD (FILNAM+6),HL ; clear file name ext + POP HL + JP __MERGE_0 + +; This entry point is used by the routine at SCPTLP. +__LCOPY_6: + PUSH HL + CALL CHGET8 + LD HL,(FILNAM+6) ; point to file name ext + LD DE,'D'+'O'*$100 ; "DO" (as in filename string) + RST CPDEHL + LD B,$00 + JP Z,__LCOPY_7 + LD DE,'B'+'A'*$100 ; "BA" (as in filename string) + RST CPDEHL + LD B,$01 + JP Z,__LCOPY_7 + LD DE,$2020 ; " " + RST CPDEHL + LD B,$02 + JP NZ,NMERR ; NM error: bad file name + +__LCOPY_7: + POP HL + PUSH BC + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + JP Z,__LCOPY_9 + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB 'A' + POP BC + DEC B + JP Z,NMERR ; NM error: bad file name +__LCOPY_8: + XOR A + LD DE,$F902 ; D = 'RAM' device, E = $02 + PUSH AF + JP __SAVE_1 + +__LCOPY_9: + POP BC + DEC B + JP M,__LCOPY_8 + CALL __NAME_2 + JP NZ,FCERR + +;SAVEBA: + CALL FINDBA + CALL NZ,KILLASC_6 + CALL RESFPT_0 + CALL NXTDIR_0 + LD (DIRPNT),HL + LD A,$80 + EX DE,HL + LD HL,(BASTXT) + EX DE,HL + CALL MAKTXT_0 + CALL RESFPT_9 + JP READY + +__FILES: + RST $38 + INC (HL) + PUSH HL + CALL CATALOG + POP HL + JP CONSOLE_CRLF + + +; Display Catalog +; +; Used by the routine at __FILES. +CATALOG: + LD HL,$F844 +CATALOG_0: + LD C,$03 + LD A,(ACTV_Y) + CP 40 + JP Z,CATALOG_1 + LD C,$06 ; 6 characters +CATALOG_1: + CALL NXTDIR + RET Z + AND $18 ; 24 + JP NZ,CATALOG_1 + PUSH HL + INC HL + LD E,(HL) + INC HL + LD D,(HL) + INC HL + PUSH DE + + LD B,$06 ; 6 characters +CATALOG_2: + LD A,(HL) + RST OUTC + INC HL + DEC B + JP NZ,CATALOG_2 + LD A,'.' + RST OUTC + LD A,(HL) + RST OUTC + INC HL + LD A,(HL) + RST OUTC + POP DE + LD HL,(BASTXT) + RST CPDEHL + LD A,'*' + LD B,' ' + JP Z,CATALOG_3 + LD A,B +CATALOG_3: + RST OUTC + LD A,B + RST OUTC + RST OUTC + POP HL + DEC C + JP NZ,CATALOG_1 + CALL OUTDO_CRLF + PUSH HL + LD HL,$0000 + CALL CHSNS_0 + POP HL + JP CATALOG_0 + +__KILL: + CALL __NAME_1 + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + JP NZ,SNERR + LD A,D + CP $F9 ; 'RAM' device ? + JP Z,__KILL_0 + RST $38 + DEFB $7E ; HKILL, Offset: 126 + ;LD A,(HL) +__KILL_0: + PUSH HL + CALL RESFPT_0 + CALL FINDFL + JP Z,FFERR + LD B,A + AND $20 + JP NZ,KILLBIN_0 + LD A,B + AND $40 + JP Z,KILLASC_5 + LD A,B + AND $02 + JP NZ,AOERR + +; Kill a text (.DO) file, DE=TOP addr, HL=adrress of dir entry. +KILLASC: + LD A,$E5 + ; PUSH HL ; (KILLASC+1) + LD BC,$0000 + LD (HL),C + LD L,E + LD H,D +KILLASC_0: + LD A,(DE) + INC DE + INC BC + CP $1A ; EOF + JP NZ,KILLASC_0 + CALL MASDEL +KILLASC_1: + CALL __EOF_4 + CALL RESFPT_0 + POP HL + RET + +; This entry point is used by the routine at GET_DEVICE. +KILLBIN: + PUSH HL +KILLBIN_0: + LD (HL),$00 + LD HL,(CO_FILES) + PUSH HL + EX DE,HL + PUSH HL + INC HL + INC HL + LD C,(HL) + INC HL + LD B,(HL) + LD HL,$0006 + ADD HL,BC + LD B,H + LD C,L + POP HL + CALL MASDEL + POP HL + LD (CO_FILES),HL + JP KILLASC_1 + +; This entry point is used by the routine at GET_DEVICE. +KILLASC_4: + CALL RESFPT_0 + LD HL,($F887) + EX DE,HL + LD HL,SUZUKI+21 + JP KILLASC+1 + +KILLASC_5: + PUSH HL + LD HL,(BASTXT) + RST CPDEHL + POP HL + JP Z,FCERR + CALL KILLASC_6 + CALL _CLVAR + JP READY + +; This entry point is used by the routine at GET_DEVICE. +KILLASC_6: + LD (HL),$00 + LD HL,(BASTXT) + RST CPDEHL + PUSH AF + PUSH DE + CALL UPD_PTRS_0 + POP DE + INC HL + CALL GETWORD_188 + PUSH BC + CALL RESFPT_0 + POP BC + POP AF + RET Z + RET C + LD HL,(BASTXT) + ADD HL,BC + LD (BASTXT),HL + RET + +__NAME: + CALL __NAME_1 + PUSH DE + CALL SWAPNM + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB 'A' + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB 'S' + CALL __NAME_1 + LD A,D + POP DE + CP D + JP NZ,FCERR + CP $F9 ; D = 'RAM' device ? + JP Z,__NAME_0 + + RST $38 + ADD A,B ; HNAME, Offset: + +__NAME_0: + PUSH HL + CALL FINDFL + JP NZ,FCERR + CALL SWAPNM + CALL FINDFL + JP Z,FFERR + PUSH HL + LD HL,(FILNAM+6) + EX DE,HL + LD HL,(FILNM2+6) + RST CPDEHL ; compare file name extensions + JP NZ,FCERR + POP HL + CALL SWAPNM + INC HL + INC HL + INC HL + CALL COPY_NAME + POP HL + RET + +__NAME_1: + CALL FILE_PARMS + RET NZ + LD D,$F9 ; 'RAM' device + RET + +__NAME_2: + LD HL,(DIRPNT) + LD DE,SUZUKI-1 + RST CPDEHL + RET + + +; Routine at 8329 +; +; Used by the routines at CSAVEM and CLOADM. +FINDCO: + LD BC,'C'*$100+'O' + JP FIND_FILEXT + +; This entry point is used by the routine at GET_DEVICE. +FINDCO_0: + CALL CHGET8 + LD HL,(FILNAM+6) + LD DE,$2020 ; " " + RST CPDEHL + JP Z,FINDDO + LD DE,'D'+'O'*$100 ; "DO" (as in filename string) + RST CPDEHL + JP NZ,NMERR ; NM error: bad file name + +FINDDO: + LD BC,'D'*$100+'O' + JP FIND_FILEXT + +FINDBA: + LD BC,'B'*$100+'A' + +FIND_FILEXT: + LD HL,FILNAM+6 + LD (HL),B + INC HL + LD (HL),C + +FINDFL: + CALL CHGET8 + LD HL,$F844 + ;LD A,$E1 + DEFB $3E ; "LD A,n" to Mask the next byte + +; Routine at 8371 +L22A2: + POP HL + CALL NXTDIR + RET Z + PUSH HL + INC HL + INC HL + LD DE,$FB77 + LD B,$08 +FINDFL_0: + INC DE + INC HL + LD A,(DE) + CP (HL) + JP NZ,L22A2 + DEC B + JP NZ,FINDFL_0 + POP HL + LD A,(HL) + INC HL + LD E,(HL) + INC HL + LD D,(HL) + DEC HL + DEC HL + AND A + RET + +NXTDIR: + PUSH BC + LD BC,$000B + ADD HL,BC + POP BC + LD A,(HL) + CP $FF + RET Z + AND A + JP P,NXTDIR + RET + +NXTDIR_0: + LD A,(ERRTRP-1) + AND A + LD HL,SUZUKI+21 + RET NZ + LD HL,SUZUKI+21 + LD BC,$000B +NXTDIR_1: + ADD HL,BC + LD A,(HL) + CP $FF + JP Z,FLERR + ADD A,A + JP C,NXTDIR_1 + RET + +__NEW: + RET NZ +; This entry point is used by the routines at SCPTLP and GET_DEVICE. +CLRPTR: + CALL __NAME_2 + CALL NZ,RESFPT + CALL CLSALL ; Close all files + LD HL,SUZUKI-1 + LD (DIRPNT),HL + LD HL,(SUZUKI) + LD (BASTXT),HL + XOR A + LD (PTRFLG),A + LD (HL),A + INC HL + LD (HL),A + INC HL + EX DE,HL + LD HL,(DO_FILES) + CALL GETWORD_188 + LD HL,$0000 + LD (RAM_FILES),HL + CALL RESFPT_0 + JP RUN_FST + +; This entry point is used by the routine at GET_DEVICE. +__NEW_2: + LD HL,(LBLIST) + EX DE,HL + LD HL,(LBEDIT) +GETWORD_188: + LD A,L + SUB E + LD C,A + LD A,H + SBC A,D + LD B,A + EX DE,HL + CALL MASDEL + LD HL,(DO_FILES) + ADD HL,BC + LD (DO_FILES),HL + RET + +; This entry point is used by the routine at GET_DEVICE. +RESFPT: + CALL GETPARM_VRFY +; This entry point is used by the routine at GET_DEVICE. +RESFPT_0: + CALL RESFPT_3 + XOR A + LD ($F745),A + LD HL,(RAM) + INC HL +RESFPT_0: + PUSH HL + LD HL,$F865 + LD DE,$FFFF +RESFPT_1: + CALL NXTDIR + JP Z,RESFPT_2 + CP $F0 + JP Z,RESFPT_1 + RRCA + JP C,RESFPT_1 + PUSH HL + INC HL + LD A,(HL) + INC HL + LD H,(HL) + LD L,A + RST CPDEHL + POP HL + JP NC,RESFPT_1 + LD B,H + LD C,L + INC HL + LD E,(HL) + INC HL + LD D,(HL) + DEC HL + DEC HL + JP RESFPT_1 + +RESFPT_2: + LD A,E + AND D + INC A + POP DE + JP Z,RESFPT_3 + LD H,B + LD L,C + LD A,(HL) + OR $01 + LD (HL),A + INC HL + LD (HL),E + INC HL + LD (HL),D + EX DE,HL + CALL RESFPT_5 + JP RESFPT_0 + +RESFPT_3: + LD HL,$F844 +RESFPT_4: + CALL NXTDIR + RET Z + AND $FE + LD (HL),A + JP RESFPT_4 + +RESFPT_5: + LD A,($F745) + DEC A + JP M,RESFPT_8 + JP Z,RESFPT_6 + INC HL + INC HL + LD E,(HL) + INC HL + LD D,(HL) + INC HL + INC HL + INC HL + ADD HL,DE + RET + +RESFPT_6: + LD A,$1A ; EOF +RESFPT_7: + CP (HL) + INC HL + JP NZ,RESFPT_7 + EX DE,HL + LD HL,(CO_FILES) + EX DE,HL + RST CPDEHL + RET NZ + LD A,$02 + LD ($F745),A + RET + +RESFPT_8: + EX DE,HL + CALL UPD_PTRS_0 + INC HL + EX DE,HL + LD HL,(DO_FILES) + EX DE,HL + RST CPDEHL + RET NZ + LD A,$01 + LD ($F745),A + RET + +RESFPT_9: + LD HL,(PROGND) + LD (VAREND),HL + LD (ARREND),HL + LD HL,(DO_FILES) + DEC HL + LD (SUZUKI),HL + INC HL + LD BC,$0002 + EX DE,HL + CALL MAKHOL_0 + XOR A + LD (HL),A + INC HL + LD (HL),A + LD HL,(DO_FILES) + ADD HL,BC + LD (DO_FILES),HL + JP RESFPT_0 + + +; Count the number of characters in (HL), null terminated +; +; Used by the routines at OPENDO, TEL_UPLD and TXT_CTL_G. +COUNT_CHARS: + PUSH HL + LD E,$FF +COUNT_CHARS_0: + INC E + LD A,(HL) + INC HL + AND A + JP NZ,COUNT_CHARS_0 + POP HL + RET + +; This entry point is used by the routine at GET_DEVICE. +OPENDO: + CALL COUNT_CHARS + CALL FNAME + JP NZ,SNERR + +MAKTXT: + CALL RESFPT_0 + CALL FINDCO_0 + EX DE,HL + SCF + RET NZ + CALL NXTDIR_0 + PUSH HL + LD HL,(DO_FILES) + PUSH HL + LD A,$1A ; EOF + CALL INSCHR + JP C,OMERR + POP DE + POP HL + PUSH HL + PUSH DE + LD A,$C0 + DEC DE + CALL MAKTXT_0 + CALL RESFPT_0 + POP HL + POP DE + AND A + RET + +; This entry point is used by the routines at SAVEBA and CSAVEM. +MAKTXT_0: + PUSH DE + LD (HL),A + INC HL + LD (HL),E + INC HL + LD (HL),D + INC HL + + DEFB $3E ; "LD A,n" to Mask the next byte +; LD A,$D5 + +; Used by the routine at __NAME. +COPY_NAME: + PUSH DE + LD DE,FILNAM + LD B,$08 + CALL REV_LDIR_B + POP DE + RET + +SWAPNM: + PUSH HL + LD B,$09 + LD DE,FILNAM + LD HL,FILNM2 +SWAPNM_0: + LD C,(HL) + LD A,(DE) + LD (HL),A + LD A,C + LD (DE),A + INC DE + INC HL + DEC B + JP NZ,SWAPNM_0 + POP HL + RET + +CHGET8: + PUSH HL + LD HL,FILNAM+6 + LD B,$03 +CHGET9: + CALL UCASE_HL + LD (HL),A + INC HL + DEC B + JP NZ,CHGET9 + POP HL + RET + +; This entry point is used by the routines at CHKSTK and GET_DEVICE. +SWAPNM_1: + CALL RESFPT_0 + LD HL,$FFFF + LD (PASPNT),HL + LD B,H + LD C,L + LD HL,(HAYASHI) ; Paste buffer file + PUSH HL + LD A,$1A ; EOF +SWAPNM_2: + CP (HL) + INC BC + INC HL + JP NZ,SWAPNM_2 + POP HL + CALL MASDEL + JP RESFPT_0 + +; This entry point is used by the routine at GET_DEVICE. +GETWORD_212: + PUSH AF + CALL CONSOLE_CRLF + CALL ERAEOL + POP AF + ADD A,A + ADD A,A + JP C,GETWORD_218 + JP M,GETWORD_225 + RST $38 + INC A + LD HL,(SUZUKI) + LD (BASTXT),HL + CALL CHGDSP_15 + LD A,B + OR C + JP Z,CLOAD_STOP + LD (DATPTR),HL + PUSH HL + CALL GETWORD_256 + LD HL,GETWORD_217 + LD (ERRTRP),HL + CALL GETWORD_294 + DI + POP DE + PUSH DE + LD HL,(BASTXT) +GETWORD_213: + LD B,$0A +GETWORD_214: + CALL CASIN + LD (HL),A + LD C,A + INC HL + RST CPDEHL + JP NC,GETWORD_217 + LD A,C + AND A + JP NZ,GETWORD_213 + DEC B + JP NZ,GETWORD_214 + CALL CTOFF + CALL UPD_PTRS + INC HL + POP DE + CALL GETWORD_255 + CALL GETWORD_224 + CALL NXTDIR_0 + LD A,$80 + EX DE,HL + LD HL,(SUZUKI) + EX DE,HL +GETWORD_215: + DEC DE +GETWORD_216: + CALL MAKTXT_0 + JP __MENU + +GETWORD_217: + CALL CTOFF + LD HL,(BASTXT) + EX DE,HL + LD HL,(DATPTR) + EX DE,HL + CALL GETWORD_255 + JP CLOAD_STOP +GETWORD_218: + LD HL,BLANK_BYTE + XOR A + LD (FNAME_END),A + LD E,$01 + CALL _OPEN + LD HL,GETWORD_222 + LD (ERRTRP),HL + CALL CHGDSP_14 + LD A,B + OR C + JP Z,GETWORD_223 + LD H,B + LD L,C + LD (DATPTR),HL + LD HL,(DO_FILES) + LD (TEMP),HL +GETWORD_219: + CALL RDBYT + JP C,GETWORD_220 + CALL DWNLDR_6 + JP Z,GETWORD_219 + CALL C,GETWORD_221 + CALL GETWORD_221 + JP GETWORD_219 +GETWORD_220: + LD (HL),$1A + CALL SCPTLP_104 + CALL GETWORD_224 + CALL NXTDIR_0 + LD A,$C0 + EX DE,HL + LD HL,(DO_FILES) + EX DE,HL + JP GETWORD_215 +GETWORD_221: + LD (HL),A + INC HL + LD A,(HL) + AND A + LD A,$0A + RET Z + +GETWORD_222: + LD HL,(DATPTR) + LD B,H + LD C,L + LD HL,(TEMP) + CALL MASDEL +GETWORD_223: + CALL SCPTLP_104 + JP CLOAD_STOP + +GETWORD_224: + LD B,$09 + LD DE,FILNAM + LD HL,$F99B + JP LDIR_B + +GETWORD_225: + RST $38 + LD A,$CD + LD (DE),A + LD HL,($E32A) + JP M,EVAL_STR_1 + JP NZ,GET_DEVICE_693 + LD BC,$0006 + ADD HL,BC + LD (DATPTR),HL + LD B,H + LD C,L + LD HL,(PROGND) + LD (TEMP),HL + CALL MAKHOL + JP C,CLOAD_STOP + EX DE,HL + LD HL,TOP + CALL CLOADM_8 + PUSH DE + LD HL,GETWORD_226 + LD (ERRTRP),HL + CALL CAS_OPNI_CO_10 + POP HL + POP DE + CALL LOAD_RECORD + JP NZ,GETWORD_226 + CALL CTOFF + POP HL + LD (CO_FILES),HL + CALL GETWORD_224 + CALL NXTDIR_0 + LD A,$A0 + EX DE,HL + LD HL,(PROGND) + EX DE,HL + JP GETWORD_216 + +GETWORD_226: + CALL CTOFF + JP GETWORD_222 + +__CSAVE: + CALL GETWORD_277 +; This entry point is used by the routine at SCPTLP. +GETWORD_227: + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + JP Z,GETWORD_228 + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB 'A' + LD E,$02 + AND A + PUSH AF + JP __SAVE_1 +GETWORD_228: + LD HL,$FB7D + LD B,$06 +GETWORD_229: + LD A,(HL) + SUB $20 + JP NZ,GETWORD_230 + LD (HL),A + DEC HL + DEC B + JP NZ,GETWORD_229 +GETWORD_230: + CALL GETPARM_VRFY + INC HL + PUSH HL + CALL IOOPRND_0 + LD B,$0A +GETWORD_231: + LD A,$D3 + CALL CSOUT + DEC B + JP NZ,GETWORD_231 + LD B,$06 + LD HL,FILNAM +GETWORD_232: + LD A,(HL) + CALL CSOUT + INC HL + DEC B + JP NZ,GETWORD_232 + LD BC,$4E20 +GETWORD_233: + DEC BC + LD A,B + OR C + JP NZ,GETWORD_233 + POP DE + LD HL,(BASTXT) +GETWORD_234: + LD A,(HL) + CALL CSOUT + INC HL + RST CPDEHL + JP NZ,GETWORD_234 + LD B,$09 +GETWORD_235: + XOR A + CALL CSOUT + DEC B + JP NZ,GETWORD_235 + LD BC,$1F40 +GETWORD_236: + DEC BC + LD A,B + OR C + JP NZ,GETWORD_236 + CALL CTOFF +GETWORD_237: + LD A,(MENU_FLG) + AND A + JP NZ,GET_DEVICE_100 + JP RESTART + +__BSAVE: + CALL __NAME_1 + LD A,D + CP $FD + JP Z,GETWORD_238 + CP $F9 + JP Z,GETWORD_240 + RST $38 + ADD A,D +GETWORD_238: + CALL CSAVEM_2 + CALL $2989 + CALL CAS_OPNO_CO_3 + LD HL,(PRLEN) + EX DE,HL + LD HL,(TOP) + LD C,$00 +GETWORD_239: + LD A,(HL) + CALL CSOUT + INC HL + DEC DE + LD A,D + OR E + JP NZ,GETWORD_239 + CALL CAS_OPNO_CO_1 + JP GETWORD_237 + +GETWORD_240: + CALL CSAVEM_2 + CALL RESFPT_0 + CALL FINDCO + CALL NZ,KILLBIN + CALL NXTDIR_0 + PUSH HL + LD HL,(CO_FILES) + PUSH HL + LD HL,(PRLEN) + LD A,H + OR L + JP Z,OMERR + PUSH HL + LD BC,$0006 ; 6 characters + ADD HL,BC + LD B,H + LD C,L + LD HL,(PROGND) + LD (TEMP),HL + CALL NC,MAKHOL + JP C,OMERR + EX DE,HL + LD HL,TOP + CALL CLOADM_8 + LD HL,(TOP) + POP BC + CALL _LDIR + POP HL + LD (CO_FILES),HL + POP HL + LD A,$A0 + EX DE,HL + LD HL,(TEMP) + EX DE,HL + CALL MAKTXT_0 + CALL RESFPT_0 + JP RESTART + +CSAVEM_2: + CALL GETWORD_242 + PUSH DE + CALL GETWORD_242 + LD A,D + OR E + JP Z,FCERR + PUSH DE + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + LD DE,$0000 + CALL NZ,GETWORD_242 + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + JP NZ,SNERR + EX DE,HL + LD (EXE),HL + POP DE + POP HL + LD (TOP),HL + ADD HL,DE + JP C,FCERR + EX DE,HL + LD (PRLEN),HL + RET + +GETWORD_242: + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + JP GETWORD + +__CLOAD: + CP $91 ; TK_PRINT (=CLOAD?) + JP Z,CVERIFY + CALL GETWORD_274 + OR $FF + PUSH AF +; This entry point is used by the routine at SCPTLP. +__CLOAD_0: + POP AF + PUSH AF + JP NZ,__CLOAD_1 + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + JP NZ,FCERR +__CLOAD_1: + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + LD A,$00 + SCF + CCF + JP Z,__CLOAD_2 + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB 'R' + JP NZ,SNERR + POP AF + SCF + PUSH AF + LD A,$80 +__CLOAD_2: + PUSH AF + LD (NLONLY),A + POP BC + POP AF + PUSH AF + PUSH BC + JP Z,__CLOAD_3 + CALL GETPARM_VRFY + CALL RESFPT_0 + LD HL,(SUZUKI) + LD (BASTXT),HL + LD HL,SUZUKI-1 + LD (DIRPNT),HL + LD HL,(PROGND) + LD (VAREND),HL + LD (ARREND),HL + CALL CHGDSP_14 + CALL GETWORD_256 + LD HL,$27E4 + LD (ERRTRP),HL +__CLOAD_3: + CALL GETWORD_298 + JP Z,__CLOAD_5 + CP $9C ; DO file type + JP Z,LOAD_RECORD_2 +__CLOAD_4: + CALL FNBAR_IF_NZ4 + CALL CONSOLE_CRLF + JP __CLOAD_3 + +__CLOAD_5: + CALL GETWORD_285 + JP NZ,__CLOAD_3 + CALL GETWORD_287 + JP NZ,__CLOAD_4 + POP BC + POP AF + PUSH AF + PUSH BC + JP Z,__CLOAD_4 + POP AF + POP AF + SBC A,A + LD (FILFLG),A + CALL CAS_OPNI_CO_12 + DI + LD HL,(DO_FILES) + EX DE,HL + LD HL,(BASTXT) +__CLOAD_6: + LD B,$0A +__CLOAD_7: + CALL CASIN + LD (HL),A + LD C,A + INC HL + RST CPDEHL + JP NC,GETWORD_253 + LD A,C + AND A + JP NZ,__CLOAD_6 + DEC B + JP NZ,__CLOAD_7 + CALL UPD_PTRS + INC HL + EX DE,HL + LD HL,(DO_FILES) + EX DE,HL + CALL GETWORD_255 + XOR A + LD L,A + LD H,A + LD (ERRTRP),HL + CALL CTOFF + CALL CONSOLE_CRLF + CALL RUN_FST + LD A,(FILFLG) + AND A + JP NZ,EXEC_EVAL_0 + JP READY + +LOAD_RECORD: + LD C,$00 +GETWORD_252: + CALL CASIN + LD (HL),A + INC HL + DEC DE + LD A,D + OR E + JP NZ,GETWORD_252 + CALL CASIN + LD A,C + AND A + RET + + CALL GETWORD_254 + LD HL,$0000 + LD (ERRTRP),HL + JP HEADER_0 + +GETWORD_253: + CALL GETWORD_254 + LD HL,$0000 + LD (ERRTRP),HL + CALL CTOFF + JP OMERR + +GETWORD_254: + LD HL,(DO_FILES) + EX DE,HL + LD HL,(BASTXT) + XOR A + LD (HL),A + INC HL + LD (HL),A + INC HL +GETWORD_255: + LD A,E + SUB L + LD C,A + LD A,D + SBC A,H + LD B,A + CALL MASDEL +; This entry point is used by the routine at SNERR. +GETWORD_256: + LD HL,(DO_FILES) + ADD HL,BC + LD (DO_FILES),HL + RET + +LOAD_RECORD_2: + CALL CAS_OPNI_CO_12 + CALL CONSOLE_CRLF + POP BC + POP AF + PUSH AF + PUSH BC + CALL NZ,GETWORD_254 + LD HL,$0000 + LD (ERRTRP),HL + LD HL,(FILTAB) + LD A,(HL) + INC HL + LD H,(HL) + LD L,A + LD (PTRFIL),HL ; Redirect I/O + LD (HL),$01 + INC HL + INC HL + INC HL + INC HL + LD (HL),$FD ; 'CAS' device ? + INC HL + INC HL + XOR A + LD (HL),A + INC HL + LD (HL),A + LD (CASPRV),A + JP __MERGE_3 + +CVERIFY: + PUSH HL + CALL GETPARM_VRFY + INC HL + EX (SP),HL + CALL CAS_OPNI_BA + PUSH HL + CALL GETWORD_294 + DI + POP HL + POP DE + PUSH HL + LD HL,(BASTXT) +GETWORD_259: + CALL CASIN + CP (HL) + JP NZ,VERIFY_ERROR + INC HL + RST CPDEHL + JP C,GETWORD_259 +GETWORD_260: + CALL CTOFF + POP HL + RET + +VERIFY_ERROR: + LD HL,$287B + CALL PRINT_LINE + JP GETWORD_260 + LD B,D + LD H,C + LD H,H + DEC C + LD A,(BC) + NOP + +__BLOAD: + CP $91 ; TK_PRINT + JP Z,CVERIFYM + CALL __NAME_1 + LD A,D + CP $FD + JP Z,GETWORD_262 + CP $F9 + JP Z,CLOADM_RAM + RST $38 + ADD A,H +GETWORD_262: + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + JP NZ,SNERR + PUSH HL + CALL $2A12 + CALL _CLOAD_PARMS + JP C,OMERR + CALL CAS_OPNI_CO_10 + LD HL,(PRLEN) + EX DE,HL + LD HL,(TOP) + CALL LOAD_RECORD + JP NZ,HEADER_0 + CALL CTOFF + JP GETWORD_264 + +CLOADM_RAM: + PUSH HL + CALL RESFPT_0 + CALL FINDCO + JP Z,FFERR + EX DE,HL + CALL CLOADM_7 + PUSH HL + CALL _CLOAD_PARMS + JP C,OMERR + LD HL,(PRLEN) + LD B,H + LD C,L + LD HL,(TOP) + EX DE,HL + POP HL + CALL _LDIR +GETWORD_264: + POP HL + RET + +_CLOAD_PARMS: + LD HL,(HIMEM) + EX DE,HL + LD HL,(TOP) + RST CPDEHL + RET C + EX DE,HL + LD HL,(PRLEN) + ADD HL,DE + EX DE,HL + LD HL,MAXRAM + RST $38 + LD B,H + RST CPDEHL + LD HL,(TOP) + RET + +; This entry point is used by the routine at GET_DEVICE. +CLOADM_7: + LD DE,TOP +CLOADM_8: + LD B,$06 + +; Move memory pointed to by HL to the memory pointed to by DE for B number of +; bytes. +; +; Used by the routines at RAM_INPUT, GET_DAY, CHGDSP, TXT_CTL_L, LOAD_BA_LBL, +; SET_CLOCK_HL and BOOT. +LDIR_B: + LD A,(HL) + LD (DE),A + INC HL + INC DE + DEC B + JP NZ,LDIR_B + RET + +; This entry point is used by the routine at GET_DEVICE. +LDIR_B_0: + CALL CLOADM_7 + PUSH HL + CALL _CLOAD_PARMS + JP C,CLOAD_STOP + EX DE,HL + LD HL,(PRLEN) + LD B,H + LD C,L + POP HL + CALL _LDIR + LD HL,(EXE) + LD A,H + OR L + LD (LASTCALL),HL + CALL NZ,PIVOTCALL + JP __MENU + +CLOAD_STOP: + CALL __BEEP + JP __MENU + +CVERIFYM: + RST CHRGTB ; Gets next character (or token) from BASIC text. + CALL __NAME_1 + CALL GETWORD_279 + PUSH HL + CALL $2A12 + CALL CAS_OPNI_CO_10 + LD HL,(PRLEN) + EX DE,HL + LD HL,(TOP) + CALL GETWORD_272 + JP NZ,VERIFY_ERROR + CALL CTOFF + POP HL + RET + +; This entry point is used by the routine at LOAD_RECORD. +GETWORD_272: + LD C,$00 +GETWORD_273: + CALL CASIN + CP (HL) + RET NZ + INC HL + DEC DE + LD A,D + OR E + JP NZ,GETWORD_273 + CALL CASIN + LD A,C + AND A + RET +GETWORD_274: + DEC HL +CAS_OPNI_BA: + RST CHRGTB ; Gets next character (or token) from BASIC text. + JP NZ,GETWORD_277 + LD B,$06 + LD DE,FILNAM + LD A,' ' +GETWORD_276: + LD (DE),A + INC DE + DEC B + JP NZ,GETWORD_276 + JP GETWORD_278 + +GETWORD_277: + CALL FILE_PARMS + JP NZ,GETWORD_279 + +GETWORD_278: + LD D,$FD +GETWORD_279: + LD A,D + CP $FD + JP NZ,FCERR + RET + +CAS_OPNO_DO: + LD A,$9C ; DO type + + defb $01 ; LD BC,NN + +; CAS open for output for Command files +; +; Used by the routine at CSAVEM. +; LD BC,$D03E + +CAS_OPNO_CO: + LD A,$D0 ; CO type + PUSH AF + CALL IOOPRND_0 + POP AF + CALL CSOUT + LD C,$00 + LD HL,FILNAM + LD DE,$0602 ; D=6, E=2 +CAS_OPNO_CO_0: + LD A,(HL) + CALL CSOUT + INC HL + DEC D + JP NZ,CAS_OPNO_CO_0 + LD HL,TOP + LD D,$0A ; 10 + DEC E + JP NZ,CAS_OPNO_CO_0 +CAS_OPNO_CO_1: + LD A,C + CPL + INC A + CALL CSOUT + LD B,$14 ; 20 +CAS_OPNO_CO_2: + XOR A + CALL CSOUT + DEC B + JP NZ,CAS_OPNO_CO_2 + JP CTOFF + +CAS_OPNO_CO_3: + CALL IOOPRND_0 + LD A,$8D + JP CSOUT + +GETWORD_285: + LD B,$09 +GETWORD_286: + CALL CASIN + CP $D3 + RET NZ + DEC B + JP NZ,GETWORD_286 + RET +GETWORD_287: + LD B,$06 + LD HL,FILNM2 +GETWORD_288: + CALL CASIN + LD (HL),A + INC HL + DEC B + JP NZ,GETWORD_288 +GETWORD_289: + LD HL,FILNAM + LD B,$06 + LD A,' ' +GETWORD_290: + CP (HL) + JP NZ,GETWORD_291 + INC HL + DEC B + JP NZ,GETWORD_290 + RET +GETWORD_291: + LD HL,FILNAM + LD DE,FILNM2 + LD B,$06 +GETWORD_292: + LD A,(DE) + AND A + JP NZ,GETWORD_293 + LD A,' ' +GETWORD_293: + CP (HL) + RET NZ + INC DE + INC HL + DEC B + JP NZ,GETWORD_292 + RET +GETWORD_294: + LD B,$D3 + LD DE,$9C06 + LD DE,$D006 + PUSH BC +GETWORD_295: + CALL GETWORD_298 + JP NZ,GETWORD_296 + CALL GETWORD_285 + JP NZ,GETWORD_295 + CALL GETWORD_287 + JP NZ,GETWORD_297 + LD A,$D3 +GETWORD_296: + POP BC + CP B + JP Z,CAS_OPNI_CO_12 + PUSH BC +GETWORD_297: + CALL FNBAR_IF_NZ4 + CALL CONSOLE_CRLF + JP GETWORD_295 +GETWORD_298: + CALL HEADER + CALL CASIN + CP $D3 + RET Z + CP $9C + JP Z,GETWORD_299 + CP $D0 + JP NZ,GETWORD_298 +GETWORD_299: + PUSH AF + LD HL,FILNM2 + LD DE,$0602 + LD C,$00 +FNBAR_IF_NZ0: + CALL CASIN + LD (HL),A + INC HL + DEC D + JP NZ,FNBAR_IF_NZ0 + LD HL,TOP + LD D,$0A + DEC E + JP NZ,FNBAR_IF_NZ0 + CALL CASIN + LD A,C + AND A + JP NZ,FNBAR_IF_NZ2 + CALL CTOFF + CALL GETWORD_289 + JP NZ,FNBAR_IF_NZ1 + POP AF + AND A + RET + +FNBAR_IF_NZ1: + CALL FNBAR_IF_NZ4 + CALL CONSOLE_CRLF +FNBAR_IF_NZ2: + POP AF + JP GETWORD_298 +CAS_OPNI_CO_10: + CALL HEADER + CALL CASIN + CP $8D + JP NZ,HEADER_0 + RET + +FNBAR_IF_NZ4: + LD DE,$2AC6 + JP FNBAR_IF_NZ6 +CAS_OPNI_CO_12: + LD DE,$2ABF +FNBAR_IF_NZ6: + LD HL,(CURLIN) + INC HL + LD A,H + OR L + RET NZ + EX DE,HL + CALL PRINT_LINE + XOR A + LD (FILNM2+6),A + LD HL,FILNM2 + CALL PRS + LD A,$0D + LD HL,CSRY + SUB (HL) + RET C + RET Z + LD B,A + LD A,' ' +FNBAR_IF_NZ7: + RST OUTC + DEC B + JP NZ,FNBAR_IF_NZ7 + RET + + +FOUND_MSG: + DEFM "Found:" + DEFB $00 + +SKIP_MSG: + DEFM "Skip :" + DEFB $00 + + +EVAL_STR: + CALL GETSTR + LD A,(HL) + INC HL + LD C,(HL) + INC HL + LD B,(HL) + POP DE + PUSH BC + PUSH AF + CALL GSTRDE + POP AF + LD D,A + LD E,(HL) + INC HL + LD C,(HL) + INC HL + LD B,(HL) + POP HL +EVAL_STR_0: + LD A,E + OR D +EVAL_STR_1: + RET Z + LD A,D + SUB $01 + RET C + XOR A + CP E + INC A + RET NC + DEC D + DEC E + LD A,(BC) + INC BC + CP (HL) + INC HL + JP Z,EVAL_STR_0 + CCF + JP EVAL_RESULT + +; STR BASIC function entry +__STR_S: + CALL FOUT + CALL CRTST + CALL GSTRCU + +; Save string in string area +SAVSTR: + LD BC,TOPOOL + PUSH BC +; This entry point is used by the routine at __DATA. +SAVSTR_0: + LD A,(HL) + INC HL + PUSH HL + CALL TESTR + POP HL + LD C,(HL) + INC HL + LD B,(HL) + CALL CRTMST ; Make temporary string + PUSH HL + LD L,A + CALL TOSTRA + POP DE + RET + +; This entry point is used by the routines at GSTRDE and SCPTLP. +MK_1BYTE_TMST: + LD A,$01 + +; Make temporary string +; +; Used by the routines at GETWORD, CONCAT, TOPOOL and SCPTLP. +MKTMST: + CALL TESTR + +; Create temporary string entry +; +; Used by the routines at SAVSTR, DTSTR and TOPOOL. +CRTMST: + LD HL,TMPSTR + PUSH HL + LD (HL),A + INC HL + LD (HL),E + INC HL + LD (HL),D + POP HL + RET + +; Create String +; +; Used by the routines at __DATA, __STR_S and PRS. +CRTST: + DEC HL + +; Create quote terminated String +; +; Used by the routines at __DATA and OPRND. +QTSTR: + LD B,$22 +; This entry point is used by the routines at __DATA and SCPTLP. +QTSTR_0: + LD D,B + +; Create String, termination char in D +; +; Used by the routine at __DATA. +DTSTR: + PUSH HL + LD C,$FF +DTSTR_0: + INC HL + LD A,(HL) + INC C + OR A + JP Z,DTSTR_1 + CP D + JP Z,DTSTR_1 + CP B + JP NZ,DTSTR_0 +DTSTR_1: + CP '"' + CALL Z,_CHRGTB + EX (SP),HL + INC HL + EX DE,HL + LD A,C + CALL CRTMST ; Make temporary string + +; Temporary string to pool +; +; Used by the routines at GETWORD, CONCAT, TOPOOL and SCPTLP. +TSTOPL: + LD DE,TMPSTR + LD A,$D5 + LD HL,(TEMPPT) + LD (DBL_FPREG),HL + LD A,$03 + LD (VALTYP),A + CALL FP2HL + LD DE,FRETOP + RST CPDEHL + LD (TEMPPT),HL + POP HL + LD A,(HL) + RET NZ + LD DE,CHRGTB + JP ERROR + +; Print number string +PRNUMS: + INC HL + +; Create string entry and print it +; +; Used by the routines at SNERR, __DATA, GETWORD, _DBL_ASCTFP, ISFLIO, SCPTLP and +; GET_DEVICE. +PRS: + CALL CRTST + +; Print string at HL +; +; Used by the routine at __DATA. +PRS1: + CALL GSTRCU + CALL LOADFP_0 + INC D +PRS1_0: + DEC D + RET Z + LD A,(BC) + RST OUTC + CP $0D + CALL Z,SCPTLP_46 + INC BC + JP PRS1_0 + +; Test if enough room for string +; +; Used by the routines at SAVSTR, MKTMST and TOPOOL. +TESTR: + OR A + LD C,$F1 + PUSH AF + LD HL,(STKTOP) + EX DE,HL + LD HL,(FRETOP) + CPL + LD C,A + LD B,$FF + ADD HL,BC + INC HL + RST CPDEHL + JP C,TESTR_1 + LD (FRETOP),HL + INC HL + EX DE,HL +; This entry point is used by the routine at MAKINT. +TESTR_0: + POP AF + RET +TESTR_1: + POP AF + LD DE,$000E + JP Z,ERROR + CP A + PUSH AF + LD BC,$2B8B + PUSH BC +; This entry point is used by the routine at MIDNUM. +TESTR_2: + LD HL,(MEMSIZ) +TESTR_3: + LD (FRETOP),HL + LD HL,$0000 + PUSH HL + LD HL,(ARREND) + PUSH HL + LD HL,TEMPST + EX DE,HL + LD HL,(TEMPPT) + EX DE,HL + RST CPDEHL + LD BC,$2BC3 + JP NZ,TESTR_9 + LD HL,PRMPRV + LD ($FB15),HL + LD HL,(VAREND) + LD ($FB12),HL + LD HL,(PROGND) +TESTR_4: + EX DE,HL + LD HL,($FB12) + EX DE,HL + RST CPDEHL + JP Z,TESTR_6 + LD A,(HL) + INC HL + INC HL + INC HL + CP $03 + JP NZ,TESTR_5 + CALL TESTR_10 + XOR A +TESTR_5: + LD E,A + LD D,$00 + ADD HL,DE + JP TESTR_4 +TESTR_6: + LD HL,($FB15) + LD E,(HL) + INC HL + LD D,(HL) + LD A,D + OR E + LD HL,(VAREND) + JP Z,TESTR_8 + EX DE,HL + LD ($FB15),HL + INC HL + INC HL + LD E,(HL) + INC HL + LD D,(HL) + INC HL + EX DE,HL + ADD HL,DE + LD ($FB12),HL + EX DE,HL + JP TESTR_4 +TESTR_7: + POP BC +TESTR_8: + EX DE,HL + LD HL,(ARREND) + EX DE,HL + RST CPDEHL + JP Z,TESTR_11 + LD A,(HL) + INC HL + CALL LOADFP + PUSH HL + ADD HL,BC + CP $03 + JP NZ,TESTR_7 + LD (TEMP8),HL + POP HL + LD C,(HL) + LD B,$00 + ADD HL,BC + ADD HL,BC + INC HL + EX DE,HL + LD HL,(TEMP8) + EX DE,HL + RST CPDEHL + JP Z,TESTR_8 + LD BC,$2C3C +TESTR_9: + PUSH BC +TESTR_10: + XOR A + OR (HL) + INC HL + LD E,(HL) + INC HL + LD D,(HL) + INC HL + RET Z + LD B,H + LD C,L + LD HL,(FRETOP) + RST CPDEHL + LD H,B + LD L,C + RET C + POP HL + EX (SP),HL + RST CPDEHL + EX (SP),HL + PUSH HL + LD H,B + LD L,C + RET NC + POP BC + POP AF + POP AF + PUSH HL + PUSH DE + PUSH BC + RET +TESTR_11: + POP DE + POP HL + LD A,H + OR L + RET Z + DEC HL + LD B,(HL) + DEC HL + LD C,(HL) + PUSH HL + DEC HL + LD L,(HL) + LD H,$00 + ADD HL,BC + LD D,B + LD E,C + DEC HL + LD B,H + LD C,L + LD HL,(FRETOP) + CALL __POS_2 + POP HL + LD (HL),C + INC HL + LD (HL),B + LD H,B + LD L,C + DEC HL + JP TESTR_3 + +; String concatenation +; +; Used by the routine at EVAL_04. +CONCAT: + PUSH BC + PUSH HL + LD HL,(DBL_FPREG) + EX (SP),HL + CALL OPRND + EX (SP),HL + CALL TSTSTR + LD A,(HL) + PUSH HL + LD HL,(DBL_FPREG) + PUSH HL + ADD A,(HL) + LD DE,$000F ; Err $0F - "String too long" + JP C,ERROR + CALL MKTMST + POP DE + CALL GSTRDE + EX (SP),HL + CALL GSTRHL + PUSH HL + LD HL,(TMPSTR) + EX DE,HL + CALL SSTSA + CALL SSTSA + LD HL,EVAL2 + EX (SP),HL + PUSH HL + JP TSTOPL + +; Move string on stack to string area +; +; Used by the routine at CONCAT. +SSTSA: + POP HL + EX (SP),HL + LD A,(HL) + INC HL + LD C,(HL) + INC HL + LD B,(HL) + LD L,A + +; Move string in BC, (len in L) to string area +; +; Used by the routines at SAVSTR and TOPOOL. +TOSTRA: + INC L + +; TOSTRA loop +TSALP: + DEC L + RET Z + LD A,(BC) + LD (DE),A + INC BC + INC DE + JP TSALP + +; Get string pointed by FPREG 'Type Error' if it is not +; +; Used by the routines at GETWORD, GSTRDE, MIDNUM and SCPTLP. +GETSTR: + CALL TSTSTR + +; Get string pointed by FPREG +; +; Used by the routines at __STR_S, PRS1 and MIDNUM. +GSTRCU: + LD HL,(DBL_FPREG) + +; Get string pointed by HL +; +; Used by the routines at CONCAT, MIDNUM and SCPTLP. +GSTRHL: + EX DE,HL + +; Get string pointed by DE +; +; Used by the routines at GETWORD, CONCAT and TOPOOL. +GSTRDE: + CALL BAKTMP + EX DE,HL + RET NZ + PUSH DE + LD D,B + LD E,C + DEC DE + LD C,(HL) + LD HL,(FRETOP) + RST CPDEHL + JP NZ,GSTRDE_0 + LD B,A + ADD HL,BC + LD (FRETOP),HL +GSTRDE_0: + POP HL + RET +; This entry point is used by the routine at __DATA. +BAKTMP: + LD HL,(TEMPPT) + DEC HL + LD B,(HL) + DEC HL + LD C,(HL) + DEC HL + RST CPDEHL +; This entry point is used by the routine at TOPOOL. +GSTRDE_2: + RET NZ + LD (TEMPPT),HL + RET + +__LEN: + LD BC,UNSIGNED_RESULT_A + PUSH BC +; This entry point is used by the routines at __ASC and __VAL. +__LEN_0: + CALL GETSTR + XOR A + LD D,A + LD A,(HL) + OR A + RET + +__ASC: + LD BC,UNSIGNED_RESULT_A + PUSH BC +; This entry point is used by the routine at FN_STRING. +__ASC_0: + CALL __LEN_0 + JP Z,FCERR + INC HL + LD E,(HL) + INC HL + LD D,(HL) + LD A,(DE) + RET + +__CHR_S: + CALL MK_1BYTE_TMST + CALL MAKINT +; This entry point is used by the routine at SCPTLP. +__CHR_S_0: + LD HL,(TMPSTR) + LD (HL),E + +; Save in string pool +TOPOOL: + POP BC + JP TSTOPL +; This entry point is used by the routine at OPRND. +TOPOOL_0: + RST CHRGTB ; Gets next character (or token) from BASIC text. + RST SYNCHR ; Check syntax: next byte holds the byte to be found + JR Z,GSTRDE_2 + EX (SP),HL + INC DE + PUSH DE + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + CALL EVAL + RST SYNCHR ; Check syntax: next byte holds the byte to be found + ADD HL,HL + EX (SP),HL + PUSH HL + RST GETYPR ; Get the number type (FAC) + JP Z,TOPOOL_1 + CALL MAKINT + JP TOPOOL_2 +TOPOOL_1: + CALL __ASC_0 +TOPOOL_2: + POP DE + CALL TOPOOL_3 + +__SPACE_S + CALL MAKINT + LD A,' ' +TOPOOL_3: + PUSH AF + LD A,E + CALL MKTMST + LD B,A + POP AF + INC B + DEC B + JP Z,TOPOOL + LD HL,(TMPSTR) +__SPACE_S_1: + LD (HL),A + INC HL + DEC B + JP NZ,__SPACE_S_1 + JP TOPOOL + +__LEFT_S: + CALL LFRGNM + XOR A +__LEFT_S_0: + EX (SP),HL + LD C,A + +__LEFT_S_1: + LD A,$E5 + ;; __LEFT_S_1+1: PUSH HL + + PUSH HL + LD A,(HL) + CP B + JP C,$2D7C + LD A,B + LD DE,$000E + PUSH BC + CALL TESTR + POP BC + POP HL + PUSH HL + INC HL + LD B,(HL) + INC HL + LD H,(HL) + LD L,B + LD B,$00 + ADD HL,BC + LD B,H + LD C,L + CALL CRTMST ; Make temporary string + LD L,A + CALL TOSTRA + POP DE + CALL GSTRDE + JP TSTOPL + +__RIGHT_S: + CALL LFRGNM + POP DE + PUSH DE + LD A,(DE) + SUB B + JP __LEFT_S_0 +__MID_S: + EX DE,HL + LD A,(HL) + CALL MIDNUM + INC B + DEC B + JP Z,FCERR + PUSH BC + LD E,$FF + CP ')' + JP Z,__MID_S_1 + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + CALL GETINT +__MID_S_1: + RST SYNCHR ; Check syntax: next byte holds the byte to be found + ADD HL,HL + POP AF + EX (SP),HL + LD BC,$2D74 + PUSH BC + DEC A + CP (HL) + LD B,$00 + RET NC + LD C,A + LD A,(HL) + SUB C + CP E + LD B,A + RET C + LD B,E + RET + +__VAL: + CALL __LEN_0 + JP Z,UNSIGNED_RESULT_A + LD E,A + INC HL + LD A,(HL) + INC HL + LD H,(HL) + LD L,A + PUSH HL + ADD HL,DE + LD B,(HL) + LD (VLZADR),HL + LD A,B + LD (VLZDAT),A + LD (HL),D + EX (SP),HL + PUSH BC + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + CALL DBL_DBL_ASCTFP + LD HL,$0000 + LD (VLZADR),HL + POP BC + POP HL + LD (HL),B + RET + +; number in program listing and check for ending ')' +; +; Used by the routine at TOPOOL. +LFRGNM: + EX DE,HL + RST SYNCHR ; Check syntax: next byte holds the byte to be found + ADD HL,HL + +; Get number in program listing +; +; Used by the routine at TOPOOL. +MIDNUM: + POP BC + POP DE + PUSH BC + LD B,E + RET + +; This entry point is used by the routine at OPRND. +FN_INSTR: + RST CHRGTB ; Gets next character (or token) from BASIC text. + CALL OPNPAR + RST GETYPR ; Get the number type (FAC) + LD A,$01 + PUSH AF + JP Z,FN_INSTR_0 ; JP if string type + POP AF + CALL MAKINT + OR A + JP Z,FCERR + PUSH AF + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + CALL EVAL + CALL TSTSTR +FN_INSTR_0: + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + PUSH HL + LD HL,(DBL_FPREG) + EX (SP),HL + CALL EVAL + RST SYNCHR ; Check syntax: next byte holds the byte to be found + ADD HL,HL + PUSH HL + CALL GETSTR + EX DE,HL + POP BC + POP HL + POP AF + PUSH BC + LD BC,POPHLRT ; (POP HL / RET) + PUSH BC + LD BC,UNSIGNED_RESULT_A + PUSH BC + PUSH AF + PUSH DE + CALL GSTRHL + POP DE + POP AF + LD B,A + DEC A + LD C,A + CP (HL) + LD A,$00 + RET NC + LD A,(DE) + OR A + LD A,B + RET Z + LD A,(HL) + INC HL + LD B,(HL) + INC HL + LD H,(HL) + LD L,B + LD B,$00 + ADD HL,BC + SUB C + LD B,A + PUSH BC + PUSH DE + EX (SP),HL + LD C,(HL) + INC HL + LD E,(HL) + INC HL + LD D,(HL) + POP HL +FN_INSTR_2: + PUSH HL + PUSH DE + PUSH BC +FN_INSTR_3: + LD A,(DE) + CP (HL) + JP NZ,FN_INSTR_6 + INC DE + DEC C + JP Z,FN_INSTR_5 + INC HL + DEC B + JP NZ,FN_INSTR_3 + POP DE + POP DE + POP BC +FN_INSTR_4: + POP DE + XOR A + RET + +FN_INSTR_5: + POP HL + POP DE + POP DE + POP BC + LD A,B + SUB H + ADD A,C + INC A + RET + +FN_INSTR_6: + POP BC + POP DE + POP HL + INC HL + DEC B + JP NZ,FN_INSTR_2 + JP FN_INSTR_4 + +__FRE: + LD HL,(ARREND) + EX DE,HL + LD HL,$0000 + ADD HL,SP + RST GETYPR ; Get the number type (FAC) + JP NZ,IMP + CALL GSTRCU + CALL TESTR_2 + EX DE,HL + LD HL,(STKTOP) + EX DE,HL + LD HL,(FRETOP) + JP IMP +; This entry point is used by the routine at _DBL_ASCTFP. +MIDNUM_7: + CALL FP_ARG2HL + LD HL,$3CE2 + CALL LOADFP_7 + CALL DECADD + RET +; This entry point is used by the routine at _DBL_ASCTFP. +MIDNUM_8: + LD HL,HALF +; This entry point is used by the routines at __RND and CHKSTK. +MIDNUM_9: + CALL LOADFP + JP FADD + CALL LOADFP + +; Subtract BCDE from FP reg +; +; Used by the routines at EXP and __RND. +FSUB: + CALL INVSGN + +; Add BCDE to FP reg +; +; Used by the routines at GETWORD, MIDNUM, __LOG, MLSP10, _DBL_ASCTFP, EXP and +; __RND. +FADD: + LD A,B + OR A + RET Z + LD A,(FACCU) + OR A + JP Z,FPBCDE + SUB B + JP NC,FADD_0 + CPL + INC A + EX DE,HL + CALL STAKI + EX DE,HL + CALL FPBCDE + POP BC + POP DE +FADD_0: + CP $19 + RET NC + PUSH AF + CALL LOADFP_5 + LD H,A + POP AF + CALL COMPL_0 + LD A,H + OR A + LD HL,DBL_FPREG + JP P,FADD_1 + CALL PLUCDE + JP NC,BNORM_8 + INC HL + INC (HL) + JP Z,$057D + LD L,$01 + CALL SCALE_2 + JP BNORM_8 + +FADD_1: + XOR A + SUB B + LD B,A + LD A,(HL) + SBC A,E + LD E,A + INC HL + LD A,(HL) + SBC A,D + LD D,A + INC HL + LD A,(HL) + SBC A,C + LD C,A +; This entry point is used by the routines at FLGREL and INT. +FADD_2: + CALL C,COMPL + +; Normalise number +; +; Used by the routine at __RND. +BNORM: + LD L,B + LD H,E + XOR A +BNORM_0: + LD B,A + LD A,C + OR A + JP NZ,BNORM_6 + LD C,D + LD D,H + LD H,L + LD L,A + LD A,B + SUB $08 + CP $E0 + JP NZ,BNORM_0 + +; This entry point is used by the routines at DIV, DECADD, DBL_DBL_ASCTFP and EXP. +CLEAR_EXPONENT: + XOR A +; This entry point is used by the routine at POWER. +SET_EXPONENT: + LD (FACCU),A + RET + +BNORM_3: + LD A,H + OR L + OR D + JP NZ,BNORM_5 + LD A,C +BNORM_4: + DEC B + RLA + JP NC,BNORM_4 + INC B + RRA + LD C,A + JP DECROU + +BNORM_5: + DEC B + ADD HL,HL + LD A,D + RLA + LD D,A + LD A,C + ADC A,A + LD C,A +BNORM_6: + JP P,BNORM_3 + + +; Single precision rounding +DECROU: + LD A,B + LD E,H + LD B,L + OR A + JP Z,BNORM_8 + LD HL,FACCU + ADD A,(HL) + LD (HL),A + JP NC,CLEAR_EXPONENT + JP Z,CLEAR_EXPONENT + +; This entry point is used by the routines at FADD and FCOMP. +BNORM_8: + LD A,B +; This entry point is used by the routines at DIV and GET_DEVICE. +BNORM_9: + LD HL,FACCU + OR A + CALL M,CLEAR_EXPONENT0 + LD B,(HL) + INC HL + LD A,(HL) + AND $80 + XOR C + LD C,A + JP FPBCDE + +; This entry point is used by the routine at FPINT. +CLEAR_EXPONENT0: + INC E + RET NZ + INC D + RET NZ + INC C + RET NZ + LD C,$80 + INC (HL) + RET NZ + JP $057D + +; Add number pointed by HL to CDE +; +; Used by the routines at FADD and _DBL_ASCTFP. +PLUCDE: + LD A,(HL) + ADD A,E + LD E,A + INC HL + LD A,(HL) + ADC A,D + LD D,A + INC HL + LD A,(HL) + ADC A,C + LD C,A + RET + +; Convert a negative number to positive +; +; Used by the routines at FADD and FPINT. +COMPL: + LD HL,SGNRES + LD A,(HL) + CPL + LD (HL),A + XOR A + LD L,A + SUB B + LD B,A + LD A,L + SBC A,E + LD E,A + LD A,L + SBC A,D + LD D,A + LD A,L + SBC A,C + LD C,A + RET +; This entry point is used by the routines at FADD and FPINT. +COMPL_0: + LD B,$00 +COMPL_1: + SUB $08 + JP C,SHRITE + LD B,E + LD E,D + LD D,C + LD C,$00 + JP COMPL_1 + +; Shift right number in BCDE +; +; Used by the routine at COMPL. +SHRITE: + ADD A,$09 + +; Scale number in BCDE for A exponent (bits) +SCALE: + ADD HL,BC + LD L,A + LD A,D + OR E + OR B + JP NZ,SCALE_1 + LD A,C +SCALE_0: + DEC L + RET Z + RRA + LD C,A + JP NC,SCALE_0 + JP SCALE_3 +SCALE_1: + XOR A + DEC L + RET Z + LD A,C +; This entry point is used by the routine at FADD. +SCALE_2: + RRA + LD C,A +SCALE_3: + LD A,D + RRA + LD D,A + LD A,E + RRA + LD E,A + LD A,B + RRA + LD B,A + JP SCALE_1 + NOP + NOP + NOP + ADD A,C + INC B + SBC A,D + RST TSTSGN + ADD HL,DE + ADD A,E + INC H + LD H,E + LD B,E + ADD A,E + LD (HL),L + CALL CALLHL5 + XOR C + LD A,A + ADD A,E + ADD A,D + INC B + NOP + NOP + NOP + ADD A,C + JP PO,$4DB0 + ADD A,E + LD A,(BC) + LD (HL),D + LD DE,$F483 + INC B + DEC (HL) + LD A,A + +; LOG +; +; Used by the routine at POWER. +__LOG: + RST TSTSGN + OR A + JP PE,FCERR + CALL __LOG_0 + LD BC,$8031 + LD DE,$7218 + JP FMULT_BCDE +__LOG_0: + CALL BCDEFP + LD A,$80 + LD (FACCU),A + XOR B + PUSH AF + CALL STAKI + LD HL,$2FDA + CALL EXP_5 + POP BC + POP HL + CALL STAKI + EX DE,HL + CALL FPBCDE + LD HL,$2FEB + CALL EXP_5 + POP BC + POP DE + CALL FDIV + POP AF + CALL STAKI + CALL FLGREL + POP BC + POP DE + JP FADD + +; Multiply BCDE to FP reg +; +; Used by the routines at __LOG, IMULT, EXP and __RND. +FMULT_BCDE: + RST TSTSGN + RET Z + LD L,$00 + CALL DIV_5 + LD A,C + LD ($FB5E),A + EX DE,HL + LD ($FB5F),HL + LD BC,$0000 + LD D,B + LD E,B + LD HL,BNORM + PUSH HL + LD HL,$3060 + PUSH HL + PUSH HL + LD HL,DBL_FPREG + LD A,(HL) + INC HL + OR A + JP Z,FMULT_BCDE_4 + PUSH HL + LD L,$08 +FMULT_BCDE_0: + RRA + LD H,A + LD A,C + JP NC,FMULT_BCDE_1 + PUSH HL + LD HL,($FB5F) + ADD HL,DE + EX DE,HL + POP HL + LD A,($FB5E) + ADC A,C +FMULT_BCDE_1: + RRA + LD C,A + LD A,D + RRA + LD D,A + LD A,E + RRA + LD E,A + LD A,B + RRA + LD B,A + AND $10 + JP Z,FMULT_BCDE_2 + LD A,B + OR $20 + LD B,A +FMULT_BCDE_2: + DEC L + LD A,H + JP NZ,FMULT_BCDE_0 + +; This entry point is used by the routines at DIV and SCPTLP. +POPHLRT: + POP HL + RET + +FMULT_BCDE_4: + LD B,E + LD E,D + LD D,C + LD C,A + RET + +; Divide FP by 10 +; +; Used by the routine at _DBL_ASCTFP. +DIV10: + CALL STAKI + LD HL,$3681 + CALL PHLTFP + +; Divide FP by number on stack +; +; Used by the routines at EVAL_04 and __TAN. +DIV: + POP BC + POP DE +; This entry point is used by the routines at __LOG and __POS. +FDIV: + RST TSTSGN + JP Z,OERR + LD L,$FF + CALL DIV_5 + INC (HL) + JP Z,$057D + INC (HL) + JP Z,$057D + DEC HL + LD A,(HL) + LD ($F41F),A + DEC HL + LD A,(HL) + LD ($F41B),A + DEC HL + LD A,(HL) + LD ($F417),A + LD B,C + EX DE,HL + XOR A + LD C,A + LD D,A + LD E,A + LD ($F422),A +DIV_1: + PUSH HL + PUSH BC + LD A,L + CALL TEL_TERM_012 + SBC A,$00 + CCF + JP NC,$30E1 + LD ($F422),A + POP AF + POP AF + SCF + JP NC,GET_DEVICE_692 + LD A,C + INC A + DEC A + RRA + JP P,DIV_3 + RLA + LD A,($F422) + RRA + AND $C0 + PUSH AF + LD A,B + OR H + OR L + JP Z,DIV_2 + LD A,' ' +DIV_2: + POP HL + OR H + JP BNORM_9 + +DIV_3: + RLA + LD A,E + RLA + LD E,A + LD A,D + RLA + LD D,A + LD A,C + RLA + LD C,A + ADD HL,HL + LD A,B + RLA + LD B,A + LD A,($F422) + RLA + LD ($F422),A + LD A,C + OR D + OR E + JP NZ,DIV_1 + PUSH HL + LD HL,FACCU + DEC (HL) + POP HL + JP NZ,DIV_1 + JP CLEAR_EXPONENT + +; This entry point is used by the routine at DECADD. +DIV_4: + LD A,$FF + ;LD L,$AF + defb $2E ; LD L,nn (mask the next "XOR" instruction) + +; Routine at 12585 +; +; Used by the routine at DBL_ADD. +L3129: + XOR A + LD HL,DBL_LAST_FPREG + LD C,(HL) + INC HL + XOR (HL) + LD B,A + LD L,$00 +; This entry point is used by the routine at FMULT_BCDE. +DIV_5: + LD A,B + OR A + JP Z,DIV_8 + LD A,L + LD HL,FACCU + XOR (HL) + ADD A,B + LD B,A + RRA + XOR B + LD A,B + JP P,DIV_7 + ADD A,$80 + LD (HL),A + JP Z,POPHLRT + CALL LOADFP_5 + LD (HL),A +; This entry point is used by the routine at _DBL_ASCTFP. +DCXH_2: + DEC HL + RET + + RST TSTSGN + CPL + POP HL +DIV_7: + OR A +DIV_8: + POP HL + JP P,CLEAR_EXPONENT + JP $057D + +; Multiply number in FPREG by 10 +; +; Used by the routine at _DBL_ASCTFP. +MLSP10: + CALL BCDEFP + LD A,B + OR A + RET Z + ADD A,$02 + JP C,$057D + LD B,A + CALL FADD + LD HL,FACCU + INC (HL) + RET NZ + JP $057D + +; Test sign of FPREG +; +; Used by the routines at GETYPR, _TSTSGN and FCOMP. +TSTSGN: + LD A,(FACCU) + OR A + RET Z + LD A,(LAST_FPREG) + DEFB $FE ; CP 2Fh ..hides the "CPL" instruction +SGN_RESULT_CPL: + CPL + ; --- START PROC L2E78 --- +SGN_RESULT: + RLA + +; This entry point is used by the routines at GETWORD and FCOMP. +EVAL_RESULT: + SBC A,A + RET NZ + INC A + RET + +; CY and A to FP, & normalise +; +; Used by the routines at __LOG and _DBL_ASCTFP. +; CY and A to FP, & normalise +FLGREL: + LD B,$88 + LD DE,$0000 +; This entry point is used by the routines at HLPASS and DBL_ABS. +FLGREL_0: + LD HL,FACCU + LD C,A + LD (HL),B + LD B,$00 + INC HL + LD (HL),$80 + RLA + JP FADD_2 + +; ABS +__ABS: + CALL _TSTSGN + RET P +; This entry point is used by the routines at OPRND, FIX and _DBL_ASCTFP. +INVSGN: + RST GETYPR ; Get the number type (FAC) + JP M,DBL_ABS + JP Z,TMERR + +; Invert number sign +; +; Used by the routines at FSUB, FIX, IMULT, POWER, __RND and __POS. +INVSGN: + LD HL,LAST_FPREG + LD A,(HL) + XOR $80 + LD (HL),A + RET +__SGN: + CALL _TSTSGN + +; Get back from function, result in A (signed) +; +; Used by the routines at UCASE and GETWORD. +INT_RESULT_A: + LD L,A + RLA + SBC A,A + LD H,A + JP INT_RESULT_HL + +; Test sign in number +; +; Used by the routines at __DATA, __ABS, INVSGN and _DBL_ASCTFP. +_TSTSGN: + RST GETYPR ; Get the number type (FAC) + JP Z,TMERR + JP P,TSTSGN + LD HL,(DBL_FPREG) +; This entry point is used by the routine at __FOR. +_SGN_RESULT: + LD A,H + OR L + RET Z + LD A,H + JP SGN_RESULT + +; Put FP value on stack +; +; Used by the routines at EVAL_04, FADD, __LOG, DIV10, MLDEBC, IMULT, _DBL_ASCTFP, +; __SQR, EXP, __RND and __TAN. +STAKI: + EX DE,HL + LD HL,(DBL_FPREG) + EX (SP),HL + PUSH HL + LD HL,(LAST_FPREG) + EX (SP),HL + PUSH HL + EX DE,HL + RET + +; Number at HL to BCDE +; +; Used by the routines at DIV10, _DBL_ASCTFP, __SQR, EXP, __RND and CHKSTK. +PHLTFP: + CALL LOADFP + +; Move BCDE to FPREG +; +; Used by the routines at EVAL_04, FADD, BNORM, __LOG, _DBL_ASCTFP, EXP and __TAN. +FPBCDE: + EX DE,HL + LD (DBL_FPREG),HL + LD H,B + LD L,C + LD (LAST_FPREG),HL + EX DE,HL + RET + +; Load FP reg to BCDE +; +; Used by the routines at __FOR, EVAL_04, __LOG, MLSP10, FCOMP, FPINT, INT, +; _DBL_ASCTFP, POWER, EXP and __RND. +BCDEFP: + LD HL,DBL_FPREG + +; Load FP value pointed by HL to BCDE +; +; Used by the routines at TESTR, MIDNUM, PHLTFP, EXP, __RND and CHKSTK. +LOADFP: + LD E,(HL) + INC HL +; This entry point is used by the routine at PRS1. +LOADFP_0: + LD D,(HL) + INC HL + LD C,(HL) + INC HL + LD B,(HL) +; This entry point is used by the routines at SNERR, MAKINT and _DBL_ASCTFP. +INCHL: + INC HL + RET + +; This entry point is used by the routines at __RND and CHKSTK. +LOADFP_2: + LD DE,DBL_FPREG + LD B,$04 + JP REV_LDIR_B + +; Copy number value from HL to DE +VAL2DE: + EX DE,HL + +; This entry point is used by the routines at STEP, __LET, TSTOPL and INSTR. +; Copy number value from DE to HL +FP2HL: + LD A,(VALTYP) + LD B,A + +; Move the memory from (DE) to (HL) for B bytes +; +; Used by the routines at __IPL, ON_TIME_S, MAKTXT, __RND, L31CA, FAC1_HL and +; BOOT.REV_LDIR_B: + LD A,(DE) + LD (HL),A + INC DE + INC HL + DEC B + JP NZ,REV_LDIR_B + RET + +; This entry point is used by the routines at FADD, DIV, FCOMP, FPINT, INT +; and DECADD. +LOADFP_5: + LD HL,LAST_FPREG + LD A,(HL) + RLCA + SCF + RRA + LD (HL),A + CCF + RRA + INC HL + INC HL + LD (HL),A + LD A,C + RLCA + SCF + RRA + LD C,A + RRA + XOR (HL) + RET + +; This entry point is used by the routine at DECADD. +LOADFP_6: + LD HL,$FB2E +; This entry point is used by the routines at __FOR, OPRND, MIDNUM and _DBL_ASCTFP. +LOADFP_7: + LD DE,$31F2 + JP INCHL0 + +; This entry point is used by the routines at EVAL_04, MIDNUM, DECADD and +; _DBL_ASCTFP. +FP_ARG2HL: + LD HL,$FB2E +; This entry point is used by the routine at _DBL_ASCTFP. +LOADFP_9: + LD DE,FP2HL +INCHL0: + PUSH DE + LD DE,DBL_FPREG + RST GETYPR ; Get the number type (FAC) + RET C + LD DE,$FB24 + RET + +; Compare FP reg to BCDE +; +; Used by the routines at _DBL_ASCTFP, POWER, __RND and CHKSTK. +FCOMP: + LD A,B + OR A + JP Z,TSTSGN + LD HL,SGN_RESULT_CPL + PUSH HL + RST TSTSGN + LD A,C + RET Z + LD HL,LAST_FPREG + XOR (HL) + LD A,C + RET M + CALL FCOMP_1 + +XDCOMP_1: + RRA + XOR C + RET + +FCOMP_1: + INC HL + LD A,B + CP (HL) + RET NZ + DEC HL + LD A,C + CP (HL) + RET NZ + DEC HL + LD A,D + CP (HL) + RET NZ + DEC HL + LD A,E + SUB (HL) + RET NZ + POP HL + POP HL + RET + +; This entry point is used by the routine at CHKSTK. +ICOMP: + LD A,D + XOR H + LD A,H + JP M,SGN_RESULT + CP D + JP NZ,FCOMP_3 + LD A,L + SUB E + RET Z +FCOMP_3: + JP EVAL_RESULT + +; This entry point is used by the routine at _DBL_ASCTFP. +FCOMP_4: + LD HL,$FB2E + CALL FP2HL +XDCOMP: + LD DE,ARG + LD A,(DE) + OR A + JP Z,TSTSGN + LD HL,SGN_RESULT_CPL ; SGN_RESULT_CPL + PUSH HL + RST TSTSGN + DEC DE + LD A,(DE) + LD C,A + RET Z + LD HL,LAST_FPREG + XOR (HL) + LD A,C + RET M + INC DE + INC HL + LD B,$08 +XDCOMP_2: + LD A,(DE) + SUB (HL) + JP NZ,XDCOMP_1 + DEC DE + DEC HL + DEC B + JP NZ,XDCOMP_2 + POP BC + RET + +; Routine at 12951 +DECCOMP: + CALL XDCOMP + JP NZ,SGN_RESULT_CPL + RET + +; This entry point is used by the routines at __FOR, EVAL_04, UCASE and DEPINT. +__CINT: + RST GETYPR ; Get the number type (FAC) + LD HL,(DBL_FPREG) + RET M + JP Z,TMERR ; If string type, "Type mismatch" + CALL NC,FCOMP_14 + LD HL,$057D + PUSH HL +; This entry point is used by the routine at __INT. +FCOMP_7: + LD A,(FACCU) + CP $90 + JP NC,INT_RESULT_HL_2 + CALL FPINT + EX DE,HL + +;INT_RESULT_HL-1: + POP DE + +; This entry point is used by the routines at UCASE, INT_RESULT_A, INT, +; IMULT, DBL_ASCTFP and _DBL_ASCTFP. +INT_RESULT_HL: + LD (DBL_FPREG),HL + +; This entry point is used by the routine at DBL_ABS. +SETTYPE_INT: + LD A,$02 ; Integer type + +; This entry point is used by the routine at HLPASS. +SETTYPE: + LD (VALTYP),A + RET + +; This entry point is used by the routine at _DBL_ASCTFP. +INT_RESULT_HL_2: + LD BC,$9080 ; BCDE = -32768 (float) + LD DE,$0000 + CALL FCOMP + RET NZ + LD H,C ; BCDE = 32768 (float) + LD L,D + JP INT_RESULT_HL-1 + +; This entry point is used by the routines at __FOR, EVAL_04, UCASE, GETWORD, +; _DBL_ASCTFP and POWER. +__CSNG: + RST GETYPR ; Get the number type (FAC) + RET PO + JP M,INT_CSNG + JP Z,TMERR +FCOMP_14: + CALL BCDEFP + CALL $3310 + LD A,B + OR A + RET Z + CALL LOADFP_5 + LD HL,$FB27 + LD B,(HL) + JP BNORM_8 + +; This entry point is used by the routines at HLPASS and _DBL_ASCTFP. +INT_CSNG: + LD HL,(DBL_FPREG) +; This entry point is used by the routines at EVAL_04, MLDEBC and IMULT. +HL_CSNG: + CALL $3310 + +; Get back from function passing an INT value HL +HLPASS: + LD A,H + LD D,L + LD E,$00 + LD B,$90 + JP FLGREL_0 + +; This entry point is used by the routines at EVAL_04, INT and _DBL_ASCTFP. +__CDBL: + RST GETYPR ; Get the number type (FAC) + RET NC + JP Z,TMERR + CALL M,INT_CSNG +; This entry point is used by the routine at _DBL_ASCTFP. +ZERO_FACCU: + LD HL,$0000 + LD ($FB24),HL + LD ($FB26),HL +; This entry point is used by the routine at DBL_DBL_ASCTFP. +SETTYPE_DBL: + LD A,$08 + LD BC,$043E + JP SETTYPE + +; Test a string, 'Type Error' if it is not +; +; Used by the routines at __DATA, UCASE, CONCAT, GETSTR, MIDNUM and SCPTLP. +TSTSTR: + RST GETYPR ; Get the number type (FAC) + RET Z + JP TMERR + +; Floating Point to Integer +; +; Used by the routines at FCOMP, INT and _DBL_ASCTFP. +FPINT: + LD B,A + LD C,A + LD D,A + LD E,A + OR A + RET Z + PUSH HL + CALL BCDEFP + CALL LOADFP_5 + XOR (HL) + LD H,A + CALL M,DCBCDE + LD A,$98 + SUB B + CALL COMPL_0 + LD A,H + RLA + CALL C,CLEAR_EXPONENT0 + LD B,$00 + CALL C,COMPL + POP HL + RET + +; Decrement FP value in BCDE +; +; Used by the routine at FPINT. +DCBCDE: + DEC DE + LD A,D + AND E + INC A + RET NZ + DEC BC + RET + +; Double Precision to Integer conversion +FIX: + RST GETYPR ; Get the number type (FAC) + RET M + RST TSTSGN + JP P,__INT + CALL INVSGN + CALL __INT + JP INVSGN + +; INT (double precision BASIC variant) +; +; Used by the routine at FIX. +__INT: + RST GETYPR ; Get the number type (FAC) + RET M + JP NC,INT_0 + JP Z,TMERR + CALL FCOMP_7 + +; INT +; +; Used by the routines at POWER, EXP and __RND. +INT: + LD HL,FACCU + LD A,(HL) + CP $98 + LD A,(DBL_FPREG) + RET NC + LD A,(HL) + CALL FPINT + LD (HL),$98 + LD A,E + PUSH AF + LD A,C + RLA + CALL FADD_2 + POP AF + RET + +; This entry point is used by the routine at __INT. +INT_0: + LD HL,FACCU + LD A,(HL) + CP $90 + JP NZ,INT_3 + LD C,A + DEC HL + LD A,(HL) + XOR $80 + LD B,$06 +INT_1: + DEC HL + OR (HL) + DEC B + JP NZ,INT_1 + OR A + LD HL,$8000 + JP NZ,INT_2 + CALL INT_RESULT_HL + JP __CDBL + +INT_2: + LD A,C +INT_3: + OR A + RET Z + CP $B8 + RET NC +; This entry point is used by the routine at _DBL_ASCTFP. +INT_4: + PUSH AF + CALL BCDEFP + CALL LOADFP_5 + XOR (HL) + DEC HL + LD (HL),$B8 + PUSH AF + DEC HL + LD (HL),C + CALL M,INT_5 + LD A,(LAST_FPREG) + LD C,A + LD HL,LAST_FPREG + LD A,$B8 + SUB B + CALL DECADD_22 + POP AF + CALL M,DECADD_10 + XOR A + LD ($FB23),A + POP AF + RET NC + JP DECADD_3 +INT_5: + LD HL,$FB24 +INT_6: + LD A,(HL) + DEC (HL) + OR A + INC HL + JP Z,INT_6 + RET + +; Multiply DE by BC +; +; Used by the routine at SCPTLP. +MLDEBC: + PUSH HL + LD HL,$0000 + LD A,B + OR C + JP Z,MLDEBC_2 + LD A,$10 +MLDEBC_0: + ADD HL,HL + JP C,SBSCT_ERR + EX DE,HL + ADD HL,HL + EX DE,HL + JP NC,MLDEBC_1 + ADD HL,BC + JP C,SBSCT_ERR +MLDEBC_1: + DEC A + JP NZ,MLDEBC_0 +MLDEBC_2: + EX DE,HL + POP HL + RET + + +; Routine at 13303 +ISUB: + LD A,H + RLA + SBC A,A + LD B,A + CALL INT_DIV_6 + LD A,C + SBC A,B + JP IADD_0 + +; This entry point is used by the routine at CHKSTK. +IADD: + LD A,H + RLA + SBC A,A +IADD_0: + LD B,A + PUSH HL + LD A,D + RLA + SBC A,A + ADD HL,DE + ADC A,B + RRCA + XOR H + JP P,INT_RESULT_HL-1 + PUSH BC + EX DE,HL + CALL HL_CSNG + POP AF + POP HL + CALL STAKI + EX DE,HL + CALL DBL_ABS_1 + JP _DBL_ASCTFP_26 + +; Integer MULTIPLY +IMULT: + LD A,H + OR L + JP Z,INT_RESULT_HL + PUSH HL + PUSH DE + CALL INT_DIV_3 + PUSH BC + LD B,H + LD C,L + LD HL,$0000 + LD A,$10 +IMULT_0: + ADD HL,HL + JP C,L345B + EX DE,HL + ADD HL,HL + EX DE,HL + JP NC,IMULT_1 + ADD HL,BC + JP C,L345B +IMULT_1: + DEC A + JP NZ,IMULT_0 + POP BC + POP DE +IMULT_2: + LD A,H + OR A + JP M,IMULT_3 + POP DE + LD A,B + JP INT_DIV_5 + +IMULT_3: + XOR $80 + OR L + JP Z,IMULT_4 + EX DE,HL + LD BC,GET_DEVICE_692 + +; Routine at 13403 +; +; Used by the routine at INT_MUL. +L345B: + CALL HL_CSNG + POP HL + CALL STAKI + CALL HL_CSNG + POP BC + POP DE + JP FMULT_BCDE + +IMULT_4: + LD A,B + OR A + POP BC + JP M,INT_RESULT_HL + PUSH DE + CALL HL_CSNG + POP DE + JP INVSGN + +; This entry point is used by the routines at UCASE and DBL_ABS. +INT_DIV: + LD A,H + OR L + JP Z,OERR ; "Division by zero" + CALL INT_DIV_3 + PUSH BC + EX DE,HL + CALL INT_DIV_6 + LD B,H + LD C,L + LD HL,$0000 + LD A,$11 ; const + PUSH AF + OR A + JP INT_DIV_2 + +INT_DIV_0: + PUSH AF + PUSH HL + ADD HL,BC + JP NC,INT_DIV_1 + POP AF + SCF + ;LD A,$E1 + DEFB $3E ; "LD A,n" to Mask the next byte + +INT_DIV_1: + POP HL +INT_DIV_2: + LD A,E + RLA + LD E,A + LD A,D + RLA + LD D,A + LD A,L + RLA + LD L,A + LD A,H + RLA + LD H,A + POP AF + DEC A + JP NZ,INT_DIV_0 + EX DE,HL + POP BC + PUSH DE + JP IMULT_2 + +INT_DIV_3: + LD A,H + XOR D + LD B,A + CALL INT_DIV_4 + EX DE,HL +INT_DIV_4: + LD A,H +; This entry point is used by the routine at DBL_ABS. +INT_DIV_5: + OR A + JP P,INT_RESULT_HL +; This entry point is used by the routines at MLDEBC and DBL_ABS. +INT_DIV_6: + XOR A + LD C,A + SUB L + LD L,A + LD A,C + SBC A,H + LD H,A + JP INT_RESULT_HL + +; ABS (double precision BASIC variant) +; +; Used by the routine at __ABS. +DBL_ABS: + LD HL,(DBL_FPREG) + CALL INT_DIV_6 + LD A,H + XOR $80 + OR L + RET NZ +; This entry point is used by the routines at __FOR, OPRND and UCASE. +DBL_ABS_0: + EX DE,HL + CALL $3310 + XOR A +; This entry point is used by the routine at MLDEBC. +DBL_ABS_1: + LD B,$98 + JP FLGREL_0 + +; This entry point is used by the routine at UCASE. +IMOD: + PUSH DE + CALL INT_DIV + XOR A + ADD A,D + RRA + LD H,A + LD A,E + RRA + LD L,A + CALL SETTYPE_INT + POP AF + JP INT_DIV_5 + +; aka DECSUB, Double precision SUB (formerly FSUB) +DECSUB: + LD HL,DBL_LAST_FPREG + LD A,(HL) + XOR $80 + LD (HL),A + +; aka DECADD, Double precision ADD (formerly FADD) +; +; Used by the routines at MIDNUM and _DBL_ASCTFP. +DECADD: + LD HL,ARG + LD A,(HL) + OR A + RET Z + LD B,A + DEC HL + LD C,(HL) + LD DE,FACCU + LD A,(DE) + OR A + JP Z,LOADFP_6 + SUB B + JP NC,DECADD_1 + CPL + INC A + PUSH AF + LD C,$08 ; DBL number, 8 bytes + INC HL + PUSH HL +DECADD_0: + LD A,(DE) + LD B,(HL) + LD (HL),A + LD A,B + LD (DE),A + DEC DE + DEC HL + DEC C + JP NZ,DECADD_0 + POP HL + LD B,(HL) + DEC HL + LD C,(HL) + POP AF +DECADD_1: + CP $39 + RET NC + PUSH AF + CALL LOADFP_5 + LD HL,$FB2D + LD B,A + LD A,$00 + LD (HL),A + LD ($FB23),A + POP AF + LD HL,DBL_LAST_FPREG + CALL DECADD_22 + LD A,B + OR A + JP P,DECADD_2 + LD A,($FB2D) + LD ($FB23),A + CALL DECADD_12 + JP NC,DECADD_8 + EX DE,HL + INC (HL) + JP Z,$057D + CALL DECADD_31 + JP DECADD_8 +DECADD_2: + CALL DECADD_16 + LD HL,SGNRES + CALL C,DECADD_20 +; This entry point is used by the routine at INT. +DECADD_3: + XOR A +DECADD_4: + LD B,A + LD A,(LAST_FPREG) + OR A + JP NZ,DECADD_7 + LD HL,$FB23 + LD C,$08 +DECADD_5: + LD D,(HL) + LD (HL),A + LD A,D + INC HL + DEC C + JP NZ,DECADD_5 + LD A,B + SUB $08 + CP $C0 + JP NZ,DECADD_4 + JP CLEAR_EXPONENT + +DECADD_6: + DEC B + LD HL,$FB23 + CALL DECADD_32 + OR A +DECADD_7: + JP P,DECADD_6 + LD A,B + OR A + JP Z,DECADD_8 + LD HL,FACCU + ADD A,(HL) + LD (HL),A + JP NC,CLEAR_EXPONENT + RET Z +DECADD_8: + LD A,($FB23) +DECADD_9: + OR A + CALL M,DECADD_10 + LD HL,SGNRES + LD A,(HL) + AND $80 + DEC HL + DEC HL + XOR (HL) + LD (HL),A + RET + +; This entry point is used by the routine at INT. +DECADD_10: + LD HL,$FB24 + LD B,$07 +DECADD_11: + INC (HL) + RET NZ + INC HL + DEC B + JP NZ,DECADD_11 + INC (HL) + JP Z,$057D + DEC HL + LD (HL),$80 + RET +DECADD_12: + LD HL,$FB2E +; This entry point is used by the routine at _DBL_ASCTFP. +DECADD_13: + LD DE,$FB24 +DECADD_14: + LD C,$07 + XOR A +DECADD_15: + LD A,(DE) + ADC A,(HL) + LD (DE),A + INC DE + INC HL + DEC C + JP NZ,DECADD_15 + RET +DECADD_16: + LD HL,$FB2E +; This entry point is used by the routine at _DBL_ASCTFP. +DECADD_17: + LD DE,$FB24 +DECADD_18: + LD C,$07 + XOR A +DECADD_19: + LD A,(DE) + SBC A,(HL) + LD (DE),A + INC DE + INC HL + DEC C + JP NZ,DECADD_19 + RET +DECADD_20: + LD A,(HL) + CPL + LD (HL),A + LD HL,$FB23 + LD B,$08 + XOR A + LD C,A +DECADD_21: + LD A,C + SBC A,(HL) + LD (HL),A + INC HL + DEC B + JP NZ,DECADD_21 + RET +; This entry point is used by the routine at INT. +DECADD_22: + LD (HL),C + PUSH HL +DECADD_23: + SUB $08 + JP C,DECADD_27 + POP HL +DECADD_24: + PUSH HL + LD DE,$0800 +DECADD_25: + LD C,(HL) + LD (HL),E + LD E,C +DECADD_26: + DEC HL + DEC D + JP NZ,DECADD_25 + JP DECADD_23 +DECADD_27: + ADD A,$09 + LD D,A +DECADD_28: + XOR A + POP HL + DEC D + RET Z +DECADD_29: + PUSH HL + LD E,$08 +DECADD_30: + LD A,(HL) + RRA + LD (HL),A + DEC HL + DEC E + JP NZ,DECADD_30 + JP DECADD_28 +DECADD_31: + LD HL,LAST_FPREG + LD D,$01 + JP DECADD_29 +DECADD_32: + LD C,$08 +DECADD_33: + LD A,(HL) + RLA + LD (HL),A + INC HL + DEC C + JP NZ,DECADD_33 + RET + +; This entry point is used by the routine at _DBL_ASCTFP. +DECMUL: + RST TSTSGN + RET Z + LD A,(ARG) + OR A + JP Z,CLEAR_EXPONENT + CALL L3129 + CALL DECADD_41 + LD (HL),C + INC DE + LD B,$07 +DECADD_35: + LD A,(DE) + INC DE + OR A + PUSH DE + JP Z,DECADD_38 + LD C,$08 +DECADD_36: + PUSH BC + RRA + LD B,A + CALL C,DECADD_12 + CALL DECADD_31 + LD A,B + POP BC + DEC C + JP NZ,DECADD_36 +DECADD_37: + POP DE + DEC B + JP NZ,DECADD_35 + JP DECADD_3 +DECADD_38: + LD HL,LAST_FPREG + CALL DECADD_24 + JP DECADD_37 + CALL CALLHL9 + CALL Z,CALLHL9 + LD C,H + LD A,L + NOP + NOP + NOP + NOP + NOP + NOP + JR NZ,DECADD_26 +; This entry point is used by the routine at _DBL_ASCTFP. + + + + + +DECADD_39: + LD DE,$3675 + LD HL,$FB2E + CALL FP2HL + JP DECMUL + +; Routine at 13969 +DECDIV: + LD A,(ARG) + OR A + JP Z,OERR + LD A,(FACCU) + OR A + JP Z,CLEAR_EXPONENT + CALL DIV_4 + INC (HL) + INC (HL) + JP Z,$057D + CALL DECADD_41 + LD HL,$FB58 + LD (HL),C + LD B,C +DECADD_40: + LD DE,$FB51 + LD HL,$FB2E + CALL DECADD_18 + LD A,(DE) + SBC A,C + CCF + JP C,$36C9 + LD DE,$FB51 + LD HL,$FB2E + CALL DECADD_14 + XOR A + JP C,$0412 + LD A,(LAST_FPREG) + INC A + DEC A + RRA + JP M,DECADD_9 + RLA + LD HL,$FB24 + LD C,$07 + CALL DECADD_33 + LD HL,$FB51 + CALL DECADD_32 + LD A,B + OR A + JP NZ,DECADD_40 + LD HL,FACCU + DEC (HL) + JP NZ,DECADD_40 + JP CLEAR_EXPONENT + +DECADD_41: + LD A,C + LD (DBL_LAST_FPREG),A + DEC HL + LD DE,$FB57 + LD BC,$0700 +DECADD_42: + LD A,(HL) + LD (DE),A + LD (HL),C + DEC DE + DEC HL + DEC B + JP NZ,DECADD_42 + RET + +; This entry point is used by the routine at _DBL_ASCTFP. +DECADD_43: + CALL FP_ARG2HL + EX DE,HL + DEC HL + LD A,(HL) + OR A + RET Z + ADD A,$02 + JP C,$057D + LD (HL),A + PUSH HL + CALL DECADD + POP HL + INC (HL) + RET NZ + JP $057D + +; ASCII to Double precision FP number +; +; Used by the routines at __DATA, TOPOOL and SCPTLP. +DBL_DBL_ASCTFP: + CALL CLEAR_EXPONENT + CALL SETTYPE_DBL + + defb $f6 ; OR $AF + +; ASCII to FP number (New version) +; +; Used by the routines at TOKEN_BUILT, __DATA, OPRND and SCPTLP. +DBL_ASCTFP: + XOR A + EX DE,HL + LD BC,$00FF + LD H,B + LD L,B + CALL Z,INT_RESULT_HL + EX DE,HL + LD A,(HL) + +; ASCII to FP number +_DBL_ASCTFP: + CP '-' + PUSH AF + JP Z,_DBL_ASCTFP_0 + CP '+' + JP Z,_DBL_ASCTFP_0 + DEC HL +_DBL_ASCTFP_0: + RST CHRGTB ; Gets next character (or token) from BASIC text. + JP C,_DBL_ASCTFP_18 + CP '.' + JP Z,_DBL_ASCTFP_9 + CP $65 + JP Z,_DBL_ASCTFP_1 + CP 'E' +_DBL_ASCTFP_1: + JP NZ,_DBL_ASCTFP_4 + PUSH HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + CP $6C + JP Z,_DBL_ASCTFP_2 + CP $4C + JP Z,_DBL_ASCTFP_2 + CP $71 + JP Z,_DBL_ASCTFP_2 + CP $51 +_DBL_ASCTFP_2: + POP HL + JP Z,_DBL_ASCTFP_3 + LD A,(VALTYP) + CP $08 + JP Z,_DBL_ASCTFP_5 + LD A,$00 + JP _DBL_ASCTFP_5 +_DBL_ASCTFP_3: + LD A,(HL) +_DBL_ASCTFP_4: + CP '%' + JP Z,_DBL_ASCTFP_10 + CP '#' + JP Z,_DBL_ASCTFP_11 + CP '!' + JP Z,_DBL_ASCTFP_12 + CP $64 + JP Z,_DBL_ASCTFP_5 + CP 'D' + JP NZ,_DBL_ASCTFP_7 +_DBL_ASCTFP_5: + OR A + CALL _DBL_ASCTFP_13 + RST CHRGTB ; Gets next character (or token) from BASIC text. + CALL UCASE_5 +_DBL_ASCTFP_6: + RST CHRGTB ; Gets next character (or token) from BASIC text. + JP C,_DBL_ASCTFP_27 + INC D + JP NZ,_DBL_ASCTFP_7 + XOR A + SUB E + LD E,A +_DBL_ASCTFP_7: + PUSH HL + LD A,E + SUB B + LD E,A +_DBL_ASCTFP_8: + CALL P,_DBL_ASCTFP_14 + CALL M,_DBL_ASCTFP_17 + JP NZ,_DBL_ASCTFP_8 + POP HL + POP AF + PUSH HL + CALL Z,INVSGN + POP HL + RST GETYPR ; Get the number type (FAC) + RET PE + PUSH HL + LD HL,POPHLRT + PUSH HL + CALL INT_RESULT_HL_2 + RET +_DBL_ASCTFP_9: + RST GETYPR ; Get the number type (FAC) + INC C + JP NZ,_DBL_ASCTFP_7 + CALL C,_DBL_ASCTFP_13 + JP _DBL_ASCTFP_0 +_DBL_ASCTFP_10: + RST CHRGTB ; Gets next character (or token) from BASIC text. + POP AF + PUSH HL + LD HL,POPHLRT + PUSH HL + PUSH AF + JP _DBL_ASCTFP_7 +_DBL_ASCTFP_11: + OR A +_DBL_ASCTFP_12: + CALL _DBL_ASCTFP_13 + RST CHRGTB ; Gets next character (or token) from BASIC text. + JP _DBL_ASCTFP_7 +_DBL_ASCTFP_13: + PUSH HL + PUSH DE + PUSH BC + PUSH AF + CALL Z,__CSNG + POP AF + CALL NZ,__CDBL + POP BC + POP DE + POP HL + RET + +_DBL_ASCTFP_14: + RET Z +_DBL_ASCTFP_15: + PUSH AF + RST GETYPR ; Get the number type (FAC) + PUSH AF + CALL PO,MLSP10 + POP AF + CALL PE,DECADD_43 + POP AF +DCR_A: + DEC A + RET + +_DBL_ASCTFP_17: + PUSH DE + PUSH HL + PUSH AF + RST GETYPR ; Get the number type (FAC) + PUSH AF + CALL PO,DIV10 + POP AF + CALL PE,DECADD_39 + POP AF + POP HL + POP DE + INC A + RET + +_DBL_ASCTFP_18: + PUSH DE + LD A,B + ADC A,C + LD B,A + PUSH BC + PUSH HL + LD A,(HL) + SUB $30 ; '0' + PUSH AF + RST GETYPR ; Get the number type (FAC) + JP P,_DBL_ASCTFP_22 + LD HL,(DBL_FPREG) + LD DE,$0CCD ; const + RST CPDEHL + JP NC,_DBL_ASCTFP_21 + LD D,H + LD E,L + ADD HL,HL + ADD HL,HL + ADD HL,DE + ADD HL,HL + POP AF + LD C,A + ADD HL,BC + LD A,H + OR A + JP M,_DBL_ASCTFP_20 + LD (DBL_FPREG),HL + +_DBL_ASCTFP_19: + POP HL + POP BC + POP DE + JP _DBL_ASCTFP_0 + +_DBL_ASCTFP_20: + LD A,C + PUSH AF +_DBL_ASCTFP_21: + CALL INT_CSNG + SCF +_DBL_ASCTFP_22: + JP NC,_DBL_ASCTFP_24 + LD BC,$9474 + LD DE,$2400 + CALL FCOMP + JP P,_DBL_ASCTFP_23 + CALL MLSP10 + POP AF + CALL _DBL_ASCTFP_25 + JP _DBL_ASCTFP_19 + +_DBL_ASCTFP_23: + CALL ZERO_FACCU +_DBL_ASCTFP_24: + CALL DECADD_43 + CALL FP_ARG2HL + POP AF + CALL FLGREL + CALL ZERO_FACCU + CALL DECADD + JP _DBL_ASCTFP_19 + +_DBL_ASCTFP_25: + CALL STAKI + CALL FLGREL +; This entry point is used by the routine at MLDEBC. +_DBL_ASCTFP_26: + POP BC + POP DE + JP FADD +_DBL_ASCTFP_27: + LD A,E + CP $0A + JP NC,$388B + RLCA + RLCA + ADD A,E + RLCA + ADD A,(HL) + SUB $30 + LD E,A + JP M,$7F1E + JP _DBL_ASCTFP_6 + +; This entry point is used by the routines at SNERR and GETWORD. +LNUM_MSG: + PUSH HL + LD HL,IN_MSG + CALL PRS + POP HL + +; Print HL in ASCII form at the current cursor position +; +; Used by the routines at __LIST, PRPARM and FREEMEM. +NUMPRT: + LD BC,PRNUMS + PUSH BC + CALL INT_RESULT_HL + XOR A + CALL NUMPRT_SUB + OR (HL) + JP PUFOUT_1 + +; This entry point is used by the routines at __DATA, MAKINT and __INP. +FOUT: + XOR A + +; This entry point is used by the routine at SCPTLP. +; Convert number/expression to string ("PRINT USING" format specified in 'A' register) +FOUT_0: + CALL NUMPRT_SUB + +; Convert the binary number in FAC1 to ASCII. A - Bit configuration for PRINT +; USING options +PUFOUT: + AND $08 + JP Z,PUFOUT_0 + LD (HL),'+' +PUFOUT_0: + EX DE,HL + CALL _TSTSGN + EX DE,HL + JP P,PUFOUT_1 + LD (HL),'-' + PUSH BC + PUSH HL + CALL INVSGN + POP HL + POP BC + OR H +PUFOUT_1: + INC HL + LD (HL),'0' + LD A,(TEMP3) + LD D,A + RLA + LD A,(VALTYP) + JP C,_DBL_ASCTFP_48 + JP Z,_DBL_ASCTFP_46 + CP $04 + JP NC,_DBL_ASCTFP_40 + LD BC,$0000 + CALL _DBL_ASCTFP_105 + +_DBL_ASCTFP_34: + LD HL,FBUFFR+1 + LD B,(HL) + LD C,$20 + LD A,(TEMP3) + LD E,A + AND $20 ; bit 5 - Asterisks fill + JP Z,_DBL_ASCTFP_35 + LD A,B + CP C + LD C,'*' + JP NZ,_DBL_ASCTFP_35 + LD A,E + AND $04 + JP NZ,_DBL_ASCTFP_35 + LD B,C +_DBL_ASCTFP_35: + LD (HL),C + RST CHRGTB ; Gets next character (or token) from BASIC text. + JP Z,_DBL_ASCTFP_36 + CP 'E' + JP Z,_DBL_ASCTFP_36 + CP 'D' + JP Z,_DBL_ASCTFP_36 + CP '0' + JP Z,_DBL_ASCTFP_35 + CP ',' + JP Z,_DBL_ASCTFP_35 + CP '.' + JP NZ,_DBL_ASCTFP_37 +_DBL_ASCTFP_36: + DEC HL + LD (HL),'0' +_DBL_ASCTFP_37: + LD A,E + AND $10 + JP Z,_DBL_ASCTFP_38 + DEC HL + LD (HL),$5C +_DBL_ASCTFP_38: + LD A,E + AND $04 + RET NZ + DEC HL + LD (HL),B + RET + +NUMPRT_SUB: + LD (TEMP3),A + LD HL,FBUFFR+1 + LD (HL),' ' + RET + +_DBL_ASCTFP_40: + CP $05 + PUSH HL + SBC A,$00 + RLA + LD D,A + INC D + CALL _DBL_ASCTFP_76 + LD BC,$0300 + ADD A,D + JP M,_DBL_ASCTFP_41 + INC D + CP D + JP NC,_DBL_ASCTFP_41 + INC A + LD B,A + LD A,$02 +_DBL_ASCTFP_41: + SUB $02 + POP HL + PUSH AF + CALL _DBL_ASCTFP_95 + LD (HL),'0' + CALL Z,INCHL + CALL _DBL_ASCTFP_98 +SUPTLZ: + DEC HL + LD A,(HL) + CP '0' + JP Z,SUPTLZ + CP '.' + CALL NZ,INCHL + POP AF + JP Z,NOENED + +_DBL_ASCTFP_43: + PUSH AF + RST GETYPR ; Get the number type (FAC) + LD A,$22 + ADC A,A + LD (HL),A + INC HL + POP AF + LD (HL),'+' + JP P,OUTEXP + LD (HL),'-' + CPL + INC A +OUTEXP: + LD B,'0'-1 ; $2F, '/' +EXPTEN: + INC B + SUB 10 + JP NC,EXPTEN + ADD A,'0'+10 + INC HL + LD (HL),B + INC HL + LD (HL),A +_DBL_ASCTFP_46: + INC HL +NOENED: + LD (HL),$00 + EX DE,HL + LD HL,FBUFFR+1 + RET + +_DBL_ASCTFP_48: + INC HL + PUSH BC + CP $04 + LD A,D + JP NC,_DBL_ASCTFP_55 + RRA + JP C,_DBL_ASCTFP_65 + LD BC,$0603 ; const + CALL _DBL_ASCTFP_94 + POP DE + LD A,D + SUB $05 + CALL P,_DBL_ASCTFP_87 + CALL _DBL_ASCTFP_105 +_DBL_ASCTFP_49: + LD A,E + OR A + CALL Z,DCXH_2 + DEC A + CALL P,_DBL_ASCTFP_87 +_DBL_ASCTFP_50: + PUSH HL + CALL _DBL_ASCTFP_34 + POP HL + JP Z,_DBL_ASCTFP_51 + LD (HL),B + INC HL +_DBL_ASCTFP_51: + LD (HL),$00 + LD HL,FBUFFR +_DBL_ASCTFP_52: + INC HL +_DBL_ASCTFP_53: + LD A,(TEMP2) + SUB L + SUB D + RET Z + LD A,(HL) + CP ' ' + JP Z,_DBL_ASCTFP_52 + CP '*' + JP Z,_DBL_ASCTFP_52 + DEC HL + PUSH HL + PUSH AF + LD BC,$39E0 + PUSH BC + RST CHRGTB ; Gets next character (or token) from BASIC text. + CP '-' + RET Z + CP '+' + RET Z + CP $5C ;'\' + RET Z + POP BC + CP '0' + JP NZ,_DBL_ASCTFP_54 + INC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + JP NC,_DBL_ASCTFP_54 + DEC HL + LD BC,$772B + POP AF + JP Z,$39FC + POP BC + JP _DBL_ASCTFP_53 +_DBL_ASCTFP_54: + POP AF + JP Z,_DBL_ASCTFP_54 + POP HL + LD (HL),$25 + RET +_DBL_ASCTFP_55: + PUSH HL + RRA + JP C,_DBL_ASCTFP_66 + JP Z,_DBL_ASCTFP_57 + LD DE,$3CEA + CALL FCOMP_4 + LD D,$10 + JP M,_DBL_ASCTFP_58 +_DBL_ASCTFP_56: + POP HL + POP BC + CALL FOUT + DEC HL + LD (HL),$25 + RET +_DBL_ASCTFP_57: + LD BC,$B60E + LD DE,$1BCA + CALL FCOMP + JP P,_DBL_ASCTFP_56 + LD D,$06 +_DBL_ASCTFP_58: + RST TSTSGN + CALL NZ,_DBL_ASCTFP_76 + POP HL + POP BC + JP M,_DBL_ASCTFP_59 + PUSH BC + LD E,A + LD A,B + SUB D + SUB E + CALL P,_DBL_ASCTFP_87 + CALL _DBL_ASCTFP_92 + CALL _DBL_ASCTFP_98 + OR E + CALL NZ,_DBL_ASCTFP_91 + OR E + CALL NZ,_DBL_ASCTFP_95 + POP DE + JP _DBL_ASCTFP_49 + +_DBL_ASCTFP_59: + LD E,A + LD A,C + OR A + CALL NZ,DCR_A ; DEC A, RET + ADD A,E + JP M,_DBL_ASCTFP_60 + XOR A +_DBL_ASCTFP_60: + PUSH BC + PUSH AF +_DBL_ASCTFP_61: + CALL M,_DBL_ASCTFP_17 + JP M,_DBL_ASCTFP_61 + POP BC + LD A,E + SUB B + POP BC + LD E,A + ADD A,D + LD A,B + JP M,_DBL_ASCTFP_62 + SUB D + SUB E + CALL P,_DBL_ASCTFP_87 + PUSH BC + CALL _DBL_ASCTFP_92 + JP _DBL_ASCTFP_63 +_DBL_ASCTFP_62: + CALL _DBL_ASCTFP_87 + LD A,C + CALL _DBL_ASCTFP_96 + LD C,A + XOR A + SUB D + SUB E + CALL _DBL_ASCTFP_87 + PUSH BC + LD B,A + LD C,A +_DBL_ASCTFP_63: + CALL _DBL_ASCTFP_98 + POP BC + OR C + JP NZ,_DBL_ASCTFP_64 + LD HL,(TEMP2) ; NXTOPR on MSX +_DBL_ASCTFP_64: + ADD A,E + DEC A + CALL P,_DBL_ASCTFP_87 + LD D,B + JP _DBL_ASCTFP_50 + +_DBL_ASCTFP_65: + PUSH HL + PUSH DE + CALL INT_CSNG + POP DE + XOR A +_DBL_ASCTFP_66: + JP Z,L3AB6 + LD E,$10 + defb $01 ; LD BC,NN + ;LD BC,$061E + +; Routine at 15030 +; +; Used by the routine at _ASCTFP. +L3AB6: + LD E,$06 + RST TSTSGN + SCF + CALL NZ,_DBL_ASCTFP_76 + POP HL + POP BC + PUSH AF + LD A,C + OR A + PUSH AF + CALL NZ,DCR_A ; DEC A, RET + ADD A,B + LD C,A + XOR A + OR B + JP Z,_DBL_ASCTFP_67 + LD A,D + AND $04 + CP $01 + SBC A,A +_DBL_ASCTFP_67: + LD D,A + ADD A,C + LD C,A + SUB E + PUSH AF + PUSH BC + PUSH DE + PUSH HL + PUSH AF +_DBL_ASCTFP_68: + CALL M,_DBL_ASCTFP_17 + JP M,_DBL_ASCTFP_68 + XOR A + LD ($FB1A),A + LD HL,$FB1B + CALL LOADFP_9 + RST GETYPR ; Get the number type (FAC) + JP PE,_DBL_ASCTFP_69 + CALL MIDNUM_8 + LD A,$FA + JP _DBL_ASCTFP_70 +_DBL_ASCTFP_69: + CALL MIDNUM_7 + LD A,$F0 +_DBL_ASCTFP_70: + POP DE + SUB D +_DBL_ASCTFP_71: + CALL M,_DBL_ASCTFP_17 + JP M,_DBL_ASCTFP_71 + LD A,(FACCU) + SUB $81 + PUSH AF + LD HL,$FB1B + CALL LOADFP_7 + POP AF + JP M,_DBL_ASCTFP_72 + LD A,$01 + LD ($FB1A),A + CALL _DBL_ASCTFP_17 +_DBL_ASCTFP_72: + POP HL + POP DE + POP BC + POP AF + PUSH BC + PUSH AF + JP M,_DBL_ASCTFP_73 + XOR A +_DBL_ASCTFP_73: + CPL + INC A + ADD A,B + INC A + ADD A,D + LD B,A + LD C,$00 + CALL _DBL_ASCTFP_98 + POP AF + CALL P,_DBL_ASCTFP_89 + CALL _DBL_ASCTFP_95 + POP BC + POP AF + JP NZ,_DBL_ASCTFP_74 + CALL DCXH_2 + LD A,(HL) + CP '.' + CALL NZ,INCHL + LD (TEMP2),HL +_DBL_ASCTFP_74: + POP AF + JP C,_DBL_ASCTFP_75 + ADD A,E + SUB B + SUB D +_DBL_ASCTFP_75: + PUSH BC + LD B,A + LD A,($FB1A) + ADD A,B + CALL _DBL_ASCTFP_43 + EX DE,HL + POP DE + JP _DBL_ASCTFP_50 + +_DBL_ASCTFP_76: + PUSH DE + XOR A + PUSH AF + RST GETYPR ; Get the number type (FAC) + JP PO,_DBL_ASCTFP_78 +_DBL_ASCTFP_77: + LD A,(FACCU) + CP $91 ; TK_PRINT + JP NC,_DBL_ASCTFP_78 + LD DE,$3CCA + LD HL,$FB2E + CALL FP2HL + CALL DECMUL + POP AF + SUB $0A + PUSH AF + JP _DBL_ASCTFP_77 +_DBL_ASCTFP_78: + CALL _DBL_ASCTFP_84 +_DBL_ASCTFP_79: + RST GETYPR ; Get the number type (FAC) + JP PE,_DBL_ASCTFP_80 + LD BC,$9143 + LD DE,$4FF9 + CALL FCOMP + JP _DBL_ASCTFP_81 +_DBL_ASCTFP_80: + LD DE,$3CD2 + CALL FCOMP_4 +_DBL_ASCTFP_81: + JP P,_DBL_ASCTFP_83 + POP AF + CALL _DBL_ASCTFP_15 + PUSH AF + JP _DBL_ASCTFP_79 +_DBL_ASCTFP_82: + POP AF + CALL _DBL_ASCTFP_17 + PUSH AF + CALL _DBL_ASCTFP_84 +_DBL_ASCTFP_83: + POP AF + OR A + POP DE + RET + +_DBL_ASCTFP_84: + RST GETYPR ; Get the number type (FAC) + JP PE,_DBL_ASCTFP_85 + LD BC,$9474 + LD DE,$23F8 + CALL FCOMP + JP _DBL_ASCTFP_86 + +_DBL_ASCTFP_85: + LD DE,$3CDA + CALL FCOMP_4 +_DBL_ASCTFP_86: + POP HL + JP P,_DBL_ASCTFP_82 + JP (HL) + +_DBL_ASCTFP_87: + OR A +_DBL_ASCTFP_88: + RET Z + DEC A + LD (HL),'0' + INC HL + JP _DBL_ASCTFP_88 +_DBL_ASCTFP_89: + JP NZ,_DBL_ASCTFP_91 +_DBL_ASCTFP_90: + RET Z + CALL _DBL_ASCTFP_95 +_DBL_ASCTFP_91: + LD (HL),'0' + INC HL + DEC A + JP _DBL_ASCTFP_90 +_DBL_ASCTFP_92: + LD A,E + ADD A,D + INC A + LD B,A + INC A +_DBL_ASCTFP_93: + SUB $03 + JP NC,_DBL_ASCTFP_93 + ADD A,$05 + LD C,A +_DBL_ASCTFP_94: + LD A,(TEMP3) + AND $40 + RET NZ + LD C,A + RET +_DBL_ASCTFP_95: + DEC B + JP NZ,_DBL_ASCTFP_97 +_DBL_ASCTFP_96: + LD (HL),$2E + LD (TEMP2),HL + INC HL + LD C,B + RET +_DBL_ASCTFP_97: + DEC C + RET NZ + LD (HL),$2C + INC HL + LD C,$03 + RET +_DBL_ASCTFP_98: + PUSH DE + PUSH BC + PUSH HL + RST GETYPR ; Get the number type (FAC) + JP PO,_DBL_ASCTFP_101 + CALL MIDNUM_7 + XOR A + CALL INT_4 + POP HL + POP BC + LD DE,$3CF2 + LD A,$0A +_DBL_ASCTFP_99: + CALL _DBL_ASCTFP_95 + PUSH BC + PUSH AF + PUSH HL + PUSH DE + LD B,$2F +_DBL_ASCTFP_100: + INC B + POP HL + PUSH HL + CALL DECADD_17 + JP NC,_DBL_ASCTFP_100 + POP HL + CALL DECADD_13 + EX DE,HL + POP HL + LD (HL),B + INC HL + POP AF + POP BC + DEC A + JP NZ,_DBL_ASCTFP_99 + PUSH BC + PUSH HL + LD HL,$FB24 + CALL PHLTFP + JP _DBL_ASCTFP_102 +_DBL_ASCTFP_101: + CALL MIDNUM_8 + LD A,$01 + CALL FPINT + CALL FPBCDE +_DBL_ASCTFP_102: + POP HL + POP BC + XOR A + LD DE,$3D38 +_DBL_ASCTFP_103: + CCF + CALL _DBL_ASCTFP_95 + PUSH BC + PUSH AF + PUSH HL + PUSH DE + CALL BCDEFP + POP HL + LD B,$2F +_DBL_ASCTFP_104: + INC B + LD A,E + SUB (HL) + LD E,A + INC HL + LD A,D + SBC A,(HL) + LD D,A + INC HL + LD A,C + SBC A,(HL) + LD C,A + DEC HL + DEC HL + JP NC,_DBL_ASCTFP_104 + CALL PLUCDE + INC HL + CALL FPBCDE + EX DE,HL + POP HL + LD (HL),B + INC HL + POP AF + POP BC + JP C,_DBL_ASCTFP_103 + INC DE + INC DE + LD A,$04 + JP _DBL_ASCTFP_106 + +_DBL_ASCTFP_105: + PUSH DE + LD DE,$3D3E + LD A,$05 +_DBL_ASCTFP_106: + CALL _DBL_ASCTFP_95 + PUSH BC + PUSH AF + PUSH HL + EX DE,HL + LD C,(HL) + INC HL + LD B,(HL) + PUSH BC + INC HL + EX (SP),HL + EX DE,HL + LD HL,(DBL_FPREG) + LD B,'0'-1 ; $2F, '/' +_DBL_ASCTFP_107: + INC B + LD A,L + SUB E +_DBL_ASCTFP_108: + LD L,A + LD A,H + SBC A,D + LD H,A + JP NC,_DBL_ASCTFP_107 + ADD HL,DE + LD (DBL_FPREG),HL + POP DE + POP HL + LD (HL),B + INC HL + POP AF + POP BC + DEC A + JP NZ,_DBL_ASCTFP_106 + CALL _DBL_ASCTFP_95 + LD (HL),A + POP DE + RET + + + NOP + NOP + NOP + NOP + LD SP,HL + LD (BC),A + + DEC D + AND D + POP HL + RST $38 + SBC A,A + LD SP,$5FA9 + LD H,E + OR D + CP $FF + INC BC + CP A + RET + DEC DE + LD C,$B6 + NOP + NOP + NOP + NOP + +HALF: + NOP + NOP + NOP + ADD A,B + NOP + NOP + INC B + CP A + RET + DEC DE + LD C,$B6 + NOP + ADD A,B + ADD A,$A4 + LD A,(HL) + ADC A,L + INC BC + NOP + LD B,B + LD A,D + DJNZ $3CF1 + LD E,D + NOP + NOP + AND B + LD (HL),D + LD C,(HL) + JR _DBL_ASCTFP_109 + NOP + NOP + DJNZ _DBL_ASCTFP_108 + CALL NC,FNCTAB_0 + NOP + NOP +_DBL_ASCTFP_109: + RET PE + HALT + LD C,B + RLA + NOP + NOP + NOP + CALL PO,GET_DEVICE_15 + LD (BC),A + NOP + NOP + NOP + JP Z,_DBL_ASCTFP_81 + NOP + NOP + NOP + NOP + POP HL + PUSH AF + DEC B + NOP + NOP + NOP + ADD A,B + SUB (HL) + SBC A,B + NOP + NOP + NOP + NOP + LD B,B + LD B,D + RRCA + NOP + NOP + NOP + NOP + AND B + ADD A,(HL) + LD BC,$2710 + NOP + DJNZ POWER_1 + RET PE + INC BC + LD H,H + NOP + LD A,(BC) + NOP + LD BC,$2100 + +; Negate number +; +; Used by the routines at POWER and __POS. +NEGAFT: + LD HL,INVSGN + EX (SP),HL + JP (HL) + +; SQR +__SQR: + CALL STAKI + LD HL,HALF + CALL PHLTFP + JP POWER_0 + +; POWER +POWER: + CALL __CSNG +; This entry point is used by the routine at __SQR. +POWER_0: + POP BC + POP DE + RST TSTSGN + LD A,B + JP Z,__EXP + JP P,POWER_2 + OR A +; This entry point is used by the routine at _DBL_ASCTFP. +POWER_1: + JP Z,OERR +POWER_2: + OR A + JP Z,SET_EXPONENT + PUSH DE + PUSH BC + LD A,C + OR $7F + CALL BCDEFP + JP P,POWER_4 + PUSH AF + LD A,(FACCU) + CP $99 + JP C,POWER_3 + POP AF + JP POWER_4 +POWER_3: + POP AF + PUSH DE + PUSH BC + CALL INT + POP BC + POP DE + PUSH AF + CALL FCOMP + POP HL + LD A,H + RRA +POWER_4: + POP HL + LD (LAST_FPREG),HL + POP HL + LD (DBL_FPREG),HL + CALL C,NEGAFT + CALL Z,INVSGN + PUSH DE + PUSH BC + CALL __LOG + POP BC + POP DE + +; EXP +EXP: + CALL FMULT_BCDE +; This entry point is used by the routine at POWER. +__EXP: + LD BC,$8138 + LD DE,$AA3B + CALL FMULT_BCDE + LD A,(FACCU) + CP $88 + JP NC,EXP_0 + CP $68 + JP C,EXP_3 + CALL STAKI + CALL INT + ADD A,$81 + JP Z,EXP_1 + POP BC + POP DE + PUSH AF + CALL FSUB + LD HL,$3DFD + CALL EXP_5 + POP BC + LD DE,$0000 + LD C,D + JP FMULT_BCDE + +EXP_0: + CALL STAKI +EXP_1: + LD A,(LAST_FPREG) + OR A + JP P,EXP_2 + POP AF + POP AF + JP CLEAR_EXPONENT + +EXP_2: + JP $057D +EXP_3: + LD BC,$8100 + LD DE,$0000 + JP FPBCDE + RLCA + LD A,H + ADC A,B + LD E,C + LD (HL),H + RET PO + SUB A + LD H,$77 + CALL NZ,GETWORD_121 + LD A,D + LD E,(HL) + LD D,B + LD H,E + LD A,H + LD A,(DE) + CP $75 + LD A,(HL) + JR $3E86 + LD SP,$0080 + NOP + NOP + ADD A,C +; This entry point is used by the routines at __RND and __POS. +EXP_4: + CALL STAKI + LD DE,$3467 + PUSH DE + PUSH HL + CALL BCDEFP + CALL FMULT_BCDE + POP HL + +; This entry point is used by the routine at __LOG. +EXP_5: + CALL STAKI + LD A,(HL) + INC HL + CALL PHLTFP +; Routine at 15922 +L3E32: + LD B,$F1 ; POP AF + POP BC + POP DE + DEC A + RET Z + PUSH DE + PUSH BC + PUSH AF + PUSH HL + CALL FMULT_BCDE + POP HL + CALL LOADFP + PUSH HL + CALL FADD + POP HL + JP L3E32 + +; RND +__RND: + RST TSTSGN + LD HL,RNDX + JP M,__RND_3 + LD HL,HOLD + CALL PHLTFP + LD HL,RNDX + RET Z + ADD A,(HL) + AND $07 + LD B,$00 + LD (HL),A + INC HL + ADD A,A + ADD A,A + LD C,A + ADD HL,BC + CALL LOADFP + CALL FMULT_BCDE + LD A,(RNDX-1) + INC A + AND $03 + LD B,$00 + CP $01 + ADC A,B + LD (RNDX-1),A + LD HL,L3EAD + ADD A,A + ADD A,A + LD C,A + ADD HL,BC + CALL MIDNUM_9 +__RND_0: + CALL BCDEFP + LD A,E + LD E,C + XOR $4F + LD C,A +__RND_1: + LD (HL),$80 + DEC HL + LD B,(HL) + LD (HL),$80 + LD HL,RNDX-2 + INC (HL) + LD A,(HL) + SUB $AB + JP NZ,__RND_2 + LD (HL),A + INC C + DEC D + INC E +__RND_2: + CALL BNORM + LD HL,HOLD + JP LOADFP_2 +__RND_3: + LD (HL),A + DEC HL + LD (HL),A + DEC HL +; Routine at 16045 +L3EAD: + LD (HL),A + JP __RND_0 + + LD L,B + OR C + LD B,(HL) + LD L,B + SBC A,C + JP (HL) + + SUB D + LD L,C + DJNZ __RND_1 + LD (HL),L + LD L,B + +; This entry point is used by the routine at __TAN. +__COS: + LD HL,$3F41 + CALL MIDNUM_9 +; This entry point is used by the routine at __TAN. +__SIN: + LD A,(FACCU) + CP $77 + RET C + LD A,(LAST_FPREG) + OR A + JP P,__RND_4 + AND $7F + LD (LAST_FPREG),A + LD DE,INVSGN + PUSH DE +__RND_4: + LD BC,$7E22 + LD DE,$F983 + CALL FMULT_BCDE + CALL STAKI + CALL INT + POP BC + POP DE + CALL FSUB + LD BC,$7F00 + LD DE,$0000 + CALL FCOMP + JP M,__RND_5 + LD BC,$7F80 + LD DE,$0000 + CALL FADD + LD BC,$8080 + LD DE,$0000 + CALL FADD + RST TSTSGN + CALL P,INVSGN + LD BC,$7F00 + LD DE,$0000 + CALL FADD + CALL INVSGN +__RND_5: + LD A,(LAST_FPREG) + OR A + PUSH AF + JP P,__RND_6 + XOR $80 + LD (LAST_FPREG),A +__RND_6: + LD HL,$3F49 + CALL EXP_4 + POP AF + RET P + LD A,(LAST_FPREG) + XOR $80 + LD (LAST_FPREG),A + RET + NOP + NOP + NOP + NOP + ADD A,E + LD SP,HL + LD ($DB7E),HL + RRCA + LD C,C + ADD A,C + NOP + NOP + NOP + LD A,A + DEC B + EI + RST CHRGTB ; Gets next character (or token) from BASIC text. + LD E,$86 + LD H,L + LD H,$99 + ADD A,A + LD E,B + INC (HL) + INC HL + ADD A,A + POP HL + LD E,L + AND L + ADD A,(HL) + IN A,($0F) + LD C,C + ADD A,E + +; TAN +__TAN: + CALL STAKI + CALL __SIN + POP BC + POP HL + CALL STAKI + EX DE,HL + CALL FPBCDE + CALL __COS + JP DIV + +; ATN +__POS: + RST TSTSGN + CALL M,NEGAFT + CALL M,INVSGN + LD A,(FACCU) + CP $81 + JP C,__POS_0 + LD BC,$8100 + LD D,C + LD E,C + CALL FDIV + LD HL,$2EC1 + PUSH HL +__POS_0: + LD HL,$3F98 + CALL EXP_4 + LD HL,$3F41 + RET + ADD HL,BC + LD C,D + RST CHRGTB ; Gets next character (or token) from BASIC text. + DEC SP + LD A,B + LD (BC),A + LD L,(HL) + ADD A,H + LD A,E + CP $C1 + CPL + LD A,H + LD (HL),H + LD SP,$7D9A + ADD A,H + DEC A + LD E,D + LD A,L + RET Z + LD A,A + SUB C + LD A,(HL) + CALL PO,$4CBB + LD A,(HL) + LD L,H + XOR D + XOR D + LD A,A + NOP + NOP + NOP + ADD A,C +; This entry point is used by the routines at SNERR and GETVAR. +__POS_1: + CALL $3FD5 +; This entry point is used by the routine at TESTR. +__POS_2: + PUSH BC + EX (SP),HL + POP BC +__POS_3: + RST CPDEHL + LD A,(HL) + LD (BC),A + RET Z + DEC BC + DEC HL + JP __POS_3 + +; Check for C levels of stack +; +; Used by the routines at __FOR, EVAL1 and SCPTLP. +CHKSTK: + PUSH HL + LD HL,(ARREND) + LD B,$00 + ADD HL,BC + ADD HL,BC + LD A,$E5 + LD A,$88 + SUB L + LD L,A + LD A,$FF + SBC A,H + LD H,A + JP C,OMERR + ADD HL,SP + POP HL + RET C +; This entry point is used by the routines at GETWORD, SCPTLP and GET_DEVICE. +OMERR: + CALL UPD_PTRS + LD HL,(STKTOP) + DEC HL + DEC HL + LD (SAVSTK),HL + LD DE,$0007 + JP ERROR +; This entry point is used by the routines at SNERR, __FOR, GETWORD, ISFLIO and +; GET_DEVICE. +RUN_FST: + LD HL,(BASTXT) + DEC HL +; This entry point is used by the routines at __FOR, GETWORD and GET_DEVICE. +_CLVAR: + LD (TEMP),HL +; This entry point is used by the routine at GET_DEVICE. +_CLREG: + CALL RUN_FST2 + LD B,$1A + LD HL,$FAED +CHKSTK_4: + LD (HL),$04 + INC HL + DEC B + JP NZ,CHKSTK_4 + XOR A + LD (ONEFLG),A + LD L,A + LD H,A + LD (ONELIN),HL + LD (OLDTXT),HL + LD HL,(MEMSIZ) + LD (FRETOP),HL + CALL __RESTORE + LD HL,(PROGND) + LD (VAREND),HL + LD (ARREND),HL + CALL CLSALL ; Close all files + LD A,(NLONLY) + AND $01 + JP NZ,_CLREG_1 + LD (NLONLY),A +; This entry point is used by the routine at GET_DEVICE. +_CLREG_1: + POP BC + LD HL,(STKTOP) + DEC HL + DEC HL + LD (SAVSTK),HL + INC HL + INC HL + +; This entry point is used by the routine at SNERR. +WARM_ENTRY: + LD SP,HL + LD HL,TEMPST + LD (TEMPPT),HL + CALL INIT_OUTPUT + CALL FINPRT + XOR A + LD H,A + LD L,A + LD (PRMLEN),HL + LD (NOFUNS),A + LD (PRMLN2),HL + LD (FUNACT),HL + LD (PRMSTK),HL + LD (SUBFLG),A + PUSH HL + PUSH BC + LD HL,(TEMP) + RET + +; This entry point is used by the routine at GETWORD. +TIME_S_ON: + DI + LD A,(HL) + AND $04 + OR $01 + LD (HL),A + EI + RET + +; This entry point is used by the routine at GETWORD. +TIME_S_OFF: + DI + LD (HL),$00 + EI + RET + +; This entry point is used by the routine at GETWORD. +TIME_S_STOP: + DI + LD A,(HL) + OR $02 + LD (HL),A + EI + RET + +; This entry point is used by the routine at ULERR. +TIME_S_STOP_1: + DI + LD A,(HL) + AND $05 + LD (HL),A + EI + RET + +RUN_FST1: + DI + LD A,(HL) + AND $03 + LD (HL),A + EI + RET + +RUN_FST2: + XOR A + LD L,A + LD H,A + LD (ON_COM_FLG),A + LD ($F84D),HL + RET + +; This entry point is used by the routine at __FOR. +RUN_FST3: + LD A,(ONEFLG) + OR A + RET NZ + PUSH HL + LD HL,(CURLIN) + LD A,H + AND L + INC A + JP Z,RUN_FST4 + LD HL,ON_COM_FLG + LD A,(HL) + DEC A + JP Z,TIME_S_STOP_7 +RUN_FST4: + POP HL + RET + +TIME_S_STOP_7: + INC HL + LD E,(HL) + INC HL + LD D,(HL) + DEC HL + DEC HL + LD A,D + OR E + JP Z,RUN_FST4 + PUSH DE + PUSH HL + CALL RUN_FST1 + CALL TIME_S_STOP + LD C,$03 + CALL CHKSTK + POP BC + POP DE + POP HL + POP AF + JP __FOR_40 + +__RESTORE: + EX DE,HL + LD HL,(BASTXT) + JP Z,RUN_FST6 + EX DE,HL + CALL LNUM_PARM_0 + PUSH HL + CALL FIRST_LNUM + LD H,B + LD L,C + POP DE + JP NC,ULERR ; Error: "Undefined line number" +RUN_FST6: + DEC HL +; This entry point is used by the routine at __DATA. +RUN_FST7: + LD (DATPTR),HL + EX DE,HL + RET + +; This entry point is used by the routine at GETWORD. +__STOP: + RET NZ + INC A + JP RUN_FST8 + +__END: + RET NZ + XOR A + LD (ONEFLG),A + PUSH AF + CALL Z,CLSALL ; Close all files + POP AF +RUN_FST8: + LD (SAVTXT),HL + LD HL,TEMPST + LD (TEMPPT),HL + LD HL,$FFF6 + POP BC + LD HL,(CURLIN) + PUSH HL + PUSH AF + LD A,L + AND H + INC A + JP Z,RUN_FST9 + LD (OLDLIN),HL + LD HL,(SAVTXT) + LD (OLDTXT),HL +RUN_FST9: + CALL INIT_OUTPUT + CALL CONSOLE_CRLF + POP AF + LD HL,BREAK_MSG + JP NZ,SNERR_8 + JP RESTART + +__CONT: + LD HL,(OLDTXT) + LD A,H + OR L + LD DE,$0011 + JP Z,ERROR + EX DE,HL + LD HL,(OLDLIN) + LD (CURLIN),HL + EX DE,HL + RET + JP FCERR + +; This entry point is used by the routines at __FOR and GETVAR. +IS_ALPHA: + LD A,(HL) +; This entry point is used by the routines at SNERR, OPRND and GETVAR. +IS_ALPHA_A: + CP $41 + RET C + CP $5B + CCF + RET + +__CLEAR: + PUSH HL + CALL GET_DEVICE_206 + CALL SWAPNM_1 + CALL GET_DEVICE_207 + POP HL + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + JP Z,_CLVAR + CALL __FOR_31 + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + PUSH HL + LD HL,(HIMEM) + LD B,H + LD C,L + LD HL,(MEMSIZ) + JP Z,_CLVAR3 + POP HL + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + PUSH DE + CALL GETWORD + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + JP NZ,SNERR + EX (SP),HL + EX DE,HL + LD A,H + AND A + JP P,FCERR ; "Illegal function call" + PUSH DE + LD DE,MAXRAM+1 ; Limit of CLEAR position + RST $38 + DEFB $00 ; RST38_VECT, offset: 00, Hook for CLEAR + + RST CPDEHL + JP NC,FCERR ; "Illegal function call" + POP DE + PUSH HL + LD BC,$FEF5 ; -267 (same offset on M100) + LD A,(MAXFIL) +_CLVAR2: + ADD HL,BC + DEC A + JP P,_CLVAR2 + POP BC + DEC HL +_CLVAR3: + LD A,L + SUB E + LD E,A + LD A,H + SBC A,D + LD D,A + JP C,OMERR + PUSH HL + LD HL,(PROGND) + PUSH BC + LD BC,$00A0 + ADD HL,BC + POP BC + RST CPDEHL + JP NC,OMERR + EX DE,HL + LD (STKTOP),HL + LD H,B + LD L,C + LD (HIMEM),HL + POP HL + LD (MEMSIZ),HL + POP HL + CALL _CLVAR + LD A,(MAXFIL) + CALL __MAX_0 + LD HL,(TEMP) + JP EXEC_EVAL_0 + +__NEXT: + LD DE,$0000 +_CLVAR4: + CALL NZ,GETVAR + LD (TEMP),HL + CALL NEXT_UNSTACK ; search FOR block on stack (skip 2 words) + JP NZ,$0574 + LD SP,HL + PUSH DE + LD A,(HL) + PUSH AF + INC HL + PUSH DE + LD A,(HL) + INC HL + OR A + JP M,_CLVAR5 + CALL PHLTFP + EX (SP),HL + PUSH HL + CALL MIDNUM_9 + POP HL + CALL LOADFP_2 + POP HL + CALL LOADFP + PUSH HL + CALL FCOMP + JP _CLVAR6 +_CLVAR5: + INC HL + INC HL + INC HL + INC HL + LD C,(HL) + INC HL + LD B,(HL) + INC HL + EX (SP),HL + LD E,(HL) + INC HL + LD D,(HL) + PUSH HL + LD L,C + LD H,B + CALL IADD + LD A,(VALTYP) + CP $04 + JP Z,$057D + EX DE,HL + POP HL + LD (HL),D + DEC HL + LD (HL),E + POP HL + PUSH DE + LD E,(HL) + INC HL + LD D,(HL) + INC HL + EX (SP),HL + CALL ICOMP +_CLVAR6: + POP HL + POP BC + SUB B + CALL LOADFP + JP Z,_CLVAR7 + EX DE,HL + LD (CURLIN),HL + LD L,C + LD H,B + JP __FOR_5 +_CLVAR7: + LD SP,HL + LD (SAVSTK),HL + EX DE,HL + LD HL,(TEMP) + LD A,(HL) + CP ',' + JP NZ,EXEC_EVAL_0 + RST CHRGTB ; Gets next character (or token) from BASIC text. + CALL _CLVAR4 + +; Tests if an I/O redirection to device is in place +; +; Used by the routines at SNERR, __DATA, MAKINT and SCPTLP. +ISFLIO: + PUSH HL + LD HL,(PTRFIL) + LD A,H + OR L + POP HL + RET + +; Send CRLF to screen or printer +; +; Used by the routines at __KEY, CATALOG, INLIN_BRK, INLIN_ENTER, TEL_FIND, +; TXT_ESC, TXT_CTL_Y and TXT_CTL_V. +OUTDO_CRLF: + LD A,$0D + RST OUTC + LD A,$0A + RST OUTC + RET + +; Routine at 16937 +; +; Used by the routines at LDIR_B, INXD, TELCOM, TEL_TERM, __MENU, SCHEDL_DE, +; TEXT and MOVE_TEXT. +__BEEP: + LD A,$07 ; BEL + RST OUTC + RET + +; This entry point is used by the routine at GET_DEVICE. +HOME: + LD A,$0B + RST OUTC + RET + +; Routine at 16945 +; +; Used by the routines at __MENU, _PRINT_TDATE, SCHEDL_DE and __EDIT. +__CLS: + LD A,$0C ; CLS/FF + RST OUTC + RET + +; Protect line 8. An ESC T is printed. +; +; Used by the routine at DSPFNK. +ISFLIO_2: + LD A,$54 ; 'T' + JP ESCA + +; Unprotect line 8. An ESC U is printed. +; +; Used by the routines at ERAFNK and DSPFNK. +oint is used by the routine at GET_DEVICE. +RSTSYS: + LD A,$55 ; 'U' + JP ESCA + +; Stop automatic scrolling. ( ESC V ) +; +; Used by the routines at __MENU and WAIT_SPC. +LOCK: + LD A,$56 ; 'V' + JP ESCA + +; Resume automatic scrolling. (ESC W) +; +; Used by the routines at TELCOM, __MENU and TXT_ESC. +UNLOCK: + LD A,$57 ; 'W' + JP ESCA + +; Turn the cursor on. An ESC P is printed. +; +; Used by the routines at FNBAR_TOGGLE, TEL_TERM and TEL_PREV. +CURSON: + LD A,$50 ; 'P' + JP ESCA + +; Turn the cursor off. An ESC Q is printed. +; +; Used by the routines at FNBAR_TOGGLE, TEL_PREV, TEL_BYE, __MENU and WAIT_SPC. +CURSOFF: + LD A,$51 ; 'Q' + JP ESCA + +; Delete current line on screen. ( ESC M ) +; +; Used by the routines at DSPFNK and TXT_CTL_L. +DELLIN: + LD A,$4D ; 'M' + JP ESCA + +; Insert line at current line. (ESC L) +; +; Used by the routine at TXT_CTL_C. +INSLIN: + LD A,$4C ; 'L' + JP ESCA + +; Erase from cursor to end of line. (ESC K) +; +; Used by the routines at CAS_OPNI_CO, ERAFNK, DSPFNK, INXD, MOVE_TEXT and +; TXT_CTL_V. +ERAEOL: + LD A,$4B ; 'K' + JP ESCA + +; This entry point is used by the routines at GETWORD and GET_DEVICE. +_ESC_X: + LD A,$58 + JP ESCA +; This entry point is used by the routine at GET_DEVICE. +HOME2: + LD A,$33 + JP ESCA + +; This entry point is used by the routine at GET_DEVICE. +HOME3: + LD A,$34 + JP ESCA + +ENTREV_COND: + OR (HL) + RET Z + +; calls ESC__p, Reverse mode +; +; Used by the routines at DSPFNK, ESC_L and INXD. +ENTREV: + LD A,$70 ; 'p' + JP ESCA + +; calls ESC__q, Exit reverse mode +; +; Used by the routines at DSPFNK, ESC_L, INXD, __MENU, WAIT_SPC and TXT_CTL_V. +EXTREV: + LD A,$71 ; 'q' + +ESCA: + PUSH AF + LD A,$1B + RST OUTC + POP AF + RST OUTC + RET + +ESCA_0: + LD HL,(ACTV_X) + LD H,$01 + +; calls ESC_Y, set cursor position (H,L) +; +; Used by the routines at LINE_GFX, ERAFNK, DSPFNK, __MENU, DOTTED_FNAME, +; CURS_HOME, SHOW_TIME, TXT_ESC, TXT_CTL_I, TXT_CTL_E, TXT_CTL_T, TXT_CTL_R, +; TXT_CTL_C, MCLEAR, MOVE_TEXT, TXT_CTL_Y and TXT_CTL_V. +; H=X position, L=Y position +POSIT: + LD A,$59 + CALL ESCA + LD A,L + ADD A,$1F + RST OUTC + LD A,H + ADD A,$1F + RST OUTC + RET + +; This entry point is used by the routines at GETWORD and GET_DEVICE. +ERAFNK: + LD A,(LABEL_LN) + AND A + RET Z + CALL RSTSYS + LD HL,(CSRX) + PUSH HL + CALL ESCA_0 + CALL HOME31 + CALL ERAEOL + POP HL + CALL POSIT + CALL _ESC_X + XOR A + RET + +; Set and display function keys +; +; Used by the routines at TELCOM and SCHEDL_DE.STDSPF: + CALL STFNK +; This entry point is used by the routines at GETWORD and GET_DEVICE. +DSPFNK: + XOR A +; This entry point is used by the routine at GET_DEVICE. +DSPFNK_0: + PUSH AF + LD (FNKSTS),A + LD HL,(CSRX) + LD A,(ACTV_X) + CP L + JP NZ,DSPFNK_1 + PUSH HL + CALL CURSOFF8 + CALL HOME + CALL DELLIN + POP HL + DEC L +DSPFNK_1: + PUSH HL + CALL RSTSYS + CALL ESCA_0 + CALL HOME31 + LD HL,FNKSTR + LD D,$01 + POP BC + POP AF + PUSH BC + JP Z,DSPFNK_2 + LD HL,FNKSTR+80 + LD D,$06 +DSPFNK_2: + LD E,$05 + LD A,(REVERSE) + + PUSH AF ; Save "reverse" status + CALL EXTREV ; Exit from reverse mode +ISFLIO_26: + LD A,(ACTV_Y) + CP 40 + LD BC,$0709 ; pos for 40 columns (7, 9) + JP Z,ISFLIO_27 + LD BC,$0F01 +ISFLIO_27: + PUSH HL + LD HL,CAPTUR+1 + LD A,D + SUB $04 + JP Z,ISFLIO_28 + DEC A + DEC HL +ISFLIO_28: + CALL Z,ENTREV_COND + POP HL + CALL GETWORD_132 + ADD HL,BC + CALL EXTREV + INC D + DEC E + CALL NZ,CPDEHL_0 + JP NZ,ISFLIO_26 + CALL ERAEOL + CALL ISFLIO_2 + POP AF + AND A + CALL NZ,HOME5 + POP HL + CALL POSIT + CALL _ESC_X + XOR A + RET + +; This entry point is used by the routine at SCPTLP. +OUTC_SUB: + PUSH HL + PUSH DE + PUSH BC + PUSH AF + RST $38 + EX AF,AF' ; HOUTD + + CALL OUTC_SUB_0 + JP POPALL + +; This entry point is used by the routine at GETWORD. +OUTC_SUB_0: + LD C,A + XOR A + LD (CRTFLG),A + RST $38 + LD A,(BC) + CALL OUTC_SUB_1 + LD HL,(CSRX) + LD (CSR_ROW),HL + RET + +OUTC_SUB_1: + CALL $7426 + CALL OUTC_SUB_3 +OUTC_SUB_2: + LD HL,(CSRX) + EX DE,HL + CALL MOVE_CURSOR + LD A,(CSR_STATUS) + AND A + RET Z + JP __MENU_75 + +OUTC_SUB_3: + LD HL,ESCCNT + LD A,(HL) + AND A + JP NZ,IN_ESC + LD A,C + CP ' ' + JP C,TTY_VECT_JP_1 + +RSTSYS4: + LD HL,(CSRX) + CP $7F ; BS + JP Z,CURSON2 + LD C,A + CALL ESC_J_1 + CALL LOCK6 + RET NZ + CALL RSTSYS5 + LD H,$01 + CALL LOCK9 + RET NZ + CALL __MENU_199 + AND A + RET NZ + CALL UPD_COORDS + CALL CURSOFF8 + LD L,$01 + JP ESC_M_0 + +RSTSYS5: + CALL TTY_VECT_JP_0_1 + JP HOME33 + +TTY_VECT_JP_0: + SBC A,(HL) + LD C,C + +TTY_VECT_JP_1: + LD HL,ESCTBL-2 + +TTY_VECT_JP: + LD C,$0C + +; This entry point is used by the routine at GET_DEVICE. +TTY_VECT_JP_2: + INC HL + INC HL + AND A + DEC C + RET M + CP (HL) + INC HL + JP NZ,TTY_VECT_JP_2 + LD A,(HL) + INC HL + LD H,(HL) + LD L,A + PUSH HL + LD HL,INVALID_CH + EX (SP),HL + PUSH HL + LD HL,(CSRX) + RET + +TTY_CTLCODES: + DEFB $07 ; Control code + JP location list for TTY controls + DEFW $76EB ; Control code + JP location list for TTY controls + DEFB $08 ; Control code + JP location list for TTY controls + DEFW LOCK8 ; Control code + JP location list for TTY controls + DEFB $09 ; Control code + JP location list for TTY controls + DEFW UNLOCK2 ; Control code + JP location list for TTY controls + DEFB $0A ; Control code + JP location list for TTY controls + DEFW $43B8 ; Control code + JP location list for TTY controls + DEFB $0B ; Control code + JP location list for TTY controls + DEFW ESC_H ; Control code + JP location list for TTY controls + DEFB $0C ; Control code + JP location list for TTY controls + DEFW $45CC ; Control code + JP location list for TTY controls + DEFB $0D ; Control code + JP location list for TTY controls + DEFW CURS_CR ; Control code + JP location list for TTY controls + DEFB $1B ; Control code + JP location list for TTY controls + DEFW ESC_MODE ; Control code + JP location list for TTY controls + DEFB $1C ; Control code + JP location list for TTY controls + DEFW $44ED ; Control code + JP location list for TTY controls + DEFB $1D ; Control code + JP location list for TTY controls + DEFW LOCK8 ; Control code + JP location list for TTY controls + DEFB $1E ; Control code + JP location list for TTY controls + DEFW $44E8 ; Control code + JP location list for TTY controls + DEFB $1F ; Control code + JP location list for TTY controls + DEFW LOCK9 ; Control code + JP location list for TTY controls + +; This entry point is used by the routine at GET_DEVICE. +TTY_VECT_JP_0_1: + LD A,(CRTFLG) + AND A + RET Z + POP AF + RET + +TEXT_LINES: + LD A,(LABEL_LN) + ADD A,$08 + RET + + +; Set cursor position +ESC_Y: + LD A,$02 + defb $01 ; LD BC,NN + +; (27), This routine puts the LCD output routine into ESCape mode +; +; Used by the routine at ESC_W. +ESC_MODE: + ;ESC_MODE+1: XOR A + LD A,$AF + LD (ESCCNT),A + RET + + + +; a.k.a. TTY_ESC +ESCFN: +; a.k.a. TTY_ESC +ESCFN: + DEFM "j" + DEFW _CLS + + DEFM "E" + DEFW _CLS + + DEFM "K" + DEFW ESC_K + + DEFM "J" + DEFW ESC_J + + DEFM "l" + DEFW ESC_CLINE ; ESC,"l", clear line + + DEFM "L" + DEFW ESC_L + + DEFM "M" + DEFW ESC_M + + DEFM "Y" + DEFW ESC_Y + + DEFM "A" + DEFW ESC_A + + DEFM "B" + DEFW ESC_B + + DEFM "C" + DEFW ESC_X_1 + + DEFM "D" + DEFW ESC_D + + DEFM "H" + DEFW ESC_H ; Home cursor + + DEFM "p" + DEFW ESC__p + + DEFM "q" + DEFW ESC__q + + DEFM "P" + DEFW ESC_P + + DEFM "Q" + DEFW ESC_Q + + DEFM "T" + DEFW ESC_T + + DEFM "U" + DEFW ESC_U + + DEFM "V" + DEFW ESC_V + + DEFM "W" + DEFW ESC_W + + DEFM "X" + DEFW ESC_X + + + +; ESCape sequence processor. +; +; Used by the routine at OUTC_SUB. +IN_ESC: + RST $38 + LD B,(HL) + LD A,C + CP $1B + LD A,(HL) + JP Z,LOCK5 + AND A + JP P,LOCK3 + CALL ESC_MODE+1 + LD A,C + LD HL,ESCFN-2 +LOCK2: + LD C,$18 + JP TTY_VECT_JP_2 + +LOCK3: + DEC A + LD (ESCCNT),A + LD A,(ACTV_Y) + LD DE,CSRY + JP Z,LOCK4 + LD A,(ACTV_X) + LD HL,LABEL_LN + ADD A,(HL) + DEC DE +LOCK4: + LD B,A + LD A,C + SUB $20 + CP B + INC A + LD (DE),A + RET C + LD A,B + LD (DE),A + RET + +; Start inverse video mode +ESC__p: + defb $f6 ; OR $AF + +; Cancel inverse video +ESC__q: + XOR A + LD (REVERSE),A + RET + +; Unprotect line 8 +ESC_U: + XOR A + defb $C2 ; JP NZ,NN (always false) + +; Protect line 8 +ESC_T: + LD A,$FF + LD (LABEL_LN),A + RET + +; Stop automatic scrolling +ESC_V: + defb $f6 ; OR $AF + +; Resume automatic scrolling +ESC_W: + XOR A + LD (NO_SCROLL),A + RET + + +;ESC_?: + defb $f6 ; OR $AF +; OR $AF +;ESC_?: + XOR A + LD (CSTYLE),A + RET + +LOCK5: + INC HL + LD (HL),A + JP ESC_MODE + + +; ESC X +ESC_X: + LD HL,ESCSAV + +; This entry point is used by the routine at DSKI_S. +; (Erase last character ?) +ESC_X_0: + LD A,(HL) + LD (HL),$00 + DEC HL + LD (HL),A + RET + + +LOCK6: + LD A,(ACTV_Y) + CP H + RET Z + INC H + JP UPD_COORDS +LOCK7: + DEC H + RET Z + JP UPD_COORDS +LOCK8: + CALL LOCK7 + RET NZ + LD A,(ACTV_Y) + LD H,A + DEC L + RET Z + JP UPD_COORDS + CALL LOCK6 + RET NZ + LD H,$01 +LOCK9: + CALL GET_BT_ROWPOS + CP L + RET Z + JP C,UNIN_ESC + INC L +UPD_COORDS: + LD (CSRX),HL + RET +UNIN_ESC: + DEC L + XOR A + JP UPD_COORDS +UNLOCK2: + LD A,(CSRY) + PUSH AF + LD A,' ' + CALL RSTSYS4 + POP BC + LD A,(CSRY) + CP B + RET Z + DEC A + AND $07 + JP NZ,UNLOCK2 + RET + +; Home cursor (ESC H) and vertical tab (0Bh) +; +; Used by the routine at _CLS. +; Home cursor +ESC_H: + LD L,$01 + +; Move cursor to beginning +; +; Used by the routines at ESC_M and ESC_L. +CURS_CR: + LD H,$01 + JP UPD_COORDS + + LD A,$AF + LD HL,CSR_STATUS + LD (HL),A + CALL TTY_VECT_JP_0_1 + LD A,(HL) + AND A + JP __MENU_76 + + +; Erase current line +ESC_M: + CALL CURS_CR +ESC_M_0: + CALL TTY_VECT_JP_0_1 + CALL TEXT_LINES + SUB L + RET C + JP Z,ESC_CLINE ; ESC,"l", clear line + PUSH HL + PUSH AF + LD B,A + CALL GETTRM + LD L,E +ESC_M_0: + LD H,D + INC HL + CALL LDIR_B + LD HL,FSTPOS + DEC (HL) + POP AF + POP HL +ESC_M_1: + PUSH AF + LD H,40 +ESC_M_2: + INC L + CALL ESC_L_2 + DEC L + CALL RESET_CONSOLE + DEC H + JP NZ,ESC_M_2 + INC L + POP AF + DEC A + JP NZ,ESC_M_1 + JP ESC_CLINE + + +; Insert line +ESC_L: + CALL CURS_CR + CALL TTY_VECT_JP_0_1 + CALL TEXT_LINES + LD H,A + SUB L + RET C + JP Z,ESC_CLINE ; ESC,"l", clear line + LD L,H + PUSH HL + PUSH AF + LD C,A + LD B,$00 + CALL GETTRM + LD L,E + LD H,D + DEC HL + CALL _LDDR + POP AF + POP HL +UNLOCK9: + PUSH AF + LD H,40 +CURSON0: + DEC L + CALL ESC_L_2 + INC L + CALL RESET_CONSOLE + DEC H + JP NZ,CURSON0 + DEC L + POP AF + DEC A + JP NZ,UNLOCK9 + JP ESC_CLINE + +ESC_L_2: + PUSH HL + PUSH HL + CALL ESC_J_4 + LD C,(HL) + POP HL + CALL ESC_J_7 + AND (HL) + POP HL + RET + +CURSON2: + CALL LOCK8 + CALL TTY_VECT_JP_0_1 +CURSON3: + XOR A + LD C,$20 + JP RESET_CONSOLE +ESC_CLINE: + LD H,$01 + +ESC_K: + CALL TTY_VECT_JP_0_1 + CALL HOME32 +CURSON6: + CALL CURSON3 + INC H + LD A,H + CP ')' + JP C,CURSON6 + RET + + CALL ESC_H + CALL CLR_ALTLCD + +; Erase from the cursor to the bottom of the screen +; "erase in display" +ESC_J: + CALL TTY_VECT_JP_0_1 + +CURSON7: + CALL ESC_K + CALL TEXT_LINES + CP L + RET C + RET Z + LD H,$01 + INC L + JP CURSON7 + +ESC_J_1: + CALL TTY_VECT_JP_0_1 + LD A,(REVERSE) + +; This entry point is used by the routines at ESC_M, ESC_L and ESC_K. +RESET_CONSOLE: + PUSH HL + PUSH AF + PUSH HL + PUSH HL + CALL ESC_J_5 + POP HL + CALL ESC_J_4 + LD (HL),C + POP DE + CALL INIT_LCD + POP AF + AND A + POP HL + RET Z +ESC_J_3: + DI + LD A,$0D + JR NC,ESC_J_3 + CALL PUT_SHAPE + LD A,$09 + ;JR NC,$45D3 + JR NC,ESC_J+1 ; ??? + +ESC_J_4: + LD A,L + ADD A,A + ADD A,A + ADD A,L + ADD A,A + ADD A,A + ADD A,A + LD E,A + SBC A,A + CPL + LD D,A + LD L,H + LD H,$00 + ADD HL,DE + LD DE,$FDD7 + ADD HL,DE + RET + +ESC_J_5: + LD B,A + CALL ESC_J_7 + INC B + DEC B + JP Z,$4629 + OR (HL) + JP Z,CALLHL6 + LD (HL),A + RET + +ESC_J_7: + LD A,L + ADD A,A + ADD A,A + ADD A,L + LD L,A + LD A,H + DEC A + PUSH AF + RRCA + RRCA + RRCA + AND $1F + ADD A,L + LD L,A + LD H,$00 + LD DE,$FA5B + ADD HL,DE + POP AF + AND $07 + LD D,A + XOR A + SCF +CURSOFF4: + RRA + DEC D + JP P,CURSOFF4 + RET + +; This entry point is used by the routine at GET_DEVICE. +ESC_J_9: + PUSH HL + CALL ESC_J_7 + XOR (HL) + LD (HL),A + POP HL + RET + +; This entry point is used by the routine at GET_DEVICE. +CLR_ALTLCD: + CALL TTY_VECT_JP_0_1 + LD A,(FNK_FLAG) + ADD A,A + RET P + PUSH HL + LD HL,ALT_LCD + LD BC,$0140 +CURSOFF7: + LD (HL),' ' + INC HL + DEC BC + LD A,B + OR C + JP NZ,CURSOFF7 + POP HL + RET + +CURSOFF8: + CALL TTY_VECT_JP_0_1 + LD A,(FNK_FLAG) + ADD A,A + RET P + LD DE,ALT_LCD + LD HL,$FBE8 + LD BC,$0140 ; 40x8 + JP _LDIR + +; This entry point is used by the routine at GET_DEVICE. +CURSOFF9: + CALL $7426 + LD L,$01 +DELLIN0: + LD H,$01 +DELLIN1: + CALL ESC_L_2 + CALL RESET_CONSOLE + INC H + LD A,H + CP ')' + JP NZ,DELLIN1 + INC L + LD A,L + CP $09 + JP NZ,DELLIN0 + JP OUTC_SUB_2 + +; This entry point is used by the routine at GET_DEVICE. +DELLIN2: + LD HL,ALT_LCD + LD E,$01 +DELLIN3: + LD D,$01 +DELLIN4: + PUSH HL + PUSH DE + LD C,(HL) + CALL INIT_LCD + POP DE + POP HL + INC HL + INC D + LD A,D + CP ')' + JP NZ,DELLIN4 + INC E + LD A,E + CP $09 + JP NZ,DELLIN3 + RET + + +; _INLIN backspace, left arrow, control H handler +; +; Used by the routines at _INLIN, _INLIN_CTL_UX and MOVE_TEXT. +_INLIN_BS: + LD A,B + DEC A + SCF + RET Z + DEC B + DEC DE + CALL DELLIN9 +_INLIN_BS_0: + PUSH AF + LD A,$7F + RST OUTC + LD HL,(CSRX) + DEC L + DEC H + LD A,H + OR L + JP Z,_INLIN_BS_1 + LD HL,CSRY + POP AF + CP (HL) + JP NZ,_INLIN_BS_0 + RET + +_INLIN_BS_1: + POP AF + SCF + RET + +_INLIN_CTL_UX: + CALL _INLIN_BS + JP NC,_INLIN_CTL_UX + RET + +DELLIN9: + PUSH BC + LD A,(SV_CSRY) + DEC B + JP Z,INSLIN3 + LD C,A + LD HL,INPBFR +INSLIN0: + INC C + LD A,(HL) + CP $09 + JP NZ,INSLIN1 + LD A,C + DEC A + AND $07 + JP NZ,INSLIN0 +INSLIN1: + LD A,(ACTV_Y) + CP C + JP NC,INSLIN2 + LD C,$01 +INSLIN2: + INC HL + DEC B + JP NZ,INSLIN0 + LD A,C +INSLIN3: + POP BC + RET + +_INLIN_FILE: + LD HL,(PTRFIL) + PUSH HL + INC HL + INC HL + INC HL + INC HL + LD A,(HL) + SUB $F9 + JP NZ,_INLIN_FILE_0 + LD L,A + LD H,A + LD (PTRFIL),HL ; Redirect I/O + LD HL,SV_TXTPOS + INC (HL) + LD A,(HL) + RRCA + CALL NC,HOME5 + LD HL,CR_WAIT_MSG + CALL PRS + CALL EXTREV +_INLIN_FILE_0: + POP HL + LD (PTRFIL),HL ; Redirect I/O + LD B,$FF + LD HL,INPBFR ; On M100 KBUF is used directly +_INLIN_FILE_1: + XOR A + LD (RAMFILE),A + LD (RAMFILE+1),A + CALL RDBYT + JP C,INSLIN9 + LD (HL),A + CP $0D ; CR + JP Z,_INLIN_FILE_3 + CP $09 ; TAB + JP Z,_INLIN_FILE_2 + CP ' ' + JP C,_INLIN_FILE_1 +_INLIN_FILE_2: + INC HL + DEC B + JP NZ,_INLIN_FILE_1 +_INLIN_FILE_3: + XOR A + LD (HL),A + LD HL,BUFMIN + RET + +INSLIN9: + INC B + JP NZ,_INLIN_FILE_3 + LD A,(NLONLY) + AND $80 + LD (NLONLY),A + CALL SCPTLP_104 + LD A,$0D ; CR + RST OUTC + CALL ERAEOL + LD A,(FILFLG) + AND A + JP Z,ERAEOL0 + CALL RUN_FST + JP EXEC_EVAL_0 + +ERAEOL0: + LD A,(ERRTRP-1) + AND A + JP NZ,__EDIT_3 + JP RESTART + +; This entry point is used by the routine at SNERR. +ERAEOL1: + CALL ISFLIO + JP NZ,_INLIN_FILE + RST $38 + LD B,B + LD L,A + JP ERAEOL4 +; This entry point is used by the routines at __DATA and GET_DEVICE. +QINLIN: + LD A,$3F + RST OUTC + LD A,' ' + RST OUTC +; This entry point is used by the routines at __DATA and GET_DEVICE. +_INLIN: + RST $38 + LD B,D ; HINLI, Hook for INLIN std routine + LD HL,(CSRX) + DEC L + CALL NZ,HOME32 + INC L +ERAEOL4: + LD (FSTPOS),HL + LD A,(CSR_STATUS) + LD ($F99A),A + CALL CURSOFF +ERAEOL5: + CALL CHGET + JP C,ERAEOL5 + LD HL,$47FA + LD C,$08 + CALL TTY_VECT_JP_2 + PUSH AF + CALL NZ,ERAEOL6 + POP AF + JP NC,ERAEOL5 + PUSH AF + LD A,($F99A) + AND A + CALL NZ,CURSON + POP AF + LD HL,BUFMIN + RET Z + CCF + RET +ERAEOL6: + LD HL,$F3DA + CP ' ' + JP C,ERAEOL7 + PUSH AF + LD A,(HL) + AND A + CALL NZ,_ESC_X3 + POP AF + RST OUTC + RET +ERAEOL7: + LD (HL),$00 + RST OUTC + JP HOME2 + EX AF,AF' + ADD HL,BC + LD C,C + LD (DE),A + LD L,A + LD C,B + LD A,(BC) + CALL PO,WORDS_2 + LD E,B + LD C,C + INC BC + LD E,L + LD C,B + DEC C + INC D + LD C,B + DEC D + LD D,D + LD C,C + LD A,A + INC BC + LD C,C + CALL HOME28 + LD DE,INPBFR + LD B,$FE + DEC L +ERAEOL8: + INC L +ERAEOL9: + PUSH DE + PUSH BC + CALL ESC_L_2 + LD A,C + POP BC + POP DE + LD (DE),A + INC DE + DEC B + JP Z,_ESC_X0 + INC H + LD A,$28 + CP H + JP NC,ERAEOL9 + PUSH DE + CALL GETTRM + POP DE + LD H,$01 + JP Z,ERAEOL8 +_ESC_X0: + DEC DE + LD A,(DE) + CP ' ' + JP Z,_ESC_X0 + INC DE + XOR A + LD (DE),A + LD A,$0D + AND A +_ESC_X1: + PUSH AF + CALL HOME32 + CALL POSIT + LD A,$0A + RST OUTC + XOR A + LD ($F3DA),A + POP AF + SCF + POP HL + RET +_ESC_X2: + INC L + CALL GETTRM + JP Z,_ESC_X2 + CALL HOME2 + XOR A + LD (INPBFR),A + LD H,$01 + JP _ESC_X1 + LD HL,$F3DA + LD A,(HL) + CPL + LD (HL),A + AND A + JP Z,HOME2 + JP HOME3 +_ESC_X3: + LD HL,(CSRX) + LD C,$20 + LD A,(REVERSE) +_ESC_X4: + PUSH HL +_ESC_X5: + PUSH BC + PUSH AF + CALL ESC_L_2 + POP DE + LD B,D + POP DE + PUSH BC + PUSH AF + LD C,E + LD A,B + CALL RESET_CONSOLE + POP DE + POP BC + LD A,$28 + INC A + INC H + CP H + LD A,D + JP NZ,_ESC_X5 + POP HL + PUSH DE + CALL GETTRM + POP DE + JP Z,HOME20 + LD A,C + CP ' ' + PUSH AF + JP NZ,_ESC_X6 + LD A,$28 + CP H + JP Z,_ESC_X6 + POP AF + RET +_ESC_X6: + PUSH DE + XOR A + CALL HOME33 + POP DE + INC L + PUSH BC + PUSH DE + PUSH HL + CALL TEXT_LINES + CP L + JP C,_ESC_X7 + EX DE,HL + LD HL,(CSRX) + EX DE,HL + PUSH DE + CALL POSIT + CALL INSLIN + POP HL + CALL POSIT + JP _ESC_X9 +_ESC_X7: + EX DE,HL + LD HL,(CSRX) + EX DE,HL + PUSH DE + LD HL,$0101 + CALL POSIT + CALL DELLIN + POP HL + DEC L + JP NZ,_ESC_X8 + INC L +_ESC_X8: + CALL POSIT + POP HL + DEC L + PUSH HL +_ESC_X9: + POP HL + POP DE + POP BC + POP AF + RET Z + DEC L +HOME20: + LD H,$01 + INC L + LD A,D + JP _ESC_X4 + LD A,$1C + RST OUTC + LD HL,(CSRX) + DEC H + JP NZ,HOME22 + INC H + PUSH HL + DEC L + JP Z,HOME21 + LD A,$28 + LD H,A + CALL GETTRM + JP NZ,HOME21 + EX (SP),HL +HOME21: + POP HL +HOME22: + CALL POSIT +HOME23: + LD A,$28 + CP H + JP Z,HOME25 + INC H +HOME24: + CALL ESC_L_2 + DEC H + CALL RESET_CONSOLE + INC H + INC H + LD A,$28 + INC A + CP H + JP NZ,HOME24 + DEC H +HOME25: + LD C,$20 + XOR A + CALL RESET_CONSOLE + CALL GETTRM + RET NZ + PUSH HL + INC L + LD H,$01 + CALL ESC_L_2 + EX (SP),HL + CALL RESET_CONSOLE + POP HL + JP HOME23 + CALL HOME28 + CALL POSIT + CALL HOME2 + XOR A + LD ($F3DA),A + PUSH HL +HOME26: + CALL GETTRM + PUSH AF + CALL ERAEOL + POP AF + JP NZ,HOME27 + LD H,$01 + INC L + CALL POSIT + JP HOME26 +HOME27: + POP HL + JP POSIT +HOME28: + DEC L + JP Z,HOME29 + CALL GETTRM + JP Z,HOME28 +HOME29: + INC L + LD A,(FSTPOS) + CP L + LD H,$01 + RET NZ + LD HL,(FSTPOS) + RET +GETTRM: + PUSH HL + LD DE,$F826 + LD H,$00 + ADD HL,DE + LD A,(HL) + EX DE,HL + POP HL + AND A + RET +; This entry point is used by the routine at GET_DEVICE. +HOME31: + CALL TTY_VECT_JP_0_1 +HOME32: + LD A,L +HOME33: + PUSH AF + CALL GETTRM + POP AF + LD (DE),A + RET + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + RET Z + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + +; DIM command +__DIM: + LD BC,$49A5 + PUSH BC + + defb $f6 ; OR $AF + +; Get variable address to DE +; +; Used by the routines at __DATA, OPRND, CHKSTK and SCPTLP. +GETVAR: + XOR A + LD (DIMFLG),A + LD C,(HL) + CALL IS_ALPHA + JP C,SNERR + XOR A + LD B,A + RST CHRGTB ; Gets next character (or token) from BASIC text. + JP C,GETVAR_0 + CALL IS_ALPHA_A + JP C,GETVAR_2 +GETVAR_0: + LD B,A +GETVAR_1: + RST CHRGTB ; Gets next character (or token) from BASIC text. + JP C,GETVAR_1 + CALL IS_ALPHA_A + JP NC,GETVAR_1 +GETVAR_2: + CP '&' + JP NC,GETVAR_3 + LD DE,GVAR + PUSH DE + LD D,$02 + CP '%' + RET Z + INC D + CP '$' + RET Z + INC D + CP '!' + RET Z + LD D,$08 + CP '#' + RET Z + POP AF +GETVAR_3: + LD A,C + AND $7F + LD E,A + LD D,$00 + PUSH HL + LD HL,VARIABLES + ADD HL,DE + LD D,(HL) + POP HL + DEC HL + +GVAR: + LD A,D + LD (VALTYP),A + RST CHRGTB ; Gets next character (or token) from BASIC text. + LD A,(SUBFLG) + DEC A + JP Z,SBSCPT_1 + JP P,GETVAR_4 + LD A,(HL) + SUB $28 ; '(' + JP Z,SBSCPT + SUB $33 + JP Z,SBSCPT +GETVAR_4: + XOR A + LD (SUBFLG),A + PUSH HL + LD HL,(PROGND) + JP GETVAR_7 +GETVAR_5: + LD A,(DE) + LD L,A + INC DE + LD A,(DE) + INC DE + CP C + JP NZ,GETVAR_6 + LD A,(VALTYP) + CP L + JP NZ,GETVAR_6 + LD A,(DE) + CP B + JP Z,GETVAR_10 +GETVAR_6: + INC DE + LD H,$00 + ADD HL,DE +GETVAR_7: + EX DE,HL + LD A,(VAREND) + CP E + JP NZ,GETVAR_5 + LD A,($FAE8) + CP D + JP NZ,GETVAR_5 + JP GETVAR_8 +GETVAR_8: + POP HL + EX (SP),HL + PUSH DE + LD DE,$12AA + RST CPDEHL + POP DE + JP Z,GETVAR_11 + EX (SP),HL + PUSH HL + PUSH BC + LD A,(VALTYP) + LD C,A + PUSH BC + LD B,$00 + INC BC + INC BC + INC BC + LD HL,(ARREND) + PUSH HL + ADD HL,BC + POP BC + PUSH HL + CALL __POS_1 + POP HL + LD (ARREND),HL + LD H,B + LD L,C + LD (VAREND),HL +GETVAR_9: + DEC HL + LD (HL),$00 + RST CPDEHL + JP NZ,GETVAR_9 + POP DE + LD (HL),E + INC HL + POP DE + LD (HL),E + INC HL + LD (HL),D + EX DE,HL +GETVAR_10: + INC DE + POP HL + RET + +GETVAR_11: + LD (FACCU),A + LD H,A + LD L,A + LD (DBL_FPREG),HL + RST GETYPR ; Get the number type (FAC) + JP NZ,GETVAR_12 ; JP if not string type, + LD HL,NULL_STRING + LD (DBL_FPREG),HL +GETVAR_12: + POP HL + RET + +; Sort out subscript +; +; Used by the routine at GETVAR. +SBSCPT: + PUSH HL ; Save code string address + LD HL,(DIMFLG) + EX (SP),HL ; Save and get code string + LD D,A ; Zero number of dimensions + +; SBSCPT loop +SCPTLP: + PUSH DE ; Save number of dimensions + PUSH BC ; Save array name + CALL GET_POSINT ; Get subscript + POP BC + POP AF ; Get number of dimensions + EX DE,HL + EX (SP),HL ; Save subscript value + PUSH HL ; Save LCRFLG and TYPE (DIMFLAG) + EX DE,HL + INC A ; Count dimensions + LD D,A ; Save in D + LD A,(HL) ; Get next byte in code string + CP ',' + JP Z,SCPTLP + CP ')' + JP Z,SCPTLP_0 + CP ']' + JP NZ,SNERR +SCPTLP_0: + RST CHRGTB ; Gets next character (or token) from BASIC text. + LD (TEMP2),HL + POP HL + LD (DIMFLG),HL + LD E,$00 + PUSH DE + + defb $11 +; LD DE,$F5E5 + +SBSCPT_1: + PUSH HL + PUSH AF + LD HL,(VAREND) + + ;LD A,$19 + DEFB $3E ; "LD A,n" to Mask the next byte + +SBSCPT_2: + ADD HL,DE + EX DE,HL + LD HL,(ARREND) + EX DE,HL + RST CPDEHL + + JP Z,BSOPRND_0 + LD E,(HL) + INC HL + LD A,(HL) + INC HL + CP C + JP NZ,SCPTLP_1 + LD A,(VALTYP) + CP E + JP NZ,SCPTLP_1 + LD A,(HL) + CP B +SCPTLP_1: + INC HL + LD E,(HL) + INC HL + LD D,(HL) + INC HL + JP NZ,SBSCPT_2 + LD A,(DIMFLG) + OR A + JP NZ,$0577 + POP AF + LD B,H + LD C,L + JP Z,POPHLRT + SUB (HL) + JP Z,SCPTLP_8 + +; This entry point is used by the routine at MLDEBC. +; "Subscript error" / "Subscript out of range" +SBSCT_ERR: + LD DE,$0009 + JP ERROR + +BSOPRND_0: + LD A,(VALTYP) + LD (HL),A + INC HL + LD E,A + LD D,$00 + POP AF + JP Z,FCERR + LD (HL),C + INC HL + LD (HL),B + INC HL + LD C,A + CALL CHKSTK + INC HL + INC HL + LD (TEMP3),HL + LD (HL),C + INC HL + LD A,(DIMFLG) + RLA + LD A,C +SCPTLP_4: + LD BC,$000B + JP NC,SCPTLP_5 + POP BC + INC BC +SCPTLP_5: + LD (HL),C + PUSH AF + INC HL + LD (HL),B + INC HL + CALL MLDEBC + POP AF + DEC A + JP NZ,SCPTLP_4 + PUSH AF + LD B,D + LD C,E + EX DE,HL + ADD HL,DE +; This entry point is used by the routine at ISFLIO. +SCPTLP_6: + JP C,OMERR + CALL $3FD5 + LD (ARREND),HL +SCPTLP_7: + DEC HL + LD (HL),$00 + RST CPDEHL + JP NZ,SCPTLP_7 + INC BC + LD D,A + LD HL,(TEMP3) + LD E,(HL) + EX DE,HL + ADD HL,HL + ADD HL,BC + EX DE,HL + DEC HL + DEC HL + LD (HL),E + INC HL + LD (HL),D + INC HL + POP AF + JP C,SCPTLP_11 +SCPTLP_8: + LD B,A + LD C,A + LD A,(HL) + INC HL + LD D,$E1 + LD E,(HL) + INC HL + LD D,(HL) + INC HL + EX (SP),HL + PUSH AF + RST CPDEHL + JP NC,SBSCT_ERR ; "Subscript error" / "Subscript out of range" + CALL MLDEBC + ADD HL,DE + POP AF + DEC A + LD B,H + LD C,L + JP NZ,$4B6E + LD A,(VALTYP) + LD B,H + LD C,L + ADD HL,HL + SUB $04 + JP C,SCPTLP_9 + ADD HL,HL + JP Z,SCPTLP_10 + ADD HL,HL +SCPTLP_9: + OR A + JP PO,SCPTLP_10 + ADD HL,BC +SCPTLP_10: + POP BC + ADD HL,BC + EX DE,HL +SCPTLP_11: + LD HL,(TEMP2) + RET + +; This entry point is used by the routine at __DATA. +USING: + CALL EVAL_0 + CALL TSTSTR + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEC SP + EX DE,HL + LD HL,(DBL_FPREG) + JP USING_1 +USING_0: + LD A,(FLGINP) + OR A + JP Z,USING_2 + POP DE + EX DE,HL +USING_1: + PUSH HL + XOR A + LD (FLGINP),A + INC A + PUSH AF + PUSH DE + LD B,(HL) + INC B + DEC B +USING_2: + JP Z,FCERR + INC HL + LD A,(HL) + INC HL + LD H,(HL) + LD L,A + JP USING_7 + +SCPTLP_16: + CALL BSOPRND_03 + RST OUTC +USING_7: + XOR A + LD E,A + LD D,A +SCPTLP_18: + CALL BSOPRND_03 + LD D,A + LD A,(HL) + INC HL + CP '#' + JP Z,SBSCT_ERR1 + DEC B + JP Z,BSOPRND_00 + CP '+' + LD A,$08 + JP Z,SCPTLP_18 + DEC HL + LD A,(HL) + INC HL + CP '.' + JP Z,SBSCT_ERR2 + CP (HL) + JP NZ,SCPTLP_16 + CP $5C ;'\' + JP Z,L4C12+1 + CP '*' + JP NZ,SCPTLP_16 + INC HL + LD A,B + CP $02 + JP C,SCPTLP_19 + LD A,(HL) + CP $5C ;'\' +SCPTLP_19: + LD A,' ' + JP NZ,SBSCT_ERR0 + DEC B + INC E + +L4C12: + CP $AF + ; L4C12+1: XOR A + + ADD A,$10 + INC HL +SBSCT_ERR0: + INC E + ADD A,D + LD D,A + +SBSCT_ERR1: + INC E + LD C,$00 + DEC B + JP Z,SBSCT_ERR5 + LD A,(HL) + INC HL + CP '.' + JP Z,SBSCT_ERR3 + CP '#' + JP Z,SBSCT_ERR1 + CP ',' + JP NZ,SBSCT_ERR4 + LD A,D + OR $40 + LD D,A + JP SBSCT_ERR1 + +SBSCT_ERR2: + LD A,(HL) + CP '#' + LD A,'.' + JP NZ,SCPTLP_16 + LD C,$01 + INC HL +SBSCT_ERR3: + INC C + DEC B + JP Z,SBSCT_ERR5 + LD A,(HL) + INC HL + CP '#' + JP Z,SBSCT_ERR3 +SBSCT_ERR4: + PUSH DE + LD DE,SBSCT_ERR5-2 + PUSH DE + LD D,H + LD E,L + CP $5E + RET NZ + CP (HL) + RET NZ + INC HL + CP (HL) + RET NZ + INC HL + CP (HL) + RET NZ + INC HL + LD A,B + SUB $04 + RET C + POP DE + POP DE + LD B,A + INC D + INC HL +; JP Z,GET_DEVICE_691 + JP Z,$D1EB ; ?? probably 'Z' never happens (same trick on MSX) +; EX DE,HL / POP DE + +SBSCT_ERR5: + LD A,D + DEC HL + INC E + AND $08 + JP NZ,SBSCT_ERR7 + DEC E + LD A,B + OR A + JP Z,SBSCT_ERR7 + LD A,(HL) + SUB $2D ; '-' + JP Z,SBSCT_ERR6 + CP $FE + JP NZ,SBSCT_ERR7 + LD A,$08 +SBSCT_ERR6: + ADD A,$04 + ADD A,D + LD D,A + DEC B +SBSCT_ERR7: + POP HL + POP AF + JP Z,BSOPRND_02 + PUSH BC + PUSH DE + CALL EVAL + POP DE + POP BC + PUSH BC + PUSH HL + LD B,E + LD A,B + ADD A,C + CP $19 + JP NC,FCERR ; "Illegal function call" error + + LD A,D + OR $80 + CALL FOUT_0 ; Convert number/expression to string (format specified in 'A' register) + CALL PRS + + POP HL + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + SCF + JP Z,SBSCT_ERR9 + LD (FLGINP),A + CP ';' + JP Z,SBSCT_ERR8 + CP ',' + JP NZ,SNERR +SBSCT_ERR8: + RST CHRGTB ; Gets next character (or token) from BASIC text. +SBSCT_ERR9: + POP BC + EX DE,HL + POP HL + PUSH HL + PUSH AF + PUSH DE + LD A,(HL) + SUB B + INC HL + LD D,$00 + LD E,A + LD A,(HL) + INC HL + LD H,(HL) + LD L,A + ADD HL,DE + LD A,B + OR A + JP NZ,USING_7 + JP BSOPRND_01 +BSOPRND_00: + CALL BSOPRND_03 + RST OUTC +BSOPRND_01: + POP HL + POP AF + JP NZ,USING_0 +BSOPRND_02: + CALL C,OUTDO_CRLF + EX (SP),HL + CALL GSTRHL + POP HL + JP FINPRT + +BSOPRND_03: + PUSH AF + LD A,D + OR A + LD A,'+' + CALL NZ,_OUTC + POP AF + RET + +; This entry point is used by the routines at OUTC and GET_DEVICE. +_OUTC: + PUSH AF + PUSH HL + CALL ISFLIO + JP NZ,OUTC_FOUT + POP HL + LD A,(PRTFLG) + OR A + JP Z,SCPTLP_43 + POP AF + +; Print the character in the A register on the printer. Expand tabs into +; spaces if nescessary +; +; Used by the routines at LPT_OUTPUT and TEL_TERM. +OUTC_TABEXP: + PUSH AF + CP $09 + JP NZ,OUTC_1 +OUTC_TABEXP_0: + LD A,' ' + CALL OUTC_TABEXP + LD A,(LPT_POS) + AND $07 + JP NZ,OUTC_TABEXP_0 + POP AF + RET + +OUTC_1: + SUB $0D + JP Z,OUTC_2 + JP C,OUTC_3 + CP $13 + JP C,OUTC_3 + LD A,(LPT_POS) + INC A +OUTC_2: + LD (LPT_POS),A +OUTC_3: + POP AF +OUTC_4: + CP $1A ; EOF + RET Z + JP LPT_OUT + +; This entry point is used by the routines at SNERR and CHKSTK. +INIT_OUTPUT: + XOR A + LD (PRTFLG),A + LD A,(LPT_POS) + OR A + RET Z + +; This entry point is used by the routine at GET_DEVICE. +INIT_OUTPUT_0: + LD A,$0D + CALL OUTC_4 + LD A,$0A + CALL OUTC_4 + XOR A + LD (LPT_POS),A + RET + +SCPTLP_43: + POP AF + PUSH AF + CALL OUTC_SUB + LD A,(CSRY) + DEC A + LD (TTYPOS),A + POP AF + RET + +; This entry point is used by the routines at SNERR, GETWORD, CHKSTK and GET_DEVICE. +; $4BB8 +CONSOLE_CRLF: + LD A,(CSRY) + DEC A + RET Z + JP OUTDO_CRLF + + LD (HL),$00 + CALL ISFLIO + LD HL,BUFMIN + JP NZ,SCPTLP_46 +; This entry point is used by the routines at __DATA and MAKINT. +OUTDO_CRLF: + LD A,$0D + RST OUTC + LD A,$0A + RST OUTC +; This entry point is used by the routines at __DATA and PRS1. +SCPTLP_46: + CALL ISFLIO + JP Z,SCPTLP_47 + XOR A + RET +SCPTLP_47: + LD A,(PRTFLG) + OR A + JP Z,SCPTLP_48 + XOR A + LD (LPT_POS),A + RET +SCPTLP_48: + XOR A + LD (TTYPOS),A + RET +; This entry point is used by the routine at OPRND. +FN_INKEY: + RST CHRGTB ; Gets next character (or token) from BASIC text. + PUSH HL + CALL CHSNS + JP Z,INKEY_S_0 + CALL CHGET + CP $03 + JP Z,SCPTLP_92 + PUSH AF + CALL MK_1BYTE_TMST + POP AF + LD E,A + CALL __CHR_S_0 +INKEY_S_0: + LD HL,NULL_STRING + LD (DBL_FPREG),HL + LD A,$03 + LD (VALTYP),A + POP HL + RET + +; This entry point is used by the routines at GETWORD and GET_DEVICE. +FNAME: + PUSH HL + JP SCPTLP_53 +; This entry point is used by the routine at GETWORD. +FILE_PARMS: + CALL EVAL + PUSH HL + CALL GETSTR + LD A,(HL) + OR A + JP Z,FILE_PARMS_2 + INC HL + LD E,(HL) + INC HL + LD H,(HL) + LD L,E + LD E,A +SCPTLP_53: + CALL USING6 + PUSH AF + LD BC,FILNAM + LD D,$09 + INC E +SCPTLP_54: + DEC E + JP Z,SCPTLP_60 + LD A,(HL) + CP ' ' + JP C,FILE_PARMS_2 + CP $7F ; BS + JP Z,FILE_PARMS_2 + CP '.' + JP Z,SCPTLP_58 + LD (BC),A + INC BC + INC HL + DEC D + JP NZ,SCPTLP_54 +SCPTLP_55: + POP AF + PUSH AF + LD D,A + LD A,(FILNAM) + INC A + JP Z,FILE_PARMS_2 + POP AF + POP HL + RET +FILE_PARMS_2: + JP NMERR +SCPTLP_57: + INC HL + JP SCPTLP_54 +SCPTLP_58: + LD A,D + CP $09 + JP Z,FILE_PARMS_2 + CP $03 + JP C,FILE_PARMS_2 + JP Z,SCPTLP_57 + LD A,' ' + LD (BC),A + INC BC + DEC D +SCPTLP_59: + JP SCPTLP_58 + + +SCPTLP_60: + LD A,' ' + LD (BC),A + INC BC + DEC D + JP NZ,SCPTLP_60 + JP SCPTLP_55 + +SCPTLP_61: + LD A,(HL) + INC HL + DEC E + RET + + +GETFLP: + CALL MAKINT + +; a.k.a. GETPTR +VARPTR_A: + LD L,A + LD A,(MAXFIL) + CP L + JP C,BNERR + LD H,$00 + LD (RAMFILE),HL + ADD HL,HL + EX DE,HL + LD HL,(FILTAB) + ADD HL,DE + LD A,(HL) + INC HL + LD H,(HL) + LD L,A + LD A,(HL) + OR A + RET Z + PUSH HL + LD DE,$0004 + ADD HL,DE + LD A,(HL) + CP $09 + JP NC,SCPTLP_63 + RST $38 + JR NZ,SCPTLP_59 + OR $51 +SCPTLP_63: + POP HL + LD A,(HL) + OR A + SCF + RET +SCPTLP_64: + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + CP '#' + CALL Z,_CHRGTB + CALL GETINT + EX (SP),HL + PUSH HL + +; a.k.a. SELECT. This entry point is used by the routines at _LOAD, __MERGE and GT_CHANNEL. +SETFIL: + CALL VARPTR_A + JP Z,CFERR + LD (PTRFIL),HL ; Redirect I/O + RST $38 + DEFB $0E ; HSETF, Offset: 14 + RET + +__OPEN: + LD BC,FINPRT + PUSH BC + CALL FILE_PARMS + JP NZ,__OPEN_0 + LD D,$F9 ; D = 'RAM' device ? + +__OPEN_0: + RST SYNCHR ; Check syntax: next byte holds the byte to be found + ADD A,D ; TK_FOR + CP $85 ; TK_INPUT, 'INPUT' TOKEN code + LD E,$01 + JP Z,__OPEN_INPUT + + CP $9C + JP Z,__OPEN_OUTPUT + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB 'A' + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB 'P' + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB 'P' + RST SYNCHR ; Check syntax: next byte holds the byte to be found + ADD A,C + LD E,$08 + JP __OPEN_2 + +__OPEN_OUTPUT: + RST CHRGTB ; Gets next character (or token) from BASIC text. + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB 'P' + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB 'U' + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB 'T' ; "OUTPUT" :S + LD E,$02 + + DEFB $3E ; "LD A,n" to Mask the next byte + + +__OPEN_INPUT: + RST CHRGTB ; Gets next character (or token) from BASIC text. + +__OPEN_2: + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB 'A' + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB 'S' ; 'AS' + PUSH DE + LD A,(HL) + CP '#' + CALL Z,_CHRGTB + CALL GETINT + OR A + JP Z,BNERR + RST $38 + DEFB $1A ; HNOFO, Offset: 26 + +; LD E,$D5 + + DEFB $1E ;LD E,N + +; Routine at 19730 +; +; Used by the routines at __MERGE, __SAVE, __EDIT, TXT_CTL_G and TXT_CTL_V. +_OPEN: + PUSH DE + DEC HL + LD E,A + RST CHRGTB ; Gets next character (or token) from BASIC text. + JP NZ,SNERR + EX (SP),HL + LD A,E + PUSH AF + PUSH HL + CALL VARPTR_A + JP NZ,AOERR + POP DE + LD A,D + CP $09 + RST $38 + DEFB $1E ; HNULO, Offset: 30 + ;LD E,$DA + JP C,IEERR + PUSH HL + LD BC,$0004 + ADD HL,BC + LD (HL),D + LD A,$00 + POP HL + JP GET_DEVICE + +; +; Used by the routines at __CLOSE, INIT_PRINT_h and L4F2E. +CLOSE1: + PUSH HL + OR A + JP NZ,NTFL0 + LD A,(NLONLY) + AND $01 + JP NZ,SCPTLP_95 + +; NTFL0 - "NoT FiLe number 0" +NTFL0: + CALL VARPTR_A + JP Z,_CLOSE_0 + + LD (PTRFIL),HL ; Redirect I/O + PUSH HL + LD A,$02 + JP C,GET_DEVICE + + RST $38 + DEFB $16 ; HNTFL, Offset: 22 + ;LD D,$C3 + JP IEERR + +; LCD, CRT, and LPT file close routine +; +; Used by the routines at GETWORD, RAM_CLS, CAS_CLS and COM_CLS. +_CLOSE: + CALL SCPTLP_94 + POP HL +_CLOSE_0: + PUSH HL + LD DE,$0007 + ADD HL,DE + LD (HL),A + LD H,A + LD L,A + LD (PTRFIL),HL ; Redirect I/O + POP HL + ADD A,(HL) + LD (HL),$00 + POP HL + RET + +; This entry point is used by the routine at __FOR. +_LOAD: + SCF ; Carry flag set for autorun + ;LD DE,CALLHL7 + LD DE,$AFF6 + ;; _LOAD+2: OR $AF -> __LOAD + ;; _LOAD+3: XOR A -> __MERGE + PUSH AF + CALL FILE_PARMS + JP Z,MERGE_SUB + LD A,D + CP $F9 + JP Z,MERGE_SUB + CP $FD + JP Z,__CLOAD_0 + RST $38 + DEFB $1C ; HMERG, Offset: 28 + +; This entry point is used by the routine at GETWORD. +__MERGE_0: + POP AF + PUSH AF + JP Z,_LOAD_0 + LD A,(HL) + SUB ',' + OR A + JP NZ,_LOAD_0 + RST CHRGTB ; Gets next character (or token) from BASIC text. + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB 'R' + POP AF + SCF +; This entry point is used by the routine at GET_DEVICE. +__MERGE_1: + PUSH AF +_LOAD_0: + PUSH AF + XOR A + LD E,$01 + CALL _OPEN + +; This entry point is used by the routine at GETWORD. +__MERGE_3: + LD HL,(PTRFIL) + LD BC,$0007 + ADD HL,BC + POP AF + SBC A,A + AND $80 + OR $01 + LD (NLONLY),A + POP AF + PUSH AF + SBC A,A + LD (FILFLG),A + LD A,(HL) + OR A + JP M,__SAVE_3 + + POP AF + CALL NZ,CLRPTR + CALL CLSALL ; Close all files + XOR A + CALL SETFIL + JP PROMPT + +__SAVE: + CALL FILE_PARMS + JP Z,__LCOPY_6 + LD A,D + CP $F9 + JP Z,__LCOPY_6 + CP $FD + JP Z,GETWORD_227 + RST $38 + JR $4FB3 + RST CHRGTB ; Gets next character (or token) from BASIC text. + LD E,$80 + SCF + JP Z,SCPTLP_78 + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB 'A' + OR A + LD E,$02 +SCPTLP_78: + PUSH AF + LD A,D + CP $09 + JP C,__SAVE_1 + LD A,E + AND $80 + JP Z,__SAVE_1 + LD E,$02 + POP AF + XOR A + PUSH AF +; This entry point is used by the routine at GETWORD. +__SAVE_1: + XOR A + CALL _OPEN + POP AF + JP C,__SAVE_2 + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + JP __LIST +__SAVE_2: + RST $38 + INC H + JP NMERR + +__SAVE_3: + RST $38 + DEFB $26 ; Offset: 38 + JP NMERR + + +; This entry point is used by the routines at __KILL, _CLREG, __END, __MERGE +; and __MAX. +; Close all files +CLSALL: + LD A,(NLONLY) + OR A + RET M + +; Routine at 20007 +CLOSE_FN: + XOR A + +__CLOSE: + LD A,(MAXFIL) + JP NZ,__CLOSE_1 + PUSH HL +SCPTLP_82: + PUSH AF + CALL CLOSE1 + POP AF + DEC A + JP P,SCPTLP_82 + POP HL + RET + +__CLOSE_1: + LD A,(HL) + CP '#' + CALL Z,_CHRGTB + CALL GETINT + PUSH HL + CALL CLOSE1 + POP HL + LD A,(HL) +SCPTLP_84: + CP ',' + RET NZ + RST CHRGTB ; Gets next character (or token) from BASIC text. + JP __CLOSE_1 + +OUTC_FOUT: + POP HL + POP AF + PUSH HL + PUSH DE + PUSH BC + PUSH AF + LD HL,(PTRFIL) + LD A,$04 + CALL __CLOSE_3 + RST $38 + LD ($E4C3),HL + LD D,C + +__CLOSE_3: + PUSH AF + PUSH DE + EX DE,HL + LD HL,$0004 + ADD HL,DE + LD A,(HL) + EX DE,HL + POP DE + CP $09 + JP C,INIT_PRINT_h_1 + POP AF + EX (SP),HL + POP HL + JP GET_DEVICE + +; This entry point is used by the routines at GETWORD and ISFLIO. +RDBYT: + PUSH BC + PUSH HL + PUSH DE + LD HL,(PTRFIL) + LD A,$06 + CALL __CLOSE_3 + RST $38 + DEFB $0A ; Offset: 10 + JP NMERR + +; Routine at 20517 +; +; Used by the routines at L1A3C and RAM_IO. +RDBYT_0: + POP DE + POP HL + POP BC + RET + +; This entry point is used by the routine at OPRND. +SCPTLP_88: + RST CHRGTB ; Gets next character (or token) from BASIC text. + RST SYNCHR ; Check syntax: next byte holds the byte to be found + INC H + RST SYNCHR ; Check syntax: next byte holds the byte to be found + JR Z,$5014 + LD HL,(PTRFIL) + PUSH HL + LD HL,$0000 + LD (PTRFIL),HL ; Redirect I/O + POP HL + EX (SP),HL + CALL GETINT + PUSH DE + LD A,(HL) + CP ',' + JP NZ,SCPTLP_89 + RST CHRGTB ; Gets next character (or token) from BASIC text. + CALL SCPTLP_64 + CP $01 + JP NZ,$51F9 + POP HL + XOR A + LD A,(HL) +SCPTLP_89: + PUSH AF + RST SYNCHR ; Check syntax: next byte holds the byte to be found + ADD HL,HL + POP AF + EX (SP),HL + PUSH AF + LD A,L + OR A + JP Z,FCERR + PUSH HL + CALL MKTMST + EX DE,HL + POP BC +SCPTLP_90: + POP AF + PUSH AF + JP Z,SCPTLP_93 + CALL CHGET + CP $03 + JP Z,SCPTLP_92 +SCPTLP_91: + LD (HL),A + INC HL + DEC C + JP NZ,SCPTLP_90 + POP AF + POP BC + POP HL + RST $38 + LD (DE),A + LD (PTRFIL),HL ; Redirect I/O + PUSH BC + JP TSTOPL +SCPTLP_92: + POP AF + LD HL,(CURLIN) + LD (ERRLIN),HL + POP HL + JP WORDS_1 +SCPTLP_93: + CALL RDBYT + JP C,$51F9 + JP SCPTLP_91 +SCPTLP_94: + CALL SCPTLP_98 + PUSH HL + LD B,$00 + CALL ZERO_MEM +SCPTLP_95: + POP HL + RET +; This entry point is used by the routine at GET_DEVICE. +ZERO_MEM: + XOR A +SCPTLP_97: + LD (HL),A + INC HL + DEC B + JP NZ,SCPTLP_97 + RET +SCPTLP_98: + LD HL,(PTRFIL) + LD DE,$0009 + ADD HL,DE + RET +INIT_PRINT_h_1: + POP AF + RET +; This entry point is used by the routine at SNERR. +INIT_PRINT_h_2: + CALL ISFLIO + JP Z,EXEC + XOR A + CALL CLOSE1 + JP $51EA +; This entry point is used by the routine at __DATA. +SCPTLP_101: + LD C,$01 +; This entry point is used by the routine at __DATA. +SCPTLP_102: + CP '#' + RET NZ + PUSH BC + CALL FNDNUM + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + LD A,E + PUSH HL + CALL SETFIL + LD A,(HL) + POP HL + POP BC + CP C + JP Z,SCPTLP_103 + JP BNERR + +SCPTLP_103: + LD A,(HL) + RET + +; This entry point is used by the routines at SNERR, GETWORD, ISFLIO and +; GET_DEVICE. +SCPTLP_104: + LD BC,$4066 + PUSH BC + XOR A + JP CLOSE1 + +; This entry point is used by the routine at __DATA. +SCPTLP_105: + RST GETYPR ; Get the number type (FAC) + LD BC,$1012 + LD DE,$2C20 + JP NZ,SCPTLP_107 + LD E,D + JP SCPTLP_107 + +; This entry point is used by the routine at __DATA. +SCPTLP_106: + LD BC,FINPRT + PUSH BC + CALL SCPTLP_101 + CALL GETVAR + CALL TSTSTR + PUSH DE + LD BC,$0CB0 + XOR A + LD D,A + LD E,A +SCPTLP_107: + PUSH AF + PUSH BC + PUSH HL +SCPTLP_108: + CALL RDBYT + JP C,$51F9 + CP ' ' + JP NZ,SCPTLP_109 + INC D + DEC D + JP NZ,SCPTLP_108 +SCPTLP_109: + CP '"' + JP NZ,SCPTLP_110 + LD A,E + CP ',' + LD A,$22 + JP NZ,SCPTLP_110 + LD D,A + LD E,A + CALL RDBYT + JP C,SCPTLP_115 +SCPTLP_110: + LD HL,INPBFR + LD B,$FF +SCPTLP_111: + LD C,A + LD A,D + CP '"' + LD A,C + JP Z,SCPTLP_113 + CP $0D + PUSH HL + JP Z,SCPTLP_117 + POP HL + CP $0A + JP NZ,SCPTLP_113 +SCPTLP_112: + LD C,A + LD A,E + CP ',' + LD A,C + CALL NZ,USING2 + CALL RDBYT + JP C,SCPTLP_115 + CP $0A + JP Z,SCPTLP_112 + CP $0D + JP NZ,SCPTLP_113 + LD A,E + CP ' ' + JP Z,SCPTLP_114 + CP ',' + LD A,$0D + JP Z,SCPTLP_114 +SCPTLP_113: + OR A + JP Z,SCPTLP_114 + CP D + JP Z,SCPTLP_115 + CP E + JP Z,SCPTLP_115 + CALL USING2 +SCPTLP_114: + CALL RDBYT + JP NC,SCPTLP_111 +SCPTLP_115: + PUSH HL + CP '"' + JP Z,SCPTLP_116 + CP ' ' + JP NZ,SCPTLP_119 +SCPTLP_116: + CALL RDBYT + JP C,SCPTLP_119 + CP ' ' + JP Z,SCPTLP_116 + CP ',' + JP Z,SCPTLP_119 + CP $0D + JP NZ,SCPTLP_118 +SCPTLP_117: + CALL RDBYT + JP C,SCPTLP_119 + CP $0A + JP Z,SCPTLP_119 +SCPTLP_118: + LD HL,(PTRFIL) + LD C,A + LD A,$08 + CALL __CLOSE_3 + RST $38 + INC D + JP NMERR +; This entry point is used by the routine at GETWORD. +SCPTLP_119: + POP HL +USING0: + LD (HL),$00 + LD HL,BUFMIN + LD A,E + SUB $20 + JP Z,USING1 + LD B,$00 + CALL QTSTR_0 + POP HL + RET +USING1: + RST GETYPR ; Get the number type (FAC) + PUSH AF + RST CHRGTB ; Gets next character (or token) from BASIC text. + POP AF + PUSH AF + CALL C,DBL_ASCTFP + POP AF + CALL NC,DBL_DBL_ASCTFP + POP HL + RET +USING2: + OR A + RET Z + LD (HL),A + INC HL + DEC B + RET NZ + POP AF + JP USING0 +; This entry point is used by the routine at GETWORD. +NMERR: + LD E,$37 + LD BC,$351E + LD BC,$381E + LD BC,$341E + LD BC,$3A1E + LD BC,$331E + LD BC,FP_ARG2HL +USING4: + LD BC,$361E + LD BC,_DBL_ASCTFP_37 + JP ERROR + +; Routine at 20993 +__LOF: + RST $38 + LD (HL),H + +; Routine at 20995 +__LOC: + RST $38 + HALT + +__LFILES: + RST $38 + LD A,B + +__DSKO_S: + RST $38 + LD A,H + +; This entry point is used by the routine at OPRND. +USING5: + RST $38 + LD A,D + +__DSKF: + RST $38 + ADC A,(HL) + + +; Routine at 21005 +L520D: + RST $38 + SUB B + +__FORMAT: + RST $38 + SUB D +USING6: + RST $38 + LD HL,($FE7E) + LD A,(FCOMP_14) + LD D,D + PUSH HL + LD D,E + CALL SCPTLP_61 + JP Z,USING8 +USING7: + CP $3A + JP Z,$5237 + CALL SCPTLP_61 + JP P,USING7 +USING8: + LD E,D + POP HL + XOR A + RST $38 + INC L + RET + RST $38 + JR NC,USING4 + CALL PO,GET_DEVICE_608 + SUB E + DEC A + CP $02 + JP NC,$5244 + RST $38 + LD L,$C3 + CALL PO,PTRFIL_1 + DEC B + JP NC,NMERR ; NM error: bad file name + POP BC + PUSH DE + PUSH BC + LD C,A + LD B,A + LD DE,$528D + EX (SP),HL + PUSH HL +USING9: + CALL UCASE_HL + PUSH BC + LD B,A + LD A,(DE) + INC HL + INC DE + CP B + POP BC + JP NZ,USING_02 + DEC C + JP NZ,USING9 +USING_00: + LD A,(DE) + OR A + JP M,USING_01 + CP $31 + JP NZ,USING_02 + INC DE + LD A,(DE) + JP USING_02 +USING_01: + POP HL + POP HL + POP DE + OR A + RET +USING_02: + OR A + JP M,USING_00 +USING_03: + LD A,(DE) + OR A + INC DE + JP P,USING_03 + LD C,B + POP HL + PUSH HL + LD A,(DE) + OR A + JP NZ,USING9 + JP NMERR + LD C,H + LD B,E + LD B,H + RST $38 + LD B,E + LD D,D + LD D,H + CP $43 + LD B,C + LD D,E + DEFB $FD + LD B,E + LD C,A + LD C,L + CALL M,$4157 + LD C,(HL) + LD B,H + EI + LD C,H + LD D,B + LD D,H + JP M,$4152 + LD C,L + LD SP,HL + NOP + +; Data block at 21163 +; +; Device vector +DEVICE_VECT: + DEFW L1942 + DEFW CRT_CTL + DEFW L1AF7 + DEFW L1BDA + DEFW L1CEC + DEFW L1BCC + DEFW RAM_CTL + +; Get the device table associated to dev# in A +; +; Used by the routines at GETWORD and SCPTLP. +GET_DEVICE: + RST $38 + LD ($D5E5),A + PUSH AF + LD DE,$0004 + ADD HL,DE + LD A,$FF + SUB (HL) + ADD A,A + LD E,A + LD D,$00 + LD HL,DEVICE_VECT + ADD HL,DE + LD E,(HL) + INC HL + LD D,(HL) + POP AF + LD L,A + LD H,$00 + ADD HL,DE + LD E,(HL) + INC HL + LD D,(HL) + EX DE,HL + POP DE + EX (SP),HL + RET + +GET_DEVICE_0: + RST $38 + LD C,B + CALL UNLOCK + LD HL,$5334 + CALL STDSPF + JP GET_DEVICE_4 +GET_DEVICE_1: + RST $38 + LD D,(HL) + CALL __BEEP + LD HL,$5334 + CALL STFNK +GET_DEVICE_2: + CALL STKINI + LD HL,GET_DEVICE_1 + LD (ERRTRP),HL + LD HL,$5318 + CALL PRINT_LINE + CALL _INLIN + RST CHRGTB ; Gets next character (or token) from BASIC text. + AND A + JP Z,GET_DEVICE_2 + EX DE,HL + LD HL,($F3C0) + EX DE,HL + CALL PARSE_COMMAND + JP Z,GET_DEVICE_1 + RET + + LD D,H + LD H,L + LD L,H + LD H,E + LD L,A + LD L,L + LD A,(OUTC) + LD D,E + LD D,H + LD B,C + LD D,H + LD C,L + LD D,E + LD D,H + LD B,L + LD D,D + LD C,L + ADC A,B + LD D,E + LD C,L + LD B,L + LD C,(HL) + LD D,L + LD B,L + LD D,(HL) + RST $38 + NOP + NOP + NOP + LD D,E + LD (HL),H + LD H,C + LD (HL),H + JR NZ,GET_DEVICE_3 +GET_DEVICE_3: + LD D,H + LD H,L + LD (HL),D + LD L,L + DEC C + NOP + NOP + NOP + NOP + NOP + LD C,L + LD H,L + LD L,(HL) + LD (HL),L + DEC C + NOP + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + AND A + JP NZ,GET_DEVICE_6 +GET_DEVICE_4: + LD HL,$F406 + LD B,$06 +GET_DEVICE_5: + LD A,(HL) + RST OUTC + INC HL + DEC B + JP NZ,GET_DEVICE_5 + JP GET_DEVICE_2 +GET_DEVICE_6: + CALL GETWORD_91 + CALL __MENU_02 + JP GET_DEVICE_2 + + JR NZ,GET_DEVICE_9 + LD (HL),D + LD H,L + HALT + NOP + NOP + NOP + JR NZ,TEL_TERM_0 + LD D,L + LD (HL),B + NOP + JR NZ,$53BE + LD L,A + LD (HL),A + LD L,(HL) + NOP + NOP + NOP + NOP + NOP + JR NZ,$53A4 + LD B,D + LD A,C + LD H,L + NOP + + RST $38 + LD C,D + + LD HL,$F406 + CALL GETWORD_91 + LD A,$40 + LD (FNK_FLAG),A + +TEL_TERM_0: + LD ($F45C),A + XOR A + LD (CAPTUR),A + LD (CAPTUR+1),A + CALL CLR_ALTLCD + LD HL,TERM_BAR ;$536B + CALL STFNK + CALL DUPDSP ; Display terminal 'DUPLEX' status + CALL ECHDSP + CALL DSPFNK + CALL CURSON +TEL_TERM_LOOP: + CALL RESTAK + LD HL,TEL_TERM_TRAP ;$5427 + LD (ERRTRP),HL +GET_DEVICE_9: + CALL CHSNS + JP Z,GET_DEVICE_10 + CALL CHGET + LD B,A + JP C,GET_DEVICE_18 + AND A + CALL NZ,SD232C + JP C,GET_DEVICE_16 + LD A,(DUPLEX) + AND A + LD A,B + JP Z,GET_DEVICE_11 +GET_DEVICE_10: + CALL RCVX + JP Z,TEL_TERM_LOOP + CALL RV232C +GET_DEVICE_11: + LD B,A + JP C,TEL_TERM_LOOP + JP Z,GET_DEVICE_12 + LD A,$82 +GET_DEVICE_12: + CP $7F ; BS + JP NZ,GET_DEVICE_13 + LD A,(CSRY) + DEC A + LD A,B +GET_DEVICE_13: + CALL NZ,_OUTC + CALL TEL_TERM_INTRPT + CALL GET_DEVICE_37 + JP TEL_TERM_LOOP + +TEL_TERM_INTRPT: + LD B,A + LD A,(ECHO) + AND A + LD A,B + RET Z + LD HL,OUTC_TABEXP +; This entry point is used by the routine at _DBL_ASCTFP. +GET_DEVICE_15: + PUSH HL + CP ' ' + RET NC + CP $1B + RET Z + POP HL + CP $08 + RET C + CP $0E ; Line number prefix + RET NC + JP (HL) + +GET_DEVICE_16: + XOR A + LD (ENDLCD),A +GET_DEVICE_17: + CALL BREAK + JP C,GET_DEVICE_17 + JP TEL_TERM_LOOP + CALL __BEEP + XOR A + LD (ECHO),A + CALL ECHDSP + JP TEL_TERM_LOOP +GET_DEVICE_18: + LD E,A + LD D,$FF + LD HL,($F3C2) + ADD HL,DE + ADD HL,DE + LD A,(HL) + INC HL + LD H,(HL) + LD L,A + LD DE,TEL_TERM_LOOP + PUSH DE + JP (HL) + LD E,C + LD D,H + LD (HL),H + LD D,H + ADD A,(HL) + LD D,H + PUSH BC + LD D,H + LD D,B + LD D,L + OR H + LD D,E + OR H +GET_DEVICE_19: + LD D,E + OR H + LD D,E + OR H + LD D,E + RET P + LD D,L + CALL TTY_VECT_JP_0_1 + CALL CURSOFF +GET_DEVICE_20: + CALL DELLIN2 +GET_DEVICE_21: + CALL CHSNS + JP Z,GET_DEVICE_21 + CALL CHGET + CALL CURSOFF9 + CALL CURSON + JP _ESC_X + LD HL,DUPLEX + LD A,(HL) + CPL + LD (HL),A + +; Routine at 21828 +; +; Used by the routine at TEL_TERM. +; Display terminal 'DUPLEX' status +DUPDSP: + LD A,(DUPLEX) + LD DE,$F6B5 + LD HL,FULLHALF_MSG ;$54AD + JP CHGDSP + + +; TELCOM ECHO function routine +TEL_ECHO: + LD HL,ECHO + LD A,(HL) + CPL + LD (HL),A +; +; Used by the routine at TEL_TERM. +; Display terminal 'ECHO' status +ECHDSP: + LD A,(ECHO) + LD DE,$F6C5 + LD HL,$54B5 + +CHGDSP: + AND A + LD BC,$0004 + JP NZ,CHGDSP_0 + ADD HL,BC + +CHGDSP_0: + LD B,C + CALL LDIR_B + LD B,$0C + XOR A +CHGDSP_1: + LD (DE),A + INC DE + DEC B + JP NZ,CHGDSP_1 + JP FNKSB + +; Message at 21677 +FULLHALF_MSG: + DEFM "FullHalf" + +ECHO_MSG: + DEFM "Echo " + +CR_WAIT_MSG: + DEFB $0D + DEFM " " + +WAIT_MSG: + DEFM "Wait " + DEFB $00 + +; TELCOM UP function routine +TEL_UPLD: + LD HL,UPLOAD_ABORT ;$55C1 + LD (ERRTRP),HL + PUSH HL + LD A,(CAPTUR) + AND A + RET NZ + CALL RESFPT_0 + LD HL,UPLMSG_0 ;$560A + CALL PRINT_LINE + CALL QINLIN ; User interaction with question mark, HL = resulting text + RST CHRGTB ; Gets next character (or token) from BASIC text. + AND A + RET Z + LD (FNAME_END),A + CALL COUNT_CHARS + CALL FNAME + RET NZ + CALL FINDCO_0 + LD HL,FNTFND ; "No file" (file not found) ..$5635 + JP Z,PRINT_LINE + EX DE,HL + EX (SP),HL + LD A,$01 + LD (CAPTUR+1),A + CALL FNKSB + POP HL + +TEL_UPLD_1: + LD A,(HL) + CP $1A ; EOF + RST $38 + LD E,D ; HC_UPLD + + JP Z,TEL_UPLD_STOP + CP $0A + JP NZ,TEL_UPLD_4 + LD A,(RS232LF) + AND A + JP NZ,TEL_UPLD_4 + LD A,(FNAME_END) + CP $0D +TEL_UPLD_4: + LD A,(HL) + LD (FNAME_END),A + JP Z,TEL_UPLD_5 + CALL SD232C + CALL TEL_UPLD_7 +TEL_UPLD_5: + INC HL + CALL CHSNS + JP Z,TEL_UPLD_1 + CALL CHGET + CP $03 ; CTL_C ? + JP Z,TEL_UPLD_STOP + CP $13 ; PAUSE ? + CALL Z,CHGET + CP $03 ; CTL_C ? + JP NZ,TEL_UPLD_1 +TEL_UPLD_STOP: + XOR A + LD (CAPTUR+1),A + JP FNKSB + +TEL_UPLD_7: + CALL RCVX + RET Z + CALL RV232C + RET C + RST OUTC + JP TEL_UPLD_7 + +; TELCOM DOWN function routine +TEL_DOWNLD: + CALL RESFPT_0 + LD A,(CAPTUR) + XOR $FF + LD (CAPTUR),A + JP Z,DWNLDR_2 + LD HL,DOWNLOAD_ABORT + +DWNLDR: + LD (ERRTRP),HL + PUSH HL + LD HL,DWNFMSG ; "File to Download" ..$5619 + CALL PRINT_LINE + CALL QINLIN ; User interaction with question mark, HL = resulting text + RST CHRGTB ; Gets next character (or token) from BASIC text. + AND A + RET Z + LD (FNAME_END),A + POP AF +DWNLDR_0: + PUSH HL + CALL OPENDO + JP C,DWNLDR_1 + LD (SV_TXTPOS),HL + CALL GETEND + POP AF + CALL TXT_CTL_C_15 + JP FNKSB + +DWNLDR_1: + EX DE,HL + CALL KILLASC+1 + POP HL + JP DWNLDR_0 + +DWNLDR_2: + CALL FNKSB + JP TXT_WIPE_END + +GET_DEVICE_37: + LD C,A + LD A,(CAPTUR) + AND A + LD A,C + RET Z + CALL DWNLDR_6 + RET Z + JP NC,DWNLDR_4 + CALL DWNLDR_4 + LD A,$0A ; 10 +DWNLDR_4: + LD HL,(SV_TXTPOS) + CALL TXT_SPLIT_ROW + LD (SV_TXTPOS),HL + RET NC ; RET if at the end of text + +DOWNLOAD_ABORT: + XOR A + LD (CAPTUR),A + CALL FNKSB + LD HL,DWNMSG ;$5621 + JP PRS_ABORTMSG + +UPLOAD_ABORT: + LD HL,UPLMSG ;$5612 + +PRS_ABORTMSG: + CALL PRINT_LINE + LD HL,ABTMSG ;$562A + CALL PRS + JP TEL_TERM_LOOP + +; This entry point is used by the routine at GETWORD. +DWNLDR_6: + LD C,A + AND A + RET Z + CP $1A ; EOF + RET Z + CP $7F ; BS + RET Z + CP $0A + JP NZ,GET_DEVICE_41 + LD A,(FNAME_END) + CP $0D +GET_DEVICE_41: + LD A,C + LD (FNAME_END),A + RET Z + CP $0D + SCF + CCF + RET NZ + AND A + SCF + RET + CALL CONSOLE_CRLF + RST $38 + LD C,H + XOR A + LD (FNK_FLAG),A + LD L,A + LD H,A + LD (CAPTUR),HL + CALL __MENU_02 + CALL CURSOFF + CALL MCLEAR_0 + JP GET_DEVICE_0 + +; Message at 22026 +UPLMSG_0: + DEFM "File to " +UPLMSG: + DEFM "Upload" + DEFB $00 + +DWNFMSG: + DEFM "File to " +DWNMSG: + DEFM "Download" + DEFB $00 + +ABTMSG: + DEFM " aborted" + DEFB $0D + DEFB $0A + DEFB $00 + +FNTFND: + DEFM "No file" + DEFB $0D + DEFB $0A + DEFB $00 + + + +; This entry point is used by the routine at GETWORD. +PRINT_LINE: + CALL CONSOLE_CRLF + JP PRS + +; This entry point is used by the routine at GETWORD. +__MENU: + SUB A + LD (PRTFLG),A + CALL _CLVAR + CALL __MENU_02 + CALL MCLEAR_0 + CALL RESFPT + CALL TEL_UPLD_18 + LD A,' ' + LD (FNK_FLAG),A + LD A,$FF + LD (MENU_FLG),A + LD A,($F3E4) + LD ($F59C),A + SUB A + LD (ESCCNT),A + LD ($F590),A + CALL __SCREEN_SUB + CALL EXTREV + CALL CURSOFF + CALL LOCK +__MENU_0: + CALL STKINI + SUB A + LD ($F9BB),A + CALL ERAFNK + LD HL,__MENU_0 + LD (ERRTRP),HL + CALL _PRINT_TDATE + LD HL,IOOPRND_0 + CALL POSIT + LD HL,COPYRIGHT_MSG ;$7FAF + CALL PRINT_TEXT + LD A,$23 + RST OUTC + IN A,($A0) +__MENU_1: + AND $0C + RRCA + RRCA + CP $01 + ADC A,$30 + RST OUTC + LD HL,$F543 + LD ($F579),HL + LD B,$36 + +__MENU_2: + LD (HL),$FF + INC HL + DEC B + JP NZ,__MENU_2 + LD L,B + LD DE,$5E61 + LD A,$B0 +__MENU_3: + LD C,A + PUSH DE + CALL __MENU_21 + POP DE + LD A,(DE) + INC DE + OR A + JP NZ,__MENU_3 + LD A,L + LD ($F591),A +__MENU_4: + CP $18 ; TEXT down arrow + JP Z,__MENU_5 + CALL GET_DEVICE_135 + PUSH HL + LD HL,NOFILE_MRK + CALL PRINT_TEXT + POP HL + INC L + LD A,L + JP __MENU_4 + +__MENU_5: + LD A,($F590) + LD L,A + CALL __MENU_10 + CALL CLRFLK + LD HL,$2208 ; cursor coordinates + CALL POSIT + CALL FREEMEM + LD HL,FBUFFR+1 + LD DE,$F6E5 + LD B,$01 + CALL STFNK_0 +__MENU_6: + SUB A + LD ($F9BB),A + CALL SCPTLP_104 + CALL PRINT_TDATE + CALL DSPFNK + LD HL,FSTFLG + SUB A + CP (HL) + JP Z,__MENU_8 + LD (HL),A + LD HL,DIRECTORY + LD B,$1B +__MENU_7: + LD A,(HL) + INC A + JP Z,__MENU_8 + DEC A + CP $C4 + JP Z,GET_DEVICE_59 + CALL GET_DEVICE_189 + JP NZ,__MENU_7 +__MENU_8: + OR $97 + CALL Z,__BEEP + CALL STKINI + LD HL,$572D + LD (ERRTRP),HL + CALL TEXT + JP C,GET_DEVICE_69 + CP $0D + JP Z,__MENU_18 + LD BC,$573A + PUSH BC + CP ' ' + JP C,__MENU_9 + RET NZ + LD A,$1C +__MENU_9: + LD HL,($F590) + LD E,L + SUB $1C + RET M + LD BC,$576E + PUSH BC + JP Z,GET_DEVICE_58 + DEC A + JP Z,GET_DEVICE_57 + DEC A + POP BC + JP Z,GET_DEVICE_56 + LD A,E + ADD A,$04 + LD D,A + CP H + RET P + LD ($F590),A + LD L,E + PUSH DE + CALL __MENU_10 + POP DE + LD L,D + +__MENU_10: + CALL $7426 + CALL GET_DEVICE_135 + LD B,$0A + PUSH HL + LD HL,CSRY + DEC (HL) +__MENU_11: + PUSH BC + PUSH DE + LD HL,(CSRX) + CALL ESC_J_9 + EX DE,HL + CALL MOVE_CURSOR + DI + CALL PUT_SHAPE + EI + POP DE + LD HL,CSRY + INC (HL) + POP BC + DEC B + JP NZ,__MENU_11 + CALL $7426 + POP HL + RET + +GET_DEVICE_56: + LD A,E + SUB $04 + LD D,A + RET M + PUSH BC + RET + +GET_DEVICE_57: + LD A,E + DEC A + LD D,A + RET P + LD D,H + DEC D + LD A,D + RET + +GET_DEVICE_58: + LD A,E + INC A + LD D,A + CP H + RET M + SUB A + LD D,A + RET + +GET_DEVICE_59: + CALL GET_DEVICE_160 + EX DE,HL + LD HL,IPLBBUF + PUSH HL + LD B,$40 + CALL GET_DEVICE_65 + LD (HL),$00 + INC HL + LD (HL),$00 + POP DE + LD HL,$F57B + LD BC,$0A00 +GET_DEVICE_60: + LD A,(DE) + CP '.' + JP NZ,GET_DEVICE_61 + LD C,$7F +GET_DEVICE_61: + INC C + CALL M,UCASE + OR A + JP Z,GET_DEVICE_63 + CP $0D + JP Z,GET_DEVICE_62 + LD (HL),A + INC DE + INC HL + DEC B + JP NZ,GET_DEVICE_60 + JP $572D + +GET_DEVICE_62: + INC DE +GET_DEVICE_63: + LD (HL),$00 + PUSH DE + CALL CHKF_0 + JP Z,$572D + PUSH HL + CALL CHSNS + JP Z,GET_DEVICE_64 + CALL CHGET + CP $03 + JP Z,$572D +GET_DEVICE_64: + POP DE + POP HL + LD (FNKPNT),HL + EX DE,HL + JP __MENU_19 + +GET_DEVICE_65: + LD A,(DE) + CP $1A ; EOF + RET Z + LD (HL),A + INC HL + INC DE + DEC B + RET Z + JP GET_DEVICE_65 + +__MENU_18: + CALL GET_DEVICE_158 +__MENU_19: + PUSH HL + CALL ERAFNK + CALL __CLS + CALL UNLOCK + LD A,($F59C) + CALL __SCREEN_SUB + CALL RSTSYS + LD A,$0C + RST OUTC + CALL UNLOCK + CALL EXTREV + CALL HOME2 + SUB A + LD (MENU_FLG),A + LD (FNK_FLAG),A + LD L,A + LD H,A + LD (ERRTRP),HL + POP HL + LD A,(HL) + AND $F0 + CALL GET_DEVICE_160 + CP $A0 + JP Z,LDIR_B_0 + CP $B0 + JP Z,CALLHL + CP $F0 + JP Z,TEL_TERM_002 + CP $C0 + JP Z,EDIT_TEXT + CP $80 + JP NZ,__MENU_0 + LD (BASTXT),HL + DEC DE + DEC DE + EX DE,HL + LD (DIRPNT),HL + CALL UPD_PTRS + CALL LOAD_BA_LBL + CALL DSPFNK + CALL RUN_FST + JP EXEC_EVAL_0 + +CALLHL: + JP (HL) + +GET_DEVICE_69: + LD HL,TEL_TERM_00 + LD (ERRTRP),HL + PUSH AF + LD A,$FF + LD ($F9BB),A + CALL ERAFNK + POP AF + SUB $F7 + JP C,TEL_TERM_LOOP0 + CP $08 + JP Z,$7EAB + CP $05 + JP Z,GET_DEVICE_93 + OR A + PUSH AF + CALL GET_DEVICE_158 + PUSH HL + CALL GET_DEVICE_160 + EX DE,HL + POP HL + LD A,(HL) + LD C,A + POP AF + PUSH AF + CP $01 + LD A,C + JP Z,GET_DEVICE_107 + AND $10 + JP NZ,TEL_TERM_00 + LD A,(HL) + AND $60 + RLCA + RLCA + RLCA + LD C,A + POP AF + PUSH HL + PUSH DE + PUSH BC + PUSH HL + JP Z,TEL_TERM_01 + DEC A + DEC A + JP Z,TXT_ASK_WIDTH + DEC A + DEC A + JP Z,GET_DEVICE_93 + CP $03 + JP Z,GET_DEVICE_105 +TEL_TERM_00: + CALL SCPTLP_104 + CALL __BEEP + CALL RESTAK + JP __MENU_6 + +TEL_TERM_01: + CALL GET_DEVICE_92 + POP HL + PUSH HL + CALL GET_DEVICE_122 + LD HL,$5EDB + CALL PRINT_TEXT + LD A,$0D + CALL GET_DEVICE_111 + POP DE + LD A,($F58F) + OR A + JP Z,TEL_TERM_02 + DEC HL + LD A,(HL) + INC HL + CP $3A + JP NZ,TEL_TERM_03 + DEC HL + DEC HL + LD A,(HL) + INC HL + INC HL + CALL UCASE + CP $4D + JP Z,TEL_TERM_03 +TEL_TERM_02: + INC DE + INC DE + INC DE + CALL MOVE_6_BYTES +TEL_TERM_03: + LD (HL),$00 + POP BC + DEC C + JP M,TEL_TERM_05 + JP NZ,$593A + CALL GET_DEVICE_124 + POP HL + PUSH DE + CALL CLOADM_7 + POP DE + RST $38 + LD A,($60C3) + LD H,$CD + PUSH HL + LD E,H + POP HL +TEL_TERM_04: + LD A,(HL) + RST OUTC + INC HL + CP $1A ; EOF + JP NZ,TEL_TERM_04 + JP __MENU_6 + +TEL_TERM_05: + CALL TEL_TERM_LOOP9 + LD A,D + CP $FC + JP Z,TEL_TERM_06 + LD HL,$5EB2 + CALL GET_DEVICE_121 + CALL SHOW_TIME + CALL CHGET_UCASE + CP $0D + JP Z,TEL_TERM_09 + CP $42 + JP Z,TEL_TERM_08 + CP $41 + JP NZ,__MENU_6 + RST OUTC +TEL_TERM_06: + CALL GET_DEVICE_126 +TEL_TERM_07: + POP HL + LD (BASTXT),HL + SUB A + JP __LIST +TEL_TERM_08: + RST OUTC +TEL_TERM_09: + CALL GET_DEVICE_124 + POP HL + LD (BASTXT),HL + RST $38 + JR C,$5947 + PUSH HL + DEC H +TEL_TERM_LOOP0: + LD HL,__MENU + LD (ERRTRP),HL + LD HL,$5E79 + CALL GET_DEVICE_121 + LD HL,$5ED2 + CALL PRINT_TEXT + LD HL,$F57B + LD DE,GET_DEVICE_164 + PUSH DE + PUSH DE + CALL TEL_TERM_INTRPT3 + LD (HL),$00 + POP DE + LD HL,FILNAM + CALL TEL_TERM_INTRPT2 + LD HL,$F99B + POP DE + CALL TEL_TERM_INTRPT2 + LD A,$0D + CALL GET_DEVICE_111 + LD A,($F58F) + LD D,$FD + OR A + JP Z,TEL_TERM_LOOP5 + LD B,$0D + LD DE,$F57B +TEL_TERM_LOOP1: + LD A,(DE) + INC DE + CP $3A + JP Z,TEL_TERM_LOOP2 + DEC B + JP NZ,TEL_TERM_LOOP1 + LD DE,$F57B + JP TEL_TERM_LOOP3 +TEL_TERM_LOOP2: + LD A,(DE) + OR A + JP Z,TEL_TERM_LOOP4 +TEL_TERM_LOOP3: + LD HL,FILNAM + CALL TEL_TERM_INTRPT4 +TEL_TERM_LOOP4: + CALL TEL_TERM_LOOP9 +TEL_TERM_LOOP5: + PUSH DE + CALL GET_DEVICE_92 + LD HL,$5EDC + CALL PRINT_TEXT + LD A,$09 + CALL GET_DEVICE_111 + LD A,($F58F) + CP $03 + JP C,TEL_TERM_00 + DEC HL + CALL UCASE_HL + LD (HL),A + LD ($F9A2),A + DEC HL + CALL UCASE_HL + LD (HL),A + LD ($F9A1),A + DEC HL + LD DE,$5E66 + LD A,(HL) + CP '.' + JP NZ,TEL_TERM_00 + CALL PARSE_COMMAND + JP Z,TEL_TERM_00 + POP AF + POP DE + PUSH AF + CP $C0 + JP Z,TEL_TERM_LOOP6 + CALL GET_DEVICE_90 + JP Z,TEL_TERM_00 +TEL_TERM_LOOP6: + CALL GET_DEVICE_91 + JP Z,TEL_TERM_00 + PUSH DE + CALL CHKF_0 + JP Z,TEL_TERM_LOOP7 + PUSH HL + CALL GET_DEVICE_160 + PUSH HL + CALL __BEEP + CALL GET_DEVICE_127 + JP NZ,__MENU_6 + POP DE + POP HL + POP BC + POP AF + PUSH AF + PUSH BC + CP $A0 + CALL GET_DEVICE_106 + JP TEL_TERM_LOOP8 +TEL_TERM_LOOP7: + LD A,($F591) + CP $18 + JP Z,TEL_TERM_00 + CALL GET_DEVICE_125 +TEL_TERM_LOOP8: + LD HL,$F99B + LD DE,$F57B + CALL TEL_TERM_INTRPT4 + SUB A + LD ($F590),A + POP DE + POP AF + JP GETWORD_212 +TEL_TERM_LOOP9: + LD HL,$F57B + CALL COUNT_CHARS + CALL FNAME + RET NZ + LD D,$FD + RET +GET_DEVICE_90: + LD A,D + CP $FC + RET Z +GET_DEVICE_91: + LD A,D + CP $F9 + RET Z + CP $FE + RET Z + CP $FF + RET Z + CP $FA + RET Z + LD HL,$5EA5 + LD A,(HL) + RET + +GET_DEVICE_92: + LD HL,GET_DEVICE_161 + JP GET_DEVICE_121 +GET_DEVICE_93: + OR A + PUSH AF + LD HL,DIRECTORY + LD B,$1B +GET_DEVICE_94: + LD A,(HL) + INC A + JP Z,GET_DEVICE_95 + DEC A + AND $FB + LD (HL),A + CALL GET_DEVICE_189 + JP NZ,GET_DEVICE_94 +GET_DEVICE_95: + POP AF + JP NZ,__MENU_0 + DEC C + DEC C + JP NZ,TEL_TERM_00 + POP HL + LD A,(HL) + OR $04 + LD (HL),A + JP __MENU_0 + +TXT_ASK_WIDTH: + POP HL + POP BC + DEC C + JP Z,TEL_TERM_00 + INC C + PUSH HL + JP Z,GET_DEVICE_101 + CALL GET_DEVICE_102 + LD HL,WIDTH_MSG ; $5ef9, "Width(" + CALL PRINT_TEXT + LD HL,$F3F6 + CALL PRINT_TEXT + LD HL,WIDTH_TAIL_MSG ; "):_" + CALL PRINT_TEXT + LD A,$03 + PUSH AF + CALL $5C13 + LD HL,$F57B + POP BC + PUSH HL +GET_DEVICE_97: + LD A,(HL) + CP '0' + JP C,GET_DEVICE_98 + CP '9'+1 + JP NC,GET_DEVICE_98 + INC HL + DEC B + JP NZ,GET_DEVICE_97 + +GET_DEVICE_98: + LD (HL),$00 + POP HL + LD A,(HL) + OR A + CALL Z,GET_DEVICE_104 + + CALL GETINT + CP $0A ; 10 + JP C,TEL_TERM_00 + CP $85 ; 133 + JP NC,TEL_TERM_00 + + ; A is in the range of 10..132 + PUSH AF + LD DE,$F3F6 + LD HL,$F57B + CALL MOVE_TEXT + CALL GET_DEVICE_102 + POP AF + POP HL + PUSH HL + PUSH AF + CALL GET_DEVICE_103 + POP AF + LD (TXT_WIDTH),A + LD (TRM_WIDTH),A + LD (PRTFLG),A + LD A,$01 + LD (TXT_EDITING),A + LD ($F4F7),A + CALL OUTDO_CRLF + POP HL + CALL GET_DEVICE_122 + CALL OUTDO_CRLF + POP DE + POP HL +GET_DEVICE_99: + CALL DWNLDR_05 + LD A,D + AND A + INC A + JP NZ,GET_DEVICE_99 +; This entry point is used by the routines at MAKINT and GETWORD. +GET_DEVICE_100: + SUB A + LD (TXT_EDITING),A + LD (PRTFLG),A + LD A,(ACTV_Y) + LD (TRM_WIDTH),A + JP __MENU_6 + +GET_DEVICE_101: + CALL GET_DEVICE_102 + POP HL + PUSH HL + CALL GET_DEVICE_103 + CALL INIT_OUTPUT_0 + POP HL + LD A,$FF + LD (PRTFLG),A + CALL GET_DEVICE_122 + CALL INIT_OUTPUT_0 + JP TEL_TERM_07 +GET_DEVICE_102: + LD HL,GET_DEVICE_163 + JP GET_DEVICE_121 +GET_DEVICE_103: + CALL GET_DEVICE_122 + CALL GET_DEVICE_125 + LD HL,GET_DEVICE_100 + LD (ERRTRP),HL + RET + +GET_DEVICE_104: + LD HL,$F3F6 + LD DE,$F57B + JP MOVE_TEXT +GET_DEVICE_105: + LD HL,$5EA7 + CALL GET_DEVICE_121 + POP HL + CALL GET_DEVICE_122 + CALL GET_DEVICE_127 + JP NZ,__MENU_6 + POP BC + POP DE + POP HL + DEC C + CALL GET_DEVICE_106 + SUB A + LD ($F590),A + JP __MENU_0 + +GET_DEVICE_106: + JP Z,KILLBIN + JP M,KILLASC_6 + JP KILLASC+1 + +GET_DEVICE_107: + PUSH HL + PUSH AF + PUSH HL + PUSH HL + LD HL,GET_DEVICE_162 + CALL GET_DEVICE_121 + POP HL + CALL GET_DEVICE_122 + LD HL,$5EDB + CALL PRINT_TEXT + POP HL + LD DE,$0009 + ADD HL,DE + PUSH HL + LD A,$06 + CALL $5C13 + POP DE + POP AF + CALL GET_DEVICE_153 + JP NZ,TEL_TERM_00 + LD HL,$F57B +GET_DEVICE_108: + LD A,(HL) + OR A + JP Z,GET_DEVICE_109 + CP $3A + INC HL + JP Z,TEL_TERM_00 + JP GET_DEVICE_108 +GET_DEVICE_109: + POP HL + INC HL + INC HL + INC HL + LD DE,GET_DEVICE_164 + PUSH HL + CALL MOVE_6_BYTES + POP HL + LD DE,$F57B +GET_DEVICE_110: + LD A,(DE) + OR A + JP Z,__MENU_0 + CP '.' + JP Z,__MENU_0 + LD (HL),A + INC DE + INC HL + JP GET_DEVICE_110 +GET_DEVICE_111: + PUSH AF + LD A,$FF + LD DE,$97F5 + LD ($F5A3),A + POP AF + LD ($F5A2),A + SUB A + LD ($F58F),A + LD HL,$F57B +GET_DEVICE_112: + CALL TEXT + JP C,GET_DEVICE_112 + CP $08 + JP Z,GET_DEVICE_120 + CP $7F ; BS + JP Z,GET_DEVICE_120 + CP $1D + JP Z,GET_DEVICE_120 + CP $03 + JP Z,TEL_TERM_00 + CP $0D + JP Z,GET_DEVICE_114 + CP '.' + CALL Z,GET_DEVICE_118 + CP ' ' + JP C,GET_DEVICE_112 + LD C,A + LD A,($F5A2) + LD E,A + LD A,($F58F) + CALL Z,$5C99 + CP E + JP Z,GET_DEVICE_119 + +; This entry point is used by the routine at __MENU. +SHOW_TIME_0: + INC A + LD ($F58F),A + LD (HL),C + INC HL + PUSH HL + LD A,C + RST OUTC + LD HL,UNDERSCORE_PROMPT ;$5EDF +GET_DEVICE_113: + CALL PRINT_TEXT + POP HL + JP GET_DEVICE_112 + +GET_DEVICE_114: + PUSH HL + LD HL,$F57B + LD A,($F58F) + OR A + JP Z,GET_DEVICE_117 + LD E,A + LD D,$01 +GET_DEVICE_115: + LD A,(HL) + CP $3A + JP NZ,GET_DEVICE_116 + DEC D +GET_DEVICE_116: + DEC E + INC HL + JP NZ,GET_DEVICE_115 + LD A,D + OR A + JP M,TEL_TERM_00 +GET_DEVICE_117: + POP HL + LD (HL),$00 + RET +GET_DEVICE_118: + LD A,($F5A3) + OR A + LD A,'.' + RET NZ + LD DE,$C0B7 + POP AF +GET_DEVICE_119: + CALL __BEEP + JP GET_DEVICE_112 +GET_DEVICE_120: + LD A,($F58F) + OR A + JP Z,GET_DEVICE_119 + DEC A + LD ($F58F),A + DEC HL + PUSH HL + LD HL,$5ECC + JP GET_DEVICE_113 +GET_DEVICE_121: + PUSH HL + LD HL,$0108 + CALL POSIT + JP GET_DEVICE_123 +GET_DEVICE_122: + EX DE,HL + LD HL,$F57B + PUSH HL + CALL DOTTED_FNAME +GET_DEVICE_123: + POP HL + JP PRINT_TEXT +GET_DEVICE_124: + CALL TEL_TERM_LOOP9 + CALL GET_DEVICE_90 + JP Z,TEL_TERM_00 +GET_DEVICE_125: + PUSH DE + PUSH HL + LD HL,$5EE4 + CALL GET_DEVICE_128 + POP HL + POP DE + RET Z + CP $0D + JP NZ,__MENU_6 + RET + +GET_DEVICE_126: + CALL TEL_TERM_LOOP9 + CALL GET_DEVICE_91 + JP Z,TEL_TERM_00 + CALL GET_DEVICE_125 + SUB A + LD E,$02 + JP _OPEN + +GET_DEVICE_127: + LD HL,$5EEF +GET_DEVICE_128: + CALL PRINT_TEXT + CALL SHOW_TIME + CALL CHGET_UCASE + CP $59 + RET NZ + RST OUTC + RET + +__MENU_21: + LD B,$1B + LD DE,DIRECTORY +__MENU_22: + LD A,(DE) + INC A + RET Z + DEC A + AND $FB + CP C + JP NZ,__MENU_23 + PUSH BC + PUSH DE + PUSH HL + LD HL,($F579) + LD (HL),E + INC HL + LD (HL),D + INC HL + LD ($F579),HL + POP HL + CALL GET_DEVICE_135 + PUSH HL + LD HL,$F57B + PUSH HL + CALL DOTTED_FNAME + POP HL + CALL PRINT_TEXT + POP HL + INC L + POP DE + POP BC +__MENU_23: + CALL GET_DEVICE_190 + JP NZ,__MENU_22 + RET + +DOTTED_FNAME: + LD A,(DE) + LD B,$2E + CP $C4 + JP NZ,_DOTTED_FNAME_0 + LD B,$2A +_DOTTED_FNAME_0: + INC DE + INC DE + INC DE + CALL MOVE_6_BYTES + LD A,' ' +DOTTED_FNAME_0: + DEC HL + CP (HL) + JP Z,DOTTED_FNAME_0 + INC HL + LD (HL),$00 + LD A,(DE) + CP ' ' + RET Z + LD (HL),B + INC HL + LD A,$02 + CALL MOVE_MEM + LD (HL),$00 + RET + +GET_DEVICE_135: + PUSH DE + PUSH HL + LD A,L + RRA + RRA + AND $3F + LD E,A + INC E + INC E + LD A,L + AND $03 + ADD A,A + LD D,A + ADD A,A + ADD A,A + ADD A,D + LD D,A + INC D + INC D + EX DE,HL + CALL POSIT + POP HL +GET_DEVICE_136: + POP DE + RET + +; Print time, day, and date on the first line of the screen +; +; Used by the routine at __MENU. +_PRINT_TDATE: + CALL __CLS + +; Same as _PRINT_TDATE but screen is not cleared. +; +; Used by the routine at SHOW_TIME. +PRINT_TDATE: + LD HL,$0101 + CALL POSIT + LD HL,$F52A + PUSH HL + LD (HL),$31 ; '1' + INC HL + LD (HL),$39 ; '9' ; CENTURY PREFIX (not Y2K compliant!) + INC HL + CALL GET_DATE + LD (HL),' ' + INC HL + CALL READ_TIME + LD (HL),$00 + POP HL + +; Print the buffer pointed to by HL, null terminated. +; +; Used by the routines at TEL_SET_STAT, TEL_CALL, __MENU, SCHEDL_DE and +; SHOW_TIME. +PRINT_TEXT: + LD A,(HL) + OR A + RET Z + RST OUTC + INC HL + JP PRINT_TEXT + +MOVE_6_BYTES: + LD A,$06 + +MOVE_MEM: + PUSH AF + LD A,(DE) + LD (HL),A + INC DE + INC HL + POP AF + DEC A + JP NZ,MOVE_MEM + RET + +TEL_TERM_INTRPT2: + CALL TEL_TERM_INTRPT4 + LD (HL),$00 + RET + +TEL_TERM_INTRPT3: + CALL TEL_TERM_INTRPT4 + INC DE +TEL_TERM_INTRPT4: + LD A,(DE) + OR A + RET Z + CP '.' + RET Z + LD (HL),A + INC HL + INC DE + JP TEL_TERM_INTRPT4 + +; Compare the buffer pointed to by DE to the buffer pointed to by HL for C +; bytes or until a null is found +; +; Used by the routine at CHKF. +COMP_MEM: + LD A,(DE) + CP (HL) + RET NZ + OR A + RET Z + INC HL + INC DE + DEC C + JP NZ,COMP_MEM + RET + +; Clear (wipe) function key definition table +; +; Used by the routine at __MENU. +CLRFLK: + LD HL,EMPTY_FNTAB ;$5E79 + +; Set new function key table, HL=address of fn table. Up to 16 chars for each +; of the 8 FN keys. +; +; Used by the routines at STDSPF, TELCOM, TEL_TERM, SCHEDL_DE, IS_CRLF, TEXT, +; WAIT_SPC and BOOT. +STFNK: + LD DE,FNKSTR + LD B,$0A +STFNK_0: + LD C,$0F +STFNK_1: + LD A,(HL) + INC HL + OR A + JP Z,STFNK_2 + LD (DE),A + INC DE + DEC C + JP NZ,STFNK_1 + SUB A +STFNK_2: + INC C +STFNK_3: + LD (DE),A + INC DE + DEC C + JP NZ,STFNK_3 + DEC B + JP NZ,STFNK_0 + +; This entry point is used by the routine at GETWORD. +FNKSB: + LD A,(LABEL_LN) + OR A + CALL NZ,DSPFNK + RET + +GET_DEVICE_153: + PUSH AF + LD (HL),$00 + LD A,($F58F) + OR A + JP Z,TEL_TERM_00 + POP AF + AND $10 + JP NZ,CHKF_0 + LD (HL),$2E + INC HL + LD A,(DE) + LD (HL),A + INC HL + INC DE + LD A,(DE) + LD (HL),A + INC HL + LD (HL),$00 +CHKF_0: + LD B,$1B + LD DE,DIRECTORY +CHKF_1: + LD HL,$F592 + LD A,(DE) + INC A + RET Z + AND $80 + JP Z,GET_DEVICE_157 + PUSH DE + PUSH HL + CALL DOTTED_FNAME + POP HL + LD C,$09 + LD DE,$F57B + CALL COMP_MEM + JP NZ,GET_DEVICE_156 + POP HL + INC C + RET +GET_DEVICE_156: + POP DE +GET_DEVICE_157: + CALL GET_DEVICE_190 + JP NZ,CHKF_1 + RET + +GET_DEVICE_158: + LD A,($F590) + LD HL,$F541 + LD DE,$0002 + INC A +GET_DEVICE_159: + ADD HL,DE + DEC A + JP NZ,GET_DEVICE_159 + DEC HL + +GET_DEVICE_160: + INC HL + LD E,(HL) + INC HL + LD D,(HL) + EX DE,HL + RET + + DEFB $F0 + DEFB $C0 + DEFB $80 + DEFB $A0 + DEFB $00 + DEFM ".BA" + DEFB $00 + DEFB $00 + DEFB $80 + DEFM ".CO" + DEFB $00 + DEFB $00 + DEFB $A0 + DEFM ".DO" + DEFB $00 + DEFB $00 + DEFB $C0 + DEFB $FF + DEFM "Load " + DEFB $00 + DEFM "Save " + DEFB $00 + DEFM "Name " + DEFB $00 + DEFM "List " + DEFB $00 + DEFM " " + DEFB $00 + DEFM "SetIPL" + DEFB $00 + DEFM "ClrIPL" + DEFB $00 + DEFB $00 + DEFM "Kill " + DEFB $00 + DEFM "Bank" + DEFB $00 + DEFM "B(inary) or A(scii)? _" + DEFB $1B + DEFM "K" + DEFB $08 + DEFB $00 + DEFM " " + DEFB $08 + DEFB $08 + DEFM "_" + DEFB $08 + DEFB $00 + DEFM " from _" + DEFB $08 + DEFB $00 + DEFM " as _" + DEFB $1B + DEFM "K" + DEFB $08 + DEFB $00 + DEFM " Ready? _" + DEFB $08 + DEFB $00 + DEFM " Sure? _" + DEFB $08 + DEFB $00 + +; Message at 24313 +WIDTH_MSG: + DEFM "Width(" + DEFB $00 + +WIDTH_TAIL_MSG: + DEFM "): _" + DEFB $08 + DEFB $00 + + +; Message at 24326 ($5F06) +FNKTAB: + DEFM "Load \"" + DEFB $00 + DEFM "Save \"" + DEFB $00 + DEFM "Files" + DEFB $0D + DEFB $00 + DEFM "List " + DEFB $00 + DEFM "Run" + DEFB $0D + DEFB $00 + DEFM "Edit " +FNKTAB_0: + DEFB $00 + DEFM "Cont" + DEFB $0D + DEFB $00 + DEFM "Print " +FNKTAB_1: + DEFB $00 + DEFM "List." +FNKTAB_2: + DEFB $0D +FNKTAB_3: + DEFB $1E + DEFB $1E + DEFB $00 + DEFM "Menu" + DEFB $0D + DEFB $00 + + + +FIND_TEXT: + PUSH DE +GET_DEVICE_183: + PUSH HL + PUSH DE +GET_DEVICE_184: + LD A,(DE) +GET_DEVICE_185: + CALL UCASE + LD C,A + CALL UCASE_HL + CP C + JP NZ,GET_DEVICE_186 + INC DE + INC HL + JP GET_DEVICE_184 +GET_DEVICE_186: + CP $00 + LD A,C + POP BC + POP HL + JP Z,GET_DEVICE_187 + CP $1A ; EOF + JP Z,GET_DEVICE_136 + CALL GET_DEVICE_188 + JP NZ,GET_DEVICE_183 + POP AF + JP FIND_TEXT + +GET_DEVICE_187: + POP DE + SCF + RET + +GET_DEVICE_188: + LD A,(DE) + CP $0D + INC DE + RET NZ + LD A,(DE) + CP $0A + RET NZ + INC DE + RET + +GET_DEVICE_189: + LD DE,$000B + ADD HL,DE + DEC B + RET + +GET_DEVICE_190: + PUSH HL + EX DE,HL + CALL GET_DEVICE_189 + EX DE,HL + POP HL + RET + +STKINI: + LD HL,$FFFF + LD (CURLIN),HL + INC HL + LD (CAPTUR),HL + +RESTAK: + POP BC + LD HL,(SAVSTK) + LD SP,HL + PUSH BC + RET + +CHGET_UCASE: + CALL CHGET + JP UCASE + +SHOW_TIME: + PUSH HL + LD HL,(CSRX) + PUSH HL + CALL CHSNS + PUSH AF + CALL Z,PRINT_TDATE + POP AF + POP HL + PUSH AF + CALL POSIT + POP AF + POP HL + JP Z,SHOW_TIME + RET + + CALL SHOW_TIME + JP CHGET + +TEXT: + LD HL,L5FD1 + LD (ERRTRP),HL + LD HL,TEXT_EMPTYBAR + CALL STFNK + +L5FD1: + XOR A + CALL NZ,__BEEP + CALL STKINI + LD HL,EDFILE_MSG + CALL PRS + CALL QINLIN ; User interaction with question mark, HL = resulting text + RST CHRGTB ; Gets next character (or token) from BASIC text. + AND A + JP Z,__MENU + CALL OPENDO + JP EDIT_TEXT + + + +; Message at 24555 +EDFILE_MSG: + DEFM "File to edit" + +; Message at 24567 +TEXT_EMPTYBAR: + DEFB $00 + DEFB $00 + DEFB $00 + DEFB $00 + DEFB $00 + DEFB $00 + DEFB $00 + DEFB $00 + DEFB $00 + DEFB $03 + DEFB $00 + +; Message at 24578 +TEXT_FNBAR: + DEFM "Find" + DEFB $0E + DEFB $00 + DEFM "Next" + DEFB $0B + DEFB $00 + DEFM "Sel " + DEFB $0C + DEFB $00 + DEFM "Cut " + DEFB $15 + DEFB $00 + DEFM "Copy" + DEFB $0F + DEFB $00 + DEFM "Keys" + DEFB $10 + DEFB $00 + DEFB $00 + DEFB $00 + DEFB $00 + DEFM "Menu" + DEFB $1B + DEFB $1B + DEFB $00 + +__EDIT: + PUSH HL + PUSH AF + CALL GET_DEVICE_206 + CALL GETPARM_VRFY + POP AF + PUSH AF + LD A,$01 + JP Z,GET_DEVICE_199 + LD A,$FF +GET_DEVICE_199: + LD (ERRTRP-1),A + XOR A + LD ($FB7A),A + LD HL,$2020 ; " " + LD (FILNAM+6),HL + LD HL,EDIT_OPN_TRP ;$60C4 + LD (ERRTRP),HL + LD DE,$F902 ; D = 'RAM' device, E = $02 + LD HL,BLANK_BYTE ; $6115 + CALL _OPEN + LD HL,EDIT_TRP + LD (ERRTRP),HL + CALL GET_DEVICE_207 + POP AF + POP HL + PUSH HL + JP __LIST + +; This entry point is used by the routine at MAKINT. +__EDIT_1: + CALL SCPTLP_104 + CALL __NEW_2 + LD A,(LABEL_LN) + LD (SV_LABEL_LN),A + LD HL,$0000 + LD (SAVE_CSRX),HL + LD ($F503),HL +__EDIT_2: + CALL RESFPT + LD HL,($F887) + LD A,(HL) + CP $1A ; EOF + JP Z,__EDIT_4 + PUSH HL + XOR A + LD HL,L6095 + JP WAIT_SPC_2 + +L6095: + XOR A + LD HL,$60D5 + LD (ERRTRP),HL + LD HL,BLANK_BYTE + LD D,$F9 ; 'RAM' device ($F8 on m100) + JP __MERGE_1 + +; This entry point is used by the routine at ISFLIO. +__EDIT_3: + CALL __CLS +__EDIT_4: + XOR A + LD (ERRTRP-1),A + LD L,A + LD H,A + LD (ERRTRP),HL + CALL KILLASC_4 + CALL _CLREG_1 + LD A,(SV_LABEL_LN) + LD (LABEL_LN),A ; Label line/8th line protect status (0=off) + JP BASIC_0 + +; Trap exit address for errors during EDITing +EDIT_TRP: + PUSH DE + CALL KILLASC_4 + POP DE + +EDIT_OPN_TRP: + PUSH DE + XOR A + LD (ERRTRP-1),A + LD L,A + LD H,A + LD (ERRTRP),HL + CALL SCPTLP_104 + POP DE + JP ERROR + + LD A,E + PUSH AF + LD HL,(FILTAB+4) + DEC HL + LD B,(HL) + DEC B + DEC HL + LD C,(HL) + DEC HL + LD L,(HL) + XOR A + LD H,A + ADD HL,BC + LD BC,$FFFF + ADD HL,BC + JP C,__EDIT_5 + LD L,A + LD H,A + +__EDIT_5: + LD (SAVE_CSRX),HL + CALL SCPTLP_104 + POP AF + CP $07 + LD HL,ERR_MEMORY ;$627F + JP Z,GET_DEVICE_205 + LD HL,ILLTXT_MSG ;$6105 +GET_DEVICE_205: + LD ($F503),HL + JP __EDIT_2 + +ILLTXT_MSG: + DEFM "Text ill-formed" + DEFB $07 + +; This entry point is used by the routine at CHKSTK. +GET_DEVICE_206: + LD HL,CONTXT + LD DE,$F99B + JP GET_DEVICE_208 +; This entry point is used by the routine at CHKSTK. +GET_DEVICE_207: + LD HL,$F99B + LD DE,CONTXT +GET_DEVICE_208: + LD B,$0C + JP LDIR_B + +EDIT_TEXT: + PUSH HL + LD HL,$0000 + LD (SAVE_CSRX),HL + LD ($F503),HL + LD A,$01 + LD HL,__MENU +WAIT_SPC_2: + LD ($F4F7),A + LD (TXT_ESCADDR),HL + CALL EXTREV ; Exit from reverse mode + CALL ERAFNK + CALL LOCK + CALL CURSOFF + CALL TEL_UPLD_18 + LD HL,TEXT_FNBAR + CALL STFNK + LD A,(ERRTRP-1) + AND A + JP Z,WAIT_SPC_3 + LD HL,$7845 ; H=120, L=69 (same const on PC8201 etc..) + ;LD ($F735),HL + LD (FNKSTR+$90),HL + LD HL,$7469 ; H=116, L=105 + ;LD ($F737),HL + LD (FNKSTR+$92),HL +WAIT_SPC_3: + LD A,(ACTV_Y) + LD (TRM_WIDTH),A + LD A,$80 + LD (FNK_FLAG),A + XOR A + LD L,A +GET_DEVICE_212: + LD H,A + LD ($F4F9),A + LD (TXT_EDITING),A + LD (TXT_ERRFLG),A + LD (STRG_ASKBUF),A + LD (TXT_SEL_BEG),HL + POP HL + LD (CUR_TXTFILE),HL + PUSH HL + CALL GETEND_CURTXT + CALL TXT_CTL_C_15 + POP DE + LD HL,(SAVE_CSRX) + ADD HL,DE + CALL GET_BT_ROWPOS + PUSH HL + CALL TEL_UPLD_75 + POP HL + CALL TXT_CTL_C_9 + LD HL,($F503) + LD A,H + OR L + JP Z,GET_DEVICE_213 + PUSH HL + CALL TXT_CTL_N_2 + EX (SP),HL + CALL TXT_ERROR + POP HL + CALL POSIT +GET_DEVICE_213: + CALL HOME3 +GET_DEVICE_214: + CALL STKINI + LD HL,GET_DEVICE_214 + LD (ERRTRP),HL + PUSH HL + LD A,($F4F9) + LD ($F4FA),A + CALL TEL_UPLD6 + LD ($F4F9),A + PUSH AF + CALL TEL_UPLD_41 + POP AF + JP C,TXT_CTL_U_11 + CP $7F ; BS + JP Z,TXT_CTL_H_0 + CP ' ' + JP NC,GET_DEVICE_215 + LD C,A + LD B,$00 + LD HL,$61EF + ADD HL,BC + ADD HL,BC + LD C,(HL) + INC HL + LD H,(HL) + LD L,C + PUSH HL + LD HL,(CSRX) + RET + XOR $61 + LD E,D + LD H,E + AND L + LD H,E + LD E,L + LD H,H + XOR H + LD H,D + INC HL + LD H,E + LD C,B + LD H,E + XOR $61 + EXX + LD H,D + LD E,B + LD H,D + XOR $61 + LD H,$67 + DJNZ GET_DEVICE_217 + ADC A,H + LD H,D + LD (HL),$67 + LD B,$66 + XOR $61 + EXX + LD H,E + BIT 4,E + RRA + LD H,E + SUB B + LD H,E + LD A,(DE) + LD H,(HL) + XOR $61 + SBC A,$63 + OR B + LD H,D + XOR $61 + JP PE,BNORM_9 + LD H,D + XOR H + LD H,D + RRA + LD H,E + INC HL + LD H,E + OR B + LD H,D + LD A,($F4FA) + SUB $1B + RET NZ + LD L,A + LD H,A + LD (ERRTRP),HL + RST $38 + LD E,H + CALL TEL_UPLD_18 + CALL UNLOCK + CALL HOME2 + CALL ERAFNK + CALL GO_BOTTOMROW + CALL POSIT + CALL OUTDO_CRLF + CALL TXT_WIPE_END + LD HL,(TXT_ESCADDR) + JP (HL) + +GET_DEVICE_215: + PUSH AF + CALL TXT_CTL_C + CALL DWNLDR_19 + CALL TXT_GET_CURPOS + POP AF +GET_DEVICE_216: + CALL TXT_SPLIT_ROW + JP C,TXT_CTL_I_1 + PUSH HL + CALL CHGDSP3 +GET_DEVICE_217: + POP HL + JP DUPDSP5 +TXT_CTL_I_1: + CALL TXT_CTL_N_2 + PUSH HL + LD HL,ERR_MEMORY + CALL TXT_ERROR +GET_DEVICE_219: + POP HL + JP POSIT + +; Message at 25215 +ERR_MEMORY: + DEFM "Memory full" + DEFB $07 + DEFB $00 + + +; TEXT control M routine +; (CR/LF, ENTER key code) + CALL TXT_CTL_C + CALL DWNLDR_19 + LD HL,(TEXT_END) + INC HL + LD A,(HL) + INC HL + OR (HL) + JP NZ,TXT_CTL_I_1 + CALL CHGDSP3 + CALL TXT_GET_CURPOS + LD A,$0D + CALL TXT_SPLIT_ROW + LD A,$0A + JP GET_DEVICE_216 + +; TEXT right arrow and control D routine +; (move cursor right) +TXT_CTL_D: + CALL TXT_CTL_X_0 + SCF + +; TEXT down arrow and control X routine +TXT_CTL_X: + CALL NC,TXT_CTL_X_1 + JP TXT_CTL_C_0 + +TXT_CTL_X_0: + LD HL,(CSRX) + LD A,(ACTV_Y) + INC H + CP H + JP NC,DUPDSP8 + LD H,$01 + +TXT_CTL_X_1: + INC L + LD A,L + PUSH HL + CALL DWNLDR_13 + LD A,E + AND D + INC A + POP HL + SCF + RET Z + CALL GET_BT_ROWPOS + CP L + CALL C,TXT_CTL_C_10 + JP DUPDSP8 + +; TEXT control H routine +; Delete previous character (BS) +TXT_CTL_H: + CALL TXT_CTL_C + CALL TXT_GET_CURPOS + CALL TXT_CTL_C_9 + CALL DUPDSP6 + RET C + +TXT_CTL_H_0: + CALL TXT_CTL_C + CALL TXT_GET_CURPOS + PUSH HL +DUPDSP3: + CALL TXT_CTL_C_9 + POP HL + LD A,(HL) + CP $1A ; EOF + RET Z + PUSH AF + PUSH HL + PUSH HL + CALL DWNLDR_19 + POP HL +DUPDSP4: + CALL MCLEAR_5 + CALL $6424 + POP HL + POP AF + CP $0D + JP NZ,DUPDSP5 + LD A,(HL) + CP $0A + JP NZ,DUPDSP5 + PUSH AF + PUSH HL + JP DUPDSP4 +DUPDSP5: + PUSH HL + LD A,(CSRX) + CALL TEL_UPLD_77 + POP HL + JP TXT_CTL_C_7 + CALL DUPDSP6 + SCF + CALL NC,DUPDSP7 + JP TXT_CTL_C_0 +DUPDSP6: + LD HL,(CSRX) + DEC H + JP NZ,DUPDSP8 + LD A,(ACTV_Y) + LD H,A +DUPDSP7: + PUSH HL + CALL DWNLDR_12 + LD HL,(CUR_TXTFILE) + RST CPDEHL + POP HL + CCF + RET C + DEC L + CALL Z,TXT_CTL_C_12 +DUPDSP8: + CALL POSIT + AND A + RET + CALL TXT_GET_CURPOS +DUPDSP9: + CALL ECHDSP4 + JP NZ,DUPDSP9 +ECHDSP0: + CALL ECHDSP4 + JP Z,ECHDSP0 + JP ECHDSP3 + CALL TXT_GET_CURPOS +ECHDSP1: + CALL ECHDSP5 + JP Z,ECHDSP1 +ECHDSP2: + CALL ECHDSP5 + JP NZ,ECHDSP2 + CALL ECHDSP4 +ECHDSP3: + CALL TXT_CTL_C_7 + JP TXT_CTL_C_0 +ECHDSP4: + LD A,(HL) + CP $1A ; EOF + POP BC + JP Z,ECHDSP3 + INC HL + JP ECHDSP6 +ECHDSP5: + EX DE,HL + LD HL,(CUR_TXTFILE) + EX DE,HL + RST CPDEHL + POP BC + JP Z,ECHDSP3 + DEC HL +ECHDSP6: + PUSH BC + PUSH HL + LD A,(HL) + CALL TEL_UPLD_73 + POP HL + RET + DEC L + LD L,$01 + JP NZ,ECHDSP7 + PUSH HL + CALL DWNLDR_12 + EX DE,HL + CALL CHGDSP0 + POP HL +ECHDSP7: + CALL POSIT + JP TXT_CTL_C_0 + PUSH HL + INC L + CALL GET_BT_ROWPOS + INC A + CP L + JP NZ,ECHDSP8 + PUSH AF + CALL DWNLDR_12 + EX DE,HL + LD A,$01 + CALL CHGDSP1 + POP AF +ECHDSP8: + DEC A + CALL DWNLDR_13 + LD B,A + INC DE + LD A,D + OR E + LD A,B + JP Z,ECHDSP8 + POP HL + LD L,A + JP ECHDSP7 + + LD A,(ACTV_Y) + LD H,A + CALL POSIT + CALL TXT_GET_CURPOS + CALL TXT_CTL_V_55 + LD BC,$0126 + JP ECHDSP7 + LD HL,(CUR_TXTFILE) + CALL CHGDSP2 + CALL HOME + JP TXT_CTL_C_0 + + LD HL,(TEXT_END) + PUSH HL + CALL TXT_CTL_V_46 + POP HL + RST CPDEHL + PUSH HL + CALL NC,CHGDSP0 +ECHDSP9: + POP HL + CALL TXT_CTL_C_9 + JP TXT_CTL_C_0 + +CHGDSP0: + CALL GET_BT_ROWPOS +CHGDSP1: + CALL GET_DEVICE_372 +CHGDSP2: + CALL SYNCHR_1 + RET Z + LD ($F507),HL + LD A,$01 + JP TEL_UPLD_79 + + CALL TXT_CTL_C + CALL TXT_GET_CURPOS + LD (TXT_SEL_BEG),HL + LD (TXT_SEL_END),HL + LD E,L + LD D,H + JP CHGDSP_01 + +CHGDSP3: + LD C,$00 + LD HL,$800E + CALL GET_BT_ROWPOS + LD HL,CSRX + SUB (HL) + LD B,A + CALL DWNLDR_12 + INC HL +TXT_CTL_L_1: + INC HL + LD E,(HL) + INC HL + LD D,(HL) + INC DE + LD A,D + OR E + RET Z + DEC C + JP M,TXT_CTL_L_2 + DEC DE + DEC DE +TXT_CTL_L_2: + DEC HL + LD (HL),E + INC HL + LD (HL),D + DEC B + JP P,TXT_CTL_L_1 + RET + +TXT_CTL_L_3: + CALL HOME + CALL DELLIN + CALL GET_BT_ROWPOS + +TXT_CTL_L_4: + ADD A,A + LD B,A + LD DE,$F507 + LD HL,$F509 + JP LDIR_B + +; TEXT control C routine +; +; Used by the routines at TXT_CTL_I, TXT_CTL_M, TXT_CTL_H, TXT_CTL_L, +; TXT_CTL_O, TXT_CTL_U and TXT_CTL_N. +; Interrupt any type of function (Cancel SETFIL, SAVE, LOAD, FIND or PRINT) +TXT_CTL_C: + CALL TXT_IS_SETFILING + PUSH HL + LD HL,$0000 + LD (TXT_SEL_BEG),HL + CALL TXT_GET_CURPOS + POP DE + JP TXT_CTL_C_1 + +; This entry point is used by the routines at TXT_CTL_X, TXT_CTL_E, TXT_CTL_A, +; TXT_CTL_T, TXT_CTL_W and TXT_CTL_Z. +TXT_CTL_C_0: + CALL TXT_IS_SETFILING + CALL TXT_GET_CURPOS + EX DE,HL + LD HL,(TXT_SEL_END) + RST CPDEHL + RET Z + EX DE,HL + LD (TXT_SEL_END),HL +TXT_CTL_C_1: + CALL TXT_CTL_U_5 +CHGDSP_01: + PUSH HL + PUSH DE + CALL TXT_CTL_V_46 + POP HL + RST CPDEHL + JP C,CHGDSP_02 + CALL GO_BOTTOMROW +CHGDSP_02: + CALL C,TXT_CTL_V_55 + LD H,L + EX (SP),HL + CALL SYNCHR_1 + JP NC,CHGDSP_03 + LD L,$01 +CHGDSP_03: + CALL NC,TXT_CTL_V_55 + POP AF + SUB L + LD C,A + EX DE,HL + LD HL,(CSRX) + EX DE,HL + PUSH DE + LD H,$01 + CALL POSIT + CALL DWNLDR_12 + LD A,C +TXT_CTL_C_5: + PUSH AF + CALL DWNLDR_05 + POP AF + DEC A + JP P,TXT_CTL_C_5 + JP GET_DEVICE_219 + +TXT_IS_SETFILING: + LD HL,(TXT_SEL_BEG) + LD A,H + OR L + RET NZ + POP HL + RET + +TXT_CTL_C_7: + CALL SYNCHR_1 + CALL C,TXT_CTL_C_13 + JP C,TXT_CTL_C_7 +CHGDSP_07: + PUSH HL + CALL TXT_CTL_V_46 + POP HL + RST CPDEHL + CALL NC,TXT_CTL_C_11 + JP NC,CHGDSP_07 + +; This entry point is used by the routines at WAIT_SPC, TXT_CTL_H, TXT_CTL_Z, +; TXT_CTL_U and TXT_CTL_V. +TXT_CTL_C_9: + CALL TXT_CTL_V_55 + JP POSIT + +TXT_CTL_C_10: + DEC L +TXT_CTL_C_11: + PUSH AF + PUSH HL + CALL TXT_CTL_L_3 + CALL GET_BT_ROWPOS + JP TXT_CTL_C_14 + +TXT_CTL_C_12: + INC L +TXT_CTL_C_13: + PUSH AF + PUSH HL + CALL CLR_BOTTOMROW + CALL HOME + CALL INSLIN + CALL DWNLDR_14 + PUSH DE + CALL TXT_CTL_V_46 + INC HL + LD E,L + LD D,H + DEC HL + DEC HL + DEC A + ADD A,A + LD C,A + LD B,$00 + CALL _LDDR + EX DE,HL + POP DE + LD (HL),D + DEC HL + LD (HL),E + LD A,$01 +TXT_CTL_C_14: + CALL TEL_UPLD_79 + POP HL + POP AF + RET +; This entry point is used by the routine at GETWORD. +CHGDSP_14: + LD HL,(DO_FILES) +; This entry point is used by the routine at GETWORD. +CHGDSP_15: + DEC HL + LD (TEXT_END),HL + +TXT_CTL_C_15: + LD HL,(ARREND) + LD BC,$00C8 + ADD HL,BC + LD BC,$0000 + XOR A + SUB L + LD L,A + SBC A,A + SUB H + LD H,A + ADD HL,SP + RET NC + LD A,H + OR L + RET Z + LD B,H + LD C,L + LD HL,(TEXT_END) + EX DE,HL + INC DE + CALL MAKHOL_0 + PUSH BC +MCLEAR: + LD (HL),$00 + INC HL + DEC BC + LD A,B + OR C + JP NZ,MCLEAR + POP BC + RET + +MCLEAR_0: + LD HL,(DO_FILES) +MCLEAR_1: + CALL GETEND + INC HL + EX DE,HL + LD HL,(CO_FILES) + EX DE,HL + RST CPDEHL + RET NC + LD A,(HL) + AND A + JP NZ,MCLEAR_1 + +; This entry point is used by the routines at DWNLDR, TXT_ESC, TXT_CTL_O and +; TXT_CTL_U. +TXT_WIPE_END: + LD HL,(TEXT_END) + PUSH HL + LD BC,$FFFF + XOR A +TXT_WIPE_END_0: + INC HL + INC BC + CP (HL) + JP Z,TXT_WIPE_END_0 + POP HL + INC HL + JP MASDEL + +; This entry point is used by the routines at DWNLDR, TXT_CTL_I, TXT_CTL_M and +; TXT_CTL_V. +TXT_SPLIT_ROW: + EX DE,HL + LD HL,(TEXT_END) + INC HL + INC (HL) + DEC (HL) + SCF + RET NZ + PUSH AF + LD (TEXT_END),HL + EX DE,HL + LD A,E + SUB L + LD C,A + LD A,D + SBC A,H + LD B,A + LD L,E + LD H,D + DEC HL + CALL _LDDR + INC HL + POP AF + LD (HL),A + INC HL + AND A + RET + +; This entry point is used by the routine at TXT_CTL_H. +MCLEAR_5: + EX DE,HL + LD HL,(TEXT_END) + LD A,L + SUB E + LD C,A + LD A,H + SBC A,D + LD B,A + DEC HL + LD (TEXT_END),HL + LD L,E + LD H,D + INC HL + CALL _LDIR + XOR A + LD (DE),A + RET + +; This entry point is used by the routine at ISFLIO. +GET_BT_ROWPOS: + PUSH HL + PUSH AF + LD HL,LABEL_LN + LD A,(ACTV_X) + ADD A,(HL) + LD L,A + POP AF + LD A,L + POP HL + RET + +GO_BOTTOMROW: + PUSH AF + LD HL,(ACTV_X) + CALL GET_BT_ROWPOS + LD L,A + POP AF + RET + +TEL_UPLD6: + CALL CHGET + RET C + PUSH AF + CP $10 + JP Z,MCLEAR_9 + POP AF + RET + +MCLEAR_9: + LD HL,(CSRX) + PUSH HL + LD A,(LABEL_LN) + AND A + JP NZ,MCLEAR_10 + INC A + CALL DSPFNK_0 + LD A,(CSRX) + POP HL + CP L + LD A,(ACTV_X) + CALL NZ,TXT_CTL_L_4 + POP AF + RET + +MCLEAR_10: + CALL ERAFNK + LD A,(ACTV_X) + DEC A + CALL DWNLDR_13 + INC HL + LD (HL),$FE + INC HL + INC HL + LD (HL),$FE + DEC A + CALL TEL_UPLD_79 + XOR A + LD (TXT_ERRFLG),A + POP HL + CALL POSIT + POP AF + RET + +; TEXT control O routine +; 'COPY' the SETFILed text +TXT_CTL_O: + CALL TXT_IS_SETFILING + CALL TXT_WIPE_END + CALL TXT_CTL_U_6 + PUSH AF + CALL TXT_CTL_C_15 + POP AF + JP NC,TXT_CTL_C + JP TXT_CTL_I_1 + +; TEXT control U routine +; same as CUT function +TXT_CTL_U: + CALL TXT_IS_SETFILING + CALL TXT_WIPE_END + CALL TXT_CTL_U_6 + PUSH AF + CALL NC,MASDEL + POP AF + JP NC,TXT_CTL_U_2 + LD A,B + AND A + JP Z,TXT_CTL_U_1 +TXT_CTL_U_0: + CALL GETWORD_131 + PUSH BC + LD BC,$0100 + CALL TXT_CTL_U_3 + POP BC + DEC B + JP NZ,TXT_CTL_U_0 +TXT_CTL_U_1: + LD A,C + AND A + CALL NZ,TXT_CTL_U_3 +TXT_CTL_U_2: + LD DE,$0000 + EX DE,HL + LD (TXT_SEL_BEG),HL + EX DE,HL + PUSH HL + LD A,(CSRX) + CALL TEL_UPLD_75 + POP HL + CALL TXT_CTL_C_9 + CALL GETEND_CURTXT + JP TXT_CTL_C_15 + + +TXT_CTL_U_3: + PUSH HL + PUSH BC + EX DE,HL + LD HL,(FILTAB+4) + EX DE,HL + CALL _LDIR + POP BC + POP HL + PUSH HL + PUSH BC + CALL MASDEL + LD HL,(HAYASHI) ; Paste buffer file + ADD HL,BC + EX DE,HL + POP BC + CALL MAKHOL_0 + EX DE,HL + LD HL,(FILTAB+4) + CALL _LDIR + POP HL + RET + +TXT_CTL_U_4: + LD HL,(TXT_SEL_BEG) + EX DE,HL + LD HL,(TXT_SEL_END) + +; This entry point is used by the routine at TXT_CTL_C. +TXT_CTL_U_5: + RST CPDEHL + RET C + EX DE,HL + RET + +TXT_CTL_U_6: + CALL SWAPNM_1 + LD HL,(HAYASHI) ; Paste buffer file + LD (KBUF),HL + XOR A + LD (TXT_BUFLAG),A + CALL TXT_CTL_U_4 + DEC DE + +TXT_CTL_U_7: + LD A,E + SUB L + LD C,A + LD A,D + SBC A,H + LD B,A + JP C,TXT_CTL_U_8 + LD A,(DE) + CP $1A ; EOF + JP Z,TXT_CTL_U_9 + CP $0D + JP NZ,TXT_CTL_U_8 + INC DE + LD A,(DE) + CP $0A ; LF + JP NZ,TXT_CTL_U_8 + INC BC +TXT_CTL_U_8: + INC BC +TXT_CTL_U_9: + LD A,B + OR C + RET Z + PUSH HL + LD HL,(KBUF) + CALL MAKHOL + EX DE,HL + POP HL + RET C + LD A,(TXT_BUFLAG) + AND A + JP Z,TXT_CTL_U_10 + ADD HL,BC +TXT_CTL_U_10: + PUSH HL + PUSH BC + CALL _LDIR + POP BC + POP HL + RET + +; This entry point is used by the routines at WAIT_SPC and TXT_CTL_P. +TXT_CTL_U_11: + CALL TXT_CTL_C + CALL TXT_WIPE_END + CALL RESFPT + CALL TXT_GET_CURPOS + LD (KBUF),HL + LD A,H + LD (TXT_BUFLAG),A + LD HL,(HAYASHI) ; Paste buffer file + LD A,(HL) + CP $1A ; EOF + JP Z,TXT_CTL_C_15 + LD E,L + LD D,H + DEC DE +TXT_CTL_U_12: + INC DE + LD A,(DE) + CP $1A ; EOF + JP NZ,TXT_CTL_U_12 + CALL TXT_CTL_U_7 + PUSH AF + PUSH DE + CALL GETEND_CURTXT + CALL TXT_CTL_C_15 + POP DE + POP AF + JP C,TXT_CTL_I_1 + PUSH DE + LD HL,(KBUF) + LD A,(CSRX) + CALL TEL_UPLD_75 + CALL TXT_CTL_V_46 + POP HL + RST CPDEHL + CALL GET_BT_ROWPOS + PUSH HL + CALL NC,TEL_UPLD_75 + POP HL + JP TXT_CTL_C_9 + +; "FIND more" ? + CALL TXT_CTL_N_2 + CALL TXT_GET_CURPOS + EX DE,HL + LD HL,STRG_ASKBUF + LD A,(HL) + AND A + RET Z + JP TEL_UPLD_12 + + +; TEXT control N routine +; FIND in text +TXT_CTL_N: + CALL TXT_CTL_N_2 + CALL TXT_GET_CURPOS + PUSH HL + LD HL,STRG_MSG ;$67BC + LD DE,STRG_ASKBUF + PUSH DE + CALL ASK_TEXT + POP DE + INC HL + LD A,(HL) + AND A + SCF + JP Z,TXT_CTL_N_0 + CALL MOVE_TEXT + POP DE +TEL_UPLD_12: + PUSH DE + LD A,(DE) + CP $1A ; EOF + JP Z,TXT_CTL_N_1 + INC DE + CALL FIND_TEXT + JP NC,TXT_CTL_N_1 + POP DE + PUSH BC + PUSH BC + CALL TXT_CTL_V_46 + POP HL + RST CPDEHL + JP C,TXT_CTL_N_0 + CALL $6A1E + AND A +TXT_CTL_N_0: + CALL C,TEL_UPLD_42 + SCF +TXT_CTL_N_1: + LD HL,NOMATCH_MSG ;$67B3 + CALL NC,TXT_ERROR + JP ECHDSP9 + CALL TXT_CTL_C + +; This entry point is used by the routines at TXT_CTL_Y and TXT_CTL_G. +TXT_CTL_N_2: + LD HL,(CSRX) + CALL GET_BT_ROWPOS + CP L + RET NZ + DEC L + PUSH HL + CALL TXT_CTL_L_3 + JP GET_DEVICE_219 + +; This entry point is used by the routines at TXT_CTL_Y and TXT_CTL_V. +TXT_ABT_ERROR: + LD HL,ABTMSG ;$562A +TXT_ERROR: + LD A,$01 + LD (TXT_ERRFLG),A +TEL_UPLD_17: + CALL CLR_BOTTOMROW + CALL PRS ; prints error message in HL + +TEL_UPLD_18: + CALL CHSNS + RET Z + CALL CHGET + JP TEL_UPLD_18 + +MOVE_TEXT: + PUSH HL +MOVE_TEXT_0: + LD A,(HL) + LD (DE),A + INC HL + INC DE + AND A + JP NZ,MOVE_TEXT_0 + POP HL + RET + +; Routine at 26062 +NOMATCH_MSG: + DEFM "No match" + DEFB $00 + +STRG_MSG: + DEFM "String:" + DEFB $00 + +; +; Used by the routines at TXT_CTL_C and TXT_CTL_N. +CLR_BOTTOMROW: + PUSH HL + CALL GO_BOTTOMROW + LD H,$01 + CALL POSIT + POP HL + JP ERAEOL + +TEL_UPLD_41: + LD HL,TXT_ERRFLG + XOR A + CP (HL) + RET Z + LD (HL),A +TEL_UPLD_42: + LD HL,(CSRX) + PUSH HL + CALL GET_BT_ROWPOS + CALL TEL_UPLD_79 + JP GET_DEVICE_219 + LD DE,BLANK_BYTE + +ASK_TEXT: + PUSH DE + CALL TEL_UPLD_17 + LD A,(CSRY) + LD (SV_CSRY),A + POP HL + PUSH HL + CALL PRS + CALL HOME2 +TEL_UPLD_44: + CALL CHGET + JP C,TEL_UPLD_44 + AND A + JP Z,TEL_UPLD_44 + POP HL + CP $0D + JP Z,TEL_UPLD_46 + PUSH AF + CALL GO_BOTTOMROW + LD A,(SV_CSRY) + LD H,A + CALL POSIT + CALL ERAEOL + POP AF + LD DE,INPBFR + LD B,$01 + AND A + JP TEL_UPLD_45 + + CALL CHGET +TEL_UPLD_45: + LD HL,$6822 + PUSH HL + RET C + CP $7F ; BS + JP Z,_INLIN_BS + CP ' ' + JP NC,TEL_UPLD_48 + LD HL,$6843 + LD C,$07 + JP TTY_VECT_JP_2 +TEL_UPLD_46: + LD DE,INPBFR + CALL MOVE_TEXT + JP TEL_UPLD_47 + INC BC + LD E,D + LD L,B + EX AF,AF' + POP BC + LD B,(HL) + ADD HL,BC + LD H,A + LD L,B + DEC C + LD E,L + LD L,B + DEC D + CALL PO,_CHSNS + CALL PO,GETWORD_102 + POP BC + LD B,(HL) + LD DE,INPBFR + POP HL + POP HL + XOR A + LD (DE),A +TEL_UPLD_47: + LD HL,BUFMIN + JP HOME3 + + LD A,$09 +TEL_UPLD_48: + LD C,A + LD A,(ACTV_Y) + SUB $09 + LD HL,CSRY + CP (HL) + JP C,__BEEP + LD A,C + INC B + RST OUTC + LD (DE),A + INC DE + RET + +TEL_UPLD_49: + XOR A + LD (TXT_COUNT),A + LD (TXT_BUFLAG),A + LD HL,TXT_BUF + LD (TXT_PTR),HL + +L67DF_LOOP: + PUSH DE + CALL TXT_CTL_V_21 + POP DE + LD A,(DE) + INC DE + CP $1A ; EOF + JP Z,TXT_CTLZ_EOF + CP $0D + JP Z,TXTCURS_CR + CP $09 + JP Z,TXT_TAB + CP ' ' + JP C,TXT_SPC + +TXT_TAB: + CALL TXT_ADD_GRAPH + JP NC,L67DF_LOOP + LD A,(DE) + CALL TXT_CTL_V_26 + JP NZ,TXT_CTL_V_6 + CALL TXT_CTL_V_8 + LD A,(DE) + CP ' ' + RET NZ + LD A,(TXT_EDITING) + AND A + RET Z + INC DE + LD A,(DE) + CP ' ' + RET NZ + DEC DE + RET + +TXT_CTL_V_6: + EX DE,HL + LD (KBUF),HL + EX DE,HL + LD HL,(TXT_PTR) + LD (TXT_SAVPTR),HL + DEC DE + LD A,(DE) + INC DE + CALL TXT_CTL_V_26 + JP Z,TXT_CTL_V_8 +TEL_UPLD_53: + DEC DE + LD A,(DE) + INC DE + CALL TXT_CTL_V_26 + JP Z,TEL_UPLD_STOP5 + DEC DE + CALL TEL_UPLD_STOP3 + JP NZ,TEL_UPLD_53 + LD HL,(TXT_SAVPTR) + LD (TXT_PTR),HL + LD HL,(KBUF) ; =PASTE_BUF + EX DE,HL +TXT_CTL_V_8: + LD A,(TXT_EDITING) + DEC A + JP Z,TXT_CRLF + RET + +TXT_SPC: + PUSH AF + LD A,$5E + CALL TXT_ADD_GRAPH + JP C,TEL_UPLD_56 + POP AF + OR $40 + CALL TXT_ADD_GRAPH + JP NC,L67DF_LOOP + LD A,(TXT_EDITING) + AND A + JP NZ,TXT_CRLF + RET + +TEL_UPLD_56: + POP AF + DEC DE + LD HL,(TXT_PTR) + DEC HL + LD (TXT_PTR),HL + LD HL,TXT_COUNT + DEC (HL) + JP TEL_UPLD_STOP5 + +TXT_CTLZ_EOF: + LD A,(TXT_EDITING) + AND A + LD A,$80 + CALL Z,TXT_ADD_GRAPH + CALL TEL_UPLD_STOP5 + LD DE,$FFFF + RET + +TXTCURS_CR: + LD A,(DE) + CP $0A + LD A,$0D + JP NZ,TXT_SPC + PUSH DE + CALL TXT_CTL_V_21 + POP DE + LD A,(TXT_EDITING) + AND A + LD A,$81 + CALL Z,TXT_ADD_GRAPH + CALL TEL_UPLD_STOP5 + INC DE + RET +TXT_ADD_GRAPH: + PUSH HL + CALL ADD_CHAR + LD HL,TXT_COUNT + CP $09 ; TAB + JP Z,ADD_TAB + INC (HL) + JP TEL_UPLD_STOP1 + +ADD_TAB: + INC (HL) + LD A,(HL) + AND $07 + JP NZ,ADD_TAB +TEL_UPLD_STOP1: + LD A,(TRM_WIDTH) + DEC A + CP (HL) + POP HL + RET + +ADD_CHAR: + LD HL,(TXT_PTR) + LD (HL),A + INC HL + LD (TXT_PTR),HL + RET +TEL_UPLD_STOP3: + LD HL,(TXT_PTR) + DEC HL + DEC HL + DEC HL + LD A,(HL) + CP $1B + JP Z,TEL_UPLD_STOP4 + INC HL + INC HL +TEL_UPLD_STOP4: + LD (TXT_PTR),HL + LD HL,TXT_COUNT + DEC (HL) + RET + +TEL_UPLD_STOP5: + LD A,(TXT_COUNT) + LD HL,TRM_WIDTH + CP (HL) + RET NC + LD A,(TXT_EDITING) + AND A + JP NZ,TXT_CRLF + LD A,$1B ; ESC .. + CALL ADD_CHAR + LD A,$4B ; ..'K', "erase in line" + CALL ADD_CHAR +TXT_CRLF: + LD A,$0D + CALL ADD_CHAR + LD A,$0A + JP ADD_CHAR + +TXT_CTL_V_21: + CALL TXT_IS_SETFILING + LD A,(TXT_EDITING) + AND A + RET NZ + LD BC,TXT_BUFLAG + PUSH DE + EX DE,HL + LD HL,(TXT_SEL_END) + EX DE,HL + RST CPDEHL + POP DE + JP NC,TEL_UPLD_STOP9 + EX DE,HL + RST CPDEHL + JP C,TEXT_NOREV + EX DE,HL + LD HL,(TXT_SEL_END) + EX DE,HL + RST CPDEHL + JP NC,TEXT_NOREV +TEXT_REV: + LD A,(BC) + AND A + RET NZ + INC A + LD H,'p' ; ESC p (enter in inverse video mode) + JP ADD_ESC_SEQ + +TEL_UPLD_STOP9: + EX DE,HL + RST CPDEHL + JP NC,TEXT_NOREV + EX DE,HL + LD HL,(TXT_SEL_END) + EX DE,HL + RST CPDEHL + JP NC,TEXT_REV + +TEXT_NOREV: + LD A,(BC) + AND A + RET Z + XOR A + LD H,'q' ; ESC q (exit from inverse video mode) + +ADD_ESC_SEQ: + PUSH HL + LD (BC),A + LD A,$1B + CALL ADD_CHAR + POP AF + JP ADD_CHAR + +TXT_CTL_V_26: + LD B,A + LD A,($F4F7) + AND A + LD A,B + RET Z + +TEL_UPLD_73: + LD HL,SYMBS_TXT + LD B,$01 +SYMB_LOOP: + CP (HL) + RET Z + INC HL + DEC B + JP NZ,SYMB_LOOP + CP '!' + INC B + RET NC + DEC B + RET + +SYMBS_TXT: + DEFM "()<>[]+-*/" + + + CALL GET_BT_ROWPOS + AND A + RRA +TEL_UPLD_75: + CALL GET_DEVICE_372 + LD ($F507),HL + CALL GET_BT_ROWPOS + ADD A,A + LD HL,$F509 +TEL_UPLD_76: + LD (HL),$FE + INC HL + DEC A + JP NZ,TEL_UPLD_76 + INC A + JP TEL_UPLD_79 +TEL_UPLD_77: + PUSH AF + LD HL,($F505) + LD A,H + OR L + JP Z,TEL_UPLD_78 + EX DE,HL + CALL TEL_UPLD_49 + POP AF + LD B,A + CALL DWNLDR_08 + LD A,B + PUSH AF + JP Z,TEL_UPLD_78 + DEC A + JP Z,TEL_UPLD_78 + LD L,A + LD H,$01 + CALL POSIT + CALL DWNLDR_06 + LD A,D + AND E + INC A + POP BC + JP Z,ERAEOL + PUSH BC +TEL_UPLD_78: + POP AF +TEL_UPLD_79: + LD L,A + LD H,$01 + CALL POSIT + CALL DWNLDR_12 + LD A,E + AND D + INC A + JP Z,DWNLDR_04 + CALL DWNLDR_12 +DWNLDR_00: + CALL GO_BOTTOMROW + CP L + JP Z,DWNLDR_01 + CALL DWNLDR_05 + LD A,D + AND E + INC A + JP Z,DWNLDR_03 + CALL DWNLDR_09 + JP NZ,DWNLDR_00 + RET +DWNLDR_01: + CALL DWNLDR_05 +DWNLDR_02: + CALL GET_BT_ROWPOS + INC A + JP DWNLDR_08 +DWNLDR_03: + CALL DWNLDR_09 + JP Z,DWNLDR_02 +DWNLDR_04: + CALL ERAEOL + CALL OUTDO_CRLF + JP DWNLDR_03 +DWNLDR_05: + CALL TEL_UPLD_49 +DWNLDR_06: + PUSH DE + LD HL,(TXT_PTR) + LD DE,TXT_BUF +DWNLDR_07: + LD A,(DE) + RST OUTC + INC DE + RST CPDEHL + JP NZ,DWNLDR_07 + LD A,(TXT_EDITING) + AND A + CALL Z,EXTREV + POP DE + RET +DWNLDR_08: + PUSH DE + CALL DWNLDR_13 + JP DWNLDR_10 +DWNLDR_09: + PUSH DE + CALL DWNLDR_12 +DWNLDR_10: + LD C,A + EX (SP),HL + RST CPDEHL + LD A,C + EX DE,HL + POP HL + RET Z + LD (HL),E + INC HL + LD (HL),D + LD A,C + RET + +TXT_CTL_V_46: + CALL GET_BT_ROWPOS + INC A + JP DWNLDR_13 +DWNLDR_12: + LD A,(CSRX) +DWNLDR_13: + LD E,A + LD D,$00 + LD HL,$F505 + ADD HL,DE + ADD HL,DE + LD E,(HL) + INC HL + LD D,(HL) + DEC HL + RET +DWNLDR_14: + CALL DWNLDR_12 + DEC A + JP Z,DWNLDR_15 + DEC HL + LD D,(HL) + DEC HL + LD E,(HL) + RET +DWNLDR_15: + LD HL,(CUR_TXTFILE) + RST CPDEHL + JP C,DWNLDR_16 + LD DE,$0000 + RET +DWNLDR_16: + PUSH DE + DEC DE + RST CPDEHL + JP NC,DWNLDR_18 +DWNLDR_17: + DEC DE + RST CPDEHL + JP NC,DWNLDR_18 + LD A,(DE) + CP $0A + JP NZ,DWNLDR_17 + DEC DE + RST CPDEHL + JP NC,DWNLDR_18 + LD A,(DE) + INC DE + CP $0D + JP NZ,DWNLDR_17 + INC DE +DWNLDR_18: + PUSH DE + CALL TEL_UPLD_49 + POP BC + EX DE,HL + POP DE + PUSH DE + RST CPDEHL + EX DE,HL + JP C,DWNLDR_18 + POP DE + LD E,C + LD D,B + RET + +DWNLDR_19: + CALL DWNLDR_14 + EX DE,HL + LD ($F505),HL + RET + + +TXT_CTL_V_55: + LD (SAVE_CSRX),HL + PUSH HL + LD HL,$F507 + CALL GET_BT_ROWPOS + LD B,A +DWNLDR_21: + LD E,(HL) + INC HL + LD D,(HL) + INC HL + PUSH HL + LD HL,(SAVE_CSRX) + RST CPDEHL + JP C,DWNLDR_22 + POP HL + EX DE,HL + EX (SP),HL + EX DE,HL + DEC B + JP P,DWNLDR_21 + DI + HALT + +DWNLDR_22: + EX DE,HL + POP HL + POP HL +DWNLDR_23: + PUSH HL + LD HL,TXT_BUF + LD (TXT_PTR),HL + XOR A + LD (TXT_COUNT),A + POP HL + DEC HL +DWNLDR_24: + INC HL + RST CPDEHL + JP NC,DWNLDR_25 + LD A,(HL) + CALL TXT_ADD_GRAPH + LD A,(HL) + CP ' ' + JP NC,DWNLDR_24 + CP $09 + JP Z,DWNLDR_24 + CALL TXT_ADD_GRAPH + JP DWNLDR_24 + +DWNLDR_25: + LD A,(TXT_COUNT) + INC A + LD H,A + CALL GET_BT_ROWPOS + SUB B + LD L,A + RET + +; This entry point is used by the routines at TXT_CTL_I, TXT_CTL_M, TXT_CTL_H, +; TXT_CTL_F, TXT_CTL_A, TXT_CTL_R, TXT_CTL_L, TXT_CTL_C, TXT_CTL_U and +; TXT_CTL_N. +TXT_GET_CURPOS: + CALL DWNLDR_12 + PUSH DE + INC A + CALL DWNLDR_13 + LD A,D + AND E + INC A + JP NZ,DWNLDR_27 + LD HL,(TEXT_END) + EX DE,HL + INC DE +DWNLDR_27: + DEC DE + LD A,(DE) + CP $0A + JP NZ,DWNLDR_28 + DEC DE + LD A,(DE) + CP $0D + JP Z,DWNLDR_28 + INC DE +DWNLDR_28: + POP HL + PUSH HL + CALL DWNLDR_23 + LD A,(CSRY) + CP H + JP C,DWNLDR_27 + POP HL + EX DE,HL + RET + +GETEND_CURTXT: + LD HL,(CUR_TXTFILE) +GETEND: + LD A,$1A +GET_DEVICE_371: + CP (HL) + INC HL + JP NZ,GET_DEVICE_371 + DEC HL + LD (TEXT_END),HL + RET +GET_DEVICE_372: + PUSH AF + EX DE,HL + LD HL,(CUR_TXTFILE) + EX DE,HL +GET_DEVICE_373: + PUSH HL + PUSH DE + CALL TEL_UPLD_49 + POP BC + POP HL + RST CPDEHL + JP NC,GET_DEVICE_373 + LD H,B + LD L,C + POP BC + DEC B + RET Z + EX DE,HL +GET_DEVICE_374: + PUSH BC + CALL DWNLDR_15 + POP BC + LD A,D + OR E + LD HL,(CUR_TXTFILE) + RET Z + DEC B + JP NZ,GET_DEVICE_374 + EX DE,HL + RET +; This entry point is used by the routine at GETWORD. +INSCHR: + LD BC,$0001 + PUSH AF + CALL MAKHOL + POP BC + RET C + LD (HL),B + INC HL + RET +; This entry point is used by the routine at GETWORD. +MAKHOL: + EX DE,HL + LD HL,(ARREND) + ADD HL,BC + RET C + LD A,$88 + SUB L + LD L,A + LD A,$FF + SBC A,H + LD H,A + RET C + ADD HL,SP + CCF + RET C +; This entry point is used by the routine at GETWORD. +MAKHOL_0: + PUSH BC + CALL GET_DEVICE_379 + LD HL,(ARREND) + LD A,L + SUB E + LD E,A + LD A,H + SBC A,D + LD D,A + PUSH DE + LD E,L + LD D,H + ADD HL,BC + LD (ARREND),HL + EX DE,HL + DEC DE + DEC HL + POP BC + LD A,B + OR C + CALL NZ,_LDDR + INC HL + POP BC + RET +; This entry point is used by the routine at GETWORD. +MASDEL: + LD A,B + OR C + RET Z + PUSH HL + PUSH BC + PUSH HL + ADD HL,BC + EX DE,HL + LD HL,(ARREND) + EX DE,HL + LD A,E + SUB L + LD C,A + LD A,D + SBC A,H + LD B,A + POP DE + LD A,B + OR C + CALL NZ,_LDIR + EX DE,HL + LD (ARREND),HL + POP BC + XOR A + SUB C + LD C,A + SBC A,A + SUB B + LD B,A + POP HL +GET_DEVICE_379: + PUSH HL + LD HL,(CO_FILES) + ADD HL,BC + LD (CO_FILES),HL + LD HL,(PROGND) + ADD HL,BC + LD (PROGND),HL + LD HL,(VAREND) + ADD HL,BC + LD (VAREND),HL + POP HL + RET + +; This entry point is used by the routines at GETWORD and ISFLIO. +_LDIR: + LD A,(HL) + LD (DE),A + INC HL + INC DE + DEC BC + LD A,B + OR C + JP NZ,_LDIR + RET + +; This entry point is used by the routine at ISFLIO. +_LDDR: + LD A,(HL) + LD (DE),A + DEC HL + DEC DE + DEC BC + LD A,B + OR C + JP NZ,_LDDR + RET + + OR B + RET NC + LD L,H + LD B,D + LD B,C + LD D,E + LD C,C + LD B,E + JR NZ,DWNLDR_44 + NOP + OR B + CALL NZ,GET_DEVICE_20 + LD B,L + LD E,B + LD D,H + JR NZ,DWNLDR_45 + JR NZ,DWNLDR_42 +DWNLDR_42: + OR B + CALL C,GET_DEVICE_19 + LD B,L + LD C,H + LD B,E + LD C,A + LD C,L + JR NZ,DWNLDR_43 +DWNLDR_43: + ADC A,B + NOP + NOP + NOP + LD D,E + LD (HL),L + LD A,D + LD (HL),L + LD L,E +DWNLDR_44: + LD L,C + JR NZ,_LDDR + NOP + NOP + NOP + LD C,B + LD H,C + LD A,C + LD H,C +DWNLDR_45: + LD (HL),E + LD L,B + LD L,C + LD C,B + NOP + NOP + NOP + LD D,D + LD L,C + LD H,E + LD L,E + LD E,C + JR NZ,$6CF0 + + + CALL PRINT_COPYRIGHT + LD HL,SUZUKI-1 + LD (DIRPNT),HL + LD HL,(SUZUKI) + LD (BASTXT),HL + LD A,$FF + LD (LABEL_LN),A +BASIC_0: + CALL LOAD_BA_LBL + CALL FNKSB + XOR A + LD (FNK_FLAG),A + CALL UPD_PTRS + CALL RUN_FST + JP READY + +; This entry point is used by the routines at OUTS_B_CHARS and BOOT. +SAVE_BA_LBL: + LD HL,FNKSTR + LD DE,$F746 + JP LOAD_BA_LBL_0 + +; LOAD BA LABEL +; +; Used by the routines at __MENU and BASIC. +LOAD_BA_LBL: + LD HL,$F746 + LD DE,FNKSTR + +LOAD_BA_LBL_0: + LD B,$A0 + JP LDIR_B + +; This entry point is used by the routines at TELCOM_RDY and SCHEDL_DE. +PARSE_COMMAND: + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. +PARSE_COMMAND_0: + LD A,(DE) + INC A + RET Z + PUSH HL + LD B,$04 +PARSE_COMMAND_1: + LD A,(DE) + LD C,A + CALL UCASE_HL + CP C + INC DE + INC HL + JP NZ,PARSE_COMMAND_3 + DEC B + JP NZ,PARSE_COMMAND_1 + POP AF + PUSH HL + EX DE,HL +PARSE_COMMAND_2: + LD E,(HL) + INC HL + LD D,(HL) + EX DE,HL + POP DE + EX (SP),HL + PUSH HL + EX DE,HL + INC H + DEC H + RET + +PARSE_COMMAND_3: + INC DE + DEC B + JP NZ,PARSE_COMMAND_3 + INC DE + POP HL + JP PARSE_COMMAND_0 + +INITIO: + DI + LD HL,ENDLCD + LD B,132 + CALL ZERO_MEM + INC A +IOINIT: + PUSH AF + DI + LD A,$19 + JR NC,PARSE_COMMAND_2 + RET Z + LD A,$43 + OUT ($B8),A + LD A,$05 + CALL SET_CLOCK_HL_4 + LD A,$ED + OUT ($BA),A + LD A,($FE43) + CALL __MENU_04 + CALL GET_DEVICE_566 + CALL INIT_LCD_ADDR + XOR A + OUT ($FE),A + CALL INIT_LCD_ADDR + LD A,$3B + OUT ($FE),A + CALL LCD_INIT_3E + CALL INIT_LCD_ADDR + LD A,$39 + OUT ($FE),A + EI + POP AF + RET Z + CALL __MENU_03 + LD A,($FEC1) + CP $02 + RET NC + CALL GET_DEVICE_582 + CALL GET_DEVICE_581 + LD A,($FEC1) + DEC A + CALL NZ,GET_DEVICE_589 + RET + +; This entry point is used by the routine at GETWORD. +PRS_ABORTMSG7: + PUSH BC + LD C,A +PRS_ABORTMSG8: + CALL BREAK + JP C,$6DBF + IN A,($BB) + AND $06 + XOR $02 + JP NZ,PRS_ABORTMSG8 + CALL SETINT_1D + LD A,C + OUT ($B9),A ; I/O port select + LD A,(ROMSEL) + LD B,A + OR $20 + NOP + OUT ($90),A + LD A,B + OUT ($90),A + PUSH BC + LD C,$06 + CALL CALLHL1 +PRS_ABORTMSG9: + POP BC + LD A,$09 + JR NC,$6E39 + POP BC + RET + +; Check RS232 queue for characters, Z if no data, A = number of chars in queue +; +; Used by the routines at EXEC_EVAL_0, TEL_TERM, TEL_UPLD and RV232C. +RCVX: + LD A,(XONXOFF_FLG) + OR A + JP Z,RCVX_0 + LD A,(XONXOFF) + INC A + RET Z +RCVX_0: + LD A,(RS232_COUNT) + OR A + RET + +; Get from RS232, A = char, Z if OK, CY if BREAK +; +; Used by the routines at COM_INPUT, TEL_LOGON, TEL_TERM and TEL_UPLD. +RV232C: + PUSH HL + PUSH DE + PUSH BC + LD HL,POPALL_INT+1 + PUSH HL + LD HL,RS232_COUNT +RV232C_0: + CALL GET_DEVICE_580 + CALL RCVX + JP Z,RV232C_0 + CP $03 + CALL C,SENDCQ + DI + DEC (HL) + CALL _UART_2 + LD A,(HL) + EX DE,HL + INC HL + INC HL + INC (HL) + DEC (HL) + RET Z + DEC (HL) + JP Z,RV232C_1 + CP A + RET +RV232C_1: + OR $FF + RET + +; RST 6.5 (RS232 Interrupt on received character) routine +; +; Used by the routine at RST65. +_UART: + CALL UART + PUSH HL + PUSH DE + PUSH BC + PUSH AF + LD HL,POPALL_INT + PUSH HL + IN A,($C8) + LD HL,COMMSK + AND (HL) + LD C,A + IN A,($D8) + AND $0E + LD B,A + JP NZ,_UART_0 + LD A,C + CP $11 ; XON + JP Z,$6E26 + CP $13 ; XOFF + JP NZ,_UART_0 + LD A,$AF + LD (ENDLCD),A + LD A,(XONXOFF_FLG) + OR A + RET NZ + +_UART_0: + LD A,($FE43) + CP $03 + JP NZ,DWNLDR_68 + LD A,($F40B) + CP $53 + JP NZ,DWNLDR_68 + LD HL,$F9B8 + LD A,C + SUB $0F + JP NZ,DWNLDR_67 + LD (HL),A + RET + +DWNLDR_67: + INC A + JP NZ,DWNLDR_68 + LD (HL),$80 + RET + +DWNLDR_68: + LD HL,RS232_COUNT + LD A,(HL) + CP $FF + RET Z + CP $E7 + CALL NC,SENDCS + PUSH BC + INC (HL) + INC HL + CALL _UART_2 + POP BC + LD A,($F40B) + CP $53 + JP NZ,DWNLDR_69 + LD A,C + CP ' ' + JP C,GET_DEVICE_410 +DWNLDR_69: + LD A,($F9B8) + OR C +GET_DEVICE_410: + LD (HL),A + LD A,B + OR A + RET Z + EX DE,HL + INC HL + DEC (HL) + INC (HL) + RET NZ + LD A,(RS232_COUNT) + LD (HL),A + RET + +_UART_2: + INC HL + LD C,(HL) + LD A,C + INC A + CP $FF + JP C,GET_DEVICE_412 + XOR A +GET_DEVICE_412: + LD (HL),A + EX DE,HL + LD HL,RS232_BUF + LD B,$00 + ADD HL,BC + RET + +; Send CTRL-Q character (X-ON) +; +; Used by the routine at RV232C. +SENDCQ: + LD A,(XONXOFF_FLG) + AND A + RET Z + LD A,(CTRL_S_FLG) + DEC A + RET NZ + LD (CTRL_S_FLG),A + PUSH BC + LD C,$11 + JP _SD232C_DELAYED + +; Send CTRL-S character (X-OFF) +; +; Used by the routine at _UART. +SENDCS: + LD A,(XONXOFF_FLG) + AND A + RET Z + LD A,(CTRL_S_FLG) + OR A + RET NZ + INC A + LD (CTRL_S_FLG),A + PUSH BC + LD C,$13 ; XOFF + JP _SD232C + +; This entry point is used by the routine at GETWORD. +SD232C: + RST $38 + LD D,D + PUSH BC + LD C,A + LD A,($F40B) + CP $53 + JP NZ,GET_DEVICE_416 + LD A,($F9B7) + XOR C + LD A,C + LD ($F9B7),A + JP P,GET_DEVICE_416 + ADD A,A + SBC A,A + ADD A,$0F + CALL SD232C +GET_DEVICE_416: + LD A,C + POP BC + + + +; Send to RS232, A = char +; +; Used by the routines at COM_OUTPUT, TEL_LOGON, TEL_TERM and TEL_UPLD. +SD232C: + PUSH BC + LD C,A + CALL _SD232C_1 + JP C,_SD232C_0 + + +_SD232C_DELAYED: + NOP + NOP + NOP + NOP + NOP + NOP + +_SD232C: + IN A,($D8) + AND $10 + JP Z,_SD232C + LD A,C + OUT ($C8),A + +_SD232C_0: + LD A,C + POP BC + RET + +_SD232C_1: + LD A,(XONXOFF_FLG) + OR A + RET Z + LD A,C + CP $11 + JP NZ,_SD232C_2 + XOR A + LD (CTRL_S_FLG),A + JP _SD232C_3 + +_SD232C_2: + SUB $13 + JP NZ,_SD232C_4 + DEC A +_SD232C_3: + LD (XONXOFF),A + RET + +_SD232C_4: + CALL BREAK + RET C + LD A,(ENDLCD) + OR A + JP NZ,_SD232C_4 + RET + + +; Set baud rate, H = 0..9 +; +; Used by the routine at INZCOM. +BAUDST: + PUSH HL + LD A,H + RLCA + LD HL,BAUD_TBL-2 + LD D,$00 + LD E,A + ADD HL,DE + LD (RS232_BAUD),HL + POP HL +; This entry point is used by the routine at MUSIC. +BAUDST_0: + PUSH HL + LD HL,(RS232_BAUD) + LD A,(HL) + OUT ($BC),A + INC HL + LD A,(HL) + OUT ($BD),A + LD A,$C3 + OUT ($B8),A + POP HL + RET + +; Start of 18 byte RS232 baud rate timer values (words). +BAUD_TBL: + DEFW $4800 + DEFW $456B + DEFW $4200 + DEFW $4100 + DEFW $4080 + DEFW $4040 + DEFW $4020 + DEFW $4010 + DEFW $4008 + + + +; Routine at 28498 +; +; Used by the routine at L76E6. +L6F52: + LD A,$01 + LD BC,$023E + LD BC,$033E + PUSH HL + PUSH DE + PUSH BC + PUSH AF + CP $03 + JP Z,INZCOM_0 + CALL $6F8E + LD BC,$C0FF + LD HL,$091C +INZCOM_0: + DI + LD A,C + LD (COMMSK),A + POP AF + PUSH AF + CALL __MENU_04 + + CALL BAUDST + IN A,($BA) + AND $3F + OR B + OUT ($BA),A + IN A,($D8) + LD A,L + AND $1F + OUT ($D8),A + CALL RES_RS232_FLAGS + JP POPALL_INT + +; This entry point is used by the routine at GETWORD. +_XONXOFF_FLG: + LD A,$AF + DI +_XONXOFF_SETFLG: + LD (XONXOFF_FLG),A + EI + RET + +RES_RS232_FLAGS: + XOR A + LD L,A + LD H,A + LD (ENDLCD),HL + LD (RS232_COUNT),HL + LD ($FE47),HL + LD ($F9B7),HL + LD (CTRL_S_FLG),A + RET + +; This entry point is used by the routine at GETWORD. +__MENU_02: + IN A,($BA) + OR $C0 + OUT ($BA),A +__MENU_03: + XOR A + LD ($FEC2),A + +__MENU_04: + RST $38 + LD D,H + PUSH BC + LD C,A + OR A + JP Z,__MENU_05 + LD A,($FE43) + OR A + JP Z,__MENU_05 + CP C + JP NZ,$056E + +__MENU_05: + LD A,C + LD ($FE43),A + RRCA + RRCA + LD C,A + LD A,(ROMSEL) + AND $3F + OR C + LD (ROMSEL),A + OUT ($90),A + POP BC + RET + +; This entry point is used by the routine at GETWORD. +DATAR_1: + LD A,(ROMSEL) + AND $F7 + INC E + DEC E + JP Z,DATAR_2 + OR $08 +DATAR_2: + OUT ($90),A + LD (ROMSEL),A + RET + +; This entry point is used by the routine at GETWORD. +DATAW: + LD C,A + LD DE,$00A5 + CALL __MENU_04 + IN A,($B9) + ADD A,$00 + LD B,$08 +__MENU_09: + NOP + NOP + LD HL,($0000) + INC DE + LD A,C + RRA + LD C,A + JP C,__MENU_02 + ADD A,$00 + LD DE,$00A5 + CALL __MENU_04 + IN A,($B9) +__MENU_00: + DEC B + JP NZ,__MENU_09 + LD A,$03 +__MENU_01: + DEC A + JP NZ,__MENU_01 + LD A,($0000) + LD DE,$00A8 + CALL __MENU_03 + NOP + NOP + LD DE,$00A8 + CALL __MENU_03 + JP BREAK +__MENU_02: + NOP + LD DE,$00A5 + CALL __MENU_03 + JP __MENU_00 +__MENU_03: + LD A,$D0 + JP __MENU_05 +__MENU_04: + IN A,($B9) + LD A,$50 +__MENU_05: + JR NC,$705C + LD A,D + OR E + JP NZ,$7040 + RET + +; This entry point is used by the routine at GETWORD. +__MENU_06: + CALL __MENU_04 + LD BC,5240 + CALL DELAY_BC + CALL __MENU_03 + LD BC,1000 + JP DELAY_BC + +; Read cassette header and sync byte only +; +; Used by the routine at HEADER.SYNCR: +SYNCR: + LD D,$00 +SYNCR_0: + CALL __MENU_17 + RET C + LD A,H + RLA + JP C,SYNCR + INC D + JP NZ,SYNCR_0 +__MENU_09: + LD D,$00 +__MENU_10: + CALL __MENU_17 + RET C + LD A,H + AND A + JP P,__MENU_09 + INC D + JP P,__MENU_10 + RET + +__MENU_11: + LD E,$00 +__MENU_12: + CALL BREAK + RET C + JR NZ,__MENU_14 + JP NC,__MENU_12 +__MENU_13: + INC E + JP Z,__MENU_11 +__MENU_14: + JR NZ,$7090 + JP C,__MENU_13 + XOR A + RET + +; This entry point is used by the routine at GETWORD. +DATAR: + CALL __MENU_11 + RET C + LD A,$14 + CP E + JP NC,DATAR + CALL __MENU_11 + RET C + LD A,$14 + CP E + JP NC,DATAR + LD L,$08 +__MENU_16: + CALL __MENU_17 + RET C + DEC L + JP NZ,__MENU_16 + LD A,H + CP H + RET + +__MENU_17: + CALL __MENU_11 + RET C + LD B,E + CALL __MENU_11 + RET C + LD A,B + ADD A,E + CP $28 + JP NC,__MENU_18 + CALL __MENU_11 + RET C + CALL __MENU_11 + RET C + SCF +__MENU_18: + LD A,H + RRA + LD H,A + XOR A + RET + +L70CD: + LD HL,_RST75_END + PUSH HL + LD HL,KBSITP + DEC (HL) + RET NZ + LD (HL),$03 + LD HL,KYDATA+8 + LD DE,KB_SHIFT + ; BRK_SCAN + LD A,$FF + OUT ($B9),A ; I/O port select + IN A,($BA) + AND $FE + OUT ($BA),A + IN A,($E8) + PUSH AF + IN A,($BA) + INC A + OUT ($BA),A + POP AF + CPL + CP (HL) + LD (HL),A + JP NZ,__MENU_19 + LD A,(DE) + LD B,A + LD A,(HL) + LD (DE),A +__MENU_19: + XOR A + OUT ($B9),A ; I/O port select + IN A,($E8) + INC A + LD A,$FF + OUT ($B9),A ; I/O port select + JP Z,__MENU_44 + LD A,$7F + LD C,$07 +__MENU_20: + LD B,A + OUT ($B9),A ; I/O port select + IN A,($E8) + CPL + DEC HL + DEC DE + CP (HL) + LD (HL),A + LD A,$FF + OUT ($B9),A ; I/O port select + JP NZ,__MENU_21 + LD A,(DE) + CP (HL) + CALL NZ,__MENU_22 +__MENU_21: + LD A,B + RRCA + DEC C + JP P,__MENU_20 + DEC HL + LD (HL),$02 + LD HL,KYWHAT + DEC (HL) + JP Z,__MENU_28 + INC (HL) + RET M + LD A,(KYWHAT+2) + LD HL,(KYWHAT+3) + AND (HL) + RET Z + LD A,(KYBCNT) + CP $02 + RET NC + LD HL,KYREPT + DEC (HL) + RET NZ + LD (HL),$06 + LD A,$01 + LD (CSRCNT),A + JP __MENU_29 + +__MENU_22: + PUSH BC + PUSH HL + PUSH DE + LD B,A + LD A,$80 + LD E,$07 +__MENU_23: + LD D,A + AND (HL) + JP Z,__MENU_24 + AND B + JP Z,__MENU_26 +__MENU_24: + LD A,D + RRCA + DEC E + JP P,__MENU_23 + POP DE +__MENU_25: + POP HL + LD A,(HL) + LD (DE),A + POP BC + RET + +__MENU_26: + LD HL,KYWHAT + INC A + CP (HL) + JP NZ,__MENU_27 + POP DE + POP HL + POP BC + RET + +__MENU_27: + LD (HL),A + LD A,C + RLCA + RLCA + RLCA + OR E + INC HL + LD (HL),A + INC HL + LD (HL),D + POP DE + EX DE,HL + LD (KYWHAT+3),HL + EX DE,HL + JP __MENU_25 + +__MENU_28: + DEC HL + LD (HL),$54 + DEC HL + LD A,(KB_SHIFT) + LD (HL),A +__MENU_29: + LD HL,$7224 + PUSH HL + LD HL,KYWHAT+1 + LD A,(HL) + LD C,A + LD DE,$002E + LD B,D + CP $35 + LD A,B + SBC A,B + INC HL + AND (HL) + LD (HL),A + LD A,(KYHOW) + RRCA + PUSH AF + LD A,C + CP E + JP C,__MENU_32 + POP AF + LD E,A + RRCA + JP NC,__MENU_30 + LD A,C + CP $31 + JP C,__MENU_30 + CP $35 + LD HL,$71EA + JP C,__MENU_31 +__MENU_30: + LD HL,$7BFD + LD A,E + RLCA + JP NC,__MENU_31 + LD HL,$7C0F +__MENU_31: + ADD HL,BC + LD A,(HL) + RET +__MENU_32: + POP AF + LD E,B + JP NC,__MENU_33 + LD E,$15 +__MENU_33: + PUSH AF + LD HL,$7BE9 + AND $20 + JP Z,__MENU_34 + LD HL,GET_DEVICE_646 +__MENU_34: + ADD HL,BC + POP AF + RRCA + JP C,__MENU_37 + RRCA + JP C,GET_DEVICE_621 + DEC E + JP P,__MENU_36 + AND $02 +__MENU_35: + LD A,(HL) + RET Z + JP GET_DEVICE_629 +__MENU_36: + LD A,C + CP $1A ; EOF + JP C,__MENU_35 + ADD HL,DE + LD A,(HL) + RET +__MENU_37: + AND $10 + LD A,C + LD C,$1B + CALL NZ,__MENU_38 + CP C + LD A,(HL) + JP C,$721F + XOR A + RET +__MENU_38: + DEC C + CP '"' + RET NZ + XOR A + RET + RLA + LD A,(DE) + LD DE,$7E12 + AND $1F + POP HL + JP C,CALLHL8 + LD C,A + SUB $F0 + JP C,__MENU_39 + LD C,A + JP __MENU_41 +__MENU_39: + LD A,C + CP $11 + JP Z,__MENU_40 + AND $EF + CP $03 + JP NZ,__MENU_42 +__MENU_40: + LD A,(FNK_FLAG) + AND $C0 + JP NZ,__MENU_42 + LD A,C + LD (BRKCHR),A + CP $03 + RET NZ + LD HL,KYBCNT + LD (HL),$00 + INC B +__MENU_41: + DEC B +__MENU_42: + LD HL,KYBCNT + LD A,(HL) + CP ' ' + RET NC + INC (HL) + RLCA + INC HL + LD E,A + ADD HL,DE + LD (HL),C + INC HL + LD (HL),B + POP AF + +_RST75_END: + LD A,$09 + + ; THIS IS A COMPLEX OPTIMIZATION, + ; THE RELATIVE JP OFFSET IS EQUIVALENT TO "POP AF" ! + ; + ; Moving the code in this ROM is not definitely a beginner's task.. + ; + ;JR NC,$7258 + defb $30 ; JR NC,N + +; POP AF, BC, DE, and HL off stack, enable interrupts and return. +; +; Used by the routines at INZCOM and MUSIC. +POPALL_INT: + POP AF +; + POP BC + POP DE + POP HL + EI + RET + +__MENU_44: + LD HL,REPCNT + DEC (HL) + RET NZ + LD HL,KYDATA + LD B,$11 + JP ZERO_MEM + +; This entry point is used by the routine at GETWORD. +__MENU_45: + CALL SETINT_1D + LD A,(KYBCNT) + OR A + JP Z,EI_NORM + LD HL,KYRDBF+1 + LD A,(HL) + ADD A,$02 + DEC HL + LD A,(HL) + PUSH AF + DEC HL + DEC (HL) + LD A,(HL) + RLCA + LD C,A + LD DE,KYRDBF+2 + INC HL +KYREAD_0: + DEC C + + defb $FA ; JP M,KYREAD_1 + +KYREAD_1: + LD L,C + LD (HL),D + LD A,(DE) + LD (HL),A + INC HL + INC DE + JP KYREAD_0 + +EI_NORM: + PUSH AF +EI_NORM_0: + LD A,$09 + JR NC,KYREAD_1 + RET + +; This entry point is used by the routine at GETWORD. +KEYX: + CALL BRKCHK + JP Z,KEYX_0 + CP $03 + JP NZ,KEYX_0 + OR A + SCF + RET + +KEYX_0: + LD A,(KYBCNT) + OR A + RET + +; This entry point is used by the routine at GETWORD. +BRKCHK: + PUSH HL + LD A,(LABEL_LN) + OR A + JP Z,BRKCHK_0 + LD A,(KB_SHIFT) + LD L,A + LD A,(FNKSTS) + XOR L + AND $01 + JP Z,BRKCHK_0 + AND L + PUSH DE + PUSH BC + CALL DSPFNK_0 + POP BC + POP DE +BRKCHK_0: + LD HL,BRKCHR + LD A,(HL) + LD (HL),$00 + POP HL + OR A + RET + +BREAK: + PUSH BC + IN A,($BA) + LD B,A + OR $01 + OUT ($BA),A + IN A,($B9) ; I/O port select + LD C,A + LD A,$7F + OUT ($B9),A ; I/O port select + IN A,($E8) + PUSH AF + LD A,$FF + OUT ($B9),A ; I/O port select + LD A,B + AND $FE + OUT ($BA),A + IN A,($E8) + RRCA + LD A,C + OUT ($B9),A ; I/O port select + LD A,B + OUT ($BA),A + POP BC + LD A,B + RRA + AND $C0 + POP BC + RET NZ + INC A + SCF + RET + +; This entry point is used by the routine at GETWORD. +MUSIC: + DI + LD A,E + OUT ($BC),A + LD A,D + OR $40 + OUT ($BD),A + LD A,$C3 + OUT ($B8),A + IN A,($BA) + AND $F8 + OR $20 + OUT ($BA),A +MUSIC_0: + CALL BREAK + JP NC,MUSIC_1 + LD A,$03 + LD (BRKCHR),A + JP MUSIC_3 + +MUSIC_1: + PUSH BC + LD BC,$012F + CALL DELAY_BC + POP BC + DEC B + JP NZ,MUSIC_0 +MUSIC_3: + IN A,($BA) + OR $04 + OUT ($BA),A + CALL BAUDST_0 + EI + RET + +DELAY_BC: + LD A,C +DELAY_BC_1: + PUSH BC + LD C,$48 +DELAY_BC_2: + DEC C + JP NZ,DELAY_BC_2 + POP BC + DEC A + JP NZ,DELAY_BC_1 + DEC B + JP NZ,DELAY_BC + RET + + +; Load the contents of the clock chip registers into the address pointed to by +; HL. +; +; Used by the routines at READ_CLOCK and _RST75. +READ_CLOCK_HL: + defb $f6 ; OR $AF + + +; Update the clock chip internal registers with the time in the buffer pointed +; to by HL +; +; Used by the routines at SET_CLOCK and BOOT. +SET_CLOCK_HL: + XOR A + PUSH AF + CALL SETINT_1D + LD A,$03 + CALL NZ,SET_CLOCK_HL_4 + LD A,$01 + CALL SET_CLOCK_HL_4 + LD C,$07 + CALL DELAY_C + LD B,$0A +__MENU_63: + LD C,$04 + LD D,(HL) +__MENU_64: + POP AF + PUSH AF + JP Z,__MENU_65 + IN A,($BB) + RRA + LD A,D + RRA + LD D,A + XOR A + JP __MENU_66 + +__MENU_65: + LD A,D + RRCA + LD D,A + LD A,$10 + RRA + RRA + RRA + RRA + OUT ($B9),A ; I/O port select +__MENU_66: + OR $09 + OUT ($B9),A ; I/O port select + AND $F7 + OUT ($B9),A ; I/O port select + DEC C + JP NZ,__MENU_64 + LD A,D + RRCA + RRCA + RRCA + RRCA + AND $0F + LD (HL),A + INC HL + DEC B + JP NZ,__MENU_63 + POP AF + LD A,$02 + CALL Z,SET_CLOCK_HL_4 + XOR A + CALL SET_CLOCK_HL_4 + JP SET_CLOCK_HL_16 + +; This entry point is used by the routine at IOINIT. +SET_CLOCK_HL_4: + OUT ($B9),A ; I/O port select + LD A,(ROMSEL) + OR $10 + OUT ($90),A + AND $EF + OUT ($90),A + RET + +; This entry point is used by the routine at GETWORD. +_RST75_7: + CALL SETINT_1D + LD HL,L70CD + PUSH HL + LD HL,CSRCNT + DEC (HL) + RET NZ + LD (HL),$7D + DEC HL + LD A,(HL) + OR A + JP P,_RST75_8 + RET PO +_RST75_8: + XOR $01 + LD (HL),A + +; -- extra code, missing on other platforms + LD A,(CSTYLE) + OR A + JP Z,PUT_SHAPE + PUSH HL + CALL __MENU_91 + LD A,(CSRSTS) + RRCA + JP NC,PUT_SHAPE_2 + PUSH DE + LD A,(RVSCUR) + LD E,A + LD A,$06 + LD HL,SHAPE2 + LD BC,SHAPE + PUSH BC +__MENU_70: + PUSH AF + LD A,(HL) + OR E + LD (BC),A + INC BC + INC HL + POP AF + DEC A + JP NZ,__MENU_70 + POP HL + POP DE + JP PUT_SHAPE_1 +; -- extra code, missing on other platforms + +; This entry point is used by the routines at ESC_J and DOTTED_FNAME. +PUT_SHAPE: + PUSH HL + LD HL,SHAPE + LD D,$00 + CALL LOAD_SHAPE + LD B,$06 + DEC HL +PUT_SHAPE_0: + LD A,(HL) + CPL + LD (HL),A + DEC HL + DEC B + JP NZ,PUT_SHAPE_0 + INC HL +PUT_SHAPE_1: + LD D,$01 + CALL LOAD_SHAPE +PUT_SHAPE_2: + POP HL + RET + +; This entry point is used by the routine at ISFLIO. +__MENU_75: + OR $AF +; This entry point is used by the routine at ISFLIO. +__MENU_76: + PUSH HL + PUSH DE + PUSH BC + PUSH AF + CALL SETINT_1D + LD HL,CSRSTS + LD A,(HL) + RRCA + LD (HL),$80 + CALL C,__MENU_91 + POP AF + PUSH AF + JP Z,_RST75_END + LD D,$00 + CALL LOAD_SHAPE2 + XOR A + LD (CSRSTS),A + INC A + LD (CSRCNT),A + JP _RST75_END + +; This entry point is used by the routine at ISFLIO. +INIT_LCD: + CALL SETINT_1D + LD HL,$0000 + ADD HL,SP + LD (SAVSP),HL + DEC D + DEC E + EX DE,HL + LD (LCD_ADDR),HL + LD A,C + ;LD DE,$78B7 + LD DE,FONT-1 + SUB $20 + JP Z,__MENU_82 + + CP $60 + ;defb $fe ; CP NN + ;LD H,B + + JP NC,__MENU_79 + LD HL,$7AFF + LD B,$09 +__MENU_78: + CP (HL) + JP Z,GET_DEVICE_624 + INC HL + DEC B + JP NZ,__MENU_78 + SCF + JP __MENU_82 +__MENU_79: + SUB $63 + JP NC,__MENU_80 + ADD A,$53 + OR A + JP __MENU_82 + +__MENU_80: + LD B,A + DEC DE + LD HL,(GCPNTR) +SET_CLOCK_HL_12: + LD A,L + OR H + JP Z,__MENU_82 + EX DE,HL + LD A,B +__MENU_82: + PUSH AF + LD L,A + LD H,$00 + LD B,H + LD C,L + ADD HL,HL + ADD HL,HL + ADD HL,BC ; *5 + POP AF + PUSH AF + JP C,ASCII_SYMBOL + ADD HL,BC ; *6 +ASCII_SYMBOL: + ADD HL,DE + POP AF + JP NC,GFX_SYMBOL + LD DE,SHAPE + PUSH DE + LD B,$05 + CALL LDIR_B + XOR A + LD (DE),A + POP HL +GFX_SYMBOL: + LD D,$01 + CALL LOAD_SHAPE +SET_CLOCK_HL_15: + XOR A + LD (GFX_TEMP+3),A + CALL LCD_INIT_3E +SET_CLOCK_HL_16: + LD A,$09 + JR NC,SET_CLOCK_HL_12 + +; Move cursor to specified position +; +; Used by the routines at OUTC_SUB and DOTTED_FNAME. +MOVE_CURSOR: + CALL SETINT_1D + DEC D + DEC E + EX DE,HL + LD (LCD_ADDR),HL + JP SET_CLOCK_HL_16 + +; Plot point on screen (D,E) +; +; Used by the routine at __PSET. +; +; D = X position (0..239), E = Y position (0..63) +PLOT: + defb $f6 ; OR $AF + +; Reset point on screen (D,E) +; +; Used by the routine at __PSET. +UNPLOT: + XOR A + PUSH AF ; Save flags to choose between PLOT and UNPLOT + CALL SETINT_1D + PUSH DE + LD C,$FE + LD A,D +__MENU_89: + INC C + INC C + LD D,A + SUB $32 + JP NC,__MENU_89 + LD B,$00 + LD HL,PLOT_TBL + LD A,E + RLA + RLA + RLA + JP NC,__MENU_90 + + LD HL,PLOT_TBL2 + +__MENU_90: + ADD HL,BC + LD B,A + CALL SET_LCD_ADDR + LD A,B + AND $C0 + OR D + LD B,A + LD E,$01 + LD HL,SHAPE + CALL SET_LCD + POP DE + LD D,B + LD A,E + AND $07 + ADD A,A + LD C,A + LD B,$00 + LD HL,PLOT_TBL + ADD HL,BC + POP AF + LD A,(HL) + LD HL,SHAPE + JP NZ,$751B + CPL + AND (HL) + + DEFB $06 ; LD B,N +L7497: + + LD B,$B6 + LD (HL),A + LD B,D + LD E,$01 + CALL GET_LCD + JP SET_CLOCK_HL_16 + +__MENU_91: + LD D,$01 +LOAD_SHAPE2: + LD HL,SHAPE2 + +; +; Used by the routines at SET_CLOCK_HL and L7409, D=??. +LOAD_SHAPE: + PUSH HL + LD E,$06 + LD A,(LCD_ADDR+1) + CP $08 + JP Z,LOAD_SHAPE_0 + CP $10 + JP Z,LOAD_SHAPE_1 + CP $21 + JP NZ,LOAD_SHAPE_2 +LOAD_SHAPE_0: + DEC E + DEC E +LOAD_SHAPE_1: + DEC E + DEC E +LOAD_SHAPE_2: + LD C,A + ADD A,C + ADD A,C + LD C,A + LD B,$00 + LD A,(LCD_ADDR) + RRA + RRA + RRA + LD HL,GFX_VECT2 + JP C,LOAD_SHAPE_3 + LD HL,GFX_VECT + +LOAD_SHAPE_3: + ADD HL,BC + LD B,A + CALL SET_LCD_ADDR + LD (GFX_TEMP),HL + LD A,B + OR (HL) + LD B,A + POP HL + DEC D + CALL SEND_LCD + INC D + LD A,$06 + SUB E + RET Z + LD E,A + PUSH HL + LD HL,(GFX_TEMP) + INC HL + CALL SET_LCD_ADDR + POP HL + LD A,B + AND $C0 + LD B,A + DEC D + + defb $da ; JP C,NN + +SET_LCD: + DEFB $F6 ;OR $AF (masks XOR A) + +; This entry point is used by the routine at UNPLOT. + +; Rebuild graphics character code to finalize PLOT/UNPLOT +GET_LCD: + XOR A + +; This entry point is used by the routine at L7497. +SEND_LCD: + PUSH DE + PUSH AF + LD A,B + CALL WAIT_LCD + OUT ($FE),A + JP Z,UNPLOT_8 + CALL WAIT_LCD + IN A,($FF) +UNPLOT_8: + POP AF + JP NZ,DO_GET_LCD + +DO_SEND_LCD: + IN A,($FE) + RLA + JP C,DO_SEND_LCD + LD A,(HL) + OUT ($FF),A + INC HL + DEC E + JP NZ,DO_SEND_LCD + POP DE + RET + +DO_GET_LCD: + IN A,($FE) + RLA + JP C,DO_GET_LCD + IN A,($FF) + LD (HL),A + INC HL + DEC E + JP NZ,DO_GET_LCD + POP DE + RET + +LCD_INIT_3E: + CALL INIT_LCD_ADDR + LD A,$3E + OUT ($FE),A + RET + +INIT_LCD_ADDR: + LD C,$03 + CALL DELAY_C + LD HL,$76CA ; OUT ($B9),$FF, OR $03 + +SET_LCD_ADDR: + LD A,(HL) + OUT ($B9),A ; I/O port select + INC HL + IN A,($BA) + AND $FC + OR (HL) + OUT ($BA),A + INC HL + RET + +WAIT_LCD: + PUSH AF +__MENU_106: + IN A,($FE) + RLA + JP C,__MENU_106 + POP AF + RET + + +; Data block at 30170 +GFX_VECT: + DEFB $01, $00, $00 + DEFB $01, $00, $06 + DEFB $01, $00, $0C + DEFB $01, $00, $12 + DEFB $01, $00, $18 + DEFB $01, $00, $1E + DEFB $01, $00, $24 + DEFB $01, $00, $2A + DEFB $01, $00, $30 + DEFB $02, $00, $04 + DEFB $02, $00, $0A + DEFB $02, $00, $10 + DEFB $02, $00, $16 + DEFB $02, $00, $1C + DEFB $02, $00, $22 + DEFB $02, $00, $28 + DEFB $02, $00, $2E + DEFB $04, $00, $02 + DEFB $04, $00, $08 + DEFB $04, $00, $0E + DEFB $04, $00, $14 + DEFB $04, $00, $1A + DEFB $04, $00, $20 + DEFB $04, $00, $26 + DEFB $04, $00, $2C + DEFB $08, $00, $00 + DEFB $08, $00, $06 + DEFB $08, $00, $0C + DEFB $08, $00, $12 + DEFB $08, $00, $18 + DEFB $08, $00, $1E + DEFB $08, $00, $24 + DEFB $08, $00, $2A + DEFB $08, $00, $30 + DEFB $10, $00, $04 + DEFB $10, $00, $0A + DEFB $10, $00, $10 + DEFB $10, $00, $16 + DEFB $10, $00, $1C + DEFB $10, $00, $22 + +; Data block at 30290 +GFX_VECT2: + DEFB $20, $00, $00 + DEFB $20, $00, $06 + DEFB $20, $00, $0C + DEFB $20, $00, $12 + DEFB $20, $00, $18 + DEFB $20, $00, $1E + DEFB $20, $00, $24 + DEFB $20, $00, $2A + DEFB $20, $00, $30 + DEFB $40, $00, $04 + DEFB $40, $00, $0A + DEFB $40, $00, $10 + DEFB $40, $00, $16 + DEFB $40, $00, $1C + DEFB $40, $00, $22 + DEFB $40, $00, $28 + DEFB $40, $00, $2E + DEFB $80, $00, $02 + DEFB $80, $00, $08 + DEFB $80, $00, $0E + DEFB $80, $00, $14 + DEFB $80, $00, $1A + DEFB $80, $00, $20 + DEFB $80, $00, $26 + DEFB $80, $00, $2C + DEFB $00, $01, $00 + DEFB $00, $01, $06 + DEFB $00, $01, $0C + DEFB $00, $01, $12 + DEFB $00, $01, $18 + DEFB $00, $01, $1E + DEFB $00, $01, $24 + DEFB $00, $01, $2A + DEFB $00, $01, $30 + DEFB $00, $02, $04 + DEFB $00, $02, $0A + DEFB $00, $02, $10 + DEFB $00, $02, $16 + DEFB $00, $02, $1C + DEFB $00, $02, $22 + + + +; Data block at 30412 +PLOT_TBL: + DEFB $01, $00 + DEFB $02, $00 + DEFB $04, $00 + DEFB $08, $00 + DEFB $10, $00 + +; Data block at 30422 ($76D6) +PLOT_TBL2: + DEFB $20, $00 + DEFB $40, $00 + DEFB $80, $00 + DEFB $00, $01 + DEFB $00, $02 + + +DELAY_C: + DEC C + JP NZ,DELAY_C + RET + +; Set interrupt to 1DH +; +; Used by the routines at PRINTR, KYREAD, SET_CLOCK_HL, MOVE_CURSOR, PLOT, UNPLOT and +; _BEEP. +SETINT_1D: + DI + LD A,$1D + JR NC,SETINT_1D + RET + +;_BEEP: + CALL SETINT_1D + LD B,$00 +_BEEP_0: + CALL _CLICK + LD C,$50 + CALL DELAY_C + DEC B + JP NZ,_BEEP_0 + JP SET_CLOCK_HL_16 + +_CLICK: + IN A,($BA) + XOR $20 + OUT ($BA),A + RET + +GET_DEVICE_565: + CALL GET_DEVICE_570 + RET Z +GET_DEVICE_566: + LD A,$91 + OUT ($73),A + CALL GET_DEVICE_570 + RET NZ + LD C,$00 + LD A,$0F + OUT ($73),A +GET_DEVICE_567: + CALL GET_DEVICE_580 + IN A,($72) + AND $02 + JP Z,GET_DEVICE_567 + LD A,$0E + OUT ($73),A + LD A,C + OUT ($71),A + LD A,$09 + OUT ($73),A +GET_DEVICE_568: + CALL GET_DEVICE_580 + IN A,($72) + AND $04 + JP Z,GET_DEVICE_568 + LD A,$08 + OUT ($73),A +GET_DEVICE_569: + CALL GET_DEVICE_580 + IN A,($72) + AND $04 + JP NZ,GET_DEVICE_569 + RET + +GET_DEVICE_570: + PUSH BC + LD A,$55 + LD B,A + OUT ($71),A + IN A,($71) + CP B + POP BC + RET + +GET_DEVICE_571: + LD A,$0B + OUT ($73),A +GET_DEVICE_572: + CALL GET_DEVICE_580 + IN A,($72) + AND $01 + JP Z,GET_DEVICE_572 + LD A,$0A + OUT ($73),A + IN A,($70) + LD C,A + LD A,$0D + OUT ($73),A +GET_DEVICE_573: + CALL GET_DEVICE_580 + IN A,($72) + AND $01 + JP NZ,GET_DEVICE_573 + LD A,$0C + OUT ($73),A + RET + +GET_DEVICE_574: + IN A,($BA) + AND $7F + OUT ($BA),A + LD D,$00 + CALL GET_DEVICE_575 + PUSH AF + IN A,($BA) + OR $80 + OUT ($BA),A + POP AF + RET C + LD D,$10 +GET_DEVICE_575: + LD A,($FEC2) + LD E,A +GET_DEVICE_576: + LD BC,$01F4 +GET_DEVICE_577: + CALL GET_DEVICE_580 + IN A,($BB) + AND $10 + XOR D + RET Z + DEC BC + LD A,C + OR B + JP NZ,GET_DEVICE_577 + DEC E + JP NZ,GET_DEVICE_576 + SCF + RET + +GET_DEVICE_578: + PUSH BC + CALL GET_DEVICE_574 + POP BC + RET C +GET_DEVICE_579: + CALL GET_DEVICE_580 + IN A,($D8) + AND $10 + JP Z,GET_DEVICE_579 + LD A,C + OUT ($C8),A + RET + +GET_DEVICE_580: + CALL BREAK + RET NC + EX (SP),HL + POP HL + RET + +GET_DEVICE_581: + CALL PRINT_LINE7 + JP GET_DEVICE_583 +GET_DEVICE_582: + CALL $6F55 +GET_DEVICE_583: + LD HL,__MENU_03 + PUSH HL + LD A,$01 + LD ($FEC2),A + LD C,$04 + CALL GET_DEVICE_578 + RET C + XOR A + LD ($FEC2),A + CALL GET_DEVICE_587 + AND $3F + RET NZ + CALL GET_DEVICE_588 + LD DE,$0006 + RST CPDEHL + RET NZ + CALL GET_DEVICE_588 + RET C + EX DE,HL + CALL GET_DEVICE_588 + RET C + CALL GET_DEVICE_592 + RET C + CALL GET_DEVICE_588 + RET C + EX DE,HL + POP BC + LD A,$FF + LD ($FEC3),A + LD SP,HL + PUSH DE + LD DE,$0000 + PUSH DE + PUSH BC +GET_DEVICE_584: + LD C,$47 + CALL GET_DEVICE_578 + RET C + LD C,$04 + CALL GET_DEVICE_579 + RET C + CALL GET_DEVICE_587 + RET C + AND $3F + JP Z,GET_DEVICE_585 + CP $0E ; Line number prefix + RET NZ + POP HL + POP HL + RET + +GET_DEVICE_585: + EX DE,HL + CALL GET_DEVICE_588 + RET C + EX DE,HL +GET_DEVICE_586: + CALL GET_DEVICE_587 + LD (HL),A + INC HL + DEC DE + LD A,D + OR E + JP NZ,GET_DEVICE_586 + JP GET_DEVICE_584 + +GET_DEVICE_587: + CALL RV232C + RET Z + POP AF + SCF + RET + +GET_DEVICE_588: + CALL GET_DEVICE_587 + LD H,A + CALL GET_DEVICE_587 + LD L,A + RET + +GET_DEVICE_589: + CALL GET_DEVICE_565 + RET NZ + LD HL,$7712 + PUSH HL + LD C,$1B + CALL GET_DEVICE_567 + RET C + LD C,'*' + CALL GET_DEVICE_567 + RET C + CALL GET_DEVICE_591 + RET C + EX DE,HL + CALL GET_DEVICE_591 + RET C + CALL GET_DEVICE_592 + RET C + LD B,H + LD C,L + CALL GET_DEVICE_591 + RET C + LD A,$FF + LD ($FEC3),A + EX DE,HL + LD SP,HL + PUSH DE + LD DE,$0000 + PUSH DE + LD D,B + LD E,C +GET_DEVICE_590: + CALL GET_DEVICE_571 + RET C + LD (HL),C + INC HL + DEC DE + LD A,D + OR E + JP NZ,GET_DEVICE_590 + POP AF + RET + +GET_DEVICE_591: + PUSH BC + CALL GET_DEVICE_571 + LD H,C + POP BC + RET C + PUSH BC + CALL GET_DEVICE_571 + LD L,C + POP BC + RET + +GET_DEVICE_592: + PUSH HL + LD HL,(PROGND) + LD BC,FNCTAB + ADD HL,BC + RST CPDEHL + POP HL + CCF + RET C + PUSH HL + PUSH DE + ADD HL,DE + EX DE,HL + LD HL,(HIMEM) + RST CPDEHL + POP DE + POP HL + RET + + NOP + +;$78B7 +FONT: + BINARY "FONT_L.BIN" + + +;$7A96 + +;00000000 +;00001000 +;00011100 +;00111110 +;01111111 + DEFB $00,$08,$1C,$3E,$7F,$00 + +;00100000 +;01110000 +;11111000 +;00100000 +;00111110 + DEFB $20,$70,$F8,$20,$3E,$00 + +;01010101 +;10101010 +;01010101 +;10101010 +;01010101 +;10101010 + DEFB $55,$AA,$55,$AA,$55,$AA + + + + +; Routine at 31401 +L7AA9: + NOP + NOP + LD B,H + LD A,A + LD B,L +GET_DEVICE_619: + LD B,L + JR NZ,GET_DEVICE_620 + AND A + AND L + PUSH HL + JR GET_DEVICE_632 + INC H + LD ($7924),HL + DEC A + LD B,D + LD B,D + LD B,D + DEC A + DEC A + LD B,B + LD B,B + LD B,B + DEC A + JR NZ,GET_DEVICE_630 + LD D,H + LD D,L + LD A,B +GET_DEVICE_620: + JR C,GET_DEVICE_628 + LD B,H + LD B,L + JR C,GET_DEVICE_626 + LD B,C + LD B,B + LD A,L + LD B,B + LD A,(HL) + DEC H + DEC H + DEC H + LD A,(DE) +GET_DEVICE_621: + DEC E + JP M,GET_DEVICE_622 + LD B,$20 +GET_DEVICE_622: + LD A,C + CP ' ' + JP NC,GET_DEVICE_623 + ADD A,$80 + ADD A,B + RET +GET_DEVICE_623: + XOR A + RET +GET_DEVICE_624: + LD A,(KYHOW) + RLCA + JP NC,GET_DEVICE_625 + LD BC,$0009 + ADD HL,BC + RLCA + JP NC,GET_DEVICE_625 + ADD HL,BC +GET_DEVICE_625: + LD A,(HL) + SCF + JP __MENU_82 + INC BC + JR NZ,GET_DEVICE_633 + INC A + DEC A + LD E,E + LD E,H + LD E,L + LD E,(HL) + LD H,H + JR NZ,GET_DEVICE_634 +GET_DEVICE_626: + INC A + DEC A + LD E,E + LD E,H +GET_DEVICE_627: + LD E,L +GET_DEVICE_628: + LD E,(HL) + INC BC + LD H,L + LD H,(HL) + LD H,A + LD L,B + LD L,C + LD L,D + LD L,E + LD L,H +GET_DEVICE_629: + LD C,A +GET_DEVICE_630: + CP $61 + RET C + LD A,(KYHOW) + AND $40 + LD A,C + JP NZ,GET_DEVICE_631 + CP $7B + RET NC + AND $5F + RET +GET_DEVICE_631: + CP $7E +GET_DEVICE_632: + RET NC + AND $5F + RET + LD B,H + JR NZ,GET_DEVICE_634 + RRCA + EX AF,AF' + RLCA + LD B,L + DEC H + RRA + LD A,(BC) +GET_DEVICE_633: + LD C,D + LD A,$09 + EX AF,AF' + RLCA + NOP + LD B,A + JR NZ,GET_DEVICE_636 +GET_DEVICE_634: + INC B + LD B,L + DEC A + DEC B + INC B + NOP + LD A,A + INC B + EX AF,AF' + DJNZ GET_DEVICE_635 + LD B,D + CCF +GET_DEVICE_635: + LD (BC),A + LD (BC),A + LD B,B + LD B,D + LD B,D + LD B,D + LD B,B + LD C,D + LD HL,($2A12) + LD B,(HL) + LD (DE),A + LD (DE),A + LD A,E + LD A,(BC) + LD D,$40 +GET_DEVICE_636: + JR NZ,$7B77 + EX AF,AF' + RLCA + LD B,B + INC A + LD BC,$7C02 + CCF + LD B,H + LD B,H + LD B,H + LD B,H + LD BC,$2141 + LD DE,$040F + LD (BC),A + LD BC,$3C02 + LD ($7F02),A + LD (BC),A + LD ($1202),A + LD ($0E52),HL + LD HL,$2525 + LD HL,$7840 + LD B,H + LD B,D + LD D,C + LD H,B + LD B,B + JR Z,GET_DEVICE_638 + JR Z,GET_DEVICE_637 + INC B + DEC B + CCF + LD B,L + LD B,L + LD (BC),A + LD A,A +GET_DEVICE_637: + LD (BC),A + LD (DE),A + LD C,$40 + LD B,D + LD B,D + LD A,(HL) +GET_DEVICE_638: + LD B,B + LD C,D + LD C,D + LD C,D + LD C,D + LD A,(HL) + INC B + DEC B + LD B,L + DEC H + INC E + NOP + RRA + LD B,B + JR NZ,GET_DEVICE_640 + LD B,B + LD A,$00 + LD A,A + JR NZ,GET_DEVICE_639 +GET_DEVICE_639: + LD A,A + LD B,B + JR NZ,GET_DEVICE_641 + LD A,(HL) + LD B,D + LD B,D + LD B,D + LD A,(HL) + RLCA + LD BC,$2141 + RRA + LD B,D + LD B,D + LD B,B + JR NZ,GET_DEVICE_642 + LD BC,$0002 + LD BC,$0202 +GET_DEVICE_640: + DEC B + DEC B + LD (BC),A +GET_DEVICE_641: + NOP + NOP + EX AF,AF' + INC E + LD A,$7F + NOP + JR NZ,GET_DEVICE_646 + RET M + JR NZ,GET_DEVICE_643 + NOP + LD D,L + XOR D +GET_DEVICE_642: + LD D,L + XOR D + LD D,L + XOR D + LD A,D + LD A,B + LD H,E + HALT + LD H,D + LD L,(HL) + LD L,L + LD L,H + LD H,C + LD (HL),E + LD H,H + LD H,(HL) + LD H,A + LD L,B + LD L,D + LD L,E + LD (HL),C + LD (HL),A + LD H,L + LD (HL),D + LD (HL),H + LD A,C + LD (HL),L + LD L,C + LD L,A + LD (HL),B + LD B,B + LD E,H + INC L + LD L,$2F + LD E,L + LD SP,$3332 + INC (HL) + DEC (HL) + LD (HL),$37 + JR C,GET_DEVICE_645 + JR NC,GET_DEVICE_646 + LD A,($5B2D) + LD E,(HL) + LD A,H + INC A + LD A,$3F + LD A,L + LD HL,$2322 +GET_DEVICE_643: + INC H + DEC H + LD H,$27 + JR Z,GET_DEVICE_646 + LD E,A + DEC HL + LD HL,(GET_DEVICE_633) + JR NZ,GET_DEVICE_644 + EX AF,AF' + LD E,$1F + DEC E + INC E + ADD HL,BC + DEC DE + DEC C + RET P + POP AF + JP P,TEL_TERM_014 + NOP + NOP + INC BC + JR NZ,$7C39 +GET_DEVICE_644: + LD A,A + INC D + LD (BC),A + LD BC,$0906 + DEC DE + DEC C + PUSH AF + OR $F7 + RET M +GET_DEVICE_645: + LD SP,HL + NOP + NOP + INC BC +GET_DEVICE_646: + LD A,C + LD A,B + LD H,E + HALT + LD H,D + LD L,(HL) + LD L,L + LD L,H + LD H,C + LD (HL),E + LD H,H + LD H,(HL) + LD H,A + LD L,B + LD L,D + LD L,E + LD (HL),C + LD (HL),A + LD H,L + LD (HL),D + LD (HL),H + LD A,D + LD (HL),L + LD L,C + LD L,A + LD (HL),B + LD A,L + INC HL + INC L + LD L,$2D + DEC HL + LD SP,$3332 + INC (HL) + DEC (HL) + LD (HL),$37 + JR C,GET_DEVICE_648 + JR NC,$7CF6 + LD A,E + LD A,(HL) + INC A + LD E,L + LD E,(HL) + DEC SP + LD A,($2A27) + LD HL,$4022 + INC H + DEC H + LD H,$2F + JR Z,GET_DEVICE_649 + DEC A + LD E,H + LD E,E + CCF + LD A,$00 + NOP + NOP + + +; Boot routine +; +; Used by the routine at $0000. +BOOT: + DI + LD SP,ALT_LCD + LD HL,30000 ; delay +BOOT_DELAY: + DEC HL + LD A,H + OR L + JP NZ,BOOT_DELAY + IN A,($D8) + AND A + JP P,BOOT_DELAY + LD A,$43 + OUT ($B8),A + LD A,$EC + OUT ($BA),A + LD A,$FF +GET_DEVICE_648: + OUT ($B9),A ; I/O port select + IN A,($E8) +GET_DEVICE_649: + AND $03 + LD A,$ED + OUT ($BA),A + JP Z,BOOT_4 + LD HL,(MAXRAM) + LD DE,$8A4D + RST CPDEHL + JP NZ,BOOT_4 + IN A,($A0) + AND $0C + JP NZ,GET_DEVICE_650 + LD A,($F3DB) + AND A + JP Z,GET_DEVICE_650 + LD DE,$7CDC + JP __MENU_186 + JP Z,GET_DEVICE_650 + XOR A + OUT ($A1),A ; LCD address + LD ($F3DB),A + +GET_DEVICE_650: + LD A,($F9B1) + LD D,A + CALL TEST_FREEMEM + CP D + JP NZ,BOOT_4 + CALL EXTROM_TST + LD A,$00 + JP NZ,BOOT_1 + DEC A +BOOT_1: + LD HL,OPTROM + CP (HL) + JP NZ,BOOT_4 + LD HL,(ATIDSV) + EX DE,HL + LD HL,$0000 + LD (ATIDSV),HL + LD HL,$9C0B ; POWER ON data marker + RST CPDEHL + JP NZ,BOOT_2 + LD HL,($F9AE) + LD SP,HL + CALL BOOT_VECT + CALL L7D6F + LD HL,(SAVSP) + PUSH HL + LD HL,(MENU_FLG) + LD A,L + AND A + JP Z,GET_DEVICE_652 + LD A,H + AND A + JP Z,GET_DEVICE_654 +GET_DEVICE_652: + LD HL,$FEC3 + XOR A + CP (HL) + LD (HL),A + JP NZ,GET_DEVICE_654 + LD A,($F3E4) + AND A + JP NZ,GET_DEVICE_655 + CALL CURSOFF9 + POP HL + LD A,H + AND A + JP Z,POPALL + LD SP,HL + JP SET_CLOCK_HL_15 + +BOOT_2: + LD A,(ERRTRP-1) + AND A + JP Z,GET_DEVICE_654 + CALL L7D6F + CALL STKINI + CALL CURSOFF9 + JP GET_DEVICE_214 + +GET_DEVICE_654: + INC A + LD (FSTFLG),A ; Set to 1 to indicate this is a power-up condition. +GET_DEVICE_655: + LD HL,(STKTOP) + LD SP,HL + CALL BOOT_VECT + CALL _CLREG_1 + LD HL,__MENU + PUSH HL + + DEFB $F6 ; OR $AF + +L7D6F: + XOR A + CALL IOINIT +; Routine at 32111 +; +; Used by the routine at L7426. + XOR A + LD (POWR_FLAG),A + LD A,($FE43) + CP $03 + RET NZ + LD HL,$F406 + JP GETWORD_91 + +BOOT_4: + LD SP,STACK_INIT + CALL TEST_FREEMEM + LD B,$E1 + LD DE,MAXRAM + LD HL,SYSVARS_ROM + CALL LDIR_B + CALL INIT_HOOKS + LD A,$0C + LD (TIMCN2),A + LD A,$64 + LD (TIMINT),A + LD HL,FNKTAB + CALL STFNK + CALL DWNLDR_47 + LD B,$42 + LD DE,$6C8E + LD HL,DIRECTORY + CALL REV_LDIR_B + LD B,$E7 + CALL ZERO_MEM + LD (HL),$FF + CALL EXTROM_TST + JP NZ,BOOT_6 + DEC A + LD (OPTROM),A + LD HL,USRDIR + LD (HL),$F0 + INC HL + INC HL + INC HL + LD DE,$F993 + LD B,$06 + CALL REV_LDIR_B + LD (HL),' ' + INC HL + LD (HL),B +BOOT_6: + XOR A + LD (ENDBUF),A + LD (NLONLY),A + LD (TMOFLG),A + LD A,':' + LD (BUFFER),A + LD HL,PRMSTK + LD (PRMPRV),HL + LD (STKTOP),HL + LD BC,$0100 + ADD HL,BC + LD (MEMSIZ),HL + LD A,$01 + LD (PROGND+1),A + CALL __MAX_0 + CALL _CLREG_1 + LD HL,(RAM) + XOR A + LD (HL),A + INC HL + LD (BASTXT),HL + LD (SUZUKI),HL + LD (HL),A + INC HL + LD (HL),A + INC HL + LD (DO_FILES),HL + LD (HAYASHI),HL ; Paste buffer file + LD (HL),$1A ; EOF + INC HL + LD (CO_FILES),HL + LD (PROGND),HL + LD HL,SUZUKI-1 + LD (DIRPNT),HL + CALL CLRPTR + CALL INITIO + LD HL,$3833 + LD ($F83C),HL + LD HL,$7EA1 + CALL $735A + JP __MENU + +PRINT_COPYRIGHT: + LD HL,PROMPT_MSG + CALL PRS + CALL CONSOLE_CRLF + RST $38 + LD E,B + CALL FREEMEM + LD HL,BYTES_MSG + JP PRS + +FREEMEM: + LD HL,(PROGND) + EX DE,HL + LD HL,(STKTOP) + LD A,L + SUB E + LD L,A + LD A,H + SBC A,D + LD H,A + LD BC,$FFF2 + ADD HL,BC + JP NUMPRT + +INIT_HOOKS: + LD HL,RST38_VECT + LD BC,$2F02 ; B=47, C=2 + LD DE,NULSUB +__MENU_181: + LD (HL),E + INC HL + LD (HL),D + INC HL + DEC B + JP NZ,__MENU_181 + LD B,$1B + LD DE,FCERR + DEC C + JP NZ,__MENU_181 + RET +TEST_FREEMEM: + LD HL,$C000 +__MENU_183: + LD A,(HL) + CPL + LD (HL),A + CP (HL) + CPL + LD (HL),A + LD A,H + JP NZ,__MENU_184 + INC L + JP NZ,__MENU_183 + SUB $20 + LD H,A + JP M,__MENU_183 +__MENU_184: + LD L,$00 + ADD A,$20 + LD H,A + LD (RAM),HL + RET + NOP + NOP + NOP + NOP + NOP + NOP + LD BC,$0000 + LD BC,$DBF3 + AND B +__MENU_185: + ADD A,$04 + AND $0C + CP $04 + JP Z,__MENU_185 + LD DE,$7EBD + JP __MENU_186 + JP NZ,$7EAB + IN A,($A0) + LD C,A + XOR A + OUT ($A1),A ; LCD address + LD A,C + LD ($F3DB),A + OUT ($A1),A ; LCD address + JP $0000 +__MENU_186: + OUT ($A1),A ; LCD address + LD HL,$E000 +__MENU_187: + LD A,(HL) + CPL + LD (HL),A + CP (HL) + CPL + LD (HL),A + JP NZ,__MENU_188 + INC L + JP NZ,__MENU_187 +__MENU_188: + EX DE,HL + JP (HL) +; This entry point is used by the routine at GETWORD. +__MENU_189: + JP NC,SNERR + LD B,$00 + AND $0F + LD D,A + OR $37 + IN A,($A0) + LD C,A + LD A,B + OUT ($A1),A ; LCD address + JP C,__MENU_190 + LD (HL),D +__MENU_190: + LD D,(HL) + LD A,C + OUT ($A1),A ; LCD address + RET + +__MAX: + RST SYNCHR ; Check syntax: next byte holds the byte to be found + CALL GET_DEVICE_695 + CALL GETINT + JP NZ,SNERR + CP $10 + JP NC,FCERR + LD (TEMP),HL + PUSH AF + CALL CLSALL ; Close all files + POP AF + CALL __MAX_0 + CALL _CLREG + JP EXEC_EVAL_0 + +; This entry point is used by the routine at CHKSTK. +__MAX_0: + PUSH AF + LD HL,(HIMEM) + LD DE,$FEF5 +__MAX_1: + ADD HL,DE + DEC A + JP P,__MAX_1 + EX DE,HL + LD HL,(STKTOP) + LD B,H + LD C,L + LD HL,(MEMSIZ) + LD A,L + SUB C + LD L,A + LD A,H + SBC A,B + LD H,A + POP AF + PUSH HL + PUSH AF + LD BC,$008C + ADD HL,BC + LD B,H + LD C,L + LD HL,(PROGND) + ADD HL,BC + RST CPDEHL + JP NC,OMERR + POP AF + LD (MAXFIL),A + LD L,E + LD H,D + LD (FILTAB),HL + DEC HL + DEC HL + LD (MEMSIZ),HL + POP BC + LD A,L + SUB C + LD L,A + LD A,H + SBC A,B + LD H,A + LD (STKTOP),HL + DEC HL + DEC HL + POP BC + LD SP,HL + PUSH BC + LD A,(MAXFIL) + LD L,A + INC L + LD H,$00 + ADD HL,HL + ADD HL,DE + EX DE,HL + PUSH DE + LD BC,$0109 ; 265 +__MAX_2: + LD (HL),E + INC HL + LD (HL),D + INC HL + EX DE,HL + LD (HL),$00 + ADD HL,BC + EX DE,HL + DEC A + JP P,__MAX_2 + POP HL + LD BC,$0009 + ADD HL,BC + LD (FILTAB+4),HL + RET + + +; Message at 32649 +BYTES_MSG: + DEFM " Bytes free" + DEFB $00 + +; Message at 32661 +PROMPT_MSG: + DEFM "NEC PC-8201 BASIC Ver 1.0 (C) Microsoft " + DEFB $00 + +; This entry point is used by the routine at GETYPR. +_RST38H: + EX (SP),HL + PUSH AF + LD A,(HL) + LD (RST38_OFFS),A + POP AF + INC HL + EX (SP),HL + PUSH HL + PUSH BC + PUSH AF + LD HL,RST38_VECT + LD A,(RST38_OFFS) + LD C,A + LD B,$00 + ADD HL,BC + LD A,(HL) + INC HL + LD H,(HL) + LD L,A + POP AF + POP BC + EX (SP),HL +; Routine at 32731 +NULSUB: + RET + +; This entry point is used by the routine at ISFLIO. +__MENU_199: + LD A,(NO_SCROLL) + AND A + RET Z + JP HOME31 + +_CLREG_1: + XOR A + LD (LPT_POS),A + JP _CLREG_1 + +CALLHL1: + LD B,$00 +CALLHL2: + IN A,($BB) + AND $04 + RET Z + DEC B + JP NZ,CALLHL2 + DEC C +CALLHL3: + JP NZ,CALLHL1 + RET + + EX DE,HL + LD A,A + JP PRS_ABORTMSG9 + diff --git a/tests/restricted/marlinziod.asm b/tests/restricted/marlinziod.asm new file mode 100644 index 00000000..1133a16c --- /dev/null +++ b/tests/restricted/marlinziod.asm @@ -0,0 +1,1347 @@ +; written by KarlHeinz.Mau@t-online.de 1996, last modified August 22nd, 1998 +; +; This program communicates with Commodore 15xx floppy disk drive running +; on Sharp MZ700-series homecomputers. +; +; The following commands are implemented: +; +; "L" Load a file from 15xx. The load address is modifiable, the program +; displays the address where it was stored. You can use or modify this +; address. First you have to specify the name of the file to load. +; +; "S" Save a file to 15xx. You have to know the begin/end address for save +; and you have to specify the name of the file to save. The name of +; the file must not exceed 16 characters in length. +; +; "V" Verifies a stored file. +; +; "C" You can input and send any command decsribed in handbooks for 15xx to +; the drive. +; +; "F" Reads and displays the error message channel of the floppy drive. +; +; "D" Loads the directory to main storage at location 6bcfh and displays the +; directory. +; Note, loaded directory overwrites the basic program area, like +; the C64 does. +; +; "I" Outputs directory to printer. +; +; "P" Outputs directory to plotter. +; + + + CPU Z80 + org 0a000h ; A000h Entrypoint MZ700 + jp start ; jump around definitions + +; MZ7xx-Characterset conversion + CHARSET 'a',0a1h + CHARSET 'b',09ah + CHARSET 'c',09fh + CHARSET 'd',09ch + CHARSET 'e',092h + CHARSET 'f',0aah + CHARSET 'g',097h + CHARSET 'h',098h + CHARSET 'i',0a6h + CHARSET 'j',0afh + CHARSET 'k',0a9h + CHARSET 'l',0b8h + CHARSET 'm',0b3h + CHARSET 'n',0b0h + CHARSET 'o',0b7h + CHARSET 'p',09eh + CHARSET 'q',0a0h + CHARSET 'r',09dh + CHARSET 's',0a4h + CHARSET 't',096h + CHARSET 'u',0a5h + CHARSET 'v',0abh + CHARSET 'w',0a3h + CHARSET 'x',09bh + CHARSET 'y',0bdh + CHARSET 'z',0a2h + CHARSET 'ä',0bbh + CHARSET 'ö',0bah + CHARSET 'ü',0adh + CHARSET 'ß',0aeh + CHARSET 'Ä',0b9h + CHARSET 'Ö',0a8h + CHARSET 'Ü',0b2h + +; Monitor-ROM-entries +GETL: equ 0003h ; get input line to (de) +LETNL: equ 0006h ; set cursor to next line +PRNT: equ 0012h ; print character in accu +MSG: equ 0015h ; print character string from (de) +ST1: equ 00adh ; entry of Monitor-ROM +LPRNT: equ 018fh ; 1 Char. plot +PRTHL: equ 03bah ; ascii print for hl +PRTHX: equ 03c3h ; ascii print for accu +HLHEX: equ 0410h ; compute 4 ascii to hl +KEY: equ 09b3h ; waits for any key (accu=displ.code) +SWEP: equ 0a50h ; checks for any key pressed +DACN: equ 0bceh ; converts display-code to ascii +dacn10: equ 0bd4h ; conversion routine +DSP: equ 0db5h ; prints display-code from accu +DSPXY: equ 1171h ; 1171 curr. column, 1172 curr. row +BasStrt: equ 6bcfh ; Start adress Basic-program area +screen: equ 0d000h ; start of screen area +le000: equ 0e000h ; 8255 Port A +le001: equ 0e001h ; 8255 Port B +le008: equ 0e008h ; LS367 + +; constants + +lf: equ 0ah ; line feed + autom. cr for printer +cr: equ 0dh ; Carriage Return +cls: equ 16h ; Clear-Screen-Character +brk2: equ 1bh ; MZ-code break +spc: equ 20h ; space-/blank-character +brk1: equ 0CBh ; Keycode Break +cr2: equ 66h ; Keycode carriage return + +; Definitions, variables, switches +Prompt0: db "LSVCDIPF : \r" ; \r = 0Dh = Stringend +Prompt1: db "Command : \r" +Prompt2: db "Load to : \r" +Prompt3: db "Begin : \r" +Prompt4: db "End : \r" +Prompt5: db "Filename : \r" +DEVNPRES: db "Device not present\r" +Break: db "Break\r" +veriferr: db "Verifying error\r" +saveerr: db "Save error\r" +loaderr: db "Load error\r" +searchfo: db "Searching for \r" +loading: db "Loading \r" +veryfing: db "Verifying \r" +saving: db "Saving \r" +filenfnd: db "File not found\r" +namemiss: db "Missing filename\r" + +PrtSw: db 0ffh ; 'P'=Plot, not 'P'=print +lc401: db 00h ; 00h=go back to monitor, + ; not 00h=goback to caller +stackptr: dw 0000h ; stack on entry to hardcopy routine +stckptr: dw 0000h ; stack pointer to return from errors + +; IEC-Definitions + +ST: db 40h ; (90h) means c64-zero-page, + ; Status word +LVFlag: db 00h ; (93h) 00=load, 01=verify, 02=save +iecflag: db 55h ; (94h) flag at IEC-output +IECBUF: db 00h ; (95h) 1 byte IEC-buffer for + ; received byte +sta: db 55h ; (a3h), IEC I/O-status +bitcnt: db 00h ; (a4h), IEC I/O-bit counter +EndPtr: dw 00cdh ; (aeh) current save-/load address +fileLen: db 0dh ; (b7h) length of file name +SecAdr: db 60h ; (b9h) secondary address +GerNr: db 08h ; (bah) device number (Floppy 8) +IOStrt: dw 0000h ; (c1h) start address +AdrLoad: dw 00c1h ; load address for file/directory +biostrt: dw 0200h ; save start address +asave: db 00h ; save for accu +hlsave: db 0000h ; save for hl +zwispei: db 0b5h ; save for received bit(s) +svsecadr: db 4eh ; save sec. address +ascwork: db "00000" ; workarea ascii-convertion + + NEWPAGE + +; Entrypoint + +start: ld de,Prompt0 ; (prompt0) + call inptproc + jp z,intbrk + call DACN ; convert display code to ascii + cp cr2 ; enter (cr) key pressed? + jp z,start ; yes, once more + ld (stckptr),sp ; save stackpointer for errors + cp 'C' ; C to put any command on floppydrive + jp z,cmdin ; yes, jump in + cp 'D' ; D to get directory on screen + jp z,start015 ; yes, jump in + cp 'F' ; F to get 15xx error message + jp z,GetErSta ; yes, jump in + cp 'L' ; L to load a file + jp z,Load ; yes, jump in + cp 'S' ; S to save a file + jp z,Save ; yes, jump in + cp 'V' ; V to verify a stored file + jp z,Verify ; yes, jump in + cp 'P' ; P to plot directory + jp nz,start020 ; no, try 'I' + ld a,40h ; set IRT bit + out (0feh),a ; IRT plotter (reset) + ld a,00h ; clr lines + out (0feh),a + ld a,'P' +start015: ld (PrtSw),a ; store to print marker + jp getdir ; continue + +start020: cp 'I' ; I to print directory? + jr nz,start ; no, error, once more + ld (PrtSw),a ; store to print marker +start030: IN A,(0FEh) + BIT 0,A ; busy? + JR Z,getdir ; not busy + OR 40h ; set IRT + OUT (0FEh),A ; reset printer + CALL lC719 ; test break key + JR NZ,start030 ; no, loop + jp intbrk ; yes, goback + +inptproc: call MSG ; print message (de) +inptp10: call KEy ; wait on any key. (display code) + cp brk1 ; break key pressed? + ret z ; yes, jump to break routine + cp 0c1h ; don't show keys (c1h-cdh)cc? + call c,DSP ; echo key to screen + push af ; save key code + call LETNL ; skip cursor to next line + pop af ; restore + and a ; no break (note: test space bar?) + ret + +; input for a 157xx-command that is to send to drive +cmdin: ld de,prompt1 ; address of prompt1 to de + call GetNam05 ; get command input line + jp z,intbrk ; jump if break key or cr key pressed + ld a,0fh ; command channel 0fh + ld (SecAdr),a ; store in + call IECOPEN ; open cmd channel and submit cmd + call IECCLOSE ; close cmd channel + call ErrorChk ; check for errors + jp GetErSta ; all done, displ. error msg channel + + +; Load and display directory + +GetDir: xor a ; 00=Load directory + ld (LVFlag),a + inc a ; 00+01 + ld (fileLen),a ; "$" is length of 1 + ld a,'$' ; $ is 157xx command to load directory + ld (fileName+11),a ; $ to the command line + ld hl,BasStrt ; area to store the directory info + ld (AdrLoad),hl ; save adress for load routine + xor A + LD (SecAdr),a ; dir load transfer on channel 0 + call IECLOAD ; exec load routine + call ErrorChk ; check for errors + jp c,intbrk ; stop at brk + ld de,BasStrt ; address of directory info in main +DirPrt05: ld a,cls ; first clear the screen + call prnt ; do it +DirPrt10: inc de ; skip around two 01h + inc de + ex de,hl + ld e,(hl) ; load # of blocks to de + inc hl + ld d,(hl) + inc hl + ex de,hl ; now to hl for hltoasc + call HLtoASC ; print # blocks +DirPrt20: ld a,(de) ; check for line end + and a + jr z,DirPrt40 ; yes, line end reached + cp spc ; check for C64 reverse on 12h and + jr nc,DirPrt30 ; other non displayable codes + ld a,spc ; yes, force them to space +DirPrt30: call prnt ; Display character + inc de ; next char form dir + jr DirPrt20 ; continue at this line + +DirPrt40: inc de + ld A,(de) ; check end of directory + and a ; (2nd 00h means end of dir) + jr nz,dirprt50 ; no, continue + ld a,(prtsw) ; yes, process end of dir now + cp 'D' ; screen only? + jr nz,dirprt45 ; no, output too +dirprt43: call letnl ; set cursor to next line on screen + jp start ; goback + +dirprt45: ld a,0ffh ; lc692 uses ret command and not jump + ld (lc401),a ; to monitor for returning + call lc692 ; print/plot + jp z,intbrk + call lc713 ; new line char printer/plotter + jp z,intbrk ; stop at brk condition + jr dirprt43 ; go endprocess + +dirprt50: ld a,(DSPXY+1) ; get row number from systemarea + cp 24 ; screen full? + jr nz,DirPrt60 ; no, do new line on screen + ld a,(prtsw) + cp 'D' ; dir to screen only? + jr z,dirprt55 ; yes + ld a,0ffh ; no, force return of lc692 to me + ld (lc401),a ; and not to monitor + call lc692 ; hardcopy screen + jp z,intbrk ; brk condition during hardcopy + jr dirprt05 ; cls, next screen + +dirprt55: call WaitKey ; yes, wait on any key + jp z,intbrk ; break key stops process + jr DirPrt05 ; do next line after clear screen + +DirPrt60: call LETNL ; set cursor to new line + jr DirPrt10 ; and continue process + +; Get and display message from drive + +GetErSta: xor A + LD (ST),a ; clear status byte + ld a,(GerNr) ; set device number + call SentTalk ; force device to init talk + ld a,6fh + call SentSAdr ; init device with parameters +GetSta10: call IECIN ; get 1 character from device + push af ; save gotten character + ld a,(ST) ; check device status + and a + jr z,GetSta20 ; ok, continue + call letnl ; CR/new line + ld a,(st) + cp 0c2h ; device not present status + jp z,f707 ; stop on error + pop af ; end, restore accu + jp start ; done + +GetSta20: pop af ; restore gotten character + call PRNT ; no, print the character on screen + jr GetSta10 ; and continue + +; Load file + +Load: call GetNam ; input file name + jp z,intbrk ; stop if break or cr + jp c,load ; again on any input error + xor a + ld (LVFlag),a ; 00h=Load + ld a,0c9h ; at first get old address to store + ld (MdfCmd02),a ; so read first two bytes only + call IECLOAD ; do incomplete load first + call F528 ; untalk and close file + call ErrorChk ; check for error + ld a,3ah ; remodify load routine + ld (MdfCmd02),a ; for complete work again + jp c,GetErSta ; get error msg on error + ld a,(ST) ; same on incorrect device status + and a + jp nz,GetErSta +Load20: ld de,Prompt2 ; set de to address of prompt2 + call MSG ; and print prompt2 + ld hl,(EndPtr) ; get old store address to hl + call PRTHL ; and print old store address + ld de,BUFL ; set address of input buffer + call GETL ; get input line (store address) + ld a,(de) + cp brk2 ; break? + jp z,intbrk ; yes, stop + ld de,BUFL+11 ; address of input + call HLHEX ; translate ascii-hex to hl + jr c,Load20 ; no hex data, once more + ld (AdrLoad),hl ; ok, save store address + xor a + ld (secadr),a ; means load to (adrload) + jr Verify10 ; jump around verify, load 00 to accu + +; verify saved file + +Verify: ld a,01h ; 01=verify + db 21h ; dummy instruction ld hl,3e00h +verify10: ld a,00h ; 00=load + ld (LVFlag),a ; store + call IECLOAD ; load file + call ErrorChk ; check for error + jp GetErSta ; print error/ok message + +; Save file + +Save: call GetNam ; get data set name + jp z,intbrk ; stop on brk key + jr c,save ; on error again +Save10: ld de,Prompt3 + call MSG ; display prompt3 + ld de,BUFL + call GETL ; get input to bufl (start address) + ld a,(de) ; check for brk + cp brk2 + jp z,intbrk ; stop + ld de,BUFL+11 ; 1st input char + ld a,(de) + cp cr ; if no input again + jr z,Save10 + call HLHEX ; ascii to hex in hl + jr c,Save10 ; if not hex again + ld (IOStrt),hl ; store in start address +Save20: ld de,Prompt4 + call MSG ; display prompt4 + ld de,BUFL + call GETL ; get input to bufl (end address) + ld a,(de) + cp brk2 ; check for brk key + jp z,intbrk ; stop on brk + ld de,BUFL+11 + ld a,(de) ; get 1st input char + cp cr ; check for no input + jr z,Save20 ; if cr only again + call HLHEX ; ascii to hex and put it to hl + jr c,Save20 ; on hex-error again + ld (EndPtr),hl ; save end address + ld a,02h + ld (LVFlag),a ; 02 means iecstor has to save data + call IECSTORE ; exec save on disk + call ErrorChk ; test for errors + jp GetErSta ; display floppy status message + +; get file or other input to fileNAME + +GetNam: ld de,Prompt5 ; Address of prompt5 to de +GetNam05: call MSG ; put prompt5 on screen + ld de,fileName ; address of input area + call GETL ; get input from keyboard + call LETNL ; set cursor to new line + ld a,(filename) ; get 1st char from input + cp brk2 ; break? + ret z ; yes, goback + ld de,filename+11 + ld a,(de) ; get 1st char from input line + cp cr ; test for cr + ret z ; goback if no further input + ld b,01h ; init length of name +GetNam10: cp cr ; end of name? + jr z,GetNam20 ; yes, stop testing and counting + cp spc ; valid name must be in the range of + ret c ; 20h and 5fh + cp 5fh + ccf ; carry is set if not + ret c + inc b ; count length + inc de ; next byte address of name + ld a,(de) ; get next byte of input + jr GetNam10 ; continue + +GetNam20: ld a,b ; length to accu + dec a ; adjust to correct length in accu + ld (fileLen),a ; save length + cp 17 ; must not exceed 16 chars in length + ccf ; carry means wrong length + inc a + dec a + ret ; goback to caller + +; the following code is yet sleeping, +; it's for dir cmd if basic is active. The coding is under test. +; sets pointers of basic like cmd NEW does, but dir is still stored in +; basic's program area. +; +; another code is in progress for save and load, if basic is active +; and the user wants to save or load a basic program. +; +;bas: ld hl,(6abfh) +; ld a,6bh +; cp h +; ret nz +; ld a,0cfh +; ret nz +; ld hl,(endptr) +; ld (6ab3h),hl +; call 224eh +; ret +; +;startxx: call bas +; jp getdir + + +; if accu=f0h (display code for space) then accu=space + +lC674: CP 0F0h ; display code f0h? (space) + RET NZ ; no + AND 20h ; yes, put space + RET ; goback + +; test shift-break + +lC686: LD A,0F8h ; column brk/ctrl/shift + LD (lE000),A ; Port A 8255 send keyboard f8h + NOP ; wait 1 nop + LD A,(lE001) ; Port B 8255 receive keyboard data + CP 7Eh ; shift + brk ? + RET ; goback + +; hardcopy entry + +lc692: push bc ; save caller's regs + push de + push hl + ld (stackptr),sp ; + LD HL,screen ; address to screen area + PUSH HL ; save for futher use +lC6C4: POP HL ; addr. of current row in screen + PUSH HL ; back for further use + LD B,40 ; init loop counter (40 columns/row) + LD D,00h + LD E,B ; DE is displacement to next row + ADD HL,DE ; HL is address to next row on screen + LD A,0D4h ; check for last row (starts at + CP H ; address d410h) + JR NZ,lC6D6 ; not last + LD A,10h + CP L + JR nZ,lC6d6 ; not last + and a ; accu is 10h, 'and a' sets NZ=no brk + JR lC72Cn ; goback + +lC6D6: POP DE ; exchange entries on stack + PUSH HL ; contains address of next row + PUSH DE ; contains address of current row +lC6D9: DEC HL ; skip backwards subsequent spaces + LD A,(HL) ; get char + OR A ; space? + JR NZ,lC6E3 ; no, start outputting, notice, +; b-reg contains # of char to output + DJNZ lC6D9 ; yes,skip space + POP HL ; full space line rebuild stack + JR lC6C4 ; process next row + +lC6E3: POP HL ; curr. column address in curr. row +lc6e7: SET 3,H ; address to screen color + LD A,17h ; color of char blue, backgrd. white + LD (HL),A ; set to invert value + RES 3,H ; address back to the char. screen + LD A,(HL) ; get char to output + CALL lC78E ; convert displ. code to ascii + OR A ; 00h? + JR NZ,lC6FC ; no + OR 20h ; yes, force space on output +lC6FC: CALL lC75B ; output 1 char + jp z,lc72c ; brk condition occured + SET 3,H ; address to screen color + LD A,71h ; color of char white, backgrd. blue + LD (HL),A ; reset to normal value + RES 3,H ; address back to the char. screen + INC HL ; next char + DJNZ lC6E7 ; loop if length(contents of row)>0 + call lc713 ; set pen to next line + jp z,lc72cn ; brk condition occured + JR lC6C4 ; loop for next row + +; skip to new line (for both, printer/plotter) + +lc713: ld a,(prtsw) ; + cp 'P' ; plotter? + ld a,cr ; cr for plotter + jr z,lc715 ; yes, do cr + ld a,lf ; no, lf for printer +lc715: call lc75b ; output cr or lf + ret + +; goes back to monitor, if brk key used and started from monitor +; else returns if brk key used and called by program +lC719: CALL lC686 ; test brk key + RET NZ ; no, continue +lC71D: CALL lC686 ; test again and + JR Z,lC71D ; wait until unpressed + xor a ; zero flag indicates break + ret + +lc72c: SET 3,H ; address to screen color + LD A,71h ; color of char white, backgrd. blue + LD (HL),A ; reset to normal value, may be inv. + xor a ; set zflag (brk condition) +lC72Cn: push af ; save zero flag (z=brk, nz=no brk) + LD A,(lC401) ; 0 means jumped into program by mon. + AND A ; >0 means called by any program + JP z,intrpt ; goback to monitor + XOR A ; prepare next execution parameters + LD (lC401),A + pop af ; notice zflag to caller + ld sp,(stackptr) + pop hl ; restore caller's reg's + POP DE + POP BC + ret ; goback to caller + +; plot 1 character + +lC73B: PUSH BC ; save callers reg + LD C,00h ; 00h=ready + LD B,A ; save + CALL lC753 ; wait on ready + jr z,lc738bn ; stop on brk + LD A,B ; restore char to plot + OUT (0FFh),A ; data to plotter + LD A,80h ; RDP (strobe) high + OUT (0FEh),A ; to plotter + LD C,01h ; RDA test + CALL lC753 ; wait (ack) + jr z,lc738bn ; stop on brk + XOR A + OUT (0FEh),A ; RDP low + cpl + and a ; NZ=no brk +lc738bn: POP BC ; restore callers reg + RET ; goback to caller + +lC753: IN A,(0FEh) + AND 00Dh ; RDA only + CP C ; test busy + jr nZ,lc753n ; not busy +lc753v: cpl ; ffh/feh + and a ; indicate no break (NZ) + ret + +lc753n: call lc719 ; test break key + JR nz,lC753 ; wait on ready + ret ; zflag=brk condition + +; outputs 1 character to plotter if (lc3fc) = "P" +; else to printer + +lC75B: LD C,A ; save char to output + LD A,(prtsw) ; get user's input char + CP 'P' ; "P"? + LD A,C ; get back char to output + JR Z,lC73B ; yes, go plot 1 char +lC764: IN A,(0FEh) ; get state of printer + BIT 0,A ; busy? + JR Z,lC772 ; no, continue + CALL lC719 ; yes, busy, brk key? + JR NZ,lC764 ; no. Wait on ready + Ret ; goback with brk condition + +; print 1 char + +lC772: LD A,C ; get back char to print + OUT (0FFh),A ; data out + IN A,(0FEh) ; get state of printer + AND 7Fh ; set strobe + OUT (0FEh),A ; put strobe + IN A,(0FEh) ; get state again + OR 80h ; reset strobe + OUT (0FEh),A ; put out +lC781: IN A,(0FEh) ; get state + BIT 0,A ; test busy + jr Z,lc753v ; not busy, goback to caller + CALL lC719 ; brk key? + JR NZ,lC781 ; no, wait on ready (printed) + Ret ; yes, goback, brk + +; display to ascii for printer or plotter + +lC78E: PUSH AF ; save char to output + LD A,(prtsw) ; users input char + CP 'P' ; "P" (plotter)? + JR NZ,lC79D ; no, printer + POP AF ; char to plot + CALL lC66B ; display to ascii (plotter) + JP lC674 + +; display to ascii conversion for plotter +; returns from monitor to caller + +lc66b: PUSH BC ; save own regs + PUSH HL + PUSH DE + LD HL,lC402 ; my translation table for plotter + JP dacn10 ; use monitor's conversion routine + + +lC79D: POP AF + CALL lC7A4 ; display to ascii conversion + JP lC674 ; if 0f0h conv. to spc, then goback + +; diplay to ascii conversion for printer + +lC7A4: PUSH BC ; save callers reg + PUSH HL + PUSH DE + LD HL,lC508 ; table display to ascii (printer) + LD C,A + LD B,00h ; bc is displacement into table + ADD HL,BC ; address to char + LD A,(HL) ; get translation char + CP 0F0h ; display code for space? + JR NZ,lC7B5 ; no, continue + AND 20h ; yes, translate to 20h +lC7B5: POP DE ; restore callers regs + POP HL + POP BC + RET ; goback to caller + +; compute contents of HL to decimal and print up to 5 +; chars without preceding nulls + +HLtoASC: push de ; save callers reg + ld bc,ascwork ; workarea for me + ld de,10000 ; 10 exp 4 + call hltoa30 ; 5th power of 10 + ld de,1000 ; 10 exp 3 + call hltoa30 ; 4th power of 10 + ld de,100 ; 10 exp 2 + call hltoa30 ; 3rd power of 10 + ld de,10 ; 10 exp 1 + call hltoa30 ; 2nd power of 10 + ld a,l ; + or '0' ; comp to decimal + ld (bc),a ; 10 exp 0 + ld de,ascwork + ld b,04h ; max. 4 preceding nulls to skip of 5 +hltoa10: ld a,(de) ; get printable dec. number + cp '0' ; check for dec. 0 + jr nz,hltoa20 ; no, go to print remaining numbers + inc de + djnz hltoa10 ; yes, skip preceding 0 +hltoa20: inc b ; adjust b +hltoa25: ld a,(de) ; get number (0-9) + call prnt ; print/plot number + inc de + djnz hltoa25 ; do next number + pop de ; end, restore callers reg + ret ; goback to caller + +hltoa30: ld a,0ffh ; init counter to ffh+1=00 +hltoa35: inc a ; count up + or a ; clear carry + sbc hl,de ; subtract until negative value + jr nc,hltoa35 ; value is positive + add hl,de ; make positive + or '0' ; make ascii + ld (bc),a ; store to workarea + inc bc ; next free address in workarea + ret ; goback to caller + +; wait on any key + +WaitKey: push bc ; save callers reg +waitK010: call SWEP ; keyboard swep + ld a,b ; any key? + and 0bfh ; turn off d6=shift, brk only + jr z,waitk010 ; no, wait + ld a,b + pop bc ; yes, ok, restore callers reg + cp 88h ; test brk key+shift + ret ; done + + +; ErrorChk: analyse errors and print dependent error message +; +; program logic: +; save af (contents of accu and carry flag) +; call errchk40 (prints err.msg load-/save-/verify-error first if any) +; restore af (contents of accu and carry on entry) +; if carry +; if a=0 (accu on entry) +; print "Break" +; endif +; endif +; +; +ErrorChk: push af ; save carry flag + call Errchk40 ; if carry output msg on error +errchk20: pop af ; get back contents of accu and carry + ret nc ; goback, done (no break) + and a + ret nz ; goback, if brk (accu=1bh) + ld de,break ; address to msg +errchk30: call msg ; print msg + call letnl + scf ; set carry (brk info) + ret ; goback + +; ErrChk40: print load/save/verify error msg +; program logic: +; if no carry +; turn off eof bit6 of st (set at time of eof, not at time of brk) +; if accu=0 +; return +; endif +; endif +; if lvflag=01h +; print "Verifying error" +; else if lvflag=02h +; print "Save error" +; else print "Load error" (lvflag=00h) +; endif +; endif +; +; +errchk40: jr c,errchk50 ; no eof + ld a,(ST) + and 0bfh ; turn off eof bit + ret z ; if eof bit only goback +errchk50: ld a,(LVFlag) ; get flag + cp 01h ; verify error? + jr nz,errchk60 ; no + ld de,veriferr ; yes, address to verify error msg +errchk55: call errchk30 ; print error msg + ret ; goback to caller + +errchk60: cp 02h ; save error? + jr nz,errchk70 ; no + ld de,saveerr ; address to save error msg + jr errchk55 ; go to print + +errchk70: ld de,loaderr ; address to load error msg + jr errchk55 ; go to print + + +; send Talk/Listen to floppy + +ed09: +Talk: +sentTalk: or 40h ; set talker bit + jr ed11 + +Listen: or 20h ; set listener bit +ed11: push af ; save for further process + ld a,(iecflag) ; + bit 7,a ; outputting end? (counter=0?) + jr z,ed20 ; yes + scf + ld a,(sta) + rra + ld (sta),a + call ed40 ; put byte on iec bus + ld a,(iecflag) + srl a ; turns off bit 7 + ld (iecflag),a + ld a,(sta) + srl a ; turns off bit 7 + ld (sta),a +ed20: pop af ; byte to put on iec bus + ld (iecbuf),a ; put command to iec buffer + call ee97 ; set data high + ld a,(le008) ; port LS367 + bit 3,a ; data low? + call z,ee85 ; yes, set clk high + ld a,(le000) ; 8255-port A + or 10h + ld (le000),a ; set atn low (8255-port A) +ed36: call ee8e ; set clk low (atn=clk=lo=listen) + call ee97 ; set data high + call eeb3 ; wait 1ms +ed40: call ee97 ; set data high + call eea9 ; get state of data line + jp c,edad ; error, data is high (no dev. pres.) + call ee85 ; data line low, set clk high + ld a,(sta) + bit 7,a ; floppy status + jr z,ed5a +ed50: call eea9 ; get state of data + jr nc,ed50 ; wait for data high +ed55: call eea9 ; get state of data line + jr c,ed55 ; wait for data low +ed5a: call eea9 ; get state of data + jr nc,ed5a ; wait for data high + call ee8e ; set clk low + ld a,08h + ld (bitcnt),a ; 8 bits +ed66: ld a,(le008) ; port LS367 + ld b,a + ld a,(le008) ; port LS367 + cp b + jr nz,ed66 ; wait for stable state of iec bus + bit 3,a + jr z,edb0 ; if data low, error (timeout) + ld a,(iecbuf) + rra + ld (iecbuf),a + jr c,dath ; buffer bit is on + call eea0 ; buffer bit is off, set data low + jr clkh + +dath: call ee97 ; set data high +clkh: call ee85 ; set clk hi (data bit ready) + call ee8e ; set clk low + call ee97 ; set data high + nop ; wait 4 nop's + nop + nop + nop + ld hl,bitcnt + dec (hl) ; bit count - 1 + jr nz,ed66 ; if not 8 bits sent process again + ld d,0fbh ; timer +ed9f: call eea9 ; get state of data line + bit 3,a + ret z ; if data low, goback + dec d ; timer - 1 + jr nz,ed9f + jr edb0 ; error, time out, no ack + +; set state to 80h/03h + +edad: ld a,80h ; status device not present + db 21h ; dummy instruction ld hl,3e03h +edb0: ld a,03h ; status time out +edb2: call fe1c ; set status + and a ; set/reset flags + jr ee03 ; jump in unlisten + +; send sec.address just behind sent of listen + +edb9: ld (iecbuf),a ; store sec.address + call ed36 ; put it on iec bus +edbe: ld a,(le000) ; 8255-port A + and 0efh + ld (le000),a ; set atn high + ret ; goback + +; send sec.address just behind sent of talk + +edc7: +sentsadr: ld (iecbuf),a ; store sec.address + call ed36 ; put it on iec bus + call eea0 ; set data low + call edbe ; set atn high + call ee85 ; set clk high +edd6: call eea9 ; get state of clk + bit 1,a ; test state of clk + jr z,edd6 ; wait on clk high + ret ; goback + +; IECOUT put 1 char on iec bus + +eddd: push af ; save char to put on iec bus + ld a,(iecflag) ; + bit 7,a + jr nz,ede6 + scf +; ld a,(iecflag) + rra + ld (iecflag),a + bit 7,a + jr nz,edeb +ede6: pop af ; get callers reg + push af ; save + call ed40 ; put byte out +edeb: pop af ; restore char to output to bus + ld (iecbuf),a ; store in iec buffer + and a ; reset carry + ret ; goback + +; send untalk + +edef: call ee8e ; set clk low + ld a,(le000) ; 8255-port A + or 10h + ld (le000),a ; set atn low + ld a,5fh ; command untalk + db 21h ; dummy instr. ld hl,3e3fh +unlisten: ld a,3fh ; command unlisten + call ed11 ; put it on iec bus +ee03: call edbe ; set atn high +ee06: ld b,0ah +ee09: dec b + jr nz,ee09 ; wait 40µs + call ee85 ; set clk high + jp ee97 ; set data high + +; IECIN get 1 char from iec bus + +ee13: +iecin: xor a + ld (bitcnt),a ; init bit counter + call ee85 ; set clk high +ee1b: call eea9 ; get state of clk + bit 1,a + jr z,ee1b ; wait on clk high +ee20: call ee97 ; set data high + ld d,0ffh ; init timer +ee37: call EEA9 ; get clk bit from carry flag + bit 1,a ; test clk bit + jr z,ee56 ; wait on clk lo (then valid databit) + dec d ; timer - 1 + jr nz,ee37 ; loop + ld a,(bitcnt) ; get bit counter + and a ; test for zero + jr z,ee47 ; no bits received, force eof (?) + ld a,02h ; timeout + jp edb2 ; set status + +ee47: call eea0 ; set data low + call ee85 ; set clk hi + ld a,40h ; set state to eof + call fe1c ; do it + ld hl,bitcnt ; when shall this condition occur??? + inc (hl) ; increment bit counter + jr nz,ee20 ; wait until bit counter equals zero +; test for programmed loop or bug (no inc to bitcnt in this address range) +ee56: ld a,08h + ld (bitcnt),a ; set bit count +ee5a: call eea9 ; get state of clk + bit 1,a + jr z,ee5a ; wait on clk high + and 08h ; 1st valid bit arrives, isolate data + jr z,ee65 ; data bit is zero, carry=0 + scf ; data bit is one, carry=1 + +; test, no usage? +ee65: ld a,(zwispei) ; + rra + ld (zwispei),a +ee67: call eea9 ; get state of clk + bit 1,a + jr nz,ee67 ; wait on clk low + ld hl,bitcnt + dec (hl) ; bit count - 1 + jr nz,ee5a ; loop until 8 bits received + call eea0 ; byte complete, set data low + ld a,(st) + bit 6,a ; eof? + jr z,ee80 ; yes, dont wait and... + call ee06 ; wait 40µs then set clk and data hi +ee80: ld a,(zwispei) ; ???? + and a ; reset carry + ret ; goback + +; set clk line high + +ee85: +clkhi: ld a,(le000) ; 8255-port A + and 0dfh ; turn off bit 5 (clk high) + ld (le000),a + ret ; goback + +; set clk line low + +ee8e: +clklo: ld a,(le000) ; 8255-port A + or 20h ; set bit 5 (clk low) + ld (le000),a + ret ; goback + +; set data high + +ee97: +datahi: ld a,(le000) ; 8255-port A + and 0bfh ; turn off bit 6 (data high) + ld (le000),a + ret ; goback + +; set data low + +eea0: +datalo: ld a,(le000) ; 8255-port A + or 40h ; set bit 6 (data low) + ld (le000),a + ret ; goback + +; get state of all input lines and move bit of data to carry flag + +eea9: +getbit: ld a,(le008) ; Port LS367 + ld b,a + ld a,(le008) + cp b + jr nz,eea9 ; wait for stable iec bus + bit 3,a ; test bit 3 + ret z ; bit3=0, carry=0 + scf ; bit3=1, carry=1 + ret ; goback + +; wait for 1ms + +eeb3: +wait1ms: ld b,0ffh ; init loop counter +eeb6: dec b ; b=b-1 + jp nz,eeb6 ; loop until b=0 + ret ; goback + + +; IECOPEN + +f3d5: +IECOPEN: ld a,(secadr) + bit 7,a ; secondary address? + jr z,f3d9 ; yes, continue open + and a ; no, primary address + ret ; goback + +f3d9: ld a,(filelen) ; test length of file name + and A + RET Z ; if no filename goback + XOR A + LD (ST),a ; clear state + ld a,(gernr) ; get unit address (mormally 8) + call listen ; send listen to this unit + ld a,(secadr) + or 0f0h ; set open bits on + call edb9 ; send open cmd with sec. address + ld a,(ST) ; + bit 7,a ; device ok? + jr z,f3f6 ; yes + jp f707 ; no, error + +f3f6: ld a,(filelen) ; test length of file name + and a + jp z,f654 ; jump to unlisten + ld c,00h ; init loop count + ld hl,filename+11 ; set hl to 1st char of file name +iecope30: ld a,c + ld (asave),a ; save loop count + ld (hlsave),hl ; save current addr. of file name + ld a,(hl) ; get current char of file name + call eddd ; IECOUT 1 char put on iec bus + ld a,(asave) + ld c,a ; restore c with loop count + ld hl,(hlsave) ; restore current address + inc hl ; next address of char to send + inc c ; inc loop count + ld a,(filelen) + cp c ; test loop count = length? + jr nz,iecope30 ; no, continue + jp f654 ; yes, send unlisten + +; IECLOAD load/verify a file (secondary address 0) + +f4b8: +IECLOAD: ld a,(filelen) + and a + jp z,f710 ; error, no file name given + ld a,(secadr) + ld (svsecadr),a ; save sec. addr. for futher use + call f5af ; put msg "searching for..." + ld a,60h ; sec. addr. 0 listen and talk + ld (secadr),a + call iecopen ; open file + ld a,(gernr) + call talk ; force talking of (gernr) + ld a,(secadr) + call edc7 ; submit sec. addr. + call ee13 ; get low byte (IECIN) of load addr. + ld (endptr),a ; save + ld a,(st) ; state of floppy drive + srl a ; turn off bit 7 and bit 6 too + srl a ; + jr c,f530 ; if bit 6 was on jump + call ee13 ; get high byte of load address + ld (endptr+1),a ; save, address is complete +mdfcmd02: ld a,(svsecadr) ; get back sec. addr. + and a + jr nz,f4f0 ; if zero take user's load address + ld a,(adrload) ; see load routine for futher info + ld (endptr),a ; not used if called by verify + ld a,(adrload+1) + ld (endptr+1),a +f4f0: call f5d2 ; msg loading/verifying +f4f3: ld a,(st) + and 0fdh ; clear timeout + LD (st),a + call ee13 ; get byte from IEC bus + ld c,a ; save byte + ld a,(st) + srl a + srl a + jr c,f4f3 + ld a,(lvflag) ; test for load or verify + and a + ld hl,(endptr) ; ptr to current address in storage + ld a,c ; restore byte read + jr z,f51c ; jump if load active + ld a,(hl) ; verify active, get byte of storage + cp c ; verify byte read and storage + jr z,f51e ; junp if okay + ld a,10h ; not ok + call fe1c ; set state to verify error + jr f51e ; continue + +f51c: ld (hl),a ; load byte read to starage +f51e: inc hl + ld (endptr),hl ; ptr to next + ld a,(st) + bit 6,a ; eof? + jr z,f4f3 ; no +f528: call edef ; yes, send untalk + call iecclose ; close +f530: jp c,f704 ; error, (file not found?) + and a ; set/reset flags + ld de,(endptr) + ret ; goback + +; put msg "searching for..." on screen + +f5af: ld de,searchfo ; address this msg + call msg ; output this msg +f5c1: ld a,(filelen) ; get length of filename + and a + ret z ; no filename + ld b,a ; b is counter + ld hl,filename+11 ; address of filename +f5c7: ld a,(hl) ; get filename char + call prnt ; output char to screen + inc hl ; point to next + dec b ; length - 1 + jr nz,f5c7 ; continue if not all + call letnl ; set cursor on next line on screen + ret ; goback + +; put msg "Loading..." on screen + +f5d2: ld de,loading ; address to msg + ld a,(lvflag) ; get Load/verify flag + and a + jr z,f5da ; 00 means load active + ld de,veryfing ; 01 means verify,address to this msg +f5da: call msg ; put msg on screen + call f5c1 ; put filename on screen + ret ; goback + +; IECSTORE puts header & file on IEC bus (secondary address 1) + +f5fa: +IECSTORE: ld a,(filelen) ; get length of filename + and a + jp z,f710 ; missing filename if zero + ld a,61h ; sec. addr 1 listener and talker + ld (secadr),a + call iecopen ; open new file + call f68f ; msg "Saving.." + ld a,(gernr) + call listen ; force listen for (gernr) + ld a,(secadr) + call edb9 ; send sec. addr. + ld de,(iostrt) + ld (biostrt),de ; save + ld a,(biostrt) ; low byte of begin + call eddd ; put it on bus + ld a,(biostrt+1) ; high byte of begin + call eddd ; put it on bus +f624: and a + ld hl,(endptr) ; ptr to end + ld de,(biostrt) ; current address of storage + sbc hl,de + jr c,f63f ; stop if negative + ld a,(de) ; get next byte + call eddd ; output to iec bus +f63a: ld hl,biostrt ; save max. to ffffh + inc (hl) + jr nz,f624 ; continue if low byte not zero + inc hl + inc (hl) + jr nz,f624 ; continue if high byte not zero +f63f: call unlisten ; send unlisten +f642: +iecclose: ld a,(secadr) + bit 7,a ; test on secondary address + jr nz,f657 ; no, primary address, done + ld a,(gernr) + call listen ; force listen for (gernr) + ld a,(secadr) + and 0efh + or 0e0h + call edb9 ; close sec. addr. 1 +f654: call unlisten ; send unlisten +f657: and a ; set/reset flags + ret ; goback + +; put msg "Saving..." on screen + +f68f: ld de,saving ; address to msg + call msg ; output msg + jp f5c1 ; add filename to msg + +; put msg "File not found" on screen + +f704: ld de,filenfnd ; address to msg + call errchk30 ; output msg + call ErrorChk + ld sp,(stckptr) ; force stop on error + jp GetErSta + +; put msg "device not present" on screen + +f707: ld de,devnpres ; address to msg + call errchk30 ; output msg + call ErrorChk + ld sp,(stckptr) ; force stop on error + jp start + +; put msg "Missing filename" on screen + +f710: ld de,namemiss ; address to msg + call errchk30 ; output msg + call ErrorChk + ld sp,(stckptr) ; force stop on error + jp start ; + +; set state + +fe1c: ld b,a + ld a,(st) + or b + ld (st),a + ret + +; end of program, goback to monitor +intbrk: call letnl + ld de,break + call msg + call letnl +intrpt: ld sp,10f0h ; init stackpointer + jp st1 ; goback to Monitor-ROM + + +; input areas +filename: db 80 dup (" ") ; max. 16 Zeichen, Buffer max. 80 +BUFL: db 80 dup (" ") ; Input-Buffer max. 80 Zeichen + +; Init string for plotter (sets line counter to 999) + +initstri: db 09h,09h,39h,39h,39h,0dh + +; plotter translation table + +lC402: db 19 dup 00h + db 0c3h,0c4h + db 12 dup 00h + db 61h,62h,63h,64h,65h,66h,67h,68h,69h + db 6bh,6ah,2fh,2ah,2eh,2dh + db 20h,21h,22h,23h,24h,25h,26h,27h,28h,29h + db 4fh,2ch,51h,2bh,57h,49h,55h + db 01h,02h,03h,04h,05h,06h,07h,08h,09h + db 0ah,0bh,0ch,0dh,0eh,0fh + db 10h,11h,12h,13h,14h,15h,16h,17h,18h,19h + db 1ah,52h,59h,54h,50h,45h + db 27 dup 00h + db 0dbh + db 4 dup 00h + db 40h + db 10 dup 00h + db 0beh + db 6 dup 00h + db 85h,0a4h,0a5h,00h,94h,87h,88h,00h,82h,98h,84h,92h + db 90h,83h,91h,81h,9ah,97h,93h,95h,89h,00h,0afh,8bh + db 86h,96h,00h,0abh,0aah,8ah,8eh,00h,0adh,8dh + db 3 dup 00h + db 8fh,8ch,0aeh,0ach,9bh,00h,99h,0bch + db 7 dup 00h + db 5ah + db 8 dup 00h + db 3eh,7 dup 00h,36h,35 dup 00h,1bh,58h + db 00h,00h,60h + +; printer translation table + +lc508: db " ABCDEFGHIJKLMNOPQRSTUVWXYZd" + db 4 dup 0f0h + db "0123456789-=;/.," + db 16 dup 0f0h + db 7dh,06h,0f0h,0f0h,04h,0f0h,05h,0f0h,0f0h,"?" + db 5 dup 00h,":",0f0h,"<[",03h,"]@",0f0h,">",0f0h + db 5ch,6 dup 0f0h,0e3h,"!",22h,"#$%&'()+*" + db 20 dup 0f0h,0b3h + db 61h,62h,63h,64h,65h,66h,67h,68h,69h + db 6ah,6bh,6ch,6dh,6eh,6fh,70h,71h,72h,73h + db 74h,75h,76h,77h,78h,79h,7ah,84h + db 8 dup 0f0h,60h,0f7h,4 dup 0f0h,0e1h,81h + db 94h,9ah,8eh,99h,12 dup 0f0h,7bh,0f0h,5eh + db 5fh,64 dup 0f0h diff --git a/tests/restricted/msxbasic.asm b/tests/restricted/msxbasic.asm new file mode 100644 index 00000000..42d56e18 --- /dev/null +++ b/tests/restricted/msxbasic.asm @@ -0,0 +1,26912 @@ + +; How to build (use the z80asm variant in z88dk): +; +; z80asm -b msxbasic +; + + +; Variant with HOOKs disabled: +; +; z80asm -DNOHOOK -b msxbasic +; +; No HOOKs but same ROM addresses: +; z80asm -DNOHOOK -DPRESERVE_LOCATIONS -b msxbasic +; + +; MOD demonstration (ZX Spectrum skin variant): +; +; z80asm -DSPECTRUM_SKIN -DNOHOOK -b msxbasic +; + + +defc BEL = $07 ; Control "G", BEEP via the console output +defc TAB = $09 ; TAB +defc LF = $0A ; Line feed +defc CR = $0D ; Carriage return +defc FF = $0C ; Form Feed / CLS +defc ESC = $1B ; Escape + + +; --- Sizes --- + +defc NUMLEV = 60 ; On CP/M it is 29: ; 0*20+19+2*5 + +; --- Prefixes, Tokens.. --- + +defc ONEFUN = TK_LEFT_S ; Function offset + +defc CLMWID = 14 ; MAKE COMMA COLUMNS FOURTEEN CHARACTERS + + + +defc OCTCON = 11 ; $0B - EMBEDED OCTAL CONSTANT +defc HEXCON = 12 ; $0C - EMBEDED HEX CONSTANT + +defc PTRCON = 13 ; $0D - A LINE REFERENCE CONSTANT +defc LINCON = 14 ; $0E - A LINE NUMBER UNCONVERTED TO POINTER + +defc IN2CON = 15 ;SINGLE BYTE (TWO BYTE WITH TOKEN) INTEGER +defc CONCN2 = 16 ;TOKEN RETURNED SECOND TYPE CONSTANT IS SCANNED. + +defc ONECON = 17 ;FIRST OF 10 (0-9) INTEGER SPECIAL TOKENS +defc INTCON = 28 ;REGULAR 16 BIT TWO'S COMPLEMENT INT + +defc CONCON = 30 ;TOKEN RETURNED BY CHRGET AFTER CONSTANT SCANNED +defc DBLCON = 31 ;DOUBLE PREC (8 BYTE) CONSTANT + + +; --- ------ --- + + +;defc STACK_INIT = $F376 +defc STACK_INIT = MAXRAM-10 + + INCLUDE "msxbasic.def" + INCLUDE "msxhook.def" + INCLUDE "msxtoken.def" + + INCLUDE "msx.def" + + +ORG $0000 + + +; Routine at 0 +; +; Check RAM and sets slot for command area. +STARTUP: + + + DI + JP _STARTUP + +; Used to initialize CHFONT +FONT: + IF SPECTRUM_SKIN + DEFW _FONT-256 + ELSE + DEFW _FONT + ENDIF + +_VDP_RD: + DEFB VDP_DATAIN +_VDP_WR: + DEFB VDP_DATA + +; A byte follows to be compared +; +; Checks if then current character pointed by +SYNCHR: + JP _SYNCHR + NOP + +; Routine at 12 +; +; Reads the value of an address in another slot +RDSLT: + JP _RDSLT + NOP + +; Routine at 16 +; +; Gets next character (or token) from BASIC text. +CHRGTB: + JP _CHRGTB + NOP + +; Routine at 20 +; +; Writes a value to an address in another slot. +WRTSLT: + JP _WRTSLT + NOP + +; Routine at 24 +; +; Output to the current device (formerly OUTC). +OUTDO: + JP _OUTDO + NOP + +; Routine at 28 +; +; Performs inter-slot call to specified address. +CALSLT: + JP _CALSLT + NOP + +; Routine at 32 +; +; Compare HL with DE. +DCOMPR: + JP CPDEHL + NOP + +; Routine at 36 +; +; Switches indicated slot at indicated page on perpetual +ENASLT: + JP _ENASLT + NOP + +; Routine at 40 +; +; Return the number type (FAC) +GETYPR: + JP _GETYPR + +; Routine at 43 +; 002B 1 Basic ROM Character set / Date format / Default interrupt freq +; 7 6 5 4 3 2 1 0 +; | | | | +-+-+-+-- Character set +; | | | | 0 = Japanese, 1 = Other +; | +-+-+---------- Date format +; | 0 = Y-M-D, 1 = M-D-Y, 2 = D-M-Y +; +---------------- Default interrupt frequency (VSYNC) +; 0 = 60Hz, 1 = 50Hz +L002B: + DEFB $91 + +L002C: + DEFB $11 + +; 002D 1 MSX Version Number +; 0 = MSX 1 +; 1 = MSX 2 +; 2 = MSX 2+ +; 3 = MSX Turbo RL002D: + DEFB $00 + +L002E: + DEFB $00 ; IF BIT 0 = 1 then internal MIDI is present ( Turbo R Only !!! ) + + NOP + +; Routine at 48 +; Call FAR +CALLF: + JP _CALLF + +L0033: + NOP + NOP + NOP + NOP + NOP + + +; Routine at 56 +; +; Performs hardware interrupt procedures. +KEYINT: + JP _KEYINT + +; Routine at 59 +; +; Dev. initialization. +INITIO: + JP _INITIO + +; Routine at 62 +; +; Initializes function key strings. +INIFNK: + JP _INIFNK + +; Routine at 65 +; +; Disables screen display. +DISSCR: + JP _DISSCR + +; Routine at 68 +; +; Enables screen display. +ENASCR: + JP _ENASCR + +; Routine at 71 +; +; Writes to the VDP register. +WRTVDP: + JP _WRTVDP + +; Routine at 74 +; +; Reads the VRAM address by [HL]. +RDVRM: + JP _RDVRM + +; Routine at 77 +; +; Write to the VRAM address by [HL]. +WRTVRM: + JP _WRTVRM + +; Routine at 80 +; +; Sets up the VDP for read. +SETRD: + JP _SETRD + +; Routine at 83 +; +; Sets up the VDP for write. +SETWRT: + JP _SETWRT + +; Routine at 86 +; +; Fill the vram with specified data +FILVRM: + JP _FILVRM + +; Routine at 89 +; +; Block transfer to memory from VRAM +LDIRMV: + JP _LDIRMV + +; Routine at 92 +; +; Block transfer to VRAM from memory +LDIRVM: + JP _LDIRVM + +; Routine at 95 +; +; Sets the VDP mode according to SCRMOD. +CHGMOD: + JP _CHGMOD + +; Routine at 98 +; +; Changes the color of the screen. +CHGCLR: + JP _CHGCLR + + NOP + +; Routine at 102 +; +; Performs non-maskable interrupt procedures. +NMI: + JP _NMI + +; Routine at 105 +; +; Initializes all sprites. +CLRSPR: + JP _CLRSPR + +; Routine at 108 +; +; Initializes screen for text mode (40*24) and sets the VDP. +INITXT: + JP _INITXT + +; Routine at 111 +; +; Initializes screen for text mode (32*24) and sets the VDP. +INIT32: + JP _INIT32 + +; Routine at 114 +; +; Initializes screen for high-resolution mode and sets the VDP. +INIGRP: + JP _INIGRP + +; Routine at 117 +; +; Initializes screen for multi-color mode and sets the VDP. +INIMLT: + JP _INIMLT + +; Routine at 120 +; +; Sets the VDP for text (40*24) mode. +SETTXT: + JP _SETTXT + +; Routine at 123 +; +; Sets the VDP for text (32*24) mode. +SETT32: + JP _SETT32 + +; Routine at 126 +; +; Sets the VDP for high-resolution mode. +SETGRP: + JP _SETGRP + +; Routine at 129 +; +; Sets the VDP for multicolor mode. +SETMLT: + JP _SETMLT + +; Routine at 132 +; +; Returns address of sprite pattern table. +CALPAT: + JP _CALPAT + +; Routine at 135 +; +; Returns address of sprite atribute table. +CALATR: + JP _CALATR + +; Routine at 138 +; +; Returns the current sprite size. +GSPSIZ: + JP _GSPSIZ + +; Routine at 141 +; +; Prints a character on the graphic screen. +GRPPRT: + JP _GRPPRT + +; Routine at 144 +; +; Initializes PSG,and static data for PLAY +GICINI: + JP _GICINI + +; Routine at 147 +; +; Writes data to the PSG register. +WRTPSG: + JP _WRTPSG + +; Routine at 150 +; +; Reads data from PSG register. +RDPSG: + JP _RDPSG + +; Routine at 153 +; +; Checks/starts background tasks for PLAY. +STRTMS: + JP _STRTMS + +; Routine at 156 +; +; Check the status of keyboard buffer. +CHSNS: + JP _CHSNS + +; Routine at 159 +; +; Waits for character being input and returns the character codes. +CHGET: + JP _CHGET + +; Routine at 162 +; +; Outputs a character to the console. +CHPUT: + JP _CHPUT + +; Routine at 165 +; +; Output a character to the line printer. +LPTOUT: + JP _LPTOUT + +; Routine at 168 +; +; Check the line priter status. +LPTSTT: + JP _LPTSTT + +; Routine at 171 +; +; Check graphic header byte and converts codes. +SNVCHR: + JP _SNVCHR + +; Routine at 174 +; +; Accepts a line from console until a CR or STOP +PINLIN: + JP _PINLIN + +; Routine at 177 +; +; Same as PINLIN,exept if AUTFLO if set. +INLIN: + JP _INLIN + +; Routine at 180 +; +; Output a '?' mark and a space then falls into the INLIN routine. +QINLIN: + JP _QINLIN + +; Routine at 183 +; +; Check the status of the Control-STOP key. +BREAKX: + JP _BREAKX + +; Routine at 186 +; +; Check the status of the SHIFT-STOP key. +ISCNTC: + JP _ISCNTC + +; Routine at 189 +; +; Same as ISCNTC,used by BASIC +CKCNTC: + JP _CKCNTC + +; Routine at 192 +; +; Sounds the buffer +BEEP: + JP _BEEP + +; Routine at 195 +; +; Clear the screen. +__CLS: + JP _CLS + +; Routine at 198 +; +; Locate cursor at the specified position. +POSIT: + JP _POSIT ; Locate cursor at the specified position + +; Routine at 201 +; +; Check if function key display is active, and display the FN list if so... +FNKSB: + JP _FNKSB + +; Routine at 204 +; +; Hide the function key diplay. +ERAFNK: + JP _ERAFNK + +; Routine at 207 +; +; Show the function key display. +DSPFNK: + JP _DSPFNK + +; Routine at 210 +; +; Forcidly places the screen in text mode. +TOTEXT: + JP _TOTEXT + +; Routine at 213 +; +; Return the current joystick status. +GTSTCK: + JP _GTSTCK + +; Routine at 216 +; +; Return the current trigger button status. +GTTRIG: + JP _GTTRIG + +; Routine at 219 +; +; Check the current touch PAD status. +GTPAD: + JP _GTPAD + +; Routine at 222 +; +; Return the value of the paddle. +GTPDL: + JP _GTPDL + +; Routine at 225 +; +; Reads the header block after turning the cassette motor on +TAPION: + JP _TAPION + +; Routine at 228 +; +; Read data from the tape +TAPIN: + JP _TAPIN + +; Routine at 231 +; +; Stops reading from the tape +TAPIOF: + JP _TAPIOF + +; Routine at 234 +; +; Turns on the cassette motor and writes the header +TAPOON: + JP _TAPOON + +; Routine at 237 +; +; Writes data on the tape +TAPOUT: + JP _TAPOUT + +; Routine at 240 +; +; Stops writing on the tape +TAPOOF: + JP _TAPOOF + +; Routine at 243 +; +; Sets the cassette motor action +STMOTR: + JP _STMOTR + +; Routine at 246 +; +; Gives number of bytes in queue +LFTQ: + JP _LFTQ + +; Routine at 249 +; +; Put byte in queue +PUTQ: + JP _PUTQ + +; Routine at 252 +; +; Shifts screenpixel to the right +RIGHTC: + JP _RIGHTC + +; Routine at 255 +; +; Shifts screenpixel to the left +LEFTC: + JP _LEFTC + +; Routine at 258 +; +; Shifts screenpixel up +UPC: + JP _UPC + +; Routine at 261 +; +; Tests whether UPC is possible, if possible, execute UPC +TUPC: + JP _TUPC + +; Routine at 264 +; +; Shifts screenpixel down +DOWNC: + JP _DOWNC + +; Routine at 267 +; +; Tests whether DOWNC is possible, if possible, execute DOWNC +TDOWNC: + JP _TDOWNC + +; Routine at 270 +; +; Scales X and Y coordinates +SCALXY: + JP _SCALXY + +; Routine at 273 +; a.k.a. MAPXYC +; +; Places cursor at current cursor address +MAPXY: + JP _MAPXY + +; Routine at 276 +; +; Gets current "graphics cursor" position and mask pattern +FETCHC: + JP _FETCHC + +; Routine at 279 +; +; Record current "graphics cursor" position and mask pattern +STOREC: + JP _STOREC + +; Routine at 282 +; +; Set attribute byte +SETATR: + JP _SETATR + +; Routine at 285 +; +; Reads attribute byte of current screenpixel +READC: + JP _READC + +; Routine at 288 +; +; Update current screenpixel of specified attribute byte +SETC: + JP _SETC + +; Routine at 291 +; +; Set horizontal screenpixels: draws an horizontal line, used for filled polygons +NSETCX: + JP _NSETCX + +; Routine at 294 +; +; Gets screen relations +GTASPC: + JP _GTASPC + +; Routine at 297 +; +; This entry point is used by the routine at __PAINT. +PNTINI: + JP _PNTINI + +; Routine at 300 +; +SCANR: + JP _SCANR + +; Routine at 303 +; +SCANL: + JP _SCANL ; $197A + +; Routine at 306 +; +; Alternates the CAP lamp status +CHGCAP: + JP _CHGCAP + +; Routine at 309 +; +; Alternates the 1-bit sound port status +CHGSND: + JP _CHGSND + +; Routine at 312 +; +; Reads the primary slot register +RSLREG: + JP _RSLREG + +; Routine at 315 +; +; Writes value to the primary slot register +WSLREG: + JP _WSLREG + +; Routine at 318 +; +; Reads VDP status register +RDVDP: + JP _RDVDP + +; Routine at 321 +; +; Returns the value of the specified line from the keyboard matrix +SNSMAT: + JP _SNSMAT + +; Routine at 324 +; +; Executes I/O for mass-storage media like diskettes +PHYDIO: + JP _PHYDIO + +; Routine at 327 +; +; Initialises mass-storage media like formatting of diskettes +FORMAT: + JP _FORMAT + +; Routine at 330 +; +; Tests if I/O to device is taking place +ISFLIO: + JP _ISFLIO + +; Routine at 333 +; +; Printer output +OUTDLP: + JP OUTC_TABEXP + +; Routine at 336 +; +; Returns pointer to play queue +GETVCP: + JP _GETVCP + +; Routine at 339 +; +; Returns pointer to variable in queue number VOICEN (byte op $FB38) +GETVC2: + JP _GETVC2 + +; Routine at 342 +; +; Clear keyboard buffer +KILBUF: + JP _KILBUF + +; Routine at 345 +; +; Executes inter-slot call to the routine in BASIC interpreter +CALBAS: + JP _CALBAS + +; -- RESERVED FOR EXPANSION -- +L015C: + DEFS $5A + +; Routine at 438 +; +; Used by the routines at RDSLT, _RDSLT_0, COPY_FONT and L0752. +; Reads the value in an address in another slot +_RDSLT: + CALL SELPRM ; Calculate bit pattern and mask code, slot# in A + JP M,_RDSLT_0 + IN A,(PPI_A) + LD D,A + AND C + OR B + CALL RDPRIM + LD A,E + RET + +; Routine at 454 +; +; Used by the routine at _RDSLT. +_RDSLT_0: + PUSH HL + CALL SELEXP ; Select secondary slot + EX (SP),HL + PUSH BC + CALL _RDSLT + JR _RW_SLT_SUB + +; Routine at 465 +; +; Used by the routines at WRTSLT and _WRTSLT_0. +; Writes a value to an address in another slot. +_WRTSLT: + PUSH DE + CALL SELPRM ; Calculate bit pattern and mask code, slot# in A + JP M,_WRTSLT_0 + POP DE + IN A,(PPI_A) + LD D,A + AND C + OR B + JP WRPRIM + +; Routine at 481 +; +; Used by the routine at _WRTSLT. +_WRTSLT_0: + EX (SP),HL + PUSH HL + CALL SELEXP ; Select secondary slot + POP DE + EX (SP),HL + PUSH BC + CALL _WRTSLT +; This entry point is used also by the routine at _RDSLT_0. +_RW_SLT_SUB: + POP BC + EX (SP),HL + PUSH AF + LD A,B + AND $3F + OR C + OUT (PPI_AOUT),A + LD A,L + LD ($FFFF),A ; Secondary slot select register + LD A,B + OUT (PPI_AOUT),A + POP AF + POP HL + RET + +; Routine at 511 +; +; Used by the routines at CALBAS, L0D12, _OUTDO and L1BA2. +_CALBAS: +IF NOCALBAS + JP (IX) + IF PRESERVE_LOCATIONS + DEFS 4 + ENDIF +ELSE + LD IY,(EXP0-1) ; Load expansion slot #0 address on IYl + JR _CALSLT +ENDIF + +; Routine at 517 +; +; Used by the routine at L002B. +; Call FAR +_CALLF: + EX (SP),HL + PUSH AF + PUSH DE + LD A,(HL) + PUSH AF + POP IY + INC HL + LD E,(HL) + INC HL + LD D,(HL) + INC HL + PUSH DE + POP IX + POP DE + POP AF + EX (SP),HL +; This entry point is used by the routines at CALSLT, _CALBAS and _CALSLT_0. +; Performs inter-slot call to specified address. +_CALSLT: + EXX + EX AF,AF' + PUSH IY ; slot address is on IYl + POP AF + PUSH IX + POP HL + CALL SELPRM ; Calculate bit pattern and mask code, slot# in A + JP M,_CALSLT_0 + IN A,(PPI_A) + PUSH AF + AND C + OR B + EXX + JP CLPRIM + +; Routine at 558 +; +; Used by the routine at _CALLF. +_CALSLT_0: + CALL SELEXP ; Select secondary slot + PUSH AF + POP IY + PUSH HL + PUSH BC + LD C,A + LD B,$00 + LD A,L + AND H + OR D + LD HL,SLT0 + ADD HL,BC + LD (HL),A + PUSH HL + EX AF,AF' + EXX + CALL _CALSLT + EXX + EX AF,AF' + POP HL + POP BC + POP DE + LD A,B + AND $3F + OR C + DI + OUT (PPI_AOUT),A + LD A,E + LD ($FFFF),A ; Secondary slot select register + LD A,B + OUT (PPI_AOUT),A + LD (HL),E + EX AF,AF' + EXX + RET + +; Routine at 606 +; +; Used by the routines at ENASLT, _ENASLT_0 and L043F. +_ENASLT: + CALL SELPRM ; Calculate bit pattern and mask code, slot# in A + JP M,_ENASLT_0 + IN A,(PPI_A) + AND C + OR B + OUT (PPI_AOUT),A + RET + +; Routine at 619 +; +; Used by the routine at _ENASLT. +_ENASLT_0: + PUSH HL + CALL SELEXP ; Select secondary slot + LD C,A + LD B,$00 + LD A,L + AND H + OR D + LD HL,SLT0 + ADD HL,BC + LD (HL),A + POP HL + LD A,C + JR _ENASLT + +; Routine at 638 +; +; Used by the routines at _RDSLT, _WRTSLT, _CALLF and _ENASLT. +; Calculate bit pattern and mask code +SELPRM: + DI + PUSH AF + LD A,H + RLCA + RLCA + AND $03 + LD E,A + LD A,$C0 +SELPRM_0: + RLCA + RLCA + DEC E + JP P,SELPRM_0 + LD E,A + CPL + LD C,A + POP AF + PUSH AF + AND $03 + INC A + LD B,A + LD A,$AB ; @10101011 +SELPRM_1: + ADD A,$55 ; @01010101 + DJNZ SELPRM_1 + LD D,A + AND E + LD B,A + POP AF + AND A + RET + +; Routine at 675 +; +; Used by the routines at _RDSLT_0, _WRTSLT_0, _CALSLT_0 and _ENASLT_0. +; Select secondary slot REG +SELEXP: + PUSH AF + LD A,D + AND $C0 + LD C,A + POP AF + PUSH AF + LD D,A + IN A,(PPI_A) + LD B,A + AND $3F + OR C + OUT (PPI_AOUT),A + LD A,D + RRCA + RRCA + AND $03 + LD D,A + LD A,$AB ; @10101011 +SELEXP_0: + ADD A,$55 ; @01010101 + DEC D + JP P,SELEXP_0 + AND E + LD D,A + LD A,E + CPL + LD H,A + LD A,($FFFF) ; Secondary slot select register + CPL ; Reading returns INVERTED! previous written value + LD L,A + AND H + OR D + LD ($FFFF),A ; Secondary slot select register + LD A,B + OUT (PPI_AOUT),A + POP AF + AND $03 + RET + + +; This entry point is used by the routine at STARTUP. +; $02D7 +_STARTUP: + LD A,$82 + OUT (PPI_MOUT),A + XOR A + OUT (PPI_AOUT),A + LD A,$50 + OUT (PPI_COUT),A + LD DE,$FFFF + XOR A + LD C,A +_STARTUP_0: + OUT (PPI_AOUT),A + SLA C + LD B,$00 + LD HL,$FFFF ; Secondary slot select register + LD (HL),$F0 + LD A,(HL) ; Reading returns INVERTED! previous written value + SUB $0F + JR NZ,_STARTUP_2 + LD (HL),A + LD A,(HL) + INC A + JR NZ,_STARTUP_2 + INC B + SET 0,C +_STARTUP_1: + LD ($FFFF),A ; Secondary slot select register +_STARTUP_2: + LD HL,$BF00 +_STARTUP_3: + LD A,(HL) + CPL + LD (HL),A + CP (HL) + CPL + LD (HL),A + JR NZ,_STARTUP_4 + NOP + NOP + NOP + DEC H + JP M,_STARTUP_3 +_STARTUP_4: + LD L,$00 + INC H + LD A,L + SUB E + LD A,H + SBC A,D + JR NC,_STARTUP_5 + EX DE,HL + LD A,($FFFF) ; Secondary slot select register + CPL ; Reading returns INVERTED! previous written value + LD L,A + IN A,(PPI_A) + LD H,A + LD SP,HL +_STARTUP_5: + LD A,B + AND A + JR Z,_STARTUP_6 + LD A,($FFFF) ; Secondary slot select register + CPL ; Reading returns INVERTED! previous written value + ADD A,$10 + CP $40 + JR C,_STARTUP_1 +_STARTUP_6: + IN A,(PPI_A) + ADD A,$50 + JR NC,_STARTUP_0 + LD HL,0 + ADD HL,SP + LD A,H + OUT (PPI_AOUT),A + LD A,L + LD ($FFFF),A ; Secondary slot select register + LD A,C + RLCA + RLCA + RLCA + RLCA + LD C,A + LD DE,$FFFF + IN A,(PPI_A) + AND $3F +_STARTUP_7: + OUT (PPI_AOUT),A + LD B,$00 + RLC C + JR NC,_STARTUP_9 + INC B + LD A,($FFFF) ; Secondary slot select register + CPL ; Reading returns INVERTED! previous written value + AND $3F +_STARTUP_8: + LD ($FFFF),A ; Secondary slot select register +_STARTUP_9: + LD HL,$FE00 +_STARTUP_10: + LD A,(HL) + CPL + LD (HL),A + CP (HL) + CPL + LD (HL),A + JR NZ,_STARTUP_11 + NOP + NOP + NOP + DEC H + LD A,H + CP $C0 + JR NC,_STARTUP_10 +_STARTUP_11: + LD L,$00 + INC H + LD A,L + SUB E + LD A,H + SBC A,D + JR NC,_STARTUP_12 + EX DE,HL + LD A,($FFFF) ; Secondary slot select register + CPL ; Reading returns INVERTED! previous written value + LD L,A + IN A,(PPI_A) + LD H,A + LD SP,HL +_STARTUP_12: + LD A,B + AND A + JR Z,_STARTUP_13 + LD A,($FFFF) ; Secondary slot select register + CPL ; Reading returns INVERTED! previous written value + ADD A,$40 + JR NC,_STARTUP_8 +; $0398 +_STARTUP_13: + IN A,(PPI_A) + ADD A,$40 + JR NC,_STARTUP_7 + LD HL,0 + ADD HL,SP + LD A,H + OUT (PPI_AOUT),A + LD A,L + LD ($FFFF),A ; Secondary slot select register + +; $03A9 + LD A,C + LD BC,$0C49 ; Clear System Variable Region (3145 bytes) + LD DE,RDPRIM+1 ; System variables region + LD HL,RDPRIM ; " " " + LD (HL),$00 + LDIR + LD C,A + LD B,$04 + LD HL,EXP3 ; Expansion slot #3 + +_STARTUP_14: +; $03DB + RR C + SBC A,A + AND $80 + LD (HL),A + DEC HL + DJNZ _STARTUP_14 + + IN A,(PPI_A) + LD C,A + XOR A + OUT (PPI_AOUT),A + LD A,($FFFF) ; Secondary slot select register + CPL ; Reading returns INVERTED! previous written value + LD L,A + LD A,$40 + OUT (PPI_AOUT),A + LD A,($FFFF) ; Secondary slot select register + CPL ; Reading returns INVERTED! previous written value + LD H,A + LD A,$80 + OUT (PPI_AOUT),A + LD A,($FFFF) ; Secondary slot select register + CPL ; Reading returns INVERTED! previous written value + LD E,A + LD A,$C0 + OUT (PPI_AOUT),A + LD A,($FFFF) ; Secondary slot select register + CPL ; Reading returns INVERTED! previous written value + LD D,A + LD A,C + OUT (PPI_AOUT),A + LD (SLT0),HL + EX DE,HL + LD (SLT2),HL + + +; $03F6 + IM 1 + JP CSTART + + +; Routine at 1019 +; +; Used by the routines at ISCNTC and _CKCNTC. +_ISCNTC: + LD A,(BASROM) + AND A + RET NZ + PUSH HL + LD HL,INTFLG + DI + LD A,(HL) + LD (HL),$00 + POP HL + EI + AND A + RET Z + CP $03 + JR Z,_ISCNTC_1 + PUSH HL + PUSH DE + PUSH BC + CALL L09DA + LD HL,INTFLG +_ISCNTC_0: + DI + LD A,(HL) + LD (HL),$00 + EI + AND A + JR Z,_ISCNTC_0 + PUSH AF + CALL L0A27 + POP AF + POP BC + POP DE + POP HL + CP $03 + RET NZ +_ISCNTC_1: + PUSH HL + CALL _KILBUF + CALL CKSTTP ; Check for STOP trap + JR NC,L043F + LD HL,IFLG_STOP ; STOP button - Interrupt flags + DI + CALL TST_IFLG_EVENT + EI + POP HL + RET + +; Routine at 1087 +; +; Used by the routine at _ISCNTC. +L043F: + CALL _TOTEXT + LD A,(EXP0) ; Expansion slot #0 + LD H,$40 + CALL _ENASLT + POP HL + XOR A + LD SP,(SAVSTK) + PUSH BC + JP __STOP_0 + +; Routine at 1108 +; +; Used by the routines at _ISCNTC and L24C4. +; Check for STOP trap +CKSTTP: + LD A,(IFLG_STOP) ; STOP button - Interrupt flags + RRCA + RET NC + LD HL,(IENTRY_STOP) ; STOP button - Interrupt related code + LD A,H + OR L + RET Z + LD HL,(CURLIN) ; Line number the Basic interpreter is working on, in direct mode it will be filled with #FFFF + INC HL + LD A,H + OR L + RET Z ; RET if we are in 'DIRECT' (immediate) mode + SCF + RET + +; Routine at 1128 +; +; Used by the routines at KILBUF and _ISCNTC. +_KILBUF: + LD HL,(PUTPNT) + LD (GETPNT),HL + RET + +; Routine at 1135 +; +; Used by the routines at BREAKX, _LPTOUT, _TAPOON, _TAPOUT, _TAPIN, TAPIN_PERIOD and TAPIN_BIT. +; Return CY if STOP is pressed +_BREAKX: + IN A,(PPI_C) + AND $F0 + + OR $07 + OUT (PPI_COUT),A + + IN A,(PPI_B) + AND $10 + RET NZ + IN A,(PPI_C) + DEC A + OUT (PPI_COUT),A + IN A,(PPI_B) + AND $02 + RET NZ + PUSH HL + LD HL,(PUTPNT) + LD (GETPNT),HL + POP HL + LD A,(OLDKEY+7) + AND $EF ; TK_EQUAL ? + LD (OLDKEY+7),A + LD A,$0D + LD (REPCNT),A + SCF + RET + + +; Routine at 1181 +; +; Used by the routine at INITIO. +_INITIO: + LD A,$07 + LD E,$80 + CALL _WRTPSG + LD A,$0F + LD E,$CF + CALL _WRTPSG + LD A,$0B + LD E,A + CALL _WRTPSG + CALL L110C + AND $40 + LD (KANAMD),A + LD A,$FF + OUT (PRN_STB),A + +; This entry point is used by the routines at GICINI, _BEEP and L24C4. +_GICINI: + PUSH HL + PUSH DE + PUSH BC + PUSH AF + LD HL,MUSICF + LD B,$71 + XOR A +GICINI_1: + LD (HL),A + INC HL + DJNZ GICINI_1 + LD DE,VOICAQ + LD B,$7F + LD HL,$0080 +GICINI_2: + PUSH HL + PUSH DE + PUSH BC + PUSH AF + CALL L14DA + POP AF + ADD A,$08 + LD E,$00 + CALL _WRTPSG + SUB $08 + PUSH AF + LD L,$0F + CALL _GETVC2_0 + EX DE,HL + LD HL,L0508 + LD BC,$0006 + LDIR + POP AF + POP BC + POP HL + POP DE + ADD HL,DE + EX DE,HL + INC A + CP $03 + JR C,GICINI_2 + LD A,$07 + LD E,$B8 + CALL _WRTPSG + JP _POPALL + +; Sound/Envelope table? at 1288, 6 bytes +L0508: + DEFB $04,$04,$78,$88,$ff,$00 + + + + +; This entry point is used by the routines at INITXT and _CHGMOD. +_INITXT: + CALL _DISSCR + XOR A + LD (SCRMOD),A + LD (OLDSCR),A + LD A,(LINL40) + LD (LINLEN),A + LD HL,(TXTNAM) + LD (NAMBAS),HL + LD HL,(TXTCGP) + LD (CGPBAS),HL + CALL _CHGCLR + CALL CLS_FORMFEED + CALL COPY_FONT + CALL _SETTXT + JR _ENASCR + +; Routine at 1336 +; +; Used by the routines at INIT32 and _CHGMOD. +_INIT32: + CALL _DISSCR + LD A,$01 + LD (SCRMOD),A + LD (OLDSCR),A + LD A,(LINL32) + LD (LINLEN),A + LD HL,(T32NAM) ; SCREEN 1 name table + LD (NAMBAS),HL + LD HL,(T32CGP) ; SCREEN 1 character pattern table + LD (CGPBAS),HL + LD HL,(T32PAT) ; SCREEN 1 sprite pattern table + LD (PATBAS),HL + LD HL,(T32ATR) + LD (ATRBAS),HL + CALL _CHGCLR + CALL CLS_FORMFEED + CALL COPY_FONT + CALL _CLRSPR_0 + CALL _SETT32 + +; This entry point is used by the routines at ENASCR, _INITXT, _INIGRP and _INIMLT. +_ENASCR: + LD A,(RG1SAV) + OR $40 + JR _DISSCR_0 + +; Routine at 1399 +; +; Used by the routines at DISSCR, _INITXT, _INIT32, _INIGRP and _INIMLT. +_DISSCR: + LD A,(RG1SAV) + AND $BF +; This entry point is used by the routine at _INIT32. +_DISSCR_0: + LD B,A + LD C,$01 + +; This entry point is used by the routines at WRTVDP, _SETTXT, _SETT32, _SETGRP, +; _SETMLT, _CLRSPR and RESTORE_BORDER. +_WRTVDP: + LD A,B + DI + OUT (VDP_CMD),A + LD A,C + OR $80 + OUT (VDP_CMD),A + EI + PUSH HL + LD A,B + LD B,$00 + LD HL,RG0SAV + ADD HL,BC + LD (HL),A + POP HL + RET + +; Routine at 1428 +; +; Used by the routines at SETTXT and _INITXT. +_SETTXT: + LD A,(RG0SAV) + AND $01 + LD B,A + LD C,$00 + CALL _WRTVDP + LD A,(RG1SAV) + AND $E7 + OR $10 + LD B,A + INC C + CALL _WRTVDP + LD HL,TXTNAM + LD DE,$0000 + JP _SETMLT_0 + +; Routine at 1460 +; +; Used by the routines at SETT32 and _INIT32. +_SETT32: + LD A,(RG0SAV) + AND $01 + LD B,A + LD C,$00 + CALL _WRTVDP + LD A,(RG1SAV) + AND $E7 + LD B,A + INC C + CALL _WRTVDP + LD HL,T32NAM ; SCREEN 1 name table + LD DE,$0000 + JP _SETMLT_0 + +; Routine at 1490 +; +; Used by the routines at INIGRP and _CHGMOD. +_INIGRP: + CALL _DISSCR + LD A,$02 + LD (SCRMOD),A + LD HL,(GRPPAT) ; SCREEN 2 sprite pattern table + LD (PATBAS),HL + LD HL,(GRPATR) ; SCREEN 2 sprite attribute table + LD (ATRBAS),HL + LD HL,(GRPNAM) ; SCREEN 2 name table + CALL _SETWRT + XOR A + LD B,$03 +_INIGRP_0: + OUT (VDP_DATA),A + INC A + JR NZ,_INIGRP_0 + DJNZ _INIGRP_0 + CALL CLS_TXT + CALL _CLRSPR_0 + CALL _SETGRP + JP _ENASCR + +; Routine at 1538 +; +; Used by the routines at SETGRP and _INIGRP. + +_SETGRP: + LD A,(RG0SAV) + OR $02 + LD B,A + LD C,$00 + CALL _WRTVDP + LD A,(RG1SAV) + AND $E7 + LD B,A + INC C + CALL _WRTVDP + LD HL,GRPNAM + LD DE,$7F03 + JR _SETMLT_0 + +; Routine at 1567 +; +; Used by the routines at INIMLT and _CHGMOD. +_INIMLT: + CALL _DISSCR + LD A,$03 + LD (SCRMOD),A + LD HL,(MLTPAT) ; SCREEN 3 sprite pattern table + LD (PATBAS),HL + LD HL,(MLTATR) ; SCREEN 3 sprite attribute table + LD (ATRBAS),HL + LD HL,(MLTNAM) ; SCREEN 3 name table + CALL _SETWRT + LD DE,$0006 +_INIMLT_0: + LD C,$04 +_INIMLT_1: + LD A,D + LD B,$20 +_INIMLT_2: + OUT (VDP_DATA),A + INC A + DJNZ _INIMLT_2 + DEC C + JR NZ,_INIMLT_1 + LD D,A + DEC E + JR NZ,_INIMLT_0 + CALL CLS_MLT + CALL _CLRSPR_0 + CALL _SETMLT + JP _ENASCR + +; Routine at 1625 +; +; Used by the routines at SETMLT and _INIMLT. +_SETMLT: + LD A,(RG0SAV) + AND $01 + LD B,A + LD C,$00 + CALL _WRTVDP + LD A,(RG1SAV) + AND $E7 + OR $08 + LD B,A + LD C,$01 + CALL _WRTVDP + LD HL,MLTNAM ; SCREEN 3 name table + LD DE,$0000 +; This entry point is used by the routines at _SETTXT, _SETT32 and _SETGRP. +_SETMLT_0: + LD BC,$0602 + CALL _SETMLT_1 + LD B,$0A + LD A,D + CALL _SETMLT_2 + LD B,$05 + LD A,E + CALL _SETMLT_2 + LD B,$09 + CALL _SETMLT_1 + LD B,$05 +_SETMLT_1: + XOR A +_SETMLT_2: + PUSH HL + PUSH AF + LD A,(HL) + INC HL + LD H,(HL) + LD L,A + XOR A +_SETMLT_3: + ADD HL,HL + ADC A,A + DJNZ _SETMLT_3 + LD L,A + POP AF + OR L + LD B,A + CALL _WRTVDP + POP HL + INC HL + INC HL + INC C + RET + +; Routine at 1704 +; +; Used by the routine at CLRSPR. +_CLRSPR: + LD A,(RG1SAV) + LD B,A + LD C,$01 + CALL _WRTVDP + LD HL,(PATBAS) + LD BC,$0800 ; 2048 + XOR A + CALL _FILVRM + +; This entry point is used by the routines at _INIT32, _INIGRP and _INIMLT. +_CLRSPR_0: + LD A,(FORCLR) + LD E,A + LD HL,(ATRBAS) + LD BC,$2000 +_CLRSPR_1: + LD A,$D1 + CALL _WRTVRM + INC HL + INC HL + LD A,C + CALL _WRTVRM + INC HL + INC C + LD A,(RG1SAV) + RRCA + RRCA + JR NC,_CLRSPR_2 + INC C + INC C + INC C +_CLRSPR_2: + LD A,E + CALL _WRTVRM + INC HL + DJNZ _CLRSPR_1 + RET + +; Routine at 1764 +; +; Used by the routine at CALPAT. +_CALPAT: + LD L,A + LD H,$00 + ADD HL,HL + ADD HL,HL + ADD HL,HL + CALL _GSPSIZ + CP $08 + JR Z,_CALPAT_0 + ADD HL,HL + ADD HL,HL +_CALPAT_0: + EX DE,HL + LD HL,(PATBAS) + ADD HL,DE + RET + +; Routine at 1785 +; +; Used by the routine at CALATR. +_CALATR: + LD L,A + LD H,$00 + ADD HL,HL + ADD HL,HL + EX DE,HL + LD HL,(ATRBAS) + ADD HL,DE + RET + +; Routine at 1796 +; +; Used by the routines at GSPSIZ and _CALPAT. +_GSPSIZ: + LD A,(RG1SAV) + RRCA + RRCA + LD A,$08 + RET NC + LD A,$20 + RET + +; Routine at 1807 +; +; Used by the routines at LDIRMV and ESC_L_2. +_LDIRMV: + CALL _SETRD + EX (SP),HL + EX (SP),HL +_LDIRMV_0: + IN A,(VDP_DATAIN) + LD (DE),A + INC DE + DEC BC + LD A,C + OR B + JR NZ,_LDIRMV_0 + RET + +; Routine at 1822 +; +; Used by the routines at _INITXT and _INIT32. +COPY_FONT: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HINIP ; Hook to Copy character set to VDP +ENDIF + LD HL,(CGPBAS) + CALL _SETWRT + LD A,(SLOTID) + LD HL,(CHFONT) + LD BC,$0800 ; FONT LENGTH: 2048 bytes + PUSH AF +COPY_FONT_0: + POP AF + PUSH AF + PUSH BC + DI + CALL _RDSLT + EI + POP BC + OUT (VDP_DATA),A + INC HL + DEC BC + LD A,C + OR B + JR NZ,COPY_FONT_0 + POP AF + RET + +; Routine at 1860 +; +; Used by the routines at LDIRVM and RESET_CONSOLE. +_LDIRVM: + EX DE,HL + CALL _SETWRT +_LDIRVM_0: + LD A,(DE) + OUT (VDP_DATA),A + INC DE + DEC BC + LD A,C + OR B + JR NZ,_LDIRVM_0 + RET + +; Routine at 1874 +; +; Used by the routine at _GRPPRT. +L0752: + LD H,$00 + LD L,A + ADD HL,HL + ADD HL,HL + ADD HL,HL + EX DE,HL + LD HL,(CHFONT) + ADD HL,DE + LD DE,PATWRK + LD B,$08 + LD A,(SLOTID) +L0752_0: + PUSH AF + PUSH HL + PUSH DE + PUSH BC + CALL _RDSLT + EI + POP BC + POP DE + POP HL + LD (DE),A + INC DE + INC HL + POP AF + DJNZ L0752_0 + RET + +; Routine at 1911 +; +; Used by the routine at _CLS. +CLS: + CALL IS_TXT + JR Z,CLS_TXT + JR NC,CLS_MLT +; This entry point is used by the routines at _INITXT and _INIT32. +CLS_FORMFEED: + LD A,(SCRMOD) + AND A + LD HL,(NAMBAS) + LD BC,$03C0 ; 960 (40*24) + JR Z,CLS_1 + LD BC,$0300 ; 768 (32x24) +CLS_1: + LD A,' ' + CALL _FILVRM + CALL CURS_HOME + LD HL,LINTTB + LD B,$18 +CLS_2: + LD (HL),B + INC HL + DJNZ CLS_2 + JP _FNKSB ; Check if function key display is active, and display the FN list if so... + +; Routine at 1953 +; +; Used by the routines at _INIGRP and CLS. +CLS_TXT: + CALL RESTORE_BORDER + LD BC,$1800 + PUSH BC + LD HL,(GRPCOL) ; SCREEN 2 color table + LD A,(BAKCLR) + CALL _FILVRM + LD HL,(GRPCGP) ; SCREEN 2 character pattern table + POP BC + XOR A + ; --- START PROC L07B6 --- +__FILVRM: + JP _FILVRM + +; Data block at 1977 + ; --- START PROC CLS_MLT --- +CLS_MLT: + CALL RESTORE_BORDER + LD HL,BAKCLR + LD A,(HL) + ADD A,A + ADD A,A + ADD A,A + ADD A,A + OR (HL) + LD HL,(MLTCGP) ; SCREEN 3 character pattern table + LD BC,$0600 ; 64*24 + JR __FILVRM + +; Routine at 1997 +; +; Used by the routines at WRTVRM, _CLRSPR, _NSETCX and SETC_GFX_4. +_WRTVRM: + PUSH AF + CALL _SETWRT + EX (SP),HL + EX (SP),HL + POP AF + OUT (VDP_DATA),A + RET + +; Routine at 2007 +; +; Used by the routines at RDVRM and L166C. +; $07D7 +_RDVRM: + CALL _SETRD + EX (SP),HL + EX (SP),HL + IN A,(VDP_DATAIN) + RET + +; Routine at 2015 +; +; Used by the routines at SETWRT, _INIGRP, _INIMLT, COPY_FONT, _LDIRVM, _WRTVRM, ESC_CLINE and +; OUT_CHAR. +_SETWRT: + LD A,L + DI + OUT (VDP_CMD),A + LD A,H + AND $3F + OR $40 + OUT (VDP_CMD),A + EI + RET + +; Routine at 2028 +; +; Used by the routines at SETRD, _LDIRMV, _RDVRM and GETCOD. +_SETRD: + LD A,L + DI + OUT (VDP_CMD),A + LD A,H + AND $3F + OUT (VDP_CMD),A + EI + RET + + ; --- START PROC L07F7 --- +_CHGCLR: + LD A,(SCRMOD) + DEC A + JP M,_CHGCLR_0 + PUSH AF + CALL RESTORE_BORDER + POP AF + RET NZ + LD A,(FORCLR) ; Foreground color + ADD A,A + ADD A,A + ADD A,A + ADD A,A + LD HL,BAKCLR + OR (HL) + LD HL,(T32COL) ; SCREEN 1 color table + LD BC,32 + +_FILVRM: + PUSH AF + CALL _SETWRT +_FILVRM_0: + POP AF + OUT (VDP_DATA),A + PUSH AF + DEC BC + LD A,C + OR B + JR NZ,_FILVRM_0 + POP AF + RET + +_CHGCLR_0: + LD A,(FORCLR) ; Foreground color + ADD A,A + ADD A,A + ADD A,A + ADD A,A + LD HL,BAKCLR + OR (HL) + LD B,A + JR SETBORDER + + +; Routine at 2098 +; +; Used by the routine at CLS_TXT. +RESTORE_BORDER: + LD A,(BDRCLR) +SETBORDER: + LD B,A + LD C,$07 + JP _WRTVDP + +; Routine at 2107 +; +; Used by the routines at TOTEXT and L043F. +_TOTEXT: + CALL IS_TXT + RET C + LD A,(OLDSCR) +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HTOTE ; Hook for the TOTEXT std routine +ENDIF + JP _CHGMOD ; Sets the VDP mode according to SCRMOD. + +; Routine at 2120 +; +; Used by the routine at __CLS. +_CLS: + RET NZ + PUSH HL + CALL CLS + POP HL + RET + +; Routine at 2127 +; +; Used by the routines at CHGMOD and _TOTEXT. +; Sets the VDP mode according to SCRMOD. +_CHGMOD: + DEC A + JP M,_INITXT + JP Z,_INIT32 + DEC A + JP Z,_INIGRP + JP _INIMLT + +; Routine at 2141 +; +; Used by the routines at LPTOUT and L1BA2. +_LPTOUT: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HLPTO ; Hook for "LPTOUT" +ENDIF + PUSH AF +_LPTOUT_0: + CALL _BREAKX ; Set CY if STOP is pressed + JR C,LPTOUT_BRK + CALL _LPTSTT + JR Z,_LPTOUT_0 + POP AF +; This entry point is used by the routine at LPTOUT_BRK. +_LPTOUT_1: + PUSH AF + OUT (PRN_DATA),A + XOR A + OUT (PRN_STB),A + DEC A + OUT (PRN_STB),A + POP AF + AND A + RET + + +; Routine at 2168 +; +; Used by the routine at _LPTOUT. +LPTOUT_BRK: + XOR A + LD (LPTPOS),A + LD A,CR + CALL _LPTOUT_1 + POP AF + SCF + RET + +; Routine at 2180 +; +; Used by the routines at LPTSTT and _LPTOUT. +_LPTSTT: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HLPTS ; Hook for LPTSTT +ENDIF + IN A,(PRN_STATUS) + RRCA + RRCA + CCF + SBC A,A + RET + +; Routine at 2190 +; +; Used by the routines at POSIT and TTY_CR. +_POSIT: ; Locate cursor at the specified position + LD A,ESC + RST OUTDO ; Output char to the current device + LD A,'Y' ; ESC_Y, set cursor coordinates + RST OUTDO ; Output char to the current device + LD A,L + ADD A,$1F ; L+31 + RST OUTDO ; Output char to the current device + LD A,H + ADD A,$1F ; H+31 + RST OUTDO ; Output char to the current device + RET + +; Routine at 2205 +; +; Used by the routines at SNVCHR, CHPUT_CONT, _FNKSB and OUTC_TABEXP. +; A.K.A. CNVCHR (Convert Character) +_SNVCHR: + PUSH HL + PUSH AF + LD HL,GRPHED + XOR A + CP (HL) + LD (HL),A + JR Z,_SNVCHR_SUB + POP AF + SUB $40 ; 'A'-1 ? + CP $20 + JR C,_SNVCHR_1 + ADD A,$40 +; This entry point is used by the routine at _SNVCHR_SUB. +_SNVCHR_0: + CP A + SCF +_SNVCHR_1: + POP HL + RET + +; Routine at 2228 +; +; Used by the routine at _SNVCHR. +_SNVCHR_SUB: + POP AF + CP $01 + JR NZ,_SNVCHR_0 + LD (HL),A + POP HL + RET + +; Routine at 2236 +; +; Used by the routines at CHPUT and _OUTCON. +_CHPUT: + PUSH HL + PUSH DE + PUSH BC + PUSH AF +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HCHPU ; Hook for CHPUT event (A-character; SAVE ALL) +ENDIF + CALL IS_TXT + JR NC,_POPALL + CALL ERASE_CURSOR + POP AF + PUSH AF + CALL CHPUT_CONT + CALL DISP_CURSOR + LD A,(CSRX) + DEC A + LD (TTYPOS),A +; This entry point is used by the routines at _INITIO and _GRPPRT_4. +_POPALL: + POP AF +; This entry point is used by the routines at L0D89, _CHGET and L11E2. +_CHPUT_1: + POP BC + POP DE + POP HL + RET + +; Routine at 2271 +; +; Used by the routines at _CHPUT and CURS_TAB. +CHPUT_CONT: + CALL _SNVCHR ; Convert character + RET NC + LD C,A + JR NZ,L08F3 + LD HL,ESCCNT + LD A,(HL) + AND A ; Are we in ESCAPE or in some special 'control code' mode ? + JP NZ,IN_ESC + LD A,C + CP ' ' ;IS THIS A MEANINGFUL CHARACTER? + JR C,TRYOUT ;IF IT'S A NON-PRINTING CHARACTER +L08F3: + LD HL,(CSRY) +IF SPECTRUM_SKIN + ; Unbind CHR$(127) and make it printable +ELSE + CP $7F ; 'DEL' key code + JP Z,DELCHR +ENDIF + CALL OUT_CHAR + CALL ESC_C + RET NZ + XOR A + CALL SETTRM + LD H,$01 +CURS_LF: + CALL CURS_DOWN + RET NZ + CALL SV_CURS_POS + LD L,$01 + JP ESC_M_0 ; ESC,"M", delete line + +; Routine at 2324 +; +; Used by the routine at CHPUT_CONT. +; $0914: Character control code processor +TRYOUT: + LD HL,TTY_CTLCODES-2 + LD C,12 +; This entry point is used by the routines at IN_ESC and _QINLIN. +; Parse the jump table in HL for C entries +TTY_JP: + INC HL + INC HL + AND A + DEC C + RET M + CP (HL) + INC HL + JR NZ,TTY_JP + LD C,(HL) + INC HL + LD B,(HL) + LD HL,(CSRY) + CALL JP_BC + XOR A + RET + +; Routine at 2349 +; +; Used by the routine at TRYOUT. +JP_BC: + PUSH BC + RET + +; First TTY JP table (12 entries) +TTY_CTLCODES: + + DEFB BEL ; BELL, go beep + DEFW _BEEP + + DEFB $08 ; BS, cursor left + DEFW CURS_LEFT + + DEFB $09 ; TAB, cursor to next tab position + DEFW CURS_TAB + + DEFB LF ; LF, cursor down a row + DEFW CURS_LF + + DEFB $0b ; HOME, cursor to home + DEFW CURS_HOME + + DEFB FF ; FORMFEED, clear screen and home + DEFW CLS_FORMFEED + + DEFB $0d ; CR, cursor to leftmost column + DEFW CURS_CR + + DEFB $1b ; ESC, enter escape sequence + DEFW ENTER_ESC + + DEFB $1c ; RIGHT, cursor right + DEFW CURS_RIGHT + + DEFB $1d ; LEFT, cursor left + DEFW CURS_LEFT + + DEFB $1e ; UP, cursor up + DEFW CURS_UP + + DEFB $1f ; DOWN, cursor down. + DEFW CURS_DOWN + + +; Second TTY JP table (15 entries) +TTY_ESC: + DEFB 'j' ; ESC,"j", clear screen and home + DEFW CLS_FORMFEED + + DEFB 'E' ; ESC,"E", clear screen and home + DEFW CLS_FORMFEED + + DEFB 'K' ; ESC,"K", clear to end of line + DEFW ESC_K + + DEFB 'J' ; ESC,"J", clear to end of screen + DEFW ESC_J + + DEFB 'l' ; ESC,"l", clear line + DEFW ESC_CLINE + + DEFB 'L' ; ESC,"L", insert line + DEFW ESC_L + + DEFB 'M' ; ESC,"M", delete line + DEFW ESC_M + + DEFB 'Y' ; ESC,"Y", set cursor coordinates + DEFW ESC_Y + + DEFB 'A' ; ESC,"A", cursor up + DEFW CURS_UP + + DEFB 'B' ; ESC,"B", cursor down + DEFW CURS_DOWN + + DEFB 'C' ; ESC,"C", cursor right + DEFW ESC_C + + DEFB 'D' ; ESC,"D", cursor left + DEFW ESC_D+1 + + DEFB 'H' ; ESC,"H", cursor home + DEFW CURS_HOME + + DEFB 'x' ; ESC,"x", change cursor + DEFW ESC_CURSOR_X + + DEFB 'y' ; ESC,"y", change cursor + DEFW ESC_CURSOR_Y + + +ESC_CURSOR_X: +; ESC,"x", change cursor, see ESC_CURS + LD A,$01 + + DEFB $01 ; "LD BC,nn" to jump over the next word without executing it +ESC_CURSOR_Y: +; ESC,"y", change cursor, see ESC_CURS + LD A,$02 + + DEFB $01 ; "LD BC,nn" to jump over the next word without executing it +; ESC,"Y", set cursor coordinates, see ESC_CURS +ESC_Y: + LD A,$04 + + DEFB $01 ; "LD BC,nn" to jump over the next word without executing it +; 'ESCAPE' sequence handling +ENTER_ESC: + LD A,$FF + +L098B: + LD (ESCCNT),A + RET + +; Routine at 2447 +; +; Used by the routine at CHPUT_CONT. +; "ESC sequence processor" +IN_ESC: + JP P,ESC_CURS +; In-Escape + LD (HL),$00 + LD A,C + LD HL,TTY_ESC-2 + LD C,15 + JP TTY_JP + +; Routine at 2461 +; +; Used by the routine at IN_ESC. +; different "Escape-Like" status flags +ESC_CURS: + DEC A + JR Z,CHG_CURSOR_X ; ESC,"x", change cursor + DEC A + JR Z,CHG_CURSOR_Y ; ESC,"y", change cursor + DEC A +; ESC,"Y", set cursor coordinates (row,column) + LD (HL),A + LD A,(LINLEN) + LD DE,CSRX + JR Z,ESC_CURS_0 + LD (HL),$03 + CALL TEXT_LINES + DEC DE +ESC_CURS_0: + LD B,A + LD A,C + SUB $20 ;Top left of screen is n=m=20h. + CP B + INC A + LD (DE),A + RET C + LD A,B + LD (DE),A + RET + +; Routine at 2494 +; +; Used by the routine at ESC_CURS. +CHG_CURSOR_X: + LD (HL),A + LD A,C + SUB '4' + JR Z,SET_CSTYLE ; Set block cursor style + DEC A ; Cursor off + JR Z,SET_CRSW + RET + +; Routine at 2504 +; +; Used by the routine at ESC_CURS. +CHG_CURSOR_Y: + LD (HL),A + LD A,C + SUB '4' + JR NZ,CURSOR_ON + + INC A ; Set underscore cursor style +; This entry point is used by the routine at CHG_CURSOR_X. +SET_CSTYLE: + LD (CSTYLE),A + RET + +; Routine at 2515 +; +; Used by the routine at CHG_CURSOR_Y. +CURSOR_ON: + DEC A + RET NZ + INC A +; This entry point is used by the routine at CHG_CURSOR_X. +SET_CRSW: + LD (CSRSW),A + RET + +; Routine at 2522 +; +; Used by the routines at _ISCNTC and _CHGET. +L09DA: + LD A,(CSRSW) + AND A + RET NZ + JR DISP_CURSOR_0 + +; Routine at 2529 +; +; Used by the routines at _CHPUT, L2428, TTY_CR, L24F2, L2535, L2550 and L25CD. +DISP_CURSOR: + LD A,(CSRSW) + AND A + RET Z +; This entry point is used by the routine at L09DA. +DISP_CURSOR_0: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HDSPC ; Hook for "Display Cursor" event +ENDIF + CALL IS_TXT + RET NC + LD HL,(CSRY) + PUSH HL + CALL GETCOD + LD (CODSAV),A + LD L,A + LD H,$00 + ADD HL,HL + ADD HL,HL + ADD HL,HL + EX DE,HL + LD HL,(CGPBAS) +; L0A01: + PUSH HL + ADD HL,DE + CALL RD_CURSOR_PIC + LD HL,LINWRK + 7 ; $FC1F + LD B,$08 ; block cursor style + LD A,(CSTYLE) + AND A + JR Z,DISP_CURSOR_1 + LD B,$03 ; "underscore" cursor style +DISP_CURSOR_1: + LD A,(HL) + CPL ; Toggle cursor block + LD (HL),A + DEC HL + DJNZ DISP_CURSOR_1 + POP HL + LD BC,$07F8 ; 2040 + ADD HL,BC + CALL WR_CURSOR_PIC + POP HL + LD C,$FF + JP OUT_CHAR + +; Routine at 2599 +; +; Used by the routines at _ISCNTC and _CHGET. +L0A27: + LD A,(CSRSW) + AND A + RET NZ + JR ERASE_CURSOR_0 + +; Routine at 2606 +; +; Used by the routines at _CHPUT, L2428, TTY_CR, L24F2, L2550, L25AE, L25B9, +; L25D7, L25F8 and L260E. +ERASE_CURSOR: + LD A,(CSRSW) + AND A + RET Z +; This entry point is used by the routine at L0A27. +ERASE_CURSOR_0: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HERAC ; Hook for "Erase cursor" event +ENDIF + CALL IS_TXT + RET NC + LD HL,(CSRY) + LD A,(CODSAV) + LD C,A + JP OUT_CHAR + +; Routine at 2628 +; +; Used by the routines at CHPUT_CONT and CURS_RIGHT. +; ESC,"C", cursor right +ESC_C: + LD A,(LINLEN) + CP H + RET Z + INC H + JR SV_CURS_POS + +; Routine at 2636 +; +; Used by the routines at DELCHR and L2634. +CURS_LEFT: + CALL ESC_D+1 ; ESC,"D", cursor left + RET NZ + LD A,(LINLEN) + LD H,A +ESC_D: + ; ESC_D+1: DEC H / LD A,n (Toggle DEC H / DEC L) + LD DE,$3E25 +CURS_UP: + DEC L + RET Z + JR SV_CURS_POS + +; Routine at 2651 +; +; Used by the routines at L25D7, L260E and L2624. +CURS_RIGHT: + CALL ESC_C ; ESC,"C", cursor right + RET NZ + LD H,$01 +; This entry point is used by the routine at CHPUT_CONT. +CURS_DOWN: + CALL TEXT_LINES + CP L + RET Z + JR C,L0A6D + INC L +; This entry point is used by the routines at CHPUT_CONT, ESC_C, CURS_LEFT, L0A6D and CURS_HOME. +SV_CURS_POS: + LD (CSRY),HL + RET + +; Routine at 2669 +; +; Used by the routine at CURS_RIGHT. +L0A6D: + DEC L + XOR A + JR SV_CURS_POS + +; Routine at 2673 +CURS_TAB: + LD A,' ' + CALL CHPUT_CONT + LD A,(CSRX) + DEC A + AND $07 + JR NZ,CURS_TAB + RET + +; Routine at 2687 +; +; Used by the routine at CLS. +CURS_HOME: + LD L,$01 +; This entry point is used by the routines at ESC_M and ESC_L. +CURS_CR: + LD H,$01 + JR SV_CURS_POS + +; Routine at 2693 +; ESC,"M", delete line +ESC_M: + CALL CURS_CR +; This entry point is used by the routines at CHPUT_CONT and L2535. +ESC_M_0: + CALL TEXT_LINES + SUB L + RET C + JP Z,ESC_CLINE ; ESC,"l", clear line + PUSH HL + PUSH AF + LD C,A + LD B,$00 + CALL GETTRM + LD L,E + LD H,D + INC HL + LDIR + LD HL,FSTPOS + DEC (HL) + POP AF + POP HL +ESC_M_1: + PUSH AF + INC L + CALL ESC_L_2 + DEC L + CALL RESET_CONSOLE + INC L + POP AF + DEC A + JR NZ,ESC_M_1 + JP ESC_CLINE ; ESC,"l", clear line + +; Routine at 2740 +; ESC,"L", insert line +ESC_L: + CALL CURS_CR +; This entry point is used by the routine at L2524. +ESC_L_0: + CALL TEXT_LINES + LD H,A + SUB L + RET C + JP Z,ESC_CLINE ; ESC,"l", clear line + LD L,H + PUSH HL + PUSH AF + LD C,A + LD B,$00 + CALL GETTRM + LD L,E + LD H,D + PUSH HL + DEC HL + LDDR + POP HL + LD (HL),H + POP AF + POP HL +ESC_L_1: + PUSH AF + DEC L + CALL ESC_L_2 + INC L + CALL RESET_CONSOLE + DEC L + POP AF + DEC A + JR NZ,ESC_L_1 + JR ESC_CLINE ; ESC,"l", clear line + +; Routine at 2787 +; +; Used by the routine at CHPUT_CONT. +; Outputting the code for 'DELETE' +DELCHR: + CALL CURS_LEFT + RET Z + LD C,' ' + JP OUT_CHAR + +; Routine at 2796 +; +; Used by the routines at ESC_M, ESC_L and _ERAFNK. +; ESC,"l", clear line +ESC_CLINE: + LD H,$01 +; This entry point is used by the routines at ESC_J and L25B9. +; ESC,"K", clear to end of line +ESC_K: + CALL TERMIN + PUSH HL + CALL TXT_LOC + CALL _SETWRT + POP HL +ESC_CLINE_1: + LD A,' ' + OUT (VDP_DATA),A + INC H + LD A,(LINLEN) + CP H + JR NC,ESC_CLINE_1 + RET + +; Routine at 2821 +; ESC,"J", clear to end of screen +ESC_J: + PUSH HL + CALL ESC_K ; ESC,"K", clear to end of line + POP HL + CALL TEXT_LINES + CP L + RET C + RET Z + LD H,$01 + INC L + JR ESC_J + +; Routine at 2837 +; +; Used by the routine at ERAFNK. +_ERAFNK: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HERAF ; Hook for ERAFNK std routine(no param.) +ENDIF + XOR A + CALL UPD_CNSDFG + RET NC + PUSH HL + LD HL,(CRTCNT) + CALL ESC_CLINE ; ESC,"l", clear line + POP HL + RET + +; Routine at 2854 +; +; Used by the routines at FNKSB and CLS. +; Check if function key display is active, and display the FN list if so... +_FNKSB: + LD A,(CNSDFG) ; FN key status + AND A + RET Z + +; This entry point is used by the routines at DSPFNK and _CHSNS. +; Show the function key display. +_DSPFNK: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HDSPF ; Hook for DSPFNK std routine(no param.) +ENDIF + LD A,$FF + CALL UPD_CNSDFG + RET NC + PUSH HL + LD A,(CSRY) + LD HL,CRTCNT + CP (HL) + LD A,LF + JR NZ,_FNKSB_1 + RST OUTDO ; Output char to the current device +_FNKSB_1: + LD A,($FBEB) ; KBD ROW #6 + RRCA + LD HL,FNKSTR + LD A,$01 + JR C,_FNKSB_2 + LD HL,FNKSTR+80 + XOR A +_FNKSB_2: + LD (FNKSWI),A + LD DE,LINWRK + PUSH DE + LD B,40 + LD A,' ' +_FNKSB_3: + LD (DE),A + INC DE + DJNZ _FNKSB_3 + POP DE + LD C,$05 + LD A,(LINLEN) + SUB $04 + JR C,_FNKSB_8 + LD B,$FF +_FNKSB_4: + INC B + SUB $05 + JR NC,_FNKSB_4 + LD A,B + AND A + JR Z,_FNKSB_8 + + DEFB $3E ; "LD A,n" to Mask the next byte +L0B75: + INC DE + PUSH BC + LD C,$00 +_FNKSB_5: + LD A,(HL) + INC HL + INC C + CALL _SNVCHR + JR NC,_FNKSB_5 + JR NZ,_FNKSB_6 + CP ' ' + JR C,_FNKSB_7 +_FNKSB_6: + LD (DE),A +_FNKSB_7: + INC DE + DJNZ _FNKSB_5 + LD A,$10 + SUB C + LD C,A + ADD HL,BC + POP BC + DEC C + JR NZ,L0B75 +_FNKSB_8: + LD HL,(CRTCNT) + CALL RESET_CONSOLE + POP HL + RET + +; Routine at 2972 +; +; Used by the routines at _ERAFNK and _FNKSB. +UPD_CNSDFG: + LD (CNSDFG),A ; FN key status +; This entry point is used by the routines at CLS, _TOTEXT, _CHPUT, DISP_CURSOR, ERASE_CURSOR and _CHSNS. +IS_TXT: + LD A,(SCRMOD) + CP $02 + RET + +; Routine at 2981 +; +; Used by the routine at DISP_CURSOR. +RD_CURSOR_PIC: + PUSH HL + LD C,$08 ; 8 bytes for cursor "shape" + JR ESC_L_2_0 + +; Routine at 2986 +; +; Used by the routines at ESC_M and ESC_L. +ESC_L_2: + PUSH HL + LD H,$01 + CALL TXT_LOC + LD A,(LINLEN) + LD C,A +; This entry point is used by the routine at RD_CURSOR_PIC. +ESC_L_2_0: + LD B,$00 ; byte counter in C only + LD DE,LINWRK + CALL _LDIRMV ; VRAM to DE + POP HL + RET + +; Routine at 3006 +; +; Used by the routine at DISP_CURSOR. +WR_CURSOR_PIC: + PUSH HL + LD C,$08 ; 8 bytes for cursor "shape" + JR RESET_CONSOLE_0 + +; Routine at 3011 +; +; Used by the routines at ESC_M, ESC_L and _FNKSB. +RESET_CONSOLE: + PUSH HL + LD H,$01 + CALL TXT_LOC + LD A,(LINLEN) + LD C,A +; This entry point is used by the routine at WR_CURSOR_PIC. +RESET_CONSOLE_0: + LD B,$00 + EX DE,HL + LD HL,LINWRK + CALL _LDIRVM + POP HL + RET + +; Routine at 3032 +; +; Used by the routines at DISP_CURSOR, TTY_CR, L24F2, L2550, L25D7 and L2634. +GETCOD: + PUSH HL + CALL TXT_LOC + CALL _SETRD + EX (SP),HL + EX (SP),HL + IN A,(VDP_DATAIN) + LD C,A + POP HL + RET + +; Routine at 3046 +; +; Used by the routines at CHPUT_CONT, DISP_CURSOR, ERASE_CURSOR, DELCHR, L24F2 and L2550. +; +OUT_CHAR: + PUSH HL + CALL TXT_LOC + CALL _SETWRT + LD A,C + OUT (VDP_DATA),A + POP HL + RET + +; Routine at 3058 +; +; Used by the routines at ESC_CLINE, ESC_L_2, RESET_CONSOLE, GETCOD and OUT_CHAR. +TXT_LOC: + PUSH BC + LD E,H + LD H,$00 + LD D,H + DEC L + ADD HL,HL + ADD HL,HL + ADD HL,HL ; *8 + LD C,L + LD B,H + ADD HL,HL + ADD HL,HL ; *32 + ADD HL,DE ; -> *40 + LD A,(SCRMOD) + AND A + LD A,(LINLEN) + JR Z,TXTLOC_SUB + SUB $22 + JR TXTLOC_SUB_0 + +; Routine at 3085 +; +; Used by the routine at TXT_LOC. +TXTLOC_SUB: + ADD HL,BC + SUB $2A ; '*'? TK_CVD ? +; This entry point is used by the routine at TXT_LOC. +TXTLOC_SUB_0: + CPL + AND A + RRA + LD E,A + ADD HL,DE + EX DE,HL + LD HL,(NAMBAS) + ADD HL,DE + DEC HL + POP BC + RET + +; Routine at 3101 +; +; Used by the routines at ESC_M, ESC_L, TERMIN, TTY_CR, L24C4, L24F2, L2550, +; L25B9, L25D7 and L266C. +; LD A,(DE+L) .. +GETTRM: + PUSH HL + LD DE,BASROM + LD H,$00 + ADD HL,DE + LD A,(HL) + EX DE,HL + POP HL + AND A + RET + +; Routine at 3113 +; +; Used by the routines at ESC_CLINE, _QINLIN and TTY_CR. +TERMIN: + ;TERMIN+1: XOR A + LD A,$AF +; This entry point is used by the routine at CHPUT_CONT. +SETTRM: + PUSH AF + CALL GETTRM + POP AF + LD (DE),A + RET + +; Routine at 3122 +; +; Used by the routines at ESC_CURS, CURS_RIGHT, ESC_M, ESC_L, ESC_J, L2524 and L2624. +TEXT_LINES: + LD A,(CNSDFG) ; FN key status + PUSH HL + LD HL,CRTCNT + ADD A,(HL) ; Number of lines on screen + POP HL + RET + +; This entry point is used by the routine at KEYINT. +_KEYINT: + PUSH HL + PUSH DE + PUSH BC + PUSH AF + EXX + EX AF,AF' + PUSH HL + PUSH DE + PUSH BC + PUSH AF + PUSH IY + PUSH IX +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HKEYI ; First interrupt handler hook +ENDIF + IN A,(VDP_STATUS) + AND A + JP P,_KEYINT_2 +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HTIMI ; Hook 2 for Interrupt handler + ENDIF + EI + LD (STATFL),A + AND $20 + LD HL,IFLG_COLLSN ; Sprite collision - Interrupt flags + CALL NZ,TST_IFLG_EVENT + LD HL,(INTCNT) + DEC HL + LD A,H + OR L + JR NZ,_KEYINT_0 + LD HL,IFLG_TIMER ; TIMER - Interrupt flags + CALL TST_IFLG_EVENT + LD HL,(INTVAL) +_KEYINT_0: + LD (INTCNT),HL + LD HL,(JIFFY) + INC HL + LD (JIFFY),HL + LD A,(MUSICF) + LD C,A + XOR A +_KEYINT_1: + RR C + PUSH AF + PUSH BC + CALL C,L113B + POP BC + POP AF + INC A + CP $03 + JR C,_KEYINT_1 + LD HL,SCNCNT ; a.k.a. KYREPT, Wait count for repeat + DEC (HL) + JR NZ,_KEYINT_2 + LD (HL),$01 + XOR A + CALL _GTSTCK_2 + AND $30 + PUSH AF + LD A,$01 + CALL _GTSTCK_2 + AND $30 + RLCA + RLCA + POP BC + OR B + PUSH AF + CALL _GTSTCK_5 + AND $01 + POP BC + OR B + LD C,A + LD HL,TRGFLG + XOR (HL) + AND (HL) + LD (HL),C + LD C,A + RRCA + LD HL,IFLG_STRIG0 ; SPACE key trigger - Interrupt flags + CALL C,TST_IFLG_EVENT + RL C + LD HL,IFLG_STRIG4 ; Joystick 2, Fire 2 - Interrupt flags + CALL C,TST_IFLG_EVENT + RL C + LD HL,IFLG_STRIG2 ; Joystick 2, Fire 1 - Interrupt flags + CALL C,TST_IFLG_EVENT + RL C + LD HL,IFLG_STRIG3 ; Joystick 1, Fire 2 - Interrupt flags + CALL C,TST_IFLG_EVENT + RL C + LD HL,IFLG_STRIG1 ; Joystick 1, Fire 1 - Interrupt flags + CALL C,TST_IFLG_EVENT + XOR A + LD (CLIKFL),A + CALL L0D12 + JR NZ,_KEYINT_2 + LD HL,REPCNT + DEC (HL) + JR NZ,_KEYINT_2 + LD (HL),$01 + LD HL,OLDKEY + LD DE,OLDKEY+1 + LD BC,$000A + LD (HL),$FF + LDIR + CALL L0D49_0 +_KEYINT_2: + POP IX + POP IY + POP AF + POP BC + POP DE + POP HL + EX AF,AF' + EXX + POP AF + POP BC + POP DE + POP HL + EI + RET + +; Routine at 3346 +; +; Used by the routine at _KEYINT. +L0D12: + IN A,(PPI_C) ; $9A on SVI + AND $F0 + LD C,A + LD B,$0B + LD HL,NEWKEY +L0D12_0: + LD A,C + OUT (PPI_COUT),A ; $96 on SVI + IN A,(PPI_B) ; $99 on SVI + LD (HL),A + INC C + INC HL + DJNZ L0D12_0 + LD A,(ENSTOP) + AND A + JR Z,L0D3A + +L0D2C: + LD A,($FBEB) ; KBD ROW #6 + CP $E8 ; CTRL-STOP ? + JR NZ,L0D3A + LD IX,READYR + JP _CALBAS + +; Routine at 3386 +; +; Used by the routine at L0D12. +L0D3A: + LD DE,NEWKEY + LD B,$0B +L0D3A_0: + DEC DE + DEC HL + LD A,(DE) + CP (HL) + JR NZ,L0D49 + DJNZ L0D3A_0 + JR L0D49_0 + +; Routine at 3401 +; +; Used by the routine at L0D3A. +L0D49: + LD A,$0D + LD (REPCNT),A +; This entry point is used by the routines at _KEYINT and L0D3A. +L0D49_0: + LD B,$0B + LD HL,OLDKEY + LD DE,NEWKEY +L0D49_1: + LD A,(DE) + LD C,A + XOR (HL) + AND (HL) + LD (HL),C + CALL NZ,L0D89 + INC DE + INC HL + DJNZ L0D49_1 +; This entry point is used by the routine at _CHSNS. +L0D49_2: + LD HL,(GETPNT) + LD A,(PUTPNT) + SUB L + RET + +; Routine at 3434 +; +; Used by the routines at CHSNS and _CHGET. +_CHSNS: + EI + PUSH HL + PUSH DE + PUSH BC + CALL IS_TXT + JR NC,_CHSNS_0 + LD A,(FNKSWI) + LD HL,$FBEB ; KBD ROW #6 + XOR (HL) + LD HL,CNSDFG ; FN key status + AND (HL) + RRCA + CALL C,_DSPFNK ; Show the function key display. +_CHSNS_0: + CALL L0D49_2 + POP BC + POP DE + POP HL + RET + +; Routine at 3465 +; +; Used by the routine at L0D49. +L0D89: + PUSH HL + PUSH DE + PUSH BC + PUSH AF + LD A,$0B + SUB B + ADD A,A + ADD A,A + ADD A,A + LD C,A + LD B,$08 + POP AF +L0D97: + RRA + PUSH BC + PUSH AF + CALL C,SCAN_KEYBOARD + POP AF + POP BC + INC C + DJNZ L0D97 + JP _CHPUT_1 + +; Message at 3493 +KEYMAP: + DEFM "0123456789-=" + DEFB '\\' + DEFM "[];'`,./" + DEFB $FF + +; Message at 3515 +L0DBB: + DEFM "abcdefghijklmnopqrstuvwxyz" + DEFM ")!@#$%^&*(_+|{}:" + DEFB '"' + DEFM "~<>?" + DEFB $FF + +; Message at 3563 +L0DEB: + DEFM "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + DEFB $09 + + +L0E06: + DEFB $ac,$ab,$ba,$ef,$bd,$f4,$fb,$ec,$07,$17,$f1,$1e,$01,$0d,$06,$05 + DEFB $bb,$f3,$f2,$1d + DEFB $FF + + DEFB $c4,$11,$bc,$c7 + +L0E1F: + CALL L1514 + INC DE + CALL C,$DDC6 + RET Z + DEC BC + DEC DE + JP NZ,$CCDB + JR L0E1F-$1F ;$0E00 (??) + +; Data block at 3630 +L0E2E: + DEFB $12,$C0,$1A,$CF,$1C,$19,$0F,$0A + DEFB $00,$FD,$FC,$00 + +L0E3A: ; Later we have a reference to $0E3A, but perhaps they are not bound + DEFB $00,$F5,$00,$00 + DEFB $08 + DEFB $1F,$F0,$16,$02 + DEFB $0E,$04,$03 + DEFB $F7,$AE,$AF,$F6,$FF,$FE,$00,$FA + DEFB $C1 + + DEFB $CE,$D4 + DEFB $10,$D6 + DEFB $DF,$CA + DEFB $DE,$C9 + DEFB $0C,$D3 + + DEFB $C3,$D7 + DEFB $CB,$A9 + DEFB $D1 + + DEFB $00,$C5,$D5,$D0,$F9,$AA,$F8,$EB + DEFB $9F,$D9,$BF,$9B,$98,$E0,$E1,$E7 + DEFB $87,$EE,$E9,$00,$ED,$DA,$B7,$B9 + DEFB $E5,$86,$A6,$A7,$FF,$84,$97,$8D + DEFB $8B,$8C,$94,$81,$B1,$A1,$91,$B3 + DEFB $B5,$E6,$A4,$A2,$A3,$83,$93,$89 + DEFB $96,$82,$95,$88,$8A,$A0,$85,$D8 + DEFB $AD,$9E,$BE,$9C,$9D,$00,$00,$E2 + DEFB $80,$00,$00,$00 + DEFB $E8,$EA,$B6,$B8,$E4,$8F,$00 + DEFB $A8,$FF,$8E + DEFB $00,$00,$00,$00 + DEFB $99,$9A,$B0,$00 + DEFB $92,$B2,$B4,$00 + DEFB $A5,$00,$E3,$00 + DEFB $00,$00,$00,$90,$00,$00,$00,$00,$00 + +L0EC5: + LD E,C + LD D,$00 + LD HL,$FB99 ; $FB99: Unknown System Variable, or -1127, -$0467 + ADD HL,DE + LD A,(HL) + AND A + JR NZ,L0EE3 +L0ED0: + EX DE,HL + ADD HL,HL + ADD HL,HL + ADD HL,HL + ADD HL,HL + LD DE,$F52F ; $F52F: Unknown System Variable or -2769, -$0AD1 + ADD HL,DE + EX DE,HL +L0EDA: + LD A,(DE) + AND A + RET Z + CALL K_L0F46_1 + INC DE + JR L0EDA + +; Routine at 3811 +L0EE3: + LD HL,(CURLIN) ; Line number the Basic interpreter is working on, in direct mode it will be filled with #FFFF + INC HL + LD A,H + OR L + JR Z,L0ED0 ; JP if in 'DIRECT' (immediate) mode + LD HL,$FBAD ; OLDKEY base address ? ($FD43 on SVI) + ADD HL,DE + ADD HL,DE + ADD HL,DE + +; This entry point is used by the routines at _ISCNTC and _KEYINT. +TST_IFLG_EVENT: + LD A,(HL) + AND $01 + RET Z + LD A,(HL) + OR $04 + CP (HL) + RET Z + LD (HL),A + XOR $05 + RET NZ + LD A,(ONGSBF) + INC A + LD (ONGSBF),A + RET + +IF NOHOOK + IF PRESERVE_LOCATIONS + ELSE + TRIM_0F00: + DEFS $0F00-TRIM_0F00 + ENDIF +ENDIF + +; Routine at 3846 +K_L0F06: + LD A,($FBEB) ; KBD ROW #6 + RRCA + LD A,$0C + SBC A,$00 + JR K_L0F46_1 + + + ; --- --- CODE CAN BE RELOCATED STARTING FROM HERE --- --- + +; Routine at 3856 +K_L0F10: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HKYEA ; Hook 1 for Keyboard decoder +ENDIF + LD E,A + LD D,$00 + ;LD HL,$1003 + LD HL,L1033-$30 + ADD HL,DE + LD A,(HL) + AND A + RET Z + JR K_L0F46_1 + +; Routine at 3871 +L0F1F: + LD A,($FBEB) ; KBD ROW #6 + LD E,A + OR $FE + BIT 4,E + JR NZ,L0F1F_0 + AND $FD +L0F1F_0: + CPL + INC A + LD (KANAST),A + JR K_L0F46_2 + + NOP + NOP + NOP + +; Routine at 3893 +L0F35: + RET + +; Routine at 3894 +K_CAPS: + LD HL,CAPST ; "capital status" flag, ( 00# = Off / FF# = On ) + LD A,(HL) + CPL + LD (HL),A + CPL +; This entry point is used by the routine at CHGCAP. +_CHGCAP: + AND A + LD A,$0C + JR Z,K_CAPS_1 + INC A +K_CAPS_1: + OUT (PPI_MOUT),A + RET + +; Routine at 3910 +K_L0F46: + LD A,($FBEB) ; KBD ROW #6 + RRCA + RRCA + LD A,$03 + JR NC,K_L0F46_0 + INC A +K_L0F46_0: + LD (INTFLG),A + JR C,K_L0F46_2 +; This entry point is used by the routines at K_L0F06, K_L0F10 and L0FD0. +K_L0F46_1: + LD HL,(PUTPNT) + LD (HL),A + CALL L105A+1 + LD A,(GETPNT) + CP L + RET Z + LD (PUTPNT),HL +; This entry point is used by the routine at L0F1F. +K_L0F46_2: + LD A,(CLIKSW) + AND A + RET Z + LD A,(CLIKFL) + AND A + RET NZ + LD A,$0F ; KBD click ? + LD (CLIKFL),A + OUT (PPI_MOUT),A + LD A,$0A ; KBD click ? +K_L0F46_3: + DEC A + JR NZ,K_L0F46_3 +; This entry point is used by the routine at CHGSND. +_CHGSND: + AND A + LD A,$0E + JR Z,_CHGSND_0 + INC A +_CHGSND_0: + OUT (PPI_MOUT),A + RET + + +K_L0F83: + LD A,($FBEB) ; KBD ROW #6 + LD E,A + RRA + RRA + PUSH AF + LD A,E + CPL + JR NC,K_L0F83_0 + RRA + RRA + RLCA + AND $03 + BIT 1,A + JR NZ,GET_KSYM + BIT 4,E + JR NZ,GET_KSYM + OR $04 + DEFB 17 ; "LD DE,nn" to jump over the next word without executing it +K_L0F83_0: + AND $01 + +GET_KSYM: + LD E,A + ADD A,A + ADD A,E + ADD A,A + ADD A,A + ADD A,A + ADD A,A + LD E,A + LD D,$00 + LD HL,KEYMAP ; Keyboard map ? + ADD HL,DE + LD B,D + ADD HL,BC + POP AF + LD A,(HL) + INC A + JP Z,L0F1F + DEC A + RET Z + JR C,L0FD0 + AND $DF ; TK_SPC ? + SUB $40 ; '@' + CP ' ' + RET NC +L0FC1: + JR K_L0F46_1 + + + +; Routine at 4035 +K_L0FC3: + LD A,($FBEB) ; KBD ROW #6 + RRCA + JR C,K_L0FC3_0 + LD A,C + ADD A,$05 + LD C,A +K_L0FC3_0: + JP L0EC5 + +; Routine at 4048 +L0FD0: + CP ' ' + JR NC,L0FDF + PUSH AF + LD A,$01 + CALL K_L0F46_1 + POP AF + ADD A,'A'-1 + JR L0FC1 + +; Routine at 4063 +; +; Used by the routine at L0FD0. +L0FDF: + LD HL,CAPST ; "capital status" flag + INC (HL) + DEC (HL) + JR Z,L0FDF_0 + CP 'a' ; Less than "a" ? + JR C,SEARCH ; Yes - search for words + CP 'z'+1 ; Greater than "z" ? + JR NC,SEARCH ; Yes - search for words + AND $DF ; TK_SPC ? +L0FDF_0: + LD DE,(KANAST) + INC E + DEC E + JR Z,L0FC1 + LD D,A + OR $20 + LD HL,L1066 + LD C,$06 + CPDR +L1003: + LD A,D + JR NZ,L0FC1 + INC HL + LD C,$06 +L1008: + ADD HL,BC + DEC E + JR NZ,L1008 + LD A,(HL) + BIT 5,D + JR NZ,L0FC1 +SEARCH: + LD C,$1F ; 31 + LD HL,L109D + CPDR + JR NZ,L0FC1 + LD C,$1F + INC HL + ADD HL,BC + LD A,(HL) + JR L0FC1 + +; Routine at 4129 +; +; Used by the routine at L0D89. +SCAN_KEYBOARD: + LD A,C + LD HL,L1B96 +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HKEYC ; Hook 2 for Keyboard decoder +ENDIF + LD D,$0F +SCAN_KEYBOARD_0: + CP (HL) + INC HL + LD E,(HL) + INC HL + PUSH DE + RET C + POP DE + JR SCAN_KEYBOARD_0 + + +;- Example of European Keyboard Layout +;FBE5 0 => 7 6 5 4 3 2 1 0 +;FBE6 1 => ; ] [ \ = - 9 8 +;FBE7 2 => B A ACCENT / . , ` ' +;FBE8 3 => J I H G F E D C +;FBE9 4 => R Q P O N M L K +;FBEA 5 => Z Y X W V U T S +;FBEB 6 => F3 F2 F1 CODE CAPS GRPH CTRL SHIFT +;FBEC 7 => RET SEL BS STOP TAB ESC F5 F4 +;FBED 8 => RIGHT DOWN UP LEFT DEL INS HOME SPACE +;FBEE 9 => 4 3 2 1 0 / + * +;FBEF 10 => . , - 9 8 7 6 5 + + +; Keyboard map +L1033: + DEFB $00,$00,$00,$00,$00,$00,$00,$00,$00,$00 + +; Routine at 4157 +L103D: + DEFB $1b,$09,$00,$08 + +L1041: + DEFB $18,$0d + +; Data block at 4163 +L1043: + DEFB $20,$0C,$12,$7F,$1D,$1E,$1F,$1C + DEFB $00,$00,$00 + +; Message at 4174 +L104E: + DEFM "0123456789" + +; Routine at 4184 +L1058: + DEC L + INC L + +L105A: + ;L105A+1: XOR A + LD L,$AF + LD (KANAST),A + JR CK_CTLX + +; Message at 4193 + +L1061: + DEFM "aeiou" + +L1066: + DEFB $79,$85,$8A,$8D,$95,$97 + DEFB $79,$A0,$82,$A1,$A2,$A3 + DEFB $79,$83,$88,$8C,$93,$96 + DEFB $79,$84,$89,$8B,$94,$81 + DEFB $98,$83,$88,$8C,$93,$96 + DEFB $84,$89,$8B,$94,$81,$98 + DEFB $A0,$82,$A1,$A2,$A3,$85 + DEFB $8A,$8D,$95,$97,$B1,$B3 + DEFB $B5,$B7,$A4,$86,$87,$91 + DEFB $B9 + + + +; Message at 4253 +L109D: + DEFB $79 + DEFM "AEIOU" + DEFB $8E + DEFM "EI" + DEFB $99 + DEFB $9A + DEFM "YA" + DEFB $90 + DEFM "IOUAEIOU" + DEFB $B0,$B2,$B4,$B6,$A5,$8F,$80,$92 + DEFB $B8,$59,$00,$00,$00,$00,$00 + + ; --- START PROC CK_CTLX --- +CK_CTLX: + INC HL + LD A,L + CP $18 ; CTL-X ? + RET NZ + LD HL,KEYBUF + RET + + +; Routine at 4299 +; +; Used by the routines at CHGET and _QINLIN. +_CHGET: + PUSH HL + PUSH DE + PUSH BC +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HCHGE ; Hook for CHGET std routine +ENDIF + CALL _CHSNS + JR NZ,_CHGET_1 + CALL L09DA +_CHGET_0: + CALL _CHSNS + JR Z,_CHGET_0 + CALL L0A27 +_CHGET_1: + LD HL,INTFLG + LD A,(HL) + CP $04 + JR NZ,_CHGET_2 + LD (HL),$00 +_CHGET_2: + LD HL,(GETPNT) + LD C,(HL) + CALL CK_CTLX + LD (GETPNT),HL + LD A,C + JP _CHPUT_1 + +; Routine at 4345 +; +; Used by the routine at CKCNTC. +_CKCNTC: + PUSH HL + LD HL,$0000 + CALL _ISCNTC + POP HL + RET + +; Routine at 4354 +; +; Used by the routines at WRTPSG, _INITIO, _BEEP, L113B, L1181 and L11B0. +_WRTPSG: + DI + OUT (PSG_ADDR),A + PUSH AF + LD A,E + OUT (PSG_DATA),A + EI + POP AF + RET + +; Routine at 4364 +; +; Used by the routines at _INITIO, _GTSTCK_3, _GTPAD, GTPAD_SUB3 and GTPAD_SUB4. +L110C: + LD A,$0E +; This entry point is used by the routines at RDPSG, _GTSTCK_2, _GTPDL and _GTPAD. +_RDPSG: + OUT (PSG_ADDR),A + IN A,(PSG_DATAIN) + RET + +; Routine at 4371 +; +; Used by the routine at BEEP. +_BEEP: + XOR A + LD E,$55 + CALL _WRTPSG + LD E,A + INC A + CALL _WRTPSG + LD E,$BE + LD A,$07 + CALL _WRTPSG + LD E,A + INC A + CALL _WRTPSG + LD BC,2000 + CALL BEEP_DELAY + JP _GICINI + +; Routine at 4403 +; +; Used by the routine at _BEEP. +BEEP_DELAY: + DEC BC + EX (SP),HL + EX (SP),HL + LD A,B + OR C + JR NZ,BEEP_DELAY + RET + +; Routine at 4411 +L113B: + LD B,A + CALL _GETVCP ; Returns pointer to play queue + DEC HL + LD D,(HL) + DEC HL + LD E,(HL) + DEC DE + LD (HL),E + INC HL + LD (HL),D + LD A,D + OR E + RET NZ + LD A,B + LD (QUEUEN),A + CALL L11E2 + CP $FF + JR Z,L11B0 + LD D,A + AND $E0 + RLCA + RLCA + RLCA + LD C,A + LD A,D + AND $1F + LD (HL),A + CALL L11E2 + DEC HL + LD (HL),A + INC C +; This entry point is used by the routine at L1181. +L113B_0: + DEC C + RET Z + CALL L11E2 + LD D,A + AND $C0 + JR NZ,L1181 + CALL L11E2 + LD E,A + LD A,B + RLCA + CALL _WRTPSG + INC A + LD E,D + CALL _WRTPSG + DEC C + JR L113B_0 + +; Routine at 4481 +; +; Used by the routine at L113B. +L1181: + LD H,A + AND $80 + JR Z,L1181_0 + LD E,D + LD A,B + ADD A,$08 + CALL _WRTPSG + LD A,E + AND $10 + LD A,$0D + CALL NZ,_WRTPSG +L1181_0: + LD A,H + AND $40 + JR Z,L113B_0 + CALL L11E2 + LD D,A + CALL L11E2 + LD E,A + LD A,$0B + CALL _WRTPSG + INC A + LD E,D + CALL _WRTPSG + DEC C + DEC C + JR L113B_0 + +; Routine at 4528 +; +; Used by the routine at L113B. +L11B0: + LD A,B + ADD A,$08 + LD E,$00 + CALL _WRTPSG + INC B + LD HL,MUSICF + XOR A + SCF +L11B0_0: + RLA + DJNZ L11B0_0 + AND (HL) + XOR (HL) + LD (HL),A +; This entry point is used by the routine at STRTMS. +_STRTMS: + LD A,(MUSICF) + OR A + RET NZ + LD HL,PLYCNT + LD A,(HL) + OR A + RET Z + DEC (HL) + LD HL,$0001 + LD (VCBA),HL + LD (VCBB),HL + LD (VCBC),HL + LD A,$07 + LD (MUSICF),A + RET + +; Routine at 4578 +; +; Used by the routines at L113B and L1181. +L11E2: + LD A,(QUEUEN) + PUSH HL + PUSH DE + PUSH BC + CALL L14AD + JP _CHPUT_1 + +; Routine at 4590 +; +; Used by the routine at GTSTCK. +_GTSTCK: + DEC A + JP M,_GTSTCK_1 + CALL _GTSTCK_2 + LD HL,STICK0_MAP +_GTSTCK_0: + AND $0F + LD E,A + LD D,$00 + ADD HL,DE + LD A,(HL) + RET + +_GTSTCK_1: + CALL _GTSTCK_5 + RRCA + RRCA + RRCA + RRCA + LD HL,STICK1_MAP + JR _GTSTCK_0 + + +; Routine at 4620 +; +; Used by the routines at _KEYINT, _GTSTCK and _GTTRIG. +_GTSTCK_2: + LD B,A + LD A,$0F + DI + CALL _RDPSG + DJNZ _GTSTCK_3 + AND $DF + OR $4C + JR _GTSTCK_4 + +; Routine at 4635 +; +; Used by the routine at _GTSTCK_2. +_GTSTCK_3: + AND $AF + OR $03 +; This entry point is used by the routine at _GTSTCK_2. +_GTSTCK_4: + OUT (PSG_DATA),A + CALL L110C + EI + RET + +; Routine at 4646 +; +; Used by the routines at _KEYINT and _GTTRIG_3. +_GTSTCK_5: + DI + IN A,(PPI_C) + AND $F0 + ADD A,$08 + OUT (PPI_COUT),A + IN A,(PPI_B) + EI + RET + +STICK0_MAP: + DEFB $00,$05,$01,$00,$03,$04,$02,$03 + DEFB $07,$06,$08,$07,$00,$05,$01,$00 + +STICK1_MAP: + DEFB $00,$03,$05,$04,$01,$02,$00,$03 + DEFB $07,$00,$06,$05,$08,$01,$07,$00 + + +; This entry point is used by the routine at GTTRIG. + ; --- START PROC L1253 --- +_GTTRIG: + DEC A + JP M,_GTTRIG_3 + PUSH AF + AND $01 + CALL _GTSTCK_2 + POP BC + DEC B + DEC B + LD B,$10 + JP M,_GTTRIG_1 + LD B,$20 +_GTTRIG_1: + AND B +; This entry point is used by the routine at _GTTRIG_3. +_GTTRIG_2: + SUB $01 + SBC A,A + RET + +; Routine at 4716 +; +; Used by the routine at _GTTRIG. +_GTTRIG_3: + CALL _GTSTCK_5 + AND $01 + JR _GTTRIG_2 + +; Routine at 4723 +; +; Used by the routine at GTPDL. +_GTPDL: + INC A + AND A + RRA + PUSH AF + LD B,A + XOR A + SCF +_GTPDL_0: + RLA + DJNZ _GTPDL_0 + LD B,A + POP AF + LD C,$10 + LD DE,$03AF ; MSK=$AF, OR=$03 + JR NC,_GTPDL_1 + LD C,$20 + LD DE,$4C9F ; MSK=$9F, OR=$4C +_GTPDL_1: + LD A,$0F + DI + CALL _RDPSG + AND E + OR D + OR C + OUT (PSG_DATA),A + XOR C + OUT (PSG_DATA),A + LD A,$0E + OUT (PSG_ADDR),A + LD C,$00 +_GTPDL_2: + IN A,(PSG_DATAIN) + AND B + JR Z,_GTPDL_3 + INC C + JP NZ,_GTPDL_2 + DEC C +_GTPDL_3: + EI + LD A,C + RET + +; Routine at 4780 +; +; Used by the routine at GTPAD. +; Check the current touch PAD status. +_GTPAD: + CP $04 + LD DE,$0CEC + JR C,_GTPAD_0 + LD DE,$03D3 + SUB $04 +_GTPAD_0: + DEC A + JP M,_GTPAD_1 + DEC A + LD A,(PADX) + RET M + LD A,(PADY) + RET Z +_GTPAD_1: + PUSH AF + EX DE,HL + LD (FILNAM),HL + SBC A,A + CPL + AND $40 + LD C,A + LD A,$0F + DI + CALL _RDPSG + AND $BF + OR C + OUT (PSG_DATA),A + POP AF + JP M,GTPAD_SUB + CALL L110C + EI + AND $08 + SUB $01 + SBC A,A + RET + +; Routine at 4840 +; +; Used by the routine at _GTPAD. +GTPAD_SUB: + LD C,$00 + CALL GTPAD_SUB3 + CALL GTPAD_SUB3 + JR C,GTPAD_SUB_2 + CALL GTPAD_SUB2 + JR C,GTPAD_SUB_2 + PUSH DE + CALL GTPAD_SUB2 + POP BC + JR C,GTPAD_SUB_2 + LD A,B + SUB D + JR NC,GTPAD_SUB_0 + CPL + INC A +GTPAD_SUB_0: + CP $05 + JR NC,GTPAD_SUB + LD A,C + SUB E + JR NC,GTPAD_SUB_1 + CPL + INC A +GTPAD_SUB_1: + CP $05 + JR NC,GTPAD_SUB + LD A,D + LD (PADX),A + LD A,E + LD (PADY),A +GTPAD_SUB_2: + EI + LD A,H + SUB $01 + SBC A,A + RET + +; Routine at 4896 +; +; Used by the routine at GTPAD_SUB. +GTPAD_SUB2: + LD C,$0A + CALL GTPAD_SUB3 + RET C + LD D,L + PUSH DE + LD C,$00 + CALL GTPAD_SUB3 + POP DE + LD E,L + XOR A + LD H,A + RET + +; Routine at 4914 +; +; Used by the routines at GTPAD_SUB and GTPAD_SUB2. +GTPAD_SUB3: + CALL GTPAD_SUB4 + LD B,$08 + LD D,C +GTPAD_SUB3_0: + RES 0,D + RES 2,D + CALL GTPAD_SUB4_1 + CALL L110C + LD H,A + RRA + RRA + RRA + RL L + SET 0,D + SET 2,D + CALL GTPAD_SUB4_1 + DJNZ GTPAD_SUB3_0 + SET 4,D + SET 5,D + CALL GTPAD_SUB4_1 + LD A,H + RRA + RET + +; Routine at 4955 +; +; Used by the routine at GTPAD_SUB3. +GTPAD_SUB4: + LD A,$35 + OR C + LD D,A + CALL GTPAD_SUB4_1 +GTPAD_SUB4_0: + CALL L110C + AND $02 + JR Z,GTPAD_SUB4_0 + RES 4,D + RES 5,D +; This entry point is used by the routine at GTPAD_SUB3. +GTPAD_SUB4_1: + PUSH HL + PUSH DE + LD HL,(FILNAM) + LD A,L + CPL + AND D + LD D,A + LD A,$0F + OUT (PSG_ADDR),A + IN A,(PSG_DATAIN) + AND L + OR D + OR H + OUT (PSG_DATA),A + POP DE + POP HL + RET + + +; Routine at 4996 +; +; Used by the routine at STMOTR. +_STMOTR: + AND A + JP M,_STMOTR_2 + +_STMOTR_0: + JR NZ,_STMOTR_1+1 + LD A,9 ; MOTOR OFF + +_STMOTR_1: + ; L183C+1: LD A,8 + defb $C2 ; JP NZ,NN (always false), masks the next 2 bytes + LD A,8 ; MOTOR ON + OUT (PPI_MOUT),A + RET + +; Routine at 5010 +; Used by the routine at _STMOTR. +_STMOTR_2: + IN A,(PPI_C) + AND $10 + JR _STMOTR_0 + + +; Routine at 5016 +; +; Used by the routine at NMI. +_NMI: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HNMI ; Hook for NMI std routine +ENDIF + RETN + + +; a.k.a. RSTFNK +; This entry point is used by the routine at INIFNK. +_INIFNK: + LD BC,$00A0 ; 160 + LD DE,FNKSTR + LD HL,FNKTAB + LDIR + RET + + +; Message at 5033 +FNKTAB: + DEFM "color " + +; Data block at 5039 +L13AF: + DEFB $00,$00,$00,$00,$00,$00,$00,$00 + DEFB $00,$00 + +; Message at 5049 +L13B9: + DEFM "auto " + +; Data block at 5054 +L13BE: + DEFB $00,$00,$00,$00,$00,$00,$00,$00 + DEFB $00,$00,$00 + +; Message at 5065 +L13C9: + DEFM "goto " + +; Data block at 5070 +L13CE: + DEFB $00,$00,$00,$00,$00,$00,$00,$00 + DEFB $00,$00,$00 + +; Message at 5081 +L13D9: + DEFM "list " + +; Data block at 5086 +L13DE: + DEFB $00,$00,$00,$00,$00,$00,$00,$00 + DEFB $00,$00,$00 + +; Message at 5097 +L13E9: + DEFM "run" + DEFB CR + + DEFB $00,$00,$00,$00,$00,$00,$00 + DEFB $00,$00,$00,$00,$00 + +; Message at 5113 +L13F9: + DEFM "color 15,4,4" + DEFB CR + + DEFB $00 + DEFB $00 + DEFB $00 + DEFM "cload" + DEFB '"' + DEFB $00,$00,$00,$00,$00,$00,$00 + DEFB $00,$00,$00 + +; Message at 5145 +L1419: + DEFM "cont" + DEFB CR + +; Data block at 5149 +L141E: + DEFB $00,$00,$00,$00,$00,$00,$00 + DEFB $00,$00,$00,$00 + +; Message at 5161 +L1429: + DEFM "list." + DEFB CR + +; Data block at 5166 +L142F: + DEFB $1E,$1E,$00,$00,$00,$00,$00 + DEFB $00,$00,$00,$0C + +; Message at 5178 +L143A: + DEFM "run" + DEFB CR + +L143E: + DEFB $00,$00,$00,$00,$00,$00,$00 + DEFB $00,$00,$00,$00 + + +_RDVDP: + IN A,(VDP_STATUS) + RET + +; Routine at 5196 +; +; Used by the routine at RSLREG. +_RSLREG: + IN A,(PPI_A) + RET + +; Routine at 5199 +; +; Used by the routine at WSLREG. +_WSLREG: + OUT (PPI_AOUT),A + RET + +; Routine at 5202 +; +; Used by the routine at SNSMAT. +_SNSMAT: + LD C,A + DI + IN A,(PPI_C) + AND $F0 + ADD A,C + OUT (PPI_COUT),A + IN A,(PPI_B) + EI + RET + +; Routine at 5215 +; +; Used by the routines at ISFLIO and _OUTDO. +_ISFLIO: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HISFL ; Hook for ISFLIO std routine +ENDIF + PUSH HL ;Save text pointer + LD HL,(PTRFIL) ;See if 'disk file' + LD A,L + OR H + POP HL + RET + +; Routine at 5226 +; +; Used by the routine at DCOMPR. +CPDEHL: + LD A,H + SUB D + RET NZ + LD A,L + SUB E + RET + +; Routine at 5232 +; +; Used by the routines at GETVCP and L113B. +; Returns pointer to play queue +_GETVCP: + LD L,$02 + JR _GETVC2_0 + +; Routine at 5236 +; +; Used by the routine at GETVC2. +_GETVC2: + LD A,(VOICEN) +; This entry point is used by the routines at _INITIO and _GETVCP. +_GETVC2_0: + PUSH DE + LD DE,VCBA + LD H,$00 + ADD HL,DE + OR A + JR Z,_GETVC2_2 + LD DE,$0025 +_GETVC2_1: + ADD HL,DE + DEC A + JR NZ,_GETVC2_1 +_GETVC2_2: + POP DE + RET + +; Routine at 5258 +; +; Used by the routine at PHYDIO. +_PHYDIO: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HPHYD ; Hook for PHYDIO std routine +ENDIF + RET + +; Routine at 5262 +; +; Used by the routine at FORMAT. +_FORMAT: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HFORM ; Hook for FORMAT std routine +ENDIF + RET + + +;PUTQ - append data to back of queue +; +; Routine at 5266 +; Used by the routine at PUTQ. +; Put byte in queue +_PUTQ: + CALL QUE_BCA ; IN: A= QUEUE#, OUT: BCA = first three bytes of the given QUEUE + LD A,B + INC A + INC HL + AND (HL) + CP C + RET Z + PUSH HL + DEC HL + DEC HL + DEC HL + EX (SP),HL + INC HL + LD C,A + LD A,(HL) + INC HL + LD H,(HL) + LD L,A + LD B,$00 + ADD HL,BC + LD (HL),E + POP HL + LD (HL),C + RET + +; Routine at 5293 +; +; Used by the routine at L11E2. +L14AD: + CALL QUE_BCA ; IN: A= QUEUE#, OUT: BCA = first three bytes of the given QUEUE + LD (HL),$00 + JR NZ,L14D1 ; QUEBAK+A + LD A,C + CP B + RET Z + INC HL + INC A + AND (HL) + DEC HL + DEC HL + PUSH HL + INC HL + INC HL + INC HL + LD C,A + LD A,(HL) + INC HL + LD H,(HL) + LD L,A + LD B,$00 + ADD HL,BC + LD A,(HL) + POP HL + LD (HL),C + OR A + RET NZ + INC A + LD A,$00 + RET + +; Routine at 5329 +; +; Used by the routine at L14AD. +L14D1: + LD C,A + LD B,$00 + LD HL,QUEBAK-1 + ADD HL,BC + LD A,(HL) + RET + +; Routine at 5338 +; +; Used by the routine at _INITIO. +L14DA: + PUSH BC + CALL QUEADDR ; HL = address for queue in A + LD (HL),B + INC HL + LD (HL),B + INC HL + LD (HL),B + INC HL + POP AF + LD (HL),A + INC HL + LD (HL),E + INC HL + LD (HL),D + RET + +; Routine at 5355 +; +; Used by the routine at LFTQ. +; Gives number of bytes left in queue +_LFTQ: + CALL QUE_BCA ; IN: A= QUEUE#, OUT: BCA = first three bytes of the given QUEUE + LD A,B + INC A + INC HL + AND (HL) + LD B,A + LD A,C + SUB B + AND (HL) + LD L,A + LD H,$00 + RET + +; Routine at 5370 +; +; Used by the routines at _PUTQ, L14AD and _LFTQ. +; IN: A= QUEUE#, OUT: BCA = first three bytes of the given QUEUE +QUE_BCA: + CALL QUEADDR ; HL = address for queue in A + LD B,(HL) + INC HL + LD C,(HL) + INC HL + LD A,(HL) + OR A + RET + +; Routine at 5380 +; +; Used by the routines at L14DA and QUE_BCA. +; HL = address for queue in A +QUEADDR: + RLCA + LD B,A + RLCA + ADD A,B + LD C,A + LD B,$00 + LD HL,(QUEUES) + ADD HL,BC + RET + +; Data block at 5392 +; $1510 +_GRPPRT: + PUSH HL + PUSH DE + PUSH BC + PUSH AF + ; --- START PROC L1514 --- +L1514: + CALL _SNVCHR + JR NC,L157B + JR NZ,_GRPPRT_00 + CP CR + JR Z,L157E + CP ' ' + JR C,L157B + +; Routine at 5411 +_GRPPRT_00: + CALL L0752 + LD A,(FORCLR) + LD (ATRBYT),A + LD HL,(GRPACY) + EX DE,HL + LD BC,(GRPACX) + CALL _SCALXY + JR NC,L157B + CALL _MAPXY + LD DE,PATWRK + LD C,$08 +_GRPPRT_0: + LD B,$08 + CALL _FETCHC ; Save cursor + PUSH HL + PUSH AF + LD A,(DE) +_GRPPRT_1: + ADD A,A + PUSH AF + CALL C,_SETC ; Update current screenpixel of specified attribute byte + CALL L16AC + POP HL + JR C,_GRPPRT_2 + PUSH HL + POP AF + DJNZ _GRPPRT_1 +_GRPPRT_2: + POP AF + POP HL + CALL _STOREC ; Restore cursor + CALL _TDOWNC + JR C,_GRPPRT_3 + INC DE + DEC C + JR NZ,_GRPPRT_0 +_GRPPRT_3: + CALL IN_GRP_MODE ; Z if GRP (high resolution screen with 256×192 pixels) + LD A,(GRPACX) + JR Z,_GRPPRT_4 + ADD A,$20 + JR C,L157E + JR _GRPPRT_5 + +; Routine at 5492 +; +; Used by the routine at _GRPPRT. +_GRPPRT_4: + ADD A,$08 + JR C,L157E +; This entry point is used by the routine at _GRPPRT. +_GRPPRT_5: + LD (GRPACX),A +; This entry point is used by the routines at _GRPPRT and L157E. +L157B: + JP _POPALL + +; Routine at 5502 +; +; Used by the routines at _GRPPRT and _GRPPRT_4. +L157E: + XOR A + LD (GRPACX),A + CALL IN_GRP_MODE ; Z if GRP (high resolution screen with 256×192 pixels) + LD A,(GRPACY) + JR Z,L158D + ADD A,$20 + DEFB $01 ; "LD BC,nn" to jump over the next word without executing it +L158D: + ADD A,8 + + CP $C0 + JR C,L157E_0 + XOR A +L157E_0: + LD (GRPACY),A + JR L157B + +; Routine at 5529 +; +; Used by the routines at SCALXY and _GRPPRT. +_SCALXY: + PUSH HL + PUSH BC + LD B,$01 + EX DE,HL + LD A,H + ADD A,A + JR NC,_SCALXY_1 + LD HL,$0000 + JR _SCALXY_2 + +_SCALXY_1: + LD DE,192 + RST DCOMPR ; Compare HL with DE. + JR C,_SCALXY_3 + EX DE,HL + DEC HL + +_SCALXY_2: + LD B,$00 +_SCALXY_3: + EX (SP),HL + LD A,H + ADD A,A + JR NC,_SCALXY_4 + LD HL,$0000 + JR _SCALXY_5 + +_SCALXY_4: + LD DE,256 + RST DCOMPR ; Compare HL with DE. + JR C,_SCALXY_6 + EX DE,HL + DEC HL + +_SCALXY_5: + LD B,$00 +_SCALXY_6: + POP DE + CALL IN_GRP_MODE ; Z if GRP (high resolution screen with 256×192 pixels) + JR Z,_SCALXY_7 + SRL L + SRL L + SRL E + SRL E +_SCALXY_7: + LD A,B + RRCA + LD B,H + LD C,L + POP HL + RET + +; Routine at 5593 +; +; Used by the routines at _GRPPRT, L157E, _SCALXY_4, _MAPXY, _SETC, L16AC, _RIGHTC, +; L16D8, _LEFTC, _TDOWNC, _DOWNC, _TUPC, _UPC, _NSETCX, _PNTINI and _SCANL. +; Z if GRP (high resolution screen with 256×192 pixels) +IN_GRP_MODE: + LD A,(SCRMOD) + SUB $02 + RET + +; Routine at 5599 +; +; Used by the routines at MAPXY and _GRPPRT. +_MAPXY: + PUSH BC + CALL IN_GRP_MODE ; Z if GRP (high resolution screen with 256×192 pixels) + JR NZ,_MAPXY_1 + LD D,C + LD A,C + AND $07 + LD C,A + LD HL,_MAPXY_0 + ADD HL,BC + LD A,(HL) + LD (CMASK),A + LD A,E + RRCA + RRCA + RRCA + AND $1F + LD B,A + LD A,D + AND $F8 + LD C,A + LD A,E + AND $07 + OR C + LD C,A + LD HL,(GRPCGP) + ADD HL,BC + LD (CLOC),HL + POP BC + RET + +_MAPXY_0: + ADD A,B + LD B,B + JR NZ,_MAPXY_3 + EX AF,AF' + INC B + LD (BC),A + + DEFB $01 ; "LD BC,nn" to jump over the next word without executing it + +_MAPXY_1: + LD A,C + RRCA + + LD A,$F0 ; Mask and keep the left nibble + JR NC,EVEN_BYTE + LD A,$0F ; Mask and keep the righe nibble +EVEN_BYTE: + LD (CMASK),A + + LD A,C +_MAPXY_3: + ADD A,A + ADD A,A + AND $F8 + LD C,A + LD A,E + AND $07 + OR C + LD C,A + LD A,E + RRCA + RRCA + RRCA + AND $07 + LD B,A + LD HL,(MLTCGP) ; SCREEN 3 character pattern table + ADD HL,BC + LD (CLOC),HL + POP BC + RET + +; Routine at 5689 +; +; Used by the routines at FETCHC, _STOREC, _GRPPRT, _SETC, L16AC, _RIGHTC, L16D8, _LEFTC, +; L1779, RIGHTC_MLT, L179C, LEFTC_MLT, _NSETCX, L190C, L192D and L1963. +; +; Gets current "graphics cursor" position and mask pattern +_FETCHC: + LD A,(CMASK) + LD HL,(CLOC) + RET + +; Routine at 5696 +; +; Used by the routines at STOREC, _GRPPRT and L192D. +; Record current "graphics cursor" position and mask pattern +; +_STOREC: + LD (CMASK),A + LD (CLOC),HL + RET + +; Data block at 5703 + ; --- START PROC L1647 --- +_READC: + PUSH BC + PUSH HL + CALL _FETCHC ; Gets current cursor position and mask pattern + LD B,A + CALL IN_GRP_MODE ; Z if GRP (high resolution screen with 256×192 pixels) + JR NZ,L166C + CALL _RDVRM + AND B + PUSH AF + LD BC,$2000 + ADD HL,BC + CALL _RDVRM + LD B,A + POP AF + LD A,B + JR Z,L1667 +L1663: + RRCA + RRCA + RRCA + RRCA +L1667: + AND $0F + POP HL + POP BC + RET + + +; Routine at 5740 +L166C: + CALL _RDVRM + INC B + DEC B + JP P,L1667 + JR L1663 + +; Routine at 5750 +; +; Used by the routine at SETATR. +; Set attribute byte +_SETATR: + CP $10 + CCF + RET C + LD (ATRBYT),A + RET + +; Routine at 5758 +; +; Used by the routines at SETC, _GRPPRT, L18BB and L19C7. +_SETC: + PUSH HL + PUSH BC + CALL IN_GRP_MODE ; Z if GRP (high resolution screen with 256×192 pixels) + CALL _FETCHC ; Get cursor statur + JR NZ,_SETC_0 + PUSH DE + CALL SETC_GFX + POP DE + POP BC + POP HL + RET + +; Data block at 5776 +_SETC_0: + LD B,A + CALL _RDVRM + LD C,A + LD A,B + CPL + AND C + LD C,A + LD A,(ATRBYT) + INC B + DEC B + JP P,_SETC_1 + ADD A,A + ADD A,A + ADD A,A + ADD A,A +_SETC_1: + OR C + CALL _WRTVRM + POP BC + POP HL + RET + + +; Routine at 5804 +; +; Used by the routines at _GRPPRT, L18F0, L190C, L1951 and L1963. +L16AC: + PUSH HL + CALL IN_GRP_MODE ; Z if GRP (high resolution screen with 256×192 pixels) + JP NZ,L1779 + CALL _FETCHC ; Gets current cursor position and mask pattern + RRCA + JR NC,LR_2 + LD A,L + AND $F8 + CP $F8 + LD A,$80 + JR NZ,_RIGHTC_0 + JP _TUPC_1 + +; Routine at 5829 +; +; Used by the routines at RIGHTC, L18BB, L199C and L19BA. +; Shifts screenpixel to the right + +_RIGHTC: + PUSH HL + CALL IN_GRP_MODE ; Z if GRP (high resolution screen with 256×192 pixels) + JP NZ,RIGHTC_MLT + CALL _FETCHC ; Gets current cursor position and mask pattern + RRCA + JR NC,LR_2 +; This entry point is used by the routine at L16AC. +_RIGHTC_0: + PUSH DE + LD DE,$0008 + JR LR_1 + +; Routine at 5848 +; +; Used by the routines at _SCANL and L19BA. +L16D8: + PUSH HL + CALL IN_GRP_MODE ; Z if GRP (high resolution screen with 256×192 pixels) + JP NZ,L179C + CALL _FETCHC ; Gets current cursor position and mask pattern + RLCA + JR NC,LR_2 + LD A,L + AND $F8 + LD A,$01 + JR NZ,LR_0 + JR _TUPC_1 + +; Routine at 5870 +; +; Used by the routine at LEFTC. +_LEFTC: + PUSH HL + CALL IN_GRP_MODE ; Z if GRP (high resolution screen with 256×192 pixels) + JP NZ,LEFTC_MLT + CALL _FETCHC ; Gets current cursor position and mask pattern + RLCA + JR NC,LR_2 + +; This entry point is used by the routine at L16D8. +LR_0: + PUSH DE + LD DE,$FFF8 ; -8 +; This entry point is used by the routine at _RIGHTC. +LR_1: + ADD HL,DE + LD (CLOC),HL + POP DE +; This entry point is used by the routines at L16AC, _RIGHTC and L16D8. +LR_2: + LD (CMASK),A + AND A + POP HL + RET + +; Routine at 5898 +; +; Used by the routines at TDOWNC and _GRPPRT. +_TDOWNC: + PUSH HL + PUSH DE + LD HL,(CLOC) + CALL IN_GRP_MODE ; Z if GRP (high resolution screen with 256×192 pixels) + JP NZ,TDOWNC_MLT + PUSH HL + LD HL,(GRPCGP) ; SCREEN 2 character pattern table + LD DE,$1700 + ADD HL,DE + EX DE,HL + POP HL + RST DCOMPR ; Compare HL with DE. + JR C,_DOWNC_0 + LD A,L + INC A + AND $07 + JR NZ,_DOWNC_0 + JR _TUPC_0 + +; Routine at 5930 +; +; Used by the routine at DOWNC. +_DOWNC: + PUSH HL + PUSH DE + LD HL,(CLOC) + CALL IN_GRP_MODE ; Z if GRP (high resolution screen with 256×192 pixels) + JP NZ,DOWNC_MLT +; This entry point is used by the routine at _TDOWNC. +_DOWNC_0: + INC HL + LD A,L + LD DE,$00F8 + JR _UPC_1 + +; Routine at 5948 +; +; Used by the routine at TUPC. +_TUPC: + PUSH HL + PUSH DE + LD HL,(CLOC) + CALL IN_GRP_MODE ; Z if GRP (high resolution screen with 256×192 pixels) + JP NZ,TUPC_MLT + PUSH HL + LD HL,(GRPCGP) ; SCREEN 2 character pattern table + LD DE,256 + ADD HL,DE + EX DE,HL + POP HL + RST DCOMPR ; Compare HL with DE. + JR NC,_UPC_0 + LD A,L + AND $07 + JR NZ,_UPC_0 +; This entry point is used by the routine at _TDOWNC. +_TUPC_0: + POP DE +; This entry point is used by the routines at L16AC, L16D8, L1779 and L179C. +_TUPC_1: + SCF + POP HL + RET + +; Routine at 5981 +; +; Used by the routine at UPC. +_UPC: + PUSH HL + PUSH DE + LD HL,(CLOC) + CALL IN_GRP_MODE ; Z if GRP (high resolution screen with 256×192 pixels) + JP NZ,UPC_MLT +; This entry point is used by the routine at _TUPC. +_UPC_0: + LD A,L + DEC HL + LD DE,$FF08 ; -248 +; This entry point is used by the routine at _DOWNC. +_UPC_1: + AND $07 + JR NZ,_UPC_2 + ADD HL,DE +_UPC_2: + LD (CLOC),HL + AND A + POP DE + POP HL + RET + +; Routine at 6009 +; +; Used by the routine at L16AC. +L1779: + CALL _FETCHC ; Gets current cursor position and mask pattern + AND A + LD A,$0F ; Mask and keep the right nibble + JP M,APPLY_MASK + LD A,L + AND $F8 + CP $F8 + JR NZ,RIGHTC_MLT_0 + JR _TUPC_1 + +; Routine at 6027 +; +; Used by the routine at _RIGHTC. +RIGHTC_MLT: + CALL _FETCHC ; Gets current cursor position and mask pattern + AND A + LD A,$0F ; Mask and keep the right nibble + JP M,APPLY_MASK +; This entry point is used by the routine at L1779. +RIGHTC_MLT_0: + PUSH DE + LD DE,$0008 + LD A,$F0 ; Mask and keep the lsft nibble + JR LEFTC_MLT_1 + +; Routine at 6044 +; +; Used by the routine at L16D8. +L179C: + CALL _FETCHC ; Gets current cursor position and mask pattern + AND A + LD A,$F0 ; Mask and keep the left nibble + JP P,APPLY_MASK + LD A,L + AND $F8 + JR NZ,LEFTC_MLT_0 + JR _TUPC_1 + +; Routine at 6060 +; +; Used by the routine at _LEFTC. +LEFTC_MLT: + CALL _FETCHC ; Gets current cursor position and mask pattern + AND A + LD A,$F0 ; Mask and keep the left nibble + JP P,APPLY_MASK +; This entry point is used by the routine at L179C. +LEFTC_MLT_0: + PUSH DE + LD DE,$FFF8 ; -8 + LD A,$0F ; Mask and keep the right nibble +; This entry point is used by the routine at RIGHTC_MLT. +LEFTC_MLT_1: + ADD HL,DE + LD (CLOC),HL + POP DE +; This entry point is used by the routines at L1779, RIGHTC_MLT and L179C. +APPLY_MASK: + LD (CMASK),A + AND A + POP HL + RET + +; Routine at 6086 +; +; Used by the routine at _TDOWNC. +TDOWNC_MLT: + PUSH HL + LD HL,(MLTCGP) ; SCREEN 3 character pattern table + LD DE,$0500 ; 1280 + ADD HL,DE + POP HL + RST DCOMPR ; Compare HL with DE. + JR C,DOWNC_MLT + LD A,L + INC A + AND $07 + JR NZ,DOWNC_MLT + SCF + POP DE + POP HL + RET + +; Routine at 6108 +; +; Used by the routines at _DOWNC and TDOWNC_MLT. +DOWNC_MLT: + INC HL + LD A,L + LD DE,$00F8 + JR UPC_MLT_0 + +; Routine at 6115 +; +; Used by the routine at _TUPC. +TUPC_MLT: + PUSH HL + LD HL,(MLTCGP) ; SCREEN 3 character pattern table + LD DE,256 + ADD HL,DE + POP HL + RST DCOMPR ; Compare HL with DE. + JR NC,UPC_MLT + LD A,L + AND $07 + JR NZ,UPC_MLT + SCF + POP DE + POP HL + RET + +; Routine at 6136 +; +; Used by the routines at _UPC and TUPC_MLT. +UPC_MLT: + LD A,L + DEC HL + LD DE,$FF08 ; -248 +; This entry point is used by the routine at DOWNC_MLT. +UPC_MLT_0: + AND $07 + JR NZ,UPC_MLT_1 + ADD HL,DE +UPC_MLT_1: + LD (CLOC),HL + AND A + POP DE + POP HL + RET + +; Routine at 6153 +; +; Used by the routines at NSETCX, L192D and L199C. +; Set horizontal screenpixels +; +_NSETCX: + CALL IN_GRP_MODE ; Z if GRP (high resolution screen with 256×192 pixels) + JP NZ,_NSETCX_NOGRP + PUSH HL + CALL _FETCHC ; Gets current cursor position and mask pattern + EX (SP),HL + ADD A,A + JR C,_NSETCX_1 + PUSH AF + LD BC,-1 + RRCA +_NSETCX_0: + ADD HL,BC + JR NC,_NSETCX_4 + RRCA + JR NC,_NSETCX_0 + POP AF + DEC A + EX (SP),HL + PUSH HL + CALL SETC_GFX + POP HL + LD DE,$0008 + ADD HL,DE + EX (SP),HL +_NSETCX_1: + LD A,L + AND $07 + LD C,A + LD A,H + RRCA + LD A,L + RRA + RRCA + RRCA + AND $3F + POP HL + LD B,A + JR Z,_NSETCX_3 +_NSETCX_2: + XOR A + CALL _WRTVRM + LD DE,$2000 + ADD HL,DE + LD A,(ATRBYT) + CALL _WRTVRM + LD DE,$2008 + ADD HL,DE + DJNZ _NSETCX_2 +_NSETCX_3: + DEC C + RET M + PUSH HL + LD HL,NSETCX_OFFSMAP + ADD HL,BC + LD A,(HL) + JR _NSETCX_5 + +NSETCX_OFFSMAP: + DEFB 10000000b + DEFB 11000000b + DEFB 11100000b + DEFB 11110000b + DEFB 11111000b + DEFB 11111100b + DEFB 11111110b + +_NSETCX_4: + ADD A,A + DEC A + CPL + LD B,A + POP AF + DEC A + AND B + + ; --- START PROC _NSETCX_5 --- +_NSETCX_5: + POP HL + + + ; --- START PROC SETC_GFX --- +SETC_GFX: + LD B,A + CALL _RDVRM + LD C,A + LD DE,$2000 + ADD HL,DE + CALL _RDVRM + PUSH AF + AND $0F + LD E,A + POP AF + SUB E + LD D,A + LD A,(ATRBYT) ; Attribute byte (for graphical routines it’s used to read the color) + CP E + JR Z,SETC_GFX_1 + ADD A,A + ADD A,A + ADD A,A + ADD A,A + CP D + JR Z,SETC_GFX_2 + PUSH AF + LD A,B + OR C + CP $FF + JR Z,SETC_GFX_4 + PUSH HL + PUSH DE + CALL SETC_GFX_2 + POP DE + POP HL + POP AF + OR E + JR SETC_GFX_5 + + +; Routine at 6302 +SETC_GFX_1: + LD A,B + CPL + AND C + + DEFB $11 ; "LD DE,nn" to skip the next 2 instructions + +SETC_GFX_2: + LD A,B + OR C + +; This entry point is used by the routine at SETC_GFX_4. +SETC_GFX_3: + LD DE,$2000 + ADD HL,DE + JR SETC_GFX_5 + +; Routine at 6314 +SETC_GFX_4: + POP AF + LD A,B + CPL + PUSH HL + PUSH DE + CALL SETC_GFX_3 + POP DE + POP HL + LD A,(ATRBYT) + OR D +; This entry point is used by the routine at SETC_GFX_1. +SETC_GFX_5: + JP _WRTVRM + +; Routine at 6331 +; +; Used by the routine at _NSETCX. +_NSETCX_NOGRP: + PUSH HL + CALL _SETC + CALL _RIGHTC + POP HL + DEC L + JR NZ,_NSETCX_NOGRP + RET + +; Routine at 6343 +; +; Used by the routine at GTASPC. +_GTASPC: + LD HL,(ASPCT1) + EX DE,HL + LD HL,(ASPCT2) + RET + +; Routine at 6351 +; +; Used by the routine at GTASPC. +_PNTINI: + PUSH AF + CALL IN_GRP_MODE ; Z if GRP (high resolution screen with 256×192 pixels) + JR Z,L18DB + POP AF + CP $10 + CCF + JR L18DB_0 + +; Routine at 6363 +; +; Used by the routine at _PNTINI. +L18DB: + POP AF + LD A,(ATRBYT) + AND A +; This entry point is used by the routine at _PNTINI. +L18DB_0: + LD (BRDATR),A + RET + + ; --- START PROC L18E4 --- +; Scans screenpixels to the right +_SCANR: + LD HL,$0000 + LD C,L + CALL IN_GRP_MODE ; Z if GRP (high resolution screen with 256×192 pixels) + JR NZ,L1951 + LD A,B + LD (RUNFLG),A + XOR A + LD (FILNAM+3),A + LD A,(BRDATR) + LD B,A +_SCANR_0: + CALL _READC + CP B + JR NZ,L190C + DEC DE + LD A,D + OR E + RET Z + CALL L16AC + JR NC,_SCANR_0 + LD DE,$0000 + RET + +; Routine at 6412 +; +; Used by the routine at _SCANR. +L190C: + CALL L19AE + PUSH DE + CALL _FETCHC ; Gets current cursor position and mask pattern + LD (CSAVEA),HL + LD (CSAVEM),A + LD DE,$0000 +L190C_0: + INC DE + CALL L16AC + JR C,L192D + CALL _READC + CP B + JR Z,L192D + CALL L19AE + JR L190C_0 + +; Routine at 6445 +; +; Used by the routine at L190C. +L192D: + PUSH DE + CALL _FETCHC ; Save cursor + PUSH HL + PUSH AF + LD HL,(CSAVEA) + LD A,(CSAVEM) + CALL _STOREC ; Restore cursor + EX DE,HL + LD (FILNAM+1),HL + LD A,(FILNAM) + AND A + CALL NZ,_NSETCX + POP AF + POP HL + CALL _STOREC ; Restore cursor + POP HL + POP DE + JP L199C_1 + +; Routine at 6481 +L1951: + CALL L19C7 + JR NC,L1963 + DEC DE + LD A,D + OR E + RET Z + CALL L16AC + JR NC,L1951 + LD DE,$0000 + RET + +; Routine at 6499 +; +; Used by the routine at L1951. +L1963: + CALL _FETCHC ; Gets current cursor position and mask pattern + LD (CSAVEA),HL + LD (CSAVEM),A + LD HL,$0000 +L1963_0: + INC HL + CALL L16AC + RET C + CALL L19C7 + JR NC,L1963_0 + RET + +; Routine at 6522 +; +; Used by the routine at GTASPC. +_SCANL: + LD HL,$0000 + LD C,L + CALL IN_GRP_MODE ; Z if GRP (high resolution screen with 256×192 pixels) + JR NZ,L19BA + XOR A + LD (FILNAM+3),A + LD A,(BRDATR) + LD B,A +_SCANL_0: + CALL L16D8 + JR C,L199C_0 + CALL _READC + CP B + JR Z,L199C + CALL L19AE + INC HL + JR _SCANL_0 + +; Routine at 6556 +; +; Used by the routine at _SCANL. +L199C: + CALL _RIGHTC +; This entry point is used by the routine at _SCANL. +L199C_0: + PUSH HL + LD DE,(FILNAM+1) + ADD HL,DE + CALL _NSETCX + POP HL +; This entry point is used by the routine at L192D. +L199C_1: + LD A,(FILNAM+3) + LD C,A + RET + +; Routine at 6574 +; +; Used by the routines at L190C and _SCANL. +L19AE: + PUSH HL + LD HL,ATRBYT + CP (HL) + POP HL + RET Z + INC A + LD (FILNAM+3),A + RET + +; Routine at 6586 +; +; Used by the routine at _SCANL. +L19BA: + CALL L16D8 + RET C + CALL L19C7 + JP C,_RIGHTC + INC HL + JR L19BA + +; Routine at 6599 +; +; Used by the routines at L1951, L1963 and L19BA. +L19C7: + CALL _READC + LD B,A + LD A,(BRDATR) + SUB B + SCF + RET Z + LD A,(ATRBYT) + CP B + RET Z + CALL _SETC + LD C,$01 + AND A + RET + +; Routine at 6621 +; a.k.a. CTWOFF +; Used by the routine at TAPOOF. +_TAPOOF: + PUSH BC + PUSH AF + LD BC,$0000 +_TAPOOF_0: + DEC BC + LD A,B + OR C + JR NZ,_TAPOOF_0 + POP AF + POP BC + +; a.k.a. CTOFF +; This entry point is used by the routine at TAPIOF. +_TAPIOF: + PUSH AF + LD A,$09 + OUT (PPI_MOUT),A + POP AF + EI + RET + +; Routine at 6641 +; +; Used by the routine at TAPOON. +_TAPOON: + OR A + PUSH AF + LD A,$08 + OUT (PPI_MOUT),A + LD HL,$0000 +_TAPOON_0: + DEC HL + LD A,H + OR L + JR NZ,_TAPOON_0 + POP AF + LD A,(HEADER) + JR Z,_TAPOON_1 + ADD A,A + ADD A,A +_TAPOON_1: + LD B,A + LD C,$00 + DI +_TAPOON_2: + CALL TAPSEND_HIGH + CALL TAPSEND_RET + DEC BC + LD A,B + OR C + JR NZ,_TAPOON_2 + JP _BREAKX ; Set CY if STOP is pressed + +; Routine at 6681 +; +; Used by the routine at TAPOUT. +_TAPOUT: + LD HL,(LOW) + PUSH AF + LD A,L + SUB $0E + LD L,A + ; start bit (HL=LOW) + CALL TAPSEND_0 + POP AF + LD B,$08 ; 8 bits +_TAPOUT_0: + RRCA + CALL C,TAPSEND_HIGH_X2 ; '1' + CALL NC,TAPSEND_LOW ; '0' + DJNZ _TAPOUT_0 + ; stop bits + CALL TAPSEND_HIGH_X2 + CALL TAPSEND_HIGH_X2 + JP _BREAKX ; Set CY if STOP is pressed + +; Routine at 6713 +; +; Used by the routine at _TAPOUT. +TAPSEND_LOW: + LD HL,(LOW) + CALL TAPSEND_0 +; This entry point is used by the routine at _TAPOON. +TAPSEND_RET: + RET + + ; --- START PROC TAPSEND_HIGH_X2 --- +TAPSEND_HIGH_X2: + CALL TAPSEND_HIGH + EX (SP),HL ; Delay ? + EX (SP),HL + NOP + NOP + NOP + NOP + CALL TAPSEND_HIGH + RET + + + +; Routine at 6733 +; +; Used by the routine at _TAPOON. +TAPSEND_HIGH: + LD HL,(HIGH) +; This entry point is used by the routines at _TAPOUT and TAPSEND_LOW. +TAPSEND_0: + PUSH AF +TAPSEND_1: + DEC L + JP NZ,TAPSEND_1 + LD A,$0B + OUT (PPI_MOUT),A +TAPSEND_2: + DEC H + JP NZ,TAPSEND_2 + LD A,$0A + OUT (PPI_MOUT),A + POP AF + RET + +; Routine at 6755 +; +; Used by the routine at TAPION. +_TAPION: + LD A,$08 + OUT (PPI_MOUT),A + DI + LD A,$0E + OUT (PSG_ADDR),A +_TAPION_0: + LD HL,$0457 ; 1111 +_TAPION_1: + LD D,C + CALL TAPIN_BIT + RET C ; Exit if BREAK was pressed + LD A,C ; get measured tape sync speed + CP $DE ; Timeout ? + JR NC,_TAPION_0 ; Try again + CP $05 ; Too short ? + JR C,_TAPION_0 ; Try again + SUB D + JR NC,_TAPION_2 + CPL + INC A +_TAPION_2: + CP $04 + JR NC,_TAPION_0 ; Try again + DEC HL + LD A,H + OR L + JR NZ,_TAPION_1 ; Correct leading tone. It must stay like this 1111 times. + LD HL,$0000 + LD B,L + LD D,L +_TAPION_3: + CALL TAPIN_BIT + RET C ; Exit if BREAK was pressed + ADD HL,BC + DEC D + JP NZ,_TAPION_3 + LD BC,$06AE ; 1710 + ADD HL,BC + LD A,H + RRA + AND $7F + LD D,A + ADD HL,HL + LD A,H + SUB D + LD D,A + SUB $06 + LD (LOWLIM),A ; Keep the minimal length of startbit + LD A,D + ADD A,A + LD B,$00 +_TAPION_4: + SUB $03 + INC B + JR NC,_TAPION_4 + LD A,B + SUB $03 + LD (WINWID),A ; Store the difference between a low-and high-cycle + OR A + RET + +; Routine at 6844 +; +; Used by the routine at TAPIN. +_TAPIN: + LD A,(LOWLIM) ; Minimal length of startbit + LD D,A +_TAPIN_0: + CALL _BREAKX ; Set CY if STOP is pressed + RET C + IN A,(PSG_DATAIN) + RLCA + JR NC,_TAPIN_0 +_TAPIN_1: + CALL _BREAKX ; Set CY if STOP is pressed + RET C + IN A,(PSG_DATAIN) + RLCA + JR C,_TAPIN_1 + LD E,$00 + CALL TAPIN_PERIOD +_TAPIN_2: + LD B,C + CALL TAPIN_PERIOD + RET C + LD A,B + ADD A,C + JP C,_TAPIN_2 + CP D + JR C,_TAPIN_2 + LD L,$08 +_TAPIN_BYTE: + CALL _TAPIN_STARTBIT + CP $04 + CCF + RET C + CP $02 + CCF + RR D + LD A,C + RRCA + CALL NC,TAPIN_PERIOD_0 + CALL TAPIN_PERIOD + DEC L + JP NZ,_TAPIN_BYTE + CALL _BREAKX ; Set CY if STOP is pressed + LD A,D + RET + +; Routine at 6915 +; +; Used by the routine at _TAPIN. +_TAPIN_STARTBIT: + LD A,(WINWID) ; Get the difference between a low-and high-cycle + LD B,A + LD C,$00 + +_TAPIN_STARTBIT_0: + IN A,(PSG_DATAIN) + XOR E + JP P,_TAPIN_STARTBIT_1 + LD A,E + CPL + LD E,A + INC C + DJNZ _TAPIN_STARTBIT_0 + LD A,C + RET + +; Unused +_TAPIN_STARTBIT_1: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 4 + ENDIF +ELSE + DEFS 4 +ENDIF + + DJNZ _TAPIN_STARTBIT_0 + LD A,C + RET + +; Routine at 6943 +; +; Used by the routine at _TAPIN. +TAPIN_PERIOD: + CALL _BREAKX ; Set CY if STOP is pressed + RET C +; This entry point is used by the routines at _TAPIN and TAPIN_BIT. +TAPIN_PERIOD_0: + LD C,$00 +; This entry point is used by the routine at TAPIN_BIT. +TAPIN_PERIOD_1: + INC C + JR Z,TAPIN_PERIOD_OVERFLOW + IN A,(PSG_DATAIN) + XOR E + JP P,TAPIN_PERIOD_1 + LD A,E + CPL + LD E,A + RET + +; Routine at 6962 +; +; Used by the routine at TAPIN_PERIOD. +TAPIN_PERIOD_OVERFLOW: + DEC C + RET + +; Routine at 6964 +; +; Used by the routine at _TAPION. +TAPIN_BIT: + CALL _BREAKX ; Set CY if STOP is pressed + RET C + IN A,(PSG_DATAIN) + RLCA + JR C,TAPIN_BIT + LD E,$00 + CALL TAPIN_PERIOD_0 + JP TAPIN_PERIOD_1 + +; Routine at 6981 +; +; OUTDO (either CALL or RST) prints char in [A] no registers affected +; to either terminal or disk file or printer depending +; flags: +; PRTFLG if non-zero print to printer +; PTRFIL if non-zero print to disk file pointed to by PTRFIL +; +; Used by the routine at OUTDO. +_OUTDO: + PUSH AF +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HOUTD ; Hook for OUTDO std routine +ENDIF + CALL _ISFLIO + JR Z,OUTDO_NOFILE + + POP AF + LD IX,FILO ; Sequential file output + JP _CALBAS + +; Routine at 6998 +; +; Used by the routine at _OUTDO. +OUTDO_NOFILE: + LD A,(PRTFLG) ;SEE IF WE WANT TO TALK TO LPT + OR A ;TEST BITS + JR Z,_OUTCON ;IF ZERO THEN NOT + LD A,(RAWPRT) + AND A + JR NZ,_OUTPRT + POP AF ;GET BACK CHAR + +; This entry point is used by the routine at OUTDLP. +OUTC_TABEXP: + PUSH AF + CP TAB ;TAB + JR NZ,NO_TAB ;NO +TABEXP_LOOP: + LD A,' ' + CALL OUTC_TABEXP + LD A,(LPTPOS) + AND $07 ;AT TAB STOP? + JR NZ,TABEXP_LOOP ;GO BACK IF MORE TO PRINT + POP AF ;POP OFF CHAR + RET ;RETURN + +; Routine at 7030 +; +; Used by the routine at OUTDO_NOFILE. +NO_TAB: + SUB CR + JR Z,NO_TAB_0 + JR C,NO_TAB_1 + CP ' '-CR + JR C,NO_TAB_1 + LD A,(LPTPOS) + INC A +NO_TAB_0: + LD (LPTPOS),A +NO_TAB_1: + LD A,(NTMSXP) + AND A + JR Z,_OUTPRT + POP AF + CALL _SNVCHR + RET NC + JR NZ,OUTPRT_SPC + JR OUTPRT_CHR + +; Keyboard jp table +L1B96: + DEFB $30,K_L0F83-$0F00 + DEFB $33,K_L0F10-$0F00 + DEFB $34,K_CAPS-$0F00 + DEFB $35,K_L0F10-$0F00 + DEFB $3a,K_L0FC3-$0F00 + DEFB $3c,K_L0F10-$0F00 + DEFB $3d,K_L0F46-$0F00 + DEFB $41,K_L0F10-$0F00 + DEFB $42,K_L0F06-$0F00 + DEFB $ff,K_L0F10-$0F00 + DEFB $00 + + +; This entry point is used by the routines at OUTDO_NOFILE and NO_TAB. +_OUTPRT: + POP AF +; This entry point is used by the routines at NO_TAB and OUTPRT_SPC. +OUTPRT_CHR: + CALL _LPTOUT + RET NC + LD IX,IO_ERR + JP _CALBAS + +; Routine at 7095 +; +; Used by the routine at NO_TAB. +OUTPRT_SPC: + LD A,' ' + JR OUTPRT_CHR + +; Routine at 7099 +; +; Used by the routine at OUTDO_NOFILE. +_OUTCON: + POP AF + JP _CHPUT + +; Data block at 7103 ($1bbf) +; Data block size: $800 (2048 bytes) +_FONT: +IF SPECTRUM_SKIN + BINARY "ZXFONT.BIN" +ELSE + BINARY "msxfont.bin" +ENDIF + + ; --- START PROC L23BF --- +; Accepts a line from console until a CR or STOP +; is typed,and stores the line in a buffer. +_PINLIN: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HPINL ; Hook for PINLIN std routine +ENDIF + LD A,(AUTFLG) ; AUTO mode ? + AND A + JR NZ,_INLIN ;NO, REUGLAR MODE + LD L,$00 + JR _INLIN_0 + + +; Routine at 9164 +; +; Used by the routine at QINLIN. +; Same as PINLIN, except if AUTFLO if set. +; L23CC +_QINLIN: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HQINL ; Hook for QINLIN std routine +ENDIF + LD A,'?' + RST OUTDO ; Output char to the current device + LD A,' ' + RST OUTDO ; Output char to the current device + +; This entry point is used by the routine at INLIN. +_INLIN: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HINLI ; Hook for INLIN std routine +ENDIF + LD HL,(CSRY) + DEC L + CALL NZ,TERMIN + INC L +_INLIN_0: + LD (FSTPOS),HL + XOR A + LD (INTFLG),A +_INLIN_1: + CALL _CHGET + LD HL,INLIN_TBL-2 +IF SPECTRUM_SKIN + ; Unbind CHR$(127) and make it printable + LD C,10 +ELSE + LD C,11 +ENDIF + CALL TTY_JP + PUSH AF + CALL NZ,CTL_CHARS + POP AF + JR NC,_INLIN_1 + LD HL,BUFMIN + RET Z + CCF +L23FE: + RET + +; Routine at 9215 +; +; Used by the routine at _QINLIN. +CTL_CHARS: + PUSH AF + CP $09 ; TAB ? + JR NZ,NOTAB + POP AF +TAB_LOOP: + LD A,$20 + CALL CTL_CHARS + LD A,(CSRX) + DEC A + AND $07 + JR NZ,TAB_LOOP + RET + +; Routine at 9235 +; +; Used by the routine at CTL_CHARS. +NOTAB: + POP AF + LD HL,INSFLG + CP $01 ; ? + JR Z,NOTAB_0 + CP ' ' + JR C,L2428 + PUSH AF + LD A,(HL) + AND A + CALL NZ,L24F2 + POP AF +NOTAB_0: + RST OUTDO ; Output char to the current device + RET + +; Routine at 9256 +; +; Used by the routine at NOTAB. +L2428: + LD (HL),$00 + RST OUTDO ; Output char to the current device +L242B: + DEFB $3E ; "LD A,n" to Mask the next byte +L242C: + DEFB $3E ; "LD A,n" .. Toggle between "LD A,$AF" and "XOR A" + +; This entry point is used by the routines at L24C4, L24E5 and L25CD. +L242D: + XOR A + PUSH AF + CALL ERASE_CURSOR + POP AF + LD (CSTYLE),A + JP DISP_CURSOR + + + +; Third TTY JP table (11 entries) +INLIN_TBL: + DEFB $08 ; BS, backspace + DEFW L2561 + + DEFB $12 ; INS, toggle insert mode + DEFW L24E5 + + DEFB $1b ; ESC: No action, (just point to 'RET') + DEFW L23FE + + DEFB $02 ; CTRL-B, previous word + DEFW L260E + + DEFB $06 ; CTRL-F, next word + DEFW L25F8 + + DEFB $0E ; CTRL-N, end of logical line + DEFW L25D7 + + DEFB $05 ; CTRL-E, clear to end of line + DEFW L25B9 + + DEFB $03 ; CTRL-STOP, terminate (CTRL-C) + DEFW L24C5 + + DEFB $0d ; CR, terminate + DEFW L245A + + DEFB $15 ; CTRL-U, clear line + DEFW L25AE + +IF SPECTRUM_SKIN + ; Unbind CHR$(127) and make it printable +ELSE + DEFB $7f ; DEL, delete character + DEFW L2550 +ENDIF + + +; CR, terminate +L245A: + CALL L266C + LD A,(AUTFLG) ; AUTO mode ? + AND A + JR Z,TTY_CR_0 ;YES + LD H,$01 +TTY_CR_0: + PUSH HL + CALL ERASE_CURSOR + POP HL + LD DE,BUF + LD B,$FE + DEC L +TTY_CR_1: + INC L +TTY_CR_2: + PUSH DE + PUSH BC + CALL GETCOD + POP BC + POP DE + AND A + JR Z,TTY_CR_4 + CP $20 ; ' ' ? + JR NC,TTY_CR_3 + DEC B + JR Z,TTY_CR_5 + LD C,A + LD A,$01 + LD (DE),A + INC DE + LD A,C + ADD A,$40 +TTY_CR_3: + LD (DE),A + INC DE + DEC B + JR Z,TTY_CR_5 +TTY_CR_4: + INC H + LD A,(LINLEN) + CP H + JR NC,TTY_CR_2 + PUSH DE + CALL GETTRM + POP DE + LD H,$01 + JR Z,TTY_CR_1 +TTY_CR_5: + DEC DE + LD A,(DE) + CP ' ' + JR Z,TTY_CR_5 + PUSH HL + PUSH DE + CALL DISP_CURSOR + POP DE + POP HL + INC DE + XOR A + LD (DE),A +; This entry point is used by the routine at L24C4. +TTY_CR_6: + LD A,CR + AND A +; This entry point is used by the routine at L24C4. +TTY_CR_7: + PUSH AF + CALL TERMIN + CALL _POSIT ; Locate cursor at the specified position + LD A,LF + RST OUTDO ; Output char to the current device + XOR A + LD (INSFLG),A + POP AF + SCF + POP HL + RET + +; Routine at 9412 +L24C4: + INC L +; CTRL-STOP, terminate (CTRL-C) +L24C5: + CALL GETTRM + JR Z,L24C4 + CALL L242D + XOR A + LD (BUF),A + LD H,$01 + PUSH HL + CALL _GICINI + CALL CKSTTP ; Check for STOP trap + POP HL + JR C,TTY_CR_6 + LD A,(BASROM) + AND A + JR NZ,TTY_CR_6 + JR TTY_CR_7 + +; Routine at 9445 +; INS, toggle insert mode +L24E5: + LD HL,INSFLG + LD A,(HL) + XOR $FF + LD (HL),A + JP Z,L242D + JP L242C + +; Routine at 9458 +; +; Used by the routine at NOTAB. +L24F2: + CALL ERASE_CURSOR + LD HL,(CSRY) + LD C,$20 +; This entry point is used by the routine at L2535. +L24F2_0: + PUSH HL +L24F2_1: + PUSH BC + CALL GETCOD + POP DE + PUSH BC + LD C,E + CALL OUT_CHAR + POP BC + LD A,(LINLEN) + INC H + CP H + LD A,D + JR NC,L24F2_1 + POP HL + CALL GETTRM + JR Z,L2535_2 + LD A,C + CP $20 + PUSH AF + JR NZ,L2524 + LD A,(LINLEN) + CP H + JR Z,L2524 + POP AF + JP DISP_CURSOR + +; Routine at 9508 +; +; Used by the routine at L24F2. +L2524: + CALL TERMIN+1 + INC L + PUSH BC + PUSH HL + CALL TEXT_LINES + CP L + JR C,L2535 + CALL ESC_L_0 ; ESC,"L", insert line + JR L2535_1 + +; Routine at 9525 +; +; Used by the routine at L2524. +L2535: + LD HL,CSRY + DEC (HL) + JR NZ,L2535_0 + INC (HL) +L2535_0: + LD L,$01 + CALL ESC_M_0 ; ESC,"M", delete line + POP HL + DEC L + PUSH HL +; This entry point is used by the routine at L2524. +L2535_1: + POP HL + POP BC + POP AF + JP Z,DISP_CURSOR + DEC L +; This entry point is used by the routine at L24F2. +L2535_2: + INC L + LD H,$01 + JR L24F2_0 + +IF SPECTRUM_SKIN + ; Unbind CHR$(127) and make it printable +ELSE +; Routine at 9552 +; DEL, delete character +L2550: + LD A,(LINLEN) + CP H + JR NZ,L2550_0 + CALL GETTRM + JR NZ,L2550_5 +L2550_0: + LD A,$1C ; RIGHT, cursor right + RST OUTDO ; Output char to the current device + LD HL,(CSRY) +ENDIF + +; BS, backspace +L2561: + PUSH HL + CALL ERASE_CURSOR + POP HL + DEC H + JP NZ,L2550_2 + INC H + PUSH HL + DEC L + JR Z,L2550_1 + LD A,(LINLEN) + LD H,A + CALL GETTRM + JR NZ,L2550_1 + EX (SP),HL +L2550_1: + POP HL +L2550_2: + LD (CSRY),HL +L2550_3: + LD A,(LINLEN) + CP H + JR Z,L2550_5 + INC H +L2550_4: + CALL GETCOD + DEC H + CALL OUT_CHAR + INC H + INC H + LD A,(LINLEN) + INC A + CP H + JR NZ,L2550_4 + DEC H +L2550_5: + LD C,' ' + CALL OUT_CHAR + CALL GETTRM + JP NZ,DISP_CURSOR + PUSH HL + INC L + LD H,$01 + CALL GETCOD + EX (SP),HL + CALL OUT_CHAR + POP HL + JR L2550_3 + +; Routine at 9646 +; CTRL-U, clear line +L25AE: + CALL ERASE_CURSOR + CALL L266C + LD (CSRY),HL + JR L25B9_0 + +; Routine at 9657 +; CTRL-E, clear to end of line +L25B9: + PUSH HL + CALL ERASE_CURSOR + POP HL +; This entry point is used by the routine at L25AE. +L25B9_0: + CALL GETTRM + PUSH AF + CALL ESC_K ; ESC,"K", clear to end of line + POP AF + JR NZ,L25CD + LD H,$01 + INC L + JR L25B9_0 + +; Routine at 9677 +; +; Used by the routines at L25B9, L25D7, L25F8 and L260E. +L25CD: + CALL DISP_CURSOR + XOR A + LD (INSFLG),A + JP L242D + +; Routine at 9687 +; CTRL-N, end of logical line +L25D7: + CALL ERASE_CURSOR + LD HL,(CSRY) + DEC L +L25D7_0: + INC L + CALL GETTRM + JR Z,L25D7_0 + LD A,(LINLEN) + LD H,A + INC H +L25D7_1: + DEC H + JR Z,L25D7_2 + CALL GETCOD + CP $20 + JR Z,L25D7_1 +L25D7_2: + CALL CURS_RIGHT + JR L25CD + +; Routine at 9720 +; CTRL-F, next word +L25F8: + CALL ERASE_CURSOR + CALL L2634 +L25F8_0: + CALL L2624 + JR Z,L25CD + JR C,L25F8_0 +L25F8_1: + CALL L2624 + JR Z,L25CD + JR NC,L25F8_1 + JR L25CD + +; Routine at 9742 +; CTRL-B, previous word +L260E: + CALL ERASE_CURSOR +L260E_0: + CALL L2634 + JR Z,L25CD + JR NC,L260E_0 +L260E_1: + CALL L2634 + JR Z,L25CD + JR C,L260E_1 + CALL CURS_RIGHT + JR L25CD + +; Routine at 9764 +; +; Used by the routine at L25F8. +L2624: + LD HL,(CSRY) + CALL CURS_RIGHT + CALL TEXT_LINES + LD E,A + LD A,(LINLEN) + LD D,A + JR L2641 + +; Routine at 9780 +; +; Used by the routines at L25F8 and L260E. +L2634: + LD HL,(CSRY) + CALL CURS_LEFT + LD DE,$0101 ; TOP-LEFT ? + +; This entry point is used by the routine at L2624. +L2641: + LD HL,(CSRY) + RST DCOMPR ; Compare HL with DE. + RET Z ; ret if so + LD DE,L2668 + PUSH DE + CALL GETCOD + CP '0' + CCF + RET NC + CP '9'+1 + RET C + CP 'A' + CCF + RET NC + CP 'Z'+1 + RET C + CP 'a' + CCF + RET NC + CP 'z'+1 + RET C + CP $86 + CCF + RET NC + CP $A0 + RET C + CP $A6 + CCF +L2668: + LD A,$00 + INC A + RET + +; Routine at 9836 +; +; Used by the routines at TTY_CR and L25AE. + +L266C: + DEC L + JR Z,L266C_0 + CALL GETTRM + JR Z,L266C +L266C_0: + INC L + LD A,(FSTPOS) + CP L + LD H,$01 + RET NZ + LD HL,(FSTPOS) + RET + +; Routine at 9856 +CSTART: + JP _CSTART + +; Routine at 9859 +; +; Used by the routine at SYNCHR. +; Check syntax: a byte follows to be compared +_SYNCHR: + JP __SYNCHR + +; Routine at 9862 +; +; Used by the routine at CHRGTB. +; Gets next character (or token) from BASIC text. +_CHRGTB: + JP __CHRGTB + +; Routine at 9865 +; +; Used by the routine at GETYPR. +; Return the number type (FAC) +_GETYPR: + JP __GETYPR + + + + + +; DOUBLE PRECISION ARITHMETIC ROUTINES + +;DOUBLE PRECISION NUMBERS ARE 8 BYTE QUANTITIES +;THE LAST 4 BYTES IN MEMORY ARE IN THE SAME FORMAT AS SINGLE PRECISION NUMBERS +;THE FIRST 4 BYTES ARE 32 MORE LOW ORDER BITS OF PRECISION +;THE LOWEST ORDER BYTE COMES FIRST IN MEMORY +; +;CALLING CONVENTIONS: +;FOR ONE ARGUMENT FUNCTIONS: +; THE ARGUMENT IS IN THE FAC, THE RESULT IS LEFT IN THE FAC +;FOR TWO ARGUMENT OPERATIONS: +; THE FIRST ARGUMENT IS IN THE FAC +; THE SECOND ARGUMENT IS IN ARG-7,6,5,4,3,2,1,0 (NOTE: ARGLO=ARG-7) +; THE RESULT IS LEFT IN THE FAC +;NOTE: THIS ORDER IS REVERSED FROM INT AND SNG +;VALTYP(DOUBLE PRECISION)=10 OCTAL + + + +; FACCU <- FACCU-ARG +; + ;DOUBLE PRECISION SUBTRACTION FAC:=FAC-ARG + ;ALTERS ALL REGISTERS +; +; aka DSUB, Double precision SUB (formerly SUBCDE) +; Routine at 9868 +; Used by the routines at __SIN, __ATN, __EXP and FSUBS. +DSUB: + LD HL,ARG ;NEGATE THE SECOND ARGUMENT + LD A,(HL) ;GET THE HO AND SIGN + OR A ; Is number zero? + RET Z ; Yes - Nothing to subtract + XOR $80 ;COMPLEMNT THE SIGN + LD (HL),A ;PUT IT BACK + JR DADD_0 ;FALL INTO DADD + + + ; --- START PROC L2697 --- +; Entry used by 'NEXT' +NEXT_DADD: + CALL HL_ARG + + ; --- START PROC DADD --- +; FACCU <- FACCU+ARG +DADD: + LD HL,ARG ;GET POINTER TO EXPONENT OF FIRST ARGUMENT + LD A,(HL) ;CHECK IF IT IS ZERO ; Get FP exponent + OR A ; Is number zero? + RET Z ;IT IS, RESULT IS ALREADY IN FAC ; Yes - Nothing to add + +DADD_0: + AND $7F + LD B,A ;SAVE EXPONENT FOR UNPACKING + LD DE,FACCU ;GET POINTER TO EXPONENT OF SECOND ARGUMENT + LD A,(DE) ;GET EXPONENT ; Get FPREG exponent + OR A ;SEE IF IT IS ZERO ; Is this number zero? + JP Z,VMOVFA ;IT IS, MOVE ARG TO FAC AND WE ARE DONE ; Yes - Move FP to FPREG ; FP number larger? + AND $7F + SUB B ;SUBTRACT EXPONENTS TO GET SHIFT COUNT ; FP number larger? + JR NC,NOSWAP_DEC ;PUT THE SMALLER NUMBER IN FAC ; No - Don't swap them + CPL ;NEGATE SHIFT COUNT ; Two's complement + INC A + PUSH AF ;SAVE SHIFT COUNT + PUSH HL ;SAVE POINTER TO ARG ; Put FP on stack + LD B,$08 ;SWITCH FAC AND ARG, SET UP A COUNT +DADD_SWAP: + LD A,(DE) ;GET A BYTE OF THE FAC + LD C,(HL) ;GET A BYTE OF ARG + LD (HL),A ;PUT THE FAC BYTE IN ARG + LD A,C ;PUT THE ARG BYTE IN A + LD (DE),A ;PUT THE ARG BYTE IN FAC + INC DE ;POINT TO THE NEXT LO BYTE OF FAC + INC HL ;POINT TO THE NEXT LO BYTE OF ARG + DJNZ DADD_SWAP ;ARE WE DONE? NO, DO THE NEXT LO BYTE + POP HL ; Pointer to ARG + POP AF ;GET THE SHIFT COUNT BACK +NOSWAP_DEC: + + ;WE NOW HAVE THE SUSPECTED LARGER NO IN THE FAC, WE NEED + ;TO KNOW IF WE ARE TO SUBTRACT (SIGNS ARE DIFFERENT) AND + ;WE NEED TO RESTORE THE HIDDEN MANTISSA BIT + ;FURTHER, IF THERE IS TO BE MORE THAN 56 BITS SHIFTED + ;TO ALIGN THE BINARY POINTS THEN THE LESSOR NO. IS + ;INSIGNIFICANT IN COMPARISON TO THE LARGER NO. SO WE + ;CAN JUST RETURN AND CALL THE LARGER NO. THE ANSWER. + + CP 16 ;ARE WE WITHIN 15 BITS? ; Second number insignificant? ; (GWBASIC) THIS MUST SET CF TO CONTINUE + RET NC ;NO, ALL DONE ; Yes - First number is result + PUSH AF ;SAVE SHIFT COUNT ; Save number of bits to scale + XOR A ; + LD (FACCU+8),A ;CLEAR TEMPORARY LEAST SIG BYTE + LD (ARG+8),A ;CLEAR EXTRA BYTE + LD HL,ARG+1 ;POINT TO THE HO OF ARG ; Point to FPREG + POP AF ;GET SHIFT COUNT ; Restore scaling factor + CALL DSHFTR ;SHIFT ARG RIGHT THE RIGHT NUMBER OF TIMES ; Scale to same exponent + LD HL,ARG + LD A,(FACCU) + XOR (HL) ; Result to be positive? + JP M,DADD3 ; No - Subtract FPREG from CDE + LD A,(ARG+8) ;GET SUBTRACTION FLAG + LD (FACCU+8),A ;SUBTRACT NUMBERS IF THEIR SIGNS ARE DIFFERENT + CALL BCDADD ; Add FPREG to CDE + JP NC,DECROU ; No overflow - Round it up + EX DE,HL ; Point to exponent + LD A,(HL) + INC (HL) ; Increment it + XOR (HL) + JP M,OV_ERR ; Number overflowed - Error + +;************************************************************** +; WE ARE NOW SET TO SHIFT THE FAC RIGHT 1 BIT. RECALL WE GOT HERE WITH CF=1. +; THE INSTRUCTIONS SINCE WE GOT HERE HAVEN'T AFFECTED +; CF SO WHEN WE SHIFT RIGHT WE WILL SHIFT CF INTO THE HIGH MANTISSA BIT. +;************************************************************* + + CALL DSHFRB ;SHIFT NUMBER RIGHT ONE, SHIFT IN CARRY ; Shift result right + SET 4,(HL) + JR DECROU ; Round it up ; (GWBASIC: 'ROUND': GO ROUND THE RESULT) + +;************************************************************** +;TO GET HERE THE SIGNS OF THE FAC AND ARG WERE DIFFERENT THUS +;IMPLYING A DESIRED SUBTRACT. +;************************************************************** + +; Routine at 9975 +; Used by the routine at DADD. +DADD3: + CALL BCDSUB ;SUBTRACT FROM FAC +; This entry point is used by the routines at BNORM and __RND. +DECNRM: +; Normalize FACCU + LD HL,FACCU+1 + LD BC,$0800 ; B=8, C=256 +DECNRM_0: + LD A,(HL) ; Get MSB ;DO WE HAVE 1 BYTE OF ZEROS + OR A ; Is it zero? + JR NZ,DNORML ; No - Do it bit at a time ;NO, SHIFT ONE PLACE AT A TIME + + ;THIS LOOP SPEEDS THINGS UP BY SHIFTING 8 PLACES AT ONE TIME + INC HL + DEC C + DEC C + DJNZ DECNRM_0 + JP ZERO + + +; a.k.a. PNORM (or NORMD on GW-BASIC) + ;NORMALIZE FAC + ;ALTERS A,B,C,D,H,L +; Routine at 9996 +; Used by the routine at DADD3. +DNORML: + AND $F0 ;Check SHIFT COUNT + JR NZ,DNORM1 + PUSH HL + CALL DNORML_RLD ; shift 4 bits left the whole accumulator (multiply by 16) + POP HL + DEC C + +;*************************************************************** +;NOW DO AT 1 BYTE MOVE LEFT +;*************************************************************** + +DNORM1: + LD A,$08 + SUB B ;SUBTRACT 8 + JR Z,DNORM5 ;UNDERFLOW + PUSH AF + PUSH BC + LD C,B + LD DE,FACCU+1 + LD B,$00 + LDIR + POP BC + POP AF + LD B,A + XOR A +DNORM3: + LD (DE),A + INC DE + DJNZ DNORM3 +DNORM5: + LD A,C ;GET THE SHIFT COUNT + OR A ;SEE IF NO SHIFTING WAS DONE + JR Z,DECROU ;NONE WAS, PROCEED TO ROUND THE NUMBER + LD HL,FACCU + LD B,(HL) ;GET POINTER TO EXPONENT + ADD A,(HL) ;UPDATE IT + LD (HL),A ;SAVE UPDATED EXPONENT + XOR B + JP M,OV_ERR ; Err $06 - "Overflow" + RET Z + + + ;ROUND FAC + ;ALTERS A,B,H,L +; a.k.a. DROUND +; This entry point is used by the routines at DADD and L3301. +DECROU: + LD HL,FACCU+8 + LD B,$07 +; This entry point is used by the routine at FINDIV. +BNORM_8: + LD A,(HL) + CP $50 + RET C + DEC HL + XOR A + SCF +DNORML_5: + ADC A,(HL) + DAA + LD (HL),A + RET NC + DEC HL + DJNZ DNORML_5 + LD A,(HL) + INC (HL) + XOR (HL) + JP M,OV_ERR ; Err $06 - "Overflow" + INC HL + LD (HL),$10 + RET + +; Routine at 10073 +; +; Used by the routine at DADD. +; Add the BCD number in (HL) to (DE). Result in (DE) +BCDADD: + LD HL,ARG+7 + LD DE,FACCU+7 + LD B,$07 +; This entry point is used by the routine at DMUL. +DAA_PASS2: + XOR A + +; Add the BCD number in (HL) to (DE). Result in (DE) +BCDADD_1: + LD A,(DE) + ADC A,(HL) + DAA + LD (DE),A + DEC DE + DEC HL + DJNZ BCDADD_1 + RET + + +; Routine at 10091 +; +; Used by the routine at DADD3. +; Subtract the BCD number in (HL) from (DE). +BCDSUB: + LD HL,ARG+8 + LD A,(HL) + CP $50 + JR NZ,BCDSUB_0 + INC (HL) +BCDSUB_0: + LD DE,FACCU+8 + LD B,$08 + XOR A +BCDSUB_1: + LD A,(DE) + SBC A,(HL) + DAA + LD (DE),A + DEC DE + DEC HL + DJNZ BCDSUB_1 + RET NC + EX DE,HL + LD A,(HL) + XOR $80 + LD (HL),A + LD HL,FACCU+8 + LD B,$08 + XOR A +BCDSUB_2: + LD A,$00 + SBC A,(HL) + DAA + LD (HL),A + DEC HL + DJNZ BCDSUB_2 + RET + +; Routine at 10135 +; +; Used by the routine at DNORML. +DNORML_RLD: + LD HL,FACCU+8 +DNORML_RLD_0: + PUSH BC + XOR A +RLDLOOP: + RLD + DEC HL ;DECREMENT POINTER TO NEXT HIGHER ORDER + DJNZ RLDLOOP ;ARE WE DONE? NO, DO THE NEXT BYTE + POP BC + RET + + + ;SUBROUTINE FOR ROUND: ADD ONE TO FAC +; Routine at 10147 +; Used by the routine at DADD. +DSHFTR: + OR A + RRA + PUSH AF + OR A + JP Z,DSHFRB_0 + PUSH AF + CPL + INC A + LD C,A + LD B,$FF + LD DE,$0007 + ADD HL,DE + LD D,H + LD E,L + ADD HL,BC + + LD A,$08 ;SET UP A COUNT + ADD A,C + + LD C,A ; Move [A] bytes + PUSH BC + LD B,$00 + LDDR + POP BC + + POP AF + INC HL + INC DE + PUSH DE + LD B,A + XOR A +DSHFTR_0: + LD (HL),A + INC HL + DJNZ DSHFTR_0 + POP HL + POP AF + RET NC + LD A,C +; This entry point is used by the routine at DSHFRB. +DSHFTR_1: + PUSH HL + PUSH BC + LD B,A + XOR A +DSHFTR_2: + RRD + INC HL + DJNZ DSHFTR_2 + POP BC + POP HL + RET + +; Routine at 10203 +; +; Used by the routines at DADD and FINDIV. +DSHFRB: + LD HL,FACCU+1 +; This entry point is used by the routine at DSHFRB_0. +DSHFRB_LP: + LD A,$08 ;SET UP A COUNT, ROTATE FAC ONE LEFT + JR DSHFTR_1 + +; Used by the routine at DSHFTR. +DSHFRB_0: + POP AF + RET NC ;Exit if we're done + JR DSHFRB_LP + + +;********************************************************** +; $FMULS FMULS MULTIPLIES THE SINGLE PRECISION +; FLOATING POINT QUANTITIES AND (FAC) +; AND RETURNS THE PRODUCT IN THE (FAC). +;*********************************************************** + + +; a.k.a. DMULT +; + ;DOUBLE PRECISION MULTIPLICATION FAC:=FAC*ARG + ;ALTERS ALL REGISTERS +; +; Routine at 10214 +; Used by the routines at __LOG, MULPHL, SUMSER, FMULT and DEXP. +DMUL: + CALL SIGN ;ZF=1 WILL BE SET IF (FAC)=0 ; Test sign of FP accumulator + RET Z ;JUST RETURN IF (FAC)=0 ; Return zero if zero + LD A,(ARG) ;MUST SEE IF ARG IS ZERO + OR A + JP Z,ZERO ;RETURN ZERO + + LD B,A + LD HL,FACCU + XOR (HL) + AND $80 + LD C,A + RES 7,B + LD A,(HL) + AND $7F ; ABS + ADD A,B + LD B,A + LD (HL),$00 + AND $C0 + RET Z + CP $C0 ;MUST NOW CHECK FOR OVERFLOW + JR NZ,DMUL_0 + JP OV_ERR ; Err $06 - "Overflow" + +DMUL_0: + LD A,B + ADD A,$40 + AND $7F ; ABS + RET Z + OR C + DEC HL + LD (HL),A + LD DE,HOLD+7 + LD BC,$0008 + LD HL,FACCU+7 + PUSH DE + LDDR + INC HL + XOR A + + LD B,$08 + +; Init FP accumulator to zero +DMUL_1: + LD (HL),A + INC HL + DJNZ DMUL_1 + POP DE + LD BC,BNORM ; NORMALIZE + PUSH BC +; This entry point is used by the routine at __RND. +DMUL_2: + CALL DAA_PASS1 ; ADC/DAA loop + PUSH HL + LD BC,$0008 + EX DE,HL + LDDR + EX DE,HL + LD HL,HOLD2+7 + LD B,$08 + CALL DAA_PASS2 ; ADC/DAA loop + POP DE + CALL DAA_PASS1 ; ADC/DAA loop + LD C,$07 + LD DE,ARG+7 +DMUL_3: + LD A,(DE) + OR A + JR NZ,DMUL_4 + + DEC DE + DEC C + JR DMUL_3 + +DMUL_4: + LD A,(DE) + DEC DE + PUSH DE + LD HL,HOLD8+7 ; HOLD8+7 ; Double precision operations work area +DMUL_5: + ADD A,A + JR C,DMUL_7 + JR Z,DMUL_8 + +DMUL_6: + LD DE,$0008 + ADD HL,DE + JR DMUL_5 + +DMUL_7: + PUSH AF + LD B,$08 + LD DE,FACCU+7 + PUSH HL + CALL DAA_PASS2 + POP HL + POP AF + JR DMUL_6 + +DMUL_8: + LD B,$0F + LD DE,FACCU+14 ; some declaration is missing here but the distances between + LD HL,FACCU+15 ; the labels in this work area is the same on all the target computers + CALL LDDR_DEHL + LD (HL),$00 + POP DE + DEC C + JR NZ,DMUL_4 + RET + +; Routine at 10371 +BNORM: + DEC HL + LD A,(HL) + INC HL + LD (HL),A + JP DECNRM ; Single precision normalization + +; Routine at 10378 +; +; Used by the routine at DMUL. +; IN: HL=last byte of value +DAA_PASS1: + LD HL,$FFF8 ; -8 + ADD HL,DE ; Move on first byte of value + LD C,$03 +DAA_PASS1_0: + LD B,$08 + OR A +DAA_PASS1_1: + LD A,(DE) + ADC A,A + DAA + LD (HL),A + DEC HL + DEC DE + DJNZ DAA_PASS1_1 + DEC C + JR NZ,DAA_PASS1_0 + RET + + +; Double precision DIVIDE +; + ;DOUBLE PRECISION DIVISION FAC:=FAC/ARG + ;ALTERS ALL REGISTERS +; +; Data block at 10399 + ; --- START PROC L289F --- +DDIV: + LD A,(ARG) + OR A ;CHECK FOR DIVISION BY ZERO + JP Z,O_ERR ;GET THE EXPONENT OF ARG + LD B,A + LD HL,FACCU ;IF FAC=0 THEN ANS IS ZERO + LD A,(HL) + OR A + JP Z,ZERO + XOR B ;Compute sign + AND $80 + LD C,A + RES 7,B ; + LD A,(HL) + AND $7F ; + SUB B + LD B,A + RRA + XOR B + AND $40 + LD (HL),$00 ; zero exponent + JR Z,DDIV_1 + LD A,B + AND $80 + RET NZ +DDIV_0: + JP OV_ERR ; Err $06 - "Overflow" + + +DDIV_1: + LD A,B + ADD A,$41 + AND $7F ; ABS + LD (HL),A + JR Z,DDIV_0 + OR C + LD (HL),$00 + DEC HL + LD (HL),A + LD DE,FACCU+7 + LD HL,ARG+7 ; Unknown system variable ? + LD B,$07 + XOR A +DDIV_2: + CP (HL) + JR NZ,DDIV_3 + DEC DE + DEC HL + DJNZ DDIV_2 +DDIV_3: + LD (DECTM2),HL ; Used at division routine execution + EX DE,HL + LD (DECTMP),HL + LD A,B + LD (DECCNT),A + LD HL,HOLD +DDIV_4: + LD B,$0F +DDIV_5: + PUSH HL + PUSH BC + LD HL,(DECTM2) + EX DE,HL + LD HL,(DECTMP) + LD A,(DECCNT) + LD C,$FF +DDIV_6: + INC C + LD B,A + PUSH HL + PUSH DE + XOR A + EX DE,HL +DDIV_7: + LD A,(DE) + SBC A,(HL) + DAA + LD (DE),A + DEC HL + DEC DE + DJNZ DDIV_7 + LD A,(DE) + SBC A,B + LD (DE),A + POP DE + POP HL + LD A,(DECCNT) + JR NC,DDIV_6 + LD B,A + EX DE,HL + CALL DAA_PASS2 + JR NC,DDIV_8 + EX DE,HL + INC (HL) +DDIV_8: + LD A,C + POP BC + LD C,A + PUSH BC + SRL B + INC B + LD E,B + LD D,$00 + LD HL,FACCU-1 + ADD HL,DE + CALL DNORML_RLD_0 + POP BC + POP HL + LD A,B + INC C + DEC C + JR NZ,DDIV_13 + CP $0F + JR Z,DDIV_12 + RRCA + RLCA + JR NC,DDIV_13 + PUSH BC + PUSH HL + LD HL,FACCU + LD B,$08 + XOR A +DDIV_9: + CP (HL) + JR NZ,DDIV_11 + INC HL + DJNZ DDIV_9 + POP HL + POP BC + SRL B + INC B + XOR A +DDIV_10: + LD (HL),A + INC HL + DJNZ DDIV_10 + JR DDIV_16 + +DDIV_11: + POP HL + POP BC + LD A,B + JR DDIV_13 + +DDIV_12: + LD A,(FACCU-1) + LD E,A + DEC A + LD (FACCU-1),A + XOR E + JP P,DDIV_4 + JP ZERO ;UNDERFLOW + +DDIV_13: + RRA + LD A,C + JR C,DDIV_14 + OR (HL) + LD (HL),A + INC HL + JR DDIV_15 + +DDIV_14: + ADD A,A + ADD A,A + ADD A,A + ADD A,A + LD (HL),A +DDIV_15: + DEC B + JP NZ,DDIV_5 +DDIV_16: + LD HL,FACCU+8 + LD DE,HOLD+7 + LD B,$08 + CALL LDDR_DEHL + JP BNORM ; NORMALIZE + + ; --- START PROC L2993 --- + +; Routine at 10643 +; +; Used by the routine at __TAN. +; +; "Sine/Cosine" Taylor polynomial algorithm +__COS: ;WILL CALCULATE X=FAC/(2*PI) + LD HL,FP_EPSILON ;FP_EPSILON: 1/(2*PI) =~ 0.159155 + CALL MULPHL + LD A,(FACCU) + AND $7F ; ABS + LD (FACCU),A + LD HL,FP_QUARTER + CALL FSUBS + CALL NEG + JR __SIN_0 + + +; 'SIN' BASIC function +; + ;SINE FUNCTION + ;IDEA: USE IDENTITIES TO GET FAC IN QUADRANTS I OR IV + ;THE FAC IS DIVIDED BY 2*PI AND THE INTEGER PART IS IGNORED BECAUSE SIN(X+2*PI)=SIN(X). + ;THEN THE ARGUMENT CAN BE COMPARED WITH PI/2 BY COMPARING THE RESULT OF THE DIVISION WITH PI/2/(2*PI)=1/4. + ;IDENTITIES ARE THEN USED TO GET THE RESULT IN QUADRANTS I OR IV. + ;AN APPROXIMATION POLYNOMIAL IS THEN USED TO COMPUTE SIN(X). +; +; Routine at 10668 +; Used by the routine at __TAN. +__SIN: +;; Trick to inspect single precision constants, "PRINT SIN(X)" to display the value +; LD BC,$xxxx +; LD DE,$yyyy +; CALL FPBCDE +; CALL __CDBL +; JP VALDBL +;; +;; (to preserve the code size, comment out the some of next instructions) +;; + ;WILL CALCULATE X=FAC/(2*PI) + LD HL,FP_EPSILON ;FP_EPSILON: 1/(2*PI) =~ 0.159155 + CALL MULPHL +; This entry point is used by the routine at __COS. +__SIN_0: + LD A,(FACCU) + OR A + CALL M,NEGAFT + CALL STAKFP ;SAVE X + CALL __INT ;FAC=INT(X) + CALL FACCU2ARG + CALL USTAKFP ;FETCH X TO REGISTERS + CALL DSUB ;FAC=X-INT(X) + LD A,(FACCU) + CP $40 + JP C,__SIN_2 + LD A,(FACCU+1) + CP $25 + JP C,__SIN_2 + CP $75 + JP NC,__SIN_1 + CALL FACCU2ARG + LD HL,FP_HALF + CALL HL2FACCU + CALL DSUB + JP __SIN_2 +__SIN_1: + LD HL,FP_UNITY + CALL HL2ARG + CALL DSUB +__SIN_2: + LD HL,FP_SINTAB ; 8 values series + JP SUMSER + + + +; 'TAN' BASIC function +; + ;TANGENT FUNCTION + ;TAN(X)=SIN(X)/COS(X) +; +; Routine at 10747 +__TAN: + CALL STAKFP ; Put angle on stack + CALL __COS ; Get COS of angle + CALL XSTKFP ; Exchange stack and FP value + CALL __SIN ; Get SIN of angle + CALL USTAKARG ; Recall result of COS + LD A,(ARG) + OR A ; COS(x) is not zero.. + JP NZ,DDIV ; Go for division + JP OV_ERR ; If it is zero, Err $06 - "Overflow" + + + +; 'ATN' BASIC function + ;IDEA: USE IDENTITIES TO GET ARG BETWEEN 0 AND 1 AND THEN USE AN + ;APPROXIMATION POLYNOMIAL TO COMPUTE ARCTAN(X) +; Routine at 10772 +__ATN: + LD A,(FACCU) + OR A + RET Z + CALL M,NEGAFT ; Negate result after if -ve ;IF ARG IS NEGATIVE, USE: ARCTAN(X)=-ARCTAN(-X) + CP $41 ; Number less than 1? + JP C,__ATN_0 ; Yes - Get arc tangnt + CALL FACCU2ARG + LD HL,FP_UNITY ; BCDE = 1 ;GET THE CONSTANT 1 + CALL HL2FACCU ;COMPUTE RECIPROCAL TO USE THE IDENTITY: + CALL DDIV ; Get reciprocal of number ; ARCTAN(X)=PI/2-ARCTAN(1/X) + CALL __ATN_0 + CALL FACCU2ARG + LD HL,FP_HALFPI ; PI/2 - angle in case > 1 ;GET POINTER TO PI/2 IN CASE WE HAVE TO + CALL HL2FACCU + JP DSUB ; Number > 1 - Sub from PI/2 ; SUBTRACT THE RESULT FROM PI/2 + +__ATN_0: + LD HL,FP_TAN15 + CALL CMPPHL + JP M,ATN_SUMSER ; Evaluate sum of series + CALL STAKFP + LD HL,FP_SQR3 + CALL ADDPHL + CALL XSTKFP + LD HL,FP_SQR3 + CALL MULPHL + LD HL,FP_UNITY + CALL FSUBS + CALL USTAKARG + CALL DDIV + CALL ATN_SUMSER ; Evaluate sum of series + LD HL,FP_SIXTHPI + JP ADDPHL + +ATN_SUMSER: + LD HL,FP_ATNTAB ; Coefficient table ;EVALUATE APPROXIMATION POLYNOMIAL + JP SUMSER ; Evaluate sum of series + + +;********************************************************** +;FOR LOG CALCULATIONS HART ALGORITHM 2524 WILL BE USED +;IN THIS ALGORITHM WE WILL CALCULATE BASE 2 LOG AS FOLLOWS +;LOG(X)=P(X)/Q(X) +;*************************************************************** + +; Routine at 10866 +; +; Used by the routine at DEXP. +__LOG: + CALL SIGN ; test FP number sign + JP M,FC_ERR ; Err $05 - "Illegal function call" ;ERROR IF ($FAC).LE..0 + JP Z,FC_ERR ; Err $05 - "Illegal function call" + LD HL,FACCU + LD A,(HL) ;FETCH EXPONENT + PUSH AF + LD (HL),$41 ;ZERO THE EXPONENT + LD HL,FP_10EXHALF + CALL CMPPHL + JP M,__LOG_0 + POP AF + INC A + PUSH AF + LD HL,FACCU + DEC (HL) +__LOG_0: + POP AF + LD (TEMP3),A ;SAVE EXPONENT + CALL STAKFP + LD HL,FP_UNITY + CALL ADDPHL + CALL XSTKFP + LD HL,FP_UNITY + CALL FSUBS + CALL USTAKARG + CALL DDIV + CALL STAKFP + CALL SQUAREFP + CALL STAKFP + CALL STAKFP + LD HL,FP_LOGTAB_Q + CALL POLY ;CALCULATE Q(X) + CALL XSTKFP ;SAVE Q(X) + LD HL,FP_LOGTAB_P + CALL POLY ;NOW TO USE HART APPROX FOR P(X) + CALL USTAKARG ;RECALL Q(X) + CALL DDIV ;CALCULATE P(X)/Q(X) + CALL USTAKARG + CALL DMUL + LD HL,FP_TWODLN10 ;FETCH 2/LN(10) + CALL ADDPHL + CALL USTAKARG + CALL DMUL ;MULTIPLY TO COMPLETE + CALL STAKFP + LD A,(TEMP3) ;FETCH EXPONENT + SUB $41 + LD L,A + ADD A,A + SBC A,A + LD H,A + CALL HL_CSNG + CALL CONDS + CALL USTAKARG + CALL DADD + LD HL,FP_LN10 + JP MULPHL + + +; 'SQR' BASIC function +; + ;SQUARE ROOT FUNCTION + ;WE USE SQR(X)=X^.5 +; +; Routine at 11007 +__SQR: + CALL SIGN ; test FP number sign + RET Z + JP M,FC_ERR ; Err $05 - "Illegal function call" + CALL FACCU2ARG + LD A,(FACCU) + OR A + RRA + ADC A,$20 + LD (ARG),A + LD A,(FACCU+1) + OR A + RRCA + OR A + RRCA + AND $33 + ADD A,$10 + LD (ARG+1),A + LD A,$07 +__SQR_0: + LD (TEMP3),A + CALL STAKFP + CALL STAKARG + CALL DDIV + CALL USTAKARG + CALL DADD + LD HL,FP_HALF ; Set power to 1/2 ;GET 1/2 + CALL MULPHL + CALL FACCU2ARG + CALL USTAKFP + LD A,(TEMP3) + DEC A + JR NZ,__SQR_0 + JP ARG2FACCU + + + +;************************************************************* +; +;THE FUNCTION EXP(X) CALCULATES e^X WHERE e=2.718282 +; THE TECHNIQUE USED IS TO EMPLOY A COUPLE +; OF FUNDAMENTAL IDENTITIES THAT ALLOWS US TO +; USE THE BASE 2 THROUGH THE DIFFICULT PORTIONS OF +; THE CALCULATION: +; +; (1)e^X=2^y WHERE y=X*LOG(e) +; (2) 2^y=2^[ INT(y)+(y-INT(y)] +; (3) IF Ny=INT(y) THEN +; 2^(Ny+y-Ny)=[2^Ny]*[2^(y-Ny)] +; +; NOW, SINCE 2^Ny IS EASY TO COMPUTE (AN EXPONENT +; CALCULATION WITH MANTISSA BITS OF ZERO) THE DIFFICULT +; PORTION IS TO COMPUTE 2^(Y-Ny) WHERE 0.LE.(Y-Ny).LT.1 +; THIS IS ACCOMPLISHED WITH A POLYNOMIAL APPROXIMATION +; TO 2^Z WHERE 0.LE.Z.LT.1 . ONCE THIS IS COMPUTED WE +; HAVE TO EFFECT THE MULTIPLY BY 2^Ny . +; +;************************************************************** +; Routine at 11082 +; +; Used by the routine at DEXP. +__EXP: + LD HL,FP_LOG10E + CALL MULPHL ;y=FAC*LOG(e) + CALL STAKFP + CALL __CINT + LD A,L + RLA + SBC A,A + CP H + JR Z,__EXP_1 + LD A,H + OR A ; Test if new exponent zero ;Is it positively too big? + JP P,RESZER ; Result zero ;Yes, overflow. + CALL VALDBL ;No, underflow for negative. + CALL USTAKFP + LD HL,FP_ZERO + JP HL2FACCU +RESZER: + JP OV_ERR ; Err $06 - "Overflow" + +__EXP_1: + LD (TEMP3),HL + CALL __CDBL + CALL FACCU2ARG + CALL USTAKFP + CALL DSUB + LD HL,FP_HALF + CALL CMPPHL + PUSH AF + JR Z,__EXP_2 + JR C,__EXP_2 + LD HL,FP_HALF + CALL FSUBS +__EXP_2: + CALL STAKFP + LD HL,FP_EXPTAB2 ; 3 values series + CALL SUMSER + CALL XSTKFP + LD HL,FP_EXPTAB ; 4 values series + CALL SMSER1 + CALL USTAKARG + CALL STAKARG + CALL STAKFP + CALL DSUB + LD HL,HOLD + CALL DBL_FACCU2HL + CALL USTAKARG + CALL USTAKFP + CALL DADD + LD HL,HOLD + CALL HL2ARG + CALL DDIV + POP AF + JR C,__EXP_3 + JR Z,__EXP_3 + LD HL,FP_10EXHALF + CALL MULPHL +__EXP_3: + LD A,(TEMP3) + LD HL,FACCU + LD C,(HL) + ADD A,(HL) + LD (HL),A + XOR C + RET P + JP OV_ERR ; Err $06 - "Overflow" + + +; Routine at 11231 +__RND: + CALL SIGN ; test FP number sign + LD HL,RNDX + JR Z,__RND_0 + CALL M,DBL_FACCU2HL + LD HL,HOLD + LD DE,RNDX + CALL DBL2HL + LD HL,RNDTAB_1 + CALL HL2ARG + LD HL,RNDTAB_2 + CALL HL2FACCU + LD DE,HOLD+7 + CALL DMUL_2 + LD DE,FACCU+8 + LD HL,RNDX+1 + LD B,$07 + CALL MOVE1 ; Copy B bytes from DE to HL + LD HL,RNDX + LD (HL),$00 +__RND_0: + CALL HL2FACCU + LD HL,FACCU + LD (HL),$40 + XOR A + LD (FACCU+8),A + JP DECNRM ; Single precision normalization + +; Routine at 11300 +; +; Used by the routine at L628E. +INIT_RND: + LD DE,RNDX_INIT + LD HL,RNDX + JR DBL2HL + +; Routine at 11308 +; +; Used by the routines at __ATN and __LOG. +ADDPHL: + CALL HL2ARG + JP DADD + + +;SUBTRACTION FAC:=ARG-FAC +;ENTRY IF POINTER TO ARG IS IN (HL) + +; Routine at 11314 +; Used by the routines at __COS, __ATN, __LOG and __EXP. +FSUBS: + CALL HL2ARG ;ENTRY IF POINTER TO ARG IS IN (HL) + JP DSUB ; FPREG = -FPREG + number at HL + +; Routine at 11320 +; +; Used by the routines at __LOG and SMSER1. +SQUAREFP: + LD HL,FACCU + +; ADD number at HL to BCDE +; +; Used by the routines at __COS, __SIN, __ATN, __LOG, __SQR, __EXP, SMSER1 and +; L3878. +MULPHL: + CALL HL2ARG + JP DMUL + +; Routine at 11329 +DIVPHL: + CALL HL2ARG + JP DDIV + +; Routine at 11335 +; +; Used by the routines at __ATN, __LOG and __EXP. +CMPPHL: + CALL HL2ARG + JP XDCOMP + +; Routine at 11341 +; +; Used by the routines at __SIN, __ATN, __SQR, __EXP and L3878. +FACCU2ARG: + LD HL,FACCU +; This entry point is used by the routines at __SIN, __EXP, __RND, ADDPHL, +; FSUBS, MULPHL, DIVPHL, CMPPHL and SMSER1. + +HL2ARG: + LD DE,ARG +; This entry point is used by the routine at ARG2FACCU. +FP2DE: + EX DE,HL + CALL DBL2HL + EX DE,HL + RET + +; Routine at 11353 +; +; Used by the routines at __SQR, XSTKFP, DEXP, L3878 and L391A. +ARG2FACCU: + LD HL,ARG +; This entry point is used by the routines at __SIN, __ATN, __EXP, __RND, +; SMSER1, FOUINI, DEXP and L3878. +HL2FACCU: + LD DE,FACCU + JR FP2DE + +; Routine at 11361 ($2C61) +; ..how is this called ? +GET_RNDX: + CALL HL_CSNG + LD HL,RNDX + +; This entry point is used by the routines at __EXP, __RND, SMSER1, DEXP and +; L3878. +DBL_FACCU2HL: + LD DE,FACCU +; This entry point is used by the routines at __RND, INIT_RND and FACCU2ARG. +DBL2HL: + LD B,$08 + JP MOVE1 ; Copy B bytes from DE to HL + +; Routine at 11375 +; +; Used by the routines at __TAN, __ATN, __LOG, __EXP and DEXP. +; Exchange stack and FP value (ARG is used and left = FACCU) +XSTKFP: + POP HL + LD (FBUFFR),HL ; Buffer for fout, save ret addr. + CALL USTAKARG + CALL STAKFP + CALL ARG2FACCU + LD HL,(FBUFFR) ; Buffer for fout, restore ret addr. + JP (HL) + + +; EXPONENTIATION AND THE SQUARE ROOT FUNCTION + +; Negate number, a.k.a. PSHNEG +; +; Used by the routines at __SIN and __ATN. +NEGAFT: + CALL NEG + LD HL,NEG ;GET THE ADDRESS OF NEG + EX (SP),HL ;SWITCH RET ADDR AND ADDR OF NEG + JP (HL) ;RETURN, THE ADDRESS OF NEG IS ON THE STACK + +; This entry point is used by the routines at __SIN, __ATN and __EXP. +SUMSER: + LD (FBUFFR),HL ; Buffer for fout + CALL STAKFP + LD HL,(FBUFFR) ; Buffer for fout + CALL SMSER1 + CALL USTAKARG ; Move FPREG to BCDE ;SQUARE X + JP DMUL ; Square the value + +; Routine at 11418 +; +; Used by the routines at __EXP and SUMSER. +SMSER1: + LD (FBUFFR),HL ; Buffer for fout + CALL SQUAREFP + LD HL,(FBUFFR) ; Buffer for fout +; This entry point is used by the routine at __LOG. +POLY: + LD A,(HL) ; Get number of coefficients ;GET DEGREE + PUSH AF ; Save count ;SAVE DEGREE + INC HL ; Point to start of table ;INCREMENT POINTER TO FIRST CONSTANT + PUSH HL + LD HL,FBUFFR ; Buffer for fout + CALL DBL_FACCU2HL + POP HL ; Point to start of table + CALL HL2FACCU ; Move coefficient to FPREG ;MOVE FIRST CONSTANT TO FAC +SUMLP: + POP AF ; Restore count ;GET DEGREE + DEC A ; Cont coefficients ;ARE WE DONE? + RET Z ; All done ;YES, RETURN + PUSH AF ; Save count ;SAVE DEGREE + PUSH HL ; Save address in table ;SAVE CONSTANT POINTER + LD HL,FBUFFR ; Buffer for fout + CALL MULPHL ; Multiply FPREG by BCDE ;EVALUATE THE POLY, MULTIPLY BY X + POP HL ; Restore address in table ;GET LOCATION OF CONSTANTS + CALL HL2ARG ; Number at HL to BCDE ;GET CONSTANT + PUSH HL ; Save address in table ;STORE LOCATION OF CONSTANTS SO FADD AND FMULT + CALL DADD ; Add coefficient to FPREG ; WILL NOT SCREW THEM UP, ADD IN CONSTANT + POP HL ; Restore address in table ;MOVE CONSTANT POINTER TO NEXT CONSTANT + JR SUMLP ; More coefficients ;SEE IF DONE + +; Routine at 11463 +; +; Used by the routines at __SQR, __EXP and L391A. +STAKARG: + LD HL,ARG+7 + JR STAKFP_0 + +; Routine at 11468 +; +; Used by the routines at __SIN, __TAN, __ATN, __LOG, __SQR, __EXP, XSTKFP, +; SUMSER, DEXP and L3878. +STAKFP: + LD HL,FACCU+7 +; This entry point is used by the routine at STAKARG. +STAKFP_0: + LD A,$04 + POP DE +STAKFP_1: + LD B,(HL) + DEC HL + LD C,(HL) + DEC HL + PUSH BC + DEC A + JR NZ,STAKFP_1 + EX DE,HL + JP (HL) + + +; This entry point is used by the routines at __TAN, __ATN, __LOG, __SQR, +; __EXP, XSTKFP, SUMSER, DEXP and L391A. +USTAKARG: + LD HL,ARG + JR USTAK_SUB + + ; --- START PROC USTAKFP --- +USTAKFP: + LD HL,FACCU + + ; --- START PROC USTAK_SUB --- +USTAK_SUB: + LD A,$04 + POP DE +USTAK_SUB_0: + POP BC + LD (HL),C + INC HL + LD (HL),B + INC HL + DEC A + JR NZ,USTAK_SUB_0 + EX DE,HL + JP (HL) + + +; FP "operands" for RND + +RNDTAB_2: + DEFB $00,$14,$38,$98,$20,$42,$08,$21 + +RNDTAB_1: + DEFB $00,$21,$13,$24,$86,$54,$05,$19 + +; Constant to initialize the "last random number" variable +RNDX_INIT: + DEFB $00,$40,$64,$96,$51,$37,$23,$58 + + +; FP Numeric constants + +FP_LOG10E: + DEFB $40,$43,$42,$94,$48,$19,$03,$24 ; LOG(E) =~ 0.43429448190324 + +FP_HALF: + DEFB $40,$50 ; 0.5 +FP_ZERO: + DEFB $00,$00,$00,$00,$00,$00,$00,$00 ; 0 + +; Why did they optimize space for FP_HALF and +; preferred not to reuse the last value of FP_ATNTAB for FP UNITY ? +FP_UNITY: + DEFB $41,$10,$00,$00,$00,$00,$00,$00 ; 1 + +FP_QUARTER: + DEFB $40,$25,$00,$00,$00,$00,$00,$00 ; 1/4 = 0.25 + +FP_10EXHALF: + DEFB $41,$31,$62,$27,$76,$60,$16,$84 ; 10^(1/2) =~ 3.1622776601684 + +FP_TWODLN10: + DEFB $40,$86,$85,$88,$96,$38,$06,$50 ; 2/LN(10) =~ 0.8685889638065 + +FP_LN10: + DEFB $41,$23,$02,$58,$50,$92,$99,$40 ; LN(10) =~ 2.302585092994 + +FP_HALFPI: + DEFB $41,$15,$70,$79,$63,$26,$79,$49 ; PI/2 =~ 1.5707963267949 + +FP_TAN15: + DEFB $40,$26,$79,$49,$19,$24,$31,$12 ; TAN(15) =~ 0.26794919243112 + +FP_SQR3: + DEFB $41,$17,$32,$05,$08,$07,$56,$89 ; SQR(3) =~ 1.7320508075689 + +FP_SIXTHPI: + DEFB $40,$52,$35,$98,$77,$55,$98,$30 ; PI/6 =~ 0.5235987755983 + +FP_EPSILON: + DEFB $40,$15,$91,$54,$94,$30,$91,$90 ; 1/(2*PI) =~ 0.1591549430919 + +FP_EXPTAB: + DEFB $04 ; 4 values series + DEFB $41,$10,$00,$00,$00,$00,$00,$00 ; 1 + DEFB $43,$15,$93,$74,$15,$23,$60,$31 ; 159.37415236031 + DEFB $44,$27,$09,$31,$69,$40,$85,$16 ; 2709.3169408516 + DEFB $44,$44,$97,$63,$35,$57,$40,$58 ; 4497.6335574058 + +FP_EXPTAB2: + DEFB $03 ; 3 values + DEFB $42,$18,$31,$23,$60,$15,$92,$75 ; 18.31236015975 + DEFB $43,$83,$14,$06,$72,$12,$93,$71 ; 831.4067219371 + DEFB $44,$51,$78,$09,$19,$91,$51,$62 ; 5178.0919915162 + +FP_LOGTAB_P: + DEFB $04 ; 4 values + DEFB $c0,$71,$43,$33,$82,$15,$32,$26 ; -0.71433382153226 + DEFB $41,$62,$50,$36,$51,$12,$79,$08 ; 6.2503651127908 + DEFB $C2,$13,$68,$23,$70,$24,$15,$03 ; -13.682370241503 + DEFB $41,$85,$16,$73,$19,$87,$23,$89 ; 8.5167319872389 + +FP_LOGTAB_Q: + DEFB $05 ; 5 values + DEFB $41,$10,$00,$00,$00,$00,$00,$00 ; 1 + DEFB $C2,$13,$21,$04,$78,$35,$01,$56 ; -13.210478350156 + DEFB $42,$47,$92,$52,$56,$04,$38,$73 ; 47.925256043873 + DEFB $C2,$64,$90,$66,$82,$74,$09,$43 ; -64.906682740943 + DEFB $42,$29,$41,$57,$50,$17,$23,$23 ; 29.415750172323 + +; Compared to the earlier BASIC versions this one is much more accurate +; the first three values of the list were simply missing +FP_SINTAB: + DEFB $08 ; 8 values + DEFB $C0,$69,$21,$56,$92,$29,$18,$09 ; -0.69215692291809 + DEFB $41,$38,$17,$28,$86,$38,$57,$71 ; 3.8172886385771 + DEFB $C2,$15,$09,$44,$99,$47,$48,$01 ; -15.094499474801 + DEFB $42,$42,$05,$86,$89,$66,$73,$55 ; 42.048689667355 + DEFB $c2,$76,$70,$58,$59,$68,$32,$91 ; -76.605859683291 + DEFB $42,$81,$60,$52,$49,$27,$55,$13 ; 81.605249275513 -> .7968968E-1 + DEFB $c2,$41,$34,$17,$02,$24,$03,$98 ; -41.341702240398 -> -.6459637 + DEFB $41,$62,$83,$18,$53,$07,$17,$96 ; 6.2831853071796 -> 1.570796 + +FP_ATNTAB: + DEFB $08 ; 8 values ; Approx. conversion of list + DEFB $BF,$52,$08,$69,$39,$04,$00,$00 ; -1/19 =~ -0.05208693904 (slightly smaller) + DEFB $3F,$75,$30,$71,$49,$13,$48,$00 ; 1/13 =~ 0.0753071491348 (slightly smaller) + DEFB $bf,$90,$81,$34,$32,$24,$70,$50 ; -1/11 =~ -0.09081343224705 + DEFB $40,$11,$11,$07,$94,$18,$40,$29 ; 1/9 =~ 0.11110794184029 + DEFB $C0,$14,$28,$57,$08,$55,$48,$84 ; -1/7 =~ -0.14285708554884 + DEFB $40,$19,$99,$99,$99,$94,$89,$67 ; 1/5 =~ 0.19999999948967 + DEFB $C0,$33,$33,$33,$33,$33,$31,$60 ; -1/3 =~ -0,3333333333316 + DEFB $41,$10,$00,$00,$00,$00,$00,$00 ; 1/1 = 1 + + + +; Test sign of FPREG + + ;PUT SIGN OF FAC IN A + ;ALTERS A ONLY + ;LEAVES FAC ALONE + ;NOTE: TO TAKE ADVANTAGE OF THE RST INSTRUCTIONS TO SAVE BYTES, FSIGN IS USUALLY DEFINED TO BE AN RST. + ;"FSIGN" IS EQUIVALENT TO "CALL SIGN" + ;THE FIRST FEW INSTRUCTIONS OF SIGN (THE ONES BEFORE SIGNC) ARE DONE IN THE 8 BYTES AT THE RST LOCATION. + +SIGN: + LD A,(FACCU) ; Get sign of FPREG + OR A ;CHECK IF THE NUMBER IS ZERO + RET Z ; RETurn if number is zero ;IT IS, A IS ZERO + DEFB $FE ; CP 2Fh ..hides the "CPL" instruction ;"CPI" AROUND NEXT BYTE + +FCOMPS: + CPL ; Invert sign ;ENTRY FROM FCOMP, COMPLEMENT SIGN + + ; --- START PROC L2E78 --- +ICOMPS: + RLA ; Sign bit to carry ;ENTRY FROM ICOMP, PUT SIGN BIT IN CARRY + + ; --- START PROC L2E79 --- +SIGNS: + SBC A,A ; Carry to all bits of A ;A=0 IF CARRY WAS 0, A=377 IF CARRY WAS 1 + RET NZ ; Return -1 if negative ;RETURN IF NUMBER WAS NEGATIVE + INC A ; Bump to +1 ;PUT ONE IN A IF NUMBER WAS POSITIVE + RET ; Positive - Return +1 ;ALL DONE + + +;ZERO FAC +;ALTERS A ONLY +;EXITS WITH A=0 +;BY OUR FLOATING POINT FORMAT, THE NUMBER IS ZERO IF THE EXPONENT IS ZERO + +; Routine at 11901 +; +; Used by the routines at DADD3, DMUL and __FIX. +ZERO: + XOR A ; Result is zero ;ZERO A + LD (FACCU),A ; Save result as zero ;ZERO THE FAC'S EXPONENT, ENTRY IF A=0 + RET ;ALL DONE + + +; +; ;GET THE VALTYP AND SET CONDITION CODES AS FOLLOWS: +;;CONDITION CODE TRUE SET FALSE SET +;;SIGN INT=2 STR,SNG,DBL +;;ZERO STR=3 INT,SNG,DBL +;;ODD PARITY SNG=4 INT,STR,DBL +;;NO CARRY DBL=10 INT,STR,SNG +;GETYPE: LDA VALTYP ;GET THE VALTYP +; CPI 10 ;SET CARRY CORRECTLY +; DCR A ;SET THE OTHER CONDITION CODES CORRECTLY +; DCR A ; WITHOUT AFFECTING CARRY +; DCR A +; RET * ;ALL DONE + + +; 'ABS' BASIC function + + ;ABSOLUTE VALUE OF FAC + ;ALTERS A,B,C,D,E,H,L + +; +; Routine at 11906 +__ABS: + CALL VSIGN ;GET THE SIGN OF THE FAC IN A + RET P ;IF IT IS POSITIVE, WE ARE DONE + + +; Invert number sign + + ;NEGATE ANY TYPE VALUE IN THE FAC + ;ALTERS A,B,C,D,E,H,L + +; +; Used by the routines at __FIX, L3301 and OPRND. +INVSGN: + RST GETYPR ;SEE WHAT KIND OF NUMBER WE HAVE + JP M,INEG ;WE HAVE AN INTEGER, NEGATE IT THAT WAY + JP Z,TM_ERR ;BLOW UP ON STRINGS, If string type, Err $0D - "Type mismatch" + ;FALL INTO NEG TO NEGATE A SNG OR DBL + + +; Invert number sign + + ;NEGATE NUMBER IN THE FAC + ;ALTERS A,H,L + ;NOTE: THE NUMBER MUST BE PACKED + +; +; This entry point is used by the routines at __COS, NEGAFT, __FIX, IMULT and FSUB. +NEG: + LD HL,FACCU ;GET POINTER TO SIGN + +INVSGN_1: + LD A,(HL) ;GET SIGN + OR A + RET Z + XOR $80 ;COMPLEMENT SIGN BIT + LD (HL),A ;SAVE IT + RET ;ALL DONE + + +; 'SGN' BASIC function + + ;SGN FUNCTION + ;ALTERS A,H,L +; +; Routine at 11927 +__SGN: + CALL VSIGN ;GET THE SIGN OF THE FAC IN A ; Test sign of FPREG + +;ENTRY TO CONVERT A SIGNED NUMBER IN A TO AN INTEGER +; Signed char to signed int conversion, then return +; Get back from function, result in A (signed) +; +; This entry point is used by the routines at DOCMP, CAS_EOF, FN_PLAY and __STRIG. +CONIA: ;ENTRY TO CONVERT A SIGNED NUMBER IN A TO AN INTEGER + LD L,A ;PUT IT IN THE LO POSITION + RLA ;EXTEND THE SIGN TO THE HO ; Sign bit to carry + SBC A,A ; Carry to all bits of A + LD H,A + JP MAKINT ;RETURN THE RESULT AND SET VALTYP + + +; Test sign in number + + ;GET THE SIGN OF THE VALUE IN THE FAC IN A + ;ALTERS A,H,L +; +; Routine at 11937 +; +; Used by the routines at __ABS, __SGN and __IF. +VSIGN: + RST GETYPR ;SEE WHAT KIND OF A NUMBER WE HAVE + JP Z,TM_ERR ;BLOW UP ON STRINGS + JP P,SIGN ;SINGLE AND DOUBLE PREC. WORK THE SAME + LD HL,(FACLOW) ;GET THE INTEGER ARGUMENT + + + ;ENTRY TO FIND THE SIGN OF (HL) + ;ALTERS A ONLY +ISIGN: + LD A,H ;GET ITS SIGN + OR L ;CHECK IF THE NUMBER IS ZERO + RET Z ;IT IS, WE ARE DONE + LD A,H ;IT ISN'T, SIGN IS THE SIGN OF H + JR ICOMPS ;GO SET A CORRECTLY + + +; Put FP value on stack + + ;FLOATING POINT MOVEMENT ROUTINES + ;PUT FAC ON STACK + ;ALTERS D,E +; +; Routine at 11953 +; Used by the routines at IADD, IMULT, IDIV and CGTCNT. +PUSHF: + EX DE,HL ; Save code string address ;SAVE (HL) + LD HL,(FACLOW) ; LSB,NLSB of FPREG ;GET LO'S + EX (SP),HL ; Stack them,get return ;SWITCH LO'S AND RET ADDR + PUSH HL ; Re-save return ;PUT RET ADDR BACK ON STACK + LD HL,(FACCU) ; MSB and exponent of FPREG ;GET HO'S + EX (SP),HL ; Stack them,get return ;SWITCH HO'S AND RET ADDR + PUSH HL ; Re-save return ;PUT RET ADDR BACK ON STACK + EX DE,HL ; Restore code string address ;GET OLD (HL) BACK + RET ;ALL DONE + +; Routine at 11966 +; +; Used by the routine at DOSND. +MOVFM: + CALL LOADFP ; Number at HL to BCDE ;GET NUMBER IN REGISTERS + ;FALL INTO MOVFR AND PUT IT IN FAC + +; Move BCDE to FPREG +; a.k.a. MOVFR +; + ;MOVE REGISTERS (B,C,D,E) TO FAC + ;ALTERS D,E +; +FPBCDE: + EX DE,HL ; Save code string address ;GET LO'S IN (HL) + LD (FACLOW),HL ; Save LSB,NLSB of number ;PUT THEM WHERE THEY BELONG + LD H,B ; Exponent of number ;GET HO'S IN (HL) + LD L,C ; MSB of number + LD (FACCU),HL ; Save MSB and exponent ;PUT HO'S WHERE THEY BELONG + EX DE,HL ; Restore code string address ;GET OLD (HL) BACK + RET ;ALL DONE + + +; Load FP reg to BCDE +; a.k.a. MOVRF +; + ;MOVE FAC TO REGISTERS (B,C,D,E) + ;ALTERS B,C,D,E,H,L +; +; Routine at 11980 +BCDEFP: + LD HL,(FACLOW) ; Point to FPREG ;GET POINTER TO FAC + +; Load FP value pointed by HL to BCDE, +; a.k.a. MOVRM +; +;GET NUMBER IN REGISTERS (B,C,D,E) FROM MEMORY [(HL)] +;ALTERS B,C,D,E,H,L +;AT EXIT (HL):=(HL)+4 +; + EX DE,HL + LD HL,(FACCU) + LD C,L + LD B,H + RET + + +; Load single precision FP value from (HL) into BCDE in reverse byte order +; a.k.a. LOADFP_CBED +; +; Routine at 11990 +; Used by the routine at __NEXT. +HLBCDE: + LD C,(HL) + INC HL + LD B,(HL) + INC HL + LD E,(HL) + INC HL + LD D,(HL) + INC HL + RET + + +; Load FP value pointed by HL to BCDE, +; a.k.a. MOVRM +; +;GET NUMBER IN REGISTERS (B,C,D,E) FROM MEMORY [(HL)] +;ALTERS B,C,D,E,H,L +;AT EXIT (HL):=(HL)+4 +; +; Routine at 11999 +; Used by the routines at MOVFM, L324B, __NEXT and GNXARY. +LOADFP: + LD E,(HL) ; Get LSB of number ;GET LO + INC HL ;POINT TO MO +; This entry point is used by the routine at PRS1. +LOADFP_0: + LD D,(HL) ; Get NMSB of number ;GET MO, ENTRY FOR BILL + INC HL ;POINT TO HO + LD C,(HL) ; Get MSB of number ;GET HO + INC HL ;POINT TO EXPONENT + LD B,(HL) ; Get exponent of number ;GET EXPONENT + +INCHL: + INC HL ; Used for conditional "INC HL" ;INC POINTER TO BEGINNING OF NEXT NUMBER + RET ;ALL DONE + + + ;MOVE NUMBER FROM FAC TO MEMORY [(HL)] + ;ALTERS A,B,D,E,H,L + ;a.k.a. MOVMF +; Routine at 12008 +; Used by the routine at __NEXT. +; copy number value from FPREG (FP accumulator) to HL +FPTHL: + LD DE,FACCU ; Point to FPREG ;GET POINTER TO FAC + ;FALL INTO MOVE + ;MOVE NUMBER FROM (DE) TO (HL) + ;ALTERS A,B,D,E,H,L + ;EXITS WITH (DE):=(DE)+4, (HL):=(HL)+4 + LD B,$04 ; 4 bytes to move ;SET COUNTER + JR MOVE1 ;CONTINUE WITH THE MOVE + +; Routine at 12015 +; +; Used by the routine at __NEXT. +HL_ARG: + LD DE,ARG ;ENTRY TO SWITCH (DE) AND (HL) + +; Copy number value from HL to DE + ;MOVE ANY TYPE VALUE (AS INDICATED BY VALTYP) FROM (DE) TO (HL) + ;ALTERS A,B,D,E,H,L +MOVVFM: + EX DE,HL + +; This entry point is used by the routines at __LET, __SWAP, TSTOPL and LHSMID. +; Copy number value from DE to HL + ; --- START PROC L2EF3 --- +VMOVE: + LD A,(VALTYP) ;GET THE LENGTH OF THE NUMBER + LD B,A ;SAVE IT AWAY (number of bytes to move) + +; This entry point is used by the routines at __RND, GET_RNDX, FPTHL and MAKTKN. +; Copy B bytes from DE to HL + + ; --- START PROC L2EF7 --- +MOVE1: + LD A,(DE) ; Get source ;GET WORD, ENTRY FROM VMOVMF + LD (HL),A ; Save destination ;PUT IT WHERE IT BELONGS + INC DE ; Next source ;INCREMENT POINTERS TO NEXT WORD + INC HL ; Next destination + DJNZ MOVE1 ; Copy B bytes from DE to HL + RET + +; Routine at 12030 +; +; Used by the routine at DMUL. +; Similar to LDDR but moving from DE to HL, B times. +LDDR_DEHL: + LD A,(DE) + LD (HL),A + DEC DE + DEC HL + DJNZ LDDR_DEHL + RET + + + ;MOVE ANY TYPE VALUE FROM MEMORY [(HL)] TO FAC + ;ALTERS A,B,D,E,H,L +; Routine at 12037 +VMOVFA: + LD HL,ARG ;ENTRY FROM DADD, MOVE ARG TO FAC + +; This entry point is used by the routines at NUMCON, OPRND and __NEXT. +VMOVFM: + LD DE,MOVVFM ;GET ADDRESS OF LOCATION THAT DOES ; Copy number value from HL to DE + JR VMVVFM ; AN "XCHG" AND FALLS INTO MOVE1 + + + ;MOVE ANY TYPE VALUE FROM FAC TO MEMORY [(HL)] + ;ALTERS A,B,D,E,H,L +; Routine at 12045 +; Used by the routines at DOSND. +VMOVAF: + LD HL,ARG ;ENTRY FROM FIN, DMUL10, DDIV10 + + + ;MOVE FAC TO ARG +; This entry point is used by the routines at DOFN and __NEXT. + ; --- START PROC L2F10 --- +VMOVMF: + LD DE,VMOVE ;GET ADDRESS OF MOVE SUBROUTINE (Copy number value from DE to HL) + +; This entry point is used by the routine at VMOVFA. +VMVVFM: + PUSH DE ;SHOVE IT ON THE STACK +;VDFACS: + LD DE,FACCU ;GET FIRST ADDRESS FOR INT, STR, SNG + LD A,(VALTYP) ;GET THE VALUE TYPE + CP $04 + RET NC ;GO MOVE IT IF WE DO NOT HAVE A DBL + LD DE,FACLOW ;WE DO, GET LO ADDR OF THE DBL NUMBER + RET ;GO DO THE MOVE + + +; COMPARE TWO NUMBERS + + ;COMPARE TWO SINGLE PRECISION NUMBERS + ;A=1 IF ARG .LT. FAC + ;A=0 IF ARG=FAC + ;A=-1 IF ARG .GT. FAC + ;DOREL DEPENDS UPON THE FACT THAT FCOMP RETURNS WITH CARRY ON + ; IFF A HAS 377 + ;ALTERS A,H,L + +; aka CMPNUM, Compare FP reg to BCDE +; Routine at 12065 +; +; Used by the routines at CONIS2, GETWORD_HL, CMPONE and __NEXT. +FCOMP: + LD A,C ; Get exponent of number + OR A ;CHECK IF ARG IS ZERO + JP Z,SIGN ; Zero - Test sign of FPREG + LD HL,FCOMPS ; Return relation routine ;WE JUMP TO FCOMPS WHEN WE ARE DONE + PUSH HL ; Save for return ;PUT THE ADDRESS ON THE STACK + CALL SIGN ; Test sign of FPREG ;CHECK IF FAC IS ZERO + LD A,C ; Get MSB of number ;IF IT IS, RESULT IS MINUS THE SIGN OF ARG + RET Z ; FPREG zero - Number's MSB ;IT IS + LD HL,FACCU ; MSB of FPREG ;POINT TO SIGN OF FAC + XOR (HL) ; Combine signs ;SEE IF THE SIGNS ARE THE SAME + LD A,C ; Get MSB of number ;IF THEY ARE DIFFERENT, RESULT IS SIGN OF ARG + RET M ; Exit if signs different ;THEY ARE DIFFERENT + CALL CMPFP ; Compare FP numbers ;CHECK THE REST OF THE NUMBER +; This entry point is used by the routine at XDCOMP. +;FCOMPD: + RRA ; Get carry to sign ;NUMBERS ARE DIFFERENT, CHANGE SIGN IF + XOR C ; Combine with MSB of number ; BOTH NUMBERS ARE NEGATIVE + RET ;GO SET UP A + +; Routine at 12091 +; +; Used by the routine at FCOMP. +; +CMPFP: + LD A,C ; Point to exponent ;POINT TO EXPONENT + CP (HL) ; Get exponent ;GET EXPONENT OF ARG + RET NZ ; Compare exponents ;COMPARE THE TWO + INC HL ; Different ;NUMBERS ARE DIFFERENT + LD A,B ; Point to MBS ;POINT TO HO + CP (HL) ; Get MSB ;GET HO OF ARG + RET NZ ; Compare MSBs ;COMPARE WITH HO OF FAC + INC HL ; Different ;THEY ARE DIFFERENT + LD A,E ; Point to NMSB ;POINT TO MO OF FAC + CP (HL) ; Get NMSB ;GET MO OF ARG + RET NZ ; Compare NMSBs ;COMPARE WITH MO OF FAC + INC HL ; Different ;THE NUMBERS ARE DIFFERENT + LD A,D ; Point to LSB ;POINT TO LO OF FAC + SUB (HL) ; Get LSB ;GET LO OF ARG + RET NZ ; Compare LSBs ;SUBTRACT LO OF FAC + POP HL ; Different ;NUMBERS ARE DIFFERENT + POP HL ; Drop RETurn ;NUMBERS ARE THE SAME, DON'T SCREW UP STACK + RET ; Drop another RETurn + ;ALL DONE + +; Integer COMPARE +; Compare the signed integer in DE to the signed integer in HL +; + ;COMPARE TWO INTEGERS + ;A=1 IF (DE) .LT. (HL) + ;A=0 IF (DE)=(HL) + ;A=-1 IF (DE) .GT. (HL) + ;ALTERS A ONLY +; +; Routine at 12109 +; Used by the routine at __NEXT. +ICOMP: + LD A,D ;ARE THE SIGNS THE SAME? + XOR H + LD A,H ;IF NOT, ANSWER IS THE SIGN OF (HL) + JP M,ICOMPS ;THEY ARE DIFFERENT + CP D ;THEY ARE THE SAME, COMPARE THE HO'S + JR NZ,ICOMP_0 ;GO SET UP A + LD A,L ;COMPARE THE LO'S + SUB E + RET Z ;ALL DONE, THEY ARE THE SAME +ICOMP_0: + JP SIGNS ;GO SET UP A + + + ;COMPARE TWO DOUBLE PRECISION NUMBERS + ;A=1 IF ARG .LT. FAC + ;A=0 IF ARG=FAC + ;A=-1 IF ARG .GT. FAC + ;ALTERS A,B,C,D,E,H,L + +; a.k.a. DCOMPD +; Routine at 12124 +; +; Used by the routines at CMPPHL, DCOMP, L391A and __NEXT. +XDCOMP: + LD DE,ARG ;GET POINTER TO ARG + LD A,(DE) ;SEE IF ARG=0 + OR A + JP Z,SIGN ;ARG=0, GO SET UP A + LD HL,FCOMPS ;PUSH FCOMPS ON STACK SO WE WILL RETURN TO + PUSH HL ; TO IT AND SET UP A + CALL SIGN ;SEE IF FAC=0 + LD A,(DE) ;GET SIGN OF ARG + LD C,A ;SAVE IT FOR LATER + RET Z ;FAC=0, SIGN OF RESULT IS SIGN OF ARG + LD HL,FACCU ;POINT TO SIGN OF FAC + XOR (HL) ;SEE IF THE SIGNS ARE THE SAME + LD A,C ;IF THEY ARE, GET THE SIGN OF THE NUMBERS + RET M ;THE SIGNS ARE DIFFERENT, GO SET A + LD B,$08 ;SET UP A COUNT +XDCOMP_0: + LD A,(DE) ;GET A BYTE FROM ARG + SUB (HL) ;COMPARE IT WITH THE FAC + JR NZ,FCOMPD ;THEY ARE DIFFERENT, GO SET UP A + INC DE ;THEY ARE THE SAME, EXAMINE THE NEXT LOWER + INC HL ; ORDER BYTES + DJNZ XDCOMP_0 ;ARE WE DONE? NO, COMPARE THE NEXT BYTES + POP BC ;THEY ARE THE SAME, GET FCOMPS OFF STACK + RET ;ALL DONE + +FCOMPD: + RRA ; Get carry to sign ;NUMBERS ARE DIFFERENT, CHANGE SIGN IF + XOR C ; Combine with MSB of number ; BOTH NUMBERS ARE NEGATIVE + RET ;GO SET UP A + + +; Compare the double precision numbers in FAC1 and ARG + ;COMPARE TWO DOUBLE PRECISION NUMBERS + ;A=1 IF ARG .GT. FAC + ;A=0 IF ARG=FAC + ;A=-1 IF ARG .LT. FAC + ;NOTE: THIS IS THE REVERSE OF ICOMP, FCOMP AND XDCOMP + ;ALTERS A,B,C,D,E,H,L +; Double precision COMPARE +; Routine at 12163 +DCOMP: + CALL XDCOMP ;COMPARE THE TWO NUMBERS + JP NZ,FCOMPS ;NEGATE THE ANSWER, MAKE SURE THE CARRY COMES + RET ; OUT CORRECT FOR DOCMP + + + +; CONVERSION ROUTINES BETWEEN INTEGER, SINGLE AND DOUBLE PRECISION + + +; 'CINT' BASIC function +; a.k.a. FRCINT + ;FORCE THE FAC TO BE AN INTEGER + ;ALTERS A,B,C,D,E,H,L +; +; Routine at 12170 +; Used by the routines at __EXP, EVAL, NOT, DANDOR, DEPINT, VARGET, __CIRCLE, +; CGTCNT, DOSND and PARMADDR. + ; --- START PROC L2F8A --- +__CINT: + RST GETYPR ;SEE WHAT WE HAVE + LD HL,(FACLOW) ;GET FACLO+0,1 IN CASE WE HAVE AN INTEGER + RET M ;WE HAVE AN INTEGER, ALL DONE + JP Z,TM_ERR ;WE HAVE A STRING, THAT IS A "NO-NO" + CALL CINT + JP C,OV_ERR + EX DE,HL + + +; Get back from function, result in HL +; + ;PUT (HL) IN FACLO, SET VALTYP TO INT + ;ALTERS A ONLY +; +; This entry point is used by the routines at __SGN, CONIS2, __FIX, IMULT, +; IMULDV, IN_PRT, OPRND, OCTCNS, __POS, FN_POINT, __CIRCLE and CGTCNT. +MAKINT: + LD (FACLOW),HL ;STORE THE NUMBER IN FACLO +; This entry point is used by the routine at IMOD. +VALINT: + LD A,$02 ;SET VALTYP TO "INTEGER" +; This entry point is used by the routine at VALSNG. +SETTYPE: + LD (VALTYP),A ;ENTRY FROM CONDS + RET ;ALL DONE + +; Routine at 12194 +; +; Used by the routine at L3301. +CONIS2: + LD BC,$32C5 ; BCDE = -32768 (float) + LD DE,$8076 + CALL FCOMP ;CHECK IF NUMBER IS -32768, ENTRY FROM FIN + RET NZ ;ERROR: IT CAN'T BE CONVERTED TO AN INTEGER + LD HL,$8000 ;IT IS -32768, PUT IT IN (HL) + +; This entry point is used by the routine at IADD. +CONIS1: + POP DE + JR MAKINT ;STORE IT IN THE FAC AND SET VALTYP + + +; 'CSNG' BASIC function +; + ;FORCE THE FAC TO BE A SINGLE PRECISION NUMBER + ;ALTERS A,B,C,D,E,H,L +; +; Convert number to single precision +__CSNG: + RST GETYPR ;SEE WHAT KIND OF NUMBER WE HAVE + RET PO ;WE ALREADY HAVE A SNG, ALL DONE + JP M,CONSI ;WE HAVE AN INTEGER, CONVERT IT + JP Z,TM_ERR ;STRINGS!! -- ERROR!! + ;DBL PREC -- FALL INTO CONSD +;CONSD: + CALL VALSNG ;IF NOT INTEGER FORCE DOUBLE TO S.P. + CALL FTCH_SNG ;Fetch in single precision + INC HL + LD A,B + OR A + RRA ;WANT ROUND-UP IF HIGH BIT SET + LD B,A + JP BNORM_8 ;GO ROUND THE NUMBER + + + +; Convert the signed integer in FAC1 to single precision. + ;CONVERT AN INTEGER TO A SINGLE PRECISION NUMBER + ;ALTERS A,B,C,D,E,H,L + ; --- START PROC CONSI --- +CONSI: + LD HL,(FACLOW) ;GET THE INTEGER + ; --- START PROC HL_CSNG --- +HL_CSNG: + LD A,H ;SET UP REGISTERS FOR FLOATR + ; --- START PROC HL_CSNG_A --- +HL_CSNG_A: + OR A + PUSH AF + CALL M,INEGHL + CALL VALSNG ;SET VALTYP TO "SINGLE PRECISION" + EX DE,HL + LD HL,$0000 + LD (FACCU),HL + LD (FACLOW),HL ; DECIMAL ACCUMULATOR + 2 + LD A,D + OR E + JP Z,POPAF + LD BC,$0500 ; 1280 + LD HL,FACCU+1 + PUSH HL + LD HL,HL_CSNG_CONST +HL_CSNG_1: + LD A,$FF + PUSH DE + LD E,(HL) + INC HL + LD D,(HL) + INC HL + EX (SP),HL + PUSH BC +HL_CSNG_2: + LD B,H + LD C,L + ADD HL,DE + INC A + JR C,HL_CSNG_2 + LD H,B + LD L,C + POP BC + POP DE + EX DE,HL + INC C + DEC C + JR NZ,HL_CSNG_3 + OR A + JR Z,HL_CSNG_6 + PUSH AF + LD A,40h ; '@' + ADD A,B + LD (FACCU),A + POP AF +HL_CSNG_3: + INC C + EX (SP),HL + PUSH AF + LD A,C + RRA + JR NC,HL_CSNG_4 + POP AF + ADD A,A ; *16 + ADD A,A + ADD A,A + ADD A,A + LD (HL),A + JR HL_CSNG_5 + + +HL_CSNG_4: + POP AF + OR (HL) + LD (HL),A + INC HL +HL_CSNG_5: + EX (SP),HL +HL_CSNG_6: + LD A,D + OR E + JR Z,HL_CSNG_7 + DJNZ HL_CSNG_1 +HL_CSNG_7: + POP HL + POP AF + RET P + JP NEG + + +HL_CSNG_CONST: + DEFB $F0,$D8,$18,$FC,$9C + DEFB $FF,$F6,$FF,$FF,$FF + + + +; 'CDBL' BASIC function + ;FORCE THE FAC TO BE A DOUBLE PRECISION NUMBER + ;ALTERS A,B,C,D,E,H,L +; +; This entry point is used by the routines at __EXP, FINFRC, FOUINI, L3878, and ISFUN. +; Position: $303A +__CDBL: + RST GETYPR ;SEE WHAT KIND OF NUMBER WE HAVE + RET NC ;WE ALREADY HAVE A DBL, WE ARE DONE + JP Z,TM_ERR ;GIVE AN ERROR IF WE HAVE A STRING + CALL M,CONSI ;CONVERT TO SNG IF WE HAVE AN INT + ;FALL INTO CONDS AND CONVERT TO DBL + + ;CONVERT A SINGLE PRECISION NUMBER TO A DOUBLE PRECISION ONE + ;ALTERS A,H,L +; This entry point is used by the routines at __LOG, L324B, FMULT, DIVIDE and L3878. +CONDS: + LD HL,$0000 ;ZERO H,L + LD (FACCU+4),HL ;CLEAR THE FOUR LOWER BYTES IN THE DOUBLE + LD (FACCU+6),HL ; PRECISION NUMBER + LD A,H + LD (FACCU+8),A + +; Set type to "double precision" +; +; This entry point is used by the routines at __EXP and DEXP. +VALDBL: + LD A,$08 + JR VALSNG_0 + +; Set type to "single precision" +; +; Routine at 12371 +VALSNG: + LD A,$04 ;SET VALTYP TO "SINGLE PRECISION" +; This entry point is used by the routine at L3034. +VALSNG_0: + JP SETTYPE + + +; Test for string type, 'Type Error' if it is not +; a.k.a. CHKSTR, FRCSTR +; + ;FORCE THE FAC TO BE A STRING + ;ALTERS A ONLY +; +; Routine at 12376 +; Used by the routines at __LINE, ISFUN, USING, L61C4, CONCAT, GETSTR, FN_INSTR and LHSMID. +TSTSTR: + RST GETYPR ;SEE WHAT KIND OF VALUE WE HAVE + RET Z ;WE HAVE A STRING, EVERYTHING IS OK + JP TM_ERR ;WE DON'T HAVE A STRING, FALL INTO TMERR + +; Data block at 12381 + ; --- START PROC CINT --- +CINT: + LD HL,CINT_RET2 + PUSH HL + LD HL,FACCU + LD A,(HL) ;GET SIGN BYTE + AND $7F ;CLEAR SIGN + CP $46 ;SEE IF TOO LARGE + RET NC ; RET with CY set + SUB $41 + JR NC,CINT_SUB + OR A ; reset CY + POP DE + LD DE,$0000 + RET + +CINT_SUB: + INC A + LD B,A + LD DE,$0000 + LD C,D + INC HL +CINT_SUB_0: + LD A,C + INC C + RRA + LD A,(HL) + JR C,CINT_SUB_1 + RRA + RRA + RRA + RRA + JR CINT_SUB_2 + +CINT_SUB_1: + INC HL +CINT_SUB_2: + AND $0F + LD (DECTMP),HL + LD H,D + LD L,E + ADD HL,HL + RET C + ADD HL,HL + RET C + ADD HL,DE + RET C + ADD HL,HL + RET C + LD E,A + LD D,$00 + ADD HL,DE + RET C + EX DE,HL + LD HL,(DECTMP) + DJNZ CINT_SUB_0 + LD HL,$8000 ; 32768 + RST DCOMPR ; Compare HL with DE. + LD A,(FACCU) + RET C + JR Z,CINT_RET1 + POP HL + OR A + RET P + EX DE,HL + CALL INEGHL + EX DE,HL + OR A + RET + +CINT_RET1: + OR A + RET P + POP HL + RET + + +; Routine at 12474 +CINT_RET2: + SCF + RET + +; Routine at 12476 +DCXBRT: + DEC BC ;THIS IS FOR BILL. C WILL NEVER BE ZERO + RET ; (THE MSB WILL ALWAYS BE ONE) SO "DCX B" + ; AND "DCR C" ARE FUNCTIONALLY EQUIVALENT + + +; 'FIX' BASIC function + ; THIS IS THE FIX (X) FUNCTION. IT RETURNS + ; FIX(X)=SGN(X)*INT(ABS(X)) +; Double Precision to Integer conversion +; a.k.a. FIXER +; Routine at 12478 +__FIX: + RST GETYPR ;GET VALTYPE OF ARG + RET M ;INT, DONE + CALL SIGN ;GET SIGN + JP P,__INT ;IF POSITIVE, JUST CALL REGULAR INT CODE + CALL NEG ;NEGATE IT + CALL __INT ;GET THE INTEGER OF IT + JP INVSGN ;NOW RE-NEGATE IT + + +; 'INT' BASIC function +; + ;GREATEST INTEGER FUNCTION + ;ALTERS A,B,C,D,E,H,L +; +; a.k.a. VINT +; This entry point is used by the routines at __SIN and L391A. +__INT: + RST GETYPR ;SEE WHAT TYPE OF A NUMBER WE HAVE + RET M ;IT IS AN INTEGER, ALL DONE + LD HL,FACCU+8 ;GET EXPONENT + LD C,$0E + JR NC,__INT_0 + JP Z,TM_ERR ; If string type, Err $0D - "Type mismatch" + LD HL,FACCU+4 + LD C,$06 ; TK_ABS ? +__INT_0: + LD A,(FACCU) + OR A + JP M,__FIX_2 + AND $7F ; ABS + SUB $41 + JP C,ZERO + INC A + SUB C + RET NC + CPL + INC A + LD B,A +__INT_1: + DEC HL + LD A,(HL) + AND $F0 + LD (HL),A + DEC B + RET Z + XOR A + LD (HL),A + DJNZ __INT_1 + RET + +__FIX_2: + AND $7F ; ABS + SUB $41 + JR NC,__FIX_3 + LD HL,$FFFF + JP MAKINT + +__FIX_3: + INC A + SUB C + RET NC + CPL + INC A + LD B,A + LD E,$00 +__FIX_4: + DEC HL + LD A,(HL) + LD D,A + AND $F0 + LD (HL),A + CP D + JR Z,__FIX_5 + INC E +__FIX_5: + DEC B + JR Z,__FIX_7 + XOR A + LD (HL),A + CP D + JR Z,__FIX_6 + INC E +__FIX_6: + DJNZ __FIX_4 +__FIX_7: + INC E + DEC E + RET Z + LD A,C + CP $06 ; TK_ABS ? + LD BC,$10C1 ; BCDE = 1 (float) + LD DE,$0000 + JP Z,FADD + EX DE,HL + LD (ARG+6),HL + LD (ARG+4),HL + LD (ARG+2),HL + LD H,B + LD L,C + LD (ARG),HL + JP DADD + + +; Multiply DE by BC +; a.k.a. UMULT + ;INTEGER MULTIPLY FOR MULTIPLY DIMENSIONED ARRAYS + ; (DE):=(BC)*(DE) + ;OVERFLOW CAUSES A BS ERROR + ;ALTERS A,B,C,D,E +; +; Routine at 12618 +; Used by the routine at DOSND. +MLDEBC: + PUSH HL ;SAVE [H,L] + LD HL,$0000 ; Clear partial product ;ZERO PRODUCT REGISTERS + LD A,B ; Test multiplier ;CHECK IF (BC) IS ZERO + OR C ;IF SO, JUST RETURN, (HL) IS ALREADY ZERO + JR Z,MLDEBC_2 ; Return zero if zero ;THIS IS DONE FOR SPEED + LD A,16 ; 16 bits ;SET UP A COUNT +MLDBLP: + ADD HL,HL ; Shift P.P left ;ROTATE (HL) LEFT ONE + JP C,BS_ERR ; "Subscript error" if overflow ;CHECK FOR OVERFLOW, IF SO, + EX DE,HL ; BAD SUBSCRIPT (BS) ERROR + ADD HL,HL ; Shift multiplier left ;ROTATE (DE) LEFT ONE + EX DE,HL + JR NC,NOMLAD ; Bit was zero - No add ;ADD IN (BC) IF HO WAS 1 + ADD HL,BC ; Add multiplicand + JP C,BS_ERR ; "Subscript error" if overflow ;CHECK FOR OVERFLOW +NOMLAD: + DEC A ; Count bits ;SEE IF DONE + JR NZ,MLDBLP +MLDEBC_2: + EX DE,HL ;RETURN THE RESULT IN [D,E] + POP HL ;GET BACK THE SAVED [H,L] + RET + + + +; +; INTEGER ARITHMETIC CONVENTIONS +; +;INTEGER VARIABLES ARE 2 BYTE, SIGNED NUMBERS +; THE LO BYTE COMES FIRST IN MEMORY +; +;CALLING CONVENTIONS: +;FOR ONE ARGUMENT FUNCTIONS: +; THE ARGUMENT IS IN (HL), THE RESULT IS LEFT IN (HL) +;FOR TWO ARGUMENT OPERATIONS: +; THE FIRST ARGUMENT IS IN (DE) +; THE SECOND ARGUMENT IS IN (HL) +; THE RESULT IS LEFT IN THE FAC AND IF NO OVERFLOW, (HL) +;IF OVERFLOW OCCURS, THE ARGUMENTS ARE CONVERTED TO SINGLE PRECISION +;WHEN INTEGERS ARE STORED IN THE FAC, THEY ARE STORED AT FACLO+0,1 +;VALTYP(INTEGER)=2 + + +; Integer SUB + ;INTEGER SUBTRTACTION (HL):=(DE)-(HL) + ;ALTERS A,B,C,D,E,H,L +; Routine at 12647 +ISUB: + LD A,H ;EXTEND THE SIGN OF (HL) TO B + RLA ;GET SIGN IN CARRY + SBC A,A + LD B,A + CALL INEGHL ;NEGATE (HL) + LD A,C ;GET A ZERO + SBC A,B ;NEGATE SIGN + JR IADD_0 ;GO ADD THE NUMBERS + +; Routine at 12658 +; +; Used by the routine at __NEXT. +IADD: + LD A,H ;EXTEND THE SIGN OF (HL) TO B + RLA ;GET SIGN IN CARRY + SBC A,A + +; This entry point is used by the routine at ISUB. +IADD_0: + LD B,A ;SAVE THE SIGN + PUSH HL ;SAVE THE SECOND ARGUMENT IN CASE OF OVERFLOW + LD A,D ;EXTEND THE SIGN OF (DE) TO A + RLA ;GET SIGN IN CARRY + SBC A,A + ADD HL,DE ;ADD THE TWO LO'S + ADC A,B ;ADD THE EXTRA HO + RRCA ;IF THE LSB OF A IS DIFFERENT FROM THE MSB OF + XOR H ; H, THEN OVERFLOW OCCURED + JP P,CONIS1 ;NO OVERFLOW, GET OLD (HL) OFF STACK AND WE ARE DONE, SAVE (HL) IN THE FAC ALSO + PUSH BC ;OVERFLOW -- SAVE EXTENDED SIGN OF (HL) + EX DE,HL ;GET (DE) IN (HL) + CALL HL_CSNG ;FLOAT IT + POP AF ;GET SIGN OF (HL) IN A + POP HL ;GET OLD (HL) BACK + CALL PUSHF ;PUT FIRST ARGUMENT ON STACK + CALL HL_CSNG ;FLOAT IT + POP BC ;GET PREVIOUS NUMBER OFF STACK + POP DE + JP FADD ;ADD THE TWO NUMBERS + + +; Integer MULTIPLY + ;INTEGER MULTIPLICATION (HL):=(DE)*(HL) + ;ALTERS A,B,C,D,E,H,L +; Routine at 12691 +; Used by the routine at L390D. +IMULT: + LD A,H ;CHECK (HL) IF IS ZERO, IF SO + OR L ; JUST RETURN. THIS IS FOR SPEED. + JP Z,MAKINT ;UPDATE FACLO TO BE ZERO AND RETURN + PUSH HL ;SAVE SECOND ARGUMENT IN CASE OF OVERFLOW + PUSH DE ;SAVE FIRST ARGUMENT + CALL IMULDV ;FIX UP THE SIGNS + PUSH BC ;SAVE THE SIGN OF THE RESULT + LD B,H ;COPY SECOND ARGUMENT INTO (BC) + LD C,L + LD HL,$0000 ;ZERO (HL), THAT IS WHERE THE PRODUCT GOES + LD A,16 ;SET UP A COUNT +IMULT_0: + ADD HL,HL ;ROTATE PRODUCT LEFT ONE + JR C,IMULT5 ;CHECK FOR OVERLFOW + EX DE,HL ;ROTATE FIRST ARGUMENT LEFT ONE TO SEE IF + ADD HL,HL ; WE ADD IN (BC) OR NOT + EX DE,HL + JR NC,IMULT_1 ;DON'T ADD IN ANYTHING + ADD HL,BC ;ADD IN (BC) + JR C,IMULT5 ;CHECK FOR OVERLFOW +IMULT_1: + DEC A ;ARE WE DONE? + JR NZ,IMULT_0 ;NO, DO IT AGAIN + POP BC ;WE ARE DONE, GET SIGN OF RESULT + POP DE ;GET ORIGINAL FIRST ARGUMENT +; This entry point is used by the routine at DIVLP. +IMLDIV: + LD A,H ;ENTRY FROM IDIV, IS RESULT .GE. 32768? + OR A + JP M,IMULT_3 ;IT IS, CHECK FOR SPECIAL CASE OF -32768 + POP DE ;RESULT IS OK, GET SECOND ARGUMENT OFF STACK + LD A,B ;GET THE SIGN OF RESULT IN A + JP INEGA ;NEGATE THE RESULT IF NECESSARY + +IMULT_3: + XOR $80 ;IS RESULT 32768? + OR L ;NOTE: IF WE GET HERE FROM IDIV, THE RESULT + JR Z,IMULT4 ; MUST BE 32768, IT CANNOT BE GREATER + EX DE,HL ;IT IS .GT. 32768, WE HAVE OVERFLOW + JR IMULT5_0 + +IMULT5: + POP BC ;GET SIGN OF RESULT OFF STACK + POP HL ;GET THE ORIGINAL FIRST ARGUMENT + +IMULT5_0: + CALL HL_CSNG ;FLOAT IT + POP HL ;GET THE ORIGINAL SECOND ARGUMENT + CALL PUSHF ;SAVE FLOATED FIRST ARUMENT + CALL HL_CSNG ;FLOAT SECOND ARGUMENT +;FMULTT: + POP BC + POP DE ;GET FIRST ARGUMENT OFF STACK, ENTRY FROM POLYX + JP FMULT ;MULTIPLY THE ARGUMENTS USING SINGLE PRECISION + +IMULT4: + LD A,B ;IS RESULT +32768 OR -32768? + OR A ;GET ITS SIGN + POP BC ;DISCARD ORIGINAL SECOND ARGUMENT + JP M,MAKINT ;THE RESULT SHOULD BE NEGATIVE, IT IS OK + PUSH DE ;IT IS POSITIVE, SAVE REMAINDER FOR MOD + CALL HL_CSNG ;FLOAT -32768 + POP DE ;GET MOD'S REMAINDER BACK + JP NEG ;NEGATE -32768 TO GET 32768, WE ARE DONE + + +; Divide the signed integer in DE by the signed integer in HL. +; + ;INTEGER DIVISION (HL):=(DE)/(HL) + ;REMAINDER IS IN (DE), QUOTIENT IN (HL) + ;ALTERS A,B,C,D,E,H,L +; +; Data block at 12774 +INT_DIV: + LD A,H +INT_DIV_0: + OR L ;CHECK FOR DIVISION BY ZERO + JP Z,O_ERR ;WE HAVE DIVISION BY ZERO!! (Err $0B - "Division by zero") + CALL IMULDV ;FIX UP THE SIGNS + PUSH BC ;SAVE THE SIGN OF THE RESULT + EX DE,HL ;GET DENOMINATOR IN (HL) + CALL INEGHL ;NEGATE IT + LD B,H ;SAVE NEGATED DENOMINATOR IN (BC) + LD C,L + +; Routine at 12789 +IDIV0: + LD HL,$0000 ;ZERO WHERE WE DO THE SUBTRACTION + LD A,17 ;SET UP A COUNT + OR A ;CLEAR CARRY + JR IDIV3 ;GO DIVIDE + +DIVLP: + PUSH HL ;SAVE (HL) I.E. CURRENT NUMERATOR + ADD HL,BC ;SUBTRACT DENOMINATOR + JR NC,IDIV2 ;WE SUBTRACTED TOO MUCH, GET OLD (HL) BACK + INC SP ;THE SUBTRACTION WAS GOOD, DISCARD OLD (HL) + INC SP + SCF ;NEXT BIT IN QUOTIENT IS A ONE + DEFB $30 ; "JR NC,n" AROUND NEXT BYTE + +IDIV2: + POP HL ;IGNORE THE SUBTRACTION, WE COULDN'T DO IT + +IDIV3: + RL E ;SHIFT IN THE NEXT QUOTIENT BIT + RL D + ADC HL,HL + DEC A ;ARE WE DONE? + JR NZ,DIVLP ;NO, DIVIDE AGAIN + EX DE,HL ;GET QUOTIENT IN (HL), REMAINDER IN (DE) + POP BC ;GET SIGN OF RESULT + PUSH DE ;SAVE REMAINDER SO STACK WILL BE ALRIGHT + JP IMLDIV ;CHECK FOR SPECIAL CASE OF 32768 + + + ;GET READY TO MULTIPLY OR DIVIDE + ;ALTERS A,B,C,D,E,H,L +; +; Routine at 12821 +; Used by the routine at IMULT. +IMULDV: + LD A,H ;GET SIGN OF RESULT + XOR D + LD B,A ;SAVE IT IN B + CALL INEGH ;NEGATE SECOND ARGUMENT IF NECESARY + EX DE,HL ;PUT (DE) IN (HL), FALL IN AND NEGATE FIRST ARGUMENT IF NECESSARY + + + ;NEGATE H,L + ;ALTERS A,C,H,L +INEGH: + LD A,H ;GET SIGN OF (HL) +; This entry point is used by the routines at IMULT and IMOD. +INEGA: + OR A ;SET CONDITION CODES + JP P,MAKINT ;WE DON'T HAVE TO NEGATE, IT IS POSITIVE + ;SAVE THE RESULT IN THE FAC FOR WHEN + ; OPERATORS RETURN THROUGH HERE + +; This entry point is used by the routines at ISUB and INEG. +INEGHL: + XOR A ;CLEAR A + LD C,A ;STORE A ZERO (WE USE THIS METHOD FOR ISUB) + SUB L ;NEGATE LO + LD L,A ;SAVE IT + LD A,C ;GET A ZERO BACK + SBC A,H ;NEGATE HO + LD H,A ;SAVE IT + JP MAKINT ;ALL DONE, SAVE THE RESULT IN THE FAC + ; FOR WHEN OPERATORS RETURN THROUGH HERE + + + ;INTEGER NEGATION + ;ALTERS A,B,C,D,E,H,L +; +; Routine at 12843 +; Used by the routine at INVSGN. +INEG: + LD HL,(FACLOW) ;GET THE INTEGER + CALL INEGHL ;NEGATE IT + LD A,H ;GET THE HIGH ORDER + XOR $80 ;CHECK FOR SPECIAL CASE OF 32768 + OR L + RET NZ ;IT DID NOT OCCUR, EVERYTHING IS FINE + +; This entry point is used by the routines at NUMCON, OPRND, GIVDBL, FN_TIME and +; L7BA3. +INEG2: + XOR A ;WE HAVE IT, FLOAT 32768 + JP HL_CSNG_A + + + ;MOD OPERATOR + ;(HL):=(DE)-(DE)/(HL)*(HL), (DE)=QUOTIENT + ;ALTERS A,B,C,D,E,H,L +; +; Routine at 12858 +; Used by the routine at DANDOR. +IMOD: + PUSH DE ;SAVE (DE) FOR ITS SIGN + CALL INT_DIV ;DIVIDE AND GET THE REMAINDER + XOR A ;TURNOFF THE CARRY AND TRANFER + ADD A,D ;THE REMAINDER*2 WHICH IS IN [D,E] + RRA ;TO [H,L] DIVIDING BY TWO + LD H,A + LD A,E + RRA + LD L,A ; ***WHG01*** FIX TO MOD OPERATOR + CALL VALINT ;SET VALTYP TO "INTEGER" IN CASE RESULT OF + POP AF + JR INEGA + + + +; FLOATING POINT ADDITION AND SUBTRACTION +; ENTRY TO FADD WITH POINTER TO ARG IN (HL) + + +; LOADFP/FADD +; Load FP at (HL) to BCDE +; +; Routine at 12875, this entry is not used by the core ROM +FADDS: + CALL LOADFP ;GET ARGUMENT INTO THE REGISTERS + ;DO THE ADDITION + +; This entry point is used by the routines at __FIX, IADD, FSUB, GETWORD_HL and +; __NEXT. +FADD: + CALL DEC_HL2ARG + CALL CONDS + JP DADD + + +;SUBTRACTION FAC:=ARG-FAC + +; Subtract the single precision numbers in FAC1 and BCDE +; aka, SUBCDE Subtract BCDE from FP reg +; +; Routine at 12887 +FSUB: + CALL NEG ;NEGATE SECOND ARGUMENT + JR FADD ;FALL INTO FADD + +; Routine at 12892 +; +; Used by the routines at IMULT, __CIRCLE and CGTCNT. +FMULT: + CALL DEC_HL2ARG + CALL CONDS + JP DMUL + +; Routine at 12901 +; +; Used by the routine at IDIV. +DIVIDE: + POP BC + POP DE +; This entry point is used by the routine at __CIRCLE. +FDIV: + LD HL,(FACLOW) + EX DE,HL + LD (FACLOW),HL + PUSH BC + LD HL,(FACCU) + EX (SP),HL + LD (FACCU),HL + POP BC + CALL DEC_HL2ARG + CALL CONDS + JP DDIV + +; Routine at 12928 +; +; Used by the routines at FADDS, FMULT and DIVIDE. +DEC_HL2ARG: + EX DE,HL + LD (ARG+2),HL + LD H,B + LD L,C + LD (ARG),HL + LD HL,$0000 + LD (ARG+4),HL + LD (ARG+6),HL + RET + +; Routine at 12947 +; +DCRART: + DEC A + RET + +; Routine at 12949 +; +DCXHRT: + DEC HL + RET + +; Routine at 12951 +; +POPHLRT: + POP HL + RET + + +; ASCII to Double precision FP number +; FLOATING POINT INPUT ROUTINE +; + ;ALTERS ALL REGISTERS + ;THE NUMBER IS LEFT IN FAC + ;AT ENTRY, (HL) POINTS TO THE FIRST CHARACTER IN A TEXT BUFFER. + ;THE FIRST CHARACTER IS ALSO IN A. WE PACK THE DIGITS INTO THE FAC + ;AS AN INTEGER AND KEEP TRACK OF WHERE THE DECIMAL POINT IS. + ;C IS $FF IF WE HAVE NOT SEEN A DECIMAL POINT, 0 IF WE HAVE. + ;B IS THE NUMBER OF DIGITS AFTER THE DECIMAL POINT. + ;AT THE END, B AND THE EXPONENT (IN E) ARE USED TO DETERMINE HOW MANY + ;TIMES WE MULTIPLY OR DIVIDE BY TEN TO GET THE CORRECT NUMBER. + ; +; Data block at 12953 + ; --- START PROC L3299 --- +; Also known as "FIN", convert text to number +FIN_DBL: + EX DE,HL ;SAVE THE TEXT POINTER IN (DE) + LD BC,$00FF ;CLEAR FLAGS: B=DECIMAL PLACE COUNT, C="." FLAG + LD H,B ;ZERO (HL) + LD L,B + CALL MAKINT ;ZERO FAC, SET VALTYP TO "INTEGER" + EX DE,HL ;GET THE TEXT POINTER BACK IN (HL) AND ZEROS IN (DE) + LD A,(HL) ;RESTORE CHAR FROM MEMORY + +; ASCII to FP number (also '&' prefixes) +H_ASCTFP: + CP '&' + JP Z,OCTCNS + +; ASCII to FP number +_ASCTFP: ;IF WE ARE CALLED BY VAL OR INPUT OR READ, THE SIGNS MAY NOT BE CRUNCHED + CP '-' ; '-': Negative? ;SEE IF NUMBER IS NEGATIVE + PUSH AF ; Save it and flags ;SAVE SIGN + JR Z,_ASCTFP_0 ; Yes - Convert number ;IGNORE MINUS SIGN + CP '+' ; Positive? ;IGNORE A LEADING SIGN + JR Z,_ASCTFP_0 ; Yes - Convert number + DEC HL ; DEC 'cos GETCHR INCs ;SET CHARACTER POINTER BACK ONE + +; This entry point is used by the routine at DPOINT. +_ASCTFP_0: ;HERE TO CHECK FOR A DIGIT, A DECIMAL POINT, "E" OR "D" + RST CHRGTB ; Set result to zero ;GET THE NEXT CHARACTER OF THE NUMBER + JP C,_ASCTFP_DIGITS ; Digit - Add to number ;WE HAVE A DIGIT + CP '.' ;CHECK FOR A DECIMAL POINT + JP Z,DPOINT ; "." - Flag point ;WE HAVE ONE, I GUESS + CP 'e' ;LOWER CASE "E" + JR Z,EXPONENTIAL + CP 'E' ;CHECK FOR A SINGLE PRECISION EXPONENT +EXPONENTIAL: + JR NZ,NOTE ;NO + PUSH HL ;SAVE TEXT PTR + RST CHRGTB ;GET NEXT CHAR + CP 'l' ;SEE IF LOWER CASE "L" + JR Z,_ASCTFP_2 ;IF SO POSSIBLE ELSE + CP 'L' ;IS THIS REALLY AN "ELSE"? + JR Z,_ASCTFP_2 ;WAS ELSE + CP 'q' ;SEE IF LOWER CASE "Q" + JR Z,_ASCTFP_2 ;IF SO POSSIBLE "EQV" + CP 'Q' ;POSSIBLE "EQV" +_ASCTFP_2: + POP HL ;RESTORE [H,L] + JR Z,_ASCTFP_3 ;IT WAS JUMP! + RST GETYPR ;IF DOUBLE DON'T DOWNGRADE TO SINGLE + JR NC,FINEX1 + XOR A ;MAKE A=0 SO NUMBER IS A SINGLE + JR FINEX +_ASCTFP_3: + LD A,(HL) ;RESTORE ORIGINAL CHAR +NOTE: + CP '%' ;TRAILING % (RSTS-11 COMPATIBILITY) ; Integer variable ? + JP Z,FININT ;MUST BE INTEGER. + CP '#' ;FORCE DOUBLE PRECISION? ; Double precision variable ? + JP Z,FINDBF ;YES, FORCE IT & FINISH UP. + CP '!' ;FORCE SINGLE PREC. ; Single precision variable ? + JP Z,FINSNF + CP 'd' ;LOWER CASE "D" + JR Z,FINEX1 + CP 'D' ;CHECK FOR A DOUBLE PRECISION EXPONENT + JR NZ,FINE ;WE DON'T HAVE ONE, THE NUMBER IS FINISHED +FINEX1: + OR A ;DOUBLE PRECISION NUMBER -- TURN OFF ZERO FLAG +FINEX: + CALL FINFRC ;FORCE THE FAC TO BE SNG OR DBL + RST CHRGTB ;GET THE FIRST CHARACTER OF THE EXPONENT + PUSH DE + LD D,$00 + CALL SGNEXP ;EAT SIGN OF EXPONENT ( test '+', '-'..) + LD C,D + POP DE + + ;HERE TO GET THE NEXT DIGIT OF THE EXPONENT +FINEC: + RST CHRGTB + JR NC,FINE_NODG + ;PACK THE NEXT DIGIT INTO THE EXPONENT + LD A,E ;EXPONENT DIGIT -- MULTIPLY EXPONENT BY 10 + CP 12 ;CHECK THAT THE EXPONENT DOES NOT OVERFLOW + ;IF IT DID, E COULD GET GARBAGE IN IT. + JR NC,FINEDO ;WE ALREADY HAVE TWO DIGITS + RLCA ;FIRST BY 4 + RLCA + ADD A,E ;ADD 1 TO MAKE 5 + RLCA ;NOW DOUBLE TO GET 10 + ADD A,(HL) ;ADD IT IN + SUB '0' ;SUBTRACT OFF ASCII CODE, THE RESULT IS + ; POSITIVE ON LENGTH=2 BECAUSE OF THE ABOVE CHECK + LD E,A ;STORE EXPONENT + JR FINEC ;CONTINUE + +FINEDO: + LD E,$80 ;AN EXPONENT LIKE THIS WILL SAFELY CAUSE OVERFLOW OR UNDERFLOW + JR FINEC ;CONTINUE + +FINE_NODG: + INC C + JR NZ,FINE + XOR A ;THE EXPONENT IS NEGATIVE + SUB E ;NEGATE IT + LD E,A ;SAVE IT AGAIN + + ;HERE TO FINISH UP THE NUMBER +; This entry point is used by the routines at _ASCTFP, DPOINT, FININT and FINDBF. +FINE: + RST GETYPR + JP M,FINE_0 + LD A,(FACCU) + OR A ;CHECK IF THE NUMBER IS ZERO + JR Z,FINE_0 + LD A,D + SUB B + ADD A,E + ADD A,$40 + LD (FACCU),A + OR A + CALL M,FINE_OV + +FINE_0: + POP AF ;GET THE SIGN + PUSH HL ;GET THE TEXT POINTER + CALL Z,INVSGN ;NEGATE IF NECESSARY + RST GETYPR ;WE WANT -32768 TO BE AN INT, BUT UNTIL NOW IT WOULD BE A SNG +;FINE2C: + JR NC,FINE_DBL + POP HL ;GET THE TEXT POINTER IN (HL) + RET PE ;IT IS NOT SNG, SO IT IS NOT -32768 + PUSH HL ;WE HAVE A SNG, SAVE TEXT POINTER + LD HL,POPHLRT ;GET ADDRESS THAT POP'S H OFF STACK BECAUSE + PUSH HL ; CONIS2 DOES FUNNY THINGS WITH THE STACK + CALL CONIS2 ;CHECK IF WE HAVE -32768 + RET ;WE DON'T, POPHRT IS STILL ON THE STACK SO WE CAN JUST RETURN + +FINE_DBL: + CALL DECROU + POP HL + RET + +; Routine at 13132 +; +; Used by the routine at L3301. +FINE_OV: + JP OV_ERR ; Err $06 - "Overflow" + + + ;HERE TO CHECK IF WE HAVE SEEN 2 DECIMAL POINTS AND SET THE DECIMAL POINT FLAG +; a.k.a. FINDP +; Routine at 13135 +; Used by the routine at _ASCTFP. +DPOINT: + RST GETYPR ;SET CARRY IF WE DON'T HAVE A DOUBLE + INC C ;SET THE FLAG + JR NZ,FINE ;WE HAD 2 DECIMAL POINTS, NOW WE ARE DONE + JR NC,DPOINT_0 + CALL FINFRC ;THIS IS THE FIRST ONE, CONVERT FAC TO SNG IF WE DON'T ALREADY HAVE A DOUBLE + LD A,(FACCU) ;CONTINUE LOOKING FOR DIGITS + OR A + JR NZ,DPOINT_0 + LD D,A +DPOINT_0: + JP _ASCTFP_0 + +; Routine at 13154 +; +; Used by the routine at _ASCTFP. +FININT: + RST CHRGTB ; Gets next character (or token) from BASIC text. + POP AF ;GET SIGN OFF THE STACK + PUSH HL ;SAVE TEXT POINTER + LD HL,POPHLRT ;ADDRESS POP (HL) AND RETURN + PUSH HL + LD HL,__CINT ;WILL WANT TO FORCE ONCE D.P. DONE + PUSH HL + PUSH AF ;PUT SIGN BACK ON THE STACK + JR FINE ;ALL DONE + + +; Routine at 13168 +; Used by the routine at _ASCTFP. +FINDBF: + OR A ;SET NON-ZERO TO FORCE DOUBLE PREC +; This entry point is used by the routine at _ASCTFP. +FINSNF: + CALL FINFRC ;FORCE THE TYPE + RST CHRGTB ;READ AFTER TERMINATOR + JR FINE ;ALL DONE + +; Routine at 13175 +; +; Used by the routines at _ASCTFP, DPOINT and FINDBF. +FINFRC: + PUSH HL ;SAVE TEXT POINTER + PUSH DE ;SAVE EXPONENT INFORMATION + PUSH BC ;SAVE DECIMAL POINT INFORMATION + PUSH AF ;SAVE WHAT WE WANT THE FAC TO BE + CALL Z,__CSNG ;CONVERT TO SNG IF WE HAVE TO + POP AF ;GET TYPE FLAG BACK + CALL NZ,__CDBL ;CONVERT TO DBL IF WE HAVE TO + POP BC ;GET DECIMAL POINT INFORMATION BACK + POP DE ;GET EXPONENT INFORMATION BACK + POP HL ;GET TEXT POINTER BACK + RET ;ALL DONE + +; Data block at 13190 +_ASCTFP_DIGITS: + SUB '0' ; convert from ASCII + JP NZ,L3393 + OR C + JP Z,L3393 + AND D + JP Z,_ASCTFP_0 +L3393: + INC D + LD A,D + CP $07 + JR NZ,ADDIG + OR A + CALL FINFRC + + +; a.k.a. FINDIG + ;HERE TO PACK THE NEXT DIGIT OF THE NUMBER INTO THE FAC + ;WE MULTIPLY THE FAC BY TEN AND ADD IN THE NEXT DIGIT +ADDIG: + PUSH DE ;SAVE EXPONENT INFORMATION ; Save sign of exponent/digit + LD A,B ;INCREMENT DECIMAL PLACE COUNT IF WE ARE ; Get digits after point + ADD A,C ; PAST THE DECIMAL POINT ; Add one if after point + INC A + LD B,A ; Re-save counter + PUSH BC ;SAVE DECIMAL POINT INFORMATION ; Save point flags + PUSH HL ;SAVE TEXT POINTER ; Save code string address + LD A,(HL) ;GET THE DIGIT + SUB '0' ;CONVERT IT TO ASCII ; convert from ASCII + PUSH AF ;SAVE THE DIGIT + RST GETYPR ;SEE WHAT KIND OF A NUMBER WE HAVE ; Get the number type (FAC) + JP P,FINDGV ;WE DO NOT HAVE AN INTEGER + + ;HERE TO PACK THE NEXT DIGIT OF AN INTEGER + LD HL,(FACLOW) ;WE HAVE AN INTEGER, GET IT IN (HL) + LD DE,3277 ;SEE IF WE WILL OVERFLOW ; Const: $0CCD + RST DCOMPR ;COMPAR RETURNS WITH CARRY ON IF ; Compare HL with DE. + JR NC,FINDG2 ; (HL) .LT. (DE), SO THE NUMBER IS TOO BIG + LD D,H ;COPY (HL) INTO (DE) + LD E,L + ADD HL,HL ;MULTIPLY (HL) BY 2 ; * 10 + ADD HL,HL ;MULTIPLY (HL) BY 2, (HL) NOW IS 4*(DE) + ADD HL,DE ;ADD IN OLD (HL) TO GET 5*(DE) + ADD HL,HL ;MULTIPLY BY 2 TO GET TEN TIMES THE OLD (HL) + POP AF ;GET THE DIGIT + LD C,A ;SAVE IT SO WE CAN USE DAD, B IS ALREADY ZERO + ADD HL,BC ;ADD IN THE NEXT DIGIT + LD A,H ;CHECK FOR OVERFLOW + OR A ;OVERFLOW OCCURED IF THE MSB IS ON + JP M,FINDG1 ;WE HAVE OVERFLOW!! + LD (FACLOW),HL ;EVERYTHING IS FINE, STORE THE NEW NUMBER +FINDGE: + POP HL ;ALL DONE, GET TEXT POINTER BACK + POP BC ;GET DECIMAL POINT INFORMATION BACK + POP DE ;GET EXPONENT INFORMATION BACK + JP _ASCTFP_0 ;GET THE NEXT CHARACTER + + + ;HERE TO HANDLE 32768, 32769 +FINDG1: + LD A,C ;GET THE DIGIT + PUSH AF ;PUT IT BACK ON THE STACK + + + ;HERE TO CONVERT THE INTEGER DIGITS TO SINGLE PRECISION DIGITS +FINDG2: + CALL CONSI ;CONVERT THE INTEGER TO SINGLE PRECISION + + ;HERE TO DECIDE IF WE HAVE A SINGLE OR DOUBLE PRECISION NUMBER +FINDGV: + POP AF + POP HL + POP BC + POP DE + JR NZ,FINDG3 + LD A,(FACCU) + OR A + LD A,$00 + JR NZ,FINDG3 + LD D,A + JP _ASCTFP_0 + + ;HERE TO CONVERT A 7 DIGIT SINGLE PRECISION NUMBER TO DOUBLE PRECISION +FINDG3: + PUSH DE + PUSH BC + PUSH HL + PUSH AF + LD HL,FACCU + LD (HL),$01 + LD A,D + CP $10 + JR C,FINDG_BCD + POP AF + JR FINDGE ;GET FLAGS OFF STACK AND WE ARE DONE + + +FINDG_BCD: + INC A + OR A + RRA + LD B,$00 + LD C,A + ADD HL,BC + POP AF + LD C,A + LD A,D + RRA + LD A,C + JR NC,FINDGE1 ; HI or LOW BCD digit ? + ADD A,A + ADD A,A + ADD A,A + ADD A,A +FINDGE1: + OR (HL) + LD (HL),A + JR FINDGE + + + + + +; 'in' message +; +; Routine at 13322 +; Used by the routine at LINE2PTR. +; $340A: +IN_PRT: + PUSH HL ;SAVE LINE NUMBER + LD HL,IN_MSG ;PRINT MESSAGE (.." in "..) + CALL PRS + POP HL ;FALL INTO LINPRT + +; Print HL in ASCII form at the current cursor position +; a.k.a. NUMPRT + ;PRINT THE 2 BYTE NUMBER IN H,L + ;ALTERS ALL REGISTERS +; This entry point is used by the routines at __LLIST, LINE2PTR and L7D29. +LINPRT: + LD BC,PRNUMS + PUSH BC + CALL MAKINT ;PUT THE LINE NUMBER IN THE FAC AS AN INTEGER + XOR A ;SET FORMAT TO FREE FORMAT + LD (TEMP3),A + LD HL,FBUFFR+1 + LD (HL),' ' ;SET UP THE SIGN + OR (HL) ;TURN OFF THE ZERO FLAG + JR SPCFST ;CONVERT THE NUMBER INTO DIGITS + + + +; +; OUTPUT THE VALUE IN THE FAC ACCORDING TO THE FORMAT SPECIFICATIONS +; IN A,B,C +; ALL REGISTERS ARE ALTERED +; THE ORIGINAL CONTENTS OF THE FAC IS LOST +; +; THE FORMAT IS SPECIFIED IN A, B AND C AS FOLLOWS: +; THE BITS OF A MEAN THE FOLLOWING: +;BIT 7 0 MEANS FREE FORMAT OUTPUT, I.E. THE OTHER BITS OF A MUST BE ZERO, +; TRAILING ZEROS ARE SUPPRESSED, A NUMBER IS PRINTED IN FIXED OR FLOATING +; POINT NOTATION ACCORDING TO ITS MAGNITUDE, THE NUMBER IS LEFT +; JUSTIFIED IN ITS FIELD, B AND C ARE IGNORED. +; 1 MEANS FIXED FORMAT OUTPUT, I.E. THE OTHER BITS OF A ARE CHECKED FOR +; FORMATTING INFORMATION, THE NUMBER IS RIGHT JUSTIFIED IN ITS FIELD, +; TRAILING ZEROS ARE NOT SUPPRESSED. THIS IS USED FOR PRINT USING. +;BIT 6 1 MEANS GROUP THE DIGITS IN THE INTEGER PART OF THE NUMBER INTO GROUPS +; OF THREE AND SEPARATE THE GROUPS BY COMMAS +; 0 MEANS DON'T PRINT THE NUMBER WITH COMMAS +;BIT 5 1 MEANS FILL THE LEADING SPACES IN THE FIELD WITH ASTERISKS ("*") +;BIT 4 1 MEANS OUTPUT THE NUMBER WITH A FLOATING DOLLAR SIGN ("$") +;BIT 3 1 MEANS PRINT THE SIGN OF A POSITIVE NUMBER AS A PLUS SIGN ("+") +; INSTEAD OF A SPACE +;BIT 2 1 MEANS PRINT THE SIGN OF THE NUMBER AFTER THE NUMBER +;BIT 1 UNUSED +;BIT 0 1 MEANS PRINT THE NUMBER IN FLOATING POINT NOTATION I.E. "E NOTATION" +; IF THIS BIT IS ON, THE COMMA SPECIFICATION (BIT 6) IS IGNORED. +; 0 MEANS PRINT THE NUMBER IN FIXED POINT NOTATION. NUMBERS .GE. 1E16 +; CANNOT BE PRINTED IN FIXED POINT NOTATION. +; +; B AND C TELL HOW BIG THE FIELD IS: +;B = THE NUMBER OF PLACES IN THE FIELD TO THE LEFT OF THE DECIMAL POINT +; (B DOES NOT INCLUDE THE DECIMAL POINT) +;C = THE NUMBER OF PLACES IN THE FIELD TO THE RIGHT OF THE DECIMAL POINT +; (C INCLUDES THE DECIMAL POINT) +; B AND C DO NOT INCLUDE THE 4 POSITIONS FOR THE EXPONENT IF BIT 0 IS ON +; FOUT ASSUMES B+C .LE. 24 (DECIMAL) +; IF THE NUMBER IS TOO BIG TO FIT IN THE FIELD, A PERCENT SIGN ("%") IS +; PRINTED AND THE FIELD IS EXTENDED TO HOLD THE NUMBER. + + +; Convert number/expression to string (format not specified) +; + ;FLOATING OUTPUT OF FAC + ;ALTERS ALL REGISTERS + ;THE ORIGINAL CONTENTS OF THE FAC IS LOST +; +; a.k.a. NUMASC +; --- START PROC L3425 --- +; Convert number/expression to string (format not specified) +FOUT: ;ENTRY TO PRINT THE FAC IN FREE FORMAT + XOR A ;SET FORMAT FLAGS TO FREE FORMATTED OUTPUT + +; --- START PROC L3426 --- +; Convert number/expression to string ("PRINT USING" format specified in 'A' register) +PUFOUT: ;ENTRY TO PRINT THE FAC USING THE FORMAT SPECIFICATIONS IN A, B AND C + CALL FOUINI ;SAVE THE FORMAT SPECIFICATION IN A AND PUT A SPACE FOR POSITIVE NUMBERS IN THE BUFFER + AND $08 ;CHECK IF POSITIVE NUMBERS GET A PLUS SIGN ; bit 3 - Sign (+ or -) preceeds number + JR Z,PUFOUT_0 ;THEY DON'T + LD (HL),'+' ;THEY DO, PUT IN A PLUS SIGN +PUFOUT_0: + EX DE,HL ;SAVE BUFFER POINTER + CALL VSIGN ;GET THE SIGN OF THE FAC ; Test sign of FPREG + EX DE,HL ;PUT THE BUFFER POINTER BACK IN (HL) + JP P,SPCFST ;IF WE HAVE A NEGATIVE NUMBER, NEGATE IT ; Positive - Space to start + LD (HL),'-' ; AND PUT A MINUS SIGN IN THE BUFFER ; "-" sign at start + PUSH BC ;SAVE THE FIELD LENGTH SPECIFICATION + PUSH HL ;SAVE THE BUFFER POINTER + CALL INVSGN ;NEGATE THE NUMBER + POP HL ;GET THE BUFFER POINTER BACK + POP BC ;GET THE FIELD LENGTH SPECIFICATIONS BACK + OR H ;TURN OFF THE ZERO FLAG, THIS DEPENDS ON THE FACT THAT FBUFFR IS NEVER ON PAGE 0. + +; --- START PROC SPCFST --- +SPCFST: + INC HL ;POINT TO WHERE THE NEXT CHARACTER GOES ; First byte of number + LD (HL),'0' ;PUT A ZERO IN THE BUFFER IN CASE THE NUMBER IS ZERO (IN FREE FORMAT) + ;OR TO RESERVE SPACE FOR A FLOATING DOLLAR SIGN (FIXED FORMAT) + LD A,(TEMP3) ;GET THE FORMAT SPECIFICATION + LD D,A ;SAVE IT FOR LATER + RLA ;PUT THE FREE FORMAT OR NOT BIT IN THE CARRY + LD A,(VALTYP) ;GET THE VALTYP, VNEG COULD HAVE CHANGED THIS SINCE -32768 IS INT AND 32768 IS SNG. + JP C,FOUTFX ;THE MAN WANTS FIXED FORMATED OUTPUT + + ;HERE TO PRINT NUMBERS IN FREE FORMAT + JP Z,FOUTZR ;IF THE NUMBER IS ZERO, FINISH IT UP + CP $04 ;DECIDE WHAT KIND OF A VALUE WE HAVE + JP NC,FOUFRV ;WE HAVE A SNG OR DBL + + ;HERE TO PRINT AN INTEGER IN FREE FORMAT + LD BC,$0000 ;SET THE DECIMAL POINT COUNT AND COMMA COUNT TO ZERO + CALL FOUTCI ;CONVERT THE INTEGER TO DECIMAL + ;FALL INTO FOUTZS AND ZERO SUPPRESS THE THING + + ;ZERO SUPPRESS THE DIGITS IN FBUFFR + ;ASTERISK FILL AND ZERO SUPPRESS IF NECESSARY + ;SET UP B AND CONDITION CODES IF WE HAVE A TRAILING SIGN +FOUTZS: + LD HL,FBUFFR+1 ;GET POINTER TO THE SIGN + LD B,(HL) ;SAVE THE SIGN IN B + LD C,' ' ;DEFAULT FILL CHARACTER TO A SPACE + LD A,(TEMP3) ;GET FORMAT SPECS TO SEE IF WE HAVE TO + LD E,A ; ASTERISK FILL. SAVE IT ; bit 5 - Asterisks fill + AND $20 + JR Z,FOUTZS_0 ;WE DON'T + LD A,B ;WE DO, SEE IF THE SIGN WAS A SPACE + CP C ;ZERO FLAG IS SET IF IT WAS + LD C,'*' ;SET FILL CHARACTER TO AN ASTERISK + JR NZ,FOUTZS_0 ;SET THE SIGN TO AN ASTERISK IF IT WAS A SPACE + LD A,E ;GET FORMAT SPECS AGAIN + AND $04 ;SEE IF SIGN IS TRAILING ; bit 2 - Sign (+ or -) follows ASCII number + JR NZ,FOUTZS_0 ;IF SO DON'T ASTERISK FILL + LD B,C ;B HAS THE SIGN, C THE FILL CHARACTER + +FOUTZS_0: + LD (HL),C ;FILL IN THE ZERO OR THE SIGN + RST CHRGTB ;GET THE NEXT CHARACTER IN THE BUFFER SINCE THERE ARE NO SPACES, "CHRGET" IS EQUIVALENT TO "INX H"/"MOV A,M" + JR Z,FOUTZS_1 ;IF WE SEE A REAL ZERO, IT IS THE END OF THE NUMBER, AND WE MUST BACK UP AND PUT IN A ZERO. + ;CHRGET SETS THE ZERO FLAG ON REAL ZEROS OR COLONS, BUT WE WON'T SEE ANY COLONS IN THIS BUFFER. + + CP 'E' ;BACK UP AND PUT IN A ZERO IF WE SEE + JR Z,FOUTZS_1 ;AN "E" OR A "D" SO WE CAN PRINT 0 IN + CP 'D' ;FLOATING POINT NOTATION WITH THE C FORMAT ZERO + JR Z,FOUTZS_1 + CP '0' ;DO WE HAVE A ZERO? + JR Z,FOUTZS_0 ;YES, SUPPRESS IT + CP ',' ;DO WE HAVE A COMMA? + JR Z,FOUTZS_0 ;YES, SUPPRESS IT + CP '.' ;ARE WE AT THE DECIMAL POINT? + JR NZ,FOUTZS_2 ;NO, I GUESS NOT +FOUTZS_1: + DEC HL ;YES, BACK UP AND PUT A ZERO BEFORE IT + LD (HL),'0' +FOUTZS_2: + LD A,E ;GET THE FORMAT SPECS TO CHECK FOR A FLOATING + AND $10 ; DOLLAR SIGN ; bit 4 - Print leading '$' + JR Z,FOUTZS_3 ;WE DON'T HAVE ONE + DEC HL ;WE HAVE ONE, BACK UP AND PUT IN THE DOLLAR + LD (HL),'$' ; SIGN +FOUTZS_3: + LD A,E ;DO WE HAVE A TRAILING SIGN? + AND $04 ; bit 2 - Sign (+ or -) follows ASCII number + RET NZ ;YES, RETURN; NOTE THE NON-ZERO FLAG IS SET + DEC HL ;NO, BACK UP ONE AND PUT THE SIGN BACK IN + LD (HL),B ;PUT IN THE SIGN + RET ;ALL DONE + + + ;HERE TO PRINT A SNG OR DBL IN FREE FORMAT +FOUFRV: + PUSH HL ;SAVE THE BUFFER POINTER + CALL FTCH_SNG + LD D,B ;THIS CALCULATES HOW MANY DIGITS + INC D ;WE WILL PRINT + LD BC,$0300 ;B = DECIMAL POINT COUNT + ;C = COMMA COUNT + ;SET COMMA COUNT TO ZERO AND DECIMAL POINT COUNT FOR E NOTATION + LD A,(FACCU) ;NORMAL ROUTE + SUB $3f ;SEE IF NUMBER SHOULD BE PRINTED IN E NOTATION + JR C,FOFRS1 ;IT SHOULD, IT IS .LT. .01 + INC D ;CHECK IF IT IS TOO BIG + CP D + JR NC,FOFRS1 ;IT IS TOO BIG, IT IS .GT. 10^D-1 + INC A ;IT IS OK FOR FIXED POINT NOTATION + LD B,A ;SET DECIMAL POINT COUNT + LD A,$02 ;SET FIXED POINT FLAG, THE EXPONENT IS ZERO + ; IF WE ARE USING FIXED POINT NOTATION +FOFRS1: + SUB $02 ;E NOTATION: ADD D-2 TO ORIGINAL EXPONENT + ;RESTORE EXP IF NOT D.P. + POP HL ;GET THE BUFFER POINTER BACK + PUSH AF ;SAVE THE EXPONENT FOR LATER + CALL FOUTAN ;.01 .LE. NUMBER .LT. .1? + LD (HL),'0' ;YES, PUT ".0" IN BUFFER + CALL Z,INCHL + CALL FOUTCV ;CONVERT THE NUMBER TO DECIMAL DIGITS + + ;HERE TO SUPPRESS THE TRAILING ZEROS +SUPTLZ: + DEC HL ; Move back through buffer ;MOVE BACK TO THE LAST CHARACTER + LD A,(HL) ; Get character ;GET IT AND SEE IF IT WAS ZERO + CP '0' ; "0" character? + JR Z,SUPTLZ ; Yes - Look back for more ;IT WAS, CONTINUE SUPPRESSING + CP '.' ; A decimal point? ;HAVE WE SUPPRESSED ALL THE FRACTIONAL DIGITS? + CALL NZ,INCHL ; Move back over digit ;YES, IGNORE THE DECIMAL POINT ALSO + POP AF ; Get "E" flag ;GET THE EXPONENT BACK + JR Z,NOENED ; No "E" needed - End buffer ;WE ARE DONE IF WE ARE IN FIXED POINT NOTATION + ;FALL IN AND PUT THE EXPONENT IN THE BUFFER + +; a.k.a. FOFLDN +; + ;HERE TO PUT THE EXPONENT AND "E" OR "D" IN THE BUFFER + ;THE EXPONENT IS IN A, THE CONDITION CODES ARE ASSUMED TO BE SET + ;CORRECTLY. +; +DOEBIT: + LD (HL),'E' ; Put "E" in buffer ;SAVE IT IN THE BUFFER + INC HL ; And move on ;INCREMENT THE BUFFER POINTER + + ;PUT IN THE SIGN OF THE EXPONENT + LD (HL),'+' ; Put '+' in buffer ;A PLUS IF POSITIVE + JP P,OUTEXP ; Positive - Output exponent + LD (HL),'-' ; Put "-" in buffer ;A MINUS IF NEGATIVE + CPL ; Negate exponent ;NEGATE EXPONENT + INC A + + ;CALCULATE THE TWO DIGIT EXPONENT +OUTEXP: + LD B,'0'-1 ; ASCII "0" - 1 ;INITIALIZE TEN'S DIGIT COUNT +EXPTEN: + INC B ; Count subtractions ;INCREMENT DIGIT + SUB 10 ; Tens digit ;SUBTRACT TEN + JR NC,EXPTEN ; More to do ;DO IT AGAIN IF RESULT WAS POSITIVE + ADD A,'0'+10 ; Restore and make ASCII ;ADD BACK IN TEN AND CONVERT TO ASCII + + ;PUT THE EXPONENT IN THE BUFFER + INC HL ; Move on + LD (HL),B ; Save MSB of exponent ;PUT TEN'S DIGIT OF EXPONENT IN BUFFER + INC HL ;WHEN WE JUMP TO HERE, A IS ZERO + LD (HL),A ; Save LSB of exponent ;PUT ONE'S DIGIT IN BUFFER + +FOUTZR: + INC HL ;INCREMENT POINTER, HERE TO FINISH UP + + ; PRINTING A FREE FORMAT ZERO +NOENED: + LD (HL),$00 ;PUT A ZERO AT THE END OF THE NUMBER + EX DE,HL ;SAVE THE POINTER TO THE END OF THE NUMBER IN (DE) FOR FFXFLV + LD HL,FBUFFR+1 ;GET A POINTER TO THE BEGINNING ; Buffer for fout + 1 + RET ;ALL DONE + + + ;HERE TO PRINT A NUMBER IN FIXED FORMAT +FOUTFX: + INC HL ;MOVE PAST THE ZERO FOR THE DOLLAR SIGN + PUSH BC ;SAVE THE FIELD LENGTH SPECIFICATIONS + CP $04 ;CHECK WHAT KIND OF VALUE WE HAVE + LD A,D ;GET THE FORMAT SPECS + JP NC,FOUFXV ;WE HAVE A SNG OR A DBL + + ;HERE TO PRINT AN INTEGER IN FIXED FORMAT + RRA ;CHECK IF WE HAVE TO PRINT IT IN FLOATING + JP C,FFXIFL ; POINT NOTATION + + ;HERE TO PRINT AN INTEGER IN FIXED FORMAT-FIXED POINT NOTATION + LD BC,$0603 ;SET DECIMAL POINT COUNT TO 6 AND COMMA COUNT TO 3 + CALL FOUICC ;CHECK IF WE DON'T HAVE TO USE THE COMMAS + POP DE ;GET THE FIELD LENGTHS + LD A,D ;SEE IF WE HAVE TO PRINT EXTRA SPACES BECAUSE + SUB $05 ; THE FIELD IS TOO BIG + CALL P,FOTZER ;WE DO, PUT IN ZEROS, THEY WILL LATER BE CONVERTED TO SPACES OR ASTERISKS BY FOUTZS + CALL FOUTCI ;CONVERT THE NUMBER TO DECIMAL DIGITS + +FOUTTD: + LD A,E ;DO WE NEED A DECIMAL POINT? + OR A + CALL Z,DCXHRT ;WE DON'T, BACKSPACE OVER IT. + DEC A ;GET HOW MANY TRAILING ZEROS TO PRINT + CALL P,FOTZER ;PRINT THEM + ;IF WE DO HAVE DECIMAL PLACES, FILL THEM UP WITH ZEROS + ;FALL IN AND FINISH UP THE NUMBER + + + ;HERE TO FINISH UP A FIXED FORMAT NUMBER +; This entry point is used by the routines at L35EC. +FOUTTS: + PUSH HL ;SAVE BUFFER POINTER + CALL FOUTZS ;ZERO SUPPRESS THE NUMBER + POP HL ;GET THE BUFFER POINTER BACK + JR Z,FFXIX1 ;CHECK IF WE HAVE A TRAILING SIGN + LD (HL),B ;WE DO, PUT THE SIGN IN THE BUFFER + INC HL ;INCREMENT THE BUFFER POINTER +FFXIX1: + LD (HL),$00 ;PUT A ZERO AT THE END OF THE NUMBER + + + ;HERE TO CHECK IF A FIXED FORMAT-FIXED POINT NUMBER OVERFLOWED ITS + ;FIELD LENGTH + ;D = THE B IN THE FORMAT SPECIFICATION + ;THIS ASSUMES THE LOCATION OF THE DECIMAL POINT IS IN TEMP2 + LD HL,FBUFFR ;GET A POINTER TO THE BEGINNING +FOUBE1: + INC HL ;INCREMENT POINTER TO THE NEXT CHARACTER +; This entry point is used by the routine at FOUBE3. +FOUBE5: + LD A,(NXTOPR) ;GET THE LOCATION OF THE DECIMAL POINT + + ;SINCE FBUFFR IS ONLY 35 (DECIMAL) LONG, WE + ; ONLY HAVE TO LOOK AT THE LOW ORDER TO SEE + ; IF THE FIELD IS BIG ENOUGH + SUB L ;FIGURE OUT HOW MUCH SPACE WE ARE TAKING + SUB D ;IS THIS THE RIGHT AMOUNT OF SPACE TO TAKE? + RET Z ;YES, WE ARE DONE, RETURN FROM FOUT + LD A,(HL) ;NO, WE MUST HAVE TOO MUCH SINCE WE STARTED + + ; CHECKING FROM THE BEGINNING OF THE BUFFER + ; AND THE FIELD MUST BE SMALL ENOUGH TO FIT IN THE BUFFER. + ; GET THE NEXT CHARACTER IN THE BUFFER. + CP ' ' ;IF IT IS A SPACE OR AN ASTERISK, WE CAN + JR Z,FOUBE1 ; IGNORE IT AND MAKE THE FIELD SHORTER WITH + CP '*' ; NO ILL EFFECTS + JR Z,FOUBE1 + DEC HL ;MOVE THE POINTER BACK ONE TO READ THE CHARACTER WITH CHRGET + PUSH HL ;SAVE THE POINTER + + + ;HERE WE SEE IF WE CAN IGNORE THE LEADING ZERO BEFORE A DECIMAL POINT. + ;THIS OCCURS IF WE SEE THE FOLLOWING: (IN ORDER) + ; +,- A SIGN (EITHER "-" OR "+") [OPTIONAL] + ; $ A DOLLAR SIGN [OPTIONAL] + ; 0 A ZERO [MANDATORY] + ; . A DECIMAL POINT [MANDATORY] + ; 0-9 ANOTHER DIGIT [MANDATORY] + ;IF YOU SEE A LEADING ZERO, IT MUST BE THE ONE BEFORE A DECIMAL POINT + ;OR ELSE FOUTZS WOULD HAVE SUPPRESSED IT, SO WE CAN JUST "INX H" + ;OVER THE CHARACTER FOLLOWING THE ZERO, AND NOT CHECK FOR THE + ;DECIMAL POINT EXPLICITLY. +FOUBE2: + PUSH AF ;PUT THE LAST CHARACTER ON THE STACK. + ;THE ZERO FLAG IS SET. + ;THE FIRST TIME THE ZERO ZERO FLAG IS NOT SET. + LD BC,FOUBE2 ;GET ADDRESS WE GO TO IF WE SEE A CHARACTER + PUSH BC ; WE ARE LOOKING FOR + RST CHRGTB ;GET THE NEXT CHARACTER + CP '-' ;SAVE IT AND GET THE NEXT CHARACTER IF IT IS + RET Z ; A MINUS SIGN, A PLUS SIGN OR A DOLLAR SIGN + CP '+' + RET Z + CP '$' + RET Z + POP BC ;IT ISN'T, GET THE ADDRESS OFF THE STACK + CP '0' ;IS IT A ZERO? + JR NZ,FOUBE4 ;NO, WE CAN NOT GET RID OF ANOTHER CHARACTER + INC HL ;SKIP OVER THE DECIMAL POINT + RST CHRGTB ;GET THE NEXT CHARACTER + JR NC,FOUBE4 ;IT IS NOT A DIGIT, WE CAN'T SHORTEN THE FIELD + DEC HL ;WE CAN!!! POINT TO THE DECIMAL POINT + JR FOUBE3_0 + +; Routine at 13655 +FOUBE3: + DEC HL ;POINT BACK ONE CHARACTER + LD (HL),A ;PUT THE CHARACTER BACK + + + ;IF WE CAN GET RID OF THE ZERO, WE PUT THE CHARACTERS ON THE STACK + ;BACK INTO THE BUFFER ONE POSITION IN FRONT OF WHERE THEY ORIGINALLY + ;WERE. NOTE THAT THE MAXIMUM NUMBER OF STACK LEVELS THIS USES IS + ;THREE -- ONE FOR THE LAST ENTRY FLAG, ONE FOR A POSSIBLE SIGN, + ;AND ONE FOR A POSSIBLE DOLLAR SIGN. WE DON'T HAVE TO WORRY ABOUT + ;THE FIRST CHARACTER BEING IN THE BUFFER TWICE BECAUSE THE POINTER + ;WHEN FOUT EXITS WILL BE POINTING TO THE SECOND OCCURANCE. +FOUBE3_0: + POP AF ;GET THE CHARACTER OFF THE STACK + JR Z,FOUBE3 ;PUT IT BACK IN THE BUFFER IF IT IS NOT THE LAST ONE + POP BC ;GET THE BUFFER POINTER OFF THE STACK + JR FOUBE5 ;SEE IF THE FIELD IS NOW SMALL ENOUGH + + ;HERE IF THE NUMBER IS TOO BIG FOR THE FIELD +; Routine at 13663 +; +FOUBE4: + POP AF ;GET THE CHARACTERS OFF THE STACK + JR Z,FOUBE4 ;LEAVE THE NUMBER IN THE BUFFER ALONE + POP HL ;GET THE POINTER TO THE BEGINNING OF THE NUMBER MINUS 1 + LD (HL),'%' ;PUT IN A PERCENT SIGN TO INDICATE THE NUMBER WAS TOO LARGE FOR THE FIELD + RET ;ALL DONE -- RETURN FROM FOUT + + + ;HERE TO PRINT A SNG OR DBL IN FIXED FORMAT +FOUFXV: + PUSH HL ;SAVE THE BUFFER POINTER + RRA ;GET FIXED OR FLOATING NOTATION FLAG IN CARRY + JP C,FFXFLV ;PRINT THE NUMBER IN E-NOTATION + CALL FTCH_SNG + LD D,B ;SET D = NUMBER OF DIGITS TO PRINT FOR A DBL + LD A,(FACCU) + SUB $4F ; (WE CAN'T PRINT A NUMBER .GE. 10^16 IN FIXED POINT NOTATION) + JR C,FFXSDC ;IF THE FAC WAS SMALL ENOUGH, GO PRINT IT + + ;HERE TO PRINT IN FREE FORMAT WITH A PERCENT SIGN A NUMBER .GE. 10^16 +;FFXSDO: + POP HL ;GET THE BUFFER POINTER OFF THE STACK + POP BC ;GET THE FIELD SPECIFICATION OFF THE STACK + CALL FOUT ;PRINT THE NUMBER IN FREE FORMAT + LD HL,FBUFFR ;POINT TO IN FRONT OF THE NUMBER + LD (HL),'%' ;PUT IN THE PERCENT SIGN + RET ;ALL DONE--RETURN FROM FOUT + + ;HERE TO PRINT A SNG IN FIXED FORMAT--FIXED POINT NOTATION +FFXSDC: + CALL SIGN ; test FP number sign + CALL NZ,FOUTNV + POP HL + POP BC + JP M,FFXXVS + + ;HERE TO PRINT A NUMBER WITH NO FRACTIONAL DIGITS + PUSH BC ;SAVE THE FIELD LENGTH SPECS AGAIN + LD E,A ;SAVE THE EXPONENT IN E + LD A,B ;WE HAVE TO PRINT LEADING ZEROS IF THE FIELD + SUB D ; HAS MORE CHARACTERS THAN THERE ARE DIGITS + SUB E ; IN THE NUMBER. + + ; IF WE ARE USING COMMAS, A MAY BE TOO BIG. + ; THIS DOESN'T MATTER BECAUSE FOUTTS WILL FIND THE CORRECT BEGINNING. + ; THERE IS ROOM IN FBUFFR BECAUSE THE MAXIMUM VALUE B CAN BE IS + ; 24 (DECIMAL) SO D+C .LE. 16 (DECIMAL) SINCE FAC .LT. 10^16. + ; SO WE NEED 8 MORE BYTES FOR ZEROS. + ; 4 COME SINCE WE WILL NOT NEED TO PRINT AN EXPONENT. + ; FBUFFR ALSO CONTAINS AN EXTRA 4 BYTES FOR THIS CASE. + ;(IT WOULD TAKE MORE THAN 4 BYTES TO CHECK FOR THIS.) + + CALL P,FOTZER ;FOUTZS WILL LATER SUPPRESS THEM + CALL FOUTCD ;SETUP DECIMAL POINT AND COMMA COUNT + CALL FOUTCV ;CONVERT THE NUMBER TO DECIMAL DIGITS + OR E ;PUT IN DIGITS AFTER THE NUMBER IF IT IS BIG ENOUGH, HERE A=0 + CALL NZ,FOTZEC ;THERE CAN BE COMMAS IN THESE ZEROS + OR E ;MAKE SURE WE GET A DECIMAL POINT FOR FOUTTS + CALL NZ,FOUTED + POP DE ;GET THE FIELD LENGTH SPECS + JP FOUTTD ;GO CHECK THE SIZE, ZERO SUPPRESS, ETC. AND FINISH THE NUMBER + + ;HERE TO PRINT A SNG OR DBL THAT HAS FRACTIONAL DIGITS +FFXXVS: + LD E,A ;SAVE THE EXPONENT + LD A,C ;DIVIDE BY TEN THE RIGHT NUMBER OF TIMES SO + OR A ; THE RESULT WILL BE ROUNDED CORRECTLY AND + CALL NZ,DCRART ; HAVE THE CORRECT NUMBER OF SIGNIFICANT + ADD A,E ; DIGITS + JP M,FFXXV8 ;FOR LATER CALCULATIONS, WE WANT A ZERO IF THE + XOR A ; RESULT WAS NOT NEGATIVE +FFXXV8: + PUSH BC ;SAVE THE FIELD SPECS + PUSH AF ;SAVE THIS NUMBER FOR LATER + CALL M,FINDIV + POP BC ;GET THE NUMBER WE SAVED BACK IN B + LD A,E ;WE HAVE TWO CASES DEPENDING ON WHETHER THE + SUB B ; THE NUMBER HAS INTEGER DIGITS OR NOT + POP BC ;GET THE FILED SPECS BACK + LD E,A ;SAVE HOW MANY DECIMAL PLACES BEFORE THE + ADD A,D ; THE NUMBER ENDS + LD A,B ;GET THE "B" FIELD SPEC + JP M,FFXXV3 + + ;HERE TO PRINT NUMBERS WITH INTEGER DIGITS + SUB D ;PRINT SOME LEADING ZEROS IF THE FIELD IS + SUB E ; BIGGER THAN THE NUMBER OF DIGITS WE WILL + CALL P,FOTZER ; PRINT + PUSH BC ;SAVE FIELD SPEC + CALL FOUTCD ;SET UP DECIMAL POINT AND COMMA COUNT + JR FFXXV6 ;CONVERT THE DIGITS AND DO THE TRIMMING UP + + ;HERE TO PRINT A NUMBER WITHOUT INTEGER DIGITS +FFXXV3: + CALL FOTZER ;PUT ALL ZEROS BEFORE THE DECIMAL POINT + LD A,C ;SAVE C + CALL FOUTDP ;PUT IN A DECIMAL POINT + LD C,A ;RESTORE C + XOR A ;DECIDE HOW MANY ZEROS TO PRINT BETWEEN THE + SUB D ; DECIMAL POINT AND THE FIRST DIGIT WE WILL + SUB E ; PRINT. + CALL FOTZER ;PRINT THE ZEROS + PUSH BC ;SAVE EXPONENT AND THE "C" IN THE FIELD SPEC + LD B,A ;ZERO THE DECIMAL PLACE COUNT + LD C,A ;ZERO THE COMMA COUNT +FFXXV6: + CALL FOUTCV ;CONVERT THE NUMBER TO DECIMAL DIGITS + POP BC ;GET THE FIELD SPECS BACK + OR C ;CHECK IF WE HAVE TO PRINT ANY ZEROS AFTER THE LAST DIGIT + JR NZ,FFXXV7 ;CHECK IF THERE WERE ANY DECIMAL PLACES AT ALL + ;E CAN NEVER BE 200, (IT IS NEGATIVE) SO IF + ; A=0 HERE, THERE IS NO WAY WE WILL CALL FOTZER + LD HL,(NXTOPR) ;THE END OF THE NUMBER IS WHERE THE DP IS +FFXXV7: + ADD A,E ;PRINT SOME MORE TRAILING ZEROS + DEC A + CALL P,FOTZER + LD D,B ;GET THE "B" FIELD SPEC IN D FOR FOUTTS + JP FOUTTS ;FINISH UP THE NUMBER + + ;HERE TO PRINT AN INTEGER IN FIXED FORMAT--FLOATING POINT NOTATION +FFXIFL: + PUSH HL ;SAVE THE BUFFER POINTER + PUSH DE ;SAVE THE FORMAT SPECS + CALL CONSI ;CONVERT THE INTEGER TO A SNG + POP DE ;GET THE FORMAT SPECS BACK +;;; XOR A ;SET FLAGS TO PRINT THE NUMBER AS A SNG + ;FALL INTO FFXFLV +FFXFLV: + CALL FTCH_SNG + LD E,B ; () GET HOW MANY DIGITS WE PRINT + +; Routine at 13817 + CALL SIGN ;SEE IF WE HAVE ZERO + PUSH AF + CALL NZ,FOUTNV ;IF NOT, NORMALIZE THE NUMBER SO ALL DIGITS TO BE PRINTED ARE IN THE INTEGER PART + POP AF + POP HL ;GET THE BUFFER POINTER BACK + POP BC ;GET THE FIELD LENGTH SPECS + PUSH AF ;SAVE THE EXPONENT + LD A,C ;CALCULATE HOW MANY SIGNIFICANT DIGITS WE MUST + OR A ; PRINT + PUSH AF ;SAVE THE "C" FIELD SPEC FOR LATER + CALL NZ,DCRART ; (DEC A, RET) + ADD A,B + LD C,A + LD A,D ;GET THE "A" FIELD SPEC + AND $04 ;SEE IF THE SIGN IS A TRAILING SIGN + CP $01 ;SET CARRY IF A IS ZERO + SBC A,A ;SET D=0 IF WE HAVE A TRAILING SIGN, + LD D,A ; D=377 IF WE DO NOT + ADD A,C + LD C,A ;SET C=NUMBER OF SIGNIFICANT DIGITS TO PRINT + SUB E ;IF WE HAVE LESS THAN E, THEN WE MUST GET RID + PUSH AF ;SAVE COMPARISON # OF SIG DIGITS AND THE # OF DIGITS WE WILL PRINT + JP P,FFXLV3_0 + CALL FINDIV ; OF SOME BY DIVIDING BY TEN AND ROUNDING + JR NZ,FFXLV3_0 + PUSH HL + CALL DSHFRB ;SHIFT NUMBER RIGHT ONE, SHIFT IN CARRY + LD HL,FACCU + INC (HL) + POP HL +FFXLV3_0: + POP AF ;GET # OF TRAILING ZEROS TO PRINT + PUSH BC ;SAVE THE "B" FIELD SPEC AND # OF SIG DIGITS + PUSH AF ;SAVE # OF TRAILING ZEROS TO PRINT + JP M,FFXLV3 ;TAKE INTO ACCOUNT DIGITS THAT WERE + XOR A ;DIVIDED OFF AT FFXLV1 +FFXLV3: + CPL + INC A + ADD A,B ;SET THE DECIMAL PLACE COUNT + INC A + ADD A,D ;TAKE INTO ACCOUNT IF THE SIGN IS TRAILING + LD B,A ; OR NOT + LD C,$00 ;SET COMMA COUNT TO ZERO, THE COMMA SPEC IS IGNORED. + CALL Z,FOUTAN ;CONVERT THE NUMBER TO DECIMAL DIGITS + CALL FOUTCV ;GET NUMBER TRAILING ZEROS TO PRINT + POP AF + + ;IF THE FIELD LENGTH IS LONGER THAN THE # OF DIGITS + ;WE CAN PRINT + CALL P,FOTZNC ;THE DECIMAL POINT COULD COME OUT IN HERE + CALL FOUTED ;IN CASE D.P. IS LAST ON LIST + POP BC ;GET # OF SIG DIGITS AND "B" FIELD SPAC BACK + POP AF ;GET THE "C" FIELD SPEC BACK + JR NZ,FFXLV4 ;IF NON-ZERO PROCEED + CALL DCXHRT ;SEE IF D.P. THERE + LD A,(HL) ;FETCH TO MAKE SURE D.P. + CP '.' ;IF NOT MUST BE ZERO + CALL NZ,INCHL ;IF NOT MUST LEAVE AS IS + LD (NXTOPR),HL ;NEED D.P. LOCATION IN TEMP2 +FFXLV4: ; SO IGNORE IT. + POP AF ;GET THE EXPONENT BACK + LD A,(FACCU) + JR Z,FFXLV2 ;EXPONENT=0 IF THE NUMBER IS ZERO + ADD A,E ;SCALE IT CORRECTLY + SUB B + SUB D +FFXLV2: + PUSH BC ;SAVE THE "B" FIELD SPEC + CALL DOEBIT ;PUT THE EXPONENT IN THE BUFFER + EX DE,HL ;GET THE POINTER TO THE END IN (HL) IN CASE WE HAVE A TRAILING SIGN + POP DE ;GET THE "B" FIELD SPEC IN D, PUT ON A + JP FOUTTS ; POSSIBLE TRAILING SIGN AND WE ARE DONE + + + ;HERE TO PUT SOME ZEROS IN THE BUFFER + ;THE COUNT IS IN A, IT CAN BE ZERO, BUT THE ZERO FLAG MUST BE SET + ;ONLY (HL) AND A ARE ALTERED + ;WE EXIT WITH A=0 +; Routine at 13926 +FOTZER: + OR A ;THIS IS BECAUSE FFXXV3 CALL US WITH THE CONDITION CODES NOT SET UP +FOTZR1: + RET Z ;RETURN IF WE ARE DONE + DEC A ;WE ARE NOT DONE, SO DECREMENT THE COUNT + LD (HL),'0' ;PUT A ZERO IN THE BUFFER + INC HL ;UPDATE THE BUFFER POINTER + JR FOTZR1 ;GO SEE IF WE ARE NOW DONE + + + ;HERE TO PUT ZEROS IN THE BUFFER WITH COMMAS OR A DECIMAL POINT IN THE MIDDLE. + ;THE COUNT IS IN A, IT CAN BE ZERO, BUT THE ZERO FLAG MUST BE SET. + ;B THE DECIMAL POINT COUNT AND C THE COMMA COUNT ARE UPDATED + ;A,B,C,H,L ARE ALTERED +; Data block at 13934 +FOTZNC: + JR NZ,FOTZEC ;ENTRY AFTER A "CALL FOUTCV" +FOTZRC: + RET Z ;RETURN IF WE ARE DONE + CALL FOUTED ;SEE IF WE HAVE TO PUT A COMMA OR A DECIMAL POINT BEFORE THIS ZERO +FOTZEC: + LD (HL),'0' ;PUT A ZERO IN THE BUFFER + INC HL ;UPDATE THE BUFFER POINTER + DEC A ;DECREMENT THE ZERO COUNT + JR FOTZRC ;GO BACK AND SEE IF WE ARE DONE + + +; Routine at 13946 +FOUTCD: + LD A,E ;SETUP DECIMAL POINT COUNT + ADD A,D + INC A + LD B,A + INC A ;SETUP COMMA COUNT +FOUTCD_0: + SUB $03 ;REDUCE [A] MOD 3 + JR NC,FOUTCD_0 + ADD A,$05 ;ADD 3 BACK IN AND ADD 2 MORE FOR SCALING + LD C,A ;SAVE A POSSIBLE COMMA COUNT + +FOUICC: + LD A,(TEMP3) ;GET THE FORMAT SPECS + AND $40 ;LOOK AT THE COMMA BIT + RET NZ ;WE ARE USING COMMAS, JUST RETURN + LD C,A ;WE AREN'T, ZERO THE COMMA COUNT + RET ;ALL DONE + + +;***************************************************************** +; +; $FOUTAN THIS ROUTINE IS CALLED BY THE FREE FORMAT OUTPUT +; CODE TO OUTPUT DECIMAL POINT AND LEADING ZEROS. +; $FOUTED THIS ROUTINE IS CALLED BY BOTH THE FREE FORMAT +; OUTPUT ROUTINE AND THE PRINT USING CODE TO OUTPUT +; THE DECIMAL POINT WHEN NECESSARY AND TO PUT IN +; COMMAS "," AFTER EACH THREE DIGITS IF THIS OPTION +; IS INVOKED. +; CALLING SEQUENCE: CALL $FOUTAN +; CALL $FOUTED +; WITH $FMTCX CONTAINING NUMBER PLACES PRIOR TO +; DECIMAL POINT(NEGATIVELY) IN UPPER BYTE AND +; NO PLACES BEFORE NEXT COMMA IN LOW BYTE +; +;******************************************************************* + + + ;HERE TO PUT DECIMAL POINTS AND COMMAS IN THEIR CORRECT PLACES + ;THIS SUBROUTINE SHOULD BE CALLED BEFORE THE NEXT DIGIT IS PUT IN THE + ;BUFFER. B=THE DECIMAL POINT COUNT, C=THE COMMA COUNT + ;THE COUNTS TELL HOW MANY MORE DIGITS HAVE TO GO IN BEFORE THE COMMA + ;OR DECIMAL POINT GO IN. THE COMMA OR DECIMAL POINT THEN GOES BEFORE + ;THE LAST DIGIT IN THE COUNT. FOR EXAMPLE, IF THE DECIMAL POINT SHOULD + ;COME AFTER THE FIRST DIGIT, THE DECIMAL POINT COUNT SHOULD BE 2. +; Routine at 13966 +; +FOUTAN: + DEC B ;IF NEGATIVE THEN LEADING ZEROS + JP P,FTD05 ;PROCESS AS NORMAL + LD (NXTOPR),HL ;SAVE DECIMAL POINT COUNT ;SAVE LOCATION OF DECIMAL POINT + LD (HL),'.' ;MOVE IN DECIMAL POINT +FTN10: + INC HL ;POINT TO NEXT OUTPUT POSITION + LD (HL),'0' ;PUT IN LEADING ZERO + INC B ;WILL INCREMENT B UNTIL ZERO + LD C,B + JR NZ,FTN10 ;PUT IN LEADING ZEROS UNTIL B ZERO + INC HL ;POINT TO NEXT AVAILABLE BUFFER LOCATION + RET + +; Routine at 13984 +; Used by the routines at FOUTCI. +FOUTED: + DEC B ;TIME FOR D.P.? +FTD05: + JR NZ,FOUED1 ;IF NOT D.P. TIME, SEE IF COMMA TIME + + ;ENTRY TO PUT A DECIMAL POINT IN THE BUFFER +FOUTDP: + LD (HL),'.' ;YES, PUT THE DECIMAL POINT IN + LD (NXTOPR),HL ;SAVE THE LOCATION OF THE DECIMAL POINT + INC HL ;INCREMENT THE BUFFER POINTER PAST D.P. + LD C,B ;PUT ZERO IN C SO WE WON"T PRINT ANY COMMAS AFTER THE DECIMAL POINT. + RET ;ALL DONE + +;HERE TO SEE IF IT IS TIME TO PRINT A COMMA +FOUED1: + DEC C ;IF ZERO TIME FOR COMMA + RET NZ ;NOPE, WE CAN RETURN + LD (HL),',' ;YES, PUT A COMMA IN THE BUFFER + INC HL ;POINT TO NEXT BUFFER POSITION + LD C,$03 ;RESET THE COMMA COUNT SO WE WILL PRINT A COMMA AFTER THREE MORE DIGITS. + RET ;ALL DONE + + + ;HERE TO CONVERT A SNG OR DBL NUMBER THAT HAS BEEN NORMALIZED TO DECIMAL DIGITS. + ;THE DECIMAL POINT COUNT AND COMMA COUNT ARE IN B AND C RESPECTIVELY. + ;(HL) POINTS TO WHERE THE FIRST DIGIT WILL GO. + ;THIS EXITS WITH A=0. (DE) IS LEFT UNALTERED. +; Data block at 14003 + ; --- START PROC FOUTCV --- +FOUTCV: + PUSH DE + ;HERE TO CONVERT A DOUBLE PRECISION NUMBER TO DECIMAL DIGITS + PUSH HL + PUSH BC + CALL FTCH_SNG + LD A,B + POP BC + POP HL + LD DE,FACCU+1 + SCF +FOUCD1: + PUSH AF + CALL FOUTED + LD A,(DE) + JR NC,L36CD + RRA + RRA + RRA + RRA + JR L36CE + +L36CD: + INC DE +L36CE: + AND $0F + ADD A,'0' + LD (HL),A + INC HL + POP AF + DEC A + CCF + JR NZ,FOUCD1 + JR FOUCI3 + + +;************************************************************* +; +; $FOUTCI CONVERT THE INTEGER IN (FACLO)-TWO BYTES TO +; ASCII DIGITS. +; CALLING SEQUENCE: CALL $FOUTCI +; WITH DECIMAL POINT AND COMMA COUNTS IN (CX) +; $FOUTO CONVERT INTEGER IN $FACLO:FACLO+1 TO OCTAL +; $FOUTH CONVERT INTEGER IN $FACLO:FACLO+1 TO HEXIDECIMAL +; CALLING SEQUENCE: CALL $FOUTO/$FOUTH +; WITH $FACLO:FACLO+1 CONTAINING INTEGER TO BE +; PRINTED. RETURNS WITH (BX) POINTING TO $FBUFF +; +;************************************************************** + + ;HERE TO CONVERT AN INTEGER INTO DECIMAL DIGITS + ;THIS EXITS WITH A=0. (DE) IS LEFT UNALTERED. +; Routine at 14043 +FOUTCI: + PUSH DE + LD DE,POWERS_TAB ;INTEGER POWER OF TEN TABLE (a.k.a. FOITB) + LD A,$05 ;MAX DIGITS TO CONVERT + + ;HERE TO CALCULATE EACH DIGIT +FOUCI1: ;ENTRY FOR FOTCV SO WE WILL ONLY CONVERT 4 DIGITS + CALL FOUTED ;SEE IF A COMMA OR DP GOES BEFORE THE DIGIT + PUSH BC ;SAVE COMMA AND DECIMAL POINT INFORMATION + PUSH AF ;SAVE DIGIT COUNT + PUSH HL ;SAVE BUFFER POINTER + EX DE,HL ;GET THE POWER OF TEN POINTER IN (HL) + LD C,(HL) ;PUT THE POWER OF TEN ON THE STACK + INC HL + LD B,(HL) + PUSH BC + INC HL ;INCREMENT THE PWR OF TEN PTR TO NEXT POWER + EX (SP),HL ;GET THE POWER OF TEN IN (HL) AND PUT THE POINTER ON THE STACK + EX DE,HL ;PUT THE POWER OF TEN IN (DE) + LD HL,(FACLOW) ;GET THE INTEGER IN (HL) + LD B,'0'-1 ;SET UP THE DIGIT COUNT, B=DIGIT TO BE PRINTED + + +FOUCI2: + INC B ;INCREMENT THE DIGIT COUNT + ; HL=HL-DE: SUBTRACT OUT POWER OF TEN + LD A,L ;SUBTRACT (DE) FROM (HL) + SUB E ;SUBTRACT THE LOW ORDERS + LD L,A ;SAVE THE NEW RESULT + LD A,H ;SUBTRACT THE HIGH ORDERS + SBC A,D + LD H,A ;SAVE THE NEW HIGH ORDER + JR NC,FOUCI2 ;IF (HL) WAS .GE. (DE) THEN SUBTRACT AGAIN + ADD HL,DE ;WE ARE DONE, BUT WE SUBTRACTED (DE) ONCE TOO OFTEN, SO ADD IT BACK IN + LD (FACLOW),HL ;SAVE IN THE FAC WHAT IS LEFT + POP DE ;GET THE POWER OF TEN POINTER BACK + POP HL ;GET THE BUFFER POINTER BACK + LD (HL),B ;PUT THE NEW DIGIT IN THE BUFFER + INC HL ;INCREMENT THE BUFFER POINTER TO NEXT DIGIT + POP AF ;GET THE DIGIT COUNT BACK + POP BC ;GET THE COMMA AND DP INFORMATION BACK + DEC A ;WAS THAT THE LAST DIGIT? + JR NZ,FOUCI1 ;NO, GO DO THE NEXT ONE +FOUCI3: + CALL FOUTED ;YES, SEE IF A DP GOES AFTER THE LAST DIGIT + LD (HL),A ;PUT A ZERO AT THE END OF THE NUMBER, BUT DON'T INCREMENT (HL) + ;SINCE AN EXPONENT OR A TRAILING SIGN MAY BE COMMING + POP DE ;GET (DE) BACK + RET ;ALL DONE, RETURN WITH A=0 + + + ;CONSTANTS USED BY FOUT + +; Routine at 14096 +POWERS_TAB: + DEFW 10000 + DEFW 1000 + DEFW 100 + DEFW 10 + DEFW 1 + + +; This entry point is used by __BIN$. +BIN_STR: + DEFB $06 ; "LD B,1" ; BASE: 2^1 -> 2 +L371B: + DEFB $01 ; "LD BC,nn" to jump over the next word without executing it +L371C: + DEFB $18 ; "JR 06 -> FOUT_SUB +L371D: + DEFB $06 ; "LD B,6" /INC BC ; BASE: 2^6 -> 64 (this is incidental !!) + +; This entry point is used by the routines at NUMLIN and __OCT$. +FOUTO: + LD B,$03 ; BASE: 2^3 -> 8 + JR FOUT_SUB + +; Routine at 14114 +; +; Used by the routines at NUMLIN and __HEX$. +FOUTH: + LD B,$04 ; BASE: 2^4 -> 16 + + +FOUT_SUB: + PUSH BC + CALL GETWORD_HL ;GET DOUBLE BYTE INT IN [H,L] + LD DE,FBUFFR+17 ;POINTER TO OUTPUT BUFFER IN [D,E] + XOR A ;GET SET TO HAVE FIRST DIGIT FOR OCTAL + LD (DE),A ;CLEAR DIGIT SEEN FLAG + POP BC + LD C,A +FOUT_SUB_0: + PUSH BC + DEC DE ;BUMP POINTER +FOUT_SUB_1: + AND A + LD A,H + RRA + LD H,A + LD A,L + RRA + LD L,A + LD A,C + RRA + LD C,A + DJNZ FOUT_SUB_1 + POP BC + PUSH BC +MAKDIG: + RLCA + DJNZ MAKDIG + ADD A,'0' ;MAKE NUMERIC DIGIT + CP '9'+1 ;IS IT A BIG HEX DIGIT? (A-F) + JR C,NOTHAL ;NO, DONT ADD OFFSET + ADD A,'A'-'9'-1 ;(A..F) ADD OFFSET +NOTHAL: + LD (DE),A ;SAVE DIGIT IN FBUFFR + POP BC + LD A,L + OR H + JR NZ,FOUT_SUB_0 + EX DE,HL + RET + +; Routine at 14162 +; +; Used by the routines at FINDIV, FOUTNV and L37B4. +FTCH_SNG: + RST GETYPR ; Get the number type (FAC) + LD HL,FACCU+7 + LD B,$0E + RET NC + LD HL,FACLOW+1 + LD B,$06 + RET + + + ;HERE TO INITIALLY SET UP THE FORMAT SPECS AND PUT IN A SPACE FOR THE + ;SIGN OF A POSITIVE NUMBER +; Routine at 14175 +FOUINI: + LD (TEMP3),A ;SAVE THE FORMAT SPECIFICATION + PUSH AF + PUSH BC + PUSH DE + CALL __CDBL + LD HL,FP_ZERO + LD A,(FACCU) + AND A + CALL Z,HL2FACCU + POP DE + POP BC + POP AF + LD HL,FBUFFR+1 ;WE START AT FBUFFR+1 IN CASE THE NUMBER WILL OVERFLOW ITS FIELD, + ; THEN THERE IS ROOM IN FBUFFR FOR THE PERCENT SIGN. + LD (HL),' ' ;PUT IN A SPACE + RET ;ALL DONE + +; Routine at 14203 +; +FINDIV: + PUSH HL + PUSH DE + PUSH BC + PUSH AF + CPL + INC A + LD E,A + LD A,$01 + JP Z,FINDIV_1 + CALL FTCH_SNG + PUSH HL +FINDIV_0: + CALL DSHFRB + DEC E + JR NZ,FINDIV_0 + POP HL + INC HL + LD A,B + RRCA + LD B,A + CALL BNORM_8 + CALL L37B4 +FINDIV_1: + POP BC + ADD A,B + POP BC + POP DE + POP HL + RET + +; Routine at 14242 +; +FOUTNV: + PUSH BC + PUSH HL + CALL FTCH_SNG + LD A,(FACCU) + SUB $40 + SUB B + LD (FACCU),A + POP HL + POP BC + OR A + RET + +; Routine at 14260 +; +; Used by the routine at FINDIV. +L37B4: + PUSH BC + CALL FTCH_SNG +L37B4_0: + LD A,(HL) + AND $0F + JR NZ,L37B4_1 + DEC B + LD A,(HL) + OR A + JR NZ,L37B4_1 + DEC HL + DJNZ L37B4_0 +L37B4_1: + LD A,B + POP BC + RET + +; Single precision exponential function +FEXP: + CALL DEC_HL2ARG + CALL CONDS + CALL STAKARG + CALL XSTKFP + CALL USTAKARG + + +; Double precision exponential function +DEXP: + LD A,(ARG) + OR A + JP Z,INTEXP_0 ; SIGN - test FP number sign + LD H,A + LD A,(FACCU) + OR A + JP Z,INTEXP_2 + CALL STAKFP + CALL L391A + JR C,DEXP_1 + EX DE,HL + LD (TEMP8),HL + CALL VALDBL + CALL USTAKARG + CALL L391A + CALL VALDBL + LD HL,(TEMP8) + JP NC,L385A + LD A,(ARG) + PUSH AF + PUSH HL + CALL ARG2FACCU + LD HL,FBUFFR ; Buffer for fout + CALL DBL_FACCU2HL + LD HL,FP_UNITY ; Load '1' to FP accumulator + CALL HL2FACCU ;SAVE y ; Put value on stack + POP HL + LD A,H + OR A + PUSH AF + JP P,DEXP_0 + XOR A + LD C,A + SUB L + LD L,A + LD A,C + SBC A,H + LD H,A +DEXP_0: + PUSH HL + JP L3878_0 + +DEXP_1: + CALL VALDBL + CALL ARG2FACCU + CALL XSTKFP + CALL __LOG + CALL USTAKARG + CALL DMUL + JP __EXP + + +; Integer exponential function +; FACCU=DE^HL +INTEXP: + LD A,H + OR L + JR NZ,INTEXP_1 + +INTEXP_0: + LD HL,$0001 + JP INT_RESULT_ONE + +INTEXP_1: + LD A,D + OR E + JR NZ,L385A +INTEXP_2: + LD A,H + RLA + JR NC,INT_RESULT_ZERO + JP O_ERR ; Err $0B - "Division by zero" + +INT_RESULT_ZERO: + LD HL,$0000 +INT_RESULT_ONE: + JP MAKINT + +L385A: + LD (TEMP8),HL + PUSH DE + LD A,H + OR A + PUSH AF + CALL M,INEGHL + LD B,H + LD C,L + LD HL,$0001 +L3869: + OR A + LD A,B + RRA + LD B,A + LD A,C + RRA + LD C,A + JR NC,L3877 + CALL L390D + JR NZ,L38C3 +L3877: + LD A,B +L3878: + OR C + JR Z,L3878_2 + PUSH HL + LD H,D + LD L,E + CALL L390D + EX DE,HL + POP HL + JR Z,L3869 + PUSH BC + PUSH HL + LD HL,FBUFFR ; Buffer for fout + CALL DBL_FACCU2HL + POP HL + CALL HL_CSNG + CALL CONDS +; This entry point is used by the routine at DEXP. +L3878_0: + POP BC + LD A,B + OR A + RRA + LD B,A + LD A,C + RRA + LD C,A + JR NC,L3878_1 + PUSH BC + LD HL,FBUFFR ; Buffer for fout + CALL MULPHL + POP BC +L3878_1: + LD A,B + OR C + JR Z,L3878_2 + PUSH BC + CALL STAKFP + LD HL,FBUFFR ; Buffer for fout + PUSH HL + CALL HL2FACCU + POP HL + PUSH HL + CALL MULPHL + POP HL + CALL DBL_FACCU2HL + CALL USTAKFP + JR L3878_0 + +L38C3: + PUSH BC + PUSH DE + CALL __CDBL + CALL FACCU2ARG + POP HL + CALL HL_CSNG + CALL CONDS + LD HL,FBUFFR ; Buffer for fout + CALL DBL_FACCU2HL + CALL ARG2FACCU + POP BC + JR L3878_1 + +L3878_2: + POP AF + POP BC + RET P + LD A,(VALTYP) + CP $02 ; Integer ? + JR NZ,L3878_3 + PUSH BC + CALL HL_CSNG + CALL CONDS + POP BC +L3878_3: + LD A,(FACCU) + OR A + JR NZ,L3878_4 + LD HL,(TEMP8) + OR H + RET P + LD A,L + RRCA + AND B + JP OV_ERR ; Err $06 - "Overflow" + +L3878_4: + CALL FACCU2ARG + LD HL,FP_UNITY + CALL HL2FACCU + JP DDIV + + +; Routine at 14605 +; +; Used by the routine at L3878. +L390D: + PUSH BC + PUSH DE + CALL IMULT + LD A,(VALTYP) + CP $02 ; Integer ? + POP DE + POP BC + RET + +; Routine at 14618 +; +; Used by the routine at DEXP. +L391A: + CALL ARG2FACCU + CALL STAKARG + CALL __INT + CALL USTAKARG + CALL XDCOMP + SCF + RET NZ + JP CINT + +; Jump table for statements and functions +; $392E +FNCTAB: + DEFW __END + DEFW __FOR + DEFW __NEXT + DEFW __DATA + DEFW __INPUT + DEFW __DIM + DEFW __READ + DEFW __LET + DEFW __GOTO + DEFW __RUN + DEFW __IF + DEFW __RESTORE + DEFW __GOSUB + DEFW __RETURN + DEFW __REM + DEFW __STOP + DEFW __PRINT + DEFW __CLEAR + DEFW __LIST + DEFW __NEW + DEFW __ON + DEFW __WAIT + DEFW __DEF + DEFW __POKE + DEFW __CONT + DEFW __CSAVE + DEFW __CLOAD + DEFW __OUT + DEFW __LPRINT + DEFW __LLIST + DEFW __CLS + DEFW __WIDTH + DEFW __REM ; ELSE + DEFW __TRON + DEFW __TROFF + DEFW __SWAP + DEFW __ERASE + DEFW __ERROR + DEFW __RESUME + DEFW __DELETE + DEFW __AUTO + DEFW __RENUM + DEFW __DEFSTR + DEFW __DEFINT + DEFW __DEFSNG + DEFW __DEFDBL + DEFW __LINE + DEFW __OPEN + DEFW __FIELD + DEFW __GET + DEFW __PUT + DEFW __CLOSE + DEFW __LOAD + DEFW __MERGE + DEFW __FILES + DEFW __LSET + DEFW __RSET + DEFW __SAVE + DEFW __LFILES + DEFW __CIRCLE + DEFW __COLOR + DEFW __DRAW + DEFW __PAINT + DEFW BEEP + DEFW __PLAY + DEFW __PSET + DEFW __PRESET + DEFW __SOUND + DEFW __SCREEN + DEFW __VPOKE + DEFW __SPRITE + DEFW __VDP + DEFW __BASE + DEFW __CALL + DEFW __TIME + DEFW __KEY + DEFW __MAX + DEFW __MOTOR + DEFW __BLOAD + DEFW __BSAVE + DEFW __DSKO_S + DEFW __SET + DEFW __NAME + DEFW __KILL + DEFW __IPL + DEFW __COPY + DEFW __CMD + DEFW __LOCATE + +FNCTAB_FN: + DEFW __LEFT_S + DEFW __RIGHT_S + DEFW __MID_S + DEFW __SGN + DEFW __INT + DEFW __ABS + DEFW __SQR + DEFW __RND + DEFW __SIN + DEFW __LOG + DEFW __EXP + DEFW __COS + DEFW __TAN + DEFW __ATN + DEFW __FRE + DEFW __INP + DEFW __POS + DEFW __LEN + DEFW __STR_S + DEFW __VAL + DEFW __ASC + DEFW __CHR_S + DEFW __PEEK + DEFW __VPEEK + DEFW __SPACE_S + DEFW __OCT_S + DEFW __HEX_S + DEFW __LPOS + DEFW __BIN_S + DEFW __CINT + DEFW __CSNG + DEFW __CDBL + DEFW __FIX + DEFW __STICK + DEFW __STRIG + DEFW __PDL + DEFW __PAD + DEFW __DSKF + DEFW __FPOS + DEFW __CVI + DEFW __CVS + DEFW __CVD + DEFW __EOF + DEFW __LOC + DEFW __LOF + DEFW __MKI_S + DEFW __MKS_S + DEFW __MKD_S + +FNCTAB_END: + +; Table position: $3A3E +WORD_PTR: + DEFW WORDS_A + DEFW WORDS_B + DEFW WORDS_C + DEFW WORDS_D + DEFW WORDS_E + DEFW WORDS_F + DEFW WORDS_G + DEFW WORDS_H + DEFW WORDS_I + DEFW WORDS_J + DEFW WORDS_K + DEFW WORDS_L + DEFW WORDS_M + DEFW WORDS_N + DEFW WORDS_O + DEFW WORDS_P + DEFW WORDS_Q + DEFW WORDS_R + DEFW WORDS_S + DEFW WORDS_T + DEFW WORDS_U + DEFW WORDS_V + DEFW WORDS_W + DEFW WORDS_X + DEFW WORDS_Y + DEFW WORDS_Z + + +; BASIC keyword and TOKEN codes list +WORDS: + +WORDS_A: + DEFM "UT" + DEFB 'O'+$80 + DEFB TK_AUTO + + DEFM "N" + DEFB 'D'+$80 + DEFB TK_AND + + DEFM "B" + DEFB 'S'+$80 + DEFB TK_ABS + + DEFM "T" + DEFB 'N'+$80 + DEFB TK_ATN + + DEFM "S" + DEFB 'C'+$80 + DEFB TK_ASC + + DEFM "TTR" + DEFB '$'+$80 + DEFB TK_ATTR + + DEFB $00 + + +WORDS_B: + + DEFM "AS" + DEFB 'E'+$80 + DEFB TK_BASE + + DEFM "SAV" + DEFB 'E'+$80 + DEFB TK_BSAVE + + DEFM "LOA" + DEFB 'D'+$80 + DEFB TK_BLOAD + + DEFM "EE" + DEFB 'P'+$80 + DEFB TK_BEEP + + DEFM "IN" + DEFB '$'+$80 + DEFB TK_BIN + + DEFB $00 + + +WORDS_C: + + DEFM "AL" + DEFB 'L'+$80 + DEFB TK_CALL + + DEFM "LOS" + DEFB 'E'+$80 + DEFB TK_CLOSE + + DEFM "OP" + DEFB 'Y'+$80 + DEFB TK_COPY + + DEFM "ON" + DEFB 'T'+$80 + DEFB TK_CONT + + DEFM "LEA" + DEFB 'R'+$80 + DEFB TK_CLEAR + + DEFM "LOA" + DEFB 'D'+$80 + DEFB TK_CLOAD + + DEFM "SAV" + DEFB 'E'+$80 + DEFB TK_CSAVE + + DEFM "SRLI" + DEFB 'N'+$80 + DEFB TK_CSRLIN + + DEFM "IN" + DEFB 'T'+$80 + DEFB TK_CINT + + DEFM "SN" + DEFB 'G'+$80 + DEFB TK_CSGN + + DEFM "DB" + DEFB 'L'+$80 + DEFB TK_CDBL + + DEFM "V" + DEFB 'I'+$80 + DEFB TK_CVI + + DEFM "V" + DEFB 'S'+$80 + DEFB TK_CVS + + DEFM "V" + DEFB 'D'+$80 + DEFB TK_CVD + + DEFM "O" + DEFB 'S'+$80 + DEFB TK_COS + + DEFM "HR" + DEFB '$'+$80 + DEFB TK_CHR_S + + DEFM "IRCL" + DEFB 'E'+$80 + DEFB TK_CIRCLE + + DEFM "OLO" + DEFB 'R'+$80 + DEFB TK_COLOR + + DEFM "L" + DEFB 'S'+$80 + DEFB TK_CLS + + DEFM "M" + DEFB 'D'+$80 + DEFB TK_CMD + + DEFB $00 + + +WORDS_D: + + DEFM "ELET" + DEFB 'E'+$80 + DEFB TK_DELETE + + DEFM "AT" + DEFB 'A'+$80 + DEFB $84 + + DEFM "I" + DEFB 'M'+$80 + DEFB TK_DIM + + DEFM "EFST" + DEFB 'R'+$80 + DEFB TK_DEFSTR + + DEFM "EFIN" + DEFB 'T'+$80 + DEFB TK_DEFINT + + DEFM "EFSN" + DEFB 'G'+$80 + DEFB TK_DEFSGN + + DEFM "EFDB" + DEFB 'L'+$80 + DEFB TK_DEFDBL + + DEFM "SKO" + DEFB '$'+$80 + DEFB TK_DSKO_S + + DEFM "E" + DEFB 'F'+$80 + DEFB TK_DEF + + DEFM "SKI" + DEFB '$'+$80 + DEFB TK_DSKI + + DEFM "SK" + DEFB 'F'+$80 + DEFB TK_DSKF + + DEFM "RA" + DEFB 'W'+$80 + DEFB TK_DRAW + + DEFB $00 + + +WORDS_E: + + DEFM "LS" + DEFB 'E'+$80 + DEFB TK_ELSE + + DEFM "N" + DEFB 'D'+$80 + DEFB $81 + + DEFM "RAS" + DEFB 'E'+$80 + DEFB TK_ERASE + + DEFM "RRO" + DEFB 'R'+$80 + DEFB TK_ERROR + + DEFM "R" + DEFB 'L'+$80 + DEFB TK_ERL + + DEFM "R" + DEFB 'R'+$80 + DEFB TK_ERR + + DEFM "X" + DEFB 'P'+$80 + DEFB TK_EXP + + DEFM "O" + DEFB 'F'+$80 + DEFB TK_EOF + + DEFM "Q" + DEFB 'V'+$80 + DEFB TK_EQV + + DEFB $00 + + +WORDS_F: + + DEFM "O" + DEFB 'R'+$80 + DEFB TK_FOR + + DEFM "IEL" + DEFB 'D'+$80 + DEFB TK_FIELD + + DEFM "ILE" + DEFB 'S'+$80 + DEFB TK_FILES + + DEFB 'N'+$80 + DEFB TK_FN + + DEFM "R" + DEFB 'E'+$80 + DEFB TK_FRE + + DEFM "I" + DEFB 'X'+$80 + DEFB TK_FIX + + DEFM "PO" + DEFB 'S'+$80 + DEFB TK_FPOS + + DEFB $00 + + +WORDS_G: + + DEFM "OT" + DEFB 'O'+$80 + DEFB TK_GOTO + + DEFM "O T" + DEFB 'O'+$80 + DEFB TK_GOTO + + DEFM "OSU" + DEFB 'B'+$80 + DEFB TK_GOSUB + + DEFM "E" + DEFB 'T'+$80 + DEFB TK_GET + + DEFB $00 + + +WORDS_H: + + DEFM "EX" + DEFB '$'+$80 + DEFB TK_HEX_S + + DEFB $00 + + +WORDS_I: + + DEFM "NPU" + DEFB 'T'+$80 + DEFB TK_INPUT + + DEFB 'F'+$80 + DEFB TK_IF + + DEFM "NST" + DEFB 'R'+$80 + DEFB TK_INSTR + + DEFM "N" + DEFB 'T'+$80 + DEFB TK_INT + + DEFM "N" + DEFB 'P'+$80 + DEFB TK_INP + + DEFM "M" + DEFB 'P'+$80 + DEFB TK_IMP + + DEFM "NKEY" + DEFB '$'+$80 + DEFB TK_INKEY_S + + DEFM "P" + DEFB 'L'+$80 + DEFB TK_IPL + + DEFB $00 + + +WORDS_J: + + DEFB $00 + + +WORDS_K: + + DEFM "IL" + DEFB 'L'+$80 + DEFB TK_KILL + + DEFM "E" + DEFB 'Y'+$80 + DEFB TK_KEY + + DEFB $00 + + +WORDS_L: + + DEFM "PRIN" + DEFB 'T'+$80 + DEFB TK_LPRINT + + DEFM "LIS" + DEFB 'T'+$80 + DEFB TK_LLIST + + DEFM "PO" + DEFB 'S'+$80 + DEFB TK_LPOS + + DEFM "E" + DEFB 'T'+$80 + DEFB TK_LET + + DEFM "OCAT" + DEFB 'E'+$80 + DEFB TK_LOCATE + + DEFM "IN" + DEFB 'E'+$80 + DEFB TK_LINE + + DEFM "OA" + DEFB 'D'+$80 + DEFB TK_LOAD + + DEFM "SE" + DEFB 'T'+$80 + DEFB TK_LSET + + DEFM "IS" + DEFB 'T'+$80 + DEFB TK_LIST + + DEFM "FILE" + DEFB 'S'+$80 + DEFB TK_LFILES + + DEFM "O" + DEFB 'G'+$80 + DEFB TK_LOG + + DEFM "O" + DEFB 'C'+$80 + DEFB TK_LOC + + DEFM "E" + DEFB 'N'+$80 + DEFB TK_LEN + + DEFM "EFT" + DEFB '$'+$80 + DEFB TK_LEFT_S + + DEFM "O" + DEFB 'F'+$80 + DEFB TK_LOF + + DEFB $00 + + +WORDS_M: + + DEFM "OTO" + DEFB 'R'+$80 + DEFB TK_MOTOR + + DEFM "ERG" + DEFB 'E'+$80 + DEFB TK_MERGE + + DEFM "O" + DEFB 'D'+$80 + DEFB TK_MOD + + DEFM "KI" + DEFB '$'+$80 + DEFB TK_MKI_S + + DEFM "KS" + DEFB '$'+$80 + DEFB TK_MKS_S + + DEFM "KD" + DEFB '$'+$80 + DEFB TK_MKD_S + + DEFM "ID" + DEFB '$'+$80 + DEFB TK_MID_S + + DEFM "A" + DEFB 'X'+$80 + DEFB TK_MAX + + DEFB $00 + + +WORDS_N: + + DEFM "EX" + DEFB 'T'+$80 + DEFB TK_NEXT + + DEFM "AM" + DEFB 'E'+$80 + DEFB TK_NAME + + DEFM "E" + DEFB 'W'+$80 + DEFB TK_NEW + + DEFM "O" + DEFB 'T'+$80 + DEFB TK_NOT + + DEFB $00 + + +WORDS_O: + + DEFM "PE" + DEFB 'N'+$80 + DEFB TK_OPEN + + DEFM "U" + DEFB 'T'+$80 + DEFB TK_OUT + + DEFB 'N'+$80 + DEFB $95 + + DEFB 'R'+$80 + DEFB TK_OR + + DEFM "CT" + DEFB '$'+$80 + DEFB TK_OCT_S + + DEFM "F" + DEFB 'F'+$80 + DEFB TK_OFF + + DEFB $00 + + +WORDS_P: + + DEFM "RIN" + DEFB 'T'+$80 + DEFB TK_PRINT + + DEFM "U" + DEFB 'T'+$80 + DEFB TK_PUT + + DEFM "OK" + DEFB 'E'+$80 + DEFB TK_POKE + + DEFM "O" + DEFB 'S'+$80 + DEFB TK_POS + + DEFM "EE" + DEFB 'K'+$80 + DEFB TK_PEEK + + DEFM "SE" + DEFB 'T'+$80 + DEFB TK_PSET + + DEFM "RESE" + DEFB 'T'+$80 + DEFB TK_PRESET + + DEFM "OIN" + DEFB 'T'+$80 + DEFB TK_POINT + + DEFM "AIN" + DEFB 'T'+$80 + DEFB TK_PAINT + + DEFM "D" + DEFB 'L'+$80 + DEFB TK_PDL + + DEFM "A" + DEFB 'D'+$80 + DEFB TK_PAD + + DEFM "LA" + DEFB 'Y'+$80 + DEFB TK_PLAY + + DEFB $00 + + +WORDS_Q: + + DEFB $00 + + +WORDS_R: + + DEFM "ETUR" + DEFB 'N'+$80 + DEFB TK_RETURN + + DEFM "EA" + DEFB 'D'+$80 + DEFB TK_READ + + DEFM "U" + DEFB 'N'+$80 + DEFB TK_RUN + + DEFM "ESTOR" + DEFB 'E'+$80 + DEFB TK_RESTORE + + DEFM "E" + DEFB 'M'+$80 + DEFB TK_REM + + DEFM "ESUM" + DEFB 'E'+$80 + DEFB TK_RESUME + + DEFM "SE" + DEFB 'T'+$80 + DEFB TK_RSET + + DEFM "IGHT" + DEFB '$'+$80 + DEFB TK_RIGHT_S + + DEFM "N" + DEFB 'D'+$80 + DEFB TK_RND + + DEFM "ENU" + DEFB 'M'+$80 + DEFB TK_RENUM + + DEFB $00 + + +WORDS_S: + + DEFM "CREE" + DEFB 'N'+$80 + DEFB TK_SCREEN + + DEFM "PRIT" + DEFB 'E'+$80 + DEFB TK_SPRITE + + DEFM "TO" + DEFB 'P'+$80 + DEFB TK_STOP + + DEFM "WA" + DEFB 'P'+$80 + DEFB TK_SWAP + + DEFM "E" + DEFB 'T'+$80 + DEFB TK_SET + + DEFM "AV" + DEFB 'E'+$80 + DEFB TK_SAVE + + DEFM "PC" + DEFB '('+$80 + DEFB TK_SPC + + DEFM "TE" + DEFB 'P'+$80 + DEFB TK_STEP + + DEFM "G" + DEFB 'N'+$80 + DEFB TK_SGN + + DEFM "Q" + DEFB 'R'+$80 + DEFB TK_SQR + + DEFM "I" + DEFB 'N'+$80 + DEFB TK_SIN + + DEFM "TR" + DEFB '$'+$80 + DEFB TK_STR_S + + DEFM "TRING" + DEFB '$'+$80 + DEFB TK_STRING + + DEFM "PACE" + DEFB '$'+$80 + DEFB TK_SPACE_S + + DEFM "OUN" + DEFB 'D'+$80 + DEFB TK_SOUND + + DEFM "TIC" + DEFB 'K'+$80 + DEFB TK_STICK + + DEFM "TRI" + DEFB 'G'+$80 + DEFB TK_TRIG + + DEFB $00 + + +WORDS_T: + + DEFM "HE" + DEFB 'N'+$80 + DEFB TK_THEN + + DEFM "RO" + DEFB 'N'+$80 + DEFB TK_TRON + + DEFM "ROF" + DEFB 'F'+$80 + DEFB TK_TROFF + + DEFM "AB" + DEFB '('+$80 + DEFB TK_TAB + + DEFB 'O'+$80 + DEFB TK_TO + + DEFM "IM" + DEFB 'E'+$80 + DEFB TK_TIME + + DEFM "A" + DEFB 'N'+$80 + DEFB TK_TAN + + DEFB $00 + + +WORDS_U: + + DEFM "SIN" + DEFB 'G'+$80 + DEFB TK_USING + + DEFM "S" + DEFB 'R'+$80 + DEFB TK_USR + + DEFB $00 + + +WORDS_V: + + DEFM "A" + DEFB 'L'+$80 + DEFB TK_VAL + + DEFM "ARPT" + DEFB 'R'+$80 + DEFB TK_VARPTR + + DEFM "D" + DEFB 'P'+$80 + DEFB TK_VDP + + DEFM "POK" + DEFB 'E'+$80 + DEFB TK_VPOKE + + DEFM "PEE" + DEFB 'K'+$80 + DEFB TK_VPEEK + + DEFB $00 + + +WORDS_W: + + DEFM "IDT" + DEFB 'H'+$80 + DEFB TK_WIDTH + + DEFM "AI" + DEFB 'T'+$80 + DEFB TK_WAIT + + DEFB $00 + + +WORDS_X: + + DEFM "O" + DEFB 'R'+$80 + DEFB TK_XOR + + DEFB $00 + + +WORDS_Y: + + DEFB $00 + + +WORDS_Z: + + DEFB $00 + + + +OPR_TOKENS: + DEFB $AB + DEFB TK_PLUS ; Token for '+' + DEFB $AD + DEFB TK_MINUS ; Token for '-' + DEFB $AA + DEFB TK_STAR ; Token for '*' + DEFB $AF + DEFB TK_SLASH ; Token for '/' + DEFB $DE + DEFB TK_EXPONENT ; Token for '^' + DEFB $DC + DEFB TK_BKSLASH ; Token for '\' + DEFB $A7 + DEFB TK_APOSTROPHE ; Token for ''' + DEFB $BE + DEFB TK_GREATER ; Token for '>' + DEFB $BD + DEFB TK_EQUAL ; Token for '=' + DEFB $BC + DEFB TK_MINOR ; Token for '<' + DEFB $00 + + + +; ARITHMETIC PRECEDENCE TABLE +PRITAB: + DEFB $79 ; + (Token code $F1) + DEFB $79 ; - + DEFB $7c ; * + DEFB $7c ; / + DEFB $7f ; ^ + DEFB $50 ; AND + DEFB $46 ; OR + DEFB $3c ; XOR + DEFB $32 ; EQU + DEFB $28 ; IMP + DEFB $7a ; MOD + DEFB $7b ; \ (Token code $FC) + + +; USED BY ASSIGNMENT CODE TO FORCE THE RIGHT HAND VALUE TO CORRESPOND +; TO THE VALUE TYPE OF THE VARIABLE BEING ASSIGNED TO. + +; NUMBER TYPES +TYPE_OPR: + DEFW __CDBL + DEFW 0 + DEFW __CINT + DEFW TSTSTR + DEFW __CSNG + + +; +; THESE TABLES ARE USED AFTER THE DECISION HAS BEEN MADE +; TO APPLY AN OPERATOR AND ALL THE NECESSARY CONVERSION HAS +; BEEN DONE TO MATCH THE TWO ARGUMENT TYPES (APPLOP) +; + +; ARITHMETIC OPERATIONS TABLE +DEC_OPR: + DEFW DADD + DEFW DSUB + DEFW DMUL + DEFW DDIV + DEFW DEXP + DEFW DCOMP + +defc OPCNT = ((FLT_OPR-DEC_OPR)/2)-1 + +; Message at 15709 +FLT_OPR: + DEFW FADD + DEFW FSUB + DEFW FMULT + DEFW FDIV + DEFW FEXP + DEFW FCOMP + +INT_OPR: + DEFW IADD + DEFW ISUB + DEFW IMULT + DEFW IDIV + DEFW INTEXP + DEFW ICOMP + +; Message at 15734 +ERROR_MESSAGES: + DEFB $00 + ; Err $01 + DEFM "NEXT without FOR" + DEFB $00 + ; Err $02 + DEFM "Syntax error" + DEFB $00 + ; Err $03 + DEFM "RETURN without GOSUB" + DEFB $00 + ; Err $04 + DEFM "Out of DATA" + DEFB $00 + ; Err $05 + DEFM "Illegal function call" + DEFB $00 + ; Err $06 + DEFM "Overflow" + DEFB $00 + ; Err $07 + DEFM "Out of memory" + DEFB $00 + ; Err $08 + DEFM "Undefined line number" + DEFB $00 + ; Err $09 + DEFM "Subscript out of range" + DEFB $00 + ; Err $0A + DEFM "Redimensioned array" + DEFB $00 + ; Err $0B + DEFM "Division by zero" + DEFB $00 + ; Err $0C + DEFM "Illegal direct" + DEFB $00 + ; Err $0D + DEFM "Type mismatch" + DEFB $00 + ; Err $0E + DEFM "Out of string space" + DEFB $00 + ; Err $0F + DEFM "String too long" + DEFB $00 + ; Err $10 + DEFM "String formula too complex" + DEFB $00 + ; Err $11 + DEFM "Can't CONTINUE" + DEFB $00 + ; Err $12 + DEFM "Undefined user function" + DEFB $00 + ; Err $13 + DEFM "Device I/O error" + DEFB $00 + ; Err $14 + DEFM "Verify error" + DEFB $00 + ; Err $15 + DEFM "No RESUME" + DEFB $00 + ; Err $16 + DEFM "RESUME without error" + DEFB $00 + ; Err $17 (but also $00) + DEFM "Unprintable error" + DEFB $00 + ; Err $18 + DEFM "Missing operand" + DEFB $00 + ; Err $19 + DEFM "Line buffer overflow" + DEFB $00 + + ; Err $32 + DEFM "FIELD overflow" + DEFB $00 + ; Err $33 + DEFM "Internal error" + DEFB $00 + ; Err $34 + DEFM "Bad file number" + DEFB $00 + ; Err $35 + DEFM "File not found" + DEFB $00 + ; Err $36 + DEFM "File already open" + DEFB $00 + ; Err $37 + DEFM "Input past end" + DEFB $00 + ; Err $38 + DEFM "Bad file name" + DEFB $00 + ; Err $39 + DEFM "Direct statement in file" + DEFB $00 + ; Err $3A + DEFM "Sequential I/O only" + DEFB $00 + ; Err $3B + DEFM "File not OPEN" + DEFB $00 + +IN_MSG: + DEFM " in " + +NULL_STRING: + DEFB $00 + +OK_MSG: + DEFM "Ok" + DEFB CR + DEFB LF + DEFB $00 + +BREAK_MSG: + DEFM "Break" + DEFB $00 + +; Data block at 16353 + ; --- START PROC BAKSTK --- +; Search FOR or GOSUB block on stack (skip 2 words) +; Used by 'RETURN' and 'NEXT' +BAKSTK: + LD HL,$0004 ; IGNORING EVERYONES "NEWSTT" AND THE RETURN.. + ADD HL,SP ; ..ADDRESS OF THIS SUBROUTINE + +; Look for "FOR" block with same index as specified in D +; a.k.a. FNDFOR +; +LOKFOR: + LD A,(HL) ; Get block ID + INC HL ; Point to index address + CP TK_FOR ; Is it a "FOR" token ;IS THIS STACK ENTRY A "FOR"? + RET NZ ; No - exit ;NO SO OK + LD C,(HL) ; BC = Address of "FOR" index + INC HL ;DO EQUIVALENT OF PUSHM / XTHL + LD B,(HL) + INC HL ; Point to sign of STEP + PUSH HL ; Save pointer to sign ;PUT H ON + LD H,B ; HL = address of "FOR" index ;PUSH B / XTHL IS SLOWER + LD L,C + LD A,D ; See if an index was specified ;FOR THE "NEXT" STATMENT WITHOUT AN ARGUMENT + OR E ; DE = 0 if no index specified ;WE MATCH ON ANYTHING + EX DE,HL ; Specified index into HL ;MAKE SURE WE RETURN [D,E] + JR Z,INDFND ; Skip if no index given ;POINTING TO THE VARIABLE + EX DE,HL ; Index back into DE + RST DCOMPR ; Compare index with one given + +INDFND: + LD BC,22 ; Offset to next block ;TO WIPE OUT A "FOR" ENTRY + POP HL ; Restore pointer to sign + RET Z ; Return if block found, WITH [H,L] POINTING THE BOTTOM OF THE ENTRY + ADD HL,BC ; Point to next block + JR LOKFOR ; Keep on looking + +; +; THE FOLLOWING FUNCTIONS ALLOW THE +; USER FULL ACCESS TO THE ALTAIR I/O PORTS +; INP(CHANNEL#) RETURNS AN INTEGER WHICH IS THE STATUS +; OF THE CHANNEL. OUT CHANNEL#,VALUE PUTS OUT THE INTEGER +; VALUE ON CHANNEL #. IT IS A STATEMENT, NOT A FUNCTION. +; +__INP: + CALL GETWORD_HL ;GET INTEGER CHANNEL # + LD B,H + LD C,L +__INP_0: + IN A,(C) + JP PASSA + +; Routine at 16395 +; +; Used by the routines at __OUT and __WAIT. +; Get "WORD,BYTE" parameters +SETIO: + CALL GETWORD ; GET INTEGER CHANNEL NUMBER + PUSH DE ; Save channel # on stack + RST SYNCHR + DEFB ',' ;MAKE SURE THERE IS A COMMA + CALL GETINT ; Get integer 0-255 + POP BC ; BC = channel # + RET + +; Routine at 16406 +__OUT: + CALL SETIO ; Get "WORD,BYTE" parameters + OUT (C),A + RET + +; Routine at 16412 +__WAIT: + CALL SETIO ; Get "WORD,BYTE" parameters + PUSH BC + PUSH AF ;SAVE THE MASK + LD E,$00 ;DEFAULT MASK2 TO ZERO + DEC HL + RST CHRGTB ;SEE IF THE STATEMENT ENDED + JR Z,__WAIT_0 ;IF NO THIRD ARGUMENT SKIP THIS + RST SYNCHR + DEFB ',' ;MAKE SURE THERE IS A "," + CALL GETINT ; Get integer 0-255 +__WAIT_0: + POP AF ;REGET THE "AND" MASK + LD D,A + POP BC +__WAIT_1: + CALL CKCNTC + IN A,(C) + XOR E ;XOR WITH MASK2 + AND D ;AND WITH MASK + JR Z,__WAIT_1 ;LOOP UNTIL RESULT IS NON-ZERO + RET + +; Routine at 16441 +PRG_END: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HPRGE ; Hook for Program End event +ENDIF + LD HL,(CURLIN) ;GET CURRENT LINE # + LD A,H ;SEE IF in 'DIRECT' (immediate) mode + AND L ;AND TOGETHER + INC A ;SET CC'S + JR Z,PRG_END_0 ;IF DIRECT DONE, ALLOW FOR DEBUGGING PURPOSES + LD A,(ONEFLG) ;SEE IF IN ON ERROR + OR A ;SET CC + LD E,$15 ;"NO RESUME" ERROR (Err $15) + JR NZ,ERROR ;YES, FORGOT RESUME +PRG_END_0: + JP ENDCON ;NO, LET IT END + +; Routine at 16463 +; +; Used by the routine at L4B4A. +DATSNR: + LD HL,(DATLIN) + LD (CURLIN),HL + +; entry for '?SN ERROR' +; +; Used by the routines at LNUM_RANGE, RUNLIN, __AUTO, EVAL, OCTCNS, NOT_KEYWORD, __RENUM_0, +; __SYNCHR, __CALL, GETVAR, __CLEAR, __OPEN, __PLAY_2, L77FE and __MAX. +SN_ERR: + LD E,$02 ; DERSN - "Syntax error" + + DEFB $01 ; "LD BC,nn" to jump over the next word without executing it +; a.k.a. OERR, DZERR +O_ERR: + LD E,$0B ; DERDV0 - "Division by zero" + + DEFB $01 ; "LD BC,nn" to jump over the next word without executing it +NF_ERR: + LD E,$01 ; DERNF - "NEXT without FOR" + + DEFB $01 ; "LD BC,nn" to jump over the next word without executing it +DD_ERR: + LD E,$0A ; "Redimensioned array" + + DEFB $01 ; "LD BC,nn" to jump over the next word without executing it +UFN_ERR: + LD E,$12 ; DERUF - "Undefined user function" + + DEFB $01 ; "LD BC,nn" to jump over the next word without executing it +RW_ERR: + LD E,$16 ; DERRE - "RESUME without error" + + DEFB $01 ; "LD BC,nn" to jump over the next word without executing it +OV_ERR: + LD E,$06 ; DEROV - "Overflow" + + DEFB $01 ; "LD BC,nn" to jump over the next word without executing it +MO_ERR: + LD E,$18 ; DERMO - "Missing operand" + + DEFB $01 ; "LD BC,nn" to jump over the next word without executing it +TM_ERR: + LD E,$0D ; DERTM - "Type mismatch" + +; This entry point is used by the routines at PRG_END, TOKENIZE_COLON, FC_ERR, UL_ERR, +; __ERROR, FDTLP, IDTEST, CHKSTK, __CONT, TSTOPL, TESTR, CONCAT, NM_ERR, __CLOAD and IO_ERR. +ERROR: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HERRO ; Hook for Error handler +ENDIF + XOR A + LD (NLONLY),A + LD HL,(VLZADR) + LD A,H + OR L + JR Z,ERROR_1 + LD A,(VLZDAT) + LD (HL),A + LD HL,$0000 + LD (VLZADR),HL +ERROR_1: + EI + LD HL,(CURLIN) ; Line number the Basic interpreter is working on, in direct mode it will be filled with #FFFF + LD (ERRLIN),HL + LD A,H + AND L + INC A + JR Z,ERRESM ; JR if in 'DIRECT' (immediate) mode + LD (DOT),HL + +; This entry point is also used by the routine at ON_ERROR. +ERRESM: ;(4096h) + LD BC,ERRMOR + JR ERESET + + +; Routine at 16539 ($409B) +; +; address of "warm boot" BASIC interpreter + +; THIS ROUTINE IS CALLED TO RESET THE STACK IF BASIC IS +; EXTERNALLY STOPPED AND THEN RESTARTED. + +READYR: + LD BC,RESTART ; 01 1E 41 + +; Routine at $409D +; This entry point is used by ERROR and BASIC_MAIN routines. +ERESET: + LD HL,(SAVSTK) ;GET A GOOD STACK BACK + JP STKERR ;JUMP INTO STKINI + +; Routine at 16404 +ERRMOR: + POP BC ;POP OFF FNDFOR STOPPER + LD A,E ;[A]=ERROR NUMBER + LD C,E ;ALSO SAVE IT FOR LATER RESTORE + LD (ERRFLG),A ;SAVE IT SO WE KNOW WHETHER TO CALL "EDIT" + LD HL,(SAVTXT) ;GET SAVED TEXT POINTER + LD (ERRTXT),HL ;SAVE FOR RESUME. + EX DE,HL ;SAVE SAVTXT PTR + LD HL,(ERRLIN) ;GET ERROR LINE # + LD A,H ;TEST IF DIRECT LINE + AND L ;SET CC'S + INC A ;SETS ZERO IF DIRECT LINE (65535) + JR Z,NTMDCN ;IF DIRECT, DONT MODIFY OLDTXT & OLDLIN + LD (OLDLIN),HL ;SET OLDLIN=ERRLIN. + EX DE,HL ;GET BACK SAVTXT + LD (OLDTXT),HL ;SAVE IN OLDTXT. +NTMDCN: + LD HL,(ONELIN) + LD A,H + OR L + EX DE,HL + LD HL,ONEFLG ; =1 if executing an error trap routine + JR Z,ERROR_REPORT + AND(HL) + JR NZ,ERROR_REPORT + ; We get here if the standard error handling is temporairly disabled (error trap). + DEC(HL) + EX DE,HL + JP GONE4 + +; Interactive error handling (print error message and break) +; a.k.a. NOTRAP +ERROR_REPORT: + XOR A + LD (HL),A + LD E,C + CALL CONSOLE_CRLF + LD HL,ERROR_MESSAGES +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HERRP ; Hook 1 for Error Handler +ENDIF + LD A,E + CP $3C + JR NC,UE_ERR ; JP if error code is bigger than $3B + CP $32 + JR NC,NTDER2 ; JP if error code is between $32 and $3B + CP $1A + JR C,LEPSKP ; JP if error code is < $1A + +; a.k.a. UPERR +UE_ERR: + LD A,$2F ; if error code is bigger than $3B then force it to $2f-$18=$17 ("Unprintable error") + +; JP here if error code is between $32 and $3B, sub $18 +NTDER2: + SUB $18 ; (DSKERR-NONDSK): FIX OFFSET INTO TABLE OF MESSAGES + LD E,A ;SAVE BACK ERROR CODE +LEPSKP: + CALL __REM ; 'Move to next line' (used by ELSE, REM..) + INC HL + DEC E + JR NZ,LEPSKP + PUSH HL + LD HL,(ERRLIN) + EX (SP),HL + ; --- START PROC _ERROR_REPORT --- +_ERROR_REPORT: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HERRF ; Hook 2 for Error Handler +ENDIF + PUSH HL + CALL TOTEXT + POP HL + LD A,(HL) ;GET 1ST CHAR OF ERROR + CP $3F ;PADDED ERROR? + JR NZ,_LEPSKP ;NO,PRINT + POP HL ;GET LINE # OFF STACK + LD HL,ERROR_MESSAGES + JR UE_ERR + +_LEPSKP: + LD A,BEL + RST OUTDO ; Output char to the current device + CALL PRS ;PRINT MESSAGE + POP HL ;RESTORE LINE NUMBER + LD A,H ;SEE IF IN DIRECT MODE + AND L + INC A ;ZERO SAYS DIRECT MODE + CALL NZ,IN_PRT ;PRINT LINE NUMBER IN [H,L] + DEFB $3E ; "LD A,n" to Mask the next byte + +RESTART: + POP BC + + ; --- START PROC READY --- +READY: + CALL TOTEXT ; Go back in text mode if in graphics mode (e.g. if BREAK was pressed) + CALL FINLPT + CALL CLOSE_STREAM +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HREAD ; Hook 1 for Mainloop ("OK") +ENDIF + CALL CONSOLE_CRLF + LD HL,OK_MSG ; "Ok" Message + CALL PRS + ; --- START PROC L4134 --- +PROMPT: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HMAIN ; Hook 2 for Mainloop +ENDIF + LD HL,$FFFF + LD (CURLIN),HL ; Set interpreter in 'DIRECT' (immediate) mode + LD HL,ENDPRG + LD (SAVTXT),HL + LD A,(AUTFLG) ; AUTO mode ? + OR A + JR Z,PROMPT_1 ;YES + LD HL,(AUTLIN) + PUSH HL + CALL LINPRT + POP DE + PUSH DE + CALL SRCHLN ; Get first line number + LD A,'*' ;CHAR TO PRINT IF LINE ALREADY EXISTS + JR C,PROMPT_0 + LD A,' ' +PROMPT_0: + RST OUTDO ; Output char to the current device + LD (AUTFLG),A ; AUTO mode +PROMPT_1: + CALL ISFLIO ; Tests if I/O to device is taking place + JR NZ,INI_STREAM + CALL PINLIN + JR NC,INI_LIN + XOR A + LD (AUTFLG),A ; Enable AUTO mode + JP PROMPT + +; Accepts a line from a stream +INI_STREAM: + CALL PINSTREAM + ; --- START PROC INI_LIN --- +INI_LIN: + RST CHRGTB ; Get first character GET THE FIRST + INC A ; Test if end of line SEE IF 0 SAVING THE CARRY FLAG + DEC A ; Without affecting Carry + JR Z,PROMPT ; Nothing entered - Get another IF SO, A BLANK LINE WAS INPUT + PUSH AF ; Save Carry status SAVE STATUS INDICATOR FOR 1ST CHARACTER + CALL ATOH ; Get line number into DE READ IN A LINE # specified line number + JR NC,BAKSP_0 ; BACK UP THE POINTER + CALL ISFLIO ; Tests if I/O to device is taking place + JP Z,SN_ERR ; ?SN Err + + +BAKSP_0: + CALL BAKSP + LD A,(AUTFLG) ; AUTO mode ? + OR A + JR Z,L4195 ; YES + CP '*' + JR NZ,L4195 + CP (HL) + JR NZ,L4195 + INC HL +L4195: + LD A,D + OR E + JR Z,EDENT + LD A,(HL) + CP ' ' + JR NZ,EDENT + INC HL +EDENT: + PUSH DE ;SAVE LINE # + CALL TOKENIZE ;CRUNCH THE LINE DOWN ; (CRUNCH) + POP DE ;RESTORE LINE # + POP AF ;WAS THERE A LINE #? + LD (SAVTXT),HL ;FOR RESUMING A DIRECT STMT +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HDIRD ; Hook 3 for Mainloop (direct statement) +ENDIF + JR C,L41B4 + XOR A + LD (AUTFLG),A ; Enable AUTO mode + JP EXEC_FILE + +L41B4: + PUSH DE + PUSH BC ;SAVE LINE # AND CHARACTER COUNT + RST CHRGTB ;REMEMBER IF THIS LINE IS + OR A ;SET THE ZERO FLAG ON ZERO LINES THAT START WITH ":" SHOULD NOT BE IGNORED + PUSH AF + LD A,(AUTFLG) ;IN AN AUTO COMMAND? + AND A ;SET CC'S + JR Z,AUTGOD ;Yes + POP AF + SCF + PUSH AF + +AUTGOD: + LD (DOT),DE ;SAVE THIS LINE # IN DOT (Current line for edit & list) + LD HL,(AUTINC) ;GET INCREMENT + ADD HL,DE ;ADD INCREMENT TO THIS LINE + JR C,AUTRES ;CHECK FOR PATHETIC CASE + PUSH DE ;SAVE LINE NUMBER # + LD DE,$FFFA ;CHECK FOR LINE # TOO BIG + RST DCOMPR + POP DE ;GET BACK LINE # + ; --- START PROC L41D2 --- +L41D2: + LD (AUTLIN),HL ;SAVE IN NEXT LINE + JR C,AUTSTR ;JP if not too big + + +AUTRES: + XOR A + LD (AUTFLG),A ;Enable 'AUTO' mode + +AUTSTR: ;And enter line + CALL SRCHLN ; Search for line number in DE: GET A POINTER TO THE LINE + JR C,LINFND ; Jump if line found: LINE EXISTS, DELETE IT + POP AF ;GET FLAG SAYS WHETHER LINE BLANK + PUSH AF ;SAVE BACK + JR NZ,L41EA + JP NC,UL_ERR ; TRYING TO DELETE NON-EXISTANT LINE, Err $08 - "Undefined line number" + ; --- START PROC L41E7 --- +L41E7: + PUSH BC + JR FINI + + ; --- START PROC L41EA --- +L41EA: + OR A ;CLEAR FLAG THAT SAYS LINE EXISTS + JR LINFND_1 + + ; --- START PROC LINFND --- +LINFND: + POP AF + PUSH AF + JR NZ,LINFND_0 + JR C,L41E7 +LINFND_0: + SCF ;SET FLAG THAT SAYS LINE EXISTS + ; --- START PROC LINFND_1 --- +LINFND_1: + PUSH BC ; Save address of line in prog + PUSH AF ;SAVE REGISTERS + PUSH HL ;SAVE [H,L] + CALL DEPTR ;GET RID OF PTRS IN PGM + POP HL ;GET BACK POINTER TO NEXT LINE + POP AF ;GET BACK PSW + POP BC ;RESTORE POINTER TO THIS LINE + PUSH BC ;SAVE BACK AGAIN + CALL C,__DELETE_0 ;DELETE THE LINE + POP DE ;POP POINTER AT PLACE TO INSERT + POP AF ;SEE IF THIS LINE HAD ANYTHING ON IT + PUSH DE ;SAVE PLACE TO START FIXING LINKS + JR Z,FINI ;IF NOT DON'T INSERT + POP DE ;GET RID OF START OF LINK FIX + LD HL,$0000 + LD (ONELIN),HL ; LINE to go when error + LD HL,(VARTAB) ; Get end of program CURRENT END + EX (SP),HL ; Get length of input line [H,L]=CHARACTER COUNT. VARTAB ONTO THE STACK + POP BC ; End of program to BC [B,C]=OLD VARTAB + PUSH HL ;SAVE COUNT OF CHARS TO MOVE + ADD HL,BC ; Find new end + PUSH HL ; Save new end SAVE NEW VARTAB + CALL MOVUP ; Make space for line + POP HL ; Restore new end POP OFF VARTAB + LD (VARTAB),HL ; Update end of program pointer + EX DE,HL ; Get line to move up in HL + LD (HL),H ; Save MSB FOOL CHEAD WITH NON-ZERO LINK + POP BC ; RESTORE COUNT OF CHARS TO MOVE + POP DE ; Get new line number GET LINE # OFF STACK + PUSH HL ; SAVE START OF PLACE TO FIX LINKS SO IT DOESN'T THINK + INC HL ; THIS LINK IS THE END OF THE PROGRAM + INC HL + LD (HL),E ; Save LSB of line number PUT DOWN LINE # + INC HL + LD (HL),D ; Save MSB of line number + INC HL ; To first byte in line + LD DE,KBUF ; Copy buffer to program ;MOVE LINE FRM KBUF TO PROGRAM AREA + DEC BC ;FIX UP COUNT OF CHARS TO MOVE + DEC BC ;(DONT INCLUDE LINE # & LINK) + DEC BC + DEC BC + +; NOW TRANSFERING LINE IN FROM BUF +MOVBUF: + LD A,(DE) ; Get source + LD (HL),A ; Save destinations + INC HL ; Next source + INC DE ; Next destination + DEC BC + LD A,C + OR B ; Done? + JR NZ,MOVBUF ; No - Repeat + + ; --- START PROC FINI --- +FINI: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HFINI ; Hook 1 for Mainloop finished +ENDIF + POP DE ;GET START OF LINK FIXING AREA + CALL CHEAD ;FIX LINKS + LD HL,(PTRFIL) ; Points to file data of currently accessing file + LD (NXTOPR),HL ; Save I/O pointer before a possible file redirection (RUN "program") + CALL RUN_FST ;DO CLEAR & SET UP STACK +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HFINE ; Hook 2 for Mainloop finished +ENDIF + LD HL,(NXTOPR) ; Restore I/O pointer + LD (PTRFIL),HL + JP PROMPT + + ; --- START PROC LINKER --- + +; Routine at 16979 +; +; Used by the routine at CHKSTK. +LINKER: + LD HL,(TXTTAB) + EX DE,HL +; +; CHEAD GOES THROUGH PROGRAM STORAGE AND FIXES +; UP ALL THE LINKS. THE END OF EACH +; LINE IS FOUND BY SEARCHING FOR THE ZERO AT THE END. +; THE DOUBLE ZERO LINK IS USED TO DETECT THE END OF THE PROGRAM +; +CHEAD: + LD H,D ;[H,L]=[D,E] + LD L,E + LD A,(HL) ;SEE IF END OF CHAIN + INC HL ;BUMP POINTER + OR (HL) ;2ND BYTE + RET Z + INC HL ;FIX H TO START OF TEXT + INC HL +CZLOOP: + INC HL ;BUMP POINTER + LD A,(HL) ;GET BYTE +CZLOO2: + OR A ;SET CC'S + JR Z,CZLIN ;END OF LINE, DONE. + CP ' ' ;EMBEDDED CONSTANT? + JR NC,CZLOOP ;NO, GET NEXT + CP $0A+1 ;IS IT LINEFEED OR BELOW? + JR C,CZLOOP ;THEN SKIP PAST + CALL __CHRCKB ;GET CONSTANT + RST CHRGTB ;GET OVER IT + JR CZLOO2 ;GO BACK FOR MORE + +CZLIN: + INC HL ;MAKE [H,L] POINT AFTER TEXT + EX DE,HL ;SWITCH TEMP + LD (HL),E ;DO FIRST BYTE OF FIXUP + INC HL ;ADVANCE POINTER + LD (HL),D ;2ND BYTE OF FIXUP + JR CHEAD ;KEEP CHAINING TIL DONE + +; Line number range +; +; SCNLIN SCANS A LINE RANGE OF +; THE FORM #-# OR # OR #- OR -# OR BLANK +; AND THEN FINDS THE FIRST LINE IN THE RANGE +; +; Routine at 17017 +; Used by the routines at __LLIST and __DELETE. +LNUM_RANGE: + LD DE,$0000 ;ASSUME START LIST AT ZERO + PUSH DE ;SAVE INITIAL ASSUMPTION + JR Z,ALL_LIST ;IF FINISHED, LIST IT ALL + POP DE ;WE ARE GOING TO GRAB A # + CALL LNUM_PARM ;GET A LINE #. IF NONE, RETURNS ZERO + PUSH DE ;SAVE FIRST + JR Z,SNGLIN ;IF ONLY # THEN DONE. + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB TK_MINUS ;MUST BE A DASH. +ALL_LIST: + LD DE,65530 ;ASSUME MAX END OF RANGE + CALL NZ,LNUM_PARM ;GET THE END OF RANGE + JP NZ,SN_ERR ;MUST BE TERMINATOR +SNGLIN: + EX DE,HL ;[H,L] = FINAL + POP DE ;GET INITIAL IN [D,E] + +FNDLN1: + EX (SP),HL ;PUT MAX ON STACK, RETURN ADDR TO [H,L] + PUSH HL ;SAVE RETURN ADDRESS BACK + + +; +; FNDLIN SEARCHES THE PROGRAM TEXT FOR THE LINE +; WHOSE LINE # IS PASSED IN [D,E]. [D,E] IS PRESERVED. +; THERE ARE THREE POSSIBLE RETURNS: +; +; 1) ZERO FLAG SET. CARRY NOT SET. LINE NOT FOUND. +; NO LINE IN PROGRAM GREATER THAN ONE SOUGHT. +; [B,C] POINTS TO TWO ZERO BYTES AT END OF PROGRAM. +; [H,L]=[B,C] +; +; 2) ZERO, CARRY SET. +; [B,C] POINTS TO THE LINK FIELD IN THE LINE +; WHICH IS THE LINE SEARCHED FOR. +; [H,L] POINTS TO THE LINK FIELD IN THE NEXT LINE. +; +; 3) NON-ZERO, CARRY NOT SET. +; LINE NOT FOUND, [B,C] POINTS TO LINE IN PROGRAM +; GREATER THAN ONE SEARCHED FOR. +; [H,L] POINTS TO THE LINK FIELD IN THE NEXT LINE. +; +; +; (Find line # in DE, BC=line addr, HL=next line addr) +; +; This entry point is used by the routines at GOTO, __DELETE, __RENUM_0, LINE2PTR and +; __RESTORE. +; Get first line number +SRCHLN: + LD HL,(TXTTAB) ; Start of program text + +; This entry point is used by the routine at RUNLIN. +SRCHLP: + LD B,H ; BC = Address to look at IF EXITING BECAUSE OF END OF PROGRAM, + LD C,L ; SET [B,C] TO POINT TO DOUBLE ZEROES. + LD A,(HL) ; Get address of next line + INC HL + OR (HL) ; End of program found? + DEC HL ;GO BACK + RET Z ; Yes - Line not found + INC HL ;SKIP PAST AND GET THE LINE # + INC HL + LD A,(HL) ; Get LSB of line number INTO [H,L] FOR COMPARISON WITH + INC HL ; THE LINE # BEING SEARCHED FOR + LD H,(HL) ; Get MSB of line number WHICH IS IN [D,E] + LD L,A + RST DCOMPR ; Compare with line in DE SEE IF IT MATCHES OR IF WE'VE GONE TOO FAR + LD H,B ; HL = Start of this line MAKE [H,L] POINT TO THE START OF THE + LD L,C ; LINE BEYOND THIS ONE, BY PICKING + LD A,(HL) ; Get LSB of next line address UP THE LINK THAT [B,C] POINTS AT + 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 NO MATCH RETURN (GREATER) + JR SRCHLP ; Keep looking + + +; TOKENIZE (CRUNCH) +; ALL "RESERVED" WORDS ARE TRANSLATED INTO SINGLE ONE OR TWO +; (IF TWO, FIRST IS ALWAYS $FF, 377 OCTAL) BYTES WITH THE MSB ON. +; THIS SAVES SPACE AND TIME BY ALLOWING FOR TABLE DISPATCH DURING EXECUTION. +; THEREFORE ALL STATEMENTS APPEAR TOGETHER IN THE RESERVED WORD LIST +; IN THE SAME ORDER THEY APPEAR IN IN STMDSP. +; +; NUMERIC CONSTANTS ARE ALSO CONVERTED TO THEIR INTERNAL +; BINARY REPRESENTATION TO IMPROVE EXECUTION SPEED +; LINE NUMBERS ARE ALSO PRECEEDED BY A SPECIAL TOKEN SO THAT +; LINE NUMBERS CAN BE CONVERTED TO POINTERS AT EXECUTION TIME. +; +; Routine at 17074 +TOKENIZE: + XOR A ; SAY EXPECTING FLOATING NUMBERS + LD (DONUM),A ; SET FLAG ACORDINGLY + LD (DORES),A ; ALLOW CRUNCHING +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HCRUN ; Hook 1 for Tokenise +ENDIF + LD BC,BUF-BUFFER-5 ; BUF-BUFFER-5 = 315 bytes + LD DE,KBUF ; SETUP DESTINATION POINTER + +; This entry point is used by the routine at TSTNUM. +NXTCHR: ; (=KLOOP) + LD A,(HL) ; Get byte + OR A ; End of line ? + JR NZ,CRNCLP ; No, continue + + +; This entry point is used by the routine at TOKEN_BUILT. +CRDONE: ; Yes - Terminate buffer + LD HL,BUF-BUFFER ; GET OFFSET: BUF-BUFFER = KBFLEN+2 = 320 bytes + LD A,L ;GET COUNT TO SUBTRACT FROM + SUB C ;SUBTRACT + LD C,A + LD A,H + SBC A,B + LD B,A + LD HL,BUFFER ; Point to start of buffer + ; Mark end of buffer + XOR A ;GET A ZERO + LD (DE),A ;NEED THREE 0'S ON THE END + INC DE ;ONE FOR END-OF-LINE + LD (DE),A ;AND 2 FOR A ZERO LINK + INC DE ;SINCE IF THIS IS A DIRECT STATEMENT + LD (DE),A ;ITS END MUST LOOK LIKE THE END OF A PROGRAM + RET ;END OF CRUNCHING + +CRNCLP: + CP '"' ; Is it a quote? QUOTE SIGN? + JP Z,CPYLIT ; Yes - Copy literal string YES, GO TO SPECIAL STRING HANDLING + CP ' ' ; Is it a space? SPACE? + JR Z,STUFFH ; Yes - Copy direct JUST STUFF AWAY + LD A,(DORES) ; a.k.a. OPRTYP, indicates whether stored word can be crunched, etc.. + OR A ; crunched, etc.. END OF LINE? + LD A,(HL) + JR Z,CRNCLP_2 ; YES, DONE CRUNCHING + +; This entry point is used by the routines at TSTNUM and NTSNGT. +STUFFH: + INC HL ; ENTRY TO BUMP [H,L] + PUSH AF ; SAVE CHAR AS KRNSAV CLOBBERS + CP $01 + JR NZ,TOKENIZE_4 + LD A,(HL) + AND A + LD A,$01 ;SET LINE NUMBER ALLOWED FLAG - KLUDGE AS HAS TO BE NON-ZERO. +TOKENIZE_4: + CALL NZ,KRNSAV ; Insert during tokenization SAVE CHAR IN KRUNCH BUFFER + POP AF ; RESTORE CHAR + SUB ':' ; ":", End of statement? + JR Z,SETLIT ; IF SO ALLOW CRUNCHING AGAIN + CP TK_DATA-':' ; SEE IF IT IS A DATA TOKEN + JR NZ,TSTREM ; No - see if REM + LD A,$01 ;SET LINE NUMBER ALLOWED FLAG - KLUDGE AS HAS TO BE NON-ZERO. +SETLIT: + LD (DORES),A ;SETUP FLAG + LD (DONUM),A ;SET NUMBER ALLOWED FLAG +TSTREM: + SUB TK_REM-':' + JR NZ,NXTCHR ;KEEP LOOPING + PUSH AF ;SAVE TERMINATOR ON STACK +STR1_LP: + LD A,(HL) ;GET A CHAR + OR A ;SET CONDITION CODES + EX (SP),HL ;GET SAVED TERMINATOR OFF STACK, SAVE [H,L] + LD A,H ;GET TERMINATOR INTO [A] WITHOUT AFFECTING PSW + POP HL ;RESTORE [H,L] + JR Z,CRDONE ;IF END OF LINE THEN DONE + CP (HL) ;COMPARE CHAR WITH THIS TERMINATOR + JR Z,STUFFH ;IF YES, DONE WITH STRING + +CPYLIT: + PUSH AF ;SAVE TERMINATOR + LD A,(HL) ;GET BACK LINE CHAR +; This entry point is used by the routine at TOKEN_BUILT. +TOKENIZE_9: + INC HL ;INCREMENT TEXT POINTER + CP $01 + JR NZ,TOKENIZE_10 + LD A,(HL) ;GET BACK LINE CHAR + AND A + LD A,$01 +TOKENIZE_10: + CALL NZ,KRNSAV ;SAVE CHAR IN KRUNCH BUFFER + JR STR1_LP ;KEEP LOOPING + +CRNCLP_2: + INC HL + OR A + JP M,NXTCHR + CP $01 + JR NZ,TOKENIZE_12 + LD A,(HL) ;GET A CHAR + AND A ;SET CONDITION CODES + JR Z,CRDONE ;IF END OF LINE THEN DONE + INC HL ;INCREMENT TEXT POINTER + JR NXTCHR + +TOKENIZE_12: + DEC HL + CP '?' ; Is it "?" short for PRINT + LD A,TK_PRINT ; TK_PRINT: "PRINT" token + PUSH DE ;SAVE STORE POINTER + PUSH BC ;SAVE CHAR COUNT + JP Z,MOVDIR ;THEN USE A "PRINT" TOKEN + LD A,(HL) + CP '_' ; $5F + JP Z,MOVDIR ; ... leave '_' unchanged ? + ;***5.11 DONT ALLOW FOLLOWING LINE #*** + LD DE,OPR_TOKENS ;ASSUME WE'LL SEARCH SPECIAL CHAR TABLE + CALL MAKUPL ;MAKE UPPER CASE (?) + CALL ISLETTER_A ;IS IT A LETTER? + JP C,TSTNUM ;NOT A LETTER, TEST FOR NUMBER + PUSH HL ;SAVE TEXT POINTER +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HCRUS ; Hook 2 for Tokenise +ENDIF + + LD HL,WORD_PTR ;GET POINTER TO ALPHA DISPATCH TABLE + +; On Spectravideo SVI this entry is tracked in the initial JP table (LBCA:) to facilitate the HOOK insertion + + SUB 'A' ;SUBTRACT ALPHA OFFSET + ADD A,A ;MULTIPLY BY TWO + LD C,A ;SAVE OFFSET IN [C] FOR DAD. + LD B,$00 ;MAKE HIGH PART OF OFFSET ZERO + ADD HL,BC ;ADD TO TABLE ADDRESS + LD E,(HL) ;SET UP POINTER IN [D,E] + INC HL + LD D,(HL) ;GET HIGH PART OF ADDRESS + POP HL ;GET BACK SOURCE POINTER + INC HL ;POINT TO CHAR AFTER FIRST ALPHA (Get next reserved word) + +TRYAGA: + PUSH HL ;SAVE TXTPTR TO START OF SEARCH AREA +LOPPSI: + CALL MAKUPL ;TRANSLATE THIS CHAR TO UPPER CASE + LD C,A ;SAVE CHAR IN [C] + LD A,(DE) ;GET BYTE FROM RESERVED WORD LIST (Get byte from table) + AND $7F ;GET RID OF HIGH BIT + JP Z,NOTRES ;IF=0 THEN END OF THIS CHARS RESLT (JP if end of list) + INC HL ;BUMP SOURCE POINTER + CP C ;COMPARE TO CHAR FROM SOURCE LINE (Same character as in buffer?) + JR NZ,LOPSKP ;IF NO MATCH, SEARCH FOR NEXT RESWRD (No - get next word) + LD A,(DE) ;GET RESWRD BYTE AGAIN + INC DE ;BUMP RESLST POINTER + OR A ;SET CC'S + JP P,LOPPSI ;SEE IF REST OF CHARS MATCH + POP AF ;GET RID OF SAVED [H,L] + LD A,(DE) ;GET RESWRD VALUE +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HISRE ; Hook 3 for Tokenise +ENDIF + OR A + JP M,TOKENIZE_17 + POP BC + POP DE + OR $80 ;MAKE HIGH ORDER BIT ONE + PUSH AF ;SAVE FN CHAR + LD A,$FF ;GET BYTE WHICH PRECEEDS FNS + CALL KRNSAV ;SAVE IN KRUNCH BUFFER + XOR A ;MAKE A ZERO + LD (DONUM),A ;TO RESET DONUM (FLOATINGS ALLOWED) + POP AF ;GET FUNCTION TOKEN + CALL KRNSAV ;STORE IT + JP NXTCHR ;KEEP KRUNCHING + +LOPSKP: + POP HL ;RESTORE UNDEFILED TEXT POINTER +LOPSK2: + LD A,(DE) ;GET A BYTE FROM RESWRD LIST + INC DE ;BUMP RESLST POINTER + OR A ;SET CC'S + JP P,LOPSK2 ;NOT END OF RESWRD, KEEP SKIPPING + INC DE ;POINT AFTER TOKEN + JR TRYAGA ;TRY ANOTHER RESWRD + +TOKENIZE_17: + DEC HL +MOVDIR: + PUSH AF +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HNTFN ; Hook 4 for Tokenise +ENDIF + LD DE,LNUM_TOKENS ; List of commands (tokens) requiring program line numbers + LD C,A +MOVDIR_0: + LD A,(DE) + OR A + JR Z,TOKEN_BUILT + INC DE + CP C + JR NZ,MOVDIR_0 + JR TOKENIZE_LNUM + +; Routine at 17333 +; List of commands (tokens) requiring program line numbers +LNUM_TOKENS: + DEFB TK_RESTORE + DEFB TK_AUTO + DEFB TK_RENUM + DEFB TK_DELETE + DEFB TK_RESUME + DEFB TK_ERL + DEFB TK_ELSE + DEFB TK_RUN + DEFB TK_LIST + DEFB TK_LLIST + DEFB TK_GOTO + DEFB TK_RETURN ; ! + DEFB TK_THEN + DEFB TK_GOSUB + DEFB $00 + +; This entry point is used by the routine at TOKENIZE. +TOKEN_BUILT: + XOR A + defb $C2 ; JP NZ,NN (always false), masks the next 2 bytes +TOKENIZE_LNUM: + LD A,1 + +TOKEN_BUILT_1: + LD (DONUM),A + POP AF + +RETNAD: + POP BC ;GET BACK CHAR COUNT + POP DE ;GET BACK DEPOSIT POINTER + CP TK_ELSE ;HAVE TO PUT A HIDDEN COLON IN FRONT OF "ELSE"S + PUSH AF ;SAVE CURRENT CHAR ($ELSE) + CALL Z,TOKENIZE_COLON ;SAVE ":" IN CRUNCH BUFFER + POP AF + CP TK_CALL ; $CA + JR Z,TOKEN_BUILT_3 + CP '_' ; $5F + JR NZ,TOKEN_BUILT_7 +TOKEN_BUILT_3: + CALL NC,KRNSAV ; Insert during tokenization +TOKEN_BUILT_4: + INC HL + CALL MAKUPL ; Load A with char in 'HL' and make it uppercase + AND A +TOKEN_BUILT_5: + JP Z,CRDONE + JP M,TOKEN_BUILT_4 + CP $01 + JR NZ,TOKEN_BUILT_6 + INC HL + LD A,(HL) + AND A + JR Z,TOKEN_BUILT_5 + JR TOKEN_BUILT_4 + +TOKEN_BUILT_6: + CP ' ' + JR Z,TOKEN_BUILT_3 + CP ':' + JR Z,TSTNUM_1 + CP '(' + JR Z,TSTNUM_1 + CP '0' + JR TOKEN_BUILT_3 + +TOKEN_BUILT_7: + CP TK_APOSTROPHE ;SINGLE QUOTE TOKEN? "'" = comment (=REM) + JP NZ,NTSNGT + PUSH AF + CALL TOKENIZE_COLON ;SAVE ":" IN CRUNCH BUFFER + LD A,TK_REM ;STORE ":$REM" IN FRONT FOR EXECUTION + CALL KRNSAV ;SAVE IT + POP AF ;GET SNGQTK (TK_APOSTROPHE) BACK + PUSH HL ;SAVE BACK AS TERMINATOR FOR STRNG + LD HL,$0000 ;STUFF THE REST OF THE LINE WITHOUT CRUNCHING + EX (SP),HL + JP TOKENIZE_9 + +; Routine at 17437 +; +; Used by the routine at TOKENIZE. +TSTNUM: + LD A,(HL) ;GET CHAR + CP '.' ;TEST FOR START OF FLOATING # + JR Z,NUMTRY ;TRY INPUTTING IT AS CONSTANT + CP '9'+1 ;IS IT A DIGIT? + JP NC,SRCSPC ;NO, TRY OTHER THINGS + CP '0' ;TRY LOWER END + JP C,SRCSPC ;NO TRY OTHER POSSIBILITIES +NUMTRY: + LD A,(DONUM) ;TEST FOR NUMBERS ALLOWED + OR A ;SET CC'S + LD A,(HL) ;GET CHAR IF GOING TO STUFFH + POP BC ;RESTORE CHAR COUNT + POP DE ;RESTORE DEP. POINTER + JP M,STUFFH ;NO, JUST STUFF IT (!) + JR Z,FLTGET ;IF DONUM=0 THEN FLOATING #'S ALLOWED + CP '.' ;IS IT DOT? + +; This entry point is used by the routine at TOKEN_BUILT. +TSTNUM_1: + JP Z,STUFFH ;YES, STUFF IT FOR HEAVENS SAKE! (EDIT .) + LD A,LINCON ;GET LINE # TOKEN + CALL KRNSAV ;SAVE IT + PUSH DE ;SAVE DEPOSIT POINTER + CALL ATOH ;GET THE LINE #. + CALL BAKSP ;BACK UP POINTER TO AFTER LAST DIGIT + +SAVINT: + EX (SP),HL ;EXCHANGE CURRENT [H,L] WITH SAVED [D,E] + EX DE,HL ;GET SAVED [D,E] IN [D,E] +TSTNUM_3: + LD A,L ;GET LOW BYTE OF VALUE RETURNED BY LINGET + CALL KRNSAV ;SAVE THE LOW BYTE OF LINE # + LD A,H ;GET HIGH BYTE +POPSTF: + POP HL ;RESTORE [H,L] + CALL KRNSAV ;SAVE IT TOO + JP NXTCHR ;EAT SOME MORE + +FLTGET: + PUSH DE ;SAVE DEPOSIT POINTER + PUSH BC ;SAVE CHAR COUNT + LD A,(HL) ;FIN ASSUMES CHAR IN [A] + CALL FIN_DBL ;READ THE # + CALL BAKSP ;BACK UP POINTER TO AFTER LAST DIGIT + POP BC ;RESTORE CHAR COUNT + POP DE ;RESTORE DEPOSIT POINTER + PUSH HL ;SAVE TEXT POINTER + LD A,(VALTYP) ;GET VALUE TYPE + CP $02 ;INTEGER? + JR NZ,NTINTG ;NO + LD HL,(FACLOW) ;GET IT + LD A,H ;GET HIGH PART + OR A ;IS IT ZERO? + LD A,$02 ;RESTORE INT VALTYP + JR NZ,NTINTG ;THEN ISNT SINGLE BYTE INT + LD A,L ;GET LOW BYTE + LD H,L ;GET LOW BYTE IN HIGH BYTE TO STORE + LD L,$0F ;GET CONSTANT FOR 1 BYTE INTS + CP $0A ;IS IT TOO BIG FOR A SINGLE BYTE CONSTANT? + JR NC,TSTNUM_3 ;TOO BIG, USE SINGLE BYTE INT + ADD A,ONECON ;MAKE SINGLE BYTE CONSTANT + JR POPSTF ;POP H & STUFF AWAY CHAR + +NTINTG: + PUSH AF ;SAVE FOR LATER + RRCA ;DIVIDE BY TWO + ADD A,$1B ;ADD OFFSET TO GET TOKEN + CALL KRNSAV ;SAVE THE TOKEN + LD HL,FACCU ;GET START POINTER + LD A,(VALTYP) + CP $02 + JR NZ,TSTNUM_7 + LD HL,FACLOW +TSTNUM_7: + POP AF ;RESTORE COUNT OF BYTES TO MOVE +TSTNUM_8: + PUSH AF ;SAVE BYTE MOVE COUNT + LD A,(HL) ;GET A BYTE + CALL KRNSAV ;SAVE IT IN KRUNCH BUFFER + POP AF ;GET BACK COUNT + INC HL ;BUMP POINTER INTO FAC + DEC A ;MOVE IT DOWN + JR NZ,TSTNUM_8 ;KEEP MOVING IT + POP HL ;GET BACK SAVED TEXT POINTER + JP NXTCHR ;KEEP LOOPING + +SRCSPC: + LD DE,OPR_TOKENS-1 ; GET POINTER TO SPECIAL CHARACTER TABLE +SRCSP2: + INC DE ; MOVE POINTER AHEAD + LD A,(DE) ; GET BYTE FROM TABLE + AND $7F ; MASK OFF HIGH BIT + JP Z,L44FA ; IF END OF TABLE, STUFF AWAY, DONT CHANGE DONUM + INC DE ; BUMP POINTER + CP (HL) ; IS THIS SPECIAL CHAR SAME AS CURRENT TEXT CHAR? + LD A,(DE) ; GET NEXT RESWRD + JR NZ,SRCSP2 ; IF NO MATCH, KEEP LOOKING + JP NOTRS1 ; FOUND, SAVE AWAY AND SET DONUM=1. + +; Routine at 17588 +; +; Used by the routine at TOKEN_BUILT. +NTSNGT: + CP '&' ; OCTAL CONSTANT? + JP NZ,STUFFH ; JUST STUFF IT AWAY + PUSH HL ; SAVE TEXT POINTER + RST CHRGTB ; GET NEXT CHAR + POP HL ; RESTORE TEXT POINTER + CALL UCASE ; MAKE CHAR UPPER CASE + CP 'H' ; '&H' HEX CONSTANT? + JR Z,NTSNGT_1 + CP 'O' ; &O ..octal prefix + JR Z,NTSNGT_0 + LD A,'&' ; $26 + JP STUFFH + +NTSNGT_0: + LD A,$0B ; Octal Number prefix + JR WUZOCT + +NTSNGT_1: + LD A,$0C ; Hex Number prefix +WUZOCT: + CALL KRNSAV ; Insert during tokenization + PUSH DE + PUSH BC + CALL OCTCNS + POP BC + JP SAVINT + +; Routine at 17630 +; +; Used by the routine at TOKEN_BUILT. +TOKENIZE_COLON: + LD A,':' ; GET COLON IN KRUNCH BUFFER +; This entry point is used by the routines at TOKENIZE, TOKEN_BUILT, TSTNUM and NTSNGT. + +; Insert during tokenization +KRNSAV: + LD (DE),A ; SAVE BYTE IN KRUNCH BUFFER + INC DE ; BUMP POINTER + DEC BC ; DECREMENT COUNT OF BYTES LEFT IN BUFFER + LD A,C ; TEST IF IT WENT TO ZERO + OR B ; BY SEEING IF DOUBLE BYTE ZERO. + RET NZ ; ALL DONE IF STILL SPACE LEFT + + LD E,$19 ; Err $19 - "Line buffer overflow" + JP ERROR + +; Routine at 17643 +; +; Used by the routine at TOKENIZE. +NOTRES: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HNOTR ; Hook 5 for Tokenise +ENDIF + POP HL ;GET BACK POINTER TO ORIGINAL CHAR + DEC HL ;NOW POINT TO FIRST ALPHA CHAR + DEC A ;SET A TO MINUS ONE + LD (DONUM),A ;FLAG WERE IN VARIABLE NAME + CALL MAKUPL ;GET CHAR FROM LINE, MAKE UPPER CASE + JP RETNAD ;..continue + +; Routine at 17658 +; +; Used by the routine at TSTNUM. +L44FA: + LD A,(HL) + CP ' ' + JR NC,NOTRS1 + CP $09 ; TAB + JR Z,NOTRS1 + CP LF + JR Z,NOTRS1 + LD A,' ' +; This entry point is used by the routine at TSTNUM. +NOTRS1: + PUSH AF + LD A,(DONUM) + INC A + JR Z,L44FA_1 + DEC A +L44FA_1: + JP TOKEN_BUILT_1 + + +; ROUTINE TO BACK UP POINTER AFTER # EATEN +; Routine at 17684 +; +; Used by the routine at TSTNUM. +BAKSP: + DEC HL ;POINT TO PREVIOUS CHAR + LD A,(HL) ;GET THE CHAR + CP ' ' ;A SPACE? + JR Z,BAKSP ;YES, KEEP BACKING UP + CP $09 ;TAB? + JR Z,BAKSP ;YES, BACK UP + CP LF ;LF? + JR Z,BAKSP + INC HL ;POINT TO CHAR AFTER LAST NON-SPACE + RET ;ALL DONE. + + +; 'FOR' BASIC command +; +; A "FOR" ENTRY ON THE STACK HAS THE FOLLOWING FORMAT: +; +; LOW ADDRESS +; TOKEN ($FOR IN HIGH BYTE) 1 BYTE +; A POINTER TO THE LOOP VARIABLE 2 BYTES +; A BYTE REFLECTING THE SIGN OF THE INCREMENT 1 BYTE +; THE STEP 4 BYTES +; THE UPPER VALUE 4 BYTES +; THE LINE # OF THE "FOR" STATEMENT 2 BYTES +; A TEXT POINTER INTO THE "FOR" STATEMENT 2 BYTES +; +; Data block at 17700 +__FOR: + LD A,$64 ; Flag "FOR" assignment + LD (SUBFLG),A ; Save "FOR" flag DONT RECOGNIZE SUBSCRIPTED VARIABLES + CALL __LET ; Set up initial index GET POINTER TO LOOP VARIABLE + POP BC ; Drop RETurn address GET RID OF THE NEWSTT RETURN + PUSH HL ; Save code string address SAVE THE TEXT POINTER + CALL __DATA ; Get next statement address SET [H,L]=END OF STATEMENT + LD (ENDFOR),HL ; Next address of FOR st. SAVE FOR COMPARISON + LD HL,2 ; Offset for "FOR" block SET UP POINTER INTO STACK + ADD HL,SP ; Point to it +FORSLP: + CALL LOKFOR ; Look for existing "FOR" block MUST HAVE VARIABLE POINTER IN [D,E] + JR NZ,FORFND ; IF NO MATCHING ENTRY, DON'T ELIMINATE ANYTHING + ADD HL,BC ; IN THE CASE OF "FOR" WE ELIMINATE THE MATCHING ENTRY AS WELL AS EVERYTHING AFTER IT + PUSH DE ; SAVE THE TEXT POINTER + DEC HL ; SEE IF END TEXT POINTER OF MATCHING ENTRY + LD D,(HL) ; MATCHES THE FOR WE ARE HANDLING + DEC HL ; PICK UP THE END OF THE "FOR" TEXT POINTER + LD E,(HL) ; FOR THE ENTRY ON THE STACK + INC HL ; WITHOUT CHANGING [H,L] + INC HL + PUSH HL ; Save block address SAVE THE STACK POINTER FOR THE COMPARISON + LD HL,(ENDFOR) ; Get address of loop statement GET ENDING TEXT POINTER FOR THIS "FOR" + RST DCOMPR ; Compare the FOR loops SEE IF THEY MATCH + POP HL ; Restore block address GET BACK THE STACK POINTER + POP DE ; GET BACK THE TEXT POINTER + JR NZ,FORSLP ; Different FORs - Find another KEEP SEARCHING IF NO MATCH + POP DE ; Restore code string address GET BACK THE TEXT POINTER + LD SP,HL ; Remove all nested loops DO THE ELIMINATION + LD (SAVSTK),HL ; UPDATE SAVED STACK SINCE A MATCHING ENTRY WAS FOUND + + DEFB $0E ; LD C,N to mask the next byte + +FORFND: + POP DE ; Code string address to DE + EX DE,HL ; [H,L]=TEXT POINTER + LD C,12 ; MAKE SURE 24 BYTES ARE AVAILABLE OFF OF THE STACK + CALL CHKSTK ; Check for 12 levels of stack + PUSH HL ; REALLY SAVE THE TEXT POINTER + LD HL,(ENDFOR) ; Get first statement of loop PICK UP POINTER AT END OF "FOR" + ; JUST BEYOND THE TERMINATOR + EX (SP),HL ; Save and restore code string PUT [H,L] POINTER TO TERMINATOR ON THE STACK + ; AND RESTORE [H,L] AS TEXT POINTER AT VARIABLE NAME + PUSH HL ; Re-save code string address PUSH THE TEXT POINTER ONTO THE STACK + LD HL,(CURLIN) ; Get current line number [H,L] GET THE CURRENT LINE # + EX (SP),HL ; Save and restore code string NOW THE CURRENT LINE # IS ON THE STACK, HL IS THE TEXT POINTER + RST SYNCHR ; Make sure "TO" is next + DEFB TK_TO ; TK_TO: "TO" token "TO" IS NECESSARY + RST GETYPR ; Get the number type (FAC) SEE WHAT TYPE THIS VALUE HAS + JP Z,TM_ERR ; If string type, "Type mismatch" GIVE STRINGS A "TYPE MISMATCH" + PUSH AF ; save type SAVE THE INTEGER/FLOATING FLAG + CALL EVAL ; EVALUATE THE TARGET VALUE FORMULA + POP AF ; Restore type POP OFF THE FLAG + PUSH HL ; SAVE THE TEXT POINTER + JR NC,FORFND_DBL ; Deal with DOUBLE-PRECISION + JP P,FORFND_SNG ; POSITIVE MEANS SINGLE PRECISION "FOR"-LOOP + CALL __CINT ; COERCE THE FINAL VALUE + EX (SP),HL ; SAVE IT ON THE STACK AND REGET THE TEXT POINTER + + LD DE,$0001 ; Default value for STEP DEFAULT THE STEP TO BE 1 + LD A,(HL) ; Get next byte in code string SEE WHAT CHARACTER IS NEXT + CP TK_STEP ; See if "STEP" is stated IS THERE A "STEP" CLAUSE? + CALL Z,FPSINT ; If so, get updated value for 'STEP' IF SO, READ THE STEP INTO [D,E] + PUSH DE ; PUT THE STEP ONTO THE STACK + PUSH HL ; SAVE THE TEXT POINTER + EX DE,HL ; STEP INTO [H,L] + CALL ISIGN ; Test sign for 'STEP' THE SIGN OF THE STEP INTO [A] + JR FORFND_1 ; FINISH UP THE ENTRY BY PUTTING THE SIGN OF + ; THE STEP AND THE DUMMY ENTRIES ON THE STACK + +FORFND_DBL: + CALL __CDBL ; Get value for 'TO' + POP DE + LD HL,$FFF8 ; -8 + ADD HL,SP + LD SP,HL + PUSH DE + CALL VMOVMF + POP HL + LD A,(HL) + CP TK_STEP ; 'STEP' + LD DE,FP_UNITY ; 1 + LD A,1 ; Default STEP value + JR NZ,SAVSTP ; No STEP given - Default to 1 + RST CHRGTB ; Jump over "STEP" token and point to step value + CALL EVAL + PUSH HL + CALL __CDBL + CALL SIGN ; test FP number sign + LD DE,FACCU + POP HL + +SAVSTP: + LD B,H + LD C,L + LD HL,$FFF8 ; -8 + ADD HL,SP + LD SP,HL + PUSH AF + PUSH BC + CALL VMOVE + POP HL + POP AF + JR FORFND_3 + +FORFND_SNG: + CALL __CSNG ; Get value for 'TO' + CALL BCDEFP ; Move "TO" value to BCDE + POP HL ; Restore code string address + PUSH BC ; Save "TO" value in block + PUSH DE ; SAVE THE SIGN OF THE INCREMENT + LD BC,$1041 ; BCDE = 1.0 float (default value for STEP) + LD DE,$0000 + +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HSNGF ; Hook for 'FOR' +ENDIF + + LD A,(HL) ; Get next byte in code string GET TERMINATING CHARACTER + CP TK_STEP ; See if "STEP" is stated + LD A,$01 ; Sign of step = 1 + JR NZ,SAVSTP_2 ; No STEP given - Default to 1 + CALL EVAL_0 ; Jump over "STEP" token and point to step value + PUSH HL ; Save code string address + CALL __CSNG ; Get value for 'STEP' + CALL BCDEFP ; Move STEP to BCDE + CALL SIGN ; Test sign for 'STEP' in FPREG + +FORFND_1: + POP HL ; Restore code string address + +SAVSTP_2: + PUSH DE ; Save the STEP value in block + PUSH BC + PUSH BC + PUSH BC + PUSH BC + PUSH BC + +FORFND_3: + OR A + JR NZ,FORFND_4 + LD A,$02 +FORFND_4: + LD C,A ;[C]=SIGN OF STEP + RST GETYPR ;MUST PUT ON INTEGER/SINGLE-PRECISION FLAG - MINUS IS SET FOR INTEGER CASE + LD B,A ;HIGH BYTE = INTEGER/SINGLE PRECISION FLAG + PUSH BC ;SAVE FLAG AND SIGN OF STEP BOTH + PUSH HL ; Save code string address + LD HL,(TEMP) ; Get address of index variable ;GET THE POINTER TO THE VARIABLE BACK + EX (SP),HL ; Save and restore code string ;PUT THE PTR ON SP AND RESTORE THE TEXT POINTER +; --- Put "FOR" block marker --- +PUTFID: + LD B,TK_FOR ; "FOR" block marker ;FINISH UP "FOR" + PUSH BC ; Save it + INC SP ; Don't save C ;THE "TOKEN" ONLY TAKES ONE BYTE OF STACK SPACE +; JMP NEWSTT ;ALL DONE + +; +; BASIC program execution driver (a.k.a. RUNCNT). HL points to code. +; +; BACK HERE FOR NEW STATEMENT. CHARACTER POINTED TO BY [H,L] +; ":" OR END-OF-LINE. THE ADDRESS OF THIS LOCATION IS +; LEFT ON THE STACK WHEN A STATEMENT IS EXECUTED SO +; IT CAN MERELY DO A RETURN WHEN IT IS DONE. +; +NEWSTT: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HNEWS ; Hook for runloop new statement event +ENDIF + LD (SAVSTK),SP + CALL ISCNTC ; Check STOP key status + LD A,(ONGSBF) + OR A ; + CALL NZ,EXEC_ONGOSUB +NEWSTT_0: + EI + LD (SAVTXT),HL ; Save code address for break TO REMEMBER HOW TO RESTART THIS STATEMENT + LD A,(HL) ; GET CURRENT CHARACTER WHICH TERMINATED THE LAST STATEMENT + CP ':' ; Multi statement line? + JR Z,EXEC ; Yes - Execute it + OR A ; End of line? + JP NZ,SN_ERR ; No - Syntax error ;MUST BE A ZERO + INC HL ; Point to address of next line + +;$4620 +GONE4: ;CHECK POINTER TO SEE IF IT IS ZERO, IF SO WE ARE AT THE END OF THE PROGRAM + LD A,(HL) ; Get LSB of line pointer + INC HL + OR (HL) ; Is it zero (End of prog)? + JP Z,PRG_END ; Yes - Terminate execution ;FIX SYNTAX ERROR IN UNENDED ERROR ROUTINE + INC HL ; Point to line number + LD E,(HL) ; Get LSB of line number + INC HL + LD D,(HL) ; Get MSB of line number ;GET LINE # IN [D,E] + EX DE,HL ; Line number to HL ;[H,L]=LINE # + LD (CURLIN),HL ; Save as current line number ;SETUP CURLIN WITH THE CURRENT LINE # + LD A,(TRCFLG) ; SEE IF TRACE IS ON (0 MEANS NO TRACE) + OR A ; NON-ZERO MEANS YES + JR Z,NEWSTT_2 ; SKIP THIS PRINTING + + ; If "TRACE" is ON, then print current line number between brackets + ; [0000] <<<-- print line number being executed + PUSH DE ;SAVE THE TEXT POINTER + LD A,'[' ;FORMAT THE LINE NUMBER + RST OUTDO ;OUTPUT IT + CALL LINPRT ;PRINT THE LINE # IN [H,L] + LD A,']' ;SOME MORE FORMATING + RST OUTDO + POP DE ;[D,E]=TEXT POINTER + +;$463F +NEWSTT_2: + EX DE,HL ;RESTORE THE TEXT POINTER, Line number back to DE + +;$4640 +EXEC: + RST CHRGTB ; Get key word ;GET THE STATEMENT TYPE + LD DE,NEWSTT ; Where to RETurn to ;PUSH ON A RETURN ADDRESS OF NEWSTT + PUSH DE ; Save for RETurn ;STATEMENT + RET Z ; Go to NEWSTT if end of STMT ;IF A TERMINATOR TRY AGAIN + + +;"IF" COMES HERE, "ON ... GOTO" AND "ON ... GOSUB" COME HERE +; This entry point is used by the routines at __ON and __IF. +ONJMP: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HGONE ; Hook 1 in runloop execute event +ENDIF + CP '_' ; $5F + JP Z,CALL_SHCUT + SUB TK_END ; $81 = TK_END .. is it a token? + JP C,__LET ; No - try to assign it, MUST BE A LET + CP TK_LOCATE+1-TK_END ; END to LOCATE ? + JP NC,NOT_KEYWORD ; Not a key word - ?SN Error + + ; We're in the token range between TK_END and TK_LOCATE + RLCA + LD C,A + LD B,$00 + EX DE,HL ; Save code string address + LD HL,FNCTAB ; Function routine addresses ;a.k.a. STMDSP: STATEMENT DISPATCH TABLE + ADD HL,BC ; Point to right address ;ADD ON OFFSET + LD C,(HL) ; Get LSB of address ;PUSH THE ADDRESS TO GO TO ONTO + INC HL ;THE STACK + LD B,(HL) ; Get MSB of address ;PUSHM SAVES BYTES BUT NOT SPEED + PUSH BC + EX DE,HL ;RESTORE THE TEXT POINTER + + ; --- START PROC L4666 --- +; +; NEWSTT FALLS INTO CHRGET. THIS FETCHES THE FIRST CHAR AFTER +; THE STATEMENT TOKEN AND THE CHRGET'S "RET" DISPATCHES TO STATEMENT +; +__CHRGTB: ; DUPLICATION OF CHRGET RST FOR SPEED +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HCNRG ; Hook for CHRGTR std routine +ENDIF + INC HL ; Point to next character ;LOOK AT NEXT CHAR + ; --- START PROC __CHRCKB --- + ; Gets current character (or token) from BASIC text. +__CHRCKB: + LD A,(HL) ; Get next code string byte ;SEE CHRGET RST FOR EXPLANATION + CP ':' ; Z if ":" ;IS IT END OF STATMENT OR BIGGER + RET NC ; NC if > "9" + +; +; CHRCON IS THE CONTINUATION OF THE CHRGET RST +; +; IN EXTENDED, CHECK FOR INLINE CONSTANT AND IF ONE +; MOVE IT INTO THE FAC & SET VALTYP APPROPRIATELY +; + CP ' ' ; MUST SKIP SPACES + JR Z,__CHRGTB ; Skip over spaces GET ANOTHER CHARACTER + JR NC,NOTLFT ; NC if < "0" NOT SPECIAL TRY OTHER POSSIB. + OR A ; Test for zero - Leave carry + RET Z + CP OCTCON ;IS IT INLINE CONSTANT ? + JR C,NOTCON ;NO, SHOULD BE TAB OR LF + CP CONCON ;ARE WE TRYING TO RE-SCAN A CONSTANT? + JR NZ,NTRSCC ;NO. + LD A,(CONSAV) ;GET THE SAVED CONSTANT TOKEN + OR A ;SET NON-ZERO, NON CARRY CC'S + RET ;ALL DONE + +NTRSCC: + CP CONCN2 ;(CONCN2) GOING TO SCAN PAST EMBEDDED CONSTANT? + JR Z,NTRSC2 ;NO, TRY OTHER CASES + PUSH AF ;SAVE TOKEN TO RETURN + INC HL ;POINT TO NUMBER + LD (CONSAV),A ;SAVE CURRENT TOKEN + SUB INTCON ;IS IT LESS THAN INTEGER CONSTANT? + JR NC,MAKTKN ;NO, NOT LINE NUMBER CONSTANT + SUB ONECON-INTCON ;LESS THAN EMBEDDED 1 BYTER + JR NC,ONEI ;WAS ONE BYTER + CP IN2CON-ONECON ;IS IT TWO BYTER? + JR NZ,FRCINC ;NOPE, NORMAL INT + LD A,(HL) ;GET EMBEDED INT + INC HL ;POINT AFTER CONSTANT +ONEI: + LD (CONTXT),HL ;SAVE TEXT POINTER + LD H,$00 ;GET UPPER BYTE OF ZERO +ONEI2: + LD L,A ;GET VALUE + LD (CONLO),HL ;SAVE CONSTANT VALUE + LD A,$02 ;GET VALTYPE + LD (CONTYP),A ;SET IT UP IN SAVE PLACE + LD HL,NUMCON ;POINT TO NUMBER RE-SCANNER ("FAKE TEXT") + POP AF ;GET BACK TOKEN + OR A ;MAKE SURE NUMBER FLAG RE-SET + RET ;RETURN TO CALLER + +FRCINC: + LD A,(HL) ;GET LOW BYTE OF CONSTANT + INC HL ;POINT PAST IT + INC HL ;TO NEXT THING + LD (CONTXT),HL ;SAVE POINTER PAST + DEC HL ;BACK TO HIGH BYTE + LD H,(HL) ;GET HIGH BYTE + JR ONEI2 ;FINISH SCANNING + +; Routine at 18104 +;RESCAN THE TOKEN & RESTORE OLD TEXT PTR +; +; Used by the routine at OPRND. +_CONFAC: + CALL CONFAC +NTRSC2: + LD HL,(CONTXT) + JR __CHRCKB ; Gets current character (or token) from BASIC text. + +; Routine at 18112 +MAKTKN: + INC A ;CALCULATE VALTYPE + RLCA ;*2 TO GET VALTYPE 0=2, 1=4, 3=8 + LD (CONTYP),A ;CONTYPE NOW SETUP + PUSH DE ;SAVE SOME RGS + PUSH BC + LD DE,CONLO ;PLACE TO STORE SAVED CONSTANT + EX DE,HL ;GET TEXT POINTER IN [D,E] + LD B,A ;SETUP COUNTER IN [B] + CALL MOVE1 ;MOVE DATA IN + EX DE,HL ;GET TEXT POINTER BACK + POP BC ;RESTORE [B,C] + POP DE + LD (CONTXT),HL ;SAVE THE GOOD TEXT POINTER + POP AF ;RESTORE TOKEN + LD HL,NUMCON ;GET POINTER TO FAKE TEXT + OR A ;CLEAR CARRY SO OTHERS DONT THINK ITS A NUMBER AND SET NON-ZERO SO NOT TERMINATOR + RET ;ALL DONE + +; Routine at 18139 +NOTCON: + CP $09 ;LINE FEED OR TAB? + JP NC,__CHRGTB ;YES, EAT. +NOTLFT: + CP '0' ;ALL CHARACTERS GREATER THAN "9" HAVE RETURNED, SO SEE IF NUMERIC + CCF ;MAKE NUMERICS HAVE CARRY ON + INC A ;SET ZERO IF [A]=0 + DEC A + RET + + +; Data at 18150 + +;THESE FAKE TOKENS FORCE CHRGET TO EFFECTIVELY RE-SCAN THE EMBEDED CONSTANT +NUMCON: + DEFB CONCON ;TOKEN RETURNED BY CHRGET AFTER CONSTANT SCANNED + DEFB CONCN2 ;TOKEN RETURNED SECOND TYPE CONSTANT IS SCANNED. + + + +; This entry point is used by the routines at _CONFAC and NUMLIN. +CONFAC: + LD A,(CONSAV) ;GET CONSTANT TOKEN + CP LINCON+1 ;LINE# CONSTANT? (ERL=#) + JR NC,NTLINE ;NO + CP PTRCON ;LINE POINTER CONSTANT? + JR C,NTLINE ;NO + LD HL,(CONLO) ;GET VALUE + JR NZ,FLTLIN ;MUST BE LINE NUMBER, NOT POINTER + INC HL ;POINT TO LINE # + INC HL + INC HL + LD E,(HL) ;GET LINE # IN [D,E] + INC HL + LD D,(HL) ;GET HIGH PART + EX DE,HL ;VALUE TO [H,L] +FLTLIN: + JP INEG2 ;FLOAT IT + +NTLINE: + LD A,(CONTYP) ;GET SAVED CONSTANT VALTYP + LD (VALTYP),A ;SAVE IN REAL VALTYP + CP $02 ; Integer ? + JR NZ,NTLINE_FLT ; No, JP + LD HL,(CONLO) ;GET LOW TWO BYTES OF FAC + LD (FACLOW),HL ;SAVE THEM +NTLINE_FLT: + LD HL,CONLO ; Value of stored constant + JP VMOVFM + + +; $4718 +__DEFSTR: + LD E,$03 ; DEFAULT SOME LETTERS TO String type + + DEFB $01 ; "LD BC,nn" to jump over the next word without executing it +; $471B +__DEFINT: + LD E,$02 ; DEFAULT SOME LETTERS TO Integer type + + DEFB $01 ; "LD BC,nn" to jump over the next word without executing it +; $471E +__DEFSNG: + LD E,$04 ; DEFAULT SOME LETTERS TO Single precision type + + DEFB $01 ; "LD BC,nn" to jump over the next word without executing it +; $4721 +__DEFDBL: + LD E,$08 ; DEFAULT SOME LETTERS TO Double Precision type + +; $4723 +DEFCON: + CALL IS_LETTER ;MAKE SURE THE ARGUMENT IS A LETTER + LD BC,SN_ERR ;PREPARE "SYNTAX ERROR" RETURN + PUSH BC + RET C ;RETURN IF THERES NO LETTER + SUB 'A' ;MAKE AN OFFSET INTO DEFTBL + LD C,A ;SAVE THE INITIAL OFFSET + LD B,A ;ASSUME IT WILL BE THE FINAL OFFSET + RST CHRGTB ;GET THE POSSIBLE DASH + CP TK_MINUS ;(token code for '-'): A RANGE ARGUMENT? ; + JR NZ,NOTRNG ;IF NOT, JUST ONE LETTER + RST CHRGTB ;GET THE FINAL POSITION + CALL IS_LETTER ;CHECK FOR A LETTER + RET C ;GIVE A SYNTAX ERROR IF IMPROPER + SUB 'A' ;MAKE IT AN OFFSET + LD B,A ;PUT THE FINAL IN [B] + RST CHRGTB ;GET THE TERMINATOR +NOTRNG: + LD A,B ;GET THE FINAL CHARACTER + SUB C ;SUBTRACT THE START + RET C ;IF IT'S LESS THATS NONSENSE + INC A ;SETUP THE COUNT RIGHT + EX (SP),HL ;SAVE THE TEXT POINTER AND GET RID OF THE "SYNTAX ERROR" RETURN + LD HL,DEFTBL ;POINT TO THE TABLE OF DEFAULTS + LD B,$00 ;SETUP A TWO-BYTE STARTING OFFSET + ADD HL,BC ;MAKE [H,L] POINT TO THE FIRST ENTRY TO BE MODIFIED +LPDCHG: + LD (HL),E ;MODIFY THE DEFAULT TABLE + INC HL + DEC A ;COUNT DOUNT THE NUMBER OF CHANGES TO MAKE + JR NZ,LPDCHG + POP HL ;GET BACK THE TEXT POINTER + LD A,(HL) ;GET LAST CHARACTER + CP ',' ;IS IT A COMMA? + RET NZ ;IF NOT STATEMENT SHOULD HAVE ENDED + RST CHRGTB ;OTHERWISE SET UP TO SCAN NEW RANGE + JR DEFCON + +; Routine at 18261 +; Get subscript +; +; INTIDX READS A FORMULA FROM THE CURRENT POSITION AND +; TURNS IT INTO A POSITIVE INTEGER +; LEAVING THE RESULT IN [D,E]. NEGATIVE ARGUMENTS +; ARE NOT ALLOWED. [H,L] POINTS TO THE TERMINATING +; CHARACTER OF THE FORMULA ON RETURN. +; +INTIDX: + RST CHRGTB ; Gets next character (or token) from BASIC text. +; This entry point is used by the routine at __CLEAR. +INTIDX_0: + CALL FPSINT_0 ;READ A FORMULA AND GET THE RESULT AS AN INTEGER IN [D,E] + ;ALSO SET THE CONDITION CODES BASED ON THE HIGH ORDER OF THE RESULT + RET P ;DON'T ALLOW NEGATIVE NUMBERS + +; entry for '?FC ERROR' +; +; Used by the routines at __LOG, __ERROR, __AUTO, OPRND, __WIDTH, FNDNUM, +; __DELETE, __RENUM_0, __RENUM_NXT, SCNVAR, ATRSCN, IN_GFX_MODE, __PAINT, __CIRCLE, CGTCNT, +; __DRAW, DMOVE, DSCALE, DCOLR, CHKRNG, REUSST, __SWAP, __CLEAR, __ASC, __MID_S, +; FN_INSTR, LHSMID, __LFILES, FN_INPUT, __SOUND, MCLPLAY, SNDFCE, L77D4, ON_OPTIONS, __STRIG, +; __SCREEN, SET_BAUDRATE, __SPRITE, PUT_SPRITE, __BASE, __CVD and __MAX. +; $475A +FC_ERR: + LD E,$05 ; Err $05 - "Illegal function call" + JP ERROR ;TOO BIG. FUNCTION CALL ERROR + +; Evaluate line number text pointed to by HL. +; +; +; LINSPC IS THE SAME AS LINGET EXCEPT IN ALLOWS THE +; CURRENT LINE (.) SPECIFIER +; +; Routine at 18271 +; +; Used by the routines at LNUM_RANGE, __AUTO and __RENUM_0. +LNUM_PARM: + LD A,(HL) ;GET CHAR FROM MEMORY + CP '.' ;IS IT CURRENT LINE SPECIFIER + LD DE,(DOT) ;GET CURRENT LINE # + JP Z,__CHRGTB ;ALL DONE. + + +; Get specified line number +; ASCII to Integer, result in DE +; +; LINGET READS A LINE # FROM THE CURRENT TEXT POSITION +; +; LINE NUMBERS RANGE FROM 0 TO 65529 +; +; THE ANSWER IS RETURNED IN [D,E]. +; [H,L] IS UPDATED TO POINT TO THE TERMINATING CHARACTER +; AND [A] CONTAINS THE TERMINATING CHARACTER WITH CONDITION +; CODES SET UP TO REFLECT ITS VALUE. +; +; This entry point is used by the routines at TSTNUM, __GOSUB, RUNLIN, __AUTO, +; CNSGET, __RENUM_0 and __RESTORE. +ATOH: + DEC HL ;BACKSPACE PTR + +; As above, but conversion starts at HL+1 +; +; Used by the routine at ON_ERROR. +ATOH2: + RST CHRGTB ;FETCH CHAR (GOBBLE LINE CONSTANTS) + CP LINCON ;$0E: EMBEDDED LINE CONSTANT? + JR Z,LINGT3 ;YES, RETURN DOUBLE BYTE VALUE + CP PTRCON ;$0D: ALSO CHECK FOR POINTER + +; This entry point is used by the routines at LINE2PTR and SCNPT2. +LINGT3: + LD DE,(CONLO) ;GET EMBEDDED LINE # + JP Z,__CHRGTB ;EAT FOLLOWING CHAR + XOR A + LD (CONSAV),A + LD DE,$0000 ;ZERO ACCUMULATED LINE # + DEC HL ;BACK UP POINTER +GTLNLP: + RST CHRGTB ; Gets next character (or token) from BASIC text. + RET NC ;WAS IT A DIGIT + PUSH HL + PUSH AF + LD HL,65529/10 ; Largest number 65529 ;SEE IF THE LINE # IS TOO BIG + RST DCOMPR ; Compare HL with DE. + JR C,POPHSR ; YES, DON'T SCAN ANY MORE DIGITS IF SO. FORCE CALLER TO SEE DIGIT AND GIVE SYNTAX ERROR + ; CAN'T JUST GO TO SYNTAX ERROR BECAUSE OF NON-FAST RENUM WHICH CAN'T TERMINATE + LD H,D ;SAVE [D,E] + LD L,E + ADD HL,DE ; *2 + ADD HL,HL ; ..*4 + ADD HL,DE ; ..*5 + ADD HL,HL ; ..*10 ;PUTTING [D,E]*10 INTO [H,L] + 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 ;ADD THE NEW DIGIT + EX DE,HL ; Number to DE + POP HL ; Restore code string address ;GET BACK TEXT POINTER + JR GTLNLP ; Go to next character + +POPHSR: + POP AF ;GET OFF TERMINATING DIGIT + POP HL ;GET BACK OLD TEXT POINTER + RET + +; Routine at 18334 +__RUN: + JP Z,RUN_FST ; RUN from start if just RUN ;NO LINE # ARGUMENT + CP LINCON ;LINE NUMBER CONSTANT? + JR Z,__RUN_0 ;YES + CP PTRCON ;LINE POINTER (RATHER UNLIKELY) + JP NZ,_RUN_FILE + +__RUN_0: ; Initialise variables ;CLEAN UP -- RESET THE STACK, DATPTR,VARIABLES ... + ;[H,L] IS THE ONLY THING PRESERVED + CALL _CLVAR + LD BC,NEWSTT + JR RUNLIN ;PUT "NEWSTT" ON AND FALL INTO "GOTO" + +; 'GOSUB' BASIC command +; Routine at 18354 +; +; A "GOSUB" ENTRY ON THE STACK HAS THE FOLLOWING FORMAT +; +; LOW ADDRESS +; +; A TOKEN EQUAL TO $GOSUB 1 BYTE +; THE LINE # OF THE THE "GOSUB" STATEMENT 2 BYTES +; A POINTER INTO THE TEXT OF THE "GOSUB" 2 BYTES +; +; HIGH ADDRESS +; +; TOTAL 5 BYTES +; +__GOSUB: + LD C,$03 ; 3 Levels of stack needed ;"GOSUB" ENTRIES ARE 5 BYTES LONG + CALL CHKSTK ; Check for 3 levels of stack ;MAKE SURE THERE IS ROOM + CALL ATOH ;MUST SCAN LINE NUMBER NOW + POP BC ; Get return address ;POP OFF RETURN ADDRESS OF "NEWSTT" + PUSH HL ; Save code string for RETURN ;REALLY PUSH THE TEXT POINTER + PUSH HL ; And for GOSUB routine ;SAVE TEXT POINTER + LD HL,(CURLIN) ; Get current line ;GET THE CURRENT LINE # + EX (SP),HL ; Into stack - Code string out ;PUT CURLIN ON THE STACK AND [H,L]=TEXT PTR + LD BC,$0000 + PUSH BC + LD BC,NEWSTT + LD A,TK_GOSUB ; "GOSUB" token + PUSH AF ; Save token ;PUT GOSUB TOKEN ON THE STACK + INC SP ; Don't save flags ;THE GOSUB TOKEN TAKES ONLY ONE BYTE + PUSH BC ;SAVE NEWSTT ON STACK + JR __GOTO_0 ;HAVE NOW GRAB LINE # PROPERLY + +; Routine at 18383 +; +; Used by the routine at EXEC_ONGOSUB. +DO_GOSUB: + PUSH HL ; Save code string for RETURN + PUSH HL ; And for GOSUB routine + LD HL,(CURLIN) ; Get current line + EX (SP),HL ; Into stack - Code string out + PUSH BC + LD A,TK_GOSUB ; "GOSUB" token + PUSH AF ; Save token + INC SP ; Don't save flags + EX DE,HL + DEC HL + LD (SAVTXT),HL + INC HL + LD (SAVSTK),SP + JP GONE4 + +; Routine at 18407 +; +; This entry point is used by the routine at __RUN. +RUNLIN: ; CONTINUE WITH SUBROUTINE + PUSH BC ; Save return address ; RESTORE RETURN ADDRESS OF "NEWSTT" + ; AND SEARCH. IN THE 8K WE START WHERE WE + ; ARE IF WE ARE GOING TO A FORWARD LOCATION. + +; This entry point is used by the routine at __IF. +__GOTO: + CALL ATOH ; ASCII number to DE binary ;PICK UP THE LINE # AND PUT IT IN [D,E] +; This entry point is used by the routine at __GOSUB. +__GOTO_0: + LD A,(CONSAV) ;GET TOKEN FOR LINE # BACK + CP PTRCON ;WAS IT A POINTER + EX DE,HL ;ASSUME SO + RET Z ;IF IT WAS, GO BACK TO NEWSTT WITH [H,L] AS TEXT PTR + CP LINCON ; Line number prefix + JP NZ,SN_ERR + EX DE,HL ;FLIP BACK IF NOT + PUSH HL ;SAVE CURRENT TEXT PTR ON STACK + LD HL,(CONTXT) ;GET POINTER TO RIGHT AFTER CONSTANT + EX (SP),HL ;SAVE ON STACK, RESTORE CURRENT TEXT PTR + CALL __REM ; Get end of line ;SKIP TO THE END OF THIS LINE + INC HL ; Start of next line ;POINT AT THE LINK BEYOND IT + PUSH HL ; Save Start of next line ;SAVE THE POINTER + LD HL,(CURLIN) ; Get current line ;GET THE CURRENT LINE # + RST DCOMPR ; Line after current? ;[D,E] CONTAINS WHERE WE ARE GOING, [H,L] CONTAINS THE CURRENT LINE # + ;SO COMPARING THEM TELLS US WHETHER TO START SEARCHING FROM WHERE + ;WE ARE OR TO START SEARCHING FROM THE BEGINNING OF TXTTAB + POP HL ; Restore Start of next line ; [H,L]=CURRENT POINTER + CALL C,SRCHLP ; Line is after current line ; SEARCH FROM THIS POINT + CALL NC,SRCHLN ; Line is before current line ; SEARCH FROM THE BEGINNING + ; -- ACTUALLY SEARCH AGAIN IF ABOVE SEARCH FAILED + JR NC,UL_ERR ; Err $08 - "Undefined line number" ;LINE NOT FOUND, DEATH + DEC BC ; Incremented after + LD A,PTRCON ;POINTER CONSTANT + LD (PTRFLG),A ;SET PTRFLG + POP HL ;GET SAVED POINTER TO RIGHT AFTER CONSTANT + CALL CONCH2 ;CHANGE LINE # TO PTR + LD H,B ; Set up code string address: [H,L]= POINTER TO THE START OF THE MATCHED LINE + LD L,C ; NOW POINTING AT THE FIRST BYTE OF THE POINTER TO THE START OF THE NEXT LINE + RET ; Line found: GO TO NEWSTT + +; entry for '?UL ERROR' +; +; Used by the routines at RUNLIN, L492A and __RESTORE. + ; --- START PROC L481C --- +UL_ERR: + LD E,$08 ; Err $08 - "Undefined line number" + JP ERROR ;C=MATCH, SO IF NO MATCH WE GIVE A "US" ERROR + + +; +; SEE "GOSUB" FOR THE FORMAT OF THE STACK ENTRY +; "RETURN" RESTORES THE LINE NUMBER AND TEXT POINTER ON THE STACK +; AFTER ELIMINATING ALL THE "FOR" ENTRIES IN FRONT OF THE "GOSUB" ENTRY +; +; Data block at 18465 +__RETURN: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HRETU ; Hook for 'RETURN' +ENDIF + LD (TEMP),HL + LD D,$FF ; Flag "GOSUB" search + CALL BAKSTK ; Look "GOSUB" block + CP TK_GOSUB ; TK_GOSUB, Token for 'GOSUB' + JR Z,__RETURN_0 + DEC HL +__RETURN_0: + LD SP,HL ; Kill all FORs in subroutine + LD (SAVSTK),HL + LD E,$03 ; Err $03 - "RETURN without GOSUB" (ERRRG) + JP NZ,ERROR ; Error if no "GOSUB" found + + POP HL ;GET LINE # "GOSUB" WAS FROM + LD A,H + OR L ; Return to line + JR Z,__RETURN_1 ; No - Return to line + LD A,(HL) + AND $01 + CALL NZ,RETURN_TRAP +__RETURN_1: + POP BC ; Get RETURN line number ;GET LINE # "GOSUB" WAS FROM + LD HL,NEWSTT ; Execution driver loop ;PUT IT INTO CURLIN + EX (SP),HL ; Into stack - Code string out ;PUT RETURN ADDRESS OF "NEWSTT" BACK ONTO THE STACK. + ;GET TEXT POINTER FROM "GOSUB" SKIP OVER SOME CHARACTERS + ;SINCE WHEN "GOSUB" STUCK THE TEXT POINTER ONTO THE STACK + ;THE LINE # ARGUMENT HADN'T BEEN READ IN YET. + EX DE,HL + LD HL,(TEMP) + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + JP NZ,__GOTO + LD H,B ; Put RETURN line number in HL + LD L,C + LD (CURLIN),HL ; Save as current ;PUT IT INTO CURLIN + EX DE,HL + + DEFB $3E ; "LD A,n" to Mask the next byte + +NXTDTA: + POP HL ;GET TEXT POINTER OFF STACK + + ; --- START PROC L485B --- +; DATA statement: find next DATA program line.. +; +; Used by the routines at __IF, FDTLP and __DEF. +__DATA: + DEFB $01 ; "LD BC," TO PICK UP ":" INTO C AND SKIP + DEFB ':' ;"DATA" TERMINATES ON ":" AND 0. ":" ONLY APPLIES IF QUOTES HAVE MATCHED UP + +; 'Go to next line' +; Used by 'REM', 'ELSE' (EXECUTED "ELSE"S ARE SKIPPED) and error handling code. +; +; NOTE: REM MUST PRESERVE [D,E] BECAUSE OF "GO TO" AND ERROR +; +__REM: + DEFB $0E ;"LD C," THE ONLY TERMINATOR IS ZERO + DEFB 0 ;0 = End of statement + + LD B,$00 ;INSIDE QUOTES THE ONLY TERMINATOR IS ZERO +NXTSTL: + LD A,C ; Statement and byte ;WHEN A QUOTE IS SEEN THE SECOND + LD C,B ;TERMINATOR IS TRADED, SO IN "DATA" + LD B,A ; Statement end byte ;COLONS INSIDE QUOTATIONS WILL HAVE NO EFFECT +NXTSTT: + DEC HL ;NOP THE INX H IN CHRGET +NXTSTT_0: + RST CHRGTB ; Get byte ;GET A CHAR + OR A ; End of line? ;ZERO IS ALWAYS A TERMINATOR + RET Z ; Yes - Exit + CP B ; End of statement? ;TEST FOR THE OTHER TERMINATOR + RET Z ; Yes - Exit + INC HL ; Next byte + CP '"' ; Literal string? ;IS IT A QUOTE? + JR Z,NXTSTL ; Yes - Look for another '"' ;IF SO TIME TO TRADE +; +; WHEN AN "IF" TAKES A FALSE BRANCH IT MUST FIND THE APPROPRIATE "ELSE" TO START EXECUTION AT. +; "DATA" COUNTS THE NUMBER OF "IF"S, IT SEES SO THAT THE "ELSE" CODE CAN MATCH "ELSE"S WITH "IF"S. +; THE COUNT IS KEPT IN [D] BECAUSE THEN S HAVE NO COLON +; MULTIPLE IFS CAN BE FOUND IN A SINGLE STATEMENT SCAN +; THIS CAUSES A PROBLEM FOR 8-BIT DATA IN UNQUOTED STRING DATA BECAUSE $IF MIGHT BE MATCHED. +; FIX IS TO HAVE FALSIF IGNORE CHANGES IN [D] IF ITS A DATA STATEMENT +; + INC A ;FUNCTION TOKEN? + JR Z,NXTSTT_0 ;THEN IGNORE FOLLOWING FN NUMBER + SUB TK_IF+1 ;IS IT AN "IF" + JR NZ,NXTSTT ;IF NOT, CONTINUE ON + CP B ;SINCE "REM" CAN'T SMASH [D,E] WE HAVE TO BE CAREFUL + ;SO ONLY IF B DOESN'T EQUAL ZERO WE INCREMENT D. (THE "IF" COUNT) + ADC A,D ;CARRY ON IF [B] NOT ZERO + LD D,A ;UPDATE [D] + JR NXTSTT ; Keep looking + +; Routine at 18555 +; LETCON IS LET ENTRY POINT WITH VALTYP-3 IN [A] +; BECAUSE GETYPR HAS BEEN CALLED +LETCON: + POP AF ;GET VALTYPE OFF STACK + ADD A,$03 ;MAKE VALTYPE CORRECT + JR __LET_0 ;CONTINUE + +; Routine at 18560 +__LET: + CALL GETVAR ;GET THE POINTER TO THE VARIABLE NAMED IN TEXT AND PUT IT INTO [D,E] + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB TK_EQUAL ;CHECK FOR "=" + LD (TEMP),DE ;MUST SET UP TEMP FOR "FOR" UP HERE SO WHEN + ;USER-FUNCTIONS CALL REDINP, TEMP DOESN'T GET CHANGED + PUSH DE + LD A,(VALTYP) ; Get data type + PUSH AF ; save type ;CALL REDINP, TEMP DOESN'T GET CHANGED + CALL EVAL ;GET THE VALUE OF THE FORMULA + POP AF ; Restore type ;GET THE VALTYP OF THE VARIABLE INTO [A] INTO FAC + +; This entry point is used by the routines at LETCON and __LINE. +__LET_0: + EX (SP),HL ;[H,L]=POINTER TO VARIABLE TEXT POINTER TO ON TOP OF STACK +; This entry point is used by the routine at __READ. +__LET_1: + LD B,A ;SAVE VALTYP + LD A,(VALTYP) ;GET PRESENT VALTYPE + CP B ;COMPARE THE TWO + LD A,B ;GET BACK CURRENT + JR Z,__LET_2 ;VALTYPE ALREADY SET UP, GO! + + CALL CHKTYP ;FORCE VALTPES TO BE [A]'S +LETCN4: + LD A,(VALTYP) ;GET PRESENT VALTYPE +__LET_2: + LD DE,FACCU ;ASSUME THIS IS WHERE TO START MOVEING + CP $02 ;IS IT? ; (Integer ?) + JR NZ,__LET_3 ;YES + LD DE,FACLOW ;NO, USE D.P. FAC +__LET_3: + PUSH HL ;SAVE THE POINTER AT THE VALUE POSITION + CP $03 ; String ? + JR NZ,LETNUM ;NUMERIC, SO FORCE IT AND COPY + + LD HL,(FACLOW) ; Pointer to string entry ;GET POINTER TO THE DESCRIPTOR OF THE RESULT + PUSH HL ; Save it on stack ;SAVE THE POINTER AT THE DESCRIPTOR + INC HL ; Skip over length + LD E,(HL) ; LSB of string address + INC HL + LD D,(HL) ; MSB of string address + LD HL,BUFFER ;IF THE DATA IS IN BUF, OR IN DISK RANDOM BUFFER, COPY. + RST DCOMPR ; Compare HL with DE.. is string before program? + JR C,__LET_5 ;SINCE BUF CHANGES ALL THE TIME GO COPY, IF DATA REALLY IS IN BUF + LD HL,(STREND) ;SEE IF IT POINTS INTO STRING SPACE + RST DCOMPR ;Is string literal in program? IF NOT DON'T COPY + POP DE ;GET BACK THE POINTER AT THE DESCRIPTOR + JR NC,DNTCPY ;DON'T COPY LITERALS + LD HL,DSCTMP-1 ;NOW, SEE IF ITS A VARIABLE + RST DCOMPR ;BY SEEING IF THE DESCRIPTOR IS IN THE TEMPORARY STORAGE AREA (BELOW DSCTMP) + JR C,__LET_4 + LD HL,TEMPST-1 + RST DCOMPR ; Compare HL with DE. + JR C,DNTCPY ;DON'T COPY IF ITS NOT A VARIABLE + +__LET_4: + DEFB $3E ; "LD A,n" to Mask the next byte + +__LET_5: + POP DE ;GET THE POINTER TO THE DESCRIPTOR IN [D,E] + + CALL FRETMS ;FREE UP A TEMORARY POINTING INTO BUF (Back to last tmp-str entry) + EX DE,HL ;STRCPY COPIES [H,L] + CALL STRCPY ;COPY VARIABLES IN STRING SPACE OR STRINGS WITH DATA IN BUF + +; a.k.a MVSTPT +DNTCPY: + CALL FRETMS ;FREE UP THE TEMPORARY WITHOUT FREEING UP ANY STRING SPACE (Back to last tmp-str entry) + EX (SP),HL ;[H,L]=PLACE TO STORE THE DESCRIPTOR + ;LEAVE A NONSENSE ENTRY ON THE STACK, SINCE THE "POP DE" DOESN'T EVER MATTER IN THIS CASE +LETNUM: + CALL VMOVE ;COPY A DESCRIPTOR OR A VALUE + POP DE ;FOR "FOR" POP OFF A POINTER AT THE LOOP VARIABLE INTO [D,E] + POP HL ;GET THE TEXT POINTER BACK + RET + +; 'ON' BASIC instruction +; ON..GOTO, ON ERROR GOTO CODE +; +; Data block at 18660 +__ON: + CP TK_ERROR ;"ON...ERROR"? + JR NZ,ON_OTHER ;NO. + RST CHRGTB ;GET NEXT THING + RST SYNCHR + DEFB TK_GOTO ;MUST HAVE ...GOTO + CALL ATOH ;GET FOLLOWING LINE # + LD A,D ;IS LINE NUMBER ZERO? + OR E ;SEE + JR Z,__ON_0 ;IF ON ERROR GOTO 0, RESET TRAP + CALL FNDLN1 ;SEE IF LINE EXISTS (SAVE [H,L] ON STACK) ..Sink HL in stack and get first line number + LD D,B ;GET POINTER TO LINE IN [D,E] + LD E,C ;(LINK FIELD OF LINE) + POP HL ;RESTORE [H,L] + JP NC,UL_ERR ;ERROR IF LINE NOT FOUND.. Err $08 - "Undefined line number" +__ON_0: + LD (ONELIN),DE ;SAVE POINTER TO LINE OR ZERO IF 0. + RET C ;YOU WOULDN'T BELIEVE IT IF I TOLD YOU + LD A,(ONEFLG) ;ARE WE IN AN "ON...ERROR" ROUTINE? + OR A ;SET CONDITION CODES + LD A,E ;WANT AN EVEN STACK PTR. FOR 8086 + RET Z ;IF NOT, HAVE ALREADY DISABLED TRAPPING. + LD A,(ERRFLG) ;GET ERROR CODE + LD E,A ;INTO E. + JP ERRESM ;FORCE THE ERROR TO HAPPEN + + ; ON KEY, STOP, SPRITE... +ON_OTHER: + CALL ON_OPTIONS ; ON_KEY, ON_STOP, ON_SPRITE, ON_TRIG, ON_INTERVAL... + JR C,NTOERR ; AN "ON ... GOSUB" PERHAPS? + + PUSH BC + RST CHRGTB ; Gets next character (or token) from BASIC text. + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB TK_GOSUB ; ..must be GOSUB. Otherwise error + XOR A + +L4917: + POP BC + PUSH BC + CP C + JP NC,SN_ERR ; ?SN Err + PUSH AF + CALL ATOH ; Get specified line number + LD A,D + OR E + JR Z,L492E + CALL FNDLN1 ; Sink HL in stack and get first line number + LD D,B + LD E,C ; DE=BC + +; Routine at 18730 +L492A: + POP HL + JP NC,UL_ERR ; Err $08 - "Undefined line number" + +L492E: + POP AF + POP BC + PUSH AF + ADD A,B + PUSH BC + CALL L785C ; (ON key.. ?) + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + POP BC + POP DE + RET Z + PUSH BC + PUSH DE + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + POP AF + INC A + JR L4917 + +; Not 'ON ERROR' +NTOERR: + CALL GETINT ; Get integer 0-255 ;GET VALUE INTO [E] + LD A,(HL) ; Get "GOTO" or "GOSUB" token ;GET THE TERMINATOR BACK + LD B,A ; Save in B ;SAVE THIS CHARACTER FOR LATER + CP TK_GOSUB ; "GOSUB" token? ;AN "ON ... GOSUB" PERHAPS? + JR Z,ONGO ; Yes - Find line number ;YES, SOME FEATURE USE + RST SYNCHR ; Make sure it's "GOTO" + DEFB TK_GOTO ; TK_GOTO: "GOTO" token ;OTHERWISE MUST BE "GOTO" + DEC HL ; Cancel increment ;BACK UP CHARACTER POINTER + +ONGO: + LD C,E ; Integer of branch value +ONGOLP: + DEC C ; Count branches + LD A,B ; Get "GOTO" or "GOSUB" token + JP Z,ONJMP ; Go to that line if right one + CALL ATOH2 ; Get line number to DE + CP ',' ; Another line number? ;A COMMA + RET NZ ; No - Drop through, IF A COMMA DOESN'T DELIMIT THE END OF THE + ; CURRENT LINE #, WE MUST BE THE END OF THE LINE + JR ONGOLP ; Yes - loop ;CONTINUE GOBBLING LINE #S + +; Data block at 18781 +__RESUME: + LD A,(ONEFLG) ;GET FLAG + OR A ;TRAP ROUTINE. + JR NZ,__RESUME_0 ;No error, continue + LD (ONELIN),A + LD (ONELIN+1),A + JP RW_ERR ; Err 16 - "RESUME without error" + +__RESUME_0: + INC A ;MAKE A=0 + LD (ERRFLG),A ;CLEAR ERROR FLAG SO ^C DOESN'T GIVE ERROR + LD A,(HL) ;GET CURRENT CHAR BACK + CP TK_NEXT ;RESUME NEXT? + JR Z,RESNXT ;YUP. + CALL ATOH ;GET FOLLOWING LINE # + RET NZ ;SHOULD TERMINATE + LD A,D ;IS LINE NUMBER ZERO? + OR E ;TEST + JR Z,RES_NOLINE + CALL __GOTO_0 ;DO A GOTO THAT LINE. + XOR A + LD (ONEFLG),A ; Clear 'on error' flag + RET + +RESNXT: + RST CHRGTB ;MUST TERMINATE + RET NZ ;BLOW HIM UP + JR RESTXT + +RES_NOLINE: + XOR A + LD (ONEFLG),A ; Clear 'on error' flag + INC A ;SET NON ZERO CONDITION CODES +RESTXT: + LD HL,(ERRTXT) ;GET POINTER INTO LINE. + EX DE,HL ;SAVE ERRTXT IN [D,E] + LD HL,(ERRLIN) ;GET LINE # + LD (CURLIN),HL ;SAVE IN CURRENT LINE # + EX DE,HL + RET NZ ;GO TO NEWSTT IF JUST "RESUME" + LD A,(HL) ;GET ":" OR LINE HEADER + OR A ;SET CC + JR NZ,NOTBGL ;#0 MEANS MUST BE ":" + INC HL ;SKIP HEADER + INC HL + INC HL + INC HL +NOTBGL: + INC HL ;POINT TO START OF THIS STATEMENT + XOR A + LD (ONEFLG),A ; Clear 'on error' flag + JP __DATA ;GET NEXT STMT + + +; 'ERROR' BASIC command +; +; THIS IS THE ERROR STATEMENT WHICH FORCES +; AN ERROR OF TYPE TO OCCUR +; MUST BE .GE. 0 AND .LE. 255 +; +; Routine at 18858 +__ERROR: + CALL GETINT ;GET THE PARAM + RET NZ ;SHOULD HAVE TERMINATED + OR A ;ERROR CODE 0? + JP Z,FC_ERR ;YES, ERROR IN ITSELF, Err $05 - "Illegal function call" + JP ERROR ;FORCE AN ERROR + + +; AUTO [[,]] +; +; THE AUTO [BEGGINNING LINE[,[INCREMENT]]] +; COMMAND IS USED TO AUTOMATICALLY GENERATE LINE NUMBERS FOR LINES TO BE INSERTED. +; BEGINNING LINE IS USED TO SPECIFY THE INITAL LINE (10 IS ASSUMED IF OMMITED) +; AND THE INCREMENT IS USED TO SPECIFY THE INCREMENT USED TO GENERATE THE NEXT LINE #. +; IF ONLY A COMMA IS USED AFTER THE BEGGINING LINE, THE OLD INCREMENT IS USED. +; +; Routine at 18869 +__AUTO: + LD DE,10 ;ASSUME INITIAL LINE # OF 10 + PUSH DE ;SAVE IT + JR Z,__AUTO_0 ;IF END OF COMMAND USE 10,10 + CALL LNUM_PARM ;GET LINE #, ALLOW USE OF . FOR CURRENT LINE + EX DE,HL ;GET TXT PTR IN [D,E] + EX (SP),HL ;PUT INIT ON STACK, GET 10 IN [H,L] + JR Z,__AUTO_1 ;IF TERMINATOR, USE INC OF 10 + EX DE,HL ;GET TEXT PTR BACK IN [H,L] + RST SYNCHR + DEFB ',' ;COMMA MUST FOLLOW + LD DE,(AUTINC) ;GET PREVIOUS INC + JR Z,__AUTO_0 ;USE PREVIOUS INC IF TERMINATOR + CALL ATOH ;GET INC + JP NZ,SN_ERR ;SHOULD HAVE FINISHED. +__AUTO_0: + EX DE,HL ;GET INC IN [H,L] +__AUTO_1: + LD A,H ;SEE IF ZERO + OR L + JP Z,FC_ERR ;ZERO INC GIVES FCERR ( Err $05 - "Illegal function call" ) + LD (AUTINC),HL ;SAVE INCREMENT + LD (AUTFLG),A ;SET FLAG TO USE AUTO IN MAIN CODE.; AUTO mode ? + POP HL ;GET INITIAL LINE # + LD (AUTLIN),HL ;SAVE IN INTIAL LINE + POP BC ;GET RID OF NEWSTT ADDR + JP PROMPT ;JUMP INTO MAIN CODE (FOR REST SEE AFTER MAIN:) + + +; 'IF'..'THEN' BASIC code +; Routine at 18917 +__IF: + CALL EVAL ; Evaluate expression (FORMULA) + LD A,(HL) ; Get token + CP ',' ; "," GET TERMINATING CHARACTER OF FORMULA + CALL Z,__CHRGTB ; IF SO SKIP IT + CP TK_GOTO ; "GOTO" token? + JR Z,IFGO ; Yes - Get line + RST SYNCHR ; Make sure it's "THEN" + DEFB TK_THEN ; "THEN" token + DEC HL ; Cancel increment +IFGO: + PUSH HL ; SAVE THE TEXT POINTER + CALL VSIGN ; Test state of expression + POP HL ; GET BACK THE TEXT POINTER + JR Z,FALSE_IF ; False - Drop through, HANDLE POSSIBLE "ELSE" +DOCOND: + RST CHRGTB ; PICK UP THE FIRST LINE # CHARACTER + RET Z ; Go to NEWSTT (RUNCNT) if end of STMT (RETURN FOR "THEN :" OR "ELSE :") + CP LINCON ; Line number prefix ? + JP Z,__GOTO ; Yes - GOTO that line + CP PTRCON ; POINTER CONSTANT + JP NZ,ONJMP ; Otherwise do statement (EXECUTE STATEMENT, NOT GOTO) + LD HL,(CONLO) ; GET TEXT POINTER + RET ; FETCH NEW STATMENT + +; +; "ELSE" HANDLER. HERE ON FALSE "IF" CONDITION +; +FALSE_IF: + LD D,$01 ;NUMBER OF "ELSE"S THAT MUST BE SEEN. + ;"DATA" INCREMENTS THIS COUNT EVERY TIME AN "IF" IS SEEN +SKPMRF: + CALL __DATA ;SKIP A STATEMENT + ;":" IS STUCK IN FRONT OF "ELSE"S SO THAT "DATA" WILL STOP BEFORE "ELSE" CLAUSES + OR A ;END OF LINE? + RET Z ;IF SO, NO "ELSE" CLAUSE + RST CHRGTB ;SEE IF WE HIT AN "ELSE" + CP TK_ELSE + JR NZ,SKPMRF ;NO, STILL IN THE "THEN" CLAUSE + DEC D ;DECREMENT THE NUMBER OF "ELSE"S THAT MUST BE SEEN + JR NZ,SKPMRF ;SKIP MORE IF HAVEN'T SEEN ENOUGH + JR DOCOND ;FOUND THE RIGHT "ELSE" -- GO EXECUTE + +; Routine at 18973 +__LPRINT: + LD A,$01 ;SAY NON ZERO + LD (PRTFLG),A ;SAVE AWAY + JR MRPRNT ; a.k.a. NEWCHR + +; Data block at 18980 +__PRINT: + LD C,$02 ;SETUP OUTPUT FILE + CALL FILGET ; Get stream number (C=default #channel) +MRPRNT: + DEC HL ; DEC 'cos GETCHR INCs + RST CHRGTB ; GET ANOTHER CHARACTER + CALL Z,OUTDO_CRLF ; CRLF if just PRINT (IF END WITHOUT PUNCTUATION) +PRNTLP: + JP Z,FINPRT ; End of list - Exit (FINISH BY RESETTING FLAGS) + ; IN WHICH CASE A TERMINATOR DOES NOT MEAN WE SHOULD TYPE A CRLF BUT JUST RETURN + CP TK_USING ; USING ;IS IT "PRINT USING" ? + JP Z,USING ;IF SO, USE A SPECIAL HANDLER + CP TK_TAB ; "TAB(" token? + JP Z,__TAB ; Yes - Do TAB routine ;THE TAB FUNCTION? + CP TK_SPC ; "SPC(" token? + JP Z,__TAB ; Yes - Do SPC routine ;THE SPC FUNCTION? + PUSH HL ; Save code string address ;SAVE THE TEXT POINTER + CP ',' ; Comma? ;IS IT A COMMA? + JR Z,DOCOM ; Yes - Move to next zone + CP ';' ; Semi-colon? ;IS IT A ";" + JP Z,NEXITM ; Do semi-colon routine + POP BC ; Code string address to BC ;GET RID OF OLD TEXT POINTER + CALL EVAL ; Evaluate expression ;EVALUATE THE FORMULA + PUSH HL ; Save code string address ;SAVE TEXT POINTER + RST GETYPR ; Get the number type (FAC) ;SEE IF WE HAVE A STRING + JR Z,PRNTST ; JP If string type ;IF SO, PRINT SPECIALY + CALL FOUT ; Convert number to text ;MAKE A NUMBER INTO A STRING + CALL CRTST ; Create temporary string ;MAKE IT A STRING + LD (HL),' ' ; Followed by a space ;PUT A SPACE AT THE END + LD HL,(FACLOW) ; Get length of output ;AND INCREASE SIZE BY 1 + INC (HL) ; Plus 1 for the space ;SIZE BYTE IS FIRST IN DESCRIPTOR + +; Output string contents (a.k.a. STRDON) +; USE FOLDING FOR STRINGS AND #S +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HPRTF ; Hook 1 for "PRINT" +ENDIF + CALL ISFLIO ;DISK OUTPUT? IF SO, DON'T EVER FORCE A CRLF + JR NZ,PRNTNB + LD HL,(FACLOW) ;GET THE POINTER + LD A,(PRTFLG) + OR A + JR Z,ISTTY ;LPT OR TTY? + LD A,(LPTPOS) ;GET WIDTH OF PRINTER + ADD A,(HL) + CP $FF ;IS IT INFINITE? (255="infinite") + JR LINCH2 ;THEN JUST PRINT + +ISTTY: + LD A,(LINLEN) ; Get width of line + LD B,A ; To B + LD A,(TTYPOS) ; Get cursor position + ADD A,(HL) ; Add length of string + DEC A ; Adjust it + CP B ; Will output fit on this line? +LINCH2: + JR C,PRNTNB ; START ON A NEW LINE + CALL Z,CRFIN ; No - CRLF first + CALL NZ,OUTDO_CRLF +PRNTNB: + CALL PRS1 ; Output string at (HL) + OR A ; Skip CALL by resetting "Z" flag + +; Output string contents (a.k.a. STRDON) +; USE FOLDING FOR STRINGS AND #S +; +; Used by the routine at __PRINT. +PRNTST: + CALL Z,PRS1 ; Output string at (HL) + POP HL ; Restore code string address + JP MRPRNT ; See if more to PRINT + +; "," found in PRINT list +DOCOM: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HCOMP ; Hook 2 for "PRINT" (comma found in PRINT command) +ENDIF + LD BC,$0008 ;(NMLO.C) if file output, SPECIAL PRINT POSITION SHOULD BE FETCHED FROM FILE DATA + LD HL,(PTRFIL) + ADD HL,BC ;[H,L] POINT AT POSITION.. + CALL ISFLIO ;OUTPUTING INTO A FILE? + LD A,(HL) ;IF FILE IS ACTIVE + JR NZ,ZONELP + LD A,(PRTFLG) ;OUTPUT TO THE LINE PRINTER? + OR A ;NON-ZERO MEANS YES + JR Z,ISCTTY ;NO, DO TELETYPE COMMA + LD A,(LPTPOS) ;OUTPUT TO THE LINE PRINTER? + CP $EE ;CHECK IF MAX COMMA FIELDS + JR CHKCOM ;USE TELETYPE CHECK + +ISCTTY: + LD A,(CLMLST) ;Column space, POSITION BEYOND WHICH THERE ARE NO MORE COMMA FIELDS + LD B,A + LD A,(TTYPOS) ;GET TELETYPE POSITION + CP B +CHKCOM: + CALL NC,OUTDO_CRLF ;TYPE CRLF + JP NC,NEXITM ;AND QUIT IF BEYOND THE LAST COMMA FIELD + +; a.k.a MORCOM +ZONELP: + SUB CLMWID ; Next zone of 14 characters + JR NC,ZONELP ; Repeat if more zones + CPL ; Number of spaces to output + ; WE WANT TO FILL THE PRINT POSITION OUT TO AN EVEN CLMWID, + ; SO WE PRINT CLMWID-[A] MOD CLMWID SPACES + JR ASPCS ; Output them ;GO PRINT [A]+1 SPACES + + +; __TAB( & __SPC( +__TAB: + PUSH AF ; Save token ;REMEMBER IF [A]=SPCTK OR TABTK + CALL FNDNUM ; Numeric argument (0..255) ;EVALUATE THE ARGUMENT + RST SYNCHR ; Make sure ")" follows + DEFB ')' + DEC HL ; Back space on to ")" + POP AF ; Restore token ;SEE IF ITS SPC OR TAB + SUB TK_SPC ; Was it "SPC(" ? ;IF SPACE LEAVE ALONE + PUSH HL ; Save code string address + JR Z,DOSPC ; Yes - Do "E" spaces + +; TAB( + LD BC,$0008 ;(NMLO.C) if file output, SPECIAL PRINT POSITION SHOULD BE FETCHED FROM FILE DATA + LD HL,(PTRFIL) + ADD HL,BC ;[H,L] POINT AT POSITION + CALL ISFLIO ;OUTPUTING INTO A FILE? (IF SO, [PTRFIL] .NE. 0) + LD A,(HL) ;IF FILE IS ACTIVE + JR NZ,DOSPC ;DO TAB CALCULATION NOW + LD A,(PRTFLG) ;LINE PRINTER OR TTY? + OR A ;NON-ZERO MEANS LPT + JP Z,TTYIST + LD A,(LPTPOS) ; Get current printer position ;GET LINE PRINTER POSITION + JR DOSPC ;GET THE LINE LENGTH + +TTYIST: + LD A,(TTYPOS) ; Get current position ;GET TELETYPE PRINT POSITION + +; SPC( +DOSPC: + CPL ; Number of spaces to print to ;PRINT [E]-[A] SPACES + ADD A,E ; Total number to print + JR NC,NEXITM ; TAB < Current POS(X) +ASPCS: + INC A ; Output A spaces + LD B,A ; Save number to print ;[B]=NUMBER OF SPACES TO PRINT + LD A,' ' ; Space ;[A]=SPACE +SPCLP: + RST OUTDO ; Output character in A ;PRINT [A] + DJNZ SPCLP ; Repeat if more ;DECREMENT THE COUNT + +; Move to next item in the PRINT list +NEXITM: + POP HL ; Restore code string address ;PICK UP TEXT POINTER + RST CHRGTB ; Get next character ;AND THE NEXT CHARACTER + ;AND SINCE WE JUST PRINTED SPACES, DON'T CALL CRDO IF IT'S THE END OF THE LINE + JP PRNTLP ; More to print + +; This entry point is used by the routines at LTSTND, L61C4 and L628E. +; +;FINISH 'PRINT' BY RESETTING FLAGS +;(IN WHICH CASE A TERMINATOR DOES NOT MEAN WE SHOULD TYPE A CRLF BUT JUST RETURN) +FINPRT: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HFINP ; Hook 3 for "PRINT" +ENDIF + XOR A + LD (PRTFLG),A + PUSH HL ;SAVE THE TEXT POINTER + LD H,A ;[H,L]=0 + LD L,A + LD (PTRFIL),HL ;ZERO OUT PTRFIL (disabling eventual output redirection) + POP HL ;GET BACK THE TEXT POINTER + RET + +; Routine at 19214 +__LINE: + CP TK_INPUT ; ? Token for INPUT to support the "LINE INPUT" statement ? + JP NZ,LINE ; No, this is a real graphics command ! + + ; LINE INPUT + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB TK_INPUT + CP '#' ;SEE IF THERE IS A FILE NUMBER + JP Z,LINE_INPUT ;DO DISK INPUT LINE + CALL __INPUT_0 ;PRINT QUOTED STRING IF ONE + CALL GETVAR ;READ STRING TO STORE INTO + CALL TSTSTR ;MAKE SURE ITS A STRING + PUSH DE ;SAVE POINTER AT VARIABLE + PUSH HL ;SAVE TEXT POINTER + CALL INLIN ;READ A LINE OF INPUT + POP DE ;GET TEXT POINTER + POP BC ;GET POINTER AT VARIABLE + JP C,INPBRK ;IF CONTROL-C, STOP + PUSH BC ;SAVE BACK VARIABLE POINTER + PUSH DE ;SAVE TEXT POINTER + LD B,$00 ;SETUP ZERO AS ONLY TERMINATOR + CALL QTSTR_0 ;LITERALIZE THE INPUT + POP HL ;RESTORE [H,L]=TEXT POINTER + LD A,$03 ;SET THREE FOR STRING + JP __LET_0 ;DO THE ASSIGNMENT + +; Message at 19259 +REDO_MSG: + DEFM "?Redo from start" + DEFB CR, LF, $00 + +; +; a.k.a. BADINP +; HERE WHEN PASSING OVER STRING LITERAL IN SUBSCRIPT OF VARIABLE IN INPUT LIST +; ON THE FIRST PASS OF INPUT CHECKING FOR TYPE MATCH AND NUMBER +; +; This entry point is used by the routine at LTSTND. +SCNSTR: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HTRMN ; Hook for "READ/INPUT" error +ENDIF + LD A,(FLGINP) ;WAS IT READ OR INPUT? + OR A ;ZERO=INPUT + JP NZ,DATSNR ;GIVE ERROR AT DATA LINE + POP BC ;GET RID OF THE POINTER INTO THE VARIABLE LIST + LD HL,REDO_MSG + CALL PRS ;PRINT "?REDO FROM START" TO NEWSTT POINTING AT THE START OF + LD HL,(SAVTXT) ;START ALL OVER: GET SAVED TEXT POINTER + RET ;GO BACK TO NEWSTT + +; Routine at 19298 +; INPUT #, set stream number (input channel) +; "set input channel" +; +; Used by the routine at __INPUT. +FILSTI: ; deal with '#' argument + CALL FILINP ; Get stream number (default #channel=1) + PUSH HL ;PUT THE TEXT POINTER ON THE STACK + LD HL,BUFMIN ;POINT AT A COMMA + JP INPUT_CHANNEL ; 'INPUT' from a stream + +; Routine at 19308 +__INPUT: + CP '#' + JR Z,FILSTI ; "set input channel" + PUSH HL + PUSH AF + CALL TOTEXT + POP AF + POP HL + LD BC,NOTQTI ;WHERE TO GO + PUSH BC ;WHEN DONE WITH QUOTED STRING + +; This entry point is used by the routine at __LINE. +__INPUT_0: + CP '"' ; Is there a prompt string? ;IS IT A QUOTE? + LD A,$00 ; Clear A and leave flags ;BE TALKATIVE + RET NZ ; not a quote.. JUST RETURN + CALL QTSTR ; MAKE THE MESSAGE A STRING + RST SYNCHR ; Check for ";" after prompt + DEFB ';' ; MUST END WITH SEMI-COLON + PUSH HL ; Save code string address ;REMEMBER WHERE IT ENDED + CALL PRS1 ; Output prompt string + POP HL ; Restore code string address ;GET BACK SAVED TEXT PTR + RET ;ALL DONE + +; Routine at 19339 +NOTQTI: + PUSH HL + CALL QINLIN ; User interaction with question mark, HL = resulting text + POP BC ; Restore code string address ;TAKE OFF SINCE MAYBE LEAVING + JP C,INPBRK ;IF EMPTY LEAVE + INC HL + LD A,(HL) + OR A + DEC HL + PUSH BC ; Re-save code string address ;PUT BACK SINCE DIDN'T LEAVE +; +; THIS IS THE FIRST PASS DICTATED BY ANSI REQUIRMENT THAN NO VALUES BE ASSIGNED +; BEFORE CHECKING TYPE AND NUMBER. THE VARIABLE LIST IS SCANNED WITHOUT EVALUATING +; SUBSCRIPTS AND THE INPUT IS SCANNED TO GET ITS TYPE. NO ASSIGNMENT IS DONE +; + JP Z,NXTDTA ; just before '__DATA" + + +; This entry point is used by the routine at FILSTI. +; 'INPUT' from a stream +INPUT_CHANNEL: + LD (HL),',' ;SETUP COMMA AT BUFMIN + JR INPCON + +; Routine at 19359 +__READ: + PUSH HL ; Save code string address ;SAVE THE TEXT POINTER + LD HL,(DATPTR) ; Next DATA statement ;GET LAST DATA LOCATION + + DEFB $F6 ; OR AFh ..Flag "READ" ;"ORI" TO SET [A] NON-ZERO + +INPCON: + XOR A ; Flag "INPUT" ;SET FLAG THAT THIS IS AN INPUT + LD (FLGINP),A ; Save "READ"/"INPUT" flag ;STORE THE FLAG +; +; IN THE PROCESSING OF DATA AND READ STATEMENTS: +; ONE POINTER POINTS TO THE DATA (IE THE NUMBERS BEING FETCHED) +; AND ANOTHER POINTS TO THE LIST OF VARIABLES +; +; THE POINTER INTO THE DATA ALWAYS STARTS POINTING TO A +; TERMINATOR -- A , : OR END-OF-LINE +; + EX (SP),HL ; Get code str' , Save pointer ;[H,L]=VARIABLE LIST POINTER <> DATA POINTER GOES ON THE STACK + + DEFB $01 ; "LD BC,nn" to jump over the next word without executing it + +LOPDT2: + RST SYNCHR ; Check for comma between items + DEFB ',' ; MAKE SURE THERE IS A "," + +; a.k.a. LOPDAT +;GTVLUS: <- the 'DEFB' trick above makes this jump unnecessary + CALL GETVAR ;READ THE VARIABLE LIST AND GET THE POINTER TO A VARIABLE INTO [D,E] + ;PUT THE VARIABLE LIST POINTER ONTO THE STACK AND TAKE THE DATA LIST POINTER OFF + EX (SP),HL +; +; NOTE AT THIS POINT WE HAVE A VARIABLE WHICH WANTS DATA +; AND SO WE MUST GET DATA OR COMPLAIN +; + PUSH DE ; SAVE THE POINTER TO THE VARIABLE WE ARE ABOUT TO SET UP WITH A VALUE + ;SINCE THE DATA LIST POINTER ALWAYS POINTS AT A TERMINATOR LETS READ THE TERMINATOR INTO [A] AND SEE WHAT IT IS + LD A,(HL) + CP ',' ; Comma? + JR Z,SCNVAL ; Yes - Get another value ;A COMMA SO A VALUE MUST FOLLOW + LD A,(FLGINP) ; Is it READ? ;SEE WHAT TYPE OF STATEMENT THIS WAS + OR A + JP NZ,FDTLP ; Yes - Find next DATA stmt ;SEARCH FOR ANOTHER DATA STATEMENT + + LD A,'?' ; More INPUT needed + RST OUTDO ; Output character + CALL QINLIN ; Get INPUT with prompt, HL = resulting text + POP DE + POP BC + JP C,INPBRK + INC HL + LD A,(HL) + DEC HL + OR A + PUSH BC + JP Z,NXTDTA ; just before '__DATA" + PUSH DE + +; This entry point is used by the routine at FDTLP. +SCNVAL: + CALL ISFLIO ; SEE IF A FILE READ + JP NZ,FILIND ; IF SO, SPECIAL HANDLING + RST GETYPR ; IS IT A STRING? + PUSH AF ; SAVE THE TYPE INFORMATION +; +; IF NUMERIC, USE FIN TO GET IT +; ONLY THE VARAIBLE TYPE IS CHECKED SO AN UNQUOTED STRING CAN BE ALL DIGITS +; + JR NZ,INPBIN ; If numeric, convert to binary + RST CHRGTB ; Gets next character + LD D,A ; Save input character ;ASSUME QUOTED STRING + LD B,A ; Again ;SETUP TERMINATORS + CP '"' ; Start of literal sting? ;QUOTE ? + JR Z,STRENT ; Yes - Create string entry ;TERMINATORS OK + LD A,(FLGINP) ; "READ" or "INPUT" ? ;INPUT SHOULDN'T TERMINATE ON ":" + OR A ;SEE IF READ OR INPUT + LD D,A ; Save 00 if "INPUT" ;SET D TO ZERO FOR INPUT + JR Z,ITMSEP ; "INPUT" - End with 00 + LD D,':' ; "DATA" - End with 00 or ":" ;UNQUOTED STRING TERMINATORS +ITMSEP: + LD B,',' ; Item separator + ; NOTE: ANSI USES [B]=44 AS A FLAG TO TRIGGER TRAILING SPACE SUPPRESSION + + DEC HL ; Back space for DTSTR + ; BACKUP SINCE START CHARACTER MUST BE INCLUDED + ; IN THE QUOTED STRING CASE WE DON'T WANT TO + ; INCLUDE THE STARTING OR ENDING QUOTE + +; a.k.a. NOWGET +STRENT: + ;MAKE A STRING DESCRIPTOR FOR THE VALUE AND COPY IF NECESSARY + CALL DTSTR ; Get string terminated by D + +DOASIG: + POP AF ;POP OFF THE TYPE INFORMATION + ADD A,$03 ;MAKE VALTYPE CORRECT + EX DE,HL ;[D,E]=TEXT POINTER + LD HL,LTSTND ;RETURN LOC + EX (SP),HL ;[H,L]=PLACE TO STORE VARIABLE VALUE + PUSH DE ;TEXT POINTER GOES ON + JP __LET_1 ;DO ASSIGNMENT + +; a.k.a. NUMINS +INPBIN: + RST CHRGTB ; Gets next character (or token) from BASIC text. + LD BC,DOASIG ; ASSIGNMENT IS COMPLICATED EVEN FOR NUMERICS SO USE THE "LET" CODE + PUSH BC ; SAVE ON STACK + JP FIN_DBL ; ELSE CALL SPECIAL ROUTINE WHICH EXPECTS DOUBLES + +; Routine at 19461 +LTSTND: + DEC HL ; DEC 'cos GETCHR INCs + RST CHRGTB ; Get next character + JR Z,MORDT ; End of line - More needed? + CP ',' ; Another value? + JP NZ,SCNSTR ; No - Bad input ;ENDED PROPERLY? +MORDT: + EX (SP),HL ; Get code string address + DEC HL ; DEC 'cos GETCHR INCs ;LOOK AT TERMINATOR + RST CHRGTB ; Get next character ;AND SET UP CONDITION CODES + JP NZ,LOPDT2 ; More needed - Get it ;NOT ENDING, CHECK FOR COMMA AND GET + ;ANOTHER VARIABLE TO FILL WITH DATA + POP DE ; Restore DATA pointer ;POP OFF THE POINTER INTO DATA + LD A,(FLGINP) ; "READ" or "INPUT" ? ;FETCH THE STATEMENT TYPE FLAG + OR A + ;INPUT STATEMENT + EX DE,HL ; DATA pointer to HL + JP NZ,UPDATA ; Update DATA pointer if "READ" ;UPDATE DATPTR + PUSH DE ; Save code string address ;SAVE THE TEXT POINTER + CALL ISFLIO ; Tests if I/O to device is taking place + JR NZ,LTSTND_1 + LD A,(HL) + OR A + LD HL,EXTRA_MSG ; "?Extra ignored" + CALL NZ,PRS +LTSTND_1: + POP HL ; Restore code string address ;GET BACK THE TEXT POINTER + JP FINPRT + +; Data block at 19503 +EXTRA_MSG: + DEFM "?Extra ignored" + DEFB CR, LF, $00 + + +; Find next DATA statement +; +; THE SEARCH FOR DATA STATMENTS IS MADE BY USING THE EXECUTION CODE +; FOR DATA TO SKIP OVER STATEMENTS. THE START WORD OF EACH STATEMENT +; IS COMPARED WITH $DATA. EACH NEW LINE NUMBER +; IS STORED IN DATLIN SO THAT IF AN ERROR OCCURS WHILE READING +; DATA THE ERROR MESSAGE WILL GIVE THE LINE NUMBER OF THE +; ILL-FORMATTED DATA +; +; a.k.a. DATLOP +; Used by the routine at __READ. +FDTLP: + CALL __DATA ; Get next statement + OR A ; End of line? + JR 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,$04 ; Err $04 - "Out of DATA" (?OD Error) ;NO DATA IS ERROR ERROD + JP Z,ERROR ; Yes - Out of DATA ;IF SO COMPLAIN + INC HL ;SKIP PAST LINE # + LD E,(HL) ; LSB of line number ;GET DATA LINE # + INC HL + LD D,(HL) ; MSB of line number + LD (DATLIN),DE ; Set line of current DATA item +FANDT: + RST CHRGTB ; Get next character ;GET THE STATEMENT TYPE + CP TK_DATA ; TK_DATA, "DATA" token ;IS IS "DATA"? + JR NZ,FDTLP ; No "DATA" - Keep looking ;NOT DATA SO LOOK SOME MORE + JP SCNVAL ; Found - Convert input ;CONTINUE READING + + + ; --- START PROC L4C5F --- +; +; FORMULA EVALUATION CODE +; +; THE FORMULA EVALUATOR STARTS WITH [H,L] POINTING TO THE FIRST CHARACTER OF THE FORMULA. +; AT THE END [H,L] POINTS TO THE TERMINATOR. +; THE RESULT IS LEFT IN THE FAC. +; ON RETURN [A] DOES NOT REFLECT THE TERMINATING CHARACTER +; +; THE FORMULA EVALUATOR USES THE OPERATOR TABLE (OPTAB) TO DETERMINE +; PRECEDENCE AND DISPATCH ADDRESSES FOR EACH OPERATOR. +; +; A TEMPORARY RESULT ON THE STACK HAS THE FOLLOWING FORMAT: +; - THE ADDRESS OF 'RETAOP' -- THE PLACE TO RETURN ON COMPLETION OF OPERATOR APPLICATION +; - THE FLOATING POINT TEMPORARY RESULT +; - THE ADDRESS OF THE OPERATOR ROUNTINE +; - THE PRECEDENCE OF THE OPERATOR +; +; TOTAL 10 BYTES +; +FRMEQL: + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB TK_EQUAL ; Token for '=' ;CHECK FOR EQUAL SIGN + ;EVALUATE FORMULA AND RETURN + DEFB 1 ; "LD BC,n" to mask the next 2 lines + +; Chk Syntax, make sure '(' follows +OPNPAR: + RST SYNCHR ; Make sure "(" follows + DEFB '(' ;GET PAREN BEFORE FORMULA + + ; --- START PROC L4C64 --- +; Evaluate expression +; +; Used by the routines at __LET, __IF, DOFN, INTIDX, FNDNUM, GETWORD, __CIRCLE, +; CGTCNT, L61C4, FN_STRING, FN_INSTR, NAMSCN, BSAVE_PARM, __BASE and __VPOKE. +; a.k.a. GETNUM, evaluate expression +EVAL: + DEC HL ; Evaluate expression & save ;BACK UP CHARACTER POINTER + +; This entry point is used by the routine at USING. +; a.k.a. LPOPER +EVAL_0: + LD D,$00 ; Precedence value ;INITIAL DUMMY PRECEDENCE IS 0 + +; Save precedence and eval until precedence break +; +; Used by the routines at EVAL, OPRND and NOT. +EVAL_1: + PUSH DE ; Save precedence ;SAVE PRECEDENCE + LD C,$01 ; Check for 1 level of stack ;EXTRA SPACE NEEDED FOR RETURN ADDRESS + CALL CHKSTK ;MAKE SURE THERE IS ROOM FOR RECURSIVE CALLS +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HFRME ; Hook 1 for Expression evaluator +ENDIF + CALL OPRND ; Get next expression value ;EVALUATE SOMETHING + +; Evaluate expression until precedence break +; +EVAL2: + LD (NXTOPR),HL ; Save address of next operator + +; +; Used by the routine at NOT. +EVAL3: + LD HL,(NXTOPR) ; Restore address of next opr + POP BC ; Precedence value and operator ;POP OFF THE PRECEDENCE OF OLDOP + LD A,(HL) ; Get next operator / function ;GET NEXT CHARACTER + LD (TEMP3),HL ;SAVE UPDATED CHARACTER POINTER + CP TK_GREATER ; Token code for '>' (lower opr code) ;IS IT AN OPERATOR? + RET C ; NO, ALL DONE (THIS CAN RESULT IN OPERATOR APPLICATION OR ACTUAL RETURN) + CP TK_MINOR+1 ; '<' +1 (higher opr code) ;SOME KIND OF RELATIONAL? + JR C,DORELS ;YES, DO IT + SUB TK_PLUS ; TK_PLUS, token code for '+' ;SUBTRAXDCT OFFSET FOR FIRST ARITHMETIC + LD E,A ; Coded operator ;MUST MULTIPLY BY 3 SINCE OPTAB ENTRIES ARE 3 LONG + JR NZ,FOPRND ;NOT ADDITION OP + + LD A,(VALTYP) ; Get data type ;SEE IF LEFT PART IS STRING + CP $03 ; String ? ;SEE IF ITS A STRING + LD A,E ; Coded operator ;REFETCH OP-VALUE + JP Z,CONCAT ; If so, string concatenation (use '+' to join strings) +FOPRND: + CP LSTOPK ; HIGHER THAN THE LAST OP? ;HIGHER THAN THE LAST OP? + RET NC ;YES, MUST BE TERMINATOR + LD HL,PRITAB ; ARITHMETIC PRECEDENCE TABLE ;CREATE INDEX INTO OPTAB + LD D,$00 ;MAKE HIGH BYTE OF OFFSET=0 + ADD HL,DE ; To the operator concerned ;ADD IN CALCULATED OFFSET + LD A,B ; Last operator precedence ;[A] GETS OLD PRECEDENCE + LD D,(HL) ; Get evaluation precedence ;REMEMBER NEW PRECEDENCE + CP D ; Compare with eval precedence ;OLD-NEW + RET NC ; Exit if higher precedence ;MUST APPLY OLD OP + ;IF HAS GREATER OR = PRECEDENCE, NEW OPERATOR + PUSH BC ; Save last precedence & token ;SAVE THE OLD PRECEDENCE + LD BC,EVAL3 ; Where to go on prec' break ;PUT ON THE ADDRESS OF THE + PUSH BC ; Save on stack for return ;PLACE TO RETURN TO AFTER OPERATOR APPLICATION + LD A,D ;SEE IF THE OPERATOR IS EXPONENTIATION +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HNTPL ; Hook 2 for Expression Evaluator +ENDIF + CP $51 ; one less than AND as mapped in PRITAB ;SEE IF THE OPERATOR IS "AND" OR "OR" + JR C,EVAL_BOOL ;AND IF SO "FRCINT" AND MAKE A SPECIAL STACK ENTRY + AND $FE ;MAKE 123 AND 122 BOTH MAP TO 122 + CP $7A ; MOD as mapped in PRITAB ;MAKE A SPECIAL CHECK FOR "MOD" AND "IDIV" + JR Z,EVAL_BOOL ;IF SO, COERCE ARGUMENTS TO INTEGER + +; THIS CODE PUSHES THE CURRENT VALUE IN THE FAC +; ONTO THE STACK, EXCEPT IN THE CASE OF STRINGS IN WHICH IT CALLS +; TYPE MISMATCH ERROR. [D] AND [E] ARE PRESERVED. +; +EVAL_NUMERIC: + LD HL,FACLOW ;SAVE THE VALUE OF THE FAC + LD A,(VALTYP) ;FIND OUT WHAT TYPE OF VALUE WE ARE SAVING + SUB $03 ; String ? SET ZERO FOR STRINGS + JP Z,TM_ERR ; Err $0D - "Type mismatch" + OR A ;SET PARITY -- CARRY UNAFFECTED SINCE OFF + + LD HL,(FACLOW) + PUSH HL ;PUSH FACLO+0,1 ON THE STACK + JP M,EVAL_NEXT ;ALL DONE IF THE DATA WAS AN INTEGER (Stack this one and get next) + + LD HL,(FACCU) + PUSH HL ;PUSH FAC-1,0 ON THE STACK + JP PO,EVAL_NEXT ;ALL DONE IF WE HAD A SNG (Stack this one and get next) + + LD HL,(FACCU+6) ;WE HAVE A DOUBLE PRECISON NUMBER + PUSH HL ;PUSH ITS 4 LO BYTES ON THE STACK + LD HL,(FACCU+4) + PUSH HL + +;a.k.a. VPUSHD +EVAL_NEXT: + ADD A,$03 ; FIX [A] TO BE THE VALTYP OF THE NUMBER JUST PUSHED ON THE STACK + LD C,E ; [C]=OPERATOR NUMBER + LD B,A ; [B]=TYPE OF VALUE ON THE STACK + PUSH BC ; SAVE THESE THINGS FOR APPLOP + LD BC,APPLOP ; GENERAL OPERATOR APPLICATION ROUTINE -- DOES TYPE CONVERSIONS + +;a.k.a. FINTMP +EVAL_MORE: + PUSH BC ; Save routine address ;SAVE PLACE TO GO + LD HL,(TEMP3) ; Address of current operator ;REGET THE TEXT POINTER + JP EVAL_1 ; Loop until prec' break ;PUSH ON THE PRECEDENCE AND READ MORE FORMULA + + +; This entry point is used by the routine at EVAL3. +DORELS: + LD D,$00 ;ASSUME NO RELATION OPS, ALSO SETUP THE HIGH ORDER OF THE INDEX INTO OPTAB +LOPREL: + SUB TK_GREATER ;IS THIS ONE RELATION? + JR C,FINREL ;RELATIONS ALL THROUGH + CP TK_MINOR-TK_GREATER+1 ;IS IT REALLY RELATIONAL? + JR NC,FINREL ;NO JUST BIG + CP 1 ;SET UP BITS BY MAPPING + RLA ;0 TO 1 1 TO 2 AND 2 TO 4 + XOR D ;BRING IN THE OLD BITS + CP D ;MAKE SURE RESULT IS BIGGER + LD D,A ;SAVE THE MASK + JP C,SN_ERR ;DON'T ALLOW TWO OF THE SAME + LD (TEMP3),HL ;SAVE CHARACTER POINTER + RST CHRGTB ;GET THE NEXT CANDIDATE + JR LOPREL + +; +; FOR "AND" AND "OR" AND "\" AND "MOD" WE WANT TO FORCE THE CURRENT VALUE +; IN THE FAC TO BE AN INTEGER, AND AT APPLICATION TIME FORCE THE RIGHT +; HAND OPERAND TO BE AN INTEGER +; +EVAL_BOOL: + PUSH DE ;SAVE THE PRECEDENCE + CALL __CINT + POP DE ;[D]=PRECEDENCE + PUSH HL ;PUSH THE LEFT HAND OPERAND + LD BC,DANDOR ;"AND" AND "OR" DOER + JR EVAL_MORE ;PUSH ON THIS ADDRESS,PRECEDENCE AND CONTINUE EVALUATION + +; +; HERE TO BUILD AN ENTRY FOR A RELATIONAL OPERATOR +; STRINGS ARE TREATED SPECIALLY. NUMERIC COMPARES ARE DIFFERENT +; FROM MOST OPERATOR ENTRIES ONLY IN THE FACT THAT AT THE +; BOTTOM INSTEAD OF HAVING RETAOP, DOCMP AND THE RELATIONAL +; BITS ARE STORED. STRINGS HAVE STRCMP,THE POINTER AT THE STRING DESCRIPTOR, +; DOCMP AND THE RELATIONAL BITS. +; +FINREL: + LD A,B ;[A]=OLD PRECEDENCE + CP 100 ;RELATIONALS HAVE PRECEDENCE 100 + RET NC ;APPLY EARLIER OPERATOR IF IT HAS HIGHER PRECEDENCE + PUSH BC ;SAVE THE OLD PRECEDENCE + PUSH DE ;SAVE [D]=RELATIONAL BITS + LD DE,100*256+OPCNT ;[D]=PRECEDENCE=100 + ;[E]=DISPATCH OFFSET FOR COMPARES IN APPLOP=4 + ;IN CASE THIS IS A NUMERIC COMPARE + LD HL,DOCMP ;ROUTINE TO TAKE COMPARE ROUTINE RESULT + ;AND RELATIONAL BITS AND RETURN THE ANSWER + PUSH HL ;DOES A JMP TO RETAOP WHEN DONE + RST GETYPR ;SEE IF WE HAVE A NUMERIC COMPARE + JP NZ,EVAL_NUMERIC ;YES, BUILD AN APPLOP ENTRY + LD HL,(FACLOW) ;GET THE POINTER AT THE STRING DESCRIPTOR + PUSH HL ;SAVE IT FOR STRCMP + LD BC,STRCMP ;STRING COMPARE ROUTINE + JR EVAL_MORE ;PUSH THE ADDRESS, REGET THE TEXT POINTER + ;SAVE THE PRECEDENCE AND SCAN + ;MORE OF THE FORMULA + +; Code at 19746 +; +; APPLOP IS RETURNED TO WHEN IT IS TIME TO APPLY AN ARITHMETIC +; OR NUMERIC COMPARISON OPERATION. +; THE STACK HAS A DOUBLE BYTE ENTRY WITH THE OPERATOR +; NUMBER AND THE VALTYP OF THE VALUE ON THE STACK. +; APPLOP DECIDES WHAT VALUE LEVEL THE OPERATION +; WILL OCCUR AT, AND CONVERTS THE ARGUMENTS. APPLOP +; USES DIFFERENT CALLING CONVENTIONS FOR EACH VALUE TYPE. +; INTEGERS: LEFT IN [D,E] RIGHT IN [H,L] +; SINGLES: LEFT IN [B,C,D,E] RIGHT IN THE FAC +; DOUBLES: LEFT IN FAC RIGHT IN ARG +; +APPLOP: + POP BC ;[B]=STACK OPERAND VALUE TYPE [C]=OPERATOR OFFSET + LD A,C ;SAVE IN MEMORY SINCE THE STACK WILL BE BUSY + LD (OPRTYP),A ;A RAM LOCATION + LD A,(VALTYP) ;GET VALTYP OF FAC + CP B ;ARE VALTYPES THE SAME? + JR NZ,VALNSM ;NO + CP $02 ;INTEGER? + JR Z,INTDPC ;YES, DISPATCH!! + CP $04 ;SINGLE? + JP Z,SNGDPC ;YES, DISPATCH!! + JR NC,DBLDPC ;MUST BE DOUBLE, DISPATCH!! +VALNSM: + LD D,A ;SAVE IN [D] + LD A,B ;CHECK FOR DOUBLE + CP $08 ;PRECISION ENTRY ON THE STACK + JR Z,STKDBL ;FORCE FAC TO DOUBLE + LD A,D ;GET VALTYPE OF FAC + CP $08 ;AND IF SO, CONVERT THE STACK OPERAND + JR Z,FACDBL ;TO DOUBLE PRECISION + LD A,B ;SEE IF THE STACK ENTRY IS SINGLE + CP $04 ;PRECISION AND IF SO, CONVERT + JR Z,STKSNG ;THE FAC TO SINGLE PRECISION + LD A,D ;SEE IF THE FAC IS SINGLE PRECISION + CP $03 ;BLOW UP ON RIGHT HAND STRING OPERAND + JP Z,TM_ERR ; Err $0D - "Type mismatch" + JR NC,EVAL_FP ;AND IF SO CONVERT THE STACK TO SINGLE PRECISION + +;NOTE: THE STACK MUST BE INTEGER AT THIS POINT + +; Integer VALTYP +INTDPC: + LD HL,INT_OPR ;INTEGER INTEGER CASE + LD B,$00 ;SPECIAL DISPATCH FOR SPEED + ADD HL,BC ;[H,L] POINTS TO THE ADDRESS TO GO TO + ADD HL,BC + LD C,(HL) ;[B,C]=ROUTINE ADDRESS + INC HL + LD B,(HL) + POP DE ;[D,E]=LEFT HAND OPERAND + LD HL,(FACLOW) ;[H,L]=RIGHT HAND OPERAND + PUSH BC ;DISPATCH + RET + +; +; THE STACK OPERAND IS DOUBLE PRECISION, SO +; THE FAC MUST BE FORCED TO DOUBLE PRECISION, MOVED INTO ARG +; AND THE STACK VALUE POPED INTO THE FAC +; +STKDBL: + CALL __CDBL ;MAKE THE FAC DOUBLE PRECISION +DBLDPC: + CALL VMOVAF ;POP OFF THE STACK OPERAND INTO THE FAC + POP HL + LD (FACCU+4),HL + POP HL + LD (FACCU+6),HL ;STORE LOW BYTES AWAY +SNGDBL: + POP BC + POP DE ;POP OFF A FOUR BYTE VALUE + CALL FPBCDE ;INTO THE FAC +SETDBL: + CALL __CDBL ;MAKE SURE THE LEFT OPERAND IS DOUBLE PRECISION + LD HL,DEC_OPR ;DISPATCH TO A DOUBLE PRECISION ROUTINE +DODSP: + LD A,(DORES) ;RECALL WHICH OPERAND IT WAS + RLCA ;CREATE A DISPATCH OFFSET, SINCE + ADD A,L ;TABLE ADDRESSES ARE TWO BYTES + LD L,A ;ADD LOW BYTE OF ADDRESS + ADC A,H ;SAVE BACK + SUB L ;ADD HIGH BYTE + LD H,A ;SUBTRACT LOW + LD A,(HL) ;RESULT BACK + INC HL ;GET THE ADDRESS + LD H,(HL) + LD L,A + JP (HL) ;AND PERFORM THE OPERATION, RETURNING TO RETAOP, EXCEPT FOR COMPARES WHICH RETURN TO DOCMP + +; +; THE FAC IS DOUBLE PRECISION AND THE STACK IS EITHER +; INTEGER OR SINGLE PRECISION AND MUST BE CONVERTED +; +FACDBL: + LD A,B + PUSH AF ;SAVE THE STACK VALUE TYPE + CALL VMOVAF ;MOVE THE FAC INTO ARG + POP AF ;POP THE STACK VALUE TYPE INTO [A] + LD (VALTYP),A ;PUT IT IN VALTYP FOR THE FORCE ROUTINE + CP $04 ;SEE IF ITS SINGLE, SO WE KNOW HOW TO POP THE VALUE OFF + JR Z,SNGDBL ;IT'S SINGLE PRECISION SO DO A POPR / CALL MOVFR + POP HL ;POP OFF THE INTEGER VALUE + LD (FACLOW),HL ;SAVE IT FOR CONVERSION + JR SETDBL ;SET IT UP + +; +; THIS IS THE CASE WHERE THE STACK IS SINGLE PRECISION +; AND THE FAC IS EITHER SINGLE PRECISION OR INTEGER +; +STKSNG: + CALL __CSNG ;CONVERT THE FAC IF NECESSARY +; Single Precision VALTYP +SNGDPC: + POP BC ;PUT THE LEFT HAND OPERAND IN THE REGISTERS + POP DE +SNGDO: + LD HL,FLT_OPR ;SETUP THE DISPATCH ADDRESS FOR THE SINGLE PRECISION OPERATOR ROUTINES + JR DODSP ;DISPATCH + +; +; THIS IS THE CASE WHERE THE FAC IS SINGLE PRECISION AND THE STACK +; IS AN INTEGER. +; +EVAL_FP: + POP HL ;POP OFF THE INTEGER ON THE STACK + CALL PUSHF ;SAVE THE FAC ON THE STACK + CALL HL_CSNG ;CONVERT [H,L] TO A SINGLE PRECISION NUMBER IN THE FAC + CALL BCDEFP ;PUT THE LEFT HAND OPERAND IN THE REGISTERS + POP HL ;RESTORE THE FAC + LD (FACCU),HL ;FROM THE STACK + POP HL + LD (FACLOW),HL + JR SNGDO ;PERFORM THE OPERATION + +; +; HERE TO DO INTEGER DIVISION. SINCE WE WANT 1/3 TO BE +; .333333 AND NOT ZERO WE HAVE TO FORCE BOTH ARGUMENTS +; TO BE SINGLE-PRECISION FLOATING POINT NUMBERS +; AND USE FDIV +; +; Routine at 19896 +IDIV: + PUSH HL ;SAVE THE RIGHT HAND ARGUMENT + EX DE,HL ;[H,L]=LEFT HAND ARGUMENT + CALL HL_CSNG ;CONVERT [H,L] TO A SINGLE-PRECISION NUMBER IN THE FAC + POP HL ;GET BACK THE RIGHT HAND ARGUMENT + CALL PUSHF ;PUSH THE CONVERTED LEFT HAND ARGUMENT ONTO THE STACK + CALL HL_CSNG ;CONVERT THE RIGHT HAND ARGUMENT TO A SINGLE PRECISION NUMBER IN THE FAC + JP DIVIDE ;DO THE DIVISION AFTER POPING INTO THE REGISTERS THE LEFT HAND ARGUMENT + + +; Routine at 19911 +; Get next expression value (a.k.a. "EVAL" !) +; Used by the routines at EVAL_1 and CONCAT. +OPRND: + RST CHRGTB ; Gets next character (or token) from BASIC text. + JP Z,MO_ERR ;TEST FOR MISSING OPERAND - IF NONE, Err $18 - "Missing Operand" Error + JP C,FIN_DBL ;IF NUMERIC, INTERPRET CONSTANT If numeric type, create FP number + CALL ISLETTER_A ;VARIABLE NAME? See if a letter + JP NC,EVAL_VARIABLE ;AN ALPHABETIC CHARACTER MEANS YES Letter - Find variable + CP DBLCON+1 ;IS IT AN EMBEDED CONSTANT + JP C,_CONFAC ;RESCAN THE TOKEN & RESTORE OLD TEXT PTR +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HEVAL ; Hook 1 for Factor Evaluator +ENDIF + INC A ;IS IT A FUNCTION CALL (PRECEDED BY $FF, 377 OCTAL) + JP Z,ISFUN ;YES, DO IT + DEC A ;FIX A BACK + CP TK_PLUS ;IGNORE "+" + JR Z,OPRND ; ..skip it, we will look the digits + CP TK_MINUS ;NEGATION? + JP Z,MINUS ; Yes - deal with minus sign + CP '"' ;STRING CONSTANT? + JP Z,QTSTR ;IF SO BUILD A DESCRIPTOR IN A TEMPORARY DESCRIPTOR LOCATION + ;AND PUT A POINTER TO THE DESCRIPTOR IN FACLO. + CP TK_NOT ;CHECK FOR "NOT" OPERATOR + JP Z,NOT + CP '&' ;OCTAL CONSTANT? + JP Z,OCTCNS + CP TK_ERR ;'ERR' token ? + JR NZ,NTERC ;NO, TRY OTHER POSSIBILITIES + +__ERR: + RST CHRGTB ;GRAB FOLLOWING CHAR IS IT A DISK ERROR CALL? + LD A,(ERRFLG) ;GET THE ERROR CODE. "CPI OVER NEXT BYTE + PUSH HL ;SAVE TEXT POINTER + CALL PASSA ;RETURN THE VALUE + POP HL ;RESTORE TEXT POINTER + RET ;ALL DONE. + + +NTERC: + CP TK_ERL ;ERROR LINE NUMBER VARIABLE + JR NZ,NTERL ;NO, TRY MORE THINGS. + + __ERL: + RST CHRGTB ;GET FOLLOWING CHARACTER + PUSH HL ;SAVE TEXT POINTER + LD HL,(ERRLIN) ;GET THE OFFENDING LINE # + CALL INEG2 ;FLOAT 2 BYTE UNSINGED INT + POP HL ;RESTORE TEXT POINTER + RET ;RETURN + +NTERL: + CP TK_POINT + JP Z,FN_POINT + CP TK_TIME + JP Z,FN_TIME + CP TK_SPRITE + JP Z,FN_SPRITE + CP TK_VDP + JP Z,FN_VDP + CP TK_BASE + JP Z,FN_BASE + CP TK_PLAY + JP Z,FN_PLAY + CP TK_DSKI + JP Z,FN_DSKI + CP TK_ATTR + JP Z,FN_ATTR + + CP TK_VARPTR ;VARPTR CALL? + JR NZ,NTVARP ;NO + +; 'VARPTR' + RST CHRGTB ;EAT CHAR AFTER + RST SYNCHR ;EAT LEFT PAREN + DEFB '(' + CP '#' ;WANT POINTER TO FILE? + JR NZ,NVRFIL ;NO, MUST BE VARIABLE + +; VARPTR(#buffer) Function +;VARPTR_BUF: + CALL FNDNUM ;READ FILE # + PUSH HL ;SAVE TEXT PTR + CALL FILIDX ;GET PTR TO FILE + EX DE,HL + POP HL ;RESTORE TEXT PTR + JR VARPTR_0 + +NVRFIL: + CALL PTRGET ;GET ADDRESS OF VARIABLE + +VARPTR_0: + RST SYNCHR + DEFB ')' ;EAT RIGHT PAREN + PUSH HL ;SAVE TEXT POINTER + EX DE,HL ;GET VALUE TO RETURN IN [H,L] + LD A,H ;MAKE SURE NOT UNDEFINED VAR + OR L ;SET CC'S. ZERO IF UNDEF + JP Z,FC_ERR ;ALL OVER IF UNDEF (DONT WANT USER POKING INTO ZERO IF HE'S TOO LAZY TO CHECK) + CALL MAKINT ;MAKE IT AN INT + POP HL ;RESTORE TEXT POINTER + RET + + +NTVARP: + CP TK_USR ;USER ASSEMBLY LANGUAGE ROUTINE?? + JP Z,FN_USR ;GO HANDLE IT + CP TK_INSTR ;IS IT THE INSTR FUNCTION?? + JP Z,FN_INSTR ;DISPATCH + CP TK_INKEY_S ;INKEY$ FUNCTION? + JP Z,FN_INKEY ;GO DO IT + CP TK_STRING ;STRING FUNCTION? + JP Z,FN_STRING ;YES, GO DO IT + CP TK_INPUT ;FIXED LENGTH INPUT? + JP Z,FN_INPUT ;YES + CP TK_CSRLIN + JP Z,FN_CSRLIN + CP TK_FN ;USER-DEFINED FUNCTION? + JP Z,DOFN + ;NUMBERED CHARACTERS ALLOWED + ;SO THERE IS NO NEED TO CHECK + ;THE UPPER BOUND + +; End of expression. Look for ')'. +; ONLY POSSIBILITY LEFT IS A FORMULA IN PARENTHESES +; +; This entry point is used by the routines at ISFUN and FN_USR. +EVLPAR: + CALL OPNPAR ; Evaluate expression in "()", RECURSIVELY EVALUATE THE FORMULA + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ')' + RET + +; '-', deal with minus sign +MINUS: ; (a.k.a. "MINUS") + LD D,$7D ; "-" precedence ;A PRECEDENCE BELOW ^ + CALL EVAL_1 ; Evaluate until prec' break ;BUT ABOVE ALL ELSE + LD HL,(NXTOPR) ; Get next operator address ;SO ^ GREATER THAN UNARY MINUS + PUSH HL ; Save next operator address ;GET TEXT POINTER + CALL INVSGN ; Negate value + + +; FUNCTIONS THAT DON'T RETURN STRING VALUES COME BACK HERE (POP HL / RET) +RETNUM: + POP HL ; Restore next operator address + RET + + +; This entry point is used by the routine at SCNVAR. +; EVAL_VARIABLE (a.k.a. CONVAR) +EVAL_VARIABLE: + CALL GETVAR ;GET A POINTER TO THE VARIABLE IN [D,E] +COMPTR: + PUSH HL ;SAVE THE TEXT POINTER + EX DE,HL ;PUT THE POINTER TO THE VARIABLE VALUE INTO [H,L]. IN THE CASE OF A STRING + ;THIS IS A POINTER TO A DESCRIPTOR AND NOT AN ACTUAL VALUE + LD (FACLOW),HL ;IN CASE IT'S STRING STORE THE POINTER TO THE DESCRIPTOR IN FACLO. + RST GETYPR ;Get the number type (FAC). FOR STRINGS WE JUST LEAVE + CALL NZ,VMOVFM ;A POINTER IN THE FAC THE FAC USING [H,L] AS THE POINTER. (CALL if not string type) + POP HL ;RESTORE THE TEXT POINTER + RET + +; Routine at 20137 +; +; Used by the routines at TOKENIZE, TOKEN_BUILT, NOTRES, L55F8 and GET_DEVNAME. +MAKUPL: + LD A,(HL) ;GET CHAR FROM MEMORY + +; Make char in 'A' upper case +; +; Used by the routines at NTSNGT and OCTCNS. +UCASE: + CP 'a' ;IS IT LOWER CASE RANGE + RET C ;LESS + CP 'z'+1 ;GREATER + RET NC ;TEST + AND $5F ;MAKE UPPER CASE + RET ;DONE + +; Routine at 20147 +CNSGET: + CP '&' ; $26 + JP NZ,ATOH + +; OCTAL, HEX or other specified base (ASCII) to FP number +; +; Used by the routines at H_ASCTFP, NTSNGT and OPRND. +OCTCNS: + LD DE,$0000 ;INITIALIZE TO ZERO AND IGNORE OVERFLOW + RST CHRGTB ;GET FIRST CHAR + CALL UCASE ;MAKE UPPER IF NESC. + LD BC,$0102 ; B=1, C=2 ..Binary + CP 'B' ;"&b": BINARY? + JR Z,LOPOCT ;IF SO, DO IT + LD BC,$0308 ; B=3, C=8 ..Octal + CP 'O' ;"&o": OCTAL? + JR Z,LOPOCT ;IF SO, DO IT + LD BC,$0410 ; B=4, C=16 ..Hex + CP 'H' ;"&h": HEX? + JP NZ,SN_ERR ; If not, "syntax error" +LOPOCT: + INC HL ;BUMP POINTER + LD A,(HL) ;GET CHAR + EX DE,HL + CALL UCASE ;MAKE UPPER CASE + CP '9'+1 ;IS IT BIGGER THAN LARGEST DIGIT? + JR C,ALPTST ;NO + CP 'A' + JR C,OCTFIN + SUB 'A'-10-'0' +ALPTST: + SUB '0' ;CONVERT DIGIT, MAKE BINARY + CP C ;IS IT BIGGER THAN LARGEST DIGIT? + JR NC,OCTFIN ;YES, BE FORGIVING & RETURN + PUSH BC +LOPHEX: + ADD HL,HL ;SHIFT RIGHT B BITS + JP C,OV_ERR ; Err $06 - "Overflow" + DJNZ LOPHEX + POP BC + OR L ;OR ON NEW DIGIT + LD L,A ;SAVE BACK + EX DE,HL ;GET TEXT POINTER BACK IN [H,L] + JR LOPOCT ;KEEP EATING + +OCTFIN: + CALL MAKINT + EX DE,HL + RET + +; Routine at 20220 +; +; Used by the routine at OPRND. +ISFUN: + INC HL ; BUMP SOURCE TEXT POINTER + LD A,(HL) ; GET THE ACTUAL TOKEN FOR FN + SUB $80+ONEFUN ; MAKE INTO OFFSET (Is it a function? -$80-1) + LD B,$00 ; Get address of function + RLCA ; Double function offset ;MULTIPLY BY 2 + LD C,A ; BC = Offset in function table + PUSH BC ; Save adjusted token value ;SAVE THE FUNCTION # ON THE STACK + RST CHRGTB ; Get next character + LD A,C ; Get adjusted token value ;LOOK AT FUNCTION # + CP 2*TK_MID_S-2*ONEFUN+1 ; Adj' LEFT$,RIGHT$ or MID$ ? + JR NC,OKNORM ; No - Do function + +; +; MOST FUNCTIONS TAKE A SINGLE ARGUMENT. +; THE RETURN ADDRESS OF THESE FUNCTIONS IS A SMALL ROUTINE +; THAT CHECKS TO MAKE SURE VALTYP IS 0 (NUMERIC) AND POPS OFF +; THE TEXT POINTER. SO NORMAL FUNCTIONS THAT RETURN STRING RESULTS (I.E. CHR$) +; MUST POP OFF THE RETURN ADDRESS OF LABBCK, AND POP OFF THE +; TEXT POINTER AND THEN RETURN TO FRMEVL. +; +; THE SO CALLED "FUNNY" FUNCTIONS CAN TAKE MORE THAN ONE ARGUMENT. +; THE FIRST OF WHICH MUST BE STRING AND THE SECOND OF WHICH +; MUST BE A NUMBER BETWEEN 0 AND 256. THE TEXT POINTER IS +; PASSED TO THESE FUNCTIONS SO ADDITIONAL ARGUMENTS +; CAN BE READ. THE TEXT POINTER IS PASSED IN [D,E]. +; THE CLOSE PARENTHESIS MUST BE CHECKED AND RETURN IS DIRECTLY +; TO FRMEVL WITH [H,L] SETUP AS THE TEXT POINTER POINTING BEYOND THE ")". +; THE POINTER TO THE DESCRIPTOR OF THE STRING ARGUMENT +; IS STORED ON THE STACK UNDERNEATH THE VALUE OF THE INTEGER ARGUMENT (2 BYTES) +; +; FIRST ARGUMENT ALWAYS STRING -- SECOND INTEGER +; + CALL OPNPAR ; Evaluate expression (X,... ;EAT OPEN PAREN AND FIRST ARG + RST SYNCHR ; Make sure "," follows + DEFB ',' ;TWO ARGS SO COMMA MUST DELIMIT + CALL TSTSTR ; Make sure it's a string ;MAKE SURE THE FIRST ONE WAS STRING + EX DE,HL ; Save code string address ;[D,E]=TXTPTR + LD HL,(FACLOW) ; Get address of string ;GET PTR AT STRING DESCRIPTOR + EX (SP),HL ; Save address of string ;GET FUNCTION # <> SAVE THE STRING PTR + PUSH HL ; Save adjusted token value ;PUT THE FUNCTION # ON + EX DE,HL ; Restore code string address ;[H,L]=TXTPTR + CALL GETINT ; Get integer 0-255 ;[E]=VALUE OF FORMULA + EX DE,HL ; Save code string address ;TEXT POINTER INTO [D,E] <> [H,L]=INT VALUE OF SECOND ARGUMENT + EX (SP),HL ; Save integer,HL = adj' token ;SAVE INT VALUE OF SECOND ARG <> [H,L]=FUNCTION NUMBER + JR GOFUNC ; Jump to string function ;DISPATCH TO FUNCTION + +; a.k.a. FNVAL +OKNORM: + CALL EVLPAR ; Evaluate expression ;CHECK OUT THE ARGUMENT AND MAKE SURE ITS FOLLOWED BY ")" + EX (SP),HL ; HL = Adjusted token value ;[H,L]=FUNCTION # AND SAVE TEXT POINTER +; +; CHECK IF SPECIAL COERCION MUST BE DONE FOR ONE OF THE TRANSCENDENTAL +; FUNCTIONS (RND, SQR, COS, SIN, TAN, ATN, LOG, AND EXP) +; THESE FUNCTIONS DO NOT LOOK AT VALTYP, BUT RATHER ASSUME THE +; ARGUMENT PASSED IN THE FAC IS SINGLE PRECISION, SO FRCSNG +; MUST BE CALLED BEFORE DISPATCHING TO THEM. +; + LD A,L ;[A]=FUNCTION NUMBER + CP 2*(TK_SQR-ONEFUN) ;LESS THAN SQUARE ROOT? ; Adj' SGN, INT or ABS ? + JR C,NOTFRF ;DON'T FORCE THE ARGUMENT + CP 2*(TK_ATN-ONEFUN)+1 ;BIGGER THAN ARC-TANGENT? ; Adj' ABS, SQR, RND, SIN, LOG, EXP, COS, TAN or ATN ? +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HOKNO ; Hook 2 for Factor Evaluator +ENDIF + JR NC,NOTFRF ;DON'T FORCE THE ARGUMENT + RST GETYPR ; Get the number type (FAC) + + PUSH HL + CALL C,__CDBL + POP HL + +NOTFRF: + LD DE,RETNUM ; Return number from function ;RETURN ADDRESS + PUSH DE ; Save on stack ;MAKE THEM REALLY COME BACK + + +GOFUNC: + LD BC,FNCTAB_FN ; Function routine addresses ;FUNCTION DISPATCH TABLE +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HFING ; Hook 3 for Factor Evaluator +ENDIF +DISPAT: + ADD HL,BC ; Point to right address ;ADD ON THE OFFSET + LD C,(HL) ; Get LSB of address ;FASTER THAN PUSHM + INC HL ; + LD H,(HL) ; Get MSB of address + LD L,C ; Address to HL + JP (HL) ; Jump to function ;GO PERFORM THE FUNCTION + +; THE FOLLOWING ROUTINE IS CALLED FROM FIN IN F4 +; TO SCAN LEADING SIGNS FOR NUMBERS. IT WAS MOVED +; TO F3 TO ELIMINATE BYTE EXTERNALS +; +; This entry point is used by the routine at _ASCTFP. +; test '+', '-'.. +SGNEXP: + DEC D ; Dee to flag negative exponent ;SET SIGN OF EXPONENT FLAG + CP TK_MINUS ; "-" token ? ;NEGATIVE EXPONENT? + RET Z ; Yes - Return + CP '-' ; "-" ASCII ? + RET Z ; Yes - Return + INC D ; Inc to flag positive exponent ;NO, RESET FLAG + CP '+' ; "+" ASCII ? + RET Z ; Yes - Return + CP TK_PLUS ; "+" token ? ;IGNORE "+" + RET Z ; Yes - Return + DEC HL ; DEC 'cos GETCHR INCs ;CHECK IF LAST CHARACTER WAS A DIGIT + RET ; Return "NZ" ;RETURN WITH NON-ZERO SET + +; Routine at 20311 +DOCMP: + INC A ;SETUP BITS + ADC A,A ;4=LESS 2=EQUAL 1=GREATER + POP BC ;WHAT DID HE WANT? + AND B ;ANY BITS MATCH? + ADD A,$FF ;MAP 0 TO 0 + SBC A,A ;AND ALL OTHERS TO 377 + CALL CONIA ;CONVERT [A] TO AN INTEGER SIGNED + JR NOT_0 ;RETURN FROM OPERATOR APPLICATION PLACE SO THE TEXT POINTER + ;WILL GET SET UP TO WHAT IT WAS WHEN LPOPER RETURNED. + +; Routine at 20323 +; +; Used by the routine at OPRND. +; Evaluate 'NOT' +NOT: + LD D,$5A ; Precedence value for "NOT" ;"NOT" HAS PRECEDENCE 90, SO FORMULA EVALUATION + CALL EVAL_1 ; Eval until precedence break ;IS ENTERED WITH A DUMMY ENTRY OF 90 ON THE STACK + CALL __CINT ; Get integer -32768 - 32767 ;COERCE THE ARGUMENT TO INTEGER + LD A,L ; Get LSB ;COMPLEMENT [H,L] + CPL ; Invert LSB + LD L,A ; Save "NOT" of LSB + LD A,H ; Get MSB + CPL ; Invert MSB + LD H,A ; Set "NOT" of MSB + LD (FACLOW),HL ; Save AC as current ;UPDATE THE FAC + POP BC ; Clean up stack ;FRMEVL, AFTER SEEING THE PRECEDENCE OF 90 THINKS IT IS + ;APPLYING AN OPERATOR SO IT HAS THE TEXT POINTER IN TEMP2 SO +; This entry point is used by the routine at DOCMP. +NOT_0: + JP EVAL3 ; Continue evaluation ;RETURN TO REFETCH IT + + +; +; DANDOR APPLIES THE "AND" AND "OR" OPERATORS +; AND SHOULD BE USED TO IMPLEMENT ALL LOGICAL OPERATORS. +; WHENEVER AN OPERATOR IS APPLIED, ITS PRECEDENCE IS IN [B]. +; THIS FACT IS USED TO DISTINGUISH BETWEEN "AND" AND "OR". +; THE RIGHT HAND ARGUMENT IS COERCED TO INTEGER, JUST AS +; THE LEFT HAND ONE WAS WHEN IT WAS PUSHED ON THE STACK. +; +; Routine at 20344 +DANDOR: + LD A,B ;SAVE THE PRECEDENCE "OR"=70 + PUSH AF + CALL __CINT ;COERCE RIGHT HAND ARGUMENT TO INTEGER + POP AF ;GET BACK THE PRECEDENCE TO DISTINGUISH "AND" AND "OR" + POP DE ;POP OFF THE LEFT HAND ARGUMENT + CP $7A ;IS THE OPERATOR "MOD"? (as in PRITAB) + JP Z,IMOD ;IF SO, USE MONTE'S SPECIAL ROUTINE + CP $7B ;IS THE OPERATOR "IDIV"? (as in PRITAB) + JP Z,INT_DIV ;LET MONTE HANDLE IT + LD BC,GIVINT ;PLACE TO RETURN WHEN DONE + PUSH BC ;SAVE ON STACK + CP $46 ;SET ZERO FOR "OR" + JR NZ,NOTOR +OR: + LD A,E ;SETUP LOW IN [A] + OR L + LD L,A + LD A,H + OR D + RET ;RETURN THE INTEGER [A,L] + +NOTOR: + CP $50 ;AND? + JR NZ,NOTAND + +AND: + LD A,E + AND L + LD L,A + LD A,H + AND D + RET ;RETURN THE INTEGER [A,L] + +NOTAND: + CP $3C ;XOR? + JR NZ,NOTXOR ;NO + +XOR: + LD A,E + XOR L + LD L,A + LD A,H + XOR D + RET + +NOTXOR: + CP $32 ;EQV? + JR NZ,IMP ;NO + +EQV: + LD A,E ;LOW PART + XOR L + CPL + LD L,A + LD A,H + XOR D + CPL + RET + +; 'IMP' expression +; +;FOR "IMP" USE A IMP B = NOT(A AND NOT(B)) +IMP: + LD A,L ;MUST BE "IMP" + CPL + AND E + CPL + LD L,A + LD A,H + CPL + AND D + CPL + RET + +; Routine at 20417 ($4FC1) +; +; THIS ROUTINE SUBTRACTS [D,E] FROM [H,L] +; AND FLOATS THE RESULT LEAVING IT IN FAC. +; +; Used by the routine at __FRE. +GIVDBL: + OR A + SBC HL,DE ;[H,L]=[H,L]-[D,E] + JP INEG2 ;FLOAT 2 BYTE UNSIGNED INT + +; Routine at 20423 +__LPOS: + LD A,(LPTPOS) + JR PASSA ;SEE WHERE WE ARE + +; Routine at 20428 +__POS: + LD A,(TTYPOS) ;GET TELETYPE POSITION, SEE WHERE WE ARE + + +; Exit from function, result in A +; a.k.a. SNGFLT +; +; This entry point is used by the routines at __INP_0, OPRND, __LPOS, __PEEK, +; __VAL, __PDL, FN_VDP and __VPEEK. +PASSA: + LD L,A ;MAKE [A] AN UNSIGNED INTEGER + XOR A + +GIVINT: + LD H,A + JP MAKINT + +; Routine at 20437 +; +; USER DEFINED (USR) ASSEMBLY LANGUAGE FUNCTION CODE +; +; Used by the routine at OPRND. +FN_USR: + CALL SCNUSR ;SCAN THE USR# + PUSH DE ;SAVE POINTER + CALL EVLPAR ;EAT LEFT PAREN AND FORMULA + EX (SP),HL ;SAVE TEXT POINTER & GET INDEX INTO USRTAB + LD E,(HL) ;GET DISPATCH ADRESS + INC HL ;BUMP POINTER + LD D,(HL) ;PICK UP 2ND BYTE OF ADDRESS + LD HL,POPHLRT ;GET ADDRESS OF POP H RET + PUSH HL ;PUSH IT ON + PUSH DE ;SAVE ADDRESS OF USR ROUTINE + LD A,(VALTYP) ;GET ARGUMENT TYPE IN [A] + PUSH AF ;SAVE VALTYP + CP $03 ;STRING?? + CALL Z,GSTRCU ;FREE IT UP + POP AF ;GET BACK VALTYP + EX DE,HL ;MOVE POSSIBLE DESC. POINTER TO [D,E] + LD HL,FACCU ;POINTER TO FAC IN [H,L] + RET ;CALL USR ROUTINE + +; Routine at 20468 +; +; Used by the routines at FN_USR and DEF_USR. +SCNUSR: + RST CHRGTB ;GET A CHAR + LD BC,$0000 ;ASSUME USR0 + CP ONECON+10 ;SINGLE BYTE INT EXPECTED + JR NC,NOARGU ;NO, MUST BE DEFAULTING TO USR0 + CP ONECON ;IS IT SMALLER THAN ONECON + JR C,NOARGU ;YES, ASSUME TRYING TO DEFAULT TO USR0 + RST CHRGTB ;SCAN PAST NEXT CHAR + LD A,(CONLO) ;GET VALUE OF 1 BYTER + OR A ;MAKE SURE CARRY IS OFF + RLA ;MULTIPLY BY 2 + LD C,A ;SAVE OFFSET IN [C] +NOARGU: + EX DE,HL ;SAVE TEXT POINTER IN [D,E] + LD HL,USR0 ;GET START OF TABLE + ADD HL,BC ;ADD ON OFFSET + EX DE,HL ;RESTORE TEXT POINTER, ADDRESS TO [D,E] + RET ;RETURN FROM SCAN ROUTINE + +; Routine at 20494 +; +; Used by the routine at __DEF. +DEF_USR: + CALL SCNUSR ;SCAN THE USR NAME + PUSH DE ;SAVE POINTER TO USRTAB ENTRY + RST SYNCHR + DEFB TK_EQUAL ;MUST HAVE EQUAL SIGN + CALL GETWORD ;GET THE ADDRESS + EX (SP),HL ;TEXT POINTER TO STACK, GET ADDRESS + LD (HL),E ;SAVE USR CALL ADDRESS + INC HL ;BUMP POINTER + LD (HL),D ;SAVE HIGH BYTE OF ADDRESS + POP HL ;RESTORE TEXT POINTER + RET ;RETURN TO NEWSTT + +; +;SIMPLE-USER-DEFINED-FUNCTION CODE +; +; IN THE 8K VERSION (SEE LATER COMMENT FOR EXTENDED) +; NOTE ONLY SINGLE ARGUMENTS ARE ALLOWED TO FUNCTIONS +; AND FUNCTIONS MUST BE OF THE SINGLE LINE FORM: +; DEF FNA(X)=X^2+X-2 +; NO STRINGS CAN BE INVOLVED WITH THESE FUNCTIONS +; +; IDEA: CREATE A FUNNY SIMPLE VARIABLE ENTRY +; WHOSE FIRST CHARACTER (SECOND WORD IN MEMORY) +; HAS THE 200 BIT SET. +; THE VALUE WILL BE: +; +; A TXTPTR TO THE FORMULA +; THE NAME OF THE PARAMETER VARIABLE +; +; FUNCTION NAMES CAN BE LIKE "FNA4" +; + +; 'DEF' BASIC instruction +; Routine at 20509 +__DEF: + CP TK_USR ;DEFINING THE CALL ADDRESS OF USR ROUTINE? + JR Z,DEF_USR ;YES, DO IT + +; DEF FN[«parameter list>}]= +; + CALL GETFNM ; Get "FN" and name ;GET A POINTER TO THE FUNCTION NAME + CALL IDTEST ; Error if in 'DIRECT' (immediate) mode + EX DE,HL ;[D,E] = THE TEXT POINTER AFTER THE FUNCTION NAME + ;AND [H,L] = POINTER AT PLACE TO STORE VALUE OF THE FUNCTION VARIABLE + LD (HL),E ;SAVE THE TEXT POINTER AS THE VALUE + INC HL + LD (HL),D + EX DE,HL ;RESTORE THE TEXT POINTER TO [H,L] + LD A,(HL) ;GET NEXT CHAR + CP '(' ;DOES THIS FUNCTION HAVE ARGS? + JP NZ,__DATA ;NO, go to get next statement + RST CHRGTB +SCNLIS: + CALL GETVAR ;GET POINTER TO DUMMY VAR(CREATE VAR) + LD A,(HL) ;GET TERMINATOR + CP ')' ;END OF ARG LIST? + JP Z,__DATA ;YES + RST SYNCHR + DEFB ',' ;"," MUST FOLLOW THEN + JR SCNLIS + +; Routine at 20544 +; +; Used by the routine at OPRND. +DOFN: + CALL GETFNM ; Make sure "FN" follows and get FN name + LD A,(VALTYP) ;FIND OUT WHAT KIND OF FUNCTION IT IS + OR A ;PUSH THIS [A] ON WITH A PSW WITH CARRY OFF SO THAT WHEN VALUES ARE + ;BEING POPPED OFF AND RESTORED TO PARAMETERS WE WILL KNOW WHEN TO STOP + ;WHEN A VALTYP IS POPPED OFF WITH CARRY OFF + + PUSH AF ;SAVE SO THAT THE FINAL RESULT WILL BE COERCED TO THE FUNCTION TYPE + LD (NXTOPR),HL ;SAVE THE TEXT POINTER THAT POINTS PAST THE FUNCTION NAME IN THE CALL + EX DE,HL ;[H,L]=A POINTER TO THE VALUE OF FUNCTION + LD A,(HL) ;[H,L]=VALUE OF THE FUNCTION + INC HL ;WHICH IS A TEXT POINTER AT THE FORMAL + LD H,(HL) ;PARAMETER LIST IN THE DEFINITION + LD L,A + LD A,H ; Is function DEFined? + OR L ;A ZERO TEXT POINTER MEANS THE FUNCTION WAS NEVER DEFINED + JP Z,UFN_ERR ; Err $12 - "Undefined user function" + LD A,(HL) ;SEE IF THERE ARE ANY PARAMETERS + CP '(' ;PARAMETER LIST STARTS WITH "("" + JP NZ,FINVLS ;SKIP OVER PARAMETER SETUP + RST CHRGTB ;GO PAST THE "(" + LD (TEMP3),HL ;SAVE THE TEXT POINTER TO THE START OF THE + EX DE,HL ;PARAMETER LIST. + LD HL,(NXTOPR) ;NOW GET THE TEXT-POINTER FROM THE CALL WHICH IS POINTING + ;JUST PAST THE FUNCTION NAME AT THE ARGUMENT LIST + RST SYNCHR + DEFB '(' ;MAKE SURE THE ARGUMENT LIST IS THERE + XOR A ;INDICATE END OF VALUES TO ASSIGN + PUSH AF + PUSH HL ;SAVE THE CALLERS TEXT POINTER + EX DE,HL ;GET THE POINTER TO THE BEGINNING OF THE PARAMETER LIST +ASGMOR: + LD A,$80 ;OUTLAW ARRAYS WHEN SCANNING + LD (SUBFLG),A ;PARAMETERS + CALL GETVAR ;READ A PARAMETER + EX DE,HL ;[D,E]=PARAMETER LIST TEXT,[H,L]=VARIABLE POINTER + EX (SP),HL ;SAVE THE VARIABLES POSITION AND GET THE POINTER AT THE ARG LIST + LD A,(VALTYP) ;AND ITS TYPE (FOR COERCION) + PUSH AF + PUSH DE ;SAVE THE TEXT POINTER INTO THE PARAMETER + CALL EVAL ;EVALUATE THE ARGUMENT + LD (NXTOPR),HL ;SAVE THE ARGUMENT LIST POINTER + POP HL ;AND THE PARAMETER LIST POINTER + LD (TEMP3),HL + POP AF ;GET THE VALUE TYPE + CALL CHKTYP ;COERCE THE ARGUMENT + LD C,$04 ;MAKE SURE THERE IS ROOM FOR THE VALUE + CALL CHKSTK ; Check for C levels on stack + LD HL,-8 ;SAVE EIGHT PLACES + ADD HL,SP + LD SP,HL + CALL VMOVMF ;PUT VALUE INTO RESERVED PLACE IN STACK + LD A,(VALTYP) ;SAVE TYPE FOR ASSIGNMENT + PUSH AF + LD HL,(NXTOPR) ;REGET THE ARGUMENT LIST POINTER + LD A,(HL) ;SEE WHAT COMES AFTER THE ARGUMENT FORMULA + CP ')' ;IS THE ARGUMENT LIST ENDING? + JR Z,POPASG ;MAKE SURE THE ARGUMENT LIST ALSO ENDED + RST SYNCHR + DEFB ',' ;SKIP OVER ARGUMENT COMMA + PUSH HL ;SAVE THE ARGUMENT LIST TEXT POINTER + LD HL,(TEMP3) ;GET THE TEXT POINTER INTO THE DEFINTION'S PARAMETER LIST + RST SYNCHR + DEFB ',' ;SKIP OVER THE PARAMETER LIST COMMA + JR ASGMOR ;AND BIND THE REST OF THE PARAMETERS + + +POPAS2: + POP AF ;IF ASSIGNMENT IS SUCESSFUL UPDATE PRMLN2 + LD (PRMLN2),A ;INDICATE NEW VARIABLE IS IN PLACE +POPASG: + POP AF ;GET THE VALUE TYPE + OR A + JR Z,FINASG ;ZERO MEANS NO MORE LEFT TO POP AND ASSIGN + LD (VALTYP),A + LD HL,$0000 ;POINT INTO STACK + ADD HL,SP ;TO GET SAVED VALUE + CALL VMOVFM ;PUT VALUE INTO FAC + LD HL,$0008 ;FREE UP STACK AREA + ADD HL,SP + LD SP,HL + POP DE ;GET PLACE TO STORE TO + LD L,$03 ;CALCULATE THE SIZE OF THE LOOKS (NAME) + +;LPSIZL: +; INC L ;INCREMENT SIZE +; DEC DE ;POINT AT PREVIOUS CHARACTER +; LD A,(DE) ;SEE IF IT IS THE LENGTH OR ANOTHER CHARACTER +; OR A +; JP M,LPSIZL ;HIGH BIT INDICATES STILL PART OF NAME + + DEC DE ;BACK UP OVER LOOKS + DEC DE + DEC DE + LD A,(VALTYP) ;GET SIZE OF VALUE + ADD A,L ;ADD ON SIZE OF NAME + LD B,A ;SAVE TOTAL LENGTH IN [B] + LD A,(PRMLN2) ;GET CURRENT SIZE OF BLOCK + LD C,A ;SAVE IN [C] + ADD A,B ;GET POTENTIAL NEW SIZE + CP $64 ;CAN'T EXCEED ALLOCATED STORAGE + JP NC,FC_ERR ; Err $05 - "Illegal function call" + PUSH AF ;SAVE NEW SIZE + LD A,L ;[A]=SIZE OF NAME + LD B,$00 ;[B,C]=SIZE OF PARM2 + LD HL,PARM2 ;BASE OF PLACE TO STORE INTO + ADD HL,BC ;[H,L]=PLACE TO START THE NEW VARIABLE + LD C,A ;[B,C]=LENGTH OF NAME OF VARIABLE + CALL BCTRAN ;PUT IN THE NEW NAME + LD BC,POPAS2 ;PLACE TO RETURN AFTER ASSIGNMENT + PUSH BC + PUSH BC ;SAVE EXTRA ENTRY ON STACK + JP LETCN4 ;PERFORM ASSIGNMENT ON [H,L] (EXTRA POP D) + +FINASG: + LD HL,(NXTOPR) ;GET ARGUMENT LIST POINTER + RST CHRGTB ;SKIP OVER THE CLOSING PARENTHESIS + PUSH HL ;SAVE THE ARGUMENT TEXT POINTER + LD HL,(TEMP3) ;GET THE PARAMETER LIST TEXT POINTER + RST SYNCHR + DEFB ')' ;MAKE SURE THE PARAMETER LIST ENDED AT THE SAME TIME + + DEFB $3E ; SKIP THE NEXT BYTE WITH "LD A,n" + +FINVLS: + PUSH DE ;HERE WHEN THERE WERE NO ARGUMENTS OR PARAMETERS SAVE THE TEXT POINTER OF THE CALLER + LD (TEMP3),HL ;SAVE THE TEXT POINTER OF THE FUNCTION + LD A,(PRMLEN) ;PUSH PARM1 STUFF ONTO THE STACK + ADD A,$04 ;WITH PRMLEN AND PRMSTK (4 BYTES EXTRA) + PUSH AF ;SAVE THE NUMBER OF BYTES + RRCA ;NUMBER OF TWO BYTE ENTRIES IN [A] + LD C,A + CALL CHKSTK ;IS THERE ROOM ON THE STACK? + POP AF ;[A]=AMOUNT TO PUT ONTO STACK + LD C,A + CPL ;COMPLEMENT [A] + INC A + LD L,A + LD H,$FF + ADD HL,SP ;SET UP NEW STACK + LD SP,HL ;SAVE THE NEW VALUE FOR PRMSTK + PUSH HL ;FETCH DATA FROM HERE + LD DE,PRMSTK + CALL BCTRAN + POP HL ;LINK PARAMETER BLOCK FOR GARBAGE COLLECTION + LD (PRMSTK),HL ;NOW PUT PARM2 INTO PARM1 + LD HL,(PRMLN2) ;SET UP LENGTH + LD (PRMLEN),HL + LD B,H + LD C,L ;[B,C]=TRANSFER COUNT + LD HL,PARM1 + LD DE,PARM2 + CALL BCTRAN + LD H,A ;CLEAR OUT PARM2 + LD L,A + LD (PRMLN2),HL + LD HL,(FUNACT) ;INCREMENT FUNCTION COUNT + INC HL + LD (FUNACT),HL ; Count of active functions + LD A,H + OR L ;SET UP ACTIVE FLAG NON-ZERO + LD (NOFUNS),A ; 0 if no function active + LD HL,(TEMP3) ;GET BACK THE FUNCTION DEFINITION TEXT POINTER + +; DCX H ;DETECT A MULTI-LINE FUNCTION +; CHRGET ;IF THE DEFINITION ENDS NOW +; JZ MULFUN ;IF ENDS, ITS A MULTI-LINE FUNCTION + + CALL FRMEQL ;SKIP OVER THE "=" IN THE DEFINITION AND EVALUATE THE DEFINITION FORMULA + ;CAN HAVE RECURSION AT THIS POINT + DEC HL + RST CHRGTB ;SEE IF THE STATEMENT ENDED RIGHT + JP NZ,SN_ERR ;THIS IS A CHEAT, SINCE THE LINE NUMBER OF THE ERROR WILL BE + ;THE CALLER'S LINE # INSTEAD OF THE DEFINITIONS LINE # + RST GETYPR ;SEE IF THE RESULT IS A STRING + JR NZ,NOCPRS ;WHOSE DESCRIPTOR IS ABOUT TO BE WIPED OUT BECAUSE IT IS SITTING IN PARM1 + ;(THIS HAPPENS IT THE FUNCTION IS A PROJECTION FUNCTION ON A STRING ARGUMENT) + LD DE,DSCTMP + LD HL,(FACLOW) + RST DCOMPR + JR C,NOCPRS ;RESULT IS A TEMP - NO COPY NESC + CALL STRCPY ;MAKE A COPY IN DSCTMP + CALL PUTTMP ;PUT RESULT IN A TEMP AND MAKE FACLO POINT AT IT +NOCPRS: + LD HL,(PRMSTK) ;GET PLACE TO RESTORE PARM1 FROM STACK + LD D,H + LD E,L + INC HL ;POINT AT LENGTH + INC HL + LD C,(HL) ;[B,C]=LENGTH + INC HL + LD B,(HL) + INC BC ;INCLUDE EXTRA BYTES + INC BC + INC BC + INC BC + LD HL,PRMSTK ;PLACE TO STORE INTO + CALL BCTRAN + EX DE,HL ;[D,E]=PLACE TO RESTORE STACK TO + LD SP,HL + LD HL,(FUNACT) ;DECREASE ACTIVE FUNCTION COUNT + DEC HL + LD (FUNACT),HL + LD A,H + OR L ;SET UP FUNCTION FLAG + LD (NOFUNS),A ; (0 if no function active) + POP HL ;GET BACK THE CALLERS TEXT POINTER + POP AF ;GET BACK THE TYPE OF THE FUNCTION + + ; --- START PROC CHKTYP --- +; a.k.a. DOCNVF (=force type conversion) +CHKTYP: + PUSH HL ;SAVE THE TEXT POINTER + AND $07 ;SETUP DISPATCH TO FORCE FORMULA TYPE + ;TO CONFORM TO THE VARIABLE ITS BEING ASSIGNED TO + LD HL,TYPE_OPR ;TABLE OF FORCE ROUTINES + LD C,A ;[B,C]=TWO BYTE OFFSET + LD B,$00 + ADD HL,BC + CALL DISPAT ;DISPATCH + POP HL ;GET BACK THE TEXT POINTER + RET + +; +; BLOCK TRANSFER ROUTINE WITH SOURCE IN [D,E] DESTINATION IN [H,L] +; AND COUNT IN [B,C]. TRANSFER IS FORWARD. +; +; Routine at 20873 +BCTRAL: + LD A,(DE) + LD (HL),A + INC HL + INC DE + DEC BC +BCTRAN: + LD A,B + OR C + JR NZ,BCTRAL + RET + +; Routine at 20883 +; +; SUBROUTINE TO SEE IF WE ARE IN DIRECT MODE AND COMPLAIN IF SO +; +; Check for a running program (Z if so). If a program is not running, generate +; an Illegal Direct (ID) error. +; +; Used by the routine at __DEF. +IDTEST: + PUSH HL ; Save code string address ;SAVE THEIR [H,L] + LD HL,(CURLIN) ; Get current line number ;SEE WHAT THE CURRENT LINE IS + INC HL ; -1 means direct statement ;DIRECT IS 65,535 SO NOW 0 + LD A,H + OR L ;IS IT ZERO NOW? + POP HL ; Restore code string address + RET NZ ; Return if in program ;RETURN IF NOT + LD E,$0C ; Err $0C - "Illegal direct" (ID_ERROR) ;"ILLEGAL DIRECT" ERROR + JP ERROR + +; Routine at 20897 +; +; SUBROUTINE TO GET A POINTER TO A FUNCTION NAME +; Make sure "FN" follows and get FN name +; +; Used by the routines at __DEF and DOFN. +GETFNM: + RST SYNCHR ; Make sure FN follows + DEFB TK_FN ;MUST START WITH "FN" + LD A,$80 ;DONT ALLOW AN ARRAY, + LD (SUBFLG),A ;DON'T RECOGNIZE THE "(" AS THE START OF AN ARRAY REFEREENCE + OR (HL) ; FN name has bit 7 set ;PUT FUNCTION BIT ON + LD C,A ; in first byte of name ;GET FIRST CHARACTER INTO [C] + JP GTFNAM ; Get FN name + +; Routine at 20909 +NOT_KEYWORD: + CP $7E ; = $FF-$81 .. Token codes smaller than $80 ? + JR NZ,NOT_KEYWORD_ERR + INC HL + LD A,(HL) + INC HL + CP TK_MID_S+$80 ; $83 + JP Z,LHSMID + CP TK_TRIG+$80 ; $A3 + JP Z,_TRIG + CP TK_INT+$80 ; $85 + JP Z,_INTERVAL +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HISMI ; Hook 2 for Runloop execute event +ENDIF +NOT_KEYWORD_ERR: + JP SN_ERR + +; Routine at 20937 +__WIDTH: + CALL GETINT ; GET WIDTH +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HWIDT ; Hook for "WIDTH" +ENDIF + AND A + JR Z,__WIDTH_1 + LD A,(OLDSCR) + AND A + LD A,E + JR Z,__WIDTH_0 + CP 32+1 + JR NC,__WIDTH_1 +__WIDTH_0: + CP 40+1 +__WIDTH_1: + JP NC,FC_ERR ; Err $05 - "Illegal function call" + LD A,(LINLEN) + CP E + RET Z + LD A,FF ; FORMFEED + RST OUTDO ; Output char to the current device + LD A,E + LD (LINLEN),A ;SETUP THE LINE LENGTH + LD A,(OLDSCR) + DEC A + LD A,E + JR NZ,__WIDTH_2 + LD (LINL32),A + JR __WIDTH_3 + +__WIDTH_2: + LD (LINL40),A +__WIDTH_3: + LD A,FF ; FORMFEED + RST OUTDO ; Output char to the current device + LD A,E + +; This entry point is used by the routine at __SCREEN. +__WIDTH_4: + SUB CLMWID + JR NC,__WIDTH_4 + ADD A,CLMWID*2 + CPL + INC A + ADD A,E + LD (CLMLST),A ; Column space + RET ;BACK TO NEWSTT + +; Routine at 21006 +; $520E +FPSINT: + RST CHRGTB ; Gets next character (or token) from BASIC text. +; +; This entry point is used by the routines at INTIDX, SCAN1 and __CIRCLE. +; $520F +FPSINT_0: + CALL EVAL ;EVALUATE A FORMULA +; +; Get integer variable to DE, error if negative +; Used by the routine at FNDNUM. +; $5212 +;CONVERT THE FAC TO AN INTEGER IN [D,E] +;AND SET THE CONDITION CODES BASED ON THE HIGH ORDER +DEPINT: + PUSH HL ;SAVE THE TEXT POINTER + CALL __CINT ;CONVERT THE FORMULA TO AN INTEGER IN [H,L] + EX DE,HL ;PUT THE INTEGER INTO [D,E] + POP HL ;RETSORE THE TEXT POINTER + LD A,D ;SET THE CONDITION CODES ON THE HIGH ORDER + OR A + RET + +; Routine at 21019 +; +; Used by the routines at L4A5A, OPRND and FILINP. +FNDNUM: + RST CHRGTB ; Gets next character (or token) from BASIC text. +; This entry point is used by the routines at SETIO, __WAIT, L492A, __ERROR, +; ISFUN, __WIDTH, __POKE, ATRSCN, __PAINT, LHSMID, MID_ARGSEP, FILSCN, __OPEN, RETRTS, +; FN_INPUT, __SOUND, __LOCATE, L77D4, __COLOR, __SCREEN, SET_BAUDRATE, PUT_SPRITE, __VDP, +; __VPOKE and __MAX. + +; a.k.a. GETBYT, get integer in 0-255 range +GETINT: + CALL EVAL ;EVALUATE A FORMULA +; This entry point is used by the routines at __CHR_S, FN_STRING, FN_INSTR, FILFRM, +; __STICK, __STRIG, __PDL and __PAD. +CONINT: + CALL DEPINT ;CONVERT THE FAC TO AN INTEGER IN [D,E] + JP NZ,FC_ERR ;WASN'T ERROR (Err $05 - "Illegal function call") + DEC HL ;ACTUALLY FUNCTIONS CAN GET HERE + ;WITH BAD [H,L] BUT NOT SERIOUS + ;SET CONDITION CODES ON TERMINATOR + RST CHRGTB + LD A,E ;RETURN THE RESULT IN [A] AND [E] + RET + + +; 'LLIST' BASIC command +; +; Routine at 21033 +__LLIST: ;PRTFLG=1 FOR REGULAR LIST + LD A,$01 ;GET NON ZERO VALUE + LD (PRTFLG),A ;SAVE IN I/O FLAG (END OF LPT) + +; 'LIST' BASIC command +; +; This entry point is used by the routine at __SAVE. +__LIST: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HLIST ; Hook for "LIST" +ENDIF + POP BC ;GET RID OF NEWSTT RETURN ADDR + CALL LNUM_RANGE ;SCAN LINE RANGE + PUSH BC ;SAVE POINTER TO 1ST LINE +__LIST_0: + LD HL,65535 ;DONT ALLOW ^C TO CHANGE + LD (CURLIN),HL ;CONTINUE PARAMETERS: Set interpreter in 'DIRECT' (immediate) mode + POP HL ;GET POINTER TO LINE + POP DE ;GET MAX LINE # OFF STACK + LD C,(HL) ;[B,C]=THE LINK POINTING TO THE NEXT LINE + INC HL + LD B,(HL) + INC HL + LD A,B ;SEE IF END OF CHAIN + OR C + JP Z,READY ;LAST LINE, STOP. + CALL ISFLIO ;DON'T ALLOW ^C ON FILE OUTPUT + CALL Z,ISCNTC ;CHECK FOR CONTROL-C + PUSH BC ;SAVE LINK + LD C,(HL) ;PUSH THE LINE # + INC HL + LD B,(HL) + INC HL + PUSH BC + EX (SP),HL ;GET LINE # INTO [H,L] + EX DE,HL ;GET MAX LINE IN [H,L] + RST DCOMPR ;PAST LAST LINE IN RANGE? + POP BC ;TEXT POINTER TO [B,C] + JP C,RESTART ;IF PAST, THEN DONE LISTING. + EX (SP),HL ;SAVE MAX ON BOTTOM OF STACK + PUSH HL ;SAVE LINK ON TOP + PUSH BC ;SAVE TEXT POINTER BACK + EX DE,HL ;GET LINE # IN [H,L] + LD (DOT),HL ;SAVE FOR LATER EDIT OR LIST <> AND WE WANT [H,L] ON THE STACK + CALL LINPRT ;PRINT AS INT WITHOUT LEADING SPACE + POP HL + LD A,(HL) ;GET BYTE FROM LINE + CP $09 ;IS IT A TAB? + JR Z,__LIST_1 ;THEN DONT PRINT SPACE + LD A,' ' + RST OUTDO ;PRINT A SPACE AFTER THE LINE # +__LIST_1: + CALL DETOKEN_LIST ;UNPACK THE LINE INTO BUF + LD HL,BUF ;POINT AT THE START OF THE UNPACKED CHARACTERS + CALL LISPRT ;PRINT THE LINE + CALL OUTDO_CRLF ;PRINT CRLF + JR __LIST_0 ;GO BACK FOR NEXT LINE + +; Routine at 21115 +; +; Used by the routine at __LLIST. +LISPRT: + LD A,(HL) + OR A ;SET CC + RET Z ;IF =0 THEN END OF LINE + CALL OUTCH1 ;OUTPUT CHAR AND CHECK FOR LF + INC HL ;INCR POINTER + JR LISPRT ;PRINT NEXT CHAR + +; Routine at 21124 +; +; Used by the routine at __LLIST. +DETOKEN_LIST: + LD BC,BUF ;GET START OF TEXT BUFFER + LD D,$FF ;GET ITS LENGTH INTO [D] + XOR A ;SET ON SPECIAL CHAR FOR SPACE INSERTION + LD (DORES),A ; a.k.a. OPRTYP, indicates whether stored word can be crunched, etc.. + JR PLOOP2 ;START HERE + +; block at 21135 + ; --- START PROC DETOKEN_NEXT --- +DETOKEN_NEXT: + INC BC ;INCREMENT DEPOSIT PTR. + INC HL ;ADVANCE TEXT PTR + DEC D ;BUMP DOWN COUNT + RET Z ;IF BUFFER FULL, RETURN + ; --- START PROC PLOOP2 --- +PLOOP2: + LD A,(HL) ;GET CHAR FROM BUF + OR A ;SET CC'S + LD (BC),A ;SAVE THIS CHAR + RET Z ;IF END OF SOURCE BUFFER, ALL DONE. + CP OCTCON ;IS IT SMALLER THAN SMALLEST EMBEDDED CONSTANT? (Not a number constant prefix ?) + JR C,NTEMBL ;YES, DONT TREAT AS ONE + CP DBLCON+1 ;IS IT EMBEDED CONSTANT? + JP C,NUMLIN ; JP if control code ;PRINT LEADING SPACE IF NESC. + CP '"' + JR NZ,DETOKEN_NEXT_2 + LD A,(OPRTYP) ; Temp operator number operations + XOR $01 + LD (OPRTYP),A ; Temp operator number operations + LD A,'"' +DETOKEN_NEXT_2: + CP ':' + JR NZ,NTEMBL + LD A,(OPRTYP) ; Temp operator number operations + RRA + JR C,DETOKEN_NEXT_3 + RLA + AND $FD + LD (OPRTYP),A ; Temp operator number operations +DETOKEN_NEXT_3: + LD A,':' +NTEMBL: + OR A + JP P,DETOKEN_NEXT + LD A,(OPRTYP) ; Temp operator number operations + RRA + JR C,_DETOKEN_NEXT + RRA + RRA + JR NC,DETOKEN + LD A,(HL) + CP TK_APOSTROPHE ;SINGLE QUOTE TOKEN? + PUSH HL + PUSH BC + LD HL,__DETOKEN_NEXT + PUSH HL + RET NZ + + ; ..or with the ':REM' sequence.. + DEC BC + LD A,(BC) + CP 'M' + RET NZ + DEC BC + LD A,(BC) + CP 'E' + RET NZ + DEC BC + LD A,(BC) + CP 'R' + RET NZ + DEC BC + LD A,(BC) + CP ':' + RET NZ + + POP AF + POP AF + POP HL + INC D ; add 4 to line byte counter D + INC D + INC D + INC D ;FIX UP CHAR COUNT + JR PLOOPR + +; Routine at 21237 +__DETOKEN_NEXT: + POP BC + POP HL + LD A,(HL) +; This entry point is used by the routine at DETOKEN. +_DETOKEN_NEXT: + JP DETOKEN_NEXT + +; Routine at 21243 +; +; Used by the routine at DETOKEN. +SET_DATA_FLAG: + LD A,(DORES) ; a.k.a. OPRTYP, indicates whether stored word can be crunched, etc.. + OR $02 +; This entry point is used by the routine at SET_REM_FLAG. +UPD_OPRTYP: + LD (DORES),A ; a.k.a. OPRTYP, indicates whether stored word can be crunched, etc.. + XOR A + RET + +; Routine at 21253 +; +; Used by the routine at DETOKEN. +SET_REM_FLAG: + LD A,(DORES) ; a.k.a. OPRTYP, indicates whether stored word can be crunched, etc.. + OR $04 + JR UPD_OPRTYP + +; Routine at 21260 +DETOKEN: + RLA + JR C,_DETOKEN_NEXT + LD A,(HL) + CP TK_DATA + CALL Z,SET_DATA_FLAG + CP TK_REM + CALL Z,SET_REM_FLAG + +PLOOPR: + LD A,(HL) + INC A ;SET ZERO IF FN TOKEN + LD A,(HL) ;GET CHAR BACK + JR NZ,NTFNTK ;NOT FUNCTION JUST TREAT NORMALLY + INC HL ;BUMP POINTER + LD A,(HL) ;GET CHAR + AND $7F ;TURN OFF HIGH BIT +NTFNTK: + INC HL + CP TK_ELSE + JR NZ,DETOKEN_1 + DEC BC + INC D +DETOKEN_1: + PUSH HL ;SAVE TEXT PTR. + PUSH BC ;SAVE DEPOSIT PTR. + PUSH DE ;SAVE CHAR COUNT. +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HBUFL ; Hook for Detokenise event +ENDIF + + LD HL,WORDS-1 ;GET PTR TO START OF RESERVED WORD LIST + LD B,A ;SAVE THIS CHAR IN [B] + LD C,'A'-1 ;INIT LEADING CHAR VALUE +RESSR3: + INC C ;BUMP LEADING CHAR VALUE. +RESSR1: + INC HL ;BUMP POINTER INTO RESLST + LD D,H ;SAVE PTR TO START OF THIS RESWRD + LD E,L +RESSRC: + LD A,(HL) ;GET CHAR FROM RESLST + OR A ;SET CC'S + JR Z,RESSR3 ;IF END OF THIS CHARS TABLE, GO BACK & BUMP C + INC HL ;BUMP SOURCE PTR + JP P,RESSRC ;IF NOT END OF THIS RESWRD, THEN KEEP LOOKING + LD A,(HL) ;GET PTR TO RESERVED WORD VALUE + CP B ;SAME AS THE ONE WE SEARCH FOR? + JR NZ,RESSR1 ;NO, KEEP LOOKING. + EX DE,HL + LD A,C ;GET LEADING CHAR + POP DE + POP BC + CP 'Z'+1 ;WAS IT A SPECIAL CHAR? + JR NZ,NTSPCH ;NON-SPECIAL CHAR +MORPUR: + LD A,(HL) ;GET BYTE FROM RESWRD + INC HL ;BUMP POINTER +NTSPCH: + LD E,A ;SAVE CHAR + AND $7F ;AND OFF HIGH ORDER BIT FOR DISK & EDIT + LD (BC),A ;STORE THIS CHAR + INC BC + DEC D ;ANY SPACE LEFT IN BUFFER + JP Z,POPAF ;NO, RETURN + OR E ;SET CC'S + JP P,MORPUR ;END OF RESWRD? + POP HL ;RESTORE SOURCE PTR. + JP PLOOP2 ;GET NEXT CHAR FROM LINE + +; Routine at 21345 +NUMLIN: + DEC HL ;MOVE POINTER BACK AS CHRGET INX'S + RST CHRGTB ;SCAN THE CONSTANT + PUSH DE ;SAVE CHAR COUNT + PUSH BC ;SAVE DEPOSIT PTR + PUSH AF ;SAVE CONSTANT TYPE. + CALL CONFAC ;MOVE CONSTANT INTO FAC + POP AF ;RESTORE CONSTANT TYPE + LD BC,CONLIN ;PUT RETURN ADDR ON STACK + PUSH BC ;SAVE IT + CP OCTCON ;OCTAL CONSTANT? + JP Z,FOUTO ;PRINT IT + CP HEXCON ;HEX CONSTANT? + JP Z,FOUTH ;PRINT IN HEX + LD HL,(CONLO) ;GET LINE # VALUE IF ONE. + JP FOUT ;PRINT REMAINING POSSIBILITIES. + +; Routine at 21374 +CONLIN: + POP BC ;RESTORE DEPOSIT PTR. + POP DE ;RESTORE CHAR COUNT + LD A,(CONSAV) ;GET SAVED CONSTANT TOKEN + LD E,'O' ;ASSUME OCTAL CONSTANT + CP OCTCON ;OCTAL CONSTANT? + JR Z,SAVBAS ;YES, PRINT IT + CP HEXCON ;HEX CONSTANT? + LD E,'H' ;ASSUME SO. + JR NZ,NUMSLN ;NOT BASE CONSTANT +SAVBAS: + LD A,'&' ;PRINT LEADING BASE INDICATOR + LD (BC),A ;SAVE IT + INC BC ;BUMP PTR + DEC D ;BUMP DOWN CHAR COUNT + RET Z ;RETURN IF END OF BUFFER + LD A,E ;GET BASE CHAR + LD (BC),A ;SAVE IT + INC BC ;BUMP PTR + DEC D ;BUMP DOWN BASE COUNT + RET Z ;END OF BUFFER, DONE +NUMSLN: + LD A,(CONTYP) ;GET TYPE OF CONSTANT WE ARE + CP $04 ;IS IT SINGLE OR DOUBLE PREC? + LD E,$00 ;NO, NEVER PRINT TRAILING TYPE INDICATOR + JR C,TYPSET + LD E,'!' ;ASSUME SINGLE PREC. + JR Z,TYPSET ;IS CONTYP=4, WAS SINGLE + LD E,'#' ;DOUBLE PREC INDICATOR +TYPSET: + LD A,(HL) ;GET LEADING CHAR + CP ' ' ;LEADING SPACE + JR NZ,NUMSL2 ;GO BY IT + INC HL +NUMSL2: + LD A,(HL) ;GET CHAR FROM NUMBER BUFFER + INC HL ;BUMP POINTER + OR A ;SET CC'S + JR Z,NUMDN ;IF ZERO, ALL DONE. + LD (BC),A ;SAVE CHAR IN BUF. + INC BC ;BUMP PTR + DEC D ;SEE IF END OF BUFFER + RET Z ;IF END OF BUFFER, RETURN + LD A,(CONTYP) ;GET TYPE OF CONSTANT TO BE PRINTED + CP $04 ;TEST FOR SINGLE OR DOUBLE PRECISION + JR C,NUMSL2 ;NO, WAS INTEGER + DEC BC ;PICK UP SAVED CHAR + LD A,(BC) ;EASIER THAN PUSHING ON STACK + INC BC ;RESTORE TO POINT WHERE IT SHOULD + JR NZ,DBLSCN ;IF DOUBLE, DONT TEST FOR EMBEDED "." + CP '.' ;TEST FOR FRACTION ; $2E + JR Z,ZERE ;IF SINGLE & EMBEDED ., THEN DONT PRINT ! +DBLSCN: +; Double Precision specifier (exponential syntax, e.g. -1.09432D-06) + CP 'D' ;DOUBLE PREC. EXPONENT? + JR Z,ZERE ;YES, MARK NO VALUE TYPE INDICATOR NESC. +; Exponential format specifier (e.g. -1.09E-06) + CP 'E' ;SINGLE PREC. EXPONENT? + JR NZ,NUMSL2 ;NO, PROCEED +ZERE: + LD E,$00 ;MARK NO PRINTING OF TYPE INDICATOR + JR NUMSL2 ;KEEP MOVING NUMBER CHARS INTO BUF + +NUMDN: + LD A,E ;GET FLAG TO INDICATE WHETHER TO INSERT + OR A ;A "D" AFTER DOUBLE PREC. # + JR Z,NOD ;NO, DONT INSERT IT + LD (BC),A ;SAVE IN BUFFER + INC BC ;BUMP POINTER + DEC D ;DECRMENT COUNT OF CHARS LEFT IN BUFFER + RET Z ;=0, MUST TRUNCATE LIST OF THIS LINE. +NOD: + LD HL,(CONTXT) ;GET BACK TEXT POINTER AFTER CONSTANT + JP PLOOP2 ;GET NEXT CHAR + +; +; THE FOLLOWING CODE IS FOR THE DELETE RANGE +; COMMAND. BEFORE THE LINES ARE DELETED, 'OK' +; IS TYPED. +; +; Routine at 21474 +__DELETE: + CALL LNUM_RANGE ;SCAN LINE RANGE + PUSH BC + CALL DEPTR ;CHANGE POINTERS BACK TO NUMBERS + POP BC + POP DE ;POP MAX LINE OFF STACK + PUSH BC ;SAVE POINTER TO START OF DELETION FOR USE BY CHEAD AFTER FINI + PUSH BC ;SAVE POINTER TO START OF 1ST LINE + CALL SRCHLN ;FIND THE LAST LINE + JR NC,FCERRG ;MUST HAVE A MATCH ON THE UPPER BOUND + LD D,H ;[D,E] = POINTER AT THE START OF THE LINE + LD E,L ;BEYOND THE LAST LINE IN THE RANGE + EX (SP),HL ;SAVE THE POINTER TO THE NEXT LINE + PUSH HL ;SAVE THE POINTER TO THE START OF THE FIRST LINE IN THE RANGE + RST DCOMPR ;MAKE SURE THE START COMES BEFORE THE END +FCERRG: + JP NC,FC_ERR ;IF NOT, Err $05 - "Illegal function call" + LD HL,OK_MSG ;PRINT "OK" PREMATURELY + CALL PRS + POP BC ;GET POINTER TO FIRST IN [B,C] + LD HL,FINI ;GO BACK TO FINI WHEN DONE + EX (SP),HL ;[H,L]=POINTER TO THE NEXT LINE + + +; --- START PROC __DELETE_0 --- +; +; ERASE A LINE FROM MEMORY +; [B,C]=START OF LINE BEING DELETED +; [D,E]=START OF NEXT LINE +; +__DELETE_0: + EX DE,HL ;[D,E] NOW HAVE THE POINTER TO THE LINE BEYOND THIS ONE + LD HL,(VARTAB) ;COMPACTIFYING TO VARTAB +MLOOP: + LD A,(DE) + LD (BC),A ;SHOVING DOWN TO ELIMINATE A LINE + INC BC + INC DE + RST DCOMPR ; Compare HL with DE. + JR NZ,MLOOP ;DONE COMPACTIFYING? + LD H,B + LD L,C + LD (VARTAB),HL + LD (ARYTAB),HL + LD (STREND),HL + RET + +; +; NOTE: IN THE 8K PEEK ONLY ACCEPTS POSITIVE NUMBERS UP TO 32767 +; POKE WILL ONLY TAKE AN ADDRESS UP TO 32767 , NO +; FUDGING ALLOWED. THE VALUE IS UNSIGNED. +; IN THE EXTENDED VERSION NEGATIVE NUMBERS CAN BE +; USED TO REFER TO LOCATIONS HIGHER THAN 32767. +; THE CORRESPONDENCE IS GIVEN BY SUBTRACTING 65536 FROM LOCATIONS +; HIGHER THAN 32767 OR BY SPECIFYING A POSITIVE NUMBER UP TO 65535. +; + +; Routine at 21532 +__PEEK: + CALL GETWORD_HL ;GET AN INTEGER IN [H,L] + LD A,(HL) ;GET THE VALUE TO RETURN + JP PASSA ;AND FLOAT IT + +; Routine at 21539 +__POKE: + CALL GETWORD ;READ A FORMULA + PUSH DE + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + CALL GETINT ; Get integer 0-255 + POP DE + LD (DE),A + RET + +; Routine at 21551 +; Get a number to DE (0..65535) +; a.k.a. FRMQNT +; Used by the routines at SETIO, DEF_USR, __POKE, __CLEAR, ONGO and __TIME. +GETWORD: + CALL EVAL + PUSH HL + CALL GETWORD_HL + EX DE,HL + POP HL + RET + +; Routine at 21561 +; +; Used by the routines at FOUTH(BIN, OCT...), __PEEK, GETWORD and BSAVE_PARM. +GETWORD_HL: + LD BC,__CINT ;RETURN HERE + PUSH BC ;SAVE ADDR + RST GETYPR ;SET THE CC'S ON VALTYPE + RET M ;RETURN IF ALREADY INTEGER. +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HFRQI ; Hook for "convert to integer" +ENDIF + CALL SIGN ; test FP number sign + RET M + CALL __CSNG + LD BC,$3245 ; BCDE = 32768 (float) + LD DE,$8076 + CALL FCOMP + RET C + LD BC,$6545 ; BCDE = 65536 (float) + LD DE,$6053 + CALL FCOMP + JP NC,OV_ERR ; Err $06 - "Overflow" + LD BC,$65C5 ; BCDE = -65536 (float) + LD DE,$6053 + JP FADD + +; Data block at 21608 +__RENUM: + LD BC,10 ;ASSUME INC=10 + PUSH BC ;SAVE ON STACK + LD D,B ;RESEQ ALL LINES BY SETTING [D,E]=0 + LD E,B + JR Z,__RENUM_2 ;IF JUST 'RESEQ' RESEQ 10 BY 10 + CP ',' ;COMMA + JR Z,__RENUM_1 ;DONT USE STARTING # OF ZERO + PUSH DE ;SAVE [D,E] + CALL LNUM_PARM ;GET NEW NN + LD B,D ;GET IN IN [B,C] WHERE IT BELONGS + LD C,E + +; Routine at 21626 +__RENUM_0: + POP DE ;GET BACK [D,E] + JR Z,__RENUM_2 ;IF EOS, DONE +__RENUM_1: + RST SYNCHR + DEFB ',' ;EXPECT COMMA + CALL LNUM_PARM ;GET NEW MM + JR Z,__RENUM_2 ;IF EOS, DONE + POP AF ;GET RID OF OLD INC + RST SYNCHR + DEFB ',' ;EXPECT COMMA + PUSH DE ;SAVE MM + CALL ATOH ;GET NEW INC + JP NZ,SN_ERR ;SHOULD HAVE TERMINATED. + LD A,D ;SEE IF INC=0 (ILLEGAL) + OR E + JP Z,FC_ERR ;YES, BLOW HIM UP NOW (Err $05 - "Illegal function call") + EX DE,HL ;FLIP NEW INC & [H,L] + EX (SP),HL ;NEW INC ONTO STACK + EX DE,HL ;GET [H,L] BACK, ORIG [D,E] BACK +__RENUM_2: + PUSH BC ;SAVE NN ON STACK + CALL SRCHLN ;FIND MM LINE + POP DE ;GET NN OFF STACK + PUSH DE ;SAVE NN BACK + PUSH BC ;SAVE POINTER TO MM LINE + CALL SRCHLN ;FIND FIRST LINE TO RESEQ. + LD H,B ;GET PTR TO THIS LINE IN [H,L] + LD L,C + POP DE ;GET LINE PTD TO BY MM + RST DCOMPR ;COMPARE TO FIRST LINE RESEQED + EX DE,HL ;GET PTR TO MM LINE IN [H,L] + JP C,FC_ERR ;CANT ALLOW PROGRAM TO BE RESEQUED ON TOP OF ITSELF (Err $05 - "Illegal function call") + POP DE ;GET NN BACK + POP BC ;GET INC IN [B,C] + POP AF ;GET RID OF NEWSTT + PUSH HL ;SAVE PTR TO FIRST LINE TO RESEQ. + PUSH DE ;SAVE NN ON STACK + JR __RENUM_4 + +; Routine at 21679 +__RENUM_NXT: + ADD HL,BC ;ADD INCREMENT INTO + JP C,FC_ERR ;UH OH, HIS INC WAS TOO LARGE. (Err $05 - "Illegal function call") + EX DE,HL ;FLIP LINK FIELD, ACCUM. + PUSH HL ;SAVE LINK FIELD + LD HL,65529 ;TEST FOR TOO LARGE LINE + RST DCOMPR ;COMPARE TO CURRENT # + POP HL ;RESTORE LINK FIELD + JP C,FC_ERR ;UH OH, HIS INC WAS TOO LARGE. (Err $05 - "Illegal function call") +__RENUM_4: + PUSH DE ;SAVE CURRENT LINE ACCUM + LD E,(HL) ;GET LINK FIELD INTO [D,E] + INC HL ;GET LOW PART INTO K[A] FOR ZERO TEST + LD D,(HL) + LD A,D ;GET HIGH PART OF LINK + OR E ;SET CC'S ON LINK FIELD + EX DE,HL ;SEE IF NEXT LINK ZERO + POP DE ;GET BACK ACCUM LINE # + JR Z,__RENUM_FIN ;ZERO, DONE + LD A,(HL) ;GET FIRST BYTE OF LINK + INC HL ;INC POINTER + OR (HL) ;SET CC'S + DEC HL ;MOVE POINTER BACK + EX DE,HL ;BACK IN [D,E] + JR NZ,__RENUM_NXT ;INC COUNT + +__RENUM_FIN: + PUSH BC ;SAVE INC + CALL SCCLIN ;SCAN PROGRAM CONVERTING LINES TO PTRS. + POP BC ;GET BACK INC + POP DE ;GET NN + POP HL ;GET PTR TO FIRST LINE TO RESEQ +__RENUM_LP: + PUSH DE ;SAVE CURRENT LINE + LD E,(HL) ;GET LINK FIELD + INC HL ;PREPARE FOR ZERO LINK FIELD TEST + LD D,(HL) + LD A,D + OR E + JR Z,LINE2PTR ;STOP RESEQING WHEN SEE END OF PGM + EX DE,HL ;FLIP LINE PTR, LINK FIELD + EX (SP),HL ;PUT LINK ON STACK, GET NEW LINE # OFF + EX DE,HL ;PUT NEW LINE # IN [D,E], THIS LINE PTR IN [H,L] + INC HL ;POINT TO LINE # FIELD. + LD (HL),E ;CHANGE TO NEW LINE # + INC HL + LD (HL),D + EX DE,HL ;GET THIS LINE # IN [H,L] + ADD HL,BC ;ADD INC + EX DE,HL ;GET NEW LINE # BACK IN [D,E] + POP HL ;GET PTR TO NEXT LINE + JR __RENUM_LP ;KEEP RESEQING + +; Routine at 21738 +; +; Used by the routines at __DELETE, __CLOAD and __CSAVE_1. +DEPTR: + LD A,(PTRFLG) + OR A + RET Z + JR SCCPTR + + ; --- START PROC LINE2PTR --- +LINE2PTR: + LD BC,RESTART ;WHERE TO GO WHEN DONE + PUSH BC ;SAVE ON STACK + + DEFB $FE ; 'CP $F6' masking the next byte/instr. + +; THE SUBROUTINES SCCLIN AND SCCPTR CONVERT ALL +; LINE #'S TO POINTERS AND VICE-VERSA. +; THE ONLY SPECIAL CASE IS "ON ERROR GOTO 0" WHERE THE "0" +; IS LEFT AS A LINE NUMBER TOKEN SO IT WONT BE CHANGED BY RESEQUENCE. + +SCCLIN: + DEFB $F6 ; 'OR $AF' masking the next instruction + +SCCPTR: + XOR A ;SET A=0 + + LD (PTRFLG),A ;SET TO SAY WHETER LINES OR PTRS EXTANT + LD HL,(TXTTAB) ; Start of program text GET PTR TO START OF PGM + DEC HL ; NOP NEXT INX. + +SCNPLN: + INC HL ; POINT TO BYTE AFTER ZERO AT END OF LINE + LD A,(HL) ; Get address of next line GET LINK FIELD INTO [D,E] + INC HL ; BUMP PTR + OR (HL) ; End of program found? SET CC'S + RET Z ; Yes - Line not found RETURN IF ALL DONE. + INC HL ; POINT PAST LINE # + LD E,(HL) ; Get LSB of line number GET LOW BYTE OF LINE # + INC HL + LD D,(HL) ; Get MSB of line number GET HIGH BYTE OF LINE # +SCNEXT: + RST CHRGTB ;GET NEXT CHAR FROM LINE + +; Line number to pointer +_LINE2PTR: + OR A ;END OF LINE + JR Z,SCNPLN ;SCAN NEXT LINE + LD C,A ;SAVE [A] + LD A,(PTRFLG) ;CHANGE LINE TOKENS WHICH WAY? + OR A ;SET CC'S + LD A,C ;GET BACK CURRENT CHAR + JR Z,SCNPT2 ;CHANGING POINTERS TO #'S +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HSCNE ; Hook for 'Line number to pointer' event +ENDIF + CP TK_ERROR ;IS IT ERROR TOKEN? + JR NZ,NTERRG ;NO. + RST CHRGTB ;SCAN NEXT CHAR + CP TK_GOTO ;ERROR GOTO? + JR NZ,_LINE2PTR ;GET NEXT ONE + RST CHRGTB ;GET NEXT CHAR + CP LINCON ; Line number prefix (LINCON): LINE # CONSTANT? + JR NZ,_LINE2PTR ;NO, IGNORE. + PUSH DE ;SAVE [D,E] + CALL LINGT3 ;GET IT + LD A,D ;IS IT LINE # ZERO? + OR E ;SET CC'S + JR NZ,CHGPTR ;CHANGE IT TO A POINTER + JR SCNEX3 ;YES, DONT CHANGE IT + +NTERRG: + CP LINCON ; Line number prefix (LINCON): LINE # CONSTANT? + JR NZ,SCNEXT ;NOT, KEEP SCANNING + PUSH DE ;SAVE CURRENT LINE # FOR POSSIBLE ERROR MSG + CALL LINGT3 ;GET LINE # OF LINE CONSTANT INTO [D,E] +CHGPTR: + PUSH HL ;SAVE TEXT POINTER JUST AT END OF LINCON 3 BYTES + CALL SRCHLN ;TRY TO FIND LINE IN PGM. + DEC BC ;POINT TO ZERO AT END OF PREVIOUS LINE + LD A,PTRCON ;CHANGE LINE # TO PTR + JR C,MAKPTR ;IF LINE FOUND CHANE # TO PTR + CALL CONSOLE_CRLF ;PRINT CRLF IF REQUIRED + LD HL,LINE_ERR_MSG ;PRINT "Undefined line" MESSAGE + PUSH DE ;SAVE LINE # + CALL PRS ;PRINT IT + POP HL ;GET LINE # IN [H,L] + CALL LINPRT ;PRINT IT + POP BC ;GET TEXT PTR OFF STACK + POP HL ;GET CURRENT LINE # + PUSH HL ;SAVE BACK + PUSH BC ;SAVE BACK TEXT PTR + CALL IN_PRT ;PRINT IT +SCNPOP: + POP HL ;POP OFF CURRENT TEXT POINTER +SCNEX3: + POP DE ;GET BACK CURRENT LINE # + DEC HL ;BACKUP POINTER + +_SCNEXT: + JR SCNEXT ;KEEP SCANNING + +; Message at 21850 +LINE_ERR_MSG: + DEFM "Undefined line " + DEFB $00 + +; Routine at 21866 +SCNPT2: + CP PTRCON ; POINTER? + JR NZ,_SCNEXT + PUSH DE + CALL LINGT3 + PUSH HL + EX DE,HL + INC HL + INC HL + INC HL + LD C,(HL) + INC HL + LD B,(HL) + LD A,LINCON ; Line number prefix +; This entry point is used by the routine at LINE2PTR. +MAKPTR: + LD HL,SCNPOP + PUSH HL + LD HL,(CONTXT) + +; This entry point is used by the routine at RUNLIN. +CONCH2: + PUSH HL + DEC HL + LD (HL),B + DEC HL + LD (HL),C + DEC HL + LD (HL),A + POP HL + RET + + +; SYNCHR - REPLACEMENTS FOR COMPAR & SYNCHK IN RSTLES VERSION +; Routine at 21900 +; +; Used by the routine at _SYNCHR. +__SYNCHR: + LD A,(HL) + EX (SP),HL + CP (HL) ;CMPC-IS CHAR THE RIGHT ONE? + INC HL + EX (SP),HL + JP NZ,SN_ERR ;GIVE ERROR IF CHARS DONT MATCH + JP __CHRGTB + +; Routine at 21911 +; +; Used by the routine at _GETYPR. +; Return the number type (FAC) +; +__GETYPR: + LD A,(VALTYP) + CP $08 ; set M,PO.. flags +; +; CONTINUATION OF GETYPE RST +; + JR NC,NCASE ;SPLIT OFF NO CARRY CASE + SUB $03 ;SET A CORRECTLY + OR A ;NOW SET LOGICAL'S OK + SCF ;CARRY MUST BE SET + RET ;ALL DONE +NCASE: + SUB $03 ;SUBTRACT CORRECTLY + OR A ;SET CC'S PROPERLY + RET ;RETURN + + +; '_' works like a shortcut for 'CALL' +; Routine at 21927 +CALL_SHCUT: + RST CHRGTB ; Gets next character (or token) from BASIC text. + + +__CALL: + LD DE,PROCNM + LD B,$0F +__CALL_0: + LD A,(HL) + AND A + JR Z,__CALL_1 + CP ':' + JR Z,__CALL_1 + CP '(' ;Eat left paren + JR Z,__CALL_1 + LD (DE),A + INC DE + INC HL + DJNZ __CALL_0 +__CALL_1: + LD A,B + CP $0F ; Did we find 0, ':', or '(' at first position ? + JR Z,__CALL_5 +__CALL_2: ; No, skip spaces + XOR A + LD (DE),A + DEC DE + LD A,(DE) + CP ' ' + JR Z,__CALL_2 + LD B,$40 + LD DE,SLTATR +__CALL_3: + LD A,(DE) + AND $20 + JR NZ,__CALL_6 +__CALL_4: + INC DE + DJNZ __CALL_3 +__CALL_5: + JP SN_ERR + +__CALL_6: + PUSH BC + PUSH DE + PUSH HL + CALL L7E2A + PUSH AF + LD C,A + LD L,$04 + CALL RDSLT_WORD + PUSH DE + POP IX + POP IY + POP HL + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + CALL CALSLT + POP DE + POP BC + JR C,__CALL_4 + RET + +; Routine at 22008 +; +; Used by the routine at GET_DEVNAME. +; deal with exceptions/expansions +L55F8: + POP HL + LD A,B + CP $10 ; TK_INP ? + JR C,L55F8_0 + LD B,$0F +L55F8_0: + CALL L7FB7 ; "RESUME NEXT"+1, copy in ROM ?? +L55F8_1: + CALL MAKUPL ; Load A with char in 'HL' and make it uppercase + LD (DE),A + INC HL + INC DE + DJNZ L55F8_1 + XOR A + LD (DE),A + LD B,$40 + LD DE,SLTATR +L55F8_2: + LD A,(DE) + AND $40 + JR NZ,L55F8_5 +L55F8_3: + INC DE + DJNZ L55F8_2 +L55F8_4: + JP NM_ERR ; Err $38 - 'Bad file name' + +L55F8_5: + PUSH BC + PUSH DE + CALL L7E2A + PUSH AF + LD C,A + LD L,$06 + CALL RDSLT_WORD + PUSH DE + POP IX + POP IY + LD A,$FF + CALL CALSLT + POP DE + POP BC + JR C,L55F8_3 + LD C,A + LD A,$40 + SUB B + ADD A,A + ADD A,A + OR C + CP $09 + JR C,L55F8_4 + CP $FC ; TK_BKSLASH ? + JR NC,L55F8_4 + POP HL + POP DE + AND A + RET + +; Routine at 22090 +; +; Used by the routine at L6F85. +L564A: + PUSH BC + PUSH AF + RRA + RRA + AND $3F + CALL L7E2A_0 + PUSH AF + LD C,A + LD L,$06 + CALL RDSLT_WORD + PUSH DE + POP IX + POP IY + POP AF + AND $03 + LD (DEVICE),A + POP BC + POP AF + POP DE + POP HL + JP CALSLT + + + +; ________________________________________________________ + +; +; MACLNG - MACRO LANGUAGE DRIVER +; +; MICROSOFT GRAPHICS AND SOUND MACRO LANGUAGES +; + + +; Data block at 22124 +MACLNG: + LD (MCLTAB),DE ;SAVE POINTER TO COMMAND TABLE + CALL EVAL ;EVALUATE STRING ARGUMENT + PUSH HL ;SAVE TXTPTR TILL DONE + LD DE,$0000 ;PUSH DUMMY ENTRY TO MARK END OF STK + PUSH DE ;DUMMY ADDR + PUSH AF ;DUMMY LENGTH +MCLNEW: + CALL GETSTR + CALL LOADFP ;GET LENGTH & POINTER + LD B,C + LD C,D + LD D,E + LD A,B + OR C + JR Z,MCLOOP ;Don't Push if addr is 0 + LD A,D + OR A + JR Z,MCLOOP ; or if Len is 0... + PUSH BC ;PUSH ADDR OF STRING + PUSH DE ;PUT IN [AL] +MCLOOP: + POP AF ;GET LENGTH OFF STACK + LD (MCLLEN),A + POP HL ;GET ADDR + LD A,H ;SEE IF LAST ENTRY + OR L + JR NZ,MACLNG_0 + LD A,(MCLFLG) ;Are we using PLAY macros ? + OR A + JP Z,MC_POPTRT ;ALL FINISHED IF ZERO + JP MCLPLAY_0 ;Yes, go for the extras + + +MACLNG_0: + LD (MCLPTR),HL ;SET UP POINTER + +; This entry point is used by the routines at __PLAY_2 and DOSND. +MCLSCN: + CALL FETCHR ;GET A CHAR FROM STRING + JR Z,MCLOOP ;END OF STRING - SEE IF MORE ON STK + ADD A,A ;PUT CHAR * 2 INTO [C] + LD C,A + LD HL,(MCLTAB) ;POINT TO COMMAND TABLE +MSCNLP: + LD A,(HL) ;GET CHAR FROM COMMAND TABLE + ADD A,A ;CHAR = CHAR * 2 (CLR HI BIT FOR CMP) +GOFCER: + CALL Z,FC_ERR ;END OF TABLE. ( Err $05 - "Illegal function call" ) + CP C ;HAVE WE GOT IT? + JR Z,MISCMD ;YES. + INC HL ;MOVE TO NEXT ENTRY + INC HL + INC HL + JR MSCNLP + +MISCMD: + LD BC,MCLSCN ;RETURN TO TOP OF LOOP WHEN DONE + PUSH BC + LD A,(HL) ;SEE IF A VALUE NEEDED + LD C,A ;PASS GOTTEN CHAR IN [C] + ADD A,A + JR NC,MNOARG ;COMMAND DOESN'T REQUIRE ARGUMENT + OR A ;CLEAR CARRY + RRA ;MAKE IT A CHAR AGAIN + LD C,A ;PUT IN [C] + PUSH BC + PUSH HL ;SAVE PTR INTO CMD TABLE + CALL FETCHR ;GET A CHAR + LD DE,$0001 ;DEFAULT ARG=1 + JP Z,VSNARG_0 ;NO ARG IF END OF STRING + CALL ISLETTER_A ;SEE IF POSSIBLE LETTER + JP NC,VSNARG + CALL VALSC3 ;GET THE VALUE + SCF ;SET CARRY TO FLAG USING NON-DEFAULT + JR ISCMD3 + +VSNARG: + CALL DECFET ;PUT CHAR BACK INTO STRING +VSNARG_0: + OR A ;CLEAR CARRY +ISCMD3: + POP HL + POP BC ;GET BACK COMMAND CHAR +MNOARG: + INC HL ;POINT TO DISPATCH ADDR + LD A,(HL) ;GET ADDRESS INTO HL + INC HL + LD H,(HL) + LD L,A + JP (HL) ;DISPATCH + + + +; This entry point is used by the routines at VALSCN, SCNVAR and DMOVE. +FETCHZ: + CALL FETCHR ;GET A CHAR FROM STRING + JR Z,GOFCER ;GIVE ERROR IF END OF LINE + RET + +; Routine at 22254 +; +; Used by the routines at L5683, VALSCN, PLAY_NOTE and DOSND. +FETCHR: + PUSH HL +FETCH2: + LD HL,MCLLEN ;POINT TO STRING LENGTH + LD A,(HL) + OR A + JR Z,MC_POPTRT ;RETURN Z=0 IF END OF STRING + DEC (HL) ;UPDATE COUNT FOR NEXT TIME + LD HL,(MCLPTR) ;GET PTR TO STRING + LD A,(HL) ;GET CHARACTER FROM STRING + INC HL ;UPDATE PTR FOR NEXT TIME + LD (MCLPTR),HL + CP ' ' ;SKIP SPACES + JR Z,FETCH2 + CP 'a'-1 ;CONVERT LOWER CASE TO UPPER + JR C,MC_POPTRT + SUB $20 ;DO CONVERSION +; This entry point is used by the routine at L5683. +MC_POPTRT: + POP HL + RET + +; Routine at 22283 +; +; Used by the routines at L5683, VALSCN, DMOVE, PLAY_NOTE and DOSND. +DECFET: + PUSH HL + LD HL,MCLLEN ;INCREMENT LENGTH + INC (HL) + LD HL,(MCLPTR) ;BACK UP POINTER + DEC HL + LD (MCLPTR),HL + POP HL + RET + +; Routine at 22297 +; +; Used by the routine at DMOVE. +VALSCN: + CALL FETCHZ ;GET FIRST CHAR OF ARGUMENT +; This entry point is used by the routine at L5683. +VALSC3: + CP '=' ;NUMERIC? + JP Z,VARGET + CP '+' ;PLUS SIGN? + JR Z,VALSCN ;THEN SKIP IT + CP '-' ;NEGATIVE VALUE? + JR NZ,VALSC2 + LD DE,NEGD ;IF SO, NEGATE BEFORE RETURNING + PUSH DE + JR VALSCN ;EAT THE "-" + +; This entry point is used by the routine at DOSND. +VALSC2: + LD DE,$0000 ;INITIAL VALUE OF ZERO +NUMLOP: + CP ',' ;COMMA + JR Z,DECFET ;YES, BACK UP AND RETURN + CP ';' ;SEMICOLON? + RET Z ;YES, JUST RETURN + CP '9'+1 ;NOW SEE IF ITS A DIGIT + JR NC,DECFET ;IF NOT, BACK UP AND RETURN + CP '0' + JR C,DECFET + + LD HL,$0000 ;[HL] is accumulator + LD B,$0A ;[HL]=[DE]*10 +MUL10: + ADD HL,DE + JR C, SCNFC ;overflow - JMP Function Call Error + DJNZ MUL10 + + SUB '0' ;ADD IN THE DIGIT + LD E,A + LD D,$00 + ADD HL,DE + JR C, SCNFC ;overflow - JMP Function Call Error + EX DE,HL ;VALUE SHOULD BE IN [DE] + CALL FETCHR ;GET NEXT CHAR + JR NZ,NUMLOP ;branch if not end of string + RET + + +; (GW-BASIC has extra code here to "Allow VARPTR$(variable) for BASCOM compatibility") +; +; Routine at 22362 +; Used by the routines at VARGET and MCLXEQ. +SCNVAR: + CALL FETCHZ ;MAKE SURE FIRST CHAR IS LETTER + LD DE,BUF ;PLACE TO COPY NAME FOR PTRGET + PUSH DE ;SAVE ADDR OF BUF FOR "ISVAR" + LD B,40 ;COPY MAX OF 40 CHARACTERS + CALL ISLETTER_A ;MAKE SURE IT'S A LETTER + JR C,SCNFC ;FC ERROR IF NOT LETTER +SCNVLP: + LD (DE),A ;STORE CHAR IN BUF + INC DE + CP ';' ;A SEMICOLON? + JR Z,SCNV2 ;YES - END OF VARIABLE NAME + CALL FETCHZ ;GET NEXT CHAR + DJNZ SCNVLP + +; This entry point is used by the routine at VALSCN. + SCNFC: + CALL FC_ERR ;ERROR - VARIABLE TOO LONG +SCNV2: + POP HL ;GET PTR TO BUF + JP EVAL_VARIABLE ;GO GET ITS VALUE + +; Routine at 22394 +; +; Used by the routine at VALSCN. +VARGET: + CALL SCNVAR ;SCAN & EVALUATE VARIABLE + CALL __CINT ;MAKE IT AN INTEGER + EX DE,HL ;IN [DE] + RET + +; Routine at 22402 +; +; Used by the DRAW and PLAY routines. +; Plays MML stored in string variable A$ *3 / Executes a drawing substring +MCLXEQ: + CALL SCNVAR ;SCAN VARIABLE NAME + LD A,(MCLLEN) ;SAVE CURRENT STRING POS & LENGTH + LD HL,(MCLPTR) + EX (SP),HL ;POP OFF RET ADDR, PUSH MCLPTR + PUSH AF + LD C,$02 ;MAKE SURE OF ROOM ON STACK + CALL CHKSTK + JP MCLNEW + +; Routine at 22421 +NEGD: + XOR A + SUB E + LD E,A + SBC A,D + SUB E + LD D,A + RET + +; ________________________________________________________ +; End of MACRO LANGUAGE block + + + +; +; ALLOW A COORDINATE OF THE FORM (X,Y) OR STEP(X,Y) +; THE LATTER IS RELATIVE TO THE GRAPHICS AC. +; THE GRAPHICS AC IS UPDATED WITH THE NEW VALUE +; RESULT IS RETURNED WITH [B,C]=X AND [D,E]=Y +; CALL SCAN1 TO GET FIRST IN A SET OF TWO PAIRS SINCE IT ALLOWS +; A NULL ARGUMENT TO IMPLY THE CURRENT AC VALUE AND +; IT WILL SKIP A "@" IF ONE IS PRESENT +; + +; Routine at 22428 +; +; Used by the routines at LINE, __PAINT, __CIRCLE and PUT_SPRITE. +SCAN1: + LD A,(HL) ;GET THE CURRENT CHARACTER + CP '@' ;ALLOW MEANINGLESS "@" + CALL Z,__CHRGTB ;BY SKIPPING OVER IT + LD BC,$0000 ;ASSUME NO COODINATES AT ALL (-SECOND) + LD D,B + LD E,C + CP TK_MINUS ; "-", SEE IF ITS SAME AS PREVIOUS + JR Z,SCANN ;USE GRAPHICS ACCUMULATOR + +; +; THE STANDARD ENTRY POINT +; + +; This entry point is used by the routines at __PSET and FN_POINT. +SCAND: + LD A,(HL) ;GET THE CURRENT CHARACTER + ;CP TK_MINUS ; '-' + CP TK_STEP ;IS IT RELATIVE? ; If STEP is used, coordinates are interpreted relative to the current cursor position. + ; In this case the values can also be negative. + PUSH AF ;REMEMBER + CALL Z,__CHRGTB ;SKIP OVER $STEP TOKEN + RST SYNCHR + DEFB '(' ;SKIP OVER OPEN PAREN + CALL FPSINT_0 ;SCAN X INTO [D,E] + PUSH DE ;SAVE WHILE SCANNING Y + RST SYNCHR + DEFB ',' ;SCAN COMMA + CALL FPSINT_0 ;GET Y INTO [D,E] + RST SYNCHR + DEFB ')' + POP BC ;GET BACK X INTO [B,C] + POP AF ;RECALL IF RELATIVE OR NOT + +SCANN: + PUSH HL ;SAVE TEXT POINTER + LD HL,(GRPACX) ;GET OLD POSITION + JR Z,SCXREL ;IF ZERO,RELATIVE SO USE OLD BASE ; JP if 'STEP' is specified + LD HL,$0000 ;IN ABSOLUTE CASE, JUST Y USE ARGEUMENT +SCXREL: + ADD HL,BC ;ADD NEW VALUE + LD (GRPACX),HL ;UPDATE GRAPHICS ACCUMLATOR + LD (GXPOS),HL ;STORE SECOND COORDINTE FOR CALLER + LD B,H ;RETURN X IN BC + LD C,L + LD HL,(GRPACY) ;GET OLDY POSITION + JR Z,SCYRE ;IF ZERO, RELATIVE SO USE OLD BASE ; JP if 'STEP' is specified + LD HL,$0000 ;ABSOLUTE SO OFFSET BY 0 +SCYRE: + ADD HL,DE + LD (GRPACY),HL ;UPDATE Y PART OF ACCUMULATOR + LD (GYPOS),HL ;STORE Y FOR CALLER + EX DE,HL ;RETURN Y IN [D,E] + POP HL ;GET BACK THE TEXT POINTER ; code string address + RET + + + +; +; PSET (X,Y)[,ATTRIBUTE] DEFAULT ATTRIBUTE TO FORCLR +; PRESET (X,Y)[,ATTRIBUTE] DEFAULT ATTIBUTE TO BAKCLR +; + +; Routine at 22501 +__PRESET: + LD A,(BAKCLR) + JR __PSET_0 + + +; Routine at 22506 +__PSET: + LD A,(FORCLR) ; Get default color (PSET=foreground) +; This entry point is used by the routine at __PRESET. +__PSET_0: + PUSH AF ; Save default color ;SAVE DEFAULT ATTRIBUTE + CALL SCAND ; Get coordinates in BC, DE ;SCAN A SINGLE COORDINATE + POP AF ; Restore default color ;GET BACK DEFAULT ATTRIBUTE + CALL ATRENT ; Get color, if specified ;SCAN POSSIBLE ATTRIBUTE + PUSH HL ; Save code string address ;SAVE TEXT POINTER + CALL SCALXY ;SCALE INTO BOUNDS + JR NC,PSTNOT ;NO PSET IF NOT IN BOUNDS + CALL MAPXY ;MAP INTO A "C" ; Find position in VRAM. CLOC=memory address, CMASK=color pixelmask + CALL SETC ;ACTUALLY DO THE SET +PSTNOT: + POP HL ; Restore code string address + RET + + +; Routine at 22531 +; +; Used by the routine at OPRND. +FN_POINT: + RST CHRGTB ; Gets next character (or token) from BASIC text. ;POINT IS RECOGNIZED IN EVAL SO NEED TO SKIP ONE MORE CHAR + PUSH HL ; Save code string address ; Save the text pointer. + CALL FETCHC ; Save cursor ;Preserve the graphics cursor, GXPOS, + POP DE ; Move code string address to DE ;and GYPOS across the POINT function + PUSH HL ; Save cursor position ;so cases like + PUSH AF ; Save cursor mask ;LINE (x1,y1)-(x2,y2),POINT(x3,y3) will + LD HL,(GYPOS) ; Make a copy of GX, GY ;work correctly. + PUSH HL + LD HL,(GXPOS) ; etc.. + PUSH HL + LD HL,(GRPACY) + PUSH HL + LD HL,(GRPACX) + PUSH HL + EX DE,HL ; Move code string address to HL ;Put the text pointer back in HL. + CALL SCAND ; Get coordinates in BC, DE ;READ THE SPECIFICATION OF THE POINT + PUSH HL ; Save code string address ;SAVE THE TEXT POINTER + CALL SCALXY ;SCALE THE POINT + LD HL,-1 ;ASSUME ILLEGAL POINT + JR NC,PNTNOT ;NOT LEGAL - RETURN -1 + CALL MAPXY ; Set addresses for dot position + CALL READC ;READ OUT THE ATTRIBUTE + LD L,A + LD H,$00 +PNTNOT: + CALL MAKINT ;Restore text pointer + POP DE ; Code string address + POP HL + LD (GRPACX),HL ; Restore GX, GY.. + POP HL ;Restore GXPOS, GYPOS, and the graphics + LD (GRPACY),HL ; ..etc.. ;cursor. + POP HL + LD (GXPOS),HL ; ..to the original .. + POP HL + LD (GYPOS),HL ; ...values + POP AF ; Restore cursor mask + POP HL ; Restore cursor position + PUSH DE ; Save code string address + CALL STOREC ; Restore cursor + POP HL ; Restore code string address ;Retrieve the text pointer and return. + RET + + +; +; ATTRIBUTE SCAN +; LOOK AT THE CURRENT POSITION AND IF THERE IS AN ARGUMENT READ IT AS +; THE 8-BIT ATTRIBUTE VALUE TO SEND TO SETATR. IF STATEMENT HAS ENDED +; OR THERE IS A NULL ARGUMENT, SEND FORCLR TO SETATR +; +; Routine at 22605 +; Used by the routines at LINE, __PAINT and __CIRCLE. +ATRSCN: + LD A,(FORCLR) +; This entry point is used by the routine at __PSET. +ATRENT: + PUSH BC + PUSH DE + LD E,A + CALL IN_GFX_MODE ; "Illegal function call" if not in graphics mode + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + JR Z,ATRFIN ;USE DEFAULT + RST SYNCHR + DEFB ',' ;INSIST ON COMMA + CP ',' ;ANOTHER COMMA FOLLOWS? + JR Z,ATRFIN ;IF SO, NULL ARGUMENT SO USE DEFAULT + CALL GETINT ;GET THE BYTE ; Get integer 0-255 +ATRFIN: + LD A,E ;GET ATTRIBUTE INTO [A] + PUSH HL ;SAVE THE TEXT POINTER + CALL SETATR ; Set attribute byte + JP C,FC_ERR ;Graphics not available ; Err $05 - "Illegal function call" + POP HL + POP DE ;GET BACK CURRENT POINT + POP BC + JP __CHRCKB ; Gets current character (or token) from BASIC text. + + + +; +; XDELT SETS [H,L]=ABS(GXPOS-[B,C]) AND SETS CARRY IF [B,C].GT.GXPOS +; ALL REGISTERS EXCEPT [H,L] AND [A,PSW] ARE PRESERVED +; NOTE: [H,L] WILL BE A DELTA BETWEEN GXPOS AND [B,C] - ADD 1 FOR AN X "COUNT" +; + +; Routine at 22641 +; Used by the routines at LINE and DOGRPH. +XDELT: + LD HL,(GXPOS) ;GET ACCUMULATOR POSITION + LD A,L + SUB C + LD L,A ;DO SUBTRACT INTO [H,L] + LD A,H + SBC A,B + LD H,A +; This entry point is used by the routine at YDELT. +XDELT_0: + RET NC ;IF NO CARRY, NO NEED TO NEGATE COUNT + +; This entry point is used by the routines at DOGRPH, STPAIN, NEGDE, CPLOT8 and +; DMOVE. +NEGHL: + XOR A ;STANDARD [H,L] NEGATE + SUB L ; Negate exponent + LD L,A ; Re-save exponent + SBC A,H + SUB L + LD H,A + SCF + RET + + +; +; YDELT SETS [H,L]=ABS(GYPOS-[D,E]) AND SETS CARRY IF [D,E].GT.GYPOS +; ALL REGISTERS EXCEPT [H,L] AND [A,PSW] ARE PRESERVED +; + +; Routine at 22659 +; Used by the routines at LINE and DOGRPH. +YDELT: + LD HL,(GYPOS) + ; HL=HL-DE + LD A,L + SUB E + LD L,A + LD A,H + SBC A,D + LD H,A + ; + JR XDELT_0 + + + +; +; XCHGX EXCHANGES [B,C] WITH GXPOS +; XCHGY EXCHANGES [D,E] WITH GYPOS +; XCHGAC PERFORMS BOTH OF THE ABOVE +; NONE OF THE OTHER REGISTERS IS AFFECTED +; + +; Routine at 22670 +; +; Used by the routines at XCHGAC and LINE. +XCHGY: + PUSH HL + LD HL,(GYPOS) + EX DE,HL + LD (GYPOS),HL + POP HL + RET + +; Routine at 22680 +; Used by the routines at LINE and DOGRPH. +XCHGAC: + CALL XCHGY + +; This entry point is used by the routine at LINE. +XCHGX: + PUSH HL + PUSH BC + LD HL,(GXPOS) + EX (SP),HL + LD (GXPOS),HL + POP BC + POP HL + RET + + + +; +; LINE [(X1,Y1)]-(X2,Y2) [,ATTRIBUTE[,B[F]]] +; DRAW A LINE FROM (X1,Y1) TO (X2,Y2) EITHER +; 1. STANDARD FORM -- JUST A LINE CONNECTING THE 2 POINTS +; 2. ,B=BOXLINE -- RECTANGLE TREATING (X1,Y1) AND (X2,Y2) AS OPPOSITE CORNERS +; 3. ,BF= BOXFILL -- FILLED RECTANGLE WITH (X1,Y1) AND (X2,Y2) AS OPPOSITE CORNERS +; + +; Routine at 22695 +; Used by the routine at __LINE. +LINE: + CALL SCAN1 ;SCAN THE FIRST COORDINATE + PUSH BC ;SAVE THE POINT + PUSH DE + RST SYNCHR + DEFB TK_MINUS ;MAKE SURE ITS PROPERLY SEPERATED + CALL SCAND ;SCAN THE SECOND SET ; Get coordinates in BC, DE + CALL ATRSCN ;SCAN THE ATTRIBUTE + POP DE ;GET BACK THE FIRST POINT + POP BC + JR Z,DOLINE ;IF STATEMENT ENDED ITS A NORMAL LINE + RST SYNCHR + DEFB ',' ;OTHERWISE MUST HAVE A COMMA + RST SYNCHR + DEFB 'B' ;AND A "B" + JP Z,BOXLIN ;IF JUST "B" THE NON-FILLED BOX + + RST SYNCHR + DEFB 'F' ;MUST BE FILLED BOX +DOBOXF: + PUSH HL ;SAVE THE TEXT POINTER + CALL SCALXY ;SCALE FIRST POINT + CALL XCHGAC ;SWITCH POINTS + CALL SCALXY ;SCALE SECOND POINT + CALL YDELT ;SEE HOW MANY LINES AND SET CARRY + CALL C,XCHGY ;MAKE [D,E] THE SMALLEST Y + INC HL ;MAKE [H,L] INTO A COUNT + PUSH HL ;SAVE COUNT OF LINES + CALL XDELT ;GET WIDTH AND SMALLEST X + CALL C,XCHGX ;MAKE [B,C] THE SMALLEST X + INC HL ;MAKE [H,L] INTO A WIDTH COUNT + PUSH HL ;SAVE WIDTH COUNT + CALL MAPXY ;MAP INTO A "C" (Set addresses for initial dot position) + POP DE ;GET WIDTH COUNT + POP BC ;GET LINE COUNT + +BOXLOP: + PUSH DE ;SAVE WIDTH + PUSH BC ;SAVE NUMBER OF LINES + CALL FETCHC ;LOOK AT CURRENT C ; Save cursor + PUSH AF ;SAVE BIT MASK OF CURRENT "C" + PUSH HL ;SAVE ADDRESS + EX DE,HL ;SET UP FOR NSETCX WITH COUNT + CALL NSETCX ;IN [H,L] OF POINTS TO SETC + POP HL ;GET BACK STARTING C + POP AF ;ADDRESS AND BIT MASK + CALL STOREC ;SET UP AS CURRENT "C" ; Restore cursor + CALL DOWNC ;MOVE TO NEXT LINE DOWN IN Y + POP BC ;GET BACK NUMBER OF LINES + POP DE ;GET BACK WIDTH + DEC BC ;COUNT DOWN LINES + LD A,B ;SEE IF ANY LEFT + OR C + JR NZ,BOXLOP ;KEEP DRAWING MORE LINES + POP HL ;RESTORE TEXT POINTER + RET + +DOLINE: + PUSH BC ;SAVE COORDINATES + PUSH DE + PUSH HL ;SAVE TEXT POINTER + CALL DOGRPH + LD HL,(GRPACX) ;RESTORE ORIGINAL SECOND COORDINATE + LD (GXPOS),HL + LD HL,(GRPACY) ;FOR BOXLIN CODE + LD (GYPOS),HL + POP HL ;RESTORE TEXT POINTER + POP DE + POP BC + RET + +BOXLIN: + PUSH HL ;SAVE TEXT POINTER + LD HL,(GYPOS) + PUSH HL ;SAVE Y2 + PUSH DE ;SAVE Y1 + EX DE,HL ;MOVE Y2 TO Y1 + CALL DOLINE ;DO TOP LINE + POP HL ;MOVE Y1 TO Y2 + LD (GYPOS),HL + EX DE,HL + CALL DOLINE + POP HL ;GET BACK Y2 + LD (GYPOS),HL ;AND RESTORE + LD HL,(GXPOS) ;GET X2 + PUSH BC ;SAVE X1 + LD B,H ;SET X1=X2 + LD C,L + CALL DOLINE + POP HL + LD (GXPOS),HL ;SET X2=X1 + LD B,H ;RESTORE X1 TO [B,C] + LD C,L + CALL DOLINE + POP HL ;RESTORE THE TEXT POINTER + RET + + +; +; DOGRPH DRAWS A LINE FROM ([B,C],[D,E]) TO (GXPOS,GYPOS) +; + +; Routine at 22844 +; +; Used by the routines at LINE and CLINE2. +DOGRPH: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HDOGR ; Hook for line drawing event +ENDIF + CALL SCALXY ;CHEATY SCALING - JUST TRUNCATE FOR NOW + CALL XCHGAC + CALL SCALXY + CALL YDELT ;GET COUNT DIFFERENCE IN [H,L] + CALL C,XCHGAC ;IF CURRENT Y IS SMALLER NO EXCHANGE + PUSH DE ;SAVE Y1 COORDINATE + PUSH HL ;SAVE DELTA Y + CALL XDELT + EX DE,HL ;PUT DELTA X INTO [D,E] + LD HL,RIGHTC ;ASSUME X WILL GO RIGHT + JR NC,LINCN2 + LD HL,LEFTC + +LINCN2: + EX (SP),HL ;PUT ROUTINE ADDRESS ON STACK AND GET DELTA Y + RST DCOMPR ;SEE WHICH DELTA IS BIGGER + JR NC,YDLTBG ;YDELTA IS BIGGER OR EQUAL + LD (MINDEL),HL ;SAVE MINOR AXIS DELTA (Y) + POP HL ;GET X ACTION ROUTINE + LD (MAXUPD+1),HL ;SAVE IN MAJOR ACTION ADDRESS ; MAXUPD = JP nn for RIGHTC, LEFTC and DOWNC + LD HL,DOWNC ;ALWAYS INCREMENT Y + LD (MINUPD+1),HL ;WHICH IS THE MINOR AXIS ; MINUPD = JP nn for RIGHTC, LEFTC and DOWNC + EX DE,HL ;[H,L]=DELTA X=MAJOR DELTA + JR LINCN3 ;MERGE WITH YDLTBG CASE AND DO DRAW + +YDLTBG: + EX (SP),HL ;ACTION ROUTINE FOR X INTO [H,L], SAVE DELTA Y ON THE STACK + LD (MINUPD+1),HL ;SAVE ADDRESS OF MINOR AXIS UPDATE ; MINUPD = JP nn for RIGHTC, LEFTC and DOWNC + LD HL,DOWNC ;Y IS ALWAYS INCREMENT MODE + LD (MAXUPD+1),HL ;SAVE AS MAJOR AXIS UPDATE ; MAXUPD = JP nn for RIGHTC, LEFTC and DOWNC + EX DE,HL ;[H,L]=DELTA X + LD (MINDEL),HL ;SAVE MINOR DELTA + POP HL ;[H,L]=DELTA Y=MAJOR DELTA + + + + +; MAJOR AXIS IS ONE WITH THE LARGEST DELTA +; MINOR IS THE OTHER +; READY TO DRAW NOW +; MINUPD+1=ADDRESS TO GO TO UPDATE MINOR AXIS COORDINATE +; MAXUPD+1=ADDRESS TO GO TO UPDATE MAJOR AXIS COORDINATE +; [H,L]=MAJOR AXIS DELTA=# OF POINTS-1 +; MINDEL=DELTA ON MINOR AXIS +; +; IDEA IS +; SET SUM=MAJOR DELTA/2 +; [B,C]=# OF POINTS +; MAXDEL=-MAJOR DELTA (CONVENIENT FOR ADDING) +; LINE LOOP (LINLP3): +; DRAW AT CURRENT POSITION +; UPDATE MAJOR AXIS +; SUM=SUM+MINOR DELTA +; IF SUM.GT.MAJOR DELTA THEN UPDATE MINOR AND SUM=SUM-MAJOR DELTA +; DECREMENT [B,C] AND TEST FOR 0 -- LOOP IF NOT +; END LOOP +; +LINCN3: + POP DE ;GET BACK Y1 + PUSH HL + CALL NEGHL + LD (MAXDEL),HL ;SAVE MAJOR DELTA FOR SUMMING + CALL MAPXY ;GET POSITION INTO BITMSK AND [H,L] ; Set addresses for initial dot position + POP DE + PUSH DE ;START SUM AT MAXDEL/2 + CALL DE_DIV2 ; "RR DE" + POP BC ;GET COUNT IN [B,C] + INC BC ;NUMBER OF POINTS IS DELTA PLUS ONE + JR LINLP3 + +; Routine at 22931 +LINLOP: + POP HL + LD A,B ;CONTINUE UNTIL COUNT EXHAUSTED + OR C + RET Z +LINLOP_0: + CALL MAXUPD ;UPDATE MAJOR AXIS + + + +; Inner loop of line code. +; +; This entry point is used by the routine at DOGRPH. +LINLP3: + CALL SETC ;SET CURRENT POINT + DEC BC + PUSH HL + LD HL,(MINDEL) ;ADD SMALL DELTA TO SUM + ADD HL,DE + EX DE,HL + LD HL,(MAXDEL) + ADD HL,DE + JR NC,LINLOP ;TIME TO UPDATE MINOR? + EX DE,HL + POP HL + LD A,B ;CONTINUE UNTIL COUNT EXHAUSTED + OR C + RET Z + CALL MINUPD ;UPDATE MAJOR AXIS ; MINUPD = JP nn for RIGHTC, LEFTC and DOWNC + JR LINLOP_0 + + +; a.k.a. HLFDE +; Routine at 22964 +; "RR DE" - Used by the routines at DOGRPH, __CIRCLE and DSCLDE. +DE_DIV2: + LD A,D + OR A ;CLEAR CARRY + RRA ;SCALE MEANS SHIFTING RIGHT ONE + LD D,A + LD A,E + RRA + LD E,A + RET + + +; Routine at 22972 +; +; Used by the routine at ATRSCN. +IN_GFX_MODE: + LD A,(SCRMOD) + CP $02 + RET P + JP FC_ERR ; Err $05 - "Illegal function call" + + +; PAINT - Fill an area with color +; +; Routine at 22981 +__PAINT: + CALL SCAN1 ;GET (X,Y) OF START + PUSH BC ;SAVE COORDS OF START + PUSH DE + CALL ATRSCN ;SET FILL ATTRIBUTE AS CURRENT + LD A,(ATRBYT) ;DEFAULT BORDER COLOR IS SAME AS FILL + LD E,A ;DEFAULT ATTRIBUTE TO [E] LIKE GETBYT + DEC HL + RST CHRGTB + JR Z,GOTBRD ;NOTHING THERE - USE DEFAULT + RST SYNCHR + DEFB ',' ;MAKE SURE OF COMMA + CALL GETINT ;GET BORDER COLOR ARGUMENT +GOTBRD: + LD A,E ;BORDER ATTRIBUTE TO A + CALL PNTINI ;INIT PAINT STUFF & CHECK BORDER ATTRIB + JP C,FC_ERR ; Err $05 - "Illegal function call" + POP DE ;GET BACK START COORDS + POP BC + PUSH HL ;SAVE TXTPTR UNTIL DONE + CALL CHKRNG ;MAKE SURE POINT IS ON SCREEN + CALL MAPXY ; Set addresses for initial dot position + LD DE,$0001 ;ENTRY COUNT IS ONE (SKIP NO BORDER) + LD B,$00 + CALL SCANR1 ;SCAN RIGHT FROM INITIAL POSITION + JR Z,POPTRT ;STARTED ON BORDER - GET TXTPTR & QUIT + PUSH HL ;SAVE NO. OF POINTED PAINTED TO RIGHT + CALL SCANL1 ;NOW SCAN LEFT FROM INITIAL POS. + POP DE ;GET RIGHT SCAN COUNT. + ADD HL,DE ;ADD TO LEFT SCAN COUNT + EX DE,HL ;COUNT TO [DE] + XOR A + CALL ENTST1 + LD A,$40 ;MAKE ENTRY FOR GOING DOWN + CALL ENTST1 + LD B,$C0 ;CAUSE PAINTING UP + JR STPAIN ;START PAINTING UPWARD + +; This entry point is used by the routines at STPAIN and __CIRCLE. +POPTRT: + POP HL ;GET BACK TEXTPTR + RET + + +; +; MAIN PAINT LOOP +; + +; Data block at 23050 +PNTLOP: + CALL CKCNTC ;CHECK FOR CTRL-C ABORT + LD A,(LOHDIR) + OR A + JR Z,PNTLP1 + LD HL,(LOHADR) + PUSH HL + LD HL,(LOHMSK) + PUSH HL + LD HL,(LOHCNT) + PUSH HL +PNTLP1: + POP DE + POP BC + POP HL + LD A,C + CALL STOREC ; Restore cursor + +STPAIN: + LD A,B ;GET DIRECTION + LD (PDIREC),A ; Direction of the paint + ADD A,A ;SEE WHETHER TO GO UP, DOWN, OR QUIT + JR Z,POPTRT ;IF ZERO, ALL DONE. + PUSH DE ;SAVE SKPCNT IN CASE TUP&TDOWN DON'T + JR NC,PDOWN ;IF POSITIVE, GO DOWN FIRST + CALL TUPC ;MOVE UP BEFORE SCANNING + JR PDOWN2 + +PDOWN: + CALL TDOWNC ;SEE IF AT BOTTOM & MOVE DOWN IF NOT +PDOWN2: + POP DE ;GET SKPCNT BACK + JR C,PNTLP1 ;OFF SCREEN - GET NEXT ENTRY + LD B,$00 + CALL SCANR1 ;SCAN RIGHT & SKIP UP TO SKPCNT BORDER + JP Z,PNTLP1 ;IF NO POINTS PAINTED, GET NEXT ENTRY + + XOR A + LD (LOHDIR),A + CALL SCANL1 ;NOW SCAN LEFT FROM START POINT + LD E,L ;[DE] = LEFT MOVCNT + LD D,H + OR A ;SEE IF LINE WAS ALREADY PAINTED + JR Z,PNTLP3 ;IT WAS - DON'T MAKE OVERHANG ENTRY + DEC HL ;IF LMVCNT.GT.1, NEED TO MAKE ENTRY + DEC HL ;IN OPPOSITE DIRECTION FOR OVERHANG. + LD A,H + ADD A,A ;SEE IF [HL] WAS .GT. 1 + JR C,PNTLP3 + LD (LOHCNT),DE + CALL FETCHC ;GET CURRENT POINT ADDRESS + LD (LOHADR),HL + LD (LOHMSK),A ;CMASK + LD A,(PDIREC) ;GET BACK DIRECTION AND INDEX + CPL + LD (LOHDIR),A +PNTLP3: + LD HL,(MOVCNT) ;GET COUNT PAINTED DURING RIGHT SCAN + ADD HL,DE ;ADD TO LEFT MOVCNT + EX DE,HL ;ENTRY COUNT TO [DE] + CALL ENTSLR ;GO MAKE ENTRY. + + LD HL,(CSAVEA) ;SET CURRENT LOCATION BACK TO END + LD A,(CSAVEM) ;OF RIGHT SCAN. + CALL STOREC + +PNTLP4: + LD HL,(SKPCNT) ;CALC SKPCNT - MOVCNT TO SEE IF + LD DE,(MOVCNT) ;ANY MORE BORDER TO SKIP + OR A + SBC HL,DE + JR Z,GOPLOP ;NO MORE - END OF THIS SCAN + JR C,PNTLP6 ;RIGHT OVERHANG - SEE IF ENTRY NEEDED + EX DE,HL ;SKIP COUNT TO [DE] FOR SCANR + LD B,$01 + CALL SCANR1 ;HERE IF NEED TO CONTINUE RIGHT SCAN + JR Z,GOPLOP ;NO MORE POINTS. + OR A ;SEE IF LINE ALREADY PAINTED + JR Z,PNTLP4 ;YES, DON'T ENTER ANYTHING + EX DE,HL ;ENTRY COUNT TO [DE] + LD HL,(CSAVEA) ;MAKE ENTRY AT LOCATION SAVED BY SCANR + LD A,(CSAVEM) ;SO WE CAN ENTER A POSITIVE SKPCNT + LD C,A + LD A,(PDIREC) + LD B,A + CALL ENTSTK ;MAKE ENTRY + JR PNTLP4 ;CONTINUE UNTIL SKPCNT .LE. 0 + +PNTLP6: + CALL NEGHL ;MAKE NEW SKPCNT POSITIVE + DEC HL ;IF SKPCNT-MOVCNT .LT. -1 + DEC HL ;THEN RIGHT OVERHANG ENTRY IS NEEDED. + LD A,H ;SEE IF POSITIVE. + ADD A,A + JR C,GOPLOP ;OVERHANG TOO SMALL FOR NEW ENTRY + + INC HL ;NOW MOVE LEFT TO BEGINNING OF SCAN + PUSH HL ;SO WE CAN ENTER A POSITIVE SKPCNT +RTOVH1: + CALL LEFTC ;START IS -(SKPCNT-MOVCNT)-1 TO LEFT + DEC HL + LD A,H + OR L + JR NZ,RTOVH1 +;RTOVH2: + POP DE ;GET BACK ENTRY SKPCNT INTO [DE] + LD A,(PDIREC) ;MAKE ENTRY IN OPPOSITE DIRECTION + CPL + CALL ENTST1 ;MAKE ENTRY +GOPLOP: + JP PNTLOP ;GO PROCESS NEXT ENTRY + + + +; Routine at 23234 +; +; Used by the routine at STPAIN. +ENTSLR: + LD A,(LFPROG) ;DON'T STACK IF SCANNED LINE + LD C,A ;WAS ALREADY PAINTED + LD A,(RTPROG) + OR C + RET Z ;Z IF SCAN LINE ALREADY PAINTED + + LD A,(PDIREC) +; This entry point is used by the routines at __PAINT and STPAIN. +ENTST1: + LD B,A ;DIRECTION IN [B] + CALL FETCHC ;LOAD REGS WITH CURRENT "C" + LD C,A ;BIT MASK IN [C] + +; This entry point is used by the routine at STPAIN. +ENTSTK: + EX (SP),HL + PUSH BC + PUSH DE + PUSH HL + LD C,$02 + JP CHKSTK ;IS ENOUGH SPACE LEFT OUT + +; Data block at 23260 +SCANR1: + CALL SCANR ;PERFORM LOW LEVEL RIGHT SCAN + LD (SKPCNT),DE ;SAVE UPDATED SKPCNT + LD (MOVCNT),HL ;SAVE MOVCNT + LD A,H ;SET CC'S ON MOVCNT + OR L + LD A,C ;GET ALREADY-PAINTED FLAG FROM [C] + LD (RTPROG),A + RET + + +; Data block at 23277 +SCANL1: + CALL FETCHC ;GET CURRENT LOCATION + PUSH HL ;AND SWAP WITH CSV + PUSH AF + LD HL,(CSAVEA) + LD A,(CSAVEM) + CALL STOREC ;REPOS AT BEGINNING OF SCAN + POP AF ;REGET PLACE WHERE RT SCN STOPPED + POP HL + LD (CSAVEA),HL ;AND SAVE IT IN TEMP LOCATION + LD (CSAVEM),A + CALL SCANL ;NOW DO LOW LEVEL LEFT SCAN + LD A,C ;GET ALREADY-PAINTED FLAG FROM [C] + LD (LFPROG),A ;WHETHER IT WAS ALREADY PAINTED + RET + + + +; Routine at 23307 +; +; Used by the routines at CPLOT8, DRUP, DRLEFT, DRWHHH, DRWEEE, DRWGGG and DMOVE. +NEGDE: + EX DE,HL + CALL NEGHL + EX DE,HL + RET + + + +; +; CIRCLE - DRAW A CIRCLE +; +; SYNTAX: CIRCLE @(X,Y),RADIUS[,ATRB[,+/-STARTANG[,+/-ENDANG[,ASPECT]]]] +; + +; Routine at 23313 +__CIRCLE: + CALL SCAN1 ;GET (X,Y) OF CENTER INTO GRPACX,Y + RST SYNCHR + DEFB ',' ;EAT COMMA + CALL FPSINT_0 ;GET THE RADIUS + PUSH HL ;SAVE TXTPTR + EX DE,HL + LD (GXPOS),HL ;SAVE HERE TILL START OF MAIN LOOP + CALL MAKINT ;PUT INTEGER INTO FAC + CALL __CSNG ;CONVERT TO SINGLE PRECISION + LD BC,$7040 ;LOAD REGS WITH SQR(2)/2 (BCDE = 0.707107) + LD DE,$0771 + CALL FMULT ;DO FLOATING PT MULTIPLY + CALL __CINT ;CONVERT TO INTEGER & GET INTO [HL] + LD (CNPNTS),HL ;CNPNTS=RADIUS*SQR(2)/2=# PTS TO PLOT + XOR A ;ZERO OUT CLINEF - NO LINES TO CENTER + LD (CLINEF),A + LD (CSCLXY),A ;INITIALLY SCALING Y + POP HL ;REGET TXTPTR + CALL ATRSCN ;SCAN POSSIBLE ATTRIBUTE + LD C,$01 ;SET LO BIT IN CLINEF FOR LINE TO CNTR + LD DE,$0000 ;DEFAULT START COUNT = 0 + CALL CGTCNT ;PARSE THE BEGIN ANGLE + PUSH DE ;SAVE COUNT FOR LATER COMPARISON + LD C,$80 ;SET HI BIT IN CLINEF FOR LINE TO CNTR + LD DE,$FFFF ;DEFAULT END COUNT = INFINITY + CALL CGTCNT ;PARSE THE END ANGLE + EX (SP),HL ;GET START COUNT, PUSH TXTPTR TILL DONE + XOR A + EX DE,HL ;REVERSE REGS TO TEST FOR .LT. + RST DCOMPR ;SEE IF END .GE. START + LD A,$00 + JR NC,CSTPLT ;YES, PLOT POINTS BETWEEN STRT & END + DEC A ;PLOT POINTS ABOVE & BELOW + EX DE,HL ;SWAP START AND END SO START .LT. END + PUSH AF ;Swap sense of center line flags + LD A,(CLINEF) + LD C,A + RLCA + RLCA + OR C + RRCA + LD (CLINEF),A ;Store swapped flags + POP AF +CSTPLT: + LD (CPLOTF),A ;SET UP PLOT POLARITY FLAG + LD (CSTCNT),DE ;STORE START COUNT + LD (CENCNT),HL ;AND END COUNT + POP HL ;GET TXTPTR + DEC HL ;NOW SEE IF LAST CHAR WAS A COMMA + RST CHRGTB + JR NZ,CIRC1 ;SOMETHING THERE + PUSH HL ;SAVE TXTPTR + CALL GTASPC ;GET DEFAULT ASPECT RATIO INTO [HL] + LD A,H + OR A ;IS ASPECT RATIO GREATER THAN ONE? + JR Z,CIRC2 ;BRIF GOOD ASPECT RATIO + LD A,$01 + LD (CSCLXY),A + EX DE,HL ;ASPECT RATIO IS GREATER THAN ONE, USE INVERSE + JR CIRC2 ;NOW GO CONVERT TO FRACTION OF 256 + +CIRC1: + RST SYNCHR + DEFB ',' ;EAT COMMA + CALL EVAL + PUSH HL ;SAVE TXTPTR + CALL __CSNG ;MAKE IT FLOATING POINT + CALL SIGN ; test FP number sign + JP Z,FC_ERR ; Err $05 - "Illegal function call" + JP M,FC_ERR ; Err $05 - "Illegal function call" + CALL CMPONE ;SEE IF GREATER THAN ONE + JR NZ,__CIRCLE_2 ;LESS THAN ONE - SCALING Y + INC A ;MAKE [A] NZ + LD (CSCLXY),A ;FLAG SCALING X + CALL FDIV ;RATIO = 1/RATIO +__CIRCLE_2: + LD BC,$2543 ;MAKE NUMBER FRACTION OF 256 (BCDE = 256 (float)) + LD DE,$0060 + CALL FMULT ;BY MULTIPLYING BY 2^8 (256) + CALL __CINT ;MAKE IT AN INTEGER IN [HL] +CIRC2: + LD (ASPECT),HL ;STORE ASPECT RATIO + +; +; CIRCLE ALGORITHM +; +; [HL]=X=RADIUS * 2 (ONE BIT FRACTION FOR ROUNDING) +; [DE]=Y=0 +; SUM =0 +; LOOP: IF Y IS EVEN THEN +; REFLECT((X+1)/2,(Y+1)/2) (I.E., PLOT POINTS) +; IF X.LT.Y THEN EXIT +; SUM=SUM+2*Y+1 +; Y=Y+1 +; IF SUM.GGWGRP.RNO +; SUM=SUM-2*X+1 +; X=X-1 +; ENDIF +; GOTO LOOP +; + + LD DE,$0000 ;INIT Y = 0 + LD (CRCSUM),DE ;SUM = 0 + LD HL,(GXPOS) ;X = RADIUS*2 + ADD HL,HL + +CIRCLP: + CALL CKCNTC + LD A,E ;TEST EVENNESS OF Y + RRA ;TO SEE IF WE NEED TO PLOT + JR C,CRCLP2 ;Y IS ODD - DON'T TEST OR PLOT + PUSH DE ;SAVE Y AND X + PUSH HL + INC HL ;ACTUAL COORDS ARE (X+1)/2,(Y+1)/2 + EX DE,HL ;(PLUS ONE BEFORE DIVIDE TO ROUND UP) + CALL DE_DIV2 ; "RR DE" + EX DE,HL + INC DE + CALL DE_DIV2 ; "RR DE" + CALL CPLOT8 + POP DE ;RESTORE X AND Y + POP HL ;INTO [DE] AND [HL] (BACKWARDS FOR CMP) + RST DCOMPR ;QUIT IF Y .GE. X + JP NC,POPTRT ;GO POP TXTPTR AND QUIT + EX DE,HL +CRCLP2: + LD B,H ;GET OFFSETS INTO PROPER REGISTERS + LD C,L ;[BC]=X + LD HL,(CRCSUM) + INC HL ;SUM = SUM+2*Y+1 + ADD HL,DE + ADD HL,DE + LD A,H ;NOW CHECK SIGN OF RESULT + ADD A,A + JR C,CNODEX ;DON'T ADJUST X IF WAS NEGATIVE + PUSH DE ;SAVE Y + EX DE,HL ;[DE]=SUM + LD H,B ;[HL]=X + LD L,C + ADD HL,HL ;[HL]=2*X-1 + DEC HL + EX DE,HL ;PREPARE TO SUBTRACT + OR A + SBC HL,DE ;CALC SUM-2*X+1 + DEC BC ;X=X-1 + POP DE ;GET Y BACK +CNODEX: + LD (CRCSUM),HL ;UPDATE CIRCLE SUM + LD H,B ;GET X BACK TO [HL] + LD L,C + INC DE ;Y=Y+1 + JR CIRCLP + +; Routine at 23546 +; +; Used by the routine at CPLOT8. +CPLSCX: + PUSH DE + CALL SCALEY + POP HL ;GET UNSCALED INTO [HL] + LD A,(CSCLXY) ;SEE WHETHER ASPECT WAS .GT. 1 + OR A + RET Z + EX DE,HL + RET ;DON'T SWAP IF ZERO + + +; +; REFLECT THE POINTS AROUND CENTER +; [HL]=X OFFSET FROM CENTER, [DE]=Y OFFSET FROM CENTER +; + +; Routine at 23558 +; +; Used by the routine at __CIRCLE. +CPLOT8: + LD (CPCNT),DE ;POINT COUNT IS ALWAYS = Y + PUSH HL ;SAVE X + LD HL,$0000 ;START CPCNT8 OUT AT 0 + LD (CPCNT8),HL + CALL CPLSCX ;SCALE Y AS APPROPRIATE + LD (CXOFF),HL ;SAVE CXOFF + POP HL ;GET BACK X + EX DE,HL + PUSH HL ;SAVE INITIAL [DE] + CALL CPLSCX ;SCALE X AS APPROPRIATE + LD (CYOFF),DE + POP DE ;GET BACK INITIAL [DE] + CALL NEGDE ;START: [DE]=-Y,[HL]=X,CXOFF=Y,CY=X + + CALL CPLOT4 ;PLOT +X,-SY -Y,-SX -X,+SY +Y,-SX + + PUSH HL + PUSH DE + LD HL,(CNPNTS) ;GET # PNTS PER OCTANT + LD (CPCNT8),HL ;AND SET FOR DOING ODD OCTANTS + LD DE,(CPCNT) ;GET POINT COUNT + OR A + SBC HL,DE ;ODD OCTANTS ARE BACKWARDS SO + LD (CPCNT),HL ;PNTCNT = PNTS/OCT - PNTCNT + LD HL,(CXOFF) ;NEED TO NEGATE CXOFF TO START OUT RIGHT + CALL NEGHL + LD (CXOFF),HL + POP DE + POP HL + CALL NEGDE ;ALSO NEED TO MAKE [DE]=-SX=-[DE] + ;PLOT +Y,-SX -X,-SY -Y,+SX +X,+SY + ;(FALL THRU TO CPLOT4) +CPLOT4: + LD A,$04 ;LOOP FOUR TIMES +CPLOT: + PUSH AF ;SAVE LOOP COUNT + PUSH HL ;SAVE BOTH X & Y OFFSETS + PUSH DE + PUSH HL ;SAVE TWICE + PUSH DE + LD DE,(CPCNT8) ;GET NP*OCTANT*8 + LD HL,(CNPNTS) ;ADD SQR(2)*RADIUS FOR NEXT OCTANT + ADD HL,HL + ADD HL,DE + LD (CPCNT8),HL ;UPDATE FOR NEXT TIME + LD HL,(CPCNT) ;CALC THIS POINT'S POINT COUNT + ADD HL,DE ;ADD IN PNTCNT*OCTANT*NP + EX DE,HL ;SAVE THIS POINT'S COUNT IN [DE] + LD HL,(CSTCNT) ;GET START COUNT + RST DCOMPR + JR Z,CLINSC ;SEE IF LINE TO CENTER REQUIRED + JR NC,CNBTWN ;IF SC .GT. PC, THEN NOT BETWEEN + LD HL,(CENCNT) ;GET END COUNT + RST DCOMPR + JR Z,CLINEC ;GO SEE IF LINE FROM CENTER NEEDED + JR NC,CBTWEN ;IF EC .GT. PC, THEN BETWEEN + +CNBTWN: + LD A,(CPLOTF) ;SEE WHETHER TO PLOT OR NOT + OR A ;IF NZ, PLOT POINTS NOT IN BETWEEN + JR NZ,CPLTIT ;NEED TO PLOT NOT-BETWEEN POINTS + JR GCPLFN ;DON'T PLOT - FIX UP STACK & RETURN + +CLINEC: + LD A,(CLINEF) ;GET CENTER LINE FLAG BYTE + ADD A,A ;BIT 7=1 MEANS DRAW LINE FROM CENTER + JR NC,CPLTIT ;NO LINE REQUIRED - JUST PLOT POINT + JR CLINE ;LINE REQUIRED. + +CLINSC: + LD A,(CLINEF) ;GET CENTER LINE FLAG BYTE + RRA ;BIT 0=1 MEANS LINE FROM CENTER NEEDED. + JR NC,CPLTIT ;NO LINE REQUIRED - JUST PLOT POINT + +CLINE: + POP DE ;GET X & Y OFFSETS + POP HL + CALL GTABSC ;GO CALC TRUE COORDINATE OF POINT + CALL CLINE2 ;DRAW LINE FROM [BC],[DE] TO CENTER + JR CPLFIN + +CBTWEN: + LD A,(CPLOTF) ;SEE WHETHER PLOTTING BETWEENS OR NOT + OR A + JR Z,CPLTIT ;IF Z, THEN DOING BETWEENS +GCPLFN: + POP DE ;CLEAN UP STACK + POP HL + JR CPLFIN + +CPLTIT: + POP DE ;GET X & Y OFFSETS + POP HL + CALL GTABSC ;CALC TRUE COORDINATE OF POINT + CALL SCALXY ;SEE IF POINT OFF SCREEN + JR NC,CPLFIN ;NC IF POINT OFF SCREEN - NO PLOT + CALL MAPXY + CALL SETC ;PLOT THE POINT +CPLFIN: + POP DE ;GET BACK OFFSETS + POP HL + POP AF ;GET BACK LOOP COUNT + DEC A + RET Z ;QUIT IF DONE. + PUSH AF ; PUSH PSW + PUSH DE ;SAVE X OFFSET + LD DE,(CXOFF) ;SWAP [HL] AND CXOFF + CALL NEGDE ;NEGATE NEW [HL] + LD (CXOFF),HL ;SWAP [DE] AND CYOFF + EX DE,HL ;NEGATE NEW [DE] + POP DE + PUSH HL + LD HL,(CYOFF) + EX DE,HL + LD (CYOFF),HL + CALL NEGDE + POP HL + POP AF ; POP PSW + JP CPLOT ;PLOT NEXT POINT + +; Routine at 23757 +; +; Used by the routines at CPLOT8 and DMOVE. +CLINE2: + LD HL,(GRPACX) ;DRAW LINE FROM [BC],[DE] + LD (GXPOS),HL ;TO GRPACX,Y + LD HL,(GRPACY) + LD (GYPOS),HL + JP DOGRPH ;GO DRAW THE LINE + +; +; GTABSC - GET ABSOLUTE COORDS +; ([BC],[DE])=(GRPACX+[HL],GRPACY+[DE]) +; +; Routine at 23772 +; Used by the routines at CPLOT8 and DMOVE. +GTABSC: + PUSH DE ;SAVE Y OFFSET FROM CENTER + LD DE,(GRPACX) ;GET CENTER POS + ADD HL,DE ;ADD TO DX + LD B,H ;[BC]=X CENTER + [HL] + LD C,L + POP DE + LD HL,(GRPACY) ;GET CENTER Y + ADD HL,DE + EX DE,HL ;[DE]=Y CENTER + [DE] + RET + + +; Routine at 23787 +; Used by the routine at CPLSCX. +SCALEY: + LD HL,(ASPECT) ;SCALE [DE] BY ASPECT RATIO + LD A,L ;CHECK FOR *0 AND *1 CASES + OR A ;ENTRY TO DO [A]*[DE] ([A] NON-Z) + JR NZ,SCAL2 ;NON-ZERO + OR H ;TEST HI BYTE + RET NZ ;IF NZ, THEN WAS *1 CASE + EX DE,HL ;WAS *0 CASE - PUT 0 IN [DE] + RET + + +SCAL2: + LD C,D + LD D,$00 + PUSH AF + CALL SCL_MULTIPLY + LD E,$80 ; ROUND UP + ADD HL,DE + LD E,C + LD C,H + POP AF + CALL SCL_MULTIPLY + LD E,C + ADD HL,DE + EX DE,HL + RET + +; Routine at 23818 +; +; Used by the routine at SCALEY. +SCL_MULTIPLY: + LD B,$08 + LD HL,$0000 +SCL_MULTIPLY_0: + ADD HL,HL + ADD A,A + JR NC,SCL_MULTIPLY_1 + ADD HL,DE +SCL_MULTIPLY_1: + DJNZ SCL_MULTIPLY_0 + RET + + +; +; PARSE THE BEGIN AND END ANGLES +; SETTING APPROPRIATE BITS IN CLINEF IF NEG. +; + +; Routine at 23831 +; Used by the routine at __CIRCLE. +CGTCNT: + DEC HL + RST CHRGTB ;GET CURRENT CHAR + RET Z ;IF NOTHING, RETURN DFLT IN [DE] + RST SYNCHR + DEFB ',' ;EAT THE COMMA + CP ',' ;USE DEFAULT IF NO ARGUMENT. + RET Z + PUSH BC ;SAVE FLAG BYTE IN [C] + CALL EVAL ;EVALUATE THE THING + EX (SP),HL ;POP FLAG BYTE, PUSH TXTPTR + PUSH HL ;RESAVE FLAG BYTE + CALL __CSNG ;MAKE IT A SINGLE PRECISION VALUE + POP BC ;GET BACK FLAG BYTE + LD HL,FACCU ;NOW SEE WHETHER POSITIVE OR NOT + LD A,(HL) ;GET EXPONENT BYTE + OR A + JP P,CGTCNT_0 + AND $7F ;MAKE IT POSITIVE + LD (HL),A + LD HL,CLINEF ;SET BIT IN [C] IN CLINEF + LD A,(HL) + OR C + LD (HL),A + +CGTCNT_0: + LD BC,$1540 ;LOAD REGS WITH 1/2*PI (BCDE = 0.159155) + LD DE,$5591 + CALL FMULT ;MULTIPLY BY 1/(2*PI) TO GET FRACTION + CALL CMPONE ;SEE IF RESULT IS GREATER THAN ONE + JP Z,FC_ERR ;FC ERROR IF SO (Err $05 - "Illegal function call") + CALL PUSHF ;SAVE FAC ON STAC + LD HL,(CNPNTS) ;GET NO. OF POINTS PER OCTANT + ADD HL,HL ;TIMES 8 FOR TRUE CIRCUMFERENCE + ADD HL,HL + ADD HL,HL + CALL MAKINT ;STICK IT IN FAC + CALL __CSNG ;AND MAKE IT SINGLE PRECISION + POP BC ;GET BACK ANG/2*PI IN REGS + POP DE + CALL FMULT ;DO THE MULTIPLY + CALL __CINT ;CONVERT TO INTEGER IN [HL] + POP DE ;GET BACK TXTPTR + EX DE,HL + RET + +; Routine at 23907 +; +; Used by the routines at __CIRCLE and CGTCNT. +CMPONE: + LD BC,$1041 ;MAKE SURE FAC IS LESS THAN ONE ..BCDE = 1 (float) + LD DE,$0000 + CALL FCOMP + DEC A + RET + +; Routine at 23918 +__DRAW: + LD A,(SCRMOD) + CP $02 + JP C,FC_ERR ;DRAW not allowed in text mode (Err $05 - "Illegal function call") + LD DE,DRAW_TAB ;DISPATCH TABLE FOR GML + XOR A + LD (DRWFLG),A + LD (MCLFLG),A + JP MACLNG + + + +; Data at 23939 ($5D83) +; JP table for the Graphics Macro Language (GML) + +DRAW_TAB: + + DEFB 'U'+$80 ;UP + DEFW DRUP ; Draw a line of pixels in a straight upward direction + + DEFB 'D'+$80 ;DOWN + DEFW DRDOWN ; Draw a line of pixels in a straight downward direction + + DEFB 'L'+$80 ;LEFT + DEFW DRLEFT ; Draw a line of pixels to the left + + DEFB 'R'+$80 ;RIGHT + DEFW DRIGHT ; Draw a line of pixels to the right + + DEFB 'M' ;MOVE + DEFW DMOVE ; Draw a line to a specific location (x,y) or a location relative to the current position (M+20,-20) + + DEFB 'E'+$80 ; -,- + DEFW DRWEEE ; Draw a diagonal line of pixels (line goes upward and to the right) + + DEFB 'F'+$80 ; +,- + DEFW DRWFFF ; Draw a diagonal line of pixels (line goes downward and to the right) + + DEFB 'G'+$80 ; +,+ + DEFW DRWGGG ; Draw a diagonal line of pixels (line goes downward and to the left) + + DEFB 'H'+$80 ; -,+ + DEFW DRWHHH ; Draw a diagonal line of pixels (line goes upward and to the left) + + DEFB 'A'+$80 ;ANGLE COMMAND + DEFW DANGLE ; Change the orientation of the drawing to 0 (normal), 1 (90 degrees clockwise), 2 (180 degrees clockwise) or 3 (270 degrees clockwise) + + DEFB 'B' ;MOVE WITHOUT PLOTTING + DEFW DNOPLT ; Move to the location specified by the command, but don't draw a line + + DEFB 'N' ;DON'T CHANGE CURRENT COORDS + DEFW DNOMOV ; Return to the starting position after performing the command + + DEFB 'X' ;EXECUTE STRING + DEFW MCLXEQ ; X Execute a sub-string of instructions + + DEFB 'C'+$80 ;COLOR + DEFW DCOLR ; Change the foreground (drawing) color to + + DEFB 'S'+$80 ;SCALE + DEFW DSCALE ; S Scale every length specified after this command by pixels. + + DEFB $00 ;END OF TABLE (Table termination) + + + + + +;MOVE +0,-Y +; Draw a line of pixels in a straight upward direction +DRUP: + CALL NEGDE + +;MOVE +0,+Y +; Draw a line of pixels in a straight downward direction +DRDOWN: + LD BC,$0000 ;DX=0 + JR DOMOVR ;TREAT AS RELATIVE MOVE + + +;MOVE -X,+0 +; Routine at 23993 +; Used by the routine at L5D83. +; Draw a line of pixels to the left +DRLEFT: + CALL NEGDE + +;MOVE +X,+0 +; Draw a line of pixels to the right +DRIGHT: + LD B,D ;[BC]=VALUE + LD C,E + LD DE,$0000 ;DY=0 + JR DOMOVR ;TREAT AS RELATIVE MOVE + +;MOVE -X,-Y +; Routine at 24003 +; Draw a diagonal line of pixels (line goes upward and to the left) +DRWHHH: + CALL NEGDE + +;MOVE +X,+Y +; Draw a diagonal line of pixels (line goes downward and to the right) +DRWFFF: + LD B,D + LD C,E + JR DOMOVR + +;MOVE +X,-Y +; Routine at 24010 +; Draw a diagonal line of pixels (line goes upward and to the right) +DRWEEE: + LD B,D + LD C,E +; This entry point is used by the routine at DRWGGG. +DRWHHC: + CALL NEGDE + JR DOMOVR + +;MOVE -X,+Y +; Routine at 24017 +; Draw a diagonal line of pixels (line goes downward and to the left) +DRWGGG: + CALL NEGDE + LD B,D + LD C,E + JR DRWHHC ;MAKE DY POSITIVE & GO + + + +; Routine at 24024 +; Draw a line to a specific location (x,y) or a location relative to the current position (M+20,-20) +DMOVE: + CALL FETCHZ ;GET NEXT CHAR AFTER COMMA + LD B,$00 ;ASSUME RELATIVE + CP '+' ;IF "+" OR "-" THEN RELATIVE + JR Z,MOVREL + CP '-' + JR Z,MOVREL + INC B ;NON-Z TO FLAG ABSOLUTE + +MOVREL: + LD A,B + PUSH AF ;SAVE ABS/REL FLAG ON STACK + CALL DECFET ;BACK UP SO VALSCN WILL SEE "-" + CALL VALSCN ;GET X VALUE + PUSH DE ;SAVE IT + CALL FETCHZ ;NOW CHECK FOR COMMA + CP ',' ;COMMA? + JP NZ,FC_ERR ; If not, Err $05 - "Illegal function call" + CALL VALSCN ;GET Y VALUE IN D + POP BC ;GET BACK X VALUE + POP AF ;GET ABS/REL FLAG + OR A + JR NZ,DRWABS ;NZ - ABSOLUTE + + +; This entry point is used by the DRAW routines at DRUP, DRLEFT, DRWHHH and DRWEEE. +DOMOVR: + CALL DSCLDE ;ADJUST Y OFFSET BY SCALE + PUSH DE ;SAVE Y OFFSET + LD D,B ;GET X INTO [DE] + LD E,C ;GO SCALE IT. + CALL DSCLDE ;GET ADJUSTED X INTO [HL] + EX DE,HL ;GET ADJUSTED Y INTO [DE] + POP DE + LD A,(DRWANG) ;GET ANGLE BYTE + RRA ;LOW BIT TO CARRY + JR NC,ANGEVN ;ANGLE IS EVEN - DON'T SWAP X AND Y + PUSH AF ;SAVE THIS BYTE + CALL NEGHL ;ALWAYS NEGATE NEW DY + EX DE,HL + POP AF ;GET BACK SHIFTED ANGLE +ANGEVN: + RRA ;TEST SECOND BIT + JR NC,ANGPOS ;DON'T NEGATE COORDS IF NOT SET + CALL NEGHL + CALL NEGDE ;NEGATE BOTH DELTAS +ANGPOS: + CALL GTABSC ;GO CALC TRUE COORDINATES +DRWABS: + LD A,(DRWFLG) ;SEE WHETHER WE PLOT OR NOT + ADD A,A ;CHECK HI BIT + JR C,DSTPOS ;JUST SET POSITION. + PUSH AF ;SAVE THIS FLAG + PUSH BC ;SAVE X,Y COORDS + PUSH DE ;BEFORE SCALE SO REFLECT DISTANCE OFF + CALL CLINE2 ;SCALE IN CASE COORDS OFF SCREEN + POP DE + POP BC ;GET THEM BACK + POP AF ;GET BACK FLAG +DSTPOS: + ADD A,A ;SEE WHETHER TO STORE COORDS + JR C,DNSTOR ;DON'T UPDATE IF B6=1 + LD (GRPACY),DE ;UPDATE GRAPHICS AC + LD H,B + LD L,C + LD (GRPACX),HL +DNSTOR: + XOR A ;CLEAR SPECIAL FUNCTION FLAGS (Reset draw mode when finished drawing) + LD (DRWFLG),A + RET + +; Routine at 24130 +; Set flags to return to the starting position after performing the command +DNOMOV: + LD A,$40 ;SET BIT SIX IN FLAG BYTE + JR DSTFLG + +; Routine at 24134 +; Set flags to move to the location specified by the command, but don't draw a line +DNOPLT: + LD A,$80 ;SET BIT 7 + +; This entry point is used by the routine at DNOMOV. +DSTFLG: + LD HL,DRWFLG + OR (HL) + LD (HL),A ;STORE UPDATED BYTE + RET + +; Data block at 24142 +; Change the orientation of the drawing to 0 (normal), 1 (90 degrees clockwise), 2 (180 degrees clockwise) or 3 (270 degrees clockwise) +DANGLE: + JR NC,DSCALE ;ERROR IF NO ARG + LD A,E ;MAKE SURE LESS THAN 4 + CP $04 + JR NC,DSCALE ;ERROR IF NOT + LD (DRWANG),A ; DrawAngle (0..3): 1=90 degrees rotation .. 3=270 degrees, etc.. + RET + +; S Scale every length specified after this command by pixels. +DSCALE: + JP NC,FC_ERR ; Err $05 - "Illegal function call" + LD A,D ;MAKE SURE LESS THAN 256 + OR A + JP NZ,FC_ERR ; Err $05 - "Illegal function call" + LD A,E + LD (DRWSCL),A ;STORE SCALE FACTOR + RET + +; Routine at 24166 +; +; Used by the routine at DMOVE. +DSCLDE: + LD A,(DRWSCL) ;GET SCALE FACTOR + OR A ;ZERO MEANS NO SCALING + RET Z + LD HL,$0000 +DSCLP: + ADD HL,DE ;ADD IN [DE] SCALE TIMES + DEC A + JR NZ,DSCLP + EX DE,HL ;PUT IT BACK IN [DE] + LD A,D ;SEE IF VALUE IS NEGATIVE + ADD A,A + PUSH AF ;SAVE RESULTS OF TEST + JR NC,DSCPOS + DEC DE ;MAKE IT TRUNCATE DOWN +DSCPOS: + CALL DE_DIV2 ;DIVIDE BY FOUR + CALL DE_DIV2 + POP AF ;SEE IF WAS NEGATIVE + RET NC ;ALL DONE IF WAS POSITIVE + LD A,D ;OR IN HIGH 2 BITS TO MAKE NEGATIVE + OR $C0 + LD D,A + INC DE ;ADJUST SO TRUNCATING TO LOWER VALUE + RET + + + +DCOLR: + JR NC,DSCALE ; "NCFER": FC ERROR IF NO ARG + LD A,E ;GO SET ATTRIBUTE + CALL SETATR ; Set attribute byte + JP C,FC_ERR ;ERROR IF ILLEGAL ATTRIBUTE ( Err $05 - "Illegal function call" ) + RET + +; Routine at 24209 +; +; Used by the routine at __PAINT. +CHKRNG: + PUSH HL ;SAVE TXTPTR + CALL SCALXY + JP NC,FC_ERR ;OUT OF BOUNDS - ERROR ( Err $05 - "Illegal function call" ) + POP HL ;REGET TXTPTR + RET + + +; Return from 'DIM' command +; a.k.a. DIMCON +DIMRET: + DEC HL ; DEC 'cos GETCHR INCs ;SEE IF COMMA ENDED THIS VARIABLE + RST CHRGTB ; Get next character + RET Z ; End of DIM statement ;IF TERMINATOR, GOOD BYE + RST SYNCHR ; Make sure "," follows + DEFB ',' ;MUST BE COMMA + + +; 'DIM' BASIC command +; +; THE "DIM" CODE SETS DIMFLG AND THEN FALLS INTO THE VARIABLE +; SEARCH ROUTINE. THE VARIABLE SEARCH ROUTINE LOOKS AT +; DIMFLG AT THREE DIFFERENT POINTS: +; +; 1) IF AN ENTRY IS FOUND, DIMFLG BEING ON INDICATES +; A "DOUBLY DIMENSIONED" VARIABLE +; 2) WHEN A NEW ENTRY IS BEING BUILT DIMFLG'S BEING ON +; INDICATES THE INDICES SHOULD BE USED FOR +; THE SIZE OF EACH INDICE. OTHERWISE THE DEFAULT +; OF TEN IS USED. +; 3) WHEN THE BUILD ENTRY CODE FINISHES, ONLY IF DIMFLG IS +; OFF WILL INDEXING BE DONE +; +__DIM: + LD BC,DIMRET ; Return to "DIMRET" ;PLACE TO COME BACK TO + PUSH BC ; Save on stack + + DEFB $F6 ; "OR n" to Mask 'XOR A' (Flag "Create" variable): NON ZERO THING MUST TURN THE MSB ON + +; Get variable address to DE (AKA PTRGET) +; +; ROUTINE TO READ THE VARIABLE NAME AT THE CURRENT TEXT POSITION +; AND PUT A POINTER TO ITS VALUE IN [D,E]. [H,L] IS UPDATED +; TO POINT TO THE CHARACTER AFTER THE VARIABLE NAME. +; VALTYP IS SETUP. NOTE THAT EVALUATING SUBSCRIPTS IN +; A VARIABLE NAME CAN CAUSE RECURSIVE CALLS TO PTRGET SO AT +; THAT POINT ALL VALUES MUST BE STORED ON THE STACK. +; ON RETURN, [A] DOES NOT REFLECT THE VALUE OF THE TERMINATING CHARACTER +; +; Used by the routines at __LET, __LINE, __READ, OPRND, __DEF, DOFN, PTRGET, +; __SWAP and __NEXT. +GETVAR: + XOR A ; Find variable address,to DE ;MAKE [A]=0 + LD (DIMFLG),A ; Set locate / create flag ;FLAG IT AS SUCH + LD C,(HL) ; Get First byte of name ;GET FIRST CHARACTER IN [C] + +; This entry point is used by the routine at GETFNM. +GTFNAM: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HPTRG ; Hook for Variable search event +ENDIF + CALL IS_LETTER ; See if a letter ;CHECK FOR LETTER + JP C,SN_ERR ; ?SN Error if not a letter ;MUST HAVE A LETTER + XOR A + LD B,A ; Clear second byte of name + RST CHRGTB ; Gets next character (or token) from BASIC text. + JR C,ISSEC ; JP if it WAS NUMERIC + CALL ISLETTER_A ; See if a letter + JR C,NOSEC ; ALLOW ALPHABETICS +ISSEC: + LD B,A +ENDNAM: + RST CHRGTB ; Gets next character (or token) from BASIC text. + JR C,ENDNAM + CALL ISLETTER_A ; Check it is in the 'A'..'Z' range + JR NC,ENDNAM +NOSEC: + CP '%'+1 ;NOT A TYPE INDICATOR + JR NC,TABTYP ;THEN DONT CHECK THEM + LD DE,HAVTYP ;SAVE JUMPS BY USING RETURN ADDRESS + PUSH DE + LD D,$02 ;CHECK FOR INTEGER + CP '%' + RET Z + INC D ;CHECK FOR STRING + CP '$' + RET Z + INC D ;CHECK FOR SINGLE PRECISION + CP '!' + RET Z + LD D,$08 ;ASSUME ITS DOUBLE PRECISION + CP '#' ;CHECK THE CHARACTER + RET Z ;WHEN WE MATCH, SETUP VALTYP + POP AF ;POP OFF NON-USED HAVTYP ADDRESS +TABTYP: + LD A,C ;GET THE STARTING CHARACTER + AND $7F ;GET RID OF THE USER-DEFINED FUNCTION BIT IN [C] + LD E,A ;BUILD A TWO BYTE OFFSET + LD D,$00 + PUSH HL ;SAVE THE TEXT POINTER + LD HL,DEFTBL-'A' ;SEE WHAT THE DEFAULT IS + ADD HL,DE + LD D,(HL) ;GET THE TYPE OUT OF THE TABLE + POP HL ;GET BACK THE TEXT POINTER + DEC HL ;NO MARKING CHARACTER + +HAVTYP: + LD A,D ;SETUP VALTYP + LD (VALTYP),A ; Set variable type + RST CHRGTB ;READ PAST TYPE MARKER + LD A,(SUBFLG) ; Array name needed ? ;GET FLAG WHETHER TO ALLOW ARRAYS + DEC A ;IF SUBFLG=1, "ERASE" HAS CALLED + JP Z,ARLDSV ; Yes - Get array name ;PTRGET, AND SPECIAL HANDLING MUST BE DONE + JP P,NSCFOR ; No array with "FOR" or "FN" ;NO ARRAYS ALLOWED + LD A,(HL) ; Get byte again ;GET CHAR BACK + SUB '(' ; ..Subscripted variable? ;ARRAY PERHAPS (IF SUBFLG SET NEVER WILL MATCH) + JP Z,SBSCPT ; Yes - Sort out subscript ;IT IS! + SUB '['-')'+1 ; ..Subscripted variable? ;SEE IF LEFT BRACKET + JP Z,SBSCPT ; Yes - Sort out subscript ;IF SO, OK SUBSCRIPT + +; a.k.a. NOARYS +NSCFOR: + XOR A ;ALLOW PARENS AGAIN ; Simple variable + LD (SUBFLG),A ;SAVE IN FLAG LOCATION ; Clear "FOR" flag + PUSH HL ;SAVE THE TEXT POINTER ; Save code string address + LD A,(NOFUNS) ;ARE FUNCTIONS ACTIVE? + OR A + LD (PRMFLG),A ;INDICATE IF PARM1 NEEDS SEARCHING + JR Z,SNFUNS ;NO FUNCTIONS SO NO SPECIAL SEARCH + LD HL,(PRMLEN) ;GET THE SIZE TO SEARCH + LD DE,PARM1 ;GET THE BASE OF THE SEARCH + ADD HL,DE ;[H,L]= PLACE TO STOP SEARCHING + LD (ARYTA2),HL ;SET UP STOPPING POINT + EX DE,HL ;[H,L]=START [D,E]=END + JR LOPFND ;START LOOPING + +; Routine at 24355 +LOPTOP: + LD A,(DE) ;GET THE VALTYP OF THIS SIMPLE VARIABLE + LD L,A ;SAVE SO WE KNOW HOW MUCH TO SKIP + INC DE + LD A,(DE) ;[A]=FIRST CHARACTER OF THIS VARIABLE + INC DE ;POINT TO 2ND CHAR OF VAR NAME + CP C ;SEE IF OUR VARIABLE MATCHES + JR NZ,NOTIT1 + LD A,(VALTYP) ;GET TYPE WERE LOOKING FOR + CP L ;COMPARE WITH OUR VALTYP + JR NZ,NOTIT1 ;NOT RIGHT KIND -- SKIP IT + LD A,(DE) ;SEE IF SECOND CHACRACTER MATCHES + CP B + JP Z,FINPTR ;THAT WAS IT, ALL DONE + +NOTIT1: + INC DE + + LD H,$00 ;[H,L]=NUMBER OF BYTES TO SKIP + ADD HL,DE ;ADD ON THE POINTER + +LOPFND: + EX DE,HL ;[D,E]=POINTER INTO SIMPLE VARIABLES + LD A,(ARYTA2) ;ARE LOW BYTES DIFFERENT + CP E ;TEST + JP NZ,LOPTOP ;YES + LD A,(ARYTA2+1) ;ARE HIGH BYTES DIFFERENT + CP D ;THE SAME? + JR NZ,LOPTOP ;NO, MUST BE MORE VARS TO EXAMINE +;NOTFNS: + LD A,(PRMFLG) ;HAS PARM1 BEEN SEARCHED + OR A + JR Z,SMKVAR ;IF SO, CREATE VARIABLE + XOR A ;FLAG PARM1 AS SEARCHED + LD (PRMFLG),A + +SNFUNS: + LD HL,(ARYTAB) ;STOPPING POINT IS [ARYTA2] + LD (ARYTA2),HL + LD HL,(VARTAB) ;SET UP STARTING POINT + JR LOPFND + +; Routine at 24413 +; +; Used by the routine at VARPTR. +PTRGET: + CALL GETVAR +VARRET: + RET + + +; THIS IS EXIT FOR VARPTR AND OTHERS +; Routine at 24417 +VARNOT: + LD D,A ;ZERO [D,E] + LD E,A + POP BC ;GET RID OF PUSHED [D,E] + EX (SP),HL ;PUT RETURN ADDRESS BACK ON STACK + RET ;RETURN FROM PTRGET + +; Routine at 24422 +; +; a.k.a. CFEVAL +; Used by the routine at LOPTOP. +SMKVAR: + POP HL ;[H,L]= TEXT POINTER + EX (SP),HL ;[H,L]= RETURN ADDRESS + PUSH DE ;SAVE CURRENT VARIABLE TABLE POSITION + LD DE,VARRET ;ARE WE RETURNING TO VARPTR? + RST DCOMPR ;COMPARE + JR Z,VARNOT ;YES. + LD DE,COMPTR ;RETURN HERE IF NOT FOUND + RST DCOMPR + POP DE ;RESTORE THE POSITION + JR Z,FINZER ;MAKE FAC ZERO (ALL TYPES) AND SKIP RETURN + EX (SP),HL ;PUT RETURN ADDRESS BACK + PUSH HL ;PUT THE TEXT POINTER BACK + PUSH BC ;SAVE THE LOOKS + LD A,(VALTYP) ;GET LENGTH OF SYMBOL TABLE ENTRY + LD C,A ;[C]=VALTYP + PUSH BC ;SAVE THE VALTYP ON THE STACK + LD B,$00 ;[B]=0 + INC BC ;MAKE THE LENGTH INCLUDE + INC BC ;THE LOOKS TOO + INC BC + LD HL,(STREND) ;EVERYTHING UP BY THE CURRENT END OF STORAGE + PUSH HL ;SAVE THIS # + ADD HL,BC ;ADD ON THE AMOUNT OF SPACE EXTRA NOW BEING USED + POP BC ;POP OFF HIGH ADDRESS TO MOVE + PUSH HL ;SAVE NEW CANDIDATE FOR STREND + CALL MOVUP ;BLOCK TRANSFER AND MAKE SURE WE ARE NOT OVERFLOWING THE STACK SPACE + POP HL ;[H,L]=NEW STREND + LD (STREND),HL ;STORE SINCE WAS OK + ;THERE WAS ROOM, AND BLOCK TRANSFER WAS DONE, SO UPDATE POINTERS + LD H,B ;GET BACK [H,L] POINTING AT THE END + LD L,C ;OF THE NEW VARIABLE + LD (ARYTAB),HL ;UPDATE THE ARRAY TABLE POINTE +ZEROER: + DEC HL ;[H,L] IS RETURNED POINTING TO THE + LD (HL),$00 ;END OF THE VARIABLE SO WE + RST DCOMPR ;ZERO BACKWARDS TO [D,E] WHICH + JR NZ,ZEROER ;POINTS TO THE START OF THE VARIABLE + POP DE + LD (HL),E ;PUT DESCRIPTION + INC HL + POP DE ;OF THIS VARIABLE INTO MEMORY + LD (HL),E + INC HL + LD (HL),D + EX DE,HL ;POINTER AT VARIABLE INTO [D,E] + +; This entry point is used by the routine at LOPTOP. +FINPTR: + INC DE ;POINT TO VALUE OF VAR + POP HL ;RESTORE TEXT POINTER + RET ;ALL DONE WITH THIS VAR + +; +; MAKE ALL TYPES ZERO AND SKIP RETURN +; +FINZER: + LD (FACCU),A ;MAKE SINGLES AND DOUBLES ZERO + LD H,A ;MAKE INTEGERS ZERO + LD L,A + LD (FACLOW),HL + RST GETYPR ;SEE IF ITS A STRING + JR NZ,POPHR2 ;IF NOT, DONE + LD HL,NULL_STRING ;MAKE IT A NULL STRING BY + LD (FACLOW),HL ;POINTING AT A ZERO +POPHR2: + POP HL ;GET THE TEXT POINTER + RET ;RETURN FROM EVAL + + +; MULTIPLE DIMENSION CODE +; + +; FORMAT OF ARRAYS IN CORE +; +; DESCRIPTOR +; LOW BYTE = SECOND CHARCTER (200 BIT IS STRING FLAG) +; HIGH BYTE = FIRST CHARACTER +; LENGTH OF ARRAY IN CORE IN BYTES (DOES NOT INCLUDE DESCRIPTOR) +; NUMBER OF DIMENSIONS 1 BYTE FOR EACH DIMENSION +; STARTING WITH THE FIRST A LIST (2 BYTES EACH) OF THE MAX INDICE+1 +; THE VALUES +; +; SBSCPT (a.k.a. ISARY): Sort out subscript +; Data block at 24506 +; Used by the routine at GETVAR. +SBSCPT: + PUSH HL ; Save code string address + LD HL,(DIMFLG) + EX (SP),HL ; Save and get code string + LD D,A ; Zero number of dimensions +SCPTLP: + PUSH DE ; Save number of dimensions + PUSH BC ; Save array name + CALL INTIDX ; Get subscript ;EVALUATE INDICE INTO [D,E] + POP BC ;POP OFF THE LOOKS + POP AF ;[A] = NUMBER OF DIMENSIONS SO FAR + EX DE,HL ;[D,E]=TEXT POINTER <> [H,L]=INDICE + EX (SP),HL ;PUT THE INDICE ON THE STACK <> [H,L]=VALTYP & DIMFLG ; Save subscript value + PUSH HL ;RESAVE VALTYP AND DIMFLG ; Save NAMTMP and TYPE + EX DE,HL ;[H,L]=TEXT POINTER + INC A ;INCREMENT # OF DIMENSIONS ; Count dimensions + LD D,A ;[D]=NUMBER OF DIMENSIONS ; Save in D + LD A,(HL) ;GET TERMINATING CHARACTER ; Get next byte in code string + CP ',' ;A COMMA SO MORE INDICES FOLLOW? ; Comma (more to come)? + JP Z,SCPTLP ;IF SO, READ MORE ; Yes - More subscripts + CP ')' ;EXPECTED TERMINATOR? ; Make sure ")" follows + JR Z,DOCHRT ;DO CHRGET FOR NEXT ONE + CP ']' ;BRACKET? + JP NZ,SN_ERR ;NO, GIVE ERROR + +DOCHRT: + RST CHRGTB ; Gets next character (or token) from BASIC text. + +;SUBSOK: + LD (NXTOPR),HL ;SAVE THE TEXT POINTER + POP HL ;[H,L]= VALTYP & DIMFLG + LD (DIMFLG),HL ;SAVE VALTYP AND DIMFLG + LD E,$00 ;WHEN [D,E] IS POPED INTO PSW, WE DON'T WANT THE ZERO FLAG TO BE SET, + ;SO "ERASE" WILL HAVE A UNIQUE CONDITION + PUSH DE ;SAVE NUMBER OF DIMENSIONS + + defb $11 ; "LD DE,nn", OVER THE NEXT TWO BYTES + +; a.k.a. ERSFIN +; Used by the routine at HAVTYP. +ARLDSV: + PUSH HL ; Save code string address ;SAVE THE TEXT POINTER + PUSH AF ; A = 00 , Flags set = Z,N ;SAVE A DUMMY NUMBER OF DIMENSIONS WITH THE ZERO FLAG SET +; +; AT THIS POINT [B,C]=LOOKS. THE TEXT POINTER IS IN TEMP2. +; THE INDICES ARE ALL ON THE STACK, FOLLOWED BY THE NUMBER OF DIMENSIONS. +; + LD HL,(ARYTAB) ; Start of arrays ;[H,L]=PLACE TO START THE SEARCH + + DEFB $3E ; "LD A,n" AROUND THE NEXT BYTE + +FNDARY: + ADD HL,DE ; Move to next array start + LD DE,(STREND) ; End of arrays + RST DCOMPR ; Compare HL with DE. + JR Z,CREARY ; Yes - Create array + LD E,(HL) ; Get type + INC HL ; Move on + LD A,(HL) ; Get second byte of name + INC HL ; Move on + CP C ; Compare with name given (second byte) + JR NZ,NXTARY ; Different - Find next array + LD A,(VALTYP) + CP E ; Compare type + JR NZ,NXTARY ; Different - Find next array + LD A,(HL) ; Get first byte of name + CP B ; Compare with name given (first byte) +NXTARY: + INC HL ; POINT TO SIZE ENTRY + LD E,(HL) ; GET VAR NAME LENGTH IN [E] + INC HL ; ADD ONE TO GET CORRECT LENGTH + LD D,(HL) ; HIGH BYTE OF ZERO + INC HL ; ADD OFFSET + JR NZ,FNDARY ; Not found - Keep looking ;IF NO MATCH, SKIP THIS ONE AND TRY AGAIN + LD A,(DIMFLG) ; Found Locate or Create it? ;SEE IF CALLED BY "DIM" + OR A ;ZERO MEANS NO + JP NZ,DD_ERR ; Create - Err $0A - "Redimensioned array" ;PRESERVE [D,E], AND DISPATCH TO + ;"REDIMENSIONED VARIABLE" ERROR + ;IF ITS "DIM" CALLING PTRGET +; +; TEMP2=THE TEXT POINTER +; WE HAVE LOCATED THE VARIABLE WE WERE LOOKING FOR +; AT THIS POINT [H,L] POINTS BEYOND THE SIZE TO THE NUMBER OF DIMENSIONS +; THE INDICES ARE ON THE STACK FOLLOWED BY THE NUMBER OF DIMENSIONS +; + POP AF ; Locate - Get number of dim'ns ;[A]=NUMBER OF DIMENSIONS + LD B,H ; BC Points to array dim'ns ;SET [B,C] TO POINT AT NUMBER OF DIMENSIONS + LD C,L + JP Z,POPHLRT ; Jump if array load/save ;"ERASE" IS DONE AT THIS POINT, SO RETURN TO DO THE ACTUAL ERASURE + SUB (HL) ; Same number of dimensions? ;MAKE SURE THE NUMBER GIVEN NOW + ;AND WHEN THE ARRAY WAS SET UP ARE THE SAME + JP Z,FINDEL ; Yes - Find element ;JUMP OFF AND READ THE INDICES.... + + ; --- START PROC BS_ERR --- +BS_ERR: + LD DE,$0009 ; ERR $09 - "Subscript out of range" + JP ERROR + +; +; HERE WHEN VARIABLE IS NOT FOUND IN THE ARRAY TABLE +; +; BUILDING AN ENTRY: +; +; PUT DOWN THE DESCRIPTOR +; SETUP NUMER OF DIMENSIONS +; MAKE SURE THERE IS ROOM FOR THE NEW ENTRY +; REMEMBER VARPTR +; TALLY=4 (VALTYP FOR THE EXTENDED) +; SKIP 2 LOCS FOR LATER FILL IN -- THE SIZE +; LOOP: GET AN INDICE +; PUT NUMBER +1 DOWN AT VARPTR AND INCREMENT VARPTR +; TALLY= TALLY * NUMBER+1 +; DECREMENT NUMBER-DIMS +; JNZ LOOP +; CALL REASON WITH [H,L] REFLECTING LAST LOC OF VARIABLE +; UPDATE STREND +; ZERO BACKWARDS +; MAKE TALLY INCLUDE MAXDIMS +; PUT DOWN TALLY +; IF CALLED BY DIMENSION, RETURN +; OTHERWISE INDEX INTO THE VARIABLE AS IF IT WERE FOUND ON THE INITIAL SEARCH +; +CREARY: + LD A,(VALTYP) ;GET VALTYP OF NEW VAR + LD (HL),A ;PUT DOWN THE VARIABLE TYPE + INC HL + LD E,A + LD D,$00 ;[D,E]=SIZE OF ONE VALUE (VALTYP) + POP AF ; Array to save or 0 dim'ns? + JP Z,FC_ERR ; Err $05 - "Illegal function call" + LD (HL),C ;PUT DOWN THE DESCRIPTOR ; 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 (=NUMBER OF TWO BYTE ENTRIES NEEDED TO STORE THE SIZE OF EACH DIMENSION) + CALL CHKSTK ; Check if enough memory ;GET SPACE FOR DIMENSION ENTRIES + INC HL ; Point to number of dimensions ;SKIP OVER THE SIZE LOCATIONS + INC HL + LD (TEMP3),HL ; Save address of pointer ;SAVE THE LOCATION TO PUT THE SIZE IN -- POINTS AT THE NUMBER OF DIMENSIONS + LD (HL),C ; Set number of dimensions ;STORE THE NUMBER OF DIMENSIONS + INC HL + LD A,(DIMFLG) ; Locate of Create? ;CALLED BY DIMENSION? + RLA ; Carry set = Create ;SET CARRY IF SO + LD A,C ; Get number of dimensions ;[A]=NUMBER OF DIMENSIONS +CRARLP: + LD BC,10+1 ; Default dimension size 10 + JR NC,DEFSIZ ; Locate - Set default size ;DEFAULT DIMENSIONS TO TEN + POP BC ; Get specified dimension size ;POP OFF AN INDICE INTO [B,C] + INC BC ; Include zero element ;ADD ONE TO IT FOR THE ZERO ENTRY +DEFSIZ: + LD (HL),C ; Save LSB of dimension size ;PUT THE MAXIMUM DOWN + PUSH AF ; Save num' of dim'ns an status ;SAVE THE NUMBER OF DIMENSIONS AND DIMFLG (CARRY) + INC HL + LD (HL),B ; Save MSB of dimension size + INC HL + CALL MLDEBC ; Multiply DE by BC to find amount of mem needed ;MULTIPLY [B,C]=NEWMAX BY CURTOL=[D,E] + POP AF ; Restore number of dimensions ;GET THE NUMBER OF DIMENSIONS AND DIMFLG (CARRY) BACK + DEC A ; Count them ;DECREMENT THE NUMBER OF DIMENSIONS LEFT + JR NZ,CRARLP ; Do next dimension if more ;HANDLE THE OTHER INDICES + PUSH AF ; Save locate/create flag ;SAVE DIMFLG (CARRY) + LD B,D ; MSB of memory needed ;[B,C]=SIZE + LD C,E ; LSB of memory needed + EX DE,HL ;[D,E]=START OF VALUES + ADD HL,DE ; Add bytes to array start ;[H,L]=END OF VALUES + JP C,OM_ERR ; Too big - Error ;OUT OF MEMORY POINTER BEING GENERATED? + CALL ENFMEM ; See if enough memory ;SEE IF THERE IS ROOM FOR THE VALUES + LD (STREND),HL ; Save new end of array ;UPDATE THE END OF STORAGE + +ZERARY: + DEC HL ; Back through array data ;ZERO THE NEW ARRAY + LD (HL),$00 ; Set array element to zero + RST DCOMPR ; All elements zeroed? ;BACK AT THE BEGINNING? + JR NZ,ZERARY ; No - Keep on going ;NO, ZERO MORE + INC BC ; Number of bytes + 1 ;ADD ONE TO THE SIZE TO INCLUDE THE BYTE FOR THE NUMBER OF DIMENSIONS + LD D,A ; A=0 ;[D]=ZERO + LD HL,(TEMP3) ; Get address of array ;GET A POINTER AT THE NUMBER OF DIMENSIONS + LD E,(HL) ; Number of dimensions ;[E]=NUMBER OF DIMENSIONS + EX DE,HL ; To HL ;[H,L]=NUMBER OF DIMENSIONS + ADD HL,HL ; Two bytes per dimension size ;[H,L]=NUMBER OF DIMENSIONS TIMES TWO + ADD HL,BC ; Add number of bytes ;ADD ON THE SIZE TO GET THE TOTAL NUMBER OF BYTES USED + EX DE,HL ; Bytes needed to DE ;[D,E]=TOTAL SIZE + DEC HL ;BACK UP TO POINT TO LOCATION TO PUT + DEC HL ;THE SIZE OF THE ARRAY IN BYTES IN. + LD (HL),E ; Save LSB of bytes needed ;PUT DOWN THE SIZE + INC HL + LD (HL),D ; Save MSB of bytes needed + INC HL + POP AF ; Locate / Create? ;GET BACK DIMFLG (CARRY) AND SET [A]=0 + JR C,ENDDIM ; A is 0 , End if create + +; +; AT THIS POINT [H,L] POINTS BEYOND THE SIZE TO THE NUMBER OF DIMENSIONS +; STRATEGY: +; NUMDIM=NUMBER OF DIMENSIONS +; CURTOL=0 +; INLPNM:GET A NEW INDICE +; POP NEW MAX INTO CURMAX +; MAKE SURE INDICE IS NOT TOO BIG +; MUTLIPLY CURTOL BY CURMAX +; ADD INDICE TO CURTOL +; NUMDIM=NUMDIM-1 +; JNZ INLPNM +; USE CURTOL*4 (VALTYP FOR EXTENDED) AS OFFSET +; +; a.k.a. GETDEF +FINDEL: + LD B,A ; Find array element ;[B,C]=CURTOL=ZERO + LD C,A + LD A,(HL) ; Number of dimensions ;[A]=NUMBER OF DIMENSIONS + INC HL ;POINT PAST THE NUMBER OF DIMENSIONS + DEFB $16 ; "LD D,n" to skip "POP HL" ;"MVI D," AROUND THE NEXT BYTE + +INLPNM: + POP HL ; Address of next dim' size ;[H,L]= POINTER INTO VARIABLE ENTRY + LD E,(HL) ; Get LSB of dim'n size ;[D,E]=MAXIMUM FOR THE CURRENT INDICE + INC HL + LD D,(HL) ; Get MSB of dim'n size + INC HL + EX (SP),HL ; Save address - Get index ;[H,L]=CURRENT INDICE, POINTER INTO THE VARIABLE GOES ON THE STACK + PUSH AF ; Save number of dim'ns ;SAVE THE NUMBER OF DIMENSIONS + RST DCOMPR ; Dimension too large? ;SEE IF THE CURRENT INDICE IS TOO BIG + JP NC,BS_ERR ; Yes - ?BS Error ;IF SO "BAD SUBSCRIPT" ERROR + CALL MLDEBC ; Multiply previous by size ;CURTOL=CURTOL*CURRENT MAXIMUM + ADD HL,DE ; Add index to pointer ;ADD THE INDICE TO CURTOL + POP AF ; Number of dimensions ;GET THE NUMBER OF DIMENSIONS IN [A] + DEC A ; Count them ;SEE IF ALL THE INDICES HAVE BEEN PROCESSED + LD B,H ; MSB of pointer ;[B,C]=CURTOL IN CASE WE LOOP BACK + LD C,L ; LSB of pointer + JR NZ,INLPNM ; More - Keep going ;PROCESS THE REST OF THE INDICES + LD A,(VALTYP) ; SEE HOW BIG THE VALUES ARE AND MULTIPLY BY THAT SIZE + LD B,H ; SAVE THE ORIGINAL VALUE FOR MULTIPLYING + LD C,L ; BY THREE + ADD HL,HL ; MULTIPLY BY TWO AT LEAST + SUB $04 ; FOR INTEGERS AND STRINGS NO MORE MULTIPLYING BY TWO + JR C,SMLVAL + ADD HL,HL ;NOW MULTIPLIED BY FOUR + JR Z,DONMUL ;IF SINGLE ALL DONE + ADD HL,HL ;BY EIGHT FOR DOUBLES +SMLVAL: + OR A ;FIX CC'S FOR Z-80 + JP PO,DONMUL ;FOR STRINGS + ADD HL,BC ;ADD IN THE ORIGINAL +DONMUL: + POP BC ; Start of array ;POP OFF THE ADDRESS OF WHERE THE VALUES BEGIN + ADD HL,BC ; Point to element ;ADD IT ONTO CURTOL TO GET THE PLACE THE VALUE IS STORED + EX DE,HL ; Address of element to DE ;RETURN THE POINTER IN [D,E] + +; a.k.a. FINNOW +ENDDIM: + LD HL,(NXTOPR) ; Got code string address ;REGET THE TEXT POINTER + RET + + +; PRINT USING +; +; PRINT#,[USING;] +; To write data to a sequential disk file. +; +; COME HERE AFTER THE "USING" CLAUSE IN A PRINT STATEMENT IS RECOGNIZED. +; THE IDEA IS TO SCAN THE USING STRING UNTIL THE VALUE LIST IS EXHAUSTED, +; FINDING STRING AND NUMERIC FIELDS TO PRINT VALUES OUT OF THE LIST IN, +; AND JUST OUTPUTING ANY CHARACTERS THAT AREN'T PART OF A PRINT FIELD. +; +; Routine at 24753 +USING: + CALL EVAL_0 ;EVALUATE THE "USING" STRING + CALL TSTSTR ;MAKE SURE IT IS A STRING + RST SYNCHR + DEFB ';' ;MUST BE DELIMITED BY A SEMI-COLON + EX DE,HL ;[D,E]=TEXT POINTER + LD HL,(FACLOW) ;GET POINTER TO "USING" STRING DESCRIPTOR + JR USING_1 ;DONT POP OFF OR LOOK AT USFLG + +; Routine at 24767 +; +; Used by the routine at L61C4. +REUSST: + LD A,(FLGINP) ;DID WE PRINT OUT A VALUE LAST SCAN? + OR A ;SET CC'S + JR Z,FCERR3 ;NO, GIVE ERROR + POP DE ;[D,E]=POINTER TO "USING" STRING DESCRIPTOR + EX DE,HL ;[D,E]=TEXT POINTER +USING_1: + PUSH HL ;SAVE THE POINTER TO "USING" STRING DESCRIPTOR + XOR A ;INITIALLY INDICATE THERE ARE MORE VALUES IN THE VALUE LIST + LD (FLGINP),A ;RESET THE FLAG THAT SAYS VALUES PRINTED + INC A ;TURN THE ZERO FLAG OFF TO INDICATE THE VALUE LIST HASN'T ENDED + PUSH AF ;SAVE FLAG INDICATING WHETHER THE VALUE LIST HAS ENDED + PUSH DE ;SAVE THE TEXT POINTER INTO THE VALUE LIST + LD B,(HL) ;[B]=LENGTH OF THE "USING" STRING + INC B ;SEE IF ITS ZERO + DEC B +FCERR3: + JP Z,FC_ERR ;IF SO, Err $05 - "Illegal function call" + INC HL ;[H,L]=POINTER AT THE "USING" STRING'S + LD A,(HL) ;DATA + INC HL + LD H,(HL) + LD L,A + JR PRCCHR ;GO INTO THE LOOP TO SCAN THE "USING" STRING + +; Data block at 24796 +BGSTRF: + LD E,B ;SAVE THE "USING" STRING CHARACTER COUNT + PUSH HL ;SAVE THE POINTER INTO THE "USING" STRING + LD C,$02 ;THE \\ STRING FIELD HAS 2 PLUS NUMBER OF ENCLOSED SPACES WIDTH +LPSTRF: + LD A,(HL) ;GET THE NEXT CHARACTER + INC HL ;ADVANCE THE POINTER AT THE "USING" STRINGDATA + CP '\\' ;THE FIELD TERMINATOR? + JP Z,ISSTRF ;GO EVALUATE A STRING AND PRINT + CP ' ' ;A FIELD EXTENDER? + JR NZ,NOSTRF ;IF NOT, ITS NOT A STRING FIELD + INC C ;INCREMENT THE FIELD WIDTH + DJNZ LPSTRF ;KEEP SCANNING FOR THE FIELD TERMINATOR +; +; SINCE STRING FIELD WASN'T FOUND, THE "USING" STRING +; CHARACTER COUNT AND THE POINTER INTO IT'S DATA MUST +; BE RESTORED AND THE "\" PRINTED +; +NOSTRF: + POP HL ;RESTORE THE POINTER INTO "USING" STRING'S DATA + LD B,E ;RESTORE THE "USING" STRING CHARACTER COUNT + LD A,'\\' ;RESTORE THE CHARACTER + +; +; HERE TO PRINT THE CHARACTER IN [A] SINCE IT WASN'T PART OF ANY FIELD +; +NEWUCH: + CALL PLS_PRNT ;IF A "+" CAME BEFORE THIS CHARACTER MAKE SURE IT GETS PRINTED + RST OUTDO ;PRINT THE CHARACTER THAT WASN'T PART OF A FIELD +PRCCHR: + XOR A ;SET [D,E]=0 SO IF WE DISPATCH + LD E,A ;SOME FLAGS ARE ALREADY ZEROED + LD D,A ;DON'T PRINT "+" TWICE +PLSFIN: + CALL PLS_PRNT ;ALLOW FOR MULTIPLE PLUSES IN A ROW + LD D,A ;SET "+" FLAG + LD A,(HL) ;GET A NEW CHARACTER + INC HL + CP '!' ;CHECK FOR A SINGLE CHARACTER + JP Z,SMSTRF ;STRING FIELD + CP '#' ;CHECK FOR THE START OF A NUMERIC FIELD + JR Z,NUMNUM ;GO SCAN IT + CP '&' ;SEE IF ITS A VARIABLE LENGTH STRING FIELD + JP Z,VARSTR ;GO PRINT ENTIRE STRING + DEC B ;ALL THE OTHER POSSIBILITIES REQUIRE AT LEAST 2 CHARACTERS + JP Z,REUSIN ;IF THE VALUE LIST IS NOT EXHAUSTED GO REUSE "USING" STRING + CP '+' ;A LEADING "+" ? + LD A,$08 ;SETUP [D] WITH THE PLUS-FLAG ON IN + JR Z,PLSFIN ;CASE A NUMERIC FIELD STARTS + DEC HL ;POINTER HAS ALREADY BEEN INCREMENTED + LD A,(HL) ;GET BACK THE CURRENT CHARACTER + INC HL ;REINCREMENT THE POINTER + CP '.' ;NUMERIC FIELD WITH TRAILING DIGITS + JR Z,DOTNUM ;IF SO GO SCAN WITH [E]=NUMBER OF DIGITS BEFORE THE "."=0 + CP '\\' ;CHECK FOR A BIG STRING FIELD STARTER + JR Z,BGSTRF ;GO SEE IF IT REALLY IS A STRING FIELD + CP (HL) ;SEE IF THE NEXT CHARACTER MATCHES THE CURRENT ONE + JR NZ,NEWUCH ;IF NOT, CAN'T HAVE $$ OR ** SO ALL THE POSSIBILITIES ARE EXHAUSTED + CP '$' ;IS IT $$ ? + JR Z,DOLRNM ;GO SET UP THE FLAG BIT + CP '*' ;IS IT ** ? + JR NZ,NEWUCH ;IF NOT, ITS NOT PART OF A FIELD SINCE ALL THE POSSIBILITIES HAVE BEEN TRIED + INC HL ;SEE IF THE "USING" STRING IS LONG + LD A,B ;CHECK FOR $ + CP $02 ;ENOUGH FOR THE SPECIAL CASE OF + JR C,_NOTSPC ; **$ + LD A,(HL) + CP '$' ;IS THE NEXT CHARACTER $ ? +_NOTSPC: + LD A,32 ;SET THE ASTERISK BIT + JR NZ,SPCNUM ;IF IT NOT THE SPECIAL CASE, DON'T SET THE DOLLAR SIGN FLAG + DEC B ;DECREMENT THE "USING" STRING CHARACTER COUNT TO TAKE THE $ INTO CONSIDERATION + INC E ;INCREMENT THE FIELD WIDTH FOR THE FLOATING DOLLAR SIGN + + DEFB $FE ; CP AFh ..hides the "XOR A" instruction (MVI SI, IN 8086) + +DOLRNM: + XOR A ;CLEAR [A] + ADD A,$10 ;SET BIT FOR FLOATING DOLLAR SIGN FLAG + INC HL ;POINT BEYOND THE SPECIAL CHARACTERS +SPCNUM: + INC E ;SINCE TWO CHARACTERS SPECIFY THE FIELD SIZE, INITIALIZE [E]=1 + ADD A,D ;PUT NEW FLAG BITS IN [A] + LD D,A ;INTO [D]. THE PLUS FLAG MAY HAVE ALREADY BEEN SET +NUMNUM: + INC E ;INCREMENT THE NUMBER OF DIGITS BEFORE THE DECIMAL POINT + LD C,$00 ;SET THE NUMBER OF DIGITS AFTER THE DECIMAL POINT = 0 + DEC B ;SEE IF THERE ARE MORE CHARACTERS + JR Z,ENDNUS ;IF NOT, WE ARE DONE SCANNING THIS NUMERIC FIELD + LD A,(HL) ;GET THE NEW CHARACTER + INC HL ;ADVANCE THE POINTER AT THE "USING" STRING DATA + CP '.' ;DO WE HAVE TRAILING DIGITS? + JR Z,AFTDOT ;IF SO, USE SPECIAL SCAN LOOP + CP '#' ;MORE LEADING DIGITS ? + JR Z,NUMNUM ;INCREMENT THE COUNT AND KEEP SCANNING + CP ',' + JR NZ,FINNUM + LD A,D ;TURN ON THE COMMA BIT + OR 64 + LD D,A + JR NUMNUM ;GO SCAN SOME MORE + +; +; HERE WHEN A "." IS SEEN IN THE "USING" STRING +; IT STARTS A NUMERIC FIELD IF AND ONLY IF +; IT IS FOLLOWED BY A "#" +; +DOTNUM: + LD A,(HL) ;GET THE CHARACTER THAT FOLLOWS + CP '#' ;IS THIS A NUMERIC FIELD? + LD A,'.' ;IF NOT, GO BACK AND PRINT "." + JP NZ,NEWUCH + LD C,$01 ;INITIALIZE THE NUMBER OF DIGITS AFTER THE DECIMAL POINT + INC HL +AFTDOT: + INC C ;INCREMENT THE NUMBER OF DIGITS AFTER THE DECIMAL POINT + DEC B ;SEE IF THE "USING" STRING HAS MORE + JR Z,ENDNUS ;CHARACTERS, AND IF NOT, STOP SCANNING + LD A,(HL) ;GET THE NEXT CHARACTER + INC HL + CP '#' ;MORE DIGITS AFTER THE DECIMAL POINT? + JR Z,AFTDOT ;IF SO, INCREMENT THE COUNT AND KEEP SCANNING +; +; CHECK FOR THE "^^^^" THAT INDICATES SCIENTIFIC NOTATION +; +FINNUM: + PUSH DE ;SAVE [D]=FLAGS AND [E]=LEADING DIGITS + LD DE,NOTSCI ;PLACE TO GO IF ITS NOT SCIENTIFIC + PUSH DE ;NOTATION + LD D,H ;REMEMBER [H,L] IN CASE + LD E,L ;ITS NOT SCIENTIFIC NOTATION + CP '^' ;IS THE FIRST CHARACTER "^" ? + RET NZ + CP (HL) ;IS THE SECOND CHARACTER "^" ? + RET NZ + INC HL + CP (HL) ;IS THE THIRD CHARACTER "^" ? + RET NZ + INC HL + CP (HL) ;IS THE FOURTH CHARACTER "^" ? + RET NZ + INC HL + LD A,B ;WERE THERE ENOUGH CHARACTERS FOR "^^^^" + SUB $04 ;IT TAKES FOUR + RET C + POP DE ;POP OFF THE NOTSCI RETURN ADDRESS + POP DE ;GET BACK [D]=FLAGS [E]=LEADING DIGITS + LD B,A ;MAKE [B]=NEW CHARACTER COUNT + INC D ;TURN ON THE SCIENTIFIC NOTATION FLAG + INC HL + + DEFB $CA ; JP Z,nn to mask the next 2 bytes ;SKIP THE NEXT TWO BYTES WITH "JZ" + +NOTSCI: + EX DE,HL ;RESTORE THE OLD [H,L] + POP DE ;GET BACK [D]=FLAGS [E]=LEADING DIGITS + +ENDNUS: + LD A,D ;IF THE LEADING PLUS FLAG IS ON + DEC HL + INC E ;INCLUDE LEADING "+" IN NUMBER OF DIGITS + AND $08 ;DON'T CHECK FOR A TRAILING SIGN + JR NZ,ENDNUM ;ALL DONE WITH THE FIELD IF SO IF THERE IS A LEADING PLUS + DEC E ;NO LEADING PLUS SO DON'T INCREMENT THE NUMBER OF DIGITS BEFORE THE DECIMAL POINT + LD A,B + OR A ;SEE IF THERE ARE MORE CHARACTERS + JR Z,ENDNUM ;IF NOT, STOP SCANNING + LD A,(HL) ;GET THE CURRENT CHARACTER + SUB '-' ;TRAIL MINUS? + JR Z,SGNTRL ;SET THE TRAILING SIGN FLAG + CP '+'-'-' ;A TRAILING PLUS? + JR NZ,ENDNUM ;IF NOT, WE ARE DONE SCANNING + LD A,$08 ;TURN ON THE POSITIVE="+" FLAG +SGNTRL: + ADD A,$04 ;TURN ON THE TRAILING SIGN FLAG + ADD A,D ;INCLUDE WITH OLD FLAGS + LD D,A + DEC B ;DECREMENT THE "USING" STRING CHARACTER COUNT TO ACCOUNT FOR THE TRAILING SIGN +ENDNUM: + POP HL ;[H,L]=THE OLD TEXT POINTER + POP AF ;POP OFF FLAG THAT SAYS WHETHER THERE ARE MORE VALUES IN THE VALUE LIST + JR Z,FLDFIN ;IF NOT, WE ARE DONE WITH THE "PRINT" + PUSH BC ;SAVE [B]=# OF CHARACTERS REMAINING IN "USING" STRING AND [C]=TRAILING DIGITS + PUSH DE ;SAVE [D]=FLAGS AND [E]=LEADING DIGITS + CALL EVAL ;READ A VALUE FROM THE VALUE LIST + POP DE ;[D]=FLAGS & [E]=# OF LEADING DIGITS + POP BC ;[B]=# CHARACTER LEFT IN "USING" STRING + ;[C]=NUMBER OF TRAILING DIGITS + PUSH BC ;SAVE [B] FOR ENTERING SCAN AGAIN + PUSH HL ;SAVE THE TEXT POINTER + LD B,E ;[B]=# OF LEADING DIGITS + LD A,B ;MAKE SURE THE TOTAL NUMBER OF DIGITS + ADD A,C ;DOES NOT EXCEED TWENTY-FOUR + CP 25 + JP NC,FC_ERR ;IF SO, Err $05 - "Illegal function call" + + LD A,D ;[A]=FLAG BITS + OR $80 ;TURN ON THE "USING" BIT + CALL PUFOUT ;PRINT THE VALUE + CALL PRS ;ACTUALLY PRINT IT + +FNSTRF: + POP HL ;GET BACK THE TEXT POINTER + DEC HL ;SEE WHAT THE TERMINATOR WAS + RST CHRGTB + SCF ;SET FLAG THAT CRLF IS DESIRED + JR Z,CRDNUS ;IF IT WAS A END-OF-STATEMENT, FLAG THAT THE VALUE LIST ENDED AND THAT CRLF SHOULD BE PRINTED + LD (FLGINP),A ;FLAG THAT VALUE HAS BEEN PRINTED. + ;DOESNT MATTER IF ZERO SET, [A] MUST BE NON-ZERO OTHERWISE + CP ';' ;A SEMI-COLON? + JR Z,SEMUSN ;A LEGAL DELIMITER + RST SYNCHR ;A COMMA ? + DEFB ',' ;THE DELIMETER WAS ILLEGAL + + DEFB $06 ; "LD B,n" to Mask the next byte + +SEMUSN: + RST CHRGTB ;IS THERE ANOTHER VALUE? +CRDNUS: + POP BC ;[B]=CHARACTERS REMAINING IN "USING" STRING + EX DE,HL ;[D,E]=TEXT POINTER + POP HL ;[H,L]=POINT AT THE "USING" STRING + PUSH HL ;DESCRIPTOR. RESAVE IT. + PUSH AF ;SAVE THE FLAG THAT INDICATES WHETHER OR NOT THE VALUE LIST TERMINATED + PUSH DE ;SAVE THE TEXT POINTER + +; +; SINCE FRMEVL MAY HAVE FORCED GARBAGE COLLECTION +; WE HAVE TO USE THE NUMBER OF CHARACTERS ALREADY SCANNED +; AS AN OFFSET TO THE POINTER TO THE "USING" STRING'S DATA +; TO GET A NEW POINTER TO THE REST OF THE CHARACTERS TO BE SCANNED +; + LD A,(HL) ;GET THE "USING" STRING'S LENGTH + SUB B ;SUBTRACT THE NUMBER OF CHARACTERS ALREADY SCANNED + INC HL ;[H,L]=POINTER AT + LD D,$00 ;THE "USING" STRING'S + LD E,A ;STRING DATA + LD A,(HL) + INC HL + LD H,(HL) ;SETUP [D,E] AS A DOUBLE BYTE OFFSET + LD L,A + ADD HL,DE ;ADD ON THE OFFSET TO GET THE NEW POINTER +;CHKUSI: + LD A,B ;[A]=THE NUMBER OF CHARACTERS LEFT TO SCAN + OR A ;SEE IF THERE ARE ANY LEFT + JP NZ,PRCCHR ;IF SO, KEEP SCANNING + JR FINUSI ;SEE IF THERE ARE MORE VALUES + +REUSIN: + CALL PLS_PRNT ;PRINT A "+" IF NECESSARY + RST OUTDO ;PRINT THE FINAL CHARACTER +FINUSI: + POP HL ;POP OFF THE TEXT POINTER + POP AF ;POP OFF THE INDICATOR OF WHETHER OR NOT THE VALUE LIST HAS ENDED + JP NZ,REUSST ;IF NOT, REUSE THE "USING" STRING + +FLDFIN: + CALL C,OUTDO_CRLF ;IF NOT COMMA OR SEMI-COLON ENDED THE VALUE LIST, PRINT A CRLF + EX (SP),HL ;SAVE THE TEXT POINTER <> [H,L]=POINT AT THE "USING" STRING'S DESCRIPTOR + CALL GSTRHL ;FINALLY FREE IT UP + POP HL ;GET BACK THE TEXT POINTER + JP FINPRT ;ZERO [PTRFIL] + +; +; HERE TO HANDLE VARIABLE LENGTH STRING FIELD SPECIFIED WITH "&" +; +VARSTR: + LD C,$00 ;SET LENGTH TO MAXIMUM POSSIBLE + JR ISSTRF_0 + +; +; HERE WHEN THE "!" INDICATING A SINGLE CHARACTER STRING FIELD HAS BEEN SCANNED +; +SMSTRF: + LD C,$01 ;SET THE FIELD WIDTH TO 1 + DEFB $3E ; "LD A,n" to Mask the next byte ;SKIP NEXT BYTE WITH A "MVI A," + +ISSTRF: + POP AF ;GET RID OF THE [H,L] THAT WAS BEING SAVED IN CASE THIS WASN'T A STRING FIELD +ISSTRF_0: + DEC B ;DECREMENT THE "USING" STRING CHARACTER COUNT + CALL PLS_PRNT ;PRINT A "+" IF ONE CAME BEFORE THE FIELD + POP HL ;TAKE OFF THE TEXT POINTER + POP AF ;TAKE OFF THE FLAG WHICH SAYS WHETHER THERE ARE MORE VALUES IN THE VALUE LIST + JR Z,FLDFIN ;IF THERE ARE NO MORE VALUES THEN WE ARE DONE + PUSH BC ;SAVE [B]=NUMBER OF CHARACTERS YET TO BE SCANNED IN "USING" STRING + CALL EVAL ;READ A VALUE + CALL TSTSTR ;MAKE SURE ITS A STRING + POP BC ;[C]=FIELD WIDTH + PUSH BC ;RESAVE [B] + PUSH HL ;SAVE THE TEXT POINTER + LD HL,(FACLOW) ;GET A POINTER TO THE DESCRIPTOR + LD B,C ;[B]=FIELD WIDTH + LD C,$00 ;SET UP FOR "LEFT$" + LD A,B + PUSH AF + OR A + CALL NZ,__LEFT_S_1 ; into LEFT$, TRUNCATE THE STRING TO [B] CHARACTERS + CALL PRS1 ;PRINT THE STRING + LD HL,(FACLOW) ;SEE IF IT NEEDS TO BE PADDED + POP AF ;[A]=FIELD WIDTH + OR A ; + JP Z,FNSTRF ;DONT PRINT ANY TRAILING SPACES + SUB (HL) ;[A]=AMOUNT OF PADDING NEEDED + LD B,A + LD A,' ' ;SETUP THE PRINT CHARACTER + INC B ;DUMMY INCREMENT OF NUMBER OF SPACES +UPRTSP: + DEC B ;SEE IF MORE SPACES + JP Z,FNSTRF ;NO, GO SEE IF THE VALUE LIST ENDED AND RESUME SCANNING + RST OUTDO ;PRINT A SPACE + JR UPRTSP ;AND LOOP PRINTING THEM + +; +; WHEN A "+" IS DETECTED IN THE "USING" STRING IF A NUMERIC FIELD FOLLOWS A BIT IN [D] +; SHOULD BE SET, OTHERWISE "+" SHOULD BE PRINTED. +; SINCE DECIDING WHETHER A NUMERIC FIELD FOLLOWS IS VERY DIFFICULT, THE BIT IS ALWAYS SET IN [D]. +; AT THE POINT IT IS DECIDED A CHARACTER IS NOT PART OF A NUMERIC FIELD, THIS ROUTINE IS CALLED +; TO SEE IF THE BIT IN [D] IS SET, WHICH MEANS A PLUS PRECEDED THE CHARACTER AND SHOULD BE PRINTED. +; +; Routine at 25158 +PLS_PRNT: + PUSH AF ;SAVE THE CURRENT CHARACTER + LD A,D ;CHECK THE PLUS BIT + OR A ;SINCE IT IS THE ONLY THING THAT COULD BE TURNED ON + LD A,'+' ;SETUP TO PRINT THE PLUS + CALL NZ,OUTDO ;PRINT IT IF THE BIT WAS SET + POP AF ;GET BACK THE CURRENT CHARACTER + RET + +; Routine at 25168 +; +; Used by the routine at SMKVAR. +MOVUP: + CALL ENFMEM ; $6267 = ENFMEM (reference not aligned to instruction) +; This entry point is used by the routines at GNXARY, __PLAY_2 and MCLPLAY. +MOVUP_0: + PUSH BC + EX (SP),HL + POP BC +MOVUP_1: + RST DCOMPR ; Compare HL with DE. + LD A,(HL) + LD (BC),A + RET Z + DEC BC + DEC HL + JR MOVUP_1 + +; Routine at 25182 +; +; Used by the routines at __GOSUB, EVAL_1, DOFN, MCLXEQ, ENTSLR and EXEC_ONGOSUB. +; $625E +CHKSTK: + PUSH HL + LD HL,(STREND) + LD B,$00 + ADD HL,BC + ADD HL,BC + + DEFB $3E ; "LD A,n" to Mask the next byte + +; See if enough memory +ENFMEM: + PUSH HL ; Save code string address + LD A,256-(2*NUMLEV) ; -(2*NUMLEV) Bytes minimum RAM + ;LD A,-120 ; 120 Bytes minimum RAM + SUB L + LD L,A + LD A,-1 ; 120 Bytes (MSB) minimum RAM + SBC A,H + LD H,A + JR C,OM_ERR + ADD HL,SP + POP HL + RET C + +; This entry point is used by the routines at __CLEAR and MAXFILES. +OM_ERR: + CALL LINKER + LD HL,(STKTOP) + DEC HL + DEC HL + LD (SAVSTK),HL + LD DE,$0007 ; Err $07 - "Out of memory" + JP ERROR + + +; Data block at 25222 +__NEW: + RET NZ + ; --- START PROC L6287 --- +CLRPTR: + LD HL,(TXTTAB) + CALL __TRON+1 ; TROFF + LD (AUTFLG),A ; AUTO mode flag + LD (PTRFLG),A ; =0 if no line number converted to pointers + LD (HL),A + INC HL + LD (HL),A + INC HL + LD (VARTAB),HL ; Pointer to start of variable space + + ; --- START PROC RUN_FST --- +; a.k.a. RUNC +RUN_FST: + ; Clear all variables +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HRUNC ; Hook 1 for RUN-Clear +ENDIF + LD HL,(TXTTAB) ; Starting address of BASIC text area + DEC HL + ; --- START PROC _CLVAR --- +;; INTVAR: +_CLVAR: + ; Initialise RUN variables +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HCLEA ; Hook 2 for RUN-Clear +ENDIF + LD (TEMP),HL ; Location for temporary reservation for st.code + + ; --- START PROC L62A7 --- +; Clear registers +_CLREG: + CALL CLR_ALLINT + LD B,1Ah + LD HL,DEFTBL +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HLOPD ; Hook 3 for RUN-Clear +ENDIF + +_CLREG_0: + LD (HL),$08 + INC HL + DJNZ _CLREG_0 + + CALL INIT_RND + XOR A + LD (ONEFLG),A ; Clear 'on error' flag + LD L,A + LD H,A + LD (ONELIN),HL + LD (OLDTXT),HL + LD HL,(MEMSIZ) + LD (FRETOP),HL + CALL __RESTORE + LD HL,(VARTAB) + LD (ARYTAB),HL + LD (STREND),HL + CALL CLSALL ; Close all files + LD A,(NLONLY) + AND $01 + JR NZ,CLREG ; Clear registers and warm boot + LD (NLONLY),A +; This entry point is used by the routine at _CSTART. +; Clear registers and warm boot: +CLREG: + POP BC + LD HL,(STKTOP) + DEC HL + DEC HL + LD (SAVSTK),HL + INC HL + INC HL + +; This entry point is used by the routine at READYR. +STKERR: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HSTKE ; Hook for "Reset stack" event +ENDIF + LD SP,HL + LD HL,TEMPST + LD (TEMPPT),HL + CALL FINLPT + CALL FINPRT + XOR A + LD H,A + LD L,A + LD (PRMLEN),HL + LD (NOFUNS),A ; 0 if no function active + LD (PRMLN2),HL + LD (FUNACT),HL + LD (PRMSTK),HL ; Previous definition block on stack + LD (SUBFLG),A + PUSH HL + PUSH BC +GTMPRT: + LD HL,(TEMP) + RET + +; Routine at 25371 +; +; Used by the routine at L77FE. +TIME_S_ON: + DI + LD A,(HL) + AND $04 + OR $01 + CP (HL) + LD (HL),A + JR Z,TIME_S_ON_0 + AND $04 + JR NZ,RESET_ONGSBF +TIME_S_ON_0: + EI + RET + +; Routine at 25387 +; +; Used by the routine at L77FE. +TIME_S_OFF: + DI + LD A,(HL) + LD (HL),$00 + JR STOP_TRAPEVT_FLG + +; Routine at 25393 +; +; Used by the routines at EXEC_ONGOSUB and L77FE. +TIME_S_STOP: + DI + LD A,(HL) + PUSH AF + OR $02 ; Interrupt STOP + LD (HL),A + POP AF +; This entry point is used by the routine at TIME_S_OFF. +STOP_TRAPEVT_FLG: + XOR $05 ; bit 0 and 2 (Interrupt occurred / Interrupt OFF) + JR Z,SET_ONGSBF + EI + RET + +; Routine at 25406 +RETURN_TRAP: + DI + LD A,(HL) + AND $05 ; bit 0 and 2 (Interrupt occurred / Interrupt OFF) + CP (HL) + LD (HL),A + JR NZ,RESET_TRAPEVT_FLG + EI + RET + +; Toggle bit 0 and 2 (Interrupt occurred / Interrupt OFF) +RESET_TRAPEVT_FLG: + XOR $05 ; bit 0 and 2 (Interrupt occurred / Interrupt OFF) + JR Z,RESET_ONGSBF + EI + RET + +; Routine at 25422 +L634E: + DI +; This entry point is used by the routines at TIME_S_ON and RETURN_TRAP. +RESET_ONGSBF: + LD A,(ONGSBF) + INC A + LD (ONGSBF),A + EI + RET + +; Routine at 25432 +; +; Used by the routine at EXEC_ONGOSUB. +TIME_S_EVENT: + DI + LD A,(HL) + AND $03 ; are bit 0 or 1 (Interrupt OFF / Interrupt STOP) set ? + CP (HL) + LD (HL),A + JR NZ,SET_ONGSBF +TIME_S_STOP_7: + EI + RET + +; This entry point is used by the routine at TIME_S_STOP. +SET_ONGSBF: + LD A,(ONGSBF) + SUB $01 + JR C,TIME_S_STOP_7 + LD (ONGSBF),A + EI + RET + +; Routine at 25454 +; +; Used by the routine at L628E. +; Clear all the interrupt trap tables definitions +CLR_ALLINT: + LD HL,TRPTBL + LD B,$1A + XOR A +CLR_ALLINT_0: + LD (HL),A + INC HL + LD (HL),A + INC HL + LD (HL),A + INC HL + DJNZ CLR_ALLINT_0 + LD HL,FNKFLG + LD B,$0A +CLR_ALLINT_1: + LD (HL),A + INC HL + DJNZ CLR_ALLINT_1 + LD (ONGSBF),A + RET + +; Routine at 25481 +EXEC_ONGOSUB: + LD A,(ONEFLG) + OR A + RET NZ + PUSH HL + LD HL,(CURLIN) ; Line number the Basic interpreter is working on, in direct mode it will be filled with #FFFF + LD A,H + AND L + INC A + JR Z,EXEC_ONGOSUB_2 + LD HL,TRPTBL + LD B,$1A +EXEC_ONGOSUB_0: + LD A,(HL) + CP $05 + JR Z,EXEC_ONGOSUB_3 +RUN_FST4: + INC HL + INC HL + INC HL + DJNZ EXEC_ONGOSUB_0 +EXEC_ONGOSUB_2: + POP HL + RET + +EXEC_ONGOSUB_3: + PUSH BC + INC HL + LD E,(HL) + INC HL + LD D,(HL) + DEC HL + DEC HL + LD A,D + OR E + POP BC + JR Z,RUN_FST4 + PUSH DE + PUSH HL + CALL TIME_S_EVENT + CALL TIME_S_STOP + LD C,$03 + CALL CHKSTK + POP BC + POP DE + POP HL + EX (SP),HL + POP HL + JP DO_GOSUB + +; Routine at 25545 +; +; Used by the routine at L628E. +__RESTORE: + EX DE,HL + LD HL,(TXTTAB) + JR Z,__RESTORE_0 + EX DE,HL + CALL ATOH ; Get specified line number + PUSH HL + CALL SRCHLN ; Get first line number + LD H,B + LD L,C + POP DE + JP NC,UL_ERR ; Err $08 - "Undefined line number" +__RESTORE_0: + DEC HL +; This entry point is used by the routine at LTSTND. +; a.k.a. RESFIN +UPDATA: + LD (DATPTR),HL + EX DE,HL + RET + +; Routine at 25571 +; $63E3 +__STOP: + JP NZ,L77A5 +; This entry point is used by the routine at L043F. +__STOP_0: + RET NZ ;RETURN IF NOT CONTROL-C AND MAKE + INC A ;SURE "STOP" STATEMENTS HAVE A TERMINATOR + JR __END_00 + +; Routine at 25578 +__END: + RET NZ ;MAKE SURE "END" STATEMENTS HAVE A TERMINATOR + XOR A + LD (ONEFLG),A ; Clear 'on error' flag + PUSH AF ;PRESERVE CONDITION CODES OVER CALL TO CLSALL + CALL Z,CLSALL ; Close all files + POP AF ;RESTORE CONDITION CODES +; This entry point is used by the routine at __STOP. +__END_00: + LD (SAVTXT),HL + LD HL,TEMPST + LD (TEMPPT),HL + DEFB $21 ; "LD HL,nn" to jump over the next word without executing it + +; Used by the routines at __RESUME, __LINE, __INPUT and __READ. +INPBRK: + OR $FF ; 11111111b, Flag "Break" wanted + POP BC ; Return not needed and more +; This entry point is used by the routine at PRG_END. +; $6401 +ENDCON: + LD HL,(CURLIN) ; Get current line number + PUSH HL + PUSH AF ; Save STOP / END statusct break? + LD A,L ; Is it direct break? + AND H + INC A ; Line is -1 if direct break + JR Z,NOLIN ; Yes - No line number + LD (OLDLIN),HL ; Save line of break + LD HL,(SAVTXT) ; Get point of break + LD (OLDTXT),HL ; Save point to CONTinue +NOLIN: + CALL FINLPT ; Disable printer echo if enabled + CALL CONSOLE_CRLF + POP AF + LD HL,BREAK_MSG ; "Break" message + JP NZ,_ERROR_REPORT + JP RESTART + +; Routine at 25636 +__CONT: + LD HL,(OLDTXT) ; Get CONTinue address + LD A,H ; Is it zero? + OR L + LD DE,$0011 ; Err $11 - "Can't CONTINUE" + JP Z,ERROR + LD DE,(OLDLIN) ; Get line of last break + LD (CURLIN),DE ; Set up current line number + RET + +; Routine at 25656 +__TRON: + DEFB $3E ; "LD A,n" to Mask the next byte + +__TROFF: + XOR A + LD (TRCFLG),A ; 0 MEANS NO TRACE + RET + +; Routine at 25662 +__SWAP: + CALL GETVAR + PUSH DE + PUSH HL + LD HL,SWPTMP + CALL VMOVE ; Copy number value from DE to HL + LD HL,(ARYTAB) + EX (SP),HL + RST GETYPR ; Get the number type (FAC) + PUSH AF + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + CALL GETVAR + POP AF + LD B,A + RST GETYPR ; Get the number type (FAC) + CP B + JP NZ,TM_ERR ; If types are different, Err $0D - "Type mismatch" + EX (SP),HL + EX DE,HL + PUSH HL + LD HL,(ARYTAB) + RST DCOMPR ; Compare HL with DE. + JR NZ,_FC_ERR_A + POP DE + POP HL + EX (SP),HL + PUSH DE + CALL VMOVE ; Copy number value from DE to HL + POP HL + LD DE,SWPTMP + CALL VMOVE ; Copy number value from DE to HL + POP HL + RET +_FC_ERR_A: + JP FC_ERR ; Err $05 - "Illegal function call" + +; Data block at 25719 +__ERASE: +L6477: + LD A,$01 + LD (SUBFLG),A + CALL GETVAR + PUSH HL + LD (SUBFLG),A + LD H,B + LD L,C + DEC BC + DEC BC + DEC BC + DEC BC + DEC BC + ADD HL,DE + EX DE,HL + LD HL,(STREND) + +L648F: + RST DCOMPR ; Compare HL with DE. + +L6490: + LD A,(DE) + LD (BC),A + INC DE + INC BC + JR NZ,L648F + DEC BC + LD H,B + LD L,C + LD (STREND),HL + POP HL + LD A,(HL) + CP ',' + RET NZ + RST CHRGTB ; Gets next character (or token) from BASIC text. +L64A2: + JR __ERASE + +; Routine at 25764 +L64A4: + POP AF + POP HL + RET + +; Routine at 25767 + +; a.k.a. CHKLTR +; Used by the routines at DEFCON and GETVAR. +; Load A with char in (HL) and check it is a letter: +IS_LETTER: + LD A,(HL) ; Get byte + +; This entry point is used by the routines at TOKENIZE, OPRND, L5683, SCNVAR and GETVAR. +; Check char in 'A' being in the 'A'..'Z' range +ISLETTER_A: + CP 'A' ; < "A" ? + RET C ; Carry set if not letter + CP 'Z'+1 ; > "Z" ? + CCF + RET ; Carry set if not letter + +; Routine at 25775 +__CLEAR: + JP Z,_CLVAR ; Just "CLEAR" Keep parameters + CALL INTIDX_0 ; Get integer + DEC HL ; Cancel increment + RST CHRGTB ; Gets next character (or token) from BASIC text. + PUSH HL ; Save code string address + LD HL,(HIMEM) + LD B,H + LD C,L + LD HL,(MEMSIZ) ; Get end of RAM + JR Z,STORED ; No value given - Use stored + POP HL + RST SYNCHR ; Check for comma + DEFB ',' + PUSH DE ; Save number + CALL GETWORD ; Get integer 0 to 32767 to DE + DEC HL ; Cancel increment + RST CHRGTB ; Gets next character (or token) from BASIC text. + JP NZ,SN_ERR + EX (SP),HL ; Save code string address + EX DE,HL ; Number to DE + LD A,H ; Get MSB of new RAM top + AND A ; too low ? + JP P,FC_ERR ; Err $05 - "Illegal function call" + PUSH DE + LD DE,MAXRAM+1 ; Limit of CLEAR position + RST DCOMPR ; Compare HL with DE. + JP NC,FC_ERR ; Err $05 - "Illegal function call" + POP DE + PUSH HL ; Save code string address (again) + LD BC,$FEF5 ; -267 (same offset on Tandy model 100) + LD A,(MAXFIL) +__CLEAR_0: + ADD HL,BC + DEC A + JP P,__CLEAR_0 + POP BC ; Restore code string address (1st copy) + DEC HL +STORED: + ;; CALL SUBDE ; The Philips VG-5000 uses this call + 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,OM_ERR ; ?OM Error if not enough mem + PUSH HL ; Save RAM top + LD HL,(VARTAB) ; Get program end + PUSH BC + LD BC,$00A0 ; 160 Bytes minimum working RAM (same offset on Tandy model 100) + ADD HL,BC ; Get lowest address + POP BC + RST DCOMPR ; Enough memory? + JP NC,OM_ERR ; No - ?OM Error + EX DE,HL ; RAM top to HL + LD (STKTOP),HL ; Set new top of RAM + LD H,B + LD L,C + LD (HIMEM),HL + POP HL + LD (MEMSIZ),HL ; Set new string space + POP HL + CALL _CLVAR ; Initialise variables + LD A,(MAXFIL) + CALL MAXFILES + LD HL,(TEMP) + JP NEWSTT + +; Routine at 25888 +; SUBDE was probably replaced by inline code and never removed on MSX and SVI +; +; SUBTRACT [H,L]-[D,E] INTO [D,E] +; +SUBDE: + 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 + RET + +; Routine at 25895 +__NEXT: + LD DE,$0000 ; In case no index given +__NEXT_0: + CALL NZ,GETVAR ; not end of statement, locate variable (Get index address) + LD (TEMP),HL ; save BASIC pointer + CALL BAKSTK ; search FOR block on stack (skip 2 words) + JP NZ,NF_ERR ; Err $01 - "NEXT without FOR" + LD SP,HL ; Clear nested loops + PUSH DE ; Save index address + LD A,(HL) ; Get sign of STEP + PUSH AF ; Save sign of STEP + INC HL + PUSH DE ; Save index address + LD A,(HL) + INC HL + OR A + JP M,__NEXT_2 + DEC A + JR NZ,__NEXT_1 + LD BC,$0008 + ADD HL,BC +__NEXT_1: + ADD A,$04 + LD (VALTYP),A + CALL VMOVFM ; Move index value to FPREG + EX DE,HL + EX (SP),HL ; Save address of TO value + PUSH HL + RST GETYPR ; Get the number type (FAC) + JR NC,__NEXT_4 + CALL HLBCDE ; Load single precision FP value from (HL) in reverse byte order + CALL FADD + POP HL + CALL FPTHL + POP HL + CALL LOADFP + PUSH HL + CALL FCOMP + JR __NEXT_3 + +__NEXT_2: + LD BC,RDSLT + ADD HL,BC + LD C,(HL) + INC HL + LD B,(HL) + INC HL + EX (SP),HL + LD E,(HL) + INC HL + LD D,(HL) + PUSH HL + LD L,C + LD H,B + CALL IADD ; ADD THE STEP TO THE LOOP VARIABLE + LD A,(VALTYP) ; SEE IF THERE WAS OVERFLOW + CP $02 ; TURNED TO SINGLE-PRECISION? + JP NZ,OV_ERR ; INDICE GOT TOO LARGE ( Err $06 - "Overflow" ) + EX DE,HL ; [D,E]=NEW LOOP VARIABLE VALUE + POP HL ; GET THE POINTER AT THE LOOP VARIABLE + LD (HL),D ; STORE THE NEW VALUE + DEC HL + LD (HL),E + POP HL ; GET BACK THE POINTER INTO THE "FOR" ENTRY + PUSH DE ; SAVE THE VALUE OF THE LOOP VARIABLE + LD E,(HL) ; [D,E]=FINAL VALUE + INC HL + LD D,(HL) + INC HL + EX (SP),HL ; SAVE THE ENTRY POINTER AGAIN, GET THE VALUE OF THE LOOP VARIABLE INTO [H,L] + CALL ICOMP ; DO THE COMPARE +__NEXT_3: + POP HL ; POP OFF THE "FOR" ENTRY POINTER WHICH IS NOW POINTING PAST THE FINAL VALUE + POP BC ; GET THE SIGN OF THE INCREMENT + SUB B ; SUBTRACT THE INCREMENTS SIGN FROM THAT OF (CURRENT VALUE-FINAL VALUE) + CALL LOADFP ; GET LINE # OF "FOR" INTO [D,E] + JR Z,KILFOR ; IF SIGN(FINAL-CURRENT)+SIGN(STEP)=0, then loop finished - Terminate it + EX DE,HL ; Loop statement line number + LD (CURLIN),HL ; Set loop line number + LD L,C ; Set code string to loop + LD H,B + JP PUTFID + +__NEXT_4: + CALL NEXT_DADD + POP HL + CALL VMOVMF + POP HL + CALL HL_ARG + PUSH DE + CALL XDCOMP + JR __NEXT_3 + +; Remove "FOR" block +KILFOR: + LD SP,HL ; SINCE [H,L] MOVED ALL THE WAY DOWN THE ENTRY + LD (SAVSTK),HL ; Code string after "NEXT" + EX DE,HL ; RESTORE THE TEXT POINTER + LD HL,(TEMP) + LD A,(HL) ; Get next byte in code string + CP ',' ; More NEXTs ? + JP NZ,NEWSTT ; No - Do next statement + RST CHRGTB ; Position to index name + CALL __NEXT_0 ; Re-enter NEXT routine +; < will not RETurn to here , Exit to NEWSTT (RUNCNT) or Loop > + + +; +; THE FOLLOWING ROUTINE COMPARES TWO STRINGS +; ONE WITH DESC IN [D,E] OTHER WITH DESC. IN [FACLO, FACLO+1] +; A=0 IF STRINGS EQUAL +; A=377 IF B,C,D,E .GT. FACLO +; A=1 IF B,C,D,E .LT. FACLO +; +STRCMP: + CALL GETSTR ; Get current string ;FREE UP THE FAC STRING, AND GET THE POINTER TO THE FAC DESCRIPTOR IN [H,L] + LD A,(HL) ; Get length of string ;SAVE THE LENGTH OF THE FAC STRING IN [A] + INC HL + LD C,(HL) ; Get LSB of address ;SAVE THE POINTER AT THE FAC STRING DATA IN [B,C] + INC HL + LD B,(HL) + POP DE ; Restore string name ;GET THE STACK STRING POINTER + PUSH BC ; Save address of string ;SAVE THE POINTER AT THE FAC STRING DATA + PUSH AF ; Save length of string ;SAVE THE FAC STRING LENGTH + CALL GSTRDE ; Get second string ;FREE UP THE STACK STRING AND RETURN + ;THE POINTER TO THE STACK STRING DESCRIPTOR IN [H,L] + POP AF ; Restore length of string 1 + LD D,A ; Length to D ;[D]=LENGTH OF FAC STRING + LD E,(HL) ;[E]=LENGTH OF STACK STRING + INC HL + LD C,(HL) ;[B,C]=POINTER AT STACK STRING + INC HL + LD B,(HL) + POP HL ; Restore address of string 1 ;GET BACK 2ND CHARACTER POINTER + +; a.k.a. CMPSTR +CSLOOP: + LD A,E ; Bytes of string 2 to do ;BOTH STRINGS ENDED + OR D ; Bytes of string 1 to do ;TEST BY OR'ING THE LENGTHS TOGETHER + RET Z ; Exit if all bytes compared ;IF SO, RETURN WITH A ZERO + LD A,D ; Get bytes of string 1 to do ;GET FACLO STRING LENGTH + SUB 1 ;SET CARRY AND MAKE [A]=255 IF [D]=0 + RET C ; Exit if end of string 1 ;RETURN IF THAT STRING ENDED + XOR A ;MUST NOT HAVE BEEN ZERO, TEST CASE + CP E ; Bytes of string 2 to do ;OF B,C,D,E STRING HAVING ENDED FIRST + INC A ;RETURN WITH A=1 + RET NC ; Exit if end of string 2 ;TEST THE CONDITION + +; a.k.a. CMPRES +;HERE WHEN NEITHER STRING ENDED + DEC D ; Count bytes in string 1 ;DECREMENT BOTH CHARACTER COUNTS + DEC E ; Count bytes in string 2 + LD A,(BC) ; Byte in string 2 ;GET CHARACTER FROM B,C,D,E STRING + INC BC ; Move up string 2 + CP (HL) ; Compare to byte in string 1 ;COMPARE WITH FACLO STRING + INC HL ; Move up string 1 ;BUMP POINTERS (INX DOESNT CLOBBER CC'S) + JR Z,CSLOOP ; Same - Try next bytes ;IF BOTH THE SAME, MUST BE MORE TO STRINGS + CCF ; Flag difference (">" or "<") ;HERE WHEN STRINGS DIFFER + JP SIGNS ; "<" gives -1 , ">" gives +1 ;SET [A] ACCORDING TO CARRY + + +; 'OCT$' BASIC function +; +; THE STRO$ FUNCTION TAKES A NUMBER AND GIVES +; A STRING WITH THE CHARACTERS THE NUMBER WOULD GIVE IF OUTPUT IN OCTAL +; +; Routine at 26101 +__OCT_S: + CALL FOUTO ;PUT OCTAL NUMBER IN FBUFFR + JR __STR_S_0 ;JUMP INTO STR$ CODE + +; 'HEX$' BASIC function +; STRH$ SAME AS STRO$ EXCEPT USES HEX INSTEAD OF OCTAL +; Routine at 26106 +__HEX_S: + CALL FOUTH ;PUT HEX NUMBER IN FBUFFR + JR __STR_S_0 ;JUMP INTO STR$ CODE + +; Routine at 26111 +__BIN_S: + CALL BIN_STR + JR __STR_S_0 + +; Routine at 26116 +__STR_S: ;IS A NUMERIC + CALL FOUT ; Turn number into text ;DO ITS OUTPUT + +; This entry point is used by the routines at __OCT_S, __HEX_S and __BIN_S. +__STR_S_0: + CALL CRTST ; Create string entry ;SCAN IT AND TURN IT INTO A STRING + CALL GSTRCU ; Current string to pool ;FREE UP THE TEMP + +; Save string in string area +SAVSTR: + LD BC,TOPOOL ; Save in string pool + PUSH BC ; Save address on stack ;SET UP ANSWER IN NEW TEMP + +; +; STRCPY CREATES A COPY OF THE STRING WHOSE DESCRIPTOR IS POINTED TO BY [H,L]. +; ON RETURN [D,E] POINTS TO DSCTMP WHICH HAS THE STRING INFO (LENGTH, WHERE COPIED TO) +; +; This entry point is used by the routines at __LET and LHSMID. +; $6611 +STRCPY: + LD A,(HL) ; Get string length ;GET LENGTH + INC HL ;MOVE UP TO THE POINTER + PUSH HL ; Save pointer to string ;GET POINTER TO POINTER OF ARG + CALL TESTR ; See if enough string space ;GET THE SPACE + POP HL ; Restore pointer to string ;FIND OUT WHERE STRING TO COPY + LD C,(HL) ; Get LSB of address + INC HL + LD B,(HL) ; Get MSB of address + CALL CRTMST ; Create string entry ;SETUP DSCTMP + PUSH HL ; Save pointer to MSB of addr ;SAVE POINTER TO DSCTMP + LD L,A ; Length of string ;GET CHARACTER COUNT INTO [L] + CALL TOSTRA ; Move to string area ;MOVE THE CHARS IN + POP DE ; Restore pointer to MSB ;RESTORE POINTER TO DSCTMP + RET ;RETURN + +; Routine at 26149 +; +; Used by the routines at __CHR_S and FN_INKEY. +STRIN1: + LD A,$01 ;MAKE ONE CHAR STRING (CHR$, INKEY$) + +; This entry point is used by the routines at CONCAT, FN_STRING, FN_INPUT and FN_SPRITE. +; Make temporary string +;GET SOME STRING SPACE ([A] CHARS) +MKTMST: + CALL TESTR ; See if enough string space + +; This entry point is used by the routines at SAVSTR, DTSTR and __LEFT_S. +; Create string entry +CRTMST: + LD HL,DSCTMP ; Temporary string ;GET DESC. TEMP + PUSH HL ; Save it ;SAVE DESC. POINTER + LD (HL),A ; Save length of string ;SAVE CHARACTER COUNT +;PUTDEI: + INC HL ;STORE [D,E]=POINTER TO FREE SPACE + LD (HL),E ; Save LSB of address + INC HL + LD (HL),D ; Save MSB of address + POP HL ; Restore pointer ;AND RESTORE [H,L] AS THE DESCRIPTOR POINTER + RET + +; Routine at 26165 +; +; Used by the routines at __STR_S and PRS. +CRTST: + DEC HL ; DEC - INCed after + + +; +; STRLT2 TAKES THE STRING LITERAL WHOSE FIRST CHARACTER IS POINTED BY [H,L]+1 AND BUILDS A DESCRIPTOR FOR IT. +; THE DESCRIPTOR IS INITIALLY BUILT IN DSCTMP, BUT PUTNEW TRANSFERS IT INTO A TEMPORARY AND LEAVES A POINTER +; AT THE TEMPORARY IN FACLO. THE CHARACTERS OTHER THAN ZERO THAT TERMINATE THE STRING SHOULD BE SET UP IN [B] +; AND [D]. IT THE TERMINATOR IS A QUOTE, THE QUOTE IS SKIPPED OVER. +; LEADING QUOTES SHOULD BE SKIPPED BEFORE CALL. ON RETURN THE CHARACTER AFTER THE STRING LITERAL IS POINTED TO +; BY [H,L] AND IS IN [A], BUT THE CONDITION CODES ARE NOT SET UP. +; +; Create quote terminated String +; +; Used by the routines at __INPUT and OPRND. +QTSTR: + LD B,'"' ; Terminating quote ;ASSUME STR ENDS ON QUOTE +; This entry point is used by the routines at __LINE and L6E35. +QTSTR_0: + LD D,B ; Quote to D + +; Create String, termination char in D +; +; Used by the routine at __READ. +DTSTR: + PUSH HL ; Save start ;SAVE POINTER TO START OF LITERAL + LD C,-1 ; Set counter to -1 ;INITIALIZE CHARACTER COUNT +STRGET: + INC HL ; Move on + LD A,(HL) ; Get byte ;GET CHAR + INC C ; Count bytes ;BUMP CHARACTER COUNT + OR A ; End of line? ;IF 0, (END OF LINE) DONE + JR Z,STRFIN ; Yes - Create string entry ;TEST + CP D ; Terminator D found? + JR Z,STRFIN ; Yes - Create string entry + CP B ; Terminator B found? ;CLOSING QUOTE + JR NZ,STRGET ; No - Keep looking ;NO, GO BACK FOR MORE +STRFIN: + CP '"' ; End with '"'? ;IF QUOTE TERMINATES THE STRING + CALL Z,__CHRGTB ; Yes - Get next character ;SKIP OVER THE QUOTE +;------ +; PUSH HL ;SAVE POINTER AT END OF STRING +; LD A,B ;WERE WE SCANNING AN UNQUOTED STRING? +; CP ',' +; JP NZ,NTTRLS ;IF NOT, DON'T SUPPRESS TRAILING SPACES +; INC C ;FIX [C] WHICH IS THE CHARACTER COUNT +;LPTRLS: +; DEC C ;DECREMENT UNTIL WE FIND A NON-SPACE CHARACTER +; JP Z,NTTRLS ;DON'T GO PAST START (ALL SPACES) +; DEC HL ;LOOK AT PREVIOUS CHARACTER +; LD A,(HL) +; CP ' ' +; JP Z,LPTRLS ;IF SO CONTINUE LOOKING +;NTTRLS: +; POP HL +;------- + EX (SP),HL ; Starting quote + INC HL ; First byte of string + EX DE,HL ; To DE ;GET POINTER TO TEMP + LD A,C ; Get length ;GET CHARACTER COUNT IN A + CALL CRTMST ; Create string entry ;SAVE STR INFO + +; +; SOME STRING FUNCTION IS RETURNING A RESULT IN DSCTMP +; WE WANT TO SETUP A TEMP DESCRIPTOR WITH DCSTMP IN IT +; PUT A POINTER TO THE DESCRIPTOR IN FACLO AND FLAG THE +; RESULT AS TYPE STRING +; + +; Temporary string to pool +; a.k.a. PUTNEW +; +; Used by the routines at CONCAT, TOPOOL, __LEFT_S, FN_INPUT and FN_SPRITE. +TSTOPL: + LD DE,DSCTMP ; Temporary string ;[D,E] POINT AT RESULT DESCRIPTOR + DEFB $3E ; "LD A,n" to Mask the next byte ;SKIP THE NEXT BYTE ("MVI AL,") + +PUTTMP: + PUSH DE ;SAVE A POINTER TO THE START OF THE STRING + LD HL,(TEMPPT) ; Temporary string pool pointer ;[H,L]=POINTER TO FIRST FREE TEMP + LD (FACLOW),HL ; Save address of string ptr ;POINTER AT WHERE RESULT DESCRIPTOR WILL BE + LD A,$03 + LD (VALTYP),A ; Set type to string ;FLAG THIS AS A STRING + CALL VMOVE ; Move string to pool ;AND MOVE THE VALUE INTO A TEMPORARY + LD DE,DSCTMP+3 ;IF THE CALL IS TO PUTTMP, [D,E] WILL NOT EQUAL DSCTMP +3 + RST DCOMPR ; Out of string pool? ;DSCTMP IS JUST BEYOND THE TEMPS + ;AND IF TEMPPT POINTS AT IT THERE ARE NO FREE TEMPS + LD (TEMPPT),HL ; Save new pointer ;SAVE NEW TEMPORARY POINTER + POP HL ; Restore code string address ;GET THE TEXT POINTER + LD A,(HL) ; Get next code byte ;GET CURRENT CHARACTER INTO [A] + RET NZ ; Return if pool OK + LD DE,$0010 ; Err $10 - "String formula too complex" ; "STRING TEMPORARY" ERROR + JP ERROR ;GO TELL HIM + +; +; PRINT THE STRING POINTED TO BY [H,L] WHICH ENDS WITH A ZERO +; IF THE STRING IS BELOW DSCTMP IT WILL BE COPIED INTO STRING SPACE +; +; Routine at 26231 +PRNUMS: + INC HL ;POINT AT NEXT CHARACTER + +; Create string entry and print it +; +; a.k.a. STROUT +; Used by the routines at IN_PRT, L4B4A, LTSTND, __DELETE, LINE2PTR, L61C4, __CLOAD, +; L710B, _CSTART and L7D29. +PRS: + CALL CRTST ;GET A STRING LITERAL + +; Print string at HL +; +; Used by the routines at L4A5A, __INPUT and L61C4. +PRS1: + CALL GSTRCU ;RETURN TEMP POINTER BY FACLO + CALL LOADFP_0 ;[D]=LENGTH [B,C]=POINTER AT DATA + INC D ;INCREMENT AND DECREMENT EARLY TO CHECK FOR NULL STRING +PRS1_0: + DEC D ;DECREMENT THE LENGTH + RET Z ;ALL DONE + LD A,(BC) ;GET CHARACTER TO PRINT + RST OUTDO + CP CR + CALL Z,CRFIN + INC BC ;POINT TO THE NEXT CHARACTER + JR PRS1_0 ;AND PRINT IT... + + +; Test if enough room for string +; +; a.k.a. GETSPA - GET SPACE FOR CHARACTER STRING +; MAY FORCE GARBAGE COLLECTION. +; +; # OF CHARS (BYTES) IN [A] +; RETURNS WITH POINTER IN [D,E] OTHERWISE IF CANT GET SPACE +; BLOWS OFF TO "OUT OF STRING SPACE" TYPE ERROR. +; +; Routine at 26254 +; Used by the routines at SAVSTR, STRIN1 and __LEFT_S. +TESTR: + OR A ; MUST BE NON ZERO. SIGNAL NO GARBAG YET + DEFB $0E ; "LD C,n" to Mask the next byte + +; GRBDON: Garbage Collection Done +GRBDON: + POP AF ;IN CASE COLLECTED WHAT WAS LENGTH? + PUSH AF ; Save status ;SAVE IT BACK + LD HL,(STKTOP) ; Bottom of string space in use + EX DE,HL ; To DE ;IN [D,E] + LD HL,(FRETOP) ; Bottom of string area ;GET TOP OF FREE SPACE IN [H,L] + CPL ; Negate length (Top down) ;-# OF CHARS + LD C,A ; -Length to BC ;IN [B,C] + LD B,$FF ; BC = -ve length of string + ADD HL,BC ; Add to bottom of space in use ;SUBTRACT FROM TOP OF FREE + INC HL ; Plus one for 2's complement + RST DCOMPR ; Below string RAM area? ;COMPARE THE TWO + JR C,TESTOS ; Tidy up if not done else err ;NOT ENOUGH ROOM FOR STRING, OFFAL TIME + LD (FRETOP),HL ; Save new bottom of area ;SAVE NEW BOTTOM OF MEMORY + INC HL ; Point to first byte of string ;MOVE BACK TO POINT TO STRING + EX DE,HL ; Address to DE ;RETURN WITH POINTER IN [D,E] + +; This entry point is used by the routine at DETOKEN. +POPAF: + POP AF ; Throw away status push ;GET CHARACTER COUNT + RET ;RETURN FROM GETSPA + +; Garbage Collection: Tidy up if not done else err +; a.k.a. GARBAG +; Used by the routine at GRBDON. +TESTOS: + POP AF ; Garbage collect been done? ;HAVE WE COLLECTED BEFORE? + LD DE,$000E ; Err $0E - "Out of string space" ;GET READY FOR OUT OF STRING SPACE ERROR + JP Z,ERROR ; Yes - Not enough string apace ;GO TELL USER HE LOST + CP A ; Flag garbage collect done ;SET ZERO FLAG TO SAY WEVE GARBAGED + PUSH AF ; Save status ;SAVE FLAG BACK ON STACK + LD BC,GRBDON ; Garbage collection done ;PLACE FOR GARBAG TO RETURN TO. + PUSH BC ; Save for RETurn ;SAVE ON STACK + +; This entry point is used by the routine at __FRE. +GARBGE: + LD HL,(MEMSIZ) ; Get end of RAM pointer ;START FROM TOP DOWN +; This entry point is used by the routine at GNXARY. +GARBLP: + LD (FRETOP),HL ; Reset string pointer ;LIKE SO + LD HL,$0000 ;GET DOUBLE ZERO + PUSH HL ; Flag no string found ;SAY DIDNT SEE VARS THIS PASS + LD HL,(STREND) ; Get bottom of string space ;FORCE DVARS TO IGNORE STRINGS IN THE PROGRAM TEXT (LITERALS, DATA) + PUSH HL ; Save bottom of string space ;FORCE FIND HIGH ADDRESS + LD HL,TEMPST ; Temporary string pool ;GET START OF STRING TEMPS + +TVAR: + LD DE,(TEMPPT) + RST DCOMPR ; Compare HL with DE. + + ;CANNOT RUN IN RAM SINCE IT STORES TO MESS UP BASIC + LD BC,TVAR ;FORCE JUMP TO TVAR ; Loop until string pool done + JP NZ,STPOOL ;DO TEMP VAR GARBAGE COLLECT ; No - See if in string area + LD HL,PRMPRV ;SETUP ITERATION FOR PARAMETER BLOCKS ; Start of simple variables + LD (TEMP9),HL + LD HL,(ARYTAB) ;GET STOPPING POINT IN [H,L] + LD (ARYTA2),HL ;STORE IN STOP LOCATION + LD HL,(VARTAB) ;GET STARTING POINT IN [H,L] +SMPVAR: + LD DE,(ARYTA2) ;GET STOPPING LOCATION ; End of simple variables + RST DCOMPR ;SEE IF AT END OF SIMPS ; All simple strings done? + JR Z,ARYVAR ; Yes - Do string arrays + LD A,(HL) ;GET VALTYP ; Get type of variable + INC HL ;BUMP POINTER TWICE + INC HL ; + INC HL ;POINT AT THE VALUE + CP $03 ;SEE IF ITS A STRING + JR NZ,SKPVAR ;IF NOT, JUST SKIP AROUND IT + CALL STRADD ;COLLECT IT ; Add if string in string area + XOR A ;AND DON'T SKIP ANYTHING MORE +SKPVAR: + LD E,A + LD D,$00 ;[D,E]=AMOUNT TO SKIP + ADD HL,DE + JR SMPVAR ;GET NEXT ONE ; Loop until simple ones done + +ARYVAR: + LD HL,(TEMP9) ;GET LINK IN PARAMETER BLOCK CHAIN + LD E,(HL) ;GO BACK ONE LEVEL + INC HL + LD D,(HL) + LD A,D + OR E ;WAS THAT THE END? + LD HL,(ARYTAB) + JR Z,ARRLP ;OTHERWISE GARBAGE COLLECT ARRAYS + EX DE,HL + LD (TEMP9),HL ;SETUP NEXT LINK IN CHAIN FOR ITERATION + INC HL ;SKIP CHAIN POINTER + INC HL + LD E,(HL) ;PICK UP THE LENGTH + INC HL + LD D,(HL) + INC HL + EX DE,HL ;SET [D,E]= ACTUAL END ADDRESS BY + ADD HL,DE ;ADDING BASE TO LENGTH + LD (ARYTA2),HL ;SET UP STOP LOCATION + EX DE,HL + JR SMPVAR + +; Move to next array +; +; Used by the routine at ARRLP. +; Routine at 26393 +GNXARY: + POP BC ; Scrap address of this array ;GET RID OF STACK GARBAGE + +; Used by the routines at TVAR and GRBARY. +ARRLP: + LD DE,(STREND) ; End of string arrays ;GET END OF ARRAYS + RST DCOMPR ; All string arrays done? ;SEE IF DONE WITH ARRAYS + JP Z,SCNEND ; Yes - Move string if found ;YES, SEE IF DONE COLLECTING + LD A,(HL) ; Get type of array ;GET THE VALUE TYPE INTO [A] + INC HL + CALL LOADFP ; Get next ;SKIP THE EXTRA CHARACTERS + PUSH HL ; Save address of num of dim'ns ;SAVE POINTER TO DIMS + ADD HL,BC ; Start of next array ;ADD TO CURRENT POINTER PO + CP $03 ; Test type of array ;SEE IF ITS A STRING + JR NZ,GNXARY ; Numeric array - Ignore it ;IF NOT JUST SKIP IT + LD (TEMP8),HL ; Save address of next array ;SAVE END OF ARRAY + POP HL ; Get address of num of dim'ns ;GET BACK CURRENT POSITION + LD C,(HL) ; BC = Number of dimensions ;PICK UP NUMBER OF DIMS + LD B,$00 ;MAKE DOUBLE WITH HIGH ZERO + ADD HL,BC ; Two bytes per dimension size ;GO PAST DIMS + ADD HL,BC ;BY ADDING ON TWICE #DIMS (2 BYTE GUYS) + INC HL ; Plus one for number of dim'ns ;ONE MORE TO ACCOUNT FOR #DIMS. + +ARYSTR: + EX DE,HL ;SAVE CURRENT POSIT IN [D,E] ; Get address of next array + LD HL,(TEMP8) ;GET END OF ARRAY + EX DE,HL ;FIX [H,L] BACK TO CURRENT ; Is this array finished? + RST DCOMPR ;SEE IF AT END OF ARRAY ; Yes - Get next one + JR Z,ARRLP ;END OF ARRAY, TRY NEXT ARRAY ; Loop until array all done + LD BC,ARYSTR ;ADDR OF WHERE TO RETURN TO + +; This entry point is used by the routine at TESTR. +STPOOL: + PUSH BC ;GOES ON STACK ; Save return address + +; This entry point is used by the routine at TESTR. +STRADD: + XOR A + OR (HL) ; Get string length ;SEE IF ITS THE NULL STRING + INC HL + LD E,(HL) ; Get LSB of string address + INC HL + LD D,(HL) ; Get MSB of string address + INC HL ;[D,E]=POINTER AT THE VALUE + RET Z ;NULL STRING, RETURN + LD B,H ;MOVE [H,L] TO [B,C] + LD C,L + LD HL,(FRETOP) ; Bottom of new area ;GET POINTER TO TOP OF STRING FREE SPACE + RST DCOMPR ; String been done? ;IS THIS STRINGS POINTER .LT. FRETOP + LD H,B ; Restore variable pointer ;MOVE [B,C] BACK TO [H,L] + LD L,C + RET C ; String done - Ignore ;IF NOT, NO NEED TO MESS WITH IT FURTHUR + POP HL ; Return address ;GET RETURN ADDRESS OFF STACK + EX (SP),HL ; Lowest available string area ;GET MAX SEEN SO FAR & SAVE RETURN ADDRESS + RST DCOMPR ; String within string area? ;LETS SEE + EX (SP),HL ; Lowest available string area ;SAVE MAX SEEN & GET RETURN ADDRESS OFF STACK + PUSH HL ; Re-save return address ;SAVE RETURN ADDRESS BACK + LD H,B ; Restore variable pointer ;MOVE [B,C] BACK TO [H,L] + LD L,C + RET NC ; Outside string area - Ignore ;IF NOT, LETS LOOK AT NEXT VAR + POP BC ; Get return , Throw 2 away ;GET RETURN ADDR OFF STACK + POP AF ;POP OFF MAX SEEN + POP AF ;AND VARIABLE POINTER + PUSH HL ; Save variable pointer ;SAVE NEW VARIABLE POINTER + PUSH DE ; Save address of current ;AND NEW MAX POINTER + PUSH BC ; Put back return address ;SAVE RETURN ADDRESS BACK + RET ; Go to it ;AND RETURN + +; +; HERE WHEN MADE ONE COMPLETE PASS THRU STRING VARS +; +; All string arrays done, now move string +; +; Used by the routine at ARYVAR. +SCNEND: + POP DE ; Addresses of strings ;POP OFF MAX POINTER + POP HL ;AND GET VARIABLE POINTER + LD A,H ; HL = 0 if no more to do ;GET LOW IN + OR L ;SEE IF ZERO POINTER + RET Z ; No more to do - Return ;IF END OF COLLECTION, THEN MAYBE RETURN TO GETSPA + DEC HL ;CURRENTLY JUST PAST THE DESCRIPTOR + LD B,(HL) ; MSB of address of string ;[B]=HIGH BYTE OF DATA POINTER + DEC HL + LD C,(HL) ; LSB of address of string ;[B,C]=POINTER AT STRING DATA + PUSH HL ; Save variable address ;SAVE THIS LOCATION SO THE POINTER CAN BE UPDATED AFTER THE STRING IS MOVED + DEC HL + LD L,(HL) ; HL = Length of string ;[L]=STRING LENGTH + LD H,$00 ;[H,L] GET CHARACTER COUNT + ADD HL,BC ; Address of end of string+1 ;[H,L]=POINTER BEYOND STRING + LD D,B ; String address to DE + LD E,C ;[D,E]=ORIGINAL POINTER + DEC HL ; Last byte in string ;DON'T MOVE ONE BEYOND STRING + LD B,H ; Address to BC ;GET TOP OF STRING IN [B,C] + LD C,L + LD HL,(FRETOP) ; Current bottom of string area ;GET TOP OF FREE SPACE + CALL MOVUP_0 ; Move string to new address ;MOVE STRING + POP HL ; Restore variable address ;GET BACK POINTER TO DESC. + LD (HL),C ; Save new LSB of address ;SAVE FIXED ADDR + INC HL ;MOVE POINTER + LD (HL),B ; Save new MSB of address ;HIGH PART + LD H,B ; Next string area+1 to HL + LD L,C ;[H,L]=NEW POINTER + DEC HL ; Next string area address ;FIX UP FRETOP + JP GARBLP ; Look for more strings ;AND TRY TO FIND HIGH AGAIN + +; String concatenation +; +; THE FOLLOWING ROUTINE CONCATENATES TWO STRINGS +; THE FACLO CONTAINS THE FIRST ONE AT THIS POINT, +; [H,L] POINTS BEYOND THE + SIGN AFTER IT +; +; Routine at 26503 +; Used by the routine at EVAL3. +CONCAT: + PUSH BC ; Save prec' opr & code string ;PUT OLD PRECEDENCE BACK ON + PUSH HL ;SAVE TEXT POINTER + LD HL,(FACLOW) ; Get first string ;GET POINTER TO STRING DESC. + EX (SP),HL ; Save first string ;SAVE ON STACK & GET TEXT POINTER BACK + CALL OPRND ; Get second string ;EVALUATE REST OF FORMULA + EX (SP),HL ; Restore first string ;SAVE TEXT POINTER, GET BACK DESC. + CALL TSTSTR ; Make sure it's a string + LD A,(HL) ; Get length of second string + PUSH HL ; Save first string ;SAVE DESC. POINTER. + LD HL,(FACLOW) ; Get second string ;GET POINTER TO 2ND DESC. + PUSH HL ; Save second string ;SAVE IT + ADD A,(HL) ; Add length of second string ;ADD TWO LENGTHS TOGETHER + LD DE,$000F ; Err $0F - "String too long" ;SEE IF RESULT .LT. 256 + JP C,ERROR ; String too long - Error ;ERROR "LONG STRING" + CALL MKTMST ; Make temporary string ;GET INITIAL STRING + POP DE ; Get second string to DE ;GET 2ND DESC. + CALL GSTRDE ; Move to string pool if needed + EX (SP),HL ; Get first string ;SAVE POINTER TO IT + CALL GSTRHL ; Move to string pool if needed ;FREE UP 1ST TEMP + PUSH HL ; Save first string ;SAVE DESC. POINTER (FIRST) + LD HL,(TMPSTR) ; Temporary string address ;GET POINTER TO FIRST + EX DE,HL ; To DE ;IN [D,E] + CALL SSTSA ; First string to string area ;MOVE IN THE FIRST STRING + CALL SSTSA ; Second string to string area ;AND THE SECOND + LD HL,EVAL2 ; Return to evaluation loop ;CAT REENTERS FORMULA EVALUATION AT EVAL2 + EX (SP),HL ; Save return,get code string + PUSH HL ; Save code string address ;TEXT POINTER OFF FIRST + JP TSTOPL ; To temporary string to pool ;THEN RETURN ADDRESS OF TSTOP + +; Routine at 26559 +; +; Used by the routine at CONCAT. +SSTSA: + POP HL ; Return address ;GET RETURN ADDR + EX (SP),HL ; Get string block,save return ;PUT BACK, BUT GET DESC. + LD A,(HL) ; Get length of string ;[A]=STRING LENGTH + INC HL + LD C,(HL) ; Get LSB of string address ;[B,C]=POINTER AT STRING DATA + INC HL + LD B,(HL) ; Get MSB of string address + LD L,A ; Length to L ;[L]=STRING LENGTH + +; Move string in BC, (len in L) to string area +; a.k.a. MOVSTR +; This entry point is used by the routines at SAVSTR and __LEFT_S. +TOSTRA: + INC L ; INC - DECed after + +TSALP: + DEC L ; Count bytes moved ;SET CC'S + RET Z ; End of string - Return ;0, NO BYTE TO MOVE +;MV_MEM: +; Move the memory pointed by BC to the memory pointed by DE, L times. + LD A,(BC) ; Get source ;GET CHAR + LD (DE),A ; Save destination ;SAVE IT + INC BC ; Next source ;MOVE POINTERS + INC DE ; Next destination + JR TSALP ; Loop until string moved ;KEEP DOING IT + + +; Get string pointed by FPREG 'Type Error' if it is not +; +; a.k.a. FRESTR +; FRETMP IS PASSED A POINTER TO A STRING DESCRIPTOR IN [D,E] +; THIS VALUE IS RETURNED IN [H,L]. ALL THE OTHER REGISTERS ARE MODIFIED. +; A CHECK TO IS MADE TO SEE IF THE STRING DESCRIPTOR [D,E] POINTS TO +; IS THE LAST TEMPORARY DESCRIPTOR ALLOCATED BY PUTNEW. +; IF SO, THE TEMPORARY IS FREED UP BY THE UPDATING OF TEMPPT. +; IF A TEMPORARY IS FREED UP, A FURTHER CHECK IS MADE TO SEE IF THE STRING DATA +; THAT THAT STRING TEMPORARY POINTED TO IS THE THE LOWEST PART OF STRING SPACE IN USE. +; IF SO, FRETMP IS UPDATED TO REFLECT THE FACT THAT THAT SPACE IS NO LONGER IN USE. +; +; Routine at 26576 +; +; Used by the routines at __NEXT, __LEN, FN_INSTR, LHSMID, NAMSCN and __SPRITE. +; $67D0 +GETSTR: + CALL TSTSTR ; Make sure it's a string + +; Get string pointed by FPREG +; +; Used by the routines at FN_USR, __STR_S, PRS1 and __FRE. +; a.k.a. FREFAC +GSTRCU: + LD HL,(FACLOW) ; Get current string + +; Get string pointed by HL +; +; Used by the routines at L61C4, CONCAT and FN_INSTR. +GSTRHL: + EX DE,HL ; Save DE ;FREE UP THE TEMP IN THE FACLO + +; Get string pointed by DE +; +; Used by the routines at __NEXT, CONCAT and __LEFT_S. +GSTRDE: + CALL FRETMS ; Was it last tmp-str? ;FREE UP THE TEMPORARY + EX DE,HL ; Restore DE ;PUT THE STRING POINTER INTO [H,L] + RET NZ ; No - Return + PUSH DE ; Save string ;SAVE [D,E] TO RETURN IN [H,L] + LD D,B ; String block address to DE ;[D,E]=POINTER AT STRING + LD E,C + DEC DE ; Point to length ;SUBTRACT ONE + LD C,(HL) ; Get string length ;[C]=LENGTH OF THE STRING FREED UP + LD HL,(FRETOP) ; Current bottom of string area ;SEE IF ITS THE FIRST ONE IN STRING SPACE + RST DCOMPR ; Last one in string area? + JR NZ,POPHL ; No - Return ;NO SO DON'T ADD + LD B,A ; Clear B (A=0) ;MAKE [B]=0 + ADD HL,BC ; Remove string from str' area ;ADD + LD (FRETOP),HL ; Save new bottom of str' area ;AND UPDATE FRETOP +POPHL: + POP HL ; Restore string ;GET POINTER AT CURRENT DESCRIPTOR + RET + +; Routine at 26606 +; +; Used by the routines at __LET and GSTRDE. +; Back to last tmp-str entry +; a.k.a BAKTMP +FRETMS: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HFRET ; Hook for 'Free descriptor' event +ENDIF + LD HL,(TEMPPT) ; Back ;GET TEMP POINTER + DEC HL ; Get MSB of address ;LOOK AT WHAT IS IN THE LAST TEM + LD B,(HL) ; Back ;[B,C]=POINTER AT STRING + DEC HL ; Get LSB of address ;DECREMENT TEMPPT BY STRSIZ + LD C,(HL) ; Back + DEC HL ; Back + RST DCOMPR ; String last in string pool? ;SEE IF [D,E] POINT AT THE LAST + RET NZ ; Yes - Leave it ;RETURN NOW IF NOW FREEING DONE + LD (TEMPPT),HL ; Save new string pool top ;UPDATE THE TEMP POINTER SINCE ITS BEEN DECREMENTED BY 4 + RET + + +; 'LEN' BASIC function +; +; THE FUNCTION LEN($) RETURNS THE LENGTH OF THE +; STRING PASSED AS AN ARGUMENT +; +; Routine at 26623 +__LEN: + LD BC,PASSA ; To return integer A ;CALL SNGFLT WHEN DONE + PUSH BC ; Save address ;LIKE SO + +; This entry point is used by the routines at __ASC and __VAL. +GETLEN: + CALL GETSTR ; Get string and its length ;FREE UP TEMP POINTED TO BY FACLO + XOR A ;FORCE NUMERIC FLAG + LD D,A ; Clear D ;SET HIGH OF [D,E] TO ZERO FOR VAL + LD A,(HL) ; Get length of string + OR A ; Set status flags ;SET CONDITION CODES ON LENGTH + RET ;RETURN + + +; 'ASC' BASIC function +; +; THE FOLLOWING IS THE ASC($) FUNCTION. IT RETURNS AN INTEGER +; WHICH IS THE DECIMAL ASCII EQUIVALENT +; +; Routine at 26635 +__ASC: + LD BC,PASSA ; To return integer A ;WHERE TO GO WHEN DONE + PUSH BC ; Save address ;SAVE RETURN ADDR ON STACK + +; This entry point is used by the routine at FN_STRING. +__ASC_0: + CALL GETLEN ; Get length of string ;SET UP ORIGINAL STR + JP Z,FC_ERR ; Null string - Error ;NULL STR, BAD ARG. + INC HL ;BUMP POINTER + LD E,(HL) ; Get LSB of address ;[D,E]=POINTER AT STRING DATA + INC HL + LD D,(HL) ; Get MSB of address + LD A,(DE) ; Get first byte of string ;[A]=FIRST CHARACTER + RET + + +; 'CHR$' BASIC function +; +; CHR$(#) CREATES A STRING WHICH CONTAINS AS ITS ONLY +; CHARACTER THE ASCII EQUIVALENT OF THE INTEGER ARG (#) +; WHICH MUST BE .LE. 255. +; +; Routine at 26651 +__CHR_S: + CALL STRIN1 ; Make One character temporary string ;GET STRING IN DSCTMP + CALL CONINT ; Make it integer A ;GET INTEGER IN RANGE + +; This entry point is used by the routine at FN_INKEY. +SETSTR: + LD HL,(TMPSTR) ; Get address of string ;GET ADDR OF STR + LD (HL),E ; Save character ;SAVE ASCII BYTE + +; Save in string pool +; +; Used by the routine at FN_STRING. +TOPOOL: + POP BC ; Clean up stack ;RETURN TO HIGHER LEVEL & SKIP THE CHKNUM CALL. + JP TSTOPL ; Temporary string to pool ;GO CALL PUTNEW + +; Routine at 26665 +; +; Used by the routine at OPRND. +FN_STRING: + RST CHRGTB ;GET NEXT CHAR FOLLOWING "STRING$" + RST SYNCHR + DEFB '(' ;MAKE SURE LEFT PAREN + CALL GETINT ;EVALUATE FIRST ARG (LENGTH) + PUSH DE ;SAVE IT + RST SYNCHR + DEFB ',' ;COMMA + CALL EVAL ;GET FORMULA ARG 2 + RST SYNCHR + DEFB ')' ;EXPECT RIGHT PAREN + EX (SP),HL ;SAVE TEXT POINTER ON STACK, GET REP FACTOR + PUSH HL ;SAVE BACK REP FACTOR + RST GETYPR ;GET TYPE OF ARG + JR Z,STRSTR ;WAS A STRING + CALL CONINT ;GET ASCII VALUE OF CHAR + JR CALSPA ;NOW CALL SPACE CODE + +STRSTR: + CALL __ASC_0 ;GET VALUE OF CHAR IN [A] +CALSPA: + POP DE ;GET REP FACTOR IN [E] + CALL __SPACE_S_0 ;INTO SPACE CODE, PUT DUMMY ENTRY ON STACK POPPED OFF BY FINBCK + +__SPACE_S: + CALL CONINT ;GET NUMBER OF CHARS IN [E] + LD A,' ' ;GET SPACE CHAR + +__SPACE_S_0: + PUSH AF ;SAVE CHAR + LD A,E ;GET NUMBER OF CHARS IN [A] + CALL MKTMST ;GET A STRING THAT LONG + LD B,A ;COUNT OF CHARS BACK IN [B] + POP AF ;GET BACK CHAR TO PUT IN STRING + INC B ;TEST FOR NULL STRING + DEC B + JR Z,TOPOOL ;YES, ALL DONE + LD HL,(TMPSTR) ;GET DESC. POINTER +SPLP: + LD (HL),A ;SAVE CHAR + INC HL ;BUMP PTR + DJNZ SPLP ;DECR COUNT, KEEP STORING CHAR + JR TOPOOL ;PUT TEMP DESC WHEN DONE + + +; 'LEFT$' BASIC function +; +; THE FOLLOWING IS THE LEFT$($,#) FUNCTION. +; IT TAKES THE LEFTMOST # CHARS OF THE STR. +; IF # IS .GT. THAN THE LEN OF THE STR, IT RETURNS THE WHOLE STR. +; +; Routine at 26721 +__LEFT_S: + CALL LFRGNM ; Get number and ending ")" ;TEST THE PARAMETERS + XOR A ; Start at first byte in string ;LEFT NEVER CHANGES STRING POINTER + +; This entry point is used by the routine at __RIGHT_S. +RIGHT1: + EX (SP),HL ; Save code string,Get string ;SAVE TEXT POINTER + LD C,A ; Starting position in string ;OFFSET NOW IN [C] + + DEFB $3E ; "LD A,n" to Mask the next byte ;SKIP THE NEXT BYTE WITH "MVI A," + +; +; THIS IS PRINT USINGS ENTRY POINT INTO LEFT$ +; +__LEFT_S_1: + PUSH HL ; Save string block address (twice) ;THIS IS A DUMMY PUSH TO OFFSET THE EXTRA POP IN PUTNEW + +; Continuation of MID$ routine +MID1: + PUSH HL ; Save string block address ;SAVE DESC. FOR FRETMP + LD A,(HL) ; Get length of string ;GET STRING LENGTH + CP B ; Compare with number given ;ENTIRE STRING WANTED? + JR C,ALLFOL ; All following bytes required ;IF #CHARS ASKED FOR.GE.LENGTH,YES + LD A,B ; Get new length ;GET TRUNCATED LENGTH OF STRING + DEFB $11 ; "LD DE,nn" to skip "LD C,0" ;SKIP OVER MVI USING "LXI D," + +ALLFOL: + LD C,0 ; First byte of string ;MAKE OFFSET ZERO + PUSH BC ; Save position in string ;SAVE OFFSET ON STACK + CALL TESTR ; See if enough string space ;GET SPACE FOR NEW STRING + POP BC ; Get position in string ;GET BACK OFFSET + POP HL ; Restore string block address ;GET BACK DESC POINTER. + PUSH HL ; And re-save it ;BUT KEEP ON STACK + INC HL ;MOVE TO STRING POINTER FIELD + LD B,(HL) ; Get LSB of address ;GET POINTER LOW + INC HL ; + LD H,(HL) ; Get MSB of address ;POINTER HIGH + LD L,B ; HL = address of string ;GET LOW IN L + LD B,$00 ; BC = starting address ;GET READY TO ADD OFFSET TO POINTER + ADD HL,BC ; Point to that byte ;ADD IT + LD B,H ; BC = source string ;GET OFFSET POINTER IN [B,C] + LD C,L + CALL CRTMST ; Create a string entry ;SAVE INFO IN DSCTMP + LD L,A ; Length of new string ;GET# OF CHARS TO MOVE IN L + CALL TOSTRA ; Move string to string area ;MOVE THEM IN + POP DE ; Clear stack ;GET BACK DESC. POINTER + CALL GSTRDE ; Move to string pool if needed ;FREE IT UP. + JP TSTOPL ; Temporary string to pool ;PUT TEMP IN TEMP LIST + + +; 'RIGHT$' BASIC function +; Routine at 26769 +__RIGHT_S: + CALL LFRGNM ; Get number and ending ")" ;CHECK ARG + POP DE ; Get string length ;GET DESC. POINTER + PUSH DE ; And re-save ;SAVE BACK FOR LEFT + LD A,(DE) ; Get length ;GET PRESENT LEN OF STR + SUB B ; Move back N bytes ;SUBTRACT 2ND PARM + JR RIGHT1 ; Go and get sub-string ;CONTINUE WITH LEFT CODE + + +; 'MID$' BASIC function +; +; MID ($,#) RETURNS STR WITH CHARS FROM # POSITION +; ONWARD. IF # IS GT LEN($) THEN RETURN NULL STRING. +; MID ($,#,#) RETURNS STR WITH CHARS FROM # POSITION +; FOR #2 CHARS. IF #2 GOES PAST END OF STRING, RETURN +; AS MUCH AS POSSIBLE. +; +; Routine at 26778 +__MID_S: + EX DE,HL ; Get code string address ;PUT THE TEXT POINTER IN [H,L] + LD A,(HL) ; Get next byte "," or ")" ;GET THE FIRST CHARACTER + CALL MIDNUM ; Get number supplied ;GET OFFSET OFF STACK AND MAKE + INC B ; Is it character zero? + DEC B ;SEE IF EQUAL TO ZERO + JP Z,FC_ERR ; Yes - Error ;IT MUST NOT BE 0 SURE DOES NOT = 0. + PUSH BC ; Save starting position ;PUT OFFSET ON TO THE STACK + CALL MID_ARGSEP ; test ',' & ')' ;DUPLICATE OF CODE CONDITIONED OUT BELOW + POP AF ; Restore starting position ;GET OFFSET BACK IN A + EX (SP),HL ; Get string,save code string ;SAVE TEXT POINTER, GET DESC. + LD BC,MID1 ; Continuation of MID$ routine ;WHERE TO RETURN TO. + PUSH BC ; Save for return ;GOES ON STACK + DEC A ; Starting position-1 ;SUB ONE FROM OFFSET + CP (HL) ; Compare with length ;POINTER PAST END OF STR? + LD B,$00 ; Zero bytes length ;ASSUME NULL LENGTH STR + RET NC ; Null string if start past end ;YES, JUST USE NULL STR + LD C,A ; Save starting position-1 ;SAVE OFFSET OF CHARACTER POINTER + LD A,(HL) ; Get length of string ;GET PRESENT LEN OF STR + SUB C ; Subtract start ;SUBTRACT INDEX (2ND ARG) + CP E ; Enough string for it? ;IS IT TRUNCATION + LD B,A ; Save maximum length available ;GET CALCED LENGTH IN B + RET C ; Truncate string if needed ;IF NOT USE PARTIAL STR + LD B,E ; Set specified length ;USE TRUNCATED LENGTH + RET ; Go and create string ;RETURN TO LEFT2 + + +; 'VAL' BASIC function +; +; THE VAL FUNCTION TAKES A STRING AND TURN IT INTO +; A NUMBER BY INTERPRETING THE ASCII DIGITS. ETC.. +; EXCEPT FOR THE PROBLEM THAT A TERMINATOR MUST BE SUPPLIED +; BY REPLACING THE CHARACTER BEYOND THE STRING, VAL +; IS MERELY A CALL TO FLOATING INPUT (FIN). +; +; Routine at 26811 +__VAL: + CALL GETLEN ; Get length of string ;DO SETUP, SET RESULT=REAL + JP Z,PASSA ; Result zero ;MAKE SURE TYPE SET UP OK IN EXTENDED + LD E,A ; Save length ;GET LENGTH OF STR + INC HL ;TO HANDLE THE FACT THE IF + LD A,(HL) ; Get LSB of address + INC HL + LD H,(HL) ; Get MSB of address ;TWO STRINGS "1" AND "2" + LD L,A ; HL = String address ;ARE STORED NEXT TO EACH OTHER + PUSH HL ; Save string address ;AND FIN IS CALLED POINTING TO + ADD HL,DE ;THE FIRST TWELVE WILL BE RETURNED + LD B,(HL) ; Get end of string+1 byte + LD (VLZADR),HL + LD A,B + LD (VLZDAT),A + LD (HL),D ; Zero it to terminate ;THE IDEA IS TO STORE 0 IN THE + ;STRING BEYOND THE ONE VAL + ;IS BEING CALLED ON + EX (SP),HL ; Save string end,get start + PUSH BC ; Save end+1 byte ;THE FIRST CHARACTER OF THE NEXT STRING + DEC HL ;***CALL CHRGET TO MAKE SURE + RST CHRGTB ;VAL(" -3")=-3 + CALL FIN_DBL ; Convert ASCII string to FP ;IN EXTENDED, GET ALL THE PRECISION WE CAN + LD HL,$0000 + LD (VLZADR),HL + POP BC ; Restore end+1 byte ;GET THE MODIFIED CHARACTER OF THE NEXT STRING INTO [B] + POP HL ; Restore end+1 address ;GET THE POINTER TO THE MODIFIED CHARACTER + LD (HL),B ; Put back original byte ;RESTORE THE CHARACTER + + ;IF STRING IS HIGHEST IN STRING SPACE + ;WE ARE MODIFYING [MEMSIZ] AND + ;THIS IS WHY [MEMSIZ] CAN'T BE USED TO STORE + ;STRING DATA BECAUSE WHAT IF THE + ;USER TOOK VAL OFF THAT HIGH STRING + RET + + +; Routine at 26851 +; +; Get number, check for ending ')' +; Used by the routines at __LEFT_S and __RIGHT_S. +; USED BY RIGHT$ AND LEFT$ FOR PARAMETER CHECKING AND SETUP +LFRGNM: + EX DE,HL ; Code string address to HL ;PUT THE TEXT POINTER IN [H,L] + RST SYNCHR ; Make sure ")" follows ;PARAM LIST SHOULD END + DEFB ')' + +; Get numeric argument for MID$ +; USED BY MID$ FOR PARAMETER CHECKING AND SETUP +MIDNUM: + POP BC ; Get return address ;GET RETURN ADDR OFF STACK + POP DE ; Get number supplied ;GET LENGTH OF ARG OFF STACK + PUSH BC ; Re-save return address ;SAVE RETURN ADDR BACK ON + LD B,E ; Number to B ;SAVE INIT LENGTH + RET + + +; INSTR +; +; THIS IS THE INSTR FUCNTION. IT TAKES ONE OF TWO +; FORMS: INSTR(I%,S1$,S2$) OR INSTR(S1$,S2$) +; IN THE FIRST FORM THE STRING S1$ IS SEARCHED FOR THE +; CHARACTER S2$ STARTING AT CHARACTER POSITION I%. +; THE SECOND FORM IS IDENTICAL, EXCEPT THAT THE SEARCH +; STARTS AT POSITION 1. INSTR RETURNS THE CHARACTER +; POSITION OF THE FIRST OCCURANCE OF S2$ IN S1$. +; IF S1$ IS NULL, 0 IS RETURNED. IF S2$ IS NULL, THEN +; I% IS RETURNED, UNLESS I% .GT. LEN(S1$) IN WHICH +; CASE 0 IS RETURNED. +; +; Routine at 26859 +; +; Used by the routine at OPRND. +FN_INSTR: + RST CHRGTB ;EAT FIRST CHAR + CALL OPNPAR ;EVALUATE FIRST ARG + RST GETYPR ;SET ZERO IF ARG A STRING. + LD A,$01 ;IF SO, ASSUME, SEARCH STARTS AT FIRST CHAR + PUSH AF ;SAVE OFFSET IN CASE STRING + JR Z,FN_INSTR_0 ;WAS A STRING + POP AF ;GET RID OF SAVED OFFSET + CALL CONINT ;FORCE ARG1 (I%) TO BE INTEGER + OR A ;DONT ALLOW ZERO OFFSET + JP Z,FC_ERR ;KILL HIM. + PUSH AF ;SAVE FOR LATER + RST SYNCHR + DEFB ',' ;EAT THE COMMA + CALL EVAL ;EAT FIRST STRING ARG + CALL TSTSTR ;BLOW UP IF NOT STRING +FN_INSTR_0: + RST SYNCHR + DEFB ',' ;EAT COMMA AFTER ARG + PUSH HL ;SAVE THE TEXT POINTER + LD HL,(FACLOW) ;GET DESCRIPTOR POINTER + EX (SP),HL ;PUT ON STACK & GET BACK TEXT PNT. + CALL EVAL ;GET LAST ARG + RST SYNCHR + DEFB ')' ;EAT RIGHT PAREN + PUSH HL ;SAVE TEXT POINTER + CALL GETSTR ;FREE UP TEMP & CHECK STRING + EX DE,HL ;SAVE 2ND DESC. POINTER IN [D,E] + POP BC ;GET TEXT POINTER IN B + POP HL ;DESC. POINTER FOR S1$ + POP AF ;OFFSET + PUSH BC ;PUT TEXT POINTER ON BOTTOM + LD BC,POPHLRT ;PUT ADDRESS OF POP H, RET ON + PUSH BC ;PUSH IT + LD BC,PASSA ;NOW ADDRESS OF [A] RETURNER + PUSH BC ;ONTO STACK + PUSH AF ;SAVE OFFSET BACK + PUSH DE ;SAVE DESC. OF S2 + CALL GSTRHL ;FREE UP S1 DESC. + POP DE ;RESTORE DESC. S2 + POP AF ;GET BACK OFFSET + LD B,A ;SAVE UNMODIFIED OFFSET + DEC A ;MAKE OFFSET OK + LD C,A ;SAVE IN C + CP (HL) ;IS IT BEYOND LENGTH OF S1? + LD A,$00 ;IF SO, RETURN ZERO. (ERROR) + RET NC + LD A,(DE) ;GET LENGTH OF S2$ + OR A ;NULL?? + LD A,B ;GET OFFSET BACK + RET Z ;ALL IF S2 NULL, RETURN OFFSET + LD A,(HL) ;GET LENGTH OF S1$ + INC HL ;BUMP POINTER + LD B,(HL) ;GET 1ST BYTE OF ADDRESS + INC HL ;BUMP POINTER + LD H,(HL) ;GET 2ND BYTE + LD L,B ;GET 1ST BYTE SET UP + LD B,$00 ;GET READY FOR DAD + ADD HL,BC ;NOW INDEXING INTO STRING + SUB C ;MAKE LENGTH OF STRING S1$ RIGHT + LD B,A ;SAVE LENGTH OF 1ST STRING IN [B] + PUSH BC ;SAVE COUNTER, OFFSET + PUSH DE ;PUT 2ND DESC (S2$) ON STACK + EX (SP),HL ;GET 2ND DESC. POINTER + LD C,(HL) ;SET UP LENGTH + INC HL ;BUMP POINTER + LD E,(HL) ;GET FIRST BYTE OF ADDRESS + INC HL ;BUMP POINTER AGAIN + LD D,(HL) ;GET 2ND BYTE + POP HL ;RESTORE POINTER FOR 1ST STRING +CHK1: + PUSH HL ;SAVE POSITION IN SEARCH STRING + PUSH DE ;SAVE START OF SUBSTRING + PUSH BC ;SAVE WHERE WE STARTED SEARCH +CHK: + LD A,(DE) ;GET CHAR FROM SUBSTRING + CP (HL) ; = CHAR POINTER TO BY [H,L] + JR NZ,OHWELL ;NO + INC DE ;BUMP COMPARE POINTER + DEC C ;END OF SEARCH STRING? + JR Z,GOTSTR ;WE FOUND IT! + INC HL ;BUMP POINTER INTO STRING BEING SEARCHED + DJNZ CHK ;DECREMENT LENGTH OF SEARCH STRING + POP DE ;END OF STRING, YOU LOSE + POP DE ;GET RID OF POINTERS + POP BC ;GET RID OF GARB +RETZER: + POP DE ;LIKE SO + XOR A ;GO TO SNGFLT. + RET ;RETURN + +GOTSTR: + POP HL + POP DE ;GET RID OF GARB + POP DE ;GET RID OF EXCESS STACK + POP BC ;GET COUNTER, OFFSET + LD A,B ;GET ORIGINAL SOURCE COUNTER + SUB H ;SUBTRACT FINAL COUNTER + ADD A,C ;ADD ORIGINAL OFFSET (N1%) + INC A ;MAKE OFFSET OF ZERO = POSIT 1 + RET ;DONE + +OHWELL: + POP BC + POP DE ;POINT TO START OF SUBSTRING + POP HL ;GET BACK WHERE WE STARTED TO COMPARE + INC HL ;AND POINT TO NEXT CHAR + DJNZ CHK1 ;DECR. # CHAR LEFT IN SOURCE STRING, TRY SEARCHING SOME MORE + JR RETZER ;END OF STRING, RETURN 0 + + +; STRING FUNCTIONS - LEFT HAND SIDE MID$ +; Routine at 26990 +; +; Used by the routine at NOT_KEYWORD. +LHSMID: + RST SYNCHR + DEFB '(' ;MUST HAVE ( + CALL GETVAR ;GET A STRING VAR + CALL TSTSTR ;MAKE SURE IT WAS A STRING + PUSH HL ;SAVE TEXT POINTER + PUSH DE ;SAVE DESC. POINTER + EX DE,HL ;PUT DESC. POINTER IN [H,L] + INC HL ;MOVE TO ADDRESS FIELD + LD E,(HL) ;GET ADDRESS OF LHS IN [D,E] + INC HL ;BUMP DESC. POINTER + LD D,(HL) ;PICK UP HIGH BYTE OF ADDRESS + LD HL,(STREND) ;SEE IF LHS STRING IS IN STRING SPACE + RST DCOMPR ;BY COMPARING IT WITH STKTOP + JR C,NCPMID ;IF ALREADY IN STRING SPACE DONT COPY. + + ;9/23/79 Allow MID$ on field strings + LD HL,(TXTTAB) + RST DCOMPR ;Is this a fielded string? + JR NC,NCPMID ;Yes, Don't copy!! + POP HL ;GET BACK DESC. POINTER + PUSH HL ;SAVE BACK ON STACK + CALL STRCPY ;COPY THE STRING LITERAL INTO STRING SPACE + POP HL ;GET BACK DESC. POINTER + PUSH HL ;BACK ON STACK AGAIN + CALL VMOVE ;MOVE NEW DESC. INTO OLD SLOT. +NCPMID: + POP HL ;GET DESC. POINTER + EX (SP),HL ;GET TEXT POINTER TO [H,L] DESC. TO STACK + RST SYNCHR + DEFB ',' ;MUST HAVE COMMA + CALL GETINT ;GET ARG#2 (OFFSET INTO STRING) + OR A ;MAKE SURE NOT ZERO + JP Z,FC_ERR ;BLOW HIM UP IF ZERO + PUSH AF ;SAVE ARG#2 ON STACK + LD A,(HL) ;RESTORE CURRENT CHAR + CALL MID_ARGSEP ;USE MID$ CODE TO EVALUATE POSIBLE THIRD ARG. + PUSH DE ;SAVE THIRD ARG ([E]) ON STACK + CALL FRMEQL ;MUST HAVE = SIGN, EVALUATE RHS OF THING. + PUSH HL ;SAVE TEXT POINTER. + CALL GETSTR ;FREE UP TEMP RHS IF ANY. + EX DE,HL ;PUT RHS DESC. POINTER IN [D,E] + POP HL ;TEXT POINTER TO [H,L] + POP BC ;ARG #3 TO C. + POP AF ;ARG #2 TO A. + LD B,A ;AND [B] + EX (SP),HL ;GET LHS DESC. POINTER TO [H,L] <> TEXT POINTER TO STACK + PUSH HL ;SAVE TEXT POINTER + LD HL,POPHLRT ;GET ADDR TO RETURN TO + EX (SP),HL ;SAVE ON STACK & GET BACK TXT PTR. + LD A,C ;GET ARG #3 + OR A ;SET CC'S + RET Z ;IF ZERO, DO NOTHING + LD A,(HL) ;GET LENGTH OF LHS + SUB B ;SEE HOW MANY CHARS IN EMAINDER OF STRING + JP C,FC_ERR ;CANT ASSIGN PAST LEN(LHS)! + INC A ;MAKE PROPER COUNT + CP C ;SEE IF # OF CHARS IS .GT. THIRD ARG + JR C,BIGLEN ;IF SO, DONT TRUNCATE + LD A,C ;TRUNCATE BY USING 3RD ARG. +BIGLEN: + LD C,B ;GET OFFSET OF STRING IN [C] + DEC C ;MAKE PROPER OFFSET + LD B,$00 ;SET UP [B,C] FOR LATER DAD B. + PUSH DE ;SAVE [D,E] + INC HL ;POINTER TO ADDRESS FIELD. + LD E,(HL) ;GET LOW BYTE IN [E] + INC HL ;BUMP POINTER + LD H,(HL) ;GET HIGH BYTE IN [H] + LD L,E ;NOW COPY LOW BYTE BACK TO [L] + ADD HL,BC ;ADD OFFSET + LD B,A ;SET COUNT OF LHS IN [B] + POP DE ;RESTORE [D,E] + EX DE,HL ;MOVE RHS. DESC. POINTER TO [H,L] + LD C,(HL) ;GET LEN(RHS) IN [C] + INC HL ;MOVE POINTER + LD A,(HL) ;GET LOW BYTE OF ADDRESS IN [A] + INC HL ;BUMP POINTER. + LD H,(HL) ;GET HIGH BYTE OF ADDRESS IN [H] + LD L,A ;COPY LOW BYTE TO [L] + EX DE,HL ;ADDRESS OF RHS NOW IN [D,E] + LD A,C ;IS RHS NULL? + OR A ;TEST + RET Z ;THEN ALL DONE. + +; NOW ALL SET UP FOR ASSIGNMENT. +; [H,L] = LHS POINTER +; [D,E] = RHS POINTER +; C = LEN(RHS) +; B = LEN(LHS) + +MID_LP: + LD A,(DE) ;GET BYTE FROM RHS. + LD (HL),A ;STORE IN LHS + INC DE ;BUMP RHS POINTER + INC HL ;BUMP LHS POINTER. + DEC C ;BUMP DOWN COUNT OF RHS. + RET Z ;IF ZERO, ALL DONE. + DJNZ MID_LP ;IF LHS ENDED, ALSO DONE. IF NOT DONE, MORE COPYING. + RET ;BACK TO NEWSTT + + +; Routine at 27108 +; +; Used by the routines at __MID_S and LHSMID. +; test ',' & ')' +MID_ARGSEP: + LD E,255 ;IF TWO ARG GUY, TRUNCATE. + CP ')' + JR Z,MID_ARGSEP_0 ;[E] SAYS USE ALL CHARS + ;IF ONE ARGUMENT THIS IS CORRECT + RST SYNCHR + DEFB ',' ;COMMA? MUST DELINEATE 3RD ARG. + CALL GETINT ;GET ARGUMENT IN [E] +MID_ARGSEP_0: + RST SYNCHR + DEFB ')' ;MUST BE FOLLOWED BY ) + RET ;ALL DONE. + +; Routine at 27122 +__FRE: + LD HL,(STREND) + EX DE,HL + LD HL,$0000 + ADD HL,SP + RST GETYPR + JP NZ,GIVDBL + CALL GSTRCU ;FREE UP ARGUMENT AND SETUP TO GIVE FREE STRING SPACE + CALL GARBGE ;DO GARBAGE COLLECTION + LD DE,(STKTOP) + LD HL,(FRETOP) ;TOP OF FREE AREA + JP GIVDBL ;RETURN [H,L]-[D,E] + +; Routine at 27150 +; +; Used by the routines at __OPEN, _RUN_FILE, __SAVE and __BSAVE. +; AKA NAMSCN (name scan) - evaluate filespecification +NAMSCN: + CALL EVAL +;NAMSC1: + PUSH HL + CALL GETSTR + LD A,(HL) + OR A ; stringsize zero ? + JR Z,NAMSCN_2 ; yep, bad filename error + INC HL + LD E,(HL) + INC HL + LD H,(HL) + LD L,E ; pointer to string + LD E,A ; size of string + + CALL PAR_DNAME ; Parse Device Name + PUSH AF + LD BC,FILNAM + LD D,11 + INC E +; This entry point is used by the routine at FNAME_6. +NAMSCN_0: + DEC E ; end of filespecification string ? + JR Z,L6A61 ; yep, fill remaining FILNAME with spaces + LD A,(HL) + CP ' ' ; control characters ? + JR C,NAMSCN_2 ; yep, bad filename error + CP '.' ; filename/extension seperator ? + JR Z,FNAME_7 ; yep, handle extension + LD (BC),A + INC BC + INC HL + DEC D ; FILNAM full ? + JR NZ,NAMSCN_0 ; nope, next +; This entry point is used by the routine at L6A61. +NAMSCN_1: + POP AF + PUSH AF + LD D,A ; devicecode + LD A,(FILNAM) + INC A ; first character FILNAME charactercode 255 ? + JR Z,NAMSCN_2 ; yep, bad filename error (because this is internally used as runflag) + POP AF + POP HL + RET + +; This entry point is used by the routine at FNAME_7. +NAMSCN_2: + JP NM_ERR ; Err $38 - 'Bad file name' + +; Routine at 27210 +; +; Used by the routine at FNAME_7. +FNAME_6: + INC HL + JR NAMSCN_0 + +; Routine at 27213 +; +; Used by the routine at NAMSCN. +FNAME_7: + LD A,D + CP 11 + JP Z,NAMSCN_2 + CP 3 + JP C,NAMSCN_2 + JR Z,FNAME_6 + LD A,' ' + LD (BC),A + INC BC + DEC D + JR FNAME_7 + +; Routine at 27233 +; +; Used by the routine at NAMSCN. +L6A61: + LD A,' ' + LD (BC),A + INC BC + DEC D + JR NZ,L6A61 + JR NAMSCN_1 + +; +; CONVERT ARGUMENT TO FILE NUMBER AND SET [B,C] TO POINT TO FILE DATA BLOCK +; +; AT THIS ENTRY POINT THE FAC HAS THE FILE NUMBER IN IT ALREADY +; +; a.k.a. GETFLP +; Routine at 27242 +; +; Used by the routines at __LOC, __LOF, __EOF and __FPOS. +FILFRM: + CALL CONINT ;GET THE FILE NUMBER INTO [A] +; +; AT THIS POINT IT IS ASSUMED THE FILE NUMBER IS IN [A] +; [D] IS SET TO ZERO. [B,C] IS SAVED. +; [H,L] IS SET TO POINT AT THE FILE DATA BLOCK FOR FILE [E] +; [A] GIVE THE MODE OF THE FILE AND ZERO IS SET, IF THE FILE IS MODE ZERO (NOT OPEN). +; +; This entry point is used by the routines at OPRND, FILSCN and __OPEN. +; a.k.a. VARPTR_A, GETPTR +FILIDX: + LD L,A ;GET FILE NUMBER INTO [L] + LD A,(MAXFIL) ;IS THIS FILE # LEGAL? + CP L + JP C,BN_ERR ;IF NOT, "BAD FILE NUMBER" (Err $34 - 'Bad file number') + LD H,$00 ;SETUP OFFSET TO GET POINTER TO FILE DATA BLOCK + ADD HL,HL + EX DE,HL + LD HL,(FILTAB) ;POINT AT POINTER TABLE + ADD HL,DE ;ADD ON OFFSET + LD A,(HL) ;PICK UP POINTER IN [H,L] + INC HL + LD H,(HL) + LD L,A + + LD A,(NLONLY) ; Are we loading a program ? + INC A + RET Z + + LD A,(HL) ;GET MODE OF FILE INTO [A] + OR A ;SET ZERO IF FILE NOT OPEN + RET Z + + PUSH HL + LD DE,$0004 ;(DATOFC) POINT TO DATA BLOCK + ADD HL,DE + LD A,(HL) ; A = FILE MODE + CP $09 + JR NC,FILIDX_1 +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HGETP ; Hook 1 for Locate FCB +ENDIF + JP IE_ERR ; Err $33 - "Internal Error" + +FILIDX_1: + POP HL + LD A,(HL) + OR A + SCF + RET + +; +; AT THIS ENTRY POINT [H,L] IS ASSUMED TO BE THE TEXT POINTER AND +; A FILE NUMBER IS SCANNED +; +; Routine at 27294 +; +; Used by the routines at GET and FN_INPUT. +FILSCN: + DEC HL + RST CHRGTB + CP '#' ;MAKE NUMBER SIGN OPTIONAL + CALL Z,__CHRGTB ;BY SKIPPING IT IF THERE + CALL GETINT ;READ THE FILE NUMBER INTO THE FAC + EX (SP),HL + PUSH HL + +; a.k.a. SELECT. This entry point is used by the routines at _RUN_FILE and FILINP. +SETFIL: + CALL FILIDX + JP Z,CF_ERR ; Err $3B - "File not OPEN" + LD (PTRFIL),HL ; Redirect I/O +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HSETF ; Hook 2 for Locate FCB +ENDIF + RET + +; Routine at 27319 +__OPEN: + LD BC,FINPRT + PUSH BC + CALL NAMSCN + LD A,(HL) + CP TK_FOR ; 'FOR' + LD E,$04 + JR NZ,__OPEN_2 + RST CHRGTB ; Gets next character (or token) from BASIC text. + CP TK_INPUT ; 'INPUT' + LD E,$01 + JR Z,__OPEN_INPUT + + CP TK_OUT ; 'OUT..PUT' + JR Z,__OPEN_OUTPUT + + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB 'A' + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB 'P' + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB 'P' + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB TK_END + LD E,$08 ; 'APPEND' + JR __OPEN_2 + +__OPEN_OUTPUT: + RST CHRGTB ; Gets next character (or token) from BASIC text. + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB TK_PUT ; "OUTPUT" :S + LD E,$02 + JR __OPEN_2 +__OPEN_INPUT: + RST CHRGTB ; Gets next character (or token) from BASIC text. +__OPEN_2: + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB 'A' + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB 'S' ; 'AS' + PUSH DE + LD A,(HL) + CP '#' + CALL Z,__CHRGTB ; Gets next character (or token) from BASIC text. + CALL GETINT ; Get integer 0-255 + OR A + JP Z,BN_ERR ; Err $34 - 'Bad file number' +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HNOFO ; Hook for "OPEN": not found event +ENDIF + + DEFB $1E ;LD E,N +NULOPN: + PUSH DE ; open a "NULL" file + DEC HL + LD E,A ;SAVE FILE NUMBER IN [E] + RST CHRGTB ; Gets next character (or token) from BASIC text. + JP NZ,SN_ERR + EX (SP),HL + LD A,E ;GET FILE NUMBER + PUSH AF + PUSH HL + CALL FILIDX + JP NZ,AO_ERR ; Err $36 - "File already open" + POP DE + LD A,D + CP $09 +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HNULO ; Hook for "OPEN" +ENDIF + JP C,IE_ERR ; Err $33 - "Internal Error" + PUSH HL + LD BC,$0004 + ADD HL,BC + LD (HL),D + LD A,$00 + POP HL + CALL GET_DEVICE + POP AF + POP HL + RET + +; Data block at 27428 + ; --- START PROC CLSFIL --- +CLSFIL: + PUSH HL + OR A + JR NZ,NTFL0 + LD A,(NLONLY) ; <>0 when loading program + AND $01 + JP NZ,POPHLRT2 ; POP HL / RET + +; NTFL0 - "NoT FiLe number 0" +NTFL0: + CALL FILIDX + JR Z,NOCLSB_0 ; CLOSE_1 + LD (PTRFIL),HL + PUSH HL + JR C,NOCLSB ; CLOSE_0 +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HNTFL ; Hook for Close I/O buffer 0 event +ENDIF + JP IE_ERR ; Err $33 - "Internal Error" + + ; CLOSE_0 +NOCLSB: + LD A,$02 + CALL GET_DEVICE + CALL CLRBUF + POP HL + ; CLOSE_1 +NOCLSB_0: + PUSH HL + LD DE,$0007 + ADD HL,DE + LD (HL),A + LD H,A + LD L,A + LD (PTRFIL),HL ; Redirect I/O + POP HL + ADD A,(HL) + LD (HL),$00 + POP HL + RET + +; Routine at 27483 +; +; load and RUN a file when text is addedd to "RUN" +; +; Used by the routine at __RUN. +_RUN_FILE: + SCF + defb $11 ; LD DE,NN + +; Routine at 19824 +__LOAD: + defb $f6 ; OR $AF + +; Routine at 19825 +__MERGE: + XOR A ;FLAG ZERO FOR "LOAD" + PUSH AF ;SAVE "RUN"/"LOAD" FLAG + CALL NAMSCN +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HMERG ; Hook for "MERGE/LOAD" +ENDIF + POP AF + PUSH AF ;SEE IF NO RUN OPTION + JR Z,_LOAD_0 ;NO, JUST LOAD + LD A,(HL) + SUB ',' ;GOTTA HAVE A COMMA + OR A + JR NZ,_LOAD_0 ;NO, JUST LOAD + RST CHRGTB ; Gets next character (or token) from BASIC text. + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB 'R' ;ONLY OPTION IS RUN + POP AF ;GET RID OF "RUN"/"LOAD" FLAG + SCF ; Set the 'RUN' flag + PUSH AF +_LOAD_0: + PUSH AF + XOR A + LD E,$01 + CALL NULOPN ; OPEN a "NULL file" + LD HL,(PTRFIL) + LD BC,$0007 + ADD HL,BC + POP AF + SBC A,A + AND $80 + OR $01 + LD (NLONLY),A + POP AF + PUSH AF + SBC A,A + LD (FILNAM),A + LD A,(HL) + OR A + JP M,L6BD4 ; handle "bad file name" for MERGE/LOAD + + POP AF + CALL NZ,CLRPTR + XOR A + CALL SETFIL + JP PROMPT + +; Routine at 27555 +__SAVE: + CALL NAMSCN +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HSAVE ; Hook 1 for "SAVE" +ENDIF + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + LD E,$80 + SCF + JR Z,__SAVE_0 + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB 'A' ; Save in ASCII mode ? + OR A + LD E,$02 +__SAVE_0: + PUSH AF + LD A,D + CP $09 + JR C,__SAVE_1 + LD E,$02 + POP AF + XOR A + PUSH AF +__SAVE_1: + XOR A + CALL NULOPN ; OPEN a "NULL file" + POP AF + JR C,__SAVE_2 + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + JP __LIST + +__SAVE_2: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HBINS ; Hook 2 for "SAVE" +ENDIF + JP NM_ERR ; Err $38 - 'Bad file name' + +; Routine at 27604 +; +; Used by the routine at _LOAD. +; handle "bad file name" for MERGE/LOAD +L6BD4: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HBINL ; Hook for "MERGE/LOAD" +ENDIF + JP NM_ERR ; Err $38 - 'Bad file name' + +; Routine at 27610 +; This function is never called by other rountines in the same ROM bank +; It is most probably used by MSXDOS. On the Spectravideo SVI it is located at $6463. +GETDEV: + PUSH HL + PUSH DE + LD HL,(PTRFIL) + LD DE,$0004 + ADD HL,DE + LD A,(HL) + POP DE + POP HL + RET + +; Routine at 27623 +; +; Used by the routines at RETRTS and CLSALL. +_CLOSE: + JR NZ,RETRTS_0 ;NOT END OF STATEMENT, SO SCAN ARGUMENTS + PUSH HL ;SAVE THE TEXT POINTER +; This entry point is used by the routine at RETALL. +__CLOSE_0: + PUSH BC ;SAVE ROUTINE ADDRESS + PUSH AF ;SAVE CURRENT VALUE + LD DE,RETALL ;RETURN ADDRESS + PUSH DE ;SAVE IT TO COME BACK WITH + PUSH BC ;DISPATCH TO SERVICE ROUTINE + OR A + RET + +; Routine at 27635 +RETALL: + POP AF ;GET BACK OLD ARGUMENT + POP BC ;GET BACK SERVICE ROUTINE ADDRESS + DEC A ;DECREMENT ARGUMENT + JP P,__CLOSE_0 ;LOOP ON MORE VALUES + POP HL ;GET BACK THE TEXT POINTER + RET + +; Routine at 27643 +RETRTS: + POP BC ;GET BACK SERVICE ROUTINE ADDRESS + POP HL ;GET BACK THE TEXT POINTER + LD A,(HL) ;SEE IF MORE ARGUMENTS + CP ',' ;DELIMITED BY COMMA + RET NZ + RST CHRGTB ;READ FIRST CHARACTER OF FORMULA +; This entry point is used by the routine at _CLOSE. +RETRTS_0: + PUSH BC ;SAVE THE SERVICE ROUTINE ADDRESS + LD A,(HL) ;GET POSSBLE "#" + CP '#' ;IS IT + CALL Z,__CHRGTB ;SKIP IT, ITS OPTIONAL + CALL GETINT ;READ THE ARGUMENT + EX (SP),HL ;SAVE THE TEXT POINTER ON THE STACK <> AND SET [H,L]=SERVICE ADDRESS + PUSH HL ;SAVE THE SERVICE ADDRESS + LD DE,RETRTS ;PUT A RETURN ADDRESS ON THE STACK + PUSH DE + SCF + JP (HL) ;DISPATCH TO DO THE FUNCTION + +__CLOSE: + LD BC,CLSFIL ;SERVICE ROUTINE ADDRESS + LD A,(MAXFIL) ;HIGHEST POSSIBLE ARGUMENT, WHICH MEANS DO ALL POSSIBLE + JR _CLOSE + +; Routine at 27676 +; +; Used by the routines at L628E, __END and __MAX. +; Close all files +CLSALL: + LD A,(NLONLY) + OR A + RET M + LD BC,CLSFIL + XOR A + LD A,(MAXFIL) + JR _CLOSE + +; Routine at 27690 +__LFILES: + LD A,$01 + LD (PRTFLG),A +__FILES: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HFILE ; Hook for "FILES" +ENDIF + JP FC_ERR + +; Routine at 27701 +; +; Used by the routine at L7756. +GET: + PUSH AF + CALL FILSCN + JR C,GET_0 +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HDGET ; Hook for "GET/PUT" +ENDIF + JP NM_ERR ; Err $38 - 'Bad file name' + +GET_0: + POP DE + POP BC + LD A,$04 + JP GET_DEVICE + +; Data block at 27720 +FILO: + PUSH HL + PUSH DE + PUSH BC + PUSH AF + CALL INDSKB ; GET A CHARACTER FROM A SEQUENTIAL FILE IN [PTRFIL] + JR NC,L6C57 +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HFILO ; Hook for "Sequential Output" event +ENDIF + JP NM_ERR ; Err $38 - 'Bad file name' + +L6C57: + POP AF + PUSH AF + LD C,A + LD A,$06 + CALL GET_DEVICE + JP POPALL + +; +; GET A CHARACTER FROM A SEQUENTIAL FILE IN [PTRFIL] +; ALL REGISTERS EXCEPT [D,E] SMASHED +; Used also to Check stream buffer status before I/O operations +; +; 'C' set if EOF read +; +INDSKB: + PUSH DE + LD HL,(PTRFIL) + EX DE,HL + LD HL,$0004 + ADD HL,DE + LD A,(HL) + EX DE,HL + POP DE + CP $09 + RET + + +; Routine at 27761 +; a.k.a. INDSKC + ; --- START PROC RDBYT --- + ; Read byte, C flag is set if EOF +RDBYT: + PUSH HL + PUSH DE + PUSH BC + CALL INDSKB ; GET A CHARACTER FROM A SEQUENTIAL FILE IN [PTRFIL] + JR NC,RDBYT_0 ; JP IF NOT EOF +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HINDS ; Hook for "Sequential Input" exception +ENDIF + JP IE_ERR ; Err $33 - "Internal Error" + + +RDBYT_0: + LD A,$08 + CALL GET_DEVICE + JP POPALL_0 + +; Routine at 27783 +; +; Used by the routine at OPRND. +FN_INPUT: + RST CHRGTB ; Gets next character (or token) from BASIC text. + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB '$' ;STRING FUNCTION + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB '(' + PUSH HL + LD HL,(PTRFIL) + PUSH HL + LD HL,$0000 + LD (PTRFIL),HL + POP HL + EX (SP),HL + CALL GETINT ;Get # of bytes to read + PUSH DE ;Save # of bytes to read + LD A,(HL) + CP ',' ;Read from disk file? + JR NZ,REDTTY ;No, from user's terminal + RST CHRGTB + CALL FILSCN ; Check we have the '#' channel specifier and put the associated file buffer in BC + CP $01 + JP Z,FN_INPUT_0 + CP $04 + JP NZ,EF_ERR ; Err $37 - "Input past END" (EOF) +FN_INPUT_0: + POP HL ;SET UP PTRFIL + XOR A ;SET ZERO FOR FLAG + LD A,(HL) +REDTTY: + PUSH AF ;NON ZERO SET IF TERMINAL I/O + RST SYNCHR ; Check syntax: next byte holds the byte to be found\n + DEFB ')' ;Must have paren + POP AF ;Get flag off stack + EX (SP),HL ;Save text ptr, [L]=# to read + PUSH AF ;Save flag + LD A,L + OR A ;Read no characters? + JP Z,FC_ERR ;Yes, error + PUSH HL ;Save # + CALL MKTMST ;Get space for string + EX DE,HL + POP BC ;[C] = # to read +FIXLOP: + POP AF + PUSH AF ;NON-ZERO set if should read from TTY + JR Z,DSKCHR ;Read from disk file + CALL CHGET ;GET CHAR IF ONE + PUSH AF ;WAS ONE + CALL CKCNTC ;Check if Control-C + POP AF +PUTCHR: + LD (HL),A ;Put char into string + INC HL + DEC C ;Read enough yet? + JR NZ,FIXLOP ;No, read more + POP AF ;Get flag off stack + POP BC + POP HL +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HRSLF ; Hook for "INPUT$" +ENDIF + LD (PTRFIL),HL + PUSH BC + JP TSTOPL ;STOP PROGRAM + +DSKCHR: + CALL RDBYT + JP C,EF_ERR ; Err $37 - "Input past END" (EOF) + JR PUTCHR + +; Routine at 27882 +CLRBUF: + CALL GETBUF + PUSH HL + LD B,$00 + CALL DOCLR +POPHLRT2: + POP HL + RET + +; Routine at 27893 +; +; Used by the routine at CLRBUF. +DOCLR: + XOR A +DOCLR_0: + LD (HL),A + INC HL + DJNZ DOCLR_0 + RET + +; Routine at 27899 +; +; Used by the routine at CLRBUF. +GETBUF: + LD HL,(PTRFIL) + LD DE,$0009 + ADD HL,DE + RET + +; Routine at 27907 +__LOC: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HSAVD ; Init Hook for LOC, LOF, EOF, FPOS +ENDIF + CALL FILFRM + JR Z,DERFNO + LD A,$0A + JR C,__EOF_1 +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HLOC ; Hook for LOC +ENDIF + JR DERIER ; Internal error + +; Routine at 27924 +__LOF: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HSAVD ; Init Hook for LOC, LOF, EOF, FPOS +ENDIF + CALL FILFRM + JR Z,DERFNO + LD A,$0C + JR C,__EOF_1 +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HLOF ; Hook for LOF +ENDIF + JR DERIER ; Internal error + +; Routine at 27941 +__EOF: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HSAVD ; Init Hook for LOC, LOF, EOF, FPOS +ENDIF + CALL FILFRM + +; This entry point is used by the routines at __LOC and __LOF. +; Possible "File Not Open" or "Bad file mode" condition +; On the Spectravideo SVI it was called "DERFND" +DERFNO: + JP Z,CF_ERR ; Err $3B - "File not OPEN" + LD A,$0E ; ? LINCON ?? +; This entry point is used by the routines at __LOC, __LOF and __FPOS. +__EOF_1: + JP C,GET_DEVICE +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HEOF ; Hook for EOF +ENDIF +; This entry point is used by the routines at __LOC, __LOF and __FPOS. +DERIER: + JP IE_ERR ; Err $33 - "Internal Error" + +; Routine at 27961 +__FPOS: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HSAVD ; Init Hook for LOC, LOF, EOF, FPOS +ENDIF + CALL FILFRM + LD A,$10 + JR C,__EOF_1 +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HFPOS ; Hook for FPOS +ENDIF + JR DERIER ; Internal error + +; Routine at 27976 +EXEC_FILE: + CALL ISFLIO + JP Z,EXEC + XOR A + CALL CLSFIL + JP DS_ERR ; Err $39 - Direct statement in a file + +; FILINP AND FILGET -- SCAN A FILE NUMBER AND SETUP PTRFIL + +; REVISION HISTORY +; 4/23/78 PGA - ALLOW # ON CLOSE +; 8/6/79 PGA - IF ^C ON MBASIC FOO, DONT RETURN TO SYSTEM. SEE 'NOTINI' +; 6/27/80 PGA - FIX INPUT#1,D# SO IT USES FINDBL INSTEAD OF FIN AND THUS AVOIDS LOSING SIGNIFICANCE. + +; Routine at 27989 +; +; Get stream number (default #channel=1) +; Used by the routine at FILSTI. +FILINP: + LD C,$01 ; (MD.SQI) MUST BE SEQUENTIAL INPUT + +; Get stream number (C=default #channel) +; Look for '#' channel specifier and put the associated file buffer in BC +FILGET: + CP '#' ;NUMBER SIGN THERE? + RET NZ ;NO, NOT DISK READER + + PUSH BC ;SAVE EXPECTED MODE + CALL FNDNUM ; Numeric argument (0..255) + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' ;GO PAST THE COMMA + LD A,E + PUSH HL + CALL SETFIL ;SETUP PTRFIL = HL + LD A,(HL) + POP HL + POP BC ;[C]=FILE MODE + CP C ;IS IT RIGHT? + JR Z,GDFILM ;GOOD FILE MODE + CP $04 + JR Z,GDFILM ;GOOD FILE MODE + CP $08 + JR NZ,BDFILM ;BAD FILE MODE + LD A,C + CP $02 +BDFILM: + JP NZ,BN_ERR ; Err $34 - 'Bad file number' + +GDFILM: + LD A,(HL) + RET + +; Routine at 28027 +; +; Used by the routine at L7380. +CLOSE_STREAM: + LD BC,GTMPRT + PUSH BC + XOR A + JP CLSFIL + +; Routine at 28035 +; +; Used by the routine at __READ. +FILIND: + RST GETYPR ;SEE IF INPUT IS STRING OR NUMBER + LD BC,DOASIG ;RETURN ADDRESS TO SETUP [FAC] + LD DE,$2C20 ; D=',' E=' ' ..SETUP TERMINATORS SPACE AND COMMA + JR NZ,INPDOR ;IF NUMERIC, GO READ THE FILE + LD E,D ;MAKE BOTH TERMINATORS COMMA + JR INPDOR ;GO READ THE FILE + +; LINE INPUT & READ CODE FOR ITEM FETCHING FROM SEQUENTIAL INPUT FILES +; Data block at 28047 +LINE_INPUT: + LD BC,FINPRT ;RESET TO CONSOLE WHEN DONE READING + PUSH BC ;SAVE ON STACK + CALL FILINP ;GET FILE NUMBER SET UP + CALL GETVAR ;READ STRING TO STORE INTO + CALL TSTSTR ;MAKE SURE IT WAS A STRING + PUSH DE + LD BC,LETCON ;GOOD RETURN ADDRESS FOR ASSIGNMENT + XOR A ;SET A=0 FOR STRING VALUE TYPE + LD D,A ;ZERO OUT BOTH TERMINATORS + LD E,A +INPDOR: + PUSH AF ;SAVE VALUE TYPE + PUSH BC ;SAVE RETURN ADDRESS + PUSH HL ;SAVE POINTER AT DATA COMING IN A DUMMY POINTER AT BUFMIN +NOTNWT: + CALL RDBYT ;READ A CHARACTER + JP C,EF_ERR ;READ PAST END ERROR IF EOF - Err $37 - "Input past END" (EOF) + CP ' ' ;SKIP LEADING SPACES + JR NZ,NOTSPC ;EXCEPT FOR LINE INPUT + INC D ;CHECK FOR LINEINPUT + DEC D + JR NZ,NOTNWT ;SKIP ANY NUMBER +NOTSPC: + CP '"' ;QUOTED STRING COMING IN? + JR NZ,NOTQTE + LD A,E ;SAVE THE QUOTE + CP ',' ;MUST BE INPUT OF A STRING + LD A,'"' ;WHICH HAS [E]=44 + JR NZ,NOTQTE ;QUOTE BACK INTO [A] + LD D,A + LD E,A ;TERMINATORS ARE QUOTES ONLY + CALL RDBYT + JR C,QUITSI ;READ PAST QUOTATION +NOTQTE: ;IF EOF, ALL DONE + LD HL,BUF ;BUFFER FOR DATA + LD B,$FF ;MAXIMUM NUMBER OF CHARACTERS (255) +LOPCRS: + LD C,A ;SAVE CHARACTER IN [C] + LD A,D ;CHECK FOR QUOTED STRING + CP '"' + LD A,C ;RESTORE CHARACTER + JR Z,NOTQTL ;DON'T IGNORE CR OR STOP ON LF + CP CR ;CR? + PUSH HL ;SAVE DEST PTR. ON STACK + JR Z,ICASLF ;EAT LINE FEED IF ONE + POP HL ;RESTORE DEST. PTR. + CP LF ;LF? + JR NZ,NOTQTL ;NO, TEST OTHER TERMINATORS +LPISLF: + LD C,A ;SAVE CURRENT CHAR + LD A,E ;GET TERMINATOR 2 + CP ',' ;CHECK FOR COMMA (UNQUOTED STRING) + LD A,C ;RESTORE ORIG CHAR + CALL NZ,STRCHR ;IF NOT, STORE LF (?) + CALL RDBYT ;GET NEXT CHAR + JR C,QUITSI ;IF EOF, ALL DONE. + + ;** 5/14/82 BUG FIX (MULTIPLE LF FOR UNQUOTED STRING) + ; This extra check exists on GW-BASIC, Tandy M100, Olivetti M10 and MSX + CP LF ;IS IT LF? + JR Z,LPISLF + + CP CR ;IS IT A CR? + JR NZ,NOTQTL ;IF NOT SEE IF STORE NORMALLY + LD A,E ;GET TERMINATOR + CP ' ' ;IS IT NUMERIC INPUT? + JR Z,LPCRGT ;IF SO, IGNORE CR, DONT PUT IN BUFFER + CP ',' ;IS IT NON-QUOTED STRING (TERM=,) + LD A,CR ;GET BACK CR. + JR Z,LPCRGT ;IF SO, IGNORE CR. +NOTQTL: + OR A ;IS CHAR ZERO + JR Z,LPCRGT ;ALWAYS IGNORE, AS IT IS TERMINATOR FOR STRLIT (SEE QUIT2B) + CP D ;TERMINATOR ONE? + JR Z,QUITSI ;STOP THEN + CP E ;TERMINATOR TWO? + JR Z,QUITSI + CALL STRCHR ;SAVE THE CHAR +LPCRGT: + CALL RDBYT + JR NC,LOPCRS +QUITSI: + PUSH HL ;SAVE PLACE TO STUFF ZERO + CP '"' ;STOPPED ON QUOTE? + JR Z,MORSPC ;DON'T SKIP SPACES THEN, BUT DO SKIP FOLLOWING COMMA OR CRLF THOUGH + CP ' ' ;STOPPED ON SPACE? + JR NZ,NOSKCR ;NO, DON'T SKIP SPACES OR ANY FOLLOWING COMMAS OR CRLFS EITHER +MORSPC: + CALL RDBYT ;READ SPACES + JR C,NOSKCR ;EOF, ALL DONE. + CP ' ' + JR Z,MORSPC + CP ',' ;COMMA? + JR Z,NOSKCR ;OK, SKIP IT + CP CR ;CARRIAGE RETURN? + JR NZ,BAKUPT ;BACK UP PAST THIS CHARACTER +ICASLF: + CALL RDBYT ;READ ANOTHER + JR C,NOSKCR ;EOF, ALL DONE. + CP LF ;LINE FEED? + JR Z,NOSKCR ;OK, SKIP IT TOO +BAKUPT: + LD C,A + CALL INDSKB + JR NC,L6E3C +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HBAKU ; Hook for "LINE INPUT#" +ENDIF + JP IE_ERR ; Err $33 - "Internal Error" + +L6E3C: + LD A,$12 ; INS ? .. TK_LEN ? + CALL GET_DEVICE + +NOSKCR: + POP HL ;GET BACK PLACE TO STORE TERMINATOR + +; This entry point is used by the routine at STRCHR. +QUIT2B: + LD (HL),$00 ;STORE THE TERMINATOR + LD HL,BUFMIN ;(buf-1) ITEM IS NOW STORED AT THIS POINT +1 + LD A,E ;WAS IT A NUMERIC INPUT? + SUB $20 ;IF SO, [E]=" " + JR Z,NUMIMK ;USE FIN TO SCAN IT + LD B,$00 + CALL QTSTR_0 ; Eval '0' quoted string + POP HL ;GET BACK [H,L] + RET ;DO ASSIGNMENT + +NUMIMK: + RST GETYPR ;;GET TYPE OF NUMERIC VARIABLE BEING READ + PUSH AF ;SAVE IT + RST CHRGTB ;;READ FIRST CHARACTER + POP AF ;RESTORE TYPE OF VARIABLE + PUSH AF ;SAVE BACK + CALL C,FIN_DBL ;SINGLE PRECISION INPUT + POP AF ;GET BACK TYPE OF VAR + CALL NC,FIN_DBL ;DOUBLE PRECISION INPUT + POP HL ;GET [H,L] + RET ;DO THE ASSIGNMENT + +; Routine at 28257 +STRCHR: + OR A ;TRYING TO STORE NULL BYTE + RET Z ;RETURN, DONT STORE IT + LD (HL),A ;STORE THE CHARACTER + INC HL + DEC B ;128 YET? + RET NZ ;MORE SPACE IN BUFFER, RETURN + POP AF ;GET RID OF SUPERFLUOUS STACK ENTRY + JP QUIT2B ;SPECIAL QUIT + +; Routine at 28267 +; +; Used by the routines at L55F8, NAMSCN, __SAVE, L6BD4, GET, __BSAVE, BLOAD_1, +; L71AB, L71D9 and GET_DEVNO. +NM_ERR: + LD E,$38 ; DERNMF - Bad file name + + DEFB $01 ; "LD BC,nn" to jump over the next word without executing it +AO_ERR: + LD E,$36 ; DERFAO - File already open, on Spectravideo it was called DERFAD + + DEFB $01 ; "LD BC,nn" to jump over the next word without executing it +DS_ERR: + LD E,$39 ; DERFDR - Direct statement in a file + + DEFB $01 ; "LD BC,nn" to jump over the next word without executing it +FF_ERR: + LD E,$35 ; DERFNF - File not found + + DEFB $01 ; "LD BC,nn" to jump over the next word without executing it +CF_ERR: + LD E,$3B ; DERFNO - File not OPEN + + DEFB $01 ; "LD BC,nn" to jump over the next word without executing it +FO_ERR: + LD E,$32 ; DERFOV - FIELD overflow + + DEFB $01 ; "LD BC,nn" to jump over the next word without executing it +BN_ERR: + LD E,$34 ; DERBFN - Bad file number + + DEFB $01 ; "LD BC,nn" to jump over the next word without executing it +IE_ERR: + LD E,$33 ; DERIER - Internal error + + DEFB $01 ; "LD BC,nn" to jump over the next word without executing it +EF_ERR: + LD E,$37 ; DERRPE - Input past end + + DEFB $01 ; "LD BC,nn" to jump over the next word without executing it +DERSAP: + LD E,$3A ; - Sequential I/O Only + + XOR A + LD (NLONLY),A + LD (FLBMEM),A + JP ERROR ; Error $00 + + +; Routine at 28306 +__BSAVE: + CALL NAMSCN + PUSH DE + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + CALL BSAVE_PARM + EX DE,HL + LD (SAVENT),HL + EX DE,HL + PUSH DE + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + CALL BSAVE_PARM + EX DE,HL + LD (SAVEND),HL + EX DE,HL + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + JR Z,__BSAVE_0 + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + CALL BSAVE_PARM + EX DE,HL + LD (SAVENT),HL + EX DE,HL +__BSAVE_0: + POP BC + POP DE + PUSH HL + PUSH BC + LD A,D + CP $FF + JP Z,DO_BSAVE + JP NM_ERR ; Err $38 - 'Bad file name' + +; Data block at 28358 +; $6EC6 +__BLOAD: + CALL NAMSCN + PUSH DE + XOR A + LD (RUNBNF),A ; Reset "Run Binary File After loading" flag (see below) + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + LD BC,$0000 + JR Z,BLOAD_1 + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + CP 'R' + JR NZ,BLOAD_0 + LD (RUNBNF),A ; Run Binary File After loading ( Bload"File.Bin",R ) 0 = Don't Run / 1 = Run + RST CHRGTB ; Gets next character (or token) from BASIC text. + JR Z,BLOAD_1 + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' +BLOAD_0: + CALL BSAVE_PARM + LD B,D + LD C,E +BLOAD_1: + POP DE + PUSH HL + PUSH BC + LD A,D + CP $FF + JP Z,TAPE_LOAD ; load data from tape (incl. header) + JP NM_ERR ; Err $38 - 'Bad file name' + +; Routine at 28404 +; +; Used by the routine at TAPE_LOAD. +TAPE_LOAD_END: + LD A,(RUNBNF) ; Run Binary File After loading ( Bload"File.Bin",R ) 0 = Don't Run / 1 = Run + OR A + JR Z,SPSVEX + XOR A + CALL CLSFIL + LD HL,POPHLRT2 ; POP HL / RET + PUSH HL + LD HL,(SAVENT) + JP (HL) + +; Named SPSVEX only to suggest a retro compatibility with the SVI318 +SPSVEX: + POP HL + XOR A + JP CLSFIL + +; Routine at 28427 +; +; Used by the routine at __BSAVE. +BSAVE_PARM: + CALL EVAL + PUSH HL + CALL GETWORD_HL + POP DE + EX DE,HL + RET + +; Data block at 28437 +; --- START PROC PAR_DNAME --- +; +; Parse Device Name +PAR_DNAME: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HPARD ; Hook 1 for "Parse device name" event +ENDIF + LD A,(HL) + CP ':' + JR C,POSDSK + PUSH HL + LD D,E + LD A,(HL) + INC HL + DEC E + JR Z,L6F2E +L6F24: + CP ':' + JR Z,GET_DEVNAME + LD A,(HL) + INC HL + DEC E + JP P,L6F24 +L6F2E: + LD E,D + POP HL + XOR A + LD A,$FF +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HNODE ; Hook 2 for "Parse device name" event +ENDIF + RET + + +POSDSK: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HPOSD ; Hook 3 for "Parse device name" event +ENDIF + JP NM_ERR ; Err $38 - 'Bad file name' + +GET_DEVNAME: + LD A,D + SUB E + DEC A + POP BC + PUSH DE + PUSH BC + LD C,A ; dev name length + LD B,A + LD DE,DEVICE_TBL + EX (SP),HL + PUSH HL +DEVN_LOOP: + CALL MAKUPL ; Load A with char in 'HL' and make it uppercase + PUSH BC + LD B,A + LD A,(DE) + INC HL + INC DE + CP B + POP BC + JR NZ,GET_DEVNAME_2 + DEC C + JR NZ,DEVN_LOOP +GET_DEVNAME_1: + LD A,(DE) + OR A + JP P,GET_DEVNAME_2 + POP HL + POP HL + POP DE + OR A + RET + +GET_DEVNAME_2: + OR A + JP M,GET_DEVNAME_1 +GET_DEVNAME_3: + LD A,(DE) + ADD A,A + INC DE + JR NC,GET_DEVNAME_3 + LD C,B + POP HL + PUSH HL + LD A,(DE) + OR A + JR NZ,DEVN_LOOP + JP L55F8 ; deal with exceptions/expansions + +; Message at 28534 +DEVICE_TBL: + DEFM "CAS" + DEFB $FF + DEFM "LPT" + DEFB $FE + DEFM "CRT" + DEFB $FD + DEFM "GRP" + DEFB $FC + DEFB $00 + +; Table to define Token groups ? +DEVICE_VECT: + DEFW CAS_CTL + DEFW LPT_CTL + DEFW CRT_CTL + DEFW GRP_CTL + +; This entry point is used by the routines at __OPEN, GET, L6C50, L6C78, +; __EOF and L6E35. + +; Routine location: $6F8F +GET_DEVICE: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HGEND ; Hook for I/O function dispatcher +ENDIF + PUSH HL + PUSH DE + PUSH AF + LD DE,$0004 + ADD HL,DE + LD A,(HL) + CP $FC ; TK_BKSLASH ? + JP C,L564A + LD A,$FF + SUB (HL) + ADD A,A + LD E,A + LD HL,DEVICE_VECT + ADD HL,DE + LD E,(HL) + INC HL + LD D,(HL) + POP AF + LD L,A + LD H,$00 + ADD HL,DE + LD E,(HL) + INC HL + LD D,(HL) + EX DE,HL + POP DE + EX (SP),HL + RET + +; Routine at 28599 +__CSAVE: + CALL FNAME_ARG + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + JR Z,__CSAVE_0 + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + CALL SET_BAUDRATE +__CSAVE_0: + PUSH HL + LD A,$D3 ; BASIC PROGRAM header mode (TK_NAME) + CALL CSAVE_HEADER + LD HL,(VARTAB) + LD (SAVEND),HL + LD HL,(TXTTAB) + CALL __CSAVE_1 + POP HL + RET + +; Routine at 28631 +; +; Used by the routine at __BSAVE. +DO_BSAVE: + LD A,$D0 ; MACHINE CODE header mode (TK_BSAVE) + CALL CSAVE_HEADER + XOR A + CALL CWRTON ; start tape for writing + POP HL + PUSH HL + CALL BSAVE_HL ; send word to tape + LD HL,(SAVEND) + PUSH HL + CALL BSAVE_HL ; send word to tape + LD HL,(SAVENT) + CALL BSAVE_HL ; send word to tape + POP DE + POP HL +DO_BSAVE_0: + LD A,(HL) + CALL CASOUT ; send byte to tape + RST DCOMPR ; Compare HL with DE. + JR NC,DO_BSAVE_1 + INC HL + JR DO_BSAVE_0 + +DO_BSAVE_1: + CALL TAPOOF + POP HL + RET + +; Routine at 28675 +; +; Used by the routine at DO_BSAVE. +; send word to tape +BSAVE_HL: + LD A,L + CALL CASOUT ; send byte to tape + LD A,H + JP CASOUT ; send byte to tape + +; Routine at 28683 +; +; Used by the routine at TAPE_LOAD. +; get word from tape +BLOAD_HL: + CALL _CASIN ; get byte from tape + LD L,A + CALL _CASIN ; get byte from tape + LD H,A + RET + +; Routine at 28692 +; +; Used by the routine at BLOAD_1. +; load data from tape (incl. header) +TAPE_LOAD: + LD C,$D0 ; MACHINE CODE header mode (TK_BSAVE) + CALL CLOAD_HEADER + CALL _CSROON ; start tape for reading + POP BC + CALL BLOAD_HL ; get word from tape + ADD HL,BC + EX DE,HL + CALL BLOAD_HL ; get word from tape + ADD HL,BC + PUSH HL + CALL BLOAD_HL ; get word from tape + LD (SAVENT),HL + EX DE,HL + POP DE +TAPE_LOAD_0: + CALL _CASIN ; get byte from tape + LD (HL),A + RST DCOMPR ; Compare HL with DE. + JR Z,TAPE_LOAD_1 + INC HL + JR TAPE_LOAD_0 + +TAPE_LOAD_1: + CALL TAPIOF + JP TAPE_LOAD_END + +; Routine at 28735 +__CLOAD: + SUB $91 ; TK_PRINT (Check if a "CLOAD?" command was issued, to just VERIFY the file ) + JR Z,_VERIFY + XOR A + DEFB $01 ; "LD BC,nn" to jump over the next word without executing it +_VERIFY: + CPL + INC HL + + CP $01 + PUSH AF + CALL CLOAD_FNAME_ARG + LD C,$D3 ; BASIC PROGRAM header mode (TK_NAME) + CALL CLOAD_HEADER + + POP AF + LD (FACLOW),A + CALL C,CLRPTR + LD A,(FACLOW) + CP $01 + LD (FRCNEW),A + PUSH AF + CALL DEPTR + POP AF + LD HL,(TXTTAB) + CALL CLOAD_SUB + JR NZ,__CLOAD_1 + LD (VARTAB),HL +__CLOAD_OK: + LD HL,OK_MSG ; "Ok" Message + CALL PRS + LD HL,(TXTTAB) + PUSH HL + JP FINI + +__CLOAD_1: + INC HL + EX DE,HL + LD HL,(VARTAB) + RST DCOMPR ; Compare HL with DE. + JP C,__CLOAD_OK + LD E,$14 ; Err $14 - "Verify error" + JP ERROR + +; Data block at 28812 + ; --- START PROC CLOAD_FNAME_ARG --- +CLOAD_FNAME_ARG: + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + JR NZ,FNAME_ARG + PUSH HL + LD HL,FILNAM + LD B,$06 + JR FNAME_ARG_1 + + ; --- START PROC FNAME_ARG --- +FNAME_ARG: + CALL EVAL + PUSH HL + CALL __ASC_0 + DEC HL + DEC HL + LD B,(HL) + LD C,$06 + LD HL,FILNAM +FNAME_ARG_0: + LD A,(DE) + LD (HL),A + INC HL + INC DE + DEC C + JR Z,FNAME_ARG_2 + DJNZ FNAME_ARG_0 + LD B,C +FNAME_ARG_1: + LD (HL),' ' + INC HL + DJNZ FNAME_ARG_1 +FNAME_ARG_2: + POP HL + RET + +; Routine at 28856 +; +; Used by the routines at TAPE_LOAD, __CLOAD and L71D9. +CLOAD_HEADER: + CALL _CSROON ; start tape for reading + LD B,10 ; we check the leading header marker 10 times + +CLOAD_HEADER_0: + CALL _CASIN ; get byte from tape + CP C ; check type + JR NZ,CLOAD_HEADER + DJNZ CLOAD_HEADER_0 + + LD HL,FILNM2 + PUSH HL + LD B,$06 ; 6 bytes +CLOAD_HEADER_1: + CALL _CASIN ; get byte from tape + LD (HL),A + INC HL + DJNZ CLOAD_HEADER_1 + POP HL + + LD DE,FILNAM + LD B,$06 ; 6 bytes +CLOAD_HEADER_2: + LD A,(DE) + INC DE + CP ' ' + JR NZ,CMP_FNAME + DJNZ CLOAD_HEADER_2 + JR FILE_FOUND + +CMP_FNAME: + LD DE,FILNAM + LD B,$06 ; 6 bytes +CMP_FNAME_LOOP: + LD A,(DE) + CP (HL) + JR NZ,SKIP_CAS_FILE + INC HL + INC DE + DJNZ CMP_FNAME_LOOP + +FILE_FOUND: + LD HL,FOUND_MSG + JP PRINT_FNAME_MSG + +SKIP_CAS_FILE: + PUSH BC + LD HL,SKIP_MSG + CALL PRINT_FNAME_MSG + POP BC + JR CLOAD_HEADER + +; Message at 28927 +FOUND_MSG: + DEFM "Found:" + DEFB $00 + +SKIP_MSG: + DEFM "Skip :" + DEFB $00 + +PRINT_FNAME_MSG: + LD DE,(CURLIN) ; Line number the Basic interpreter is working on, in direct mode it will be filled with #FFFF + INC DE + LD A,D + OR E + RET NZ ; Avoid printing messages if CLOAD was issued from within a running program + CALL PRS + LD HL,FILNM2 + LD B,$06 +PRNAME_LOOP: + LD A,(HL) + INC HL + RST OUTDO ; Output char to the current device + DJNZ PRNAME_LOOP + JP OUTDO_CRLF + +; Routine at 28965 +; +; Used by the routines at __CSAVE, DO_BSAVE and L71D9. +CSAVE_HEADER: + CALL CWRTON ; start tape for writing + LD B,10 ; we write the leading header marker 10 times +CSAVE_HEADER_0: + CALL CASOUT ; send byte to tape + DJNZ CSAVE_HEADER_0 + LD B,$06 + LD HL,FILNAM +CSAVE_HEADER_1: + LD A,(HL) + INC HL + CALL CASOUT ; send byte to tape + DJNZ CSAVE_HEADER_1 + JP TAPOOF + +; Routine at 28990 +; +; Used by the routine at __CSAVE. +__CSAVE_1: + PUSH HL + CALL DEPTR + XOR A + CALL CWRTON ; start tape for writing + POP DE + LD HL,(SAVEND) +__CSAVE_1_0: + LD A,(DE) + INC DE + CALL CASOUT ; send byte to tape + RST DCOMPR ; Compare HL with DE. + JR NZ,__CSAVE_1_0 + LD L,$07 +__CSAVE_1_1: + CALL CASOUT ; send byte to tape + DEC L + JR NZ,__CSAVE_1_1 + JP TAPOOF + +; Routine at 29021 +; +; Used by the routine at __CLOAD. +CLOAD_SUB: + CALL _CSROON ; start tape for reading + SBC A,A + CPL + LD D,A +CLOAD_SUB_0: + LD B,$0A ; 10 bytes +CLOAD_SUB_1: + CALL _CASIN ; get byte from tape + LD E,A + CALL ENFMEM ; $6267 = ENFMEM (reference not aligned to instruction) + LD A,E + SUB (HL) + AND D + JP NZ,TAPIOF + LD (HL),E + LD A,(HL) + OR A + INC HL + JR NZ,CLOAD_SUB_0 + DJNZ CLOAD_SUB_1 + + LD BC,$FFFA ; -6 + ADD HL,BC + XOR A + JP TAPIOF + + +; Data block at 29058 +; GRP: Device Control Table/Driver +; $7182 +GRP_CTL: + DEFW DEVICE_OPEN + DEFW DO_NOTHING ; CLOSE operation + DEFW DERSAP ; "Sequential I/O access only" error + DEFW GRP_OUTPUT + + DEFW FC_ERR ; INPUT operation + DEFW FC_ERR + DEFW FC_ERR + DEFW FC_ERR ; EOF operation + DEFW FC_ERR + DEFW FC_ERR ; UNGETC operation + +GRP_OUTPUT: + LD A,(SCRMOD) + CP $02 + JP C,FC_ERR + LD A,C +; Routine at 29087 +L719F: + JP GRPPRT + + + +; Routine at 29090 +; CRT: Device Control Table/Driver +; $71A2 +CRT_CTL: + DEFW DEVICE_OPEN + DEFW DO_NOTHING ; CLOSE operation + DEFW DERSAP ; "Sequential I/O access only" error + DEFW CRT_OUTPUT + + DEFW FC_ERR ; INPUT operation + DEFW FC_ERR + DEFW FC_ERR + DEFW FC_ERR ; EOF operation + DEFW FC_ERR + DEFW FC_ERR ; UNGETC operation + +DEVICE_OPEN: + CALL GET_DEVNO ; Get device number + CP $01 + JP Z,NM_ERR ; Err $38 - 'Bad file name' +; This entry point is used by the routine at L71D9. +REDIRECT_IO: + LD (PTRFIL),HL + LD (HL),E +DO_NOTHING: + RET + +; Routine at 29123 +CRT_OUTPUT: + LD A,C + JP CHPUT + +; Data block at 29127 +; CAS: Device Control Table/Driver +;$71C7 +CAS_CTL: + DEFW CAS_OPEN + DEFW CAS_CLOSE + DEFW DERSAP ; "Sequential I/O access only" error + DEFW CAS_OUTPUT + + DEFW CAS_INPUT + DEFW FC_ERR + DEFW FC_ERR + DEFW CAS_EOF + DEFW FC_ERR + DEFW CAS_UNGETC + + +CAS_OPEN: + PUSH HL + PUSH DE + LD BC,$0006 + ADD HL,BC ; char count + XOR A + LD (HL),A + LD (CASPRV),A ; clear char for UNGETC + CALL GET_DEVNO + CP $04 + JP Z,NM_ERR ; Err $38 - 'Bad file name' + + CP $01 + JR Z,CAS_OPEN_RD + + LD A,$EA ; ASCII FILE header mode (TK_DSKI$) + CALL CSAVE_HEADER + +CAS_OPEN_END: + POP DE + POP HL + JR REDIRECT_IO + +CAS_OPEN_RD: + LD C,$EA ; ASCII FILE header mode (TK_DSKI$) + CALL CLOAD_HEADER + CALL TAPIOF + JR CAS_OPEN_END + + +; Routine at 29189 +CAS_CLOSE: + LD A,(HL) + CP $01 + JR Z,CAS_CLOSE_1 + LD A,$1A ; EOF + PUSH HL + CALL INIT_DEV_OUTPUT + CALL Z,CAS_OUTPUT_0 + POP HL + CALL CLOSE_DEVICE + JR Z,CAS_CLOSE_1 + PUSH HL + ADD HL,BC +CAS_CLOSE_0: + LD (HL),$1A ; EOF + INC HL + INC C + JR NZ,CAS_CLOSE_0 + POP HL + CALL CAS_OUTPUT_0 +CAS_CLOSE_1: + XOR A + LD (CASPRV),A + RET + +; Routine at 29226 +CAS_OUTPUT: + LD A,C + CALL INIT_DEV_OUTPUT + RET NZ +; This entry point is used by the routine at CAS_CLOSE. +CAS_OUTPUT_0: + XOR A + CALL CWRTON ; start tape for writing + LD B,$00 +CAS_OUTPUT_1: + LD A,(HL) + CALL CASOUT ; send byte to tape + INC HL + DJNZ CAS_OUTPUT_1 + JP TAPOOF + +; Routine at 29247 +; +; Used by the routine at CAS_EOF. +CAS_INPUT: + EX DE,HL + LD HL,CASPRV + CALL GET_BYTE + EX DE,HL + CALL INIT_INPUT + JR NZ,CAS_INPUT_1 + PUSH HL + CALL _CSROON ; start tape for reading + POP HL + LD B,$00 +CAS_INPUT_0: + CALL _CASIN ; get byte from tape + LD (HL),A + INC HL + DJNZ CAS_INPUT_0 + CALL TAPIOF + DEC H + XOR A + LD B,A +CAS_INPUT_1: + LD C,A + ADD HL,BC + LD A,(HL) + CP $1A ; EOF + SCF + CCF + RET NZ + LD (CASPRV),A + SCF + RET + +; Routine at 29293 +CAS_EOF: + CALL CAS_INPUT + LD HL,CASPRV + LD (HL),A + SUB $1A ; EOF + SUB $01 + SBC A,A + JP CONIA ;CONVERT [A] TO AN INTEGER SIGNED + +; Routine at 29308 +CAS_UNGETC: + LD HL,CASPRV + LD (HL),C + RET + +; Routine at 29313 +; +; Used by the routine at CAS_CLOSE. +CLOSE_DEVICE: + LD BC,$0006 + ADD HL,BC ; char count + LD A,(HL) + LD C,A + LD (HL),$00 + JR DEVICE_RET + +; Routine at 29323 +; +; Used by the routines at CAS_CLOSE and CAS_OUTPUT. +INIT_DEV_OUTPUT: + LD E,A + LD BC,$0006 + ADD HL,BC ; char count + LD A,(HL) + INC (HL) + INC HL + INC HL + INC HL + PUSH HL + LD C,A + ADD HL,BC + LD (HL),E + POP HL + RET + +; Routine at 29339 +; +; Used by the routine at CAS_INPUT. +INIT_INPUT: + LD BC,$0006 + ADD HL,BC ; char count + LD A,(HL) + INC (HL) +; This entry point is used by the routine at CLOSE_DEVICE. +DEVICE_RET: + INC HL + INC HL + INC HL + AND A + RET + +; Data block at 29350 +; LPT: Device Control Table/Driver +; $72A6 +LPT_CTL: + DEFW DEVICE_OPEN + DEFW DO_NOTHING ; CLOSE operation + DEFW DERSAP ; "Sequential I/O access only" error + DEFW LPT_OUTPUT + + DEFW FC_ERR ; INPUT operation + DEFW FC_ERR + DEFW FC_ERR + DEFW FC_ERR ; EOF operation + DEFW FC_ERR + DEFW FC_ERR ; UNGETC operation + +LPT_OUTPUT: + LD A,C + JP OUTDLP + + +; Routine at 29374 +; +; Used by the routine at CAS_INPUT. +GET_BYTE: + LD A,(HL) + LD (HL),$00 + AND A + RET Z + INC SP + INC SP + CP $1A ; EOF + SCF + CCF + RET NZ + LD (HL),A + SCF + RET + +; Routine at 29389 +; +; Used by the routines at L71AB and L71D9. +; Copy the current device/stream/channel number to A +GET_DEVNO: + LD A,E + CP $08 + JP Z,NM_ERR ; Err $38 - 'Bad file name' + RET + +; Routine at 29396 +; +; Used by the routines at BLOAD_HL, TAPE_LOAD, CLOAD_HEADER, CLOAD_SUB and CAS_INPUT. +; get byte from tape +_CASIN: + PUSH HL + PUSH DE + PUSH BC + CALL TAPIN ; Get byte from cassette + JR NC,POPALL_0 + JR DIOERR + +; Routine at 29406 +; +; Used by the routines at DO_BSAVE, BSAVE_HL, CSAVE_HEADER, __CSAVE_1 and CAS_OUTPUT. +; send byte to tape +CASOUT: + PUSH HL + PUSH DE + PUSH BC + PUSH AF + CALL TAPOUT + JR NC,POPALL + JR DIOERR + +; Routine at 29417 +; +; Used by the routines at TAPE_LOAD, CLOAD_HEADER, CLOAD_SUB and CAS_INPUT. +; start tape for reading (Cassette motor on and wait for Sync and Header) +_CSROON: + PUSH HL + PUSH DE + PUSH BC + PUSH AF + CALL TAPION + JR NC,POPALL +; This entry point is used by the routines at _CASIN and CASOUT. +DIOERR: + CALL TAPIOF + JP IO_ERR + +; Routine at 29432 +; +; Used by the routines at DO_BSAVE, CSAVE_HEADER, __CSAVE_1 and CAS_OUTPUT. +; start tape for writing +CWRTON: + PUSH HL + PUSH DE + PUSH BC + PUSH AF + CALL TAPOON +; This entry point is used by the routines at L6C50, CASOUT and _CSROON. +POPALL: + POP AF +; This entry point is used by the routines at L6C78 and _CASIN. +POPALL_0: + POP BC + POP DE + POP HL + RET + +; Routine at 29444 +; +; Used by the routines at L628E and __END. +FINLPT: + XOR A ;RESET PRINT FLAG SO + LD (PRTFLG),A ;OUTPUT GOES TO TERMINAL + LD A,(LPTPOS) ;GET CURRENT LPT POSIT + OR A ;ON LEFT HAND MARGIN ALREADY? + RET Z ;YES, RETURN + + LD A,CR ;PUT OUT CRLF + CALL LPTCHR + LD A,LF + CALL LPTCHR + XOR A + LD (LPTPOS),A ;ZERO LPTPOS + RET ;DONE + +; Routine at 29468 +; +; Used by the routine at FINLPT. +LPTCHR: + CALL LPTOUT + RET NC + JP IO_ERR + +; Routine at 29475 +; +; Used by the routines at LINE2PTR and __END. +CONSOLE_CRLF: + LD A,(TTYPOS) ;GET CURRENT TTYPOS + OR A ;SET CC'S + RET Z ;IF ALREADY ZERO, RETURN + +; This entry point is used by the routines at L4A5A, __LLIST, L61C4, L710B and __KEY. +; a.k.a. CRDO +OUTDO_CRLF: + +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HCRDO ; Hook for "CRLF to OUTDO" events +ENDIF + + LD A,CR ; CR + RST OUTDO ; Output char to the current device + LD A,LF ; LF + RST OUTDO ; Output char to the current device + +; This entry point is used by the routines at L4A5A, PRS1 and OUTCH1. +;DON'T PUT CR/LF OUT TO LOAD FILE +CRFIN: + CALL ISFLIO ;SEE IF OUTPUTTING TO DISK + JR Z,CRCONT ;NOT DISK FILE, CONTINUE + XOR A ;CRFIN MUST ALWAYS RETURN WITH A=0 + RET ;AND CARRY=0. + +CRCONT: + LD A,(PRTFLG) ;GOING TO PRINTER? + OR A ;TEST + JR Z,NTPRTR ;NO + XOR A ;DONE, RETURN + LD (LPTPOS),A ;ZERO POSITON + RET + +NTPRTR: + LD (TTYPOS),A ; Set to position 0 ;SET TTYPOS=0 + RET ; Store it + +; Routine at 29511 +; +; Used by the routine at OPRND. +FN_INKEY: + RST CHRGTB ; Gets next character (or token) from BASIC text. + PUSH HL ;SAVE THE TEXT POINTER + CALL CHSNS ;SET NON-ZERO IF CHAR THERE + JR Z,NULRT ;NO, RETURN NULL STRING + CALL CHGET + PUSH AF + CALL STRIN1 ;MAKE ONE CHAR STRING + POP AF + LD E,A ;CHAR TO [D] + CALL SETSTR ;STUFF IN DESCRIPTOR AND GOTO PUTNEW + +NULRT: + LD HL,NULL_STRING + LD (FACLOW),HL + LD A,$03 ; String + LD (VALTYP),A + POP HL + RET + +; Routine at 29543 +; +; Used by the routine at LISPRT. +OUTCH1: + RST OUTDO ;OUTPUT THE CHAR + CP LF ;WAS IT A LF? + RET NZ ;NO, RETURN + LD A,CR ;DO CR + RST OUTDO + CALL CRFIN + LD A,LF ;RESTORE CHAR (LF) + RET + + +; A.K.A. TTYLIN +; Accepts a line from a file or device +; +PINSTREAM: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HDSKC ; ($FEEE) Hook for Mainloop line input +ENDIF + LD B,$FF + LD HL,BUF +L737C: + CALL RDBYT + JR C,EOF_REACHED + LD (HL),A + CP CR + JR Z,NEXT_LINE + CP $09 ; TAB + JR Z,L7380_0 + CP LF + JR Z,L737C +L7380_0: + INC HL + DJNZ L737C +NEXT_LINE: + XOR A + LD (HL),A + LD HL,BUFMIN + RET + +EOF_REACHED: + INC B + JR NZ,NEXT_LINE + LD A,(NLONLY) + AND $80 + LD (NLONLY),A + CALL CLOSE_STREAM + LD A,(FILNAM) + AND A + JP Z,RESTART + CALL RUN_FST + JP NEWSTT + +; Routine at 29618 +; +; Used by the routines at _CSROON and LPTCHR. +IO_ERR: + LD E,$13 ; Err $13 - "Device I/O error" + JP ERROR + +; Routine at 29623 +__MOTOR: + LD E,$FF + JR Z,__MOTOR_0 + SUB TK_OFF + LD E,A + JR Z,L73C4+1 + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB TK_ON + LD E,$01 +L73C4: + ; L73C4+1: RST CHRGTB ; Gets next character (or token) from BASIC text. + LD A,$D7 +__MOTOR_0: + LD A,E + JP STMOTR + +; Routine at 29642 +__SOUND: + CALL GETINT ;Get frequency. ; Get integer 0-255 + CP 14 ; PSG Channel range + JP NC,FC_ERR ;Frequency too low + PUSH AF ;Save frequency + RST SYNCHR + DEFB ',' + CALL GETINT ;Get duration. +;::::::::::::::::::::: +L73D8: + POP AF +;:::::::: CODE RELOCATION IS SAFE STARTING FROM HERE :::::::: + CP $07 + JR NZ,__SOUND_0 + RES 6,E + SET 7,E +__SOUND_0: + JP WRTPSG + + + + +; Data block at 29668 +L73E4: + DEFB ' ' + + +; +; PLAY - MUSIC MACRO LANGUAGE +; + +; Takumi Miyamoto, former employee at ASCII Corporation, tells about a bug in the play statement: +; "Few people seemed to notice it, but there was a bug in BASIC play statements in MSX1-2+. +; It caused an extra space for one count when a play command ended. +; In other words, there was a short pause at the moment of the transition from one play sentence to the next. +; The tempo shifts for a moment, but many of you may not have noticed it." + +__PLAY: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HPLAY ; Hook for 'PLAY' +ENDIF + + PUSH HL + LD HL,PLAY_TAB + LD (MCLTAB),HL + LD A,$00 + LD (PRSCNT),A ; Used by PLAY command in BASIC + LD HL,$FFF6 ; -10 + ADD HL,SP + LD (SAVSP),HL ; Used by PLAY command in BASIC + POP HL + PUSH AF +__PLAY_0: + CALL EVAL + EX (SP),HL + PUSH HL + CALL GETSTR + CALL LOADFP + LD A,E + OR A + JR NZ,__PLAY_1 + + LD E,$01 + LD BC,L73E4 ; points to ' '.. empty play queue + LD D,C + LD C,B + +; Routine at 29715 +__PLAY_1: + POP AF + PUSH AF + CALL GETVCP ; Returns pointer to play queue + LD (HL),E ; = 1 + INC HL + LD (HL),D + INC HL + LD (HL),C + INC HL + LD D,H + LD E,L + LD BC,$001C ; 28 + ADD HL,BC + EX DE,HL + LD (HL),E + INC HL + LD (HL),D + POP BC + POP HL + INC B + LD A,B + CP $03 ; TK_MID_S ? + JR NC,__PLAY_3 + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + JR Z,__PLAY_2 + PUSH BC + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + JR __PLAY_0 + +; Routine at 29753 +__PLAY_2: + LD A,B + LD (VOICEN),A + CALL DOSND_SUB + INC B + LD A,B + CP $03 + JR C,__PLAY_2 +; This entry point is used by the routine at __PLAY_1. +__PLAY_3: + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + JP NZ,SN_ERR + PUSH HL +; This entry point is used by the routine at MCLPLAY. +__PLAY_4: + XOR A +; This entry point is used by the routine at MCLPLAY. +__PLAY_5: + PUSH AF + LD (VOICEN),A + LD B,A + CALL L7521 + JP C,MCLPLAY_3 + LD A,B + CALL GETVCP ; Returns pointer to play queue + LD A,(HL) + OR A + JP Z,MCLPLAY_3 + LD (MCLLEN),A + INC HL + LD E,(HL) + INC HL + LD D,(HL) + INC HL + LD (MCLPTR),DE + LD E,(HL) + INC HL + LD D,(HL) + INC HL + PUSH HL + LD L,$24 + CALL GETVC2 + PUSH HL + LD HL,(SAVSP) + DEC HL + POP BC + DI + CALL MOVUP_0 + POP DE + LD H,B + LD L,C + LD SP,HL + EI + LD A,$FF + LD (MCLFLG),A + JP MCLSCN + +; Routine at 29838 +; +; Used by the routine at DOSND. +MCLPLAY: + LD A,(MCLLEN) ;POINT TO STRING LENGTH + OR A + JR NZ,MCLPLAY_1 +; This entry point is used by the routine at L5683. +MCLPLAY_0: + CALL DOSND_SUB +MCLPLAY_1: + LD A,(VOICEN) + CALL GETVCP + LD A,(MCLLEN) ;Get str len + LD (HL),A + INC HL + LD DE,(MCLPTR) + LD (HL),E + INC HL + LD (HL),D + LD HL,$0000 + ADD HL,SP + EX DE,HL + LD HL,(SAVSP) + DI + LD SP,HL + POP BC + POP BC + POP BC + PUSH HL + OR A + SBC HL,DE + JR Z,MCLPLAY_2 + LD A,$F0 + AND L + OR H + JP NZ,FC_ERR + LD L,$24 + CALL GETVC2 + POP BC + DEC BC + CALL MOVUP_0 + POP HL + DEC HL + LD (HL),B + DEC HL + LD (HL),C + JR MCLPLAY_3 +MCLPLAY_2: + POP BC + POP BC +; This entry point is used by the routine at __PLAY_2. +MCLPLAY_3: + EI + POP AF + INC A + CP $03 + JP C,__PLAY_5 + DI + LD A,(INTFLG) + CP $03 + JR Z,MCLPLAY_6 + LD A,(PRSCNT) + RLCA + JR C,MCLPLAY_4 + LD HL,PLYCNT + INC (HL) + CALL STRTMS +MCLPLAY_4: + EI + LD HL,PRSCNT + LD A,(HL) + OR $80 + LD (HL),A + CP $83 ; TK_NEXT ? + JP NZ,__PLAY_4 +MCLPLAY_5: + POP HL + RET + +MCLPLAY_6: + CALL GICINI + JR MCLPLAY_5 + +; Routine at 29959 +; +; Used by the routines at __PLAY_2 and MCLPLAY. +DOSND_SUB: + LD A,(PRSCNT) + INC A + LD (PRSCNT),A + LD E,$FF +; This entry point is used by the routine at DOSND. +DOSND_SUB_0: + PUSH HL + PUSH BC +DOSND_SUB_1: + PUSH DE + LD A,(VOICEN) + DI + CALL PUTQ + EI + POP DE + JR Z,DOSND_SUB_1 + POP BC + POP HL + RET + + +; Routine at 29985 +; +; Used by the routines at __PLAY_2 and DOSND. +L7521: + LD A,(VOICEN) + PUSH BC + DI + CALL LFTQ ; Gives number of bytes left in queue + EI + POP BC + CP $08 + RET + + +; Data table at 29998 +;$5D83 +PLAY_TAB: + DEFB 'A' ;THE NOTES A-G + DEFW PLAY_NOTE + + DEFB 'B' + DEFW PLAY_NOTE + + DEFB 'C' + DEFW PLAY_NOTE + + DEFB 'D' + DEFW PLAY_NOTE + + DEFB 'E' + DEFW PLAY_NOTE + + DEFB 'F' + DEFW PLAY_NOTE + + DEFB 'G' + DEFW PLAY_NOTE + + DEFB 'M'+$80 ;Music Meta Command + DEFW PLYMET ; Envelope cycle setting *2 (1..65535) + + DEFB 'V'+$80 + DEFW VOLUME ; Volume (0..15) + + DEFB 'S'+$80 + DEFW ENVELOPE_SHAPE ; Envelope shape *2 (0..15) + + DEFB 'N'+$80 ;PLAY NUMERIC NOTE + DEFW PLYNUM ; Plays Note raised to n (0..96) + + DEFB 'O'+$80 ;OCTAVE + DEFW POCTAV ; Octave (1..8) + + DEFB 'R'+$80 ; GW-BASIC has 'P' for 'Pause' + DEFW REST ; Rest setting (1..64) + + DEFB 'T'+$80 ;TEMPO + DEFW TEMPO ; Tempo setting (32..255) + + DEFB 'L'+$80 ;LENGTH + DEFW LENGTH ; Length (1..64) + + DEFB 'X' ;EXECUTE STRING + DEFW MCLXEQ ; .. Plays MML string stored in variable A$ + + DEFB $00 ;END OF TABLE + + + +; TABLE OF INDEXES INTO NOTE_TAB FOR EACH NOTE +; VALUE OF 0 MEANS NOTE NOT ALLOWED. + +NOTE_XLT: + DEFB 8*2 ;A- (G#) + DEFB 9*2 ;A + DEFB 10*2 ;A# + DEFB 11*2 ;B + + DEFB $00 ;NO C- OR B# + DEFB $00 + + DEFB 1*2 ;C + DEFB 2*2 ;C# + DEFB 3*2 ;D + DEFB 4*2 ;D# + DEFB 5*2 ;E + + DEFB 5*2 ;NO E# OR F- + + DEFB 6*2 ;F + DEFB 7*2 ;F# + DEFB 8*2 ;G + + +; TABLE OF NOTE FREQUENCIES +; IN GW-BASIC THESE WERE THE FREQUENCIES IN HERTZ OF THE TOP OCTAVE (6) +; DIVIDED DOWN BY POWERS OF TWO TO GET ALL OTHER OCTAVES +; + + +NOTE_TAB: + DEFW $0D5D ;C + DEFW $0C9C ;C# + DEFW $0BE7 ;D + DEFW $0B3C ;D# + DEFW $0A9B ;E + DEFW $0A02 ;F + DEFW $0973 ;F# + DEFW $08EB ;G + DEFW $086B ;G# + DEFW $07F2 ;A + DEFW $0780 ;A# + DEFW $0714 ;B + + + +; Volume (0..15) +VOLUME: + JR C,SET_VOLUME + LD E,8 ; Default volume: 8 +SET_VOLUME: + LD A,15 ; Max volume: 15 + CP E + JR C,PLGO_FC + +SET_ENVELOPE: + XOR A + OR D + JR NZ,PLGO_FC + LD L,$12 + CALL GETVC2 + LD A,$40 + AND (HL) + OR E + LD (HL),A + RET + + + +; PLYMET - Process Music Meta Commands. +; ..on AY it sets the envelope cycle *2 (1..65535) + + +; Routine at 30110 +; Used by the routine at L752E. +PLYMET: + LD A,E + JR C,SET_ENV_CYCLE + CPL + INC A + LD E,A +SET_ENV_CYCLE: + OR D + JR Z,PLGO_FC + LD L,$13 + CALL GETVC2 + PUSH HL + LD A,(HL) + INC HL + LD H,(HL) + LD L,A + RST DCOMPR ; Compare HL with DE. + POP HL + RET Z + LD (HL),E + INC HL + LD (HL),D + DEC HL + DEC HL + LD A,$40 + OR (HL) + LD (HL),A + RET + +; Routine at 30142 +; Envelope shape *2 (0..15) +ENVELOPE_SHAPE: + LD A,E + CP 15+1 ; Max envelope shape: 15 + JR NC,PLGO_FC + OR $10 + LD E,A + JR SET_ENVELOPE + + +; Data block at 30152 + ; --- START PROC LENGTH --- +; Length (1..64) +LENGTH: + JR C,SET_LENGHT ;JP IF ARGUMENT AVAILABLE + LD E,4 ; Default Length: 4 +SET_LENGHT: + LD A,E + CP 64+1 ;ALLOW ONLY UP TO 64 + JR NC,PLGO_FC ;FC ERROR IF TOO BIG + LD L,$10 ;STORE NOTE LENGTH + + ; --- START PROC L75D3 --- +SETVC2: + CALL GETVC2 + XOR A + OR D + JR NZ,PLGO_FC + OR E + JR Z,PLGO_FC + LD (HL),A + RET + + ; --- START PROC PLGO_FC --- +PLGO_FC: + CALL FC_ERR + + ; --- START PROC TEMPO --- +; Tempo setting (32..255) +TEMPO: + JR C,SET_TEMPO ;JP IF ARGUMENT AVAILABLE + LD E,120 ; Default tempo: 120 +SET_TEMPO: + LD A,E + CP 32 ;ALLOW ONLY 32 - 255 + JR C,PLGO_FC ;FC ERROR IF TOO SMALL + LD L,$11 ;Store Beats per minute + JR SETVC2 + +; Routine at 30191 +; Octave (1..8) +POCTAV: + JR C,SET_OCTAVE ;JP IF ARGUMENT AVAILABLE + LD E,4 ; Default octave: 4 +SET_OCTAVE: + LD A,E + CP 8+1 ; Max octave: 8 + JR NC,PLGO_FC ;FC ERROR IF TO BIG + LD L,$0F ;Store octave value + JR SETVC2 + +; Routine at 30204 +; +; Used by the routine at L752E. +; Rest setting (1..64) +REST: + JR C,SET_REST + LD E,4 ; Default REST value: 4 +SET_REST: + XOR A + OR D + JR NZ,PLGO_FC + OR E + JR Z,PLGO_FC + CP 65 ;If was .gt. 64 + JR NC,PLGO_FC ; then error + +; This entry point is used by the routine at PLYNUM. +PLYNO3: + LD HL,$0000 + PUSH HL + LD L,$10 + CALL GETVC2 + PUSH HL + INC HL + INC HL + LD A,(HL) + LD (SAVVOL),A + LD (HL),$80 + DEC HL + DEC HL + JR DOSND_0 + +; Routine at 30241 +PLYNUM: + JR NC,PLGO_FC ;ERROR IF NO ARG + XOR A ;GET NOTE NUMBER INTO [AL] + OR D + JR NZ,PLGO_FC + OR E ;SEE IF ZERO (PAUSE) + JR Z,PLYNO3 ;DO THE PAUSE + CP 96+1 ;ALLOW ONLY 0..96 (Max RAISE value: 96) + JR NC,PLGO_FC ;FC ERROR IF TOO BIG + LD A,E + LD B,$00 + LD E,B +PLYNUM_0: + SUB 12 ;DIVIDE BY 12 + INC E ;OCTAVE counter + JR NC,PLYNUM_0 + ADD A,12 + ADD A,A ;NOTE*2.. + LD C,A ;.. in BC + JP PLYNU3 ;PLAY NOTE + +; Routine at 30270 +PLAY_NOTE: + LD B,C + LD A,C + SUB 'A'-1 ;MAP TO 1..7 + ADD A,A ;MAP TO 2..14 (THIS ASSUMES SHARP) + LD C,A + CALL FETCHR ;GET NEXT CHARACTER + JR Z,PLYNO2 ;END OF STRING - NO SHARP OR FLAT + CP '#' ;CHECK FOR POSSIBLE SHARP + JR Z,PLYSHARP ;SHARP IT THEN + CP '+' ;"+" ALSO MEANS SHARP + JR Z,PLYSHARP + CP '-' ;"-" MEANS FLAT + JR Z,PLYFLAT + CALL DECFET ;PUT CHAR BACK IN STRING. + JR PLYNO2 ;TREAT AS UNMODIFIED NOTE. + +; Flat (Lower half tone) +PLYFLAT: + DEC C ;DECREMENT TWICE TO FLAT IT + LD A,B ;INTO [AL] FOR XLAT + CP 'C' + JR Z,PLAY_NOTE_1 ; 'C flat' does not exist, compensate.. + CP 'F' + JR NZ,PLYNO2 ; 'F flat' does not exist, compensate.. +PLAY_NOTE_1: + DEC C +PLYNO2: + DEC C ;MAP BACK TO UNSHARPED +; Sharp (raise half tone) +PLYSHARP: + LD L,$0F + CALL GETVC2 + LD E,(HL) + LD B,$00 + LD HL,NOTE_XLT ;POINT TO TRANSLATE TABLE + ADD HL,BC + LD C,(HL) + + +; Play note. BC = ptr to the freq. table, E=octave +; This entry point is used by the routine at PLYNUM. +PLYNU3: + LD HL,NOTE_TAB + ADD HL,BC + LD A,E ; A = OCTAVE + LD E,(HL) + INC HL + LD D,(HL) +PLYNU3_0: + DEC A ; OCTAVE properly set ? + JR Z,DOSND ; ok, go for sound + SRL D + RR E + JR PLYNU3_0 ; OCTAVE shifting + +; Routine at 30340 +SNDFCE: + CALL FC_ERR ; Complain + +; This entry point is used by the routine at PLAY_NOTE. +DOSND: + ADC A,E + LD E,A + ADC A,D + SUB E + LD D,A + PUSH DE + LD L,$10 + CALL GETVC2 + LD C,(HL) + PUSH HL + CALL FETCHR + JR Z,PLYNU4 ;Brif end of string + CALL VALSC2 ;See if possible number + +; This entry point is used by the routine at REST. +DOSND_0: + LD A,64 ;If was .gt. 64 + CP E + JR C,SNDFCE ; then error + XOR A + OR D + JR NZ,SNDFCE + OR E ;Any Length? + JR Z,PLYNU4 ;Brif not, just do note + LD C,E +PLYNU4: + POP HL + LD D,$00 + LD B,D + INC HL + LD E,(HL) + PUSH HL + CALL MLDEBC + EX DE,HL + CALL HL_CSNG + CALL VMOVAF + LD HL,FP_SNDCONST ; Single precision float const: 12000, (calibrate to 1 second units) + CALL MOVFM + CALL DDIV + CALL __CINT + LD D,H + LD E,L +PLYDOT: + CALL FETCHR + JR Z,PLYDOX ;Brif EOS + CP '.' ;Note duration extender? + JR NZ,PLYDO2 ;Brif not + SRL D ;Duration = Duration * 1.5 + RR E ;Ovf/2 + ADC HL,DE + LD A,$E0 + AND H ;Still too big? + JR Z,PLYDOT ;Itterate if not + XOR H + LD H,A + JR PLYDOX +PLYDO2: + CALL DECFET ;Put char back +PLYDOX: + LD DE,$0005 + RST DCOMPR ; Compare HL with DE. + JR C,DOSND_1 + EX DE,HL +DOSND_1: + LD BC,$FFF7 ; -9 + POP HL + PUSH HL + ADD HL,BC + LD (HL),D + INC HL + LD (HL),E + INC HL + LD C,$02 + EX (SP),HL + INC HL + LD E,(HL) + LD A,E + AND $BF + LD (HL),A + EX (SP),HL + LD A,$80 + OR E + LD (HL),A + INC HL + INC C + EX (SP),HL + LD A,E + AND $40 + JR Z,DOSND_2 + INC HL + LD E,(HL) + INC HL + LD D,(HL) + POP HL + LD (HL),D + INC HL + LD (HL),E + INC HL + INC C + INC C + + DEFB $FE ; 'CP $E1' masking 'POP HL' + +DOSND_2: + POP HL + POP DE + LD A,D + OR E + JR Z,DOSND_3 + LD (HL),D + INC HL + LD (HL),E + INC C + INC C +DOSND_3: + LD L,$07 + CALL GETVC2 + LD (HL),C + LD A,C + SUB $02 + RRCA + RRCA + RRCA + INC HL + OR (HL) + LD (HL),A + DEC HL + LD A,D + OR E + JR NZ,DOSND_4 + PUSH HL + LD A,(SAVVOL) + OR $80 + LD BC,$000B + ADD HL,BC + LD (HL),A + POP HL +DOSND_4: + POP DE + LD B,(HL) + INC HL +DOSND_5: + LD E,(HL) + INC HL + CALL DOSND_SUB_0 + DJNZ DOSND_5 + CALL L7521 + JP C,MCLPLAY + JP MCLSCN + +; Pointed by routine at DOSND +; numeric float const +FP_SNDCONST: + DEFB $00 + DEFB $00 + DEFB $45 + DEFB $12 + + +__PUT: + LD B,$80 + DEFB 17 ; "LD DE,nn" to jump over the next word without executing it + +__GET: + LD B,$00 + CP TK_SPRITE + JP Z,PUT_SPRITE + LD A,B + JP GET + +; Routine at 30566 +__LOCATE: + LD DE,(CSRY) + PUSH DE + CP ',' + JR Z,__LOCATE_0 + CALL GETINT ; Get integer 0-255 + INC A + POP DE + LD D,A + PUSH DE + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + JR Z,__LOCATE_3 +__LOCATE_0: + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + CP ',' + JR Z,__LOCATE_1 + CALL GETINT ; Get integer 0-255 + INC A + POP DE + LD E,A + PUSH DE + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + JR Z,__LOCATE_3 +__LOCATE_1: + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + CALL GETINT ; Get integer 0-255 + AND A ; Hide.. + LD A,'y' + JR NZ,__LOCATE_2 + DEC A ; ..un-hide cursor +__LOCATE_2: + PUSH AF + LD A,ESC + RST OUTDO ; Output char to the current device + POP AF ; ESC_y (show/hide cursor) + RST OUTDO ; Output char to the current device + LD A,$35 ; '5' + RST OUTDO ; Output char to the current device +__LOCATE_3: + EX (SP),HL + CALL POSIT + POP HL + RET + +; Routine at 30629 +; +; Used by the routine at __STOP. +L77A5: + PUSH HL + LD HL,$FC6A ; Unkown system variable + JR _TRIG_0 + +; Routine at 30635 +; +; Used by the routine at __SPRITE. +L77AB: + PUSH HL + LD HL,IFLG_COLLSN ; Sprite collision - Interrupt flags + JR _TRIG_0 + +; Routine at 30641 +; +; Used by the routine at NOT_KEYWORD. +_INTERVAL: + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB 'E' ; "INTE..." + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB 'R' ; "INTER..." + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB $FF + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB TK_VAL+$80 ; "INTERVAL" + PUSH HL + LD HL,IFLG_TIMER ; TIMER - Interrupt flags + JR _TRIG_0 + +; Routine at 30655 +; +; Used by the routine at NOT_KEYWORD. +; STICK(n) function +_TRIG: + LD A,$04 + CALL BYTPPARM ; Get (byte parameter), use A to check its MAX value + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + PUSH HL + LD D,$00 + LD HL,IFLG_STRIG0 ; SPACE key trigger - Interrupt flags + ADD HL,DE + ADD HL,DE + ADD HL,DE +; This entry point is used by the routines at L77A5, L77AB and _INTERVAL. +_TRIG_0: + CALL L77FE + JR __MDM_2 + +; Routine at 30676 +; This entry point is used by the routine at _TRIG and KEY_CONFIG. +L77D4: + CALL GETINT ; Get integer 0-255 + DEC A + CP $0A + JP NC,FC_ERR + LD A,(HL) + PUSH HL + CALL L77E8 + +__MDM_2: + POP HL + POP AF + RST CHRGTB ; Gets next character (or token) from BASIC text. + JP NEWSTT_0 + +; Routine at 30696 +; +; Used by the routine at L77D4. +L77E8: + LD D,$00 + LD HL,FNKSWI + ADD HL,DE + PUSH HL + LD HL,TRPTBL-3 ; BOTTOM+1 + ADD HL,DE + ADD HL,DE + ADD HL,DE + CALL L77FE + LD A,(HL) + AND $01 + POP HL + LD (HL),A + RET + +; Routine at 30718 +; +; Used by the routines at _TRIG and L77E8. +L77FE: + CP TK_ON + JP Z,TIME_S_ON + CP TK_OFF + JP Z,TIME_S_OFF + CP TK_STOP + JP Z,TIME_S_STOP + JP SN_ERR + +; Routine at 30736 +ON_OPTIONS: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HONGO ; Hook for "ON DEVICE GOSUB" +ENDIF + LD BC,$000A ; 1, 10 + CP TK_KEY + RET Z + LD BC,$0A01 ; 10, 1 + CP TK_STOP + RET Z + INC B ; 10, 2 + CP TK_SPRITE + RET Z + CP $FF ; Lower TOKEN codes prefix ? + RET C + PUSH HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + CP TK_TRIG+$80 ; $A3 + JR Z,ON_OPTIONS_1 + + CP TK_INT+$80 ; INTERVAL ? + JR Z,ON_INTERVAL + +ON_OPTIONS_0: + POP HL + SCF + RET + +ON_OPTIONS_1: + POP BC + LD BC,$0C05 ; 12, 5 + RET + +ON_INTERVAL: + RST CHRGTB ; Gets next character (or token) from BASIC text. + CP 'E' ; "INTE.." + JR NZ,ON_OPTIONS_0 + POP BC + RST CHRGTB ; Gets next character (or token) from BASIC text. + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB 'R' ; "INTER.." + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB $FF + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB TK_VAL+$80 ; "INTERVAL" + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB TK_EQUAL ; Token for '=' + CALL GETWORD + LD A,D + OR E + JP Z,FC_ERR + EX DE,HL + LD (INTVAL),HL + LD (INTCNT),HL + EX DE,HL + LD BC,$1101 ; 17, 1 + DEC HL + RET + + +; Routine at 30812 +; +; Used by the routine at L492A. +L785C: + PUSH HL + LD B,A ; compute (B*3)+IENTRY_F1 + ADD A,A + ADD A,B + LD L,A + LD H,$00 + LD BC,TRPTBL+1 ; First entry in the table for interrupt services + ADD HL,BC + LD (HL),E + INC HL + LD (HL),D + POP HL + RET + +; Routine at 30828 +__KEY: + CP TK_LIST ; "KEY LIST" command ? + JR NZ,KEY_CONFIG + RST CHRGTB ; Gets next character (or token) from BASIC text. + PUSH HL + LD HL,FNKSTR + LD C,$0A +__KEY_0: + LD B,$10 +__KEY_1: + LD A,(HL) + INC HL + CALL SNVCHR + JR C,__KEY_2 + DEC B + JR Z,__KEY_5 + LD A,(HL) + INC HL + LD E,A + CALL SNVCHR + JR Z,__KEY_2 + LD A,$01 + RST OUTDO ; Output char to the current device + LD A,E + JR __KEY_4 + +__KEY_2: + CP $7F ; 'DEL' key code + JR Z,__KEY_3 + CP ' ' + JR NC,__KEY_4 +__KEY_3: + LD A,' ' +__KEY_4: + RST OUTDO ; Output char to the current device + DJNZ __KEY_1 +__KEY_5: + CALL OUTDO_CRLF + DEC C + JR NZ,__KEY_0 + POP HL + RET + +; Routine at 30886 +KEY_ON: + RST CHRGTB ; Gets next character (or token) from BASIC text. + JP DSPFNK ; Show the function key display. + +; Routine at 30890 +KEY_OFF: + RST CHRGTB ; Gets next character (or token) from BASIC text. + JP ERAFNK + +; Data block at 30894 +KEY_CONFIG: + CP '(' + JP Z,L77D4 + CP TK_ON ; "KEY ON" + JR Z,KEY_ON + + CP TK_OFF ; "KEY OFF" + JR Z,KEY_OFF + + CALL GETINT ; Get integer 0-255 + DEC A + CP LF + JP NC,FC_ERR + EX DE,HL + LD L,A + LD H,$00 + ADD HL,HL + ADD HL,HL + ADD HL,HL + ADD HL,HL + LD BC,FNKSTR ; FUNCTION KEY AREA + ADD HL,BC + PUSH HL + EX DE,HL + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + CALL EVAL + PUSH HL + CALL GETSTR + LD B,(HL) + INC HL + LD E,(HL) + INC HL + LD D,(HL) + POP HL + EX (SP),HL + LD C,$0F + LD A,B + AND A + JR Z,KEY_CONFIG_1 +KEY_CONFIG_0: + LD A,(DE) + AND A + JP Z,FC_ERR + LD (HL),A + INC DE + INC HL + DEC C + JR Z,KEY_CONFIG_2 + DJNZ KEY_CONFIG_0 +KEY_CONFIG_1: + LD (HL),B + INC HL + DEC C + JR NZ,KEY_CONFIG_1 +KEY_CONFIG_2: + LD (HL),C + CALL FNKSB + POP HL + RET + +; Routine at 30976 +; +; Used by the routine at OPRND. +FN_TIME: + RST CHRGTB ; Gets next character (or token) from BASIC text. + PUSH HL + LD HL,(JIFFY) + CALL INEG2 + POP HL + RET + +; Routine at 30986 +; +; Used by the routine at OPRND. +FN_CSRLIN: + RST CHRGTB ; Gets next character (or token) from BASIC text. + PUSH HL + LD A,(CSRY) + JR FN_PLAY_1 + +; Routine at 30993 +__TIME: + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB TK_EQUAL ; Token for '=' + CALL GETWORD + LD (JIFFY),DE + RET + +; Routine at 31003 +; +; Used by the routine at OPRND. +FN_PLAY: + RST CHRGTB ; Gets next character (or token) from BASIC text. + LD A,$03 ; 3 possible sound channels + CALL BYTPPARM ; Get (byte parameter), use A to check its MAX value + PUSH HL + LD A,(MUSICF) + DEC E + JP M,FN_PLAY_3 +FN_PLAY_0: + RRCA + DEC E + JP P,FN_PLAY_0 + LD A,$00 + JR NC,FN_PLAY_2 +; This entry point is used by the routine at FN_CSRLIN. +FN_PLAY_1: + DEC A +FN_PLAY_2: + CALL CONIA ;CONVERT [A] TO AN INTEGER SIGNED + POP HL + RET + +FN_PLAY_3: + AND $07 + JR Z,FN_PLAY_2 + LD A,$FF + JR FN_PLAY_2 + +; Routine at 31040 +__STICK: + CALL CONINT + CP $03 + JR NC,__STRIG_0 + CALL GTSTCK + JR __PDL_0 + +; Routine at 31052 +__STRIG: + CALL CONINT + CP $05 +; This entry point is used by the routines at __STICK, __PDL and __PAD. +__STRIG_0: + JP NC,FC_ERR + CALL GTTRIG +; This entry point is used by the routine at __PAD. +__STRIG_1: + JP CONIA ;CONVERT [A] TO AN INTEGER SIGNED + +; Routine at 31066 +__PDL: + CALL CONINT + DEC A + CP $0C + JR NC,__STRIG_0 + INC A + CALL GTPDL +; This entry point is used by the routines at __STICK and __PAD. +__PDL_0: + JP PASSA + +; Routine at 31081 +__PAD: + CALL CONINT + CP $08 + JR NC,__STRIG_0 + PUSH AF + CALL GTPAD + LD B,A + POP AF + AND $03 + DEC A + CP $02 + LD A,B + JR C,__PDL_0 + JR __STRIG_1 + +; Routine at 31104 +__COLOR: + LD BC,FC_ERR ; Default addr to exit to if out of range + PUSH BC + LD DE,(FORCLR) + PUSH DE + CP ',' + JR Z,__COLOR_0 + CALL GETINT ; Get integer 0-255 + POP DE + CP $10 ; 16 colors + RET NC + LD E,A + PUSH DE + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + JR Z,__COLOR_2 +__COLOR_0: + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + JR Z,__COLOR_2 + CP ',' + JR Z,__COLOR_1 + CALL GETINT ; Get integer 0-255 + POP DE + CP $10 ; 16 colors + RET NC + LD D,A + PUSH DE + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + JR Z,__COLOR_2 +__COLOR_1: + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + CALL GETINT ; Get integer 0-255 + POP DE + CP $10 ; 16 colors + RET NC + LD (BDRCLR),A + PUSH DE +__COLOR_2: + POP DE + POP AF ; Remove "FC_ERR" on exit + PUSH HL + EX DE,HL + LD (FORCLR),HL + LD A,L + LD (ATRBYT),A + CALL CHGCLR + POP HL + RET + +; Routine at 31180 +; SCREEN ,,,, +__SCREEN: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HSCRE ; Hook for "SCREEN" +ENDIF + CP ',' + JR Z,__SCREEN_0 + CALL GETINT ; Get integer 0-255 + CP $04 + JP NC,FC_ERR + PUSH HL + CALL CHGMOD ; Sets the VDP mode according to SCRMOD. + LD A,(LINLEN) + LD E,A + CALL __WIDTH_4 + POP HL + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + RET Z +__SCREEN_0: + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + CP ',' + JR Z,__SCREEN_1 + CALL GETINT ; Get integer 0-255 + CP $04 + JP NC,FC_ERR + LD A,(RG1SAV) + AND $FC + OR E + LD (RG1SAV),A + PUSH HL + CALL CLRSPR + POP HL + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + RET Z +__SCREEN_1: + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + CP ',' + JR Z,__SCREEN_2 + CALL GETINT ; Get integer 0-255 + LD (CLIKSW),A + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + RET Z +__SCREEN_2: + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + CP ',' + JR Z,SET_PRINTERTYPE + CALL SET_BAUDRATE + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + RET Z + +SET_PRINTERTYPE: + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + CALL GETINT ; Get integer 0-255 + LD (NTMSXP),A + RET + +; Routine at 31277 +; +; Used by the routines at __CSAVE and __SCREEN. +SET_BAUDRATE: + CALL GETINT ; Get integer 0-255 + DEC A + CP $02 + JP NC,FC_ERR + PUSH HL + LD BC,$0005 + AND A + LD HL,CS120 ; 1200 bps + JR Z,SET_BAUDRATE_0 + ADD HL,BC ; HL=CS240: 2400 BPS + +SET_BAUDRATE_0: + LD DE,LOW + LDIR ; Copy to 'LOW', 'HIGH' and 'HEADER' delay counters + POP HL + RET + +; Routine at 31304 +__SPRITE: + CP $24 + JP NZ,L77AB + LD A,(SCRMOD) + AND A + JP Z,FC_ERR + CALL GET_HEXBYTE + PUSH DE + CALL FRMEQL + EX (SP),HL + PUSH HL + CALL GETSTR + INC HL + LD E,(HL) + INC HL + LD D,(HL) + CALL GSPSIZ + LD C,A + LD B,$00 + DEC HL + DEC HL + DEC A + CP (HL) + LD A,(HL) + JR C,__SPRITE_0 + POP HL + PUSH HL + PUSH AF + XOR A + CALL FILVRM + POP AF + AND A + LD C,A + LD B,$00 +__SPRITE_0: + EX DE,HL + POP DE + CALL NZ,LDIRVM + POP HL + RET + +; Routine at 31364 +; +; Used by the routine at OPRND. +FN_SPRITE: + CALL GETNEXT_HEXBYTE + PUSH HL + PUSH DE + CALL GSPSIZ + LD C,A + LD B,$00 + PUSH BC + CALL MKTMST ; Make temporary string + LD HL,(TMPSTR) + EX DE,HL + POP BC + POP HL + CALL LDIRMV + JP TSTOPL + +; Routine at 31391 +; +; Used by the routine at FN_SPRITE. +GETNEXT_HEXBYTE: + RST CHRGTB ; Gets next character (or token) from BASIC text. + +; This entry point is used by the routine at __SPRITE. +GET_HEXBYTE: + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB '$' + LD A,$FF ; A whole byte range + CALL BYTPPARM ; Get (byte parameter), use A to check its MAX value + PUSH HL + LD A,E + CALL CALPAT + EX DE,HL + POP HL + RET + +; Routine at 31407 +; +; Used by the routine at L7756. +PUT_SPRITE: + DEC B + JP M,FC_ERR + LD A,(SCRMOD) + AND A + JP Z,FC_ERR + RST CHRGTB ; Gets next character (or token) from BASIC text. + CALL GETINT ; Get integer 0-255 + CP 32 + JP NC,FC_ERR + PUSH HL + CALL CALATR + EX (SP),HL + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + CP ',' + JR Z,PUT_SPRITE_1 + CALL SCAN1 + EX (SP),HL + LD A,E + CALL WRTVRM + LD A,B + ADD A,A + LD A,C + LD B,$00 + JR NC,PUT_SPRITE_0 + ADD A,$20 + LD B,$80 +PUT_SPRITE_0: + INC HL + CALL WRTVRM + INC HL + INC HL + CALL RDVRM + AND $0F + OR B + CALL WRTVRM + DEC HL + DEC HL + DEC HL + EX (SP),HL + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + POP BC + RET Z + PUSH BC +PUT_SPRITE_1: + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + CP ',' + JR Z,PUT_SPRITE_2 + CALL GETINT ; Get integer 0-255 + CP $10 + JP NC,FC_ERR + EX (SP),HL + INC HL + INC HL + INC HL + CALL RDVRM + AND $80 + OR E + CALL WRTVRM + DEC HL + DEC HL + DEC HL + EX (SP),HL + DEC HL + RST CHRGTB ; Gets next character (or token) from BASIC text. + POP BC + RET Z + PUSH BC +PUT_SPRITE_2: + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + CALL GETINT ; Get integer 0-255 + CALL GSPSIZ + LD A,E + JR NC,PUT_SPRITE_3 + CP $40 + JP NC,FC_ERR + ADD A,A + ADD A,A +PUT_SPRITE_3: + EX (SP),HL + INC HL + INC HL + CALL WRTVRM + POP HL + RET + +; Routine at 31543 +__VDP: + LD A,$07 + CALL BYTPPARM ; Get (byte parameter), use A to check its MAX value + PUSH DE + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB TK_EQUAL ; Token for '=' + CALL GETINT ; Get integer 0-255 + POP BC + LD B,A + JP WRTVDP + +; Routine at 31559 +; +; Used by the routine at OPRND. +FN_VDP: + RST CHRGTB ; Gets next character (or token) from BASIC text. + LD A,$08 + CALL BYTPPARM ; Get (byte parameter), use A to check its MAX value + PUSH HL + LD D,$00 + LD HL,RG0SAV + ADD HL,DE + LD A,(HL) + CALL PASSA + POP HL + RET + +; Routine at 31578 +__BASE: + LD A,$13 + CALL BYTPPARM ; Get (byte parameter), use A to check its MAX value + LD D,$00 + PUSH DE + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB TK_EQUAL ; Token for '=' + CALL EVAL + EX (SP),HL + PUSH HL + CALL PARMADDR ; get address parameter + LD C,L + LD B,H + POP HL + LD A,L + PUSH AF + ADD HL,HL + EX DE,HL + LD HL,L7BA3 + ADD HL,DE + LD A,C + AND (HL) + JR NZ,__BASE_0 + INC HL + LD A,B + AND (HL) +__BASE_0: + JP NZ,FC_ERR + LD HL,TXTNAM + ADD HL,DE + LD (HL),C + INC HL + LD (HL),B + POP AF + LD E,$FF +__BASE_1: + INC E + SUB $05 + JR NC,__BASE_1 + LD A,(SCRMOD) + CP E + CALL Z,L7B99 + POP HL + RET + +; Routine at 31641 +; +; Used by the routine at __BASE. +L7B99: + DEC A + JP M,SETTXT + JP Z,SETGRP + JP SETMLT + +; Routine at 31651 +L7BA3: + DEFB $ff,$03, $3f,$00, $ff,$07, $7f,$00, $ff,$07 + DEFB $ff,$03, $3f,$00, $ff,$07, $7f,$00, $ff,$07 + DEFB $ff,$03, $ff,$1f, $ff,$1f, $7f,$00, $ff,$07 + DEFB $ff,$03, $3f,$00, $ff,$07, $7f,$00, $ff,$07 + +; This entry point is used by the routine at OPRND. +FN_BASE: + RST CHRGTB ; Gets next character (or token) from BASIC text. + LD A,$13 + CALL BYTPPARM ; Get (byte parameter), use A to check its MAX value + PUSH HL + LD D,$00 + LD HL,TXTNAM + ADD HL,DE + ADD HL,DE +; This entry point is used by the routine at BYTPPARM. +FN_BASE_1: + LD A,(HL) + INC HL + LD H,(HL) + LD L,A + CALL INEG2 + POP HL + RET + +; Routine at 31714 +__VPOKE: + CALL EVAL + PUSH HL + CALL PARMADDR ; get address parameter + EX (SP),HL + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ',' + CALL GETINT ; Get integer 0-255 + EX (SP),HL + CALL WRTVRM + POP HL + RET + +; Routine at 31733 +__VPEEK: + CALL PARMADDR ; get address parameter + CALL RDVRM + JP PASSA + +; Routine at 31742 +; +; Used by the routines at __BASE, __VPOKE and __VPEEK. +PARMADDR: + CALL __CINT + LD DE,$4000 + RST DCOMPR ; Compare HL with DE. + RET C + JR _FC_ERR_B + +; Routine at 31752 +; +; Used by the routines at _TRIG, FN_PLAY, GETNEXT_HEXBYTE, __VDP, FN_VDP, __BASE and L7BA3. +; Get (byte parameter), use A to check its MAX value +BYTPPARM: + PUSH AF + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB '(' + CALL GETINT ; Get integer 0-255 + POP AF + CP E + JR C,_FC_ERR_B + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB ')' + LD A,E + RET + +; Routine at 31766 +__DSKO_S: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HDSKO ; Hook for "DSKO$" +ENDIF + JR _FC_ERR_B + +; Routine at 31771 +__SET: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HSETS ; Hook for SET +ENDIF + JR _FC_ERR_B + +; Routine at 31776 +__NAME: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HNAME ; Hook for NAME +ENDIF + JR _FC_ERR_B + +; Routine at 31781 +__KILL: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HKILL ; Hook for KILL +ENDIF + JR _FC_ERR_B + +; Routine at 31786 +__IPL: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HIPL ; Hook for IPL +ENDIF + JR _FC_ERR_B + +; Routine at 31791 +__COPY: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HCOPY ; Hook for COPY +ENDIF + JR _FC_ERR_B + +; Routine at 31796 +__CMD: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HCMD ; Hook for CMD +ENDIF + JR _FC_ERR_B + +; Routine at 31801 +__DSKF: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HDSKF ; Hook for DSKF +ENDIF + JR _FC_ERR_B + +; Routine at 31806 +; +; Used by the routine at OPRND. +FN_DSKI: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HDSKI ; Hook for DSKI$ +ENDIF + JR _FC_ERR_B + +; Routine at 31811 +; +; Used by the routine at OPRND. +FN_ATTR: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HATTR ; Hook for ATTR$ +ENDIF + JR _FC_ERR_B + + + +;LSET/RSET stringvar = stringexp +; +; If stringvar points to an I/O buffer, use the string size to +; justify string. If stringvar is a literal, make new var with length +; of literal. If stringvar points to string space, use it. If the +; length of the variable is zero, return the null string. If a copy +; must be created, and stringexp is a temporary, use this space over +; unless length stringvar greater than stringexp. + + +; Routine at 31816 +__LSET: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HLSET ; Hook for LSET +ENDIF + JR _FC_ERR_B + +; Routine at 31821 +__RSET: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HRSET ; Hook for RSET +ENDIF + JR _FC_ERR_B + +; Routine at 31826 +__FIELD: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HFIEL ; Hook for FIELD +ENDIF + JR _FC_ERR_B + +; Routine at 31831 +__MKI_S: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HMKI_S ; Hook for MKI$ +ENDIF + JR _FC_ERR_B + +; Routine at 31836 +__MKS_S: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HMKS_S ; Hook for MKS$ +ENDIF + JR _FC_ERR_B + +; Routine at 31841 +__MKD_S: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HMKD_S ; Hook for MKD$ +ENDIF + JR _FC_ERR_B + +; Routine at 31846 +__CVI: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HCVI ; Hook for CVI +ENDIF + JR _FC_ERR_B + +; Routine at 31851 +__CVS: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HCVS ; Hook for CVS +ENDIF + JR _FC_ERR_B + +; Routine at 31856 +__CVD: +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 3 + ENDIF +ELSE + CALL HCVD ; Hook for CVD +ENDIF +; This entry point is used by the routines at PARMADDR, BYTPPARM, __DSKO_S, __SET, +; __NAME, __KILL, __IPL, __COPY, __CMD, __DSKF, FN_DSKI, FN_ATTR, __LSET, __RSET, +; __FIELD, __MKI_S, __MKS_S, __MKD_S, __CVI and __CVS. +_FC_ERR_B: + JP FC_ERR + +; Routine at 31862 +; +; Used by the routine at CSTART. +_CSTART: + LD SP,STACK_INIT +IF NOHOOK + IF PRESERVE_LOCATIONS + DEFS 13 + ENDIF +ELSE + LD BC,$022F ; HOOK table size + LD DE,HKEYI+1 + LD HL,HKEYI ; First Entry in the Hook Table + LD (HL),$C9 ; 'RET' + LDIR +ENDIF + LD HL,RDPRIM ; First location in the System variables region + LD (HIMEM),HL + CALL BASE_RAM + LD (BOTTOM),HL + + LD BC,$0090 ; > $0076 crashes the SVI + LD DE,RDPRIM ; Prepare System variables region, first location is $F380 (RDPRIM) + LD HL,__RDPRIM ; + LDIR + + ;CALL INIT32 + ;HALT + + CALL INIFNK ; Init FN KEY region, starts at $F87F + XOR A + LD (ENDBUF),A + LD (NLONLY),A + LD A,',' + LD (BUFMIN),A ; a comma just before BUF.. used, e.g. in "FILSTI" + LD A,':' + LD (BUFFER),A ; a colon for restarting input + LD HL,(FONT) ; Point to CHFONT in ROM + LD (CHFONT),HL + LD HL,PRMSTK ; Previous definition block on stack + LD (PRMPRV),HL + LD (STKTOP),HL + LD BC,$00C8 ; 200 + ADD HL,BC + LD (MEMSIZ),HL + LD A,$01 + LD (VARTAB+1),A + CALL MAXFILES + CALL CLREG ; Clear registers and warm boot + LD HL,(BOTTOM) + XOR A + LD (HL),A + INC HL + LD (TXTTAB),HL + CALL CLRPTR + CALL INITIO + CALL INIT32 + CALL CLRSPR + LD HL,$0A0B ; Cursor Position: + LD (CSRY),HL + LD HL,MSX_MSG ; "MSX System" + CALL PRS + LD HL,$0A0C ; Cursor Position: + LD (CSRY),HL + LD HL,VER_MSG + CALL PRS +IF SPECTRUM_SKIN + LD HL,$060E ; Cursor Position: +ELSE + LD HL,$020E ; Cursor Position: +ENDIF + LD (CSRY),HL + LD HL,COPYRIGHT_MSG + CALL PRS + LD B,$06 +_CSTART_0: + DEC HL + LD A,L + OR H + JR NZ,_CSTART_0 + LD B,$00 + CALL L7D75 + LD HL,(BOTTOM) + XOR A + LD (HL),A + INC HL + LD (TXTTAB),HL + CALL CLRPTR + CALL BANNER + JP READY + +; Routine at 32041 +; +; Used by the routine at _CSTART. +; Initial "copyright" message on top of the screen +; The "DISK BASIC" extension calls it directly skipping the +; above call (adds the "DISK BASIC" message), so this can't be easily relocated +; (probably HOOKS need to be disabled in this case) +BANNER: + LD A,$FF + LD (CNSDFG),A ; FN key status +IF SPECTRUM_SKIN + CALL INIT32 +ELSE + CALL INITXT +ENDIF + LD HL,BASIC_MSG + CALL PRS + LD HL,VER_MSG + CALL PRS + LD HL,COPYRIGHT_MSG + CALL PRS + LD HL,(VARTAB) + EX DE,HL + LD HL,(STKTOP) + ; HL=HL-DE + LD A,L + SUB E + LD L,A + LD A,H + SBC A,D + LD H,A + ; + LD BC,$FFF2 ; -14 + ADD HL,BC + CALL LINPRT + LD HL,BYTES_MSG + JP PRS + +; Routine at 32093 +; +; Used by the routine at _CSTART. +; Programs mostly start on 0x8000 (if not otherwise descripted by TXTTAB) +BASE_RAM: + LD HL,$8000 ; 32768 +; This entry point is used by the routine at L7D61. +JUST_RET: + RET + +; Routine at 32097 +L7D61: + CPL + LD (HL),A + CP (HL) + CPL + LD (HL),A + JR NZ,L7D61_0 + INC L + JR NZ,JUST_RET + LD A,H + DEC A + RET P + LD H,A + JR JUST_RET +L7D61_0: + LD L,$00 + INC H + RET + +; Routine at 32117 +; +; Used by the routine at _CSTART. +L7D75: + DI + LD C,$00 + LD DE,EXP0 ; Expansion slot #0 + LD HL,SLTATR +L7D75_0: + LD A,(DE) + OR C + LD C,A + PUSH DE +L7D75_1: + INC HL + PUSH HL + LD HL,$4000 +L7D75_2: + CALL RDSLT_WORD + PUSH HL + LD HL,$4241 + RST DCOMPR ; Compare HL with DE. + POP HL + LD B,$00 + JR NZ,L7D75_3 + CALL RDSLT_WORD + PUSH HL + PUSH BC + PUSH DE + POP IX + LD A,C + PUSH AF + POP IY + CALL NZ,CALSLT + POP BC + POP HL + CALL RDSLT_WORD + ADD A,$FF + RR B + CALL RDSLT_WORD + ADD A,$FF + RR B + CALL RDSLT_WORD + ADD A,$FF + RR B + LD DE,$FFF8 ; -8 + ADD HL,DE +L7D75_3: + EX (SP),HL + LD (HL),B + INC HL + EX (SP),HL + LD DE,$3FFE + ADD HL,DE + LD A,H + CP $C0 + JR C,L7D75_2 + POP HL + INC HL + LD A,C + AND A + LD DE,RDSLT + JP P,L7DDF+1 + ADD A,$04 + LD C,A + CP $90 + JR C,L7D75_1 + AND $03 + LD C,A +L7DDF: + ; L7DDF+1: ADD HL,DE + LD A,$19 + POP DE + INC DE + INC C + LD A,C + CP $04 + JR C,L7D75_0 + LD HL,SLTATR + LD B,$40 +L7DEE: + LD A,(HL) + ADD A,A + JR C,L7D75_5 + INC HL + DJNZ L7DEE + RET + +L7D75_5: + CALL L7E2A + CALL ENASLT + LD HL,(VARTAB) + LD DE,$C000 + RST DCOMPR ; Compare HL with DE. + JR NC,L7D75_6 + EX DE,HL + LD (VARTAB),HL +L7D75_6: + LD HL,($8008) ; Programs mostly start on 0x8000 (if not otherwise descripted by TXTTAB) + INC HL + LD (TXTTAB),HL + LD A,H + LD (BASROM),A + CALL RUN_FST + JP NEWSTT + +; Routine at 32282 +; +; Used by the routines at __CALL, L55F8, L564A and L7D75. +RDSLT_WORD: + CALL RDSLT_WORD_0 + LD E,D +RDSLT_WORD_0: + LD A,C + PUSH BC + PUSH DE + CALL RDSLT + POP DE + POP BC + LD D,A + OR E + INC HL + RET + +; Routine at 32298 +; +; Used by the routines at __CALL, L55F8 and L7D75. +L7E2A: + LD A,$40 + SUB B +; This entry point is used by the routine at L564A. +L7E2A_0: + LD B,A + LD H,$00 + RRA + RR H + RRA + RR H + RRA + RRA + AND $03 + LD C,A + LD A,B + LD B,$00 + PUSH HL + LD HL,EXP0 ; Expansion slot #0 + ADD HL,BC + AND $0C + OR C + LD C,A + LD A,(HL) + POP HL + OR C + RET + +; Routine at 32331 +__MAX: + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB TK_FILES + RST SYNCHR ; Check syntax: next byte holds the byte to be found + DEFB TK_EQUAL ; Token for '=' + CALL GETINT ; Get integer 0-255 + JP NZ,SN_ERR + CP $10 + JP NC,FC_ERR + LD (TEMP),HL + PUSH AF + CALL CLSALL ; Close all files + POP AF + CALL MAXFILES + CALL _CLREG + JP NEWSTT + +; Routine at 32363 +; +; Used by the routines at __CLEAR, _CSTART and __MAX. +; clear files ? +MAXFILES: + PUSH AF + LD HL,(HIMEM) + LD DE,$FEF5 ; -267 (same offset on Tandy model 100) +MAXFILES_0: + ADD HL,DE + DEC A + JP P,MAXFILES_0 + EX DE,HL + LD HL,(STKTOP) + LD B,H + LD C,L + LD HL,(MEMSIZ) + LD A,L + SUB C + LD L,A + LD A,H + SBC A,B + LD H,A + POP AF + PUSH HL + PUSH AF + LD BC,$008C ; 140 + ADD HL,BC + LD B,H + LD C,L + LD HL,(VARTAB) + ADD HL,BC + RST DCOMPR ; Compare HL with DE. + JP NC,OM_ERR + POP AF + LD (MAXFIL),A + LD L,E + LD H,D + LD (FILTAB),HL + DEC HL + DEC HL + LD (MEMSIZ),HL + POP BC + LD A,L + SUB C + LD L,A + LD A,H + SBC A,B + LD H,A + LD (STKTOP),HL + DEC HL + DEC HL + POP BC + LD SP,HL + PUSH BC + LD A,(MAXFIL) + LD L,A + INC L + LD H,$00 + ADD HL,HL + ADD HL,DE + EX DE,HL + PUSH DE + LD BC,$0109 ; 265 +MAXFILES_1: + LD (HL),E + INC HL + LD (HL),D + INC HL + EX DE,HL + LD (HL),$00 + ADD HL,BC + EX DE,HL + DEC A + JP P,MAXFILES_1 + POP HL + LD BC,$0009 + ADD HL,BC + LD (NULBUF),HL + RET + +; Message at 32472 +MSX_MSG: + DEFM "MSX system" + DEFB $00 +VER_MSG: + DEFM "version 1.0" + DEFB CR + DEFB LF + DEFB $00 +BASIC_MSG: + DEFM "MSX BASIC " + DEFB $00 +COPYRIGHT_MSG: +IF SPECTRUM_SKIN + DEFB 127 + DEFM " 1983 by Microsoft" +ELSE + DEFM "Copyright 1983 by Microsoft" +ENDIF + DEFB CR + DEFB LF + DEFB $00 +BYTES_MSG: + DEFM " Bytes free" + DEFB $00 + + +;---------------------------------------------------- +;-- THE NEXT $ 90 BYTES WILL BE RELOCATED AT $F380 -- +;---------------------------------------------------- + +; Routine at 32551 ($7F27 -> $F380) +__RDPRIM: + OUT (PPI_AOUT),A + LD E,(HL) + JR __WRPRIM_0 + +DEFC SYSV_DELTA = RDPRIM-__RDPRIM + +; Routine at 32556 ($7F2C -> $F385) +__WRPRIM: + OUT (PPI_AOUT),A + LD (HL),E + +__WRPRIM_0: + LD A,D + OUT (PPI_AOUT),A + RET + +; Routine at 32563 ($F733 -> $F38C) +__CLPRIM: + OUT (PPI_AOUT),A + EX AF,AF' + CALL CALLIX + SYSV_DELTA ; CALL (IX) + EX AF,AF' + POP AF + OUT (PPI_AOUT),A + EX AF,AF' + RET + +CALLIX: JP (IX) ; ($7F3F -> $F398) +; CALLIX+1: JP (HL) ; ($7F40 -> $F399) + +; USR0 ($7F3F -> $F39A) +USR_JPTAB: + DEFW FC_ERR ; USR0 + DEFW FC_ERR ; USR1 + DEFW FC_ERR ; USR2 + DEFW FC_ERR ; USR3 + DEFW FC_ERR ; USR4 + DEFW FC_ERR ; USR5 + DEFW FC_ERR ; USR6 + DEFW FC_ERR ; USR7 + DEFW FC_ERR ; USR8 + DEFW FC_ERR ; USR9 + + DEFB 37 ; LINL40: Width for SCREEN 0 + DEFB 29 ; LINL32: Width for SCREEN 1 + DEFB 29 ; LINLEN: Width for the current text mode + DEFB 24 ; CRTCNT: Columns + DEFB 14 ; CLMLST: Column space. + + DEFW 0 ; TXTNAM: SCREEN 0 name table + DEFW 0 ; TXTCOL: SCREEN 0 color table + DEFW $0800 ; TXTCGP: SCREEN 0 character pattern table + DEFW 0 ; TXTATR: SCREEN 0 Sprite Attribute Table + DEFW 0 ; TXTPAT: SCREEN 0 Sprite Pattern Table + + DEFW $1800 ; T32NAM: SCREEN 1 name table + DEFW $2000 ; T32COL: SCREEN 1 color table + DEFW 0 ; T32CGP: SCREEN 1 character pattern table + DEFW $1B00 ; T32ATR: SCREEN 1 Sprite Attribute Table + DEFW $3800 ; T32PAT: SCREEN 1 Sprite Pattern Table + + DEFW $1800 ; GRPNAM: SCREEN 2 name table + DEFW $2000 ; GRPCOL: SCREEN 2 color table + DEFW 0 ; GRPCGP: SCREEN 2 character pattern table + DEFW $1B00 ; GRPATR: SCREEN 2 Sprite Attribute Table + DEFW $3800 ; GRPPAT: SCREEN 2 Sprite Pattern Table + + DEFW $0800 ; MLTNAM: SCREEN 3 name table + DEFW 0 ; MLTCOL: SCREEN 3 color table + DEFW 0 ; MLTCGP: SCREEN 3 character pattern table + DEFW $1B00 ; MLTATR: SCREEN 3 Sprite Attribute Table + DEFW $3800 ; MLTPAT: SCREEN 3 Sprite Pattern Table + + DEFB 1 ; CLIKSW: keyboard click status + DEFB 1 ; CSRY : Current row position of the cursor + DEFB 1 ; CSRX : Current column position of the cursor + DEFB 0 ; CNSDFG: function keys status + + DEFB $00 ; RG0SAV: Copy of VDP Register #0 + DEFB $E0 ; RG1SAV: Copy of VDP Register #1 + DEFB $00 ; RG2SAV: Copy of VDP Register #2 + DEFB $00 ; RG3SAV: Copy of VDP Register #3 + DEFB $00 ; RG4SAV: Copy of VDP Register #4 + DEFB $00 ; RG5SAV: Copy of VDP Register #5 + DEFB $00 ; RG6SAV: Copy of VDP Register #6 + DEFB $00 ; RG7SAV: Copy of VDP Register #7 + + DEFB $00 ; STATFL: Content of VDP(8) status register + DEFB $FF ; TRGFLG: trigger buttons and space bar status +IF SPECTRUM_SKIN + DEFB 1 ; FORCLR: Foreground color + DEFB 14 ; BAKCLR: Background color + DEFB 14 ; BDRCLR: Border color +ELSE + DEFB 15 ; FORCLR: Foreground color + DEFB 4 ; BAKCLR: Background color + DEFB 4 ; BDRCLR: Border color +ENDIF + + JP 0 ; ($7F94 -> $F3EC) Jump instruction used by Basic LINE command. (RIGHTC, LEFTC, UPC and DOWNC) + JP 0 ; ($7F96 -> $F3EF) Jump instruction used by Basic LINE command. (RIGHTC, LEFTC, UPC and DOWNC + + DEFB $0F ; ATRBYT: Attribute byte (for graphical routines it’s used to read the color) + + DEFW $F959 ; QUEUES: Address of the queue table for 'PLAY' + DEFB $FF ; FRCNEW: CLOAD flag + + DEFB 1 ; SCNCNT: Key scan timing + DEFB 50 ; REPCNT: Key repeat delay counter + +L7FFF: + DEFW KEYBUF ; PUTPNT: Keyboard buffer write position + DEFW KEYBUF ; GETPNT: Keyboard buffer read position + +; CS120 Cassette I/O parameters to use for 1200 baud + DEFW $5C53 ; LOW - Signal delay when writing a 0 to tape + DEFW $2D26 ; HIGH - Signal delay when writing a 1 to tape ($4D52 on SVI) + DEFB $0F ; HEADER - Delay of tape header (sync.) block + +; CS240 - Cassette I/O parameters to use for 2400 baud + DEFW $2D25 ; LOW - Signal delay when writing a 0 to tape + DEFW $160E ; HIGH - Signal delay when writing a 1 to tape ($4D52 on SVI) + DEFB $1F ; HEADER - Delay of tape header (sync.) block + +; Default Cassette I/O parameters (1200 baud) + DEFW $5C53 ; LOW - Signal delay when writing a 0 to tape + DEFW $2D26 ; HIGH - Signal delay when writing a 1 to tape ($4D52 on SVI) + DEFB $0F ; HEADER - Delay of tape header (sync.) block + + DEFW $0100 ; ASPCT1 Horizontal / Vertical aspect for CIRCLE command + DEFW $0100 ; ASPCT2 Horizontal / Vertical aspect for CIRCLE command + +; "RESUME NEXT" ($7FB6 -> $F40F) +; ENDCON: +; + DEFB ':' ; SAVTXT often points to this value (copied to "ENDCON" in RAM) +L7FB7: + LD DE,PROCNM ; $FD89 + AND A + RET NZ + INC B + RET + + + + +L0END: + defs $8000-L0END + diff --git a/tests/restricted/msxbasic.def b/tests/restricted/msxbasic.def new file mode 100644 index 00000000..5d532e33 --- /dev/null +++ b/tests/restricted/msxbasic.def @@ -0,0 +1,458 @@ +lstoff + +; MSX BASIC and SYSTEM VARIABLES definitions +; +; December 2019 +; $Id: msxbasic.def $ +; + + +defc VDP_RP = $0006 ; address of vdp READ port +defc VDP_WP = $0007 ; address of vdp WRITE port +defc MSX_VER = $002D ; MSX version (0 = MSX1, 1 = MSX2) + +; System variables + +defc MAXRAM = $F380 ;Beginnning of system variables' space + +; SUBROUTINES FOR READ/WRITE CALLS OF THE INTER-SLOT +defc RDPRIM = $F380 ;5 Routine that reads from a primary slot +defc WRPRIM = $F385 ;7 Routine that writes to a primary slot +defc CLPRIM = $F38C ;14 Routine that calls a routine in a primary slot +defc USRTAB = $F39A ;2 Address to call with Basic USR0 +defc USR0 = $F39A ;2 Address to call with Basic USR0 +defc USR1 = $F39C ;2 Address to call with Basic USR1 +defc USR2 = $F39E ;2 Address to call with Basic USR2 +defc USR3 = $F3A0 ;2 Address to call with Basic USR3 +defc USR4 = $F3A2 ;2 Address to call with Basic USR4 +defc USR5 = $F3A4 ;2 Address to call with Basic USR5 +defc USR6 = $F3A6 ;2 Address to call with Basic USR6 +defc USR7 = $F3A8 ;2 Address to call with Basic USR7 +defc USR8 = $F3AA ;2 Address to call with Basic USR8 +defc USR9 = $F3AC ;2 Address to call with Basic USR9 +defc LINL40 = $F3AE ;1 Width for SCREEN 0 (default 37) +defc LINL32 = $F3AF ;1 Width for SCREEN 1 (default 29) +defc LINLEN = $F3B0 ;1 Width for the current text mode +defc CRTCNT = $F3B1 ;1 Number of lines on screen +defc CLMLST = $F3B2 ;1 Column space, used to be updated with 'WIDTH', on MSX it is automatic (32/40 columns)) + + +; VIDEO VARIABLES DEPENDING ON MODE +defc TXTNAM = $F3B3 ;2 BASE(0) - SCREEN 0 name table +defc TXTCOL = $F3B5 ;2 BASE(1) - SCREEN 0 color table +defc TXTCGP = $F3B7 ;2 BASE(2) - SCREEN 0 character pattern table +defc TXTATR = $F3B9 ;2 BASE(3) - SCREEN 0 Sprite Attribute Table +defc TXTPAT = $F3BB ;2 BASE(4) - SCREEN 0 Sprite Pattern Table + +defc T32NAM = $F3BD ;2 BASE(5) - SCREEN 1 name table +defc T32COL = $F3BF ;2 BASE(6) - SCREEN 1 color table +defc T32CGP = $F3C1 ;2 BASE(7) - SCREEN 1 character pattern table +defc T32ATR = $F3C3 ;2 BASE(8) - SCREEN 1 sprite attribute table +defc T32PAT = $F3C5 ;2 BASE(9) - SCREEN 1 sprite pattern table + +defc GRPNAM = $F3C7 ;2 BASE(10) - SCREEN 2 name table +defc GRPCOL = $F3C9 ;2 BASE(11) - SCREEN 2 color table +defc GRPCGP = $F3CB ;2 BASE(12) - SCREEN 2 character pattern table +defc GRPATR = $F3CD ;2 BASE(13) - SCREEN 2 sprite attribute table +defc GRPPAT = $F3CF ;2 BASE(14) - SCREEN 2 sprite pattern table + +defc MLTNAM = $F3D1 ;2 BASE(15) - SCREEN 3 name table +defc MLTCOL = $F3D3 ;2 BASE(16) - SCREEN 3 color table +defc MLTCGP = $F3D5 ;2 BASE(17) - SCREEN 3 character pattern table +defc MLTATR = $F3D7 ;2 BASE(18) - SCREEN 3 sprite attribute table +defc MLTPAT = $F3D9 ;2 BASE(19) - SCREEN 3 sprite pattern table + +defc CLIKSW = $F3DB ;press click status +defc CSRY = $F3DC ;1 Current row-position of the cursor +defc CSRX = $F3DD ;1 Current column-position of the cursor +defc CNSDFG = $F3DE ;function keys status + + +; AREA TO SAVE VDP REGISTERS +defc RG0SAV = $F3DF ;1 Content of VDP(0) register (R#0) +defc RG1SAV = $F3E0 ;1 Content of VDP(1) register (R#1) +defc RG2SAV = $F3E1 ;1 Content of VDP(2) register (R#2) +defc RG3SAV = $F3E2 ;1 Content of VDP(3) register (R#3) +defc RG4SAV = $F3E3 ;1 Content of VDP(4) register (R#4) +defc RG5SAV = $F3E4 ;1 Content of VDP(5) register (R#5) +defc RG6SAV = $F3E5 ;1 Content of VDP(6) register (R#6) +defc RG7SAV = $F3E6 ;1 Content of VDP(7) register (R#7) +defc STATFL = $F3E7 ;1 Content of VDP(8) status register (S#0) +defc TRGFLG = $F3E8 ;1 Information about trigger buttons and space bar state +defc FORCLR = $F3E9 ;1 Foreground color +defc BAKCLR = $F3EA ;1 Background color +defc BDRCLR = $F3EB ;1 Border color +defc MAXUPD = $F3EC ;3 Jump instruction used by Basic LINE command. The routines used are: RIGHTC, LEFTC, UPC and DOWNC +defc MINUPD = $F3EF ;3 Jump instruction used by Basic LINE command. The routines used are: RIGHTC, LEFTC, UPC and DOWNC +defc ATRBYT = $F3F2 ;1 Attribute byte (for graphical routines it’s used to read the color) + +; WORK AREA FOR PLAY STATEMENT +defc QUEUES = $F3F3 ;2 Address of the queue table +defc FRCNEW = $F3F5 ;1 CLOAD flag + +; WORK AREA FOR KEY INPUT +defc SCNCNT = $F3F6 ;1 Key scan timing +defc REPCNT = $F3F7 ;1 This is the key repeat delay counter +defc PUTPNT = $F3F8 ;2 Address in the keyboard buffer where a character will be written +defc GETPNT = $F3FA ;2 Address in the keyboard buffer where the next character is read +defc CS120 = $F3FC ;5 Cassette I/O parameters to use for 1200 baud +defc CS240 = $F401 ;5 Cassette I/O parameters to use for 2400 baud +defc LOW = $F406 ;2 Signal delay when writing a 0 to tape +defc HIGH = $F408 ;2 Signal delay when writing a 1 to tape +defc HEADER = $F40A ;1 Delay of tape header (sync.) block +defc ASPCT1 = $F40B ;2 Horizontal / Vertical aspect for CIRCLE command +defc ASPCT2 = $F40D ;2 Horizontal / Vertical aspect for CIRCLE command +defc ENDPRG = $F40F ;5 Pointer for the RESUME NEXT command + +; USED BY BASIC INTERNALLY +defc ERRFLG = $F414 ;1 Basic Error code +defc LPTPOS = $F415 ;1 Position of the printer head +defc PRTFLG = $F416 ;1 Printer output flag is read by OUTDO +defc NTMSXP = $F417 ;1 Printer type is read by OUTDO. SCREEN ,,,n writes to this address +defc RAWPRT = $F418 ;1 Raw printer output is read by OUTDO +defc VLZADR = $F419 ;2 Address of data that is temporairly replaced by ‘O’ when Basic function VAL("") is running +defc VLZDAT = $F41B ;1 Original value that was in the address pointed to with VLZADR +defc CURLIN = $F41C ;2 Line number the Basic interpreter is working on, in direct mode it will be filled with #FFFF + +defc BUFFER = $F41E ; byte 0 in input buffer +defc KBUF = $F41F +defc BUFMIN = $F55D ; used in INPUT st. +defc BUF = $F55E ; Buffer to store characters typed( in ASCII code) +defc ENDBUF = $F660 ; Prevent overflow of BUF + +defc TTYPOS = $F661 ; Virtual cursor location internally retained by BASIC +defc DIMFLG = $F662 ; ARRAY FLAG +defc VALTYP = $F663 ; Type indicator +defc OPRTYP = $F664 ; Store operator number in the extended momentarily before operator application +defc DORES = $F664 ; Indicates whether stored word can be crunched +defc DONUM = $F665 ; Flag for crunch +defc CONTXT = $F666 ; Text address used by CNRGET +defc CONSAV = $F668 ; Store token of constant after calling CHRGET +defc CONTYP = $F669 ; Type of stored constant +defc CONLO = $F66A ; Value of stored constant +defc MEMSIZ = $F672 ; Highest location in memory used by BASIC +defc STKTOP = $F674 ; Top location to be used for the stack +defc TXTTAB = $F676 ; Starting address of BASIC text area +defc TEMPPT = $F678 ; Starting address of unused area of temporary descriptor +defc TEMPST = $F67A ; Temporary descriptors +defc VARIABLES = $F689 ; Storage area for BASIC variables + +defc DSCTMP = $F698 ; String descriptor which is the result of string fun. +defc TMPSTR = $F699 ; Temporary string +defc FRETOP = $F69B ; Starting address of unused area of string area +defc TEMP3 = $F69D ; Used for garbage collection or by USR function +defc TEMP8 = $F69F ; Used for garbage collection +defc ENDFOR = $F6A1 ; Next address of FOR st. +defc DATLIN = $F6A3 ; Line number of DATA st.read by READ st. +defc SUBFLG = $F6A5 ; Flag for array for USR fn, 0 if no FOR/NEXT loop in progress, etc... +defc USFLG = $F6A6 +defc FLGINP = $F6A6 ; Flag for INPUT or READ +defc TEMP = $F6A7 ; Location for temporary reservation for st.code +defc PTRFLG = $F6A9 ; =0 if no line number converted to pointers +defc AUTFLG = $F6AA ; AUTO mode flag +defc AUTLIN = $F6AB ; Current line number for auto +defc AUTINC = $F6AD ; Increment for auto +defc SAVTXT = $F6AF ; Pointer to most recent or currently running line (e.g. used by RESUME) +defc SAVSTK = $F6B1 ; Save stack when error occurs +defc ERRLIN = $F6B3 ; Line where last error +defc DOT = $F6B5 ; Current line for edit & list +defc ERRTXT = $F6B7 ; Text pointer for use by RESUME +defc ONELIN = $F6B9 ; LINE to go when error +defc ONEFLG = $F6BB ; =1 if executing an error trap routine +defc NXTOPR = $F6BC ; Next operator in EVAL +defc OLDLIN = $F6BE ; old line number set up ^C ... +defc OLDTXT = $F6C0 ; Points st. to be executed next +defc VARTAB = $F6C2 ; Pointer to start of variable space +defc ARYTAB = $F6C4 ; Pointer to begging of array table +defc STREND = $F6C6 +defc DATPTR = $F6C8 ; DATA pointer +defc DEFTBL = $F6CA ; Default valtype for each letter + +; USER FUNCTION PARAMETERS +defc PRMSTK = $F6E4 ; Previous definition block on stack +defc PRMLEN = $F6E6 ; Number of bytes of objective table +defc PARM1 = $F6E8 ; Objective prameter definition table +defc PRMPRV = $F74C ; Pointer to previous parameter block +defc PRMLN2 = $F74E ; Size of parameter block +defc PARM2 = $F750 ; For parameter storage +defc PRMFLG = $F7B4 ; Flag to indicate whether PARM1 was searching +defc ARYTA2 = $F7B5 ; End point of search +defc NOFUNS = $F7B7 ; 0 if no function active +defc TEMP9 = $F7B8 ; Location of temporary storage for garbage collection +defc FUNACT = $F7BA ; Count of active functions +defc SWPTMP = $F7BC ; Value of first variable in SWAP st. +defc TRCFLG = $F7C4 ; 0 MEANS NO TRACE + +; MATH-PACK +defc FBUFFR = $F7C5 ; Buffer for fout +defc DECTMP = $F7F0 ; Used to transform decimal integer to floating point number +defc DECTM2 = $F7F2 ; Used at division routine execution +defc DECCNT = $F7F4 ; Used at division routine execution +;;defc DAC = $F7F6 ; DECIMAL ACCUMULATOR +defc FACCU = $F7F6 ; alias for DECIMAL ACCUMULATOR +defc FACLOW = $F7F8 ; DECIMAL ACCUMULATOR + 2 +defc HOLD8 = $F806 ; (48 bytes) Double precision operations work area +defc HOLD2 = $F836 ; (8 bytes) +defc HOLD = $F83E ; (9 bytes) +defc ARG = $F847 ; Area to set the value to be calculate with DAC +defc RNDX = $F857 ; Last random number + +; DATA AREA USED BY BASIC INTERPRETER +defc MAXFIL = $F85F ; High legal file number +defc FILTAB = $F860 ; Starting address of of file data area +defc NULBUF = $F862 ; Points to file 0 buffer ( used in SAVE & LOAD st.) +defc PTRFIL = $F864 ; Points to file data of currently accessing file +defc RUNFLG = $F866 ; Non-zero for run after load +defc FILNAM = $F866 ; Name for FILES, NAME & others +defc FILNM2 = $F871 ; Second name for NAME +defc NLONLY = $F87C ; <>0 when loading program +defc SAVEND = $F87D ; End address for BSAVE +defc FNKSTR = $F87F ; FUNCTION KEY AREA +defc CGPNT = $F91F ; Address to store charecter font in ROM +;; defc CGTABL = $0004 ; Found in CBIOS.. does it exist on the regular BIOS too ? +defc SLOTID = $F91F ; 1 Character set SlotID +defc CHFONT = $F920 ; 2 Character set address +defc NAMBAS = $F922 ; Base address of current pattern name table +defc CGPBAS = $F924 ; Base address of current pattern generator table +defc PATBAS = $F926 ; Base address of current sprite generator table +defc ATRBAS = $F928 ; Base address of current sprite attribute table +defc CLOC = $F92A ; (CHKROM/CLOC) +defc CMASK = $F92C +defc MINDEL = $F92D +defc MAXDEL = $F92F + +; DATA AREA FOR CIRCLE STATEMENT +defc ASPECT = $F931 ; Aspect ratio of the circle; set by of CIRCLE +defc CENCNT = $F933 ; End count +defc CLINEF = $F935 ; Flag to draw line to centre +defc CNPNTS = $F936 ; Point to be plottted +defc CPLOTF = $F938 ; Plot polarity flag +defc CPCNT = $F939 ; 1/8 of number of points in circle +defc CPCNT8 = $F93B +defc CRCSUM = $F93D ; CIRCLE sum +defc CSTCNT = $F93F ; CIRCLE start count +defc CSCLXY = $F941 ; Scale of X & Y +defc CSAVEA = $F942 ; reservation area of ADVGRP +defc CSAVEM = $F944 ; reservation area of ADVGRP +defc CXOFF = $F945 ; X offset from center +defc CYOFF = $F947 ; Y offset from center + +; DATA AREA FOR PAINT STATEMENT +defc LOHMSK = $F949 +defc LOHDIR = $F94A +defc LOHADR = $F94B +defc LOHCNT = $F94D +defc SKPCNT = $F94F ; Skip count +defc MOVCNT = $F951 ; Movement count +defc PDIREC = $F953 ; Direction of the paint +defc LFPROG = $F954 +defc RTPROG = $F955 + +defc MCLTAB = $F956 +defc MCLFLG = $F958 + +defc QUETAB = $F959 +defc QUEBAK = $F971 +defc VOICAQ = $F975 +defc VOICBQ = $F9F5 +defc VOICCQ = $FA75 + +; FOR MSX 2 ONLY ? +defc DPPAGE = $FAF5 ; Display page number + +defc ACPAGE = $FAF6 +defc AVCSAV = $FAF7 ; Reserves AV control port +defc EXBRSA = $FAF8 ; 1 Slot address of the SUBROM (EXtended Bios-Rom Slot Address) + +defc CHRCNT = $FAF9 ; Character counter in the buffer used in Roman-Kana translation +defc ROMA = $FAFA ; Area to store character (Japan version only) +defc MODE = $FAFC ; mode svitch for VRAM size +defc NORUSE = $FAFD ; unused +defc XSAVE = $FAFE ; [10000000 XXXXXXXX] +defc YSAVE = $FB00 ; [*0000000 YYYYYYYY] *-light pen interrupt request +defc LOGOPR = $FB02 ; Logical operation code + +; Data area used by RS-232C or disk drive +defc RSTMP = $FB03 +defc TOCNT = $FB03 +defc RSFCB = $FB04 +defc RSIQLN = $FB06 +defc MEXBIH = $FB07 +defc OLDSTT = $FB0C +defc OLDINT = $FB12 +defc DEVNUM = $FB17 +defc DATCNT = $FB18 +defc ERRORS = $FB1B +defc FLAGS = $FB1C +defc ESTBLS = $FB1D +defc COMMSK = $FB1E +defc LSTCOM = $FB1F +defc LSTMOD = $FB20 + +; Data area used by MSX-DOS +defc DRVINF = $FB21 ;1 Nr. of drives connected to disk interface 1 +defc DRVINF1 = $FB21 ;1 Nr. of drives connected to disk interface 1 +defc DISKIF1 = $FB22 ;1 Slot address of disk interface 1 +defc DRVINF2 = $FB23 ;1 Nr. of drives connected to disk interface 2 +defc DISKIF2 = $FB24 ;1 Slot address of disk interface 2 +defc DRVINF3 = $FB25 ;1 Nr. of drives connected to disk interface 3 +defc DISKIF3 = $FB26 ;1 Slot address of disk interface 3 +defc DRVINF4 = $FB27 ;1 Nr. of drives connected to disk interface 4 +defc DISKIF4 = $FB28 ;1 Slot address of disk interface 4 + +defc PRSCNT = $FB35 ; Used by PLAY command in BASIC +defc SAVSP = $FB36 ; " +defc VOICEN = $FB38 ; " +defc SAVVOL = $FB39 ; " +defc MCLLEN = $FB3B ; " +defc MCLPTR = $FB3C ; " +defc QUEUEN = $FB3E +defc MUSICF = $FB3F +defc PLYCNT = $FB40 +defc VCBA = $FB41 +defc VCBB = $FB66 +defc VCBC = $FB8B +defc ENSTOP = $FBB0 ; <>0 if warm start enabled (CTRL+SHIFT+GRPH+KANA/CODE for warm start) +defc BASROM = $FBB1 ; <>0 if basic is in rom (CTRL+STOP disabled) + +defc LINTTB = $FBB2 ; line terminator table (<>0 if line terminates) +defc FSTPOS = $FBCA ; first position for inlin +defc CODSAV = $FBCC ; code save area for cursor +defc FNKSWI = $FBCD ; indicate which func key is displayed +defc FNKFLG = $FBCE ; fkey which have subroutine +defc ONGSBF = $FBD8 ; global event flag +defc CLIKFL = $FBD9 +defc OLDKEY = $FBDA ; (key map) +defc NEWKEY = $FBE5 ; (key map) +defc KEYBUF = $FBF0 ; key code buffer +defc BUFEND = $FC18 ; end of key buffer +defc LINWRK = $FC18 ; ^ +defc PATWRK = $FC40 ; Pattern Buffer +defc BOTTOM = $FC48 +defc SYSMEM = $FC4A ;start address of system memory +defc HIMEM = $FC4A ;^ +defc TRPTBL = $FC4C +defc RTYCNT = $FC9A + +defc INTFLG = $FC9B ; This flag is set if STOP (=4) or CTRL + STOP (=3) is pressed +defc PADY = $FC9C ; Y-coordinate of a connected Graphics Tablet (PAD) +defc PADX = $FC9D ; X-coordinate of a connected Graphics Tablet (PAD) + +defc JIFFY = $FC9E ; (TIMEVAR) Counter for the BASIC "time" function, each interrupt of the VDP it is increased by 1. +defc INTVAL = $FCA0 ; length of the interval when the ON INTERVAL routine was established. +defc INTCNT = $FCA2 ; ON INTERVAL counter (counts backwards) +defc LOWLIM = $FCA4 ; Used by the Cassette system (minimal length of startbit) +defc WINWID = $FCA5 ; Used by the Cassette system (store the difference between a low-and high-cycle) +defc GRPHED = $FCA6 ; flag for graph. char +defc ESCCNT = $FCA7 ; escape sequence counter +defc INSFLG = $FCA8 ; insert mode flag +defc CSRSW = $FCA9 ; cursor display switch +defc CSTYLE = $FCAA ; cursor style i.e. Used if INS Key is used ( 00# = Full Cursor / FF# = Halve Cursor ) +defc CAPST = $FCAB ; capital status ( 00# = Off / FF# = On ) +defc KANAST = $FCAC ; russian key status (Dead Keys) 1=DK, 2=SHIFT+DK, 3=CODE+DK, 4=SHIFT+CODE+DK +defc KANAMD = $FCAD +defc FLBMEM = $FCAE ; 0 if loading basic programm + +defc SCRMOD = $FCAF ; screen mode +defc OLDSCR = $FCB0 ; old screen mode +defc CASPRV = $FCB1 +defc BRDATR = $FCB2 ; border color for paint +defc GXPOS = $FCB3 ; X-position +defc GYPOS = $FCB5 ; Y-position +defc GRPACX = $FCB7 +defc GRPACY = $FCB9 +defc DRWFLG = $FCBB ; DrawFlag: Bit 7 = Draw Line (,N), Bit 6 = Move Cursor (,B) +defc DRWSCL = $FCBC ; DrawScaling +defc DRWANG = $FCBD ; DrawAngle (0..3): 1=90 degrees rotation .. 3=270 degrees, etc.. + +defc RUNBNF = $FCBE ; Run Binary File After loading ( Bload"File.Bin",R ) 0 = Don't Run / 1 = Run +defc SAVENT = $FCBF ; start address for BSAVE / BLOAD operations + +; FCC1H -- slot-address of main-ROM +defc EXPTBL = $FCC1 ;1 Slot 0: #80 = expanded, 0 = not expanded. Also slot address of the main BIOS-ROM. +defc EXP0 = $FCC1 ;1 Expansion Slot 0 +defc EXP1 = $FCC2 ;1 Expansion Slot 1 +defc EXP2 = $FCC3 ;1 Expansion Slot 2 +defc EXP3 = $FCC4 ;1 Expansion Slot 3 +defc SLTTBL = $FCC5 ;1 Mirror of slot 0 secondary slot selection register. +defc SLT0 = $FCC5 ;1 Mirror of slot 0... +defc SLT1 = $FCC6 ;1 Mirror of slot 1... +defc SLT2 = $FCC7 ;1 Mirror of slot 2... +defc SLT3 = $FCC8 ;1 Mirror of slot 3... + +defc SLTATR = $FCC9 ; Slotatributes found starting: Bit 7 = Basic prog, Bit 6 = Dev Ext, Bit 5 = Stmt Ext +defc SLTWRK = $FD09 ; (free word = FD09H + 32*basic slot + 8*expansion slot + 2*page) +defc PROCNM = $FD89 ; name of expanded statement +defc DEVICE = $FD99 ; device ID for cartrige 0-3 + + +; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- +; BASIC locations +; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- + +;defc WARM_BT = $409B ; address of "warm boot" BASIC interpreter + +;defc DOTLINE = $58FC ; LINE (BC,DE)-(GXPOS,GYPOS) +;defc DOBOXF = $58C1 +;defc BOXLIN = $5912 +;defc DO_CIRC = $5B19 ; + +;; defc PSET = $57F5 +;defc DOPSET = $57F5 ; (X = (BC), Y = (DE)) + +;defc N_PAINT = $266E ; (color = (A), X = (BC), Y = (DE)) - +;defc O_PAINT = $59E3 ; - init: CALL 0129H (PNTINI in msxbios), then CALL PAINT (BC,DE) + + +; -------------------------------------------------------------------------- + +; TRPTBL (78) - Data table for the interrupt facilities of the MSX computer. +; IFLG_* byte meaning: +; Bit 7-3 - unused +; Bit 2 - Interrupt occurred Y/N 1= Yes +; Bit 1 - Interrupt STOP Y/N 1= Yes +; Bit 0 - Interrupt OFF Y/N 1= No + + +defc IFLG_F1 = $FC4C ; F1 Key - Interrupt flags +defc IENTRY_F1 = $FC4D ; F1 Key - Interrupt related code +defc IFLG_F2 = $FC4F ; F2 Key - Interrupt flags +defc IENTRY_F2 = $FC50 ; F2 Key - Interrupt related code +defc IFLG_F3 = $FC52 ; F3 Key - Interrupt flags +defc IENTRY_F3 = $FC53 ; F3 Key - Interrupt related code +defc IFLG_F4 = $FC55 ; F4 Key - Interrupt flags +defc IENTRY_F4 = $FC56 ; F4 Key - Interrupt related code +defc IFLG_F5 = $FC58 ; F5 Key - Interrupt flags +defc IENTRY_F5 = $FC59 ; F5 Key - Interrupt related code +defc IFLG_F6 = $FC5B ; F6 Key - Interrupt flags +defc IENTRY_F6 = $FC5C ; F6 Key - Interrupt related code +defc IFLG_F7 = $FC5E ; F7 Key - Interrupt flags +defc IENTRY_F7 = $FC5F ; F7 Key - Interrupt related code +defc IFLG_F8 = $FC61 ; F8 Key - Interrupt flags +defc IENTRY_F8 = $FC62 ; F8 Key - Interrupt related code +defc IFLG_F9 = $FC64 ; F9 Key - Interrupt flags +defc IENTRY_F9 = $FC65 ; F9 Key - Interrupt related code +defc IFLG_F10 = $FC67 ; F10 Key - Interrupt flags +defc IENTRY_F10 = $FC68 ; F10 Key - Interrupt related code + +defc IFLG_STOP = $FC6A ; STOP button - Interrupt flags +defc IENTRY_STOP = $FC6B ; STOP button - Interrupt related code +defc IFLG_COLLSN = $FC6D ; Sprite collision - Interrupt flags +defc IENTRY_COLLSN = $FC6E ; Sprite collision - Interrupt related code + +defc IFLG_STRIG0 = $FC70 ; SPACE key trigger - Interrupt flags +defc IENTRY_STRIG0 = $FC71 ; SPACE key trigger - Interrupt related code +defc IFLG_STRIG1 = $FC73 ; Joystick 1, Fire 1 - Interrupt flags +defc IENTRY_STRIG1 = $FC74 ; Joystick 1, Fire 1 - Interrupt related code +defc IFLG_STRIG2 = $FC76 ; Joystick 2, Fire 1 - Interrupt flags +defc IENTRY_STRIG2 = $FC77 ; Joystick 2, Fire 1 - Interrupt related code +defc IFLG_STRIG3 = $FC79 ; Joystick 1, Fire 2 - Interrupt flags +defc IENTRY_STRIG3 = $FC7A ; Joystick 1, Fire 2 - Interrupt related code +defc IFLG_STRIG4 = $FC7C ; Joystick 2, Fire 2 - Interrupt flags +defc IENTRY_STRIG4 = $FC7D ; Joystick 2, Fire 2 - Interrupt related code + +defc IFLG_TIMER = $FC7F ; TIMER - Interrupt flags +defc IENTRY_TIMER = $FC80 ; TIMER - Interrupt related code + +; -------------------------------------------------------------------------- +lston diff --git a/tests/restricted/rombasic.asm b/tests/restricted/rombasic.asm new file mode 100644 index 00000000..71a16388 --- /dev/null +++ b/tests/restricted/rombasic.asm @@ -0,0 +1,15463 @@ + + +; NOTE: the code listed in this disassembly is not complete, the ROM files hold folded program pages which had to be manually remapped. +; Not all tbe proper bank mapping was considered ! + + + +; ___________ information collected so far about the memory banks ___________ + + +; FFFFh |----Reserved-----| +; D400h |----CPM CCP------| +; | | +; | User RAM | +; | | +; | | +; 4000h |-----------------|-----------------| +; 3000h |----PCG RAM-----| ROM 2 | | +; 2800h |---Colour RAM---| | Lower CPM | +; 2000h |-- Screen RAM---|-----------------| memory | +; | ROM 1 | | +; 0100h | |-----------------| +; 0000h |-----------------|--CPM-reserved---| +; +; bank 2 bank 1 bank 3 + + +; Bank 1 is what we see in LEVEL II basic when we use the peek & poke commands. +; Bank 3 is the extra ram allocated to cpm +; Bank 2 is the Screen RAM + +; Turns screen ram on from ROM BASIC +; in a,(50h) ; get system status +; set 0,a +; out (70h),a ; Set system status + +; Turns screen ram off from ROM BASIC +; in a,(50h) ; get system status +; res 0,a +; out (70h),a ; Set system status + + +; _____________________________________________________________________________ + + + +0000 f3 di +0001 c30001 jp 0100h + +0004 00 nop +0005 00 nop +0006 00 nop +0007 00 nop + +; SYNCHR: Check syntax: next byte holds the byte to be found +0008 c3c0fb jp 0fbc0h + +000b 1e2c ld e,2ch ; ?L3 Error +000d c38c28 jp 288ch ; ERROR, E=error code + +; CHRGTB: Gets next character (or token) from BASIC text. +0010 c3c3fb jp 0fbc3h + +; Memory Overflow (MO ERROR) entry +0013 1e28 ld e,28h +0015 c38c28 jp 288ch ; ERROR, E=error code + +; DCOMPR - Compare HL with DE. +0018 c3c6fb jp 0fbc6h + +001b af xor a ; (motor off) +001c d3e4 out (0e4h),a ; Disk select +001e 18e0 jr 0000h + + +0020 c3c9fb jp 0fbc9h ; GETYPR - Get the number type (FAC) + +0023 00 nop +0024 00 nop +0025 00 nop +0026 00 nop +0027 00 nop + +0028 c3ccfb jp 0fbcch + +002b 00 nop +002c 00 nop +002d 00 nop +002e 00 nop +002f 00 nop + + +0030 c3cffb jp 0fbcfh + +0033 00 nop +0034 00 nop +0035 00 nop +0036 00 nop +0037 00 nop + +0038 c3d2fb jp 0fbd2h ; Interrupt exit - initialised to a return + +003b 00 nop +003c 00 nop +003d 00 nop +003e 00 nop +003f 00 nop + +0040 c30d03 jp 030dh ; Console output routine +0043 c3ea09 jp 09eah ; Console status routine +0046 c3ac09 jp 09ach ; Console input routine +0049 c3fa08 jp 08fah ; RINPUT - Console line input routine +004c c36504 jp 0465h ; Cursor on routine +004f c36e04 jp 046eh ; Cursor off routine +0052 c37606 jp 0676h ; LO-RES Selection routine +0055 c37c06 jp 067ch ; HI-RES Selection routine +0058 c3e304 jp 04e3h ; Clear screen routine +005b c3c80b jp 0bc8h ; Print routine +005e c32d0c jp 0c2dh ; List routine +0061 c3450c jp 0c45h ; List status routine +0064 c34b02 jp 024bh ; RS232 Output routine +0067 c35602 jp 0256h ; RS232 Status routine +006a c35e02 jp 025eh ; RS232 Input routine +006d c39e07 jp 079eh ; Cassette read on routine +0070 c3c907 jp 07c9h ; Casette read routine +0073 c32307 jp 0723h ; Cassette write on routine +0076 c33d07 jp 073dh ; Cassette output routine +0079 c38007 jp 0780h ; Cassette off routine +007c c3b606 jp 06b6h ; Turns CRTC on +007f c3ae06 jp 06aeh ; Turns CRTC off +0082 c31005 jp 0510h ; Fills BC bytes at HL with A +0085 c3cc06 jp 06cch ; Loads CRTC regs with B+1 bytes dwn from HL +0088 c36806 jp 0668h ; Turns screen ram on +008b c36f06 jp 066fh ; Turns screen ram off +008e c3e918 jp 18e9h ; __CINT: Floating point to Integer (e.g. get numeric argument from USR function and place in HL) +0091 c31b19 jp 191bh ; __CSNG: Integer to single precision +0094 c3d61c jp 1cd6h ; ASCTFP - ASCII to Binary conversion +0097 c3281e jp 1e28h ; Floating point to ASCII +009a c38015 jp 1580h ; FPADD - Single precision add (Add BCDE to FP reg) +009d c37d15 jp 157dh ; SUBCDE - Single precision subtract (Subtract BCDE from FP reg) +00a0 c3b116 jp 16b1h ; FPMULT - Single precision multiply (Multiply BCDE to FP reg) +00a3 c38433 jp 3384h ; IDIV - (Single precision division ??) +00a6 c37618 jp 1876h ; CMPNUM - Single precision compare +00a9 c3e117 jp 17e1h ; ABS - Absolute value +00ac c3a119 jp 19a1h ; DBL_INT - Return Integer +00af c32724 jp 2427h ; ATN - Arctangent +00b2 c3ab23 jp 23abh ; COS - Cosine +00b5 c3b123 jp 23b1h ; SIN - Sine +00b8 c31224 jp 2412h ; TAN - Tangent +00bb c31e18 jp 181eh ; FPBCDE: Move single precision value in BC/DE into FPREG +00be c31b18 jp 181bh ; PHLTFP - Move a single precision value -> HL to FPREG +00c1 c32c18 jp 182ch ; LOADFP: Load single precision value pointed by (HL) into BC/DE +00c4 c32918 jp 1829h ; BCDEFP: Load a single precision value from FPREG into BC/DE +00c7 c30e18 jp 180eh ; STAKFP: Move FPREG to stack +00ca c3162a jp 2a16h ; FIND_LNUM - Search for line number +00cd c30135 jp 3501h ; GETVAR: Find address of variable +00d0 c39c2d jp 2d9ch ; __GOSUB: Gosub routine +00d3 c3ca2d jp 2dcah ; Return entry point - warm start of BASIC +00d6 c39b37 jp 379bh ; PRS - Output a string +00d9 c3693a jp 3a69h ; Print message, text ptr in (HL) + +00dc d9 exx +00dd 210042 ld hl,4200h +00e0 cdf510 call 10f5h +00e3 af xor a +00e4 cd5e06 call 065eh +00e7 23 inc hl +00e8 cb5c bit 3,h +00ea 28f7 jr z,00e3h +00ec d9 exx +00ed c3590c jp 0c59h + +00f0 00 nop +00f1 00 nop +00f2 00 nop +00f3 00 nop +00f4 00 nop +00f5 00 nop +00f6 00 nop +00f7 00 nop +00f8 00 nop +00f9 00 nop +00fa 00 nop +00fb 00 nop +00fc 00 nop +00fd 00 nop +00fe 00 nop +00ff 00 nop + + + +; Start + +0100 210010 ld hl,1000h +0103 2b dec hl +0104 7c ld a,h +0105 b5 or l +0106 20fb jr nz,0103h +0108 3e4e ld a,4eh +010a d311 out (11h),a ; Serial Control and status port +010c 3e37 ld a,37h +010e d311 out (11h),a ; Serial Control and status port +0110 3e81 ld a,81h +0112 d363 out (63h),a ; Parallel Port Interface Control word +0114 3e10 ld a,10h +0116 d362 out (62h),a ; Parallel and Cassette I/O port +0118 210040 ld hl,4000h +011b 3600 ld (hl),00h +011d 218ffc ld hl,0fc8fh ; No.of lines displayed by screen +0120 3600 ld (hl),00h +0122 2a16fc ld hl,(0fc16h) +0125 11a5a5 ld de,0a5a5h +0128 b7 or a +0129 ed52 sbc hl,de +012b 2037 jr nz,0164h +012d 2a18fc ld hl,(0fc18h) +0130 115a7e ld de,7e5ah +0133 ed52 sbc hl,de +0135 202d jr nz,0164h +0137 21e3fb ld hl,0fbe3h ; CASSETTE SPEED 01 = 1200 baud 02 = 600 baud 04 = 300 baud +013a cbbe res 7,(hl) ; mask out the cassette flag bit +013c 3ae2fb ld a,(0fbe2h) +013f 47 ld b,a +0140 3a89fc ld a,(0fc89h) +0143 b8 cp b +0144 2006 jr nz,014ch +0146 db50 in a,(50h) ; get system status +0148 f604 or 04h +014a d370 out (70h),a ; Set system status +014c 2190fc ld hl,0fc90h ; ESCAPE FLAG REGISTER +014f cb46 bit 0,(hl) +0151 c20702 jp nz,0207h +0154 21ce10 ld hl,10ceh +0157 cd0d11 call 110dh ; PRS - Output a string to video device +015a af xor a +015b 3201fe ld (0fe01h),a ; AUTFLG: Auto increment flag 0 = no auto mode, otherwise line number +015e 010229 ld bc,2902h ; RESTART +0161 c39828 jp 2898h + +0164 3134fc ld sp,0fc34h +0167 3e3a ld a,3ah +0169 d323 out (23h),a ; 8253 MODE CONTROL WORD +016b d320 out (20h),a ; COUNTER 0 - Audio output freq. +016d d320 out (20h),a ; COUNTER 0 - Audio output freq. +016f 3e76 ld a,76h +0171 d323 out (23h),a ; 8253 MODE CONTROL WORD +0173 3ed0 ld a,0d0h +0175 d321 out (21h),a ; COUNTER 1 - Baud rate gen.(RS232) +0177 af xor a +0178 d321 out (21h),a ; COUNTER 1 - Baud rate gen.(RS232) +017a af xor a +017b 329dfc ld (0fc9dh),a + +; Buid a JP table for common subroutines on top of RAM +017e 217224 ld hl,2472h +0181 11c0fb ld de,0fbc0h +0184 014e00 ld bc,004eh +0187 edb0 ldir + +0189 060c ld b,0ch +018b af xor a +018c 12 ld (de),a +018d 13 inc de +018e 10fc djnz 018ch + +0190 1134fc ld de,0fc34h +0193 21e127 ld hl,27e1h +0196 012600 ld bc,0026h +0199 edb0 ldir + +019b 21e1fe ld hl,0fee1h +019e 363a ld (hl),3ah +01a0 23 inc hl +01a1 70 ld (hl),b +01a2 23 inc hl +01a3 362c ld (hl),2ch +01a5 23 inc hl +01a6 22c7fd ld (0fdc7h),hl ; Pointer to address of keyboard buffer +01a9 110b00 ld de,000bh +01ac 0611 ld b,11h +01ae 2172fe ld hl,0fe72h +01b1 36c3 ld (hl),0c3h +01b3 23 inc hl +01b4 73 ld (hl),e +01b5 23 inc hl +01b6 72 ld (hl),d +01b7 23 inc hl +01b8 10f7 djnz 01b1h +01ba 110300 ld de,0003h +01bd 0614 ld b,14h +01bf 36c9 ld (hl),0c9h +01c1 19 add hl,de +01c2 10fb djnz 01bfh +01c4 21befb ld hl,0fbbeh +01c7 22d1fd ld (0fdd1h),hl ; Memory size +01ca 11ceff ld de,0ffceh +01cd 19 add hl,de +01ce 2254fc ld (0fc54h),hl ; Address of string area boundary +01d1 cd372a call 2a37h +01d4 21dd06 ld hl,06ddh +01d7 1166fc ld de,0fc66h ; LOW SCREEN RESOLUTION CRTC DATA +01da 012900 ld bc,0029h +01dd edb0 ldir +01df cd8f06 call 068fh +01e2 cd4a0c call 0c4ah +01e5 cd8f06 call 068fh +01e8 cd6504 call 0465h ; Cursor on routine +01eb 3e70 ld a,70h +01ed 32e4fb ld (0fbe4h),a ; COLOUR BYTE copied into colour ram with every console output +01f0 21a5a5 ld hl,0a5a5h +01f3 2216fc ld (0fc16h),hl +01f6 215a7e ld hl,7e5ah +01f9 2218fc ld (0fc18h),hl +01fc 2190fc ld hl,0fc90h ; ESCAPE FLAG REGISTER +01ff 3601 ld (hl),01h +0201 cdc902 call 02c9h ; Detect Disk Drive Controller +0204 caf00e jp z,0ef0h +0207 2190fc ld hl,0fc90h ; ESCAPE FLAG REGISTER +020a 3600 ld (hl),00h +020c 3e70 ld a,70h +020e 32e4fb ld (0fbe4h),a ; COLOUR BYTE copied into colour ram with every console output +0211 21cd10 ld hl,10cdh ; BEL, Excalibur 64 Extended Basic 1.1 +0214 cd9b37 call 379bh ; PRS - Output a string +0217 216602 ld hl,0266h ; "Memory Size" +021a cd9b37 call 379bh ; PRS - Output a string +021d cd9d2a call 2a9dh ; INLIN +0220 38f5 jr c,0217h +0222 d7 rst 10h ; CHRGTB: Gets next character (or token) from BASIC text. + +0223 2820 jr z,0245h +0225 cd452d call 2d45h ; LNUM_PARM_0 - Get specified line number (2nd parameter) +0228 b7 or a +0229 20ec jr nz,0217h +022b eb ex de,hl +022c 2b dec hl +022d 111444 ld de,4414h +0230 df rst 18h ; DCOMPR - Compare HL with DE. +0231 38e4 jr c,0217h +0233 ed5bd1fd ld de,(0fdd1h) ; Memory size +0237 13 inc de +0238 df rst 18h ; DCOMPR - Compare HL with DE. +0239 30dc jr nc,0217h +023b 22d1fd ld (0fdd1h),hl ; Memory size +023e 11ceff ld de,0ffceh +0241 19 add hl,de +0242 2254fc ld (0fc54h),hl ; Address of string area boundary +0245 cd372a call 2a37h +0248 c30329 jp 2903h ; READY + +; RS232 Output routine +024b 08 ex af,af' +024c db11 in a,(11h) ; Serial Control and status port +024e e601 and 01h +0250 28fa jr z,024ch +0252 08 ex af,af' +0253 d310 out (10h),a +0255 c9 ret + +; RS232 Status routine +0256 db11 in a,(11h) ; Serial Control and status port +0258 e602 and 02h +025a c8 ret z +025b 3eff ld a,0ffh +025d c9 ret + +; RS232 Input routine +025e cd5602 call 0256h ; RS232 Status routine +0261 28fb jr z,025eh +0263 db10 in a,(10h) +0265 c9 ret + +0266 0d dec c +0267 4d ld c,l +0268 65 ld h,l +0269 6d ld l,l +026a 6f ld l,a +026b 72 ld (hl),d +026c 79 ld a,c +026d 2053 jr nz,02c2h +026f 69 ld l,c +0270 7a ld a,d +0271 65 ld h,l +0272 00 nop +0273 db50 in a,(50h) ; get system status +0275 e610 and 10h +0277 28fa jr z,0273h ; wait for CSYNC - Composite video sync.signal +0279 7e ld a,(hl) +027a cb9c res 3,h +027c 1f rra +027d 300a jr nc,0289h +027f db50 in a,(50h) ; get system status +0281 e610 and 10h +0283 28fa jr z,027fh ; wait for CSYNC - Composite video sync.signal +0285 7e ld a,(hl) +0286 fec0 cp 0c0h +0288 3f ccf +0289 f5 push af +028a db50 in a,(50h) ; get system status +028c e610 and 10h +028e 28fa jr z,028ah ; wait for CSYNC - Composite video sync.signal +0290 46 ld b,(hl) +0291 f1 pop af +0292 c9 ret + +0293 f5 push af +0294 cbdc set 3,h +0296 db50 in a,(50h) ; get system status +0298 e610 and 10h +029a 28fa jr z,0296h ; wait for CSYNC - Composite video sync.signal +029c cbc6 set 0,(hl) ; enable PCGEN bit +029e cb9c res 3,h ; move from attribute to text address +02a0 06c0 ld b,0c0h ; character 0xC0 (192) +02a2 70 ld (hl),b +02a3 f1 pop af +02a4 c9 ret + +02a5 d7 rst 10h ; CHRGTB: Gets next character (or token) from BASIC text. +02a6 c39e07 jp 079eh ; Cassette read on routine + +02a9 cdd2fe call 0fed2h +02ac fe23 cp 23h +02ae c8 ret z +02af fe40 cp 40h +02b1 c0 ret nz +02b2 23 inc hl +02b3 cdf639 call 39f6h ; GETWORD - Get a number to DE (0..65535) +02b6 cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +02b7 2c defb ',' +02b8 e5 push hl +02b9 2ae1fb ld hl,(0fbe1h) ; MAXIMUM No. CHARACTERS ALLOWED ON SCREEN +02bc b7 or a +02bd ed52 sbc hl,de +02bf da352d jp c,2d35h ; Error: Illegal function call (FC ERROR) +02c2 ed53ddfb ld (0fbddh),de ; CURSOR POSITION relative to upper L.H. corner +02c6 e1 pop hl +02c7 7e ld a,(hl) +02c8 c9 ret + +; Detect Disk Drive Controller +02c9 cd283f call 3f28h +02cc cd5910 call 1059h +02cf c9 ret + +02d0 00 nop +02d1 00 nop +02d2 00 nop +02d3 00 nop +02d4 00 nop +02d5 00 nop +02d6 00 nop +02d7 00 nop +02d8 00 nop +02d9 00 nop +02da 00 nop +02db 00 nop +02dc 00 nop +02dd 00 nop +02de 00 nop +02df 00 nop +02e0 00 nop +02e1 00 nop +02e2 00 nop +02e3 00 nop +02e4 00 nop +02e5 00 nop +02e6 00 nop +02e7 00 nop + + +02e8 e5 push hl +02e9 d5 push de +02ea c5 push bc +02eb cdf202 call 02f2h +02ee c1 pop bc +02ef d1 pop de +02f0 e1 pop hl +02f1 c9 ret + +02f2 f5 push af +02f3 3efd ld a,0fdh +02f5 d361 out (61h),a ; Keyboard row select +02f7 db00 in a,(00h) ; **KEYBOARD_MATRIX_COLUMN_READ** +02f9 feef cp 0efh +02fb 200f jr nz,030ch +02fd 3ebf ld a,0bfh +02ff d361 out (61h),a ; Keyboard row select +0301 db00 in a,(00h) ; **KEYBOARD_MATRIX_COLUMN_READ** + +0303 fedf cp 0dfh +0305 ccac09 call z,09ach ; Console input routine +0308 fe13 cp 13h +030a 28f9 jr z,0305h +030c f1 pop af + +; Console output routine +030d 218ffc ld hl,0fc8fh ; No.of lines displayed by screen +0310 cb46 bit 0,(hl) +0312 ca6303 jp z,0363h +0315 cb86 res 0,(hl) +0317 cb7e bit 7,(hl) +0319 c2b705 jp nz,05b7h +031c cb56 bit 2,(hl) +031e c20906 jp nz,0609h +0321 fe4a cp 4ah +0323 ca4306 jp z,0643h +0326 fe43 cp 43h +0328 ca9705 jp z,0597h +032b fe3d cp 3dh +032d ca9f05 jp z,059fh +0330 fe48 cp 48h +0332 caa705 jp z,05a7h +0335 fe49 cp 49h +0337 caad05 jp z,05adh +033a fe31 cp 31h +033c caf6fb jp z,0fbf6h ; Function 1 key exit - initialised to a return +033f fe32 cp 32h +0341 caf9fb jp z,0fbf9h ; Function 2 key exit - initialised to a return +0344 fe33 cp 33h +0346 cafcfb jp z,0fbfch ; Function 3 key exit - initialised to a return +0349 fe34 cp 34h +034b cafffb jp z,0fbffh ; Function 4 key exit - initialised to a return +034e fe35 cp 35h +0350 ca02fc jp z,0fc02h ; Function 5 key exit - initialised to a return +0353 fe36 cp 36h +0355 ca05fc jp z,0fc05h ; Function 6 key exit - initialised to a return +0358 fe37 cp 37h +035a ca08fc jp z,0fc08h ; Function 7 key exit - initialised to a return +035d fe38 cp 38h +035f ca0bfc jp z,0fc0bh ; Function 8 key exit - initialised to a return +0362 c9 ret + +0363 fe20 cp 20h +0365 306a jr nc,03d1h +0367 fe0d cp 0dh +0369 ca2e04 jp z,042eh +036c 211804 ld hl,0418h +036f e5 push hl +0370 fe08 cp 08h +0372 ca5804 jp z,0458h +0375 fe09 cp 09h +0377 ca6f05 jp z,056fh +037a fe08 cp 08h +037c ca7704 jp z,0477h +037f fe0c cp 0ch +0381 ca8404 jp z,0484h +0384 fe0a cp 0ah +0386 ca9404 jp z,0494h +0389 fe0b cp 0bh +038b cab504 jp z,04b5h +038e fe1a cp 1ah +0390 cae304 jp z,04e3h ; Clear screen routine +0393 fe0e cp 0eh +0395 ca2e04 jp z,042eh +0398 fe1e cp 1eh +039a cab305 jp z,05b3h +039d e1 pop hl +039e fe1b cp 1bh +03a0 ca9105 jp z,0591h +03a3 fe07 cp 07h +03a5 ca5b05 jp z,055bh ; BEL +03a8 fe16 cp 16h +03aa ca6504 jp z,0465h ; Cursor on routine +03ad fe15 cp 15h +03af ca6e04 jp z,046eh ; Cursor off routine +03b2 fe17 cp 17h +03b4 ca8206 jp z,0682h +03b7 fe14 cp 14h +03b9 ca7c06 jp z,067ch ; HI-RES Selection routine +03bc fe1c cp 1ch +03be ca1a05 jp z,051ah +03c1 fe1d cp 1dh +03c3 ca2805 jp z,0528h +03c6 fe19 cp 19h +03c8 cab606 jp z,06b6h ; Turns CRTC on +03cb fe18 cp 18h +03cd caae06 jp z,06aeh ; Turns CRTC off +03d0 c9 ret + +03d1 ed5bddfb ld de,(0fbddh) ; CURSOR POSITION relative to upper L.H. corner +03d5 2adffb ld hl,(0fbdfh) ; CRTC value for "display start address" +03d8 19 add hl,de +03d9 cb9c res 3,h +03db cbec set 5,h +03dd 08 ex af,af' +03de cd6806 call 0668h ; Turns screen ram on +03e1 08 ex af,af' +03e2 cd5e06 call 065eh +03e5 cbdc set 3,h +03e7 3ae4fb ld a,(0fbe4h) ; COLOUR BYTE copied into colour ram with every console output +03ea cd5e06 call 065eh +03ed cd6f06 call 066fh ; Turns screen ram off +03f0 13 inc de +03f1 2ae1fb ld hl,(0fbe1h) ; MAXIMUM No. CHARACTERS ALLOWED ON SCREEN +03f4 b7 or a +03f5 ed52 sbc hl,de +03f7 301f jr nc,0418h +03f9 cd0f07 call 070fh ; Get current video parameters (BC=text_colums, DE=?) +03fc 2adffb ld hl,(0fbdfh) ; CRTC value for "display start address" +03ff 09 add hl,bc +0400 cb9c res 3,h +0402 22dffb ld (0fbdfh),hl ; CRTC value for "display start address" +0405 cd3405 call 0534h +; update cursor position +0408 2adffb ld hl,(0fbdfh) ; CRTC value for "display start address" +040b 3e0d ld a,0dh ; reg. for CRTC display start address, MSB +040d d330 out (30h),a ; CRTC register select +040f 0e31 ld c,31h ; CRTC data +0411 ed69 out (c),l ; reg. for CRTC display start address, LSB +0413 3d dec a +0414 d330 out (30h),a ; CRTC register select +0416 ed61 out (c),h +0418 ed53ddfb ld (0fbddh),de ; CURSOR POSITION relative to upper L.H. corner +041c 2adffb ld hl,(0fbdfh) ; CRTC value for "display start address" +041f 19 add hl,de +0420 3e0f ld a,0fh ; reg. for CRTC cursor address, MSB +0422 d330 out (30h),a ; CRTC register select +0424 0e31 ld c,31h ; CRTC data +0426 ed69 out (c),l +0428 3d dec a ; reg. for CRTC cursor address, LSB +0429 d330 out (30h),a ; CRTC register select +042b ed61 out (c),h +042d c9 ret + +042e 08 ex af,af' +042f cd0f07 call 070fh ; Get current video parameters (BC=text_colums, DE=?) +0432 2addfb ld hl,(0fbddh) ; CURSOR POSITION relative to upper L.H. corner +0435 b7 or a +0436 ed52 sbc hl,de +0438 3007 jr nc,0441h +043a eb ex de,hl +043b b7 or a +043c ed42 sbc hl,bc +043e eb ex de,hl +043f 18f1 jr 0432h +0441 08 ex af,af' +0442 fe0d cp 0dh +0444 c0 ret nz +0445 218ffc ld hl,0fc8fh ; No.of lines displayed by screen +0448 cb6e bit 5,(hl) +044a 2803 jr z,044fh +044c c31804 jp 0418h +044f eb ex de,hl +0450 09 add hl,bc +0451 e5 push hl +0452 cd1f05 call 051fh +0455 d1 pop de +0456 1899 jr 03f1h +0458 ed5bddfb ld de,(0fbddh) ; CURSOR POSITION relative to upper L.H. corner +045c 7b ld a,e +045d b2 or d +045e c8 ret z +045f 1b dec de +0460 ed53ddfb ld (0fbddh),de ; CURSOR POSITION relative to upper L.H. corner +0464 c9 ret + + +; Cursor on routine +0465 3e0a ld a,0ah +0467 d330 out (30h),a ; CRTC register select +0469 3e60 ld a,60h +046b d331 out (31h),a ; CRTC data +046d c9 ret + +; Cursor off routine +046e 3e0a ld a,0ah +0470 d330 out (30h),a ; CRTC register select +0472 3e20 ld a,20h +0474 d331 out (31h),a ; CRTC data +0476 c9 ret + + +0477 ed5bddfb ld de,(0fbddh) ; CURSOR POSITION relative to upper L.H. corner +047b 1b dec de +047c 7a ld a,d +047d 3c inc a +047e c0 ret nz +047f ed5be1fb ld de,(0fbe1h) ; MAXIMUM No. CHARACTERS ALLOWED ON SCREEN +0483 c9 ret +0484 ed5bddfb ld de,(0fbddh) ; CURSOR POSITION relative to upper L.H. corner +0488 13 inc de +0489 2ae1fb ld hl,(0fbe1h) ; MAXIMUM No. CHARACTERS ALLOWED ON SCREEN +048c b7 or a +048d ed52 sbc hl,de +048f d0 ret nc +0490 110000 ld de,0000h +0493 c9 ret + +0494 2addfb ld hl,(0fbddh) ; CURSOR POSITION relative to upper L.H. corner +0497 cd0f07 call 070fh ; Get current video parameters (BC=text_colums, DE=?) +049a 09 add hl,bc +049b eb ex de,hl +049c 218ffc ld hl,0fc8fh ; No.of lines displayed by screen +049f cb6e bit 5,(hl) +04a1 2804 jr z,04a7h +04a3 e1 pop hl +04a4 c3f103 jp 03f1h +04a7 2ae1fb ld hl,(0fbe1h) ; MAXIMUM No. CHARACTERS ALLOWED ON SCREEN +04aa ed52 sbc hl,de +04ac d0 ret nc +04ad eb ex de,hl +04ae 210000 ld hl,0000h +04b1 ed52 sbc hl,de +04b3 eb ex de,hl +04b4 c9 ret + +04b5 cd0f07 call 070fh ; Get current video parameters (BC=text_colums, DE=?) +04b8 2addfb ld hl,(0fbddh) ; CURSOR POSITION relative to upper L.H. corner +04bb b7 or a +04bc ed42 sbc hl,bc +04be 3006 jr nc,04c6h +04c0 ed5be1fb ld de,(0fbe1h) ; MAXIMUM No. CHARACTERS ALLOWED ON SCREEN +04c4 ed5a adc hl,de +04c6 eb ex de,hl +04c7 c9 ret + +; __CLS +04c8 2819 jr z,04e3h ; Clear screen routine +04ca cdf639 call 39f6h ; LDIRVM - Block transfer to VRAM from memory (HL)->(DE), BC times +04cd 7a ld a,d +04ce b7 or a +04cf c21c16 jp nz,161ch ; Overflow Error (OV ERROR) +04d2 7b ld a,e +04d3 fe08 cp 08h +04d5 d21c16 jp nc,161ch ; Overflow Error (OV ERROR) +04d8 07 rlca +04d9 47 ld b,a +04da 3ae4fb ld a,(0fbe4h) ; COLOUR BYTE copied into colour ram with every console output +04dd e6f0 and 0f0h +04df b0 or b +04e0 32e4fb ld (0fbe4h),a ; COLOUR BYTE copied into colour ram with every console output + +; // Workaround found in MAME: fix a bug that causes screen to be filled with 'p' +; ROM_FILL(0x4ee, 1, 0) +; ROM_FILL(0x4ef, 1, 8) +; ROM_FILL(0x4f6, 1, 0) +; ROM_FILL(0x4f7, 1, 8) + +; Clear screen routine +04e3 e5 push hl +04e4 cdae06 call 06aeh ; Turns CRTC off +04e7 cd6806 call 0668h ; Turns screen ram on +04ea 210020 ld hl,2000h +04ed 01ff07 ld bc,07ffh +04f0 3e20 ld a,20h +04f2 cd1005 call 0510h ; Fills BC bytes at HL with A +04f5 01ff07 ld bc,07ffh +04f8 3ae4fb ld a,(0fbe4h) ; COLOUR BYTE copied into colour ram with every console output +04fb cd1005 call 0510h ; Fills BC bytes at HL with A +04fe cd6f06 call 066fh ; Turns screen ram off +0501 cdb606 call 06b6h ; Turns CRTC on +0504 110000 ld de,0000h +0507 ed53dffb ld (0fbdfh),de ; CRTC value for "display start address" +050b cd0804 call 0408h ; update cursor position +050e e1 pop hl +050f c9 ret + +; Fills BC bytes at HL with A +0510 77 ld (hl),a +0511 23 inc hl +0512 0b dec bc +0513 08 ex af,af' +0514 78 ld a,b +0515 b1 or c +0516 c8 ret z +0517 08 ex af,af' +0518 18f6 jr 0510h + +051a cd2e04 call 042eh +051d eb ex de,hl +051e 09 add hl,bc +051f ed5bddfb ld de,(0fbddh) ; CURSOR POSITION relative to upper L.H. corner +0523 b7 or a +0524 ed52 sbc hl,de +0526 180a jr 0532h +0528 2ae1fb ld hl,(0fbe1h) ; MAXIMUM No. CHARACTERS ALLOWED ON SCREEN +052b ed5bddfb ld de,(0fbddh) ; CURSOR POSITION relative to upper L.H. corner +052f b7 or a +0530 ed52 sbc hl,de +0532 44 ld b,h +0533 4d ld c,l + +0534 2adffb ld hl,(0fbdfh) ; CRTC value for "display start address" +0537 19 add hl,de +0538 cbec set 5,h +053a d5 push de +053b 3ae4fb ld a,(0fbe4h) ; COLOUR BYTE copied into colour ram with every console output +053e 5f ld e,a +053f cd6806 call 0668h ; Turns screen ram on +0542 cb9c res 3,h +0544 3e20 ld a,20h +0546 cd5e06 call 065eh +0549 cbdc set 3,h +054b 7b ld a,e +054c cd5e06 call 065eh +054f 23 inc hl +0550 cba4 res 4,h +0552 0b dec bc +0553 78 ld a,b +0554 b1 or c +0555 20eb jr nz,0542h +0557 d1 pop de +0558 c36f06 jp 066fh ; Turns screen ram off + +; BEL +055b 015e01 ld bc,015eh +055e cdaf0d call 0dafh ; Enable sound output, BC=audio frequency +0561 21ff7f ld hl,7fffh +0564 110100 ld de,0001h +0567 ed52 sbc hl,de +0569 20fc jr nz,0567h +056b cdba0d call 0dbah ; Stop sound output +056e c9 ret + +056f 218ffc ld hl,0fc8fh ; No.of lines displayed by screen +0572 cb6e bit 5,(hl) +0574 2002 jr nz,0578h +0576 e1 pop hl +0577 c9 ret + +0578 cd2e04 call 042eh +057b 23 inc hl +057c 3e07 ld a,07h +057e a5 and l +057f fe00 cp 00h +0581 c27b05 jp nz,057bh +0584 19 add hl,de +0585 eb ex de,hl +0586 2ae1fb ld hl,(0fbe1h) ; MAXIMUM No. CHARACTERS ALLOWED ON SCREEN +0589 b7 or a +058a ed52 sbc hl,de +058c d0 ret nc +058d 110000 ld de,0000h +0590 c9 ret + +0591 218ffc ld hl,0fc8fh ; No.of lines displayed by screen +0594 cbc6 set 0,(hl) +0596 c9 ret + +0597 218ffc ld hl,0fc8fh ; No.of lines displayed by screen +059a cbd6 set 2,(hl) +059c cbc6 set 0,(hl) +059e c9 ret +059f 218ffc ld hl,0fc8fh ; No.of lines displayed by screen +05a2 cbfe set 7,(hl) +05a4 cbc6 set 0,(hl) +05a6 c9 ret +05a7 218ffc ld hl,0fc8fh ; No.of lines displayed by screen +05aa cbee set 5,(hl) +05ac c9 ret + +05ad 218ffc ld hl,0fc8fh ; No.of lines displayed by screen +05b0 cbae res 5,(hl) +05b2 c9 ret +05b3 110000 ld de,0000h +05b6 c9 ret + +05b7 cb76 bit 6,(hl) +05b9 201b jr nz,05d6h +05bb cbf6 set 6,(hl) +05bd cbc6 set 0,(hl) +05bf b7 or a +05c0 d620 sub 20h +05c2 d8 ret c +05c3 fe18 cp 18h +05c5 d0 ret nc +05c6 3c inc a +05c7 210000 ld hl,0000h +05ca 115000 ld de,0050h +05cd 22ddfb ld (0fbddh),hl ; CURSOR POSITION relative to upper L.H. corner +05d0 3d dec a +05d1 2818 jr z,05ebh +05d3 19 add hl,de +05d4 18fa jr 05d0h +05d6 cbb6 res 6,(hl) +05d8 cbbe res 7,(hl) +05da b7 or a +05db d620 sub 20h +05dd d8 ret c +05de fe50 cp 50h +05e0 d0 ret nc +05e1 2addfb ld hl,(0fbddh) ; CURSOR POSITION relative to upper L.H. corner +05e4 3c inc a +05e5 3d dec a +05e6 2803 jr z,05ebh +05e8 23 inc hl +05e9 18fa jr 05e5h +05eb eb ex de,hl +05ec cd1804 call 0418h +05ef c9 ret + +05f0 218ffc ld hl,0fc8fh ; No.of lines displayed by screen +05f3 cbd6 set 2,(hl) +05f5 cbc6 set 0,(hl) +05f7 cdac09 call 09ach ; Console input routine +05fa e65f and 5fh +05fc cd0d03 call 030dh ; Console output routine +05ff cdac09 call 09ach ; Console input routine +0602 e65f and 5fh +0604 cd0d03 call 030dh ; Console output routine +0607 af xor a +0608 c9 ret + +0609 cb4e bit 1,(hl) +060b 201e jr nz,062bh +060d cbce set 1,(hl) +060f cbc6 set 0,(hl) +0611 b7 or a +0612 d641 sub 41h +0614 d8 ret c +0615 fe10 cp 10h +0617 d0 ret nc +0618 cb07 rlc a +061a cb07 rlc a +061c cb07 rlc a +061e cb07 rlc a +0620 47 ld b,a +0621 3ae4fb ld a,(0fbe4h) ; COLOUR BYTE copied into colour ram with every console output +0624 e60f and 0fh +0626 b0 or b +0627 32e4fb ld (0fbe4h),a ; COLOUR BYTE copied into colour ram with every console output +062a c9 ret + +062b cb8e res 1,(hl) +062d cb96 res 2,(hl) +062f b7 or a +0630 d641 sub 41h +0632 d8 ret c +0633 fe08 cp 08h +0635 d0 ret nc +0636 cb07 rlc a +0638 47 ld b,a +0639 3ae4fb ld a,(0fbe4h) ; COLOUR BYTE copied into colour ram with every console output +063c e6f1 and 0f1h +063e b0 or b +063f 32e4fb ld (0fbe4h),a ; COLOUR BYTE copied into colour ram with every console output +0642 c9 ret + +0643 3ae4fb ld a,(0fbe4h) ; COLOUR BYTE copied into colour ram with every console output +0646 47 ld b,a +0647 e60e and 0eh +0649 cb07 rlc a +064b cb07 rlc a +064d cb07 rlc a +064f 4f ld c,a +0650 3e70 ld a,70h +0652 a0 and b +0653 cb0f rrc a +0655 cb0f rrc a +0657 cb0f rrc a +0659 b1 or c +065a 32e4fb ld (0fbe4h),a ; COLOUR BYTE copied into colour ram with every console output +065d c9 ret + +065e 08 ex af,af' +065f db50 in a,(50h) ; get system status +0661 e610 and 10h +0663 28fa jr z,065fh ; wait for CSYNC - Composite video sync.signal +0665 08 ex af,af' +0666 77 ld (hl),a +0667 c9 ret + +; Turns screen ram on +0668 db50 in a,(50h) ; get system status +066a cbc7 set 0,a +066c d370 out (70h),a ; Set system status +066e c9 ret + +; Turns screen ram off +066f db50 in a,(50h) ; get system status +0671 cb87 res 0,a +0673 d370 out (70h),a ; Set system status +0675 c9 ret + +; LO-RES Selection routine +0676 db50 in a,(50h) ; get system status +0678 e6fb and 0fbh +067a 180d jr 0689h + +; HI-RES Selection routine +067c db50 in a,(50h) ; get system status +067e f604 or 04h +0680 1807 jr 0689h + +0682 cdae06 call 06aeh ; Turns CRTC off +0685 db50 in a,(50h) ; get system status +0687 ee04 xor 04h + +0689 d370 out (70h),a ; Set system status +068b e604 and 04h +068d 2009 jr nz,0698h +068f ed5b86fc ld de,(0fc86h) ; MAX No. of characters displayed in low resolution +0693 2175fc ld hl,0fc75h +0696 1807 jr 069fh + +0698 ed5b88fc ld de,(0fc88h) ; MAX No. of characters displayed in high resolution +069c 2185fc ld hl,0fc85h + +069f ed53e1fb ld (0fbe1h),de ; MAXIMUM No. CHARACTERS ALLOWED ON SCREEN +06a3 060f ld b,0fh +06a5 cdcc06 call 06cch ; Loads CRTC regs with B+1 bytes dwn from HL +06a8 cdb606 call 06b6h ; Turns CRTC on +06ab c3e304 jp 04e3h ; Clear screen routine + +06ae 3e01 ld a,01h ; Turns CRTC off +06b0 d330 out (30h),a ; CRTC register select +06b2 af xor a +06b3 d331 out (31h),a ; CRTC data +06b5 c9 ret + +06b6 3e01 ld a,01h +06b8 d330 out (30h),a ; CRTC register select +06ba db50 in a,(50h) ; get system status +06bc e604 and 04h +06be 2006 jr nz,06c6h +06c0 3a67fc ld a,(0fc67h) ; No. of characters displayed in a horiz scan +06c3 d331 out (31h),a ; CRTC data +06c5 c9 ret + +06c6 3a77fc ld a,(0fc77h) +06c9 d331 out (31h),a ; CRTC data +06cb c9 ret + +06cc 0e31 ld c,31h ; Loads CRTC regs with B+1 bytes dwn from HL +06ce 0d dec c ; CRTC register select +06cf ed41 out (c),b +06d1 0c inc c ; CRTC data +06d2 edab outd +06d4 20f8 jr nz,06ceh +06d6 0d dec c ; CRTC register select +06d7 ed41 out (c),b +06d9 0c inc c ; CRTC data +06da edab outd +06dc c9 ret + + + + ; LOW SCREEN RESOLUTION CRTC DATA, to be copied to $FC66 + +06dd defb 0x3f ; -> FC66 ......Total No. of character intervals in horiz scan +06de defb 0x28 ; -> FC67 ......No. of characters displayed in a horiz scan +06df defb 0x31 ; -> FC68 ......Horiz sync position (values between 0x31 and 0x2F were used to center the display depending on the video monitor, possibly older ROMs had different values) +06e0 defb 0x05 ; -> FC69 ......horiz sync pulse width +06e1 defb 0x18 ; -> FC6A ......Total No. of character lines +06e2 defb 0x0c ; -> FC6B ......Adjust for vertical sync +06e3 defb 0x18 ; -> FC6C ......No of lines displayed by CRTC +06e4 defb 0x18 ; -> FC6D ......Vertical sync position +06e5 defb 0x00 ; -> FC6E ......Interlace mode +06e6 defb 0x0b ; -> FC6F ......crtc reg.9 +06e7 defb 0x20 ; -> FC70 ......crtc reg.10 -> Cursor blinking +06e8 defb 0x0b ; -> FC71 ......crtc reg 11 +06e9 defb 0x00 ; -> FC72 ......crtc reg 12 +06ea defb 0x00 ; -> FC73 ......crtc reg 13 +06eb defb 0x00 ; -> FC74 ......crtc reg 14 -> cursor position (high byte) +06ec defb 0x00 ; -> FC75 ......crtc reg 15 -> cursor position (low byte) + + + + ; HIGH SCREEN RESOLUTION CRTC DATA, to be copied to $FC76 + +06ed defb 0x7f ; -> FC76 ......Total No. of character intervals in horiz scan +06ee defb 0x50 ; -> FC77 ......No. of characters displayed in a horiz scan +06ef defb 0x62 ; -> FC78 ......Horiz sync position (see above about video display centering) +06f0 defb 0x0a ; -> FC79 ......horiz sync pulse width +06f1 defb 0x18 ; -> FC7A ......Total No. of character lines +06f2 defb 0x0c ; -> FC7B ......Adjust for vertical sync +06f3 defb 0x18 ; -> FC7C ......No of lines displayed by CRTC +06f4 defb 0x18 ; -> FC7D ......Vertical sync position +06f5 defb 0x00 ; -> FC7E ......Interlace mode +06f6 defb 0x0b ; -> FC7F ......crtc reg.9 +06f7 defb 0x20 ; -> FC80 ......crtc reg.10 -> Cursor blinking +06f8 defb 0x0b ; -> FC81 ......crtc reg 11 +06f9 defb 0x00 ; -> FC82 ......crtc reg 12 +06fa defb 0x00 ; -> FC83 ......crtc reg 13 +06fb defb 0x00 ; -> FC84 ......crtc reg 14 -> cursor position (high byte) +06fc defb 0x00 ; -> FC85 ......crtc reg 15 -> cursor position (low byte) + + + + ; MAX No. of characters displayed in low resolution, word value to DATA be copied to $FC86 +006fd defw 03bfh + + + + ; MAX No. of characters displayed in high resolution, word value to DATA be copied to $FC88 +006ff defw 077fh + + + +0701 98 sbc a,b +0702 03 inc bc +0703 3007 jr nc,070ch +0705 181f jr 0726h +0707 03 inc bc +0708 3f ccf +0709 06f8 ld b,0f8h +070b 02 ld (bc),a +070c f0 ret p +070d 05 dec b +070e 14 inc d + +; Get current video parameters (BC=text_colums, DE=?) +070f ed5b8afc ld de,(0fc8ah) +0713 012800 ld bc,0028h +0716 db50 in a,(50h) ; get system status +0718 e604 and 04h +071a c8 ret z +071b ed5b8cfc ld de,(0fc8ch) +071f 015000 ld bc,0050h +0722 c9 ret + +; Cassette write on routine +0723 3ae3fb ld a,(0fbe3h) ; CASSETTE SPEED 01 = 1200 baud 02 = 600 baud 04 = 300 baud +0726 cbff set 7,a ; enable the "cassette write" flag bit +0728 32e3fb ld (0fbe3h),a ; CASSETTE SPEED 01 = 1200 baud 02 = 600 baud 04 = 300 baud +072b cd8b07 call 078bh +072e 0600 ld b,00h +0730 af xor a +0731 cd3d07 call 073dh ; Cassette output routine +0734 10fa djnz 0730h +0736 3ea5 ld a,0a5h ; header byte +0738 1803 jr 073dh ; Cassette output routine + + +; Cassette output routine x2 +073a cd3d07 call 073dh ; Cassette output routine +; Cassette output routine +073d c5 push bc +073e cd5707 call 0757h ; long pulse (start bit) + +0741 0608 ld b,08h ; 1 byte +0743 c5 push bc +0744 cb0f rrc a ; send first the rightmost bit +0746 d45707 call nc,0757h ; long pulse (bit=0) +0749 dc6207 call c,0762h ; short pulse (bit=1) +074c c1 pop bc +074d 10f4 djnz 0743h + +074f cd6207 call 0762h ; short pulse (stop bit) +0752 cd6207 call 0762h ; .. x2 (stop bit) +0755 c1 pop bc +0756 c9 ret + +; send long pulse to cassette +0757 f5 push af +0758 067d ld b,7dh ; 125 +075a 3ae3fb ld a,(0fbe3h) ; CASSETTE SPEED 01 = 1200 baud 02 = 600 baud 04 = 300 baud +075d cbbf res 7,a ; mask out the "cassette write" flag bit +075f 4f ld c,a +0760 1809 jr 076bh + +; send short pulse to cassette +0762 f5 push af + +0763 063d ld b,3dh ; 61 +0765 3ae3fb ld a,(0fbe3h) ; CASSETTE SPEED 01 = 1200 baud 02 = 600 baud 04 = 300 baud +0768 cb27 sla a ; x2 ("cassette write" flag bit is wiped as well) +076a 4f ld c,a + +; send pulse to cassette +076b c5 push bc +076c 10fe djnz 076ch ; delay +076e c1 pop bc + +076f 3e0e ld a,0eh ; cassette output signal=low +0771 d363 out (63h),a ; Parallel Port Interface Control word + +0773 c5 push bc +0774 10fe djnz 0774h ; delay +0776 c1 pop bc + +0777 3e0f ld a,0fh ; cassette output signal=high +0779 d363 out (63h),a ; Parallel Port Interface Control word + +077b 0d dec c +077c 20ed jr nz,076bh ; Repeat 'C' times + +077e f1 pop af +077f c9 ret + +; Cassette off routine +0780 3ae3fb ld a,(0fbe3h) ; CASSETTE SPEED 01 = 1200 baud 02 = 600 baud 04 = 300 baud +0783 cb7f bit 7,a +0785 c8 ret z +0786 cbbf res 7,a ; turn off the "cassette write" flag bit +0788 32e3fb ld (0fbe3h),a ; CASSETTE SPEED 01 = 1200 baud 02 = 600 baud 04 = 300 baud + +078b c5 push bc +078c 062e ld b,2eh ;'*' +078e c5 push bc +078f 019907 ld bc,0799h +0792 c5 push bc +0793 01003d ld bc,3d00h +0796 f5 push af +0797 18d2 jr 076bh + +0799 c1 pop bc +079a 10f2 djnz 078eh +079c c1 pop bc +079d c9 ret + +; Cassette read on routine +079e d9 exx +079f af xor a +07a0 cdc907 call 07c9h ; Casette read routine +07a3 fea5 cp 0a5h ; header byte +07a5 20f9 jr nz,07a0h +07a7 cd0f07 call 070fh ; Get current video parameters (BC=text_colums, DE=?) +; Show '**' in green on the top-right corner +07aa 2adffb ld hl,(0fbdfh) ; CRTC value for "display start address" +07ad 09 add hl,bc +07ae cb9c res 3,h +07b0 2b dec hl +07b1 2b dec hl +07b2 cbec set 5,h +07b4 cd6806 call 0668h ; Turns screen ram on +07b7 362a ld (hl),2ah ; '*' +07b9 cbdc set 3,h +07bb 36f0 ld (hl),0f0h ; green attribute +07bd 23 inc hl +07be 36f0 ld (hl),0f0h ; green attribute +07c0 cb9c res 3,h +07c2 362a ld (hl),2ah ; '*' +07c4 cd6f06 call 066fh ; Turns screen ram off +07c7 d9 exx +07c8 c9 ret + +; Casette read routine (get byte from tape) +07c9 c5 push bc +07ca cd3a08 call 083ah ; get pulse from cassette (and throw it away) +07cd cd3a08 call 083ah ; get pulse from cassette +07d0 fe1d cp 1dh +07d2 38f9 jr c,07cdh +07d4 3ae3fb ld a,(0fbe3h) ; CASSETTE SPEED 01 = 1200 baud 02 = 600 baud 04 = 300 baud +07d7 47 ld b,a +07d8 cb20 sla b +07da 05 dec b +07db cd3a08 call 083ah ; get pulse from cassette +07de 10fb djnz 07dbh +07e0 3e80 ld a,80h +07e2 cdeb07 call 07ebh +07e5 cb1f rr a +07e7 30f9 jr nc,07e2h +07e9 c1 pop bc +07ea c9 ret + +07eb c5 push bc +07ec f5 push af +07ed 3ae3fb ld a,(0fbe3h) ; CASSETTE SPEED 01 = 1200 baud 02 = 600 baud 04 = 300 baud +07f0 47 ld b,a +07f1 0e00 ld c,00h +07f3 c5 push bc +07f4 cd3a08 call 083ah ; get pulse from cassette +07f7 cd3a08 call 083ah ; get pulse from cassette +07fa 81 add a,c +07fb 4f ld c,a +07fc 10f9 djnz 07f7h +07fe c1 pop bc +07ff 48 ld c,b +0800 cb40 bit 0,b +0802 2006 jr nz,080ah +0804 cb3f srl a +0806 cb38 srl b +0808 18f6 jr 0800h +080a fe1d cp 1dh +080c f5 push af +080d 79 ld a,c +080e 3001 jr nc,0811h +0810 07 rlca +0811 07 rlca +0812 91 sub c +0813 3d dec a +0814 47 ld b,a +0815 2805 jr z,081ch +0817 cd3a08 call 083ah ; get pulse from cassette +081a 10fb djnz 0817h +081c f1 pop af +081d c1 pop bc +081e 78 ld a,b +081f c1 pop bc +0820 c9 ret + +; toggle top-right asterisk +0821 d9 exx +0822 cd0f07 call 070fh ; Get current video parameters (BC=text_colums, DE=?) +0825 2adffb ld hl,(0fbdfh) ; CRTC value for "display start address" +0828 09 add hl,bc +0829 2b dec hl +082a cbec set 5,h +082c cb9c res 3,h +082e cd6806 call 0668h ; Turns screen ram on +0831 7e ld a,(hl) +0832 ee0a xor 0ah +0834 77 ld (hl),a +0835 cd6f06 call 066fh ; Turns screen ram off +0838 d9 exx +0839 c9 ret + +; get pulse from cassette +083a c5 push bc +083b db62 in a,(62h) ; Parallel and Cassette I/O port +083d 4f ld c,a +083e 0600 ld b,00h +0840 04 inc b +0841 db62 in a,(62h) ; Parallel and Cassette I/O port +0843 a9 xor c +0844 cb5f bit 3,a +0846 28f8 jr z,0840h +0848 78 ld a,b +0849 c1 pop bc +084a c9 ret + +; 'CSAVEM', part of _CSAVE +084b d7 rst 10h ; CHRGTB: Gets next character (or token) from BASIC text. +084c cdc40e call 0ec4h ; Get parameters for 'CSAVEM'/'CLOADM' +084f cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +0850 2c defb ',' +0851 7a ld a,d +0852 08 ex af,af' +0853 c5 push bc +0854 cdf639 call 39f6h ; GETWORD - Get a number to DE (0..65535) +0857 d5 push de +0858 cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +0859 2c defb ',' +085a cdf639 call 39f6h ; GETWORD - Get a number to DE (0..65535) +085d eb ex de,hl +085e c1 pop bc +085f b7 or a +0860 ed42 sbc hl,bc ; HL= program size +0862 da1c16 jp c,161ch ; Overflow Error (OV ERROR) +0865 e3 ex (sp),hl ; (SP)='program size' +0866 c5 push bc ; (SP)='program position' +0867 cd2307 call 0723h ; Cassette write on routine +086a 3e2f ld a,2fh ; 'CLOADM' marker: 2F2F2F +086c cd3d07 call 073dh ; Cassette output routine +086f cd3a07 call 073ah ; Cassette output routine x 2 +0872 08 ex af,af' +0873 47 ld b,a +0874 7e ld a,(hl) +0875 cdd90e call 0ed9h ; TO UPPER +0878 23 inc hl +0879 cd3d07 call 073dh ; Cassette output routine +087c 10f6 djnz 0874h +087e 3e5c ld a,5ch ; filename end marker +0880 cd3d07 call 073dh ; Cassette output routine +0883 e1 pop hl +0884 c1 pop bc + +0885 7c ld a,h ; HL = Program position ...MSB +0886 cd3d07 call 073dh ; Cassette output routine +0889 7d ld a,l ; ..LSB +088a cd3d07 call 073dh ; Cassette output routine + +088d 78 ld a,b ; BC = Program size ...MSB +088e cd3d07 call 073dh ; Cassette output routine +0891 79 ld a,c ; ..LSB +0892 cd3d07 call 073dh ; Cassette output routine + +0895 7e ld a,(hl) +0896 23 inc hl +0897 cd3d07 call 073dh ; Cassette output routine +089a 0b dec bc +089b 78 ld a,b +089c b1 or c +089d 20f6 jr nz,0895h + +089f eb ex de,hl +08a0 c9 ret + + + +08a1 e1 pop hl +08a2 2b dec hl + +; 'CLOADM' +08a3 d7 rst 10h ; CHRGTB: Gets next character (or token) from BASIC text. +08a4 e5 push hl +08a5 f5 push af +08a6 2803 jr z,08abh ; skip next call if no arguments +08a8 cdc40e call 0ec4h ; Get parameters for 'CSAVEM'/'CLOADM' + +08ab c5 push bc +08ac cd9e07 call 079eh ; Cassette read on routine + +08af 0603 ld b,03h +08b1 cdc907 call 07c9h ; Casette read routine +08b4 fe2f cp 2fh 'CLOADM' marker: 2F2F2F +08b6 20f7 jr nz,08afh +08b8 10f7 djnz 08b1h + +08ba c1 pop bc +08bb f1 pop af +08bc 3e20 ld a,20h ; ' ' +08be 2811 jr z,08d1h + +08c0 cdc907 call 07c9h ; Casette read routine +08c3 5f ld e,a +08c4 0a ld a,(bc) +08c5 cdd90e call 0ed9h ; TO UPPER +08c8 bb cp e +08c9 20d6 jr nz,08a1h + +08cb 03 inc bc +08cc 15 dec d +08cd 20f1 jr nz,08c0h +08cf 3e01 ld a,01h + +08d1 47 ld b,a +08d2 cdc907 call 07c9h ; Casette read routine +08d5 fe5c cp 5ch ; filename end marker +08d7 2804 jr z,08ddh +08d9 10f7 djnz 08d2h +08db 18c4 jr 08a1h + +08dd e3 ex (sp),hl +08de cdc907 call 07c9h ; Casette read routine +08e1 67 ld h,a ; HL= program location ...MSB +08e2 cdc907 call 07c9h ; Casette read routine +08e5 6f ld l,a ; ..LSB +08e6 cdc907 call 07c9h ; Casette read routine +08e9 47 ld b,a ; BC= program size ...MSB +08ea cdc907 call 07c9h ; Casette read routine +08ed 4f ld c,a ; ...LSB + +08ee cdc907 call 07c9h ; Casette read routine +08f1 77 ld (hl),a +08f2 23 inc hl +08f3 0b dec bc +08f4 78 ld a,b +08f5 b1 or c +08f6 20f6 jr nz,08eeh +08f8 e1 pop hl +08f9 c9 ret + + +; RINPUT - Console line input routine +08fa af xor a +08fb 324dfc ld (0fc4dh),a ; Holds last character typed after break +08fe 32c6fd ld (0fdc6h),a ; CURPOS (a.k.a. TTYPOS) - Current cursor position (column number) +0901 cdaefe call 0feaeh +0904 cd6504 call 0465h ; Cursor on routine +0907 2ac7fd ld hl,(0fdc7h) ; Pointer to address of keyboard buffer +090a 01ffff ld bc,0ffffh +090d cdb309 call 09b3h +0910 fe0d cp 0dh +0912 287c jr z,0990h +0914 fe03 cp 03h +0916 2877 jr z,098fh +0918 fe18 cp 18h +091a 2840 jr z,095ch +091c 110d09 ld de,090dh +091f d5 push de +0920 fe20 cp 20h +0922 3013 jr nc,0937h +0924 fe08 cp 08h +0926 281f jr z,0947h +0928 fe09 cp 09h +092a ca6309 jp z,0963h +092d fe1a cp 1ah +092f 2810 jr z,0941h +0931 fe17 cp 17h +0933 cce802 call z,02e8h +0936 c9 ret + +0937 04 inc b +0938 05 dec b +0939 c8 ret z +093a 77 ld (hl),a +093b 23 inc hl +093c cde802 call 02e8h +093f 05 dec b +0940 c9 ret + +0941 cdf202 call 02f2h +0944 d1 pop de +0945 18b3 jr 08fah ; RINPUT - Console line input routine + +0947 78 ld a,b +0948 b9 cp c +0949 c8 ret z +094a 2b dec hl +094b 3e08 ld a,08h +094d cde802 call 02e8h +0950 3e20 ld a,20h +0952 cde802 call 02e8h +0955 3e08 ld a,08h +0957 cde802 call 02e8h +095a 04 inc b +095b c9 ret + +095c cd4709 call 0947h +095f 20fb jr nz,095ch +0961 1897 jr 08fah ; RINPUT - Console line input routine +0963 e5 push hl +0964 c5 push bc +0965 cd2e04 call 042eh +0968 eb ex de,hl +0969 2addfb ld hl,(0fbddh) ; CURSOR POSITION relative to upper L.H. corner +096c b7 or a +096d ed52 sbc hl,de +096f 3005 jr nc,0976h +0971 ed5be1fb ld de,(0fbe1h) ; MAXIMUM No. CHARACTERS ALLOWED ON SCREEN +0975 19 add hl,de +0976 7d ld a,l +0977 c1 pop bc +0978 e1 pop hl +0979 e607 and 07h +097b ed44 neg +097d c608 add a,08h +097f 5f ld e,a +0980 78 ld a,b +0981 b7 or a +0982 c8 ret z +0983 3e20 ld a,20h +0985 77 ld (hl),a +0986 23 inc hl +0987 cde802 call 02e8h +098a 05 dec b +098b 1d dec e +098c c8 ret z +098d 18f1 jr 0980h + +098f 37 scf +0990 f5 push af +0991 3600 ld (hl),00h +0993 3e0d ld a,0dh +0995 cd2e04 call 042eh +0998 cd6e04 call 046eh ; Cursor off routine +099b f1 pop af +099c 2ac7fd ld hl,(0fdc7h) ; Pointer to address of keyboard buffer +099f 2b dec hl +09a0 d8 ret c +09a1 af xor a +09a2 c9 ret + +09a3 cdc0fe call 0fec0h +09a6 d9 exx +09a7 cdea09 call 09eah ; Console status routine +09aa d9 exx +09ab c9 ret + +09ac cda309 call 09a3h ; Console input routine +09af b7 or a +09b0 c0 ret nz +09b1 18f9 jr 09ach ; Console input routine + +09b3 e5 push hl +09b4 c5 push bc +09b5 cdea09 call 09eah ; Console status routine +09b8 c1 pop bc +09b9 e1 pop hl +09ba b7 or a +09bb c0 ret nz +09bc 18f5 jr 09b3h + +; FN_INKEY +09be d7 rst 10h ; CHRGTB: Gets next character (or token) from BASIC text. +09bf e5 push hl +09c0 3a4dfc ld a,(0fc4dh) ; Holds last character typed after break +09c3 b7 or a +09c4 2006 jr nz,09cch +09c6 cda309 call 09a3h +09c9 b7 or a +09ca 2811 jr z,09ddh +09cc f5 push af +09cd af xor a +09ce 324dfc ld (0fc4dh),a ; Holds last character typed after break +09d1 3c inc a +09d2 cd4b37 call 374bh ; MKTMST - Make temporary string +09d5 f1 pop af +09d6 2af4fd ld hl,(0fdf4h) +09d9 77 ld (hl),a +09da c37837 jp 3778h ; TSTOPL - Temporary string to pool + +09dd 217202 ld hl,0272h +09e0 2241fe ld (0fe41h),hl ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +09e3 3e03 ld a,03h +09e5 32cffd ld (0fdcfh),a ; Type flag for FPREG: 2 - Integer, 3 - String, 4 - Single, 5 - Double +09e8 e1 pop hl +09e9 c9 ret + + +; Console status routine +09ea af xor a +09eb d361 out (61h),a ; Keyboard row select +09ed db00 in a,(00h) ; **KEYBOARD_MATRIX_COLUMN_READ** +09ef eeff xor 0ffh +09f1 280f jr z,0a02h +09f3 0efe ld c,0feh +09f5 79 ld a,c +09f6 d361 out (61h),a ; Keyboard row select +09f8 db00 in a,(00h) ; **KEYBOARD_MATRIX_COLUMN_READ** +09fa eeff xor 0ffh +09fc 200f jr nz,0a0dh +09fe cb01 rlc c +0a00 38f3 jr c,09f5h +0a02 21ac0d ld hl,0dach +0a05 af xor a +0a06 32d8fb ld (0fbd8h),a +0a09 22dafb ld (0fbdah),hl +0a0c c9 ret + +0a0d cd890a call 0a89h +0a10 b7 or a +0a11 28eb jr z,09feh +0a13 5f ld e,a +0a14 06ff ld b,0ffh +0a16 04 inc b +0a17 1f rra +0a18 30fc jr nc,0a16h +0a1a 2ad8fb ld hl,(0fbd8h) +0a1d b7 or a +0a1e ed42 sbc hl,bc +0a20 2013 jr nz,0a35h +0a22 2adafb ld hl,(0fbdah) +0a25 2b dec hl +0a26 7c ld a,h +0a27 b5 or l +0a28 2803 jr z,0a2dh +0a2a af xor a +0a2b 18dc jr 0a09h + +0a2d 21bc02 ld hl,02bch +0a30 22dafb ld (0fbdah),hl +0a33 1816 jr 0a4bh +0a35 21c805 ld hl,05c8h +0a38 2b dec hl +0a39 7d ld a,l +0a3a b4 or h +0a3b 20fb jr nz,0a38h +0a3d db00 in a,(00h) ; **KEYBOARD_MATRIX_COLUMN_READ** +0a3f eeff xor 0ffh +0a41 cd890a call 0a89h +0a44 bb cp e +0a45 20b7 jr nz,09feh +0a47 ed43d8fb ld (0fbd8h),bc +0a4b 3eff ld a,0ffh +0a4d 3c inc a +0a4e cb19 rr c +0a50 38fb jr c,0a4dh +0a52 07 rlca +0a53 07 rlca +0a54 07 rlca +0a55 b0 or b +0a56 4f ld c,a +0a57 0600 ld b,00h +0a59 21200b ld hl,0b20h +0a5c 3efe ld a,0feh +0a5e d361 out (61h),a ; Keyboard row select +0a60 db00 in a,(00h) ; **KEYBOARD_MATRIX_COLUMN_READ** +0a62 cb57 bit 2,a +0a64 2002 jr nz,0a68h +0a66 cbf1 set 6,c +0a68 09 add hl,bc +0a69 cb6f bit 5,a +0a6b 7e ld a,(hl) +0a6c 200a jr nz,0a78h +0a6e fe61 cp 61h +0a70 3806 jr c,0a78h +0a72 fe7b cp 7bh +0a74 3002 jr nc,0a78h +0a76 cbaf res 5,a +0a78 fe3c cp 3ch +0a7a d8 ret c +0a7b 47 ld b,a +0a7c 3efd ld a,0fdh +0a7e d361 out (61h),a ; Keyboard row select +0a80 db00 in a,(00h) ; **KEYBOARD_MATRIX_COLUMN_READ** +0a82 cb67 bit 4,a +0a84 78 ld a,b +0a85 c0 ret nz +0a86 e61f and 1fh +0a88 c9 ret + +0a89 cb41 bit 0,c +0a8b 2003 jr nz,0a90h +0a8d e6db and 0dbh +0a8f c9 ret + +0a90 cb49 bit 1,c +0a92 200d jr nz,0aa1h +0a94 cb5f bit 3,a +0a96 2803 jr z,0a9bh +0a98 e608 and 08h +0a9a c9 ret + +0a9b cb67 bit 4,a +0a9d 2849 jr z,0ae8h +0a9f af xor a +0aa0 c9 ret + +0aa1 cb61 bit 4,c +0aa3 c0 ret nz +0aa4 cb7f bit 7,a +0aa6 281d jr z,0ac5h +0aa8 f5 push af +0aa9 3efd ld a,0fdh +0aab d361 out (61h),a ; Keyboard row select +0aad db00 in a,(00h) ; **KEYBOARD_MATRIX_COLUMN_READ** +0aaf cb67 bit 4,a +0ab1 cae20e jp z,0ee2h ; __SYSTEM +0ab4 3efe ld a,0feh +0ab6 d361 out (61h),a ; Keyboard row select +0ab8 db00 in a,(00h) ; **KEYBOARD_MATRIX_COLUMN_READ** +0aba cb57 bit 2,a +0abc ca0000 jp z,0000h +0abf 79 ld a,c +0ac0 d361 out (61h),a ; Keyboard row select +0ac2 f1 pop af +0ac3 cbbf res 7,a +0ac5 cb67 bit 4,a +0ac7 c8 ret z +0ac8 f5 push af +0ac9 3efe ld a,0feh +0acb d361 out (61h),a ; Keyboard row select +0acd db00 in a,(00h) ; **KEYBOARD_MATRIX_COLUMN_READ** +0acf cb57 bit 2,a +0ad1 79 ld a,c +0ad2 2804 jr z,0ad8h +0ad4 d361 out (61h),a +0ad6 f1 pop af +0ad7 c9 ret + +0ad8 d361 out (61h),a ; Keyboard row select +0ada f1 pop af +0adb 218ffc ld hl,0fc8fh ; No.of lines displayed by screen +0ade cb56 bit 2,(hl) +0ae0 21f005 ld hl,05f0h +0ae3 282f jr z,0b14h +0ae5 e6ef and 0efh +0ae7 c9 ret + +0ae8 cb77 bit 6,a +0aea 2805 jr z,0af1h +0aec 21f6fb ld hl,0fbf6h ; Function 1 key exit - initialised to a return +0aef 1815 jr 0b06h + +0af1 cb4f bit 1,a +0af3 2805 jr z,0afah +0af5 21f9fb ld hl,0fbf9h ; Function 2 key exit - initialised to a return +0af8 180c jr 0b06h + +0afa cb47 bit 0,a +0afc 2805 jr z,0b03h +0afe 21fcfb ld hl,0fbfch ; Function 3 key exit - initialised to a return +0b01 1803 jr 0b06h +0b03 21fffb ld hl,0fbffh ; Function 4 key exit - initialised to a return +0b06 3efe ld a,0feh +0b08 d361 out (61h),a ; Keyboard row select +0b0a db00 in a,(00h) ; **KEYBOARD_MATRIX_COLUMN_READ** +0b0c cb57 bit 2,a +0b0e 2004 jr nz,0b14h +0b10 110c00 ld de,000ch +0b13 19 add hl,de +0b14 e3 ex (sp),hl +0b15 211e0b ld hl,0b1eh +0b18 e3 ex (sp),hl +0b19 ed43d8fb ld (0fbd8h),bc +0b1d e9 jp (hl) +0b1e af xor a +0b1f c9 ret + +0b20 72 ld (hl),d +0b21 77 ld (hl),a +0b22 77 ld (hl),a +0b23 65 ld h,l +0b24 09 add hl,bc +0b25 09 add hl,bc +0b26 61 ld h,c +0b27 71 ld (hl),c +0b28 13 inc de +0b29 12 ld (de),a +0b2a 14 inc d +0b2b 2020 jr nz,0b4dh +0b2d 2011 jr nz,0b40h +0b2f 112e6d ld de,6d2eh +0b32 2f cpl +0b33 2c inc l +0b34 62 ld h,d +0b35 62 ld h,d +0b36 6e ld l,(hl) +0b37 6e ld l,(hl) +0b38 27 daa +0b39 6c ld l,h +0b3a 0d dec c +0b3b 3b dec sp +0b3c 6a ld l,d +0b3d 67 ld h,a +0b3e 6b ld l,e +0b3f 68 ld l,b +0b40 34 inc (hl) +0b41 323533 ld (3335h),a +0b44 7f ld a,a +0b45 1b dec de +0b46 31315b ld sp,5b31h +0b49 6f ld l,a +0b4a 5d ld e,l +0b4b 70 ld (hl),b +0b4c 75 ld (hl),l +0b4d 74 ld (hl),h +0b4e 69 ld l,c +0b4f 79 ld a,c +0b50 66 ld h,(hl) +0b51 78 ld a,b + + +0b52 76 halt +0b53 63 ld h,e +0b54 64 ld h,h +0b55 73 ld (hl),e +0b56 7a ld a,d +0b57 7a ld a,d +0b58 3d dec a +0b59 3008 jr nc,0b63h +0b5b 2d dec l +0b5c 3836 jr c,0b94h +0b5e 39 add hl,sp +0b5f 37 scf +0b60 52 ld d,d +0b61 57 ld d,a +0b62 57 ld d,a +0b63 45 ld b,l +0b64 09 add hl,bc +0b65 09 add hl,bc +0b66 41 ld b,c +0b67 51 ld d,c +0b68 13 inc de +0b69 12 ld (de),a +0b6a 14 inc d +0b6b 2020 jr nz,0b8dh +0b6d 2011 jr nz,0b80h +0b6f 113e4d ld de,4d3eh +0b72 3f ccf +0b73 3c inc a +0b74 42 ld b,d +0b75 42 ld b,d +0b76 4e ld c,(hl) +0b77 4e ld c,(hl) +0b78 224c0d ld (0d4ch),hl +0b7b 3a4a47 ld a,(474ah) +0b7e 4b ld c,e +0b7f 48 ld c,b +0b80 24 inc h +0b81 40 ld b,b +0b82 25 dec h +0b83 23 inc hl +0b84 7f ld a,a +0b85 1b dec de +0b86 21217b ld hl,7b21h +0b89 4f ld c,a +0b8a 7d ld a,l +0b8b 50 ld d,b +0b8c 55 ld d,l +0b8d 54 ld d,h +0b8e 49 ld c,c +0b8f 59 ld e,c +0b90 46 ld b,(hl) +0b91 58 ld e,b +0b92 56 ld d,(hl) +0b93 43 ld b,e +0b94 44 ld b,h +0b95 53 ld d,e +0b96 5a ld e,d +0b97 5a ld e,d +0b98 2b dec hl +0b99 29 add hl,hl +0b9a 08 ex af,af' +0b9b 5f ld e,a +0b9c 2a5e28 ld hl,(285eh) +0b9f 26d9 ld h,0d9h +0ba1 4f ld c,a +0ba2 cdbdfe call 0febdh +0ba5 3a50fc ld a,(0fc50h) ; Output device code 0 = Video, 1 = Printer, -1 = Cassette +0ba8 b7 or a +0ba9 79 ld a,c +0baa d9 exx +0bab fa3d07 jp m,073dh ; Cassette output routine +0bae 2018 jr nz,0bc8h ; Print routine +0bb0 f5 push af +0bb1 cde802 call 02e8h +0bb4 d9 exx +0bb5 cd0f07 call 070fh ; Get current video parameters (BC=text_colums, DE=?) +0bb8 2addfb ld hl,(0fbddh) ; CURSOR POSITION relative to upper L.H. corner +0bbb b7 or a +0bbc ed42 sbc hl,bc +0bbe 30fc jr nc,0bbch +0bc0 09 add hl,bc +0bc1 7d ld a,l +0bc2 32c6fd ld (0fdc6h),a ; CURPOS (a.k.a. TTYPOS) - Current cursor position (column number) +0bc5 d9 exx +0bc6 f1 pop af +0bc7 c9 ret + +; Print routine +0bc8 d9 exx +0bc9 4f ld c,a +0bca 1e00 ld e,00h +0bcc 00 nop +0bcd 00 nop +0bce 00 nop +0bcf 00 nop +0bd0 fe0d cp 0dh +0bd2 2805 jr z,0bd9h +0bd4 3a4ffc ld a,(0fc4fh) ; No. of characters printed on this line +0bd7 3c inc a +0bd8 5f ld e,a +0bd9 7b ld a,e +0bda 324ffc ld (0fc4fh),a ; No. of characters printed on this line +0bdd 79 ld a,c +0bde cde30b call 0be3h +0be1 d9 exx +0be2 c9 ret + +0be3 dd21e5fb ld ix,0fbe5h +0be7 00 nop +0be8 00 nop +0be9 00 nop +0bea 00 nop +0beb 00 nop +0bec 00 nop +0bed 1816 jr 0c05h + +0bef af xor a +0bf0 ddb603 or (ix+03h) +0bf3 2810 jr z,0c05h +0bf5 dd7e03 ld a,(ix+03h) +0bf8 dd9604 sub (ix+04h) + +0bfb 47 ld b,a +0bfc 3e0a ld a,0ah +0bfe cd2d0c call 0c2dh ; List routine +0c01 10f9 djnz 0bfch +0c03 1816 jr 0c1bh + +0c05 cd2d0c call 0c2dh ; List routine +0c08 fe0d cp 0dh +0c0a c0 ret nz +0c0b 3e0a ld a,0ah +0c0d cd2d0c call 0c2dh ; List routine +0c10 dd3404 inc (ix+04h) +0c13 dd7e04 ld a,(ix+04h) +0c16 ddbe03 cp (ix+03h) +0c19 79 ld a,c +0c1a c0 ret nz +0c1b dd360400 ld (ix+04h),00h +0c1f c9 ret + +; STOP_LPT +0c20 af xor a +0c21 3250fc ld (0fc50h),a ; Output device code 0 = Video, 1 = Printer, -1 = Cassette +0c24 3a4ffc ld a,(0fc4fh) ; No. of characters printed on this line +0c27 b7 or a +0c28 c8 ret z +0c29 3e0d ld a,0dh +0c2b 189b jr 0bc8h ; Print routine + +; List routine +0c2d 08 ex af,af' +0c2e cd450c call 0c45h ; List status routine +0c31 20fb jr nz,0c2eh +0c33 08 ex af,af' +0c34 d360 out (60h),a ; Parallel output port data [PA0-PA7] +0c36 08 ex af,af' +0c37 3e08 ld a,08h +0c39 d363 out (63h),a ; Parallel Port Interface Control word +0c3b 060a ld b,0ah +0c3d 10fe djnz 0c3dh +0c3f 3e09 ld a,09h +0c41 d363 out (63h),a ; Parallel Port Interface Control word +0c43 08 ex af,af' +0c44 c9 ret + +; List status routine +0c45 db62 in a,(62h) ; Parallel and Cassette I/O port +0c47 e603 and 03h +0c49 c9 ret +0c4a 210048 ld hl,4800h +0c4d cdf510 call 10f5h +0c50 af xor a +0c51 cd5e06 call 065eh +0c54 23 inc hl +0c55 cb54 bit 2,h +0c57 28f7 jr z,0c50h +0c59 f5 push af +0c5a d9 exx +0c5b cd6806 call 0668h ; Turns screen ram on +0c5e 21004c ld hl,4c00h +0c61 0e00 ld c,00h +0c63 59 ld e,c +0c64 1603 ld d,03h +0c66 af xor a +0c67 cb43 bit 0,e +0c69 2802 jr z,0c6dh +0c6b f6f0 or 0f0h +0c6d cb4b bit 1,e +0c6f 2802 jr z,0c73h +0c71 f60f or 0fh +0c73 0604 ld b,04h +0c75 cd5e06 call 065eh +0c78 23 inc hl +0c79 10fa djnz 0c75h +0c7b cb3b srl e +0c7d cb3b srl e +0c7f 15 dec d +0c80 20e4 jr nz,0c66h +0c82 0604 ld b,04h +0c84 af xor a +0c85 cd5e06 call 065eh +0c88 23 inc hl +0c89 10fa djnz 0c85h +0c8b 0c inc c +0c8c cb71 bit 6,c +0c8e 28d3 jr z,0c63h +0c90 cd6f06 call 066fh ; Turns screen ram off +0c93 d9 exx +0c94 f1 pop af +0c95 c9 ret + +; __PCGEN +0c96 cadc00 jp z,00dch +0c99 fea1 cp 0a1h +0c9b 2817 jr z,0cb4h +0c9d fe4f cp 4fh ; 'F' +0c9f 201e jr nz,0cbfh +0ca1 e5 push hl +0ca2 d7 rst 10h ; CHRGTB: Gets next character (or token) from BASIC text. +0ca3 fe46 cp 46h ; 'F' +0ca5 2017 jr nz,0cbeh +0ca7 d7 rst 10h ; CHRGTB: Gets next character (or token) from BASIC text. +0ca8 fe46 cp 46h ; 'F' +0caa 2012 jr nz,0cbeh +0cac d1 pop de +0cad 3ae4fb ld a,(0fbe4h) ; COLOUR BYTE copied into colour ram with every console output +0cb0 cb87 res 0,a ; set PCGEN ON/OFF flag (blank) +0cb2 1805 jr 0cb9h + +0cb4 3ae4fb ld a,(0fbe4h) ; COLOUR BYTE copied into colour ram with every console output +0cb7 cbc7 set 0,a ; set PCGEN ON/OFF flag (noblank) +0cb9 32e4fb ld (0fbe4h),a ; COLOUR BYTE copied into colour ram with every console output +0cbc d7 rst 10h ; CHRGTB: Gets next character (or token) from BASIC text. +0cbd c9 ret + +0cbe e1 pop hl +0cbf cdf639 call 39f6h ; GETWORD - Get a number to DE (0..65535) (or, LDIRVM - Block transfer to VRAM from memory (HL)->(DE), BC times) +0cc2 e5 push hl +0cc3 eb ex de,hl +0cc4 3e80 ld a,80h +0cc6 ad xor l +0cc7 6f ld l,a +0cc8 110040 ld de,4000h +0ccb 00 nop +0ccc 00 nop +0ccd 00 nop +0cce 00 nop +0ccf 29 add hl,hl +0cd0 29 add hl,hl +0cd1 29 add hl,hl +0cd2 29 add hl,hl +0cd3 19 add hl,de +0cd4 eb ex de,hl +0cd5 e1 pop hl +0cd6 2b dec hl +0cd7 d7 rst 10h ; CHRGTB: Gets next character (or token) from BASIC text. +0cd8 2806 jr z,0ce0h +0cda fe2c cp ',' +0cdc 2818 jr z,0cf6h +0cde cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +0cdf 3b defb ';' +0ce0 060c ld b,0ch +0ce2 cd6806 call 0668h ; Turns screen ram on +0ce5 af xor a +0ce6 eb ex de,hl +0ce7 cd5e06 call 065eh +0cea 23 inc hl +0ceb 10fa djnz 0ce7h +0ced eb ex de,hl +0cee cd6f06 call 066fh ; Turns screen ram off +0cf1 2b dec hl +0cf2 d7 rst 10h ; CHRGTB: Gets next character (or token) from BASIC text. +0cf3 c8 ret z +0cf4 18c9 jr 0cbfh +0cf6 0610 ld b,10h +0cf8 d7 rst 10h ; CHRGTB: Gets next character (or token) from BASIC text. +0cf9 fe2c cp ',' +0cfb 2818 jr z,0d15h +0cfd d5 push de +0cfe c5 push bc +0cff cdf639 call 39f6h ; GETWORD - Get a number to DE (0..65535) +0d02 7a ld a,d +0d03 b7 or a +0d04 c21c16 jp nz,161ch ; Overflow Error (OV ERROR) +0d07 cd6806 call 0668h ; Turns screen ram on +0d0a 7b ld a,e +0d0b c1 pop bc +0d0c d1 pop de +0d0d eb ex de,hl +0d0e cd5e06 call 065eh +0d11 cd6f06 call 066fh ; Turns screen ram off +0d14 eb ex de,hl +0d15 13 inc de +0d16 2b dec hl +0d17 d7 rst 10h ; CHRGTB: Gets next character (or token) from BASIC text. +0d18 c8 ret z +0d19 fe2c cp ',' +0d1b 2005 jr nz,0d22h +0d1d 10d9 djnz 0cf8h +0d1f c38128 jp 2881h ; Syntax Error (SN ERROR) +0d22 cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +0d23 3b defb ';' +0d24 c8 ret z +0d25 1898 jr 0cbfh + +; __RANDOM +0d27 ed5f ld a,r +0d29 32cbfd ld (0fdcbh),a +0d2c c9 ret + +; __COLOUR +0d2d ca1300 jp z,0013h ; Memory Overflow (MO ERROR) +0d30 fe23 cp 23h ; '#' +0d32 2018 jr nz,0d4ch ; look for extra paramenters +0d34 d7 rst 10h ; CHRGTB: Gets next character (or token) from BASIC text. +0d35 fe31 cp 31h ; test for colour #1 +0d37 2006 jr nz,0d3fh ; not colour #1, try colour #2 +0d39 db50 in a,(50h) ; get system status +0d3b cb9f res 3,a ; set colour #1 +0d3d 1809 jr 0d48h ; exit via 'set system status' + +0d3f fe32 cp 32h ; test colour #2 +0d41 c28128 jp nz,2881h ; Syntax Error (SN ERROR) if not valid color +0d44 db50 in a,(50h) ; get system status +0d46 cbdf set 3,a ; set colour #2 + +0d48 d370 out (70h),a ; Set system status +0d4a d7 rst 10h ; CHRGTB: Gets next character (or token) from BASIC text. +0d4b c9 ret + +; look for extra parameters in colour commands +0d4c fe2c cp ',' +0d4e 2008 jr nz,0d58h ; no, try for other values +0d50 3ae4fb ld a,(0fbe4h) ; COLOUR BYTE copied into colour ram with every console output +0d53 e6f0 and 0f0h ; mask background color +0d55 f5 push af ; save foreground color +0d56 181a jr 0d72h ; test next value + +0d58 cdf639 call 39f6h ; GETWORD - Get a number to DE (0..65535) +0d5b 201a jr nz,0d77h ; > 255 ? +0d5d 7b ld a,e ; store foreground color +0d5e fe10 cp 10h ; 0..15 ? +0d60 301b jr nc,0d7dh ; Overflow Error (OV ERROR) +0d62 07 rlca ; SHIFT foreground color.. +0d63 07 rlca ; ..to top nibble.. +0d64 07 rlca ; ..to conform.. +0d65 07 rlca ; ..to colour byte format +0d66 f5 push af ; save foreground colour +0d67 2b dec hl ; reset symbol pointer +0d68 d7 rst 10h ; CHRGTB: Gets next character (or token) from BASIC text. +0d69 2007 jr nz,0d72h +0d6b 3ae4fb ld a,(0fbe4h) ; COLOUR BYTE copied into colour ram with every console output +0d6e e60e and 0eh ; mask foreground colour +0d70 180f jr 0d81h ; go mix colours + +; text next value in colour commands +0d72 cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +0d73 2c defb ',' +0d74 cdf639 call 39f6h ; GETWORD - Get a number to DE (0..65535) +0d77 c21c16 jp nz,161ch ; Overflow Error (OV ERROR) +0d7a 7b ld a,e ; get background colour +0d7b fe08 cp 08h ; 0..7 ? +0d7d d21c16 jp nc,161ch ; Overflow Error (OV ERROR) +0d80 07 rlca ; background to colour byte format +0d81 c1 pop bc ; get foreground colour +0d82 b0 or b ; mix fore and back colours +0d83 47 ld b,a ; temp store in B +0d84 3ae4fb ld a,(0fbe4h) ; COLOUR BYTE copied into colour ram with every console output +0d87 e601 and 01h ; save PCGEN ON/OFF flag (blank) +0d89 b0 or b ; mix it with colours +0d8a 32e4fb ld (0fbe4h),a ; COLOUR BYTE copied into colour ram with every console output +0d8d 7e ld a,(hl) ; fetch next symbol +0d8e c9 ret + + + + +0d8f cd890e call 0e89h +0d92 b0 or b +0d93 c5 push bc +0d94 47 ld b,a +0d95 db50 in a,(50h) ; get system status +0d97 e610 and 10h +0d99 28fa jr z,0d95h ; wait for CSYNC - Composite video sync.signal +0d9b 78 ld a,b +0d9c 77 ld (hl),a +0d9d c1 pop bc +0d9e c9 ret + +0d9f 2f cpl +0da0 a0 and b +0da1 18f0 jr 0d93h + +0da3 cbc7 set 0,a +0da5 18ec jr 0d93h +0da7 03 inc bc +0da8 18f9 jr 0da3h + +0daa cdaf0d call 0dafh ; Enable sound output, BC=audio frequency +0dad e1 pop hl +0dae c9 ret + +; Enable sound output, BC=audio frequency +0daf 3e36 ld a,36h +0db1 d323 out (23h),a ; 8253 MODE CONTROL WORD +0db3 79 ld a,c +0db4 d320 out (20h),a ; COUNTER 0 - Audio output freq. +0db6 78 ld a,b +0db7 d320 out (20h),a ; COUNTER 0 - Audio output freq. +0db9 c9 ret + +; Stop sound output +0dba 3e34 ld a,34h +0dbc d323 out (23h),a ; 8253 MODE CONTROL WORD +0dbe c9 ret + + +; __SET +0dbf cdfe0d call 0dfeh ; COORD_PARMS_DST - get X,Y parameters for graphics coordinates +0dc2 d5 push de +0dc3 cd8f0d call 0d8fh +0dc6 00 nop +0dc7 00 nop +0dc8 180a jr 0dd4h + +; __RESET +0dca cdfe0d call 0dfeh ; COORD_PARMS_DST - get X,Y parameters for graphics coordinates +0dcd d5 push de +0dce cd890e call 0e89h +0dd1 cd9f0d call 0d9fh +0dd4 cbdc set 3,h +0dd6 3ae4fb ld a,(0fbe4h) ; COLOUR BYTE copied into colour ram with every console output +0dd9 cda30d call 0da3h +0ddc cd6f06 call 066fh ; Turns screen ram off +0ddf e1 pop hl +0de0 c9 ret + +; FN_POINT +0de1 d7 rst 10h ; CHRGTB: Gets next character (or token) from BASIC text. +0de2 cdfe0d call 0dfeh ; COORD_PARMS_DST - get X,Y parameters for graphics coordinates +0de5 d5 push de +0de6 300a jr nc,0df2h +0de8 cd890e call 0e89h +0deb a0 and b +0dec 2805 jr z,0df3h +0dee 3e01 ld a,01h +0df0 1801 jr 0df3h + +0df2 78 ld a,b +0df3 6f ld l,a +0df4 2600 ld h,00h +0df6 cd0419 call 1904h ; INT_RESULT_HL - Get back from function, result in HL +0df9 cd6f06 call 066fh ; Turns screen ram off +0dfc e1 pop hl +0dfd c9 ret + +; COORD_PARMS_DST - get X,Y parameters for graphics coordinates +0dfe cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +0dff 28 defb '(' +0e00 cdf639 call 39f6h ; GETWORD - Get a number to DE (0..65535) +0e03 c21c16 jp nz,161ch ; Overflow Error (OV ERROR) +0e06 7b ld a,e +0e07 3291fc ld (0fc91h),a ; First warm start flag +0e0a cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +0e0b 2c defb ',' +0e0c cdf639 call 39f6h ; GETWORD - Get a number to DE (0..65535) +0e0f c21c16 jp nz,161ch ; Overflow Error (OV ERROR) +0e12 7b ld a,e +0e13 3c inc a +0e14 3292fc ld (0fc92h),a +0e17 cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +0e18 29 add hl,hl +0e19 e5 push hl +0e1a af xor a +0e1b 2191fc ld hl,0fc91h ; First warm start flag +0e1e db50 in a,(50h) ; get system status +0e20 e604 and 04h +0e22 3e28 ld a,28h +0e24 2801 jr z,0e27h + +0e26 17 rla +0e27 17 rla +0e28 3d dec a +0e29 be cp (hl) +0e2a da1c16 jp c,161ch ; Overflow Error (OV ERROR) +0e2d 3a8efc ld a,(0fc8eh) +0e30 47 ld b,a +0e31 80 add a,b +0e32 80 add a,b +0e33 23 inc hl +0e34 be cp (hl) +0e35 da1c16 jp c,161ch ; Overflow Error (OV ERROR) +0e38 af xor a +0e39 3293fc ld (0fc93h),a +0e3c 0e03 ld c,03h +0e3e 47 ld b,a +0e3f 3a92fc ld a,(0fc92h) +0e42 91 sub c +0e43 280a jr z,0e4fh +0e45 3803 jr c,0e4ah +0e47 04 inc b +0e48 18f8 jr 0e42h + +0e4a 78 ld a,b +0e4b 3c inc a +0e4c 3293fc ld (0fc93h),a +0e4f af xor a +0e50 db50 in a,(50h) ; get system status +0e52 e604 and 04h +0e54 3e28 ld a,28h +0e56 2801 jr z,0e59h +0e58 17 rla +0e59 210000 ld hl,0000h +0e5c 1600 ld d,00h +0e5e 5f ld e,a +0e5f 04 inc b +0e60 05 dec b +0e61 2803 jr z,0e66h +0e63 19 add hl,de +0e64 10fd djnz 0e63h +0e66 3a91fc ld a,(0fc91h) ; First warm start flag +0e69 1f rra +0e6a 1600 ld d,00h +0e6c 5f ld e,a +0e6d 19 add hl,de +0e6e ed5bdffb ld de,(0fbdfh) ; CRTC value for "display start address" +0e72 19 add hl,de +0e73 7c ld a,h +0e74 e607 and 07h +0e76 f628 or 28h +0e78 67 ld h,a +0e79 cd6806 call 0668h ; Turns screen ram on +0e7c cd7302 call 0273h +0e7f 00 nop +0e80 00 nop +0e81 00 nop +0e82 00 nop +0e83 00 nop +0e84 00 nop +0e85 00 nop +0e86 00 nop +0e87 d1 pop de +0e88 c9 ret + +0e89 3809 jr c,0e94h +0e8b cd9302 call 0293h +0e8e 00 nop +0e8f 00 nop +0e90 00 nop +0e91 00 nop +0e92 00 nop +0e93 00 nop +0e94 eb ex de,hl +0e95 0e00 ld c,00h +0e97 2191fc ld hl,0fc91h ; First warm start flag +0e9a cb46 bit 0,(hl) +0e9c 2801 jr z,0e9fh +0e9e 0c inc c +0e9f 0c inc c +0ea0 2193fc ld hl,0fc93h +0ea3 7e ld a,(hl) +0ea4 b7 or a +0ea5 2812 jr z,0eb9h +0ea7 cb47 bit 0,a +0ea9 2807 jr z,0eb2h +0eab 2b dec hl +0eac cb46 bit 0,(hl) +0eae 2011 jr nz,0ec1h +0eb0 180b jr 0ebdh + +0eb2 2b dec hl +0eb3 cb46 bit 0,(hl) +0eb5 280a jr z,0ec1h +0eb7 1804 jr 0ebdh +0eb9 cb01 rlc c +0ebb cb01 rlc c +0ebd cb01 rlc c +0ebf cb01 rlc c +0ec1 79 ld a,c +0ec2 eb ex de,hl +0ec3 c9 ret + +; Get parameters for 'CSAVEM'/'CLOADM' +0ec4 cd2b32 call 322bh ; EVAL +0ec7 e7 rst 20h ; GETYPR - Get the number type (FAC) +0ec8 c28128 jp nz,2881h ; Syntax Error (SN ERROR) +0ecb e5 push hl +0ecc cdce38 call 38ceh ; GSTRCU - Get string pointed by FPREG +0ecf cd2e18 call 182eh ; LOADFP_0 - move 3 bytes from (HL) to D,C,B +0ed2 7a ld a,d +0ed3 b7 or a +0ed4 ca8128 jp z,2881h ; Syntax Error (SN ERROR) +0ed7 e1 pop hl +0ed8 c9 ret + +; simple TOUPPER conversion for CLOADM/CSAVEM +0ed9 fe61 cp 61h ; 'a' +0edb d8 ret c +0edc fe7b cp 7bh +0ede d0 ret nc ; 'z'+1 +0edf e65f and 5fh ; TO UPPER +0ee1 c9 ret + +; __SYSTEM +0ee2 cdc902 call 02c9h ; Detect Disk Drive Controller +0ee5 2809 jr z,0ef0h +0ee7 21a510 ld hl,10a5h ; "No Controller" +0eea cd9b37 call 379bh ; PRS - Output a string +0eed c30000 jp 0000h + +0ef0 217410 ld hl,1074h ; BEL, ESC, 'H', 16h, 1Ah +0ef3 cd9b37 call 379bh ; PRS - Output a string +0ef6 cda211 call 11a2h +0ef9 1e01 ld e,01h +0efb 3ed0 ld a,0d0h +0efd cd3e10 call 103eh +0f00 010400 ld bc,0004h +0f03 dbf0 in a,(0f0h) ; WD2793 FDC command/status register +0f05 e680 and 80h +0f07 2821 jr z,0f2ah +0f09 cd4510 call 1045h +0f0c cd5310 call 1053h ; timing delay +0f0f 10f2 djnz 0f03h +0f11 0d dec c +0f12 20ef jr nz,0f03h +0f14 217a10 ld hl,107ah ; "INSERT DISK" +0f17 cd9b37 call 379bh ; PRS - Output a string +0f1a cdea09 call 09eah ; Console status routine +0f1d b7 or a +0f1e c21b00 jp nz,001bh +0f21 1e01 ld e,01h +0f23 cd4510 call 1045h +0f26 e680 and 80h +0f28 20f0 jr nz,0f1ah +0f2a 3134fc ld sp,0fc34h +0f2d dbe8 in a,(0e8h) ; disk status +0f2f e602 and 02h ; selected disk size +0f31 47 ld b,a +0f32 ee02 xor 02h +0f34 d3ec out (0ech),a ; change disk size +0f36 dbe8 in a,(0e8h) ; disk status +0f38 e602 and 02h ; selected disk size +0f3a b8 cp b +0f3b 2008 jr nz,0f45h +0f3d b7 or a +0f3e 2008 jr nz,0f48h + +0f40 cd580f call 0f58h ; init disk with size bit disabled +0f43 1806 jr 0f4bh + +0f45 cd580f call 0f58h + +0f48 cd540f call 0f54h ; init disk with size bit enabled + +0f4b 218910 ld hl,1089h ; "READ ERROR" +0f4e cd9b37 call 379bh ; PRS - Output a string +0f51 c30000 jp 0000h + +; init disk with size bit enabled +0f54 3e02 ld a,02h +0f56 1802 jr 0f5ah + +; init disk with size bit disabled +0f58 3e00 ld a,00h +0f5a d3ec out (0ech),a ; init disk type (size, density..) +0f5c 0603 ld b,03h +0f5e 3e0c ld a,0ch +0f60 cd3e10 call 103eh +0f63 e618 and 18h +0f65 2803 jr z,0f6ah +0f67 10f5 djnz 0f5eh +0f69 c9 ret + +0f6a 1605 ld d,05h +0f6c 216610 ld hl,1066h +0f6f 0ee0 ld c,0e0h +0f71 060e ld b,0eh +0f73 edb3 otir +0f75 3e01 ld a,01h +0f77 d3f2 out (0f2h),a ; FDC sector register +0f79 3e86 ld a,86h +0f7b cd3e10 call 103eh +0f7e e61c and 1ch +0f80 2804 jr z,0f86h +0f82 15 dec d +0f83 20e7 jr nz,0f6ch +0f85 c9 ret + +0f86 2a00d4 ld hl,(0d400h) +0f89 114c53 ld de,534ch +0f8c b7 or a +0f8d ed52 sbc hl,de +0f8f 2061 jr nz,0ff2h +0f91 2a02d4 ld hl,(0d402h) +0f94 11432e ld de,2e43h +0f97 b7 or a +0f98 ed52 sbc hl,de +0f9a 2056 jr nz,0ff2h +0f9c 1100ea ld de,0ea00h +0f9f 2a08d4 ld hl,(0d408h) +0fa2 19 add hl,de +0fa3 ed4b06d4 ld bc,(0d406h) +0fa7 110105 ld de,0501h +0faa c5 push bc +0fab d5 push de +0fac e5 push hl +0fad cdfb0f call 0ffbh +0fb0 e1 pop hl +0fb1 d1 pop de +0fb2 c1 pop bc +0fb3 b7 or a +0fb4 2804 jr z,0fbah +0fb6 15 dec d +0fb7 20f1 jr nz,0faah +0fb9 c9 ret + +0fba 3a05d4 ld a,(0d405h) +0fbd eb ex de,hl +0fbe 214000 ld hl,0040h +0fc1 29 add hl,hl +0fc2 0f rrca +0fc3 30fc jr nc,0fc1h +0fc5 19 add hl,de +0fc6 0c inc c +0fc7 10de djnz 0fa7h +0fc9 3a00ea ld a,(0ea00h) +0fcc fec3 cp 0c3h +0fce 2022 jr nz,0ff2h +0fd0 3a03ea ld a,(0ea03h) +0fd3 fec3 cp 0c3h +0fd5 201b jr nz,0ff2h +0fd7 ed5bd1fd ld de,(0fdd1h) ; Memory size +0fdb 2a54fc ld hl,(0fc54h) ; Address of string area boundary +0fde b7 or a +0fdf ed52 sbc hl,de +0fe1 11fed3 ld de,0d3feh +0fe4 ed53d1fd ld (0fdd1h),de ; Memory size +0fe8 19 add hl,de +0fe9 2254fc ld (0fc54h),hl ; Address of string area boundary +0fec cd472a call 2a47h +0fef c31611 jp 1116h + +0ff2 21b710 ld hl,10b7h +0ff5 cd9b37 call 379bh ; PRS - Output a string +0ff8 c30000 jp 0000h + +0ffb 3e83 ld a,83h +0ffd d3e0 out (0e0h),a ; DMA CONTROL PORT +0fff 3e19 ld a,19h +1001 d3e0 out (0e0h),a ; DMA CONTROL PORT +1003 7d ld a,l +1004 d3e0 out (0e0h),a ; DMA CONTROL PORT +1006 7c ld a,h +1007 d3e0 out (0e0h),a ; DMA CONTROL PORT +1009 79 ld a,c +100a 216a10 ld hl,106ah +100d 0ee0 ld c,0e0h +100f 060a ld b,0ah +1011 edb3 otir +1013 cba3 res 4,e +1015 2104d4 ld hl,0d404h +1018 be cp (hl) +1019 3803 jr c,101eh +101b cbe3 set 4,e +101d 96 sub (hl) +101e 210ad4 ld hl,0d40ah +1021 4f ld c,a +1022 0600 ld b,00h +1024 09 add hl,bc +1025 7e ld a,(hl) +1026 d3f2 out (0f2h),a ; FDC sector register +1028 7b ld a,e +1029 d3e4 out (0e4h),a ; Disk select +102b cd5310 call 1053h ; timing delay +102e 0e86 ld c,86h +1030 3e10 ld a,10h +1032 a3 and e +1033 2802 jr z,1037h +1035 cbd9 set 3,c +1037 79 ld a,c +1038 cd3e10 call 103eh +103b e61c and 1ch +103d c9 ret + +103e d3f0 out (0f0h),a ; WD2793 FDC command/status register +1040 3e0a ld a,0ah +1042 3d dec a +1043 20fd jr nz,1042h +1045 7b ld a,e +1046 d3e4 out (0e4h),a ; Disk select +1048 f620 or 20h +104a d3e4 out (0e4h),a ; Disk select +104c dbf0 in a,(0f0h) ; WD2793 FDC command/status register +104e cb47 bit 0,a +1050 20f3 jr nz,1045h +1052 c9 ret + +; timing delay +1053 af xor a +1054 3d dec a +1055 00 nop +1056 20fc jr nz,1054h +1058 c9 ret + +1059 dbf1 in a,(0f1h) ; FDC tract register +105b 2f cpl +105c d3f1 out (0f1h),a ; FDC tract register +105e 4f ld c,a +105f cd5310 call 1053h ; timing delay +1062 dbf1 in a,(0f1h) ; FDC tract register +1064 b9 cp c +1065 c9 ret + + + +1066 83 add a,e +1067 19 add hl,de +1068 00 nop +1069 d46100 call nc,0061h ; List status routine +106c 04 inc b +106d 14 inc d +106e 2885 jr z,0ff5h +1070 f3 di +1071 8a adc a,d +1072 cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +1073 87 defb 87h ; TK_NEXT +1074 07 rlca +1075 1b dec de +1076 48 ld c,b +1077 161a ld d,1ah +1079 00 nop +107a 17 rla + +107b 1649 ld d,49h +107d 4e ld c,(hl) +107e 53 ld d,e +107f 45 ld b,l +1080 52 ld d,d +1081 54 ld d,h +1082 2044 jr nz,10c8h +1084 49 ld c,c +1085 53 ld d,e +1086 4b ld c,e +1087 0a ld a,(bc) +1088 00 nop +1089 0d dec c +108a 0a ld a,(bc) +108b 52 ld d,d +108c 45 ld b,l +108d 41 ld b,c +108e 44 ld b,h +108f 2045 jr nz,10d6h +1091 52 ld d,d +1092 52 ld d,d +1093 4f ld c,a +1094 52 ld d,d +1095 202e jr nz,10c5h +1097 2e20 ld l,20h +1099 4e ld c,(hl) +109a 4f ld c,a +109b 2053 jr nz,10f0h +109d 59 ld e,c +109e 53 ld d,e +109f 54 ld d,h +10a0 45 ld b,l +10a1 4d ld c,l +10a2 0d dec c +10a3 0a ld a,(bc) +10a4 00 nop +10a5 0d dec c +10a6 0a ld a,(bc) +10a7 4e ld c,(hl) +10a8 6f ld l,a +10a9 2043 jr nz,10eeh +10ab 6f ld l,a +10ac 6e ld l,(hl) +10ad 74 ld (hl),h +10ae 72 ld (hl),d +10af 6f ld l,a +10b0 6c ld l,h +10b1 6c ld l,h +10b2 65 ld h,l +10b3 72 ld (hl),d +10b4 0d dec c +10b5 0a ld a,(bc) +10b6 00 nop +10b7 0d dec c +10b8 0a ld a,(bc) +10b9 4e ld c,(hl) +10ba 6f ld l,a +10bb 74 ld (hl),h +10bc 2061 jr nz,111fh +10be 2053 jr nz,1113h +10c0 79 ld a,c +10c1 73 ld (hl),e +10c2 74 ld (hl),h +10c3 65 ld h,l +10c4 6d ld l,l +10c5 2044 jr nz,110bh +10c7 69 ld l,c +10c8 73 ld (hl),e +10c9 6b ld l,e +10ca 0d dec c +10cb 0a ld a,(bc) +10cc 00 nop + +10cd 1a ld a,(de) + +10ce 161b ld d,1bh +10d0 49 ld c,c +10d1 07 rlca +10d2 0d dec c +10d3 45 ld b,l +10d4 78 ld a,b +10d5 63 ld h,e +10d6 61 ld h,c +10d7 6c ld l,h +10d8 69 ld l,c +10d9 62 ld h,d +10da 75 ld (hl),l +10db 72 ld (hl),d +10dc 2036 jr nz,1114h +10de 34 inc (hl) +10df 2045 jr nz,1126h +10e1 78 ld a,b +10e2 74 ld (hl),h +10e3 65 ld h,l +10e4 6e ld l,(hl) +10e5 64 ld h,h +10e6 65 ld h,l +10e7 64 ld h,h +10e8 2042 jr nz,112ch +10ea 61 ld h,c +10eb 73 ld (hl),e +10ec 69 ld l,c +10ed 63 ld h,e +10ee 2031 jr nz,1121h +10f0 2e31 ld l,31h +10f2 0d dec c +10f3 0d dec c +10f4 00 nop +10f5 cd6806 call 0668h ; Turns screen ram on +10f8 e5 push hl +10f9 f5 push af +10fa 210030 ld hl,3000h ; PCG RAM address + +10fd db50 in a,(50h) ; get system status +10ff e610 and 10h +1101 28fa jr z,10fdh ; wait for CSYNC - Composite video sync.signal +1103 3604 ld (hl),04h +1105 23 inc hl +1106 cb5c bit 3,h +1108 28f3 jr z,10fdh +110a f1 pop af +110b e1 pop hl +110c c9 ret + +; PRS - Output a string to video device +110d 3e00 ld a,00h +110f 3250fc ld (0fc50h),a ; Output device code 0 = Video, 1 = Printer, -1 = Cassette +1112 cd9b37 call 379bh ; PRS - Output a string +1115 c9 ret + +1116 cd3a3f call 3f3ah +1119 00 nop +111a 00 nop +111b 00 nop +111c 00 nop +111d c300ea jp 0ea00h +1120 74 ld (hl),h +1121 0d dec c +1122 0a ld a,(bc) +1123 00 nop + +1124 0d dec c +1125 0a ld a,(bc) +1126 44 ld b,h +1127 69 ld l,c +1128 73 ld (hl),e +1129 6b ld l,e +112a 2069 jr nz,1195h +112c 73 ld (hl),e +112d 206e jr nz,119dh +112f 6f ld l,a +1130 74 ld (hl),h +1131 2061 jr nz,1194h +1133 2076 jr nz,11abh +1135 61 ld h,c +1136 6c ld l,h +1137 69 ld l,c +1138 64 ld h,h +1139 2073 jr nz,11aeh +113b 79 ld a,c +113c 73 ld (hl),e +113d 74 ld (hl),h +113e 65 ld h,l +113f 6d ld l,l +1140 2064 jr nz,11a6h +1142 69 ld l,c +1143 73 ld (hl),e +1144 6b ld l,e +1145 0d dec c +1146 0a ld a,(bc) +1147 00 nop + +; __OPEN +1148 cdd011 call 11d0h +114b c2352d jp nz,2d35h ; Error: Illegal function call (FC ERROR) +114e d7 rst 10h ; CHRGTB: Gets next character (or token) from BASIC text. +114f cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +1150 2c defb ',' +1151 d5 push de +1152 43 ld b,e +1153 cd5612 call 1256h +1156 cd103f call 3f10h +1159 cd6712 call 1267h ; get filename +115c c2352d jp nz,2d35h ; Error: Illegal function call (FC ERROR) +115f 0e0f ld c,0fh +1161 cd4d15 call 154dh +1164 3c inc a +1165 2009 jr nz,1170h +1167 0e16 ld c,16h +1169 cd4d15 call 154dh +116c 3c inc a +116d ca352d jp z,2d35h ; Error: Illegal function call (FC ERROR) +1170 c1 pop bc +1171 3a9dfc ld a,(0fc9dh) +1174 b0 or b +1175 329dfc ld (0fc9dh),a +1178 0600 ld b,00h +117a eb ex de,hl +117b 21bdfd ld hl,0fdbdh +117e 09 add hl,bc +117f 70 ld (hl),b +1180 eb ex de,hl +1181 c9 ret + +; __CLOSE +1182 281e jr z,11a2h +1184 cdd011 call 11d0h +1187 d5 push de +1188 cd0c14 call 140ch +118b 0e10 ld c,10h +118d cd4d15 call 154dh +1190 3c inc a +1191 ca352d jp z,2d35h ; Error: Illegal function call (FC ERROR) +1194 d1 pop de +1195 3a9dfc ld a,(0fc9dh) +1198 aa xor d +1199 329dfc ld (0fc9dh),a +119c d7 rst 10h ; CHRGTB: Gets next character (or token) from BASIC text. +119d c8 ret z +119e cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +119f 2c defb ',' +11a0 18e2 jr 1184h + +11a2 3a9dfc ld a,(0fc9dh) +11a5 b7 or a +11a6 c8 ret z +11a7 0608 ld b,08h +11a9 0f rrca +11aa 3802 jr c,11aeh +11ac 10fb djnz 11a9h +11ae 58 ld e,b +11af 3e00 ld a,00h +11b1 1f rra +11b2 10fd djnz 11b1h +11b4 57 ld d,a +11b5 3e09 ld a,09h +11b7 93 sub e +11b8 5f ld e,a +11b9 d5 push de +11ba cd0c14 call 140ch +11bd 0e10 ld c,10h +11bf cd4d15 call 154dh +11c2 3c inc a +11c3 ca352d jp z,2d35h ; Error: Illegal function call (FC ERROR) +11c6 c1 pop bc +11c7 3a9dfc ld a,(0fc9dh) +11ca a8 xor b +11cb 329dfc ld (0fc9dh),a +11ce 18d2 jr 11a2h + +11d0 ca1300 jp z,0013h ; Memory Overflow (MO ERROR) +11d3 d28128 jp nc,2881h ; Syntax Error (SN ERROR) +11d6 fe39 cp 39h +11d8 d2352d jp nc,2d35h ; Error: Illegal function call (FC ERROR) +11db d630 sub 30h +11dd 5f ld e,a +11de 43 ld b,e +11df af xor a +11e0 37 scf +11e1 17 rla +11e2 10fd djnz 11e1h +11e4 57 ld d,a +11e5 3a9dfc ld a,(0fc9dh) +11e8 a2 and d +11e9 c9 ret + +11ea cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +11eb 22 defb '"' +11ec ca jp z,2881h ; Syntax Error (SN ERROR) +11ef d7 rst 10h ; CHRGTB: Gets next character (or token) from BASIC text. +11f0 b7 or a +11f1 ca8128 jp z,2881h ; Syntax Error (SN ERROR) +11f4 2b dec hl +11f5 2b dec hl +11f6 fe3a cp 3ah ; ':' +11f8 3e00 ld a,00h +11fa 200f jr nz,120bh +11fc d7 rst 10h ; CHRGTB: Gets next character (or token) from BASIC text. +11fd da6515 jp c,1565h ; ?FD Error +1200 e65f and 5fh +1202 d641 sub 41h +1204 fe0d cp 0dh +1206 d26515 jp nc,1565h ; ?FD Error +1209 3c inc a +120a 23 inc hl +120b 12 ld (de),a +120c d5 push de +120d eb ex de,hl +120e 23 inc hl +120f 3e20 ld a,20h +1211 060b ld b,0bh +1213 77 ld (hl),a +1214 23 inc hl +1215 10fc djnz 1213h +1217 af xor a +1218 0605 ld b,05h +121a 77 ld (hl),a +121b 23 inc hl +121c 10fc djnz 121ah +121e 010f00 ld bc,000fh +1221 09 add hl,bc +1222 77 ld (hl),a +1223 eb ex de,hl +1224 d1 pop de +1225 d5 push de +1226 13 inc de +1227 0609 ld b,09h +1229 cd4212 call 1242h +122c 7e ld a,(hl) +122d fe2e cp 2eh +122f 200d jr nz,123eh +1231 d1 pop de +1232 d5 push de +1233 eb ex de,hl +1234 010900 ld bc,0009h +1237 09 add hl,bc +1238 eb ex de,hl +1239 0604 ld b,04h +123b cd4212 call 1242h +123e cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +123f 22 defb '"' +1240 d1 pop de +1240 c9 ret + +1242 d7 rst 10h ; CHRGTB: Gets next character (or token) from BASIC text. +1243 3808 jr c,124dh +1245 e65f and 5fh +1247 fe41 cp 41h ; 'A' +1249 d8 ret c +124a fe5b cp 5bh ; 'Z'+1 +124c d0 ret nc +124d 1003 djnz 1252h +124f c36515 jp 1565h ; ?FD Error + +1252 12 ld (de),a +1253 13 inc de +1254 18ec jr 1242h + +1256 e5 push hl +1257 210000 ld hl,0000h +125a 112400 ld de,0024h +125d 19 add hl,de +125e 10fd djnz 125dh +1260 117afc ld de,0fc7ah +1263 19 add hl,de +1264 eb ex de,hl +1265 e1 pop hl +1266 c9 ret + +; get filename +1267 e5 push hl +1268 0608 ld b,08h +126a 3a9dfc ld a,(0fc9dh) +126d 1f rra +126e 3805 jr c,1275h +1270 10fb djnz 126dh +1272 e1 pop hl +1273 af xor a +1274 c9 ret + +1275 08 ex af,af' +1276 c5 push bc +1277 d5 push de +1278 3e09 ld a,09h +127a 90 sub b +127b 210100 ld hl,0001h +127e 012400 ld bc,0024h +1281 09 add hl,bc +1282 3d dec a +1283 20fc jr nz,1281h +1285 017afc ld bc,0fc7ah +1288 09 add hl,bc +1289 010b00 ld bc,000bh +128c 13 inc de +128d 1a ld a,(de) +128e eda1 cpi +1290 200a jr nz,129ch +1292 ea8c12 jp pe,128ch +1295 d1 pop de +1296 c1 pop bc +1297 e1 pop hl +1298 3e01 ld a,01h +129a b7 or a +129b c9 ret + +129c d1 pop de +129d c1 pop bc +129e 08 ex af,af' +129f 18cc jr 126dh +12a1 fe4d cp 4dh ; 'M' +12a3 2002 jr nz,12a7h +12a5 d7 rst 10h ; CHRGTB: Gets next character (or token) from BASIC text. +12a6 af xor a +12a7 f5 push af +12a8 1180d8 ld de,0d880h +12ab cd103f call 3f10h +12ae f1 pop af +12af 280d jr z,12beh +12b1 eb ex de,hl +12b2 2189d8 ld hl,0d889h +12b5 3642 ld (hl),42h ; 'B' +12b7 23 inc hl +12b8 3641 ld (hl),41h ; 'A' +12ba 23 inc hl +12bb 3653 ld (hl),53h ; 'S' +12bd eb ex de,hl +12be f5 push af +12bf 1180d8 ld de,0d880h +12c2 0e13 ld c,13h +12c4 cd4d15 call 154dh +12c7 0e16 ld c,16h +12c9 cd4d15 call 154dh +12cc 3c inc a +12cd ca352d jp z,2d35h ; Error: Illegal function call (FC ERROR) +12d0 f1 pop af +12d1 2835 jr z,1308h +12d3 e5 push hl +12d4 2a19fe ld hl,(0fe19h) ; Addr of simple variables +12d7 ed5b58fc ld de,(0fc58h) ; BASTXT - Address of BASIC Program +12db b7 or a +12dc ed52 sbc hl,de +12de d5 push de +12df 0e1a ld c,1ah +12e1 cd4d15 call 154dh +12e4 1180d8 ld de,0d880h +12e7 0e15 ld c,15h +12e9 cd4d15 call 154dh +12ec d1 pop de +12ed 018000 ld bc,0080h +12f0 b7 or a +12f1 ed42 sbc hl,bc +12f3 3805 jr c,12fah +12f5 eb ex de,hl +12f6 09 add hl,bc +12f7 eb ex de,hl +12f8 18e4 jr 12deh +12fa 1180d8 ld de,0d880h +12fd 0e10 ld c,10h +12ff cd4d15 call 154dh +1302 3c inc a +1303 ca352d jp z,2d35h ; Error: Illegal function call (FC ERROR) +1306 e1 pop hl +1307 c9 ret + +1308 cd452d call 2d45h ; LNUM_PARM_0 - Get specified line number (2nd parameter) +130b d5 push de +130c cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +130d 2c defb ',' +130e cd452d call 2d45h ; LNUM_PARM_0 - Get specified line number (2nd parameter) +1311 c28128 jp nz,2881h ; Syntax Error (SN ERROR) +1314 e3 ex (sp),hl +1315 eb ex de,hl +1316 b7 or a +1317 ed52 sbc hl,de +1319 ca1c16 jp z,161ch ; Overflow Error (OV ERROR) +131c da1c16 jp c,161ch ; Overflow Error (OV ERROR) +131f ed5300d8 ld (0d800h),de +1323 e5 push hl +1324 eb ex de,hl +1325 1102d8 ld de,0d802h +1328 017e00 ld bc,007eh +132b edb0 ldir +132d 1100d8 ld de,0d800h +1330 0e1a ld c,1ah +1332 cd4d15 call 154dh +1335 1180d8 ld de,0d880h +1338 0e15 ld c,15h +133a cd4d15 call 154dh +133d eb ex de,hl +133e e1 pop hl +133f 017e00 ld bc,007eh +1342 b7 or a +1343 ed42 sbc hl,bc +1345 38b3 jr c,12fah +1347 c3de12 jp 12deh +134a fe4d cp 4dh +134c 2002 jr nz,1350h +134e d7 rst 10h ; CHRGTB: Gets next character (or token) from BASIC text. +134f af xor a +1350 f5 push af +1351 1180d8 ld de,0d880h +1354 cd103f call 3f10h +1357 f1 pop af +1358 f5 push af +1359 281a jr z,1375h +135b 2b dec hl +135c d7 rst 10h ; CHRGTB: Gets next character (or token) from BASIC text. +135d 2806 jr z,1365h +135f cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +1360 2c defb ',' +1361 cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +1362 52 defb 'R' ; autorun after load +1363 3eff ld a,0ffh +1365 3297fc ld (0fc97h),a +1368 eb ex de,hl +1369 2189d8 ld hl,0d889h +136c 3642 ld (hl),42h ; 'B' +136e 23 inc hl +136f 3641 ld (hl),41h ; 'A' +1371 23 inc hl +1372 3653 ld (hl),53h ; 'S' +1374 eb ex de,hl +1375 1180d8 ld de,0d880h +1378 0e0f ld c,0fh +137a cd4d15 call 154dh +137d 3c inc a +137e ca352d jp z,2d35h ; Error: Illegal function call (FC ERROR) +1381 f1 pop af +1382 2849 jr z,13cdh +1384 cd372a call 2a37h +1387 0e03 ld c,03h +1389 2a58fc ld hl,(0fc58h) ; BASTXT - Address of BASIC Program +138c cdf513 call 13f5h +138f 0680 ld b,80h +1391 1100d8 ld de,0d800h +1394 1a ld a,(de) +1395 77 ld (hl),a +1396 08 ex af,af' +1397 13 inc de +1398 23 inc hl +1399 cd5628 call 2856h +139c 08 ex af,af' +139d b7 or a +139e 2806 jr z,13a6h +13a0 0e03 ld c,03h +13a2 10f0 djnz 1394h +13a4 18e6 jr 138ch +13a6 0d dec c +13a7 20f9 jr nz,13a2h +13a9 2219fe ld (0fe19h),hl ; Addr of simple variables +13ac 3a97fc ld a,(0fc97h) +13af 3c inc a +13b0 280d jr z,13bfh +13b2 211328 ld hl,2813h +13b5 cd9b37 call 379bh ; PRS - Output a string +13b8 2a58fc ld hl,(0fc58h) ; BASTXT - Address of BASIC Program +13bb e5 push hl +13bc c3d229 jp 29d2h + +13bf ed5b58fc ld de,(0fc58h) ; BASTXT - Address of BASIC Program +13c3 cde629 call 29e6h +13c6 21082c ld hl,2c08h +13c9 e5 push hl +13ca c3472a jp 2a47h + +13cd e5 push hl +13ce cdf513 call 13f5h +13d1 2102d8 ld hl,0d802h +13d4 ed5b00d8 ld de,(0d800h) +13d8 017e00 ld bc,007eh +13db edb0 ldir +13dd 2180d8 ld hl,0d880h +13e0 0e1a ld c,1ah +13e2 cd4d15 call 154dh +13e5 eb ex de,hl +13e6 0e14 ld c,14h +13e8 cd4d15 call 154dh +13eb 018000 ld bc,0080h +13ee 09 add hl,bc +13ef eb ex de,hl +13f0 b7 or a +13f1 28ed jr z,13e0h +13f3 e1 pop hl +13f4 c9 ret + +13f5 c5 push bc +13f6 1100d8 ld de,0d800h +13f9 0e1a ld c,1ah +13fb cd4d15 call 154dh +13fe 1180d8 ld de,0d880h +1401 0e14 ld c,14h +1403 cd4d15 call 154dh +1406 b7 or a +1407 c2352d jp nz,2d35h ; Error: Illegal function call (FC ERROR) +140a c1 pop bc +140b c9 ret + +140c cd8714 call 1487h +140f e5 push hl +1410 2a99fc ld hl,(0fc99h) +1413 cb7e bit 7,(hl) +1415 2806 jr z,141dh +1417 af xor a +1418 cd5814 call 1458h +141b 18f3 jr 1410h +141d e1 pop hl +141e c9 ret + +; __WRITE# +141f ca1300 jp z,0013h ; Memory Overflow (MO ERROR) +1422 cdd011 call 11d0h +1425 ca352d jp z,2d35h ; Error: Illegal function call (FC ERROR) +1428 cd8714 call 1487h +142b d7 rst 10h ; CHRGTB: Gets next character (or token) from BASIC text. +142c c8 ret z +142d cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +142e 2c defb ',' +142f cd2b32 call 322bh ; EVAL +1432 e5 push hl +1433 e7 rst 20h ; GETYPR - Get the number type (FAC) +1434 2806 jr z,143ch +1436 cd271e call 1e27h +1439 cd5937 call 3759h + +143c cd4814 call 1448h +143f 3e2c ld a,2ch +1441 cd5814 call 1458h +1444 e1 pop hl +1445 2b dec hl +1446 18e3 jr 142bh + +1448 cdce38 call 38ceh ; GSTRCU - Get string pointed by FPREG +144b cd2e18 call 182eh ; LOADFP_0 - move 3 bytes from (HL) to D,C,B +144e 14 inc d +144f 15 dec d +1450 c8 ret z +1451 0a ld a,(bc) +1452 cd5814 call 1458h +1455 03 inc bc +1456 18f7 jr 144fh + +1458 d5 push de +1459 c5 push bc +145a 2a99fc ld hl,(0fc99h) +145d 4e ld c,(hl) +145e cbb9 res 7,c +1460 0600 ld b,00h +1462 eb ex de,hl +1463 2a9bfc ld hl,(0fc9bh) +1466 09 add hl,bc +1467 77 ld (hl),a +1468 eb ex de,hl +1469 cbfe set 7,(hl) +146b 34 inc (hl) +146c 2016 jr nz,1484h +146e ed5b9bfc ld de,(0fc9bh) +1472 0e1a ld c,1ah +1474 cd4d15 call 154dh +1477 ed5b97fc ld de,(0fc97h) +147b 0e15 ld c,15h +147d cd4d15 call 154dh +1480 3c inc a +1481 ca352d jp z,2d35h ; Error: Illegal function call (FC ERROR) +1484 c1 pop bc +1485 d1 pop de +1486 c9 ret + +1487 e5 push hl +1488 2180d3 ld hl,0d380h +148b 018000 ld bc,0080h +148e 7b ld a,e +148f 09 add hl,bc +1490 3d dec a +1491 20fc jr nz,148fh +1493 229bfc ld (0fc9bh),hl +1496 4b ld c,e +1497 21bdfd ld hl,0fdbdh +149a 09 add hl,bc +149b 2299fc ld (0fc99h),hl +149e 43 ld b,e +149f cd5612 call 1256h +14a2 ed5397fc ld (0fc97h),de +14a6 e1 pop hl +14a7 c9 ret + +; READ # (__READ#) +14a8 cd1c37 call 371ch +14ab d7 rst 10h ; CHRGTB: Gets next character (or token) from BASIC text. +14ac ca1300 jp z,0013h ; Memory Overflow (MO ERROR) +14af cdd011 call 11d0h +14b2 ca352d jp z,2d35h ; Error: Illegal function call (FC ERROR) +14b5 cd8714 call 1487h +14b8 d7 rst 10h ; CHRGTB: Gets next character (or token) from BASIC text. +14b9 cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +14ba 2c defb ',' +14bb e5 push hl +14bc 21e3fe ld hl,0fee3h +14bf 06ff ld b,0ffh +14c1 23 inc hl +14c2 c5 push bc +14c3 cd0e15 call 150eh +14c6 c1 pop bc +14c7 77 ld (hl),a +14c8 b7 or a +14c9 ca6a15 jp z,156ah ; ?OD Error (out of DATA) +14cc fe2c cp ',' +14ce 2804 jr z,14d4h +14d0 10ef djnz 14c1h +14d2 36ff ld (hl),0ffh +14d4 e1 pop hl +14d5 cd0135 call 3501h ; GETVAR: Find address of variable +14d8 e5 push hl +14d9 d5 push de +14da 21e3fe ld hl,0fee3h +14dd e7 rst 20h ; GETYPR - Get the number type (FAC) +14de f5 push af +14df 2019 jr nz,14fah +14e1 d7 rst 10h ; CHRGTB: Gets next character (or token) from BASIC text. +14e2 57 ld d,a +14e3 47 ld b,a +14e4 fe22 cp 22h +14e6 2805 jr z,14edh +14e8 163a ld d,3ah +14ea 062c ld b,2ch +14ec 2b dec hl +14ed cd5d37 call 375dh ; DTSTR - Create String, termination char in D +14f0 f1 pop af +14f1 eb ex de,hl +14f2 210715 ld hl,1507h +14f5 e3 ex (sp),hl +14f6 d5 push de +14f7 c31e2e jp 2e1eh + +14fa d7 rst 10h ; CHRGTB: Gets next character (or token) from BASIC text. +14fb f1 pop af +14fc f5 push af +14fd 01f014 ld bc,14f0h +1500 c5 push bc +1501 dad61c jp c,1cd6h ; ASCII to Binary conversion +1504 c3cf1c jp 1ccfh ; DBL_ASCTFP - ASCII to Double precision FP number + +1507 eb ex de,hl +1508 e1 pop hl +1509 2b dec hl +150a d7 rst 10h ; CHRGTB: Gets next character (or token) from BASIC text. +150b c8 ret z +150c 18ab jr 14b9h + +150e e5 push hl +150f 2a99fc ld hl,(0fc99h) +1512 7e ld a,(hl) +1513 b7 or a +1514 2016 jr nz,152ch +1516 ed5b9bfc ld de,(0fc9bh) +151a 0e1a ld c,1ah +151c cd4d15 call 154dh +151f ed5b97fc ld de,(0fc97h) +1523 0e14 ld c,14h +1525 cd4d15 call 154dh +1528 b7 or a +1529 203f jr nz,156ah ; ?OD Error (out of DATA) +152b af xor a +152c 4f ld c,a +152d 0600 ld b,00h +152f cbfe set 7,(hl) +1531 34 inc (hl) +1532 cbbe res 7,(hl) +1534 2a9bfc ld hl,(0fc9bh) +1537 09 add hl,bc +1538 7e ld a,(hl) +1539 e1 pop hl +153a c9 ret + +; __KILL +153b 1180d8 ld de,0d880h +153e cd103f call 3f10h +1541 cd6712 call 1267h ; get filename +1544 c2352d jp nz,2d35h ; Error: Illegal function call (FC ERROR) +1547 0e13 ld c,13h +1549 cd4d15 call 154dh +154c c9 ret + +154d e5 push hl +154e d5 push de +154f 3a00ea ld a,(0ea00h) +1552 fec3 cp 0c3h +1554 c2352d jp nz,2d35h ; Error: Illegal function call (FC ERROR) +1557 3a03ea ld a,(0ea03h) +155a fec3 cp 0c3h +155c c2352d jp nz,2d35h ; Error: Illegal function call (FC ERROR) +155f cd33ea call 0ea33h +1562 d1 pop de +1563 e1 pop hl +1564 c9 ret + +; ?FD Error +1565 1e2e ld e,2eh : ?FD Error +1567 c38c28 jp 288ch ; ERROR, E=error code + +; ?OD Error (out of DATA) +156a 1e06 ld e,06h +156c c38c28 jp 288ch ; ERROR, E=error code + +156f 55 ld d,l +1570 c0 ret nz +1571 2d dec l + +1572 21ea21 ld hl,21eah ; HALF: Constant ptr for 0.5 in FP + +; ADDPHL - ADD number at HL to BCDE +1575 cd2c18 call 182ch ; LOADFP: Load single precision value pointed by (HL) into BC/DE +1578 1806 jr 1580h ; FPADD - Single precision add (Add BCDE to FP reg) + +; SUBPHL - SUBTRACT number at HL from BCDE +157a cd2c18 call 182ch ; LOADFP: Load single precision value pointed by (HL) into BC/DE + +; SUBCDE - Single precision subtract (Subtract BCDE from FP reg) +157d cdec17 call 17ech ; INVSGN - Invert number sign + +; FPADD - Single precision add (Add BCDE to FP reg) +1580 78 ld a,b +1581 b7 or a +1582 c8 ret z +1583 3a44fe ld a,(0fe44h) ; FPEXP - Floating Point Exponent +1586 b7 or a +1587 ca1e18 jp z,181eh ; FPBCDE: Move single precision value in BC/DE into FPREG +158a 90 sub b +158b 300c jr nc,1599h +158d 2f cpl +158e 3c inc a +158f eb ex de,hl +1590 cd0e18 call 180eh ; STAKFP: Move FPREG to stack +1593 eb ex de,hl +1594 cd1e18 call 181eh ; FPBCDE: Move single precision value in BC/DE into FPREG +1597 c1 pop bc +1598 d1 pop de +1599 fe19 cp 19h +159b d0 ret nc +159c f5 push af +159d cd4918 call 1849h +15a0 67 ld h,a +15a1 f1 pop af +15a2 cd4116 call 1641h ; SCALE - Scale number in BCDE for A exponent (bits) +15a5 b4 or h +15a6 2141fe ld hl,0fe41h ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +15a9 f2be15 jp p,15beh +15ac cd2116 call 1621h ; PLUCDE - Add number pointed by HL to CDE +15af d20016 jp nc,1600h +15b2 23 inc hl +15b3 34 inc (hl) +15b4 ca1c16 jp z,161ch ; Overflow Error (OV ERROR) +15b7 2e01 ld l,01h +15b9 cd5516 call 1655h +15bc 1842 jr 1600h + +15be af xor a +15bf 90 sub b +15c0 47 ld b,a +15c1 7e ld a,(hl) +15c2 9b sbc a,e +15c3 5f ld e,a +15c4 23 inc hl +15c5 7e ld a,(hl) +15c6 9a sbc a,d +15c7 57 ld d,a +15c8 23 inc hl +15c9 7e ld a,(hl) +15ca 99 sbc a,c +15cb 4f ld c,a +15cc dc2d16 call c,162dh ; COMPL - Convert a negative number to positive +15cf 68 ld l,b +15d0 63 ld h,e +15d1 af xor a +15d2 47 ld b,a +15d3 79 ld a,c +15d4 b7 or a +15d5 2018 jr nz,15efh +15d7 4a ld c,d +15d8 54 ld d,h +15d9 65 ld h,l +15da 6f ld l,a +15db 78 ld a,b +15dc d608 sub 08h +15de fee0 cp 0e0h +15e0 20f0 jr nz,15d2h +15e2 af xor a +15e3 3244fe ld (0fe44h),a ; FPEXP - Floating Point Exponent +15e6 c9 ret + +15e7 05 dec b +15e8 29 add hl,hl +15e9 7a ld a,d +15ea 17 rla +15eb 57 ld d,a +15ec 79 ld a,c +15ed 8f adc a,a +15ee 4f ld c,a +15ef f2e715 jp p,15e7h +15f2 78 ld a,b +15f3 5c ld e,h +15f4 45 ld b,l +15f5 b7 or a +15f6 2808 jr z,1600h +15f8 2144fe ld hl,0fe44h ; FPEXP - Floating Point Exponent +15fb 86 add a,(hl) +15fc 77 ld (hl),a +15fd 30e3 jr nc,15e2h +15ff c8 ret z + +1600 78 ld a,b +1601 2144fe ld hl,0fe44h ; FPEXP - Floating Point Exponent +1604 b7 or a +1605 fc1216 call m,1612h +1608 46 ld b,(hl) +1609 23 inc hl +160a 7e ld a,(hl) +160b e680 and 80h +160d a9 xor c +160e 4f ld c,a +160f c31e18 jp 181eh ; FPBCDE: Move single precision value in BC/DE into FPREG + +1612 1c inc e +1613 c0 ret nz +1614 14 inc d +1615 c0 ret nz +1616 0c inc c +1617 c0 ret nz +1618 0e80 ld c,80h +161a 34 inc (hl) +161b c0 ret nz + +; Overflow Error (OV ERROR) +161c 1e0a ld e,0ah +161e c38c28 jp 288ch ; ERROR, E=error code + +; PLUCDE - Add number pointed by HL to CDE +1621 7e ld a,(hl) +1622 83 add a,e +1623 5f ld e,a +1624 23 inc hl +1625 7e ld a,(hl) +1626 8a adc a,d +1627 57 ld d,a +1628 23 inc hl +1629 7e ld a,(hl) +162a 89 adc a,c +162b 4f ld c,a +162c c9 ret + +; COMPL - Convert a negative number to positive +162d 2145fe ld hl,0fe45h ; SGNRES - Sign of result +1630 7e ld a,(hl) +1631 2f cpl +1632 77 ld (hl),a +1633 af xor a +1634 6f ld l,a +1635 90 sub b +1636 47 ld b,a +1637 7d ld a,l +1638 9b sbc a,e +1639 5f ld e,a +163a 7d ld a,l +163b 9a sbc a,d +163c 57 ld d,a +163d 7d ld a,l +163e 99 sbc a,c +163f 4f ld c,a +1640 c9 ret + +; SCALE - Scale number in BCDE for A exponent (bits) +1641 0600 ld b,00h +1643 d608 sub 08h +1645 3807 jr c,164eh ; SHRITE - Shift right number in BCDE +1647 43 ld b,e +1648 5a ld e,d +1649 51 ld d,c +164a 0e00 ld c,00h +164c 18f5 jr 1643h + +; SHRITE - Shift right number in BCDE +164e c609 add a,09h +1650 6f ld l,a +1651 af xor a +1652 2d dec l +1653 c8 ret z +1654 79 ld a,c +1655 1f rra +1656 4f ld c,a +1657 7a ld a,d +1658 1f rra +1659 57 ld d,a +165a 7b ld a,e +165b 1f rra +165c 5f ld e,a +165d 78 ld a,b +165e 1f rra +165f 47 ld b,a +1660 18ef jr 1651h + +; UNITY - Constant ptr for number 1 in FP +1662 00 nop +1663 00 nop +1664 00 nop +1665 81 add a,c + +; LOGTAB - Table used by LOG +1666 03 inc bc +1667 aa xor d +1668 56 ld d,(hl) +1669 19 add hl,de +166a 80 add a,b +166b f1 pop af +166c 227680 ld (8076h),hl +166f 45 ld b,l +1670 aa xor d +1671 3882 jr c,15f5h + +; LOG +1673 cdbf17 call 17bfh ; TSTSGN - Test sign of FPREG +1676 b7 or a +1677 ea352d jp pe,2d35h ; Error: Illegal function call (FC ERROR) +167a 2144fe ld hl,0fe44h ; FPEXP - Floating Point Exponent +167d 7e ld a,(hl) +167e 013580 ld bc,8035h +1681 11f304 ld de,04f3h +1684 90 sub b +1685 f5 push af +1686 70 ld (hl),b +1687 d5 push de +1688 c5 push bc +1689 cd8015 call 1580h ; FPADD - Single precision add (Add BCDE to FP reg) +168c c1 pop bc +168d d1 pop de +168e 04 inc b +168f cd0c17 call 170ch ; DVBCDE - Divide FP by BCDE +1692 216216 ld hl,1662h ; UNITY - Constant ptr for number 1 in FP +1695 cd7a15 call 157ah ; SUBPHL - SUBTRACT number at HL from BCDE +1698 216616 ld hl,1666h ; LOGTAB - Table used by LOG +169b cd0423 call 2304h ; SUMSER - Evaluate sum of series +169e 018080 ld bc,8080h +16a1 110000 ld de,0000h +16a4 cd8015 call 1580h ; FPADD - Single precision add (Add BCDE to FP reg) +16a7 f1 pop af +16a8 cdf31d call 1df3h +16ab 013180 ld bc,8031h +16ae 111872 ld de,7218h + +; FPMULT - Single precision multiply (Multiply BCDE to FP reg) +16b1 cdbf17 call 17bfh ; TSTSGN - Test sign of FPREG +16b4 c8 ret z +16b5 2e00 ld l,00h +16b7 cd7e17 call 177eh +16ba 79 ld a,c +16bb 326ffe ld (0fe6fh),a +16be eb ex de,hl +16bf 2270fe ld (0fe70h),hl +16c2 010000 ld bc,0000h +16c5 50 ld d,b +16c6 58 ld e,b +16c7 21cf15 ld hl,15cfh +16ca e5 push hl +16cb 21d316 ld hl,16d3h +16ce e5 push hl +16cf e5 push hl +16d0 2141fe ld hl,0fe41h ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +16d3 7e ld a,(hl) +16d4 23 inc hl +16d5 b7 or a +16d6 2824 jr z,16fch +16d8 e5 push hl +16d9 2e08 ld l,08h +16db 1f rra +16dc 67 ld h,a +16dd 79 ld a,c +16de 300b jr nc,16ebh +16e0 e5 push hl +16e1 2a70fe ld hl,(0fe70h) +16e4 19 add hl,de +16e5 eb ex de,hl +16e6 e1 pop hl +16e7 3a6ffe ld a,(0fe6fh) +16ea 89 adc a,c +16eb 1f rra +16ec 4f ld c,a +16ed 7a ld a,d +16ee 1f rra +16ef 57 ld d,a +16f0 7b ld a,e +16f1 1f rra +16f2 5f ld e,a +16f3 78 ld a,b +16f4 1f rra +16f5 47 ld b,a +16f6 2d dec l +16f7 7c ld a,h +16f8 20e1 jr nz,16dbh +16fa e1 pop hl +16fb c9 ret + +16fc 43 ld b,e +16fd 5a ld e,d +16fe 51 ld d,c +16ff 4f ld c,a +1700 c9 ret + +; DIV10 - Divide FP by 10 +1701 cd0e18 call 180eh ; STAKFP: Move FPREG to stack +1704 21421c ld hl,1c42h +1707 cd1b18 call 181bh ; PHLTFP - Move a single precision value -> HL to FPREG + +; DIV - Divide FP by number on stack +170a c1 pop bc +170b d1 pop de + +; DVBCDE - Divide FP by BCDE +170c cdbf17 call 17bfh ; TSTSGN - Test sign of FPREG +170f ca8428 jp z,2884h ; ?UL Error +1712 2eff ld l,0ffh +1714 cd7e17 call 177eh +1717 34 inc (hl) +1718 34 inc (hl) +1719 2b dec hl +171a 7e ld a,(hl) +171b 323dfc ld (0fc3dh),a +171e 2b dec hl +171f 7e ld a,(hl) +1720 3239fc ld (0fc39h),a +1723 2b dec hl +1724 7e ld a,(hl) +1725 3235fc ld (0fc35h),a +1728 41 ld b,c +1729 eb ex de,hl +172a af xor a +172b 4f ld c,a +172c 57 ld d,a +172d 5f ld e,a +172e 3240fc ld (0fc40h),a +1731 e5 push hl +1732 c5 push bc +1733 7d ld a,l +1734 cd34fc call 0fc34h +1737 de00 sbc a,00h +1739 3f ccf +173a 3007 jr nc,1743h +173c 3240fc ld (0fc40h),a +173f f1 pop af +1740 f1 pop af +1741 37 scf +1742 d2c1e1 jp nc,0e1c1h +1745 79 ld a,c +1746 3c inc a +1747 3d dec a +1748 1f rra +1749 fa0116 jp m,1601h +174c 17 rla +174d 7b ld a,e +174e 17 rla +174f 5f ld e,a +1750 7a ld a,d +1751 17 rla +1752 57 ld d,a +1753 79 ld a,c +1754 17 rla +1755 4f ld c,a +1756 29 add hl,hl +1757 78 ld a,b +1758 17 rla +1759 47 ld b,a +175a 3a40fc ld a,(0fc40h) +175d 17 rla +175e 3240fc ld (0fc40h),a +1761 79 ld a,c +1762 b2 or d +1763 b3 or e +1764 20cb jr nz,1731h +1766 e5 push hl +1767 2144fe ld hl,0fe44h ; FPEXP - Floating Point Exponent +176a 35 dec (hl) +176b e1 pop hl +176c 20c3 jr nz,1731h +176e c31c16 jp 161ch ; Overflow Error (OV ERROR) + +1771 3eff ld a,0ffh +1773 2eaf ld l,0afh +1775 214dfe ld hl,0fe4dh ; DBL_FPREG: Last byte in Double Precision FP register (+sign bit) +1778 4e ld c,(hl) +1779 23 inc hl +177a ae xor (hl) +177b 47 ld b,a +177c 2e00 ld l,00h +177e 78 ld a,b +177f b7 or a +1780 281f jr z,17a1h +1782 7d ld a,l +1783 2144fe ld hl,0fe44h ; FPEXP - Floating Point Exponent +1786 ae xor (hl) +1787 80 add a,b +1788 47 ld b,a +1789 1f rra +178a a8 xor b +178b 78 ld a,b +178c f2a017 jp p,17a0h +178f c680 add a,80h +1791 77 ld (hl),a +1792 cafa16 jp z,16fah +1795 cd4918 call 1849h +1798 77 ld (hl),a +1799 2b dec hl +179a c9 ret +179b cdbf17 call 17bfh ; TSTSGN - Test sign of FPREG +179e 2f cpl +179f e1 pop hl +17a0 b7 or a +17a1 e1 pop hl +17a2 f2e215 jp p,15e2h +17a5 c31c16 jp 161ch ; Overflow Error (OV ERROR) + +; MLSP10 - Multiply number in FPREG by 10 +17a8 cd2918 call 1829h ; BCDEFP: Load a single precision value from FPREG into BC/DE +17ab 78 ld a,b +17ac b7 or a +17ad c8 ret z +17ae c602 add a,02h +17b0 da1c16 jp c,161ch ; Overflow Error (OV ERROR) +17b3 47 ld b,a +17b4 cd8015 call 1580h ; FPADD - Single precision add (Add BCDE to FP reg) +17b7 2144fe ld hl,0fe44h ; FPEXP - Floating Point Exponent +17ba 34 inc (hl) +17bb c0 ret nz +17bc c31c16 jp 161ch ; Overflow Error (OV ERROR) + +; TSTSGN - Test sign of FPREG +17bf 3a44fe ld a,(0fe44h) ; FPEXP - Floating Point Exponent +17c2 b7 or a +17c3 c8 ret z +17c4 3a43fe ld a,(0fe43h) ; LAST-FPREG - Last byte in Single Precision FP Register (+sign bit) +17c7 fe2f cp 2fh +17c9 17 rla +17ca 9f sbc a,a +17cb c0 ret nz +17cc 3c inc a +17cd c9 ret + +; FLGREL - CY and A to FP, & normalise +17ce 0688 ld b,88h +17d0 110000 ld de,0000h +17d3 2144fe ld hl,0fe44h ; FPEXP - Floating Point Exponent +17d6 4f ld c,a +17d7 70 ld (hl),b +17d8 0600 ld b,00h +17da 23 inc hl +17db 3680 ld (hl),80h +17dd 17 rla +17de c3cc15 jp 15cch + +; ABS - Absolute value +17e1 cdfe17 call 17feh ; _TSTSGN - Test sign in number +17e4 f0 ret p + +; INVSGN +17e5 e7 rst 20h ; GETYPR - Get the number type (FAC) +17e6 fac51a jp m,1ac5h ; DBL_ABS - ABS (double precision BASIC variant) +17e9 ca6019 jp z,1960h ; TYPE_ERR + +; INVSGN - Invert number sign +17ec 2143fe ld hl,0fe43h ; LAST-FPREG - Last byte in Single Precision FP Register (+sign bit) +17ef 7e ld a,(hl) +17f0 ee80 xor 80h ; invert sign +17f2 77 ld (hl),a +17f3 c9 ret + +17f4 cdfe17 call 17feh ; _TSTSGN - Test sign in number + +; INT_RESULT_A - Get back from function, result in A (signed) +17f7 6f ld l,a +17f8 17 rla +17f9 9f sbc a,a +17fa 67 ld h,a +17fb c30419 jp 1904h ; INT_RESULT_HL - Get back from function, result in HL + +; _TSTSGN - Test sign in number +17fe e7 rst 20h ; GETYPR - Get the number type (FAC) +17ff ca6019 jp z,1960h ; TYPE_ERR +1802 f2bf17 jp p,17bfh ; TSTSGN - Test sign of FPREG +1805 2a41fe ld hl,(0fe41h) ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +1808 7c ld a,h +1809 b5 or l +180a c8 ret z +180b 7c ld a,h +180c 18bb jr 17c9h + +; STAKFP: Move FPREG to stack +180e eb ex de,hl +180f 2a41fe ld hl,(0fe41h) ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +1812 e3 ex (sp),hl +1813 e5 push hl +1814 2a43fe ld hl,(0fe43h) ; LAST-FPREG - Last byte in Single Precision FP Register (+sign bit) +1817 e3 ex (sp),hl +1818 e5 push hl +1819 eb ex de,hl +181a c9 ret + +; PHLTFP - Move a single precision value -> HL to FPREG +181b cd2c18 call 182ch ; LOADFP: Load single precision value pointed by (HL) into BC/DE + +; FPBCDE: Move single precision value in BC/DE into FPREG +181e eb ex de,hl +181f 2241fe ld (0fe41h),hl ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +1822 60 ld h,b +1823 69 ld l,c +1824 2243fe ld (0fe43h),hl ; LAST-FPREG - Last byte in Single Precision FP Register (+sign bit) +1827 eb ex de,hl +1828 c9 ret + +; BCDEFP: Load a single precision value from FPREG into BC/DE +1829 2141fe ld hl,0fe41h ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) + +; LOADFP: Load single precision value pointed by (HL) into BC/DE +182c 5e ld e,(hl) +182d 23 inc hl +; LOADFP_0 - move 3 bytes from (HL) to D,C,B +182e 56 ld d,(hl) +182f 23 inc hl +1830 4e ld c,(hl) +1831 23 inc hl +1832 46 ld b,(hl) +; INCHL +1833 23 inc hl +1834 c9 ret + +; DEC_FACCU2HL - copy number value from FPREG (FP accumulator) to HL +1835 1141fe ld de,0fe41h ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +1838 0604 ld b,04h +183a 1805 jr 1841h ; CPY2HL - Copy B bytes from DE to HL + + +; VAL2DE - Copy number value from HL to DE +183c eb ex de,hl + +; FP2HL - Copy number value from DE to HL +183d 3acffd ld a,(0fdcfh) ; Type flag for FPREG: 2 - Integer, 3 - String, 4 - Single, 5 - Double +1840 47 ld b,a + +; CPY2HL - Copy B bytes from DE to HL +1841 1a ld a,(de) +1842 77 ld (hl),a +1843 13 inc de +1844 23 inc hl +1845 05 dec b +1846 20f9 jr nz,1841h +1848 c9 ret + +1849 2143fe ld hl,0fe43h ; LAST-FPREG - Last byte in Single Precision FP Register (+sign bit) +184c 7e ld a,(hl) +184d 07 rlca +184e 37 scf +184f 1f rra +1850 77 ld (hl),a +1851 3f ccf +1852 1f rra +1853 23 inc hl +1854 23 inc hl +1855 77 ld (hl),a +1856 79 ld a,c +1857 07 rlca +1858 37 scf +1859 1f rra +185a 4f ld c,a +185b 1f rra +185c ae xor (hl) +185d c9 ret + +; FP_ARG2DE +185e 2147fe ld hl,0fe47h ; ARG +1861 113c18 ld de,183ch ; VAL2DE - Copy number value from HL to DE +1864 1806 jr 186ch ; FPCOPY_0 + +; FP_ARG2HL +1866 2147fe ld hl,0fe47h ; ARG +1869 113d18 ld de,183dh ; FP2HL - Copy number value from DE to HL +; FPCOPY_0 +186c d5 push de +186d 1141fe ld de,0fe41h ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +1870 e7 rst 20h ; GETYPR - Get the number type (FAC) +1871 d8 ret c +1872 113dfe ld de,0fe3dh +1875 c9 ret + +; CMPNUM - Compare FP reg to BCDE +1876 78 ld a,b +1877 b7 or a +1878 cabf17 jp z,17bfh ; TSTSGN - Test sign of FPREG +187b 21c817 ld hl,17c8h ; SGN_RESULT_CPL +187e e5 push hl +187f cdbf17 call 17bfh ; TSTSGN - Test sign of FPREG +1882 79 ld a,c +1883 c8 ret z +1884 2143fe ld hl,0fe43h ; LAST-FPREG - Last byte in Single Precision FP Register (+sign bit) +1887 ae xor (hl) +1888 79 ld a,c +1889 f8 ret m +188a cd9018 call 1890h +188d 1f rra +188e a9 xor c +188f c9 ret +1890 23 inc hl +1891 78 ld a,b +1892 be cp (hl) +1893 c0 ret nz +1894 2b dec hl +1895 79 ld a,c +1896 be cp (hl) +1897 c0 ret nz +1898 2b dec hl +1899 7a ld a,d +189a be cp (hl) +189b c0 ret nz +189c 2b dec hl +189d 7b ld a,e +189e 96 sub (hl) +189f c0 ret nz +18a0 e1 pop hl +18a1 e1 pop hl +18a2 c9 ret + +; ICOMP +18a3 7a ld a,d +18a4 ac xor h +18a5 7c ld a,h +18a6 fac917 jp m,17c9h +18a9 ba cp d +18aa c2ca17 jp nz,17cah +18ad 7d ld a,l +18ae 93 sub e +18af c2ca17 jp nz,17cah +18b2 c9 ret +18b3 2147fe ld hl,0fe47h ; ARG +18b6 cd3d18 call 183dh ; FP2HL - Copy number value from DE to HL + +; XDCOMP +18b9 114efe ld de,0fe4eh +18bc 1a ld a,(de) +18bd b7 or a +18be cabf17 jp z,17bfh ; TSTSGN - Test sign of FPREG +18c1 21c817 ld hl,17c8h ; SGN_RESULT_CPL +18c4 e5 push hl +18c5 cdbf17 call 17bfh ; TSTSGN - Test sign of FPREG +18c8 1b dec de +18c9 1a ld a,(de) +18ca 4f ld c,a +18cb c8 ret z +18cc 2143fe ld hl,0fe43h ; LAST-FPREG - Last byte in Single Precision FP Register (+sign bit) +18cf ae xor (hl) +18d0 79 ld a,c +18d1 f8 ret m +18d2 13 inc de +18d3 23 inc hl +18d4 0608 ld b,08h +18d6 1a ld a,(de) +18d7 96 sub (hl) +18d8 c28d18 jp nz,188dh +18db 1b dec de +18dc 2b dec hl +18dd 05 dec b +18de 20f6 jr nz,18d6h +18e0 c1 pop bc +18e1 c9 ret + +; DECCOMP +18e2 cdb918 call 18b9h ; XDCOMP +18e5 c2c817 jp nz,17c8h ; SGN_RESULT_CPL +18e8 c9 ret + + +; __CINT: Floating point to Integer +18e9 e7 rst 20h ; GETYPR - Get the number type (FAC) +18ea 2a41fe ld hl,(0fe41h) ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +18ed f8 ret m +18ee ca6019 jp z,1960h ; TYPE_ERR +18f1 d42319 call nc,1923h +18f4 211c16 ld hl,161ch ; Overflow Error (OV ERROR) +18f7 e5 push hl +18f8 3a44fe ld a,(0fe44h) ; FPEXP - Floating Point Exponent +18fb fe90 cp 90h +18fd 300e jr nc,190dh +18ff cd6519 call 1965h ; FPINT - Floating Point to Integer +1902 eb ex de,hl +1903 d1 pop de + +; INT_RESULT_HL - Get back from function, result in HL +1904 2241fe ld (0fe41h),hl ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +1907 3e02 ld a,02h +1909 32cffd ld (0fdcfh),a ; Type flag for FPREG: 2 - Integer, 3 - String, 4 - Single, 5 - Double +190c c9 ret + +190d 018090 ld bc,9080h +1910 110000 ld de,0000h +1913 cd7618 call 1876h ; CMPNUM - Compare FP reg to BCDE +1916 c0 ret nz +1917 61 ld h,c +1918 6a ld l,d +1919 18e8 jr 1903h + +; __CSNG: Integer to single precision +191b e7 rst 20h ; GETYPR - Get the number type (FAC) +191c e0 ret po +191d fa3619 jp m,1936h +1920 ca6019 jp z,1960h ; TYPE_ERR +1923 cd2918 call 1829h ; BCDEFP: Load a single precision value from FPREG into BC/DE +1926 cd5919 call 1959h ; SETTYPE_INT +1929 78 ld a,b +192a b7 or a +192b c8 ret z +192c cd4918 call 1849h +192f 2140fe ld hl,0fe40h +1932 46 ld b,(hl) +1933 c30016 jp 1600h +1936 2a41fe ld hl,(0fe41h) ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +1939 cd5919 call 1959h ; SETTYPE_INT +193c 7c ld a,h +193d 55 ld d,l +193e 1e00 ld e,00h +1940 0690 ld b,90h +1942 c3d317 jp 17d3h + +; __CDBL +1945 e7 rst 20h ; GETYPR - Get the number type (FAC) +1946 d0 ret nc +1947 ca6019 jp z,1960h ; TYPE_ERR +194a fc3619 call m,1936h +; ZERO_FACCU +194d 210000 ld hl,0000h +1950 223dfe ld (0fe3dh),hl +1953 223ffe ld (0fe3fh),hl +; SETTYPE_DBL +1956 3e08 ld a,08h +1958 01 defb 01h ; ld bc,nnnn ..to skip the next 2 bytes +; SETTYPE_INT +1959 3e04 ld a,04h +195b c30919 jp 1909h + +; TSTSTR - Test a string, 'Type Error' if it is not +195e e7 rst 20h ; GETYPR - Get the number type (FAC) +195f c8 ret z +; TYPE_ERR +1960 1e18 ld e,18h ; ?TM Error +1962 c38c28 jp 288ch ; ERROR, E=error code + +; FPINT - Floating Point to Integer +1965 47 ld b,a +1966 4f ld c,a +1967 57 ld d,a +1968 5f ld e,a +1969 b7 or a +196a c8 ret z +196b e5 push hl +196c cd2918 call 1829h ; BCDEFP: Load a single precision value from FPREG into BC/DE +196f cd4918 call 1849h +1972 ae xor (hl) +1973 67 ld h,a +1974 fc8919 call m,1989h ; DCBCDE - Decrement FP value in BCDE +1977 3e98 ld a,98h +1979 90 sub b +197a cd4116 call 1641h ; SCALE - Scale number in BCDE for A exponent (bits) +197d 7c ld a,h +197e 17 rla +197f dc1216 call c,1612h +1982 0600 ld b,00h +1984 dc2d16 call c,162dh ; COMPL - Convert a negative number to positive +1987 e1 pop hl +1988 c9 ret + +; DCBCDE - Decrement FP value in BCDE +1989 1b dec de +198a 7a ld a,d +198b a3 and e +198c 3c inc a +198d c0 ret nz +198e 0b dec bc +198f c9 ret + +; FIX - Double Precision to Integer conversion +1990 e7 rst 20h ; GETYPR - Get the number type (FAC) +1991 f8 ret m +1992 cdbf17 call 17bfh ; TSTSGN - Test sign of FPREG +1995 f2a119 jp p,19a1h ; DBL_INT - Return Integer +1998 cdec17 call 17ech ; INVSGN - Invert number sign +199b cda119 call 19a1h ; DBL_INT - Return Integer +199e c3e517 jp 17e5h ; INVSGN + +; DBL_INT - Return Integer +19a1 e7 rst 20h ; GETYPR - Get the number type (FAC) +19a2 f8 ret m +19a3 301e jr nc,19c3h +19a5 28b9 jr z,1960h ; TYPE_ERR +19a7 cdf818 call 18f8h +; INT +19aa 2144fe ld hl,0fe44h ; FPEXP - Floating Point Exponent +19ad 7e ld a,(hl) +19ae fe98 cp 98h +19b0 3a41fe ld a,(0fe41h) ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +19b3 d0 ret nc +19b4 7e ld a,(hl) +19b5 cd6519 call 1965h ; FPINT - Floating Point to Integer +19b8 3698 ld (hl),98h +19ba 7b ld a,e +19bb f5 push af +19bc 79 ld a,c +19bd 17 rla +19be cdcc15 call 15cch +19c1 f1 pop af +19c2 c9 ret +19c3 2144fe ld hl,0fe44h ; FPEXP - Floating Point Exponent +19c6 7e ld a,(hl) +19c7 fe90 cp 90h +19c9 dae918 jp c,18e9h ; __CINT: Floating point to Integer +19cc 2014 jr nz,19e2h +19ce 4f ld c,a +19cf 2b dec hl +19d0 7e ld a,(hl) +19d1 ee80 xor 80h ; invert sign +19d3 0606 ld b,06h +19d5 2b dec hl +19d6 b6 or (hl) +19d7 05 dec b +19d8 20fb jr nz,19d5h +19da b7 or a +19db 210080 ld hl,8000h +19de ca0419 jp z,1904h ; INT_RESULT_HL - Get back from function, result in HL +19e1 79 ld a,c +19e2 feb8 cp 0b8h +19e4 d0 ret nc +19e5 f5 push af +19e6 cd2918 call 1829h ; BCDEFP: Load a single precision value from FPREG into BC/DE +19e9 cd4918 call 1849h +19ec ae xor (hl) +19ed 2b dec hl +19ee 36b8 ld (hl),0b8h +19f0 f5 push af +19f1 fc0a1a call m,1a0ah +19f4 2143fe ld hl,0fe43h ; LAST-FPREG - Last byte in Single Precision FP Register (+sign bit) +19f7 3eb8 ld a,0b8h +19f9 90 sub b +19fa cdd31b call 1bd3h +19fd f1 pop af +19fe fc8a1b call m,1b8ah +1a01 af xor a +1a02 323cfe ld (0fe3ch),a +1a05 f1 pop af +1a06 d0 ret nc +1a07 c3421b jp 1b42h +1a0a 213dfe ld hl,0fe3dh +1a0d 7e ld a,(hl) +1a0e 35 dec (hl) +1a0f b7 or a +1a10 23 inc hl +1a11 28fa jr z,1a0dh +1a13 c9 ret + +; MLDEBC - Multiply DE by BC +1a14 e5 push hl +1a15 210000 ld hl,0000h +1a18 78 ld a,b +1a19 b1 or c +1a1a 2812 jr z,1a2eh +1a1c 3e10 ld a,10h +1a1e 29 add hl,hl +1a1f da3136 jp c,3631h +1a22 eb ex de,hl +1a23 29 add hl,hl +1a24 eb ex de,hl +1a25 3004 jr nc,1a2bh +1a27 09 add hl,bc +1a28 da3136 jp c,3631h +1a2b 3d dec a +1a2c 20f0 jr nz,1a1eh +1a2e eb ex de,hl +1a2f e1 pop hl +1a30 c9 ret + +; ISUB - Integer SUB +1a31 7c ld a,h +1a32 17 rla +1a33 9f sbc a,a +1a34 47 ld b,a +1a35 cdbb1a call 1abbh +1a38 79 ld a,c +1a39 98 sbc a,b +1a3a 1803 jr 1a3fh + +; IADD - Integer ADD +1a3c 7c ld a,h +1a3d 17 rla +1a3e 9f sbc a,a +1a3f 47 ld b,a +1a40 e5 push hl +1a41 7a ld a,d +1a42 17 rla +1a43 9f sbc a,a +1a44 19 add hl,de +1a45 88 adc a,b +1a46 0f rrca +1a47 ac xor h +1a48 f20319 jp p,1903h +1a4b c5 push bc +1a4c eb ex de,hl +1a4d cd3919 call 1939h +1a50 f1 pop af +1a51 e1 pop hl +1a52 cd0e18 call 180eh ; STAKFP: Move FPREG to stack +1a55 eb ex de,hl +1a56 cdd51a call 1ad5h +1a59 c3f91d jp 1df9h + +; INT_MUL - Integer MULTIPLY +1a5c 7c ld a,h +1a5d b5 or l +1a5e ca0419 jp z,1904h ; INT_RESULT_HL - Get back from function, result in HL +1a61 e5 push hl +1a62 d5 push de +1a63 cdaf1a call 1aafh +1a66 c5 push bc +1a67 44 ld b,h +1a68 4d ld c,l +1a69 210000 ld hl,0000h +1a6c 3e10 ld a,10h +1a6e 29 add hl,hl +1a6f 381f jr c,1a90h +1a71 eb ex de,hl +1a72 29 add hl,hl +1a73 eb ex de,hl +1a74 3004 jr nc,1a7ah +1a76 09 add hl,bc +1a77 da901a jp c,1a90h +1a7a 3d dec a +1a7b 20f1 jr nz,1a6eh +1a7d c1 pop bc +1a7e d1 pop de +1a7f 7c ld a,h +1a80 b7 or a +1a81 fa891a jp m,1a89h +1a84 d1 pop de +1a85 78 ld a,b +1a86 c3b71a jp 1ab7h +1a89 ee80 xor 80h ; invert sign +1a8b b5 or l +1a8c 2813 jr z,1aa1h +1a8e eb ex de,hl +1a8f 01c1e1 ld bc,0e1c1h +1a92 cd3919 call 1939h +1a95 e1 pop hl +1a96 cd0e18 call 180eh ; STAKFP: Move FPREG to stack +1a99 cd3919 call 1939h +1a9c c1 pop bc +1a9d d1 pop de +1a9e c3b116 jp 16b1h ; FPMULT - Single precision multiply (Multiply BCDE to FP reg) + +1aa1 78 ld a,b +1aa2 b7 or a +1aa3 c1 pop bc +1aa4 fa0419 jp m,1904h ; INT_RESULT_HL - Get back from function, result in HL +1aa7 d5 push de +1aa8 cd3919 call 1939h +1aab d1 pop de +1aac c3ec17 jp 17ech ; INVSGN - Invert number sign + +1aaf 7c ld a,h +1ab0 aa xor d +1ab1 47 ld b,a +1ab2 cdb61a call 1ab6h +1ab5 eb ex de,hl +1ab6 7c ld a,h +1ab7 b7 or a +1ab8 f20419 jp p,1904h ; INT_RESULT_HL - Get back from function, result in HL +1abb af xor a +1abc 4f ld c,a +1abd 95 sub l +1abe 6f ld l,a +1abf 79 ld a,c +1ac0 9c sbc a,h +1ac1 67 ld h,a +1ac2 c30419 jp 1904h ; INT_RESULT_HL - Get back from function, result in HL + +; DBL_ABS - ABS (double precision BASIC variant) +1ac5 2a41fe ld hl,(0fe41h) ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +1ac8 cdbb1a call 1abbh +1acb 7c ld a,h +1acc ee80 xor 80h ; invert sign +1ace b5 or l +1acf c0 ret nz +1ad0 eb ex de,hl +1ad1 cd5919 call 1959h ; SETTYPE_INT +1ad4 af xor a +1ad5 0698 ld b,98h +1ad7 c3d317 jp 17d3h + +; DBL_SUB - Double precision SUB (formerly SUBCDE) +1ada 214dfe ld hl,0fe4dh ; DBL_FPREG: Last byte in Double Precision FP register (+sign bit) +1add 7e ld a,(hl) +1ade ee80 xor 80h ; invert sign +1ae0 77 ld (hl),a +; DBL_ADD - Double precision ADD (formerly FPADD) +1ae1 214efe ld hl,0fe4eh +1ae4 7e ld a,(hl) +1ae5 b7 or a +1ae6 c8 ret z +1ae7 47 ld b,a +1ae8 2b dec hl +1ae9 4e ld c,(hl) +1aea 1144fe ld de,0fe44h ; FPEXP - Floating Point Exponent +1aed 1a ld a,(de) +1aee b7 or a +1aef ca5e18 jp z,185eh ; FP_ARG2DE +1af2 90 sub b +1af3 3016 jr nc,1b0bh +1af5 2f cpl +1af6 3c inc a +1af7 f5 push af +1af8 0e08 ld c,08h +1afa 23 inc hl +1afb e5 push hl +1afc 1a ld a,(de) +1afd 46 ld b,(hl) +1afe 77 ld (hl),a +1aff 78 ld a,b +1b00 12 ld (de),a +1b01 1b dec de +1b02 2b dec hl +1b03 0d dec c +1b04 20f6 jr nz,1afch +1b06 e1 pop hl +1b07 46 ld b,(hl) +1b08 2b dec hl +1b09 4e ld c,(hl) +1b0a f1 pop af +1b0b fe39 cp 39h +1b0d d0 ret nc +1b0e f5 push af +1b0f cd4918 call 1849h +1b12 23 inc hl +1b13 3600 ld (hl),00h +1b15 47 ld b,a +1b16 f1 pop af +1b17 214dfe ld hl,0fe4dh ; DBL_FPREG: Last byte in Double Precision FP register (+sign bit) +1b1a cdd31b call 1bd3h +1b1d 3a46fe ld a,(0fe46h) +1b20 323cfe ld (0fe3ch),a +1b23 78 ld a,b +1b24 b7 or a +1b25 f2391b jp p,1b39h +1b28 cd9d1b call 1b9dh +1b2b d2781b jp nc,1b78h +1b2e eb ex de,hl +1b2f 34 inc (hl) +1b30 ca1c16 jp z,161ch ; Overflow Error (OV ERROR) +1b33 cdfa1b call 1bfah +1b36 c3781b jp 1b78h +1b39 cdaf1b call 1bafh +1b3c 2145fe ld hl,0fe45h ; SGNRES - Sign of result +1b3f dcc11b call c,1bc1h +1b42 af xor a +1b43 47 ld b,a +1b44 3a43fe ld a,(0fe43h) ; LAST-FPREG - Last byte in Single Precision FP Register (+sign bit) +1b47 b7 or a +1b48 201e jr nz,1b68h +1b4a 213cfe ld hl,0fe3ch +1b4d 0e08 ld c,08h +1b4f 56 ld d,(hl) +1b50 77 ld (hl),a +1b51 7a ld a,d +1b52 23 inc hl +1b53 0d dec c +1b54 20f9 jr nz,1b4fh +1b56 78 ld a,b +1b57 d608 sub 08h +1b59 fec0 cp 0c0h +1b5b 20e6 jr nz,1b43h +1b5d c3e215 jp 15e2h +1b60 05 dec b +1b61 213cfe ld hl,0fe3ch +1b64 cd011c call 1c01h +1b67 b7 or a +1b68 f2601b jp p,1b60h +1b6b 78 ld a,b +1b6c b7 or a +1b6d 2809 jr z,1b78h +1b6f 2144fe ld hl,0fe44h ; FPEXP - Floating Point Exponent +1b72 86 add a,(hl) +1b73 77 ld (hl),a +1b74 d2e215 jp nc,15e2h +1b77 c8 ret z +1b78 3a3cfe ld a,(0fe3ch) +1b7b b7 or a +1b7c fc8a1b call m,1b8ah +1b7f 2145fe ld hl,0fe45h ; SGNRES - Sign of result +1b82 7e ld a,(hl) +1b83 e680 and 80h +1b85 2b dec hl +1b86 2b dec hl +1b87 ae xor (hl) +1b88 77 ld (hl),a +1b89 c9 ret +1b8a 213dfe ld hl,0fe3dh +1b8d 0607 ld b,07h +1b8f 34 inc (hl) +1b90 c0 ret nz +1b91 23 inc hl +1b92 05 dec b +1b93 20fa jr nz,1b8fh +1b95 34 inc (hl) +1b96 ca1c16 jp z,161ch ; Overflow Error (OV ERROR) +1b99 2b dec hl +1b9a 3680 ld (hl),80h +1b9c c9 ret + +1b9d 2147fe ld hl,0fe47h ; ARG +1ba0 113dfe ld de,0fe3dh +1ba3 0e07 ld c,07h +1ba5 af xor a +1ba6 1a ld a,(de) +1ba7 8e adc a,(hl) +1ba8 12 ld (de),a +1ba9 13 inc de +1baa 23 inc hl +1bab 0d dec c +1bac 20f8 jr nz,1ba6h +1bae c9 ret +1baf 2147fe ld hl,0fe47h ; ARG +1bb2 113dfe ld de,0fe3dh +1bb5 0e07 ld c,07h +1bb7 af xor a +1bb8 1a ld a,(de) +1bb9 9e sbc a,(hl) +1bba 12 ld (de),a +1bbb 13 inc de +1bbc 23 inc hl +1bbd 0d dec c +1bbe 20f8 jr nz,1bb8h +1bc0 c9 ret +1bc1 7e ld a,(hl) +1bc2 2f cpl +1bc3 77 ld (hl),a +1bc4 213cfe ld hl,0fe3ch +1bc7 0608 ld b,08h +1bc9 af xor a +1bca 4f ld c,a +1bcb 79 ld a,c +1bcc 9e sbc a,(hl) +1bcd 77 ld (hl),a +1bce 23 inc hl +1bcf 05 dec b +1bd0 20f9 jr nz,1bcbh +1bd2 c9 ret +1bd3 71 ld (hl),c +1bd4 e5 push hl +1bd5 d608 sub 08h +1bd7 380e jr c,1be7h +1bd9 e1 pop hl +1bda e5 push hl +1bdb 110008 ld de,0800h +1bde 4e ld c,(hl) +1bdf 73 ld (hl),e +1be0 59 ld e,c +1be1 2b dec hl +1be2 15 dec d +1be3 20f9 jr nz,1bdeh +1be5 18ee jr 1bd5h +1be7 c609 add a,09h +1be9 57 ld d,a +1bea af xor a +1beb e1 pop hl +1bec 15 dec d +1bed c8 ret z +1bee e5 push hl +1bef 1e08 ld e,08h +1bf1 7e ld a,(hl) +1bf2 1f rra +1bf3 77 ld (hl),a +1bf4 2b dec hl +1bf5 1d dec e +1bf6 20f9 jr nz,1bf1h +1bf8 18f0 jr 1beah +1bfa 2143fe ld hl,0fe43h ; LAST-FPREG - Last byte in Single Precision FP Register (+sign bit) +1bfd 1601 ld d,01h +1bff 18ed jr 1beeh +1c01 0e08 ld c,08h +1c03 7e ld a,(hl) +1c04 17 rla +1c05 77 ld (hl),a +1c06 23 inc hl +1c07 0d dec c +1c08 20f9 jr nz,1c03h +1c0a c9 ret + +; DBL_MUL Double precision MULTIPLY +1c0b cdbf17 call 17bfh ; TSTSGN - Test sign of FPREG +1c0e c8 ret z +1c0f cd7417 call 1774h +1c12 cda31c call 1ca3h +1c15 71 ld (hl),c +1c16 13 inc de +1c17 0607 ld b,07h +1c19 1a ld a,(de) +1c1a 13 inc de +1c1b b7 or a +1c1c d5 push de +1c1d 2817 jr z,1c36h +1c1f 0e08 ld c,08h +1c21 c5 push bc +1c22 1f rra +1c23 47 ld b,a +1c24 dc9d1b call c,1b9dh +1c27 cdfa1b call 1bfah +1c2a 78 ld a,b +1c2b c1 pop bc +1c2c 0d dec c +1c2d 20f2 jr nz,1c21h +1c2f d1 pop de +1c30 05 dec b +1c31 20e6 jr nz,1c19h +1c33 c3421b jp 1b42h +1c36 2143fe ld hl,0fe43h ; LAST-FPREG - Last byte in Single Precision FP Register (+sign bit) +1c39 cdda1b call 1bdah +1c3c 18f1 jr 1c2fh + +1c3e 00 nop +1c3f 00 nop +1c40 00 nop +1c41 00 nop +1c42 00 nop +1c43 00 nop +1c44 2084 jr nz,1bcah +1c46 113e1c ld de,1c3eh +1c49 2147fe ld hl,0fe47h ; ARG +1c4c cd3d18 call 183dh ; FP2HL - Copy number value from DE to HL + +; DBL_DIV - Double precision DIVIDE +1c4f 3a4efe ld a,(0fe4eh) +1c52 b7 or a +1c53 ca8428 jp z,2884h ; ?UL Error +1c56 cd7117 call 1771h +1c59 34 inc (hl) +1c5a 34 inc (hl) +1c5b cda31c call 1ca3h +1c5e 2171fe ld hl,0fe71h +1c61 71 ld (hl),c +1c62 41 ld b,c +1c63 116afe ld de,0fe6ah +1c66 2147fe ld hl,0fe47h ; ARG +1c69 cdb51b call 1bb5h +1c6c 1a ld a,(de) +1c6d 99 sbc a,c +1c6e 3f ccf +1c6f 380b jr c,1c7ch +1c71 116afe ld de,0fe6ah +1c74 2147fe ld hl,0fe47h ; ARG +1c77 cda31b call 1ba3h +1c7a af xor a +1c7b da1204 jp c,0412h +1c7e 3a43fe ld a,(0fe43h) ; LAST-FPREG - Last byte in Single Precision FP Register (+sign bit) +1c81 3c inc a +1c82 3d dec a +1c83 1f rra +1c84 fa7b1b jp m,1b7bh +1c87 17 rla +1c88 213dfe ld hl,0fe3dh +1c8b 0e07 ld c,07h +1c8d cd031c call 1c03h +1c90 216afe ld hl,0fe6ah +1c93 cd011c call 1c01h +1c96 78 ld a,b +1c97 b7 or a +1c98 20c9 jr nz,1c63h +1c9a 2144fe ld hl,0fe44h ; FPEXP - Floating Point Exponent +1c9d 35 dec (hl) +1c9e 20c3 jr nz,1c63h +1ca0 c31c16 jp 161ch ; Overflow Error (OV ERROR) + +1ca3 79 ld a,c +1ca4 324dfe ld (0fe4dh),a ; DBL_FPREG: Last byte in Double Precision FP register (+sign bit) +1ca7 2b dec hl +1ca8 1170fe ld de,0fe70h +1cab 010007 ld bc,0700h +1cae 7e ld a,(hl) +1caf 12 ld (de),a +1cb0 71 ld (hl),c +1cb1 1b dec de +1cb2 2b dec hl +1cb3 05 dec b +1cb4 20f8 jr nz,1caeh +1cb6 c9 ret +1cb7 cd6618 call 1866h ; FP_ARG2HL +1cba eb ex de,hl +1cbb 2b dec hl +1cbc 7e ld a,(hl) +1cbd b7 or a +1cbe c8 ret z +1cbf c602 add a,02h +1cc1 da1c16 jp c,161ch ; Overflow Error (OV ERROR) +1cc4 77 ld (hl),a +1cc5 e5 push hl +1cc6 cde11a call 1ae1h ; DBL_ADD - Double precision ADD (formerly FPADD) +1cc9 e1 pop hl +1cca 34 inc (hl) +1ccb c0 ret nz +1ccc c31c16 jp 161ch ; Overflow Error (OV ERROR) + +; DBL_ASCTFP - ASCII to Double precision FP number +1ccf cde215 call 15e2h +1cd2 cd5619 call 1956h ; SETTYPE_DBL +1cd5 f6af or 0afh +1cd7 eb ex de,hl +1cd8 01ff00 ld bc,00ffh +1cdb 60 ld h,b +1cdc 68 ld l,b +1cdd cc0419 call z,1904h ; INT_RESULT_HL - Get back from function, result in HL +1ce0 eb ex de,hl +1ce1 7e ld a,(hl) +1ce2 fe2d cp 2dh +1ce4 f5 push af +1ce5 caed1c jp z,1cedh +1ce8 fe2b cp 2bh +1cea 2801 jr z,1cedh +1cec 2b dec hl +1ced d7 rst 10h ; CHRGTB: Gets next character (or token) from BASIC text. +1cee da931d jp c,1d93h +1cf1 fe2e cp 2eh +1cf3 ca4e1d jp z,1d4eh +1cf6 fe45 cp 45h +1cf8 2814 jr z,1d0eh +1cfa fe25 cp 25h +1cfc ca581d jp z,1d58h +1cff fe23 cp 23h +1d01 ca5f1d jp z,1d5fh +1d04 fe21 cp 21h +1d06 ca601d jp z,1d60h +1d09 fe44 cp 44h +1d0b 2024 jr nz,1d31h +1d0d b7 or a +1d0e cd651d call 1d65h +1d11 e5 push hl +1d12 21271d ld hl,1d27h +1d15 e3 ex (sp),hl +1d16 d7 rst 10h ; CHRGTB: Gets next character (or token) from BASIC text. +1d17 15 dec d +1d18 fece cp 0ceh +1d1a c8 ret z +1d1b fe2d cp 2dh +1d1d c8 ret z +1d1e 14 inc d +1d1f fecd cp 0cdh +1d21 c8 ret z +1d22 fe2b cp 2bh +1d24 c8 ret z +1d25 2b dec hl +1d26 f1 pop af +1d27 d7 rst 10h ; CHRGTB: Gets next character (or token) from BASIC text. +1d28 dafe1d jp c,1dfeh +1d2b 14 inc d +1d2c 2003 jr nz,1d31h +1d2e af xor a +1d2f 93 sub e +1d30 5f ld e,a +1d31 e5 push hl +1d32 7b ld a,e +1d33 90 sub b +1d34 f4741d call p,1d74h +1d37 fc821d call m,1d82h +1d3a 20f8 jr nz,1d34h +1d3c e1 pop hl +1d3d f1 pop af +1d3e e5 push hl +1d3f cce517 call z,17e5h ; INVSGN +1d42 e1 pop hl +1d43 e7 rst 20h ; GETYPR - Get the number type (FAC) +1d44 e8 ret pe +1d45 e5 push hl +1d46 21fa16 ld hl,16fah +1d49 e5 push hl +1d4a cd0d19 call 190dh +1d4d c9 ret + +1d4e e7 rst 20h ; GETYPR - Get the number type (FAC) +1d4f 0c inc c +1d50 20df jr nz,1d31h +1d52 dc651d call c,1d65h +1d55 c3ed1c jp 1cedh +1d58 e7 rst 20h ; GETYPR - Get the number type (FAC) +1d59 f28128 jp p,2881h ; Syntax Error (SN ERROR) +1d5c 23 inc hl +1d5d 18d2 jr 1d31h +1d5f b7 or a +1d60 cd651d call 1d65h +1d63 18f7 jr 1d5ch + +1d65 e5 push hl +1d66 d5 push de +1d67 c5 push bc +1d68 f5 push af +1d69 cc1b19 call z,191bh ; __CSNG: Integer to single precision +1d6c f1 pop af +1d6d c44519 call nz,1945h ; __CDBL +1d70 c1 pop bc +1d71 d1 pop de +1d72 e1 pop hl +1d73 c9 ret + +1d74 c8 ret z +1d75 f5 push af +1d76 e7 rst 20h ; GETYPR - Get the number type (FAC) +1d77 f5 push af +1d78 e4a817 call po,17a8h ; MLSP10 - Multiply number in FPREG by 10 +1d7b f1 pop af +1d7c ecb71c call pe,1cb7h +1d7f f1 pop af +1d80 3d dec a +1d81 c9 ret + +1d82 d5 push de +1d83 e5 push hl +1d84 f5 push af +1d85 e7 rst 20h ; GETYPR - Get the number type (FAC) +1d86 f5 push af +1d87 e40117 call po,1701h ; DIV10 - Divide FP by 10 +1d8a f1 pop af +1d8b ec461c call pe,1c46h +1d8e f1 pop af +1d8f e1 pop hl +1d90 d1 pop de +1d91 3c inc a +1d92 c9 ret +1d93 d5 push de +1d94 78 ld a,b +1d95 89 adc a,c +1d96 47 ld b,a +1d97 c5 push bc +1d98 e5 push hl +1d99 7e ld a,(hl) + +1d9a d630 sub 30h +1d9c f5 push af +1d9d e7 rst 20h ; GETYPR - Get the number type (FAC) +1d9e f2c71d jp p,1dc7h +1da1 2a41fe ld hl,(0fe41h) ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +1da4 11cd0c ld de,0ccdh +1da7 df rst 18h ; DCOMPR - Compare HL with DE. +1da8 3019 jr nc,1dc3h +1daa 54 ld d,h +1dab 5d ld e,l +1dac 29 add hl,hl +1dad 29 add hl,hl +1dae 19 add hl,de +1daf 29 add hl,hl +1db0 f1 pop af +1db1 4f ld c,a +1db2 09 add hl,bc +1db3 7c ld a,h +1db4 b7 or a +1db5 fac11d jp m,1dc1h +1db8 2241fe ld (0fe41h),hl ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +1dbb e1 pop hl +1dbc c1 pop bc +1dbd d1 pop de +1dbe c3ed1c jp 1cedh + +1dc1 79 ld a,c +1dc2 f5 push af +1dc3 cd3619 call 1936h +1dc6 37 scf +1dc7 3018 jr nc,1de1h +1dc9 017494 ld bc,9474h +1dcc 110024 ld de,2400h +1dcf cd7618 call 1876h ; CMPNUM - Compare FP reg to BCDE +1dd2 f2de1d jp p,1ddeh +1dd5 cda817 call 17a8h ; MLSP10 - Multiply number in FPREG by 10 +1dd8 f1 pop af +1dd9 cdf31d call 1df3h +1ddc 18dd jr 1dbbh + +1dde cd4d19 call 194dh +1de1 cdb71c call 1cb7h +1de4 cd6618 call 1866h ; FP_ARG2HL +1de7 f1 pop af +1de8 cdce17 call 17ceh ; FLGREL - CY and A to FP, & normalise +1deb cd4d19 call 194dh +1dee cde11a call 1ae1h ; DBL_ADD - Double precision ADD (formerly FPADD) +1df1 18c8 jr 1dbbh + +1df3 cd0e18 call 180eh ; STAKFP: Move FPREG to stack +1df6 cdce17 call 17ceh ; FLGREL - CY and A to FP, & normalise +1df9 c1 pop bc +1dfa d1 pop de +1dfb c38015 jp 1580h ; FPADD - Single precision add (Add BCDE to FP reg) + +1dfe 7b ld a,e +1dff fe0a cp 0ah +1e01 3009 jr nc,1e0ch +1e03 07 rlca +1e04 07 rlca +1e05 83 add a,e +1e06 07 rlca +1e07 86 add a,(hl) +1e08 d630 sub 30h +1e0a 5f ld e,a +1e0b fa1e32 jp m,321eh +1e0e c3271d jp 1d27h + +; LNUM_MSG +1e11 e5 push hl +1e12 210e28 ld hl,280eh +1e15 cd9b37 call 379bh ; PRS - Output a string +1e18 e1 pop hl +1e19 cd0419 call 1904h ; INT_RESULT_HL - Get back from function, result in HL +1e1c af xor a +1e1d cd9e1e call 1e9eh +1e20 b6 or (hl) +1e21 cd431e call 1e43h +1e24 c39a37 jp 379ah ; PRNUMS - Print number string + +1e27 af xor a + +; Floating point to ASCII +1e28 cd9e1e call 1e9eh +1e2b e608 and 08h +1e2d 2802 jr z,1e31h +1e2f 362b ld (hl),2bh +1e31 eb ex de,hl +1e32 cdfe17 call 17feh ; _TSTSGN - Test sign in number +1e35 eb ex de,hl +1e36 f2431e jp p,1e43h +1e39 362d ld (hl),2dh +1e3b c5 push bc +1e3c e5 push hl +1e3d cde517 call 17e5h ; INVSGN +1e40 e1 pop hl +1e41 c1 pop bc +1e42 b4 or h +1e43 23 inc hl +1e44 3630 ld (hl),30h +1e46 3af8fd ld a,(0fdf8h) ; 1: Index of last byte executed in current statement- 2: Edit flag during print using +1e49 57 ld d,a +1e4a 17 rla +1e4b 3acffd ld a,(0fdcfh) ; Type flag for FPREG: 2 - Integer, 3 - String, 4 - Single, 5 - Double +1e4e da041f jp c,1f04h +1e51 cafc1e jp z,1efch +1e54 fe04 cp 04h +1e56 d2a71e jp nc,1ea7h +1e59 010000 ld bc,0000h +1e5c cd9921 call 2199h +1e5f 2150fe ld hl,0fe50h +1e62 46 ld b,(hl) +1e63 0e20 ld c,20h +1e65 3af8fd ld a,(0fdf8h) ; 1: Index of last byte executed in current statement- 2: Edit flag during print using +1e68 5f ld e,a +1e69 e620 and 20h +1e6b 2807 jr z,1e74h +1e6d 78 ld a,b +1e6e b9 cp c +1e6f 0e2a ld c,2ah +1e71 2001 jr nz,1e74h +1e73 41 ld b,c +1e74 71 ld (hl),c +1e75 d7 rst 10h ; CHRGTB: Gets next character (or token) from BASIC text. +1e76 2814 jr z,1e8ch +1e78 fe45 cp 45h +1e7a 2810 jr z,1e8ch +1e7c fe44 cp 44h +1e7e 280c jr z,1e8ch +1e80 fe30 cp 30h +1e82 28f0 jr z,1e74h +1e84 fe2c cp ',' +1e86 28ec jr z,1e74h +1e88 fe2e cp 2eh +1e8a 2003 jr nz,1e8fh +1e8c 2b dec hl +1e8d 3630 ld (hl),30h +1e8f 7b ld a,e +1e90 e610 and 10h +1e92 2803 jr z,1e97h +1e94 2b dec hl +1e95 3624 ld (hl),24h +1e97 7b ld a,e +1e98 e604 and 04h +1e9a c0 ret nz +1e9b 2b dec hl +1e9c 70 ld (hl),b +1e9d c9 ret +1e9e 32f8fd ld (0fdf8h),a ; 1: Index of last byte executed in current statement- 2: Edit flag during print using +1ea1 2150fe ld hl,0fe50h +1ea4 3620 ld (hl),20h +1ea6 c9 ret +1ea7 fe05 cp 05h +1ea9 e5 push hl +1eaa de00 sbc a,00h +1eac 17 rla +1ead 57 ld d,a +1eae 14 inc d +1eaf cd6b20 call 206bh +1eb2 010003 ld bc,0300h +1eb5 82 add a,d +1eb6 fac11e jp m,1ec1h +1eb9 14 inc d +1eba ba cp d +1ebb 3004 jr nc,1ec1h +1ebd 3c inc a +1ebe 47 ld b,a +1ebf 3e02 ld a,02h +1ec1 d602 sub 02h +1ec3 e1 pop hl +1ec4 f5 push af +1ec5 cdfb20 call 20fbh +1ec8 3630 ld (hl),30h +1eca cc3318 call z,1833h ; INCHL +1ecd cd0e21 call 210eh +1ed0 2b dec hl +1ed1 7e ld a,(hl) +1ed2 fe30 cp 30h +1ed4 28fa jr z,1ed0h +1ed6 fe2e cp 2eh +1ed8 c43318 call nz,1833h ; INCHL +1edb f1 pop af +1edc 281f jr z,1efdh +1ede f5 push af +1edf e7 rst 20h ; GETYPR - Get the number type (FAC) +1ee0 3e22 ld a,22h +1ee2 8f adc a,a +1ee3 77 ld (hl),a +1ee4 23 inc hl +1ee5 f1 pop af +1ee6 362b ld (hl),2bh +1ee8 f2ef1e jp p,1eefh +1eeb 362d ld (hl),2dh +1eed 2f cpl +1eee 3c inc a +1eef 062f ld b,2fh +1ef1 04 inc b +1ef2 d60a sub 0ah +1ef4 30fb jr nc,1ef1h +1ef6 c63a add a,3ah +1ef8 23 inc hl +1ef9 70 ld (hl),b +1efa 23 inc hl +1efb 77 ld (hl),a +1efc 23 inc hl +1efd 3600 ld (hl),00h +1eff eb ex de,hl +1f00 2150fe ld hl,0fe50h +1f03 c9 ret +1f04 23 inc hl +1f05 c5 push bc +1f06 fe04 cp 04h +1f08 7a ld a,d +1f09 d2731f jp nc,1f73h +1f0c 1f rra +1f0d da0d20 jp c,200dh +1f10 010306 ld bc,0603h +1f13 cdf320 call 20f3h +1f16 d1 pop de +1f17 7a ld a,d +1f18 d605 sub 05h +1f1a f4d320 call p,20d3h +1f1d cd9921 call 2199h +1f20 7b ld a,e +1f21 b7 or a +1f22 cc9917 call z,1799h +1f25 3d dec a +1f26 f4d320 call p,20d3h + +1f29 e5 push hl +1f2a cd5f1e call 1e5fh +1f2d e1 pop hl +1f2e 2802 jr z,1f32h +1f30 70 ld (hl),b +1f31 23 inc hl +1f32 3600 ld (hl),00h +1f34 214ffe ld hl,0fe4fh +1f37 23 inc hl +1f38 3a13fe ld a,(0fe13h) ; NXTOPR: Next operand, addr of decimal point in PBUF, etc.. +1f3b 95 sub l +1f3c 92 sub d +1f3d c8 ret z +1f3e 7e ld a,(hl) +1f3f fe20 cp 20h +1f41 28f4 jr z,1f37h +1f43 fe2a cp 2ah +1f45 28f0 jr z,1f37h +1f47 2b dec hl +1f48 e5 push hl +1f49 f5 push af +1f4a 01491f ld bc,1f49h +1f4d c5 push bc +1f4e d7 rst 10h ; CHRGTB: Gets next character (or token) from BASIC text. +1f4f fe2d cp 2dh +1f51 c8 ret z +1f52 fe2b cp 2bh +1f54 c8 ret z +1f55 fe24 cp 24h +1f57 c8 ret z +1f58 c1 pop bc +1f59 fe30 cp 30h +1f5b 200f jr nz,1f6ch +1f5d 23 inc hl +1f5e d7 rst 10h ; CHRGTB: Gets next character (or token) from BASIC text. +1f5f 300b jr nc,1f6ch +1f61 2b dec hl +1f62 012b77 ld bc,772bh +1f65 f1 pop af +1f66 28fb jr z,1f63h +1f68 c1 pop bc +1f69 c3381f jp 1f38h + +1f6c f1 pop af +1f6d 28fd jr z,1f6ch +1f6f e1 pop hl +1f70 3625 ld (hl),25h +1f72 c9 ret +1f73 e5 push hl +1f74 1f rra +1f75 da1420 jp c,2014h +1f78 2814 jr z,1f8eh +1f7a 11ee21 ld de,21eeh +1f7d cdb318 call 18b3h +1f80 1610 ld d,10h +1f82 fa9c1f jp m,1f9ch +1f85 e1 pop hl +1f86 c1 pop bc +1f87 cd271e call 1e27h +1f8a 2b dec hl +1f8b 3625 ld (hl),25h +1f8d c9 ret + +1f8e 010eb6 ld bc,0b60eh +1f91 11ca1b ld de,1bcah +1f94 cd7618 call 1876h ; CMPNUM - Compare FP reg to BCDE +1f97 f2851f jp p,1f85h +1f9a 1606 ld d,06h +1f9c cdbf17 call 17bfh ; TSTSGN - Test sign of FPREG +1f9f c46b20 call nz,206bh +1fa2 e1 pop hl +1fa3 c1 pop bc +1fa4 fac11f jp m,1fc1h +1fa7 c5 push bc +1fa8 5f ld e,a +1fa9 78 ld a,b +1faa 92 sub d +1fab 93 sub e +1fac f4d320 call p,20d3h +1faf cde720 call 20e7h +1fb2 cd0e21 call 210eh +1fb5 b3 or e +1fb6 c4e120 call nz,20e1h +1fb9 b3 or e +1fba c4fb20 call nz,20fbh +1fbd d1 pop de +1fbe c3201f jp 1f20h + +1fc1 5f ld e,a +1fc2 79 ld a,c +1fc3 b7 or a +1fc4 c4801d call nz,1d80h +1fc7 83 add a,e +1fc8 facc1f jp m,1fcch +1fcb af xor a +1fcc c5 push bc +1fcd f5 push af +1fce fc821d call m,1d82h +1fd1 face1f jp m,1fceh +1fd4 c1 pop bc +1fd5 7b ld a,e +1fd6 90 sub b +1fd7 c1 pop bc +1fd8 5f ld e,a +1fd9 82 add a,d +1fda 78 ld a,b +1fdb fae91f jp m,1fe9h +1fde 92 sub d +1fdf 93 sub e +1fe0 f4d320 call p,20d3h +1fe3 c5 push bc +1fe4 cde720 call 20e7h +1fe7 1811 jr 1ffah + +1fe9 cdd320 call 20d3h +1fec 79 ld a,c +1fed cdfe20 call 20feh +1ff0 4f ld c,a +1ff1 af xor a +1ff2 92 sub d +1ff3 93 sub e +1ff4 cdd320 call 20d3h +1ff7 c5 push bc +1ff8 47 ld b,a +1ff9 4f ld c,a + +1ffa cd0e21 call 210eh +1ffd c1 pop bc +1ffe b1 or c + +; Switched memory bank +;1fff 2003 jr nz,2004h +;2001 2a13fe ld hl,(0fe13h) +;(...) + + +; 1fff 20ff jr nz,2000h +2001 ff rst 38h +2002 ff rst 38h +2003 ff rst 38h +2004 ff rst 38h +2005 ff rst 38h +2006 ff rst 38h +2007 ff rst 38h +2008 ff rst 38h +2009 ff rst 38h +200a ff rst 38h +200b ff rst 38h +200c ff rst 38h +200d ff rst 38h +200e ff rst 38h +200f ff rst 38h +2010 ff rst 38h +2011 ff rst 38h +2012 ff rst 38h +2013 ff rst 38h +2014 ff rst 38h +2015 ff rst 38h +2016 ff rst 38h +2017 ff rst 38h +2018 ff rst 38h +2019 ff rst 38h +201a ff rst 38h +201b ff rst 38h +201c ff rst 38h +201d ff rst 38h +201e ff rst 38h +201f ff rst 38h +2020 ff rst 38h +2021 ff rst 38h +2022 ff rst 38h +2023 ff rst 38h +2024 ff rst 38h +2025 ff rst 38h +2026 ff rst 38h +2027 ff rst 38h +2028 ff rst 38h +2029 ff rst 38h +202a ff rst 38h +202b ff rst 38h +202c ff rst 38h +202d ff rst 38h +202e ff rst 38h +202f ff rst 38h +2030 ff rst 38h +2031 ff rst 38h +2032 ff rst 38h +2033 ff rst 38h +2034 ff rst 38h +2035 ff rst 38h +2036 ff rst 38h +2037 ff rst 38h +2038 c3d2fb jp 0fbd2h ; Interrupt exit - initialised to a return +203b ff rst 38h +203c ff rst 38h +203d ff rst 38h +203e ff rst 38h +203f ff rst 38h +2040 ff rst 38h +2041 ff rst 38h +2042 ff rst 38h +2043 ff rst 38h +2044 ff rst 38h +2045 ff rst 38h +2046 ff rst 38h +2047 ff rst 38h +2048 ff rst 38h +2049 ff rst 38h +204a ff rst 38h +204b ff rst 38h +204c ff rst 38h +204d ff rst 38h +204e ff rst 38h +204f ff rst 38h +2050 ff rst 38h +2051 ff rst 38h +2052 ff rst 38h +2053 ff rst 38h +2054 ff rst 38h +2055 ff rst 38h +2056 ff rst 38h +2057 ff rst 38h +2058 ff rst 38h +2059 ff rst 38h +205a ff rst 38h +205b ff rst 38h +205c ff rst 38h +205d ff rst 38h +205e ff rst 38h +205f ff rst 38h +2060 ff rst 38h +2061 ff rst 38h +2062 ff rst 38h +2063 ff rst 38h +2064 ff rst 38h +2065 ff rst 38h +2066 ff rst 38h +2067 ff rst 38h +2068 ff rst 38h +2069 ff rst 38h +206a ff rst 38h +206b ff rst 38h +206c ff rst 38h +206d ff rst 38h +206e ff rst 38h +206f ff rst 38h +2070 ff rst 38h +2071 ff rst 38h +2072 ff rst 38h +2073 ff rst 38h +2074 ff rst 38h +2075 ff rst 38h +2076 ff rst 38h +2077 ff rst 38h +2078 ff rst 38h +2079 ff rst 38h +207a ff rst 38h +207b ff rst 38h +207c ff rst 38h +207d ff rst 38h +207e ff rst 38h +207f ff rst 38h +2080 ff rst 38h +2081 ff rst 38h +2082 ff rst 38h +2083 ff rst 38h +2084 ff rst 38h +2085 ff rst 38h +2086 ff rst 38h +2087 ff rst 38h +2088 ff rst 38h +2089 ff rst 38h +208a ff rst 38h +208b ff rst 38h +208c ff rst 38h +208d ff rst 38h +208e ff rst 38h +208f ff rst 38h +2090 ff rst 38h +2091 ff rst 38h +2092 ff rst 38h +2093 ff rst 38h +2094 ff rst 38h +2095 ff rst 38h +2096 ff rst 38h +2097 ff rst 38h +2098 ff rst 38h +2099 ff rst 38h +209a ff rst 38h +209b ff rst 38h +209c ff rst 38h +209d ff rst 38h +209e ff rst 38h +209f ff rst 38h +20a0 ff rst 38h +20a1 ff rst 38h +20a2 ff rst 38h +20a3 ff rst 38h +20a4 ff rst 38h +20a5 ff rst 38h +20a6 ff rst 38h +20a7 ff rst 38h +20a8 ff rst 38h +20a9 ff rst 38h +20aa ff rst 38h +20ab ff rst 38h +20ac ff rst 38h +20ad ff rst 38h +20ae ff rst 38h +20af ff rst 38h +20b0 ff rst 38h +20b1 ff rst 38h +20b2 ff rst 38h +20b3 ff rst 38h +20b4 ff rst 38h +20b5 ff rst 38h +20b6 ff rst 38h +20b7 ff rst 38h +20b8 ff rst 38h +20b9 ff rst 38h +20ba ff rst 38h +20bb ff rst 38h +20bc ff rst 38h +20bd ff rst 38h +20be ff rst 38h +20bf ff rst 38h +20c0 ff rst 38h +20c1 ff rst 38h +20c2 ff rst 38h +20c3 ff rst 38h +20c4 ff rst 38h +20c5 ff rst 38h +20c6 ff rst 38h +20c7 ff rst 38h +20c8 ff rst 38h +20c9 ff rst 38h +20ca ff rst 38h +20cb ff rst 38h +20cc ff rst 38h +20cd ff rst 38h +20ce ff rst 38h +20cf ff rst 38h +20d0 ff rst 38h +20d1 ff rst 38h +20d2 ff rst 38h +20d3 ff rst 38h +20d4 ff rst 38h +20d5 ff rst 38h +20d6 ff rst 38h +20d7 ff rst 38h +20d8 ff rst 38h +20d9 ff rst 38h +20da ff rst 38h +20db ff rst 38h +20dc ff rst 38h +20dd ff rst 38h +20de ff rst 38h +20df ff rst 38h +20e0 ff rst 38h +20e1 ff rst 38h +20e2 ff rst 38h +20e3 ff rst 38h +20e4 ff rst 38h +20e5 ff rst 38h +20e6 ff rst 38h +20e7 ff rst 38h +20e8 ff rst 38h +20e9 ff rst 38h +20ea ff rst 38h +20eb ff rst 38h +20ec ff rst 38h +20ed ff rst 38h +20ee ff rst 38h +20ef ff rst 38h +20f0 ff rst 38h +20f1 ff rst 38h +20f2 ff rst 38h +20f3 ff rst 38h +20f4 ff rst 38h +20f5 ff rst 38h +20f6 ff rst 38h +20f7 ff rst 38h +20f8 ff rst 38h +20f9 ff rst 38h +20fa ff rst 38h +20fb ff rst 38h +20fc ff rst 38h +20fd ff rst 38h +20fe ff rst 38h +20ff ff rst 38h +2100 ff rst 38h +2101 ff rst 38h +2102 ff rst 38h +2103 ff rst 38h +2104 ff rst 38h +2105 ff rst 38h +2106 ff rst 38h +2107 ff rst 38h +2108 ff rst 38h +2109 ff rst 38h +210a ff rst 38h +210b ff rst 38h +210c ff rst 38h +210d ff rst 38h +210e ff rst 38h +210f ff rst 38h +2110 ff rst 38h +2111 ff rst 38h +2112 ff rst 38h +2113 ff rst 38h +2114 ff rst 38h +2115 ff rst 38h +2116 ff rst 38h +2117 ff rst 38h +2118 ff rst 38h +2119 ff rst 38h +211a ff rst 38h +211b ff rst 38h +211c ff rst 38h +211d ff rst 38h +211e ff rst 38h +211f ff rst 38h +2120 ff rst 38h +2121 ff rst 38h +2122 ff rst 38h +2123 ff rst 38h +2124 ff rst 38h +2125 ff rst 38h +2126 ff rst 38h +2127 ff rst 38h +2128 ff rst 38h +2129 ff rst 38h +212a ff rst 38h +212b ff rst 38h +212c ff rst 38h +212d ff rst 38h +212e ff rst 38h +212f ff rst 38h +2130 ff rst 38h +2131 ff rst 38h +2132 ff rst 38h +2133 ff rst 38h +2134 ff rst 38h +2135 ff rst 38h +2136 ff rst 38h +2137 ff rst 38h +2138 ff rst 38h +2139 ff rst 38h +213a ff rst 38h +213b ff rst 38h +213c ff rst 38h +213d ff rst 38h +213e ff rst 38h +213f ff rst 38h +2140 ff rst 38h +2141 ff rst 38h +2142 ff rst 38h +2143 ff rst 38h +2144 ff rst 38h +2145 ff rst 38h +2146 ff rst 38h +2147 ff rst 38h +2148 ff rst 38h +2149 ff rst 38h +214a ff rst 38h +214b ff rst 38h +214c ff rst 38h +214d ff rst 38h +214e ff rst 38h +214f ff rst 38h +2150 ff rst 38h +2151 ff rst 38h +2152 ff rst 38h +2153 ff rst 38h +2154 ff rst 38h +2155 ff rst 38h +2156 ff rst 38h +2157 ff rst 38h +2158 ff rst 38h +2159 ff rst 38h +215a ff rst 38h +215b ff rst 38h +215c ff rst 38h +215d ff rst 38h +215e ff rst 38h +215f ff rst 38h +2160 ff rst 38h +2161 ff rst 38h +2162 ff rst 38h +2163 ff rst 38h +2164 ff rst 38h +2165 ff rst 38h +2166 ff rst 38h +2167 ff rst 38h +2168 ff rst 38h +2169 ff rst 38h +216a ff rst 38h +216b ff rst 38h +216c ff rst 38h +216d ff rst 38h +216e ff rst 38h +216f ff rst 38h +2170 ff rst 38h +2171 ff rst 38h +2172 ff rst 38h +2173 ff rst 38h +2174 ff rst 38h +2175 ff rst 38h +2176 ff rst 38h +2177 ff rst 38h +2178 ff rst 38h +2179 ff rst 38h +217a ff rst 38h +217b ff rst 38h +217c ff rst 38h +217d ff rst 38h +217e ff rst 38h +217f ff rst 38h +2180 ff rst 38h +2181 ff rst 38h +2182 ff rst 38h +2183 ff rst 38h +2184 ff rst 38h +2185 ff rst 38h +2186 ff rst 38h +2187 ff rst 38h +2188 ff rst 38h +2189 ff rst 38h +218a ff rst 38h +218b ff rst 38h +218c ff rst 38h +218d ff rst 38h +218e ff rst 38h +218f ff rst 38h +2190 ff rst 38h +2191 ff rst 38h +2192 ff rst 38h +2193 ff rst 38h +2194 ff rst 38h +2195 ff rst 38h +2196 ff rst 38h +2197 ff rst 38h +2198 ff rst 38h +2199 ff rst 38h +219a ff rst 38h +219b ff rst 38h +219c ff rst 38h +219d ff rst 38h +219e ff rst 38h +219f ff rst 38h +21a0 ff rst 38h +21a1 ff rst 38h +21a2 ff rst 38h +21a3 ff rst 38h +21a4 ff rst 38h +21a5 ff rst 38h +21a6 ff rst 38h +21a7 ff rst 38h +21a8 ff rst 38h +21a9 ff rst 38h +21aa ff rst 38h +21ab ff rst 38h +21ac ff rst 38h +21ad ff rst 38h +21ae ff rst 38h +21af ff rst 38h +21b0 ff rst 38h +21b1 ff rst 38h +21b2 ff rst 38h +21b3 ff rst 38h +21b4 ff rst 38h +21b5 ff rst 38h +21b6 ff rst 38h +21b7 ff rst 38h +21b8 ff rst 38h +21b9 ff rst 38h +21ba ff rst 38h +21bb ff rst 38h +21bc ff rst 38h +21bd ff rst 38h +21be ff rst 38h +21bf ff rst 38h +21c0 ff rst 38h +21c1 ff rst 38h +21c2 ff rst 38h +21c3 ff rst 38h +21c4 ff rst 38h +21c5 ff rst 38h +21c6 ff rst 38h +21c7 ff rst 38h +21c8 ff rst 38h +21c9 ff rst 38h +21ca ff rst 38h +21cb ff rst 38h +21cc ff rst 38h +21cd ff rst 38h +21ce ff rst 38h +21cf ff rst 38h +21d0 ff rst 38h +21d1 ff rst 38h +21d2 ff rst 38h +21d3 ff rst 38h +21d4 ff rst 38h +21d5 ff rst 38h +21d6 ff rst 38h +21d7 ff rst 38h +21d8 ff rst 38h +21d9 ff rst 38h +21da ff rst 38h +21db ff rst 38h +21dc ff rst 38h +21dd ff rst 38h +21de ff rst 38h +21df ff rst 38h +21e0 ff rst 38h +21e1 ff rst 38h +21e2 ff rst 38h +21e3 ff rst 38h +21e4 ff rst 38h +21e5 ff rst 38h +21e6 ff rst 38h +21e7 ff rst 38h +21e8 ff rst 38h +21e9 ff rst 38h +21ea ff rst 38h +21eb ff rst 38h +21ec ff rst 38h +21ed ff rst 38h +21ee ff rst 38h +21ef ff rst 38h +21f0 ff rst 38h +21f1 ff rst 38h +21f2 ff rst 38h +21f3 ff rst 38h +21f4 ff rst 38h +21f5 ff rst 38h +21f6 ff rst 38h +21f7 ff rst 38h +21f8 ff rst 38h +21f9 ff rst 38h +21fa ff rst 38h +21fb ff rst 38h +21fc ff rst 38h +21fd ff rst 38h +21fe ff rst 38h +21ff ff rst 38h +2200 ff rst 38h +2201 ff rst 38h +2202 ff rst 38h +2203 ff rst 38h +2204 ff rst 38h +2205 ff rst 38h +2206 ff rst 38h +2207 ff rst 38h +2208 ff rst 38h +2209 ff rst 38h +220a ff rst 38h +220b ff rst 38h +220c ff rst 38h +220d ff rst 38h +220e ff rst 38h +220f ff rst 38h +2210 ff rst 38h +2211 ff rst 38h +2212 ff rst 38h +2213 ff rst 38h +2214 ff rst 38h +2215 ff rst 38h +2216 ff rst 38h +2217 ff rst 38h +2218 ff rst 38h +2219 ff rst 38h +221a ff rst 38h +221b ff rst 38h +221c ff rst 38h +221d ff rst 38h +221e ff rst 38h +221f ff rst 38h +2220 ff rst 38h +2221 ff rst 38h +2222 ff rst 38h +2223 ff rst 38h +2224 ff rst 38h +2225 ff rst 38h +2226 ff rst 38h +2227 ff rst 38h +2228 ff rst 38h +2229 ff rst 38h +222a ff rst 38h +222b ff rst 38h +222c ff rst 38h +222d ff rst 38h +222e ff rst 38h +222f ff rst 38h +2230 ff rst 38h +2231 ff rst 38h +2232 ff rst 38h +2233 ff rst 38h +2234 ff rst 38h +2235 ff rst 38h +2236 ff rst 38h +2237 ff rst 38h +2238 ff rst 38h +2239 ff rst 38h +223a ff rst 38h +223b ff rst 38h +223c ff rst 38h +223d ff rst 38h +223e ff rst 38h +223f ff rst 38h +2240 ff rst 38h +2241 ff rst 38h +2242 ff rst 38h +2243 ff rst 38h +2244 ff rst 38h +2245 ff rst 38h +2246 ff rst 38h +2247 ff rst 38h +2248 ff rst 38h +2249 ff rst 38h +224a ff rst 38h +224b ff rst 38h +224c ff rst 38h +224d ff rst 38h +224e ff rst 38h +224f ff rst 38h +2250 ff rst 38h +2251 ff rst 38h +2252 ff rst 38h +2253 ff rst 38h +2254 ff rst 38h +2255 ff rst 38h +2256 ff rst 38h +2257 ff rst 38h +2258 ff rst 38h +2259 ff rst 38h +225a ff rst 38h +225b ff rst 38h +225c ff rst 38h +225d ff rst 38h +225e ff rst 38h +225f ff rst 38h +2260 ff rst 38h +2261 ff rst 38h +2262 ff rst 38h +2263 ff rst 38h +2264 ff rst 38h +2265 ff rst 38h +2266 ff rst 38h +2267 ff rst 38h +2268 ff rst 38h +2269 ff rst 38h +226a ff rst 38h +226b ff rst 38h +226c ff rst 38h +226d ff rst 38h +226e ff rst 38h +226f ff rst 38h +2270 ff rst 38h +2271 ff rst 38h +2272 ff rst 38h +2273 ff rst 38h +2274 ff rst 38h +2275 ff rst 38h +2276 ff rst 38h +2277 ff rst 38h +2278 ff rst 38h +2279 ff rst 38h +227a ff rst 38h +227b ff rst 38h +227c ff rst 38h +227d ff rst 38h +227e ff rst 38h +227f ff rst 38h +2280 ff rst 38h +2281 ff rst 38h +2282 ff rst 38h +2283 ff rst 38h +2284 ff rst 38h +2285 ff rst 38h +2286 ff rst 38h +2287 ff rst 38h +2288 ff rst 38h +2289 ff rst 38h +228a ff rst 38h +228b ff rst 38h +228c ff rst 38h +228d ff rst 38h +228e ff rst 38h +228f ff rst 38h +2290 ff rst 38h +2291 ff rst 38h +2292 ff rst 38h +2293 ff rst 38h +2294 ff rst 38h +2295 ff rst 38h +2296 ff rst 38h +2297 ff rst 38h +2298 ff rst 38h +2299 ff rst 38h +229a ff rst 38h +229b ff rst 38h +229c ff rst 38h +229d ff rst 38h +229e ff rst 38h +229f ff rst 38h +22a0 ff rst 38h +22a1 ff rst 38h +22a2 ff rst 38h +22a3 ff rst 38h +22a4 ff rst 38h +22a5 ff rst 38h +22a6 ff rst 38h +22a7 ff rst 38h +22a8 ff rst 38h +22a9 ff rst 38h +22aa ff rst 38h +22ab ff rst 38h +22ac ff rst 38h +22ad ff rst 38h +22ae ff rst 38h +22af ff rst 38h +22b0 ff rst 38h +22b1 ff rst 38h +22b2 ff rst 38h +22b3 ff rst 38h +22b4 ff rst 38h +22b5 ff rst 38h +22b6 ff rst 38h +22b7 ff rst 38h +22b8 ff rst 38h +22b9 ff rst 38h +22ba ff rst 38h +22bb ff rst 38h +22bc ff rst 38h +22bd ff rst 38h +22be ff rst 38h +22bf ff rst 38h +22c0 ff rst 38h +22c1 ff rst 38h +22c2 ff rst 38h +22c3 ff rst 38h +22c4 ff rst 38h +22c5 ff rst 38h +22c6 ff rst 38h +22c7 ff rst 38h +22c8 ff rst 38h +22c9 ff rst 38h +22ca ff rst 38h +22cb ff rst 38h +22cc ff rst 38h +22cd ff rst 38h +22ce ff rst 38h +22cf ff rst 38h +22d0 ff rst 38h +22d1 ff rst 38h +22d2 ff rst 38h +22d3 ff rst 38h +22d4 ff rst 38h +22d5 ff rst 38h +22d6 ff rst 38h +22d7 ff rst 38h +22d8 ff rst 38h +22d9 ff rst 38h +22da ff rst 38h +22db ff rst 38h +22dc ff rst 38h +22dd ff rst 38h +22de ff rst 38h +22df ff rst 38h +22e0 ff rst 38h +22e1 ff rst 38h +22e2 ff rst 38h +22e3 ff rst 38h +22e4 ff rst 38h +22e5 ff rst 38h +22e6 ff rst 38h +22e7 ff rst 38h +22e8 ff rst 38h +22e9 ff rst 38h +22ea ff rst 38h +22eb ff rst 38h +22ec ff rst 38h +22ed ff rst 38h +22ee ff rst 38h +22ef ff rst 38h +22f0 ff rst 38h +22f1 ff rst 38h +22f2 ff rst 38h +22f3 ff rst 38h +22f4 ff rst 38h +22f5 ff rst 38h +22f6 ff rst 38h +22f7 ff rst 38h +22f8 ff rst 38h +22f9 ff rst 38h +22fa ff rst 38h +22fb ff rst 38h +22fc ff rst 38h +22fd ff rst 38h +22fe ff rst 38h +22ff ff rst 38h +2300 c34803 jp 0348h +2303 7e ld a,(hl) +2304 fefa cp 0fah +2306 ca7f07 jp z,077fh +2309 2b dec hl +230a 7e ld a,(hl) +230b fe20 cp 20h +230d 28fa jr z,2309h +230f 23 inc hl +2310 fea9 cp 0a9h +2312 ca740d jp z,0d74h +2315 feaa cp 0aah +2317 ca770e jp z,0e77h +231a feab cp 0abh +231c ca6216 jp z,1662h ; UNITY - Constant ptr for number 1 in FP +231f feac cp 0ach +2321 ca000b jp z,0b00h +2324 fead cp 0adh +2326 ca7017 jp z,1770h +2329 fea6 cp 0a6h +232b ca5b19 jp z,195bh +232e fea7 cp 0a7h +2330 ca6d19 jp z,196dh +2333 fe90 cp 90h +2335 ca7b08 jp z,087bh +2338 fe85 cp 85h +233a ca7703 jp z,0377h +233d feb0 cp 0b0h +233f ca1e08 jp z,081eh +2342 c3f61c jp 1cf6h +2345 c35f1b jp 1b5fh +2348 3c inc a +2349 ca0a19 jp z,190ah +234c 3c inc a +234d caa708 jp z,08a7h +2350 3c inc a +2351 caef08 jp z,08efh +2354 3c inc a +2355 cada08 jp z,08dah +2358 3c inc a +2359 ca2209 jp z,0922h +235c 3c inc a +235d ca8306 jp z,0683h +2360 3c inc a +2361 ca8215 jp z,1582h +2364 3c inc a +2365 ca3306 jp z,0633h +2368 3c inc a +2369 ca5306 jp z,0653h +236c 3c inc a +236d ca6506 jp z,0665h +2370 3c inc a +2371 cab31d jp z,1db3h +2374 c3f61c jp 1cf6h +2377 dd2193fe ld ix,0fe93h +237b cd9a1d call 1d9ah +237e 2b dec hl +237f cdc51c call 1cc5h +2382 cd5d0b call 0b5dh +2385 23 inc hl +2386 feb2 cp 0b2h ; TK_PRINT +2388 cafb0b jp z,0bfbh +238b fe52 cp 52h ; 'R' +238d caac03 jp z,03ach +2390 fe4d cp 4dh ; 'M' +2392 ca7e1a jp z,1a7eh +2395 fedb cp 0dbh ; '' +2397 ca5905 jp z,0559h +239a fea0 cp 0a0h +239c ca9605 jp z,0596h +239f fe53 cp 53h +23a1 cae605 jp z,05e6h +23a4 febb cp 0bbh +23a6 ca1906 jp z,0619h +23a9 c3f61c jp 1cf6h + +23ac cd211d call 1d21h +23af d5 push de +23b0 cd520b call 0b52h +23b3 2c inc l +23b4 cd211d call 1d21h +23b7 c1 pop bc +23b8 d5 push de +23b9 c5 push bc +23ba 7a ld a,d +23bb b3 or e +23bc ca001d jp z,1d00h +23bf 2b dec hl +23c0 cd5d0b call 0b5dh +23c3 fe2c cp ',' +23c5 ed5b58fc ld de,(0fc58h) ; BASTXT - Address of BASIC Program +23c9 ed5355fb ld (0fb55h),de +23cd 201a jr nz,23e9h +23cf 23 inc hl +23d0 cd211d call 1d21h +23d3 e1 pop hl +23d4 e5 push hl +23d5 cd4c0b call 0b4ch +23d8 da001d jp c,1d00h +23db dd21162a ld ix,2a16h ; ix = {Search for line number} +23df cd9a1d call 1d9ah +23e2 d2001d jp nc,1d00h +23e5 ed4355fb ld (0fb55h),bc +23e9 210000 ld hl,0000h +23ec 54 ld d,h +23ed 5d ld e,l +23ee d9 exx +23ef 2a19fe ld hl,(0fe19h) ; Addr of simple variables +23f2 2257fb ld (0fb57h),hl +23f5 2a58fc ld hl,(0fc58h) ; BASTXT - Address of BASIC Program +23f8 2b dec hl + +23f9 23 inc hl +23fa 7e ld a,(hl) +23fb 23 inc hl +23fc b6 or (hl) +23fd 284d jr z,244ch +23ff 23 inc hl +2400 23 inc hl +2401 cd5d0b call 0b5dh +2404 200b jr nz,2411h +2406 d9 exx +2407 23 inc hl +2408 d9 exx +2409 a7 and a +240a 20f5 jr nz,2401h +240c d9 exx +240d 13 inc de +240e d9 exx +240f 18e8 jr 23f9h + +2411 cd1f05 call 051fh +2414 20eb jr nz,2401h +2416 cd5d0b call 0b5dh +2419 dde5 push ix +241b cd211d call 1d21h +241e dde1 pop ix +2420 cd2c05 call 052ch +2423 281c jr z,2441h +2425 7b ld a,e +2426 02 ld (bc),a +2427 03 inc bc +2428 7a ld a,d +2429 02 ld (bc),a +242a 7b ld a,e +242b 03 inc bc +242c 02 ld (bc),a +242d 03 inc bc +242e 7a ld a,d +242f 02 ld (bc),a +2430 03 inc bc +2431 ed4357fb ld (0fb57h),bc +2435 e5 push hl +2436 af xor a +2437 c5 push bc +2438 e1 pop hl +2439 ed72 sbc hl,sp +243b 3803 jr c,2440h +243d c30a1d jp 1d0ah + +2440 e1 pop hl +2441 2b dec hl +2442 cd5d0b call 0b5dh +2445 fe2c cp ',' +2447 28cd jr z,2416h +2449 2b dec hl +244a 18b5 jr 2401h +244c 2a55fb ld hl,(0fb55h) +244f 5e ld e,(hl) +2450 7b ld a,e +2451 23 inc hl +2452 56 ld d,(hl) +2453 b2 or d +2454 281f jr z,2475h +2456 d5 push de +2457 23 inc hl +2458 5e ld e,(hl) +2459 23 inc hl +245a 56 ld d,(hl) +245b cd2c05 call 052ch +245e dde1 pop ix +2460 d1 pop de +2461 2005 jr nz,2468h +2463 7b ld a,e +2464 02 ld (bc),a +2465 03 inc bc +2466 7a ld a,d +2467 02 ld (bc),a +2468 72 ld (hl),d +2469 2b dec hl +246a 73 ld (hl),e +246b eb ex de,hl +246c d1 pop de +246d 19 add hl,de +246e d5 push de +246f e5 push hl +2470 dde5 push ix +2472 e1 pop hl +2473 18da jr 244fh + +2475 2a58fc ld hl,(0fc58h) +2478 2b dec hl +2479 23 inc hl +247a 7e ld a,(hl) +247b 23 inc hl +247c b6 or (hl) +247d ca0d05 jp z,050dh +2480 23 inc hl +2481 5e ld e,(hl) +2482 23 inc hl +2483 56 ld d,(hl) +2484 cd5d0b call 0b5dh +2487 a7 and a +2488 28ef jr z,2479h +248a cd1f05 call 051fh +248d 20f5 jr nz,2484h +248f cd5d0b call 0b5dh +2492 30f3 jr nc,2487h +2494 e5 push hl +2495 dde5 push ix +2497 cd211d call 1d21h +249a dde1 pop ix +249c cd2c05 call 052ch +249f 0a ld a,(bc) +24a0 5f ld e,a +24a1 03 inc bc +24a2 0a ld a,(bc) +24a3 57 ld d,a +24a4 d5 push de +24a5 eb ex de,hl +24a6 2a57fb ld hl,(0fb57h) +24a9 e5 push hl +24aa af xor a +24ab ed52 sbc hl,de +24ad 23 inc hl +24ae e5 push hl +24af c1 pop bc +24b0 e1 pop hl +24b1 54 ld d,h +24b2 5d ld e,l +24b3 13 inc de +24b4 13 inc de +24b5 13 inc de +24b6 13 inc de +24b7 c5 push bc +24b8 dde1 pop ix +24ba edb8 lddr +24bc e1 pop hl +24bd d5 push de +24be dde5 push ix +24c0 cd281d call 1d28h +24c3 af xor a +24c4 dd21ea3f ld ix,3feah +24c8 cd9a1d call 1d9ah +24cb dde1 pop ix +24cd c1 pop bc +24ce d1 pop de +24cf 23 inc hl +24d0 c5 push bc +24d1 eda0 ldi +24d3 7e ld a,(hl) +24d4 a7 and a +24d5 20fa jr nz,24d1h +24d7 c1 pop bc +24d8 1b dec de +24d9 d5 push de +24da 13 inc de +24db c5 push bc +24dc e1 pop hl +24dd e5 push hl +24de d5 push de +24df eb ex de,hl +24e0 af xor a +24e1 ed52 sbc hl,de +24e3 23 inc hl +24e4 23 inc hl +24e5 23 inc hl +24e6 d1 pop de +24e7 e3 ex (sp),hl +24e8 23 inc hl +24e9 dde5 push ix +24eb c1 pop bc +24ec edb0 ldir +24ee d1 pop de +24ef 2a57fb ld hl,(0fb57h) +24f2 19 add hl,de +24f3 2257fb ld (0fb57h),hl +24f6 2a19fe ld hl,(0fe19h) ; Addr of simple variables +24f9 19 add hl,de +24fa 2219fe ld (0fe19h),hl ; Addr of simple variables +24fd e1 pop hl +24fe e5 push hl +24ff cd5d0b call 0b5dh +2502 fe2c cp ',' +2504 d1 pop de +2505 ca8f04 jp z,048fh +2508 eb ex de,hl +2509 2b dec hl +250a c38404 jp 0484h +250d cd2f1d call 1d2fh +2510 dd210329 ld ix,2903h ; IX = {READY} +2514 dde5 push ix +2516 dd214b2a ld ix,2a4bh ; IX = {_CLVAR - Initialise RUN variables} +251a dde5 push ix +251c c38a3f jp 3f8ah ; BANK SWITCHING - flip ROM page + +251f e5 push hl +2520 c5 push bc +2521 215205 ld hl,0552h +2524 010700 ld bc,0007h +2527 edb1 cpir +2529 c1 pop bc +252a e1 pop hl +252b c9 ret + +252c e5 push hl +252d d5 push de +252e d5 push de +252f c1 pop bc +2530 2a19fe ld hl,(0fe19h) ; Addr of simple variables +2533 ed5b57fb ld de,(0fb57h) +2537 cd4c0b call 0b4ch +253a 280e jr z,254ah +253c 79 ld a,c +253d be cp (hl) +253e 23 inc hl +253f 2002 jr nz,2543h +2541 78 ld a,b +2542 be cp (hl) +2543 23 inc hl +2544 2807 jr z,254dh +2546 23 inc hl +2547 23 inc hl +2548 18ed jr 2537h + +254a 3eff ld a,0ffh +254c a7 and a +254d e5 push hl +254e c1 pop bc +254f d1 pop de +2550 e1 pop hl +2551 c9 ret + +2552 8d adc a,l +2553 91 sub c +2554 ca959f jp z,9f95h +2557 8e adc a,(hl) +2558 90 sub b +2559 e5 push hl +255a 210050 ld hl,5000h +255d 1100bf ld de,0bf00h +2560 cd4c0b call 0b4ch +2563 cac905 jp z,05c9h +2566 23 inc hl +2567 3a8cfb ld a,(0fb8ch) +256a 77 ld (hl),a +256b 0608 ld b,08h +256d af xor a +256e 328cfb ld (0fb8ch),a +2571 cdcb05 call 05cbh +2574 db62 in a,(62h) ; Parallel and Cassette I/O port +2576 cb5f bit 3,a +2578 280e jr z,2588h +257a 3a8cfb ld a,(0fb8ch) +257d cbc7 set 0,a +257f cb17 rl a +2581 328cfb ld (0fb8ch),a +2584 10eb djnz 2571h +2586 18d8 jr 2560h +2588 3a8cfb ld a,(0fb8ch) +258b cb87 res 0,a +258d cb17 rl a +258f 328cfb ld (0fb8ch),a +2592 10dd djnz 2571h +2594 18ca jr 2560h + +2596 e5 push hl +2597 210050 ld hl,5000h +259a 1100bf ld de,0bf00h +259d cd4c0b call 0b4ch +25a0 cac905 jp z,05c9h +25a3 23 inc hl +25a4 7e ld a,(hl) +25a5 328cfb ld (0fb8ch),a + +25a8 0608 ld b,08h ; 1 byte +25aa cdd205 call 05d2h +25ad 3a8cfb ld a,(0fb8ch) +25b0 cb07 rlc a +25b2 328cfb ld (0fb8ch),a +25b5 cb47 bit 0,a +25b7 2808 jr z,25c1h +25b9 3e0e ld a,0eh ; cassette output signal=low +25bb d363 out (63h),a ; Parallel Port Interface Control word +25bd 10eb djnz 25aah +25bf 18dc jr 259dh + +25c1 3e0f ld a,0fh ; cassette output signal=high +25c3 d363 out (63h),a ; Parallel Port Interface Control word +25c5 10e3 djnz 25aah +25c7 18d4 jr 259dh +25c9 e1 pop hl +25ca c9 ret + +25cb c5 push bc +25cc 0608 ld b,08h +25ce 10fe djnz 25ceh +25d0 c1 pop bc +25d1 c9 ret + +25d2 c5 push bc +25d3 0608 ld b,08h +25d5 10fe djnz 25d5h +25d7 c1 pop bc +25d8 c9 ret + +25d9 cd520b call 0b52h +25dc 57 ld d,a +25dd cd520b call 0b52h +25e0 41 ld b,c +25e1 cd520b call 0b52h +25e4 50 ld d,b +25e5 c9 ret + +25e6 cdd905 call 05d9h +25e9 2b dec hl +25ea cd5d0b call 0b5dh +25ed cd661d call 1d66h +25f0 3acffd ld a,(0fdcfh) ; Type flag for FPREG: 2 - Integer, 3 - String, 4 - Single, 5 - Double +25f3 fe03 cp 03h +25f5 c2fb1c jp nz,1cfbh +25f8 d5 push de +25f9 cd520b call 0b52h +25fc 2c inc l +25fd cd661d call 1d66h +2600 c1 pop bc +2601 e5 push hl +2602 c5 push bc +2603 e1 pop hl +2604 3acffd ld a,(0fdcfh) ; Type flag for FPREG: 2 - Integer, 3 - String, 4 - Single, 5 - Double +2607 fe03 cp 03h +2609 c2fb1c jp nz,1cfbh +260c 0603 ld b,03h +260e 4e ld c,(hl) +260f 1a ld a,(de) +2610 77 ld (hl),a +2611 79 ld a,c +2612 12 ld (de),a +2613 13 inc de +2614 23 inc hl +2615 10f7 djnz 260eh +2617 e1 pop hl +2618 c9 ret + +2619 2a58fc ld hl,(0fc58h) ; BASTXT - Address of BASIC Program +261c 74 ld (hl),h +261d dd21e529 ld ix,29e5h +2621 cd9a1d call 1d9ah +2624 dd210329 ld ix,2903h ; IX = {READY} +2628 dde5 push ix +262a dd21432a ld ix,2a43h +262e dde5 push ix +2630 c38a3f jp 3f8ah ; BANK SWITCHING - flip ROM page + +2633 e5 push hl +2634 cdc51c call 1cc5h +2637 cd6c1d call 1d6ch +263a e5 push hl +263b dde1 pop ix +263d e1 pop hl +263e 2b dec hl +263f cd5d0b call 0b5dh +2642 fe2c cp ',' +2644 2007 jr nz,264dh +2646 23 inc hl +2647 cd961d call 1d96h +264a d5 push de +264b 18f1 jr 263eh +264d e5 push hl +264e cd9a1d call 1d9ah +2651 e1 pop hl +2652 c9 ret +2653 e5 push hl +2654 cdc51c call 1cc5h +2657 cd721d call 1d72h +265a 21fc3f ld hl,3ffch +265d cd481d call 1d48h +2660 cd4e1d call 1d4eh +2663 e1 pop hl +2664 c9 ret +2665 e5 push hl +2666 cdc51c call 1cc5h +2669 cd721d call 1d72h +266c 21e1ff ld hl,0ffe1h +266f cd3c1d call 1d3ch +2672 21fc3f ld hl,3ffch +2675 cd421d call 1d42h +2678 21e1ff ld hl,0ffe1h +267b cd481d call 1d48h +267e cd541d call 1d54h +2681 e1 pop hl +2682 c9 ret + +2683 cd5d0b call 0b5dh +2686 cdc51c call 1cc5h +2689 cd520b call 0b52h +268c 28e5 jr z,2673h +268e 2ad3fd ld hl,(0fdd3h) ; TMSTPT: Address of next available location in LSPT +2691 224efb ld (0fb4eh),hl +2694 e1 pop hl +2695 cd5a1d call 1d5ah +2698 e5 push hl +2699 3acffd ld a,(0fdcfh) ; Type flag for FPREG: 2 - Integer, 3 - String, 4 - Single, 5 - Double +269c fe03 cp 03h +269e cab506 jp z,06b5h +26a1 cd6c1d call 1d6ch +26a4 3eff ld a,0ffh +26a6 a4 and h +26a7 c2001d jp nz,1d00h +26aa 7c ld a,h +26ab b5 or l +26ac ca001d jp z,1d00h +26af 2b dec hl +26b0 229dfb ld (0fb9dh),hl +26b3 1808 jr 26bdh +26b5 210000 ld hl,0000h +26b8 229dfb ld (0fb9dh),hl +26bb 182c jr 26e9h +26bd e1 pop hl +26be cdef06 call 06efh +26c1 329ffb ld (0fb9fh),a +26c4 a7 and a +26c5 ca001d jp z,1d00h +26c8 ed53a3fb ld (0fba3h),de +26cc e1 pop hl +26cd cdef06 call 06efh +26d0 32a1fb ld (0fba1h),a +26d3 a7 and a +26d4 ca001d jp z,1d00h +26d7 ed53a5fb ld (0fba5h),de +26db e1 pop hl +26dc cd520b call 0b52h +26df 29 add hl,hl +26e0 e5 push hl +26e1 2a4efb ld hl,(0fb4eh) +26e4 22d3fd ld (0fdd3h),hl ; TMSTPT: Address of next available location in LSPT +26e7 181c jr 2705h +26e9 e1 pop hl +26ea cdf906 call 06f9h +26ed 18d2 jr 26c1h + +26ef cd520b call 0b52h +26f2 2c inc l +26f3 cd5a1d call 1d5ah +26f6 cd601d call 1d60h +26f9 d1 pop de +26fa e5 push hl +26fb d5 push de +26fc 2a41fe ld hl,(0fe41h) ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +26ff 7e ld a,(hl) +2700 23 inc hl +2701 5e ld e,(hl) +2702 23 inc hl +2703 56 ld d,(hl) +2704 c9 ret + +2705 ed4b9dfb ld bc,(0fb9dh) +2709 3aa1fb ld a,(0fba1h) +270c 81 add a,c +270d 4f ld c,a +270e 3a9ffb ld a,(0fb9fh) +2711 b9 cp c +2712 da001d jp c,1d00h +2715 cd2207 call 0722h +2718 2241fe ld (0fe41h),hl ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +271b 3e02 ld a,02h +271d 32cffd ld (0fdcfh),a ; Type flag for FPREG: 2 - Integer, 3 - String, 4 - Single, 5 - Double +2720 e1 pop hl +2721 c9 ret + +2722 2aa3fb ld hl,(0fba3h) +2725 ed5b9dfb ld de,(0fb9dh) +2729 19 add hl,de +272a 22a7fb ld (0fba7h),hl +272d cd3a07 call 073ah ; Cassette output routine x 2 +2730 2804 jr z,2736h +2732 210000 ld hl,0000h +2735 c9 ret +2736 2600 ld h,00h +2738 69 ld l,c +2739 c9 ret +273a 3aa1fb ld a,(0fba1h) +273d 3d dec a +273e 4f ld c,a +273f 3a9dfb ld a,(0fb9dh) +2742 47 ld b,a +2743 3a9ffb ld a,(0fb9fh) +2746 90 sub b +2747 91 sub c +2748 47 ld b,a +2749 3a9dfb ld a,(0fb9dh) +274c 4f ld c,a +274d 3aa1fb ld a,(0fba1h) +2750 1600 ld d,00h +2752 0c inc c +2753 5f ld e,a +2754 2aa7fb ld hl,(0fba7h) +2757 e5 push hl +2758 dde1 pop ix +275a 2aa5fb ld hl,(0fba5h) +275d e5 push hl +275e fde1 pop iy +2760 dd7e00 ld a,(ix+00h) +2763 fdbe00 cp (iy+00h) +2766 200a jr nz,2772h +2768 dd23 inc ix +276a fd23 inc iy +276c 1d dec e +276d 7b ld a,e +276e a7 and a +276f c8 ret z +2770 18ee jr 2760h +2772 2aa7fb ld hl,(0fba7h) +2775 23 inc hl +2776 22a7fb ld (0fba7h),hl +2779 10d2 djnz 274dh +277b 3eff ld a,0ffh +277d a7 and a +277e c9 ret + +277f cd5d0b call 0b5dh +2782 cdc51c call 1cc5h +2785 fe28 cp 28h +2787 c2f61c jp nz,1cf6h +278a 23 inc hl +278b cd661d call 1d66h +278e cd601d call 1d60h +2791 eb ex de,hl +2792 d5 push de +2793 7e ld a,(hl) +2794 23 inc hl +2795 5e ld e,(hl) +2796 23 inc hl +2797 56 ld d,(hl) +2798 eb ex de,hl +2799 3297fb ld (0fb97h),a +279c a7 and a +279d ca001d jp z,1d00h +27a0 2295fb ld (0fb95h),hl +27a3 e1 pop hl +27a4 cd520b call 0b52h +27a7 2c inc l +27a8 cd961d call 1d96h +27ab da001d jp c,1d00h +27ae 7a ld a,d +27af b3 or e +27b0 ca001d jp z,1d00h +27b3 ed5399fb ld (0fb99h),de +27b7 cd520b call 0b52h +27ba 2c inc l +27bb cd961d call 1d96h +27be da001d jp c,1d00h +27c1 7b ld a,e +27c2 b2 or d +27c3 ca001d jp z,1d00h +27c6 ed539bfb ld (0fb9bh),de +27ca 3a99fb ld a,(0fb99h) +27cd 47 ld b,a +27ce 3a97fb ld a,(0fb97h) +27d1 90 sub b +27d2 3c inc a +27d3 3c inc a +27d4 47 ld b,a +27d5 3a9bfb ld a,(0fb9bh) +27d8 b8 cp b +27d9 d2001d jp nc,1d00h +27dc cd520b call 0b52h +27df 29 add hl,hl +27e0 cd520b call 0b52h +27e3 d5 push de +27e4 e5 push hl +27e5 2ad3fd ld hl,(0fdd3h) ; TMSTPT: Address of next available location in LSPT +27e8 224efb ld (0fb4eh),hl +27eb e1 pop hl +27ec cd5a1d call 1d5ah +27ef cd601d call 1d60h +27f2 e5 push hl +27f3 2a4efb ld hl,(0fb4eh) +27f6 22d3fd ld (0fdd3h),hl ; TMSTPT: Address of next available location in LSPT +27f9 2a41fe ld hl,(0fe41h) ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +27fc 7e ld a,(hl) +27fd 23 inc hl +27fe 5e ld e,(hl) +27ff 23 inc hl +2800 56 ld d,(hl) +2801 f5 push af +2802 3a9bfb ld a,(0fb9bh) +2805 47 ld b,a +2806 f1 pop af +2807 4f ld c,a +2808 2a95fb ld hl,(0fb95h) +280b d5 push de +280c ed5b99fb ld de,(0fb99h) +2810 1b dec de +2811 19 add hl,de +2812 d1 pop de +2813 1a ld a,(de) +2814 77 ld (hl),a +2815 13 inc de +2816 23 inc hl +2817 0d dec c +2818 2802 jr z,281ch +281a 10f7 djnz 2813h +281c e1 pop hl +281d c9 ret + + +281e 2b dec hl +281f cdc51c call 1cc5h +2822 cd5d0b call 0b5dh +2825 7e ld a,(hl) +2826 febe cp 0beh +2828 ca4008 jp z,0840h +282b fec1 cp 0c1h +282d ca3308 jp z,0833h +2830 c3f61c jp 1cf6h + + +2833 23 inc hl +2834 cd520b call 0b52h +2837 d5 push de +2838 cd961d call 1d96h +283b ed5342fc ld (0fc42h),de ; Address of USR subroutine +283f c9 ret + +2840 cd5d0b call 0b5dh +2843 cd361d call 1d36h +2846 e5 push hl +2847 cd6c1d call 1d6ch +284a eb ex de,hl +284b e1 pop hl +284c 3eff ld a,0ffh +284e a2 and d +284f c2001d jp nz,1d00h +2852 3e08 ld a,08h +2854 bb cp e +2855 da001d jp c,1d00h +2858 7b ld a,e +2859 a7 and a +285a ca001d jp z,1d00h +285d 87 add a,a +285e 83 add a,e +285f f5 push af +2860 cd520b call 0b52h +2863 d5 push de +2864 cd961d call 1d96h +2867 f1 pop af +2868 e5 push hl +2869 d5 push de +286a 21f3fb ld hl,0fbf3h +286d 1600 ld d,00h +286f 5f ld e,a +2870 19 add hl,de +2871 3ec3 ld a,0c3h +2873 77 ld (hl),a +2874 23 inc hl +2875 d1 pop de +2876 73 ld (hl),e +2877 23 inc hl +2878 72 ld (hl),d +2879 e1 pop hl +287a c9 ret + +287b 2b dec hl +287c cd5d0b call 0b5dh +287f 281c jr z,289dh + +; Syntax Error (SN ERROR) +2881 cdc51c call 1cc5h +2884 dd213a2d ld ix,2d3ah ; LNUM_PARM - Get specified line number +2888 cd9a1d call 1d9ah +288b e5 push hl + +; ERROR, E=error code +288c dd21162a ld ix,2a16h ; ix = {Search for line number} +2890 cd9a1d call 1d9ah +2893 e1 pop hl +2894 d2051d jp nc,1d05h +2897 0b dec bc +2898 ed431ffe ld (0fe1fh),bc ; Points to byte following last char +289c c9 ret + +289d eb ex de,hl +289e 2a58fc ld hl,(0fc58h) ; BASTXT - Address of BASIC Program +28a1 2b dec hl +28a2 221ffe ld (0fe1fh),hl ; Points to byte following last char +28a5 eb ex de,hl +28a6 c9 ret + +28a7 e5 push hl +28a8 cdc51c call 1cc5h +28ab cd6c1d call 1d6ch +28ae 110020 ld de,2000h +28b1 cd4c0b call 0b4ch +28b4 da001d jp c,1d00h +28b7 11ff9f ld de,9fffh +28ba cd4c0b call 0b4ch +28bd d2001d jp nc,1d00h +28c0 cd0f1d call 1d0fh +28c3 db50 in a,(50h) ; get system status +28c5 e610 and 10h +28c7 28fa jr z,28c3h ; wait for CSYNC - Composite video sync.signal +28c9 5e ld e,(hl) +28ca 1600 ld d,00h +28cc ed5341fe ld (0fe41h),de ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +28d0 3e02 ld a,02h +28d2 32cffd ld (0fdcfh),a ; Type flag for FPREG: 2 - Integer, 3 - String, 4 - Single, 5 - Double +28d5 cd1b1d call 1d1bh +28d8 e1 pop hl +28d9 c9 ret + +28da e5 push hl +28db cdc51c call 1cc5h +28de cd6c1d call 1d6ch +28e1 cd781d call 1d78h +28e4 ed5341fe ld (0fe41h),de ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +28e8 3e02 ld a,02h +28ea 32cffd ld (0fdcfh),a ; Type flag for FPREG: 2 - Integer, 3 - String, 4 - Single, 5 - Double +28ed e1 pop hl +28ee c9 ret +28ef e5 push hl +28f0 cdc51c call 1cc5h +28f3 cd6c1d call 1d6ch +28f6 e5 push hl +28f7 3e2f ld a,2fh +28f9 dd214b37 ld ix,374bh ; IX = {MKTMST - Make temporary string} +28fd cd9a1d call 1d9ah +2900 2af4fd ld hl,(0fdf4h) +2903 d1 pop de +2904 0610 ld b,10h +2906 c5 push bc +2907 cd841d call 1d84h +290a cd240a call 0a24h +290d 3e20 ld a,20h +290f 77 ld (hl),a +2910 23 inc hl +2911 13 inc de +2912 c1 pop bc +2913 10f1 djnz 2906h +2915 21f3fd ld hl,0fdf3h ; TMPSTR: 3 bytes used to hold length and addr of a string when moved to string area +2918 2241fe ld (0fe41h),hl ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +291b 3e03 ld a,03h + +; PROMPT +291d 32cffd ld (0fdcfh),a ; Type flag for FPREG: 2 - Integer, 3 - String, 4 - Single, 5 - Double +2920 e1 pop hl +2921 c9 ret + + +2922 cd5d0b call 0b5dh +2925 cdc51c call 1cc5h +2928 fec6 cp 0c6h +292a cad20a jp z,0ad2h +292d fe48 cp 48h +292f caf809 jp z,09f8h +2932 fe42 cp 42h +2934 ca430a jp z,0a43h +2937 fe4f cp 4fh +2939 ca8f0a jp z,0a8fh +293c e5 push hl +293d 2ad3fd ld hl,(0fdd3h) ; TMSTPT: Address of next available location in LSPT +2940 224efb ld (0fb4eh),hl +2943 e1 pop hl +2944 dd212b32 ld ix,322bh ; IX = {EVAL} +2948 cd9a1d call 1d9ah +294b e5 push hl +294c dd215e19 ld ix,195eh ; IX = {TSTSTR - Test a string, 'Type Error' if it is not} +2950 cd9a1d call 1d9ah +2953 ed5b41fe ld de,(0fe41h) ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +2957 1a ld a,(de) +2958 fe12 cp 12h +295a d2001d jp nc,1d00h +295d 3260fb ld (0fb60h),a +2960 47 ld b,a +2961 13 inc de +2962 eb ex de,hl +2963 5e ld e,(hl) +2964 23 inc hl +2965 56 ld d,(hl) +2966 1a ld a,(de) +2967 13 inc de +2968 e65f and 5fh +296a fe42 cp 42h +296c cabb09 jp z,09bbh +296f fe4f cp 4fh +2971 cad709 jp z,09d7h +2974 fe48 cp 48h +2976 c2001d jp nz,1d00h +2979 3a60fb ld a,(0fb60h) +297c fe06 cp 06h +297e d2001d jp nc,1d00h +2981 05 dec b +2982 78 ld a,b +2983 a7 and a +2984 ca001d jp z,1d00h +2987 210000 ld hl,0000h +298a 29 add hl,hl +298b 29 add hl,hl +298c 29 add hl,hl +298d 29 add hl,hl +298e 1a ld a,(de) +298f fe3a cp 3ah +2991 3809 jr c,299ch +2993 fe41 cp 41h ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +2995 da001d jp c,1d00h +2998 e6df and 0dfh +299a d607 sub 07h +299c d630 sub 30h +299e da001d jp c,1d00h +29a1 fe10 cp 10h +29a3 d2001d jp nc,1d00h +29a6 b5 or l +29a7 6f ld l,a +29a8 13 inc de +29a9 10df djnz 298ah +29ab 2241fe ld (0fe41h),hl ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +29ae 3e02 ld a,02h +29b0 32cffd ld (0fdcfh),a ; Type flag for FPREG: 2 - Integer, 3 - String, 4 - Single, 5 - Double +29b3 2a4efb ld hl,(0fb4eh) +29b6 22d3fd ld (0fdd3h),hl ; TMSTPT: Address of next available location in LSPT +29b9 e1 pop hl +29ba c9 ret + +29bb 210000 ld hl,0000h +29be 05 dec b +29bf 78 ld a,b +29c0 a7 and a +29c1 ca001d jp z,1d00h +29c4 29 add hl,hl +29c5 1a ld a,(de) +29c6 13 inc de +29c7 fe30 cp 30h +29c9 2807 jr z,29d2h +29cb fe31 cp 31h +29cd c2001d jp nz,1d00h +29d0 cbc5 set 0,l +29d2 10f0 djnz 29c4h +29d4 c3ab09 jp 09abh +29d7 210000 ld hl,0000h +29da 05 dec b +29db 78 ld a,b +29dc a7 and a +29dd ca001d jp z,1d00h +29e0 29 add hl,hl +29e1 29 add hl,hl +29e2 29 add hl,hl +29e3 1a ld a,(de) +29e4 13 inc de +29e5 fe30 cp 30h +29e7 da001d jp c,1d00h +29ea fe38 cp 38h +29ec d2001d jp nc,1d00h +29ef d630 sub 30h +29f1 b5 or l +29f2 6f ld l,a +29f3 10eb djnz 29e0h +29f5 c3ab09 jp 09abh +29f8 23 inc hl +29f9 cd961d call 1d96h +29fc e5 push hl +29fd d5 push de +29fe 3e05 ld a,05h +2a00 dd214b37 ld ix,374bh ; IX = {MKTMST - Make temporary string} +2a04 cd9a1d call 1d9ah +2a07 2af4fd ld hl,(0fdf4h) +2a0a 3e48 ld a,48h +2a0c 77 ld (hl),a +2a0d d1 pop de +2a0e cd1e0a call 0a1eh +2a11 21f3fd ld hl,0fdf3h ; TMPSTR: 3 bytes used to hold length and addr of a string when moved to string area +2a14 3e03 ld a,03h + +; FIND_LNUM - Search for line number +2a16 32cffd ld (0fdcfh),a ; Type flag for FPREG: 2 - Integer, 3 - String, 4 - Single, 5 - Double +2a19 2241fe ld (0fe41h),hl ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +2a1c e1 pop hl +2a1d c9 ret + +2a1e 23 inc hl +2a1f 7a ld a,d +2a20 cd240a call 0a24h +2a23 7b ld a,e +2a24 f5 push af +2a25 cb3f srl a +2a27 cb3f srl a +2a29 cb3f srl a +2a2b cb3f srl a +2a2d cd3b0a call 0a3bh +2a30 77 ld (hl),a +2a31 23 inc hl +2a32 f1 pop af +2a33 e60f and 0fh +2a35 cd3b0a call 0a3bh +2a38 77 ld (hl),a +2a39 23 inc hl +2a3a c9 ret +2a3b c630 add a,30h +2a3d fe3a cp 3ah +2a3f f8 ret m +2a40 c607 add a,07h +2a42 c9 ret + +2a43 23 inc hl +2a44 cd961d call 1d96h +2a47 e5 push hl +2a48 d5 push de +2a49 3e11 ld a,11h +2a4b dd214b37 ld ix,374bh ; IX = {MKTMST - Make temporary string} +2a4f cd9a1d call 1d9ah +2a52 2af4fd ld hl,(0fdf4h) +2a55 3e42 ld a,42h +2a57 77 ld (hl),a +2a58 111000 ld de,0010h +2a5b 19 add hl,de +2a5c d1 pop de +2a5d cd6d0a call 0a6dh +2a60 21f3fd ld hl,0fdf3h ; TMPSTR: 3 bytes used to hold length and addr of a string when moved to string area +2a63 3e03 ld a,03h +2a65 32cffd ld (0fdcfh),a ; Type flag for FPREG: 2 - Integer, 3 - String, 4 - Single, 5 - Double +2a68 2241fe ld (0fe41h),hl ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +2a6b e1 pop hl +2a6c c9 ret + +2a6d 7b ld a,e +2a6e 0607 ld b,07h +2a70 cd760a call 0a76h +2a73 7a ld a,d +2a74 0607 ld b,07h +2a76 d5 push de +2a77 5f ld e,a +2a78 e601 and 01h +2a7a c630 add a,30h +2a7c 77 ld (hl),a +2a7d 2b dec hl +2a7e 7b ld a,e +2a7f cb3f srl a +2a81 5f ld e,a +2a82 e601 and 01h +2a84 c630 add a,30h +2a86 77 ld (hl),a +2a87 2b dec hl +2a88 7b ld a,e +2a89 cb3f srl a +2a8b 10f4 djnz 2a81h +2a8d d1 pop de +2a8e c9 ret +2a8f 23 inc hl +2a90 cd961d call 1d96h +2a93 e5 push hl +2a94 d5 push de +2a95 3e07 ld a,07h +2a97 dd214b37 ld ix,374bh ; IX = {MKTMST - Make temporary string} +2a9b cd9a1d call 1d9ah +2a9e 2af4fd ld hl,(0fdf4h) +2aa1 3e4f ld a,4fh +2aa3 77 ld (hl),a +2aa4 110600 ld de,0006h +2aa7 19 add hl,de +2aa8 d1 pop de +2aa9 cdb90a call 0ab9h +2aac 21f3fd ld hl,0fdf3h ; TMPSTR: 3 bytes used to hold length and addr of a string when moved to string area +2aaf 3e03 ld a,03h +2ab1 32cffd ld (0fdcfh),a ; Type flag for FPREG: 2 - Integer, 3 - String, 4 - Single, 5 - Double +2ab4 2241fe ld (0fe41h),hl ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +2ab7 e1 pop hl +2ab8 c9 ret + +2ab9 eb ex de,hl +2aba 0606 ld b,06h +2abc 3e07 ld a,07h +2abe a5 and l +2abf c630 add a,30h +2ac1 12 ld (de),a +2ac2 cb3c srl h +2ac4 cb1d rr l +2ac6 cb3c srl h +2ac8 cb1d rr l +2aca cb3c srl h +2acc cb1d rr l +2ace 1b dec de +2acf 10eb djnz 2abch +2ad1 c9 ret +2ad2 23 inc hl +2ad3 cdc51c call 1cc5h +2ad6 cd580e call 0e58h +2ad9 e5 push hl + +2ada cdc813 call 13c8h +2add 5f ld e,a +2ade 3a8afb ld a,(0fb8ah) +2ae1 cb4f bit 1,a +2ae3 78 ld a,b +2ae4 2001 jr nz,2ae7h +2ae6 7b ld a,e +2ae7 a0 and b +2ae8 f5 push af +2ae9 3a8bfb ld a,(0fb8bh) ; Current system status +2aec d370 out (70h),a ; Set system status +2aee f1 pop af +2aef 2802 jr z,2af3h +2af1 3eff ld a,0ffh +2af3 2141fe ld hl,0fe41h ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +2af6 77 ld (hl),a +2af7 23 inc hl +2af8 77 ld (hl),a +2af9 3e02 ld a,02h +2afb 32cffd ld (0fdcfh),a ; Type flag for FPREG: 2 - Integer, 3 - String, 4 - Single, 5 - Double +2afe e1 pop hl +2aff c9 ret + +2b00 2b dec hl +2b01 cdc51c call 1cc5h +2b04 cd5d0b call 0b5dh +2b07 23 inc hl +2b08 feaa cp 0aah +2b0a ca740b jp z,0b74h +2b0d fe43 cp 43h +2b0f caad0b jp z,0badh +2b12 fe53 cp 53h +2b14 cad30b jp z,0bd3h +2b17 fe4f cp 4fh +2b19 ca7a15 jp z,157ah ; SUBPHL - SUBTRACT number at HL from BCDE +2b1c fe58 cp 58h +2b1e ca0b0e jp z,0e0bh +2b21 fe84 cp 84h +2b23 ca6a14 jp z,146ah +2b26 fe90 cp 90h +2b28 ca0c16 jp z,160ch +2b2b fe83 cp 83h +2b2d ca240e jp z,0e24h +2b30 fe82 cp 82h +2b32 ca430e jp z,0e43h +2b35 fe50 cp 50h +2b37 caca17 jp z,17cah +2b3a fecb cp 0cbh +2b3c cacb18 jp z,18cbh +2b3f feb2 cp 0b2h ; TK_PRINT +2b41 ca470c jp z,0c47h +2b44 fea1 cp 0a1h +2b46 ca3b16 jp z,163bh +2b49 c3f61c jp 1cf6h +2b4c 7c ld a,h +2b4d 92 sub d +2b4e c0 ret nz +2b4f 7d ld a,l +2b50 93 sub e +2b51 c9 ret +2b52 7e ld a,(hl) +2b53 e3 ex (sp),hl +2b54 be cp (hl) +2b55 23 inc hl +2b56 e3 ex (sp),hl +2b57 ca5d0b jp z,0b5dh +2b5a c3f61c jp 1cf6h +2b5d 23 inc hl +2b5e 7e ld a,(hl) +2b5f fe3a cp 3ah +2b61 d0 ret nc +2b62 fe20 cp 20h +2b64 28f7 jr z,2b5dh +2b66 fe0b cp 0bh +2b68 3004 jr nc,2b6eh +2b6a fe09 cp 09h +2b6c 30ef jr nc,2b5dh +2b6e fe30 cp 30h +2b70 3f ccf +2b71 3c inc a +2b72 3d dec a +2b73 c9 ret + +2b74 e5 push hl +2b75 cd0f1d call 1d0fh +2b78 210140 ld hl,4001h +2b7b e5 push hl +2b7c 112001 ld de,0120h +2b7f 0e28 ld c,28h +2b81 3a8afb ld a,(0fb8ah) +2b84 cb47 bit 0,a +2b86 2002 jr nz,2b8ah +2b88 0e50 ld c,50h +2b8a 41 ld b,c +2b8b db50 in a,(50h) ; get system status +2b8d e610 and 10h +2b8f 28fa jr z,2b8bh ; wait for CSYNC - Composite video sync.signal +2b91 7e ld a,(hl) +2b92 2b dec hl +2b93 77 ld (hl),a +2b94 23 inc hl +2b95 19 add hl,de +2b96 10f3 djnz 2b8bh +2b98 e1 pop hl +2b99 23 inc hl +2b9a e5 push hl +2b9b 112041 ld de,4120h +2b9e cd4c0b call 0b4ch +2ba1 112001 ld de,0120h +2ba4 41 ld b,c +2ba5 38e4 jr c,2b8bh +2ba7 cd1b1d call 1d1bh +2baa e1 pop hl +2bab e1 pop hl +2bac c9 ret + +2bad cd520b call 0b52h +2bb0 4f ld c,a +2bb1 cd520b call 0b52h +2bb4 50 ld d,b +2bb5 cd520b call 0b52h +2bb8 59 ld e,c +2bb9 e5 push hl +2bba cd4c14 call 144ch +2bbd cd0f1d call 1d0fh +2bc0 210040 ld hl,4000h +2bc3 11006d ld de,6d00h +2bc6 01002d ld bc,2d00h +2bc9 edb0 ldir +2bcb cd1b1d call 1d1bh +2bce cd5414 call 1454h +2bd1 e1 pop hl +2bd2 c9 ret + +2bd3 cdd905 call 05d9h +2bd6 e5 push hl +2bd7 cd4c14 call 144ch +2bda cd0f1d call 1d0fh +2bdd 01002d ld bc,2d00h +2be0 210040 ld hl,4000h +2be3 11006d ld de,6d00h +2be6 7e ld a,(hl) +2be7 f5 push af +2be8 1a ld a,(de) +2be9 77 ld (hl),a +2bea f1 pop af +2beb 12 ld (de),a +2bec 23 inc hl +2bed 13 inc de +2bee 0b dec bc +2bef 78 ld a,b +2bf0 b1 or c +2bf1 20f3 jr nz,2be6h +2bf3 cd1b1d call 1d1bh +2bf6 cd5414 call 1454h +2bf9 e1 pop hl +2bfa c9 ret + +2bfb 2b dec hl +2bfc cd5d0b call 0b5dh +2bff fe23 cp 23h +2c01 c2f61c jp nz,1cf6h +2c04 cd5d0b call 0b5dh +2c07 fe28 cp 28h +2c09 cd361d call 1d36h +2c0c e5 push hl +2c0d cd6c1d call 1d6ch +2c10 7c ld a,h +2c11 a7 and a +2c12 c2001d jp nz,1d00h +2c15 7d ld a,l +2c16 a7 and a +2c17 2822 jr z,2c3bh +2c19 fe01 cp 01h +2c1b ca2f0c jp z,0c2fh +2c1e fe02 cp 02h +2c20 c2001d jp nz,1d00h +2c23 3a8afb ld a,(0fb8ah) +2c26 cbe7 set 4,a +2c28 cbaf res 5,a +2c2a 328afb ld (0fb8ah),a +2c2d 1816 jr 2c45h +2c2f 3a8afb ld a,(0fb8ah) +2c32 cbe7 set 4,a +2c34 cbef set 5,a +2c36 328afb ld (0fb8ah),a +2c39 180a jr 2c45h +2c3b 3a8afb ld a,(0fb8ah) +2c3e cba7 res 4,a +2c40 cbef set 5,a +2c42 328afb ld (0fb8ah),a +2c45 e1 pop hl +2c46 c9 ret + +2c47 e5 push hl +2c48 af xor a +2c49 328cfb ld (0fb8ch),a +2c4c 3e0d ld a,0dh +2c4e cd6c0d call 0d6ch +2c51 3e0a ld a,0ah +2c53 cd6c0d call 0d6ch +2c56 210000 ld hl,0000h +2c59 22adfb ld (0fbadh),hl +2c5c 22affb ld (0fbafh),hl +2c5f 22abfb ld (0fbabh),hl +; _CHRGTB - Pick next char from program +2c62 cdf70c call 0cf7h +2c65 22affb ld (0fbafh),hl +2c68 cd580d call 0d58h +2c6b 2805 jr z,2c72h +2c6d 06c0 ld b,0c0h +2c6f cd640d call 0d64h +2c72 cd500d call 0d50h +2c75 cd580d call 0d58h +2c78 2805 jr z,2c7fh +2c7a 0630 ld b,30h +2c7c cd640d call 0d64h +2c7f cd500d call 0d50h +2c82 cd580d call 0d58h +2c85 2805 jr z,2c8ch +2c87 060c ld b,0ch +2c89 cd640d call 0d64h +2c8c cd500d call 0d50h +2c8f cd580d call 0d58h +2c92 2805 jr z,2c99h +2c94 0603 ld b,03h +2c96 cd640d call 0d64h +2c99 3a8cfb ld a,(0fb8ch) +2c9c cd6c0d call 0d6ch +2c9f 3a8afb ld a,(0fb8ah) +2ca2 cb47 bit 0,a +2ca4 2806 jr z,2cach +2ca6 3a8cfb ld a,(0fb8ch) + +2ca9 cd6c0d call 0d6ch +2cac af xor a +2cad 328cfb ld (0fb8ch),a +2cb0 2a85fb ld hl,(0fb85h) ; Max X resolution +2cb3 2b dec hl +2cb4 ed5badfb ld de,(0fbadh) +2cb8 ed52 sbc hl,de +2cba 7c ld a,h +2cbb b5 or l +2cbc 280d jr z,2ccbh +2cbe 2aadfb ld hl,(0fbadh) +2cc1 23 inc hl +2cc2 22adfb ld (0fbadh),hl +2cc5 2aabfb ld hl,(0fbabh) +2cc8 c3650c jp 0c65h +2ccb 3e0a ld a,0ah +2ccd cd6c0d call 0d6ch +2cd0 cd500d call 0d50h +2cd3 22abfb ld (0fbabh),hl +2cd6 112001 ld de,0120h +2cd9 cd4c0b call 0b4ch +2cdc d2eb0c jp nc,0cebh +2cdf 210000 ld hl,0000h +2ce2 22adfb ld (0fbadh),hl +2ce5 2aabfb ld hl,(0fbabh) +2ce8 c3620c jp 0c62h + +2ceb 3e1b ld a,1bh +2ced cd6c0d call 0d6ch +2cf0 3e40 ld a,40h +2cf2 cd6c0d call 0d6ch +2cf5 e1 pop hl +2cf6 c9 ret + +2cf7 3e1b ld a,1bh +2cf9 cd6c0d call 0d6ch +2cfc 3e33 ld a,33h +2cfe cd6c0d call 0d6ch +2d01 3a8afb ld a,(0fb8ah) +2d04 cb67 bit 4,a +2d06 201a jr nz,2d22h +2d08 3e14 ld a,14h +2d0a cd6c0d call 0d6ch +2d0d 3e1b ld a,1bh +2d0f cd6c0d call 0d6ch +2d12 3e4b ld a,4bh +2d14 cd6c0d call 0d6ch +2d17 3e80 ld a,80h +2d19 cd6c0d call 0d6ch +2d1c 3e02 ld a,02h +2d1e cd6c0d call 0d6ch +2d21 c9 ret + +2d22 3a8afb ld a,(0fb8ah) +2d25 cb6f bit 5,a + +2d27 2816 jr z,2d3fh +2d29 3e16 ld a,16h +2d2b cd6c0d call 0d6ch +2d2e 3e1b ld a,1bh +2d30 cd6c0d call 0d6ch +2d33 3e2a ld a,2ah +; Error: Illegal function call (FC ERROR) +2d35 cd6c0d call 0d6ch +2d38 3e04 ld a,04h + +; LNUM_PARM - Get specified line number +2d3a cd6c0d call 0d6ch +2d3d 18d8 jr 2d17h +2d3f 3e14 ld a,14h +2d41 cd6c0d call 0d6ch +2d44 3e1b ld a,1bh +2d46 cd6c0d call 0d6ch +2d49 3e4c ld a,4ch +2d4b cd6c0d call 0d6ch +2d4e 18c7 jr 2d17h +2d50 2aaffb ld hl,(0fbafh) +2d53 23 inc hl +2d54 22affb ld (0fbafh),hl +2d57 c9 ret + +2d58 cdc813 call 13c8h +2d5b a0 and b +2d5c f5 push af +2d5d 3a8bfb ld a,(0fb8bh) ; Current system status +2d60 d370 out (70h),a ; Set system status +2d62 f1 pop af +2d63 c9 ret +2d64 3a8cfb ld a,(0fb8ch) +2d67 b0 or b +2d68 328cfb ld (0fb8ch),a +2d6b c9 ret + +2d6c dd212d0c ld ix,0c2dh ; IX = {List routine} +2d70 cd9a1d call 1d9ah +2d73 c9 ret + +2d74 2b dec hl +2d75 cdc51c call 1cc5h +2d78 cd5d0b call 0b5dh +2d7b cd520b call 0b52h +2d7e 28cd jr z,2d4dh +2d80 96 sub (hl) +2d81 1d dec e +2d82 ed535dfb ld (0fb5dh),de +2d86 cd520b call 0b52h +2d89 2c inc l +2d8a cd961d call 1d96h +2d8d ed5363fb ld (0fb63h),de +2d91 cd520b call 0b52h +2d94 29 add hl,hl +2d95 cd520b call 0b52h +2d98 2c inc l +2d99 cd961d call 1d96h +2d9c ed5365fb ld (0fb65h),de ; number of text columns +2da0 af xor a +2da1 3261fb ld (0fb61h),a +2da4 3a8afb ld a,(0fb8ah) +2da7 cb47 bit 0,a +2da9 2005 jr nz,2db0h +2dab 3e01 ld a,01h +2dad 3261fb ld (0fb61h),a +2db0 7e ld a,(hl) +2db1 fe2c cp ',' +2db3 280c jr z,2dc1h +2db5 af xor a +2db6 3289fb ld (0fb89h),a +2db9 3eff ld a,0ffh +2dbb 325ffb ld (0fb5fh),a +2dbe c3050e jp 0e05h + +2dc1 23 inc hl +2dc2 cd961d call 1d96h +2dc5 7b ld a,e +2dc6 3289fb ld (0fb89h),a +2dc9 fe03 cp 03h +2dcb d2001d jp nc,1d00h +2dce 3a8afb ld a,(0fb8ah) +2dd1 cb47 bit 0,a +2dd3 2006 jr nz,2ddbh +2dd5 7b ld a,e +2dd6 fe02 cp 02h +2dd8 ca001d jp z,1d00h +2ddb 7e ld a,(hl) +2ddc fe2c cp ',' +2dde 3eff ld a,0ffh +2de0 325ffb ld (0fb5fh),a +2de3 2020 jr nz,2e05h +2de5 23 inc hl +2de6 cd961d call 1d96h +2de9 da001d jp c,1d00h +2dec 7b ld a,e +2ded 325ffb ld (0fb5fh),a + +; __DATA - DATA statement: find next DATA program line.. +2df0 7e ld a,(hl) +2df1 fe2c cp ',' +2df3 2010 jr nz,2e05h +2df5 23 inc hl +2df6 cd961d call 1d96h +2df9 da001d jp c,1d00h +2dfc 7b ld a,e +2dfd fe09 cp 09h +2dff d2001d jp nc,1d00h +2e02 3261fb ld (0fb61h),a +2e05 e5 push hl +2e06 cd8710 call 1087h +2e09 e1 pop hl +2e0a c9 ret + +2e0b 7e ld a,(hl) +2e0c fe83 cp 83h ; TK_SET - token for 'SET' +2e0e c2f61c jp nz,1cf6h +2e11 23 inc hl +2e12 cd580e call 0e58h +2e15 e5 push hl +2e16 cdc813 call 13c8h +2e19 a8 xor b +2e1a 47 ld b,a +2e1b 3a8afb ld a,(0fb8ah) +2e1e cb4f bit 1,a +2e20 201f jr nz,2e41h +2e22 1810 jr 2e34h +2e24 cd580e call 0e58h +2e27 e5 push hl +2e28 cdc813 call 13c8h +2e2b b0 or b +2e2c 47 ld b,a +2e2d 3a8afb ld a,(0fb8ah) +2e30 cb4f bit 1,a +2e32 200d jr nz,2e41h +2e34 db50 in a,(50h) ; get system status +2e36 e610 and 10h +2e38 28fa jr z,2e34h ; wait for CSYNC - Composite video sync.signal +2e3a 78 ld a,b +2e3b 77 ld (hl),a +2e3c 3a8bfb ld a,(0fb8bh) ; Current system status +2e3f d370 out (70h),a ; Set system status +2e41 e1 pop hl +2e42 c9 ret +2e43 cd580e call 0e58h +2e46 e5 push hl +2e47 cdc813 call 13c8h +2e4a 57 ld d,a +2e4b 3a8afb ld a,(0fb8ah) +2e4e cb4f bit 1,a +2e50 20ef jr nz,2e41h +2e52 78 ld a,b +2e53 2f cpl +2e54 a2 and d +2e55 47 ld b,a +2e56 18dc jr 2e34h + +2e58 2b dec hl +2e59 cd5d0b call 0b5dh +2e5c cd520b call 0b52h +2e5f 28cd jr z,2e2eh +2e61 96 sub (hl) +2e62 1d dec e +2e63 ed53adfb ld (0fbadh),de +2e67 cd520b call 0b52h +2e6a 2c inc l +2e6b cd961d call 1d96h +2e6e ed53affb ld (0fbafh),de +2e72 cd520b call 0b52h +2e75 29 add hl,hl +2e76 c9 ret + +2e77 2b dec hl +2e78 cdc51c call 1cc5h +2e7b cd5d0b call 0b5dh +2e7e fe89 cp 89h ; TK_INPUT +2e80 c2ed0e jp nz,0eedh ; -> jp 0000h +2e83 cd5d0b call 0b5dh +2e86 dd211c37 ld ix,371ch +2e8a cd9a1d call 1d9ah +2e8d 7e ld a,(hl) +2e8e fe22 cp 22h +2e90 2024 jr nz,2eb6h +2e92 dd215a37 ld ix,375ah ; IX ={QTSTR - Create quote terminated String} +2e96 cd9a1d call 1d9ah +2e99 dd21c030 ld ix,30c0h +2e9d cd9a1d call 1d9ah +2ea0 7e ld a,(hl) +2ea1 23 inc hl +2ea2 fe2c cp ',' +2ea4 2810 jr z,2eb6h +2ea6 fe3b cp 3bh +2ea8 c2f61c jp nz,1cf6h +2eab e5 push hl +2eac 3e3f ld a,3fh +2eae dd21a00b ld ix,0ba0h ; IX = {OUTC (alias OUTDO): print character} +2eb2 cd9a1d call 1d9ah +2eb5 e1 pop hl +2eb6 e5 push hl +2eb7 dd21fa08 ld ix,08fah ; IX = {Console line input routine} +2ebb cd9a1d call 1d9ah +2ebe c1 pop bc +2ebf dd21a92c ld ix,2ca9h +2ec3 da9a1d jp c,1d9ah +2ec6 c5 push bc +2ec7 e3 ex (sp),hl +2ec8 dd210135 ld ix,3501h ; GETVAR: Find address of variable +2ecc cd9a1d call 1d9ah +2ecf dd215e19 ld ix,195eh ; IX = {TSTSTR - Test a string, 'Type Error' if it is not} +2ed3 cd9a1d call 1d9ah +2ed6 eb ex de,hl +2ed7 e3 ex (sp),hl +2ed8 d5 push de +2ed9 0600 ld b,00h +2edb dd215c37 ld ix,375ch ; IX = {QTSTR_0} +2edf cd9a1d call 1d9ah +2ee2 e1 pop hl +2ee3 af xor a +2ee4 dd211d2e ld ix,2e1dh +2ee8 dde5 push ix +2eea c38a3f jp 3f8ah ; BANK SWITCHING - flip ROM page + +2eed 2b dec hl +2eee cd5d0b call 0b5dh +2ef1 7e ld a,(hl) +2ef2 fece cp 0ceh +2ef4 2013 jr nz,2f09h +2ef6 23 inc hl +2ef7 ed5b7dfb ld de,(0fb7dh) +2efb ed5375fb ld (0fb75h),de +2eff ed5b7ffb ld de,(0fb7fh) +2f03 ed5377fb ld (0fb77h),de +2f07 181e jr 2f27h +2f09 cd520b call 0b52h +2f0c 28cd jr z,2edbh +2f0e 96 sub (hl) +2f0f 1d dec e +2f10 ed5375fb ld (0fb75h),de +2f14 cd520b call 0b52h +2f17 2c inc l +2f18 cd961d call 1d96h +2f1b ed5377fb ld (0fb77h),de +2f1f cd520b call 0b52h +2f22 29 add hl,hl +2f23 cd520b call 0b52h +2f26 ce2b adc a,2bh +2f28 cd5d0b call 0b5dh +2f2b cd520b call 0b52h +2f2e 28cd jr z,2efdh +2f30 96 sub (hl) +2f31 1d dec e +2f32 ed5379fb ld (0fb79h),de +2f36 ed537dfb ld (0fb7dh),de +2f3a cd520b call 0b52h +2f3d 2c inc l +2f3e cd961d call 1d96h +2f41 ed537bfb ld (0fb7bh),de +2f45 ed537ffb ld (0fb7fh),de +2f49 cd520b call 0b52h +2f4c 29 add hl,hl +2f4d 7e ld a,(hl) +2f4e fe2c cp ',' +2f50 2806 jr z,2f58h +2f52 af xor a +2f53 3289fb ld (0fb89h),a +2f56 1821 jr 2f79h +2f58 23 inc hl +2f59 cd961d call 1d96h +2f5c 7b ld a,e +2f5d fe03 cp 03h +2f5f d2001d jp nc,1d00h +2f62 3289fb ld (0fb89h),a +2f65 7e ld a,(hl) +2f66 fe2c cp ',' +2f68 200f jr nz,2f79h +2f6a cd5d0b call 0b5dh +2f6d 7e ld a,(hl) +2f6e fe42 cp 42h +2f70 c2f61c jp nz,1cf6h +2f73 cd5d0b call 0b5dh +2f76 c3920f jp 0f92h +2f79 e5 push hl +2f7a cd9312 call 1293h +2f7d e1 pop hl +2f7e 110000 ld de,0000h +2f81 ed5375fb ld (0fb75h),de +2f85 ed5377fb ld (0fb77h),de +2f89 ed5379fb ld (0fb79h),de +2f8d ed537bfb ld (0fb7bh),de +2f91 c9 ret + +2f92 7e ld a,(hl) +2f93 fe46 cp 46h +2f95 ca1d10 jp z,101dh +2f98 2b dec hl +2f99 cd5d0b call 0b5dh +2f9c caa20f jp z,0fa2h +2f9f c3f61c jp 1cf6h +2fa2 ed5b75fb ld de,(0fb75h) +2fa6 d5 push de +2fa7 ed5b77fb ld de,(0fb77h) +2fab d5 push de +2fac ed5b79fb ld de,(0fb79h) +2fb0 d5 push de +2fb1 ed5b7bfb ld de,(0fb7bh) +2fb5 d5 push de +2fb6 e5 push hl +2fb7 fde1 pop iy +2fb9 dde1 pop ix +2fbb c1 pop bc +2fbc d1 pop de +2fbd e1 pop hl +2fbe fde5 push iy +2fc0 2275fb ld (0fb75h),hl +2fc3 ed4379fb ld (0fb79h),bc +2fc7 ed5377fb ld (0fb77h),de +2fcb ed537bfb ld (0fb7bh),de +2fcf cd7d10 call 107dh +2fd2 ed4379fb ld (0fb79h),bc +2fd6 ed5377fb ld (0fb77h),de +2fda ed4375fb ld (0fb75h),bc +2fde dd227bfb ld (0fb7bh),ix +2fe2 cd7310 call 1073h +2fe5 ed4375fb ld (0fb75h),bc +2fe9 dd227bfb ld (0fb7bh),ix +2fed 2279fb ld (0fb79h),hl +2ff0 dd2277fb ld (0fb77h),ix +2ff4 cd7d10 call 107dh +2ff7 2279fb ld (0fb79h),hl +2ffa dd2277fb ld (0fb77h),ix +2ffe ed537bfb ld (0fb7bh),de +3002 2275fb ld (0fb75h),hl +3005 cd7310 call 1073h +3008 e1 pop hl +3009 110000 ld de,0000h +300c ed5375fb ld (0fb75h),de +3010 ed5377fb ld (0fb77h),de +3014 ed5379fb ld (0fb79h),de +3018 ed537bfb ld (0fb7bh),de +301c c9 ret +301d cd5d0b call 0b5dh +3020 e5 push hl +3021 2a75fb ld hl,(0fb75h) +3024 2281fb ld (0fb81h),hl +3027 2a77fb ld hl,(0fb77h) +302a ed5b7bfb ld de,(0fb7bh) +302e ed52 sbc hl,de +3030 2a77fb ld hl,(0fb77h) +3033 fa4610 jp m,1046h +3036 ed5377fb ld (0fb77h),de +303a 227bfb ld (0fb7bh),hl +303d 227ffb ld (0fb7fh),hl +3040 ed5383fb ld (0fb83h),de +3044 1803 jr 3049h +3046 2283fb ld (0fb83h),hl +3049 2a81fb ld hl,(0fb81h) +304c 2275fb ld (0fb75h),hl +304f 2a7dfb ld hl,(0fb7dh) +3052 2279fb ld (0fb79h),hl +3055 cd7d10 call 107dh +3058 2a83fb ld hl,(0fb83h) +305b ed5b7ffb ld de,(0fb7fh) +305f e5 push hl +3060 ed52 sbc hl,de +3062 e1 pop hl +3063 280c jr z,3071h +3065 23 inc hl +3066 2283fb ld (0fb83h),hl +3069 2277fb ld (0fb77h),hl +306c 227bfb ld (0fb7bh),hl +306f 18d8 jr 3049h +3071 e1 pop hl +3072 c9 ret + +3073 e5 push hl +3074 d5 push de +3075 c5 push bc +3076 cddb16 call 16dbh +3079 c1 pop bc +307a d1 pop de +307b e1 pop hl +307c c9 ret + +307d e5 push hl +307e d5 push de +307f c5 push bc +3080 cd0117 call 1701h ; DIV10 - Divide FP by 10 +3083 c1 pop bc +3084 d1 pop de +3085 e1 pop hl +3086 c9 ret + +3087 3a8afb ld a,(0fb8ah) +308a cbdf set 3,a +308c 328afb ld (0fb8ah),a +308f 3a61fb ld a,(0fb61h) +3092 a7 and a +3093 280a jr z,309fh +3095 47 ld b,a +3096 2a63fb ld hl,(0fb63h) +3099 29 add hl,hl +309a 10fd djnz 3099h +309c 2263fb ld (0fb63h),hl +309f 210000 ld hl,0000h +30a2 2275fb ld (0fb75h),hl +30a5 2a65fb ld hl,(0fb65h) ; number of text columns +30a8 cb7c bit 7,h +30aa c0 ret nz +30ab 2277fb ld (0fb77h),hl +30ae eb ex de,hl +30af 210100 ld hl,0001h +30b2 ed52 sbc hl,de +30b4 29 add hl,hl +30b5 2267fb ld (0fb67h),hl +30b8 cd5511 call 1155h +30bb 2a77fb ld hl,(0fb77h) +30be ed5b75fb ld de,(0fb75h) +30c2 13 inc de +30c3 2b dec hl +30c4 cd4c0b call 0b4ch +30c7 d8 ret c +30c8 1b dec de +30c9 cb7c bit 7,h +30cb c0 ret nz +30cc 2a67fb ld hl,(0fb67h) +30cf cb7c bit 7,h +30d1 2006 jr nz,30d9h +30d3 7c ld a,h +30d4 b5 or l +30d5 2014 jr nz,30ebh +30d7 183b jr 3114h +30d9 2a77fb ld hl,(0fb77h) +30dc 29 add hl,hl +30dd eb ex de,hl +30de 2a67fb ld hl,(0fb67h) +30e1 29 add hl,hl +30e2 19 add hl,de +30e3 2b dec hl +30e4 2b dec hl +30e5 cb7c bit 7,h +30e7 2017 jr nz,3100h +30e9 1829 jr 3114h +30eb 2a75fb ld hl,(0fb75h) +30ee 29 add hl,hl +30ef eb ex de,hl +30f0 2a67fb ld hl,(0fb67h) +30f3 29 add hl,hl +30f4 ed52 sbc hl,de +30f6 2b dec hl +30f7 2b dec hl +30f8 cb7c bit 7,h +30fa c21411 jp nz,1114h +30fd c33711 jp 1137h +3100 2a75fb ld hl,(0fb75h) +3103 23 inc hl +3104 2275fb ld (0fb75h),hl +3107 29 add hl,hl +3108 23 inc hl +3109 ed5b67fb ld de,(0fb67h) +310d 19 add hl,de +310e 2267fb ld (0fb67h),hl +3111 c3b810 jp 10b8h +3114 2a75fb ld hl,(0fb75h) +3117 23 inc hl +3118 2275fb ld (0fb75h),hl +311b 29 add hl,hl +311c ed5b77fb ld de,(0fb77h) +3120 1b dec de +3121 ed5377fb ld (0fb77h),de +3125 eb ex de,hl +3126 29 add hl,hl +3127 eb ex de,hl +3128 ed52 sbc hl,de +312a 23 inc hl +312b 23 inc hl +312c ed5b67fb ld de,(0fb67h) +3130 19 add hl,de +3131 2267fb ld (0fb67h),hl +3134 c3b810 jp 10b8h +3137 2a77fb ld hl,(0fb77h) +313a 2b dec hl +313b 2277fb ld (0fb77h),hl +313e 29 add hl,hl +313f ed5b67fb ld de,(0fb67h) +3143 eb ex de,hl +3144 ed52 sbc hl,de +3146 23 inc hl +3147 2267fb ld (0fb67h),hl +314a c3b810 jp 10b8h +314d 7a ld a,d +314e 2f cpl +314f 57 ld d,a +3150 7b ld a,e +3151 2f cpl +3152 5f ld e,a +3153 13 inc de +3154 c9 ret +3155 ed5b75fb ld de,(0fb75h) +3159 cd4d11 call 114dh +315c ed5369fb ld (0fb69h),de +3160 ed5b77fb ld de,(0fb77h) +3164 cd4d11 call 114dh +3167 ed536bfb ld (0fb6bh),de +316b 2a75fb ld hl,(0fb75h) +316e ed5b5dfb ld de,(0fb5dh) +3172 19 add hl,de +3173 22adfb ld (0fbadh),hl +3176 2a77fb ld hl,(0fb77h) +3179 ed4b63fb ld bc,(0fb63h) +317d 3a5ffb ld a,(0fb5fh) +3180 cb4f bit 1,a +3182 2803 jr z,3187h +3184 cd4412 call 1244h +3187 2a6bfb ld hl,(0fb6bh) +318a ed4b63fb ld bc,(0fb63h) +318e 3a5ffb ld a,(0fb5fh) +3191 cb77 bit 6,a +3193 280a jr z,319fh +3195 3a8afb ld a,(0fb8ah) +3198 cb5f bit 3,a +319a 2003 jr nz,319fh +319c cd4412 call 1244h +319f 2a69fb ld hl,(0fb69h) +31a2 ed5b5dfb ld de,(0fb5dh) +31a6 19 add hl,de +31a7 22adfb ld (0fbadh),hl +31aa 2a77fb ld hl,(0fb77h) +31ad ed4b63fb ld bc,(0fb63h) +31b1 3a5ffb ld a,(0fb5fh) +31b4 cb57 bit 2,a +31b6 280a jr z,31c2h +31b8 3a8afb ld a,(0fb8ah) +31bb cb5f bit 3,a +31bd 2003 jr nz,31c2h +31bf cd4412 call 1244h +31c2 2a6bfb ld hl,(0fb6bh) +31c5 ed4b63fb ld bc,(0fb63h) +31c9 3a5ffb ld a,(0fb5fh) +31cc cb6f bit 5,a +31ce 2803 jr z,31d3h +31d0 cd4412 call 1244h +31d3 2a77fb ld hl,(0fb77h) +31d6 ed4b63fb ld bc,(0fb63h) +31da ed5b5dfb ld de,(0fb5dh) +31de 19 add hl,de +31df 22adfb ld (0fbadh),hl +31e2 2a75fb ld hl,(0fb75h) +31e5 3a5ffb ld a,(0fb5fh) +31e8 cb47 bit 0,a +31ea 2803 jr z,31efh +31ec cd4412 call 1244h +31ef 2a69fb ld hl,(0fb69h) +31f2 ed4b63fb ld bc,(0fb63h) +31f6 3a5ffb ld a,(0fb5fh) +31f9 cb7f bit 7,a +31fb 280a jr z,3207h +31fd 3a8afb ld a,(0fb8ah) +3200 cb5f bit 3,a +3202 2003 jr nz,3207h +3204 cd4412 call 1244h +3207 2a6bfb ld hl,(0fb6bh) +320a ed5b5dfb ld de,(0fb5dh) +320e 19 add hl,de +320f 22adfb ld (0fbadh),hl +3212 2a69fb ld hl,(0fb69h) +3215 ed4b63fb ld bc,(0fb63h) +3219 3a5ffb ld a,(0fb5fh) +321c cb67 bit 4,a +321e 2803 jr z,3223h +3220 cd4412 call 1244h +3223 2a75fb ld hl,(0fb75h) +3226 ed4b63fb ld bc,(0fb63h) +322a 3a5ffb ld a,(0fb5fh) +322d cb5f bit 3,a +322f 280a jr z,323bh +3231 3a8afb ld a,(0fb8ah) +3234 cb5f bit 3,a +3236 2003 jr nz,323bh +3238 cd4412 call 1244h +323b 3a8afb ld a,(0fb8ah) +323e cb9f res 3,a +3240 328afb ld (0fb8ah),a +3243 c9 ret + +3244 09 add hl,bc +3245 3a61fb ld a,(0fb61h) +3248 a7 and a +3249 2807 jr z,3252h +324b 47 ld b,a +324c cb3c srl h +324e cb1d rr l +3250 10fa djnz 324ch +3252 22affb ld (0fbafh),hl +3255 cd5912 call 1259h +3258 c9 ret + +3259 c5 push bc +325a d5 push de +325b cdc813 call 13c8h +325e f5 push af +325f 3a8afb ld a,(0fb8ah) +3262 cb4f bit 1,a +3264 2803 jr z,3269h +3266 f1 pop af +3267 1827 jr 3290h +3269 3a89fb ld a,(0fb89h) +326c fe00 cp 00h +326e 2810 jr z,3280h +3270 fe01 cp 01h +3272 2804 jr z,3278h +3274 f1 pop af +3275 a8 xor b +3276 180a jr 3282h +3278 f1 pop af +3279 57 ld d,a +327a 78 ld a,b +327b 2f cpl +327c a2 and d +327d 47 ld b,a +327e 1802 jr 3282h +3280 f1 pop af +3281 b0 or b +3282 47 ld b,a +3283 db50 in a,(50h) ; get system status +3285 e610 and 10h +3287 28fa jr z,3283h ; wait for CSYNC - Composite video sync.signal +3289 78 ld a,b +328a 77 ld (hl),a +328b 3a8bfb ld a,(0fb8bh) ; Current system status +328e d370 out (70h),a ; Set system status +3290 d1 pop de +3291 c1 pop bc +3292 c9 ret + +3293 af xor a +3294 3263fb ld (0fb63h),a +3297 325ffb ld (0fb5fh),a +329a 3e01 ld a,01h +329c 2a79fb ld hl,(0fb79h) +329f ed5b75fb ld de,(0fb75h) +32a3 b7 or a +32a4 ed52 sbc hl,de +32a6 f2c712 jp p,12c7h +32a9 ed5b79fb ld de,(0fb79h) +32ad 2a75fb ld hl,(0fb75h) +32b0 ed5375fb ld (0fb75h),de +32b4 2279fb ld (0fb79h),hl +32b7 2a77fb ld hl,(0fb77h) +32ba ed5b7bfb ld de,(0fb7bh) +32be ed5377fb ld (0fb77h),de +32c2 227bfb ld (0fb7bh),hl +32c5 18d3 jr 329ah +32c7 2a79fb ld hl,(0fb79h) +32ca ed5b75fb ld de,(0fb75h) +32ce ed52 sbc hl,de +32d0 226ffb ld (0fb6fh),hl +32d3 2a7bfb ld hl,(0fb7bh) +32d6 ed5b77fb ld de,(0fb77h) +32da ed52 sbc hl,de +32dc 2271fb ld (0fb71h),hl +32df 210100 ld hl,0001h +32e2 2273fb ld (0fb73h),hl +32e5 f2fb12 jp p,12fbh +32e8 21ffff ld hl,0ffffh +32eb 2273fb ld (0fb73h),hl +32ee ed5b7bfb ld de,(0fb7bh) +32f2 2a77fb ld hl,(0fb77h) +32f5 ed52 sbc hl,de +32f7 23 inc hl +32f8 2271fb ld (0fb71h),hl +32fb 3a63fb ld a,(0fb63h) +32fe a7 and a +32ff 2033 jr nz,3334h +3301 3e01 ld a,01h +3303 2a6ffb ld hl,(0fb6fh) +3306 ed5b71fb ld de,(0fb71h) +330a b7 or a +330b ed52 sbc hl,de +330d f23413 jp p,1334h +3310 2a75fb ld hl,(0fb75h) +3313 ed5b77fb ld de,(0fb77h) +3317 2277fb ld (0fb77h),hl +331a ed5375fb ld (0fb75h),de +331e 2a79fb ld hl,(0fb79h) +3321 ed5b7bfb ld de,(0fb7bh) +3325 227bfb ld (0fb7bh),hl +3328 ed5379fb ld (0fb79h),de +332c 3eff ld a,0ffh +332e 3263fb ld (0fb63h),a +3331 c39a12 jp 129ah +3334 2a71fb ld hl,(0fb71h) +3337 29 add hl,hl +3338 2267fb ld (0fb67h),hl +333b ed5b6ffb ld de,(0fb6fh) +333f ed52 sbc hl,de +3341 2265fb ld (0fb65h),hl ; number of text columns +3344 ed52 sbc hl,de +3346 2269fb ld (0fb69h),hl +3349 2a73fb ld hl,(0fb73h) +334c cb7c bit 7,h +334e 280a jr z,335ah +3350 2a65fb ld hl,(0fb65h) ; number of text columns +3353 ed5b67fb ld de,(0fb67h) +3357 2265fb ld (0fb65h),hl ; number of text columns +335a 2a77fb ld hl,(0fb77h) +335d 226dfb ld (0fb6dh),hl +3360 2a75fb ld hl,(0fb75h) +3363 226bfb ld (0fb6bh),hl +3366 3a63fb ld a,(0fb63h) +3369 a7 and a +336a 2811 jr z,337dh +336c 2a6bfb ld hl,(0fb6bh) +336f 22affb ld (0fbafh),hl +3372 2a6dfb ld hl,(0fb6dh) +3375 22adfb ld (0fbadh),hl +3378 cd5912 call 1259h +337b 180f jr 338ch +337d 2a6dfb ld hl,(0fb6dh) +3380 22affb ld (0fbafh),hl +3383 2a6bfb ld hl,(0fb6bh) +3386 22adfb ld (0fbadh),hl +3389 cd5912 call 1259h +338c 2a75fb ld hl,(0fb75h) +338f ed5b79fb ld de,(0fb79h) +3393 b7 or a +3394 ed52 sbc hl,de +3396 7c ld a,h +3397 b5 or l +3398 282d jr z,33c7h +339a 2a75fb ld hl,(0fb75h) +339d 23 inc hl +339e 2275fb ld (0fb75h),hl +33a1 2a65fb ld hl,(0fb65h) ; number of text columns +33a4 cb7c bit 7,h +33a6 280a jr z,33b2h +33a8 ed5b67fb ld de,(0fb67h) +33ac 19 add hl,de +33ad 2265fb ld (0fb65h),hl ; number of text columns +33b0 18ae jr 3360h +33b2 ed5b69fb ld de,(0fb69h) +33b6 19 add hl,de +33b7 2265fb ld (0fb65h),hl ; number of text columns +33ba 2a6dfb ld hl,(0fb6dh) +33bd ed5b73fb ld de,(0fb73h) +33c1 19 add hl,de +33c2 226dfb ld (0fb6dh),hl +33c5 1899 jr 3360h +33c7 c9 ret + +33c8 3a8afb ld a,(0fb8ah) +33cb cb8f res 1,a +33cd 328afb ld (0fb8ah),a +33d0 2aadfb ld hl,(0fbadh) +33d3 ed5b85fb ld de,(0fb85h) ; Max X resolution +33d7 3efc ld a,0fch +33d9 a4 and h +33da 2019 jr nz,33f5h +33dc cd4c0b call 0b4ch +33df d2f513 jp nc,13f5h +33e2 2aaffb ld hl,(0fbafh) +33e5 3efe ld a,0feh +33e7 a4 and h +33e8 200b jr nz,33f5h +33ea 112001 ld de,0120h +33ed cd4c0b call 0b4ch +33f0 d2f513 jp nc,13f5h +33f3 180c jr 3401h + +33f5 3a8afb ld a,(0fb8ah) +33f8 cbcf set 1,a +33fa 328afb ld (0fb8ah),a +33fd 210000 ld hl,0000h +3400 c9 ret + +3401 2aadfb ld hl,(0fbadh) +3404 3e07 ld a,07h +3406 a5 and l +3407 114414 ld de,1444h +340a 83 add a,e +340b 3001 jr nc,340eh +340d 14 inc d +340e 5f ld e,a +340f 1a ld a,(de) +3410 47 ld b,a +3411 3ef8 ld a,0f8h +3413 a5 and l +3414 6f ld l,a +3415 29 add hl,hl +3416 29 add hl,hl +3417 e5 push hl +3418 29 add hl,hl +3419 29 add hl,hl +341a 29 add hl,hl +341b d1 pop de +341c 19 add hl,de +341d ed5baffb ld de,(0fbafh) +3421 19 add hl,de +3422 110040 ld de,4000h +3425 19 add hl,de +3426 11fe9f ld de,9ffeh +3429 cd4c0b call 0b4ch +342c d2f513 jp nc,13f5h +342f 110040 ld de,4000h +3432 cd4c0b call 0b4ch +3435 daf513 jp c,13f5h +3438 cd0f1d call 1d0fh +343b db50 in a,(50h) ; get system status +343d e610 and 10h +343f ca3b14 jp z,143bh ; wait for CSYNC - Composite video sync.signal +3442 7e ld a,(hl) +3443 c9 ret + +3444 80 add a,b +3445 40 ld b,b +3446 2010 jr nz,3458h +3448 08 ex af,af' +3449 04 inc b +344a 02 ld (bc),a +344b 013e01 ld bc,013eh +344e d330 out (30h),a ; CRTC register select +3450 af xor a +3451 d331 out (31h),a +3453 c9 ret + +3454 3e01 ld a,01h +3456 d330 out (30h),a ; CRTC register select +3458 db50 in a,(50h) ; get system status +345a e604 and 04h +345c 2006 jr nz,3464h +345e 3a67fc ld a,(0fc67h) ; No. of characters displayed in a horiz scan +3461 d331 out (31h),a +3463 c9 ret + +3464 3a77fc ld a,(0fc77h) +3467 d331 out (31h),a +3469 c9 ret + +346a 7e ld a,(hl) +346b fe4c cp 4ch +346d 2004 jr nz,3473h +346f 23 inc hl +3470 c3f914 jp 14f9h +3473 e5 push hl +3474 cd4315 call 1543h +3477 dd215500 ld ix,0055h ; IX = {HI-RES Selection routine} +347b cd9a1d call 1d9ah +347e 3a8afb ld a,(0fb8ah) +3481 cb87 res 0,a +3483 328afb ld (0fb8ah),a +3486 118002 ld de,0280h ; 640 +3489 ed5385fb ld (0fb85h),de ; Max X resolution +348d cd4c14 call 144ch +3490 cd0f1d call 1d0fh + +3493 210040 ld hl,4000h +3496 110140 ld de,4001h +3499 af xor a +349a 77 ld (hl),a +349b 01fe5f ld bc,5ffeh +349e edb0 ldir + +34a0 210004 ld hl,0400h +34a3 2263fb ld (0fb63h),hl +34a6 111204 ld de,0412h +34a9 ed5367fb ld (0fb67h),de + +34ad dd210020 ld ix,2000h +34b1 fd210030 ld iy,3000h +34b5 3e50 ld a,50h ; 80 +34b7 3265fb ld (0fb65h),a ; number of text columns + +34ba 3a65fb ld a,(0fb65h) ; number of text columns +34bd 47 ld b,a +34be 2a63fb ld hl,(0fb63h) +34c1 111200 ld de,0012h ; 18 +34c4 7d ld a,l +34c5 dd7700 ld (ix+00h),a +34c8 7c ld a,h +34c9 fd7700 ld (iy+00h),a +34cc dd23 inc ix +34ce fd23 inc iy +34d0 19 add hl,de +34d1 10ee djnz 34c1h + +34d3 2a63fb ld hl,(0fb63h) +34d6 23 inc hl +34d7 2263fb ld (0fb63h),hl +34da ed5b67fb ld de,(0fb67h) +34de cd4c0b call 0b4ch +34e1 20d7 jr nz,34bah + +34e3 210028 ld hl,2800h +34e6 010008 ld bc,0800h +34e9 cbc6 set 0,(hl) ; enable PCGEN bit +34eb 23 inc hl +34ec 0b dec bc +34ed 78 ld a,b +34ee b1 or c +34ef 20f8 jr nz,34e9h +34f1 cd5414 call 1454h +34f4 cd1b1d call 1d1bh + +34f7 e1 pop hl +34f8 c9 ret + + +34f9 e5 push hl +34fa cd4b15 call 154bh +34fd dd215200 ld ix,0052h ; IX = {LO-RES Selection routine} +3501 cd9a1d call 1d9ah +3504 3a8afb ld a,(0fb8ah) +3507 cbc7 set 0,a +3509 328afb ld (0fb8ah),a +350c 114001 ld de,0140h +350f ed5385fb ld (0fb85h),de ; Max X resolution +3513 cd4c14 call 144ch +3516 cd0f1d call 1d0fh +3519 210040 ld hl,4000h +351c 110140 ld de,4001h +351f af xor a +3520 77 ld (hl),a +3521 01002d ld bc,2d00h +3524 edb0 ldir +3526 210004 ld hl,0400h +3529 2263fb ld (0fb63h),hl +352c 111204 ld de,0412h +352f ed5367fb ld (0fb67h),de +3533 dd210020 ld ix,2000h +3537 fd210030 ld iy,3000h +353b 3e28 ld a,28h ; 40 +353d 3265fb ld (0fb65h),a ; number of text columns +3540 c3ba14 jp 14bah + +3543 219f05 ld hl,059fh +3546 22e1fb ld (0fbe1h),hl ; MAXIMUM No. CHARACTERS ALLOWED ON SCREEN +3549 1806 jr 3551h +354b 21cf02 ld hl,02cfh +354e 22e1fb ld (0fbe1h),hl ; MAXIMUM No. CHARACTERS ALLOWED ON SCREEN +3551 21c415 ld hl,15c4h +3554 1166fc ld de,0fc66h ; LOW SCREEN RESOLUTION CRTC DATA +3557 012400 ld bc,0024h ; 16*2+2*2 (2CRTC tables + 2 word parameters with the respective size in characters) +355a edb0 ldir +355c 219f05 ld hl,059fh +355f 2288fc ld (0fc88h),hl ; MAX No. of characters displayed in high resolution +3562 215005 ld hl,0550h +3565 228cfc ld (0fc8ch),hl +3568 21cf02 ld hl,02cfh +356b 2286fc ld (0fc86h),hl ; MAX No. of characters displayed in low resolution +356e 21a802 ld hl,02a8h +3571 228afc ld (0fc8ah),hl +3574 3e12 ld a,12h +3576 328ffc ld (0fc8fh),a ; No.of lines displayed by screen +3579 c9 ret + +357a cd520b call 0b52h +357d 46 ld b,(hl) +357e cd520b call 0b52h +3581 46 ld b,(hl) +3582 e5 push hl +3583 21e815 ld hl,15e8h +3586 1166fc ld de,0fc66h ; LOW SCREEN RESOLUTION CRTC DATA +3589 012400 ld bc,0024h +358c edb0 ldir +358e 21bf03 ld hl,03bfh +3591 2286fc ld (0fc86h),hl ; MAX No. of characters displayed in low resolution +3594 219803 ld hl,0398h +3597 228afc ld (0fc8ah),hl +359a 3e18 ld a,18h ; 24 lines +359c 328ffc ld (0fc8fh),a ; No.of lines displayed by screen +359f 217f07 ld hl,077fh +35a2 2288fc ld (0fc88h),hl ; MAX No. of characters displayed in high resolution +35a5 22e1fb ld (0fbe1h),hl ; MAXIMUM No. CHARACTERS ALLOWED ON SCREEN +35a8 213007 ld hl,0730h +35ab 228cfc ld (0fc8ch),hl +35ae 3a8afb ld a,(0fb8ah) +35b1 cb47 bit 0,a +35b3 2006 jr nz,35bbh + +35b5 dd215500 ld ix,0055h ; IX = {HI-RES Selection routine} +35b9 1804 jr 35bfh + +35bb dd215200 ld ix,0052h ; IX = {LO-RES Selection routine} + +35bf cd9a1d call 1d9ah +35c2 e1 pop hl +35c3 c9 ret +35c4 3f ccf +35c5 2831 jr z,35f8h +35c7 05 dec b +35c8 12 ld (de),a +35c9 08 ex af,af' +35ca 12 ld (de),a +35cb 12 ld (de),a +35cc 00 nop +35cd 0f rrca +35ce 200b jr nz,35dbh +35d0 00 nop +35d1 00 nop +35d2 00 nop +35d3 00 nop +35d4 7f ld a,a +35d5 50 ld d,b +35d6 62 ld h,d +35d7 0a ld a,(bc) +35d8 12 ld (de),a +35d9 08 ex af,af' +35da 12 ld (de),a +35db 12 ld (de),a +35dc 00 nop +35dd 0f rrca +35de 200b jr nz,35ebh +35e0 00 nop +35e1 00 nop +35e2 00 nop +35e3 00 nop +35e4 cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +35e5 02 ld (bc),a +35e6 9f sbc a,a +35e7 05 dec b +35e8 3f ccf +35e9 2831 jr z,361ch +35eb 05 dec b +35ec 180c jr 35fah +35ee 1818 jr 3608h +35f0 00 nop +35f1 0b dec bc +35f2 200b jr nz,35ffh +35f4 00 nop +35f5 00 nop +35f6 00 nop +35f7 00 nop +35f8 7f ld a,a +35f9 50 ld d,b +35fa 62 ld h,d +35fb 0a ld a,(bc) +35fc 180c jr 360ah +35fe 1818 jr 3618h +3600 00 nop +3601 0b dec bc +3602 200b jr nz,360fh +3604 00 nop +3605 00 nop +3606 00 nop +3607 00 nop +3608 bf cp a +3609 03 inc bc +360a 7f ld a,a +360b 07 rlca +360c e5 push hl +360d 3a8afb ld a,(0fb8ah) +3610 cb47 bit 0,a +3612 c22816 jp nz,1628h + +3615 cd4315 call 1543h +3618 dd215500 ld ix,0055h ; IX = {HI-RES Selection routine} +361c cd9a1d call 1d9ah +361f cd4c14 call 144ch +3622 cd0f1d call 1d0fh +3625 c3a014 jp 14a0h + +3628 cd4b15 call 154bh +362b dd215200 ld ix,0052h ; IX = {LO-RES Selection routine} +362f cd9a1d call 1d9ah +3632 cd4c14 call 144ch +3635 cd0f1d call 1d0fh +3638 c32615 jp 1526h + +363b e5 push hl +363c 3a8afb ld a,(0fb8ah) +363f cb47 bit 0,a +3641 c25316 jp nz,1653h +3644 cd4b15 call 154bh +3647 cd4315 call 1543h +364a dd215500 ld ix,0055h ; IX = {HI-RES Selection routine} +364e cd9a1d call 1d9ah +3651 e1 pop hl +3652 c9 ret + +3653 cd4315 call 1543h +3656 cd4b15 call 154bh +3659 dd215200 ld ix,0052h ; IX = {LO-RES Selection routine} +365d cd9a1d call 1d9ah +3660 e1 pop hl +3661 c9 ret + +3662 7e ld a,(hl) +3663 fe23 cp 23h +3665 282d jr z,3694h +3667 cd961d call 1d96h +366a c2f61c jp nz,1cf6h +366d b3 or e +366e 281f jr z,368fh +3670 e5 push hl +3671 010000 ld bc,0000h +3674 21ff7f ld hl,7fffh +3677 b7 or a +3678 ed52 sbc hl,de +367a 3803 jr c,367fh +367c 03 inc bc +367d 18f9 jr 3678h +367f cd9f16 call 169fh +3682 e1 pop hl +3683 c9 ret + +3684 3e36 ld a,36h +3686 d323 out (23h),a ; 8253 MODE CONTROL WORD +3688 79 ld a,c +3689 d320 out (20h),a ; COUNTER 0 - Audio output freq. +368b 78 ld a,b +368c d320 out (20h),a ; COUNTER 0 - Audio output freq. +368e c9 ret +368f 3e34 ld a,34h +3691 d323 out (23h),a ; 8253 MODE CONTROL WORD +3693 c9 ret + +3694 cd5d0b call 0b5dh +3697 cd961d call 1d96h +369a e5 push hl +369b d5 push de +369c c1 pop bc +369d 18e0 jr 367fh + +369f d1 pop de +36a0 e1 pop hl +36a1 d5 push de +36a2 c5 push bc +36a3 2b dec hl +36a4 cd5d0b call 0b5dh +36a7 fe2c cp ',' +36a9 2808 jr z,36b3h +36ab c1 pop bc +36ac cd8416 call 1684h +36af d1 pop de +36b0 e5 push hl +36b1 d5 push de +36b2 c9 ret + +36b3 23 inc hl +36b4 cd961d call 1d96h +36b7 c1 pop bc +36b8 e5 push hl +36b9 cd8416 call 1684h +36bc 1804 jr 36c2h + +36be 1b dec de +36bf cdce16 call 16ceh +36c2 7a ld a,d +36c3 b3 or e +36c4 20f8 jr nz,36beh +36c6 cd8f16 call 168fh +36c9 e1 pop hl +36ca d1 pop de +36cb e5 push hl +36cc d5 push de +36cd c9 ret + +36ce c5 push bc +36cf f5 push af +36d0 010020 ld bc,2000h +36d3 0b dec bc +36d4 78 ld a,b +36d5 b1 or c +36d6 20fb jr nz,36d3h +36d8 f1 pop af +36d9 c1 pop bc +36da c9 ret + +36db 3a8afb ld a,(0fb8ah) +36de cbd7 set 2,a +36e0 328afb ld (0fb8ah),a +36e3 2a75fb ld hl,(0fb75h) +36e6 ed5b77fb ld de,(0fb77h) +36ea 2277fb ld (0fb77h),hl +36ed ed5375fb ld (0fb75h),de +36f1 2a79fb ld hl,(0fb79h) +36f4 ed5b7bfb ld de,(0fb7bh) +36f8 ed5379fb ld (0fb79h),de +36fc 227bfb ld (0fb7bh),hl +36ff 1808 jr 3709h +3701 3a8afb ld a,(0fb8ah) +3704 cb97 res 2,a +3706 328afb ld (0fb8ah),a +3709 210100 ld hl,0001h +370c 2287fb ld (0fb87h),hl +370f 2a75fb ld hl,(0fb75h) +3712 ed5b79fb ld de,(0fb79h) +3716 b7 or a +3717 ed52 sbc hl,de +3719 fa2217 jp m,1722h +371c 21ffff ld hl,0ffffh +371f 2287fb ld (0fb87h),hl +3722 2a75fb ld hl,(0fb75h) +3725 ed5b77fb ld de,(0fb77h) +3729 ed53affb ld (0fbafh),de +372d 22adfb ld (0fbadh),hl +3730 3a8afb ld a,(0fb8ah) +3733 cb57 bit 2,a +3735 280e jr z,3745h +3737 2aadfb ld hl,(0fbadh) +373a ed5baffb ld de,(0fbafh) +373e 22affb ld (0fbafh),hl +3741 ed53adfb ld (0fbadh),de +3745 cd5912 call 1259h +3748 3a8afb ld a,(0fb8ah) +374b cb57 bit 2,a +374d 280e jr z,375dh +374f 2aadfb ld hl,(0fbadh) +3752 ed5baffb ld de,(0fbafh) +3756 ed53adfb ld (0fbadh),de +375a 22affb ld (0fbafh),hl +375d 2aadfb ld hl,(0fbadh) +3760 ed5b79fb ld de,(0fb79h) +3764 b7 or a +3765 cd4c0b call 0b4ch +3768 c8 ret z +3769 ed5b87fb ld de,(0fb87h) +376d 19 add hl,de +376e 18bd jr 372dh + +3770 3a8afb ld a,(0fb8ah) +3773 cbcf set 1,a +3775 328afb ld (0fb8ah),a +3778 cdc51c call 1cc5h +377b 1808 jr 3785h + +377d 3a8afb ld a,(0fb8ah) +3780 cb8f res 1,a +3782 328afb ld (0fb8ah),a +3785 cd961d call 1d96h +3788 d5 push de +3789 cd520b call 0b52h +378c 2c inc l +378d dd21103a ld ix,3a10h ; IX = {GETINT} +3791 cd9a1d call 1d9ah +3794 5f ld e,a +3795 c1 pop bc +3796 e5 push hl +3797 c5 push bc +3798 e1 pop hl +3799 3a8afb ld a,(0fb8ah) +379c cb4f bit 1,a +379e c40f1d call nz,1d0fh +37a1 43 ld b,e +37a2 db50 in a,(50h) ; get system status +37a4 e610 and 10h +37a6 28fa jr z,37a2h ; wait for CSYNC - Composite video sync.signal +37a8 78 ld a,b +37a9 77 ld (hl),a +37aa 23 inc hl +37ab 3a8afb ld a,(0fb8ah) +37ae cb4f bit 1,a +37b0 c41b1d call nz,1d1bh +37b3 eb ex de,hl +37b4 e1 pop hl +37b5 7e ld a,(hl) +37b6 fe20 cp 20h +37b8 2003 jr nz,37bdh +37ba 23 inc hl +37bb 18f8 jr 37b5h + +37bd fe2c cp ',' +37bf 2008 jr nz,37c9h +37c1 cdc51c call 1cc5h +37c4 d5 push de +37c5 23 inc hl +37c6 c38d17 jp 178dh +37c9 c9 ret + +37ca cd520b call 0b52h +37cd 41 ld b,c +37ce cd520b call 0b52h +37d1 d8 ret c +37d2 cd580e call 0e58h +37d5 ed5badfb ld de,(0fbadh) +37d9 ed5363fb ld (0fb63h),de +37dd ed5baffb ld de,(0fbafh) +37e1 ed5365fb ld (0fb65h),de ; number of text columns +37e5 af xor a +37e6 3289fb ld (0fb89h),a +37e9 e5 push hl +37ea 21ffff ld hl,0ffffh +37ed 2267fb ld (0fb67h),hl +37f0 2a63fb ld hl,(0fb63h) +37f3 22adfb ld (0fbadh),hl +37f6 2a65fb ld hl,(0fb65h) ; number of text columns +37f9 22affb ld (0fbafh),hl +37fc cd9518 call 1895h +37ff c29318 jp nz,1893h +3802 2a63fb ld hl,(0fb63h) +3805 22adfb ld (0fbadh),hl +3808 228dfb ld (0fb8dh),hl +380b 2a65fb ld hl,(0fb65h) ; number of text columns +380e 22affb ld (0fbafh),hl +3811 228ffb ld (0fb8fh),hl +3814 cd5912 call 1259h +3817 2aadfb ld hl,(0fbadh) +381a 23 inc hl +381b 22adfb ld (0fbadh),hl +381e af xor a +381f cd9518 call 1895h +3822 28f0 jr z,3814h +3824 2aadfb ld hl,(0fbadh) +3827 2293fb ld (0fb93h),hl +382a 2a8dfb ld hl,(0fb8dh) +382d 2b dec hl +382e 22adfb ld (0fbadh),hl +3831 af xor a +3832 cd9518 call 1895h +3835 2010 jr nz,3847h +3837 cd5912 call 1259h +383a 2aadfb ld hl,(0fbadh) +383d 2b dec hl +383e 22adfb ld (0fbadh),hl +3841 af xor a +3842 cd9518 call 1895h +3845 28f0 jr z,3837h +3847 2aadfb ld hl,(0fbadh) +384a 2291fb ld (0fb91h),hl +384d ed5b93fb ld de,(0fb93h) +3851 19 add hl,de +3852 cb3c srl h +3854 cb1d rr l +3856 228dfb ld (0fb8dh),hl +3859 22adfb ld (0fbadh),hl +385c 2a67fb ld hl,(0fb67h) +385f ed5b8ffb ld de,(0fb8fh) +3863 19 add hl,de +3864 228ffb ld (0fb8fh),hl +3867 22affb ld (0fbafh),hl +386a af xor a +386b cd9518 call 1895h +386e 28a4 jr z,3814h +3870 2a67fb ld hl,(0fb67h) +3873 cb7c bit 7,h +3875 ca9318 jp z,1893h +3878 210100 ld hl,0001h +387b 2267fb ld (0fb67h),hl +387e 2a63fb ld hl,(0fb63h) +3881 22adfb ld (0fbadh),hl +3884 228dfb ld (0fb8dh),hl +3887 2a65fb ld hl,(0fb65h) ; number of text columns +388a 23 inc hl +388b 228ffb ld (0fb8fh),hl +388e 22affb ld (0fbafh),hl +3891 1881 jr 3814h +3893 e1 pop hl +3894 c9 ret + +3895 cda618 call 18a6h +3898 c0 ret nz +3899 cdc813 call 13c8h +389c a0 and b +389d f5 push af +389e db50 in a,(50h) ; get system status +38a0 cb87 res 0,a +38a2 d370 out (70h),a ; Set system status +38a4 f1 pop af +38a5 c9 ret +38a6 2aadfb ld hl,(0fbadh) +38a9 cb7c bit 7,h +38ab c0 ret nz +38ac ed5b85fb ld de,(0fb85h) ; Max X resolution +38b0 b7 or a +38b1 ed52 sbc hl,de +38b3 f2c718 jp p,18c7h +38b6 2aaffb ld hl,(0fbafh) +38b9 cb7c bit 7,h +38bb c0 ret nz +38bc 112001 ld de,0120h +38bf b7 or a +38c0 ed52 sbc hl,de +38c2 f2c718 jp p,18c7h +38c5 af xor a +38c6 c9 ret +38c7 3eff ld a,0ffh +38c9 a7 and a +38ca c9 ret + +; GETSTR - Get string pointed by FPREG 'Type Error' if it is not +38cb e5 push hl +38cc cd4c14 call 144ch +38cf 210040 ld hl,4000h +; GSTRDE - Get string pointed by DE +38d2 01ff5f ld bc,5fffh +38d5 cd0f1d call 1d0fh +38d8 7e ld a,(hl) +38d9 eeff xor 0ffh +38db 77 ld (hl),a +38dc 23 inc hl +38dd 0b dec bc +38de 78 ld a,b +38df b1 or c +38e0 20f6 jr nz,38d8h +38e2 cd1b1d call 1d1bh +38e5 cd5414 call 1454h +38e8 e1 pop hl +38e9 c9 ret + +38ea 1180d8 ld de,0d880h +38ed 0e14 ld c,14h +38ef cdf318 call 18f3h +38f2 c9 ret + +38f3 d5 push de +38f4 e5 push hl +38f5 c5 push bc +38f6 dd214d15 ld ix,154dh +38fa cd9a1d call 1d9ah +38fd c1 pop bc +38fe e1 pop hl +38ff d1 pop de +3900 c9 ret + +3901 0e1a ld c,1ah +3903 1100d8 ld de,0d800h +3906 cdf318 call 18f3h +3909 c9 ret +390a ed5351fb ld (0fb51h),de +390e e5 push hl +390f 2ad3fd ld hl,(0fdd3h) ; TMSTPT: Address of next available location in LSPT +3912 224efb ld (0fb4eh),hl +3915 e1 pop hl +3916 dd212b32 ld ix,322bh ; IX = {EVAL} +391a cd9a1d call 1d9ah +391d e5 push hl +391e 3acffd ld a,(0fdcfh) ; Type flag for FPREG: 2 - Integer, 3 - String, 4 - Single, 5 - Double +3921 fe03 cp 03h +3923 c2fb1c jp nz,1cfbh +3926 2141fe ld hl,0fe41h ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +3929 5e ld e,(hl) +392a 23 inc hl +392b 56 ld d,(hl) +392c eb ex de,hl +392d 7e ld a,(hl) +392e a7 and a +392f ca001d jp z,1d00h +3932 4f ld c,a +3933 23 inc hl +3934 5e ld e,(hl) +3935 23 inc hl +3936 56 ld d,(hl) +3937 eb ex de,hl +3938 11e2ff ld de,0ffe2h +393b 0600 ld b,00h +393d edb0 ldir +393f 3e22 ld a,22h +3941 32e1ff ld (0ffe1h),a +3944 12 ld (de),a +3945 ed5b51fb ld de,(0fb51h) +3949 21e1ff ld hl,0ffe1h +394c dd21ea11 ld ix,11eah +3950 cd9a1d call 1d9ah +3953 2a4efb ld hl,(0fb4eh) +3956 22d3fd ld (0fdd3h),hl ; TMSTPT: Address of next available location in LSPT +3959 e1 pop hl +395a c9 ret +395b 7e ld a,(hl) +395c fe48 cp 48h +395e ca7f19 jp z,197fh +3961 fe4d cp 4dh +3963 dd214a13 ld ix,134ah +3967 ca9a1d jp z,1d9ah +396a c38d1a jp 1a8dh +396d 7e ld a,(hl) +396e fe48 cp 48h +3970 cabc19 jp z,19bch +3973 fe41 cp 41h +3975 ca9f1b jp z,1b9fh +3978 dd21a112 ld ix,12a1h +397c c39a1d jp 1d9ah +397f 23 inc hl +3980 cdc51c call 1cc5h +3983 1180d8 ld de,0d880h +3986 cd0a19 call 190ah +3989 e5 push hl +398a cd0119 call 1901h +398d 1180d8 ld de,0d880h +3990 0e0f ld c,0fh +3992 cd2d1a call 1a2dh +3995 210040 ld hl,4000h +3998 225bfb ld (0fb5bh),hl +399b 2a5bfb ld hl,(0fb5bh) +399e 11ff9e ld de,9effh +39a1 cd4c0b call 0b4ch +39a4 d2541a jp nc,1a54h +39a7 cdea18 call 18eah +39aa b7 or a +39ab c2001d jp nz,1d00h +39ae 2a5bfb ld hl,(0fb5bh) +39b1 0680 ld b,80h +39b3 1100d8 ld de,0d800h +39b6 cd091a call 1a09h +39b9 c39b19 jp 199bh +39bc 23 inc hl +39bd cdc51c call 1cc5h +39c0 1180d8 ld de,0d880h +39c3 cd0a19 call 190ah +39c6 e5 push hl +39c7 cd0119 call 1901h +39ca cd1f1a call 1a1fh +39cd cd281a call 1a28h +39d0 210040 ld hl,4000h +39d3 225bfb ld (0fb5bh),hl +39d6 2a5bfb ld hl,(0fb5bh) +39d9 11ff9e ld de,9effh +39dc cd4c0b call 0b4ch +39df d2451a jp nc,1a45h +39e2 2a5bfb ld hl,(0fb5bh) +39e5 0680 ld b,80h +39e7 1100d8 ld de,0d800h +39ea cdf619 call 19f6h +39ed 225bfb ld (0fb5bh),hl +39f0 cd351a call 1a35h +39f3 c3d619 jp 19d6h + + +; LDIRVM - Block transfer to VRAM from memory (HL)->(DE), BC times +39f6 cd0f1d call 1d0fh +39f9 db50 in a,(50h) ; get system status +39fb e610 and 10h +39fd 28fa jr z,39f9h ; wait for CSYNC - Composite video sync.signal +39ff 7e ld a,(hl) +3a00 23 inc hl +3a01 12 ld (de),a +3a02 13 inc de +3a03 cd1b1d call 1d1bh +3a06 10ee djnz 39f6h ; LDIRVM +3a08 c9 ret + +3a09 cd0f1d call 1d0fh +3a0c db50 in a,(50h) ; get system status +3a0e e610 and 10h + +; GETINT +3a10 28fa jr z,3a0ch ; wait for CSYNC - Composite video sync.signal +3a12 1a ld a,(de) +; MAKINT - Convert tmp string to int in A register +3a13 13 inc de +3a14 77 ld (hl),a +3a15 23 inc hl +3a16 cd1b1d call 1d1bh +3a19 10ee djnz 3a09h +3a1b 225bfb ld (0fb5bh),hl +3a1e c9 ret + +3a1f 1180d8 ld de,0d880h +3a22 0e13 ld c,13h +3a24 cdf318 call 18f3h +3a27 c9 ret +3a28 1180d8 ld de,0d880h +3a2b 0e16 ld c,16h +3a2d cdf318 call 18f3h +3a30 3c inc a +3a31 ca001d jp z,1d00h +3a34 c9 ret +3a35 1180d8 ld de,0d880h +3a38 0e15 ld c,15h +3a3a cdf318 call 18f3h +3a3d 3c inc a +3a3e c0 ret nz +3a3f cd451a call 1a45h +3a42 c3001d jp 1d00h +3a45 1180d8 ld de,0d880h +3a48 0e10 ld c,10h +3a4a cdf318 call 18f3h +3a4d 3c inc a +3a4e c2541a jp nz,1a54h +3a51 c3001d jp 1d00h +3a54 e1 pop hl +3a55 c9 ret + +3a56 2a58fc ld hl,(0fc58h) ; BASTXT - Address of BASIC Program +3a59 3600 ld (hl),00h +3a5b 23 inc hl +3a5c 3600 ld (hl),00h +3a5e 23 inc hl +3a5f 3600 ld (hl),00h +3a61 23 inc hl +3a62 2219fe ld (0fe19h),hl ; Addr of simple variables +3a65 c9 ret + +3a66 2100d8 ld hl,0d800h + +; Print message, text ptr in (HL) +3a69 5e ld e,(hl) +3a6a 23 inc hl +3a6b 56 ld d,(hl) +3a6c 213a39 ld hl,393ah +3a6f cd4c0b call 0b4ch +3a72 d0 ret nc +3a73 e1 pop hl +3a74 2ab1fb ld hl,(0fbb1h) +3a77 dd214a13 ld ix,134ah +3a7b c39a1d jp 1d9ah +3a7e 22b1fb ld (0fbb1h),hl +3a81 3a8afb ld a,(0fb8ah) +3a84 cb9f res 3,a +3a86 328afb ld (0fb8ah),a +3a89 af xor a +3a8a 3c inc a +3a8b 180c jr 3a99h +3a8d 22b1fb ld (0fbb1h),hl +3a90 3a8afb ld a,(0fb8ah) +3a93 cb9f res 3,a +3a95 328afb ld (0fb8ah),a +3a98 af xor a +3a99 3d dec a +3a9a 328cfb ld (0fb8ch),a +3a9d 1180d8 ld de,0d880h +3aa0 cd0a19 call 190ah +3aa3 e5 push hl +3aa4 cd0119 call 1901h +3aa7 cdfb1a call 1afbh +3aaa 3c inc a +3aab ca741a jp z,1a74h +3aae 2ac7fd ld hl,(0fdc7h) ; Pointer to address of keyboard buffer +3ab1 226bfb ld (0fb6bh),hl +3ab4 cdf21a call 1af2h +3ab7 b7 or a +3ab8 c2001d jp nz,1d00h +3abb 3a8afb ld a,(0fb8ah) +3abe cb5f bit 3,a +3ac0 cc661a call z,1a66h +3ac3 3a8afb ld a,(0fb8ah) +3ac6 cbdf set 3,a +3ac8 328afb ld (0fb8ah),a +3acb 3a8cfb ld a,(0fb8ch) +3ace a7 and a +3acf c4561a call nz,1a56h +3ad2 af xor a +3ad3 328cfb ld (0fb8ch),a +3ad6 cdc51c call 1cc5h +3ad9 2100d8 ld hl,0d800h +3adc 0680 ld b,80h +3ade 7e ld a,(hl) +3adf fe1a cp 1ah +3ae1 c2e71a jp nz,1ae7h +3ae4 c3bb1c jp 1cbbh +3ae7 c3041b jp 1b04h +3aea 23 inc hl +3aeb 05 dec b +3aec c2de1a jp nz,1adeh +3aef c3b41a jp 1ab4h +3af2 1180d8 ld de,0d880h +3af5 0e14 ld c,14h +3af7 cdf318 call 18f3h +3afa c9 ret +3afb 1180d8 ld de,0d880h +3afe 0e0f ld c,0fh +3b00 cdf318 call 18f3h +3b03 c9 ret +3b04 2267fb ld (0fb67h),hl +3b07 60 ld h,b +3b08 69 ld l,c +3b09 2269fb ld (0fb69h),hl +3b0c d5 push de +3b0d 2a6bfb ld hl,(0fb6bh) +3b10 fe0a cp 0ah +3b12 2814 jr z,3b28h +3b14 fe0d cp 0dh +3b16 200b jr nz,3b23h +3b18 af xor a +3b19 77 ld (hl),a +3b1a 2ac7fd ld hl,(0fdc7h) ; Pointer to address of keyboard buffer +3b1d 2b dec hl +3b1e c3341b jp 1b34h +3b21 1805 jr 3b28h +3b23 77 ld (hl),a +3b24 23 inc hl +3b25 226bfb ld (0fb6bh),hl +3b28 d1 pop de +3b29 2a69fb ld hl,(0fb69h) +3b2c 44 ld b,h +3b2d 4d ld c,l +3b2e 2a67fb ld hl,(0fb67h) +3b31 c3ea1a jp 1aeah +3b34 2259fb ld (0fb59h),hl +3b37 3ec3 ld a,0c3h +3b39 32b7fe ld (0feb7h),a +3b3c 219c3f ld hl,3f9ch +3b3f 22b8fe ld (0feb8h),hl +3b42 2a59fb ld hl,(0fb59h) +3b45 23 inc hl +3b46 7e ld a,(hl) +3b47 2b dec hl +3b48 f5 push af +3b49 e6f0 and 0f0h +3b4b fe30 cp 30h +3b4d c26d1b jp nz,1b6dh +3b50 f1 pop af +3b51 fe3a cp 3ah +3b53 d26d1b jp nc,1b6dh +3b56 dd216b29 ld ix,296bh +3b5a dde5 push ix +3b5c c38a3f jp 3f8ah ; BANK SWITCHING - flip ROM page + +3b5f 3ec9 ld a,0c9h +3b61 32b7fe ld (0feb7h),a +3b64 2ac7fd ld hl,(0fdc7h) ; Pointer to address of keyboard buffer +3b67 226bfb ld (0fb6bh),hl +3b6a c3211b jp 1b21h +3b6d 3ec9 ld a,0c9h +3b6f 32b7fe ld (0feb7h),a +3b72 21a33b ld hl,3ba3h +3b75 dd219b37 ld ix,379bh ; IX= {Output a string} +3b79 cd9a1d call 1d9ah +3b7c dd210329 ld ix,2903h ; IX = {READY} +3b80 dde5 push ix +3b82 c38a3f jp 3f8ah ; BANK SWITCHING - flip ROM page + +3b85 44 ld b,h +3b86 49 ld c,c +3b87 52 ld d,d +3b88 45 ld b,l +3b89 43 ld b,e +3b8a 54 ld d,h +3b8b 2053 jr nz,3be0h +3b8d 54 ld d,h +3b8e 41 ld b,c +3b8f 54 ld d,h +3b90 45 ld b,l +3b91 4d ld c,l +3b92 45 ld b,l +3b93 4e ld c,(hl) +3b94 54 ld d,h +3b95 2049 jr nz,3be0h +3b97 4e ld c,(hl) +3b98 2046 jr nz,3be0h +3b9a 49 ld c,c +3b9b 4c ld c,h +3b9c 45 ld b,l +3b9d 0d dec c +3b9e 00 nop +3b9f 23 inc hl +3ba0 cdc51c call 1cc5h +3ba3 1180d8 ld de,0d880h +3ba6 cd0a19 call 190ah +3ba9 e5 push hl +3baa 2a58fc ld hl,(0fc58h) ; BASTXT - Address of BASIC Program +3bad 7e ld a,(hl) +3bae a7 and a +3baf c2b81b jp nz,1bb8h +3bb2 23 inc hl +3bb3 7e ld a,(hl) +3bb4 a7 and a +3bb5 ca001d jp z,1d00h +3bb8 cd0119 call 1901h +3bbb cdc41b call 1bc4h +3bbe 2a58fc ld hl,(0fc58h) ; BASTXT - Address of BASIC Program +3bc1 c3e51b jp 1be5h +3bc4 2100d8 ld hl,0d800h +3bc7 2263fb ld (0fb63h),hl +3bca 0680 ld b,80h +3bcc ed4365fb ld (0fb65h),bc ; number of text columns +3bd0 1180d8 ld de,0d880h +3bd3 0e13 ld c,13h +3bd5 cdf318 call 18f3h +3bd8 1180d8 ld de,0d880h +3bdb 0e16 ld c,16h +3bdd cdf318 call 18f3h +3be0 3c inc a +3be1 ca001d jp z,1d00h +3be4 c9 ret +3be5 2253fb ld (0fb53h),hl +3be8 2a53fb ld hl,(0fb53h) +3beb 7e ld a,(hl) +3bec 23 inc hl +3bed 46 ld b,(hl) +3bee b0 or b +3bef ca5b1c jp z,1c5bh +3bf2 23 inc hl +3bf3 5e ld e,(hl) +3bf4 23 inc hl +3bf5 56 ld d,(hl) +3bf6 21e1ff ld hl,0ffe1h +3bf9 ed5341fe ld (0fe41h),de ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +3bfd 3e02 ld a,02h +3bff 32cffd ld (0fdcfh),a ; Type flag for FPREG: 2 - Integer, 3 - String, 4 - Single, 5 - Double +3c02 010000 ld bc,0000h +3c05 dd219921 ld ix,2199h +3c09 cd9a1d call 1d9ah +3c0c 21e1ff ld hl,0ffe1h +3c0f 7e ld a,(hl) +3c10 fe00 cp 00h +3c12 2808 jr z,3c1ch +3c14 e5 push hl +3c15 cd5f1c call 1c5fh +3c18 e1 pop hl +3c19 23 inc hl +3c1a 18f3 jr 3c0fh +3c1c 2a53fb ld hl,(0fb53h) +3c1f 3e20 ld a,20h +3c21 cd5f1c call 1c5fh +3c24 2a53fb ld hl,(0fb53h) +3c27 23 inc hl +3c28 23 inc hl +3c29 23 inc hl +3c2a 23 inc hl +3c2b dd21723a ld ix,3a72h +3c2f cd9a1d call 1d9ah +3c32 2ac7fd ld hl,(0fdc7h) ; Pointer to address of keyboard buffer +3c35 7e ld a,(hl) +3c36 fe00 cp 00h +3c38 2807 jr z,3c41h +3c3a cd5f1c call 1c5fh +3c3d 23 inc hl +3c3e c3351c jp 1c35h +3c41 3e0d ld a,0dh +3c43 cd5f1c call 1c5fh +3c46 3e0a ld a,0ah +3c48 cd5f1c call 1c5fh +3c4b 2a53fb ld hl,(0fb53h) +3c4e 4e ld c,(hl) +3c4f 23 inc hl +3c50 46 ld b,(hl) +3c51 c5 push bc +3c52 e1 pop hl +3c53 2253fb ld (0fb53h),hl +3c56 7c ld a,h +3c57 b5 or l +3c58 c2e81b jp nz,1be8h +3c5b 3e1a ld a,1ah +3c5d 1800 jr 3c5fh +3c5f e5 push hl +3c60 d5 push de +3c61 c5 push bc +3c62 2a63fb ld hl,(0fb63h) +3c65 ed4b65fb ld bc,(0fb65h) ; number of text columns +3c69 fe1a cp 1ah +3c6b 200b jr nz,3c78h +3c6d 77 ld (hl),a +3c6e 1180d8 ld de,0d880h +3c71 0e15 ld c,15h +3c73 cdf318 call 18f3h +3c76 1834 jr 3cach +3c78 77 ld (hl),a +3c79 05 dec b +3c7a 280a jr z,3c86h +3c7c ed4365fb ld (0fb65h),bc ; number of text columns +3c80 23 inc hl +3c81 2263fb ld (0fb63h),hl +3c84 1822 jr 3ca8h +3c86 e5 push hl +3c87 c5 push bc +3c88 1180d8 ld de,0d880h +3c8b 0e15 ld c,15h +3c8d cdf318 call 18f3h +3c90 c1 pop bc +3c91 e1 pop hl +3c92 b7 or a +3c93 ca9c1c jp z,1c9ch +3c96 cdac1c call 1cach +3c99 c3001d jp 1d00h +3c9c 0680 ld b,80h +3c9e 2100d8 ld hl,0d800h +3ca1 ed4365fb ld (0fb65h),bc ; number of text columns +3ca5 2263fb ld (0fb63h),hl +3ca8 c1 pop bc +3ca9 d1 pop de +3caa e1 pop hl +3cab c9 ret +3cac 1180d8 ld de,0d880h +3caf 0e10 ld c,10h +3cb1 cdf318 call 18f3h +3cb4 3c inc a +3cb5 c2bb1c jp nz,1cbbh +3cb8 c3bb1c jp 1cbbh +3cbb e1 pop hl +3cbc dd210329 ld ix,2903h ; IX = {READY} +3cc0 dde5 push ix +3cc2 c38a3f jp 3f8ah ; BANK SWITCHING - flip ROM page + +3cc5 e5 push hl +3cc6 f5 push af +3cc7 c5 push bc +3cc8 269f ld h,9fh +3cca 3ef0 ld a,0f0h +3ccc ee0f xor 0fh +3cce 6f ld l,a +3ccf e5 push hl +3cd0 21c51c ld hl,1cc5h +3cd3 3ee5 ld a,0e5h +3cd5 ae xor (hl) +3cd6 c2ef1c jp nz,1cefh +3cd9 e1 pop hl +3cda cd0f1d call 1d0fh +3cdd db50 in a,(50h) ; get system status +3cdf e610 and 10h +3ce1 28fa jr z,3cddh ; wait for CSYNC - Composite video sync.signal +3ce3 7e ld a,(hl) +3ce4 3c inc a +3ce5 3c inc a + +; Workaround observed in MAME: patch out the protection +; ROM_FILL(0x3ce7, 1, 0) + +3ce6 2007 jr nz,3cefh +3ce8 cd1b1d call 1d1bh +3ceb c1 pop bc +3cec f1 pop af +3ced e1 pop hl +3cee c9 ret + +3cef cd1b1d call 1d1bh +3cf2 c3f61c jp 1cf6h + +3cf5 c9 ret +3cf6 1e02 ld e,02h ; ? SN Error +3cf8 c3023f jp 3f02h ; Flip ROM page and fire the error message +3cfb 1e18 ld e,18h ; ? DD Error +3cfd c3023f jp 3f02h ; Flip ROM page and fire the error message +3d00 1e08 ld e,08h ; ?FC Error +3d02 c3023f jp 3f02h ; Flip ROM page and fire the error message +3d05 1e0e ld e,0eh ; ?UL Error +3d07 c3023f jp 3f02h ; Flip ROM page and fire the error message +3d0a 1e0c ld e,0ch ; ?OM Error +3d0c c3023f jp 3f02h ; Flip ROM page and fire the error message +3d0f db50 in a,(50h) ; get system status +3d11 328bfb ld (0fb8bh),a ; Current system status +3d14 cbc7 set 0,a +3d16 cb8f res 1,a +3d18 d370 out (70h),a ; Set system status +3d1a c9 ret + +3d1b 3a8bfb ld a,(0fb8bh) ; Current system status +3d1e d370 out (70h),a ; Set system status +3d20 c9 ret +3d21 dd21452d ld ix,2d45h ; IX= {LNUM_PARM_0 - Get specified line number (2nd parameter)} +3d25 c39a1d jp 1d9ah +3d28 dd210419 ld ix,1904h ; INT_RESULT_HL - Get back from function, result in HL +3d2c c39a1d jp 1d9ah +3d2f dd21e229 ld ix,29e2h +3d33 c39a1d jp 1d9ah +3d36 dd212034 ld ix,3420h ; OPRND_6 +3d3a 185e jr 3d9ah +3d3c dd213518 ld ix,1835h ; IX = {DEC_FACCU2HL - copy number value from FPREG (FP accumulator) to HL} +3d40 1858 jr 3d9ah +3d42 dd211b18 ld ix,181bh ; IX = {Move a single precision value -> HL to FPREG} +3d46 1852 jr 3d9ah +3d48 dd212c18 ld ix,182ch ; IX = {Load single precision value -> into BC/DE} +3d4c 184c jr 3d9ah +3d4e dd21b116 ld ix,16b1h ; IX = {FPMULT - Single precision multiply (Multiply BCDE to FP reg)} +3d52 1846 jr 3d9ah +3d54 dd210c17 ld ix,170ch ; IX = {DVBCDE - Divide FP by BCDE} +3d58 1840 jr 3d9ah +3d5a dd212b32 ld ix,322bh ; IX = {EVAL} +3d5e 183a jr 3d9ah +3d60 dd215e19 ld ix,195eh ; IX = {TSTSTR - Test a string, 'Type Error' if it is not} +3d64 1834 jr 3d9ah +3d66 dd210135 ld ix,3501h ; IX= {GETVAR: Find address of variable} +3d6a 182e jr 3d9ah +3d6c dd21e918 ld ix,18e9h ; IX= {__CINT: Floating point to Integer} +3d70 1828 jr 3d9ah +3d72 dd211b19 ld ix,191bh ; IX= {Integer to single precision} +3d76 1822 jr 3d9ah +3d78 dd21f43f ld ix,3ff4h +3d7c 181c jr 3d9ah +3d7e dd21ea3f ld ix,3feah +3d82 1816 jr 3d9ah +3d84 dd21f83f ld ix,3ff8h +3d88 1810 jr 3d9ah +3d8a dd21f23f ld ix,3ff2h +3d8e 180a jr 3d9ah +3d90 dd215910 ld ix,1059h +3d94 1804 jr 3d9ah +3d96 dd21f639 ld ix,39f6h ; GETWORD - Get a number to DE (0..65535) (or ; LDIRVM - Block transfer to VRAM from memory (HL)->(DE), BC times) + +3d9a dde5 push ix +3d9c c3803f jp 3f80h ; BANK SWITCHING - call the FAR function in stack + +3d9f cd0f1d call 1d0fh +3da2 db50 in a,(50h) ; get system status +3da4 e610 and 10h +3da6 28fa jr z,3da2h ; wait for CSYNC - Composite video sync.signal +3da8 3efe ld a,0feh +3daa 00 nop +3dab 3c inc a +3dac 3c inc a +3dad f5 push af +3dae cd1b1d call 1d1bh +3db1 f1 pop af +3db2 c9 ret + +3db3 dbf1 in a,(0f1h) ; FDC tract register +3db5 2f cpl +3db6 d3f1 out (0f1h),a ; FDC tract register +3db8 4f ld c,a +3db9 af xor a +3dba 3d dec a +3dbb 20fd jr nz,3dbah +3dbd dbf1 in a,(0f1h) ; FDC tract register +3dbf b9 cp c +3dc0 c24f1e jp nz,1e4fh +3dc3 cd9f1d call 1d9fh +3dc6 00 nop +3dc7 c34f1e jp 1e4fh + +3dca 50 ld d,b +3dcb fb ei +3dcc cd7a1e call 1e7ah +3dcf cd831e call 1e83h +3dd2 cd881e call 1e88h +3dd5 af xor a +3dd6 d3f0 out (0f0h),a ; WD2793 FDC command/status register +3dd8 cd831e call 1e83h +3ddb cd831e call 1e83h +3dde cd881e call 1e88h +3de1 110200 ld de,0002h +3de4 cdec1d call 1dech +3de7 1812 jr 3dfbh +3de9 110a00 ld de,000ah +3dec 010000 ld bc,0000h +3def 0b dec bc +3df0 78 ld a,b +3df1 b1 or c +3df2 20fb jr nz,3defh +3df4 1b dec de +3df5 7b ld a,e +3df6 b2 or d +3df7 20f6 jr nz,3defh +3df9 c9 ret + +3dfa a7 and a +3dfb 00 nop +3dfc 00 nop +3dfd 3e83 ld a,83h +3dff d3e0 out (0e0h),a ; DMA CONTROL PORT +3e01 3afa1d ld a,(1dfah) +3e04 eeff xor 0ffh +3e06 d3f2 out (0f2h),a ; FDC sector register +3e08 af xor a +3e09 d3f1 out (0f1h),a ; FDC tract register +3e0b 3e8c ld a,8ch +3e0d d3f0 out (0f0h),a ; WD2793 FDC command/status register +3e0f 0ef3 ld c,0f3h +3e11 cd831e call 1e83h +3e14 cd831e call 1e83h +3e17 dbf0 in a,(0f0h) ; WD2793 FDC command/status register +3e19 cb4f bit 1,a +3e1b 2018 jr nz,3e35h +3e1d dbf0 in a,(0f0h) ; WD2793 FDC command/status register +3e1f cb4f bit 1,a +3e21 2012 jr nz,3e35h +3e23 dbf0 in a,(0f0h) ; WD2793 FDC command/status register +3e25 cb4f bit 1,a +3e27 200c jr nz,3e35h +3e29 cb47 bit 0,a +3e2b 280d jr z,3e3ah +3e2d dbf0 in a,(0f0h) ; WD2793 FDC command/status register +3e2f cb4f bit 1,a +3e31 2002 jr nz,3e35h +3e33 18e2 jr 3e17h +3e35 ed78 in a,(c) +3e37 c3171e jp 1e17h +3e3a e61c and 1ch +3e3c 200d jr nz,3e4bh +3e3e 3a50fb ld a,(0fb50h) +3e41 3d dec a +3e42 ca951e jp z,1e95h +3e45 3250fb ld (0fb50h),a +3e48 c3fd1d jp 1dfdh + +3e4b cb5f bit 3,a +3e4d 28ef jr z,3e3eh +3e4f 3ec9 ld a,0c9h +3e51 3293fe ld (0fe93h),a +3e54 af xor a +3e55 214dfb ld hl,0fb4dh ; force the range fb4dh..fbbdh to zero +3e58 77 ld (hl),a +3e59 114efb ld de,0fb4eh +3e5c 017000 ld bc,0070h +3e5f edb0 ldir +3e61 3a8afb ld a,(0fb8ah) +3e64 cbc7 set 0,a +3e66 328afb ld (0fb8ah),a +3e69 cd0f1d call 1d0fh +3e6c 3eff ld a,0ffh +3e6e f5 push af +3e6f 6f ld l,a +3e70 d660 sub 60h +3e72 67 ld h,a +3e73 f1 pop af +3e74 3d dec a +3e75 77 ld (hl),a +3e76 cd1b1d call 1d1bh +3e79 c9 ret + +3e7a 3e01 ld a,01h +3e7c d3e4 out (0e4h),a ; Disk select +3e7e cbef set 5,a ; Motor drive monostable trigger +3e80 d3e4 out (0e4h),a ; Disk select +3e82 c9 ret + +3e83 e3 ex (sp),hl +3e84 e3 ex (sp),hl +3e85 e3 ex (sp),hl +3e86 e3 ex (sp),hl +3e87 c9 ret + +3e88 dbf0 in a,(0f0h) ; WD2793 FDC command/status register +3e8a cb47 bit 0,a +3e8c 20fa jr nz,3e88h +3e8e dbf0 in a,(0f0h) ; WD2793 FDC command/status register +3e90 cb47 bit 0,a +3e92 20f4 jr nz,3e88h +3e94 c9 ret + +3e95 cd0f1d call 1d0fh +3e98 21ff0f ld hl,0fffh +3e9b 3e9f ld a,9fh +3e9d 67 ld h,a +3e9e 18d5 jr 3e75h +3ea0 ff rst 38h +3ea1 ff rst 38h +3ea2 ff rst 38h +3ea3 ff rst 38h +3ea4 ff rst 38h +3ea5 ff rst 38h +3ea6 ff rst 38h +3ea7 ff rst 38h +3ea8 ff rst 38h +3ea9 ff rst 38h +3eaa ff rst 38h +3eab ff rst 38h +3eac ff rst 38h +3ead ff rst 38h +3eae ff rst 38h +3eaf ff rst 38h +3eb0 ff rst 38h +3eb1 ff rst 38h +3eb2 ff rst 38h +3eb3 ff rst 38h +3eb4 ff rst 38h +3eb5 ff rst 38h +3eb6 ff rst 38h +3eb7 ff rst 38h +3eb8 ff rst 38h +3eb9 ff rst 38h +3eba ff rst 38h +3ebb ff rst 38h +3ebc ff rst 38h +3ebd ff rst 38h +3ebe ff rst 38h +3ebf ff rst 38h +3ec0 ff rst 38h +3ec1 ff rst 38h +3ec2 ff rst 38h +3ec3 ff rst 38h +3ec4 ff rst 38h +3ec5 ff rst 38h +3ec6 ff rst 38h +3ec7 ff rst 38h +3ec8 ff rst 38h +3ec9 ff rst 38h +3eca ff rst 38h +3ecb ff rst 38h +3ecc ff rst 38h +3ecd ff rst 38h +3ece ff rst 38h +3ecf ff rst 38h +3ed0 ff rst 38h +3ed1 ff rst 38h +3ed2 ff rst 38h +3ed3 ff rst 38h +3ed4 ff rst 38h +3ed5 ff rst 38h +3ed6 ff rst 38h +3ed7 ff rst 38h +3ed8 ff rst 38h +3ed9 ff rst 38h +3eda ff rst 38h +3edb ff rst 38h +3edc ff rst 38h +3edd ff rst 38h +3ede ff rst 38h +3edf ff rst 38h +3ee0 ff rst 38h +3ee1 ff rst 38h +3ee2 ff rst 38h +3ee3 ff rst 38h +3ee4 ff rst 38h +3ee5 ff rst 38h +3ee6 ff rst 38h +3ee7 ff rst 38h +3ee8 ff rst 38h +3ee9 ff rst 38h +3eea ff rst 38h +3eeb ff rst 38h +3eec ff rst 38h +3eed ff rst 38h +3eee ff rst 38h +3eef ff rst 38h +3ef0 ff rst 38h +3ef1 ff rst 38h +3ef2 ff rst 38h +3ef3 ff rst 38h +3ef4 ff rst 38h +3ef5 ff rst 38h +3ef6 ff rst 38h +3ef7 ff rst 38h +3ef8 ff rst 38h +3ef9 ff rst 38h +3efa ff rst 38h +3efb ff rst 38h +3efc ff rst 38h +3efd ff rst 38h +3efe ff rst 38h +3eff ff rst 38h +3f00 ff rst 38h +3f01 ff rst 38h +3f02 ff rst 38h +3f03 ff rst 38h +3f04 ff rst 38h +3f05 ff rst 38h +3f06 ff rst 38h +3f07 ff rst 38h +3f08 ff rst 38h +3f09 ff rst 38h +3f0a ff rst 38h +3f0b ff rst 38h +3f0c ff rst 38h +3f0d ff rst 38h +3f0e ff rst 38h +3f0f ff rst 38h +3f10 ff rst 38h +3f11 ff rst 38h +3f12 ff rst 38h +3f13 ff rst 38h +3f14 ff rst 38h +3f15 ff rst 38h +3f16 ff rst 38h +3f17 ff rst 38h +3f18 ff rst 38h +3f19 ff rst 38h +3f1a ff rst 38h +3f1b ff rst 38h +3f1c ff rst 38h +3f1d ff rst 38h +3f1e ff rst 38h +3f1f ff rst 38h +3f20 ff rst 38h +3f21 ff rst 38h +3f22 ff rst 38h +3f23 ff rst 38h +3f24 ff rst 38h +3f25 ff rst 38h +3f26 ff rst 38h +3f27 ff rst 38h +3f28 ff rst 38h +3f29 ff rst 38h +3f2a ff rst 38h +3f2b ff rst 38h +3f2c ff rst 38h +3f2d ff rst 38h +3f2e ff rst 38h +3f2f ff rst 38h +3f30 ff rst 38h +3f31 ff rst 38h +3f32 ff rst 38h +3f33 ff rst 38h +3f34 ff rst 38h +3f35 ff rst 38h +3f36 ff rst 38h +3f37 ff rst 38h +3f38 ff rst 38h +3f39 ff rst 38h +3f3a ff rst 38h +3f3b ff rst 38h +3f3c ff rst 38h +3f3d ff rst 38h +3f3e ff rst 38h +3f3f ff rst 38h +3f40 ff rst 38h +3f41 ff rst 38h +3f42 ff rst 38h +3f43 ff rst 38h +3f44 ff rst 38h +3f45 ff rst 38h +3f46 ff rst 38h +3f47 ff rst 38h +3f48 ff rst 38h +3f49 ff rst 38h +3f4a ff rst 38h +3f4b ff rst 38h +3f4c ff rst 38h +3f4d ff rst 38h +3f4e ff rst 38h +3f4f ff rst 38h +3f50 ff rst 38h +3f51 ff rst 38h +3f52 ff rst 38h +3f53 ff rst 38h +3f54 ff rst 38h +3f55 ff rst 38h +3f56 ff rst 38h +3f57 ff rst 38h +3f58 ff rst 38h +3f59 ff rst 38h +3f5a ff rst 38h +3f5b ff rst 38h +3f5c ff rst 38h +3f5d ff rst 38h +3f5e ff rst 38h +3f5f ff rst 38h +3f60 ff rst 38h +3f61 ff rst 38h +3f62 ff rst 38h +3f63 ff rst 38h +3f64 ff rst 38h +3f65 ff rst 38h +3f66 ff rst 38h +3f67 ff rst 38h +3f68 ff rst 38h +3f69 ff rst 38h +3f6a ff rst 38h +3f6b ff rst 38h +3f6c ff rst 38h +3f6d ff rst 38h +3f6e ff rst 38h +3f6f ff rst 38h +3f70 ff rst 38h +3f71 ff rst 38h +3f72 ff rst 38h +3f73 ff rst 38h +3f74 ff rst 38h +3f75 ff rst 38h +3f76 ff rst 38h +3f77 ff rst 38h +3f78 ff rst 38h +3f79 ff rst 38h +3f7a ff rst 38h +3f7b ff rst 38h +3f7c ff rst 38h +3f7d ff rst 38h +3f7e ff rst 38h +3f7f ff rst 38h +3f80 ff rst 38h +3f81 ff rst 38h +3f82 ff rst 38h +3f83 ff rst 38h +3f84 ff rst 38h +3f85 ff rst 38h +3f86 ff rst 38h +3f87 ff rst 38h +3f88 ff rst 38h +3f89 ff rst 38h +3f8a ff rst 38h +3f8b ff rst 38h +3f8c ff rst 38h +3f8d ff rst 38h +3f8e ff rst 38h +3f8f ff rst 38h +3f90 ff rst 38h +3f91 ff rst 38h +3f92 ff rst 38h +3f93 ff rst 38h +3f94 ff rst 38h +3f95 ff rst 38h +3f96 ff rst 38h +3f97 ff rst 38h +3f98 ff rst 38h +3f99 ff rst 38h +3f9a ff rst 38h +3f9b ff rst 38h +3f9c ff rst 38h +3f9d ff rst 38h +3f9e ff rst 38h +3f9f ff rst 38h +3fa0 ff rst 38h +3fa1 ff rst 38h +3fa2 ff rst 38h +3fa3 ff rst 38h +3fa4 ff rst 38h +3fa5 ff rst 38h +3fa6 ff rst 38h +3fa7 ff rst 38h +3fa8 ff rst 38h +3fa9 ff rst 38h +3faa ff rst 38h +3fab ff rst 38h +3fac ff rst 38h +3fad ff rst 38h +3fae ff rst 38h +3faf ff rst 38h +3fb0 ff rst 38h +3fb1 ff rst 38h +3fb2 ff rst 38h +3fb3 ff rst 38h +3fb4 ff rst 38h +3fb5 ff rst 38h +3fb6 ff rst 38h +3fb7 ff rst 38h +3fb8 ff rst 38h +3fb9 ff rst 38h +3fba ff rst 38h +3fbb ff rst 38h +3fbc ff rst 38h +3fbd ff rst 38h +3fbe ff rst 38h +3fbf ff rst 38h +3fc0 ff rst 38h +3fc1 ff rst 38h +3fc2 ff rst 38h +3fc3 ff rst 38h +3fc4 ff rst 38h +3fc5 ff rst 38h +3fc6 ff rst 38h +3fc7 ff rst 38h +3fc8 ff rst 38h +3fc9 ff rst 38h +3fca ff rst 38h +3fcb ff rst 38h +3fcc ff rst 38h +3fcd ff rst 38h +3fce ff rst 38h +3fcf ff rst 38h +3fd0 ff rst 38h +3fd1 ff rst 38h +3fd2 ff rst 38h +3fd3 ff rst 38h +3fd4 ff rst 38h +3fd5 ff rst 38h +3fd6 ff rst 38h +3fd7 ff rst 38h +3fd8 ff rst 38h +3fd9 ff rst 38h +3fda ff rst 38h +3fdb ff rst 38h +3fdc ff rst 38h +3fdd ff rst 38h +3fde ff rst 38h +3fdf ff rst 38h +3fe0 ff rst 38h +3fe1 ff rst 38h +3fe2 ff rst 38h +3fe3 ff rst 38h +3fe4 ff rst 38h +3fe5 ff rst 38h +3fe6 ff rst 38h +3fe7 ff rst 38h +3fe8 ff rst 38h +3fe9 ff rst 38h +3fea ff rst 38h +3feb ff rst 38h +3fec ff rst 38h +3fed ff rst 38h +3fee ff rst 38h +3fef ff rst 38h +3ff0 ff rst 38h +3ff1 ff rst 38h +3ff2 ff rst 38h +3ff3 ff rst 38h +3ff4 ff rst 38h +3ff5 ff rst 38h +3ff6 ff rst 38h +3ff7 ff rst 38h +3ff8 ff rst 38h +3ff9 ff rst 38h +3ffa ff rst 38h +3ffb ff rst 38h +3ffc ff rst 38h +3ffd ff rst 38h +3ffe ff rst 38h +3fff ff rst 38h + + + + + + + + + + +; ---------------------------------------------------------------------------------------- +; this code is in the last 2000h bytes in ROM1, the BASIC pages it at position $2000 +; ---------------------------------------------------------------------------------------- + + +;1ffd c1 pop bc +;1ffe b1 or c +1fff 2003 jr nz,2004h ; --------------- ROM bank ---------------- +2001 2a13fe ld hl,(0fe13h) ; NXTOPR: Next operand, addr of decimal point in PBUF, etc.. +2004 83 add a,e +2005 3d dec a +2006 f4d320 call p,20d3h +2009 50 ld d,b +200a c3291f jp 1f29h + + +200d e5 push hl +200e d5 push de +200f cd3619 call 1936h +2012 d1 pop de +2013 af xor a +2014 ca1a20 jp z,201ah +2017 1e10 ld e,10h +2019 011e06 ld bc,061eh +201c cdbf17 call 17bfh ; TSTSGN - Test sign of FPREG +201f 37 scf +2020 c46b20 call nz,206bh +2023 e1 pop hl +2024 c1 pop bc +2025 f5 push af +2026 79 ld a,c +2027 b7 or a +2028 f5 push af +2029 c4801d call nz,1d80h +202c 80 add a,b +202d 4f ld c,a +202e 7a ld a,d +202f e604 and 04h +2031 fe01 cp 01h +2033 9f sbc a,a +2034 57 ld d,a +2035 81 add a,c +2036 4f ld c,a +2037 93 sub e +2038 f5 push af +2039 c5 push bc +203a fc821d call m,1d82h +203d fa3a20 jp m,203ah +2040 c1 pop bc +2041 f1 pop af +2042 c5 push bc +2043 f5 push af +2044 fa4820 jp m,2048h +2047 af xor a +2048 2f cpl +2049 3c inc a +204a 80 add a,b +204b 3c inc a +204c 82 add a,d +204d 47 ld b,a +204e 0e00 ld c,00h +2050 cd0e21 call 210eh +2053 f1 pop af +2054 f4db20 call p,20dbh +2057 c1 pop bc +2058 f1 pop af +2059 cc9917 call z,1799h +205c f1 pop af +205d 3803 jr c,2062h +205f 83 add a,e +2060 90 sub b +2061 92 sub d +2062 c5 push bc +2063 cdde1e call 1edeh +2066 eb ex de,hl +2067 d1 pop de +2068 c3291f jp 1f29h + + +206b d5 push de +206c af xor a +206d f5 push af +206e e7 rst 20h ; GETYPR - Get the number type (FAC) +206f e28c20 jp po,208ch +2072 3a44fe ld a,(0fe44h) ; FPEXP - Floating Point Exponent +2075 fe91 cp 91h +2077 d28c20 jp nc,208ch +207a 11ce21 ld de,21ceh +207d 2147fe ld hl,0fe47h ; ARG +2080 cd3d18 call 183dh ; FP2HL - Copy number value from DE to HL +2083 cd0b1c call 1c0bh ; DBL_MUL Double precision MULTIPLY +2086 f1 pop af +2087 d60a sub 0ah +2089 f5 push af +208a 18e6 jr 2072h + +208c cdb920 call 20b9h +208f e7 rst 20h ; GETYPR - Get the number type (FAC) +2090 300b jr nc,209dh +2092 014391 ld bc,9143h +2095 11f94f ld de,4ff9h +2098 cd7618 call 1876h ; CMPNUM - Compare FP reg to BCDE +209b 1806 jr 20a3h + +209d 11d621 ld de,21d6h +20a0 cdb318 call 18b3h +20a3 f2b520 jp p,20b5h +20a6 f1 pop af +20a7 cd751d call 1d75h +20aa f5 push af +20ab 18e2 jr 208fh + +20ad f1 pop af +20ae cd821d call 1d82h +20b1 f5 push af +20b2 cdb920 call 20b9h +20b5 f1 pop af +20b6 b7 or a +20b7 d1 pop de +20b8 c9 ret + +20b9 e7 rst 20h ; GETYPR - Get the number type (FAC) +20ba eac820 jp pe,20c8h +20bd 017494 ld bc,9474h +20c0 11f823 ld de,23f8h +20c3 cd7618 call 1876h ; CMPNUM - Compare FP reg to BCDE +20c6 1806 jr 20ceh + +20c8 11de21 ld de,21deh +20cb cdb318 call 18b3h +20ce e1 pop hl +20cf f2ad20 jp p,20adh +20d2 e9 jp (hl) + +20d3 b7 or a +20d4 c8 ret z +20d5 3d dec a +20d6 3630 ld (hl),30h +20d8 23 inc hl +20d9 18f9 jr 20d4h + +20db 2004 jr nz,20e1h +20dd c8 ret z +20de cdfb20 call 20fbh +20e1 3630 ld (hl),30h +20e3 23 inc hl +20e4 3d dec a +20e5 18f6 jr 20ddh + +20e7 7b ld a,e +20e8 82 add a,d +20e9 3c inc a +20ea 47 ld b,a +20eb 3c inc a +20ec d603 sub 03h +20ee 30fc jr nc,20ech +20f0 c605 add a,05h +20f2 4f ld c,a +20f3 3af8fd ld a,(0fdf8h) ; 1: Index of last byte executed in current statement- 2: Edit flag during print using +20f6 e640 and 40h +20f8 c0 ret nz +20f9 4f ld c,a +20fa c9 ret + +20fb 05 dec b +20fc 2008 jr nz,2106h +20fe 362e ld (hl),2eh ; '*' +2100 2213fe ld (0fe13h),hl ; NXTOPR: Next operand, addr of decimal point in PBUF, etc.. +2103 23 inc hl +2104 48 ld c,b +2105 c9 ret + +2106 0d dec c +2107 c0 ret nz +2108 362c ld (hl),2ch +210a 23 inc hl +210b 0e03 ld c,03h +210d c9 ret + +210e d5 push de +210f e7 rst 20h ; GETYPR - Get the number type (FAC) +2110 e25421 jp po,2154h +2113 c5 push bc +2114 e5 push hl +2115 cd6618 call 1866h ; FP_ARG2HL +2118 21e621 ld hl,21e6h +211b cd6118 call 1861h +211e cde11a call 1ae1h ; DBL_ADD - Double precision ADD (formerly FPADD) +2121 af xor a +2122 cde519 call 19e5h +2125 e1 pop hl +2126 c1 pop bc +2127 11f621 ld de,21f6h +212a 3e0a ld a,0ah +212c cdfb20 call 20fbh +212f c5 push bc +2130 f5 push af +2131 e5 push hl +2132 d5 push de +2133 062f ld b,2fh +2135 04 inc b +2136 e1 pop hl +2137 e5 push hl +2138 cdb21b call 1bb2h +213b 30f8 jr nc,2135h +213d e1 pop hl +213e cda01b call 1ba0h +2141 eb ex de,hl +2142 e1 pop hl +2143 70 ld (hl),b +2144 23 inc hl +2145 f1 pop af +2146 c1 pop bc +2147 3d dec a +2148 20e2 jr nz,212ch +214a c5 push bc +214b e5 push hl +214c 213dfe ld hl,0fe3dh +214f cd1b18 call 181bh ; PHLTFP - Move a single precision value -> HL to FPREG +2152 180c jr 2160h + + +2154 c5 push bc +2155 e5 push hl +2156 cd7215 call 1572h +2159 3c inc a +215a cd6519 call 1965h ; FPINT - Floating Point to Integer +215d cd1e18 call 181eh ; FPBCDE: Move single precision value in BC/DE into FPREG +2160 e1 pop hl +2161 c1 pop bc +2162 af xor a +2163 113c22 ld de,223ch +2166 3f ccf +2167 cdfb20 call 20fbh +216a c5 push bc +216b f5 push af +216c e5 push hl +216d d5 push de +216e cd2918 call 1829h ; BCDEFP: Load a single precision value from FPREG into BC/DE +2171 e1 pop hl +2172 062f ld b,2fh +2174 04 inc b +2175 7b ld a,e +2176 96 sub (hl) +2177 5f ld e,a +2178 23 inc hl +2179 7a ld a,d +217a 9e sbc a,(hl) +217b 57 ld d,a +217c 23 inc hl +217d 79 ld a,c +217e 9e sbc a,(hl) +217f 4f ld c,a +2180 2b dec hl +2181 2b dec hl +2182 30f0 jr nc,2174h +2184 cd2116 call 1621h ; PLUCDE - Add number pointed by HL to CDE +2187 23 inc hl +2188 cd1e18 call 181eh ; FPBCDE: Move single precision value in BC/DE into FPREG +218b eb ex de,hl +218c e1 pop hl +218d 70 ld (hl),b +218e 23 inc hl +218f f1 pop af +2190 c1 pop bc +2191 38d3 jr c,2166h +2193 13 inc de +2194 13 inc de +2195 3e04 ld a,04h +2197 1806 jr 219fh + + +2199 d5 push de +219a 114222 ld de,2242h +219d 3e05 ld a,05h +219f cdfb20 call 20fbh +21a2 c5 push bc +21a3 f5 push af +21a4 e5 push hl +21a5 eb ex de,hl +21a6 4e ld c,(hl) +21a7 23 inc hl +21a8 46 ld b,(hl) +21a9 c5 push bc +21aa 23 inc hl +21ab e3 ex (sp),hl +21ac eb ex de,hl +21ad 2a41fe ld hl,(0fe41h) ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +21b0 062f ld b,2fh +21b2 04 inc b +21b3 7d ld a,l +21b4 93 sub e +21b5 6f ld l,a +21b6 7c ld a,h +21b7 9a sbc a,d +21b8 67 ld h,a +21b9 30f7 jr nc,21b2h +21bb 19 add hl,de +21bc 2241fe ld (0fe41h),hl ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +21bf d1 pop de +21c0 e1 pop hl +21c1 70 ld (hl),b +21c2 23 inc hl +21c3 f1 pop af +21c4 c1 pop bc +21c5 3d dec a +21c6 20d7 jr nz,219fh +21c8 cdfb20 call 20fbh +21cb 77 ld (hl),a +21cc d1 pop de +21cd c9 ret + +21ce 00 nop +21cf 00 nop +21d0 00 nop +21d1 00 nop +21d2 f9 ld sp,hl +21d3 02 ld (bc),a +21d4 15 dec d +21d5 a2 and d +21d6 fdff rst 38h +21d8 9f sbc a,a +21d9 31a95f ld sp,5fa9h +21dc 63 ld h,e +21dd b2 or d +21de feff cp 0ffh +21e0 03 inc bc +21e1 bf cp a +21e2 c9 ret + +21e3 1b dec de +21e4 0eb6 ld c,0b6h +21e6 00 nop +21e7 00 nop +21e8 00 nop +21e9 00 nop + +; HALF: Constant for 0.5 in FP +21ea 00 nop +21eb 00 nop +21ec 00 nop +21ed 80 add a,b +21ee 00 nop +21ef 00 nop +21f0 04 inc b +21f1 bf cp a +21f2 c9 ret + +21f3 1b dec de +21f4 0eb6 ld c,0b6h +21f6 00 nop +21f7 80 add a,b +21f8 c6a4 add a,0a4h +21fa 7e ld a,(hl) +21fb 8d adc a,l +21fc 03 inc bc +21fd 00 nop +21fe 40 ld b,b +21ff 7a ld a,d +2200 10f3 djnz 21f5h +2202 5a ld e,d +2203 00 nop +2204 00 nop +2205 a0 and b +2206 72 ld (hl),d +2207 4e ld c,(hl) +2208 1809 jr 2213h + + +220a 00 nop +220b 00 nop +220c 10a5 djnz 21b3h +220e d4e800 call nc,00e8h +2211 00 nop +2212 00 nop +2213 e8 ret pe +2214 76 halt +2215 48 ld c,b +2216 17 rla +2217 00 nop +2218 00 nop +2219 00 nop +221a e40b54 call po,540bh +221d 02 ld (bc),a +221e 00 nop +221f 00 nop +2220 00 nop +2221 ca9a3b jp z,3b9ah +2224 00 nop +2225 00 nop +2226 00 nop +2227 00 nop +2228 e1 pop hl +2229 f5 push af +222a 05 dec b +222b 00 nop +222c 00 nop +222d 00 nop +222e 80 add a,b +222f 96 sub (hl) +2230 98 sbc a,b +2231 00 nop +2232 00 nop +2233 00 nop +2234 00 nop +2235 40 ld b,b +2236 42 ld b,d +2237 0f rrca +2238 00 nop +2239 00 nop +223a 00 nop +223b 00 nop +223c a0 and b +223d 86 add a,(hl) +223e 011027 ld bc,2710h +2241 00 nop +2242 1027 djnz 226bh +2244 e8 ret pe +2245 03 inc bc +2246 64 ld h,h +2247 00 nop +2248 0a ld a,(bc) +2249 00 nop +224a 010021 ld bc,2100h +224d ec17e3 call pe,0e317h +2250 e9 jp (hl) + +; SQR +2251 cd0e18 call 180eh ; STAKFP: Move FPREG to stack +2254 21ea21 ld hl,21eah ; HALF: Constant ptr for 0.5 in FP +2257 cd1b18 call 181bh ; PHLTFP - Move a single precision value -> HL to FPREG +225a 1803 jr 225fh + +; POWER +225c cd1b19 call 191bh ; __CSNG: Integer to single precision +225f c1 pop bc +2260 d1 pop de +2261 cdbf17 call 17bfh ; TSTSGN - Test sign of FPREG +2264 78 ld a,b +2265 283c jr z,22a3h ; EXP +2267 f26e22 jp p,226eh +226a b7 or a +226b ca8428 jp z,2884h ; ?UL Error +226e b7 or a +226f cae315 jp z,15e3h +2272 d5 push de +2273 c5 push bc +2274 79 ld a,c +2275 f67f or 7fh +2277 cd2918 call 1829h ; BCDEFP: Load a single precision value from FPREG into BC/DE +227a f28b22 jp p,228bh +227d d5 push de +227e c5 push bc +227f cdaa19 call 19aah ; INT +2282 c1 pop bc +2283 d1 pop de +2284 f5 push af +2285 cd7618 call 1876h ; CMPNUM - Compare FP reg to BCDE +2288 e1 pop hl +2289 7c ld a,h +228a 1f rra +228b e1 pop hl +228c 2243fe ld (0fe43h),hl ; LAST-FPREG - Last byte in Single Precision FP Register (+sign bit) +228f e1 pop hl +2290 2241fe ld (0fe41h),hl ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +2293 dc4c22 call c,224ch ; NEGAFT - Negate number +2296 ccec17 call z,17ech ; INVSGN - Invert number sign +2299 d5 push de +229a c5 push bc +229b cd7316 call 1673h ; LOG +229e c1 pop bc +229f d1 pop de +22a0 cdb116 call 16b1h ; FPMULT - Single precision multiply (Multiply BCDE to FP reg) + +; EXP +22a3 cd0e18 call 180eh ; STAKFP: Move FPREG to stack +22a6 013881 ld bc,8138h +22a9 113baa ld de,0aa3bh +22ac cdb116 call 16b1h ; FPMULT - Single precision multiply (Multiply BCDE to FP reg) +22af 3a44fe ld a,(0fe44h) ; FPEXP - Floating Point Exponent +22b2 fe88 cp 88h +22b4 d29b17 jp nc,179bh +22b7 cdaa19 call 19aah ; INT +22ba c680 add a,80h +22bc c602 add a,02h +22be da9b17 jp c,179bh +22c1 f5 push af +22c2 216216 ld hl,1662h ; UNITY - Constant ptr for number 1 in FP +22c5 cd7515 call 1575h ; ADDPHL - ADD number at HL to BCDE +22c8 cdab16 call 16abh +22cb f1 pop af +22cc c1 pop bc +22cd d1 pop de +22ce f5 push af +22cf cd7d15 call 157dh ; SUBCDE - Single precision subtract (Subtract BCDE from FP reg) +22d2 cdec17 call 17ech ; INVSGN - Invert number sign +22d5 21e322 ld hl,22e3h +22d8 cd1323 call 2313h +22db 110000 ld de,0000h +22de c1 pop bc +22df 4a ld c,d +22e0 c3b116 jp 16b1h ; FPMULT - Single precision multiply (Multiply BCDE to FP reg) + +22e3 08 ex af,af' +22e4 40 ld b,b +22e5 2e94 ld l,94h +22e7 74 ld (hl),h +22e8 70 ld (hl),b +22e9 4f ld c,a +22ea 2e77 ld l,77h +22ec 6e ld l,(hl) +22ed 02 ld (bc),a +22ee 88 adc a,b +22ef 7a ld a,d +22f0 e6a0 and 0a0h +22f2 2a7c50 ld hl,(507ch) +22f5 aa xor d +22f6 aa xor d +22f7 7e ld a,(hl) +22f8 ff rst 38h +22f9 ff rst 38h +22fa 7f ld a,a +22fb 7f ld a,a +22fc 00 nop +22fd 00 nop +22fe 80 add a,b +22ff 81 add a,c +2300 00 nop +2301 00 nop +2302 00 nop +2303 81 add a,c + +; SUMSER - Evaluate sum of series +2304 cd0e18 call 180eh ; STAKFP: Move FPREG to stack +2307 119c1a ld de,1a9ch +230a d5 push de +230b e5 push hl +230c cd2918 call 1829h ; BCDEFP: Load a single precision value from FPREG into BC/DE +230f cdb116 call 16b1h ; FPMULT - Single precision multiply (Multiply BCDE to FP reg) +2312 e1 pop hl +2313 cd0e18 call 180eh ; STAKFP: Move FPREG to stack +2316 7e ld a,(hl) +2317 23 inc hl +2318 cd1b18 call 181bh ; PHLTFP - Move a single precision value -> HL to FPREG +231b 06f1 ld b,0f1h +231d c1 pop bc +231e d1 pop de +231f 3d dec a +2320 c8 ret z +2321 d5 push de +2322 c5 push bc +2323 f5 push af +2324 e5 push hl +2325 cdb116 call 16b1h ; FPMULT - Single precision multiply (Multiply BCDE to FP reg) +2328 e1 pop hl +2329 cd2c18 call 182ch ; LOADFP: Load single precision value pointed by (HL) into BC/DE +232c e5 push hl +232d cd8015 call 1580h ; FPADD - Single precision add (Add BCDE to FP reg) +2330 e1 pop hl +2331 18e9 jr 231ch + +2333 cde918 call 18e9h ; __CINT: Floating point to Integer +2336 7c ld a,h +2337 b7 or a +2338 fa352d jp m,2d35h ; Error: Illegal function call (FC ERROR) +233b b5 or l +233c ca5a23 jp z,235ah +233f e5 push hl +2340 cd5a23 call 235ah +2343 cd2918 call 1829h ; BCDEFP: Load a single precision value from FPREG into BC/DE +2346 eb ex de,hl +2347 e3 ex (sp),hl +2348 c5 push bc +2349 cd3919 call 1939h +234c c1 pop bc +234d d1 pop de +234e cdb116 call 16b1h ; FPMULT - Single precision multiply (Multiply BCDE to FP reg) +2351 216216 ld hl,1662h ; UNITY - Constant ptr for number 1 in FP +2354 cd7515 call 1575h ; ADDPHL - ADD number at HL to BCDE +2357 c3aa19 jp 19aah ; INT + +235a 2144fc ld hl,0fc44h +235d e5 push hl +235e 110000 ld de,0000h +2361 4b ld c,e +2362 2603 ld h,03h +2364 2e08 ld l,08h +2366 eb ex de,hl +2367 29 add hl,hl +2368 eb ex de,hl +2369 79 ld a,c +236a 17 rla +236b 4f ld c,a +236c e3 ex (sp),hl +236d 7e ld a,(hl) +236e 07 rlca +236f 77 ld (hl),a +2370 e3 ex (sp),hl +2371 d28023 jp nc,2380h +2374 e5 push hl +2375 2acafd ld hl,(0fdcah) ; Random number seeds +2378 19 add hl,de +2379 eb ex de,hl +237a 3accfd ld a,(0fdcch) +237d 89 adc a,c +237e 4f ld c,a +237f e1 pop hl +2380 2d dec l +2381 c26623 jp nz,2366h +2384 e3 ex (sp),hl +2385 23 inc hl +2386 e3 ex (sp),hl +2387 25 dec h +2388 c26423 jp nz,2364h +238b e1 pop hl +238c 2165b0 ld hl,0b065h +238f 19 add hl,de +2390 22cafd ld (0fdcah),hl ; Random number seeds +2393 cd5919 call 1959h ; SETTYPE_INT +2396 3e05 ld a,05h +2398 89 adc a,c +2399 32ccfd ld (0fdcch),a +239c eb ex de,hl +239d 0680 ld b,80h +239f 2145fe ld hl,0fe45h ; SGNRES - Sign of result +23a2 70 ld (hl),b +23a3 2b dec hl +23a4 70 ld (hl),b +23a5 4f ld c,a +23a6 0600 ld b,00h +23a8 c3cf15 jp 15cfh + +; COS - Cosine +23ab 21f523 ld hl,23f5h ; HALFPI: ptr to PI/2 constant +23ae cd7515 call 1575h ; ADDPHL - ADD number at HL to BCDE +; SIN - Sine +23b1 cd0e18 call 180eh ; STAKFP: Move FPREG to stack +23b4 014983 ld bc,8349h +23b7 11db0f ld de,0fdbh +23ba cd1e18 call 181eh ; FPBCDE: Move single precision value in BC/DE into FPREG +23bd c1 pop bc +23be d1 pop de +23bf cd0c17 call 170ch ; DVBCDE - Divide FP by BCDE +23c2 cd0e18 call 180eh ; STAKFP: Move FPREG to stack +23c5 cdaa19 call 19aah ; INT +23c8 c1 pop bc +23c9 d1 pop de +23ca cd7d15 call 157dh ; SUBCDE - Single precision subtract (Subtract BCDE from FP reg) +23cd 21f923 ld hl,23f9h +23d0 cd7a15 call 157ah ; SUBPHL - SUBTRACT number at HL from BCDE +23d3 cdbf17 call 17bfh ; TSTSGN - Test sign of FPREG +23d6 37 scf +23d7 f2e123 jp p,23e1h +23da cd7215 call 1572h +23dd cdbf17 call 17bfh ; TSTSGN - Test sign of FPREG +23e0 b7 or a +23e1 f5 push af +23e2 f4ec17 call p,17ech ; INVSGN - Invert number sign +23e5 21f923 ld hl,23f9h +23e8 cd7515 call 1575h ; ADDPHL - ADD number at HL to BCDE +23eb f1 pop af +23ec d4ec17 call nc,17ech ; INVSGN - Invert number sign +23ef 21fd23 ld hl,23fdh +23f2 c30423 jp 2304h ; SUMSER - Evaluate sum of series + + +; HALFPI: PI/2 constant +23f5 db0f in a,(0fh) +23f7 49 ld c,c +23f8 81 add a,c +23f9 00 nop +23fa 00 nop +23fb 00 nop +23fc 7f ld a,a +23fd 05 dec b +23fe ba cp d +23ff d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +2400 1e86 ld e,86h +2402 64 ld h,h +2403 2699 ld h,99h +2405 87 add a,a +2406 58 ld e,b +2407 34 inc (hl) +2408 23 inc hl +2409 87 add a,a +240a e0 ret po +240b 5d ld e,l +240c a5 and l +240d 86 add a,(hl) +240e da0f49 jp c,490fh +2411 83 add a,e + +; TAN - Tangent +2412 cd0e18 call 180eh ; STAKFP: Move FPREG to stack +2415 cdb123 call 23b1h ; SIN - Sine +2418 c1 pop bc +2419 e1 pop hl +241a cd0e18 call 180eh ; STAKFP: Move FPREG to stack +241d eb ex de,hl +241e cd1e18 call 181eh ; FPBCDE: Move single precision value in BC/DE into FPREG +2421 cdab23 call 23abh ; COS - Cosine +2424 c30a17 jp 170ah ; DIV - Divide FP by number on stack + +; ATN - Arctangent +2427 cdbf17 call 17bfh ; TSTSGN - Test sign of FPREG +242a fc4c22 call m,224ch ; NEGAFT - Negate number +242d fcec17 call m,17ech ; INVSGN - Invert number sign +2430 3a44fe ld a,(0fe44h) ; FPEXP - Floating Point Exponent +2433 fe81 cp 81h +2435 380c jr c,2443h +2437 010081 ld bc,8100h +243a 51 ld d,c +243b 59 ld e,c +243c cd0c17 call 170ch ; DVBCDE - Divide FP by BCDE +243f 217a15 ld hl,157ah ; SUBPHL - SUBTRACT number at HL from BCDE +2442 e5 push hl +2443 214d24 ld hl,244dh +2446 cd0423 call 2304h ; SUMSER - Evaluate sum of series +2449 21f523 ld hl,23f5h ; HALFPI: ptr to PI/2 constant +244c c9 ret + +244d 09 add hl,bc +244e 4a ld c,d +244f d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +2450 3b dec sp +2451 78 ld a,b +2452 02 ld (bc),a +2453 6e ld l,(hl) +2454 84 add a,h +2455 7b ld a,e +2456 fec1 cp 0c1h +2458 2f cpl +2459 7c ld a,h +245a 74 ld (hl),h +245b 319a7d ld sp,7d9ah +245e 84 add a,h +245f 3d dec a +2460 5a ld e,d +2461 7d ld a,l +2462 c8 ret z +2463 7f ld a,a +2464 91 sub c +2465 7e ld a,(hl) +2466 e4bb4c call po,4cbbh +2469 7e ld a,(hl) +246a 6c ld l,h +246b aa xor d +246c aa xor d +246d 7f ld a,a +246e 00 nop +246f 00 nop +2470 00 nop +2471 81 add a,c + + +; Code to be relocated at FBC0h (004eh bytes) + +; ->FBC0h (RST 8 jumps here) +2472 c3802b jp 2b80h + +; ->FBC3h (RST 10h jumps here) +2475 c3622c jp 2c62h ; _CHRGTB - Pick next char from program + +; ->FBC6h (RST 18h jumps here) +2478 c37a2b jp 2b7ah ; -> CPDEHL - compare DE and HL (aka DCOMPR) + +; ->FBC9h (RST 20h jumps here) +247b c3cd34 jp 34cdh ; GETYPR - Get the number type (FAC) + +; ->FBCCh (RST 28h jumps here) +247e c9 ret +247f 00 nop +2480 00 nop + +; ->FBCFh (RST 30h jumps here) +2481 c9 ret +2482 00 nop +2483 00 nop + +; ->FBD2h (RST 38h jumps here) +2484 f3 di ; Interrupt exit - initialised to a return +2485 c9 ret +2486 00 nop + + +2487 010000 ld bc,0000h +248a 00 nop +248b 00 nop +248c 34 inc (hl) +248d 1c inc e +248e 00 nop + +; -> FBDDh +248f 00 nop ; CURSOR POSITION relative to upper L.H. corner +2490 00 nop + +; -> FBDFh +2491 00 nop ; CRTC value for "display start address" +2492 00 nop + +; -> FBE1h +2493 00 nop ; MAXIMUM No. CHARACTERS ALLOWED ON SCREEN +2494 00 nop + + +2495 01f006 ld bc,06f0h +2498 00 nop +2499 00 nop +249a 43 ld b,e +249b 00 nop +249c 00 nop +249d 00 nop +249e 00 nop + +249f c30000 jp 0000h + + +24a2 c30000 jp 0000h + + +24a5 3e00 ld a,00h +24a7 c9 ret + +24a8 c9 ret + +24a9 00 nop +24aa 00 nop +24ab c9 ret + +24ac 00 nop +24ad 00 nop +24ae c9 ret + +24af 00 nop +24b0 00 nop +24b1 c9 ret + +24b2 00 nop +24b3 00 nop +24b4 c9 ret + +24b5 00 nop +24b6 00 nop +24b7 c9 ret + +24b8 00 nop +24b9 00 nop +24ba c9 ret + +24bb 00 nop +24bc 00 nop +24bd c9 ret + +24be 00 nop +24bf 00 nop +24c0 00 nop +24c1 00 nop +24c2 00 nop +24c3 00 nop +24c4 00 nop +24c5 00 nop +24c6 00 nop +24c7 00 nop +24c8 00 nop +24c9 00 nop +24ca 00 nop +24cb 00 nop +24cc 00 nop +24cd 00 nop +24ce 00 nop +24cf 00 nop +24d0 00 nop +24d1 00 nop +24d2 00 nop +24d3 00 nop +24d4 00 nop +24d5 00 nop +24d6 00 nop +24d7 00 nop +24d8 00 nop +24d9 00 nop +24da 00 nop +24db 00 nop +24dc 00 nop +24dd 00 nop +24de 00 nop +24df 00 nop +24e0 00 nop +24e1 00 nop +24e2 00 nop +24e3 00 nop +24e4 00 nop +24e5 00 nop + + + +; # JP table for functions = $24E6 +;24e6 f417a1 call p,0a117h +;24e9 19 add hl,de +;24ea e1 pop hl +;(..) + +# -- FUNCTIONS -- + +$17F4 - [215] SGN +$19A1 - [216] INT +$17E1 - [217] ABS +$36C8 - [218] FRE +$39E3 - [219] INP +$36E9 - [220] POS +$2251 - [221] SQR +$2333 - [222] RND +$1673 - [223] LOG +$22A3 - [224] EXP +$23AB - [225] COS +$23B1 - [226] SIN +$2412 - [227] TAN +$2427 - [228] ATN +$3BA8 - [229] PEEK +$3F14 - [230] VPEEK +$FE78 - [231] PEN +$3F1C - [232] WPK +$FE81 - [233] EOF +$FE84 - [234] JSK +$3F2C - [235] JUMP +$3F32 - [236] DEG +$3F18 - [237] MPK$ +$3F36 - [238] RAD +$18E9 - [239] CINT +$191B - [240] CSNG +$1945 - [241] CDBL +$1990 - [242] FIX +$38F7 - [243] LEN +$372A - [244] STR$ +$39B9 - [245] VAL +$3903 - [246] ASC +$3913 - [247] CHR$ +$3955 - [248] LEFT$ +$3985 - [249] RIGHT$ +$398E - [250] MID$ +;($4EC5 - [251] ') + +;252a 85 add a,l +;252b 39 add hl,sp + +;252c 8e adc a,(hl) +;252d 39 add hl,sp + +; TOKEN table position (in the ROM file it is shifted to $452e) +252e c5 push bc +252f 4e ld c,(hl) +2530 44 ld b,h +2531 c64f add a,4fh +2533 52 ld d,d +2534 d24553 jp nc,5345h +2537 45 ld b,l +2538 54 ld d,h +2539 d345 out (45h),a +253b 54 ld d,h +253c c34c53 jp 534ch + +253f c34d44 jp 444dh + +2542 d2414e jp nc,4e41h +2545 44 ld b,h +2546 4f ld c,a +2547 4d ld c,l +2548 ce45 adc a,45h +254a 58 ld e,b +254b 54 ld d,h +254c c44154 call nz,5441h +254f 41 ld b,c +2550 c9 ret + +2551 4e ld c,(hl) +2552 50 ld d,b +2553 55 ld d,l +2554 54 ld d,h +2555 c4494d call nz,4d49h +2558 d24541 jp nc,4145h +255b 44 ld b,h +255c cc4554 call z,5445h +255f c7 rst 00h +2560 4f ld c,a +2561 54 ld d,h +2562 4f ld c,a +2563 d2554e jp nc,4e55h +2566 c9 ret + +2567 46 ld b,(hl) +2568 d24553 jp nc,5345h +256b 54 ld d,h +256c 4f ld c,a +256d 52 ld d,d +256e 45 ld b,l +256f c7 rst 00h +2570 4f ld c,a +2571 53 ld d,e +2572 55 ld d,l +2573 42 ld b,d +2574 d24554 jp nc,5445h +2577 55 ld d,l +2578 52 ld d,d +2579 4e ld c,(hl) +257a d2454d jp nc,4d45h +257d d354 out (54h),a +257f 4f ld c,a +2580 50 ld d,b +2581 c5 push bc +2582 4c ld c,h +2583 53 ld d,e +2584 45 ld b,l +2585 d4524f call nc,4f52h +2588 4e ld c,(hl) +2589 d4524f call nc,4f52h +258c 46 ld b,(hl) +258d 46 ld b,(hl) +258e c44546 call nz,4645h +2591 53 ld d,e +2592 54 ld d,h +2593 52 ld d,d +2594 c44546 call nz,4645h +2597 49 ld c,c +2598 4e ld c,(hl) +2599 54 ld d,h +259a c44546 call nz,4645h +259d 53 ld d,e +259e 4e ld c,(hl) +259f 47 ld b,a +25a0 c44546 call nz,4645h +25a3 44 ld b,h +25a4 42 ld b,d +25a5 4c ld c,h +25a6 d0 ret nc +25a7 43 ld b,e +25a8 47 ld b,a +25a9 45 ld b,l +25aa 4e ld c,(hl) +25ab c5 push bc +25ac 44 ld b,h +25ad 49 ld c,c +25ae 54 ld d,h +25af c5 push bc +25b0 52 ld d,d +25b1 52 ld d,d +25b2 4f ld c,a +25b3 52 ld d,d +25b4 d24553 jp nc,5345h +25b7 55 ld d,l +25b8 4d ld c,l +25b9 45 ld b,l +25ba cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +25bb 55 ld d,l +25bc 54 ld d,h +25bd cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +25be 4e ld c,(hl) +25bf cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +25c0 50 ld d,b +25c1 45 ld b,l +25c2 4e ld c,(hl) +25c3 c34f4c jp 4c4fh + +25c6 4f ld c,a +25c7 55 ld d,l +25c8 52 ld d,d +25c9 d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +25ca 52 ld d,d +25cb 49 ld c,c +25cc 54 ld d,h +25cd 45 ld b,l +25ce 23 inc hl +25cf c34c4f jp 4f4ch + +25d2 53 ld d,e +25d3 45 ld b,l +25d4 cc4f41 call z,414fh +25d7 44 ld b,h +25d8 d341 out (41h),a +25da 56 ld d,(hl) +25db 45 ld b,l +25dc cb49 bit 1,c +25de 4c ld c,h +25df 4c ld c,h +25e0 c34952 jp 5249h + + +25e3 43 ld b,e +25e4 4c ld c,h +25e5 45 ld b,l +25e6 cc494e call z,4e49h +25e9 45 ld b,l +25ea d34f out (4fh),a +25ec 55 ld d,l +25ed 4e ld c,(hl) +25ee 44 ld b,h +25ef c8 ret z +25f0 47 ld b,a +25f1 52 ld d,d +25f2 d650 sub 50h +25f4 4f ld c,a +25f5 4b ld c,e +25f6 45 ld b,l +25f7 d359 out (59h),a +25f9 53 ld d,e +25fa 54 ld d,h +25fb 45 ld b,l +25fc 4d ld c,l +25fd cc5052 call z,5250h +2600 49 ld c,c +2601 4e ld c,(hl) +2602 54 ld d,h +2603 c44546 call nz,4645h +2606 d0 ret nc +2607 4f ld c,a +2608 4b ld c,e +2609 45 ld b,l +260a d0 ret nc +260b 52 ld d,d +260c 49 ld c,c +260d 4e ld c,(hl) +260e 54 ld d,h +260f c34f4e jp 4e4fh + +2612 54 ld d,h +2613 cc4953 call z,5349h +2616 54 ld d,h +2617 cc4c49 call z,494ch +261a 53 ld d,e +261b 54 ld d,h +261c c4454c call nz,4c45h +261f 45 ld b,l +2620 54 ld d,h +2621 45 ld b,l +2622 c1 pop bc +2623 55 ld d,l +2624 54 ld d,h +2625 4f ld c,a +2626 c34c45 jp 454ch + +2629 41 ld b,c +262a 52 ld d,d +262b c34c4f jp 4f4ch + +262e 41 ld b,c +262f 44 ld b,h +2630 c35341 jp 4153h + + +2633 56 ld d,(hl) +2634 45 ld b,l +2635 ce45 adc a,45h +2637 57 ld d,a +2638 d44142 call nc,4241h +263b 28d4 jr z,2611h +263d 4f ld c,a +263e c64e add a,4eh +2640 d5 push de +2641 53 ld d,e +2642 49 ld c,c +2643 4e ld c,(hl) +2644 47 ld b,a +2645 d641 sub 41h +2647 52 ld d,d +2648 50 ld d,b +2649 54 ld d,h +264a 52 ld d,d +264b d5 push de +264c 53 ld d,e +264d 52 ld d,d +264e c5 push bc +264f 52 ld d,d +2650 4c ld c,h +2651 c5 push bc +2652 52 ld d,d +2653 52 ld d,d +2654 d354 out (54h),a +2656 52 ld d,d +2657 49 ld c,c +2658 4e ld c,(hl) +2659 47 ld b,a +265a 24 inc h +265b c9 ret + +265c 4e ld c,(hl) +265d 53 ld d,e +265e 54 ld d,h +265f 52 ld d,d +2660 d0 ret nc +2661 4f ld c,a +2662 49 ld c,c +2663 4e ld c,(hl) +2664 54 ld d,h +2665 d4494d call nc,4d49h +2668 45 ld b,l +2669 24 inc h +266a cd454d call 4d45h +266d c9 ret + +266e 4e ld c,(hl) +266f 4b ld c,e +2670 45 ld b,l +2671 59 ld e,c +2672 24 inc h +2673 d44845 call nc,4548h +2676 4e ld c,(hl) +2677 ce4f adc a,4fh +2679 54 ld d,h +267a d354 out (54h),a +267c 45 ld b,l +267d 50 ld d,b +267e ab xor e +267f ad xor l +2680 aa xor d +2681 af xor a +2682 dec1 sbc a,0c1h +2684 4e ld c,(hl) +2685 44 ld b,h +2686 cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +2687 52 ld d,d +2688 be cp (hl) +2689 bd cp l +268a bc cp h +268b d347 out (47h),a +268d 4e ld c,(hl) +268e c9 ret + +268f 4e ld c,(hl) +2690 54 ld d,h +2691 c1 pop bc +2692 42 ld b,d +2693 53 ld d,e +2694 c652 add a,52h +2696 45 ld b,l +2697 c9 ret + +2698 4e ld c,(hl) +2699 50 ld d,b +269a d0 ret nc +269b 4f ld c,a +269c 53 ld d,e +269d d351 out (51h),a +269f 52 ld d,d +26a0 d24e44 jp nc,444eh +26a3 cc4f47 call z,474fh +26a6 c5 push bc +26a7 58 ld e,b +26a8 50 ld d,b +26a9 c34f53 jp 534fh + +26ac d349 out (49h),a +26ae 4e ld c,(hl) +26af d4414e call nc,4e41h +26b2 c1 pop bc +26b3 54 ld d,h +26b4 4e ld c,(hl) +26b5 d0 ret nc +26b6 45 ld b,l +26b7 45 ld b,l +26b8 4b ld c,e +26b9 d650 sub 50h +26bb 45 ld b,l +26bc 45 ld b,l +26bd 4b ld c,e +26be d0 ret nc +26bf 45 ld b,l +26c0 4e ld c,(hl) +26c1 d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +26c2 50 ld d,b +26c3 4b ld c,e +26c4 c5 push bc +26c5 4f ld c,a +26c6 46 ld b,(hl) +26c7 ca534b jp z,4b53h +26ca ca554d jp z,4d55h +26cd 50 ld d,b +26ce c44547 call nz,4745h +26d1 cd504b call 4b50h +26d4 24 inc h +26d5 d24144 jp nc,4441h +26d8 c3494e jp 4e49h + +26db 54 ld d,h +26dc c3534e jp 4e53h + +26df 47 ld b,a +26e0 c34442 jp 4244h + + +26e3 4c ld c,h +26e4 c649 add a,49h +26e6 58 ld e,b +26e7 cc454e call z,4e45h +26ea d354 out (54h),a +26ec 52 ld d,d +26ed 24 inc h +26ee d641 sub 41h +26f0 4c ld c,h +26f1 c1 pop bc +26f2 53 ld d,e +26f3 43 ld b,e +26f4 c34852 jp 5248h + + +26f7 24 inc h +26f8 cc4546 call z,4645h +26fb 54 ld d,h +26fc 24 inc h +26fd d24947 jp nc,4749h +2700 48 ld c,b +2701 54 ld d,h +2702 24 inc h +2703 cd4944 call 4449h +2706 24 inc h +2707 a7 and a +2708 80 add a,b +2709 00 nop + + +; # JP table for statements +;270a 99 sbc a,c +;270b 2c inc l +;270c 8b adc a,e +;270d 2b dec hl + +$2C99 - [128] END +$2B8B - [129] FOR +$0DCA - [130] RESET +$0DBF - [131] SET +$04C8 - [132] CLS + $3F42 - [133] CMD +$0D27 - [134] RANDOM +$31AA - [135] NEXT +$2DF0 - [136] DATA +$3085 - [137] INPUT +$34FC - [138] DIM +$30DA - [139] READ +$2E0C - [140] LET +$2DAD - [141] GOTO +$2D8E - [142] RUN +$2F24 - [143] IF + $3F42 - [144] RESTORE +$2D9C - [145] GOSUB +$2DC9 - [146] RETURN +$2DF2 - [147] REM ; (__DATA+2) +$2C94 - [148] STOP +$2DF2 - [149] ELSE ; (__DATA+2) +$2CE2 - [150] TRON +$2CE3 - [151] TROFF +$2CEB - [152] DEFSTR +$2CEE - [153] DEFINT +$2CF1 - [154] DEFSNG +$2CF4 - [155] DEFDBL +$0C96 - [156] PCGEN +$3D5E - [157] EDIT +$2EDF - [158] ERROR +$2E9A - [159] RESUME +$39EF - [160] OUT +$2E57 - [161] ON +$1148 - [162] OPEN +$0D2D - [163] COLOUR +$141F - [164] WRITE# +$1182 - [165] CLOSE + $3F42 - [166] LOAD + $3F42 - [167] SAVE +$153B - [168] KILL + $3F42 - [169] CIRCLE + $3F42 - [170] LINE + $3F42 - [171] SOUND + $3F42 - [172] HGR + $3F42 - [173] VPOKE +$0EE2 - [174] SYSTEM +$2F52 - [175] LPRINT + $3F42 - [176] DEF +$3BAF - [177] POKE +$2F5A - [178] PRINT +$2CCF - [179] CONT +$3A22 - [180] LIST +$3A1D - [181] LLIST +$3ABA - [182] DELETE +$2EF3 - [183] AUTO +$2D65 - [184] CLEAR +$3B18 - [185] CLOAD +$3AE9 - [186] CSAVE +$2A33 - [187] NEW + +;277c 183b jr 27b9h +;277e e9 jp (hl) +;277f 3a332a ld a,(2a33h) + +; PRITAB - ARITHMETIC PRECEDENCE TABLE +;2782 79 ld a,c +;2783 79 ld a,c +; (...) + +; (2782h) ARITHMETIC PRECEDENCE TABLE +PRITAB: + DEFB $79 ; + (Token code $F1) + DEFB $79 ; - + DEFB $7c ; * + DEFB $7c ; / + DEFB $7f ; ^ + DEFB $50 ; AND + DEFB $46 ; OR + +; (2789h) NUMBER TYPES +TYPE_OPR: + DEFW __CDBL -> 1945h + DEFW 0 + DEFW __CINT -> 18e9h + DEFW TSTSTR -> 195eh + DEFW __CSNG -> 191bh + +2789 45 ld b,l +278a 19 add hl,de +278b 00 nop +278c 00 nop +278d e9 jp (hl) +278e 185e jr 27eeh +2790 19 add hl,de +2791 1b dec de +2792 19 add hl,de + + +; (2793h) - DOUBLE PRECISION ARITHMETIC OPERATIONS TABLE +DEC_OPR: + DEFW DECADD -> 1ae1h (DBL_ADD) + DEFW DECSUB -> 1adah (DBL_SUB) + DEFW DECMUL -> 1c0bh (DBL_MUL) + DEFW DECDIV -> 1c4fh (DBL_DIV) + DEFW DECCOMP -> 18e2h + +; (279dh) - SINGLE PRECISION ARITHMETIC OPERATIONS TABLE +FLT_OPR: + DEFW FADD -> 1580h (FPADD) + DEFW FSUB -> 157dh (SUBCDE) + DEFW FMULT -> 16b1h (FPMULT) + DEFW FDIV -> 170ch (DVBCDE) + DEFW FCOMP -> 1876h (CMPNUM) + +; (27a7h) - INTEGER ARITHMETIC OPERATIONS TABLE +INT_OPR: + DEFW IADD -> 1a3ch + DEFW ISUB -> 1a31h + DEFW IMULT -> 1a5ch (INT_MUL) + DEFW IDIV -> 3384h + DEFW ICOMP -> 18a3h + + + +; (27b1h) ERROR_MESSAGES +;27b0 184e jr 2800h + + +27b2 46 ld b,(hl) +27b3 53 ld d,e +27b4 4e ld c,(hl) +27b5 52 ld d,d +27b6 47 ld b,a +27b7 4f ld c,a +27b8 44 ld b,h +27b9 46 ld b,(hl) +27ba 43 ld b,e +27bb 4f ld c,a +27bc 56 ld d,(hl) +27bd 4f ld c,a +27be 4d ld c,l +27bf 55 ld d,l +27c0 4c ld c,h +27c1 42 ld b,d +27c2 53 ld d,e +27c3 44 ld b,h +27c4 44 ld b,h +27c5 2f cpl +27c6 3049 jr nc,2811h +27c8 44 ld b,h +27c9 54 ld d,h +27ca 4d ld c,l +27cb 4f ld c,a +27cc 53 ld d,e +27cd 4c ld c,h +27ce 53 ld d,e +27cf 53 ld d,e +27d0 54 ld d,h +27d1 43 ld b,e +27d2 4e ld c,(hl) +27d3 4e ld c,(hl) +27d4 52 ld d,d +27d5 52 ld d,d +27d6 57 ld d,a +27d7 55 ld d,l +27d8 45 ld b,l +27d9 4d ld c,l +27da 4f ld c,a +27db 46 ld b,(hl) +27dc 44 ld b,h +27dd 4c ld c,h +27de 33 inc sp +27df 46 ld b,(hl) +27e0 4e ld c,(hl) + + + + +;0190 1134fc ld de,0fc34h +;0193 21e127 ld hl,27e1h +;0196 012600 ld bc,0026h +;0199 edb0 ldir + +; 27e1 -> FC34 ..FC34 is also pointed by SP under some condition +27e1 d600 sub 00h +27e3 6f ld l,a +27e4 7c ld a,h +27e5 de00 sbc a,00h +27e7 67 ld h,a +27e8 78 ld a,b +27e9 de00 sbc a,00h +27eb 47 ld b,a +27ec 3e00 ld a,00h +27ee c9 ret + +; -> FC42 ; Address of USR subroutine +; default: 2d35 = {Error: Illegal function call (FC ERROR)} +27ef 35 dec (hl) +27f0 2d dec l + +27f1 40 ld b,b +27f2 e64d and 4dh + +; -> FC47 +; Used by "__INP" +27f4 db00 in a,(00h) ; INPORT=FC48h +27f6 c9 ret + +; -> FC4A +; Used by "__OUT" +27f7 d300 out (00h),a ; OTPORT=FC4Bh +27f9 c9 ret + +27fa 00 nop +27fb 00 nop +27fc 00 nop +27fd 00 nop +27fe 50 ld d,b +27ff 3800 jr c,2801h +2801 be cp (hl) +2802 fb ei +2803 feff cp 0ffh +2805 014020 ld bc,2040h +2808 45 ld b,l +2809 72 ld (hl),d +280a 72 ld (hl),d +280b 6f ld l,a +280c 72 ld (hl),d +280d 00 nop +280e 2069 jr nz,2879h +2810 6e ld l,(hl) +2811 2000 jr nz,2813h +2813 52 ld d,d +2814 45 ld b,l +2815 41 ld b,c +2816 44 ld b,h +2817 59 ld e,c +2818 0d dec c +2819 00 nop +281a 42 ld b,d +281b 72 ld (hl),d +281c 65 ld h,l +281d 61 ld h,c +281e 6b ld l,e +281f 00 nop +2820 210400 ld hl,0004h +2823 39 add hl,sp +2824 7e ld a,(hl) +2825 23 inc hl +2826 fe81 cp 81h +2828 c0 ret nz +2829 4e ld c,(hl) +282a 23 inc hl +282b 46 ld b,(hl) +282c 23 inc hl +282d e5 push hl +282e 69 ld l,c +282f 60 ld h,b +2830 7a ld a,d +2831 b3 or e +2832 eb ex de,hl +2833 2802 jr z,2837h +2835 eb ex de,hl +2836 df rst 18h ; DCOMPR - Compare HL with DE. +2837 010e00 ld bc,000eh +283a e1 pop hl +283b c8 ret z +283c 09 add hl,bc +283d 18e5 jr 2824h + + +283f cd5628 call 2856h +2842 c5 push bc +2843 e3 ex (sp),hl +2844 c1 pop bc +2845 df rst 18h ; DCOMPR - Compare HL with DE. +2846 7e ld a,(hl) +2847 02 ld (bc),a +2848 c8 ret z +2849 0b dec bc +284a 2b dec hl +284b 18f8 jr 2845h + + +; CHKSTK - Check for C levels of stack +284d e5 push hl +284e 2a1dfe ld hl,(0fe1dh) ; ARREND - Starting address of free space list (FSL) +2851 0600 ld b,00h +2853 09 add hl,bc +2854 09 add hl,bc +2855 3ee5 ld a,0e5h +2857 3ec6 ld a,0c6h +2859 95 sub l +285a 6f ld l,a +285b 3eff ld a,0ffh +285d 9c sbc a,h +285e 3804 jr c,2864h +2860 67 ld h,a +2861 39 add hl,sp +2862 e1 pop hl +2863 d8 ret c +2864 1e0c ld e,0ch ; ?OM Error (out of memory) +2866 1824 jr 288ch ; ERROR, E=error code + +2868 2a56fc ld hl,(0fc56h) ; CURLIN: Current line number +286b 7c ld a,h +286c a5 and l +286d 3c inc a +286e 2808 jr z,2878h +2870 3a12fe ld a,(0fe12h) ; ONEFLG - Flag. FF during on error processing cleared by resume routine +2873 b7 or a +2874 1e22 ld e,22h ; ?ID Error +2876 2014 jr nz,288ch ; ERROR, E=error code +2878 c3ac2c jp 2cach + +; DATSNR - 'SN err' entry for Input STMT +287b 2afafd ld hl,(0fdfah) ; Line No. of last data statement +287e 2256fc ld (0fc56h),hl ; CURLIN: Current line number +; Syntax Error (SN ERROR) +2881 1e02 ld e,02h +2883 011e14 ld bc,141eh ; ?UL Error +2886 011e00 ld bc,001eh ; ?NF Error +2889 011e24 ld bc,241eh ; ?TM Error +; ERROR, E=error code +288c 2a56fc ld hl,(0fc56h) ; CURLIN: Current line number +288f 220afe ld (0fe0ah),hl ; ERRLIN: Line No. in which error occured. +2892 220cfe ld (0fe0ch),hl ; Line No. in which error occured. +2895 019e28 ld bc,289eh +2898 2a08fe ld hl,(0fe08h) ; During execution: stack pointer value when statement execution begins. +289b c3842a jp 2a84h + +289e c1 pop bc +289f 7b ld a,e +28a0 4b ld c,e +28a1 324efc ld (0fc4eh),a ; ERRFLG +28a4 2a06fe ld hl,(0fe06h) ; SAVTXT (During input: ADDR of code string for current statement) +28a7 220efe ld (0fe0eh),hl ; ERRTXT +28aa eb ex de,hl +28ab 2a0afe ld hl,(0fe0ah) ; ERRLIN: Line No. in which error occured. +28ae 7c ld a,h +28af a5 and l +28b0 3c inc a +28b1 2807 jr z,28bah +28b3 2215fe ld (0fe15h),hl ; OLDLIN: Last line number executed saved by stop/end +28b6 eb ex de,hl +28b7 2217fe ld (0fe17h),hl ; OLDTXT: Addr of last byte executed during error +28ba 2a10fe ld hl,(0fe10h) ; ONELIN: LINE to go when 'on error' event happens +28bd 7c ld a,h +28be b5 or l +28bf eb ex de,hl +28c0 2112fe ld hl,0fe12h ; ONEFLG - Flag. FF during on error processing cleared by resume routine +28c3 2808 jr z,28cdh ; ERROR_REPORT +28c5 a6 and (hl) +28c6 2005 jr nz,28cdh ; ERROR_REPORT +28c8 35 dec (hl) +28c9 eb ex de,hl +28ca c3202c jp 2c20h + +; ERROR_REPORT +28cd af xor a +28ce 77 ld (hl),a +28cf 59 ld e,c +28d0 cde42f call 2fe4h ; CONSOLE_CRLF +28d3 21b127 ld hl,27b1h ; ERROR_MESSAGES +28d6 cda5fe call 0fea5h +28d9 57 ld d,a +28da 3e3f ld a,3fh ; '?' +28dc cda00b call 0ba0h ; OUTC (alias OUTDO): print character +28df 19 add hl,de +28e0 7e ld a,(hl) +28e1 cda00b call 0ba0h ; OUTC (alias OUTDO): print character +28e4 d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +28e5 cda00b call 0ba0h ; OUTC (alias OUTDO): print character +28e8 210728 ld hl,2807h ; "Error" +28eb e5 push hl +28ec 2a0afe ld hl,(0fe0ah) ; ERRLIN: Line No. in which error occured. +28ef e3 ex (sp),hl +28f0 cd9b37 call 379bh ; PRS - Output a string +28f3 e1 pop hl +28f4 11feff ld de,0fffeh +28f7 df rst 18h ; DCOMPR - Compare HL with DE. +28f8 ca0001 jp z,0100h +28fb 7c ld a,h +28fc a5 and l +28fd 3c inc a +28fe c4111e call nz,1e11h ; LNUM_MSG +;2901 3ec1 ld a,0c1h + DEFB $3E ; "LD A,n" to Mask the next byte +; RESTART +2902 c1 pop bc +; READY +2903 cd200c call 0c20h ; STOP_LPT +2906 cdabfe call 0feabh +2909 cd8007 call 0780h ; Cassette off routine +290c cde42f call 2fe4h ; CONSOLE_CRLF +290f 211328 ld hl,2813h ; "READY" +2912 cd9b37 call 379bh ; PRS - Output a string +2915 3a4efc ld a,(0fc4eh) ; ERRFLG +2918 d602 sub 02h +291a cc513d call z,3d51h + +; PROMPT: +291d 21ffff ld hl,0ffffh +2920 2256fc ld (0fc56h),hl ; CURLIN: Current line number +2923 3a01fe ld a,(0fe01h) ; AUTFLG: Auto increment flag 0 = no auto mode, otherwise line number +2926 b7 or a +2927 2837 jr z,2960h +2929 2a02fe ld hl,(0fe02h) ; AUTLIN: Current line number in binary (during input phase) +292c e5 push hl +292d cd191e call 1e19h +2930 d1 pop de +2931 d5 push de +2932 cd162a call 2a16h ; FIND_LNUM - Search for line number +2935 3e2a ld a,2ah +2937 3802 jr c,293bh +2939 3e20 ld a,20h ; ' ' +293b cda00b call 0ba0h ; OUTC (alias OUTDO): print character +293e cdfa08 call 08fah ; RINPUT - Console line input routine +2941 d1 pop de +2942 3006 jr nc,294ah +2944 af xor a +2945 3201fe ld (0fe01h),a ; AUTFLG: Auto increment flag 0 = no auto mode, otherwise line number +2948 18b9 jr 2903h ; READY + + +294a 2a04fe ld hl,(0fe04h) ; AUTINC: Auto line increment +294d 19 add hl,de +294e 38f4 jr c,2944h +2950 d5 push de +2951 11f9ff ld de,0fff9h +2954 df rst 18h ; DCOMPR - Compare HL with DE. +2955 d1 pop de +2956 30ec jr nc,2944h +2958 2202fe ld (0fe02h),hl ; AUTLIN: Current line number in binary (during input phase) +295b f6ff or 0ffh +295d c3e93e jp 3ee9h + +2960 3e3e ld a,3eh ; '>' +2962 cda00b call 0ba0h ; OUTC (alias OUTDO): print character +2965 cdfa08 call 08fah ; RINPUT - Console line input routine +2968 da1d29 jp c,291dh ; PROMPT +296b d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +296c 3c inc a +296d 3d dec a +296e ca1d29 jp z,291dh ; PROMPT +2971 f5 push af +2972 cd452d call 2d45h ; LNUM_PARM_0 - Get specified line number (2nd parameter) + +2975 2b dec hl +2976 7e ld a,(hl) +2977 fe20 cp 20h ; =' ' ? +2979 28fa jr z,2975h +297b 23 inc hl +297c 7e ld a,(hl) +297d fe20 cp 20h ; =' ' ? +297f cc3318 call z,1833h +2982 d5 push de +2983 cdaa2a call 2aaah +2986 d1 pop de +2987 f1 pop af +2988 2206fe ld (0fe06h),hl ; SAVTXT (During input: ADDR of code string for current statement) +298b cdb1fe call 0feb1h +298e d2442c jp nc,2c44h +2991 d5 push de +2992 c5 push bc +2993 af xor a +2994 32fdfd ld (0fdfdh),a ; Read flag: 0 = read statement active +2997 d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +2998 b7 or a +2999 f5 push af +299a eb ex de,hl +299b 220cfe ld (0fe0ch),hl ; Line No. in which error occured. +299e eb ex de,hl +299f cd162a call 2a16h ; FIND_LNUM - Search for line number +29a2 c5 push bc +29a3 dcd83a call c,3ad8h +29a6 d1 pop de +29a7 f1 pop af +29a8 d5 push de +29a9 2827 jr z,29d2h +29ab d1 pop de +29ac 2a19fe ld hl,(0fe19h) ; Addr of simple variables +29af e3 ex (sp),hl +29b0 c1 pop bc +29b1 09 add hl,bc +29b2 e5 push hl +29b3 cd3f28 call 283fh +29b6 e1 pop hl +29b7 2219fe ld (0fe19h),hl ; Addr of simple variables +29ba eb ex de,hl +29bb 74 ld (hl),h +29bc d1 pop de +29bd e5 push hl +29be 23 inc hl +29bf 23 inc hl +29c0 73 ld (hl),e +29c1 23 inc hl +29c2 72 ld (hl),d +29c3 23 inc hl +29c4 eb ex de,hl +29c5 2ac7fd ld hl,(0fdc7h) ; Pointer to address of keyboard buffer +29c8 eb ex de,hl +29c9 1b dec de +29ca 1b dec de +29cb 1a ld a,(de) +29cc 77 ld (hl),a +29cd 23 inc hl +29ce 13 inc de +29cf b7 or a +29d0 20f9 jr nz,29cbh +29d2 d1 pop de +29d3 cde629 call 29e6h +29d6 cdb4fe call 0feb4h +29d9 cd472a call 2a47h +29dc cdb7fe call 0feb7h +29df c31d29 jp 291dh ; PROMPT + +29e2 2a58fc ld hl,(0fc58h) ; BASTXT - Address of BASIC Program +29e5 eb ex de,hl +29e6 62 ld h,d +29e7 6b ld l,e +29e8 7e ld a,(hl) +29e9 23 inc hl +29ea b6 or (hl) +29eb c8 ret z +29ec 23 inc hl +29ed 23 inc hl +29ee 23 inc hl +29ef af xor a +29f0 be cp (hl) +29f1 23 inc hl +29f2 20fc jr nz,29f0h +29f4 eb ex de,hl +29f5 73 ld (hl),e +29f6 23 inc hl +29f7 72 ld (hl),d +29f8 18ec jr 29e6h + +; LNUM_RANGE - Get specified line number range +29fa 110000 ld de,0000h +29fd d5 push de +29fe 2809 jr z,2a09h +2a00 d1 pop de +2a01 cd3a2d call 2d3ah ; LNUM_PARM - Get specified line number +2a04 d5 push de +2a05 280b jr z,2a12h +2a07 cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +2a08 ce defb TK_MINUS +2a09 11faff ld de,0fffah ; -6 +2a0c c43a2d call nz,2d3ah ; LNUM_PARM - Get specified line number +2a0f c28128 jp nz,2881h ; Syntax Error (SN ERROR) +2a12 eb ex de,hl +2a13 d1 pop de +FIND_LNUM_0: +2a14 e3 ex (sp),hl +2a15 e5 push hl + +; FIND_LNUM - Search for line number +2a16 2a58fc ld hl,(0fc58h) ; BASTXT - Address of BASIC Program +2a19 44 ld b,h +2a1a 4d ld c,l +2a1b 7e ld a,(hl) +2a1c 23 inc hl +2a1d b6 or (hl) +2a1e 2b dec hl +2a1f c8 ret z +2a20 23 inc hl +2a21 23 inc hl +2a22 7e ld a,(hl) +2a23 23 inc hl +2a24 66 ld h,(hl) +2a25 6f ld l,a +2a26 df rst 18h ; DCOMPR - Compare HL with DE. +2a27 60 ld h,b +2a28 69 ld l,c +2a29 7e ld a,(hl) +2a2a 23 inc hl +2a2b 66 ld h,(hl) +2a2c 6f ld l,a +2a2d 3f ccf +2a2e c8 ret z +2a2f 3f ccf +2a30 d0 ret nc +2a31 18e6 jr 2a19h + +; __NEW +2a33 c0 ret nz +2a34 cdc804 call 04c8h ; __CLS +2a37 2a58fc ld hl,(0fc58h) ; BASTXT - Address of BASIC Program +2a3a cde32c call 2ce3h +2a3d 3201fe ld (0fe01h),a ; AUTFLG: Auto increment flag 0 = no auto mode, otherwise line number +2a40 77 ld (hl),a +2a41 23 inc hl +2a42 77 ld (hl),a +2a43 23 inc hl +2a44 2219fe ld (0fe19h),hl ; Addr of simple variables +2a47 2a58fc ld hl,(0fc58h) ; BASTXT - Address of BASIC Program +2a4a 2b dec hl +; _CLVAR - Initialise RUN variables +2a4b 22fffd ld (0fdffh),hl +2a4e 061a ld b,1ah +2a50 2121fe ld hl,0fe21h ; Variable declaration list. 26 entries, each containing a code inicating default mode for that initial letter +2a53 3604 ld (hl),04h +2a55 23 inc hl +2a56 10fb djnz 2a53h +2a58 af xor a +2a59 3212fe ld (0fe12h),a ; ONEFLG - Flag. FF during on error processing cleared by resume routine +2a5c 6f ld l,a +2a5d 67 ld h,a +2a5e 2210fe ld (0fe10h),hl ; ONELIN: LINE to go when 'on error' event happens +2a61 2217fe ld (0fe17h),hl ; OLDTXT: Addr of last byte executed during error +2a64 2ad1fd ld hl,(0fdd1h) ; Memory size +2a67 22f6fd ld (0fdf6h),hl ; Pointer to next available loc. in string area. +2a6a cd7b2c call 2c7bh +2a6d 2a19fe ld hl,(0fe19h) ; Addr of simple variables +2a70 221bfe ld (0fe1bh),hl ; VAREND: Addr of dimensioned variables +2a73 221dfe ld (0fe1dh),hl ; ARREND - Starting address of free space list (FSL) +2a76 cda211 call 11a2h +2a79 c1 pop bc +2a7a 2a54fc ld hl,(0fc54h) ; Address of string area boundary +2a7d 2b dec hl +2a7e 2b dec hl +2a7f 2208fe ld (0fe08h),hl ; During execution: stack pointer value when statement execution begins. +2a82 23 inc hl +2a83 23 inc hl +2a84 f9 ld sp,hl +2a85 21d5fd ld hl,0fdd5h ; TEMPST: LSPT (literal string pool table) +2a88 22d3fd ld (0fdd3h),hl ; TMSTPT: Address of next available location in LSPT +2a8b cd200c call 0c20h ; STOP_LPT +2a8e cd5430 call 3054h +2a91 af xor a +2a92 67 ld h,a +2a93 6f ld l,a +2a94 32fcfd ld (0fdfch),a ; FOR flag (1 = 'for' in progress, 0 = no 'for' in progress) +2a97 e5 push hl +2a98 c5 push bc +2a99 2afffd ld hl,(0fdffh) +2a9c c9 ret + +; INLIN +2a9d 3e3f ld a,3fh ; '?' +2a9f cda00b call 0ba0h ; OUTC (alias OUTDO): print character +2aa2 3e20 ld a,20h ; ' ' +2aa4 cda00b call 0ba0h ; OUTC (alias OUTDO): print character +2aa7 c3fa08 jp 08fah ; RINPUT - Console line input routine + +2aaa af xor a +2aab 32d0fd ld (0fdd0h),a +2aae 4f ld c,a +2aaf eb ex de,hl +2ab0 2ac7fd ld hl,(0fdc7h) ; Pointer to address of keyboard buffer +2ab3 2b dec hl +2ab4 2b dec hl +2ab5 eb ex de,hl +2ab6 7e ld a,(hl) +2ab7 fe20 cp 20h ; ' ' +2ab9 ca452b jp z,2b45h ; +2abc 47 ld b,a +2abd fe22 cp 22h ; '"' +2abf ca612b jp z,2b61h +2ac2 b7 or a +2ac3 ca672b jp z,2b67h +2ac6 3ad0fd ld a,(0fdd0h) +2ac9 b7 or a +2aca 7e ld a,(hl) +2acb c2452b jp nz,2b45h ; +2ace fe3f cp 3fh ; '?' +2ad0 3eb2 ld a,0b2h ; TK_PRINT +2ad2 ca452b jp z,2b45h ; +2ad5 7e ld a,(hl) +2ad6 fe30 cp 30h ; '0' +2ad8 3805 jr c,2adfh +2ada fe3c cp 3ch ; '<' +2adc da452b jp c,2b45h ; +2adf d5 push de +2ae0 112d25 ld de,252dh +2ae3 c5 push bc +2ae4 01272b ld bc,2b27h +2ae7 c5 push bc +2ae8 067f ld b,7fh +2aea 7e ld a,(hl) +2aeb fe61 cp 61h +2aed 3807 jr c,2af6h +2aef fe7b cp 7bh +2af1 3003 jr nc,2af6h +2af3 e65f and 5fh ; '_' +2af5 77 ld (hl),a +2af6 4e ld c,(hl) +2af7 eb ex de,hl +2af8 23 inc hl +2af9 b6 or (hl) +2afa f2f82a jp p,2af8h +2afd 04 inc b +2afe 7e ld a,(hl) +2aff e67f and 7fh +2b01 c8 ret z +2b02 b9 cp c +2b03 20f3 jr nz,2af8h +2b05 eb ex de,hl +2b06 e5 push hl +2b07 13 inc de +2b08 1a ld a,(de) +2b09 b7 or a +2b0a fa232b jp m,2b23h +2b0d 4f ld c,a +2b0e 78 ld a,b +2b0f fe8d cp 8dh +2b11 2002 jr nz,2b15h +2b13 d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +2b14 2b dec hl +2b15 23 inc hl +2b16 7e ld a,(hl) +2b17 fe61 cp 61h +2b19 3802 jr c,2b1dh +2b1b e65f and 5fh +2b1d b9 cp c +2b1e 28e7 jr z,2b07h +2b20 e1 pop hl +2b21 18d3 jr 2af6h +2b23 48 ld c,b +2b24 f1 pop af +2b25 eb ex de,hl +2b26 c9 ret + +2b27 eb ex de,hl +2b28 79 ld a,c +2b29 c1 pop bc +2b2a d1 pop de +2b2b eb ex de,hl +2b2c fe95 cp 95h +2b2e 363a ld (hl),3ah +2b30 2002 jr nz,2b34h +2b32 0c inc c +2b33 23 inc hl +2b34 fefb cp 0fbh +2b36 200c jr nz,2b44h +2b38 363a ld (hl),3ah +2b3a 23 inc hl +2b3b 0693 ld b,93h +2b3d 70 ld (hl),b +2b3e 23 inc hl +2b3f eb ex de,hl +2b40 0c inc c +2b41 0c inc c +2b42 181d jr 2b61h + +2b44 eb ex de,hl +; +2b45 23 inc hl +2b46 12 ld (de),a +2b47 13 inc de +2b48 0c inc c +2b49 d63a sub 3ah +2b4b 2804 jr z,2b51h +2b4d fe4e cp 4eh +2b4f 2003 jr nz,2b54h +2b51 32d0fd ld (0fdd0h),a +2b54 d659 sub 59h +2b56 c2b62a jp nz,2ab6h +2b59 47 ld b,a +2b5a 7e ld a,(hl) +2b5b b7 or a +2b5c 2809 jr z,2b67h +2b5e b8 cp b +2b5f 28e4 jr z,2b45h ; +2b61 23 inc hl +2b62 12 ld (de),a +2b63 0c inc c +2b64 13 inc de +2b65 18f3 jr 2b5ah +2b67 210500 ld hl,0005h +2b6a 44 ld b,h +2b6b 09 add hl,bc +2b6c 44 ld b,h +2b6d 4d ld c,l +2b6e 2ac7fd ld hl,(0fdc7h) ; Pointer to address of keyboard buffer +2b71 2b dec hl +2b72 2b dec hl +2b73 2b dec hl +2b74 12 ld (de),a +2b75 13 inc de +2b76 12 ld (de),a +2b77 13 inc de +2b78 12 ld (de),a +2b79 c9 ret + +; CPDEHL - compare DE and HL (aka DCOMPR) +; -> fbc6h +2b7a 7c ld a,h +2b7b 92 sub d +2b7c c0 ret nz +2b7d 7d ld a,l +2b7e 93 sub e +2b7f c9 ret + +2b80 7e ld a,(hl) +2b81 e3 ex (sp),hl +2b82 be cp (hl) +2b83 23 inc hl +2b84 e3 ex (sp),hl +2b85 ca622c jp z,2c62h ; _CHRGTB - Pick next char from program +2b88 c38128 jp 2881h ; Syntax Error (SN ERROR) + +; __FOR: +2b8b 3e64 ld a,64h +2b8d 32fcfd ld (0fdfch),a ; FOR flag (1 = 'for' in progress, 0 = no 'for' in progress) +2b90 cd0c2e call 2e0ch ; __LET +2b93 e3 ex (sp),hl +2b94 cd2028 call 2820h +2b97 d1 pop de +2b98 2005 jr nz,2b9fh +2b9a 09 add hl,bc +2b9b f9 ld sp,hl +2b9c 2208fe ld (0fe08h),hl ; During execution: stack pointer value when statement execution begins. +2b9f eb ex de,hl +2ba0 0e08 ld c,08h +2ba2 cd4d28 call 284dh ; CHKSTK - Check for C levels of stack +2ba5 e5 push hl +2ba6 cdf02d call 2df0h ; __DATA - DATA statement: find next DATA program line.. +2ba9 e3 ex (sp),hl +2baa e5 push hl +2bab 2a56fc ld hl,(0fc56h) ; CURLIN: Current line number +2bae e3 ex (sp),hl +2baf cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +2bb0 bd defb 0bdh ; TK_TO +2bb1 e7 rst 20h ; GETYPR - Get the number type (FAC) +2bb2 ca6019 jp z,1960h ; If string type, TYPE_ERR +2bb5 d26019 jp nc,1960h ; TYPE_ERR +2bb8 f5 push af +2bb9 cd2b32 call 322bh ; EVAL +2bbc f1 pop af +2bbd e5 push hl +2bbe f2d62b jp p,2bd6h +2bc1 cde918 call 18e9h ; __CINT: Floating point to Integer +2bc4 e3 ex (sp),hl +2bc5 110100 ld de,0001h +2bc8 7e ld a,(hl) +2bc9 fecc cp 0cch +2bcb ccf539 call z,39f5h ; FPSINT - Get subscript +2bce d5 push de +2bcf e5 push hl +2bd0 eb ex de,hl +2bd1 cd0818 call 1808h +2bd4 1822 jr 2bf8h + +2bd6 cd1b19 call 191bh ; __CSNG: Integer to single precision +2bd9 cd2918 call 1829h ; BCDEFP: Load a single precision value from FPREG into BC/DE +2bdc e1 pop hl +2bdd c5 push bc +2bde d5 push de +2bdf 010081 ld bc,8100h +2be2 51 ld d,c +2be3 5a ld e,d +2be4 7e ld a,(hl) +2be5 fecc cp 0cch +2be7 3e01 ld a,01h +2be9 200e jr nz,2bf9h +2beb cd2c32 call 322ch ; __EVAL__ +2bee e5 push hl +2bef cd1b19 call 191bh ; __CSNG: Integer to single precision +2bf2 cd2918 call 1829h ; BCDEFP: Load a single precision value from FPREG into BC/DE +2bf5 cdbf17 call 17bfh ; TSTSGN - Test sign of FPREG +2bf8 e1 pop hl +2bf9 c5 push bc +2bfa d5 push de +2bfb 4f ld c,a +2bfc e7 rst 20h ; GETYPR - Get the number type (FAC) +2bfd 47 ld b,a +2bfe c5 push bc +2bff e5 push hl +2c00 2afffd ld hl,(0fdffh) +2c03 e3 ex (sp),hl +2c04 0681 ld b,81h +2c06 c5 push bc +2c07 33 inc sp +2c08 cda309 call 09a3h +2c0b b7 or a +2c0c c48a2c call nz,2c8ah +2c0f 2206fe ld (0fe06h),hl ; SAVTXT (During input: ADDR of code string for current statement) +2c12 ed7308fe ld (0fe08h),sp ; During execution: stack pointer value when statement execution begins. +2c16 7e ld a,(hl) +2c17 fe3a cp 3ah +2c19 2829 jr z,2c44h +2c1b b7 or a +2c1c c28128 jp nz,2881h ; Syntax Error (SN ERROR) +2c1f 23 inc hl +2c20 7e ld a,(hl) +2c21 23 inc hl +2c22 b6 or (hl) +2c23 ca6828 jp z,2868h +2c26 23 inc hl +2c27 5e ld e,(hl) +2c28 23 inc hl +2c29 56 ld d,(hl) +2c2a eb ex de,hl +2c2b 2256fc ld (0fc56h),hl ; CURLIN: Current line number +2c2e 3a3bfe ld a,(0fe3bh) ; TRCFLG - Trace flag (0 = No trace, Non-zero = trace) +2c31 b7 or a +2c32 280f jr z,2c43h +2c34 d5 push de +2c35 3e3c ld a,3ch ; '<' +2c37 cda00b call 0ba0h ; OUTC (alias OUTDO): print character +2c3a cd191e call 1e19h +2c3d 3e3e ld a,3eh ; '?' +2c3f cda00b call 0ba0h ; OUTC (alias OUTDO): print character +2c42 d1 pop de +2c43 eb ex de,hl +2c44 d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +2c45 11082c ld de,2c08h +2c48 d5 push de +2c49 c8 ret z +2c4a d680 sub 80h +2c4c da0c2e jp c,2e0ch ; __LET +2c4f fe3c cp 3ch +2c51 d2db39 jp nc,39dbh ; IN BASIC instruction +2c54 07 rlca +2c55 4f ld c,a +2c56 0600 ld b,00h +2c58 eb ex de,hl +2c59 210a27 ld hl,270ah ; # JP table for statements +2c5c 09 add hl,bc +2c5d 4e ld c,(hl) +2c5e 23 inc hl +2c5f 46 ld b,(hl) +2c60 c5 push bc +2c61 eb ex de,hl +2c62 23 inc hl +2c63 7e ld a,(hl) +2c64 fe3a cp 3ah +2c66 d0 ret nc +2c67 fe20 cp 20h +2c69 ca622c jp z,2c62h +2c6c fe0b cp 0bh +2c6e 3005 jr nc,2c75h +2c70 fe09 cp 09h +2c72 d2622c jp nc,2c62h +2c75 fe30 cp 30h +2c77 3f ccf +2c78 3c inc a +2c79 3d dec a +2c7a c9 ret + +2c7b eb ex de,hl +2c7c 2a58fc ld hl,(0fc58h) ; BASTXT - Address of BASIC Program +2c7f 2b dec hl +2c80 221ffe ld (0fe1fh),hl ; Points to byte following last char +2c83 eb ex de,hl +2c84 c9 ret + +2c85 cda309 call 09a3h +2c88 b7 or a +2c89 c8 ret z +2c8a fe60 cp 60h +2c8c ccac09 call z,09ach ; Console input routine +2c8f 324dfc ld (0fc4dh),a ; Holds last character typed after break +2c92 fe03 cp 03h + +; __STOP +2c94 c0 ret nz +2c95 3c inc a +2c96 c39f2c jp 2c9fh ; __END_00 + +; __END +2c99 c0 ret nz +2c9a f5 push af +2c9b cca211 call z,11a2h +2c9e f1 pop af +; __END_00 +2c9f 2206fe ld (0fe06h),hl ; SAVTXT (During input: ADDR of code string for current statement) +2ca2 21d5fd ld hl,0fdd5h ; TEMPST: LSPT (literal string pool table) +2ca5 22d3fd ld (0fdd3h),hl ; TMSTPT: Address of next available location in LSPT +2ca8 21f6ff ld hl,0fff6h +2cab c1 pop bc +2cac 2a56fc ld hl,(0fc56h) ; CURLIN: Current line number +2caf e5 push hl +2cb0 f5 push af +2cb1 7d ld a,l +2cb2 a4 and h +2cb3 3c inc a +2cb4 2809 jr z,2cbfh +2cb6 2215fe ld (0fe15h),hl ; OLDLIN: Last line number executed saved by stop/end +2cb9 2a06fe ld hl,(0fe06h) ; SAVTXT (During input: ADDR of code string for current statement) +2cbc 2217fe ld (0fe17h),hl ; OLDTXT: Addr of last byte executed during error +2cbf cd200c call 0c20h ; STOP_LPT +2cc2 cde42f call 2fe4h ; CONSOLE_CRLF +2cc5 f1 pop af +2cc6 211a28 ld hl,281ah ; "Break" message +2cc9 c2f028 jp nz,28f0h +2ccc c30229 jp 2902h ; RESTART + +; __CONT +2ccf 2a17fe ld hl,(0fe17h) ; OLDTXT: Addr of last byte executed during error +2cd2 7c ld a,h +2cd3 b5 or l +2cd4 1e20 ld e,20h ; ?CN Error +2cd6 ca8c28 jp z,288ch ; ERROR, E=error code +2cd9 eb ex de,hl +2cda 2a15fe ld hl,(0fe15h) ; OLDLIN: Last line number executed saved by stop/end +2cdd 2256fc ld (0fc56h),hl ; CURLIN: Current line number +2ce0 eb ex de,hl +2ce1 c9 ret + +; __TRON +2ce2 3eaf ld a,0afh +;; __TROFF (2ce3): XOR A +2ce4 323bfe ld (0fe3bh),a ; TRCFLG - Trace flag (0 = No trace, Non-zero = trace) +2ce7 c9 ret + +2ce8 f1 pop af +2ce9 e1 pop hl +2cea c9 ret + + +; __DEFSTR +2ceb 1e03 ld e,03h ; String type + DEFB $01 ; "LD BC,nn" to jump over the next word without executing it + +;(2ceeh) +; __DEFINT +2cee LD E,$02 ; Integer type + DEFB $01 ; "LD BC,nn" to jump over the next word without executing it + +;(2cf1h) +; __DEFSNG +2cf1 LD E,$04 ; Single precision type + DEFB $01 ; "LD BC,nn" to jump over the next word without executing it + +; (2cf4h) +; __DEFDBL +2cf4 LD E,$08 ; Double Precision type + +;2ced 011e02 ld bc,021eh +;2cf0 011e04 ld bc,041eh +;2cf3 011e08 ld bc,081eh + +2cf6 cd282d call 2d28h ; IS_ALPHA_A +2cf9 018128 ld bc,2881h ; (SP) = Syntax Error (SN ERROR) +2cfc c5 push bc +2cfd d8 ret c +2cfe d641 sub 41h +2d00 4f ld c,a +2d01 47 ld b,a +2d02 d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +2d03 fece cp 0ceh +2d05 2009 jr nz,2d10h +2d07 d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +2d08 cd282d call 2d28h ; IS_ALPHA_A +2d0b d8 ret c +2d0c d641 sub 41h +2d0e 47 ld b,a +2d0f d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +2d10 78 ld a,b +2d11 91 sub c +2d12 d8 ret c +2d13 3c inc a +2d14 e3 ex (sp),hl +2d15 2121fe ld hl,0fe21h ; Variable declaration list. 26 entries, each containing a code inicating default mode for that initial letter +2d18 0600 ld b,00h +2d1a 09 add hl,bc +2d1b 73 ld (hl),e +2d1c 23 inc hl +2d1d 3d dec a +2d1e 20fb jr nz,2d1bh +2d20 e1 pop hl +2d21 7e ld a,(hl) +2d22 fe2c cp 2ch +2d24 c0 ret nz +2d25 d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +2d26 18ce jr 2cf6h + +; IS_ALPHA_A +2d28 7e ld a,(hl) +2d29 fe41 cp 41h +2d2b d8 ret c +2d2c fe5b cp 5bh +2d2e 3f ccf +2d2f c9 ret + +2d30 d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +2d31 cdf639 call 39f6h ; GETWORD - Get a number to DE (0..65535) +2d34 f0 ret p + +; Error: Illegal function call (FC ERROR) +2d35 1e08 ld e,08h +2d37 c38c28 jp 288ch ; ERROR, E=error code + +; LNUM_PARM - Get specified line number +2d3a 7e ld a,(hl) +2d3b fe2e cp 2eh ; '.' ? +2d3d eb ex de,hl +2d3e 2a0cfe ld hl,(0fe0ch) ; Line No. in which error occured. +2d41 eb ex de,hl +2d42 ca622c jp z,2c62h ; _CHRGTB - Pick next char from program + +; LNUM_PARM_0 - Get specified line number (2nd parameter) +2d45 2b dec hl +2d46 110000 ld de,0000h +2d49 d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +2d4a d0 ret nc +2d4b e5 push hl +2d4c f5 push af +2d4d 219819 ld hl,1998h +2d50 df rst 18h ; DCOMPR - Compare HL with DE. +2d51 da8128 jp c,2881h ; Syntax Error (SN ERROR) +2d54 62 ld h,d +2d55 6b ld l,e +2d56 19 add hl,de +2d57 29 add hl,hl +2d58 19 add hl,de +2d59 29 add hl,hl +2d5a f1 pop af +2d5b d630 sub 30h +2d5d 5f ld e,a +2d5e 1600 ld d,00h +2d60 19 add hl,de +2d61 eb ex de,hl +2d62 e1 pop hl +2d63 18e4 jr 2d49h + +; __CLEAR +2d65 ca4b2a jp z,2a4bh ; _CLVAR - Initialise RUN variables +2d68 cd312d call 2d31h +2d6b 2b dec hl +2d6c d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +2d6d c0 ret nz +2d6e e5 push hl +2d6f 2ad1fd ld hl,(0fdd1h) ; Memory size +2d72 7d ld a,l +2d73 93 sub e +2d74 5f ld e,a +2d75 7c ld a,h +2d76 9a sbc a,d +2d77 57 ld d,a +2d78 da6428 jp c,2864h +2d7b 2a19fe ld hl,(0fe19h) ; Addr of simple variables +2d7e 012800 ld bc,0028h +2d81 09 add hl,bc +2d82 df rst 18h ; DCOMPR - Compare HL with DE. +2d83 d26428 jp nc,2864h +2d86 eb ex de,hl +2d87 2254fc ld (0fc54h),hl ; Address of string area boundary +2d8a e1 pop hl +2d8b c34b2a jp 2a4bh ; _CLVAR - Initialise RUN variables + +; __RUN +2d8e ca472a jp z,2a47h +2d91 cdc3fe call 0fec3h +2d94 cd4b2a call 2a4bh ; _CLVAR - Initialise RUN variables +2d97 01082c ld bc,2c08h +2d9a 1810 jr 2dach + +; __GOSUB: Gosub routine +2d9c 0e03 ld c,03h +2d9e cd4d28 call 284dh ; CHKSTK - Check for C levels of stack +2da1 c1 pop bc +2da2 e5 push hl +2da3 e5 push hl +2da4 2a56fc ld hl,(0fc56h) ; CURLIN: Current line number +2da7 e3 ex (sp),hl +2da8 3e91 ld a,91h ; TK_GOSUB +2daa f5 push af +2dab 33 inc sp +2dac c5 push bc + +; __GOTO +2dad cd452d call 2d45h ; LNUM_PARM_0 - Get specified line number (2nd parameter) +2db0 cdf22d call 2df2h ; __DATA+2: 'Move to next line' (used also by ELSE, REM..) +2db3 e5 push hl +2db4 2a56fc ld hl,(0fc56h) ; CURLIN: Current line number +2db7 df rst 18h ; DCOMPR - Compare HL with DE. +2db8 e1 pop hl +2db9 23 inc hl +2dba dc192a call c,2a19h +2dbd d4162a call nc,2a16h ; FIND_LNUM - Search for line number +2dc0 60 ld h,b +2dc1 69 ld l,c +2dc2 2b dec hl +2dc3 d8 ret c +2dc4 1e0e ld e,0eh ; ?UL Error +2dc6 c38c28 jp 288ch ; ERROR, E=error code + +; __RETURN +2dc9 c0 ret nz +; Return entry point - warm start of BASIC +2dca 16ff ld d,0ffh +2dcc cd2028 call 2820h +2dcf f9 ld sp,hl +2dd0 2208fe ld (0fe08h),hl ; During execution: stack pointer value when statement execution begins. +2dd3 fe91 cp 91h ; TK_GOSUB +2dd5 1e04 ld e,04h ; ?RG Error +2dd7 c28c28 jp nz,288ch ; ERROR, E=error code +2dda e1 pop hl +2ddb 2256fc ld (0fc56h),hl ; CURLIN: Current line number +2dde 23 inc hl +2ddf 7c ld a,h +2de0 b5 or l +2de1 2007 jr nz,2deah +2de3 3afdfd ld a,(0fdfdh) ; Read flag: 0 = read statement active +2de6 b7 or a +2de7 c20229 jp nz,2902h ; RESTART +2dea 21082c ld hl,2c08h +2ded e3 ex (sp),hl +2dee 3ee1 ld a,0e1h + + +; __DATA +2df0 013a0e ld bc,0e3ah ; Put ':' in C, $0E in B +; 'Go to next line' +; Used by 'REM', 'ELSE' and error handling code. +; __DATA+2: +; LD C,0 ; Put $00 in C +2df3 00 nop ; used to set C to zero when entered with a +2 bytes shift +2df4 0600 ld b,00h +2df6 79 ld a,c +2df7 48 ld c,b +2df8 47 ld b,a +2df9 7e ld a,(hl) +2dfa b7 or a +2dfb c8 ret z +2dfc b8 cp b +2dfd c8 ret z +2dfe 23 inc hl +2dff fe22 cp 22h +2e01 28f3 jr z,2df6h +2e03 d68f sub 8fh +2e05 20f2 jr nz,2df9h +2e07 b8 cp b +2e08 8a adc a,d +2e09 57 ld d,a +2e0a 18ed jr 2df9h + +; __LET +2e0c cd0135 call 3501h ; GETVAR: Find address of variable +2e0f cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +2e10 d5 defb TK_EQUAL +2e11 eb ex de,hl +2e12 22fffd ld (0fdffh),hl +2e15 eb ex de,hl +2e16 d5 push de +2e17 e7 rst 20h ; GETYPR - Get the number type (FAC) +2e18 f5 push af +2e19 cd2b32 call 322bh ; EVAL +2e1c f1 pop af +2e1d e3 ex (sp),hl +2e1e c603 add a,03h +2e20 cd0d37 call 370dh +2e23 cd6d18 call 186dh +2e26 e5 push hl +2e27 2028 jr nz,2e51h +2e29 2a41fe ld hl,(0fe41h) ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +2e2c e5 push hl +2e2d 23 inc hl +2e2e 5e ld e,(hl) +2e2f 23 inc hl +2e30 56 ld d,(hl) +2e31 2a58fc ld hl,(0fc58h) ; BASTXT - Address of BASIC Program +2e34 df rst 18h ; DCOMPR - Compare HL with DE. +2e35 300e jr nc,2e45h +2e37 2a54fc ld hl,(0fc54h) ; Address of string area boundary +2e3a df rst 18h ; DCOMPR - Compare HL with DE. +2e3b d1 pop de +2e3c 300f jr nc,2e4dh +2e3e 2a19fe ld hl,(0fe19h) ; Addr of simple variables +2e41 df rst 18h ; DCOMPR - Compare HL with DE. +2e42 3009 jr nc,2e4dh +2e44 3ed1 ld a,0d1h +2e46 cde938 call 38e9h +2e49 eb ex de,hl +2e4a cd3737 call 3737h +2e4d cde938 call 38e9h +2e50 e3 ex (sp),hl +2e51 cd3d18 call 183dh ; FP2HL - Copy number value from DE to HL +2e54 d1 pop de +2e55 e1 pop hl +2e56 c9 ret + +; __ON +2e57 fe9e cp 9eh ; TK_ERROR +2e59 2025 jr nz,2e80h ; ON_OTHER +2e5b d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +2e5c cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +2e5d 8d TK_GOTO +2e5e cd452d call 2d45h ; LNUM_PARM_0 - Get specified line number (2nd parameter) +2e61 7a ld a,d +2e62 b3 or e +2e63 2809 jr z,2e6eh +2e65 cd142a call 2a14h ; FIND_LNUM_0 +2e68 50 ld d,b +2e69 59 ld e,c +2e6a e1 pop hl +2e6b d2c42d jp nc,2dc4h +2e6e eb ex de,hl +2e6f 2210fe ld (0fe10h),hl ; ONELIN: LINE to go when 'on error' event happens +2e72 eb ex de,hl +2e73 d8 ret c +2e74 3a12fe ld a,(0fe12h) ; ONEFLG - Flag. FF during on error processing cleared by resume routine +2e77 b7 or a +2e78 c8 ret z +2e79 3a4efc ld a,(0fc4eh) ; ERRFLG +2e7c 5f ld e,a +2e7d c39528 jp 2895h + +; ON_OTHER +2e80 cd103a call 3a10h ; GETINT +2e83 7e ld a,(hl) +2e84 47 ld b,a +2e85 fe91 cp 91h ; TK_GOSUB +2e87 2803 jr z,2e8ch +2e89 cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +2e8a 8d cp 8dh ; TK_GOTO +2e8b 2b dec hl +2e8c 4b ld c,e +2e8d 0d dec c +2e8e 78 ld a,b +2e8f ca4a2c jp z,2c4ah +2e92 cd462d call 2d46h +2e95 fe2c cp 2ch +2e97 c0 ret nz +2e98 18f3 jr 2e8dh + +; __RESUME +2e9a 1112fe ld de,0fe12h ; ONEFLG - Flag. FF during on error processing cleared by resume routine +2e9d 1a ld a,(de) +2e9e b7 or a +2e9f ca8a28 jp z,288ah ; ?TM Error +2ea2 3c inc a +2ea3 324efc ld (0fc4eh),a ; ERRFLG +2ea6 12 ld (de),a +2ea7 7e ld a,(hl) +2ea8 fe87 cp 87h +2eaa 280c jr z,2eb8h +2eac cd452d call 2d45h ; LNUM_PARM_0 - Get specified line number (2nd parameter) +2eaf c0 ret nz +2eb0 7a ld a,d +2eb1 b3 or e +2eb2 c2b02d jp nz,2db0h +2eb5 3c inc a +2eb6 1802 jr 2ebah + +2eb8 d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +2eb9 c0 ret nz +2eba 2a0efe ld hl,(0fe0eh) ; ERRTXT +2ebd eb ex de,hl +2ebe 2a0afe ld hl,(0fe0ah) ; ERRLIN: Line No. in which error occured. +2ec1 2256fc ld (0fc56h),hl ; CURLIN: Current line number +2ec4 eb ex de,hl +2ec5 c0 ret nz +2ec6 7e ld a,(hl) +2ec7 b7 or a +2ec8 2004 jr nz,2eceh +2eca 23 inc hl +2ecb 23 inc hl +2ecc 23 inc hl +2ecd 23 inc hl +2ece 23 inc hl +2ecf 7a ld a,d +2ed0 a3 and e +2ed1 3c inc a +2ed2 c2f02d jp nz,2df0h ; __DATA - DATA statement: find next DATA program line.. +2ed5 3afdfd ld a,(0fdfdh) ; Read flag: 0 = read statement active +2ed8 3d dec a +2ed9 caa92c jp z,2ca9h +2edc c3f02d jp 2df0h ; __DATA - DATA statement: find next DATA program line.. + +; __ERROR +2edf cd103a call 3a10h ; GETINT +2ee2 c0 ret nz +2ee3 b7 or a +2ee4 ca352d jp z,2d35h ; Error: Illegal function call (FC ERROR) +2ee7 3d dec a +2ee8 87 add a,a +2ee9 5f ld e,a +2eea fe2f cp 2fh +2eec 3802 jr c,2ef0h +2eee 1e26 ld e,26h ; ?LS Error +2ef0 c38c28 jp 288ch ; ERROR, E=error code + +; __AUTO: +2ef3 110a00 ld de,000ah +2ef6 d5 push de +2ef7 2817 jr z,2f10h +2ef9 cd3a2d call 2d3ah ; LNUM_PARM - Get specified line number +2efc eb ex de,hl +2efd e3 ex (sp),hl +2efe 2811 jr z,2f11h +2f00 eb ex de,hl +2f01 cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +2f02 2c defb ',' +2f03 eb ex de,hl +2f04 2a04fe ld hl,(0fe04h) ; AUTINC: Auto line increment +2f07 eb ex de,hl +2f08 2806 jr z,2f10h +2f0a cd452d call 2d45h ; LNUM_PARM_0 - Get specified line number (2nd parameter) +2f0d c28128 jp nz,2881h ; Syntax Error (SN ERROR) +2f10 eb ex de,hl +2f11 7c ld a,h +2f12 b5 or l +2f13 ca352d jp z,2d35h ; Error: Illegal function call (FC ERROR) +2f16 2204fe ld (0fe04h),hl ; AUTINC: Auto line increment +2f19 3201fe ld (0fe01h),a ; AUTFLG: Auto increment flag 0 = no auto mode, otherwise line number +2f1c e1 pop hl +2f1d 2202fe ld (0fe02h),hl ; AUTLIN: Current line number in binary (during input phase) +2f20 c1 pop bc +2f21 c31d29 jp 291dh ; PROMPT + +; __IF +2f24 cd2b32 call 322bh ; EVAL +2f27 7e ld a,(hl) +2f28 fe2c cp 2ch +2f2a cc622c call z,2c62h ; _CHRGTB - Pick next char from program +2f2d feca cp 0cah +2f2f cc622c call z,2c62h ; _CHRGTB - Pick next char from program +2f32 2b dec hl +2f33 e5 push hl +2f34 cdfe17 call 17feh ; _TSTSGN - Test sign in number +2f37 e1 pop hl +2f38 2807 jr z,2f41h +2f3a d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +2f3b daad2d jp c,2dadh ; __GOTO +2f3e c3492c jp 2c49h + +2f41 1601 ld d,01h +2f43 cdf02d call 2df0h ; __DATA - DATA statement: find next DATA program line.. +2f46 b7 or a +2f47 c8 ret z +2f48 d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +2f49 fe95 cp 95h +2f4b 20f6 jr nz,2f43h +2f4d 15 dec d +2f4e 20f3 jr nz,2f43h +2f50 18e8 jr 2f3ah + +; __LPRINT +2f52 3e01 ld a,01h +2f54 3250fc ld (0fc50h),a ; Output device code 0 = Video, 1 = Printer, -1 = Cassette +2f57 c3862f jp 2f86h + +; __PRINT +2f5a cdc6fe call 0fec6h +2f5d fe40 cp 40h +2f5f 2016 jr nz,2f77h +2f61 cdf539 call 39f5h ; FPSINT - Get subscript +2f64 cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +2f65 2c defb ',' +2f66 e5 push hl +2f67 2ae1fb ld hl,(0fbe1h) ; MAXIMUM No. CHARACTERS ALLOWED ON SCREEN +2f6a b7 or a +2f6b ed52 sbc hl,de +2f6d da352d jp c,2d35h ; Error: Illegal function call (FC ERROR) +2f70 ed53ddfb ld (0fbddh),de ; CURSOR POSITION relative to upper L.H. corner +2f74 e1 pop hl +2f75 180f jr 2f86h + +2f77 fe23 cp 23h +2f79 200b jr nz,2f86h +2f7b d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +2f7c cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +2f7d 2c defb ',' +2f7e cd2307 call 0723h ; Cassette write on routine +2f81 3e80 ld a,80h +2f83 3250fc ld (0fc50h),a ; Output device code 0 = Video, 1 = Printer, -1 = Cassette +2f86 2b dec hl +2f87 d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +2f88 cce92f call z,2fe9h +2f8b ca5430 jp z,3054h +2f8e febf cp 0bfh +2f90 cabb3b jp z,3bbbh +2f93 febc cp 0bch +2f95 ca2230 jp z,3022h +2f98 e5 push hl +2f99 fe2c cp 2ch +2f9b caf32f jp z,2ff3h +2f9e fe3b cp 3bh +2fa0 ca4f30 jp z,304fh +2fa3 c1 pop bc +2fa4 cd2b32 call 322bh ; EVAL +2fa7 e5 push hl +2fa8 e7 rst 20h ; GETYPR - Get the number type (FAC) +2fa9 2832 jr z,2fddh +2fab cd271e call 1e27h +2fae cd5937 call 3759h +2fb1 cdc9fe call 0fec9h +2fb4 2a41fe ld hl,(0fe41h) ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +2fb7 3a50fc ld a,(0fc50h) ; Output device code 0 = Video, 1 = Printer, -1 = Cassette +2fba b7 or a +2fbb fad42f jp m,2fd4h +2fbe 2808 jr z,2fc8h +2fc0 3a4ffc ld a,(0fc4fh) ; No. of characters printed on this line +2fc3 86 add a,(hl) +2fc4 fe84 cp 84h +2fc6 1809 jr 2fd1h + +2fc8 3a51fc ld a,(0fc51h) ; Size of video display line +2fcb 47 ld b,a +2fcc 3ac6fd ld a,(0fdc6h) ; CURPOS (a.k.a. TTYPOS) - Current cursor position (column number) +2fcf 86 add a,(hl) +2fd0 b8 cp b +2fd1 d4e92f call nc,2fe9h +2fd4 cd9e37 call 379eh ; PRS1 - Print string at HL +2fd7 3e20 ld a,20h ; ' ' +2fd9 cda00b call 0ba0h ; OUTC (alias OUTDO): print character +2fdc b7 or a +2fdd cc9e37 call z,379eh ; PRS1 - Print string at HL +2fe0 e1 pop hl +2fe1 c3862f jp 2f86h + +; CONSOLE_CRLF +2fe4 3ac6fd ld a,(0fdc6h) ; CURPOS (a.k.a. TTYPOS) - Current cursor position (column number) +2fe7 b7 or a +2fe8 c8 ret z +2fe9 3e0d ld a,0dh ; CR +2feb cda00b call 0ba0h ; OUTC (alias OUTDO): print character +2fee cdccfe call 0fecch +2ff1 af xor a +2ff2 c9 ret + +2ff3 cdcffe call 0fecfh +2ff6 3a50fc ld a,(0fc50h) ; Output device code 0 = Video, 1 = Printer, -1 = Cassette +2ff9 b7 or a +2ffa f20430 jp p,3004h +2ffd 3e2c ld a,2ch ; ',' +2fff cda00b call 0ba0h ; OUTC (alias OUTDO): print character +3002 184b jr 304fh + +3004 2808 jr z,300eh +3006 3a4ffc ld a,(0fc4fh) ; No. of characters printed on this line +3009 fe70 cp 70h +300b c31630 jp 3016h + + +300e 3a52fc ld a,(0fc52h) ; Last comma column position +3011 47 ld b,a +3012 3ac6fd ld a,(0fdc6h) ; CURPOS (a.k.a. TTYPOS) - Current cursor position (column number) +3015 b8 cp b +3016 d4e92f call nc,2fe9h +3019 3034 jr nc,304fh +301b d60e sub 0eh +301d 30fc jr nc,301bh +301f 2f cpl +3020 1823 jr 3045h + + +3022 cd0f3a call 3a0fh ; FNDNUM - Load 'A' with the next nume in BASIC program +3025 e6ff and 0ffh +3027 5f ld e,a +3028 cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +3029 29 defb '(' +302a 2b dec hl +302b e5 push hl +302c cdcffe call 0fecfh +302f 3a50fc ld a,(0fc50h) ; Output device code 0 = Video, 1 = Printer, -1 = Cassette +3032 b7 or a +3033 fa352d jp m,2d35h ; Error: Illegal function call (FC ERROR) +3036 ca3e30 jp z,303eh +3039 3a4ffc ld a,(0fc4fh) ; No. of characters printed on this line +303c 1803 jr 3041h + + +303e 3ac6fd ld a,(0fdc6h) ; CURPOS (a.k.a. TTYPOS) - Current cursor position (column number) +3041 2f cpl +3042 83 add a,e +3043 300a jr nc,304fh +3045 3c inc a +3046 47 ld b,a +3047 3e20 ld a,20h ; ' ' +3049 cda00b call 0ba0h ; OUTC (alias OUTDO): print character +304c 05 dec b +304d 20fa jr nz,3049h +304f e1 pop hl +3050 d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +3051 c38b2f jp 2f8bh + +3054 3a50fc ld a,(0fc50h) ; Output device code 0 = Video, 1 = Printer, -1 = Cassette +3057 b7 or a +3058 fc8007 call m,0780h ; Cassette off routine +305b af xor a +305c 3250fc ld (0fc50h),a ; Output device code 0 = Video, 1 = Printer, -1 = Cassette +305f cdbafe call 0febah +3062 c9 ret + +3063 3f ccf +3064 52 ld d,d +3065 45 ld b,l +3066 44 ld b,h +3067 4f ld c,a +3068 0d dec c +3069 00 nop +306a 3afefd ld a,(0fdfeh) ; FLGINP: 1 = input statement active. Also used in print using to hold seperator between string and variable. +306d b7 or a +306e c27b28 jp nz,287bh ; DATSNR - 'SN err' entry for Input STMT +3071 3ac9fd ld a,(0fdc9h) ; 0 if input from cassette else non-zero +3074 b7 or a +3075 1e2a ld e,2ah ; ?FD Error +3077 ca8c28 jp z,288ch ; ERROR, E=error code +307a c1 pop bc +307b 216330 ld hl,3063h +307e cd9b37 call 379bh ; PRS - Output a string +3081 2a06fe ld hl,(0fe06h) ; SAVTXT (During input: ADDR of code string for current statement) +3084 c9 ret + +; __INPUT +3085 cd1c37 call 371ch +3088 7e ld a,(hl) +3089 cda902 call 02a9h +308c d623 sub 23h +308e 32c9fd ld (0fdc9h),a ; 0 if input from cassette else non-zero +3091 7e ld a,(hl) +3092 2020 jr nz,30b4h +3094 cda502 call 02a5h +3097 e5 push hl +3098 06fa ld b,0fah +309a 2ac7fd ld hl,(0fdc7h) ; Pointer to address of keyboard buffer +309d cdc907 call 07c9h ; Casette read routine +30a0 77 ld (hl),a +30a1 23 inc hl +30a2 fe0d cp 0dh +30a4 2802 jr z,30a8h +30a6 10f5 djnz 309dh +30a8 2b dec hl +30a9 3600 ld (hl),00h +30ab cd8007 call 0780h ; Cassette off routine +30ae 2ac7fd ld hl,(0fdc7h) ; Pointer to address of keyboard buffer +30b1 2b dec hl +30b2 1822 jr 30d6h + +30b4 01c630 ld bc,30c6h +30b7 c5 push bc +30b8 fe22 cp 22h +30ba c0 ret nz +30bb cd5a37 call 375ah ; QTSTR - Create quote terminated String +30be cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +30bf 3b defb ';' +30c0 e5 push hl +30c1 cd9e37 call 379eh ; PRS1 - Print string at HL +30c4 e1 pop hl +30c5 c9 ret + +30c6 e5 push hl +30c7 cd9d2a call 2a9dh ; INLIN +30ca c1 pop bc +30cb daa92c jp c,2ca9h +30ce 23 inc hl +30cf 7e ld a,(hl) +30d0 b7 or a +30d1 2b dec hl +30d2 c5 push bc +30d3 caef2d jp z,2defh +30d6 362c ld (hl),2ch +30d8 180e jr 30e8h + +; __READ +30da fe23 cp 23h +30dc caa814 jp z,14a8h ; '#' + +30df 3c inc a +30e0 32c9fd ld (0fdc9h),a ; 0 if input from cassette else non-zero +30e3 e5 push hl +30e4 2a1ffe ld hl,(0fe1fh) ; Points to byte following last char +30e7 f6af or 0afh +30e9 32fefd ld (0fdfeh),a ; FLGINP: 1 = input statement active. Also used in print using to hold seperator between string and variable. +30ec e3 ex (sp),hl +30ed 1802 jr 30f1h + +30ef cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +30f0 2c defb ',' +30f1 cd0135 call 3501h ; GETVAR: Find address of variable +30f4 e3 ex (sp),hl +30f5 d5 push de +30f6 7e ld a,(hl) +30f7 fe2c cp 2ch +30f9 2826 jr z,3121h +30fb 3afefd ld a,(0fdfeh) ; FLGINP: 1 = input statement active. Also used in print using to hold seperator between string and variable. +30fe b7 or a +30ff c28a31 jp nz,318ah ; FDTLP - Find next DATA statement +3102 3ac9fd ld a,(0fdc9h) ; 0 if input from cassette else non-zero +3105 b7 or a +3106 1e06 ld e,06h ;?OD Error (out of DATA) +3108 ca8c28 jp z,288ch ; ERROR, E=error code +310b 3e3f ld a,3fh ; '?' +310d cda00b call 0ba0h ; OUTC (alias OUTDO): print character +3110 cd9d2a call 2a9dh ; INLIN +3113 d1 pop de +3114 c1 pop bc +3115 daa92c jp c,2ca9h +3118 23 inc hl +3119 7e ld a,(hl) +311a b7 or a +311b 2b dec hl +311c c5 push bc +311d caef2d jp z,2defh +3120 d5 push de +3121 cdd8fe call 0fed8h +3124 e7 rst 20h ; GETYPR - Get the number type (FAC) +3125 f5 push af +3126 2019 jr nz,3141h +3128 d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +3129 57 ld d,a +312a 47 ld b,a +312b fe22 cp 22h +312d 2805 jr z,3134h +312f 163a ld d,3ah +3131 062c ld b,2ch +3133 2b dec hl +3134 cd5d37 call 375dh ; DTSTR - Create String, termination char in D +3137 f1 pop af +3138 eb ex de,hl +3139 214e31 ld hl,314eh +313c e3 ex (sp),hl +313d d5 push de +313e c31e2e jp 2e1eh + +3141 d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +3142 f1 pop af +3143 f5 push af +3144 013731 ld bc,3137h +3147 c5 push bc +3148 dad61c jp c,1cd6h +314b d2cf1c jp nc,1ccfh ; DBL_ASCTFP - ASCII to Double precision FP number +314e 2b dec hl +314f d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +3150 2805 jr z,3157h +3152 fe2c cp 2ch +3154 c26a30 jp nz,306ah +3157 e3 ex (sp),hl +3158 2b dec hl +3159 d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +315a c2ef30 jp nz,30efh +315d d1 pop de +315e 3ac9fd ld a,(0fdc9h) ; 0 if input from cassette else non-zero +3161 b7 or a +3162 c8 ret z +3163 3afefd ld a,(0fdfeh) ; FLGINP: 1 = input statement active. Also used in print using to hold seperator between string and variable. +3166 b7 or a +3167 eb ex de,hl +3168 c2802c jp nz,2c80h +316b d5 push de +316c cddbfe call 0fedbh +316f b6 or (hl) +3170 217a31 ld hl,317ah +3173 c49b37 call nz,379bh ; PRS - Output a string +3176 e1 pop hl +3177 c35430 jp 3054h + + +317a 3f ccf +317b 45 ld b,l +317c 78 ld a,b +317d 74 ld (hl),h +317e 72 ld (hl),d +317f 61 ld h,c +3180 2069 jr nz,31ebh +3182 67 ld h,a +3183 6e ld l,(hl) +3184 6f ld l,a +3185 72 ld (hl),d +3186 65 ld h,l +3187 64 ld h,h +3188 0d dec c +3189 00 nop + +; FDTLP - Find next DATA statement +318a cdf02d call 2df0h ; __DATA - DATA statement: find next DATA program line.. +318d b7 or a +318e 2012 jr nz,31a2h +3190 23 inc hl +3191 7e ld a,(hl) +3192 23 inc hl +3193 b6 or (hl) +3194 1e06 ld e,06h ;?OD Error (out of DATA) +3196 ca8c28 jp z,288ch ; ERROR, E=error code +3199 23 inc hl +319a 5e ld e,(hl) +319b 23 inc hl +319c 56 ld d,(hl) +319d eb ex de,hl +319e 22fafd ld (0fdfah),hl ; Line No. of last data statement +31a1 eb ex de,hl +31a2 d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +31a3 fe88 cp 88h +31a5 20e3 jr nz,318ah ; FDTLP - Find next DATA statement +31a7 c32131 jp 3121h + +; __NEXT +31aa 110000 ld de,0000h +31ad c40135 call nz,3501h ; GETVAR: Find address of variable +31b0 22fffd ld (0fdffh),hl +31b3 cd2028 call 2820h +31b6 c28728 jp nz,2887h ; ?NF Error (next without for) +31b9 f9 ld sp,hl +31ba 2208fe ld (0fe08h),hl ; During execution: stack pointer value when statement execution begins. +31bd d5 push de +31be 7e ld a,(hl) +31bf 23 inc hl +31c0 f5 push af +31c1 d5 push de +31c2 7e ld a,(hl) +31c3 23 inc hl +31c4 b7 or a +31c5 fade31 jp m,31deh +31c8 cd1b18 call 181bh ; PHLTFP - Move a single precision value -> HL to FPREG +31cb e3 ex (sp),hl +31cc e5 push hl +31cd cd7515 call 1575h ; ADDPHL - ADD number at HL to BCDE +31d0 e1 pop hl +31d1 cd3518 call 1835h ; DEC_FACCU2HL - copy number value from FPREG (FP accumulator) to HL +31d4 e1 pop hl +31d5 cd2c18 call 182ch ; LOADFP: Load single precision value pointed by (HL) into BC/DE +31d8 e5 push hl +31d9 cd7618 call 1876h ; CMPNUM - Compare FP reg to BCDE +31dc 1829 jr 3207h + + + +31de 23 inc hl +31df 23 inc hl +31e0 23 inc hl +31e1 23 inc hl +31e2 4e ld c,(hl) +31e3 23 inc hl +31e4 46 ld b,(hl) +31e5 23 inc hl +31e6 e3 ex (sp),hl +31e7 5e ld e,(hl) +31e8 23 inc hl +31e9 56 ld d,(hl) +31ea e5 push hl +31eb 69 ld l,c +31ec 60 ld h,b +31ed cd3c1a call 1a3ch +31f0 3acffd ld a,(0fdcfh) ; Type flag for FPREG: 2 - Integer, 3 - String, 4 - Single, 5 - Double +31f3 fe04 cp 04h +31f5 ca1c16 jp z,161ch ; Overflow Error (OV ERROR) +31f8 eb ex de,hl +31f9 e1 pop hl +31fa 72 ld (hl),d +31fb 2b dec hl +31fc 73 ld (hl),e +31fd e1 pop hl +31fe d5 push de +31ff 5e ld e,(hl) +3200 23 inc hl +3201 56 ld d,(hl) +3202 23 inc hl +3203 e3 ex (sp),hl +3204 cda318 call 18a3h ; ICOMP +3207 e1 pop hl +3208 c1 pop bc +3209 90 sub b +320a cd2c18 call 182ch ; LOADFP: Load single precision value pointed by (HL) into BC/DE +320d 2809 jr z,3218h +320f eb ex de,hl +3210 2256fc ld (0fc56h),hl ; CURLIN: Current line number +3213 69 ld l,c +3214 60 ld h,b +3215 c3042c jp 2c04h + +3218 f9 ld sp,hl +3219 2208fe ld (0fe08h),hl ; During execution: stack pointer value when statement execution begins. +321c 2afffd ld hl,(0fdffh) +321f 7e ld a,(hl) +3220 fe2c cp 2ch +3222 c2082c jp nz,2c08h +3225 d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +3226 cdad31 call 31adh + +; OPNPAR - Chk Syntax, make sure '(' follows +3229 cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +322a 28 defb '(' + +; EVAL +; a.k.a. GETNUM, evaluate expression +322b 2b dec hl +; __EVAL__ +322c 1600 ld d,00h + +; EVAL1 +; Save precedence and eval until precedence break +322e d5 push de +; __EVAL1__ - Save precedence and eval until precedence break +322f 0e01 ld c,01h +3231 cd4d28 call 284dh ; CHKSTK - Check for C levels of stack +3234 cd9333 call 3393h ; OPRND: Get next expression value +; EVAL2 - Evaluate expression until precedence break +3237 2213fe ld (0fe13h),hl ; NXTOPR: Next operand, addr of decimal point in PBUF, etc.. +; EVAL3 - Evaluate expression until precedence break +323a 2a13fe ld hl,(0fe13h) ; NXTOPR: Next operand, addr of decimal point in PBUF, etc.. +323d c1 pop bc +323e 7e ld a,(hl) +323f 1600 ld d,00h +3241 d6d4 sub 0d4h +3243 3813 jr c,3258h +3245 fe03 cp 03h +3247 300f jr nc,3258h +3249 fe01 cp 01h +324b 17 rla +324c aa xor d +324d ba cp d +324e 57 ld d,a +324f da8128 jp c,2881h ; Syntax Error (SN ERROR) +3252 22f8fd ld (0fdf8h),hl ; 1: Index of last byte executed in current statement- 2: Edit flag during print using +3255 d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +3256 18e9 jr 3241h + + +3258 7a ld a,d +3259 b7 or a +325a c2e032 jp nz,32e0h +325d 7e ld a,(hl) +325e 22f8fd ld (0fdf8h),hl ; 1: Index of last byte executed in current statement- 2: Edit flag during print using +3261 d6cd sub 0cdh +3263 d8 ret c +3264 fe07 cp 07h +3266 d0 ret nc +3267 5f ld e,a +3268 3acffd ld a,(0fdcfh) ; Type flag for FPREG: 2 - Integer, 3 - String, 4 - Single, 5 - Double +326b d603 sub 03h +326d b3 or e +326e ca8338 jp z,3883h ; CONCAT - String concatenation +3271 218227 ld hl,2782h ; PRITAB - ARITHMETIC PRECEDENCE TABLE +3274 19 add hl,de +3275 78 ld a,b +3276 56 ld d,(hl) +3277 ba cp d +3278 d0 ret nc +3279 c5 push bc +327a 013a32 ld bc,323ah ; EVAL3 - Evaluate expression until precedence break +327d c5 push bc +327e 7a ld a,d +327f fe7f cp 7fh +3281 cac832 jp z,32c8h +3284 fe51 cp 51h +3286 dad532 jp c,32d5h +3289 2141fe ld hl,0fe41h ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +328c b7 or a +328d 3acffd ld a,(0fdcfh) ; Type flag for FPREG: 2 - Integer, 3 - String, 4 - Single, 5 - Double +3290 3d dec a +3291 3d dec a +3292 3d dec a +3293 ca6019 jp z,1960h ; TYPE_ERR +3296 4e ld c,(hl) +3297 23 inc hl +3298 46 ld b,(hl) +3299 c5 push bc +329a fab932 jp m,32b9h +329d 23 inc hl +329e 4e ld c,(hl) +329f 23 inc hl +32a0 46 ld b,(hl) +32a1 c5 push bc +32a2 f5 push af +32a3 b7 or a +32a4 e2b832 jp po,32b8h +32a7 f1 pop af +32a8 23 inc hl +32a9 3803 jr c,32aeh +32ab 213dfe ld hl,0fe3dh +32ae 4e ld c,(hl) +32af 23 inc hl +32b0 46 ld b,(hl) +32b1 23 inc hl +32b2 c5 push bc +32b3 4e ld c,(hl) +32b4 23 inc hl +32b5 46 ld b,(hl) +32b6 c5 push bc +32b7 06f1 ld b,0f1h +32b9 c603 add a,03h +32bb 4b ld c,e +32bc 47 ld b,a +32bd c5 push bc +32be 01fa32 ld bc,32fah +32c1 c5 push bc +32c2 2af8fd ld hl,(0fdf8h) ; 1: Index of last byte executed in current statement- 2: Edit flag during print using +32c5 c32e32 jp 322eh ; EVAL1 + + +32c8 cd1b19 call 191bh ; __CSNG: Integer to single precision +32cb cd0e18 call 180eh ; STAKFP: Move FPREG to stack +32ce 015c22 ld bc,225ch +32d1 167f ld d,7fh +32d3 18ec jr 32c1h + + +32d5 d5 push de +32d6 cde918 call 18e9h ; __CINT: Floating point to Integer +32d9 d1 pop de +32da e5 push hl +32db 01dd34 ld bc,34ddh +32de 18e1 jr 32c1h + +32e0 78 ld a,b +32e1 fe64 cp 64h +32e3 d0 ret nc +32e4 c5 push bc +32e5 d5 push de +32e6 110464 ld de,6404h +32e9 21ac34 ld hl,34ach +32ec e5 push hl +32ed e7 rst 20h ; GETYPR - Get the number type (FAC) +32ee c28932 jp nz,3289h +32f1 2a41fe ld hl,(0fe41h) ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +32f4 e5 push hl +32f5 018034 ld bc,3480h +32f8 18c7 jr 32c1h + +32fa c1 pop bc +32fb 79 ld a,c +32fc 32d0fd ld (0fdd0h),a +32ff 78 ld a,b +3300 fe08 cp 08h +3302 2828 jr z,332ch +3304 3acffd ld a,(0fdcfh) ; Type flag for FPREG: 2 - Integer, 3 - String, 4 - Single, 5 - Double +3307 fe08 cp 08h +3309 ca5433 jp z,3354h +330c 57 ld d,a +330d 78 ld a,b +330e fe04 cp 04h +3310 ca6633 jp z,3366h +3313 7a ld a,d +3314 fe03 cp 03h +3316 ca6019 jp z,1960h ; TYPE_ERR +3319 d27033 jp nc,3370h +331c 21a727 ld hl,27a7h ; INT_OPR - INTEGER ARITHMETIC OPERATIONS TABLE +331f 0600 ld b,00h +3321 09 add hl,bc +3322 09 add hl,bc +3323 4e ld c,(hl) +3324 23 inc hl +3325 46 ld b,(hl) +3326 d1 pop de +3327 2a41fe ld hl,(0fe41h) ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +332a c5 push bc +332b c9 ret + +332c cd4519 call 1945h ; __CDBL +332f cd6618 call 1866h ; FP_ARG2HL +3332 e1 pop hl +3333 223ffe ld (0fe3fh),hl +3336 e1 pop hl +3337 223dfe ld (0fe3dh),hl +333a c1 pop bc +333b d1 pop de +333c cd1e18 call 181eh ; FPBCDE: Move single precision value in BC/DE into FPREG +333f cd4519 call 1945h ; __CDBL +3342 219327 ld hl,2793h ; DEC_OPR: DOUBLE PRECISION ARITHMETIC OPERATIONS TABLE +3345 3ad0fd ld a,(0fdd0h) +3348 07 rlca +3349 c5 push bc +334a 4f ld c,a +334b 0600 ld b,00h +334d 09 add hl,bc +334e c1 pop bc +334f 7e ld a,(hl) +3350 23 inc hl +3351 66 ld h,(hl) +3352 6f ld l,a +3353 e9 jp (hl) +3354 c5 push bc +3355 cd6618 call 1866h ; FP_ARG2HL +3358 f1 pop af +3359 32cffd ld (0fdcfh),a ; Type flag for FPREG: 2 - Integer, 3 - String, 4 - Single, 5 - Double +335c fe04 cp 04h +335e 28da jr z,333ah +3360 e1 pop hl +3361 2241fe ld (0fe41h),hl ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +3364 18d9 jr 333fh + +3366 cd1b19 call 191bh ; __CSNG: Integer to single precision +3369 c1 pop bc +336a d1 pop de +336b 219d27 ld hl,279dh ; FLT_OPR - SINGLE PRECISION ARITHMETIC OPERATIONS TABLE +336e 18d5 jr 3345h + + +3370 e1 pop hl +3371 cd0e18 call 180eh ; STAKFP: Move FPREG to stack +3374 cd3919 call 1939h +3377 cd2918 call 1829h ; BCDEFP: Load a single precision value from FPREG into BC/DE +337a e1 pop hl +337b 2243fe ld (0fe43h),hl ; LAST-FPREG - Last byte in Single Precision FP Register (+sign bit) +337e e1 pop hl +337f 2241fe ld (0fe41h),hl ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +3382 18e7 jr 336bh + +3384 e5 push hl +3385 eb ex de,hl +3386 cd3919 call 1939h +3389 e1 pop hl +338a cd0e18 call 180eh ; STAKFP: Move FPREG to stack +338d cd3919 call 1939h +3390 c30a17 jp 170ah ; DIV - Divide FP by number on stack + +; OPRND: Get next expression value +3393 d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +3394 1e28 ld e,28h ; ?LS Error +3396 ca8c28 jp z,288ch ; ERROR, E=error code +3399 dad61c jp c,1cd6h +339c cd282d call 2d28h ; IS_ALPHA_A +339f d23434 jp nc,3434h +33a2 fecd cp 0cdh ; TK_PLUS +33a4 28ed jr z,3393h ; OPRND: Get next expression value +33a6 fe2e cp 2eh ; '.' +33a8 cad61c jp z,1cd6h +33ab fece cp 0ceh ; TK_MINUS +33ad ca2634 jp z,3426h ; OPRND_SUB +33b0 fe22 cp 22h ; '"' +33b2 ca5a37 jp z,375ah ; QTSTR - Create quote terminated String +33b5 fecb cp 0cbh ; TK_NOT +33b7 cab834 jp z,34b8h; : _NOT +33ba fe26 cp 26h ; '&' +33bc ca203f jp z,3f20h ; HEXTFP +33bf fec3 cp 0c3h ; TK_ERR +33c1 200a jr nz,33cdh ; OPRND_0 + +; __ERR +33c3 d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +33c4 3a4efc ld a,(0fc4eh) ; ERRFLG +33c7 e5 push hl +33c8 cdec36 call 36ech ; UNSIGNED_RESULT_A +33cb e1 pop hl +33cc c9 ret + +; OPRND_0 +33cd fec2 cp 0c2h +33cf 200a jr nz,33dbh +33d1 d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +33d2 e5 push hl +33d3 2a0afe ld hl,(0fe0ah) ; ERRLIN: Line No. in which error occured. +33d6 cdd01a call 1ad0h +33d9 e1 pop hl +33da c9 ret + +33db fec0 cp 0c0h +33dd 2014 jr nz,33f3h ; OPRND_2 +33df d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +33e0 cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +33e1 28 defb '(' +33e2 cd0135 call 3501h ; GETVAR: Find address of variable +33e5 cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +33e6 29 defb ')' +33e7 e5 push hl +33e8 eb ex de,hl +33e9 7c ld a,h +33ea b5 or l +33eb ca352d jp z,2d35h ; Error: Illegal function call (FC ERROR) +33ee cd0419 call 1904h ; INT_RESULT_HL +33f1 e1 pop hl +33f2 c9 ret + +; OPRND_2 +33f3 fec1 cp 0c1h ; TK_USR +33f5 caf236 jp z,36f2h ; FN_USR +33f8 fec5 cp 0c5h ; TK_INSTR +33fa ca243f jp z,3f24h ; FN_INSTR +33fd fec8 cp 0c8h ; TK_MEM +33ff cabd36 jp z,36bdh ; FN_MEM +3402 fec7 cp 0c7h ; TK_TIME +3404 ca96fe jp z,0fe96h ; FN_TIME +3407 fec6 cp 0c6h ; TK_POINT +3409 cae10d jp z,0de1h ; FN_POINT +340c fec9 cp 0c9h ; TK_INKEY +340e cabe09 jp z,09beh ; FN_INKEY +3411 fec4 cp 0c4h ; TK_STRING +3413 ca2339 jp z,3923h ; FN_STRING +3416 febe cp 0beh ; TK_FN +3418 ca75fe jp z,0fe75h ; FN_FN +341b d6d7 sub 0d7h +341d d24234 jp nc,3442h + +; OPRND_6 +3420 cd2932 call 3229h ; OPNPAR - Chk Syntax, make sure '(' follows +3423 cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +3424 29 defb '(' +3425 c9 ret + +; OPRND_SUB: +3426 167d ld d,7dh +3428 cd2e32 call 322eh ; EVAL1 +342b 2a13fe ld hl,(0fe13h) ; NXTOPR: Next operand, addr of decimal point in PBUF, etc.. +342e e5 push hl +342f cde517 call 17e5h ; INVSGN +3432 e1 pop hl +3433 c9 ret + +3434 cd0135 call 3501h ; GETVAR: Find address of variable +3437 e5 push hl +3438 eb ex de,hl +3439 2241fe ld (0fe41h),hl ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +343c e7 rst 20h ; GETYPR - Get the number type (FAC) +343d c46118 call nz,1861h +3440 e1 pop hl +3441 c9 ret + +3442 0600 ld b,00h +3444 07 rlca +3445 4f ld c,a +3446 c5 push bc +3447 d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +3448 79 ld a,c +3449 fe41 cp 41h +344b 3816 jr c,3463h +344d cd2932 call 3229h ; OPNPAR - Chk Syntax, make sure '(' follows +3450 cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +3451 2c defb ',' +3452 cd5e19 call 195eh ; TSTSTR - Test a string, 'Type Error' if it is not +3455 eb ex de,hl +3456 2a41fe ld hl,(0fe41h) ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +3459 e3 ex (sp),hl +345a e5 push hl +345b eb ex de,hl +345c cd103a call 3a10h ; GETINT +345f eb ex de,hl +3460 e3 ex (sp),hl +3461 1814 jr 3477h + + +3463 cd2034 call 3420h ; OPRND_6 +3466 e3 ex (sp),hl +3467 7d ld a,l +3468 fe0c cp 0ch +346a 3807 jr c,3473h +346c fe1b cp 1bh +346e e5 push hl +346f dc1b19 call c,191bh ; __CSNG: Integer to single precision +3472 e1 pop hl +3473 113234 ld de,3432h +3476 d5 push de +3477 01e624 ld bc,24e6h ; # JP table for functions = $24E6 +347a 09 add hl,bc +347b 4e ld c,(hl) +347c 23 inc hl +347d 66 ld h,(hl) +347e 69 ld l,c +347f e9 jp (hl) +3480 cdcb38 call 38cbh ; GETSTR - Get string pointed by FPREG 'Type Error' if it is not +3483 7e ld a,(hl) +3484 23 inc hl +3485 4e ld c,(hl) +3486 23 inc hl +3487 46 ld b,(hl) +3488 d1 pop de +3489 c5 push bc +348a f5 push af +348b cdd238 call 38d2h ; GSTRDE - Get string pointed by DE +348e d1 pop de +348f 5e ld e,(hl) +3490 23 inc hl +3491 4e ld c,(hl) +3492 23 inc hl +3493 46 ld b,(hl) +3494 e1 pop hl +3495 7b ld a,e +3496 b2 or d +3497 c8 ret z +3498 7a ld a,d +3499 d601 sub 01h +349b d8 ret c +349c af xor a +349d bb cp e +349e 3c inc a +349f d0 ret nc +34a0 15 dec d +34a1 1d dec e +34a2 0a ld a,(bc) +34a3 be cp (hl) +34a4 23 inc hl +34a5 03 inc bc +34a6 28ed jr z,3495h +34a8 3f ccf +34a9 c3ca17 jp 17cah +34ac 3c inc a +34ad 8f adc a,a +34ae c1 pop bc +34af a0 and b +34b0 c6ff add a,0ffh +34b2 9f sbc a,a +34b3 cdf717 call 17f7h ; INT_RESULT_A - Get back from function, result in A (signed) +34b6 1812 jr 34cah + +; _NOT +34b8 165a ld d,5ah +34ba cd2e32 call 322eh ; EVAL1 +34bd cde918 call 18e9h ; __CINT: Floating point to Integer +34c0 7d ld a,l +34c1 2f cpl +34c2 6f ld l,a +34c3 7c ld a,h +34c4 2f cpl +34c5 67 ld h,a +34c6 2241fe ld (0fe41h),hl ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +34c9 c1 pop bc +34ca c33a32 jp 323ah ; EVAL3 - Evaluate expression until precedence break + +; GETYPR - Get the number type (FAC) +34cd 3acffd ld a,(0fdcfh) ; Type flag for FPREG: 2 - Integer, 3 - String, 4 - Single, 5 - Double +34d0 fe08 cp 08h +34d2 3005 jr nc,34d9h +34d4 d603 sub 03h +34d6 b7 or a +34d7 37 scf +34d8 c9 ret + +34d9 d603 sub 03h +34db b7 or a +34dc c9 ret + +34dd c5 push bc +34de cde918 call 18e9h ; __CINT: Floating point to Integer +34e1 f1 pop af +34e2 d1 pop de +34e3 01ee36 ld bc,36eeh +34e6 c5 push bc +34e7 fe46 cp 46h +34e9 2006 jr nz,34f1h +34eb 7b ld a,e +34ec b5 or l +34ed 6f ld l,a +34ee 7c ld a,h +34ef b2 or d +34f0 c9 ret + +34f1 7b ld a,e +34f2 a5 and l +34f3 6f ld l,a +34f4 7c ld a,h +34f5 a2 and d +34f6 c9 ret + +34f7 2b dec hl +34f8 d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +34f9 c8 ret z +34fa cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +34fb 2c defb ',' + +; __DIM +34fc 01f734 ld bc,34f7h ; (SP) = {POP HL / RET} +34ff c5 push bc +;3500 f6af or 0afh +3500 defb f6h ; OR $AF +; GETVAR: Find address of variable +3501 af xor a +3502 32cefd ld (0fdceh),a ; DIMFLG aka LCRFLG (Locate/Create and Type +3505 46 ld b,(hl) +3506 cd282d call 2d28h ; IS_ALPHA_A +3509 da8128 jp c,2881h ; Syntax Error (SN ERROR) +350c af xor a +350d 4f ld c,a +350e d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +350f 3805 jr c,3516h +3511 cd282d call 2d28h ; IS_ALPHA_A +3514 3809 jr c,351fh +3516 4f ld c,a +3517 d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +3518 38fd jr c,3517h +351a cd282d call 2d28h ; IS_ALPHA_A +351d 30f8 jr nc,3517h +351f 114635 ld de,3546h +3522 d5 push de +3523 1602 ld d,02h +3525 fe25 cp 25h +3527 c8 ret z +3528 14 inc d +3529 fe24 cp 24h +352b c8 ret z +352c 14 inc d + + +352d fe21 cp 21h +352f c8 ret z +3530 1608 ld d,08h +3532 fe23 cp 23h +3534 c8 ret z +3535 78 ld a,b +3536 d641 sub 41h +3538 e67f and 7fh +353a 5f ld e,a +353b 1600 ld d,00h +353d e5 push hl +353e 2121fe ld hl,0fe21h ; Variable declaration list. 26 entries, each containing a code inicating default mode for that initial letter +3541 19 add hl,de +3542 56 ld d,(hl) +3543 e1 pop hl +3544 2b dec hl +3545 c9 ret + +3546 7a ld a,d +3547 32cffd ld (0fdcfh),a ; Type flag for FPREG: 2 - Integer, 3 - String, 4 - Single, 5 - Double +354a d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +354b 3afcfd ld a,(0fdfch) ; FOR flag (1 = 'for' in progress, 0 = no 'for' in progress) +354e b7 or a +354f c25835 jp nz,3558h +3552 7e ld a,(hl) +3553 d628 sub 28h +3555 cadd35 jp z,35ddh ; SBSCPT - Sort out subscript +3558 af xor a +3559 32fcfd ld (0fdfch),a ; FOR flag (1 = 'for' in progress, 0 = no 'for' in progress) +355c e5 push hl +355d d5 push de +355e 2a19fe ld hl,(0fe19h) ; Addr of simple variables +3561 eb ex de,hl +3562 2a1bfe ld hl,(0fe1bh) ; VAREND: Addr of dimensioned variables +3565 df rst 18h ; DCOMPR - Compare HL with DE. +3566 e1 pop hl +3567 2819 jr z,3582h +3569 1a ld a,(de) +356a 6f ld l,a +356b bc cp h +356c 13 inc de +356d 200b jr nz,357ah +356f 1a ld a,(de) +3570 b9 cp c +3571 2007 jr nz,357ah +3573 13 inc de +3574 1a ld a,(de) +3575 b8 cp b +3576 cac035 jp z,35c0h +3579 3e13 ld a,13h +357b 13 inc de +357c e5 push hl +357d 2600 ld h,00h +357f 19 add hl,de +3580 18df jr 3561h + + +3582 7c ld a,h +3583 e1 pop hl +3584 e3 ex (sp),hl +3585 f5 push af +3586 d5 push de +3587 11e533 ld de,33e5h +358a df rst 18h ; DCOMPR - Compare HL with DE. +358b 2836 jr z,35c3h +358d 113734 ld de,3437h +3590 df rst 18h ; DCOMPR - Compare HL with DE. +3591 d1 pop de +3592 2835 jr z,35c9h +3594 f1 pop af +3595 e3 ex (sp),hl +3596 e5 push hl +3597 c5 push bc +3598 4f ld c,a +3599 0600 ld b,00h +359b c5 push bc +359c 03 inc bc +359d 03 inc bc +359e 03 inc bc +359f 2a1dfe ld hl,(0fe1dh) ; ARREND - Starting address of free space list (FSL) +35a2 e5 push hl +35a3 09 add hl,bc +35a4 c1 pop bc +35a5 e5 push hl +35a6 cd3f28 call 283fh +35a9 e1 pop hl +35aa 221dfe ld (0fe1dh),hl ; ARREND - Starting address of free space list (FSL) +35ad 60 ld h,b +35ae 69 ld l,c +35af 221bfe ld (0fe1bh),hl ; VAREND: Addr of dimensioned variables +35b2 2b dec hl +35b3 3600 ld (hl),00h +35b5 df rst 18h ; DCOMPR - Compare HL with DE. +35b6 20fa jr nz,35b2h +35b8 d1 pop de +35b9 73 ld (hl),e +35ba 23 inc hl +35bb d1 pop de +35bc 73 ld (hl),e +35bd 23 inc hl +35be 72 ld (hl),d +35bf eb ex de,hl +35c0 13 inc de +35c1 e1 pop hl +35c2 c9 ret + +35c3 57 ld d,a +35c4 5f ld e,a +35c5 f1 pop af +35c6 f1 pop af +35c7 e3 ex (sp),hl +35c8 c9 ret + +35c9 3244fe ld (0fe44h),a ; FPEXP - Floating Point Exponent +35cc c1 pop bc +35cd 67 ld h,a +35ce 6f ld l,a +35cf 2241fe ld (0fe41h),hl ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +35d2 e7 rst 20h ; GETYPR - Get the number type (FAC) +35d3 2006 jr nz,35dbh +35d5 211228 ld hl,2812h +35d8 2241fe ld (0fe41h),hl ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +35db e1 pop hl +35dc c9 ret + +; SBSCPT - Sort out subscript +35dd e5 push hl +35de 2acefd ld hl,(0fdceh) ; DIMFLG aka LCRFLG (Locate/Create and Type +35e1 e3 ex (sp),hl +35e2 57 ld d,a +; SCPTLP - SBSCPT loop +35e3 d5 push de +35e4 c5 push bc +35e5 cd302d call 2d30h +35e8 c1 pop bc +35e9 f1 pop af +35ea eb ex de,hl +35eb e3 ex (sp),hl +35ec e5 push hl +35ed eb ex de,hl +35ee 3c inc a +35ef 57 ld d,a +35f0 7e ld a,(hl) +35f1 fe2c cp 2ch +35f3 28ee jr z,35e3h ; SCPTLP - SBSCPT loop +35f5 cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +35f6 29 defb '(' +35f7 2213fe ld (0fe13h),hl ; NXTOPR: Next operand, addr of decimal point in PBUF, etc.. +35fa e1 pop hl +35fb 22cefd ld (0fdceh),hl ; DIMFLG aka LCRFLG (Locate/Create and Type +35fe d5 push de +35ff 2a1bfe ld hl,(0fe1bh) ; VAREND: Addr of dimensioned variables +3602 3e19 ld a,19h +3604 eb ex de,hl +3605 2a1dfe ld hl,(0fe1dh) ; ARREND - Starting address of free space list (FSL) +3608 eb ex de,hl +3609 df rst 18h ; DCOMPR - Compare HL with DE. +360a 3acffd ld a,(0fdcfh) ; Type flag for FPREG: 2 - Integer, 3 - String, 4 - Single, 5 - Double +360d 2827 jr z,3636h +360f be cp (hl) +3610 23 inc hl +3611 2008 jr nz,361bh +3613 7e ld a,(hl) +3614 b9 cp c +3615 23 inc hl +3616 2004 jr nz,361ch +3618 7e ld a,(hl) +3619 b8 cp b +361a 3e23 ld a,23h +361c 23 inc hl +361d 5e ld e,(hl) +361e 23 inc hl +361f 56 ld d,(hl) +3620 23 inc hl +3621 20e0 jr nz,3603h +3623 3acefd ld a,(0fdceh) ; DIMFLG aka LCRFLG (Locate/Create and Type +3626 b7 or a +3627 1e12 ld e,12h ; ?DD Error +3629 c28c28 jp nz,288ch ; ERROR, E=error code +362c f1 pop af +362d 96 sub (hl) +362e ca8936 jp z,3689h +3631 1e10 ld e,10h ; ?BS Error +3633 c38c28 jp 288ch ; ERROR, E=error code + +3636 77 ld (hl),a +3637 23 inc hl +3638 5f ld e,a +3639 1600 ld d,00h +363b f1 pop af +363c 71 ld (hl),c +363d 23 inc hl +363e 70 ld (hl),b +363f 23 inc hl +3640 4f ld c,a +3641 cd4d28 call 284dh ; CHKSTK - Check for C levels of stack +3644 23 inc hl +3645 23 inc hl +3646 22f8fd ld (0fdf8h),hl ; 1: Index of last byte executed in current statement- 2: Edit flag during print using +3649 71 ld (hl),c +364a 23 inc hl +364b 3acefd ld a,(0fdceh) ; DIMFLG aka LCRFLG (Locate/Create and Type +364e 17 rla +364f 79 ld a,c +3650 010b00 ld bc,000bh +3653 3002 jr nc,3657h +3655 c1 pop bc +3656 03 inc bc +3657 71 ld (hl),c +3658 23 inc hl +3659 70 ld (hl),b +365a 23 inc hl +365b f5 push af +365c cd141a call 1a14h ; MLDEBC - Multiply DE by BC +365f f1 pop af +3660 3d dec a +3661 20ed jr nz,3650h +3663 f5 push af +3664 42 ld b,d +3665 4b ld c,e +3666 eb ex de,hl +3667 19 add hl,de +3668 38c7 jr c,3631h +366a cd5628 call 2856h +366d 221dfe ld (0fe1dh),hl ; ARREND - Starting address of free space list (FSL) +3670 2b dec hl +3671 3600 ld (hl),00h +3673 df rst 18h ; DCOMPR - Compare HL with DE. +3674 20fa jr nz,3670h +3676 03 inc bc +3677 57 ld d,a +3678 2af8fd ld hl,(0fdf8h) ; 1: Index of last byte executed in current statement- 2: Edit flag during print using +367b 5e ld e,(hl) +367c eb ex de,hl +367d 29 add hl,hl +367e 09 add hl,bc +367f eb ex de,hl +3680 2b dec hl +3681 2b dec hl +3682 73 ld (hl),e +3683 23 inc hl +3684 72 ld (hl),d +3685 23 inc hl +3686 f1 pop af +3687 3830 jr c,36b9h +3689 47 ld b,a +368a 4f ld c,a +368b 7e ld a,(hl) +368c 23 inc hl +368d 16e1 ld d,0e1h +368f 5e ld e,(hl) +3690 23 inc hl +3691 56 ld d,(hl) +3692 23 inc hl +3693 e3 ex (sp),hl +3694 f5 push af +3695 df rst 18h ; DCOMPR - Compare HL with DE. +3696 d23136 jp nc,3631h +3699 cd141a call 1a14h ; MLDEBC - Multiply DE by BC +369c 19 add hl,de +369d f1 pop af +369e 3d dec a +369f 44 ld b,h +36a0 4d ld c,l +36a1 20eb jr nz,368eh +36a3 3acffd ld a,(0fdcfh) ; Type flag for FPREG: 2 - Integer, 3 - String, 4 - Single, 5 - Double +36a6 44 ld b,h +36a7 4d ld c,l +36a8 29 add hl,hl +36a9 d604 sub 04h +36ab 3804 jr c,36b1h +36ad 29 add hl,hl +36ae 2806 jr z,36b6h +36b0 29 add hl,hl +36b1 b7 or a +36b2 e2b636 jp po,36b6h +36b5 09 add hl,bc +36b6 c1 pop bc +36b7 09 add hl,bc +36b8 eb ex de,hl +36b9 2a13fe ld hl,(0fe13h) ; NXTOPR: Next operand, addr of decimal point in PBUF, etc.. +36bc c9 ret + +; FN_MEM +36bd af xor a +36be e5 push hl +36bf 32cffd ld (0fdcfh),a ; Type flag for FPREG: 2 - Integer, 3 - String, 4 - Single, 5 - Double +36c2 cdc836 call 36c8h +36c5 e1 pop hl +36c6 d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +36c7 c9 ret + +36c8 2a1dfe ld hl,(0fe1dh) ; ARREND - Starting address of free space list (FSL) +36cb eb ex de,hl +36cc 210000 ld hl,0000h +36cf 39 add hl,sp +36d0 e7 rst 20h ; GETYPR - Get the number type (FAC) +36d1 200d jr nz,36e0h +36d3 cdce38 call 38ceh ; GSTRCU - Get string pointed by FPREG +36d6 cdda37 call 37dah +36d9 2a54fc ld hl,(0fc54h) ; Address of string area boundary +36dc eb ex de,hl +36dd 2af6fd ld hl,(0fdf6h) ; Pointer to next available loc. in string area. +36e0 7d ld a,l +36e1 93 sub e +36e2 6f ld l,a +36e3 7c ld a,h +36e4 9a sbc a,d +36e5 67 ld h,a +36e6 c3d01a jp 1ad0h + +36e9 3ac6fd ld a,(0fdc6h) ; CURPOS (a.k.a. TTYPOS) - Current cursor position (column number) + +; UNSIGNED_RESULT_A +36ec 6f ld l,a +36ed af xor a +36ee 67 ld h,a +36ef c30419 jp 1904h ; INT_RESULT_HL + + +; FN_USR +36f2 cda8fe call 0fea8h +36f5 d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +36f6 cd2034 call 3420h ; OPRND_6 +36f9 e5 push hl +36fa 21fa16 ld hl,16fah +36fd e5 push hl +36fe 3acffd ld a,(0fdcfh) ; Type flag for FPREG: 2 - Integer, 3 - String, 4 - Single, 5 - Double +3701 f5 push af +3702 fe03 cp 03h +3704 ccce38 call z,38ceh ; GSTRCU - Get string pointed by FPREG +3707 f1 pop af +3708 eb ex de,hl +3709 2a42fc ld hl,(0fc42h) ; Address of USR subroutine +370c e9 jp (hl) + +370d e5 push hl +370e e607 and 07h +3710 218927 ld hl,2789h ; TYPE_OPR: NUMBER TYPES TABLE +3713 4f ld c,a +3714 0600 ld b,00h +3716 09 add hl,bc +3717 cd7a34 call 347ah +371a e1 pop hl +371b c9 ret + +371c e5 push hl +371d 2a56fc ld hl,(0fc56h) ; CURLIN: Current line number +3720 23 inc hl +3721 7c ld a,h +3722 b5 or l +3723 e1 pop hl +3724 c0 ret nz +3725 1e16 ld e,16h ; ?ID Error +3727 c38c28 jp 288ch ; ERROR, E=error code + +; STR - STR BASIC function entry +372a cd271e call 1e27h +372d cd5937 call 3759h +3730 cdce38 call 38ceh ; GSTRCU - Get string pointed by FPREG +; SAVSTR - Save string in string area +3733 011f39 ld bc,391fh ; TOPOOL - Save in string pool +3736 c5 push bc +3737 7e ld a,(hl) +3738 23 inc hl +3739 e5 push hl +373a cdb337 call 37b3h ; TESTR - Test if enough room for string +373d e1 pop hl +373e 4e ld c,(hl) +373f 23 inc hl +3740 46 ld b,(hl) +3741 cd4e37 call 374eh ; CRTMST - Create temporary string entry +3744 e5 push hl +3745 6f ld l,a +3746 cdc238 call 38c2h ; TOSTRA - Move string in BC, (len in L) to string area +3749 d1 pop de +374a c9 ret + +; MKTMST - Make temporary string +374b cdb337 call 37b3h ; TESTR - Test if enough room for string + +; CRTMST - Create temporary string entry +374e 21f3fd ld hl,0fdf3h ; TMPSTR: 3 bytes used to hold length and addr of a string when moved to string area +3751 e5 push hl +3752 77 ld (hl),a +3753 23 inc hl +3754 73 ld (hl),e +3755 23 inc hl +3756 72 ld (hl),d +3757 e1 pop hl +3758 c9 ret + +3759 2b dec hl +; QTSTR - Create quote terminated String +375a 0622 ld b,22h ; '"' +; QTSTR_0 +375c 50 ld d,b +; DTSTR - Create String, termination char in D +375d e5 push hl +375e 0eff ld c,0ffh +3760 23 inc hl +3761 7e ld a,(hl) +3762 0c inc c +3763 b7 or a +3764 2806 jr z,376ch +3766 ba cp d +3767 2803 jr z,376ch +3769 b8 cp b +376a 20f4 jr nz,3760h +376c fe22 cp 22h ; '"' +376e cc622c call z,2c62h ; _CHRGTB - Pick next char from program +3771 e3 ex (sp),hl +3772 23 inc hl +3773 eb ex de,hl +3774 79 ld a,c +3775 cd4e37 call 374eh ; CRTMST - Create temporary string entry + +; TSTOPL - Temporary string to pool +3778 11f3fd ld de,0fdf3h ; TMPSTR: 3 bytes used to hold length and addr of a string when moved to string area +377b 3ed5 ld a,0d5h +377d 2ad3fd ld hl,(0fdd3h) ; TMSTPT: Address of next available location in LSPT +3780 2241fe ld (0fe41h),hl ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +3783 3e03 ld a,03h +3785 32cffd ld (0fdcfh),a ; Type flag for FPREG: 2 - Integer, 3 - String, 4 - Single, 5 - Double +3788 cd3d18 call 183dh ; FP2HL - Copy number value from DE to HL +378b 11f6fd ld de,0fdf6h ; Pointer to next available loc. in string area. +378e df rst 18h ; DCOMPR - Compare HL with DE. +378f 22d3fd ld (0fdd3h),hl ; TMSTPT: Address of next available location in LSPT +3792 e1 pop hl +3793 7e ld a,(hl) +3794 c0 ret nz +3795 1e1e ld e,1eh ; ?ST Error +3797 c38c28 jp 288ch ; ERROR, E=error code + + +; PRNUMS - Print number string +379a 23 inc hl + +; PRS - Output a string +379b cd5937 call 3759h +; PRS1 - Print string at HL +379e cdce38 call 38ceh ; GSTRCU - Get string pointed by FPREG +37a1 cd2e18 call 182eh ; LOADFP_0 - move 3 bytes from (HL) to D,C,B +37a4 14 inc d +37a5 15 dec d +37a6 c8 ret z +37a7 0a ld a,(bc) +37a8 cda00b call 0ba0h ; OUTC (alias OUTDO): print character +37ab fe0d cp 0dh +37ad ccee2f call z,2feeh +37b0 03 inc bc +37b1 18f2 jr 37a5h + +; TESTR - Test if enough room for string +37b3 b7 or a +37b4 0ef1 ld c,0f1h +37b6 f5 push af +37b7 2a54fc ld hl,(0fc54h) ; Address of string area boundary +37ba eb ex de,hl +37bb 2af6fd ld hl,(0fdf6h) ; Pointer to next available loc. in string area. +37be 2f cpl +37bf 4f ld c,a +37c0 06ff ld b,0ffh +37c2 09 add hl,bc +37c3 23 inc hl +37c4 df rst 18h ; DCOMPR - Compare HL with DE. +37c5 3807 jr c,37ceh +37c7 22f6fd ld (0fdf6h),hl ; Pointer to next available loc. in string area. +37ca 23 inc hl +37cb eb ex de,hl +37cc f1 pop af +37cd c9 ret + +37ce f1 pop af +37cf 1e1a ld e,1ah ; ?OS Error +37d1 ca8c28 jp z,288ch ; ERROR, E=error code +37d4 bf cp a +37d5 f5 push af +37d6 01b537 ld bc,37b5h +37d9 c5 push bc +37da 2ad1fd ld hl,(0fdd1h) ; Memory size +37dd 22f6fd ld (0fdf6h),hl ; Pointer to next available loc. in string area. +37e0 210000 ld hl,0000h +37e3 e5 push hl +37e4 2a54fc ld hl,(0fc54h) ; Address of string area boundary +37e7 e5 push hl +37e8 21d5fd ld hl,0fdd5h ; TEMPST: LSPT (literal string pool table) +37eb eb ex de,hl +37ec 2ad3fd ld hl,(0fdd3h) ; TMSTPT: Address of next available location in LSPT +37ef eb ex de,hl +37f0 df rst 18h ; DCOMPR - Compare HL with DE. +37f1 01eb37 ld bc,37ebh +37f4 c23e38 jp nz,383eh +37f7 2a19fe ld hl,(0fe19h) ; Addr of simple variables +37fa eb ex de,hl +37fb 2a1bfe ld hl,(0fe1bh) ; VAREND: Addr of dimensioned variables +37fe eb ex de,hl +37ff df rst 18h ; DCOMPR - Compare HL with DE. +3800 2813 jr z,3815h +3802 7e ld a,(hl) +3803 23 inc hl +3804 23 inc hl +3805 23 inc hl +3806 fe03 cp 03h +3808 2004 jr nz,380eh +380a cd3f38 call 383fh +380d af xor a +380e 5f ld e,a +380f 1600 ld d,00h +3811 19 add hl,de +3812 18e6 jr 37fah +3814 c1 pop bc +3815 eb ex de,hl +3816 2a1dfe ld hl,(0fe1dh) ; ARREND - Starting address of free space list (FSL) +3819 eb ex de,hl +381a df rst 18h ; DCOMPR - Compare HL with DE. +381b ca5f38 jp z,385fh +381e 7e ld a,(hl) +381f 23 inc hl +3820 cd2c18 call 182ch ; LOADFP: Load single precision value pointed by (HL) into BC/DE +3823 e5 push hl +3824 09 add hl,bc +3825 fe03 cp 03h +3827 20eb jr nz,3814h +3829 22f8fd ld (0fdf8h),hl ; 1: Index of last byte executed in current statement- 2: Edit flag during print using +382c e1 pop hl +382d 4e ld c,(hl) +382e 0600 ld b,00h +3830 09 add hl,bc +3831 09 add hl,bc +3832 23 inc hl +3833 eb ex de,hl +3834 2af8fd ld hl,(0fdf8h) ; 1: Index of last byte executed in current statement- 2: Edit flag during print using +3837 eb ex de,hl +3838 df rst 18h ; DCOMPR - Compare HL with DE. +3839 28da jr z,3815h +383b 013338 ld bc,3833h +383e c5 push bc +383f af xor a +3840 b6 or (hl) +3841 23 inc hl +3842 5e ld e,(hl) +3843 23 inc hl +3844 56 ld d,(hl) +3845 23 inc hl +3846 c8 ret z +3847 44 ld b,h +3848 4d ld c,l +3849 2af6fd ld hl,(0fdf6h) ; Pointer to next available loc. in string area. +384c df rst 18h ; DCOMPR - Compare HL with DE. +384d 60 ld h,b +384e 69 ld l,c +384f d8 ret c +3850 e1 pop hl +3851 e3 ex (sp),hl +3852 df rst 18h ; DCOMPR - Compare HL with DE. +3853 e3 ex (sp),hl +3854 e5 push hl +3855 60 ld h,b +3856 69 ld l,c +3857 d0 ret nc +3858 c1 pop bc +3859 f1 pop af +385a f1 pop af +385b e5 push hl +385c d5 push de +385d c5 push bc +385e c9 ret + +385f d1 pop de +3860 e1 pop hl +3861 7d ld a,l +3862 b4 or h +3863 c8 ret z +3864 2b dec hl +3865 46 ld b,(hl) +3866 2b dec hl +3867 4e ld c,(hl) +3868 e5 push hl +3869 2b dec hl +386a 6e ld l,(hl) +386b 2600 ld h,00h +386d 09 add hl,bc +386e 50 ld d,b +386f 59 ld e,c +3870 2b dec hl +3871 44 ld b,h +3872 4d ld c,l +3873 2af6fd ld hl,(0fdf6h) ; Pointer to next available loc. in string area. +3876 cd4228 call 2842h +3879 e1 pop hl +387a 71 ld (hl),c +387b 23 inc hl +387c 70 ld (hl),b +387d 69 ld l,c +387e 60 ld h,b +387f 2b dec hl +3880 c3dd37 jp 37ddh + +; CONCAT - String concatenation +3883 c5 push bc +3884 e5 push hl +3885 2a41fe ld hl,(0fe41h) ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +3888 e3 ex (sp),hl +3889 cd9333 call 3393h ; OPRND: Get next expression value +388c e3 ex (sp),hl +388d cd5e19 call 195eh ; TSTSTR - Test a string, 'Type Error' if it is not +3890 7e ld a,(hl) +3891 e5 push hl +3892 2a41fe ld hl,(0fe41h) ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +3895 e5 push hl +3896 86 add a,(hl) +3897 1e1c ld e,1ch ; ?LS Error +3899 da8c28 jp c,288ch ; ERROR, E=error code +389c cd4b37 call 374bh ; MKTMST - Make temporary string +389f d1 pop de +38a0 cdd238 call 38d2h ; GSTRDE - Get string pointed by DE +38a3 e3 ex (sp),hl +38a4 cdd138 call 38d1h ; GSTRHL - Get string pointed by HL +38a7 e5 push hl +38a8 2af4fd ld hl,(0fdf4h) ; TMPSTR +38ab eb ex de,hl +38ac cdba38 call 38bah ; SSTSA - Move string on stack to string area +38af cdba38 call 38bah ; SSTSA - Move string on stack to string area +38b2 213d32 ld hl,323dh +38b5 e3 ex (sp),hl +38b6 e5 push hl +38b7 c37837 jp 3778h ; TSTOPL - Temporary string to pool + +; SSTSA - Move string on stack to string area +38ba e1 pop hl +38bb e3 ex (sp),hl +38bc 7e ld a,(hl) +38bd 23 inc hl +38be 4e ld c,(hl) +38bf 23 inc hl +38c0 46 ld b,(hl) +38c1 6f ld l,a + +; TOSTRA - Move string in BC, (len in L) to string area +38c2 2c inc l +; TSALP - TOSTRA loop +38c3 2d dec l +38c4 c8 ret z +38c5 0a ld a,(bc) +38c6 12 ld (de),a +38c7 03 inc bc +38c8 13 inc de +38c9 18f8 jr 38c3h ; TSALP - TOSTRA loop + +; GETSTR - Get string pointed by FPREG 'Type Error' if it is not +38cb cd5e19 call 195eh ; TSTSTR - Test a string, 'Type Error' if it is not +; GSTRCU - Get string pointed by FPREG +38ce 2a41fe ld hl,(0fe41h) ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +; GSTRHL - Get string pointed by HL +38d1 eb ex de,hl +; GSTRDE - Get string pointed by DE +38d2 cde938 call 38e9h +38d5 eb ex de,hl +38d6 c0 ret nz +38d7 d5 push de +38d8 50 ld d,b +38d9 59 ld e,c +38da 1b dec de +38db 4e ld c,(hl) +38dc 2af6fd ld hl,(0fdf6h) ; Pointer to next available loc. in string area. +38df df rst 18h ; DCOMPR - Compare HL with DE. +38e0 2005 jr nz,38e7h +38e2 47 ld b,a +38e3 09 add hl,bc +38e4 22f6fd ld (0fdf6h),hl ; Pointer to next available loc. in string area. +38e7 e1 pop hl +38e8 c9 ret + +; BAKTMP - Back to last tmp-str entry +38e9 2ad3fd ld hl,(0fdd3h) ; TMSTPT: Address of next available location in LSPT +38ec 2b dec hl +38ed 46 ld b,(hl) +38ee 2b dec hl +38ef 4e ld c,(hl) +38f0 2b dec hl +38f1 df rst 18h ; DCOMPR - Compare HL with DE. +38f2 c0 ret nz +38f3 22d3fd ld (0fdd3h),hl ; TMSTPT: Address of next available location in LSPT +38f6 c9 ret + +; __LEN +38f7 01ec36 ld bc,36ech ; UNSIGNED_RESULT_A +38fa c5 push bc +38fb cdcb38 call 38cbh ; GETSTR - Get string pointed by FPREG 'Type Error' if it is not +38fe af xor a +38ff 57 ld d,a +3900 7e ld a,(hl) +3901 b7 or a +3902 c9 ret + +; __ASC +3903 01ec36 ld bc,36ech ; UNSIGNED_RESULT_A +3906 c5 push bc +; __ASC_0 +3907 cdfb38 call 38fbh +390a ca352d jp z,2d35h ; Error: Illegal function call (FC ERROR) +390d 23 inc hl +390e 5e ld e,(hl) +390f 23 inc hl +3910 56 ld d,(hl) +3911 1a ld a,(de) +3912 c9 ret + +; __CHR_S +3913 3e01 ld a,01h ; Make temporary string 1 byte long +3915 cd4b37 call 374bh ; MKTMST - Make temporary string +3918 cd133a call 3a13h ; MAKINT - Convert tmp string to int in A register +391b 2af4fd ld hl,(0fdf4h) ; TMPSTR+1 +391e 73 ld (hl),e +; TOPOOL - Save in string pool +391f c1 pop bc +3920 c37837 jp 3778h ; TSTOPL - Temporary string to pool + +; FN_STRING +3923 d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +3924 cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +3925 28 defb '(' +3926 cd103a call 3a10h ; GETINT +3929 d5 push de +392a cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +392b 2c defb ',' +392c cd2b32 call 322bh ; EVAL +392f cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +3930 29 defb '(' +3931 e3 ex (sp),hl +3932 e5 push hl +3933 e7 rst 20h ; GETYPR - Get the number type (FAC) +3934 2805 jr z,393bh +3936 cd133a call 3a13h ; MAKINT - Convert tmp string to int in A register +3939 1803 jr 393eh ;FN_STRING_1 +;FN_STRING_0 +393b cd0739 call 3907h ; __ASC_0 +;FN_STRING_1 +393e d1 pop de +393f f5 push af +3940 f5 push af +3941 7b ld a,e +3942 cd4b37 call 374bh ; MKTMST - Make temporary string +3945 5f ld e,a +3946 f1 pop af +3947 1c inc e +3948 1d dec e +3949 28d4 jr z,391fh ; TOPOOL - Save in string pool +394b 2af4fd ld hl,(0fdf4h) ; TMPSTR+1 +394e 77 ld (hl),a +394f 23 inc hl +3950 1d dec e +3951 20fb jr nz,394eh +3953 18ca jr 391fh ; TOPOOL - Save in string pool + +; __LEFT_S +3955 cdd339 call 39d3h ; LFRGNM - number in program listing and check for ending ')' +3958 af xor a +3959 e3 ex (sp),hl +395a 4f ld c,a +395b 3ee5 ld a,0e5h +395d e5 push hl +395e 7e ld a,(hl) +395f b8 cp b +3960 3802 jr c,3964h +3962 78 ld a,b +3963 110e00 ld de,000eh +3966 c5 push bc +3967 cdb337 call 37b3h ; TESTR - Test if enough room for string +396a c1 pop bc +396b e1 pop hl +396c e5 push hl +396d 23 inc hl +396e 46 ld b,(hl) +396f 23 inc hl +3970 66 ld h,(hl) +3971 68 ld l,b +3972 0600 ld b,00h +3974 09 add hl,bc +3975 44 ld b,h +3976 4d ld c,l +3977 cd4e37 call 374eh ; CRTMST - Create temporary string entry +397a 6f ld l,a +397b cdc238 call 38c2h ; TOSTRA - Move string in BC, (len in L) to string area +397e d1 pop de +397f cdd238 call 38d2h ; GSTRDE - Get string pointed by DE +3982 c37837 jp 3778h ; TSTOPL - Temporary string to pool + +; __RIGHT_S +3985 cdd339 call 39d3h ; LFRGNM - number in program listing and check for ending ')' +3988 d1 pop de +3989 d5 push de +398a 1a ld a,(de) +398b 90 sub b +398c 18cb jr 3959h + +; __MID_S +398e eb ex de,hl +398f 7e ld a,(hl) +3990 cdd639 call 39d6h ; MIDNUM - Get numeric argument for MID$ +3993 04 inc b +3994 05 dec b +3995 ca352d jp z,2d35h ; Error: Illegal function call (FC ERROR) +3998 c5 push bc +3999 1eff ld e,0ffh +399b fe29 cp 29h +399d 2805 jr z,39a4h +399f cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +39a0 2c defb ',' +39a1 cd103a call 3a10h ; GETINT +39a4 cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +39a5 29 defb '(' +39a6 f1 pop af +39a7 e3 ex (sp),hl +39a8 015d39 ld bc,395dh +39ab c5 push bc +39ac 3d dec a +39ad be cp (hl) +39ae 0600 ld b,00h +39b0 d0 ret nc +39b1 4f ld c,a +39b2 7e ld a,(hl) +39b3 91 sub c +39b4 bb cp e +39b5 47 ld b,a +39b6 d8 ret c +39b7 43 ld b,e +39b8 c9 ret + +39b9 cdfb38 call 38fbh +39bc caec36 jp z,36ech ; UNSIGNED_RESULT_A +39bf 5f ld e,a +39c0 23 inc hl +39c1 7e ld a,(hl) +39c2 23 inc hl +39c3 66 ld h,(hl) +39c4 6f ld l,a +39c5 e5 push hl +39c6 19 add hl,de +39c7 46 ld b,(hl) +39c8 72 ld (hl),d +39c9 e3 ex (sp),hl +39ca c5 push bc +39cb 7e ld a,(hl) +39cc cdcf1c call 1ccfh ; DBL_ASCTFP - ASCII to Double precision FP number +39cf c1 pop bc +39d0 e1 pop hl +39d1 70 ld (hl),b +39d2 c9 ret + +; LFRGNM - number in program listing and check for ending ')' +39d3 eb ex de,hl +39d4 cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +39d5 29 defb '(' +39d6 c1 pop bc +39d7 d1 pop de +39d8 c5 push bc +39d9 43 ld b,e +39da c9 ret + +; IN BASIC instruction +39db fe7a cp 7ah +39dd c28128 jp nz,2881h ; Syntax Error (SN ERROR) +39e0 c3423f jp 3f42h ; Exec command in FAR memory bank + +; __INP +39e3 cd133a call 3a13h ; MAKINT - Convert tmp string to int in A register +39e6 3248fc ld (0fc48h),a ; INPORT - Current port for 'INP' function +39e9 cd47fc call 0fc47h +39ec c3ec36 jp 36ech ; UNSIGNED_RESULT_A + +; __OUT +39ef cd023a call 3a02h +39f2 c34afc jp 0fc4ah + +; FPSINT - Get subscript +39f5 d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. + +; GETWORD - Get a number to DE (0..65535) +39f6 cd2b32 call 322bh ; EVAL +; DEPINT - Get integer variable to DE, error if negative +39f9 e5 push hl +39fa cde918 call 18e9h ; __CINT: Floating point to Integer +39fd eb ex de,hl +39fe e1 pop hl +39ff 7a ld a,d +3a00 b7 or a +3a01 c9 ret + +; OUT BASIC instruction +3a02 cd103a call 3a10h ; GETINT +3a05 3248fc ld (0fc48h),a ; INPORT - Current port for 'INP' function +3a08 324bfc ld (0fc4bh),a ; OTPORT +3a0b cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +3a0c 2c defb ',' +3a0d 1801 jr 3a10h ; GETINT + + +; FNDNUM - Load 'A' with the next nume in BASIC program +3a0f d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. + +; GETINT +3a10 cd2b32 call 322bh ; EVAL +; MAKINT - Convert tmp string to int in A register +3a13 cdf939 call 39f9h ; DEPINT - Get integer variable to DE, error if negative +3a16 c2352d jp nz,2d35h ; Error: Illegal function call (FC ERROR) +3a19 2b dec hl +3a1a d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +3a1b 7b ld a,e +3a1c c9 ret + +; __LLIST +3a1d 3e01 ld a,01h +3a1f 3250fc ld (0fc50h),a ; Output device code 0 = Video, 1 = Printer, -1 = Cassette +; __LIST +3a22 c1 pop bc +3a23 cdfa29 call 29fah ; LNUM_RANGE - Get specified line number range +3a26 c5 push bc +3a27 21ffff ld hl,0ffffh +3a2a 2256fc ld (0fc56h),hl ; CURLIN: Current line number +3a2d e1 pop hl +3a2e d1 pop de +3a2f 4e ld c,(hl) +3a30 23 inc hl +3a31 46 ld b,(hl) +3a32 23 inc hl +3a33 78 ld a,b +3a34 b1 or c +3a35 ca0329 jp z,2903h ; READY +3a38 cddbfe call 0fedbh +3a3b cd852c call 2c85h +3a3e c5 push bc +3a3f 4e ld c,(hl) +3a40 23 inc hl +3a41 46 ld b,(hl) +3a42 23 inc hl +3a43 c5 push bc +3a44 e3 ex (sp),hl +3a45 eb ex de,hl +3a46 df rst 18h ; DCOMPR - Compare HL with DE. +3a47 c1 pop bc +3a48 da0229 jp c,2902h ; RESTART +3a4b e3 ex (sp),hl +3a4c e5 push hl +3a4d c5 push bc +3a4e eb ex de,hl +3a4f 220cfe ld (0fe0ch),hl ; Line No. in which error occured. +3a52 cd191e call 1e19h +3a55 3e20 ld a,20h ; ' ' +3a57 e1 pop hl +3a58 cda00b call 0ba0h ; OUTC (alias OUTDO): print character +3a5b cd723a call 3a72h +3a5e 2ac7fd ld hl,(0fdc7h) ; Pointer to address of keyboard buffer +3a61 cd693a call 3a69h ; Print message, text ptr in (HL) +3a64 cde92f call 2fe9h +3a67 18be jr 3a27h + +; Print message, text ptr in (HL) +3a69 7e ld a,(hl) +3a6a b7 or a ; end of string ? +3a6b c8 ret z +3a6c cda00b call 0ba0h ; OUTC (alias OUTDO): print character +3a6f 23 inc hl +3a70 18f7 jr 3a69h ; loop + +3a72 e5 push hl +3a73 2ac7fd ld hl,(0fdc7h) ; Pointer to address of keyboard buffer +3a76 44 ld b,h +3a77 4d ld c,l +3a78 e1 pop hl +3a79 16ff ld d,0ffh +3a7b 1803 jr 3a80h + +3a7d 03 inc bc +3a7e 15 dec d +3a7f c8 ret z +3a80 7e ld a,(hl) +3a81 b7 or a +3a82 23 inc hl +3a83 02 ld (bc),a +3a84 c8 ret z +3a85 f27d3a jp p,3a7dh +3a88 fefb cp 0fbh +3a8a 2008 jr nz,3a94h +3a8c 0b dec bc +3a8d 0b dec bc +3a8e 0b dec bc +3a8f 0b dec bc +3a90 14 inc d +3a91 14 inc d +3a92 14 inc d +3a93 14 inc d +3a94 fe95 cp 95h +3a96 cc8e19 call z,198eh +3a99 d67f sub 7fh +3a9b e5 push hl +3a9c 5f ld e,a +3a9d 212e25 ld hl,252eh ; TOKEN table position +3aa0 7e ld a,(hl) +3aa1 b7 or a +3aa2 23 inc hl +3aa3 f2a03a jp p,3aa0h +3aa6 1d dec e +3aa7 20f7 jr nz,3aa0h +3aa9 e67f and 7fh +3aab 02 ld (bc),a +3aac 03 inc bc +3aad 15 dec d +3aae cacc37 jp z,37cch +3ab1 7e ld a,(hl) +3ab2 23 inc hl +3ab3 b7 or a +3ab4 f2ab3a jp p,3aabh +3ab7 e1 pop hl +3ab8 18c6 jr 3a80h + +; __DELETE +3aba cdfa29 call 29fah ; LNUM_RANGE - Get specified line number range +3abd d1 pop de +3abe c5 push bc +3abf c5 push bc +3ac0 cd162a call 2a16h ; FIND_LNUM - Search for line number +3ac3 3005 jr nc,3acah +3ac5 54 ld d,h +3ac6 5d ld e,l +3ac7 e3 ex (sp),hl +3ac8 e5 push hl +3ac9 df rst 18h ; DCOMPR - Compare HL with DE. +3aca d2352d jp nc,2d35h ; Error: Illegal function call (FC ERROR) +3acd 211328 ld hl,2813h +3ad0 cd9b37 call 379bh ; PRS - Output a string +3ad3 c1 pop bc +3ad4 21d229 ld hl,29d2h +3ad7 e3 ex (sp),hl +3ad8 eb ex de,hl +3ad9 2a19fe ld hl,(0fe19h) ; Addr of simple variables +3adc 1a ld a,(de) +3add 02 ld (bc),a +3ade 03 inc bc +3adf 13 inc de +3ae0 df rst 18h ; DCOMPR - Compare HL with DE. +3ae1 20f9 jr nz,3adch +3ae3 60 ld h,b +3ae4 69 ld l,c +3ae5 2219fe ld (0fe19h),hl ; Addr of simple variables +3ae8 c9 ret + +; __CSAVE +3ae9 fe4d cp 4dh ; 'M' +3aeb ca4b08 jp z,084bh ; JP if 'CSAVEM' + +3aee cd2b32 call 322bh ; EVAL +3af1 e5 push hl +3af2 cd0739 call 3907h ; __ASC_0 +3af5 cd2307 call 0723h ; Cassette write on routine (-> output $A5) +3af8 3ed3 ld a,0d3h ; CLOAD MARKER: D3D3D3 +3afa cd3d07 call 073dh ; Cassette output routine (-> output 0,0,0, $A5, $D3, D3, D3) +3afd cd3a07 call 073ah ; Cassette output routine x 2 +3b00 1a ld a,(de) +3b01 cd3d07 call 073dh ; Cassette output routine +3b04 2a58fc ld hl,(0fc58h) ; BASTXT - Address of BASIC Program +3b07 eb ex de,hl +3b08 2a19fe ld hl,(0fe19h) ; Addr of simple variables +3b0b 1a ld a,(de) +3b0c 13 inc de +3b0d cd3d07 call 073dh ; Cassette output routine +3b10 df rst 18h ; DCOMPR - Compare HL with DE. +3b11 20f8 jr nz,3b0bh +3b13 cd8007 call 0780h ; Cassette off routine +3b16 e1 pop hl +3b17 c9 ret + +; __CLOAD +3b18 7e ld a,(hl) +3b19 fe4d cp 4dh ; 'M' +3b1b caa308 jp z,08a3h ; 'CLOADM' + +3b1e d6b2 sub 0b2h ; TK_PRINT +3b20 2802 jr z,3b24h +3b22 af xor a +3b23 012f23 ld bc,232fh +3b26 f5 push af +3b27 2b dec hl +3b28 d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +3b29 3e00 ld a,00h +3b2b 2807 jr z,3b34h +3b2d cd2b32 call 322bh ; EVAL +3b30 cd0739 call 3907h ; __ASC_0 +3b33 1a ld a,(de) +3b34 6f ld l,a +3b35 f1 pop af +3b36 b7 or a +3b37 67 ld h,a +3b38 2241fe ld (0fe41h),hl ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +3b3b cc372a call z,2a37h +3b3e 2a41fe ld hl,(0fe41h) ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +3b41 eb ex de,hl +3b42 cd9e07 call 079eh ; Cassette read on routine +3b45 0603 ld b,03h +3b47 cdc907 call 07c9h ; Casette read routine (x3) +3b4a d6d3 sub 0d3h ; CLOAD MARKER: D3D3D3 +3b4c 20f7 jr nz,3b45h +3b4e 10f7 djnz 3b47h + +3b50 cdc907 call 07c9h ; Casette read routine +3b53 1c inc e +3b54 1d dec e +3b55 2803 jr z,3b5ah +3b57 bb cp e +3b58 2037 jr nz,3b91h + +3b5a 2a58fc ld hl,(0fc58h) ; BASTXT - Address of BASIC Program +3b5d 0603 ld b,03h +3b5f cdc907 call 07c9h ; Casette read routine +3b62 5f ld e,a +3b63 96 sub (hl) +3b64 a2 and d +3b65 2021 jr nz,3b88h +3b67 73 ld (hl),e +3b68 cd5628 call 2856h +3b6b 7e ld a,(hl) +3b6c b7 or a +3b6d 23 inc hl +3b6e 20ed jr nz,3b5dh +3b70 cd2108 call 0821h ; toggle top-right asterisk +3b73 10ea djnz 3b5fh +3b75 2219fe ld (0fe19h),hl ; Addr of simple variables +3b78 211328 ld hl,2813h +3b7b cd9b37 call 379bh ; PRS - Output a string +3b7e cd8007 call 0780h ; Cassette off routine +3b81 2a58fc ld hl,(0fc58h) ; BASTXT - Address of BASIC Program +3b84 e5 push hl +3b85 c3d229 jp 29d2h + +3b88 21a33b ld hl,3ba3h +3b8b cd9b37 call 379bh ; PRS - Output a string +3b8e c30229 jp 2902h ; RESTART + + +3b91 323e3c ld (3c3eh),a +3b94 0603 ld b,03h +3b96 cdc907 call 07c9h ; Casette read routine +3b99 b7 or a +3b9a 20f8 jr nz,3b94h +3b9c 10f8 djnz 3b96h +3b9e cda107 call 07a1h +3ba1 18a2 jr 3b45h + +3ba3 42 ld b,d +3ba4 41 ld b,c +3ba5 44 ld b,h +3ba6 0d dec c +3ba7 00 nop +3ba8 cde918 call 18e9h ; __CINT: Floating point to Integer +3bab 7e ld a,(hl) +3bac c3ec36 jp 36ech ; UNSIGNED_RESULT_A + +; __POKE +3baf cdf639 call 39f6h ; GETWORD - Get a number to DE (0..65535) +3bb2 d5 push de +3bb3 cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +3bb4 2c defb ',' +3bb5 cd103a call 3a10h ; GETINT +3bb8 d1 pop de +3bb9 12 ld (de),a +3bba c9 ret + +3bbb cd2c32 call 322ch ; __EVAL__ +3bbe cd5e19 call 195eh ; TSTSTR - Test a string, 'Type Error' if it is not +3bc1 cf rst 08h ; SYNCHR: Check syntax: next byte holds the byte to be found +3bc2 3b defb ';' +3bc3 eb ex de,hl +3bc4 2a41fe ld hl,(0fe41h) ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +3bc7 1808 jr 3bd1h + +3bc9 3afefd ld a,(0fdfeh) ; FLGINP: 1 = input statement active. Also used in print using to hold seperator between string and variable. +3bcc b7 or a +3bcd 280c jr z,3bdbh +3bcf d1 pop de +3bd0 eb ex de,hl +3bd1 e5 push hl +3bd2 af xor a +3bd3 32fefd ld (0fdfeh),a ; FLGINP: 1 = input statement active. Also used in print using to hold seperator between string and variable. +3bd6 ba cp d +3bd7 f5 push af +3bd8 d5 push de +3bd9 46 ld b,(hl) +3bda b0 or b +3bdb ca352d jp z,2d35h ; Error: Illegal function call (FC ERROR) +3bde 23 inc hl +3bdf 4e ld c,(hl) +3be0 23 inc hl +3be1 66 ld h,(hl) +3be2 69 ld l,c +3be3 181c jr 3c01h + +3be5 58 ld e,b +3be6 e5 push hl +3be7 0e02 ld c,02h +3be9 7e ld a,(hl) +3bea 23 inc hl +3beb fe25 cp 25h +3bed ca153d jp z,3d15h +3bf0 fe20 cp 20h +3bf2 2003 jr nz,3bf7h +3bf4 0c inc c +3bf5 10f2 djnz 3be9h +3bf7 e1 pop hl +3bf8 43 ld b,e +3bf9 3e25 ld a,25h ; '%' +3bfb cd473d call 3d47h +3bfe cda00b call 0ba0h ; OUTC (alias OUTDO): print character +3c01 af xor a +3c02 5f ld e,a +3c03 57 ld d,a +3c04 cd473d call 3d47h +3c07 57 ld d,a +3c08 7e ld a,(hl) +3c09 23 inc hl +3c0a fe21 cp 21h +3c0c ca123d jp z,3d12h +3c0f fe23 cp 23h +3c11 2837 jr z,3c4ah +3c13 05 dec b +3c14 cafc3c jp z,3cfch +3c17 fe2b cp 2bh +3c19 3e08 ld a,08h +3c1b 28e7 jr z,3c04h +3c1d 2b dec hl +3c1e 7e ld a,(hl) +3c1f 23 inc hl +3c20 fe2e cp 2eh +3c22 2840 jr z,3c64h +3c24 fe25 cp 25h +3c26 28bd jr z,3be5h +3c28 be cp (hl) +3c29 20d0 jr nz,3bfbh +3c2b fe24 cp 24h +3c2d 2814 jr z,3c43h +3c2f fe2a cp 2ah +3c31 20c8 jr nz,3bfbh +3c33 78 ld a,b +3c34 fe02 cp 02h +3c36 23 inc hl +3c37 3803 jr c,3c3ch +3c39 7e ld a,(hl) +3c3a fe24 cp 24h +3c3c 3e20 ld a,20h +3c3e 2007 jr nz,3c47h +3c40 05 dec b +3c41 1c inc e +3c42 feaf cp 0afh +3c44 c610 add a,10h +3c46 23 inc hl +3c47 1c inc e +3c48 82 add a,d +3c49 57 ld d,a +3c4a 1c inc e +3c4b 0e00 ld c,00h +3c4d 05 dec b +3c4e 2847 jr z,3c97h +3c50 7e ld a,(hl) +3c51 23 inc hl +3c52 fe2e cp 2eh +3c54 2818 jr z,3c6eh +3c56 fe23 cp 23h +3c58 28f0 jr z,3c4ah +3c5a fe2c cp 2ch +3c5c 201a jr nz,3c78h +3c5e 7a ld a,d +3c5f f640 or 40h +3c61 57 ld d,a +3c62 18e6 jr 3c4ah +3c64 7e ld a,(hl) +3c65 fe23 cp 23h +3c67 3e2e ld a,2eh ; '*' +3c69 2090 jr nz,3bfbh +3c6b 0e01 ld c,01h +3c6d 23 inc hl +3c6e 0c inc c +3c6f 05 dec b +3c70 2825 jr z,3c97h +3c72 7e ld a,(hl) +3c73 23 inc hl +3c74 fe23 cp 23h +3c76 28f6 jr z,3c6eh +3c78 d5 push de +3c79 11953c ld de,3c95h +3c7c d5 push de +3c7d 54 ld d,h +3c7e 5d ld e,l +3c7f fe5b cp 5bh +3c81 c0 ret nz +3c82 be cp (hl) +3c83 c0 ret nz +3c84 23 inc hl +3c85 be cp (hl) +3c86 c0 ret nz +3c87 23 inc hl +3c88 be cp (hl) +3c89 c0 ret nz +3c8a 23 inc hl +3c8b 78 ld a,b +3c8c d604 sub 04h +3c8e d8 ret c +3c8f d1 pop de +3c90 d1 pop de +3c91 47 ld b,a +3c92 14 inc d +3c93 23 inc hl +3c94 caebd1 jp z,0d1ebh +3c97 7a ld a,d +3c98 2b dec hl +3c99 1c inc e +3c9a e608 and 08h +3c9c 2015 jr nz,3cb3h +3c9e 1d dec e +3c9f 78 ld a,b +3ca0 b7 or a +3ca1 2810 jr z,3cb3h +3ca3 7e ld a,(hl) +3ca4 d62d sub 2dh +3ca6 2806 jr z,3caeh +3ca8 fefe cp 0feh +3caa 2007 jr nz,3cb3h +3cac 3e08 ld a,08h +3cae c604 add a,04h +3cb0 82 add a,d +3cb1 57 ld d,a +3cb2 05 dec b +3cb3 e1 pop hl +3cb4 f1 pop af +3cb5 2850 jr z,3d07h +3cb7 c5 push bc +3cb8 d5 push de +3cb9 cd2b32 call 322bh ; EVAL +3cbc d1 pop de +3cbd c1 pop bc +3cbe c5 push bc +3cbf e5 push hl +3cc0 43 ld b,e +3cc1 78 ld a,b +3cc2 81 add a,c +3cc3 fe19 cp 19h +3cc5 d2352d jp nc,2d35h ; Error: Illegal function call (FC ERROR) +3cc8 7a ld a,d +3cc9 f680 or 80h +3ccb cd281e call 1e28h +3cce cd9b37 call 379bh ; PRS - Output a string +3cd1 e1 pop hl +3cd2 2b dec hl +3cd3 d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +3cd4 37 scf +3cd5 280d jr z,3ce4h +3cd7 32fefd ld (0fdfeh),a ; FLGINP: 1 = input statement active. Also used in print using to hold seperator between string and variable. +3cda fe3b cp 3bh +3cdc 2805 jr z,3ce3h +3cde fe2c cp 2ch +3ce0 c28128 jp nz,2881h ; Syntax Error (SN ERROR) +3ce3 d7 rst 10h ; CHRGTB: Gets next character or token from BASIC text. +3ce4 c1 pop bc +3ce5 eb ex de,hl +3ce6 e1 pop hl +3ce7 e5 push hl +3ce8 f5 push af +3ce9 d5 push de +3cea 7e ld a,(hl) +3ceb 90 sub b +3cec 23 inc hl +3ced 4e ld c,(hl) +3cee 23 inc hl +3cef 66 ld h,(hl) +3cf0 69 ld l,c +3cf1 1600 ld d,00h +3cf3 5f ld e,a +3cf4 19 add hl,de +3cf5 78 ld a,b +3cf6 b7 or a +3cf7 c2013c jp nz,3c01h +3cfa 1806 jr 3d02h + +3cfc cd473d call 3d47h +3cff cda00b call 0ba0h ; OUTC (alias OUTDO): print character +3d02 e1 pop hl +3d03 f1 pop af +3d04 c2c93b jp nz,3bc9h +3d07 dce92f call c,2fe9h +3d0a e3 ex (sp),hl +3d0b cdd138 call 38d1h ; GSTRHL - Get string pointed by HL +3d0e e1 pop hl +3d0f c35430 jp 3054h + + +3d12 0e01 ld c,01h +3d14 3ef1 ld a,0f1h +3d16 05 dec b +3d17 cd473d call 3d47h +3d1a e1 pop hl +3d1b f1 pop af +3d1c 28e9 jr z,3d07h +3d1e c5 push bc +3d1f cd2b32 call 322bh ; EVAL +3d22 cd5e19 call 195eh ; TSTSTR - Test a string, 'Type Error' if it is not +3d25 c1 pop bc +3d26 c5 push bc +3d27 e5 push hl +3d28 2a41fe ld hl,(0fe41h) ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +3d2b 41 ld b,c +3d2c 0e00 ld c,00h +3d2e c5 push bc +3d2f cd5c39 call 395ch +3d32 cd9e37 call 379eh ; PRS1 - Print string at HL +3d35 2a41fe ld hl,(0fe41h) ; FPREG - Floating Point Register (FACCU, FACLOW on Ext. BASIC) +3d38 f1 pop af +3d39 96 sub (hl) +3d3a 47 ld b,a +3d3b 3e20 ld a,20h +3d3d 04 inc b +3d3e 05 dec b +3d3f cad13c jp z,3cd1h +3d42 cda00b call 0ba0h ; OUTC (alias OUTDO): print character +3d45 18f7 jr 3d3eh + +3d47 f5 push af +3d48 7a ld a,d +3d49 b7 or a +3d4a 3e2b ld a,2bh ; '+' +3d4c c4a00b call nz,0ba0h ; OUTC (alias OUTDO): print character +3d4f f1 pop af +3d50 c9 ret + +3d51 324efc ld (0fc4eh),a ; ERRFLG +3d54 2a0afe ld hl,(0fe0ah) ; ERRLIN: Line No. in which error occured. +3d57 b4 or h +3d58 a5 and l +3d59 3c inc a +3d5a eb ex de,hl +3d5b c8 ret z +3d5c 1804 jr 3d62h + +; __EDIT +3d5e cd3a2d call 2d3ah ; LNUM_PARM - Get specified line number +3d61 c0 ret nz +3d62 e1 pop hl +3d63 eb ex de,hl +3d64 220cfe ld (0fe0ch),hl ; Line No. in which error occured. +3d67 eb ex de,hl +3d68 cd162a call 2a16h ; FIND_LNUM - Search for line number +3d6b d2c42d jp nc,2dc4h +3d6e 60 ld h,b +3d6f 69 ld l,c +3d70 23 inc hl +3d71 23 inc hl +3d72 4e ld c,(hl) +3d73 23 inc hl +3d74 46 ld b,(hl) +3d75 23 inc hl +3d76 c5 push bc +3d77 cd723a call 3a72h +3d7a e1 pop hl +3d7b e5 push hl +3d7c cd191e call 1e19h +3d7f 3e20 ld a,20h ; ' ' +3d81 cda00b call 0ba0h ; OUTC (alias OUTDO): print character +3d84 2ac7fd ld hl,(0fdc7h) ; Pointer to address of keyboard buffer +3d87 3e16 ld a,16h +3d89 cda00b call 0ba0h ; OUTC (alias OUTDO): print character +3d8c e5 push hl +3d8d 0eff ld c,0ffh +3d8f 0c inc c +3d90 7e ld a,(hl) +3d91 b7 or a +3d92 23 inc hl +3d93 20fa jr nz,3d8fh +3d95 e1 pop hl +3d96 47 ld b,a +3d97 1600 ld d,00h +3d99 cdac09 call 09ach ; Console input routine +3d9c d630 sub 30h +3d9e 380e jr c,3daeh +3da0 fe0a cp 0ah +3da2 300a jr nc,3daeh +3da4 5f ld e,a +3da5 7a ld a,d +3da6 07 rlca +3da7 07 rlca +3da8 82 add a,d +3da9 07 rlca +3daa 83 add a,e +3dab 57 ld d,a +3dac 18eb jr 3d99h + +3dae e5 push hl +3daf 21973d ld hl,3d97h +3db2 e3 ex (sp),hl +3db3 15 dec d +3db4 14 inc d +3db5 c2b93d jp nz,3db9h +3db8 14 inc d +3db9 fed8 cp 0d8h +3dbb cad03e jp z,3ed0h +3dbe fedd cp 0ddh +3dc0 cade3e jp z,3edeh +3dc3 fef0 cp 0f0h +3dc5 2841 jr z,3e08h +3dc7 fe31 cp 31h +3dc9 3802 jr c,3dcdh +3dcb d620 sub 20h +3dcd fe21 cp 21h +3dcf caf43e jp z,3ef4h +3dd2 fe1c cp 1ch +3dd4 ca3e3e jp z,3e3eh +3dd7 fe23 cp 23h +3dd9 283f jr z,3e1ah +3ddb fe19 cp 19h +3ddd ca7b3e jp z,3e7bh +3de0 fe14 cp 14h +3de2 ca483e jp z,3e48h +3de5 fe13 cp 13h +3de7 ca633e jp z,3e63h +3dea fe15 cp 15h +3dec cae13e jp z,3ee1h +3def fe28 cp 28h +3df1 ca763e jp z,3e76h +3df4 fe1b cp 1bh +3df6 281c jr z,3e14h +3df8 fe18 cp 18h +3dfa ca733e jp z,3e73h +3dfd fe11 cp 11h +3dff c0 ret nz +3e00 c1 pop bc +3e01 d1 pop de +3e02 cde92f call 2fe9h +3e05 c3633d jp 3d63h + +3e08 7e ld a,(hl) +3e09 b7 or a +3e0a c8 ret z +3e0b 04 inc b +3e0c cda00b call 0ba0h ; OUTC (alias OUTDO): print character +3e0f 23 inc hl +3e10 15 dec d +3e11 20f5 jr nz,3e08h +3e13 c9 ret + +3e14 e5 push hl +3e15 215d3e ld hl,3e5dh +3e18 e3 ex (sp),hl +3e19 37 scf +3e1a f5 push af +3e1b cdac09 call 09ach ; Console input routine +3e1e 5f ld e,a +3e1f f1 pop af +3e20 f5 push af +3e21 dc5d3e call c,3e5dh +3e24 7e ld a,(hl) +3e25 b7 or a ; end of string ? +3e26 ca3c3e jp z,3e3ch +3e29 cda00b call 0ba0h ; OUTC (alias OUTDO): print character +3e2c f1 pop af +3e2d f5 push af +3e2e dc9f3e call c,3e9fh +3e31 3802 jr c,3e35h +3e33 23 inc hl +3e34 04 inc b +3e35 7e ld a,(hl) +3e36 bb cp e +3e37 20eb jr nz,3e24h +3e39 15 dec d +3e3a 20e8 jr nz,3e24h +3e3c f1 pop af +3e3d c9 ret + +3e3e cd693a call 3a69h ; Print message, text ptr in (HL) +3e41 cde92f call 2fe9h +3e44 c1 pop bc +3e45 c37a3d jp 3d7ah +3e48 7e ld a,(hl) +3e49 b7 or a +3e4a c8 ret z +3e4b 3e21 ld a,21h ; '!' +3e4d cda00b call 0ba0h ; OUTC (alias OUTDO): print character +3e50 7e ld a,(hl) +3e51 b7 or a +3e52 2809 jr z,3e5dh +3e54 cda00b call 0ba0h ; OUTC (alias OUTDO): print character +3e57 cd9f3e call 3e9fh +3e5a 15 dec d +3e5b 20f3 jr nz,3e50h +3e5d 3e21 ld a,21h ; '!' +3e5f cda00b call 0ba0h ; OUTC (alias OUTDO): print character +3e62 c9 ret + +3e63 7e ld a,(hl) +3e64 b7 or a +3e65 c8 ret z +3e66 cdac09 call 09ach ; Console input routine +3e69 77 ld (hl),a +3e6a cda00b call 0ba0h ; OUTC (alias OUTDO): print character +3e6d 23 inc hl +3e6e 04 inc b +3e6f 15 dec d +3e70 20f1 jr nz,3e63h +3e72 c9 ret + +3e73 3600 ld (hl),00h +3e75 48 ld c,b +3e76 16ff ld d,0ffh +3e78 cd083e call 3e08h +3e7b cdac09 call 09ach ; Console input routine +3e7e b7 or a +3e7f ca7b3e jp z,3e7bh +3e82 fe08 cp 08h +3e84 280a jr z,3e90h +3e86 fe0d cp 0dh +3e88 cade3e jp z,3edeh +3e8b fe1b cp 1bh +3e8d c8 ret z +3e8e 201e jr nz,3eaeh +3e90 3e08 ld a,08h +3e92 05 dec b +3e93 04 inc b +3e94 281f jr z,3eb5h +3e96 cda00b call 0ba0h ; OUTC (alias OUTDO): print character +3e99 2b dec hl +3e9a 05 dec b +3e9b 117b3e ld de,3e7bh +3e9e d5 push de +3e9f e5 push hl +3ea0 0d dec c +3ea1 7e ld a,(hl) +3ea2 b7 or a +3ea3 37 scf +3ea4 cafa16 jp z,16fah +3ea7 23 inc hl +3ea8 7e ld a,(hl) +3ea9 2b dec hl +3eaa 77 ld (hl),a +3eab 23 inc hl +3eac 18f3 jr 3ea1h +3eae f5 push af +3eaf 79 ld a,c +3eb0 feff cp 0ffh +3eb2 3803 jr c,3eb7h +3eb4 f1 pop af +3eb5 18c4 jr 3e7bh + +3eb7 90 sub b +3eb8 0c inc c +3eb9 04 inc b +3eba c5 push bc +3ebb eb ex de,hl +3ebc 6f ld l,a +3ebd 2600 ld h,00h +3ebf 19 add hl,de +3ec0 44 ld b,h +3ec1 4d ld c,l +3ec2 23 inc hl +3ec3 cd4228 call 2842h +3ec6 c1 pop bc +3ec7 f1 pop af +3ec8 77 ld (hl),a +3ec9 cda00b call 0ba0h ; OUTC (alias OUTDO): print character +3ecc 23 inc hl +3ecd c37b3e jp 3e7bh + +3ed0 78 ld a,b +3ed1 b7 or a +3ed2 c8 ret z +3ed3 05 dec b +3ed4 2b dec hl +3ed5 3e08 ld a,08h +3ed7 cda00b call 0ba0h ; OUTC (alias OUTDO): print character +3eda 15 dec d +3edb 20f3 jr nz,3ed0h +3edd c9 ret + +3ede cd693a call 3a69h ; Print message, text ptr in (HL) +3ee1 cde92f call 2fe9h +3ee4 c1 pop bc +3ee5 d1 pop de +3ee6 7a ld a,d +3ee7 a3 and e +3ee8 3c inc a +3ee9 2ac7fd ld hl,(0fdc7h) ; Pointer to address of keyboard buffer +3eec 2b dec hl +3eed c8 ret z +3eee 37 scf +3eef 23 inc hl +3ef0 f5 push af +3ef1 c38229 jp 2982h + + +3ef4 c1 pop bc +3ef5 d1 pop de +3ef6 c30329 jp 2903h ; READY + + +3ef9 00 nop +3efa c0 ret nz +3efb 00 nop +3efc f20b00 jp p,000bh +3eff f20b00 jp p,000bh + +3f02 db50 in a,(50h) ; get system status +3f04 cbaf res 5,a ; DISPEN - CRTC display enable signal +3f06 d370 out (70h),a ; Set system status +3f08 c38c28 jp 288ch ; ERROR, E=error code + +3f0b ff rst 38h +3f0c ff rst 38h +3f0d ff rst 38h +3f0e ff rst 38h +3f0f ff rst 38h +3f10 3eff ld a,0ffh +3f12 181c jr 3f30h + +3f14 3efe ld a,0feh +3f16 1818 jr 3f30h + +3f18 3efd ld a,0fdh +3f1a 1814 jr 3f30h + +3f1c 3efc ld a,0fch +3f1e 1810 jr 3f30h + +; HEXTFP +3f20 3efb ld a,0fbh +3f22 180c jr 3f30h + +; FN_INSTR +3f24 3efa ld a,0fah +3f26 1808 jr 3f30h + +3f28 3ef9 ld a,0f9h +3f2a 1804 jr 3f30h + +3f2c 3ef8 ld a,0f8h +3f2e 1800 jr 3f30h + +3f30 1822 jr 3f54h ; __Exec command in FAR memory bank (1) + +3f32 3ef7 ld a,0f7h +3f34 181e jr 3f54h ; __Exec command in FAR memory bank (1) + +3f36 3ef6 ld a,0f6h +3f38 181a jr 3f54h ; __Exec command in FAR memory bank (1) + +3f3a 3ef5 ld a,0f5h +3f3c 1816 jr 3f54h ; __Exec command in FAR memory bank (1) + +3f3e 3ef4 ld a,0f4h +3f40 1812 jr 3f54h ; __Exec command in FAR memory bank (1) + +; Exec command in FAR memory bank +3f42 1822 jr 3f66h + +3f44 180e jr 3f54h ; __Exec command in FAR memory bank (1) + +3f46 3ef2 ld a,0f2h +3f48 180a jr 3f54h ; __Exec command in FAR memory bank (1) + +3f4a 3ef1 ld a,0f1h +3f4c 1806 jr 3f54h ; __Exec command in FAR memory bank (1) + +3f4e 3ef0 ld a,0f0h +3f50 1802 jr 3f54h ; __Exec command in FAR memory bank (1) + +3f52 00 nop +3f53 00 nop + +; __Exec command in FAR memory bank (1) +3f54 f5 push af +3f55 db50 in a,(50h) ; get system status +3f57 cbef set 5,a ; DISPEN - CRTC display enable signal +3f59 d370 out (70h),a ; Set system status +3f5b f1 pop af +3f5c cd0003 call 0300h +3f5f db50 in a,(50h) ; get system status +3f61 cbaf res 5,a ; DISPEN - CRTC display enable signal +3f63 d370 out (70h),a ; Set system status +3f65 c9 ret + +; __Exec command in FAR memory bank +3f66 f5 push af +3f67 db50 in a,(50h) ; get system status +3f69 cbef set 5,a ; DISPEN - CRTC display enable signal +3f6b d370 out (70h),a ; Set system status +3f6d f1 pop af +3f6e cd0303 call 0303h +3f71 db50 in a,(50h) ; get system status +3f73 cbaf res 5,a ; DISPEN - CRTC display enable signal +3f75 d370 out (70h),a ; Set system status +3f77 c9 ret + +3f78 ff rst 38h +3f79 ff rst 38h +3f7a ff rst 38h +3f7b ff rst 38h +3f7c ff rst 38h +3f7d ff rst 38h +3f7e ff rst 38h +3f7f ff rst 38h + +; BANK SWITCHING - call the FAR function in stack +3f80 dd21933f ld ix,3f93h ; restore original pages and return +3f84 fde1 pop iy +3f86 dde5 push ix ; restore original pages and return +3f88 fde5 push iy +; BANK SWITCHING - flip ROM page +3f8a f5 push af +3f8b db50 in a,(50h) ; get system status +3f8d cbaf res 5,a ; DISPEN - CRTC display enable signal +3f8f d370 out (70h),a ; Set system status +3f91 f1 pop af +3f92 c9 ret + +; restore original pages and return +3f93 f5 push af +3f94 db50 in a,(50h) ; get system status +3f96 cbef set 5,a ; DISPEN - CRTC display enable signal +3f98 d370 out (70h),a ; Set system status +3f9a f1 pop af +3f9b c9 ret + +3f9c f5 push af +3f9d db50 in a,(50h) ; get system status +3f9f cbef set 5,a ; DISPEN - CRTC display enable signal +3fa1 d370 out (70h),a ; Set system status +3fa3 f1 pop af +3fa4 c34503 jp 0345h + +3fa7 ff rst 38h +3fa8 ff rst 38h +3fa9 ff rst 38h +3faa ff rst 38h +3fab ff rst 38h +3fac ff rst 38h +3fad ff rst 38h +3fae ff rst 38h +3faf ff rst 38h +3fb0 ff rst 38h +3fb1 ff rst 38h +3fb2 ff rst 38h +3fb3 ff rst 38h +3fb4 ff rst 38h +3fb5 ff rst 38h +3fb6 ff rst 38h +3fb7 ff rst 38h +3fb8 ff rst 38h +3fb9 ff rst 38h +3fba ff rst 38h +3fbb ff rst 38h +3fbc ff rst 38h +3fbd ff rst 38h +3fbe ff rst 38h +3fbf ff rst 38h +3fc0 ff rst 38h +3fc1 ff rst 38h +3fc2 ff rst 38h +3fc3 ff rst 38h +3fc4 ff rst 38h +3fc5 ff rst 38h +3fc6 ff rst 38h +3fc7 ff rst 38h +3fc8 ff rst 38h +3fc9 ff rst 38h +3fca ff rst 38h +3fcb ff rst 38h +3fcc ff rst 38h +3fcd ff rst 38h +3fce ff rst 38h +3fcf ff rst 38h +3fd0 ff rst 38h +3fd1 ff rst 38h +3fd2 ff rst 38h +3fd3 ff rst 38h +3fd4 ff rst 38h +3fd5 ff rst 38h +3fd6 ff rst 38h +3fd7 ff rst 38h +3fd8 ff rst 38h +3fd9 ff rst 38h +3fda ff rst 38h +3fdb ff rst 38h +3fdc ff rst 38h +3fdd ff rst 38h +3fde ff rst 38h +3fdf ff rst 38h +3fe0 ff rst 38h +3fe1 ff rst 38h +3fe2 ff rst 38h +3fe3 ff rst 38h +3fe4 ff rst 38h +3fe5 ff rst 38h +3fe6 ff rst 38h +3fe7 ff rst 38h +3fe8 ff rst 38h +3fe9 ff rst 38h + +3fea cd9e1e call 1e9eh +3fed b6 or (hl) +3fee cd431e call 1e43h +3ff1 c9 ret + +3ff2 7e ld a,(hl) +3ff3 c9 ret + +3ff4 5e ld e,(hl) +3ff5 23 inc hl +3ff6 56 ld d,(hl) +3ff7 c9 ret + +3ff8 1a ld a,(de) +3ff9 c9 ret + +3ffa dde9 jp (ix) +3ffc e1 pop hl +3ffd 2e65 ld l,65h +3fff 86 add a,(hl)