Oakland CPM Archive

home *** CD-ROM | disk | FTP | other *** search

/ Oakland CPM Archive / oakcpm.iso / cpm / parasol / parasols.ark / LCOMMON.ASM < prev next >

Wrap

Assembly Source File | 1986-10-06 | 14.4 KB | 965 lines

; ;----------------------------------------------- ; ; S Y M B O L T A B L E ; M A N I P U L A T I O N ; ;----------------------------------------------- ; ; ; ;-----fixup reference to built-in routine------ ; ; in: a = routine identifier ; fix.up.built.in.rtn: push psw lxi h,word lxi d,word.save call move.string pop psw ; sta word xra a sta word + 1 call fix.up.fwd.ref.word ; lxi h,word.save lxi d,word jmp move.string ; ; ; ;-------------------------- ; all forward references cause all registers to be ; undefined. Specific cases must be handled elsewhere ;-------------------------- ; ; fix.up.fwd.ref.word: lhld curr.ovl.start.key push h call opt.undef.all call init.sym.tbl.srch fufrw.lup: call get.sym.tbl.entry lda ste.type ;any more to do? cpi stet.end.tbl jz fufrw.restore.ovl ;exit ; lxi h,curr.block.level ;is it within scope? lda ste.block.level cmp m jc fufrw.restore.ovl ;exit ; lda ste.type ;is it a fwd ref? cpi stet.fwd.ref jnz fufrw.lup ; lxi h,ste.name ;is it same name? lxi d,word call compare.strings jnz fufrw.lup ; lhld ste.ovl.key ;is reference in an overlay? mov a,h ana l inr a jz fufrw.not.ovl ; lda overlay.in.process ;patch ovl-to-ovl handled same ora a ;as patch com-to-com jnz fufrw.not.ovl ; ;---set up for overlay patch--- ; push h ;ovl-hdr key call write.code.write ;---save COM fcb--- lxi h,code.fcb lxi d,code.fcb.save lxi b,36 call move.h.2.d.cnt.b lxi h,code.file.map lxi d,code.map.save lxi b,512 call move.h.2.d.cnt.b ;---replace COM fcb with OVL fcb--- lxi h,ovl.fcb lxi d,code.fcb lxi b,36 call move.h.2.d.cnt.b ;---don't allocate any new ovl recs--- lxi h,code.file.map lxi d,code.file.map + 1 mvi m,0ffh lxi b,511 call move.h.2.d.cnt.b mvi a,0ffh sta overlay.in.process ; pop h ;ovl-hdr key shld ovl.sctr.offset shld curr.ovl.start.key ; lhld curr.code.addr push h ;save non-ovl address ; ;---find start address of overlay--- ; lhld start.wk.sym.tbl.addr ;save parms for push h ;get.sym.tbl.entry lhld wk.sym.tbl.addr push h ; ;--loop for earliest label in this overlay--- fufrw.get.ovl.lup: call get.sym.tbl.entry lda ste.type cpi stet.end.tbl ;finished? jz fufrw.ovl.endlup ;yes ; ani 0ffh - stet.deleted ;see what it used to be cpi stet.label ;is this a label jnz fufrw.get.ovl.lup ;no, can't be ovl start ; lhld ste.ovl.key ;is it same overlay as patch? xchg lhld ovl.sctr.offset call cmp.de.fm.hl jnz fufrw.get.ovl.lup ;no ; lhld ste.address ;the last one here is overlay-start shld fufrw.ovl.hdr.addr jmp fufrw.get.ovl.lup ; fufrw.ovl.endlup: ;---restore previous sym-tbl search params--- pop h shld wk.sym.tbl.addr pop h shld start.wk.sym.tbl.addr lxi d,symbol.table.entry call move.sym.tbl.entry fufrw.ovl.hdr.addr equ $+1 lxi h,0 shld start.code.addr ; ;---do the patch--- ; lhld ste.address shld curr.code.addr call set.code.key shld code.fcb + fcb.rnd.rec call read.code.buff.only pop h ;routine addr push h ;re-save call put.code.word call write.code.write ;force disk update ;---set back to non-overlay COM file--- xra a sta overlay.in.process lxi h,code.fcb.save lxi d,code.fcb lxi b,36 call move.h.2.d.cnt.b lxi h,code.map.save lxi d,code.file.map lxi b,512 call move.h.2.d.cnt.b lxi h,0 shld ovl.sctr.offset lxi h,0100h shld start.code.addr pop h ;restore routine addr shld curr.code.addr call set.code.key call read.code.buff.only jmp fufrw.ovl.cont ; ;---NON-overlay fix-up--- ; fufrw.not.ovl: lhld ste.address call read.code lhld curr.code.addr push h lhld ste.address shld curr.code.addr pop h push h call put.code.word pop h shld curr.code.addr fufrw.ovl.cont: lhld start.wk.sym.tbl.addr mov a,m ori stet.deleted mov m,a jmp fufrw.lup ; ; fufrw.restore.ovl: pop h shld curr.ovl.start.key ret ; ; ; ;--------------------------------------- ; ; ; put code word / put code byte ; in: (word) - hl (put into code l then h) ; (byte) - a ; put.code.word: mov a,l push h call put.code.byte pop h mov a,h put.code.byte: push psw ; lhld start.code.addr xchg lhld curr.code.addr call cmp.de.fm.hl cc err.pgm.bounds ; call read.code ; lhld curr.code.addr mov a,l lhld start.code.addr sub l ani 7fh mov l,a mvi h,0 lxi d,code.buffer dad d pop psw mov m,a lhld curr.code.addr inx h shld curr.code.addr ret ; ; ; ; ; ;--------------------------------------- write.code.write: lhld code.fcb + fcb.rnd.rec lxi d,code.file.map dad d mvi m,0ffh lxi d,code.buffer mvi c,26 call entry ; ;---add in possible overlay base sctr offset--- ; lhld code.fcb + fcb.rnd.rec push h xchg lhld ovl.sctr.offset dad d shld code.fcb + fcb.rnd.rec lxi d,code.fcb mvi c,34 call entry pop h shld code.fcb + fcb.rnd.rec push psw ; lxi d,dflt.dma mvi c,26 call entry ; call clear.code.buff pop psw ora a rz jmp err.code.write ; ; ; ; ;-------------------------------------- ; ; read code ; ; read.code: call set.code.key shld curr.read.key xchg lhld code.fcb + fcb.rnd.rec call cmp.de.fm.hl rz ; call write.code.write ; lxi d,0 read.code.write.lup: push d lxi h,code.file.map dad d mov a,m ora a jnz read.code.written ; xchg shld code.fcb + fcb.rnd.rec call write.code.write ; read.code.written: pop d lhld curr.read.key call cmp.de.fm.hl jz read.code.end inx d jmp read.code.write.lup ; read.code.end: lhld curr.read.key shld code.fcb + fcb.rnd.rec ; lxi d,code.file.map dad d mov a,m ora a jz clear.code.buff ; read.code.buff.only: ; lxi d,code.buffer mvi c,26 call entry ; lhld code.fcb + fcb.rnd.rec push h xchg lhld ovl.sctr.offset dad d shld code.fcb + fcb.rnd.rec lxi d,code.fcb mvi c,33 call entry pop h shld code.fcb + fcb.rnd.rec ; lxi d,dflt.dma mvi c,26 jmp entry ; ; ; ;---------------------------------- ; set code key ; ; in: hl=memory address of code file ; out: hl=code file key ; ; set.code.key: ;---compute offset from start of code--- ;---whether offset is zero or 100h------ xchg lhld start.code.addr mov a,h cma mov h,a mov a,l cma mov l,a inx h dad d ;--shr 8 then shl 1 (shr 7) mov a,l mov l,h mvi h,0 dad h add a mvi a,0 adc l mov l,a mvi a,0 adc h mov h,a ret ; ; ; clear.code.buff: xra a sta code.buffer lxi h,code.buffer lxi d,code.buffer + 1 lxi b,127 jmp move.h.2.d.cnt.b ; ; ; ; ; ;---put word and 'ste.' params into symbol table--- ; put.word.into.tbl: lhld curr.code.addr shld ste.address put.word.into.tbl.no.addr: lxi h,word lxi d,ste.name call move.string put.ste.into.tbl.no.addr: lhld curr.ovl.start.key lda overlay.in.process ora a jnz psit.is.ovl lxi h,0ffffh psit.is.ovl: shld ste.ovl.key lda curr.block.level sta ste.block.level ; ;---fall into 'move.entry.to.sym.tbl'--- ; ; ; ; ;-----move symbol.table.entry into symbol table----- ; in: symbol.table.entry ; start.sym.tbl.addr ; ; out: start.sym.tbl.addr ; ; move.entry.to.sym.tbl: lxi d,ste.name - 1 lxi b,(ste.name - symbol.table.entry) metst.count.lup: inx b inx d ldax d ora a jnz metst.count.lup ; push d lhld my.top.stk.addr dad b xchg lhld start.sym.tbl.addr call cmp.hl.fm.de pop d jc metst.move.lup ; lxi d,em.sym.ofl mvi c,9 call entry jmp boot em.sym.ofl: db 'symbol table overflow',13,10,'$' ; metst.move.lup: dcx h ldax d mov m,a dcx d dcx b mov a,b ora c jnz metst.move.lup shld start.sym.tbl.addr ; ;---check if new low sym tbl addr--- ; xchg lhld lowest.sym.tbl.addr call cmp.hl.fm.de xchg rnc ; shld lowest.sym.tbl.addr ret ; ; ; ; ;--------------------------------------------------- ; set.dflt.dma: lxi d,dflt.dma mvi c,26 jmp entry ; set.dflt.dma.map: db 00h ; ;-------------------------------------------------- ; listing.crlf: mvi e,0dh call print.out mvi e,0ah jmp print.out ; ; con.ch.in: mvi c,1 jmp entry ; ; listing.string.out: ldax d ora a rz inx d push d mov e,a call print.out pop d jmp listing.string.out ; ; ; listing.blk.hex.out: push psw mvi e,' ' call print.out pop psw listing.hex.out: push psw rrc rrc rrc rrc call listing.hex.digit pop psw listing.hex.digit: ani 0fh adi '0' cpi '9'+1 jc listing.hex.ok adi 7 listing.hex.ok: mov e,a jmp print.out ; ; ; print.sym.tbl.entry: lxi d,pst.lit.type call listing.string.out lda ste.type call listing.hex.out ; lxi d,pst.lit.address call listing.string.out lda ste.address + 1 call listing.hex.out lda ste.address call listing.hex.out ; lxi d,pst.lit.level call listing.string.out lda ste.block.level call listing.hex.out ; lxi d,pst.lit.ovl call listing.string.out lda ste.ovl.key + 1 call listing.hex.out lda ste.ovl.key call listing.hex.out ; lxi d,pst.lit.length call listing.string.out lda ste.length + 1 call listing.hex.out lda ste.length call listing.hex.out ; lxi d,pst.lit.name call listing.string.out lxi d,ste.name ldax d ani 80h ;special? jnz str.to.print.in.hex call listing.string.out jmp listing.crlf ; ; pst.lit.type: db 'type:',0 pst.lit.address: db ' addr:',0 pst.lit.level: db ' lvl:',0 pst.lit.ovl: db ' ovl#:',0 pst.lit.length: db ' length:',0 pst.lit.name: db ' name:',0 pst.line.wk: db ' ',0 ; ; ; ; ; ; ; ;------------------------------------------ ; ; print.out.word: lxi d,word ldax d ani 80h jnz err.unx.hex call listing.string.out jmp listing.crlf ; err.unx.hex: call str.to.print.in.hex jmp listing.crlf ; ; ; ; ; str.to.print.in.hex: ldax d ora a jz listing.crlf inx d push d call listing.blk.hex.out pop d jmp str.to.print.in.hex ; ; ; ; ;---------------------------------------------- ; ; ; err.pgm.bounds: lxi h,em.pgm.bounds jmp print.error em.pgm.bounds: db 'Program address out of bounds',0 ; ; ; ;---------------------------------------------- ; ; ; ; ;----initialize for symbol table search---- ; init.sym.tbl.srch: lhld start.sym.tbl.addr shld wk.sym.tbl.addr lhld end.sym.tbl.addr shld start.wk.sym.tbl.addr ret ; ; ; ;-----get next symbol-table entry----- ; ; in: wk.sym.tbl.addr points at next entry ; ; out: symbol.table.entry ; wk.sym.tbl.addr points at new next entry ; start.wk.sym.tbl.addr points at new current entry ; get.sym.tbl.entry: lhld wk.sym.tbl.addr shld start.wk.sym.tbl.addr lxi d,symbol.table.entry call move.sym.tbl.entry shld wk.sym.tbl.addr ret ; ; ; print.out.c.blanks: mov a,c ora a rz push b mvi e,' ' call print.out pop b dcr c jmp print.out.c.blanks ; ; ; move.sym.tbl.entry: lxi b,ste.name - symbol.table.entry call move.h.2.d.cnt.b jmp move.string ; ; ; put.fwd.bir.sv.word: lhld word push h call put.fwd.ref.bir pop h shld word ret ; ; ; put.bir.call.fwd: push psw call opt.undef.all mvi a,(call) call put.code.byte pop psw put.fwd.ref.bir: sta word mov c,a xra a sta word + 1 ; mov a,c cpi bir.routine.limit jnc put.fwd.ref.addr sui bir.routine.base mov e,a mvi d,0 lxi h,built.in.rtn.flags dad d mov m,c ; ; ; ;---put backwards jump to table if table present--- ; lda table.fwd.flag ora a jz put.fwd.ref.addr ; mov h,d mov l,e dad h ;times 3 dad d xchg lhld fwd.tbl.addr dad d jmp put.code.word ; ; ; ;---no table present -- put forward reference--- ; (also entry point for fwd-ref addresses) ; put.fwd.ref.addr: mvi a,stet.fwd.ref sta ste.type lxi h,0 shld ste.length call put.word.into.tbl lxi h,0 jmp put.code.word ; ; ; err.code.write: lxi d,em.code.write mvi c,9 call entry mvi c,1 call entry cpi 3 jz boot ret ; ; ; em.code.write: db 'COM file write error',13,10 db 'press ^C to abort, or any other',13,10 db 'key to ignore',13,10,'$' ; ; ; print.out: lda print.console ora a jz print.out.not.con push d call print.con.ch pop d print.out.not.con: lda print.printer.flag ora a jz print.out.not.printer push d mvi c,5 call entry pop d print.out.not.printer: lda print.disk.flag ora a rz ;exit push d mov a,e lxi h,print.fcb + fcb.status ;zero status mvi m,0 push h lxi d,print.fcb call disk.char.out pop h mov a,m ;check status ora a jz print.out.disk.ok lxi d,em.print.disk mvi c,9 call entry xra a ;stop disk print on error sta print.disk.flag print.out.disk.ok: pop d ret ; ; ; print.error.and.colm: call print.error jmp print.error.colm ; ; ; print.error.and.word: mvi a,0ffh sta print.word.flag call print.error jmp print.out.word ; ; ; print.warning: lda nowarn.flag ora a rnz mvi a,'>' sta prt.err.flag.byte push h jmp print.warn.entry ; ; ; print.error: push h lhld err.ctr inx h shld err.ctr mvi e,7 call print.con.ch ;beep on error mvi a,'-' sta prt.err.flag.byte print.warn.entry: mvi d,5 prt.err.dash.lup: push d prt.err.flag.byte equ $+1 mvi e,'-' call print.out pop d dcr d jnz prt.err.dash.lup pop h print.error.lup: mov a,m ora a jz print.error.end push h mov e,a call print.out pop h inx h jmp print.error.lup ; print.error.end: lda print.word.flag ora a cz listing.crlf xra a sta print.word.flag mvi a,0ffh sta error.this.line ret ; ; ; print.error.colm: lda curr.print.colm ora a rz ; ;-----check number of spaces print is offset----- ; mvi c,0 lda print.blk.match.flag ani 06h add c mov c,a ; lda print.blk.lvl.flag ani 6 add c mov c,a ; lda print.line.num.flag ani 6 add c mov c,a ; lda print.code.addr.flag ani 5 add c mov c,a ; call print.out.c.blanks ; ; lda curr.print.colm dcr a ora a jz prt.err.got.colm cpi print.line.size - 3 jnc prt.err.got.colm prt.err.colm.lup: push psw mvi e,'-' call print.out pop psw dcr a jnz prt.err.colm.lup prt.err.got.colm: mvi e,'|' call print.out jmp listing.crlf ; ; ; ; print.con.ch: mvi c,2 jmp entry ; em.print.disk: db 7,'Print write error$' ; ; ; ; ;-------------- End of LCOMMON.ASM ----------------- ;; ;