title HiSoft PASCAL80 name ('HP') ; DASMed version of HISOFT PASCAL compiler HP.COM ; DASMed by W.Cirsovius ; NOTE: Originally the code will be moved correctly ; into memory to prevent illegal copies of this compiler .z80 aseg org 0100h LD.BC equ 001h LD.DE equ 011h LD.HL equ 021h LD.A.L equ 07dh LD.D.H equ 054h LD.E.L equ 05dh LD.HL.A equ 077h LD.A.HL equ 07eh LD.Bi equ 006h LD.Ci equ 00eh LD.Ai equ 03eh LD.@A equ 032h LD.A@ equ 03ah LD.@HL equ 022h LD.HL@ equ 02ah LD.SPHL equ 0f9h ; DEC.HL equ 02bh INC.SP equ 033h ; AD.HLDE equ 019h AD.HLHL equ 029h AD.HLSP equ 039h JP@ equ 0c3h JP.NZ@ equ 0c2h JP.Z@ equ 0cah JP.C@ equ 0dah JP.M@ equ 0fah JP.HL equ 0e9h CAL equ 0cdh CP.i equ 0feh PUSH.BC equ 0c5h PUSH.DE equ 0d5h PUSH.HL equ 0e5h PUSH.AF equ 0f5h POP.DE equ 0d1h POP.HL equ 0e1h EX.DEHL equ 0ebh NOOP equ 000h XOR.A equ 0afh LD.@DE equ 0ed53h LD.DE@ equ 0ed5bh LD.IX_D equ 0dd72h LD.IX_E equ 0dd73h LD.IX_H equ 0dd74h LD.IX_L equ 0dd75h LD.D_IX equ 0dd56h LD.E_IX equ 0dd5eh LD.H_IX equ 0dd66h LD.L_IX equ 0dd6eh LD.A_IX equ 0dd7eh POP.IX equ 0dde1h l00a6 equ 000a6h ; and (hl);nop l00b6 equ 000b6h ; or (hl);nop la62f equ 0a62fh ; cpl;and (hl) lb0ed equ 0b0edh ; ldir ;; UNKNOWN FROM l09f7: ;; l1b65: l1a48 toknum macro tok,num ld de,256*(tok)+num endm toktst macro tok,num toknum tok,num call l0faa endm ;; l1c8d: l19cf **** l15e1:l09b7 ;; l1d55 RTL starts ; DYNAMIC DATA ; ; l3e2c l3ead l3f2e ; Status words [l016a]: ; 0,(ix+0) P+,L+ = Set printer device ; 1,(ix+0) O+ = Check overflow ; 2,(ix+0) C+ = Keyboard check during run time ; 3,(ix+0) S+ = Stack check ; 4,(ix+0) I+ = Integer check ; 5,(ix+0) A+ = Array check ; 6,(ix+0) N = Write to file enabled if set ; 7,(ix+0) If set read line from file ; 0,(ix+2) End of file allowed if set ; 2,(ix+2) Y = Ask for file deletion if file does exist ; 6,(ix+2) D = Start of data ; 7,(ix+2) G = Go ; 0,(ix+3) X = ??? OS equ 0000h BDOS equ 0005h TPA equ 0100h .conin equ 1 .conout equ 2 .lstout equ 5 .condir equ 6 .kbdlin equ 10 .kbstat equ 11 .open equ 15 .close equ 16 .delete equ 19 .rdseq equ 20 .wrseq equ 21 .make equ 22 .setdma equ 26 .rdrnd equ 33 .wrrnd equ 34 _get equ -1 .drv equ 1 .nam equ 8 .ext equ 3 _EX equ 12 _S1 equ 14 _CR equ 32 _RRN equ 33 reclng equ 128 null equ 00h tab equ 09h lf equ 0ah cr equ 0dh eof equ 1ah MSB equ 10000000b UPPMASK equ 11011111b LOMASK equ 00001111b Colpos equ 8 LINLEN equ 80 ; ; Tokens ; @ID equ 0 @PRG equ 1 @DIV equ 2 @CON equ 3 @PRC equ 4 @FNC equ 5 @NOT equ 6 @OR equ 7 @AND equ 8 @MOD equ 9 @VAR equ 10 @OF equ 11 @TO equ 12 @DOWNTO equ 13 @THEN equ 14 @UNTIL equ 15 @END equ 16 @DO equ 17 @ELSE equ 18 @REPEAT equ 19 @GOTO equ 26 @TYP equ 31 @IN equ 32 @LBL equ 33 .NEQ equ 77h ; <> .EQ equ 78h ; = .GT equ 79h ; > .LT equ 7ah ; < .GTE equ 7bh ; >= .LTE equ 7ch ; <= l020e equ 256*2+14 ; Type ??? .false equ 0 .true equ 1 l0084 equ 84h l00a4 equ 0a4h l0016 equ 22 ; Length of real bits (???) l03d6 equ 03d6h l07d6 equ l07d6 l08cc equ 08cch l5000 equ 5000h l0000 equ 00h l0001 equ 01h l0002 equ 02h l0003 equ 03h l0004 equ 04h l0005 equ 05h l0006 equ 06h l0007 equ 07h l0008 equ 08h l0009 equ 09h l000a equ 0ah l000b equ 0bh l000d equ 0dh l000e equ 0eh l000f equ 0fh l0011 equ 11h l001a equ 1ah l0021 equ 21h l0023 equ 23h l0024 equ 24h l0028 equ 28h l004d equ 4dh l0058 equ 58h l005c equ 5ch l005d equ 5dh l006c equ 6ch l006d equ 6dh l0080 equ 80h l0081 equ 81h l00a1 equ 0a1h l00a3 equ 0a3h l00a9 equ 0a9h l00aa equ 0aah l00ad equ 0adh l63e7 equ 63e7h l7806 equ 7806h l8000 equ 8000h l84cd equ 84cdh laac3 equ 0aac3h lac2a equ 0ac2ah lae25 equ 0ae25h lae2b equ 0ae2bh lbccd equ 0bccdh lc53f equ 0c53fh lcd03 equ 0cd03h lcd08 equ 0cd08h lcd3c equ 0cd3ch ldb22 equ 0db22h leb12 equ 0eb12h lff53 equ 0ff53h lff7e equ 0ff7eh lffcd equ 0ffcdh lfff5 equ 0fff5h lfff6 equ 0fff6h lfff9 equ 0fff9h lfffa equ 0fffah lfffc equ 0fffch lffff equ 0ffffh ld sp,(l0006) ; Get stack jr l0115 ; Start ; l0106: db -1 ; End flag ; ds 14 ; ; In the original this is the code to move part of the compiler ; l0115: ds 3 ; LD DE,5D23 ds 3 ; LD BC,1D24 ds 3 ; LD HL,50DD ds 2 ; LDDR ; call l5a70 ; Prepare environment of compiler l0123: call l4dd6 ; Process a block cp '.'+MSB ; Verify end jp z,l0875 ; Yeap ld e,11 call l09b7 ; . expected jr l0123 ; l0132:: ;;** ds 3 ; Jump to storage routine l0135: db 0,0 l0137: db 0,0 l0139: db 0,0 l013b: db 0,0 l013d: db ' ' ; Last character read l013e: db 0 l013f: db 0,0 l0141: db 0,0 l0143: db 0,0 l0145: db 0,0 l0147: db 0,0 l0149: db 0,0 l014b: db 0,0 l014d: dw 0 ; High memory l014f: db 0,0 l0151: dw l0d14 l0153: dw l1d4b ; Current symbol pointer l0155: dw l1d55 ; Top symbol pointer l0157: dw l3f2e ; Line pointer l0159: dw 0 ; Line number l015b: db 0,0 l015d: dw 0 l015f: db 0 ; Blank count on error l0160: db 0 l0161: db 0 ; Error indicator l0162: db 6 l0163: db 0,0 l0165: db 0,0,0,0,0 ; ; Status word ; l016a: db 11101111b ;; db 0efh ; +0 l016b: db 0 ; +1 db ' ' ; +2 db 0 ; +3 ; db 0,0 l0170: db 0,0 l0172: db 0,0 l0174: db 0 l0175: db 0 l0176: db 0,0 l0178: db 0,0 l017a: dw l121d-TPA ; Default start of binary code l017c: dw 0 l017e: dw 0 l0180: db 0,1 l0182: db 0,0,0,0,0,0,0,0,0 l018b: dw 0 ; Address for option G ; ; Binary file ; l018d: db 0,' COM' ds 24 ; ; Source file ; l01b1: db 0,' PAS' ds 24 l01d5: db 0,' PAS' ds 24 l01f9: dw l01b1 l01fb: dw l3e2c ; Address of disk buffer l01fd: dw l3eac ; Current disk buffer l01ff: dw 0 ; ; ; l0201: ld hl,l01b1 ; Point to source file ld de,l0081 call l02cf ; Copy file name to command line ld a,(l0161) or a ; Test previous error jr z,l0240 ; Nope ld a,' ' ld (de),a inc de ld hl,l0694 ld (l038b+1),hl ; Change output vector ld (l0355),de ; Init buffer address ld hl,(l01f9) ; Get source file ld de,l0106 call l02cf ; Copy file name xor a ld (de),a ld hl,(l0159) ; Get line number ld b,5 ld iy,l0650 call l062e ; Print as decimal l0235: ld hl,l0394 ld (l038b+1),hl ld hl,(l0355) ; Get buffer address jr l0241 l0240: ex de,hl l0241: ld de,l0081 or a sbc hl,de ld a,l dec de ld (de),a ld de,l02e2 call l02a0 push hl ld hl,l0305 ld de,l042e ld bc,l004d ldir ld a,(l0352) ld (l04bd),a ld hl,(l0353) ; Get line position ld (l04be),hl ld de,l04c0 ld hl,l0357 ld c,')' ldir l0272: ld hl,l0106 ld bc,l000f ldir ld hl,lb0ed ld (TPA-2),hl ; Set 'ldir' pop bc ld hl,l03ed ld de,TPA jp TPA-2 l028a: ld de,l018d ; Point to binary file xor a ld (l018d+_EX),a ld (l018d+_S1),a ld (l018d+_CR),a call l02a0 push hl ld de,l03ea+9 jr l0272 l02a0: ld c,.open call l03cc ; Open file inc a ; Verify ok jp z,OS ; Exit if not found ex de,hl ld de,l03ed ; Init disk buffer l02ad: call l03ca ; Set disk buffer ex de,hl ld c,.rdseq call l03cc ; Read record from file or a ; Test end of file jr nz,l02c0 ; Yeap ld bc,reclng add hl,bc ; Advance disk buffer ex de,hl jr l02ad l02c0: ld de,l03ed or a sbc hl,de ; Test any data read jp z,OS ; Nope, exit ; ; Set standard disk buffer ; l02c9: ld de,l0080 jp l03ca ; Set disk buffer ; ; Copy file name from ^HL to ^DE ; l02cf: ld a,(hl) ; Get drive or a ; Test default jr z,l02db add a,'A'-1 ; Make ASCII ld (de),a inc de ld a,':' ld (de),a ; Give delimiter inc de l02db: inc hl ld bc,.nam ldir ; Unpack name of file ret ; l02e2:: db 0,'HPE COM' ds 23 l0305: db 'HP.COM' db 0,0,0,0,0,0,0 l0312: db 0 l0313: ds 63 l0352: db 0 l0353: dw 0 l0355: dw 0 ; Buffer address l0357: db 'Error messages not available ',null ; ; Give new line on device ; l0380: ld a,cr call l038b ; Simple one ld a,lf jr l038b ; ; Give blank on device ; l0389: ld a,' ' ; ; Put character to device ; l038b: jp l0394 ; Address selected dynamically ; ; Put character to printer ; l038e: push af push bc l0390: ld c,.lstout jr l0398 ; ; Put character to console ; l0394: push af push bc ld c,.conout ; ; Do character OS call ; l0398: push de ld e,a push hl ex af,af' push af ex af,af' exx push bc push de push hl exx push ix push iy call BDOS ; Do the call pop iy pop ix exx pop hl pop de pop bc exx ex af,af' pop af ex af,af' pop hl pop de pop bc pop af ret ; ; Read random record from file ; l03bb: ld c,.rdrnd jr l03c1 ; ; Write random record to file ; l03bf: ld c,.wrrnd l03c1: ld de,l018d ; Point to binary file jr l03cc ; Do file I/O ; ; Read character from keyboard ; l03c6: ld c,.conin jr l03cc ; ; Set disk buffer ; l03ca: ld c,.setdma ; ; Do OS call ; l03cc: push hl push de push bc ex af,af' push af ex af,af' exx push bc push de push hl exx push ix push iy call BDOS pop iy pop ix pop hl pop de pop bc exx ex af,af' pop af ex af,af' pop bc pop de pop hl ret ; ; Print zero closed string ^HL ; l03ed:: ld a,(hl) inc hl or a ret z call l038b ; Put character to device jr l03ed ; ; ; l03f6: ld iy,l0000 add iy,sp ld a,(iy+3) add a,d jp pe,l0451 push af ld c,e xor a ex de,hl ld l,(iy+2) ld b,8 l040c: rr l jr nc,l0411 add a,d l0411: rra djnz l040c rr l ld h,a ld a,(iy+4) ld b,8 l041c: rra jr nc,l0420 add hl,de l0420: rr h rr l djnz l041c rra ld b,7 l0429: rr (iy+5) jr nc,l0432 add a,c adc hl,de l0432: rr h rr l rra djnz l0429 pop de ld e,a bit 6,h jr nz,l0445 rl e adc hl,hl jr l0449 l0445: inc d jp pe,l0451 l0449: pop bc pop af pop af push bc ret l044e: ld (l013d),a ; Save last character l0451: ld e,1 ; Number too large l0453: call l09b7 jp l0c78 l0459: ld iy,l0000 add iy,sp ld a,(iy+3) sub d jp pe,l0451 push af ld c,e ex de,hl ld h,(iy+5) ld l,(iy+4) ld a,(iy+2) ld b,8 l0474: sub c sbc hl,de jr nc,l047c add a,c adc hl,de l047c: rl (iy-2) add a,a adc hl,hl djnz l0474 ld b,8 l0487: sbc hl,de jr nc,l048c add hl,de l048c: rla add hl,hl djnz l0487 cpl ld l,a ld a,h ld b,8 l0495: sub d jr nc,l0499 add a,d l0499: rl e add a,a djnz l0495 ld b,e pop de ld a,e cpl ld h,a ld a,b cpl bit 7,h jr nz,l04b1 dec d jp pe,l0451 l04ad: ld e,a jp l0449 l04b1: srl h rr l rra jr l04ad l04b8: add hl,hl rl e rl d l04bd: push de l04be: push hl add hl,hl l04c0: rl e rl d add hl,hl rl e rl d pop bc add hl,bc ex de,hl pop bc adc hl,bc ex de,hl ret l04d1: ld hl,04000h ld d,l ld e,l ld iy,l04fd l04da: srl a jr nc,l04f5 push af push iy push hl push de ld h,(iy+0) ld l,(iy+1) ld e,(iy+2) ld d,(iy+3) call l03f6 pop iy pop af l04f5: ret z ld bc,l0004 add iy,bc jr l04da l04fd: db 050h,000h,000h,003h ; 1 E01 db 064h,000h,000h,006h ; 1 E02 db 04eh,020h,000h,00dh ; 1 E04 db 05fh,05eh,010h,01ah ; 1 E08 db 047h,00dh,0e4h,035h ; 1 E16 db 04eh,0e2h,0d4h,06ah ; 1 E32 l0515: set 1,(ix+2) l0519: ld c,d cp 'E' jr z,l0587 ld (l013d),a ; Save last character xor a cp e jr nz,l0531 bit 7,h jr nz,l0531 ld (l0143),hl ld a,7fh jp l0c7a l0531: ld a,d jp l05a9 l0535: ld hl,l0000 ld d,h ld e,l ld b,7 push bc jr l0543 l053f: push bc call l04b8 l0543: sub '0' ld c,a ld b,d add hl,bc jr nc,l054b inc de l054b: call l0b0b ; Get character and test if it is a digit pop bc dec b jr nc,l055a ; Nope jr nz,l053f l0554: inc d call l0b0b ; Get character and test if it is a digit jr c,l0554 ; Yeap l055a: cp '.' jr nz,l0519 call l0b0b ; Get character and test if it is a digit jr nc,l0515 ; Nope dec b inc b ld c,d jr z,l057d l0568: push bc call l04b8 sub '0' ld c,a ld b,d add hl,bc jr nc,l0574 inc e l0574: pop bc dec c call l0b0b ; Get character and test if it is a digit jr nc,l0582 ; Nope djnz l0568 l057d: call l0b0b ; Get character and test if it is a digit jr c,l057d ; Yeap l0582: ld d,c cp 'E' jr nz,l0599 l0587: push de call l06f0 cp '-' jr nz,l059f call l06f0 call l060c pop af sub b jr l05a9 l0599: ld (l013d),a ; Save last character ld a,d jr l05a9 l059f: cp '+' call z,l06f0 call l060c pop af add a,b l05a9: ld d,16h ld c,a bit 7,e jr nz,l05f9 xor a cp e jr nz,l05bd cp l jr nz,l05c1 cp h jr nz,l05c1 ld d,0 ret l05bd: bit 6,e jr nz,l05c7 l05c1: add hl,hl rl e dec d jr l05bd l05c7: ld b,e ld e,l ld l,h ld h,b ld a,c or a ret z push hl push de jp m,l05da call l04d1 call l03f6 ret l05da: neg cp ' ' jr nc,l05e7 call l04d1 l05e3: call l0459 ret l05e7: sub ' ' call l04d1 call l0459 push hl push de ld hl,04ee2h ; Load 1.0E+32 ld de,06ad4h jr l05e3 l05f9: inc hl jr nz,l05fd inc e l05fd: srl e rr h rr l inc d jp l05c7 l0607: ld e,31 jp l0453 ; Exponent expected l060c: call l0b0e ; Test character a digit jr nc,l0607 ; Nope sub '0' ld b,a call l0b0b ; Get character and test if it is a digit jr nc,l062a ; Nope sub '0' ld c,a ld a,b add a,a ld b,a add a,a add a,a add a,b add a,c ld b,a call l0b0b ; Get character and test if it is a digit jp c,l044e ; Yeap l062a: ld (l013d),a ; Save last character ret ; ; Print decimal value HL with B places ; l062e: ld c,'0' ; Force leading zero l0630: ld e,(iy+0) ; Get divisor ld d,(iy+1) ld a,'0'-1 ; Init quotient or a l0639: inc a ; Update quotient sbc hl,de ; Divide jr nc,l0639 add hl,de ; Make remainder positive cp c ; Test leading zero jr nz,l0645 ; Nope ld a,' ' ; Give blank if so inc c l0645: dec c call l038b ; Put character to device inc iy ; Fix divisor table inc iy djnz l0630 ret ; l0650: dw 10000 dw 1000 l0654: dw 100 l0656: dw 10 dw 1 ; ; Print hex word ; l065a: ld a,d call l065f ld a,e ; ; Print hex byte ; l065f: push af rrca ; Get upper bits rrca rrca rrca call l0668 pop af ; ; Print hex nibble ; l0668: and LOMASK ; Mask bits add a,090h ; Convert to hex ASCII daa adc a,040h daa jp l038b ; Put character to device ; ; ; l0673: xor a sbc hl,de add hl,de jr nc,l067a ex de,hl l067a: or d jr nz,l068f ld a,e ld e,d jr l0687 l0681: ex de,hl add hl,de ex de,hl l0684: add hl,hl jr c,l068f l0687: rra jr nc,l0684 or a jr nz,l0681 add hl,de ret nc l068f: ld e,53 jp l09b7 ; Array too large ( >64K! ) ; ; Store non blank characters ; l0694: cp ' ' ; Test blank ret z ; Ignore it push hl ld hl,(l0355) ; Get buffer address ld (hl),a ; Store character inc hl ld (l0355),hl ; Save address pop hl ret ; ; Put line on console ; l06a2: push bc push de push hl ld d,0 ; Init column counter ld hl,l3f2e ; Init line pointer l06aa: ld a,(hl) ; Get character cp tab ; Test tab jr nz,l06bf ; Nope inc hl ld a,d ; Get column and -8 ; Calculate places to next one add a,8 sub d ld b,a l06b7: call l0389 ; Give blank on device inc d djnz l06b7 jr l06aa l06bf: cp cr ; Test end of line jr z,l06ca call l038b ; Put character to device inc d inc hl jr l06aa l06ca: ld a,(l015d) or a jr nz,l06d4 ld a,d ld (l015f),a ; Set blank count l06d4: pop hl pop de pop bc ret ; ; Print program counter and line number ; l06d8: call l1076 ; Get current program counter ex de,hl call l065a ; Print hex value ld hl,(l0159) ; Get line number push bc ld b,5 ld iy,l0650 call l062e ; Print as decimal pop bc jp l0389 ; Give blank on device ; ; Get next character ; l06f0: push hl bit 7,(ix+0) ; Test read new line from file jr z,l0717 ; Nope, process current line push de ld hl,(l0159) ; Get line number inc hl ; Advance it ld (l0159),hl bit 0,(ix+0) ; Test print call nz,l06d8 ; Yeap, print program counter and line number l0706: push bc call l074b ; Read line from file res 7,(ix+0) ; Set process current line bit 0,(ix+0) ; Test print call nz,l06a2 ; Yeap, put line on console pop bc pop de l0717: ld hl,(l0157) ; Get line pointer ; May change to "jp l07c5" on option G l071a: ld a,(hl) ; Get character inc hl ; Advance line pointer ld (l0157),hl pop hl l0720: cp cr ; Test end of line ret nz ; Nope push hl push de ld hl,(l0157) ; Get line pointer ld de,l3f2e+LINLEN+1 sbc hl,de ; Test line filled ld a,LINLEN ld (l015d),a jr z,l0706 ; Yeap xor a ld (l015d),a ld (l015f),a ; Clear blank count bit 0,(ix+0) ; Test print call nz,l0380 ; Yeap, give new line on device pop de pop hl set 7,(ix+0) ; Set read line from file ld a,' ' ret ; ; Read line from file ; l074b: ld de,l3f2e ld (l0157),de ; Init line pointer ld b,LINLEN ; Set length of line ld hl,(l01fd) ; Get current disk buffer l0757: ld a,(hl) ; Get character or a ; Test read from file jr z,l0778 ; Yeap cp eof ; Test end of file jr z,l0794 ; Yeap ld (de),a ; Store character inc hl cp lf ; Test end of line jr z,l0774 ; Yeap inc de djnz l0757 ; Fill buffer inc b cp cr ; Test return jr z,l0757 ; Try one character yet ex de,hl ld (hl),cr ; Close line inc hl ld (hl),lf ex de,hl l0774: ld (l01fd),hl ; Set current disk buffer ret l0778: push bc push de ld de,(l01fb) call l03ca ; Set disk buffer ld hl,(l01f9) ; Get source file ex de,hl ld c,.rdseq call l03cc ; Read record from file or a ; Test end of file pop de pop bc jr z,l0757 ; Nope ld hl,l0e8b ; No EOF jr l07e7 l0794: bit 0,(ix+2) ; Test EOF allowed jr z,l07e4 ; Nope res 0,(ix+2) ; Reset it ld hl,l3e2c ld (l01fb),hl ; Reset disk buffer ld hl,l01b1 ; Point to source file ld (l01f9),hl ; Set source file push de ex de,hl call l0e99 pop de ld hl,(l01ff) ld (l01fd),hl ; Set current disk buffer ld hl,(l015b) ld (l0159),hl ; Reset line number ld hl,l3f2e ; Init line pointer ld (hl),0dh inc hl ld (hl),0ah ret ; ; Go here for option G ; l07c5: push de ld de,(l018b) ; Get address of option G call l1076 ; Get current program counter or a sbc hl,de l07d0: ld hl,(l0157) ; Get line pointer jp nc,l09ac l07d6: pop de jp l071a l07da: ld hl,l0806 ; No error found jr l07e7 l07df: ld hl,l07f0 ; Symbol table full jr l07e7 l07e4: ld hl,l0e76 ; No more text l07e7: call l03ed ; Give message call l08ef ; Delete existing file jp l0923 ; End compiler ; l07f0: db cr,lf,'Symbol Table Full' db cr,lf,null l0806: db cr,lf,'Sorry, can''t find error',null ; ; Get base option ??? ; ; C set says not found ; l0820:: ld a,(de) ; Get character cp 'a' ; Test lower case jr c,l082b cp 'z'+1 jr nc,l082b sub 'a'-'A' ; Convert to UPPER case l082b: inc de l082c: ld hl,l0d08 ; Point to standard options ld b,6 l0831: cp (hl) ; Compare inc hl jr z,l0855 ; Got it inc hl djnz l0831 cp 'P' ; Test P+/- scf ret nz ld a,(de) inc de ld hl,l0394 cp '-' ; Test turn off jr z,l0850 cp '+' ; Test turn on jr nz,l086d set 0,(ix+0) ; Set bit ld hl,l038e l0850: ld (l038b+1),hl ; Change output to printer jr l0867 l0855: ld a,(de) inc de cp '+' ; Test turn on jr z,l086f ; Yeap cp '-' ; Test turn off jr nz,l086d ld a,(hl) ; Get bit cpl ; Build mask and (ix+0) ; Clear bit l0864: ld (ix+0),a ; Bring back state byte l0867: ld a,(de) inc de cp ',' jr z,l0820 l086d: or a ret l086f: ld a,(hl) ; Get bit or (ix+0) ; Set it jr l0864 ; ; End of compiler ; l0875: bit 7,(ix+2) ; Test option G jp nz,l07da ; Yeap ld hl,l0e17 call l03ed ; Tell end address ld hl,l092d call l106a ; Insert 'jp l0355' ex de,hl dec de ; Fix to end address call l065a ; Print hex value bit 6,(ix+2) ; Test option D jr z,l0897 ; Nope ld de,(l014d) ; Get high memory l0897: inc de ld hl,(l0176) push af push hl l089d: inc hl call l10e9 call nc,l10c1 ; Store word into current address pop hl pop af jr nz,l08b4 dec hl dec hl ld de,(l0145) call l10e9 call nc,l10c1 ; Store word into current address l08b4: ld hl,l0e27 call l03ed ; Tell minimum address for D option call l1076 ; Get current program counter ld de,(l014d) ; Get high memory add hl,de ld de,(l0145) or a sbc hl,de ; Calculate address ex de,hl call l065a ; Print hex value call l0380 ; Give new line on device ld a,(l0161) or a ; Test previous error jr z,l08fc ; Nope push af ld hl,l0e41 call l03ed ; Tell number of errors pop af ld l,a ld h,0 ld iy,l0654 ld b,3 call l062e ; Print decimal value call l08ef ; Delete existing file jr l0923 ; End compiler ; ; Delete existing file ; l08ef:: bit 6,(ix+0) ; Test write enabled ret z ; Nope ld de,l018d ; Point to binary file ld c,.delete jp l03cc ; Delete file l08fc: bit 6,(ix+0) ; Test write enabled jr z,l0923 ; Nope, end compiler exx push hl exx pop hl ld de,-l5a6a+reclng;;la616 add hl,de ; Build start of compiled code, zero relative ld bc,l5a6a ; Get start of binary code ld de,(l0180) ; Get start of code to be written into call l093e ; Write to disk ld de,l018d ; Point to binary file ld c,.close call l03cc ; Close file bit 0,(ix+3) ; Test option X jp nz,l028a ; ; End compiler ; l0923: ld a,(l0106) ; Get end flag inc a ; Test end jp z,OS ; Yeap jp l0201 ; ; ; l092d: db 3 JP L0355 ; ; Calculate file values from byte count in reg HL ; ; On exit reg B holds record count and reg C holds index within record ; Reg HL holds value in record boundary ; l0931: ld a,reclng and l ; Build index ld c,a ; Get into reg C ld a,l sub c ld l,c ; Get record boundary ld c,a push hl add hl,hl ; Calculate record count ld b,h ; Get as result pop hl ret ; ; Write data to file ; ; Write to disk ; ; HL start of compiled code, zero relative ; BC start of binary code ; DE start of code to be written into ; l093e: push hl or a ld hl,l5a6a ; Get top address sbc hl,de ; Strip off offset ex de,hl pop hl push bc call l0931 ; Calculate file values push hl or a sbc hl,de ld (l017c),hl ; Save for offset ex de,hl xor a ld l,a ld h,a sbc hl,de ld (l017e),hl ; Save base address pop hl ex (sp),hl push bc inc b ; Test any record to be written dec b jr z,l0967 ; Nope l0962: call l0980 ; Write records to file djnz l0962 l0967: ld de,l5a6a ; Init disk buffer pop bc ld b,0 inc c ; Test remainig bytes dec c l096f: jr z,l0973 ; Nope ldir ; Unpack them l0973: push de ; Save buffer address exx pop hl ; Get for current PC exx pop de ld hl,(l0180) add hl,de ; Set new top address ld (l0180),hl ret ; ; Write record to file with buffer address in reg HL ; l0980: bit 6,(ix+0) ; Test write enabled jr z,l099f ; Nope ex de,hl call l03ca ; Set disk buffer ex de,hl ld de,l018d ; Point to binary file ld c,.wrrnd call l03cc ; Write random record to file or a ; Test success jr nz,l09a6 ; Nope ld de,(l018d+_RRN) inc de ; Advance to next record ld (l018d+_RRN),de l099f: ld a,b ld bc,l0080 add hl,bc ; Advance disk buffer ld b,a ret l09a6: ld hl,l0e57 ; Write error jp l07e7 ; ; ; l09ac: ld e,75 jr l09b7 ; Run time error ; ; Verify identifier ; l09b0: call l0b1a ; Get token ; ; Verify identifier ; l09b3: or a ; Verify identifier ret z ld e,4 ; Identifier expected ; ; Process error with error number in reg E ; l09b7: push af push bc push hl bit 0,(ix+0) ; Test print jr nz,l09cb ; Yeap push de call l0380 ; Give new line on device call l06d8 ; Print program counter and line number call l06a2 ; Put line on console pop de l09cb: ld hl,l0e4a call l03ed ; Tell error ld hl,(l0157) ; Get line pointer ld a,(hl) cp cr ; Test end of line jr z,l09de cp lf jr nz,l09df dec hl ; Fix pointer if so l09de: dec hl l09df: ld bc,l3f2e ; Init line pointer l09e2: push hl or a sbc hl,bc ; Calculate position of error in line push de ld de,(l015d) ; Get offset add hl,de ; Fix position bit 0,(ix+0) ; Test print jr z,l0a01 ; Nope ld a,e or a ; Test offset jr z,l0a01 ; Nope ld a,(l015f) ; Get blank count push bc ld b,a l09fb: call l0389 ; Give blank on device djnz l09fb pop bc l0a01: pop de ld (l0353),hl ; Save position pop hl ld d,0 ; Init column position l0a08: or a sbc hl,bc ; Test end of position add hl,bc jr z,l0a2b ; Yeap ld a,(bc) cp tab ; Test tabulator jr nz,l0a24 ; Nope ld a,d ; Get column and -Colpos ; Calculate distance to next position add a,Colpos sub d push bc ld b,a l0a1b: call l0389 ; Give blank on device inc d djnz l0a1b pop bc jr l0a28 l0a24: call l0389 ; Give blank on device inc d l0a28: inc bc jr l0a08 l0a2b: ld a,81h ld (l0352),a ld a,'^' call l038b ; Put character to device ld l,e ; Get error number ld h,0 ld de,l0080 ld c,.setdma call l03cc ; Set disk buffer xor a ld (l0ab6+_CR),a ; Clear current record ld de,l0ab6 ld c,.open call l03cc ; Open file inc a ; Test success jr z,l0a89 ; Nope ld b,l ; Get error number l0a50: ld c,.rdseq call l03cc ; Read record from file ld hl,l0080 l0a58: ld a,l ; Get buffer pointer or a ; Test end of buffer jr z,l0a50 ; Yeap, read next one ld a,(hl) cp lf ; Find new line inc hl jr nz,l0a58 djnz l0a58 ; Loop till error line found call l0380 ; Give new line on device ld bc,l0357 ; Init error line l0a6a: ld a,l ; Get buffer pointer or a ; Test end of buffer jr nz,l0a78 ; Nope push bc ld c,.rdseq call l03cc ; Read record from file pop bc ld hl,l0080 ; Init buffer address l0a78: ld a,(hl) ld (bc),a ; Unpack error line inc bc call l038b ; Put character to device inc hl cp lf ; Test end of line jr nz,l0a6a ; Nope dec bc ; Fix pointer dec bc xor a ld (bc),a ; Set end of line l0a87: jr l0a92 l0a89: ld iy,l0656 ld b,2 call l062e ; Print decimal value l0a92: ld hl,l0161 inc (hl) ; Mark error found call l08ef ; Delete existing file bit 7,(ix+2) ; Test option G jp nz,l0201 ; Yeap call l03c6 ; Read character from keyboard cp 'C'-'@' ; Test abort jp z,OS ; Exit if so and UPPMASK cp 'E' jp z,l0201 call l0380 ; Give new line on device pop hl pop bc pop af ret ; l0ab6: db 0,'HP80 ERR' ds 24 ; ; Test valid alphanumeric label - C set says yes ; l0ada:: ld d,a ; Save character cp '0' ; Test numeric ccf ret nc ; Nope cp '9'+1 ret c and UPPMASK ; Get upper case cp 'A' ; Test alphabetical ccf ret nc ; Nope cp 'Z'+1 ret ; ; Get hex digit - C set says not a hex digit ; l0aeb: call l06f0 ; Get character cp 'a' ; Test lower case hex jr c,l0af8 cp 'f'+1 jr nc,l0af8 sub 'a'-'A' ; Convert to upper case l0af8: cp 'A' jr c,l0b03 cp 'F'+1 ccf ret c sub 'A'-10 ; Strip off offset ret l0b03: call l0b0e ; Test character a digit ccf ret c ; Nope sub '0' ; Strip off offset ret ; ; Get character and test if it is a digit - C set says yes ; l0b0b: call l06f0 ; Get character ; ; Test character a digit - C set says yes ; l0b0e: cp '0' ; Test range ccf ret nc cp '9'+1 ret ; ; ; l0b15: ld a,'.'+MSB jp l0c0e ; ; Get token ; l0b1a: push hl push de push bc bit 1,(ix+2) jr nz,l0b15 ld a,(l013d) ; Get last character l0b26: cp tab ; Skip white space jr z,l0b2e cp ' ' jr nz,l0b33 l0b2e: call l06f0 ; Get next character jr l0b26 l0b33: cp 'A' ; Test range jp c,l0bf3 ; May be numeric cp 'Z'+1 jr nc,l0b6e l0b3c: ld hl,l0135 ; Point to label ld b,8 ; Get length ld d,a ; Save character and UPPMASK ; Get upper case l0b44: ld (hl),a ; Or (hl),d on option U - Save label call l06f0 ; Get next character call l0ada ; Test valid alphanumeric label jr nc,l0b59 ; Nope inc hl djnz l0b44 ; Sample all dec hl l0b51: call l06f0 ; Get next character call l0ada ; Test valid alphanumeric label jr c,l0b51 ; Yeap, so skip remainder l0b59: push de set 7,(hl) ; Set end of label ld a,(l0135) ; ??? WHY ??? ld hl,l0e0c ; Point to table call l1007 ; Find procedure or function ld c,0 jr nc,l0b6a ; No match ld c,(hl) ; Fetch index l0b6a: pop af jp l0c0a l0b6e: cp '{' ; Test start of comment jr z,l0b7c ; Yeap jp nc,l0c2f cp 'a' jr nc,l0b3c jp l0c2f ; ; Found comment indicator { or (* ; l0b7c: call l06f0 ; Get next character cp '$' ; Test option requested jr nz,l0bde ; Nope ld de,(l0157) ; Get line pointer l0b87: call l5c88 ; Get standard option - disabled if compiling jr nc,l0bd2 ; Got one cp 'F' ; Test option F, include file jr nz,l0bd2 ld hl,(l01fd) ; Get current disk buffer ld (l01ff),hl ld hl,(l0159) ; Get line number ld (l015b),hl ld hl,0 ld (l0159),hl ; Clear line number ld hl,l01d5 ld (l01f9),hl ; Set source file inc hl call l0f01 ; Parse file ld b,a xor a ld (l01d5+_EX),a ld (l01d5+_CR),a ld a,c ld (l01d5),a ex de,hl call l0ece ; Open source file ex de,hl ld hl,l3ead ld (l01fb),hl ; Change disk buffer ld hl,l3f2d ld (l01fd),hl ; Init current disk buffer set 0,(ix+2) ; Set end of file allowed ld a,b cp ',' jr z,l0b87 l0bd2: ld (l0157),de ; Set line pointer call l0720 ; Process end of line jr l0bde l0bdb: call l06f0 ; Get next character l0bde: cp '}' ; Test end of comment jr z,l0bed cp '*' jr nz,l0bdb call l06f0 ; Get next character cp ')' jr nz,l0bde l0bed: call l06f0 ; Get next character jp l0b26 l0bf3: call l0b0e ; Test character a digit jr c,l0c6a ; Yeap cp ':' ; Test possible ':=' jr nz,l0c3a ; Nope call l06f0 ; Get next character ld c,':'+MSB cp '=' jr nz,l0c0a ld c,125 l0c07: call l06f0 ; Get next character l0c0a: ld (l013d),a ; Save last character ld a,c ; Get back index l0c0e: res 1,(ix+2) pop bc pop de pop hl ret l0c16: cp '''' ; Test string jp z,l0ca9 cp '#' ; Test hex indicator jr z,l0c82 cp '(' ; Test left parenthesis jr nz,l0c2f call l06f0 ; Get next character ld c,'('+MSB cp '*' ; Test comment (* jp z,l0b7c jr l0c0a l0c2f: add a,MSB ; Mark character for token ld c,a cp '.'+MSB jr nz,l0c07 ld a,' ' jr l0c0a l0c3a: jr c,l0c16 ; Must be control ld c,.EQ cp '=' jr z,l0c07 cp '<' jr nz,l0c59 call l06f0 ld c,.NEQ cp '>' jr z,l0c07 ld c,.LT cp '=' jr nz,l0c0a ld c,.LTE jr l0c07 l0c59: cp '>' jr nz,l0c2f call l06f0 cp '=' ld c,.GT jr nz,l0c0a ld c,.GTE jr l0c07 l0c6a: ld (l013e),sp call l0535 ld (l0143),hl ld (l0141),de l0c78: ld a,126 l0c7a: ld sp,(l013e) pop bc pop de pop hl ret ; ; Found hex indicator # ; l0c82: call l0aeb ; Get hex digit jr c,l0c9c ; Not hex ld l,a ld h,0 ld b,4 l0c8c: call l0aeb ; Get hex digit jr c,l0ca1 ; Not hex add hl,hl add hl,hl add hl,hl add hl,hl or l ld l,a djnz l0c8c call l06f0 l0c9c: ld e,51 call l09b7 ; Hex digit expected l0ca1: ld c,127 ld (l0143),hl jp l0c0a ; ; Found string indicator ' ; l0ca9: call l1067 ; Insert 'jp xxxx' ld (l0143),hl ld c,0 l0cb1: call l06f0 bit 7,(ix+0) jr nz,l0d01 cp '''' jr z,l0cc4 l0cbe: call l1081 ; Store byte inc c jr l0cb1 l0cc4: call l06f0 cp '''' jr z,l0cbe l0ccb: ld (l013d),a ; Save last character dec c jr nz,l0ce2 exx dec hl ld a,(hl) l0cd4: dec hl dec hl dec hl exx ld l,a ld h,0ffh ld (l0143),hl ld a,118 jr l0cfe l0ce2: inc c jr nz,l0cee ld e,33 call l09b7 ; Null strings not allowed: use CHR(0) xor a exx jr l0cd4 l0cee: ld a,c ld (l0141),a call l1076 ; Get current program counter ex de,hl ld hl,(l0143) call l10b5 ; Store word into previous address ld a,117 ; Return string l0cfe: jp l0c0e l0d01: ld e,68 call l09b7 ; Strings cannot have EOLNs jr l0ccb ; ; $I options - followed by bit attached in status byte ; l0d08: db 'L' db 00000001b db 'O' db 00000010b db 'C' db 00000100b db 'S' db 00001000b db 'I' db 00010000b db 'A' db 00100000b ; ; Internal symbol table - procedures and functions ; ; Label Token ; -------- ----- ; PROGRAM 1 ; DIV 2 ; CONST 3 ; PROCEDUR 4 ; FUNCTION 5 ; NOT 6 ; OR 7 ; AND 8 ; MOD 9 ; VAR 10 ; OF 11 ; TO 12 ; DOWNTO 13 ; THEN 14 ; UNTIL 15 ; END 16 ; DO 17 ; ELSE 18 ; REPEAT 19 ; CASE 20 ; WHILE 21 ; FOR 22 ; IF 23 ; BEGIN 24 ; WITH 25 ; GOTO 26 ; SET 27 ; ARRAY 28 ; FORWARD 29 ; RECORD 30 ; TYPE 31 ; IN 32 ; LABEL 33 ; NIL 34 ; FILE 35 ; PACKED 36 ; l0d14: dw 0 dc 'PACKED' db 36 l0d1d: dw l0d14 dc 'FILE' db 35 l0d24: dw l0d1d dc 'NIL' db 34 l0d2a: dw l0d24 dc 'FORWARD' db 29 l0d34: dw l0d2a dc 'PROGRAM' db 1 l0d3e: dw l0d34 dc 'IN' db 32 l0d43: dw l0d3e dc 'OR' db 7 l0d48: dw l0d43 dc 'OF' db 11 l0d4d: dw l0d48 dc 'TO' db 12 l0d52: dw l0d4d dc 'DO' db 17 l0d57: dw l0d52 dc 'IF' db 23 l0d5c: dw l0d57 dc 'SET' db 27 l0d62: dw l0d5c dc 'NOT' db 6 l0d68: dw l0d62 dc 'MOD' db 9 l0d6e: dw l0d68 dc 'DIV' db 2 l0d74: dw l0d6e dc 'VAR' db 10 l0d7a: dw l0d74 dc 'AND' db 8 l0d80: dw l0d7a dc 'FOR' db 22 l0d86: dw l0d80 dc 'END' db 16 l0d8c: dw l0d86 dc 'GOTO' db 26 l0d93: dw l0d8c dc 'WITH' db 25 l0d9a: dw l0d93 dc 'TYPE' db 31 l0da1: dw l0d9a dc 'CASE' db 20 l0da8: dw l0da1 dc 'ELSE' db 18 l0daf: dw l0da8 dc 'THEN' db 14 l0db6: dw l0daf dc 'LABEL' db 33 l0dbe: dw l0db6 dc 'CONST' db 3 l0dc6: dw l0dbe dc 'ARRAY' db 28 l0dce: dw l0dc6 dc 'UNTIL' db 15 l0dd6: dw l0dce dc 'WHILE' db 21 l0dde: dw l0dd6 dc 'BEGIN' db 24 l0de6: dw l0dde dc 'RECORD' db 30 l0def: dw l0de6 dc 'DOWNTO' db 13 l0df8: dw l0def dc 'REPEAT' db 19 l0e01: dw l0df8 dc 'FUNCTION' db 5 l0e0c: dw l0e01 dc 'PROCEDUR' db 4 ; l0e17:: db cr,lf,'End Address: ',null l0e27: db cr,lf,'Minimum D option value:',null l0e41: db 'Errors :',null l0e4a: db cr,lf,' *ERROR* ',null l0e57: db 'Write Error',null l0e63: db cr,lf,'No Source File: ',null l0e76: db cr,lf,'Error:No more text',null l0e8b: db cr,lf,'No EOF',null l0e94: db '.PAS',null ; ; Tell current compiling file ; l0e99:: push hl ld hl,l0ec1 call l03ed ld h,d ld l,e inc hl push bc ld b,8 call l0eb9 ld a,'.' call l038b ; Put character to device ld b,3 call l0eb9 call l0380 ; Give new line on device pop bc pop hl ret l0eb9: ld a,(hl) inc hl call l038b ; Put character to device djnz l0eb9 ret l0ec1: db cr,lf,'Compiling ',null ; ; Open source file ; l0ece: ld c,.open ld de,(l01f9) ; Get source file call l03cc ; Open file inc a ; Test success jr nz,l0e99 ; Yeap ld hl,l0e63 call l03ed ; Tell no source file ld a,(de) ; Get drive dec a ; Test defined jp m,l0eef ; Nope add a,'A' ; Make ASCII call l0394 ; Print drive ld a,':' call l0394 l0eef: ld b,8 ld hl,(l01f9) ; Get source file l0ef4: inc hl ld a,(hl) call l0394 ; Tell name djnz l0ef4 ld hl,l0e94 ; Give final .PAS jp l07e7 ; Then exit ; ; Parse file ; l0f01:: ld a,(de) inc de cp ' ' jr z,l0f01 call l0f32 ret z ld c,a ld a,(de) inc de cp ':' jr z,l0f1a ld (hl),c inc hl ld b,7 ld c,0 jr l0f22 l0f1a: ld b,8 ld a,0c0h add a,c ld c,a l0f20: ld a,(de) inc de l0f22: call l0f32 jr z,l0f2c ld (hl),a inc hl djnz l0f20 ret l0f2c: ld (hl),' ' inc hl djnz l0f2c ret l0f32: push hl push bc ld bc,l000d ld hl,l0f3f cpir pop bc pop hl ret ; l0f3f: db ' ,.<>;:=?*[]',cr ; ; Verify ??? type in BC ; l0f4c:: ld de,l0004 jr l0f54 ; ; Verify constant type in BC ; l0f51: ld de,l0001 ; ; Verify same type in DE and BC ; l0f54: ex de,hl or a sbc hl,bc ; Test same type add hl,bc ex de,hl ret z ; Yeap bit 7,b jr z,l0f6e bit 7,d jr z,l0f6e ld e,a ld a,b cp 80h ld a,e ret z ld a,d cp 80h ld a,e ret z l0f6e: ld e,10 jp l09b7 ; Wrong type combination ; ; Verify semicolon ; l0f73: cp ';'+MSB ; Verify semicolon ld e,2 jp z,l0b1a ; Get token call l09b7 ; Semi-colon or END expected before here jp l0b1a ; Get token ; ; Verify colon ; l0f80: call l0b1a ; Get token l0f83: toknum ':'+MSB,22 jr l0faa ; Colon expected ; ; Verify OF ; l0f88: call l0b1a ; Get token l0f8b: toknum 11,20 jr l0faa ; 'OF' expected ; ; Verify assignment ; l0f90: toknum 125,8 jr l0faa ; ':=' expected ; ; Verify squared bracket close ; l0f95: toknum ']'+MSB,35 jr l0faa ; ']' expected ; ; Verify comma ; l0f9a: toknum ','+MSB,21 jr l0faa ; Comma expected ; ; Verify left parenthesis ; l0f9f: call l0b1a ; Get token l0fa2: toknum '('+MSB,18 jr l0faa ; '(' expected ; ; Verify right parenthesis ; l0fa7: toknum ')'+MSB,9 ; ')' expected ; ; Verify correct token and get next one ; l0faa: cp d ; Verify it jp z,l0b1a ; Got it jp l09b7 ; Process error ; ; Put symbol into table - Admin length in reg DE ; l0fb1: push de ld hl,(l0155) ; Get top symbol pointer ld de,(l0153) ; Get current symbol pointer ld (l0153),hl ; Set new current symbol pointer ld bc,l3dec or a sbc hl,bc ; Test enough space in table add hl,bc jp nc,l07df ; Table full ld (hl),e ; Save pointer inc hl ld (hl),d inc hl or a ; Verify identifier jr nz,l0fe2 ; Nope, error ex de,hl ld hl,l0135 ; Point to symbol ld bc,0 l0fd4: ld a,(hl) ldi ; Unpack symbol or a jp p,l0fd4 ; Loop till MSB set l0fdb: pop hl add hl,de ; Calculate new top ld (l0155),hl ; Set new top symbol pointer ex de,hl ret l0fe2: ld e,4 call l09b7 ; Identifier expected ld (hl),MSB ; Indicate end inc hl ex de,hl jr l0fdb ; ; Get symbol from table ; l0fed: ld hl,(l0153) ; Get current symbol pointer call l1007 ; Find label jr nc,l0ffc ; No match ld a,(hl) ; Fetch type inc hl ld c,(hl) ; Fetch value inc hl ld b,(hl) inc hl ret l0ffc: ld e,3 xor a jp l09b7 ; Undeclared identifier ; ; Find label from table ^HL- C set says found ; l1002: ld a,b or c ; Test end of table ret z ; Yeap ld h,b ; Copy address ld l,c l1007: ld de,l0135 ; Point to label name ld c,(hl) ; Fetch address of previous entry inc hl ld b,(hl) inc hl l100e: ld a,(de) cp (hl) ; Compare jr nz,l1002 ; No match or a inc de inc hl jp p,l100e ; Still more to search for scf ; Set success ret ; ; ; l101a: ld hl,(l0151) l101d: ld a,h or l ld e,62 ccf jp z,l09b7 ; Undeclared label ld e,(hl) inc hl ld d,(hl) push de l1029: inc hl ld c,(hl) inc hl ld b,(hl) ex de,hl ld hl,(l0143) or a sbc hl,bc pop hl jr nz,l101d ex de,hl inc hl ld e,(hl) inc hl ld d,(hl) inc hl ld a,(l0160) cp (hl) ret z ld e,61 scf jp l09b7 ; Label at wrong level ; ; Insert code ^HL - preset by 'ld bc,00xx' ; l1048: push hl ld e,a call l0132 ; Give opcode db LD.BC ld a,(l0174) ; Get value inc a call l1081 ; Store byte call l0132 ; Followed by zero db 00h ld a,e jr l106b ; Then put code sequence ; ; Insert code ^HL - started with length - into location-2 ; l105c: push hl ; Save pointer exx ; Get back current PC dec hl ; Fix location dec hl jr l106c ; Insert code ; ; Insert code ^HL - started with length - into previous location ; l1062: push hl ; Save pointer exx ; Get back current PC dec hl ; Get previous location jr l106c ; Insert code ; ; Insert 'jp xxxx' ; l1067: ld hl,l10e7 ; Insert 'jp xxxx' ; ; Insert code ^HL - started with length - into current binary code ; l106a: push hl ; Save pointer l106b: exx ; Get back current PC l106c: ex (sp),hl ; Get back pointer ld c,(hl) ; Fetch length inc hl ld b,0 pop de ; Get current PC ldir ; Unpack code ex de,hl exx ; Get back new PC ; ; Get current program counter ; l1076: exx ; Get PC push hl ld bc,(l017c) add hl,bc ; Add offset ex (sp),hl exx pop hl ret ; ; Store byte into current PC ; l1081: exx ld (hl),a inc hl exx ret ; ; ; l1086: call l1081 ; Store byte jp l1076 ; Get current program counter ; ; Store immediate byte [Redirected call l0132] ; l108c: pop hl ; Get pointer to byte push af ; Save Accu ld a,(hl) ; Get byte inc hl call l1081 ; Store byte pop af push hl ; Save caller jp l1076 ; Get current program counter ; ; Store "ld de,val16" - val16 in reg HL ; l1098: ex de,hl ; ; Store "ld de,val16" - val16 in reg DE ; l1099: call l0132 ; Store opcode db LD.DE jr l10aa ; Store word ; ; Store "ld hl,(val16)" - val16 in reg DE ; l109f: call l0132 ; Store opcode db LD.HL@ jr l10aa ; Store word ; ; Store "ld hl,val16" - val16 in reg HL ; l10a5: ex de,hl ; ; Store "ld hl,val16" - val16 in reg DE ; l10a6: call l0132 ; Store opcode db LD.HL ; ; Store word in DE ; l10aa: push af ld a,e call l1081 ; Store lo byte ld a,d call l1086 ; Store hi byte pop af ret ; ; Store word into previous address ; l10b5: dec hl ; Get previous ; ; Store word into current address ; l10b6: push bc push hl call l10d5 ; Get current address ld (hl),d ; Store word dec hl ld (hl),e pop hl pop bc ret ; ; Store word into current address ; l10c1: push bc push hl call l10d5 ; Get current address ld (hl),e ; Store word inc hl ld (hl),d pop hl pop bc ret ; ; Store byte into current address ; l10cc: push bc push hl call l10d5 ; Get current address ld (hl),a ; Store byte pop hl pop bc ret ; ; Get current address from ^HL ; l10d5: ld bc,(l017e) ; Get base address add hl,bc ret ; ; ; l10db: exx dec hl exx dec hl call l0132 db LD.Bi ld e,c jp l156e ; ; ; l10e7: db 3 DB JP@ ; ; ; l10e9: push de ld de,(l0180) or a sbc hl,de add hl,de pop de ret nc push hl push de push bc push af ld bc,TPA or a sbc hl,bc call l0931 ld hl,(l018d+_RRN) push hl push de ld hl,l018d+_RRN ld (hl),b inc hl ld (hl),0 jr nc,l1111 ld (hl),1 l1111:: push bc ld de,l3f80 call l03ca ; Set disk buffer call l03bb ; Read random record from file pop bc ld b,0 ld hl,l3f80 add hl,bc pop de ld (hl),e ld a,c cp 7fh jr z,l1137 inc hl ld (hl),d l112b: call l03bf ; Write random record to file pop hl ld (l018d+_RRN),hl pop af pop bc pop de pop hl ret l1137: push de call l03bf ; Write random record to file ld hl,(l018d+_RRN) inc hl ld (l018d+_RRN),hl call l03bb ; Read random record from file pop de ld a,d ld (l3f80),a jr l112b l114c: cp ';'+MSB ; Test end of statement ret z or a ; Test identifier jr z,l1155 cp 36+1 ; Test standard keywords ret c ; Yeap l1155: call l0b1a ; Get token jr l114c l115a: call l0b1a ; Get token call l117a ; Get constant call l11e1 dec c jr z,l1171 inc c bit 6,h ret z push af ld a,80h xor h ld h,a pop af ret l1171: inc c ex de,hl ld hl,l0000 or a sbc hl,de ret ; ; Get constant ; l117a:: or a ; Test identifier jr z,l11a6 cp '+'+MSB ; Test unary sign jr z,l11db cp '-'+MSB jr z,l115a ld hl,(l0143) cp 117 ; Test string jr z,l11d3 ld bc,l0001 cp 127 ; Test hex constant jr z,l11d0 inc c ld de,(l0141) cp 126 ; Test identifier jr z,l11d0 inc c cp 118 ; Test character jr z,l11d0 ld e,13 jp l09b7 ; Constant expected l11a6: call l0fed ; Get symbol from table ld de,l1c9d or a sbc hl,de ; Test CHR add hl,de jr nz,l11c1 ; Nope call l0f9f ; Verify left parenthesis call l117a ; Get constant call l0fa7 ; Verify right parenthesis ld bc,l0003 ld h,0 ret l11c1: dec a ; Verify constant ld e,14 call nz,l09b7 ; Identifier is not a constant ld e,(hl) inc hl ld d,(hl) inc hl ld a,(hl) inc hl ld h,(hl) ld l,a ex de,hl l11d0: jp l0b1a ; Get token l11d3: ld a,(l0141) ld c,a ld b,2 jr l11d0 l11db: call l0b1a ; Get token call l117a ; Get constant l11e1: push af xor a cp b jr nz,l11ef ld a,c dec a jr z,l11ed dec a jr nz,l11ef l11ed: pop af ret l11ef: ld e,28 pop af jp l09b7 ; Type INTEGER or REAL expected ; ; ; l11f5: ld de,l0004 add hl,de ld e,(hl) inc hl ld d,(hl) inc hl ld b,(hl) xor a cp b ld a,(l0160) ret ; ; ; l1204: call l0132 ; Insert 'ld b,..' db LD.Bi call l1081 ; Store byte l120b: ld hl,l122f call l106a ; Insert 'jp l04b4' jr l1219 l1213: ld hl,l1233 call l106a ; Insert code l1219: call l10a6 ; Store "ld hl,val16" call l0132 ; Insert 'add hl,de' db AD.HLDE ret l1221: ld a,d or a l1223: inc a jr nz,l1229 ld a,e add a,a ret l1229: dec a ret nz ld a,e sub 7dh ret ; ; ; l122f: db 3 CALL L04B4 ; ; ; l1233: db 3 PUSH IX POP DE ; ; Insert keyboard check if requested ; l1237: bit 2,(ix+0) ; Test keyboard check during run time ret z ; Nope ld hl,l1242 jp l106a ; Insert 'call l032b' ; ; Code for keyboard check ; l1242: db 3 CALL L032B ; ; ; l1246: push af xor a cp b jr nz,l1250 ld a,c cp 2 jr nz,l1256 l1250: ld e,47 pop af jp l09b7 ; Scalar (not real) expected l1256: pop af ret ; ; Code for character = ; l1258: db 8 POP BC SUB B LD A,1 JR Z,L1260 XOR A L1260: PUSH AF ; ; Code for character <> ; l1261: db 7 POP BC SUB B JR Z,L1268 LD A,1 L1268: PUSH AF ; ; Code for character > ; l1269: db 6 POP BC SUB B LD A,0 RLA PUSH AF ; ; Code for character < ; l1270: db 7 LD B,A POP AF SUB B LD A,0 RLA PUSH AF ; ; Code for character >= ; l1278: db 8 LD B,A POP AF SUB B CCF LD A,0 RLA PUSH AF ; ; Code for character <= ; l1281: db 7 POP BC SUB B CCF LD A,0 RLA PUSH AF ; ; Code for integer = ; l1289: db 8 POP DE XOR A SBC HL,DE JR NZ,L1291 INC A L1291: PUSH AF ; ; Code for integer <> ; l1292: db 8 POP DE XOR A SBC HL,DE JR Z,L129A INC A L129A: PUSH AF ; ; Code for integer > ; l129b: db 9 POP DE OR A SBC HL,DE LD A,80H AND H RLCA PUSH AF ; ; Code for checked integer > ; l12a5: db 5 POP DE CALL L0A7F PUSH AF ; ; Code for integer < ; l12ab: db 10 EX DE,HL POP HL OR A SBC HL,DE LD A,80H AND H RLCA PUSH AF ; ; Code for checked integer < ; l12b6: db 6 EX DE,HL POP HL CALL L0A7F PUSH AF ; ; Code for integer >= ; l12bd: db 12 EX DE,HL POP HL OR A SBC HL,DE LD A,80H AND H RLCA XOR 1 PUSH AF ; ; Code for checked integer >= ; l12ca: db 6 EX DE,HL POP HL CALL L0A8A PUSH AF ; ; Code for integer <= ; l12d1: db 11 POP DE OR A SBC HL,DE LD A,80H AND H RLCA XOR 1 PUSH AF ; ; Code for checked integer <= ; l12dd: db 5 POP DE CALL L0A8A PUSH AF ; ; ; l12e3: db 7 POP DE LD A,(DE) SUB (HL) INC HL INC DE JR NZ,L12EB ; ; ; l12eb: db 8 DB 005H,010H,0F8H,03CH DB 018H,001H,0AFH,0F5H ; ; ; l12f4: db 8 DB 004H,010H,0F8H,018H DB 002H,03EH,001H,0F5H ; ; ; l12fd: db 11 DB 004H,010H,0F8H,018H DB 005H,03EH,000H,038H DB 001H,03CH,0F5H ; ; ; l1309: db 11 DB 004H,010H,0F8H,018H DB 005H,03EH,000H,030H DB 001H,03CH,0F5H ; ; ; l1315: db 11 DB 004H,010H,0F8H,018H DB 004H,03EH,000H,038H DB 001H,03CH,0F5H ; ; ; l1321: db 11 DB 004H,010H,0F8H,018H DB 004H,03EH,000H,030H DB 001H,03CH,0F5H ; ; Code for real = ; l132d: db 15 EX DE,HL POP BC XOR A SBC HL,BC POP BC JR NZ,L133C EX DE,HL SBC HL,BC JR NZ,L133C INC A L133C: PUSH AF ; ; Code for real <> ; l133d: db 15 EX DE,HL POP BC XOR A SBC HL,BC POP BC JR NZ,L134B EX DE,HL SBC HL,BC JR Z,L134C L134B: INC A L134C: PUSH AF ; ; Code for real < ; l134d: db 12 LD A,80H XOR H LD H,A CALL L0BB2 LD A,80H AND H RLCA PUSH AF ; ; Code for real > ; l135a: db 20 POP BC EX (SP),HL BIT 6,H JR Z,L1365 LD A,80H XOR H LD H,A L1365: EX (SP),HL PUSH BC CALL L0BB2 LD A,80H AND H RLCA PUSH AF ; ; Code for real <= ; l136f: db 22 POP BC EX (SP),HL BIT 6,H JR Z,L137A LD A,80H XOR H LD H,A L137A: EX (SP),HL PUSH BC CALL L0BB2 LD A,80H AND H RLCA XOR 1 PUSH AF ; ; Code for real >= ; l1386: db 14 LD A,80H XOR H LD H,A CALL L0BB2 LD A,80H AND H RLCA XOR 1 PUSH AF ; ; Code for set = ; l1395: db 10 LD HL,SL0A6A LD (SL0A5C+1),HL CALL SL0A50 PUSH AF ; ; Code for set <> ; l13a0: db 12 LD HL,SL0A6A LD (SL0A5C+1),HL CALL SL0A50 XOR .TRUE PUSH AF ; ; Code for set <= ; l13ad: db 10 LD HL,SL0A73 LD (SL0A5C+1),HL CALL SL0A50 PUSH AF ; ; Code for set >= ; l13b8: db 10 LD HL,SL0A78 LD (SL0A5C+1),HL CALL SL0A50 PUSH AF ; ; Comparision tables ; ; Integer ; l13c3: dw l1292 ; <> dw l1289 ; = dw l129b ; > dw l12ab ; < dw l12bd ; >= dw l12d1 ; <= ; ; Integer with overflow check ; l13cf: dw l1292 dw l1289 dw l12a5 dw l12b6 dw l12ca dw l12dd ; ; Character ; l13db: dw l1261 dw l1258 dw l1269 dw l1270 dw l1278 dw l1281 ; ; ; l13e7: dw l12f4 dw l12eb dw l12fd dw l1309 dw l1315 dw l1321 ; ; Real ; l13f3: dw l133d dw l132d dw l135a dw l134d dw l1386 dw l136f ; ; Set ; l13ff: dw l13a0 dw l1395 dw 0 dw 0 dw l13b8 dw l13ad ; ; Get boolean expression ; ; Insert 'or a;jp z,..' ; l140b: call l0b1a ; Get token call l44f4 ; Test IN or relations call l0f4c ; Verify ??? type ld hl,l141d call l1062 ; Insert code dec hl dec hl ret ; ; Code for jump on zero ; l141d: db 4 OR A DB JP.Z@ ; ; Process hex constant ; l1420: call l101a jp c,l0b1a ; Get token push hl call l1076 ; Get current program counter ex de,hl inc hl call l10e9 call nc,l10c1 ; Store word into current address pop hl dec hl ld (hl),d dec hl ld (hl),e call l0f80 ; Verify colon jr l146f ; Process statements ; ; Statement table ; l143c: dw l404b ; 19 : REPEAT dw l1709 ; 20 : CASE dw l4000 ; 21 : WHILE dw l182d ; 22 : FOR dw l4021 ; 23 : IF dw l4068 ; 24 : BEGIN dw l407e ; 25 : WITH dw l40ee ; 26 : GOTO ; ; ; l144c: cp 127 ; Test hex constant jr z,l1420 cp @REPEAT ; Test range ret c cp @GOTO+1 ret nc add a,a ld l,a ld h,0 ld de,l143c-2*@REPEAT add hl,de ; Position in table ld e,(hl) ; Get address inc hl ld d,(hl) ex de,hl jp (hl) ; Execute ; ; Process 'DO' ; l1463: push bc ret l1465: ex af,af' toktst @DO,16 ; 'DO' expected call l1237 ; Insert keyboard check if requested ; ; Process statements ; l146f: res 0,(ix+1) or a ; Test identifier ld hl,l0172 ld (hl),0 jp nz,l144c ; Nope, process statement or hex constant call l0fed ; Get symbol from table cp 4 jp z,l162c cp 6 jr z,l1463 cp 8 jp z,l48c2 cp 5 jp z,l15ef exx push hl exx ld e,7 call l565e ; This identifier can't begin a statement exx ld d,h ld e,l ex (sp),hl push af ex de,hl or a sbc hl,de ld bc,l000b or a sbc hl,bc ; Test length of code ?????? jr nz,l14f0 ex de,hl ld a,(hl) ; Get opcode ?????? cp LD.HL ; Test 'ld hl,...' jr nz,l14f0 inc hl ld c,(hl) ; Get value inc hl ld b,(hl) inc hl ld a,(hl) cp PUSH.HL ; Test 'push hl' jr nz,l14f0 inc hl ld a,(hl) cp LD.HL ; Test 2nd 'ld hl,...' jr nz,l14f0 inc hl ld e,(hl) ; Get this value, too inc hl ld d,(hl) ex de,hl add hl,hl add hl,bc ex de,hl inc hl ld a,(hl) cp AD.HLHL ; Test 'add hl,hl' follows jr nz,l14f0 inc hl ld a,(hl) cp POP.DE ; Test 'pop de' jr nz,l14f0 inc hl ld a,(hl) cp AD.HLDE ; Test 'add hl,de' jr nz,l14f0 inc hl ld a,(hl) cp PUSH.HL ; Test 'push hl' jr nz,l14f0 ld bc,lfff6 pop af add hl,bc pop bc push de exx pop hl l14ea: ld d,1 ld b,0 jr l14f3 l14f0: pop af pop hl exx l14f3: push hl push de dec b jr nz,l14fe ld hl,l4ca2 call l1062 ; Insert code "ld (l0132),hl" l14fe: inc b call l0f90 ; Verify assignment call l44de pop hl pop de dec b jp z,l1592 inc b jp nz,l15c5 l150f: dec h jp m,l157b exx dec hl exx jr nz,l1536 dec c jr z,l152f dec c jp nz,l181b exx dec hl exx call l0132 ; Insert 'ld (...),de' db HIGH LD.@DE call l0132 db LOW LD.@DE call l10aa ; Store word inc de inc de l152f: call l0132 ; Insert 'ld (...),hl' db LD.@HL jp l10aa l1536: dec c jr z,l1558 dec c jr nz,l1558 exx dec hl exx call l0132 ; Insert 'ld (ix+..),e' db HIGH LD.IX_E call l0132 db LOW LD.IX_E call l156e inc e call l0132 ; Insert 'ld (ix+..),d' db HIGH LD.IX_D call l0132 db LOW LD.IX_D call l156e inc e cp a l1558: call l0132 ; Insert 'ld (ix+..),l' db HIGH LD.IX_L jr nz,l1575 call l0132 db LOW LD.IX_L call l156e call l0132 ; Insert 'ld (ix+..),h' db HIGH LD.IX_H inc e call l0132 db LOW LD.IX_H l156e: push af ld a,e call l1086 l1573: pop af ret l1575: call l0132 db LD.HL.A ; Insert 'ld (hl),a' jr l156e l157b: dec c jr z,l1586 dec c jr z,l158c ld hl,l1608 jr l1589 l1586: ld hl,l160b l1589: jp l1062 ; Insert code l158c: ld hl,l1615 jp l105c ; Insert code l1592: ld hl,l1620 jp l1048 ; Insert code ; ; RECAST ; l1598: call l0f9f ; Verify left parenthesis call l44f4 ; Test IN or relations call l4b1d jp l4af8 ; ; POKE ; l15a4: call l0f9f ; Verify left parenthesis call l44c5 call l0f9a ; Verify comma call l44f4 ; Test IN or relations call l0fa7 ; Verify right parenthesis l15b3: dec b jr z,l15e1 dec b jr nz,l15bf ld (l0170),bc jr l15c5 l15bf: inc b inc b ld h,0 jr z,l157b l15c5: bit 6,b jr nz,l15e6 bit 7,b jr nz,l15ea exx dec hl exx call l0132 ; Insert 'ld bc,...' db LD.BC ld de,(l0170) call l10aa ; Store word ld hl,l1611 jp l106a ; Insert code l15e1: ld e,52 ; Cannot POKE sets l15e3: jp l09b7 ; Process error l15e6: ld e,63 ; Cannot assign or POKE files jr l15e3 l15ea: ld c,1 jp l150f ; ; ; l15ef: push bc inc hl inc hl ld b,(hl) inc b inc hl inc hl inc hl ld e,(hl) inc hl ld d,(hl) ld a,(l0160) call l5790 ex (sp),hl ld c,(hl) inc hl ld b,(hl) pop hl jp l14f3 ; ; ; l1608: db 2 POP HL LD (HL),A ; ; ; l160b: db 5 EX DE,HL POP HL LD (HL),E INC HL LD (HL),D ; ; ; l1611: db 3 POP DE LDIR ; ; ; l1615: db 10 LD B,H LD C,L POP HL LD (HL),E INC HL LD (HL),D INC HL LD (HL),C INC HL LD (HL),B ; ; ; l1620: db 11 LD DE,(L0132) LD HL,0 ADD HL,SP LDIR LD SP,HL ; ; ; l162c: push hl push bc ld de,l0004 add hl,de ld b,(hl) call l0b1a ; Get token dec b inc b jp z,l169d call l0fa2 ; Verify left parenthesis ld de,l0005 add hl,de l1642: call l5470 push bc ld e,a dec hl ld a,(hl) inc hl ld c,(hl) inc hl ld b,(hl) push hl cp 2 ld a,e jr z,l165f ld e,24 push bc call l5829 ; Variable expected as parameter pop de call l0f54 ; Verify same type jr l1680 l165f: call l44de bit 7,b jr nz,l1680 dec b jr z,l1680 inc b jr z,l168e ; ; Put SET to stack ; exx dec hl exx call l0132 ; Insert 'ld bc,...' db LD.BC ld de,(l0170) ; Get length of SET call l10aa ; Store word ld hl,l16cb call l106a ; Insert code l1680: pop hl pop bc dec b jr z,l169a call l0f9a ; Verify comma ld de,l000a add hl,de jr l1642 l168e: dec c jr z,l1680 dec c jr z,l1680 call l0132 ; Insert 'inc sp' db INC.SP jr l1680 l169a: call l0fa7 ; Verify right parenthesis l169d: res 3,(ix+2) pop hl ld c,(hl) inc hl ld b,(hl) pop hl push af ld e,(hl) inc hl ld d,(hl) inc hl ld a,(hl) ld hl,l0160 sub (hl) jp p,l16c6 neg call l0132 ; Insert 'ld b,...' db LD.Bi call l1081 ; Store byte ld hl,l16d7 l16bf: call l106a ; Insert code pop af jp l10aa ; Store word l16c6:: ld hl,l16dd jr l16bf ; ; Code for moving a SET to stack ; l16cb: db 11 EX DE,HL XOR A LD L,A LD H,A SBC HL,BC ADD HL,SP LD SP,HL EX DE,HL LDIR ; ; ; l16d7: db 5 CALL L04B4 PUSH DE DB CAL ; ; ; l16dd: db 3 PUSH IX DB CAL ; ; Process CASE for character case ; l16e1: call l117a ; Get constant push hl ld hl,l0165 ld e,(hl) ld d,0 call l0f54 ; Verify same type pop de call l0132 ; Insert 'cp ..' db CP.i call l156e ld hl,l17ce call l106a ; Insert 'jp z,...' cp ':'+MSB jr z,l1705 call l0f9a ; Verify comma jr l16e1 l1705: ld a,-5 jr l1744 ; ; Statement CASE ; l1709: ld bc,lffff push bc call l0b1a ; Get token call l44f4 ; Test IN or relations exx dec hl exx call l1076 ; Get current program counter dec hl push hl toktst 11,20 ; 'OF' expected ld b,a ld a,c ld (l0165),a l1726: dec a ; Test character ld a,b jr nz,l16e1 ; Yeap l172a: call l117a ; Get constant call l0f51 ; Verify constant type call l1098 ; Store "ld de,val16" ld hl,l17c8 call l106a ; Insert code cp ':'+MSB ; Test more jr z,l1742 ; Nope call l0f9a ; Verify comma jr l172a l1742: ld a,-10 l1744: ld d,h ld e,l dec hl l1747: ld b,-1 ld c,a add hl,bc pop bc push bc or a sbc hl,bc add hl,bc jr z,l1758 call l10b6 ; Store word into current address jr l1747 l1758: pop bc dec de push de ld hl,l0165 ld b,(hl) push bc call l0b1a ; Get token call l146f ; Process statements pop bc ld hl,l0165 ld (hl),b call l1067 ; Insert 'jp xxxx' dec hl pop de pop bc push hl inc b push bc push hl ex de,hl inc de call l10b6 ; Store word into current address dec hl dec hl push af ld a,JP.NZ@ call l10cc ; Store 'jp nz,..' into current address pop af cp @ELSE ; Test ELSE jr z,l17b5 cp @END ; Test END jr z,l1795 call l0f73 ; Verify semicolon ld b,a ld a,(l0165) jp l1726 l1795: inc hl dec de dec de dec de call l10c1 ; Store word into current address pop de pop bc pop hl exx dec hl dec hl dec hl exx call l0b1a ; Get token l17a7: call l1076 ; Get current program counter ex de,hl dec b inc b ret z l17ae: pop hl call l10b6 ; Store word into current address djnz l17ae ret l17b5: pop de pop bc inc b pop hl call l1076 ; Get current program counter dec hl push hl push bc call l0b1a ; Get token call l146f ; Process statements pop bc jr l17a7 ; ; Code for checking CASE item ; l17c8: db 7 OR A SBC HL,DE ADD HL,DE DB JP.Z@ ; ; Code for jp z,... ; l17ce: db 3 DB JP.Z@ ; ; ; l17d0: call l1081 ; Store byte inc c ; ; ; l17d4: push af call l17da pop af ret ; ; ; l17da: ld hl,(l0163) call l11f5 jr z,l1817 sub b jr z,l17fd dec c jr z,l17f0 call l1204 l17eb: call l0132 ; Insert 'ld (hl),a' db LD.HL.A ret l17f0: call l0132 ; Insert 'push hl' db PUSH.HL call l1204 l17f7: ld hl,l1822 jp l106a ; Insert code l17fd: call l1221 jr nc,l1806 dec c jp l1558 l1806: dec c jr z,l180e call l1213 jr l17eb l180e: call l0132 ; Insert 'push hl' db PUSH.HL call l1213 jr l17f7 l1817: dec c jp z,l152f l181b: call l0132 ; Insert 'ld (..),a' db LD.@A jp l10aa ; Store word ; ; ; l1822: db 5 POP DE LD (HL),E INC HL LD (HL),D EX DE,HL ; ; ; l1828: db 4 LD E,(HL) INC HL LD D,(HL) EX DE,HL ; ; Statement FOR ; l182d: call l09b0 ; Verify identifier call l0fed ; Get symbol from table cp 2 ld e,7 call nz,l09b7 ; This identifier can't begin a statement ld a,c ld (l0165),a ld (l0163),hl call l0b1a ; Get token call l0f90 ; Verify assignment call l44c8 exx ld (l0170),hl ; Save PC exx call l17d4 cp @DOWNTO ; Verify DOWNTO jr z,l185d cp @TO ; Or TO ld e,17 call nz,l09b7 ; 'TO' or 'DOWNTO' expected l185d: push af call l0b1a ; Get token ld hl,(l0165) ld h,0 exx push hl exx call l44d8 ex af,af' ld a,c dec a exx pop bc exx jr nz,l18b4 add a,'!' call l4784 exx inc hl cp (hl) jr nz,l189d sbc hl,bc add hl,bc jr nz,l189d ld de,(l0170) sbc hl,de ld b,h ld c,l ld h,d ld l,e dec de ldir dec hl exx pop af push hl set 2,(ix+1) call l1067 ; Insert 'jp xxxx' jr l18ac l189d: inc hl inc hl inc hl exx res 2,(ix+1) ld hl,l19b6 call l106a ; Insert code pop af l18ac: dec hl push hl push af ld hl,(l0163) jr l18e7 l18b4: pop af cp @TO ; Test TO jr nz,l18c1 ld hl,l19b9 ld de,l19bd jr l18c7 l18c1: ld hl,l19c2 ld de,l19c7 l18c7: call l1062 ; Insert code push hl ex de,hl call l106a ; Insert code push hl call l0132 ; Insert 'push bc' db PUSH.BC push af ld hl,(l0163) push hl ld a,(l0165) push af call l1465 ; Process DO ex af,af' pop af ld c,a pop hl ld (l0163),hl l18e7: call l11f5 jr z,l193f sub b jr z,l1910 call l1204 l18f2: dec c jr z,l1950 call l0132 ; Insert 'ld (hl),a' db LD.HL.A l18f9: pop af add a,'0' call l17d0 ld hl,l19cb call l106a ; Insert code pop de call l10b5 ; Store word into previous address inc hl ex de,hl pop hl ex af,af' jp l10c1 ; Store word into current address l1910: call l1221 jr nc,l193a call l0132 ; Insert 'ld l,(ix+..)' db HIGH LD.L_IX dec c jr nz,l1931 call l0132 db LOW LD.L_IX call l156e inc e call l0132 ; Insert 'ld h,(ix+..)' db HIGH LD.H_IX call l0132 db LOW LD.H_IX call l156e jr l1956 l1931: call l0132 ; Insert 'ld a,(hl)' db LD.A.HL call l156e jr l18f9 l193a: call l1213 jr l18f2 l193f: dec c jr z,l194b call l0132 db LD.A@ ; Insert 'ld a,(..)' call l10aa ; Store word jr l18f9 l194b: call l109f ; Store "ld hl,(val16)" jr l1956 l1950: ld hl,l1828 call l106a ; Insert code l1956: pop af rlca rlca rlca sub '=' call l17d0 call l1076 ; Get current program counter ex de,hl pop hl push hl call l10b6 ; Store word into current address bit 2,(ix+1) jr nz,l19a9 call l0132 ; Insert 'pop de' db POP.DE call l0132 push de l1976: cp '+' jr z,l197e call l0132 ; Insert 'ex de,hl' db EX.DEHL l197e: ld hl,l19b1 call l106a ; Insert code dec hl push hl ld h,(ix+1) push hl call l1465 ; Process DO pop hl ld (ix+1),h call l1067 ; Insert 'jp xxxx' ex de,hl pop hl call l10b6 ; Store word into current address ex de,hl pop de inc de call l10b5 ; Store word into previous address bit 2,(ix+1) ret nz call l0132 ; Insert 'pop de' db POP.DE ret l19a9: pop bc pop de call l1099 ; Store "ld de,val16" push bc jr l1976 ; ; ; l19b1: db 6 OR A SBC HL,DE DB JP.M@ ; ; ; l19b6: db 4 EX (SP),HL DB JP@ ; ; ; l19b9: db 3 POP BC CP B DB JP.C@ ; ; ; l19bd: db 4 NOP NOP INC A LD B,A ; ; ; l19c2: db 4 LD B,A POP AF CP B DB JP.C@ ; ; ; l19c7: db 3 NOP NOP DEC B ; ; ; l19cb: db 5 POP BC CP B DB JP.NZ@ ; ; Standard keywords ; l19cf: dw 0 dc 'FRAC' db 11 dw l121d l19d8:: dw l19cf dc 'RANDOM' db 7 dw l5a14 l19e3:: dw l19d8 dc 'RANSEED' db 8 db 0,0 dw l5a08 dw l5a08 db 4 l19f4:: dw l19e3 dc 'EXP' db 11 dw l12db l19fc:: dw l19f4 dc 'LN' db 11 dw l1389 l1a03:: dw l19fc dc 'ARCTAN' db 11 dw l1583 l1a0e: dw l1a03 dc 'TAN' db 11 dw l1654 l1a16: dw l1a0e dc 'COS' db 11 dw l1410 l1a1e: dw l1a16 dc 'SIN' db 11 dw l142e ; ; End of standard list ; l1a26: dw 0 ; Changed to "l1a1e" on option 'T' dc 'CPM' db 9 db 1,0 dw l5a2a dw l5a2a db 3 l1a33: dw l1a26 dc 'INP' db 9 db 3,0 dw l59c5 dw l59c5 db 2 l1a40: dw l1a33 dc 'OUT' db 6 dw l59a9 l1a48: dw l1a40 dc 'ADDR' db 7 dw l5998 l1a51: dw l1a48 dc 'SIZE' db 7 dw l597a l1a5a: dw l1a51 dc 'INLINE' db 6 dw l495c l1a65: dw l1a5a dc 'ENTIER' db 12 dw l0dab l1a70: dw l1a65 dc 'READLF' db 8 db 0,0 dw l59dc dw l59dc db 1 l1a80: dw l1a70 dc 'PROFF' db 8 db 0,0 dw l59d0 dw l59d0 db 1 l1a8f: dw l1a80 dc 'PRON' db 8 db 0,0 dw l59d6 dw l59d6 db 1 l1a9d: dw l1a8f dc 'USER' db 8 db 0,0 dw l59e6 dw l59e6 db 2 l1aab: dw l1a9d dc 'INCH' db 9 db 3,0 dw l59cb dw l59cb db 1 l1ab9: dw l1aab dc 'RB' db 2 db 3,0,0,0,0ffh,0,'0',2,0 l1ac7: dw l1ab9 dc 'RF' db 2 db 3,0,0,0,0ffh,0,'-',2,0 l1ad5: dw l1ac7 dc 'RA' db 2 db 3,0,0,0,0ffh,0,'.',2,0 l1ae3: dw l1ad5 dc 'RC' db 2 db 3,0,0,0,0ffh,0,'/',2,0 l1af1: dw l1ae3 dc 'RD' db 2 db 3,0,0,0,0ffh,0,'2',2,0 l1aff: dw l1af1 dc 'RE' db 2 db 3,0,0,0,0ffh,0,'1',2,0 l1b0d: dw l1aff dc 'RH' db 2 db 3,0,0,0,0ffh,0,'4',2,0 l1b1b: dw l1b0d dc 'RL' db 2 db 3,0,0,0,0ffh,0,'3',2,0 l1b29: dw l1b1b dc 'RAF' db 2 db 1,0,1,80h,0ffh,7fh,'-',2,0 l1b38: dw l1b29 dc 'RBC' db 2 db 1,0,1,80h,0ffh,7fh,'/',2,0 l1b47: dw l1b38 dc 'RDE' db 2 db 1,0,1,80h,0ffh,7fh,'1',2,0 l1b56: dw l1b47 dc 'RHL' db 2 db 1,0,1,80h,0ffh,7fh,'3',2,0 l1b65: dw l1b56 dc 'RIY' db 2 db 1,0,1,80h,0ffh,7fh,'5',2,0 l1b74: dw l1b65 dc 'USERF' db 8 db 0,0 dw l5a35 dw l5a35 db 2 l1b83: dw l1b74 dc 'HALT' db 8 db 0,0 dw l5a4c dw l5a4c db 1 l1b91: dw l1b83 dc 'SQRT' db 11 dw l1097 l1b9a: dw l1b91 dc 'PAGE' db 6 dw l43dc l1ba3: dw l1b9a dc 'ROUND' db 12 dw l0da0 l1bad: dw l1ba3 dc 'TRUNC' db 12 dw l0d7a l1bb7: dw l1bad dc 'MAXINT' db 1 db 1,0,0ffh,7fh l1bc4: dw l1bb7 dc 'SUCC' db 7 dw l493e l1bcd: dw l1bc4 dc 'PRED' db 7 dw l492d l1bd6: dw l1bcd dc 'ORD' db 7 dw l491e l1bde: dw l1bd6 dc 'RECAST' db 7 dw l1598 l1be9: dw l1bde dc 'PEEK' db 7 dw l4b2c l1bf2: dw l1be9 dc 'POKE' db 6 dw l15a4 l1bfb: dw l1bf2 dc 'MEMAVAIL' db 7 dw l5881 l1c08: dw l1bfb dc 'RELEASE' db 6 dw l589b l1c14: dw l1c08 dc 'MARK' db 6 dw l5896 l1c1d: dw l1c14 dc 'DISPOSE' db 6 dw l58be l1c29: dw l1c1d dc 'NEW' db 6 dw l58c3 l1c31: dw l1c29 dc 'REWRITE' db 6 dw l443b l1c3d: dw l1c31 dc 'RESET' db 6 dw l4443 l1c47: dw l1c3d dc 'CHAIN' db 6 dw l4429 l1c51: dw l1c47 dc 'EOLN' db 7 dw l43e4 l1c5a: dw l1c51 dc 'EOF' db 7 dw l4409 l1c62: dw l1c5a dc 'OUTPUT' db 2 db 3,'@',0,0ffh,0ffh,0ffh,9ch,1,0 l1c74: dw l1c62 dc 'INPUT' db 2 db 3,'@',0,0ffh,0ffh,0ffh,'C',1,0 l1c85: dw l1c74 dc 'GET' db 6 dw l43c0 l1c8d: dw l1c85 dc 'PUT' db 6 dw l43b8 l1c95: dw l1c8d dc 'CHR' db 9 db 3,0 l1c9d: db 'PZPZ',2 l1ca2: dw l1c95 dc 'ODD' db 9 db 4,0 dw l5a03 dw l5a03 db 2 l1caf: dw l1ca2 dc 'ABS' db 13 dw l5a5a dw l5a65 l1cb9: dw l1caf dc 'SQR' db 13 dw l5a53 dw l5a5f l1cc3: dw l1cb9 dc 'TEXT' db 3 db 3,40h,0,0ffh,0ffh,0ffh,0a9h,0 l1cd2: dw l1cc3 dc 'FALSE' db 1 db 4,0,0,1 l1cde: dw l1cd2 dc 'TRUE' db 1 db 4,0,1,1 l1ce9: dw l1cde dc 'BOOLEAN' db 3 db 4,0,0,1,1,1,1,0 l1cfb: dw l1ce9 dc 'CHAR' db 3 db 3,0,0,0ffh,0ffh,0ffh,1,0 l1d0a: dw l1cfb dc 'REAL' db 3 db 2,0,0,0,0,0,4,0 l1d19: dw l1d0a dc 'INTEGER' db 3 db 1,0,1,80h,0ffh,7fh,2,0 l1d2b: dw l1d19 dc 'READLN' db 6 dw l4343 l1d36: dw l1d2b dc 'READ' db 6 dw l437c l1d3f: dw l1d36 dc 'WRITELN' db 6 dw l4191 l1d4b: dw l1d3f dc 'WRITE' db 6 dw l4143 l1d55:: .phase 0100h ; ; Part I : Base computing ; l0100: jp $-$ l0103: jp l0308 ; ; 15 Bytes header ; s0106: db -1 ; End flag ; ds 14 ; ; End of header ; l0115: ds 2 sl0117: ds 2 ; Caller's PC l0119: ds 2 l011b: ds 2 l011d: ds 2 ; Length of dynamic item l011f: ds 2 ; Current heap l0121: ds 2 ; Heap pointer nop nop l0125: nop nop nop nop nop nop nop nop nop nop nop nop l0131: nop l0132: nop l0133: ds 2 ; Real, part 1 l0135: ds 2 ; Real, part 2 l0137: ds 2 ; FLP 2.1 l0139: ds 2 ; FLP 2.2 l013b: ds 2 ; FLP 1.1 l013d: ds 2 ; FLP 1.2 l013f: dw 0 dw 0 ; ; Console input FIB ; l0143: dw l014c ; Pointer to current character l0145: dw l014d ; Pointer to end character l0147: db 1 db 0 ; End of file flag l0149: db -1 db 50h ; Max console length db 0 ; Current character l014c: db cr l014d: db eof ds 50h-2 ; ; Console output FIB ; l019c: dw l01a3 dw 0 db -1 db 1 db -1 l01a3: db 0 ; Character buffer l01a4: jp l01ea ; Do XBIOS call l01a7: jp l0554 ; Get character from console l01aa: jp l089d ; Put character to console ; ; Initialize XBIOS entry ; l01ad: ld hl,(l0001) ld de,l0058 add hl,de ; Point to address of XBIOS entry ld e,(hl) ; Fetch address inc hl ld d,(hl) ld (l01a4+1),de ; Store it ret ; ; Test character available - C set says yes ; sl01bc: ld c,.condir push de ld e,_get call sl01cb ; Test character available pop de or a ret z ; Nope scf ; Indicate it ret ; ; Read character from keyboard ; sl01c9: ld c,.conin ; ; Do OS call ; sl01cb: push de push hl push ix push iy call BDOS ; Call it pop iy pop ix pop hl pop de ret ; ; Set default DMA ; sl01db: push de ld de,l0080 jr sl01e2 ; ; Set DMA ^DE ; sl01e1: push de sl01e2: push bc ld c,.setdma call sl01cb pop bc pop de l01ea: ret ; ; Give new line on device ; l01eb: ld a,cr call l01aa ld a,lf call l01aa ret ; ; Put character to console ; l01f6:: push af push de ld e,a push bc ld c,.conout call sl01cb pop bc pop de pop af ret ; ; Process USER ; l0203: ld hl,(l022d) push hl pop af ld hl,(l0233) ld de,(l0231) ld bc,(l022f) ld iy,(l0235) ret ; ; End of USER call ; l0218: ld (l0233),hl push af pop hl ld (l022d),hl ld (l0231),de ld (l022f),bc ld (l0235),iy ret ; l022d: ds 2 ; AF l022f: ds 2 ; BC l0231: ds 2 ; DE l0233: ds 2 ; HL l0235: ds 2 ; IY ; ; Get caller and execute it ; l0237: pop hl ; Get it jp (hl) ; Jump to it ; ; Test character a digit - C set if so ; l0239: cp '0' ; Test it ccf ret nc cp '9'+1 ret ; ; Print integer ; sl0240: push hl push bc ld b,5 ; Set max length bit 7,h ; Test < 0 jr z,l0250 ; Nope ex de,hl ld hl,0 or a sbc hl,de ; Negate it inc b ; Remember sign l0250: ld iy,l02b2 ; Init table pointer l0254: ld e,(iy+0) ; Get divisor ld d,(iy+1) or a sbc hl,de jr nc,l0267 add hl,de inc iy inc iy djnz l0254 inc b l0267: ld c,b ld b,0 pop hl or a sbc hl,bc jr c,l0276 ld b,l inc b dec b call nz,l02c1 l0276: pop hl l0277: bit 7,h jr z,l0287 ld a,'-' call l01aa or a ex de,hl ld hl,0 sbc hl,de l0287: ld iy,l02b2 ld bc,l0530 l028e: ld a,'0' ld e,(iy+0) ld d,(iy+1) l0296: or a sbc hl,de jr c,l029e inc a jr l0296 l029e: add hl,de cp c jr z,l02a6 call l01aa dec c l02a6: inc iy inc iy djnz l028e cp c ret nz call l01aa ret ; l02b2: dw 10000 dw 1000 dw 100 dw 10 dw 1 ; ; Print blanks ; sl02bc: sub l ; Test against requested count ret nc neg ; Make > 0 ; ; Print ACCU blanks ; sl02c0: ld b,a ; Unpack ; ; Print B blanks ; l02c1: ld a,' ' l02c3: call l01aa ; Just do it djnz l02c3 ret ; ; Print string ^HL with length in reg B ; sl02c9: ld a,(hl) ; Get character inc hl call l01aa ; Print it djnz sl02c9 ret ; ; Print TRUE or FALSE ; l02d1: or a ; Test boolean jr nz,l02d9 ; Get TRUE ld hl,l02e5 ; Get FALSE jr l02dc l02d9: ld hl,l02eb l02dc: ld a,(hl) or a ret z call l01aa ; Print it inc hl jr l02dc ; l02e5: db 'FALSE',null l02eb: db 'TRUE',null ; ; Out of memory ; sl02f0: ld de,sl0445 jr l0305 l02f5: pop bc l02f6: ld de,l04a4 ; Number expected jr l0305 l02fb: pop bc pop bc l02fd: ld de,l0493 ; Number too large jr l0305 l0302: ld de,l043c ; Tell overflow l0305: jp l0103 ; ; ; l0308: ld hl,l019c ld (l0125),hl ; Set console output ex de,hl call l02dc ; Print string ld hl,l0434 jr l0341 ; Tell PC ; ; Tell division by zero ; l0317: ld de,l0450 jr l0305 ; ; Index too low ; l031c: ld de,l045a jr l0305 ; ; Index too high ; l0321: ld de,l0468 jr l0305 ; ; Maths call error ; l0326: ld de,l0477 jr l0305 ; ; Test if keyboard interrupt ; l032b: ld c,.kbstat call sl01cb ; Get state of keyboard rrca ; Test pending character ret nc ; Nope call sl01c9 ; Read it cp 'C'-'@' ; Test abort ret nz ; Nope ; ; HALT ; l0338: ld hl,l019c ld (l0125),hl ; Set console output ld hl,l042e ; Tell Halt l0341: call l02dc ; Print string pop de ; Get address call l0aa8 ; Print it as hex ld (l03b6),de ; Save address call sl01c9 ; Read character from keyboard and UPPMASK ; Get as upper case cp 'E' jr z,l037e ; ; End of program ; l0355:: ld a,(s0106) ; Get end flag inc a ; Test end jr z,l0377 ; Yeap ld de,l0080+1 ld bc,l03f4-l03ea ld hl,l03ea ldir ; Unpack CCP line ld a,l03f4-l03ea ld (l0080),a ; Set length ld hl,l08cc ld (l0115),hl ld hl,l03db ; Point to file jp l074e l0377: call s03f6 rst 0 ; ; Redirected console output ; l037b: ld (hl),a inc hl ret ; ; ; l037e: ld hl,l037b ld (l01aa+1),hl ; Change output vector to store to memory ld a,(s0106) ; Get end flag inc a ; Test end jr nz,l038d ; Nope ld (s0106),a ; Mark chain file l038d: ld de,l0080+1 ld bc,l03f6-l03ea ld hl,l03ea ldir ; Unpack file name push de ld de,l005c ld c,.drv+.nam ld hl,l03e9 ; Point to file data ld a,(l03ea+1) cp ':' ; Test possible drive jr nz,l03ae inc hl ld a,(hl) sub 'A'-1 ; Make binary inc hl ld (hl),a l03ae: ldir ; Unpack to main file ld a,' ' ld (l006d),a ; Clear second name l03b6 equ $+1 ld de,$-$ ; Load address pop hl call l0aa8 ; Print as hex ld a,16 ld (l0080),a ; Set length of input ld hl,l07d6 ld (l0115),hl ld hl,l03cd ; Point to file jp l074e ; l03cd: db ' HP .COM' l03db: db ' HPE .COM' l03e9: db 0 l03ea: db '1234567890' l03f4: db ';G' l03f6: ; ; ; s03f6: call sl01db ; Set default DMA ld hl,(l0100+1) l03fc: ld a,(hl) ; Get opcode cp 0c3h ; Test 'jp xxxx' - means jump over code jr nz,l0408 ; Nope inc hl ld e,(hl) ; Get address inc hl ld d,(hl) ex de,hl jr l03fc ; Retry l0408: ld de,l001a add hl,de l040c: inc hl ld a,(hl) cp 021h ; Test 'ld hl,xxxx' jr nz,l041e ; Nope ld de,l0007 add hl,de ld e,(hl) inc hl ld d,(hl) call l094d ; Close file if open jr l040c l041e: cp 032h ; Test 'ld (xxxx),a' ret nz inc hl ld e,(hl) inc hl ld d,(hl) call l0907 ld de,l0006 add hl,de jr l040c ; l042e: db cr,lf,'Halt' l0434: db ' at PC=',null l043c: db 'Overflow',null sl0445: db 'Out of RAM',null l0450: db '/ by Zero',null l045a: db 'Index too Low',null l0468: db 'Index too High',null l0477: db 'Maths Call Error',null l0488: db 'File Error',null l0493: db 'Number too large',null l04a4: db 'Number expected',null ; ; ; l04b4: db 0ddh ; ld d,ixh ld d,h db 0ddh ; ld e,ixl ld e,l l04b8: ex de,hl ld e,(hl) inc hl ld d,(hl) djnz l04b8 ret ; ; HL:=HL*DE - unsigned ; l04bf: xor a sbc hl,de add hl,de jr nc,l04c6 ex de,hl l04c6: or e ld e,d jp nz,l04d1 ex de,hl ret l04cd: ex de,hl add hl,de ex de,hl l04d0: add hl,hl l04d1: rra jr nc,l04d0 or a jr nz,l04cd add hl,de ret ; ; HL:=HL*DE ; l04d9: jp l0302 l04dc: ld a,d xor h ld b,a call l050e ex de,hl call l050e xor a sbc hl,de add hl,de jr nc,l04ed ex de,hl l04ed: or d jr nz,l04d9 or e ld e,d jp nz,l04fd ex de,hl ret l04f7: ex de,hl add hl,de ex de,hl l04fa: add hl,hl jr c,l04d9 l04fd: rra jr nc,l04fa or a jr nz,l04f7 adc hl,de jr c,l04d9 jp m,l04d9 or b ret p jr l0511 ; ; Get ABS(integer) ; l050e: ld a,h or a ret p ; ; Negate integer ; l0511: xor a sub l ld l,a ld a,0 sbc a,h ld h,a ret ; ; DE:=DE DIV HL ; HL:=DE MOD HL ; l0519: ld a,h or l ; Test zero divisor jp z,l0317 ; Error if so ld a,h push de xor d push af xor a or h call p,l0511 ld b,h ld c,l ld hl,0 ex de,hl call l050e l0530: or l jp z,l0549 ld a,17 l0536: add hl,hl dec a jr nc,l0536 ex de,hl l053b: adc hl,hl add hl,bc jr c,l0542 sbc hl,bc l0542: rl e rl d dec a jr nz,l053b l0549: pop af ex de,hl call m,l0511 ex de,hl pop af or a ret p jr l0511 ; ; Get character from FIB ; l0554: call l09d6 ; Get character from buffer l0557: push hl push de push bc push af ld hl,(l0125) ; Get FIB call l0585 ; Update character I/O pop af pop bc pop de pop hl ret ; ; Process file error ; l0566: push hl ld de,l0488 jp l0305 ; ; ; l056d: push hl ld hl,(l0125) ; Get FIB ld e,(hl) inc hl ld d,(hl) push de ex de,hl dec hl dec hl ld b,(hl) dec hl ld c,(hl) pop hl pop de ldir ld hl,(l0125) ; Get FIB jp l0626 ; ; ; l0585: ld e,(hl) ; Fetch line pointer inc hl ld d,(hl) inc hl inc hl inc hl ld a,(hl) ; Get file flag dec a ; Test open jr nz,l0566 ; Nope, error dec hl dec hl dec hl inc de ld a,(de) ; Get character ld (hl),d ; Bring back pointer dec hl ld (hl),e cp lf ; Test end of line jr z,l0585 cp eof ; Test end of file ret nz push hl inc hl inc hl ld c,(hl) inc hl ld b,(hl) inc hl inc hl ex de,hl sbc hl,bc ex de,hl pop de jp nz,l0731 inc hl ld a,(hl) inc a ; Test file jp nz,l06e6 ; Yeap inc hl ex de,hl ld c,.kbdlin call sl01cb ; Read line from keyboard ex de,hl inc hl ld c,(hl) ; Fetch length of input inc hl ld b,0 ld a,(hl) ; Get first character cp 'C'-'@' ; Test abort jp z,OS ; Yeap cp eof ; Test end of file jr nz,l05d3 push hl ld de,lfffc add hl,de ld (hl),1 pop hl l05d3: push hl add hl,bc ; Point to end of line ld (hl),cr ; Close line inc hl ld (hl),eof ld e,cr ld c,.conout call sl01cb ; Close line on screen ld e,lf ld c,.conout call sl01cb ex de,hl pop bc ld hl,lfffa add hl,bc ld (hl),d ; Store end pointer dec hl ld (hl),e dec hl ld (hl),b ; Store start pointer dec hl ld (hl),c ret ; ; Process RESET(DE,HL) ; l05f6:: push de call l07d0 pop hl call l0734 ; Open file ret z inc hl inc hl ex de,hl ld bc,l0028 add hl,bc ex de,hl call sl01e1 ; Set DMA ex de,hl ld c,.rdseq call sl01cb ; Read record or a ; Test success jp nz,l0566 ; Nope error ld d,h ld e,l ld bc,l0080 add hl,bc ex de,hl push de ld c,4 ldir ex de,hl ld (hl),4 pop hl jr l0633 ; ; ; l0626: ld de,l0004 add hl,de ld a,(hl) dec a jp nz,l0566 ; File error ld de,l00a4 add hl,de l0633: ld c,(hl) inc hl ld b,(hl) ld a,c or b jr z,l067d dec bc ld (hl),b dec hl ld (hl),c inc hl inc hl ld c,(hl) inc hl ld b,(hl) inc hl ld a,(hl) push hl ld e,a ld d,0 ex de,hl add hl,de ld de,-l0084 add hl,de pop de inc de push de l0652: cp 80h jr nz,l0673 pop hl push hl push de push bc ld de,-l0084-1 add hl,de ex de,hl call sl01e1 ; Set DMA ld hl,-l0021 add hl,de ex de,hl ld c,.rdseq call sl01cb ; Read record inc a ; Verify success jp z,l0566 ; Nope, error pop bc pop de xor a l0673: inc a ldi jp pe,l0652 l0679: pop hl dec hl ld (hl),a ret l067d: ld de,-l00a4 add hl,de ld (hl),1 ret ; ; ; l0684: ld de,l0004 add hl,de ld a,(hl) inc a jp nz,l0566 ; File error ld de,l00a4 add hl,de inc (hl) inc hl jr nz,l0696 inc (hl) l0696: inc hl ld c,(hl) inc hl ld b,(hl) inc hl ld a,(hl) push hl ld e,a ld d,0 ex de,hl add hl,de ld de,-l0084 add hl,de pop de inc de push de ex de,hl l06aa: cp 80h jr nz,l06bf ex (sp),hl push hl push bc ld de,-l0084-1 call l06ce ex de,hl pop bc or a jp nz,l06c7 pop hl ex (sp),hl l06bf: inc a ldi jp pe,l06aa jr l0679 l06c7: pop de pop de dec hl dec hl ld (hl),0 ret ; ; ; l06ce: add hl,de ex de,hl call sl01e1 ; Set DMA ld hl,-l0021 add hl,de ex de,hl ld c,.wrseq jp sl01cb ; Write record ; ; Process RESET(DE,HL) - Text file ; l06dd: push de ; Save FIB call l07e8 ; Parse file pop hl call l0734 ; Open file ret z l06e6: ld hl,l0028 add hl,de ex de,hl ld (hl),e inc hl ld (hl),d push de inc hl ld c,(hl) inc hl ld b,(hl) inc hl inc hl push hl push bc inc hl inc hl l06f9: call sl01e1 ; Set DMA ex de,hl ld c,.rdseq call sl01cb ; Read record or a jr nz,l0713 ld bc,l0080 add hl,bc pop bc sbc hl,bc jr z,l0719 add hl,bc push bc ex de,hl jr l06f9 l0713: ld (hl),eof ld (l07a6),hl pop bc l0719: pop de pop hl l071b: ld a,(hl) cp lf inc hl l071f equ $ jr z,l071b ; May be 'nop; nop' on READLF dec hl push de dec de dec de dec de dec de ex de,hl ld (hl),d dec hl ld (hl),e ex de,hl pop de cp eof ret nz ex de,hl l0731: ld (hl),1 ret ; ; Open file ; l0734: push hl ld de,l0004 add hl,de ld (hl),1 inc hl inc hl inc hl ex de,hl ld c,.open call sl01cb ; Open file ex de,hl dec hl dec hl inc a ; Test success pop de jr z,l0731 ; Nope ld (hl),0 ; Indicate file open ret ; ; ; l074e: push hl call s03f6 pop hl ld de,l07a8 call l06dd ld hl,(l0115) ld a,h or l jr z,l076a ex de,hl ld hl,s0106 ld a,(hl) ; Get chain flag ld bc,l000f ldir ; Unpack header l076a: call sl01db ; Set default DMA ld hl,lb0ed ld (TPA-2),hl ; Set 'ldir' ld hl,(l07a6) ld de,l07d0 or a sbc hl,de ; Verify chain file jr z,l0787 ; Nope, error ld b,h ld c,l ex de,hl ld de,TPA jp TPA-2 l0787: ld hl,l078e call l02dc ; Tell error rst 0 ; l078e: db cr,lf,'Can''t find chain file',null l07a6: dw l07d0 l07a8: dw l07d0 dw lffff ds 36 ; ; ; l07d0: call sl01db ; Set default DMA push hl ld h,d ld l,e ld bc,l00ad add hl,bc ex de,hl ld (hl),e inc hl ld (hl),d inc hl inc hl inc hl ex de,hl pop hl call l0907 jr l07ff ; ; Parse file ; l07e8: call sl01db ; Set default DMA ex de,hl inc hl inc hl ld c,(hl) ; Fetch address inc hl ld b,(hl) inc bc ld a,b or c ; Test valid address dec bc ld a,eof jr z,l07fa ; Nope ld (bc),a ; Set end of file l07fa: ex de,hl inc de call l094d ; Close file if open l07ff: inc de inc de call l0835 ; Convert character to upper case cp ' ' ; Test default drive jr z,l0829 ; Yeap sub 'A'-1 ; Convert to binary l080a: ld (de),a ; Unpack drive inc de ld (de),a inc de inc hl inc hl ld b,.nam call l082c ; Unpack name inc hl ld b,.ext call l082c ; Unpack extension xor a ld (de),a ; Init some locations inc de ld (de),a inc de ld (de),a inc de ld (de),a ld hl,l0011 add hl,de ld (hl),a ret l0829: xor a jr l080a ; ; ; l082c: call l0835 ; Convert character to upper case ld (de),a inc de inc hl djnz l082c ret ; ; Convert character ^HL to upper case ; l0835: ld a,(hl) ; Get character cp 'a' ; Test range ret c ; Not lower case cp 'z'+1 ret nc sub 'a'-'A' ; Convert ret ; ; ; l083f: push de call l07d0 pop hl ld de,l0004 add hl,de call l0884 ld bc,l0023 add hl,bc ld d,h ld e,l ld bc,l0080 add hl,bc ld (hl),0 inc hl ld (hl),0 dec hl ld a,4 ld c,a ldir ld (hl),a ret ; ; Process REWRITE(DE,HL); ; l0862: push de ; Save FIB call l07e8 ; Parse file pop de ld hl,l0028 add hl,de ex de,hl ld (hl),e inc hl ld (hl),d inc hl ld c,(hl) inc hl ld b,(hl) inc hl push hl ld h,b ld l,c sbc hl,de ld b,h ld c,l dec bc ld h,d ld l,e ld (hl),0 inc de ldir pop hl l0884: ld (hl),0ffh inc hl push hl inc hl inc hl ex de,hl ld c,.delete call sl01cb ; Delete file ld c,.make call sl01cb ; Create ne wone pop hl inc a ld (hl),1 ret nz ld (hl),0 ret ; ; Put character to console ; l089d: push hl push de push bc push af ld hl,(l0125) ; Get FIB ld e,(hl) inc hl ld d,(hl) ld (de),a dec hl call l08b8 pop af pop bc pop de pop hl ret ; ; ; l08b1: ld a,(de) ; Get character ld e,a l08b4 equ $+1 ld c,.conout jp sl01cb ; Put to console l08b8: ld e,(hl) inc hl ld d,(hl) inc hl inc hl inc hl ld a,(hl) inc a jp nz,l0566 ; File error inc hl inc hl ld a,(hl) ld bc,-5 add hl,bc inc a jr z,l08b1 inc de ld a,(de) ld (hl),d dec hl ld (hl),e cp 1ah ret nz ex de,hl ld hl,l0028 add hl,de ex de,hl ld (hl),e inc hl ld (hl),d inc hl ld c,(hl) inc hl ld b,(hl) ; ; Write record(s) to file ; l08e2: push bc inc hl inc hl inc hl inc hl l08e7: call sl01e1 ; Set DMA ex de,hl ld c,.wrseq call sl01cb ; Write record to file ld bc,reclng add hl,bc ; Point to next buffer pop bc or a ; Test success jr nz,l0900 ; Nope, write error sbc hl,bc ; Test done ret nc ; Yeap add hl,bc ex de,hl push bc jr l08e7 ; Try next l0900: ld h,d ld l,e dec hl dec hl ld (hl),0 ; Set end of file ret ; ; ; l0907: ld a,(de) or a ret p push de push hl ld hl,l0024 call l06ce push de ld hl,l00a1 add hl,de ld c,(hl) inc hl ld b,(hl) inc hl ld a,(hl) ld de,lff7e add hl,de ld (hl),0 inc hl ld (hl),0 inc hl ld (hl),0 inc hl pop de push af push bc ex de,hl call sl01e1 ; Set DMA ex de,hl ld c,.rdrnd call sl01cb ; Read last record pop bc ld (hl),c inc hl ld (hl),b ld c,.wrrnd call sl01cb ; Write record ld c,.close call sl01cb ; Close file ld hl,l00a3 add hl,de pop af ld (hl),a pop hl pop de ret ; ; Close file if open ; l094d: ld a,(de) or a ; Test open ret p ; Nope push de push hl dec de dec de dec de dec de ld hl,l0028 add hl,de ex de,hl ld c,(hl) ; Fetch current buffer address inc hl ld b,(hl) ld a,eof ld (bc),a ; Store end of file inc bc inc hl inc hl call l08e2 ; Write record(s) to file ld c,.close call sl01cb ; Close file pop hl pop de ret ; ; Process READLN ; l096f: call l01a7 ; Get character cp cr ; Wait for end of line jr nz,l096f ret ; ; Perform EOLN ^HL ; l0977: ld e,(hl) ; Get address of character inc hl ld d,(hl) ld a,(de) ; Get character cp cr ; Test end of line ld a,.false ret nz ; Nope inc a ; Return true ret ; ; Skip blanks and end of line ; l0982: call l01a7 ; Get character cp ' ' ; Test blank jr z,l0982 ; Nope cp cr ; Test end of line ret nz ; Nope, got it jr l0982 ; ; ; l098e: call l0982 ; Get character cp '-' ; Test negative sign jr z,l09cc ; Yeap, process it cp '+' ; Test positive sign l0997: call z,l01a7 ; Get new character on sign call l0239 ; Test character a digit jp nc,l02f6 ; Nope ld hl,0 ; Init result ld b,4 ; Set length cp '3'+1 ; Test range jr nc,l09aa inc b ; Fix length l09aa: sub '0' ; Make binary ld e,a ld d,0 add hl,de ; Add it call l09d6 ; Get character from buffer call l0239 ; Test character a digit jr nc,l09c6 ; Nope call l0557 ; Update I/O dec b ; Count down jr z,l09c9 ; Number too large add hl,hl ; * 2 push hl add hl,hl ; * 4 add hl,hl ; * 8 pop de add hl,de ; *10 jr l09aa l09c6: bit 7,h ; Verify in range ret z l09c9: jp l02fd ; Number too large l09cc: call l0997 ; Get number ld e,0 ; Remember D is NULL already ex de,hl or a sbc hl,de ; Negate number ret ; ; Get character from buffer ; l09d6: push hl push de ld hl,(l0125) ; Get FIB ld e,(hl) ; Fetch current buffer address inc hl ld d,(hl) ld a,(de) ; Get character pop de pop hl ret ; ; Process READ(HL) ; l09e2: call l09d6 ; Get character from buffer cp cr ; Test end of line jr z,l09f1 ; Yeap ld (hl),a ; Store character inc hl call l0557 ; Update I/O djnz l09e2 ret l09f1: xor a l09f2: ld (hl),a ; Fill remainder with NULLs inc hl djnz l09f2 ret ; ; ; l09f7: ld hl,l0002 add hl,sp ld c,a xor a srl c rra srl c rra srl c rla rla rla ld b,a inc b xor a scf l0a0c: adc a,a djnz l0a0c add hl,bc ret ; ; ; l0a11: inc a ld b,a l0a13: ld a,(hl) or d ld (hl),a rlc d jr nc,l0a1b inc hl l0a1b: djnz l0a13 ret ; ; ; l0a1e: pop hl ld (sl0117),hl ld b,0 ld l,b ld h,b or a sbc hl,bc add hl,sp ld d,h ld e,l dec hl ld sp,hl ld (hl),0 ldir ld hl,(sl0117) jp (hl) ; ; ; l0a36: pop hl ld (sl0117),hl ld hl,l0000 add hl,sp ld d,h ld e,l add hl,bc ld b,c l0a42: ld a,(de) ; ; Code changed to: ; ; 1) or (hl) : l00b6 ; nop ; ; 2) and (hl) : l00a6 ; nop ; ; 3) cpl : la62f ; and (hl) ; l0a43: ld (bc),a nop ; ld (hl),a inc hl inc de djnz l0a42 ex de,hl ld sp,hl ld hl,(sl0117) jp (hl) ; ; Do the SET comparasion ; sl0a50: pop hl ; Get caller ld (sl0117),hl ; Save it ld hl,0 add hl,sp ; Copy stack ld d,h ; Get pointer to 1st SET ld e,l add hl,bc ; Get pointer to 2nd SET ld b,c ; Get length of set sl0a5c: call $-$ ; Call set dynamically inc hl ; Returns on match inc de djnz sl0a5c ld a,.true ; Set result sl0a65: ld sp,hl ; Get back cleaned stack ld hl,(sl0117) ; Get caller jp (hl) ; Go back ; ; Compare sets = and <> ; sl0a6a: ld a,(de) ; Get bit pattern cp (hl) ; Compare sl0a6c: ret z ; End if match l0a6d: inc hl djnz l0a6d ; Position address for resulting stack xor a ; Set result jr sl0a65 ; Exit ; ; Compare sets <= ; sl0a73: ld a,(de) ; Get pattern cpl ; Toggle bits and (hl) ; Mask jr sl0a6c ; ; Compare sets >= ; sl0a78: ex de,hl ld a,(de) ; Get pattern cpl ; Toggle bits and (hl) ; Mask ex de,hl jr sl0a6c ; ; Check integer for < > ; l0a7f: or a sbc hl,de ld a,80h jp pe,l0a92 l0a87: and h rlca ret ; ; Check integer for <= >= ; l0a8a: or a sbc hl,de ld a,80h jp pe,l0a87 l0a92: and h rlca xor 1 ret ; ; ; l0a97: dec l ld a,e jr z,l0ab6 ; Print hex nibble dec l jr z,l0aad ; Print hex byte dec l jr z,l0aa8 ; Print hex word dec l jr z,l0aa8 ld b,l call l02c1 ; Print blanks before ; ; Print hex word ; l0aa8: ld a,d call l0aad ld a,e ; ; Print hex byte ; l0aad: ld c,a ; Save byte rrca ; Extract hi bits rrca rrca rrca call l0ab6 ; Convert to ASCII ld a,c ; Then lo bits ; ; Print hex nibble ; l0ab6: and LOMASK ; Get bits add a,090h daa ; Convert to ASCII adc a,040h daa call l01aa ; Print it ret ; ; Perform NEW ^HL with length in reg DE ; l0ac2:: ld (l011d),de ; Save length push hl ld hl,l0121 ld (l011b),hl ; Init heap pointer ld hl,(l0121) l0ad0: push hl call l0b19 ; Fetch DE.BC from ^HL ld hl,(l011d) ; Get length of item or a sbc hl,bc ; Test same length add hl,bc jr z,l0b0d ; Got it jr c,l0ae6 ; New is greater than request pop hl ld (l011b),hl ex de,hl jr l0ad0 l0ae6: ld a,b and c ; Test no length inc a jr z,l0af6 ; Yeap push hl xor a sbc hl,bc sub l ld c,a ld a,0 sbc a,h ld b,a pop hl l0af6: ld (l011d),bc ; Set length of item pop bc ; Get back address of heap push bc add hl,bc ; Build new top call l0b34 push hl ld (hl),e ; Save new address inc hl ld (hl),d inc hl ld bc,(l011d) ; Get length of item ld (hl),c ; Save length inc hl ld (hl),b pop de l0b0d: ld hl,(l011b) ; Get heap chain ld (hl),e ; Set end address inc hl ld (hl),d pop de pop hl ld (hl),e ; Set start address of new entry inc hl ld (hl),d ret ; ; Fetch DE.BC from ^HL ; l0b19: ld e,(hl) inc hl ld d,(hl) inc hl ld c,(hl) inc hl ld b,(hl) ret ; ; Process RELEASE ; Same for initialize memory on entry ; l0b21: push hl ld (l0121),hl ; Save start of heap ld a,0ffh ld (hl),a ; Init two addresses inc hl ld (hl),a inc hl ld (hl),a inc hl ld (hl),a pop de l0b2f: push hl push de ex de,hl jr l0b41 ; ; Set up new heap ; l0b34: push hl push de ld de,(l011f) ; Get current heap or a sbc hl,de add hl,de jr nc,l0b41 ex de,hl ; Get max address l0b41: ld (l011f),hl ; Save heap value ex de,hl ld hl,lffcd sbc hl,de ; Allow some space ld (l0119),hl ; Save free memory add hl,sp jp nc,sl02f0 ; Out of memory pop de pop hl ret ; ; Process DISPOSE ; l0b54: push de ld c,(hl) ; Fetch address of item inc hl ld b,(hl) ld hl,l0121 ; Init heap pointer l0b5b: ld e,(hl) ; Get address inc hl ld d,(hl) ex de,hl or a sbc hl,bc add hl,bc jr c,l0b5b ; Not last in queue dec de push bc ex (sp),hl pop bc ld (hl),c ; Save address inc hl ld (hl),b inc hl pop bc ld (hl),c ; Save length inc hl ld (hl),b dec hl dec hl dec hl ex de,hl ld (hl),e ; Store address inc hl ld (hl),d dec hl call l0b7d ex de,hl l0b7d: push hl call l0b19 ; Fetch DE.BC from ^HL pop hl push hl add hl,bc sbc hl,de ; Test same address pop hl ret nz ; Nope, exot push bc push hl ex de,hl call l0b19 ; Fetch DE.BC from ^HL pop hl push bc ld (hl),e inc hl ld (hl),d inc hl ex de,hl pop hl pop bc ld a,h and l inc a jr z,l0b9d add hl,bc l0b9d: ex de,hl ld (hl),e inc hl ld (hl),d dec hl dec hl dec hl ex de,hl ld a,h and l inc a jp nz,l0b2f ret ; ; Part II : Real number computing ; l0bac: pop af l0bad: pop bc pop de pop hl push bc ret ; ; Add reals ; l0bb2: bit 6,h ; Test operand 2 = 0.0 jr z,l0bad ; Yeap ld iy,0 add iy,sp ld a,h ld b,(iy+5) bit 6,b ; Test operand 1 = 0.0 jr z,l0c08 xor b ; Get resulting sign push af push de ld a,d ld d,b ld b,e ld e,(iy+4) sub (iy+3) ; Check difference jp pe,l0c0d jp m,l0c2b ld c,(iy+2) jr z,l0c3a l0bdb: push hl res 7,d ; No signs res 7,h l0be0: srl d ; Make exponents equal rr e rr c dec a jr nz,l0be0 ld a,b bit 7,(iy-1) ; Test resulting sign jr nz,l0c12 l0bf0: add a,c ; Get result adc hl,de pop bc pop de jp po,l0c01 srl h rr l rra inc d jp pe,l0c22 ; Test overflow l0c01: ld e,a ld a,b and 80h or h ld h,a l0c07: pop af l0c08: pop bc ; Dummy pop - return OP 2 pop af ; (or result) pop af push bc ret l0c0d: pop de jr nc,l0bac jr l0c07 l0c12: sub c sbc hl,de l0c15: pop bc l0c16: pop de l0c17: bit 6,h ; Check normalized jr nz,l0c01 add a,a ; Fix mantissa adc hl,hl dec d ; And exponent jp po,l0c17 ; Check overflow l0c22: ld sp,iy pop bc pop hl pop hl push bc jp l0302 l0c2b: ld c,b ld b,(iy+3) ld (iy-3),b ; Save result ld b,(iy+2) ex de,hl neg jr l0bdb l0c3a: ld a,b push hl res 7,h ; Reset signs res 7,d bit 7,(iy-1) jr z,l0bf0 ; Start if > 0.0 sub c sbc hl,de jr nz,l0c4e ; Check conditions or a jr z,l0c5e l0c4e: jr nc,l0c15 ld de,l0000 ex de,hl ld c,a pop af cpl ld b,a ; Fix a bit xor a sub c sbc hl,de jr l0c16 l0c5e: ld d,h ld e,h pop af ; Fix stack pop af jr l0c07 ; Get result ; ; Raise reals ; l0c64: pop bc push hl push de push bc ; ; Multiply reals ; l0c68: ld iy,0 add iy,sp ld a,01000000b and h ; Check zero operand 2 ld b,(iy+5) and b ; As well as operand 1 jr z,l0cd5 ; Get zero result if either ld a,h xor b and 80h ; Get a bit ld b,a ld a,(iy+3) add a,d ; Add exponents ld c,a jp pe,l0c22 ; Overflow push bc res 7,h ; Reset sign bit ld c,e xor a ex de,hl ld l,(iy+2) ; Load last byte ld b,8 l0c8f: rr l ; Shift byte jr nc,l0c94 add a,d l0c94: rra djnz l0c8f rr l ld h,a ld a,(iy+4) ld b,8 l0c9f: rra ; Same for middle byte jr nc,l0ca3 add hl,de l0ca3: rr h rr l djnz l0c9f rra ld b,7 l0cac: rr (iy+5) jr nc,l0cb5 add a,c adc hl,de l0cb5: rr h rr l rra ; Same for hi byte djnz l0cac pop bc ld e,a ld d,c bit 6,h ; Test normalized jr nz,l0cc9 rl e adc hl,hl ; Shift bit if not jr l0ccd l0cc9: inc d ; Bump exponent jp pe,l0c22 ; Error l0ccd: ld a,b or h ld h,a ; Set resulting bit pop bc pop af ; Fix stack pop af push bc ret l0cd5: pop hl ; Fix stack pop de ex (sp),hl ld hl,0 ; Return 0.0 ld e,h ld d,l ret ; ; Divide reals ; l0cde: bit 6,h ; Test zero divisor jp z,l0317 ; Yeap, error ld iy,0 add iy,sp ld b,(iy+5) bit 6,b ; Test zero dividend jp z,l0cd5 ; Return 0.0 if so ld a,(iy+3) sub d jp pe,l0c22 push af ld d,b ld c,e ld e,(iy+4) ld a,d xor h and 80h res 7,d ; Reset bits res 7,h push af ex de,hl ld a,(iy+2) ld b,8 l0d0d: sub c sbc hl,de jr nc,l0d15 add a,c ; Shift lo byte adc hl,de l0d15: rl (iy-4) add a,a adc hl,hl djnz l0d0d ld b,8 l0d20: sbc hl,de jr nc,l0d25 add hl,de l0d25: rla add hl,hl djnz l0d20 cpl ld l,a ld a,h ld b,8 l0d2e: sub d jr nc,l0d32 add a,d l0d32: rl e add a,a djnz l0d2e pop bc ld a,c cpl ld h,a ld a,e pop de cpl bit 7,h ; Test bit set jr nz,l0d4f dec d jp pe,l0c22 l0d46: ld e,a ld a,h or b ld h,a pop bc pop af pop af push bc ret l0d4f: srl h ; Divide mantissa by 2 rr l rra jr l0d46 ; ; Convert integer to real ; l0d56: ld a,80h and h ; Test sign jp z,l0d63 ; >= 0 ex de,hl ld hl,0 sbc hl,de ; Make > 0 or a l0d63: ld de,0 adc hl,de ret z ld d,14 ; Set count l0d6b: bit 6,h ; Test normalized jp nz,l0d75 ; Yeap add hl,hl ; Shift value dec d ; Update exponent jp l0d6b l0d75: ld e,0 ; Clear LSByte or h ; Get resulting sign ld h,a ret ; ; Real function TRUNC ; l0d7a: bit 6,h ; Test zero number ret z ; Yeap ld a,80h and h ; Test sign ld c,a ; Save it res 7,h ; Make greater zero ld a,14 ; Test max exponent sub d jr z,l0d92 jp m,l0d9c ; Out of range ld b,a l0d8c: srl h ; Shift mantissa rr l djnz l0d8c l0d92: inc c ; Test sign ret p ex de,hl ld hl,0 or a sbc hl,de ; Negate number ret l0d9c: ld hl,0 ; Return zero ret ; ; Real function ROUND ; l0da0: push hl push de ld de,0ff00h ld hl,04000h call l0bb2 ; Add 0.5 ; ; Real function ENTIER - Convert real to integer ; l0dab: bit 6,h ; Test zero number ret z ; Yeap ld a,80h and h ; Get sign ld c,a ; Save it res 7,h ; Make greater zero ld a,d or a ; Test exponent jp m,l0de1 ld a,14 sub d jp c,l0302 ; Overflow ld b,a ; Save shift value xor a cp e ; Test last byte jp z,l0dc6 inc a ; Fix if not zero l0dc6: dec b inc b ; Test any to be shifted jp z,l0dd3 l0dcb: srl h rr l ; Shift mantissa right adc a,0 djnz l0dcb l0dd3: inc c ; Test sign ret p or a ; Test any bit jp z,l0dda inc hl l0dda: ex de,hl ld hl,0 sbc hl,de ; Negate result ret l0de1: inc c ld hl,0 ret p ; Return 0 dec hl ; Or -1 ret ; ; Multiply mantissa by 10 ; l0de8: add hl,hl ; * 2 rl e rl d push de push hl ; add hl,hl ; * 4 rl e rl d add hl,hl ; * 8 rl e rl d ; pop bc ; Get back * 2 add hl,bc ; *10 ex de,hl pop bc adc hl,bc ex de,hl ret ; ; Get factor 1Exx, xx=1 .. 32 ; l0e01: ld hl,04000h ; Init 1.0 ld d,l ld e,l ld iy,l0e2d ; Init table l0e0a: srl a ; Get bit jr nc,l0e25 ; Skip if not set push af push iy push hl push de ld h,(iy+0) ; Load multiplier ld l,(iy+1) ld e,(iy+2) ld d,(iy+3) call l0c68 ; Multiply pop iy pop af l0e25: ret z ; End if all bits shifted ld bc,l0004 add iy,bc ; Fix table jr l0e0a ; l0e2d: db 050h,000h,000h,003h ; 1 E01 db 064h,000h,000h,006h ; 1 E02 db 04eh,020h,000h,00dh ; 1 E04 db 05fh,05eh,010h,01ah ; 1 E08 db 047h,00dh,0e4h,035h ; 1 E16 db 04eh,0e2h,0d4h,06ah ; 1 E32 ; ; Fix numbers depending on exponent ; l0e45: ld a,d ; Get exponent cp 3 ret c push hl push de ld bc,05000h jr nz,l0e55 or a sbc hl,bc ; Test equal jr c,l0e65 ; Let number unchanged if so l0e55: ld h,b ld l,c ld de,00300h ; Complete 10.0 call l0cde ; Divide ld a,(l0131) inc a ; Fix digits ld (l0131),a ret l0e65: pop de pop hl ret ; ; ; l0e68: pop af l0e69: pop af ld a,(l013f) ld hl,(l0133) ld de,(l0133+2) jp l0f7d ; ; ; l0e77: ld a,e ld (l013f),a ld a,l ld (l0132),a or a ld a,0ffh jr z,l0e89 jp m,l0e89 sub l dec a l0e89: add a,e pop hl pop de ex (sp),hl ld (l0133),hl ld (l0133+2),de rlc h push af rrc h jp p,l0e9f res 7,h dec a l0e9f: or a jp m,l0e69 ld (l0131),a push hl push de ld hl,04000h push hl ld h,0ffh push hl ld a,(l0132) call l0e01 ; Get factor 1Exx call l0cde ; Divide call l0bb2 ; Add ld (l0137),hl ld (l0137+2),de pop af ld a,0ffh push af ld a,(l0131) ld c,a ld a,(l0132) add a,c dec a ld (l0132),a ld a,c l0ed3: push hl push de call l0e01 ; Get factor 1Exx call l0cde ; Divide call l0f52 ld a,d push af cp 9+1 jr nc,l0e68 pop af jp m,l0f44 or a jr nz,l0f02 ld a,(l0131) sub b jr z,l0f02 ld d,a ld a,' ' call l01aa ld a,d dec a ld hl,(l0137) ld de,(l0137+2) jr l0ed3 l0f02: call l0f49 l0f05: ld a,'0' add a,d call l01aa ld a,(l0131) cp b jr nz,l0f16 ld a,'.' call l01aa l0f16: ld a,d ld hl,(l013b) ld de,(l013b+2) neg jr z,l0f2d push hl push de ld l,a ld h,0ffh call l0d56 ; Convert to real call l0bb2 ; Add reals l0f2d: ld bc,l5000 push bc ld b,3 push bc call l0c68 ; Multiply call l0f52 jr nc,l0f05 l0f3c: ld a,'0' add a,d pop bc call l01aa ret l0f44: call l0f49 jr l0f3c ; ; ; l0f49: bit 0,c ret z ld a,'-' call l01aa ret ; ; ; l0f52: ld (l013b),hl ld (l013b+2),de call l0d7a ; Truncate ld d,l pop hl pop bc inc b push bc ld a,(l0132) cp b push hl ret ; ; Output 0.0... ; l0f67: ld hl,l108e call l02dc ; Give prefix ld a,(l0132) ; Get count inc a ld b,a ld a,'0' l0f74: call l01aa ; Put zeroes djnz l0f74 inc hl jp l02dc ; ; ; l0f7d: sub 8 jp p,l0f84 ; ; Floating point output ; l0f82: ld a,4 ; Get defualt length l0f84: ld (l0132),a ; Save length sub 4+1 ; Check max jr c,l0f91 inc a ; Fix count call sl02c0 ; Fill leading blanks jr l0f82 l0f91: bit 6,h ; Test zero number jr z,l0f67 ; Output it bit 7,h ; Test sign jr z,l0f9f res 7,h ; Clear it ld a,'-' jr l0fa1 ; Indicate it l0f9f: ld a,' ' l0fa1: call l01aa ; Output first character ld a,d or a ; Get state of exponent push hl push de ld de,004dh ; Set default addend ld h,d ld l,d jp m,l1047 l0fb0: srl a ; Shift exponent jr nc,l0fba add hl,de l0fb5: ex de,hl add hl,hl ex de,hl jr l0fb0 l0fba: jr nz,l0fb5 ; Loop till zero ld a,h ; Get result ld (l0131),a call l0e01 ; Get factor 1Exx call l0cde ; Divide call l0e45 ; Fix number push hl push de l0fcb: ld a,(l0132) ; Get count add a,a ; Build index add a,a ld e,a ld d,0 ld hl,l107a add hl,de ; Get table address ld e,(hl) ; Fetch number inc hl ld d,(hl) inc hl ld c,(hl) inc hl ld h,(hl) ld l,c call l0bb2 ; Add rounding call l0e45 ; Fix number ld b,d inc b inc b ld d,e ; Unpack numbers ld e,h ld h,l ld l,d ld d,0 ; Init BCD l0fee: add hl,hl ; Shift mantissa rl e rl d ; Shift into BCD djnz l0fee ld a,'0' add a,d call l01aa ; Output it ld d,0 ld a,'.' call l01aa ; Set decimal point ld a,(l0132) ; Get decimal places inc a ld b,a l1007: push bc call l0de8 ; Multiply mantissa by 10 ld a,'0' add a,d call l01aa ; Pint decimal places ld d,0 pop bc djnz l1007 ld a,'E' call l01aa ; Output exponent indicator ld a,(l0131) ; Get sign of exponent or a jp p,l1029 neg ; Negate it ld c,a ld a,'-' jr l102c l1029: ld c,a ld a,'+' l102c: call l01aa ; Output sign ld a,c ; Get exponent ld b,10 ; Set divisor ld c,'0' ; Init ASCII digit l1034: sub b ; Divide by 10 jr c,l103a inc c jr l1034 l103a: add a,b add a,'0' ; Build units ld b,a ld a,c call l01aa ; Output exponent ld a,b call l01aa ret l1047: cpl ; Make exponent positive l1048: srl a jr nc,l1052 add hl,de l104d: ex de,hl add hl,hl ex de,hl jr l1048 l1052: jr nz,l104d ld a,h cpl ld (l0131),a neg call l0e01 ; Get factor 1Exx call l0c68 ; Multiply push hl push de ld a,d or a ; Check range jp p,l0fcb ld hl,05000h ; Load 10.0 ld de,00300h call l0c68 ; Multiply push hl push de ld hl,l0131 dec (hl) ; Fix exponent jp l0fcb ; l107a: db 066h,0fbh,066h,066h ; 5.0 E-2 db 085h,0f8h,0ebh,051h ; 5.0 E-3 db 036h,0f5h,085h,041h ; 5.0 E-4 db 08bh,0f1h,0dbh,068h ; 5.0 E-5 db 0d6h,0eeh,0e2h,053h ; 5.0 E-6 ; l108e: db ' 0.',null db 'E+00',null ; ; SQRT ; l1097: ld a,h or a ; Verify positive sign jp m,l0326 ; Error ret z ; End if 0.0 ld (l0133+2),de ; Save number ld (l0133),hl sra d ; Init exponent ld b,4 ; Init loop l10a8: push bc push hl push de ld bc,(l0133) ; Get number push bc ld bc,(l0133+2) push bc call l0cde ; Divide call l0bb2 ; Add reals dec d ; Count down exponent pop bc djnz l10a8 ret ; ; Floating point input ; l10c0: call l0982 ; Get character cp '-' ; Test sign jr z,l10d0 cp '+' call z,l01a7 ; Get new character if so call sl10db ; Convert ret l10d0: call l01a7 ; Get next character call sl10db ; Convert ld a,80h xor h ; Toggle sign ld h,a ret ; ; Do the floating point conversion ; sl10db: call l0239 ; Test character a digit jp nc,l02f6 ; Nope ld hl,0 ; Init result ld d,h ld e,l ld b,7 ; Init counter push bc jr l10ef l10eb: push bc call l0de8 ; Multiply mantissa by 10 l10ef: sub '0' ; Strip off ASCII offset ld c,a ld b,d add hl,bc ; Insert into mantissa jr nc,l10f7 inc de ; Insert carry l10f7: call l09d6 ; Get character from buffer call l0239 ; Test next character still a digit pop bc dec b jr nc,l1114 ; Nope call l0557 ; Update I/O jr nz,l10eb ; Still any to be read l1106: inc d call l09d6 ; Get character from buffer call l0239 ; Test character a digit jr nc,l1114 ; Nope call l0557 ; Update I/O jr l1106 l1114: cp '.' ; Check fraction jp nz,l116c ; Nope, maybe exponent call l0557 ; Update I/O call l01a7 ; Get character call l0239 ; Test character a digit jp nc,l02f5 ; Nope but should be dec b inc b ld c,d jr z,l1145 ; The remainder gies to trash l112a: push bc call l0de8 ; Multiply mantissa by 10 sub '0' ; Strip off ASCII offset ld c,a ld b,d add hl,bc ; Fix mantissa jr nc,l1136 inc e ; Remember carry l1136: pop bc dec c call l09d6 ; Get character from buffer call l0239 ; Test character a digit jr nc,l1152 ; Nope call l0557 ; Strip off ASCII offset djnz l112a l1145: call l09d6 ; Get character from buffer call l0239 ; Test character a digit jr nc,l1152 ; Nope call l0557 ; Update I/O jr l1145 l1152: ld d,c cp 'E' ; Test exponent jr nz,l1170 ; Nope l1157: push de call l0557 ; Update I/O call l01a7 ; Get character cp '-' ; Test sign jr nz,l1173 ; Nope call l01a7 ; Get character call sl11db ; Get exponent pop af sub b ; Build resulting exponent jr l117d l116c: cp 'E' ; Test exponent jr z,l1157 ; Yeap l1170: ld a,d jr l117d l1173: cp '+' ; Test sign call z,l01a7 ; Get character call sl11db ; Get exponent pop af add a,b ; Build resulting exponent l117d: ld d,l0016 ld c,a bit 7,e ; Check sign jp nz,l11ce ; Process it xor a cp e jr nz,l1192 cp l jr nz,l1196 cp h jr nz,l1196 ld d,0 ret l1192: bit 6,e ; Test normalized jr nz,l119c ; Yeap l1196: add hl,hl ; Fix mantissa rl e dec d jr l1192 l119c: ld b,e ; Unpack number ld e,l ld l,h ld h,b ld a,c or a ; Check all done ret z ; Yeap push hl push de jp m,l11af call l0e01 ; Get factor 1Exx call l0c68 ; Multiply ret l11af: neg cp 31+1 ; Test exponent jr nc,l11bc call l0e01 ; Get factor 1Exx l11b8: call l0cde ; Divide ret l11bc: sub 31+1 ; Fix exponent call l0e01 ; Get factor 1Exx call l0cde ; Divide push hl push de ld hl,04ee2h ; Load 1.0E+32 ld de,06ad4h jr l11b8 ; Divide l11ce: inc hl jr nz,l11d2 inc e l11d2: srl e rr h rr l inc d jr l119c ; ; Get exponent ; sl11db: call l0239 ; Test character a digit jr nc,l1202 ; Nope sub '0' ld b,a call l09d6 ; Get character from buffer call l0239 ; Test character a digit ret nc ; Nope call l0557 ; Update I/O sub '0' ; Make binary ld c,a ld a,b add a,a ; Get times 10 ld b,a add a,a add a,a add a,b add a,c ld b,a call l09d6 ; Get character from buffer call l0239 ; Test character a digit jp c,l02fb ; Yeap ret l1202: pop bc pop bc pop bc ld de,l120b jp l0305 ; Error ; l120b: db 'Exponent Expected',null ; ; FRAC(X) ; l121d: ld a,h ; Test zero number or a ret z jp m,l1243 ; Got negative one l1223: bit 7,d ; Test exponent MSB ret nz ld b,d ; Get it inc b ld a,e l1229: add a,a ; Shift mantissa adc hl,hl djnz l1229 ld d,0ffh res 7,h ; Reset MSB ld e,a l1233: bit 6,h ; Check normalize bit ret nz dec d ; Fix exponent sla e ; And mantissa adc hl,hl jr nz,l1233 inc e dec e jr nz,l1233 ld d,e ; Return LSB, it's the exponent ret l1243: res 7,h ; Reset bit call l1223 ; Get fraction bit 6,h ; Test bit ret z set 7,h ; Set if positive result push hl push de ld hl,04000h ; Load 1.0 ld d,l ld e,l call l0bb2 ; Build 1.0-FRACTION ret ; ; RANDOM ; L1258: ld iy,l12c5 ; Point to seed ld a,ll12da/ll12c5 ; Init loop ld (l12da),a l1261: ld e,(iy+0) ld d,(iy+1) ld l,(iy+2) ld h,0 call l0519 ; DE:=DE DIV HL; HL:=DE MOD HL push hl ld l,(iy+3) ld h,0 call l04dc ; HL:=HL*DE ex (sp),hl ld e,(iy+4) ld d,0 call l04dc ; HL:=HL*DE pop de or a sbc hl,de jr nc,l128e ld e,(iy+5) ld d,(iy+6) add hl,de l128e: ld (iy+0),l ; Store new seed ld (iy+1),h push iy call l0d56 ; Convert to real pop iy push iy push hl push de ld l,(iy+5) ld h,(iy+6) call l0d56 ; Convert to real call l0cde ; Divide pop iy push hl push de ld de,ll12c5 add iy,de ; Position to next entry ld hl,l12da dec (hl) jr nz,l1261 pop de pop hl call l0bb2 ; Add call l0bb2 ; Add jp l121d ; Get fraction ; l12c5: db 060h,053h,0b1h,002h,0abh,03dh,076h ll12c5 equ $-l12c5 l12cc: db 023h,030h,0b0h,023h,0ach,063h,076h l12d3: db 01fh,01dh,0b2h,03fh,0aah,073h,076h ll12da equ $-l12c5 l12da: db 0 ; ; EXP(X) ; l12db: push hl push de ld hl,05c55h ; Load 1.28644 ld de,001eh call l0c68 ; Multiply push hl push de call l0dab ; Convert to integer ld (l0131),hl ; Save integer pop de pop hl call l121d ; Get fraction bit 6,h jr z,l1370 ; Zero means 1.0 call l16fc ; Subtract 0.5 exx or a ; Test result jp m,l136b jp z,l1374 ld hl,l137b l1305: ld b,(hl) ; Load +-0.25 inc hl ld c,0 push bc ld b,0feh push bc exx call l0bb2 ; Add bit 6,h ; Test zero result jr nz,l1319 ld h,040h ; Set 5.42101 E-20 ld d,0c0h l1319: exx ld c,(hl) ; Load 1.68179/1.18921 inc hl ld b,(hl) inc hl push bc ld c,(hl) inc hl ld b,0 push bc ld c,(hl) ; Load 29.1158/20.5880 inc hl ld b,(hl) inc hl push bc ld c,(hl) ld b,4 push bc exx push hl push de ld bc,lc53f ; Load -8.6547 push bc ld bc,l03d6 push bc ld bc,l63e7 ; Load 24.9764 push bc ld bc,l04dc push bc call l0cde ; Divide call l0bb2 ; Add call l0bb2 ; Add call l0cde ; Divide call l0bb2 ; Add l134f: ld a,(l0131+1) ; Test integer number or a jr z,l1362 ; Less 256 inc a jp nz,l0302 ld a,(l0131) or a jp p,l0302 ld d,a ret l1362: ld a,(l0131) or a ; Test negative jp m,l0302 ld d,a ret l136b: ld hl,l1382 ; Set table jr l1305 l1370: ld h,040h ; Set mantissa for 1.0 jr l134f l1374: ld hl,05a82h ; Set 1.41420 ld e,04fh jr l134f ; l137b: db 0c0h ; Hi mantissa byte db 0a2h,06bh,07fh ; Mantissa 1, exp=00 db 076h,074h,08ch ; Mantissa 2, exp=04 l1382: db 040h db 01bh,04ch,0f7h db 05ah,052h,012h ; ; LN(X) ; l1389: ld a,h dec a jp m,l0326 ld a,d ld (l0131),a ld d,0 ld bc,04073h ; Load 4.02823 push bc ld bc,002a1h push bc ld bc,0c4d2h ; Load -34.4107 push bc ld bc,00545h push bc push hl push de ld bc,05309h ; Load 10.3797 push bc ld bc,l0390 push bc ld bc,0c103h ; Load -8.12650 push bc ld bc,00314h push bc push hl push de ld bc,041a3h ; Load 2.05121 push bc ld bc,00189h push bc ld bc,0c43ah ; Load -0.266520 push bc ld bc,0fea0h push bc ld bc,06ccch ; Load 0.424995 push bc ld bc,0fe7ch push bc call l0bb2 ; Add call l0cde ; Divide call l0bb2 ; Add call l0bb2 ; Add call l0cde ; Divide call l0bb2 ; Add call l0bb2 ; Add call l0cde ; Divide call l0bb2 ; Add push hl push de ld a,(l0131) ld l,a ld h,0 ; Make 16 bit exponent or a jp p,l13f8 dec h l13f8: call l0d56 ; Convert exponent to real ld bc,058b9h ; Load 0.693147 push bc ld bc,0ff0ch push bc call l0c68 ; Multiply call l0bb2 ; Add ret ; ; COS(X) ; l140a: ld hl,04000h ; Return 1.0 ld d,l ld e,l ret l1410: bit 6,h ; Test zero argument jr z,l140a ; Yeap, return 1.0 ld a,d cp 0f3h ; Test range jp m,l140a call l155d ; Fix argument ld b,0 jr nz,l1426 ld b,80h call l1546 ; Fix mantissa l1426: ld a,d add a,2 ; Fix exponent ex af,af' ld a,2 jr l1442 ; ; SIN(X) ; l142e: bit 6,h ; Test zero argument ret z ; Return 0.0 if so ld a,d cp 0f3h ret m push hl call l155d ; Fix argument jr nz,l143f call l1546 ; Fix mantissa xor a l143f: ex af,af' xor a pop bc l1442: ex af,af' xor b cpl and 80h ; Extract sign ld (l0131),a ld a,d cp 0feh call z,l1546 ; Fix mantissa ex af,af' add a,a ex af,af' cp 0fdh jr nz,l145a call l1546 ; Fix mantissa l145a: cp 0fch ex af,af' add a,a ex af,af' jr nz,l1470 ex af,af' inc a ex af,af' ld bc,04000h ; Load 0.125 push bc ld b,0fdh push bc set 7,h call l0bb2 ; Add - subtract in this case l1470: ex af,af' exx ld l,a ld h,0 ld de,l1573 add hl,de ld a,(hl) ld (l0132),a exx ld (l0133),de ld (l0133+2),hl call l0c64 ; Sqr push hl push de ld bc,07a3bh ; Load 1.90986 push bc ld bc,00021h push bc ld bc,04d67h ; Load 2.41886 push bc ld bc,0157h push bc ld bc,0e144h ; Load -15.1982 push bc ld bc,000b2h push bc call l0bb2 ; Add call l0cde ; Divide call l0bb2 ; Add ld (l013b),de ; Save result ld (l013b+2),hl call l0cde ; Divide ld c,h ld a,h xor 80h ; Change sign ld h,a ld (l0137),de ; Save result ld (l0137+2),hl ld h,c push hl push de ld de,(l013b) ld hl,(l013b+2) call l0bb2 ; Add ld (l013f),de ; Save result ld (l013f+2),hl ld a,(l0132) srl a ; Check previous set up jr c,l1505 or a jr nz,l14f0 ld de,(l0133) ld hl,(l0133+2) inc d l14e7: call l1539 ; Divide old number l14ea: ld a,(l0131) or h ; Build resulting sign ld h,a ret l14f0: ld de,(l013b) ld hl,(l013b+2) push hl push de ld de,(l0137) ld hl,(l0137+2) call l0bb2 ; Add jr l14e7 l1505: ld hl,05a82h ; Load 0.707107 ld de,0ff79h push hl push de inc d or a jr nz,l1513 set 7,h l1513: push hl push de ld de,(l0137) ld hl,(l0137+2) jr nz,l1522 ld a,h xor 80h ; Toggle sign ld h,a l1522: push hl push de ld hl,(l0133+2) ld de,(l0133) call l0bb2 ; Add call l0c68 ; Multiply call l1539 ; Divide old number l1534: call l0bb2 ; Add jr l14ea ; ; Divide old number ; l1539: push hl push de ld hl,(l013f+2) ld de,(l013f) call l0cde ; Divide ret ; ; Fix mantissa ; l1546: ld a,e ; Get LSByte l1547: dec d ; Fix exponent add a,a ; Shift mantissa adc hl,hl jr z,l1557 bit 6,h ; Test zero jr z,l1547 ; Shift till set l1551: ld e,a ex af,af' inc a ex af,af' ld a,d ; Bring back exponent ret l1557: or a ; Test zero byte jr nz,l1547 ld d,a jr l1551 ; ; Fix argument ; l155d: push af res 7,h ; Make positive ld bc,0517ch ; Load 0.159155 push bc ld bc,0fdc0h push bc call l0c68 ; Multiply call l121d ; Get fraction pop af ex af,af' ld a,d inc a ; Return fixed argument ret ; l1573: db 0,1,3,2,2,3,1,0,2,3,1,0,0,1,3,2 ; ; ARCTAN(X) ; l1583:: bit 6,h ; Test zero argument ret z ; Yeap, return 0.0 ld a,h and 80h ; Extract sign ld (l0131),a res 7,h ; make number positive ld a,d or a ; Test exponent < 0 jp m,l15a9 ; Yeap ld a,2 ld (l0133),a ; Set index exx ld hl,049e6h ; Load 0.57735 ld de,0ff9dh push hl push de ld bc,0d555h ; Load -1.33331 push bc ld b,0 jr l15cc l15a9: cp 0feh ; Check range of exponent jr nc,l15b8 cp 0f3h jp c,l14ea xor a ld (l0133),a ; Reset index jr l15d9 l15b8: ld a,1 ld (l0133),a ; Set index exx ld hl,06ed9h ; Load 1.73205 ld de,000ebh push hl push de ld bc,0c000h ; Load -4,0 push bc ld b,2 l15cc: push bc push hl push de exx call l0bb2 ; Add call l0cde ; Divide call l0bb2 ; Add l15d9: push hl push de ld bc,04000h ; Load 1.0 push bc ld b,c push bc call l0c64 ; Sqr push hl push de ld bc,06000h ; Load 3.0 push bc ld b,1 push bc inc d ; Fix exponent of result inc d push hl push de dec d dec d ld b,050h ; Load 5.0 push bc ld b,2 push bc push hl push de ld bc,0638eh ; Load 0.777777 push bc ld bc,0ff39h push bc ld bc,06b15h ; Load 0.104572 push bc ld bc,0fc00h push bc call l0c68 ; Multiply call l0bb2 ; Add call l0cde ; Divide call l0bb2 ; Add call l0cde ; Divide call l0bb2 ; Add call l0cde ; Divide call l0bb2 ; Add call l0cde ; Divide ld a,(l0133) or a ; Test any to fix jr z,l1642 ; Nope push hl push de add a,a ; Get index to fix add a,a ld hl,l1645-4 ld e,a ld d,0 add hl,de ld e,(hl) ; Fetch value inc hl ld d,(hl) inc hl ld c,(hl) inc hl ld h,(hl) ld l,c call l0bb2 ; Add l1642: jp l14ea ; l1645: db 048h,0ffh,005h,043h ; 0.523599 db 048h,000h,005h,043h ; 1.0472 db 0ech,000h,087h,064h ; 1.5708 ; ; TAN(X) ; l1651: xor a ; Clear exponent jr l1693 l1654: bit 6,h ; Test zero ret z ; Return 0.0 if so ld a,d cp 0f8h ; Test range ret m ld a,h ld (l0131),a ; Save sign res 7,h ; Make positive ld bc,0517ch ; Load 0.31831 push bc ld bc,0fec1h push bc call l0c68 ; Multiply call l121d ; Get fraction call l16fc ; Subtract 0.5 ld a,(l0131) xor h xor 80h and 80h ; Extracr resulting sign ld (l0131),a res 7,h ; Force positive ld a,d add a,3 ; Test exponent jr nc,l1651 jr z,l1692 ; Test zero ld a,h cp 070h ; Test range jp nc,l1707 cp 060h ld a,2 jr c,l1693 l1692: inc a l1693: add a,a ; Build index exx ld d,0 ld e,a ld hl,l173d add hl,de ld c,0 ld b,(hl) ; Load number inc hl push bc ld b,(hl) push bc exx call l0bb2 ; Add push hl push de ld bc,04305h ; Load 0.523699 push bc ld bc,0ff49h push bc ld bc,0d4e1h ; Load -0.663146 push bc ld bc,0fff4h push bc ld bc,0c0d8h ; Load -0.253303 push bc ld bc,0fe77h push bc call l0c64 ; Sqr call l0bb2 ; Add call l0cde ; Divide call l0bb2 ; Add call l0c68 ; Multiply exx sla e ; Build another index sla e ld hl,l1745 add hl,de ld c,(hl) ; Load number #1 inc hl ld b,(hl) push bc inc hl ld c,(hl) inc hl ld b,(hl) push bc inc hl ld c,(hl) ; Load number #2 inc hl ld b,(hl) inc hl ld e,(hl) inc hl ld d,(hl) push bc push de exx call l0bb2 ; Add call l0cde ; Divide exx set 7,b push bc push de exx jp l1534 ; ; Subtract 0.5 ; l16fc: ld bc,0c000h ; Load -0.5 push bc ld b,0ffh push bc call l0bb2 ; Add ret l1707: call l16fc ; Subtract 0.5 res 7,h push hl push de call l0c64 ; Sqr ld bc,06487h ; Load 3.14159 push bc ld bc,001eeh push bc push hl push de ld bc,052aeh ; Load 10.3354 push bc ld bc,003f5h push bc ld bc,0519ah ; Load 40.8026 push bc ld bc,005f2h push bc call l0c68 ; Multiply call l0bb2 ; Add call l0c68 ; Multiply call l0bb2 ; Add call l0c68 ; Multiply jp l14ea ; ; MSB, EXPonent, rest is zero ; l173d: db 0c0h,0fch ; -6.25 E-2 db 0e0h,0fdh ; -1.875 E-1 db 0d0h,0feh ; -3.125 E-1 db 0f0h,0feh ; -4.375 E-1 ; ; NOTE: LO-HI ; l1745: db 088h,042h,03fh,000h ; 1.03957 E 0 db 0d7h,065h,0d8h,0fdh ; 1.98912 E-1 db 092h,05ch,0d9h,000h ; 1.44646 E 0 db 086h,055h,0e0h,0ffh ; 6.68179 E-1 db 0ach,067h,0adh,001h ; 3.23983 E 0 db 0c8h,05fh,064h,000h ; 1.49661 E 0 db 018h,069h,0b8h,004h ; 2.62741 E 1 db 06fh,050h,0fch,002h ; 5.02734 E 0 l1765:: .dephase ; ; ; l33ba:: call l1076 push hl call l1237 ; Insert keyboard check if requested call l140b ; Get boolean expression push hl toktst @DO,16 ; 'DO' expected call l146f ; Process statements call l1067 ; Insert 'jp xxxx' pop de ex de,hl call l10c1 ; Store word into current address ex de,hl pop de jp l10b5 ; Store word into previous address call l140b push hl toktst @THEN,15 ; 'THEN' expected call l146f ; Process statements cp @ELSE ; Test 'ELSE' jr nz,l33fd call l1067 ; Insert 'jp xxxx' ex de,hl pop hl call l10c1 ; Store word into current address dec de dec de push de call l0b1a ; Get token call l146f ; Process statements l33fd: call l1076 ; Get current program counter ex de,hl pop hl jp l10c1 ; Store word into current address call l1076 ; Get current program counter push hl call l0b1a ; Get token call l1237 ; Insert keyboard check if requested l340f: call l146f ; Process statements cp @UNTIL ; Test 'UNTIL' jr z,l341b call l0f73 ; Verify semicolon jr l340f l341b: call l140b ; Get boolean expression pop de jp l10c1 ; Store word into current address call l0b1a ; Get token l3425: call l146f ; Process statements cp @END ; Test 'END' jp z,l0b1a ; Get token call l0f73 ; Verify semicolon jr l3425 l3432: pop af ld e,57 jp l09b7 ; Variable in WITH must be RECORD type l3xx1:: call l0b1a ; Get token ld e,56 call l5829 ; Variable expected after 'WITH' exx dec hl exx call l0132 ; Insert 'ld (..),hl' db LD.@HL ld de,l0005 add hl,de ex de,hl call l10aa ; Store word call l0132 ; Insert 'jp ...' db JP@ ld de,l0004 add hl,de ex de,hl call l10aa ; Store word exx inc hl inc hl exx push af ld a,b cp 3 jr c,l3432 inc bc ld a,(bc) dec bc or a jr z,l3432 push bc ld b,h ld c,l pop hl push hl call l40d8 pop hl pop af push hl cp 0ach jr z,l348d toktst @DO,16 ; 'DO' expected call l146f ; Process statements l3483: pop hl ld bc,l0000 push af call l40d8 pop af ret l348d: call l407e ; Process WITH jr l3483 l3492: ld a,c call l5470 ld c,a ld de,l0008 add hl,de ld (hl),c inc hl ld (hl),b inc hl ld e,(hl) inc hl ld d,(hl) ld a,d or e ret z ex de,hl jr l3492 call l0b1a ; Get token ld e,60 cp 7fh jp nz,l09b7 ; Unsigned integer expected after GOTO call l101a call l0132 ; Insert 'jp ...' db JP@ call l10aa ; Store word jp l0b1a ; Get token l34bf: res 6,b push bc l34c2: call l0f9a ; Verify comma ld hl,l4127 call l106a ; Insert code pop bc push bc call l44de call l15b3 ld hl,l412f call l106a ; Insert code cp 0a9h jr nz,l34c2 pop bc jp l0b1a ; Get token rlca ld hl,(l0125) ld e,(hl) inc hl ld d,(hl) push de ld b,'*' dec h ld bc,l84cd ld b,0cdh sbc a,a rrca bit 4,(ix+2) ret z ld hl,l43ae jr l350b call l4136 call l4154 l3503: bit 4,(ix+2) ret z ld hl,l43b3 l350b: jp l106a ; Insert code ld hl,l4263 call l106a ; Insert code call l44f4 ; Test IN or relations bit 6,b jr z,l3529 call l438c call l5125 jr nz,l34bf call l0f9a ; Verify comma l3526: call l44f4 ; Test IN or relations l3529: dec b inc b jp nz,l423b dec c jr z,l3584 dec c jp z,l421c dec c jr z,l35b5 dec c jp z,l4203 ld e,19 call l09b7 ; Can't write this type of expression l3541: cp ','+MSB jp nz,l0fa7 ; Verify right parenthesis call l0b1a ; Get token jr l3526 call l0b1a ; Get token call l4139 ld hl,l4263 call l106a ; Insert code cp '('+MSB jr nz,l3577 call l0b1a ; Get token call l44f4 ; Test IN or relations bit 6,b jr z,l357f call l4432 call l438c cp 0a9h jr z,l3574 call l4169 jr l3577 l3574: call l0b1a ; Get token l3577: ld hl,l426a call l106a ; Insert code jr l3503 l357f: call l416f jr l3577 l3584: cp 0bah ld hl,l426e jr nz,l35b0 call l44c2 ld hl,l4277 cp 0bah jr nz,l35b0 call l0b1a ; Get token or a ld e,67 call nz,l09b7 ; Too many ':'s. Only e:m:h valid ld a,(l0135) cp 0c8h jr z,l35aa cp 0e8h call nz,l09b7 ; Too many ':'s. Only e:m:h valid l35aa: call l0b1a ; Get token ld hl,l427e l35b0: call l1062 ; Insert code jr l3541 l35b5: ld de,l429c ld hl,l42a3 jr l35c3 ld de,l428e ld hl,l4298 l35c3: cp 0bah jr nz,l35b0 push hl push de call l44c2 pop hl call l1062 ; Insert code pop hl l35d1: call l106a ; Insert code jr l35f2 cp 0bah jr nz,l35ec call l44c2 cp 0bah ld hl,l42a7 jr nz,l35b0 call l44c2 ld hl,l42b2 jr l35b0 l35ec: ld hl,l42ae call l105c ; Insert code l35f2: jp l4187 dec b dec b jp nz,l4182 cp 0bah jr nz,l3615 push bc call l44c2 pop de exx dec hl exx call l0132 ; Insert 'ld a,..' db LD.Ai call l156e ld hl,l4283 call l106a ; Insert code jr l3618 l3615: call l10db l3618: ld hl,l428a jr l35d1 ; Insert code ld b,'!' sbc a,h ld bc,02522h ld bc,lcd03 ex de,hl ld bc,lcd08 ld (hl),a ld (bc),a ld a,' ' call l01aa ld b,'D' ld c,l pop hl call l0240 inc b pop de call l0a97 ld b,'O' call sl02bc pop hl ld b,c inc bc call l02c9 ; Set standard disk buffer / print string ??? add hl,bc ld a,5 pop bc push bc sub b call sl02bc pop af inc bc call l02d1 ld b,'>' ld bc,lbccd ld (bc),a pop af inc bc call l01aa ld b,7dh pop de pop hl call l0f7d inc bc call l0f82 ; Floating point output inc b pop de call l0e77 l3671: call l0f9a ; Verify comma ld e,29 call l5829 ; Can't read this type of variable ld hl,l42cc call l1062 ; Insert code cp 0a9h jr nz,l3671 jp l0b1a ; Get token inc bc call l056d or a ld e,26 jp nz,l09b7 ; Variable expected in READ call l0fed ; Get symbol from table ld e,26 jp l565e ; Variable expected in READ ld hl,l4385 call l106a ; Insert code l369e:: call l42d0 bit 6,b jr z,l36b3 call l438c call l5125 jr nz,l3671 call l0f9a ; Verify comma call l42d0 l36b3: push af push hl push de xor a cp b jr nz,l36eb ld a,c dec a jr z,l36d9 dec a jr z,l36e1 dec a jr z,l36e6 l36c4: ld e,29 call l09b7 ; Can't read this type of variable l36c9: pop hl pop de pop af call l150f l36cf: cp ','+MSB jp nz,l0fa7 ; Verify right parenthesis call l0b1a ; Get token jr l369e l36d9: ld hl,l439a l36dc: call l106a ; Insert code jr l36c9 l36e1: ld hl,l43a8 jr l36dc l36e6: ld hl,l439f jr l36dc l36eb: dec b dec b jr nz,l36c4 call l10db ld hl,l43a4 call l106a ; Insert code pop de pop hl pop af jr l36cf call l0b1a ; Get token call l4139 ld hl,l4385 call l106a ; Insert code cp 0a8h jr nz,l372e call l0b1a ; Get token call l42d0 bit 6,b jr z,l372b call l4432 call l438c cp 0a9h jr z,l3726 call l42f3 jr l372e l3726: call l0b1a ; Get token jr l372e l372b: call l42f9 l372e: ld hl,l4396 call l106a ; Insert code jr l373c call l4136 call l42de l373c: jp l4149 db 6 LD HL,L0143 LD (L0125),HL ; ; ; l3746: ld hl,l4392 jp l1062 ; Insert code inc bc ld (l0125),hl inc bc call l096f inc b call l098e push hl inc b call l01a7 push af inc bc call l09e2 dec b call l10c0 push hl push de inc b ld hl,(l0125) push hl inc b pop hl ld (l0125),hl ld hl,l44a1 ld de,l44a9 jr l3780 ld hl,l449d ld de,l44a5 l3780: push hl push de call l0f9f ; Verify left parenthesis l3785: call l5827 l3788: call l0fa7 ; Verify right parenthesis pop de pop hl call l4476 ld bc,l0004 jp l1062 ; Insert code ld hl,l44b9 ld de,l019c jr l37a4 ld hl,l44ad ld de,l0143 l37a4: push hl push de call l0b1a ; Get token cp 0a8h jr z,l37b8 pop de call l10a6 ; Store "ld hl,val16" pop hl ld bc,l0004 jp l106a ; Insert code l37b8: call l0b1a ; Get token call l5827 call l4432 jr l3788 call l0b1a ; Get token cp 0a8h jr z,l37d9 ld de,l0143 call l10a6 ; Store "ld hl,val16" ld hl,l44b2 ld bc,l0004 jp l106a ; Insert code l37d9: ld hl,l44b2 push hl push hl call l0b1a ; Get token jr l3785 call l0f9f ; Verify left parenthesis ld hl,l4499 push hl jr l3823 call l4476 ret z ld e,76 jp l09b7 ; This proc/func only on textfiles ld hl,l448a ld de,l4494 jr l3803 ld hl,l4485 ld de,l448f l3803: push hl push de call l0f9f ; Verify left parenthesis call l5827 pop de pop hl call l4476 push hl exx ld c,a dec hl dec hl ld a,(hl) inc hl inc hl dec a ld a,c exx ld e,73 call z,l09b7 ; RESET, REWRITE invalid on INPUT, OUTPUT call l0f9a ; Verify comma l3823: ld bc,l020e call l44de call l0fa7 ; Verify right parenthesis pop hl jp l1062 ; Insert code bit 6,b jr z,l383a call l5125 ret z ex de,hl ret l383a: ld e,65 jp l09b7 ; Parameter should be of FILE type inc b pop de call l06dd inc b pop de call l0862 inc b pop de call l05f6 inc b pop de call l083f inc bc call l074e inc bc call l0585 inc bc call l08b8 inc bc call l0626 inc bc call l0684 inc b call l0977 push af ld b,11h dec b nop add hl,de ld a,(hl) push af ex af,af' ld (l0125),hl ld a,0ch call l01aa call l0b1a ; Get token ld bc,l0001 push bc jr l3893 ld hl,(l0172) dec h push hl call l44f4 ; Test IN or relations exx dec hl exx jr l389c push hl l3893: call l44f4 ; Test IN or relations jr l389c push bc call l44e6 ; Test IN or relations l389c: pop de jp l0f54 ; Verify same type ld hl,l0002 or a sbc hl,bc jr nz,l38ae set 0,(ix+1) jr l38b2 l38ae: res 0,(ix+1) l38b2: call l463e ; Get simple expression cp @IN jp z,l45b4 cp .NEQ ; Test comparision ret c cp .LTE+1 ret nc add a,a ; Double for index ld l,a ld h,0 push hl push bc call l463b ; Get simple expression ld e,a ld a,b or a jr nz,l3921 ld a,c dec a jr z,l390e dec a ld a,e jr nz,l3905 pop bc call l11e1 exx dec hl exx bit 0,c jr z,l38fb ld hl,l4747 call l1062 ; Insert code call l0132 ; Insert 'nop' db NOOP pop hl ; Get back comparison code push hl ld e,a ld a,l cp 2*.GT ; Test <> or = jr c,l38fa ; Yeap ld l,2 ; Else change index sub l ; ... swap < and > xor l ; ... also <= and >= add a,l ld l,a ex (sp),hl l38fa: ld a,e ; ; Real comparision ; l38fb: ld bc,l13f3-2*.NEQ l38fe: pop hl call l45e5 jp l1062 ; Insert code ; ; Character comparision ; l3905: pop de call l0f54 ; Verify same type ld bc,l13db-2*.NEQ jr l38fe ; ; Integer comparision ; l390e: ld a,e pop de call l0f54 ; Verify same type bit 4,(ix+0) ; Test make integer check ld bc,l13c3-2*.NEQ jr z,l38fe ; Nope ld bc,l13cf-2*.NEQ jr l38fe ; ; ??? comparision ; l3921: ld a,e pop de call l0f54 ; Verify same type bit 7,d jr nz,l395e dec d jr z,l393e dec d jr nz,l3953 call l10db ld hl,l12e3 call l106a ; Insert code ld bc,l13e7-2*.NEQ jr l38fe ; ; Set comparision ; l393e: pop hl ld e,a ld a,l cp 2*.GT jr z,l3959 cp 2*.LT ld a,e jr z,l395a ld bc,l13ff-2*.NEQ call l45e5 jp l1048 ; Insert code l3953: ld e,27 ; Cannot compare expressions of this type l3955: pop hl l3956: jp l09b7 l3959: ld a,e l395a: ld e,49 jr l3956 ; '<' and '>' can't be used with sets ; ; Pointer comparision, = and <> only ; l395e: ld e,a pop hl push hl ld a,l cp 2*.GT ld bc,l13c3-2*119 ld a,e jr c,l38fe ld e,64 jr l3955 ; Can only use equality tests on pointers call l4caa exx dec hl exx jr c,l397a call l0132 ; Insert 'ld a,l' db LD.A.L l397a: ld hl,l45ef call l106a ; Insert code push bc call l463b ; Get simple expression pop de call l0f54 ; Verify same type ld hl,l45f3 call l106a ; Insert code ld c,a ld hl,(l0174) ld h,0 inc l call l4600 ld a,c call l0132 ; Insert 'push af' db PUSH.AF jr l39a5 add hl,bc ld e,(hl) inc hl ld d,(hl) inc hl ex de,hl l39a5: ld bc,l0004 ret inc bc ld (l0132),a inc c ld a,(l0132) call l09f7 and (hl) neg ld a,0 rla ld a,h or a jr nz,l39d4 ld a,l cp 6 jr nc,l39d4 srl a jr nc,l39cc call l0132 ; Insert 'inc sp' db INC.SP or a l39cc: ret z call l0132 ; Insert 'pop hl' db POP.HL dec a jr l39cc l39d4: call l10a5 ; Store "ld hl,val16" call l0132 ; Insert 'add hl,sp' db AD.HLSP call l0132 ; Insert 'ld sp,hl' db LD.SPHL ret call l4797 ; Get term call l11e1 bit 0,c ld hl,l4714 jr nz,l3a23 ld hl,l4719 call l105c ; Insert code jr l3a0c call l0b1a ; Get token cp 0adh jp z,l4626 cp 0abh jr nz,l3a09 call l4797 ; Get term call l11e1 jr l3a0c l3a09: call l479a ; Get term l3a0c: cp 0abh jr z,l3a28 cp 0adh jr z,l3a28 cp 7 ret nz call l0f4c ; Verify ??? type call l4797 ; Get term call l0f4c ; Verify ??? type ld hl,l4738 l3a23: call l1062 ; Insert code jr l3a0c l3a28: dec b jp z,l46e5 inc b call l11e1 ld b,a push bc call l4797 ; Get term call l11e1 bit 0,c pop bc jr nz,l3a60 exx dec hl dec hl exx bit 2,b jr z,l3a4b ld hl,l473c call l106a ; Insert code l3a4b: bit 0,c jr z,l3a55 ld hl,l4747 call l106a ; Insert code l3a55: ld hl,l474d ld bc,l0002 call l106a ; Insert code jr l3a0c l3a60: push af xor a call l4780 jr z,l3a81 bit 2,b jr z,l3a70 ex de,hl ld l,a ld h,a sbc hl,de l3a70: bit 1,(ix+0) ; Test overflow check (set is so) call l4753 l3a77: pop af call l0132 ; Insert 'push hl' db PUSH.HL ld bc,l0001 jr l3a0c l3a81: bit 2,b jr nz,l3a8e bit 1,(ix+0) ; Test overflow check (set is so) call l4775 jr l3a77 l3a8e: bit 1,(ix+0) ; Test overflow check ld hl,l472b jr nz,l3a9a ; Yeap ld hl,l4733 l3a9a: call l106a ; Insert code jr l3a77 push af inc b push bc call l4797 ; Get term pop de call l0f54 ; Verify same type pop de bit 2,d ld hl,l470a jr nz,l3ab4 ld hl,l4700 l3ab4: call l1048 ; Insert code jp l4652 add hl,bc ld hl,l00b6 ; or (hl);nop ld (l0a43),hl call l0a36 add hl,bc ld hl,la62f ; cpl;and (hl) ld (l0a43),hl call l0a36 inc b call l0511 push hl ld a,(bc) bit 6,h jr z,l3adc ld a,80h xor h ld h,a l3adc: push hl push de ld b,0b7h adc hl,de call pe,l0302 rlca ex de,hl or a sbc hl,de call pe,l0302 inc b ex de,hl or a sbc hl,de inc bc pop bc or b push af inc b ld a,80h xor h ld h,a dec b call l0d56 ; Convert to real push hl push de dec b ex (sp),hl push de call l0d56 ; Convert to real dec b call l0bb2 push hl push de push af ld a,h or a jr nz,l3b23 ld a,l ld e,'#' l3b15: cp 5 jr nc,l3b2b pop bc or a ret z ld b,a l3b1d: call l156e djnz l3b1d ret l3b23: inc a jr nz,l3b2b sub l ld e,'+' jr nz,l3b15 l3b2b: call l1098 ; Store "ld de,val16" pop af ld hl,l4724 jp nz,l106a ; Insert code call l0132 ; Insert 'add hl,de' db AD.HLDE ret bit 3,(ix+2) exx dec hl jr z,l3b4c dec hl ld d,(hl) dec hl ld e,(hl) dec hl dec hl push de exx pop hl ret l3b4c: ld (hl),0d1h inc hl exx ret call l0b1a ; Get token call l4998 ; Get factor l3b57: cp 0aah jr z,l3bc9 cp 2 jr z,l3b7b cp 9 jr z,l3b7b cp 0afh jr z,l3baa cp 8 ret nz call l0f4c ; Verify ??? type call l4995 ; Get factor call l0f4c ; Verify ??? type ld hl,l48b2 call l1062 ; Insert code jr l3b57 l3b7b: call l0f51 ; Verify constant type push af call l4995 ; Get factor call l0f51 ; Verify constant type call l4780 jr z,l3b92 ex de,hl call l0132 ; Insert 'ex de,hl' db EX.DEHL call l10a6 ; Store "ld hl,val16" l3b92: pop de bit 0,d ld hl,l48ae ; Set MOD jr nz,l3b9d ld hl,l48a9 ; Set DIV l3b9d: call l106a ; Insert code l3ba0: call l0132 ; Insert 'push hl' db PUSH.HL res 3,(ix+2) jr l3b57 l3baa: call l11e1 bit 0,c jr z,l3bbb ld hl,l4741 call l1062 ; Insert code set 0,(ix+1) l3bbb: call l4995 ; Get factor call l11e1 ld hl,l48b6 call l105c ; Insert code jr l3b57 l3bc9: push bc dec b jr z,l3bf3 inc b call l11e1 call l4995 ; Get factor call l11e1 bit 0,c pop de jr nz,l3c02 exx dec hl dec hl exx bit 0,e jr z,l3bea ld hl,l4747 call l106a ; Insert code l3bea: ld hl,l48bc call l106a ; Insert code l3bf0: jp l479d l3bf3: call l4995 ; Get factor pop de call l0f54 ; Verify same type ld hl,l489b call l1048 ; Insert code jr l3bf0 l3c02: call l4780 ex de,hl ld hl,l48a5 ; Set code for integer * jr z,l3b9d push af push bc call l485a pop bc pop af jr l3ba0 push hl ld a,d or a jr nz,l3c45 ld a,e cp 11h jr nc,l3c45 or a jr z,l3c45 cp 1 pop hl ret z push hl exx push hl exx ld c,0feh l3c2b: srl a jr z,l3c4c jr nc,l3c3c inc c jr z,l3c42 call l0132 ; Insert 'ld d,h' db LD.D.H call l0132 ; Insert 'ld e,l' db LD.E.L l3c3c: call l0132 ; Insert 'add hl,hl' db AD.HLHL jr l3c2b l3c42: exx pop hl exx l3c45: call l1099 ; Store "ld de,val16" pop hl jp l106a ; Insert code l3c4c: pop hl pop hl inc c ret nz call l0132 ; Insert 'add hl,de' db AD.HLDE ret add hl,bc ld hl,l00a6 ; and (hl);nop ld (l0a43),hl call l0a36 inc bc call l04dc inc b call l0519 ex de,hl inc bc call l0519 inc bc pop bc and b push af dec b call l0cde push hl push de dec b call l0c68 push hl push de ld a,(l016b) push af push bc ld e,(hl) inc hl ld d,(hl) inc hl push de ld e,(hl) inc hl ld d,(hl) push de inc hl ld b,(hl) call l0b1a ; Get token dec b jr z,l3ca7 call l0fa2 ; Verify left parenthesis jr l3c9a l3c97: call l0f9a ; Verify comma l3c9a: push bc call l44c5 pop bc djnz l3c97 call l4af8 exx dec hl exx l3ca7: pop hl pop de bit 1,(ix+0) ; Test overflow check jr z,l3cb0 ; Nope ex de,hl l3cb0: pop bc pop de ld (ix+1),d call l106a ; Insert code ld hl,l0001 or a sbc hl,bc ret nz jp l4b8b ld a,(l016b) push af call l0f9f ; Verify left parenthesis call l44f4 ; Test IN or relations call l1246 call l4af8 dec c pop de ld (ix+1),d ret call l4908 jr z,l3ce4 ld hl,l494b ld c,b l3ce1: call l1062 ; Insert code l3ce4: jp l4b8a call l4908 jr z,l3cf3 ld hl,l4953 l3cef: inc c jp l1062 l3cf3: ld hl,l4959 jr l3ce1 call l4908 ld hl,l4950 jr nz,l3cef ld hl,l4956 jr l3ce1 inc b ld l,a ld h,0 push hl ld (bc),a inc a push af ld (bc),a dec a push af ld (bc),a inc hl push hl ld (bc),a dec hl push hl call l0f9f ; Verify left parenthesis ld hl,l59fb call l106a ; Insert code l3d1f: call l117a ; Get constant ld c,a ld a,l call l1081 ; Store byte ld a,c cp 0ach jr z,l3d35 ld hl,l59ff call l106a ; Insert code jp l0fa7 ; Verify right parenthesis l3d35: call l0b1a ; Get token jr l3d1f l3d3a: call l4995 ; Get factor call l0f4c ; Verify ??? type ld hl,l4c3b jp l1062 ; Insert code l3d46: call l0b1a ; Get token call l44f8 ; Test IN or relations jp l4af8 call l0b1a ; Get token res 3,(ix+2) or a jr z,l3da9 cp 76h jr z,l3d8e cp 75h jr z,l3d96 cp 0a8h jr z,l3d46 cp 0dbh jp z,l4cd8 cp '"' jp z,l4a47 set 3,(ix+2) cp 7fh ld hl,(l0143) jr z,l3de0 ld de,(l0141) cp 7eh jr z,l3de9 cp 6 jr z,l3d3a ld e,12 call l09b7 ; Factor expected jp l114c l3d8e: ld a,(l0143) ld bc,l0003 jr l3dc9 l3d96: ld de,(l0143) ld a,(l0141) ld c,a ld b,2 l3da0: ld l,c ld h,0 ld (l0170),hl jp l4a52 l3da9: call l0fed ; Get symbol from table cp 1 ret m jp nz,l4aad set 3,(ix+2) ld e,(hl) inc hl ld d,(hl) ld a,b or a jr nz,l3da0 ld a,c dec a jr z,l3ddf dec a jr z,l3e11 ld a,d ld (l0175),a ld a,e l3dc9: or a jr z,l3dd9 call l0132 ; Insert 'ld a,..' db LD.Ai call l1081 l3dd3: call l0132 ; Insert 'push af' db PUSH.AF jr l3dfe l3dd9: call l0132 ; Insert 'xor a' db XOR.A jr l3dd3 l3ddf: ex de,hl l3de0: bit 0,(ix+1) jr z,l3e08 call l4c1a l3de9: ex de,hl push hl l3deb: ex de,hl l3dec: ex (sp),hl call l1098 ; Store "ld de,val16" pop de call l10a6 ; Store "ld hl,val16" call l4bad ld bc,l0002 set 0,(ix+1) l3dfe: jp l0b1a ; Get token ld bc,l8000 ld d,c ld e,c jr l3e0c l3e08: ld bc,l0001 ex de,hl l3e0c: call l5842 jr l3dfe l3e11: push de inc hl ld e,(hl) inc hl ld d,(hl) jr l3deb l3e18: ld a,(l016b) ld d,a push bc ex (sp),hl ld c,(hl) inc hl ld b,(hl) pop hl ld a,c bit 7,b jr z,l3e29 ld a,1 l3e29: push bc push de ld c,a l3e2c: ; *** ADDRESS OF DISK BUFFER push bc push hl dec a ld hl,l4c61 jr z,l3e3d dec a ld hl,l4c63 jr z,l3e3d ld hl,l4c4b l3e3d: call l106a ; Insert code pop hl call l162c pop bc pop de ld (ix+1),d dec c jr nz,l3e54 ld hl,l4c3f call l106a ; Insert code pop bc ret l3e54: dec c jr z,l3e5c ld hl,l4c42 jr l3e63 l3e5c: ld hl,l4c46 set 0,(ix+1) l3e63: pop bc jp l106a ; Insert code cp 9 jp z,l48c2 cp 0ah jp z,l4b5a jp nc,l4aff cp 7 jp z,l1463 cp 5 jr z,l3e18 jp l4b5a l3e80: push bc set 0,(ix+1) call l4aef exx dec hl dec hl exx call l0132 db CAL ; Insert 'call ...' pop de call l10aa jp l4bad l3e97: ld a,(l016b) push af call l4ac6 pop de ld (ix+1),d dec c exx dec hl exx jp l4b8b call l0f9f ; Verify left parenthesis l3eac: l3ead equ l3eac+1 ; *** ADDRESS OF INCLUDE DISK BUFFER call l44f8 ; Test IN or relations call l11e1 res 3,(ix+2) jp l0fa7 ; Verify right parenthesis cp 0ch jr c,l3e80 jr z,l3e97 cp 0fh jp z,l4b5a push bc ld e,(hl) inc hl ld d,(hl) push de call l4aef bit 0,c pop de pop hl jp nz,l1062 ; Insert code ex de,hl jp l105c ; Insert code call l0f9a ; Verify comma ld hl,l0182 push hl call l5145 pop hl ld c,(hl) inc hl ld b,(hl) ret ld a,(l016b) push af call l0f9f ; Verify left parenthesis call l44c5 pop de ld (ix+1),d call l4b1d call l4af8 inc hl call l584f ld d,0 jr l3f19 l3f02: push bc ld c,1 call l4b68 pop bc ret l3f0a: exx dec hl exx ld hl,l16cb inc b jp l1048 ; Insert code ld e,12 call l565e ; Factor expected l3f19: bit 7,b jr nz,l3f02 dec b jr z,l3f0a inc b ret nz dec d jp m,l4bfd ex de,hl jr nz,l3f70 dec c jr z,l3f3d dec c l3f2d: ; *** 0 FOR FORCING READ FROM FILE l3f2e equ l3f2d+1 ; *** ADDRESS OF LINE (LENGTH 80, 50H) jr z,l3f51 call l0132 ; Insert 'ld a,(...)' db LD.A@ call l10aa ; Store word l3f36: inc c call l0132 ; Insert 'push af' db PUSH.AF inc c ret l3f3d: call l109f ; Store "ld hl,(val16)" l3f40: call l0132 ; Insert 'push hl' db PUSH.HL inc c bit 0,(ix+1) ret z inc c ld hl,l4741 jp l1062 ; Insert code l3f51: call l0132 ; Insert 'ld de,(...)' db HIGH LD.DE@ call l0132 db LOW LD.DE@ call l10aa ; Store word inc de inc de call l109f ; Store "ld hl,(val16)" l3f61: set 0,(ix+1) inc c inc c call l0132 ; Insert 'push hl' db PUSH.HL call l0132 ; Insert 'push de' db PUSH.DE ret l3f70: ld d,HIGH LD.L_IX ; Init word as prefix call l0132 ; Insert prefix... db HIGH LD.L_IX dec c jr z,l3f85 dec c jr z,l3f96 call l0132 ; Insert 'ld a,(ix+..)' db LOW LD.A_IX l3f80: call l156e jr l3f36 l3f85: call l0132 ; Insert 'ld l,(ix+..)' db LOW LD.L_IX call l10aa ; Store word: offset and prefix inc e ; Update offset call l0132 ; Insert 'ld h,(ix+..+1)' db LOW LD.H_IX call l156e jr l3f40 l3f96: call l0132 ; Insert 'ld e,(ix+..)' db LOW LD.E_IX call l10aa ; Store word: offset and prefix inc e ; Update offset call l0132 ; Insert 'ld d,(ix+..+1)' db LOW LD.D_IX call l10aa ; Store word: offset and prefix inc e ; Update offset call l0132 ; Insert 'ld l,(ix+..+2)' db LOW LD.L_IX call l10aa ; Store word: offset and prefix inc e ; Update offset call l0132 ; Insert 'ld h,(ix+..+3)' db LOW LD.H_IX call l156e jr l3f61 dec c jr z,l3fc2 dec c jr z,l3fc8 ld hl,l4c4d jr l3fcf l3fc2: ld hl,l4c50 jp l4927 l3fc8: ld hl,l4c56 set 0,(ix+1) l3fcf: inc c inc c jp l1062 ; Insert code ld a,80h and h jr z,l3fe0 ex de,hl ld hl,l0000 sbc hl,de or a l3fe0: ld de,l0000 adc hl,de ret z ld d,0eh l3fe8: bit 6,h jr nz,l3ff0 add hl,hl dec d jr l3fe8 l3ff0: ld e,0 or h ld h,a ret inc bc xor 1 push af ld (bc),a pop hl push hl inc bc dec sp pop af push af ; ; Statement WHILE ; l4000: call l1076 ; Get current program counter l4003: push hl ; Save current PC call l1237 ; Insert keyboard check if requested call l140b ; Get boolean expression push hl ; Save current PC toktst @DO,16 ; 'DO' expected call l146f ; Process statements call l1067 ; Insert 'jp xxxx' pop de ; Get PC ex de,hl call l10c1 ; Store word into current address ex de,hl pop de ; Get PC jp l10b5 ; Store word into previous address ; ; Statement IF ; l4021: call l140b ; Get boolean expression push hl toktst @THEN,15 ; 'THEN' expected call l146f ; Process statements cp @ELSE ; Test ELSE jr nz,l4043 call l1067 ; Insert 'jp xxxx' ex de,hl pop hl call l10c1 ; Store word into current address dec de dec de push de call l0b1a ; Get token call l146f ; Process statements l4043: call l1076 ; Get current program counter ex de,hl pop hl jp l10c1 ; Store word into current address ; ; Statement REPEAT ; l404b: call l1076 ; Get current program counter push hl ; Save it call l0b1a ; Get token call l1237 ; Insert keyboard check if requested l4055: call l146f ; Process statements cp @UNTIL ; Loop till UNTIL found jr z,l4061 call l0f73 ; Verify semicolon jr l4055 ; Process next statement l4061: call l140b ; Get boolean expression pop de ; Get back PC jp l10c1 ; Store word into current address ; ; Statement BEGIN ; l4068: call l0b1a ; Get token l406b: call l146f ; Process statements cp @END ; Test END jp z,l0b1a ; Get token if so call l0f73 ; Verify semicolon jr l406b ; End try next ; ; Statement WITH ; l4078: pop af ld e,57 jp l09b7 ; Variable in WITH must be RECORD type l407e: call l0b1a ; Get token ld e,56 call l5829 ; Variable expected after 'WITH' exx dec hl exx call l0132 ; Insert 'ld (...),hl' db LD.@HL ld de,l0005 add hl,de ex de,hl call l10aa ; Store word call l0132 ; Insert 'jp ...' db JP@ ld de,l0004 add hl,de ex de,hl call l10aa ; Store word exx inc hl inc hl exx push af ld a,b cp 3 jr c,l4078 inc bc ld a,(bc) dec bc or a jr z,l4078 push bc ld b,h ld c,l pop hl push hl call l40d8 pop hl pop af push hl cp ','+MSB ; Test more jr z,l40d3 toktst @DO,16 ; 'DO' expected call l146f ; Process statements l40c9: pop hl ld bc,l0000 push af call l40d8 pop af ret l40d3: call l407e ; Process WITH jr l40c9 l40d8: ld a,c call l5470 ld c,a ld de,l0008 add hl,de ld (hl),c inc hl ld (hl),b inc hl ld e,(hl) inc hl ld d,(hl) ld a,d or e ret z ex de,hl jr l40d8 ; ; Statement GOTO ; l40ee: call l0b1a ; Get token ld e,60 cp 127 jp nz,l09b7 ; Unsigned integer expected after GOTO call l101a call l0132 ; Insert 'jp ...' db JP@ call l10aa ; Store word jp l0b1a ; Get token l4105: res 6,b push bc l4108: call l0f9a ; Verify comma ld hl,l4127 call l106a ; Insert code pop bc push bc call l44de call l15b3 ld hl,l412f call l106a ; Insert code cp 0a9h jr nz,l4108 pop bc jp l0b1a ; Get token ; ; ; l4127: db 7 LD HL,(L0125) LD E,(HL) INC HL LD D,(HL) PUSH DE ; ; ; l412f: db 6 LD HL,(L0125) CALL L0684 ; ; ; l4136: call l0f9f ; Verify left parenthesis l4139: bit 4,(ix+2) ret z ld hl,l43ae jr l4151 ; ; WRITE ; l4143: call l4136 call l4154 l4149: bit 4,(ix+2) ret z ld hl,l43b3 l4151: jp l106a ; Insert code l4154: ld hl,l4263 call l106a ; Insert code call l44f4 ; Test IN or relations bit 6,b jr z,l416f call l438c call l5125 jr nz,l4105 l4169: call l0f9a ; Verify comma l416c: call l44f4 ; Test IN or relations l416f: dec b inc b jp nz,l423b dec c jr z,l41ca dec c jp z,l421c dec c jr z,l41fb dec c jp z,l4203 l4182: ld e,19 call l09b7 ; Can't write this type of expression l4187: cp ','+MSB jp nz,l0fa7 ; Verify right parenthesis call l0b1a ; Get token jr l416c ; ; WRITELN ; l4191: call l0b1a ; Get token call l4139 ld hl,l4263 call l106a ; Insert code cp 0a8h jr nz,l41bd call l0b1a ; Get token call l44f4 ; Test IN or relations bit 6,b jr z,l41c5 call l4432 call l438c cp 0a9h jr z,l41ba call l4169 jr l41bd l41ba: call l0b1a ; Get token l41bd: ld hl,l426a call l106a ; Insert code jr l4149 l41c5: call l416f jr l41bd l41ca: cp 0bah ld hl,l426e jr nz,l41f6 call l44c2 ld hl,l4277 cp 0bah jr nz,l41f6 call l0b1a ; Get token or a ld e,67 call nz,l09b7 ; Too many ':'s. Only e:m:h valid ld a,(l0135) cp 0c8h jr z,l41f0 cp 0e8h call nz,l09b7 ; Too many ':'s. Only e:m:h valid l41f0: call l0b1a ; Get token ld hl,l427e l41f6: call l1062 ; Insert code jr l4187 l41fb: ld de,l429c ld hl,l42a3 jr l4209 l4203: ld de,l428e ld hl,l4298 l4209: cp 0bah jr nz,l41f6 push hl push de call l44c2 pop hl call l1062 ; Insert code pop hl l4217: call l106a ; Insert code jr l4238 l421c: cp 0bah jr nz,l4232 call l44c2 cp 0bah ld hl,l42a7 jr nz,l41f6 call l44c2 ld hl,l42b2 jr l41f6 l4232: ld hl,l42ae call l105c ; Insert code l4238: jp l4187 l423b: dec b dec b jp nz,l4182 cp 0bah jr nz,l425b push bc call l44c2 pop de exx dec hl exx call l0132 ; Insert 'ld a,..' db LD.Ai call l156e ld hl,l4283 call l106a ; Insert code jr l425e l425b: call l10db l425e: ld hl,l428a jr l4217 ; Insert code ; ; ; l4263: db 6 LD HL,L019C LD (L0125),HL ; ; ; l426a: db 3 CALL L01EB ; ; ; l426e: db 8 CALL L0277 LD A,' ' CALL L01AA ; ; ; l4277: db 6 LD B,H LD C,L POP HL CALL SL0240 ; ; ; l427e: db 4 POP DE CALL L0A97 ; ; ; l4283: db 6 LD C,A CALL SL02BC POP HL LD B,C ; ; ; l428a: db 3 CALL SL02C9 ; ; ; l428e: db 9 LD A,5 POP BC PUSH BC SUB B CALL SL02BC POP AF ; ; ; l4298: db 3 CALL L02D1 ; ; ; l429c: db 6 LD A,1 CALL SL02BC POP AF ; ; ; l42a3: db 3 CALL L01AA ; ; ; l42a7: db 6 LD A,L POP DE POP HL CALL L0F7D ; ; Code for Floating point output ; l42ae: db 3 CALL L0F82 ; ; ; l42b2: db 4 POP DE CALL L0E77 ; ; ; l42b7: call l0f9a ; Verify comma ld e,29 call l5829 ; Can't read this type of variable ld hl,l42cc call l1062 ; Insert code cp 0a9h jr nz,l42b7 jp l0b1a ; Get token ; ; ; l42cc: db 3 CALL L056D ; ; ; l42d0: or a ld e,26 jp nz,l09b7 ; Variable expected in READ call l0fed ; Get symbol from table ld e,26 jp l565e ; Variable expected in READ l42de: ld hl,l4385 call l106a ; Insert code l42e4: call l42d0 bit 6,b jr z,l42f9 call l438c call l5125 jr nz,l42b7 l42f3: call l0f9a ; Verify comma call l42d0 l42f9: push af push hl push de xor a cp b jr nz,l4331 ld a,c dec a jr z,l431f dec a jr z,l4327 dec a jr z,l432c l430a: ld e,29 call l09b7 ; Can't read this type of variable l430f: pop hl pop de pop af call l150f l4315: cp ','+MSB jp nz,l0fa7 ; Verify right parenthesis call l0b1a ; Get token jr l42e4 l431f: ld hl,l439a l4322: call l106a ; Insert code jr l430f l4327: ld hl,l43a8 jr l4322 l432c: ld hl,l439f jr l4322 l4331: dec b dec b jr nz,l430a call l10db ld hl,l43a4 call l106a ; Insert code pop de pop hl pop af jr l4315 ; ; READLN ; l4343:: call l0b1a ; Get token call l4139 ld hl,l4385 call l106a ; Insert code cp 0a8h jr nz,l4374 call l0b1a ; Get token call l42d0 bit 6,b jr z,l4371 call l4432 call l438c cp 0a9h jr z,l436c call l42f3 jr l4374 l436c: call l0b1a ; Get token jr l4374 l4371: call l42f9 l4374: ld hl,l4396 call l106a ; Insert code jr l4382 ; ; READ ; l437c: call l4136 call l42de l4382: jp l4149 ; ; ; l4385: db 6 LD HL,L0143 LD (L0125),HL l438c: ld hl,l4392 jp l1062 ; Insert code ; ; ; l4392: db 3 LD (L0125),HL ; ; ; l4396: db 3 CALL L096F ; ; ; l439a: db 4 CALL L098E PUSH HL ; ; ; l439f: db 4 CALL L01A7 PUSH AF ; ; ; l43a4: db 3 CALL L09E2 ; ; Code for floating point input ; l43a8: db 5 CALL L10C0 PUSH HL PUSH DE ; ; ; l43ae: db 4 LD HL,(L0125) PUSH HL ; ; ; l43b3: db 4 POP HL LD (L0125),HL ; ; PUT ; l43b8:: ld hl,l44a1 ld de,l44a9 jr l43c6 ; ; GET ; l43c0: ld hl,l449d ld de,l44a5 l43c6: push hl push de call l0f9f ; Verify left parenthesis l43cb: call l5827 l43ce: call l0fa7 ; Verify right parenthesis pop de pop hl call l4476 ld bc,l0004 jp l1062 ; Insert code ; ; PAGE ; l43dc: ld hl,l44b9 ld de,l019c jr l43ea ; ; EOLN ; l43e4: ld hl,l44ad ld de,l0143 l43ea: push hl push de call l0b1a ; Get token cp '('+MSB jr z,l43fe pop de call l10a6 ; Store "ld hl,val16" pop hl ld bc,l0004 jp l106a ; Insert code l43fe: call l0b1a ; Get token call l5827 call l4432 jr l43ce ; ; EOF ; l4409: call l0b1a ; Get token cp '('+MSB ; Test parameter follows jr z,l441f ld de,l0143 call l10a6 ; Store "ld hl,val16" ld hl,l44b2 ld bc,l0004 jp l106a ; Insert code l441f: ld hl,l44b2 push hl push hl call l0b1a ; Get token jr l43cb ; ; CHAIN ; l4429: call l0f9f ; Verify left parenthesis ld hl,l4499 push hl jr l4469 ; ; ; l4432: call l4476 ret z ld e,76 jp l09b7 ; This proc/func only on textfiles ; ; REWRITE ; l443b: ld hl,l448a ld de,l4494 jr l4449 ; ; RESET ; l4443: ld hl,l4485 ld de,l448f l4449: push hl push de call l0f9f ; Verify left parenthesis call l5827 pop de pop hl call l4476 push hl exx ld c,a dec hl dec hl ld a,(hl) inc hl inc hl dec a ld a,c exx ld e,73 call z,l09b7 ; RESET, REWRITE invalid on INPUT, OUTPUT call l0f9a ; Verify comma l4469: ld bc,l020e call l44de call l0fa7 ; Verify right parenthesis pop hl jp l1062 ; Insert code l4476: bit 6,b jr z,l4480 call l5125 ret z ex de,hl ret l4480: ld e,65 jp l09b7 ; Parameter should be of FILE type ; ; ; l4485: db 4 POP DE CALL L06DD ; ; ; l448a: db 4 POP DE CALL L0862 ; ; ; l448f: db 4 POP DE CALL L05F6 ; ; ; l4494: db 4 POP DE CALL L083F ; ; ; l4499: db 3 call l074e ; ; ; l449d: db 3 CALL L0585 ; ; ; l44a1: db 3 CALL L08B8 ; ; ; l44a5: db 3 CALL L0626 ; ; ; l44a9: db 3 CALL L0684 ; ; ; l44ad: db 4 CALL L0977 PUSH AF ; ; ; l44b2: db 6 LD DE,L0005 ADD HL,DE LD A,(HL) PUSH AF ; ; ; l44b9: db 8 LD (L0125),HL LD A,0CH CALL L01AA ; ; ; l44c2: call l0b1a ; Get token l44c5: ld bc,l0001 ; ; ; l44c8: push bc jr l44d9 l44cb: ld hl,(l0172) dec h push hl call l44f4 ; Test IN or relations exx dec hl exx jr l44e2 l44d8: push hl l44d9: call l44f4 ; Test IN or relations jr l44e2 ; ; Verify same type in reg BC ; l44de: push bc call l44e6 ; Test IN or relations l44e2: pop de jp l0f54 ; Verify same type ; ; Test IN or relations ; l44e6: ld hl,l0002 or a sbc hl,bc jr nz,l44f4 set 0,(ix+1) jr l44f8 l44f4: res 0,(ix+1) l44f8: call l463e ; Get simple expression cp @IN ; Test IN jp z,l45b4 cp .NEQ ; Test comparision ret c cp .LTE+1 ret nc add a,a ld l,a ld h,0 push hl push bc call l463b ; Get simple expression ld e,a ld a,b or a jr nz,l4567 ld a,c dec a jr z,l4554 dec a ld a,e jr nz,l454b pop bc call l11e1 exx dec hl exx bit 0,c jr z,l4541 ld hl,l4747 call l1062 ; Insert code call l0132 ; Insert 'nop' db NOOP pop hl ; Get back comparison code push hl ld e,a ld a,l cp 2*.GT ;;0f2h jr c,l4540 ld l,2 sub l ; ... swap < and > xor l ; ... also <= and >= add a,l ld l,a ex (sp),hl l4540: ld a,e ; ; Real comparision ; l4541: ld bc,l13f3-2*.NEQ l4544: pop hl call l45e5 jp l1062 ; Insert code ; ; Character comparision ; l454b: pop de call l0f54 ; Verify same type ld bc,l13db-2*.NEQ jr l4544 ; ; Integer comparision ; l4554: ld a,e pop de call l0f54 ; Verify same type bit 4,(ix+0) ; Test make integer check ld bc,l13c3-2*.NEQ jr z,l4544 ; Nope ld bc,l13cf-2*.NEQ jr l4544 ; ; ??? comparision ; l4567: ld a,e pop de call l0f54 ; Verify same type bit 7,d jr nz,l45a4 dec d jr z,l4584 dec d jr nz,l4599 call l10db ld hl,l12e3 call l106a ; Insert code ld bc,l13e7-2*.NEQ jr l4544 ; ; Set comparision ; l4584: pop hl ld e,a ld a,l cp 2*.GT jr z,l459f cp 2*.LT ld a,e jr z,l45a0 ld bc,l13ff-2*.NEQ call l45e5 jp l1048 ; Insert code l4599: ld e,27 ; Cannot compare expressions of this type l459b: pop hl l459c: jp l09b7 ; Process error l459f: ld a,e l45a0: ld e,49 jr l459c ; '<' and '>' can't be used with sets ; ; Pointer comparision, = and <> only ; l45a4: ld e,a pop hl push hl ld a,l cp 2*.GT ld bc,l13c3-2*.NEQ ld a,e jr c,l4544 ld e,64 jr l459b ; Can only use equality tests on pointers ; ; ; l45b4: call l4caa exx dec hl exx jr c,l45c0 call l0132 ; Insert 'ld a,l' db LD.A.L l45c0: ld hl,l45ef call l106a ; Insert code push bc call l463b ; Get simple expression pop de call l0f54 ; Verify same type ld hl,l45f3 call l106a ; Insert code ld c,a ld hl,(l0174) ld h,0 inc l call l4600 ld a,c call l0132 ; Insert 'push af' db PUSH.AF jr l45eb ; ; ; l45e5: add hl,bc ld e,(hl) inc hl ld d,(hl) inc hl ex de,hl l45eb: ld bc,l0004 ret ; ; ; l45ef: db 3 LD (L0132),A ; ; ; l45f3: db 12 LD A,(L0132) CALL L09F7 AND (HL) NEG LD A,0 RLA ; ; ; l4600: ld a,h or a jr nz,l461a ld a,l cp 6 jr nc,l461a srl a jr nc,l4612 call l0132 ; Insert 'inc sp' db INC.SP or a l4612: ret z call l0132 ; Insert 'pop hl' db POP.HL dec a jr l4612 l461a: call l10a5 ; Store "ld hl,val16" call l0132 ; Insert 'add hl,sp' db AD.HLSP call l0132 ; Insert 'ld sp,hl' db LD.SPHL ret l4626: call l4797 ; Get term call l11e1 bit 0,c ld hl,l4714 jr nz,l4669 ld hl,l4719 call l105c ; Insert code jr l4652 ; ; Get simple expression ; l463b: call l0b1a ; Get token l463e: cp '-'+MSB jp z,l4626 cp '+'+MSB jr nz,l464f call l4797 ; Get term call l11e1 jr l4652 l464f: call l479a ; Get term l4652: cp '+'+MSB jr z,l466e cp '-'+MSB jr z,l466e cp @OR ret nz call l0f4c ; Verify ??? type call l4797 ; Get term call l0f4c ; Verify ??? type ld hl,l4738 l4669: call l1062 ; Insert code jr l4652 l466e: dec b jp z,l46e5 inc b call l11e1 ld b,a push bc call l4797 ; Get term call l11e1 bit 0,c pop bc jr nz,l46a6 exx dec hl dec hl exx bit 2,b jr z,l4691 ld hl,l473c call l106a ; Insert code l4691: bit 0,c jr z,l469b ld hl,l4747 call l106a ; Insert code l469b: ld hl,l474d ld bc,l0002 call l106a ; Insert code jr l4652 l46a6: push af xor a call l4780 jr z,l46c7 bit 2,b jr z,l46b6 ex de,hl ld l,a ld h,a sbc hl,de l46b6: bit 1,(ix+0) ; Test overflow check (set is so) call l4753 l46bd: pop af call l0132 ; Insert 'push hl' db PUSH.HL ld bc,l0001 jr l4652 l46c7: bit 2,b jr nz,l46d4 bit 1,(ix+0) ; Test overflow check (set is so) call l4775 jr l46bd l46d4: bit 1,(ix+0) ; Test overflow check ld hl,l472b jr nz,l46e0 ; Yeap ld hl,l4733 l46e0: call l106a ; Insert code jr l46bd l46e5: push af inc b push bc call l4797 ; Get term pop de call l0f54 ; Verify same type pop de bit 2,d ld hl,l470a jr nz,l46fa ld hl,l4700 l46fa: call l1048 ; Insert code jp l4652 ; ; ; l4700: db 9 LD HL,L00B6 ; OR (HL);NOP LD (L0A43),HL CALL L0A36 ; ; ; l470a: db 9 LD HL,LA62F ; CPL;AND (HL) LD (L0A43),HL CALL L0A36 ; ; ; l4714: db 4 CALL L0511 PUSH HL ; ; ; l4719: db 10 BIT 6,H JR Z,L4722 LD A,80H XOR H LD H,A L4722: PUSH HL PUSH DE ; ; ; l4724: db 6 OR A ADC HL,DE CALL PE,L0302 ; ; ; l472b: db 7 EX DE,HL OR A SBC HL,DE CALL PE,L0302 ; ; ; l4733: db 4 EX DE,HL OR A SBC HL,DE ; ; ; l4738: db 3 POP BC OR B PUSH AF ; ; ; l473c: db 4 LD A,80H XOR H LD H,A ; ; ; l4741: db 5 CALL L0D56 PUSH HL PUSH DE ; ; ; l4747: db 5 EX (SP),HL PUSH DE CALL L0D56 ; ; ; l474d: db 5 CALL L0BB2 PUSH HL PUSH DE ; ; ; l4753: push af ld a,h or a jr nz,l4769 ld a,l ld e,'#' l475b: cp 5 jr nc,l4771 pop bc or a ret z ld b,a l4763: call l156e djnz l4763 ret l4769: inc a jr nz,l4771 sub l ld e,'+' jr nz,l475b l4771: call l1098 ; Store "ld de,val16" pop af l4775: ld hl,l4724 jp nz,l106a ; Insert code call l0132 ; Insert 'add hl,de' db AD.HLDE ret l4780: bit 3,(ix+2) l4784: exx dec hl jr z,l4792 dec hl ld d,(hl) dec hl ld e,(hl) dec hl dec hl push de exx pop hl ret l4792: ld (hl),POP.DE ; Insert 'pop de' inc hl exx ret ; ; Get term ; l4797: call l0b1a ; Get token l479a: call l4998 ; Get factor l479d: cp '*'+MSB ; Test multiply jr z,l480f cp @DIV ; Test integer division jr z,l47c1 cp @MOD ; Test modulo jr z,l47c1 cp '/'+MSB ; Test real division jr z,l47f0 cp @AND ; Test AND ret nz call l0f4c ; Verify ??? type call l4995 ; Get factor call l0f4c ; Verify ??? type ld hl,l48b2 call l1062 ; Insert code jr l479d l47c1: call l0f51 ; Verify constant type push af call l4995 ; Get factor call l0f51 ; Verify constant type call l4780 jr z,l47d8 ex de,hl call l0132 ; Insert 'ex de,hl' db EX.DEHL call l10a6 ; Store "ld hl,val16" l47d8: pop de bit 0,d ld hl,l48ae ; Set MOD jr nz,l47e3 ld hl,l48a9 ; Set DIV l47e3: call l106a ; Insert code l47e6: call l0132 ; Insert 'push hl' db PUSH.HL res 3,(ix+2) jr l479d l47f0: call l11e1 bit 0,c jr z,l4801 ld hl,l4741 call l1062 ; Insert code set 0,(ix+1) l4801: call l4995 ; Get factor call l11e1 ld hl,l48b6 call l105c ; Insert code jr l479d l480f: push bc dec b jr z,l4839 inc b call l11e1 call l4995 ; Get factor call l11e1 bit 0,c pop de jr nz,l4848 exx dec hl dec hl exx bit 0,e jr z,l4830 ld hl,l4747 call l106a ; Insert code l4830: ld hl,l48bc call l106a ; Insert code l4836: jp l479d l4839: call l4995 ; Get factor pop de call l0f54 ; Verify same type ld hl,l489b call l1048 ; Insert code jr l4836 l4848: call l4780 ex de,hl ld hl,l48a5 ; Set code for integer * jr z,l47e3 push af push bc call l485a pop bc pop af jr l47e6 l485a: push hl ld a,d or a jr nz,l488b ld a,e cp 11h jr nc,l488b or a jr z,l488b cp 1 pop hl ret z push hl exx push hl exx ld c,0feh l4871: srl a jr z,l4892 jr nc,l4882 inc c jr z,l4888 call l0132 ; Insert 'ld d,h' db LD.D.H call l0132 ; Insert 'ld e,l' db LD.E.L l4882: call l0132 ; Insert 'add hl,hl' db AD.HLHL jr l4871 l4888: exx pop hl exx l488b: call l1099 ; Store "ld de,val16" pop hl jp l106a ; Insert code l4892: pop hl pop hl inc c ret nz call l0132 ; Insert 'add hl,de' db AD.HLDE ret l489b: db 9 LD HL,L00A6 ; AND (HL);NOP LD (L0A43),HL CALL L0A36 ; ; Multiply integers ; l48a5: db 3 CALL L04DC ; ; Divide integers ; l48a9: db 4 CALL L0519 EX DE,HL ; ; Modulo of integers ; l48ae: db 3 CALL L0519 l48b2: db 3 POP BC AND B PUSH AF ; ; Divide reals ; l48b6: db 5 CALL L0CDE PUSH HL PUSH DE ; ; Multiply reals ; l48bc: db 5 CALL L0C68 PUSH HL PUSH DE ; ; ; l48c2: ld a,(l016b) push af push bc ld e,(hl) inc hl ld d,(hl) inc hl push de ld e,(hl) inc hl ld d,(hl) push de inc hl ld b,(hl) call l0b1a ; Get token dec b jr z,l48ed call l0fa2 ; Verify left parenthesis jr l48e0 l48dd: call l0f9a ; Verify comma l48e0: push bc call l44c5 pop bc djnz l48dd call l4af8 exx dec hl exx l48ed: pop hl pop de bit 1,(ix+0) ; Test overflow check (set is so) jr z,l48f6 ; Nope ex de,hl l48f6: pop bc pop de ld (ix+1),d call l106a ; Insert code ld hl,l0001 or a sbc hl,bc ret nz jp l4b8b l4908: ld a,(l016b) push af call l0f9f ; Verify left parenthesis call l44f4 ; Test IN or relations call l1246 call l4af8 dec c pop de ld (ix+1),d ret ; ; ORD ; l491e: call l4908 jr z,l492a ld hl,l494b ld c,b l4927: call l1062 ; Insert code l492a: jp l4b8a ; ; PRED ; l492d: call l4908 jr z,l4939 ld hl,l4953 l4935: inc c jp l1062 ; Insert code l4939: ld hl,l4959 jr l4927 ; ; SUCC ; l493e: call l4908 ld hl,l4950 jr nz,l4935 ld hl,l4956 jr l4927 ; ; ; l494b: db 4 LD L,A LD H,0 PUSH HL ; ; ; l4950: db 2 INC A PUSH AF ; ; ; l4953: db 2 DEC A PUSH AF ; ; ; l4956: db 2 INC HL PUSH HL ; ; ; l4959: db 2 DEC HL PUSH HL ; ; INLINE ; l495c: call l0f9f ; Verify left parenthesis ld hl,l59fb call l106a ; Insert code l4965: call l117a ; Get constant ld c,a ld a,l call l1081 ; Store byte ld a,c cp ','+MSB jr z,l497b ld hl,l59ff call l106a ; Insert code jp l0fa7 ; Verify right parenthesis l497b: call l0b1a ; Get token jr l4965 l4980: call l4995 ; Get factor call l0f4c ; Verify ??? type ld hl,l4c3b jp l1062 ; Insert code l498c: call l0b1a ; Get token call l44f8 ; Test IN or relations jp l4af8 ; ; Get factor ; l4995: call l0b1a ; Get token l4998: res 3,(ix+2) or a ; Test identifier jr z,l49ef cp 118 ; Test character jr z,l49d4 cp 117 ; Test string jr z,l49dc cp '('+MSB jr z,l498c cp '['+MSB jp z,l4cd8 cp '"' jp z,l4a47 set 3,(ix+2) cp 127 ld hl,(l0143) jr z,l4a26 ld de,(l0141) cp 126 jr z,l4a2f cp @NOT jr z,l4980 ld e,12 call l09b7 ; Factor expected jp l114c l49d4: ld a,(l0143) ld bc,l0003 jr l4a0f l49dc: ld de,(l0143) ld a,(l0141) ld c,a ld b,2 l49e6: ld l,c ld h,0 ld (l0170),hl jp l4a52 l49ef: call l0fed ; Get symbol from table cp 1 ret m jp nz,l4aad set 3,(ix+2) ld e,(hl) inc hl ld d,(hl) ld a,b or a jr nz,l49e6 ld a,c dec a jr z,l4a25 dec a jr z,l4a57 ld a,d ld (l0175),a ld a,e l4a0f: or a jr z,l4a1f call l0132 ; Insert 'ld a,..' db LD.Ai call l1081 l4a19: call l0132 ; Insert 'push af' db PUSH.AF jr l4a44 l4a1f: call l0132 ; Insert 'xor a' db XOR.A jr l4a19 l4a25: ex de,hl l4a26: bit 0,(ix+1) jr z,l4a4e call l4c1a l4a2f: ex de,hl push hl l4a31: ex de,hl ex (sp),hl call l1098 ; Store "ld de,val16" pop de call l10a6 ; Store "ld hl,val16" call l4bad ld bc,l0002 set 0,(ix+1) l4a44: jp l0b1a ; Get token l4a47: ld bc,l8000 ld d,c ld e,c jr l4a52 l4a4e: ld bc,l0001 ex de,hl l4a52: call l5842 jr l4a44 l4a57: push de inc hl ld e,(hl) inc hl ld d,(hl) jr l4a31 l4a5e: ld a,(l016b) ld d,a push bc ex (sp),hl ld c,(hl) inc hl ld b,(hl) pop hl ld a,c bit 7,b jr z,l4a6f ld a,1 l4a6f: push bc push de ld c,a push bc push hl dec a ld hl,l4c61 jr z,l4a83 dec a ld hl,l4c63 jr z,l4a83 ld hl,l4c4b l4a83: call l106a ; Insert code pop hl call l162c pop bc pop de ld (ix+1),d dec c jr nz,l4a9a ld hl,l4c3f call l106a ; Insert code pop bc ret l4a9a: dec c jr z,l4aa2 ld hl,l4c42 jr l4aa9 l4aa2: ld hl,l4c46 set 0,(ix+1) l4aa9: pop bc jp l106a ; Insert code l4aad: cp 9 jp z,l48c2 cp 0ah jp z,l4b5a jp nc,l4aff cp 7 jp z,l1463 cp 5 jr z,l4a5e jp l4b5a l4ac6: push bc set 0,(ix+1) call l4aef exx dec hl dec hl exx call l0132 ; Insert 'call ...' db CAL pop de call l10aa ; Store word jp l4bad l4add: ld a,(l016b) push af call l4ac6 pop de ld (ix+1),d dec c exx dec hl exx jp l4b8b l4aef: call l0f9f ; Verify left parenthesis call l44f8 ; Test IN or relations call l11e1 l4af8: res 3,(ix+2) jp l0fa7 ; Verify right parenthesis l4aff: cp 0ch jr c,l4ac6 jr z,l4add cp 0fh jp z,l4b5a push bc ld e,(hl) inc hl ld d,(hl) push de call l4aef bit 0,c pop de pop hl jp nz,l1062 ; Insert code ex de,hl jp l105c ; Insert code l4b1d: call l0f9a ; Verify comma ld hl,l0182 l4b23: push hl call l5145 pop hl ld c,(hl) inc hl ld b,(hl) ret ; ; PEEK ; l4b2c: ld a,(l016b) push af call l0f9f ; Verify left parenthesis call l44c5 pop de ld (ix+1),d call l4b1d call l4af8 inc hl call l584f ld d,0 jr l4b5f l4b48: push bc ld c,1 call l4b68 pop bc ret l4b50: exx dec hl exx ld hl,l16cb inc b jp l1048 ; Insert code l4b5a: ld e,12 call l565e ; Factor expected l4b5f: bit 7,b jr nz,l4b48 dec b jr z,l4b50 inc b ret nz l4b68: dec d jp m,l4bfd ex de,hl jr nz,l4bb6 dec c jr z,l4b83 dec c jr z,l4b97 call l0132 ; Insert 'ld a,(...)' db LD.A@ call l10aa ; Store word l4b7c: inc c call l0132 ; Insert 'push af' db PUSH.AF inc c ret l4b83: call l109f ; Store "ld hl,(val16)" l4b86: call l0132 ; Insert 'push hl' db PUSH.HL l4b8a: inc c l4b8b: bit 0,(ix+1) ret z inc c ld hl,l4741 jp l1062 ; Insert code l4b97: call l0132 db HIGH LD.DE@ ; Insert 'ld (...),de' call l0132 db LOW LD.DE@ call l10aa ; Store word inc de inc de call l109f ; Store "ld hl,(val16)" l4ba7: set 0,(ix+1) inc c inc c l4bad: call l0132 ; Insert 'push hl' db PUSH.HL call l0132 ; Insert 'push de' db PUSH.DE ret l4bb6: ld d,HIGH LD.L_IX call l0132 db HIGH LD.L_IX ; Insert prefix dec c jr z,l4bcb dec c jr z,l4bdc call l0132 ; Insert 'ld a,(ix+..)' db LOW LD.A_IX call l156e jr l4b7c l4bcb: call l0132 ; Insert 'ld l,(ix+..)' db LOW LD.L_IX call l10aa ; Store offset and prefix inc e ; Update offset call l0132 ; Insert 'ld h,(ix+..+1)' db LOW LD.H_IX call l156e jr l4b86 l4bdc: call l0132 ; Insert 'ld e,(ix+..)' db LOW LD.E_IX call l10aa ; Store offset and prefix inc e ; Update offset call l0132 ; Insert 'ld d,(ix+..+1)' db LOW LD.D_IX call l10aa ; Store offset and prefix inc e ; Update offset call l0132 ; Insert 'ld l,(ix+..+2)' db LOW LD.L_IX call l10aa ; Store offset and prefix inc e ; Update offset call l0132 ; Insert 'ld h,(ix+..+3)' db LOW LD.H_IX call l156e jr l4ba7 l4bfd: dec c jr z,l4c08 dec c jr z,l4c0e ld hl,l4c4d jr l4c15 l4c08: ld hl,l4c50 jp l4927 l4c0e: ld hl,l4c56 set 0,(ix+1) l4c15: inc c inc c jp l1062 ; Insert code l4c1a: ld a,80h and h jr z,l4c26 ex de,hl ld hl,l0000 sbc hl,de or a l4c26: ld de,l0000 adc hl,de ret z ld d,0eh l4c2e: bit 6,h jr nz,l4c36 add hl,hl dec d jr l4c2e l4c36: ld e,0 or h ld h,a ret ; ; ; l4c3b: db 3 XOR 1 PUSH AF ; ; ; l4c3f: db 2 POP HL PUSH HL ; ; ; l4c42: db 3 DEC SP POP AF PUSH AF ; ; ; l4c46: db 4 POP DE POP HL PUSH HL PUSH DE ; ; ; l4c4b: db 1 DEC SP ; ; ; l4c4d: db 2 LD A,(HL) PUSH AF ; ; ; l4c50: db 5 LD E,(HL) INC HL LD D,(HL) EX DE,HL PUSH HL ; ; ; l4c56: db 10 LD E,(HL) INC HL LD D,(HL) INC HL LD C,(HL) INC HL LD H,(HL) LD L,C PUSH HL PUSH DE ; ; ; l4c61: db 1 PUSH HL ; ; ; l4c63: db 2 PUSH HL PUSH DE ; ; ; l4c66: or a ld hl,l4c9d jr z,l4c76 call l0132 db LD.Ci ; Insert 'ld c,..' call l1081 ld hl,l4c79 l4c76: jp l106a ; Insert code ; ; ; l4c79: db 3 CALL L0A1E inc bc call l09f7 ; ; ; l4c81: db 5 CALL L09F7 OR (HL) LD (HL),A db 4 LD A,L CALL L09F7 ; ; ; l4c8c: db 7 LD E,A CALL L09F7 LD D,A PUSH HL PUSH DE ; ; ; l4c94: db 8 POP DE POP HL SUB E JR C,LL4C9D CALL L0A11 LL4C9D: ; ; ; l4c9d: DB 4 LD B,0 PUSH BC INC SP ; ; Code for storage of reg HL into ??? ; l4ca2: db 3 LD (L0132),HL ; ; ; ; ; ; l4ca6: db 3 LD HL,(L0132) ; ; ; l4caa: call l1246 inc b ld (l0172),bc ld a,c dec a jr z,l4cca cp 2 ld a,1fh jr z,l4cc5 ld a,(l0175) srl a srl a srl a l4cc5: ld (l0174),a scf ret l4cca: ld a,1fh ld (l0174),a or a ret l4cd1: ld bc,(l0172) jp l0b1a ; Get token l4cd8: ld a,(l0172) or a jp z,l4d39 ld a,(l0174) call l4c66 call l0b1a ; Get token cp 0ddh jr z,l4cd1 l4cec: call l44cb l4cef: cp 0aeh jr z,l4d0c dec c jr nz,l4cfa call l0132 ; Insert 'ld a,l' db LD.A.L l4cfa: ld hl,l4c81 l4cfd: call l106a ; Insert code cp 0ddh jr z,l4cd1 toktst 172,42 ; ',' or ']' expected in set ;;lac2a jr l4cec l4d0c: call l0b1a ; Get token toktst 174,43 ; '..' or ',' or ']' expected in set ;;lae2b dec c jr z,l4d23 ld hl,l4c8c call l106a ; Insert code call l44cb jr l4d34 l4d23: call l0132 ; Insert 'ld a,l' db LD.A.L ld hl,l4c8c call l106a ; Insert code call l44cb call l0132 ; Insert 'ld a,l' db LD.A.L l4d34: ld hl,l4c94 jr l4cfd l4d39: call l0b1a ; Get token cp 0ddh jr z,l4d64 call l44f4 ; Test IN or relations push af call l4caa jr nc,l4d53 exx dec hl exx call l4c66 l4d4f: pop af jp l4cef l4d53: ld hl,l4ca2 call l1062 ; Insert code call l4c66 ld hl,l4ca6 call l106a ; Insert code jr l4d4f l4d64: ld e,45 call l09b7 ; Null set not allowed here jp l0b1a ; Get token ; ; ; l4d6c: db 5 LD SP,(L0006) DB LD.HL ; ; ; l4d72: db 5 ADD HL,SP CALL NC,SL02F0 DB HIGH LD.IX_D ; ; Code for initialization of program ; l4d78: db 12 LD HL,$-$ ; Filled with start of heap LD SP,IX CALL L0B21 CALL L01AD XOR A ; ; ; l4d85: ld hl,(l014d) ; Get high memory ld (l0145),hl ex de,hl ld hl,l4d6c call l106a ; Insert code ld hl,0 or a sbc hl,de ex de,hl call l10aa ; Store word ld hl,l4d72 call l106a ; Insert code bit 6,(ix+2) ; Test option D jr z,l4db0 ; Nope ld de,l0006 call l109f ; Store "ld hl,(val16)" jr l4db3 l4db0: call l10a6 ; Store "ld hl,val16" l4db3: ld (l0176),hl ld hl,l4d78 call l106a ; Insert code cp @VAR ; Test variable jr nz,l4dcc call l0b1a ; Get token l4dc3: call l5506 call l0f73 ; Verify semicolon or a jr z,l4dc3 l4dcc: call l1067 ; Insert 'jp xxxx' dec hl ld (l0178),hl jp l4eb4 ; ; Process a block ; l4dd6: cp @LBL ; Test label jr nz,l4e24 call l1067 ; Insert 'jp xxxx' push hl l4dde: call l0b1a ; Get token cp 7fh ld e,59 jp nz,l09b7 ; Unsigned integer expected after LABEL ld hl,(l0155) ; Get top symbol pointer ld de,(l0151) ld (l0151),hl ld (hl),e inc hl ld (hl),d inc hl ld de,(l0143) ld (hl),e inc hl ld (hl),d inc hl ex de,hl call l1076 ; Get current program counter ex de,hl ld (hl),e inc hl ld (hl),d inc hl ld a,(l0160) ld (hl),a inc hl ld (l0155),hl ; Set top symbol pointer call l1067 ; Insert 'jp xxxx' call l0b1a ; Get token cp ','+MSB jr z,l4dde call l1076 ; Get current program counter ex de,hl pop hl call l10b5 ; Store word into previous address call l0f73 ; Verify semicolon l4e24: cp @CON ; Test constant jr nz,l4e6d call l0b1a ; Get token l4e2b: call l0fb1 ; Put symbol into table push hl call l0b1a ; Get token cp 7dh jr nz,l4e3d ld e,5 call l09b7 ; '=' not ':=' in constant declarations jr l4e44 l4e3d: cp 78h ld e,6 call nz,l09b7 ; '=' expected l4e44: call l0b1a ; Get token call l117a ; Get constant ex de,hl ex (sp),hl ld (hl),1 inc hl ld (hl),c inc hl ld (hl),b inc hl dec b inc b jr nz,l4e59 dec c dec c l4e59: pop bc jr nz,l4e60 ld (hl),c inc hl ld (hl),b inc hl l4e60: ld (hl),e inc hl ld (hl),d inc hl ld (l0155),hl ; Set top symbol pointer call l0f73 ; Verify semicolon or a jr z,l4e2b l4e6d: cp @TYP ; Test type jr nz,l4e8f call l0b1a ; Get token l4e74: ld de,l0009 call l0fb1 ; Put symbol into table ld (hl),3 inc hl call l0b1a ; Get token toktst 120,6 ; '=' expected ;;l7806 call l5145 call l0f73 ; Verify semicolon or a jr z,l4e74 l4e8f: ld hl,l5145 ld (l54a5),hl ; Set address ld d,a ld a,(l0160) ; Get prolog flag or a ld a,d jp z,l4d85 ; Must set prolog first ld hl,lfffc ld (l0145),hl cp @VAR ; Test variable jr nz,l4eb4 call l0b1a ; Get token l4eab: call l54c0 call l0f73 ; Verify semicolon or a jr z,l4eab l4eb4: ld hl,(l0145) push hl ld hl,l0160 inc (hl) l4ebc: cp @PRC ; Test procedure jr z,l4ec5 cp @FNC ; Test function jp nz,l5097 l4ec5: push af call l09b0 ; Verify identifier ld hl,(l0153) ; Get current symbol pointer call l1007 ; Find label jp c,l5031 ; Got it l4ed2: xor a ld de,l000a call l0fb1 ; Put symbol into table pop af ld (hl),a inc hl inc hl inc hl ex de,hl call l1076 ; Get current program counter ex de,hl ld (hl),e inc hl ld (hl),d inc hl ld a,(l0160) dec a ld (hl),a ex de,hl call l1067 ; Insert 'jp xxxx' ld hl,(l0155) ; Get top symbol pointer push hl call l0b1a ; Get token cp '('+MSB jp nz,l5074 ld hl,l0000 ld (l0145),hl ld hl,l5462 ld (l54a5),hl ; Set address l4f08: call l0b1a ; Get token cp 0ah jr z,l4f14 call l54c0 jr l4f23 l4f14: ld d,0ah call l0b1a ; Get token call l547a ld bc,l0002 dec hl call l54d5 l4f23: cp ';'+MSB jr z,l4f08 call l0fa7 ; Verify right parenthesis pop bc push af push bc ld hl,(l0153) ; Get current symbol pointer push hl ld hl,(l0155) ; Get top symbol pointer dec hl dec hl ld b,(hl) dec hl ld c,(hl) ex de,hl ld hl,l0002 xor a sbc hl,bc ld (l014f),hl l4f43: add hl,bc ex de,hl ld (hl),e inc hl ld (hl),d pop hl pop bc inc a or a sbc hl,bc add hl,bc push bc jr z,l4f62 ld e,(hl) inc hl ld d,(hl) push de dec hl dec hl dec hl ld b,(hl) dec hl ld c,(hl) ex de,hl ld hl,(l014f) jr l4f43 l4f62: ld l,c ld h,b dec hl ld de,(l014f) ld (hl),d dec hl ld (hl),e dec hl ld (hl),a ld bc,lfff9 add hl,bc ld a,(hl) cp 4 pop bc jp z,l502c pop af push bc push hl call l0f83 ; Verify colon or a ld e,41 call nz,l09b7 ; Function result must be type identifier call l0fed ; Get symbol from table cp 3 ld e,30 call nz,l09b7 ; Identifier is not a type ld a,b or a ld e,46 jr z,l4f98 call p,l09b7 ; Scalar (including real) expected l4f98: ex de,hl dec de dec de pop hl inc hl ld (hl),e inc hl ld (hl),d call l0b1a ; Get token l4fa3: call l0f73 ; Verify semicolon cp 1dh jr nz,l4fbc pop hl dec hl dec hl dec hl call l5081 ld (hl),1 call l0b1a ; Get token l4fb6: call l0f73 ; Verify semicolon jp l4ebc l4fbc: ld hl,(l0151) push hl ld hl,(l0153) ; Get current symbol pointer push hl ld hl,(l0155) ; Get top symbol pointer push hl call l4dd6 ; Process a block pop hl ld (l0155),hl ; Set top symbol pointer pop hl ld (l0153),hl ; Set current symbol pointer pop hl ld (l0151),hl ld c,a ld de,(l0145) ld hl,(l0147) call l10b5 ; Store word into previous address xor a ld l,a ld h,a sbc hl,de call l4600 call l0132 db HIGH POP.IX call l0132 ; Insert 'pop ix' db LOW POP.IX call l0132 ; Insert 'pop de' db POP.DE pop hl dec hl ld d,(hl) dec hl ld e,(hl) dec hl push hl ex de,hl call l4600 ld a,c call l0132 ; Insert 'ex de,hl' db EX.DEHL call l0132 ; Insert 'jp (hl)' db JP.HL pop hl call l5081 ld (hl),0 push af ld a,(l0160) dec a jr nz,l5029 exx push hl exx pop hl ld de,-l5a6a ;;la596 add hl,de ; Build start of compiled code, zero relative ld bc,l5a6a ; Get start of binary code ld de,(l0180) ; Get start of code to be written into call l093e ; Write to disk l5029: pop af jr l4fb6 l502c: pop af push bc jp l4fa3 l5031: pop af push af cp (hl) jp nz,l4ed2 pop af inc hl inc hl inc hl ld e,(hl) inc hl ld d,(hl) push hl call l1076 ; Get current program counter ex de,hl inc hl call l10e9 call nc,l10c1 ; Store word into current address pop hl ld (hl),d dec hl ld (hl),e ex de,hl call l1067 ; Insert 'jp xxxx' ex de,hl ld de,l0004 add hl,de ld a,(hl) add hl,de dec hl push hl or a jr z,l506b inc hl inc hl ld b,a ld e,0bh l5063: set 6,(hl) call l5470 add hl,de djnz l5063 l506b: call l0b1a ; Get token call l0f73 ; Verify semicolon jp l4fbc l5074: ld hl,l0002 ld (l014f),hl pop bc push af push bc xor a jp l4f62 l5081: ld b,(hl) dec hl inc b dec b ret z push hl ld de,l0006 add hl,de ld e,0bh l508d: res 6,(hl) call l5470 add hl,de djnz l508d pop hl ret l5097: res 4,(ix+2) ld hl,l0160 dec (hl) jr z,l50ff ld hl,l000a add hl,sp ld e,(hl) inc hl ld d,(hl) ld hl,lfff6 add hl,de ld c,a ld a,(hl) cp 5 ld a,c jr nz,l50b7 set 4,(ix+2) l50b7: inc hl inc hl inc hl ld c,(hl) inc hl ld b,(hl) ex de,hl call l1076 ; Get current program counter ex de,hl ld (hl),d dec hl ld (hl),e ld h,b ld l,c inc hl call l10c1 ; Store word into current address call l1237 ; Insert keyboard check if requested ld hl,l5113 call l106a ; Insert code pop bc ld hl,l0004 add hl,bc ld (l0145),hl call l10a5 ; Store "ld hl,val16" ld (l0147),hl call l0132 ; Insert 'add hl,sp' db AD.HLSP call l0132 ; Insert 'ld sp,hl' db LD.SPHL bit 3,(ix+0) ; Test check stack state jr z,l50f6 ; Nope ld hl,l511c call l106a ; Insert code l50f6: toktst 24,25 ; 'BEGIN' expected ;;l1819 jp l406b l50ff: pop hl ld (l0145),hl call l1076 ; Get current program counter ex de,hl ld hl,(l0178) dec hl call l10e9 call nc,l10c1 ; Store word into current address jr l50f6 ; ; ; l5113: db 8 PUSH IX LD IX,L0004 ADD IX,SP ; ; ; l511c: db 8 LD DE,(L0119) ADD HL,DE CALL NC,SL02F0 ; ; ; l5125: push hl ld hl,l4003 or a sbc hl,bc pop hl ret ; ; ; l512e: call l0f88 ; Verify OF call l4b23 set 6,(hl) ld b,(hl) inc hl push hl call l5931 pop hl ld bc,l0004 add hl,bc ld (hl),e inc hl ld (hl),d ret l5145: cp '$' call z,l0b1a ; Get token cp 1ch jr z,l51a6 cp 1eh jp z,l524b cp '^'+MSB jr z,l5192 cp '#' jr z,l512e cp 1bh jp nz,l53aa call l0f88 ; Verify OF call l53aa ld c,(hl) inc hl ld b,(hl) call l1246 inc (hl) inc hl inc hl ld b,(hl) inc hl inc hl dec c jr z,l5182 srl b srl b srl b inc b l517c: inc hl ld (hl),b inc hl ld (hl),0 ret l5182: dec b inc b ld e,40 call nz,l09b7 ; Set too large ( >256 elements ) dec (hl) inc (hl) call nz,l09b7 ; Set too large ( >256 elements ) ld b,' ' jr l517c l5192: call l0b1a ; Get token call l5462 inc hl set 7,(hl) ld c,2 ld de,l0005 add hl,de ld (hl),c inc hl ld (hl),0 ret l51a6: call l0b1a ; Get token toktst 219,34 ; '[' expected ;;ldb22 l51af: ld de,(l0155) ; Get top symbol pointer ld (hl),e inc hl ld (hl),d push de push hl ex de,hl call l53aa inc hl ld c,a ld a,(hl) or a ld a,c ld e,36 call nz,l09b7 ; Array index type must be scalar inc hl ld c,(hl) inc hl ld b,(hl) inc hl ld e,(hl) inc hl ld d,(hl) inc hl push hl push de ld de,l0008 add hl,de ld (l0155),hl ; Set top symbol pointer pop hl sbc hl,bc inc hl ex (sp),hl push hl cp 0ddh jr z,l523c cp 0ach jr nz,l5244 call l0b1a ; Get token call l51af l51ec: pop hl ld de,l0006 add hl,de ld e,(hl) inc hl ld d,(hl) pop hl push af call l0673 pop af ex de,hl pop hl inc hl ld (hl),e inc hl ld (hl),d inc hl inc hl inc hl ld (hl),e inc hl ld (hl),d ex (sp),hl push hl ld de,l539f ld bc,l0004 push af l520f: ld a,(de) inc de cpi jr nz,l5238 jp pe,l520f ld a,(hl) ex af,af' inc hl ld bc,l0007 l521e: ld a,(de) inc de cpi jr nz,l5238 jp pe,l521e ex af,af' ld c,a pop af pop hl ld (l0155),hl ; Set top symbol pointer pop hl ld de,lfffa add hl,de ld (hl),2 dec hl ld (hl),c ret l5238: pop af pop hl pop hl ret l523c: call l0f88 ; Verify OF l523f: call l5145 jr l51ec l5244: ld e,38 call l09b7 ; ']' or ',' expected in ARRAY decl jr l523f l524b: ex de,hl ld hl,l5145 ld (l54a5),hl ; Set address ld hl,l0000 ld (l0149),hl ex de,hl push hl call l5274 toktst 16,54 ; 'END' or ',' expected in RECORD defn ;;l1036 ld de,(l0149) pop hl inc hl inc hl ld (hl),e inc hl ld (hl),d inc hl inc hl inc hl ld (hl),e inc hl ld (hl),d ret l5274: call l0b1a ; Get token l5277: cp 14h jr z,l5291 or a ret nz call l5343 call l534d ld de,l000b add hl,de ld (hl),0 dec hl ld (hl),0 cp 0bbh jr z,l5274 ret l5291: push hl call l09b0 ; Verify identifier ld hl,(l0153) ; Get current symbol pointer call l1007 ; Find label jr nc,l52ac ; No match ld a,(hl) cp 3 jr nz,l52ac inc hl ld c,(hl) inc hl ld b,(hl) pop hl call l0b1a ; Get token jr l52e0 l52ac: pop hl call l5343 ld de,l000d call l0fb1 ; Put symbol into table call l0f80 ; Verify colon ld (hl),0fh inc hl call l5462 ld c,(hl) inc hl ld b,(hl) push bc ld de,l0005 add hl,de ld c,(hl) inc hl ld b,(hl) ld de,(l0149) ld (hl),d dec hl ld (hl),e ex de,hl add hl,bc ld (l0149),hl ex de,hl inc hl inc hl ld (hl),0 inc hl ld (hl),0 inc hl pop bc l52e0: call l1246 call l0f8b ; Verify OF ex de,hl ld hl,(l0149) ld (l014b),hl l52ed: push de push bc l52ef: call l117a ; Get constant pop de push de call l0f54 ; Verify same type cp ':'+MSB jr z,l5300 call l0f9a ; Verify comma jr l52ef l5300: call l0f9f ; Verify left parenthesis pop bc pop de push bc ld hl,(l0149) push hl ld hl,(l014b) push hl ex de,hl call l5277 call l0fa7 ; Verify right parenthesis ld c,l ld b,h ld hl,(l0149) pop de or a sbc hl,de add hl,de jr nc,l5322 ex de,hl l5322: ld (l014b),hl pop hl ld (l0149),hl ld d,b ld e,c pop bc cp 0bbh jr nz,l5333 call l0b1a ; Get token l5333: cp 10h jr z,l533b cp 0a9h jr nz,l52ed l533b: ld hl,(l014b) ld (l0149),hl ex de,hl ret l5343: ld de,(l0155) ; Get top symbol pointer inc de inc de ld (hl),e inc hl ld (hl),d ret l534d: ld hl,(l0149) push hl ld d,0fh ld hl,l000d call l547d ex (sp),hl ld (l0149),hl pop hl ld b,(hl) dec hl ld c,(hl) push de l5362: ld de,(l0149) ld (hl),e inc hl ld (hl),d inc hl ex de,hl add hl,bc ld (l0149),hl ex de,hl ld (hl),0 inc hl ld (hl),0 inc hl ld e,l ld d,h inc de inc de inc de inc de ld (hl),e inc hl ld (hl),d ld de,lfff5 add hl,de pop de or a sbc hl,de add hl,de ret z push de ld de,l000e add hl,de push bc call l5470 ex de,hl ld hl,(l0163) ld bc,l0006 ldir pop bc ex de,hl jr l5362 l539f: ld bc,0100h nop nop inc bc nop nop rst 38h rst 38h rst 38h l53aa: push hl or a jr z,l53f2 cp 0a8h jr z,l5416 push hl call l117a ; Get constant pop de ex de,hl l53b8: call l1246 ld (hl),c inc hl ld (hl),b inc hl ld (hl),e inc hl ld (hl),d inc hl push hl push de toktst 174,37 ; '..' expected ;;lae25 call l0faa ; '..' expected push bc call l117a ; Get constant pop de call l0f54 ; Verify same type pop de or a sbc hl,de add hl,de ld e,39 call m,l09b7 ; Lowerbound > upperbound ex de,hl pop hl ld (hl),e inc hl ld (hl),d l53e5: inc hl dec c ld bc,l0002 jr z,l53ed dec c l53ed: ld (hl),c inc hl ld (hl),b pop hl ret l53f2: call l0fed ; Get symbol from table dec a jr z,l540c l53f8: cp 2 ld e,30 call nz,l09b7 ; Identifier is not a type dec hl dec hl pop de push de ld bc,l0008 ldir pop hl jp l0b1a ; Get token l540c: call l0b1a ; Get token ld e,(hl) inc hl ld d,(hl) pop hl push hl jr l53b8 l5416: xor a ld (l0165),a ld hl,l0162 ld c,(hl) inc (hl) ld b,0 l5421: call l0b1a ; Get token push bc ld de,l0005 call l0fb1 ; Put symbol into table pop bc ld (hl),1 inc hl ld (hl),c inc hl ld (hl),b inc hl ld a,(l0165) ld (hl),a inc a ld (l0165),a inc hl push hl call l0b1a ; Get token cp ','+MSB jr z,l5421 call l0fa7 ; Verify right parenthesis ld d,a ld a,(l0165) ld b,a dec a l544d: pop hl ld (hl),a djnz l544d pop hl push hl ld (hl),c inc hl ld (hl),b inc hl ld (hl),0 inc hl ld (hl),a inc hl ld (hl),a inc hl ld (hl),a ld a,d jr l53e5 l5462: push hl or a ld e,44 call nz,l09b7 ; Parameter type must be type identifier call l0fed ; Get symbol from table dec a jp l53f8 l5470: ld c,a l5471: ld a,(hl) inc hl or a jp p,l5471 ld a,c inc hl ret ; ; ; l547a: ld hl,l000a l547d: push de ex de,hl ld hl,(l0155) ; Get top symbol pointer inc hl inc hl ex (sp),hl push hl l5486: push de call l0fb1 ; Put symbol into table pop de pop af push af ld (hl),a call l0b1a ; Get token cp 0bah jr z,l549c push de call l0f9a ; Verify comma pop de jr l5486 l549c: pop af call l0b1a ; Get token inc hl pop de push hl push de l54a5 equ $+1 call l5145 pop hl call l5470 ld (l0163),hl ex de,hl pop hl push hl ld bc,l0008 ldir ex de,hl ld c,a ld a,(l0160) ld (hl),a ld a,c dec hl pop de ret l54c0: ld d,2 call l547a ld b,(hl) dec hl ld c,(hl) push hl ex de,hl inc hl bit 6,(hl) ld e,72 call nz,l09b7 ; Files must be globals or VAR parameters dec hl ex de,hl pop hl l54d5: push de ex de,hl l54d7: ld hl,(l0145) or a sbc hl,bc ld (l0145),hl ex de,hl ld (hl),e inc hl ld (hl),d ld de,lfff9 add hl,de pop de or a sbc hl,de add hl,de ret z push de ld de,l000b add hl,de push bc call l5470 ex de,hl ld hl,(l0163) ld bc,l0009 ldir dec de dec de dec de pop bc jr l54d7 ; ; ; l5506: ld d,2 call l547a ld b,(hl) dec hl ld c,(hl) push de ex de,hl inc hl bit 6,(hl) jr z,l54d7 push bc ld b,(hl) dec hl ld c,(hl) call l5125 pop bc push de jr nz,l5588 cp 0dbh jr nz,l5544 push bc call l0b1a ; Get token call l117a ; Get constant call l0f51 ; Verify constant type call l0f95 ; Verify squared bracket close dec h inc h ld e,66 call nz,l09b7 ; File buffer too large ( >32K ) ld h,l dec h ld l,0 srl h rr l pop bc add hl,bc ld b,h ld c,l l5544: ld de,(l0145) dec de call l10a6 ; Store "ld hl,val16" inc de ex de,hl or a sbc hl,bc ld (l0145),hl ex de,hl pop hl ld (hl),e inc hl ld (hl),d push hl inc de inc de call l152f inc de inc de call l181b pop hl ld de,lfff9 add hl,de pop de or a sbc hl,de add hl,de ret z push de ld de,l000b add hl,de push bc call l5470 ex de,hl ld hl,(l0163) ld bc,l0009 ldir dec de dec de dec de pop bc push de jr l5544 l5588: ld hl,(l0145) or a sbc hl,bc ld (l0145),hl ex de,hl pop hl ld (hl),e inc hl ld (hl),d push hl push de inc de inc de inc de inc de call l181b ld h,b ld l,c ld de,lff53 add hl,de ex de,hl call l10a6 ; Store "ld hl,val16" pop de ld hl,l00aa add hl,de ex de,hl call l152f pop hl ld de,lfff9 add hl,de pop de or a sbc hl,de add hl,de ret z push de ld de,l000b add hl,de push bc call l5470 ex de,hl ld hl,(l0163) ld bc,l0009 ldir dec de dec de dec de pop bc push de jr l5588 l55d6: ld e,58 jp l09b7 ; No associated WITH statement l55db: ld de,l0007 add hl,de ld d,(hl) dec hl ld e,(hl) ld a,d or e call z,l55d6 push hl call l109f ; Store "ld hl,(val16)" call l0132 ; Insert 'push hl' db PUSH.HL pop hl dec hl dec hl jr l5611 l55f4: cp 0aeh jp nz,l5756 pop hl call l0b1a ; Get token or a ld e,55 call nz,l09b7 ; Field identifier expected call l0fed ; Get symbol from table ld e,55 cp 0fh call nz,l09b7 ; Field identifier expected ld de,l0004 add hl,de l5611: ld e,(hl) inc hl ld d,(hl) ld bc,lfff9 add hl,bc push hl bit 1,(ix+1) jr z,l562b call l4784 exx inc hl exx add hl,de call l10a5 ; Store "ld hl,val16" jr l5632 l562b: exx dec hl exx ex de,hl call l4753 l5632: call l0132 ; Insert 'push hl' db PUSH.HL pop hl call l0b1a ; Get token ld c,(hl) inc hl ld b,(hl) inc hl l563e: call l584f l5641: ld e,a ld a,b cp '@' jr nc,l5650 ld d,0 cp 2 ld a,e ret c push bc jr l56aa l5650: ld a,e push bc push hl ld d,(ix+1) push de ld d,0 ld c,1 jp l57f3 ; ; ... error code in reg E ; l565e: res 1,(ix+1) cp 2 jr z,l5673 cp 0ah jp z,l57c7 cp 0fh jp z,l55db jp l09b7 ; Process error l5673: call l584f ld a,b or a jp z,l578b dec a push bc jp z,l57b6 bit 6,b jp nz,l580c bit 7,b jp nz,l57e5 call l11f5 jr z,l569c sub b jr z,l5697 call l1204 jr l56a3 l5697: call l1213 jr l56a3 l569c: call l10a6 ; Store "ld hl,val16" set 1,(ix+1) l56a3: call l0132 ; Insert 'push hl' db PUSH.HL call l0b1a ; Get token l56aa: pop hl push hl ld d,a ld a,h cp 2 jr z,l56b5 inc hl ld a,(hl) or a l56b5: ld a,d jp nz,l55f4 cp 0dbh jp nz,l5756 l56be: pop hl ld a,h cp 2 jp z,l575a call l0b1a ; Get token ld c,(hl) inc hl ld b,(hl) inc hl push hl ld d,(ix+1) push de call l44c8 res 3,(ix+2) pop de res 1,d ld (ix+1),d dec c jr z,l56e7 ld hl,l494b call l1062 ; Insert code l56e7: exx dec hl exx pop hl push af ld e,(hl) inc hl ld d,(hl) inc hl push hl xor a cp c push af jr z,l56f7 ld d,a l56f7: xor a push de ld h,a ld l,a sbc hl,de call l4753 pop de pop af pop hl ld c,(hl) inc hl ld b,(hl) inc hl jr z,l570a ld b,a l570a: bit 5,(ix+0) ; Test array check jr z,l572a ; Nope push hl ld hl,l5914 push de call l106a ; Insert code ld h,b ld l,c pop bc or a sbc hl,bc ex de,hl inc de call l1099 ; Store "ld de,val16" ld hl,l591a call l106a ; Insert code pop hl l572a: ld bc,l0006 add hl,bc ld e,(hl) inc hl ld d,(hl) ld bc,lfff9 add hl,bc push hl ld hl,l590c call l485a ld hl,l5910 call l106a ; Insert code pop hl ld c,(hl) inc hl ld b,(hl) inc hl pop af cp ','+MSB jr z,l5752 call l0f95 ; Verify squared bracket close jp l563e l5752: push bc jp l56be l5756: pop bc ld d,0 ret l575a: push hl call l44c2 exx dec hl exx call l0132 ; Insert 'dec hl' db DEC.HL pop bc bit 5,(ix+0) ; Test array check jr z,l577c ; Nope ld hl,l5922 call l106a ; Insert code ld e,c call l156e ld hl,l592d call l106a ; Insert code l577c: ld hl,l5910 call l106a ; Insert code call l0f95 ; Verify squared bracket close ld d,0 ld bc,l0003 ret l578b: call l11f5 jr z,l57b0 l5790: sub b ld b,0 jr z,l57a0 l5795: call l1204 l5798: ld d,0 call l0132 ; Insert 'push hl' db PUSH.HL jr l57a8 l57a0: call l1221 jr nc,l57ab ld h,2 l57a7: ex de,hl l57a8: jp l0b1a ; Get token l57ab: call l1213 jr l5798 l57b0: ld b,0 ld h,1 jr l57a7 l57b6: call l11f5 jr z,l57c1 sub b pop bc jr z,l57ab jr l5795 l57c1: call l10a6 ; Store "ld hl,val16" pop bc jr l5798 l57c7: push bc call l584f push hl ld d,(ix+1) push de ld c,1 res 0,(ix+1) call l578b call l4b68 pop de ld (ix+1),d pop hl pop bc l57e2: jp l5641 l57e5: push hl ld d,(ix+1) push de ld c,1 res 0,(ix+1) call l578b l57f3: cp 0deh jr nz,l5808 l57f7: call l4b68 pop de ld (ix+1),d pop hl pop bc call l0b1a ; Get token call l5847 jr l57e2 l5808: pop bc pop bc pop bc ret l580c: push hl ld d,(ix+1) push de ld c,1 res 0,(ix+1) call l578b cp 0deh jr z,l57f7 pop bc pop bc pop bc call l5835 ld d,0 ret l5827: ld e,65 ; Parameter should be of FILE type l5829: or a jp nz,l09b7 ; Process error push de call l0fed ; Get symbol from table pop de call l565e l5835: dec d ret m ex de,hl jr z,l5842 call l1213 l583d: call l0132 ; Insert 'push hl' db PUSH.HL ret l5842: call l10a6 ; Store "ld hl,val16" jr l583d l5847: bit 6,b res 6,b ret nz res 7,b ret l584f: push bc call l5847 ld e,(hl) inc hl ld d,(hl) dec hl dec b jr z,l5868 ld (l0170),de inc b pop bc ret nz ld e,a ld a,d ld (l0175),a ld a,e ret l5868: inc b ld (l0172),bc pop bc ld e,a ld a,d dec c jr nz,l5875 ld a,0ffh l5875: inc c srl a srl a srl a ld (l0174),a ld a,e ret ; ; MEMAVAIL ; l5881: call l0b1a ; Get token ld hl,l5890 call l106a ; Insert code ld bc,l0001 jp l4b8b ; ; ; l5890: db 5 LD HL,(L0119) ADD HL,SP PUSH HL ; ; MARK ; l5896: ld hl,l58ae jr l589e ; ; RELEASE ; l589b: ld hl,l58b6 l589e: push hl call l0f9f ; Verify left parenthesis ld e,69 call l5829 ; Parameter must be a POINTER variable call l0fa7 ; Verify right parenthesis pop hl jp l1062 ; Insert code ; ; Code for MARK(^HL) ; l58ae: db 7 LD DE,(L011F) LD (HL),E INC HL LD (HL),D ; ; Code for RELEASE(^HL) ; l58b6: db 7 LD E,(HL) INC HL LD D,(HL) EX DE,HL CALL L0B21 ; ; DISPOSE ; l58be: ld hl,l5908 jr l58c6 ; ; NEW ; l58c3: ld hl,l5904 l58c6: push hl call l0f9f ; Verify left parenthesis ld e,69 call l5829 ; Parameter must be a POINTER variable bit 7,b ld e,69 jp z,l09b7 ; Parameter must be a POINTER variable exx dec hl exx res 7,b dec b jr z,l58f7 inc b jr z,l58ff ld hl,(l0170) l58e4: dec hl res 0,l res 1,l ld de,l0004 add hl,de call l1098 ; Store "ld de,val16" pop hl call l0fa7 ; Verify right parenthesis jp l106a l58f7: ld hl,(l0174) inc l ld h,0 jr l58e4 l58ff: ld hl,l0004 jr l58e4 ; ; Code for NEW() ; l5904: db 3 CALL L0AC2 ; ; Code for DISPOSE() ; l5908: db 3 CALL L0B54 ; ; ; l590c: db 3 CALL L04BF ; ; ; l5910: db 3 POP DE ADD HL,DE PUSH HL ; ; l5914: db 5 BIT 7,H CALL NZ,L031C ; ; ; l591a: db 7 OR A SBC HL,DE ADD HL,DE CALL P,L0321 ; ; ; l5922: db 10 LD A,H OR A CALL M,L031C CALL NZ,L0321 LD A,L DB CP.i ; ; ; l592d: db 3 CALL NC,L0321 ; ; ; l5931: ld d,0 bit 7,b jr nz,l5977 bit 6,b jr nz,l5963 dec b jr z,l5955 dec b jr z,l5953 inc b inc b jr z,l5949 ld e,(hl) inc hl ld d,(hl) ret l5949: ld e,2 dec c ret z dec e dec c ret nz ld e,4 ret l5953: ld e,c ret l5955: ld e,(hl) dec c jr nz,l595b ld e,0ffh l595b: srl e srl e srl e inc e ret l5963: call l5125 jr z,l5973 res 6,b call l5931 ld hl,l00ad add hl,de ex de,hl ret l5973: ld de,l00a9 ret l5977: ld e,2 ret ; ; SIZE ; l597a: call l0f9f ; Verify left parenthesis call l09b3 ; Verify identifier call l0fed ; Get symbol from table sub 2 jr z,l598d dec a ld e,74 call nz,l09b7 ; SIZE takes variable or type identifier l598d: call l5931 call l5842 call l0b1a ; Get token jr l59a0 ; ; ADDR ; l5998: call l0f9f ; Verify left parenthesis ld e,70 call l5829 ; ADDR takes a variable parameter l59a0: ld bc,l0001 call l4af8 jp l4b8b ; ; OUT ; l59a9: call l0f9f ; Verify left parenthesis call l44c5 call l0f9a ; Verify comma ld bc,l0003 call l44c8 call l0fa7 ; Verify right parenthesis ld hl,l59c1 jp l1062 ; Insert code ; ; ; l59c1: db 3 POP BC OUT (C),A ; ; Code for INP ; l59c5: db 5 ld c,l LD B,H IN A,(C) PUSH AF ; ; Code for INCH ; l59cb: db 4 CALL SL01BC PUSH AF ; ; Code for PROFF ; l59d0: db 5 LD A,2 LD (L08B4),A ; ; Code for PRON ; l59d6: db 5 LD A,5 LD (L08B4),A ; ; Code for READLF ; l59dc: db 9 LD HL,L0000 LD (L071F),HL LD (L0599),HL ; ; Code for USER ; l59e6: db 20 EX DE,HL CALL L0237 LL59E6 EQU $ LD BC,LA59E6-LL59E6 ADD HL,BC LD (HL),E INC HL LD (HL),D CALL L0203 LA59E6 EQU $+1 CALL $-$ CALL L0218 ; ; ; l59fb: db 3 CALL L0203 ; ; ; l59ff: db 3 CALL L0218 ; ; Code for ODD ; l5a03: db 4 LD A,L AND 1 PUSH AF ; ; Code for RANSEED ; l5a08: db 11 LD (L12C5),HL POP HL LD (L12CC),HL POP HL LD (L12D3),HL ; ; Process RANDOM ; l5a14: set 0,(ix+1) call l0b1a ; Get token ld bc,l0002 ld hl,l5a24 jp l106a ; Insert code l5a24: db 5 CALL L1258 PUSH HL PUSH DE ; ; Code for CPM ; l5a2a: db 10 EX DE,HL POP BC PUSH IX CALL L0005 POP IX PUSH HL ; ; Code for USERF - XBIOS CALL ; l5a35: db 22 EX DE,HL CALL L0237 LL5A35 EQU $ LD BC,LA5A35-LL5A35 ADD HL,BC LD (HL),E INC HL LD (HL),D CALL L0203 CALL L01A4 LA5A35 EQU $ DW 0 CALL L0218 ; ; Code for HALT ; l5a4c: db 3 CALL L0338 db 2 LD A,L PUSH AF ; ; Code for SQR (integer) ; l5a53: db 6 LD E,L LD D,H CALL L04DC PUSH HL ; ; Code for ABS (integer) ; l5a5a: db 4 CALL L050E PUSH HL ; ; Code for SQR (real) ; l5a5f: db 5 CALL L0C64 PUSH HL PUSH DE ; ; Code for ABS (real) ; l5a65: db 4 RES 7,H PUSH HL PUSH DE ; ; ; l5a6a: ld hl,l5c50 ; Give usage jp l07e7 ; ; Prepare environment of compiler ; l5a70: ld hl,(l0006) ; Get high memory ld (l014d),hl ; Save it ld hl,l5bc2 call l03ed ; Give copyright ld hl,l0080 ; Init command line ld b,h ld c,(hl) ; Get length of line add hl,bc ; Position to end inc l ld (hl),b ; Close line ld l,l0080+1 ; Reset pointer l5a86: ld a,(hl) ; Get character inc hl cp ' ' ; Skip blanks jr z,l5a86 ld d,h ; Copy start pointer ld e,l l5a8e: or a ; Test end of line jr z,l5a99 ; Yeap ld a,(hl) inc hl cp ' ' ; Find next blank jr z,l5adc jr l5a8e l5a99: ld a,' ' ld (l006d),a ; Clear second name ex de,hl ; Get back pointer ld b,0 dec hl push hl ld de,l0313 ; Point to ??? l5aa6: ld a,(hl) inc hl cp ' ' jr z,l5abc cp ';' ; Test option delimiter jr z,l5abc or a ; Test end of line jr z,l5abc cp '.' ; Test file delimiter jr z,l5abc inc b ; Advance count ld (de),a ; Unpack command line inc de jr l5aa6 l5abc:: ld a,b ; Get length of line ld (l0312),a ; Save it or a ; Test any input jp z,l5a6a ; Nope, give usage pop hl ; Get back start pointer ld de,l03ea-l0100+l1d55 ld c,a ld b,0 ldir ; Unpack line ld c,a ld a,l0009+1 sub c jr z,l5ada ld b,a ex de,hl l5ad5: ld (hl),' ' ; Clear remainder inc hl djnz l5ad5 l5ada: jr l5aee l5adc: ld a,(hl) inc hl cp ' ' jr z,l5adc cp ';' ; Test option delimiter jr z,l5a99 ld hl,l006d ld a,(hl) cp ' ' ; Test second name jr nz,l5af7 ; Yeap l5aee: ld hl,l005d ; Point to file name ld a,(hl) cp ' ' ; Verify name given jp z,l5a6a ; Give usage if not l5af7: dec l ; Fix for drive ld de,l01b1 ; Point to source file ld bc,l0009 ldir ; Unpack name of file ld l,l005d ld a,(hl) dec l cp ' ' ; Test empty name jr nz,l5b0c ; Nope ld a,(hl) ld l,l006c ld (hl),a ; Save drive l5b0c: ld de,l018d ; Point to binary file ld c,l0009 ldir ; Unpack name of file ld ix,l016a ld de,l0080+1 ; Reset command pointer l5b1a: ld a,(de) ; Get character or a ; Test end inc de jr z,l5b26 ; Yeap cp ';' ; Test option delimiter jr nz,l5b1a ; Nope, ignore call l5c88 ; Get standard option l5b26: call l0ece ; Open source file xor a ld (l3f2d),a ; Force read from file ld (l3eac),a ld a,0c3h ld (l0132),a ; Set "jp l108c" ld hl,l108c ld (l0132+1),hl ld hl,TPA exx ; Init pointer for binary code call l0b1a ; Get first token - must be 'PROGRAM' push af ; Save token ld hl,l0820 ld (l0b87+1),hl ; Disable standard options bit 6,(ix+0) ; Test write enabled jr z,l5b81 ; Nope ld de,l018d ; Point to binary file ld c,.open call l03cc ; Open file inc a ; Test on board jr z,l5b75 ; Nope bit 2,(ix+2) ; Test ask for file deletion jr nz,l5b70 ; Nope ld hl,l5c38 call l03ed call l03c6 ; Read character from keyboard and UPPMASK cp 'Y' jp nz,l0923 ; End compiler l5b70: ld c,.delete call l03cc ; Delete file l5b75: ld c,.make call l03cc ; Create new file inc a ld hl,l5c27 ; Directory full jp z,l07e7 l5b81: ld hl,(l017a) ; Get start of binary code inc h ; Make TPA relative ld (l1d55+1),hl ; Save start address for jump bit 7,(ix+2) ; Test option G jr z,l5b9a ; Nope push hl ld de,(l018b) ; Get address of option G or a sbc hl,de pop hl jp nc,l07da l5b9a: dec h ; Fix start of compiled code, zero relative ld bc,l1d55 ; Get start of binary code ld de,TPA ; Get start of code to be written into call l093e ; Write RTL to disk pop af ; Get back token toktst @PRG,23 ; 'PROGRAM' expected toktst @ID,4 ; Identifier expected cp '('+MSB ; Test parameter in parentheses jr nz,l5bbf ; Nope l5bb5: call l0b1a ; Get token cp ')'+MSB ; Find closure jr nz,l5bb5 call l0b1a ; Get token l5bbf: jp l0f73 ; Now do the compile job ; l5bc2: db cr,lf,'HiSoft Pascal80 Pedigree' db cr,lf,'Copyright HiSoft 1983,84,85,86' db cr,lf,'7 May 1987' db cr,lf,'All rights reserved.' db cr,lf,null l5c27: db cr,lf,'Directory Full',null l5c38: db cr,lf,'File exists - Delete?',null l5c50: db cr,lf,'Usage is:' db cr,lf db 'HP source <;option<,option,..>>' db cr,lf,null ; ; Get standard option ; l5c88: call l0820 ; Get base options ret nc ; Got one cp 'N' ; Test 'N'o write to file jr nz,l5c96 res 6,(ix+0) ; Clear write enabled jr l5cc3 l5c96: cp 'V' ; Test end address jr nz,l5ca2 l5c9a: call l5d0c ; Get hex value ld (l014d),hl ; Set high memory jr l5cc3 l5ca2: cp 'Y' ; Test ask for file deletion if file does exist jr nz,l5cac set 2,(ix+2) ; Set flag jr l5cc3 l5cac: cp 'R' ; Test Real number suppression ld hl,l0bac-TPA jr z,l5cc0 cp 'T' ; Test transcendental functions allowed jr nz,l5cca ; Nope ld hl,l1a1e ld (l1a26),hl ; Expand for transcendental functions ld hl,l1765-TPA l5cc0: ld (l017a),hl ; Set start of code l5cc3: ld a,(de) inc de cp ',' jr z,l5c88 ret l5cca: cp 'U' ; Test upper case jr nz,l5cd5 ld a,72h ld (l0b44),a ; Change (hl),a to (hl),d jr l5cc3 l5cd5: cp 'D' ; Test Data jr nz,l5cdf set 6,(ix+2) ; Set option D jr l5c9a l5cdf: cp 'G' ; Test option G jr nz,l5d03 call l5d0c ; Get hex value ld (l018b),hl ; Set address res 6,(ix+0) ; Clear write enabled res 0,(ix+0) ; Clear print set 7,(ix+2) ; Set option G ld hl,l0717 ld (hl),0c3h ; Change to "jp l07c5" inc hl ld de,l07c5 ld (hl),e inc hl ld (hl),d jr l5cc3 l5d03: cp 'X' ret nz set 0,(ix+3) ; Set option jr l5cc3 ; ; Get hex value from ^DE to HL - *MUST* be four digits ; l5d0c: ld b,4 ; Set max digits ld hl,0 ; Init result l5d11: ld a,(de) ; Get character inc de cp '9'+1 ; Test decimal jr c,l5d19 ; Yeap sub 'A'-'0'-10 ; Fix for hex l5d19: sub '0' ; Strip off ASCII offset add hl,hl ; Old *16 add hl,hl add hl,hl add hl,hl or l ; Insert digit ld l,a djnz l5d11 ret l5d24:: end