[continued from previous message]

; Convert binary number to a string of ASCII digits
; HL - binary number
; DE - divisor (descending powers of 10)
; B - leading zero suppression character
; A, C - temporaries

digit: mvi c,zero ; Initialize character
dg0: mov a,l ; Sub denom (DE) from numerator (HL)
sub e
mov l,a
mov a,h
sbb d
mov h,a
jc dg1 ; Negative result, all done
inr c ; Count number of subtracts
jmp dg0

dg1: dad d ; Adjust HL
mov a,c
cpi zero ; Check for leading zero suppression
jnz dg3
mov c,b
dg2: jmp po ; Punch character

dg3: mvi b,zero
jmp dg2

;--------------------------------
; Encode a BNPF word and punch it

encode: mvi c,upB ; Punch a 'B'
call po
mvi b,08h ; 8-bit count
mov a,m ; Get data
en0: rlc ; Rotate to set Carry
push psw ; Save intermediate result
mvi a,00h ; Compute either 'P' or 'N'
ral ; based on following algorithm:
ral ; char = 'N + 2*Carry
adi upN ; char = 'N' if Carry = 0
mov c,a ; char = 'P' if Carry = 1
call po
pop psw
dcr b
jnz en0
mvi c,upF
call po
mvi c,space
jmp po

;--------------------------------
; Evaluate expression: <expr>,<expr>,<expr>
;
; The C register contains the number of parameters required
; (1, 2, or 3). Parameters are returned on the Stack.

expr: lxi h,0000H ; Initial value of parameter
ex0: call ti ; Get a character
ex1: mov b,a ; Save delimiter character
call nibble ; Convert to hex
jc ex2 ; Not legal char, treat as delimiter
dad h ; *2
dad h ; *4
dad h ; *8
dad h ; *16
ora l
mov l,a
jmp ex0 ; Get another character

ex2: xthl ; Get return address off stack
; Put HL on
push h ; Replace return address
mov a,b
call p2c ; Test delimiter character
jnc ex3
dcr c ; CR entered
jnz Ler ; Too few params
ret

ex3: jnz Ler ; Illegal delimiter
dcr c
jnz expr
ret

exp: ; Entry point for conditional parameters
mvi c,01H
lxi h,0000H
jmp ex1

;--------------------------------
; Compare HL with DE
; If HL < DE then Carry = 0
; If HL = DE then Carry = 0
; If HL > DE then Carry = 1

hilo: inx h ; Bump HL
mov a,h ; Test for HL = 0
ora l
stc
rz
mov a,e ; DE - HL, set/reset Carry
sub l
mov a,d
sbb h
ret ; Return

;--------------------------------
; Convert nibble in A to ASCII in A
; and print on console device.

hxd: call conv
jmp co

;--------------------------------
; Externally-referenced routine
;
; I/O system status code
; Status byte returned in A
; Stack usage: 2 bytes

iochk: lda iobyt ; Get status byte
ret ; Return

;--------------------------------
; Externally-referenced routine
;
; Set I/O configuration
; Value expected in C
; Stack usage: 2 bytes

ioset: push h ; Save HL
lxi h,iobyt ; point HL at IOBYT
mov m,c
pop h ; Restore HL
ret ; Return

;--------------------------------
; Print contents of HL in hex on console device

Ladr: mov a,h ; Print MSB
call Lbyte
mov a,l ; Print LSB
jmp Lbyte

;--------------------------------
; List a byte as 2 ASCII characters

Lbyte: push psw ; Save a copy of A
rrc
rrc
rrc
rrc
ani 00001111B ; Upper 4 bits
call hxd
pop psw ; Retrieve original value
ani 00001111B ; Lower 4 bits
jmp hxd

;--------------------------------
; Punch 6 inches of leader

lead: mvi b,60 ; Set to punch 6 inches of NULLs
le0: mvi c,00H ; (NULL is already a label)
call po
dcr b
jnz le0
ret ; Return

;--------------------------------
; Externally-referenced routine
;
; List Output code
; Value expected in C, A and Flags modified
; Stack usage: 2 bytes

lo: lda iobyt ; Get status byte
ani LOW NOT Lmsk ; Get list bits
jz TTYout ; List = TTY
cpi lcrt
jz CRTout ; List = CRT
cpi Luse1 ; Test for user-defined list devices
jz L1loc ; Branch to user devices
jmp L2loc

;--------------------------------
; Externally-referenced routine
;
; Return address of end of memory to user
; Value returned in (B, A)
; Stack usage: 2 bytes

memck: push h
call MemSiz
mov b,h
mvi a,0c0h
pop h
ret

;--------------------------------
; Find end of memory, set stack

