Oakland CPM Archive

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

/ Oakland CPM Archive / oakcpm.iso / cpm / arc-lbr / typel36.lbr / TYPEL36.MQC / TYPEL36.MAC

Wrap

Text File | 1985-02-10 | 14.9 KB | 730 lines

.comment \ TYPEL.MAC v3.6 (c) 1984,1985 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: 01/01/85 Added page eject for $L mode, minor changes 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 ... 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 LOUT ;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 FF EQU 12 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+'P'-40H ;highest accessible drive + 1 (A=2) MAXUSR: DB 1+31 ;highest accessible user + 1 MAXLIN: DB 0 ;number of lines to print max (0=all) MAXLPS: DB 23 ;max lines per screen -1 (0= no page) LSTEN: DB 1 ;zero=list disable, nz=list enable SYSEN: DB 1 ;zero=no sys files, nz=sys files ok EJECTP: DB 56 ;eject page after EJECTP lines in $L mode ; ; refuse to type these file types ; (note that type check is done after USQ so no need to ; check for .CQM etc) ; NOTYP: 'COM' 'OBJ' ;renamed COM 'LBR' ;library 'OV?' ;OVR,OVL,OV1,OV2 etc 'ARC' ;archive file ; 'DIR' ;archive directory 'BAD' ;locked out bad spot 'SYS' ;system file '??#' ;specially marked file (USERS.TX# etc) ; 'LOG' ;log file 'INT' ;intermediate file (CBASIC etc) 'REL' ;relocatable object file '?RL' ;PRL, CRL, IRL ; 'CMD' ;hard to say... (dbase ok, cp/m86 no-go) 'EXE' ;executable MSDOS file, renamed COMs DB 0 ;end of table DS 9*3 ;room for 9 more types ; SKIPC: LXI H,0 ;save CP/M stack pointer DAD SP SHLD STACK LXI SP,STACK ;set up local stack CALL PRINT 'TYPEL v3.60 (c) ESKAY 01-01-85',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 LSTOT ; NA: XRA A STA MAXLPS ;non paging ; EXARG: LDA LSTEN ORA A JNZ SK1 STA LSTOT ; 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 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 CR,LF,'* ',0 MVI A,1 STA SINGFL CALL BBLINE CALL PRINT 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 EJECTP ;max # of lines in $L mode STA EJECT 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 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 CR,LF '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 ')',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 '[more]',CR,0 CALL CIN CPI 'C'-40H JZ EREXT CALL PRINT ' ',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 CR,LF 'TYPEL aborted - maximum number of lines exceeded.',CR,LF 'Please use XMODEM to transfer file to your system.' 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 CR,LF '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 CR,LF 'Can''t type a .',0 MVI B,3 ; TCL: MOV A,M INX H CALL CCOUT DCR B JNZ TCL CALL PRINT ' 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 CR,LF 'Drive/user out of bounds',CR,LF,0 JMP EREXT ; NOFILE: CALL PRINT CR,LF '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 LSTOT ORA A MOV A,B JNZ COT CALL CCOUT POP B RET ; COT: CALL LOUT ;output to list device CPI LF ;if not linefeed... JNZ ..CTE ;...then exit list out routine MVI A,0FFH STA TAB LDA EJECTP ORA A ;if no page length... JZ ..CTE ;...then do not paginate LDA EJECT ;get current line count DCR A ;decrement it STA EJECT ;store count back JNZ ..CTE ;continue if end of page not reached LDA EJECTP ;get line count for one page STA EJECT ;reset counter MVI A,FF ;get a form feed CALL LOUT ;kick a page ; ..CTE: POP B RET ; NOLBR: CALL PRINT CR,LF 'LBR directory may be damaged - aborting',CR,LF,0 JMP EREXT ; NOMEM: CALL PRINT CR,LF 'No member file name specified.',CR,LF,0 JMP WHAT ; NULLEN: CALL PRINT CR,LF 'Member file is 0k - cannot type.',CR,LF,0 JMP EREXT ; RDERR: CALL PRINT CR,LF 'Cannot read file',CR,LF,0 JMP EREXT ; NOAMB: CALL PRINT CR,LF 'No ambiguous file names allowed',CR,LF,0 ; WHAT: CALL PRINT CR,LF 'TYPEL v3.60 universal single-file lister',CR,LF 'Usage:',CR,LF 9,'TYPEL [du:]fn[.ft] [fn.ft]',CR,LF 'Examples:',CR,LF 9,'TYPEL MDM722 MDM722.IQF types member file in LBR',CR,LF 9,'TYPEL TEST.AQM types normal file',CR,LF 9,'TYPEL F4:TEST.BQS accepts ZCPR drive/user',CR,LF 9,'TYPEL FOO.ASM $N $N option=not paging',CR,LF 9,'TYPEL BAR.ZOT $L $L option=LST: device',CR,LF 'If 1 argument is supplied, single file is typed.',CR,LF 'If 2 arguments, TYPEL assumes first arg is type LBR',CR,LF 'and attempts to type LBR member.',CR,LF 9,'Typing TYPEL without argument starts interactive mode.' CR,LF,'You can enter individual filenames or RETURN to stop.' CR,LF,LF,0 ; EREXT: CALL GETUD ;restore default DU LDA SINGFL ORA A JNZ LOOP ; FINISH: LHLD STACK SPHL RET ; SINGFL: DB 0 ;0=single files, 1=prompted LSTOT: 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 EJECT: DB 0 ;line count in $L 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