mirror of
https://github.com/open-simh/simtools.git
synced 2026-01-24 03:17:36 +00:00
306 lines
6.4 KiB
Plaintext
306 lines
6.4 KiB
Plaintext
.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
|