# 2.11BSD#431 - /usr/src/new/m11/exec.m11

       1:
       2: ; @(#)exec.m11	1.2 3/26/82
       3: ;this is the key to the bob bowering assembler that has been modified for
       4: ;unix by brent byer
       5: ;symbols for ddt have been added by forrest howard, who also fixed various
       6: ;bugs
       7:         .title  exec    -  assembler exec
       8:
       9:         .ident  /01aug5/
      10:
      11:         .mcall (at)ndebug,sdebug
      12:         .mcall (at)jeq,jne
      13:         .mcall  (at)always,ct.mne,xmit,putkb,putkbl,putlp,genswt
      14:         .mcall  (at)genedt
      15:         .mcall  (at)error,scanw
      16:         .mcall  (at)st.flg
      17:         always
      18:         ct.mne
      19:         st.flg
      20:
      21:
      22:         .macro  strcpy  from,to ,?loop
      23:         mov     r0,-(sp)
      24:         mov     r1,-(sp)
      25:         mov     from,r0
      26:         mov     to,r1
      27: loop:
      28:         movb    (r0)+,(r1)+
      29:         bne     loop
      30:
      31:         mov     (sp)+,r1
      32:         mov     (sp)+,r0
      33:         .endm
      34:         .sbttl          assembly options
      35:
      36: ;the following macro causes assembly options to be
      37: ;printed on the loader map and any implications
      38: ;(second argument) to be defined.  options are
      39: ;selected by equating them to zero.
      40:
      41:         .macro  ldrmap  mne,implies
      42:         .if df  mne
      43:         .list
      44:         .globl  mne
      45:         .nlist
      46:         .irp    x,<implies>
      47:         .globl  x
      48: x=      0                       ;invoke implications
      49:         .endm
      50:         .endc
      51:         .endm   ldrmap
      52:
      53:
      54: ;the following group enables functions
      55:
      56:         ldrmap  rsx11d,<dflgtb>         ;rsx11d "features"
      57:
      58:         ldrmap  debug           ;debug version
      59:         ldrmap  pdpv45          ;pdp-11/45 instructions
      60:         ldrmap  id.spc          ;i- & d-space capability for unix
      61:         ldrmap  dblbuf          ;tran'd input
      62:
      63: ;the following group disables functions
      64:
      65:         .iif df x40&x45,        xfltg=  0
      66:
      67:         ldrmap  xbaw            ;no bells and whistles
      68:         ldrmap  xswit,xcref     ;no switches
      69:         ldrmap  xrel,xedpic     ;abs output only
      70:         ldrmap  xmacro,xsml     ;all generated code (macro, rept, etc.)
      71:         ldrmap  xsml            ;system macros
      72:         ldrmap  x40             ;pdp-11/40 features
      73:         ldrmap  x45             ;pdp-11/45 features
      74:         ldrmap  xfltg,xedfpt    ;floating point evaluation
      75:         ldrmap  xedabs          ;ed.abs
      76:         ldrmap  xedama          ;ed.ama
      77:         ldrmap  xedpic          ;ed.pic
      78:         ldrmap  xedfpt          ;ed.fpt
      79:         ldrmap  xedlsb          ;ed.lsb
      80:         ldrmap  xedpnc          ;ed.pnc
      81:         ldrmap  xedlc           ;ed.lc
      82:         ldrmap  xedcdr          ;card reader format
      83:         ldrmap  xzerr           ;"z" errors
      84:         ldrmap  xlcttm          ;no lpt listing format
      85:         ldrmap  xlcseq          ;sequence numbers
      86:         ldrmap  xtime           ;no time & date on header
      87:         .sbttl          globals
      88:
      89: ;globals defined in assembler
      90:
      91:         .globl  srchi
      92:         .globl  prop1,  endp1,  prop2,  endp2
      93:         .globl  bksiz
      94:         .globl  symlp,  symhp
      95:         .globl  setlc,  seted
      96:         .globl  uc.set, um.set
      97:
      98:
      99:         .globl  pass
     100:
     101:         .globl  putkb,  putkbl, putlp
     102:
     103:         .globl  dnc,    movbyt, savreg, xmit0
     104:
     105:         .globl  linbuf, errcnt, openo,  openc
     106:         .globl  chrpnt, prosw, absexp
     107:
     108:         .globl  xctpas
     109:
     110:
     111: ;globals defined in mcexec
     112:
     113:         .globl  pagnum, linnum
     114:         .globl  inicor, iargv
     115:
     116:         .if ndf xtime
     117:         .globl  dattim
     118:         .endc
     119:         .if ndf xsml
     120:         .globl  finsml, inisml, smlnam, smlfil
     121:         .endc
     122:         .globl  getic,  hdrttl, putoc,  getsrc
     123:         .globl  io.eof, io.eoi, io.tty, io.err
     124:
     125:         .globl  ioftbl, cnttbl, buftbl, ioltbl, chrtbl
     126:         .globl  exttbl, bintbl, lstflg, chntbl
     127:         .globl  $wrsys, $wrbfp, $wrcnt, $brksy, $brkad
     128:
     129:         .globl  symovf, macovf
     130:
     131:         .globl  errrol,crfrol
     132:         .globl  xctprg
     133: errrol= 1
     134:         .mcall  (at)param
     135:
     136:         .globl  $creat, $open, $close, $exit, $read, $write, $sbrk
     137:         .globl  $seek, $gettod, $fork, $wait, $execv
     138:
     139:                                 ;init sectors
     140:
     141:
     142:         entsec  implin
     143:         .blkw
     144:         xitsec
     145:         .sbttl  mcioch - i/o channel assignments
     146:
     147: .macro  genchn  zchan,zlnk,zbuf,ztype,zext,zlen
     148:         setchn  cmo,    cmo,    cmo,    0,      ,80.
     149:         setchn  src,    src,    src,    0,      m11,    132.
     150:         setchn  lst,    lst,    lst,    ,       lst,    512.
     151:         setchn  obj,    obj,    obj,    1,      obj,    42.
     152:         .if ndf xsml
     153:         setchn  sml,    sml,    sml,    0,      sml,    80.
     154:         .endc
     155:         .if ndf xcref
     156:         setchn  crf,    crf,    crf,    ,       xrf,    512.
     157:         .endc
     158: .endm   genchn
     159:
     160:         .macro  setchn  zchan,zlnk,zbuf,ztype,zext,zlen
     161:         .if nb  <zlen>
     162:         param   zbuf'len,       zlen
     163:         .endc
     164:         .endm
     165:
     166:         genchn
     167:
     168:         .globl  objlen
     169:
     170: tmpcnt= 0
     171:         .macro  setchn  zchan,zlnk,zbuf,ztype,zext,zlen
     172:         .list
     173: zchan'chn=      tmpcnt
     174:         .nlist
     175:         .globl  zchan'chn
     176: tmpcnt= tmpcnt+2
     177:         .endm
     178:
     179:         genchn
     180:
     181: maxchn= tmpcnt                  ;just to preserve the count
     182:         .macro  serror  xxx ; was: .macro serror number,message
     183:         mov     xxx,r0          ; was:  jsr	r0,serror
     184:                                 ; was: .asciz	\message\
     185:         jmp     serror          ; new: no return
     186:                                 ;.even
     187:         .endm   serror
     188:
     189: .macro .asclc, str
     190:         .nlist
     191:
     192:         .irpc x, ^%str%
     193:
     194:         .if ge ''x-101
     195:                 .if le ''x-132
     196:                         .byte ''x+40
     197:                 .iff
     198:                         .byte ''x
     199:                 .endc
     200:         .iff
     201:         .byte ''x
     202:         .endc
     203:
     204:         .endm
     205:
     206:         .byte   0
     207:
     208:         .list
     209: .endm
     210:         .sbttl  start of program
     211:
     212:         .globl  start,  fin
     213:
     214:
     215: start:                          ;start of program
     216:         mov     (sp)+,iargc     ;store arg. count
     217:         mov     sp,iargv        ;store pointer to arg. vector
     218:         clr     (sp)
     219:         mov     #dattim,r2      ;set date and time
     220:         sub     #8.,sp          ;allocate a timeval on the stack
     221:         mov     sp,r0
     222:         clr     -(sp)           ;we're not interested in the time zone
     223:         mov     r0,-(sp)        ;pointer to allocated timeval
     224:         tst     -(sp)           ;simulate return address stack spacing
     225:         $gettod
     226:         add     #6.,sp          ;skip up to timeval
     227:         mov     (sp)+,r0        ;snag tv_sec
     228:         mov     (sp)+,r1
     229:         cmp     (sp)+,(sp)+     ;toss tv_usec
     230:         call    cvtim           ;convert to ascii
     231:
     232:         call    xctprg          ;clean up core
     233:         call    inip0           ;output file processing
     234:         call    inip1
     235:         call    prop1   ;pass one
     236:         call    finp1
     237:         call    endp1   ;clean up
     238:         call    inip2
     239:         call    prop2   ;pass 2
     240:         call    endp2
     241:         call    setdn           ;finished, control not returned
     242:
     243:         mov     #objchn,r0
     244:         call    zwrite
     245:         call    zclose
     246:
     247:         mov     #lstchn,r0      ;output any remaining listing
     248:         call    zwrite
     249:
     250:         .if ndf xcref
     251:         mov     crfpnt,r2
     252:         beq     9$
     253:         mov     #crfchn,r0
     254:         call    zwrite          ;dump out any remaining output
     255:         call    zclose          ;close cref tmp. file
     256:         mov     #lstchn,r0
     257:         tst     ioftbl+lstchn
     258:         bne     81$
     259:         mov     cnttbl+crfchn,cnttbl+lstchn
     260:                                 ;set up to recycle (i hope)
     261:         inc     lstflg
     262:         call    openo
     263: 81$:    mov     #lstchn,r2      ;set up name of listing file in linbuf
     264:         call    src.ap
     265:         ; execl("macxrf", "macxrf", "-flags", "fred.xrf", "fred.lst", 0);
     266:         ;	meaning of flags arg:
     267:         ;	"-"	m11 invoked with -cr only: do the standard stuff
     268:         ;	"-am.." other letters added as extra cr flags invoked.
     269:         ;
     270:         mov     #crefav,-(sp)   ;cref will do the rest!!
     271:         mov     #crfrun,-(sp)
     272:         tst     -(sp)           ;simulate return address stack spacing
     273:         $execv
     274:         add     #6.,sp
     275:
     276:
     277:         br      $$exit
     278:         .endc
     279:
     280: 9$:     tst     lpflag          ;spooler requested?
     281:         beq     $$exit          ;no, leave
     282:
     283:         mov     #lstchn,r0      ;yes, close listing channel
     284:         mov     r0,r2           ;copy for src.ap
     285:         call    zclose
     286:         call    src.ap          ;put name of lst file into linbuf
     287:         mov     #lpargs,-(sp)   ;take it away, LPR!
     288:         mov     #lprrun,-(sp)
     289:         tst     -(sp)           ;simulate return address stack spacing
     290:         $execv
     291:         add     #6.,sp
     292:
     293: $$exit: clr     r0              ;leave r0 set corectly
     294:         tst     errcnt
     295:         beq     1$              ;no problems
     296:         inc     r0              ;return 1
     297: 1$:
     298:         mov     r0,-(sp)        ;that's all, folks!
     299:         tst     -(sp)           ;simulate return address stack spacing
     300:         $exit
     301:
     302:
     303:
     304:         entsec  dpure
     305: lpargs: lprrun
     306:         linbuf
     307:         0
     308:
     309: lprrun: .asclc  /usr/ucb/lpr
     310:         .even
     311:
     312:
     313:
     314:         entsec  mixed
     315:
     316: argc:   .blkw   1
     317: iargc:  .blkw   1
     318: iargv:  .blkw   1
     319: argv:   .blkw   1
     320: symlp:  <^pl xpcor>
     321: symhp:  <<<^ph xpcor>+63.>&^c63.>-2
     322:
     323:         entsec  impure
     324:
     325: lstflg: .blkw   1
     326: lttflg::        .blkw   1
     327: crfpnd: .blkw   1
     328: no.flg: .blkw   1
     329: u.flag::        .blkw   1               ; user wants UNIX style line numbers
     330: lpflag: .blkw   1
     331: mx.flg::        .blkw   1               ; if set, do macro expansion ONLY
     332: xx.flg::        .blkw   1               ; debug switch
     333: my.flg::        .blkw   1               ; and also show the pre-xpnd srce lines
     334: sx.flg::        .blkw   1               ; if set, generate more local syms syms
     335: pdp10::         .blkw   1               ; check for model dependencies in
     336:                                         ; the instruction set
     337:         entsec  mixed
     338: crefil: .blkw   30                      ; name of cref file: /fred.xrf/
     339: crefav: .word   crfrun
     340:         .word   crflag+1
     341:         .word   crefil
     342:         .word   linbuf
     343:         .word   0
     344: crflag: .ascii  /--/
     345:         .blkw   5
     346: crap:   .word   crflag+2
     347:
     348:         xitsec
     349:         .sbttl  output file initialization
     350:
     351: inip0:                          ;initialize things
     352:         mov     #cmochn,r0      ;set up cmo
     353:         call    zopen
     354:         mov     #1,chntbl+cmochn        ;it is file handle #1
     355:         call    inip0z          ;set up argc & argv
     356: 1$:     dec     argc            ;any more arguments?
     357:         blt     9$              ;no, return
     358:         mov     argv,r0         ;yes, get pointer to next arg.
     359:         mov     (r0)+,r1        ;  into r1
     360:         mov     r0,argv         ;store back new argv
     361:         tst     r1
     362:         beq     1$              ;ignore null pointers (maybe, first one)
     363:         cmpb    (r1)+,#'-       ;is switch indicated?
     364:         beq     3$              ;yes
     365:         mov     -(r0),srcnam    ;no , last name will be prefix
     366:         br      1$
     367: 3$:     ;here is hack for explicit name switch
     368:         cmpb    (r1),#'n
     369:         bne     33$
     370:         cmpb    1(r1),#'a
     371:         bne     33$
     372:         add     #3,r1           ;move past na:
     373:         mov     r1,esrcnam
     374:         br      1$
     375: 33$:    mov     #linbuf,r2      ;point to dest. for switch
     376:         mov     r2,r3           ;make copy
     377:         clr     (r2)+           ;zap initially
     378:         mov     r2,chrpnt       ;copy pointer here for arg.
     379: 4$:     movb    (r1)+,r0        ;get char.
     380:         call    mk.up           ;make upper case
     381:         ble     55$             ;null or :
     382:         movb    r0,(r3)+        ;ok, store
     383:         cmp     r3,r2           ;max. of 2 chars.
     384:         blo     4$
     385: 5$:     movb    (r1)+,r0        ;store rest of arg. in linbuf
     386:         call    mk.up           ;check it and make upper case
     387: 55$:    bge     6$              ;neg. indicates :
     388:         mov     #40,r0          ;replace with space
     389: 6$:     movb    r0,(r2)+
     390:         bne     5$              ;continue till null
     391:         mov     linbuf,r0       ;restore switch name into r0
     392: 7$:     call    prosw           ;process the switch
     393:         bne     1$              ;continue if no error
     394: 8$:     serror  #swcerr
     395:
     396: 9$:
     397: 19$:    tst     srcnam          ;must be at least one filename
     398:         beq     $$exit          ;or we are just a no-op.
     399:         return
     400:
     401: .globl  cttbl                   ; defined in misc.m11
     402:
     403: mk.up:
     404:         bic     #^c177,r0
     405:         cmpb    #ct.lc,cttbl(r0)
     406:         bne     1$              ; if lower, make upper
     407:         sub     #40,r0
     408: 1$:     cmpb    #':,r0          ; if input is a colon,
     409:         bne     2$
     410:         neg     r0              ; return MINUS COLON !!!
     411: 2$:     tst     r0              ; else return input
     412:         return
     413:
     414:         entsec  impure
     415: srcnam: .blkw   1
     416: esrcnam: .blkw  1
     417:         xitsec
     418:         genswt  no,no.set
     419: no.set: inc     no.flg          ;indicate no object output
     420:         return
     421:
     422:         genswt  uc,uc.set       ; revert to bad old DEC upper case rules
     423:         genswt  um,um.set       ; revert to bad old Harvard upper case rules
     424:
     425:         genswt  sx,sx.set
     426: sx.set: inc     sx.flg
     427:         return
     428:
     429:         genswt  u,u.set
     430:
     431: u.set:  inc     u.flag
     432:         return
     433:         genswt  xx,xx.set
     434: xx.set: inc     xx.flg
     435:         return
     436:         genswt  mx,mx.set
     437:         genswt  my,my.set
     438:         genswt  lt,lt.set
     439: mx.set:
     440:         call    no.set
     441:         call    lt.set
     442:         inc     mx.flg
     443:         return
     444: my.set:
     445:         inc     my.flg
     446:         br      mx.set
     447:
     448:         genswt  10,setten
     449: setten:
     450:         inc     pdp10
     451:         return
     452: lt.set:
     453:         mov     #1,lttflg
     454:         call    ls.set
     455:         movb    #'o,@crap               ; tell cref to go on stdout, too.
     456:         inc     crap
     457:         return
     458: .if     ne,mk.symbol
     459:         genswt  ns,ns.set
     460:
     461: ns.set: inc     out$ym
     462:         return
     463:
     464:         .globl  out$ym
     465: .endc
     466:         .globl  fixtit
     467:         .globl  ed.gbl, eddflt
     468:         genswt  xs,xs.set
     469: xs.set:                         ; obsolete
     470:         call    absexp          ; so that -xs:3 wont genrerate a 'bad switch'
     471:                                 ; error.
     472:         return
     473:
     474:         genswt  ha,ha.set
     475:         genswt  de,de.set
     476: ha.set:
     477:         inc     veritas                         ; reinstate addf #12,3,fr1
     478:         mov     #harvid,vernam
     479:         call    um.set
     480:         ;	harvard .psect attrib scheme uses same defaults as UCB,
     481:         ;	but uses them wrong.  The 'veritas' flag tells when to misuse
     482:         ;	them.  See 'psect' in xlat.m11
     483:         ;
     484:         bis     #ed.gbl,eddflt
     485:         jmp     fixtit
     486: de.set:
     487:         call    uc.set
     488:         mov     #decid,vernam
     489:         ;
     490:         ; incomprehensible but true DEC default attribute patterns
     491:         ;
     492:         mov     #insflg!pattrs,psdflt
     493:         mov     #insflg!cattrs,csdflt
     494:         mov     #insflg!aattrs,asdflt
     495:         bis     #ed.gbl,eddflt
     496:         jmp     fixtit
     497:
     498:         genswt  dp,dp.set
     499:         genswt  da,da.set
     500:         genswt  dc,dc.set
     501:         .globl  psdflt,asdflt,csdflt,psarol     ; in xlat.m11:  .psect atribs
     502:
     503: da.set:
     504:         mov     #asdflt,-(sp)
     505:         br      dx.set
     506: dc.set:
     507:         mov     #csdflt,-(sp)
     508:         br      dx.set
     509: dp.set:
     510:         mov     #psdflt,-(sp)
     511: dx.set:
     512:         call    gsarg
     513:         beq     9$
     514:         scanw   psarol
     515:         beq     10$
     516:         bisb    symbol+2,@(sp)
     517:         bicb    symbol+3,@(sp)
     518:         br      dx.set
     519: 10$:    error   45,a,<illegal .psect attribute>
     520: 9$:
     521:         tst     (sp)+
     522:         return
     523:
     524:         genswt  ls,ls.set
     525:         genswt  lp,lp.set
     526:
     527: lp.set: inc     lpflag          ;note spooler request
     528:         movb    #'l,@crap
     529:         inc     crap
     530: ls.set: inc     lstflg          ;note lst file req.
     531:         mov     #lstchn,r2      ;set up to add buffer for lstchn
     532: addbuf: mov     symlp,r0        ;get cur. free loc.
     533:         mov     r0,cnttbl(r2)   ;that's where our byte count will go
     534:         tst     (r0)+           ;now point to our buffer
     535:         mov     r0,buftbl(r2)
     536:         add     ioltbl(r2),r0   ;allow for length of buffer
     537:         mov     r0,symlp        ;new free loc.
     538:
     539:         return
     540:
     541: .if ndf xcref
     542:         genswt  cr,cr.set
     543:         genedt  crf
     544:         .globl  ed.crf,edmask,gsarg,cpopj
     545: cr.set:
     546:         tst     crfpnd
     547:         bne     2$
     548:         inc     crfpnd          ;note pending cref
     549:         bis     #ed.crf,edmask  ; so .enabl/.dsabl crf will work.
     550: 1$:
     551:         call    gsarg
     552:         beq     3$
     553:         scanw   crfrol
     554:         beq     9$
     555:         movb    symbol+4,@crap
     556:         inc     crap
     557:         br      1$
     558: 3$:
     559:         mov     #crfchn,r2      ;set up buffer for it
     560:         jmp     addbuf
     561:
     562: 9$:
     563:         error   55,a, <illegal cref argument>
     564: 2$:
     565:         return
     566:
     567:         .macro  gencrf  name,char
     568:         entsec  crfsec
     569:         .even
     570:         .rad50  /name/
     571:         .word   cpopj
     572:         .word   char
     573:         .endm
     574:         gencrf  s,'s
     575:         gencrf  sy,'s
     576:         gencrf  sym,'s
     577:         gencrf  r,'r
     578:         gencrf  re,'r
     579:         gencrf  reg,'r
     580:         gencrf  m,'m
     581:         gencrf  ma,'m
     582:         gencrf  mac,'m
     583:         gencrf  p,'p
     584:         gencrf  pe,'p
     585:         gencrf  per,'p
     586:         gencrf  pst,'p
     587:         gencrf  c,'c
     588:         gencrf  cs,'c
     589:         gencrf  cse,'c
     590:         gencrf  sec,'c
     591:         gencrf  pse,'c
     592:         gencrf  e,'e
     593:         gencrf  er,'e
     594:         gencrf  err,'e
     595:
     596:         xitsec
     597:
     598: .endc
     599:         .sbttl  pass initialization
     600:
     601: inip1:                  ;init for pass 1
     602:         mov     #lstchn,r0
     603:         call    openo
     604:         call    srchi           ;init the symbol table & rolls
     605:         br      inip2f          ;set source for pass
     606:
     607: inip2:                          ;init for pass 2
     608:         inc     pass
     609:         tst     crfpnd
     610:         beq     inip2f
     611:         call    crfset
     612: inip2f: call    setlc
     613:         .globl  mx.2 , mdepth
     614:         .globl  mac.er
     615:         clr     mx.2
     616:         clr     mdepth
     617:         call    seted
     618: inip0z: mov     iargv,argv      ;init count & pointer to args.
     619:         mov     iargc,argc
     620:         dec     argc
     621:         add     #2,argv
     622:         return
     623:         .sbttl  end of pass routines
     624:
     625: finp1:                          ;finish of pass
     626:         mov     #srcchn,r0
     627:         call    zclose
     628:         return
     629:
     630:
     631:
     632: openo:                          ;open output file
     633:         call    savreg
     634:         mov     r0,r2           ;copy r0 (chn. #)
     635:         cmp     r0,#lstchn      ;is it list channel?
     636:         bne     1$              ;no
     637:         tst     lttflg          ; <<< REEDS june 1981
     638:         beq     100$            ; <<<
     639:         mov     #1,r0           ; <<< use standard output if -lt flag in use
     640:         br      7$              ; <<<
     641: 100$:
     642:         tst     lstflg          ;yes, is listing enabled (-ls) ?
     643:         beq     9$              ;no, ignore
     644: 1$:     cmp     r0,#objchn      ;is this object channel?
     645:         bne     11$             ;no
     646:         tst     no.flg          ;were we told to withhold obj. o/p ?
     647:         bne     9$              ;yes, ignore
     648: 11$:    call    src.ap          ;set up name in linbuf
     649:         mov     #linbuf,$crtnm  ;  and pointer to name
     650: 2$:     mov     $crtmd,-(sp)
     651:         mov     $crtnm,-(sp)
     652:         tst     -(sp)
     653:         $creat
     654:         bcs     99$
     655:         add     #6.,sp
     656:         br      7$
     657: 99$:
     658:         add     #6.,sp
     659:         mov     #linbuf,r1      ;no good, complain
     660: 3$:     tstb    (r1)+           ;find end of filename
     661:         bne     3$
     662:         dec     r1              ;back up over null
     663:         mov     #ncmsg,r0       ;append rest of msg.
     664: 4$:     movb    (r0)+,(r1)+
     665:         bne     4$
     666:         putkb   #linbuf
     667:         return
     668:
     669: 7$:     mov     r0,chntbl(r2)   ;store file handle
     670:         mov     r2,r0           ;restore r0 with chn. #
     671:         call    zopen
     672: 9$:     return
     673: src.fp:
     674:         mov     srcnam,r1       ;transfer file name from src prefix
     675:         tst     esrcnam
     676:         beq 1$
     677:         mov     esrcnam,r1
     678: 1$:
     679:         mov     #linbuf,r0      ;and store in linbuf
     680: nam.fp: clr     -(sp)           ;clear "." flag
     681: 2$:     movb    (r1)+,(r0)+     ;transfer a byte
     682:         beq     4$              ;move on if done
     683:         cmpb    -1(r0),#'.      ;not null, was it a "." ?
     684:         beq     3$              ;yes, set flag and cont.
     685:         cmpb    -1(r0),#'/      ;no, was it / ?
     686:         bne     2$              ;no, continue
     687:         clr     (sp)            ;yes, clear flag
     688:         br      2$              ;continue
     689: 3$:     mov     r0,(sp)         ;flag with adr. past period.
     690:         br      2$
     691: 4$:     mov     r0,r1           ;copy adr. past terminating null
     692:         mov     (sp)+,r0        ;restore period flag (adr.)
     693:         bne     5$              ;if set, move on
     694:         mov     r1,r0           ;use this adr.
     695: 5$:     dec     r0              ;back up pointer to null or period.
     696:         return
     697:
     698: nam.ap: call    nam.fp          ;move to period
     699:         br      ap.ext
     700:
     701: src.ap: call    src.fp          ;find period.
     702:                                 ; and plop appropriate ext. in
     703:
     704: ap.ext: tstb    (r0)+           ;period here?
     705:         bne     1$              ;yes, assuming non-null is a period
     706:         movb    #'.,-1(r0)      ;no, put one in
     707: 1$:     mov     exttbl(r2),r1   ;get pointer to ext.
     708: 2$:     movb    (r1)+,(r0)+     ;store the ext. at end of name
     709:         bne     2$
     710: 7$:     return
     711:         .sbttl  end of program cleanup
     712:
     713: setdn:                          ;clean up
     714:         mov     #finmsg,r1      ;set for final message
     715:         mov     #linbuf,r2
     716:         call    movbyt          ;move into linbuf
     717:         mov     errcnt,r1
     718: ; ***	beq	1$		;don't bother if successful
     719:         call    dnc             ;print in decimal
     720:         clrb    (r2)
     721:
     722:         tst     mx.flg
     723:         bne     1$
     724:         tst     lttflg          ; <<< REEDS june 81
     725:         beq     100$            ; <<< REEDS june 81
     726:         putlp   #linbuf         ; <<< REEDS june 81
     727:         br      1$              ; <<< REEDS june 81
     728: 100$:   putkbl  #linbuf         ;list to kb & lp
     729:
     730: 1$:     return
     731: serror:                         ;"s" error
     732:         call    putkb
     733:         call    mac.er                  ;maybe caused by macro explosion
     734:         mov     #1,r0
     735:         mov     r0,-(sp)
     736:         tst     -(sp)                   ;simulate return address stack spacing
     737:         $exit
     738:
     739: ; symovf:	serror	217,<symbol table overflow>
     740: symovf:
     741:                 serror  #symerr
     742: macovf:         call    mac.er
     743:                 serror  #macerr         ; no return: exit sys call
     744:
     745: getic:                          ;get input character
     746:         dec     @cnttbl(r0)     ;any chars left in line?
     747:         blt     4$              ;  no
     748:         clr     r5
     749:         bisb    @chrtbl(r0),r5  ;yes, fetch next
     750:         inc     chrtbl(r0)      ;bump count
     751:         return
     752:
     753: 4$:     tst     ioftbl(r0)      ;file initted?
     754:         beq     5$              ;no, do so
     755:         call    zread           ;read and wait
     756:         mov     ioftbl(r0),r5   ;get condition flags
     757:         bic     #^c<io.eof!io.err>,r5   ;clear extraneous
     758:         beq     getic           ;branch if nothing special
     759:         bit     #io.eof,r5
     760:         beq     9$              ;  error, exit
     761:         mov     #io.eoi,r5      ;in case not source
     762:         cmp     r0,#srcchn      ;is it src.?
     763:         bne     9$              ;no
     764: 5$:     call    getsrc          ;open next source file
     765:         mov     #io.eoi,r5      ;in case unsuccessful
     766:         tst     ioftbl+srcchn   ;winner?
     767:         beq     9$              ;no
     768:         mov     #io.eof,r5      ;set end-of-file
     769: 9$:     bis     #100000,r5      ;set flag bit
     770:         return
     771:
     772:         .globl  err.by          ; array holds file name for error printer
     773: getsrc:
     774:         clrb    err.by
     775:         clr     fileln          ; start unix line numbers over
     776:         mov     #srcchn,r0      ;use source chn.
     777:         mov     r0,-(sp)
     778:         mov     r1,-(sp)
     779:         mov     r2,-(sp)
     780:         mov     r0,r2           ;copy chn. #
     781:         call    zclose          ;close current source input
     782: 1$:     dec     argc            ;any left?
     783:         blt     7$              ;no
     784:         mov     argv,r0         ;point to next arg.
     785:         mov     (r0)+,r1
     786:         mov     r0,argv
     787:         tst     r1              ;ignore null pointer
     788:         beq     1$
     789:         cmpb    (r1),#'-        ;switch?
     790:         beq     1$              ;yes, ignore
     791:         mov     buftbl+srcchn,r0        ;point to dest. of name
     792:         mov     r0,$opnnm       ;set up pointer to name
     793:         call    nam.fp          ;transfer name & find period.
     794:         clr     -(sp)           ;clear retry indicator
     795:         tstb    (r0)            ;was ext. specified?
     796:         bne     13$             ;yes, try it as is
     797:         mov     r0,(sp)         ;no, save adr. of null
     798:         call    ap.ext          ;append default ext.
     799: 13$:    clr     $opnmd          ;set up mode as "read"
     800:         mov     $opnmd,-(sp)
     801:         mov     $opnnm,-(sp)
     802:         tst     -(sp)           ;simulate return address stack spacing
     803:         $open
     804:         bcs     99$             ;if ok, move on
     805:         add     #6.,sp
     806:         br      3$
     807: 99$:
     808:         add     #6,sp
     809:         tst     (sp)            ;prepared to retry w/o ext.?
     810:         beq     14$             ;no, not found!
     811:         clrb    @(sp)           ;yes, remove ext.
     812:         clr     (sp)            ;just one retry
     813:         br      13$
     814: 14$:    mov     #linbuf,r1      ;store msg. in buffer
     815:         mov     $opnnm,r0
     816: 15$:    movb    (r0)+,(r1)+
     817:         bne     15$             ;store file name
     818:         dec     r1              ;back up pointer
     819:         mov     #nfmsg,r0
     820: 2$:     movb    (r0)+,(r1)+
     821:         bne     2$
     822:         putkb   #linbuf
     823:         mov     #1,-(sp)        ;indicate error status
     824:         tst     -(sp)           ;and die
     825:         $exit
     826:
     827: 3$:     mov     r0,chntbl+srcchn        ;store file handle.
     828:         bis     #io.opn,ioftbl+srcchn   ;denote open
     829:         clr     @cnttbl+srcchn  ;beware of dos "feature"
     830:         tst     (sp)+           ;flush retry indicator
     831:         mov     $opnnm,r1
     832:         mov     #err.by,r2
     833:         call    movbyt
     834:         clrb    (r2)
     835: 4$:     mov     argc,r0         ;get arg. count
     836:         mov     argv,r1         ;and vector ptr.
     837: 5$:     dec     r0              ;any left?
     838:         blt     7$              ;no
     839:         cmpb    @(r1)+,#'-      ;yes, but is it switch?
     840:         beq     5$              ;yes
     841:         clr     r5              ;no, note another file to go
     842: 6$:
     843: 10$:    mov     (sp)+,r2
     844:         mov     (sp)+,r1
     845:         mov     (sp)+,r0
     846:         return
     847: 7$:     mov     sp,r5           ;note no more files
     848:         br      6$
     849:
     850: putoc:  cmp     @cnttbl(r0),ioltbl(r0)  ;any room left?
     851:         bge     5$              ;no
     852:         movb    r1,@chrtbl(r0)  ;yes
     853:         inc     chrtbl(r0)
     854:         inc     @cnttbl(r0)
     855: 4$:     return
     856: 5$:     bit     #io.opn,ioftbl(r0)      ;open?
     857:         beq     4$              ;no, return
     858:         call    zwrite          ;yes, dump buffer
     859:         br      putoc           ;try again
     860:         .sbttl  system macro handlers
     861:
     862:         .if ndf xsml
     863:
     864: inisml:                         ;init sml file
     865:         mov     #smlchn,r0      ;open 'er up
     866:         tst     ioftbl(r0)
     867:         bne     finsml
     868:         call    zopen
     869:         mov     smlnam,r1       ;get pointer to name prefix
     870:         mov     #smlfil,r0      ;point to destination of complete string
     871:         mov     r0,$opnnm       ;make copy for system call
     872:         mov     #smlchn,r2      ;set up channel #
     873:         call    nam.fp          ;transfer name to smlfil & find period.
     874:         tstb    (r0)            ;ext. specified?
     875:         bne     1$              ;yes
     876:         call    ap.ext          ;no, supply default
     877: 1$:     clr     $opnmd          ;for reading
     878:         mov     $opnmd,-(sp)
     879:         mov     $opnnm,-(sp)
     880:         tst     -(sp)
     881:         $open
     882:         bcc     99$
     883:         add     #6.,sp
     884:         br      finsml
     885: 99$:
     886:         add     #6.,sp
     887:         mov     r0,chntbl+smlchn
     888:         mov     sp,r0           ;flag good (non-zero) return
     889:         return
     890:
     891: finsml:                         ;close out sml file
     892:         mov     #smlchn,r0      ;  and release it
     893:         call    zrlse
     894:         clr     r0              ;signal that we're through
     895:         return
     896:
     897:
     898:         .data
     899: .globl  veritas
     900: veritas:        .blkw                           ; harvard retrocomat in effect
     901: ;
     902:
     903:         entsec  impure
     904:
     905: smlnam: .blkw   1
     906: smlfil: .blkw   20              ;macro filename (.sml) goes here
     907:
     908:         xitsec
     909:
     910:         .endc
     911:         .sbttl  init/read/write routines
     912:
     913:         .globl  zread,  zwrite
     914:
     915: zinit:                          ;init a device
     916:         bis     #io.ini,ioftbl(r0)      ;flag as in use
     917:         return
     918:
     919: zopen:  bis     #io.opn,ioftbl(r0)
     920:         mov     buftbl(r0),chrtbl(r0)
     921:         clr     @cnttbl(r0)
     922:         return
     923:
     924: zread:                          ;read a line
     925:         mov     r0,-(sp)
     926:         mov     r1,-(sp)
     927:         mov     r0,r1
     928:         mov     buftbl(r0),$rdbfp
     929:         mov     ioltbl(r0),$rdcnt
     930:         mov     buftbl(r0),chrtbl(r0)
     931:         mov     $rdcnt,-(sp)
     932:         mov     $rdbfp,-(sp)
     933:         mov     chntbl(r0),-(sp);get file handle
     934:         tst     -(sp)
     935:         $read
     936:         bcs     99$
     937:         add     #8.,sp
     938:         br      1$
     939: 99$:
     940:         add     #8.,sp
     941:         bis     #io.err,ioftbl(r1)
     942:         br      8$
     943: 1$:     mov     r0,@cnttbl(r1)  ;store count of chars. read
     944:         bne     8$
     945:         bis     #io.eof,ioftbl(r1)      ;eof if none
     946: 8$:
     947:         mov     (sp)+,r1
     948:         mov     (sp)+,r0
     949:         return
     950: zwrite:                         ;write a line
     951:         mov     r0,-(sp)
     952:         mov     r1,-(sp)
     953:         mov     r2,-(sp)
     954:         mov     r0,r2
     955:         bit     #io.opn,ioftbl(r0)      ;only if open
     956:         beq     9$
     957:         mov     buftbl(r0),r1
     958:         mov     @cnttbl(r0),r0
     959:         beq     4$              ;and non-zero count
     960:         tst     bintbl(r2)      ;binary?
     961:         ble     59$             ;  no
     962:         mov     r2,-(sp)
     963:         add     #4,r0
     964:         mov     r0,-(r1)
     965:         mov     #1,-(r1)
     966:         mov     r0,-(sp)
     967:         add     r1,r0
     968:         clr     -(sp)
     969: 51$:    movb    (r1)+,r2
     970:         add     r2,(sp)
     971:         cmp     r1,r0
     972:         blo     51$
     973:         neg     (sp)
     974:         movb    (sp)+,(r1)
     975:         clrb    1(r1)
     976:         mov     (sp)+,r0
     977:         sub     r0,r1
     978:         bis     #1,r0
     979:         inc     r0
     980:         mov     (sp)+,r2
     981: 59$:    mov     r0,$wrcnt       ;store byte count
     982:         mov     r1,$wrbfp       ;and buffer adr.
     983:         mov     $wrcnt,-(sp)
     984:         mov     $wrbfp,-(sp)
     985:         mov     chntbl(r2),-(sp);get file handle
     986:         tst     -(sp)
     987:         $write
     988:         bcs     99$
     989:         add     #8.,sp
     990:         br      4$
     991: 99$:
     992:         add     #8.,sp
     993:         bis     #io.err,ioftbl(r2)      ;error
     994: 4$:     clr     @cnttbl(r2)     ;clear count initially
     995:         mov     buftbl(r2),chrtbl(r2)   ;point to beg. of buffer
     996: 9$:     mov     (sp)+,r2
     997:         mov     (sp)+,r1
     998:         mov     (sp)+,r0
     999:         return
    1000: zclose:                         ;close file
    1001:         bit     #io.opn,ioftbl(r0)      ;is file open?
    1002:         beq     1$              ;no
    1003:         mov     r0,-(sp)        ;yes, save r0
    1004:         mov     chntbl(r0),-(sp) ;get file handle
    1005:         tst     -(sp)           ;close
    1006:         $close
    1007:         cmp     (sp)+,(sp)+
    1008:         mov     (sp)+,r0
    1009:         clr     ioftbl(r0)
    1010:         clr     @cnttbl(r0)
    1011: 1$:     return
    1012:
    1013: zrlse:                          ;close and release file
    1014:         call    zclose          ;be sure it's closed
    1015:         clr     ioftbl(r0)      ;clear device table
    1016:         return
    1017:         .sbttl  messages
    1018:
    1019:         entsec  imppas
    1020: pagnum: .blkw                   ;page number
    1021: linnum: .blkw   2               ;line number
    1022: fileln::        .blkw   1               ; true line number in file
    1023:         entsec  mixed
    1024:
    1025:
    1026:         .if ndf xtime
    1027: dattim: .ascii  /00-xxx-00 /
    1028: datti1: .ascii  /00:00/
    1029: datti2: .ascii  /:00/
    1030:         .even
    1031:         .endc
    1032:
    1033:         entsec  dpure
    1034:
    1035: ;endp1m:	.asciz	/end of pass/
    1036: macerr: .asciz  /macro text overflow/
    1037: symerr: .asciz  /symbol table overflow/
    1038: swcerr: .asciz  /bad switch/
    1039: finmsg: .asciz  /errors detected:  /
    1040:
    1041: nfmsg:  .asciz  / not found/
    1042: ncmsg:  .asciz  / - can't create/
    1043:
    1044:         .even
    1045:
    1046:         entsec  mixed
    1047: vernam::        1$              ; addr of default logo
    1048: 1$:     .asciz  /UCB m11 v1.2 /
    1049: harvid: .asciz  /Harvard m11 /
    1050: decid:  .asciz  /DEC Macro-11 /
    1051:         .even
    1052:
    1053:         xitsec
    1054:         .sbttl  i/o tables
    1055:
    1056:         .list   meb
    1057:                                 ;i/o flags
    1058: io.ini= 000001                  ;initted
    1059: io.opn= 000002                  ;opened
    1060: io.tty= 000004                  ;device is tty
    1061: io.eof= 000010                  ;eof seen
    1062: io.err= 000020                  ;error encountered
    1063: io.eoi= 000040                  ;end of input
    1064: io.out= 100000                  ;output device
    1065:
    1066:         entsec  impure
    1067: ioftbl: .blkw   maxchn/2        ;i/o flag table
    1068:
    1069:         entsec  dpure
    1070: ioltbl:                         ;i/o length table
    1071:         .macro  setchn  zchan,zlnk,zbuf,ztype,zext,zlen
    1072:         .list
    1073:         .word   zbuf'len
    1074:         .nlist
    1075:         .endm
    1076:         genchn
    1077:
    1078:         .list
    1079:
    1080:         .macro  setchn  zchan,zlnk,zbuf,ztype,zext,zlen
    1081:         .list
    1082:         .if nb zext
    1083: zchan'ext:      .asclc  zext
    1084:         .endc
    1085:         .nlist
    1086:         .endm
    1087:
    1088:         genchn
    1089:
    1090:         .even
    1091: nulext: .word   0
    1092:
    1093:
    1094:         entsec  mixed
    1095: exttbl:
    1096:         .macro  setchn  zchan,zlnk,zbuf,ztype,zext,zlen
    1097:         .list
    1098:         .if nb zext
    1099:         .word   zchan'ext
    1100:         .iff
    1101:         .word   nulext
    1102:         .endc
    1103:         .nlist
    1104:         .endm
    1105:
    1106:         genchn
    1107:         entsec  mixed
    1108: cnttbl:                         ;pointer to counts
    1109:         .macro  setchn  zchan,zlnk,zbuf,ztype,zext,zlen
    1110:         .list
    1111:         .if nb ztype
    1112:         .word   zbuf'buf-2
    1113:         .iff
    1114:         .word   0
    1115:         .endc
    1116:         .nlist
    1117:         .endm
    1118:         genchn
    1119:
    1120:
    1121: buftbl:                         ;pointers to buffers
    1122:         .macro  setchn  zchan,zlnk,zbuf,ztype,zext,zlen
    1123:         .list
    1124:         .if nb ztype
    1125:         .word   zbuf'buf
    1126:         .iff
    1127:         .word   0
    1128:         .endc
    1129:         .nlist
    1130:         .endm
    1131:         genchn
    1132:
    1133:         entsec  impure
    1134: chrtbl:                         ;char pointer table
    1135:         .blkw   maxchn/2
    1136:
    1137:
    1138: chntbl:                 ;channel <--> file handle table
    1139:         .blkw   maxchn/2
    1140:
    1141:         entsec  mixed
    1142:
    1143: bintbl:
    1144:         .macro  setchn  zchan,zlnk,zbuf,ztype,zext,zlen
    1145:         .list
    1146:         .if nb ztype
    1147:         .word   ztype
    1148:         .iff
    1149:         .word   0
    1150:         .endc
    1151:         .nlist
    1152:         .endm
    1153:
    1154:         genchn
    1155:         .macro  setchn  zchan,zlnk,zbuf,ztype,zext,zlen
    1156:         .if nb  <ztype>
    1157:         entsec  impure
    1158:         .list
    1159:
    1160:         .blkw   3
    1161: zbuf'buf:       .blkw   <zbuf'len+1>/2+2
    1162:         .nlist
    1163:         .endc
    1164:         .endm
    1165:
    1166:         genchn
    1167:
    1168:
    1169:         entsec  mixed
    1170: $wrbfp: .blkw   1
    1171: $wrcnt: .blkw   1
    1172:
    1173: $rdbfp: .blkw   1
    1174: $rdcnt: .blkw   1
    1175:
    1176: $crtnm: .blkw   1
    1177: $crtmd: .word   0644
    1178:
    1179:
    1180: $opnnm: .blkw   1
    1181: $opnmd: .blkw   1
    1182:
    1183: $brkad: .blkw   1
    1184:
    1185:         xitsec
    1186:         .sbttl  cross reference handlers
    1187:
    1188:         .if ndf xcref
    1189:
    1190: crfset:                         ;cref switch processor
    1191:         tst     pass
    1192:         beq     9$
    1193:         mov     #crfchn,r0
    1194:         call    openo
    1195:         bit     #io.opn,ioftbl+crfchn   ;successful?
    1196:         beq     9$              ;no
    1197:         strcpy  #linbuf,#crefil
    1198:         mov     sp,crfpnt       ;yes, flag non-null
    1199: 9$:     return
    1200:         .globl  crfdef, crfref, rolndx, r50unp
    1201:
    1202:         .nlist  meb
    1203:         .if df  xcref
    1204: crfref: crfdef: return
    1205:         .iff
    1206:
    1207:         .globl  symbol
    1208:
    1209: crfdef: inc     crfdfl          ;cref definition
    1210: crfref: tst     crfpnt          ;any cref output at this time?
    1211:         jeq     9$              ;  no
    1212:         tst     pass
    1213:         jeq     9$              ; experiment
    1214:         tst     pagnum          ;started yet?
    1215:         jeq     9$              ;  no, forget it
    1216:         bit     #ed.crf,edmask  ; cref might be turned off for a while
    1217:         jeq     9$
    1218:         call    savreg
    1219: 1$:     cmp     crfpag,pagnum   ;new page?
    1220:         bhis    2$              ;  no
    1221:         mov     #cr.pag,r1      ;yes, send flag
    1222:         call    putxrf
    1223:         inc     crfpag
    1224:         clr     crflin
    1225:         br      1$
    1226:
    1227: 2$:     cmp     crflin,linnum   ;new line number?
    1228:         bhis    3$              ;  no
    1229:         mov     #cr.lin,r1
    1230:         call    putxrf
    1231:         inc     crflin
    1232:         br      2$
    1233:
    1234: 3$:     tst     symbol          ;ignore null symbols
    1235:         jeq     8$
    1236:         mov     #crftyp,r1
    1237: 4$:
    1238:         cmpb    rolndx,(r1)+    ;map roll number to cref type
    1239:         bne     4$
    1240:         sub     #crftyp+1-cr.sym,r1
    1241:         call    tstreg
    1242:         tst     xxxreg
    1243:         beq     44$
    1244:         movb    #25,r1
    1245: 44$:
    1246:         clr     xxxreg
    1247:         call    putxrf
    1248:         mov     #crfsym,r2      ;point to where symbol gets unpacked to
    1249:         call    r50unp          ;unpack the symbol
    1250:         mov     #crfsym,r2      ;point to beginning of unpacked symbol
    1251: 5$:     movb    (r2)+,r1        ;get symbol char.
    1252:         cmpb    r1,#space       ;space is end
    1253:         beq     55$
    1254:         call    putxrf          ;non-space - output it
    1255:         cmp     r2,#crfsym+6    ;max. of 6 chars.
    1256:         blo     5$
    1257: 55$:    mov     crfdfl,r1       ;set "#" bit
    1258:         tstb    opclas
    1259:         bpl     6$              ;branch if no "*"
    1260:         bis     #2,r1
    1261: 6$:     bis     #cr.sym,r1      ;set terminator
    1262:         call    putxrf          ;send it
    1263:         call    ckvtc           ;see if vt needed
    1264: 8$:
    1265: 9$:     clr     crfdfl
    1266:         return
    1267:
    1268: tstreg:
    1269:         clr     xxxreg
    1270:         call    savreg
    1271:         cmp     rolndx,#symrol
    1272:         bne     1$
    1273:         mov     #regrol,r4
    1274:         mov     <^pl rolbas>(r4),r3
    1275:         mov     <^pl roltop>(r4),r1
    1276:         movb    <^pl rolsiz>(r4),r2
    1277: 4$:
    1278:         cmp     r3,r1
    1279:         bge     1$
    1280:         cmp     (r3),symbol
    1281:         bne     2$
    1282:         cmp     2(r3),symbol+2
    1283:         bne     2$
    1284:         inc     xxxreg
    1285:         br      1$
    1286: 2$:
    1287:         add     r2,r3
    1288:         br      4$
    1289: 1$:
    1290:         return
    1291:
    1292: putxrf: dec     vtcnt
    1293:         mov     #crfchn,r0      ;reset channel #
    1294:         tst     r1
    1295:         jne     putoc
    1296:         return
    1297:         ;jmp	putoc
    1298:
    1299: vtini=100.
    1300:
    1301: ckvtc:  tst     vtcnt
    1302:         bmi     1$
    1303:         return
    1304: 1$:     mov     #vtini,vtcnt
    1305:         mov     #vt,r1
    1306:         mov     #crfchn,r0      ;reset channel #
    1307:         tst     r1
    1308:         jne     putoc
    1309:         return
    1310:         ;jmp	putoc
    1311:         entsec  impure
    1312: crfsym: .blkw   3
    1313: vtcnt:  .blkw
    1314: crfflg: .blkw
    1315: crfpnt: .blkw
    1316: xxxreg::        .blkw
    1317:
    1318:
    1319:
    1320:         .globl  opclas, errrol
    1321:
    1322: cr.ver= 001+<001*400>           ;type 1, version #1
    1323: cr.pag= 002                     ;new page
    1324: cr.lin= 003                     ;new line
    1325: cr.sym= 020                     ;symbol
    1326:
    1327: errrol= 1                       ;dummy roll
    1328:
    1329:         entsec  impure
    1330: crfver: .blkw                   ;version flag
    1331: crfpag: .blkw
    1332: crflin: .blkw
    1333:
    1334:         entsec  implin
    1335: crfdfl: .blkw                   ; "#" and "*" flags
    1336:
    1337:         entsec  dpure
    1338: crftyp:
    1339:         .irp    x,<sym,mac,pst,sec,err,reg>
    1340:         .iif ndf x'rol, .globl  x'rol
    1341:         .byte   x'rol
    1342:         .endm
    1343:         .even
    1344:
    1345: crfrun: .asclc  /usr/new/macxrf
    1346:         .even
    1347:         xitsec
    1348:
    1349:         .endc
    1350: .if ndf xtime
    1351:
    1352:         .globl  dnc, movbyt
    1353:
    1354: ;called with:
    1355: ;	r0 - high-order word of 32-bit # seconds past 1jan70 gmt
    1356: ;	r1 - low-order word
    1357: ;	r2 - destination adr. of ascii (19 bytes)
    1358:
    1359:         gmtsec = $timdf*3600.
    1360:
    1361:
    1362: cvtim::
    1363:         sub     #gmtsec,r1      ;adjust for deviation
    1364:         sbc     r0
    1365:         div     #8.*3600.,r0    ;form # 8-hour units
    1366:         mov     r1,-(sp)        ;save remaining hours, minutes & seconds
    1367:         mov     r0,r1           ;now form days
    1368:         clr     r0
    1369:         div     #3,r0
    1370:         ash     #3,r1           ;and hours
    1371:         mov     r1,-(sp)        ;saving hours
    1372:         movb    #-1.,nmonth     ;begin month ticker
    1373:         mov     #69.,nyear      ;epoch starts in 1970
    1374: 1$:     incb    nyear
    1375:         jsr     pc,yearl        ;returns length of that year in r1
    1376:         sub     r1,r0
    1377:         bpl     1$
    1378:         add     r1,r0
    1379:         mov     #28.,$feb
    1380:         cmp     r1,#366.        ;is this leap year?
    1381:         bne     21$
    1382:         inc     $feb            ;yes
    1383: 21$:    mov     #montab,r1
    1384: 4$:     incb    nmonth
    1385:         sub     (r1)+,r0
    1386:         bpl     4$
    1387:         add     -(r1),r0
    1388:         inc     r0              ;form day of month
    1389:         mov     r0,r1           ;put # days into r1 for conversion
    1390:         call    dnc
    1391:         movb    #'-,(r2)+       ;store dash
    1392:         movb    nmonth,r1
    1393:         asl     r1              ;form offset into asciz table
    1394:         asl     r1
    1395:         add     #mo.tab,r1      ;form adr. of string
    1396:         call    movbyt
    1397:         movb    #'-,(r2)+
    1398:         mov     nyear,r1        ;print out year modulo 100
    1399:         call    dnc
    1400:         movb    #40,(r2)+
    1401:         mov     (sp)+,r0        ;get partial hours
    1402:         mov     (sp)+,r1        ;get initial remainder
    1403:         mov     r0,-(sp)        ;save
    1404:         clr     r0              ;form hours
    1405:         div     #3600.,r0
    1406:         add     (sp)+,r0
    1407:         mov     r1,-(sp)        ;save # seconds
    1408:         mov     r0,r1           ;set up for conversion
    1409:         cmp     r1,#10.
    1410:         bge     6$
    1411:         movb    #'0,(r2)+
    1412: 6$:     call    dnc
    1413:         movb    #':,(r2)+
    1414:         mov     (sp)+,r1        ;restore # seconds
    1415:         clr     r0
    1416:         div     #60.,r0         ;form # minutes
    1417:         mov     r0,r1
    1418:         cmp     r1,#10.
    1419:         bge     7$
    1420:         movb    #'0,(r2)+
    1421: 7$:     call    dnc
    1422:         clrb    (r2)+
    1423:         rts     pc
    1424: yearl:  mov     #365.,r1
    1425:         bit     #3,nyear
    1426:         bne     8$
    1427:         inc     r1
    1428: 8$:     rts     pc
    1429:
    1430:
    1431:
    1432: entsec  dpure
    1433:
    1434: mo.tab: .asciz  /jan/
    1435:         .asciz  /feb/
    1436:         .asciz  /mar/
    1437:         .asciz  /apr/
    1438:         .asciz  /may/
    1439:         .asciz  /jun/
    1440:         .asciz  /jul/
    1441:         .asciz  /aug/
    1442:         .asciz  /sep/
    1443:         .asciz  /oct/
    1444:         .asciz  /nov/
    1445:         .asciz  /dec/
    1446:
    1447: entsec  mixed
    1448:
    1449: montab: 31.
    1450: $feb:   28.
    1451:         31.
    1452:         30.
    1453:         31.
    1454:         30.
    1455:         31.
    1456:         31.
    1457:         30.
    1458:         31.
    1459:         30.
    1460:         31.
    1461:
    1462:
    1463: entsec  impure
    1464: .even
    1465: nyear:  .blkw
    1466: nmonth: .blkb
    1467: .even
    1468:
    1469: xitsec
    1470:
    1471: .endc
    1472:
    1473:         .end    start

Last modified: 1987-06-20 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 689 |