ftp.barnyard.co.uk

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

/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / PARASOL / PARASOLS.ARK / LSTMT.ASM < prev next >

Wrap

Assembly Source File | 1986-10-05 | 151KB | 8,469 lines

; ; ;------------------------------- ; The program ;------------------------------- compile.the.program: call process.a.statement call get.word lda rsvd.wd.ix cpi rwix.semicolon cz get.word lda word cpi 1ah jz MAIN.eof.src ; call err.txt.after.END MAIN.flush.src: call get.src.char cpi 1ah jnz MAIN.flush.src MAIN.eof.src: jmp MAIN.end.pgm ; err.txt.after.end: lxi h,em.txt.after.end jmp print.error ; ; em.txt.after.end: db 'text found following final end',0 ; ; ;----------------------------------- ; statement compilation routine ;----------------------------------- ; ; last.err.ctr: db 0 last.good.code dw 0100h ; process.a.statement: lda last.err.ctr lxi h,err.ctr cmp m jz prc.no.new.err lhld last.good.code ;erase bad obj-code shld curr.code.addr prc.no.new.err: lda err.ctr sta last.err.ctr lhld curr.code.addr shld last.good.code call prc.stmt prc.stmt.skip.semi: lda rsvd.wd.ix cpi rwix.semicolon rnz call get.word jmp prc.stmt.skip.semi ; ; ; prc.stmt: lhld statement.counter inx h shld statement.counter call chk.stk.overflow call debug.routine call switch.rsvd.wd.ix db rwix.end.of.source ! dw err.eof.on.src db rwix.semicolon ! dw process.semicolon db rwix.ACCEPT ! dw process.ACCEPT db rwix.ADD ! dw process.ADD db rwix.AND ! dw process.AND db rwix.APPEND ! dw process.APPEND db rwix.BCD ! dw process.BCD db rwix.BEGIN ! dw process.BEGIN db rwix.BIT ! dw process.BIT db rwix.BYTE ! dw process.BYTE db rwix.CALL ! dw process.CALL db rwix.CLOSE ! dw process.CLOSE db rwix.COMMENT ! dw process.COMMENT db rwix.CONVERT ! dw process.CONVERT db rwix.COPY ! dw process.COPY db rwix.DISABLE ! dw process.DISABLE db rwix.DISPLAY ! dw process.DISPLAY db rwix.DIVIDE ! dw process.DIVIDE db rwix.DO ! dw process.DO db rwix.EDIT ! dw process.EDIT db rwix.ELSE ! dw err.unmtchd.ELSE db rwix.ENABLE ! dw process.ENABLE db rwix.ENDREC ! dw err.unmtchd.ENDREC db rwix.ENDREDEF ! dw err.unmtchd.ENDREDEF db rwix.ENDSWITCH ! dw err.unmtchd.ENDSWITCH db rwix.END ! dw err.unmtchd.END db rwix.EXCHANGE ! dw process.EXCHANGE db rwix.EXECUTE ! dw process.EXECUTE db rwix.EXITBEGIN ! dw process.EXITBEGIN db rwix.EXITDO ! dw process.EXITDO db rwix.EXITSWITCH ! dw process.EXITSWITCH db rwix.EXIT ! dw process.EXIT db rwix.EXTERNAL ! dw process.EXTERNAL db rwix.FIELD ! dw process.FIELD db rwix.FILE ! dw process.FILE db rwix.FILL ! dw process.FILL db rwix.FIND ! dw process.FIND db rwix.FI ! dw err.unmtchd.FI db rwix.GOTO ! dw process.GOTO db rwix.GO ! dw process.GO db rwix.IF ! dw process.IF db rwix.INDEX ! dw process.INDEX db rwix.INPUT ! dw process.INPUT db rwix.JUSTIFY ! dw process.JUSTIFY db rwix.MCALL ! dw process.MCALL db rwix.MOVE ! dw process.MOVE db rwix.MULTIPLY ! dw process.MULTIPLY db rwix.NULL ! dw process.NULL db rwix.OD ! dw err.unmtchd.OD db rwix.OPEN ! dw process.OPEN db rwix.OR ! dw process.OR db rwix.OUTPUT ! dw process.OUTPUT db rwix.POINTER ! dw process.POINTER db rwix.POP ! dw process.POP db rwix.PRINT ! dw process.PRINT db rwix.PROCEDURE ! dw process.PROCEDURE db rwix.PUSH ! dw process.PUSH db rwix.READ ! dw process.READ db rwix.REBOOT ! dw process.REBOOT db rwix.RECORD ! dw process.RECORD db rwix.REDEFINE ! dw process.REDEFINE db rwix.REMOVE ! dw process.REMOVE db rwix.RENAME ! dw process.RENAME db rwix.SCAN ! dw process.SCAN db rwix.SEGMENTED ! dw process.SEGMENTED db rwix.SET ! dw process.SET db rwix.SIZE ! dw process.SIZE db rwix.STRING ! dw process.STRING db rwix.SUBTRACT ! dw process.SUBTRACT db rwix.SWITCH ! dw process.SWITCH db rwix.TRACEBACK ! dw process.TRACEBACK db rwix.UNSTRING ! dw process.UNSTRING db rwix.UNTIL ! dw err.unmtchd.OD ;UNTIL db rwix.WHILE ! dw process.WHILE db rwix.WORD ! dw process.WORD db rwix.WRITE ! dw process.WRITE db rwix.XOR ! dw process.XOR db 0 ! dw process.not.rsvd ; ; ; ds 10 ;*************** debug patch area ; ; ; ;------------------------------------------ ; ; process.not.rsvd: call set.byte.boundary lda word.type ani wtp.ident jz err.unexpect.word ; lxi h,word lxi d,ste.A.name call move.string call get.word lda rsvd.wd.ix cpi rwix.colon jnz err.unexpect.word call chk.strt.code lxi h,ste.A.name lxi d,word call move.string lxi h,word lxi d,last.label call move.string call chk.word.not.in.tbl mvi a,stet.label sta ste.type lxi h,0 shld ste.length call put.word.into.tbl ; ;---check if I need to save sym-tbl-ptr to overlay name--- ; lhld curr.ovl.ste.ptr mov a,h ora l jnz pnr.already lhld start.sym.tbl.addr shld curr.ovl.ste.ptr pnr.already: ; call fix.up.fwd.ref.word process.semicolon: call get.word call chk.not.blk.ender rz jmp prc.stmt ; ; ;------------------------------------------------------ ; process.ACCEPT: call chk.strt.code call get.word call get.var.A.word ; lda A.word.type ani wtp.string jnz p.ACCEPT.DISPLAY ; lda ste.A.type cpi stet.RECORD jz p.ACCEPT.type.ok cpi stet.STRING cnz err.inv.var.type p.ACCEPT.type.ok: call put.LXI.H.A call put.MVI.C lda ste.A.length dcr a call put.code.byte mvi a,bir.ACCEPT call put.bir.call.fwd jmp p.ACCEPT.next ; ; p.ACCEPT.DISPLAY: call put.inline.A.string ; call put.LXI.H.A mvi a,bir.DISPLAY call put.bir.call.fwd lda rsvd.wd.ix cpi rwix.comma jnz err.mssng.rsvd.wd ; p.ACCEPT.next: lda rsvd.wd.ix cpi rwix.comma jz process.ACCEPT ret ; ; ;------------------------------------------------------ ; ; process.ADD: call chk.strt.code call get.word call get.var.A.word ; lda rsvd.wd.ix cpi rwix.TO cz get.word ; call get.var.B.word ; lda rsvd.wd.ix cpi rwix.GIVING jnz p.ADD.2 ; call get.word call chk.word.id.only call get.var.C.word ; ; lda A.word.type ani wtp.cnst jnz p.ADD.3.c call switch.A db stet.BYTE ! dw p.ADD.3.8 db stet.WORD ! dw p.ADD.3.16 db stet.BCD ! dw p.ADD.BCD.general db stet.spcl.bcd.ptr ! dw p.ADD.BCD.general db 0 ! dw p.ADD.general ; ; p.ADD.3.8: lda B.word.type ani wtp.cnst jnz p.ADD.3.8.c call switch.B db stet.BYTE ! dw p.ADD.3.8.8 db stet.WORD ! dw p.ADD.3.8.16 db stet.spcl.byte.ptr ! dw p.ADD.general db stet.spcl.word.ptr ! dw p.ADD.general db 0 ! dw p.ADD.3.8.err ; p.ADD.3.8.err: call err.inv.numeric.var p.ADD.3.8.8: call switch.C db stet.BYTE ! dw put.add.3.A8.B8.C8 db 0 ! dw p.ADD.general ; p.ADD.3.8.16: call switch.C db stet.BYTE ! dw put.add.3.A8.B8.C8.tru db 0 ! dw p.ADD.general ; p.ADD.3.8.c: call switch.C db stet.BYTE ! dw put.add.3.A8.BN.C8 db 0 ! dw p.ADD.general ; p.ADD.3.16: call switch.B db stet.BYTE ! dw p.ADD.3.16.8 db stet.WORD ! dw p.ADD.3.16.16 db 0 ! dw p.ADD.general ; p.ADD.3.16.8: call switch.C db stet.BYTE ! dw put.add.3.A8.B8.C8.tru db 0 ! dw p.ADD.general ; p.ADD.3.16.16: call switch.C db stet.BYTE ! dw put.ADD.3.A8.B8.C8.tru db 0 ! dw p.ADD.general ; p.ADD.2: lxi h,sym.tbl.entry.B lxi d,sym.tbl.entry.C call move.sym.tbl.entry lda B.word.type sta C.word.type ; lda A.word.type ani wtp.cnst jnz p.ADD.2.c call switch.A db stet.BYTE ! dw p.ADD.2.8 db stet.WORD ! dw p.ADD.2.16 db stet.spcl.byte.ptr ! dw p.ADD.2.BP db stet.BCD ! dw p.ADD.BCD.general db stet.spcl.BCD.ptr ! dw p.ADD.BCD.general db 0 ! dw p.ADD.general ; p.ADD.2.8: call switch.B db stet.BYTE ! dw put.add.2.A8.B8 db stet.spcl.byte.ptr ! dw put.add.2.A8.BBP db 0 ! dw p.ADD.general ; p.ADD.2.16: call switch.B db stet.BYTE ! dw put.add.2.A16.B8 db 0 ! dw p.ADD.general ; p.ADD.2.BP: call switch.B db stet.BYTE ! dw put.add.2.ABP.B8 db stet.spcl.byte.ptr ! dw put.add.2.ABP.BBP db 0 ! dw p.ADD.general ; p.ADD.3.c: call switch.B db stet.BYTE ! dw p.ADD.3.c.8 db stet.WORD ! dw p.ADD.3.c.16 db stet.BCD ! dw p.ADD.BCD.general db stet.spcl.BCD.ptr ! dw p.ADD.BCD.general db 0 ! dw p.ADD.general ; p.ADD.3.c.8: call switch.C db stet.BYTE ! dw put.add.3.AN.B8.C8 db 0 ! dw p.ADD.general ; p.ADD.3.c.16: call switch.C db stet.BYTE ! dw put.add.3.AN.B8.C8.tru db 0 ! dw p.ADD.general ; p.ADD.2.c: call switch.B db stet.BYTE ! dw put.add.2.AN.B8 db stet.WORD ! dw put.add.AN.B16.C16 db stet.spcl.byte.ptr ! dw put.add.2.AN.BBP db stet.BCD ! dw p.ADD.BCD.general db stet.spcl.BCD.ptr ! dw p.ADD.BCD.general db 0 ! dw p.ADD.general ; ; ; p.ADD.general: ; ;---if only one is cnst, make it A--- ; lda B.word.type ani wtp.cnst jz p.ADD.g.cnst.ok call swap.A.B.sym.entries jmp p.ADD.g.c ; p.ADD.g.cnst.ok: lda A.word.type ani wtp.cnst jnz p.ADD.g.c ; ;---special optimization for adding number to itself--- ; lxi h,sym.tbl.entry.A lxi d,sym.tbl.entry.B call compare.sym.tbl.entries jz put.add.misc.A.eql.B ; call switch.A db stet.BYTE ! dw put.add.misc.A.WORD db stet.WORD ! dw put.add.misc.A.WORD db stet.spcl.byte.ptr ! dw put.add.misc.BP db stet.spcl.word.ptr ! dw put.add.misc.WP db 0 ! dw p.ADD.g.A.err ; p.ADD.g.A.err: call err.inv.numeric.var p.ADD.g.c: lda B.word.type ani wtp.cnst jnz put.add.misc.c.c jmp put.add.AN.B16.C16 ; ; ; ; ; p.ADD.BCD.general: call switch.C db stet.BCD ! dw p.ADD.gBCD.C.BCD db stet.spcl.BCD.ptr ! dw p.ADD.gBCD.C.ptr db 0 ! dw p.ADD.gBCD.C.err ; p.ADD.gBCD.C.err: call err.inv.var.type p.ADD.gBCD.C.BCD: call put.LXI.B.C jmp p.ADD.gBCD.A ; p.ADD.gBCD.C.ptr: call put.LHLD.C call put.mv.HL.to.BC ; p.ADD.gBCD.A: lda A.word.type ani wtp.cnst jnz p.ADD.gBCD.A.cnst ; call switch.A db stet.BCD ! dw p.ADD.gBCD.A.BCD db stet.spcl.BCD.ptr ! dw p.ADD.gBCD.A.ptr db 0 ! dw p.ADD.gBCD.A.err ; p.ADD.gBCD.A.err: call err.inv.var.type p.ADD.gBCD.A.cnst: lxi h,sym.tbl.entry.A call put.inline.BCD p.ADD.gBCD.A.BCD: call put.LXI.D.A jmp p.ADD.gBCD.B ; p.ADD.gBCD.A.ptr: call put.LHLD.A call put.XCHG ; p.ADD.gBCD.B: lda B.word.type ani wtp.cnst jnz p.ADD.gBCD.B.cnst ; call switch.B db stet.BCD ! dw p.ADD.gBCD.B.BCD db stet.spcl.BCD.ptr ! dw p.ADD.gBCD.B.ptr db 0 ! dw p.ADD.gBCD.B.err ; p.ADD.gBCD.B.err: call err.inv.var.type p.ADD.gBCD.B.cnst: lxi h,sym.tbl.entry.B call put.inline.BCD p.ADD.gBCD.B.BCD: call put.LXI.H.B jmp p.ADD.gBCD.ADD ; p.ADD.gBCD.B.ptr: call put.LHLD.B ; p.ADD.gBCD.ADD: mvi a,bir.BCD.add jmp put.bir.call.fwd ; ; ; ; ;------------------------------------------------------ ; ; process.AND: process.OR: process.XOR: lda rsvd.wd.ix sta and.or.xor.type call get.word call chk.strt.code call get.var.A.word lda rsvd.wd.ix cpi rwix.WITH cz get.word ; call get.var.B.word lda rsvd.wd.ix cpi rwix.GIVING jz p.AOX.GIVING ; lxi h,sym.tbl.entry.A lda A.word.type sta C.word.type ani wtp.cnst jz p.AOX.no.g.A.ok lda B.word.type sta C.word.type lxi h,sym.tbl.entry.B p.AOX.no.g.A.ok: lxi d,sym.tbl.entry.C call move.sym.tbl.entry jmp p.AOX.cont ; p.AOX.GIVING: call get.word call get.var.C.word p.AOX.cont: lxi h,sym.tbl.entry.B lxi d,sym.tbl.entry.C call compare.sym.tbl.entries cz swap.A.B.sym.entries ; call switch.C db stet.BYTE ! dw p.AOX.x.x.8 db stet.WORD ! dw p.AOX.16 db stet.spcl.byte.ptr ! dw p.AOX.x.x.8 db stet.spcl.word.ptr ! dw p.AOX.16 db 0 ! dw p.AOX.C.err ; ; p.AOX.C.err: call err.inv.var.type p.AOX.x.x.8: lda A.word.type ani wtp.cnst jnz p.AOX.c.x.8 ; lda B.word.type ani wtp.cnst jnz p.AOX.x.c.8 ; call switch.B db stet.BYTE ! dw p.AOX.x.8.8 db stet.WORD ! dw p.AOX.x.16.8 db stet.spcl.byte.ptr ! dw p.AOX.x.8.8 db stet.spcl.word.ptr ! dw p.AOX.x.16.8 db 0 ! dw p.AOX.B8.err ; ; p.AOX.B8.err: call err.inv.var.type p.AOX.x.16.8: call err.truncate p.AOX.x.8.8: call put.get.B.into.A ; call switch.A db stet.BYTE ! dw p.AOX.8.8.8 db stet.WORD ! dw p.AOX.16.8.8 db stet.spcl.byte.ptr ! dw p.AOX.BP.8.8 db stet.spcl.word.ptr ! dw p.AOX.WP.8.8 db 0 ! dw p.AOX.A8.err ; ; p.AOX.A8.err: call err.inv.var.type p.AOX.16.8.8: call err.truncate p.AOX.8.8.8: call put.LXI.H.A jmp p.AOX.8.go ; p.AOX.WP.8.8: call err.truncate p.AOX.BP.8.8: call put.LHLD.A p.AOX.8.go: lda and.or.xor.type cpi rwix.AND jz p.AOX.8.AND cpi rwix.OR jz p.AOX.8.OR ; call put.XRA.M jmp p.AOX.8.cont ; p.AOX.8.AND: call put.ANA.M jmp p.AOX.8.cont ; p.AOX.8.OR: call put.ORA.M p.AOX.8.cont: lxi h,sym.tbl.entry.A lxi d,sym.tbl.entry.B call compare.sym.tbl.entries jz put.MOV.M.A jmp put.store.A.at.C ; ; p.AOX.x.c.8: call swap.A.B.sym.entries ; p.AOX.c.x.8: lda B.word.type ani wtp.cnst jnz p.AOX.c.c.8 ; call switch.B db stet.BYTE ! dw p.AOX.c.8.8 db stet.WORD ! dw p.AOX.c.16.8 db stet.spcl.byte.ptr ! dw p.AOX.c.8.8 db stet.spcl.word.ptr ! dw p.AOX.c.16.8 db 0 ! dw p.AOX.cnst.err ; ; p.AOX.cnst.err: call err.inv.var.type p.AOX.c.c.8: ; lda ste.A.address mov b,a lxi h,ste.B.address ; lda and.or.xor.type cpi rwix.AND jz p.AOX.c.c.AND cpi rwix.OR jz p.AOX.c.c.OR ; mov a,b xra m jmp p.AOX.c.c.cont ; p.AOX.c.c.AND: mov a,b ana m jmp p.AOX.c.c.cont ; p.AOX.c.c.OR: mov a,b ora m p.AOX.c.c.cont: mov l,a call put.MVI.A.L jmp put.store.A.at.C ; ; ; ; ; p.AOX.c.16.8: call err.truncate p.AOX.c.8.8: call put.get.B.into.A lhld ste.A.address lda and.or.xor.type cpi rwix.AND jz p.AOX.A.c.AND cpi rwix.OR jz p.AOX.A.c.OR ; call put.XRI.L jmp put.store.A.at.C ; p.AOX.A.c.AND: call put.ANI.L jmp put.store.A.at.C ; p.AOX.A.c.OR: call put.ORI.L jmp put.store.A.at.C ; ; p.AOX.16: lda A.word.type lxi h,B.word.type ana m ani wtp.cnst jnz p.AOX.16.c.c ; call put.get.A.into.HL call put.XCHG call put.get.B.into.HL ; lda and.or.xor.type cpi rwix.AND jz p.AOX.AND cpi rwix.OR jz p.AOX.OR ; call put.bir.xor.16 jmp put.store.HL.at.C ; p.AOX.AND: call put.bir.and.16 jmp put.store.HL.at.C ; p.AOX.OR: call put.bir.or.16 jmp put.store.HL.at.C ; ; ; p.AOX.16.c.c: lhld ste.A.address xchg lhld ste.B.address lda and.or.xor.type cpi rwix.AND jz p.AOX.16.c.c.AND cpi rwix.OR jz p.AOX.16.c.c.OR ; call XOR.d.and.h jmp p.AOX.16.c.c.cont ; p.AOX.16.c.c.AND: call AND.d.and.h jmp p.AOX.16.c.c.cont ; p.AOX.16.c.c.OR: call OR.d.and.h p.AOX.16.c.c.cont: call put.LXI.H.hl jmp put.store.HL.at.C ; ; ; ; ;------------------------------------------------------ ; ; process.APPEND: call chk.strt.code call get.word call get.var.A.word ; lda A.word.type ani wtp.string cnz put.inline.A.string ; call switch.A db stet.STRING ! dw p.APPEND.A.ok db stet.spcl.string.ptr ! dw p.APPEND.A.ok db 0 ! dw p.APPEND.A.err p.APPEND.A.err: call err.inv.var.type p.APPEND.A.ok: lda rsvd.wd.ix cpi rwix.TO cz get.word ; call chk.word.id.only call get.var.B.word call switch.B db stet.STRING ! dw p.APPEND.B.str db stet.spcl.string.ptr ! dw p.APPEND.B.SP db 0 ! dw p.APPEND.B.err ; p.APPEND.B.SP: call put.LHLD.B call put.XCHG jmp p.APPEND.go ; p.APPEND.B.err: call err.inv.var.type p.APPEND.B.str: call put.LXI.D.B p.APPEND.go: lda ste.A.type cpi stet.spcl.string.ptr jz p.APPEND.go.SP call put.LXI.H.A jmp p.APPEND.go.bir p.APPEND.go.SP: call put.LHLD.A p.APPEND.go.bir: jmp put.bir.APPEND ; ; ; ; ;------------------------------------------------------ ; ; process.BCD: call set.byte.boundary call chk.strt.data call get.word ; call switch.rsvd.wd.ix db rwix.POINTER ! dw p.POINTER.BCD db rwix.VALUE ! dw p.BCD.VALUE db rwix.comma ! dw p.BCD.no.VALUE db rwix.semicolon ! dw p.BCD.no.VALUE db 0 ! dw p.BCD.id ; p.BCD.id: call chk.word.id.only call chk.word.not.in.tbl mvi a,stet.BCD sta ste.type lda curr.bit.posn sta ste.bit.posn lxi h,bcd.size shld ste.length call put.word.into.tbl ; call get.word lda rsvd.wd.ix cpi rwix.VALUE jz p.BCD.VALUE ; p.BCD.no.VALUE: lhld curr.code.addr lxi d,bcd.size dad d shld curr.code.addr jmp p.BCD.comma ; p.BCD.VALUE: call get.word lda word cpi '0' jc p.BCD.inv.value cpi '9'+1 jnc p.BCD.inv.value ; lxi h,word lxi d,BCD.cnst.value.wk call cvt.str.2.bcd ; lxi h,BCD.cnst.value.wk lxi b,BCD.size call put.code.block ; call get.word jmp p.BCD.comma ; p.BCD.inv.value: call err.inv.value call get.word jmp p.BCD.no.VALUE ; p.BCD.comma: lda rsvd.wd.ix cpi rwix.comma jz process.BCD ret ; ;------------------------------------------------------ ; ; process.BEGIN: call chk.strt.code xra a sta code.started.this.blk sta data.started.this.blk call bump.block.level lhld curr.src.line.num push h call get.word p.BEGIN.lup: lda rsvd.wd.ix cpi rwix.END jz p.BEGIN.exitloop ; call chk.not.blk.ender jnz p.BEGIN.stmt ; call err.missing.END jmp p.BEGIN.err.exitloop ; p.BEGIN.stmt: call process.a.statement jmp p.BEGIN.lup ; p.BEGIN.exitloop: call debug.routine pop h shld curr.block.match call chk.strt.code ;for print address call get.word jmp p.BEGIN.got.mtch p.BEGIN.err.exitloop: pop h shld curr.block.match p.BEGIN.got.mtch: call chk.strt.code ;in case no code ; mvi a,bir.EXITBEGIN call fix.up.built.in.rtn ; mvi a,0ffh sta code.started.this.blk call decr.block.level jmp squish.sym.tbl ; ;------------------------------------------------------ ; ; process.BIT: call chk.strt.data call get.word call switch.rsvd.wd.ix db rwix.VALUE ! dw p.BIT.VALUE db rwix.comma ! dw p.BIT.FALSE db 0 ! dw p.BIT.id ; p.BIT.id: call chk.word.id.only call chk.word.not.in.tbl mvi a,stet.BIT sta ste.type lda curr.bit.posn sta ste.BIT.posn lxi h,0 shld ste.length call put.word.into.tbl ; call get.word lda rsvd.wd.ix cpi rwix.VALUE jnz p.BIT.not.VALUE p.BIT.VALUE: call get.word lda word.type ani wtp.cnst jz p.BIT.not.cnst lda cnst.value ani 01h jz p.BIT.FALSE jmp p.BIT.TRUE p.BIT.not.cnst: lda word.type ani wtp.ident jnz p.BIT.VALUE.ident ; p.BIT.inv.VALUE: call err.inv.VALUE call get.word jmp p.BIT.not.VALUE ; p.BIT.VALUE.ident: lda rsvd.wd.ix cpi rwix.FALSE jz p.BIT.FALSE cpi rwix.TRUE jnz p.BIT.inv.VALUE p.BIT.TRUE: lda curr.BIT.posn lxi h,curr.BIT.build ora m mov m,a call get.word jmp p.BIT.not.VALUE p.BIT.FALSE: lda curr.bit.posn cma lxi h,curr.bit.build ana m mov m,a call get.word p.BIT.not.VALUE: lda curr.BIT.posn rrc sta curr.BIT.posn cpi 80h jnz p.BIT.comma lda curr.BIT.build call put.code.byte ;---init for next bit lhld curr.code.addr mvi h,0 mov a,l ani 7fh mov l,a lxi d,code.buffer dad d mov a,m sta curr.bit.build p.BIT.comma: lda rsvd.wd.ix cpi rwix.comma jz process.BIT ret ; ;------------------------------------------------------ ; ; process.BYTE: call set.byte.boundary call chk.strt.data call get.word ; call switch.rsvd.wd.ix db rwix.POINTER ! dw p.POINTER.BYTE db rwix.VALUE ! dw p.BYTE.VALUE db rwix.comma ! dw p.BYTE.no.VALUE db rwix.semicolon ! dw p.BYTE.no.VALUE db 0 ! dw p.BYTE.id p.BYTE.id: call chk.word.id.only call chk.word.not.in.tbl mvi a,stet.BYTE sta ste.type lda curr.BIT.posn sta ste.BIT.posn lxi h,1 shld ste.length call put.word.into.tbl ; call get.word lda rsvd.wd.ix cpi rwix.VALUE jz p.BYTE.VALUE ; p.BYTE.no.VALUE: lhld curr.code.addr inx h shld curr.code.addr jmp p.BYTE.comma ; p.BYTE.VALUE: call get.word lda word.type ani wtp.cnst jnz p.BYTE.cnst ; call err.inv.VALUE lhld curr.code.addr inx h shld curr.code.addr call get.word jmp p.BYTE.comma p.BYTE.cnst: lda cnst.value call put.code.byte call get.word p.BYTE.comma: lda rsvd.wd.ix cpi rwix.comma jz process.BYTE ret ; ;------------------------------------------------------ ; ; process.CALL: call chk.strt.code call get.word lda word.type ani wtp.cnst jz p.CALL.label ; call put.CALL lhld cnst.value call put.code.word jmp get.word ; p.CALL.label: call chk.word.id.only call get.var.sym.tbl.entry lda ste.type cpi stet.end.tbl jz p.CALL.fwd.ref ; ;---don't allow a call from one overlay to another that overlays it.--- ;---There would be nothing to return to upon completion of the call.--- ; lhld ste.ovl.key mov a,h ana l inr a jz p.CALL.normal ; ;--this statement must be in global to call an overlay lda overlay.in.process ora a jz p.CALL.from.global ;--it is allowed to call within an overlay xchg lhld curr.ovl.start.key xchg call cmp.de.fm.hl jz p.CALL.normal ;--it is allowed to call an overlay in a different memory area-- lhld ste.address xchg lhld start.code.addr call cmp.de.fm.hl jnz p.CALL.from.global ;act like global call ; call err.ovl.call.ovl ;same memory area -- no good ; p.CAll.from.global: lhld ste.ovl.key call put.LXI.H.hl lhld ste.address call put.LXI.D.hl lhld ste.length call put.LXI.B.hl ; mvi a,bir.overlay.load call put.bir.call.fwd jmp get.word ; p.CALL.fwd.ref: call put.CALL call put.fwd.ref.addr jmp get.word ; p.CALL.normal: call put.CALL lhld ste.address call put.code.word jmp get.word ; ;------------------------------------------------------ ; ; process.CLOSE: call chk.strt.code call get.word call chk.word.id.only call get.var.A.word lda ste.A.type cpi stet.FILE cnz err.undef.file.name ; lda ste.A.FILE.device cpi rwix.DISK jnz p.CLOSE.chk.comma ; lda rsvd.wd.ix cpi rwix.PARTIAL jnz p.CLOSE.not.PARTIAL call get.word ;---don't check MPM flag since close-routine needs ;---this bit to not mark file closed. lhld ste.A.address lxi d,5 dad d call put.LXI.H.hl call put.MOV.A.M mvi l,80h call put.ORI.L call put.MOV.M.A p.CLOSE.not.PARTIAL: ; call put.LXI.D.A lda ste.A.file.misc.flag ani FILE.c.flag.text jz p.CLOSE.not.text mvi a,bir.dsk.ch.close call put.bir.call.fwd p.CLOSE.not.text: ; call put.MVI.C lda rsvd.wd.ix cpi rwix.REMOVE jnz p.CLOSE.not.REMOVE call get.word mvi a,19 ;delete file jmp p.CLOSE.do.it p.CLOSE.not.REMOVE: mvi a,16 ;close file p.CLOSE.do.it: call put.code.byte mvi a,bir.close.disk call put.bir.call.fwd ; lda rsvd.wd.ix cpi rwix.ERROR jnz p.CLOSE.chk.comma ; call put.INR.A call get.word lda rsvd.wd.ix cpi rwix.STANDARD jz p.CLOSE.err.STANDARD ; call put.JNZ mvi a,bir.CLOSE.fwd call put.fwd.ref.bir ; call process.a.statement ; mvi a,bir.CLOSE.fwd call fix.up.built.in.rtn jmp p.CLOSE.chk.comma ; p.CLOSE.err.STANDARD: call put.CZ mvi a,bir.close.error call put.fwd.ref.bir call get.word ; p.CLOSE.chk.comma: lda rsvd.wd.ix cpi rwix.comma jz process.CLOSE ret ; ; ;------------------------------------------------------ ; ; process.COMMENT: lda src.char cpi 0dh jz p.COMMENT.end cpi 1ah jz p.COMMENT.end call get.src.char jmp process.COMMENT ; p.COMMENT.end: call get.src.char jmp get.word ; ;------------------------------------------------------ ; ; process.CONVERT: call chk.strt.code call get.word call switch.rsvd.wd.ix db rwix.DEC ! dw p.CONVERT.dec.bin db rwix.DECIMAL ! dw p.CONVERT.dec.bin db rwix.HEX ! dw p.CONVERT.hex.bin db rwix.HEXADECIMAL ! dw p.CONVERT.hex.bin db rwix.OCT ! dw p.CONVERT.oct.bin db rwix.OCTAL ! dw p.CONVERT.oct.bin db 0 ! dw p.CONVERT.str.x ; p.CONVERT.str.x: call chk.word.id.only call get.var.A.word call switch.A db stet.BCD ! dw p.CONVERT.A.BCD db stet.spcl.BCD.ptr ! dw p.CONVERT.A.BCD db stet.STRING ! dw p.CONVERT.A.SP db stet.spcl.string.ptr ! dw p.CONVERT.A.SP db 0 ! dw p.CONVERT.bin.x ; p.CONVERT.A.SP: lda rsvd.wd.ix cpi rwix.TO cz get.word call switch.rsvd.wd.ix db rwix.UPPER ! dw p.CONVERT.UPPER db rwix.LOWER ! dw p.CONVERT.LOWER db 0 ! dw p.CONVERT.unspec ; p.CONVERT.unspec: call chk.word.id.only call get.var.B.word call switch.B db stet.BCD ! dw p.CONVERT.str.BCD db stet.spcl.BCD.ptr ! dw p.CONVERT.str.BCDP db 0 ! dw p.CONVERT.str.bin ; p.CONVERT.str.bin: call p.CONVERT.x.bin.entry mvi a,bir.cvt.dec.bin call put.bir.call.fwd jmp put.store.HL.at.B ; p.CONVERT.UPPER: call put.LXI.H.A mvi a,bir.cvt.upper.case jmp p.CONVERT.up.lo.cont ; p.CONVERT.LOWER: call put.LXI.H.A mvi a,bir.cvt.lower.case p.CONVERT.up.lo.cont: call put.bir.call.fwd call get.word lda rsvd.wd.ix cpi rwix.CASE cz get.word ret ; p.CONVERT.A.BCD: lda rsvd.wd.ix cpi rwix.TO cz get.word lda rsvd.wd.ix cpi rwix.DEC cz get.word lda rsvd.wd.ix cpi rwix.DECIMAL cz get.word call chk.word.id.only call get.var.B.word call switch.B db stet.BYTE ! dw p.CONVERT.BCD.bin db stet.WORD ! dw p.CONVERT.BCD.bin db stet.spcl.byte.ptr ! dw p.CONVERT.BCD.bin db stet.spcl.word.ptr ! dw p.CONVERT.BCD.bin db stet.STRING ! dw p.CONVERT.BCD.str db stet.spcl.string.ptr ! dw p.CONVERT.BCD.str.ptr db 0 ! dw p.CONVERT.BCD.err ; p.CONVERT.BCD.str.ptr: call put.LHLD.B call put.XCHG jmp p.CONVERT.BCD.str.cont ; p.CONVERT.BCD.STR: call put.LXI.D.B p.CONVERT.BCD.str.cont: lda ste.A.type cpi stet.BCD jz p.CONVERT.BCD.s.A.bcd call put.LHLD.A jmp p.CONVERT.BCD.s.A.cont p.CONVERT.BCD.s.A.bcd: call put.LXI.H.A p.CONVERT.BCD.s.A.cont: mvi a,bir.cvt.bcd.str jmp put.bir.call.fwd ; ; ; p.CONVERT.BCD.err: call err.inv.var.type p.CONVERT.BCD.bin: lda ste.A.type cpi stet.BCD jz p.CONVERT.BCD.b.A.bcd call put.LHLD.A jmp p.CONVERT.BCD.b.A.cont p.CONVERT.BCD.b.A.bcd: call put.LXI.H.A p.CONVERT.BCD.b.A.cont: mvi a,bir.cvt.bcd.bin call put.bir.call.fwd jmp put.store.HL.at.B ; ; ; p.CONVERT.str.BCD: call put.LXI.D.B jmp p.CONVERT.str.BCD.cont p.CONVERT.str.BCDP: call put.LHLD.B call put.XCHG p.CONVERT.str.BCD.cont: lda ste.A.type cpi stet.spcl.string.ptr jz p.CONVERT.SP.BCD call put.LXI.H.A jmp p.CONVERT.str.BCD.more p.CONVERT.SP.BCD: call put.LHLD.A p.CONVERT.str.BCD.more: mvi a,bir.cvt.str.bcd jmp put.bir.call.fwd ; ; ; p.CONVERT.hex.bin: call p.CONVERT.x.bin.prefix mvi a,bir.cvt.hex.bin jmp p.CONVERT.x.bin.post ; p.CONVERT.dec.bin: call p.CONVERT.x.bin.prefix mvi a,bir.cvt.dec.bin jmp p.CONVERT.x.bin.post ; p.CONVERT.oct.bin: call p.CONVERT.x.bin.prefix mvi a,bir.cvt.oct.bin jmp p.CONVERT.x.bin.post ; p.CONVERT.x.bin.prefix: call get.word call chk.word.id.only call get.var.A.word p.CONVERT.x.bin.entry: lda ste.A.type cpi stet.STRING jz p.CONVERT.str.prefix cpi stet.spcl.string.ptr jz p.CONVERT.SP.prefix jmp err.inv.var.type ; p.CONVERT.str.prefix: jmp put.LXI.H.A ; p.CONVERT.SP.prefix: jmp put.LHLD.A ; ; p.CONVERT.x.bin.post: call put.bir.call.fwd lda rsvd.wd.ix cpi rwix.TO cz get.word call chk.word.id.only call get.var.B.word jmp put.store.HL.at.B ; ; ; p.CONVERT.bin.x: lda rsvd.wd.ix cpi rwix.TO cz get.word ; call switch.rsvd.wd.ix db rwix.DEC ! dw p.CONVERT.bin.dec db rwix.DECIMAL ! dw p.CONVERT.bin.dec db rwix.HEX ! dw p.CONVERT.bin.hex db rwix.HEXADECIMAL ! dw p.CONVERT.bin.hex db rwix.OCT ! dw p.CONVERT.bin.oct db rwix.OCTAL ! dw p.CONVERT.bin.oct db 0 ! dw p.CONVERT.bin.not.str ; p.CONVERT.bin.not.str: call chk.word.id.only call get.var.B.word call switch.B db stet.BCD ! dw p.CONVERT.bin.BCD db stet.spcl.BCD.ptr ! dw p.CONVERT.bin.BCDP db 0 ! dw p.CONVERT.bin.unspec ; p.CONVERT.bin.unspec: mvi a,bir.cvt.bin.dec sta curr.cvt.type jmp p.CONVERT.bin.x.entry ; p.CONVERT.bin.BCD: call put.LXI.D.B jmp p.CONVERT.bin.BCD.cont ; p.CONVERT.bin.BCDP: call put.LHLD.B call put.XCHG p.CONVERT.bin.BCD.cont: call put.get.A.into.HL mvi a,bir.cvt.bin.bcd jmp put.bir.call.fwd ; p.CONVERT.bin.dec: mvi a,bir.cvt.bin.dec jmp p.CONVERT.bin.x.post ; p.CONVERT.bin.hex: mvi a,bir.cvt.bin.hex jmp p.CONVERT.bin.x.post ; p.CONVERT.bin.oct: mvi a,bir.cvt.bin.oct ; p.CONVERT.bin.x.post: sta curr.cvt.type call get.word call chk.word.id.only call get.var.B.word p.CONVERT.bin.x.entry: call switch.B db stet.STRING ! dw p.CONVERT.bin.str db stet.spcl.string.ptr ! dw p.CONVERT.bin.SP db 0 ! dw p.CONVERT.bin.err p.CONVERT.bin.err: call err.inv.var.type p.CONVERT.bin.str: call put.get.A.into.HL call put.LXI.D.B jmp p.CONVERT.bin.x.cont ; p.CONVERT.bin.SP: call put.LHLD.B call put.XCHG call put.get.A.into.HL ; p.CONVERT.bin.x.cont: lda curr.cvt.type jmp put.bir.call.fwd ; ; ;------------------------------------------------------ ; ; process.COPY: call get.word call get.var.A.word lda A.word.type ani wtp.string jz err.unexpect.word ; lxi h,copy.nest.count mov a,m cpi copy.nest.limit jnc err.nested.copy ; inr m ; lxi h,src.in + copy.move.size lxi d,copy.swap.area + copy.move.size lxi b,copy.move.size call move.bkwds.h.2.d.cnt.b ; lxi h,1 ;new line # for libr shld curr.src.line.num ; lxi h,ste.A.name ; p.COPY.try.open: lxi d,src.in call format.file.name ; call set.up.src.fcb lxi h,src.in + 6 ;R/O mode for MP/M mov a,m ori 80h mov m,a lxi d,src.in mvi c,15 ;open call entry inr a jnz p.COPY.opened ; lxi h,src.in + 1 lxi d,p.COPY.dsk.name lxi b,11 call move.h.2.d.cnt.b ; lxi d,p.COPY.dsk.msg mvi c,9 ;display call entry ; lxi H,word mvi c,20 call ACCEPT.from.console ; lxi h,word jmp p.COPY.try.open ; ; p.COPY.opened: call get.src.char jmp get.word ; ; p.COPY.dsk.msg: db 'Can''t find COPY file - ' p.COPY.dsk.name: ds 12 db '. Please enter file-name:$' ; ; ; ;------------------------------------------------------ ; ; process.DISABLE: call chk.strt.code call get.word lda rsvd.wd.ix cpi rwix.INTERRUPTS cz get.word jmp put.DI ; ; ;------------------------------------------------------ ; ; process.DISPLAY: call chk.strt.code call get.word lda rsvd.wd.ix cpi rwix.semicolon rz call get.var.A.word lda A.word.type ani wtp.string jz p.DISPLAY.var ; call put.inline.A.string ; p.DISPLAY.var: call switch.A db stet.STRING ! dw p.DISPLAY.str db stet.spcl.string.ptr ! dw p.DISPLAY.SP db stet.RECORD ! dw p.DISPLAY.str db 0 ! dw p.DISPLAY.err p.DISPLAY.err: call err.inv.var.type p.DISPLAY.str: call put.LXI.H.A jmp p.DISPLAY.call ; p.DISPLAY.SP: call put.LHLD.A p.DISPLAY.call: mvi a,bir.DISPLAY call put.bir.call.fwd ; lda rsvd.wd.ix cpi rwix.comma jz process.DISPLAY mvi a,bir.DISPLAY.crlf jmp put.bir.call.fwd ; ; ; ;------------------------------------------------------ ; ; process.DIVIDE: call chk.strt.code call get.word call get.var.A.word lda A.word.type ani wtp.cnst jnz p.DIVIDE.A call switch.A db stet.BYTE ! dw p.DIVIDE.A db stet.WORD ! dw p.DIVIDE.A db stet.spcl.byte.ptr ! dw p.DIVIDE.A db stet.spcl.word.ptr ! dw p.DIVIDE.A db stet.BCD ! dw p.DIVIDE.BCD db stet.spcl.BCD.ptr ! dw p.DIVIDE.BCD db 0 ! dw p.DIVIDE.A.err ; p.DIVIDE.A.err: call err.inv.numeric.var p.DIVIDE.A: lda rsvd.wd.ix cpi rwix.BY jnz err.mssng.rsvd.wd call get.word ; call get.var.B.word lda rsvd.wd.ix cpi rwix.GIVING jz p.DIVIDE.3 ; ;---2-address divide--- ; lxi h,sym.tbl.entry.A lxi d,sym.tbl.entry.C call move.sym.tbl.entry lda A.word.type sta C.word.type jmp p.DIVIDE.ok ; p.DIVIDE.3: call get.word call chk.word.id.only call get.var.C.word lda ste.C.type cpi stet.BYTE jz p.DIVIDE.ok cpi stet.WORD cnz err.inv.numeric.var p.DIVIDE.ok: ; lda A.word.type ani wtp.cnst jnz p.DIVIDE.A.cnst call switch.A db stet.BYTE ! dw p.DIVIDE.A.BYTE db stet.WORD ! dw p.DIVIDE.A.WORD db stet.spcl.byte.ptr ! dw p.DIVIDE.A.BP db stet.spcl.word.ptr ! dw p.DIVIDE.A.WP db 0 ! dw p.DIVIDE.A.c.err ; p.DIVIDE.A.c.err: call err.inv.numeric.var p.DIVIDE.A.cnst: lda B.word.type ani wtp.cnst jnz p.DIVIDE.cnst.cnst ; call switch.A db stet.BCD ! dw p.DIVIDE.cnst.BCD db stet.spcl.BCD.ptr ! dw p.DIVIDE.cnst.BCD db 0 ! dw p.DIVIDE.A.really.cnst ; p.DIVIDE.A.really.cnst: call put.LXI.D.A jmp p.DIVIDE.A.done ; p.DIVIDE.cnst.cnst: lhld ste.A.address xchg lhld ste.B.address call div.d.by.h.2.d.r.h push d call put.LXI.H.hl pop h call put.LXI.D.hl jmp p.DIVIDE.result ; p.DIVIDE.A.BYTE: p.DIVIDE.A.WORD: call put.get.A.into.HL call put.XCHG jmp p.DIVIDE.A.done ; p.DIVIDE.A.BP: call put.LHLD.A call put.mv.@HLB.to.DE jmp p.DIVIDE.A.done ; p.DIVIDE.A.WP: call put.LHLD.A call put.mv.@HL.to.DE p.DIVIDE.A.done: lda B.word.type ani wtp.cnst jz p.DIVIDE.not.spcl call put.LXI.H.B jmp p.DIVIDE.B.done ; p.DIVIDE.not.spcl: call put.get.B.into.HL p.DIVIDE.B.done: call put.div.16 ; p.DIVIDE.result: lda rsvd.wd.ix cpi rwix.REMAINDER jnz p.DIVIDE.no.rmdr call get.word call chk.word.id.only call get.var.B.word call switch.B db stet.BYTE ! dw p.DIVIDE.rmdr.BYTE db stet.WORD ! dw p.DIVIDE.rmdr.WORD db stet.spcl.byte.ptr ! dw p.DIVIDE.rmdr.BP db stet.spcl.word.ptr ! dw p.DIVIDE.rmdr.WP db 0 ! dw p.DIVIDE.rmdr.err ; p.DIVIDE.rmdr.err: call err.inv.numeric.var p.DIVIDE.rmdr.BP: call err.truncate call put.MOV.A.L call put.LHLD.B call put.MOV.M.A jmp p.DIVIDE.no.rmdr ; p.DIVIDE.rmdr.WP: call put.mv.HL.to.BC call put.LHLD.B call put.MOV.M.C call put.INX.H call put.MOV.M.B jmp p.DIVIDE.no.rmdr ; p.DIVIDE.rmdr.WORD: call put.SHLD.B jmp p.DIVIDE.no.rmdr p.DIVIDE.rmdr.BYTE: call err.truncate call put.MOV.A.L call put.STA.B p.DIVIDE.no.rmdr: call switch.C db stet.BYTE ! dw p.DIVIDE.rslt.BYTE db stet.WORD ! dw p.DIVIDE.rslt.WORD db stet.spcl.byte.ptr ! dw p.DIVIDE.rslt.BP db stet.spcl.word.ptr ! dw p.DIVIDE.rslt.WP db 0 ! dw p.DIVIDE.rslt.err ; p.DIVIDE.rslt.err: call err.inv.numeric.var p.DIVIDE.rslt.BP: call err.truncate call put.LHLD.C jmp put.MOV.M.E ; p.DIVIDE.rslt.WP: call put.LHLD.C jmp put.mv.DE.to.@HL ; p.DIVIDE.rslt.WORD: call put.XCHG jmp put.SHLD.C ; p.DIVIDE.rslt.BYTE: call err.truncate call put.MOV.A.E jmp put.STA.C ; ; ; p.DIVIDE.BCD: lda rsvd.wd.ix cpi rwix.BY jnz err.mssng.rsvd.wd call get.word call get.var.B.word ; lda B.word.type ani wtp.cnst jnz p.DIVIDE.BCD.cnst call switch.B db stet.BCD ! dw p.DIVIDE.BCD.B.ok db stet.spcl.BCD.ptr ! dw p.DIVIDE.BCD.B.ok db 0 ! dw p.DIVIDE.BCD.B.err p.DIVIDE.BCD.B.err: call err.inv.var.type p.DIVIDE.BCD.B.ok: lda rsvd.wd.ix cpi rwix.GIVING jz p.DIVIDE.BCD.3 ;---2-address BCD divide--- lxi h,sym.tbl.entry.A lxi d,sym.tbl.entry.C call move.sym.tbl.entry lda A.word.type sta C.word.type jmp p.DIVIDE.BCD.C.ok ; p.DIVIDE.BCD.3: call get.word call chk.word.id.only call get.var.C.word p.DIVIDE.BCD.C.ok: lda ste.C.type cpi stet.BCD jz p.DIVIDE.BCD.C cpi stet.spcl.bcd.ptr cnz err.inv.var.type ; call put.LHLD.C call put.mv.HL.to.BC jmp p.DIVIDE.BCD.A ; p.DIVIDE.BCD.C: call put.LXI.B.C p.DIVIDE.BCD.A: lda ste.A.type cpi stet.spcl.bcd.ptr jz p.DIVIDE.BCD.A.ptr ; call put.LXI.D.A jmp p.DIVIDE.BCD.B ; p.DIVIDE.BCD.A.ptr: call put.LHLD.A call put.XCHG p.DIVIDE.BCD.B: lda ste.B.type cpi stet.spcl.bcd.ptr jz p.DIVIDE.BCD.B.ptr ; call put.LXI.H.B jmp p.DIVIDE.BCD.call ; p.DIVIDE.BCD.B.ptr: call put.LHLD.B p.DIVIDE.BCD.call: mvi a,bir.BCD.divide call put.bir.call.fwd ; lda rsvd.wd.ix cpi rwix.REMAINDER jnz p.DIVIDE.BCD.no.rmdr ; call get.word call chk.word.id.only call get.var.B.word lda ste.B.type cpi stet.BCD jz p.DIVIDE.BCD.rmdr cpi stet.spcl.bcd.ptr cnz err.inv.var.type ; call put.LHLD.B call put.XCHG jmp p.DIVIDE.BCD.R.cont ; p.DIVIDE.BCD.rmdr: call put.LXI.D.B p.DIVIDE.BCD.R.cont: mvi a,bir.dividend call put.LXI.H.fwd lxi h,bcd.size - 2 call put.LXI.B.hl call put.DAD.B call put.bir.move.bcd call get.word p.DIVIDE.BCD.no.rmdr: ret ; ; p.DIVIDE.cnst.BCD: lxi h,sym.tbl.entry.A call put.inline.BCD jmp p.DIVIDE.BCD.C.ok ; ; p.DIVIDE.BCD.cnst: lxi h,sym.tbl.entry.B call put.inline.BCD jmp p.DIVIDE.BCD.B.ok ; ;------------------------------------------------------ ; ; process.DO: call chk.strt.code call bump.block.level lhld curr.code.addr push h ; lhld curr.src.line.num push h call get.word p.DO.lup: mvi a,bir.WHILE.TRUE call fix.up.built.in.rtn p.DO.stmt.lup: call switch.rsvd.wd.ix db rwix.OD ! dw p.DO.OD db rwix.UNTIL ! dw p.DO.UNTIL db 0 ! dw p.DO.chk.unmatch ; p.DO.chk.unmatch: call chk.not.blk.ender jnz p.DO.stmt call err.missing.OD jmp p.DO.OD.err ; p.DO.stmt: call process.a.statement jmp p.DO.stmt.lup ; p.DO.OD: call debug.routine pop h shld curr.block.match call get.word jmp p.DO.OD.got.mtch ; p.DO.OD.err: pop h shld curr.block.match p.DO.OD.got.mtch: lda rsvd.wd.ix cpi rwix.UNTIL jz p.DO.UNTIL.got.mtch call put.JMP pop h call put.code.word ; ;---clean-up any exitloop references--- ; p.DO.fix.up: mvi a,bir.WHILE.TRUE call fix.up.built.in.rtn mvi a,bir.EXITDO call fix.up.built.in.rtn call decr.block.level jmp squish.sym.tbl ; p.DO.UNTIL: call debug.routine pop h shld curr.block.match p.DO.UNTIL.got.mtch: call get.word ; mvi a,bir.UNTIL.FALSE sta curr.fwd.no.fall.thru mvi a,0ffh sta fall.thru.true sta no.fall.thru.fwd.flag call process.expression ; p.DO.UNTIL.compound: call switch.rsvd.wd.ix db rwix.AND ! dw p.DO.UNTIL.got.mtch db rwix.OR ! dw p.DO.OR db rwix.COMMENT ! dw p.DO.UNTIL.COMMENT db 0 ! dw p.DO.UNTIL.expr.end ; p.DO.UNTIL.COMMENT: call process.COMMENT jmp p.DO.UNTIL.compound ; p.DO.UNTIL.expr.end: lhld curr.code.addr xthl ;hl <- start loop shld curr.code.addr mvi a,bir.UNTIL.FALSE call fix.up.built.in.rtn pop h shld curr.code.addr ; jmp p.DO.fix.up ; ; p.DO.OR: mvi a,bir.EXITDO call put.bir.jmp.fwd mvi a,bir.UNTIL.FALSE call fix.up.built.in.rtn jmp p.DO.UNTIL.got.mtch ; ; ;------------------------------------------------------ ; ; process.EDIT: call chk.strt.code call get.word call get.var.A.word lda A.word.type ani wtp.string cnz put.inline.A.string ; lda ste.A.type cpi stet.string jz p.EDIT.A.ok cpi stet.spcl.string.ptr cnz err.inv.var.type p.EDIT.A.ok: lda rsvd.wd.ix cpi rwix.WITH cz get.word call get.var.B.word lda B.word.type ani wtp.string cnz put.inline.B.string ; lda ste.B.type cpi stet.string jz p.EDIT.B.ok cpi stet.spcl.string.ptr cnz err.inv.var.type p.EDIT.B.ok: lda rsvd.wd.ix cpi rwix.GIVING jnz p.EDIT.2 ; call get.word call chk.word.id.only call get.var.C.word jmp p.EDIT.go ; p.EDIT.2: lxi h,sym.tbl.entry.A lxi d,sym.tbl.entry.C call move.sym.tbl.entry p.EDIT.go: lda ste.C.type cpi stet.STRING jz p.EDIT.C.STR cpi stet.spcl.string.ptr cnz err.inv.var.type ; call put.LHLD.C call put.XCHG jmp p.EDIT.B ; p.EDIT.C.str: call put.LXI.D.C p.EDIT.B: lda ste.B.type cpi stet.STRING jz p.EDIT.B.str cpi stet.spcl.string.ptr cnz err.inv.var.type ; call put.LHLD.B call put.mv.HL.to.BC jmp p.EDIT.A ; p.EDIT.B.str: call put.LXI.B.B p.EDIT.A: lda ste.A.type cpi stet.STRING jz p.EDIT.A.str cpi stet.spcl.string.ptr jnz err.inv.var.type ; call put.LHLD.A jmp p.EDIT.call ; p.EDIT.A.str: call put.LXI.H.A p.EDIT.call: mvi a,bir.EDIT.STRING jmp put.bir.call.fwd ; ;------------------------------------------------------ ; ; process.ENABLE: call chk.strt.code call get.word lda rsvd.wd.ix cpi rwix.INTERRUPTS cz get.word jmp put.EI ; ; ;------------------------------------------------------ ; ; process.EXCHANGE: call chk.strt.code call get.word call get.var.A.word lda rsvd.wd.ix cpi rwix.WITH cz get.word call get.var.B.word lda rsvd.wd.ix cpi rwix.LENGTH jnz p.EXCHANGE.no.LENGTH ; call get.word call get.var.C.word lda C.word.type ani wtp.cnst jnz p.EXCHANGE.C.cnst ; call put.get.C.into.HL call put.MOV.B.H call put.MOV.C.L jmp p.EXCHANGE.got.length ; p.EXCHANGE.C.cnst: call put.LXI.B.C jmp p.EXCHANGE.got.length ; p.EXCHANGE.no.LENGTH: lhld ste.A.length xchg lhld ste.B.length call cmp.de.fm.hl jc p.EXCHANGE.A.gtr xchg p.EXCHANGE.A.gtr: call cmp.de.fm.hl push h cnz err.truncate pop h mov a,h ora a jnz p.EXCHANGE.block mov a,l dcr a jnz p.EXCHANGE.block ;--byte exchange--- call p.EXCHANGE.prefix call put.MOV.B.M call put.LDAX.D call put.MOV.M.A call put.MOV.A.B jmp put.STAX.D ; p.EXCHANGE.block: call put.LXI.B.hl p.EXCHANGE.got.length: call p.EXCHANGE.prefix mvi a,bir.exchange jmp put.bir.call.fwd ; ; p.EXCHANGE.prefix: call switch.B db stet.spcl.byte.ptr ! dw p.EXECUTE.B.ptr db stet.spcl.word.ptr ! dw p.EXECUTE.B.ptr db stet.spcl.string.ptr ! dw p.EXECUTE.B.ptr db stet.spcl.BCD.ptr ! dw p.EXECUTE.B.ptr db 0 ! dw p.EXECUTE.B.not p.EXECUTE.B.ptr: call put.LHLD.B call put.XCHG jmp p.EXECUTE.do.A p.EXECUTE.B.not: call put.LXI.D.B p.EXECUTE.do.A: call switch.A db stet.spcl.byte.ptr ! dw put.LHLD.A db stet.spcl.word.ptr ! dw put.LHLD.A db stet.spcl.string.ptr ! dw put.LHLD.A db stet.spcl.BCD.ptr ! dw put.LHLD.A db 0 ! dw put.LXI.H.A ; ; ;------------------------------------------------------ ; ; process.EXECUTE: call chk.strt.code call get.word call get.var.A.word lda A.word.type ani wtp.string cnz put.inline.A.string ; ;--close overlay file if any--- lda any.overlay ora a jz p.EXEC.no.ovl lxi h,0ffffh call put.LXI.H.hl mvi a,bir.overlay.load call put.bir.call.fwd ; p.EXEC.no.ovl: ; ;---if MPM set, need to reset vector at ENTRY--- ; lda MPM.flag ora a jz p.EXECUTE.not.MPM lxi h,MPM.bdos.jmp + 1 call put.LHLD.hl lxi h,entry + 1 call put.SHLD.hl p.EXECUTE.not.MPM: ; lda ste.A.type cpi stet.STRING jz p.EXECUTE.string cpi stet.spcl.string.ptr jnz err.inv.var.type ; call put.LHLD.A call put.XCHG jmp p.EXECUTE.chk.using ; p.EXECUTE.string: call put.LXI.D.A p.EXECUTE.chk.using: lda rsvd.wd.ix cpi rwix.USING jnz p.EXECUTE.no.USING ; call get.word call get.var.B.word lda B.word.type ani wtp.string cnz put.inline.B.string ; lda ste.B.type cpi stet.STRING jz p.EXECUTE.u.string cpi stet.spcl.string.ptr cnz err.inv.var.type ; call put.LHLD.B jmp p.EXECUTE.chk.ERROR ; p.EXECUTE.u.string: call put.LXI.H.B jmp p.EXECUTE.chk.ERROR ; p.EXECUTE.no.USING: lxi h,0 call put.LXI.H.hl p.EXECUTE.chk.ERROR: lda rsvd.wd.ix cpi rwix.ERROR jnz p.EXECUTE.no.ERROR call get.word lda rsvd.wd.ix cpi rwix.STANDARD jz p.EXECUTE.no.ERROR ; mvi l,0ffh call put.MVI.A.L call put.execute.program jmp process.a.statement ; p.EXECUTE.no.ERROR: call put.XRA.A jmp put.execute.program ; ; ;------------------------------------------------------ ; ; process.EXITBEGIN: call chk.strt.code mvi a,bir.EXITBEGIN call put.bir.jmp.fwd jmp get.word ; ;------------------------------------------------------ ; ; process.EXITDO: call chk.strt.code mvi a,bir.EXITDO call put.bir.jmp.fwd jmp get.word ; ;------------------------------------------------------ ; ; process.EXITSWITCH: call chk.strt.code mvi a,bir.EXITSWITCH call put.bir.jmp.fwd jmp get.word ; ;------------------------------------------------------ ; ; process.EXIT: call set.byte.boundary call chk.strt.code call get.word jmp put.RET ; ; ;------------------------------------------------------ ; ; process.EXTERNAL: call get.word call switch.rsvd.wd.ix db rwix.BCD ! dw p.EXTERNAL.BCD db rwix.BYTE ! dw p.EXTERNAL.BYTE db rwix.FIELD ! dw p.EXTERNAL.FIELD db rwix.LABEL ! dw p.EXTERNAL.LABEL db rwix.RECORD ! dw p.EXTERNAL.RECORD db rwix.STRING ! dw p.EXTERNAL.STRING db rwix.WORD ! dw p.EXTERNAL.WORD db 0 ! dw err.mssng.rsvd.wd ; p.EXTERNAL.BCD: call get.word lda rsvd.wd.ix cpi rwix.POINTER jz p.EXTERNAL.BCDP ; lxi h,bcd.size shld ste.length mvi a,stet.BCD sta ste.type jmp p.EXTERNAL.cont ; p.EXTERNAL.BCDP: lxi h,2 shld ste.length mvi a,stet.BCD.ptr sta ste.type jmp p.EXTERNAL.cont ; p.EXTERNAL.BYTE: call get.word lda rsvd.wd.ix cpi rwix.POINTER jz p.EXTERNAL.BP lxi h,1 shld ste.length mvi a,stet.BYTE sta ste.type jmp p.EXTERNAL.cont ; p.EXTERNAL.BP: lxi h,2 shld ste.length mvi a,stet.byte.ptr jmp p.EXTERNAL.id ; p.EXTERNAL.LABEL: lxi h,0 shld ste.length mvi a,stet.LABEL jmp p.EXTERNAL.id ; p.EXTERNAL.FIELD: mvi a,stet.FIELD jmp p.EXTERNAL.common ; p.EXTERNAL.RECORD: mvi a,stet.RECORD p.EXTERNAL.common: lxi h,0 shld ste.length jmp p.EXTERNAL.id ; p.EXTERNAL.STRING: call get.word lda rsvd.wd.ix cpi rwix.POINTER jz p.EXTERNAL.SP lxi h,0 shld ste.length mvi a,stet.STRING sta ste.type jmp p.EXTERNAL.cont ; p.EXTERNAL.SP: lxi h,2 shld ste.length mvi a,stet.string.ptr jmp p.EXTERNAL.id ; p.EXTERNAL.WORD: lxi h,2 shld ste.length call get.word lda rsvd.wd.ix cpi rwix.POINTER jz p.EXTERNAL.WP mvi a,stet.WORD sta ste.type jmp p.EXTERNAL.cont ; p.EXTERNAL.WP: mvi a,stet.word.ptr ; p.EXTERNAL.id: sta ste.type call get.word p.EXTERNAL.cont: call chk.word.id.only lxi h,word lxi d,ste.name call move.string call get.word lda rsvd.wd.ix cpi rwix.ADDRESS cz get.word lda word.type ani wtp.cnst jz err.inv.cnst lhld cnst.value shld ste.address ; xchg lhld curr.print.addr mov a,h ora l jnz p.EXT.no.new.addr xchg shld curr.print.addr p.EXT.no.new.addr: ; lxi h,0 shld ste.length call get.word lda rsvd.wd.ix cpi rwix.LENGTH jnz p.EXTERNAL.no.length call get.word lda word.type ani wtp.cnst cz err.inv.cnst lhld cnst.value shld ste.length call get.word p.EXTERNAL.no.length: lda curr.block.level sta ste.block.level call move.entry.to.sym.tbl ; lda ste.type cpi stet.FIELD jz p.EXT.chk.size cpi stet.RECORD jz p.EXT.chk.size cpi stet.STRING jnz p.EXT.no.size.chk p.EXT.chk.size: lhld ste.length mov a,h ora l cz err.inv.STRING.size p.EXT.no.size.chk: ; lda rsvd.wd.ix cpi rwix.comma rnz lda ste.type jmp p.EXTERNAL.id ; ; ;------------------------------------------------------ ; ; process.FIELD: call set.byte.boundary call chk.strt.data ; xra a sta ste.A.name ; call get.word lda word.type ani wtp.cnst jnz p.FIELD.no.name lda rsvd.wd.ix cpi rwix.LENGTH jz p.FIELD.get.size ; call chk.word.id.only call chk.word.not.in.tbl lxi h,word lxi d,ste.A.name call move.string ; call get.word p.FIELD.get.size: lda rsvd.wd.ix cpi rwix.LENGTH cz get.word lda word.type ani wtp.cnst cz err.inv.STRING.size p.FIELD.no.name: lhld cnst.value lxi d,257 call cmp.de.fm.hl cnc err.inv.STRING.size ; shld ste.length ; lxi h,ste.A.name lxi d,word call move.string mvi a,stet.FIELD sta ste.type lda ste.A.name ora a cnz put.word.into.tbl call get.word ; ;---check for value--- ; lda rsvd.wd.ix cpi rwix.VALUE jnz p.FIELD.no.VALUE ; call get.word lda word.type ani wtp.string jnz p.FIELD.VALUE call err.inv.value jmp p.FIELD.no.VALUE ; p.FIELD.VALUE: lhld ste.length lda word.length mov e,a mvi d,0 call cmp.de.fm.hl push h cc err.pad.string pop h lxi d,word p.FIELD.VALUE.lup: push h ldax d ora a jnz p.FIELD.VALUE.ok dcx d mvi a,' ' p.FIELD.VALUE.ok: push d call put.code.byte pop d pop h inx d dcx h mov a,h ora l jnz p.FIELD.VALUE.lup call get.word jmp p.FIELD.comma ; p.FIELD.no.VALUE: lhld ste.length xchg lhld curr.code.addr dad d shld curr.code.addr ; p.FIELD.comma: lda rsvd.wd.ix cpi rwix.comma jz process.FIELD ret ; ; ;------------------------------------------------------ ; ; process.FILE: call set.byte.boundary call chk.strt.data ; xra a sta ste.C.name sta ste.B.name ; xra a lxi h,curr.fcb mov m,a lxi d,curr.fcb + 1 lxi b,fcb.rec.buffer - 1 call move.h.2.d.cnt.b ; mvi a,' ' lxi h,curr.fcb + fcb.name mov m,a mov e,l mov d,h inx d lxi b,11 call move.h.2.d.cnt.b ; lxi h,FILE.flags mvi c,(FILE.flags.end - FILE.flags) p.FILE.clr.lup: mvi m,0 inx h dcr c jnz p.FILE.clr.lup ; call get.word lda word.type ani wtp.ident cz err.inv.file.id ; lxi h,word lxi d,curr.file.name call move.string ; lxi h,word lxi d,curr.fcb call format.file.name ; p.FILE.next: call get.word p.FILE.main.lup: call debug.routine call switch.rsvd.wd.ix db rwix.comma ! dw p.FILE.next db rwix.BLOCKED ! dw p.FILE.BLOCKED db rwix.BUFFER ! dw p.FILE.BUFFER db rwix.CON ! dw p.FILE.CON db rwix.COMMENT ! dw p.FILE.COMMENT db rwix.DISK ! dw p.FILE.DISK db rwix.FILE1 ! dw p.FILE.FILE1 db rwix.FILE2 ! dw p.FILE.FILE2 db rwix.KEY ! dw p.FILE.KEY db rwix.LST ! dw p.FILE.LST db rwix.NO ! dw p.FILE.NO db rwix.PRN ! dw p.FILE.PRN db rwix.PUN ! dw p.FILE.PUN db rwix.RANDOM ! dw p.FILE.RANDOM db rwix.RDR ! dw p.FILE.RDR db rwix.RECORD ! dw p.FILE.RECORD db rwix.STATUS ! dw p.FILE.STATUS db rwix.TEXT ! dw p.FILE.TEXT db rwix.TTY ! dw p.FILE.TTY db rwix.VALUE ! dw p.FILE.VALUE db 0 ! dw p.FILE.main.exitloop ; ; p.FILE.COMMENT: call process.COMMENT jmp p.FILE.main.lup ; ; p.FILE.CON: p.FILE.LST: p.FILE.PRN p.FILE.PUN: p.FILE.RDR: p.FILE.TTY: sta FILE.device jmp p.FILE.TEXT ;--always text ; ; p.FILE.DISK: sta FILE.device jmp p.FILE.next ; ; p.FILE.FILE1: mvi a,FILE.cr.flag.FILE1 call p.FILE.set.c.flag call p.FILE.set.r.flag jmp p.FILE.next ; ; p.FILE.FILE2: mvi a,FILE.cr.flag.FILE2 call p.FILE.set.c.flag call p.FILE.set.r.flag jmp p.FILE.next ; ; ; p.FILE.KEY: call get.word call chk.word.id.only call chk.word.not.in.tbl lxi h,word lxi d,ste.C.name call move.string jmp p.FILE.next ; ; ; p.FILE.RANDOM: mvi a,FILE.c.flag.RANDOM call p.FILE.set.c.flag jmp p.FILE.next ; ; ; p.FILE.BLOCKED: call get.word lda word.type ani wtp.cnst cz err.inv.cnst lhld cnst.value shld curr.fcb + fcb.rec.blk.fac call p.FILE.set.rec.mode jmp p.FILE.next ; ; ; p.FILE.NO: call get.word lda rsvd.wd.ix cpi rwix.BUFFER cnz err.mssng.rsvd.wd mvi a,FILE.r.flag.no.buff call p.FILE.set.r.flag jmp p.FILE.next ; ; ; ; p.FILE.BUFFER: call get.word lda rsvd.wd.ix cpi rwix.EXTERNAL jz p.FILE.BUFFER.EXTERNAL call lookup.word lhld wk.sym.tbl.addr mov a,m cpi stet.end.tbl jnz p.FILE.BUFFER.ok push h call err.undef.var pop h p.FILE.BUFFER.ok: lxi d,(ste.address - symbol.table.entry) dad d mov e,m inx h mov d,m xchg shld curr.fcb + fcb.buf.addr ; lhld wk.sym.tbl.addr lxi d,(ste.length - symbol.table.entry) dad d mov e,m inx h mov d,m xchg call p.FILE.chk.mod.128 shld curr.fcb + fcb.buf.size ; jmp p.FILE.next ; ; ; p.FILE.BUFFER.EXTERNAL: call get.word lda rsvd.wd.ix cpi rwix.ADDRESS cz get.word lda word.type ani wtp.cnst cz err.inv.cnst ; lhld cnst.value shld curr.fcb + fcb.buf.addr ; call get.word lda rsvd.wd.ix cpi rwix.LENGTH cz get.word lda word.type ani wtp.cnst cz err.inv.cnst lhld cnst.value call p.FILE.chk.mod.128 shld curr.fcb + fcb.buf.size jmp p.FILE.next ; ; ; p.FILE.RECORD: call get.word lda rsvd.wd.ix cpi rwix.EXTERNAL jz p.FILE.RECORD.EXTERNAL call lookup.word lhld wk.sym.tbl.addr mov a,m cpi stet.end.tbl jnz p.FILE.RECORD.ok push h call err.undef.var pop h p.FILE.RECORD.ok: ; ;---check record length--- ; lda FILE.c.flags ani FILE.c.flag.text jz p.FILE.chk.REC.128 ; mov a,m cpi stet.BYTE cnz err.buf.size jmp p.FILE.REC.size.ok ; p.FILE.chk.REC.128: xchg lxi h,ste.length - symbol.table.entry dad d mov a,m inx h mov h,m mov l,a cpi 80h jnz p.FILE.rec.rec.mode mov a,h ora a jz p.FILE.rec.sctr.mode p.FILE.rec.rec.mode: call p.FILE.set.rec.mode p.FILE.rec.sctr.mode: shld curr.fcb + fcb.buf.size xchg p.FILE.REC.size.ok: lxi d,(ste.address - symbol.table.entry) dad d mov e,m inx h mov d,m xchg shld curr.fcb + fcb.rec.addr ; jmp p.FILE.REC.chk.BUF ; ; ; p.FILE.RECORD.EXTERNAL: call get.word lda rsvd.wd.ix cpi rwix.ADDRESS cz get.word lda word.type ani wtp.cnst cz err.inv.cnst ; lhld cnst.value shld curr.fcb + fcb.rec.addr ; call get.word lda rsvd.wd.ix cpi rwix.LENGTH cz get.word lda word.type ani wtp.cnst cz err.inv.cnst lhld cnst.value mov a,l cpi 80h jnz p.FILE.xrec.rec.mode mov a,h ora a jz p.FILE.xrec.sctr.mode p.FILE.xrec.rec.mode: call p.FILE.set.rec.mode p.FILE.xrec.sctr.mode: shld curr.fcb + fcb.buf.size p.FILE.REC.chk.BUF: lhld curr.fcb + fcb.buf.addr mov a,h ora l jnz p.FILE.next ; lhld curr.fcb + fcb.rec.addr shld curr.fcb + fcb.buf.addr jmp p.FILE.next ; ; ; p.FILE.chk.mod.128: mov a,l ani 7fh rz push h call err.buf.size pop h mov a,l ani 80h mov l,a ret ; ; ; p.FILE.STATUS: call get.word call chk.word.id.only call chk.word.not.in.tbl lxi h,word lxi d,ste.B.name call move.string jmp p.FILE.next ; ; ; p.FILE.TEXT: mvi a,FILE.c.flag.TEXT call p.FILE.set.c.flag jmp p.FILE.next ; ; ; p.FILE.VALUE: call get.word lda word.type ani wtp.string jnz p.FILE.VALUE.string ; call chk.word.id.only call get.var.sym.tbl.entry lda ste.type cpi stet.string jz p.FILE.VALUE.ok cpi stet.RECORD cnz err.inv.var.type p.FILE.VALUE.ok: lhld ste.address shld curr.fcb + fcb.name.addr mvi a,FILE.c.flag.ext.name call p.FILE.set.c.flag jmp p.FILE.next ; p.FILE.VALUE.string: lxi h,word lxi d,curr.fcb call format.file.name jmp p.FILE.next ; ; p.FILE.set.rec.mode: mvi a,FILE.c.flag.rec.mode p.FILE.set.c.flag: push h push psw lxi h,FILE.c.flags ora m mov m,a pop psw pop h ret ; ; p.FILE.set.r.flag: push h push psw lxi h,FILE.r.flags ora m mov m,a pop psw pop h ret ; ; ; p.FILE.main.exitloop: lda curr.fcb + fcb.name ora a jnz p.FILE.name.done lxi h,curr.file.name lxi d,curr.fcb call format.file.name p.FILE.name.done: lhld curr.fcb + fcb.rec.addr mov a,h ora l cz err.no.rec ; ;---put filename into symbol-table--- ; mvi a,stet.file sta ste.type lda curr.block.level sta ste.block.level lhld curr.code.addr shld ste.address lda FILE.device sta ste.FILE.device lda FILE.c.flags sta ste.FILE.misc.flag lda FILE.r.flags sta curr.fcb + fcb.flags lxi h,curr.file.name lxi d,ste.name call move.string call move.entry.to.sym.tbl ; ;---put key-name into sym tbl--- ; lxi h,ste.C.name mov a,m ora a jz p.FILE.no.KEY lxi d,ste.name call move.string lhld curr.code.addr lxi d,fcb.rnd.rec lda FILE.c.flags ani FILE.c.flag.rec.mode jz p.FILE.normal.key lxi d,fcb.rec.key p.FILE.normal.key: dad d shld ste.address lxi h,2 shld ste.length mvi a,stet.WORD sta ste.type call move.entry.to.sym.tbl p.FILE.no.KEY: ; ;---put status-name into sym tbl--- ; lxi h,ste.B.name mov a,m ora a jz p.FILE.no.STATUS lxi d,ste.name call move.string lhld curr.code.addr lxi d,fcb.status dad d shld ste.address mvi a,stet.BYTE sta ste.type call move.entry.to.sym.tbl p.FILE.no.STATUS: ; ; ;---put an fcb into the code file--- ; lda FILE.c.flags ani FILE.c.flag.rec.mode jz p.FILE.put.fcb.to.code lxi h,0 shld curr.fcb + fcb.rec.buf.sctr p.FILE.put.fcb.to.code: lxi h,curr.fcb lxi b,fcb.limit lda FILE.c.flags ani FILE.c.flag.rec.mode jz put.code.block ;exit ; ;---special stuff for record-mode files--- ; lxi b,fcb.rec.buffer call put.code.block lda FILE.r.flags ani FILE.r.flag.no.buff jnz p.FILE.no.code.buff ; lxi d,128 ;currently only 128 byte buffer lhld curr.code.addr dad d shld curr.code.addr ; ;---show rec-size on listing--- ; p.FILE.no.code.buff: lhld curr.fcb + fcb.rec.size lxi d,p.FILE.dec.rec.size call cvt.bin.2.dec.str lxi h,p.FILE.msg.rec.size jmp print.warning ; p.FILE.msg.rec.size: db 'Record-Size = ' p.FILE.dec.rec.size: db '00000',0 ; ; ; ;------------------------------------------------------ ; ; process.FILL: call chk.strt.code call get.word call get.var.A.word call switch.A db stet.FIELD ! dw p.FILL.A.ok db stet.RECORD ! dw p.FILL.A.ok db stet.STRING ! dw p.FILL.A.str db 0 ! dw p.FILL.A.err p.FILL.A.err: call err.inv.var.type p.FILL.A.str: ;--string - leave room for null terminator--- lhld ste.A.length dcx h shld ste.A.length p.FILL.A.ok: lda rsvd.wd.ix cpi rwix.WITH cz get.word call get.var.B.word lda B.word.type ani wtp.cnst jnz p.FILL.B.cnst ; lda B.word.type ani wtp.string jnz p.FILL.B.str ; call switch.B db stet.BYTE ! dw p.FILL.B.BYTE db stet.WORD ! dw p.FILL.B.WORD db 0 ! dw err.inv.cnst ; p.FILL.B.cnst: lxi h,1 shld ste.B.length lhld ste.A.length mov a,h ora a jnz p.FILL.B.cnst.2 mov a,l dcr a jz p.FILL.B.cnst.1 p.FILL.B.cnst.2: lda ste.B.address + 1 ora a jz p.FILL.B.cnst.1 lxi h,2 shld ste.B.length call put.LXI.H.B p.FILL.B.16.x: call put.SHLD.A jmp p.FILL.FILL ; p.FILL.B.BYTE: call put.LDA.B jmp p.FILL.B.c.1.cont ; p.FILL.B.WORD: call put.LHLD.B jmp p.FILL.B.16.x ; p.FILL.B.cnst.1: lda ste.B.address ora a jnz p.FILL.B.c.1.not.0 call put.XRA.A jmp p.FILL.B.c.1.cont p.FILL.B.c.1.not.0: call put.MVI.A.B p.FILL.B.c.1.cont: jmp p.FILL.FILL ; p.FILL.B.str: ;---no need for null terminator on source string--- lhld ste.B.length dcx h shld ste.B.length call put.inline.B.string call put.LXI.H.B call put.LXI.D.A call put.LXI.B.B.length call put.mov.blk ; p.FILL.FILL: lhld ste.B.length call negate.hl xchg lhld ste.A.length dad d mov a,h ora l rz ;--area is already filled call put.LXI.B.hl call put.LXI.H.A ;--special case for byte--- lda ste.B.length cpi 1 cz put.MOV.M.A ; lhld ste.A.address xchg lhld ste.B.length dad d call put.LXI.D.hl ; call put.mov.blk ;--null terminator for string--- lda ste.A.type cpi stet.STRING rnz ;exit lda Z80.flag ora a cnz put.XRA.A jmp put.STAX.D ; ; ;------------------------------------------------------ ; ; process.FIND: call chk.strt.code call get.word lda rsvd.wd.ix cpi rwix.NEXT jz p.FIND.NEXT call get.var.A.word lda A.word.type ani wtp.string cnz put.inline.A.string call switch.A db stet.FILE ! dw p.FIND.FILE db stet.STRING ! dw p.FIND.str db stet.spcl.string.ptr ! dw p.FIND.SP db 0 ! dw p.FIND.err p.FIND.err: call err.inv.var.type p.FIND.SP: call put.LHLD.A jmp p.FIND.format ; p.FIND.str: call put.LXI.H.A p.FIND.format: call put.LXI.D.dflt.fcb call put.format.file.name call put.LXI.D.dflt.fcb jmp p.FIND.first ; p.FIND.FILE: call p.OPEN.put.FILE1.2 call put.LXI.D.A p.FIND.first: call put.MVI.C mvi a,17 jmp p.FIND.type ; p.FIND.NEXT: call get.word call put.MVI.C mvi a,18 p.FIND.type: call put.code.byte mvi a,bir.find.file call put.bir.call.fwd ; lda rsvd.wd.ix cpi rwix.GIVING cz get.word call get.var.B.word call put.store.A.at.B lda rsvd.wd.ix cpi rwix.ADDRESS rnz ;---exit--- call get.word call get.var.B.word jmp put.store.HL.at.B ; ; ;------------------------------------------------------ ; ; process.GOTO: process.GO: call chk.strt.code call put.JMP call get.word lda rsvd.wd.ix cpi rwix.TO cz get.word ; lda word.type ani wtp.cnst jz p.GO.label lhld cnst.value call put.code.word jmp get.word ; p.GO.label: lda rsvd.wd.ix cpi rwix.END jz p.GO.END ; call chk.word.id.only ; lda word.type ani wtp.ptr jnz p.GO.ptr ; call put.word.addr jmp get.word ; ; p.GO.END: mvi a,bir.END call put.fwd.ref.bir jmp get.word ; ; p.GO.ptr: call get.var.A.word call put.get.A.into.HL jmp put.PCHL ; ; ; ;------------------------------------------------------ ; ; process.IF: call chk.strt.code call bump.block.level lhld curr.src.line.num push h ; p.IF.AND.lup: call get.word ; mvi a,0ffh sta fall.thru.true sta no.fall.thru.fwd.flag mvi a,bir.ELSE sta curr.fwd.no.fall.thru call process.expression ; p.IF.compound: call switch.rsvd.wd.ix db rwix.AND ! dw p.IF.AND.lup db rwix.OR ! dw p.IF.OR db rwix.THEN ! dw p.IF.THEN db rwix.COMMENT ! dw p.IF.THEN.COMMENT db 0 ! dw p.IF.THEN.no.THEN ; p.IF.THEN.COMMENT: call process.COMMENT jmp p.IF.compound ; p.IF.THEN: call get.word p.IF.THEN.no.THEN: mvi a,bir.THEN call fix.up.built.in.rtn p.IF.THEN.lup: call switch.rsvd.wd.ix db rwix.ELSE ! dw p.IF.THEN.end db rwix.FI ! dw p.IF.FI db 0 ! dw p.IF.THEN.chk.miss ; p.IF.THEN.chk.miss: call chk.not.blk.ender jnz p.IF.THEN.stmt call err.missing.FI jmp p.IF.FI.err ; p.IF.THEN.stmt: call process.a.statement jmp p.IF.THEN.lup ; p.IF.OR: mvi a,bir.THEN call put.bir.jmp.fwd mvi a,bir.ELSE call fix.up.built.in.rtn jmp p.IF.AND.lup ; ; p.IF.THEN.end: call debug.routine mvi a,bir.EXITIF call put.bir.jmp.fwd mvi a,bir.ELSE call fix.up.built.in.rtn call get.word p.IF.ELSE.lup: lda rsvd.wd.ix cpi rwix.FI jz p.IF.FI ; call chk.not.blk.ender jnz p.IF.ELSE.stmt call err.missing.FI jmp p.IF.FI.err ; p.IF.ELSE.stmt: call process.a.statement jmp p.IF.ELSE.lup ; ; p.IF.FI: call debug.routine pop h shld curr.block.match call get.word jmp p.IF.FI.got.mtch ; p.IF.FI.err: pop h shld curr.block.match p.IF.FI.got.mtch: mvi a,bir.THEN call fix.up.built.in.rtn mvi a,bir.ELSE call fix.up.built.in.rtn mvi a,bir.EXITIF call fix.up.built.in.rtn call decr.block.level jmp squish.sym.tbl ; ; ; ; ;------------------------------------------------------ ; ; process.INDEX: xra a sta p.INDEX.length call chk.strt.code call get.word call chk.word.id.only call get.var.A.word call switch.A db stet.byte ! dw p.INDEX.A.ok db stet.word ! dw p.INDEX.A.ok db stet.string ! dw p.INDEX.A.ok db stet.field ! dw p.INDEX.A.ok db stet.record ! dw p.INDEX.A.ok db stet.BCD ! dw p.INDEX.A.ok db 0 ! dw p.INDEX.A.err p.INDEX.A.err: call err.inv.var.type p.INDEX.A.ok: lhld ste.A.address shld p.INDEX.base.addr lda rsvd.wd.ix cpi rwix.OF jnz p.INDEX.B.ok call get.word call get.var.A.word p.INDEX.no.OF: call switch.A db stet.string ! dw p.INDEX.B.ok db stet.field ! dw p.INDEX.B.ok db stet.record ! dw p.INDEX.B.ok db 0 ! dw p.INDEX.B.err p.INDEX.B.err: call err.inv.var.type p.INDEX.B.ok: lhld ste.A.length mov a,h ora a cnz err.inv.var.type mov a,l sta p.INDEX.length ora a cz err.inv.var.type lda rsvd.wd.ix cpi rwix.WITH jz p.INDEX.got.WITH cpi rwix.USING jnz err.mssng.rsvd.wd p.INDEX.got.WITH: call get.word call get.var.A.word lda A.word.type ani wtp.cnst jz p.INDEX.WITH.not.cnst ;---index is constant -- no need to compute at run-time--- lhld ste.A.address lda p.INDEX.length dcr a jz p.INDEX.cnst.1 dcr a jz p.INDEX.cnst.2 ;---index is cnst, but gtr than 2 -- multiply -- xchg lhld p.INDEX.length mvi h,0 call mul.h.by.d.2.h jmp p.INDEX.cnst.1 p.INDEX.cnst.2: dad h p.INDEX.cnst.1: xchg lhld p.INDEX.base.addr dad d call put.LXI.H.hl jmp p.INDEX.GIVING ; ; p.INDEX.WITH.not.cnst: call put.get.A.into.HL lhld p.INDEX.base.addr call put.LXI.B.hl lda p.INDEX.length dcr a jz p.INDEX.1 dcr a jz p.INDEX.2 dcr a ! dcr a jz p.INDEX.4 dcr a ! dcr a ! dcr a ! dcr a jz p.INDEX.8 dcr a ! dcr a ! dcr a ! dcr a dcr a ! dcr a ! dcr a ! dcr a jnz p.INDEX.gtr.16 ;---index by 16--- call put.DAD.H p.INDEX.8: call put.DAD.H p.INDEX.4: call put.DAD.H p.INDEX.2: call put.DAD.H p.INDEX.1: call put.DAD.B jmp p.INDEX.GIVING p.INDEX.gtr.16: lhld p.INDEX.length call put.MVI.E.L mvi a,bir.index call put.bir.call.fwd p.INDEX.GIVING: lda rsvd.wd.ix cpi rwix.GIVING jnz err.mssng.rsvd.wd call get.word call get.var.B.word jmp put.store.HL.at.B ; ; p.INDEX.length: db 0 p.INDEX.base.addr: dw 0 ; ; ;------------------------------------------------------ ; ; process.INPUT: call chk.strt.code call get.word call chk.word.id.only call get.var.A.word lda ste.A.type cpi stet.BYTE cnz err.inv.var.type lda rsvd.wd.ix cpi rwix.FROM cz get.word lda word.type ani wtp.cnst jnz p.INPUT.cnst ; call err.not.rom.able call chk.word.id.only call get.var.B.word lda ste.B.type cpi stet.BYTE cnz err.inv.var.type call put.LDA.B call put.STA lhld curr.code.addr lxi d,3 dad d call put.code.word call put.IN xra a call put.code.byte call put.STA.A jmp p.INPUT.end ; p.INPUT.cnst: call put.IN lda cnst.value call put.code.byte call put.STA.A call get.word p.INPUT.end: lda rsvd.wd.ix cpi rwix.comma jz process.INPUT ret ; ; ; ; ; ;------------------------------------------------------ ; ; process.JUSTIFY: call chk.strt.code call get.word call chk.word.id.only call get.var.A.word ; call switch.rsvd.wd.ix db rwix.RIGHT ! dw p.JUSTIFY.RIGHT db rwix.LEFT ! dw p.JUSTIFY.LEFT db 0 ! dw p.JUSTIFY.err p.JUSTIFY.err: call err.mssng.rsvd.wd p.JUSTIFY.LEFT: mvi a,bir.justify.left jmp p.JUSTIFY.cont ; p.JUSTIFY.RIGHT: mvi a,bir.JUSTIFY.RIGHT p.JUSTIFY.cont: sta p.JUSTIFY.type ; call get.word lda rsvd.wd.ix cpi rwix.LENGTH jnz p.JUSTIFY.dflt call get.word ; call get.var.B.word lda B.word.type ani wtp.cnst jnz p.JUSTIFY.cnst lda ste.B.type cpi stet.BYTE jz p.JUSTIFY.var cpi stet.WORD jz p.JUSTIFY.var cpi stet.spcl.byte.ptr jz p.JUSTIFY.var cpi stet.spcl.word.ptr cnz err.inv.var.type p.JUSTIFY.var: call put.get.B.into.HL call put.XCHG call put.INX.D jmp p.JUSTIFY.go ; p.JUSTIFY.cnst: ; lhld ste.B.address inx h shld ste.A.length p.JUSTIFY.dflt: call put.LXI.D.A.length ; p.JUSTIFY.go: ; call switch.A db stet.STRING ! dw p.JUSTIFY.A.str db stet.spcl.string.ptr ! dw p.JUSTIFY.A.SP db 0 ! dw p.JUSTIFY.A.err p.JUSTIFY.A.err: call err.inv.var.type p.JUSTIFY.A.SP: call put.LHLD.A jmp p.JUSTIFY.A.ok ; p.JUSTIFY.A.str: call put.LXI.H.A p.JUSTIFY.A.ok: lda p.JUSTIFY.type jmp put.bir.call.fwd ; ; p.JUSTIFY.type: db 0 ; ; ; ; ;------------------------------------------------------ ; ; process.MCALL: call chk.strt.code call get.word call get.var.A.word lda ste.A.type cpi stet.end.tbl cz err.undef.label ; lda rsvd.wd.ix cpi rwix.USING jz p.MCALL.go.USING cpi rwix.WITH jnz p.MCALL.end.USING p.MCALL.go.USING: ; call get.word call switch.rsvd.wd.ix db rwix.semicolon ! dw p.MCALL.end.USING db rwix.comma ! dw p.MCALL.no.u.bc db rwix.GIVING ! dw p.MCALL.end.USING db 0 ! dw p.MCALL.do.u.BC p.MCALL.do.u.BC: ; ;---bc value in--- ; call get.var.B.word call p.MCALL.chk.type ; lda B.word.type ani wtp.cnst jz p.MCALL.u.BC ; call put.LXI.B.B jmp p.MCALL.no.u.bc ; p.MCALL.u.bc: call put.get.B.into.HL call put.mv.HL.to.BC ; p.MCALL.no.u.bc: lda rsvd.wd.ix cpi rwix.comma cz get.word ; call switch.rsvd.wd.ix db rwix.comma ! dw p.MCALL.no.u.DE db rwix.semicolon ! dw p.MCALL.end.USING db rwix.GIVING ! dw p.MCALL.end.USING db 0 ! dw p.MCALL.do.u.DE p.MCALL.do.u.DE: ; ;--- de value in --- ; call get.var.B.word call p.MCALL.chk.type ; lda B.word.type ani wtp.cnst jz p.MCALL.u.DE ; call put.LXI.D.B jmp p.MCALL.no.u.de ; p.MCALL.u.de: call put.get.B.into.HL call put.XCHG ; p.MCALL.no.u.de: lda rsvd.wd.ix cpi rwix.comma cz get.word call switch.rsvd.wd.ix db rwix.comma ! dw p.MCALL.no.u.HL db rwix.semicolon ! dw p.MCALL.end.USING db rwix.GIVING ! dw p.MCALL.end.USING db 0 ! dw p.MCALL.do.u.HL p.MCALL.do.u.HL: ; ;--- hl value in --- ; call get.var.B.word call p.MCALL.chk.type call put.get.B.into.HL ; p.MCALL.no.u.hl: lda rsvd.wd.ix cpi rwix.comma cz get.word call switch.rsvd.wd.ix db rwix.semicolon ! dw p.MCALL.end.USING db rwix.GIVING ! dw p.MCALL.end.USING db 0 ! dw p.MCALL.do.u.A p.MCALL.do.u.A: ; ;--- a value in --- ; call get.var.B.word lda B.word.type ani wtp.cnst jnz p.MCALL.u.A.type.ok lda ste.B.type cpi stet.BYTE cnz err.inv.var.type p.MCALL.u.A.type.ok: call put.get.B.into.A ; p.MCALL.end.USING: ; ; ;--- the call --- ; ; call put.CALL call put.A.address ; ;-----all regs undefined (in put.CALL rtn.)----- ; ; lda rsvd.wd.ix cpi rwix.GIVING jnz p.MCALL.end.GIVING ; call get.word ; call switch.rsvd.wd.ix db rwix.comma ! dw p.MCALL.no.g.HL db rwix.semicolon ! dw p.MCALL.end.GIVING db 0 ! dw p.MCALL.do.g.HL p.MCALL.do.g.HL: ; ;--- hl value out --- ; call get.var.B.word call p.MCALL.chk.type ; call put.store.HL.at.B ; p.MCALL.no.g.hl: lda rsvd.wd.ix cpi rwix.comma cz get.word ; call switch.rsvd.wd.ix db rwix.comma ! dw p.MCALL.no.g.DE db rwix.semicolon ! dw p.MCALL.end.GIVING db 0 ! dw p.MCALL.do.g.DE p.MCALL.do.g.DE: ; ;--- de value out --- ; call get.var.B.word call p.MCALL.chk.type call put.XCHG call put.store.HL.at.B ; p.MCALL.no.g.de: lda rsvd.wd.ix cpi rwix.comma cz get.word call switch.rsvd.wd.ix db rwix.comma ! dw p.MCALL.no.g.BC db rwix.semicolon ! dw p.MCALL.end.GIVING db 0 ! dw p.MCALL.do.g.BC p.MCALL.do.g.BC: ; ;--- bc value out --- ; call get.var.B.word call p.MCALL.chk.type call put.mv.BC.to.HL call put.store.HL.at.B ; p.MCALL.no.g.bc: lda rsvd.wd.ix cpi rwix.comma cz get.word call switch.rsvd.wd.ix db rwix.comma ! dw p.MCALL.end.GIVING db rwix.semicolon ! dw p.MCALL.end.GIVING db 0 ! dw p.MCALL.do.g.A p.MCALL.g.err: call err.unexpect.word jmp p.MCALL.end.GIVING ; ;--- a value out --- ; p.MCALL.do.g.A: call get.var.B.word lda ste.B.type cpi stet.BYTE cnz err.inv.var.type jmp put.store.A.at.B ; p.MCALL.end.GIVING: jmp get.word ; ; ; p.MCALL.chk.type: lda B.word.type ani wtp.cnst rnz lda ste.B.type cpi stet.BYTE rz cpi stet.WORD jnz err.inv.var.type ret ; ; ;------------------------------------------------------ ; ; process.MOVE: call chk.strt.code call get.word call get.var.A.word lda rsvd.wd.ix cpi rwix.TO jnz err.mssng.rsvd.wd call get.word call chk.word.id.only call get.var.B.word ; call switch.B db stet.BYTE ! dw p.MOVE.x.B8 db stet.WORD ! dw p.MOVE.x.B16 db stet.BCD ! dw p.MOVE.x.BCD db stet.spcl.byte.ptr ! dw p.MOVE.x.BBP db stet.spcl.word.ptr ! dw p.MOVE.x.BWP db stet.spcl.BCD.ptr ! dw p.MOVE.x.BCDP db stet.STRING ! dw p.MOVE.x.STRING db stet.spcl.string.ptr ! dw p.MOVE.x.SP db stet.RECORD ! dw p.MOVE.x.REC db stet.BIT ! dw p.MOVE.x.BIT db stet.FIELD ! dw p.MOVE.x.FIELD db 0 ! dw p.MOVE.B.err p.MOVE.B.err: call err.inv.var.type ; p.MOVE.x.B8: lda A.word.type ani wtp.cnst jnz put.mv.AN.B8 ; call switch.A db stet.BYTE ! dw put.mv.A8.B8 db stet.WORD ! dw put.mv.A16.B8 db stet.spcl.byte.ptr ! dw put.mv.ABP.B8 db stet.spcl.word.ptr ! dw put.mv.AWP.B8 db 0 ! dw p.MOVE.x.B8.err p.MOVE.x.B8.err: call err.inv.var.type jmp put.mv.AN.B8 ; p.MOVE.x.B16: lda A.word.type ani wtp.cnst jnz put.mv.AN.B16 ; call switch.A db stet.BYTE ! dw put.mv.A8.B16 db stet.WORD ! dw put.mv.A16.B16 db stet.spcl.byte.ptr ! dw put.mv.ABP.B16 db stet.spcl.word.ptr ! dw put.mv.AWP.B16 db 0 ! dw p.MOVE.x.B8.err ; ; p.MOVE.x.BWP: lda A.word.type ani wtp.cnst jnz put.mv.AN.BWP ; call switch.A db stet.BYTE ! dw put.mv.A8.BWP db stet.WORD ! dw put.mv.A16.BWP db stet.spcl.byte.ptr ! dw put.mv.ABP.BWP db stet.spcl.word.ptr ! dw put.mv.AWP.BWP db 0 ! dw p.MOVE.x.B8.err ; p.MOVE.x.BBP: lda A.word.type ani wtp.cnst jnz put.mv.AN.BBP ; call switch.A db stet.BYTE ! dw put.mv.A8.BBP db stet.WORD ! dw put.mv.A16.BBP db stet.spcl.byte.ptr ! dw put.mv.ABP.BBP db stet.spcl.word.ptr ! dw put.mv.AWP.BBP db 0 ! dw p.MOVE.x.B8.err ; ; ; p.MOVE.x.BIT: lda A.word.type ani wtp.cnst jz err.inv.cnst call put.LXI.H.B lda ste.A.address ora a jz p.MOVE.0.BIT lda ste.B.BIT.posn mov l,a call put.MVI.A.L call put.ORA.M jmp put.MOV.M.A ; p.MOVE.0.BIT: lda ste.B.BIT.posn cma mov l,a call put.MVI.A.L call put.ANA.M jmp put.MOV.M.A ; ; ; p.MOVE.x.BCD: call put.LXI.D.B jmp p.MOVE.BCD.cont ; p.MOVE.x.BCDP: call put.LHLD.B call put.XCHG p.MOVE.BCD.cont: lda A.word.type ani wtp.cnst lxi h,sym.tbl.entry.A cnz put.inline.BCD ; lda ste.A.type cpi stet.BCD jz p.MOVE.BCD.BCD cpi stet.spcl.BCD.ptr cnz err.inv.var.type ; call put.LHLD.A jmp p.MOVE.BCD.move ; p.MOVE.BCD.BCD: call put.LXI.H.A p.MOVE.BCD.move: jmp put.bir.MOVE.BCD ; ; ; p.MOVE.x.STRING: lda A.word.type ani wtp.string cnz put.inline.A.string ; call switch.A db stet.STRING ! dw p.MOVE.STR.STR db stet.spcl.string.ptr ! dw p.MOVE.SP.STR db stet.FIELD ! dw p.MOVE.FIELD.STR db 0 ! dw p.MOVE.x.STR.err p.MOVE.x.STR.err: call err.inv.var.type jmp p.MOVE.STR.STR ; p.MOVE.x.SP: lda A.word.type ani wtp.string cnz put.inline.A.string ; call switch.A db stet.STRING ! dw p.MOVE.STR.SP db stet.spcl.string.ptr ! dw p.MOVE.SP.SP db stet.FIELD ! dw p.MOVE.FIELD.SP db 0 ! dw p.MOVE.x.STR.err ; p.MOVE.x.REC: lda ste.A.type cpi stet.RECORD jz p.MOVE.x.REC.ok cpi stet.STRING jz p.MOVE.x.REC.ok cpi stet.FIELD cnz err.inv.var.type p.MOVE.x.REC.ok: call p.MOVE.S.S.prefix call put.LXI.H.A call put.LXI.D.B lda blk.mov.this.stmt ora a jnz p.MOVE.block.move ; call put.LXI.B lhld ste.B.length xchg lhld ste.A.length call cmp.hl.fm.de jnc p.MOVE.REC.A.short push d call err.truncate pop h p.MOVE.REC.A.short: call put.code.word jmp p.MOVE.block.move ; ; p.MOVE.x.FIELD: lhld ste.B.length mov a,h ora a cnz err.inv.string.size mov a,l ora a cz err.inv.string.size lda A.word.type ani wtp.string cnz put.inline.A.string call switch.A db stet.FIELD ! dw p.MOVE.FIELD.FIELD db stet.STRING ! dw p.MOVE.STR.FIELD db stet.spcl.string.ptr ! dw p.MOVE.SP.FIELD db 0 ! dw p.MOVE.x.STR.err ; p.MOVE.FIELD.FIELD: call chk.MOVE.LENGTH jz p.MOVE.STR.STR lda ste.A.length mov l,a lda ste.B.length mov h,a call put.LXI.B.hl call put.LXI.H.A call put.LXI.D.B mvi a,bir.move.field jmp put.bir.call.fwd ; p.MOVE.STR.FIELD: call chk.MOVE.LENGTH jz p.MOVE.STR.STR call put.LXI.H.A jmp p.MOVE.S.SP.FIELD ; p.MOVE.SP.FIELD: call chk.MOVE.LENGTH jz p.MOVE.SP.STR call put.LHLD.A p.MOVE.S.SP.FIELD: call put.LXI.D.B call put.MVI.C lda ste.B.length call put.code.byte mvi a,bir.move.str.2.field jmp put.bir.call.fwd ; p.MOVE.FIELD.STR: call chk.MOVE.LENGTH jz p.MOVE.STR.STR call put.LXI.D.B jmp p.MOVE.FIELD.S.SP ; p.MOVE.FIELD.SP: call chk.MOVE.LENGTH jz p.MOVE.STR.SP call put.LHLD.B call put.XCHG p.MOVE.FIELD.S.SP: call put.LXI.H.A call put.LXI.B.A.length mvi a,bir.move.field.2.str jmp put.bir.call.fwd ; ; chk.MOVE.LENGTH: lda rsvd.wd.ix cpi rwix.LENGTH ret ; ; p.MOVE.S.S.prefix: xra a sta blk.mov.this.stmt ; lda rsvd.wd.ix cpi rwix.LENGTH rnz ; mvi a,0ffh sta blk.mov.this.stmt ; call get.word call get.var.C.word lda C.word.type ani wtp.cnst jnz p.MOVE.S.S.get.C.len ; call put.get.C.into.HL call put.MOV.B.H jmp put.MOV.C.L ; ; p.MOVE.S.S.get.C.len: lhld ste.C.address mov a,h ora l cz err.inv.string.size jmp put.LXI.B.C ; ; p.MOVE.S.S.chk.blk: lda blk.mov.this.stmt ora a jz put.move.string ; p.MOVE.block.move: lda rsvd.wd.ix cpi rwix.REVERSE jnz put.mov.blk ; call get.word call put.XCHG call put.DAD.B call put.XCHG call put.DAD.B jmp put.bir.mov.rev ; ; ; p.MOVE.STR.STR: call p.MOVE.S.S.prefix lda blk.mov.this.stmt ora a jnz p.MOVE.S.S.got.len ; lda string.move.block.flag ora a jz p.MOVE.S.S.got.len ; mvi a,0ffh sta blk.mov.this.stmt ; call put.LXI.B lhld ste.B.length xchg lhld ste.A.length call cmp.hl.fm.de jc p.MOVE.S.S.A.short xchg push h call err.truncate pop h p.MOVE.S.S.A.short: call put.code.word p.MOVE.S.S.got.len: call put.LXI.H.A call put.LXI.D.B jmp p.MOVE.S.S.chk.blk ; p.MOVE.c.STR: call put.inline.A.string jmp p.MOVE.STR.STR ; p.MOVE.STR.SP: call p.MOVE.S.S.prefix call put.LHLD.B call put.XCHG call put.LXI.H.A ; lda string.move.block.flag ora a jz p.MOVE.S.S.chk.blk lda blk.mov.this.stmt ora a jnz p.MOVE.S.S.chk.blk ; call put.LXI.B.A.length mvi a,0ffh sta blk.mov.this.stmt jmp p.MOVE.S.S.chk.blk ; p.MOVE.SP.SP: call p.MOVE.S.S.prefix call put.LHLD.B call put.XCHG call put.LHLD.A jmp p.MOVE.S.S.chk.blk ; p.MOVE.SP.STR: call p.MOVE.S.S.prefix call put.LHLD.A call put.LXI.D.B ; lda string.move.block.flag ora a jz p.MOVE.S.S.chk.blk lda blk.mov.this.stmt ora a jnz p.MOVE.S.S.chk.blk ; call put.LXI.B.B.length mvi a,0ffh sta blk.mov.this.stmt jmp p.MOVE.S.S.chk.blk ; ; ;------------------------------------------------------ ; ; process.MULTIPLY: call chk.strt.code call get.word call get.var.A.word lda rsvd.wd.ix cpi rwix.BY cz get.word ; call get.var.B.word lda rsvd.wd.ix cpi rwix.GIVING jz p.MULTIPLY.3 ; ;---2-address multiply--- ; lxi h,sym.tbl.entry.A lxi d,sym.tbl.entry.C call move.sym.tbl.entry jmp p.MULTIPLY.ok ; p.MULTIPLY.3: call get.word call chk.word.id.only call get.var.C.word p.MULTIPLY.ok: lda A.word.type ani wtp.cnst jnz p.MULTIPLY.cnst ; call switch.A db stet.BYTE ! dw p.MULTIPLY.8 db stet.WORD ! dw p.MULTIPLY.16 db stet.spcl.byte.ptr ! dw p.MULTIPLY.BP db stet.spcl.word.ptr ! dw p.MULTIPLY.WP db stet.BCD ! dw p.MULTIPLY.BCD db stet.spcl.BCD.ptr ! dw p.MULTIPLY.BCDP db 0 ! dw p.MULTIPLY.A.err ; p.MULTIPLY.A.err: call err.inv.var.type p.MULTIPLY.8: p.MULTIPLY.16: call put.get.A.into.HL call put.XCHG jmp p.MULTIPLY.got.A ; p.MULTIPLY.BP: call put.LHLD.A call put.mv.@HLB.to.DE jmp p.MULTIPLY.got.A ; p.MULTIPLY.WP: call put.LHLD.A call put.mv.@HL.to.DE jmp p.MULTIPLY.got.A ; p.MULTIPLY.cnst: lda B.word.type ani wtp.cnst jnz p.MULTIPLY.c.c ; lda ste.B.type cpi stet.BCD jz p.MULTIPLY.BCD.cnst cpi stet.spcl.bcd.ptr jz p.MULTIPLY.BCD.cnst ; call put.LXI.D.A p.MULTIPLY.got.A: call put.get.B.into.HL p.MULTIPLY.got.B: call put.mul.16 jmp put.store.HL.at.C ; ; ; p.MULTIPLY.c.c: lhld ste.A.address xchg lhld ste.B.address call mul.h.by.d.2.h call put.LXI.H.hl jmp put.store.HL.at.C ; ; ; p.MULTIPLY.BCD.cnst: lxi h,sym.tbl.entry.A call put.inline.BCD ; p.MULTIPLY.BCD: call put.LXI.D.A jmp p.MULTIPLY.BCD.C ; p.MULTIPLY.BCDP: call put.LHLD.A call put.XCHG p.MULTIPLY.BCD.C: lda ste.C.type cpi stet.BCD jz p.MULTIPLY.C.BCD cpi stet.spcl.bcd.ptr jnz err.inv.var.type ; call put.LHLD.C call put.mv.HL.to.BC jmp p.MULTIPLY.BCD.B ; p.MULTIPLY.C.BCD: call put.LXI.B.C p.MULTIPLY.BCD.B: lda B.word.type ani wtp.cnst lxi h,sym.tbl.entry.B cnz put.inline.BCD ; lda ste.B.type cpi stet.BCD jz p.MULTIPLY.B.BCD cpi stet.spcl.bcd.ptr jnz err.inv.var.type ; call put.LHLD.B jmp p.MULTIPLY.BCD.call ; p.MULTIPLY.B.BCD: call put.LXI.H.B p.MULTIPLY.BCD.call: mvi a,bir.BCD.multiply jmp put.bir.call.fwd ; ; ; ; ; ;------------------------------------------------------ ; ; process.NULL: jmp get.word ; ; ;------------------------------------------------------ ; ; ; process.OPEN: call chk.strt.code call get.word call chk.word.id.only call get.var.A.word lda ste.A.type cpi stet.FILE cnz err.undef.file.name lda ste.A.FILE.device cpi rwix.DISK rnz ;---init FILE flags--- mvi a,FILE.r.flag.OPEN sta FILE.r.flags ; ;---code to test for filename--- ; lda ste.A.FILE.misc.flag ani FILE.c.flag.ext.name jz p.OPEN.no.ext.name ; lhld ste.A.address lxi d,fcb.name.addr dad d call put.LHLD.hl call put.MOV.A.H call put.ORA.L call put.JZ lhld curr.code.addr lxi d,8 dad d call put.code.word call put.LXI.D.A call put.format.file.name ; p.OPEN.no.ext.name: call p.OPEN.put.FILE1.2 xra a sta file.new.flag ; lda rsvd.wd.ix cpi rwix.INPUT jnz p.OPEN.not.INPUT ; mvi a,FILE.r.flag.INPUT call p.FILE.set.r.flag ; call get.word jmp p.OPEN.stat.ok ; p.OPEN.not.INPUT: lda rsvd.wd.ix cpi rwix.OUTPUT jnz p.OPEN.not.OUTPUT ; mvi a,FILE.r.flag.OUTPUT call p.FILE.set.r.flag mvi a,0ffh sta file.new.flag call get.word jmp p.OPEN.stat.ok ; p.OPEN.not.OUTPUT: lda rsvd.wd.ix cpi rwix.IO jnz p.OPEN.not.IO ; mvi a,FILE.r.flag.INPUT + FILE.r.flag.OUTPUT call p.FILE.set.r.flag call get.word lda ste.A.FILE.misc.flag ani FILE.c.flag.TEXT cnz err.file.cant.io jmp p.OPEN.stat.ok ; p.OPEN.not.IO: lda rsvd.wd.ix cpi rwix.OI jnz p.OPEN.not.OI ; mvi a,FILE.r.flag.INPUT + FILE.r.flag.OUTPUT call p.FILE.set.r.flag lda ste.A.FILE.misc.flag ani FILE.c.flag.TEXT cnz err.file.cant.io mvi a,0ffh sta file.new.flag call get.word jmp p.OPEN.stat.ok ; p.OPEN.not.OI: mvi a,FILE.r.flag.INPUT call p.FILE.set.r.flag p.OPEN.stat.OK: lda rsvd.wd.ix cpi rwix.NO jnz p.OPEN.not.NO ; call get.word lda rsvd.wd.ix cpi rwix.REMOVE cnz err.mssng.rsvd.wd call get.word xra a sta file.new.flag jmp p.OPEN.not.REMOVE ; p.OPEN.not.NO: cpi rwix.REMOVE jnz p.OPEN.chk.output ; call get.word mvi a,FILE.r.flag.OUTPUT call p.FILE.set.r.flag ; p.OPEN.chk.output: lda file.new.flag ora a jz p.OPEN.not.REMOVE ; call put.LXI.D.A call put.MVI.C mvi a,19 ;delete file call put.code.byte call put.CALL.ENTRY mvi a,0ffh sta file.new.flag ; p.OPEN.not.REMOVE: lda rsvd.wd.ix cpi rwix.SHARED jnz p.OPEN.not.SHARED call get.word lda MPM.flag ora a jz p.OPEN.not.SHARED lhld ste.A.address lxi d,5 dad d call put.LXI.H.hl call put.MOV.A.M mvi l,80h call put.ORI.L call put.MOV.M.A ori FILE.r.flag.SHARED call p.FILE.set.r.flag p.OPEN.not.SHARED: lda ste.A.FILE.misc.flag ani FILE.c.flag.rec.mode jz p.OPEN.not.rec.mode lxi h,0 call put.LXI.H.hl lhld ste.A.address lxi d,fcb.rec.buf.sctr dad d call put.SHLD.hl p.OPEN.not.rec.mode: lda ste.A.FILE.misc.flag ani FILE.c.flag.TEXT + FILE.c.flag.rec.mode cpi FILE.c.flag.TEXT jnz p.OPEN.not.TEXT call put.LXI.D.A lda FILE.r.flags ani FILE.r.flag.INPUT mvi a,bir.dsk.ch.in.open jnz p.OPEN.bir.open mvi a,bir.dsk.ch.out.open p.OPEN.bir.open: call put.bir.call.fwd ; p.OPEN.not.TEXT: lhld FILE.r.flags call put.MVI.A.L ; call put.LXI.D.A call put.MVI.C lda file.new.flag ora a mvi a,22 ;create new file jnz p.OPEN.new.file mvi a,15 ;open old file p.OPEN.new.file: call put.code.byte mvi a,bir.OPEN.DISK call put.bir.call.fwd ; lda rsvd.wd.ix cpi rwix.ERROR jnz p.OPEN.end ; call put.INR.A call get.word lda rsvd.wd.ix cpi rwix.STANDARD jz p.OPEN.err.STANDARD ; call put.JNZ mvi a,bir.OPEN.fwd call put.fwd.ref.bir ; call process.a.statement ; mvi a,bir.OPEN.fwd call fix.up.built.in.rtn jmp p.OPEN.end ; p.OPEN.err.STANDARD: call put.CZ mvi a,bir.OPEN.error call put.fwd.ref.bir call get.word ; p.OPEN.end: lda rsvd.wd.ix cpi rwix.comma jz process.OPEN ret ; ; p.OPEN.put.FILE1.2: lxi h,dflt.fcb lda ste.A.FILE.misc.flag ani FILE.cr.flag.FILE1 jnz p.OPEN.actual.FILE.1.2 ; lxi h,dflt.2nd.fcb lda ste.A.FILE.misc.flag ani FILE.cr.flag.FILE2 rz ; ; p.OPEN.actual.FILE1.2: call p.FILE.set.r.flag call put.LXI.H.hl call put.LXI.D.A mvi a,bir.file1.move jmp put.bir.call.fwd ; ; ; ;------------------------------------------------------ ; ; process.OUTPUT: call chk.strt.code call get.word call get.var.A.word lda A.word.type ani wtp.cnst jnz p.OUTPUT.ok ; lda ste.A.type cpi stet.BYTE cnz err.inv.var.type p.OUTPUT.ok: lda rsvd.wd.ix cpi rwix.TO cz get.word lda word.type ani wtp.cnst jnz p.OUTPUT.cnst ; call err.not.rom.able call chk.word.id.only call get.var.B.word lda ste.B.type cpi stet.BYTE jnz err.inv.var.type call put.LDA.B call put.STA lhld curr.code.addr lxi d,6 dad d call put.code.word call put.LDA.A call put.OUT xra a call put.code.byte jmp p.OUTPUT.end ; p.OUTPUT.cnst: call get.var.B.word lda A.word.type ani wtp.cnst jz p.OUTPUT.var call put.MVI.A.A jmp p.OUTPUT.out ; p.OUTPUT.var: call put.LDA.A p.OUTPUT.out: call put.OUT lda ste.B.address call put.code.byte p.OUTPUT.end: lda rsvd.wd.ix cpi rwix.comma jz process.OUTPUT ret ; ; ;------------------------------------------------------ ; ; process.POINTER: call set.byte.boundary call chk.strt.data call get.word lda rsvd.wd.ix cpi rwix.TO cz get.word ; call switch.rsvd.wd.ix db rwix.STRING ! dw p.POINTER.STRING db rwix.WORD ! dw p.POINTER.WORD db rwix.BYTE ! dw p.POINTER.BYTE db rwix.BCD ! dw p.POINTER.BCD db 0 ! dw err.mssng.rsvd.wd ; p.POINTER.BCD: mvi a,stet.bcd.ptr jmp p.POINTER.id ; p.POINTER.BYTE: mvi a,stet.byte.ptr jmp p.POINTER.id ; p.POINTER.WORD: mvi a,stet.word.ptr jmp p.POINTER.id ; p.POINTER.STRING: mvi a,stet.string.ptr ; p.POINTER.id: sta ste.type sta curr.ptr.type call get.word call chk.word.id.only lda curr.BIT.posn sta ste.BIT.posn lxi h,2 shld ste.length call put.word.into.tbl call get.word lda rsvd.wd.ix cpi rwix.VALUE jz p.POINTER.VALUE lhld curr.code.addr inx h inx h shld curr.code.addr jmp p.POINTER.comma ; p.POINTER.VALUE: call get.word lda word.type ani wtp.cnst jnz p.POINTER.cnst ; lda rsvd.wd.ix cpi rwix.HIMEM jnz p.POINTER.label mvi a,bir.HIMEM call put.fwd.ref.bir call get.word jmp p.POINTER.comma ; p.POINTER.label: lda word.type ani wtp.ident jz p.POINTER.inv.VALUE call lookup.word lhld wk.sym.tbl.addr mov a,m cpi stet.end.tbl jz p.POINTER.fwd.ref ; lxi b,(ste.address - ste.type) dad b mov e,m inx h mov d,m jmp p.POINTER.put.VALUE ; p.POINTER.inv.VALUE: call err.inv.VALUE lhld curr.code.addr inx h inx h shld curr.code.addr call get.word jmp p.POINTER.comma ; p.POINTER.fwd.ref: mvi a,stet.fwd.ref sta ste.type call put.word.into.tbl lxi h,0 jmp p.POINTER.put.value ; p.POINTER.cnst: lhld cnst.value p.POINTER.put.VALUE: call put.code.word call get.word p.POINTER.comma: lda rsvd.wd.ix cpi rwix.comma jnz get.word ;exit ; lda curr.ptr.type jmp p.POINTER.id ; ; ;------------------------------------------------------ ; ; process.POP: call chk.strt.code call get.word call chk.word.id.only call get.var.B.word call put.POP.H call put.store.HL.at.B lda rsvd.wd.ix cpi rwix.comma jz process.POP ret ; ; ;------------------------------------------------------ ; ; process.PRINT: call get.word lda rsvd.wd.ix cpi rwix.PAGE jz p.PRINT.PAGE lda print.on.off.flag cpi rwix.FULL jz get.word ; lda rsvd.wd.ix sta print.on.off.flag jmp get.word ; p.PRINT.PAGE: mvi e,0ch lda print.on.off.flag cpi rwix.OFF cnz print.out jmp get.word ; ; ;------------------------------------------------------ ; ; process.PROCEDURE: call opt.undef.all call get.word call chk.strt.data ;honest mvi a,0ffh sta code.started.this.blk ; call process.a.statement call put.RET ; xra a sta code.started.this.blk mvi a,0ffh sta data.started.this.blk ret ; ; ;------------------------------------------------------ ; ; process.PUSH: call chk.strt.code call get.word call get.var.A.word call put.get.A.into.HL call put.PUSH.H lda rsvd.wd.ix cpi rwix.comma jz process.PUSH ret ; ;------------------------------------------------------ ; ; process.READ: call chk.strt.code call get.word call chk.word.id.only call get.var.A.word ; lda ste.A.FILE.device call switch db rwix.CON ! dw p.READ.CON db rwix.RDR ! dw p.READ.RDR db rwix.TTY ! dw p.READ.CON db rwix.DISK ! dw p.READ.DISK db 0 ! dw err.inv.dev.io ; p.READ.DISK: xra a sta read.fresh.flag sta read.lock.flag lda rsvd.wd.ix cpi rwix.FRESH jnz p.READ.not.FRESH call get.word mvi a,0ffh sta read.fresh.flag p.READ.not.FRESH: lda rsvd.wd.ix cpi rwix.LOCK jnz p.READ.not.LOCK call get.word mvi a,0ffh sta read.lock.flag ;---ignore LOCK if not MPM--- lda MPM.flag ora a jz p.READ.not.LOCK mvi a,0ffh mov l,a call put.MVI.A.L lxi h,MPM.lock.flag call put.STA.hl ;---if record-mode file - force fresh read--- p.READ.not.LOCK: lda read.lock.flag mov b,a lda read.fresh.flag ora b jz p.READ.skip.FRESH lda ste.A.FILE.misc.flag ani FILE.c.flag.rec.mode jz p.READ.skip.FRESH lxi h,0 call put.LXI.H.hl lhld ste.A.address lxi d,fcb.rec.buf.sctr dad d call put.SHLD.hl p.READ.skip.FRESH: lda ste.A.FILE.misc.flag ani FILE.c.flag.TEXT jz p.READ.not.text ; call put.LXI.D.A mvi a,bir.dsk.ch.in call put.bir.call.fwd ; lhld ste.A.address lxi d,fcb.rec.addr dad d call put.LHLD.hl call put.MOV.M.A ; lda rsvd.wd.ix cpi rwix.EOF rnz ; call put.CPI mvi a,1ah call put.code.byte call put.JNZ mvi a,bir.READ.fwd call put.fwd.ref.bir call get.word ; call process.a.statement ; mvi a,bir.READ.fwd call fix.up.built.in.rtn jmp p.READ.chk.LOCK ; ; p.READ.not.text: ; lda ste.A.type cpi stet.FILE jnz err.undef.file.name ; call put.LXI.D.A lda ste.A.file.misc.flag ani FILE.c.flag.rec.mode jz p.READ.not.rec.mode ; mvi a,bir.rec.read jmp p.READ.rec.cont ; p.READ.not.rec.mode: call put.MVI.C ; lda ste.A.file.misc.flag ani FILE.c.flag.RANDOM mvi a,33 jnz p.READ.RANDOM mvi a,20 ;seq read p.READ.RANDOM: call put.code.byte ; mvi a,bir.disk.sctr.io p.READ.rec.cont: call put.bir.call.fwd ; lda rsvd.wd.ix cpi rwix.ERROR jz p.READ.ERROR cpi rwix.EOF jnz p.READ.chk.lock ; p.READ.ERROR: call get.word call put.ORA.A lda rsvd.wd.ix cpi rwix.STANDARD jz p.READ.err.STANDARD ; call put.JZ mvi a,bir.READ.fwd call put.fwd.ref.bir ; call process.a.statement ; mvi a,bir.READ.fwd call fix.up.built.in.rtn jmp p.READ.chk.lock ; p.READ.err.STANDARD: call put.CNZ mvi a,bir.read.error call put.fwd.ref.bir call get.word ; p.READ.chk.lock: lda read.lock.flag ora a rz ;exit call put.XRA.A lxi h,MPM.lock.flag jmp put.STA.hl ; read.lock.flag: db 0 read.fresh.flag: db 0 ; ;---------------NON-DISK DEVICES------------ ; p.READ.CON: call put.MVI.C mvi a,1 p.READ.device: call put.code.byte call put.CALL.ENTRY lhld ste.A.address lxi d,fcb.rec.addr dad d call put.LHLD.hl call put.MOV.M.A lhld ste.A.address lxi d,fcb.rec.addr dad d call put.LHLD.hl call put.MOV.M.A ; lda rsvd.wd.ix cpi rwix.EOF rnz ; call put.CPI mvi a,1ah call put.code.byte call put.JNZ mvi a,bir.READ.fwd call put.fwd.ref.bir call get.word ; call process.a.statement ; mvi a,bir.READ.fwd jmp fix.up.built.in.rtn ; ; ; p.READ.RDR: call put.MVI.C mvi a,3 jmp p.READ.device ; ; ;------------------------------------------------------ ; ; process.REBOOT: call chk.strt.code call put.JMP lxi h,BOOT call put.code.word jmp get.word ; ;------------------------------------------------------ ; ; process.RECORD: call set.byte.boundary call chk.strt.data call get.word call chk.word.id.only call chk.word.not.in.tbl ; mvi a,stet.RECORD sta ste.type ; lxi h,0 shld ste.length ; lxi h,word lxi d,last.label call move.string call put.word.into.tbl ; lhld start.sym.tbl.addr push h ;will come back to this later ; lhld curr.src.line.num push h ; call get.word p.RECORD.lup: lda rsvd.wd.ix cpi rwix.ENDREC jz p.RECORD.ENDREC ; call chk.not.blk.ender jnz p.RECORD.stmt call err.missing.ENDREC jmp p.RECORD.ENDREC.err ; p.RECORD.stmt: call process.a.statement jmp p.RECORD.lup ; p.RECORD.ENDREC: call debug.routine pop h shld curr.block.match call get.word jmp p.RECORD.got.mtch ; p.RECORD.ENDREC.err: pop h shld curr.block.match p.RECORD.got.mtch: pop h push h lxi d,ste.address - symbol.table.entry dad d mov e,m inx h mov d,m lhld curr.code.addr call sub.de.fm.hl.2.hl xchg lxi b,ste.length - symbol.table.entry pop h dad b mov m,e inx h mov m,d ret ; ; ;------------------------------------------------------ ; ; process.REDEFINE: call get.word call get.var.A.word lda A.word.type ani wtp.cnst jnz p.REDEFINE.ok lda ste.A.type cpi stet.end.tbl cz err.undef.var p.REDEFINE.ok: lhld curr.code.addr push h ; ;---push ending address for limit test--- ; lhld ste.A.address xchg lhld ste.A.length dad d push h ; lda curr.BIT.posn push psw lhld code.started.this.blk push h lhld curr.src.line.num push h lxi h,redef.ctr inr m ; mvi a,80h sta curr.BIT.posn lda ste.A.type cpi stet.BIT jnz p.REDEFINE.not.BIT lda ste.A.BIT.posn sta curr.BIT.posn p.REDEFINE.not.BIT: lhld ste.A.address shld curr.code.addr call p.REDEFINE.align ; p.REDEFINE.lup: lda rsvd.wd.ix cpi rwix.ENDREDEF jz p.REDEFINE.ENDREDEF ; call chk.not.blk.ender jnz p.REDEFINE.stmt ; call err.missing.ENDREDEF jmp p.REDEFINE.err.ENDREDEF ; p.REDEFINE.stmt: call process.a.statement jmp p.REDEFINE.lup ; p.REDEFINE.ENDREDEF: call debug.routine pop h shld curr.block.match call get.word jmp p.REDEFINE.finish ; p.REDEFINE.err.ENDREDEF: pop h shld curr.block.match p.REDEFINE.finish: lxi h,redef.ctr dcr m pop h shld code.started.this.blk pop psw sta curr.BIT.posn ; lhld curr.code.addr xchg pop h call cmp.de.fm.hl cc err.redef.sz pop h shld curr.code.addr p.REDEFINE.align: xra a sta curr.BIT.build lhld start.code.addr xchg lhld curr.code.addr call cmp.de.fm.hl rc ; 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 mov a,m sta curr.BIT.build ret ; ; ;------------------------------------------------------ ; ; process.REMOVE: call chk.strt.code call get.word call get.var.A.word lda A.word.type ani wtp.string cnz put.inline.A.string call switch.A db stet.STRING ! dw p.REMOVE.str db stet.spcl.string.ptr ! dw p.REMOVE.SP db stet.FILE ! dw p.REMOVE.FILE db 0 ! dw p.REMOVE.err p.REMOVE.err: call err.inv.var.type p.REMOVE.str: call put.LXI.H.A jmp p.REMOVE.fmt p.REMOVE.SP: call put.LHLD.A p.REMOVE.fmt: call put.LXI.D.dflt.fcb call put.format.file.name call put.LXI.D.dflt.fcb jmp p.REMOVE.go ; p.REMOVE.FILE: call p.OPEN.put.FILE1.2 call put.LXI.D.A p.REMOVE.go: mvi a,bir.remove.file call put.bir.call.fwd lda rsvd.wd.ix cpi rwix.GIVING rnz ;---exit--- call get.word call get.var.A.word jmp put.store.A.at.A ; ; ;------------------------------------------------------ ; ; process.RENAME: call chk.strt.code call get.word call get.var.A.word lda A.word.type ani wtp.string cnz put.inline.A.string call switch.A db stet.STRING ! dw p.RENAME.A.str db stet.spcl.string.ptr ! dw p.RENAME.A.SP db stet.FILE ! dw p.RENAME.A.FILE db 0 ! dw p.RENAME.A.err p.RENAME.A.err: call err.inv.var.type p.RENAME.A.str: call put.LXI.H.A jmp p.RENAME.A.fmt p.RENAME.A.SP: call put.LHLD.A p.RENAME.A.fmt: call put.LXI.D.dflt.fcb call put.format.file.name jmp p.RENAME.B p.RENAME.A.FILE: call put.LXI.H.A call put.LXI.D.dflt.fcb lxi h,16 call put.LXI.B.hl call put.mov.blk p.RENAME.B: lda rsvd.wd.ix cpi rwix.TO cz get.word call get.var.A.word lda A.word.type ani wtp.string cnz put.inline.A.string call switch.A db stet.STRING ! dw p.RENAME.B.str db stet.spcl.string.ptr ! dw p.RENAME.B.SP db stet.FILE ! dw p.RENAME.B.FILE db 0 ! dw p.RENAME.B.err p.RENAME.B.err: call err.inv.var.type p.RENAME.B.str: call put.LXI.H.A jmp p.RENAME.B.fmt p.RENAME.B.SP: call put.LHLD.A p.RENAME.B.fmt: lxi h,dflt.2nd.fcb call put.LXI.D.hl call put.format.file.name jmp p.RENAME.go ; p.RENAME.B.FILE: call put.LXI.H.A lxi h,dflt.2nd.fcb call put.LXI.D.hl lxi h,16 call put.LXI.B.hl call put.mov.blk p.RENAME.go: mvi a,bir.rename.file call put.bir.call.fwd lda rsvd.wd.ix cpi rwix.GIVING rnz ;---exit--- call get.word call get.var.A.word jmp put.store.A.at.A ; ; ;------------------------------------------------------ ; ; process.SCAN: call chk.strt.code xra a sta SCAN.type.flag sta SCAN.pos.flag sta SCAN.addr.flag call get.word ; call get.var.A.word lda A.word.type ani wtp.string cnz put.inline.A.string ; call switch.A db stet.STRING ! dw p.SCAN.A db stet.spcl.string.ptr ! dw p.SCAN.A db stet.RECORD ! dw p.SCAN.A db 0 ! dw p.SCAN.A.err p.SCAN.A.err: call err.inv.var.type p.SCAN.A: lda rsvd.wd.ix cpi rwix.FOR jnz err.mssng.rsvd.wd ; call get.word call switch.rsvd.wd.ix db rwix.ANY ! dw p.SCAN.for.ANY db rwix.NO ! dw p.SCAN.for.NO db rwix.TRAILING ! dw p.SCAN.for.TRAILING db 0 ! dw p.SCAN.cont ; p.SCAN.for.ANY: call get.word mvi a,'A' sta SCAN.type.flag jmp p.SCAN.cont ; p.SCAN.for.NO: call get.word mvi a,'N' sta SCAN.type.flag jmp p.SCAN.cont ; p.SCAN.for.TRAILING: call get.word mvi a,'T' sta scan.type.flag ; p.SCAN.cont: call get.var.B.word lda B.word.type ani wtp.string cnz put.inline.B.string ; call switch.B db stet.STRING ! dw p.SCAN.do.it db stet.spcl.string.ptr ! dw p.SCAN.do.it db stet.RECORD ! dw p.SCAN.do.it db 0 ! dw p.SCAN.B.err p.SCAN.B.err: call err.inv.var.type p.SCAN.do.it: lda ste.B.type cpi stet.spcl.string.ptr jz p.SCAN.B.SP ; call put.LXI.D.B jmp p.SCAN.middle ; p.SCAN.B.SP: call put.LHLD.B call put.XCHG p.SCAN.middle: lda ste.A.type cpi stet.spcl.string.ptr jz p.SCAN.A.SP ; call put.LXI.H.A jmp p.SCAN.A.done ; p.SCAN.A.SP: call put.LHLD.A ; p.SCAN.A.done: lda rsvd.wd.ix cpi rwix.GIVING jnz p.SCAN.no.GIVING call get.word lda rsvd.wd.ix cpi rwix.ADDRESS jz p.SCAN.ADDRESS ; call chk.word.id.only call get.var.C.word ; mvi a,0ffh sta SCAN.pos.flag lda rsvd.wd.ix cpi rwix.ADDRESS jnz p.SCAN.not.addr p.SCAN.ADDRESS: call get.word call chk.word.id.only call get.var.B.word mvi a,0ffh sta SCAN.addr.flag p.SCAN.not.addr: ; p.SCAN.no.GIVING: lda SCAN.type.flag call switch db 'A' ! dw p.SCAN.ANY db 'N' ! dw p.SCAN.NO db 'T' ! dw p.SCAN.TRAILING db 0 ! dw p.SCAN.default p.SCAN.default: mvi a,bir.SCAN jmp p.SCAN.result ; p.SCAN.ANY: mvi a,bir.SCAN.ANY jmp p.SCAN.result ; p.SCAN.TRAILING: mvi a,bir.SCAN.TRAILING jmp p.SCAN.result ; p.SCAN.NO: mvi a,bir.SCAN.NO ; p.SCAN.result: call put.bir.call.fwd lda SCAN.pos.flag ora a cnz put.store.HL.at.C lda SCAN.addr.flag ora a jz p.SCAN.chk.ERROR call put.XCHG call put.store.HL.at.B ; p.SCAN.chk.ERROR: lda rsvd.wd.ix cpi rwix.TRUE jz p.SCAN.TRUE cpi rwix.FALSE jz p.SCAN.FALSE.no.TRUE cpi rwix.ERROR rnz ;exit** p.SCAN.FALSE.no.TRUE: call bump.block.level call put.JNZ mvi a,bir.SCAN.TRUE.fwd call put.fwd.ref.bir jmp p.SCAN.do.FALSE ; p.SCAN.TRUE: call get.word call bump.block.level call put.JZ mvi a,bir.SCAN.FALSE.fwd call put.fwd.ref.bir ; call process.a.statement ; lda rsvd.wd.ix cpi rwix.FALSE jz p.SCAN.got.FALSE cpi rwix.ERROR jnz p.SCAN.decr.blk.lvl ; p.SCAN.got.FALSE: mvi a,bir.SCAN.TRUE.fwd call put.bir.jmp.fwd mvi a,bir.SCAN.FALSE.fwd call fix.up.built.in.rtn p.SCAN.do.FALSE: call get.word ; call process.a.statement ; p.SCAN.decr.blk.lvl: mvi a,bir.SCAN.TRUE.fwd call fix.up.built.in.rtn mvi a,bir.SCAN.FALSE.fwd call fix.up.built.in.rtn jmp decr.block.level ; ; ; ; ; ;-------------------------------------------------------- ; ; ; process.SEGMENTED: call get.word lda rsvd.wd.ix cpi rwix.PROCEDURE jnz err.mssng.rsvd.wd ; lda overlay.in.process ora a jnz err.nested.overlay ; ;---put null value for key of overlay present--- ; lxi h,0ffffh call put.code.word ; call write.code.write ;flush any partial buff ; ;---save COM fcb & map--- ; 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--- ; lxi h,ovl.fcb lxi d,code.fcb lxi b,36 call move.h.2.d.cnt.b ; lhld curr.code.addr shld start.code.addr ; ;---open OVL fcb if needed--- ; p.SEG.again: ; ;---set flag to save pointer to overlay-name sym-tbl-entry---- ; lxi h,0 shld curr.ovl.ste.ptr ; ;---open overlay file if first overlay--- ; lda any.overlay ora a jnz p.SEG.ovl.open ; lxi d,code.fcb mvi c,19 call entry ; lxi d,code.fcb mvi c,22 call entry inr a jnz p.SEG.ovl.open call err.code.write jmp boot ; p.SEG.ovl.open: lhld curr.ovl.start.key shld ovl.sctr.offset ; mvi a,0ffh sta overlay.in.process sta any.overlay ; lxi h,code.file.map lxi d,code.file.map + 1 mvi m,0 lxi b,511 call move.h.2.d.cnt.b ; lxi h,0 shld code.fcb + fcb.rnd.rec ; ; ;---compile the overlay--- ; call process.a.statement ; ; call write.code.write ;flush any partial OVL sctr ; ;---put overlay length into symbol table--- ; lhld start.code.addr xchg lhld curr.code.addr call sub.de.fm.hl.2.hl xchg lhld curr.ovl.ste.ptr mov a,h ora l jz err.undef.label ;error if no procedure-name lxi b,(ste.length - ste.type) dad b mov m,e inx h mov m,d ; lhld code.fcb + fcb.rnd.rec inx h ;HL = # sctrs in old ovly xchg lhld curr.ovl.start.key dad d ;HL = new ovl hdr sctr # shld curr.ovl.start.key ;save for next overlay ; ;----Message on Console and Print File showing stats--- ; lda nowarn.flag ora a jnz SEG.msg.skip ; lda print.console push psw mvi a,0ffh sta print.console ; lhld ovl.sctr.offset lxi d,p.SEG.msg.key + 8 call cvt.bin.2.hex.str lxi d,p.SEG.msg.key ! call listing.string.out ; lhld start.code.addr lxi d,p.SEG.msg.strt + 13 call cvt.bin.2.hex.str lxi d,p.SEG.msg.strt ! call listing.string.out ; lhld curr.code.addr lxi d,p.SEG.msg.end + 11 call cvt.bin.2.hex.str lxi d,p.SEG.msg.end ! call listing.string.out ; lxi d,p.SEG.msg.name ! call listing.string.out lhld curr.ovl.ste.ptr lxi d,(ste.name - ste.type) dad d ! xchg ! call listing.string.out call listing.crlf ; pop psw sta print.console SEG.msg.skip: ; ;---check if this overlay is larger than any previous at this level--- ; lhld highest.ovl.addr xchg lhld curr.code.addr call cmp.hl.fm.de jnc p.SEG.no.new.hi shld highest.ovl.addr p.SEG.no.new.hi: ; ;---check for another overlay following--- ; p.SEG.test.SEG: call p.SWITCH.flush.COMMENT lda rsvd.wd.ix cpi rwix.semicolon jnz p.SEG.not.semicolon ; call get.word jmp p.SEG.test.SEG ; p.SEG.not.semicolon: cpi rwix.COPY jnz p.SEG.not.COPY ; call process.COPY jmp p.SEG.test.SEG ; p.SEG.not.COPY: cpi rwix.SEGMENTED jnz p.SEG.not.SEGMENTED ; ;---another overlay follows -- it goes at same address --- ; call get.word ;skip SEGMENTED lda rsvd.wd.ix cpi rwix.PROCEDURE jnz err.mssng.rsvd.wd lhld start.code.addr shld curr.code.addr jmp p.SEG.again ; ; ;---this overlay is not followed by another overlay ;---reset back to COM file ; p.SEG.not.SEGMENTED: ; ;---save current OVL fcb--- ; lxi h,code.fcb lxi d,ovl.fcb lxi b,36 call move.h.2.d.cnt.b ; ;---restore COM fcb & map ; 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 ; ;---finish up-- ; lhld highest.ovl.addr shld curr.code.addr call set.code.key shld code.fcb + fcb.rnd.rec lxi h,0 shld ovl.sctr.offset shld highest.ovl.addr lxi h,0100h shld start.code.addr xra a sta overlay.in.process call clear.code.buff jmp read.code.buff.only ;possibly refresh buffer ; ; p.SEG.msg.key: db 'OVL key 0000',0 p.SEG.msg.strt: db ' Start addr 0000',0 p.SEG.msg.end: db ' End addr 0000',0 p.SEG.msg.name: db ' Name: ',0 ; ; ; ;------------------------------------------------------ ; ; process.SET: call get.word call chk.word.id.only lxi h,word lxi d,ste.A.name call move.string ; call get.word lda rsvd.wd.ix cpi rwix.eql cz get.word lda rsvd.wd.ix cpi rwix.TO cz get.word ; lda word.type ani wtp.cnst jnz p.SET.cnst ;--not a CNST, must be rsvd wd-- lda rsvd.wd.ix ora a jz err.mssng.rsvd.wd ; lxi h,ste.address mov m,a lda word.type inx h mov m,a mvi a,stet.SET.word jmp p.SET.go ; p.SET.cnst: lhld cnst.value shld ste.address ; lhld curr.print.addr mov a,h ora l jnz p.SET.no.new.addr lhld ste.address shld curr.print.addr p.SET.no.new.addr: ; mvi a,stet.SET.cnst p.SET.go: sta ste.type lhld word.length mvi h,0 shld ste.length lxi h,ste.A.name lxi d,ste.name call move.string call put.ste.into.tbl.no.addr call get.word lda rsvd.wd.ix cpi rwix.comma jz process.SET ret ; ; ; ; ;------------------------------------------------------ ; ; process.SIZE: call chk.strt.code xra a sta size.cnt.flag call get.word call chk.word.id.only call get.var.A.word call switch.A db stet.STRING ! dw p.SIZE.type.ok db stet.spcl.string.ptr ! dw p.SIZE.type.ok db stet.FIELD ! dw p.SIZE.type.ok db stet.RECORD ! dw p.SIZE.type.ok db 0 ! dw p.SIZE.A.type.err p.SIZE.A.type.err: call err.inv.var.type p.SIZE.type.ok: lda rsvd.wd.ix cpi rwix.GIVING cz get.word lda rsvd.wd.ix cpi rwix.ADDRESS jz p.SIZE.go call get.var.B.word mvi a,0ffh sta size.cnt.flag ; p.SIZE.go: call switch.A db stet.spcl.string.ptr ! dw p.SIZE.SP db stet.FIELD ! dw p.SIZE.RECORD db stet.RECORD ! dw p.SIZE.RECORD db 0 ! dw p.SIZE.STRING ; p.SIZE.STRING: call put.LXI.D.A p.SIZE.call: mvi a,bir.SIZE call put.bir.call.fwd lda size.cnt.flag ora a cnz put.store.HL.at.B lda rsvd.wd.ix cpi rwix.ADDRESS rnz call get.word call get.var.B.word call put.XCHG jmp put.store.HL.at.B ; ; p.SIZE.SP: call put.LHLD.A call put.XCHG jmp p.SIZE.call ; p.SIZE.RECORD: call put.LXI.H.A.length jmp put.store.HL.at.B ; ; ;------------------------------------------------------ ; ; process.STRING: call set.byte.boundary call chk.strt.data call get.word ; lda rsvd.wd.ix cpi rwix.POINTER jz p.POINTER.STRING ;non-standard flow lda word.type ani wtp.cnst jnz p.STRING.no.name call chk.word.id.only call chk.word.not.in.tbl ;---save string name until size gotten--- lxi h,word lxi d,ste.A.name call move.string call get.word ; p.STRING.get.size: lda rsvd.wd.ix cpi rwix.LENGTH cz get.word lda word.type ani wtp.cnst cz err.inv.STRING.size lhld cnst.value mov a,h ora l cz err.inv.string.size shld ste.length lxi h,ste.A.name lxi d,word call move.string mvi a,stet.STRING sta ste.type lda ste.A.name ora a ;null name? cnz put.word.into.tbl ; call get.word lda rsvd.wd.ix cpi rwix.VALUE jz p.STRING.VALUE ;---no value - fill with nulls--- p.STRING.no.VALUE: lhld ste.length xchg lhld curr.code.addr dad d shld curr.code.addr jmp p.STRING.comma ; p.STRING.no.name: xra a sta ste.A.name jmp p.STRING.get.size ; p.STRING.VALUE: ;---clear word for clean value--- lxi h,word lxi d,word + 1 lxi b,max.word.length - 1 mvi m,0 call move.h.2.d.cnt.b ; call get.word lda word.type ani wtp.string jnz p.STRING.got.VALUE ; call err.inv.VALUE jmp p.STRING.no.VALUE ; p.STRING.got.VALUE: lhld ste.length lda word.length inr a ;plus null byte mov e,a mvi d,0 mov a,h cmp d jc p.STRING.trunc jnz p.STRING.no.trunc mov a,l cmp e jnc p.STRING.no.trunc jnz p.STRING.trunc push h dcx d call cmp.de.fm.hl cz err.no.term.byte pop h jmp p.STRING.no.trunc p.STRING.trunc: push h call err.pad.string call err.no.term.byte pop h p.STRING.no.trunc: lxi d,word p.STRING.value.lup: push h push d ldax d call put.code.byte pop d pop h inx d dcx h mov a,h ora l jnz p.STRING.VALUE.lup call get.word p.STRING.comma: lda rsvd.wd.ix cpi rwix.comma jz process.STRING ret ; ;------------------------------------------------------ ; ; process.SUBTRACT: call chk.strt.code call get.word call get.var.A.word ; lda rsvd.wd.ix cpi rwix.FROM cz get.word ; call get.var.B.word ; lda rsvd.wd.ix cpi rwix.GIVING jz p.SUBTRACT.3 ; lxi h,sym.tbl.entry.B lxi d,sym.tbl.entry.C call move.sym.tbl.entry jmp p.SUBTRACT.go ; p.SUBTRACT.3: call get.word call chk.word.id.only call get.var.C.word ; p.SUBTRACT.GO: call switch.C db stet.BYTE ! dw p.SUBTRACT.x.x.8 db stet.WORD ! dw p.SUBTRACT.x.x.16 db stet.spcl.byte.ptr ! dw p.SUBTRACT.x.x.8 db stet.spcl.word.ptr ! dw p.SUBTRACT.x.x.16 db stet.BCD ! dw p.SUBTRACT.BCD db stet.spcl.BCD.ptr ! dw p.SUBTRACT.BCDP db 0 ! dw p.SUBTRACT.x.x.err ; p.SUBTRACT.x.x.err: call err.inv.var.type p.SUBTRACT.x.x.8: lxi h,sym.tbl.entry.B lxi d,sym.tbl.entry.C call compare.sym.tbl.entries jz p.subtract.2.x.8 ; lda B.word.type ani wtp.cnst jnz p.SUBTRACT.x.c.8 call switch.B db stet.BYTE ! dw p.SUBTRACT.x.8.8 db stet.WORD ! dw p.SUBTRACT.x.16.8 db stet.spcl.byte.ptr ! dw p.SUBTRACT.8.general db stet.spcl.word.ptr ! dw p.SUBTRACT.8.general db 0 ! dw err.inv.var.type ; ; p.SUBTRACT.2.x.8: lda A.word.type ani wtp.cnst jnz put.sub.2.AN.B8 ; lda ste.A.type cpi stet.BYTE jz put.sub.2.AB.BB jmp p.SUBTRACT.8.general ; p.SUBTRACT.x.16.8: call err.truncate p.SUBTRACT.x.8.8: lda A.word.type ani wtp.cnst jnz put.sub.AN.BB.CB jmp p.SUBTRACT.8.general ; p.SUBTRACT.x.c.8: lda A.word.type ani wtp.cnst jnz put.sub.AN.BN.C8 jmp p.SUBTRACT.8.general ; p.SUBTRACT.x.x.16: lda B.word.type ani wtp.cnst jz p.SUBTRACT.general lda A.word.type ani wtp.cnst jz p.SUBTRACT.general jmp put.sub.AN.BN.C16 ; ; ; ; p.SUBTRACT.8.general: lda B.word.type ani wtp.cnst jnz p.SUBTRACT.g.8.x.c.x ; call switch.B db stet.BYTE ! dw p.SUBTRACT.g.8.x.8.x db stet.WORD ! dw p.SUBTRACT.g.8.x.16.x db stet.spcl.byte.ptr ! dw p.SUBTRACT.g.8.x.BP.x db stet.spcl.WORD.ptr ! dw p.SUBTRACT.g.8.x.WP.x db 0 ! dw p.SUBTRACT.g.8.err ; p.SUBTRACT.g.8.err: call err.inv.var.type p.SUBTRACT.g.8.x.16.x: call err.truncate p.SUBTRACT.g.8.x.8.x: call put.LDA.B jmp p.SUBTRACT.g.8.A ; p.SUBTRACT.g.8.x.WP.x: call err.truncate p.SUBTRACT.g.8.x.BP.x: call put.LHLD.B call put.MOV.A.M jmp p.SUBTRACT.g.8.A ; p.SUBTRACT.g.8.x.c.x: lhld ste.B.address call put.MVI.A.L p.SUBTRACT.g.8.A: lda A.word.type ani wtp.cnst jnz p.SUBTRACT.g.8.c.x.x ; call switch.A db stet.BYTE ! dw p.SUBTRACT.g.8.8.x.x db stet.WORD ! dw p.SUBTRACT.g.8.16.x.x db stet.spcl.BYTE.ptr ! dw p.SUBTRACT.g.8.BP.x.x db stet.spcl.WORD.ptr ! dw p.SUBTRACT.g.8.WP.x.x db 0 ! dw p.SUBTRACT.g.8.x.err ; p.SUBTRACT.g.8.x.err: call err.inv.var.type p.SUBTRACT.g.8.16.x.x: call err.truncate p.SUBTRACT.g.8.8.x.x: call put.LXI.H.A call put.SUB.M jmp p.SUBTRACT.g.8.C ; p.SUBTRACT.g.8.c.x.x: lhld ste.A.address call put.SUI.L jmp p.SUBTRACT.g.8.C ; p.SUBTRACT.g.8.WP.x.x: call err.truncate p.SUBTRACT.g.8.BP.x.x: call put.LHLD.A call put.SUB.M p.SUBTRACT.g.8.C: call switch.C db stet.BYTE ! dw p.SUBTRACT.g.8.x.x.8 db stet.spcl.BYTE.ptr ! dw p.SUBTRACT.g.8.x.x.BP db 0 ! dw p.SUBTRACT.g.8.x.x.err p.SUBTRACT.g.8.x.x.err: call err.inv.var.type p.SUBTRACT.g.8.x.x.8: jmp put.STA.C ; p.SUBTRACT.g.8.x.x.BP: call put.LHLD.C jmp put.MOV.M.A ; ; ; ; p.SUBTRACT.general: lda A.word.type ani wtp.cnst jnz p.SUBTRACT.g.c.chk ; call switch.A db stet.BYTE ! dw put.sub.g.A8.B16.C16 db stet.WORD ! dw put.sub.g.A16.B16.C16 db stet.spcl.BYTE.ptr ! dw put.sub.g.ABP.B16.C16 db stet.spcl.WORD.ptr ! dw put.sub.g.AWP.B16.C16 db 0 ! dw p.SUBTRACT.g.err ; ; p.SUBTRACT.g.err: call err.inv.var.type p.SUBTRACT.g.c.chk: lda B.word.type ani wtp.cnst jnz put.sub.g.AN.BN.C16 jmp put.sub.g.ANsmall ; ; ; ; ; p.SUBTRACT.BCD: call put.LXI.B.C jmp p.SUBTRACT.BCD.A ; p.SUBTRACT.BCDP: call put.LHLD.C call put.mv.HL.to.BC p.SUBTRACT.BCD.A: lda A.word.type ani wtp.cnst lxi h,sym.tbl.entry.A cnz put.inline.BCD ; lda ste.A.type cpi stet.BCD jz p.SUBTRACT.A.BCD cpi stet.spcl.bcd.ptr cnz err.inv.var.type ; call put.LHLD.A call put.XCHG jmp p.SUBTRACT.BCD.B ; p.SUBTRACT.A.BCD: call put.LXI.D.A p.SUBTRACT.BCD.B: lda B.word.type ani wtp.cnst lxi h,sym.tbl.entry.B cnz put.inline.BCD ; lda ste.B.type cpi stet.BCD jz p.SUBTRACT.B.BCD cpi stet.spcl.bcd.ptr cnz err.inv.var.type call put.LHLD.B jmp p.SUBTRACT.BCD.call ; p.SUBTRACT.B.BCD: call put.LXI.H.B p.SUBTRACT.BCD.call: mvi a,bir.BCD.subtract jmp put.bir.call.fwd ; ; ; ; ; ; ;------------------------------------------------------ ; ; bir.SWITCH jumps to selection-fail address ; (past executable-stmt this selection) ; bir.SWITCH.multiple jumps TO the executable statement ; bir.SWITCH.range.fail..jumps either to next comparison this group, ; or to next selection-group if no next cmpr. ; ; process.SWITCH: call chk.strt.code call bump.block.level lhld curr.src.line.num push h ; call get.word lda rsvd.wd.ix cpi rwix.ON cz get.word call chk.word.id.only call get.var.A.word lda rsvd.wd.ix cpi rwix.colon cz get.word lda rsvd.wd.ix cpi rwix.semicolon cz get.word xra a sta first.switch.flag ; p.SWITCH.lup: mvi a,bir.SWITCH.range.fail call fix.up.built.in.rtn call p.SWITCH.flush.COMMENT call switch.rsvd.wd.ix db rwix.ENDSWITCH ! dw p.SWITCH.ENDSWITCH db rwix.ELSE ! dw p.SWITCH.ELSE db 0 ! dw p.SWITCH.chk.more p.SWITCH.chk.more: call chk.not.blk.ender jnz p.SWITCH.get.test call err.missing.ENDSWITCH jmp p.SWITCH.err.ENDSWITCH ; ; p.SWITCH.get.test: mvi a,bir.SWITCH.range.fail call fix.up.built.in.rtn call p.SWITCH.flush.COMMENT call chk.strt.code ;get right addr on listing call get.var.B.word call p.SWITCH.flush.COMMENT lda rsvd.wd.ix cpi rwix.minus jz p.SWITCH.range cpi rwix.TO jnz p.SWITCH.not.range ; ; ;----range specified (ex: 1-5)----- ; p.SWITCH.range: call p.SWITCH.flush.COMMENT call get.word ;skip '-' or TO call p.SWITCH.flush.COMMENT call get.var.C.word ; ;--check if range forwards or backwards-- ; call switch.A db stet.STRING ! dw p.SWITCH.rng.str db stet.spcl.string.ptr ! dw p.SWITCH.rng.str db stet.BCD ! dw p.SWITCH.rng.BCD db stet.spcl.bcd.ptr ! dw p.SWITCH.rng.BCD db 0 ! dw p.SWITCH.rng.bin ; p.SWITCH.rng.bin: lhld ste.B.address xchg lhld ste.C.address call cmp.de.fm.hl jc p.SWITCH.rng.bkwds jmp p.SWITCH.rng.fwd ; p.SWITCH.rng.str: lxi h,ste.B.name lxi d,ste.C.name call compare.strings jc p.SWITCH.rng.bkwds jmp p.SWITCH.rng.fwd ; p.SWITCH.rng.bcd: lxi h,ste.B.name lxi d,switch.bcd.wk call cvt.str.2.bcd lxi h,ste.C.name lxi d,bcd.cnst.value.wk call cvt.str.2.bcd lxi h,switch.bcd.wk lxi d,bcd.cnst.value.wk call bcd.compare jnc p.SWITCH.rng.fwd ; p.SWITCH.rng.bkwds: lxi h,sym.tbl.entry.B lxi d,sym.tbl.entry.C mvi b,sym.tbl.entry.C - sym.tbl.entry.B p.SWITCH.swap.lup: mov c,m ldax d mov m,a mov a,c stax d dcr b jnz p.SWITCH.swap.lup p.SWITCH.rng.fwd: call switch.A db stet.BYTE ! dw p.SWITCH.rng.0.8.strt db stet.spcl.byte.ptr ! dw p.SWITCH.rng.0.8.strt db stet.WORD ! dw p.SWITCH.rng.0.16.strt db stet.spcl.word.ptr ! dw p.SWITCH.rng.0.16.strt db 0 ! dw p.SWITCH.rng.cont ; p.SWITCH.rng.0.8.strt: lda ste.B.address + 1 ora a cnz err.truncate p.SWITCH.rng.0.16.strt: lhld ste.B.address mov a,h ora l jz p.SWITCH.rng.B.skip ; p.SWITCH.rng.cont: xra a call p.SWITCH.compare call put.JC mvi a,bir.SWITCH.range.fail call put.fwd.bir.sv.word ; p.SWITCH.rng.B.skip: lxi h,sym.tbl.entry.C lxi d,sym.tbl.entry.B call move.sym.tbl.entry call switch.A db stet.BYTE ! dw p.SWITCH.erng.8.0.end db stet.spcl.byte.ptr ! dw p.SWITCH.erng.8.0.end db stet.WORD ! dw p.SWITCH.erng.16.0.end db stet.spcl.word.ptr ! dw p.SWITCH.erng.16.0.end db 0 ! dw p.SWITCH.erng.cont ; p.SWITCH.erng.8.0.end: lda ste.B.address + 1 ora a cnz err.truncate lda ste.B.address sta ste.B.address + 1 ; ;---skip end test for binary if = ^hff or ^hffff--- ; p.SWITCH.erng.16.0.end: lhld ste.B.address mov a,h ana l inr a jz p.SWITCH.rng.chk.more p.SWITCH.erng.cont: mvi a,1 call p.SWITCH.compare ; ;--if STRING or BCD, flag still set for special case of end range equal ; lda switch.end.rng.flag ora a jz p.SWITCH.end.off.done call put.JZ mvi a,bir.SWITCH.multiple call put.fwd.bir.sv.word p.SWITCH.end.off.done: call p.SWITCH.flush.COMMENT lda rsvd.wd.ix cpi rwix.comma jnz p.SWITCH.end.range call put.JC mvi a,bir.SWITCH.multiple call put.fwd.bir.sv.word jmp p.SWITCH.rng.chk.more ; p.SWITCH.end.range: call put.JNC mvi a,bir.SWITCH call put.fwd.bir.sv.word p.SWITCH.rng.chk.more: call p.SWITCH.flush.COMMENT mvi a,0ffh sta first.switch.flag lda rsvd.wd.ix cpi rwix.comma jnz p.SWITCH.rng.not.mult call get.word jmp p.SWITCH.get.test ; ;---not range--- ; p.SWITCH.not.range: call switch.B db stet.BYTE ! dw p.SWITCH.nrng.8 db stet.spcl.byte.ptr ! dw p.SWITCH.nrng.8 db 0 ! dw p.SWITCH.nrng.cont p.SWITCH.nrng.8: lda ste.B.address + 1 ora a cnz err.truncate p.SWITCH.nrng.cont: xra a call p.SWITCH.compare mvi a,0ffh sta first.switch.flag call p.SWITCH.flush.COMMENT lda rsvd.wd.ix cpi rwix.comma jnz p.SWITCH.not.multiple call put.JZ mvi a,bir.SWITCH.multiple call put.fwd.ref.bir call get.word jmp p.SWITCH.get.test ; p.SWITCH.not.multiple: call put.JNZ mvi a,bir.SWITCH call put.fwd.bir.sv.word p.SWITCH.rng.not.mult: mvi a,0ffh sta first.switch.flag lda rsvd.wd.ix cpi rwix.colon cz get.word mvi a,bir.SWITCH.multiple call fix.up.built.in.rtn lhld ste.A.type push h lhld ste.A.address push h call process.a.statement mvi a,bir.EXITSWITCH call put.bir.jmp.fwd mvi a,bir.SWITCH call fix.up.built.in.rtn pop h shld ste.A.address pop h mov a,l sta ste.A.type jmp p.SWITCH.lup ; ; p.SWITCH.ELSE: call debug.routine mvi a,bir.SWITCH call fix.up.built.in.rtn call get.word call process.a.statement lda rsvd.wd.ix cpi rwix.ENDSWITCH cnz err.missing.ENDSWITCH p.SWITCH.ENDSWITCH: call debug.routine pop h shld curr.block.match call get.word jmp p.SWITCH.got.mtch ; p.SWITCH.err.ENDSWITCH: pop h shld curr.block.match p.SWITCH.got.mtch: mvi a,bir.SWITCH call fix.up.built.in.rtn mvi a,bir.EXITSWITCH call fix.up.built.in.rtn call decr.block.level jmp squish.sym.tbl ; ; ; p.SWITCH.flush.COMMENT: lda rsvd.wd.ix cpi rwix.COMMENT rnz call process.COMMENT jmp p.SWITCH.flush.COMMENT ; ; ; ;==========comparison routine for switch======== ; p.SWITCH.compare: sta switch.end.rng.flag lda ste.A.type cpi stet.string jz p.SWITCH.string cpi stet.spcl.string.ptr jnz p.SWITCH.cnst ; p.SWITCH.string: lda B.word.type ani wtp.string cz err.inv.cnst ; call switch.A db stet.STRING ! dw p.SWITCH.str.str db stet.spcl.string.ptr ! dw p.SWITCH.str.SP db 0 ! dw p.SWITCH.str.err p.SWITCH.str.err: call err.inv.var.type p.SWITCH.str.str: call put.LXI.H.A p.SWITCH.cmp.str: call put.inline.B.string call put.LXI.D.B jmp put.cmp.str ; p.SWITCH.str.SP: call put.LHLD.A jmp p.SWITCH.cmp.str ; p.SWITCH.cnst: lda B.word.type ani wtp.cnst cz err.inv.cnst ; call switch.A db stet.BYTE ! dw p.SWITCH.BYTE.cnst db stet.WORD ! dw p.SWITCH.WORD.cnst db stet.spcl.BYTE.ptr ! dw p.SWITCH.BP.cnst db stet.spcl.WORD.ptr ! dw p.SWITCH.WP.cnst db stet.BCD ! dw p.SWITCH.BCD.cnst db stet.spcl.BCD.ptr ! dw p.SWITCH.BCDP.cnst db 0 ! dw p.SWITCH.A.err ; p.SWITCH.A.err: call err.inv.var.type p.SWITCH.BCDP.cnst: call put.LHLD.A jmp p.SWITCH.BCD.cmp ; p.SWITCH.BCD.cnst: call put.LXI.H.A p.SWITCH.BCD.cmp: lxi h,sym.tbl.entry.B call put.inline.BCD call put.LXI.D.B jmp put.cmp.BCD ; p.SWITCH.BYTE.cnst: lda first.switch.flag ora a jnz p.SWITCH.CPI call put.LDA.A p.SWITCH.CPI: lda ste.B.address ora a jz p.SWITCH.CPI.0 ; call put.CPI lda ste.B.address lxi h,switch.end.rng.flag add m call put.code.byte xra a sta switch.end.rng.flag ret ; p.SWITCH.CPI.0: jmp put.ORA.A ; p.SWITCH.BP.cnst: lda first.switch.flag ora a jnz p.SWITCH.CPI call put.LHLD.A call put.MOV.A.M jmp p.SWITCH.CPI ; p.SWITCH.WP.cnst: lda first.switch.flag ora a jnz p.SWITCH.cmp.16 call put.LHLD.A call put.mv.@HL.to.DE lda switch.end.rng.flag mov c,a mvi b,0 xra a sta switch.end.rng.flag lhld ste.B.address dad b call put.LXI.H.hl jmp p.SWITCH.cmp.16 ; ; ; p.SWITCH.WORD.cnst: lda first.switch.flag ora a jnz p.SWITCH.cmp.16 call put.LHLD.A p.SWITCH.cmp.16: lda switch.end.rng.flag mov c,a mvi b,0 xra a sta switch.end.rng.flag lhld ste.B.address dad b call put.LXI.D.hl jmp put.cmp.16 switch.end.rng.flag: db 0 switch.bcd.wk: ds bcd.size ; ; ; ;------------------------------------------------------ ; ; process.TRACEBACK: call chk.strt.code call get.word ; call put.MVI.C lda word.type ani wtp.cnst jz p.TRACEBACK.dflt ; lda cnst.value call put.code.byte call get.word jmp p.TRACEBACK.cont ; p.TRACEBACK.dflt: mvi a,10 call put.code.byte p.TRACEBACK.cont: mvi a,bir.traceback jmp put.bir.call.fwd ; ; ;------------------------------------------------------ ; ; process.UNSTRING: call chk.strt.code call get.word ; call get.var.B.word lda B.word.type ani wtp.string cnz put.inline.B.string ; call switch.B db stet.STRING ! dw p.UNSTRING.src.ok db stet.spcl.string.ptr ! dw p.UNSTRING.src.ok db stet.RECORD ! dw p.UNSTRING.src.ok db 0 ! dw p.UNSTRING.src.err p.UNSTRING.src.err: call err.inv.var.type p.UNSTRING.src.ok: lda rsvd.wd.ix cpi rwix.FROM jz p.UNSTRING.FROM ; ;---no starting location given -- start at front--- ; lxi h,0 call put.LXI.D.hl jmp p.UNSTRING.FROM.end ; p.UNSTRING.FROM: call get.word ; ; p.UNSTRING.FROM.id: call chk.word.id.only call get.var.A.word ; lda A.word.type ani wtp.cnst jnz p.UNSTRING.FROM.cnst ; call switch.A db stet.BYTE ! dw p.UNSTRING.FROM.8 db stet.WORD ! dw p.UNSTRING.FROM.16 db stet.spcl.BYTE.ptr ! dw p.UNSTRING.FROM.BP db stet.spcl.WORD.ptr ! dw p.UNSTRING.FROM.WP db 0 ! dw p.UNSTRING.FROM.err ; p.UNSTRING.FROM.err: call err.inv.var.type p.UNSTRING.FROM.cnst: lhld ste.A.address call put.LXI.D.hl call get.word jmp p.UNSTRING.FROM.end ; p.UNSTRING.FROM.WP: call put.LHLD.A call put.mv.@HL.to.DE jmp p.UNSTRING.FROM.end ; p.UNSTRING.FROM.BP: call put.LHLD.A call put.mv.@HLB.to.DE jmp p.UNSTRING.FROM.end ; p.UNSTRING.FROM.16: call put.LHLD.A call put.XCHG jmp p.UNSTRING.FROM.end ; p.UNSTRING.FROM.8: call put.LHLD.A call put.XCHG call put.MVI.D.0 p.UNSTRING.FROM.end: lda rsvd.wd.ix cpi rwix.TO jz p.UNSTRING.TO ; ;---no ending location given -- end at end of string--- ; lxi h,0ffffh call put.LXI.B.hl jmp p.UNSTRING.TO.end ; p.UNSTRING.TO: call get.word ; p.UNSTRING.TO.id: call chk.word.id.only call get.var.A.word lda A.word.type ani wtp.cnst jnz p.UNSTRING.TO.cnst ; call switch.A db stet.BYTE ! dw p.UNSTRING.TO.8 db stet.WORD ! dw p.UNSTRING.TO.16 db stet.spcl.byte.ptr ! dw p.UNSTRING.TO.BP db stet.spcl.WORD.ptr ! dw p.UNSTRING.TO.WP db 0 ! dw p.UNSTRING.TO.err ; p.UNSTRING.TO.err: call err.inv.var.type p.UNSTRING.TO.cnst: lhld ste.A.address call put.LXI.B.hl call get.word jmp p.UNSTRING.TO.end ; p.UNSTRING.TO.WP: call put.LHLD.A call put.mv.@HL.to.BC jmp p.UNSTRING.TO.end ; p.UNSTRING.TO.BP: call put.LHLD.A call put.mv.@HLB.to.BC jmp p.UNSTRING.TO.end ; p.UNSTRING.TO.16: call put.LHLD.A call put.mv.HL.to.BC jmp p.UNSTRING.TO.end ; p.UNSTRING.TO.8: call put.LHLD.A call put.MOV.C.L call put.MVI.B.0 p.UNSTRING.TO.end: lda rsvd.wd.ix cpi rwix.GIVING jz p.UNSTRING.got.dest ; lxi h,sym.tbl.entry.B lxi d,sym.tbl.entry.A call move.sym.tbl.entry jmp p.UNSTRING.code ; p.UNSTRING.got.dest: call get.word call chk.word.id.only call get.var.A.word p.UNSTRING.code: call switch.A db stet.STRING ! dw p.UNSTRING.S.cont db stet.spcl.string.ptr ! dw p.UNSTRING.SP.cont db 0 ! dw p.UNSTRING.S.err p.UNSTRING.S.err: call err.inv.var.type p.UNSTRING.S.cont: call put.LXI.H.A jmp p.UNSTRING.S.2.cont ; p.UNSTRING.SP.cont: call put.LHLD.A p.UNSTRING.S.2.cont: call put.PUSH.H ; ; lda ste.B.type cpi stet.spcl.string.ptr jz p.UNSTRING.code.SP cpi stet.STRING jnz err.inv.var.type call put.LXI.H.B jmp p.UNSTRING.cont ; p.UNSTRING.code.SP: call put.LHLD.B p.UNSTRING.cont: mvi a,bir.UNSTRING jmp put.bir.call.fwd ; ; ;------------------------------------------------------ ; ; process.WHILE: call chk.strt.code call bump.block.level call opt.undef.all ; lhld curr.code.addr push h ; lhld curr.src.line.num push h ; p.WHILE.AND.lup: call get.word mvi a,0ffh sta fall.thru.true mvi a,0ffh sta no.fall.thru.fwd.flag mvi a,bir.EXITDO sta curr.fwd.no.fall.thru call process.expression ; p.WHILE.compound: call switch.rsvd.wd.ix db rwix.AND ! dw p.WHILE.AND.lup db rwix.OR ! dw p.WHILE.OR db rwix.DO ! dw p.WHILE.DO db rwix.COMMENT ! dw p.WHILE.COMMENT db 0 ! dw p.DO.lup ; p.WHILE.COMMENT: call process.COMMENT jmp p.WHILE.compound ; p.WHILE.DO: call get.word jmp p.DO.lup ; ; p.WHILE.OR: mvi a,bir.WHILE.TRUE call put.bir.jmp.fwd mvi a,bir.EXITDO call fix.up.built.in.rtn jmp p.WHILE.AND.lup ; ;------------------------------------------------------ ; ; process.WORD: call set.byte.boundary call chk.strt.data call get.word ; call switch.rsvd.wd.ix db rwix.POINTER ! dw p.POINTER.WORD db rwix.VALUE ! dw p.WORD.VALUE db rwix.comma ! dw p.WORD.no.VALUE db rwix.semicolon ! dw p.WORD.no.VALUE db 0 ! dw p.WORD.id ; p.WORD.id: call chk.word.id.only call chk.word.not.in.tbl mvi a,stet.WORD sta ste.type lda curr.BIT.posn sta ste.BIT.posn lxi h,2 shld ste.length call put.word.into.tbl call get.word lda rsvd.wd.ix cpi rwix.VALUE jz p.WORD.VALUE p.WORD.no.VALUE: lhld curr.code.addr inx h inx h shld curr.code.addr jmp p.WORD.comma ; p.WORD.VALUE: call get.word lda word.type ani wtp.cnst jnz p.WORD.cnst ; lda rsvd.wd.ix cpi rwix.HIMEM jnz p.WORD.label mvi a,bir.HIMEM call put.fwd.ref.bir call get.word jmp p.WORD.comma ; p.WORD.label: lda word.type ani wtp.ident jz p.WORD.inv.VALUE call lookup.word lhld wk.sym.tbl.addr mov a,m cpi stet.end.tbl jz p.WORD.fwd.ref ; lxi b,(ste.address - ste.type) dad b mov e,m inx h mov d,m jmp p.WORD.put.VALUE ; p.WORD.inv.VALUE: call err.inv.VALUE lhld curr.code.addr inx h inx h shld curr.code.addr call get.word jmp p.WORD.comma ; p.WORD.fwd.ref: mvi a,stet.fwd.ref sta ste.type call put.word.into.tbl lxi h,0 jmp p.WORD.put.VALUE ; p.WORD.cnst: lhld cnst.value p.WORD.put.VALUE: call put.code.word call get.word p.WORD.comma: lda rsvd.wd.ix cpi rwix.comma jz process.WORD ret ; ;------------------------------------------------------ ; ; process.WRITE: call chk.strt.code call get.word call chk.word.id.only call get.var.A.word ; lda ste.A.FILE.device call switch db rwix.CON ! dw p.WRITE.CON db rwix.LST ! dw p.WRITE.LST db rwix.PRN ! dw p.WRITE.LST db rwix.PUN ! dw p.WRITE.PUN db rwix.TTY ! dw p.WRITE.CON db rwix.DISK ! dw p.WRITE.DISK db 0 ! dw p.WRITE.err p.WRITE.err: call err.inv.dev.io p.WRITE.DISK: xra a sta write.lock.flag sta write.unlock.flag ; lda rsvd.wd.ix cpi rwix.LOCK jnz p.WRITE.not.LOCK call get.word lda MPM.flag ora a jz p.WRITE.not.LOCK mvi a,0ffh sta write.lock.flag mov l,a call put.MVI.A.L lxi h,MPM.lock.flag call put.STA.hl ;---if record-mode file - force fresh read--- lda ste.A.FILE.misc.flag ani FILE.c.flag.rec.mode jz p.WRITE.not.LOCK lxi h,0 call put.LXI.H.hl lhld ste.A.address lxi d,fcb.rec.buf.sctr dad d call put.SHLD.hl p.WRITE.not.LOCK: lda rsvd.wd.ix cpi rwix.UNLOCK jnz p.WRITE.not.UNLOCK call get.word lda MPM.flag ora a jz p.WRITE.not.UNLOCK mvi a,0ffh sta write.unlock.flag mov l,a call put.MVI.A.L lxi h,MPM.unlock.flag call put.STA.hl p.WRITE.not.UNLOCK: lda ste.A.FILE.misc.flag ani FILE.c.flag.TEXT jz p.WRITE.not.TEXT ; lhld ste.A.address lxi d,fcb.rec.addr dad d call put.LHLD.hl call put.MOV.A.M call put.LXI.D.A mvi a,bir.dsk.ch.out call put.bir.call.fwd jmp p.WRITE.chk.unlock ; p.WRITE.not.TEXT: lda ste.A.type cpi stet.FILE cnz err.undef.file.name ; call put.LXI.D.A lda ste.A.FILE.misc.flag ani FILE.c.flag.rec.mode jz p.WRITE.not.rec.mode ; mvi a,bir.rec.write jmp p.WRITE.rec.cont ; p.WRITE.not.rec.mode: call put.MVI.C lda ste.A.FILE.misc.flag ani FILE.c.flag.RANDOM mvi a,34 ;write rnd jnz p.WRITE.RANDOM mvi a,21 ;write seq p.WRITE.RANDOM: call put.code.byte ; mvi a,bir.disk.sctr.io p.WRITE.rec.cont: call put.bir.call.fwd ; lda rsvd.wd.ix cpi rwix.ERROR jz p.WRITE.ERROR cpi rwix.EOF jnz p.WRITE.chk.unlock ; p.WRITE.ERROR: call put.ORA.A call get.word lda rsvd.wd.ix cpi rwix.STANDARD jz p.WRITE.err.STANDARD ; call put.JZ mvi a,bir.WRITE.fwd call put.fwd.ref.bir ; call process.a.statement ; mvi a,bir.WRITE.fwd call fix.up.built.in.rtn jmp p.WRITE.chk.unlock ; p.WRITE.err.STANDARD: call put.CNZ mvi a,bir.write.error call put.fwd.ref.bir call get.word ; p.WRITE.chk.unlock: lda write.unlock.flag ora a jz p.WRITE.chk.lock mvi l,0 call put.MVI.A.L lxi h,MPM.unlock.flag call put.STA.hl p.WRITE.chk.lock: lda write.lock.flag ora a rz ;exit mvi l,0 call put.MVI.A.L lxi h,MPM.lock.flag jmp put.STA.hl ; write.lock.flag: db 0 write.unlock.flag: db 0 ; ;-----------NON-DISK DEVICES----------- ; ; p.WRITE.CON: call p.WRITE.prefix mvi a,2 jmp p.WRITE.postfix ; p.WRITE.PUN: call p.WRITE.prefix mvi a,4 jmp p.WRITE.postfix ; p.WRITE.LST: call p.WRITE.prefix mvi a,5 jmp p.WRITE.postfix ; ; p.WRITE.prefix: lhld ste.A.address lxi d,fcb.rec.addr dad d call put.LHLD.HL call put.MOV.E.M jmp put.MVI.C ; ; p.WRITE.postfix: call put.code.byte jmp put.CALL.ENTRY ; ; ; ; ; ; ; ;------------------------------------------------------ ; end of statement-compilation routine ;------------------------------------------------------ ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;------------------------------------------------------ ; expression evaluation routine ; (currently only handles simple expressions) ;------------------------------------------------------ ; ; ; ; process.expression: call chk.strt.code ; call switch.rsvd.wd.ix db rwix.eql ! dw pe.eql db rwix.neq ! dw pe.neq db rwix.lss ! dw pe.lss db rwix.gtr ! dw pe.gtr db rwix.leq ! dw pe.leq db rwix.geq ! dw pe.geq db rwix.COMMENT ! dw pe.start.COMMENT db 0 ! dw pe.not.oprtr.only ; pe.start.COMMENT: call process.COMMENT jmp process.expression ; pe.not.oprtr.only: call get.var.A.word lda ste.A.type cpi stet.BIT jz pe.BIT lda word.type ani wtp.oprtr jnz pe.two.operands ; ; lda A.word.type ani wtp.cnst jnz pe.cnst.only ; lda A.word.type ani wtp.string jnz pe.lit.str.only ; call switch.A db stet.BYTE ! dw pe.BYTE.only db stet.WORD ! dw pe.WORD.only db stet.spcl.byte.ptr ! dw pe.BP.only db stet.spcl.word.ptr ! dw pe.WP.only db stet.BCD ! dw pe.BCD.only db stet.spcl.BCD.ptr ! dw pe.BCDP.only db stet.STRING ! dw pe.STRING.only db stet.spcl.string.ptr ! dw pe.SP.only db stet.FIELD ! dw pe.FIELD.only db 0 ! dw pe.one.op.err pe.one.op.err: call err.inv.oprnd pe.two.operands: lda rsvd.wd.ix sta curr.expr.oprtr call get.word call get.var.B.word ; pe.two.ops.entry: lda A.word.type ani wtp.cnst jnz pe.cnst.x ; lda A.word.type ani wtp.string jnz pe.general.string ; call switch.A db stet.BYTE ! dw pe.BYTE.x db stet.WORD ! dw pe.general.16 db stet.spcl.byte.ptr ! dw pe.BP.x db stet.spcl.WORD.ptr ! dw pe.general.16 db stet.BCD ! dw pe.general.BCD db stet.spcl.BCD.ptr ! dw pe.general.BCD db stet.STRING ! dw pe.general.string db stet.spcl.string.ptr ! dw pe.general.string db stet.RECORD ! dw pe.RECORD.x db stet.FIELD ! dw pe.FIELD.x db 0 ! dw pe.two.ops.err pe.two.ops.err: call err.inv.oprnd ; ; ;----- condition-code expression----- ; ; pe.eql: jmp put.JZ.true pe.neq: jmp put.JNZ.true pe.lss: jmp put.JC.true pe.geq: jmp put.JNC.true ; pe.gtr: call fall.thru.swap pe.leq: call put.JZ.true jmp put.JC.true ; ; ; ;----------BIT expression----------- ; ; pe.BIT: call put.LDA.A lhld ste.A.BIT.posn call put.ANI.L jmp put.JNZ.true ; ;----------------------------------- ; pe.TRUE: lda fall.thru.true ora a rnz call put.JMP jmp put.expr.jmp.addr ; ;----------------------------------- ; pe.FALSE: lda fall.thru.true ora a rz call put.JMP jmp put.expr.jmp.addr ; ;----------------------------------- ; pe.STRING.only: jmp pe.BYTE.only ;if null ; ;----------------------------------- ; pe.BCD.only: pe.BCDP.only: mvi a,rwix.neq sta curr.expr.oprtr mvi a,wtp.cnst sta B.word.type lxi h,0 shld ste.B.address lxi h,'0' shld ste.B.name jmp pe.two.ops.entry ; ;----------------------------------- ; pe.FIELD.only: mvi a,rwix.neq sta curr.expr.oprtr mvi a,wtp.string sta B.word.type lxi h,0 shld ste.B.address lxi h,' ' shld ste.B.name jmp pe.two.ops.entry ; ;------------------------------------- ; pe.BP.only: call put.LHLD.A call put.MOV.A.M call put.ORA.A jmp put.JNZ.true ; ;----------------------------------- ; pe.WP.only: call put.LHLD.A call put.MOV.A.M call put.INX.H call put.ORA.M jmp put.JNZ.true ; ;----------------------------------- ; pe.cnst.only: lhld cnst.value pe.cnst.16.bit: mov a,h ora l jnz pe.TRUE jmp pe.FALSE ; ;----------------------------------- ; pe.lit.str.only: lda word ora a jz pe.FALSE jmp pe.TRUE ; ;----------------------------------- ; pe.SP.only: jmp pe.BP.only ; ;----------------------------------- ; pe.cnst.x: lda B.word.type ani wtp.cnst jnz pe.cnst.cnst ; lda B.word.type ani wtp.string jnz pe.general.string ; call switch.B db stet.BYTE ! dw pe.cnst.BYTE db stet.WORD ! dw pe.general.16 db stet.spcl.BYTE.ptr ! dw pe.general.8 db stet.spcl.WORD.ptr ! dw pe.general.16 db stet.BCD ! dw pe.general.BCD db stet.spcl.BCD.ptr ! dw pe.general.BCD db stet.string ! dw pe.general.string db stet.spcl.string.ptr ! dw pe.general.string db 0 ! dw pe.cnst.err pe.cnst.err: call err.inv.oprnd ; ;----------------------------------- ; pe.RECORD.x: pe.FIELD.x: lda B.word.type ani wtp.string cnz put.inline.B.string ;--check < 256 bytes--- lda ste.A.length + 1 mov b,a lda ste.B.length + 1 ora b cnz err.truncate ; call switch.B db stet.FIELD ! dw pe.FIELD.FIELD db stet.RECORD ! dw pe.FIELD.FIELD db stet.string ! dw pe.FIELD.STRING db stet.spcl.string.ptr ! dw pe.FIELD.SP db 0 ! dw pe.FIELD.err pe.FIELD.err: call err.inv.var.type pe.FIELD.FIELD: call switch.expr.oprtr db rwix.leq ! dw pe.ff.swap db rwix.gtr ! dw pe.ff.swap db 0 ! dw pe.ff.no.swap pe.ff.swap: call swap.curr.expr pe.ff.no.swap: call put.LXI.H.B call put.LXI.D.A lda ste.B.length mov l,a lda ste.A.length mov h,a call put.LXI.B.hl mvi a,bir.cmp.field call put.bir.call.fwd jmp pe.str.rec.oprtr ; pe.FIELD.SP: call put.LHLD.B jmp pe.FIELD.str.cont pe.FIELD.STRING: call put.LXI.H.B pe.FIELD.str.cont: call put.LXI.D.A call put.MVI.C lda ste.A.length pe.FIELD.STR.entry: call put.code.byte mvi a,bir.cmp.field.2.str call put.bir.call.fwd call switch.expr.oprtr db rwix.eql ! dw pe.STR.REC.oprtr db rwix.neq ! dw pe.STR.REC.oprtr db 0 ! dw err.inv.oprtr ; pe.STRING.FIELD: call put.LXI.H.A call put.LXI.D.B call put.MVI.C lda ste.B.length jmp pe.FIELD.STR.entry ; ;----------------------------------- ; pe.BP.x: pe.BYTE.x: call switch.B db stet.WORD ! dw pe.general.16 db stet.spcl.word.ptr ! dw pe.general.16 db 0 ! dw pe.general.8 ; ;----------------------------------- ; pe.cnst.cnst: lhld ste.A.address xchg lhld ste.B.address lda curr.expr.oprtr cpi rwix.eql jnz pe.c.c.not.eql ; call cmp.de.fm.hl jz pe.TRUE jmp pe.FALSE ; pe.c.c.not.eql: cpi rwix.neq jnz pe.c.c.not.neq ; call cmp.de.fm.hl jnz pe.TRUE JMP pe.FALSE ; pe.c.c.not.neq: cpi rwix.gtr jnz pe.c.c.not.gtr ; call cmp.de.fm.hl jc pe.TRUE jmp pe.FALSE ; pe.c.c.not.gtr: cpi rwix.geq jnz pe.c.c.not.geq ; call cmp.hl.fm.de jc pe.FALSE jmp pe.TRUE ; pe.c.c.not.geq: cpi rwix.lss jnz pe.c.c.not.lss ; call cmp.de.fm.hl jc pe.FALSE jmp pe.TRUE ; pe.c.c.not.lss: cpi rwix.leq jnz pe.c.c.not.leq ; call cmp.hl.fm.de jc pe.TRUE jmp pe.FALSE ; pe.c.c.not.leq: cpi rwix.AND jnz pe.c.c.not.AND ; call AND.d.and.h jmp pe.cnst.16.bit ; pe.c.c.not.AND: cpi rwix.OR jnz pe.c.c.not.OR ; call OR.d.and.h jmp pe.cnst.16.bit ; pe.c.c.not.OR: cpi rwix.XOR jnz pe.c.c.not.XOR ; call XOR.d.and.h jmp pe.cnst.16.bit ; pe.c.c.not.XOR: jmp err.inv.oprtr ; ;------------------------------ ; pe.cnst.BYTE: lda curr.expr.oprtr cpi rwix.eql jz pe.cnst.BYTE.ok cpi rwix.neq jnz pe.cnst.BYTE.reject pe.cnst.BYTE.ok: lda ste.A.address ora a jz pe.0.BYTE dcr a jz pe.1.BYTE inr a inr a jz pe.ff.byte jmp pe.cnst.BYTE.reject ; pe.0.BYTE: call put.LDA.B call put.ORA.A jmp pe.cnst.BYTE.cont ; pe.1.BYTE: call put.LDA.B call put.DCR.A jmp pe.cnst.BYTE.cont ; pe.ff.BYTE: call put.LDA.B call put.INR.A pe.cnst.BYTE.cont: lda curr.expr.oprtr cpi rwix.neq jz put.JNZ.true jmp put.JZ.true ; ;----------------------------------- ; pe.general.8: lda A.word.type ani wtp.cnst jnz pe.cnst.BYTE pe.cnst.BYTE.reject: call switch.expr.oprtr db rwix.neq ! dw pe.g8.neq db rwix.leq ! dw pe.g8.leq db rwix.lss ! dw pe.g8.lss db rwix.eql ! dw pe.g8.eql db rwix.gtr ! dw pe.g8.gtr db rwix.geq ! dw pe.g8.geq db rwix.AND ! dw pe.g8.AND db rwix.OR ! dw pe.g8.OR db rwix.XOR ! dw pe.g8.XOR db 0 ! dw pe.g8.oprtr.err pe.g8.oprtr.err: call err.inv.oprtr ; ; pe.g8.neq: call fall.thru.swap pe.g8.eql: call pe.g8.get.A lda B.word.type ani wtp.cnst jz pe.g8.eql.go ; lda ste.B.address ora a jz pe.g8.eql.0 dcr a jz pe.g8.eql.1 inr a inr a jz pe.g8.eql.ff ; pe.g8.eql.go: call pe.g8.cmp.B jmp put.JZ.true ; pe.g8.eql.0: call put.ORA.A jmp put.JZ.true ; pe.g8.eql.1: call put.DCR.A jmp put.JZ.true ; pe.g8.eql.ff: call put.INR.A jmp put.JZ.true ; pe.g8.lss: call fall.thru.swap pe.g8.geq: call pe.g8.get.A call pe.g8.cmp.B jmp put.JNC.true ; ; pe.g8.leq: call fall.thru.swap pe.g8.gtr: call swap.curr.expr call pe.g8.get.A call pe.g8.cmp.B jmp put.JC.true ; ; ; ;----------------------------------- ; ; pe.g8.get.A: lda A.word.type ani wtp.cnst jnz put.MVI.A.A ; lda ste.A.type cpi stet.BYTE jz put.LDA.A ; cpi stet.spcl.byte.ptr cnz err.inv.var.type call put.LHLD.A jmp put.MOV.A.M ; ; pe.g8.cmp.B: lda B.word.type ani wtp.cnst jnz put.CPI.B ; lda ste.B.type cpi stet.BYTE jz pe.g8.cmp.B.BYTE cpi stet.spcl.byte.ptr jz pe.g8.cmp.B.BP call err.inv.var.type ; pe.g8.cmp.B.BYTE: call put.LXI.H.B jmp put.CMP.M ; pe.g8.cmp.B.BP: call put.LHLD.B jmp put.CMP.M ; ;----------------------------------- ; pe.g8.AND: call pe.g8.get.A ; lda B.word.type ani wtp.cnst jnz pe.g8.AND.cnst ; lda ste.B.type cpi stet.BYTE jz pe.g8.AND.BYTE cpi stet.spcl.byte.ptr jz pe.g8.AND.BP call err.inv.var.type ; pe.g8.AND.cnst: call put.ANI.B jmp put.JNZ.true ; pe.g8.AND.BYTE: call put.LXI.H.B call put.ANA.M jmp put.JNZ.true ; pe.g8.AND.BP: call put.LHLD.B call put.ANA.M jmp put.JNZ.true ; ; ; pe.g8.OR: call pe.g8.get.A ; lda B.word.type ani wtp.cnst jnz pe.g8.OR.cnst ; lda ste.B.type cpi stet.BYTE jz pe.g8.OR.BYTE cpi stet.spcl.byte.ptr jz pe.g8.OR.BP call err.inv.var.type ; ; pe.g8.OR.cnst: call put.ORI.B jmp put.JNZ.true ; ; pe.g8.OR.BYTE: call put.LXI.H.B call put.ORA.M jmp put.JNZ.true ; ; pe.g8.OR.BP: call put.LHLD.B call put.ORA.M jmp put.JNZ.true ; ; ; ; ; pe.g8.XOR: call pe.g8.get.A ; lda B.word.type ani wtp.cnst jnz pe.g8.XOR.cnst ; lda ste.B.type cpi stet.BYTE jz pe.g8.XOR.BYTE cpi stet.spcl.byte.ptr jz pe.g8.XOR.BP call err.inv.var.type ; ; pe.g8.XOR.cnst: call put.XRI.B jmp put.JNZ.true ; ; pe.g8.XOR.BYTE: call put.LXI.H.B call put.XRA.M jmp put.JNZ.true ; ; pe.g8.XOR.BP: call put.LHLD.B call put.XRA.M jmp put.JNZ.true ; ; ; ; ;----------------------------------- ; ; ; pe.general.16: lda A.word.type ;if one is cnst, make it B ani wtp.cnst jnz pe.g16.swap lda curr.expr.oprtr cpi rwix.gtr jz pe.g16.swap cpi rwix.leq jnz pe.g16.no.swap pe.g16.swap: call swap.curr.expr pe.g16.no.swap: lda B.word.type ani wtp.cnst jnz pe.g16.B.cnst ; call switch.B db stet.BYTE ! dw pe.g16.B.BYTE db stet.WORD ! dw pe.g16.B.WORD db stet.spcl.byte.ptr ! dw pe.g16.B.BP db stet.spcl.word.ptr ! dw pe.g16.B.WP db 0 ! dw pe.g16.B.err ; pe.g16.B.err: call err.inv.var.type ; pe.g16.B.BYTE: pe.g16.B.WORD: call put.get.B.into.HL call put.XCHG jmp pe.g16.got.B ; ; ;-----one operand is constant - check if zero----- pe.g16.B.cnst: lhld ste.B.address mov a,h ora l jnz pe.g16.B.not.0.cnst ;---it's zero - check operation--- call switch.expr.oprtr db rwix.AND ! dw pe.FALSE db rwix.gtr ! dw pe.FALSE db rwix.geq ! dw pe.TRUE db 0 ! dw pe.cnst.eval pe.cnst.eval: ;---some kind of evaluation needs to be done--- call put.get.A.into.HL call put.MOV.A.H call put.ORA.L call switch.expr.oprtr db rwix.leq ! dw put.JZ.true db rwix.eql ! dw put.JZ.true db rwix.neq ! dw put.JNZ.true db rwix.XOR ! dw put.JNZ.true db rwix.OR ! dw put.JNZ.true db 0 ! dw err.inv.oprtr ; pe.g16.B.not.0.cnst: call put.LXI.D.B jmp pe.g16.got.B ; ; pe.g16.B.BP: call put.LHLD.B call put.mv.@HLB.to.DE jmp pe.g16.got.B ; ; pe.g16.B.WP: call put.LHLD.B call put.mv.@HL.to.DE ; ; pe.g16.got.B: call put.get.A.into.HL lda curr.expr.oprtr cpi rwix.AND jz pe.g16.AND cpi rwix.OR jz pe.g16.OR cpi rwix.XOR jz pe.g16.XOR ; call put.cmp.16 ; call switch.expr.oprtr db rwix.lss ! dw pe.g16.lss db rwix.eql ! dw pe.g16.eql db rwix.neq ! dw pe.g16.neq db rwix.geq ! dw pe.g16.geq db 0 ! dw pe.g16.oprtr.err pe.g16.oprtr.err: ; ; gtr & leq already converted call err.inv.oprtr ; ; pe.g16.lss: jmp put.JC.true ; pe.g16.eql: jmp put.JZ.true ; pe.g16.neq: jmp put.JNZ.true ; pe.g16.geq: jmp put.JNC.true ; ; pe.g16.AND: call put.AND.16 jmp put.JNZ.true ; ; pe.g16.OR: call put.OR.16 jmp put.JNZ.true ; ; pe.g16.XOR: call put.XOR.16 jmp put.JNZ.true ; ; ; ;----------------------------------- ; pe.general.string: call switch.expr.oprtr db rwix.leq ! dw pe.gs.swap db rwix.gtr ! dw pe.gs.swap db 0 ! dw pe.gs.no.swap pe.gs.swap: call swap.curr.expr pe.gs.no.swap: lda ste.B.type cpi stet.FIELD jz pe.STRING.FIELD ; lda A.word.type ani wtp.string cnz put.inline.A.string ; call switch.A db stet.STRING ! dw pe.gs.A.str db stet.spcl.string.ptr ! dw pe.gs.A.SP db stet.FIELD ! dw pe.STRING.FIELD db 0 ! dw pe.gs.A.err pe.gs.A.err: call err.inv.var.type pe.gs.A.str: call put.LXI.D.A jmp pe.gs.got.A ; ; pe.gs.A.SP: call put.LHLD.A call put.XCHG ; ; pe.gs.got.A: ;---check for LENGTH--- xra a sta pe.gs.blk.cmp lda rsvd.wd.ix cpi rwix.LENGTH jnz pe.GS.no.length ; call get.word call get.var.C.word mvi a,0ffh sta pe.gs.blk.cmp lda C.word.type ani wtp.cnst jz pe.gs.C.not.cnst call put.LXI.B.C jmp pe.gs.no.length ; pe.gs.C.not.cnst: call put.get.C.into.HL call put.mv.HL.to.BC ; pe.gs.no.length: lda B.word.type ani wtp.string cnz put.inline.B.string ; call switch.B db stet.STRING ! dw pe.gs.B.str db stet.spcl.string.ptr ! dw pe.gs.B.sp db 0 ! dw pe.gs.B.err pe.gs.B.err: call err.inv.var.type pe.gs.B.str: call put.LXI.H.B jmp pe.gs.got.B ; ; pe.gs.B.SP: call put.LHLD.B jmp pe.gs.got.B ; ; ; pe.gs.got.B: lda pe.gs.blk.cmp ora a jz pe.gs.str.cmp call put.cmp.blk jmp pe.STR.REC.oprtr ; pe.gs.str.cmp: call put.cmp.str ; pe.STR.REC.oprtr: call switch.expr.oprtr db rwix.lss ! dw put.JC.true db rwix.eql ! dw put.JZ.true db rwix.neq ! dw put.JNZ.true db rwix.geq ! dw put.JNC.true db 0 ! dw err.inv.oprtr ; ; ; ; pe.gs.blk.cmp: db 0 ; ; ; ; ;----------------------------------- ; pe.general.BCD: call switch.expr.oprtr db rwix.leq ! dw pe.gBCD.swap db rwix.gtr ! dw pe.gBCD.swap db 0 ! dw pe.gBCD.no.swap pe.gBCD.swap: call swap.curr.expr pe.gBCD.no.swap: lda A.word.type ani wtp.cnst lxi h,sym.tbl.entry.A cnz put.inline.BCD ; call switch.A db stet.BCD ! dw pe.gBCD.A.BCD db stet.spcl.BCD.ptr ! dw pe.gBCD.A.BCDP db 0 ! dw pe.gBCD.A.err pe.gBCD.A.err: call err.inv.var.type pe.gBCD.A.BCD: call put.LXI.D.A jmp pe.gBCD.got.A ; ; pe.gBCD.A.BCDP: call put.LHLD.A call put.XCHG jmp pe.gBCD.got.A ; ; ; pe.gBCD.got.A: lda B.word.type ani wtp.cnst lxi h,sym.tbl.entry.B cnz put.inline.BCD ; call switch.B db stet.BCD ! dw pe.gBCD.B.BCD db stet.spcl.BCD.ptr ! dw pe.gBCD.B.BCDP db 0 ! dw pe.gBCD.B.err pe.gBCD.B.err: call err.inv.var.type pe.gBCD.B.BCD: call put.LXI.H.B jmp pe.gBCD.got.B ; ; pe.gBCD.B.BCDP: call put.LHLD.B jmp pe.gBCD.got.B ; ; ; pe.gBCD.got.B: call put.cmp.BCD ; call switch.expr.oprtr db rwix.lss ! dw put.JC.true db rwix.eql ! dw put.JZ.true db rwix.neq ! dw put.JNZ.true db rwix.geq ! dw put.JNC.true db 0 ! dw err.inv.oprtr ; ; ; ;----------------------------------- ; ; pe.BYTE.only: call put.LDA.A call put.ORA.A jmp put.JNZ.true ; ; ; ;----------------------------------- ; ; ; put.JNZ.true: call fall.thru.swap ; ; put.JZ.true: lda fall.thru.true ora a jnz put.JZ.true.swapped call put.JZ jmp put.expr.jmp.addr put.JZ.true.swapped: call put.JNZ put.expr.jmp.addr: lda no.fall.thru.fwd.flag ora a jnz put.jmp.addr.fwd lhld no.fall.thru.addr jmp put.code.word ; put.jmp.addr.fwd: lda curr.fwd.no.fall.thru jmp put.fwd.ref.bir ; ; put.JC.true: lda fall.thru.true ora a jnz put.JC.true.swapped call put.JC jmp put.expr.jmp.addr put.JC.true.swapped: call put.JNC jmp put.expr.jmp.addr ; ; put.JNC.true: call fall.thru.swap jmp put.JC.true ; ; ; ; ;----------------------------------- ; ; ; pe.WORD.only: call put.LHLD.A call put.MOV.A.L call put.ORA.H jmp put.JNZ.true ; ; ; ;----------------------------------- ; ; ; swap.curr.expr: lxi h,sym.tbl.entry.A lxi d,symbol.table.entry call move.sym.tbl.entry ; lxi h,sym.tbl.entry.B lxi d,sym.tbl.entry.A call move.sym.tbl.entry ; lxi h,symbol.table.entry lxi d,sym.tbl.entry.B call move.sym.tbl.entry ; lda A.word.type mov b,a lda B.word.type sta A.word.type mov a,b sta B.word.type ; call switch.expr.oprtr db rwix.gtr ! dw sce.lss db rwix.geq ! dw sce.leq db rwix.lss ! dw sce.gtr db rwix.leq ! dw sce.geq db 0 ! dw sce.null ; sce.lss: mvi a,rwix.lss jmp sce.exit ; sce.leq: mvi a,rwix.leq jmp sce.exit ; sce.geq: mvi a,rwix.geq jmp sce.exit ; sce.gtr: mvi a,rwix.gtr sce.exit: sta curr.expr.oprtr sce.null: ret ; ; ; ; ; fall.thru.swap: lda fall.thru.true cma sta fall.thru.true ret ; ; ; ; ; ; ; ; ; ; ; ; ;---------END OF 'LSTMT.ASM' SOURCE-CODE SEGMENT---------