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