mirror of
https://github.com/wwarthen/RomWBW.git
synced 2026-02-06 14:11:48 -06:00
1125 lines
18 KiB
Plaintext
1125 lines
18 KiB
Plaintext
;
|
||
; PROGRAM: DPROG
|
||
; AUTHOR: Richard Conn
|
||
; VERSION: 1.0
|
||
; DATE: 28 July 84
|
||
; PREVIOUS VERSIONS: None
|
||
;
|
||
vers equ 10
|
||
z3env equ 0f400h
|
||
|
||
;
|
||
; DPROG is used to program the user's terminal, printer, or punch
|
||
; with data from the file specified in the command line. DPROG will
|
||
; automatically search for the file along the path starting at the
|
||
; indicated (or implied) DU.
|
||
;
|
||
|
||
;
|
||
; Basic Equates
|
||
;
|
||
opsys equ 0
|
||
fcb equ 5ch
|
||
tbuff equ 80h
|
||
cr equ 0dh
|
||
ff equ 0ch
|
||
lf equ 0ah
|
||
ctrlc equ 'C'-'@'
|
||
ctrls equ 'S'-'@'
|
||
ctrlz equ 'Z'-'@'
|
||
bel equ 7
|
||
bs equ 8
|
||
tab equ 9
|
||
|
||
;
|
||
; DPROG Constants
|
||
;
|
||
COMMENT equ ';' ;denotes a comment line
|
||
WORD equ '-' ;denotes a word definition
|
||
SYM equ '=' ;symbol table dump command
|
||
DEV equ '>' ;device assignment
|
||
INP equ '<' ;input forms (pause, string, delay)
|
||
wordl equ 16 ;length of word
|
||
fmt equ '(' ;begin format definition
|
||
fmtch equ '%' ;format escape char
|
||
endfmt equ ')' ;end format definition
|
||
quote equ '"' ;quote string
|
||
literal equ '\' ;literal interpretation follows
|
||
control equ '^' ;control char follows
|
||
|
||
;
|
||
; SYSLIB Routines
|
||
;
|
||
ext condin,cin,cout,lout,pout
|
||
ext z3init,pfind,z3log
|
||
ext moveb,hmovb,logud,pfn1,caps
|
||
ext f$open,f$read,f$close
|
||
ext eval,pafdc,pa2hc
|
||
ext codend
|
||
|
||
;
|
||
; Environment Definition
|
||
;
|
||
if z3env ne 0
|
||
;
|
||
; External ZCPR3 Environment Descriptor
|
||
;
|
||
jmp start
|
||
db 'Z3ENV' ;This is a ZCPR3 Utility
|
||
db 1 ;External Environment Descriptor
|
||
z3eadr:
|
||
dw z3env
|
||
start:
|
||
lhld z3eadr ;pt to ZCPR3 environment
|
||
;
|
||
else
|
||
;
|
||
; Internal ZCPR3 Environment Descriptor
|
||
;
|
||
MACLIB Z3BASE.LIB
|
||
MACLIB SYSENV.LIB
|
||
z3eadr:
|
||
jmp start
|
||
SYSENV
|
||
start:
|
||
lxi h,z3eadr ;pt to ZCPR3 environment
|
||
endif
|
||
|
||
;
|
||
; Start of Program -- Initialize ZCPR3 Environment
|
||
;
|
||
call z3init ;initialize the ZCPR3 Env
|
||
;
|
||
; Initial Routines
|
||
;
|
||
call helpck ;check for help
|
||
call bufinit ;initialize buffers
|
||
;
|
||
; Load File
|
||
;
|
||
call locfile ;locate file
|
||
call logud ;enter directory of file
|
||
call load ;load file
|
||
;
|
||
; Perform Program
|
||
;
|
||
call program ;program the user's terminal
|
||
ret
|
||
|
||
;
|
||
; Initialize Buffers
|
||
;
|
||
bufinit:
|
||
call codend ;address of free space
|
||
shld format ;format string
|
||
xchg
|
||
lxi h,deffmt ;set default format (char)
|
||
mvi b,40 ;allow 40 chars
|
||
call moveb
|
||
xchg ;HL pts to format buffer
|
||
inr h ;next page
|
||
shld locstk ;set location stack
|
||
shld tos ;set top of stack
|
||
mvi m,0
|
||
inx h
|
||
mvi m,0 ;zero stack
|
||
dcx h
|
||
inr h ;next page
|
||
shld free ;free area
|
||
mvi a,'C' ;assign console as output device
|
||
sta outdev
|
||
ret
|
||
|
||
;
|
||
; Check for Help
|
||
;
|
||
helpck:
|
||
lxi h,fcb+1 ;pt to fcb name
|
||
mov a,m ;get it
|
||
cpi '/' ;help if slash
|
||
rnz
|
||
pop psw ;clear stack
|
||
call eprint
|
||
db 'DPROG, Version '
|
||
db (vers/10)+'0','.',(vers mod 10)+'0'
|
||
db cr,lf,' Syntax:'
|
||
db cr,lf,' DPROG <-- STD.DPG'
|
||
db cr,lf,' DPROG filename <-- filename.DPG'
|
||
db cr,lf,' DPROG filename.typ <-- filename.typ'
|
||
db 0
|
||
ret
|
||
|
||
;
|
||
; Find File
|
||
; If found, return BC=DU and NZ
|
||
;
|
||
locfile:
|
||
lxi d,fcb ;pt to FCB
|
||
call z3log
|
||
lxi d,fcb+1 ;pt to file name
|
||
lxi h,defname ;pt to default file name
|
||
mvi b,8 ;8 chars
|
||
ldax d ;any type?
|
||
cpi ' ' ;none if space
|
||
cz moveb
|
||
lxi d,fcb+9 ;pt to file type
|
||
lxi h,deftype ;pt to default file type
|
||
mvi b,3 ;3 chars
|
||
ldax d ;any type?
|
||
cpi ' ' ;none if space
|
||
cz moveb
|
||
lxi d,fcb ;pt to FCB
|
||
mvi a,0ffh ;search current
|
||
call pfind ;search for file
|
||
rnz ;get file if found
|
||
;
|
||
; Abort Attempt to Load File
|
||
;
|
||
abort:
|
||
pop psw ;clear stack
|
||
call eprint
|
||
db cr,lf,' File ',0
|
||
lxi d,fcb+1 ;pt to file name
|
||
call pfn1
|
||
call eprint
|
||
db ' NOT Found',0
|
||
ret
|
||
|
||
;
|
||
; Load File
|
||
;
|
||
load:
|
||
lxi d,fcb ;pt to fcb
|
||
call f$open ;open file for input
|
||
jnz abort ;abort attempt
|
||
lhld free ;buffer area
|
||
load1:
|
||
lxi d,fcb ;pt to fcb
|
||
call f$read ;read next block
|
||
jnz load2 ;done, so mark and close
|
||
lxi d,tbuff ;copy into buffer
|
||
xchg ;copy into buffer at DE from TBUFF at HL
|
||
mvi b,128 ;128 bytes
|
||
call moveb
|
||
lxi h,80h ;pt to next buffer
|
||
dad d
|
||
jmp load1
|
||
load2:
|
||
mvi m,ctrlz ;mark EOF
|
||
inr h ;next page
|
||
mvi l,0
|
||
shld words ;mark beginning of word definition area
|
||
shld nxtword ;mark next word
|
||
mvi m,0 ;mark no words
|
||
jmp f$close ;close input file
|
||
|
||
;
|
||
; Program the User's Terminal
|
||
;
|
||
program:
|
||
lhld free ;pt to first char
|
||
prog1:
|
||
call capa ;capitalize
|
||
cpi ctrlz ;done?
|
||
rz
|
||
cpi CR ;eol?
|
||
jz skipl
|
||
cpi WORD ;word definition?
|
||
jz defword
|
||
cpi SYM ;symbol table or format definition dump?
|
||
jz dump
|
||
cpi DEV ;assign device?
|
||
jz device
|
||
cpi INP ;input form?
|
||
jz input
|
||
push h ;save HL
|
||
prog2:
|
||
call output ;output line at HL
|
||
call locpop ;pop stack if any
|
||
jnz prog2 ;continue if any element on stack
|
||
pop h ;restore HL
|
||
;
|
||
; Skip to next line
|
||
;
|
||
skipl:
|
||
mov a,m ;get char
|
||
call capa ;capitalize
|
||
cpi CR ;new line?
|
||
jz skipl1
|
||
cpi LF ;new line?
|
||
jz skipl1
|
||
cpi CTRLZ ;EOF?
|
||
rz
|
||
inx h ;pt to next
|
||
jmp skipl
|
||
skipl1:
|
||
mov a,m ;get it
|
||
inx h ;pt to next
|
||
ani 7fh ;mask
|
||
cpi CR ;continue?
|
||
jz skipl1
|
||
cpi LF ;continue?
|
||
jz skipl1
|
||
dcx h ;pt to non-eol char
|
||
jmp prog1 ;continue with next line
|
||
;
|
||
; Input Form
|
||
;
|
||
input:
|
||
inx h ;pt to next char
|
||
call cin ;get any char
|
||
ani 7fh ;mask
|
||
cpi ctrlc ;abort?
|
||
jz opsys
|
||
jmp skipl ;continue
|
||
;
|
||
; Assign Device
|
||
;
|
||
device:
|
||
inx h ;pt to char
|
||
call capa ;capitalize
|
||
cpi 'C' ;console?
|
||
jz setdev
|
||
cpi 'L' ;list?
|
||
jz setdev
|
||
cpi 'P' ;punch?
|
||
jz setdev
|
||
push psw
|
||
call eprint
|
||
db cr,lf,bel,' Invalid Device Assignment: ',0
|
||
pop psw
|
||
call cout ;print char
|
||
dcx h ;back up
|
||
jmp skipl ;continue
|
||
;
|
||
; Perform assignment
|
||
;
|
||
setdev:
|
||
sta outdev ;assign
|
||
jmp skipl ;continue
|
||
;
|
||
; Define Word
|
||
;
|
||
defword:
|
||
inx h ;pt to first char of word
|
||
call bufword ;store word in buffer
|
||
shld nextch ;save ptr to next char
|
||
call wscan ;scan for word
|
||
jz defnew ;new word defined
|
||
xchg ;ptr to high-order in DE
|
||
lhld nextch ;get ptr to word definition
|
||
xchg ;word defn in DE, word adr high in HL
|
||
mov m,d ;store new address
|
||
dcx h
|
||
mov m,e
|
||
xchg ;HL pts to word
|
||
jmp skipl ;skip out line
|
||
;
|
||
; New Word
|
||
;
|
||
defnew:
|
||
lhld nxtword ;pt to next word
|
||
xchg
|
||
lxi h,wordbf ;pt to buffer
|
||
mvi b,wordl ;number of chars max
|
||
call hmovb ;copy into buffer and advance HL
|
||
lhld nextch ;get address
|
||
xchg
|
||
mov m,e ;put low
|
||
inx h
|
||
mov m,d ;put high
|
||
inx h ;set ptr to next word
|
||
mvi m,0 ;store zero
|
||
shld nxtword ;set ptr
|
||
xchg ;HL pts to word definition
|
||
jmp skipl ;skip to next line
|
||
|
||
;
|
||
; Dump Format String or Word Table
|
||
;
|
||
dump:
|
||
inx h ;pt to option
|
||
call capa ;check for format display option
|
||
cpi 'F' ;format?
|
||
jz dfmt ;dump format if so
|
||
cpi 'S' ;symbols?
|
||
jz dsym
|
||
dcx h ;pt to current
|
||
call dumpsym ;dump symbols
|
||
call dumpfmt ;dump format
|
||
jmp skipl ;continue
|
||
;
|
||
; Dump Format
|
||
;
|
||
dfmt:
|
||
call dumpfmt ;do dump
|
||
jmp skipl ;continue
|
||
;
|
||
; Dump Words
|
||
;
|
||
dsym:
|
||
call dumpsym ;do dump
|
||
jmp skipl ;continue
|
||
;
|
||
; Dump Words in Symbol Table
|
||
;
|
||
dumpsym:
|
||
push h ;save HL
|
||
call eprint
|
||
db cr,lf,' >> Word Definitions <<',0
|
||
lhld words ;dump word table
|
||
sym1:
|
||
mov a,m ;get next
|
||
ora a
|
||
jz symexit
|
||
call eprint
|
||
db cr,lf,' ',0
|
||
call prword ;print word
|
||
mov e,m ;get low
|
||
inx h
|
||
mov d,m ;get high
|
||
inx h ;pt to next word
|
||
push h ;save ptr
|
||
call eprint
|
||
db ' >',0
|
||
xchg ;HL pts to word
|
||
sym2:
|
||
mov a,m ;get next char
|
||
cpi CR ;done?
|
||
jz sym3
|
||
cpi TAB ;translate tab to space
|
||
jnz sym2out
|
||
mvi a,' ' ;space instead of tab
|
||
sym2out:
|
||
call chout
|
||
inx h
|
||
jmp sym2
|
||
sym3:
|
||
call eprint
|
||
db '<',0
|
||
pop h ;pt to next word
|
||
jmp sym1
|
||
symexit:
|
||
pop h ;pt to char
|
||
ret
|
||
;
|
||
; Output Format String
|
||
;
|
||
dumpfmt:
|
||
push h ;save ptr
|
||
call eprint
|
||
db cr,lf,' Format: (',0
|
||
lhld format ;pt to string
|
||
call epstr ;print it
|
||
call eprint
|
||
db ')',cr,lf,0
|
||
pop h ;get ptr
|
||
ret
|
||
|
||
;
|
||
; Print Word at HL (advance HL)
|
||
;
|
||
prword:
|
||
mvi b,wordl ;number of chars
|
||
prw1:
|
||
mov a,m ;get char
|
||
call chout
|
||
inx h
|
||
dcr b
|
||
jnz prw1
|
||
ret
|
||
;
|
||
; Routine to Output a Line
|
||
;
|
||
output:
|
||
call sksp ;skip spaces
|
||
cpi COMMENT ;done?
|
||
rz
|
||
cpi CR ;done?
|
||
rz
|
||
cpi LF ;done?
|
||
rz
|
||
cpi CTRLZ ;done?
|
||
rz
|
||
cpi fmt ;format definition?
|
||
jz outfmt
|
||
cpi quote ;chars?
|
||
jz outch
|
||
call bufword ;store word in buffer
|
||
shld nextch ;save ptr to next char after word
|
||
call wscan ;scan for word in table
|
||
jz badword ;word not defined
|
||
call locpush ;push location onto stack
|
||
xchg ;HL pts to continuation location
|
||
jmp output ;continue
|
||
;
|
||
; Output Quoted String
|
||
;
|
||
outch:
|
||
inx h ;pt to next char
|
||
outch1:
|
||
mov a,m ;get it
|
||
ani 7fh ;mask
|
||
cpi CR ;done?
|
||
jz outcherr
|
||
cpi LF ;done?
|
||
jz outcherr
|
||
cpi CTRLZ ;done?
|
||
jz outcherr
|
||
cpi quote ;end of quote?
|
||
jz outch2
|
||
call charout ;output char in whatever form
|
||
jmp outch1 ;continue
|
||
outcherr:
|
||
call eprint
|
||
db cr,lf,bel,' Premature End of Quote',cr,lf,0
|
||
jmp output
|
||
outch2:
|
||
inx h ;pt to after quote
|
||
jmp output ;continue
|
||
;
|
||
; Output char in A and set HL to next char on exit
|
||
;
|
||
charout:
|
||
cpi control ;control char follows?
|
||
jz charo0
|
||
cpi literal ;literal follows?
|
||
jz charo1
|
||
;
|
||
; Normal Char in A
|
||
;
|
||
charnxt:
|
||
inx h ;pt to next char
|
||
jmp formatout ;output with format
|
||
;
|
||
; Output control char
|
||
;
|
||
charo0:
|
||
inx h ;pt to char
|
||
call capa ;get char
|
||
sui '@' ;convert to control
|
||
jc ctrlerr
|
||
cpi 20h
|
||
jnc ctrlerr
|
||
inx h ;pt to next
|
||
jmp formatout
|
||
ctrlerr:
|
||
call eprint
|
||
db cr,lf,bel,' Invalid Control Character',cr,lf,0
|
||
ret
|
||
;
|
||
; Output Literal Format
|
||
;
|
||
charo1:
|
||
inx h ;pt to char
|
||
call capa ;get char
|
||
cpi 'B' ;BS?
|
||
jz c1bs
|
||
cpi 'D' ;DEL?
|
||
jz c1del
|
||
cpi 'E' ;ESCAPE?
|
||
jz c1esc
|
||
cpi 'L' ;CRLF?
|
||
jz c1nl
|
||
cpi 'N' ;LF?
|
||
jz c1lf
|
||
cpi 'R' ;CR?
|
||
jz c1cr
|
||
cpi 'T' ;TAB?
|
||
jz c1tab
|
||
cpi '0' ;digit?
|
||
jc charol ;literal if not
|
||
cpi '9'+1 ;range?
|
||
jc numout
|
||
cpi ' ' ;less than space?
|
||
jnc charol
|
||
call eprint
|
||
db cr,lf,bel,' Invalid Literal Argument',cr,lf,0
|
||
ret
|
||
|
||
;
|
||
; Output Char in A literally
|
||
;
|
||
charol:
|
||
mov a,m ;get char
|
||
ani 7fh ;don't cap this way
|
||
inx h ;pt to next
|
||
jmp formatout
|
||
;
|
||
; Output Number
|
||
;
|
||
numout:
|
||
call eval ;convert to binary in DE
|
||
mov a,e ;char binary value
|
||
jmp formatout ;output with format
|
||
;
|
||
; Output BS
|
||
;
|
||
c1bs:
|
||
mvi a,bs
|
||
jmp charnxt
|
||
;
|
||
; Output TAB
|
||
;
|
||
c1tab:
|
||
mvi a,tab
|
||
jmp charnxt
|
||
;
|
||
; Output CR
|
||
;
|
||
c1cr:
|
||
mvi a,cr
|
||
jmp charnxt
|
||
;
|
||
; Output DEL
|
||
;
|
||
c1del:
|
||
mvi a,7fh
|
||
jmp charnxt
|
||
;
|
||
; Output ESCAPE
|
||
;
|
||
c1esc:
|
||
mvi a,1bh
|
||
jmp charnxt
|
||
;
|
||
; Output LF
|
||
;
|
||
c1lf:
|
||
mvi a,lf
|
||
jmp charnxt
|
||
;
|
||
; Output CRLF
|
||
;
|
||
c1nl:
|
||
mvi a,cr
|
||
call formatout ;output CR
|
||
mvi a,lf
|
||
jmp charnxt
|
||
|
||
;
|
||
; Output Char in A According to Format
|
||
;
|
||
formatout:
|
||
push h ;save ptr to next char
|
||
push b ;save BC
|
||
mov b,a ;char in B
|
||
lhld format ;pt to format string
|
||
fout1:
|
||
mov a,m ;get next char
|
||
ani 7fh ;mask
|
||
jz foutx ;exit if end of string
|
||
cpi fmtch ;expression form?
|
||
jz fout2
|
||
cpi literal ;literal?
|
||
jz flit
|
||
;
|
||
; Output char in A and advance
|
||
;
|
||
fch:
|
||
call chout ;output char
|
||
inx h ;pt to next
|
||
jmp fout1
|
||
;
|
||
; Output Value in B according to format
|
||
;
|
||
fout2:
|
||
inx h ;pt to format type
|
||
mov a,m ;get char
|
||
inx h ;pt to next
|
||
ani 7fh ;mask
|
||
call caps
|
||
ora a ;none?
|
||
jz fout1 ;error condition - % at end of string
|
||
cpi 'C' ;char?
|
||
jz foch
|
||
cpi 'D' ;floating decimal chars
|
||
jz fod
|
||
cpi '2' ;2 decimal chars
|
||
jz fo2
|
||
cpi '3' ;3 decimal chars
|
||
jz fo3
|
||
cpi 'X' ;2 hex chars
|
||
jz fox
|
||
push psw
|
||
call eprint
|
||
db cr,lf,bel,' Invalid Format Char: ',0
|
||
pop psw
|
||
call cout
|
||
call crlf
|
||
jmp fout1 ;continue
|
||
|
||
;
|
||
; Output value in B as char
|
||
;
|
||
foch:
|
||
mov a,b ;get value
|
||
call chout ;output it
|
||
jmp fout1 ;continue
|
||
;
|
||
; Output value in B as floating decimal
|
||
;
|
||
fod:
|
||
mov a,b ;get value
|
||
call pafdc ;output
|
||
jmp fout1 ;continue
|
||
;
|
||
; Output value in B as hex
|
||
;
|
||
fox:
|
||
mov a,b ;get value
|
||
call pa2hc ;output
|
||
jmp fout1 ;continue
|
||
;
|
||
; Output value in B as 3 decimal chars
|
||
;
|
||
fo3:
|
||
mvi c,100 ;100's
|
||
call dec ;output and fall thru to FO2
|
||
;
|
||
; Output value in B as 2 decimal chars
|
||
;
|
||
fo2:
|
||
mvi c,10 ;10's
|
||
call dec
|
||
mov a,b ;get value
|
||
adi '0' ;convert
|
||
call chout
|
||
jmp fout1 ;continue
|
||
;
|
||
; Subtracting Output
|
||
; Output value in B as 100's or 10's digit (leading 0 allowed)
|
||
;
|
||
dec:
|
||
push d ;save DE
|
||
mov a,b ;get value
|
||
mvi d,'0' ;set digit
|
||
dec1:
|
||
sub c ;subtract
|
||
jc dec2
|
||
inr d ;increment digit
|
||
jmp dec1
|
||
dec2:
|
||
add c ;add back in
|
||
mov b,a
|
||
mov a,d ;output digit
|
||
call chout
|
||
pop d ;restore DE
|
||
ret
|
||
;
|
||
; Exit Format String Output
|
||
;
|
||
foutx:
|
||
pop b ;restore BC
|
||
pop h ;restore ptr to next char
|
||
ret
|
||
;
|
||
; Literal Format Output
|
||
;
|
||
flit:
|
||
inx h ;pt to char
|
||
call capa ;get char
|
||
cpi 'B' ;BS?
|
||
jz f1bs
|
||
cpi 'D' ;DEL?
|
||
jz f1del
|
||
cpi 'E' ;ESCAPE?
|
||
jz f1esc
|
||
cpi 'L' ;CRLF?
|
||
jz f1nl
|
||
cpi 'N' ;LF?
|
||
jz f1lf
|
||
cpi 'R' ;CR?
|
||
jz f1cr
|
||
cpi 'T' ;TAB?
|
||
jz f1tab
|
||
cpi '0' ;digit?
|
||
jc fchck ;literal if not
|
||
cpi '9'+1 ;range?
|
||
jnc fchck
|
||
;
|
||
; Output Number
|
||
;
|
||
call eval ;convert to binary in DE
|
||
mov a,e ;char binary value
|
||
jmp fch ;output
|
||
;
|
||
; Check for Valid Literal
|
||
;
|
||
fchck:
|
||
cpi ' ' ;not valid if less than space
|
||
jnc fch
|
||
call eprint
|
||
db cr,lf,bel,' Invalid Literal Argument',cr,lf,0
|
||
jmp fout1
|
||
;
|
||
; Output BS
|
||
;
|
||
f1bs:
|
||
mvi a,bs
|
||
jmp fch
|
||
;
|
||
; Output TAB
|
||
;
|
||
f1tab:
|
||
mvi a,tab
|
||
jmp fch
|
||
;
|
||
; Output CR
|
||
;
|
||
f1cr:
|
||
mvi a,cr
|
||
jmp fch
|
||
;
|
||
; Output DEL
|
||
;
|
||
f1del:
|
||
mvi a,7fh
|
||
jmp fch
|
||
;
|
||
; Output ESCAPE
|
||
;
|
||
f1esc:
|
||
mvi a,1bh
|
||
jmp fch
|
||
;
|
||
; Output LF
|
||
;
|
||
f1lf:
|
||
mvi a,lf
|
||
jmp fch
|
||
;
|
||
; Output CRLF
|
||
;
|
||
f1nl:
|
||
mvi a,cr
|
||
call chout ;output CR
|
||
mvi a,lf
|
||
jmp fch
|
||
|
||
;
|
||
; Define New Output Format
|
||
;
|
||
outfmt:
|
||
inx h ;pt to format char
|
||
xchg
|
||
lhld format ;pt to format area
|
||
xchg
|
||
;
|
||
; Get next char for format string
|
||
;
|
||
outf1:
|
||
mov a,m ;get next char
|
||
ani 7fh ;mask
|
||
cpi endfmt ;end of format?
|
||
jz outf2
|
||
cpi CR ;end of line?
|
||
jz outf3
|
||
cpi LF ;end of line?
|
||
jz outf3
|
||
cpi CTRLZ ;end of file?
|
||
jz outf3
|
||
stax d ;store char
|
||
inx h ;pt to next
|
||
inx d
|
||
cpi literal ;literal denotation?
|
||
jnz outf1 ;continue if not
|
||
;
|
||
; Literal flag, so store next char exactly as-is without interpretation
|
||
;
|
||
mov a,m ;get next char
|
||
ani 7fh ;mask
|
||
stax d ;store it literally
|
||
inx h ;pt to next
|
||
inx d
|
||
jmp outf1
|
||
;
|
||
; Format String Stored - Terminate it
|
||
;
|
||
outf2:
|
||
inx h ;pt to next char
|
||
outf3:
|
||
xra a ;terminate format string
|
||
stax d
|
||
jmp output
|
||
|
||
;
|
||
; Invalid Word - So State
|
||
;
|
||
badword:
|
||
call eprint
|
||
db cr,lf,bel,' Invalid Word Reference: ',0
|
||
lxi h,wordbf ;pt to buffer
|
||
call prword ;print word
|
||
lhld nextch ;continue
|
||
jmp output
|
||
;
|
||
; Element must be a word - resolve it
|
||
;
|
||
bufword:
|
||
lxi d,wordbf ;buffer to store word in
|
||
mvi b,wordl ;length
|
||
;
|
||
; Build Word into WORDBF
|
||
;
|
||
bword1:
|
||
call capa ;get char
|
||
cpi ' '+1 ;end?
|
||
jc bword3
|
||
stax d ;store char
|
||
inx h ;pt to next
|
||
inx d
|
||
dcr b ;count down
|
||
jnz bword1
|
||
;
|
||
; Word is longer than WORDL - skip trailing chars
|
||
;
|
||
bword2:
|
||
mov a,m ;skip chars to delimiter
|
||
ani 7fh ;mask
|
||
cpi ' '+1
|
||
jc bword4
|
||
inx h ;pt to next
|
||
jmp bword2
|
||
;
|
||
; Word is built into WORDBF - space fill it
|
||
;
|
||
bword3:
|
||
mvi a,' ' ;space
|
||
stax d ;store char
|
||
inx d ;pt to next
|
||
dcr b ;count down
|
||
jnz bword3
|
||
;
|
||
; Word is Stored
|
||
; HL pts to next char after the Word
|
||
;
|
||
bword4:
|
||
ret
|
||
;
|
||
; Scan for Word in Table
|
||
; Return with Zero Set if Not Resolved
|
||
; If Resolved, DE=address of word
|
||
;
|
||
wscan:
|
||
lhld words ;pt to first word in table
|
||
wscan1:
|
||
mov a,m ;abort if empty table
|
||
ora a
|
||
rz
|
||
lxi d,wordbf ;pt to buffer
|
||
mvi b,wordl ;size of buffer
|
||
push h ;save HL
|
||
wscan2:
|
||
ldax d ;get char
|
||
cmp m ;compare
|
||
jnz wscan3
|
||
inx h ;pt to next
|
||
inx d
|
||
dcr b ;count down
|
||
jnz wscan2
|
||
mov e,m ;get address in DE
|
||
inx h
|
||
mov d,m
|
||
pop psw ;clear stack
|
||
xra a ;return NZ
|
||
dcr a
|
||
ret
|
||
wscan3:
|
||
pop h ;get address of current word in table
|
||
lxi d,wordl+2 ;advance to next word
|
||
dad d
|
||
jmp wscan1
|
||
|
||
;
|
||
; Push Address in NEXTCH onto Location Stack
|
||
;
|
||
locpush:
|
||
push h ;save regs
|
||
push d
|
||
lhld nextch ;get address
|
||
xchg ;... in DE
|
||
lhld tos ;get top of stack
|
||
mov m,e ;store address
|
||
inx h
|
||
mov m,d
|
||
inx h
|
||
shld tos ;new top of stack
|
||
pop d ;restore regs
|
||
pop h
|
||
ret
|
||
;
|
||
; Pop Address from Top of Stack
|
||
;
|
||
locpop:
|
||
lhld locstk ;local stack
|
||
xchg
|
||
lhld tos ;check to see if nothing on stack
|
||
mov a,e ;if lows are same, nothing on stack
|
||
cmp l
|
||
rz
|
||
dcx h ;pt to top element
|
||
mov d,m ;get high
|
||
dcx h
|
||
mov e,m ;get low
|
||
shld tos ;new top of stack
|
||
xchg ;address in HL
|
||
xra a ;return with NZ
|
||
dcr a
|
||
ret
|
||
;
|
||
; Skip to Non-Space
|
||
;
|
||
sksp:
|
||
mov a,m ;get char
|
||
ani 7fh ;mask
|
||
call issp ;test for space
|
||
rnz ;not space, so return
|
||
inx h ;pt to next
|
||
jmp sksp
|
||
;
|
||
; Test char in A for space char
|
||
; Ret with Z if yes
|
||
;
|
||
issp:
|
||
push h ;save HL
|
||
push b ;save BC
|
||
lxi h,sptab ;pt to table
|
||
mov b,a ;char in B
|
||
issp1:
|
||
mov a,m ;get next char
|
||
ora a ;end of table?
|
||
jz issp3
|
||
cmp b ;match?
|
||
jz issp2
|
||
inx h ;pt to next
|
||
jmp issp1
|
||
issp2:
|
||
mov a,b ;restore char
|
||
pop b ;restore regs
|
||
pop h
|
||
ret ;Z flag is set
|
||
issp3:
|
||
xra a ;set NZ
|
||
dcr a
|
||
jmp issp2
|
||
;
|
||
; Output New Line
|
||
;
|
||
crlf:
|
||
push psw ;save A
|
||
mvi a,cr ;CR
|
||
call chout
|
||
mvi a,lf ;LF
|
||
call chout
|
||
pop psw ;get A
|
||
ret
|
||
;
|
||
; Output Char in A with XON/XOFF Flow Control
|
||
;
|
||
chout:
|
||
push psw ;save char
|
||
call condin ;conditional input
|
||
jz chout1
|
||
cpi ctrls ;pause?
|
||
jnz chout1
|
||
call cin ;wait for following char
|
||
chout1:
|
||
pop psw ;get char
|
||
push b ;save BC
|
||
mov c,a ;char in C
|
||
lda outdev ;get output device
|
||
cpi 'C' ;console?
|
||
jz chcon
|
||
cpi 'L' ;printer?
|
||
jz chlst
|
||
cpi 'P' ;punch?
|
||
jz chpun
|
||
;
|
||
; Output to Console
|
||
;
|
||
chcon:
|
||
mov a,c ;get char
|
||
call cout
|
||
pop b
|
||
ret
|
||
;
|
||
; Output to List
|
||
;
|
||
chlst:
|
||
mov a,c ;get char
|
||
call lout
|
||
pop b
|
||
ret
|
||
;
|
||
; Output to Punch
|
||
;
|
||
chpun:
|
||
mov a,c ;get char
|
||
call pout
|
||
pop b
|
||
ret
|
||
;
|
||
; Print String Pted to by HL
|
||
;
|
||
epstr:
|
||
mov a,m ;get char
|
||
inx h ;pt to next
|
||
ani 7fh ;mask MSB
|
||
rz ;done
|
||
call chout ;print char
|
||
jmp epstr
|
||
;
|
||
; Print String at Return Address
|
||
;
|
||
eprint:
|
||
xthl ;save HL and pt to string
|
||
call epstr ;print string
|
||
xthl ;restore HL and new exec adr
|
||
ret
|
||
;
|
||
; Input Char, Mask, and Capitalize
|
||
;
|
||
capa:
|
||
mov a,m ;get char
|
||
ani 7fh ;mask
|
||
jmp caps ;capitalize
|
||
|
||
;
|
||
; Space Table
|
||
;
|
||
sptab:
|
||
db ' ',tab,bs,ff,',','.',0 ;space chars
|
||
|
||
;
|
||
; Data Area
|
||
;
|
||
defname:
|
||
db 'STD ' ;default file name
|
||
deftype:
|
||
db 'DPG' ;default file type
|
||
deffmt:
|
||
db '%C',0 ;default format string
|
||
outdev:
|
||
ds 1 ;output device (C=console, L=list, P=punch)
|
||
outdev1:
|
||
ds 1 ;save area for output device
|
||
wordbf:
|
||
ds wordl ;current word buffer
|
||
format:
|
||
ds 2 ;address of format string
|
||
free:
|
||
ds 2 ;address of free area
|
||
words:
|
||
ds 2 ;address of scratch area
|
||
nxtword:
|
||
ds 2 ;pointer to next word
|
||
nextch:
|
||
ds 2 ;pointer to next char
|
||
locstk:
|
||
ds 2 ;pointer to location stack
|
||
tos:
|
||
ds 2 ;pointer to top of stack
|
||
|
||
end
|
||
|