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: 1630
Valid CSS Valid XHTML 1.0 Strict