mirror of https://github.com/wwarthen/RomWBW.git
You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
1125 lines
18 KiB
1125 lines
18 KiB
;
|
|
; 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
|
|
|