.title getl .list me .ident /03apr4/ .mcall (at)always,ch.mne,st.flg .globl ..z, sdebug .mcall (at)zap always ch.mne st.flg .mcall (at)sdebug,ndebug .mcall (at)xmit,param,error .mcall (at)genedt,gencnd,setnz .mcall (at)search,scanw .globl lcbegl, linend, lcendl .globl cdrsav .globl linnum, seqend, pagnum, pagext, ffcnt .globl lppcnt .globl stmnt .globl cndwrd, lsybas, lc.cnd, lsbset .globl xctlin .globl secrol, cndrol, lsyrol, symrol .globl srcchn, smlchn .globl crfdef, crfref .globl clcfgs, clcloc, clcmax .globl clcnam, clcsec, cpopj .globl flags, getchr, getnb, getsym .globl lsrch, mode .globl sector, setnb .globl setsec, setxpr .globl symbol, tstarg, value .globl smllvl, msbmrp, getmch .globl edmask, ed.cdr, ed.lc, ed.lsb ;globals defined in assembler .if ndf xswit .globl absexp, chrpnt, pass .endc .globl savreg, xmit0 .globl linbuf .globl gsarg ;globals defined in mcexec .globl getic, io.eof, io.eoi, io.err .globl argcnt, cndmex .globl endflg .globl getlin, lblend, lcendl, lcflag .globl lcmask, lsgbas .globl u.flag , mac.er, macdfn xitsec ;start in default sector getlin: ;get an input line call savreg getl01: call xctlin ;init line-oriented variables mov ffcnt,r0 ;any reserved ff's? beq 2$ ; no add r0,pagnum ;yes, update page number mov #-1,pagext clr ffcnt .if ndf xlcseq clr linnum ;init new cref sequence clr seqend .endc tst pass beq 2$ clr lppcnt 2$: .if ndf xsml mov #-1,r4 ;assume in sysmac mov #smlchn,r0 tst smllvl ;true? bne 4$ ; yes .endc clr r4 ;no, assume physical input mov #srcchn,r0 .if ndf xmacro mov msbmrp,r1 ;fetch pointer beq 4$ ;zero means not in macro inc r4 ;make it a one 4$: asl r4 ;double for indexing .endc mov #linbuf,r2 mov r2,lcbegl ;set up beginning mov r2,chrpnt mov #linend,lcendl ; and end of line markers ;fall through getl10: ;char loop call @getltb(r4) ;call proper routine bic #200,r5 ;clear sign bit beq getl10 ;ignore if null bmi 25$ ;special if sign bit set cmp r5,#40 ;less than space? blo 20$ ; yes cmp r5,#140 ;good guy as is? blo 14$ ; yes beq 22$ ;illegal cmp r5,#172 ;lower case? bhi 22$ ; no, probably illegal .if ndf xedlc bit #ed.lc,edmask ;lower case enabled? beq 14$ ; yes, leave alone .endc sub #40,r5 ;convert lower to upper case 14$: movb r5,(r2)+ ;store in linbuf cmp r2,#linend ;overflow? blo getl10 ; no tstb -(r2) ;yes, move back one 16$: ;flag line error error 12,l, br getl10 20$: cmp r5,#tab ;<40, check specials beq 14$ ;ok as is cmp r5,#lf beq getl40 ;eol cmp r5,#vt ;vertical tab? beq 32$ ; yes (special) cmp r5,#ff bne 23$ tst u.flag beq 30$ ; -u flag not in effect: pay heed to form feeds mov #40,r5 ; flag in effect: convert ^L into space br 14$ 23$: cmp r5,#cr beq getl10 ;ignore carriage returns 22$: cmp r5,#177 ;rubout? beq getl10 ; yes, ignore 24$: ; error 13,i, bis #200,r5 ;flag for qm on listing br 14$ 25$: bit r5,#io.eoi ;end of input? bne 34$ ; yes bit r5,#io.err ;error? bne 16$ ; yes ;no, assume eof and fall through 30$: .if ndf xmacro tst r4 ;reading from source? bne 32$ ; no inc ffcnt ;yes, bump page count add pagnum,ffcnt+2 .endc 32$: cmp r2,#linbuf ;first char? bne getl40 ; no jmp getl01 ;yes, reprocess line 34$: tst macdfn bne 35$ error 14,e,<.end not found> ;end of input, br 36$ 35$: error 140,e, 36$: inc endflg ; missed .end statement getl40: clrb (r2) mov #linbuf,..z call sdebug .if ndf xmacro tst r4 bne 41$ .endc .if ndf xlcseq inc linnum ;bump line number .globl fileln inc fileln ;bump true line number .endc 41$: .if ndf xedcdr movb linbuf+72.,cdrsav ;save column 73 bit #ed.cdr,edmask ;card reader type? bne 42$ ; no clrb linbuf+72. ;yes, force eol 42$: .endc mov endflg,r0 ;return with "endflg" as argument jmp setnb ;return pointing at first non-blank entsec dpure ;input mode jump table .if ndf xsml .word getic ;sysmac same as regular source .endc getltb: .word getic ;get input character .if ndf xmacro .word getmch ;get macro character .endc entsec imppas endflg: .blkw ;set non-zero on end lppcnt: .blkw 1 ;force new page when negative ffcnt: .blkw 2 ;unprocessed ff count pagext: .blkw 1 ;page number extension .if ndf xlcseq seqend: .blkw 1 .endc xitsec .iif ndf xedlc, genedt lc ;lower case setsec: clr r0 bisb sector,r0 ; imuli rs.sec*2,r0 ;multiply by bytes/block mov r0,-(sp) asl r0 asl r0 add (sp)+,r0 asl r0 add <^pl rolbas>+secrol,r0 ;compute base of sector roll mov (r0)+,symbol ;xfer sector name to symbol mov (r0)+,symbol+2 return .sbttl conditionals .globl iif iif: ;immediate handlers call tcon ;test argument tst r3 bmi 3$ ; branch if unsatisfied cmp #ch.com,r5 ;comma? bne 1$ ; no call getchr ;yes, bypass 1$: mov chrpnt,r1 ;save current location call setnb ;set to nom-blank bit #lc.cnd,lcmask ;conditional suppression? beq 2$ ; no mov r1,lcbegl ;yes, suppress all up to comma 2$: clr argcnt jmp stmnt ;back to statement 3$: clr r5 ;false, but no "q" error br endcx ;concatenated conditionals .irp arg, .globl if'arg if'arg: .endm mov symbol+2,symbol ;treat second half as argument call tconf ;examine it br if1 ;into the main stream .globl if, ift, iff, iftf, endc if: ;micro-programmmed conditional call tcon ;test argument if1: mov #cndlvl,r1 ;point to level cmp (r1),#15. ;room for another? bgt ifoer1 ; no, error inc (r1) ;yes, bump level asl r3 ;set carry to true (0) or false (1) ror -(r1) ;rotate into cndmsk asl r3 ror -(r1) ;ditto for cndwrd br endcx ift: ;if true sub-conditional mov cndmsk,r3 ;get current br iftf ; and branch iff: ;if false sub-conditional mov cndmsk,r3 ;get current condition com r3 ;use complement and fall through iftf: ;unconditional sub-conditional ;(r3=0 when called directly) tst cndlvl ;conditional in progress? ble ifoerr ; no, error asl cndwrd ;move off current flag asl r3 ;set carry ror cndwrd ;mov on br endcx endc: ;end of conditional mov #cndlvl,r1 ;point to level tst (r1) ;in conditional? ble ifoerr ; no, error dec (r1) ;yes, decrement asl -(r1) ;reduce mask asl -(r1) ; and test word endcx: bit #lc.cnd,lcmask ;suppression requested? beq 2$ ; no mov lblend,r0 ;yes, any label? beq 1$ ; no, suppress whole line mov r0,lcendl ;yes, list only label br 2$ 1$: bis #lc.cnd,lcflag ;mark conditional 2$: return ifoerr: error 15,o, ;condition error return ifoer1: error 16,o, return tcon: ;test condition call gsarg ;get a symbol tconf: scanw cndrol ;scan for argument beq 7$ ; error if not found mov symbol+2,r1 ;get address asr r1 ;low bit used for toggle flag sbc r3 ;r3 goes to -1 if odd asl r1 ;back to normal (and even) tst cndwrd ;already unsat? bne tcon8 ; yes, just exit call tstarg ;bypass comma jmp @r1 ;jump to handler 7$: error 17,a, tcon8: clr r5 ;no "q" error return gencnd eq, tconeq gencnd ne, tconeq, f gencnd z, tconeq gencnd nz, tconeq, f gencnd gt, tcongt gencnd le, tcongt, f gencnd g, tcongt gencnd lt, tconlt gencnd ge, tconlt, f gencnd l, tconlt gencnd df, tcondf gencnd ndf, tcondf, f tconeq: call absexp ;eq/ne, test expression beq tcontr ;branch if sat tconfa: com r3 ; false, toggle tcontr: return ;true, just exit tcongt: call absexp bgt tcontr br tconfa tconlt: call absexp blt tcontr br tconfa tcondf: ;if/idf mov r3,r1 ;save initial condition clr r2 ;set "&" clr r3 ;start off true 1$: call getsym ;get a symbol beq 8$ ; undefined if not a sym search symrol ;search user symbol table call crfref clr r0 ;assume defined bit #defflg,mode ;good guess? bne 2$ ; yes 8$: com r0 ;no, toggle 2$: cmp r0,r3 ;yes, match? beq 3$ ; yes, all set mov r2,r3 ; no com r3 3$: mov r1,r2 ;assume "&" cmp r5,#ch.and ; "&" beq 4$ ; branch if good guess cmp r5,#ch.ior ;perhaps or? bne 5$ ; no com r2 ;yes, toggle mode 4$: call getnb ;bypass op br 1$ ;try again 5$: tst r1 ;ifdf? beq 6$ ; yes com r3 ;no, toggle 6$: return entsec imppas ;conditional storage (must be ordered) cndwrd: .blkw ;test word cndmsk: .blkw ;condition mask cndlvl: .blkw ;nesting level cndmex: .blkw ;mexit flag xitsec .sbttl roll handlers .if ndf xedlsb lsrch: ;local symbol search tst lsyflg ;flag set? beq 1$ ; no clr lsyflg ;yes, clear it inc lsybkn ;bump block number 1$: mov #symbol,r0 mov lsybkn,(r0)+ ;move into "symbol" mov value,(r0) .if ndf rsx11d beq 2$ ;error if zero cmp (r0),#^d127 blos lsrch3 .iff bne lsrch3 .endc 2$: error 18,t, ;yes, flag error lsrch3: search lsyrol ;search the roll return entsec imppas lsyflg: .blkw ;bumped at "label:" lsybkn: .blkw ;block number lsybas: .blkw ;section base lsgbas: .blkw ;base for generated symbols xitsec genedt lsb,lsbtst ;local symbol block .enabl lsb lsbtst: bne 2$ ;bypass if /ds br 1$ lsbset: bit #ed.lsb,edmask ;in lsb over-ride? beq 2$ ; yes 1$: inc lsyflg ;flag new block mov clcloc,lsybas ;set new base bic #1,lsybas ;be sure its even clr lsgbas ;clear generated symbol base 2$: return .dsabl lsb .endc .sbttl utilities setxpr: ;set expression registers mov #symbol,r1 mov #sector,r2 mov #mode,r3 mov #value,r4 return .end