Ultrix-3.1/src/ucb/m11/exec.m11
;//////////////////////////////////////////////////////////////////////
;/ Copyright (c) Digital Equipment Corporation 1984, 1985, 1986. /
;/ All Rights Reserved. /
;/ Reference "/usr/src/COPYRIGHT" for applicable restrictions. /
;//////////////////////////////////////////////////////////////////////
; @(#)exec.m11 1.2 3/26/82
;this is the key to the bob bowering assembler that has been modified for
;unix by brent byer
;symbols for ddt have been added by forrest howard, who also fixed various
;bugs
.title exec - assembler exec
.ident /01aug5/
.mcall (at)ndebug,sdebug
.mcall (at)jeq,jne
.mcall (at)always,ct.mne,xmit,putkb,putkbl,putlp,genswt
.mcall (at)genedt
.mcall (at)error,scanw
.mcall (at)st.flg
always
ct.mne
st.flg
.macro strcpy from,to ,?loop
mov r0,-(sp)
mov r1,-(sp)
mov from,r0
mov to,r1
loop:
movb (r0)+,(r1)+
bne loop
mov (sp)+,r1
mov (sp)+,r0
.endm
.sbttl assembly options
;the following macro causes assembly options to be
;printed on the loader map and any implications
;(second argument) to be defined. options are
;selected by equating them to zero.
.macro ldrmap mne,implies
.if df mne
.list
.globl mne
.nlist
.irp x,<implies>
.globl x
x= 0 ;invoke implications
.endm
.endc
.endm ldrmap
;the following group enables functions
ldrmap rsx11d,<dflgtb> ;rsx11d "features"
ldrmap debug ;debug version
ldrmap pdpv45 ;pdp-11/45 instructions
ldrmap id.spc ;i- & d-space capability for unix
ldrmap dblbuf ;tran'd input
;the following group disables functions
.iif df x40&x45, xfltg= 0
ldrmap xbaw ;no bells and whistles
ldrmap xswit,xcref ;no switches
ldrmap xrel,xedpic ;abs output only
ldrmap xmacro,xsml ;all generated code (macro, rept, etc.)
ldrmap xsml ;system macros
ldrmap x40 ;pdp-11/40 features
ldrmap x45 ;pdp-11/45 features
ldrmap xfltg,xedfpt ;floating point evaluation
ldrmap xedabs ;ed.abs
ldrmap xedama ;ed.ama
ldrmap xedpic ;ed.pic
ldrmap xedfpt ;ed.fpt
ldrmap xedlsb ;ed.lsb
ldrmap xedpnc ;ed.pnc
ldrmap xedlc ;ed.lc
ldrmap xedcdr ;card reader format
ldrmap xzerr ;"z" errors
ldrmap xlcttm ;no lpt listing format
ldrmap xlcseq ;sequence numbers
ldrmap xtime ;no time & date on header
.sbttl globals
;globals defined in assembler
.globl srchi
.globl prop1, endp1, prop2, endp2
.globl bksiz
.globl symlp, symhp
.globl setlc, seted
.globl uc.set, um.set
.globl pass
.globl putkb, putkbl, putlp
.globl dnc, movbyt, savreg, xmit0
.globl linbuf, errcnt, openo, openc
.globl chrpnt, prosw, absexp
.globl xctpas
;globals defined in mcexec
.globl pagnum, linnum
.globl inicor, iargv
.if ndf xtime
.globl dattim
.endc
.if ndf xsml
.globl finsml, inisml, smlnam, smlfil
.endc
.globl getic, hdrttl, putoc, getsrc
.globl io.eof, io.eoi, io.tty, io.err
.globl ioftbl, cnttbl, buftbl, ioltbl, chrtbl
.globl exttbl, bintbl, lstflg, chntbl
.globl $wrsys, $wrbfp, $wrcnt, $brksy, $brkad
.globl symovf, macovf
.globl errrol,crfrol
.globl xctprg
errrol= 1
.mcall (at)param
.globl $creat, $open, $close, $exit, $read, $write, $break
.globl $seek, $indir, $time, $fork, $wait, $exec
;init sectors
entsec implin
.blkw
xitsec
.sbttl mcioch - i/o channel assignments
.macro genchn zchan,zlnk,zbuf,ztype,zext,zlen
setchn cmo, cmo, cmo, 0, ,80.
setchn src, src, src, 0, m11, 132.
setchn lst, lst, lst, , lst, 512.
setchn obj, obj, obj, 1, obj, 42.
.if ndf xsml
setchn sml, sml, sml, 0, sml, 80.
.endc
.if ndf xcref
setchn crf, crf, crf, , xrf, 512.
.endc
.endm genchn
.macro setchn zchan,zlnk,zbuf,ztype,zext,zlen
.if nb <zlen>
param zbuf'len, zlen
.endc
.endm
genchn
.globl objlen
tmpcnt= 0
.macro setchn zchan,zlnk,zbuf,ztype,zext,zlen
.list
zchan'chn= tmpcnt
.nlist
.globl zchan'chn
tmpcnt= tmpcnt+2
.endm
genchn
maxchn= tmpcnt ;just to preserve the count
.macro serror xxx ; was: .macro serror number,message
mov xxx,r0 ; was: jsr r0,serror
; was: .asciz \message\
jmp serror ; new: no return
;.even
.endm serror
.macro .asclc, str
.nlist
.irpc x, ^%str%
.if ge ''x-101
.if le ''x-132
.byte ''x+40
.iff
.byte ''x
.endc
.iff
.byte ''x
.endc
.endm
.byte 0
.list
.endm
.sbttl start of program
.globl start, fin
start: ;start of program
mov (sp)+,iargc ;store arg. count
mov sp,iargv ;store pointer to arg. vector
clr (sp)
mov #dattim,r2 ;set date and time
$time
call cvtim ;convert to ascii
call xctprg ;clean up core
call inip0 ;output file processing
call inip1
call prop1 ;pass one
call finp1
call endp1 ;clean up
call inip2
call prop2 ;pass 2
call endp2
call setdn ;finished, control not returned
mov #objchn,r0
call zwrite
call zclose
mov #lstchn,r0 ;output any remaining listing
call zwrite
.if ndf xcref
mov crfpnt,r2
beq 9$
mov #crfchn,r0
call zwrite ;dump out any remaining output
call zclose ;close cref tmp. file
mov #lstchn,r0
tst ioftbl+lstchn
bne 81$
mov cnttbl+crfchn,cnttbl+lstchn
;set up to recycle (i hope)
inc lstflg
call openo
81$: mov #lstchn,r2 ;set up name of listing file in linbuf
call src.ap
$exec ;cref will do the rest!!
crfrun
crefav
; execl("macxrf", "macxrf", "-flags", "fred.xrf", "fred.lst", 0);
; meaning of flags arg:
; "-" m11 invoked with -cr only: do the standard stuff
; "-am.." other letters added as extra cr flags invoked.
;
br $$exit
.endc
9$: tst lpflag ;spooler requested?
beq $$exit ;no, leave
mov #lstchn,r0 ;yes, close listing channel
mov r0,r2 ;copy for src.ap
call zclose
call src.ap ;put name of lst file into linbuf
$exec ; take it away, LPR!
lprrun
lpargs
$$exit: clr r0 ;leave r0 set corectly
tst errcnt
beq 1$ ;no problems
inc r0 ;return 1
1$:
$exit ;that's all, folks!
entsec dpure
lpargs: lprrun
linbuf
0
lprrun: .asclc /usr/ucb/lpr
.even
entsec mixed
argc: .blkw 1
iargc: .blkw 1
iargv: .blkw 1
argv: .blkw 1
symlp: <^pl xpcor>
symhp: <<<^ph xpcor>+63.>&^c63.>-2
entsec impure
lstflg: .blkw 1
lttflg:: .blkw 1
crfpnd: .blkw 1
no.flg: .blkw 1
u.flag:: .blkw 1 ; user wants UNIX style line numbers
lpflag: .blkw 1
mx.flg:: .blkw 1 ; if set, do macro expansion ONLY
xx.flg:: .blkw 1 ; debug switch
my.flg:: .blkw 1 ; and also show the pre-xpnd srce lines
sx.flg:: .blkw 1 ; if set, generate more local syms syms
pdp10:: .blkw 1 ; check for model dependencies in
; the instruction set
entsec mixed
crefil: .blkw 30 ; name of cref file: /fred.xrf/
crefav: .word crfrun
.word crflag+1
.word crefil
.word linbuf
.word 0
crflag: .ascii /--/
.blkw 5
crap: .word crflag+2
xitsec
.sbttl output file initialization
inip0: ;initialize things
mov #cmochn,r0 ;set up cmo
call zopen
mov #1,chntbl+cmochn ;it is file handle #1
call inip0z ;set up argc & argv
1$: dec argc ;any more arguments?
blt 9$ ;no, return
mov argv,r0 ;yes, get pointer to next arg.
mov (r0)+,r1 ; into r1
mov r0,argv ;store back new argv
tst r1
beq 1$ ;ignore null pointers (maybe, first one)
cmpb (r1)+,#'- ;is switch indicated?
beq 3$ ;yes
mov -(r0),srcnam ;no , last name will be prefix
br 1$
3$: ;here is hack for explicit name switch
cmpb (r1),#'n
bne 33$
cmpb 1(r1),#'a
bne 33$
add #3,r1 ;move past na:
mov r1,esrcnam
br 1$
33$: mov #linbuf,r2 ;point to dest. for switch
mov r2,r3 ;make copy
clr (r2)+ ;zap initially
mov r2,chrpnt ;copy pointer here for arg.
4$: movb (r1)+,r0 ;get char.
call mk.up ;make upper case
ble 55$ ;null or :
movb r0,(r3)+ ;ok, store
cmp r3,r2 ;max. of 2 chars.
blo 4$
5$: movb (r1)+,r0 ;store rest of arg. in linbuf
call mk.up ;check it and make upper case
55$: bge 6$ ;neg. indicates :
mov #40,r0 ;replace with space
6$: movb r0,(r2)+
bne 5$ ;continue till null
mov linbuf,r0 ;restore switch name into r0
7$: call prosw ;process the switch
bne 1$ ;continue if no error
8$: serror #swcerr
9$:
19$: tst srcnam ;must be at least one filename
beq $$exit ;or we are just a no-op.
return
.globl cttbl ; defined in misc.m11
mk.up:
bic #^c177,r0
cmpb #ct.lc,cttbl(r0)
bne 1$ ; if lower, make upper
sub #40,r0
1$: cmpb #':,r0 ; if input is a colon,
bne 2$
neg r0 ; return MINUS COLON !!!
2$: tst r0 ; else return input
return
entsec impure
srcnam: .blkw 1
esrcnam: .blkw 1
xitsec
genswt no,no.set
no.set: inc no.flg ;indicate no object output
return
genswt uc,uc.set ; revert to bad old DEC upper case rules
genswt um,um.set ; revert to bad old Harvard upper case rules
genswt sx,sx.set
sx.set: inc sx.flg
return
genswt u,u.set
u.set: inc u.flag
return
genswt xx,xx.set
xx.set: inc xx.flg
return
genswt mx,mx.set
genswt my,my.set
genswt lt,lt.set
mx.set:
call no.set
call lt.set
inc mx.flg
return
my.set:
inc my.flg
br mx.set
genswt 10,setten
setten:
inc pdp10
return
lt.set:
mov #1,lttflg
call ls.set
movb #'o,@crap ; tell cref to go on stdout, too.
inc crap
return
.if ne,mk.symbol
genswt ns,ns.set
ns.set: inc out$ym
return
.globl out$ym
.endc
.globl fixtit
.globl ed.gbl, eddflt
genswt xs,xs.set
xs.set: ; obsolete
call absexp ; so that -xs:3 wont genrerate a 'bad switch'
; error.
return
genswt ha,ha.set
genswt de,de.set
ha.set:
inc veritas ; reinstate addf #12,3,fr1
mov #harvid,vernam
call um.set
; harvard .psect attrib scheme uses same defaults as UCB,
; but uses them wrong. The 'veritas' flag tells when to misuse
; them. See 'psect' in xlat.m11
;
bis #ed.gbl,eddflt
jmp fixtit
de.set:
call uc.set
mov #decid,vernam
;
; incomprehensible but true DEC default attribute patterns
;
mov #insflg!pattrs,psdflt
mov #insflg!cattrs,csdflt
mov #insflg!aattrs,asdflt
bis #ed.gbl,eddflt
jmp fixtit
genswt dp,dp.set
genswt da,da.set
genswt dc,dc.set
.globl psdflt,asdflt,csdflt,psarol ; in xlat.m11: .psect atribs
da.set:
mov #asdflt,-(sp)
br dx.set
dc.set:
mov #csdflt,-(sp)
br dx.set
dp.set:
mov #psdflt,-(sp)
dx.set:
call gsarg
beq 9$
scanw psarol
beq 10$
bisb symbol+2,@(sp)
bicb symbol+3,@(sp)
br dx.set
10$: error 45,a,<illegal .psect attribute>
9$:
tst (sp)+
return
genswt ls,ls.set
genswt lp,lp.set
lp.set: inc lpflag ;note spooler request
movb #'l,@crap
inc crap
ls.set: inc lstflg ;note lst file req.
mov #lstchn,r2 ;set up to add buffer for lstchn
addbuf: mov symlp,r0 ;get cur. free loc.
mov r0,cnttbl(r2) ;that's where our byte count will go
tst (r0)+ ;now point to our buffer
mov r0,buftbl(r2)
add ioltbl(r2),r0 ;allow for length of buffer
mov r0,symlp ;new free loc.
return
.if ndf xcref
genswt cr,cr.set
genedt crf
.globl ed.crf,edmask,gsarg,cpopj
cr.set:
tst crfpnd
bne 2$
inc crfpnd ;note pending cref
bis #ed.crf,edmask ; so .enabl/.dsabl crf will work.
1$:
call gsarg
beq 3$
scanw crfrol
beq 9$
movb symbol+4,@crap
inc crap
br 1$
3$:
mov #crfchn,r2 ;set up buffer for it
jmp addbuf
9$:
error 55,a, <illegal cref argument>
2$:
return
.macro gencrf name,char
entsec crfsec
.even
.rad50 /name/
.word cpopj
.word char
.endm
gencrf s,'s
gencrf sy,'s
gencrf sym,'s
gencrf r,'r
gencrf re,'r
gencrf reg,'r
gencrf m,'m
gencrf ma,'m
gencrf mac,'m
gencrf p,'p
gencrf pe,'p
gencrf per,'p
gencrf pst,'p
gencrf c,'c
gencrf cs,'c
gencrf cse,'c
gencrf sec,'c
gencrf pse,'c
gencrf e,'e
gencrf er,'e
gencrf err,'e
xitsec
.endc
.sbttl pass initialization
inip1: ;init for pass 1
mov #lstchn,r0
call openo
call srchi ;init the symbol table & rolls
br inip2f ;set source for pass
inip2: ;init for pass 2
inc pass
tst crfpnd
beq inip2f
call crfset
inip2f: call setlc
.globl mx.2 , mdepth
.globl mac.er
clr mx.2
clr mdepth
call seted
inip0z: mov iargv,argv ;init count & pointer to args.
mov iargc,argc
dec argc
add #2,argv
return
.sbttl end of pass routines
finp1: ;finish of pass
mov #srcchn,r0
call zclose
return
openo: ;open output file
call savreg
mov r0,r2 ;copy r0 (chn. #)
cmp r0,#lstchn ;is it list channel?
bne 1$ ;no
tst lttflg ; <<< REEDS june 1981
beq 100$ ; <<<
mov #1,r0 ; <<< use standard output if -lt flag in use
br 7$ ; <<<
100$:
tst lstflg ;yes, is listing enabled (-ls) ?
beq 9$ ;no, ignore
1$: cmp r0,#objchn ;is this object channel?
bne 11$ ;no
tst no.flg ;were we told to withhold obj. o/p ?
bne 9$ ;yes, ignore
11$: call src.ap ;set up name in linbuf
mov #linbuf,$crtnm ; and pointer to name
2$: $indir
$crtsy
bcc 7$ ;ok
mov #linbuf,r1 ;no good, complain
3$: tstb (r1)+ ;find end of filename
bne 3$
dec r1 ;back up over null
mov #ncmsg,r0 ;append rest of msg.
4$: movb (r0)+,(r1)+
bne 4$
putkb #linbuf
return
7$: mov r0,chntbl(r2) ;store file handle
mov r2,r0 ;restore r0 with chn. #
call zopen
9$: return
src.fp:
mov srcnam,r1 ;transfer file name from src prefix
tst esrcnam
beq 1$
mov esrcnam,r1
1$:
mov #linbuf,r0 ;and store in linbuf
nam.fp: clr -(sp) ;clear "." flag
2$: movb (r1)+,(r0)+ ;transfer a byte
beq 4$ ;move on if done
cmpb -1(r0),#'. ;not null, was it a "." ?
beq 3$ ;yes, set flag and cont.
cmpb -1(r0),#'/ ;no, was it / ?
bne 2$ ;no, continue
clr (sp) ;yes, clear flag
br 2$ ;continue
3$: mov r0,(sp) ;flag with adr. past period.
br 2$
4$: mov r0,r1 ;copy adr. past terminating null
mov (sp)+,r0 ;restore period flag (adr.)
bne 5$ ;if set, move on
mov r1,r0 ;use this adr.
5$: dec r0 ;back up pointer to null or period.
return
nam.ap: call nam.fp ;move to period
br ap.ext
src.ap: call src.fp ;find period.
; and plop appropriate ext. in
ap.ext: tstb (r0)+ ;period here?
bne 1$ ;yes, assuming non-null is a period
movb #'.,-1(r0) ;no, put one in
1$: mov exttbl(r2),r1 ;get pointer to ext.
2$: movb (r1)+,(r0)+ ;store the ext. at end of name
bne 2$
7$: return
.sbttl end of program cleanup
setdn: ;clean up
mov #finmsg,r1 ;set for final message
mov #linbuf,r2
call movbyt ;move into linbuf
mov errcnt,r1
; *** beq 1$ ;don't bother if successful
call dnc ;print in decimal
clrb (r2)
tst mx.flg
bne 1$
tst lttflg ; <<< REEDS june 81
beq 100$ ; <<< REEDS june 81
putlp #linbuf ; <<< REEDS june 81
br 1$ ; <<< REEDS june 81
100$: putkbl #linbuf ;list to kb & lp
1$: return
serror: ;"s" error
call putkb
call mac.er ;maybe caused by macro explosion
mov #1,r0
$exit
; symovf: serror 217,<symbol table overflow>
symovf:
serror #symerr
macovf: call mac.er
serror #macerr ; no return: exit sys call
getic: ;get input character
dec @cnttbl(r0) ;any chars left in line?
blt 4$ ; no
clr r5
bisb @chrtbl(r0),r5 ;yes, fetch next
inc chrtbl(r0) ;bump count
return
4$: tst ioftbl(r0) ;file initted?
beq 5$ ;no, do so
call zread ;read and wait
mov ioftbl(r0),r5 ;get condition flags
bic #^c<io.eof!io.err>,r5 ;clear extraneous
beq getic ;branch if nothing special
bit #io.eof,r5
beq 9$ ; error, exit
mov #io.eoi,r5 ;in case not source
cmp r0,#srcchn ;is it src.?
bne 9$ ;no
5$: call getsrc ;open next source file
mov #io.eoi,r5 ;in case unsuccessful
tst ioftbl+srcchn ;winner?
beq 9$ ;no
mov #io.eof,r5 ;set end-of-file
9$: bis #100000,r5 ;set flag bit
return
.globl err.by ; array holds file name for error printer
getsrc:
clrb err.by
clr fileln ; start unix line numbers over
mov #srcchn,r0 ;use source chn.
mov r0,-(sp)
mov r1,-(sp)
mov r2,-(sp)
mov r0,r2 ;copy chn. #
call zclose ;close current source input
1$: dec argc ;any left?
blt 7$ ;no
mov argv,r0 ;point to next arg.
mov (r0)+,r1
mov r0,argv
tst r1 ;ignore null pointer
beq 1$
cmpb (r1),#'- ;switch?
beq 1$ ;yes, ignore
mov buftbl+srcchn,r0 ;point to dest. of name
mov r0,$opnnm ;set up pointer to name
call nam.fp ;transfer name & find period.
clr -(sp) ;clear retry indicator
tstb (r0) ;was ext. specified?
bne 13$ ;yes, try it as is
mov r0,(sp) ;no, save adr. of null
call ap.ext ;append default ext.
13$: clr $opnmd ;set up mode as "read"
$indir ;indirect to dirty area
$opnsy
bcc 3$ ;if ok, move on
tst (sp) ;prepared to retry w/o ext.?
beq 14$ ;no, not found!
clrb @(sp) ;yes, remove ext.
clr (sp) ;just one retry
br 13$
14$: mov #linbuf,r1 ;store msg. in buffer
mov $opnnm,r0
15$: movb (r0)+,(r1)+
bne 15$ ;store file name
dec r1 ;back up pointer
mov #nfmsg,r0
2$: movb (r0)+,(r1)+
bne 2$
putkb #linbuf
mov #1,r0 ;indicate error status
$exit ;and die
3$: mov r0,chntbl+srcchn ;store file handle.
bis #io.opn,ioftbl+srcchn ;denote open
clr @cnttbl+srcchn ;beware of dos "feature"
tst (sp)+ ;flush retry indicator
mov $opnnm,r1
mov #err.by,r2
call movbyt
clrb (r2)
4$: mov argc,r0 ;get arg. count
mov argv,r1 ;and vector ptr.
5$: dec r0 ;any left?
blt 7$ ;no
cmpb @(r1)+,#'- ;yes, but is it switch?
beq 5$ ;yes
clr r5 ;no, note another file to go
6$:
10$: mov (sp)+,r2
mov (sp)+,r1
mov (sp)+,r0
return
7$: mov sp,r5 ;note no more files
br 6$
putoc: cmp @cnttbl(r0),ioltbl(r0) ;any room left?
bge 5$ ;no
movb r1,@chrtbl(r0) ;yes
inc chrtbl(r0)
inc @cnttbl(r0)
4$: return
5$: bit #io.opn,ioftbl(r0) ;open?
beq 4$ ;no, return
call zwrite ;yes, dump buffer
br putoc ;try again
.sbttl system macro handlers
.if ndf xsml
inisml: ;init sml file
mov #smlchn,r0 ;open 'er up
tst ioftbl(r0)
bne finsml
call zopen
mov smlnam,r1 ;get pointer to name prefix
mov #smlfil,r0 ;point to destination of complete string
mov r0,$opnnm ;make copy for system call
mov #smlchn,r2 ;set up channel #
call nam.fp ;transfer name to smlfil & find period.
tstb (r0) ;ext. specified?
bne 1$ ;yes
call ap.ext ;no, supply default
1$: clr $opnmd ;for reading
$indir
$opnsy
bcs finsml
mov r0,chntbl+smlchn
mov sp,r0 ;flag good (non-zero) return
return
finsml: ;close out sml file
mov #smlchn,r0 ; and release it
call zrlse
clr r0 ;signal that we're through
return
.data
.globl veritas
veritas: .blkw ; harvard retrocomat in effect
;
entsec impure
smlnam: .blkw 1
smlfil: .blkw 20 ;macro filename (.sml) goes here
xitsec
.endc
.sbttl init/read/write routines
.globl zread, zwrite
zinit: ;init a device
bis #io.ini,ioftbl(r0) ;flag as in use
return
zopen: bis #io.opn,ioftbl(r0)
mov buftbl(r0),chrtbl(r0)
clr @cnttbl(r0)
return
zread: ;read a line
mov r0,-(sp)
mov r1,-(sp)
mov r0,r1
mov buftbl(r0),$rdbfp
mov ioltbl(r0),$rdcnt
mov buftbl(r0),chrtbl(r0)
mov chntbl(r0),r0 ;get file handle
$indir
$rdsys
bcc 1$ ;ok
bis #io.err,ioftbl(r1)
br 8$
1$: mov r0,@cnttbl(r1) ;store count of chars. read
bne 8$
bis #io.eof,ioftbl(r1) ;eof if none
8$:
mov (sp)+,r1
mov (sp)+,r0
return
zwrite: ;write a line
mov r0,-(sp)
mov r1,-(sp)
mov r2,-(sp)
mov r0,r2
bit #io.opn,ioftbl(r0) ;only if open
beq 9$
mov buftbl(r0),r1
mov @cnttbl(r0),r0
beq 4$ ;and non-zero count
tst bintbl(r2) ;binary?
ble 59$ ; no
mov r2,-(sp)
add #4,r0
mov r0,-(r1)
mov #1,-(r1)
mov r0,-(sp)
add r1,r0
clr -(sp)
51$: movb (r1)+,r2
add r2,(sp)
cmp r1,r0
blo 51$
neg (sp)
movb (sp)+,(r1)
clrb 1(r1)
mov (sp)+,r0
sub r0,r1
bis #1,r0
inc r0
mov (sp)+,r2
59$: mov r0,$wrcnt ;store byte count
mov r1,$wrbfp ;and buffer adr.
mov chntbl(r2),r0 ;get file handle
$indir
$wrsys
bcc 4$
bis #io.err,ioftbl(r2) ;error
4$: clr @cnttbl(r2) ;clear count initially
mov buftbl(r2),chrtbl(r2) ;point to beg. of buffer
9$: mov (sp)+,r2
mov (sp)+,r1
mov (sp)+,r0
return
zclose: ;close file
bit #io.opn,ioftbl(r0) ;is file open?
beq 1$ ;no
mov r0,-(sp) ;yes, save r0
mov chntbl(r0),r0 ;get file handle
$close ;close
mov (sp)+,r0
clr ioftbl(r0)
clr @cnttbl(r0)
1$: return
zrlse: ;close and release file
call zclose ;be sure it's closed
clr ioftbl(r0) ;clear device table
return
.sbttl messages
entsec imppas
pagnum: .blkw ;page number
linnum: .blkw 2 ;line number
fileln:: .blkw 1 ; true line number in file
entsec mixed
.if ndf xtime
dattim: .ascii /00-xxx-00 /
datti1: .ascii /00:00/
datti2: .ascii /:00/
.even
.endc
entsec dpure
;endp1m: .asciz /end of pass/
macerr: .asciz /macro text overflow/
symerr: .asciz /symbol table overflow/
swcerr: .asciz /bad switch/
finmsg: .asciz /errors detected: /
nfmsg: .asciz / not found/
ncmsg: .asciz / - can't create/
.even
entsec mixed
vernam:: 1$ ; addr of default logo
1$: .asciz /UCB m11 v1.2 /
harvid: .asciz /Harvard m11 /
decid: .asciz /DEC Macro-11 /
.even
xitsec
.sbttl i/o tables
.list meb
;i/o flags
io.ini= 000001 ;initted
io.opn= 000002 ;opened
io.tty= 000004 ;device is tty
io.eof= 000010 ;eof seen
io.err= 000020 ;error encountered
io.eoi= 000040 ;end of input
io.out= 100000 ;output device
entsec impure
ioftbl: .blkw maxchn/2 ;i/o flag table
entsec dpure
ioltbl: ;i/o length table
.macro setchn zchan,zlnk,zbuf,ztype,zext,zlen
.list
.word zbuf'len
.nlist
.endm
genchn
.list
.macro setchn zchan,zlnk,zbuf,ztype,zext,zlen
.list
.if nb zext
zchan'ext: .asclc zext
.endc
.nlist
.endm
genchn
.even
nulext: .word 0
entsec mixed
exttbl:
.macro setchn zchan,zlnk,zbuf,ztype,zext,zlen
.list
.if nb zext
.word zchan'ext
.iff
.word nulext
.endc
.nlist
.endm
genchn
entsec mixed
cnttbl: ;pointer to counts
.macro setchn zchan,zlnk,zbuf,ztype,zext,zlen
.list
.if nb ztype
.word zbuf'buf-2
.iff
.word 0
.endc
.nlist
.endm
genchn
buftbl: ;pointers to buffers
.macro setchn zchan,zlnk,zbuf,ztype,zext,zlen
.list
.if nb ztype
.word zbuf'buf
.iff
.word 0
.endc
.nlist
.endm
genchn
entsec impure
chrtbl: ;char pointer table
.blkw maxchn/2
chntbl: ;channel <--> file handle table
.blkw maxchn/2
entsec mixed
bintbl:
.macro setchn zchan,zlnk,zbuf,ztype,zext,zlen
.list
.if nb ztype
.word ztype
.iff
.word 0
.endc
.nlist
.endm
genchn
.macro setchn zchan,zlnk,zbuf,ztype,zext,zlen
.if nb <ztype>
entsec impure
.list
.blkw 3
zbuf'buf: .blkw <zbuf'len+1>/2+2
.nlist
.endc
.endm
genchn
entsec mixed
$wrsys: $write
$wrbfp: .blkw 1
$wrcnt: .blkw 1
$rdsys: $read
$rdbfp: .blkw 1
$rdcnt: .blkw 1
$crtsy: $creat
$crtnm: .blkw 1
$crtmd: .word 0644
$opnsy: $open
$opnnm: .blkw 1
$opnmd: .blkw 1
$brksy: $break
$brkad: .blkw 1
xitsec
.sbttl cross reference handlers
.if ndf xcref
crfset: ;cref switch processor
tst pass
beq 9$
mov #crfchn,r0
call openo
bit #io.opn,ioftbl+crfchn ;successful?
beq 9$ ;no
strcpy #linbuf,#crefil
mov sp,crfpnt ;yes, flag non-null
9$: return
.globl crfdef, crfref, rolndx, r50unp
.nlist meb
.if df xcref
crfref: crfdef: return
.iff
.globl symbol
crfdef: inc crfdfl ;cref definition
crfref: tst crfpnt ;any cref output at this time?
jeq 9$ ; no
tst pass
jeq 9$ ; experiment
tst pagnum ;started yet?
jeq 9$ ; no, forget it
bit #ed.crf,edmask ; cref might be turned off for a while
jeq 9$
call savreg
1$: cmp crfpag,pagnum ;new page?
bhis 2$ ; no
mov #cr.pag,r1 ;yes, send flag
call putxrf
inc crfpag
clr crflin
br 1$
2$: cmp crflin,linnum ;new line number?
bhis 3$ ; no
mov #cr.lin,r1
call putxrf
inc crflin
br 2$
3$: tst symbol ;ignore null symbols
jeq 8$
mov #crftyp,r1
4$:
cmpb rolndx,(r1)+ ;map roll number to cref type
bne 4$
sub #crftyp+1-cr.sym,r1
call tstreg
tst xxxreg
beq 44$
movb #25,r1
44$:
clr xxxreg
call putxrf
mov #crfsym,r2 ;point to where symbol gets unpacked to
call r50unp ;unpack the symbol
mov #crfsym,r2 ;point to beginning of unpacked symbol
5$: movb (r2)+,r1 ;get symbol char.
cmpb r1,#space ;space is end
beq 55$
call putxrf ;non-space - output it
cmp r2,#crfsym+6 ;max. of 6 chars.
blo 5$
55$: mov crfdfl,r1 ;set "#" bit
tstb opclas
bpl 6$ ;branch if no "*"
bis #2,r1
6$: bis #cr.sym,r1 ;set terminator
call putxrf ;send it
call ckvtc ;see if vt needed
8$:
9$: clr crfdfl
return
tstreg:
clr xxxreg
call savreg
cmp rolndx,#symrol
bne 1$
mov #regrol,r4
mov <^pl rolbas>(r4),r3
mov <^pl roltop>(r4),r1
movb <^pl rolsiz>(r4),r2
4$:
cmp r3,r1
bge 1$
cmp (r3),symbol
bne 2$
cmp 2(r3),symbol+2
bne 2$
inc xxxreg
br 1$
2$:
add r2,r3
br 4$
1$:
return
putxrf: dec vtcnt
mov #crfchn,r0 ;reset channel #
tst r1
jne putoc
return
;jmp putoc
vtini=100.
ckvtc: tst vtcnt
bmi 1$
return
1$: mov #vtini,vtcnt
mov #vt,r1
mov #crfchn,r0 ;reset channel #
tst r1
jne putoc
return
;jmp putoc
entsec impure
crfsym: .blkw 3
vtcnt: .blkw
crfflg: .blkw
crfpnt: .blkw
xxxreg:: .blkw
.globl opclas, errrol
cr.ver= 001+<001*400> ;type 1, version #1
cr.pag= 002 ;new page
cr.lin= 003 ;new line
cr.sym= 020 ;symbol
errrol= 1 ;dummy roll
entsec impure
crfver: .blkw ;version flag
crfpag: .blkw
crflin: .blkw
entsec implin
crfdfl: .blkw ; "#" and "*" flags
entsec dpure
crftyp:
.irp x,<sym,mac,pst,sec,err,reg>
.iif ndf x'rol, .globl x'rol
.byte x'rol
.endm
.even
crfrun: .asclc /usr/ucb/macxrf
.even
xitsec
.endc
.if ndf xtime
.globl dnc, movbyt
;called with:
; r0 - high-order word of 32-bit # seconds past 1jan70 gmt
; r1 - low-order word
; r2 - destination adr. of ascii (19 bytes)
gmtsec = $timdf*3600.
cvtim::
sub #gmtsec,r1 ;adjust for deviation
sbc r0
div #8.*3600.,r0 ;form # 8-hour units
mov r1,-(sp) ;save remaining hours, minutes & seconds
mov r0,r1 ;now form days
clr r0
div #3,r0
ash #3,r1 ;and hours
mov r1,-(sp) ;saving hours
movb #-1.,nmonth ;begin month ticker
mov #69.,nyear ;epoch starts in 1970
1$: incb nyear
jsr pc,yearl ;returns length of that year in r1
sub r1,r0
bpl 1$
add r1,r0
mov #28.,$feb
cmp r1,#366. ;is this leap year?
bne 21$
inc $feb ;yes
21$: mov #montab,r1
4$: incb nmonth
sub (r1)+,r0
bpl 4$
add -(r1),r0
inc r0 ;form day of month
mov r0,r1 ;put # days into r1 for conversion
call dnc
movb #'-,(r2)+ ;store dash
movb nmonth,r1
asl r1 ;form offset into asciz table
asl r1
add #mo.tab,r1 ;form adr. of string
call movbyt
movb #'-,(r2)+
mov nyear,r1 ;print out year modulo 100
call dnc
movb #40,(r2)+
mov (sp)+,r0 ;get partial hours
mov (sp)+,r1 ;get initial remainder
mov r0,-(sp) ;save
clr r0 ;form hours
div #3600.,r0
add (sp)+,r0
mov r1,-(sp) ;save # seconds
mov r0,r1 ;set up for conversion
cmp r1,#10.
bge 6$
movb #'0,(r2)+
6$: call dnc
movb #':,(r2)+
mov (sp)+,r1 ;restore # seconds
clr r0
div #60.,r0 ;form # minutes
mov r0,r1
cmp r1,#10.
bge 7$
movb #'0,(r2)+
7$: call dnc
clrb (r2)+
rts pc
yearl: mov #365.,r1
bit #3,nyear
bne 8$
inc r1
8$: rts pc
entsec dpure
mo.tab: .asciz /jan/
.asciz /feb/
.asciz /mar/
.asciz /apr/
.asciz /may/
.asciz /jun/
.asciz /jul/
.asciz /aug/
.asciz /sep/
.asciz /oct/
.asciz /nov/
.asciz /dec/
entsec mixed
montab: 31.
$feb: 28.
31.
30.
31.
30.
31.
31.
30.
31.
30.
31.
entsec impure
.even
nyear: .blkw
nmonth: .blkb
.even
xitsec
.endc
.end start