home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
commercial-software
/
programming
/
Z80TOOLS.ZIP
/
DISK1.ZIP
/
CMDASM.ANT
< prev
next >
Wrap
Text File
|
1998-07-30
|
74KB
|
3,264 lines
; Copyright (C) 1985 M&T Publishing Co. all rights reserved
; TYPIST -- echo keyboard lines to printer
maclib environ
dseg
linesize equ 132 ; max line we will read
keyboard:
confile
printer:
lstfile
line strspace linesize
cseg
prolog
loop:
fgetstr keyboard,line,linesize
rz
fputline printer,line
jmp loop
end
e strspace linesize
cseg
prolog
; Copyright (C) 1985 M&T Publishing Co. all rights reserved
; KEYFILE destination
; write keyboard lines into file specified by "destination"
maclib environ
dseg
Linelen equ 256
Input: filedef Linelen,,CON:
Screen: msgfile
Output: filedef Linelen
Line: strspace Linelen
Prompt: strconst '==>'
Ughhh: strconst 'I have a problem.$'
cseg
prolog
;verify the command operand Destination
; parse and save command operands
savetail ; save operands, set A to count
; if not just 1, abort w/ message
cpi 1 ; exactly one?
abort nz,Ughhh
; assign operand 1 to Output
tailtokn 1 ; set DE->string of token #1
xchg ; make that HL->token
fassign Output,@H ; assign string to file
; if invalid, abort w/ message
abort z,Ughhh ; Z true if not valid filespec
; if ambiguous, abort w/ message
cpi '?' ; A="?" if ambiguous
abort z,Ughhh
;prepare the Input file
freset Input
;prepare the Output file
frewrite Output
loop:
; display Prompt on Screen
fputstr Screen,Prompt
; read Line from Input
fgetstr Input,Line,Linelen
; if end of file, break
jz done
; write Line to Output
fputline Output,Line,Linelen
;end loop.
jmp loop
; close the Output file
done: fclose Output
ret
end
e to Output
fputline Output,Line,Linel title 'EMIT command'
;===============================================================
;
; EMIT device bytes...
;
; Emit a control sequence specified by "bytes..." operands, to
; a logical device CON:, LST:, or AUX: as given by "device."
;
; History:
; initial code 18 June 84
; Copyright (C) 1985 M&T Publishing Co. all rights reserved
;===============================================================
maclib environ
dseg
usage: ; usage message for aborts
cr equ AsciiCR
lf equ AsciiLF
tab equ AsciiTAB
db 'EMIT sends bytes to a device. Syntax is',cr,lf
db tab,'EMIT device bytes...',cr,lf
db 'Device must be CON: or LST: or AUX: or PUN:',cr,lf
db 'A byte is either',cr,lf
db tab,'a decimal number from 0 to 255',cr,lf
db tab,'a hex number from 0H to 0FFH',cr,lf
db tab,'name of a control character like ESC or CR',cr,lf
db tab,'quoted literal characters like ''ABC or "9',cr,lf
db '$' ; must end abort with a dollarsign
abdev: strconst ' is not a device I can emit to.$'
abopr: strconst ' is not a byte-code I can convert.$'
ntoken db 0 ; number of operands
ctoken db 0 ; token being worked on now
cbyte dw 0 ; ->next byte of "stuff"
stuff: ds 128 ; space for output bytes (and msgs)
dest: filedef 128
cseg
prolog
; validate the number of command-tokens
extrn CHKOPS
lxi b,(1*256)+255 ; B=1, C=255
lxi d,usage ; DE->usage message
call CHKOPS
sta ntoken ; save count of operands
; validate the device-name and assign to dest
call checkdev ; do it in a subroutine
; set up for the loop:
mvi a,2 ; first byte will be
sta ctoken ; ..operand #2
lxi h,stuff ; and will go into
shld cbyte ; ..byte 0 of stuff
mvi b,0 ; count bytes in B
; for each code-token c with initial byte x...
for:
lxi h,ntoken
mov a,m ; A = total operands
inx h ; HL->ctoken
cmp m ; total < current?
jc donefor ; (yes, done)
mov a,m ; A = current token
inr m ; ..and ctoken = next
tailtokn @A ; DE->current token
ldax d ; A = initial byte
; if (x is alphabetic) then
; j := handle-name(c,j)
alpha? @A ; is A alphabetic?
jnz notalph ; (no)
call handlename ; yes, handle it
jmp for ; ..and interate
; else if (x is decimal) then
; j := handle-number(c,j)
notalph:
digit? @A ; is it a digit?
jnz notdig ; (no)
call handlenum
jmp for
; else if (x is a quote) then
; j := handle-literal(c,j)
notdig:
cpi '''' ; single quote?
jz isquote
cpi '"' ; ..or double?
jnz notquote
isquote:
call handlelit
jmp for
; else badbyte(c)
notquote:
call badbyte
; end for.
donefor:
mov a,b
ora a ; any bytes decoded?
rz ; (no, quit)
; write the saved bytes to dest
lxi h,stuff
lxi d,dest
outloop:
mov a,m ; A = this byte
inx h ; HL->next one
fputbyte @D,@A ; write it
djnz outloop
ret
; handlename: DE->operand beginning with alphabetic --
; decode it with a table look-up.
dseg
names: strtable 36 ; set up table of names
strentry 'NUL' ; after each name,
db 0 ; put byte value.
strentry 'SOH'
db 1
strentry 'STX'
db 2
strentry 'ETX'
db 3
strentry 'EOT'
db 4
strentry 'ENQ'
db 5
strentry 'ACK'
db 6
strentry 'BEL'
db 7
strentry 'BS'
db 8
strentry 'HT'
db 9
strentry 'LF'
db 10
strentry 'VT'
db 11
strentry 'FF'
db 12
strentry 'CR'
db 13
strentry 'SO'
db 14
strentry 'SI'
db 15
strentry 'DLE'
db 16
strentry 'DC1' ; DC1 = XON = ctrl-Q
db 17
strentry 'XON'
db 17
strentry 'DC2'
db 18
strentry 'DC3' ; DC3 = XOFF = ctrl-S
db 19
strentry 'XOFF'
db 19
strentry 'DC4'
db 20
strentry 'NAK'
db 21
strentry 'SYN'
db 22
strentry 'ETB'
db 23
strentry 'CAN'
db 24
strentry 'EM'
db 25
strentry 'SUB'
db 26
strentry 'ESC'
db 27
strentry 'FS'
db 28
strentry 'GS'
db 29
strentry 'RS'
db 30
strentry 'US'
db 31
strentry 'SPACE'
db 32
strentry 'COMMA'
db 44
cseg
handlename:
push h
push psw
lxi h,names
strlook @D,@Hupdate ; find DE->string in HL->table
jnz badbyte ; give up if not in table
inx h ; HL->byte after matching entry
mov a,m ; ..which is requested value
lhld cbyte
mov m,a ; put in next "stuff" slot
inx h
shld cbyte ; update pointer
inr b ; ..and count byte
pop psw
pop h
ret
; handlenum: DE->token commencing in a digit, convert it
; from either decimal or hex.
handlenum:
push psw
push h
push d ; save ->start of string
strend @Dupdate ; DE->null at end of string
dcx d ; DE->last byte of string
ldax d
pop d ; recover ->string
cpi 'H' ; hex number?
jnz nothex
straxbw @D ; convert hex to binary in HL
jmp dechex ; ..and check value
nothex: digit? @A ; not hex, is it decimal?
jnz badbyte ; (no -- 17X...)
stradbw @D ; convert decimal to binary
dechex: mov a,h ; value > 255?
ora a ; ..H is nonzero if so
jnz badbyte ; (yes, give up)
mov a,l ; no, save value in A
lhld cbyte
mov m,a ; and put in next stuff slot
inx h
shld cbyte ; update pointer,
inr b ; ..and count byte
pop h
pop psw
ret
; handlelit: DE->string starting with one of two quotes,
; copy it (less quotes) to stuff.
handlelit:
push psw
push h
push d
ldax d ; A = opening quote
inx d ; DE->byte after it
push d ; (save that)
strend @Dupdate; DE->terminal null
dcx d ; DE->closing byte of string
xchg ; (make that HL)
cmp m ; did they close the quote?
jnz notclosed
mvi m,0 ; yes, truncate string
notclosed:
pop d ; DE->first literal byte again
ldax d ; is there anything left now,
ora a ; ..or was it just only a quote?
jnz havesome
pop d ; recover ->whole string
jmp badbyte ; ..and give up
havesome:
lhld cbyte
litloop:
mov m,a ; copy literal byte to stuff
inr b ; ..and count it
inx h ; ..and point to next slot
inx d ; ..and point to next byte
ldax d ; is that byte
ora a ; ..the null at the end?
jnz litloop ; (no, continue)
shld cbyte ; record final ->next slot
pop d
pop h
pop psw
ret
; badbyte: DE->an operand we can't handle, abort
badbyte:
xchg ; HL->operand
lxi d,stuff ; DE->space to build msg
strcopy @D,@H
strappnd @D,abopr
abort ,@D
; checkdev: subroutine to validate "device" operand and
; abort if it isn't appropriate.
dseg
devtab: strtable 4 ; initiate table of 4 strings
strentry 'CON:' ; fill with valid devices
strentry 'LST:'
strentry 'AUX:'
strentry 'PUN:'
cseg
checkdev:
push h
push d
push psw
tailtokn 1 ; DE->first operand string
strlook @D,devtab ; lookup DE->string in table
jnz baddev ; (didn't find it)
xchg ; make it HL->operand
lxi d,dest ; and DE->file
fassign @D,@H ; assign name to filedef
frewrite @D ; ..and open it
pop psw
pop d
pop h
ret
baddev: ; oops, not a device we know -- build an abort message
xchg ; HL->bad device
lxi d,stuff ; place to build message
strcopy @D,@H ; copy "frummage" to stuff
lxi h,abdev
strappnd @D,@H ; append rest of msg
abort ,@D ; ..and abort with it
end
H ; copy "frummage" to;===============================================================
;
; CDUMP filespec
;
; Displays file "filespec" in ascii, 64 bytes to the line, for
; safe inspection when the contents of the file are in doubt.
;
; Abort messages
; usage message
; input-open messages
;
; Modules:
; CHKOPS
; OPENIN
;
; History
; initial code 6/21/84
; Copyright (C) 1985 M&T Publishing Co. all rights reserved
;===============================================================
maclib environ
dseg
usage: db 'CDUMP filespec'
db AsciiCR,AsciiLF
db 'Displays contents of file 64 bytes/line, with'
db AsciiCR,AsciiLF
db 'control characters translated to "~" and ends'
db AsciiCR,AsciiLF
db 'of lines shown as "//".'
db AsciiCR,AsciiLF
db '$'
user: msgfile
input: filedef 1024
line: strspace 64
cseg
prolog
; check operand count of 1, etc (CHKOPS)
mvi b,1 ; minimum operands: 1
mov c,b ; maximum ditto
lxi d,usage
extrn CHKOPS
call CHKOPS
; validate filespec, assign it to input, and open it
mvi a,1 ; operand 1 is filespec
lxi d,input ; filedef to assign it to
extrn OPENIN
call OPENIN
; repeat
loop:
; make first 64-byte line and display it
call makeline
fputline user,line
; make second line and display it
call makeline
fputline user,line
; until end-of-file(input) or keyboard-pending
testcon ; keyboard?
jnz done ; (yes)
feof? input ; no, end of file?
jnz loop ; (no, continue)
; end cdump.
done: ret
; makeline()
makeline:
push psw
push b
push d
push h
; make line a null string
lxi d,line
strnull @D
xchg ; carry HL->string position
lxi d,input ; ..and DE->file
; for t := 0 to 63
mvi b,64 ; set loop count
mloop:
; c := fgetbyte(input)
fgetbyte @D
; c := translate(c)
call translate
; append c to line
xchg
strput @Dupdate,@A
xchg
; end for
djnz mloop
;end makeline.
pop h
pop d
pop b
pop psw
ret
;translate(x) : character
translate:
; if (x > 127) then x := x - 128
cpi AsciiDEL+1
jc lt128
ani AsciiDEL
lt128:
; if (x >= space) and (x < DEL) then return x
cpi AsciiBlank ; if less than space
jc iscontrol ; ..it's a control char
cpi AsciiDEL ; not less than space,
rc ; if < DEL, is ascii
iscontrol:
; if (x = CR) or (x = LF) then return slash
cpi AsciiCR
jz slash
cpi AsciiLF
jnz dot
slash: mvi a,'/'
ret
; return a dot
dot: mvi a,'.'
ret
;end translate.
end
jz slash
cpi AsciiLF
jnz dot
slash: mvi a,'/' title 'BDUMP -- binary file display'
;===============================================================
;
; BDUMP filespec
;
; Displays file "filespec" in hex and ascii, 16 bytes to the
; line, with CP/M record numbers.
;
; Abort messages
; usage message
; input-open messages
;
; Modules:
; CHKOPS
; OPENIN
;
; History
; initial code 6/26/84
; Copyright (C) 1985 M&T Publishing Co. all rights reserved
;===============================================================
maclib environ
dseg
usage: db 'BDUMP filespec'
db AsciiCR,AsciiLF
db 'Displays contents of file 16 bytes/line, with'
db AsciiCR,AsciiLF
db 'data shown in both hex and ascii, with CP/M'
db AsciiCR,AsciiLF
db 'file record numbers.'
db AsciiCR,AsciiLF
db '$'
input: filedef 1024
cseg
prolog
; check operand count of 1, etc (CHKOPS)
mvi b,1 ; minimum operands: 1
mov c,b ; maximum ditto
lxi d,usage
extrn CHKOPS
call CHKOPS
; validate filespec, assign and open (OPENIN)
mvi a,1 ; operand #1 is filespec
lxi d,input ; DE->filedef for it
extrn OPENIN
call OPENIN
; HL will carry record number
lxi h,0
; DE will address input file
lxi d,input
; repeat
; get 128 bytes and display it
loop128:
call show128 ; with(file,recnum)
inx h ; next record number
; until end-of-file(input) or keyboard-pending
testcon ; keyboard pending?
jnz done ; (yes)
feof? input ; no, end of file?
jnz loop128 ; (no, continue)
;end bdump.
done: ret
;show128(DE->file,HL=recnum)
; user is a file representing the screen
; line is space for a display line
; block is space for 128 bytes of data
dseg
user: msgfile ; moved to this level
line: strspace 80
block: ds 128
cseg
show128:
push psw
push b
push d
push h ; save recnum on top of stack
; fgetblok(given file,block)
fgetblok @D,block,128
; process 1st 16 bytes into line
lxi h,block
lxi d,line
call show16 ; with(line,bytes)
; append record number recnum to line
strput @Dupdate,AsciiBlank
xthl ; save ->bytes, HL=recnum
strbwax @D,@H
xthl ; get back HL->bytes
; fputline(user,line)
fputline user,line
; do 7 more times
mvi b,7 ; loop count for djnz
loop7:
; process next 16 bytes into line
lxi d,16
dad d ; advance HL to next 16
lxi d,line
call show16 ; with(line,bytes)
; fputline(user,line)
fputline user,line
; end do.
djnz loop7
;end show128.
pop h
pop d
pop b
pop psw
ret
;show16(DE->line,HL->bytes) { method 1 }
show16:
push psw
push b
push d
push h ; HL->bytes to display
; make line the null string
strnull @D
; for each byte x in bytes
mvi b,16
loophex:
; append hex display of x to line
mov a,m ; get byte "x"
inx h ; ..and advance pointer
strbbax @Dupdate,@A
; append a blank to line
mvi a,AsciiBlank
strput @Dupdate,@A
; end for
djnz loophex
; append another blank to line
strput @Dupdate,@A ; A = blank at end of loop
; for each byte x in bytes
pop h ; recover ->bytes
push h ; ..and save again
mvi b,16
loopasc:
; append translate(x) to line
mov a,m
inx h
call translate
strput @Dupdate,@A
; end for
djnz loopasc
;end show16.
pop h
pop d
pop b
pop psw
ret
;translate(x) : character (from cdump)
translate:
; if (x > 127) then x := x - 128
cpi AsciiDEL+1
jc lt128
ani AsciiDEL
lt128:
; if (x >= space) and (x < DEL) then return x
cpi AsciiBlank ; if less than space
jc iscontrol ; ..it's a control char
cpi AsciiDEL ; not less than space,
rc ; if < DEL, is ascii
iscontrol:
; if (x = CR) or (x = LF) then return backslash
cpi AsciiCR
jz slish
cpi AsciiLF
jnz dot
slish: mvi a,'\'
ret
; return a dot
dot: mvi a,'.'
ret
;end translate.
end
jz slish
cpi Asci;===============================================================
;
; PACK infile outfile
;
; Read infile, compress using digraph and run-length methods,
; and write compressed data as outfile.
;
; Abort messages
; file-open messages
; usage message
;
; Modules
; CHKOPS
; OPENUT (OPENIN, OPENOU)
; LOOKUP
;
; History:
; initial code 13 July 84
; Copyright (C) 1985 M&T Publishing Co. all rights reserved
;===============================================================
maclib environ
dseg
usage:
db AsciiTAB,'PACK infile outfile'
db AsciiCR,AsciiLF
db 'Reads file "infile," compresses its data, and writes the'
db AsciiCR,AsciiLF
db 'compressed result as "outfile." Use the UNPACK program'
db AsciiCR,AsciiLF
db 'to restore packed data to normal. Only ASCII files will'
db AsciiCR,AsciiLF
db 'show significant reduction in size.'
db AsciiCR,AsciiLF
db '$'
infile: filedef 128 ; small input buffer
outfile: filedef 16384 ; big buffer for speed
Literally equ 0E8h ; prefix for nonascii byte
CRLF equ 0E9h ; code for CR, LF pair
CLTAB equ 0EAh ; code for CR, LF, TAB
; EBh through EEh uncommitted
EndFile equ 0EFh ; code for physical end of file
RunBase equ 0F0h ; base code for a run of 2 or more
Run17 equ 0FFh ; code for a run of 17
Verflag equ 0FFh ; prefix for version
Version equ 74h ; month/year in hex for version check
cseg
extrn CHKOPS,OPENIN,OPENOU
prolog
; chkops(1,2) { one or two operands }
mvi b,1 ; at least one,
mvi c,2 ; not more than 2, operands
lxi d,usage
call CHKOPS
; openin(1,infile) { first names infile }
mvi a,1
lxi d,infile
call OPENIN
; openou(2,outfile,infile) { 2nd is null or names outfile }
mvi a,2
lxi b,infile
lxi d,outfile
call OPENOU
; initialize outfile with version-code
mvi a,Verflag
fputbyte @D,@A
mvi a,Version
fputbyte @D,@A
call process ; process-loop out of line
fclose outfile
ret
;===============================================================
; In the following we will deal with pseudo-code variables b and
; c as words, and carry them in registers BC and DE respectively
; To reduce (?) confusion we give meaningful (?) names to the
; high and low bytes of the register pairs.
varBhi equ B
varBlo equ C
varChi equ D
varClo equ E
;===============================================================
; readtoC(): read a byte from infile and form it as a word in
; the variable c. Form a value of 256 if end of file is seen.
readtoC:
fgetbyte infile
mov varClo,a
mvi varChi,0 ; assume not end of file
rnz ; (right)
inr varChi ; 00 returned, make c=0100h
ret
;===============================================================
; compareC(A): compare the byte in A to variable c. If c>255
; then it doesn't match anything; otherwise do a byte compare.
compareC:
dcr varChi ; test hi byte for zero by
inr varChi ; decrementing and incrementing
rnz ; c > 255, is eof, matches nothing
cmp varClo
ret
;===============================================================
; cmpBC: compare b=c. If either is > 255 (end of file), they
; don't match. Else do byte-compare.
cmpBC:
mov a,varBhi
ora varChi
rnz ; (exit if either > 255)
mov a,varBlo
cmp varClo
ret
;===============================================================
; the main loop, after the pseudo-code but modified to use the
; above hardware-specific subroutines. A classification table
; is used for quick recognition and translation of the common
; 13 characters " etaoinshrdlu."
dseg
classtable:
$-PRINT ; shorten the listing
rept 128 ; array[0..127] of bytes
db 0ffh ; = not one of the common characters
endm
$+PRINT
org classtable+' '
db 0
org classtable+'e'
db 1
org classtable+'t'
db 2
org classtable+'a'
db 3
org classtable+'o'
db 4
org classtable+'i'
db 5
org classtable+'n'
db 6
org classtable+'s'
db 7
org classtable+'h'
db 8
org classtable+'r'
db 9
org classtable+'d'
db 10
org classtable+'l'
db 11
org classtable+'u'
db 12
org classtable+128
cseg
process:
push psw
push b
push d
push h
;b := readone()
;c := readone()
call readtoC
mov varBhi,varChi
mov varBlo,varClo
call readtoC
;repeat {. here b is known to be a valid byte .}
toploop:
; if (b > 127) then
; fputbyte(Literally,outfile)
; fputbyte(b,outfile)
mov a,varBlo ; if byte value
ora a ; ..has high bit of 0
jp lt128 ; ..it is less than 128
mvi a,Literally
fputbyte outfile,@A
mov a,varBlo
fputbyte outfile,@A
jmp botloop
lt128:
; else if (b and c are a compressible pair) then
; form the pair as x
lxi h,classtable
dad b ; HL->classtable[b]
mov a,m ; ..which is FF
ora a ; ..if b not one of " etaoinshrdlu"
jm nopair
call makepair ; try 2nd byte for a pair
ora a ; paircodes have high bit set
jp nopair
; fputbyte(x,outfile)
; c := readone()
fputbyte outfile,@A
call readtoC
jmp botloop
nopair:
; else if (b = CR) and (c = LF) then
mov a,varBlo
cpi AsciiCR
jnz noCR
mvi a,AsciiLF
call compareC
jnz noCR
; x := CRLF
; c := readone()
mvi h,CRLF ; use H for "x" here
call readtoC
; if (c = TAB) then
mvi a,AsciiTAB
call compareC
jnz noTAB
; x := CLTAB
; c := readone(infile)
mvi h,CLTAB
call readtoC
noTAB:
; endif
; fputbyte(x,outfile)
mov a,h
fputbyte outfile,@A
jmp botloop
noCR:
; else if (b = c) then {. possible run .}
call cmpbc
jnz norun
call doruncode ; run-code stuff out of line
jmp botloop
norun:
; else
; fputbyte(b,outfile)
mov a,varBlo
fputbyte outfile,@A
; endif
botloop:
; b := c
mov varBhi,varChi
mov varBlo,varClo
; c := readone(infile)
call readtoC
;until (b > 255)
mov a,varBhi
ora a
jz toploop
mvi a,EndFile
fputbyte outfile,@A
pop h
pop d
pop b
pop psw
ret
;===============================================================
; makepair, somewhat modified from the pseudo-code: When called
; it is already known that "b" is a common letter, and its
; numeric code 0..12 is in register A.
dseg
aftersp strconst 't aiocsw'
aftere strconst ' rsndcmt'
aftert strconst 'h eorias'
aftera strconst 'nt lrmcs'
aftero strconst ' nrfupmd'
afteri strconst 'ntsclofg'
aftern strconst ' dtgeaso'
afters strconst ' tesia.u'
afterh strconst 'ea iotr.'
afterr strconst 'ea oisty'
afterd strconst ' eios.a,'
afterl strconst 'e lioydv'
afteru strconst 'tslrmned'
followers: ; table of pointers to follower-lists
dw aftersp
dw aftere,aftert,aftera
dw aftero,afteri,aftern
dw afters,afterh,afterr
dw afterd,afterl,afteru
cseg
makepair:
dcr varChi
inr varChi ; if c > 255,
rnz ; ..we can't make a pair
push b
push d
push h
; At this point we know variable c is a byte, not eof, and
; that variable b -- regs BC -- is too. Hence BC=00xx.
; We'll be using B and C as work registers, and will rely
; on B being initially 00.
; p := lookup(b,list1) -- already done
mov c,a ; BC = 00nn, the first number
; q := lookup(c,followers[p])
lxi h,followers
dad b ; add twice 00nn to HL
dad b ; HL->(word)->followers of "b"
mov a,m
inx h
mov h,m
mov l,a ; HL->followers of "b"
makeloop:
mov a,m ; A = possible follower
cmp varClo ; is this it?
jz makepool; (yes)
inr b ; no, increment "q"
inx h ; ..and point to next candidate
ora a ; was that 00 = end of list?
jnz makeloop; (no, continue)
makepool:
; if (q > 7) then return 0
mov a,b
cpi 8 ; did we find c in follower-list?
jnc makedone; (no, exit with A not a pair code)
; return 80h + (p shiftleft 3) + q
mov a,c
add a ! add a ! add a
ora b
ori 80h
makedone:
;end makepair
pop h
pop d
pop b
ret
;===============================================================
; doruncode: the logic for forming a run-code, after the pseudo-
; code but moved out of line for clarity. On arrival, we know
; that b=c and therefore c isn't end of file. Regs HL are used
; for variable "n" at first, since we could count a run of more
; than 256 bytes.
doruncode:
push psw
push h
; n := 2
lxi h,2
; loop
runloop:
; c := readone
call readtoC
; while (c < 256) and (b = c)
call cmpBC ; checks both conditions
jnz runover
; n := n + 1
inx h
jmp runloop
runover:
; end loop
push d ; save DE over loop
lxi d,17 ; ..and carry 17 in it
; while (n >= 17) do
; fputbyte(FFh,outfile)
; fputbyte(b,outfile)
; n := n-17
; end while
putloop:
ora a ; (clear carry)
dsbc d ; decrement n by 17
jc putover ; ..and stop if n < 17
mvi a,Run17
fputbyte outfile,@A
mov a,varBlo
fputbyte outfile,@A
jmp putloop
putover:
mov a,l ; A now has residual "n"
add e ; put back the 17-too-much
pop d ; and restore DE
; if (n > 0) then
jz rundone
; if (n > 1) then
cpi 2
jc runsolo
; x := F0h + n-2
; fputbyte(x,outfile)
sbi 2
ori RunBase
fputbyte outfile,@A
; endif
runsolo:
; fputbyte(b,outfile)
mov a,varBlo
fputbyte outfile,@A
; endif
rundone:
pop h
pop psw
ret
end
olo:
; fputbyte(b,outfile)
mov a,varBlo
fputbyte outfile,@A
; endif;===============================================================
;
; UNPACK infile outfile
;
; Read a file created by PACK and restore it to its original
; condition.
;
; Abort messages
; file-open messages
; usage message
; "Input file was not created by PACK."
; "Impossible input value -- error in PACK."
;
; Modules
; CHKOPS
; OPENUT (OPENIN, OPENOU)
;
; History:
; initial code 17 July 84
; Copyright (C) 1985 M&T Publishing Co. all rights reserved
;===============================================================
maclib environ
dseg
usage:
db AsciiTAB,'UNPACK infile outfile'
db AsciiCR,AsciiLF
db 'Input file "infile" must have been created by the PACK'
db AsciiCR,AsciiLF
db 'program. Its contents are restored to their original'
db AsciiCR,AsciiLF
db 'form and written as "outfile."'
db AsciiCR,AsciiLF
db '$'
notpacked:
db 'Input file not prepared by PACK.$'
impossible:
db 'Impossible input value -- error in PACK.$'
infile: filedef 128 ; small input buffer
outfile: filedef 16384 ; big buffer for speed
Literally equ 0E8h ; prefix for nonascii byte
CRLF equ 0E9h ; code for CR, LF pair
CRLFTAB equ 0EAh ; code for CR, LF, TAB
; EBh through EEh uncommitted
EndFlag equ 0EFh ; code for physical end of file
RunBase equ 0F0h ; base code for a run of 3 or more
Run18 equ 0FFh ; code for a run of 18
Verflag equ 0FFh ; prefix for version
Version equ 74h ; month/year in hex for version check
cseg
extrn CHKOPS,OPENIN,OPENOU
prolog
; chkops(1,2) { one or two operands }
mvi b,1 ; at least one,
mvi c,2 ; not more than 2, operands
lxi d,usage
call CHKOPS
; openin(1,infile) { first names infile }
mvi a,1
lxi d,infile
call OPENIN
; openou(2,outfile,infile) { 2nd is null or names outfile }
mvi a,2
lxi b,infile
lxi d,outfile
call OPENOU
; check for the version code
lxi d,infile
fgetbyte @D
cpi VerFlag
abort nz,notpacked
fgetbyte @D
cpi Version
abort nz,notpacked
call process ; process-loop out of line
fclose outfile
ret
;===============================================================
; process: the main loop, from the pseudo-code plan. The case
; structure is implemented using a table that contains one entry
; for each possible input byte. Each entry is the offset from
; "casetop" to the "case---" label appropriate to that byte.
dseg
casetable:
; note: the following uses of REPT revealed a bug in RMAC 1.1.
; If the repetition value is between 61h and 7Ah inclusive, REPT
; performs 20h too few repetitions (i.e. 41h to 5Ah). The IF
; statement after the REPT checks for this and compensates.
count set 1+07Fh-0 ; 0..7f = ascii characters
rept count
db toascii ; "to..." labels defined later
endm
count set 1+0E7h-80h ; 80..E7 = pair codes
temp set $
rept count
db topair
endm
if ($-temp) lt count ; then we didn't get enough repeats
rept count-($-temp) ; make up the lack
db topair
endm
endif
db tononasc ; E8 = nonascii follows
db tocrlf ; E9 = CR, LF
db tocltab ; EA = CR, LF, TAB
rept 1+0EEh-0EBh ; EB..EF = impossible
db toerror
endm
db toerror ; EF = endfile shouldn't come here
rept 1+0FFh-0F0h ; F0..FF = runcodes
db torun
endm
cseg
process:
push psw
push b
push d
push h
;next := fgetbyte(infile)
lxi d,infile
fgetbyte @D
mov b,a ; carry "next" in B
lxi d,outfile ; carry DE->outfile
;repeat
toploop:
; case (next) of
lxi h,casetable
mov a,b
addhla ; HL -> class of byte in A
mov a,m ; get it to A
lxi h,cases
addhla ; HL-> code of case action
pchl ; go do it
cases:
;{ascii} 0..7Fh : fputbyte(next,outfile)
caseascii:
toascii equ caseascii-cases
mov a,b
fputbyte @D,@A
jmp casend
;{pairs} 80..E7h: decode the pair as b,c
; fputbyte(b,outfile)
; fputbyte(c,outfile)
casepair:
topair equ casepair-cases
mov a,b
call decode ; decode A to B,C
mov a,b
fputbyte @D,@A
mov a,c
fputbyte @D,@A
jmp casend
;{nonascii} E8h : next := fgetbyte(infile)
; fputbyte(next,outfile)
casenonasc:
tononasc equ casenonasc-cases
fgetbyte infile
fputbyte @D,@A
jmp casend
;{CRLF} E9h : fputbyte(CR,outfile)
; fputbyte(LF,outfile)
casecrlf:
tocrlf equ casecrlf-cases
mvi a,AsciiCR
fputbyte @D,@A
mvi a,AsciiLF
fputbyte @D,@A
jmp casend
;(CLTAB} EAh : fputbyte(CR,outfile)
; fputbyte(LF,outfile)
; fputbyte(TAB,outfile)
casecltab:
tocltab equ casecltab-cases
mvi a,AsciiCR
fputbyte @D,@A
mvi a,AsciiLF
fputbyte @D,@A
mvi a,AsciiTAB
fputbyte @D,@A
jmp casend
;{runcode} F0..FFh: n := 2 + low four bits of next
; next := fgetbyte(infile)
; do n times: fputbyte(next,outfile)
caserun:
torun equ caserun-cases
mov a,b
ani 0Fh ; A = low bits of runcode
adi 2 ; ..plus 2
mov b,a ; save loop count in B
fgetbyte infile
running:
fputbyte @D,@A
djnz running
jmp casend
; the "impossible" input is also a case
caserror:
toerror equ caserror-cases
abort ,impossible
; end case.
casend:
; next := fgetbyte(infile)
fgetbyte infile
mov b,a
;until (next = EFh)
cpi EndFlag
jnz toploop
pop h
pop d
pop b
pop psw
ret
;===============================================================
; decode(paircode in A to characters in B, C) -- decoding is
; done by using the values in the paircode to index tables of
; letters. The code is 1aaaabbb. The first letter of the pair
; is firstab[aaaa] while the second is followtab[aaaa,bbb].
dseg
firstab:
db ' etaoinshrdlu'
followtab:
db 't aiocsw'
db ' rsndcmt'
db 'h eorias'
db 'nt lrmcs'
db ' nrfupmd'
db 'ntsclofg'
db ' dtgeaso'
db ' tesia.u'
db 'ea iotr.'
db 'ea oisty'
db ' eios.a,'
db 'e lioydv'
db 'tslrmned'
cseg
decode:
push h
push psw ; save copy of paircode
; get the 4-bit number "aaaa" to the low four bits of the
; register and isolate it.
rar ! rar ! rar
ani 0Fh
; use it to select the first letter
lxi h,firstab
addhla
mov b,m
; use the whole 7-bits aaaabbb to index the 2nd letter
pop psw
ani 7Fh ; get rid of high bit
lxi h,followtab
addhla
mov c,m
pop h
ret
aaabbb to index the 2nd letter
pop psw
ani 7Fh ; get rid of high bit
lxi h,followtab
addhla
;===============================================================
;
; TABBIT input output
;
; Reads an ASCII file and converts sequences of blanks to tabs
; wherever possible. Also deletes trailing blanks on a line.
;
; Abort messages
; file-open messages
; usage message
;
; Modules
; CHKOPS
; OPENUT (OPENIN, OPENOU)
;
; History
; Initial code 6 July 1984
; Copyright (C) 1985 M&T Publishing Co. all rights reserved
;===============================================================
maclib environ
dseg
usage:
db AsciiTAB,'TABBIT infile outfile'
db AsciiCR,AsciiLF
db 'Tabbit reads the input file and converts sequences of'
db AsciiCR,AsciiLF
db 'blanks to tabs where possible. It also deletes blanks'
db AsciiCR,AsciiLF
db 'at the ends of lines.'
db AsciiCR,AsciiLF
db 'The input file should be all-ASCII, and its data should'
db AsciiCR,AsciiLF
db 'not be intended for further processing before printing.'
db AsciiCR,AsciiLF,'$'
input: filedef 128 ; small input buffer
output: filedef 16384 ; big output buffer for speed
cseg
prolog
extrn CHKOPS,OPENIN,OPENOU
mvi b,1 ; at least one operand
mvi c,2 ; but not more than 2
lxi d,usage
call CHKOPS ; chkops(min,max,usage)
mvi a,1 ; 1st operand is input
lxi d,input
call OPENIN
mvi a,2 ; 2nd is output (may be null)
lxi b,input ; default filespec is "input"
lxi d,output
call OPENOU
call Process ; do the main loop
fclose output ; close the output file
ret ; and end
;======= Body of program (from pseudo-code) ========
Process:
;.column := 0
lxi b,0 ; carry column in BC
lxi d,input ; carry DE->input file
;.repeat
mainloop:
;.....x := fgetchar(input)
fgetchar @D
;.....count := 0
lxi h,0 ; count in HL
;.....while (x = AsciiBlank)
readblank:
cpi AsciiBlank
jnz notblank
;.........count := count + 1
;.........x := fgetchar(input)
inx h
fgetchar @D
;.....end while
jmp readblank
notblank:
;.....if (x <> AsciiCR) then
cpi AsciiCR
jz isCR
push psw ; save the byte "x"
push d ; save ->input, free up DE
;.........n := 8 - ( column mod 8 )
; note: since the expression needs only the low bits of
; the count, we can reorder it to (-(column mod 8)) + 8
; and do it all in the A-register.
mov a,c ; low-order bits of column
ani 0111b ; A = column mod 8
neg a ; A = -(column mod 8)
adi 8 ; A = (-(column mod 8))+8
mov e,a
mvi d,0 ; DE = 8-(column mod 8)
;.........while (count >= n)
tabloop:
cmpbw @H,@D ; flags := count-n
jc tabend ; count < n
;.............fputchar(output,AsciiTAB)
mvi a,AsciiTAB
fputchar output,@A
;.............column := column + n
;.............count := count - n
ora a ; clear carry
dsbc d ; count := count-n
xchg ; (DE=count, HL=n)
dad b ; HL = column+n
mov b,h !mov c,l; move it back to BC
xchg ; (restore HL=count, DE=junk)
;.............n := 8
lxi d,8
;.........end while
jmp tabloop
tabend:
;.........while (count > 0)
blankloop:
mov a,h ! ora l ; test HL (count) for zero
jz blankend
;.............fputchar(output,AsciiBlank)
mvi a,AsciiBlank
fputchar output,@A
;.............column := column + 1
;.............count := count - 1
inx b
dcx h
;.........end while
jmp blankloop
blankend:
;.....end if
pop d
pop psw
isCR:
;.....if (x < AsciiBlank) then { control char }
cpi AsciiBlank
jnc notCC
;.........if (x = AsciiCR) then
;..................column := 0
cpi AsciiCR
jnz notCR
lxi b,0
jmp writex
notCR:
;.........elif (x = AsciiBS) and (column > 0) then
;..................column := column - 1
cpi AsciiBS
jnz notBS
mov h,a ; save "x"
mov a,b !ora c ; test column for zero
mov a,h ; restore "x"
jz writex ; (column = 0, don't back up)
dcx b
jmp writex
notBS:
;.........elif (x = AsciiTAB) then
;..................column := (column OR 0111b) + 1
cpi AsciiTAB
jnz writex
mov h,a ; save "x"
mov a,c
ori 0111b
mov c,a ; BC = column OR 0111b
inx b ; ..plus one
mov a,h
jmp writex
;.........endif
notCC:
;.....else if (x < AsciiDEL) then { printable }
;.........column := column + 1
cpi AsciiDEL
jnc writex
inx b
;.....endif
writex:
;.....fputchar(output,x)
fputchar output,@A
;.until (end of input)
cpi CpmEof
jnz mainloop
ret
end
ritex:
;.....fputchar(output,x)
fputchar output,@A
;.until (end of input)
cpi CpmEof;===============================================================
;
; UNTAB infile outfile [tabinc]
;
; Read infile, convert tabs to spaces, write as outfile. Assumes
; a regular tab increment of tabinc (default is 8 if [tabinc])
; not given.
;
; Note: the option [tabinc] must be a separate token and must
; not contain embedded spaces or commas.
;
; Abort messages
; file-open messages
; usage message
; "option must be [nn] where "nn" is a decimal
; number between 1 and 255."
;
; Modules
; CHKOPS
; OPENUT (OPENIN, OPENOU)
;
; History:
; initial code 10 July 84
; Copyright (C) 1985 M&T Publishing Co. all rights reserved
;===============================================================
maclib environ
dseg
usage:
db AsciiTAB,'UNTAB infile outfile [nn]'
db AsciiCR,AsciiLF
db 'Reads ascii file "infile," converts tabs to spaces, and'
db AsciiCR,AsciiLF
db 'writes "outfile." Tab-conversion assumes a regular tab'
db AsciiCR,AsciiLF
db 'increment of "nn" with a default of 8 (normal CP/M) when'
db AsciiCR,AsciiLF
db 'the option "[nn]" is omitted.'
db AsciiCR,AsciiLF
db '$'
infile: filedef 128 ; small input buffer
outfile: filedef 16384 ; big buffer for speed
tabincr: ds 1 ; space for tab increment
opcount: ds 1 ; save number of operands
cseg
extrn CHKOPS,OPENIN,OPENOU
prolog
; chkops(1,3) { one to three operands }
mvi b,1 ; at least one,
mvi c,3 ; not more than 3, operands
lxi d,usage
call CHKOPS ; check, get count
sta opcount ; ..of operands and save
; openin(1,infile) { first names infile }
mvi a,1
lxi d,infile
call OPENIN
; openou(2,outfile,infile) { 2nd is null or names outfile }
mvi a,2
lxi d,outfile
lxi b,infile ; (default file)
call OPENOU
; extract tab-increment from option to tabincr
lda opcount
call getincr ; do it in a subroutine
sta tabincr
call process ; do the work
lxi d,outfile
fclose @D
ret
;===============================================================
; getincr(op#) returns increment -- extract a number from
; the option [incr] if we can find it, return in A.
dseg
badop:
db 'option must be [nn] where "nn" is a decimal number'
db AsciiCR,AsciiLF
db 'between 1 and 255.'
db AsciiCR,AsciiLF
db '$'
cseg
getincr:
push h
push d
push b
tailtokn @A ; DE->given operand string
ldax d
cpi '[' ; start of option?
mvi a,8 ; (assume not)
jnz default
inx d ; yes, step over bracket
stradbw @Dupdate; extract digits to word in HL
; result of stradbw is zero in two cases: if the number
; was actually zero ([000]) or if there were no decimal
; digits ([abc]).
mov a,h ! ora l ; check for zero...
abort z,badop
mov a,h ! ora a ; check for HL > 255...
abort nz,badop
mov a,l ; put increment in A
default:
pop b
pop d
pop h
ret
;===============================================================
; process: the main loop, after the pseudo-code, moved out of
; line for clarity. As part of the main-line, we don't bother
; to save the registers.
process:
lxi d,0 ; carry "column" in DE
; repeat
procloop:
; x := fgetchar(infile)
fgetchar infile
; if (x = AsciiTAB) then
cpi AsciiTAB
jnz notTab
; n := tabincr - (column mod tabincr)
lda tabincr ; A = tabincr = divisor
mov h,d ! mov l,e ; HL = column = dividend
div816 @H,@A ; HL = HL/A, A = remainder
neg a ; A = -(column mod tabincr)
lxi h,tabincr
add m ; A = tabincr-(column mod tabincr)
mov b,a ; put in B as loop-count
; do n times: fputchar(output,AsciiBlank)
; column := column + n
mvi a,AsciiBlank
outblank:
fputchar outfile,@A
inx d ; increment column for each
djnz outblank
; note: at the end of this then-section we know we didn't
; have CpmEof (we had a tab) so we can short-circuit the
; loop test and continue at the top of the loop
jmp procloop
; else
notTab:
; fputchar(output,x)
fputchar outfile,@A
; adjust column for effect of x (from tabbit)
; if (x < AsciiBlank) then { control char }
cpi AsciiBlank
jnc notCC
; if (x = AsciiCR) then
; column := 0
cpi AsciiCR
jnz notCR
lxi d,0
jmp endloop
notCR:
; elif (x = AsciiBS) and (column > 0) then
; column := column - 1
cpi AsciiBS
jnz endloop
mov h,a ; save "x"
mov a,d !ora e ; test column for zero
mov a,h ; restore "x"
jz endloop ; (column = 0, don't back up)
dcx d
jmp endloop
notCC:
; else if (x < AsciiDEL) then { printable }
; column := column + 1
cpi AsciiDEL
jnc endloop
inx d
endloop:
; until (x = CpmEof)
cpi CpmEof
jnz procloop
ret
lumn := column + 1
cpi AsciiDEL
jnc endloop
inx d
endloop:
name 'ANTNEW'
;===============================================================
;
; ANTNEW antname
;
; This command creates the 3 files of a new anthology as
; antname.ANT, antname.ANX, and antname.ANY. One (empty) data
; record is written to antname.ANT so that it will be visibly
; in existence. One record of all-zeros is written to both
; directory files. This creates a valid directory containing
; no information.
;
; If any file of these names exists, the command terminates
; with an error message and does nothing.
;
; messages:
; usage message
; abort messages of ANTSET (in ANTPRE.ASM)
; abort "You must erase the existing anthology first."
;
; history:
; remember to close the darn files 8/2/84
; initial code 8/1/84
; Copyright (C) 1985 M&T Publishing Co. all rights reserved
;===============================================================
maclib environ
common /ANTCOM/
; This common area definition is included in all, or most
; anthology programs. It defines the directory in storage.
; The filedefs are assembled in module ANTSUP.
AntHdr equ $ ; following words precede directory
SizeR ds 2 ; size of array R (128-multiple)
SpanR ds 2 ; # of 128-byte records over R
SizeF ds 2 ; size of array FS (ditto)
SpanF ds 2 ; # of 128-byte records over FS
AlFiles ds 2 ; count of allocated files
Frecs ds 2 ; count of free records
AntHdrLen equ $-AntHdr ; bytes written at head of file
Base ds 2 ; ->base of dir. (array R)
TopR ds 2 ; ->low free byte
BotF ds 2 ; ->bottom byte of FS
TopF ds 2 ; ->byte after directory
SizeDir equ 16384 ; in-core size of directory
FSsize equ 14 ; offset to size in FS entry
FSlen equ 16 ; size of an FS entry
AntDat ds FcrLen ; data file antname.ANT
AntDirX ds FcrLen ; directory copy antname.ANX
AntDirY ds FcrLen ; directory copy antname.ANY
AntSeq ds FcrLen ; sequential file in/out
cseg ; end of common
dseg
record ds 128 ; link will fill with zeros
exists:
strconst 'You must erase the existing anthology first.$'
usage:
db AsciiTAB
db 'ANTNEW antname'
db AsciiCR,AsciiLF
db 'Creates a new anthology as "antname." That operand'
db AsciiCR,AsciiLF
db 'must be a valid filename, and may contain a drive letter'
db AsciiCR,AsciiLF
if CpmLevel gt 22h
db 'and/or a file password'
db AsciiCR,AsciiLF
endif
db 'but a filetype is not necessary and will be ignored.'
db AsciiCR,AsciiLF
db 'Any existing anthology of that name on that drive must'
db AsciiCR,AsciiLF
db 'erased by you before; this command won''t replace it.'
db '$'
cseg
extrn ANTSET
prolog
lxi d,usage
call ANTSET ; returns token-count
cpi 2 ; if we got more than 1,
abort nc,usage ; quit with usage message
lxi d,AntDat
call makeit
lxi d,AntDirX
call makeit
lxi d,AntDirY
call makeit
ret
makeit: ; test DE->file to see if it exists, and create it
freset @D
abort nz,exists
frewrite @D
fputblok @D,record,128
fclose @D
ret
end
f it exists, and create it
freset @D
abort nz;===============================================================
;
; ANTDIR antname filename.typ
;
; Lists selected (or all, if "filename.typ" is omitted) members
; of anthology "antname." The display has one line per member,
; showing the member's size in 128-byte records and its name.
; It is followed by a summary line showing total records for
; the members displayed, total allocated to the anthology, and
; total allocated but not in use.
;
; messages:
; aborts from ANTSET, ANTOPE, ANTLOA, ANTMRK
; usage message
; history:
; initial code 6 August 1984
; Copyright (C) 1985 M&T Publishing Co. all rights reserved
;===============================================================
maclib environ
extrn ANTSET,ANTOPE,ANTLOA,ANTMRK,ANTNMK
common /ANTCOM/
; This common area definition is included in all, or most
; anthology programs. It defines the directory in storage.
; The filedefs are assembled in module ANTSUP.
AntHdr equ $ ; following words precede directory
SizeR ds 2 ; size of array R (128-multiple)
SpanR ds 2 ; # of 128-byte records over R
SizeF ds 2 ; size of array FS (ditto)
SpanF ds 2 ; # of 128-byte records over FS
AlFiles ds 2 ; count of allocated files
Frecs ds 2 ; count of free records
AntHdrLen equ $-AntHdr ; bytes written at head of file
Base ds 2 ; ->base of dir. (array R)
TopR ds 2 ; ->low free byte
BotF ds 2 ; ->bottom byte of FS
TopF ds 2 ; ->byte after directory
SizeDir equ 16384 ; in-core size of directory
FSsize equ 14 ; offset to size in FS entry
FSlen equ 16 ; size of an FS entry
AntDat ds FcrLen ; data file antname.ANT
AntDirX ds FcrLen ; directory copy antname.ANX
AntDirY ds FcrLen ; directory copy antname.ANY
AntSeq ds FcrLen ; sequential file in/out
cseg ; end of common
dseg
totrecs dw 0 ; count of records listed
screen: msgfile
header: strconst <AsciiCR,'records filename',AsciiCR,AsciiCR>
divide: strconst <'--------',AsciiCR>
lpof: strconst ' (of'
inuse: strconst ' in use;'
unused: strconst ' allocated and unused)'
usage:
db AsciiTAB,'ANTDIR antname filename.typ'
db AsciiCR,AsciiLF
db 'Displays the names of files held in anthology "antname."'
db AsciiCR,AsciiLF
db 'If the second operand is omitted, all files are shown.'
db AsciiCR,AsciiLF
db 'The second operand may use CP/M-style wildcards.'
db AsciiCR,AsciiLF,'$'
cseg
prolog
; Set up the anthology files for use, and find out how many
; command tokens there are. We support either 1 or 2 -- if
; there is but 1, a request for the 2nd one will get us the
; null string instead, which ANTMRK can handle.
lxi d,usage
call ANTSET
cpi 3
abort nc,usage
; Get the directory open and ready for use.
call ANTOPE
call ANTLOA
; Display a blank line and the column-header.
fputstr screen,header
; Mark all the members of interest, returning the count in HL.
; If there are zero matches, proceed direct to the totals line.
lxi h,0
shld totrecs ; clear total records
tailtokn 2
call ANTMRK
mov b,h ! mov c,l ; set up count in BC
mov a,b ! ora c ; is count zero?
jz lastline ; (yes, skip the details)
; Display detail lines for all the marked members.
lhld TopF ; Scan from oldest down
loop:
call ANTNMK ; HL->next marked entry down
call detail ; display it
dcx b ; count it
mov a,b ! ora c ; and if there are more,
jnz loop ; ..continue
; Display the totals.
lastline:
call totals
ret
; Display(HL->entry): display the size and name of this
; member -- the size as a decimal number in a 7-byte field,
; a space, and the filename.
detail:
push psw
push d
push h
lxi d,FSsize
dad d ; HL->S[f]
mov a,m ! inx h
mov h,m ! mov l,a ; HL = S[f]
xchg
lhld totrecs
dad d ; accumulate total
shld totrecs
xchg
lxi d,screen
mvi a,7 ; field-width
fputbwad @D,@H,@A ; write number
fputchar @D,AsciiBlank ; one space
pop h ; HL->filename string
fputline @D,@H ; finish the line
pop d
pop psw
ret
; Totals: display "rrrr (of tttt; fff allocated but unused)"
totals:
lxi d,screen
lxi h,divide
fputstr @D,@H ; divider below bytes column
lhld totrecs ; display total records
mvi a,7 ; ..in 7-byte field
fputbwad @D,@H,@A
lxi h,lpof
fputstr @D,@H ; nnnnn (of
lhld SizeR ; total allocated is SizeR/2
xra a ; (clear carry, field size 0)
rarr h
rarr l ; 0 >> H >> L
fputbwad @D,@H,@A ; .ANT size in minimum width
lxi h,inuse
fputstr @D,@H
lhld Frecs ; total allocated-but-unused
fputbwad @D,@H,@A
lxi h,unused
fputline @D,@H
ret
end
tstr @D,@H
lhld Frecs ; total allocated-but-unused
fputbwad @D,@H,@A
lxi h,unused
fputline;===============================================================
;
; ANTGET antname filespec
;
; Retrieves selected members of anthology "antname." When the
; "filespec" operand is ambiguous, retrieves each matching
; member-name. The drivecode and password of "filespec" apply
; to all members retrieved.
;
; messages:
; FILESPEC...done
; No matching files.
; aborts from ANTSET, ANTOPE, ANTLOA, ANTMRK
; usage message
; history:
; initial code 7 August 1984
; Copyright (C) 1985 M&T Publishing Co. all rights reserved
;===============================================================
maclib environ
extrn ANTSET ; set up operands
extrn ANTOPE ; open anthology files
extrn ANTLOA ; load directory
extrn ANTMRK ; mark matching files
extrn ANTNMK ; get next marked file
extrn ANTND ; next data record number
extrn ANTOUT ; copy record to AntSeq
common /ANTCOM/
; This common area definition is included in all, or most
; anthology programs. It defines the directory in storage.
; The filedefs are assembled in module ANTSUP.
AntHdr equ $ ; following words precede directory
SizeR ds 2 ; size of array R (128-multiple)
SpanR ds 2 ; # of 128-byte records over R
SizeF ds 2 ; size of array FS (ditto)
SpanF ds 2 ; # of 128-byte records over FS
AlFiles ds 2 ; count of allocated files
Frecs ds 2 ; count of free records
AntHdrLen equ $-AntHdr ; bytes written at head of file
Base ds 2 ; ->base of dir. (array R)
TopR ds 2 ; ->low free byte
BotF ds 2 ; ->bottom byte of FS
TopF ds 2 ; ->byte after directory
SizeDir equ 16384 ; in-core size of directory
FSsize equ 14 ; offset to size in FS entry
FSlen equ 16 ; size of an FS entry
AntDat ds FcrLen ; data file antname.ANT
AntDirX ds FcrLen ; directory copy antname.ANX
AntDirY ds FcrLen ; directory copy antname.ANY
AntSeq ds FcrLen ; sequential file in/out
cseg ; end of common
dseg
screen: msgfile
nofile: strconst 'No matching files.'
dots: strconst '...'
done: strconst <'done',AsciiCR>
usage:
db AsciiTAB,'ANTGET antname filespec'
db AsciiCR,AsciiLF
db 'Retrieves the members that match "filespec" from anthology'
db AsciiCR,AsciiLF
db '"antname" as independent files. The drive and password of'
db AsciiCR,AsciiLF
db '"filespec" apply to all members retrieved.'
db AsciiCR,AsciiLF,'$'
cseg
prolog
; Set up the anthology files for use, and find out how many
; command tokens there are. We require 2.
lxi d,usage
call ANTSET
cpi 2
abort nz,usage
; Get the directory open and ready for use.
call ANTOPE
call ANTLOA
; Mark all the members of interest, returning the count in HL.
; If there are zero matches, say so and exit.
tailtokn 2 ; DE->operand string
call ANTMRK
mov b,h ! mov c,l ; set up count in BC
mov a,b ! ora c ; is count zero?
jnz gotsome ; (no, proceed)
lxi d,screen
lxi h,nofile
fputline @D,@H
jmp fini
; Copy out all the marked members.
gotsome:
lxi d,screen
lhld TopF ; Scan from oldest down
loop:
call ANTNMK ; HL->next marked entry down
fputstr @D,@H
fputstr @D,dots ; document our progress
call copy ; copy the file
fputstr @D,done
dcx b ; count it
mov a,b ! ora c ; and if there are more,
jnz loop ; ..continue
fini:
ret
; Copy(HL->entry): Set up AntSeq with the filename and type
; from the entry, and open it for output. Then copy all its
; records from the .ANT data file.
copy:
push psw
push b
push d
push h
lxi d,AntSeq
fassign @D,@H,,0110b ; assign filename and type only
frewrite @D ; prepare for output
; nrecs := S[f]
; recno := 0
; while (nrecs > 0)
; recno := nextdat(f,recno)
; copyout(recno)
; nrecs := nrecs - 1
; end while
lxi d,FSsize
dad d ; HL->S[f]
mov c,m ! inx h
mov b,m ; BC=S[f]
pop h ! push h ; restore HL->F[f]
lxi d,0 ; DE holds record number
coploop:
mov a,b ! ora c
jrz copover
call ANTND
call ANTOUT
dcx b
jmp coploop
copover:
lxi d,AntSeq
fclose @D
pop h
pop d
pop b
pop psw
ret
end
ND
call ANTOU name 'ANTPUT'
;===============================================================
;
; ANTPUT antname filespec
;
; Adds all files that match "filespec" to anthology "antname,"
; replacing any that already exist there.
;
; messages
; usage message
; FRUMMAGE...checking...done
; FRUMMAGE is not a valid filespec
; FRUMMAGE -- no disk file found
; FRUMMAGE -- anthology files may not be put in one
; aborts from ANTLOA, ANTSAV, ANTPRE (ANTSET and
; ANTOPE), and ANTSUP (ANTADD, ANTFRE, ANTNF, ANTINP)
;
;
; history
; initial code 8/2/84
; Copyright (C) 1985 M&T Publishing Co. all rights reserved
;===============================================================
maclib environ
extrn ANTSET ; set up antname
extrn ANTOPE ; open anthology files
extrn ANTLOA ; load directory
extrn ANTFIN ; lookup filename
extrn ANTFRE ; free records of a file
extrn ANTADD ; add filename
extrn ANTND ; next owned record of f
extrn ANTNF ; next free record for f
extrn ANTINP ; copy record into anth.
extrn ANTSAV ; commit directory to disk
common /ANTCOM/
; This common area definition is included in all, or most
; anthology programs. It defines the directory in storage.
; The filedefs are assembled in module ANTSUP.
AntHdr equ $ ; following words precede directory
SizeR ds 2 ; size of array R (128-multiple)
SpanR ds 2 ; # of 128-byte records over R
SizeF ds 2 ; size of array FS (ditto)
SpanF ds 2 ; # of 128-byte records over FS
AlFiles ds 2 ; count of allocated files
Frecs ds 2 ; count of free records
AntHdrLen equ $-AntHdr ; bytes written at head of file
Base ds 2 ; ->base of dir. (array R)
TopR ds 2 ; ->low free byte
BotF ds 2 ; ->bottom byte of FS
TopF ds 2 ; ->byte after directory
SizeDir equ 16384 ; in-core size of directory
FSsize equ 14 ; offset to size in FS entry
FSlen equ 16 ; size of an FS entry
AntDat ds FcrLen ; data file antname.ANT
AntDirX ds FcrLen ; directory copy antname.ANX
AntDirY ds FcrLen ; directory copy antname.ANY
AntSeq ds FcrLen ; sequential file in/out
cseg ; end of common
dseg
screen: msgfile
usage:
db AsciiTAB,'ANTPUT antname filespec'
db AsciiCR,AsciiLF
db 'Adds all files that match "filespec" to the anthology'
db AsciiCR,AsciiLF
db 'named "antname." Files that already exist in the anthology'
db AsciiCR,AsciiLF
db 'are replaced.$'
cseg
;===============================================================
; Main line of ANTPUT.
prolog
lxi d,usage
call ANTSET
cpi 2 ; require 2 operands
abort nz,usage
call ANTOPE ; open all 3 files
call ANTLOA ; load the directory
tailtokn 2
call listall ; list all files, A := count
ora a ; any file found?
rz ; (no, we're done)
mov b,a ; yes, set loop count
Putloop:
call setnext ; set up next file
call doput ; ..and bring it in
djnz PutLoop
call ANTSAV
Putover:
ret
;===============================================================
; Listall(DE->operand): Check the operand string and prepare an
; array of ready filedefs, one for every matching disk file.
; Return the count of files in A.
dseg
listbase dw 0 ; ->found files
listptr dw 0 ; ->next file
maxfile equ 100 ; most files we allow (less than 256)
specsize equ 13 ; max length of "filename.typ"
listsize equ specsize*maxfile ; space for maximum list
workfile filedef 128 ; filedef to receive names
ngspec: strconst ' is not a valid filespec.'
nomatch: strconst ' -- no disk file found.'
operand: dw 0 ; ->command operand
cseg
Listall:
push b
push d
push h
; Assign the operand to AntSeq, which puts its drivecode and
; password there permanently, and also prepares AntSeq as the
; input to fdirbegn and fdircont.
xchg ; HL->string
shld operand ; (save for later msgs)
lxi d,AntSeq
fassign @D,@H
jnz LA1 ; (it was ok)
lxi d,screen
fputstr @D,@Hupdate
lxi h,ngspec
fputline @D,@Hupdate
xra a ; count of zero
jmp LAdone
; Allocate space to hold maxfile filedefs and save its address
LA1: lxi b,listsize
dslow @B
shld listbase
shld listptr
; Search the disk directory for the first (or only) file that
; matches AntSeq. If none are found, display a message and
; return a count of zero.
lxi h,workfile ; target filedef
fdirbegn @D,@H ; find and assign
jnz LA2 ; (there is at least 1)
lxi d,screen
lhld operand
fputstr @D,@Hupdate
lxi h,nomatch
fputline @D,@Hupdate
xra a
jmp LAdone
; At least one matching file was found. In this loop, save
; the filename.typ string of the matching file in a list
; and try for another.
LA2:
mvi b,0 ; initial count of found
lhld listbase ; carry target in HL
LAloop:
inr b ; count this file
mvi a,maxfile
cmp b ; don't go too far!
jz LAloopz ; (found max, stop)
mvi m,0 ; make a null string
fgetspec workfile,@Hupdate,0110b ; (name and type)
inx h ; step over null to next string
fdircont AntSeq,workfile ; try for another
jnz LAloop
LAloopz:
; Ok, we found B files and listptr->the first one.
mov a,b ; put count in A
LAdone:
pop h
pop d
pop b
ret
;===============================================================
; setnext: assign the next filename.typ from our list into the
; AntSeq filedef ready to use.
setnext:
push d
push h
lxi d,AntSeq
lhld listptr
fassign @D,@Hupdate,,0110b ; assign name.typ only
inx h ; step over null to next string
shld listptr
pop h
pop d
ret
;===============================================================
; doput: put one file into the anthology. The file has been
; checked as valid and unambiguous, has been assigned to AntSeq,
; and is known to be a real disk file.
dseg
fstr: strspace 12 ; room for "filename.typ"
type: strspace 4 ; room for just ".typ"
dots: strconst '...'
chkg: strconst 'checking...'
done: strconst 'done'
isant: strconst ' -- anthology files may not be put in one.'
typetab: strtable 3
strentry '.ANT'
strentry '.ANX'
strentry '.ANY'
cseg
doput:
push psw
push b
push d
push h
; Get the file opened.
lxi d,AntSeq ; DE->filedef
freset @D ; ..open for input
; Extract the "filename.typ" string which will be its
; anthology directory key, and ".typ" with which we
; can check for an anthology.
lxi h,type
mvi m,0
fgetspec @D,@H,0100b ; just the type
lxi h,fstr ; HL->string
mvi m,0 ; make that HL->null string
fgetspec @D,@H,0110b ; filename and type
; Put up the filename and type on the screen
lxi d,screen
fputstr @D,@H ; put up FRUMMAGE on screen
; Check to make sure it isn't part of an anthology.
lxi d,type
strlook @D,typetab ; check for illegal types
jrnz notant ; (it doesn't end in ".AN?")
; The file does end in .AN?, complain and give up on it.
lxi d,screen
fputline @D,isant ; it does, complain and
jmp DPdone
; We have an open file that isn't an anthology. Put up the
; three dots that mean we're reading it.
notant:
lxi d,screen
fputstr @D,dots
lxi d,fstr ; DE->"filename.typ"
; f := find(fstr)
; if (f=0) then {it's a new file}
; f := add(fstr)
; else {it exists already}
; delete(f)
; endif
call ANTFIN ; find(DE->str) gives HL=f
mov a,h ! ora l ; was it found?
jnz DPexists; (yes)
call ANTADD ; add(DE->str) gives HL=f
jmp DP3
DPexists:
call ANTFRE ; free(HL=f)
DP3:
; recno := 0
; nrecs := 0
; while (not eof(AntSeq)) do
; recno := nextfree(f,recno)
; copyin(recno)
; nrecs := nrecs + 1
; end while
lxi d,0 ; carry recno in DE
lxi b,0 ; carry nrecs in BC
; HL already = f
DPloop1:
feof? AntSeq
jz DPloop1z
call ANTNF
call ANTINP
inx b
jmp DPloop1
DPloop1z:
; S[f] := nrecs
push h ; save ->file entry
lxi d,FSsize
dad d ; HL->S[f]
mov m,c
inx h
mov m,b ; ..set to count of records
pop h ; HL->F[f] again
; The "checkpoint" function forces all CP/M-buffered blocks
; of a file onto disk and updates the disk directory.
fcheckpt AntDat
; To check the file, we don't need to "read" it in the sense
; of getting each record to a buffer of our own. The seek
; operation refills the filedef buffer to contain the sought
; data, so all we have to do is seek to every record. That
; will force re-reading all the disk sectors we wrote to.
fputstr screen,chkg
lxi d,0 ; record number in DE
; HL still has "f"
; BC still has S[f]
DPloop2:
mov a,b ! ora c ; while nrec > 0
jrz DPloop2z
call ANTND ; DE gets next record #
xchg ; move it to HL
frecseek AntDat,@H
xchg
dcx b
jmp DPloop2
DPloop2z:
fputline screen,done
DPdone:
pop h
pop d
pop b
pop psw
ret
end
H
;===============================================================
;
; ANTERA antname filename.typ
;
; Deletes selected members of anthology "antname." When the
; "filename.typ" operand is ambiguous, displays each matching
; member-name and requests confirmation.
;
; messages:
; FILENAME.TYP -- delete (y/n)?
; aborts from ANTSET, ANTOPE, ANTLOA, ANTMRK, ANTSAV
; usage message
; history:
; initial code 6 August 1984
; Copyright (C) 1985 M&T Publishing Co. all rights reserved
;===============================================================
maclib environ
extrn ANTSET ; set up operands
extrn ANTOPE ; open anthology files
extrn ANTLOA ; load directory
extrn ANTMRK ; mark matching files
extrn ANTNMK ; get next marked file
extrn ANTFRE ; delete a file's records
extrn ANTSAV ; save the directory.
common /ANTCOM/
; This common area definition is included in all, or most
; anthology programs. It defines the directory in storage.
; The filedefs are assembled in module ANTSUP.
AntHdr equ $ ; following words precede directory
SizeR ds 2 ; size of array R (128-multiple)
SpanR ds 2 ; # of 128-byte records over R
SizeF ds 2 ; size of array FS (ditto)
SpanF ds 2 ; # of 128-byte records over FS
AlFiles ds 2 ; count of allocated files
Frecs ds 2 ; count of free records
AntHdrLen equ $-AntHdr ; bytes written at head of file
Base ds 2 ; ->base of dir. (array R)
TopR ds 2 ; ->low free byte
BotF ds 2 ; ->bottom byte of FS
TopF ds 2 ; ->byte after directory
SizeDir equ 16384 ; in-core size of directory
FSsize equ 14 ; offset to size in FS entry
FSlen equ 16 ; size of an FS entry
AntDat ds FcrLen ; data file antname.ANT
AntDirX ds FcrLen ; directory copy antname.ANX
AntDirY ds FcrLen ; directory copy antname.ANY
AntSeq ds FcrLen ; sequential file in/out
cseg ; end of common
dseg
screen: confile
Ambig: db 0 ; set to '?' if we must prompt
query: strconst ' -- delete (y/n)? '
anslen equ 10 ; max answer allowed
answer: strspace anslen
nofile: strconst 'No matching files.'
usage:
db AsciiTAB,'ANTERA antname filename.typ'
db AsciiCR,AsciiLF
db 'Deletes member "filename.typ" from anthology "antname."'
db AsciiCR,AsciiLF
db 'If the second operand is ambiguous, each member that'
db AsciiCR,AsciiLF
db 'matches it is shown and you are asked to confirm its'
db AsciiCR,AsciiLF
db 'deletion. Reply Y to delete, anything else to leave it.'
db AsciiCR,AsciiLF,'$'
cseg
prolog
; Set up the anthology files for use, and find out how many
; command tokens there are. We require 2.
lxi d,usage
call ANTSET
cpi 2
abort nz,usage
; Get the directory open and ready for use.
call ANTOPE
call ANTLOA
; There is a difference between an explicit filename.typ that
; matches one member and an ambiguous one that just happens
; to match only one. ANTMRK doesn't tell us which happened,
; so we do a redundant fassign here just to find out if the
; operand is ambiguous.
tailtokn 2
xchg
lxi d,AntSeq
fassign @D,@H
xchg
sta Ambig ; = "?" if ambiguous
; Mark all the members of interest, returning the count in HL.
; If there are zero matches, say so and exit.
call ANTMRK
mov b,h ! mov c,l ; set up count in BC
mov a,b ! ora c ; is count zero?
jnz gotsome ; (no, proceed)
lxi d,screen
lxi h,nofile
fputline @D,@H
jmp done
; Delete all the marked members.
gotsome:
lhld TopF ; Scan from oldest down
loop:
call ANTNMK ; HL->next marked entry down
call confirm ; get confirmation if nec.
cz delete ; delete if permitted
dcx b ; count it
mov a,b ! ora c ; and if there are more,
jnz loop ; ..continue
; Update the directory to disk
call ANTSAV
done:
ret
; Confirm(HL->entry): Get confirmation from the user, if
; necessary, that this entry should be deleted.
confirm:
push b
push d
push h
lda ambig
cpi '?' ; was command ambiguous?
jrz askuser ; (yes, ask the question)
xra a ; no, no confirmation needed
jr confirmed
askuser:
lxi d,screen
fputstr @D,@H ; FILENAME.TYP
lxi h,query
fputstr @D,@H ; ...-- delete (y/n)?
lxi h,answer
mvi m,0 ; clear answer field
lxi b,anslen
fgetstr @D,@H,@B
mov a,m
toupper @A
cpi 'Y'
confirmed:
pop h
pop d
pop b
ret
; delete(HL->entry) Free this entry's records, make its name
; the null string, and decrement AlFiles.
delete:
call ANTFRE
mvi m,0
push h
lhld AlFiles
dcx h
shld AlFiles
pop h
ret
end
nd decrement AlFiles.
delete:
call ANTFRE
mvi m,0
push h
lhld AlFiles
dcx h; Copyright (C) 1985 M&T Publishing Co. all rights reserved
; HOWBIG: report the size of the transient program area to
; the console in decimal and hex -- and show off the
; numeric conversion function calls.
maclib environ
dseg
string strspace 40
msg1 strconst ' ('
msg2 strconst 'h) bytes of storage free'
user confile
cseg
prolog
lxi b,0 ; HL= space remaining after
space? @B ; allocation of zero bytes
lxi d,string ; DE->string area
strbwad @Dupdate,@H,0 ; "ddddd
strappnd @Dupdate,msg1 ; (
strbwax @Dupdate,@H ; xxxx
lxi h,msg2 ; ) bytes"
strappnd @Dupdate,@Hupdate
lxi d,user
lxi h,string
fputstr @D,@Hupdate
ret
end
x
lxi h,msg2 ; ) bytes"
strappnd @Dupdate,@Hupdate
lxi d,user
lxi h;===============================================================
; Copyright (C) 1985 M&T Publishing Co. all rights reserved
;
; SQASM infile outfile
;
; This utility reads infile (which ought to be an assembly
; source file) and deletes from it
; - all blank lines
; - all semicolon comment lines
; - all semicolon comments at ends of lines
; - all redundant whitespace
; and writes the remaining lines onto outfile.
;
; Such crude processing is intended for macro libraries like
; ENVIRON.LIB. Assembly time of a small program that uses
; ENVIRON is cut in half by applying sqasm to the macro library.
;
; This version is implemented using a finite-state automaton;
; it replaces a prior version that used spaghetti-jumps to do
; the same work.
;
maclib environ
extrn CHKOPS ; checks operands, gives usage msg
extrn OPENIN ; utility input open module
extrn OPENOU ; open output with default module
dseg
con confile ; for messages
infile filedef 1024 ; one-sector input buffer
outfile filedef 16384 ; huge output buffer for speed
usage:
db 'SQASM squashes assembly source files. Syntax is:'
db AsciiCR,AsciiLF
db AsciiTAB,'SQASM infile outfile'
db AsciiCR,AsciiLF
db 'The output contains the input but stripped of all blank,'
db AsciiCR,AsciiLF
db 'comment-only and null lines, and of all comments and'
db AsciiCR,ASciiLF
db 'extra blanks and tabs.'
db AsciiCR,AsciiLF
db '$'
cseg
prolog
; Save command tokens and check usage
mvi b,1 ; we can live with only "infile"
mvi c,2 ; but max tokens is 2.
lxi d,usage
call CHKOPS
; Assign, open input file
lxi d,infile ; file to assign
mvi a,1 ; operand token number
call OPENIN ; ..do it
; Assign, open output file
lxi b,infile ; default filespec here
lxi d,outfile ; file to assign
mvi a,2 ; operand token
call OPENOU ; ..do it
; Main loop: read bytes from infile and use them to drive the
; FSA. For FSA theory see any text on compiler design; for
; notes on this one, see below.
lxi h,S0 ; start in state 0
jmp A0 ; and start on action 0
; Action 4 is to write an exclamation mark, a blank, and
; then do action 1.
A4: lxi d,outfile
mvi a,'!'
fputchar @D,@A
mvi a,' '
fputchar @D,@A
jmp A1
; Action 3 is to write an exclamation mark then do Action 1
A3: lxi d,outfile
mvi a,'!'
fputchar @D,@A
jmp A1
; Action 2 is to write a blank then do Action 1
A2: lxi d,outfile
mvi a,' '
fputchar @D,@A
jmp A1
; Action 1 is to write the current character and do Action 0
A1: lxi d,outfile
mov a,b
fputchar @D,@A
jmp A0
; Action 0 is to get the next input byte and cycle the FSA
A0: lxi d,infile
fgetchar @D
jrz endfile ; (quit on eof)
mov b,a ; save copy of input char for A1
xchg ; save current state in DE
lxi h,class ; base of class table
ani 07fh ; clear hi bit of input char if on
addhla ; hl->class[char]
mov a,m ; a := class[char]
xchg ; hl->state
addhla ; hl->state[class]
mov e,m ! inx h ! mov d,m ! inx h ; DE=action
push d ; save ->next action on stack
mov e,m ! inx h ! mov d,m ; DE = next state
xchg ; HL = new state
ret ; go do action A0/1/2/3
endfile:
fclose outfile
ret
dseg
; The class-table is used to classify input bytes into one of
; six classes:
; 0 = characters not otherwise classified
; 1 = the TAB and the BLANK
; 2 = the apostrophe (single quote)
; 3 = the semicolon
; 4 = the exclamation mark (rmac statement delimiter)
; 5 = the CR that ends a line
; class numbers are multiplied by 4 to index the 4-byte
; entries of the FSA matrix.
class:
rept 8 ; 8 times
dw 0,0,0,0,0,0,0,0 ; 16 bytes of 0 = 128 0's
endm
zclass equ $
org class + AsciiTAB
db 1*4
org class + AsciiBlank
db 1*4
org class + ''''
db 2*4
org class + ';'
db 3*4
org class + '!'
db 4*4
org class + AsciiCR
db 4*5
org zclass
; The FSA matrix defines an array with 7 rows which are called
; "states." The automaton is always "in" a particular "state,"
; i.e. at A0, HL always points to some row.
; What the rows contain are six, 4-byte entries. Each contains
; the address of an action, A3/2/1/0, and the address of a new
; state (row). To operate the FSA means, to index the current
; state by the class of the current input character, do the
; action named in that entry, and move to the new state named
; in that entry. That's all there is to it.
S0:
; State 0 is the initial state for any physical line. Here we
; delect null and comment-only lines.
dw A1,S2 ; other: copy byte, go to S2
dw A0,S0A ; blank: ignore, go to S0A
dw A1,S4 ; quote: copy, go to S4
dw A0,S0C ; semic: ignore, to S0C
dw A0,S0 ; exclm: ignore, stay here
dw A0,S0 ; CR: ignore, stay here
S0A:
; State 0A is for lines that begin with white-space. They may
; yet prove to be comment-only or all-blank, but if a token
; starts, we want to begin it with one blank.
dw A2,S2 ; other: copy blank+byte, S2
dw A0,S0A ; blank: ignore, stay here
dw A2,S4 ; quote: copy blank+quote, S4
dw A0,S0C ; semic: ignore, S0C
dw A0,S0 ; exclm: ignore, restart line
dw A0,S0 ; CR: ignore, restart line
S0C:
; State 0C is entered for a comment that heads a physical
; line or is preceded only by spaces. Just toss everything
; to a statement boundary.
dw A0,S0C ; other: skip, stay here
dw A0,S0C ; blank: skip, stay here
dw A0,S0C ; quote: skip, stay here
dw A0,S0C ; semic: skip, stay here
dw A0,S0 ; exclm: skip, leave comment state
dw A0,S0 ; CR: skip, S0
S1:
; State 1 is the opening of a new logical statement, from seeing
; an exclam after copying some output. The exclam has NOT been
; copied yet -- if it is followed by useful data we generate it
; with A3.
dw A3,S2 ; other: copy exclam+byte, S2
dw A0,S1A ; blank: ignore, S1A
dw A3,S4 ; quote: copy exclam+quote, S4
dw A0,S5 ; semic: ignore, S5
dw A0,S1 ; exclm: ignore, stay here
dw A1,S0 ; CR: copy it, S0
S1A:
; State 1A, like 0A, remembers that this logical statement
; began with a blank.
dw A4,S2 ; other: copy exclam+blank+byte, S2
dw A0,S1A ; blank: ignore, stay here
dw A4,S4 ; quote: exclam+blank+quote,S4
dw A0,S5 ; semic: ignore, S5
dw A0,S1 ; exclm: ignore, S1 again
dw A1,S0 ; CR: copy it, S0
S2:
; State 2 is entered for any useful assembly token other than
; a quoted string. Stay in it, copying "other" bytes, to the
; next delimiter.
dw A1,S2 ; other: copy, stay here
dw A0,S3 ; blank: ignore, S3
dw A1,S4 ; quote: copy, S4
dw A0,S5 ; semic: ignore, S5
dw A0,S1 ; exclm: ignore, S1
dw A1,S0 ; CR: copy, S0
S3:
; State 3 is entered when a blank/tab follows any useful token.
; The blank has NOT been copied yet, and won't be unless we
; find another token. Then we'll use A2 to generate it.
dw A2,S2 ; other: blank+byte, S2
dw A0,S3 ; blank: ignore, stay here
dw A2,S4 ; quote: blank+quote, S4
dw A0,S5 ; semic: ignore, S5
dw A0,S1 ; exclm: ignore, S1
dw A1,S0 ; CR: copy, S0
S4:
; State 4 is where we process tokens that are quoted strings.
; Since we don't have to interpret them, we can treat double
; quotes ('x''y') as multiple quote strings ('x' and 'y').
dw A1,S4 ; other: copy, stay here
dw A1,S4 ; blank: copy, stay here
dw A1,S2 ; quote: copy, go to S2
dw A1,S4 ; semic: copy, stay here
dw A1,S4 ; exclm: copy, stay here
dw A1,S0 ; CR: copy, S0 (bad rmac syntax)
S5:
; State 5 is entered for a comment that follows useful tokens.
; There differences from S0C are that, since some output has
; been produced, a CR has to be copied and an exclam should
; send us to S1 not S0.
dw A0,S5 ; other: skip, stay here
dw A0,S5 ; blank: skip, stay here
dw A0,S5 ; quote: skip, stay here
dw A0,S5 ; semic: skip, stay here
dw A0,S1 ; exclm: skip, S1
dw A1,S0 ; CR: copy, S0
end
5 ; quote: skip, stay here
dw A0,S5 ; semic: skip, stay here