NOTE:
=====
If you feel the urge to "improve" this program,
PLEASE, call the SENECA RCPM first to see if there
is a later version. THEN send me your update.
Created from the LDIR code in LDIR12, LTYPE17, SYSLIB routines, and,
of course, thanks to Dave Rand for the USQ baseline code.
Revision history:
08/19/84 Rewrote USQB, added prompted mode
07/21/84 Allowed type of $SYS files, adapted for SYSLIB3
07/07/84 Fixed bug introduced in 3.2
05/23/84 Fixed problem with end-of-file detection
05/06/84 Added $L argument option
04/14/84 General cleanup, added $N argument option
02/15/84 Fixed problem in lbr member filename scanner
02/13/84 Single file mode skipped logging - could only
type files in default drive/user.
02/12/84 MAJOR REVISION AND NAME CHANGE v2.00
Program now called TYPEL. It is now able to type
(almost) any single file. See doc for more info
01/25/84 Added display of original file name if squeezed.
01/20/84 Made M80/L80 compatible, changed drive/user code
to allow use in restricted area if already logged.
Added page mode.
01/06/84 Rewrote part of LTYPE to allow reconfig without
reassembly, other minor mods. SFK
12/09/83 Fixed ^C bug (problem with CONDIN when remote active)
also fixed problem with 0-length files. SFK
12/09/83 Added code to save/restore default drive/user SFK.
11/29/83 Made ^C and ^S checks more frequent to fix a problem
which sometimes caused it to ignore ^C. SFK
11/24/83 Strips bit 7, made MAXLIN a DB at 101H
11/20/83 Initially written.
For further info and reassembly instructions read the DOC file!
\
8080
;
EXTRN BBLINE ;SYSLIB line input
EXTRN CCOUT ;SYSLIB character out (convert ctl chars)
EXTRN CLOUT ;SYSLIB list char out
EXTRN COMPB ;SYSLIB compare .DE-.HL
EXTRN CIN ;SYSLIB character in
EXTRN DIVHD ;SYSLIB HL DIV DE
EXTRN F$OPEN ;SYSLIB open file
EXTRN F$READ ;SYSLIB file read
EXTRN BDOS ;SYSLIB BDOS call
EXTRN FNAME ;SYSLIB file name parser
EXTRN PUTUD ;SYSLIB save current DU
EXTRN GETUD ;SYSLIB restore default DU
EXTRN LOGUD ;SYSLIB log drive/user
EXTRN PRINT ;SYSLIB print routine
EXTRN PSTR ;SYSLIB print <HL>
EXTRN R$READ ;SYSLIB random read
EXTRN RETUD ;SYSLIB return drive/user
;
EXTRN USQ ;Baseline USQ code
EXTRN UINIT ;USQ init code
PUBLIC FCB
PUBLIC BUFF ;start of buffer
PUBLIC TOPRAM ;end of buffer location
PUBLIC EREXT ;error intercept from USQ
PUBLIC TABLE ;1032 bytes
PUBLIC BUFULL ;buffer full (print) routine
;
request usqb,syslib ;take the workload off the user
;
cr equ 0dh
lf equ 0ah
argch equ '$' ;option delimiter
;
bufsz equ 1 ;buffer size in K bytes
dbuf equ 80h ;default buffer
dfcb equ 5ch ;default fcb
;
begin: jmp skipc
maxdrv: db 1+'B'-40H ;highest accessible drive + 1 (A=2)
maxusr: db 1+30 ;highest accessible user + 1
maxlin: db 80 ;number of lines to print max (0=all)
maxlps: db 23 ;max lines per screen -1 (0= no page)
lsten: db 0 ;zero=list disable, nz=list enable
sysen: db 0 ;zero=no sys files, nz=sys files ok
;
; refuse to type these file types
; (note that type check is done after USQ so no need to
; check for .CQM etc)
;
notyp: db 'COM'
db 'OBJ' ;renamed COM
db 'LBR' ;library
db 'OV?' ;OVR,OVL,OV1,OV2 etc
db 'ARC' ;archive file
; db 'DIR' ;archive directory
db 'BAD' ;locked out bad spot
; db 'SYS' ;system file
db '??#' ;specially marked file (USERS.TX# etc)
; db 'LOG' ;log file
db 'INT' ;intermediate file (CBASIC etc)
db 'REL' ;relocatable object file
db '?RL' ;PRL, CRL, IRL
; db 'CMD' ;hard to say... (dbase ok, cp/m86 no-go)
db 'EXE' ;executable MSDOS file, renamed COMs
db 0 ;end of table
ds 9*3 ;room for 9 more types
;
skipc: lxi sp,stack ;set up local stack
call print
db 'TYPEL v3.49 (c) ESKAY 10-07-84',cr,lf,0
lxi h,dbuf ;point to buffer
mov b,m ;char count to b
inr b
arglp: dcr b
jz sk1
inx h
mov a,m
cpi argch ;check for option delimiter
jnz arglp
dcx h
mov a,m
inx h
cpi ' ' ;option must come after a blank
jnz arglp
dcx h
mvi m,0 ;remove option
inx h
inx h ;point to arg
mov a,m
cpi 'N' ;N=nopage
mvi m,0
jz na
cpi 'L'
jnz exarg
sta lout
na: xra a
sta maxlps ;non paging
exarg: lda lsten
ora a
jnz sk1
sta lout
sk1: call putud ;save default DU
lxi d,bufsz*1024 ;compute...
lxi h,buff ;...buffer size
dad d ;for disk read
mov a,h
sta topram
call retud ;get current drive/user
mov a,c
ora a
jz no00
mov h,b
mov l,c
shld userno ;save current DU
lda dfcb+1 ;check if no file name specified
cpi ' '
jnz single
loop: call print
db cr,lf,'* ',0
mvi a,1
sta singfl
call bbline
call print
db cr,lf,lf,0
ora a
jz finish
lxi sp,stack
jmp nextfl
;
stlin: lda maxlin ;max number of lines displayed
sta maxls
sta maxls1
lda maxlps
ora a
jz mls
dcr a ;first page is one less than normal
mls: sta lps
ret
;
single: lxi h,dbuf+2 ;point to argument
nextfl: lxi d,fcb
call stlin
call fname ;parse file name
jz what ;not a valid file name
mov a,m ;get delimiter
sta fflag ;set flag LBR/non-LBR
push h ;save command line ptr
inx b ;check if current DU:
mov a,b
ora c
dcx b ;restore DU: value
jz currdu ;skip this if current
call print
db cr,lf,lf
db 'Can only display current drive/user!',cr,lf,lf,0
rst 0
mov a,b ;get specified drive
dcr b ;get into range 0..f
cpi 0ffh ;ff means current drive
lxi h,maxdrv
jnz newdsk ;skip if different
lda driveno
mov b,a
jmp curdsk
;
newdsk: cmp m
jnc illdu ;yes - complain
curdsk: mov a,c ;get specified user area
cpi '?' ;all user areas???
jz illdu ;yes - complain
cpi 0ffh ;current user area?
jnz newusr
lda userno
mov c,a
jmp curusr
;
newusr: inx h ;illegal user specified?
cmp m
jnc illdu ;yes - complain
curusr: call logud ;log into specified DU:
currdu: lda fflag ;get flag
cpi ' ' ;LBR member request?
pop h ;get cmd line ptr back
jnz nolbf ;nope, must be singlefile
inx h ;get next char
lxi d,memfcb ;point to member fcb
call fname ;parse member name
lxi h,fcb+1
call ckamb ;check ambiguity
lxi h,memfcb+1
call ckamb
lxi h,FCB+9 ;default to .LBR
mvi m,'L'
inx h
mvi m,'B'
inx h
mvi m,'R'
lxi d,fcb
call f$open ;attempt to open file
jnz nofile ;not a LBR file
xra a
sta dirs ;set directory check size to 0
lda sysen ;if $SYS suppress
ora a ;then...
cz sysck ;check for $sys bit
xra a
sta lin ;set line count to 0
lxi h,memfcb+9 ;point to member type
call typck ;check valid type
call f$read ;read directory into default buffer
jnz rderr
lxi h,dbuf ;point to dbuf
lxi d,dirname ;point to 8 blanks
call cpfn ;compare
jnz nolbr ;not equal
lxi d,14
dad d
mov a,m
sta dirsiz ;directory size
xra a
sta memfcb
jmp c00 ;skip into directory check
;
dirlp: lxi d,fcb
call f$read
jnz rderr
c00: lxi b,20h
lxi h,dbuf
lxi d,memfcb
call cpfn
jz found
dad b
call cpfn
jz found
dad b
call cpfn
jz found
dad b
call cpfn
jz found
lda dirs
inr a
sta dirs
mov b,a
lda dirsiz
cmp b
jnz dirlp
call print
db cr,lf
db 'Member file not found in LBR directory',cr,lf,0
jmp erext
;
; Found the member file name in the LDIR
;
found: lxi d,12
dad d
push h ;save pointer for now,
inx h ;point to size
inx h
mov a,m ;get low byte
inx h
ora m ;if a=0 then file is 0k
jz nullen ;go complain
pop h ;get pointer back
mov a,m ;get file address
inx h
mov h,m
mov l,a
;
; enter here from non-LBR routine with HL=0000
;
dotyp: lxi d,fcb ;get fcb...
call r$read ;...and read random
jnz rderr
lxi b,dbuf ;point to buffer
ldax b ;get first byte
cpi 76h ;if not 76H (=not squeezed)...
jnz plain ;...then process as text
inx b ;point to and...
ldax b ;...get next byte
cpi 0ffh ;if FF then squeezed..
jnz plain ;...else plain text (?)
call uinit
lxi h,dbuf+4 ;point to original name
call chktp ;check it's type
mvi a,'(' ;print the original name...
call ccout ;...in parentheses
lxi h,dbuf+4
call pstr
call print
db ')',cr,lf,0
call usq ;now unsqueeze and print
jmp goteof
;
; This routine fills the buffer then calls the print routine
;
plain: lxi d,fcb
lxi b,dbuf ;default buffer
fnext: lxi h,buff
rdlp: call f$read ;changed to properly detect eof...
jnz goteof ;...in unsqueezed single files
mlp: ldax b
mov m,a
inx h
inr c
jnz mlp
mvi c,80h
lda topram
cmp h
jnz rdlp
call bufull ;print buffer contents
jmp fnext
;
goteof: call bufull
jmp erext
;
; This is the print buffer routine (BUFULL)
;
bufull: push h
push d
push b
push psw
lxi h,buff
buflp: mov a,m
cpi 1ah
jz erext
cpi 'I'-40h
jz proctab
ani 7fh ;strip high bits
call putchr
cpi lf
jz eoln
call condin ;get keybd char if available
jz goon ;none there, go on
cpi 'C'-40h ;if ^C...
jz erext ;...then finished
cpi 'S'-40h ;if not ^S...
jnz goon ;...then go on, else...
call cin ;...wait for keypress
cpi 'C'-40h
jz erext
jmp goon
;
; This is NOT the SYSLIB routine by same name...
;
condin: push h
push d
push b
mvi c,6
mvi e,0ffh
call bdos
ora a
pop b
pop d
pop h
ret
;
eoln: mvi a,0ffh ;reset tab counter
sta tab
lda maxlps ;get max lines per screen
ora a
jz nopag ;skip if no page mode
lda lps
dcr a
sta lps
jnz nopag
call print
db '[more]',cr,0
call cin
cpi 'C'-40h
jz erext
call print
db ' ',cr,0
lda maxlps
sta lps
nopag: mvi a,0 ;filled by program
maxls equ $-1 ;if maxln=0...
ora a
jz goon ;..then skip line counter
lda lin ;else increment...
inr a
sta lin ;...the line counter
cpi 0 ;see if maxlin reached
maxls1 equ $-1
jnz goon ;no, continue
call print ;else abort with message
db cr,lf
db 'TYPEL aborted - maximum number of lines exceeded.',cr,lf
db 'Please use XMODEM to transfer file to your system.'
db cr,lf,lf,0
jmp erext
;
proctab:lda tab ;get current tab value
mov b,a ;save current
ani 0f8h ;round down to last full 8
adi 8 ;make next tab stop
tablp: call spout ;put space
inr b ;continue spaces to..
cmp b ;...next tab stop
jnz tablp
sta tab ;save next tab stop
jmp go1
;
; Print a space
;
spout: push psw
mvi a,' '
call putchr
pop psw
ret
;
goon: lda tab ;increment...
inr a
sta tab ;...tab counter
go1: inx h ;increment buffer pointer
lda topram ;get top of ram
cmp h ;if not yet reached...
jnz buflp ;...then get next char
pop psw ;else return to caller...
pop b ;...to get more
pop d
pop h
ret
;
; process non-LBR file
;
nolbf: lxi h,fcb+1
call ckamb
lxi h,fcb+9 ;point to type
call typck ;check valid type
lxi d,fcb
call f$open ;open the file
jnz nofile ;not found...
lda sysen
ora a
cz sysck ;$sys file?
call f$read ;read first sector
lxi h,0
jz dotyp ;type it now...
call print
db cr,lf
db 'Unable to type - empty file?',cr,lf,0
jmp erext
;
; check type of squeezed file (HL=original fn)
;
chktp: push b
mvi b,9 ;9 char max
chkt1: mov a,m
inx h
cpi '.' ;end of fn?
jz typck1
dcr b
jnz chkt1
pop b
ret
;
; check file type at <HL> against table
; PSW, HL munched, ret only if ok
;
typck: push b
typck1: push d
push h
lxi d,notyp ;point to no-type table
tck1: pop h
push h
mvi b,3 ;3 chars to compare
tck2: ldax d
ora a ;if end of table...
jz typok ;...then return
cpi '?' ;ambiguous?
jz tck3 ;yes, skip
cmp m ;if no match...
jnz tck4 ;...then skip to next table entry
inx h
inx d
dcr b
jnz tck2 ;loop until all 3 match
pop h
pop d
pop b
jmp tckno ;not ok to type
;
; skip next character in table and filetype
;
tck3: inx h
inx d
dcr b
jnz tck2
jmp tck1
;
; skip to next table entry
;
tck4: inx d
dcr b
jnz tck4
jmp tck1
;
; restore registers and return (ok to type)
;
typok: pop h
pop d
pop b
ret
;
; complain and abort (type found in table)
;
tckno: call print
db cr,lf
db 'Can''t type a .',0
mvi b,3
tcl: mov a,m
inx h
call ccout
dcr b
jnz tcl
call print
db ' file!',cr,lf,0
jmp erext
;
; check if DE+10 has bit 7 set ($SYS file)
;
sysck: push h ;save HL
lxi h,10
dad d
mov a,m
pop h
ani 80h
rz
jmp nofile ;pretend not there
;
; Here are the messages
;
illdu: call print
db cr,lf
db 'Drive/user out of bounds',cr,lf,0
jmp erext
;
nofile: call print
db cr,lf
db 'No such file on disk',cr,lf,0
jmp erext
;
cpfn: push h
push d
push b
mvi b,12 ;12 characters
call compb
pop b
pop d
pop h
ret
;
ckamb: mvi a,'?' ;see if there is any...
mvi e,11 ;...ambiguity in the file spec
ckamlp: cmp m
jz noamb ;complain if ambiguous fn
inx h
dcr e
jnz ckamlp
ret
;
putchr: push b
mov b,a
lda lout
ora a
mov a,b
jnz cot
call ccout
pop b
ret
;
cot: call clout
pop b
ret
;
nolbr: call print
db cr,lf
db 'LBR directory may be damaged - aborting',cr,lf,0
jmp erext
;
nomem: call print
db cr,lf
db 'No member file name specified.',cr,lf,0
jmp what
;
nullen: call print
db cr,lf
db 'Member file is 0k - cannot type.',cr,lf,0
jmp erext
;
rderr: call print
db cr,lf
db 'Cannot read file',cr,lf,0
jmp erext
;
no00: call print
db cr,lf,lf,7
db 'ERROR - cannot use in users 0 and 31!',cr,lf,0
rst 0
;
noamb: call print
db cr,lf
db 'No ambiguous file names allowed',cr,lf,0
what: call print
db cr,lf
db 'TYPEL v3.5 universal single-file lister',cr,lf
db 'Usage:',cr,lf
db 9,'TYPEL [du:]fn[.ft] [fn.ft]',cr,lf
db 'Examples:',cr,lf
db 9,'TYPEL MDM722 MDM722.IQF types member file in LBR',cr,lf
db 9,'TYPEL TEST.AQM types normal file',cr,lf
db 9,'TYPEL F4:TEST.BQS accepts ZCPR drive/user',cr,lf
db 9,'TYPEL FOO.ASM $N $N option=not paging',cr,lf
db 9,'TYPEL BAR.ZOT $L $L option=LST: device',cr,lf
db 'If 1 argument is supplied, single file is typed.',cr,lf
db 'If 2 arguments, TYPEL assumes first arg is type LBR',cr,lf
db 'and attempts to type LBR member.',cr,lf
db 9,'Typing TYPEL without argument starts interactive mode.'
db cr,lf,'You can enter individual filenames or RETURN to stop.'
db cr,lf,lf,0
erext: call getud ;restore default DU
lda singfl
ora a
jnz loop
finish: rst 0
;
singfl: db 0 ;0=single files, 1=prompted
lout: db 0 ;flag for list out
fflag: db 0 ;flag for LBR/non-LBR
topram: db 0 ;hi byte of buffer end
dirs: db 0 ;# of dir sectors processed
dirsiz: db 0 ;# of total dir sectors
tab: db 0 ;current line tab
lin: db 0 ;line count
lps: db 0 ;line count for page mode
userno: db 0 ;current user #
driveno:db 0 ;current drive
fcb: ds 36 ;out fcb
memfcb: ds 12
ds 50 ;25 level stack
stack: dw 0 ;save CP/M stack pointer here
dirname:db 0,' '
buff equ 2000h ;start buffer
table equ buff-1048 ;usq table
end
option=LST: device',cr,lf
db 'If 1 argument is supplied, single file is typ
