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: 1777 |
|