Ultrix-3.1/src/ucb/m11/misc.m11
;//////////////////////////////////////////////////////////////////////
;/ Copyright (c) Digital Equipment Corporation 1984, 1985, 1986. /
;/ All Rights Reserved. /
;/ Reference "/usr/src/COPYRIGHT" for applicable restrictions. /
;//////////////////////////////////////////////////////////////////////
.title atmisc
.ident /14dec3/ ;
.globl ..z,sdebug
.mcall (at)sdebug,ndebug
.mcall (at)always,ch.mne,ct.mne,error
always
ch.mne
ct.mne
.globl symbol, chrpnt, symbeg, value
.globl cpopj, setwrd, setbyt, dnc, r50unp
.globl getsym, mulr50, getr50, setr50, tstr50
.globl cvtnum
.globl setsym, getnb, setnb, getchr, setchr
.globl savreg, xmit0, movbyt, mul, div
xitsec ;start in default sector
setwrd: mov r1,-(sp) ;stack reg
mov 2(r1),r1 ;get actual value
movb #dig.0/2,(r2) ;set primitive
asl r1
rolb (r2)+ ;move in bit
mov #5,r0
br setbyx
setbyt: mov r1,-(sp) ;stack index
movb 2(r1),r1 ;get value
mov #space,r0
movb r0,(r2)+ ;pad with spaces
movb r0,(r2)+
movb r0,(r2)+
swab r1 ;manipulate to left half
rorb r1 ;get the last guy
clc
ror r1
mov #3,r0
setbyx: swab r0
add #3,r0
movb #dig.0/10,(r2)
1$: asl r1
rolb (r2)
decb r0
bgt 1$
tstb (r2)+
swab r0
sob r0,setbyx
mov (sp)+,r1
return
dnc: ;decimal number conversion
mov #10.,r3 ;set divisor
1$: ;entry for other than decimal
clr r0
div r3,r0 ;divide r1
mov r1,-(sp) ;save remainder
mov r0,r1 ;set for next divide
beq 2$ ; unless zero
call 1$ ;recurse
2$: mov (sp)+,r1 ;retrieve number
add #dig.0,r1 ;convert to ascii
movb r1,(r2)+ ;store
return
r50unp: ;rad 50 unpack routine
mov r4,-(sp) ;save reg
mov #symbol,r4 ;point to symbol storage
1$: mov (r4)+,r1 ;get next word
mov #50*50,r3 ;set divisor
call 10$ ;divide and stuff it
mov #50,r3
call 10$ ;again for next
mov r1,r0
call 11$ ;finish last guy
cmp r4,#symbol+4 ;through?
bne 1$ ; no
mov (sp)+,r4 ;yes, restore register
return
10$: clr r0
div r3,r0
11$: tst r0 ;space?
beq 23$ ; yes
cmp r0,#33 ;test middle
blt 22$ ;alpha
beq 21$ ;dollar
add #22-11,r0 ;dot or dollar
21$: add #11-100,r0
22$: add #100-40,r0
23$: add #40,r0
movb r0,(r2)+ ;stuff it
return
.sbttl symbol/character handlers
getsym:
call savreg
mov chrpnt,symbeg ;save in case of rescan
mov #symbol+4,r1
clr -(r1)
clr -(r1)
bitb cttbl(r5),#ct.alp ;alpha?
beq 5$ ; no, exit false
mov #26455,r2
call setr50
1$: call mulr50
2$: asr r2
bcs 1$
add r0,(r1)
3$: call getr50
ble 4$
asr r2
bcs 2$
beq 3$
tst (r1)+
br 1$
4$: call setnb
5$: mov symbol,r0
return
mulr50: ;multiply r0 * 50
; imuli 50,r0
mov r0,-(sp)
asl r0
asl r0
add (sp)+,r0
asl r0
asl r0
asl r0
return
entsec impure
chrpnt: .blkw ;character pointer
symbeg: .blkw ;start of current symbol
xitsec
getr50: call getchr
setr50: mov r5,r0
tstr50: bitb #ct.lc!ct.alp!ct.num!ct.sp,cttbl(r0) ;alpha, numeric, or space?
beq 1$ ; no, exit minus
cmp r0,#ch.dol ;yes, try dollar
blo 2$ ;space
beq 3$ ;dollar
bitb #ct.lc,cttbl(r0)
beq 10$
add #'A-'a,r0
10$:
cmp r0,#let.a
cmp r0,#let.a
blo 4$ ;dot or digit
br 5$ ;alpha
1$: mov #100000+space,r0 ;invalid, force minus
2$: sub #space-11,r0 ;space
3$: sub #11-22,r0 ;dollar
4$: sub #22-100,r0 ;dot, digit
5$: sub #100,r0 ;alphabetic
return
cvtnum: ;convert text to numeric
; in - r2 radix
; out - value result
; r0 - high bit - overflow
; - high byte - character count
; - low byte - oversize count
call savreg
clr r0 ;result flag register
clr r1 ;numeric accumulator
1$: mov r5,r3 ;get a copy of the current char
sub #dig.0,r3 ;convert to absolute
cmp r3,#9. ;numeric?
bhi 9$ ; no, we're through
cmp r3,r2 ;yes, less than radix?
blo 2$ ; yes
inc r0 ;no, bump "n" error count
2$:
.if ndf pdpv45
mov r2,r4 ;copy of current radix
clr -(sp) ;temp ac
3$: asr r4 ;shift radix
bcc 4$ ;branch if no accumulation
add r1,(sp) ;add in
4$: tst r4 ;any more bits to process?
beq 5$ ; no
asl r1 ;yes, shift pattern
bcc 3$ ;branch if no overflow
bis #100000,r0 ;oh, oh. flag it
br 3$
5$: mov (sp)+,r1 ;set new number
.iff
mul r2,r1
.endc
add r3,r1 ;add in current number
call getchr ;get another character
add #000400,r0 ;tally character count
br 1$
9$: mov r1,value ;return result in "value"
return ;return, testing r0
;ct.eol= 000 ; eol
;ct.com= 001 ; comma
;ct.tab= 002 ; tab
;ct.sp= 004 ; space
;ct.pcx= 010 ; printing character
;ct.num= 020 ; numeric
;ct.alp= 040 ; alpha, dot, dollar
;ct.lc= 100 ; lower case alpha
;ct.smc= 200 ; semi-colon (minus bit)
;
;ct.pc= ct.com!ct.smc!ct.pcx!ct.num!ct.alp ;printing chars
.macro genctt arg ;generate character type table
.irp a, <arg>
.byte ct.'a
.endm
.endm
entsec dpure
cttbl: ;character type table
genctt <eol, eol, eol, eol, eol, eol, eol, eol>
genctt <eol, tab, eol, eol, eol, eol, eol, eol>
genctt <eol, eol, eol, eol, eol, eol, eol, eol>
genctt <eol, eol, eol, eol, eol, eol, eol, eol>
genctt <sp , pcx, pcx, pcx, alp, pcx, pcx, pcx>
genctt <pcx, pcx, pcx, pcx, com, pcx, alp, pcx>
genctt <num, num, num, num, num, num, num, num>
genctt <num, num, pcx, smc, pcx, pcx, pcx, pcx>
genctt <pcx, alp, alp, alp, alp, alp, alp, alp>
genctt <alp, alp, alp, alp, alp, alp, alp, alp>
genctt <alp, alp, alp, alp, alp, alp, alp, alp>
genctt <alp, alp, alp, pcx, pcx, pcx, pcx, pcx>
genctt <eol, lc , lc , lc , lc , lc , lc , lc >
genctt <lc , lc , lc , lc , lc , lc , lc , lc >
genctt <lc , lc , lc , lc , lc , lc , lc , lc >
genctt <lc , lc , lc , eol, eol, eol, eol, eol>
xitsec
setsym: ;set symbol for re-scan
mov symbeg,chrpnt ;set the pointer
br setchr ;set character and flags
getnb: ;get a non-blank character
inc chrpnt ;bump pointer
setnb: call setchr ;set register and flags
bitb #ct.sp!ct.tab,cttbl(r5) ;blank?
bne getnb ; yes, bypass
br setchr ;exit, setting flags
getchr: ;get the next character
inc chrpnt ;bump pointer
setchr: movb @chrpnt,r5 ;set register and flags
.if ndf xedlc
cmp r5,#141 ;lower case?
blo 1$ ;no
cmp r5,#172
bhi 1$ ;no
sub #40,r5 ;convert to upper case
1$: tst r5 ;set condition codes
.endc
;bmi getchr ;loop if invalid character
bpl 2$ ;non invalid char, return
error 13,i,<illegal character>
mov #'? ,r5
movb #200!'?,@chrpnt ; put the qm into linbuf
2$: return
savreg: ;save registers
mov r3,-(sp)
mov r2,-(sp)
mov r1,-(sp)
mov 6.(sp),-(sp) ;place return address on top
mov r4,8.(sp)
; call tststk ;test stack
call @(sp)+ ;return the call
mov (sp)+,r1 ;restore registers
mov (sp)+,r2
mov (sp)+,r3
mov (sp)+,r4
tst r0 ;set condition codes
cpopj: return
.rept 20 ;generate xmit sequence
mov (r1)+,(r2)+
.endm
xmit0: return
movbyt: ;move byte string
1$: movb (r1)+,(r2)+ ;move one
bne 1$ ;loop if non-null
tstb -(r2) ;end, point back to null
return
.end