MemSiz: push b ; Save BC
lxi h,00ffH ; Find end of memory
mem0: dcr h
mov a,m ; Fetch contents of memory
cma ; Invert it
mov m,a ; Attempt to write into memory
cmp m ; Is location Read/Write?
cma ; Invert again
mov m,a ; Write data back
jnz mem0 ; Yes: continue
inx h ; Point to first non-RAM location

IF debug
mvi h,2 ; Set stack at 200H for debug
ENDIF

lxi b,exit-endx ; Compute top of new stack
dad b
pop b ; Restore BC
ret ; Return

;--------------------------------
; Decode ASCII char in A into hex digit in A
; Filter out all characters not in the sequence (0-9, A-F)
; Return Carry=1 for illegal characters.

nibble: sui zero
rc ; Filter out 0-2FH
adi zero-(upF+1)
rc ; Filter out 47H-0FFH
adi 6
jp ni0 ; Take branch for A-F
adi 7
rc ; Filter out 3AH-40H
ni0: adi 10
ora a ; Clear error flag
ret ; Return

;--------------------------------
; Punch contents of HL in hex on punch device

padr: mov a,h
call pbyte
mov a,l
jmp pbyte

;--------------------------------
; Punch A byte as 2 ASCII characters

pbyte: push psw
rrc
rrc
rrc
rrc
ani 00001111B
call conv
call po
pop psw
push psw
ani 00001111B
call conv
call po
pop psw
add d
mov d,a
ret ; Return

;--------------------------------
; Test for null input parameter

pchk: call ti ; Get a character
p2c: cpi space
rz
cpi comma
rz
cpi cr
stc
cmc
rnz
stc
ret

;--------------------------------
; Punch CR, LF

peol: mvi c,cr
call po
mvi c,lf
jmp po

;--------------------------------
; Pulse a PROM location
; HL points to data in memory
; PROM address is already set

pgrm: mov a,m ; Get data from memory
cma ; Invert it
out pdo ; Output it
mvi a,progo ; Pulse PROM programmer
out promc
mvi a,prono
out promc
push b ; Delay 20 ms. for programmer settling
mvi b,Ldly
pg0: call delay
dcr b
jnz pg0
pop b
ret

;--------------------------------
; Externally-referenced routine
;
; Punch Output code, value expected in C
; A, Flags and X modified
; Stack usage: 2 bytes

po: lda iobyt ; Get status byte
ani LOW NOT Pmsk ; Get punch bits
jz TTYout ; No: punch = TTY
cpi pptp ; Test for PTP
jnz po1 ; Test for user device(s)
po0: ; Punch = PTP
in ptps ; Get Status
ani prdy ; Check status
jz po0 ; Loop until ready
mov a,c
out ptpo
mvi a,ptpgo ; Start Punch
out ptpc
mvi a,ptpno ; Stop Punch
out ptpc
ret

po1: cpi puse1
jz P1loc
jmp P2loc

;--------------------------------
; Externally-referenced routine
;
; Reader Input code
; Value returned in A, Flags modified
; Stack usage: 8 bytes

ri: push h ; Save HL
lxi h,iobyt ; Point HL at IOBYT
mov a,m
ani LOW NOT Rmsk ; Reader = PTR?
jnz ri3 ; Branch to PTR routine
mvi a,ttygo ; Reader = TTY
out ttc
mvi a,ttyno
out ttc
mvi h,tout ; Set reader TimeOUT timer
ri0: in tts
ani ttyda
jz ri2 ; Data is ready
call delay ; Delay 1.0 ms.
dcr h
jnz ri0
ri1: xra a
stc ; Set Carry indicating EOF
pop h
ret ; Return

ri2: in tti
cma
ora a ; Clear Carry
pop h
ret ; Return

ri3: cpi rptr ; PTR routine
jnz ri6
mvi a,ptrgo ; Start PTR
out ptrc
mvi a,ptrno ; Stop PTR
out ptrc
mvi h,tout ; Set reader TimeOUT timer
ri4: in ptrs
ani ptrda
jnz ri5
call delay
dcr h
jnz ri4
jmp ri1

ri5: in ptri ; Get the data
ora a
pop h
ret ; Return

ri6: pop h
cpi Ruse1
jz R1loc
jmp R2loc

;--------------------------------
; Get character from reader, mask off parity bit

rix: call ri
jc Ler ; Reader timeout error
ani 01111111B
ret ; Return

;--------------------------------
; Restart 1 code (programmed breakpoint)
;
; This routine is entered via a Restart 1 (RST 1) instruction
; The instruction is encountered either in the user program
; (as a breakpoint) or is input via a console interrupt.
; This routine saves the state of the calling process, and
; turns control over to the Monitor.

