Oakland CPM Archive

home *** CD-ROM | disk | FTP | other *** search

/ Oakland CPM Archive / oakcpm.iso / cpm / tdossigi / typel.mqc / TYPEL.MAC

Wrap

Text File | 1986-07-05 | 15.0 KB | 699 lines

.comment \ TYPEL.MAC v3.5 (c) 1984 ESKAY Software Services 7120 Skillman #2104 Dallas, TX 75231 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