.title lout .ident /10may4/ .mcall (at)always,ch.mne,st.flg,ct.mne .mcall (at)bisbic always ch.mne st.flg ct.mne .mcall (at)xmit,param,putlp .macro putlin addr ;use listing flags .if dif mov addr,r0 .endc call putlin .endm .mcall (at)genswt,error .mcall (at)zwrite .mcall (at)genedt,setnz .mcall (at)scanw,next,zap .mcall (at)sdebug,ndebug param lpp, 60. ; param ttllen, 32. param stllen, 64. .globl codrol, errrol, lcdrol, symrol, secrol .globl lcbegl, linend, lcendl .globl linbuf, cdrsav, endp2l .globl linnum, seqend, pagnum, pagext .globl ffcnt, lppcnt .globl dflgbm, opclas .globl edmask, ed.cdr, ed.lc srclen = 204 ;********************* octlen = 60 ;********************* mx.on =lc.md!lc.mc!lc.ld!lc.toc!lc.sym!lc.cnd!lc.bin!lc.loc!lc.seq .globl lc.cnd .globl exmflg .globl lstchn, cmochn, lstflg, putoc .globl mx.flg, my.flg .globl crfref .globl clcfgs, clcloc, clcmax .globl clcnam, clcsec, cpopj .globl errbts .globl flags, getchr, getnb, getsym .globl mode .globl rolndx, rolupd .globl sector, setpf0, setpf1 .globl setsym .globl symbol, tstarg, value .globl expr, pcroll, prgttl .globl setwrd, setbyt, tstr50, mulr50 .globl r50unp .globl setchr ;globals defined in assembler .globl setlc .globl chrpnt, getr50, pass .globl putkb, putkbl, putlp .globl dnc, movbyt, savreg, xmit0 .globl linbuf, errcnt ;globals defined in mcexec .globl dattim .globl hdrttl .globl io.eof, io.tty, io.err .globl ioftbl, cnttbl, buftbl .globl argcnt, cttbl .globl endlin .globl getlin, lblend, lcendl, lcflag .globl lcmask, lc.mc, lc.md, lc.me .globl lst.kb, lst.lp, lstdev xitsec ;start in default sector endlin: ;end of line processor call savreg clr rolupd ;set to fetch from code roll tstb cttbl(r5) ;eol or semi-colon? ble lout1 ; yes error 19,q, lout1: .if ndf xedcdr movb cdrsav,linbuf+72. ;replace borrowed char .endc mov pass,-(sp) ;pass 1? beq 9$ ; yes call mx.mx ; <<< REEDS june 81 mov lstdev,(sp) ;init listing flag tst errbts ;any errors? bne 7$ ; yes, go directly, do not collect, etc. tstb (sp) ;any listing device? beq 9$ ; no bit #lc.ld,lcflag ;listing directive? bne 5$ ; yes tst mx.flg ; <<< REEDS june 81 bne 80$ ; <<< REEDS june 81: in mx mode we ignore .list tst lclvl ;test over-under ride blt 5$ ;if <0, list only if errors bgt 8$ ;if >0, list unconditionally 80$: bit #lc.com,lcmask ;comment suppression? beq 2$ ; no mov chrpnt,lcendl ;yes, assume we're sitting at comment 2$: bit #lc.src,lcmask ;line suppression? beq 3$ ; no mov #linbuf,lcendl ;yes, point to start of buffer 3$: .if ndf xmacro tstb <^pl rolsiz>+codrol+1 ;anything in code roll? beq 4$ ; no bit #lc.meb,lcmask ;macro binary expansion? bne 4$ ; no bic #lc.me,lcflag ;yes, ignore me flag .endc 4$: bit lcmask,lcflag ;anything suppressed? beq 9$ ; no, use current flags 5$: clr (sp) ;yes, clear listing mode br 9$ 7$: swab (sp) ;error, set to error flags 8$: mov #linbuf,lcbegl ;list entire line mov #linend,lcendl 9$: call pcroll ;process entry on code roll endl10: movb (sp),lstreq ;anything requested? beq endl20 ; no clrb @lcendl ;set asciz terminator mov #octbuf,r2 11$: mov #space*400+space,(r2)+ ;blank fill cmp #linbuf,r2 ;test for end (beginning of line buffer) bne 11$ endl50: mov #octbuf,r2 ;point to start of buffer call tsterr ;set error flags mov #linnum,r0 mov (r0)+,r1 cmp r1,(r0) beq 2$ mov r1,(r0) bit #lc.seq,lcmask bne 2$ mov r2,r4 call dnc mov #octbuf+7,r0 1$: movb -(r2),-(r0) movb #space,(r2) cmp r2,r4 bhi 1$ mov #octbuf+7,r2 2$: movb #tab,(r2)+ 21$: mov #pf0,r1 bit #lc.loc,lcmask bne 4$ tst (r1) beq 3$ call setwrd 3$: movb #tab,(r2)+ 4$: clr (r1) mov #pf1,r1 bit #lc.bin,lcmask bne endl19 mov #1,r4 bit #lc.ttm,lcmask beq 41$ cmpb (r4)+,(r4)+ ; cheap increment by 2 41$: tst (r1) beq 6$ 5$: call setwdb 6$: movb #tab,(r2)+ clr (r1) dec r4 beq endl19 tst rolupd beq 6$ call pcroll br 5$ endl19: mov lcbegl,r1 ;point to start of listing line call movbyt ;move over putlin #octbuf ; test for header and list call err.pr endl20: clrb @lcbegl ;don't dupe line tst rolupd ;finished? beq endl30 ; yes, don't loop call pcroll beq endl30 ;exit if empty bit #lc.bex!lc.bin,lcmask ;binary extension suppressed? beq endl10 ; no br endl20 ;yes, don't list endl30: tst (sp)+ ;prune listing flag zap codrol ;clear the code roll mov clcloc,r0 cmp r0,clcmax ;new high for sector? blos 31$ ; no mov r0,clcmax ;yes, set it 31$: return setwdb: ;list word or byte tst (r1) ;anything for second field? beq 9$ ; no mov #setwrd,-(sp) ;assume word bit #dflgbm,opclas ;true? beq 1$ ; yes mov #setbyt,(sp) ;no, byte 1$: call @(sp)+ ;call routine bit #77*400,(r1) ;test for linker modification beq 9$ bit #5100,(r1) ;if one of these isnt set I dont know bne 12$ ;what is going on, so lets mark it ? movb #'?,(r2) br 9$ 12$: movb #ch.xcl,(r2) ; ' marks psect relocation bit #4000,(r1) bne 10$ movb #'",(r2) ; " location counter relocation 10$: bit #glbflg,(r1) beq 2$ movb #'G,(r2) tst symbol ; harvard m11 uses global syms with funny bne 2$ ; names for complex relocation movb #'C,(r2) 2$: tstb (r2)+ 9$: return tsterr: ;test and process errors mov errbts,r0 ;any errors? beq 9$ ; no bic #err.,r0 ;yes, ".print"? beq 4$ ; yes inc errcnt ;bump error count call err.sh 4$: mov #errmne-1,r1 1$: tstb (r1)+ ;move char pntr and clear carry ror errbts ;rotate error bits bcc 2$ movb (r1),(r2)+ .if ndf xcref movb (r1),r0 ;fetch character call tstr50 ;convert to rad50 call mulr50 ;left justify call mulr50 mov r0,symbol ;store clr symbol+2 mov #errrol,rolndx ;prepare to cref call crfref ;do so .endc br 1$ 2$: bne 1$ 9$: return .globl fileln .globl putli2 err.sh:: call savreg tst lstflg bne 9$ ; printf("%s: line %d: %s\n", infile, fileln, errmess) mov #err.bx,r2 tstb err.by beq 1$ mov #err.by,r1 call movbyt mov #err.s1,r1 call movbyt mov fileln,r1 call dnc tst err.xx beq 2$ mov #err.s2,r1 call movbyt 1$: mov err.xx,r1 call movbyt clr err.xx 2$: clrb (r2) mov #err.bx,r2 mov #lst.kb,r4 call putli2 9$: return .data err.s1: .asciz /: line / .even err.s2: .asciz /: / .bss err.bx: .blkw 60 err.by:: .blkw 60 entsec impure errcnt: .blkw ;error counter entsec implin errbts: .blkw ;error flags err.xx:: .blkw ;error message xitsec .if ndf xedcdr genedt cdr entsec impure cdrsav: .blkw ;saved char from card format .endc entsec impure octbuf: octerp: .blkb 0 octseq: .blkb 2 octpf0: .blkb 7 octpf1: .blkb octlen-<.-octbuf> linbuf: .blkw srclen/2 linend: .blkw 1 .data tmpcnt = 1 errmne: .irpc char,< abeilmnopqrtuz> .ascii /char/ .globl err.'char err.'char= tmpcnt tmpcnt = tmpcnt+tmpcnt .endm xitsec .globl title, sbttl title: call getsym ;get a symbol bne title1 ; error if null error 20,a, return title1: mov r0,prgttl ;move into storage mov symbol+2,prgttl+2 call setsym ;point to start of title mov #ttlbuf,r2 ;point to buffer movb #ff,(r2)+ ;store page eject clr r3 ;clear position conter 2$: .if ndf xedlc ;>>>gh 7/20/78 to not automatically upper-case bit #ed.lc,edmask ;lower case enabled? bne 6$ ; no, leave as upper case mov chrpnt,r5 ;fake for ovlay pic movb (r5),r5 ;fetch original character 6$: .endc movb r5,(r2) ;plunk the next char in the buffer beq 5$ ;branch if end cmp r5,#tab ;a tab? bne 3$ ; no bis #7,r3 ;yes, compensate 3$: inc r3 ;update position counter cmp r3,#ttllen ;within bounds? bhis 4$ ; no tstb (r2)+ ;yes, move pointer 4$: call getchr ;get the next character bne 2$ ;loop if not end 5$: movb #tab,(r2)+ ;set separator .globl vernam mov vernam,r1 call movbyt ;set version number, etc. mov #dattim,r1 call movbyt ;date and time mov r2,ttlbrk ;remember break point clrb (r2) return .data defttl:: .asciz /.main./ ;default title entsec impure ttlbrk: .blkw ;break location ttlbuf: .blkb ttllen-1!7+1+1 ;modulo tab + ff .blkb 20. ;intro msg .iif ndf xtime, .blkb 20. ;time & date .blkb 20. ;page number .even xitsec sbttl: ;sub-title directive mov #stlbuf,r2 ;point to sub-title buffer tst pass ;pass one? beq 2$ ; yes 1$: .if ndf xedlc ;>>>gh 7/20/78 to not automatically upper-case bit #ed.lc,edmask ;lower case enabled? bne 4$ ; no, leave as upper case mov chrpnt,r5 ;fake for ovlay pic movb (r5),r5 ;fetch original character 4$: .endc movb r5,(r2)+ ;move character in beq 13$ ; branch if end call getchr ;get the next character cmp r2,#stlbuf+stllen-1 ;test for end blo 1$ tstb -(r2) ;polish off line br 1$ 2$: bit #lc.toc,lcmask bne 13$ tstb lstdev ;any listing device? beq 13$ ; no, exit tst mx.flg ; <<< REEDS june 81 bne 13$ ; <<< mov #toctxt,r1 call movbyt ;set table of contents call setsym ;point to ".sbttl" 3$: call getr50 ;get radix-50 char bgt 3$ ;stop at first terminator mov chrpnt,r2 ;set pointer .if ndf xlcseq mov linnum,r0 call 10$ movb #ch.sub,-(r2) .iff movb #tab,-(r2) .endc mov pagnum,r0 call 10$ movb #space,-(r2) tst lstflg beq 15$ bisb lstdev,lstreq 15$: putlin r2 ;output return 10$: mov #4,r4 ; << REEDS. changed to 4 digit field from 3 11$: movb #space,-(r2) mov r0,r1 beq 12$ clr r0 div #^d10,r0 add #dig.0,r1 movb r1,(r2) 12$: sob r4,11$ 13$: return .data toctxt: .asciz /table of contents/ entsec imppas stlbuf: .blkw /2 ;sub-title buffer xitsec .globl print, error .enabl lsb print: error 0,<>, ; null error (dont count) br error1 error: error 53,p, error1: call setpf0 ;print location field call expr ;evaluate expression beq 2$ ;branch if null call setpf1 ;non-null, list value 2$: return .dsabl lsb .globl rem rem: ; ".rem" directive mov r5,r3 ;set terminating character bne rem1 ;branch if non-null error 22,a, ;error, no delimiting character return rem1: call getchr ;get the next character 2$: tst r5 ;end of line? bne 3$ ; no call endlin ;yes, polish off line call getlin ;get next line beq 2$ ;loop if no eof return ;eof, exit 3$: cmp r5,r3 ;is this the terminator? bne rem1 ; no jmp getnb ;yes, bypass and exit .sbttl listing control .globl nlist, list nlist: com r3 ;make r3 -1 list: asl r3 ;make r3 0/-2 inc r3 ;now 1/-1 1$: call tstarg ;test for another argument bne 2$ ; valid tst argcnt ;null, first? bne list7 ; no, we're through inc argcnt ;yes, mark it 2$: call getsym ;try for a symbol scanw lcdrol ;look it up in the table beq 6$ ; error if not found clr r2 sec 3$: rol r2 sob r0,3$ tst exmflg ;called from command string? beq 11$ ; no bis r2,lcmcsi ;yes, set disable bits bisbic lcdeft ;change the default values br 12$ ; and skip test 11$: bit r2,lcmcsi ;this flag off limits? bne 5$ ; yes 12$: bic r2,lcmask bit r2,#lc. ;null? beq 4$ ; no call pagex ;set listing control add r3,lclvl ;yes, update level count beq 5$ ;don't set flag if back to zero 4$: tst r3 bpl 5$ ;.list, branch bis r2,lcmask 5$: br 1$ ;try for more 6$: error 23,a, list7: return genswt li,list ;generate /li genswt nl,nlist ; and /nl switch entries .globl page page: inc ffcnt ;simulate ff after this line pagex: bis #lc.ld,lcflag ;flag as listing directive return .macro genlct mne,init ;generate listing control table lc.'mne= 1 .rept <.-lctbas>/2 lc.'mne= lc.'mne+lc.'mne .endm .rad50 /mne/ .if nb lcinit= lcinit+lc.'mne .endc .endm lcinit= 0 entsec lctsec lctbas = . genlct seq genlct loc genlct bin genlct src genlct com genlct bex genlct md genlct mc genlct me ,1 genlct meb,1 genlct cnd genlct ld ,1 genlct ttm,1 genlct toc genlct sym genlct < > ;null xitsec genswt fl,profl flsbts= lc.seq!lc.loc!lc.bin!lc.bex!lc.me!lc.meb!lc.toc!lc.sym profl: mov #flsbts,lcmcsi mov #flsbts,lcmask return .globl eddflt,ucflag uc.set:: bis #ed.lc,eddflt um.set:: inc ucflag return .data .even ucflag:: .word ; if set, dont do case trnslation in macros entsec dpure lcdeft: .word lcinit ; default value for lcmask xitsec entsec impure lcmask: .blkw ;mask bits lclvl: .blkw ;level count lcmcsi: .blkw ;command string storage entsec implin lcflag: .blkw ;flag bits lcbegl: .blkw ;pointer to start of line lcendl: .blkw ;pointer to end of line lblend: .blkw ;end of label (for parsing) xitsec setlc: mov lcdeft,lcmask ;default flags clr lclvl clr lcmcsi return .sbttl listing stuff setpf0: ;set print field zero sdebug mov clcfgs,pf0 ;set current location flags bisb #100,pf0+1 ;assume word mov clcloc,pf0+2 ;set location return setpf1: ;set print field one mov mode,pf1 ;set mode of current value bisb #100,pf1+1 ;assume word mov value,pf1+2 return entsec implin pf0: .blkw 2 pf1: .blkw 2 xitsec endp2l: ;end pass2 listing call err.pr ; flush out last error message mov #symtxt,r1 mov #stlbuf,r2 call movbyt ;set "symbol table" sub-title tstb lstdev ;any listing output? beq endp2d ; no bit #lc.sym,lcmask ;symbol table suppression? bne endp2d ; yes inc ffcnt ;force new page clr lppcnt ;force new page inc pagnum mov #-1,pagext clr rolupd ;set for symbol table scan 2$: mov #linbuf,r2 ;point to storage 3$: next symrol ;get the next symbol beq endp2a ; no more bit #regflg,mode ;register? bne 3$ ; yes, don't list call r50unp ;unpack the symbol mov #endp2t,r3 call endp2p mov #mode,r1 ;point to mode bits bit #defflg,(r1) ;defined? beq 4$ ; no call setwrd br 6$ 4$: mov #stars,r1 call movbyt ;undefined, substitute ****** 6$: call endp2p .iif df rsx11d, call endp2x mov #sector,r1 cmpb #1,(r1) bge 10$ cmpb -(r1),-(r1) call setbyt 10$: movb #tab,(r2)+ ;separator cmp r2,#linbuf+50. ;enough for one line? blo 3$ ; no call endp2b ;output line br 2$ ;next line endp2a: ; print .psect list .if ndf xrel clr rolupd ;set for sector scan 21$: call endp2b ;output line next secrol ;get the next entry beq endp2d ; exit if end of roll movb #'<,(r2)+ call r50unp ;print the name, movb #'>,(r2)+ movb #tab,(r2)+ mov #value,r1 call setwrd ; the value, movb #tab,(r2)+ mov #sector-2,r1 call setbyt ; and the entry number movb #tab,(r2)+ mov #flags-2,r1 call setbyt ; and the attributes br 21$ .endc endp2b: clrb (r2) mov lstdev,lstreq ; we want output putlin #linbuf mov #linbuf,r2 ;reset to start of buffer endp2d: return endp2p: call endp2x endp2x: mov (r3)+,r0 bit (r3)+,mode bne 32$ swab r0 32$: movb r0,(r2)+ return entsec dpure endp2t: .ascii / =/ .word lblflg .ascii /% / .word regflg .ascii /r / .word relflg .ascii /g / .word glbflg .if df rsx11d .ascii /x / .word dfgflg .endc .data stars: .asciz /******/ symtxt: .asciz /symbol table/ xitsec lst.kb= 1 ;teletype listing lst.lp= 2 ;lpt listing xitsec ; ; These routines are high level. They make output go to ; more than one device, they add page headers. The dogsbody ; low guy is 'putli2', who in turn calls on 'o.kblp', which ; interfaces with the file buffering guys directly. ; putkb: mov #lst.kb,lstreq ;set request br putlix putkbl: mov #lst.kb,lstreq ;set for tty putlp: tst lstflg ;doing a listing? beq putlix ;no bisb lstdev,lstreq ;lpt ; ; output a line plain & simple ; putlix: call savreg mov r0,r2 movb lstreq,r4 call putli2 return putlin: ;output a line with page heading if needed call savreg ;stack registers mov r0,r2 ;arg to r2 movb lstreq,r4 ;get request clr lstreq ;clear it tst r4 beq 9$ ;just exit if empty bgt 2$ ;omit header if not listing dec lppcnt ;yes, decrement count bgt 2$ ;skip if not time call putpag 2$: call err.pr call putli2 ;print out the line 9$: return putli2: movb (r2)+,r1 ;get a char. beq 21$ ;end on null call o.kblp ;transmit appropriately br putli2 ;till null 21$: movb #lf,r1 ; used to be cr/lf call o.kblp bit #lst.kb,r4 ;if sending to cmochn, beq 9$ ;no zwrite cmo ;yes, send it now 9$: return o.kblp: bic #177600,r1 ;just 7 bits, please. bit #lst.kb,r4 ;cmo on? beq 1$ ;no mov #cmochn,r0 ;yes call putoc 1$: bit #lst.lp,r4 ;lst on? beq 2$ ;no mov #lstchn,r0 ;yes call putoc 2$: return ; put out a page heading putpag: ;mov #lpp,lppcnt ;reset count mov #lpp-4,lppcnt ;reset count, compensate for bug introduced ;by rearranging pagination logic mov r2,-(sp) ;stack current pointer mov ttlbrk,r2 ;end of pre-set title tst pass beq 11$ mov #pagmne,r1 call movbyt ;move "page" into position mov pagnum,r1 call dnc ;convert to decimal inc pagext beq 11$ movb #'-,(r2)+ mov pagext,r1 inc r1 call dnc 11$: clrb (r2) tst mx.flg ; <<< REEDS june 81 bne 100$ putlp #ttlbuf ;print title putlp #stlbuf ; sub-title, 100$: putlp #crlf ; and a blank line mov (sp)+,r2 return entsec impure lstreq: .blkw ;list request flags lstdev: .blkb 2 ;error(lh), listing(rh) .data pagmne: .ascii / page / crlf: .asciz // xitsec .macro putl x ; printf("%s\n", mx.lin) mov x,mx.tmp call putl .endm putl: .irpc xx,<012345> mov r'xx,-(sp) .endm mov mx.tmp,r2 mov #lst.lp,r4 call putli2 .irpc xx,<543210> mov (sp)+,r'xx .endm return putsc: call savreg mov mdepth,r4 1$: movb #';,r1 call mx.put dec r4 bpl 1$ movb #tab,r1 call mx.put return mx.put: call savreg mov #lst.lp,r4 bic #177600,r1 mov #lstchn,r0 call putoc return mx.mx: call savreg tst mx.flg beq 1$ mov #mx.on,lcmask tst errbts beq 3$ putl #mxstar call err.pr 3$: tst mx.2 ; is it a .narg, etc. directive? beq 2$ clr mx.2 tst my.flg bne 20$ call putsc ; ;.narg frodo putl #linbuf 20$: putl #mx.gen ; ; generates: putl #mx.pxx ; frodo = 5280 br 1$ 2$: tst my.flg ; is it otherwise suppressed & are bne 1$ ; we listing such? bit lcmask,lcflag ; anything supppressed? beq 1$ call putsc putl #linbuf 1$: return err.pr: call savreg mov r0,-(sp) mov r5,-(sp) tst err.xx beq 1$ mov #lst.kb,r4 tst lstflg beq 2$ mov #lst.lp,r4 2$: mov err.xx,r2 call putli2 clr err.xx 1$: mov (sp)+,r5 mov (sp)+,r0 return .bss mdepth:: .blkw 1 xitsec entsec mixed mx.gen:: .asciz /;*** generates:/ mxstar:: .asciz /*** error ***/ mx.pxx: .ascii mx.sym:: .ascii /symbol = / mx.num:: .ascii /65000/ .even mx.2:: .blkw mx.tmp: .blkw ; space for putl(arg) .end