0000: 0000: 0000: ;******************************************************************** 0000: ;* * 0000: ;* ROM OF THE JUPITER ACE * 0000: ;* * 0000: ;******************************************************************** 0000: ;* * 0000: ;* 1996-09-23 BODO WENZEL DISASSEMBLED AND COMMENTED * 0000: ;* 2008-06-03 KIO CLEANED AND TRANSLATED * 0000: ;* 2008-06-12 KIO changes for zasm and verified result * 0000: ;* 2008-06-12 KIO LAST CHANGE * 0000: ;* * 0000: ;******************************************************************** 0000: 0000: #target rom 0000: 0000: ;================================================================ 0000: ; Constants 0000: 0000: ; Character codes 0000: KLT EQU 001H ; cursor left 0000: LOK EQU 002H ; CAPS LOCK 0000: KRT EQU 003H ; cursor right 0000: GFX EQU 004H ; graphics 0000: CDL EQU 005H ; delete character 0000: KUP EQU 007H ; cursor up 0000: INV EQU 008H ; inverted 0000: KDN EQU 009H ; cursor down 0000: LDL EQU 00AH ; clear line 0000: CCR EQU 00DH ; go to line end 0000: PND EQU 060H ; pound sterling 0000: CPR EQU 07FH ; COPYRIGHT 0000: 0000: CINV EQU 080H ; bit for inverted character 0000: CLAST EQU 080H ; bit for last character of text string 0000: 0000: IMM EQU 040H ; immediate word 0000: 0000: SAFETY EQU 12 ; minimum space for argument stack 0000: 0000: FSIGN EQU 080H ; float sign 0000: FEOFFS EQU 040H ; float exponent offset 0000: 0000: ;================================================================ 0000: ; input and output, only address bit A0 is decoded by the hardware 0000: 0000: IO EQU 0FEH ; input resets speaker FF 0000: ; D0..4 keys from selected keyboard row 0000: ; row: A15..A8 0000: ; D5 casette recorder EAR-IN 0000: ; output sets speaker FF 0000: ; D3 cassette recorder MIC-OUT 0000: 0000: ;================================================================ 0000: ; 1K video ram 0000: ; 0000: ; character rows: 24 + 4/7 + 1 + 4/7 (60/50 HZ) 0000: ; characters: 32 + 8 + 4 + 8 0000: ; screen + lower border + vsync + upper border 0000: 0000: SCREEN EQU 02400H ; 24 rows à 32 characters 0000: SCREND EQU SCREEN+24*32 0000: 0000: PADMEM EQU 02701H ; scratch 0000: FPADMEM EQU PADMEM & ~0400h ; no wait states 0000: SCRMEND EQU 02800H ; end 0000: 0000: ;================================================================ 0000: ; 1K character ram 0000: 0000: CHRSET EQU 02C00H ; 128 characters à 8 bytes 0000: 0000: ;================================================================ 0000: ; main memory: min. 1K; up to 49K 0000: 0000: MEMBEG EQU 03C00H ; start of ram address 0000: 0000: FPWS EQU 03C00H ; scratch for floating point calculations 0000: 0000: LISTWS EQU 03C13H 0000: LPICNT EQU 03C13H ; LIST/EDIT word counter 0000: LPIBUF EQU 03C14H ; LIST/EDIT indent buffer 0000: LPIACT EQU 03C15H ; LIST/EDIT indent current 0000: LPLCNT EQU 03C16H ; LIST/EDIT line counter 0000: 0000: RAMTOP EQU 03C18H ; end of ram +1 address 0000: 0000: HLD EQU 03C1AH ; pointer during "#" 0000: 0000: SCRPOS EQU 03C1CH ; output field cursor 0000: INSCRN EQU 03C1EH ; input field start 0000: CURSOR EQU 03C20H ; input field cursor 0000: ENDBUF EQU 03C22H ; input field end 0000: 0000: RAMVAR EQU 03C24H ; initialised starting from here ------- 0000: 0000: LHALF EQU 03C24H ; output field end 0000: 0000: KEYCOD EQU 03C26H ; pressed key 0000: KEYCNT EQU 03C27H ; timer 0000: STATIN EQU 03C28H ; 0 release input 0000: ; 1 caps lock 0000: ; 2 graphics 0000: ; 3 inverse 0000: ; 5 "ENTER" pressed 0000: 0000: EXWRCH EQU 03C29H ; alternative output 0000: 0000: FRAMES EQU 03C2BH ; VSYNC counter 0000: 0000: XCOORD EQU 03C2FH ; PLOT coordinates 0000: YCOORD EQU 03C30H ; 0000: 0000: VCURRENT EQU 03C31H ; address of current dictionary 0000: VCONTEXT EQU 03C33H ; address of searched dict. 0000: VOCLNK EQU 03C35H ; address of last dict. 0000: STKBOT EQU 03C37H ; address of free ram 0000: DICT EQU 03C39H ; pointer in dict. 0000: SPARE EQU 03C3BH ; pointer to argument stack ((WERTESTACK)) 0000: 0000: ERRNO EQU 03C3DH ; error number 0000: 0000: FLAGS EQU 03C3EH ; 2 compile mode 0000: ; 3 edit mode 0000: ; 4 invisible input 0000: ; 6 compiler ("[","]") 0000: 0000: VBASE EQU 03C3FH ; number base 0000: 0000: DICT1ST EQU 03C40H ; dictionary "FORTH" 0000: 0000: ;================================================================ 0000: ; Structures: 0000: ; 0000: ; Dictionary: 0000: ; DB... name (ASCII), last character flagged with bit 7 set 0000: ; DW link to previous dict. 0000: ; DW last address 0000: ; DB name length 0000: ; DW,DW Forth words for switching 0000: ; DB always 0 0000: ; DW first address 0000: ; 0000: ; Rom words: 0000: ; DB... name (ASCII), last character flagged with bit 7 set 0000: ; DW link to previous word 0000: ; DB name length 0000: ; DW first code address 0000: ; ... more data 0000: ; 0000: ; Ram words: 0000: ; DB... name (ASCII), last character flagged with bit 7 set 0000: ; DW byte offset to end of word 0000: ; DW link to previous word 0000: ; DB name length (bit 6 = "immediate") 0000: ; DW first code address 0000: ; ... more data 0000: ; 0000: ; floating point numbers: 0000: ; 3 bytes mantissa BCD 0000: ; 1 byte exponent, offset 40H, bit 7=mantissa sign 0000: ; 0000: ;================================================================ 0000: ; Error numbers 0000: 0000: ERRNONE EQU -1 ; ok 0000: ERRMEM EQU 1 ; out of memory 0000: ERRSTK EQU 2 ; stack underflow 0000: ERRBRK EQU 3 ; user breaked 0000: ERRIMM EQU 4 ; immediate mode in interpreting mode 0000: ERRBLK EQU 5 ; nesting error (e.g. "IF" - "ENDIF") 0000: ERRNAME EQU 6 ; name too long for "CRHEADER" 0000: ERRPICK EQU 7 ; bad stack offset (e.g. "PICK") 0000: ERRFLT EQU 8 ; float overflow 0000: ERRAT EQU 9 ; error in "AT" 0000: ERRREAD EQU 10 ; error in "?READ" or "?VERIFY" 0000: ERRDICT EQU 11 ; error in dict. in "REDEFINE" & "FORGET" 0000: ERRMODE EQU 12 ; compile mode in "LINKHERE" 0000: ERRFIND EQU 13 ; word not found 0000: ERRLIST EQU 14 ; word can't be listed in "LIST" 0000: 0000: 0000: ;================================================================ 0000: ; RESET 0000: 0000: #code 0,$10000 ; ((inserted by zasm)) 0000: ORG 00000H 0000: F3 DI ; disable interrupts 0001: 21003C LD HL,MEMBEG 0004: 3EFC LD A,0FCH ; test value and mask 0006: 1820 JR RMEMLP 0008: 0008: ;================================================================ 0008: ; print one character 0008: 0008: ORG 00008H 0008: RSTEMIT: 0008: D9 EXX 0009: DDCB3E5E BIT 3,(IX+FLAGS-MEMBEG) 000D: C3EE03 JP REMIT 0010: 0010: ;================================================================ 0010: ; push value in DE on argument stack 0010: 0010: ORG 00010H 0010: RSTPUSH: 0010: 2A3B3C LD HL,(SPARE) 0013: 73 LD (HL),E 0014: 23 INC HL 0015: C35F08 JP RPUSH 0018: 0018: ;================================================================ 0018: ; pop value from argument stack to DE 0018: 0018: ORG 00018H 0018: RSTPULL: 0018: 2A3B3C LD HL,(SPARE) 001B: 2B DEC HL 001C: 56 LD D,(HL) 001D: C35908 JP RPULL 0020: 0020: ;================================================================ 0020: ; display error 0020: 0020: ORG 00020H 0020: RSTERR: 0020: E1 POP HL 0021: 7E LD A,(HL) 0022: 323D3C LD (ERRNO),A ; fetch error number 0025: C3AD00 JP RABORT 0028: 0028: ;================================================================ 0028: RMEMLP: 0028: 24 INC H 0029: 77 LD (HL),A 002A: BE CP (HL) 002B: 28FB JR Z,RMEMLP ; search ram end 002D: 002D: A4 AND H 002E: 67 LD H,A ; only full kbytes 002F: 22183C LD (RAMTOP),HL ; store ram end address 0032: F9 LD SP,HL ; initialise stack pointer 0033: 210D01 LD HL,ROMVAR 0036: 1803 JR RGOON 0038: 0038: ;================================================================ 0038: ; VSYNC interrupt 0038: 0038: ORG 00038H 0038: C33A01 JP VSYNC 003B: 003B: ;================================================================ 003B: RGOON: 003B: 11243C LD DE,RAMVAR 003E: 012D00 LD BC,ROMVEND-ROMVAR 0041: EDB0 LDIR ; preset variables 0043: 0043: DD21003C LD IX,MEMBEG 0047: FD21C804 LD IY,RSLNEXT ; set pointer 004B: 004B: CD240A CALL CCLS 004E: AF XOR A 004F: 320027 LD (SCREEN+24*32),A ; set screen end marker 0052: 0052: ;---------------------------------------------------------------- 0052: 21002C LD HL,CHRSET 0055: RGFXLP: 0055: 7D LD A,L 0056: E6BF AND 0BFH ; 4 block graphic sets 0058: 0F RRCA 0059: 0F RRCA ; XX0000XX 00 005A: 0F RRCA ; XX0001XX 00 005B: 3002 JR NC,RGFXM ; XX0010XX 0F 005D: 0F RRCA ; XX0011XX 00 005E: 0F RRCA ; XX0100XX F0 005F: RGFXM: ; XX0101XX 00 005F: 0F RRCA ; XX0110XX FF 0060: 47 LD B,A ; XX0111XX 00 0061: 9F SBC A,A ; XX1000XX 00 0062: CB18 RR B ; XX1001XX 0F 0064: 47 LD B,A ; XX1010XX 0F 0065: 9F SBC A,A ; XX1011XX 0F 0066: A8 XOR B ; XX1100XX F0 0067: E6F0 AND 0F0H ; XX1101XX 0F 0069: A8 XOR B ; XX1110XX FF 006A: 77 LD (HL),A ; XX1111XX 0F 006B: 2C INC L 006C: 20E7 JR NZ,RGFXLP ; more graphic symbols? 006E: 006E: 11FF2F LD DE,CHRSET+128*8-1 0071: 21FB1F LD HL,ROMCHR-1 0074: 010800 LD BC,8 ; 8 rows 0077: EDB8 LDDR ; copyright sign 0079: 0079: EB EX DE,HL 007A: 3E5F LD A,128-020H-1 ; count of remaining characters 007C: RCHRLP: 007C: 0E07 LD C,7 ; 7 rows 007E: CB6F BIT 5,A 0080: 2803 JR Z,RCHR7 ; character with 7 rows? 0082: 70 LD (HL),B 0083: 2B DEC HL 0084: 0D DEC C ; bottom row is background only 0085: RCHR7: 0085: EB EX DE,HL 0086: EDB8 LDDR ; copy glyph 0088: EB EX DE,HL 0089: 0089: 70 LD (HL),B 008A: 2B DEC HL ; top row is background only 008B: 008B: 3D DEC A 008C: 20EE JR NZ,RCHRLP ; more characters? 008E: 008E: ED56 IM 1 ; set interrupt mode for VSYNC: RST 38H 0090: 1809 JR RQUIT 0092: 0092: ;================================================================ 0092: 515549D4 DB 'QUI','T' | CLAST 0096: 0000 DW 0 0098: 04 DB 4 0099: QUIT: 0099: 9B00 DW $+2 009B: 009B: RQUIT: 009B: ED7B183C LD SP,(RAMTOP) ; restore stack pointer 009F: FB EI ; enable interrupt 00A0: C3F204 JP QUITLOOP ; doit! 00A3: 00A3: ;================================================================ 00A3: 41424F52 00A7: D4 DB 'ABOR','T' | CLAST 00A8: 9800 DW QUIT-1 00AA: 05 DB 5 00AB: ABORT: 00AB: AD00 DW $+2 00AD: 00AD: RABORT: 00AD: FDE5 PUSH IY 00AF: FD21B904 LD IY,NEXT ; standard error checking 00B3: 00B3: 2A373C LD HL,(STKBOT) 00B6: 223B3C LD (SPARE),HL ; reset data stack 00B9: 00B9: 213E3C LD HL,FLAGS 00BC: 7E LD A,(HL) 00BD: E6B3 AND ~ ((1<<6) | (1<<3) | (1<<2)) 00BF: CB56 BIT 2,(HL) 00C1: 77 LD (HL),A ; switch off compiler and editor 00C2: 281A JR Z,ABGOON ; not in compiler mode? 00C4: 00C4: CDB904 CALL NEXT 00C7: 9004B308 00CB: 4B10 DW DP,AT,GETBYTE 00CD: 00CD: 05 DB 5 00CE: D20D6B08 00D2: 1016 DW PLUS,DUP,RESCURR ; reset 'CURRENT' 00D4: 00D4: B5151110 00D8: 373C DW NFA,GETWORD,STKBOT 00DA: 00DA: C108 DW EXCLAM ; reset stack 00DC: 0E1A DW SEMICODE 00DE: 00DE: ABGOON: 00DE: DDCB3D7E BIT 7,(IX+ERRNO-MEMBEG) 00E2: 201B JR NZ,ABORTEND ; no error set? 00E4: 00E4: CD0818 CALL ROMTXT 00E7: 4552524F 00EB: D2 DB 'ERRO','R' | CLAST 00EC: 00EC: CDB904 CALL NEXT 00EF: 11103D3C 00F3: 9608B309 00F7: 950A DW GETWORD,ERRNO,CAT,PNT,CR 00F9: 00F9: 0E1A DW SEMICODE ; display error 00FB: DD363DFF LD (IX+ERRNO-MEMBEG),ERRNONE ; no more error 00FF: 00FF: ABORTEND: 00FF: 2A373C LD HL,(STKBOT) 0102: 010C00 LD BC,SAFETY 0105: 09 ADD HL,BC 0106: 223B3C LD (SPARE),HL 0109: FDE1 POP IY 010B: 188E JR RQUIT 010D: 010D: ;================================================================ 010D: ROMVAR: 010D: E026 DW SCREEN+23*32 ;LHALF 010F: 0000 DB 0,0 ;KEYCOD 0111: 00 DB 0 ;STATIN 0112: 0000 DW 0 ;EXWRCH 0114: 00000000 DB 0,0,0,0 ;FRAMES 0118: 0000 DB 0,0 ;XCOORD/YCOORD 011A: 4C3C DW FORTH+2+RAMVAR-ROMVAR ;VCURRENT 011C: 4C3C DW FORTH+2+RAMVAR-ROMVAR ;VCONTEXT 011E: 4F3C DW FORTH+5+RAMVAR-ROMVAR ;VOCLNK 0120: 513C DW FREEMEM ;STKBOT 0122: 453C DW FORTH-5+RAMVAR-ROMVAR ;DICT 0124: 5D3C DW FREEMEM+SAFETY ;SPARE 0126: FF DB -1 ;ERRNO 0127: 00 DB 0 ;FLAGS 0128: 0A DB 10 ;VBASE 0129: 0129: 464F5254 012D: C8 DB 'FORT','H' | CLAST ;DICT1ST 012E: 012E: 0000FF1F DW 0000H,1FFFH 0132: 05 DB 5 0133: FORTH: 0133: B511 DW SETCONTEXT 0135: 493C DW FORTH-1+RAMVAR-ROMVAR ; FORTH IS CONTEXT 0137: 00 DB 0 0138: 0000 DW 0 013A: 013A: ROMVEND: 013A: FREEMEM EQU ROMVEND+RAMVAR-ROMVAR ; free ram 013A: 013A: ;================================================================ 013A: VSYNC: 013A: F5 PUSH AF 013B: 08 EX AF,AF' 013C: F5 PUSH AF 013D: C5 PUSH BC 013E: D5 PUSH DE 013F: E5 PUSH HL ; save registers 0140: 0140: 063E LD B,62 0142: VDELAY: 0142: 10FE DJNZ VDELAY ; wait some time: the interrupt signal 0144: ; remains active for 1 character row == 1/39 frame !! 0144: 0144: 212B3C LD HL,FRAMES 0147: VSCNT: 0147: 34 INC (HL) 0148: 23 INC HL 0149: 28FC JR Z,VSCNT ; increment VSYNC counter 014B: 014B: CD1003 CALL VKEY ; get key with auto repeat 014E: 014E: 21283C LD HL,STATIN 0151: CB46 BIT 0,(HL) 0153: 2821 JR Z,VSEND ; input disabled? 0155: A7 AND A 0156: 281E JR Z,VSEND ; no key pressed? 0158: FE20 CP ' ' 015A: 3814 JR C,VSCTRL ; control code? 015C: 015C: CB4E BIT 1,(HL) 015E: C40708 CALL NZ,TOUPPER ; "CAPS LOCK" ? 0161: CB56 BIT 2,(HL) 0163: 2802 JR Z,VSNOGRF 0165: E69F AND 09FH ; "GRAPHICS" ? 0167: VSNOGRF: 0167: CB5E BIT 3,(HL) 0169: 2802 JR Z,VSNOINV 016B: F680 OR CINV ; "INVERSE" ? 016D: VSNOINV: 016D: CD9601 CALL DCDCNORM ; printable character 0170: 0170: VSCTRL: 0170: CDE601 CALL DOCTRL ; control code 0173: 0173: CD8202 CALL DCSETCUR ; locate cursor 0176: VSEND: 0176: E1 POP HL 0177: D1 POP DE 0178: C1 POP BC 0179: F1 POP AF 017A: 08 EX AF,AF' 017B: F1 POP AF ; restore registers 017C: 017C: FB EI ; re-enable interrupts 017D: C9 RET ; return to interrupted programme 017E: 017E: ;================================================================ 017E: DCDOCHAR: 017E: FE0D CP CCR 0180: 2014 JR NZ,DCDCNORM ; not "ENTER" ? 0182: 0182: 210027 LD HL,SCREEN+24*32 0185: 22223C LD (ENDBUF),HL 0188: 22203C LD (CURSOR),HL ; move cursor to frame end 018B: 018B: AF XOR A 018C: CD9801 CALL DCDCINS ; set new input end 018F: 018F: 21E026 LD HL,SCREEN+23*32 0192: 221E3C LD (INSCRN),HL ; one line input 0195: C9 RET 0196: 0196: DCDCNORM: 0196: A7 AND A 0197: C8 RET Z ; no key? 0198: 0198: DCDCINS: 0198: 08 EX AF,AF' ; remember character 0199: 0199: 2A223C LD HL,(ENDBUF) 019C: 7E LD A,(HL) 019D: A7 AND A 019E: 2806 JR Z,DCDCSCROL 01A0: 1100D9 LD DE,-(SCREEN+24*32) 01A3: 19 ADD HL,DE 01A4: 3028 JR NC,DCDCEND ; input end before screen end? 01A6: 01A6: DCDCSCROL: 01A6: ED5B243C LD DE,(LHALF) 01AA: 21A0DB LD HL,-(SCREEN+3*32) 01AD: 19 ADD HL,DE 01AE: 3034 JR NC,DCDCQUIT ; output end within first 3 lines? 01B0: 01B0: 2A1C3C LD HL,(SCRPOS) 01B3: 012000 LD BC,32 01B6: 09 ADD HL,BC 01B7: ED52 SBC HL,DE 01B9: D5 PUSH DE 01BA: D42104 CALL NC,SCROLLUP ; output cursor in last line? 01BD: 01BD: CDB002 CALL DCSTREND 01C0: D1 POP DE 01C1: CD2F04 CALL INSLINE ; scroll up input 01C4: 01C4: 211E3C LD HL,INSCRN 01C7: 0604 LD B,4 ; 4 times 01C9: DCDCSLOOP: 01C9: CD4304 CALL DECLINE 01CC: 10FB DJNZ DCDCSLOOP ; scroll up input start 01CE: 01CE: DCDCEND: 01CE: CD0203 CALL DCGETCIN 01D1: 54 LD D,H 01D2: 5D LD E,L 01D3: 23 INC HL 01D4: 22223C LD (ENDBUF),HL ; scroll input end 01D7: 01D7: 2B DEC HL 01D8: 2B DEC HL 01D9: 2802 JR Z,DCDCSTORE ; input cursor at end? 01DB: 01DB: EDB8 LDDR ; shift remaining input 01DD: 01DD: DCDCSTORE: 01DD: 08 EX AF,AF' 01DE: 12 LD (DE),A ; store character 01DF: 13 INC DE 01E0: ED53203C LD (CURSOR),DE ; store new input address 01E4: DCDCQUIT: 01E4: AF XOR A ; set Z flag, no more chacters 01E5: C9 RET 01E6: 01E6: ;================================================================ 01E6: DOCTRL: 01E6: 21F001 LD HL,DCJMPTAB 01E9: 1600 LD D,0 01EB: 5F LD E,A 01EC: 19 ADD HL,DE ; pointer to table entry 01ED: 5E LD E,(HL) 01EE: 19 ADD HL,DE 01EF: E9 JP (HL) ; jump to address 01F0: DCJMPTAB: 01F0: 20 DB DCNOP-$ ; 0 (no key) 01F1: 13 DB DCLEFT-$ ; 1 cursor left 01F2: 0C DB DCFLAG-$ ; 2 caps lock 01F3: 1E DB DCRIGHT-$ ; 3 cursor right 01F4: 0A DB DCFLAG-$ ; 4 graphic symbol 01F5: 37 DB DCCHARDEL-$ ; 5 delete character 01F6: 1A DB DCNOP-$ ; 6 (unused) 01F7: 50 DB DCUP-$ ; 7 cursor up 01F8: 06 DB DCFLAG-$ ; 8 inverted 01F9: 9C DB DCDOWN-$ ; 9 cursor down 01FA: C9 DB DCLINEDEL-$ ; A clear line 01FB: 15 DB DCNOP-$ ; B (unused) 01FC: 14 DB DCNOP-$ ; C (unused) 01FD: D3 DB DCENTER-$ ; D end of line 01FE: 01FE: ;---------------------------------------------------------------- 01FE: DCFLAG: 01FE: 21283C LD HL,STATIN 0201: AE XOR (HL) 0202: 77 LD (HL),A ; toggle flag 0203: C9 RET 0204: 0204: ;---------------------------------------------------------------- 0204: DCLEFT: 0204: 2A203C LD HL,(CURSOR) 0207: 2B DEC HL 0208: 7E LD A,(HL) 0209: A7 AND A 020A: C8 RET Z ; at input start? 020B: 020B: 22203C LD (CURSOR),HL ; store new address 020E: 020E: 23 INC HL 020F: 77 LD (HL),A ; move character 0210: DCNOP: 0210: C9 RET 0211: 0211: ;---------------------------------------------------------------- 0211: DCRIGHT: 0211: 2A203C LD HL,(CURSOR) 0214: 23 INC HL 0215: ED5B223C LD DE,(ENDBUF) 0219: A7 AND A 021A: ED52 SBC HL,DE 021C: C8 RET Z ; at input end? 021D: 021D: 19 ADD HL,DE 021E: 22203C LD (CURSOR),HL ; store new address 0221: 0221: 7E LD A,(HL) 0222: 2B DEC HL 0223: 77 LD (HL),A ; move character 0224: C9 RET 0225: 0225: ;---------------------------------------------------------------- 0225: DCCURDEL: 0225: 2A203C LD HL,(CURSOR) 0228: 23 INC HL 0229: 22203C LD (CURSOR),HL ; increment input address 022C: 022C: DCCHARDEL: 022C: CD0203 CALL DCGETCIN 022F: 62 LD H,D 0230: 6B LD L,E 0231: 1B DEC DE 0232: 1A LD A,(DE) 0233: A7 AND A 0234: C8 RET Z ; at input start? 0235: 0235: ED53203C LD (CURSOR),DE 0239: 78 LD A,B 023A: B1 OR C 023B: 2802 JR Z,DCCDGOON ; at input end? 023D: 023D: EDB0 LDIR ; delete character to the left 023F: DCCDGOON: 023F: 2B DEC HL 0240: 3620 LD (HL),' ' ; delete last character 0242: 22223C LD (ENDBUF),HL ; (superfluxuous?) 0245: 0245: 0C INC C ; clear Z flag 0246: C9 RET 0247: 0247: ;---------------------------------------------------------------- 0247: DCUP: 0247: CD0402 CALL DCLEFT 024A: 2808 JR Z,DCUSCROLL ; at input start? 024C: 024C: 061F LD B,31 024E: DCUPLOOP: 024E: CD0402 CALL DCLEFT 0251: 10FB DJNZ DCUPLOOP ; at most one line back 0253: C9 RET 0254: 0254: DCUSCROLL: 0254: 2A1E3C LD HL,(INSCRN) 0257: ED5B243C LD DE,(LHALF) 025B: A7 AND A 025C: ED52 SBC HL,DE 025E: C8 RET Z ; input start at output end? 025F: 025F: CD2502 CALL DCCURDEL 0262: 0262: 2A1E3C LD HL,(INSCRN) 0265: 11E0FF LD DE,-32 0268: AF XOR A 0269: DCUSLOOP: 0269: 19 ADD HL,DE 026A: BE CP (HL) 026B: 20FC JR NZ,DCUSLOOP ; search next tag 026D: 026D: 221E3C LD (INSCRN),HL 0270: 0270: CDF402 CALL DCSETEND 0273: 22203C LD (CURSOR),HL ; store new input end 0276: 0276: ;---------------------------------------------------------------- 0276: DCOUTCUR: 0276: 3EA0 LD A,' ' | CINV 0278: CD7E01 CALL DCDOCHAR ; print cursor blob 027B: 027B: 2A203C LD HL,(CURSOR) 027E: 2B DEC HL 027F: 22203C LD (CURSOR),HL ; update address 0282: 0282: DCSETCUR: 0282: 2A203C LD HL,(CURSOR) 0285: 3A283C LD A,(STATIN) 0288: 1F RRA 0289: 3697 LD (HL),017H | CINV ; "NORMAL" 028B: 1F RRA 028C: 3002 JR NC,SCNOCAPS 028E: 36C3 LD (HL),'C' | CINV ; "CAPS LOCK" 0290: SCNOCAPS: 0290: 1F RRA 0291: D0 RET NC 0292: 36C7 LD (HL),'G' | CINV ; "GRAFIK" 0294: C9 RET 0295: 0295: ;---------------------------------------------------------------- 0295: DCDOWN: 0295: CD1102 CALL DCRIGHT 0298: 2808 JR Z,DCDSCROLL ; at input end? 029A: 061F LD B,31 029C: DCDNLOOP: 029C: CD1102 CALL DCRIGHT 029F: 10FB DJNZ DCDNLOOP ; at most one line down 02A1: C9 RET 02A2: 02A2: DCDSCROLL: 02A2: CDB002 CALL DCSTREND 02A5: E0 RET PO ; end found? 02A6: E5 PUSH HL 02A7: CD2502 CALL DCCURDEL 02AA: E1 POP HL 02AB: CDED02 CALL DCSETBEG ; store new input start 02AE: 18C6 JR DCOUTCUR 02B0: 02B0: ;---------------------------------------------------------------- 02B0: DCSTREND: 02B0: 210027 LD HL,SCREEN+24*32 02B3: ED5B1E3C LD DE,(INSCRN) 02B7: A7 AND A 02B8: ED52 SBC HL,DE 02BA: 44 LD B,H 02BB: 4D LD C,L ; calculate count 02BC: 02BC: EB EX DE,HL 02BD: 23 INC HL ; pointer behind start 02BE: 02BE: AF XOR A 02BF: EDB1 CPIR ; search end of text 02C1: 2B DEC HL ; back one charatcer 02C2: C9 RET 02C3: 02C3: ;---------------------------------------------------------------- 02C3: DCLINEDEL: 02C3: 2A223C LD HL,(ENDBUF) 02C6: 2B DEC HL 02C7: 22203C LD (CURSOR),HL ; pointer to input end 02CA: 02CA: DCLDLOOP: 02CA: CD2C02 CALL DCCHARDEL 02CD: 20FB JR NZ,DCLDLOOP ; clear to start 02CF: C9 RET 02D0: 02D0: ;---------------------------------------------------------------- 02D0: DCENTER: 02D0: 21283C LD HL,STATIN 02D3: CBEE SET 5,(HL) ; print "ENTER" 02D5: CB86 RES 0,(HL) ; disable input 02D7: C9 RET 02D8: 02D8: ;---------------------------------------------------------------- 02D8: DCCLEAR: 02D8: 210027 LD HL,SCREEN+24*32 02DB: ED5B243C LD DE,(LHALF) 02DF: CDFA07 CALL BLANKS ; clear input area 02E2: 02E2: 21E026 LD HL,SCREEN+23*32 02E5: 22243C LD (LHALF),HL 02E8: 3600 LD (HL),0 ; set text end marker 02EA: 02EA: DCRETYPE: 02EA: 2A243C LD HL,(LHALF) 02ED: 02ED: DCSETBEG: 02ED: 221E3C LD (INSCRN),HL ; store input start 02F0: 23 INC HL 02F1: 22203C LD (CURSOR),HL ; store cursor address 02F4: 02F4: DCSETEND: 02F4: CDB002 CALL DCSTREND 02F7: 3E20 LD A,' ' 02F9: DCSELOOP: 02F9: 2B DEC HL 02FA: BE CP (HL) 02FB: 28FC JR Z,DCSELOOP ; search input end 02FD: 02FD: 23 INC HL 02FE: 22223C LD (ENDBUF),HL ; store input end 0301: C9 RET 0302: 0302: ;---------------------------------------------------------------- 0302: DCGETCIN: 0302: 2A223C LD HL,(ENDBUF) 0305: ED5B203C LD DE,(CURSOR) 0309: A7 AND A 030A: ED52 SBC HL,DE 030C: 44 LD B,H 030D: 4D LD C,L ; calculate count 030E: 030E: 19 ADD HL,DE ; restore pointer 030F: C9 RET 0310: 0310: ;---------------------------------------------------------------- 0310: VKEY: 0310: CD3603 CALL KEYGET 0313: 47 LD B,A ; get pressed key 0314: 0314: 2A263C LD HL,(KEYCOD) 0317: AD XOR L 0318: 280B JR Z,VKAGAIN ; still same key? 031A: AD XOR L 031B: 2803 JR Z,VKNEW ; no key pressed? 031D: AF XOR A 031E: BD CP L 031F: C0 RET NZ ; now different key? 0320: 0320: VKNEW: 0320: 68 LD L,B ; save key 0321: 2620 LD H,32 ; load timer count 0323: 180D JR VKQUIT 0325: 0325: VKAGAIN: 0325: 25 DEC H ; decrement timer count 0326: 0326: 7C LD A,H 0327: FE1E CP 30 0329: 2806 JR Z,VKPRESS ; key debounced? 032B: 032B: AF XOR A 032C: BC CP H 032D: 2003 JR NZ,VKQUIT ; reached auto-repeat time? 032F: 032F: 2604 LD H,4 ; reset timer count 0331: VKPRESS: 0331: 7D LD A,L ; get key 0332: VKQUIT: 0332: 22263C LD (KEYCOD),HL 0335: C9 RET 0336: 0336: ;---------------------------------------------------------------- 0336: KEYGET: 0336: 01FEFE LD BC,IO | (0FEH << 8) ; masl and address 0339: ED50 IN D,(C) ; line with "SHIFT" and "SYMBOL" 033B: 5A LD E,D ; save 033C: 033C: CB3A SRL D 033E: 9F SBC A,A 033F: E6D8 AND -40 ; offset for "no shift" 0341: CB3A SRL D 0343: 3802 JR C,KEYGNC ; no "SYMBOL"? 0345: 3E28 LD A,40 ; key count 0347: KEYGNC: 0347: C657 ADD A,2*40+7 ; NORMAL "SHIFT" "SYMBOL" 0349: 6F LD L,A ; 47 87 127 034A: 034A: 7B LD A,E 034B: F603 OR 3 ; line without "SHIFT" and "SYMBOL" 034D: 034D: 1EFF LD E,0FFH ; key not yet found 034F: KEYGLP: 034F: 2F CPL 0350: E61F AND 1FH 0352: 57 LD D,A ; mask key 0353: 280D JR Z,KEYGNK ; no key pressed? 0355: 0355: 7D LD A,L 0356: 1C INC E 0357: 2012 JR NZ,KEYGQU ; already key pressed? 0359: KEYGSC: 0359: D608 SUB 8 ; adjust offset 035B: CB3A SRL D 035D: 30FA JR NC,KEYGSC ; key not yet found? 035F: 035F: 5F LD E,A ; save offset 0360: 2009 JR NZ,KEYGQU ; one more key pressed? 0362: KEYGNK: 0362: 2D DEC L ; adjust offset 0363: CB00 RLC B 0365: 3006 JR NC,KEYGQU2 ; keyboard completed? 0367: 0367: ED78 IN A,(C) ; get next key 0369: 18E4 JR KEYGLP 036B: 036B: KEYGQU: 036B: 1EFF LD E,-1 ; no key pressed 036D: KEYGQU2: 036D: 7B LD A,E 036E: 3C INC A 036F: C8 RET Z ; no key pressed? 0370: 0370: 217603 LD HL,KEYTBL 0373: 19 ADD HL,DE 0374: 7E LD A,(HL) ; get key code 0375: C9 RET 0376: KEYTBL: 0376: 76687936 037A: 35746763 DB 'v','h','y','6','5','t','g','c' ; NORMAL 037E: 037E: 626A7537 0382: 34726678 DB 'b','j','u','7','4','r','f','x' 0386: 0386: 6E6B6938 038A: 3365647A DB 'n','k','i','8','3','e','d','z' 038E: 038E: 6D6C6F39 0392: 32777300 DB 'm','l','o','9','2','w','s',0 0396: 0396: 200D7030 039A: 31716100 DB ' ',CCR,'p','0','1','q','a',0 039E: 039E: 039E: 56485907 03A2: 01544743 DB 'V','H','Y',KUP,KLT,'T','G','C' ; with "SHIFT" 03A6: 03A6: 424A5509 03AA: 08524658 DB 'B','J','U',KDN,INV,'R','F','X' 03AE: 03AE: 4E4B4903 03B2: 3345445A DB 'N','K','I',KRT,'3','E','D','Z' 03B6: 03B6: 4D4C4F04 03BA: 02575300 DB 'M','L','O',GFX,LOK,'W','S',0 03BE: 03BE: 200D5005 03C2: 0A514100 DB ' ',CCR,'P',CDL,LDL,'Q','A',0 03C6: 03C6: 03C6: 2F5E5B26 03CA: 253E7D3F DB '/','^','[','&','%','>','}','?' ; with "SYMBOL" 03CE: 03CE: 2A2D5D27 03D2: 243C7B60 DB '*','-',']',"'",'$','<','{',PND 03D6: 03D6: 2C2B7F28 03DA: 23455C3A DB ',','+',CPR,'(','#','E','\',':' 03DE: 03DE: 2E3D3B29 03E2: 40577C00 DB '.','=',';',')','@','W','|',0 03E6: 03E6: 200D225F 03EA: 21517E00 DB ' ',CCR,'"','_','!','Q','~',0 03EE: 03EE: ;================================================================ 03EE: REMIT: 03EE: 2805 JR Z,RENORM ; not "EDIT" ? 03F0: CD7E01 CALL DCDOCHAR 03F3: D9 EXX 03F4: C9 RET 03F5: 03F5: RENORM: 03F5: 47 LD B,A 03F6: 2A293C LD HL,(EXWRCH) 03F9: 7C LD A,H 03FA: B5 OR L 03FB: 78 LD A,B 03FC: 2801 JR Z,EMITSCR 03FE: E9 JP (HL) ; use output vector? 03FF: 03FF: EMITSCR: 03FF: 2A1C3C LD HL,(SCRPOS) 0402: ED5B243C LD DE,(LHALF) 0406: EB EX DE,HL 0407: 37 SCF 0408: ED52 SBC HL,DE 040A: EB EX DE,HL 040B: DC2104 CALL C,SCROLLUP ; scroll up one line if needed 040E: 040E: FE0D CP CCR 0410: 2804 JR Z,ESENTER ; "ENTER" ? 0412: 0412: 77 LD (HL),A ; store character 0413: 23 INC HL ; next address 0414: 1806 JR ESQUIT 0416: 0416: ESENTER: 0416: 23 INC HL 0417: 7D LD A,L 0418: E61F AND 32-1 041A: 20FA JR NZ,ESENTER ; move pointer to start of next line 041C: 041C: ESQUIT: 041C: 221C3C LD (SCRPOS),HL ; store cursor address 041F: D9 EXX 0420: C9 RET 0421: 0421: ;---------------------------------------------------------------- 0421: SCROLLUP: 0421: F5 PUSH AF 0422: 211C3C LD HL,SCRPOS 0425: CD4304 CALL DECLINE ; adjust cursor address 0428: F1 POP AF 0429: 0429: 2A243C LD HL,(LHALF) 042C: 112024 LD DE,SCREEN+32 ; scroll up output area 042F: 042F: INSLINE: 042F: A7 AND A 0430: ED52 SBC HL,DE 0432: 44 LD B,H 0433: 4D LD C,L ; character count 0434: 21E0FF LD HL,-32 0437: 19 ADD HL,DE 0438: EB EX DE,HL 0439: EDB0 LDIR ; scroll screen up 043B: 0620 LD B,32 043D: ILLOOP: 043D: 2B DEC HL 043E: 3620 LD (HL),' ' 0440: 10FB DJNZ ILLOOP ; clear new line 0442: C9 RET 0443: 0443: ;---------------------------------------------------------------- 0443: DECLINE: 0443: 7E LD A,(HL) 0444: D620 SUB 32 0446: 77 LD (HL),A 0447: 23 INC HL 0448: 3001 JR NC,DLEND 044A: 35 DEC (HL) 044B: DLEND: 044B: 23 INC HL 044C: C9 RET 044D: 044D: ;================================================================ 044D: GETVAR: 044D: EB EX DE,HL 044E: 5E LD E,(HL) 044F: 1600 LD D,0 ; get offset 0451: 21003C LD HL,MEMBEG 0454: 19 ADD HL,DE 0455: EB EX DE,HL 0456: D7 RST RSTPUSH ; address on stack 0457: FDE9 JP (IY) 0459: 0459: ;================================================================ 0459: 484552C5 DB 'HER','E' | CLAST 045D: AA00 DW ABORT-1 045F: 04 DB 4 0460: 6204 HERE: DW $+2 0462: ED5B373C LD DE,(STKBOT) 0466: D7 RST RSTPUSH 0467: FDE9 JP (IY) 0469: 0469: ;================================================================ 0469: 434F4E54 046D: 4558D4 DB 'CONTEX','T' | CLAST 0470: 5F04 DW HERE-1 0472: 07 DB 7 0473: CONTEXT: 0473: 4D04 DW GETVAR 0475: 33 DB VCONTEXT-MEMBEG 0476: 0476: ;================================================================ 0476: 43555252 047A: 454ED4 DB 'CURREN','T' | CLAST 047D: 7204 DW CONTEXT-1 047F: 07 DB 7 0480: CURRENT: 0480: 4D04 DW GETVAR 0482: 31 DB VCURRENT-MEMBEG 0483: 0483: ;================================================================ 0483: 424153C5 DB 'BAS','E' | CLAST 0487: 7F04 DW CURRENT-1 0489: 04 DB 4 048A: 4D04 BASE: DW GETVAR 048C: 3F DB VBASE-MEMBEG 048D: 048D: ;================================================================ 048D: GETFLAGS: 048D: 4D04 DW GETVAR 048F: 3E DB FLAGS-MEMBEG 0490: 0490: ;================================================================ 0490: DP: 0490: 4D04 DW GETVAR 0492: 39 DB DICT-MEMBEG 0493: 0493: ;================================================================ 0493: 5041C4 DB 'PA','D' | CLAST 0496: 8904 DW BASE-1 0498: 03 DB 3 0499: F50F0127 PAD: DW DOCONSTANT,PADMEM 049D: 049D: ;================================================================ 049D: NSEMICOLON: 049D: BB DB ';' | CLAST 049E: 9804 DW PAD-1 04A0: 41 DB 1 | IMM 04A1: SEMICOLON: 04A1: 0811B604 DW DOCOMPILER,SEMIS 04A5: D812 DW ASSERT 04A7: 0A DB 10 ; test test value 04A8: 0E1A DW SEMICODE 04AA: 04AA: 213E3C LD HL,FLAGS 04AD: 7E LD A,(HL) 04AE: E6BB AND ~ ((1 << 6) | (1 << 2)) 04B0: 77 LD (HL),A ; switch off compiler 04B1: FDE9 JP (IY) 04B3: 04B3: ;================================================================ 04B3: 00 DB 0 04B4: E8FF DW NSEMICOLON-$-1 04B6: B804 SEMIS: DW RSEMIS 04B8: E1 RSEMIS: POP HL ; dispose off current pointer 04B9: 04B9: E1 NEXT: POP HL ; get pointer 04BA: NEXTSUB: 04BA: 5E LD E,(HL) 04BB: 23 INC HL 04BC: 56 LD D,(HL) 04BD: 23 INC HL 04BE: E5 PUSH HL ; get next Forth address 04BF: EB NEXTDE: EX DE,HL 04C0: 5E LD E,(HL) 04C1: 23 INC HL 04C2: 56 LD D,(HL) 04C3: 23 INC HL 04C4: EB EX DE,HL 04C5: E9 JP (HL) ; jump to machine code 04C6: 04C6: ;================================================================ 04C6: SLNEXT: 04C6: C804 DW RSLNEXT 04C8: RSLNEXT: 04C8: 010B00 LD BC,11 04CB: ED5B3B3C LD DE,(SPARE) 04CF: 2A373C LD HL,(STKBOT) 04D2: 09 ADD HL,BC 04D3: ED52 SBC HL,DE 04D5: 3802 JR C,RSLNGOON ; still enough room between stacks? 04D7: ERRORSTK: 04D7: E7 RST RSTERR 04D8: 02 DB ERRSTK 04D9: 04D9: RSLNGOON: 04D9: 010000 LD BC,0 04DC: CD8C0F CALL MEMCHECK 04DF: CDE404 CALL USERBREAK 04E2: 18D5 JR NEXT 04E4: 04E4: ;================================================================ 04E4: USERBREAK: 04E4: 3EFE LD A,0FEH 04E6: DBFE IN A,(IO) ; read keyboard row 04E8: 1F RRA 04E9: D8 RET C ;"SHIFT" not pressed? 04EA: 3E7F LD A,7FH 04EC: DBFE IN A,(IO) ; read keyboard row 04EE: 1F RRA 04EF: D8 RET C ;"BREAK" not pressed? 04F0: BREAK: 04F0: E7 RST RSTERR 04F1: 03 DB ERRBRK 04F2: 04F2: ;================================================================ 04F2: QUITLOOP: 04F2: CDB904 CALL NEXT 04F5: QLLOOP: 04F5: 8C05 DW QUERY ; get one line 04F7: 0605 DW LINE ; and interpret 04F9: 3605 DW OK ; and print "OK" 04FB: 7612 DW DOREPEAT ; infinite loop 04FD: F7FF DW QLLOOP-$-1 04FF: 04FF: ;================================================================ 04FF: 4C494EC5 DB 'LIN','E' | CLAST 0503: A004 DW SEMICOLON-1 0505: 04 DB 4 0506: C30E LINE: DW DOCOL 0508: LINELOOP: 0508: C604 DW SLNEXT ; check all 050A: 3D06EE08 DW FIND,QDUP ; search word 050E: 8312 DW DOIF ; not found? 0510: 0700 DW LINENUM-$-1 0512: 4F05 DW CHKIMM ; execute word 0514: 7612 DW DOREPEAT 0516: F1FF DW LINELOOP-$-1 0518: LINENUM: 0518: A906EE08 DW NUMBER,QDUP ; search number 051C: 8312 DW DOIF ; not found? 051E: 0700 DW LINESTR-$-1 0520: 6405 DW CHKNUMBER ; execute number 0522: 7612 DW DOREPEAT 0524: E3FF DW LINELOOP-$-1 0526: LINESTR: 0526: 1B061A0C DW CHKSTRING,ZEROEQ ; search text 052A: 8312 DW DOIF ; not found? 052C: 0300 DW LINEERR-$-1 052E: B604 DW SEMIS 0530: LINEERR: 0530: 7805 DW RETYPE ; display error 0532: 7612 DW DOREPEAT 0534: D3FF DW LINELOOP-$-1 0536: 0536: ;================================================================ 0536: 3805 OK: DW $+2 0538: 3A3E3C LD A,(FLAGS) 053B: CB77 BIT 6,A 053D: 200E JR NZ,OKQUIT ; is the compiler still ON? 053F: CB67 BIT 4,A 0541: 200A JR NZ,OKQUIT ; input invisible? 0543: CD0818 CALL ROMTXT 0546: 204F4BA0 DB ' OK',' ' | CLAST 054A: 3E0D LD A,CCR 054C: CF RST RSTEMIT 054D: OKQUIT: 054D: FDE9 JP (IY) 054F: 054F: ;================================================================ 054F: CHKIMM: 054F: 5105 DW $+2 0551: 0551: DF RST RSTPULL ; code array address 0552: 1B DEC DE 0553: 1A LD A,(DE) 0554: 2F CPL 0555: DDA63E AND (IX+FLAGS-MEMBEG) 0558: E640 AND 1 << 6 055A: 13 INC DE 055B: 2804 JR Z,CHKIQUIT ; compiler OFF or immediate? 055D: 055D: D7 RST RSTPUSH 055E: 114E0F LD DE,KOMMA 0561: CHKIQUIT: 0561: C3BF04 JP NEXTDE 0564: 0564: ;---------------------------------------------------------------- 0564: CHKNUMBER: 0564: 6605 DW $+2 0566: 0566: DF RST RSTPULL 0567: DDCB3E76 BIT 6,(IX+FLAGS-MEMBEG) 056B: 20F4 JR NZ,CHKIQUIT ; compiler ON? 056D: FDE9 JP (IY) 056F: 056F: ;================================================================ 056F: 52455459 0573: 50C5 DB 'RETYP','E' | CLAST 0575: 0575: 8B05 DW QUERY-1 0577: 06 DB 6 0578: RETYPE: 0578: 7A05 DW $+2 057A: 057A: CDEA02 CALL DCRETYPE 057D: CD7602 CALL DCOUTCUR 0580: 36BF LD (HL),'?' | CINV ; change cursor 0582: 1810 JR QSTART 0584: 0584: ;================================================================ 0584: 51554552 0588: D9 DB 'QUER','Y' | CLAST 0589: 0589: 0505 DW LINE-1 058B: 05 DB 5 058C: QUERY: 058C: 8E05 DW $+2 058E: 058E: CDD802 CALL DCCLEAR 0591: CD7602 CALL DCOUTCUR 0594: 0594: QSTART: 0594: 21283C LD HL,STATIN 0597: CBC6 SET 0,(HL) ; release input 0599: CBAE RES 5,(HL) ; no "ENTER" yet 059B: QLOOP: 059B: CB6E BIT 5,(HL) 059D: 28FC JR Z,QLOOP ; wait for "ENTER" 059F: 059F: CD2502 CALL DCCURDEL 05A2: FDE9 JP (IY) 05A4: 05A4: ;================================================================ 05A4: 574F52C4 DB 'WOR','D' | CLAST 05A8: 7705 DW RETYPE-1 05AA: 04 DB 4 05AB: AD05 WORD: DW $+2 05AD: DF RST RSTPULL ; get delimiter 05AE: 05AE: 21FE27 LD HL,SCRMEND-2 05B1: 06FD LD B,SCRMEND-SCREND-3 05B3: WCLLOOP: 05B3: 3620 LD (HL),' ' 05B5: 2B DEC HL 05B6: 10FB DJNZ WCLLOOP ;clear buffer 05B8: 05B8: D5 PUSH DE 05B9: EB EX DE,HL 05BA: D7 RST RSTPUSH 05BB: D1 POP DE 05BC: CDE105 CALL CWORD ; read text 05BF: 05BF: 04 INC B 05C0: 05 DEC B 05C1: 2803 JR Z,WGOON1 05C3: 01FF00 LD BC,255 ; limit count to 255 05C6: WGOON1: 05C6: 210127 LD HL,PADMEM 05C9: 71 LD (HL),C ; store count 05CA: 23 INC HL 05CB: 3EFC LD A,252 05CD: B9 CP C 05CE: 3001 JR NC,WGOON2 05D0: 4F LD C,A ;limit count 05D1: WGOON2: 05D1: 0C INC C 05D2: D5 PUSH DE 05D3: C5 PUSH BC 05D4: EB EX DE,HL 05D5: EDB0 LDIR ; move input 05D7: C1 POP BC 05D8: D1 POP DE 05D9: 0D DEC C 05DA: CDDA07 CALL BLWORD ; clear input 05DD: FDE9 JP (IY) 05DF: 05DF: ;================================================================ 05DF: GETSTRING: 05DF: 1E20 LD E,' ' ; space character is delimiter 05E1: CWORD: 05E1: 2A243C LD HL,(LHALF) 05E4: 221E3C LD (INSCRN),HL 05E7: 05E7: 010000 LD BC,0 ; no character yet 05EA: CWLOOP1: 05EA: 23 INC HL 05EB: 7E LD A,(HL) 05EC: BB CP E 05ED: 28FB JR Z,CWLOOP1 ; search start 05EF: A7 AND A 05F0: 280E JR Z,CWNFND 05F2: 05F2: E5 PUSH HL ; save start 05F3: CWLOOP2: 05F3: 03 INC BC ; count 05F4: 23 INC HL 05F5: 7E LD A,(HL) 05F6: A7 AND A 05F7: 2803 JR Z,CWEND ;end of text? 05F9: BB CP E 05FA: 20F7 JR NZ,CWLOOP2 ; search end 05FC: CWEND: 05FC: D1 POP DE ; restore start 05FD: 05FD: AF XOR A 05FE: B8 CP B 05FF: C9 RET ; test for count == 256 0600: 0600: CWNFND: 0600: D5 PUSH DE 0601: CDB002 CALL DCSTREND 0604: E21406 JP PO,CWERR ; input end found? 0607: ED5B243C LD DE,(LHALF) 060B: CDFA07 CALL BLANKS ; clear input area 060E: 22243C LD (LHALF),HL 0611: D1 POP DE 0612: 18CD JR CWORD ; next word 0614: 0614: CWERR: 0614: EB EX DE,HL ; pointer to end (???) 0615: C1 POP BC 0616: 010000 LD BC,0 0619: 37 SCF ; flag no success 061A: C9 RET 061B: 061B: ;================================================================ 061B: CHKSTRING: 061B: 1D06 DW $+2 061D: 061D: CDDF05 CALL GETSTRING 0620: 50 LD D,B 0621: 59 LD E,C 0622: D7 RST RSTPUSH 0623: FDE9 JP (IY) 0625: 0625: ;================================================================ 0625: 564C4953 0629: D4 DB 'VLIS','T' | CLAST 062A: 062A: AA05 DW WORD-1 062C: 05 DB 5 062D: VLIST: 062D: 2F06 DW $+2 062F: 062F: 3E0D LD A,CCR 0631: CF RST RSTEMIT 0632: 0632: 0E00 LD C,0 ; find all words 0634: 180E JR RFIND 0636: 0636: ;================================================================ 0636: 46494EC4 DB 'FIN','D' | CLAST 063A: 2C06 DW VLIST-1 063C: 04 DB 4 063D: FIND: 063D: 3F06 DW $+2 063F: 063F: CDDF05 CALL GETSTRING 0642: 3846 JR C,RZERO ; no word entered? 0644: 0644: RFIND: 0644: 2A333C LD HL,(VCONTEXT) 0647: 7E LD A,(HL) 0648: 23 INC HL 0649: 66 LD H,(HL) 064A: 6F LD L,A ; get first pointer 064B: FLOOP: 064B: 7E LD A,(HL) 064C: E63F AND 3FH 064E: 282F JR Z,FNEXT2 ; no more words? 0650: A9 XOR C 0651: 2804 JR Z,FTEST ; same length? 0653: 79 LD A,C 0654: A7 AND A 0655: 2028 JR NZ,FNEXT2 ; searching one single word? 0657: FTEST: 0657: D5 PUSH DE 0658: E5 PUSH HL 0659: CDE815 CALL PTR2NAME 065C: B1 OR C 065D: 2817 JR Z,FPRINT ; print word immediately? 065F: 065F: 41 LD B,C ; get word length 0660: FCOMPARE: 0660: 1A LD A,(DE) 0661: CD0708 CALL TOUPPER 0664: 13 INC DE 0665: AE XOR (HL) 0666: E67F AND CLAST^0FFH ; note: original: AND NOT CLAST 0668: 23 INC HL 0669: 2012 JR NZ,FNEXT1 ; different word? 066B: 10F3 DJNZ FCOMPARE ; not yet all characters? 066D: 066D: D1 POP DE 066E: 13 INC DE 066F: D7 RST RSTPUSH ; pointer to code area 0670: D1 POP DE 0671: CDDA07 CALL BLWORD ; clear input if required 0674: FDE9 JP (IY) 0676: 0676: FPRINT: 0676: CDFB17 CALL OUTTXT 0679: 76 HALT ; wait for VSYNC 067A: CDE404 CALL USERBREAK 067D: FNEXT1: 067D: E1 POP HL 067E: D1 POP DE 067F: FNEXT2: 067F: 2B DEC HL 0680: 7E LD A,(HL) 0681: 2B DEC HL 0682: 6E LD L,(HL) 0683: 67 LD H,A ; next pointer 0684: B5 OR L 0685: 20C4 JR NZ,FLOOP ; not yet all words? 0687: C3 DB 0C3H ; JP RZERO (HRM-HRM...) 0688: 0688: ;================================================================ 0688: 8A06 ZERO: DW $+2 068A: 110000 RZERO: LD DE,0 068D: D7 RST RSTPUSH 068E: FDE9 JP (IY) 0690: 0690: ;================================================================ 0690: 45584543 0694: 5554C5 DB 'EXECUT','E' | CLAST 0697: 3C06 DW FIND-1 0699: 07 DB 7 069A: EXECUTE: 069A: 9C06 DW $+2 069C: DF RST RSTPULL 069D: C3BF04 JP NEXTDE 06A0: 06A0: ;================================================================ 06A0: 4E554D42 06A4: 45D2 DB 'NUMBE','R' | CLAST 06A6: 9906 DW EXECUTE-1 06A8: 06 DB 6 06A9: NUMBER: 06A9: AB06 DW $+2 06AB: CDDF05 CALL GETSTRING 06AE: 38DA JR C,RZERO ; no word entered? 06B0: 06B0: C5 PUSH BC 06B1: D5 PUSH DE 06B2: CD4C07 CALL CNVINT 06B5: 2005 JR NZ,NFLOAT ; no gap? 06B7: 110610 LD DE,LITERAL 06BA: 1858 JR NUMBERQUIT ; 16 bit integer 06BC: 06BC: NFLOAT: 06BC: DF RST RSTPULL 06BD: 110000 LD DE,0 06C0: D7 RST RSTPUSH 06C1: 110045 LD DE,0 | ((FEOFFS+5) << 8) 06C4: 06C4: C1 POP BC 06C5: C5 PUSH BC 06C6: 0A LD A,(BC) 06C7: FE2D CP '-' 06C9: 2003 JR NZ,NFGOON ; positive number? 06CB: 16C5 LD D,FSIGN | (FEOFFS+5) 06CD: 03 INC BC 06CE: NFGOON: 06CE: D7 RST RSTPUSH 06CF: 50 LD D,B 06D0: 59 LD E,C 06D1: 06D1: 2B DEC HL 06D2: 2B DEC HL 06D3: NFLOOP1: 06D3: CD2307 CALL DECGET 06D6: 23 INC HL 06D7: 34 INC (HL) 06D8: 2B DEC HL 06D9: 30F8 JR NC,NFLOOP1 ; convert integer portion 06DB: 06DB: FEFE CP '.'-'0' 06DD: 203D JR NZ,NUMBERERR ; not decimal point? 06DF: NFLOOP2: 06DF: CD2307 CALL DECGET 06E2: 30FB JR NC,NFLOOP2 ; convert fractional part 06E4: 06E4: C630 ADD A,'0' 06E6: CD7B07 CALL CNVEND 06E9: 2004 JR NZ,NFEXP ; no gap? 06EB: 1E00 LD E,0 06ED: 180E JR NFEGOON 06EF: NFEXP: 06EF: E6DF AND ~ 020H 06F1: FE45 CP 'E' 06F3: 2027 JR NZ,NUMBERERR ; no exponent? 06F5: E5 PUSH HL 06F6: CD4C07 CALL CNVINT 06F9: DF RST RSTPULL 06FA: E1 POP HL 06FB: 201F JR NZ,NUMBERERR ; no gap? 06FD: NFEGOON: 06FD: CD4007 CALL FZEROEQ 0700: 280F JR Z,NFQUIT ; number value = 0 ? 0702: 0702: 23 INC HL 0703: 7E LD A,(HL) 0704: E67F AND 7FH 0706: 83 ADD A,E 0707: FA1C07 JP M,NUMBERERR 070A: 2810 JR Z,NUMBERERR ; exponent out of range? 070C: AE XOR (HL) 070D: E67F AND 7FH 070F: AE XOR (HL) ; keep sign 0710: 77 LD (HL),A ; store exponent 0711: NFQUIT: 0711: 115510 LD DE,LITFLOAT 0714: NUMBERQUIT: 0714: D7 RST RSTPUSH 0715: D1 POP DE 0716: C1 POP BC 0717: CDDA07 CALL BLWORD 071A: FDE9 JP (IY) 071C: 071C: NUMBERERR: 071C: E1 POP HL 071D: E1 POP HL 071E: DF RST RSTPULL 071F: DF RST RSTPULL 0720: C38A06 JP RZERO 0723: 0723: ;---------------------------------------------------------------- 0723: DECGET: 0723: 1A LD A,(DE) 0724: 13 INC DE 0725: D630 SUB '0' 0727: D8 RET C 0728: FE0A CP 10 072A: 3F CCF 072B: D8 RET C ; character < '0' or > '9' ? 072C: 072C: DECSHIN: 072C: 4F LD C,A 072D: 7E LD A,(HL) 072E: E6F0 AND 0F0H 0730: C0 RET NZ ; highest digit != 0 ? 0731: 79 LD A,C 0732: DECSTORE: 0732: 2B DEC HL 0733: 2B DEC HL 0734: 0E03 LD C,3 0736: DSLOOP: 0736: ED6F RLD 0738: 23 INC HL 0739: 0D DEC C 073A: 20FA JR NZ,DSLOOP ; lowest digit 073C: 35 DEC (HL) 073D: 2B DEC HL 073E: BF CP A 073F: C9 RET ; inserted digit, test for 0 0740: 0740: ;---------------------------------------------------------------- 0740: FZEROEQ: 0740: 0606 LD B,6 0742: FZEQLP: 0742: AF XOR A 0743: CD2C07 CALL DECSHIN 0746: C0 RET NZ ; digit != 0 found? 0747: 10F9 DJNZ FZEQLP ; at most all digits 0749: 23 INC HL 074A: 70 LD (HL),B ; clear exponent 074B: C9 RET 074C: 074C: ;---------------------------------------------------------------- 074C: CNVINT: 074C: D7 RST RSTPUSH 074D: CDB904 CALL NEXT 0750: 6B089608 0754: 4B10 DW DUP,CAT,GETBYTE 0756: 0756: 2D DB '-' 0757: 4A0C DW EQ ; negative sign? 0759: 6B08A90D 075D: D208 DW DUP,NEGATE,GTR 075F: 075F: D20D1F0E DW PLUS,ONEMINUS ; update pointer 0763: 88068806 0767: FF08 DW ZERO,ZERO,ROT 0769: 0769: 8A07 DW CONVERT ; convert number 076B: FF08DF08 076F: 940D DW ROT,RGT,IFN0NEG ; invert sign if required 0771: 0771: FF087908 DW ROT,DROP ; dispose off high word 0775: 8508 DW SWAP 0777: 0E1A DW SEMICODE 0779: DF RST RSTPULL 077A: 1A LD A,(DE) 077B: CNVEND: 077B: FE20 CP ' ' 077D: C8 RET Z 077E: A7 AND A 077F: C9 RET ; test for gap 0780: 0780: ;================================================================ 0780: 434F4E56 0784: 4552D4 DB 'CONVER','T' | CLAST 0787: A806 DW NUMBER-1 0789: 07 DB 7 078A: CONVERT: 078A: C30E DW DOCOL 078C: CNVTLOOP: 078C: 090E6B08 0790: D208 DW ONEPLUS,DUP,GTR ; remember address 0792: 0792: 9608B807 DW CAT,CNVDIGIT ; convert one character 0796: 8312 DW DOIF ; no numeric character? 0798: 1B00 DW CNVTEND-$-1 079A: 8508 DW SWAP 079C: 8A049608 07A0: A80C DW BASE,CAT,UMUL 07A2: 07A2: 7908FF08 DW DROP,ROT 07A6: 8A049608 07AA: A80C DW BASE,CAT,UMUL 07AC: 07AC: EE0D DW DPLUS ; insert number character 07AE: DF08 DW RGT ; restore address 07B0: 7612 DW DOREPEAT 07B2: D9FF DW CNVTLOOP-$-1 07B4: CNVTEND: 07B4: DF08 DW RGT ; adjust stack 07B6: B604 DW SEMIS 07B8: 07B8: ;---------------------------------------------------------------- 07B8: CNVDIGIT: 07B8: BA07 DW $+2 07BA: DF RST RSTPULL 07BB: 7B LD A,E 07BC: CD0708 CALL TOUPPER ; get character 07BF: C6D0 ADD A,-'0' 07C1: 3014 JR NC,CNVDQUIT ; character < '0' ? 07C3: FE0A CP 10 07C5: 3806 JR C,CNVDOK ; character < '9' ? 07C7: C6EF ADD A,'0'-'A' 07C9: 300C JR NC,CNVDQUIT ; character < 'A' ? 07CB: C60A ADD A,10 ; adjust value 07CD: CNVDOK: 07CD: DDBE3F CP (IX+VBASE-MEMBEG) 07D0: 3005 JR NC,CNVDQUIT ; character too large? 07D2: 1600 LD D,0 07D4: 5F LD E,A 07D5: D7 RST RSTPUSH ; store digit 07D6: 37 SCF 07D7: CNVDQUIT: 07D7: C3210C JP CMPPUSH ; test store 07DA: 07DA: ;================================================================ 07DA: BLWORD: 07DA: 62 LD H,D 07DB: 6B LD L,E ; pointer to start 07DC: 03 INC BC 07DD: 09 ADD HL,BC 07DE: E5 PUSH HL ; pointer behind separator 07DF: 07DF: DDCB3E66 BIT 4,(IX+FLAGS-MEMBEG) 07E3: CC7F09 CALL Z,CTYPE ; input visible? 07E6: 07E6: CDB002 CALL DCSTREND ; search input end 07E9: 07E9: D1 POP DE 07EA: A7 AND A 07EB: ED52 SBC HL,DE 07ED: 44 LD B,H 07EE: 4D LD C,L ; calculate remaining characters 07EF: 07EF: 2A1E3C LD HL,(INSCRN) 07F2: 23 INC HL 07F3: EB EX DE,HL 07F4: 3805 JR C,BLANKS2 07F6: 2802 JR Z,BLANKS 07F8: EDB0 LDIR ; erase input 07FA: 07FA: ;---------------------------------------------------------------- 07FA: BLANKS: 07FA: A7 AND A 07FB: BLANKS2: 07FB: ED52 SBC HL,DE 07FD: EB EX DE,HL ; calculate count 07FE: BLLOOP: 07FE: 7A LD A,D 07FF: B3 OR E 0800: C8 RET Z ; everything erased? 0801: 0801: 3620 LD (HL),' ' 0803: 23 INC HL ; erase next character 0804: 1B DEC DE 0805: 18F7 JR BLLOOP 0807: 0807: ;================================================================ 0807: TOUPPER: 0807: E67F AND 7FH 0809: FE61 CP 'a' 080B: D8 RET C 080C: FE7B CP 'z'+1 080E: D0 RET NC 080F: E65F AND 5FH 0811: C9 RET 0812: 0812: ;================================================================ 0812: 5649D3 DB 'VI','S' | CLAST 0815: 8907 DW CONVERT-1 0817: 03 DB 3 0818: 1A08 VIS: DW $+2 081A: DDCB3EA6 RES 4,(IX+FLAGS-MEMBEG) ; input visible 081E: FDE9 JP (IY) 0820: 0820: ;================================================================ 0820: 494E5649 0824: D3 DB 'INVI','S' | CLAST 0825: 1708 DW VIS-1 0827: 05 DB 5 0828: 2A08 INVIS: DW $+2 082A: DDCB3EE6 SET 4,(IX+FLAGS-MEMBEG) ; input invisible 082E: FDE9 JP (IY) 0830: 0830: ;================================================================ 0830: 464153D4 DB 'FAS','T' | CLAST 0834: 2708 DW INVIS-1 0836: 04 DB 4 0837: 3908 FAST: DW $+2 0839: FD21B904 LD IY,NEXT 083D: FDE9 JP (IY) 083F: 083F: ;================================================================ 083F: 534C4FD7 DB 'SLO','W' | CLAST 0843: 3608 DW FAST-1 0845: 04 DB 4 0846: 4808 SLOW: DW $+2 0848: FD21C804 LD IY,RSLNEXT 084C: FDE9 JP (IY) 084E: 084E: ;================================================================ 084E: 2A3B3C PULLBC: LD HL,(SPARE) 0851: 2B DEC HL 0852: 46 LD B,(HL) 0853: 2B DEC HL 0854: 4E LD C,(HL) 0855: 223B3C LD (SPARE),HL 0858: C9 RET 0859: 0859: ;================================================================ 0859: 2B RPULL: DEC HL 085A: 5E LD E,(HL) 085B: 223B3C LD (SPARE),HL 085E: C9 RET 085F: 085F: ;================================================================ 085F: 72 RPUSH: LD (HL),D 0860: 23 INC HL 0861: 223B3C LD (SPARE),HL 0864: C9 RET 0865: 0865: ;================================================================ 0865: 4455D0 DB 'DU','P' | CLAST 0868: 4508 DW SLOW-1 086A: 03 DB 3 086B: 6D08 DUP: DW $+2 086D: DF RST RSTPULL 086E: D7 RST RSTPUSH 086F: D7 RST RSTPUSH 0870: FDE9 JP (IY) 0872: 0872: ;================================================================ 0872: 44524FD0 DB 'DRO','P' | CLAST 0876: 6A08 DW DUP-1 0878: 04 DB 4 0879: 7B08 DROP: DW $+2 087B: DF RST RSTPULL 087C: FDE9 JP (IY) 087E: 087E: ;================================================================ 087E: 535741D0 DB 'SWA','P' | CLAST 0882: 7808 DW DROP-1 0884: 04 DB 4 0885: 8708 SWAP: DW $+2 0887: DF RST RSTPULL 0888: CD4E08 CALL PULLBC 088B: D7 RST RSTPUSH 088C: 50 LD D,B 088D: 59 LD E,C 088E: D7 RST RSTPUSH 088F: FDE9 JP (IY) 0891: 0891: ;================================================================ 0891: 43C0 DB 'C','@' | CLAST 0893: 8408 DW SWAP-1 0895: 02 DB 2 0896: 9808 CAT: DW $+2 0898: DF RST RSTPULL 0899: 1A LD A,(DE) 089A: 5F LD E,A 089B: 1600 LD D,0 089D: D7 RST RSTPUSH 089E: FDE9 JP (IY) 08A0: 08A0: ;================================================================ 08A0: 43A1 DB 'C','!' | CLAST 08A2: 9508 DW CAT-1 08A4: 02 DB 2 08A5: CEXCLAM: 08A5: A708 DW $+2 08A7: DF RST RSTPULL 08A8: CD4E08 CALL PULLBC 08AB: 79 LD A,C 08AC: 12 LD (DE),A 08AD: FDE9 JP (IY) 08AF: 08AF: ;================================================================ 08AF: C0 DB '@' | CLAST 08B0: A408 DW CEXCLAM-1 08B2: 01 DB 1 08B3: B508 AT: DW $+2 08B5: DF RST RSTPULL 08B6: EB EX DE,HL 08B7: 5E LD E,(HL) 08B8: 23 INC HL 08B9: 56 LD D,(HL) 08BA: D7 RST RSTPUSH 08BB: FDE9 JP (IY) 08BD: 08BD: ;================================================================ 08BD: A1 DB '!' | CLAST 08BE: B208 DW AT-1 08C0: 01 DB 1 08C1: C308 EXCLAM: DW $+2 08C3: DF RST RSTPULL 08C4: CD4E08 CALL PULLBC 08C7: EB EX DE,HL 08C8: 71 LD (HL),C 08C9: 23 INC HL 08CA: 70 LD (HL),B 08CB: FDE9 JP (IY) 08CD: 08CD: ;================================================================ 08CD: 3ED2 DB '>','R' | CLAST 08CF: C008 DW EXCLAM-1 08D1: 02 DB 2 08D2: D408 GTR: DW $+2 08D4: DF RST RSTPULL 08D5: C1 POP BC 08D6: D5 PUSH DE 08D7: C5 PUSH BC 08D8: FDE9 JP (IY) 08DA: 08DA: ;================================================================ 08DA: 52BE DB 'R','>' | CLAST 08DC: D108 DW GTR-1 08DE: 02 DB 2 08DF: E108 RGT: DW $+2 08E1: C1 POP BC 08E2: D1 POP DE 08E3: C5 PUSH BC 08E4: D7 RST RSTPUSH 08E5: FDE9 JP (IY) 08E7: 08E7: ;================================================================ 08E7: 3F4455D0 DB '?DU','P' | CLAST 08EB: DE08 DW RGT-1 08ED: 04 DB 4 08EE: F008 QDUP: DW $+2 08F0: DF RST RSTPULL 08F1: D7 RST RSTPUSH 08F2: 7A LD A,D 08F3: B3 OR E 08F4: C41000 CALL NZ,RSTPUSH 08F7: FDE9 JP (IY) 08F9: 08F9: ;================================================================ 08F9: 524FD4 DB 'RO','T' | CLAST 08FC: ED08 DW QDUP-1 08FE: 03 DB 3 08FF: C30E ROT: DW DOCOL 0901: D2088508 0905: DF088508 DW GTR,SWAP,RGT,SWAP 0909: B604 DW SEMIS 090B: 090B: ;================================================================ 090B: 4F5645D2 DB 'OVE','R' | CLAST 090F: FE08 DW ROT-1 0911: 04 DB 4 0912: C30E OVER: DW DOCOL 0914: D2086B08 0918: DF088508 DW GTR,DUP,RGT,SWAP 091C: B604 DW SEMIS 091E: 091E: ;================================================================ 091E: 504943CB DB 'PIC','K' | CLAST 0922: 1109 DW OVER-1 0924: 04 DB 4 0925: 2709 PICK: DW $+2 0927: CD4D09 CALL CPICK 092A: FDE9 JP (IY) 092C: 092C: ;================================================================ 092C: 524F4CCC DB 'ROL','L' | CLAST 0930: 2409 DW PICK-1 0932: 04 DB 4 0933: 3509 ROLL: DW $+2 0935: CD4D09 CALL CPICK 0938: 0938: EB EX DE,HL 0939: 2A373C LD HL,(STKBOT) 093C: ED52 SBC HL,DE 093E: D2D704 JP NC,ERRORSTK ; stack too small? 0941: 0941: 62 LD H,D 0942: 6B LD L,E 0943: 23 INC HL 0944: 23 INC HL 0945: EDB0 LDIR ; move stack 0947: ED533B3C LD (SPARE),DE 094B: FDE9 JP (IY) 094D: 094D: ;================================================================ 094D: CD4E08 CPICK: CALL PULLBC 0950: 0B DEC BC 0951: CB21 SLA C 0953: CB10 RL B 0955: 03 INC BC 0956: 03 INC BC 0957: 3002 JR NC,CPKGOON ; offset ok? 0959: E7 RST RSTERR 095A: 07 DB ERRPICK 095B: CPKGOON: 095B: 2A3B3C LD HL,(SPARE) 095E: ED42 SBC HL,BC 0960: E5 PUSH HL 0961: 5E LD E,(HL) 0962: 23 INC HL 0963: 56 LD D,(HL) 0964: D7 RST RSTPUSH ; get value from argument stack 0965: E1 POP HL 0966: C9 RET 0967: 0967: ;================================================================ 0967: 545950C5 DB 'TYP','E' | CLAST 096B: 3209 DW ROLL-1 096D: 04 DB 4 096E: 7009 TYPE: DW $+2 0970: CD4E08 CALL PULLBC 0973: DF RST RSTPULL 0974: CD7F09 CALL CTYPE 0977: FDE9 JP (IY) 0979: 0979: ;================================================================ 0979: 1A TYPEDE: LD A,(DE) 097A: 4F LD C,A 097B: 13 INC DE 097C: 1A LD A,(DE) 097D: 47 LD B,A 097E: 13 INC DE 097F: 097F: ;---------------------------------------------------------------- 097F: 78 CTYPE: LD A,B 0980: B1 OR C 0981: C8 RET Z 0982: 1A LD A,(DE) 0983: 13 INC DE 0984: 0B DEC BC 0985: CF RST RSTEMIT 0986: 18F7 JR CTYPE 0988: 0988: ;================================================================ 0988: 3CA3 DB '<','#' | CLAST 098A: 6D09 DW TYPE-1 098C: 02 DB 2 098D: 8F09 LTNUM: DW $+2 098F: 21FF27 LD HL,SCRMEND-1 0992: 221A3C LD (HLD),HL ; prepare pointer 0995: FDE9 JP (IY) 0997: 0997: ;================================================================ 0997: 23BE DB '#','>' | CLAST 0999: 8C09 DW LTNUM-1 099B: 02 DB 2 099C: 9E09 NUMGT: DW $+2 099E: DF RST RSTPULL 099F: DF RST RSTPULL ;clean stack 09A0: 09A0: ED5B1A3C LD DE,(HLD) 09A4: D7 RST RSTPUSH ; get pointer 09A5: 21FF27 LD HL,SCRMEND-1 09A8: A7 AND A 09A9: ED52 SBC HL,DE 09AB: EB EX DE,HL 09AC: D7 RST RSTPUSH ;calculate length 09AD: FDE9 JP (IY) 09AF: 09AF: ;================================================================ 09AF: AE DB '.' | CLAST 09B0: 490A DW SIGN-1 09B2: 01 DB 1 09B3: C30E PNT: DW DOCOL 09B5: 8D096B08 DW LTNUM,DUP ; start conversion 09B9: 0D0C8806 DW ABS,ZERO ; create double word 09BD: E109 DW NUMS ; convert absolute value 09BF: FF084A0A DW ROT,SIGN ; handle sign 09C3: PNTLEFT: 09C3: 9C09 DW NUMGT ; finish conversion 09C5: 6E09730A DW TYPE,SPACE ; print 09C9: B604 DW SEMIS 09CB: 09CB: ;================================================================ 09CB: 55AE DB 'U','.' | CLAST 09CD: B209 DW PNT-1 09CF: 02 DB 2 09D0: C30E UPNT: DW DOCOL 09D2: 88068D09 09D6: E109 DW ZERO,LTNUM,NUMS ; start conversion 09D8: 7612 DW DOREPEAT 09DA: E8FF DW PNTLEFT-$-1 09DC: 09DC: ;================================================================ 09DC: 23D3 DB '#','S' | CLAST 09DE: CF09 DW UPNT-1 09E0: 02 DB 2 09E1: C30E NUMS: DW DOCOL 09E3: F709 NUMSLP: DW NUM ; convert one digit 09E5: 12091209 09E9: 360E1A0C DW OVER,OVER,LOR,ZEROEQ 09ED: 8D12 DW DOUNTIL ; remainder != 0? 09EF: F3FF DW NUMSLP-$-1 09F1: B604 DW SEMIS 09F3: 09F3: ;================================================================ 09F3: A3 DB '#' | CLAST 09F4: E009 DW NUMS-1 09F6: 01 DB 1 09F7: C30E NUM: DW DOCOL 09F9: 8A049608 09FD: C40CFF08 DW BASE,CAT,DIV32BY16,ROT ; modulo "BASE" 0A01: 070A5C0A DW NIBASC,HOLD ; store as character 0A05: B604 DW SEMIS 0A07: 0A07: ;================================================================ 0A07: 090A NIBASC: DW $+2 0A09: DF RST RSTPULL 0A0A: 7B LD A,E ; get nibble 0A0B: C630 ADD A,'0' 0A0D: FE3A CP '0'+10 0A0F: 3802 JR C,NADEC ; adjustment for 'A'... 0A11: C607 ADD A,7 0A13: 5F NADEC: LD E,A 0A14: D7 RST RSTPUSH ; store ASCII character 0A15: FDE9 JP (IY) 0A17: 0A17: ;================================================================ 0A17: 434CD3 DB 'CL','S' | CLAST 0A1A: F609 DW NUM-1 0A1C: 03 DB 3 0A1D: 1F0A CLS: DW $+2 0A1F: CD240A CALL CCLS 0A22: FDE9 JP (IY) 0A24: 0A24: 11FF26 CCLS: LD DE,SCREEN+24*32-1 0A27: 2A243C LD HL,(LHALF) 0A2A: 012000 LD BC,32 0A2D: 09 ADD HL,BC 0A2E: 2B DEC HL 0A2F: EDB8 LDDR ; last output line to screen end 0A31: 0A31: ED432F3C LD (XCOORD),BC ; clear plot position 0A35: 210024 LD HL,SCREEN 0A38: 221C3C LD (SCRPOS),HL ; cursor home 0A3B: 13 INC DE 0A3C: EB EX DE,HL 0A3D: 22243C LD (LHALF),HL ; set output end 0A40: C3FA07 JP BLANKS ; erase output area 0A43: 0A43: ;================================================================ 0A43: 534947CE DB 'SIG','N' | CLAST 0A47: 9B09 DW NUMGT-1 0A49: 04 DB 4 0A4A: 4C0A SIGN: DW $+2 0A4C: DF RST RSTPULL 0A4D: CB12 RL D 0A4F: 1E2D LD E,'-' 0A51: 380C JR C,RHOLD ; store '-' if required 0A53: FDE9 JP (IY) 0A55: 0A55: ;================================================================ 0A55: 484F4CC4 DB 'HOL','D' | CLAST 0A59: 1C0A DW CLS-1 0A5B: 04 DB 4 0A5C: 5E0A HOLD: DW $+2 0A5E: DF RST RSTPULL 0A5F: 2A1A3C RHOLD: LD HL,(HLD) 0A62: 2D DEC L 0A63: 2804 JR Z,HOLDQUIT ; buffer full? 0A65: 0A65: 221A3C LD (HLD),HL 0A68: 73 LD (HL),E ; store character 0A69: HOLDQUIT: 0A69: FDE9 JP (IY) 0A6B: 0A6B: ;================================================================ 0A6B: 53504143 0A6F: C5 DB 'SPAC','E' | CLAST 0A70: 5B0A DW HOLD-1 0A72: 05 DB 5 0A73: 750A SPACE: DW $+2 0A75: 3E20 LD A,' ' 0A77: CF RST RSTEMIT 0A78: SPACEQUIT: 0A78: FDE9 JP (IY) 0A7A: 0A7A: ;================================================================ 0A7A: 53504143 0A7E: 45D3 DB 'SPACE','S' | CLAST 0A80: 720A DW SPACE-1 0A82: 06 DB 6 0A83: 850A SPACES: DW $+2 0A85: DF RST RSTPULL 0A86: SPCLOOP: 0A86: 1B DEC DE 0A87: CB7A BIT 7,D 0A89: 20ED JR NZ,SPACEQUIT ; all printed? 0A8B: 3E20 LD A,' ' 0A8D: CF RST RSTEMIT 0A8E: 18F6 JR SPCLOOP 0A90: 0A90: ;================================================================ 0A90: 43D2 DB 'C','R' | CLAST 0A92: 820A DW SPACES-1 0A94: 02 DB 2 0A95: 970A CR: DW $+2 0A97: 3E0D LD A,CCR 0A99: CF RST RSTEMIT 0A9A: FDE9 JP (IY) 0A9C: 0A9C: ;================================================================ 0A9C: 454D49D4 DB 'EMI','T' | CLAST 0AA0: 940A DW CR-1 0AA2: 04 DB 4 0AA3: A50A EMIT: DW $+2 0AA5: DF RST RSTPULL 0AA6: 7B LD A,E 0AA7: CF RST RSTEMIT 0AA8: FDE9 JP (IY) 0AAA: 0AAA: ;================================================================ 0AAA: 46AE DB 'F','.' | CLAST 0AAC: A20A DW EMIT-1 0AAE: 02 DB 2 0AAF: B10A FPNT: DW $+2 0AB1: 2A3B3C LD HL,(SPARE) 0AB4: 2B DEC HL 0AB5: CB7E BIT 7,(HL) 0AB7: CBBE RES 7,(HL) 0AB9: 2803 JR Z,FPGOON1 0ABB: 3E2D LD A,'-' 0ABD: CF RST RSTEMIT ; print negative sign 0ABE: FPGOON1: 0ABE: 1E00 LD E,0 ; no exponent until now 0AC0: 7E LD A,(HL) 0AC1: 3D DEC A 0AC2: FE49 CP FEOFFS+9 0AC4: 3004 JR NC,FPGOON2 0AC6: FE3C CP FEOFFS-4 0AC8: 3004 JR NC,FPGOON3 ; no exponent required? 0ACA: FPGOON2: 0ACA: 3641 LD (HL),FEOFFS+1 0ACC: 3C INC A 0ACD: 5F LD E,A ; remember exponent 0ACE: FPGOON3: 0ACE: 3E40 LD A,FEOFFS 0AD0: 96 SUB (HL) 0AD1: 3809 JR C,FPMLOOP ; exponent negative? 0AD3: 47 LD B,A 0AD4: 04 INC B 0AD5: 3E2E LD A,'.' 0AD7: CF FPH0: RST RSTEMIT 0AD8: 3E30 LD A,'0' 0ADA: 10FB DJNZ FPH0 ; print leading zeros 0ADC: 0ADC: FPMLOOP: 0ADC: 3E40 LD A,'@' 0ADE: BE CP (HL) 0ADF: 9F SBC A,A 0AE0: 2B DEC HL 0AE1: B6 OR (HL) 0AE2: 2B DEC HL 0AE3: B6 OR (HL) 0AE4: 2B DEC HL 0AE5: B6 OR (HL) 0AE6: 23 INC HL 0AE7: 23 INC HL 0AE8: 2812 JR Z,FP0 ; number = 0? 0AEA: 0AEA: AF XOR A 0AEB: CD3207 CALL DECSTORE 0AEE: C630 ADD A,'0' 0AF0: CF RST RSTEMIT ; print next numeric character 0AF1: 23 INC HL 0AF2: 7E LD A,(HL) 0AF3: FE40 CP FEOFFS 0AF5: 20E5 JR NZ,FPMLOOP ; value < 0.1 or value >= 1.0 ? 0AF7: 3E2E LD A,'.' 0AF9: CF RST RSTEMIT 0AFA: 18E0 JR FPMLOOP ; print decimal point 0AFC: 0AFC: 7B FP0: LD A,E 0AFD: A7 AND A 0AFE: 2005 JR NZ,FPEXP ; exponent must be printed? 0B00: 3E20 LD A,' ' 0B02: CF RST RSTEMIT 0B03: 180B JR FPQUIT 0B05: 0B05: D641 FPEXP: SUB FEOFFS+1 0B07: 6F LD L,A 0B08: 9F SBC A,A 0B09: 67 LD H,A 0B0A: 3E45 LD A,'E' 0B0C: CF RST RSTEMIT 0B0D: CD0E18 CALL PNTHL ; print exponent 0B10: DF FPQUIT: RST RSTPULL 0B11: DF RST RSTPULL 0B12: FDE9 JP (IY) 0B14: 0B14: ;================================================================ 0B14: 41D4 DB 'A','T' | CLAST 0B16: AE0A DW FPNT-1 0B18: 02 DB 2 0B19: 1B0B ATPOS: DW $+2 0B1B: DF RST RSTPULL ; column 0B1C: CD4E08 CALL PULLBC ; row 0B1F: 79 LD A,C 0B20: CD280B CALL CATPOS 0B23: 221C3C LD (SCRPOS),HL 0B26: FDE9 JP (IY) 0B28: 0B28: C620 CATPOS: ADD A,32 0B2A: 6F LD L,A 0B2B: 2601 LD H,1 ; screen / 32 0B2D: 29 ADD HL,HL 0B2E: 29 ADD HL,HL 0B2F: 29 ADD HL,HL 0B30: 29 ADD HL,HL 0B31: 29 ADD HL,HL ; screen + row 0B32: 1600 LD D,0 0B34: 7B LD A,E 0B35: E61F AND 1FH 0B37: 5F LD E,A 0B38: 19 ADD HL,DE ; screen + row + column 0B39: 0B39: ED5B243C LD DE,(LHALF) 0B3D: ED52 SBC HL,DE 0B3F: 19 ADD HL,DE 0B40: D8 RET C ; not behind output area? 0B41: E7 RST RSTERR 0B42: 09 DB ERRAT 0B43: 0B43: ;================================================================ 0B43: 504C4FD4 DB 'PLO','T' | CLAST 0B47: 180B DW ATPOS-1 0B49: 04 DB 4 0B4A: 4C0B PLOT: DW $+2 0B4C: CD4E08 CALL PULLBC ; 0/1/2/3 = RES/SET/NOP/XOR 0B4F: 0B4F: DF RST RSTPULL ; y position 0B50: DD7330 LD (IX+YCOORD-MEMBEG),E 0B53: CB3B SRL E 0B55: CB11 RL C ;LSB of Y 0B57: 0B57: 3E16 LD A,22 0B59: 93 SUB E ; Y position as line number 0B5A: 0B5A: DF RST RSTPULL ; X position 0B5B: DD732F LD (IX+XCOORD-MEMBEG),E 0B5E: CB3B SRL E 0B60: CB11 RL C ;LSB of X 0B62: 0B62: CD280B CALL CATPOS ; pointer in screen 0B65: 0B65: 7E LD A,(HL) ; get current character 0B66: E678 AND 78H 0B68: FE10 CP 10H 0B6A: 7E LD A,(HL) 0B6B: 2802 JR Z,PLGOON ; already a graphics character? 0B6D: 3E10 LD A,10H ; empty graphics character 0B6F: PLGOON: 0B6F: 5F LD E,A ; remember initial character code 0B70: 1687 LD D,87H ; set mask 0B72: 0B72: 79 LD A,C 0B73: E603 AND 3 0B75: 47 LD B,A 0B76: 2807 JR Z,PLX0Y0 ; X=0 and Y=0 ? 0B78: 0B78: 2F CPL 0B79: C602 ADD A,2 0B7B: CE03 ADC A,3 0B7D: 57 LD D,A 0B7E: 43 LD B,E ; bit masks for X!=0 and Y!=0 0B7F: PLX0Y0: 0B7F: 79 LD A,C 0B80: 0F RRCA 0B81: 0F RRCA 0B82: 0F RRCA 0B83: 9F SBC A,A ; clear or set mask 0B84: CB59 BIT 3,C 0B86: 2004 JR NZ,PLXOR ; NOP/XOR ? 0B88: AB XOR E 0B89: 07 RLCA 0B8A: 9F SBC A,A 0B8B: A8 XOR B ; prepare clear/set 0B8C: PLXOR: 0B8C: A2 AND D 0B8D: AB XOR E 0B8E: 77 LD (HL),A ; store new character code 0B8F: FDE9 JP (IY) 0B91: 0B91: ;================================================================ 0B91: 424545D0 DB 'BEE','P' | CLAST 0B95: 490B DW PLOT-1 0B97: 04 DB 4 0B98: C30E BEEP: DW DOCOL 0B9A: 12094B10 DW OVER,GETBYTE 0B9E: 7D DB 125 0B9F: 85087A0D DW SWAP,MULDIV ; adjust value 0BA3: 0E1A DW SEMICODE 0BA5: 0BA5: DF RST RSTPULL 0BA6: CD4E08 CALL PULLBC 0BA9: 21F900 LD HL,250-1 0BAC: 09 ADD HL,BC 0BAD: 2C INC L ; (rounding?) 0BAE: F3 DI 0BAF: BLOOP: 0BAF: 3E7F LD A,7FH 0BB1: DBFE IN A,(IO) 0BB3: 0F RRCA 0BB4: 3011 JR NC,BDBREAK ; breaked? 0BB6: CDC90B CALL BEEPDELAY 0BB9: 1B DEC DE 0BBA: 7A LD A,D 0BBB: D3FE OUT (IO),A 0BBD: CDC90B CALL BEEPDELAY 0BC0: B3 OR E 0BC1: C2AF0B JP NZ,BLOOP ; duration not yet expired? 0BC4: FB EI 0BC5: FDE9 JP (IY) 0BC7: 0BC7: BDBREAK: 0BC7: E7 RST RSTERR 0BC8: 03 DB ERRBRK 0BC9: 0BC9: BEEPDELAY: 0BC9: 45 LD B,L 0BCA: 4C LD C,H 0BCB: BDLOOP: 0BCB: 10FE DJNZ BDLOOP 0BCD: 05 DEC B 0BCE: 0D DEC C 0BCF: C2CB0B JP NZ,BDLOOP ; wait a moment... 0BD2: C9 RET 0BD3: 0BD3: ;================================================================ 0BD3: 494E4B45 0BD7: D9 DB 'INKE','Y' | CLAST 0BD8: 970B DW BEEP-1 0BDA: 05 DB 5 0BDB: DD0B INKEY: DW $+2 0BDD: CD3603 CALL KEYGET 0BE0: 5F LD E,A 0BE1: 1600 LD D,0 0BE3: D7 RST RSTPUSH 0BE4: FDE9 JP (IY) 0BE6: 0BE6: ;================================================================ 0BE6: 49CE DB 'I','N' | CLAST 0BE8: DA0B DW INKEY-1 0BEA: 02 DB 2 0BEB: ED0B IN: DW $+2 0BED: CD4E08 CALL PULLBC 0BF0: 1600 LD D,0 0BF2: ED58 IN E,(C) 0BF4: D7 RST RSTPUSH 0BF5: FDE9 JP (IY) 0BF7: 0BF7: ;================================================================ 0BF7: 4F55D4 DB 'OU','T' | CLAST 0BFA: EA0B DW IN-1 0BFC: 03 DB 3 0BFD: FF0B OUT: DW $+2 0BFF: CD4E08 CALL PULLBC 0C02: DF RST RSTPULL 0C03: ED59 OUT (C),E 0C05: FDE9 JP (IY) 0C07: 0C07: ;================================================================ 0C07: 4142D3 DB 'AB','S' | CLAST 0C0A: FC0B DW OUT-1 0C0C: 03 DB 3 0C0D: C30E ABS: DW DOCOL 0C0F: 6B08940D DW DUP,IFN0NEG 0C13: B604 DW SEMIS 0C15: 0C15: ;================================================================ 0C15: 30BD DB '0','=' | CLAST 0C17: 0C0C DW ABS-1 0C19: 02 DB 2 0C1A: 1C0C ZEROEQ: DW $+2 0C1C: DF RST RSTPULL 0C1D: 7A LD A,D 0C1E: B3 OR E 0C1F: FE01 CP 1 ;C, if A=0 0C21: CMPPUSH: 0C21: 3E00 LD A,0 0C23: 57 LD D,A 0C24: 17 RLA 0C25: 5F LD E,A 0C26: D7 RST RSTPUSH ; if C, then value = 1, else 0 0C27: FDE9 JP (IY) 0C29: 0C29: ;================================================================ 0C29: 30BC DB '0','<' | CLAST 0C2B: 190C DW ZEROEQ-1 0C2D: 02 DB 2 0C2E: 300C ZEROLT: DW $+2 0C30: DF RST RSTPULL 0C31: CB12 RL D ; get number sign 0C33: 18EC JR CMPPUSH 0C35: 0C35: ;================================================================ 0C35: 30BE DB '0','>' | CLAST 0C37: 2D0C DW ZEROLT-1 0C39: 02 DB 2 0C3A: 3C0C ZEROGT: DW $+2 0C3C: DF RST RSTPULL 0C3D: 7A LD A,D 0C3E: B3 OR E 0C3F: 28E0 JR Z,CMPPUSH ; = 0 ? 0C41: CB12 RL D 0C43: 3F CCF 0C44: 18DB JR CMPPUSH ;get inverted number sign 0C46: 0C46: ;================================================================ 0C46: BD DB '=' | CLAST 0C47: 390C DW ZEROGT-1 0C49: 01 DB 1 0C4A: C30E EQ: DW DOCOL 0C4C: E10D1A0C DW MINUS,ZEROEQ 0C50: B604 DW SEMIS 0C52: 0C52: ;================================================================ 0C52: BE DB '>' | CLAST 0C53: 490C DW EQ-1 0C55: 01 DB 1 0C56: 580C GT: DW $+2 0C58: DF RST RSTPULL 0C59: D5 PUSH DE 0C5A: DF RST RSTPULL 0C5B: E1 POP HL 0C5C: CD990C CALL GREATER 0C5F: 18C0 JR CMPPUSH 0C61: 0C61: ;================================================================ 0C61: BC DB '<' | CLAST 0C62: 550C DW GT-1 0C64: 01 DB 1 0C65: C30E LT: DW DOCOL 0C67: 8508560C DW SWAP,GT 0C6B: B604 DW SEMIS 0C6D: 0C6D: ;================================================================ 0C6D: 55BC DB 'U','<' | CLAST 0C6F: 640C DW LT-1 0C71: 02 DB 2 0C72: 740C ULT: DW $+2 0C74: CD4E08 CALL PULLBC 0C77: DF UCMP: RST RSTPULL 0C78: EB EX DE,HL 0C79: A7 AND A 0C7A: ED42 SBC HL,BC ; C = (BC > HL) 0C7C: 18A3 JR CMPPUSH 0C7E: 0C7E: ;================================================================ 0C7E: 44BC DB 'D','<' | CLAST 0C80: 710C DW ULT-1 0C82: 02 DB 2 0C83: 850C DLT: DW $+2 0C85: DF RST RSTPULL 0C86: D5 PUSH DE 0C87: CD4E08 CALL PULLBC 0C8A: DF RST RSTPULL 0C8B: E1 POP HL 0C8C: A7 AND A 0C8D: ED52 SBC HL,DE 0C8F: 28E6 JR Z,UCMP ; upper words equal? 0C91: 0C91: 19 ADD HL,DE 0C92: EB EX DE,HL 0C93: CD990C CALL GREATER ; compare only upper words 0C96: DF RST RSTPULL 0C97: 1888 JR CMPPUSH 0C99: 0C99: ;================================================================ 0C99: GREATER: 0C99: 7C LD A,H 0C9A: AA XOR D 0C9B: FAA00C JP M,GRTRQUIT ; different number sign? 0C9E: ED52 SBC HL,DE 0CA0: GRTRQUIT: 0CA0: CB14 RL H ; number sign in C 0CA2: C9 RET 0CA3: 0CA3: ;================================================================ 0CA3: 55AA DB 'U','*' | CLAST 0CA5: 820C DW DLT-1 0CA7: 02 DB 2 0CA8: AA0C UMUL: DW $+2 0CAA: DF RST RSTPULL 0CAB: CD4E08 CALL PULLBC 0CAE: 210000 LD HL,0 0CB1: 3E10 LD A,16 ; set bit counter 0CB3: UMULLOOP: 0CB3: 29 ADD HL,HL 0CB4: EB EX DE,HL 0CB5: ED6A ADC HL,HL 0CB7: EB EX DE,HL 0CB8: 3004 JR NC,UMULNEXT ; multiplicator bit = 0 ? 0CBA: 09 ADD HL,BC 0CBB: 3001 JR NC,UMULNEXT ; no overflow? 0CBD: 13 INC DE 0CBE: UMULNEXT: 0CBE: 3D DEC A 0CBF: 20F2 JR NZ,UMULLOOP ; not yet all bits? 0CC1: EB EX DE,HL 0CC2: 182F JR PUSHDEHL 0CC4: 0CC4: ;================================================================ 0CC4: DIV32BY16: 0CC4: C60C DW $+2 0CC6: DF RST RSTPULL ; divisor 0CC7: D9 EXX 0CC8: DF RST RSTPULL ; dividend H 0CC9: D5 PUSH DE 0CCA: DF RST RSTPULL ; dividend L 0CCB: E1 POP HL 0CCC: 0CCC: 7C LD A,H 0CCD: B5 OR L 0CCE: 3E21 LD A,33 ; usual bit counter 0CD0: 2003 JR NZ,D32GOON ; dividend > 65535? 0CD2: EB EX DE,HL 0CD3: 3E11 LD A,17 ; shorten calculation 0CD5: D32GOON: 0CD5: D9 EXX 0CD6: 47 LD B,A 0CD7: AF XOR A 0CD8: 67 LD H,A 0CD9: 6F LD L,A 0CDA: 4F LD C,A ; prepare calculation 0CDB: D32LOOP: 0CDB: ED6A ADC HL,HL 0CDD: 9F SBC A,A 0CDE: A7 AND A 0CDF: ED52 SBC HL,DE ; test subtraction 0CE1: 99 SBC A,C 0CE2: 3001 JR NC,D32NEXT 0CE4: 19 ADD HL,DE ; undo subtraction 0CE5: D32NEXT: 0CE5: 3F CCF 0CE6: D9 EXX 0CE7: EB EX DE,HL 0CE8: ED6A ADC HL,HL 0CEA: EB EX DE,HL 0CEB: ED6A ADC HL,HL 0CED: D9 EXX 0CEE: 10EB DJNZ D32LOOP ; not yet all bits? 0CF0: EB EX DE,HL 0CF1: D7 RST RSTPUSH ; store remainder 0CF2: D9 EXX ; get quotient 0CF3: 0CF3: PUSHDEHL: 0CF3: E5 PUSH HL 0CF4: D7 RST RSTPUSH 0CF5: D1 POP DE 0CF6: D7 RST RSTPUSH 0CF7: FDE9 JP (IY) 0CF9: 0CF9: ;================================================================ 0CF9: 2F4D4FC4 DB '/MO','D' | CLAST 0CFD: A70C DW UMUL-1 0CFF: 04 DB 4 0D00: C30E DIVMOD: DW DOCOL 0D02: 8508D208 0D06: E9120D0C DW SWAP,GTR,I,ABS ; prepare dividend 0D0A: 4B10 DW GETBYTE 0D0C: 00 DB 0 0D0D: DIVMOD2: 0D0D: FF086B08 0D11: E912 DW ROT,DUP,I 0D13: 600E DW LXOR ; calculate number sign 0D15: D2080D0C DW GTR,ABS ; prepare divisor 0D19: 8C0D DW UDIVMOD 0D1B: DF08940D 0D1F: 8508 DW RGT,IFN0NEG,SWAP ; number sign of quotient 0D21: DF08940D 0D25: 8508 DW RGT,IFN0NEG,SWAP ; number sign of remainder 0D27: B604 DW SEMIS 0D29: 0D29: ;================================================================ 0D29: 2A2F4D4F 0D2D: C4 DB '*/MO','D' | CLAST 0D2E: FF0C DW DIVMOD-1 0D30: 05 DB 5 0D31: MULDIVMOD: 0D31: C30E DW DOCOL 0D33: FF08D208 0D37: E9120D0C DW ROT,GTR,I,ABS ; prepare first multiplier 0D3B: 0D3B: FF086B08 0D3F: DF08600E DW ROT,DUP,RGT,LXOR ; calculate number sign 0D43: 0D43: D2080D0C DW GTR,ABS ; prepare second multiplier 0D47: A80C DW UMUL 0D49: 7612 DW DOREPEAT 0D4B: C1FF DW DIVMOD2-$-1 0D4D: 0D4D: ;================================================================ 0D4D: AF DB '/' | CLAST 0D4E: 300D DW MULDIVMOD-1 0D50: 01 DB 1 0D51: C30E DIV: DW DOCOL 0D53: 000D DW DIVMOD 0D55: 85087908 DW SWAP,DROP ; clear remainder 0D59: B604 DW SEMIS 0D5B: 0D5B: ;================================================================ 0D5B: 4D4FC4 DB 'MO','D' | CLAST 0D5E: 500D DW DIV-1 0D60: 03 DB 3 0D61: C30E MOD: DW DOCOL 0D63: 000D DW DIVMOD 0D65: 7908 DW DROP ; clear quotient 0D67: B604 DW SEMIS 0D69: 0D69: ;================================================================ 0D69: AA DB '*' | CLAST 0D6A: 600D DW MOD-1 0D6C: 01 DB 1 0D6D: C30E MUL: DW DOCOL 0D6F: A80C7908 DW UMUL,DROP ; clear upper word 0D73: B604 DW SEMIS 0D75: 0D75: ;================================================================ 0D75: 2AAF DB '*','/' | CLAST 0D77: 6C0D DW MUL-1 0D79: 02 DB 2 0D7A: C30E MULDIV: DW DOCOL 0D7C: 310D DW MULDIVMOD ; */MOD 0D7E: 85087908 DW SWAP,DROP ; clear remainder 0D82: B604 DW SEMIS 0D84: 0D84: ;================================================================ 0D84: 552F4D4F 0D88: C4 DB 'U/MO','D' | CLAST 0D89: 790D DW MULDIV-1 0D8B: 05 DB 5 0D8C: UDIVMOD: 0D8C: C30E DW DOCOL 0D8E: C40C7908 DW DIV32BY16,DROP 0D92: B604 DW SEMIS 0D94: 0D94: ;================================================================ 0D94: IFN0NEG: 0D94: C30E DW DOCOL 0D96: 2E0C8312 DW ZEROLT,DOIF 0D9A: 0300 DW I0NEND-$-1 0D9C: A90D DW NEGATE ; same sign as TOS 0D9E: B604 I0NEND: DW SEMIS 0DA0: 0DA0: ;================================================================ 0DA0: 4E454741 0DA4: 54C5 DB 'NEGAT','E' | CLAST 0DA6: 8B0D DW UDIVMOD-1 0DA8: 06 DB 6 0DA9: AB0D NEGATE: DW $+2 0DAB: 010200 LD BC,2 ; 2 bytes 0DAE: 180F JR DONEGATE 0DB0: 0DB0: ;================================================================ 0DB0: 444E4547 0DB4: 4154C5 DB 'DNEGAT','E' | CLAST 0DB7: A80D DW NEGATE-1 0DB9: 07 DB 7 0DBA: DNEGATE: 0DBA: BC0D DW $+2 0DBC: 010400 LD BC,4 ; 4 bytes 0DBF: DONEGATE: 0DBF: 2A3B3C LD HL,(SPARE) 0DC2: A7 AND A 0DC3: ED42 SBC HL,BC ; pointer to number in value stack 0DC5: DNLOOP: 0DC5: 78 LD A,B ; load 0, don't clear C 0DC6: 9E SBC A,(HL) 0DC7: 77 LD (HL),A ; negate byte 0DC8: 23 INC HL 0DC9: 0D DEC C 0DCA: 20F9 JR NZ,DNLOOP ; not yet all bytes? 0DCC: FDE9 JP (IY) 0DCE: 0DCE: ;================================================================ 0DCE: AB DB '+' | CLAST 0DCF: B90D DW DNEGATE-1 0DD1: 01 DB 1 0DD2: D40D PLUS: DW $+2 0DD4: DF RST RSTPULL 0DD5: D5 PUSH DE 0DD6: DF RST RSTPULL 0DD7: E1 POP HL 0DD8: 19 ADD HL,DE 0DD9: EB EX DE,HL 0DDA: D7 RST RSTPUSH 0DDB: FDE9 JP (IY) 0DDD: 0DDD: ;================================================================ 0DDD: AD DB '-' | CLAST 0DDE: D10D DW PLUS-1 0DE0: 01 DB 1 0DE1: C30E MINUS: DW DOCOL 0DE3: A90DD20D DW NEGATE,PLUS 0DE7: B604 DW SEMIS 0DE9: 0DE9: ;================================================================ 0DE9: 44AB DB 'D','+' | CLAST 0DEB: E00D DW MINUS-1 0DED: 02 DB 2 0DEE: F00D DPLUS: DW $+2 0DF0: DF RST RSTPULL 0DF1: D5 PUSH DE 0DF2: CD4E08 CALL PULLBC 0DF5: DF RST RSTPULL 0DF6: D5 PUSH DE 0DF7: DF RST RSTPULL 0DF8: EB EX DE,HL 0DF9: 09 ADD HL,BC 0DFA: EB EX DE,HL 0DFB: D7 RST RSTPUSH 0DFC: C1 POP BC 0DFD: E1 POP HL 0DFE: ED4A ADC HL,BC 0E00: EB EX DE,HL 0E01: D7 RST RSTPUSH 0E02: FDE9 JP (IY) 0E04: 0E04: ;================================================================ 0E04: 31AB DB '1','+' | CLAST 0E06: ED0D DW DPLUS-1 0E08: 02 DB 2 0E09: ONEPLUS: 0E09: 0B0E DW $+2 0E0B: DF RST RSTPULL 0E0C: 1809 JR XPLUS 0E0E: 0E0E: ;================================================================ 0E0E: 32AB DB '2','+' | CLAST 0E10: 080E DW ONEPLUS-1 0E12: 02 DB 2 0E13: TWOPLUS: 0E13: 150E DW $+2 0E15: DF RST RSTPULL 0E16: 13 INC DE 0E17: 13 XPLUS: INC DE 0E18: 1814 JR XPLUSMINUS 0E1A: 0E1A: ;================================================================ 0E1A: 31AD DB '1','-' | CLAST 0E1C: 120E DW TWOPLUS-1 0E1E: 02 DB 2 0E1F: ONEMINUS: 0E1F: 210E DW $+2 0E21: DF RST RSTPULL 0E22: 1809 JR XMINUS 0E24: 0E24: ;================================================================ 0E24: 32AD DB '2','-' | CLAST 0E26: 1E0E DW ONEMINUS-1 0E28: 02 DB 2 0E29: TWOMINUS: 0E29: 2B0E DW $+2 0E2B: DF RST RSTPULL 0E2C: 1B DEC DE 0E2D: 1B XMINUS: DEC DE 0E2E: XPLUSMINUS: 0E2E: D7 RST RSTPUSH 0E2F: FDE9 JP (IY) 0E31: 0E31: ;================================================================ 0E31: 4FD2 DB 'O','R' | CLAST 0E33: 280E DW TWOMINUS-1 0E35: 02 DB 2 0E36: 380E LOR: DW $+2 0E38: DF RST RSTPULL 0E39: CD4E08 CALL PULLBC 0E3C: 7B LD A,E 0E3D: B1 OR C 0E3E: 5F LD E,A 0E3F: 7A LD A,D 0E40: B0 OR B 0E41: 57 LD D,A 0E42: D7 RST RSTPUSH 0E43: FDE9 JP (IY) 0E45: 0E45: ;================================================================ 0E45: 414EC4 DB 'AN','D' | CLAST 0E48: 350E DW LOR-1 0E4A: 03 DB 3 0E4B: 4D0E LAND: DW $+2 0E4D: DF RST RSTPULL 0E4E: CD4E08 CALL PULLBC 0E51: 7B LD A,E 0E52: A1 AND C 0E53: 5F LD E,A 0E54: 7A LD A,D 0E55: A0 AND B 0E56: 57 LD D,A 0E57: D7 RST RSTPUSH 0E58: FDE9 JP (IY) 0E5A: 0E5A: ;================================================================ 0E5A: 584FD2 DB 'XO','R' | CLAST 0E5D: 4A0E DW LAND-1 0E5F: 03 DB 3 0E60: 620E LXOR: DW $+2 0E62: DF RST RSTPULL 0E63: CD4E08 CALL PULLBC 0E66: 7B LD A,E 0E67: A9 XOR C 0E68: 5F LD E,A 0E69: 7A LD A,D 0E6A: A8 XOR B 0E6B: 57 LD D,A 0E6C: D7 RST RSTPUSH 0E6D: FDE9 JP (IY) 0E6F: 0E6F: ;================================================================ 0E6F: 4D41D8 DB 'MA','X' | CLAST 0E72: 5F0E DW LXOR-1 0E74: 03 DB 3 0E75: C30E MAX: DW DOCOL 0E77: 12091209 0E7B: 650C DW OVER,OVER,LT ; compare numbers 0E7D: 7112 DW DOELSE 0E7F: 0F00 DW MINMAX-$-1 0E81: 0E81: ;================================================================ 0E81: 4D49CE DB 'MI','N' | CLAST 0E84: 740E DW MAX-1 0E86: 03 DB 3 0E87: C30E MIN: DW DOCOL 0E89: 12091209 0E8D: 560C DW OVER,OVER,GT ; compare numbers 0E8F: 0E8F: MINMAX: 0E8F: 8312 DW DOIF 0E91: 0300 DW MINMAXEND-$-1 0E93: 8508 DW SWAP ; swap if required 0E95: MINMAXEND: 0E95: 7908 DW DROP ; erase other number 0E97: B604 DW SEMIS 0E99: 0E99: ;================================================================ 0E99: 44454349 0E9D: 4D41CC DB 'DECIMA','L' | CLAST 0EA0: 860E DW MIN-1 0EA2: 07 DB 7 0EA3: DECIMAL: 0EA3: A50E DW $+2 0EA5: DD363F0A LD (IX+VBASE-MEMBEG),10 0EA9: FDE9 JP (IY) 0EAB: 0EAB: ;================================================================ 0EAB: BA NCOLON: DB ':' | CLAST 0EAC: A20E DW DECIMAL-1 0EAE: 01 DB 1 0EAF: 8510C30E COLON: DW DODEFINER,DOCOL 0EB3: 4B10 DW GETBYTE 0EB5: 0A DB 10 ; store test value 0EB6: 0E1A DW SEMICODE 0EB8: 0EB8: 213E3C LD HL,FLAGS 0EBB: 7E LD A,(HL) 0EBC: F644 OR 0 + (1 << 6) | (1 << 2) 0EBE: 77 LD (HL),A ; switch on compiler 0EBF: FDE9 JP (IY) 0EC1: 0EC1: ;================================================================ 0EC1: E9FF DW NCOLON-$-1 0EC3: EB DOCOL: EX DE,HL ; current pointer for stack 0EC4: C3BA04 JP NEXTSUB 0EC7: 0EC7: ;================================================================ 0EC7: NCREATE: 0EC7: 43524541 0ECB: 54C5 DB 'CREAT','E' | CLAST 0ECD: AE0E DW COLON-1 0ECF: 06 DB 6 0ED0: C30E CREATE: DW DOCOL 0ED2: 4B10 DW GETBYTE 0ED4: 20 DB ' ' 0ED5: AB05FB0E DW WORD,CRHEADER ; prepare header 0ED9: 88064E0F DW ZERO,KOMMA 0EDD: 8004B308 DW CURRENT,AT 0EE1: 6B08B308 0EE5: 4E0F DW DUP,AT,KOMMA ; create link 0EE7: 60048508 0EEB: C108 DW HERE,SWAP,EXCLAM ; remember address 0EED: 99049608 0EF1: 5F0F DW PAD,CAT,CKOMMA 0EF3: 1110EC0F 0EF7: 4E0F DW GETWORD,DOCREATE,KOMMA ; store first word 0EF9: B604 DW SEMIS 0EFB: 0EFB: ;================================================================ 0EFB: CRHEADER: 0EFB: FD0E DW $+2 0EFD: CD2E0F CALL LINKHERE 0F00: DF RST RSTPULL 0F01: 1A LD A,(DE) ; get name length 0F02: 3D DEC A 0F03: FE3F CP 03FH 0F05: 3802 JR C,CHGOON ; name short enough? 0F07: E7 RST RSTERR 0F08: 06 DB ERRNAME 0F09: 0F09: C608 CHGOON: ADD A,8 ; links, length byte and first word 0F0B: 4F LD C,A 0F0C: 0600 LD B,0 0F0E: CD8C0F CALL MEMCHECK 0F11: 0F11: 1A LD A,(DE) 0F12: 4F LD C,A 0F13: 2A373C LD HL,(STKBOT) 0F16: D5 PUSH DE 0F17: CD9E0F CALL ALLOC ; allocate memory 0F1A: D1 POP DE 0F1B: 1A LD A,(DE) 0F1C: 47 LD B,A ; character count 0F1D: 13 CHLOOP: INC DE 0F1E: 1A LD A,(DE) 0F1F: CD0708 CALL TOUPPER 0F22: 77 LD (HL),A 0F23: 23 INC HL 0F24: 10F7 DJNZ CHLOOP ; store name 0F26: 22393C LD (DICT),HL 0F29: 2B DEC HL 0F2A: CBFE SET 7,(HL) ; tag end of name 0F2C: FDE9 JP (IY) 0F2E: 0F2E: ;================================================================ 0F2E: LINKHERE: 0F2E: DDCB3E56 BIT 2,(IX+FLAGS-MEMBEG) 0F32: 2802 JR Z,LHGOON ; not compile mode? 0F34: E7 RST RSTERR 0F35: 0C DB ERRMODE 0F36: 0F36: 2A373C LHGOON: LD HL,(STKBOT) 0F39: ED5B393C LD DE,(DICT) 0F3D: AF XOR A 0F3E: ED52 SBC HL,DE 0F40: EB EX DE,HL 0F41: 73 LD (HL),E 0F42: 23 INC HL 0F43: 72 LD (HL),D ; create link 0F44: 67 LD H,A 0F45: 6F LD L,A 0F46: 22393C LD (DICT),HL 0F49: C9 RET 0F4A: 0F4A: ;================================================================ 0F4A: AC DB ',' | CLAST 0F4B: CF0E DW CREATE-1 0F4D: 01 DB 1 0F4E: C30E KOMMA: DW DOCOL 0F50: 830F6004 0F54: 290EC108 DW ALLOT2,HERE,TWOMINUS,EXCLAM 0F58: B604 DW SEMIS 0F5A: 0F5A: ;================================================================ 0F5A: 43AC DB 'C',',' | CLAST 0F5C: 4D0F DW KOMMA-1 0F5E: 02 DB 2 0F5F: C30E CKOMMA: DW DOCOL 0F61: 4B10 DW GETBYTE 0F63: 01 DB 1 0F64: 760F6004 0F68: 1F0EA508 DW ALLOT,HERE,ONEMINUS,CEXCLAM 0F6C: B604 DW SEMIS 0F6E: 0F6E: ;================================================================ 0F6E: 414C4C4F 0F72: D4 DB 'ALLO','T' | CLAST 0F73: 5E0F DW CKOMMA-1 0F75: 05 DB 5 0F76: 780F ALLOT: DW $+2 0F78: CD4E08 CALL PULLBC 0F7B: 2A373C LD HL,(STKBOT) 0F7E: CD9E0F CALL ALLOC 0F81: FDE9 JP (IY) 0F83: 0F83: ;================================================================ 0F83: C30E ALLOT2: DW DOCOL 0F85: 4B10 DW GETBYTE 0F87: 02 DB 2 0F88: 760F DW ALLOT 0F8A: B604 DW SEMIS 0F8C: 0F8C: ;================================================================ 0F8C: MEMCHECK: 0F8C: 211E00 LD HL,30 0F8F: MEMCHECK2: 0F8F: C5 PUSH BC 0F90: 09 ADD HL,BC 0F91: ED4B3B3C LD BC,(SPARE) 0F95: 09 ADD HL,BC ; new end address 0F96: C1 POP BC 0F97: 3803 JR C,MCERROR ; memory overflow? 0F99: ED72 SBC HL,SP 0F9B: D8 RET C ; no overflow into stack? 0F9C: MCERROR: 0F9C: E7 RST RSTERR 0F9D: 01 DB ERRMEM 0F9E: 0F9E: ;================================================================ 0F9E: EB ALLOC: EX DE,HL 0F9F: 212800 LD HL,40 0FA2: CD8F0F CALL MEMCHECK2 ; some more testing 0FA5: 2A373C LD HL,(STKBOT) 0FA8: 09 ADD HL,BC 0FA9: 22373C LD (STKBOT),HL 0FAC: 2A3B3C LD HL,(SPARE) 0FAF: E5 PUSH HL 0FB0: 09 ADD HL,BC 0FB1: 223B3C LD (SPARE),HL ; advance pointer 0FB4: 0FB4: E3 EX (SP),HL 0FB5: E5 PUSH HL 0FB6: A7 AND A 0FB7: ED52 SBC HL,DE 0FB9: 44 LD B,H 0FBA: 4D LD C,L ; distance = old space - DE 0FBB: E1 POP HL 0FBC: D1 POP DE 0FBD: C8 RET Z ; nothing to move? 0FBE: 0FBE: 2B DEC HL 0FBF: 1B DEC DE 0FC0: EDB8 LDDR 0FC2: 23 INC HL ; move argument stack 0FC3: C9 RET 0FC4: 0FC4: ;================================================================ 0FC4: NVARIABLE: 0FC4: 56415249 0FC8: 41424CC5 DB 'VARIABL','E' | CLAST 0FCC: 750F DW ALLOT-1 0FCE: 08 DB 8 0FCF: VARIABLE: 0FCF: 8510F00F DW DODEFINER,DOVARIABLE 0FD3: 4E0F DW KOMMA 0FD5: B604 DW SEMIS 0FD7: 0FD7: ;================================================================ 0FD7: NCONSTANT: 0FD7: 434F4E53 0FDB: 54414ED4 DB 'CONSTAN','T' | CLAST 0FDF: CE0F DW VARIABLE-1 0FE1: 08 DB 8 0FE2: CONSTANT: 0FE2: 8510F50F DW DODEFINER,DOCONSTANT 0FE6: 4E0F DW KOMMA 0FE8: B604 DW SEMIS 0FEA: 0FEA: ;================================================================ 0FEA: DCFE DW NCREATE-$-1 0FEC: DOCREATE: 0FEC: 1802 JR DOVARIABLE 0FEE: 0FEE: ;================================================================ 0FEE: D5FF DW NVARIABLE-$-1 0FF0: DOVARIABLE: 0FF0: D7 RST RSTPUSH 0FF1: FDE9 JP (IY) 0FF3: 0FF3: ;================================================================ 0FF3: E3FF DW NCONSTANT-$-1 0FF5: DOCONSTANT: 0FF5: EB EX DE,HL 0FF6: 5E LD E,(HL) 0FF7: 23 INC HL 0FF8: 56 LD D,(HL) 0FF9: D7 RST RSTPUSH ; value on stack 0FFA: FDE9 JP (IY) 0FFC: 0FFC: ;================================================================ 0FFC: 4C495445 1000: 5241CC DB 'LITERA','L' | CLAST 1003: E10F DW CONSTANT-1 1005: 47 DB 7 | IMM 1006: LITERAL: 1006: 08111110 DW DOCOMPILER,GETWORD 100A: 4E0F DW KOMMA 100C: B604 DW SEMIS 100E: 100E: ;================================================================ 100E: 02 DB 2 100F: FFFF DW -1 1011: GETWORD: 1011: 1310 DW $+2 1013: 0601 LD B,1 ; only one word 1015: E1 GWLOOP: POP HL 1016: 5E LD E,(HL) 1017: 23 INC HL 1018: 56 LD D,(HL) ; get word 1019: 23 GWGOON: INC HL 101A: E5 PUSH HL 101B: D7 RST RSTPUSH ; word on stack 101C: 10F7 DJNZ GWLOOP 101E: FDE9 GWQUIT: JP (IY) 1020: 1020: ;================================================================ 1020: 41534349 1024: C9 NASCII: DB 'ASCI','I' | CLAST 1025: 0510 DW LITERAL-1 1027: 45 DB 5 | IMM 1028: C30E ASCII: DW DOCOL 102A: 4B10 DW GETBYTE 102C: 20 DB ' ' 102D: AB05090E 1031: 9608 DW WORD,ONEPLUS,CAT 1033: 0E1A DW SEMICODE 1035: DDCB3E76 BIT 6,(IX+FLAGS-MEMBEG) 1039: 28E3 JR Z,GWQUIT ; compiler off? 103B: CDB904 CALL NEXT 103E: 11104B10 1042: 4E0F DW GETWORD,GETBYTE,KOMMA 1044: 5F0F DW CKOMMA 1046: B604 DW SEMIS 1048: 1048: ;================================================================ 1048: 01 DB 1 1049: D6FF DW NASCII-$-1 104B: GETBYTE: 104B: 4D10 DW $+2 104D: E1 POP HL 104E: 5E LD E,(HL) 104F: 1600 LD D,0 1051: 0601 LD B,1 1053: 18C4 JR GWGOON 1055: 1055: ;================================================================ 1055: LITFLOAT: 1055: 08116410 DW DOCOMPILER,GETFLOAT 1059: 85084E0F 105D: 4E0F DW SWAP,KOMMA,KOMMA 105F: B604 DW SEMIS 1061: 1061: ;================================================================ 1061: 04 DB 4 1062: FFFF DW -1 1064: GETFLOAT: 1064: 6610 DW $+2 1066: 0602 LD B,2 1068: 18AB JR GWLOOP 106A: 106A: ;================================================================ 106A: NDEFINER: 106A: 44454649 106E: 4E45D2 DB 'DEFINE','R' | CLAST 1071: 2710 DW ASCII-1 1073: 07 DB 7 1074: DEFINER: 1074: 85108510 DW DODEFINER,DODEFINER 1078: 60044B10 DW HERE,GETBYTE 107C: 0C DB 12 107D: 830F DW ALLOT2 107F: 7612 DW DOREPEAT 1081: 34FE DW 0EB6H-$-1 1083: 1083: ;================================================================ 1083: E6FF DW NDEFINER-$-1 1085: DODEFINER: 1085: CDF00F CALL DOVARIABLE 1088: D00E DW CREATE ; creaste header 108A: 6B08B308 DW DUP,AT 108E: 6004290E 1092: C108 DW HERE,TWOMINUS,EXCLAM ; create link 1094: 130E9A10 DW TWOPLUS,DROPGOON 1098: B604 DW SEMIS 109A: 109A: ;---------------------------------------------------------------- 109A: DROPGOON: 109A: 9C10 DW $+2 109C: DF RST RSTPULL 109D: C3C30E JP DOCOL 10A0: 10A0: ;================================================================ 10A0: 43414CCC DB 'CAL','L' | CLAST 10A4: 7310 DW DEFINER-1 10A6: 04 DB 4 10A7: A910 CALL: DW $+2 10A9: DF RST RSTPULL ; get target address 10AA: EB EX DE,HL 10AB: E9 JP (HL) 10AC: 10AC: ;================================================================ 10AC: NDOESGT: 10AC: 444F4553 10B0: BE DB 'DOES','>' | CLAST 10B1: F410 DW COMPILER-1 10B3: 45 DB 5 | IMM 10B4: 0811E810 DOESGT: DW DOCOMPILER,DODOESGT 10B8: D812 DW ASSERT 10BA: 0C DB 12 ; test test value 10BB: CD10 DW DOESPATCH 10BD: 4B10 DW GETBYTE 10BF: CD DB 0CDH 10C0: 5F0F DW CKOMMA 10C2: 1110F00F 10C6: 4E0F DW GETWORD,DOVARIABLE,KOMMA ; "CALL DOVARIABLE" 10C8: 10C8: 4B10 DW GETBYTE 10CA: 0A DB 10 ; set etst value 10CB: B604 DW SEMIS 10CD: 10CD: ;================================================================ 10CD: DOESPATCH: 10CD: C30E DW DOCOL 10CF: 6B08290E 10D3: B515 DW DUP,TWOMINUS,NFA 10D5: 6004E10D 10D9: 1F0E4E0F DW HERE,MINUS,ONEMINUS,KOMMA 10DD: 60048508 10E1: C108 DW HERE,SWAP,EXCLAM ; adjust link 10E3: B604 DW SEMIS 10E5: 10E5: ;================================================================ 10E5: 05 DB 5 10E6: C5FF DW NDOESGT-$-1 10E8: DODOESGT: 10E8: B804 DW RSEMIS 10EA: 10EA: ;================================================================ 10EA: NCOMPILER: 10EA: 434F4D50 10EE: 494C45D2 DB 'COMPILE','R' | CLAST 10F2: A610 DW CALL-1 10F4: 08 DB 8 10F5: COMPILER: 10F5: 85100811 DW DODEFINER,DOCOMPILER 10F9: 6011 DW IMMEDIATE 10FB: 6004 DW HERE 10FD: 4B10 DW GETBYTE 10FF: 0B DB 11 1100: 830F DW ALLOT2 1102: 7612 DW DOREPEAT 1104: B1FD DW 0EB6H-$-1 1106: 1106: ;================================================================ 1106: E3FF DW NCOMPILER-$-1 1108: DOCOMPILER: 1108: DDCB3E76 BIT 6,(IX+FLAGS-MEMBEG) 110C: 2002 JR NZ,DOCOMGOON ; compiler ON? 110E: E7 RST RSTERR 110F: 04 DB ERRIMM 1110: 1110: DOCOMGOON: 1110: CDF00F CALL DOVARIABLE 1113: 6B08B308 1117: 4E0F DW DUP,AT,KOMMA 1119: 7612 DW DOREPEAT 111B: 78FF DW 1094H-$-1 111D: 111D: ;================================================================ 111D: NRUNSGT: 111D: 52554E53 1121: BE DB 'RUNS','>' | CLAST 1122: B310 DW DOESGT-1 1124: 45 DB 5 | IMM 1125: 08114011 RUNSGT: DW DOCOMPILER,DORUNSGT 1129: D812 DW ASSERT 112B: 0B DB 11 ; test test value 112C: 85085F0F DW SWAP,CKOMMA 1130: CD10 DW DOESPATCH 1132: 11104211 1136: 4E0F DW GETWORD,RUNSCORR,KOMMA 1138: 4B10 DW GETBYTE 113A: 0A DB 10 ; set test value 113B: B604 DW SEMIS 113D: 113D: ;---------------------------------------------------------------- 113D: 05 DB 5 113E: DEFF DW NRUNSGT-$-1 1140: DORUNSGT: 1140: B804 DW RSEMIS 1142: 1142: ;---------------------------------------------------------------- 1142: RUNSCORR: 1142: E1 POP HL 1143: D5 PUSH DE 1144: EB EX DE,HL 1145: D7 RST RSTPUSH 1146: 42 LD B,D 1147: 4B LD C,E 1148: D1 POP DE 1149: D5 PUSH DE 114A: 1B DEC DE 114B: 1B DEC DE 114C: CD9E15 CALL SKIPOFFS ; next Forth address 114F: D1 POP DE 1150: C5 PUSH BC 1151: C3C30E JP DOCOL 1154: 1154: ;================================================================ 1154: 494D4D45 1158: 44494154 115C: C5 DB 'IMMEDIAT','E' | CLAST 115D: 2411 DW RUNSGT-1 115F: 09 DB 9 1160: IMMEDIATE: 1160: C30E DW DOCOL 1162: 8004B308 1166: B308 DW CURRENT,AT,AT 1168: 0E1A DW SEMICODE 116A: DF RST RSTPULL 116B: EB EX DE,HL 116C: CBF6 SET 6,(HL) ; set 'immediate' bit 116E: FDE9 JP (IY) 1170: 1170: ;================================================================ 1170: 564F4341 1174: 42554C41 1178: 52D9 DB 'VOCABULAR','Y' | CLAST 117A: 5F11 DW IMMEDIATE-1 117C: 0A DB 10 117D: VOCABULARY: 117D: 8510B511 DW DODEFINER,SETCONTEXT 1181: 8004B308 DW CURRENT,AT 1185: 130E4E0F DW TWOPLUS,KOMMA 1189: 88065F0F DW ZERO,CKOMMA ; prepare link 118D: 60041110 1191: 353C DW HERE,GETWORD,VOCLNK 1193: 6B08B308 1197: 4E0FC108 DW DUP,AT,KOMMA,EXCLAM ; toggle compiler 119B: B604 DW SEMIS 119D: 119D: ;================================================================ 119D: 44454649 11A1: 4E495449 11A5: 4F4ED3 DB 'DEFINITION','S' | CLAST 11A8: 7C11 DW VOCABULARY-1 11AA: 0B DB 11 11AB: DEFINITIONS: 11AB: AD11 DW $+2 11AD: 2A333C LD HL,(VCONTEXT) 11B0: 22313C LD (VCURRENT),HL 11B3: FDE9 JP (IY) 11B5: 11B5: ;---------------------------------------------------------------- 11B5: SETCONTEXT: 11B5: ED53333C LD (VCONTEXT),DE 11B9: FDE9 JP (IY) 11BB: 11BB: ;================================================================ 11BB: 49C6 NIF: DB 'I','F' | CLAST 11BD: E013 DW RSQRBR-1 11BF: 42 DB 2 | IMM 11C0: 08118312 IF: DW DOCOMPILER,DOIF 11C4: 60044B10 DW HERE,GETBYTE 11C8: 02 DB 2 11C9: 830F DW ALLOT2 11CB: B604 DW SEMIS 11CD: 11CD: ;================================================================ 11CD: 5748494C 11D1: C5 NWHILE: DB 'WHIL','E' | CLAST 11D2: BF11 DW IF-1 11D4: 45 DB 5 | IMM 11D5: 08118812 WHILE: DW DOCOMPILER,DOWHILE 11D9: D812 DW ASSERT 11DB: 01 DB 1 ; test test value 11DC: 60044B10 DW HERE,GETBYTE 11E0: 04 DB 4 11E1: 830F DW ALLOT2 11E3: B604 DW SEMIS 11E5: 11E5: ;================================================================ 11E5: 454C53C5 NELSE: DB 'ELS','E' | CLAST 11E9: D411 DW WHILE-1 11EB: 44 DB 4 | IMM 11EC: 08117112 ELSE: DW DOCOMPILER,DOELSE 11F0: D812 DW ASSERT 11F2: 02 DB 2 ; test test value 11F3: 830F DW ALLOT2 11F5: 2512 DW DOFPATCH 11F7: 6004290E DW HERE,TWOMINUS 11FB: 4B10 DW GETBYTE 11FD: 02 DB 2 ; set test value 11FE: B604 DW SEMIS 1200: 1200: ;================================================================ 1200: 544845CE NTHEN: DB 'THE','N' | CLAST 1204: EB11 DW ELSE-1 1206: 44 DB 4 | IMM 1207: 0811A412 THEN: DW DOCOMPILER,DOTHEN 120B: D812 DW ASSERT 120D: 02 DB 2 ; test test value 120E: 2512 DW DOFPATCH 1210: B604 DW SEMIS 1212: 1212: ;================================================================ 1212: 42454749 1216: CE NBEGIN: DB 'BEGI','N' | CLAST 1217: 0612 DW THEN-1 1219: 45 DB 5 | IMM 121A: 08119F12 BEGIN: DW DOCOMPILER,DOBEGIN 121E: 6004 DW HERE 1220: 4B10 DW GETBYTE 1222: 01 DB 1 ; set test value 1223: B604 DW SEMIS 1225: 1225: ;================================================================ 1225: DOFPATCH: 1225: C30E DW DOCOL 1227: 6B086004 122B: 8508E10D DW DUP,HERE,SWAP,MINUS 122F: 1F0E8508 1233: C108 DW ONEMINUS,SWAP,EXCLAM ; patch jump address 1235: B604 DW SEMIS 1237: 1237: ;================================================================ 1237: DORPATCH: 1237: C30E DW DOCOL 1239: 6004E10D 123D: 1F0E DW HERE,MINUS,ONEMINUS 123F: 4E0F DW KOMMA ; patch jump address 1241: B604 DW SEMIS 1243: 1243: ;================================================================ 1243: NREPEAT: 1243: 52455045 1247: 41D4 DB 'REPEA','T' | CLAST 1249: 1912 DW BEGIN-1 124B: 46 DB 6 | IMM 124C: 08117612 REPEAT: DW DOCOMPILER,DOREPEAT 1250: D812 DW ASSERT 1252: 04 DB 4 ; test test value 1253: 8508 DW SWAP 1255: 3712 DW DORPATCH 1257: 2512 DW DOFPATCH 1259: B604 DW SEMIS 125B: 125B: ;================================================================ 125B: 554E5449 125F: CC NUNTIL: DB 'UNTI','L' | CLAST 1260: 4B12 DW REPEAT-1 1262: 45 DB 5 | IMM 1263: 08118D12 UNTIL: DW DOCOMPILER,DOUNTIL 1267: D812 DW ASSERT 1269: 01 DB 1 ; test test value 126A: 3712 DW DORPATCH 126C: B604 DW SEMIS 126E: 126E: ;================================================================ 126E: 02 DB 2 126F: 75FF DW NELSE-$-1 1271: 7812 DOELSE: DW FJUMP 1273: 1273: ;================================================================ 1273: 02 DB 2 1274: CEFF DW NREPEAT-$-1 1276: DOREPEAT: 1276: 7812 DW FJUMP 1278: 1278: ;================================================================ 1278: E1 FJUMP: POP HL 1279: 5E LD E,(HL) 127A: 23 INC HL 127B: 56 LD D,(HL) ; get offset 127C: OFFSJUMP: 127C: 19 ADD HL,DE 127D: C3BA04 JP NEXTSUB ; set new Forth pointer 1280: 1280: ;================================================================ 1280: 02 DB 2 1281: 39FF DW NIF-$-1 1283: 8F12 DOIF: DW IF0JUMP 1285: 1285: ;================================================================ 1285: 02 DB 2 1286: 46FF DW NWHILE-$-1 1288: DOWHILE: 1288: 8F12 DW IF0JUMP 128A: 128A: ;================================================================ 128A: 02 DB 2 128B: CFFF DW NUNTIL-$-1 128D: DOUNTIL: 128D: 8F12 DW IF0JUMP 128F: 128F: ;---------------------------------------------------------------- 128F: IF0JUMP: 128F: CD4E08 CALL PULLBC 1292: 78 LD A,B 1293: B1 OR C ; test for 0 1294: EQUJUMP: 1294: 28E2 JR Z,FJUMP ; condition true? 1296: E1 POP HL 1297: 23 INC HL 1298: 23 INC HL 1299: C3BA04 JP NEXTSUB ; skip offset 129C: 129C: ;================================================================ 129C: 00 DB 0 129D: 74FF DW NBEGIN-$-1 129F: DOBEGIN: 129F: B904 DW NEXT 12A1: 12A1: ;================================================================ 12A1: 00 DB 0 12A2: 5DFF DW NTHEN-$-1 12A4: B904 DOTHEN: DW NEXT 12A6: 12A6: ;================================================================ 12A6: 44CF NDO: DB 'D','O' | CLAST 12A8: 6212 DW UNTIL-1 12AA: 42 DB 2 | IMM 12AB: 08112313 DO: DW DOCOMPILER,DODO 12AF: 6004 DW HERE 12B1: 4B10 DW GETBYTE 12B3: 03 DB 3 ; set test value 12B4: B604 DW SEMIS 12B6: 12B6: ;================================================================ 12B6: 4C4F4FD0 NLOOP: DB 'LOO','P' | CLAST 12BA: AA12 DW DO-1 12BC: 44 DB 4 | IMM 12BD: 08113213 LOOP: DW DOCOMPILER,DOLOOP 12C1: LOOPGOON: 12C1: D812 DW ASSERT 12C3: 03 DB 3 ; test test value 12C4: 3712 DW DORPATCH 12C6: B604 DW SEMIS 12C8: 12C8: ;================================================================ 12C8: NPLUSLOOP: 12C8: 2B4C4F4F 12CC: D0 DB '+LOO','P' | CLAST 12CD: BC12 DW LOOP-1 12CF: 45 DB 5 | IMM 12D0: PLUSLOOP: 12D0: 08113C13 DW DOCOMPILER,DOPLUSLOOP 12D4: 7612 DW DOREPEAT 12D6: EAFF DW LOOPGOON-$-1 12D8: 12D8: ;================================================================ 12D8: DA12 ASSERT: DW $+2 12DA: DF RST RSTPULL 12DB: E1 POP HL 12DC: 7E LD A,(HL) 12DD: 23 INC HL 12DE: E5 PUSH HL ; test value 12DF: 93 SUB E 12E0: B2 OR D 12E1: 284A JR Z,JNEXT4 ; same as value on stack? 12E3: E7 RST RSTERR 12E4: 05 DB ERRBLK 12E5: 12E5: ;================================================================ 12E5: C9 DB 'I' | CLAST 12E6: AA11 DW DEFINITIONS-1 12E8: 01 DB 1 12E9: EB12 I: DW $+2 12EB: C1 POP BC 12EC: D1 POP DE ; loop counter or "R" 12ED: D5 PUSH DE 12EE: C5 PUSH BC 12EF: D7 RST RSTPUSH 12F0: FDE9 JP (IY) 12F2: 12F2: ;================================================================ 12F2: 49A7 DB 'I',"'" | CLAST 12F4: E812 DW I-1 12F6: 02 DB 2 12F7: F912 ITICK: DW $+2 12F9: 210400 LD HL,4 ;"R2" (see "I") 12FC: 1809 JR RGET 12FE: 12FE: ;================================================================ 12FE: CA DB 'J' | CLAST 12FF: F612 DW ITICK-1 1301: 01 DB 1 1302: 0413 J: DW $+2 1304: 210600 LD HL,6 ;"R3" (see "I") 1307: 39 RGET: ADD HL,SP 1308: 5E LD E,(HL) 1309: 23 INC HL 130A: 56 LD D,(HL) ; get value from return stack 130B: D7 RST RSTPUSH 130C: FDE9 JP (IY) 130E: 130E: ;================================================================ 130E: 4C454156 1312: C5 DB 'LEAV','E' | CLAST 1313: 0113 DW J-1 1315: 05 DB 5 1316: 1813 LEAVE: DW $+2 1318: C1 POP BC 1319: E1 POP HL 131A: E1 POP HL 131B: E5 PUSH HL 131C: E5 PUSH HL ; counter := end value 131D: C5 PUSH BC 131E: FDE9 JP (IY) 1320: 1320: ;================================================================ 1320: 00 DB 0 1321: 84FF DW NDO-$-1 1323: 2513 DODO: DW $+2 1325: CD4E08 CALL PULLBC 1328: DF RST RSTPULL 1329: E1 POP HL 132A: D5 PUSH DE 132B: C5 PUSH BC ; remember counter and end value 132C: E5 PUSH HL 132D: FDE9 JNEXT4: JP (IY) 132F: 132F: ;================================================================ 132F: 02 DB 2 1330: 85FF DW NLOOP-$-1 1332: 3413 DOLOOP: DW $+2 1334: 110100 LD DE,1 1337: 1806 JR LOOPADD 1339: 1339: ;================================================================ 1339: 02 DB 2 133A: 8DFF DW NPLUSLOOP-$-1 133C: DOPLUSLOOP: 133C: 3E13 DW $+2 133E: DF RST RSTPULL 133F: LOOPADD: 133F: C1 POP BC 1340: E1 POP HL ; get counter 1341: A7 AND A 1342: ED5A ADC HL,DE ; increment (??? UMSTAENDLICH) 1344: 7A LD A,D 1345: D1 POP DE ; get end value 1346: 37 SCF 1347: EA5813 JP PE,LOOPEND ; overflow? => end 134A: D5 PUSH DE 134B: E5 PUSH HL ; store back values 134C: 07 RLCA 134D: 3001 JR NC,LOOPCMP 134F: EB EX DE,HL 1350: LOOPCMP: 1350: CD990C CALL GREATER 1353: 3F CCF 1354: 3002 JR NC,LOOPEND ; not yet finished? 1356: E1 POP HL 1357: E1 POP HL ; discard loop values 1358: LOOPEND: 1358: C5 PUSH BC 1359: 9F SBC A,A 135A: C39412 JP EQUJUMP 135D: 135D: ;================================================================ 135D: NLBRACKET: 135D: A8 DB '(' | CLAST 135E: D413 DW LSQRBR-1 1360: 41 DB 1 | IMM 1361: LBRACKET: 1361: 08117913 DW DOCOMPILER,DOLBRACKET 1365: 4B10 DW GETBYTE 1367: 29 DB ')' 1368: 60048508 136C: 830F9F13 LBREND: DW HERE,SWAP,ALLOT2,SAVETEXT 1370: 8508C108 DW SWAP,EXCLAM ; store text 1374: B604 DW SEMIS 1376: 1376: ;================================================================ 1376: FF DB -1 1377: E5FF DW NLBRACKET-$-1 1379: DOLBRACKET: 1379: 7B13 DW $+2 137B: E1 POP HL 137C: 5E LD E,(HL) 137D: 23 INC HL 137E: 56 LD D,(HL) ; get offset 137F: 13 INC DE 1380: C37C12 JP OFFSJUMP 1383: 1383: ;================================================================ 1383: 2EA2 NPTSTR: DB '.','"' | CLAST 1385: 6013 DW LBRACKET-1 1387: 42 DB 2 | IMM 1388: 08119613 PTSTR: DW DOCOMPILER,DOPTSTR 138C: 4B10 DW GETBYTE 138E: 22 DB '"' 138F: 7612 DW DOREPEAT 1391: D6FF DW LBREND-$-1 1393: 1393: ;================================================================ 1393: FF DB -1 1394: EEFF DW NPTSTR-$-1 1396: DOPTSTR: 1396: 9813 DW $+2 1398: D1 POP DE 1399: CD7909 CALL TYPEDE ; print string 139C: D5 PUSH DE 139D: FDE9 JP (IY) 139F: 139F: ;================================================================ 139F: SAVETEXT: 139F: A113 DW $+2 13A1: DF STLOOP: RST RSTPULL 13A2: D5 PUSH DE 13A3: CDE105 CALL CWORD ; search end 13A6: 62 LD H,D 13A7: 6B LD L,E 13A8: 09 ADD HL,BC 13A9: 7E LD A,(HL) 13AA: E1 POP HL 13AB: BD CP L 13AC: 280A JR Z,STFND ; end found? 13AE: 13AE: EB EX DE,HL 13AF: D7 RST RSTPUSH 13B0: 117805 LD DE,RETYPE 13B3: CD1518 CALL EXECDE 13B6: 18E9 JR STLOOP ; try again 13B8: 13B8: STFND: 13B8: D5 PUSH DE 13B9: C5 PUSH BC 13BA: 2A373C LD HL,(STKBOT) ; limit against spare 13BD: CD9E0F CALL ALLOC ; get memory 13C0: C1 POP BC 13C1: D1 POP DE 13C2: D5 PUSH DE 13C3: C5 PUSH BC 13C4: EB EX DE,HL 13C5: EDB0 LDIR ; copy text 13C7: C1 POP BC 13C8: 50 LD D,B 13C9: 59 LD E,C 13CA: D7 RST RSTPUSH 13CB: D1 POP DE 13CC: CDDA07 CALL BLWORD ; erase input 13CF: FDE9 JP (IY) 13D1: 13D1: ;================================================================ 13D1: DB DB '[' | CLAST 13D2: CF12 DW PLUSLOOP-1 13D4: 41 DB 1 | IMM 13D5: D713 LSQRBR: DW $+2 13D7: DDCB3EB6 RES 6,(IX+FLAGS-MEMBEG) ; switch off compiler 13DB: FDE9 JP (IY) 13DD: 13DD: ;================================================================ 13DD: DD DB ']' | CLAST 13DE: 1513 DW LEAVE-1 13E0: 01 DB 1 13E1: E313 RSQRBR: DW $+2 13E3: DDCB3EF6 SET 6,(IX+FLAGS-MEMBEG) ; switch on compiler 13E7: FDE9 JP (IY) 13E9: 13E9: ;================================================================ 13E9: 455849D4 DB 'EXI','T' | CLAST 13ED: 8713 DW PTSTR-1 13EF: 04 DB 4 13F0: B804 EXIT: DW RSEMIS 13F2: 13F2: ;================================================================ 13F2: RDONAME EQU 0 ; pointer to name of old word 13F2: RDOCODE EQU 2 ; pointer to code field of old word 13F2: RDNCODE EQU 4 ; pointer to code field of new word 13F2: RDDNAME EQU 4 ; difference in name lengths 13F2: RDNRUN EQU 6 ; 0 / run address of new word 13F2: RDOEND EQU 8 ; pointer behind old word 13F2: RDNEND EQU 10 ; pointer behind new word 13F2: RDDLEN EQU 10 ; difference in length 13F2: RDNNAME EQU 12 ; pointer to name of new word 13F2: ;================================================================ 13F2: 52454445 13F6: 46494EC5 DB 'REDEFIN','E' | CLAST 13FA: EF13 DW EXIT-1 13FC: 08 DB 8 13FD: REDEFINE: 13FD: FF13 DW $+2 13FF: CD2E0F CALL LINKHERE 1402: 2A313C LD HL,(VCURRENT) 1405: 5E LD E,(HL) 1406: 23 INC HL 1407: 56 LD D,(HL) 1408: EB EX DE,HL 1409: 23 INC HL 140A: 220527 LD (PADMEM+RDNCODE),HL ; code field new word 140D: E5 PUSH HL 140E: CDC015 CALL PTR2ADDR 1411: 220D27 LD (PADMEM+RDNNAME),HL 1414: ED430727 LD (PADMEM+RDNRUN),BC 1418: ED530B27 LD (PADMEM+RDNEND),DE ; get address 141C: 141C: 2A373C LD HL,(STKBOT) 141F: ED52 SBC HL,DE 1421: C2DA14 JP NZ,DICTERR ; not newest word? 1424: 1424: D1 POP DE 1425: D7 RST RSTPUSH ; word to be redefined 1426: CDB904 CALL NEXT 1429: 10163D06 142D: 0E1A DW RESCURR,FIND,SEMICODE 142F: 142F: DF RST RSTPULL ; code field address of old word 1430: 21AFC3 LD HL,-FREEMEM 1433: 19 ADD HL,DE 1434: D2CF14 JP NC,REDEFABORT ; word not in ram? 1437: 1437: EB EX DE,HL 1438: 220327 LD (PADMEM+RDOCODE),HL 143B: CDC015 CALL PTR2ADDR ; get address 143E: 220127 LD (PADMEM+RDONAME),HL 1441: E5 PUSH HL ; (see below!) 1442: ED530927 LD (PADMEM+RDOEND),DE 1446: 78 LD A,B 1447: B1 OR C 1448: ED5B0727 LD DE,(PADMEM+RDNRUN) 144C: 2804 JR Z,RDGOON1 ; old without special run part? 144E: 7A LD A,D 144F: B3 OR E 1450: 287D JR Z,REDEFABORT ; new without special run part? 1452: 1452: RDGOON1: 1452: E1 POP HL 1453: ED4B0D27 LD BC,(PADMEM+RDNNAME) 1457: ED42 SBC HL,BC 1459: EB EX DE,HL 145A: 19 ADD HL,DE 145B: 220727 LD (PADMEM+RDNRUN),HL ; update run address 145E: 145E: 2A0B27 LD HL,(PADMEM+RDNEND) 1461: 19 ADD HL,DE 1462: ED4B0927 LD BC,(PADMEM+RDOEND) 1466: A7 AND A 1467: ED42 SBC HL,BC 1469: 220B27 LD (PADMEM+RDDLEN),HL ; calculate length difference 146C: 146C: 012E00 LD BC,46 146F: 09 ADD HL,BC 1470: CB7C BIT 7,H 1472: 200B JR NZ,RDGOON2 ; at least 47 bytes shorter? 1474: 1474: ED4B3B3C LD BC,(SPARE) 1478: 09 ADD HL,BC 1479: 3854 JR C,REDEFABORT 147B: ED72 SBC HL,SP 147D: 3050 JR NC,REDEFABORT ; out of memory? 147F: 147F: RDGOON2: 147F: 2A0327 LD HL,(PADMEM+RDOCODE) 1482: E5 PUSH HL 1483: 2B DEC HL 1484: 2B DEC HL 1485: 46 LD B,(HL) 1486: 2B DEC HL 1487: 4E LD C,(HL) 1488: 2A0527 LD HL,(PADMEM+RDNCODE) 148B: E5 PUSH HL 148C: 2B DEC HL 148D: 2B DEC HL 148E: 70 LD (HL),B 148F: 2B DEC HL 1490: 71 LD (HL),C ; link words 1491: E1 POP HL 1492: 19 ADD HL,DE 1493: C1 POP BC 1494: A7 AND A 1495: ED42 SBC HL,BC 1497: 220527 LD (PADMEM+RDDNAME),HL ; calculate name length difference 149A: 149A: ED5B0127 LD DE,(PADMEM+RDONAME) 149E: 2A0927 LD HL,(PADMEM+RDOEND) 14A1: A7 AND A 14A2: ED52 SBC HL,DE 14A4: 44 LD B,H 14A5: 4D LD C,L 14A6: D5 PUSH DE 14A7: C5 PUSH BC 14A8: CDDC14 CALL DELWORD ; erase old word 14AB: 14AB: 2A0B27 LD HL,(PADMEM+RDDLEN) 14AE: C1 POP BC 14AF: 09 ADD HL,BC 14B0: 44 LD B,H 14B1: 4D LD C,L 14B2: E1 POP HL 14B3: C5 PUSH BC 14B4: CD9E0F CALL ALLOC ; get memory for new word 14B7: EB EX DE,HL 14B8: 2A0D27 LD HL,(PADMEM+RDNNAME) 14BB: ED4B0B27 LD BC,(PADMEM+RDDLEN) 14BF: 09 ADD HL,BC ; adjust start address 14C0: C1 POP BC 14C1: C5 PUSH BC 14C2: E5 PUSH HL 14C3: EDB0 LDIR ; copy new word 14C5: D1 POP DE 14C6: C1 POP BC 14C7: CDDC14 CALL DELWORD ; erase original data 14CA: CDF814 CALL CORRCURR ; adjust pointer 14CD: FDE9 JP (IY) 14CF: 14CF: REDEFABORT: 14CF: 2A313C LD HL,(VCURRENT) 14D2: ED5B0527 LD DE,(PADMEM+RDNCODE) 14D6: 1B DEC DE 14D7: 73 LD (HL),E 14D8: 23 INC HL 14D9: 72 LD (HL),D ; set 'current dictionary' 14DA: DICTERR: 14DA: E7 RST RSTERR 14DB: 0B DB ERRDICT 14DC: 14DC: ;================================================================ 14DC: DELWORD: 14DC: 2A373C LD HL,(STKBOT) 14DF: A7 AND A 14E0: ED42 SBC HL,BC 14E2: 22373C LD (STKBOT),HL ; lower 'HERE' 14E5: 14E5: 2A3B3C LD HL,(SPARE) 14E8: ED42 SBC HL,BC 14EA: 223B3C LD (SPARE),HL ; lower 'SPARE' 14ED: 14ED: ED52 SBC HL,DE 14EF: C8 RET Z ; was this the last word? 14F0: 14F0: C5 PUSH BC 14F1: 44 LD B,H 14F2: 4D LD C,L 14F3: E1 POP HL 14F4: 19 ADD HL,DE 14F5: EDB0 LDIR ; move remainder 14F7: C9 RET 14F8: 14F8: ;---------------------------------------------------------------- 14F8: CORRCURR: 14F8: 01313C LD BC,VCURRENT 14FB: CD5715 CALL CORRPTR 14FE: CD5715 CALL CORRPTR ; adjust 'CURRENT' pointer 1501: 1501: 01403C LD BC,DICT1ST 1504: CORRDICT: 1504: 2A373C LD HL,(STKBOT) 1507: 37 SCF 1508: ED42 SBC HL,BC 150A: D8 RET C ; reached end? 150B: 150B: CDLOOP: 150B: 0A LD A,(BC) 150C: 17 RLA 150D: 03 INC BC 150E: 30FB JR NC,CDLOOP ; skip name 1510: 1510: 03 INC BC 1511: 03 INC BC 1512: CD5715 CALL CORRPTR ; adjust end address 1515: 03 INC BC 1516: CD5715 CALL CORRPTR ; first word of dictionary 1519: CDFB15 CALL JUMPDE 151C: C30E DW DOCOL 151E: 1C DB CDCOLON-$ 151F: 8510 DW DODEFINER 1521: 16 DB CDDEFCOM-$ 1522: 0811 DW DOCOMPILER 1524: 13 DB CDDEFCOM-$ 1525: B511 DW SETCONTEXT 1527: 18 DB CDSETCTXT-$ 1528: 0000 DW 0 152A: 152A: 21F9FF LD HL,-7 152D: 09 ADD HL,BC 152E: 4E LD C,(HL) 152F: 23 INC HL 1530: 46 LD B,(HL) 1531: 2B DEC HL 1532: 09 ADD HL,BC ; link to previous dictionary 1533: 44 LD B,H 1534: 4D LD C,L 1535: 18CD JR CORRDICT 1537: 1537: CDDEFCOM: 1537: CD5715 CALL CORRPTR 153A: CDCOLON: 153A: CD4815 CALL CORRWORD 153D: 18C5 JR CORRDICT 153F: 153F: CDSETCTXT: 153F: CD5715 CALL CORRPTR 1542: 03 INC BC 1543: CD5715 CALL CORRPTR 1546: 18BC JR CORRDICT 1548: 1548: ;---------------------------------------------------------------- 1548: CORRWORD: 1548: CD5715 CALL CORRPTR 154B: 21B604 LD HL,SEMIS 154E: A7 AND A 154F: ED52 SBC HL,DE 1551: C8 RET Z ; Forth word end found? 1552: CD9E15 CALL SKIPOFFS 1555: 18F1 JR CORRWORD 1557: 1557: ;---------------------------------------------------------------- 1557: CORRPTR: 1557: 0A LD A,(BC) 1558: 5F LD E,A 1559: 03 INC BC 155A: 0A LD A,(BC) 155B: 57 LD D,A 155C: 0B DEC BC ; get address 155D: CD6815 CALL CORRADDR 1560: EB EX DE,HL 1561: 7B LD A,E 1562: 02 LD (BC),A 1563: 03 INC BC 1564: 7A LD A,D 1565: 02 LD (BC),A ; store back adjusted value 1566: 03 INC BC 1567: C9 RET 1568: 1568: ;---------------------------------------------------------------- 1568: CORRADDR: 1568: 2A0127 LD HL,(PADMEM+RDONAME) 156B: A7 AND A 156C: ED52 SBC HL,DE 156E: 62 LD H,D 156F: 6B LD L,E 1570: D0 RET NC ; older word => no adjustment 1571: 1571: 2A0927 LD HL,(PADMEM+RDOEND) 1574: ED52 SBC HL,DE 1576: 300C JR NC,CAWORD ; redefined word? 1578: 1578: 2A0D27 LD HL,(PADMEM+RDNNAME) 157B: ED52 SBC HL,DE 157D: 3813 JR C,CADICT ; other dictionary? 157F: 157F: 2A0B27 LD HL,(PADMEM+RDDLEN) 1582: 19 ADD HL,DE 1583: C9 RET ; newer => adjust with offset 1584: 1584: CAWORD: 1584: 2A0327 LD HL,(PADMEM+RDOCODE) 1587: ED52 SBC HL,DE 1589: 2A0727 LD HL,(PADMEM+RDNRUN) 158C: D8 RET C ; has run part => new address 158D: 158D: 2A0527 LD HL,(PADMEM+RDDNAME) 1590: 19 ADD HL,DE 1591: C9 RET ; adjust with name difference 1592: 1592: CADICT: 1592: 2A0127 LD HL,(PADMEM+RDONAME) 1595: 19 ADD HL,DE 1596: ED5B0D27 LD DE,(PADMEM+RDNNAME) 159A: A7 AND A 159B: ED52 SBC HL,DE 159D: C9 RET ; adjust with length difference 159E: 159E: ;---------------------------------------------------------------- 159E: SKIPOFFS: 159E: 1B DEC DE 159F: 1A LD A,(DE) 15A0: 17 RLA 15A1: D0 RET NC ; plain Forth word? 15A2: 15A2: SKOFFS2: 15A2: 1B DEC DE 15A3: 1B DEC DE 15A4: 1A LD A,(DE) ; get offset 15A5: 6F LD L,A 15A6: 2600 LD H,0 15A8: 3C INC A 15A9: 2006 JR NZ,SKOGOON ; offset byte valid? 15AB: 0A LD A,(BC) 15AC: 6F LD L,A 15AD: 03 INC BC 15AE: 0A LD A,(BC) 15AF: 67 LD H,A 15B0: 03 INC BC ; get offset from code 15B1: 15B1: SKOGOON: 15B1: 09 ADD HL,BC 15B2: 44 LD B,H 15B3: 4D LD C,L ; remember new address 15B4: C9 RET 15B5: 15B5: ;---------------------------------------------------------------- 15B5: B715 NFA: DW $+2 15B7: DF RST RSTPULL 15B8: EB EX DE,HL 15B9: CDE715 CALL FPTR2NAME 15BC: EB EX DE,HL 15BD: D7 RST RSTPUSH 15BE: FDE9 JP (IY) 15C0: 15C0: ;---------------------------------------------------------------- 15C0: PTR2ADDR: 15C0: E5 PUSH HL 15C1: 5E LD E,(HL) 15C2: 23 INC HL 15C3: 56 LD D,(HL) ; get first word address 15C4: CDFB15 CALL JUMPDE 15C7: 0811 DW DOCOMPILER 15C9: 0B DB P2ARUN-$ 15CA: 8510 DW DODEFINER 15CC: 08 DB P2ARUN-$ 15CD: 0000 DW 0 15CF: 15CF: 010000 LD BC,0 ; no special run part 15D2: 1807 JR P2AGOON 15D4: 15D4: P2ARUN: 15D4: E1 POP HL 15D5: E5 PUSH HL 15D6: 23 INC HL 15D7: 23 INC HL 15D8: 4E LD C,(HL) 15D9: 23 INC HL 15DA: 46 LD B,(HL) ;get runtime address 15DB: 15DB: P2AGOON: 15DB: E1 POP HL 15DC: E5 PUSH HL 15DD: 2B DEC HL 15DE: 2B DEC HL 15DF: 2B DEC HL 15E0: 2B DEC HL 15E1: 56 LD D,(HL) 15E2: 2B DEC HL 15E3: 5E LD E,(HL) 15E4: 19 ADD HL,DE 15E5: EB EX DE,HL ;calculate pointer behind word 15E6: E1 POP HL 15E7: 15E7: ;---------------------------------------------------------------- 15E7: FPTR2NAME: 15E7: 2B DEC HL 15E8: PTR2NAME: 15E8: 7C LD A,H 15E9: FE3C CP MEMBEG >> 8 15EB: 7E LD A,(HL) 15EC: CBB7 RES 6,A ; clear 'immediate' bit 15EE: 3802 JR C,P2NGOON 15F0: C602 ADD A,2 ; more for words in ram 15F2: P2NGOON: 15F2: 2B DEC HL 15F3: 2B DEC HL ; skip link pointer 15F4: P2NLOOP: 15F4: 2B DEC HL 15F5: 3D DEC A 15F6: 20FC JR NZ,P2NLOOP ; point to start of name 15F8: C9 RET 15F9: 15F9: ;=============================================================== 15F9: JDELOOP: 15F9: 23 INC HL ; skip offset 15FA: E5 PUSH HL 15FB: JUMPDE: 15FB: E1 POP HL 15FC: 7E LD A,(HL) 15FD: 23 INC HL 15FE: E5 PUSH HL 15FF: 66 LD H,(HL) 1600: 6F LD L,A ; get next pointer 1601: 1601: B4 OR H 1602: C8 RET Z ; 0 ? (HRM-HRM, AUF "NOP" !!!) 1603: 1603: ED52 SBC HL,DE 1605: E1 POP HL 1606: 23 INC HL 1607: 20F0 JR NZ,JDELOOP ;pointer not yet reached? 1609: 1609: D5 PUSH DE 160A: 1600 LD D,0 160C: 5E LD E,(HL) ; get offset 160D: 19 ADD HL,DE 160E: D1 POP DE 160F: E9 JP (HL) ;jump to code 1610: 1610: ;================================================================ 1610: RESCURR: 1610: C30E DW DOCOL 1612: 1F0E290E 1616: B308 DW ONEMINUS,TWOMINUS,AT 1618: 8004B308 161C: C108 DW CURRENT,AT,EXCLAM ; reset 'CURRENT' 161E: B604 DW SEMIS 1620: 1620: ;================================================================ 1620: FINDWORD: 1620: CDB904 CALL NEXT 1623: 3D06 DW FIND 1625: 0E1A DW SEMICODE 1627: DF RST RSTPULL ; address of code field 1628: 21AFC3 LD HL,-FREEMEM 162B: 19 ADD HL,DE 162C: D8 RET C ; word found? 162D: E7 RST RSTERR 162E: 0D DB ERRFIND 162F: 162F: ;================================================================ 162F: 464F5247 1633: 45D4 DB 'FORGE','T' | CLAST 1635: FC13 DW REDEFINE-1 1637: 06 DB 6 1638: 3A16 FORGET: DW $+2 163A: 2A313C LD HL,(VCURRENT) 163D: ED5B333C LD DE,(VCONTEXT) 1641: A7 AND A 1642: ED52 SBC HL,DE 1644: C2DA14 JP NZ,DICTERR ; different dictionaries? 1647: 1647: CD2016 CALL FINDWORD 164A: 21FBFF LD HL,-5 164D: 19 ADD HL,DE 164E: 22393C LD (DICT),HL 1651: DDCB3ED6 SET 2,(IX+FLAGS-MEMBEG) ;switch on compile mode 1655: E7 RST RSTERR 1656: FF DB ERRNONE 1657: 1657: ;================================================================ 1657: 454449D4 DB 'EDI','T' | CLAST 165B: 3716 DW FORGET-1 165D: 04 DB 4 165E: 6016 EDIT: DW $+2 1660: CD2016 CALL FINDWORD 1663: DDCB3EDE SET 3,(IX+FLAGS-MEMBEG) ; remember "EDIT" 1667: 180C JR EDITLIST 1669: 1669: ;================================================================ 1669: 4C4953D4 DB 'LIS','T' | CLAST 166D: 5D16 DW EDIT-1 166F: 04 DB 4 1670: 7216 LIST: DW $+2 1672: CD2016 CALL FINDWORD 1675: 1675: ;---------------------------------------------------------------- 1675: EDITLIST: 1675: 3E0D LD A,CCR 1677: CF RST RSTEMIT 1678: DDCB3E5E BIT 3,(IX+FLAGS-MEMBEG) 167C: D5 PUSH DE 167D: C4D802 CALL NZ,DCCLEAR ; "EDIT" ? 1680: C1 POP BC 1681: 0A LD A,(BC) 1682: 5F LD E,A 1683: 03 INC BC 1684: 0A LD A,(BC) 1685: 57 LD D,A 1686: 0B DEC BC 1687: CDFB15 CALL JUMPDE 168A: C30E DW DOCOL 168C: 0B DB ELCOLON-$ 168D: 0811 DW DOCOMPILER 168F: 0D DB ELCOMPILER-$ 1690: 8510 DW DODEFINER 1692: 1F DB ELDEFINER-$ 1693: 0000 DW 0 1695: E7 RST RSTERR 1696: 0E DB ERRLIST 1697: 1697: ;---------------------------------------------------------------- 1697: ELCOLON: 1697: 210200 LD HL,2 169A: 1818 JR ELOUT 169C: 169C: ;---------------------------------------------------------------- 169C: ELCOMPILER: 169C: D5 PUSH DE 169D: 210200 LD HL,2 16A0: 09 ADD HL,BC 16A1: 7E LD A,(HL) 16A2: 23 INC HL 16A3: 66 LD H,(HL) 16A4: 6F LD L,A ; address behind "DOCOMPILER" 16A5: 2B DEC HL 16A6: 2B DEC HL 16A7: 2B DEC HL 16A8: 6E LD L,(HL) 16A9: 7D LD A,L 16AA: 07 RLCA 16AB: 9F SBC A,A 16AC: 67 LD H,A ; code byte (???) to 16 bit 16AD: CD0E18 CALL PNTHL 16B0: D1 POP DE 16B1: 16B1: ;---------------------------------------------------------------- 16B1: ELDEFINER: 16B1: 210400 LD HL,4 16B4: 16B4: ;---------------------------------------------------------------- 16B4: ELOUT: 16B4: 09 ADD HL,BC 16B5: E5 PUSH HL 16B6: C5 PUSH BC 16B7: CDE417 CALL OUTWORD ; print ":" etc. 16BA: D1 POP DE 16BB: C1 POP BC 16BC: CDE417 CALL OUTWORD ; print name 16BF: 16BF: DD361401 LD (IX+LPIBUF-MEMBEG),1 ; indent 1 character 16C3: ELMLOOP: 16C3: DD361610 LD (IX+LPLCNT-MEMBEG),16 ; 16 rows 16C7: ELLLOOP: 16C7: CD0817 CALL LISTPGM 16CA: 3806 JR C,ELREADY ; finished listing of word? 16CC: DD3516 DEC (IX+LPLCNT-MEMBEG) 16CF: F2C716 JP P,ELLLOOP ; not yet all rows used? 16D2: 16D2: ELREADY: 16D2: DDCB3E5E BIT 3,(IX+FLAGS-MEMBEG) 16D6: 2010 JR NZ,ELEDIT ; "EDIT" ? 16D8: 16D8: 3828 JR C,ELQUIT ; finished listing of word? 16DA: 16DA: 21263C LD HL,KEYCOD 16DD: 3600 LD (HL),0 16DF: ELACK: 16DF: 7E LD A,(HL) 16E0: A7 AND A 16E1: 28FC JR Z,ELACK ; wait for confirmation 16E3: 16E3: CDE404 CALL USERBREAK 16E6: 18DB JR ELMLOOP ; resume 16E8: 16E8: ELEDIT: 16E8: F5 PUSH AF 16E9: DDCB3E9E RES 3,(IX+FLAGS-MEMBEG) ; short no "EDIT" 16ED: C5 PUSH BC 16EE: 16EE: CDB904 CALL NEXT 16F1: 78050605 DW RETYPE,LINE 16F5: 0E1A DW SEMICODE ; edit 16F7: 16F7: DDCB3EDE SET 3,(IX+FLAGS-MEMBEG) ; again "EDIT" 16FB: CDD802 CALL DCCLEAR 16FE: C1 POP BC 16FF: F1 POP AF 1700: 30C1 JR NC,ELMLOOP ; listing of word not yet completed? 1702: ELQUIT: 1702: DDCB3E9E RES 3,(IX+FLAGS-MEMBEG) ; no more "EDIT" 1706: FDE9 JP (IY) 1708: 1708: ;---------------------------------------------------------------- 1708: LISTPGM: 1708: 3A143C LD A,(LPIBUF) 170B: 32153C LD (LPIACT),A ; get indent 170E: DD361305 LD (IX+LPICNT-MEMBEG),5 ; start with 5 words 1712: LPLOOP: 1712: 0A LD A,(BC) 1713: 5F LD E,A 1714: 03 INC BC 1715: 0A LD A,(BC) 1716: 57 LD D,A 1717: 03 INC BC 1718: CDFB15 CALL JUMPDE ; get next word 171B: 8312 DW DOIF 171D: 40 DB LPIINC-$ 171E: 7112 DW DOELSE 1720: 44 DB LPILEFT-$ 1721: A412 DW DOTHEN 1723: 48 DB LPIDEC-$ 1724: 9F12 DW DOBEGIN 1726: 37 DB LPIINC-$ 1727: 8D12 DW DOUNTIL 1729: 42 DB LPIDEC-$ 172A: 8812 DW DOWHILE 172C: 38 DB LPILEFT-$ 172D: 7612 DW DOREPEAT 172F: 3C DB LPIDEC-$ 1730: 2313 DW DODO 1732: 2B DB LPIINC-$ 1733: 3213 DW DOLOOP 1735: 36 DB LPIDEC-$ 1736: 3C13 DW DOPLUSLOOP 1738: 33 DB LPIDEC-$ 1739: E810 DW DODOESGT 173B: 29 DB LPILEFT-$ 173C: 4011 DW DORUNSGT 173E: 26 DB LPILEFT-$ 173F: 1110 DW GETWORD 1741: 3B DB LPWORD-$ 1742: 6410 DW GETFLOAT 1744: 47 DB LPFLOAT-$ 1745: 4B10 DW GETBYTE 1747: 51 DB LPBYTE-$ 1748: 7913 DW DOLBRACKET 174A: 62 DB LPLBRACKET-$ 174B: 9613 DW DOPTSTR 174D: 63 DB LPPTSTR-$ 174E: B604 DW SEMIS 1750: 54 DB LPSEMIS-$ 1751: 0000 DW 0 1753: 1753: CDE117 LPOUT: CALL OUTWORDI 1756: DD3513 LPNEXT: DEC (IX+LPICNT-MEMBEG) 1759: 20B7 JR NZ,LPLOOP ; limit number of words 175B: A7 AND A ; listing of word not yet finished 175C: C9 RET 175D: 175D: 2A143C LPIINC: LD HL,(LPIBUF) 1760: 65 LD H,L 1761: 2C INC L ; increase indent 1762: 180C JR LPINDENT 1764: 1764: LPILEFT: 1764: 2A143C LD HL,(LPIBUF) 1767: 65 LD H,L 1768: 25 DEC H ; decrease indent 1769: 1805 JR LPINDENT 176B: 176B: 2A143C LPIDEC: LD HL,(LPIBUF) 176E: 2D DEC L 176F: 65 LD H,L ; decrease indent 1770: LPINDENT: 1770: 22143C LD (LPIBUF),HL 1773: 1773: DD361301 LD (IX+LPICNT-MEMBEG),1 ; last word for now 1777: 1777: DD3516 DEC (IX+LPLCNT-MEMBEG) ; row finished 177A: 18D7 JR LPOUT 177C: 177C: LPWORD: 177C: CDDA17 CALL LPNXTWRD 177F: D7 RST RSTPUSH 1780: 11B309 LD DE,PNT 1783: LPNUMBER: 1783: CDC117 CALL OUTINDENT 1786: CD1518 CALL EXECDE ; print number 1789: 18CB JR LPNEXT 178B: 178B: LPFLOAT: 178B: CDDA17 CALL LPNXTWRD 178E: D7 RST RSTPUSH 178F: CDDA17 CALL LPNXTWRD 1792: D7 RST RSTPUSH 1793: 11AF0A LD DE,FPNT 1796: 18EB JR LPNUMBER 1798: 1798: LPBYTE: 1798: 0A LD A,(BC) 1799: F5 PUSH AF 179A: CDE117 CALL OUTWORDI 179D: F1 POP AF 179E: CF RST RSTEMIT 179F: 3E20 LD A,' ' 17A1: CF RST RSTEMIT 17A2: 18B2 JR LPNEXT 17A4: 17A4: LPSEMIS: 17A4: CD0818 CALL ROMTXT 17A7: 0D3B8D DB CCR,';',CCR | CLAST 17AA: 17AA: 37 SCF ; finished listing of word 17AB: C9 RET 17AC: 17AC: LPLBRACKET: 17AC: 3E29 LD A,')' 17AE: 1802 JR LPSTRING 17B0: 17B0: LPPTSTR: 17B0: 3E22 LD A,'"' 17B2: LPSTRING: 17B2: F5 PUSH AF 17B3: C5 PUSH BC 17B4: CDE117 CALL OUTWORDI 17B7: D1 POP DE 17B8: CD7909 CALL TYPEDE ; print text string 17BB: 42 LD B,D 17BC: 4B LD C,E 17BD: F1 POP AF 17BE: CF RST RSTEMIT ; print delimiter character 17BF: 17BF: A7 AND A ; listing of word not yet finished 17C0: C9 RET 17C1: 17C1: ;---------------------------------------------------------------- 17C1: OUTINDENT: 17C1: 3A153C LD A,(LPIACT) 17C4: A7 AND A 17C5: F8 RET M ; no new line and indent? 17C6: 17C6: C5 PUSH BC 17C7: 47 LD B,A 17C8: 3E0D LD A,CCR 17CA: CF RST RSTEMIT 17CB: 04 INC B 17CC: 05 DEC B 17CD: 2805 JR Z,OIQUIT ; indent = 0 ? 17CF: OILOOP: 17CF: 3E20 LD A,' ' 17D1: CF RST RSTEMIT 17D2: 10FB DJNZ OILOOP ; print indent 17D4: 17D4: DD3615FF OIQUIT: LD (IX+LPIACT-MEMBEG),-1 ; no more indent 17D8: C1 POP BC 17D9: C9 RET 17DA: 17DA: ;---------------------------------------------------------------- 17DA: LPNXTWRD: 17DA: 0A LD A,(BC) 17DB: 5F LD E,A 17DC: 03 INC BC 17DD: 0A LD A,(BC) 17DE: 57 LD D,A 17DF: 03 INC BC ; get next word 17E0: C9 RET 17E1: 17E1: ;---------------------------------------------------------------- 17E1: OUTWORDI: 17E1: CDC117 CALL OUTINDENT 17E4: 17E4: OUTWORD: 17E4: EB EX DE,HL 17E5: 2B DEC HL 17E6: 7E LD A,(HL) 17E7: CB7F BIT 7,A 17E9: 2005 JR NZ,OWDOXX ; no simple Forth word? 17EB: CDE815 CALL PTR2NAME 17EE: 180B JR OUTTXT 17F0: 17F0: EB OWDOXX: EX DE,HL 17F1: CDA215 CALL SKOFFS2 17F4: 13 INC DE 17F5: 1A LD A,(DE) 17F6: 6F LD L,A 17F7: 13 INC DE 17F8: 1A LD A,(DE) 17F9: 67 LD H,A 17FA: 19 ADD HL,DE ; pointer to name 17FB: 17FB: 7E OUTTXT: LD A,(HL) 17FC: E67F AND 7FH ; get character 17FE: CF RST RSTEMIT 17FF: CB7E BIT 7,(HL) 1801: 23 INC HL 1802: 28F7 JR Z,OUTTXT ; not yet finished? 1804: 3E20 LD A,' ' 1806: CF RST RSTEMIT 1807: C9 RET 1808: 1808: ;---------------------------------------------------------------- 1808: E3 ROMTXT: EX (SP),HL ; get pointer 1809: CDFB17 CALL OUTTXT 180C: E3 EX (SP),HL ; set return address 180D: C9 RET 180E: 180E: ;================================================================ 180E: 11B309 PNTHL: LD DE,PNT 1811: D5 PUSH DE 1812: EB EX DE,HL 1813: D7 RST RSTPUSH 1814: D1 POP DE 1815: 1815: ;---------------------------------------------------------------- 1815: C5 EXECDE: PUSH BC 1816: CDBF04 CALL NEXTDE 1819: 1B18 DW $+2 181B: 1D18 DW $+2 181D: C1 POP BC 181E: C1 POP BC 181F: C9 RET 1820: 1820: ;================================================================ 1820: FDE5 TXALL: PUSH IY 1822: E5 PUSH HL 1823: FDE1 POP IY ; get address 1825: 219218 LD HL,TXRXQUIT 1828: E5 PUSH HL ; set return address 1829: 1829: 2100E0 LD HL,-2000H 182C: CB79 BIT 7,C 182E: 2802 JR Z,TAGOON1 ; long pilot? 1830: 26FC LD H,-0400H >> 8 1832: TAGOON1: 1832: 1832: 13 INC DE 1833: FD2B DEC IY ; adjust pointer and count 1835: F3 DI 1836: AF XOR A ; prepare 1837: TALOOP1: 1837: 0697 LD B,151 1839: TADEL1: 1839: 10FE DJNZ TADEL1 ; wait long 183B: 183B: D3FE OUT (IO),A ; toggle level 183D: EE08 XOR 8 183F: 183F: 2C INC L 1840: 2001 JR NZ,TAGOON2 1842: 24 INC H 1843: TAGOON2: 1843: 20F2 JR NZ,TALOOP1 ; emit pilot 1845: 1845: 062B LD B,43 1847: TADEL2: 1847: 10FE DJNZ TADEL2 ; wait short 1849: 1849: D3FE OUT (IO),A ; level = 0 184B: 184B: 69 LD L,C ; get start byte 184C: 184C: 01083B LD BC,8 + (59 << 8) 184F: TADEL3: 184F: 10FE DJNZ TADEL3 ; wait short 1851: 1851: 79 LD A,C 1852: D3FE OUT (IO),A ; level = 1 1854: 1854: 0638 LD B,56 1856: C38A18 JP TASTART 1859: ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 1859: TALOOP2: 1859: 79 LD A,C ; get 1 level 185A: CB78 BIT 7,B ; set Z flag 185C: TADEL4: 185C: 10FE DJNZ TADEL4 ; wait short 185E: 185E: 3004 JR NC,TABIT0 ; bit = 0 ? 1860: 1860: 063D LD B,61 1862: TADEL5: 1862: 10FE DJNZ TADEL5 ; wait short 1864: 1864: TABIT0: 1864: D3FE OUT (IO),A ; set level 1866: 063A LD B,58 1868: C25918 JP NZ,TALOOP2 ; sent first half of bit? 186B: 186B: 05 DEC B ; cycle adjustment 186C: AF XOR A ; get 0 level 186D: TANEXT: 186D: CB15 RL L 186F: C25C18 JP NZ,TADEL4 ; not yet sent all 8 bits? 1872: 1872: 1B DEC DE ; decrement counter 1873: FD23 INC IY ; increment pointer 1875: 1875: 062E LD B,46 1877: 1877: 3E7F LD A,7FH 1879: DBFE IN A,(IO) 187B: 1F RRA 187C: D0 RET NC ; user breaked? 187D: 187D: 7A LD A,D 187E: FEFF CP 0FFH 1880: D0 RET NC ; sent test value? 1881: 1881: B3 OR E 1882: 280B JR Z,TAEND ; sent all bytes? 1884: 1884: FD6E00 LD L,(IY+0) ; get next byte 1887: TACHECK: 1887: 7C LD A,H 1888: AD XOR L 1889: 67 LD H,A ; calculate test value 188A: 188A: TASTART: 188A: AF XOR A 188B: 37 SCF ; for the bit count 188C: C36D18 JP TANEXT 188F: 188F: 6C TAEND: LD L,H ; send test value 1890: 18F5 JR TACHECK 1892: 1892: ;---------------------------------------------------------------- 1892: TXRXQUIT: 1892: FDE1 POP IY 1894: 08 EX AF,AF' 1895: 063B LD B,59 1897: TRQDEL6: 1897: 10FE DJNZ TRQDEL6 ; wait short 1899: AF XOR A 189A: D3FE OUT (IO),A ; level = 0 189C: 3E7F LD A,7FH 189E: DBFE IN A,(IO) 18A0: 1F RRA 18A1: FB EI 18A2: D2F004 JP NC,BREAK ; user breaked? 18A5: 08 EX AF,AF' 18A6: C9 RET 18A7: 18A7: ;---------------------------------------------------------------- 18A7: F3 RXALL: DI 18A8: FDE5 PUSH IY 18AA: E5 PUSH HL 18AB: FDE1 POP IY ; get pointer 18AD: 219218 LD HL,TXRXQUIT 18B0: E5 PUSH HL ; set return address 18B1: 61 LD H,C ; remember start byte 18B2: 08 EX AF,AF' ; remember read/verify flag 18B3: 18B3: AF XOR A 18B4: 4F LD C,A ; 'til now 0level 18B5: 18B5: RASYNC: 18B5: C0 RET NZ ; user breaked? 18B6: RALOOP1: 18B6: 2E00 LD L,0 18B8: RALOOP2: 18B8: 06B8 LD B,-72 18BA: CD1119 CALL RXBIT 18BD: 30F6 JR NC,RASYNC ; breaked? 18BF: 3EDF LD A,-33 18C1: B8 CP B 18C2: 30F2 JR NC,RALOOP1 ; no sync bit found? 18C4: 2C INC L 18C5: 20F1 JR NZ,RALOOP2 ; not yet 256 pulses received? 18C7: 18C7: RALOOP3: 18C7: 06CF LD B,-49 18C9: CD1519 CALL RXLEVEL 18CC: 30E7 JR NC,RASYNC ; abort? 18CE: 18CE: 78 LD A,B 18CF: FED8 CP -40 18D1: 30F4 JR NC,RALOOP3 ; still sync pulses? 18D3: 18D3: CD1519 CALL RXLEVEL 18D6: D0 RET NC ; abort? 18D7: 18D7: CDFC18 CALL RXBYTE 18DA: D0 RET NC ; abort? 18DB: 18DB: 3F CCF 18DC: C0 RET NZ ; wrong first byte? 18DD: 1811 JR RASTART 18DF: 18DF: ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 18DF: 08 RALOOP: EX AF,AF' 18E0: 3005 JR NC,RAVERIFY ; verify only? 18E2: 18E2: FD7500 LD (IY+0),L ; store byte 18E5: 1805 JR RAGOON 18E7: RAVERIFY: 18E7: FD7E00 LD A,(IY+0) 18EA: AD XOR L 18EB: C0 RET NZ ; bytes differ? 18EC: 18EC: RAGOON: 18EC: FD23 INC IY ; increment pointer 18EE: 1B DEC DE ; decrement count 18EF: 08 EX AF,AF' 18F0: 18F0: RASTART: 18F0: CDFC18 CALL RXBYTE 18F3: D0 RET NC ; break? 18F4: 18F4: 7A LD A,D 18F5: B3 OR E 18F6: 20E7 JR NZ,RALOOP ; not yet all bytes received? 18F8: 18F8: 7C LD A,H 18F9: FE01 CP 1 ; raise C if test value is ok 18FB: RETURN: 18FB: C9 RET 18FC: 18FC: ;---------------------------------------------------------------- 18FC: RXBYTE: 18FC: 2E01 LD L,1 ; for the bit count 18FE: 18FE: RB8LOOP: 18FE: 06C7 LD B,-57 1900: CD1119 CALL RXBIT 1903: D0 RET NC ; abort? 1904: 3EE2 LD A,-30 1906: B8 CP B ; long duration = bit 1 1907: CB15 RL L 1909: D2FE18 JP NC,RB8LOOP ; not yet 8 bits? 190C: 190C: 7C LD A,H 190D: AD XOR L 190E: 67 LD H,A ; calculate etst value 190F: 37 SCF ; receive byte 1910: C9 RET 1911: 1911: ;---------------------------------------------------------------- 1911: CD1519 RXBIT: CALL RXLEVEL 1914: D0 RET NC ; abort? 1915: RXLEVEL: 1915: 3E14 LD A,20 1917: RBDELAY: 1917: 3D DEC A 1918: 20FD JR NZ,RBDELAY ; wait short 191A: 191A: A7 AND A ; clear C 191B: RBLOOP: 191B: 04 INC B 191C: C8 RET Z ; timeout? 191D: 191D: 3E7F LD A,7FH 191F: DBFE IN A,(IO) 1921: 1F RRA 1922: D0 RET NC ; user breaked? 1923: 1923: A9 XOR C 1924: E610 AND 020H >> 1 1926: 28F3 JR Z,RBLOOP ; level still the same? 1928: 1928: 79 LD A,C 1929: 2F CPL 192A: 4F LD C,A ; remember level 192B: 192B: 37 SCF ; all ok 192C: C9 RET 192D: 192D: ;================================================================ 192D: FFLAG EQU 0 ; 00/FF = dictionary / binary data 192D: FNLEN EQU 1 ; length of name 192D: ; 2 ; file name 192D: FLEN EQU 11 ; byte count 192D: FSTART EQU 13 ; start address 192D: FDICT EQU 15 ; dictionary 192D: FCURR EQU 17 ; VCURRENT 192D: ; 19 ; VCONTEXT 192D: ; 21 ; VOCLNK 192D: ; 23 ; STKBOT 192D: 192D: FSIZE EQU 25 ; size of this block 192D: 192D: ;================================================================ 192D: 534156C5 DB 'SAV','E' | CLAST 1931: 6F16 DW LIST-1 1933: 04 DB 4 1934: C30E SAVE: DW DOCOL 1936: 101A4F1A DW FILEFHEAD,DOSAVE 193A: B604 DW SEMIS 193C: 193C: ;================================================================ 193C: 42534156 1940: C5 DB 'BSAV','E' | CLAST 1941: 3319 DW SAVE-1 1943: 05 DB 5 1944: C30E BSAVE: DW DOCOL 1946: 3D1A4F1A DW FILEBHEAD,DOSAVE 194A: B604 DW SEMIS 194C: 194C: ;================================================================ 194C: 424C4F41 1950: C4 DB 'BLOA','D' | CLAST 1951: 4319 DW BSAVE-1 1953: 05 DB 5 1954: C30E BLOAD: DW DOCOL 1956: 3D1A741A 195A: B81A DW FILEBHEAD,READHEADER,DOBLOAD 195C: B604 DW SEMIS 195E: 195E: ;================================================================ 195E: 56455249 1962: 46D9 DB 'VERIF','Y' | CLAST 1964: 5319 DW BLOAD-1 1966: 06 DB 6 1967: C30E VERIFY: DW DOCOL 1969: 101A DW FILEFHEAD 196B: 7112 DW DOELSE 196D: 0F00 DW DOVERIFY-$-1 196F: 196F: ;================================================================ 196F: 42564552 1973: 4946D9 DB 'BVERIF','Y' | CLAST 1976: 6619 DW VERIFY-1 1978: 07 DB 7 1979: BVERIFY: 1979: C30E DW DOCOL 197B: 3D1A DW FILEBHEAD 197D: DOVERIFY: 197D: 741ABE1A DW READHEADER,DOBVERIFY 1981: B604 DW SEMIS 1983: 1983: ;================================================================ 1983: 4C4F41C4 DB 'LOA','D' | CLAST 1987: 7819 DW BVERIFY-1 1989: 04 DB 4 198A: C30E LOAD: DW DOCOL 198C: 101A DW FILEFHEAD 198E: 0E1A DW SEMICODE 1990: 2A373C LD HL,(STKBOT) 1993: 220E23 LD (FPADMEM+FSTART),HL ; start 1996: EB EX DE,HL 1997: 21CCFF LD HL,-52 199A: 39 ADD HL,SP 199B: A7 AND A 199C: ED52 SBC HL,DE 199E: 220C23 LD (FPADMEM+FLEN),HL ; size of free memory 19A1: 19A1: CDB904 CALL NEXT 19A4: 741AB81A DW READHEADER,DOBLOAD 19A8: 0E1A DW SEMICODE 19AA: 19AA: ED4B373C LD BC,(STKBOT) 19AE: 21503C LD HL,FREEMEM-1 19B1: 220127 LD (PADMEM+RDONAME),HL 19B4: 23 INC HL 19B5: 220927 LD (PADMEM+RDOEND),HL ; prepare adjustment 19B8: 19B8: 2A2523 LD HL,(FPADMEM+FSIZE+FLEN) 19BB: 09 ADD HL,BC 19BC: 22373C LD (STKBOT),HL ; allocate mamory 19BF: 19BF: 21AFC3 LD HL,-FREEMEM 19C2: 09 ADD HL,BC 19C3: 220B27 LD (PADMEM+RDDLEN),HL 19C6: ED5B2923 LD DE,(FPADMEM+FSIZE+FDICT) 19CA: 19 ADD HL,DE 19CB: ED5B4C3C LD DE,(FORTH+2+RAMVAR-ROMVAR) 19CF: 224C3C LD (FORTH+2+RAMVAR-ROMVAR),HL ; new end 19D2: 19D2: C5 PUSH BC 19D3: D5 PUSH DE 19D4: ED730D27 LD (PADMEM+RDNNAME),SP 19D8: CD0415 CALL CORRDICT ; link loaded dictionary 19DB: C1 POP BC 19DC: E1 POP HL 19DD: LDNLOOP: 19DD: CB7E BIT 7,(HL) 19DF: 23 INC HL 19E0: 28FB JR Z,LDNLOOP ; skip name 19E2: 23 INC HL 19E3: 23 INC HL 19E4: 71 LD (HL),C 19E5: 23 INC HL 19E6: 70 LD (HL),B ; store length of dictionary 19E7: 19E7: 2A373C LD HL,(STKBOT) 19EA: 010C00 LD BC,SAFETY 19ED: 09 ADD HL,BC 19EE: 223B3C LD (SPARE),HL ; setup argument stack 19F1: FDE9 JP (IY) 19F3: 19F3: ;================================================================ 19F3: FILENAME: 19F3: C30E DW DOCOL 19F5: 4B10 DW GETBYTE 19F7: 20 DB ' ' 19F8: AB05 DW WORD 19FA: 0E1A DW SEMICODE ; get name 19FC: CD2E0F CALL LINKHERE 19FF: DF RST RSTPULL 1A00: 3E20 LD A,' ' 1A02: 12 LD (DE),A ; replace name length with ' ' 1A03: 1A03: 110C27 LD DE,PADMEM+FLEN 1A06: 21FF27 LD HL,SCRMEND-1 1A09: CDFA07 CALL BLANKS ; erase buffer 1A0C: FDE9 JP (IY) 1A0E: 1A0E: ;================================================================ 1A0E: SEMICODE: 1A0E: FB18 DW RETURN 1A10: 1A10: ;================================================================ 1A10: FILEFHEAD: 1A10: C30E DW DOCOL 1A12: F319 DW FILENAME 1A14: 0E1A DW SEMICODE 1A16: AF XOR A 1A17: 320123 LD (FPADMEM+FFLAG),A 1A1A: 21513C LD HL,FREEMEM 1A1D: 220E23 LD (FPADMEM+FSTART),HL 1A20: EB EX DE,HL 1A21: 2A373C LD HL,(STKBOT) 1A24: A7 AND A 1A25: ED52 SBC HL,DE 1A27: 220C23 LD (FPADMEM+FLEN),HL 1A2A: 2A4C3C LD HL,(FORTH+2+RAMVAR-ROMVAR) 1A2D: 221023 LD (FPADMEM+FDICT),HL 1A30: 21313C LD HL,VCURRENT 1A33: 111223 LD DE,FPADMEM+FCURR 1A36: 010800 LD BC,8 1A39: EDB0 LDIR ; prepeare header 1A3B: FDE9 JP (IY) 1A3D: 1A3D: ;================================================================ 1A3D: FILEBHEAD: 1A3D: C30E DW DOCOL 1A3F: F319 DW FILENAME 1A41: 11100C23 1A45: C108 DW GETWORD,FPADMEM+FLEN,EXCLAM 1A47: 11100E23 1A4B: C108 DW GETWORD,FPADMEM+FSTART,EXCLAM 1A4D: B604 DW SEMIS 1A4F: 1A4F: ;================================================================ 1A4F: 511A DOSAVE: DW $+2 1A51: 3A0223 LD A,(FPADMEM+FNLEN) 1A54: A7 AND A 1A55: 285F JR Z,RXERROR ; no name? 1A57: 2A0C23 LD HL,(FPADMEM+FLEN) 1A5A: 7C LD A,H 1A5B: B5 OR L 1A5C: 2858 JR Z,RXERROR ; length = 0 ? 1A5E: E5 PUSH HL 1A5F: 1A5F: 111900 LD DE,25 1A62: 210123 LD HL,FPADMEM+FFLAG 1A65: 4A LD C,D 1A66: CD2018 CALL TXALL ; send header 1A69: 1A69: D1 POP DE 1A6A: 2A0E23 LD HL,(FPADMEM+FSTART) 1A6D: 0EFF LD C,-1 1A6F: CD2018 CALL TXALL ; send data 1A72: FDE9 JP (IY) 1A74: 1A74: ;---------------------------------------------------------------- 1A74: READHEADER: 1A74: 761A DW $+2 1A76: 1A76: RHLOOP: 1A76: 111900 LD DE,25 1A79: 211A23 LD HL,FPADMEM+FSIZE+FFLAG 1A7C: 4A LD C,D 1A7D: 37 SCF 1A7E: CDA718 CALL RXALL ; read header 1A81: 30F3 JR NC,RHLOOP ; not yet ok? 1A83: 1A83: 111A23 LD DE,FPADMEM+FSIZE+FFLAG 1A86: 1A LD A,(DE) 1A87: A7 AND A 1A88: 200B JR NZ,RHBINARY ; binary data? 1A8A: 1A8A: CD0818 CALL ROMTXT 1A8D: 0D446963 1A91: 74BA DB CCR,'Dict',':' | CLAST 1A93: 180A JR RHCHECK 1A95: 1A95: RHBINARY: 1A95: CD0818 CALL ROMTXT 1A98: 0D427974 1A9C: 6573BA DB CCR,'Bytes',':' | CLAST 1A9F: 1A9F: RHCHECK: 1A9F: 210123 LD HL,FPADMEM+FFLAG 1AA2: 010B0B LD BC,11 + (11 << 8) 1AA5: 1802 JR RHCSTART 1AA7: 1AA7: RHCLOOP: 1AA7: 1A LD A,(DE) 1AA8: CF RST RSTEMIT ; print name 1AA9: RHCSTART: 1AA9: 1A LD A,(DE) 1AAA: BE CP (HL) 1AAB: 2001 JR NZ,RHCNEXT ; characters not the same? 1AAD: 0D DEC C 1AAE: RHCNEXT: 1AAE: 23 INC HL 1AAF: 13 INC DE 1AB0: 10F5 DJNZ RHCLOOP ; not yet all characters? 1AB2: 1AB2: 20C2 JR NZ,RHLOOP ; names not the same? 1AB4: FDE9 JP (IY) 1AB6: 1AB6: ;---------------------------------------------------------------- 1AB6: RXERROR: 1AB6: E7 RST RSTERR 1AB7: 0A DB ERRREAD 1AB8: 1AB8: ;---------------------------------------------------------------- 1AB8: DOBLOAD: 1AB8: BA1A DW $+2 1ABA: 06FF LD B,-1 ; read 1ABC: 1812 JR DOBREAD 1ABE: 1ABE: ;---------------------------------------------------------------- 1ABE: DOBVERIFY: 1ABE: C01A DW $+2 1AC0: 211223 LD HL,FPADMEM+FCURR 1AC3: 112B23 LD DE,FPADMEM+FSIZE+FCURR 1AC6: 0608 LD B,8 1AC8: DBVLOOP: 1AC8: 1A LD A,(DE) 1AC9: 13 INC DE 1ACA: BE CP (HL) 1ACB: 23 INC HL 1ACC: 20E8 JR NZ,RXERROR 1ACE: 10F8 DJNZ DBVLOOP ; compare variables 1AD0: 1AD0: DOBREAD: 1AD0: 2A0C23 LD HL,(FPADMEM+FLEN) 1AD3: ED5B2523 LD DE,(FPADMEM+FSIZE+FLEN) 1AD7: 7C LD A,H 1AD8: B5 OR L 1AD9: 2804 JR Z,DBRGOON1 ; do not test length? 1ADB: ED52 SBC HL,DE 1ADD: 38D7 JR C,RXERROR 1ADF: 1ADF: DBRGOON1: 1ADF: 2A0E23 LD HL,(FPADMEM+FSTART) 1AE2: 7C LD A,H 1AE3: B5 OR L 1AE4: 2003 JR NZ,DBRGOON2 ; use start address? 1AE6: 2A2723 LD HL,(FPADMEM+FSIZE+FSTART) 1AE9: 1AE9: DBRGOON2: 1AE9: 0EFF LD C,-1 1AEB: CB18 RR B ; get read/verify flag 1AED: CDA718 CALL RXALL ; read data 1AF0: 30C4 JR NC,RXERROR ; break? 1AF2: FDE9 JP (IY) 1AF4: 1AF4: ;================================================================ 1AF4: FEXP1 EQU 0 ; exponent upper number / result 1AF4: FEXP2 EQU 1 ; exponent lower number 1AF4: FSGN EQU 2 ; number sign 7=lower 6=upper number 1AF4: FACCU EQU 3 ; akkumulator 1AF4: FQUO EQU 7 ; quotient 1AF4: FDIVOR EQU 16 ; divisor 1AF4: ;================================================================ 1AF4: 010F3C FINIT: LD BC,FPWS+FDIVOR-1 1AF7: AF XOR A 1AF8: FICLEAR: 1AF8: 02 LD (BC),A 1AF9: 0D DEC C ;(slightly dirty!!!) 1AFA: 20FC JR NZ,FICLEAR ;clear buffer 1AFC: 1AFC: 2A3B3C LD HL,(SPARE) 1AFF: 11FCFF LD DE,-4 1B02: 2B DEC HL 1B03: 4E LD C,(HL) ; remember exponent of upper number 1B04: 77 LD (HL),A ; and clear 1B05: 19 ADD HL,DE 1B06: 23 INC HL 1B07: 223B3C LD (SPARE),HL ; clear "TOS" 1B0A: 2B DEC HL 1B0B: 46 LD B,(HL) ; remember exponent of lower number 1B0C: 77 LD (HL),A ; and clear 1B0D: 79 LD A,C 1B0E: 0F RRCA 1B0F: A8 XOR B 1B10: E67F AND FSIGN^0FFH ; note: original: AND NOT FSIGN 1B12: A8 XOR B 1B13: 32023C LD (FPWS+FSGN),A ; remember number sign 1B16: CBB8 RES 7,B 1B18: CBB9 RES 7,C 1B1A: ED43003C LD (FPWS+FEXP1),BC ; store exponent 1B1E: 23 INC HL 1B1F: EB EX DE,HL ; pointer to upper number 1B20: 19 ADD HL,DE ; pointer to lower number 1B21: C9 RET 1B22: 1B22: ;---------------------------------------------------------------- 1B22: FADJUST: 1B22: 3E09 LD A,9 1B24: B8 CP B 1B25: 3001 JR NC,FADJLP1 ; limit difference of exponents 1B27: 47 LD B,A 1B28: 1B28: FADJLP1: 1B28: 0E04 LD C,4 1B2A: 23 INC HL 1B2B: 23 INC HL 1B2C: 23 INC HL 1B2D: AF XOR A 1B2E: FADJLP2: 1B2E: ED67 RRD 1B30: 2B DEC HL 1B31: 0D DEC C 1B32: 20FA JR NZ,FADJLP2 ; divide smaller number 1B34: 23 INC HL 1B35: 10F1 DJNZ FADJLP1 ; until difference equals 1B37: 1B37: C6FB ADD A,-5 ; was last digit >= 5 ? 1B39: E5 PUSH HL 1B3A: FADJLP3: 1B3A: 7E LD A,(HL) 1B3B: 88 ADC A,B 1B3C: 27 DAA 1B3D: 77 LD (HL),A 1B3E: 23 INC HL 1B3F: 38F9 JR C,FADJLP3 ; round 1B41: E1 POP HL 1B42: C9 RET 1B43: 1B43: ;---------------------------------------------------------------- 1B43: FNEG: 1B43: C5 PUSH BC 1B44: E5 PUSH HL 1B45: 0604 LD B,4 1B47: A7 AND A 1B48: FNLOOP: 1B48: 3E00 LD A,0 1B4A: 9E SBC A,(HL) 1B4B: 27 DAA 1B4C: 77 LD (HL),A 1B4D: 23 INC HL 1B4E: 10F8 DJNZ FNLOOP ; negate all digits 1B50: E1 POP HL 1B51: C1 POP BC 1B52: C9 RET 1B53: 1B53: ;---------------------------------------------------------------- 1B53: FADDITION: 1B53: 0E01 LD C,1 ; multiplicator 1 1B55: 1B55: FMULADD: 1B55: E5 PUSH HL 1B56: D5 PUSH DE 1B57: C5 PUSH BC 1B58: 79 LD A,C 1B59: E60F AND 0FH 1B5B: 47 LD B,A 1B5C: A9 XOR C 1B5D: 4F LD C,A 1B5E: 0F RRCA 1B5F: 0F RRCA 1B60: 81 ADD A,C 1B61: 0F RRCA 1B62: 80 ADD A,B 1B63: 4F LD C,A ; convert BCD to binary 1B64: 0604 LD B,4 1B66: AF XOR A 1B67: FMLOOP1: 1B67: C5 PUSH BC 1B68: D5 PUSH DE 1B69: E5 PUSH HL 1B6A: 86 ADD A,(HL) 1B6B: 27 DAA 1B6C: 6F LD L,A 1B6D: 1A LD A,(DE) 1B6E: 2600 LD H,0 1B70: 54 LD D,H 1B71: CB14 RL H ; overflow from addition 1B73: A7 AND A 1B74: 281B JR Z,FMNEXT ; digit = 0 ? 1B76: 5F LD E,A 1B77: FMLOOP2: 1B77: CB39 SRL C 1B79: 3008 JR NC,FMNOADD ; multiplicator bit = 0 ? 1B7B: 7D LD A,L 1B7C: 83 ADD A,E 1B7D: 27 DAA 1B7E: 6F LD L,A 1B7F: 7C LD A,H 1B80: 8A ADC A,D 1B81: 27 DAA 1B82: 67 LD H,A ; add 1B83: FMNOADD: 1B83: 0C INC C 1B84: 0D DEC C 1B85: 280A JR Z,FMNEXT ; multiplicator = 0 ? 1B87: 7B LD A,E 1B88: 87 ADD A,A 1B89: 27 DAA 1B8A: 5F LD E,A 1B8B: 7A LD A,D 1B8C: 8F ADC A,A 1B8D: 27 DAA 1B8E: 57 LD D,A ; shift result 1B8F: 18E6 JR FMLOOP2 ; again 1B91: 1B91: FMNEXT: 1B91: EB EX DE,HL 1B92: E1 POP HL 1B93: 73 LD (HL),E 1B94: 7A LD A,D 1B95: D1 POP DE 1B96: C1 POP BC 1B97: 13 INC DE 1B98: 23 INC HL 1B99: 10CC DJNZ FMLOOP1 ; not yet all bytes? 1B9B: 1B9B: C1 POP BC 1B9C: D1 POP DE 1B9D: E1 POP HL 1B9E: C9 RET 1B9F: 1B9F: ;================================================================ 1B9F: 46AD DB 'F','-' | CLAST 1BA1: 8919 DW LOAD-1 1BA3: 02 DB 2 1BA4: C30E FMINUS: DW DOCOL 1BA6: 0F1D DW FNEGATE 1BA8: 0E1A DW SEMICODE 1BAA: 1807 JR FADDSUB 1BAC: 1BAC: ;================================================================ 1BAC: 46AB DB 'F','+' | CLAST 1BAE: A31B DW FMINUS-1 1BB0: 02 DB 2 1BB1: B31B FPLUS: DW FADDSUB 1BB3: 1BB3: FADDSUB: 1BB3: CDF41A CALL FINIT ; prepare 1BB6: 1BB6: 79 LD A,C 1BB7: 90 SUB B 1BB8: F5 PUSH AF 1BB9: 3006 JR NC,FASGOON1 ; lower exponent <= upper exponent? 1BBB: EB EX DE,HL 1BBC: ED44 NEG 1BBE: DD7000 LD (IX+FPWS+FEXP1-MEMBEG),B ; swap numbers 1BC1: FASGOON1: 1BC1: 47 LD B,A 1BC2: C4221B CALL NZ,FADJUST ; adjust other number if required 1BC5: F1 POP AF 1BC6: 3001 JR NC,FASGOON2 ; lower exponent <= upper exponent? 1BC8: EB EX DE,HL 1BC9: FASGOON2: 1BC9: 1BC9: 0602 LD B,2 1BCB: DD4E02 LD C,(IX+FPWS+FSGN-MEMBEG) 1BCE: FASLP1: 1BCE: CB11 RL C 1BD0: DC431B CALL C,FNEG 1BD3: EB EX DE,HL 1BD4: 10F8 DJNZ FASLP1 ; negate numbers if required 1BD6: 1BD6: CD531B CALL FADDITION 1BD9: 1B DEC DE 1BDA: 1A LD A,(DE) 1BDB: C668 ADD A,0100H-98H ; note kio 2008-06-12: original: ADD A,-98H 1BDD: CB18 RR B 1BDF: DD7002 LD (IX+FPWS+FSGN-MEMBEG),B ; remember new sign 1BE2: C4431B CALL NZ,FNEG ; negate if required 1BE5: 1BE5: FASLP2: 1BE5: 1A LD A,(DE) 1BE6: A7 AND A 1BE7: 2019 JR NZ,FASGOON3 ;most significant digits != 0 ? 1BE9: DD3500 DEC (IX+FPWS+FEXP1-MEMBEG) 1BEC: DD3500 DEC (IX+FPWS+FEXP1-MEMBEG) ; adjust exponent 1BEF: D5 PUSH DE 1BF0: 62 LD H,D 1BF1: 6B LD L,E 1BF2: 2B DEC HL 1BF3: 01FF03 LD BC,255+(3 << 8) ; load C for "LDD" 1BF6: FASLP3: 1BF6: B6 OR (HL) 1BF7: EDA8 LDD 1BF9: 10FB DJNZ FASLP3 ; shift digits 1BFB: EB EX DE,HL 1BFC: 70 LD (HL),B 1BFD: D1 POP DE 1BFE: 20E5 JR NZ,FASLP2 ; number != 0 ? 1C00: FDE9 JP (IY) 1C02: 1C02: FASGOON3: 1C02: 54 LD D,H 1C03: 5D LD E,L ; do not yet shift number 1C04: 1C04: ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 1C04: D5 FCORR: PUSH DE 1C05: 010400 LD BC,4 1C08: EDB0 LDIR ; shift number 1C0A: E1 POP HL 1C0B: 1B DEC DE 1C0C: FCLP: 1C0C: 1A LD A,(DE) 1C0D: A7 AND A 1C0E: 2811 JR Z,FCQUIT ; digits = 0? 1C10: 1C10: FE10 CP 10H 1C12: 9F SBC A,A 1C13: 3C INC A 1C14: 3C INC A 1C15: 47 LD B,A 1C16: DD8600 ADD A,(IX+FPWS+FEXP1-MEMBEG) 1C19: 32003C LD (FPWS+FEXP1),A ; adjust exponent 1C1C: 1C1C: CD221B CALL FADJUST 1C1F: 18EB JR FCLP 1C21: 1C21: FCQUIT: 1C21: 3A003C LD A,(FPWS+FEXP1) 1C24: 3D DEC A 1C25: FEBF CP -FEOFFS-1 1C27: 3C INC A 1C28: 3013 JR NC,FLT0 ; number too small? 1C2A: FE80 CP +FEOFFS+64 1C2C: 300D JR NC,FLTERR ; number to big? 1C2E: 47 LD B,A 1C2F: 3A023C LD A,(FPWS+FSGN) 1C32: 4F LD C,A 1C33: 17 RLA 1C34: A9 XOR C 1C35: E680 AND FSIGN 1C37: A8 XOR B 1C38: 12 LD (DE),A ; number sign and exponent 1C39: FDE9 JP (IY) 1C3B: 1C3B: FLTERR: 1C3B: E7 RST RSTERR 1C3C: 08 DB ERRFLT 1C3D: 1C3D: FLT0: 1C3D: 010004 LD BC,0+(4 << 8) 1C40: FLT0LP: 1C40: 71 LD (HL),C 1C41: 23 INC HL 1C42: 10FC DJNZ FLT0LP ; set result to 0 1C44: FDE9 JP (IY) 1C46: 1C46: ;================================================================ 1C46: 46AA DB 'F','*' | CLAST 1C48: B01B DW FPLUS-1 1C4A: 02 DB 2 1C4B: FMUL: 1C4B: 4D1C DW $+2 1C4D: 1C4D: CDF41A CALL FINIT ; prepare 1C50: 1C50: AF XOR A 1C51: B8 CP B 1C52: 9F SBC A,A 1C53: A1 AND C 1C54: 28E7 JR Z,FLT0 ; one of both numbers = 0? 1C56: 1C56: E5 PUSH HL 1C57: 01023C LD BC,FPWS+FACCU-1 1C5A: C5 PUSH BC 1C5B: 0603 LD B,3 1C5D: FMLOOP: 1C5D: 4E LD C,(HL) 1C5E: 23 INC HL 1C5F: E3 EX (SP),HL 1C60: 23 INC HL 1C61: CD551B CALL FMULADD 1C64: E3 EX (SP),HL 1C65: 10F6 DJNZ FMLOOP ; multiply all double digits 1C67: 1C67: ED4B003C LD BC,(FPWS+FEXP1) 1C6B: 78 LD A,B 1C6C: 81 ADD A,C 1C6D: D642 SUB FEOFFS+2 1C6F: 32003C LD (FPWS+FEXP1),A ; calculate exponent 1C72: E1 POP HL 1C73: D1 POP DE 1C74: 188E JR FCORR 1C76: 1C76: ;================================================================ 1C76: 46AF DB 'F','/' | CLAST 1C78: 4A1C DW FMUL-1 1C7A: 02 DB 2 1C7B: 7D1C FDIV: DW $+2 1C7D: CDF41A CALL FINIT ; prepare 1C80: 1C80: AF XOR A 1C81: B8 CP B 1C82: 28B9 JR Z,FLT0 ; dividend = 0 ? 1C84: 1C84: B9 CP C 1C85: 28B4 JR Z,FLTERR ; divisor = 0 ? 1C87: 1C87: 13 INC DE 1C88: 13 INC DE 1C89: 1A LD A,(DE) 1C8A: 1B DEC DE 1C8B: 1B DEC DE 1C8C: C601 ADD A,1 1C8E: 27 DAA 1C8F: 08 EX AF,AF' ; test for 0.99????E?? 1C90: 1C90: EB EX DE,HL 1C91: CD431B CALL FNEG ; negate upper number for subtraction 1C94: EB EX DE,HL 1C95: 1C95: E5 PUSH HL 1C96: 11103C LD DE,FPWS+FDIVOR 1C99: 010400 LD BC,4 1C9C: EDB0 LDIR ; save lower number 1C9E: EB EX DE,HL 1C9F: 2B DEC HL 1CA0: 0605 LD B,5 ; count divisor digits 1CA2: FDLOOP1: 1CA2: D5 PUSH DE 1CA3: 7E LD A,(HL) 1CA4: 2B DEC HL 1CA5: 5E LD E,(HL) 1CA6: 08 EX AF,AF' 1CA7: 4F LD C,A 1CA8: 08 EX AF,AF' 1CA9: 0C INC C 1CAA: 0D DEC C 1CAB: 2003 JR NZ,FDGOON1 ; was number < 0.990000EXX ? 1CAD: 5F LD E,A 1CAE: 181B JR FDGOON2 1CB0: 1CB0: FDGOON1: 1CB0: C5 PUSH BC 1CB1: 0602 LD B,2 ; 2 digits per byte 1CB3: FDLOOP2: 1CB3: 1610 LD D,10H 1CB5: FDLOOP3: 1CB5: CB23 SLA E 1CB7: 17 RLA 1CB8: CB12 RL D 1CBA: 30F9 JR NC,FDLOOP3 ; shift D-A-E by 1 digit 1CBC: 14 INC D 1CBD: FDLOOP4: 1CBD: 91 SUB C 1CBE: 27 DAA 1CBF: 1C INC E 1CC0: 30FB JR NC,FDLOOP4 1CC2: 15 DEC D 1CC3: 20F8 JR NZ,FDLOOP4 ; partial division by subtraction 1CC5: 81 ADD A,C 1CC6: 27 DAA 1CC7: 1D DEC E 1CC8: 10E9 DJNZ FDLOOP2 ; calculate single quotient 1CCA: 1CCA: C1 POP BC 1CCB: FDGOON2: 1CCB: 4B LD C,E 1CCC: D1 POP DE 1CCD: 0C INC C 1CCE: 0D DEC C 1CCF: 2817 JR Z,FDNEXT ; single quotient = 0? 1CD1: 1CD1: E5 PUSH HL 1CD2: 2B DEC HL 1CD3: 2B DEC HL 1CD4: CD551B CALL FMULADD ; subtract 1CD7: D5 PUSH DE 1CD8: 11FBFF LD DE,FQUO-FDIVOR+4 1CDB: 19 ADD HL,DE ; align pointers 1CDC: 11033C LD DE,FPWS+FACCU 1CDF: 79 LD A,C 1CE0: 12 LD (DE),A 1CE1: CD531B CALL FADDITION ; akkumulate quotient 1CE4: D1 POP DE 1CE5: E1 POP HL 1CE6: 23 INC HL 1CE7: 04 INC B 1CE8: FDNEXT: 1CE8: 10B8 DJNZ FDLOOP1 ; and another go... 1CEA: 1CEA: 2A003C LD HL,(FPWS+FEXP1) 1CED: 7C LD A,H 1CEE: 95 SUB L 1CEF: C640 ADD A,FEOFFS 1CF1: 21083C LD HL,FPWS+FQUO+1 1CF4: 47 LD B,A 1CF5: 3A0B3C LD A,(FPWS+FQUO+4) 1CF8: A7 AND A 1CF9: 2003 JR NZ,FDGOON3 1CFB: 05 DEC B 1CFC: 05 DEC B 1CFD: 2B DEC HL ; adjust exponent 1CFE: FDGOON3: 1CFE: DD7000 LD (IX+FPWS+FEXP1-MEMBEG),B ; new exponent 1D01: D1 POP DE 1D02: C3041C JP FCORR ; adjust result 1D05: 1D05: ;================================================================ 1D05: 464E4547 1D09: 4154C5 DB 'FNEGAT','E' | CLAST 1D0C: 7A1C DW FDIV-1 1D0E: 07 DB 7 1D0F: FNEGATE: 1D0F: 111D DW $+2 1D11: DF RST RSTPULL 1D12: 7A LD A,D 1D13: A7 AND A 1D14: 2802 JR Z,FNQUIT 1D16: EE80 XOR 80H ; negate numbers != 0 1D18: FNQUIT: 1D18: 57 LD D,A 1D19: D7 RST RSTPUSH 1D1A: FDE9 JP (IY) 1D1C: 1D1C: ;================================================================ 1D1C: 494ED4 DB 'IN','T' | CLAST 1D1F: 0E1D DW FNEGATE-1 1D21: 03 DB 3 1D22: 241D INT: DW $+2 1D24: 2A3B3C LD HL,(SPARE) 1D27: 2B DEC HL 1D28: 110000 LD DE,0 ; erase value 1D2B: INTLOOP: 1D2B: 7E LD A,(HL) ; get exponent 1D2C: 07 RLCA 1D2D: FE82 CP 0+(FEOFFS+1) << 1 1D2F: 3814 JR C,INTQUIT ; ABS(number) < 1.0 ? 1D31: 1D31: AF XOR A 1D32: 2B DEC HL 1D33: CD3207 CALL DECSTORE ; shift left 1 digit 1D36: 23 INC HL 1D37: EB EX DE,HL 1D38: 44 LD B,H 1D39: 4D LD C,L 1D3A: 29 ADD HL,HL 1D3B: 29 ADD HL,HL 1D3C: 09 ADD HL,BC 1D3D: 29 ADD HL,HL ; value * 10 1D3E: 4F LD C,A 1D3F: 0600 LD B,0 1D41: 09 ADD HL,BC ; add overflow digit 1D42: EB EX DE,HL 1D43: 18E6 JR INTLOOP 1D45: 1D45: INTQUIT: 1D45: 2B DEC HL 1D46: 2B DEC HL 1D47: 72 LD (HL),D 1D48: 2B DEC HL 1D49: 73 LD (HL),E 1D4A: 11940D LD DE,IFN0NEG 1D4D: C3BF04 JP NEXTDE ; adjust number sign 1D50: 1D50: ;================================================================ 1D50: 55464C4F 1D54: 41D4 DB 'UFLOA','T' | CLAST 1D56: 211D DW INT-1 1D58: 06 DB 6 1D59: 5B1D UFLOAT: DW $+2 1D5B: DF RST RSTPULL 1D5C: EB EX DE,HL 1D5D: 010010 LD BC,0 | (16 << 8) 1D60: 51 LD D,C 1D61: 59 LD E,C 1D62: 29 UFLOOP: ADD HL,HL 1D63: 7B LD A,E 1D64: 8F ADC A,A 1D65: 27 DAA 1D66: 5F LD E,A 1D67: 7A LD A,D 1D68: 8F ADC A,A 1D69: 27 DAA 1D6A: 57 LD D,A 1D6B: CB11 RL C 1D6D: 10F3 DJNZ UFLOOP ; convert to BCD 1D6F: 1D6F: D7 RST RSTPUSH 1D70: 1646 LD D,FEOFFS+6 1D72: 59 LD E,C 1D73: D7 RST RSTPUSH ; store number 1D74: 2B DEC HL 1D75: 2B DEC HL 1D76: CD4007 CALL FZEROEQ ; adjust exponent if 0 1D79: FDE9 JP (IY) 1D7B: 1D7B: ;================================================================ 1D7B: ; Character Set 1D7B: 1D7B: 00000000 DB 000H,000H,000H,000H 1D7F: 000000 DB 000H,000H,000H ;........ 1D82: ;........ 1D82: ;........ 1D82: ;........ 1D82: ;........ 1D82: ;........ 1D82: ;........ 1D82: 10101010 DB 010H,010H,010H,010H 1D86: 001000 DB 000H,010H,000H ;...*.... 1D89: ;...*.... 1D89: ;...*.... 1D89: ;...*.... 1D89: ;........ 1D89: ;...*.... 1D89: ;........ 1D89: 24240000 DB 024H,024H,000H,000H 1D8D: 000000 DB 000H,000H,000H ;..*..*.. 1D90: ;..*..*.. 1D90: ;........ 1D90: ;........ 1D90: ;........ 1D90: ;........ 1D90: ;........ 1D90: 247E2424 DB 024H,07EH,024H,024H 1D94: 7E2400 DB 07EH,024H,000H ;..*..*.. 1D97: ;.******. 1D97: ;..*..*.. 1D97: ;..*..*.. 1D97: ;.******. 1D97: ;..*..*.. 1D97: ;........ 1D97: 083E283E DB 008H,03EH,028H,03EH 1D9B: 0A3E08 DB 00AH,03EH,008H ;....*... 1D9E: ;..*****. 1D9E: ;..*.*... 1D9E: ;..*****. 1D9E: ;....*.*. 1D9E: ;..*****. 1D9E: ;....*... 1D9E: 62640810 DB 062H,064H,008H,010H 1DA2: 264600 DB 026H,046H,000H ;.**...*. 1DA5: ;.**..*.. 1DA5: ;....*... 1DA5: ;...*.... 1DA5: ;..*..**. 1DA5: ;.*...**. 1DA5: ;........ 1DA5: 1028102A DB 010H,028H,010H,02AH 1DA9: 443A00 DB 044H,03AH,000H ;...*.... 1DAC: ;..*.*... 1DAC: ;...*.... 1DAC: ;..*.*.*. 1DAC: ;.*...*.. 1DAC: ;..***.*. 1DAC: ;........ 1DAC: 08100000 DB 008H,010H,000H,000H 1DB0: 000000 DB 000H,000H,000H ;....*... 1DB3: ;...*.... 1DB3: ;........ 1DB3: ;........ 1DB3: ;........ 1DB3: ;........ 1DB3: ;........ 1DB3: 04080808 DB 004H,008H,008H,008H 1DB7: 080400 DB 008H,004H,000H ;.....*.. 1DBA: ;....*... 1DBA: ;....*... 1DBA: ;....*... 1DBA: ;....*... 1DBA: ;.....*.. 1DBA: ;........ 1DBA: 20101010 DB 020H,010H,010H,010H 1DBE: 102000 DB 010H,020H,000H ;..*..... 1DC1: ;...*.... 1DC1: ;...*.... 1DC1: ;...*.... 1DC1: ;...*.... 1DC1: ;..*..... 1DC1: ;........ 1DC1: 0014083E DB 000H,014H,008H,03EH 1DC5: 081400 DB 008H,014H,000H ;........ 1DC8: ;...*.*.. 1DC8: ;....*... 1DC8: ;..*****. 1DC8: ;....*... 1DC8: ;...*.*.. 1DC8: ;........ 1DC8: 0008083E DB 000H,008H,008H,03EH 1DCC: 080800 DB 008H,008H,000H ;........ 1DCF: ;....*... 1DCF: ;....*... 1DCF: ;..*****. 1DCF: ;....*... 1DCF: ;....*... 1DCF: ;........ 1DCF: 00000000 DB 000H,000H,000H,000H 1DD3: 080810 DB 008H,008H,010H ;........ 1DD6: ;........ 1DD6: ;........ 1DD6: ;........ 1DD6: ;....*... 1DD6: ;....*... 1DD6: ;...*.... 1DD6: 0000003E DB 000H,000H,000H,03EH 1DDA: 000000 DB 000H,000H,000H ;........ 1DDD: ;........ 1DDD: ;........ 1DDD: ;..*****. 1DDD: ;........ 1DDD: ;........ 1DDD: ;........ 1DDD: 00000000 DB 000H,000H,000H,000H 1DE1: 181800 DB 018H,018H,000H ;........ 1DE4: ;........ 1DE4: ;........ 1DE4: ;........ 1DE4: ;...**... 1DE4: ;...**... 1DE4: ;........ 1DE4: 00020408 DB 000H,002H,004H,008H 1DE8: 102000 DB 010H,020H,000H ;........ 1DEB: ;......*. 1DEB: ;.....*.. 1DEB: ;....*... 1DEB: ;...*.... 1DEB: ;..*..... 1DEB: ;........ 1DEB: 3C464A52 DB 03CH,046H,04AH,052H 1DEF: 623C00 DB 062H,03CH,000H ;..****.. 1DF2: ;.*...**. 1DF2: ;.*..*.*. 1DF2: ;.*.*..*. 1DF2: ;.**...*. 1DF2: ;..****.. 1DF2: ;........ 1DF2: 18280808 DB 018H,028H,008H,008H 1DF6: 083E00 DB 008H,03EH,000H ;...**... 1DF9: ;..*.*... 1DF9: ;....*... 1DF9: ;....*... 1DF9: ;....*... 1DF9: ;..*****. 1DF9: ;........ 1DF9: 3C42023C DB 03CH,042H,002H,03CH 1DFD: 407E00 DB 040H,07EH,000H ;..****.. 1E00: ;.*....*. 1E00: ;......*. 1E00: ;..****.. 1E00: ;.*...... 1E00: ;.******. 1E00: ;........ 1E00: 3C420C02 DB 03CH,042H,00CH,002H 1E04: 423C00 DB 042H,03CH,000H ;..****.. 1E07: ;.*....*. 1E07: ;....**.. 1E07: ;......*. 1E07: ;.*....*. 1E07: ;..****.. 1E07: ;........ 1E07: 08182848 DB 008H,018H,028H,048H 1E0B: 7E0800 DB 07EH,008H,000H ;....*... 1E0E: ;...**... 1E0E: ;..*.*... 1E0E: ;.*..*... 1E0E: ;.******. 1E0E: ;....*... 1E0E: ;........ 1E0E: 7E407C02 DB 07EH,040H,07CH,002H 1E12: 423C00 DB 042H,03CH,000H ;.******. 1E15: ;.*...... 1E15: ;.*****.. 1E15: ;......*. 1E15: ;.*....*. 1E15: ;..****.. 1E15: ;........ 1E15: 3C407C42 DB 03CH,040H,07CH,042H 1E19: 423C00 DB 042H,03CH,000H ;..****.. 1E1C: ;.*...... 1E1C: ;.*****.. 1E1C: ;.*....*. 1E1C: ;.*....*. 1E1C: ;..****.. 1E1C: ;........ 1E1C: 7E020408 DB 07EH,002H,004H,008H 1E20: 101000 DB 010H,010H,000H ;.******. 1E23: ;......*. 1E23: ;.....*.. 1E23: ;....*... 1E23: ;...*.... 1E23: ;...*.... 1E23: ;........ 1E23: 3C423C42 DB 03CH,042H,03CH,042H 1E27: 423C00 DB 042H,03CH,000H ;..****.. 1E2A: ;.*....*. 1E2A: ;..****.. 1E2A: ;.*....*. 1E2A: ;.*....*. 1E2A: ;..****.. 1E2A: ;........ 1E2A: 3C42423E DB 03CH,042H,042H,03EH 1E2E: 023C00 DB 002H,03CH,000H ;..****.. 1E31: ;.*....*. 1E31: ;.*....*. 1E31: ;..*****. 1E31: ;......*. 1E31: ;..****.. 1E31: ;........ 1E31: 00001000 DB 000H,000H,010H,000H 1E35: 001000 DB 000H,010H,000H ;........ 1E38: ;........ 1E38: ;...*.... 1E38: ;........ 1E38: ;........ 1E38: ;...*.... 1E38: ;........ 1E38: 00100000 DB 000H,010H,000H,000H 1E3C: 101020 DB 010H,010H,020H ;........ 1E3F: ;...*.... 1E3F: ;........ 1E3F: ;........ 1E3F: ;...*.... 1E3F: ;...*.... 1E3F: ;..*..... 1E3F: 00040810 DB 000H,004H,008H,010H 1E43: 080400 DB 008H,004H,000H ;........ 1E46: ;.....*.. 1E46: ;....*... 1E46: ;...*.... 1E46: ;....*... 1E46: ;.....*.. 1E46: ;........ 1E46: 00003E00 DB 000H,000H,03EH,000H 1E4A: 3E0000 DB 03EH,000H,000H ;........ 1E4D: ;........ 1E4D: ;..*****. 1E4D: ;........ 1E4D: ;..*****. 1E4D: ;........ 1E4D: ;........ 1E4D: 00100804 DB 000H,010H,008H,004H 1E51: 081000 DB 008H,010H,000H ;........ 1E54: ;...*.... 1E54: ;....*... 1E54: ;.....*.. 1E54: ;....*... 1E54: ;...*.... 1E54: ;........ 1E54: 3C420408 DB 03CH,042H,004H,008H 1E58: 0008 DB 000H,008H ;..****.. 1E5A: ;.*....*. 1E5A: ;.....*.. 1E5A: ;....*... 1E5A: ;........ 1E5A: ;....*... 1E5A: 3C4A565E DB 03CH,04AH,056H,05EH 1E5E: 403C DB 040H,03CH ;..****.. 1E60: ;.*..*.*. 1E60: ;.*.*.**. 1E60: ;.*.****. 1E60: ;.*...... 1E60: ;..****.. 1E60: 3C42427E DB 03CH,042H,042H,07EH 1E64: 4242 DB 042H,042H ;..****.. 1E66: ;.*....*. 1E66: ;.*....*. 1E66: ;.******. 1E66: ;.*....*. 1E66: ;.*....*. 1E66: 7C427C42 DB 07CH,042H,07CH,042H 1E6A: 427C DB 042H,07CH ;.*****.. 1E6C: ;.*....*. 1E6C: ;.*****.. 1E6C: ;.*....*. 1E6C: ;.*....*. 1E6C: ;.*****.. 1E6C: 3C424040 DB 03CH,042H,040H,040H 1E70: 423C DB 042H,03CH ;..****.. 1E72: ;.*....*. 1E72: ;.*...... 1E72: ;.*...... 1E72: ;.*....*. 1E72: ;..****.. 1E72: 78444242 DB 078H,044H,042H,042H 1E76: 4478 DB 044H,078H ;.****... 1E78: ;.*...*.. 1E78: ;.*....*. 1E78: ;.*....*. 1E78: ;.*...*.. 1E78: ;.****... 1E78: 7E407C40 DB 07EH,040H,07CH,040H 1E7C: 407E DB 040H,07EH ;.******. 1E7E: ;.*...... 1E7E: ;.*****.. 1E7E: ;.*...... 1E7E: ;.*...... 1E7E: ;.******. 1E7E: 7E407C40 DB 07EH,040H,07CH,040H 1E82: 4040 DB 040H,040H ;.******. 1E84: ;.*...... 1E84: ;.*****.. 1E84: ;.*...... 1E84: ;.*...... 1E84: ;.*...... 1E84: 3C42404E DB 03CH,042H,040H,04EH 1E88: 423C DB 042H,03CH ;..****.. 1E8A: ;.*....*. 1E8A: ;.*...... 1E8A: ;.*..***. 1E8A: ;.*....*. 1E8A: ;..****.. 1E8A: 42427E42 DB 042H,042H,07EH,042H 1E8E: 4242 DB 042H,042H ;.*....*. 1E90: ;.*....*. 1E90: ;.******. 1E90: ;.*....*. 1E90: ;.*....*. 1E90: ;.*....*. 1E90: 3E080808 DB 03EH,008H,008H,008H 1E94: 083E DB 008H,03EH ;..*****. 1E96: ;....*... 1E96: ;....*... 1E96: ;....*... 1E96: ;....*... 1E96: ;..*****. 1E96: 02020242 DB 002H,002H,002H,042H 1E9A: 423C DB 042H,03CH ;......*. 1E9C: ;......*. 1E9C: ;......*. 1E9C: ;.*....*. 1E9C: ;.*....*. 1E9C: ;..****.. 1E9C: 44487048 DB 044H,048H,070H,048H 1EA0: 4442 DB 044H,042H ;.*...*.. 1EA2: ;.*..*... 1EA2: ;.***.... 1EA2: ;.*..*... 1EA2: ;.*...*.. 1EA2: ;.*....*. 1EA2: 40404040 DB 040H,040H,040H,040H 1EA6: 407E DB 040H,07EH ;.*...... 1EA8: ;.*...... 1EA8: ;.*...... 1EA8: ;.*...... 1EA8: ;.*...... 1EA8: ;.******. 1EA8: 42665A42 DB 042H,066H,05AH,042H 1EAC: 4242 DB 042H,042H ;.*....*. 1EAE: ;.**..**. 1EAE: ;.*.**.*. 1EAE: ;.*....*. 1EAE: ;.*....*. 1EAE: ;.*....*. 1EAE: 4262524A DB 042H,062H,052H,04AH 1EB2: 4642 DB 046H,042H ;.*....*. 1EB4: ;.**...*. 1EB4: ;.*.*..*. 1EB4: ;.*..*.*. 1EB4: ;.*...**. 1EB4: ;.*....*. 1EB4: 3C424242 DB 03CH,042H,042H,042H 1EB8: 423C DB 042H,03CH ;..****.. 1EBA: ;.*....*. 1EBA: ;.*....*. 1EBA: ;.*....*. 1EBA: ;.*....*. 1EBA: ;..****.. 1EBA: 7C42427C DB 07CH,042H,042H,07CH 1EBE: 4040 DB 040H,040H ;.*****.. 1EC0: ;.*....*. 1EC0: ;.*....*. 1EC0: ;.*****.. 1EC0: ;.*...... 1EC0: ;.*...... 1EC0: 3C424252 DB 03CH,042H,042H,052H 1EC4: 4A3C DB 04AH,03CH ;..****.. 1EC6: ;.*....*. 1EC6: ;.*....*. 1EC6: ;.*.*..*. 1EC6: ;.*..*.*. 1EC6: ;..****.. 1EC6: 7C42427C DB 07CH,042H,042H,07CH 1ECA: 4442 DB 044H,042H ;.*****.. 1ECC: ;.*....*. 1ECC: ;.*....*. 1ECC: ;.*****.. 1ECC: ;.*...*.. 1ECC: ;.*....*. 1ECC: 3C403C02 DB 03CH,040H,03CH,002H 1ED0: 423C DB 042H,03CH ;..****.. 1ED2: ;.*...... 1ED2: ;..****.. 1ED2: ;......*. 1ED2: ;.*....*. 1ED2: ;..****.. 1ED2: FE101010 DB 0FEH,010H,010H,010H 1ED6: 1010 DB 010H,010H ;*******. 1ED8: ;...*.... 1ED8: ;...*.... 1ED8: ;...*.... 1ED8: ;...*.... 1ED8: ;...*.... 1ED8: 42424242 DB 042H,042H,042H,042H 1EDC: 423E DB 042H,03EH ;.*....*. 1EDE: ;.*....*. 1EDE: ;.*....*. 1EDE: ;.*....*. 1EDE: ;.*....*. 1EDE: ;..*****. 1EDE: 42424242 DB 042H,042H,042H,042H 1EE2: 2418 DB 024H,018H ;.*....*. 1EE4: ;.*....*. 1EE4: ;.*....*. 1EE4: ;.*....*. 1EE4: ;..*..*.. 1EE4: ;...**... 1EE4: 42424242 DB 042H,042H,042H,042H 1EE8: 5A24 DB 05AH,024H ;.*....*. 1EEA: ;.*....*. 1EEA: ;.*....*. 1EEA: ;.*....*. 1EEA: ;.*.**.*. 1EEA: ;..*..*.. 1EEA: 42241818 DB 042H,024H,018H,018H 1EEE: 2442 DB 024H,042H ;.*....*. 1EF0: ;..*..*.. 1EF0: ;...**... 1EF0: ;...**... 1EF0: ;..*..*.. 1EF0: ;.*....*. 1EF0: 82442810 DB 082H,044H,028H,010H 1EF4: 1010 DB 010H,010H ;*.....*. 1EF6: ;.*...*.. 1EF6: ;..*.*... 1EF6: ;...*.... 1EF6: ;...*.... 1EF6: ;...*.... 1EF6: 7E040810 DB 07EH,004H,008H,010H 1EFA: 207E DB 020H,07EH ;.******. 1EFC: ;.....*.. 1EFC: ;....*... 1EFC: ;...*.... 1EFC: ;..*..... 1EFC: ;.******. 1EFC: 0E080808 DB 00EH,008H,008H,008H 1F00: 080E DB 008H,00EH ;....***. 1F02: ;....*... 1F02: ;....*... 1F02: ;....*... 1F02: ;....*... 1F02: ;....***. 1F02: 00402010 DB 000H,040H,020H,010H 1F06: 0804 DB 008H,004H ;........ 1F08: ;.*...... 1F08: ;..*..... 1F08: ;...*.... 1F08: ;....*... 1F08: ;.....*.. 1F08: 70101010 DB 070H,010H,010H,010H 1F0C: 1070 DB 010H,070H ;.***.... 1F0E: ;...*.... 1F0E: ;...*.... 1F0E: ;...*.... 1F0E: ;...*.... 1F0E: ;.***.... 1F0E: 10385410 DB 010H,038H,054H,010H 1F12: 1010 DB 010H,010H ;...*.... 1F14: ;..***... 1F14: ;.*.*.*.. 1F14: ;...*.... 1F14: ;...*.... 1F14: ;...*.... 1F14: 00000000 DB 000H,000H,000H,000H 1F18: 0000FF DB 000H,000H,0FFH ;........ 1F1B: ;........ 1F1B: ;........ 1F1B: ;........ 1F1B: ;........ 1F1B: ;........ 1F1B: ;******** 1F1B: 1C227820 DB 01CH,022H,078H,020H 1F1F: 207E00 DB 020H,07EH,000H ;...***.. 1F22: ;..*...*. 1F22: ;.****... 1F22: ;..*..... 1F22: ;..*..... 1F22: ;.******. 1F22: ;........ 1F22: 0038043C DB 000H,038H,004H,03CH 1F26: 443E00 DB 044H,03EH,000H ;........ 1F29: ;..***... 1F29: ;.....*.. 1F29: ;..****.. 1F29: ;.*...*.. 1F29: ;..*****. 1F29: ;........ 1F29: 20203C22 DB 020H,020H,03CH,022H 1F2D: 223C00 DB 022H,03CH,000H ;..*..... 1F30: ;..*..... 1F30: ;..****.. 1F30: ;..*...*. 1F30: ;..*...*. 1F30: ;..****.. 1F30: ;........ 1F30: 001C2020 DB 000H,01CH,020H,020H 1F34: 201C00 DB 020H,01CH,000H ;........ 1F37: ;...***.. 1F37: ;..*..... 1F37: ;..*..... 1F37: ;..*..... 1F37: ;...***.. 1F37: ;........ 1F37: 04043C44 DB 004H,004H,03CH,044H 1F3B: 443E00 DB 044H,03EH,000H ;.....*.. 1F3E: ;.....*.. 1F3E: ;..****.. 1F3E: ;.*...*.. 1F3E: ;.*...*.. 1F3E: ;..*****. 1F3E: ;........ 1F3E: 00384478 DB 000H,038H,044H,078H 1F42: 403C00 DB 040H,03CH,000H ;........ 1F45: ;..***... 1F45: ;.*...*.. 1F45: ;.****... 1F45: ;.*...... 1F45: ;..****.. 1F45: ;........ 1F45: 0C101810 DB 00CH,010H,018H,010H 1F49: 101000 DB 010H,010H,000H ;....**.. 1F4C: ;...*.... 1F4C: ;...**... 1F4C: ;...*.... 1F4C: ;...*.... 1F4C: ;...*.... 1F4C: ;........ 1F4C: 003C4444 DB 000H,03CH,044H,044H 1F50: 3C0438 DB 03CH,004H,038H ;........ 1F53: ;..****.. 1F53: ;.*...*.. 1F53: ;.*...*.. 1F53: ;..****.. 1F53: ;.....*.. 1F53: ;..***... 1F53: 40407844 DB 040H,040H,078H,044H 1F57: 444400 DB 044H,044H,000H ;.*...... 1F5A: ;.*...... 1F5A: ;.****... 1F5A: ;.*...*.. 1F5A: ;.*...*.. 1F5A: ;.*...*.. 1F5A: ;........ 1F5A: 10003010 DB 010H,000H,030H,010H 1F5E: 103800 DB 010H,038H,000H ;...*.... 1F61: ;........ 1F61: ;..**.... 1F61: ;...*.... 1F61: ;...*.... 1F61: ;..***... 1F61: ;........ 1F61: 04000404 DB 004H,000H,004H,004H 1F65: 042418 DB 004H,024H,018H ;.....*.. 1F68: ;........ 1F68: ;.....*.. 1F68: ;.....*.. 1F68: ;.....*.. 1F68: ;..*..*.. 1F68: ;...**... 1F68: 20283030 DB 020H,028H,030H,030H 1F6C: 282400 DB 028H,024H,000H ;..*..... 1F6F: ;..*.*... 1F6F: ;..**.... 1F6F: ;..**.... 1F6F: ;..*.*... 1F6F: ;..*..*.. 1F6F: ;........ 1F6F: 10101010 DB 010H,010H,010H,010H 1F73: 100C00 DB 010H,00CH,000H ;...*.... 1F76: ;...*.... 1F76: ;...*.... 1F76: ;...*.... 1F76: ;...*.... 1F76: ;....**.. 1F76: ;........ 1F76: 00685454 DB 000H,068H,054H,054H 1F7A: 545400 DB 054H,054H,000H ;........ 1F7D: ;.**.*... 1F7D: ;.*.*.*.. 1F7D: ;.*.*.*.. 1F7D: ;.*.*.*.. 1F7D: ;.*.*.*.. 1F7D: ;........ 1F7D: 00784444 DB 000H,078H,044H,044H 1F81: 444400 DB 044H,044H,000H ;........ 1F84: ;.****... 1F84: ;.*...*.. 1F84: ;.*...*.. 1F84: ;.*...*.. 1F84: ;.*...*.. 1F84: ;........ 1F84: 00384444 DB 000H,038H,044H,044H 1F88: 443800 DB 044H,038H,000H ;........ 1F8B: ;..***... 1F8B: ;.*...*.. 1F8B: ;.*...*.. 1F8B: ;.*...*.. 1F8B: ;..***... 1F8B: ;........ 1F8B: 00784444 DB 000H,078H,044H,044H 1F8F: 784040 DB 078H,040H,040H ;........ 1F92: ;.****... 1F92: ;.*...*.. 1F92: ;.*...*.. 1F92: ;.****... 1F92: ;.*...... 1F92: ;.*...... 1F92: 003C4444 DB 000H,03CH,044H,044H 1F96: 3C0406 DB 03CH,004H,006H ;........ 1F99: ;..****.. 1F99: ;.*...*.. 1F99: ;.*...*.. 1F99: ;..****.. 1F99: ;.....*.. 1F99: ;.....**. 1F99: 001C2020 DB 000H,01CH,020H,020H 1F9D: 202000 DB 020H,020H,000H ;........ 1FA0: ;...***.. 1FA0: ;..*..... 1FA0: ;..*..... 1FA0: ;..*..... 1FA0: ;..*..... 1FA0: ;........ 1FA0: 00384038 DB 000H,038H,040H,038H 1FA4: 047800 DB 004H,078H,000H ;........ 1FA7: ;..***... 1FA7: ;.*...... 1FA7: ;..***... 1FA7: ;.....*.. 1FA7: ;.****... 1FA7: ;........ 1FA7: 10381010 DB 010H,038H,010H,010H 1FAB: 100C00 DB 010H,00CH,000H ;...*.... 1FAE: ;..***... 1FAE: ;...*.... 1FAE: ;...*.... 1FAE: ;...*.... 1FAE: ;....**.. 1FAE: ;........ 1FAE: 00444444 DB 000H,044H,044H,044H 1FB2: 443C00 DB 044H,03CH,000H ;........ 1FB5: ;.*...*.. 1FB5: ;.*...*.. 1FB5: ;.*...*.. 1FB5: ;.*...*.. 1FB5: ;..****.. 1FB5: ;........ 1FB5: 00444428 DB 000H,044H,044H,028H 1FB9: 281000 DB 028H,010H,000H ;........ 1FBC: ;.*...*.. 1FBC: ;.*...*.. 1FBC: ;..*.*... 1FBC: ;..*.*... 1FBC: ;...*.... 1FBC: ;........ 1FBC: 00445454 DB 000H,044H,054H,054H 1FC0: 542800 DB 054H,028H,000H ;........ 1FC3: ;.*...*.. 1FC3: ;.*.*.*.. 1FC3: ;.*.*.*.. 1FC3: ;.*.*.*.. 1FC3: ;..*.*... 1FC3: ;........ 1FC3: 00442810 DB 000H,044H,028H,010H 1FC7: 284400 DB 028H,044H,000H ;........ 1FCA: ;.*...*.. 1FCA: ;..*.*... 1FCA: ;...*.... 1FCA: ;..*.*... 1FCA: ;.*...*.. 1FCA: ;........ 1FCA: 00444444 DB 000H,044H,044H,044H 1FCE: 3C0438 DB 03CH,004H,038H ;........ 1FD1: ;.*...*.. 1FD1: ;.*...*.. 1FD1: ;.*...*.. 1FD1: ;..****.. 1FD1: ;.....*.. 1FD1: ;..***... 1FD1: 007C0810 DB 000H,07CH,008H,010H 1FD5: 207C00 DB 020H,07CH,000H ;........ 1FD8: ;.*****.. 1FD8: ;....*... 1FD8: ;...*.... 1FD8: ;..*..... 1FD8: ;.*****.. 1FD8: ;........ 1FD8: 0E083030 DB 00EH,008H,030H,030H 1FDC: 080E00 DB 008H,00EH,000H ;....***. 1FDF: ;....*... 1FDF: ;..**.... 1FDF: ;..**.... 1FDF: ;....*... 1FDF: ;....***. 1FDF: ;........ 1FDF: 08080808 DB 008H,008H,008H,008H 1FE3: 080800 DB 008H,008H,000H ;....*... 1FE6: ;....*... 1FE6: ;....*... 1FE6: ;....*... 1FE6: ;....*... 1FE6: ;....*... 1FE6: ;........ 1FE6: 70100C0C DB 070H,010H,00CH,00CH 1FEA: 107000 DB 010H,070H,000H ;.***.... 1FED: ;...*.... 1FED: ;....**.. 1FED: ;....**.. 1FED: ;...*.... 1FED: ;.***.... 1FED: ;........ 1FED: 324C0000 DB 032H,04CH,000H,000H 1FF1: 000000 DB 000H,000H,000H ;..**..*. 1FF4: ;.*..**.. 1FF4: ;........ 1FF4: ;........ 1FF4: ;........ 1FF4: ;........ 1FF4: ;........ 1FF4: 3C4299A1 DB 03CH,042H,099H,0A1H 1FF8: A199423C DB 0A1H,099H,042H,03CH ;..****.. 1FFC: ;.*....*. 1FFC: ;*..**..* 1FFC: ;*.*....* 1FFC: ;*.*....* 1FFC: ;*..**..* 1FFC: ;.*....*. 1FFC: ;..****.. 1FFC: ROMCHR: 1FFC: ;================================================================ 1FFC: FF DB 0FFH 1FFD: 581D DW UFLOAT-1 1FFF: 00 DB 000H 2000: ;================================================================ 2000: 2000: 2000: #END 2000: 2000: 2000: 2000: 2000: 2000: ; +++ defined symbols +++ KLT equ $0001 ; = 1 LOK equ $0002 ; = 2 KRT equ $0003 ; = 3 GFX equ $0004 ; = 4 CDL equ $0005 ; = 5 KUP equ $0007 ; = 7 INV equ $0008 ; = 8 KDN equ $0009 ; = 9 LDL equ $000A ; = 10 CCR equ $000D ; = 13 PND equ $0060 ; = 96 CPR equ $007F ; = 127 CINV equ $0080 ; = 128 CLAST equ $0080 ; = 128 IMM equ $0040 ; = 64 SAFETY equ $000C ; = 12 FSIGN equ $0080 ; = 128 FEOFFS equ $0040 ; = 64 IO equ $00FE ; = 254 SCREEN equ $2400 ; = 9216 SCREND equ $2700 ; = 9984 PADMEM equ $2701 ; = 9985 FPADMEM equ $2301 ; = 8961 SCRMEND equ $2800 ; = 10240 CHRSET equ $2C00 ; = 11264 MEMBEG equ $3C00 ; = 15360 FPWS equ $3C00 ; = 15360 LISTWS equ $3C13 ; = 15379 LPICNT equ $3C13 ; = 15379 LPIBUF equ $3C14 ; = 15380 LPIACT equ $3C15 ; = 15381 LPLCNT equ $3C16 ; = 15382 RAMTOP equ $3C18 ; = 15384 HLD equ $3C1A ; = 15386 SCRPOS equ $3C1C ; = 15388 INSCRN equ $3C1E ; = 15390 CURSOR equ $3C20 ; = 15392 ENDBUF equ $3C22 ; = 15394 RAMVAR equ $3C24 ; = 15396 LHALF equ $3C24 ; = 15396 KEYCOD equ $3C26 ; = 15398 KEYCNT equ $3C27 ; = 15399 STATIN equ $3C28 ; = 15400 EXWRCH equ $3C29 ; = 15401 FRAMES equ $3C2B ; = 15403 XCOORD equ $3C2F ; = 15407 YCOORD equ $3C30 ; = 15408 VCURRENT equ $3C31 ; = 15409 VCONTEXT equ $3C33 ; = 15411 VOCLNK equ $3C35 ; = 15413 STKBOT equ $3C37 ; = 15415 DICT equ $3C39 ; = 15417 SPARE equ $3C3B ; = 15419 ERRNO equ $3C3D ; = 15421 FLAGS equ $3C3E ; = 15422 VBASE equ $3C3F ; = 15423 DICT1ST equ $3C40 ; = 15424 ERRNONE equ $FFFFFFFF ; = -1 ERRMEM equ $0001 ; = 1 ERRSTK equ $0002 ; = 2 ERRBRK equ $0003 ; = 3 ERRIMM equ $0004 ; = 4 ERRBLK equ $0005 ; = 5 ERRNAME equ $0006 ; = 6 ERRPICK equ $0007 ; = 7 ERRFLT equ $0008 ; = 8 ERRAT equ $0009 ; = 9 ERRREAD equ $000A ; = 10 ERRDICT equ $000B ; = 11 ERRMODE equ $000C ; = 12 ERRFIND equ $000D ; = 13 ERRLIST equ $000E ; = 14 RSTEMIT equ $0008 ; = 8 RSTPUSH equ $0010 ; = 16 RSTPULL equ $0018 ; = 24 RSTERR equ $0020 ; = 32 RMEMLP equ $0028 ; = 40 RGOON equ $003B ; = 59 RGFXLP equ $0055 ; = 85 RGFXM equ $005F ; = 95 RCHRLP equ $007C ; = 124 RCHR7 equ $0085 ; = 133 QUIT equ $0099 ; = 153 RQUIT equ $009B ; = 155 ABORT equ $00AB ; = 171 RABORT equ $00AD ; = 173 ABGOON equ $00DE ; = 222 ABORTEND equ $00FF ; = 255 ROMVAR equ $010D ; = 269 FORTH equ $0133 ; = 307 ROMVEND equ $013A ; = 314 FREEMEM equ $3C51 ; = 15441 VSYNC equ $013A ; = 314 VDELAY equ $0142 ; = 322 VSCNT equ $0147 ; = 327 VSNOGRF equ $0167 ; = 359 VSNOINV equ $016D ; = 365 VSCTRL equ $0170 ; = 368 VSEND equ $0176 ; = 374 DCDOCHAR equ $017E ; = 382 DCDCNORM equ $0196 ; = 406 DCDCINS equ $0198 ; = 408 DCDCSCROL equ $01A6 ; = 422 DCDCSLOOP equ $01C9 ; = 457 DCDCEND equ $01CE ; = 462 DCDCSTORE equ $01DD ; = 477 DCDCQUIT equ $01E4 ; = 484 DOCTRL equ $01E6 ; = 486 DCJMPTAB equ $01F0 ; = 496 DCFLAG equ $01FE ; = 510 DCLEFT equ $0204 ; = 516 DCNOP equ $0210 ; = 528 DCRIGHT equ $0211 ; = 529 DCCURDEL equ $0225 ; = 549 DCCHARDEL equ $022C ; = 556 DCCDGOON equ $023F ; = 575 DCUP equ $0247 ; = 583 DCUPLOOP equ $024E ; = 590 DCUSCROLL equ $0254 ; = 596 DCUSLOOP equ $0269 ; = 617 DCOUTCUR equ $0276 ; = 630 DCSETCUR equ $0282 ; = 642 SCNOCAPS equ $0290 ; = 656 DCDOWN equ $0295 ; = 661 DCDNLOOP equ $029C ; = 668 DCDSCROLL equ $02A2 ; = 674 DCSTREND equ $02B0 ; = 688 DCLINEDEL equ $02C3 ; = 707 DCLDLOOP equ $02CA ; = 714 DCENTER equ $02D0 ; = 720 DCCLEAR equ $02D8 ; = 728 DCRETYPE equ $02EA ; = 746 DCSETBEG equ $02ED ; = 749 DCSETEND equ $02F4 ; = 756 DCSELOOP equ $02F9 ; = 761 DCGETCIN equ $0302 ; = 770 VKEY equ $0310 ; = 784 VKNEW equ $0320 ; = 800 VKAGAIN equ $0325 ; = 805 VKPRESS equ $0331 ; = 817 VKQUIT equ $0332 ; = 818 KEYGET equ $0336 ; = 822 KEYGNC equ $0347 ; = 839 KEYGLP equ $034F ; = 847 KEYGSC equ $0359 ; = 857 KEYGNK equ $0362 ; = 866 KEYGQU equ $036B ; = 875 KEYGQU2 equ $036D ; = 877 KEYTBL equ $0376 ; = 886 REMIT equ $03EE ; = 1006 RENORM equ $03F5 ; = 1013 EMITSCR equ $03FF ; = 1023 ESENTER equ $0416 ; = 1046 ESQUIT equ $041C ; = 1052 SCROLLUP equ $0421 ; = 1057 INSLINE equ $042F ; = 1071 ILLOOP equ $043D ; = 1085 DECLINE equ $0443 ; = 1091 DLEND equ $044B ; = 1099 GETVAR equ $044D ; = 1101 HERE equ $0460 ; = 1120 CONTEXT equ $0473 ; = 1139 CURRENT equ $0480 ; = 1152 BASE equ $048A ; = 1162 GETFLAGS equ $048D ; = 1165 DP equ $0490 ; = 1168 PAD equ $0499 ; = 1177 NSEMICOLON equ $049D ; = 1181 SEMICOLON equ $04A1 ; = 1185 SEMIS equ $04B6 ; = 1206 RSEMIS equ $04B8 ; = 1208 NEXT equ $04B9 ; = 1209 NEXTSUB equ $04BA ; = 1210 NEXTDE equ $04BF ; = 1215 SLNEXT equ $04C6 ; = 1222 RSLNEXT equ $04C8 ; = 1224 ERRORSTK equ $04D7 ; = 1239 RSLNGOON equ $04D9 ; = 1241 USERBREAK equ $04E4 ; = 1252 BREAK equ $04F0 ; = 1264 QUITLOOP equ $04F2 ; = 1266 QLLOOP equ $04F5 ; = 1269 LINE equ $0506 ; = 1286 LINELOOP equ $0508 ; = 1288 LINENUM equ $0518 ; = 1304 LINESTR equ $0526 ; = 1318 LINEERR equ $0530 ; = 1328 OK equ $0536 ; = 1334 OKQUIT equ $054D ; = 1357 CHKIMM equ $054F ; = 1359 CHKIQUIT equ $0561 ; = 1377 CHKNUMBER equ $0564 ; = 1380 RETYPE equ $0578 ; = 1400 QUERY equ $058C ; = 1420 QSTART equ $0594 ; = 1428 QLOOP equ $059B ; = 1435 WORD equ $05AB ; = 1451 WCLLOOP equ $05B3 ; = 1459 WGOON1 equ $05C6 ; = 1478 WGOON2 equ $05D1 ; = 1489 GETSTRING equ $05DF ; = 1503 CWORD equ $05E1 ; = 1505 CWLOOP1 equ $05EA ; = 1514 CWLOOP2 equ $05F3 ; = 1523 CWEND equ $05FC ; = 1532 CWNFND equ $0600 ; = 1536 CWERR equ $0614 ; = 1556 CHKSTRING equ $061B ; = 1563 VLIST equ $062D ; = 1581 FIND equ $063D ; = 1597 RFIND equ $0644 ; = 1604 FLOOP equ $064B ; = 1611 FTEST equ $0657 ; = 1623 FCOMPARE equ $0660 ; = 1632 FPRINT equ $0676 ; = 1654 FNEXT1 equ $067D ; = 1661 FNEXT2 equ $067F ; = 1663 ZERO equ $0688 ; = 1672 RZERO equ $068A ; = 1674 EXECUTE equ $069A ; = 1690 NUMBER equ $06A9 ; = 1705 NFLOAT equ $06BC ; = 1724 NFGOON equ $06CE ; = 1742 NFLOOP1 equ $06D3 ; = 1747 NFLOOP2 equ $06DF ; = 1759 NFEXP equ $06EF ; = 1775 NFEGOON equ $06FD ; = 1789 NFQUIT equ $0711 ; = 1809 NUMBERQUIT equ $0714 ; = 1812 NUMBERERR equ $071C ; = 1820 DECGET equ $0723 ; = 1827 DECSHIN equ $072C ; = 1836 DECSTORE equ $0732 ; = 1842 DSLOOP equ $0736 ; = 1846 FZEROEQ equ $0740 ; = 1856 FZEQLP equ $0742 ; = 1858 CNVINT equ $074C ; = 1868 CNVEND equ $077B ; = 1915 CONVERT equ $078A ; = 1930 CNVTLOOP equ $078C ; = 1932 CNVTEND equ $07B4 ; = 1972 CNVDIGIT equ $07B8 ; = 1976 CNVDOK equ $07CD ; = 1997 CNVDQUIT equ $07D7 ; = 2007 BLWORD equ $07DA ; = 2010 BLANKS equ $07FA ; = 2042 BLANKS2 equ $07FB ; = 2043 BLLOOP equ $07FE ; = 2046 TOUPPER equ $0807 ; = 2055 VIS equ $0818 ; = 2072 INVIS equ $0828 ; = 2088 FAST equ $0837 ; = 2103 SLOW equ $0846 ; = 2118 PULLBC equ $084E ; = 2126 RPULL equ $0859 ; = 2137 RPUSH equ $085F ; = 2143 DUP equ $086B ; = 2155 DROP equ $0879 ; = 2169 SWAP equ $0885 ; = 2181 CAT equ $0896 ; = 2198 CEXCLAM equ $08A5 ; = 2213 AT equ $08B3 ; = 2227 EXCLAM equ $08C1 ; = 2241 GTR equ $08D2 ; = 2258 RGT equ $08DF ; = 2271 QDUP equ $08EE ; = 2286 ROT equ $08FF ; = 2303 OVER equ $0912 ; = 2322 PICK equ $0925 ; = 2341 ROLL equ $0933 ; = 2355 CPICK equ $094D ; = 2381 CPKGOON equ $095B ; = 2395 TYPE equ $096E ; = 2414 TYPEDE equ $0979 ; = 2425 CTYPE equ $097F ; = 2431 LTNUM equ $098D ; = 2445 NUMGT equ $099C ; = 2460 PNT equ $09B3 ; = 2483 PNTLEFT equ $09C3 ; = 2499 UPNT equ $09D0 ; = 2512 NUMS equ $09E1 ; = 2529 NUMSLP equ $09E3 ; = 2531 NUM equ $09F7 ; = 2551 NIBASC equ $0A07 ; = 2567 NADEC equ $0A13 ; = 2579 CLS equ $0A1D ; = 2589 CCLS equ $0A24 ; = 2596 SIGN equ $0A4A ; = 2634 HOLD equ $0A5C ; = 2652 RHOLD equ $0A5F ; = 2655 HOLDQUIT equ $0A69 ; = 2665 SPACE equ $0A73 ; = 2675 SPACEQUIT equ $0A78 ; = 2680 SPACES equ $0A83 ; = 2691 SPCLOOP equ $0A86 ; = 2694 CR equ $0A95 ; = 2709 EMIT equ $0AA3 ; = 2723 FPNT equ $0AAF ; = 2735 FPGOON1 equ $0ABE ; = 2750 FPGOON2 equ $0ACA ; = 2762 FPGOON3 equ $0ACE ; = 2766 FPH0 equ $0AD7 ; = 2775 FPMLOOP equ $0ADC ; = 2780 FP0 equ $0AFC ; = 2812 FPEXP equ $0B05 ; = 2821 FPQUIT equ $0B10 ; = 2832 ATPOS equ $0B19 ; = 2841 CATPOS equ $0B28 ; = 2856 PLOT equ $0B4A ; = 2890 PLGOON equ $0B6F ; = 2927 PLX0Y0 equ $0B7F ; = 2943 PLXOR equ $0B8C ; = 2956 BEEP equ $0B98 ; = 2968 BLOOP equ $0BAF ; = 2991 BDBREAK equ $0BC7 ; = 3015 BEEPDELAY equ $0BC9 ; = 3017 BDLOOP equ $0BCB ; = 3019 INKEY equ $0BDB ; = 3035 IN equ $0BEB ; = 3051 OUT equ $0BFD ; = 3069 ABS equ $0C0D ; = 3085 ZEROEQ equ $0C1A ; = 3098 CMPPUSH equ $0C21 ; = 3105 ZEROLT equ $0C2E ; = 3118 ZEROGT equ $0C3A ; = 3130 EQ equ $0C4A ; = 3146 GT equ $0C56 ; = 3158 LT equ $0C65 ; = 3173 ULT equ $0C72 ; = 3186 UCMP equ $0C77 ; = 3191 DLT equ $0C83 ; = 3203 GREATER equ $0C99 ; = 3225 GRTRQUIT equ $0CA0 ; = 3232 UMUL equ $0CA8 ; = 3240 UMULLOOP equ $0CB3 ; = 3251 UMULNEXT equ $0CBE ; = 3262 DIV32BY16 equ $0CC4 ; = 3268 D32GOON equ $0CD5 ; = 3285 D32LOOP equ $0CDB ; = 3291 D32NEXT equ $0CE5 ; = 3301 PUSHDEHL equ $0CF3 ; = 3315 DIVMOD equ $0D00 ; = 3328 DIVMOD2 equ $0D0D ; = 3341 MULDIVMOD equ $0D31 ; = 3377 DIV equ $0D51 ; = 3409 MOD equ $0D61 ; = 3425 MUL equ $0D6D ; = 3437 MULDIV equ $0D7A ; = 3450 UDIVMOD equ $0D8C ; = 3468 IFN0NEG equ $0D94 ; = 3476 I0NEND equ $0D9E ; = 3486 NEGATE equ $0DA9 ; = 3497 DNEGATE equ $0DBA ; = 3514 DONEGATE equ $0DBF ; = 3519 DNLOOP equ $0DC5 ; = 3525 PLUS equ $0DD2 ; = 3538 MINUS equ $0DE1 ; = 3553 DPLUS equ $0DEE ; = 3566 ONEPLUS equ $0E09 ; = 3593 TWOPLUS equ $0E13 ; = 3603 XPLUS equ $0E17 ; = 3607 ONEMINUS equ $0E1F ; = 3615 TWOMINUS equ $0E29 ; = 3625 XMINUS equ $0E2D ; = 3629 XPLUSMINUS equ $0E2E ; = 3630 LOR equ $0E36 ; = 3638 LAND equ $0E4B ; = 3659 LXOR equ $0E60 ; = 3680 MAX equ $0E75 ; = 3701 MIN equ $0E87 ; = 3719 MINMAX equ $0E8F ; = 3727 MINMAXEND equ $0E95 ; = 3733 DECIMAL equ $0EA3 ; = 3747 NCOLON equ $0EAB ; = 3755 COLON equ $0EAF ; = 3759 DOCOL equ $0EC3 ; = 3779 NCREATE equ $0EC7 ; = 3783 CREATE equ $0ED0 ; = 3792 CRHEADER equ $0EFB ; = 3835 CHGOON equ $0F09 ; = 3849 CHLOOP equ $0F1D ; = 3869 LINKHERE equ $0F2E ; = 3886 LHGOON equ $0F36 ; = 3894 KOMMA equ $0F4E ; = 3918 CKOMMA equ $0F5F ; = 3935 ALLOT equ $0F76 ; = 3958 ALLOT2 equ $0F83 ; = 3971 MEMCHECK equ $0F8C ; = 3980 MEMCHECK2 equ $0F8F ; = 3983 MCERROR equ $0F9C ; = 3996 ALLOC equ $0F9E ; = 3998 NVARIABLE equ $0FC4 ; = 4036 VARIABLE equ $0FCF ; = 4047 NCONSTANT equ $0FD7 ; = 4055 CONSTANT equ $0FE2 ; = 4066 DOCREATE equ $0FEC ; = 4076 DOVARIABLE equ $0FF0 ; = 4080 DOCONSTANT equ $0FF5 ; = 4085 LITERAL equ $1006 ; = 4102 GETWORD equ $1011 ; = 4113 GWLOOP equ $1015 ; = 4117 GWGOON equ $1019 ; = 4121 GWQUIT equ $101E ; = 4126 NASCII equ $1020 ; = 4128 ASCII equ $1028 ; = 4136 GETBYTE equ $104B ; = 4171 LITFLOAT equ $1055 ; = 4181 GETFLOAT equ $1064 ; = 4196 NDEFINER equ $106A ; = 4202 DEFINER equ $1074 ; = 4212 DODEFINER equ $1085 ; = 4229 DROPGOON equ $109A ; = 4250 CALL equ $10A7 ; = 4263 NDOESGT equ $10AC ; = 4268 DOESGT equ $10B4 ; = 4276 DOESPATCH equ $10CD ; = 4301 DODOESGT equ $10E8 ; = 4328 NCOMPILER equ $10EA ; = 4330 COMPILER equ $10F5 ; = 4341 DOCOMPILER equ $1108 ; = 4360 DOCOMGOON equ $1110 ; = 4368 NRUNSGT equ $111D ; = 4381 RUNSGT equ $1125 ; = 4389 DORUNSGT equ $1140 ; = 4416 RUNSCORR equ $1142 ; = 4418 IMMEDIATE equ $1160 ; = 4448 VOCABULARY equ $117D ; = 4477 DEFINITIONS equ $11AB ; = 4523 SETCONTEXT equ $11B5 ; = 4533 NIF equ $11BB ; = 4539 IF equ $11C0 ; = 4544 NWHILE equ $11CD ; = 4557 WHILE equ $11D5 ; = 4565 NELSE equ $11E5 ; = 4581 ELSE equ $11EC ; = 4588 NTHEN equ $1200 ; = 4608 THEN equ $1207 ; = 4615 NBEGIN equ $1212 ; = 4626 BEGIN equ $121A ; = 4634 DOFPATCH equ $1225 ; = 4645 DORPATCH equ $1237 ; = 4663 NREPEAT equ $1243 ; = 4675 REPEAT equ $124C ; = 4684 NUNTIL equ $125B ; = 4699 UNTIL equ $1263 ; = 4707 DOELSE equ $1271 ; = 4721 DOREPEAT equ $1276 ; = 4726 FJUMP equ $1278 ; = 4728 OFFSJUMP equ $127C ; = 4732 DOIF equ $1283 ; = 4739 DOWHILE equ $1288 ; = 4744 DOUNTIL equ $128D ; = 4749 IF0JUMP equ $128F ; = 4751 EQUJUMP equ $1294 ; = 4756 DOBEGIN equ $129F ; = 4767 DOTHEN equ $12A4 ; = 4772 NDO equ $12A6 ; = 4774 DO equ $12AB ; = 4779 NLOOP equ $12B6 ; = 4790 LOOP equ $12BD ; = 4797 LOOPGOON equ $12C1 ; = 4801 NPLUSLOOP equ $12C8 ; = 4808 PLUSLOOP equ $12D0 ; = 4816 ASSERT equ $12D8 ; = 4824 I equ $12E9 ; = 4841 ITICK equ $12F7 ; = 4855 J equ $1302 ; = 4866 RGET equ $1307 ; = 4871 LEAVE equ $1316 ; = 4886 DODO equ $1323 ; = 4899 JNEXT4 equ $132D ; = 4909 DOLOOP equ $1332 ; = 4914 DOPLUSLOOP equ $133C ; = 4924 LOOPADD equ $133F ; = 4927 LOOPCMP equ $1350 ; = 4944 LOOPEND equ $1358 ; = 4952 NLBRACKET equ $135D ; = 4957 LBRACKET equ $1361 ; = 4961 LBREND equ $1368 ; = 4968 DOLBRACKET equ $1379 ; = 4985 NPTSTR equ $1383 ; = 4995 PTSTR equ $1388 ; = 5000 DOPTSTR equ $1396 ; = 5014 SAVETEXT equ $139F ; = 5023 STLOOP equ $13A1 ; = 5025 STFND equ $13B8 ; = 5048 LSQRBR equ $13D5 ; = 5077 RSQRBR equ $13E1 ; = 5089 EXIT equ $13F0 ; = 5104 RDONAME equ $0000 ; = 0 RDOCODE equ $0002 ; = 2 RDNCODE equ $0004 ; = 4 RDDNAME equ $0004 ; = 4 RDNRUN equ $0006 ; = 6 RDOEND equ $0008 ; = 8 RDNEND equ $000A ; = 10 RDDLEN equ $000A ; = 10 RDNNAME equ $000C ; = 12 REDEFINE equ $13FD ; = 5117 RDGOON1 equ $1452 ; = 5202 RDGOON2 equ $147F ; = 5247 REDEFABORT equ $14CF ; = 5327 DICTERR equ $14DA ; = 5338 DELWORD equ $14DC ; = 5340 CORRCURR equ $14F8 ; = 5368 CORRDICT equ $1504 ; = 5380 CDLOOP equ $150B ; = 5387 CDDEFCOM equ $1537 ; = 5431 CDCOLON equ $153A ; = 5434 CDSETCTXT equ $153F ; = 5439 CORRWORD equ $1548 ; = 5448 CORRPTR equ $1557 ; = 5463 CORRADDR equ $1568 ; = 5480 CAWORD equ $1584 ; = 5508 CADICT equ $1592 ; = 5522 SKIPOFFS equ $159E ; = 5534 SKOFFS2 equ $15A2 ; = 5538 SKOGOON equ $15B1 ; = 5553 NFA equ $15B5 ; = 5557 PTR2ADDR equ $15C0 ; = 5568 P2ARUN equ $15D4 ; = 5588 P2AGOON equ $15DB ; = 5595 FPTR2NAME equ $15E7 ; = 5607 PTR2NAME equ $15E8 ; = 5608 P2NGOON equ $15F2 ; = 5618 P2NLOOP equ $15F4 ; = 5620 JDELOOP equ $15F9 ; = 5625 JUMPDE equ $15FB ; = 5627 RESCURR equ $1610 ; = 5648 FINDWORD equ $1620 ; = 5664 FORGET equ $1638 ; = 5688 EDIT equ $165E ; = 5726 LIST equ $1670 ; = 5744 EDITLIST equ $1675 ; = 5749 ELCOLON equ $1697 ; = 5783 ELCOMPILER equ $169C ; = 5788 ELDEFINER equ $16B1 ; = 5809 ELOUT equ $16B4 ; = 5812 ELMLOOP equ $16C3 ; = 5827 ELLLOOP equ $16C7 ; = 5831 ELREADY equ $16D2 ; = 5842 ELACK equ $16DF ; = 5855 ELEDIT equ $16E8 ; = 5864 ELQUIT equ $1702 ; = 5890 LISTPGM equ $1708 ; = 5896 LPLOOP equ $1712 ; = 5906 LPOUT equ $1753 ; = 5971 LPNEXT equ $1756 ; = 5974 LPIINC equ $175D ; = 5981 LPILEFT equ $1764 ; = 5988 LPIDEC equ $176B ; = 5995 LPINDENT equ $1770 ; = 6000 LPWORD equ $177C ; = 6012 LPNUMBER equ $1783 ; = 6019 LPFLOAT equ $178B ; = 6027 LPBYTE equ $1798 ; = 6040 LPSEMIS equ $17A4 ; = 6052 LPLBRACKET equ $17AC ; = 6060 LPPTSTR equ $17B0 ; = 6064 LPSTRING equ $17B2 ; = 6066 OUTINDENT equ $17C1 ; = 6081 OILOOP equ $17CF ; = 6095 OIQUIT equ $17D4 ; = 6100 LPNXTWRD equ $17DA ; = 6106 OUTWORDI equ $17E1 ; = 6113 OUTWORD equ $17E4 ; = 6116 OWDOXX equ $17F0 ; = 6128 OUTTXT equ $17FB ; = 6139 ROMTXT equ $1808 ; = 6152 PNTHL equ $180E ; = 6158 EXECDE equ $1815 ; = 6165 TXALL equ $1820 ; = 6176 TAGOON1 equ $1832 ; = 6194 TALOOP1 equ $1837 ; = 6199 TADEL1 equ $1839 ; = 6201 TAGOON2 equ $1843 ; = 6211 TADEL2 equ $1847 ; = 6215 TADEL3 equ $184F ; = 6223 TALOOP2 equ $1859 ; = 6233 TADEL4 equ $185C ; = 6236 TADEL5 equ $1862 ; = 6242 TABIT0 equ $1864 ; = 6244 TANEXT equ $186D ; = 6253 TACHECK equ $1887 ; = 6279 TASTART equ $188A ; = 6282 TAEND equ $188F ; = 6287 TXRXQUIT equ $1892 ; = 6290 TRQDEL6 equ $1897 ; = 6295 RXALL equ $18A7 ; = 6311 RASYNC equ $18B5 ; = 6325 RALOOP1 equ $18B6 ; = 6326 RALOOP2 equ $18B8 ; = 6328 RALOOP3 equ $18C7 ; = 6343 RALOOP equ $18DF ; = 6367 RAVERIFY equ $18E7 ; = 6375 RAGOON equ $18EC ; = 6380 RASTART equ $18F0 ; = 6384 RETURN equ $18FB ; = 6395 RXBYTE equ $18FC ; = 6396 RB8LOOP equ $18FE ; = 6398 RXBIT equ $1911 ; = 6417 RXLEVEL equ $1915 ; = 6421 RBDELAY equ $1917 ; = 6423 RBLOOP equ $191B ; = 6427 FFLAG equ $0000 ; = 0 FNLEN equ $0001 ; = 1 FLEN equ $000B ; = 11 FSTART equ $000D ; = 13 FDICT equ $000F ; = 15 FCURR equ $0011 ; = 17 FSIZE equ $0019 ; = 25 SAVE equ $1934 ; = 6452 BSAVE equ $1944 ; = 6468 BLOAD equ $1954 ; = 6484 VERIFY equ $1967 ; = 6503 BVERIFY equ $1979 ; = 6521 DOVERIFY equ $197D ; = 6525 LOAD equ $198A ; = 6538 LDNLOOP equ $19DD ; = 6621 FILENAME equ $19F3 ; = 6643 SEMICODE equ $1A0E ; = 6670 FILEFHEAD equ $1A10 ; = 6672 FILEBHEAD equ $1A3D ; = 6717 DOSAVE equ $1A4F ; = 6735 READHEADER equ $1A74 ; = 6772 RHLOOP equ $1A76 ; = 6774 RHBINARY equ $1A95 ; = 6805 RHCHECK equ $1A9F ; = 6815 RHCLOOP equ $1AA7 ; = 6823 RHCSTART equ $1AA9 ; = 6825 RHCNEXT equ $1AAE ; = 6830 RXERROR equ $1AB6 ; = 6838 DOBLOAD equ $1AB8 ; = 6840 DOBVERIFY equ $1ABE ; = 6846 DBVLOOP equ $1AC8 ; = 6856 DOBREAD equ $1AD0 ; = 6864 DBRGOON1 equ $1ADF ; = 6879 DBRGOON2 equ $1AE9 ; = 6889 FEXP1 equ $0000 ; = 0 FEXP2 equ $0001 ; = 1 FSGN equ $0002 ; = 2 FACCU equ $0003 ; = 3 FQUO equ $0007 ; = 7 FDIVOR equ $0010 ; = 16 FINIT equ $1AF4 ; = 6900 FICLEAR equ $1AF8 ; = 6904 FADJUST equ $1B22 ; = 6946 FADJLP1 equ $1B28 ; = 6952 FADJLP2 equ $1B2E ; = 6958 FADJLP3 equ $1B3A ; = 6970 FNEG equ $1B43 ; = 6979 FNLOOP equ $1B48 ; = 6984 FADDITION equ $1B53 ; = 6995 FMULADD equ $1B55 ; = 6997 FMLOOP1 equ $1B67 ; = 7015 FMLOOP2 equ $1B77 ; = 7031 FMNOADD equ $1B83 ; = 7043 FMNEXT equ $1B91 ; = 7057 FMINUS equ $1BA4 ; = 7076 FPLUS equ $1BB1 ; = 7089 FADDSUB equ $1BB3 ; = 7091 FASGOON1 equ $1BC1 ; = 7105 FASGOON2 equ $1BC9 ; = 7113 FASLP1 equ $1BCE ; = 7118 FASLP2 equ $1BE5 ; = 7141 FASLP3 equ $1BF6 ; = 7158 FASGOON3 equ $1C02 ; = 7170 FCORR equ $1C04 ; = 7172 FCLP equ $1C0C ; = 7180 FCQUIT equ $1C21 ; = 7201 FLTERR equ $1C3B ; = 7227 FLT0 equ $1C3D ; = 7229 FLT0LP equ $1C40 ; = 7232 FMUL equ $1C4B ; = 7243 FMLOOP equ $1C5D ; = 7261 FDIV equ $1C7B ; = 7291 FDLOOP1 equ $1CA2 ; = 7330 FDGOON1 equ $1CB0 ; = 7344 FDLOOP2 equ $1CB3 ; = 7347 FDLOOP3 equ $1CB5 ; = 7349 FDLOOP4 equ $1CBD ; = 7357 FDGOON2 equ $1CCB ; = 7371 FDNEXT equ $1CE8 ; = 7400 FDGOON3 equ $1CFE ; = 7422 FNEGATE equ $1D0F ; = 7439 FNQUIT equ $1D18 ; = 7448 INT equ $1D22 ; = 7458 INTLOOP equ $1D2B ; = 7467 INTQUIT equ $1D45 ; = 7493 UFLOAT equ $1D59 ; = 7513 UFLOOP equ $1D62 ; = 7522 ROMCHR equ $1FFC ; = 8188