; ; ; ; ;----LEOJ2.ASM Module (final part of PARASOL2.OVL) ; ; opt.undef.all: ret ;prevents assembly error ; ; ; ; put.JMP: mvi a,(jmp) jmp put.code.byte ; ; put.LXI.H: mvi a,21h jmp put.code.byte ; ; put.LXI.H.fixup: push psw call put.LXI.H pop psw call fix.up.built.in.rtn lxi h,0 jmp put.code.word ; ; ; ; put.RET: mvi a,(ret) jmp put.code.byte ; ; ; ; put.SPHL: mvi a,(sphl) jmp put.code.byte ; ; ; ; err.undef.label: lxi h,em.undef.label jmp print.error ; ; em.undef.label: db 'undefined label',0 ; ; ; ; ;------misc utility routines-------- ; ; ; in: hl -> buffer area ; c = buffer size - 1 ; ; out: buffer = string which was typed ; 2 CP/M bytes at front stripped off ; ; ACCEPT.from.console: mov m,c inx h mov m,c push h dcx h xchg mvi c,10 call entry pop h push h mov e,m mvi d,0 dad d inx h mvi m,0 call display.crlf pop h mov e,l mov d,h inx h dcx d jmp move.string ; ACCEPT.map: db 00h,00h,06h,06h ; ;-------------------------------------------------- ; AND.d.and.h: mov a,d ana h mov h,a mov a,e ana l mov l,a ora h ret AND.16.map: db 00h ; ;-------------------------------------------------- ; ; in: de -> string to append to ; hl -> string to be appended ; append.h.2.d: ldax d inx d ora a jnz append.h.2.d dcx d jmp move.string ; append.map: db 08h,0c0h ; ;-------------------------------------------------- ; ; ; ; in: hl -> src1 ; de -> src2 ; bc -> sum bcd.add: ldax d xra m ani 80h jnz bcd.add.not.same ldax d stax b jmp bcd.add.entry ; bcd.add.not.same: ldax d push psw xri 80h stax d push d push b lxi b,dividend ldax d stax b call bcd.sub.do.it pop d pop h pop psw mov m,a lxi h,dividend jmp move.bcd ; bcd.add.map: db 04h,30h,0ch,60h,0d8h ; ; ; ; ; ;================================================ ; ; in: hl -> src1 ; de -> src2 ; bc -> sum ; out: bc -> sum ; ; ; bcd.add.entry: push b call bcd.prep ora a bcd.add.lup: sta bcd.add.ctr ldax d adc m daa stax b dcx b dcx h dcx d lda bcd.add.ctr dcr a jnz bcd.add.lup ; pop b ret ; bcd.add.ctr: db 0 ; ; bcd.add.entry.map: db 32h,00h,88h,00h ; ; ; ; ; ; ;=========================================== ; ; ; ; bcd compare ; in: hl -> #1 ; de -> #2 ; ; out: non-zero + carry: @hl > @de ; zero @hl = @de ; non-zero + no carry: @hl < @de ; bcd.compare: ldax d ani 80h jz bcd.comp.de.pos ; mov a,m ani 80h jz bcd.comp.de.neg.hl.pos ; de- hl- call bcd.comp.de.pos.hl.pos cmc ret ; bcd.comp.de.pos: mov a,m ani 80h jz bcd.comp.de.pos.hl.pos ; de+ hl- mvi a,1 ora a ret ; bcd.comp.de.neg.hl.pos: mvi a,1 ora a stc ret ; bcd.comp.de.pos.hl.pos: inx d inx h lxi b,bcd.size - 1 jmp cmp.blk ; ; bcd.comp.map: db 08h,24h,04h,00h,03h ; ; ;================================================= ; ; ; ; BCD Divide ; ; quotient := 0 ; shift.ctr := 0 ; while dividend >= divisor ; shift divisor left ; add 1 to shift.ctr ; if shift.ctr >= (bcd.size - 1) * 2 ; exitdo ; fi; ; od; ; while shift.ctr > 0 do ; shift divisor right ; shift quotient left ; subtract 1 from shift.ctr ; while dividend >= divisor do ; subtract divisor from dividend ; add 1 to quotient ; od until divisor = 0 ; od; ; end; ; ; ; ; in: hl -> divisor ; de -> dividend ; bc -> quotient ; (divide @de by @hl giving @bc) ; (divide dividend by divisor) ; (dividend field has remainder after divide) ; ; ; ; bcd.divide: ldax d xra m ani 80h sta div.dst.sign ; push d push h mov h,b mov l,c shld div.quot.ptr ;---clear quotient lxi h,quotient lxi d,quotient + 1 xra a mov m,a lxi b,((bcd.size - 1) * 2) - 1 call move.h.2.d.cnt.b ;---move divisor & dividend into work area pop h lxi d,divisor call bcd.move.2.dbl ; pop h lxi d,dividend call bcd.move.2.dbl ;---initialize shift count xra a sta div.shift.ctr div.adjust.lup: lxi h,divisor lxi d,dividend lxi b,(bcd.size - 1) * 2 call cmp.blk ;cmpr hl fm de jc div.adjust.end ; lxi h,divisor lxi b,(bcd.size - 1) * 2 call bcd.shift.left ; lda div.shift.ctr inr a sta div.shift.ctr cpi (bcd.size * 2) - 1 jnc div.done ;divide by zero ; jmp div.adjust.lup ; div.adjust.end: ; div.shift.lup: lda div.shift.ctr ora a jz div.done ; dcr a sta div.shift.ctr ; lxi h,divisor lxi b,(bcd.size - 1) * 2 call bcd.shift.right ; lxi h,quotient lxi b,(bcd.size - 1) * 2 call bcd.shift.left ; xra a sta div.cnst.ctr ; div.add.lup: lxi h,divisor lxi d,dividend lxi b,(bcd.size * 2) call cmp.blk ;cmpr hl fm de jc div.add.end ; lxi d,bcd.size - 2 lxi h,dividend dad d lxi d,divisor + (bcd.size - 2) mov b,h mov c,l call bcd.sub.entry ; lxi h,div.cnst.ctr inr m ; jmp div.add.lup ; div.add.end: lxi h,div.cnst lxi d,quotient + (bcd.size - 2) mov b,d mov c,e call bcd.add.entry jmp div.shift.lup ; div.done: lhld div.quot.ptr lda div.dst.sign mov m,a xchg lxi h,quotient + (bcd.size - 1) inx d lxi b,bcd.size - 1 call move.h.2.d.cnt.b ; ret ; ; div.shift.ctr: db 0 div.dst.sign: db 0 div.quot.ptr: dw 0 quotient: ds (bcd.size - 1) * 2 divisor: ds (bcd.size - 1) * 2 div.cnst: ds (bcd.size - 1) div.cnst.ctr: db 0 ; ; bcd.divide.map: db 04h,09h,20h,32h,66h,0c9h,30h,0d2h db 0dh,10h,92h,22h,41h,0a0h,0c9h,30h db 0d0h,64h,34h,49h,0dh,24h,20h,60h ds ((bcd.size*5)/8)+1 ; ; ; ; ; ; ; ;=========================================== ; ; ; in: hl -> src (single) ; de -> dst (double) ; bcd.move.2.dbl: mvi c,(bcd.size - 1) bcdm2d.lup: xra a stax d inx d dcr c jnz bcdm2d.lup inx h lxi b,(bcd.size - 1) jmp move.h.2.d.cnt.b ; ; bcd.move.2.dbl.map: db 01h,03h ; ; ; ; ; ;=========================================== ; ; ; ; ; ; ; BCD Format: ; ; |Sxxx.xxxx|1111.2222|3333.4444|5555.6666|7777.8888|9999.AAAA|BBBB.CCCC|DDDD.EEEE| ; |\---v--/ \-------------------------------v-----------------------------------/ ; | | | ; | | the number expressed in packed BCD digits ; | ignored ; the sign of the number 0 - positive, 1 - negative ; ; ;=========================================== ; ; ; ; ; ; BCD Multiply ; ; shift.ctr := 16 ; dst := 0 ; dst.sign := src.1.sign XOR src.2.sign ; do ; shift src.1 right ; while shifted.out.digit <> 0 do ; add src.2 to dst ; subtract 1 from shifted.out.digit ; od; ; shift src.2 left ; subtract 1 from shift.ctr ; od until shift.ctr = 0 ; move dst.sign to dst[byte] ; end ; ; ; ; in: hl -> src1 ; de -> src2 ; bc -> product ; ; bcd.multiply: ldax d xra m ani 80h sta mul.dst.sign ; push b push d ;---move src1 and src2 to work buffers lxi d,mul.src.1 call bcd.move.2.dbl ; pop h lxi d,mul.src.2 call bcd.move.2.dbl ;---clear dst pop h mvi m,0 shld mul.dst.ptr mov d,h mov e,l inx d lxi b,bcd.size - 1 call move.h.2.d.cnt.b ;---init shift counter mvi a,(bcd.size - 1) * 2 mul.lup.by.digit: sta mul.shift.ctr ; lxi h,mul.src.1 lxi b,(bcd.size - 1) * 2 call bcd.shift.right ; mul.lup.for.sum: ora a jz mul.end.lup.sum push psw lhld mul.dst.ptr mov b,h mov c,l lxi d,mul.src.2 + (bcd.size - 2) call bcd.add.entry pop psw dcr a jnz mul.lup.for.sum mul.end.lup.sum: lxi h,mul.src.2 lxi b,(bcd.size - 1) * 2 call bcd.shift.left ; lda mul.shift.ctr dcr a jnz mul.lup.by.digit ; lhld mul.dst.ptr lda mul.dst.sign mov m,a ret ; ; mul.shift.ctr: db 0 mul.dst.sign: db 0 mul.dst.ptr: dw 0 mul.src.1: ds (bcd.size - 1) * 2 mul.src.2: ds (bcd.size - 1) * 2 ; bcd.multiply.map: db 04h,26h,4ch,20h,18h,90h,64h db 42h,62h,41h,0a2h,48h,00h ds ((bcd.size*4)/8)+1 ; ; ; ; ; ;================================================== ; ; ; dividend: ds (bcd.size - 1) * 2 ; dividend.map: ds (((bcd.size-1)*2)/8)+1 ; ; ; ; ;=========================================== ; ; ; in: hl -> src1 ; de -> src2 ; ; out: hl -> src1 + (bcd.size - 1) ; de -> src2 + (bcd.size - 1) ; a = bcd.size - 1 ; bcd.prep: push b lxi b,(bcd.size - 1) dad b xchg dad b xthl dad b xthl pop b mvi a,(bcd.size - 1) ret ; ; bcd.prep.map: db 00h,00h ; ; ; ; ; ;=========================================== ; ; ; ; in: hl -> src1 ; de -> src2 ; bc -> difference ; (subtract @de from @hl giving @bc) ; bcd.subtract: ldax d xra m ani 80h jnz bcd.sub.not.same ldax d stax b jmp bcd.sub.do.it ; bcd.sub.not.same: ldax d push psw xri 80h stax d push d push b lxi b,dividend ldax d stax b call bcd.add.entry pop d pop h pop psw mov m,a lxi h,dividend jmp move.bcd ; bcd.subtract.map: db 04h,30h,0ch,60h,0d8h ; ; ; ; ; ; ;================================================ ; ; ; in: hl -> src1 ; de -> src2 ; bc -> difference (@hl - @de) ; bcd.sub.do.it: push b push d push h ; xra a sta bcd.sub.hl.lss ; inx d inx h lxi b,(bcd.size - 1) call cmp.blk ;cmpr hl fm de jc bcd.sub.hl.gtr ; pop d pop h mvi a,0ffh sta bcd.sub.hl.lss jmp bcd.sub.cont.1 ; bcd.sub.hl.gtr: pop h pop d bcd.sub.cont.1: pop b mov a,m stax b call bcd.sub.entry ;---check for zero result - force + sign if zero mov h,b mov l,c mvi e,bcd.size - 1 xra a bcd.sub.chk.0.lup: inx h ora m dcr e jnz bcd.sub.chk.0.lup ora a jnz bcd.sub.get.sign stax b ret ;---if subtraction was reversed, reverse sign bcd.sub.get.sign: lda bcd.sub.hl.lss ora a rz ldax b xri 80h stax b ret ; ; bcd.sub.hl.lss: db 0 ; ; bcd.sub.do.it.map: db 04h,06h,81h,20h,30h,04h,42h,00h,00h ; ; ; ; ; ; ;=========================================== ; ; ; in: hl -> src1 ; de -> src2 ; bc -> difference (@hl - @de) ; bcd.sub.entry: push b call bcd.prep stc bcd.sub.lup: sta bcd.sub.ctr push b push psw mvi a,99h sub m mov c,a pop psw ldax d adc c daa pop b stax b dcx h dcx d dcx b lda bcd.sub.ctr dcr a jnz bcd.sub.lup ; pop b ret ; bcd.sub.ctr: db 0 ; ; bcd.sub.entry.map: db 32h,00h,00h,88h,00h ; ; ; ; ; ; ;=========================================== ; ; ; ; in: hl -> start of number ; c = number of bytes to shift ; ; out: a = shifted-out digit ; bcd.shift.right: mvi d,0 bcd.shr.lup: mov a,m ani 0fh mov b,a rlc ! rlc ! rlc ! rlc mov e,a mov a,m rrc ! rrc ! rrc ! rrc ani 0fh ora d mov m,a mov d,e inx h dcr c jnz bcd.shr.lup mov a,b ret ; ; bcd.shift.right.map: db 00h,00h,00h,80h ; ; ; ; ; ;============================================== ; ; ; ; in: hl -> start of number ; c = number of bytes to shift ; ; out: a = shifted-out digit ; bcd.shift.left: push h push d mov e,c mvi d,0 dcx d dad d bcd.shl.lup: mov a,m rrc ! rrc ! rrc ! rrc ani 0fh mov e,a mov a,m rlc ! rlc ! rlc ! rlc ani 0f0h ora d mov m,a mov d,e dcx h dcr c jnz bcd.shl.lup mov a,e pop d pop h ret ; ; bcd.shift.left.map: db 00h,00h,00h,08h,00h ; ; ; ; ; ;=============================================== ; cmp.blk: mov a,b ora c rz ldax d cmp m rnz dcx b inx h inx d jmp cmp.blk ; cmp.blk.map: db 00h,20h ; ; ;-------------------------------------------------- ; compare.strings: ldax d cmp m rnz inx h inx d ora a rz jmp compare.strings cmp.str.map: db 00h,80h ; ;-------------------------------------------------- ; cmp.de.fm.hl: mov a,h cmp d rnz mov a,l cmp e ret cmp.16.map: db 00h ; ;-------------------------------------------------- ; cmp.hl.fm.de: mov a,d cmp h rnz mov a,e cmp l ret pmc.16.map: db 00h ; ;-------------------------------------------------- ; ; ; in: hl -> bcd ; out: hl = # ; cvt.bcd.2.bin: lxi d,cb2b.wk lxi b,bcd.size call move.h.2.d.cnt.b lxi d,cb2b.wk + 1 mvi c,(bcd.size -1) * 2 lxi h,0 cbcd2b.lup: push b xchg mvi c,(bcd.size - 1) call bcd.shift.left push psw push h lxi h,10 call mul.h.by.d.2.h pop d pop psw add l mov l,a mvi a,0 adc h mov h,a pop b dcr c jnz cbcd2b.lup ret ; cb2b.wk: ds bcd.size ; ; cvt.bcd.2.bin.map: db 41h,0a0h,03h,03h,00h,10h,00h ; ; ; ; ; ;=========================================== ; ; ; ; in: hl -> bcd ; de -> string cvt.bcd.2.str: push d lxi d,cbcd2s.wk lxi b,bcd.size call move.h.2.d.cnt.b pop d lxi h,cbcd2s.wk mvi c,(bcd.size - 1) * 2 ; mov a,m inx h ani 80h jz cbcd2s.plus ; mvi a,'-' stax d inx d ; cbcd2s.plus: push b lxi b,(bcd.size - 1) call bcd.shift.left pop b ; ora a jnz cbcd2s.lup ; dcr c jnz cbcd2s.plus inr c ; ; cbcd2s.lup: ori '0' stax d inx d ; push b lxi b,(bcd.size - 1) call bcd.shift.left pop b dcr c jnz cbcd2s.lup ; xra a stax d ret ; cbcd2s.wk: ds bcd.size ; ; cvt.bcd.2.str.map: db 20h,0c8h,04h,00h,0c4h,40h,06h,20h ds (bcd.size/8)+1 ; ; ; ; ; ;=========================================== ; ; ; ; in: hl = # ; de -> dest bcd cvt.bin.2.bcd: push d xchg lxi h,10000 call div.d.by.h.2.d.r.h xchg mov a,l sta cb2bcd.rslt + (bcd.size - 3) ; lxi h,1000 call div.d.by.h.2.d.r.h xchg mov a,l rlc ! rlc ! rlc ! rlc ani 0f0h push psw ; lxi h,100 call div.d.by.h.2.d.r.h xchg pop psw ora l sta cb2bcd.rslt + (bcd.size - 2) ; lxi h,10 call div.d.by.h.2.d.r.h mov a,e rlc ! rlc ! rlc ! rlc ani 0f0h ora l sta cb2bcd.rslt + (bcd.size - 1) ; pop d lxi h,cb2bcd.rslt lxi b,bcd.size jmp move.h.2.d.cnt.b ; ; cb2bcd.rslt: ds bcd.size ; ; cvt.bin.2.bcd.map: db 03h,10h,60h,00h,0c2h,0ch,01h,10h,60h ds (bcd.size/8)+1 ; ; ;=========================================== ; ; in: hl = # ; de -> str ; cvt.bin.2.dec.str: xchg push h lxi h,cb2d.wk + 5 mvi m,0 cb2d.lup: dcx h push h lxi h,10 call cmp.hl.fm.de jc cb2d.done call div.d.by.h.2.d.r.h mov a,l pop h ori '0' mov m,a jmp cb2d.lup cb2d.done: pop h mov a,e ori '0' mov m,a pop d jmp move.string ; cb2d.wk: db '000000' ; cb2d.map: db 10h,06h,98h,10h,0ch,00h ; ;-------------------------------------------------- ; ; in: hl = # ; de -> str ; cvt.bin.2.hex.str: xchg mov a,d call hex.left call hex.right mov a,e call hex.left call hex.right mvi m,0 ret hex.left: push psw rrc rrc rrc rrc jmp hex.digit hex.right: push psw hex.digit: ani 0fh adi '0' cpi '9'+1 jc hex.9 adi 7 hex.9: mov m,a inx h pop psw ret ; cb2h.map: db 12h,24h,00h,80h,20h,00h ; ;-------------------------------------------------- ; ; in: hl = # ; de -> str ; cvt.bin.2.oct.str: push d xchg lxi h,cb2o.wk + 6 cb2o.lup: mov a,e ani 07h ori '0' dcx h mov m,a mov a,e rrc rrc rrc ani 1fh mov e,a mov a,d ani 03h rrc rrc rrc ora e mov e,a mov a,d rrc rrc rrc ani 1fh mov d,a ora e jnz cb2o.lup pop d jmp move.string ; cb2o.wk: db '000000',0 ; cb2o.map: db 10h,00h,00h,00h,08h,0c0h,00h ; ;-------------------------------------------------- ; ; in: hl -> str ; ; out: hl = # ; cvt.dec.str.2.bin: xchg lxi h,0 cds2b.lup: ldax d cpi '0' rc cpi '9'+1 rnc push d lxi d,10 call mul.h.by.d.2.h pop d ldax d inx d sui '0' add l mov l,a mvi a,0 adc h mov h,a jmp cds2b.lup ; cds2b.map: db 00h,00h,0c0h,02h,00h ; ;-------------------------------------------------- ; ; ; in: hl -> str ; ; out: hl = # ; cvt.hex.str.2.bin: xchg lxi h,0 chs2b.lup: ldax d sui '0' rc cpi 9+1 jc chs2b.ok cpi 'A' - '0' rc cpi 'F'+1-'0' jc chs2b.upper cpi 'a'-'0' rc cpi 'f'+1-'0' rnc sui 'a'-'9'-1 jmp chs2b.ok chs2b.upper: sui 'A'-'9'-1 chs2b.ok: dad h dad h dad h dad h add l mov l,a mvi a,0 adc h mov h,a inx d jmp chs2b.lup ; chs2b.map: db 00h,10h,10h,02h,00h,02h ; ;-------------------------------------------------- ; ; ; in: hl -> str ; ; out: hl = # ; cvt.oct.str.2.bin: xchg lxi h,0 cos2b.lup: ldax d sui '0' rc cpi '7'-'0'+1 rnc dad h dad h dad h add l mov l,a mvi a,0 adc h mov h,a inx d jmp cos2b.lup ; cos2b.map: db 00h,00h,02h,00h ; ;-------------------------------------------------- ; ; ; ; in: hl -> string ; de -> bcd cvt.str.2.bcd: push h mov h,d mov l,e push h inx d xra a mov m,a lxi b,(bcd.size - 1) call move.h.2.d.cnt.b ; pop d pop h mov a,m cpi '-' jnz cs2bcd.plus inx h mvi a,80h jmp cs2bcd.sign cs2bcd.plus: xra a cs2bcd.sign: push psw cs2bcd.lup: mov a,m cpi '.' jz cs2bcd.point sui '0' jc cs2bcd.end cpi 9 + 1 jnc cs2bcd.end ; push h push d push psw lxi b,bcd.size - 1 inx d xchg call bcd.shift.left pop psw pop d lxi h,(bcd.size - 1) dad d ora m mov m,a pop h cs2bcd.point: inx h jmp cs2bcd.lup ; cs2bcd.end: pop psw stax d ret ; ; cvt.str.2.bcd.map: db 00h,18h,10h,40h,42h,10h,03h,00h,10h ; ; ; ; ; ;=========================================== ; ; in: hl -> string ; ; out: hl -> string terminator ; cvt.str.to.lower.case: mov a,m ora a rz cpi 'A' jc cslc.no cpi 'Z'+1 jnc cslc.no adi 'a'-'A' mov m,a cslc.no: inx h jmp cvt.str.to.lower.case cslc.map: db 02h,10h,20h ; ;-------------------------------------------------- ; ; ; in: hl -> string ; ; out: hl -> string terminator ; cvt.str.to.upper.case: mov a,m ora a rz cpi 'a' jc csuc.no cpi 'z'+1 jnc csuc.no sui 'a'-'A' mov m,a csuc.no: inx h jmp cvt.str.to.upper.case csuc.map: db 02h,10h,20h ; ;-------------------------------------------------- ; ; in: hl -> string ; display.string: mov e,m mov a,m ora a rz mvi c,2 push h call entry pop h inx h jmp display.string ; dsp.str.map: db 00h,04h ; ;-------------------------------------------------- ; display.crlf: lxi d,display.txt.crlf mvi c,9 jmp entry display.txt.crlf: db 13,10,'$' ; dcrlf.map: db 40h,00h,00h ; ; ;---------------------------------------------- ; DIVIDE DE BY HL ; QUOTIENT IS RETURNED IN DE ; REMAINDER IS RETURNED IN HL ;---------------------------------------------- div.d.by.h.2.d.r.h: mov b,h mov c,l xra a mov l,a mov h,a mvi a,16 divdhb2drhloop: push psw dad h xra a xchg dad h xchg adc l sub c mov l,a mov a,h sbb b mov h,a inx d jnc divdhb2drhover dad b dcx d divdhb2drhover: pop psw dcr a rz jmp divdhb2drhloop div.16.map: db 00h,00h,04h,04h ; ; ; ;------------------------------------------- ; ; ; ; EDIT STRING ; ; edit character action ; -------------- ------------------------------ ; L Left justify prior to edit ; If present, this must be the first ; character in the edit string. ; This is the default if the edit-string ; starts with 'X' or ' '. ; ; R Right-justify prior to edit. ; If present this must be the first ; character in the edit string. ; This is the default if the edit-string ; does not start with either 'L', 'X' or ' '. ; ; X Move one character from source to ; destination. ; ; 9 Move one character from source to ; destination. ; ; Insert a blank into the source field. ; ; Z If any non-zero characters have previously ; been moved in this edit, treat this as ; a '9'. ; If no non-zero characters have been ; moved, and the current character is ; zero, move a blank, otherwise move ; the current character. ; ; $ If the next character to be moved is ; the first non-zero character, move ; a '$' to the receiving field. ; If no non-zero characters have been moved ; and the next character is also zero, ; move a blank, otherwise treat this as ; a 'Z'. ; ; . insert a period into the receiving field. ; ; , If any non-zero characters have been ; moved, insert a comma, otherwise insert ; a space. ; ; + If this is the last character in the ; edit string, insert a '+' or '-' ; (depending on whether a '-' was found ; as the first non-zero with a '9' operator. ; If this is not the last character in the ; edit string, this is handled the same ; as the '$'. ; ; - Same as '+', except that if no '-' was ; found as the first non-blank with a '9' ; operator, a blank is moved. ; ; Ix Insert letter x in destination string. ; ; anything else is treated as an 'X'. ; ; NOTE: a space is treated as a zero for the purpose ; of determining if a non-zero digit has ; been moved. ; ; NOTE: if '$' is used with a sign ('+' or '-'), ; the sign must be trailing. ; ; NOTE: if a leading sign is used, it must ; occur in a position where the source ; field has a minus, otherwise it will ; not be recognised. (editing '-1' with ; a picture of '---,-99' will give a ; result of ' 01'. ; ; ; ; in: hl -> src ; de -> dest ; bc -> picture ; ; edit.string: push d push h lxi d,edit.src.wk call move.string pop h pop d ; mvi a,'+' sta edit.sign ; mvi a,' ' sta edit.comma.blank ; mvi a,'R' sta edit.just xra a sta edit.non.zero ; ldax b cpi 'L' jz edit.just.spec cpi 'R' jz edit.just.spec cpi ' ' jz edit.left.just cpi 'X' jnz edit.dflt.just ; edit.left.just: mvi a,'L' sta edit.just jmp edit.dflt.just ; edit.just.spec: inx b sta edit.just edit.dflt.just: xchg shld edit.dst.ptr mov h,b mov l,c shld edit.pic.ptr xchg call size.d.2.h xchg ;---trailing sign is also an insertion char--- lhld edit.pic.ptr dad d dcx h mov a,m cpi '+' jz edit.trail cpi '-' jnz edit.no.trail edit.trail: dcx d edit.no.trail: ;---don't include insertion characters in--- ;---with justification length. lhld edit.pic.ptr edit.lup.ins.chars: mov a,m inx h ora a jz edit.end.ins.chars cpi '.' jz edit.ins.char cpi ',' jz edit.ins.char cpi ' ' jz edit.ins.char cpi 'I' jnz edit.lup.ins.chars dcx d ;count off one for letter I,too inx h ;skip over char to insert edit.ins.char: dcx d jmp edit.lup.ins.chars ; edit.end.ins.chars: lxi h,edit.src.wk inx d ;make room for string terminator lda edit.just cpi 'L' jnz edit.right.just call justify.left jmp edit.just.done edit.right.just: call justify.right edit.just.done: lhld edit.pic.ptr mov b,h mov c,l lhld edit.dst.ptr xchg lxi h,edit.src.wk ; edit.lup: ldax b inx b ; ora a jz edit.end cpi ' ' jz edit.blank cpi '.' jz edit.dot cpi ',' jz edit.comma cpi '+' jz edit.plus cpi '-' jz edit.minus cpi '$' jz edit.dollar cpi 'Z' jz edit.Z cpi '9' jz edit.9 cpi 'I' jz edit.I ; edit.move: mov a,m jmp edit.move.skip ; ; edit.9: mvi a,0ffh sta edit.non.zero edit.9.move: mov a,m cpi '-' jz edit.9.minus cpi ' ' jz edit.9.0 jmp edit.move.skip ; edit.9.minus: sta edit.sign edit.9.0: mvi a,'0' edit.move.skip: inx h edit.dot: edit.blank: edit.dst.only: stax d inx d call edit.chk.zero jz edit.lup mvi a,0ffh sta edit.non.zero jmp edit.lup ; ; edit.I: ldax b inx b jmp edit.comma.dst ; ; edit.comma: lda edit.non.zero ora a lda edit.comma.blank jz edit.comma.dst mvi a,',' edit.comma.dst: stax d inx d jmp edit.lup ; ; edit.plus: ldax b ora a ;trailing? jnz edit.plus.no.trail lda edit.sign jmp edit.dst.only ; edit.plus.no.trail: lda edit.non.zero ora a jnz edit.9.move mov a,m call edit.chk.zero jnz edit.9.move inx h mov a,m dcx h call edit.chk.zero mvi a,' ' jz edit.move.skip ldax b cpi ',' jz edit.plus.over.comma lda edit.sign jmp edit.move.skip ; edit.plus.over.comma: lda edit.sign jmp edit.set.over.comma ; ; edit.minus: ldax b ora a ;trailing? jnz edit.minus.no.trail lda edit.sign cpi '-' jz edit.dst.only mvi a,' ' jmp edit.dst.only ; edit.minus.no.trail: lda edit.non.zero ora a jnz edit.9.move mov a,m call edit.chk.zero jnz edit.9.move inx h mov a,m dcx h call edit.chk.zero mvi a,' ' jz edit.move.skip ldax b cpi ',' jz edit.minus.over.comma lda edit.sign cpi '-' jz edit.move.skip mvi a,' ' jmp edit.move.skip ; edit.minus.over.comma: lda edit.sign cpi '-' jz edit.set.over.comma mvi a,' ' edit.set.over.comma: sta edit.comma.blank mvi a,' ' jmp edit.move.skip ; ; edit.dollar: lda edit.non.zero ora a jnz edit.9.move mov a,m call edit.chk.zero jnz edit.9.move inx h mov a,m dcx h call edit.chk.zero mvi a,' ' jz edit.move.skip ldax b cpi ',' jz edit.dollar.over.comma mvi a,'$' jmp edit.move.skip ; edit.dollar.over.comma: mvi a,'$' jmp edit.set.over.comma ; ; edit.Z: lda edit.non.zero ora a jnz edit.9.move mov a,m call edit.chk.zero jnz edit.9.move mvi a,' ' jmp edit.move.skip ; ; edit.end: xra a stax d ret ; ; ; ; edit.chk.zero: cpi ' ' rz cpi '0' rz cpi '-' rnz sta edit.sign mvi a,'0' ret ; ; edit.sign: db '+' edit.just: db 'R' edit.non.zero: db 0 edit.comma.blank: db ' ' edit.dst.ptr: dw 0 edit.pic.ptr: dw 0 edit.src.wk: ds max.edit.len ; ; edit.string.map: db 13h,04h,21h,10h,42h,10h,84h db 88h,84h,64h,04h,22h,08h,42h db 10h,82h,44h,26h,9ah,11h db 04h,21h,08h,42h,10h,84h,22h db 10h,42h,48h,09h,09h,09h db 12h,04h,24h,91h,12h,08h,41h db 24h,90h,90h,84h,88h,90h,42h db 09h,08h,48h,42h,12h,22h,41h db 08h,21h,09h,11h,21h,00h db 02h,00h,00h ds (max.edit.len / 8) + 1 ; ; ; ; ; ;=============================================== ; exchange.block: push b mov b,m ldax d mov m,a mov a,b stax d inx h inx d pop b dcx b mov a,b ora c rz jmp exchange.block ; exchange.map: db 00h,02h,00h ; ;=============================================== ; ; in: de -> string with file-name ; hl -> command-line (or =0 if none) ; a = 0 - no error exit provided ; <> 0 - return to caller on error ; execute.program: push h xchg push psw lxi d,dflt.fcb call format.file.name execute.no.format: ;used only internally lxi d,dflt.fcb lxi h,6 ;open R/O for MP/M dad d mov a,m ori 80h mov m,a mvi c,15 ;open call entry inr a jnz exec.open.ok pop psw pop d ora a rnz ;return on error ; lxi h,exec.err.msg lxi d,dflt.fcb call file.error ; exec.err.msg: db 'EXECUTE',0 ; exec.open.ok: pop psw ;restore stack pop h ;cmd-line ptr mov a,h ora l jz exec.no.cmd lxi d,dflt.dma mvi a,7fh stax d inx d call move.string ; exec.no.cmd: lhld entry + 1 lxi d,exec.start - exec.end ;-(size) dad d sphl push h xchg lhld exec.1 + 1 dad d shld exec.1 + 1 lhld exec.2 + 1 dad d shld exec.2 + 1 lxi h,exec.start pop d push d lxi b,exec.end - exec.start jmp move.h.2.d.cnt.b ; ; exec.start: lxi d,100h push d exec.lup: push d mvi c,26 ;set dma call entry lxi d,dflt.fcb mvi c,20 ;read call entry pop d ora a exec.2: jnz exec.close - exec.start lxi h,128 dad d xchg exec.1: jmp exec.lup - exec.start ; exec.close: lxi d,dflt.fcb mvi c,16 ;close file for MP/M jmp entry ;return to 100h ; ; ds 1 exec.end: ; ; exec.pgm.map: db 01h,80h,00h,10h,20h,0c0h,01h,00h,60h db 02h,24h,48h,0ch,00h,00h,00h,00h,00h db 00h,00h,00h,00h ; ; ; ; ;=============================================== ;------------------------------------------- ; format file name ; ; incoming parameters: ; de points to fcb ; hl points to alpha file-name ; ; outgoing parameters: ; hl points to the character after the last one used ; the fcb will be fully initialized (for 33 bytes) ;-------------------------------------------------- format.file.name: push d mvi c,fcb.rnd.rec + 2 xra a call ffn.fill pop d mvi c,8 inx h mov a,m dcx h inx d cpi ':' jnz ffn.name.lup dcx d mov a,m inx h inx h sui 'A'-1 stax d inx d ffn.name.lup: mov a,m inx h ora a jz ffn.delim.found cpi '.' jz ffn.end.name cpi '*' jnz ffn.name.not.star call ffn.fill.q jmp ffn.skip.name ; ffn.name.not.star: stax d inx d dcr c jnz ffn.name.lup ffn.skip.name: mov a,m inx h cpi '.' jz ffn.end.name ora a jz ffn.delim.found jmp ffn.skip.name ; ffn.end.name: mov a,c ora a jz ffn.do.ext call ffn.fill.b ffn.do.ext: mvi c,3 ffn.ext.lup: mov a,m inx h ora a jz ffn.fill.b cpi '*' jz ffn.fill.q stax d inx d dcr c jnz ffn.ext.lup ret ; ; ffn.delim.found: mov a,c ora a cnz ffn.fill.b mvi c,3 ffn.fill.b: mvi a,' ' ffn.fill: stax d inx d dcr c jnz ffn.fill ret ; ffn.fill.q: mvi a,'?' jmp ffn.fill ; ; ffn.map: db 04h,00h,40h,01h,08h,49h,04h,08h db 90h,90h,10h,82h,08h,02h,08h ; ; ;-------------------------------------------------- ; ; ; in: HL = value of subscript ; BC = addr of base of array ; E = size of incr ; ; out: HL = indexed address ; index.rtn: mvi d,0 push b call mul.h.by.d.2.h pop b dad b ret index.map: db 0ch,00h ; ;-------------------------------------------------- ; ; ; ; in: hl -> string ; de = field size ; justify.left: dcx d push d push h mov e,l mov d,h jsl.skip.blk.lup: mov a,m cpi ' ' jnz jsl.found.non.blk inx h jmp jsl.skip.blk.lup jsl.found.non.blk: call move.string pop h xchg call size.d.2.h xchg ;de -> string terminator ;hl = # chars ; xthl ;hl = field size ;de = # chars ;end string ptr is on stk ; call cmp.hl.fm.de jnc jsl.exit ;too big - don't try call sub.de.fm.hl.2.hl ;# chars to add xchg pop h jsl.lup: mvi m,' ' inx h mvi m,0 dcx d mov a,d ora e jnz jsl.lup ret jsl.exit: pop d ret ; ; justify.left.map: db 00h,44h,0c6h,34h,0c0h,04h,00h ; ; ; ; ; ;=========================================== ; ; ; ; in: hl -> string ; de = field size ; justify.right: push d ;field size xchg call size.d.2.h ; xchg jsr.skip.blk.lup: dcx h dcx d mov a,m cpi ' ' jnz jsr.found.non.blk mvi m,0 jmp jsr.skip.blk.lup ; jsr.found.non.blk: inx h inx d ; inx d ;include string terminator xthl ;put addr of str terminator on stack ;get field-size to hl call cmp.hl.fm.de jnc jsr.exit push d ;save string size call sub.de.fm.hl.2.hl xchg ;de <- size difference pop b ;string size pop h ;hl -> string terminator ;de = # bytes to add ;bc = size of string push d xchg dad d jsr.mov.lup: ldax d mov m,a dcx h dcx d dcx b mov a,b ora c jnz jsr.mov.lup pop b jsr.fill.lup: mvi m,' ' dcx h dcx b mov a,b ora c jnz jsr.fill.lup ret ; jsr.exit: pop d ret ; ; justify.right.map: db 18h,08h,40h,0d1h,80h,01h,00h,40h ; ; ; ; ; ;=========================================== ; ; ; ; move bcd move (bcd.size) bytes from @hl to @de ; move.bcd: lxi b,bcd.size jmp move.h.2.d.cnt.b move.bcd.map: db 0ch ; ; ;==================================================== ; ; in: hl -> byte after last in src ; de -> byte after last in dst ; bc = # bytes to move ; move.bkwds.h.2.d.cnt.b: mov a,c ora b rz dcx h dcx d mov a,m stax d dcx b jmp move.bkwds.h.2.d.cnt.b mov.bkwds.blk.map: db 00h,40h ; ;-------------------------------------------------- ; move.h.2.d.cnt.b: mov a,c ora b rz mov a,m stax d inx h inx d dcx b jmp move.h.2.d.cnt.b mov.blk.map: db 00h,40h ; ;-------------------------------------------------- ; ; in: hl -> src ; de -> dst ; move.string: mov a,m stax d inx h inx d ora a rz jmp move.string mov.str.map: db 01h,00h ; ;-------------------------------------------------- ; ; in: hl -> src ; de -> dst ; c = # src bytes ; b = # dst bytes ; move.field: mov a,m stax d inx h inx d dcr b rz dcr c jnz move.field mv.field.fill: mvi a,' ' stax d inx d dcr b jnz mv.field.fill ret ; move.field.map: db 00h,80h,80h ; ; ;-------------------------------------------------- ; ; in: hl -> field 1 ; de -> field 2 ; c = #bytes 1 ; b = #bytes 2 ; cmp.field: ldax d cmp m rnz inx h inx d dcr c jz cmp.field.hl.short dcr b jnz cmp.field cmp.field.de.short: mvi a,' ' cmp m rnz inx h dcr c rz jmp cmp.field.de.short ; cmp.field.hl.short: dcr b rz ;same length ldax d cpi ' ' rnz inx d jmp cmp.field.hl.short ; ; cmp.field.map: db 01h,10h,04h,01h,00h ; ; ;-------------------------------------------------- ; ; in: hl -> src (field) ; de -> dst (string) ; b=0 ; c=# src bytes ; move.field.2.str: call move.h.2.d.cnt.b stax d ret ; move.field.2.str.map: db 60h ; ; ;-------------------------------------------------- ; move.str.2.field: mov a,m ora a jz mv.str.2.field.fill stax d inx d inx h dcr c rz jmp move.str.2.field mv.str.2.field.fill: mvi a,' ' stax d inx d dcr c jnz mv.str.2.field.fill ret ; move.str.2.field.map: db 10h,10h,10h ; ; ;-------------------------------------------------- ; ; in: hl -> string ; de -> field ; c = # bytes ; cmp.field.2.str: mov a,m ora a jz cmp.f.2.s.str.short ldax d cmp m rnz inx h inx d dcr c jnz cmp.field.2.str cmp.f.2.s.field.short: mov a,m ora a rz cpi ' ' rnz inx h jmp cmp.f.2.s.field.short cmp.f.2.s.str.short: ldax d cpi ' ' rnz dcr c rz inx d jmp cmp.f.2.s.str.short ; cmp.field.2.str.map: db 10h,08h,02h,00h,80h ; ; ;------------------------------------ ; MULTIPLY HL BY DE GIVING HL ;------------------------------------ mul.h.by.d.2.h: mov b,h mov c,l xra a mov h,a mov l,a mvi a,16 mulhbd2hloop: dad h xchg dad h xchg jnc mulhbd2hover dad b mulhbd2hover: dcr a rz jmp mulhbd2hloop mul.16.map: db 00h,08h,20h ; ;-------------------------------------------------- ; negate.HL: mov a,h cma mov h,a mov a,l cma mov l,a inx h ret ; negate.hl.map: db 00h,00h ; ;-------------------------------------------------- ; OR.d.and.h: mov a,d ora h mov h,a mov a,e ora l mov l,a ora h ret OR.16.map: db 00h ; ; ; in: HL = overlay-header sctr # ; if HL = FFFF then close overlay fcb. ; DE = overlay load address ; BC = overlay size (bytes) ; ; overlay.loader: mov a,h ana l inr a jnz ovl.not.close ; ;---close the overlay file--- ; lxi h,ovl.open.flag mov a,m ora a rz mvi m,0 ;mark closed in case error return fm EXEC lxi d,ovl.load.fcb mvi c,16 jmp entry ; ovl.not.close: ; ;---save key into overlay file--- ; shld ovl.load.fcb + fcb.rnd.rec ;sctr # of header rec push d ;save load/exec addr xchg ;DE <- sctr#...HL <- addr dcx h mov a,m cmp d jnz ovl.load.needed dcx h mov a,m cmp e rz ;off to ovl already present -------- ovl.load.needed: pop h shld ovl.load.addr dcx h ;store key of loaded overlay mov m,d dcx h mov m,e mov h,b mov l,c shld ovl.byte.cnt ; ;---check if OVL file already open--- ; ovl.open.flag equ $+1 mvi a,00h ora a jnz ovl.already.open ; mvi a,0ffh sta ovl.open.flag ; lxi d,ovl.load.fcb mvi c,15 call entry inr a cz overlay.error ; ovl.already.open: call set.dflt.dma ;** lhld ovl.load.addr push h ;fake a call ovl.load.lup: lhld ovl.byte.cnt mov a,h ora l rz ;off to overlay (ovly returns to my caller) ; lxi d,ovl.load.fcb mvi c,33 call entry ora a cnz overlay.error ; lhld ovl.byte.cnt mov a,h ora a jnz ovl.load.128 mov a,l cpi 128 mov c,l mov b,h ;0 jc ovl.load.move ovl.load.128: lxi b,128 ovl.load.move: push b lhld ovl.load.addr xchg lxi h,dflt.dma call move.h.2.d.cnt.b ;** xchg shld ovl.load.addr pop h call negate.HL ;** xchg lhld ovl.byte.cnt dad d shld ovl.byte.cnt ; lhld ovl.load.fcb + fcb.rnd.rec inx h shld ovl.load.fcb + fcb.rnd.rec ; jmp ovl.load.lup ; ; overlay.error: lxi d,ovl.load.fcb lxi h,ovl.err.txt jmp file.error ovl.err.txt: db 'OVERLAY',0 ; ; ; ovl.byte.cnt: dw 0 ovl.load.addr: dw 0 ovl.load.fcb: ds fcb.limit ; ; overlay.loader.map: db 09h,01h,01h,01h,01h,00h,82h,12h,01h,34h db 41h,00h,90h,80h,81h,03h,23h,22h,44h,92h db 60h,00h,00h,00h,00h,00h,00h,00h,00h,00h ; ;-------------------------------------------------- ; ; in: hl -> string to scan ; de -> string to scan for (delim list) ; ; out: hl = position in string of result (0 relative) ; hl = position of terminator in @hl if not found ; hl = bc ; de = address corresponding to count in HL ; :Z - not found ; :NZ- found ; scan.h.for.d: lxi b,0 push d sh4d.lup: pop d push d push h mov a,m ora a jz sh4d.found sh4d.ch.lup: ldax d ora a jz sh4d.found cmp m jnz sh4d.next inx h inx d jmp sh4d.ch.lup sh4d.next: inx b pop h inx h jmp sh4d.lup sh4d.found: pop d pop h mov h,b mov l,c ldax d ora a ret ; sh4d.map: db 00h,21h,10h,82h,00h ; ;-------------------------------------------------- ; ; ; in: hl -> string to scan ; de -> string to scan for (delim list) ; ; out: hl = position in string of result (0 relative) ; hl = position of terminator in @hl if not found ; hl = bc ; de = address corresponding to count in HL ; :Z - not found ; :NZ- found ; scan.h.for.any.d: lxi b,0 push d sh4ad.lup: pop d push d push h mov a,m ora a jz sh4ad.found sh4ad.ch.lup: ldax d ora a jz sh4ad.next cmp m jz sh4ad.found inx d jmp sh4ad.ch.lup sh4ad.next: inx b pop h inx h jmp sh4ad.lup sh4ad.found: pop d pop h mov h,b mov l,c ldax d ora a ret ; sh4ad.map: db 00h,21h,11h,04h,00h ; ;-------------------------------------------------- ; ; ; in: hl -> string to scan ; de -> string to scan for (delim list) ; ; out: hl = position in string of result (0 relative) ; hl = position of terminator in @hl if not found ; hl = bc ; de = address corresponding to count in HL ; :Z - not found ; :NZ- found ; scan.h.for.no.d: lxi b,0 push d sh4nd.lup: pop d push d push h mov a,m ora a jz sh4nd.found sh4nd.ch.lup: ldax d ora a jz sh4nd.found cmp m jz sh4nd.next inx d jmp sh4nd.ch.lup sh4nd.next: inx b pop h inx h jmp sh4nd.lup sh4nd.found: pop d pop h mov h,b mov l,c ldax d ora a ret ; sh4nd.map: db 00h,21h,11h,04h,00h ; ;-------------------------------------------------- ; ; ; in: hl -> string to scan ; de -> string to scan for (delim list) ; ; out: hl = position in string of result (0 relative) ; hl = position of terminator in @hl if not found ; hl = bc ; de = address corresponding to count in HL ; :Z - not found ; :NZ- found ; scan.h.for.trailing.d: lxi b,0 shld sh4td.last.ptr push h mov h,b mov l,c shld sh4td.last.ctr pop h push d sh4td.lup: pop d push d push h mov a,m ora a jz sh4td.found sh4td.ch.lup: ldax d ora a jz sh4td.next cmp m jz sh4td.again inx d jmp sh4td.ch.lup sh4td.next: inx b mov h,b mov l,c shld sh4td.last.ctr pop h inx h shld sh4td.last.ptr jmp sh4td.lup sh4td.again: inx b pop h inx h jmp sh4td.lup sh4td.found: pop d pop h lhld sh4td.last.ptr xchg lhld sh4td.last.ctr ldax d ora a ret ; sh4td.last.ctr: dw 0 sh4td.last.ptr: dw 0 ; sh4td.map: db 008h,20h,08h,44h,41h,09h,04h,22h,00h ; ;-------------------------------------------------- ; ; in: de -> string ; ; out: hl = size (excluding terminator) ; de -> string terminator ; size.d.2.h: lxi h,0 sd2h.lup: ldax d ora a rz inx h inx d jmp sd2h.lup ; size.map: db 00h,40h ; ;-------------------------------------------------- ; sub.de.fm.hl.2.hl: mov a,l sub e mov l,a mov a,h sbb d mov h,a ret sub.16.map: db 00h ; ;-------------------------------------------------- ; ; in: hl -> src string ; de -> start position (0 relative) ; bc -> end position (0 relative) ; on stack = pointer to dest string ; UNSTRING.rtn: mov a,m ora a jz UNSTRING.move mov a,e ora d jz UNSTRING.move mov a,c ora b jz UNSTRING.move inx h dcx d dcx b jmp UNSTRING.rtn ; UNSTRING.move: xchg ;de <- curr string pos ;hl <- 0 pop h ;hl <- return addr xthl ;stack <- return addr ;hl <- dst. ptr. UNSTRING.mv.lup: mov a,b ora c jz UNSTRING.mv.end ldax d ora a jz UNSTRING.mv.end mov m,a inx d inx h dcx b jmp UNSTRING.mv.lup ; UNSTRING.mv.end: mvi m,0 ret ; UNSTRING.map: db 10h,84h,10h,10h,81h,00h ; ;-------------------------------------------------- ; XOR.d.and.h: mov a,d xra h mov h,a mov a,e xra l mov l,a ora h ret XOR.16.map: db 00h ; ;------------------------------------------------------------- ; RECORD-MODE I/O ROUTINES ;------------------------------------------------------------- ; ; ; ;-------------------------------------- ; record-read ; in: DE <- fcb ; out: DE <- fcb ; A = status record.read: call locate.record ;** push d ;save fcb ptr shld rec.rd.buf.ptr ;save buff ptr call rec.sctr.read ;** ;---get record size--- lxi h,fcb.rec.size dad d mov a,m inx h mov h,m mov l,a shld rec.rd.byte.ctr ;---get record address--- lxi h,fcb.rec.addr dad d mov a,m inx h mov h,m mov l,a shld rec.rd.rec.ptr ;---go thru this loop for each sector to be read--- rec.rd.sctr.lup: lhld rec.rd.buf.ptr mov b,h mov c,l lhld rec.rd.byte.ctr dad b mov b,h mov c,l ;---check if buffer present lxi h,fcb.flags dad d mov a,m ani FILE.r.flag.no.buff lxi h,dflt.dma + 128 jnz rec.rd.no.buff ;---buffer is present--- lxi h,fcb.rec.buffer + 128 dad d ;---HL = ptr past end of sector--- ;---BC = ptr past end of record--- ;---if BC > HL, only move (HL - rec.ptr) bytes--- ;---else move (byte.ctr) bytes--- rec.rd.no.buff: mov a,h cmp b jc rec.rd.partial jnz rec.rd.full mov a,l cmp c jnc rec.rd.full rec.rd.partial: ;---compute # bytes of record present--- xchg lhld rec.rd.buf.ptr xchg call sub.de.fm.hl.2.hl ;** push h ;save to decr ctr later ;---DE still = ptr to record--- mov b,h mov c,l lhld rec.rd.rec.ptr xchg lhld rec.rd.buf.ptr call move.h.2.d.cnt.b ;** ;---DE = ptr to next byte in record needed--- xchg shld rec.rd.rec.ptr ;---subtract # bytes moved from # bytes needed--- pop h call negate.HL ;** xchg lhld rec.rd.byte.ctr dad d shld rec.rd.byte.ctr ;---point HL to start of buffer for next sector--- pop d push d lxi h,fcb.flags dad d mov a,m ani FILE.r.flag.no.buff lxi h,dflt.dma jnz rec.rd.set.buff lxi h,fcb.rec.buffer dad d rec.rd.set.buff: shld rec.rd.buf.ptr ;---incr sector number--- lxi h,fcb.rnd.rec dad d mov c,m inx h mov b,m inx b mov m,b dcx h mov m,c call rec.sctr.read ;** jmp rec.rd.sctr.lup ; rec.rd.full: lhld rec.rd.byte.ctr mov b,h mov c,l lhld rec.rd.rec.ptr xchg lhld rec.rd.buf.ptr call move.h.2.d.cnt.b ;** pop d lxi h,fcb.status dad d mov a,m ret ; ; ; rec.rd.byte.ctr: dw 0 rec.rd.buf.ptr: dw 0 rec.rd.rec.ptr: dw 0 ; rec.read.map: db 64h,0c0h,10h,02h,42h,00h,02h,01h,21h,11h db 84h,4ch,8ch,88h,00h,10h,20h,00h,0d2h,11h db 30h,00h,00h ; ; ; ;-------------------------------------- ; record-write ; in: DE <- fcb ; out: DE <- fcb ; A = status record.write: call locate.record ;** push d push b ;save buffer ix shld rec.wt.buf.ptr lxi h,fcb.rec.size dad d mov a,m inx h mov h,m mov l,a shld rec.wt.byte.ctr lxi h,fcb.rec.addr dad d mov a,m inx h mov h,m mov l,a shld rec.wt.rec.ptr rec.wt.sctr.lup: lhld rec.wt.buf.ptr mov b,h mov c,l lhld rec.wt.byte.ctr dad b mov b,h mov c,l ;---check if buffer is present--- lxi h,fcb.flags dad d mov a,m ani FILE.r.flag.no.buff lxi h,dflt.dma + 128 jnz rec.wt.no.buff ;---buffer is present--- lxi h,fcb.rec.buffer + 128 dad d ;---HL = ptr past end of sector--- ;---BC = ptr past end of record--- ;---if BC < HL, pre-read is needed--- rec.wt.no.buff: mov a,b cmp h jc rec.wt.pre.read jnz rec.wt.chk.ix mov a,c cmp l jc rec.wt.pre.read ;---if rec starts after start of sctr, pre-read is needed--- rec.wt.chk.ix: xthl ;HL <- buff ix mov a,h ora l lxi h,0 ;any more will be 0 xthl jz rec.wt.no.pre.rd rec.wt.pre.read: call rec.sctr.read ;** rec.wt.no.pre.rd: ;---if BC > HL, only move (HL - rec.ptr) bytes--- ;---else move (byte.ctr) bytes--- mov a,h cmp b jc rec.wt.partial jnz rec.wt.full mov a,l cmp c jnc rec.wt.full ; rec.wt.partial: xchg lhld rec.wt.buf.ptr xchg call sub.de.fm.hl.2.hl ;** push h mov b,h mov c,l ; DE still = buff ptr lhld rec.wt.rec.ptr call move.h.2.d.cnt.b ;** shld rec.wt.rec.ptr pop h call negate.HL ;** xchg lhld rec.wt.byte.ctr dad d shld rec.wt.byte.ctr pop b pop d push d push b lxi h,fcb.flags dad d mov a,m ani FILE.r.flag.no.buff lxi h,dflt.dma jnz rec.wt.set.buff lxi h,fcb.rec.buffer dad d rec.wt.set.buff: shld rec.wt.buf.ptr call rec.sctr.write ;** lxi h,fcb.rnd.rec dad d mov c,m inx h mov b,m inx b mov m,b dcx h mov m,c jmp rec.wt.sctr.lup ; rec.wt.full: lhld rec.wt.byte.ctr mov b,h mov c,l lhld rec.wt.buf.ptr xchg lhld rec.wt.rec.ptr call move.h.2.d.cnt.b ;** pop b ;restore stack pop d jmp rec.sctr.write ;** ; ; rec.wt.byte.ctr: dw 0 rec.wt.buf.ptr: dw 0 rec.wt.rec.ptr: dw 0 ; ; rec.write.map: db 62h,00h,40h,09h,08h,00h,08h,04h,84h db 01h,31h,21h,11h,84h,0d1h,91h,00h,00h db 81h,30h,00h,90h,89h,8ch,00h ; ; ; ; ;----------------------------------- ; LOCATE RECORD ; in: DE <- fcb ; out: DE <- fcb ; HL <- 1st byte of record in buff ; BC <- offset of record in sctr ; fcb.rnd.rec = sctr # of start of record ; locate.record: push d ;stk <- fcb lxi h,fcb.flags dad d mov a,m ani FILE.r.flag.OPEN jz file.not.open.err ;** ;---get rec-length--- lxi h,fcb.rec.size dad d mov a,m inx h mov h,m mov l,a shld loc.rl ;---get record-key--- lxi h,fcb.rec.key dad d mov c,m inx h mov b,m ;BC <- rec.key ;---get blocking-factor--- lxi h,fcb.rec.blk.fac dad d mov e,m inx h mov d,m ;DE <- blk.fac ;---if blk-fctr = 0 then it's unblocked--- mov a,e ora d jz locate.unblocked ; ; ; ;---------------------------------------- ; Blocked-file locate ; push d ;stk <- blk fac ;---multiply rec.key by sctrs/rec--- ;---(nothing if rec.size <= 128)---- lhld loc.rl lxi d,127 dad d ;round up call loc.div.128 mov d,b mov e,c call mul.h.by.d.2.h ;** xchg ;DE <- rec key * sctrs/rec pop h ;HL <- blk fac ;---divide (rec.key * sctrs/rec) by blk.fac--- call div.d.by.h.2.d.r.h ;** xchg shld loc.sctr ;save sctr # ;---multiply rmdr by rec-size--- ;---(nothing if blk.fac = 1)---- lhld loc.rl jmp locate.rec.end ; ; ; ;------------------------------------------- ; Unblocked-file locate ; ; locate.unblocked: lhld loc.rl call loc.div.128 push d ;rl mod 128 push h ;rl / 128 ; mov h,b mov l,c call loc.div.128 push d ;rn mod 128 xchg ;DE <- rn / 128 ; lhld loc.rl call mul.h.by.d.2.h ;** shld loc.sctr ; pop d ;rn mod 128 pop h ;rl / 128 push d ;rn mod 128 call mul.h.by.d.2.h ;** xchg lhld loc.sctr dad d shld loc.sctr ; pop d ;rn mod 128 pop h ;rl mod 128 ; ; ; ; ;--------------------------------------- ; End of locate ; ; DE & HL are factors of offset ; fcb-addr is on stk ; locate.rec.end: ;---multiply offset factors to get total offset--- call mul.h.by.d.2.h ;** ;---divide offset by 128, any quot added to sctr#--- ;---remainder becomes new offset--- call loc.div.128 xchg xthl ;stk <- sctr offset, HL <- fcb push h ;stk <- fcb ;---add quotient to sctr#--- lhld loc.sctr dad d mov b,h mov c,l ;---put sctr # in fcb--- pop d ;DE <- fcb lxi h,fcb.rnd.rec dad d mov m,c inx h mov m,b pop b ;BC <- sctr offset ;---check if buffer present--- lxi h,fcb.flags dad d mov a,m ani FILE.r.flag.no.buff lxi h,dflt.dma jnz loc.rec.finish ;---buffer is present--- lxi h,fcb.rec.buffer dad d loc.rec.finish: dad b ret ; ; ; loc.div.128: mov a,l ani 7fh mov e,a ;DE <- rmdr mvi d,0 xra a ;reset carry dad h mov l,h ;HL <- quot aci 0 mov h,a ret ; ; ; loc.sctr: dw 0 loc.rl: dw 0 ; ; locate.rec.map: db 00h,60h,08h,00h,01h,10h,21h,8ch,92h,48h,10h db 9ah,0ch,88h,68h,20h,00h,00h,10h,00h,00h,00h ; ; ; ; ; ; ; ; ; ; ;----------------------------- ; sector read for record i/o ; in: de -> fcb ; out: all reg pairs saved ;----------------------------- rec.sctr.read: push h push b push d ;---always do fresh read if NO BUFFER--- lxi h,fcb.flags dad d mov a,m ani FILE.r.flag.no.buff xchg lxi d,dflt.dma jnz rsr.no.buff.read xchg ;---buffer is present -- check which sector--- ;---check if record is already present--- lxi h,fcb.rnd.rec dad d mov b,h mov c,l lxi h,fcb.rec.buf.sctr dad d ldax b cmp m jnz rsr.do.read inx h inx b ldax b cmp m jnz rsr.do.read ; ;---if buf rec # = 0, always read --- mov b,m dcx h mov a,m ora b mvi a,0 jnz rsr.exit rsr.do.read: lxi h,fcb.rec.buffer dad d xchg rsr.no.buff.read: mvi c,1ah call entry pop d push d mvi c,33 call entry ;---set file status--- pop d push d push psw ora a jz rsr.read.ok ;---if no buffer, need to clear dflt.dma instead--- lxi h,fcb.flags dad d mov a,m ani FILE.r.flag.no.buff lxi h,dflt.dma jnz rsr.eof.no.buff ;---clear buffer--- lxi h,fcb.rec.buffer dad d rsr.eof.no.buff: mvi c,128 xra a rsr.clr.eof.lup: mov m,a inx h dcr c jnz rsr.clr.eof.lup rsr.read.ok: call rec.sctr.updt ;** pop psw rsr.exit: pop d lxi h,fcb.status dad d mov m,a pop b pop h ret ; ; rec.sctr.read.map: db 00h,01h,00h,01h,02h,01h,00h,00h db 01h,00h,08h,00h,4ch,00h ; ; ; ;-------------------------------- ; in: DE -> fcb ; out: all reg pairs saved ;-------------------------------- rec.sctr.write: push h push b push d ;---if no buffer, dma-addr is dflt.dma--- lxi h,fcb.flags dad d mov a,m ani FILE.r.flag.no.buff xchg lxi d,dflt.dma jnz rsw.no.buff xchg ;---normal buffer--- lxi h,fcb.rec.buffer dad d xchg rsw.no.buff: mvi c,1ah call entry pop d push d mvi c,34 call entry pop d push d push psw lxi h,fcb.status dad d mov m,a call rec.sctr.updt ;** pop psw pop d pop b pop h ret ; ; rec.sctr.write.map: db 00h,01h,00h,00h,00h,0ch,00h ; ; ; ;---------------------------------------------- ; record buffer-sector update ;---------------------------------------------- rec.sctr.updt: lxi h,fcb.rec.buf.sctr dad d mov b,h mov c,l lxi h,fcb.rnd.rec dad d mov a,m stax b inx h inx b mov a,m stax b jmp set.dflt.dma ;** ; ; rec.sctr.updt.map: db 00h,00h,60h ; ; ; ; ; ; ;-------------------------------------------------- ; ; in: de -> fcb ; c = open-type (15 or 22) ; a = run-time flags value ; ; out: a = open status ; ; open.disk.file: lxi h,fcb.flags dad d ora m ;leave existing flags mov m,a ; lxi h,fcb.ext.num xra a dad d mov m,a ; lxi h,fcb.cur.rec dad d mov m,a ; push d call entry pop d ; lxi h,fcb.status dad d mov m,a ret ; open.disk.map: db 00h,00h,00h,00h ; ;--------------------------------------------- ; ; in: de -> fcb ; c = close-type (16 or 19) ; ; out: de -> fcb ; a = close status ; close.disk.file: lxi h,5 dad d mov a,m ani 80h jnz close.partial lxi h,fcb.flags dad d mvi a,0ffh - FILE.r.flag.OPEN ana m mov m,a close.partial: push d call entry pop d lxi h,fcb.status dad d mov m,a ret close.disk.map: db 00h,80h,00h,00h ; ;-------------------------------------------------- ; ; ; ; in: hl = ^h5c or ^h6c ; de -> fcb ; move.dflt.file.name: ;-----test if dflt-name move needed----- mov b,h mov c,l lxi h,fcb.flags dad d mov a,m ani (FILE.cr.flag.FILE1 or FILE.cr.flag.FILE2) rz ;no move needed ;-----reset flag so move won't be done next time----- mov a,m ani 0ffh - (FILE.cr.flag.FILE1 or FILE.cr.flag.FILE2) mov m,a ;-----drive on cmd.line overrides drive in fcb----- mov h,b mov l,c mov a,m ora a jz mdfd.no.drive stax d mdfd.no.drive: ;-----name on cmd.line overrides name in fcb----- inx h inx d lxi b,8 mov a,m cpi ' ' jnz mdfd.name.move dad b xchg dad b xchg jmp mdfd.ext mdfd.name.move: call move.h.2.d.cnt.b mdfd.ext: ;-----ext on cmd-line overrides ext in fcb----- mov a,m cpi ' ' rz lxi b,3 jmp move.h.2.d.cnt.b ; move.dflt.file.map: db 00h,00h,10h,01h,02h,60h,18h ; ; ; ;----------------------------------------------- ; ; rename file ; rename.file: call set.dflt.dma mvi c,23 lxi d,dflt.fcb jmp entry ; rename.file.map: db 60h,00h ; ; ;----------------------------------------------- ; remove.file: push d call set.dflt.dma pop d mvi c,19 jmp entry ; remove.file.map: db 30h,00h ; ; ;---------------------------------------------- ; find.file: push d push b call set.dflt.dma pop b pop d call entry mov l,a mvi h,0 dad h ! dad h ! dad h ! dad h ! dad h lxi d,dflt.dma dad d ret ; find.file.map: db 18h,00h,00h,00h ; ;--------------------------------------------------- ; ; ; in: de -> fcb ; c = I/O operator (20/21/33/34) ; ; out: a = I/O status ; disk.sctr.io: lxi h,fcb.flags dad d mov a,m ani FILE.r.flag.OPEN jz file.not.open.err push b push d lxi h,fcb.buf.addr dad d mov e,m inx h mov d,m ;dma addr mvi c,26 call entry pop d pop b push d call entry ;read/write pop d lxi h,fcb.status dad d mov m,a push psw push d call set.dflt.dma pop d pop psw ret ; dsio.map: db 00h,0c0h,00h,00h,01h,80h ; ;-------------------------------------------------- ; ; in: de -> fcb ; close.dsk.ch: lxi h,fcb.flags dad d mov a,m ani FILE.r.flag.output rz call cdch.eof cdch.lup: call cdch.eof lxi h,fcb.buf.ix dad d mov c,m inx h mov b,m dcx b mov a,c ora b jnz cdch.lup ret ; cdch.eof: push d mvi a,1ah call disk.char.out pop d ret ; cdch.map: db 00h,48h,00h,40h,0c0h ; ;-------------------------------------------------- ; ; in: de -> fcb ; disk.ch.in.open: lxi h,fcb.buf.size + 1 dad d mov b,m dcx h mov c,m dcx h mov m,b dcx h mov m,c ret dcio.map: db 00h,00h,00h ; ;-------------------------------------------------- ; ; in: de -> fcb ; disk.ch.out.open: lxi h,fcb.buf.ix + 1 dad d xra a mov m,a dcx h mov m,a ret dcoo.map: db 00h,00h,00h ; ;-------------------------------------------------- ; ; in: de -> fcb ; ; out: de -> buffer address of character ; a = character ; disk.char.in: mvi a,20 call disk.char.help ora a mov a,m rz mvi c,sctr.size mvi a,1ah dci.lup: mov m,a inx h dcr c jnz dci.lup lxi h,fcb.buf.addr dad d mov e,m inx h mov d,m ldax d ret dci.map: db 18h,00h,80h,00h ; ;-------------------------------------------------- ; ; in: de -> fcb ; a = character ; ; out: de = buffer address of character ; disk.char.out: push psw mvi a,21 call disk.char.help ora a jz dco.old lxi h,fcb.buf.addr dad d mov e,m inx h mov d,m xchg dco.old: pop psw mov m,a ret dco.map: db 0ch,80h,00h ; ;-------------------------------------------------- ; ; in: de -> fcb ; a = I/O operator (20/21) ; ; out: a = I/O status ; hl = buffer address for current character ; disk.char.help: push psw lxi h,fcb.flags dad d mov a,m ani FILE.r.flag.OPEN jz file.not.open.err push d lxi h,fcb.buf.ix dad d mov c,m ;bc <- buf ix inx h mov b,m inx h mov e,m ;de <- buf size inx h mov d,m push h mov h,b mov l,c call cmp.hl.fm.de pop h jnz dch.ch.fm.buf dcx h dcx h ;clr buf ix xra a mov m,a dcx h mov m,a xchg ;hl <- buf size dad h ;h = #sctrs/buf mov b,h ;b = #sctrs/buf xchg dcx h mov d,m ;de <- buf addr dcx h mov e,m xchg ;hl <- buf addr dch.read.lup: push b push h xchg mvi c,26 call entry pop h pop b pop d ;fcb addr pop psw ;read/write code push psw push d push b push h mov c,a ;read/write code call entry push psw ;status call set.dflt.dma pop psw ;status pop h pop b ora a ;status ok? jnz dch.src.eof ;no lxi d,sctr.size dad d ;new dma addr dcr b ;count # sctrs jnz dch.read.lup dch.ch.fm.buf: pop d ;fcb ptr pop psw ;restore stack lxi h,fcb.buf.ix dad d mov c,m inx h mov b,m inx b ;incr buf ix mov m,b dcx h mov m,c dcx h mov d,m ;de <- buf ptr dcx h mov e,m dcx b ;old buf.ix mov h,b mov l,c dad d ;plus buf start = char ptr xra a ret ; dch.src.eof: pop d push h lxi h,fcb.status dad d mov m,a inx h inx h inx h ;point to buf.ix mov c,m inx h mov b,m inx b ;incr buf.ix mov m,b dcx h mov m,c pop h pop psw ret ; dch.map: db 00h,60h,00h,19h,00h,00h,00h,00h db 03h,04h,04h,00h,00h,00h,00h,00h db 00h,00h ; ; ; ;--------------------------------------------- ; FILE NOT OPEN -- error message at run-time ; file.not.open.err: lxi h,fno.text jmp file.error ; fno.text: db 'NOT OPEN',0 fno.map: db 4ch,00h,00h ; ;---STANDARD OPEN error routine----- ; open.error: lxi h,open.err.txt jmp file.error open.err.txt: db 'OPEN',0 open.err.map: db 4ch,00h ; ;-----STANDARD CLOSE error routine----- ; close.error: lxi h,close.err.txt jmp file.error close.err.txt: db 'CLOSE',0 close.err.map: db 4ch,00h ; ;---STANDARD READ error routine--- ; read.error: lxi h,read.err.txt jmp file.error ; read.err.txt: db 'READ',0 read.err.map: db 4ch,00h ; ;-----STANDARD WRITE error routine----- ; write.error: lxi h,write.err.txt jmp file.error write.err.txt: db 'WRITE',0 write.err.map: db 4ch,00h ; ;-----general file-error handler----- ; file.error: push d lxi d,file.err.type mvi c,8 call move.str.2.field pop h ; push h mov a,m ora a jnz file.err.not.dflt lda dflt.drive inr a file.err.not.dflt: ani 0fh ;strip user off adi 'A'-1 sta file.err.drive pop h ; push h lxi d,fcb.status dad d mov l,m lxi d,file.err.addr call cvt.bin.2.hex.str lhld file.err.addr + 2 shld file.err.stat pop h ; push h lxi d,file.err.addr call cvt.bin.2.hex.str pop h ; push h lxi d,fcb.rnd.rec dad d mov a,m inx h mov h,m mov l,a lxi d,file.err.rec call cvt.bin.2.hex.str pop h ; inx h lxi d,file.err.name lxi b,11 call move.h.2.d.cnt.b lxi d,file.err.txt mvi c,9 call entry mvi c,10 ;# tracebacks jmp traceback ; file.err.txt: db 'FILE ' file.err.type: db ' ERROR, (STATUS=' file.err.stat: db '00) RND-REC=' file.err.rec: db '0000 . FCB AT ' file.err.addr: db '0000 .',13,10,'NAME:' file.err.drive: db 'X:' file.err.name: db ' $' ; file.err.map: db 21h,82h,00h,40h,13h,48h,4ch,00h,4ch,41h,0a0h,0ch dw 0,0,0,0,0,0,0,0,0,0,0,0 ; ; ; ;-----stack traceback----- ; traceback: lxi h,0 dad sp push h push b lxi d,traceback.txt mvi c,9 call entry traceback.lup: pop b dcr c jz boot lhld entry + 1 xchg pop h inx h call cmp.de.fm.hl jnc boot mov d,m dcx h mov e,m inx h inx h push h push b xchg lxi d,traceback.addr + 1 call cvt.bin.2.hex.str lxi d,traceback.addr mvi c,9 call entry jmp traceback.lup ; traceback.txt: db 13,10,'STACK TRACEBACK:$' traceback.addr: db ' 0000 $' ; traceback.map: db 01h,00h,00h,30h,00h,9ah db 02h,00h,00h,00h,00h,00h,00h ; ; ; ; ; ; ; ; ; ; ; ;-------------------------------------------- ; table of built-in relocatable routines ; ; format: ; dw start of routine ; dw end of routine / start of map ; db forward b-i-r references ; (above is optional and may be repeated) ; db 0 ; ;-------------------------------------------- ; ; reloc.rtn.tbl: ;---ACCEPT dw ACCEPT.from.console dw ACCEPT.map db bir.DISPLAY.crlf db bir.mov.str db 0 ;---OVERLAY LOAD dw overlay.loader dw overlay.loader.map db bir.set.dflt.dma db bir.mov.blk db bir.neg.hl db bir.file.error db 0 ;---INDEX dw index.rtn dw index.map db bir.mul.16 db 0 ;---MOVE FIELD dw move.field dw move.field.map db 0 ;---MOVE FIELD TO STRING dw move.field.2.str dw move.field.2.str.map db bir.mov.blk db 0 ;---COMPARE FIELDS dw cmp.field dw cmp.field.map db 0 ;---COMPARE FIELD TO STRING dw cmp.field.2.str dw cmp.field.2.str.map db 0 ;---DEFAULT FILE NAME MOVE dw move.dflt.file.name dw move.dflt.file.map db bir.mov.blk db bir.mov.blk db 0 ;---RENAME FILE dw rename.file dw rename.file.map db bir.set.dflt.dma db 0 ;---REMOVE FILE dw remove.file dw remove.file.map db bir.set.dflt.dma db 0 ;---FIND FILE dw find.file dw find.file.map db bir.set.dflt.dma db 0 ;---EXECUTE PROGRAM dw execute.program dw exec.pgm.map db bir.fmt.filnm db bir.file.error db bir.mov.str db bir.mov.blk db 0 ;---BCD MULTIPLY dw bcd.multiply dw bcd.multiply.map db bir.BCD.move.2.dbl db bir.BCD.move.2.dbl db bir.mov.blk db bir.BCD.shift.right db bir.BCD.add.entry db bir.BCD.shift.left db 0 ;---BCD DIVIDE dw bcd.divide dw bcd.divide.map db bir.mov.blk db bir.BCD.move.2.dbl db bir.dividend db bir.BCD.move.2.dbl db bir.dividend db bir.cmp.blk db bir.BCD.shift.left db bir.BCD.shift.right db bir.BCD.shift.left db bir.dividend db bir.cmp.blk db bir.dividend db bir.BCD.sub.entry db bir.BCD.add.entry db bir.mov.blk db 0 ;---BCD MOVE TO DOUBLE dw bcd.move.2.dbl dw bcd.move.2.dbl.map db bir.mov.blk db 0 ;---BCD ADD dw bcd.add dw bcd.add.map db bir.BCD.add.entry db bir.dividend db bir.BCD.sub.do.it db bir.dividend db bir.move.BCD db 0 ;---BCD SUBTRACT dw bcd.subtract dw bcd.subtract.map db bir.bcd.sub.do.it db bir.dividend db bir.BCD.add.entry db bir.dividend db bir.move.BCD db 0 ;---BCD SUB DO IT dw bcd.sub.do.it dw bcd.sub.do.it.map db bir.cmp.blk db bir.bcd.sub.entry db 0 ;---BCD ADD ENTRY dw bcd.add.entry dw bcd.add.entry.map db bir.bcd.prep db 0 ;---BCD SUB ENTRY dw bcd.sub.entry dw bcd.sub.entry.map db bir.bcd.prep db 0 ;---BCD PREP dw bcd.prep dw bcd.prep.map db 0 ;---CVT STR -> BCD dw cvt.str.2.bcd dw cvt.str.2.bcd.map db bir.mov.blk db bir.bcd.shift.left db 0 ;---CVT BCD -> STR dw cvt.bcd.2.str dw cvt.bcd.2.str.map db bir.mov.blk db bir.bcd.shift.left db bir.bcd.shift.left db 0 ;---CVT BCD -> BIN dw cvt.bcd.2.bin dw cvt.bcd.2.bin.map db bir.mov.blk db bir.bcd.shift.left db bir.mul.16 db 0 ;---CVT BIN -> BCD dw cvt.bin.2.bcd dw cvt.bin.2.bcd.map db bir.div.16 db bir.div.16 db bir.div.16 db bir.div.16 db bir.mov.blk db 0 ;---BCD SHIFT RIGHT dw bcd.shift.right dw bcd.shift.right.map db 0 ;---BCD SHIFT LEFT dw bcd.shift.left dw bcd.shift.left.map db 0 ;---EDIT STRING dw edit.string dw edit.string.map db bir.mov.str db bir.size db bir.justify.left db bir.justify.right db 0 ;---JUSTIFY LEFT dw justify.left dw justify.left.map db bir.mov.str db bir.size db bir.pmc.16 db bir.sub.16 db 0 ;---JUSTIFY RIGHT dw justify.right dw justify.right.map db bir.size db bir.pmc.16 db bir.sub.16 db 0 ;---MOVE BCD dw move.bcd dw move.bcd.map db bir.mov.blk db 0 ;---BCD COMPARE dw bcd.compare dw bcd.comp.map db bir.cmp.blk db 0 ;---RECORD READ dw record.read dw rec.read.map db bir.locate.rec db bir.rec.sctr.read db bir.sub.16 db bir.mov.blk db bir.neg.hl db bir.rec.sctr.read db bir.mov.blk db 0 ;---RECORD WRITE dw record.write dw rec.write.map db bir.locate.rec db bir.rec.sctr.read db bir.sub.16 db bir.mov.blk db bir.neg.hl db bir.rec.sctr.write db bir.mov.blk db bir.rec.sctr.write db 0 ;---LOCATE RECORD dw locate.record dw locate.rec.map db bir.file.not.open db bir.mul.16 db bir.div.16 db bir.mul.16 db bir.mul.16 db bir.mul.16 db 0 ;---REC SCTR READ dw rec.sctr.read dw rec.sctr.read.map db bir.rec.sctr.updt db 0 ;---REC SCTR WRITE dw rec.sctr.write dw rec.sctr.write.map db bir.rec.sctr.updt db 0 ;---REC SCTR UPDT (show sctr # in buff) dw rec.sctr.updt dw rec.sctr.updt.map db bir.set.dflt.dma db 0 ;---CMP BLK dw cmp.blk dw cmp.blk.map db 0 ;---DISPLAY dw display.string dw dsp.str.map db 0 ;---DISPLAY cr/lf dw display.crlf dw dcrlf.map db 0 ;---UNSTRING dw UNSTRING.rtn dw UNSTRING.map db 0 ;---SCAN dw scan.h.for.d dw sh4d.map db 0 ;---SCAN ANY dw scan.h.for.any.d dw sh4ad.map db 0 ;---SCAN NO dw scan.h.for.no.d dw sh4nd.map db 0 ;---SCAN TRAILING dw scan.h.for.trailing.d dw sh4td.map db 0 ;---SIZE dw size.d.2.h dw size.map db 0 ;---cvt bin - oct dw cvt.bin.2.oct.str dw cb2o.map db bir.mov.str db 0 ;---cvt dec - bin dw cvt.dec.str.2.bin dw cds2b.map db bir.mul.16 db 0 ;---cvt hex - bin dw cvt.hex.str.2.bin dw chs2b.map db 0 ;---cvt oct - bin dw cvt.oct.str.2.bin dw cos2b.map db 0 ;---AND.16 dw AND.d.and.h dw AND.16.map db 0 ;---OR.16 dw OR.d.and.h dw OR.16.map db 0 ;---XOR.16 dw XOR.d.and.h dw XOR.16.map db 0 ;---cvt.bin.2.dec dw cvt.bin.2.dec.str dw cb2d.map db bir.pmc.16 db bir.div.16 db bir.mov.str db 0 ;---cmp.str dw compare.strings dw cmp.str.map db 0 ;---mul 16 dw mul.h.by.d.2.h dw mul.16.map db 0 ;---div 16 dw div.d.by.h.2.d.r.h dw div.16.map db 0 ;---sub 16 dw sub.de.fm.hl.2.hl dw sub.16.map db 0 ;---append dw append.h.2.d dw append.map db bir.mov.str db 0 ;---mov.str dw move.string dw mov.str.map db 0 ;---exchange block dw exchange.block dw exchange.map db 0 ;---format file name dw format.file.name dw ffn.map db 0 ;---convert to upper case dw cvt.str.to.upper.case dw csuc.map db 0 ;---convert to lower case dw cvt.str.to.lower.case dw cslc.map db 0 ;---disk-text file close dw close.dsk.ch dw cdch.map db bir.dsk.ch.out db 0 ;---disk-text open output dw disk.ch.out.open dw dcoo.map db 0 ;---disk-text open input dw disk.ch.in.open dw dcio.map db 0 ;---disk-text character output dw disk.char.out dw dco.map db bir.dsk.ch.help db 0 ;---disk-text character input dw disk.char.in dw dci.map db bir.dsk.ch.help db 0 ;---support routine for disk-text i/o dw disk.char.help dw dch.map db bir.file.not.open db bir.pmc.16 db bir.set.dflt.dma db 0 ;---disk sector i/o dw disk.sctr.io dw dsio.map db bir.file.not.open db bir.set.dflt.dma db 0 ;---open disk file dw open.disk.file dw open.disk.map db 0 ;---close disk file dw close.disk.file dw close.disk.map db 0 ;---compare backwards dw cmp.hl.fm.de dw pmc.16.map db 0 ;---NEGATE HL dw negate.hl dw negate.hl.map db 0 ;---MOVE BLOCK REVERSE dw move.bkwds.h.2.d.cnt.b dw mov.bkwds.blk.map db 0 ;---SET DEFAULT DMA dw set.dflt.dma dw set.dflt.dma.map db 0 ;---FILE NOT OPEN ERROR MESSAGE dw file.not.open.err dw fno.map db bir.file.error db 0 ;---OPEN ERROR dw open.error dw open.err.map db bir.file.error db 0 ;---CLOSE ERROR dw close.error dw close.err.map db bir.file.error db 0 ;---READ ERROR dw read.error dw read.err.map db bir.file.error db 0 ;---WRITE ERROR dw write.error dw write.err.map db bir.file.error db 0 ;---FILE ERROR dw file.error dw file.err.map db bir.move.str.2.field db bir.cvt.bin.hex db bir.cvt.bin.hex db bir.cvt.bin.hex db bir.mov.blk db bir.traceback db 0 ;---TRACEBACK dw traceback dw traceback.map db bir.cmp.16 db bir.cvt.bin.hex db 0 ;---MOVE STRING TO FIELD dw move.str.2.field dw move.str.2.field.map db 0 ;---mov.blk dw move.h.2.d.cnt.b dw mov.blk.map db 0 ;---cvt bin hex dw cvt.bin.2.hex.str dw cb2h.map db 0 ;---cmp.16 dw cmp.de.fm.hl dw cmp.16.map db 0 ;---DIVIDEND dw dividend dw dividend.map db 0 ;---end of table db 0 ; ; ds 20 ;patch area ; ; ; ; ; ; ; ; ; ; ; ; ; bir.descriptions: db 'accept',0 db 'overlay load',0 db 'index',0 db 'move field',0 db 'move field to string',0 db 'compare field',0 db 'compare field to string',0 db 'FILE1 name move',0 db 'rename file',0 db 'remove file',0 db 'find file',0 db 'execute',0 db 'bcd multiply',0 db 'bcd divide',0 db 'bcd mv 2 dbl',0 db 'bcd add',0 db 'bcd subtract',0 db 'bcd sub do it',0 db 'bcd add entry',0 db 'bcd sub entry',0 db 'bcd prep',0 db 'cvt str 2 bcd',0 db 'cvt bcd 2 str',0 db 'cvt bcd 2 bin',0 db 'cvt bin 2 bcd',0 db 'bcd shift right',0 db 'bcd shift left',0 db 'edit',0 db 'justify left',0 db 'justify right',0 db 'move bcd',0 db 'bcd compare',0 db 'rec read',0 db 'rec write',0 db 'locate rec',0 db 'rec sctr read',0 db 'rec sctr write',0 db 'rec sctr update',0 db 'cmp blk',0 db 'display',0 db 'disp crlf',0 db 'unstring',0 db 'scan',0 db 'scan any',0 db 'scan no',0 db 'scan trailing',0 db 'size',0 db 'cvt bin 2 oct',0 db 'cvt dec 2 bin',0 db 'cvt hex 2 bin',0 db 'cvt oct 2 bin',0 db 'and',0 db 'or',0 db 'xor',0 db 'cvt bin 2 dec',0 db 'string compare',0 db 'multiply',0 db 'divide',0 db 'subtract',0 db 'append',0 db 'move string',0 db 'exchange',0 db 'format file name',0 db 'cvt str 2 upper',0 db 'cvt str 2 lower',0 db 'txt dsk close',0 db 'txt out dsk open',0 db 'txt in dsk open',0 db 'txt dsk output',0 db 'txt dsk input',0 db 'txt help',0 db 'dsk sctr i/o',0 db 'dsk open',0 db 'dsk close',0 db 'cmp hl fm de',0 db 'negate',0 db 'move block reverse',0 db 'set dflt dma',0 db 'file not open err',0 db 'open error',0 db 'close error',0 db 'read error',0 db 'write error',0 db 'file error',0 db 'traceback',0 db 'move string to field',0 db 'move block',0 db 'cvt bin 2 hex',0 db 'cmp de fm hl',0 db 'bcd remainder',0 db 0,0,0 ; ; ; msg.tot.sym.tbl.spc: db 'total symbol table space ',0 msg.usd.sym.tbl.spc: db 'used symbol table space ',0 msg.percent.prefix: db ' (',0 msg.percent.postfix: db '%) ',0 msg.hi.obj.code: db 'start free memory address ',0 msg.num.k.prefix: db 'H (',0 msg.num.recs.prefix: db 'K) (',0 msg.num.recs.postfix: db ' records)',13,10,13,10,0 msg.25: db '.25',0 msg.50: db '.50',0 msg.75: db '.75',0 msg.err: db ' errors. ',0 msg.statements: db ' statements compiled. ',0 msg.lines.printed: db ' lines printed.',0 ; ; ; l.eoj.himem equ $ ; ; ; ; ; ; end