restart:push h ; Save machine state
push d
push b
push psw
call MemSiz ; HL = new Stack Pointer
xchg
fetch 10 ; Compute original Stack Pointer
mvi b,04h ; Count for transfer of machine state
; to storage (move the Stack).
xchg
rst0: dcx h
mov m,d
dcx h
mov m,e
pop d
dcr b
jnz rst0
pop b ; Get old PC = BC, old HL = DE
dcx b ; Decrement to point at trapped code
sphl ; New Stack value
fetch Tloc
mov a,m ; Test if this is a programmed restart
sub c ; or a console restart.
inx h
jnz rst1
mov a,m
sub b
jz rst3
rst1: inx h
inx h
mov a,m
sub c
jnz rst2
inx h
mov a,m
sub b
jz rst3
rst2: inx b
rst3: fetch Lloc
mov m,e
inx h
mov m,d ; Save old HL
inx h
inx h
mov m,c ; Save old PC
inx h
mov m,b
push b
mvi c,star
call co
pop h ; Retrieve old PC for display
call Ladr ; Display PC
fetch Tloc ; Clear traps
mvi d,02h ; Set count for 2 traps
rst4: mov c,m ; Get LSB of address
mvi m,00h ; Clear memory
inx h
mov b,m ; Get MSB of address
mvi m,00h
inx h
mov a,c
ora b ; Test for valid trap
jz rst5 ; Address = 0, no trap to restore
mov a,m ; Get opcode byte
stax b ; Replace it
rst5: inx h ; Point to next trap address
dcr d
jnz rst4 ; Repeat for trap 2
jmp start

;--------------------------------
; Input from console, echoed and returned in A

ti: call ci
ani 01111111B
push b
mov c,a
call co
mov a,c
pop b
ret ; Return

;--------------------------------
; Master I/O device table
; 4 bytes/entry
;
; Byte 0 = identifying character
; Byte 1 = logical device mask
; Bytes 2,3 = subordinate physical device table

Ltbl: db 'C',Cmsk ; C - console
dw act
db 'R',Rmsk ; R - reader
dw art
db 'P',Pmsk ; P - punch
dw apt
db 'L',Lmsk ; L - list
dw alt

;--------------------------------
; I/O system physical device tables
; 2 bytes/entry
;
; Byte 0 = identifying character
; Byte 1 = device select bit pattern

act: db 'T',ctty ; Console = TTY
db 'C',ccrt ; Console = CRT
db 'B',batch ; Batch mode console = Read, List
db '1',Cuse ; User-defined console device

art: db 'T',rtty ; Reader = TTY
db 'P',rptr ; Reader = PTR
db '1',Ruse1 ; User-defined reader device 1
db '2',Ruse2 ; User-defined reader device 2

apt: db 'T',ptty ; Punch = TTY
db 'P',pptp ; Punch = PTP
db '1',Puse1 ; User-defined punch device 1
db '2',Puse2 ; User-defined punch device 2

alt: db 'T',ltty ; List = TTY
db 'C',lcrt ; List = CRT
db '1',Luse1 ; User-defined list device 1
db '2',Luse2 ; User-defined list device 2

;--------------------------------
; Exit code template, to be executed in RAM
;
; db E pop D ; Monitor work stack origin
; db D
; db C pop B
; db B
; db Flags pop PSW
; db A
; db SPL pop H
; db SPO SPHL

exit: ; Monitor stack origin
pop d ; Restore DE
pop b ; Restore BC
pop psw ; Restore A and Flags
pop h ; Restore original stack value
sphl
ei ; Enable Interrupts
lxi h,$-$ ; Restore HL
HLx EQU $-2
jmp $-$ ; Return to interrupted code
PCx EQU $-2

t1a: dw 0000h ; Trap 1 Address
db 00h ; Trap 1 value
dw 0000h ; Trap 2 Address
db 00h ; Trap 2 Value
endx:

;--------------------------------
; Displacement of register location from SP (level 0)

Aloc EQU 5
Bloc EQU 3
Cloc EQU 2
Dloc EQU 1
Eloc EQU 0
Floc EQU 4
Hloc EQU HLx-exit+9
Lloc EQU HLx-exit+8
Ploc EQU PCx-exit+9
Sloc EQU 7
Tloc EQU t1a-exit+8

;--------------------------------
; Table for accessing registers
; Table contains:
; (1) Register identifier
; (2) Stack Pointer displacement
; (3) Precision

actbl: db 'A', Aloc, 1
db 'B', Bloc, 1
db 'C', Cloc, 1
db 'D', Dloc, 1
db 'E', Eloc, 1
db 'F', Floc, 1
db 'H', Hloc, 1
db 'L', Lloc, 1
db 'M', Hloc, 2
db 'P', Ploc, 2
db 'S', Sloc, 2
db -1

;--------------------------------
; End of program

END

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)