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