1: .title atmisc 2: 3: .ident /14dec3/ ; 4: 5: .globl ..z,sdebug 6: .mcall (at)sdebug,ndebug 7: .mcall (at)always,ch.mne,ct.mne,error 8: always 9: ch.mne 10: ct.mne 11: 12: .globl symbol, chrpnt, symbeg, value 13: 14: .globl cpopj, setwrd, setbyt, dnc, r50unp 15: .globl getsym, mulr50, getr50, setr50, tstr50 16: .globl cvtnum 17: .globl setsym, getnb, setnb, getchr, setchr 18: .globl savreg, xmit0, movbyt, mul, div 19: 20: xitsec ;start in default sector 21: setwrd: mov r1,-(sp) ;stack reg 22: mov 2(r1),r1 ;get actual value 23: movb #dig.0/2,(r2) ;set primitive 24: asl r1 25: rolb (r2)+ ;move in bit 26: mov #5,r0 27: br setbyx 28: 29: setbyt: mov r1,-(sp) ;stack index 30: movb 2(r1),r1 ;get value 31: mov #space,r0 32: movb r0,(r2)+ ;pad with spaces 33: movb r0,(r2)+ 34: movb r0,(r2)+ 35: swab r1 ;manipulate to left half 36: rorb r1 ;get the last guy 37: clc 38: ror r1 39: mov #3,r0 40: setbyx: swab r0 41: add #3,r0 42: movb #dig.0/10,(r2) 43: 1$: asl r1 44: rolb (r2) 45: decb r0 46: bgt 1$ 47: tstb (r2)+ 48: swab r0 49: sob r0,setbyx 50: mov (sp)+,r1 51: return 52: dnc: ;decimal number conversion 53: mov #10.,r3 ;set divisor 54: 1$: ;entry for other than decimal 55: clr r0 56: div r3,r0 ;divide r1 57: mov r1,-(sp) ;save remainder 58: mov r0,r1 ;set for next divide 59: beq 2$ ; unless zero 60: call 1$ ;recurse 61: 2$: mov (sp)+,r1 ;retrieve number 62: add #dig.0,r1 ;convert to ascii 63: movb r1,(r2)+ ;store 64: return 65: 66: 67: r50unp: ;rad 50 unpack routine 68: mov r4,-(sp) ;save reg 69: mov #symbol,r4 ;point to symbol storage 70: 1$: mov (r4)+,r1 ;get next word 71: mov #50*50,r3 ;set divisor 72: call 10$ ;divide and stuff it 73: mov #50,r3 74: call 10$ ;again for next 75: mov r1,r0 76: call 11$ ;finish last guy 77: cmp r4,#symbol+4 ;through? 78: bne 1$ ; no 79: mov (sp)+,r4 ;yes, restore register 80: return 81: 82: 83: 10$: clr r0 84: div r3,r0 85: 11$: tst r0 ;space? 86: beq 23$ ; yes 87: cmp r0,#33 ;test middle 88: blt 22$ ;alpha 89: beq 21$ ;dollar 90: add #22-11,r0 ;dot or dollar 91: 21$: add #11-100,r0 92: 22$: add #100-40,r0 93: 23$: add #40,r0 94: movb r0,(r2)+ ;stuff it 95: return 96: .sbttl symbol/character handlers 97: 98: getsym: 99: call savreg 100: mov chrpnt,symbeg ;save in case of rescan 101: mov #symbol+4,r1 102: clr -(r1) 103: clr -(r1) 104: bitb cttbl(r5),#ct.alp ;alpha? 105: beq 5$ ; no, exit false 106: mov #26455,r2 107: call setr50 108: 1$: call mulr50 109: 2$: asr r2 110: bcs 1$ 111: add r0,(r1) 112: 3$: call getr50 113: ble 4$ 114: asr r2 115: bcs 2$ 116: beq 3$ 117: tst (r1)+ 118: br 1$ 119: 120: 4$: call setnb 121: 5$: mov symbol,r0 122: return 123: 124: 125: mulr50: ;multiply r0 * 50 126: ; imuli 50,r0 127: mov r0,-(sp) 128: asl r0 129: asl r0 130: add (sp)+,r0 131: asl r0 132: asl r0 133: asl r0 134: return 135: 136: entsec impure 137: chrpnt: .blkw ;character pointer 138: symbeg: .blkw ;start of current symbol 139: xitsec 140: getr50: call getchr 141: setr50: mov r5,r0 142: tstr50: bitb #ct.lc!ct.alp!ct.num!ct.sp,cttbl(r0) ;alpha, numeric, or space? 143: beq 1$ ; no, exit minus 144: cmp r0,#ch.dol ;yes, try dollar 145: blo 2$ ;space 146: beq 3$ ;dollar 147: bitb #ct.lc,cttbl(r0) 148: beq 10$ 149: add #'A-'a,r0 150: 10$: 151: cmp r0,#let.a 152: cmp r0,#let.a 153: blo 4$ ;dot or digit 154: br 5$ ;alpha 155: 156: 1$: mov #100000+space,r0 ;invalid, force minus 157: 2$: sub #space-11,r0 ;space 158: 3$: sub #11-22,r0 ;dollar 159: 4$: sub #22-100,r0 ;dot, digit 160: 5$: sub #100,r0 ;alphabetic 161: return 162: cvtnum: ;convert text to numeric 163: 164: ; in - r2 radix 165: 166: ; out - value result 167: ; r0 - high bit - overflow 168: ; - high byte - character count 169: ; - low byte - oversize count 170: 171: 172: call savreg 173: clr r0 ;result flag register 174: clr r1 ;numeric accumulator 175: 1$: mov r5,r3 ;get a copy of the current char 176: sub #dig.0,r3 ;convert to absolute 177: cmp r3,#9. ;numeric? 178: bhi 9$ ; no, we're through 179: cmp r3,r2 ;yes, less than radix? 180: blo 2$ ; yes 181: inc r0 ;no, bump "n" error count 182: 2$: 183: .if ndf pdpv45 184: mov r2,r4 ;copy of current radix 185: clr -(sp) ;temp ac 186: 3$: asr r4 ;shift radix 187: bcc 4$ ;branch if no accumulation 188: add r1,(sp) ;add in 189: 4$: tst r4 ;any more bits to process? 190: beq 5$ ; no 191: asl r1 ;yes, shift pattern 192: bcc 3$ ;branch if no overflow 193: bis #100000,r0 ;oh, oh. flag it 194: br 3$ 195: 196: 5$: mov (sp)+,r1 ;set new number 197: .iff 198: mul r2,r1 199: .endc 200: add r3,r1 ;add in current number 201: call getchr ;get another character 202: add #000400,r0 ;tally character count 203: br 1$ 204: 205: 9$: mov r1,value ;return result in "value" 206: return ;return, testing r0 207: ;ct.eol= 000 ; eol 208: ;ct.com= 001 ; comma 209: ;ct.tab= 002 ; tab 210: ;ct.sp= 004 ; space 211: ;ct.pcx= 010 ; printing character 212: ;ct.num= 020 ; numeric 213: ;ct.alp= 040 ; alpha, dot, dollar 214: ;ct.lc= 100 ; lower case alpha 215: ;ct.smc= 200 ; semi-colon (minus bit) 216: ; 217: ;ct.pc= ct.com!ct.smc!ct.pcx!ct.num!ct.alp ;printing chars 218: 219: .macro genctt arg ;generate character type table 220: .irp a, <arg> 221: .byte ct.'a 222: .endm 223: .endm 224: 225: 226: entsec dpure 227: cttbl: ;character type table 228: genctt <eol, eol, eol, eol, eol, eol, eol, eol> 229: genctt <eol, tab, eol, eol, eol, eol, eol, eol> 230: genctt <eol, eol, eol, eol, eol, eol, eol, eol> 231: genctt <eol, eol, eol, eol, eol, eol, eol, eol> 232: 233: genctt <sp , pcx, pcx, pcx, alp, pcx, pcx, pcx> 234: genctt <pcx, pcx, pcx, pcx, com, pcx, alp, pcx> 235: genctt <num, num, num, num, num, num, num, num> 236: genctt <num, num, pcx, smc, pcx, pcx, pcx, pcx> 237: 238: genctt <pcx, alp, alp, alp, alp, alp, alp, alp> 239: genctt <alp, alp, alp, alp, alp, alp, alp, alp> 240: genctt <alp, alp, alp, alp, alp, alp, alp, alp> 241: genctt <alp, alp, alp, pcx, pcx, pcx, pcx, pcx> 242: 243: genctt <eol, lc , lc , lc , lc , lc , lc , lc > 244: genctt <lc , lc , lc , lc , lc , lc , lc , lc > 245: genctt <lc , lc , lc , lc , lc , lc , lc , lc > 246: genctt <lc , lc , lc , eol, eol, eol, eol, eol> 247: 248: xitsec 249: setsym: ;set symbol for re-scan 250: mov symbeg,chrpnt ;set the pointer 251: br setchr ;set character and flags 252: 253: getnb: ;get a non-blank character 254: inc chrpnt ;bump pointer 255: setnb: call setchr ;set register and flags 256: bitb #ct.sp!ct.tab,cttbl(r5) ;blank? 257: bne getnb ; yes, bypass 258: br setchr ;exit, setting flags 259: 260: getchr: ;get the next character 261: inc chrpnt ;bump pointer 262: setchr: movb @chrpnt,r5 ;set register and flags 263: .if ndf xedlc 264: cmp r5,#141 ;lower case? 265: blo 1$ ;no 266: cmp r5,#172 267: bhi 1$ ;no 268: sub #40,r5 ;convert to upper case 269: 1$: tst r5 ;set condition codes 270: .endc 271: ;bmi getchr ;loop if invalid character 272: bpl 2$ ;non invalid char, return 273: error 13,i,<illegal character> 274: mov #'? ,r5 275: movb #200!'?,@chrpnt ; put the qm into linbuf 276: 2$: return 277: savreg: ;save registers 278: mov r3,-(sp) 279: mov r2,-(sp) 280: mov r1,-(sp) 281: mov 6.(sp),-(sp) ;place return address on top 282: mov r4,8.(sp) 283: ; call tststk ;test stack 284: call @(sp)+ ;return the call 285: mov (sp)+,r1 ;restore registers 286: mov (sp)+,r2 287: mov (sp)+,r3 288: mov (sp)+,r4 289: tst r0 ;set condition codes 290: cpopj: return 291: 292: 293: .rept 20 ;generate xmit sequence 294: mov (r1)+,(r2)+ 295: .endm 296: xmit0: return 297: 298: movbyt: ;move byte string 299: 1$: movb (r1)+,(r2)+ ;move one 300: bne 1$ ;loop if non-null 301: tstb -(r2) ;end, point back to null 302: return 303: 304: 305: .end
|
Last modified: 1982-12-11
Generated: 2016-12-26 |
Generated by src2html V0.67
page hit count: 518 |
|