1: .title getl 2: .list me 3: 4: .ident /03apr4/ 5: 6: 7: .mcall (at)always,ch.mne,st.flg 8: .globl ..z, sdebug 9: .mcall (at)zap 10: always 11: ch.mne 12: st.flg 13: 14: .mcall (at)sdebug,ndebug 15: .mcall (at)xmit,param,error 16: .mcall (at)genedt,gencnd,setnz 17: .mcall (at)search,scanw 18: 19: 20: .globl lcbegl, linend, lcendl 21: .globl cdrsav 22: 23: .globl linnum, seqend, pagnum, pagext, ffcnt 24: .globl lppcnt 25: 26: .globl stmnt 27: 28: .globl cndwrd, lsybas, lc.cnd, lsbset 29: .globl xctlin 30: .globl secrol, cndrol, lsyrol, symrol 31: 32: .globl srcchn, smlchn 33: .globl crfdef, crfref 34: 35: .globl clcfgs, clcloc, clcmax 36: .globl clcnam, clcsec, cpopj 37: .globl flags, getchr, getnb, getsym 38: .globl lsrch, mode 39: .globl sector, setnb 40: .globl setsec, setxpr 41: .globl symbol, tstarg, value 42: .globl smllvl, msbmrp, getmch 43: .globl edmask, ed.cdr, ed.lc, ed.lsb 44: 45: ;globals defined in assembler 46: 47: .if ndf xswit 48: .globl absexp, chrpnt, pass 49: .endc 50: 51: .globl savreg, xmit0 52: .globl linbuf 53: .globl gsarg 54: 55: ;globals defined in mcexec 56: 57: .globl getic, io.eof, io.eoi, io.err 58: .globl argcnt, cndmex 59: .globl endflg 60: .globl getlin, lblend, lcendl, lcflag 61: .globl lcmask, lsgbas 62: .globl u.flag , mac.er, macdfn 63: 64: xitsec ;start in default sector 65: 66: getlin: ;get an input line 67: call savreg 68: getl01: call xctlin ;init line-oriented variables 69: mov ffcnt,r0 ;any reserved ff's? 70: beq 2$ ; no 71: add r0,pagnum ;yes, update page number 72: mov #-1,pagext 73: clr ffcnt 74: .if ndf xlcseq 75: clr linnum ;init new cref sequence 76: clr seqend 77: .endc 78: tst pass 79: beq 2$ 80: clr lppcnt 81: 2$: .if ndf xsml 82: mov #-1,r4 ;assume in sysmac 83: mov #smlchn,r0 84: tst smllvl ;true? 85: bne 4$ ; yes 86: .endc 87: clr r4 ;no, assume physical input 88: mov #srcchn,r0 89: .if ndf xmacro 90: mov msbmrp,r1 ;fetch pointer 91: beq 4$ ;zero means not in macro 92: inc r4 ;make it a one 93: 4$: asl r4 ;double for indexing 94: .endc 95: mov #linbuf,r2 96: mov r2,lcbegl ;set up beginning 97: mov r2,chrpnt 98: mov #linend,lcendl ; and end of line markers 99: ;fall through 100: 101: getl10: ;char loop 102: call @getltb(r4) ;call proper routine 103: bic #200,r5 ;clear sign bit 104: beq getl10 ;ignore if null 105: bmi 25$ ;special if sign bit set 106: cmp r5,#40 ;less than space? 107: blo 20$ ; yes 108: cmp r5,#140 ;good guy as is? 109: blo 14$ ; yes 110: beq 22$ ;illegal 111: cmp r5,#172 ;lower case? 112: bhi 22$ ; no, probably illegal 113: .if ndf xedlc 114: bit #ed.lc,edmask ;lower case enabled? 115: beq 14$ ; yes, leave alone 116: .endc 117: sub #40,r5 ;convert lower to upper case 118: 14$: movb r5,(r2)+ ;store in linbuf 119: cmp r2,#linend ;overflow? 120: blo getl10 ; no 121: tstb -(r2) ;yes, move back one 122: 16$: ;flag line error 123: error 12,l,<line too long> 124: br getl10 125: 126: 20$: cmp r5,#tab ;<40, check specials 127: beq 14$ ;ok as is 128: cmp r5,#lf 129: beq getl40 ;eol 130: cmp r5,#vt ;vertical tab? 131: beq 32$ ; yes (special) 132: cmp r5,#ff 133: bne 23$ 134: tst u.flag 135: beq 30$ ; -u flag not in effect: pay heed to form feeds 136: mov #40,r5 ; flag in effect: convert ^L into space 137: br 14$ 138: 23$: 139: cmp r5,#cr 140: beq getl10 ;ignore carriage returns 141: 22$: cmp r5,#177 ;rubout? 142: beq getl10 ; yes, ignore 143: 24$: 144: ; error 13,i,<illegal character> 145: bis #200,r5 ;flag for qm on listing 146: br 14$ 147: 148: 25$: bit r5,#io.eoi ;end of input? 149: bne 34$ ; yes 150: bit r5,#io.err ;error? 151: bne 16$ ; yes 152: ;no, assume eof and fall through 153: 30$: .if ndf xmacro 154: tst r4 ;reading from source? 155: bne 32$ ; no 156: inc ffcnt ;yes, bump page count 157: add pagnum,ffcnt+2 158: .endc 159: 32$: cmp r2,#linbuf ;first char? 160: bne getl40 ; no 161: jmp getl01 ;yes, reprocess line 162: 163: 34$: tst macdfn 164: bne 35$ 165: error 14,e,<.end not found> ;end of input, 166: br 36$ 167: 35$: error 140,e,<end of input while macro or repeat in progress> 168: 36$: 169: inc endflg ; missed .end statement 170: 171: getl40: clrb (r2) 172: mov #linbuf,..z 173: call sdebug 174: .if ndf xmacro 175: tst r4 176: bne 41$ 177: .endc 178: .if ndf xlcseq 179: inc linnum ;bump line number 180: .globl fileln 181: inc fileln ;bump true line number 182: .endc 183: 41$: .if ndf xedcdr 184: movb linbuf+72.,cdrsav ;save column 73 185: bit #ed.cdr,edmask ;card reader type? 186: bne 42$ ; no 187: clrb linbuf+72. ;yes, force eol 188: 42$: .endc 189: mov endflg,r0 ;return with "endflg" as argument 190: jmp setnb ;return pointing at first non-blank 191: 192: entsec dpure ;input mode jump table 193: .if ndf xsml 194: .word getic ;sysmac same as regular source 195: .endc 196: getltb: .word getic ;get input character 197: .if ndf xmacro 198: .word getmch ;get macro character 199: .endc 200: 201: entsec imppas 202: endflg: .blkw ;set non-zero on end 203: lppcnt: .blkw 1 ;force new page when negative 204: ffcnt: .blkw 2 ;unprocessed ff count 205: pagext: .blkw 1 ;page number extension 206: .if ndf xlcseq 207: seqend: .blkw 1 208: .endc 209: 210: xitsec 211: 212: .iif ndf xedlc, genedt lc ;lower case 213: setsec: 214: clr r0 215: bisb sector,r0 216: ; imuli rs.sec*2,r0 ;multiply by bytes/block 217: mov r0,-(sp) 218: asl r0 219: asl r0 220: add (sp)+,r0 221: asl r0 222: add <^pl rolbas>+secrol,r0 ;compute base of sector roll 223: mov (r0)+,symbol ;xfer sector name to symbol 224: mov (r0)+,symbol+2 225: return 226: .sbttl conditionals 227: 228: .globl iif 229: 230: 231: 232: 233: iif: ;immediate handlers 234: call tcon ;test argument 235: tst r3 236: bmi 3$ ; branch if unsatisfied 237: cmp #ch.com,r5 ;comma? 238: bne 1$ ; no 239: call getchr ;yes, bypass 240: 1$: mov chrpnt,r1 ;save current location 241: 242: 243: call setnb ;set to nom-blank 244: bit #lc.cnd,lcmask ;conditional suppression? 245: beq 2$ ; no 246: mov r1,lcbegl ;yes, suppress all up to comma 247: 2$: clr argcnt 248: jmp stmnt ;back to statement 249: 250: 3$: clr r5 ;false, but no "q" error 251: br endcx 252: 253: 254: ;concatenated conditionals 255: .irp arg, <eq,ge,gt,le,lt,ne,g,l,nz,z,df,ndf> 256: .globl if'arg 257: if'arg: 258: .endm 259: 260: mov symbol+2,symbol ;treat second half as argument 261: call tconf ;examine it 262: br if1 ;into the main stream 263: 264: 265: .globl if, ift, iff, iftf, endc 266: 267: if: ;micro-programmmed conditional 268: call tcon ;test argument 269: if1: mov #cndlvl,r1 ;point to level 270: cmp (r1),#15. ;room for another? 271: bgt ifoer1 ; no, error 272: inc (r1) ;yes, bump level 273: asl r3 ;set carry to true (0) or false (1) 274: ror -(r1) ;rotate into cndmsk 275: asl r3 276: ror -(r1) ;ditto for cndwrd 277: br endcx 278: ift: ;if true sub-conditional 279: mov cndmsk,r3 ;get current 280: br iftf ; and branch 281: 282: iff: ;if false sub-conditional 283: mov cndmsk,r3 ;get current condition 284: com r3 ;use complement and fall through 285: 286: iftf: ;unconditional sub-conditional 287: ;(r3=0 when called directly) 288: tst cndlvl ;conditional in progress? 289: ble ifoerr ; no, error 290: asl cndwrd ;move off current flag 291: asl r3 ;set carry 292: ror cndwrd ;mov on 293: br endcx 294: 295: endc: ;end of conditional 296: mov #cndlvl,r1 ;point to level 297: tst (r1) ;in conditional? 298: ble ifoerr ; no, error 299: dec (r1) ;yes, decrement 300: asl -(r1) ;reduce mask 301: asl -(r1) ; and test word 302: endcx: 303: bit #lc.cnd,lcmask ;suppression requested? 304: beq 2$ ; no 305: mov lblend,r0 ;yes, any label? 306: beq 1$ ; no, suppress whole line 307: mov r0,lcendl ;yes, list only label 308: br 2$ 309: 310: 1$: bis #lc.cnd,lcflag ;mark conditional 311: 2$: return 312: 313: ifoerr: error 15,o,<conditional not in progress> ;condition error 314: return 315: ifoer1: error 16,o,<too many nested conditionals> 316: return 317: tcon: ;test condition 318: call gsarg ;get a symbol 319: tconf: scanw cndrol ;scan for argument 320: beq 7$ ; error if not found 321: mov symbol+2,r1 ;get address 322: asr r1 ;low bit used for toggle flag 323: sbc r3 ;r3 goes to -1 if odd 324: asl r1 ;back to normal (and even) 325: tst cndwrd ;already unsat? 326: bne tcon8 ; yes, just exit 327: call tstarg ;bypass comma 328: jmp @r1 ;jump to handler 329: 330: 7$: error 17,a,<conditional argument not specified> 331: tcon8: clr r5 ;no "q" error 332: return 333: 334: 335: 336: gencnd eq, tconeq 337: gencnd ne, tconeq, f 338: gencnd z, tconeq 339: gencnd nz, tconeq, f 340: gencnd gt, tcongt 341: gencnd le, tcongt, f 342: gencnd g, tcongt 343: gencnd lt, tconlt 344: gencnd ge, tconlt, f 345: gencnd l, tconlt 346: gencnd df, tcondf 347: gencnd ndf, tcondf, f 348: 349: 350: tconeq: call absexp ;eq/ne, test expression 351: beq tcontr ;branch if sat 352: tconfa: com r3 ; false, toggle 353: tcontr: return ;true, just exit 354: 355: tcongt: call absexp 356: bgt tcontr 357: br tconfa 358: 359: tconlt: call absexp 360: blt tcontr 361: br tconfa 362: 363: tcondf: ;if/idf 364: mov r3,r1 ;save initial condition 365: clr r2 ;set "&" 366: clr r3 ;start off true 367: 1$: call getsym ;get a symbol 368: beq 8$ ; undefined if not a sym 369: search symrol ;search user symbol table 370: call crfref 371: clr r0 ;assume defined 372: bit #defflg,mode ;good guess? 373: bne 2$ ; yes 374: 8$: com r0 ;no, toggle 375: 2$: cmp r0,r3 ;yes, match? 376: beq 3$ ; yes, all set 377: mov r2,r3 ; no 378: com r3 379: 3$: mov r1,r2 ;assume "&" 380: cmp r5,#ch.and ; "&" 381: beq 4$ ; branch if good guess 382: cmp r5,#ch.ior ;perhaps or? 383: bne 5$ ; no 384: com r2 ;yes, toggle mode 385: 4$: call getnb ;bypass op 386: br 1$ ;try again 387: 388: 5$: tst r1 ;ifdf? 389: beq 6$ ; yes 390: com r3 ;no, toggle 391: 6$: return 392: 393: entsec imppas 394: ;conditional storage (must be ordered) 395: cndwrd: .blkw ;test word 396: cndmsk: .blkw ;condition mask 397: cndlvl: .blkw ;nesting level 398: cndmex: .blkw ;mexit flag 399: xitsec 400: 401: .sbttl roll handlers 402: 403: .if ndf xedlsb 404: lsrch: ;local symbol search 405: tst lsyflg ;flag set? 406: beq 1$ ; no 407: clr lsyflg ;yes, clear it 408: inc lsybkn ;bump block number 409: 1$: mov #symbol,r0 410: mov lsybkn,(r0)+ ;move into "symbol" 411: mov value,(r0) 412: .if ndf rsx11d 413: beq 2$ ;error if zero 414: cmp (r0),#^d127 415: blos lsrch3 416: .iff 417: bne lsrch3 418: .endc 419: 2$: error 18,t,<illegal local symbol> ;yes, flag error 420: lsrch3: search lsyrol ;search the roll 421: return 422: entsec imppas 423: lsyflg: .blkw ;bumped at "label:" 424: lsybkn: .blkw ;block number 425: lsybas: .blkw ;section base 426: lsgbas: .blkw ;base for generated symbols 427: xitsec 428: genedt lsb,lsbtst ;local symbol block 429: 430: .enabl lsb 431: lsbtst: bne 2$ ;bypass if /ds 432: br 1$ 433: 434: lsbset: bit #ed.lsb,edmask ;in lsb over-ride? 435: beq 2$ ; yes 436: 1$: inc lsyflg ;flag new block 437: mov clcloc,lsybas ;set new base 438: bic #1,lsybas ;be sure its even 439: clr lsgbas ;clear generated symbol base 440: 2$: return 441: 442: .dsabl lsb 443: 444: .endc 445: .sbttl utilities 446: 447: setxpr: ;set expression registers 448: mov #symbol,r1 449: mov #sector,r2 450: mov #mode,r3 451: mov #value,r4 452: return 453: .end
|
Last modified: 1982-12-11
Generated: 2016-12-26 |
Generated by src2html V0.67
page hit count: 2021 |
|