title TURBO PASCAL Compiler for CP/M 80 name ('TURBO') ; DASMed version of TURBO.COM, v3.0 ; By W. Cirsovius ;; +++l6f66 l446c l7124 l2da4 l3135 l2df8 ; l731f -> $STR$ in Teil 6 ;;; RTL l0af5 ;;; MENUE ----- ;;; EDITOR l42a1 l3918 l2fc1 l324b l32f5 (SEARCH) ;;; COMPILER l5039 .z80 aseg org 0100h FALSE equ 0 .TRUE equ 1 OS equ 0000h DU equ 0004h BDOS equ 0005h TPAtop equ BDOS+1 Number equ 005dh TPA equ 0100h .resdsk equ 13 .seldsk equ 14 .open equ 15 .close equ 16 .srcfrs equ 17 .srcnxt equ 18 .delete equ 19 .rdseq equ 20 .wrseq equ 21 .make equ 22 .rename equ 23 .retdsk equ 25 .setdma equ 26 .getalv equ 27 .getdpb equ 31 .rndrd equ 33 .rndwr equ 34 .filsiz equ 35 RecLng equ 128 ; Standard record length Dirlng equ 15 MaxParams equ 31 @const equ 2 @conin equ 3 @conout equ 4 @list equ 5 @auxout equ 6 @auxin equ 7 ..const equ (@const-1)*3 ..conin equ (@conin-1)*3 ..conout equ (@conout-1)*3 ..list equ (@list-1)*3 ..auxout equ (@auxout-1)*3 ..auxin equ (@auxin-1)*3 Fdrv equ 1 Fname equ 8 Fext equ 3 _SYS equ 10 _ex equ 12 DIRlen equ 16 _rrn equ 33 FCBlen equ 36 FIB.rec equ 4 ; Pointer #records FIB.reclen equ 6 ; Pointer record length FIB.cur equ 8 ; Pointer to current record FIB.FCB equ 12 ; Pointer to FCB FIBlen equ FIB.FCB+FCBlen ; FIB length less buffer FIB.buff equ FIBlen ; Pointer to buffer FIBtype equ 00001111b rd.bit equ 4 wr.bit equ 5 out.bit equ 6 in.bit equ 7 ..in equ 10000000b ..out equ 01000000b ..read equ 00010000b FixRecLen equ 4 ; Fixed record length Rec.Wr.bit equ 0 Rec.New.bit equ 1 Rec.Wr equ 01b Rec.New equ 10b RAMdevice equ 6 HeapLen equ 4 ; Heap administration HeapLOadr equ 0 ; Address location HeapHIadr equ 1 HeapLOlen equ 2 ; Length location HeapHIlen equ 3 null equ 00h bs equ 08h tab equ 09h lf equ 0ah cr equ 0dh eof equ 1ah esc equ 1bh CtrlC equ 'C'-'@' Xoff equ 'S'-'@' @CAN equ 'U'-'@' CtrlX equ 'X'-'@' DEL equ 7fh LoMask equ 00001111b DPBMASK equ 00011111b NOMSB equ 01111111b MSB equ 10000000b LSB equ 00000001b @MSB equ 1000000000000000b MINWID equ 56 ; Min width for filename MAXINT equ 32767 DefSTR equ 8 _LB equ 0 _MB equ 7 sgn.bit equ 7 sign.bit equ 10000000b mant.len equ 5 ; Byte length of mantissa Real.Len equ 6 ; Length of real bit.len equ 8 ; Bits in a byte exp.offset equ 080h ; Offset in exponent Exp.One equ exp.offset+1 ; Exponent for >=1.0 int.max equ exp.offset+15 ; Max exponent for an integer mant.bits equ mant.len*bit.len real.dig equ 24 ; Length of mantissa real.field equ 7 ; Real field size real.ASCII equ 12 ; Decimal places ExpFix equ 77 ; Exponent fix for real to ASCII ExpRange equ 0d9h ; Exponent range sqr.exp equ 014h ; SQRT exponent fix sin.min equ 06ch ; SIN/COS minimum exponent ln.min equ 067h ; LN minimum exponent exp.max equ 088h ; EXP maximum exponent dot.bit equ 6 ; Status of dot in real exps.bit equ 5 ; Sign of exponent exp.bit equ 4 ; Exponent l00fe equ 254 ; Mystery editor size MEMGAP equ 708 ; Memory gap at top of memory StkSpc equ 1024 ; Stack space _SavLen equ 8192 _RST equ 7 ; ** CAUTION ** @RST equ _RST SHL 3 ; RST address (0x0038H) RST equ 11000111b + @RST; RST instruction (0xFFH) @OVLADR equ 9000h ; Overlay load address .LD.A equ 03eh ; LD A,xx .LD.BC equ 001h ; LD BC,xxxx .LD.DE equ 011h ; LD DE,xxxx .LD.HL equ 021h ; LD HL,xxxx .LD.SP equ 031h ; LD SP,xxxx .LD@DE equ 5bedh ; LD DE,(xxxx) .LD@HL equ 02ah ; LD HL,(xxxx) .LDHL@ equ 022h ; LD (xxxx),HL .LDA@ equ 032h ; LD (xxxx),A .JP equ 0c3h ; JP xxxx .CALL equ 0cdh ; CALL addr .JPZ equ 0cah ; JP Z,xxxx .EXX equ 0d9h ; EXX .POP.HL equ 0e1h ; POP HL .PUSH.HL equ 0e5h ; PUSH HL .INC.HL equ 023h ; PUSH HL .DEC.HL equ 02bh ; PUSH HL ; skip equ 03eh ; LD A,xx skip.2 equ 001h ; LD BC,xx skip.3 equ 011h ; LD DE,xx _LinLen equ 127 .MaxBuf equ 126 ; Max line input .MaxSamp equ 30 ; Max sample input _Ahead equ 20 ; Size of ahead buffer set.len equ 32 DefWITH equ 2 _Byte equ 1 _Addr equ 2 _Array equ 1 _Record equ 2 _Set equ 3 _Ptr equ 4 _RecF equ 5 _TxtF equ 6 _UntF equ 7 _String equ 8 _Real equ 9 _Integ equ 10 _Bool equ 11 _Char equ 12 _Label equ 1 _Const equ 2 _Type equ 3 _Var equ 4 _Proc equ 5 _Overly equ 7 _Begin equ 8 ; ; Option selection bits ; _Ropt equ 00000010b _Uopt equ 00001000b ; .Iopt equ 0 .Ropt equ 1 .Aopt equ 2 .Uopt equ 3 .Xopt equ 4 .Vopt equ 5 .Bopt equ 6 .Copt equ 7 ; ; Search option list ; _W equ 0 _N equ 1 _U equ 2 _G equ 3 _B equ 4 ; ; Error levels ; _BRK equ 0 ; User break _IO equ 1 ; I/O error _RT equ 2 ; Run time error ; ; BREAK error ; _CBRK equ 1 ; ; Compiler errors ; _ColExp equ 1 _SemiExp equ 2 _CommaExp equ 3 _LftPar equ 4 _RgtPar equ 5 _EquExp equ 6 _AssigExp equ 7 _LftBrExp equ 8 _RgtBrExp equ 9 _DotExp equ 10 _TwoDots equ 11 _BEGINexp equ 12 _NoDO equ 13 _End equ 14 _NoOF equ 15 _SUBexp equ 16 _StrIdx equ 17 _NoDOWN_TO equ 18 _BoolExp equ 20 _FileVarExp equ 21 _IntConst equ 22 _IntExpr equ 23 _IntVarExp equ 24 _IntRealCexp equ 25 _NumExprExp equ 26 _NumVarExp equ 27 _PtrVarExp equ 28 _RecVarExp equ 29 _SimTyp equ 30 _SimpExpr equ 31 _StrgConExp equ 32 _StrgExpExp equ 33 _StrgVarExp equ 34 _MustTextFile equ 35 _TypeExp equ 36 _UntFileExp equ 37 _UnkLabel equ 40 _Undef equ 41 _InkPointer equ 42 _DoubleLab equ 43 _InvType equ 44 _ConstRange equ 45 _IllCASE equ 46 _IllOps equ 47 _InvResult equ 48 _IllStrgLen equ 49 _StrConst equ 50 _IllSkalar equ 51 _IllLimit equ 52 _ResWord equ 53 _IllAss equ 54 _StrConLong equ 55 _IntegErr equ 56 _RealErr equ 57 _IllChar equ 58 _IllConst equ 60 _InvFilPtr equ 61 _NoStruktVar equ 62 _IllTxtFile equ 63 _IllFileType equ 64 _NoUntypeFile equ 65 _InvIO equ 66 _VarFile equ 67 _FileF equ 68 _InvSetOrder equ 69 _IllSetRange equ 70 _IllGOTO equ 71 _IllLabel equ 72 _UndefFORW equ 73 _IllINLINE equ 74 _InvalABS equ 75 _OvlFORW equ 76 _OvlDirErr equ 77 _NoFileErr equ 90 _IllSrcEnd equ 91 _NoOvl equ 92 _CompDirec equ 93 _INCLerr equ 96 _TooManyWITH equ 97 _MemOvfl equ 98 _CompOvfl equ 99 _IndxErr equ 144 _RngErr equ 145 _ABORT equ 202 _FndRTerr equ 200 _DskFull equ 250 ; ; Run-Time errors ; _FLPovfl equ 1 ; 0x01 _DivZero equ 2 ; 0x02 _NegSqrt equ 3 ; 0x03 _LNerr equ 4 ; 0x04 _StrLenErr equ 16 ; 0x10 _TruncOvl equ 146 ; 0x92 _OVLerr equ 240 ; 0xf0 _HeapErr equ 255 ; 0xff ; ; Run-Time I/O errors ; _NoFile equ 1 ; 0x01 _NoRead equ 2 ; 0x02 _NoWrite equ 3 ; 0x03 _BlkErr equ 4 ; 0x04 _IllNum equ 16 ; 0x10 _IllIO equ 32 ; 0x20 _DirErr equ 33 ; 0x21 _StdAssErr equ 34 ; 0x22 _InvRec equ 144 ; 0x90 _SeekEOF equ 145 ; 0x91 _IllEOF equ 153 ; 0x99 _WrErr equ 240 ; 0xF0 _DirFull equ 241 ; 0xF1 _OvflErr equ 242 ; 0xF2 _NoClose equ 255 ; 0xFF TPhead equ 21 ; Header code length for ERROR _Video equ 7 ; Status @DUMMY equ 04d2h l0300 equ 0300h l0800 equ 0800h l07d0 equ 07d0h l00a0 equ 00a0h ; Keypressed l00a3 equ 00a3h ; Read KBD l00a6 equ 00a6h ; Console output l00a9 equ 00a9h ; List output l00ac equ 00ach ; Auxiliary output l00af equ 00afh ; Auxiliary input l00b2 equ 00b2h ; Console output l00b5 equ 00b5h ; Read USR l00b8 equ 00b8h ; Base FIB l00ba equ 00bah ; ConinFIB l00bc equ 00bch ; LstFIB l00be equ 00beh ; AuxFIB l00c0 equ 00c0h ; UsrFIB l00c2 equ 00c2h ; StdIOdev l00c4 equ 00c4h ; Heap pointer l00c6 equ 00c6h ; Recursion pointer l00c8 equ 00c8h ; Four byte random value l00cc equ 00cch ; Base PC l00ce equ 00ceh ; Current PC l00d0 equ 00d0h ; I/O result l00d1 equ 00d1h ; Buffer length l00d2 equ 00d2h ; RTL top of memory l00d4 equ 00d4h ; Current pointer l00d6 equ 00d6h ; Top pointer l00d8 equ 00d8h ; Run mode l00d9 equ 00d9h ; + JP xxxx l00da equ 00dah ; + Restart vector l00dc equ 00dch ; Overlay drive l00dd equ 00ddh ; $C mode l00e0 equ 00e0h ; Video mode l00e8 equ 00e8h ; Pointer ???? l00f4 equ 00f4h ; Available memory l0000 equ 00h l0001 equ 01h l0002 equ 02h l0005 equ 05h l0008 equ 08h l000c equ 0ch l000d equ 0dh l0015 equ 15h l0019 equ 19h l0024 equ 24h l0030 equ 30h l005c equ 5ch l0080 equ 80h l0081 equ 81h l00b0 equ 00b0h l00de equ 0deh l00e2 equ 0e2h l00e4 equ 0e4h l00e6 equ 0e6h l00e9 equ 0e9h l00ea equ 0eah l00ec equ 0ech l00ed equ 0edh l00f0 equ 0f0h l00f2 equ 0f2h l00f6 equ 0f6h l00f8 equ 0f8h lfff3 equ 0fff3h lfffc equ 0fffch lffff equ 0ffffh l0100: jp l20e2 ; Jump over Run Time Library ; ; %%%%%%%%%%%%%%%%%%%%%%%%% ; %%% RUN TIME ROUTINES %%% ; %%%%%%%%%%%%%%%%%%%%%%%%% ; db 0cdh,0abh db 'Copyright (C) 1985 BORLAND Inc',null l0124: db 4 ; CPU speed db 0,0a1h,'B' ; ; &&&&&&&&&&&&&&&&&& ; &&& PATCH AREA &&& ; &&&&&&&&&&&&&&&&&& ; l0128: cp 0fch ; Test special key jp z,l2e8f cp esc ; Test ESCape jp z,l2e8f jp l2e88 ; ds 30 ; l0153: db TermLen db 'Schneider Joyce' TermLen equ $-l0153-1 db '12864' l0168: db 90 ; Screen columns l0169: dw 31 ; Screen lines ; ; Lead in sequence: Leave 24x80 mode ; l016b: db 2,esc,'y' ; db 1bh,'Y ',1,1,1dh db 3,3,1bh,1bh,1bh,0d5h ; ; Lead out sequence: Enter 24x80 mode ; l017b: db 2,esc,'x' ; db 0,0,1ch,0,17h,17h db 1dh,17h,17h,0efh,9eh,0cdh,0bdh l018b: db 4,esc,'Y',0,0 ds 11 ll018b equ $-l018b l019b: db 1 ; Binary indicator (1 is binary) l019c: db ' ' ; Offset for column l019d: db ' ' ; Offset for row l019e: db 4 ; Position of column l019f: db 3 ; Position of row l01a0: dw 0 ; ; Clear display ; l01a2: db 2,esc,'E' ds 3 ; ; Home cursor ; l01a8: db 2,esc,'H' ds 3 ; ; Insert line ; l01ae: db 2,esc,'L' ds 3 ; ; Delete line ; l01b4: db 2,esc,'M' ds 3 l01ba: dw 0 ; ; Clear to end of line ; l01bc: db 2,esc,'K' ds 3 ; ; Turn off inverse ; l01c2: db 2,esc,'q' ds 3 ; ; Turn on inverse ; l01c8: db 2,esc,'p' ds 3 l01ce: dw 0 ; ; Print control string ^HL on console ; C set if control not defined ; l01d0: ld a,(hl) ; Get character or a ; Test defined scf ret z ; Nope as C set says l01d4: inc hl push af push hl ld a,(hl) ; Get character call l01e8 ; Put to console pop hl pop af dec a ret z jr l01d4 ; ; Give new line on console ; l01e1: call l0200 db cr,lf,null ret ; ; Put character on console ; l01e8: ld l,a push hl ; Push onto stack call l00a6 ; Put to console ret ; ; Check character for attribute ; MSB set for normal output ; l01ee: cp MSB ; Test attribute set call c,l026b ; Nope, set invers video call nc,l0284 ; Yeap, set normal video and NOMSB ; Strip off attribute jr l01e8 ; ; Print immediate control string on console ; l01fa: push hl ld hl,l01ee ; Get new output routine jr l0204 ; ; Print immediate string on console ; l0200: push hl ld hl,l01e8 ; Get new output routine l0204: ld (l0213),hl ; Change output vector pop hl ex (sp),hl ; Get pointer to string push af push bc push de l020c: ld a,(hl) ; Get character inc hl or a ; Test end jr z,l0218 ; Yeap push hl l0213 equ $+1 call @DUMMY ; Process output pop hl jr l020c l0218: pop de pop bc pop af ex (sp),hl ret ; ; Delay by value in reg HL ; l021d: ld a,l or h ; Test any value given ret z ; Nope ld a,(l0124) ; Get CPU speed add a,a add a,a add a,a ; Build delay value l0226: ex (sp),hl ; 5 cycles ex (sp),hl ; 10 cycles ex (sp),hl ; 15 cycles ex (sp),hl ; 20 cycles push bc ; 23 cycles ld bc,1234 ; 26 cycles pop bc ; 29 cycles dec a ; 30 cycles jr nz,l0226 dec hl jr l021d ; ; Give control and delay if control defined ; l0235: call l01d0 ; Give control ret c ; Not defined ld hl,(l01ce) ; Get value jr l021d ; Delay ; ; Clear screen ; l023e: push af push bc push de push hl ld hl,l01a8 call l0235 ; Home cursor ld hl,l01a2 l024b: call l01d0 ; Clear display ld hl,(l01ba) call nc,l021d ; Delay if defined pop hl pop de pop bc pop af ret ; ; Delete line ; l0259: push af push bc push de push hl ld hl,l01b4 jr l024b ; Delete line ; ; Insert line ; l0262: push af push bc push de push hl ld hl,l01ae jr l024b ; Insert line ; ; Set low video ; l026b: push af ld a,(l00e0) ; Get video mode or a ; Test low mode already set jr z,l0282 ; Yeap, skip push bc push de push hl xor a ld (l00e0),a ; Set video mode ld hl,l01c8 ; Set attribute l027c: call l0235 ; Give control pop hl pop de pop bc l0282: pop af ret ; ; Set normal video ; l0284: push af ld a,(l00e0) ; Get video mode cp -1 ; Test normal mode already set jr z,l0282 ; Yeap, skip push bc push de push hl ld a,-1 ld (l00e0),a ; Set video mode ld hl,l01c2 ; Reset attribute jr l027c ; ; Erase to end of line ; l0299: push af push bc push de push hl ld hl,l01bc ; Clear to end of line jr l027c ; ; Position cursor with X (column) in reg H and y (row) in reg L ; l02a2: push af push bc push de push hl push hl ld de,l00f0 ld hl,l018b ld bc,ll018b ldir ; Unpack control string pop de ; Get back coordinates ld a,(l019e) ; Get position of column ld c,a ld a,(l019c) ; Get offset for column add a,d ; Build real value push de call l02dc ; Store it pop de ld a,(l019f) ; Get position of row ld c,a ld a,(l019d) ; Get offset for row add a,e ; Build real value call l02dc ; Store it ld hl,l00f0 call l01d0 ; Give control ld hl,(l01a0) ; Get delay value call l021d ; Delay a bit pop hl pop de pop bc pop af ret ; ; Store Accu in position in reg C ; l02dc: ld hl,l00f0 ld b,0 add hl,bc ; Position in string ex de,hl ld hl,l019b inc (hl) ; Test binary dec (hl) jr z,l02ec ; Nope, build ASCII ld (de),a ; Store value ret l02ec: dec de ; Fix for hi ASCII dec de ld hl,l0307+3 ; Point to divisor ld b,3 ; Set length l02f3: dec hl ld c,'0'-1 ; Init ASCII l02f6: inc c ; Fix quotient sub (hl) ; Divide jr nc,l02f6 add a,(hl) ; Build last value push af ld a,c cp '0' ; Test zero jr z,l0302 ; Skip if so ld (de),a ; Store ASCII l0302: inc de pop af djnz l02f3 ret ; l0307: db 1,10,100 ; ; Set lead in ; l030a: ld hl,l016b ; Give lead in jp l0235 ; ; Set lead out ; l0310: ld hl,l017b ; Give lead out jp l0235 ; ; Test key pressed ; EXIT Reg HL holds 1 if key pressed ; l0316: ld de,..const call l035f ; Get state and 1 ; Extract the bit jr l0326 ; ; Read character from console ; EXIT Reg HL holds character ; l0320: ld de,..conin l0323: call l035f ; Get input l0326: ld l,a ; Expand result to 16 bit ld h,0 ret ; ; Read character from auxiliary device ; EXIT Reg HL holds character ; l032a: ld de,..auxin ; Set function jr l0323 ; Do thru BIOS ; ; Write character to list device ; ENTRY Character on stack ; l032f: ld de,..list ; Set function jr l033c ; Do thru BIOS ; ; Write character to auxiliary device ; ENTRY Character on stack ; l0334: ld de,..auxout ; Set function jr l033c ; Do thru BIOS ; ; Write character to console ; ENTRY Character on stack ; l0339: ld de,..conout ; Set function l033c: pop hl pop bc ; Get character push hl ld a,(l00dd) ; Get $C mode or a jr z,l035f ; $C-, so skip testing push de push bc call l00a0 ; Test key pressed ld a,h or l ; Nope jr z,l035d call l03e1 ; Read character cp Xoff ; Test XOFF jr nz,l035d call l03e1 cp CtrlC ; Test abort jp z,l20d4 ; Halt if so l035d: pop bc pop de ; ; Do BIOS internal call ; l035f: ld hl,(OS+1) ; Fetch base vector add hl,de ; Add osffset jp (hl) ; Go ; ; Init TURBO program ; ENTRY Reg HL holds top of RAM ; Reg B holds break mode ; ($C- B=00) ; ($C+ B=FF) ; Reg C holds interrupt mode ; ($U- C=00) ; ($U+ C=rst) ; [rst may be the opcode for the requested ; RST opcode, typically F7 or EF] ; l0364: ld (l00d2),hl ; Save address ld a,b ld (l00dd),a ; Set $C mode ld a,c ; Get $U or a jr z,l037a ; No interrupt ld a,.JP ; Set JP to interrupt ld (@RST),a ld hl,l1ffb ld (@RST+1),hl ; Change vector l037a: ld hl,l03a5 ld de,l00a0 ld bc,ll0018 ldir ; Unpack I/O ld hl,l03bd ld de,l00b8 ld bc,ll000c ldir ; Init FIB xor a ld l,a ld h,a ld (l00d0),a ; Clear I/O error ld (l00d4),hl ; Clear some pointers ld (l00d6),hl ld a,.MaxBuf ld (l00d1),a ; Set buffer length ld (l00e0),a ; Set video mode ret ; ; Character I/O table moved into 0x00A0 ; l03a5: jp l0316 ; 0x00A0 : Keypressed jp l0320 ; 0x00A3 : Read KBD jp l0339 ; 0x00A6 : Console output jp l032f ; 0x00A9 : List output jp l0334 ; 0x00AC : Auxiliary output jp l032a ; 0x00AF : Auxiliary input jp l0339 ; 0x00B2 : Console output jp l0320 ; 0x00B5 : Read KBD ll0018 equ $-l03a5 ; ; Standard IO control table ; l03bd: db 11000001b ; 0x00B8 : Input Output for CON db 0 db 10000010b ; 0x00BA : Input for KBD db 0 db 01000011b ; 0x00BC : Output for LST db 0 db 11000100b ; 0x00BE : Input Output for AUX db 0 db 11000101b ; 0x00C0 : Input Output for USR db 0 db 11000001b ; 0x00C2 : Input Output for CON db 0 ll000c equ $-l03bd ; ; Put chracater to console ; l03c9: push bc push de push hl push ix push iy push af ld l,a ld h,0 push hl call l00a6 ; Put to console pop af l03d9: pop iy pop ix pop hl pop de pop bc ret ; ; Read character from keyboard ; l03e1: push bc push de push hl push ix push iy call l00a3 ; Read KBD ld a,l jr l03d9 ; ; Parse file, allow wildcards ; l03ee: ld c,NOT FALSE ; Set flag jr l03fe ; ; Parse file, wildcards not allowed ; l03f2: ld c,FALSE ld de,(l00d2) ; Get top of memory for input l03f8: inc de ld a,(de) cp ' ' ; Skip blanks jr z,l03f8 l03fe: ld hl,l005c+Fdrv+Fname ld b,Fext call l047b ; Blank extension l0406: ld a,(de) ; Get character call l04a6 ; Convert to upper case cp 'A' ; Test posible drive jr c,l0420 cp 'P'+1 jr nc,l0420 ld b,a ; Save drive inc de ld a,(de) cp ':' ; Verify drive jr nz,l041f ld a,b sub 'A'-1 ; Make binary inc de jr l0421 l041f: dec de l0420: xor a ; Set default drive l0421: ld hl,l005c ld (hl),a ; Save drive inc hl inc c ; Test wildcards allowed dec c jr z,l0443 ; Nope ld a,(de) ; Get character call l0482 ; Test delimiter jr nz,l0443 ; Nope cp '?' ; Test single wildcard jr z,l0443 ; Yeap cp '*' ; Test wildcard jr z,l0443 ; Yeap cp '.' ; Test dot jr z,l0443 ; Yeap ld b,Fname+Fext call l0477 ; Set wildcard jr l0453 ; Go init remainder l0443: ld b,Fname call l045e ; Parse name ld a,(de) cp '.' ; Test extension delimiter jr nz,l0453 ; Nope inc de ld b,Fext call l045e ; Parse extension l0453: ld hl,l005c+_ex ld b,FCBlen-_ex l0458: ld (hl),0 ; Clear remainder of FCB inc hl djnz l0458 ret ; ; Parse B characters ; l045e: ld a,(de) ; Get character inc c ; Test wildcard allowed dec c jr z,l046b ; Nope cp '?' ; Test single wildcard jr z,l0470 ; Save it cp '*' ; Test multiple wildcards jr z,l0476 ; Map them l046b: call l0482 ; Test delimiter jr z,l047b ; Yeap l0470: ld (hl),a ; Store character inc hl inc de djnz l045e ret l0476: inc de ; ; Set B wildcards ; l0477: ld a,'?' ; Set wildcard character jr l047d ; ; Blank B positions in ^HL ; l047b: ld a,' ' l047d: ld (hl),a ; Save character inc hl djnz l047d ret ; ; Test delimiter ; Z set says yes ; l0482: call l04a6 ; Convert to upper case cp ' ' ; Test control jr c,l0496 ; Yeap, it's a delimiter push hl push bc ld hl,l0498 ld bc,ll0498 cpir ; Find in table pop bc pop hl ret l0496: cp a ret ; l0498: db ' .,;:=?*[]<>{}' ll0498 equ $-l0498 ; ; Convert character to UPPER case ; l04a6: cp 'a' ; Test range ret c cp 'z'+1 ret nc sub 'a'-'A' ; Convert to upper case ret ; ; Print hex word in reg HL ; l04af: ld a,h ; Get hi call l04b4 ; Print it ld a,l ; Followed by lo ; ; Print hex byte in Accu ; l04b4: push af rra ; Isolate hi bits rra rra rra call l04bd ; Convert them pop af l04bd: and LoMask ; Mak bits add a,090h ; Dirty trick daa adc a,040h daa jp l03c9 ; Put to console ; ; Get byte from 16 bit ; ENTRY Reg HL holds 16 bit signed integer ; EXIT Accu holds 0 and carry set if HL<0 ; Accu holds -1 and carry reset if HL>256 ; Accu holds low part and carry reset else ; l04c8: xor a scf bit 7,h ; Test sign bit ret nz ; Return 0 and C set if HL<0 ld a,h or a ld a,l ret z ; Return LO if HI=0 ld a,-1 ; Else return -1 ret ; ; Test enough space ; ENTRY Reg HL holds 1st free address ; Reg DE holds last free address ; Reg BC holds top of ram ; Accu holds run mode ; l04d4: ld (l00d8),a ; Re/Set runmode (0 is TP menue) push bc call l1eaf ; Init heap pop bc ld hl,(TPAtop) or a sbc hl,bc ; Test memory available jp c,l20a8 ; Nope, exit ex de,hl pop de ; Get caller ld sp,hl ; Set new stack ld bc,-StkSpc add hl,bc ; Allow some stack space ld (l00c6),hl ; Set recursion pointer xor a ld l,a ld h,a ld (l00ce),hl ; Reset current PC ld (l00dc),a ; Reset overlay drive ld a,.JP ld (l00d9),a ; Init restart ld hl,l20de ld (l00da),hl ; Set error vector ex de,hl ld (l00cc),hl ; Set base PC jp (hl) ; Jump back to caller ; ; Start of recursive procedure or function ; ENTRY Reg BC holds bytes to be preserved ; Reg HL holds address of save area ; l0508: push hl ld hl,(l00c6) ; Get recursion pointer or a sbc hl,bc ; Calculate new pointer ld (l00c6),hl ld de,(l00c4) ; Get heap pointer or a sbc hl,de ; Test against it add hl,de ex de,hl pop hl jp c,l1d75 ; Error if overlapping ldir ret ; ; End of recursive procedure or function ; ENTRY Reg BC holds bytes to be preserved ; Reg DE holds address of save area ; l0522: ld hl,(l00c6) ; Get recursion pointer ldir ; Reload code ld (l00c6),hl ; Update pointer exx ret ; ; Load real into registers ; ENTRY Reg HL points to real variable ; EXIT Regs HL,DE,BC hold number ; l052c: ld e,(hl) ; Get exponent inc hl ld d,(hl) ; Get LSB inc hl push de ld e,(hl) ; Get 4th mantissa byte inc hl ld d,(hl) ; Get 3rd mantissa byte inc hl ld c,(hl) ; Get 2nd mantissa byte inc hl ld b,(hl) ; Get MSB pop hl ret ; ; Move string to stack ; ENTRY Reg HL points to string ; l053a: pop ix ; Get caller ex de,hl ld a,(de) ; Get length of string ld c,a ld b,0 cpl ; Negate ld l,a ld h,-1 add hl,sp ; Fix stack ld sp,hl ex de,hl inc bc ldir ; Move to stack jp (ix) ; Exit ; ; Move immediate string to stack ; ENTRY String started with length after caller ; l054d: pop de ; Get string pointer ld a,(de) ; Get length ld c,a ld b,0 ; Expand for 16 bit cpl ; Negate ld l,a ld h,-1 add hl,sp ; Fix stack ld sp,hl ex de,hl inc bc ldir ; Move to stack jp (hl) ; ; Push set onto stack ; ENTRY Reg HL points to set variable ; Reg C holds set length in bits ; Reg B holds set to be cleared ; l055d: pop ix ; Get caller ex de,hl ld hl,-set.len add hl,sp ; Adjust stack for max set length ld sp,hl ex de,hl push bc inc b ; Test bits to clear dec b jr z,l0570 ; Nope xor a l056c: ld (de),a ; Clear a part inc de djnz l056c l0570: ldir ; Save set on stack pop bc ld a,set.len sub b sub c ; Test remaining bits to clear jr z,l057f ; Nope ld b,a xor a l057b: ld (de),a ; Clear bits inc de djnz l057b l057f: jp (ix) ; ; Initialize a set on stack ; l0581: pop ix ; Get caller ld hl,-set.len add hl,sp ; Fix stack ld sp,hl ld b,set.len ; Set count xor a l058b: ld (hl),a ; Init set inc hl djnz l058b jp (ix) ; ; Init one set element ; ENTRY Reg HL holds set value to be set ; l0591: pop ix ld b,l ; Get value call l05ba ; Get bit l0597: or (hl) ; Insert it ld (hl),a l0599: jp (ix) ; ; Init a contiguous set value ; ENTRY Reg HL holds upper limit ; On stack pushed lower limit ; l059b: pop ix pop de ; Get lower limit ld a,l sub e jr c,l0599 ; Out of range inc a ld c,a ld b,e ; Get low value call l05ba ; Get bit ld e,a ld b,c ; Copy loop value xor a l05ab: or e sla e ; Shift bit jr nc,l05b6 or (hl) ; Insert ld (hl),a inc hl ; Point to next xor a ld e,1 ; Init low bit for next l05b6: djnz l05ab jr l0597 ; Set final one ; ; Access one set bit ; ENTRY Reg B holds numeric value of set element ; EXIT Accu holds bit ; Reg HL points to set loacation ; l05ba: ld a,b ; Get value and 11111000b ; Mask it rrca ; Divide by eight rrca rrca add a,2 ; Fix position for stack ld l,a ld h,0 add hl,sp ; Get position ld a,b and 00000111b ; Mask bits inc a ld b,a xor a scf ; Init 1 l05cd: rla ; Shift bit into correct position djnz l05cd ret ; ; Save real number ; ENTRY Reg HL points to real variable ; Alternative regs HL,DE,BC hold number ; l05d1: push hl ; Save pointer exx ex de,hl ex (sp),hl ; Get back pointer ld (hl),e ; Save exponent inc hl ld (hl),d ; Save LSB inc hl pop de ld (hl),e ; Save 4th mantissa byte inc hl ld (hl),d ; Save 3rd byte inc hl ld (hl),c ; Save 2nd byte inc hl ld (hl),b ; Save MSB ret ; ; Assign string from stack ; ENTRY Reg HL points to string to be assigned ; Reg B holds max length of this string ; l05e2: pop ix ; Get caller ld a,b ; Get max ex de,hl ; Swap pointer ld hl,0 ld b,h add hl,sp ; Fix stack for start of string ld c,(hl) ; Get this length push hl add hl,bc ; Calculate new stack l05ee: inc hl ex (sp),hl cp c ; Test length jr c,l05f4 ld a,c ; Get smaller one l05f4: ld (de),a ; Unpack length inc de inc hl or a ; Test any character jr z,l05fd ; Nope ld c,a ldir ; Unpack if so l05fd: pop hl ld sp,hl jp (ix) ; ; Assign string from stack ; ENTRY Reg B holds max length of string ; l0601: pop ix ; Get caller ld a,b ; Get max ld hl,0 ld b,h add hl,sp ; Fix stack for start of string ld c,(hl) ; Get this length push hl add hl,bc ; Calculate new stack inc hl ld e,(hl) ; Fetch address of string inc hl ld d,(hl) jr l05ee ; Unpack it ; ; Assign set variable ; ENTRY Reg HL points to variable ; Reg BC holds length of set ; l0612: pop ix ; Get caller ex de,hl ld l,b ; Copy length ld h,0 ld b,h add hl,sp ; Point to start location ldir ; Unpack set variable ld hl,set.len l061f: add hl,sp ; Fix stack ld sp,hl jp (ix) ; Exit ; ; Assign set variable ; ENTRY Reg BC holds length of set ; l0623: pop ix ; Get caller ld hl,set.len add hl,sp ; Point to destination ld e,(hl) ; Get it inc hl ld d,(hl) ld l,b ; Copy length ld h,0 ld b,h add hl,sp ; Point to start location ldir ld hl,set.len+2 ; Remember address jr l061f ; Fix stack ; ; Set set to stack ; ENTRY Reg HL holds address of set ; Reg B holds length of set ; l0638: pop ix ; Get caller ex de,hl ; Swap source ld a,b cpl ld l,a ld h,-1 ; Get -length add hl,sp ; Fix stack ld sp,hl ; Set new ld (hl),b ; Set length inc hl ld c,b ; Expand length ld b,0 ex de,hl ; Get back source ldir ; Move to stack jp (ix) ; ; Index check on compiler directive {$R+} ; ENTRY Reg HL holds current index ; Reg DE holds max index ; l064c: or a sbc hl,de ; Verify limit ok add hl,de ret c ; Yeap ld a,_IndxErr jp l2027 ; Else process error ; ; Range check on compiler directive {$R+} ; ENTRY Reg HL holds actual value ; Reg DE holds low limit ; Reg BC holds range of value ; l0656: or a sbc hl,de or a sbc hl,bc ; Test max jr nc,l0661 ; Error add hl,bc ; Restore value add hl,de ret l0661: ld a,_RngErr jp l2027 ; Set error ; ; Set up FOR .. TO loop ; ENTRY Reg DE holds start value ; Reg HL holds end value ; EXIT Reg DE holds loops ; Reg HL holds start value ; l0666: or a sbc hl,de ; Get difference ex de,hl ; Into reg DE l066a: inc de ; Fix loop count jp pe,l0671 ; Check any loop ret p jr l0672 l0671: ret m l0672: ld de,0 ; Set no loop ret ; ; Set up FOR .. DOWNTO loop ; ENTRY Reg DE holds start value ; Reg HL holds end value ; EXIT Reg DE holds loops ; Reg HL holds start value ; l0676: push de ex de,hl or a sbc hl,de ; Get difference ex de,hl pop hl jr l066a ; Build loop ; ; ################## The comparison package ################### ; # TRUE set (=1 on TURBO) if relation matches # ; # # ; # On all relational functions the assignment is as follows: # ; # # ; # INTEGER : DE:HL # ; # REAL : (Regs):(Regs)' # ; # STRING : (Stack):(next_stack) # ; # # ; ############################################################# ; ; ******************************** ; ********** Relation = ********** ; ******************************** ; ; %%%%%%%%%%%%% ; %% INTEGER %% ; %%%%%%%%%%%%% ; l067f: or a sbc hl,de ; Get difference l0682: ld hl,.TRUE ; Init TRUE ret z ; Ok, same dec hl ; Fix for FALSE ret ; ; %%%%%%%%%% ; %% REAL %% ; %%%%%%%%%% ; l0688: call l0bdf ; Compare jr l0682 ; Set result ; ; %%%%%%%%%%%% ; %% STRING %% ; %%%%%%%%%%%% ; l068d: call l09b0 ; Compare jr l0682 ; Set result ; ; ********************************* ; ********** Relation <> ********** ; ********************************* ; ; %%%%%%%%%%%%% ; %% INTEGER %% ; %%%%%%%%%%%%% ; l0692: or a sbc hl,de ; Get difference l0695: ld hl,.TRUE ; Init TRUE ret nz ; Ok, not same dec hl ; Fix for FALSE ret ; ; %%%%%%%%%% ; %% REAL %% ; %%%%%%%%%% ; l069b: call l0bdf ; Compare jr l0695 ; Set result ; ; %%%%%%%%%%%% ; %% STRING %% ; %%%%%%%%%%%% ; l06a0: call l09b0 ; Compare jr l0695 ; Set result ; ; ********************************* ; ********** Relation >= ********** ; ********************************* ; ; %%%%%%%%%%%%% ; %% INTEGER %% ; %%%%%%%%%%%%% ; l06a5: call l0772 ; Check operands l06a8: ld hl,.TRUE ; Init TRUE ret nc ; Ok if .GTE. dec hl ; Else fix for FALSE ret ; ; %%%%%%%%%% ; %% REAL %% ; %%%%%%%%%% ; l06ae: call l0bdf ; Compare jr l06a8 ; Set result ; ; %%%%%%%%%%%% ; %% STRING %% ; %%%%%%%%%%%% ; l06b3: call l09b0 ; Compare jr l06a8 ; Set result ; ; ********************************* ; ********** Relation <= ********** ; ********************************* ; ; %%%%%%%%%%%%% ; %% INTEGER %% ; %%%%%%%%%%%%% ; l06b8: call l0772 ; Check operands l06bb: ld hl,.TRUE ; Init TRUE ret z ; Ok if .EQ. ret c ; Ok if .LT. dec hl ; Else fix for FALSE ret ; ; %%%%%%%%%% ; %% REAL %% ; %%%%%%%%%% ; l06c2: call l0bdf ; Compare jr l06bb ; Set result ; ; %%%%%%%%%%%% ; %% STRING %% ; %%%%%%%%%%%% ; l06c7: call l09b0 ; Compare jr l06bb ; Set result ; ; ******************************** ; ********** Relation > ********** ; ******************************** ; ; %%%%%%%%%%%%% ; %% INTEGER %% ; %%%%%%%%%%%%% ; l06cc: call l0772 ; Check operands l06cf: ld hl,FALSE ; Init FALSE ret z ; Ok if .EQ. ret c ; Ok if .LT. inc hl ; Else fix for TRUE ret ; ; %%%%%%%%%% ; %% REAL %% ; %%%%%%%%%% ; l06d6: call l0bdf ; Compare jr l06cf ; Set result ; ; %%%%%%%%%%%% ; %% STRING %% ; %%%%%%%%%%%% ; l06db: call l09b0 ; Compare jr l06cf ; Set result ; ; ******************************** ; ********** Relation < ********** ; ******************************** ; ; %%%%%%%%%%%%% ; %% INTEGER %% ; %%%%%%%%%%%%% ; l06e0: call l0772 ; Check operands l06e3: ld hl,.TRUE ; Init TRUE ret c ; Ok if .LT. dec hl ; Else fix for FALSE ret ; ; %%%%%%%%%% ; %% REAL %% ; %%%%%%%%%% ; l06e9: call l0bdf ; Compare jr l06e3 ; Set result ; ; %%%%%%%%%%%% ; %% STRING %% ; %%%%%%%%%%%% ; l06ee: call l09b0 ; Compare jr l06e3 ; Set result ; ; ################# End of comparison package ################# ; ; Function SQR(integer):integer; ; ENTRY Reg HL holds number ; EXIT Reg HL holds power ; l06f3: ld d,h ; Copy number ld e,l ; ; Operator * ; Multiply signed integers ; ENTRY Reg DE holds multiplicand ; Reg HL holds multiplier ; EXIT Reg HL holds product ; l06f5: ld c,e ; Copy multiplicand ld b,d ex de,hl ld hl,0 ; Init product ld a,d or a ; Test word ld a,16 jr nz,l0704 ; Yeap, set bit count ld d,e ld a,8 ; Change bit count l0704: add hl,hl ; Do the multiplication ex de,hl add hl,hl ex de,hl jr nc,l070b add hl,bc l070b: dec a jr nz,l0704 ret ; ; Operator DIV ; Divide signed integers ; ENTRY Reg DE holds dividend ; Reg HL holds divisor ; EXIT Reg HL holds quotient ; Reg DE holds remainder ; l070f: ld a,h ; Test zero divisor or l jp z,l0a03 ; Divide by zero ld a,h xor d ; Calculate sign push af call l0780 ; Make both numbers positive ex de,hl call l0780 ex de,hl ld b,h ; Copy divisor ld c,l xor a ld h,a ; Clear result ld l,a ld a,17 ; Set bit count l0726: adc hl,hl ; Perform division sbc hl,bc jr nc,l072e add hl,bc scf l072e: ccf rl e rl d dec a ; Test done jr nz,l0726 ; Nope, loop on ex de,hl pop af ; Get resulting sign ret p jr l0783 ; Negate result ; ; Function RANDOM(integer):integer ; ENTRY Reg HL holds integer limit ; EXIT Reg HL holds random ; l073b: push hl call l0792 ; Get random value srl h ; Make positive, dividing by 2 rr l pop de ex de,hl ; ; Operator MOD ; Get modulo of signed integers ; ENTRY Reg DE holds dividend ; Reg HL holds divisor ; EXIT Reg HL holds remainder ; l0745: call l070f ; HL:=DE DIV HL;DE:=DE MOD HL ex de,hl ; Swap remainder bit 7,d ; Test result ret z jr l0783 ; Negate ; ; Operator SHL ; Shift left number ; ENTRY Reg DE holds number to be shifted ; Reg HL holds shift count ; EXIT Reg HL holds result ; l074e: call l0761 ; Get shift values ret z ; End on zero l0752: add hl,hl ; Shift djnz l0752 ret ; ; Operator SHR ; Shift right number ; ENTRY Reg DE holds number to be shifted ; Reg HL holds shift count ; EXIT Reg HL holds result ; l0756: call l0761 ; Get shift values ret z ; End on zero l075a: srl h ; Shift rr l djnz l075a ret ; ; Set shift values ; ENTRY Reg HL holds number to be shifted ; Reg DE holds shift count ; EXIT Reg B holds shift count ; Zero flag set on nothing to be shifted ; Reg HL may be preset to zero ; l0761: ex de,hl ; Swap factor ld a,d ; Test hi zero value or a jr nz,l076e ; Nope, should be ld a,e cp 16 ; Test max length jr nc,l076e ; Overflow ld b,a or a ret l076e: xor a ld h,a ; Clear result ld l,a ret ; ; Compare signed integers ; ENTRY Reg DE holds 1st number ; Reg HL holds 2nd number ; EXIT Zero flag set if DE=HL ; Carry flag set if DE main_string - no match inc a ; Fix count ld c,a l08ce: push bc push de push hl l08d1: ld a,(de) cp (hl) ; Compare jr z,l08e1 ; Maybe success pop hl pop de pop bc inc hl dec c ; Test more to search jr nz,l08ce ; Ok, then try next l08dc: ld hl,0 ; Set zero result jr l08ef l08e1: inc hl inc de djnz l08d1 ; Loop thru sub_string pop de pop hl pop bc ld hl,0 add hl,sp ; Get pointers ex de,hl sbc hl,de ; Calculate resulting position l08ef: ld sp,iy ; Set stack jp (ix) ; Exit ; ; Procedure DELETE(string,start,length) ; ENTRY Start on stack, followed by string ; Reg HL holds length ; l08f3: pop ix ; Get caller call l04c8 ; Get length byte from integer ld c,a pop hl call l09dd ; Verify length in range 1..255 ld e,a pop hl ; Get start_string ld a,(hl) ; Get length sub e ; Test start > length jr c,l091e ; Exit if so inc c dec c ; Test any length jr z,l091e ; Nope, exit sub c ; Test remaining count jr c,l091c ; Nope, done push af ld a,(hl) sub c ld (hl),a ld b,0 ld d,b add hl,de ; Point to destination ld d,h ld e,l add hl,bc ; Point to source pop af inc a ld c,a ldir ; Unpack jr l091e l091c: dec e ; Adjust length ld (hl),e ; Store it l091e: jp (ix) ; Exit ; ; Procedure INSERT(string,substring,start) ; ENTRY Pointer of substring on stack, followed by string ; Reg HL holds start ; Reg B holds max length of string ; l0920: pop ix ; Get caller call l09dd ; Verify start in range 1..255 ld c,a pop de ; Get sub_string ld (l00e8),de ld hl,0 add hl,sp ; Get string pointer ld a,(de) push af add a,(hl) ; Get combined length jr c,l0937 ; Truncate on overflow cp b ; Compare against max jr c,l0938 ; Ok l0937: ld a,b ; Set max defualt l0938: ld (de),a ; Save combined length pop af ; Get length of substring ld d,a ld e,(hl) sub c ; Get remainder jr c,l096e ; Skip inc a ld l,a ld a,d add a,e jr c,l0949 cp b ld a,l jr c,l0951 l0949: ld a,b sub e jr c,l0973 sub c jr c,l0973 inc a l0951: or a jr z,l0973 push bc push de ld hl,(l00e8) ; Get back sub_string pointer ld e,a dec e ld d,0 ld b,d add hl,de add hl,bc pop de push de push hl ld d,b add hl,de ex de,hl pop hl ld c,a lddr ; Move down pop de pop bc jr l0973 l096e: ld a,d inc a jr z,l098b ld c,a l0973: ld a,b sub c inc a cp e jr c,l097a ld a,e l097a: or a jr z,l098b ld hl,(l00e8) ; Get sub_string pointer ld b,0 add hl,bc ex de,hl ld hl,1 add hl,sp ld c,a ldir ; Move l098b: ld hl,0 ld d,h add hl,sp ; Fix stack ld e,(hl) inc de add hl,de ld sp,hl ; Set stack jp (ix) ; Exit ; ; Check assignment of string to character ; EXIT Reg L holds character ; l0996: pop ix ; Get caller pop hl ; Get length and character dec l ; Verify character only jp nz,l0866 ; Error if not ld l,h ; Unpack character ld h,0 jp (ix) ; Exit ; ; Set character into string ; l09a2: ld hl,2 ld d,h add hl,sp ; Point to string ld e,(hl) ; Get length inc de add hl,de ; Point to top ld a,(hl) ; Get character ld (hl),1 ; Set length inc hl ld (hl),a ; Store character ret ; ; Compare two strings ; ENTRY 1st stack 1st pushed, 2nd stack 2nd pushed ; EXIT Carry flag set if 1st<2nd ; Zero flag set if 1st=2nd ; l09b0: ld hl,2*2 ; Note 2nd level call ld d,h add hl,sp ; Point to 2nd string ld e,(hl) ; Get length ld c,e inc hl push hl add hl,de ; Point to first string ld e,(hl) ; Get length ld b,e inc hl push hl add hl,de ; Set return stack push hl pop iy ; Copy into reg IY pop de ; Get 1st string pop hl ; Get 2nd string l09c4: xor a ; Try zero length cp b jr z,l09cc cp c ; Test on both jr nz,l09d3 ld a,b l09cc: cp c l09cd: pop hl ; Get back callers pop de ld sp,iy ; Set new stack push de ; Set 2nd kevel caller jp (hl) ; Exit l09d3: ld a,(de) cp (hl) ; Compare jr nz,l09cd ; No match inc hl inc de dec b dec c jr l09c4 ; ; Verify value in reg HL in range 1..255 ; l09dd: ld a,h ; Verify < 256 or a jr nz,l09e4 ld a,l or a ; Verify <> 0 ret nz l09e4: ld a,_StrIdx jp l2029 ; ; Function ADD:real ; ENTRY Regs (HL,DE,BC) hold 1st number ; Regs (HL,DE,BC)' hold 2nd number ; EXIT Regs (HL,DE,BC) hold sum ; l09e9: call l0a0d ; Add l09ec: ret nc ; Check result ld a,_FLPovfl jp l2027 ; Set error and abort ; ; Function SUBTRACT:real ; ENTRY Regs (HL,DE,BC) hold 1st number ; Regs (HL,DE,BC)' hold 2nd number ; EXIT Regs (HL,DE,BC) hold difference ; l09f2: call l0a81 ; Subtract jr l09ec ; Check result ; ; Function SQR(real):real ; ENTRY Regs (HL,DE,BC) hold number ; EXIT Regs (HL,DE,BC) hold square ; l09f7: call l0fac ; Copy number, then multiply ; ; Function MULTIPLY:real ; ENTRY Regs (HL,DE,BC) hold multiplicand ; Regs (HL,DE,BC)' hold multiplier ; EXIT Regs (HL,DE,BC) hold product ; l09fa: call l0a97 ; Multiply jr l09ec ; Check result ; ; Function DIVIDE:real ; ENTRY Regs (HL,DE,BC) hold 1st dividend ; Regs (HL,DE,BC)' hold 2nd divisor ; EXIT Regs (HL,DE,BC) hold quotient ; l09ff: exx ; Get divisor ld a,l or a ; Verify not zero exx l0a03: ld a,_DivZero jp z,l2027 ; Error if division by zero call l0af5 ; Divide jr l09ec ; Check result ; ; Add reals ; ENTRY Regs (HL,DE,BC) hold 1st number ; Regs (HL,DE,BC)' hold 2nd number ; EXIT Regs (HL,DE,BC) hold sum ; Carry set on overflow ; l0a0d: exx bit sgn.bit,b ; Test sign of 2nd number exx jp nz,l0a88 ; Subtract if less 0 l0a14: exx ld a,l ; Test 2nd number zero or a exx ret z ; Ok, result is the 1st number exx push bc ; Save 1st number push de push hl exx ld a,l or a ; Test 1st number zero jr nz,l0a27 ; Nope exx res sgn.bit,b ; Clear sign jr l0a7b ; Get 2nd number as result l0a27: push bc set sgn.bit,b ; Force bit set xor a ex af,af' exx set sgn.bit,b ld a,l exx sub l ; Test same exponents jr z,l0a47 ; Yeap jr nc,l0a3c neg ex af,af' dec a ex af,af' exx l0a3c: call l0b7a ; Shift mantissa right inc l ; Bump exponent dec a jr nz,l0a3c ex af,af' jr z,l0a47 exx l0a47: pop af ; Get back mantissa MSB and sign.bit ; Test sign jr nz,l0a5b ; It's negative call l0b92 ; Add mantissas jr nc,l0a76 ; Test bit out call l0b7b ; Rotate mantissa right or a inc l ; Fix exponent jr nz,l0a76 ; Test underflow scf jr l0a7b l0a5b: call l0bc6 ; Compare mantissas ccf push af jr z,l0a72 ; It's same jr c,l0a65 ; It's less exx l0a65: call l0bac ; Subtract mantissas l0a68: bit sgn.bit,b ; Test normalized jr nz,l0a75 ; Yeap call l0b86 ; Shift left dec l jr nz,l0a68 l0a72: call l0b72 ; Zero result l0a75: pop af l0a76: jr c,l0a7a ; Test sign res sgn.bit,b ; Reset if positive l0a7a: or a l0a7b: exx pop hl pop de pop bc exx ret ; ; Subtract reals ; ENTRY Regs (HL,DE,BC) hold 1st number ; Regs (HL,DE,BC)' hold 2nd number ; EXIT Regs (HL,DE,BC) hold difference ; Carry set on overflow ; l0a81: exx bit sgn.bit,b ; Test sign of 2nd number exx jp nz,l0a14 ; Add if less 0 l0a88: call l0a8f ; Negate call l0a14 ; Then add ret c ; ; Negate real ; ENTRY Regs HL,DE,BC hold real number ; EXIT Sign changed if real > 0 ; l0a8f: inc l ; Test exponent zero dec l ret z ; Exit if so ld a,b xor sign.bit ; Change sign bit ld b,a ret ; ; Multiply reals ; ENTRY Regs (HL,DE,BC) hold multiplicand ; Regs (HL,DE,BC)' hold multiplier ; EXIT Regs (HL,DE,BC) hold product ; Carry set on overflow ; l0a97: exx ld a,l or a ; Test zero multiplier exx jp z,l0b72 ; Return 0.0 if so ld a,l or a ret z ; Return if multiplicand zero exx add a,l ; Add exponents exx call l0b4d ; Fix exponent push bc ; Save number push de push hl add ix,sp call l0b72 ; Prepare result exx ld l,mant.len ; Set mantissa count exx l0ab3: ld a,bit.len ; Set bit count inc ix ld l,(ix+0) l0aba: ex af,af' rr l ; Shift bit jr nc,l0ac2 call l0b92 ; Add mantissa if bit out l0ac2: call l0b7b ; Rotate mantissa right ex af,af' dec a ; Go thru all bits jr nz,l0aba exx dec l exx jr nz,l0ab3 ld l,(ix-mant.len) ; Get byte back bit sgn.bit,b ; Test sign jr nz,l0ade ex af,af' call l0b87 ; Get bit inc l dec l jr z,l0ade dec l l0ade: pop af ; Clean stack pop af pop af l0ae1: or a l0ae2: ex af,af' pop af exx pop bc pop hl exx pop ix res sgn.bit,b ; Reset hi bit or b ld b,a ; Insert sign inc l dec l call z,l0b72 ; Clear if underflow ex af,af' ret ; ; Divide reals ; ENTRY Regs (HL,DE,BC) hold 1st dividend ; Regs (HL,DE,BC)' hold 2nd divisor ; EXIT Regs (HL,DE,BC) hold quotient ; Carry set on overflow ; l0af5: ld a,l or a ; Test zero divisor ret z exx sub l ; Get resulting exponent exx ccf call l0b4d ; Fix it push hl push hl push hl add ix,sp exx ld l,mant.len ; Get complete count exx ld a,bit.len ; Set bit count l0b0a: ex af,af' call l0bc6 ; Compare mantissas jr c,l0b13 call l0bac ; Subtract mantissas l0b13: ccf rl l ex af,af' dec a ; Go thru the bits jr nz,l0b26 ld (ix+mant.len),l ; Set result dec ix exx dec l ; Go thru the mantissa exx jr z,l0b32 ; Total end ld a,bit.len ; Reset bit count l0b26: call l0b86 ; Shift left jr nc,l0b0a ex af,af' call l0bac ; Subtract mantissas or a jr l0b13 l0b32: call l0b86 ; Shift left jr c,l0b3b call l0bc6 ; Compare mantissas ccf l0b3b: pop hl pop de pop bc bit sgn.bit,b ; Test bit jr nz,l0b47 call l0b87 ; Shift in jr l0ae1 l0b47: inc l ; Test ok jr nz,l0ae1 scf jr l0ae2 ; ; Fix exponent ; ENTRY Accu and Carry reflect state of addition or ; subtraction of exponents ; l0b4d: jr c,l0b55 ; Test bit out add a,exp.offset ; Add offset jr c,l0b59 ; Test bit jr l0b70 l0b55: add a,exp.offset jr c,l0b70 l0b59: ld l,a ; Set new exponent ex (sp),ix ; Get caller exx push hl push bc ld a,b set sgn.bit,b ; Set bit exx xor b and sign.bit ; Get result push af set sgn.bit,b ; Second, too push ix ; Bring back caller ld ix,0 ; Return IX=0 ret l0b70: pop hl ret c ; ; Clear real number ; EXIT Regs (HL,DE,BC) hold zero ; l0b72: xor a ld l,a ; Clear all involved bytes ld b,a ld c,a ld d,a ld e,a ld h,a ret ; ; Shift mantissa right ; l0b7a: or a ; Clear carry ; ; Rotate mantissa right ; l0b7b: rr b ; Shift 5 bytes right rr c rr d rr e rr h ret ; ; Shift mantissa left ; l0b86: or a ; Clear carry ; ; Rotate mantissa left ; l0b87: rl h ; Shift 5 bytes left rl e rl d rl c rl b ret ; ; Add mantissas ; l0b92: ld a,h ; Get 1st exx ; Then second add a,h ; Add exx ld h,a ; Into 1st ld a,e exx adc a,e exx ld e,a ld a,d exx adc a,d exx ld d,a ld a,c exx adc a,c exx ld c,a ld a,b exx adc a,b exx ld b,a ret ; ; Subtract mantissas ; l0bac: ld a,h ; Get 1st exx ; Then second sub h ; Subtract exx ld h,a ; Into 1st ld a,e exx sbc a,e exx ld e,a ld a,d exx sbc a,d exx ld d,a ld a,c exx sbc a,c exx ld c,a ld a,b exx sbc a,b exx ld b,a ret ; ; Compare mantissas ; l0bc6: ld a,b ; Get 1st exx ; Then second cp b ; Compare exx ret nz ; Exit if .NE. zero ld a,c exx cp c exx ret nz ld a,d exx cp d exx ret nz ld a,e exx cp e exx ret nz ld a,h exx cp h exx ret ; ; Compare two reals ; ENTRY 1st real in register set ; 2nd real in alternative set ; EXIT Carry flag set if 1st<2nd ; Zero flag set if 1st=2nd ; l0bdf: exx ld a,b ; Get sign exx xor b ; Test same signs jp p,l0be9 ; Yeap ld a,b ; Get 1st sign rla ; Calculate result ret l0be9: bit sgn.bit,b ; Test 1st > 0 jr z,l0bf3 ; Yeap call l0bf3 ; Compare ret z ccf ret l0bf3: ld a,l ; Get exponent exx cp l ; Compare exx ret nz ; Not same or a ; Test zero ret z jp l0bc6 ; Compare mantissas ; ; Function INT(real):real ; l0bfd: ld a,l sub Exp.One ; Test >= 1 jp c,l0b72 ; Nope, return 0.0 inc a ; Fix count cp mant.bits ; Test fraction ret nc ; No, that's it exx push bc ; save 2nd push de push hl ex af,af' call l0b72 ; Init result ex af,af' l0c10: scf call l0b7b ; Rotate mantissa right dec a jr nz,l0c10 exx ld a,h ; Mask result exx and h exx ld h,a ld a,e exx and e exx ld e,a ld a,d exx and d exx ld d,a ld a,c exx and c exx ld c,a ld a,b exx and b exx ld b,a l0c31: jp l0a7b ; ; Function FRAC(real):real ; l0c34: exx push bc push de push hl exx call l0fac ; Copy number exx call l0bfd ; Get integer part exx call l0a81 ; Subtract from original number jr l0c31 ; ; Function SQRT(real):real ; l0c46: ld a,l ; Test zero operand or a ret z ; Ok, that's it bit sgn.bit,b ; Verify operand >= 0 ld a,_NegSqrt jp nz,l2027 ; Should be call l0fac ; Copy number ld a,l add a,exp.offset sra a ; Fix resulting exponent add a,exp.offset ld l,a sub sqr.exp ; Fix exponent push af exx l0c5f: push bc push de push hl call l0af5 ; Divide reals call l0a0d ; Add reals dec l ; Exponent - 1 push bc push de push hl call l0a81 ; Subtract reals ld a,l pop hl pop de pop bc exx pop hl pop de pop bc ex (sp),hl cp h ; Test ready ex (sp),hl jr nc,l0c5f ; Loop on pop af exx ret ; ; Function COS(real):real ; l0c7f: exx call l0f8e ; Load constant PI dec l ; Make 90 degrees call l0a81 ; Subtract reals ; ; Function SIN(real):real ; l0c87: exx call l0f8e ; Load constant PI inc l ; Make 360 degrees exx ld a,l cp sin.min ; Test underflow ret c push bc res sgn.bit,b ; Clear sign call l0bdf ; Compare against period pop bc jr c,l0ca3 call l0af5 ; Divide reals call l0c34 ; Get fraction call l0a97 ; Multiply reals l0ca3: bit sgn.bit,b ; Test sign jr z,l0caa call l0a0d ; Add reals l0caa: exx dec l ; Make 180 degrees exx call l0bdf ; Test within 180 degrees push af jr c,l0cb6 call l0a81 ; Subtract reals l0cb6: exx dec l ; Make 90 degrees exx call l0bdf ; Test within 90 degrees jr c,l0cc3 exx inc l ; Make 180 degrees call l0a81 ; Subtract reals l0cc3: ld a,l cp sin.min ; Test underflow jr c,l0d03 exx ld bc,02aaah ; Set 1/3 ld de,0aaaah ld hl,0aa7fh call l0a97 ; Multiply reals (Divide by 3) push ix ld ix,l0d0d-Real.Len ld a,Trg.Len call l0f34 ; Do the TAYLOR loop pop ix call l0fac ; Copy number call l0a97 ; Multiply reals call l0a97 ; Multiply reals push bc push de push hl exx call l0fac ; Copy number dec l ; Divide by 4 dec l exx dec l ; Divide by 2 call l0a0d ; Add reals exx pop hl pop de pop bc exx call l0a81 ; Subtract reals inc l ; Multiply by 4 inc l l0d03: pop af inc l ; Test zero dec l ret z ret c ; Check sign ld a,b xor sign.bit ; Toggle it ld b,a ret ; ; Taylor series for SINE and COSINE ; l0d0d: db 067h,0aah,03fh,02bh,032h,0d7h ; -1/11! db 06eh,0b6h,02ah,01dh,0efh,038h ; 1/9! db 074h,00dh,0d0h,000h,00dh,0d0h ; -1/7! db 07ah,088h,088h,088h,088h,008h ; 1/5! db 07eh,0abh,0aah,0aah,0aah,0aah ; -1/3! Trg.Len equ ($-l0d0d)/Real.Len ; ; Function LN(real):real ; l0d2b: inc l dec l ; Check zero ld a,_LNerr jp z,l2027 ; Error if so bit sgn.bit,b jp nz,l2027 ; If negative, too exx call l0f98 ; Load constant SQRT(2) exx ld a,l ld l,Exp.One ; Fix exponent sub l push af call l0af5 ; Divide reals exx call l0f86 ; Load constant 1.0 exx call l0a81 ; Subtract reals push bc push de push hl exx inc l ; Number times 2 call l0a0d ; Add reals exx pop hl pop de pop bc call l0af5 ; Divide reals push ix ld ix,l0d92-Real.Len ld a,LN.len call l0f34 ; Do the TAYLOR loop pop ix inc l ; Number times 2 exx call l0fa2 ; Load constant LN(2) dec l ; Halve it exx call l0a0d ; Add reals pop af push bc push de push hl ld l,a ld h,0 jr nc,l0d7c dec h ; Set -1 l0d7c: call l1008 ; Convert to real exx inc l ; Number times 2 call l0a97 ; Multiply reals exx pop hl pop de pop bc call l0a0d ; Add reals ld a,l cp ln.min ; Test underflow jp c,l0b72 ; Return 0.0 if so ret ; ; Taylor series for Natural Logarithm ; l0d92: db 07dh,08ah,09dh,0d8h,089h,01dh ; 1/13 db 07dh,0e9h,0a2h,08bh,02eh,03ah ; 1/11 db 07dh,08eh,0e3h,038h,08eh,063h ; 1/9 db 07eh,049h,092h,024h,049h,012h ; 1/7 db 07eh,0cdh,0cch,0cch,0cch,04ch ; 1/5 db 07fh,0abh,0aah,0aah,0aah,02ah ; 1/3 LN.len equ ($-l0d92)/Real.Len ; ; Function EXP(real):real ; l0db6: exx call l0fa2 ; Load constant LN(2) exx or a bit sgn.bit,b push af ; Save sign res sgn.bit,b ; Clear it call l0af5 ; Divide reals ld a,l cp exp.max ; Test overflow jr nc,l0e10 push bc push de push hl inc l ; Times 2 call l0fd0 ; Get integer push hl srl h ; Divide by 2 rr l ld a,l pop hl push af call l1008 ; Back to real inc l ; Test zero dec l jr z,l0de0 dec l ; Fix if not l0de0: exx pop af pop hl pop de pop bc push af call l0a81 ; Subtract reals push ix ld ix,l0e16-Real.Len ld a,EXP.Len call l0f49 ; Do the TAYLOR loop pop ix pop af jr nc,l0e03 push af exx call l0f98 ; Load constant SQRT(2) exx call l0a97 ; Multiply reals pop af l0e03: add a,l ; Build resulting exponent ld l,a jr c,l0e10 ; Overflow pop af ; Test sign ret z exx call l0f86 ; Load constant 1.0 jp l0af5 ; Divide reals (1/number) l0e10: pop hl ld a,_FLPovfl ; Error jp l2027 ; ; Taylor series for natural EXPonetiation ; l0e16: db 06dh,02eh,01dh,011h,060h,031h ; 1.3215 E-6 db 070h,046h,02ch,0feh,0e5h,07fh ; 1.5252 E-5 db 074h,036h,07ch,089h,084h,021h ; 1.5403 E-4 db 077h,053h,03ch,0ffh,0c3h,02eh ; 1.3333 E-3 db 07ah,0d2h,07dh,05bh,095h,01dh ; 9.6181 E-3 db 07ch,025h,0b8h,046h,058h,063h ; 5.5504 E-2 db 07eh,016h,0fch,0efh,0fdh,075h ; 2.4022 E-1 db 080h,0d2h,0f7h,017h,072h,031h ; 6.9314 E-1 EXP.Len equ ($-l0e16)/Real.Len ; ; Function ARCTAN(real):real ; l0e46: ld a,l or a ; Test zero ret z push ix exx call l0f86 ; Load constant 1.0 exx xor a bit sgn.bit,b ; Test sign jr z,l0e58 inc a res sgn.bit,b ; Make absolute l0e58: push af call l0bdf ; Compare against 1.0 jr c,l0e66 exx call l0af5 ; Divide reals (1/number) pop af set sgn.bit,a ; Indicate reverse push af l0e66: exx ld bc,006cfh ; Load 0.13165 ld de,0e98eh ld hl,04a7eh exx call l0bdf ; Compare reals jr nc,l0e7b call l0f2e ; Build TAYLOR series jr l0eca l0e7b: ld ix,l0ee0-3*Real.Len ld a,2 ; Set loop l0e81: ex af,af' exx ld de,3*Real.Len add ix,de call l0f73 ; Get value from table exx call l0bdf ; Compare reals jr c,l0e9c ex af,af' dec a ; Go thru the loop jr nz,l0e81 exx ld de,2*Real.Len add ix,de ; Fix table exx l0e9c: exx call l0f6e ; Get next from table set sgn.bit,b ; Make negative call l0a0d ; Add reals push bc push de push hl call l0f73 ; Get value back call l0a97 ; Multiply reals exx call l0f86 ; Load constant 1.0 call l0a0d ; Add reals exx pop hl pop de pop bc call l0af5 ; Divide reals push ix call l0f2e ; Do TAYLOR pop ix exx call l0f6e ; Get from table call l0a0d ; Add reals l0eca: pop af rla ; Get sign bit jr nc,l0ed8 push af exx call l0f8e ; Load constant PI dec l ; Make 90 degrees call l0a81 ; Subtract reals pop af l0ed8: pop ix bit 1,a ; Test operand sign ret z set sgn.bit,b ; Set negative ret ; ; 2nd Taylor series for ARCTangent ; l0ee0: db 07fh,0e7h,0cfh,0cch,013h,054h ; 4.1421 E-1 db 07fh,0f6h,0f4h,0a2h,030h,009h ; 2.6794 E-1 db 07fh,06ah,0c1h,091h,00ah,006h ; 2.6179 E-1 db 080h,0b5h,09eh,08ah,06fh,044h ; 7.6732 E-1 db 080h,082h,02ch,03ah,0cdh,013h ; 5.7735 E-1 db 080h,06ah,0c1h,091h,00ah,006h ; 5.2359 E-1 db 081h,000h,000h,000h,000h,000h ; 1.0000 db 080h,021h,0a2h,0dah,00fh,049h ; 7.8539 E-1 ; ; Taylor series for ARCTangent ; l0f10: db 07dh,0e8h,0a2h,08bh,02eh,0bah ; -1/11 db 07dh,08eh,0e3h,038h,08eh,063h ; 1/9 db 07eh,049h,092h,024h,049h,092h ; -1/7 db 07eh,0cdh,0cch,0cch,0cch,04ch ; 1/5 db 07fh,0abh,0aah,0aah,0aah,0aah ; -1/3 AT.Len equ ($-l0f10)/Real.Len ; ; Perform TAYLOR series ; Calculate SERIES(x^2)*x ; l0f2e: ld ix,l0f10-Real.Len ld a,AT.Len l0f34: push bc push de push hl push af call l0fac ; Copy number call l0a97 ; Multiply reals [^2] pop af call l0f49 ; Do the TAYLOR loop exx pop hl pop de pop bc jp l0a97 ; Multiply reals ; ; The TAYLOR series loop ; ENTRY Reg IX points to table ; Accu holds loop count ; Calculate : 1-(1/3!)x+..+/-..-(1/11!)x^8 ; l0f49: push af exx call l0f6e ; Load from table jr l0f60 ; Skip addition this time l0f50: push af exx push bc push de push hl call l0f6e ; Get next value from table call l0a0d ; Add reals exx pop hl pop de pop bc exx l0f60: call l0a97 ; Multiply reals pop af dec a ; Test done jr nz,l0f50 ; Nope exx call l0f86 ; Load constant 1.0 jp l0a0d ; Add reals ; ; Load next real from table ; ENTRY Reg IX points to table ; EXIT Regs (HL,DE,BC) hold real ; l0f6e: ld de,Real.Len add ix,de ; Point to nexr ; ; Load real from table ; ENTRY Reg IX points to table ; EXIT Regs (HL,DE,BC) hold real ; l0f73: ld l,(ix+0) ; Get exponent ld h,(ix+1) ; Mantissa LSB ld e,(ix+2) ld d,(ix+3) ld c,(ix+4) ld b,(ix+5) ; Mantissa MSB ret ; ; Load constant 1.0 ; l0f86: ld hl,Exp.One ; Load 6 bytes 2^0 ld b,h ld c,h ld d,h ld e,h ret ; ; Load constant PI=3.141592654 ; l0f8e: ld bc,0490fh ; Load 6 bytes ld de,0daa2h ld hl,02182h ret ; ; Load constant SQRT (2)=1.414213562 ; l0f98: ld bc,03504h ; Load 6 bytes ld de,0f333h ld hl,0fa81h ret ; ; Load constant LN (2)=0.693147181 ; l0fa2: ld bc,03172h ; Load 6 bytes ld de,017f7h ld hl,0d280h ret ; ; Copy real number ; ENTRY Regs (HL,DE,BC) hold number ; EXIT Number copied to alternating regs (HL,DE,BC)' ; l0fac: push bc ; Push onto stack push de push hl exx ; Copy into alternate registers pop hl ; Pop back pop de pop bc ret ; ; Function RANDOM:real; ; EXIT Regs (HL,DE,BC) hold number ; l0fb4: call l0792 ; Get random value ld hl,exp.offset ; Init exponent and count ld a,mant.bits-bit.len l0fbc: bit sgn.bit,b ; Test MSB set jr nz,l0fcd sla e ; Shift left if not rl d rl c rl b dec l ; Count down exponent dec a jr nz,l0fbc ld l,a l0fcd: res sgn.bit,b ; .. make 1.0> x >=0.0 ret ; ; Function ROUND(real):integer ; l0fd0: bit sgn.bit,b ; Attache sign exx call l0f86 ; Load constant 1.0 jr z,l0fda ; Test < 0 set sgn.bit,b ; make constant -1.0 l0fda: dec l ; Set +-0.5 call l0a0d ; Add reals ; ; Function TRUNC(real):integer ; l0fde: or a bit sgn.bit,l ; Test exponent < 0 jr z,l0fff ; Return zero if so bit sgn.bit,b ; Mark sign ex af,af' set sgn.bit,b ; Set bit l0fe8: ld a,int.max cp l jr c,l1003 ; Test overflow jr z,l0ff5 ; Or end of conversion call l0b7a ; Shift mantissa right inc l ; Bump exponent jr l0fe8 l0ff5: call l0b7a ; Shift mantissa right ex af,af' ld h,b ; Get result ld l,c ret z ; End if > 0 jp l0783 ; Negate l0fff: ld hl,0 ; Return 0 ret l1003: ld a,_TruncOvl jp l2027 ; Set error ; ; Convert integer to floating point ; ENTRY Reg HL holds signed integer ; EXIT Regs (HL,DE,BC) hold real ; ; NOTE: ON INTEGER 8000H AND ONLY ON THIS NUMBER ; THIS ROUTINE WILL LOOP FOREVER !!!!!!!! ; l1008: ld a,h ; Test Zero or l jp z,l0b72 ; Set 0.0 if so bit sgn.bit,h ; Test sign ex af,af' call l0780 ; Make number positive ld a,int.max+1 ; Init exponent l1015: add hl,hl ; Shift mantissa dec a ; Fix exponent bit sgn.bit,h ; Test ready jr z,l1015 ; Nope, wait for bit ld b,h ; Get into hi part of mantissa ld c,l ld de,0 ; Clear lo part ld h,d ld l,a ex af,af' ; Test sign ret nz res sgn.bit,b ; Set > 0 ret ; ; Convert real to formatted ASCII string ; ENTRY Reg HL holds fix comma places (-1 on none) ; Reg DE holds decimal places ; Regs (HL,BC,DE)' hold real number ; Reg IX points to ASCII buffer ; l1027: call l04c8 ; Get fix comma places ex de,hl ld e,0 jr c,l1033 ; Integer was < 0, no places cp real.dig+1 ; Test max digits jr c,l104b l1033: dec e call l04c8 ; Get decimal places exx bit sgn.bit,b ; Test sign exx ld d,real.field ; Init field size jr z,l1040 inc d ; Fix for sign < 0.0 l1040: sub d ; Test against field length jr nc,l1044 xor a l1044: cp real.field+2 ; Test max jr c,l104a ld a,real.field+2 l104a: inc a l104b: ld d,a push de exx ld iy,number push ix call l10eb ; Prepare conversion pop ix pop de ld c,a ; Save result exponent ld a,d inc a bit sgn.bit,e ; Test sign jr nz,l1071 ; < 0 add a,c ; Fix exponent jp p,l106b ld (iy),0 ; Clear entry jr l1076 l106b: cp real.ASCII ; Test decimal places jr c,l1071 ld a,real.ASCII-1 ; Truncate it l1071: push de call l1180 ; Normalize ASCII pop de l1076: bit sgn.bit,b ; Test sign jr z,l107f ld a,'-' call l10e5 ; Set sign l107f: bit sgn.bit,e ; Test sign jr z,l1086 ld h,c ; Unpack ld c,0 l1086: bit sgn.bit,c ; Test sign jr z,l108f call l10e3 ; Set 0 jr l1096 l108f: call l10d9 ; Copy ASCII dec c ; Bump down jp p,l108f l1096: ld a,d ; Test mantissa or a jr z,l10b1 ; None ld a,'.' call l10e5 ; Set decimal dot l109f: inc c ; Fix exponent jr z,l10a8 call l10e3 ; Set 0 dec d jr nz,l109f l10a8: dec d jp m,l10b1 call l10d9 ; Copy ASCII jr l10a8 l10b1: bit sgn.bit,e ; Test exponent ret z ; Nope ld a,'E' call l10e5 ; Set 'E'xponent ld a,'+' bit sgn.bit,h ; Test bit jr z,l10c5 ld a,h neg ; Make exponent > 0 ld h,a ld a,'-' l10c5: call l10e5 ; Store sign of exponent ld a,h ; Get exponent ld b,'0'-1 ; Init HI l10cb: inc b ; Fix result sub 10 ; Divide by 10 jr nc,l10cb add a,'9'+1 ; Make remainder ASCII ld (ix),b ; save HI inc ix jr l10e5 ; Store LO ; ; Copy from buffer, set 0 if end ; l10d9: ld a,(iy) ; Get number inc iy or a ; Test end jr nz,l10e5 ; Nope dec iy ; Fix for zero storage ; ; Store ASCII zero into number ; l10e3: ld a,'0' ; Set zero ; ; Store ASCII into number ; l10e5: ld (ix),a ; Store number inc ix ; Update pointer ret ; ; Prepare ASCII for real to formatted ASCII conversion ; ENTRY Reg IY points to ASXII buffer ; Regs (HL,BC,DE) hold real number ; EXIT Buffer pre-filled ; Accu holds exponent equivalent ; l10eb: push iy ; save buffer inc l ; Test zero number dec l jr nz,l10ff ld b,real.ASCII ; Set length l10f3: ld (iy),'0' ; Clear ASCII number inc iy djnz l10f3 xor a jp l117d l10ff: push bc ; Save sign res sgn.bit,b ; Reset sign ld a,l exx sub exp.offset ; Strip off offset ld l,a sbc a,a ; Expand to signed 16 bit ld h,a ld de,ExpFix call l06f5 ; HL:=HL*DE ld de,10 / 2 add hl,de ; Gix exponent ld a,h cp ExpRange ; Test range jr nz,l1119 inc a ; Fix result l1119: ld (iy),a ; Store into buffer neg call l1240 ld a,l cp Exp.One ; Test exponent jr nc,l112c call l12b3 ; Fix mantissa dec (iy) ; Fix exponent l112c: set sgn.bit,b ; Set bit ld a,exp.offset+4 sub l ; Test exponent ld l,0 jr z,l113d l1135: call l0b7a ; Shift mantissa right rr l dec a jr nz,l1135 l113d: ld a,(iy) ; Get exponent push af ld a,real.ASCII ; Set count l1143: ex af,af' ld a,b ; Get MSB rra ; Isolate hi rra rra rra and LoMask ; Mask bits add a,'0' ; Make ASCII ld (iy),a inc iy ld a,b and LoMask ld b,a push bc push de push hl sla l call l0b87 ; Rotate mantissa left *2 sla l call l0b87 ; * 4 ex de,hl ex (sp),hl add hl,de ; * 5 pop de ex (sp),hl adc hl,de ex de,hl pop hl ex (sp),hl adc hl,bc ld b,h ld c,l pop hl sla l call l0b87 ; *10 ex af,af' dec a jr nz,l1143 pop af pop bc l117d: pop iy ret ; ; Normalize ASCII number ; ENTRY Accu holds length of number ; l1180: push iy pop hl ; Copy buffer ld e,a ld d,0 add hl,de ld a,(hl) ; Get last digit ld (hl),0 cp '5' ; Test to be normalized ret c ; Nope l118d: dec e ; Count down jp m,l119c dec hl ; Get previous ld a,(hl) inc a ; Advance digit ld (hl),a cp '9'+1 ; Test in range ret c ; Yeap ld (hl),0 ; Clear this one jr l118d l119c: ld (hl),'1' ; Set carry inc hl ld (hl),0 ; Clear next inc c ret ; ; Convert ASCII string to Floating Point number ; ENTRY Reg IX points to ASCII number ; EXIT Regs HL,DE,BC hold real ; Carry set indicates conversion error ; l11a3: exx ld bc,0 ; Reset flags exx call l0b72 ; Init 0.0 l11ab: ld a,(ix) ; Get character call l04a6 ; Convert to upper case cp '.' ; Test decimal point jr nz,l11c1 exx bit dot.bit,b ; Test already selected scf ret nz ; Error if so set dot.bit,b ; Indicate dot exx l11bd: inc ix ; Skip character jr l11ab ; Get next l11c1: cp 'E' ; Test exponent jr z,l11e6 ; Yeap, process it call l1239 ; Test digit jr nc,l121e ; Nope ex af,af' call l12b3 ; Convert mantissa ret c ; Error ex af,af' exx push bc ld l,a ; Build integer ld h,0 call l1008 ; Convert to floating point call l09e9 ; Add reals exx pop bc ret c ; End if overflow bit dot.bit,b ; Test decimal point jr z,l11e3 dec c ; Fix length if so l11e3: exx jr l11bd ; ; Found 'E'xponent ; l11e6: call l121e ; Fix mantissa ret c ; Overflow exx set exp.bit,b ; Set bit inc ix ld a,(ix) cp '+' ; Test any sign jr z,l11fc ; Skip plus cp '-' jr nz,l11fe set exps.bit,b ; Indicate negative exponent l11fc: inc ix l11fe: call l1236 ; Get 1st digit ccf ret c ; Invalid ld c,a inc ix call l1236 ; Get 2nd digit jr nc,l1215 ; Only one inc ix ld d,a ld a,c ; Get first one - it's tens add a,a ; * 2 add a,a ; * 4 add a,c ; * 5 add a,a ; *10 add a,d ; Insert 2nd ld c,a l1215: bit exps.bit,b ; Test exponent < 0 jr z,l121d ; Nope ld a,c neg ; Change it if so ld c,a l121d: exx l121e: exx ld a,c ; Get exponent add a,exp.offset ; Set offset cp 05ah ; Check range ret c ; Underflow cp 0a6h ccf ret c ; Overflow push bc push ix ld a,c call l1240 ; Fix exponent pop ix exx pop bc ; Fix stack exx ret ; ; Get character and test if digit ; ENTRY Reg IX points to character ; EXIT Accu holds character ; Carry reset if in range ; l1236: ld a,(ix) ; Get character ; ; Test character a digit - C set if so ; ENTRY Accu holds character ; EXIT Carry reset if in range ; l1239: sub '0' ; Strip off offset ccf ret nc ; Out of range cp 9+1 ret ; ; Fix exponent for real to ASCII conversion ; ENTRY Accu holds exponent equivalent ; EXIT Real fixed ; l1240: push af ; Save exponent or a ; Test sign jp p,l1247 neg ; Make >0 l1247: push af srl a ; Shift srl a inc a ; Then fix ld hl,-Real.Len ; Init index ld de,Real.Len l1253: add hl,de ; Fix index dec a jr nz,l1253 ex de,hl ld ix,l1277 ; Point to table add ix,de call l0f73 ; Get number from table pop af and 11b ; Get MOD 4 jr z,l126e l1266: push af call l12b3 ; Fix mantissa pop af dec a jr nz,l1266 l126e: pop af ; Get back exponent or a jp p,l0a97 ; Multiply reals if > 0 exx jp l0af5 ; Divide reals if < 0 ; ; Fix up table ; l1277: db 081h,000h,000h,000h,000h,000h ; 1 E 0 db 08eh,000h,000h,000h,040h,01ch ; 1 E 4 db 09bh,000h,000h,020h,0bch,03eh ; 1 E 8 db 0a8h,000h,010h,0a5h,0d4h,068h ; 1 E12 db 0b6h,004h,0bfh,0c9h,01bh,00eh ; 1 E16 db 0c3h,0ach,0c5h,0ebh,078h,02dh ; 1 E20 db 0d0h,0cdh,0ceh,01bh,0c2h,053h ; 1 E24 db 0deh,0f9h,078h,039h,03fh,001h ; 1 E28 db 0ebh,02bh,0a8h,0adh,0c5h,01dh ; 1 E32 db 0f8h,0c9h,07bh,0ceh,097h,040h ; 1 E36 ; ; Fix mantissa for real to ASCII conversion ; ENTRY Regs (BC,DE,HL) hold real ; EXIT Real fixed ; l12b3: ld a,l ; Test exponent or a ret z ; Zero set _MB,b ; Set bit push bc push de ld a,h call l0b7a ; Shift mantissa right call l0b7a ; Two places add a,h ; Add LSB ld h,a ex (sp),hl ; Get middle part adc hl,de ; Add it ex de,hl pop hl ex (sp),hl adc hl,bc ; Same for hi part ld b,h ; Copy to high ld c,l pop hl ; Get back old hi jr nc,l12d6 call l0b7b ; Rotate mantissa right inc l ; Fix exponent scf ret z l12d6: ld a,l add a,3 ; Fix exponent ld l,a res _MB,b ; Clear bit ret ; ; Test sets not equal (<>) ; ENTRY Both sets on stack ; EXIT Reg HL holds boolean result ; l12dd: ld c,.TRUE ; Set flag jr l12e3 ; Compare ; ; Test sets equal (=) ; ENTRY Both sets on stack ; EXIT Reg HL holds boolean result ; l12e1: ld c,FALSE l12e3: call l133f ; Get sets l12e6: ld a,(de) cp (hl) ; Compare jr nz,l12f2 ; Not equal inc hl inc de djnz l12e6 ld a,c xor .TRUE ; Zoggle flag if equal ld c,a l12f2: ld hl,2*set.len add hl,sp ; Fix stack ld sp,hl ld l,c ; Get state ld h,0 jp (ix) ; Exit ; ; Test two sets included (1st in 2nd, <=) ; ENTRY Both sets on stack ; EXIT Reg HL holds boolean result ; l12fc: ld c,.TRUE ; Set flag jr l1302 ; ; Test two sets included (2nd in 1st, >=) ; ENTRY Both sets on stack ; EXIT Reg HL holds boolean result ; l1300: ld c,FALSE l1302: call l133f ; Get sets dec c ; Test comparision mode jr nz,l1309 ex de,hl l1309: ld c,FALSE l130b: ld a,(de) or (hl) ; Combine cp (hl) ; Compare jr nz,l12f2 inc hl inc de djnz l130b ld c,.TRUE ; Return TRUE jr l12f2 ; ; Combine two sets (add, +) ; ENTRY Both sets on stack ; EXIT Combined set on stack ; l1318: call l133f ; Get sets l131b: ld a,(de) or (hl) ; Combine sets ld (hl),a inc hl inc de djnz l131b l1322: ex de,hl ld sp,hl jp (ix) ; ; Combine two sets (subtract, -) ; ENTRY Both sets on stack ; EXIT Combined set on stack ; l1326: call l133f ; Get sets l1329: ld a,(de) cpl ; Complement and (hl) ; Mask bits ld (hl),a inc hl inc de djnz l1329 jr l1322 ; ; Combine two sets (intersection, *) ; ENTRY Both sets on stack ; EXIT Combined set on stack ; l1333: call l133f ; Get sets l1336: ld a,(de) and (hl) ; Mask ld (hl),a inc hl inc de djnz l1336 jr l1322 ; ; Get addresses of sets ; ENTRY Both sets on stack ; EXIT Regs HL and DE point to sets ; Reg IX holds caller address ; Reg B holds set length ; l133f: pop iy ; Get last caller pop ix ; Get caller before last one ld hl,0 add hl,sp ex de,hl ; Get 1st set ld hl,set.len ld b,l ; Get length add hl,sp ; Get 2nd set jp (iy) ; Return ; ; Test element in set (IN) ; ENTRY Both sets on stack ; EXIT Reg HL holds boolean result ; l134f: pop ix ; Get caller ld hl,set.len+1 add hl,sp ; Get pointer to set ld a,(hl) or a ; Test any set jr z,l135c xor a jr l1362 ; Force FALSE l135c: dec hl ld b,(hl) call l05ba ; Get bit state and (hl) l1362: ld hl,set.len+2 add hl,sp ld sp,hl ; Set return stack ld hl,FALSE ; Init FALSE jr z,l136d ; Test result inc hl ; Set TRUE l136d: jp (ix) ; ; Procedure ASSIGN(file,filename) ; ENTRY Filenname as string on stack ; FIB followed string ; ; Assign text file ; l136f: db skip ; Set non zero ; ; Assign (un)typed file ; l1370: xor a ; Set zero ld (l00e8),a ; Put into mode pop iy ; Get back caller ld hl,(l00d2) ; Get top of memory ld b,16 ; And max length call l05e2 ; Assign string from stack xor a ld (de),a ; Close it pop hl ; Fetch FIB ld (l00e2),hl ; Put into device push iy ; Bring back caller ld a,h ; Verify not standard but file or a jr nz,l1390 ld a,_StdAssErr ; Set illegal FIB ld (l00d0),a ret l1390: ld a,(l00e8) ; Get back mode or a ; Test text file jr z,l13a0 ; Nope call l13b6 ; Find standard device jr nz,l13a0 ; Nope ld hl,(l00e2) ; Get back FIB ld (hl),a ; Set flag ret l13a0: call l03f2 ; Parse file ld hl,(l00e2) ld (hl),0 ld de,FIB.FCB add hl,de ; Point to FCB part ex de,hl ld hl,l005c ld bc,FCBlen ldir ; Move FCB to FIB ret ; ; Find standard IO device ; ENTRY TOPRAM filled with device string ; EXIT Zero flag set if device found ; Accu holds FIB flag if so ; l13b6: ld b,Std.Len ; Init length ld hl,l13e6 ; Get table address l13bb: push bc push hl ld b,Std.Itm-1 ; Set length of one item ld de,(l00d2) ; Get top of memory l13c3: inc de ld a,(de) cp ' ' ; Skip leading blanks jr z,l13c3 l13c9: ld a,(de) ; Get character call l04a6 ; Convert to upper case sub (hl) ; Compare jr z,l13da ; Maybe a hit pop hl pop bc ld de,Std.Itm add hl,de ; Point to next entry djnz l13bb ; Try more or a ret l13da: inc hl inc de djnz l13c9 ; Loop until all found pop bc pop bc ld a,(de) cp ':' ; Verify standard device ret nz ld a,(hl) ; Get flag if so ret ; ; Standard character I/O devices ; l13e6: db 'CON' db 11000001b ; Input output for CON Std.Itm equ $-l13e6 db 'TRM' db 11000001b ; Input output for TRM db 'KBD' db 10000010b ; Input for KBD db 'LST' db 01000011b ; Output for LST db 'AUX' db 11000100b ; Input output for AUX db 'USR' db 11000101b ; Input output for USR Std.Len equ ($-l13e6) / Std.Itm ; ; Prepare files ; ENTRY Reg HL points to FIB ; ; Procedure REWRITE(text_file) ; l13fe: db skip ; ; Procedure RESET(text_file) ; l13ff: xor a ld (l00e8),a ; Set mode (0=RESET) call l1469 ; Close open file ld a,(l00d0) or a ; Test error ret nz ; End if so ld hl,(l00e2) ; Get FIB res wr.bit,(hl) ; Reset write flag ld a,(hl) and FIBtype ; Get type ret nz ; Exit on standard device call l1430 ; Prepare file operation ld a,(l00d0) or a ; Test error ret nz ; Exit if so ld hl,(l00e2) ; Get back FIB ld a,(l00e8) ; Get file mode or a ; Test RESET ld bc,RecLng*256+..in jr z,l142b ; Yeap ld bc,0*256+..out l142b: ld (hl),c ; Set flag inc hl inc hl ld (hl),b ; Set buffer pointer ret ; ; Prepare file operation for current FIB ; l1430: call l145a ; Clear FCB of this FIB ld hl,(l00e2) ; Get FIB ld de,FIB.FCB add hl,de ; Point to FCB ex de,hl ld a,(l00e8) ; Get file mode or a ; Test RESET ld bc,_NoFile*256+.open jr z,l144e ; Yeap, go open file push de ld c,.delete call BDOS ; Delete file before rewrite pop de ld bc,_DirFull*256+.make l144e: push bc call BDOS ; Now open or make file pop bc inc a ; Test success ret nz ; Yeap ld a,b ld (l00d0),a ; Set error if not ret ; ; Clear FCB of current FIB ; l145a: ld hl,(l00e2) ; Get FIB ld de,FIB.FCB+_ex add hl,de ; Point to EX filed ld b,FCBlen-_ex ; Set length l1463: ld (hl),0 ; Clear it inc hl djnz l1463 ret ; ; Close text file ; ; Procedure CLOSE(text_file) ; ; ENTRY Reg HL holds FIB ; l1469: ld (l00e2),hl ; Save FIB for current device ld a,(hl) and FIBtype ; Get type ret nz ; Exit if not a file bit out.bit,(hl) ; Test output jr z,l147e ; Skip if not ld a,eof call l16c6 ; Close file by EOF call l170c ; Then flash buffer jr l1481 l147e: bit in.bit,(hl) ; Test input ret z ; Nope, end l1481: ld hl,(l00e2) ; Get FIB push hl ld de,FIB.FCB add hl,de ; Point to FCB ex de,hl ld c,.close call BDOS ; Close file pop hl inc a ; Test success jr nz,l1498 ; Yeap ld a,_NoClose ld (l00d0),a ; Set error l1498: ld (hl),0 ; Reset FIB flag ret ; ; Set standard device ; l149b: ex (sp),hl ld (l00e4),hl ; Save caller ex (sp),hl push hl ld hl,l00c2 ld (l00e2),hl ; Set standard as FIB pop hl ret ; ; Check file before read ; ENTRY Reg HL points to FIB ; l14a9: ex (sp),hl ld (l00e4),hl ; Save caller for error ex (sp),hl ld (l00e2),hl ; Save FIB bit in.bit,(hl) ; Test read allowed ret nz ; Yeap ld a,_NoRead ld (l00d0),a ; Set error ret ; ; Check file before write ; ENTRY Reg HL points to FIB ; l14ba: ex (sp),hl ld (l00e4),hl ; Save caller for error ex (sp),hl ld (l00e2),hl ; Save FIB bit out.bit,(hl) ; Test write allowed ret nz ; Yeap ld a,_NoWrite ld (l00d0),a ; Set error ret ; ; Function READLN(var) ; ENTRY Reg HL points to variable ; l14cb: db skip ; ; Function READ(var) ; ENTRY Reg HL points to variable ; EXIT Reg HL points to variable ; l14cc: xor a ex (sp),hl ; Get caller ld (l00e4),hl ; Save it ex (sp),hl push hl ld hl,l00c2 ld (l00e2),hl ; Set standard device res wr.bit,(hl) ; Reset write bit push af ; Save mode call l14e8 ; Read a line pop af or a ; Test READLN jr z,l14e6 call l01e1 ; Give new line if so l14e6: pop hl ret ; ; Read a line from keyboard ; l14e8: ld b,0 ; Reset flag l14ea: ld hl,l00d1 ; Point to buffer length ld a,(hl) ; Get buffer length cp .MaxBuf+1 ; Verify in range jr c,l14f4 ld a,.MaxBuf ; Truncate if not l14f4: ld c,a ld (hl),.MaxBuf ; Set default length ld hl,(l00d2) ; Get top of memory ld (l00d4),hl ; Unpack it l14fd: ld d,0 ; Reset character count l14ff: call l03e1 ; Read character ld (hl),a ; Unpack it ld e,1 ; Init flag cp bs ; Test backspace jr z,l153f cp DEL ; Test delete jr z,l153f dec e cp CtrlX ; Test ^X jr z,l153f cp esc ; Test escape jr z,l153f cp eof ; Test end of file jr z,l1550 cp cr ; Test end of line jr z,l1556 cp ' ' ; Test printable jr nc,l1533 cp CtrlC ; Test ^C jr nz,l14ff ld a,(l00dd) ; Get $C mode or a ; Test abort jr z,l14ff ; $C- - so ignore ld ix,(l00e4) jp l2016 ; Abort ; ; Found printable character ; l1533: ld a,c ; Get max cp d ; Test against count jr z,l14ff ; Yeap, ignore ld a,(hl) ; Get character inc d ; Advance counter inc hl ; Point to next storage location call l03c9 ; Put to console jr l14ff ; ; Special control detected: Backspace, DELete, ^X, ESCape ; l153f: dec d ; Fix count jp m,l14fd ; Ignore if at 1st position dec hl call l0200 ; Position cursor left db bs,' ',bs db null dec e ; Test backspace or delete jr z,l14ff ; Yeap jr l153f ; Else delete two characters on screen ; ; Found EOF ; l1550: inc b ; Test flag dec b jr z,l14ff ; Ignore input jr l155a ; Close input line ; ; Found CR ; l1556: inc b ; Test flag dec b jr nz,l155e ; Ignore EOF l155a: ld (hl),eof ; Close line jr l1566 l155e: call l01e1 ; Give new line ld (hl),cr ; Close line inc hl ld (hl),lf l1566: inc hl ld (l00d6),hl ; Set top pointer ret ; ; Get character from file or console buffer ; l156b: ld hl,(l00e2) ; Get FIB ld a,(l00d0) or a ; Test error jr nz,l15ed ; Force EOF if so ld a,(hl) bit wr.bit,a ; Test preread jr nz,l15e9 ; Fetch if so and FIBtype ; Test device jr nz,l15ab ; Yeap, standard I/O inc hl ; Point to sector buffer inc hl ld a,(hl) or a ; Test filled jp p,l1597 ; Not yet ld c,.rdseq push hl call l19ba ; Read sector pop hl jr z,l1595 ; Read was successfull push hl ld de,FIB.buff-2 add hl,de ; Point to buffer ld (hl),eof ; Set EOF pop hl l1595: xor a ld (hl),a ; Reset buffer pointer l1597: inc (hl) ; Bump pointer add a,FIB.buff-2 ld e,a ld d,0 add hl,de ; Calculate current buffer ld a,(hl) cp eof ; Test EOF jr nz,l15e0 ; Nope ld hl,(l00e2) inc hl inc hl dec (hl) ; Fix pointer if eof found jr l15e0 l15ab: dec a ; Test CON: jr nz,l15c9 ld hl,(l00d4) ; Get current ppinter ld de,(l00d6) ; Get top pointer or a sbc hl,de ; Test more in buffer jr c,l15bf ; Ok ld b,-1 call l14ea ; Else get more l15bf: ld hl,(l00d4) ; Get current pointer ld a,(hl) inc hl ; Bump ld (l00d4),hl jr l15e0 l15c9: dec a ; Test KBD: jr nz,l15d2 call l00a3 ; Read KBD ld a,l jr l15e0 l15d2: dec a ; Test AUX: dec a jr nz,l15dc call l00af ; Get from auxiliary ld a,l jr l15e0 l15dc: call l00b5 ; Read USR ld a,l l15e0: ld hl,(l00e2) ; Get back FIB set wr.bit,(hl) ; Set preread flag inc hl ld (hl),a ; Save character dec hl ret l15e9: inc hl ; Point to character buffer ld a,(hl) ; Get character dec hl ret l15ed: ld a,eof ; Return EOF ret ; ; Get character from current device ; Fix up controls ; l15f0: push hl ld hl,(l00e2) ; Get FIB ld a,(hl) and FIBtype ; Get device cp RAMdevice ; Test RAM jr z,l1622 l15fb: call l156b ; Get character from device cp ' '+1 ; Test control jr nc,l160a ; Nope cp eof ; Test EOF jr z,l160a ; Yeap res wr.bit,(hl) ; Reset preread jr l15fb ; Then synchronize l160a: ld de,Number ; Set buffer ld b,.MaxSamp ; Set max l160f: push bc push de call l156b ; Get character from device pop de pop bc cp ' '+1 ; Test control jr c,l1620 ; Yeap, end if so res wr.bit,(hl) ; No preread ld (de),a ; save character inc de djnz l160f l1620: xor a ld (de),a ; Close buffer l1622: pop hl ret ; ; Check negative sign of ASCII number ; ENTRY Location NUMBER filled ; EXIT Reg IX points to number buffer ; Reg B holds 0 on no negative sign ; and 1 on negative sign found ; Zero flag indicates empty buffer ; l1624: ld ix,Number ; Init pointer ld a,(ix) ; Get character or a ret z ; Exit if zero ld b,0 cp '-' ; Test negative sign ret nz ; Nope inc b ; Fix result inc ix ; Skip pointer ret ; ; Fix number conversion for error ; ENTRY Reg IX points behind number ; Carry set reflects overflow ; EXIT Carry set indicates error ; IORESULT set to error 010H ; l1636: jr c,l163d ; Fall into error ld a,(ix) ; Test correct end or a ret z ; Yeap l163d: ld a,_IllNum ld (l00d0),a ; Set error scf ret ; ; Get character from input READ(char) ; ENTRY Reg HL points to character variable ; l1644: push hl ; Save pointer call l156b ; Get character res wr.bit,(hl) ; Reset preread pop hl ; Get back pointer ld (hl),a ; Save character ret ; ; Get byte from input READ(byte) ; ENTRY Reg HL points to byte variable ; l164d: db skip ; Set byte flag ; ; Get integer from input READ(integer) ; ENTRY Reg HL points to integer variable ; l164e: xor a ; Reset byte flag ld c,a push bc call l15f0 ; Get number input pop bc call l1624 ; Test sign ret z ; Empty number, exit push bc push hl call l07f7 ; Convert ASCII to integer pop de pop bc call l1636 ; Test error ret c ; Yeap, exit dec b ; Test negative sign call z,l0783 ; Negate if so ex de,hl ld (hl),e ; Save low or byte inc c dec c ; Test byte jr nz,l1670 ; Skip if so inc hl ld (hl),d ; Save high on integer l1670: ex de,hl ret ; ; Get real from input READ(real) ; ENTRY Reg HL points to real variable ; l1672: call l15f0 ; Get ASCII number call l1624 ; Test sign ret z ; Empty number, exit push bc push hl call l11a3 ; Convert to real exx pop hl pop bc call l1636 ; Test error ret c ; Yeap, exit dec b ; Test negative sign exx call z,l0a8f ; Negate if so exx jp l05d1 ; Save real number ; ; Get string from input READ(string[max]) ; ENTRY Reg HL points to string variable ; Reg B holds max characters in string ; l168e: push hl ; Save pointer ex de,hl ld c,0 ; Clear character count l1692: push bc push de call l156b ; Get character pop de pop bc cp cr ; Test end of line jr z,l16a8 cp eof ; Test end of file jr z,l16a8 res wr.bit,(hl) ; Reset preread inc c ; Advance count inc de ; Advance pointer ld (de),a djnz l1692 l16a8: pop hl ; Get back pointer ld (hl),c ; Set length ret ; ; Handle end of line after READLN from file ; l16ab: call l156b ; Get character cp eof ; Test end of file jr z,l16c5 res wr.bit,(hl) ; Reset preread cp lf ; Test new line jr z,l16c5 cp cr ; Wait for end of line jr nz,l16ab call l156b cp lf ; Maybe new line jr nz,l16c5 res wr.bit,(hl) ; Reset preread if so l16c5: ret ; ; Output character to device ; ENTRY Accu holds character ; l16c6: ld hl,(l00e2) ; Get FIB ld c,a ; Save character ld a,(l00d0) or a ; Test I/O error ret nz ; Exit if so ld a,(hl) ; Get type and FIBtype ; Test device jr nz,l16e4 ; Yeap inc hl ; Point to sector buffer inc hl push hl ld a,(hl) ; Get pointer add a,FIB.buff-2 ld e,a ld d,0 add hl,de ; Make pointer absolute ld (hl),c ; Save character pop hl inc (hl) ; Advance count ret p ; Still in range jr l170c ; Write record l16e4: cp RAMdevice ; Test store to RAM jr z,l16fd ; Yeap pop hl ld b,0 push bc push hl dec a ; 1=CON: jp z,l00a6 ; Put to console dec a ; 3=LST: dec a jp z,l00a9 ; Put to printer dec a ; 4=AUX: jp z,l00ac ; Put to auxiliary ; 5=USR: jp l00b2 ; Put to console l16fd: ld hl,(l00e8) ; Get string pointer ld a,(l00ea) ; Get max length cp (hl) ; Test in range ret z ; Nope, exit inc (hl) ; Bump count ld e,(hl) ld d,0 add hl,de ; Build address ld (hl),c ; Store character ret ; ; Write sector to file if any item in buffer ; l170c: ld hl,(l00e2) ; Get FIB inc hl inc hl ld a,(hl) ; Get record pointer or a ; Test any in buffer ret z ; Nope, exit ld (hl),0 ; Clear pointer ld c,.wrseq call l19ba ; Write record ret z ; Ok, no errr ld a,_WrErr ld (l00d0),a ; Set error ret ; ; Write character to device ; WRITE(char) ; ENTRY Reg L holds character ; l1722: ld a,l ; Get character jp l16c6 ; Put it ; ; Write integer to device ; WRITE(int) ; WRITE(int:m) ; ENTRY Integer on stack ; Reg HL holds digit count (zero without count) ; l1726: pop bc pop de push bc ld ix,(l00d2) ; Get top of memory for buffer bit sgn.bit,h ; Test sign of count jr z,l1737 ; >= 0 call l0783 ; Negate ex de,hl ; Swap values jr l1745 l1737: ex de,hl bit sgn.bit,h ; Test sign of number jr z,l1745 ; >= 0 call l0783 ; Negate ld (ix),'-' ; Init sign inc ix l1745: push de call l07c6 ; Convert integer to ASCII l1749: pop hl call l04c8 ; Get byte from integer ld de,(l00d2) ; Get back top of memory push ix pop hl or a sbc hl,de ; Calculate length of string ld c,l ex de,hl l1759: sub c ; Test against count jr c,l176a ; Ignore if out of range jr z,l176a ld b,a ; Save count push hl l1760: ld a,' ' push bc call l16c6 ; Blank leading places pop bc djnz l1760 pop hl l176a: ld b,c ; Get back length inc b l176c: dec b ret z ld a,(hl) push bc push hl call l16c6 ; Type digits pop hl pop bc inc hl jr l176c ; ; Formatted write ; WRITE(real) ; WRITE(real:n) ; WRITE(real:n:m) ; ENTRY Reg HL holds fix comma places (-1 on none) ; Stack holds decimal places and real ; (Without decimal places defaults to 24) ; l1779: pop bc pop de ; Get places exx pop hl ; Get number pop de pop bc exx push bc ld ix,(l00d2) ; Get top of memory for buffer push de call l1027 ; Convert real to ASCII jr l1749 ; ; Boolean write ; WRITE(bool) ; WRITE(bool:m) ; ENTRY Reg HL holds places (0 on none) ; Stack holds boolean ; l178b: pop bc pop de ; Get boolean push bc call l04c8 ; Get byte from integer bit _LB,e ; Test bit ld hl,l17a1 ld c,l17a1.l jr nz,l1759 ; It is TRUE ld hl,l17a5 ld c,l17a5.l jr l1759 ; Tell FALSE ; l17a1: db 'TRUE' l17a1.l equ $-l17a1 l17a5: db 'FALSE' l17a5.l equ $-l17a5 ; ; String and formatted character write ; WRITE(string) ; WRITE(string:m) ; WRITE(char:m) ; ENTRY Reg HL holds places (0 on none) ; Stack holds string (chracter=string with length=1) ; l17aa: call l04c8 ; Get byte from integer for places ld hl,2 add hl,sp ; Fix stack ld c,(hl) ; Get length inc hl call l1759 ; Print right justified pop de ; Get back caller ld sp,hl ; Reset stack push de ret ; ; Immediate string write ; WRITE('string') ; ENTRY Stack holds string starting with length ; l17ba: pop hl ; Get pointer to string ld a,(hl) ; Get length inc hl or a ; Test any jr z,l17cc ld b,a ; save length if so l17c1: ld a,(hl) ; Get character push bc push hl call l16c6 ; Write it pop hl pop bc inc hl djnz l17c1 l17cc: jp (hl) ; ; Give new line ; WRITELN{...} ; l17cd: ld a,cr call l16c6 ; Give return ld a,lf jp l16c6 ; Followed by line feed ; ; The logical delimiter functions ; Function SEEKEOLN(device):boolean ; ENTRY Reg HL points to FIB ; EXIT Reg HL holds TRUE or FALSE ; l17d7: ld de,1*256+cr ; Set CR jr l17e9 ; ; Function EOLN(device):boolean ; l17dc: ld de,cr jr l17e9 ; ; Function SEEKEOF(device):boolean ; l17e1: ld de,1*256+eof ; Set EOF jr l17e9 ; ; Function EOF(device):boolean ; l17e6:: ld de,eof l17e9: ld (l00e2),hl ; Set device bit in.bit,(hl) ; Test input possible jr z,l180c ; Nope l17f0: push de call l156b ; Get character pop de cp e ; Test end found jr z,l1808 ; Yeap cp eof ; Test end of file jr z,l1808 ; Force TRUE if so cp ' '+1 ; Test control jr nc,l180c ; Nope inc d ; Test control to be checked dec d jr z,l180c ; Yeap res wr.bit,(hl) ; Reset preread jr l17f0 l1808: ld hl,.TRUE ; Return TRUE ret l180c: ld hl,FALSE ; Return FALSE ret ; ; Prepare typed files ; Procedure REWRITE(typed_file) ; ENTRY Reg HL points to FIB ; Reg DE holds length of record ; l1810: db skip ; ; Procedure RESET(typed_file) ; l1811: xor a ld (l00e8),a ; Set mode (0=RESET) ld (l00e6),de ; Save record length call l187a ; Close file ld a,(l00d0) ; Test error or a ret nz ; End if so call l1430 ; Set up FIB ld a,(l00d0) ; Test error or a ret nz ; End if so ld hl,(l00e2) ; Init FIB flag ld (hl),..in+..out+..read inc hl inc hl ld (hl),a ; Init record pointer ld de,FIB.cur-2 add hl,de ; Point to current record ld (hl),a ; Clear it inc hl ld (hl),a ld de,FIB.FCB+_rrn-FIB.cur-1 add hl,de ; Point to random record ld (hl),a ; Clear it inc hl ld (hl),a ld de,FIB.rec-FIB.FCB-_rrn-1 add hl,de ; Point to FIB record ld a,(l00e8) or a ; Test mode jr nz,l1864 ; Skip RESET ; ; Perform RESET ; push hl ld bc,FixRecLen ; Set four bytes xor a call l1909 ; Prepare read pop hl inc hl inc hl ld c,(hl) ; Point to max records inc hl ld b,(hl) ld hl,(l00e6) or a sbc hl,bc ; Test agianst tem in file ret z ; Correct value ld a,_InvRec ld (l00d0),a ; Set error ret ; ; Perform REWRITE ; l1864: push hl xor a ld (hl),a ; Clear record inc hl ld (hl),a inc hl ld de,(l00e6) ; Fetch length ld (hl),e ; Store into FIB inc hl ld (hl),d pop hl ld bc,FixRecLen ld a,Rec.New+Rec.Wr jp l1909 ; Prepare write ; ; Procedure CLOSE(typed_file) ; ENTRY Reg HL points to FIB ; l187a: ld (l00e2),hl ; Save FIB ld a,(hl) ; Get state and ..in+..out ; Test any action ret z ; Nope call l19ae ; Write record if requested ld hl,(l00e2) ; Get FIB ld de,FIB.FCB+_rrn add hl,de ; Point to random recird xor a ld (hl),a ; Clear it inc hl ld (hl),a ld de,-FIB.FCB-_rrn+1 add hl,de ; Point to record ld (hl),a ; Clear it inc hl inc hl ld bc,FixRecLen ld a,Rec.Wr call l1909 ; Prepare write call l19ae ; Write if requested jp l1481 ; Close file ; ; Prepare write to record file ; ENTRY Reg HL points to FIB ; l18a4: ex (sp),hl ld (l00e4),hl ; Save caller ex (sp),hl ld (l00e2),hl ; Save FIB ld a,(hl) and ..in+..out ; Test I/O allowed ret nz ; Yeap l18b0: ld a,_BlkErr ld (l00d0),a ; Set error ret ; ; Get structure from input READ(type) ; ENTRY Reg HL points to FIB ; l18b6: ld a,(l00d0) ; Get error or a ; Test previous ret nz ; Yeap push hl call l1a5a ; Get record data ex de,hl or a sbc hl,de ; Test against last record pop hl jr nc,l18d6 ; Error xor a call l1909 ; Read l18ca: ld hl,(l00e2) ; Get back FIB ld de,FIB.cur add hl,de inc (hl) ; Bump record ret nz inc hl inc (hl) ret l18d6: ld a,_IllEOF ld (l00d0),a ; Set error ret ; ; Put structure to output WRITE(type) ; ENTRY Reg HL points to FIB ; l18dc: ld a,(l00d0) ; Get error or a ; Test previous ret nz ; Yeap push hl call l1a5a ; Get record data or a sbc hl,de ; Test same size ld a,Rec.Wr jr nz,l18fc ld hl,(l00e2) ld de,FIB.rec add hl,de ; Point to record inc (hl) ; Bump it jr nz,l18fa inc hl inc (hl) jr z,l1902 ; Overflow error l18fa: ld a,Rec.New+Rec.Wr l18fc: pop hl call l1909 ; Execute write jr l18ca l1902: pop hl ld a,_OvflErr ld (l00d0),a ; Set error ret ; ; Perform record IO ; ENTRY Reg HL points to FIB record field ; Reg BC holds record length ; (Four on CLOSE, RESET and REWRITE) ; Accu holds code : ; 0 : On RESET and READ ; 1 : On CLOSE and WRITE ; 3 : On WRITE and REWRITE ; l1909: ld (l00e9),a ; Save code ex de,hl l190d: ld hl,(l00e2) ; Get FIB bit rd.bit,(hl) ; Test known buffer jr z,l1943 ; Nope res rd.bit,(hl) ; Reset bit ld a,(l00e9) ; Get mode bit Rec.Wr.bit,a ; Test write jr z,l1935 ; Nope, so read inc hl inc hl ld a,(hl) ; Get record pointer dec hl dec hl or a jr nz,l1935 ; Not empty, so read ld a,(l00e9) ; Get code bit Rec.New.bit,a ; Test new jr nz,l1943 ; Yeap ld a,b ; Get counter or a jr nz,l1943 ld a,c ; Test new or a jp m,l1943 l1935: push bc push de ld c,.rndrd call l19ba ; Read record pop de pop bc jr nz,l1991 ; Error return ld hl,(l00e2) ; Get back FIB l1943: ld a,(l00e9) ; Get mode bit Rec.Wr.bit,a ; Test write allowed jr z,l194c ; Nope set wr.bit,(hl) ; Set bit l194c: inc hl inc hl ld a,(hl) ; Get pointer to buffer add a,FIB.buff-2 push de ld e,a ld d,0 add hl,de ; Get address of buffer pop de sub FIB.buff-2 ; Reset pointer call l199a ; Swap pointer l195c: ldi ; Move bytes jp po,l1966 ; Test done inc a ; Bump pointer jp p,l195c ; Test done dec a l1966: inc a call l199a ; Swap back ld hl,(l00e2) ; Get FIB inc hl inc hl and NOMSB ; Test remainder in buffer ld (hl),a jr nz,l198a ; Yeap push bc push de push hl call l19ae ; Write record pop hl pop de pop bc jr nz,l1994 ; Error return push de ld de,FIB.FCB+_rrn-2 add hl,de ; Point to record pop de inc (hl) ; Advance it jr nz,l198a inc hl inc (hl) l198a: ld a,b ; Test all done or c jp nz,l190d ; Nope ex de,hl ret l1991: ld a,_IllEOF db skip.2 l1994: ld a,_WrErr ld (l00d0),a ; Set error ret ; ; Swap record pointers on request ; ENTRY Reg HL and DE hold pointer ; EXIT Register swapped on write selected ; l199a: push af ld a,(l00e9) ; Get mode bit Rec.Wr.bit,a ; Test selection jr z,l19a3 ex de,hl ; Swap l19a3: pop af ret ; ; Force record write ; Procedure FLUSH(type) ; ENTRY Reg HL holds FIB ; l19a5: ld (l00e2),hl ; Save FIB call l19ae ; Write if possible ret z jr l1994 ; Set error ; ; Write random record if select, set read ; l19ae: ld c,.rndwr ; Set OS function ld hl,(l00e2) ; Get FIB set rd.bit,(hl) ; Set read bit bit wr.bit,(hl) ; Test write ret z ; Nope res wr.bit,(hl) ; Reset and write ; ; Execute file function ; ENTRY Reg C holds file function ; EXIT Zero flag reflects state of function ; Accu holds BDOS code ; l19ba: ld hl,(l00e2) ; Load FIB push hl push bc ld de,FIB.buff add hl,de ; Point to buffer ex de,hl ld c,.setdma call BDOS ; Set disk buffer pop bc pop hl ld de,FIB.FCB add hl,de ; Point to FCB ex de,hl call BDOS ; Execute OS function or a ; Build result ret ; ; Procedure SEEK(file,record) ; ENTRY Reg HL holds record seeked for ; FIB pushed onto stack ; l19d5: pop bc pop de ld (l00e2),de ; Save FIB push bc push hl call l1a5a ; Get FIB data pop de or a sbc hl,de ; Test record less size jr c,l1a26 ; Error if so ld hl,(l00e2) ; Get FIB ld bc,FIB.reclen ; Point to length of record add hl,bc ld c,(hl) ; Get record inc hl ld b,(hl) inc hl ld (hl),e ; Save record number inc hl ld (hl),d call l1a2c ; Multiply it ld bc,FixRecLen add hl,bc ; Adjust for header jr nc,l19fe inc de l19fe: ld a,l and NOMSB ; Get record pointer add hl,hl ; * 2 ex de,hl adc hl,hl ex de,hl ld d,e ; / 256 ld e,h ld hl,(l00e2) ; Get FIB inc hl inc hl ld (hl),a ; Store record pointer ld bc,FIB.FCB+_rrn-2 add hl,bc ; Point to random record ld c,(hl) ; Get it inc hl ld b,(hl) ex de,hl or a sbc hl,bc ; Test record already set add hl,bc ret z ; Yeap push de push hl call l19ae ; Write record pop de pop hl ld (hl),d ; Set current record dec hl ld (hl),e ret l1a26: ld a,_SeekEOF ld (l00d0),a ; Set error ret ; ; Multiply record number by record length ; ENTRY Reg BC holds length of record ; Reg DE holds number of record ; EXIT Reg HL holds the product of both ; l1a2c: push de ; Copy number exx pop hl ; Get copy exx ld hl,0 ; Init result ld d,h ld e,l ld a,16 ; Set bit length l1a37: add hl,hl ; Shift result ex de,hl adc hl,hl ; Treat as 32 bit number ex de,hl exx add hl,hl ; Shift number exx jr nc,l1a45 add hl,bc ; Fix for carry jr nc,l1a45 inc de l1a45: dec a jr nz,l1a37 ; Loop on ret ; ; Function EOF(device):boolean (untyped) ; l1a49:: call l1a5d ; Get size of file or a sbc hl,de ; Test end ld hl,FALSE ret nz ; Return FALSE if not inc hl ; Fix for TRUE ret ; ; Get record position of file ; Function FILEPOS(file):integer ; ENTRY Reg HL holds FIB ; EXIT Reg HL holds current record ; l1a55: call l1a5d ; Get size of file ex de,hl ; Into integer result ret ; ; Get record data of file ; EXIT Reg HL holds size of file ; Reg DE holds current record ; Reg BC holds record length ; l1a5a: ld hl,(l00e2) ; Load FIB ; ; Get size of file ; Function FILESIZE(file):integer ; ENTRY Reg HL holds FIB ; EXIT Reg HL holds size of file in terms of records ; Reg DE holds current record ; Reg BC holds length of record ; l1a5d: ld de,FIB.rec add hl,de ; Point to records ld e,(hl) ; Get number of records inc hl ld d,(hl) inc hl push de ld c,(hl) ; Get record length inc hl ld b,(hl) inc hl ld e,(hl) ; Get current record inc hl ld d,(hl) pop hl ret ; ; Prepare untyped files ; Procedure REWRITE(un_typed_file) ; ENTRY Reg HL points to FIB ; l1a6f: db skip ; ; Procedure RESET(un_typed_file) ; l1a70: xor a ld (l00e8),a ; Save mode (0=RESET) call l1ab0 ; Close open file ld a,(l00d0) or a ; Test error ret nz ; Exit if so call l1430 ; Fix FIB ld a,(l00d0) or a ; Test error ret nz ; Exit if so ld hl,(l00e2) ; Get FIB ld (hl),..in+..out ; Set flag push hl ld de,FIB.FCB add hl,de ; Point to FCB ex de,hl ld c,.filsiz call BDOS ; Get size of file pop hl ld de,FIB.FCB+_rrn add hl,de ; Point to size xor a ld c,(hl) ; Get size ld (hl),a ; Reset size inc hl ld b,(hl) ld (hl),a ld de,FIB.rec-FIB.FCB-_rrn-1 add hl,de ; Point to recird number ld (hl),c ; Set it inc hl ld (hl),b inc hl ld (hl),RecLng ; Set standard record inc hl ld (hl),a inc hl ld (hl),a ; Init current record inc hl ld (hl),a ret ; ; Close untyped file ; ENTRY Reg HL holds FIB ; ; Procedure CLOSE(un_typed_file) ; l1ab0: ld (l00e2),hl ; Save FIB ld a,(hl) ; Get mode and ..in+..out ; Test access ret z ; Nope jp l1481 ; Close it ; ; Write block to untyped file ; Procedure BLOCKWRITE(file,buffer,count) ; ENTRY Reg HL holds number of records to be written ; On stack FIB and buffer ; l1aba: ld a,.rndwr ; Set function code jr l1ac0 ; ; Read block from untyped file ; Procedure BLOCKREAD(file,buffer,count) ; ENTRY Reg HL holds number of records to be read ; On stack FIB and buffer ; l1abe: ld a,.rndrd ; Set function code l1ac0: ld b,h ; Copy count ld c,l ld hl,l00f0 ; Point to scratch ld (l00e6),hl ; Set for record pop ix pop de ; Get buffer pop hl ; Get FIB push ix push bc call l1afd ; Execute block I/O pop bc ld a,(l00d0) or a ; Test error ret nz ; Exit if so ld hl,(l00f0) sbc hl,bc ; Test all records processed ret z ; Yeap ld a,(l00e9) ; Get file function cp .rndrd ; Test read ld a,_IllEOF jr z,l1ae9 ld a,_WrErr l1ae9: ld (l00d0),a ; Set error code accordingly ret ; ; Write block to untyped file ; Procedure BLOCKWRITE(file,buffer,count,result) ; ENTRY Reg HL points to result ; On stack FIB, buffer and number of records ; l1aed: ld a,.rndwr ; Set function jr l1af3 ; ; Rad block from untyped file ; Procedure BLOCKREAD(file,buffer,count,result) ; ENTRY Reg HL points to result ; On stack FIB, buffer and number of records ; l1af1: ld a,.rndrd ; Set function l1af3: ld (l00e6),hl ; Save result pointer pop ix pop bc ; Get count pop de ; Get buffer pop hl ; Get FIB push ix ; ; Perform block IO ; ENTRY Accu holds file function ; Reg HL holds FIB ; Reg DE holds buffer ; l1afd: ld (l00e9),a ; Save function ld (l00e2),hl ; Save FIB ld a,(hl) ; Get mode and ..in+..out ; Test IO allowed jp z,l18b0 ; Nope ld hl,(l00e6) ; Get record address xor a ld (hl),a ; Clear record inc hl ld (hl),a l1b10: ld a,b or c ; Test all done jr z,l1b4d ; Yeap push bc push de ld c,.setdma call BDOS ; Set disk buffer ld hl,(l00e2) ; Get back FIB ld de,FIB.FCB add hl,de ; Point to FCB ex de,hl ld a,(l00e9) ; Get file function ld c,a call BDOS ; Execute I/O pop de pop bc or a ; Test result jr nz,l1b4d ; Not good push de ld hl,(l00e2) ; Get FIB again ld de,FIB.FCB+_rrn add hl,de ; Point to record inc (hl) ; Advance record jr nz,l1b3c inc hl inc (hl) l1b3c: pop de ld hl,RecLng add hl,de ; Advance buffer ex de,hl ld hl,(l00e6) inc (hl) ; Advance record count jr nz,l1b4a inc hl inc (hl) l1b4a: dec bc ; Count down requested length jr l1b10 l1b4d: ld hl,(l00e2) ; Get FIB ld de,FIB.FCB+_rrn add hl,de ; Point to last record ld c,(hl) inc hl ld b,(hl) ld de,FIB.cur-FIB.FCB-_rrn-1 add hl,de ; Point to FIB record ld (hl),c ; Save record number inc hl ld (hl),b ld de,-FIB.rec add hl,de ; Point to record ld d,(hl) dec hl ld e,(hl) ex de,hl or a sbc hl,bc ; Test against last record ret nc ex de,hl ld (hl),c ; Save new max record inc hl ld (hl),b ret ; ; Procedure SEEK(file,record) ; ENTRY Reg HL holds record seeked for ; FIB pushed onto stack ; l1b6f: pop bc pop de ld (l00e2),de ; Save FIB push bc push hl call l1a5a ; Get record data pop de or a sbc hl,de ; Test position jp c,l1a26 ; Error if overflow ld hl,(l00e2) ; Get FIB ld bc,FIB.cur add hl,bc ld (hl),e ; Save new position inc hl ld (hl),d ld bc,FIB.FCB+_rrn-FIB.cur-1 add hl,bc ld (hl),e ; Save in FCB, too inc hl ld (hl),d ret ; ; Delete file ; Procedure ERASE(file) ; ENTRY Reg HL holds FIB ; l1b93: call l1c4c ; Check legal FIB ret nz ; Nope ld de,FIB.FCB add hl,de ; Point to FCB ex de,hl ld c,.delete call BDOS ; Delete file inc a ret nz jr l1be4 ; Set error if unknown ; ; Rename file ; Procedure RENAME(file,newname) ; ENTRY FIB and name on stack ; l1ba5: pop iy ld hl,(l00d2) ; Get top of memory for buffer ld b,16 ; Set max call l05e2 ; Assign string from stack xor a ld (de),a pop hl ; Load FIB push iy call l1c4c ; Check legal FIB ret nz ; Nope push hl call l03f2 ; Parse file pop hl push hl ld de,FIB.FCB+DIRlen add hl,de ; Point to 2nd FCB ex de,hl ld hl,l005c ld bc,Fdrv+Fname+Fext ldir ; Move new name pop hl ld de,FIB.FCB add hl,de ; Point to FCB push hl ex de,hl ld c,.rename call BDOS ; Rename pop de inc a ; Test success jr z,l1be4 ; Nope ld hl,l005c ld bc,FCBlen ldir ; Unpack new file ret l1be4: ld a,_NoFile ; Set error l1be6: ld (l00d0),a ret ; ; Perform executing new programs ; Procedure EXECUTE(File) ; ENTRY Reg HL points to FIB ; l1bea: db skip ; ; Procedure CHAIN(File) ; l1beb: xor a ld (l00e8),a ; Set mode (0=CHAIN) call l1c4c ; Test device ok ret nz ; Nope ld a,(l00d8) ; Test run mode or a ld a,_DirErr jr z,l1be6 ; Must *NOT* be direct mode ld hl,(l00e2) ; Get FIB ld de,FIB.FCB add hl,de ; Point to FCB ld de,l005c ld bc,FCBlen ldir ; Move to standard FCB ld de,l005c ld c,.open call BDOS ; Open file inc a jr z,l1be4 ; File not found ld hl,l1c33 ; Point to loader ld de,l00b0 ld bc,l0019 ldir ; Move loader to temporary location ld de,TPA ; Init loader address ld a,(l00e8) ; Test mode or a jr nz,l1c2d ld de,(TPA+1) ; Change address for CHAIN l1c2d: ld sp,TPA ; Get local stack jp l00b0 ; Go load ; ; ############### Start of loader ############### ; ; Loader will be moved into 00B0H temporary loaction ; l1c33: .phase l00b0 .l1c33: push de ld c,.setdma call BDOS ; Set disk buffer ld de,l005c ld c,.rdseq call BDOS ; Read a code record pop de ld hl,RecLng add hl,de ; Bump address ex de,hl or a ; Test more jr z,.l1c33 jr TPA ; Start after loading l0019 equ $-.l1c33 .dephase ; ; ################ End of loader ################ ; ; Check legal device for file operation ; ENTRY Reg HL points to FIB ; EXIT Zero flag set if legal device ; If illegal, IOerror 20H will be set ; l1c4c: ld (l00e2),hl ; Save FIB ld a,(hl) ; Get flag and FIBtype ; Mask it ret z ; 0000 menas file ld a,_IllIO ld (l00d0),a ; Set error ret ; ; Load overlay file ; ENTRY Reg HL holds record procedure starts with ; Reg DE holds number of records to be read ; ; Overlay call follows: ; 2 Bytes hold last sector read ; 11 Bytes NAME.EXT of file ; n*128 Bytes record(s) ; l1c59: ld (l00e6),hl ; Save record ld (l00e8),de ; Save record count ex de,hl pop hl ld (l00e2),hl ; Save caller ld c,(hl) ; Fetch last sector ld (hl),e ; Set new one inc hl ld b,(hl) ld (hl),d ex de,hl ; Compare bew:old or a sbc hl,bc jr z,l1cca ; Overlay already in memory ex de,hl inc hl ld de,l005c ld a,(l00dc) ; Get overlay drive ld (de),a ; Store into standard FCB inc de ld bc,Fname+Fext ldir ; Move name to standard FCB ld b,FCBlen-_ex xor a l1c82: ld (de),a ; Clear remainder of FCB inc de djnz l1c82 push hl ; Save address of buffer ld de,l005c ld c,.open call BDOS ; Open file pop de ; Get back buffer address inc a ; Test success jr z,l1cd2 ; Nope ld hl,(l00e6) ; Get start record ld (l005c+_rrn),hl ; Set for random record ld bc,(l00e8) ; Get record count l1c9d: push bc push de ld c,.setdma call BDOS ; Set disk buffer ld de,l005c ld c,.rndrd call BDOS ; Read from file pop de pop bc or a ; Verify no error jr nz,l1cd2 ; Error ld hl,(l005c+_rrn) inc hl ; Bump record ld (l005c+_rrn),hl ld hl,RecLng add hl,de ; Get next address ex de,hl dec bc ld a,b ; Test done or c jr nz,l1c9d ; Nope ld de,l005c ld c,.close call BDOS ; Close file l1cca: ld hl,(l00e2) ; Get caller ld de,2+Fname+Fext add hl,de ; Skip header jp (hl) ; Enter overlay l1cd2: ld ix,(l00e2) ; Get caller's PC ld a,_OVLerr jp l2029 ; Abort ; ; Procedure OVRDRIVE(drive) ; ENTRY Reg HL holds drive (1=A, 2=B, etc) ; l1cdb: call l04c8 ; Get byte from integer cp 'P'-'@'+1 ; Test max ret nc ; Exit on range error ld (l00dc),a ; Set overlay drive ret ; ; Procedure NEW(pointer) ; Procedure GETMEM(pointer,space) ; ENTRY Reg HL holds space required ; Variable pointer on stack ; l1ce5: ld (l00f0),hl ; Save space required ex de,hl pop hl ex (sp),hl ld (l00f2),hl ; Save address of variable inc de inc de inc de ld a,e and -HeapLen ; Get modulo 4 ld e,a ld hl,l00de ld (l00f8),hl ; Init pointer ld ix,(l00de) ; Get pointer to 1st free address l1cff: ld l,(ix+HeapLOlen) ld h,(ix+HeapHIlen) ld a,l ; Test assignment or h jr z,l1d51 ; Maybe free sbc hl,de ; Test gap jr nc,l1d1c ld l,(ix+HeapLOadr); Get next address ld h,(ix+HeapHIadr) push hl ld (l00f8),ix ; Save last address pop ix ; Copy chain jr l1cff l1d1c: jr nz,l1d28 ; Not same gap length ld e,(ix+HeapLOadr); Get address if so ld d,(ix+HeapHIadr) push ix jr l1d43 ; Save state l1d28: ld c,l ; Copy length ld b,h ld l,(ix+HeapLOadr); Get address ld h,(ix+HeapHIadr) l1d30: push ix ; Save pointer add ix,de ; Advance ld (ix+HeapLOadr),l; Set start values ld (ix+HeapHIadr),h ld (ix+HeapLOlen),c ld (ix+HeapHIlen),b push ix pop de ; Copy pointer l1d43: ld hl,(l00f8) ; Get pointer ld (hl),e ; Set new link inc hl ld (hl),d pop de ld hl,(l00f2) ld (hl),e ; Set into vriable inc hl ld (hl),d ret l1d51: push ix pop hl add hl,de ld (l00c4),hl ; Set new heap pointer ld hl,(l00f0) ; Get space ld bc,HeapLen add hl,bc ; Get complete length push ix pop bc add hl,bc jp c,l1d75 ; Error if overlapping ld bc,(l00c6) ; Get recursion pointer sbc hl,bc ; Test against it ld bc,0 ld hl,0 jp c,l1d30 ; ; Heap error ; l1d75: ld a,_HeapErr jp l2027 ; Set error ; ; Procedure DISPOSE(pointer) ; Procedure FREEMEM(pointer,space) ; ENTRY Reg HL holds space ; Variable pointer on stack ; l1d7a: ex de,hl ; Save space pop hl ex (sp),hl ; Get variable pointer ld a,(hl) ; Get dynamic pointer inc hl ld h,(hl) ld l,a inc de ; Fix space inc de inc de ld a,e and -HeapLen ; Get modulo 4 ld e,a ex de,hl ld (l00f0),hl ; Save length ld hl,(l00de) ; Load pointer to free heap push hl pop ix or a sbc hl,de ; Check pointer addresses jr nc,l1de9 l1d97: ld l,(ix+HeapLOadr); Get address ld h,(ix+HeapHIadr) push hl or a sbc hl,de ; Compare jr nc,l1da7 pop ix jr l1d97 l1da7: pop hl push de pop iy ld bc,(l00f0) ; Get length ld (iy+HeapLOlen),c; Store it ld (iy+HeapHIlen),b ld (iy+HeapLOadr),l; Store address, too ld (iy+HeapHIadr),h ld (ix+HeapLOadr),e ld (ix+HeapHIadr),d push ix pop hl ld c,(ix+HeapLOlen); Get old length ld b,(ix+HeapHIlen) call l1e04 ; Compare jr z,l1dd8 ; Match ld e,(ix+HeapLOadr); Get address ld d,(ix+HeapHIadr) push de pop ix l1dd8: push ix pop hl ld c,(ix+HeapLOlen) ld b,(ix+HeapHIlen) ld e,(ix+HeapLOadr) ld d,(ix+HeapHIadr) jr l1e04 l1de9: ld hl,(l00de) ; Get pointer to free heap ld (l00de),de ; Set new address push de pop ix ld (ix+HeapLOadr),l; Set chain ld (ix+HeapHIadr),h ld bc,(l00f0) ; Get length ld (ix+HeapLOlen),c ld (ix+HeapHIlen),b ex de,hl l1e04: add hl,bc ; Bump next or a sbc hl,de ; Test same ret nz push de pop iy ; Copy pointer ld hl,(l00c4) ; Get heap pointer or a sbc hl,de ; Test top found jr z,l1e2f ld a,(iy+HeapLOadr); Unpack address ld (ix+HeapLOadr),a ld a,(iy+HeapHIadr) ld (ix+HeapHIadr),a ld l,(iy+HeapLOlen) ld h,(iy+HeapHIlen) add hl,bc ld (ix+HeapLOlen),l; Unpack new length ld (ix+HeapHIlen),h xor a ret l1e2f: push ix pop hl ld (l00c4),hl ; Set new top heap pointer ld b,HeapLen l1e37: ld (hl),0 ; Clear top inc hl djnz l1e37 ret ; ; Get free memory ; Function MEMAVAIL:integer ; EXIT Reg HL holds free memory in bytes ; l1e3d: call l1e4b ; Get memory ld hl,(l00f4) ; Get available memory ret ; ; Get max free memory ; Function MAXAVAIL:integer ; EXIT Reg HL holds free memory in bytes ; l1e44: call l1e4b ; Get memory ld hl,(l00f6) ; Get max memory ret ; ; Get free memory ; l1e4b: ld hl,0 ld (l00f4),hl ; Init available memory ld (l00f6),hl ld ix,(l00de) ; Get pointer to free heap l1e58: ld c,(ix+HeapLOlen) ld b,(ix+HeapHIlen) ld a,c or b ; Test end of chain jr z,l1e80 ld hl,(l00f4) ; Get old available memory add hl,bc ; Add length ld (l00f4),hl ld hl,(l00f6) ; Get max or a sbc hl,bc ; Check it jr nc,l1e75 ld (l00f6),bc ; Set new max l1e75: ld l,(ix+HeapLOadr); Get chain ld h,(ix+HeapHIadr) push hl pop ix jr l1e58 ; Loop l1e80: ld hl,(l00c6) ; Get recursion pointer ld bc,-5 add hl,bc ; Build free address ld de,(l00c4) ; Get heap pointer or a sbc hl,de ; Test any free ret c ex de,hl ld hl,(l00f4) ; Get available memory add hl,de ; Add gap ld (l00f4),hl ld hl,(l00f6) ; Get max or a sbc hl,de ; Subtract ret nc ld (l00f6),de ; Set new ret ; ; Mark heap ; Procedure MARK(pointer) ; ENTRY Reg HL holds pointer ; l1ea3: ld de,(l00c4) ; Get heap pointer ld (hl),e ; Store into variable inc hl ld (hl),d ret ; ; Release heap ; Procedure RELEASE(pointer) ; ENTRY Reg HL holds pointer ; l1eab: ld e,(hl) ; Load heap from variable inc hl ld d,(hl) ex de,hl ; ; Init heap ; ENTRY Reg HL points to 1st free location ; l1eaf: ld (l00c4),hl ; Set heap pointer ld (l00de),hl ld b,HeapLen l1eb7: ld (hl),0 ; Clear 4 bytes inc hl djnz l1eb7 ret ; ; Convert number to string ; Procedure STR(real,string) ; ENTRY Real pushed onto stack with formatting data ; Reg HL points to string ; Reg B holds length of string ; l1ebd: db skip ; ; Procedure STR(integer,string) ; ENTRY Integer pushed onto stack with digit count ; Reg HL points to string ; Reg B holds length of string ; l1ebe: xor a ld c,a ; Save mode ld (l00e8),hl ; Save string xor a ld (hl),a ; Init to empty string ld (l00d0),a ; Clear error ld a,b ld (l00ea),a ; Save max length ld hl,(l00e2) ld (l00ed),hl ; Save current FIB ld hl,l1f46 ld (l00e2),hl ; Set RAM device pop hl ; Get caller ld (l00e4),hl pop hl ; Get digit count/comma places inc c ; Test mode dec c jr nz,l1ee6 call l1726 ; Get integer string jr l1ee9 l1ee6: call l1779 ; Get real string l1ee9: ld hl,(l00ed) ld (l00e2),hl ; Restore FIB ld hl,(l00e4) ; Get caller jp (hl) ; ; Convert string to number ; Procedure VAL(string,real,result) ; ENTRY String and address of real pushed onto stack ; Reg HL points to result ; l1ef3: db skip ; ; Procedure VAL(string,integer,result) ; ENTRY String and address of integer pushed onto stack ; Reg HL points to result ; l1ef4: xor a ld (l00ec),a ; Save mode ld (l00e8),hl ; Save result ld hl,(l00e2) ld (l00ed),hl ; Save current FIB ld hl,l1f46 ld (l00e2),hl ; Set RAM FIB pop hl ld (l00e4),hl ; Save caller pop hl ld (l00ea),hl ; Save integer/real address ld hl,l005c ld b,1eh call l05e2 ; Assign string from stack xor a ld (de),a ld hl,(l00ea) ; Get back variable pointer ld a,(l00ec) ; Test mode or a jr nz,l1f27 call l164e ; Convert to integer jr l1f2a l1f27: call l1672 ; Convert to real l1f2a: ld hl,l00d0 ld a,(hl) ; Get IOResult ld (hl),0 ; Clear or a ld h,a ld l,a jr z,l1f3d ; Test error push ix pop hl ; Get last address ld de,l005c sbc hl,de ; Get relative string error l1f3d: ex de,hl ld hl,(l00e8) ; Point to result ld (hl),e ; Save error or success inc hl ld (hl),d jr l1ee9 ; Exit ; ; FIB for RAM storage ; l1f46: db ..in+..out+RAMdevice db 0 ; ; Procedure RANDOMIZE ; l1f48: ld a,r ; Get refresh counter ld (l00c8+3),a ; Set for random ret ; ; Fill variable with constant value ; Procedure FILLCHAR(var,num,val) ; ENTRY Reg HL holds value ; Count and variable address pushed onto stack ; l1f4e: ex de,hl pop ix pop bc ; Get count pop hl ; Get address ld a,b or c ; Test count zero jr z,l1f62 ; Skip if so ld (hl),e ; Store value dec bc ; Fix count ld a,b or c ; Test count one jr z,l1f62 ; Skip if so ld d,h ; Copy address ld e,l inc de l1f60: ldir ; Move value for fill l1f62: jp (ix) ; ; Move variable to another ; Procedure MOVE(var1,var2,len) ; ENTRY Reg HL holds count ; Variables pushed onto stack ; l1f64: ld b,h ; Copy count ld c,l pop ix pop de ; Get 2nd var pop hl ; Get 1st one ld a,b or c jr z,l1f62 ; Test zero length sbc hl,de add hl,de ; Test overlapping jr nc,l1f60 ; Move up if so dec bc add hl,bc ; Point to top ex de,hl add hl,bc ex de,hl inc bc lddr ; Move down jp (ix) ; ; Get string from OS command line ; Function PARAMSTR(num):any_string ; ENTRY Reg HL holds number of substring ; EXIT Selected string on stack ; l1f7d: ld d,l ; Get number inc d dec d jr z,l1f85 ; Skip if none call l1f9d l1f85: pop ix ; Free stack ld c,a ; Get length of string ld b,0 cpl ld l,a ld h,-1 add hl,sp ; Build address on stack ld sp,hl ld (hl),c ; Store length inc hl ex de,hl inc c ; Test any selected dec c jr z,l1f99 ; Nope ldir ; Unpack it l1f99: jp (ix) ; ; Get number of parameters in OS command line ; Function PARAMCOUNT:integer; ; l1f9b: ld d,0 ; Set dummy selection ; ; Get parameters of OS command line ; ENTRY Reg D holds number of substring selected ; EXIT Reg DE points to selected substring ; Accu holds length of substring ; Reg HL holds index of substring ; l1f9d: ld hl,l0080 ; Init pointer ld a,MaxParams ; Test parameter count ld b,(hl) cp b jr nc,l1fa8 ld b,MaxParams ; Truncate to max l1fa8: inc hl ld c,0 ; Init count l1fab: inc b dec b ; Test end jr z,l1fbc ; Yeap ld a,(hl) cp ' ' jr z,l1fb8 ; Skip white spaces cp tab jr nz,l1fbc l1fb8: inc hl dec b jr l1fab l1fbc: ld e,l ; Save pointer l1fbd: inc b dec b ; Test done jr z,l1fce ; Yeap ld a,(hl) cp ' ' jr z,l1fce ; Find white space cp tab jr z,l1fce inc hl dec b jr l1fbd l1fce: ld a,l sub e ; Test same position jr z,l1fd6 inc c ; Count up index dec d ; Test found jr nz,l1fab l1fd6: ld l,c ; Get selected or last index ld h,0 ; Make pointer relative ld d,h ret ; ; Procedure GOTOXY(x_val,y_val) ; ENTRY Reg HL holds y_val ; x_val on stack ; l1fdb: pop de pop bc push de dec l ; Fix row ld h,c dec h ; Fix column jp l02a2 ; Position cursor ; ; Function UPCASE(char):char ; ENTRY Reg HL holds character ; EXIT Reg HL holds UPPER case character ; l1fe4: ld a,l ; Get into accu call l04a6 ; Convert to upper case ld l,a ; Bring it back ret ; ; Execute BIOS function ; Procedures BIOS(func) ; BIOS(func,param) ; Functions BIOS(func):integer ; BIOS(func,param):integer ; BIOSHL(func,param):integer ; ENTRY Reg DE holds BIOS function ; Reg BC holds optional parameter ; EXIT Accu and reg HL hold result ; l1fea: ld hl,(OS+1) ; Get base address add hl,de ; Make executable add hl,de add hl,de jp (hl) ; Execute ; ; Get IO result ; Function IORESULT:integer ; EXIT Reg HL holds result ; l1ff1: ld hl,l00d0 ; Point to result ld a,(hl) ; Get it ld (hl),0 ; Clear after request ld l,a ld h,0 ret ; ; Control C entry - entered via RST after each statement ; l1ffb: call l0316 ; Test key pressed ld a,h or l ret z ; Nope ld a,(l00dd) ; Get $C mode push af xor a ld (l00dd),a ; Set $C- call l0320 ; Read from keyboard pop af ld (l00dd),a ; Reset $C mode ld a,l cp CtrlC ; Test Control-C ret nz ; Nope pop ix ; Fetch PC l2016: ld de,_CBRK ; Set CtrlC error jr l202c ; Enter error routine ; ; Check IOResult after IO operation ; (May be turned off by {$I-}) ; l201b: ld a,(l00d0) ; Test any error or a ret z ; Nope pop ix ; Get caller ld e,a ; Save code ld d,_IO ; Set mode jr l202c l2027: pop ix ; Get caller l2029: ld e,a ; Save code ld d,_RT ; Set mode ; ; Common error handler ; ENTRY Reg D holds error mode ; Reg E holds error code ; Reg IX holds callers address ; l202c: push de call l037a ; Reset some things pop de xor a ld (l00dd),a ; Set $C- mode ld hl,(l00ce) ; Get current PC ld a,h ; Check zero or l push ix pop hl ld bc,(l00cc) ; Get base PC sbc hl,bc ; Subtract for base ld bc,TPhead add hl,bc ; Fix for 0100h start ld (l00ce),hl ; Set current PC or a ; Look for previous zero jr nz,l2054 ; Nope push de push de push hl call l00d9 ; Do restart pop de l2054: ld a,d or a ; Test user break jr nz,l206c call l0200 ; Tell control C db '^C' db cr,lf db 'User break' db null jr l2097 l206c: dec a ; Test I/O error jr nz,l207a call l0200 ; Tell I/O error db cr,lf db 'I/O' db null jr l2088 l207a: call l0200 ; Tell run time error db cr,lf db 'Run-time' db null l2088: call l0200 db ' error ' db null ld a,e call l04b4 ; Print error byte l2097: call l0200 ; Tell current PC db ', PC=' db null ld hl,(l00ce) ; Get current PC call l04af ; Print hex jr l20bd ; Abort ; ; Process memory error ; l20a8: call l0200 ; Tell error db 'Not enough memory' db null ; ; Error detected, tell abort and break ; l20bd: call l0200 ; Tell it db cr,lf db 'Program aborted' db cr,lf,null ; ; Halt program ; l20d4: ld a,(l00d8) ; Test run mode or a jp z,l278e ; Enter TP menue jp OS ; Exit .COM file ; ; Restart after error ; l20de: pop hl ; Get PC pop de ; Clean stack pop de jp (hl) ; Restart ; ; %%%%%%%%%%%%%%%%%%% ; %%% MENUE ENTRY %%% ; %%%%%%%%%%%%%%%%%%% ; ; Enter here thru cold start ; l20e2: jp l215e ; Go to initializer ; ; Set up environment ; l20e5: ld hl,(TPAtop) ; Get top of memory pop bc ld sp,hl push bc ld de,-StkSpc add hl,de ; Allow some space ld (l4548),hl ; Set top of memory ld hl,l7ad7 ; Get top of used memory ld bc,256*0+0 ; No break, no interrupt call l0364 ; Init pointers call l030a ; Give lead in sequence call l026b ; Set low video jp l0284 ; Set normal video ; ; Init session and load work file if defined ; l2104: call l20e5 ; Set up environment ld a,(l4542) ; Get compile flag push af ld a,(l4541) ; Test error message file read or a call nz,l2da4 ; Yeap, read it call l2d8f ; Init session call l2d4b ; Test work file defined call nz,l2506 ; Yeap, load file ld a,(l44f3) ; Get compiler mode dec a jr z,l2125 ; Compile to memory pop af ld (l4542),a ; Reset compile flag l2125: jp l223b ; Enter menue ; ; Give delimiter line ; l2128: call l0200 db '---------------------------------------' db cr,lf,null ret ; ; Give B blanks ; l2156: call l0200 ; Just do it db ' ',null djnz l2156 ret ; ; Come here after cold start ; l215e: ld hl,(TPAtop) ; Fetch top of memory ld bc,-MEMGAP add hl,bc ld (l44f6),hl ; Set for available memory ld c,.retdsk call BDOS ; Get logged disk inc a ld (l44f8),a ; Save it call l20e5 ; Set up environment call l023e ; Clear screen call l2128 ; Give delimiter call l0200 ; Tell what we are l217d: db 'TURBO' db ' Pascal system',null call l026b ; Set low video ld b,7 call l2156 ; Give blanks call l0200 ; Tell version ; db 'Version 3.00A' db cr,lf,null ld b,27 call l2156 ; Give blanks call l0200 ; Tell type and copyright ; db 'CP/M-80, Z80' db cr,lf,cr,lf db 'Copyright (C) 1983,84,85 ' db null call l0284 ; Set normal video call l0200 ; db 'BORLAND Inc.' db cr,lf,null call l2128 ; Give delimiter call l0200 ; Tell type of terminal ; db lf db 'Terminal: ' db null ld hl,l0153 call l01d0 ; Give string call l0200 ; Ask for error messages to be included ; db cr,lf,lf,lf,lf db 'Include error messages' db null call l2d21 ; Ask for YES or NO ld (l4541),a ; Save result call nz,l2da4 ; YES, read it call l2d8f ; Init session call l227a ; Display menue ; ; %%%%%%%%%%%%%%%%%%%&&&&& ; %%% TURBO WARM START %%% ; %%%%%%%%%%%%%%%%%%%&&&&& ; l223b: ld sp,(TPAtop) ; Get top of stack ld hl,l223b push hl ; Set return address call l01fa ; Indicate input requested ; db cr+MSB,lf+MSB,'>'+MSB db null call l03e1 ; Read character call l04a6 ; Convert to upper case call l01e1 ; Give new line ld hl,l2460 ld de,l2472 ld b,MainLen call l2450 ; Find command jr c,l227a ; Display menue if not found jp (hl) ; Execute command ; ; Input option string ; On exit ^DE points to first non blank ; l2261: call l0200 ; Tell what we want ; db ': ' db null call l14e8 ; Get line call l01e1 ; Give new line ld de,l7ad7 ; Point to start of line l2270: ld a,(de) ; Get character cp eof ; End on end of line ret z cp ' ' ; Skip blanks ret nz inc de jr l2270 ; ; Display menue ; l227a: call l023e ; Clear screen call l01fa ; Give some info ; db 'L'+MSB,'ogged drive:',' '+MSB db null ld c,.retdsk call BDOS ; Fetch disk add a,'A' ; Make ASCII call l03c9 ; Put to console call l01fa ; Tell work file ; db cr+MSB,lf+MSB,lf+MSB db 'W'+MSB,'ork file:',' '+MSB db null call l3135 ; Type it call l01fa ; Tell main file ; db cr+MSB,lf+MSB db 'M'+MSB,'ain file:',' '+MSB db null ld de,l44f9 call l2df8 ; Tell name of file call l01fa ; Give selection ; db cr+MSB,lf+MSB,lf+MSB db 'E'+MSB,'dit ' db 'C'+MSB,'ompile ' db 'R'+MSB,'un ' db 'S'+MSB,'ave' db cr,lf,lf db 'e','X'+MSB,'ecute ' db 'D'+MSB,'ir ' db 'Q'+MSB,'uit compiler ' db 'O'+MSB,'ptions' db cr,lf,lf db 'Text: ' db null ld de,(l4544) ; Get start of text ld hl,(l4546) ; Get end of text dec hl call l2338 ; Tell free bytes ld de,(l4546) ; Get end of text ld hl,(l4548) ; Get top of available memory ; ; Tell free memory ; ENTRY Reg HL holds end address ; Reg DE holds start address ; l232e: call l0200 ; Tell free memory ; db 'Free: ' db null ; ; Print decimal free bytes and hex addresses ; ENTRY Reg HL holds end address ; Reg DE holds start address ; l2338: push hl push de or a sbc hl,de ; Calculate difference call l2e5c ; Print it call l0200 ; Tell bytes ; db ' bytes (' db null pop hl ; Get start address call l04af ; Print hex ld a,'-' call l03c9 ; Give delimiter pop hl ; Get end address call l04af ; Print hex ld a,')' call l03c9 ; Give closure jp l01e1 ; Give new line ; ; Display arrow if compile selected ; l2361: dec a ; Test compile selected jr nz,l2374 ; Nope, erase display call l01fa a2361: db 'compile -> ' la2361 equ $-a2361 db null ret l2374: ld b,la2361 jp l2156 ; Give blanks ; ; ############################## ; ### MAIN MENUE O - Options ### ; ############################## ; l2379: ld hl,l2379 push hl ; Set return address call l023e ; Clear screen ld a,(l44f3) ; Get compile mode call l2361 ; Display arrow call l01fa db 'M'+MSB,'emory' db cr,lf,null call l2361 ; Display arrow call l01fa db 'C'+MSB,'om-file' db cr,lf,null call l2361 ; Display arrow call l01fa db 'c','H'+MSB,'n-file' db cr,lf,lf,null ld a,(l44f3) ; Get compile mode cp 1 ; Test compile to memory jr z,l2419 ; Yeap call l01fa db 'S'+MSB,'tart address:',' '+MSB db null ld hl,(l44f4) ; Get start address call l04af ; Print hex call l01fa db ' (min ' db null ld hl,l20e2 ; Get start address call l04af ; Print hex call l01fa db ')' db cr,lf db 'E'+MSB,'nd address:',' '+MSB db null ld hl,(l44f6) ; Get top of available memory call l04af ; Print hex call l01fa db ' (max ' db null ld hl,(TPAtop) call l04af ; Print hex call l01fa db ')' db cr,lf,lf,null l2419: call l01fa db 'F'+MSB,'ind run-time error ' db 'Q'+MSB,'uit' db cr,lf,lf db '>'+MSB db null call l03e1 ; Read character call l04a6 ; Convert to upper case call l01e1 ; Give new line ld hl,l246b ld de,l2488 ld b,SubLen call l2450 ; Find command ret c ; Not found jp (hl) ; Execute ; ; Find character in list ^HL of length in reg B ; Return address from table ^DE on success ; Set C if not found ; l2450: cp (hl) ; Compare jr z,l245a ; Match inc hl ; Skip character inc de ; Skip address inc de djnz l2450 ; Go thru table scf ; Indicate no match ret l245a: ex de,hl ld e,(hl) ; Fetch address inc hl ld d,(hl) ex de,hl ret ; l2460: db 'LWMECRSXDQO' MainLen equ $-l2460 l246b: db 'MCHSEFQ' SubLen equ $-l246b l2472: dw l2cce ; L - Log drive dw l24c9 ; W - Work file dw l249a ; M - Main file dw l2af8 ; E - Edit dw l2827 ; C - Compile dw l2a97 ; R - Run dw l2639 ; S - Save dw l2b2d ; X - eXecute dw l2b93 ; D - Directory dw l2b24 ; Q - Quit dw l2379 ; O - Options l2488: dw l2740 ; M - Compile Memory dw l2744 ; C - Compile Com-file dw l2748 ; H - Compile cHn-file dw l2750 ; S - Start address dw l276e ; E - End address dw l279b ; F - Find run-time error dw l2496 ; Q - Quit ; ; ########################## ; ### SUB MENUE Q - Quit ### ; ########################## ; l2496: pop hl jp l227a ; Display menue ; ; ################################ ; ### MAIN MENUE M - Main file ### ; ################################ ; l249a: call l0200 db cr,lf db 'Main file name' db null call l2d9f ; Init a bit call l2261 ; Input string ld a,0 ld (l44f9+Fdrv),a ; Set default drive ret z call l2d2a ; Prepare .PAS file ld de,l44f9 ; Point to main file ld hl,l005c ld bc,FCBlen ldir ; Unpack FCB ret ; ; ################################ ; ### MAIN MENUE W - Work file ### ; ################################ ; l24c9: ld hl,l25bc ld (l259d+1),hl ; Redirect error call l2601 ; Save work file call l0200 db cr,lf db 'Work file name' db null call l2261 ; Input string ld a,0 ld (l451d+Fdrv),a ; Set no work file jr nz,l24f6 ; Got input call l2d8f ; Init session jp l223b ; Enter menue l24f6: call l2d2a ; Prepare .PAS file ld de,l451d ld hl,l005c ld bc,FCBlen ldir ; Unpack work file jr l250c ; Init and load text file ; ; Init a bit and load wirk file into memory ; l2506: ld hl,l25b7 ld (l259d+1),hl ; Redirect error l250c: ld hl,l25eb ld (l257c+1),hl ; Set vector for file too big call l2d8f ; Init session ld de,l451d ; ; Load text file ; ENTRY Reg DE points to FCB ; EXIT Reg HL points to end of memory ; l2518: ld hl,(l4544) ; Get start of text ld (l4460),hl ; Set block start pointer ld (l4462),hl ; Set block end pointer ld (l4450),hl ; Set current memory pointer ld (l4454),hl ; Set block pointer ld (l4458),hl ; Set edit pointer ld (l446a),hl ; Set start of screen ld bc,(l4548) ; Get top of available memory call l253b ; Load file ld (hl),cr ; Close last line inc hl ld (l4546),hl ; Set end of text ret ; ; Load a file ; ENTRY Reg BC holds last available address ; Reg DE holds FCB ; Reg HL holds start address ; EXIT Reg HL holds end address ; l253b: push hl push bc push de call l0200 ; Tell action db cr,lf db 'Loading ' db null call l2df8 ; Tell name of file ld de,l005c call l26dc ; Clear FCB pop hl ld bc,l0024 ldir ld c,.open call l26d3 ; Open file l2560: push af ld de,l7957 ld c,.setdma call l7265 ; Set disk buffer pop af pop bc pop hl inc a ; Test file found jr z,l259d ; Nope ld (l7b6d),bc ; Set last memory address l2573: ld bc,(l7b6d) ; Get last memory address dec b or a sbc hl,bc ; Test room in memory add hl,bc l257c: jp nc,@DUMMY ; Nope push hl ld c,.rdseq call l26d3 ; Read record from file pop hl or a ; Test end of file ret nz ; Yeap ld de,l7957 ; Point to buffer ld b,RecLng l258d: ld a,(de) ; Scan for EOF cp -1 ret z and NOMSB cp eof ret z ld (hl),a ; Unpack data inc hl inc de djnz l258d jr l2573 l259d: jp @DUMMY ; *** REDIRECTED *** ; ; Tell file not found ; l25a0: call l0200 db cr,lf db 'File not found' db null l25b4: jp l2e76 ; Get ESCape ; ; Redirected error if work file read error ; l25b7: call l25a0 ; Tell file not found jr l25ee ; ; Redirected error if work file not found ; l25bc: call l0200 db cr,lf db 'New File' db null inc hl push hl ld hl,1000 call l021d ; Delay one second pop hl ret ; ; Tell file too big ; l25d4: ld hl,(l4546) ; Get end of text call l0200 db cr,lf db 'File too big' db null jr l25b4 ; ; Process file too big error ; l25eb: call l25d4 ; Tell file too big l25ee: xor a ld (l451d+Fdrv),a ; Indicate no file jp l223b ; Enter menue ; ; Set extension .BAK ; l25f5: ld hl,l005c+Fdrv+Fname ld (hl),'B' inc hl ld (hl),'A' inc hl ld (hl),'K' ret ; ; Save work file on request ; l2601: db skip ; ; Save work file on request ; l2602: xor a ex af,af' ld a,(l447f) ; Test text changed or a ret z ; Nope ex af,af' or a ; Test request jr z,l2639 ; Save file if not call l0200 db 'Workfile ' db null call l3135 ; Type name of file call l0200 db ' not saved. Save' db null xor a ld (l447f),a ; Set no text changed call l2d21 ; Ask for YES or NO ret z ; NO ; ; ########################### ; ### MAIN MENUE S - Save ### ; ########################### ; l2639: call l2d50 ; Get file ld hl,l451d push hl ld de,l005c ld bc,FCBlen ldir ; Unpack file call l0200 ; Tell action db cr,lf db 'Saving ' db null ld de,l005c call l2df8 ; Tell name of file ld hl,(l4546) ; Get end of text dec hl ld (hl),eof ; Close text call l25f5 ; Set extension .BAK call l26d9 ; Clear FCB ld c,.delete call l7265 ; Delete file ld hl,l005c+Fdrv ld de,l005c+DIRlen xor a ld (l447f),a ; Set no text changed ld (de),a inc a ld (l44f2),a ; Set rename flag inc de ld bc,DIRlen-1 ldir ; Unpack name pop hl ld de,l005c ld bc,DIRlen ldir ; Get new file ld c,.rename call l26d3 ; Rename it ld hl,(l4544) ; Get start of text l2692: push hl call l26d9 ; Clear FCB ld c,.make call l7265 ; Create new file pop hl inc a jr z,l26ed ; Error creating file push hl ld de,l7957 push de ld c,.setdma call l7265 ; Set disk buffer pop de pop hl ld b,RecLng ; Set length of buffer l26ad: ld a,(hl) ; Get from memory inc hl l26af: ld (de),a ; Put to buffer inc de djnz l26c6 ld b,a ; Save last character push bc push hl ld c,.wrseq call l26d3 ; Write record to file pop hl pop bc or a ; Test success jr nz,l26fe ; Nope, write error ld de,l7957 ; Reset pointer ld a,b ; Get back last character ld b,RecLng ; Reset buffer length l26c6: cp eof ; Test end of file jr nz,l26ad ; Nope, go on ld a,b sub RecLng ; Test record boundary ld a,eof jr nz,l26af ; Nope, write end ld c,.close ; Close file ; ; Do OS call with standard FCB ; l26d3: ld de,l005c jp l7265 ; Do file call ; ; Clear FCB ; l26d9: ld de,l005c ; ; Clear FCB ^DE ; l26dc: push de ld hl,_ex add hl,de ; Point to extent ld (hl),0 ; Clear it ld d,h ld e,l inc de ld bc,FCBlen-_ex-1 ldir ; Clear remainder pop de ret ; ; Create file error ; l26ed: call l0200 ; Tell error db ' Directory' db null jr l2708 ; ; Write file error ; l26fe: call l0200 ; Tell error db ' Disk' db null l2708: call l0200 db ' full' db null call l2e76 ; Get ESCape call l26d9 ; Clear FCB ld c,.delete call l26d3 ; Delete file ld a,(l44f2) ; Test to be renamed or a ret z ; Nope ld (l447f),a ; Set text changed ld hl,l005c+Fdrv ld de,l005c+DIRlen xor a ld (l44f2),a ; Clear rename flag ld (de),a ; Clear name entry inc de ld bc,DIRlen-1 ldir ; Unpack FCB call l25f5 ; Set extension .BAK ld c,.rename call l26d3 ; Rename file jp l223b ; Enter menue ; ; #################################### ; ### SUB MENUE M - Compile Memory ### ; #################################### ; l2740: ld a,1 ; Set memory jr l274a ; ; ###################################### ; ### SUB MENUE C - Compile Com-file ### ; ###################################### ; l2744: ld a,2 ; Set .COM file jr l274a ; ; ###################################### ; ### SUB MENUE H - Compile cHn-file ### ; ###################################### ; l2748: ld a,3 ; Set .CHN file l274a: ld (l44f3),a ; Set compile mode jp l2d9f ; Force compile ; ; ################################### ; ### SUB MENUE S - Start address ### ; ################################### ; l2750: call l0200 ; Tell what we want db 'Start address' db null call l2261 ; Input string ld hl,l20e2 ; Set default call nz,l2dd9 ; Get new hex value ld (l44f4),hl ; Save new start address ret ; ; ################################# ; ### SUB MENUE E - End address ### ; ################################# ; l276e: call l0200 ; Tell what we want db 'End address' db null call l2261 ; Input string ld hl,(TPAtop) ld bc,-MEMGAP add hl,bc ; Calculate default call nz,l2dd9 ; Get new hex value ld (l44f6),hl ; Set top of available memory ret ; ; Exit memory resident program ; l278e: call l20e5 ; Set up environment ld hl,(l00ce) ; Get current PC ld a,h or l jr nz,l27b1 ; Process error jp l223b ; Enter menue ; ; ######################################### ; ### SUB MENUE F - Find run-time error ### ; ######################################### ; l279b: call l0200 ; Tell what we want db 'Enter PC' db null call l2261 ; Input string ret z ; Empty call l2dd9 ; Get hex PC ld (l00ce),hl ; Set current PC l27b1: call l01e1 ; Give new line call l27d7 ; Load file into memory ld hl,0 ld (l7904),hl ; Clear address ld a,2 ld (l7900),a ; Set searching call l0200 ; Tell searching db cr,lf db 'Searching' db null call l2d9f ; Force compile jp l28d0 ; Go compile ; ; Load file into memory ; l27d7: call l2d4b ; Test work file defined call z,l2d50 ; Get file if not call l2d7a ; Test main file here l27e0: ld hl,l451d jr nz,l27ea ; Got any file call l2d50 ; Get file jr l2808 l27ea: call l2d7f ; Test same files jr z,l27e0 ; Yeap, get another one call l2602 ; Save work file ld hl,l25eb ld (l257c+1),hl ; Set vector for file too big ld hl,l25b7 ld (l259d+1),hl ; Set vector for read error ld de,l44f9 ; Point to main file push de call l2518 ; Load text file ld a,1 pop hl l2808: ld (l44f1),a ; Re/Set file flag ld de,l7933 ld bc,FCBlen ldir ; Unpack file xor a ld (l7900),a ; Set compile to memory ld hl,(TPAtop) ld (l790a),hl ; Set end of code l281d: ld hl,(l4546) ; Get end of text ld (hl),eof ; Set end of file inc hl ld (l7904),hl ; Set for code start address ret ; ; ############################## ; ### MAIN MENUE C - Compile ### ; ############################## ; l2827: call l27d7 ; Load file into memory ld a,(l44f3) ; Get compile mode dec a ; Test compile to memory jp z,l28aa ; Yeap dec a ; Test compile to .COM file push af jr nz,l283c ; Nope ld a,'C' ; Load .COM ld hl,'O'+'M'*256 jr l2841 l283c: ld a,'C' ; Load .CHN ld hl,'H'+'N'*256 l2841: ld (l7933+Fdrv+Fname),a ld (l7933+Fdrv+Fname+1),hl ld a,1 ld (l7900),a ; Set compile to file ld hl,(l44f4) ; Get start address of compiler ld (l7904),hl ; Save ld hl,(l44f6) ; Get top of available memory ld (l790a),hl ; Save also ld de,l7933 push de call l26dc ; Clear FCB ld c,.delete call l7265 ; Delete file pop de ld c,.make call l7265 ; Create new file inc a ; Test success jp z,l2a5a ; Nope, error pop af ; Get back .COM or .CHN ld hl,TPA jr z,l2877 ; Got .COM ld hl,(l7904) ; Get code start address l2877: ld (l7902),hl ; Save for current PC ex de,hl l287b: ld hl,(l7904) ; Get code start address scf sbc hl,de ; Test end reached jr c,l28a9 ; Yeap ld hl,(l7904) ; Get code start address ld (TPA+1),hl ; Set as start address push de ld c,.setdma call l7265 ; Set disk buffer ld c,.wrseq ld de,l7933 call l7265 ; Write record to file pop de ld hl,l20e2 ld (TPA+1),hl ; Reset start address or a ; Test I/O success jp nz,l2a5a ; Error, disk full ld hl,RecLng add hl,de ; Advance buffer ex de,hl jr l287b l28a9: db skip l28aa: xor a call l0200 ; Tell compiling ; db cr,lf db 'Compiling ' db null ld de,l7933 or a ; Test compile to memory jr z,l28cd ; Yeap call l0200 ; Indicate file ; db ' --> ' db null call l2df8 ; Tell name of file l28cd: call l2d9f ; Force compile l28d0: call l01e1 ; Give new line call l454a ; Compile ld a,(l7901) ; Get error code cp _ABORT ; Test abort jr nz,l28fa ; Nope call l0200 ; Tell abortion ; db cr,lf,lf db 'Compilation aborted' db null jp l223b ; Enter menue l28fa: call l0200 ; Tell lines db ' lines' db cr,lf,lf,null ld a,(l7901) ; Get error code or a ; Test any error jp nz,l2970 ; Yeap ld a,(l7900) ; Get compile flag cp 2 ; Test searching jr nz,l292a ; Nope call l2a7a ; Tell error position call l0200 db 'not found' db cr,lf,null jp l223b ; Re-enter menue l292a: or a ; Test compile to memory jr z,l293a ; Yeap ld hl,(l7904) ; Get code start address ld de,l20e2 ; Get start of application or a sbc hl,de add hl,de call nz,l232e ; Tell free l293a: call l0200 db 'Code: ' db null ld de,(l7904) ; Get code start address ld hl,(l7906) ; Get code end address push hl dec hl call l2338 ; Tell free bytes pop de ld hl,(l7908) ; Get start of data push hl call l232e ; Tell free pop de inc de ld hl,(l790a) ; Get end of code call l0200 db 'Data: ' db null call l2338 ; Tell free bytes ld a,-1 ld (l4542),a ; Set no compile ret ; ; Process compiler error ; l2970: cp _DskFull ; Test disk error jp nc,l2a5a ; Error, disk full cp _FndRTerr ; Test run-time error found jr nc,l29ec ; Yeap ld b,a ; Save error number call l0200 ; Tell error db 'Error ' db null ld h,0 ld l,b ; Build 16 bit number push bc call l2e61 ; Print it pop bc ld a,(l4541) ; Test error message file read or a jr z,l29f8 ; No message file ld hl,(l429e) ; Get base of message file l2995: ld a,(hl) ; Get character cp eof ; Test end of message jr z,l29f8 ; Yeap cp ' ' ; Test control jr c,l29ad ; Yeap, skip it sub '0' ; Build number - always two digits ld c,a add a,a add a,a add a,c add a,a inc hl add a,(hl) ; Combine number sub '0' ; Fix it inc hl cp b ; Test message found jr z,l29b6 ; Got it l29ad: ld a,(hl) inc hl cp cr ; Skip to end of line jr nz,l29ad inc hl jr l2995 ; Try next line l29b6: call l0200 ; Tell result ; db ': ' db null l29bc: ld a,(hl) ; Get character cp cr ; Test end of text jr z,l29f8 ; That's all cp ' ' ; Test combined message jr nc,l29e6 ; Nope ld de,(l429e) ; Get base of message file l29c9: ld a,(de) ; Get character inc de cp ' ' ; Test printable jr nc,l29dd ; Yeap, skip it cp (hl) ; Test extension found jr nz,l29dd ; Nope l29d2: ld a,(de) ; Get from extended part cp cr ; Test end of line jr z,l29e9 ; Yeap call l03c9 ; Put substring to console inc de jr l29d2 l29dd: ld a,(de) inc de cp cr ; Skip this line jr nz,l29dd inc de jr l29c9 l29e6: call l03c9 ; Put to console l29e9: inc hl jr l29bc ; Loop on ; ; Got position of run-time error ; l29ec: call l2a7a ; Tell error position call l0200 db 'found' db null l29f8: xor a ld (l44f1),a ; Clear file flag ld a,(l790e) ; Test read from memory or a jr z,l2a41 ; Nope ld a,'.' call l03c9 ; Put to console call l2602 ; Save work file ld de,l451d ld hl,l790f ld bc,Fdrv+Fname+Fext ldir ; Copy include file call l2506 ; Load it call l0200 db cr,lf db 'Error found in above include file' db null jr l2a51 l2a41: call l2d7a ; Test main file here jr z,l2a51 ; Nope ld de,l451d ld hl,l44f9 ; Point to main file ld bc,Fdrv+Fname+Fext ldir ; Copy file l2a51: call l2e76 ; Get ESCape ld hl,(l790c) ; Fetch current editor address jp l2afe ; And fall into edit ; ; Process disk full ; l2a5a: call l0200 ; Tell error ; db 'Disk or directory full' db null call l2e76 ; Get ESCape jp l223b ; Enter menue ; ; Tell error position message ; l2a7a: call l0200 db 'Run-time error position ' db null ret ; ; ########################## ; ### MAIN MENUE R - Run ### ; ########################## ; l2a97: ld a,(l4542) ; Get compile flag or a call z,l2827 ; Compile before run ld a,(l44f3) ; Get compile flag dec a jr z,l2adf ; Got to memory dec a ret nz ; Skip chain call l2b33 ; Load overlay file ret z ; Not found call l2d7a ; Test main file here ld hl,l451d jr z,l2ab5 ; Nope ld hl,l44f9 ; Point to main file l2ab5: ld de,l7933 ld bc,Fdrv+Fname+Fext ldir ; Unpack FCB ld a,'C' ; Set .COM ld hl,'O'+'M'*256 ld (l7933+Fdrv+Fname),a ld (l7933+Fdrv+Fname+1),hl ld de,l7933 call l26dc ; Clear FCB push de ld c,.open call l7265 ; Open file pop hl inc a ; Test file here jp z,l2104 ; Nope, init session ld de,l42a0 ; Set dummy parameter jp l2b7a ; Prepare overlay l2adf: ld (l0080),a ; Clear parameter call l281d ; Set text and code pointer call l0200 ; Tell running db cr,lf db 'Running' db cr,lf,null ld hl,(l7904) ; Get code start address jp (hl) ; And go ; ; ########################### ; ### MAIN MENUE E - Edit ### ; ########################### ; l2af8: call l2d50 ; Get file ld hl,-1 ; Set zero offset l2afe: push hl ld hl,(l00a6+1) ld (l421e),hl ; Change I/O ld hl,l4214 ld (l00a6+1),hl pop hl jp l2e91 ; Go edit ; ; Control: EXIT EDITOR ; l2b0f: call l3e40 ; Sample character ld hl,(l0169) ; Get screen lines dec l ; Fix row ld h,0 ; Set column call l02a2 ; Position cursor ld hl,(l421e) ld (l00a6+1),hl ; Reset I/O jp l223b ; ; ########################### ; ### MAIN MENUE Q - Quit ### ; ########################### ; l2b24: call l2601 ; Save work file call l0310 ; Give lead out sequence jp OS ; Exit to OS ; ; ############################## ; ### MAIN MENUE X - eXecute ### ; ############################## ; l2b2d: call l2b33 ; Load overlay file ret z ; Not found jr l2b5a ; Go ; ; Load overlay file ; Z set says not found ; l2b33: call l2601 ; Save work file ld de,l217d ; Set name ld a,'O' ld hl,'V'+'R'*256 call l2e20 ; Prepare .OVR file ret z ld de,@OVLADR-RecLng l2b45: ld hl,RecLng add hl,de ; Build disk buffer address push hl ex de,hl ld c,.setdma call BDOS ; Set disk buffer ld c,.rdseq call l26d3 ; Read record pop de or a ; Test end of file jr z,l2b45 ; Nope, loop on ret ; ; Execute file ; l2b5a: call l0200 ; Tell program db cr,lf db 'Program' db null call l2261 ; Input string jp z,l2104 ; No input ld a,'C' ld hl,'O'+'M'*256 call l2e20 ; Prepare .COM file jr z,l2b5a ; Not there, retry ld hl,l005c l2b7a: push de ; Set argument pointer push hl ; Set FCB ld a,(l44f8) push af ; Set logged disk ld hl,l03ee push hl ; Set parse file routine ld hl,l00f4 push hl ; Set available memory ld hl,l4450 push hl ; Set current memory pointer ld hl,l2104 push hl ; Set return address jp @OVLADR ; Execute overlay ; ; ################################ ; ### MAIN MENUE D - Directory ### ; ################################ ; l2b93: call l0200 db 'Dir mask' db null call l2261 ; Input string call l03ee ; Parse file ld c,.retdsk call l7265 ; Return current disk push af push af ld a,(l005c) ; Get disk or a ; Test default jr z,l2bbb ; Yeap pop hl ; Clean stack dec a ld e,a push af ; Set new disk ld c,.seldsk call l7265 ; Select disk l2bbb: pop af add a,'A' ; Make disk ASCII ld (l2c8d),a ; Save disk ld de,l7957 ld c,.setdma call l7265 ; Set disk buffer ld de,0 ; Clear flag and count ld c,.srcfrs l2bce: push de call l26d3 ; Search for file pop de ld c,a inc a ; Test valid one jr z,l2c29 ; Nope ld a,c add a,a ; Result *32 add a,a add a,a add a,a add a,a ld c,a ld b,0 ld hl,l7957+_SYS add hl,bc ; Point to SYS bit bit 7,(hl) ; Test set jr nz,l2c25 ; Yeap, skip display ld d,-1 ; Set any found flag ld hl,l7957 add hl,bc ; Point to entry inc e ; Test first file dec e jr nz,l2bff ; Nope ld a,(l0168) ; Get screen columns dec a ld e,-1 l2bf8: inc e sub Dirlng ; Calculate files per line jr nc,l2bf8 jr l2c05 l2bff: call l0200 ; db ': ' db null l2c05: ld b,Fname+Fext ; Set length l2c07: inc hl ld a,(hl) and NOMSB ; Strip off offset call l03c9 ; Put to console ld a,b cp Fext+1 ; Test extension ld a,' ' call z,l03c9 ; Put blank to console if so djnz l2c07 dec e ; Test remainder in line jr z,l2c22 ; Nope ld a,' ' call l03c9 ; Put to console jr l2c25 l2c22: call l01e1 ; Give new line l2c25: ld c,.srcnxt ; Search next jr l2bce l2c29: inc e ; Test any file left dec e call nz,l01e1 ; Give new line if so inc d ; Test any file found jr z,l2c3e ; Yeap call l0200 ; Else tell it ; db 'No file' db cr,lf,null l2c3e: call l01e1 ; Give new line ; ; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ; !!! FOLLOWING IS ERRONEOUS ON CP/M 3.x !!! ; !!! USES BDOS FUNCTION 46 ON CP/M 3.x !!! ; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ; ld c,.getdpb call BDOS ; Fetch disk parameter block push hl pop ix ; Copy it ld a,(ix+3) ; Get block mask inc a ; Fix rra ; DIV 8 (1-> 1k, 2->2k etc.) rra rra and DPBMASK ; Mask it ld (l7b71),a ; Save block size ld l,(ix+5) ; Fetch block count ld h,(ix+6) ld (l7b6f),hl ; Save it inc hl ; Fix call l2cc6 ; Build size in bytes push hl ; Save it ; ; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ; !!! THE ALLOCATION VECTOR MAY BE FOUND IN ANOTHER !!! ; !!! MEMORY BANK RUNNING CP/M 3.X. !!! ; !!! THE NEXT CALCULATION MAY BE WRONG THEREFORE !!! ; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ; ld c,.getalv call BDOS ; Get allocation vector ex de,hl ld hl,(l7b6f) ; Get block count ld bc,0 call l2ca5 ; Get free blocks ld h,b ld l,c call l2cc6 ; Build size in bytes call l0200 ; Tell size ; db 'Bytes Remaining On ' l2c8d: db 'X: ' db null ex de,hl pop hl ; Get back total size or a sbc hl,de ; Calculate free bytes call l2e61 ; Print number ld a,'k' call l03c9 ; Put to console pop af ; Get back selected disk ld e,a ld c,.seldsk jp l7265 ; Select disk ; ; BC holds resulting block count ; DE holds allocation vector ; HL holds block count ; ; BC holds free blocks ; l2ca5: push bc ld bc,-8 add hl,bc ; Fix block count pop bc ld a,h ; Get hi or a ld a,(de) jp p,l2cb8 l2cb1: inc l jr z,l2cbd ; Done, calculate free blocks or a rra jr l2cb1 l2cb8: call l2cbd ; Calculate free blocks from bits jr l2ca5 ; ; Calculate free blocks in reg BC from vector in Accu ; l2cbd: inc de ; Advance allocation vector l2cbe: or a ; Test end of bit stream ret z ; Yeap rra ; Get resulting bit jr nc,l2cbe ; Not set inc bc ; Advance block count jr l2cbe ; ; Build bytes in blocks ; l2cc6: ld a,(l7b71) ; Get block size l2cc9: rra ; Get bit ret c ; Got it add hl,hl ; Double byte count jr l2cc9 ; ; ################################ ; ### MAIN MENUE L - Log drive ### ; ################################ ; l2cce: call l0200 ; Tell what we expect ; db 'New drive' db null call l2261 ; Input string ld a,(de) cp eof ; Test empty input jr nz,l2ce8 ; Nope ld a,(DU) ; Get from caller jr l2cf1 l2ce8: call l04a6 ; Convert to upper case sub 'A' ; Verify in range ret c cp 'P'-'A'+1 ret nc l2cf1: push af ld c,.resdsk call l7265 ; Reset disk system pop af ld (DU),a ; Set new disk ld e,a ld c,.seldsk jp l7265 ; Select disk ; ; Ask for YES or NO - Z set is NO ; l2d01: call l0200 ; Tell what we does expect ; db ' (Y/N)? ' db null l2d0d: call l03e1 ; Read character call l04a6 ; Convert to upper case cp 'Y' ; Test YES jr z,l2d1b cp 'N' ; Test NO jr nz,l2d0d l2d1b: call l03c9 ; Put to console sub 'N' ret ; ; Get response Y or N - Z set is NO ; l2d21: call l2d01 ; Ask for YES or NO push af call l01e1 ; Give new line pop af ret ; ; Build file .PAS ; l2d2a: ld a,'P' ; Set .PAS ld hl,'A'+'S'*256 l2d2f: ld (l005c+Fdrv+Fname),a ld (l005c+Fdrv+Fname+1),hl ld c,0 ; Set no wild card call l0406 ; Parse file ld a,(l005c) ; Test drive given or a ret nz ; Yeap push de ld c,.retdsk call l7265 ; Return current disk inc a ld (l005c),a ; Set disk pop de ret ; ; Test work file defined - Z set says no ; l2d4b: ld a,(l451d+Fdrv) ; Fetch name or a ret ; ; Get file ; l2d50: call l2d4b ; Test work file defined jr nz,l2d6f ; Yeap call l2d7a ; Test main file defined jr nz,l2d5f ; Yeap call l24c9 ; Get work file jr l2d6f l2d5f: ld de,l451d ld hl,l44f9 ; Point to main file ld bc,l0024 ldir ld a,1 ld (l44f1),a ; Set file flag l2d6f: ld a,(l44f1) ; Test file flag or a ret z ; No file call l2602 ; Save work file jp l2506 ; ; Test main file defined - Z set says no ; l2d7a: ld a,(l44f9+Fdrv) ; Fetch name or a ret ; ; Compare main and work file - Z says same ; l2d7f: ld de,l451d ; Point to work file ld hl,l44f9 ; Point to main file ld b,Fdrv+Fname+Fext l2d87: ld a,(de) sub (hl) ; Compare ret nz ; Not same inc de inc hl djnz l2d87 ret ; ; Init session ; l2d8f: ld hl,(l4544) ; Get start of text ld (hl),' ' ; Clear it inc hl ld (l4546),hl ; Save pointer xor a ld (l447f),a ; Clear text change flag ld (l44f1),a ; Clear file flag l2d9f: xor a ld (l4542),a ; Force compile ret ; ; Read error message file ; l2da4: ld hl,(l429e) ; Get base of message file ld (l4544),hl ; Set as start of text ld de,l217d ; Point to filename ld a,'M' ld hl,'S'+'G'*256 call l2e20 ; Prepare .MSG file ld (l4541),a ; Set error message file read call z,l2e76 ; Get ESCape jr z,l2dcf ld hl,l25a0 ld (l259d+1),hl ; Set vector for file not found ld hl,l25d4 ld (l257c+1),hl ; Set vector for file too big ld de,l005c call l2518 ; Load text file l2dcf: ld hl,(l4546) ; Get end of text ld (hl),eof inc hl ld (l4544),hl ; Set start of text ret ; ; Convert string ^DE to hex number in reg HL ; l2dd9: ld hl,0 ; Init result l2ddc: ld a,(de) ; Get character call l04a6 ; Convert to upper case sub '0' ; Strip off offset ret c ; Out of range cp 9+1 ; Test decimal jr c,l2def ; Yeap sub 'A'-'0'-10 ; Fix for hex cp 10 ; Verify correct range ret c cp 15+1 ret nc l2def: add hl,hl ; Old * 16 add hl,hl add hl,hl add hl,hl or l ld l,a ; Insert digit inc de jr l2ddc ; ; Tell name of file ^DE ; l2df8: inc de ld a,(de) ; Get name dec de or a ; Test defined ret z ; Nope ld a,(de) ; Get drive add a,'A'-1 cp 'A'-1 ; Test default drive call nz,l03c9 ; Put to console if not ld a,':' call nz,l03c9 ; Give delimiter ld b,Fname+Fext ; Set length l2e0c: inc de ld a,(de) ; Get character and NOMSB ; Strip off attribute cp ' ' ; Test blank call nz,l03c9 ; Put to console if not ld a,b cp Fext+1 ; Test extension follows ld a,'.' call z,l03c9 ; Put delimiter to console if so djnz l2e0c ret ; ; Prepare file ^DE with extensin in A,L,H ; Z set if file not found ; l2e20: call l2d2f ; Parse file and build extension ld hl,l005c call l2e51 ; Open file ret nz ; Got it ld a,(l44f8) ; Get logged disk cp (hl) ; Test same drive ld (hl),a ; Set logged one call nz,l2e51 ; Open file if different drives ret nz ld a,'A'-'@' cp (hl) ; Test base drive ld (hl),a ; Force it call nz,l2e51 ; Open file if not base ret nz ; Got it ld (hl),0 ; Set default drive ex de,hl ; And tell error ; ; Tell file ^DE not found ; l2e3e: call l2df8 ; Tell name of file call l0200 ; Tell not found ; db ' not found' db null xor a ret ; ; Open standard file - Z set says not found ; l2e51: push de push hl ld c,.open call l26d3 ; Open file pop hl pop de inc a ; Fix result ret ; ; Print integer in reg HL fixed sized ; l2e5c: ld de,-5 ; Set size jr l2e64 ; ; Print integer number in reg HL ; l2e61: ld de,-1 ; Set no size l2e64: push ix push iy push hl push de call l149b ; Set standard device pop hl call l1726 ; Write integer pop iy pop ix ret ; ; Get ESCape character ; l2e76: push af call l0200 ; Tell it ; db '. Press ' db null l2e88: call l03e1 ; Read character jp l0128 ; &PATCH&: Test special keys nop l2e8f: pop af ret ; ; %%%%%%%%%%%%%%%%%%%% ; %%% EDITOR PART %%%% ; %%%%%%%%%%%%%%%%%%%% ; l2e91: push hl ld de,256*lf+cr ld hl,(l4546) ; Get end of text ld (hl),d ; Close line dec hl ld (hl),e ld (l7b74+_LinLen),de xor a ld (l4474),a ; Clear change flag inc a ld (l4475),a ; Init row ld hl,l43de ld (l7b72),hl ; Init pointer to all delimiters ld iy,l446c call l023e ; Clear screen pop de ; Get offset inc de ; Fix it ld hl,(l4544) ; Get start of text add hl,de ; Add to offset call l33a9 l2ebd: ld a,(l4482) ; Get control character count dec a jr z,l2ed5 ; Got one ld hl,256*0+0 call l02a2 ; Set cursor to control position ld a,(l4482) ; Get control character count add a,a ; Double it ld b,a ; For count ld a,' ' l2ed0: call l03c9 ; Blank control characters djnz l2ed0 l2ed5: call l3b96 call l2ff7 ; Give status call l2f3a ; Get character jr nc,l2f0e ; No control jr z,l2ebd ld hl,l2ebd ld a,d cp (HIGH @MSB)-1 ; Test special address jr c,l2ef4 ; Nope ld (l447f),a ; Set text changed and NOMSB ld d,a xor a ld (l4542),a ; Force compile l2ef4: push hl ; Set return address push de ; Save control address ld hl,l4456+1 ld de,l445a+1 ld bc,l0008 lddr ; Save a bit ret ; ; Control: CONTROL PREFIX ; l2f02:: call l2f8a ; Get character ld (iy+22),3 call l4271 ; Get character jr l2f16 l2f0e: ld (l447f),a ; Re/Set text changed ld hl,l4542 ld (hl),0 ; Force compile l2f16: ld hl,(l4452) ; Get current edit pointer ld de,l7b74+_LinLen-2 call l3be2 ; Compare HL:DE jr nc,l2ebd ; Line too long bit 0,(iy+6) ; Test insert push af call z,l41eb ; Yeap, so make room pop af ld (hl),a ; Store character inc hl ; Bump buffer push hl call l4197 pop hl ld (l4452),hl ; Set current edit pointer call l3fe7 jp l2ebd ; ; Get character ; C set indicates control ; l2f3a: call l4271 ; Get character cp '~'+1 ; Test printable range jr nc,l2f44 ; Nope cp ' ' ; Test once again ret nc l2f44: ld hl,l4482 ; Point to control character count ld (hl),1 ; Init count inc hl ld (hl),a ; Save control l2f4b: push hl ld hl,l4482 ; Point to control character count ld de,l42a1 ld b,11111111b call l2fc1 ; Find control pop hl or a ; Test found jr nz,l2f6b ; Yeap push hl ld hl,l4482 ; Point to control character count ld de,l4369 ld b,00011111b call l2fc1 ; Find control pop hl or a ; Test found scf ret z ; Nope l2f6b: dec a ; Test all found jr z,l2f78 ; Nope ld hl,l43f4 add hl,bc ; Go into table add hl,bc ld e,(hl) ; Fetch address inc hl ld d,(hl) scf ; Set result ret l2f78: call l2f8a ; Get character push af call l4271 ; Get character inc (iy+22) inc hl ld (hl),a pop af call z,l2f8a ; Get character jr l2f4b ; ; Get character ; l2f8a: call l4232 ; Poll character from input call l428f ; Test look ahead buffer empty ret nz ; Nope push hl ld hl,256*0+0 call l02a2 ; Position cursor ld hl,l4482 ; Point to control character count ld a,(hl) ; Get length l2f9c: push af inc hl ld a,(hl) ; Get character call l2fa8 ; Dispaly as control pop af dec a jr nz,l2f9c pop hl ret ; ; Display character in Accu ; l2fa8: push af call l3cec ; Make normal video pop af cp ' ' ; Test control jp nc,l03c9 ; Put to console if not push af push af ld a,'^' call l03c9 ; Indicate control pop af add a,'@' call l03c9 ; Put to console as ASCII pop af ret ; ; ^HL points to key sequence searched for in list ^DE with mask in reg B ; Accu= 0 says not found ; Accu= 1 says part found ; Accu=-1 says found ; l2fc1: ld c,-1 ; Init index push bc push hl l2fc5: pop hl pop bc ld a,(de) ; Get length from list inc de or a ; Test end ret z ; Yeap inc c ; Advance index push bc push hl ld c,(hl) ; Get length from input sub c ; Get difference inc hl jr nc,l2fd7 ; In range add a,c ; Else fix it ld c,a jr l2ff0 ; Go adjust l2fd7: push af l2fd8: ld a,(de) ; Get from list sub (hl) ; Compare and b ; Set mask jr nz,l2fed ; No match inc de inc hl dec c jr nz,l2fd8 pop af pop hl pop bc ld b,0 ld a,-1 ret z ; Got exact length ld a,1 ; Fix for partial success ret l2fed: pop af add a,c ld c,a l2ff0: ld b,0 ex de,hl add hl,bc ex de,hl jr l2fc5 ; ; Give editor status ; l2ff7: call l4232 ; Poll character from input call l428f ; Test look ahead buffer empty ret nz ; Nope ld hl,l4474 ld a,(hl) ; Test status changed or a jr nz,l3078 ; No change ld (hl),-1 ; Reset it ld hl,256*0+0 ld (l4476),hl xor a ld (l4478),a call l02a2 ; Position cursor call l3c12 ; Clear line call l3cdf ; Set low video ld a,(l0168) ; Get screen columns cp MINWID ; Test room for filename jr c,l302a ; Nope ld hl,256*42+0 call l02a2 ; Position cursor call l3135 ; Type work file l302a: ld hl,256*6+0 call l420e ; Position cursor and tell line db 'Line ' db null ld hl,256*16+0 call l420e ; Position cursor and tell column db 'Col ' db null ld hl,256*24+0 ld a,(l4472) ; Get insert mode or a jr nz,l305a ; Overwrite call l420e ; Position cursor and tell insert db 'Insert ' db null jr l3068 l305a: call l420e ; Position cursor and tell overwrite db 'Overwrite ' db null l3068: ld a,(l4479) ; Get tabulate state or a jr nz,l3078 call l4211 db 'Indent' db null l3078: ld a,(l446c) add a,(iy+4) ; Add column inc a ld hl,(l4478) cp l jr z,l309b ld (l4478),a push af ld hl,256*20+0 call l02a2 ; Position cursor call l3cdf ; Set low video pop af ld l,a ld h,0 ld a,3 ; Set number of digits call l30ec ; Give count l309b: ld de,(l4476) ld hl,(l4450) ; Get current memory pointer call l3be2 ; Compare HL:DE jp z,l37a4 ; Same, set edit cursor call l37a4 ; Set edit cursor ld de,(l4544) ; Get start of text ld hl,(l4450) ; Get current memory pointer or a sbc hl,de ; Get relative position ld c,l ld b,h ex de,hl ld de,1 ld a,c or b ; Test any jr z,l30d3 ; Nope l30bf: ld a,lf inc de cpir ; Find new line jp po,l30d3 ; Got it dec e inc e call z,l4232 ; Poll character from input call l428f ; Test look ahead buffer empty jr nz,l30e9 ; Nope jr l30bf l30d3: ld hl,256*11+0 push de call l02a2 ; Position cursor call l3cdf ; Set low video pop hl ld a,5 ; Set number of digits call l30ec ; Give count ld hl,(l4450) ; Get current memory pointer ld (l4476),hl l30e9: jp l37a4 ; Set edit cursor ; ; Print fixed format integer ; ENTRY Reg HL holds number to be printed ; Accu holds decimal places ; l30ec: push af ld b,0 ; Clear count call l30fe ; Print number pop af add a,b ; Test all digits typed ret z ; Yeap ld b,a ld a,' ' l30f8: call l03c9 ; Fill remainder with blanks djnz l30f8 ret ; ; Print decimal number ; ENTRY Reg HL holds number ; Reg B holds places ; l30fe: ld a,h or l ; Test zero output ld a,'0' jr z,l3131 ; Yeap, print it ld de,10000 call l311f ; Get ten thousands ld de,1000 call l311f ; Get thousands ld de,100 call l311f ; Get hundreds ld de,10 call l311f ; Get tens ld de,1 ; Finally units ; ; Print modulo ; ENTRY Reg HL holds number ; Reg DE holds divisor ; Reg B holds places ; EXIT Reg HL fixed ; Reg B decremented if digit is printed ; l311f: xor a ; Clear digit l3120: sbc hl,de ; Divide jr c,l3127 inc a ; Bump digit jr l3120 l3127: add hl,de ; Make remainder positive add a,'0' ; Make ASCII cp '0' ; Test zero jr nz,l3131 inc b ; Test leading zero dec b ret z ; Suppress it l3131: dec b ; Fix count jp l03c9 ; Put to console ; ; Type work file ; l3135: ld de,l451d jp l2df8 ; Tell name of file ; ; Get string for search and file function ; ENTRY Reg DE points to line buffer ; Byte 0 holds max characters ; Byte 1 holds resulting length ; l313b: call l0200 ; Indicate input ; db ': ' db null ex de,hl push hl pop ix ; Copy buffer inc hl ld d,(hl) ld (hl),0 inc hl l314a: res _LB,(iy+_Video) ; Disable video push de push hl call l2f3a ; Get character pop hl pop de set _LB,(iy+_Video) ; Allow video jr nc,l31b9 ; No control jr nz,l3165 ld a,(l4483) ; Get character call l3ef6 ; Test function cancelled jr l314a l3165: ld a,c cp 0 jr nz,l316d ld (hl),1ah ret l316d: cp 3 jr nz,l317c ld a,(ix+1) cp d jr nc,l314a inc (ix+1) jr l31c6 l317c: cp 5 jr nz,l3190 l3180: ld a,(ix+1) cp d jr z,l314a ld a,(hl) ; Get character call l2fa8 ; Display as control inc hl inc (ix+1) jr l3180 l3190: cp 4 jr nz,l319b l3194: call l31d7 jr nz,l3194 jr l314a l319b: cp '-' jr nz,l31a4 call l4271 ; Get character jr l31b9 l31a4: cp 1bh jr z,l31b4 cp 1ch jr z,l31b4 cp 1 jr z,l31b4 cp 2 jr nz,l314a l31b4: call l31d7 l31b7: jr l314a l31b9: ld e,a ld a,(ix+1) cp (ix+0) jr nc,l314a inc (ix+1) ld (hl),e l31c6: ld a,(hl) ; Get character inc hl call l2fa8 ; Display as control ld a,(ix+1) cp d jr c,l31b7 ld d,(ix+1) jp l31b7 l31d7: ld a,(ix+1) or a ret z dec (ix+1) dec hl ld a,(hl) cp ' ' call c,l31e6 l31e6: call l4211 db bs+MSB,' '+MSB,bs+MSB db null ld a,0ffh or a ret ; ; Control: FIND STRING ; l31f1: xor a ld (l447e),a ; Set find flag call l31fd ; Get string searched for call l3220 ; Get options jr l3252 ; Enter process ; ; Get string searched for ; l31fd: call l3e04 ; Tell what we want db 'Find' db null ld de,l4490 ; Point to buffer l3208: jp l313b ; Get search string ; ; Get string to be replaced ; l320b: call l3e07 ; Tell what we want db 'Replace with' db null ld de,l44b1 ; Point to buffer jr l3208 ; Get replace string ; ; Get options ; l3220: call l3e07 ; Tell what we want db 'Options' db null ld de,l44d2 ; Get buffer call l313b ; Get search string ld a,(l0168) ; Get screen columns ld h,a dec h ; Fix column ld l,0 ; Set row jp l02a2 ; Position cursor ; ; Control: FIND AND REPLACE STRING ; l323b: ld a,-1 ld (l447e),a ; Set replace flag call l31fd ; Get string searched for call l320b ; Get replace string call l3220 ; Get options jr l3252 ; Enter process ; ; Control: REPEAT LAST SEARCH ; l324b: call l2f8a ; Get character ld (iy+22),3 ; Init count l3252: call l3e40 ; Sample character call l3e23 ; Find last non blank inc hl ld de,(l4452) ; Get current edit pointer call l4191 ; Find min ld de,l7b74 or a sbc hl,de ; Subtract base ld de,(l4450) ; Get current memory pointer add hl,de ; Add for real address ld (l4488),hl ; Set end ld de,0 ; Clear counter ld hl,l44d2+1 ; Init buffer ld b,(hl) ; Fetch length ld (iy+17),0 ; Clear flag inc b ; Test any in buffer dec b jr z,l32c0 ; Nope l327d: inc hl ld a,(hl) ; Get character cp '0' ; Test possible count jr c,l3293 ; Nope cp '9'+1 jr nc,l3293 call l3426 sub '0' add a,e ; Add digit to count ld e,a jr nc,l32be inc d ; Remember carry jr l32be l3293: call l04a6 ; Convert to upper case cp 'W' ; Test whole word search jr nz,l329e set _W,(iy+17) l329e: cp 'U' ; Test ignore case jr nz,l32a6 set _U,(iy+17) l32a6: cp 'N' ; Test no request jr nz,l32ae set _N,(iy+17) l32ae: cp 'G' ; Test global jr nz,l32b6 set _G,(iy+17) l32b6: cp 'B' ; Test backwards jr nz,l32be set _B,(iy+17) l32be: djnz l327d l32c0: ld a,e ; Test loop count or d jr nz,l32c7 ; Yeap ld de,1 ; Set default l32c7: ld (l448a),de ; Save loop count ld hl,(l4544) ; Get start of text ld a,(l447d) ; Get option flags bit _B,a ; Test backwards jr z,l32d8 ; Nope ld hl,(l4546) ; Get end of text l32d8: bit _G,a ; Test global search jr nz,l32df ; Yeap ld hl,(l4488) ; Get end of search pointer l32df: ld (l4488),hl ; Set end of search pointer bit _B,(iy+17) ; Test backwards jr nz,l32f5 ; Yeap ld de,(l4546) ; Get end of text dec de call l3be2 ; Compare HL:DE jp nc,l3380 jr l32fb l32f5: call l3bee ; Fix to start of line jp c,l3380 l32fb: ld de,l4492 ld a,(l4491) ld b,a bit _B,(iy+17) ; Test backwards jr z,l330e ; Nope dec a add a,e ld e,a jr nc,l330e inc d l330e: bit _W,(iy+17) ; Test whole word search jr z,l3323 ; Nope push de push hl call l33fb ld a,(hl) pop hl pop de jr c,l3323 call l33e4 jr c,l3377 l3323: dec b inc b jr z,l332e l3327: call l340f jr nz,l3377 djnz l3364 l332e: bit _W,(iy+17) ; Test whole word search jr z,l3341 ; Nope push hl call l3406 ld a,(hl) pop hl jr c,l3341 call l33e4 jr c,l3377 l3341: bit _B,(iy+17) ; Test backwards call z,l3bdd ; Nope ld a,(l447e) ; Get find flag or a call nz,l3430 ; Replace selected bit _G,(iy+17) ; Test global search l3353: jr nz,l32df ld bc,(l448a) ; Get loop count dec bc ; Decrement ld (l448a),bc ld a,b or c jr nz,l3353 jr l33a9 l3364: push de call l3406 pop de jr c,l3380 bit _B,(iy+17) ; Test backwards jr z,l3374 ; Nope dec de jr l3327 l3374: inc de jr l3327 l3377: ld hl,(l4488) ; Get end of search pointer call l3406 jp nc,l32df l3380: call l33d6 call l33a9 bit _G,(iy+17) ; Test global search ret nz call l3e04 db 'Search string not found' db null jp l3f12 l33a9: call l33af jp l3d2c ; Restore line l33af: ld de,(l4546) ; Get end of text dec de call l3be2 ; Compare HL:DE jr c,l33ba ex de,hl l33ba: push hl push hl call l3bf5 ; Get previous EOL ld (l4450),hl ; Set current memory pointer or a ex de,hl pop hl sbc hl,de ld de,l7b74 add hl,de ld (l4452),hl ; Set current edit pointer call l3fe7 call l401f pop hl ret l33d6: ld de,(l4544) ; Get start of text call l4191 ; Find min ld hl,(l4546) ; Get end of text dec hl jp l4191 ; Find min l33e4: cp '0' jr c,l33f9 cp ':' ret c cp 'A' jr c,l33f9 cp 5bh ret c cp 61h jr c,l33f9 cp 7bh ret c l33f9: or a ret l33fb: bit _B,(iy+17) ; Test backwards jr z,l340c ; Nope l3401: call l3bdd ccf ret l3406: bit _B,(iy+17) ; Test backwards jr z,l3401 ; Nope l340c: jp l3bee ; Fix to start of line l340f: ld a,(de) cp 1 ret z cp (hl) ret z bit _U,(iy+17) ; Test ignore case jr z,l3424 ; Yeap call l33e4 jr nc,l3424 xor (hl) and 0dfh ret l3424: cp (hl) ret l3426: push hl ld l,e ld h,d add hl,hl add hl,hl add hl,de add hl,hl ex de,hl pop hl ret l3430: push hl call l428f ; Test look ahead buffer empty jr z,l343c ; Yeap bit _N,(iy+17) ; Test no request jr nz,l349d ; Yeap l343c: call l33a9 call l3b96 bit _N,(iy+17) ; Test no request jr nz,l349d ; Yeap call l3e07 db 'Replace (','Y'+MSB,'/','N'+MSB,'): ' db null l345b: ld l,(iy+5) ; Get row ld h,(iy+4) ; Get column call l02a2 ; Position cursor ld bc,l07d0 l3467: call l4232 ; Poll character from input call l428f ; Test look ahead buffer empty jr nz,l348c ; Nope dec bc ld a,c or b jr nz,l3467 ld hl,256*15+0 call l02a2 ; Position cursor ld bc,l07d0 l347d: call l4232 ; Poll character from input call l428f ; Test look ahead buffer empty jr nz,l348c ; Nope dec bc ld a,c or b jr nz,l347d jr l345b l348c: call l4271 ; Get character call l3ef6 ; Test function cancelled call l04a6 ; Convert to upper case cp 'Y' jr z,l349d cp 19h jr nz,l34eb l349d: set 0,(iy+19) xor a ld (l4542),a ; Force compile ld a,(l44b2) ld c,a ld b,0 pop hl push hl push bc ld a,(l4491) sub c ld c,a push af jr nc,l34b7 dec b l34b7: bit _B,(iy+17) ; Test backwards jr nz,l34c0 ; Yeap ld hl,(l4488) ; Get end of search pointer l34c0: pop af push hl call nz,l3f18 pop de pop bc ld a,b or c jr z,l34d0 ld hl,l44b3 ldir l34d0: call l428f ; Test look ahead buffer empty push af call nz,l4147 ; Nope, so reset row pop af jr nz,l34e2 ; Eas not empty push de call l3d2c ; Restore line call l4139 pop de l34e2: bit _B,(iy+17) ; Test backwards jr nz,l34eb ; Yeap pop hl ex de,hl ret l34eb: pop hl ret ; ; Control: WRITE BLOCK TO FILE ; l34ed: bit 0,(iy+20) ; Test block set ret nz ; Nope call l3e40 ; Sample character call l3d2c ; Restore line ld hl,(l4460) ; Get block start pointer ld de,(l4462) ; Get block end pointer call l3be2 ; Compare HL:DE ret nc ; Start >= end call l363c call l3d2c ; Restore line l3509: call l3e04 ; Tell what we want db 'Write block to file' db null call l3566 ; Get name of file ret z call l2d2a ; Prepare .PAS file ld c,.open call l26d3 ; Open file inc a ; Test file already exist jr z,l3551 ; Nope call l3e07 db 'Overwrite old ' db null ld de,l005c call l2df8 ; Tell name of file call l2d01 ; Ask for YES or NO jr z,l3509 ; No ld c,.delete call l26d3 ; Delete file l3551: ld hl,(l4462) ; Get block end pointer ld a,(hl) ; Save character push af push hl ld (hl),eof ; Set end of file call l3e0d ; Set cursor ld hl,(l4460) ; Get block start pointer call l2692 ; Save block to file pop hl pop af ld (hl),a ; Restore character ret ; ; Get name of file ; l3566: ld de,l44df call l313b ; Get filename ld de,l44df+2 ld a,(de) cp eof ; Test empty name ret ; ; Control: READ BLOCK FROM FILE ; l3573: call l3e04 ; Tell what we want db 'Read block from file' db null call l3566 ; Get name of file ret z call l2d2a ; Prepare .PAS file ld c,.open call l26d3 ; Open file inc a ; Test success jr nz,l35a8 ; Yeap call l3e0d ; Set cursor ld de,l005c call l2e3e ; Tell not found call l3f12 jr l3573 l35a8: res 0,(iy+20) ; Mark block call l363c ld hl,(l4546) ; Get end of text ld de,(l4548) ; Get top of available memory ld bc,l00fe add hl,bc ; Build top or a sbc hl,de ; Calculate size push hl ld b,h ld c,l ld hl,(l448c) scf call l3f18 pop de ld hl,l35dd ; Set return address push hl ld hl,(l448c) push hl xor a sbc hl,de push hl ld hl,l35f1 ld (l257c+1),hl ; Redirect load error jp l2560 ; Load the block ; ; Process end of read ; l35dd: ld (l4462),hl ; Set block end pointer ex de,hl ld hl,(l448c) ld (l4460),hl ; Set block start pointer l35e7: ld hl,(l7b6d) ; Get last memory address or a sbc hl,de ; Build difference ld b,h ld c,l jr l3612 ; ; Redirected load error ; l35f1: ld de,(l448c) call l35e7 jp l3ed9 ; ; Control: MOVE BLOCK ; l35fb: call l363c jp nc,l3d2c ; Restore line call l3687 ld hl,(l448c) ld de,(l4460) ; Get block start pointer ld (l4460),hl ; Set block start pointer add hl,bc ld (l4462),hl ; Set block end pointer l3612: ex de,hl or a call l3f18 ld hl,(l4460) ; Get block start pointer call l33a9 jp l3762 ; ; Control: COPY BLOCK ; l3620: call l363c jp nc,l3d2c ; Restore line call l3687 ld hl,(l448c) ld (l4460),hl ; Set block start pointer add hl,bc ld (l4462),hl ; Set block end pointer call l401f call l3d2c ; Restore line jp l3762 ; ; ; l363c: bit 0,(iy+20) ; Test block set jr z,l3644 ; Yeap xor a ret l3644: call l3e23 ; Find last non blank inc hl ld de,(l4452) ; Get current edit pointer push de call l4191 ; Find min ex de,hl call l3e44 ; Sample character pop hl ld de,l7b74 or a sbc hl,de ; Subtract base ld de,(l4450) ; Get current memory pointer add hl,de ; Build real pointer ld (l448c),hl push hl ld de,(l4460) ; Get block start pointer inc de call l3be2 ; Compare HL:DE ld de,(l4462) ; Get block end pointer jr c,l367a ; HL < Start_Of_Block call l3be2 ; Compare HL:DE jr nc,l367a ; HL >= End_Of_Block or a jr l3685 l367a: ld hl,(l4460) ; Get block start pointer or a sbc hl,de ld (l448e),hl ld c,l ld b,h l3685: pop hl ret ; ; ; l3687: call l3f18 ld bc,(l448e) ld a,c ; Negate value cpl ld c,a ld a,b cpl ld b,a inc bc ld de,(l448c) ld hl,(l4460) ; Get block start pointer push bc ldir pop bc ret ; ; Control: DELETE BLOCK ; l36a1: bit 0,(iy+20) ; Test block set ret nz ; Nope call l3e40 ; Sample character ld hl,(l4460) ; Get block start pointer call l3bf5 ; Get previous EOL ld (l4450),hl ; Set current memory pointer ld hl,(l4454) ; Get block pointer ld de,(l4460) ; Get block start pointer inc de call l3be2 ; Compare HL:DE jr c,l36ce ; HL < Start_Of_Block ld de,(l4462) ; Get block end pointer call l3be2 ; Compare HL:DE jr nc,l36ce ; HL >= End_Of_Block ld hl,(l4450) ; Get current memory pointer ld (l4454),hl ; Set block pointer l36ce: ld hl,(l4462) ; Get block end pointer ld de,(l4460) ; Get block start pointer or a sbc hl,de jp c,l3d2c ; Restore line if End < Start ld c,l ld b,h ex de,hl push hl push bc push af call l401f pop af pop bc pop hl call l3f18 ld hl,(l4450) ; Get current memory pointer ld (l4460),hl ; Set block start pointer ld (l4462),hl ; Set block end pointer call l3d2c ; Restore line jp l3762 ; ; Control: TOGGLE BLOCK DISPLAY ; l36f9: ld hl,l4480 ; Point to block mark call l3796 ; Toggle block bit jp l3762 ; ; Control: MARK END OF BLOCK ; l3702: ld hl,(l4452) ; Get current edit pointer ld (l4466),hl ; Set for end of block ld hl,(l4450) ; Get current memory pointer ld (l4462),hl ; Set block end pointer bit 1,(iy+1) ; Test end block set 1,(iy+1) l3716: ex af,af' bit 0,(iy+20) ; Test previous block set res 0,(iy+20) ; Set now jr nz,l3762 ; Was not set ex af,af' jr z,l3762 ; Prevous was also not set jr l374e ; ; Control: MARK BEGIN OF BLOCK ; l3726: ld hl,(l4452) ; Get current edit pointer ld (l4464),hl ; Save address ld hl,(l4450) ; Get current memory pointer ld (l4460),hl ; Set block start pointer bit 0,(iy+1) ; Test start block set 0,(iy+1) jr l3716 ; ; Control: BEGIN OF BLOCK ; l373c: call l3e40 ; Sample character ld hl,(l4460) ; Get block start pointer jp l33a9 ; ; Control: END OF BLOCK ; l3745: call l3e40 ; Sample character ld hl,(l4462) ; Get block end pointer jp l33a9 ; ; ; l374e: ld h,0 ; Set left column call l37a7 ; Set editor cursor ld hl,l7b74 ; Load base address set 0,(iy+16) call l3c1a res 0,(iy+16) ret ; ; ; l3762: call l374e jp l4147 ; Reset row ; ; Control: END OF TEXT ; l3768: call l3e40 ; Sample character ld hl,(l4546) ; Get end of text jp l33a9 ; ; Control: LINE LEFT ; l3771: ld hl,l7b74 ; Set start of line ld (l4452),hl ; Set current edit pointer jp l3fe7 ; ; Control: LINE RIGHT ; l377a: call l3e23 ; Find last non blank inc hl ld de,l7b74+_LinLen call l3be2 ; Compare HL:DE jr c,l3789 ld hl,l7b74+_LinLen-1 l3789: ld (l4452),hl ; Set current edit pointer jp l3fe7 ; ; Control: TOGGLE INSERT/OVERWRITE ; l378f: ld (iy+8),0 ; Set no change ld hl,l4472 ; Point to insert mode ; ; Toggle status bit ^HL ; l3796: ld a,(hl) ; Get value xor 1 ; Toggle bit ld (hl),a ret ; ; Control: TOGGLE TABULATE ; l379b: ld (iy+8),0 ; Set no change ld hl,l4479 jr l3796 ; Toggle tabulate bit ; ; Set current edit cursor ; l37a4: ld h,(iy+4) ; Get column ; ; Set editor cursor to current row ; ENTRY Reg H holds column position ; l37a7: ld l,(iy+5) ; Get row jp l02a2 ; Position cursor ; ; Control: LINE DOWN ; l37ad: ld hl,(l4450) ; Get current memory pointer call l41b1 ; Find next end of line ret c ; Out of text call l3e40 ; Sample character ld hl,(l4450) ; Get current memory pointer call l41b1 ; Find next end of line l37bd: ld (l4450),hl ; Set current memory pointer res 0,(iy+14) set 0,(iy+21) call l401f res 0,(iy+21) jp l3d2c ; Restore line ; ; Control: LINE UP ; l37d2: ld hl,(l4450) ; Get current memory pointer call l41d0 ; Find previous line ret c ; Below start of text push hl call l3e40 ; Sample character pop hl jr l37bd ; ; Control: SCROLL UP ; l37e0: ld hl,(l446a) ; Get start of screen ld de,(l4544) ; Get start of text call l3be2 ; Compare HL:DE ret z call l3e40 ; Sample character ld b,0 ld hl,(l4450) ; Get current memory pointer l37f3: ld de,(l446a) ; Get start of screen call l3be2 ; Compare HL:DE jr z,l3802 ; Match call l41d0 ; Find previous line inc b jr l37f3 l3802: ld de,(l4450) ; Get current memory pointer ld (l4450),hl ; Set current memory pointer ex de,hl ld a,(l0169) ; Get screen lines sub 3 ; Less status cp b jr nz,l3815 call l41d0 ; Find previous line l3815: push hl ld hl,(l4450) ; Get current memory pointer call l41d0 ; Find previous line call l37bd pop hl l3820: jr l37bd ; ; Control: SCROLL DOWN ; l3822: call l3e40 ; Sample character ld hl,(l4450) ; Get current memory pointer push hl ld hl,(l446a) ; Get start of screen ld a,(l0169) ; Get screen lines sub 2 ; Less status ld b,a l3832: call l41b1 ; Find next end of line djnz l3832 push af call l37bd pop af pop hl jr c,l3820 ld de,(l446a) ; Get start of screen call l3be2 ; Compare HL:DE jr nc,l3820 ; HL >= Start_Of_Screen call l41b1 ; Find next end of line jr l3820 ; ; Control: BOTTOM OF SCREEN ; l384d: ld hl,(l446a) ; Get start of screen ld de,(l4450) ; Get current memory pointer call l3be2 ; Compare HL:DE ret z ; Same push hl call l3e40 ; Sample character pop hl jr l3820 ; ; Control: TOP OF SCREEN ; l385f: call l3e40 ; Sample character ld hl,(l446a) ; Get start of screen ld a,(l0169) ; Get screen lines sub 3 ; Less status ld b,a l386b: call l41b1 ; Find next end of line djnz l386b jr l3820 ; ; Control: PAGE DOWN ; l3872: call l3e40 ; Sample character ld a,(l0169) ; Get screen lines sub 2 ; Less status ld c,a ld b,a ld hl,(l446a) ; Get start of screen l387f: call l41b1 ; Find next end of line djnz l387f ld (l446a),hl ; Set start of screen ld b,c ld hl,(l4450) ; Get current memory pointer l388b: call l41b1 ; Find next end of line djnz l388b l3890: ld (l4450),hl ; Set current memory pointer call l401f call l4147 ; Reset row jp l3d2c ; Restore line ; ; Control: PAGE UP ; l389c: call l3e40 ; Sample character ld a,(l0169) ; Get screen lines sub 2 ; Less status ld b,a ld c,a ld hl,(l446a) ; Get start of screen l38a9: call l41d0 ; Find previous line djnz l38a9 ld (l446a),hl ; Set start of screen ld b,c ld hl,(l4450) ; Get current memory pointer l38b5: call l41d0 ; Find previous line n-times djnz l38b5 jr l3890 ; ; Control: BEGIN OF TEXT ; l38bc: ld hl,(l446a) ; Get start of screen ld de,(l4544) ; Get start of text call l3be2 ; Compare HL:DE jr z,l38cb ; Same call l4147 ; Reset row l38cb: call l3e40 ; Sample character ld hl,(l4544) ; Get start of text ld (l4450),hl ; Set current memory pointer ld (l446a),hl ; Set start of screen call l401f call l3d2c ; Restore line ld hl,l7b74 ld (l4452),hl ; Init edit pointer jp l3fe7 ; ; Control: NEW LINE ; l38e6: bit 0,(iy+6) ; Test insert jr z,l38f2 ; New line call l37ad ; Line down jp l3771 ; Goto start of line l38f2: set 0,(iy+19) xor a ld (l4542),a ; Force compile ld a,lf call l03c9 ; Put new line to console call l3918 call l37a4 ; Set edit cursor bit 0,(iy+13) ; Test auto tab ret nz ; Yeap call l3a6b ; Position to previous line ret c ; Below start of text ld de,l43f2 call l412e ; Find blank jp c,l3a72 ; Yeap, insert tab ret ; ; ; l3918: call l3950 ld hl,(l4450) ; Get current memory pointer push hl call l3d2c ; Restore line call l3e40 ; Sample character pop hl call l41b1 ; Find next end of line ld (l4450),hl ; Set current memory pointer ld hl,l7b74 l392f: ld (l4452),hl ; Set current edit pointer call l3fe7 call l401f jp l3d2c ; Restore line ; ; Control: INSERT LINE ; l393b:: call l3950 call l0200 db cr,lf,null ld hl,(l4450) ; Get current memory pointer call l41b1 ; Find next end of line call l3c1a jp l3d2c ; Restore line ; ; ; l3950: call l3e40 ; Sample character ld a,(l01ae) ; Test insert line implemented or a push af call nz,l0262 ; Yeap: insert line pop af call z,l4139 ; Nope call l3e23 ; Find last non blank inc hl ; Skip ld de,(l4452) ; Get current edit pointer call l4191 ; Find min ld de,l7b74 or a sbc hl,de ; Subtract base l3970: ex de,hl ld hl,(l4450) ; Get current memory pointer add hl,de ; Add offset push hl scf ld bc,-2 call l3f18 pop hl ld (hl),cr ; Close line inc hl ld (hl),lf ret ; ; Control: CURSOR LEFT ; l3984: ld hl,(l4452) ; Get current edit pointer call l3c02 ; Move character left ret c ; Not possible l398b: ld (l4452),hl ; Set current edit pointer jp l3fe7 ; ; Control: CURSOR RIGHT ; l3991: ld hl,(l4452) ; Get current edit pointer call l3be8 ; Move character right ret nc ; Out off limit jr l398b ; Save new position ; ; Control: LAST CURSOR POSITION ; l399a: call l3e40 ; Sample character ld hl,(l4458) ; Get edit pointer call l3bf5 ; Get previous EOL ld (l4450),hl ; Set current memory pointer ld hl,(l445a) jp l392f ; ; Control: MARK SINGLE WORD ; l39ac: call l3a0b ; Word right call l39ea ; Word left ld hl,(l4452) ; Get current edit pointer l39b5: call l412a ; Find delimiter jr c,l39bf ; Yeap call l3be8 ; Move character right jr c,l39b5 ; Still in limit l39bf: ld (l4452),hl ; Set current edit pointer call l3702 ; Mark end call l39ea ; Word left jp l3726 ; Mark start ; ; ; l39cb: ld hl,(l4450) ; Get current memory pointer call l41d0 ; Find previous line jr c,l3a05 ; Below start push hl call l3e40 ; Sample character pop hl ld (l4450),hl ; Set current memory pointer res 0,(iy+14) call l401f call l3d2c ; Restore line call l3e23 ; Find last non blank jr l3a01 ; ; Control: WORD LEFT ; l39ea: ld hl,(l4452) ; Get current edit pointer l39ed: call l3c02 ; Move character left jr c,l39cb ; At beginning of line call l412a ; Find delimiter jr c,l39ed ; Yeap l39f7: call l3c02 ; Move character left jr c,l3a01 ; At beginning of line call l412a ; Find delimiter jr nc,l39f7 ; Nope l3a01: inc hl l3a02: ld (l4452),hl ; Set current edit pointer l3a05: ld hl,(l4452) ; Get current edit pointer jp l3fe7 ; ; Control: WORD RIGHT ; l3a0b: call l3e23 ; Find last non blank ld de,(l4452) ; Get current edit pointer push de xor a sbc hl,de jr nc,l3a19 inc a l3a19: ld (l7b71),a ; Set direction flag pop hl l3a1d: dec hl l3a1e: call l3be8 ; Move character right jr c,l3a4e ; Still in limit l3a23: ld hl,(l4450) ; Get current memory pointer call l41b1 ; Find next end of line ret c ; Out of text call l3e40 ; Sample character ld hl,(l4450) ; Get current memory pointer call l41b1 ; Find next end of line ld (l4450),hl ; Set current memory pointer res 0,(iy+14) call l401f call l3d2c ; Restore line ld hl,l7b74 ld (l4452),hl ; Init current edit pointer call l412a ; Find delimiter jr c,l3a1d ; Yeap jp l3fe7 l3a4e: call l412a ; Find delimiter jr nc,l3a1e ; Nope l3a53: call l3be8 ; Move character right jr c,l3a64 ; Still in limit ld a,(l7b71) ; Get direction or a jr nz,l3a23 call l3e23 ; Find last non blank inc hl ; Skip jr l3a02 l3a64: call l412a ; Find delimiter jr c,l3a53 ; Yeap jr l3a02 ; ; Position to previous line ; EXIT Reg HL points to line ; Carry set if below start of text ; l3a6b: ld hl,(l4450) ; Get current memory pointer call l41d0 ; Find previous line ret ; ; Control: TABULATE ; l3a72: call l3a6b ; Position to previous line ret c ; Below start of text ld a,(l4471) ; Get row push af ; Save it ld hl,(l4452) ; Get current edit pointer ld (l4468),hl ; Save it res 0,(iy+7) ; Disable video call l3e40 ; Sample character ld hl,(l4450) ; Get current memory pointer push hl call l41d0 ; Find previous line ld (l4450),hl ; Set current memory pointer call l3d2c ; Restore line ld hl,l43f2 ld (l7b72),hl ; Set pointer to reduced delimiters call l3a0b ; Word right ld hl,l43de ld (l7b72),hl ; Reset pointer to delimiters pop hl pop af ld (l4471),a ; Reset row ld (l4450),hl ; Reset current memory pointer call l3d2c ; Restore line set 0,(iy+7) ; Enable video bit 0,(iy+6) ; Test insert jp nz,l374e ; Nope ld hl,(l4452) ; Get current edit pointer ld de,(l4468) ; Get back previous pointer sbc hl,de ; Get difference ret c ; Nothing to clear ret z ex de,hl ; Get length l3ac5: push de call l41eb ; Make room ld (hl),' ' ; Insert blank pop de dec e jr nz,l3ac5 jp l374e ; ; Control: DELETE TO END OF LINE ; l3ad2: ld hl,(l4452) ; Get current edit pointer push hl call l3fc5 pop hl push hl ld de,l7b74+_LinLen-1 l3ade: ld (hl),' ' ; Clear character call l3be2 ; Compare HL:DE jr z,l3ae8 ; Match inc hl ; Advance jr l3ade l3ae8: pop hl jp l4197 ; ; Control: DELETE LINE ; l3aec:: ld hl,l7b74 ld (l4452),hl ; Set current edit pointer call l3fe7 call l3ad2 ; Delete to end of line call l3e40 ; Sample character ld hl,(l4450) ; Get current memory pointer push hl push hl call l41b1 ; Find next end of line pop de jr c,l3b10 ; Out of text or a sbc hl,de ; Fet length ld c,l ld b,h pop hl jp nz,l3b26 ret l3b10: pop hl jp l3d2c ; Restore line l3b14: call l3e44 ; Sample character ld hl,(l4450) ; Get current memory pointer call l41b1 ; Find next end of line jp c,l3d2c ; Restore line if out of text dec hl dec hl ld bc,2 or a l3b26: call l3f18 ld a,(l01b4) ; Test delete line implemented or a jr z,l3b3c ; Nope call l0259 ; Delete line ld a,(l0169) ; Get screen lines dec a call l3bbc jp l3d2c ; Restore line l3b3c: call l4139 jp l3d2c ; Restore line ; ; Control: DELETE RIGHT WORD ; l3b42: call l3e23 ; Find last non blank ld de,(l4452) ; Get current edit pointer call l3be2 ; Compare HL:DE ex de,hl jr c,l3b14 ; HL=DE l3c5e: call l3ca1 call l3cc0 ld de,(l4486) call l3be2 ; Compare HL:DE jr z,l3c89 ; Clear if same ld a,(hl) call l3bdd jr nc,l3c17 ; Clear line call l3c08 cp lf ; Test end of line jr z,l3c17 ; Clear on new line call l3c8b ; Process control character djnz l3c5e l3c7f: ld a,(hl) call l3bdd jr nc,l3c89 ; Clear line cp lf ; Test new line jr nz,l3c7f l3c89: jr l3c17 ; Clear line ; ; Process control character ; l3c8b: cp ' ' ; Test control character jr nc,l3c96 ; Nope add a,'@' ; Make ASCII push af call l3c99 ; Select video pop af l3c96: jp l03c9 ; Put to console ; ; Select video ; l3c99: ld a,(l00e0) ; Get video mode or a jr z,l3cec ; Make normal video jr l3cdf ; Set low video ; ; ; l3ca1: bit 0,(iy+16) ret z bit 0,(iy+20) ; Test block set jr nz,l3cec ; Nope, make normal video ld de,(l4464) ; Get block start address call l3be2 ; Compare HL:DE jr c,l3cec ; Make normal video ld de,(l4466) ; Get end of block pointer call l3be2 ; Compare HL:DE jr c,l3cdf ; Set low video jr l3cec ; Make normal video ; ; ; l3cc0: bit 0,(iy+16) ret nz bit 0,(iy+20) ; Test block set jr nz,l3cec ; Nope, make normal video ld de,(l4460) ; Get block start pointer call l3be2 ; Compare HL:DE jr c,l3cec ; Make normal video ld de,(l4462) ; Get block end pointer call l3be2 ; Compare HL:DE jr z,l3cec ; Make normal video jr nc,l3cec ; Make normal video ; ; Set low video ; l3cdf: ld a,(l00e0) ; Get video mode or a ; Test enabled ret z ; Nope bit 0,(iy+7) ; Test selected ret z ; Nope jp l026b ; Set low video ; ; Set normal video ; l3cec: ld a,(l00e0) ; Get video mode or a ; Test enabled ret nz ; Yeap bit 0,(iy+7) ; Test selected ret z ; Nope jp l0284 ; Set normal video ; ; Clear to end of line ; ENTRY Reg B holds column position ; l3cf9: inc b ; Test position dec b ret z ; Ignore left margin ld a,(l01bc) ; Test clear to end of line implemented or a jp nz,l0299 ; Yeap l3d03: ld a,' ' call l03c9 ; Put blanks to console djnz l3d03 ret ; ; Delete current line ; l3d0b: ld a,(l01b4) ; Test delete line implemented or a jr nz,l3d23 ; Yeap ld (l4474),a ; Set no change ld a,(l0169) ; Get screen lines dec a ld l,a ; Set row ld h,0 ; Set column call l02a2 ; Position cursor ld a,lf jp l03c9 ; Put new line to console l3d23: ld hl,256*0+1 call l02a2 ; Position cursor jp l0259 ; Delete line ; ; Control: RESTORE DELETED LINE ; l3d2c: ld hl,(l4450) ; Get current memory pointer ld de,0 ld (l4464),de ; Reset start of block pointer ld (l4466),de ; Reset end of block pointer ld b,_LinLen ; Set max length ld ix,l7b74 ; Set base address ld (iy+1),0 ; Clear block state l3d44: ld a,(hl) ld de,(l4460) ; Get block start pointer call l3be2 ; Compare HL:DE jr nz,l3d56 ; Not same addresses ld (l4464),ix ; Set start of block pointer set 0,(iy+1) ; Set start block l3d56: ld de,(l4462) ; Get block end pointer call l3be2 ; Compare HL:DE jr nz,l3d67 ; Not same addresses ld (l4466),ix ; Set end of block pointer set 1,(iy+1) ; Set end block l3d67: cp cr ; Test end of line jr nz,l3dc3 ; Nope ld (ix+0),' ' ; Fill with blank inc ix dec b jr z,l3dd9 call l3bdd jr nc,l3d44 l3d79: ld de,(l4462) ; Get block end pointer call l3be2 ; Compare HL:DE jr nc,l3d8a ; HL>= Start_Of_Block push hl ld hl,-1 ld (l4466),hl ; Set end of block pointer pop hl l3d8a: ld de,(l4460) ; Get block start pointer call l3be2 ; Compare HL:DE jr nc,l3d99 ; HL>= End_Of_Block ld hl,-1 ld (l4464),hl ; Set start of block pointer l3d99: ld a,_LinLen sub b ; Calculate remaining length ld (l446f),a ; Save relative column l3d9f: ld (ix+0),' ' ; Fill with blanks inc ix djnz l3d9f ld hl,(l4452) ; Get current edit pointer call l3fe7 bit 0,(iy+14) set 0,(iy+14) jp nz,l374e ld a,(l4475) ; Get current row dec a cp (iy+5) ; Test against row ret nc jp l374e l3dc3: cp lf ; Test end of line jr z,l3d79 ; Yeap ld (ix+0),a ; Store character inc ix dec b ; Test still room jr nz,l3dd1 ; Yeap jr l3dd9 ; Line too long l3dd1: call l3bdd jr nc,l3d79 jp l3d44 l3dd9: call l3e04 ; Tell error db 'Line too long - CR inserted' db null call l3f12 ld hl,_LinLen-2 call l3970 jp l3d2c ; Restore line ; ; ; l3e04: call l3ba4 l3e07: call l3e0d ; Set cursor jp l4211 ; ; Set cursor home ; l3e0d: ld (iy+8),0 ; Set no change ld hl,256*0+0 call l02a2 ; Position cursor call l3c12 ; Clear line ld hl,256*0+0 call l02a2 ; Position cursor jp l3cdf ; Set low video ; ; Find last non blank in current line ; EXIT Reg HL holds pointer to non blank ; l3e23: ld a,' ' ; Set what we are looking for ld hl,l7b74+_LinLen-1 ld de,l7b74-1 ; Init pointers l3e2b: cp (hl) ; Test match ret nz ; Nope, got it dec hl call l3be2 ; Test beginning jr nz,l3e2b ; Nope ret ; ; Get pointer within limits ; ENTRY Reg HL holds 1st pointer ; Reg BC holds 2nd pointer ; EXIT Reg HL unchanged if out of line ; Reg HL holds MIN(HL,BC) else ; l3e34: ld de,l7b74+_LinLen call l3be2 ; Compare HL:DE ret nc ; End found ld d,b ld e,c jp l4191 ; Find min ; ; Poll character, insert at end of line ; l3e40: call l3e23 ; Find last non blank inc hl ; Skip over ; ; Poll character, insert at current position ; ENTRY Reg HL holds current text address ; l3e44: ld c,l ; Copy pointer ld b,h ld hl,(l4464) ; Get start of block pointer call l3e34 ; Fix it ld (l4464),hl ; Set start of block pointer ld hl,(l4466) ; Get end of block pointer call l3e34 ; Fix it ld (l4466),hl ; Set end of block pointer ld l,c ld h,b inc hl ld de,l7b74 or a sbc hl,de ; Get relative position push hl ld a,(l446f) ; Get relative column sub l ; Subtract it ld c,a ld b,0 ; Expand for 16 bits jr nc,l3e6d ld b,-1 ; Signed expansion l3e6d: ld hl,(l4450) ; Get current memory pointer call nz,l3f18 pop bc ld ix,(l4450) ; Get current memory pointer ld hl,l7b74 ; Load base ld b,c ; Copy position dec b ; Test any inc b jr z,l3ea5 ; Nope l3e80: ld a,(hl) ; Get character ld de,(l4464) ; Get start of block pointer call l3be2 ; Compare HL:DE jr nz,l3e8e ; Not the same ld (l4460),ix ; Set block start pointer l3e8e: ld de,(l4466) ; Get end of block pointer call l3be2 ; Compare HL:DE jr nz,l3e9b ; Not the same ld (l4462),ix ; Set block end pointer l3e9b: ld (ix+0),a ; Unpack character inc hl inc ix djnz l3e80 dec ix l3ea5: ld a,cr ld (ix+0),a ; Set end of line ret ; ; Display characters left and check enough memory ; l3eab: ld hl,(l4548) ; Get top of available memory or a sbc hl,de ; Test remainder jr c,l3ed9 ; Nope ld bc,l00fe sbc hl,bc ; Test min ret nc ; Yeap add hl,bc push hl call l3e0d ; Set cursor pop hl ld b,0 call l30fe ; Tell bytes left call l4211 db ' byte(s) left' db null call l3f12 ; Wait for quit ret l3ed9: call l3e04 db 'ERROR: Out of space' db null call l3f12 ; Wait for quit jp l2ebd ; ; Test editor function cancelled ; l3ef6: cp @CAN ; Test cancel ret nz ; Nope call l3e04 db '*** INTERRUPTED' db null call l3f12 ; Wait for quit jp l2ebd ; ; Clear ahaed buffer and wait for user quit ; l3f12: call l422b ; Clear look ahead buffer jp l2e76 ; Get ESCape ; ; ; l3f18: push hl push bc jr nc,l3f96 ld de,(l4546) ; Get end of text push de push de ex de,hl or a sbc hl,de ex (sp),hl or a sbc hl,bc jp nc,l3ed9 ld e,l ld d,h push de call l3eab ; Test enough room pop de pop bc inc bc pop hl ld (l4546),de ; Set end of text ld a,b l3f3c: sub HIGH _SavLen jr c,l3f4d ld b,a push bc ld bc,_SavLen lddr ; Move down pop bc call l4232 ; Poll character from input jr l3f3c l3f4d: ld a,c or b jr z,l3f53 lddr l3f53: pop bc pop hl ex de,hl inc de ld hl,(l4460) ; Get block start pointer call l3f8e ld (l4460),hl ; Set block start pointer ld hl,(l4462) ; Get block end pointer call l3f8e ld (l4462),hl ; Set block end pointer ld hl,(l446a) ; Get start of screen call l3f8e ld (l446a),hl ; Set start of screen ld hl,(l4450) ; Get current memory pointer call l3f8e ld (l4450),hl ; Set current memory pointer ld hl,(l4454) ; Get block pointer call l3f8e ld (l4454),hl ; Set block pointer ld hl,(l4458) ; Get edit pointer call l3f8e ld (l4458),hl ; Set edit pointer ret ; ; ; l3f8e: call l3be2 ; Compare HL:DE ret c or a sbc hl,bc ret ; ; ; l3f96: push hl add hl,bc push hl ld de,(l4546) ; Get end of text inc de ex de,hl or a sbc hl,de ld c,l ld b,h pop hl pop de ld a,b l3fa7: sub HIGH _SavLen jr c,l3fb8 ld b,a push bc ld bc,_SavLen ldir ; Move up pop bc call l4232 ; Poll character from input jr l3fa7 l3fb8: ld a,c or b jr z,l3fbf ldir dec de l3fbf: ld (l4546),de ; Set end of text jr l3f53 ; ; ; l3fc5: push hl ld de,(l4464) ; Get start of block pointer call l4191 ; Find min bit 0,(iy+1) ; Test start block jr z,l3fd6 ; Nope ld (l4464),hl ; Set start of block pointer l3fd6: pop hl bit 1,(iy+1) ; Test end block ret z ; Nope ld de,(l4466) ; Get end of block pointer call l4191 ; Find min ld (l4466),hl ; Set end of block pointer ret ; ; ; l3fe7: ld de,l7b74 ; Get base address ld a,(l0168) ; Get screen columns dec a ld c,a or a sbc hl,de ld a,l sub (iy+0) jr c,l4012 cp c jr c,l400e sub c inc a add a,(iy+0) ld (l446c),a ld a,(l0168) ; Get screen columns dec a dec a ld (l4470),a ; Set column to end jp l3762 l400e: ld (l4470),a ; Set column ret l4012: add a,(iy+0) ld (l446c),a ld (iy+4),0 ; Clear column jp l3762 ; ; ; l401f: bit 0,(iy+7) ret z ld hl,(l446a) ; Get start of screen ld de,(l4544) ; Get start of text call l4191 ; Find min ex de,hl ld (l446a),hl ; Set max for start of screen ld bc,1 ld de,(l4450) ; Get current memory pointer call l3be2 ; Compare HL:DE jp z,l40da ; Same jr c,l4086 ; HL < Current_Pointer l4041: ld de,(l4450) ; Get current memory pointer call l3be2 ; Compare HL:DE jr z,l4055 ; Same call l41d0 ; Find previous line inc bc ld a,c or a call z,l4232 ; Poll character from input jr l4041 l4055: ld (l446a),hl ; Set start of screen ld (iy+5),1 ; Init row set 0,(iy+14) ld a,b or a jr nz,l4083 ; Teset row ld a,(l01ae) ; Test insert line implemented or a jr z,l4083 ; Nope ld a,(l0169) ; Get screen lines dec a cp c jr c,l4083 dec c ld hl,256*0+1 call l02a2 ; Position cursor dec c push af inc c l407b: call l0262 ; Insert line dec c jr nz,l407b pop af ret z l4083: jp l4147 ; Reset row l4086: ld de,(l4450) ; Get current memory pointer call l3be2 ; Compare HL:DE jr z,l409a ; Same call l41b1 ; Find next end of line inc bc ld a,c or a call z,l4232 ; Poll character from input jr l4086 l409a: ld a,b or a jr nz,l40de ld a,(l0169) ; Get screen lines dec a ld e,a ld a,c sub e ld d,a inc d jr c,l40da dec d jr nz,l40b3 bit 0,(iy+21) jp nz,l4103 l40b3: inc d sub e jr nc,l40de ld a,(l4475) ; Get current row sub d ; Test row jr c,l40de jr z,l40de ld (l4475),a ; Set row ld hl,(l446a) ; Get start of screen ld b,d push de l40c7: call l41b1 ; Find next end of line push hl call l3d0b ; Delete current line pop hl djnz l40c7 ld (l446a),hl ; Set start of screen pop de l40d5: dec e ld (iy+5),e ; Set row ret l40da: ld (iy+5),c ; Set row ret l40de: ld hl,(l446a) ; Get start of screen dec bc ld a,(l0169) ; Get screen lines sub 3 ld e,a ld a,c sub e ld c,a jr nc,l40ee dec b l40ee: call l41b1 ; Find next end of line dec bc ld a,c or b jr nz,l40ee ld (l446a),hl ; Set start of screen call l4147 ; Reset row set 0,(iy+14) jp l401f l4103: call l40d5 ld a,(l4475) ; Get current row ld l,a ld a,(l0169) ; Get screen lines cp l ld a,l jr z,l4117 dec a jr z,l4117 ld (l4475),a ; Set row l4117: ld hl,(l446a) ; Get start of screen call l41b1 ; Find next end of line ld (l446a),hl ; Set start of screen call l3d0b ; Delete current line ld a,(l0169) ; Get screen lines dec a jp l3bbc ; ; Find delimiter ; ENTRY Reg HL points to current text ; EXIT Carry set if delimiter found ; l412a: ld de,(l7b72) ; Get pointer to delimiters l412e: ld a,(de) ; Test end of list or a ret z ; Yeap cp (hl) ; Compare jr z,l4137 ; Got it inc de jr l412e l4137: scf ret ; ; Delete line if no ESC sequence present ; l4139: push af ld a,(l4471) ; Get row cp (iy+9) ; Compare jr nc,l4145 ld (l4475),a ; Set row l4145: pop af ret ; ; Reset row ; l4147: ld (iy+9),1 ; Init row ret ; ; Adjust pointer for inserting characters ; ENTRY Reg BC holds number of characters to be inserted ; l414c: ex de,hl bit 0,(iy+1) ; Test start block jr z,l415f ; Nope ld hl,(l4464) ; Get start of block pointer call l3be2 ; Compare HL:DE jr c,l415f ; Start_of_block < DE add hl,bc ; Add offset ld (l4464),hl ; Set start of block pointer l415f: bit 1,(iy+1) ; Test end block jr z,l4171 ; Nope ld hl,(l4466) ; Get end of block pointer call l3be2 ; Compare HL:DE jr c,l4171 ; End_of_block < DE add hl,bc ; Add offset ld (l4466),hl ; Set end of block pointer l4171: ex de,hl ret ; ; ; l4173: push hl ld bc,-1 call l414c ; Delete one character ex de,hl ld hl,l7b74+_LinLen-1 or a sbc hl,de jr z,l418a ; Same ld c,l ld b,h ld l,e ld h,d inc hl ldir ; Unpack l418a: ld hl,l7b74+_LinLen-1 ld (hl),' ' ; Clear last entry pop hl ret ; ; Get minimum of two addresses ; ENTRY Reg HL holds 1st address ; Reg DE holds 2nd address ; EXIT Regs swapped if 1st >= 2nd ; l4191: call l3be2 ; Compare HL:DE ret c ; HL < DE ex de,hl ; Swap ret ; ; ; l4197: call l37a4 ; Set edit cursor ld a,(l0168) ; Get screen columns dec a sub (iy+4) ; Subtract from column ld hl,(l4452) ; Get current edit pointer ld b,a set 0,(iy+16) call l3c41 res 0,(iy+16) ret ; ; Adjust for next end of line ; ENTRY Reg HL holds current pointer ; EXIT Reg HL holds pointer to next line ; Carry set if pointer behind end address ; l41b1: push bc ex de,hl ld hl,(l4546) ; Get end of text dec hl or a sbc hl,de ; Build difference ld b,h ld c,l inc bc ex de,hl ld d,h ld e,l jr c,l41cc ; Out of text ld a,lf cpir ; Find new line jp po,l41cc or a pop bc ret l41cc: scf ; Set out of text ex de,hl pop bc ret ; ; Adjust for previous end of line ; ENTRY Reg HL holds current pointer ; EXIT Reg HL holds pointer to previous line ; Carry set if pointer below start address ; l41d0: push bc ld c,l ; Save pointer ld b,h ld a,lf call l3bee ; Fix to start of line jr c,l41e7 ; Below l41da: call l3bee ; Fix to start of line jr z,l41e5 ; Got start jr c,l41e7 ; It's below start cp (hl) ; Find line feed jr nz,l41da ; Nope inc hl l41e5: pop bc ret l41e7: ld h,b ; Restore pointer ld l,c pop bc ret ; ; Adjust pointer for inserting one character ; l41eb: push hl ld bc,1 call l414c ; Adjust pointer for inserting one character ld de,l7b74+_LinLen-1 ex de,hl or a sbc hl,de ; Get difference dec hl ld c,l ld b,h ld de,l7b74+_LinLen-2 ld l,e ld h,d dec hl ld a,c or b ; Test any jr z,l420c ; Nope push de lddr ; Move characters pop hl ld (hl),' ' ; Clear character l420c: pop hl ret ; ; Position cursor and give immediate string ; ENTRY Reg H holds column ; Reg L holds row ; l420e: call l02a2 ; Position cursor l4211: jp l01fa ; Give string ; ; ##################################################### ; >>> Redirected console output during edit session <<< ; ##################################################### ; l4214: pop hl ex (sp),hl bit 0,(iy+7) jr z,l4220 push hl l421e equ $+1 call @DUMMY ; *** REDIRECTED *** l4220: ld a,(l4543) sub 2 ld (l4543),a ret nz jr l423e ; Poll character from input ; ; Clear look ahead buffer ; l422b: ld hl,(l445c) ; Get input queue pointer ld (l445e),hl ; Set for output queue pointer ret ; ; Poll character from input ; l4232: push af push bc push de push hl call l423e ; Poll character from input pop hl pop de pop bc pop af ret ; ; Poll character from input without register preserving ; l423e: ld hl,(l445e) ; Get output queue pointer call l4263 ; Bump it ld de,(l445c) ; Get input queue pointer ex de,hl sbc hl,de ; Test room in output queue ex de,hl ret z ; Nope push hl push ix push iy call l00a0 ; Test key pressed pop iy pop ix pop hl ret z ; No character available call l03e1 ; Read character ld (hl),a ; Store it ld (l445e),hl ; Set output queue pointer ret ; ; Bump and check ahead pointer ; ENTRY Reg HL holds current pointer ; EXIT Reg HL holds position within the queue ; l4263: inc hl ; Bump pointer ld de,l7b59+_Ahead or a ex de,hl sbc hl,de ; Test end of queue ex de,hl ret nz ; Nope ld hl,l7b59 ; Set start of queue ret ; ; Get character from console or ahead buffer ; l4271: push hl push de ld de,(l445c) ; Get input queue pointer ld hl,(l445e) ; Get output queue pointer or a sbc hl,de ; Test any in buffer ex de,hl jr z,l4289 ; Nope, buffer is empty call l4263 ; Bump queue pointer ld a,(hl) ; Get character ld (l445c),hl ; Set input queue pointer jr l428c l4289: call l03e1 ; Read character l428c: pop de pop hl ret ; ; Test look ahead buffer empty - Z set says yes ; l428f: push hl push de ld de,(l445c) ; Get input queue pointer ld hl,(l445e) ; Get output queue pointer or a sbc hl,de pop de pop hl ret ; l429e: dw l7bf5 ; Base of message file l42a0: db eof l42a1:: db 1,0dh db 1,1 db 1,0ffh db 1,6 db 1,0fah db 1,0fbh db 1,1fh db 1,1eh db 1,0f5h db 1,0f4h db 1,0f8h db 1,0f9h db 1,0f6h db 1,0f7h db 1,0ffh db 1,0ffh db 1,0ffh db 1,0ffh db 1,0ffh db 1,0ffh db 1,0ffh db 1,0e0h db 1,0ffh db 1,0ffh db 1,0ffh db 1,0ffh db 1,0ffh db 1,0ffh db 1,0ffh db 1,0ffh db 1,0ffh db 1,0ffh db 1,0ffh db 1,0ffh db 1,0ffh db 1,0ffh db 1,0ffh db 1,0ffh db 1,0ffh db 1,0ffh db 1,0ffh db 1,0ffh db 1,0ffh db 1,0ffh db 1,0ffh db 1,0ffh db 0,0ffh db 1,0ffh ; db 0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0 l4369:: ; ; Basic movement ; db 1,'M'-'@' db 1,'S'-'@' db 1,'H'-'@' db 1,'D'-'@' db 1,'A'-'@' db 1,'F'-'@' db 1,'E'-'@' db 1,'X'-'@' db 1,'W'-'@' db 1,'Z'-'@' db 1,'R'-'@' db 1,'C'-'@' ; ; Extended movement ; db 2,'Q'-'@','S'-'@' db 2,'Q'-'@','D'-'@' db 2,'Q'-'@','E'-'@' db 2,'Q'-'@','X'-'@' db 2,'Q'-'@','R'-'@' db 2,'Q'-'@','C'-'@' db 2,'Q'-'@','B'-'@' db 2,'Q'-'@','K'-'@' db 2,'Q'-'@','P'-'@' ; ; Insert and delete commands ; db 1,'V'-'@' db 1,'N'-'@' db 1,'Y'-'@' db 2,'Q'-'@','Y'-'@' db 1,'T'-'@' db 1,'G'-'@' db 1,DEL ; ; Block commands ; db 1,0ffh db 2,'K'-'@','B'-'@' db 2,'K'-'@','K'-'@' db 2,'K'-'@','T'-'@' db 2,'K'-'@','H'-'@' db 2,'K'-'@','C'-'@' db 2,'K'-'@','V'-'@' db 2,'K'-'@','Y'-'@' db 2,'K'-'@','R'-'@' db 2,'K'-'@','W'-'@' ; ; More commands ; db 2,'K'-'@','D'-'@' db 1,'I'-'@' db 2,'Q'-'@','I'-'@' db 2,'Q'-'@','L'-'@' db 2,'Q'-'@','F'-'@' db 2,'Q'-'@','A'-'@' db 1,'L'-'@' db 1,'P'-'@' db 0 l43de:: db '<>,[].*+-/$:=(){}^#''' l43f2:: db ' ',null l43f4:: ; ; Basic movement ; dw l38e6 ; NEW LINE dw l3984 ; CURSOR LEFT dw l3984 ; CURSOR LEFT dw l3991 ; CURSOR RIGHT dw l39ea ; WORD LEFT dw l3a0b ; WORD RIGHT dw l37d2 ; LINE UP dw l37ad ; LINE DOWN dw l37e0 ; SCROLL UP dw l3822 ; SCROLL DOWN dw l389c ; PAGE UP dw l3872 ; PAGE DOWN ; ; Extended movement ; dw l3771 ; LINE LEFT dw l377a ; LINE RIGHT dw l384d ; BOTTOM OF SCREEN dw l385f ; TOP OF SCREEN dw l38bc ; BEGIN OF TEXT dw l3768 ; END OF TEXT dw l373c ; BEGIN OF BLOCK dw l3745 ; END OF BLOCK dw l399a ; LAST CURSOR POSITION ; ; Insert and delete commands ; dw l378f ; TOGGLE INSERT/OVERWRITE dw @MSB+l393b ; INSERT LINE dw @MSB+l3aec ; DELETE LINE dw @MSB+l3ad2 ; DELETE TO END OF LINE dw @MSB+l3b42 ; DELETE RIGHT WORD dw @MSB+l3b73 ; DELETE RIGHT CHARACTER dw @MSB+l3b78 ; DELETE LEFT CHARACTER dw @MSB+l3b78 ; DELETE LEFT CHARACTER ; ; Block commands ; dw l3726 ; MARK BEGIN OF BLOCK dw l3702 ; MARK END OF BLOCK dw l39ac ; MARK SINGLE WORD dw l36f9 ; TOGGLE BLOCK DISPLAY dw @MSB+l3620 ; COPY BLOCK dw @MSB+l35fb ; MOVE BLOCK dw @MSB+l36a1 ; DELETE BLOCK dw @MSB+l3573 ; READ BLOCK FROM FILE dw l34ed ; WRITE BLOCK TO FILE ; ; More commands ; dw l2b0f ; EXIT EDITOR dw @MSB+l3a72 ; TABULATE dw l379b ; TOGGLE TABULATE dw @MSB+l3d2c ; RESTORE DELETED LINE dw l31f1 ; FIND STRING dw l323b ; FIND AND REPLACE STRING dw l324b ; REPEAT LAST SEARCH dw @MSB+l2f02 ; CONTROL PREFIX l4450:: dw 0 ; Current memory pointer l4452: dw l7b74 ; Current edit pointer l4454: dw 0 ; Block pointer l4456: dw l7b74 l4458: dw 0 ; Edit pointer l445a: dw l7b74 l445c: dw l7b59 ; Input queue pointer l445e: dw l7b59 ; Output queue pointer l4460: dw 0 ; Block start pointer l4462: dw 0 ; Block end pointer l4464: dw 2 ; Block start pointer l4466: dw 2 ; Block end pointer l4468: dw 0 ; Temporary edit pointer l446a: dw 0 ; Start of screen ; ; The editor status block ; l446c: db 0 ; + 0 db 0 ; + 1: Block state ; xxxxxxx1: Start set) ; xxxxxx1x: End set) db 1 ; + 2 l446f: db 1 ; + 3: Relative column l4470: db 0 ; + 4: Editor column l4471: db 1 ; + 5: Editor row l4472: db 0 ; + 6: Insert flag (Bit 0=0) db 1 ; + 7: Video flag (1 is reverse) l4474: db 0 ; + 8: Change flag l4475: db 1 ; + 9: Editor row l4476: db 0 ; +10 db 0 ; +11 l4478: db 0 ; +12 l4479: db 0 ; +13: Auto tabulate flag db 1 ; +14 db 1 ; +15 db 0 ; +16 l447d: db 0 ; +17: Option flags for search/replace ; 00000001: W: Whole word search ; 00000010: N: No request ; 00000100: U: Ignore case ; 00001000: G: Global search ; 00010000: B: Backwards l447e: db 0 ; +18: Find (0) or replace (-1) flag l447f: db 0 ; +19: Text change flag l4480: db 0 ; +20: Block marker (1: Not set) db 0 ; +21 l4482: db 3 ; +22 l4483: db 0,0,0 l4486: db 0,0 l4488: dw 0 ; End of search pointer l448a: dw 0 ; Search loop count l448c: dw 0 l448e: dw 0 ; ; Search buffer ; l4490: db 1eh l4491: db 0 l4492: db 0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0 ; ; Replace buffer ; l44b1: db 1eh l44b2: db 0 l44b3: db 0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0 ; ; Option buffer ; l44d2: db 0ah db 0,0,0,0,0,0,0,0,0,0,0,0 ; ; Block file name ; l44df: db 0fh db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 l44f1: db 0 ; File flag l44f2: db 0 ; Rename flag (1 is rename) l44f3: db 1 ; Compile flag: ; 1: Compile to memory ; 2: Compile to COM-file ; 3: Compile to CHN-file l44f4: dw l20e2 ; Start address of compiler l44f6: dw 0 ; Top of available memory l44f8: db 0 ; Logged disk l44f9: ds FCBlen ; Main file l451d: ds FCBlen l4541: db 0 ; Error message file flag (0 is not read) l4542: db 0 ; Compile flag l4543: db 0 l4544: dw l7bf5 ; Start of text l4546: dw l7bf5 ; End of text l4548: dw 0 ; Top of available memory ; ; %%%%%%%%%%%%%%%%%%%%%% ; %%% COMPILER ENTRY %%% ; %%%%%%%%%%%%%%%%%%%%%% ; l454a: ld (l7b71),sp ; Save stack ld hl,(l4546) ; Get end of text inc hl ld (l7bdf),hl ; Save for memory top inc h ; Allow a gap of 1024 bytes inc h inc h inc h ld (l7be1),hl ; Save for top of .COM file ld hl,(l790a) ; Get end of code ld (l7908),hl ; Save for start of data xor a ld h,a ld l,a ld (l7b91),a ; Clear ???? ld (l7b92),a ; Clear ???? ld (l7b94),a ; Clear ???? ld (l7ba2),a ; Clear end of file ld (l7ba0),a ; Clear end on break [option U+] ld (l7be3),a ; Clear back fix level ld (l790e),a ; Enable memory read ld (l7b96),a ; Clear OVERLAY number ld (l7bdb),a ; Clear file access ld (l7bdd),hl ; Clear record base ld (l7bef),hl ; Clear line count call l718f ; Test abort dec hl ld (l7933+_rrn),hl ; Set highest record ld a,_Char+1 ld (l7b93),a ; Set special type ld a,NOT (_Ropt+_Uopt) ld (l7b9d),a ; Set default options ld a,2*DefWITH ld (l7bc7),a ; Set depth for WITH ld hl,(l4544) ; Get start of text ld (l7bd7),hl ; Init source pointer ld (l7bd9),hl ld ix,l79d7 ; Init start of line ld (ix+0),null ; Set line empty ld hl,(l7904) ; Get code start address call l6cc2 ; Check chaining ld hl,(l4548) ; Get top of available memory dec hl ld (l7b77),hl ; Save ld d,h ld e,l ld bc,LenLab ; Get length of internal table or a sbc hl,bc ld (l7b73),hl ; Init label pointers ld (l7b75),hl ld (l7b7b),hl call l6bc7 ; Check enough memory ld hl,l731f+LenLab-1 lddr ; Unpack symbol table call l45ea ; Go compile ld a,(l7900) ; Get compile flag dec a ; Test compiling to file jr nz,l45e2 ; Nope call l6c96 ; Fix back level call l6cfd ; Write record l45e2: ld (l7906),iy ; Save new top of code xor a jp l72e3 ; Set special zero error ; ; Do the compiler task ; l45ea: call l6f95 ; Process line call l6e76 ; Find PROGRAM dw l7529 jr nz,l460a ; Nope call l4692 ; Build dummy label call l6f1b ; Test ( jr nz,l4607 ; Nope l45fc: call l4692 ; Build dummy label call l6f13 ; Test , jr z,l45fc ; Yeap, get next dummy call l6f6e ; Verify ) l4607: call l6f48 ; Verify ; l460a: ld a,.LD.SP ld hl,TPA call l6b94 ; Set LD SP,TPA ld hl,l79d7 ; Get start of source line ld a,(l7900) ; Get compile flag or a ; Test compile to memory jr z,l4621 ; Yeap ld de,l0080 call l6c30 ; Allow space for loader l4621: call l6b92 ; Set LD HL,L79D7 ld a,(l7b9d) ; Get options bit .Copt,a ; Test $C+ ld d,0 jr z,l462e ; Nope dec d l462e: push de ; Save flag ld a,.LD.BC call l6b9c ; Set LD BC,FLAG push iy ; Save PC call l6b97 ; Set dummy word ld hl,l0364 call l6b86 ; Set CALL INIPRG ld a,.LD.HL call l6b9c ; Set LD HL,1STFREE push iy ; Save PC call l6b97 ; Set dummy word ld a,.LD.DE call l6b9c ; Set LD DE,LASTFREE push iy ; Save PC call l6b97 ; Set dummy word ld hl,(l790a) ; Get end of code call l6b8a ; Set LD BC,TOPRAM ld a,(l7900) ; Get compile flag ld h,a ld l,.LD.A call l6b97 ; Set LD A,FLAG ld hl,l04d4 call l6b86 ; Set CALL RANGCHK call l469e ; Do a block call l52fc ld a,(ix+0) cp '.' ; Verify closing . call l72da db _DotExp ld hl,l20d4 call l6b82 ; Set JP HALT pop hl ; Get back PC for LASTFREE ld de,(l7908) ; Get start of data call l6c42 ; Store back pop hl ; Get back PC for 1STFREE call l6c3f ; Store back current PC pop hl ; Get back PC for FLAG pop de ; Get FLAG ld a,(l7ba0) ; Get end on break flag [option U+] ld e,a jp l6c42 ; Store it back ; ; Build dummy label ; l4692: ld hl,(l7b73) ; Get label pointer push hl ; Save it call l6d87 ; Get label pop hl ld (l7b73),hl ; Restore label pointer ret ; ; Perform a block ; l469e: ld a,(l7bc7) ; Get depth for WITH push af add a,a ; Double it ld e,a ld d,0 call l6c30 ; Allocate space for it push hl call l6b77 ; Set JP push iy ; Save PC push hl call l6b97 ; Set dummy word l46b3: call l6e5a ; Find statement db _Byte dw l7584 call l72da ; Must be db _BEGINexp ld a,(hl) ; Get type l46be: cp _Label ; Test LABEL jr nz,l46c7 ; Nope call l488e ; Process it jr l46b3 l46c7: cp _Const ; Test CONST jr nz,l46d0 ; Nope call l48b7 ; Process it jr l46be l46d0: cp _Type ; Test TYPE jr nz,l46d9 ; Nope call l4aeb ; Process it jr l46be l46d9: cp _Var ; Test VAR jr nz,l46e6 ; Nope call l4b2a ; Process it ld hl,(l7908) ; Get start of data ex (sp),hl jr l46be l46e6: cp _Overly ; Test OVERLAY jp nz,l485e ld a,(l7900) ; Get compile flag or a call l72d4 ; Must not be compiled to memory db _OvlDirErr ld hl,l7933+Fdrv ld de,l7bb2 ld bc,Fname ldir ; Copy name of file ld hl,l7b96 ; Point to OVERLAY number ld a,(hl) ; Get current number inc (hl) ; Advance it ex de,hl ; Get pointer to extension ld (hl),'0' ; Init extension inc hl ld b,'0'-1 ; Init tens l4709: inc b ; Divide by ten sub 10 jr nc,l4709 ld (hl),b ; Save tens inc hl add a,'9'+1 ; Calculate units ld (hl),a ; Save it ld hl,l1c59 call l6b86 ; Set CALL OVERLAY ld hl,-1 call l6b97 ; Save word ld hl,l7bb2 ; Point to name ld b,Fname+Fext l4724: ld a,(hl) call l6b9c ; Store name and extension inc hl djnz l4724 ld a,(l7900) ; Get compile flag dec a ; Test compiling to file jr nz,l473b ; Nope call l6c96 ; Fix back level xor a ld (l7be3),a ; Set back fix level call l6cfd ; Write record l473b: ld hl,(l7bdd) ; Get record base push hl ld hl,(l7902) ; Get code pointer push hl ld hl,(l7bb0) ; Get length of overlay push hl ld (l7902),iy ; Set code pointer ld hl,0 ld (l7bb0),hl ; Clear length of overlay ld hl,-FCBlen add hl,sp ; Let some space on stack for FCB ld sp,hl ex de,hl ld hl,l7933 ld bc,FCBlen ldir ; Unpack current FCB ld a,(l7900) ; Get compile flag dec a ; Test compiling to file jr nz,l478c ; Nope ld hl,l7bb2 ld de,l7933+Fdrv ld bc,Fname+Fext ldir ; Copy overlay FCB to .COM FCB ex de,hl ld b,FCBlen-Fdrv-Fname-Fext l4773: ld (hl),0 ; Clear remainder of FCB inc hl djnz l4773 ld de,l7933 push de ld c,.delete call l7265 ; Delete file pop de ld c,.make call l7265 ; Create new one inc a call l72d4 ; Must be success db _NoOvl l478c: xor a ld (l7bdb),a ; Clear file access ld (l7bdc),a ; Clear record pointer ld hl,(l7908) ; Get start of data ld (l7bab),hl ; Set for overlay l4799: call l6e5a ; Find PROCEDURE or FUNCTION db 1 dw l75a7 call l72da ; Must be either db _SUBexp ld a,(hl) ; Get type push iy ld hl,(l7933+_rrn) ; Get current record ld (l7bdd),hl ; Set record base ld hl,(l7908) ; Get start of data push hl ld hl,(l7bab) ; Get address of overlay data push hl ld e,-1 call l4b3a ; Perform PROCEDURE/FUNCTION ld b,h ld c,l pop de ; Get back overlay data ld hl,(l7908) ; Get start of data or a sbc hl,de ; Test min add hl,de jr c,l47c6 ex de,hl ; Swap addresses l47c6: ld (l7bab),hl ; Set address of overlay data pop hl ld (l7908),hl ; Set start of data pop de push bc push de ld a,(l7900) ; Get compile flag dec a ; Test compiling to file call z,l6c96 ; Yeap, fix back level xor a ld (l7be3),a ; Reset back fix level pop de push de l47dd: push iy ; Copy code pointer pop hl or a sbc hl,de ; Get difference ld a,l and RecLng-1 ; Test record boundary jr z,l47ee ; Yeap xor a call l6b9c ; Fill remainder with zeroes jr l47dd l47ee: add hl,hl ; Calculate lenght in bytes ld e,h ld d,0 rl d ld hl,(l7bb0) ; Get length of overlay sbc hl,de ; Test max jr nc,l47ff ld (l7bb0),de ; Set new length l47ff: pop iy ; Get back PC pop hl inc hl ld (hl),e ; Save record inc hl ld (hl),d call l6e76 ; Find more OVERLAY dw l759f jr z,l4799 ; Yeap ld hl,(l7bab) ; Get address of overlay data ld (l7908),hl ; Set start of data ld a,(l7900) ; Get compile flag dec a ; Test compiling to file jr nz,l4821 ; Nope ld de,l7933 ld c,.close call l7265 ; Close file l4821: ld hl,0 add hl,sp ; Copy stack ld de,l7933 ld bc,FCBlen ldir ; Get back original .COM FCB ld sp,hl ld de,(l7bb0) ; Get length of overlay pop hl ld (l7bb0),hl ; Set new length pop hl ld (l7902),hl ; Set code pointer pop hl ld (l7bdd),hl ; Set record base xor a ld (l7bdb),a ; Clear file access ld hl,-1 ld (l7933+_rrn),hl ; Set highest record number push iy pop hl call l6cc2 ; Check chaining l484e: ld b,RecLng l4850: xor a call l6b9c ; Clear record djnz l4850 dec de ld a,d ; Test all done or e jr nz,l484e jp l46b3 l485e: cp _Begin ; Test BEGIN jr z,l486a ; Yeap ld e,0 call l4b3a ; Perform PROCEDURE/FUNCTION jp l46b3 l486a: call l4e8a ; Process it pop de pop hl push de push iy ; Copy PC pop de dec de ; Fix it dec de or a sbc hl,de ; Calculate size add hl,de jr z,l4880 call l6c3f ; Store back PC jr l4884 l4880: dec hl call l6cc2 ; Check chaining l4884: pop de pop hl ld (l7bca),hl pop af ld (l7bc6),a ret ; ; Process LABEL ; l488e: ld de,256*1+0 call l6d75 ; Put to table ld a,(ix+0) call l7282 ; Test valid character call l6d8d ; Build label ld a,(l7b94) ; Get ??? call l6d7a ; Put to label ld b,3 l48a5: ld a,-1 call l6d7a ; Set end djnz l48a5 call l6dc6 ; Set label pointer call l6f13 ; Test , jr z,l488e ; Yeap jp l6f48 ; Verify ; ; ; Process CONST ; l48b7: ld hl,(l7b73) ; Get label pointer push hl ld de,256*0+0 call l6d75 ; Put to table call l6d87 ; Get label call l6f23 ; Test = jr nz,l4901 ; Nope, must be : then call l6a0d ; Get constant ld a,b ; Get type call l6d7a ; Store into table ld a,b ; Get back type cp _Real ; Test real jr nz,l48e3 ; Nope exx push hl ; Save reals push de push bc ld b,3 ; Set word count l48db: pop de ; Get part of real call l6d75 ; Put to table djnz l48db jr l48fa l48e3: cp _String ; Test string jr nz,l48f6 ; Nope, must be integer ld hl,l7a57 ; Get buffer ld a,c ; Get length inc c ; Fix it l48ec: call l6d7a ; Put to table ld a,(hl) inc hl dec c jr nz,l48ec jr l48fa l48f6: ex de,hl ; Get integer call l6d75 ; Put to table l48fa: call l6dc6 ; Set label pointer ld d,2 jr l4928 l4901: call l6f40 ; Verify : xor a call l6d7a ; Store zero in table call l6d72 ; Store PC to table ld hl,(l7b73) ; Get label pointer push hl call l6d75 ; Put to table call l6dc6 ; Set label pointer call l4f9b ; Get type pop hl ; Get back label pointer ld de,(l7b5a) ; Get type table ld (hl),d ; Store into dec hl ld (hl),e call l6f76 ; Verify = call l4937 ; Assign constant ld d,4 l4928: pop hl ; Get back label pointer ld (hl),d ; Put into call l6f48 ; Verify ; call l6e5a ; Find statement db 1 dw l7584 jr nz,l48b7 ; Nope ld a,(hl) ; Get type ret ; ; Process presetted constant ; l4937: ld a,(l7b5c) ; Get type cp _Ptr ; Test valid jr c,l4946 ; May not be a file cp _String jr nc,l4946 call l72e1 db _InvFilPtr l4946: cp _Array ; Test ARRAY constant jr nz,l49a1 ; Nope call l6d2a ; Save environment ld hl,(l7b60) ; Get hi set limit call l5271 ; Load name ld hl,(l7b6d) ; Get last memory address ld de,(l7b6b) or a sbc hl,de inc hl push hl ld hl,(l7b5e) ; Get lo set limit call l5287 ; Get name pop de ld a,(l7b5c) ; Get type cp _Char ; Test character jr nz,l4978 ld a,d ; Test byte or a jr nz,l4978 ; Nope call l6f1b ; Test ( jr nz,l498a ; Nope jr l497b l4978: call l6f66 ; Verify ( l497b: push de call l4937 ; Recursive assign constant pop de dec de ld a,d or e jr z,l499a call l6f5e ; Verify , jr l497b l498a: push de call l69fd ; Get string constant pop de ld a,c ; Get length cp e call l72da ; Verify valid length db _StrConst call l6b62 ; Store string jr l499d l499a: call l6f6e ; Verify ) l499d: call l6d49 ; Get back environment ret l49a1: cp _Record ; Test RECORD constant jr nz,l49fa ; Nope call l6d2a ; Save environment call l6f66 ; Verify ( ld a,(l7b5d) ld c,a ld hl,(l7b62) ; Get length of type push hl ld hl,0 l49b6: push bc push hl ld b,_Ptr call l6e54 ; Get pointer label call l72da ; Should be found db _Undef call l5276 ; Get values and name pop de ld hl,(l7b58) ; Get value or a sbc hl,de add hl,de call l72da ; Verify valid size db _InvSetOrder ld de,(l7b62) ; Get length of type add hl,de push hl call l6f40 ; Verify : call l4937 ; Assign constant recursively pop hl pop bc call l6f0f ; Test ; jr z,l49b6 ; Yeap call l6f6e ; Verify ) pop de ex de,hl or a sbc hl,de l49eb: ld a,h ; Test zero or l jr z,l49f6 ; Yeap xor a call l6b9c ; Fill zeroes dec hl jr l49eb l49f6: call l6d49 ; Get back environment ret l49fa: cp _Set ; Test SET constant jr nz,l4a7a ; Nope call l6d2a ; Save environment ld hl,(l7b62) ; Get length of type ld (l7b6f),hl ld hl,(l7b5e) ; Get lo set limit call l5287 ; Get name call l6f30 ; Verify [ ld (l7ba9),ix ; Save line pointer call l0581 ; Initialize a set on stack ld ix,(l7ba9) ; Get back line pointer call l6ef7 ; Test ] jr z,l4a4b ; Yeap l4a20: call l4aca push hl call l6e76 ; Find .. dw l7580 jr nz,l4a37 ; Nope call l4aca ld (l7ba9),ix ; Save source pointer call l059b ; Init a contiguous set value jr l4a3f l4a37: pop hl ld (l7ba9),ix ; Save source pointer call l0591 ; Init one set element l4a3f: ld ix,(l7ba9) ; Get back source pointer call l6f13 ; Test , jr z,l4a20 ; Yeap call l6f38 ; Verify ] l4a4b: ld hl,l7a57 ld bc,set.len ld (l7ba9),ix ; Save source pointer call l0612 ; Assign set variable ld ix,(l7ba9) ; Get back source pointer ld hl,l7a57 ld a,(l7b5e) ; Get lo set limit rra ; Divide by 8 rra rra and set.len-1 ; Get modulo ld e,a ld d,0 add hl,de ; Build pointer ld a,(l7b6f) ; Get length ld b,a l4a6f: ld a,(hl) ; Get bytes call l6b9c ; Store them inc hl djnz l4a6f call l6d49 ; Get back environment ret l4a7a: cp _String ; Test STRING constant jr nz,l4a99 ; Nope call l69fd ; Get string constant ld a,(l7b62) ; Get length of string dec a sub c ld b,a jr nc,l4a8d add a,c ld c,a ; Set length ld b,0 l4a8d: call l6b5e ; Put string inc b l4a91: dec b ret z xor a call l6b9c ; Fill zeroes jr l4a91 l4a99: cp _Real ; Test REAL constant jr nz,l4abc ; Nope call l69ea ; Get constant ld a,b ; Get type cp _Real ; Test real jr z,l4aaf ; Yeap cp _Integ ; Test integer call l72da ; Should be db _IntRealCexp call l1008 ; Convert to real exx l4aaf: exx push bc push de push hl ld b,real.len/2 ; Set word count l4ab5: pop hl call l6b97 ; Save real number djnz l4ab5 ret l4abc: call l4aca ld a,(l7b62) ; Get length of type dec a ld a,l jp z,l6b9c ; Set byte jp l6b97 ; Or set word ; ; ; l4aca: call l69ea ; Get constant ld a,(l7b5c) ; Get type cp b ; Verify same types call l72da db _InvType ld de,(l7b5e) ; Get lo set limit call l728d ; Compare jr c,l4ae7 ; Out of range ld de,(l7b60) ; Get hi set limit call l728d ; Compare ret c ret z l4ae7: call l72e1 db _ConstRange ; ; Process TYPE ; l4aeb: ld hl,(l7b73) ; Get label pointer push hl l4aef: ld hl,(l7b73) ; Get label pointer push hl ld de,0 call l6d75 ; Put to table call l6d87 ; Get label ld hl,(l7b73) ; Get label pointer push hl call l6d75 ; Put to table call l6dc6 ; Set label pointer call l6f76 ; Verify = call l4f9b ; Get type pop hl ld de,(l7b5a) ; Get type table ld (hl),d ; Store into dec hl ld (hl),e pop hl ld (hl),3 call l6f48 ; Verify ; call l6e5a ; Find statement db _Byte dw l7584 jr nz,l4aef ; Nope ld a,(hl) ; Fetch type pop hl push af call l5295 pop af ret ; ; Process VAR ; l4b2a: call l4f35 call l6f48 ; Verify ; call l6e5a ; Find statement db _Byte dw l7584 jr nz,l4b2a ; Nope ld a,(hl) ; Fetch type ret ; ; Perform PROCEDURE/FUNCTION ; ; Accu holds PROCEDURE or FUNCTION ; Reg E holds overlay flag (-1) ; l4b3a: ld b,a ld c,0 sub _Proc ; Get type ld (l7b97),a ; 0 is PROCEDURE ld a,e ; Get overlay ld (l7b99),a ; 0 is normal ld a,(l7b9d) ; Get options ld (l7b9e),a ; Set local options push bc call l6ddb jp z,l4c61 pop de call l6d75 ; Put to table call l6d87 ; Get label ld hl,(l7b7b) ; Get current label pointer push hl ld hl,(l7b75) ; Get previous label pointer ld (l7b7b),hl ld hl,(l7b73) ; Get label pointer push hl call l6d75 ; Put to table call l6d75 ; Multiple call l6d75 call l6d75 ld de,(l7bdd) ; Get record base call l6d75 ; Put to table ld de,0 call l6d75 ; Put to table call l6f1b ; Test ( ld b,0 ; Clear parameter count jr nz,l4bda ; Nope l4b88: push bc ld hl,(l7b73) ; Get label pointer push hl call l6d75 ; Put to table call l6d75 ; Twice call l6e76 ; Find VAR dw l7595 ld bc,0 jr nz,l4b9e ; Nope dec c ; Indicate VAR l4b9e: push bc call l6d87 ; Get label pop bc inc b ; Count parameters call l6f13 ; Test , jr z,l4b9e ; Yeap push bc call l6f0b ; Test : jr nz,l4bb8 ; Nope ld a,c ld (l7b8f),a ; Save state call l4f18 ; Get variable jr l4bc3 l4bb8: inc c ; Verify not VAR call l72da db _SemiExp ld hl,l750b+7 ld (l7b5a),hl ; Init type table l4bc3: pop bc pop hl ld (hl),b dec hl ld (hl),c ld de,(l7b5a) ; Get type table dec hl ld (hl),d ; Store into dec hl ld (hl),e pop bc inc b call l6f0f ; Test ; jr z,l4b88 ; Yeap call l6f6e ; Verify ) l4bda: push bc ld a,(l7b97) or a ; Test PROCEDURE jr z,l4c07 ; Yeap call l6f40 ; Verify : xor a ld (l7b8f),a call l4f18 ; Get variable ld a,(l7b5c) ; Get type cp _String ; Test range jr nc,l4bf8 cp _Ptr ; Should be pointer call l72da db _InvResult l4bf8: pop bc pop hl push hl push bc ld de,-4 add hl,de ; Fix pointer ld de,(l7b5a) ; Get type table ld (hl),d ; Store into dec hl ld (hl),e l4c07: pop bc pop de pop hl ld (l7b7b),hl ; Restore current label pointer push de push bc call l6dc6 ; Set label pointer call l6f48 ; Verify ; ld a,(l7b99) or a ; Test overlay jr nz,l4c44 ; Yeap call l6e76 ; Find FORWARD dw l7533 jr nz,l4c2c ; Nope push iy ; Copy PC pop de call l6b82 ; Set JP ld a,-1 jr l4c38 l4c2c: call l6e76 ; Find EXTERNAL dw l753a jr nz,l4c44 ; Nope call l69f2 ; Get integer constant ex de,hl xor a l4c38: pop bc pop hl ld (hl),a ; Store values dec hl ld (hl),b dec hl ld (hl),d ; Set address dec hl ld (hl),e jp l6f48 ; Verify ; l4c44: pop bc pop hl push hl ld (hl),0 ; Set values dec hl ld (hl),b dec hl push iy ; Copy PC pop de ld a,(l7b99) or a ; Test overlay jr z,l4c5b ; Nope ex de,hl ld bc,-16 add hl,bc ; Fix value ex de,hl l4c5b: ld (hl),d ; Save address dec hl ld (hl),e pop hl jr l4c76 l4c61: ld a,(hl) or a call l72d4 ; Verify label not found db _DoubleLab ld a,(l7b99) or a ; Test overlay (0 is not) call l72da ; Verify not FORWARD overlay db _OvlFORW call l6e96 ; Set new pointer pop de call l6f48 ; Verify ; l4c76: ex de,hl ld a,(l7b9d) ; Get option ld hl,(l7908) ; Get start of data bit .Aopt,a ; Test $A+ - absolute code for recursion jr z,l4c84 ; Yeap ld hl,0 l4c84: ld (l7b83),hl ld hl,(l7b7b) ; Get current label pointer push hl ld hl,(l7b73) ; Get label pointer ld (l7b7b),hl ; Into current push hl ex de,hl ld a,(hl) ld (hl),0 dec hl ld b,(hl) dec hl ld d,(hl) dec hl ld e,(hl) dec hl or a jr z,l4ca7 push hl ex de,hl inc hl call l6c3f ; Store back PC pop hl l4ca7: ld a,(l7b97) or a ; Test PROCEDURE jr z,l4cd2 ; Yeap ld d,(hl) dec hl ld e,(hl) dec hl push hl ex de,hl call l5287 ; Get name ld a,(l7b5c) ; Get type ld (l7b87),a ld hl,(l7b62) ; Get length of type ld a,l ld (l7b88),a ; save lo ex de,hl call l6c30 ; Allocate space ld (l7b89),hl ex de,hl pop hl ld (hl),d dec hl ld (hl),e dec hl jr l4cd6 l4cd2: ld de,-4 add hl,de l4cd6: ld de,-4 add hl,de push hl ld c,0 ld a,b or a jr z,l4d2b l4ce1: ld a,(hl) add a,c ld c,a push bc ld b,(hl) dec hl ld a,(hl) ld (l7b8f),a dec hl ld d,(hl) ; Get type table dec hl ld e,(hl) dec hl push hl ex de,hl ld (l7b5a),hl ; Save type table call l5287 ; Get name ld hl,(l7b73) ; Get label pointer ex (sp),hl push bc l4cfd: push bc ld de,4*256+0 call l6d75 ; Put to table l4d04: ld a,(hl) call l6d7a ; Store into table bit _MB,(hl) ; Test end of table dec hl jr z,l4d04 ; Nope push hl call l6d7a ; Store last byte into table call l6d75 ; Put to table call l6d75 call l6dc6 ; Set label pointer pop hl pop bc djnz l4cfd pop bc ex (sp),hl xor a ld (l7b90),a call l4f52 pop hl pop bc djnz l4ce1 l4d2b: ld b,c push bc ld hl,(l7b73) ; Get label pointer push hl ld hl,(l7b83) push hl ld hl,(l7b89) push hl ld a,(l7b87) push af ld a,(l7b88) push af ld a,(l7b97) ; Get PROCEDURE/FUNCTION flag push af ; Save it ld hl,l7b94 ; Point to ??? inc (hl) call l469e ; Perform a block pop af ld (l7b97),a ; Reset flag pop af ld (l7b88),a pop af ld (l7b87),a pop hl ld (l7b89),hl pop hl ld (l7b83),hl ld (l7b85),de ld a,h or l jr z,l4d79 sbc hl,de jr z,l4d79 call l6b8a ; Set LD BC,val16 ex de,hl call l6b92 ; Set LD HL,val16 ld hl,l0508 ; Set recursion routine call l6b86 ; Set CALL RECUR l4d79: pop hl pop bc inc b dec b jp z,l4df3 call l6b50 ; Set POP IY db @L1 $I1: POP IY @L1 equ $-$I1 l4d86: push bc inc hl ld e,(hl) inc hl ld d,(hl) add hl,de push hl dec hl dec hl l4d8f: bit _MB,(hl) ; Test end of string dec hl jr z,l4d8f ; Nope call l5276 ; Get values and name ld a,(l7b57) or a jr nz,l4dd4 ld a,(l7b5c) ; Get type cp _Set jr c,l4dbd jr z,l4de6 cp _Ptr jr z,l4de3 cp _String jr c,l4dbd jr z,l4de6 cp _Integ jr nc,l4de3 call l6b50 ; Set POP sequence db @L2 $I2: POP HL POP DE POP BC @L2 equ $-$I2 jr l4de6 l4dbd: call l6b73 ; Set POP HL ld hl,(l7b58) ; Get value call l6b8e ; Set LD DE,val16 ld hl,(l7b62) ; Get length of type call l6b8a ; Set LD BC,val16 call l6b50 ; Set LDIR db @L3 $I3: LDIR @L3 equ $-$I3 jr l4de9 l4dd4: xor a ld (l7b57),a ld a,_Ptr ld (l7b5c),a ; Set POINTER ld hl,2 ld (l7b62),hl ; Set length of pointer type l4de3: call l6b73 ; Set POP HL l4de6: call l661b l4de9: pop hl pop bc djnz l4d86 call l6b50 ; Set PUSH IY db @L4 $I4: PUSH IY @L4 equ $-$I4 l4df3: call l52fc ld hl,l7b94 ; Point to ??? dec (hl) ld a,(l7b97) or a ; Test PROCEDURE jr z,l4e46 ; Yeap ld hl,(l7b89) ld a,(l7b87) cp _String jr nz,l4e24 ld b,a call l6b50 ; Set POP IY db @L5 $I5: POP IY @L5 equ $-$I5 ld a,.LD.HL call l6b94 ; Set LD HL,val16 ld hl,l053a call l6b86 ; Move string to stack call l6b50 db @L6 $I6: PUSH IY @L6 equ $-$I6 jr l4e46 l4e24: cp _Real jr nz,l4e35 ld a,.LD.HL call l6b94 ; Set LD HL,val16 ld hl,l052c call l6b86 ; Set load real jr l4e46 l4e35: ld a,.LD@HL call l6b94 ; Set LD HL,(adr16) ld a,(l7b88) dec a jr nz,l4e46 call l6b50 ; Set LD H,0 db @L7 $I7: LD H,0 @L7 equ $-$I7 l4e46: ld hl,(l7b83) ld a,h or l jr z,l4e74 ld de,(l7b85) sbc hl,de jr z,l4e74 ld a,(l7b97) or a ; Test PROCEDURE jr z,l4e65 ; Yeap ld a,(l7b87) cp _String ld a,.EXX call nz,l6b9c ; Set EXX l4e65: call l6b8a ; Set LD BC,val16 ex de,hl call l6b8e ; Set LD DE,val16 ld hl,l0522 call l6b82 ; Set end of recursive routine jr l4e79 l4e74: call l6b50 ; Set RET db @L8 $I8: RET @L8 equ $-$I8 l4e79: call l6f48 ; Verify ; pop de pop hl ld (l7b73),hl ; Set label pointers ld (l7b75),hl pop hl ld (l7b7b),hl ; Restore current label pointer ex de,hl ret ; ; Process BEGIN ; l4e8a: ld hl,(l7b73) ; Get label pointer l4e8d: ld de,(l7b7b) ; Get current label pointer or a sbc hl,de add hl,de ret z ; End on level 0 inc hl ld e,(hl) inc hl ld d,(hl) add hl,de ld a,(hl) cp 6 jr z,l4ea4 cp 5 jr nz,l4e8d l4ea4: push hl dec hl dec hl l4ea7: bit _MB,(hl) ; Find end of string dec hl jr z,l4ea7 ld a,(hl) ; Get type or a call l72da ; Maybe undefined FORWARD db _UndefFORW pop hl jr l4e8d ; ; ; l4eb5: ld hl,(l7b73) ; Get label pointer push hl ld b,0 l4ebb: push bc ld d,_Ptr ; Set type ld a,(l7b91) ; Get ??? ld e,a call l6d75 ; Put to table call l6d87 ; Get label call l6d7a ; Store into table call l6d75 ; Put to table call l6d75 ; Twice call l6dc6 ; Set label pointer pop bc inc b call l6f13 ; Test , jr z,l4ebb ; Yeap pop hl ret ; ; ; l4edd: ld hl,(l7b73) ; Get label pointer push hl call l4f9b ; Get type pop hl call l5295 call l6e76 ; Test ABSOLUTE dw l7562 ld a,0 jr nz,l4f14 ; Nope ld a,(l7b91) ; Get ??? or a call l72da db _InvalABS ld bc,256*_Ptr+0 call l6e54 ; Find label jr nz,l4f0c ; Nope ld a,(hl) ld (l7b8f),a dec hl ld d,(hl) dec hl ld e,(hl) ex de,hl jr l4f0f l4f0c: call l69f2 ; Get integer constant l4f0f: ld (l7b7f),hl ; Store value ld a,-1 l4f14: ld (l7b90),a ret ; ; Process variable on PROCEDURE and FUNCTION ; l4f18: call l4fc8 ; Get simple type call l72da ; Verify ok db _TypeExp xor a ld (l7b90),a ld a,(l7b8f) or a ret nz ld a,(l7b5c) ; Get type cp _RecF ret c cp _String ret nc call l72e1 ; Files must be VAR db _VarFile ; ; ; l4f35: call l4eb5 push hl push bc call l6f40 ; Verify : xor a ld (l7b8f),a call l4edd pop bc ld a,(l7b90) or a jr z,l4f51 ld a,b dec a call l72da ; Invalid ABSOLUTE db _InvalABS l4f51: pop hl l4f52: push bc push hl ld a,(l7b8f) ld hl,2 or a jr nz,l4f60 ld hl,(l7b62) ; Get length of type l4f60: ex de,hl ld a,(l7b91) ; Get ??? or a jr nz,l4f72 ld a,(l7b90) or a jr nz,l4f72 call l6c30 ; Allocate space jr l4f7b l4f72: ld hl,(l7b7f) push hl add hl,de ld (l7b7f),hl pop hl l4f7b: ex de,hl pop hl dec hl l4f7e: dec hl bit _MB,(hl) jr z,l4f7e dec hl ld a,(l7b8f) ld (hl),a dec hl ld (hl),d dec hl ld (hl),e dec hl ld de,(l7b5a) ; Get type table ld (hl),d ; Store into dec hl ld (hl),e dec hl dec hl dec hl pop bc djnz l4f52 ret ; ; Get a TYPE ; l4f9b: call l4fc8 ; Test simple type ret z call l6e76 ; Skip possible PACKED dw l7542 call l4fdb ; Check ARRAY ret z call l5039 ; Check RECORD ret z call l5106 ; Check SET ret z call l5140 ; Check ^ ret z call l516b ; Check FILE ret z call l51a5 ; Check STRING ret z call l51c5 ; Test SCALAR () ret z call l5210 ; Test RANGE .. ret z call l72e1 ; Type declaration expected db _TypeExp ; ; Get SIMPLE TYPE ; EXIT Zero set if found ; l4fc8: ld bc,256*3+0 call l6e54 ; Get from table ret nz ; Not found ld d,(hl) ; Fetch type table dec hl ld e,(hl) ex de,hl ld (l7b5a),hl ; Save type call l5287 ; Get name xor a ; Set success ret ; ; Look for ARRAY ; l4fdb: call l6e76 ; Test ARRAY dw l7548 ret nz ; Nope call l6f30 ; Verify [ ld b,0 l4fe6: push bc call l523b pop bc ld hl,(l7b5a) ; Get type table push hl ld hl,(l7b60) ; Get hi limit ld de,(l7b5e) ; Get lo limit or a sbc hl,de inc hl ld a,h or l call l72d4 ; Verify not same db _MemOvfl push hl inc b call l6f13 ; Test , jr z,l4fe6 ; Yeap push bc call l6f38 ; Verify ] call l6f88 call l4f9b ; Get type pop bc l5012: ld hl,(l7b5a) ; Get type table ld (l7b5e),hl ; Set as lo limit ld hl,(l7b62) ; Get length of type pop de push bc call l729a ; Multiply numbers call l72c8 ; Check compiler overflow db _MemOvfl pop bc ld (l7b62),hl ; Set length of type pop hl ld (l7b60),hl ; Set hi limit ld a,_Array ld (l7b5c),a ; Set ARRAY push bc call l5254 ; Put to table pop bc djnz l5012 ret ; ; Look for RECORD ; l5039: call l6e76 ; Test RECORD dw l7554 ret nz ; Nope ld a,(l7b9a) push af ld a,(l7b91) ; Get ??? push af ld hl,l7b92 ; Point to ??? inc (hl) ld a,(hl) ld (l7b91),a ; Set ??? ld hl,(l7b7f) push hl ld hl,(l7b81) push hl ld hl,l0000 ld (l7b7f),hl ld (l7b81),hl xor a ld (l7b9a),a call l508b ld hl,(l7b81) ld (l7b62),hl ; Set length of type pop hl ld (l7b81),hl pop hl ld (l7b7f),hl ld a,(l7b91) ; Get ??? ld (l7b5d),a pop af ld (l7b91),a ; Set ??? pop af ld (l7b9a),a ld a,_Record ld (l7b5c),a ; Set RECORD jp l5254 ; ; ; l508b: call l50f9 ret z call l6e76 ; Test CASE dw l75da jr z,l50b0 ; Yeap call l4f35 ld hl,(l7b7f) ld de,(l7b81) or a sbc hl,de jr c,l50a9 add hl,de ld (l7b81),hl l50a9: call l6f0f ; Test ; jr z,l508b ; Yeap jr l50e8 l50b0: call l4fc8 call nz,l4f35 call l6f88 l50b9: call l50f9 ret z ld hl,(l7b7f) push hl l50c1: call l69ea ; Get constant call l6f13 ; Test , jr z,l50c1 ; Yeap call l6f40 ; Verify : call l6f66 ; Verify ( ld a,(l7b9a) push af ld a,0ffh ld (l7b9a),a call l508b pop af ld (l7b9a),a pop hl ld (l7b7f),hl call l6f0f ; Test ; jr z,l50b9 ; Yeap l50e8: ld a,(l7b9a) or a jp nz,l6f6e ; Verify ) call l6e76 ; Find END dw l7530 ret z ; Yeap call l72e1 db _End l50f9: ld a,(l7b9a) or a jp nz,l6f1f call l6e76 ; Find END dw l7530 ret ; ; Check SET ; l5106: call l6e76 ; Test SET dw l7551 ret nz ; Nope call l6f88 call l523b ld hl,(l7b60) ; Get hi set limit ld de,(l7b5e) ; Get lo set limit ld a,h or d call l72da db _IllSetRange srl l srl l srl l srl e srl e srl e ld a,l inc a sub e ld l,a ld (l7b62),hl ; Set length of type ld hl,(l7b5a) ; Get type table ld (l7b5e),hl ; Set lo set limit ld a,_Set ld (l7b5c),a ; Set SET jp l5254 ; ; Check ^ ; l5140: call l6f27 ret nz ld de,l0000 call l6d75 ; Put to table ld hl,(l7b73) ; Get label pointer push hl call l6dba call l6dc6 ; Set label pointer pop hl ld (l7b5e),hl ; Set lo set limit ld a,_Ptr ld (l7b5c),a ; Set POINTER ld a,0ffh ld (l7b5d),a ld hl,l0002 ld (l7b62),hl ; Set length of type jp l5254 ; ; Check FILE ; l516b: call l6e76 ; Find FILE dw l754d ret nz ; Nope call l6e76 ; Find OF dw l7560 jr nz,l5197 ; Nope call l4f9b ; Get type ld a,(l7b5c) ; Get type cp _RecF jr c,l518a cp _String jr nc,l518a call l72e1 db _FileF l518a: ld hl,(l7b5a) ; Get type table ld (l7b5e),hl ; Set lo set limit ld a,_RecF ld hl,l00b0 jr l519c l5197: ld a,_UntF ld hl,l0030 l519c: ld (l7b5c),a ; Set type ld (l7b62),hl ; Set length of type jp l5254 ; ; Check STRING ; l51a5: call l6e76 ; Find STRING dw l755a ret nz ; Nope call l6f30 ; Verify [ call l69f2 ; Get integer constant inc h dec h call l72da db _IllStrgLen inc l dec l call l72d4 db _IllStrgLen call l6f38 ; Verify ] inc hl ld a,_String jr l519c ; ; Test SCALAR () ; l51c5: call l6f1b ; Test ( ret nz ; Nope ld hl,lffff l51cc: push hl ld de,l0200 call l6d75 ; Put to table call l6d87 ; Get label ld a,(l7b93) ; Get type call l6d7a pop de inc de push de call l6d75 ; Put to table call l6dc6 ; Set label pointer pop hl call l6f13 ; Test , jr z,l51cc ; Yeap call l6f6e ; Verify ) push hl ld hl,l7b93 ; Point to type ld a,(hl) inc (hl) pop hl ld de,l0000 l51f8: ld (l7b5c),a ; Set type ld (l7b5e),de ; Set lo set limit ld (l7b60),hl ; Set hi set limit ld a,d or h ld hl,l0001 jr z,l520a inc hl l520a: ld (l7b62),hl ; Set length of type jp l5254 ; ; Test RANGE .. ; l5210: call l6a0d ; Get constant ret nz ld a,b push af cp 0ah call l72c8 db _IllSkalar push hl call l6e76 ; Find .. dw l7580 call l72da db _TwoDots call l69ea ; Get constant pop de pop af push af cp b call l72da db _InvType call l728d ; Compare call l72c8 ; Verify upper > lower db _IllLimit pop af jr l51f8 ; ; ; l523b: call l5210 ret z call l51c5 ret z call l4fc8 call l72da db _SimTyp ld a,(l7b5c) ; Get type cp _Integ ret nc call l72e1 db _SimTyp l5254: ld de,l0800 call l6d75 ; Put to table ld hl,(l7b73) ; Get label pointer ld (l7b5a),hl ; Save into type table ld hl,l7b5c ; Point to type ld b,8 l5265: ld a,(hl) call l6d7a inc hl djnz l5265 call l6dc6 ; Set label pointer xor a ret ; ; ; l5271: ld de,l7b69 jr l528a ; ; Get values and name ; l5276: ld a,(hl) dec hl ld (l7b57),a ld d,(hl) dec hl ld e,(hl) dec hl ld (l7b58),de ; Set value ld d,(hl) dec hl ld e,(hl) ex de,hl ; ; Get name ; l5287: ld de,l7b5c ; Point to type l528a: push bc ld b,8 l528d: ld a,(hl) ld (de),a dec hl inc de djnz l528d pop bc ret ; ; ; l5295: ld (l7b79),hl ld hl,(l7b73) ; Get label pointer l529b: ld bc,(l7b79) or a sbc hl,bc add hl,bc ret z inc hl ld c,(hl) inc hl ld b,(hl) add hl,bc ld a,(hl) cp 8 jr nz,l529b ld (hl),0 push hl dec hl dec hl ld a,(hl) cp 4 jr nz,l52f8 dec hl ld a,(hl) or a jr z,l52f8 ld (hl),0 dec hl push hl ld e,(hl) dec hl ld d,(hl) ld hl,(l7b73) ; Get label pointer l52c7: ld bc,(l7b77) ; Get top of available memory or a sbc hl,bc add hl,bc call l72d4 db _InkPointer inc hl ld c,(hl) inc hl ld b,(hl) add hl,bc ld a,(hl) cp 3 jr nz,l52c7 push hl push de dec hl dec hl l52e1: ld a,(de) cp (hl) jr z,l52e9 pop de pop hl jr l52c7 l52e9: bit 7,(hl) dec hl dec de jr z,l52e1 pop bc pop bc ld b,(hl) dec hl ld c,(hl) pop hl ld (hl),c dec hl ld (hl),b l52f8: pop hl jp l529b ; ; ; l52fc: xor a ld (l7b95),a ld (l7bc9),a call l5377 ld (l7ba4),iy call l6b82 ld hl,(l7b73) ; Get label pointer l5310: ld de,(l7b75) ; Get previous label pointer or a sbc hl,de add hl,de jr nc,l5363 inc hl ld c,(hl) inc hl ld b,(hl) inc hl ld a,(hl) inc hl ld e,(hl) inc hl ld d,(hl) push hl push bc ld b,a ld a,d or e jr z,l533a ex de,hl dec hl ld a,(hl) ld c,a inc a call l72d4 db _UnkLabel dec hl ld d,(hl) dec hl ld e,(hl) jr l5340 l533a: ld de,(l7ba4) ld c,0 l5340: pop hl ld a,b sub c jr nz,l534a call l6c42 jr l5360 l534a: call l72c8 db _IllGOTO push de push af call l6c3f ; Store back PC pop af ld b,a l5355: call l6b73 ; Set POP HL djnz l5355 ld a,.JP pop hl call l6b94 l5360: pop hl jr l5310 l5363: ld hl,(l7ba4) inc hl push iy pop de dec de dec de or a sbc hl,de add hl,de jp nz,l6c3f ; Store back PC dec hl jp l6cc2 ; Check chaining ; ; Statement BEGIN ; l5377: call l5385 ; Process a statement call l6e76 ; Find END dw l7530 ret z call l6f50 jr l5377 ; ; Process a statement ; l5385: ld a,0ffh ld (l7b98),a ld a,(l7b9d) ; Get options ld (l7b9e),a ; Set local options bit .Uopt,a ; Test $U+ jr z,l539c ; Nope ld a,RST ld (l7ba0),a ; Set end on break flag [option U+] call l6b9c ; Insert RST l539c: call l6e5a ; Find statement db 2 dw l75bb jr z,l53cb ; Yeap call l67b2 jp z,l57ea ld bc,256*5+0 call l6e54 jp z,l573d ld bc,256*1+0 call l6e54 jr z,l53d0 ld bc,256*6+0 call l6e54 jp z,l591f call l6e5a ; Find procedure db 2 dw l7638 ret nz ; Nope l53cb: ld e,(hl) ; Fetch address inc hl ld d,(hl) ex de,hl jp (hl) ; Go l53d0: call l6f40 ; Verify : ld a,(l7b94) ; Get ??? cp (hl) call l72da db _IllLabel dec hl ld a,(hl) inc a call l72da db _DoubleLab ld a,(l7b95) ld (hl),a push iy pop de dec hl ld (hl),d dec hl ld (hl),e jr l5385 ; ; Statement IF ; l53ef: call l5eb0 call l6b50 ; Set BIT 0,L ! JP Z,addr db @L9 $I9: BIT _LB,L db .JPZ @L9 equ $-$I9 push iy call l6b97 call l6e76 ; Find THEN dw l756a call l72da db _StrIdx call l5385 ; Process a statement call l6e76 ; Find ELSE dw l756e jr nz,l5420 ; Nope call l6b77 ; Set JP pop hl push iy call l6b97 call l6c3f ; Store back PC call l5385 ; Process a statement l5420: pop hl jp l6c3f ; Store back PC ; ; Statement WHILE ; l5424: push iy call l5eb0 call l6e76 ; Find DO dw l7572 call l72da db _NoDO call l6b50 ; Set BIT 0,L ! JP Z,addr db @L10 $I10: BIT _LB,L db .JPZ @L10 equ $-$I10 push iy call l6b97 call l5385 ; Process a statement pop de pop hl ld a,.JP call l6b94 ex de,hl jp l6c3f ; Store back PC ; ; Statement REPEAT ; l544c: push iy l544e: call l5385 ; Process a statement call l6e76 ; Find UNTIL dw l7574 jr z,l545d ; Yeap call l6f50 jr l544e l545d: call l5eb0 call l6b50 db @L11 $I11: BIT _LB,L db .JPZ @L11 equ $-$I11 pop hl jp l6b97 ; ; Statement FOR ; l546b: ld bc,256*4+0 call l6e54 call l72da db _Undef call l5276 ld a,(l7b57) or a jr nz,l5485 ld a,(l7b5c) ; Get type cp _Integ jr nc,l5489 l5485: call l72e1 db _SimTyp l5489: call l6d2a ; Save environment ld a,(l7b5c) ; Get type push af call l6f7e call l5ee8 call l6b6f ; Set PUSH HL pop af push af cp b call l72da db _InvType call l6e5a ; Find TO or DOWNTO db 1 dw l75f5 call l72da db _NoDOWN_TO ld e,(hl) ; Get instruction push de call l5ee8 pop de pop af push de cp b call l72da db _InvType call l6e76 ; Find DO dw l7572 call l72da db _NoDO call l6b50 ; Set POP DE db @L12 $I12: POP DE @L12 equ $-$I12 pop de call l6d63 push de ld a,e ld hl,l0666 ; Set up FOR .. TO loop cp '#' jr z,l54d5 ld hl,l0676 ; Set up FOR .. DOWNTO loop l54d5: call l6b86 ; Set CALL push iy call l6b50 ; Set code sequence db @L13 $I13: LD A,D OR E JP Z,$-$ PUSH DE @L13 equ $-$I13 call l661b ld hl,l7b95 inc (hl) call l5385 ; Process a statement ld hl,l7b95 dec (hl) pop hl pop de call l6d49 ; Get back environment push hl ld hl,(l7b58) ; Get value ld a,.LD@HL call l6b94 ld a,(l7b62) ; Get length of type dec a jr nz,l550c call l6b50 ; Set LD H,0 db @L14 $I14: LD H,0 @L14 equ $-$I14 l550c: ld a,e ; Get byte call l6b9c ; Store it call l6b50 ; Set code sequence db @L15 $I15: POP DE DEC DE db .JP @L15 equ $-$I15 pop hl call l6b97 inc hl inc hl inc hl jp l6c3f ; Store back PC ; ; Statement CASE ; l5521: call l5ebb ld (l7b9c),a xor a ld (l7b9b),a call l6f88 ld b,0 push bc l5531: ld b,1 l5533: push bc ld hl,l7b9b bit 7,(hl) jr z,l5549 call l6b50 ; Set ADD HL,DE db @L16 $I16: ADD HL,DE @L16 equ $-$I16 bit 4,(hl) jr z,l5549 call l6b50 ; Set ADD HL,BC db @L17 $I17: ADD HL,BC @L17 equ $-$I17 l5549: call l69ea ; Get constant ld a,(l7b9c) cp b call l72da db _IllCASE call l6b8e ; Set LD DE,val16 push hl call l6e76 ; Find .. dw l7580 pop hl jr nz,l5582 ; Nope push hl call l69ea ; Get constant ld a,(l7b9c) cp b call l72da db _IllCASE pop de or a sbc hl,de inc hl call l6b8a call l6b50 ; Set sequence db @L18 $I18: OR A SBC HL,DE OR A SBC HL,BC @L18 equ $-$I18 ld a,0dah jr l558b l5582: call l6b50 ; Set sequence db @L19 $I19: OR A SBC HL,DE @L19 equ $-$I19 ld a,0cah l558b: ld (l7b9b),a call l6f0b ; Test : pop bc jr z,l55a5 ld a,(l7b9b) ; Get byte call l6b9c ; Store it push iy call l6b97 call l6f5e ; Verify , inc b jr l5533 l55a5: push iy pop de inc de inc de inc de l55ab: dec b jr z,l55b4 pop hl call l6c42 jr l55ab l55b4: ld a,(l7b9b) ; Get byte res 3,a ; Fix it call l6b9c ; Store pop bc push iy inc b push bc call l6b97 ld a,(l7b9b) push af ld a,(l7b9c) push af call l5385 ; Process a statement pop af ld (l7b9c),a pop af ld (l7b9b),a call l6f0f ; Test ; ld e,1 jr z,l55df ; Yeap dec e l55df: push de call l6e76 ; Find END dw l7530 pop de jr z,l561e call l6b77 ; Set JP pop bc pop hl push iy push bc push de call l6b97 call l6c3f ; Store back PC call l6e76 ; Find ELSE dw l756e pop de jr z,l560f ; Yeap dec e jp z,l5531 ld a,(l7b98) or a call l72d4 db _End call l72e1 db _Undef l560f: call l5385 ; Process a statement call l6e76 ; Find END dw l7530 jr z,l561e ; Yeap call l6f50 jr l560f l561e: pop bc l561f: pop hl call l6c3f ; Store back PC djnz l561f ret ; ; Statement GOTO ; l5626: ld bc,256*1+0 call l6e54 call l72da db _UnkLabel ld a,(l7b94) cp (hl) call l72da db _IllLabel ex de,hl l5639: call l6d75 ; Put to table ld a,(l7b95) call l6d7a call l6b77 ; Set JP push iy pop de call l6d75 ; Put to table jp l6b97 ; ; Statement WITH ; l564e: ld a,(l7bc9) push af l5652: ld a,(l7bc6) ld hl,l7bc9 cp (hl) call l72d4 db _TooManyWITH call l677f ld a,(l7b5c) ; Get type cp _Record call l72da db _RecVarExp ld hl,l7bc9 ld e,(hl) ld d,0 inc (hl) ld hl,l7bcc add hl,de ld a,(l7b5d) ld (hl),a ld hl,(l7bca) add hl,de add hl,de ld a,.LDHL@ call l6b94 call l6f13 ; Test , jr z,l5652 ; Yeap call l6e76 ; Find DO dw l7572 call l72da db _NoDO call l5385 ; Process a statement pop af ld (l7bc9),a ret ; ; Statement INLINE ; l5698: call l6f66 ; Verify ( l569b: ld a,'>' call l6f29 ld a,2 jr z,l56ae ld a,'<' call l6f29 ld a,1 jr z,l56ae xor a l56ae: ld (l7ba6),a xor a ld h,a ld l,a ld b,a l56b5: push bc push hl call l6a0d ; Get constant jr nz,l56c5 ld a,b cp 0ah jr z,l5702 call l72e1 db _IntConst l56c5: ld hl,l7ba6 ld a,(hl) or a jr nz,l56ce ld (hl),2 l56ce: ld a,'*' call l6f29 jr nz,l56da push iy pop hl jr l5702 l56da: ld bc,256*4+0 call l6e54 jr nz,l56ea call l5276 ld hl,(l7b58) ; Get value jr l5702 l56ea: ld bc,256*5+0 call l6e54 jr z,l56fc ld bc,256*6+0 call l6e54 call l72da db _IllINLINE l56fc: dec hl dec hl ld d,(hl) dec hl ld e,(hl) ex de,hl l5702: pop de pop bc dec b jr nz,l570a call l6a30 l570a: add hl,de ld b,0 ld a,'+' call l6f29 jr z,l56b5 inc b ld a,'-' call l6f29 jr z,l56b5 ld a,(l7ba6) cp 1 jr z,l5729 jr nc,l572f inc h dec h jr nz,l572f l5729: ld a,l ; Get byte call l6b9c ; Store it jr l5732 l572f: call l6b97 l5732: ld a,'/' call l6f29 jp z,l569b jp l6f6e ; Verify ) l573d: dec hl ld b,(hl) dec hl ld d,(hl) dec hl ld e,(hl) dec hl push de ld d,(hl) dec hl ld e,(hl) dec hl push de dec hl dec hl ld d,(hl) dec hl ld e,(hl) dec hl push de ld d,(hl) dec hl ld e,(hl) dec hl push de inc b dec b jp z,l57d6 call l6f66 ; Verify ( l575e: push bc ld b,(hl) dec hl ld a,(hl) dec hl ld (l7b57),a ld d,(hl) dec hl ld e,(hl) dec hl ld c,b l576b: bit 7,(hl) dec hl jr z,l576b djnz l576b ld b,c push hl ex de,hl call l5287 ; Get name l5778: push bc ld a,(l7b57) or a jr nz,l57a9 ld a,(l7b5c) ; Get type cp _Set jr c,l57a1 call l5e84 call l5864 ld a,(l7b5c) ; Get type cp _Ptr jr z,l57bd cp _Real jr c,l57c0 jr nz,l57bd call l6b50 ; Set sequence db @L20 $I20: PUSH BC PUSH DE @L20 equ $-$I20 jr l57bd l57a1: call l6d2a ; Save environment call l6749 jr l57af l57a9: call l6d2a ; Save environment call l677f l57af: call l6d5d ld a,(l7b69) cp 0 call nz,l58c5 call l6d49 ; Get back environment l57bd: call l6b6f ; Set PUSH HL l57c0: pop bc dec b jr z,l57c9 call l6f5e ; Verify , jr l5778 l57c9: pop hl pop bc dec b jr z,l57d3 call l6f5e ; Verify , jr l575e l57d3: call l6f6e ; Verify ) l57d6: pop de pop hl ld a,d or e jr z,l57e3 call l6b92 ; Set LD HL,val16 ex de,hl call l6b8e ; Set LD DE,val16 l57e3: pop de pop hl ld a,.CALL jp l6b94 l57ea: ld a,(l7b5c) ; Get type cp 0 jr z,l57f9 cp _RecF jr c,l57fd cp _String jr nc,l57fd l57f9: call l72e1 db _IllAss l57fd: ld a,(l7bbd) bit 1,a jr nz,l5812 bit 0,a jr z,l580a ld a,0ffh l580a: ld hl,(l7bbe) ld (l7b58),hl ; Set value jr l581a l5812: call l678b call l6b6f ; Set PUSH HL ld a,1 l581a: ld (l7b57),a call l6f7e ld a,(l7b5c) ; Get type cp _Set jp nc,l593a call l6d2a ; Save environment call l6749 call l6d43 call l58c5 ld a,(l7b64) dec a jr z,l5852 inc a jr z,l5845 call l6b50 ; Set LD DE,(adr) db @L21 $I21: dw .LD@DE @L21 equ $-$I21 jr l584a l5845: call l6b50 db @L22 $I22: db .LD.DE ; Set LD DE,adr @L22 equ $-$I22 l584a: ld hl,(l7b65) call l6b97 jr l5857 l5852: call l6b50 ; Set POP DE db @L23 $I23: pop de @L23 equ $-$I23 l5857: ld hl,(l7b6f) call l6b8a call l6b50 ; Set LDIR db @L24 $I24: LDIR @L24 equ $-$I24 ret l5864: ld a,(l7b5c) ; Get type cp _Real jr nz,l5877 ld a,b cp _Integ jr nz,l589d ld b,9 ld hl,l1008 jr l589a l5877: cp _String jr nz,l588c ld a,b cp _Char jr nz,l589d ld b,8 call l6b50 ; Set sequence db @L25 $I25: LD H,L LD L,1 PUSH HL @L25 equ $-$I25 jr l589d l588c: cp _Char jr nz,l589d ld a,b cp _String jr nz,l589d ld b,0ch ld hl,l0996 ; Set check assignment l589a: call l6b86 ; Set CALL l589d: ld a,(l7b5c) ; Get type cp b jr nz,l58c1 cp 3 jr nz,l58b1 ld a,c or a ret z ld hl,(l7b5e) ; Get lo set limit cp (hl) ret z jr l58c1 l58b1: cp 4 ret nz ld hl,(l7b8b) ld a,h or l ret z ld de,(l7b5e) ; Get lo set limit sbc hl,de ret z l58c1: call l72e1 db _InvType l58c5: ld a,(l7b5c) ; Get type cp 0 jr z,l591b ld c,0bfh cp _Integ jr nc,l5906 ld c,83h cp _String jr nz,l58e3 ld a,(l7b9e) ; Get local options bit .Vopt,a ; Test $V+ jr nz,l5906 ; Yeap ld c,80h jr l5906 l58e3: cp _TxtF jr nc,l5906 ld c,0b3h cp _Set jr nc,l5906 ld c,0c3h cp _Record jr nc,l5906 ld hl,(l7b60) ; Get hi set limit ld a,h or l ld c,0bfh jr nz,l5906 ld hl,(l7b6d) ; Get last memory address ld a,(hl) cp 0ah jr nz,l591b ld c,0b3h l5906: ld hl,l7b5c ; Point to type ld de,l7b69 ld b,8 l590e: rl c jr nc,l5916 ld a,(de) cp (hl) jr nz,l591b l5916: inc hl inc de djnz l590e ret l591b: call l72e1 db _InvType l591f: ld de,lfffc add hl,de ld d,(hl) dec hl ld e,(hl) dec hl push de ld d,(hl) dec hl ld e,(hl) ld (l7b58),de ; Set value pop hl call l5287 ; Get name xor a ld (l7b57),a call l6f7e l593a: call l5e84 call l5864 jp l661b ; ; Procedure ASSIGN(FileVar,String) ; l5943: call l5a0c ld hl,l1370 cp 6 jr nz,l5955 ld hl,l136f call l5955 jr l5989 l5955: push hl call l6b6f ; Set PUSH HL call l6f5e ; Verify , call l5ed0 pop hl l5960: call l6f6e ; Verify ) jp l6b86 ; Set CALL <...> ; ; Procedure RENAME(FileVar,String) ; l5966: call l5a0c ld hl,l1ba5 call l5955 jr l5989 ; ; Procedure ERASE(FileVar) ; l5971: call l5a0c ld hl,l1b93 jr l5960 ; ; Procedure CHAIN(FileVar) ; l5979: ld hl,l1beb jr l5981 ; ; Procedure EXECUTE(FileVar) ; l597e: ld hl,l1bea l5981: push hl call l5a0c l5985: pop hl l5986: call l5960 l5989: jp l5abe ; ; Procedure SEEK(FileVar,Integer) ; l598c: call l5a0c cp 6 call l72d4 db _IllTxtFile ld hl,l19d5 cp 5 jr z,l599f ld hl,l1b6f l599f: push hl call l6b6f ; Set PUSH HL call l6f5e ; Verify , call l5e97 jr l5985 ; ; Procedure FLUSH(FileVar) ; l59ab: call l5a0c cp 5 call l72da db _IllFileType ld hl,l19a5 jr l5986 ; ; Procedure RESET(FileVar,String) ; l59b9: ld hl,l59fa jr l59c1 ; ; Procedure REWRITE(FileVar,String) ; l59be: ld hl,l5a00 l59c1: push hl call l5a0c ld a,(l7b5c) ; Get type cp _RecF jr nz,l59d8 ld hl,(l7b5e) ; Get lo set limit call l5271 ; Load name ld hl,(l7b6f) call l6b8e ; Set LD DE,val16 l59d8: pop hl jr l59e1 ; ; Procedure CLOSE(FileVar) ; l59db: call l5a0c ld hl,l5a06 l59e1: call l6f6e ; Verify ) call l59e9 jr l5989 l59e9: ld a,(l7b5c) ; Get type sub _RecF add a,a ld e,a ld d,0 add hl,de ld e,(hl) inc hl ld d,(hl) ex de,hl jp l6b86 ; Set CALL <...> l59fa: dw l1811 ; Record file dw l13ff ; Text file dw l1a70 ; Untyped file l5a00: dw l1810 dw l13fe dw l1a6f l5a06: dw l187a dw l1469 dw l1ab0 l5a0c: call l6f66 ; Verify ( call l5a17 ret z call l72e1 db _FileVarExp l5a17: call l67b2 scf ret nz ld a,(l7b5c) ; Get type cp _RecF jr c,l5a2f cp _String jr nc,l5a2f call l678b xor a ld a,(l7b5c) ; Get back type ret l5a2f: xor a dec a ret ; ; Procedure READLN(FileVar,Variables) ; l5a32: db skip ; ; Procedure READ(FileVar,Variables) ; l5a33: xor a ld (l7ba3),a call l6f1b ; Test ( jr z,l5a41 ; Yeap call l5aca jr l5ab4 l5a41: call l5a17 jr c,l5a63 jr nz,l5a5b cp 5 jp z,l5bd8 cp 6 call l72da db _NoUntypeFile ld hl,l14a9 call l6b86 ; Set CALL FILECHECK jr l5aac l5a5b: call l678b call l5aca jr l5a69 l5a63: call l5aca l5a66: call l677f l5a69: ld a,(l7b5c) ; Get type cp _String jr c,l5a78 cp _Bool jr z,l5a78 cp _Char+1 jr c,l5a7c l5a78: call l72e1 db _InvIO l5a7c: cp _String jr nz,l5a8f ld a,(l7b62) ; Get length of type dec a ld h,a ld l,6 call l6b97 ld hl,l168e jr l5aa9 l5a8f: ld hl,l1672 cp _Real jr z,l5aa9 ld hl,l1644 cp _Char jr z,l5aa9 ld hl,l164e ld a,(l7b62) ; Get length of type dec a jr nz,l5aa9 ld hl,l164d l5aa9: call l6b86 ; Set CALL l5aac: call l6f13 ; Test , jr z,l5a66 ; Yeap call l6f6e ; Verify ) l5ab4: ld hl,l16ab l5ab7: ld a,(l7ba3) or a call nz,l6b86 ; Set CALL NEWLINE l5abe: ld a,(l7b9e) ; Get local options bit .Iopt,a ; Test $I+ ret z ; Nope ld hl,l201b jp l6b86 ; Set CALL CHECKIO l5aca: ld hl,l149b ld a,(l7b9e) ; Get local options bit .Bopt,a ; Test $B+ jr z,l5ae4 ; Nope ld hl,l14cc ld a,(l7ba3) or a jr z,l5ae4 ld hl,l14cb xor a ld (l7ba3),a l5ae4: jp l6b86 ; Set CALL ; ; Procedure WRITELN(FileVar,Variables) ; l5ae7: db skip ; ; Procedure WRITE(FileVar,Variables) ; l5ae8: xor a ld (l7ba3),a call l6f1b ; Test ( jr z,l5afa ; Yeap ld hl,l149b call l6b86 ; Set CALL STDIO jp l5bd2 l5afa: call l5a17 jr c,l5b20 jr nz,l5b15 cp 5 jp z,l5bdd cp 6 call l72da db _NoUntypeFile ld hl,l14ba call l6b86 ; Set CALL CHECKWRFILE jp l5bc9 l5b15: call l620f ld hl,l149b call l6b86 ; Set CALL STDIO jr l5b4f l5b20: ld hl,l149b call l6b86 ; Set CALL STDIO l5b26: call l6a5c jr nz,l5b4c ld a,b cp 8 jr nz,l5b47 ld a,(ix+0) cp ',' jr z,l5b3b cp ')' jr nz,l5b47 l5b3b: ld hl,l17ba call l6b86 ; Set CALL IMSTRG call l6b5e jp l5bc9 l5b47: call l6201 jr l5b4f l5b4c: call l5ee8 l5b4f: ld a,b cp 8 jr c,l5b58 cp 0dh jr c,l5b5c l5b58: call l72e1 db _InvIO l5b5c: cp 0ch jr nz,l5b6a call l6f0b ; Test : jr nz,l5ba6 call l5edd jr l5b72 l5b6a: call l6148 call l6f0b ; Test : jr nz,l5b8b l5b72: push bc call l5e97 pop bc ld a,b cp 9 jr nz,l5ba6 call l6f0b ; Test : jr nz,l5b9d push bc call l6b6f ; Set PUSH HL call l5e97 pop bc jr l5ba6 l5b8b: ld hl,l0000 ld a,b cp 9 jr nz,l5b95 ld l,12h l5b95: call l6b92 ; Set LD HL,val16 ld a,b cp 9 jr nz,l5ba6 l5b9d: call l6b6f ; Set PUSH HL ld hl,lffff call l6b92 ; Set LD HL,val16 l5ba6: ld a,b ld hl,l17aa cp 8 jr z,l5bc6 ld hl,l1779 cp 9 jr z,l5bc6 ld hl,l1726 cp 0ah jr z,l5bc6 ld hl,l178b cp 0bh jr z,l5bc6 ld hl,l1722 l5bc6: call l6b86 ; Set CALL l5bc9: call l6f13 ; Test , jp z,l5b26 ; Yeap call l6f6e ; Verify ) l5bd2: ld hl,l17cd jp l5ab7 l5bd8: ld hl,l18b6 jr l5be0 l5bdd: ld hl,l18dc l5be0: ld (l7ba7),hl ld a,(l7ba3) or a call l72da db _MustTextFile ld hl,l18a4 call l6b86 ; Set CALL PREPRECWR ld hl,(l7b5e) ; Get lo set limit call l5271 ; Load name l5bf7: call l6f13 ; Test , jr nz,l5c10 ; Nope call l6d24 call l677f call l6d43 call l58c5 ld hl,(l7ba7) call l6b86 ; Set CALL jr l5bf7 l5c10: call l6f6e ; Verify ) jp l5abe ; ; Procedure BLOCKREAD(FileVar,Variable,Integer[,Integer]) ; l5c16: ld hl,l1af1 ld de,l1abe jr l5c24 ; ; Procedure BLOCKWRITE(FileVar,Variable,Integer[,Integer]) ; l5c1e: ld hl,l1aed ld de,l1aba l5c24: push hl push de call l5a0c cp 7 call l72da db _UntFileExp call l6b6f ; Set PUSH HL call l6f5e ; Verify , call l677f call l6b6f ; Set PUSH HL call l6f5e ; Verify , call l5e97 call l6f13 ; Test , pop de pop hl jr z,l5c4b ; Yeap push de jr l5c63 l5c4b: push hl call l6b6f ; Set PUSH HL call l677f ld a,(l7b5c) ; Get type cp _Integ jr nz,l5c5f ld a,(l7b62) ; Get length of type dec a jr nz,l5c63 l5c5f: call l72e1 db _IntVarExp l5c63: jp l5985 ; ; Procedure DELETE(String,Integer,Integer) ; l5c66: call l6f66 ; Verify ( call l5cad call l6b6f ; Set PUSH HL call l6f5e ; Verify , call l5e97 call l6b6f ; Set PUSH HL call l6f5e ; Verify , call l5e97 ld hl,l08f3 ; Set DELETE l5c81: call l6f6e ; Verify ) jp l6b86 ; Set CALL ; ; Procedure INSERT(String,String,Integer) ; l5c87: call l6f66 ; Verify ( call l5ed0 call l6f5e ; Verify , call l5cad call l6b6f ; Set PUSH HL ld a,(l7b62) ; Get length of type dec a ld h,a ld l,6 push hl call l6f5e ; Verify , call l5e97 pop hl call l6b97 ld hl,l0920 jr l5c81 ; Set INSERT l5cad: call l677f ld a,(l7b5c) ; Get type cp _String ret z call l72e1 db _StrgVarExp ; ; Procedure STR(Num,String) ; l5cba: call l6f66 ; Verify ( call l5ea2 call l6148 call l6f0b ; Test : jr nz,l5ce4 push bc call l5e97 call l6b6f ; Set PUSH HL pop bc ld a,b cp 0ah jr z,l5d02 call l6f0b ; Test : jr nz,l5cf9 push bc call l5e97 call l6b6f ; Set PUSH HL pop bc jr l5d02 l5ce4: ld hl,l0000 ld a,b cp 0ah jr z,l5cee ld l,12h l5cee: call l6b92 ; Set LD HL,val16 call l6b6f ; Set PUSH HL ld a,b cp 0ah jr z,l5d02 l5cf9: ld hl,lffff call l6b92 ; Set LD HL,val16 call l6b6f ; Set PUSH HL l5d02: call l6f5e ; Verify , push bc call l5cad ld a,(l7b62) ; Get length of type dec a ld h,a ld l,6 call l6b97 pop bc ld hl,l1ebe ld a,b cp 0ah jr z,l5d1f ld hl,l1ebd l5d1f: jp l5c81 ; ; Procedure VAL(String,Integer,Integer) ; l5d22: call l6f66 ; Verify ( call l5ed0 call l6f5e ; Verify , call l677f ld a,(l7b5c) ; Get type cp _Real jr z,l5d45 cp _Integ jr nz,l5d41 ld a,(l7b62) ; Get length of type dec a ld a,0ah jr nz,l5d45 l5d41: call l72e1 db _NumVarExp l5d45: push af call l6b6f ; Set PUSH HL call l6f5e ; Verify , call l677f ld a,(l7b5c) ; Get type cp _Integ jr nz,l5d5c ld a,(l7b62) ; Get length of type dec a jr nz,l5d60 l5d5c: call l72e1 db _IntVarExp l5d60: pop af ld hl,l1ef4 cp 0ah jr z,l5d1f ld hl,l1ef3 jr l5d1f ; ; Procedure GOTOXY(Integer,Integer) ; l5d6d: call l6f66 ; Verify ( call l5e97 ld hl,l1fdb l5d76: push hl call l6b6f ; Set PUSH HL call l6f5e ; Verify , call l5e97 pop hl jr l5db1 ; ; Procedure RANDOMIZE ; l5d83: ld hl,l1f48 jp l6b86 ; Set CALL RANDOMIZE ; ; Procedure DELAY(Integer) ; l5d89: call l6f66 ; Verify ( call l5e97 ld hl,l021d jr l5db1 ; Set call to delay ; ; Procedure GETMEM(Variable,Integer) ; l5d94: call l5de3 call l6f5e ; Verify , call l5e97 jr l5dae ; ; Procedure NEW(Variable) ; l5d9f: call l5de3 ld hl,(l7b5e) ; Get lo set limit call l5271 ; Load name ld hl,(l7b6f) call l6b92 ; Set LD HL,val16 l5dae: ld hl,l1ce5 l5db1: jp l5960 ; ; Procedure FREEMEM(Variable,Integer) ; l5db4: call l5de3 call l6f5e ; Verify , call l5e97 jr l5dce ; ; Procedure DISPOSE(Variable) ; l5dbf: call l5de3 ld hl,(l7b5e) ; Get lo set limit call l5271 ; Load name ld hl,(l7b6f) call l6b92 ; Set LD HL,val16 l5dce: ld hl,l1d7a jp l5960 ; ; Procedure MARK(Variable) ; l5dd4: ld hl,l1ea3 jr l5ddc ; ; Procedure RELEASE(Variable) ; l5dd9: ld hl,l1eab l5ddc: push hl call l5de9 pop hl jr l5db1 l5de3: call l5de9 jp l6b6f ; Set PUSH HL l5de9: call l6f66 ; Verify ( call l677f ld a,(l7b5c) ; Get type cp _Ptr ret z call l72e1 db _PtrVarExp ; ; Procedure OVRDRIVE(Integer) ; l5df9: call l6f66 ; Verify ( call l5e97 ld hl,l1cdb jp l5960 ; ; Procedure MOVE(Integer,Integer,Integer) ; l5e05: call l6f66 ; Verify ( call l677f call l6b6f ; Set PUSH HL call l6f5e ; Verify , call l677f ld hl,l1f64 jp l5d76 ; ; Procedure FILLCHAR(Integer,Integer,Byte) ; l5e1a: call l6f66 ; Verify ( call l677f call l6b6f ; Set PUSH HL call l6f5e ; Verify , call l5e97 call l6b6f ; Set PUSH HL call l6f5e ; Verify , call l5ebb ld hl,l1f4e jp l5db1 ; ; Procedure CRTINIT ; l5e38: ld hl,l030a jr l5e45 ; Set call to lead in ; ; Procedure CRTEXIT ; l5e3d: ld hl,l0310 jr l5e45 ; Set call to lead out ; ; Procedure CLRSCR ; l5e42: ld hl,l023e ; Set call to clear screen l5e45: jp l6b86 ; Set CALL ; ; Procedure CLREOL ; l5e48: ld hl,l0299 ; Set call to clear to end of line jr l5e45 ; ; Procedure NORMVIDEO or HIGHVIDEO ; l5e4d: ld hl,l0284 ; Set call to normal video jr l5e45 ; ; Procedure LOWVIDEO ; l5e52: ld hl,l026b ; Set call to low video jr l5e45 ; ; Procedure INSLINE ; l5e57: ld hl,l0262 ; Set call to insert line jr l5e45 ; ; Procedure DELLINE ; l5e5c: ld hl,l0259 ; Set call to delete line jr l5e45 ; ; Procedure EXIT ; l5e61: ld de,OS ; Set call to exit jp l5639 ; ; Procedure HALT ; l5e67: ld hl,l20d4 jp l6b82 ; Set call to HALT program ; ; Procedure PORT(Integer,Integer) ; l5e6d: call l5e8e call l6b50 ; Set sequence db @L26 $I26: POP BC OUT (C),L @L26 equ $-$I26 ret ; ; Procedure STACKPTR ; l5e78: call l6f7e call l5e97 call l6b50 ; Set LD SP,HL db @L27 $I27: LD SP,HL @L27 equ $-$I27 ret l5e84: call l6d2a ; Save environment call l5ee8 call l6d49 ; Get back environment ret l5e8e: call l65d5 call l6f7e call l6b6f ; Set PUSH HL l5e97: call l5ee8 ld a,b cp 0ah ret z call l72e1 db _IntExpr l5ea2: call l5ee8 ld a,b cp 0ah ret z cp 9 ret z call l72e1 db _NumExprExp l5eb0: call l5ee8 ld a,b cp 0bh ret z call l72e1 db _BoolExp l5ebb: call l5ee8 l5ebe: ld a,b cp 0ah ret nc cp 8 call l72da db _SimpExpr ld b,0ch ld hl,l0996 jp l6b86 ; Set CALL CHECKASSIGNMENT l5ed0: call l5ee8 ld a,b cp 8 ret z cp 0ch call l72da db _StrgExpExp l5edd: ld b,8 call l6b50 ; Set sequence db @L28 $I28: LD H,L LD L,1 PUSH HL @L28 equ $-$I28 ret l5ee8: call l5f98 l5eeb: push bc call l6e5a ; Find relation db 1 dw l7625 pop bc ret nz ; Nope ld a,(hl) ; Get code inc a ; Test IN jr z,l5f34 ; Yeap dec a push af push bc call l6148 ld hl,(l7b8b) push hl call l5f98 pop hl ld (l7b8d),hl pop de call l6160 pop af ld e,a ld d,0 ld hl,l5f68 add hl,de ld a,b cp 3 jr z,l5f28 inc hl inc hl cp 9 jr z,l5f28 inc hl inc hl cp 8 jr z,l5f28 inc hl inc hl l5f28: ld e,(hl) inc hl ld d,(hl) ld a,d or e call l72d4 db _IllOps ex de,hl jr l5f62 l5f34: ld a,b cp 0ah jr nc,l5f47 cp 8 call l72da db _IllOps ld hl,l0996 call l6b86 ; Set CALL CHECKASSIGNMENT ld b,0ch l5f47: push bc call l6b6f ; Set PUSH HL call l5f98 pop de ld a,b cp 3 call l72da db _IllOps ld a,c or a jr z,l5f5f cp d call l72da db _InvType l5f5f: ld hl,l134f l5f62: call l6b86 ; Set CALL ld b,0bh ret l5f68: dw l12e1 dw l0688 ; Real = dw l068d ; String = dw l067f ; Integer = dw l12dd dw l069b ; Real <> dw l06a0 ; String <> dw l0692 ; Integer <> dw l1300 dw l06ae ; Real >= dw l06b3 ; String >= dw l06a5 ; Integer >= dw l12fc dw l06c2 ; Real <= dw l06c7 ; String <= dw l06b8 ; Integer <= dw l0000 dw l06d6 ; Real > dw l06db ; String > dw l06cc ; Integer > dw l0000 dw l06e9 ; Real < dw l06ee ; String < dw l06e0 ; Integer < l5f98: call l6054 l5f9b: push bc call l6e5a ; Find operator db 1 dw l7619 pop bc ret nz ; Nope ld a,b cp 4 call l72d4 db _IllOps ld a,(hl) ; Get operator push af push bc call l6148 call l6054 pop de pop af ; Get back operator push af or a ; Test + jr nz,l5fc9 ; Nope ld a,b cp 0ch jr nz,l5fc9 call l6b50 ; Set sequence db @L29 $I29: LD H,L LD L,1 PUSH HL @L29 equ $-$I29 ld b,8 l5fc9: call l6160 pop af ; Get back operator cp 2 ; Test - jr nc,l601b ; Nope, OR or XOR push af ld a,b ld hl,l1318 ld de,l1326 cp 3 jr z,l6006 ld hl,l09e9 ; Set add reals ld de,l09f2 ; Set subtract reals cp 9 jr z,l6006 cp 8 jr z,l6010 cp 0ah call l72da db _IllOps pop af dec a jr z,l5ffc call l6b50 ; Set ADD HL,DE db @L30 $I30: ADD HL,DE @L30 equ $-$I30 jr l5f9b l5ffc: call l6b50 ; Set sequence db @L31 $I31: EX DE,HL OR A SBC HL,DE @L31 equ $-$I31 jr l5f9b l6006: pop af dec a jr nz,l600b ex de,hl l600b: call l6b86 ; Set CALL jr l5f9b l6010: pop af dec a call l72d4 db _IllOps ld hl,l083d jr l600b ; Set add two strings l601b: ld a,b jr nz,l6039 ; Must be XOR cp 0bh jr z,l602f cp 0ah call l72da db _IllOps call l6b50 ; Set OR db @L32 $I32: LD A,H OR D LD H,A @L32 equ $-$I32 l602f: call l6b50 ; Set OR db @L33 $I33: LD A,L OR E LD L,A @L33 equ $-$I33 jp l5f9b l6039: cp 0bh jr z,l604a cp 0ah call l72da db _IllOps call l6b50 ; Set XOR db @L34 $I34: LD A,H XOR D LD H,A @L34 equ $-$I34 l604a: call l6b50 ; Set XOR db @L35 $I35: LD A,L XOR E LD L,A @L35 equ $-$I35 jp l5f9b l6054: call l60e9 l6057: push bc call l6e5a ; Find operator db 1 dw l7600 pop bc ret nz ; Nope ld a,b cp 4 call l72d4 db _IllOps ld a,(hl) ; Get operator push af push bc call l6148 call l60e9 pop de pop af ; Get back operator push af dec a ; Test / jr nz,l6083 ; Nope ld a,b cp 0ah jr nz,l6083 ld hl,l1008 call l6b86 ; Set CALL INT_TO_FLP ld b,9 l6083: call l6160 pop af ; Get back operator ld e,a ld a,b inc e ; Test * dec e jr nz,l60a9 ; Nope ld hl,l1333 cp 3 jr z,l60a4 ld hl,l06f5 ; Set integer multiply cp 0ah jr z,l60a4 ld hl,l09fa ; Set real multiply l609e: cp 9 call l72da db _IllOps l60a4: call l6b86 ; Set CALL jr l6057 l60a9: ld hl,l09ff ; Set real division dec e ; Test / jr z,l609e ; Yeap dec e ; Test AND jr nz,l60cc ; Nope cp 0bh jr z,l60c3 cp 0ah call l72da db _IllOps call l6b50 ; Set AND db @L36 $I36: LD A,H AND D LD H,A @L36 equ $-$I36 l60c3: call l6b50 ; Set AND db @L37 $I37: LD A,L AND E LD L,A @L37 equ $-$I37 jr l6057 l60cc: cp 0ah call l72da db _IllOps ld hl,l070f ; Set integer DIV dec e ; Test DIV jr z,l60a4 ; Yeap ld hl,l0745 ; Set integer MOD dec e ; Test MOD jr z,l60a4 ld hl,l074e ; Set SHL dec e ; Test SHL jr z,l60a4 ld hl,l0756 ; Set SHR jr l60a4 l60e9: call l6e76 ; Find NOT dw l7579 jr nz,l6112 ; Nope call l6112 ld a,b cp 0ah jr z,l6107 cp 0bh call l72da db _IllOps call l6b50 ; Set sequence db @L38 $I38: LD A,L XOR 1 LD L,A @L38 equ $-$I38 ret l6107: call l6b50 ; Set sequence db @L39 $I39: LD A,L CPL LD L,A LD A,H CPL LD H,A @L39 equ $-$I39 ret l6112: ld a,(l7ba1) push af call l6a39 ld a,e ld (l7ba1),a call l621d ld a,(l7ba1) ld e,a call l6a4a jr z,l6143 ld a,b cp 0ah jr nz,l613b call l6b50 ; Set sequence db @L40 $I40: LD A,L CPL LD L,A LD A,H CPL LD H,A INC HL @L40 equ $-$I40 jr l6143 l613b: call l6b50 ; Set sequence db @L41 $I41: LD A,B XOR 80H LD B,A @L41 equ $-$I41 l6143: pop af ld (l7ba1),a ret l6148: ld a,b cp 0ah jr nc,l615d cp 4 jr z,l615d cp 8 ret z cp 3 ret z call l6b50 ; Set sequence db @L42 $I42: PUSH BC PUSH DE @L42 equ $-$I42 l615d: jp l6b6f ; Set PUSH HL l6160: ld a,d cp 9 jr nz,l6174 ld a,b cp 0ah jr nz,l6187 ld hl,l1008 call l6b86 ; Set CALL INT_TO_FLP ld b,9 jr l6187 l6174: cp 8 jr nz,l6187 ld a,b cp 0ch jr nz,l6187 call l6b50 ; Set sequence db @L43 $I43: LD H,L LD L,1 PUSH HL @L43 equ $-$I43 ld b,8 l6187: ld a,b cp 9 jr nz,l6193 call l6b50 ; Set EXX db @L44 $I44: EXX @L44 equ $-$I44 jr l61a4 l6193: cp 8 jr nz,l61a4 ld a,d cp 0ch jr nz,l61a4 ld hl,l09a2 call l6b86 ; Set CALL CHR_TO_STRG ld d,8 l61a4: ld a,d cp 0ah jr z,l61bc jr nc,l61ce cp 4 jr z,l61ce cp 9 jr c,l61d3 call l6b50 ; Set sequence db @L45 $I45: POP HL POP DE POP BC @L45 equ $-$I45 jr l61d3 l61bc: ld a,b cp 9 jr nz,l61ce call l6b73 ; Set POP HL ld hl,l1008 call l6b86 ; Set CALL INT_TO_FLP ld d,9 jr l61d3 l61ce: call l6b50 ; Set POP DE db @L46 $I46: POP DE @L46 equ $-$I46 l61d3: ld a,b cp d call l72da db _InvType cp 3 jr nz,l61ea ld a,e cp c ret z or a ret z ld a,c ld c,e or a ret z call l72e1 db _InvType l61ea: cp 4 ret nz ld hl,(l7b8b) ld a,h or l ret z ld de,(l7b8d) ld a,d or e ret z sbc hl,de ret z call l72e1 db _InvType l6201: ld de,l5eeb push de ld de,l5f9b push de ld de,l6057 push de jr l622d l620f: ld de,l5eeb push de ld de,l5f9b push de ld de,l6057 push de jr l6276 l621d: call l6a5c jr nz,l6257 ld a,(l7ba1) ld e,a call l6a1f xor a ld (l7ba1),a l622d: ld a,b cp 9 jr nz,l6249 exx push bc push de push hl ld bc,256*3+031h l6239: ld a,c sub 10h ld c,a ; Get byte call l6b9c ; Store it pop hl call l6b97 djnz l6239 ld b,9 ret l6249: cp 8 jp nz,l6b92 ; Set LD HL,val16 ld hl,l054d call l6b86 ; Move immediate string to stack jp l6b5e l6257: ld bc,256*6+0 call l6e54 jr nz,l6271 call l573d ex de,hl call l5287 ; Get name ld hl,(l7b5e) ; Get lo set limit ld (l7b8b),hl ld a,(l7b5c) ; Get type ld b,a ret l6271: call l67b2 jr nz,l62d2 l6276: ld a,(l7b5c) ; Get type cp _String jr nc,l6285 cp _Set jr z,l6285 cp _Ptr jr nz,l629d l6285: call l66da ld hl,(l7b5e) ; Get lo set limit ld (l7b8b),hl ld a,(l7b5c) ; Get type ld b,a cp _Set ret nz call l5287 ; Get name ld a,(l7b5c) ; Get type ld c,a ret l629d: cp _Array call l72da db _NoStruktVar call l678b ld hl,(l7b5e) ; Get lo set limit ld a,(hl) cp 0ch call l72da db _NoStruktVar ld hl,(l7b60) ; Get hi set limit ld a,(hl) cp 0ah call l72da db _NoStruktVar ld hl,(l7b62) ; Get length of type ld a,h or a call l72da db _NoStruktVar ld h,l ld l,6 call l6b97 ld hl,l0638 call l6b86 ; Set set to stack ld b,8 ret l62d2: call l6ee0 jr nz,l631c ld hl,l0581 call l6b86 ; Initialize a set on stack call l6ef7 ; Test ] ld bc,l0300 ret z ; Yeap l62e4: push bc call l5ebb ld a,b pop bc inc c dec c jr nz,l62ef ld c,a l62ef: cp c call l72da db _InvType push bc call l6e76 ; Find .. dw l7580 ld hl,l0591 jr nz,l6310 ; Nope, init one set element call l6b6f ; Set PUSH HL call l5ebb ld a,b pop bc push bc cp c call l72da db _InvType ld hl,l059b ; Init a contiguous set value l6310: call l6b86 ; Set CALL pop bc call l6f13 ; Test , jr z,l62e4 ; Yeap jp l6f38 ; Verify ] l631c: call l6f1b ; Test ( jr nz,l6327 ; Nope call l5ee8 jp l6f6e ; Verify ) l6327: call l6e5a ; Find function db 2 dw l77b1 jr nz,l6335 ; Nope ld e,(hl) inc hl ld d,(hl) ex de,hl xor a jp (hl) l6335: call l6e76 ; Find NIL dw l757c jr nz,l6345 ; Nope ld hl,l0000 call l6b92 ; Set LD HL,val16 jp l642e l6345: ld bc,256*3+0 call l6e54 call l72da db _Undef ld d,(hl) dec hl ld e,(hl) ld a,(de) cp 0ah call l72c8 db _SimTyp push af call l65ef pop af ld b,a ret ; ; Function SQR(Num) ; l6360: call l65e7 ld hl,l06f3 ; Set integer SQR ld a,b cp 0ah jr z,l636e ld hl,l09f7 ; Set real SQR l636e: jp l6b86 ; Set CALL ; ; Function ABS(Num) ; l6371: call l65e7 ld a,b cp 0ah jr z,l6380 call l6b50 ; Set RES 7,B db @L47 $I47: RES 7,B @L47 equ $-$I47 ret l6380: ld hl,l0780 ; Set integer ABS jr l63cf ; ; Function SQRT(Num) ; l6385: ld hl,l0c46 jr l63ab ; ; Function SIN(Num) ; l638a: ld hl,l0c87 jr l63ab ; ; Function COS(Num) ; l638f: ld hl,l0c7f jr l63ab ; ; Function ARCTAN(Num) ; l6394: ld hl,l0e46 jr l63ab ; ; Function LN(Num) ; l6399: ld hl,l0d2b jr l63ab ; ; Function EXP(Num) ; l639e: ld hl,l0db6 jr l63ab ; ; Function INT(Num) ; l63a3: ld hl,l0bfd jr l63ab ; ; Function FRAC(Num) ; l63a8: ld hl,l0c34 l63ab: push hl call l65e7 ld hl,l1008 ld a,b cp 0ah call z,l6b86 ; Set CALL INT_TO_FLP pop hl ld b,9 jp l6b86 ; Set CALL ; ; Function TRUNC(Num) ; l63be: ld hl,l0fde jr l63c6 ; ; Function ROUND(Num) ; l63c3: ld hl,l0fd0 l63c6: push hl call l65e7 pop hl ld a,b cp 0ah ret z l63cf: ld b,0ah jp l6b86 ; Set CALL ; ; Function SUCC(Num) ; l63d4: ld a,.INC.HL ; INC HL db skip.3 ; ; Function PRED(Num) ; l63d7: ld a,.DEC.HL ; DEC HL push af call l65ef pop af ; Get byte back jp l6b9c ; Store it ; ; Function LO(Integer) ; l63e1: call l65de call l6b50 ; Set LD H,0 db @L48 $I48: LD H,0 @L48 equ $-$I48 ret ; ; Function HI(Integer) ; l63eb: call l65de call l6b50 ; Set sequence db @L49 $I49: LD L,H LD H,0 @L49 equ $-$I49 ret ; ; Function SWAP(Num) ; l63f6: call l65de call l6b50 ; Set sequence db @L50 $I50: LD A,L LD L,H LD H,A @L50 equ $-$I50 ret ; ; Function ODD(Num) ; l6401: call l65de ld hl,l078b ; Set function ODD l6407: ld b,0bh l6409: jp l6b86 ; Set CALL ODD ; ; Function KEYPRESSED ; l640c: ld hl,l00a0 jr l6407 ; ; Function ORD(Var) ; l6411: call l6f66 ; Verify ( call l5ee8 call l6f6e ; Verify ) ld a,b cp 4 jr z,l6422 call l5ebe l6422: ld b,0ah ret ; ; Function CHR(Num) ; l6425: call l65de ld b,0ch ret ; ; Function PTR(Integer) ; l642b: call l65de l642e: ld hl,l0000 ld (l7b8b),hl ld b,4 ret ; ; Function UPCASE(Char) ; l6437: call l65ef ld b,0ch ld hl,l1fe4 jr l6409 ; ; Function LENGTH(String) ; l6441: call l6f66 ; Verify ( ld hl,l08a3 ; Set LENGTH l6447: push hl call l5ed0 call l6f6e ; Verify ) pop hl jp l63cf ; ; Function POS(String,String) ; l6452: call l6f66 ; Verify ( call l5ed0 call l6f5e ; Verify , ld hl,l08b2 jr l6447 ; Set POS ; ; Function COPY(String,Integer,Integer) ; l6460: call l6f66 ; Verify ( call l5ed0 call l6f5e ; Verify , call l5e97 call l6f5e ; Verify , call l6b6f ; Set PUSH HL call l5e97 call l6f6e ; Verify ) ld hl,l086b call l6b86 ; Set CALL COPY l647e: ld b,8 ret ; ; Function CONCAT(String,String,...) ; l6481: call l6f66 ; Verify ( call l5ed0 l6487: call l6f13 ; Test , jr nz,l6497 ; Nope call l5ed0 ld hl,l083d call l6b86 ; Set add two strings jr l6487 l6497: call l6f6e ; Verify ) jr l647e ; ; Function PARAMCOUNT ; l649c: ld hl,l1f9b jr l64bf ; ; Function PARAMSTR(Integer) ; l64a1: call l65de ld hl,l1f7d ld b,8 jp l6b86 ; Set CALL PARAMSTR ; ; Function RANDOM(Integer) ; l64ac: call l6f1b ; Test ( ld hl,l0fb4 ld b,9 jr nz,l64c1 ; Nope call l5e97 call l6f6e ; Verify ) ld hl,l073b ; Set integer random l64bf: ld b,0ah l64c1: jp l6b86 ; Set CALL RANDOM ; ; Function IORESULT ; l64c4: ld hl,l1ff1 jr l64bf ; ; Function EOF(FileVar) ; l64c9: call l65f7 ld hl,l6615 call l59e9 l64d2: ld b,0bh ret ; ; Function SEEKEOF(FileVar) ; l64d5: ld hl,l17e1 jr l64e2 ; ; Function SEEKEOLN(FileVar) ; l64da: ld hl,l17d7 jr l64e2 ; ; Function EOLN(TextFileVar) ; l64df: ld hl,l17dc l64e2: push hl call l65f7 cp 6 call l72da db _MustTextFile pop hl call l6b86 ; Set CALL jr l64d2 ; ; Function FILEPOS(FileVar) ; l64f2: ld hl,l1a55 ld de,l1a55 jr l6500 ; ; Function FILESIZE(FileVar) ; l64fa: ld hl,l1a5d ld de,l1a5d l6500: push hl push de call l65f7 pop de pop hl cp 6 call l72d4 db _IllTxtFile cp 5 jr z,l64bf ex de,hl jr l64bf ; ; Function MEMAVAIL ; l6514: ld hl,l1e3d jr l64bf ; ; Function MAXAVAIL ; l6519: ld hl,l1e44 jr l64bf ; ; Procedure BIOS(Integer,Integer) ; Function BIOSHL(Integer,Integer) ; l651e: db skip ; ; Function BIOS(Integer,Integer) ; l651f: xor a push af call l6f66 ; Verify ( call l5e97 call l6b6f ; Set PUSH HL call l6f13 ; Test , jr nz,l6538 ; Nope call l5e97 call l6b50 ; Set sequence db @L51 $I51: LD B,H LD C,L @L51 equ $-$I51 l6538: call l6b50 ; Set POP DE db @L52 $I52: POP DE @L52 equ $-$I52 ld hl,l1fea l6540: call l6f6e ; Verify ) call l6b86 ; Set CALL BIOS pop af ld b,0ah or a ret nz call l6b50 ; Set sequence db @L53 $I53: LD L,A LD H,0 @L53 equ $-$I53 ret ; ; Procedure BDOS(Integer,Integer) ; Function BDOSHL(Integer,Integer) ; l6553: db skip ; ; Function BDOS(Integer,Integer) ; l6554: xor a push af call l6f66 ; Verify ( call l5e97 call l6b6f ; Set PUSH HL call l6f13 ; Test , jr nz,l656c ; Nope call l5e97 call l6b50 ; Set EX DE,HL db @L54 $I54: EX DE,HL @L54 equ $-$I54 l656c: call l6b50 ; Set POP BC db @L55 $I55: POP BC @L55 equ $-$I55 ld hl,BDOS jr l6540 ; ; Function ADDR(Var) ; l6576: call l6f66 ; Verify ( ld bc,256*5+0 call l6e54 jr z,l6589 ld bc,256*6+0 call l6e54 jr nz,l6594 l6589: dec hl dec hl ld d,(hl) dec hl ld e,(hl) ex de,hl l658f: call l6b92 ; Set LD HL,val16 jr l6597 l6594: call l677f l6597: call l6f6e ; Verify ) ld b,0ah ret ; ; Function SIZEOF(Var) ; l659d: call l6f66 ; Verify ( ld bc,256*3+0 call l6e54 jr nz,l65b1 ld d,(hl) dec hl ld e,(hl) ex de,hl call l5287 ; Get name jr l65ba l65b1: push iy call l677f pop hl call l6cc2 ; Check chaining l65ba: ld hl,(l7b62) ; Get length of type jr l658f ; ; Function PORT(Integer) ; l65bf: call l65d5 call l6b50 ; Set sequence db @L56 $I56: LD C,L IN L,(C) @L56 equ $-$I56 ret ; ; Function STACKPTR ; l65ca: call l6b50 ; Set sequence db @L57 $I57: LD HL,0 ADD HL,SP @L57 equ $-$I57 ld b,0ah ret l65d5: call l6f30 ; Verify [ call l5e97 jp l6f38 ; Verify ] l65de: call l6f66 ; Verify ( call l5e97 l65e4: jp l6f6e ; Verify ) l65e7: call l6f66 ; Verify ( call l5ea2 jr l65e4 l65ef: call l6f66 ; Verify ( call l5ebb jr l65e4 l65f7: call l6f1b ; Test ( jr z,l6608 ; Yeap ld hl,l00c2 call l6b92 ; Set LD HL,val16 ld a,_TxtF ld (l7b5c),a ; Set TEXT ret l6608: call l5a17 call l72da db _FileVarExp push af call l6f6e ; Verify ) pop af ret l6615: ld c,c ld a,(de) and 17h ld c,c ld a,(de) ; ; ; l661b: ld a,(l7b57) ld c,a ld hl,(l7b58) ; Get value ld a,(l7b5c) ; Get type cp _Set jr nz,l6634 call l6734 ld hl,l0623 ld de,l0612 jr l6648 ; Assign set variable l6634: cp _String jr nz,l665e ld a,(l7b62) ; Get length of type dec a ld h,a ld l,6 call l6b97 ld hl,l0601 ; Assign string from stack ld de,l05e2 ; Assign string from stack l6648: dec c jr z,l665b ex de,hl l664c: ld a,.LD.HL inc c jr z,l6653 ld a,.LD@HL l6653: push hl ld hl,(l7b58) ; Get value call l6b94 pop hl l665b: jp l6b86 ; Set CALL l665e: cp _Real jr nz,l6672 call l6b50 ; Set EXX db @L58 $I58: EXX @L58 equ $-$I58 ld hl,l05d1 ; Save real number dec c jr nz,l664c call l6b73 ; Set POP HL jr l665b l6672: cp _Ptr jr z,l669d ld a,(l7b9e) ; Get local options bit .Ropt,a ; Test $R+ jr z,l669d ; Nope ld hl,(l7b5e) ; Get lo set limit ld de,(l7b60) ; Get hi set limit inc de or a sbc hl,de add hl,de jr z,l669d dec de call l6b8e ; Set LD DE,val16 ex de,hl or a sbc hl,de inc hl call l6b8a ld hl,l0656 call l6b86 ; Index check on compiler directive {$R+} l669d: dec c jr nz,l66b7 call l6b50 ; Set sequence db @L59 $I59: EX DE,HL POP HL @L59 equ $-$I59 l66a6: call l6b50 ; Set LD (HL),E db @L60 $I60: LD (HL),E @L60 equ $-$I60 ld a,(l7b62) ; Get length of type dec a ret z call l6b50 ; Set sequence db @L61 $I61: INC HL LD (HL),D @L61 equ $-$I61 ret l66b7: ld hl,(l7b58) ; Get value inc c jr nz,l66cf ld a,(l7b62) ; Get length of type dec a ld a,.LDHL@ jr nz,l66cc call l6b50 ; Set LD A,L db @L62 $I62: LD A,L @L62 equ $-$I62 ld a,.LDA@ l66cc: jp l6b94 l66cf: call l6b50 ; Set sequence db @L63 $I63: EX DE,HL db .LD@HL @L63 equ $-$I63 call l6b97 jr l66a6 l66da: ld a,(l7b5c) ; Get type cp _Integ jr nc,l6701 cp _Ptr jr z,l6701 push af call l678b pop af ld hl,l052c ; Set load real cp _Real jr z,l66fe ld hl,l053a ; Move string to stack cp _String jr z,l66fe call l6734 ld hl,l055d ; Push set onto stack l66fe: jp l6b86 ; Set CALL l6701: ld a,(l7bbd) or a jr nz,l671b ld a,.LD@HL ld hl,(l7bbe) call l6b94 ld a,(l7b62) ; Get length of type dec a ret nz l6714: call l6b50 ; Set LD H,0 db @L64 $I64: LD H,0 @L64 equ $-$I64 ret l671b: call l678b ld a,(l7b62) ; Get length of type dec a jr nz,l672b call l6b50 ; Set LD L,(HL) db @L65 $I65: LD L,(HL) @L65 equ $-$I65 jr l6714 l672b: call l6b50 ; Set sequence db @L66 $I66: LD E,(HL) INC HL LD D,(HL) EX DE,HL @L66 equ $-$I66 ret l6734: ld hl,(l7b5e) ; Get lo set limit call l5271 ; Load name ld hl,(l7b62) ; Get length of type ld a,(l7b6b) rra rra rra and 1fh ld h,a jp l6b8a l6749: call l6a0d ; Get constant jr nz,l677f ld a,b cp 8 call l72da db _IllConst ld l,18h ld h,c call l6b97 ld (l7b58),iy ; Set value ld a,_Array ld (l7b5c),a ; Set ARRAY ld hl,l74db+7 ld (l7b5e),hl ; Set lo set limit ld hl,l0000 ld (l7b60),hl ; Reset hi set limit ld l,c ld (l7b62),hl ; Set length of type call l6b62 ; Store string ld a,.LD.HL ld hl,(l7b58) ; Get value jp l6b94 l677f: call l6787 ret z call l72e1 db _Undef l6787: call l67b2 ret nz l678b: ld a,(l7bbd) ld hl,(l7bbe) bit 1,a jr nz,l67a2 bit 0,a ld a,.LD.HL jr z,l679d ld a,.LD@HL l679d: call l6b94 jr l67b0 l67a2: bit 0,a jr nz,l67b0 ld a,.LD.DE call l6b94 call l6b50 ; Set ADD HL,DE db @L67 $I67: ADD HL,DE @L67 equ $-$I67 l67b0: xor a ret l67b2: call l680c jr z,l67d9 ld bc,256*4+0 call l6e54 jr nz,l67ed call l5276 ld a,(l7b57) or a ld a,'!' ld b,0 jr z,l67cf ld a,'*' inc b l67cf: ld hl,l7bbd ld (hl),b ld hl,(l7b58) ; Get value ld (l7bbe),hl l67d9: call l683a jr z,l67d9 call l6931 jr z,l67d9 call l6974 jr z,l67d9 call l699f xor a ret l67ed: call l6e76 ; Find MEM dw l78fa ret nz ; Nope call l65d5 ld a,_Integ ld (l7b5c),a ; Set INTEGER ld hl,l0001 ld (l7b62),hl ; Set length of type dec l ld (l7b5e),hl ; Set lo set limit dec l ld (l7b60),hl ; Set hi set limit jp l6903 l680c: ld a,(l7bc9) ld b,a l6810: dec b ret m push bc ld e,b ld d,0 ld hl,l7bcc add hl,de ld a,(hl) ld c,a ld b,4 call l6e54 pop bc jr nz,l6810 push hl ld a,b add a,a ld e,a ld d,0 ld hl,(l7bca) add hl,de ld (l7bbe),hl ld hl,l7bbd ld (hl),1 pop hl jp l6948 l683a: ld a,(l7b5c) ; Get type cp _Array ret nz call l6ee0 ret nz call l678b l6847: call l6b6f ; Set PUSH HL call l5e84 ld hl,(l7b60) ; Get hi set limit call l5271 ; Load name ld a,(l7b69) cp b call l72da db _InvType ld hl,(l7b6b) ld a,h or a jr nz,l6874 ld a,l cp 4 jr nc,l6888 l6867: or a jr z,l6893 push af call l6b50 ; Set DEC HL db @L68 $I68: DEC HL @L68 equ $-$I68 pop af dec a jr l6867 l6874: inc a jr nz,l6888 ld a,l cp 0fdh jr c,l6888 l687c: push af call l6b50 ; Set INC HL db @L69 $I69: INC HL @L69 equ $-$I69 pop af inc a jr nz,l687c jr l6893 l6888: call l6a30 call l6b8e ; Set LD DE,val16 call l6b50 ; Set ADD HL,DE db @L70 $I70: ADD HL,DE @L70 equ $-$I70 l6893: ld a,(l7b9e) ; Get local options bit .Ropt,a ; Test $R+ jr z,l68ae ld hl,(l7b6d) ; Get last memory address ld de,(l7b6b) or a sbc hl,de inc hl call l6b8e ; Set LD DE,val16 ld hl,l064c call l6b86 ; Index check on compiler directive {$R+} l68ae: ld hl,(l7b5e) ; Get lo set limit call l5287 ; Get name ld hl,(l7b62) ; Get length of type ld a,h or a jr nz,l68d8 ld a,l dec a jr z,l68ed dec a jr nz,l68c9 call l6b50 ; Set ADD HL,HL db @L71 $I71: ADD HL,HL @L71 equ $-$I71 jr l68ed l68c9: cp 4 jr nz,l68d8 call l6b50 ; Set sequence db @L72 $I72: ADD HL,HL LD E,L LD D,H ADD HL,HL ADD HL,DE @L72 equ $-$I72 jr l68ed l68d8: ld a,(l7b9e) ; Get local options bit .Xopt,a ; Test $X+ jr nz,l68ea ; Yeap call l6b8e ; Set LD DE,val16 ld hl,l06f5 ; Set integer multiply call l6b86 jr l68ed l68ea: call l690a l68ed: call l6b50 ; Set sequence db @L73 $I73: POP DE ADD HL,DE @L73 equ $-$I73 ld a,(l7b5c) ; Get type cp _Array jr nz,l6900 call l6f13 ; Test , jp z,l6847 ; Yeap l6900: call l6f38 ; Verify ] l6903: ld a,3 ld (l7bbd),a xor a ret l690a: ld b,1 l690c: ld a,h or a jr nz,l6914 ld a,l dec a jr z,l6927 l6914: bit 0,l jr z,l691c call l6b6f ; Set PUSH HL inc b l691c: call l6b50 ; Set ADD HL,HL db @L74 $I74: ADD HL,HL @L74 equ $-$I74 srl h rr l jr l690c l6927: dec b ret z call l6b50 ; Set sequence db @L75 $I75: POP DE ADD HL,DE @L75 equ $-$I75 jr l6927 l6931: ld a,(l7b5c) ; Get type cp _Record ret nz call l6f17 ret nz ld a,(l7b5d) ld c,a ld b,4 call l6e54 call l72da db _Undef l6948: call l5276 ld hl,(l7b58) ; Get value ld a,h or l ret z ld hl,l7bbd bit 0,(hl) jr z,l6967 push hl call l678b pop hl ld (hl),2 ld hl,(l7b58) ; Get value ld (l7bbe),hl xor a ret l6967: ld hl,(l7bbe) ld de,(l7b58) ; Get value add hl,de ld (l7bbe),hl xor a ret l6974: ld a,(l7b5c) ; Get type cp _Ptr ret nz call l6f27 ret nz ld hl,l7bbd ld a,(hl) or a jr nz,l6988 inc (hl) jr l6997 l6988: push hl call l678b pop hl ld (hl),3 call l6b50 ; Set sequence db @L76 $I76: LD E,(HL) INC HL LD D,(HL) EX DE,HL @L76 equ $-$I76 l6997: ld hl,(l7b5e) ; Get lo set limit call l5287 ; Get name xor a ret l699f: ld a,(l7b5c) ; Get type cp _String ret nz call l6ee0 ret nz call l678b call l6b6f ; Set PUSH HL ld hl,(l7b62) ; Get length of type push hl call l5e97 pop hl ld a,(l7b9e) ; Get local options bit .Ropt,a ; Test $R+ jr z,l69c7 ; Nope call l6b8e ; Set LD DE,val16 ld hl,l064c call l6b86 ; Index check on compiler directive {$R+} l69c7: call l6b50 ; Set sequence db @L77 $I77: POP DE ADD HL,DE @L77 equ $-$I77 call l6f38 ; Verify ] ld a,_Char ld (l7b5c),a ; Set CHAR ld hl,l0001 ld (l7b62),hl ; Set length of type dec hl ld (l7b5e),hl ; Set lo set limit dec l ld (l7b60),hl ; Set hi set limit ld a,3 ld (l7bbd),a xor a ret ; ; Get constant ; l69ea: call l6a0d ; Get constant ret z call l72e1 db _Undef ; ; Get integer constant ; l69f2: call l69ea ; Get constant ld a,b cp 0ah ret z call l72e1 db _IntConst ; ; Get string constant ; l69fd: call l69ea ; Get constant ld a,b cp 8 ret z cp 0ch call l72da db _StrgConExp ld b,8 ret ; ; Get constant ; l6a0d: call l6a39 push de call l6a5c pop de jr z,l6a1f inc e dec e call l72da db _IntRealCexp dec e ret l6a1f: call l6a4a ret z ld a,b cp 9 jr nz,l6a30 exx ld a,b xor 80h ld b,a exx xor a ret l6a30: ld a,h cpl ld h,a ld a,l cpl ld l,a inc hl xor a ret l6a39: ld e,0ffh ld a,(ix+0) cp '-' jr z,l6a47 inc e cp '+' ret nz inc e l6a47: jp l6f92 ; Process line l6a4a: inc e dec e ret z ld a,b cp 0ah jr z,l6a56 cp 9 jr nz,l6a58 l6a56: dec e ret l6a58: call l72e1 db _IntRealCexp l6a5c: call l6a99 ; Sample constant ret z ; Got one ld bc,256*2+0 call l6e54 ret nz ld b,(hl) ld a,b dec hl cp 0ah jr c,l6a74 ld d,(hl) dec hl ld e,(hl) ex de,hl xor a ret l6a74: cp 9 jr nz,l6a88 push bc ld b,(hl) dec hl ld c,(hl) dec hl ld d,(hl) dec hl ld e,(hl) dec hl ld a,(hl) dec hl ld l,(hl) ld h,a exx pop bc ret l6a88: ld c,(hl) ld de,l7a57 push bc inc c l6a8e: dec c jr z,l6a97 dec hl ld a,(hl) ld (de),a inc de jr l6a8e l6a97: pop bc ret ; ; Sample constant - Z set indicates constant ; ; Reg B holds type of constant ; Reg C holds length of constant ; l6a99: ld a,(ix+0) ; Get character cp '''' ; Test string jr z,l6aa8 cp '^' ; Test control character prefix jr z,l6aa8 cp '#' ; Test character prefix jr nz,l6b0e l6aa8: ld hl,l7a57 ; Init parameter buffer ld c,0 ; Init length l6aad: ld a,(ix+0) cp '^' ; Test control character prefix jr z,l6ad8 cp '#' ; Test character prefix jr z,l6aee cp '''' ; Test string jr nz,l6afe l6abc: inc ix ld a,(ix+0) or a call l72d4 db _StrConLong cp '''' jr nz,l6ad3 inc ix ld a,(ix+0) cp '''' jr nz,l6aad l6ad3: ld (hl),a inc hl inc c jr l6abc l6ad8: inc ix ld a,(ix+0) call l04a6 ; Convert to upper case or a call l72d4 db _StrConLong xor '@' inc ix l6ae9: ld (hl),a inc hl inc c jr l6aad l6aee: inc ix push bc push hl call l07f7 ; Convert ASCII to integer ld a,l pop hl pop bc call l72c8 db _IntegErr jr l6ae9 l6afe: ld b,8 ld a,c dec a jr nz,l6b0b ld h,a ld a,(l7a57) ld l,a ld b,0ch l6b0b: jp l6f95 ; Process line l6b0e: cp '$' jr z,l6b45 call l7286 ; Test digit jr nc,l6b1a xor a dec a ret l6b1a: push ix pop de l6b1d: inc de ld a,(de) call l7286 ; Test digit jr nc,l6b1d call l04a6 ; Convert to upper case cp 'E' jr z,l6b39 cp '.' jr nz,l6b45 inc de ld a,(de) cp '.' jr z,l6b45 cp ')' jr z,l6b45 l6b39: call l11a3 call l72c8 db _RealErr exx ld b,9 jr l6b0b l6b45: call l07f7 ; Convert ASCII to integer call l72c8 db _IntegErr ld b,0ah jr l6b0b ; ; Transfer immediate opcodes ; Sequence starts with length ; l6b50: ex (sp),hl push bc ld b,(hl) ; Get length inc hl l6b54: ld a,(hl) ; Get byte call l6b9c ; Store it inc hl djnz l6b54 pop bc ex (sp),hl ret l6b5e: ld a,c ; Get byte call l6b9c ; Store it ; ; Store string ; l6b62: ld hl,l7a57 inc c l6b66: dec c ret z ld a,(hl) ; Get character inc hl call l6b9c ; Store it jr l6b66 ; ; Set PUSH HL ; l6b6f: ld a,.PUSH.HL jr l6b9c ; ; Set POP HL ; l6b73: ld a,.POP.HL jr l6b9c ; ; Set JP ; l6b77: ld a,.JP jr l6b9c ; ; Set word in reg DE ; l6b7b: ld a,e call l6b9c ld a,d jr l6b9c ; ; Set JP WORD ; l6b82: ld a,.JP jr l6b94 ; ; Set CALL WORD ; l6b86: ld a,.CALL jr l6b94 ; ; Set LD BC,WORD ; l6b8a: ld a,.LD.BC jr l6b94 ; ; Set LD DE,WORD ; l6b8e: ld a,.LD.DE jr l6b94 ; ; Set LD HL,WORD ; l6b92: ld a,.LD.HL ; ; Insert opcodes in Accu, reg L and reg H ; l6b94: call l6b9c ; ; Insert word in reg HL ; l6b97: ld a,l call l6b9c ld a,h ; ; Insert byte in Accu ; l6b9c: push bc ld b,a ld a,(l7900) ; Get compile flag or a ; Test mode jr nz,l6ba7 ; Searching or compiling ld (iy+0),b ; Store byte into memory l6ba7: inc iy ; Update PC or a ; Test compile to memory jr z,l6bc6 ; Yeap push hl push de dec a ; Test search jr z,l6bc1 ; Nope push iy pop de dec de ld hl,(l00ce) ; Get current PC or a sbc hl,de call l72d4 db _FndRTerr jr l6bc4 l6bc1: call l6c02 ; Put byte to file l6bc4: pop de pop hl l6bc6: pop bc ; ; Check enough memory ; l6bc7: push hl push de push iy pop de ld a,(l7900) ; Get compile flag or a jr z,l6be7 ; Skip if compiling to memory ld de,(l7bdf) ; Get memory top dec a jr nz,l6be7 ld de,(l7be1) ; Get top of .COM file ld a,(l790e) ; Test memory read or a jr z,l6be7 ; Yeap ld de,(l7be6) l6be7: ld hl,(l7b73) ; Get label pointer scf sbc hl,de call l72c8 db _CompOvfl push iy pop de ld hl,(l7908) ; Get start of data dec h dec h sbc hl,de call l72c8 db _MemOvfl pop de pop hl ret ; ; Put byte in reg B to file ; l6c02: ld hl,l7bdb ; Point to file access set 1,(hl) ; Set write enabled bit 0,(hl) ; Test re-read jr z,l6c12 ; Nope res 0,(hl) ; Clear it push bc call l6cf9 ; Re-read record pop bc l6c12: ld a,(l7bdc) ; Get record pointer ld e,a ld d,0 ld hl,l7957 add hl,de ; Build buffer address ld (hl),b ; Store byte inc a ; Advance record pointer jp p,l6c2c ; Still within limits call l6cfd ; Write record ld hl,(l7933+_rrn) inc hl ; Advance record count ld (l7933+_rrn),hl xor a l6c2c: ld (l7bdc),a ; Set record pointer ret ; ; Allocate space in reg DE ; l6c30: ld hl,(l7908) ; Get start of data or a sbc hl,de call l72c8 db _MemOvfl ld (l7908),hl ; Set start of data jr l6bc7 ; Check enough memory ; ; Store back current PC to ^HL ; l6c3f: push iy ; Get PC pop de ; ; Store back reg DE to ^HL ; l6c42: ld a,(l7900) ; Get compile flag dec a ; Test compiling to memory jr z,l6c53 ; Yeap push iy push hl pop iy call l6b7b ; Set word pop iy ret l6c53: push bc push de push hl ld hl,(l7bdf) ; Get memory top ld a,(l7be3) ; Get back fix level ld b,a inc b l6c5e: dec b jr z,l6c84 ld e,(hl) inc hl ld d,(hl) ex (sp),hl or a sbc hl,de add hl,de ex (sp),hl jr c,l6c71 inc hl inc hl inc hl jr l6c5e l6c71: dec hl ex de,hl ld l,b ld h,0 add hl,hl add hl,hl ld b,h ld c,l add hl,de ld d,h ld e,l dec hl inc de inc de inc de lddr inc hl l6c84: pop de ld (hl),e inc hl ld (hl),d inc hl pop de ld (hl),e inc hl ld (hl),d pop bc ld hl,l7be3 ; Point to back fix level inc (hl) ret nz xor a jr l6c9b ; ; Fix back level ; l6c96: ld a,(l7be3) ; Get back fix level or a ret z l6c9b: push bc push de push iy ld b,a ld hl,(l7bdf) ; Get memory top l6ca3: push bc ld e,(hl) inc hl ld d,(hl) inc hl push hl ex de,hl call l6cc2 ; Check chaining pop hl ld b,(hl) inc hl push hl call l6c02 ; Put byte to file pop hl ld b,(hl) inc hl push hl call l6c02 ; Put byte to file pop hl pop bc djnz l6ca3 pop hl pop de pop bc ; ; Check chaining ; l6cc2: push hl pop iy ld a,(l7900) ; Get compile flag dec a ; Test compiling to file ret nz ; Nope push de push bc ld de,(l7902) ; Get code pointer or a sbc hl,de ld a,l and 7fh ld (l7bdc),a ; Set record pointer add hl,hl ld l,h rla and 1 ld h,a ld de,(l7bdd) ; Get record base add hl,de ; Calculate new record ld de,(l7933+_rrn) or a sbc hl,de add hl,de jr z,l6cf6 push hl call l6cfd ; Write record pop hl ld (l7933+_rrn),hl ; Reset record l6cf6: pop bc pop de ret ; ; Read a record ; l6cf9: ld c,.rndrd jr l6d09 ; ; Write a record ; l6cfd: ld hl,l7bdb ; Point to file access set 0,(hl) ; Set re-read enabled bit 1,(hl) ; Test record to be written ret z ; Nope res 1,(hl) ; Reset it ld c,.rndwr l6d09: push bc ; Save function ld de,l7957 ld c,.setdma call l7265 ; Set disk buffer pop bc ld de,l7933 call l7265 ; Read or write record or a ret z dec a ret z cp 3 ret z call l72e1 db _DskFull l6d24: exx ld de,l7b64 jr l6d2e ; ; Save environment ; l6d2a: exx ld de,l7b57 l6d2e: pop hl ld (l7bd5),hl ld hl,lfff3 add hl,sp ld sp,hl ex de,hl ld bc,l000d ldir l6d3d: ld hl,(l7bd5) push hl exx ret l6d43: exx ld de,l7b64 jr l6d4d ; ; Get back environment ; l6d49: exx ld de,l7b57 l6d4d: pop hl ld (l7bd5),hl ld hl,l0000 add hl,sp ld bc,l000d ldir ld sp,hl jr l6d3d l6d5d: exx ld de,l7b64 jr l6d67 l6d63: exx ld de,l7b57 l6d67: ld hl,l0002 add hl,sp ld bc,l000d ldir exx ret ; ; Put current PC to table ; l6d72: push iy pop de l6d75: ld a,d call l6d7a ld a,e l6d7a: push hl ld hl,(l7b73) ; Get label pointer ld (hl),a dec hl ld (l7b73),hl ; Set label pointer pop hl jp l6bc7 ; Check enough memory ; ; Get label ; l6d87: ld a,(ix+0) call l7271 ; Test label character ; ; Build label ; l6d8d: call l72c8 db _IllChar call l6ed0 l6d94: call l6eb8 ld a,(ix+0) l6d9a: cp 'a' jr c,l6da4 cp 'z'+1 jr nc,l6da4 sub 'a'-'A' l6da4: call l6d7a inc ix ld a,(ix+0) call l7282 ; Test valid character jr nc,l6d9a ; Yeap ld hl,(l7b73) ; Get label pointer inc hl set 7,(hl) jp l6f95 ; Process line l6dba: ld a,(ix+0) call l7271 ; Test label character call l72c8 db _IllChar jr l6d94 ; ; Set label pointer ; l6dc6: ld hl,(l7b75) ; Get previous label pointer ld de,(l7b73) ; Get label pointer or a sbc hl,de ex de,hl call l6d75 ; Put to table ld hl,(l7b73) ; Get label pointer ld (l7b75),hl ; Unpack into previous ret l6ddb: ld hl,(l7b7b) ; Get current label pointer jr l6de3 ; ; ; l6de0: ld hl,(l7b77) ; Get top of available memory l6de3: ld (l7b7d),hl ld a,(l7bc0) cp c jr z,l6e48 ld a,c ld (l7bc0),a ld hl,(l7b75) ; Get previous label pointer l6df3: ld de,(l7b7d) xor a sbc hl,de add hl,de jr nz,l6e03 xor a ld (l7bc1),a dec a ret l6e03: inc hl ld e,(hl) inc hl ld d,(hl) add hl,de ld a,(hl) or a jr z,l6df3 dec hl ld a,(hl) inc hl cp c jr nz,l6df3 push ix pop de push bc push hl dec hl dec hl l6e19: ld b,(hl) ld a,(de) dec hl inc de ld c,b res 7,b cp 'a' jr c,l6e2a cp 'z'+1 jr nc,l6e2a sub 'a'-'A' l6e2a: cp b jr nz,l6e37 bit 7,c jr z,l6e19 ld a,(de) call l7282 ; Test valid character jr c,l6e3b ; Nope l6e37: pop hl pop bc jr l6df3 l6e3b: ld (l7bc2),hl ld (l7bc4),de pop hl pop bc ld a,(hl) ld (l7bc1),a l6e48: ld hl,(l7bc2) ld de,(l7bc4) ld a,(l7bc1) cp b ret ; ; Find label with type in reg B ; l6e54: call l6de0 ret nz jr l6e96 ; ; Find constant string list ^PC ; Z set says found ; l6e5a: ex (sp),hl ld c,(hl) ; Get length of data following string inc hl ld e,(hl) ; Get address of string inc hl ld d,(hl) inc hl ex (sp),hl ex de,hl l6e63: call l6e7d ; Find string ret z ; Got it dec hl ; Postion to previous character l6e68: bit _MB,(hl) ; Find end of string inc hl jr z,l6e68 ld b,0 add hl,bc ; Position to next string in list ld a,(hl) or a ; Test more in list jr nz,l6e63 ; Yeap dec a ; Set string not found ret ; ; Find constant string ^PC ; Z set says found ; l6e76: ex (sp),hl ld e,(hl) ; Get address of string inc hl ld d,(hl) inc hl ex (sp),hl ex de,hl ; ; Find string ^HL ; l6e7d: push ix ; Copy source pointer pop de ld a,(hl) ; Get character from searched string call l7271 ; Test label character jr c,l6e92 ; Nope call l6e9c ; Compare ret nz ; Not found ld a,(de) ; Get character from source call l7282 ; Test valid character jr c,l6e96 ; Nope or a ret l6e92: call l6e9c ; Compare ret nz ; Not found l6e96: push de ; Set resulting source pointer pop ix jp l6f95 ; Process line ; ; Compare reference ^HL: source ^DE ; Z set says match ; l6e9c: push bc l6e9d: ld b,(hl) ; Get from reference ld a,(de) ; Get from source inc hl inc de ld c,b ; Save reference res _MB,b ; Strip off MSB cp 'a' ; Test range jr c,l6eae cp 'z'+1 jr nc,l6eae sub 'a'-'A' ; Convert to UPPER case l6eae: cp b ; Compare jr nz,l6eb6 ; No match bit _MB,c ; Test end of reference jr z,l6e9d ; Nope xor a ; Force match l6eb6: pop bc ret l6eb8: ld hl,l7513 l6ebb: ld c,(hl) inc c ret z dec c inc hl ld e,(hl) inc hl ld d,(hl) inc hl push hl ex de,hl call l6e63 pop hl jr nz,l6ebb call l72e1 db _ResWord l6ed0: ld a,(l7b91) ; Get ??? ld c,a call l6ddb ld a,(l7bc1) or a ret z call l72e1 db _DoubleLab l6ee0: ld a,'[' call l6f29 ret z ld a,(ix+0) cp '(' ret nz ld a,(ix+1) cp '.' ret nz l6ef2: inc ix jp l6f92 ; Process line ; ; Test ] - Z set says found ; l6ef7: ld a,']' call l6f29 ret z ;;::: ld a,(ix+0) cp '.' ret nz ld a,(ix+1) cp ')' ret nz jr l6ef2 ; ; Test colon : - Z set says found ; l6f0b: ld a,':' jr l6f29 ; ; Test semicolon ; - Z set says found ; l6f0f: ld a,';' jr l6f29 ; ; Test comma , - Z set says found ; l6f13: ld a,',' jr l6f29 l6f17: ld a,'.' jr l6f29 ; ; Test left parenthesis ( - Z set says found ; l6f1b: ld a,'(' jr l6f29 l6f1f: ld a,')' jr l6f29 ; ; Test equate = - Z set says found ; l6f23: ld a,'=' jr l6f29 l6f27: ld a,'^' l6f29: cp (ix+0) ret nz jp l6f92 ; Process line ; ; Verify [ ; l6f30: call l6ee0 ret z call l72e1 db _LftBrExp ; ; Verify ] ; l6f38: call l6ef7 ; Test ] ret z call l72e1 db _RgtBrExp ; ; Verify : ; l6f40: call l6f0b ; Test : ret z call l72e1 db _SemiExp ; ; Verify ; ; l6f48: call l6f0f ; Test ; ret z ; Yeap l6f4c: call l72e1 db _ColExp l6f50: call l6f0f ; Test ; ret z ; Yeap ld a,(l7b98) or a jr z,l6f4c call l72e1 db _Undef ; ; Verify , ; l6f5e: call l6f13 ; Test , ret z ; Yeap call l72e1 db _CommaExp ; ; Verify ( ; l6f66: call l6f1b ; Test ( ret z ; Yeap call l72e1 db _LftPar ; ; Verify ) ; l6f6e: call l6f1f ret z call l72e1 db _RgtPar ; ; Verify = ; l6f76: call l6f23 ; Find = ret z call l72e1 db _EquExp l6f7e: call l6e76 ; Find := dw l7582 ret z ; Yeap call l72e1 db _AssigExp l6f88: call l6e76 ; Find OF dw l7560 ret z ; Yeap call l72e1 db _NoOF ; ; Process source line ; l6f92: call l7124 ; Get character from file l6f95: xor a ld (l7b98),a dec a ld (l7bc0),a ld a,(ix+0) ; Get a character or a ; Test empty jr z,l6f92 ; Yeap, so get next cp ' ' ; Skip blanks jr z,l6f92 cp tab ; Skip tabs jr z,l6f92 cp '(' ; Test possible comment jr z,l6fb5 cp '{' ; Test real comment jr z,l6fbf l6fb3: xor a ret l6fb5: ld a,(ix+1) ; Get next cp '*' ; Test comment jr nz,l6fb3 ; Nope call l7124 ; Get next character l6fbf: push bc ld b,(ix+0) ; Get comment indicator ld a,(ix+1) ; Get next character cp '$' ; Test compiler directive jr z,l6feb ; Maybe l6fca: call l7124 ; Get next character l6fcd: ld a,b cp '*' ; Test two character indicators ld a,(ix+0) jr nz,l6fe4 ; Nope cp b jr nz,l6fca ld a,(ix+1) cp ')' jr nz,l6fca call l7124 ; Get character from file jr l6fe8 l6fe4: cp '}' ; Test end of comment jr nz,l6fca ; Nope, wait for l6fe8: pop bc jr l6f92 l6feb: push bc push de push hl call l7124 ; Get character from file l6ff1: call l7124 ; Get character from file ld a,(ix+0) call l04a6 ; Convert to upper case cp 'I' ; Test include or I/O error ld b,00000001b jr z,l704d cp 'R' ; Test index range test ld b,00000010b jr z,l704d cp 'A' ; Test absolute code ld b,00000100b jr z,l704d cp 'U' ; Test user break ld b,00001000b jr z,l704d cp 'X' ; Test arry optimization ld b,00010000b jr z,l704d cp 'V' ; Test var type test ld b,00100000b jr z,l704d cp 'B' ; Test I/O mode ld b,01000000b jr z,l704d cp 'C' ; Test keyboard interrupt ld b,10000000b jr z,l704d cp 'W' ; Test WITH check jr z,l707a ; ; Next directives used by MS-DOS only. ; They will be checked for compatibility only ; ld b,00000000b cp 'K' ; Test stack check ([$K+, $K-]) jr z,l704d cp 'D' ; Test device check ([$D+, $D-]) jr z,l704d cp 'F' ; Test number of open files ([$Fnum]) jr z,l708e cp 'G' ; Test input buffer ([$Gnum]) jr z,l708e cp 'P' ; Test output buffer ([$Pnum]) jr z,l708e call l72e1 ; Invalid directive db _CompDirec l7048: pop hl pop de pop bc jr l6fcd ; ; Set or reset directive $x+ or $x- ; ; Bit to be attached held in reg B ; l704d: call l7124 ; Get character from file ld a,(ix+0) ld c,0 ; Init for set cp '+' ; Test it jr z,l7065 ; Yeap dec c ; Prepare for reset - all bits set cp '-' jr z,l7065 dec b ; Remember $I is 00000001b - used multiple call l72da ; Else error db _CompDirec jr l709b ; Now process include l7065: ld hl,l7b9d ; Point to options ld a,(hl) ; Get current bits xor c ; Toggle bits or let in tact or b ; Insert bit xor c ; Set result ld (hl),a l706d: call l7124 ; Get character from file l7070: ld a,(ix+0) cp ',' ; Test more jp z,l6ff1 ; Yeap jr l7048 l707a: call l7124 ; Get character from file ld a,(ix+0) call l7286 ; Test digit call l72c8 db _CompDirec sub '0' ld (l7bc7),a ; Change depth for WITH jr l706d ; ; Process MS-DOS compatible directives ; l708e: call l7124 ; Get character from file ld a,(ix+0) call l7286 ; Test digit jr nc,l708e ; Yeap, skip over jr l7070 l709b: cp ' ' jr nz,l70a7 ; Skip over directive call l7124 ; Get character from file ld a,(ix+0) jr l709b l70a7: ld a,(l790e) ; Get memory read flag or a call l72da ; Should be memory read db _INCLerr push ix pop de call l2d2a ; Prepare .PAS file push de pop ix ld de,l005c push de ld c,.open call l7265 ; Open file pop hl inc a call l72d4 db _NoFileErr ld de,l790f ld bc,FCBlen ldir ; Unpack file ld a,(l7900) ; Get compile flag dec a ; Test compiling to file jr z,l70e2 ; Yeap ld hl,l7957 ld (l7be4),hl ; Save top of .COM file ld hl,l79d7 ; Get start of source line ld a,1 jr l7103 l70e2: ld hl,(l7b73) ; Get label pointer ld de,(l7be1) ; Get top of .COM file ld (l7be4),de ; Save it or a sbc hl,de ; Calculate difference srl h rr l ld a,h or a call l72d4 ; If hi zero, no memory db _CompOvfl ld a,l and RecLng ld l,a push hl add hl,hl ld a,h pop hl add hl,de l7103: ld (l7be6),hl ld (l7be9),hl ld (l7be8),a ld (l790e),a ; Re/Set memory read flag ld hl,l0000 ld (l7beb),hl ld a,(l7b9d) ; Get options ld (l7b9f),a ld a,(l7bc7) ; Get depth for WITH ld (l7bc8),a jp l7048 ; ; Get character from file ; l7124: ld a,(ix+0) inc ix or a ret nz push bc push de push hl ld a,(l7ba2) ; Get end of file or a call l72da db _IllSrcEnd ld hl,(l7bd7) ; Get source pointer ld (l7bd9),hl ; Unpack it ld hl,(l7beb) ld (l7bed),hl ld hl,l79d7 ; Get start of source line push hl pop ix ; Copy it ld b,RecLng-1 ; Set max length l714a: push hl push bc call l71f3 pop bc pop hl cp cr jr z,l7175 cp eof jr z,l716a cp tab jr z,l7161 cp ' ' jr c,l714a l7161: djnz l7166 inc b jr l714a l7166: ld (hl),a inc hl jr l714a l716a: ld (l7ba2),a ; Set end of file call l717e call l718f ; Test abort jr l7178 l7175: call l717e l7178: ld (hl),0 pop hl pop de pop bc ret l717e: push af push hl ld hl,(l7bef) inc hl ; Advance line count ld (l7bef),hl ld a,l and 0fh jr z,l7191 pop hl pop af ret ; ; Test abortion of compilation ; l718f: push af push hl l7191: push bc push de push ix push iy ld a,cr call l03c9 ; Put to console ld a,(l790e) ; Test memory read or a jr z,l71a6 ; Yeap ld a,'I' jr l71a8 l71a6: ld a,' ' l71a8: call l03c9 ; Put to console ld a,' ' call l03c9 ; Put to console ld hl,(l7bef) ; Get line count call l2e61 ; Print number call l00a0 ; Test key pressed or a jr z,l71ea call l0200 db ' *** Abort compilation' db null call l2d01 ; Ask for YES or NO call l72da db _ABORT ld b,32 l71e1: call l0200 db bs,' ',bs db null djnz l71e1 l71ea: pop iy pop ix pop de pop bc pop hl pop af ret ; ; Read character from file ; l71f3: ld a,(l790e) ; Test memory read or a jr nz,l7205 ; Nope l71f9: ld hl,(l7bd7) ; Get source pointer ld a,(hl) cp eof ; Test end of file ret z ; Yeap inc hl ld (l7bd7),hl ret l7205: ld hl,(l7be9) ld de,(l7be6) or a sbc hl,de add hl,de jr c,l7242 ld de,(l7be4) ; Get top of .COM file ld a,(l7be8) ld b,a l721a: push bc push de ld c,.setdma call l7265 ; Set disk buffer ld de,l790f ld c,.rdseq call l7265 ; Read record pop de pop bc or a jr nz,l7237 ld hl,RecLng add hl,de ; Advance buffer ex de,hl djnz l721a jr l723f l7237: ld a,eof ; Set end of file ld (de),a inc de ld (l7be6),de l723f: ld hl,(l7be4) ; Get top of .COM file l7242: ld a,(hl) inc hl ld (l7be9),hl cp eof jr nz,l725d xor a ld (l790e),a ; Enable memory read ld a,(l7b9f) ld (l7b9d),a ; Reset options ld a,(l7bc8) ld (l7bc7),a ; Set depth for WITH jr l71f9 l725d: ld hl,(l7beb) inc hl ld (l7beb),hl ret ; ; Perform OS call ; l7265: push ix ; Preserve index registers push iy call BDOS ; Call system pop iy pop ix ret ; ; Test label character ; C set says no ; l7271: cp 'A' ret c cp 'Z'+1 ccf ret nc cp '_' ret z cp 'a' ret c cp 'z'+1 ccf ret ; ; Test valid character ; C set says no ; l7282: call l7271 ; Test label character ret nc ; Yeap ; ; Test character a digit ; C set says no ; l7286: cp '0' ; Test digit ret c cp '9'+1 ccf ret ; ; Compare signed integers HL:DE ; ; C set if HL> INTEGER ; l731f:: dw ..INT $$INT: dw l74d3+7 db 'R'+MSB,'EGETNI' db 0,_Type ..INT equ $-$$INT ; ; -->> CHAR ; dw ..CHAR $$CHAR: dw l74db+7 db 'R'+MSB,'AHC' db 0,_Type ..CHAR equ $-$$CHAR ; ; -->> REAL ; dw ..REAL $$REAL: dw l74e3+7 db 'L'+MSB,'AER' db 0,_Type ..REAL equ $-$$REAL ; ; -->> BOOLEAN ; dw ..BOOL $$BOOL: dw l74eb+7 db 'N'+MSB,'AELOOB' db 0,_Type ..BOOL equ $-$$BOOL ; ; -->> TEXT ; dw ..TEXT $$TEXT: dw l74f3+7 db 'T'+MSB,'XET' db 0,_Type ..TEXT equ $-$$TEXT ; ; -->> BYTE ; dw ..BYTE $$BYTE: dw l74fb+7 db 'E'+MSB,'TYB' db 0,_Type ..BYTE equ $-$$BYTE ; ; -->> TRUE ; dw ..TRUE $$TRUE: dw .TRUE db _Bool db 'E'+MSB,'URT' db 0,_Const ..TRUE equ $-$$TRUE ; ; -->> FALSE ; dw ..FALSE $$FALSE: dw FALSE db _Bool db 'E'+MSB,'SLAF' db 0,_Const ..FALSE equ $-$$FALSE ; ; -->> MAXINT ; dw ..MXINT $$MAXINT: dw MAXINT db _Integ db 'T'+MSB,'NIXAM' db 0,_Const ..MXINT equ $-$$MAXINT ; ; -->> PI ; dw ..PI $$PI: db 082h,021h,0a2h,0dah,00fh,049h db _Real db 'I'+MSB,'P' db 0,_Const ..PI equ $-$$PI ; ; -->> OUTPUT ; dw ..OUTP $$OUTP: dw l74f3+7 dw l00c2 db 0 db 'T'+MSB,'UPTUO' db 0,4 ..OUTP equ $-$$OUTP ; ; -->> INPUT ; dw ..INPT $$INPT: dw l74f3+7 dw l00c2 db 0 db 'T'+MSB,'UPNI' db 0,_Ptr ..INPT equ $-$$INPT ; ; -->> CON ; dw ..CON $$CON: dw l74f3+7 dw l00b8 db 0 db 'N'+MSB,'OC' db 0,_Ptr ..CON equ $-$$CON ; ; -->> TRM ; dw ..TRM $$TRM: dw l74f3+7 dw l00b8 db 0 db 'M'+MSB,'RT' db 0,_Ptr ..TRM equ $-$$TRM ; ; -->> KBD ; dw ..KBD $$KBD: dw l74f3+7 dw l00ba db 0 db 'D'+MSB,'BK' db 0,_Ptr ..KBD equ $-$$KBD ; ; -->> LST ; dw ..LST $$LST: dw l74f3+7 dw l00bc db 0 db 'T'+MSB,'SL' db 0,_Ptr ..LST equ $-$$LST ; ; -->> AUX ; dw ..AUX $$AUX: dw l74f3+7 dw l00be db 0 db 'X'+MSB,'UA' db 0,_Ptr ..AUX equ $-$$AUX ; ; -->> USR ; dw ..USR $$USR: dw l74f3+7 dw l00c0 db 0 db 'R'+MSB,'SU' db 0,_Ptr ..USR equ $-$$USR ; ; -->> BUFLEN ; dw ..BUFL $$BUFL: dw l74fb+7 dw l00d1 db 0 db 'N'+MSB,'ELFUB' db 0,_Ptr ..BUFL equ $-$$BUFL ; ; -->> HEAPPTR ; dw ..HEAP $$HEAP: dw l74d3+7 dw l00c4 db 0 db 'R'+MSB,'TPPAEH' db 0,_Ptr ..HEAP equ $-$$HEAP ; ; -->> RECURPTR ; dw ..RECUR $$RECUR: dw l74d3+7 dw l00c6 db 0 db 'R'+MSB,'TPRUCER' db 0,_Ptr ..RECUR equ $-$$RECUR ; ; -->> CONSTPTR ; dw ..CONSP $$CONSP: dw l74d3+7 dw l00a0+1 db 0 db 'R'+MSB,'TPTSNOC' db 0,_Ptr ..CONSP equ $-$$CONSP ; ; -->> CONINPTR ; dw ..CONIP $$CONIP: dw l74d3+7 dw l00a3+1 db 0 db 'R'+MSB,'TPNINOC' db 0,_Ptr ..CONIP equ $-$$CONIP ; ; -->> CONOUTPTR ; dw ..CONOP $$CONOP: dw l74d3+7 dw l00a6+1 db 0 db 'R'+MSB,'TPTUONOC' db 0,_Ptr ..CONOP equ $-$$CONOP ; ; -->> LSTOUTPTR ; dw ..LSTOP $$LSTOP: dw l74d3+7 dw l00a9+1 db 0 db 'R'+MSB,'TPTUOTSL' db 0,_Ptr ..LSTOP equ $-$$LSTOP ; ; -->> AUXINPTR ; dw ..AUXIP $$AUXIP: dw l74d3+7 dw l00af+1 db 0 db 'R'+MSB,'TPNIXUA' db 0,_Ptr ..AUXIP equ $-$$AUXIP ; ; -->> AUXOUTPTR ; dw ..AUXOP $$AUXOP: dw l74d3+7 dw l00ac+1 db 0 db 'R'+MSB,'TPTUOXUA' db 0,_Ptr ..AUXOP equ $-$$AUXOP ; ; -->> USRINPTR ; dw ..USRIP $$USRIP: dw l74d3+7 dw l00b5+1 db 0 db 'R'+MSB,'TPNIRSU' db 0,_Ptr ..USRIP equ $-$$USRIP ; ; -->> USROUTPTR ; dw ..USROP $$USROP: dw l74d3+7 dw l00b2+1 db 0 db 'R'+MSB,'TPTUORSU' db 0,_Ptr ..USROP equ $-$$USROP ; ; -->> ERRORPTR ; dw ..ERRPT $$ERRPT: dw l74d3+7 dw l00da db 0 db 'R'+MSB,'TPRORRE' db 0,_Ptr ..ERRPT equ $-$$ERRPT ; ; -->> CBREAK ; dw ..CBRK $$CBRK: dw l74eb+7 dw l00dd db 0 db 'K'+MSB,'AERBC' db 0,_Ptr ..CBRK equ $-$$CBRK IntLabTab: LenLab equ IntLabTab-l731f ; ; Standard type length table ; Note HI-LO entries of definition words ; dww macro val db HIGH val db LOW val endm l74d3: dww 2 ; Length for this type dww MAXINT ; Max value dww (-MAXINT-1) ; Min value dww _Integ ; Type l74db: dww 1 dww 255 dww 0 dww _Char l74e3: dww 6 dww 0 dww 0 dww _Real l74eb: dww 1 dww .TRUE dww FALSE dww _Bool l74f3: dww (FIBlen+RecLng) dww 0 dww 0 dww _TxtF l74fb: dww 1 dww 255 dww 0 dww _Integ ; dww (DefSTR+1) dww 0 dww 0 dww _String l750b: dww 0 dww 0 dww 0 dww 0 ; ; Table of reserved words ; l7513: db 0 dw l7529 db _Byte dw l7584 db _Addr dw l75bb db _Byte dw l75f5 db _Byte dw l7604 db _Byte dw l761d db _Byte dw l7634 db -1 ; ; Keywords ; l7529: dc 'PROGRAM' l7530: dc 'END' l7533: dc 'FORWARD' l753a: dc 'EXTERNAL' l7542: dc 'PACKED' l7548: dc 'ARRAY' l754d: dc 'FILE' l7551: dc 'SET' l7554: dc 'RECORD' l755a: dc 'STRING' l7560: dc 'OF' l7562: dc 'ABSOLUTE' l756a: dc 'THEN' l756e: dc 'ELSE' l7572: dc 'DO' l7574: dc 'UNTIL' l7579: dc 'NOT' l757c: dc 'NIL' db 0 l7580: dc '..' l7582: dc ':=' ; ; Main block table ; -->> Code is type ; l7584: dc 'LABEL' db 1 dc 'CONST' db 2 dc 'TYPE' db 3 l7595: dc 'VAR' db 4 dc 'BEGIN' db 8 l759f: dc 'OVERLAY' db 7 l75a7: dc 'PROCEDURE' db 5 dc 'FUNCTION' db 6 db 0 ; ; Statement table ; l75bb: dc 'BEGIN' dw l5377 dc 'IF' dw l53ef dc 'WHILE' dw l5424 dc 'REPEAT' dw l544c dc 'FOR' dw l546b l75da: dc 'CASE' dw l5521 dc 'GOTO' dw l5626 dc 'WITH' dw l564e dc 'INLINE' dw l5698 db 0 l75f5: dc 'TO' inc hl dc 'DOWNTO' dec hl db 0 l7600: dc '*' db 0 dc '/' db 1 l7604: dc 'AND' db 2 dc 'DIV' db 3 dc 'MOD' db 4 dc 'SHL' db 5 dc 'SHR' db 6 db 0 l7619: dc '+' db 0 dc '-' db 1 l761d: dc 'OR' db 2 dc 'XOR' db 3 db 0 l7625: dc '=' db 00000000b dc '<>' db 00001000b dc '>=' db 00010000b dc '<=' db 00011000b dc '>' db 00100000b dc '<' db 00101000b l7634: dc 'IN' db 11111111b db 0 l7638: dc 'WRITELN' dw l5ae7 dc 'WRITE' dw l5ae8 dc 'READLN' dw l5a32 dc 'READ' dw l5a33 dc 'DELETE' dw l5c66 dc 'INSERT' dw l5c87 dc 'ASSIGN' dw l5943 dc 'RESET' dw l59b9 dc 'REWRITE' dw l59be dc 'CLOSE' dw l59db dc 'ERASE' dw l5971 dc 'RENAME' dw l5966 dc 'SEEK' dw l598c dc 'GETMEM' dw l5d94 dc 'NEW' dw l5d9f dc 'FREEMEM' dw l5db4 dc 'DISPOSE' dw l5dbf dc 'MARK' dw l5dd4 dc 'RELEASE' dw l5dd9 dc 'OVRDRIVE' dw l5df9 dc 'CRTINIT' dw l5e38 dc 'CRTEXIT' dw l5e3d dc 'GOTOXY' dw l5d6d dc 'CLRSCR' dw l5e42 dc 'CLREOL' dw l5e48 dc 'NORMVIDEO' dw l5e4d dc 'HIGHVIDEO' dw l5e4d dc 'LOWVIDEO' dw l5e52 dc 'INSLINE' dw l5e57 dc 'DELLINE' dw l5e5c dc 'DELAY' dw l5d89 dc 'BLOCKREAD' dw l5c16 dc 'BLOCKWRITE' dw l5c1e dc 'RANDOMIZE' dw l5d83 dc 'MOVE' dw l5e05 dc 'FILLCHAR' dw l5e1a dc 'EXIT' dw l5e61 dc 'HALT' dw l5e67 dc 'PORT' dw l5e6d dc 'STACKPTR' dw l5e78 dc 'FLUSH' dw l59ab dc 'EXECUTE' dw l597e dc 'CHAIN' dw l5979 dc 'STR' dw l5cba dc 'VAL' dw l5d22 dc 'BDOS' dw l6553 dc 'BIOS' dw l651e db 0 l77b1: dc 'CHR' dw l6425 dc 'ORD' dw l6411 dC 'COPY' dw l6460 dc 'LENGTH' dw l6441 dc 'POS' dw l6452 dc 'CONCAT' dw l6481 dc 'SUCC' dw l63d4 dc 'PRED' dw l63d7 dc 'UPCASE' dw l6437 dc 'TRUNC' dw l63be dc 'ROUND' dw l63c3 dc 'ODD' dw l6401 dc 'ABS' dw l6371 dc 'SQR' dw l6360 dc 'SQRT' dw l6385 dc 'SIN' dw l638a dc 'COS' dw l638f dc 'ARCTAN' dw l6394 dc 'LN' dw l6399 dc 'EXP' dw l639e dc 'INT' dw l63a3 dc 'FRAC' dw l63a8 dc 'RANDOM' dw l64ac dc 'PARAMCOUNT' dw l649c dc 'PARAMSTR' dw l64a1 dc 'LO' dw l63e1 dc 'HI' dw l63eb dc 'SWAP' dw l63f6 dc 'PTR' dw l642b dc 'IORESULT' dw l64c4 dc 'EOF' dw l64c9 dc 'EOLN' dw l64df dc 'SEEKEOF' dw l64d5 dc 'SEEKEOLN' dw l64da dc 'FILESIZE' dw l64fa dc 'FILEPOS' dw l64f2 dc 'KEYPRESSED' dw l640c dc 'MEMAVAIL' dw l6514 dc 'MAXAVAIL' dw l6519 dc 'PORT' dw l65bf dc 'STACKPTR' dw l65ca dc 'ADDR' dw l6576 dc 'SIZEOF' dw l659d dc 'BDOSHL' dw l6553 dc 'BDOS' dw l6554 dc 'BIOSHL' dw l651e dc 'BIOS' dw l651f db 0 l78fa: dc 'MEM' dw 0 db 0 ; ; Start of dynamic data ; - originally at page boundary - here : 7900h ; ; Dynamic data area starts - shared by editor and compiler most ; l7900: db 1ah ; Compile flag: ; 0: Compile to memory ; 1: Compile to .COM/.CHN file ; 2: Searching l7901: db 'd' ; Error code l7902: db 'SE' ; Code pointer l7904: db 'EK' ; Code start address l7906: db 'EO' ; Code end address l7908: db 'L',0ceh ; Start of data l790a: db 0dah,'d' ; End of code address l790c: db 'FI' ; Current editor address l790e: db 'L' ; Memory read flag (0 is read) l790f: db 'ESIZ',0c5h,0fah,'dFILEPO',0d3h,0f2h db 'dKEYPRESSE',0c4h,0ch,'dMEMAVAI',0cch ; ; FCB of source file ; l7933: db 14h db 'eMAXAVAI' db 0cch db 19h,'ePOR',0d4h,0bfh,'eSTACKPT' db 0d2h,0cah,'eADD',0d2h,'v' db 'eSI' ; ; DISK BUFFER ; l7957: db 'ZEO',0c6h,9dh,'eBDOS' db 'H',0cch,'SeBDO',0d3h,'TeBIOSH' db 0cch,1eh,'eBIO',0d3h,1fh,'e' db 0,'ME',0cdh,0,0,0 l7980:: ;;** l79d7 equ l7957+RecLng ; Start of source line l7a57 equ l79d7+RecLng l7ad7 equ l7a57+RecLng ; Top of used memory on start l7b57 equ l7ad7+RecLng l7b58 equ l7b57+1 ; Value of symbol l7b59 equ l7b58+1 l7b5a equ l7b59+1 ; Type table l7b5c equ l7b5a+2 ; Type l7b5d equ l7b5c+1 l7b5e equ l7b5d+1 ; Lo set limit l7b60 equ l7b5e+2 ; Hi set limit l7b62 equ l7b60+2 ; Length of type l7b64 equ l7b62+2 l7b65 equ l7b64+1 l7b69 equ l7b65+4 l7b6b equ l7b69+2 l7b6d equ l7b6b+2 ; Last memory address l7b6f equ l7b6d+2 ; TEMP l7b71 equ l7b6f+2 ; TEMP l7b72 equ l7b71+1 ; EDT: Pointer to delimters l7b73 equ l7b72+1 ; Label pointer l7b74 equ l7b73+1 ; EDT: Edited line l7b75 equ l7b74+1 ; Previous label pointer l7b77 equ l7b75+2 ; Top of available memory l7b79 equ l7b77+2 l7b7b equ l7b79+2 ; Current label pointer l7b7d equ l7b7b+2 l7b7f equ l7b7d+2 l7b81 equ l7b7f+2 l7b83 equ l7b81+2 l7b85 equ l7b83+2 l7b87 equ l7b85+2 l7b88 equ l7b87+1 l7b89 equ l7b88+1 l7b8b equ l7b89+2 l7b8d equ l7b8b+2 l7b8f equ l7b8d+2 l7b90 equ l7b8f+1 l7b91 equ l7b90+1 ; ??? l7b92 equ l7b91+1 ; ??? l7b93 equ l7b92+1 ; Type l7b94 equ l7b93+1 ; ??? l7b95 equ l7b94+1 l7b96 equ l7b95+1 ; OVERLAY number l7b97 equ l7b96+1 ; PROCEDURE (=0) or FUNCTION (<>0) l7b98 equ l7b97+1 l7b99 equ l7b98+1 ; Overlay flag (-1) l7b9a equ l7b99+1 l7b9b equ l7b9a+1 l7b9c equ l7b9b+1 l7b9d equ l7b9c+1 ; Option bits l7b9e equ l7b9d+1 ; Local PROCEDURE/FUNCTION options l7b9f equ l7b9e+1 l7ba0 equ l7b9f+1 ; End on break l7ba1 equ l7ba0+1 l7ba2 equ l7ba1+1 ; End of file l7ba3 equ l7ba2+1 l7ba4 equ l7ba3+1 l7ba6 equ l7ba4+2 l7ba7 equ l7ba6+1 l7ba9 equ l7ba7+2 l7bab equ l7ba9+2 ; Data pointer for overlay l7bb0 equ l7bab+5 ; Length of overlay l7bb2 equ l7bb0+2 ; OVERLAY file name l7bbd equ l7bb2+11 l7bbe equ l7bbd+1 l7bc0 equ l7bbe+2 l7bc1 equ l7bc0+1 l7bc2 equ l7bc1+1 l7bc4 equ l7bc2+2 l7bc6 equ l7bc4+2 l7bc7 equ l7bc6+1 ; Depth for WITH l7bc8 equ l7bc7+1 l7bc9 equ l7bc8+1 l7bca equ l7bc9+1 l7bcc equ l7bca+2 l7bd5 equ l7bcc+9 l7bd7 equ l7bd5+2 ; Source pointer l7bd9 equ l7bd7+2 ; Dtto. l7bdb equ l7bd9+2 ; File access l7bdc equ l7bdb+1 ; Record pointer l7bdd equ l7bdc+1 ; Record base l7bdf equ l7bdd+2 l7be1 equ l7bdf+2 ; Top of .COM file l7be3 equ l7be1+2 ; Back fix level l7be4 equ l7be3+1 ; Saved top of .COM file l7be6 equ l7be4+2 l7be8 equ l7be6+2 l7be9 equ l7be8+1 l7beb equ l7be9+2 l7bed equ l7beb+2 l7bef equ l7bed+2 ; Line count l7bf5 equ l7bef+6 ; Start of text end