; NOTE: This is a copyrighted program released for private, ; non-commercial use ONLY. Please read copyright statement ; starting on line number 44 for details. ; Program: LPUT ; Author: Bruce Morgen ; Version: 1.0 ; Date: November 25, 1986 ;LPUT.Z80 11/25/86 ; The godfather of LPUT is Nick DeWolf, inventor of the ; remarkable ON! Computer - probably the finest Z80-based ; personal computer ever made. Nick suggested that users ; who were not computer enthusiasts would never use LBR ; files because existing LBR utilities like LU and NULU ; made the process of creating LBRs and filling them with ; member files too intimidating for non-techies. Thanks ; for the inspiration, Nick. I hope users of the ON! and ; other Z-System compatible computers enjoy the program. ; ; ON! Systems, Inc., manufacturers of the ON! system, has ; done more to foster the creation of quality utility ; software then any other hardware vendor in recent memory. ; Their product is superb and deserves the support of the ; user community. For more information about the ON!, ; call Bill Elliot at 312-680-4680. ; ; Please direct communications about LPUT itself to me: ; ; Bruce Morgen ; North American One-Eighty Group ; P.O. Box 2781 ; Warminster, PA 18974 ; ; Voice phone: ; 215-443-9031 (East Coast business hours ONLY!) ; ; Electronic mail: ; Lillipute Z-Nodes (312-649-1730, 312-664-1730) ; Drexel Hill NorthStar (215-623-4040) ;_______________________________________________________________ ; ; LPUT is copyright 1986 by the author. It is released to ; the user community in source and object form for non- ; commercial use only. Permission is hereby given to use ; and/or modify it in any way that you see fit. The author ; retains exclusive rights to public release of LPUT and ; asks that any improvements to the program or adaptations ; for other operating environments not be distributed in ; any way without his consent. Furthermore, any commercial ; use of LPUT without the express written agreement of the ; author is specifically prohibited. This prohibition ; includes sale of the program in any form except as part ; a user group library disk selling for not more than $20 ; copying and handling fee or as a download offering on ; remote access systems with no fee charged beyond normal ; subscription and/or access rates. LPUT may not be sold ; or licensed by any person other than the author or his ; authorized agent(s). As of August 19, 1987, the only ; such agent is ON! Systems, Inc., Libertyville, IL, USA. ; The author warrants that LPUT comprises his original ; work and as such is protected by the copyright laws of ; The United States of America and applicable international ; copyright regulations. No other warranty is expressed or ; implied. ; ; (signed) Bruce Morgen August 19, 1987 ;________________________________________________________________ ; ; Version 2.0 April 6, 1991 by Howard Goldstein ; Fixed a bug introduced in the previous version which was causing ; garbage to be placed in the date and time fields of the LBR's ; Also, the check for an imbedded stamp is now done before the check ; for a DOS date stamper. Thus, imbedded stamps are stored in the ; directory even on systems without a stamper. ; ; Version 1.9 March 22, 1991 by Howard Goldstein (beta version) ; There are two significant changes in this version. First, LPUT now ; stores files' create and modify time in the library directory. Second, ; as in LBREXT and NULU, an input filespec of dir: defaults to dir:*.*. ; Again as in LBREXT, .typ is equivalent to *.typ, and : is *.* in the ; default directory. I have also made a few trivial internal changes, ; fixing a couple of potential problems and taking advantage of new SYSLIB ; divide routines. ; Thanks to Gene Pizzetta for providing me with the basis for the time ; conversion code. ; ; Version 1.8 November 15, 1989 by Howard Goldstein ; This version fixes a bug introduced in version 1.7. The bug ; was causing LPUT to create totally corrupt LBR's under Z3PLUS. The ; problem was in the DATER routine. Looking toward the future, I also ; made a small change that will allow LPUT to pick up imbedded date ; stamps from LZH encoded files. ; ; Version 1.7 September 26, 1989 by Howard Goldstein ; The major change in this version was to incorporate the new DSLIB ; routines that allow it to pick up member files' datestamps directly ; from ZSDOS. This also fixes a bug that showed up under ZSDOS: ; Sometimes a member file's "modified" stamp would be updated as it ; was being added to the LBR. I did a bit of crunching to keep the ; code under 6k. The major change in this regard was to eliminate ; SYSLIB's FILLB and use a much shorter inline routine. ; The program was linked with the Version 4 libraries. SYSLIB ; now contains Bruce's table-driven CRC routines so the separate REL ; file is no longer included. LINKAGE ORDER IS: ; WILDEX, MYSORT, UNDATE, DSLIB, Z3LIB, SYSLIB. ; ; Version 1.6B September 27, 1988 by Bruce Morgen ; Retaining Michal's excellent work with modify dating, I put in ; some code to allow a trailing parameter of "+nn" to leave "nn" ; extra LBR directory entries beyond what is required for the ; member file list. This parameter is ignored if the target LBR ; already exists or if a "/nn" occurs first in the command tail. ; Following the laudable trend instigated by Howard "Mr. Beta" ; Goldstein, LPUT now uses the Z33/Z34 CCP parser whenever it's ; available. ; ; Version 1.6 August 27, 1988 by Michal Carson ; A very few adjustments to store last mod date in library ; directory along with cre date. After Creation date is ; evaluated and stored, Modification date is moved into the labels ; accessed by @UDCVT, evaluated and stored. This means that the ; mod date will be displayed. ; Version 1.5A March 29, 1988 by Bruce Morgen ; Fixed problem with null dates and midnights in CR23ed files ; creating anamolous LBR date values. Jay Sage has suggested ; that the DS Modify date is really more authentic than the ; Create date for LBR use, supplied LPUTMOD.HEX to implement ; that preference - however, be aware that LBREXT26 will make ; the LBR date the Create date on extraction. ; Version 1.5 March 16, 1988 by Bruce Morgen ; Full DateStamper support, including imbedded dates in ; CRUNCH23Ded files, plus a few minor tweaks. Reverted to ; old Type 1 format as a high org would screw up performance ; badly due to constricted buffer space. ; Version 1.4 June 28, 1987 by Bruce Morgen ; Fully-buffered file input, more random reads to survive ; ZRDOS 1.7 and later peculiarities, no more attribits in ; LBR directory entries, WILDEX lists now sorted via Sigi's ; (modified, of course) MYSORT. LPUT will now create a new ; LBR with the correct size directory if the specified one ; does not exist. Moreover, the special syntax: ; LPUT newlbr /nn ; where xx is a number will create a beautiful but entirely ; empty LBR with nn entries. Added NEWLBR flag to minimize ; calling the CLEAN routine. SYSLIB CRC routines discarded ; in favor of a look-up table ala' DISK7, CHEK15, PPIP, etc. ; Thanks to Irv Hoff for pointing out the speed advantage of ; that approach. This is the ON! Systems release version. ; (Tweak tweak, fiddle fiddle, faster faster....) ; Version 1.3 May 29, 1987 by Bruce Morgen ; Handles file lists just like LGET. Really, it does... ; Version 1.2 May 28, 1987 by Bruce Morgen ; Updated to ZCPR33/BGii Type 3 format. Coded internal PRNDU ; routine calling SYSLIB, deleted FENV call and external, use ; DSEG for new LIBs, Z80fy and DSEGify WILDEX module, put in ; in-line code to avoid the LBR eating itself as a member. FALSE EQU 0 TRUE EQU NOT FALSE M80 EQU FALSE ; Using Microsoft Macro 80 ; Assembler? Otherwise false. FCB EQU 05CH ; Default file control block FCB2 EQU 06CH ; The other one TBUFF EQU 080H ; Default DMA buffer CR EQU 0DH ; ASCII Carriage return LF EQU 0AH ; ASCII Linefeed BEL EQU 07H ; ASCII Console Bell ENTRY $MEMRY,COUT,@DCFLD ENTRY DATER ENTRY YEAR,MONTH,DAY EXTRN WILDEX,SORT,@UDCVT; Modified Sigi Kluger modules ; Z3LIB stuff (used version 4.3B of Z3LIB) EXTRN Z3INIT,Z3LOG,PUTER2,GETMSG,ZFNAME,GETEFCB EXTRN Z33CHK,Z33FNAME,GZMTOP ; DSLIB stuff EXTRN TIMINI,RCLOCK,GSTAMP,BCD2BIN,DOSTYP ; SYSLIB stuff (Note: "BDOS" is a SYSLIB routine, not 0005h, ; used version 4.3C of SYSLIB) EXTRN CRLF,EPSTR,EPRINT,PFN2,PAFDC,PHLFDC EXTRN F$OPEN,F$READ,F$CLOSE,R$READ,R$WRITE EXTRN F$MAKE,F$WRITE,INITFCB EXTRN PUTUD,GETUD,RETUD,LOGUD,GETFS,GETRR EXTRN DPARAMS,DFREE,SDIV,COMPHD,SETDMA EXTRN CLINE,SKSP,EVAL10,BOUT,BIST,BIN,BDOS ; Look-up table based CRC module ala' DISK77, CHEK15, PPIP, etc. ; (Now part of SYSLIB) EXTRN CRC3INIT,CRC3CLR,CRC3UPD,CRC3DONE IF M80 .Z80 ; Needed by M80 only ENDIF LPUT: JP START DB 'Z3ENV',1 ; Type 1 external environment. Z3EADR: DW 0e050h START: LD (STACK),SP LD HL,($MEMRY) INC H LD SP,HL LD A,L OR A JR Z,CRCPAG INC H LD L,0 CRCPAG: LD (CRCTBL),HL ; Store address CALL CRC3INIT CALL PUTUD ; Store current DU via SYSLIB. CALL MKWILD ; Make filespec *.* if only dir: given LD HL,TBUFF LD C,(HL) ; Command line length in BC LD B,0 CALL CLINE ; Stow command tail as a string. PUSH HL ; Save buffer start for later LD A,(FCB2+1) CP 20H JR Z,NOEXTR LD A,'+' ; Prepare to search for extras CPIR ; Scan ahead JR NZ,NOEXTR ; NZ means no "+" anywhere DEC HL ; De-bump to end of filenames DEC HL LD A,(HL) ; Get the byte CP 21H ; Test for space character JR NC,NOEXTR ; If not, it's not extras LD (HL),B ; Otherwise, null-terminate INC HL ; Go back to alleged number INC HL LD B,H ; Copy pointer to BC LD C,L CALL EVAL10 ; Evaluate as decimal LD A,(HL) ; Test terminator, clear carry OR A ; Must be a null JR NZ,NOEXTR ; Otherwise no extras SBC HL,BC ; Make sure EVAL10 pointer moved JR NZ,YSEXTR ; It did if NZ NOEXTR: LD DE,0 ; No extras if we're here YSEXTR: LD (EXTRA),DE ; Save for MKNLBR POP HL ; Get back buffer start in HL LD D,H ; Copy buffer start to DE. LD E,L XOR A ; Search for null terminator. LD BC,0FFH ; 255 byte range in buffer. CPIR ; Do it Z80-style. DEC HL ; Back up over null. LD (CMDEND),HL ; Store address for later. EX DE,HL ; Get buffer start back into HL. LD A,',' ; Search for input file delmtr. LD BC,33 ; Reasonable range limit. CPIR DEC HL JR Z,FNDCMA ; If it was a comma, use it. EX DE,HL ; Otherwise use end of string. FNDCMA: LD (CMDLIN),HL LD HL,(Z3EADR) ; Get environment address or 00. LD A,L ; Test for valid environment. OR H JR NZ,OKZ3 ; Z flag set indicates failure. CALL EPRINT DB 'Non-ZCPR3 systems',0 ABTXIT: LD HL,ABTMSG ; Share ASCII for space savings. CALL EPSTR JP DIROK OKZ3: CALL Z3INIT ; Pass ENV to Z3LIB. CALL EPRINT DB 'LPUT, Version 2.0',0 LD DE,FCB+1 LD A,(DE) CP 20H JR Z,HELP CP '/' JP NZ,CHKAMB HELP: CALL EPRINT DB CR,LF DB 'Syntax:' DB CR,LF,' ',0 CALL GETEFCB JR Z,NOEFCB LD B,8 EFCBLP: INC HL LD A,(HL) AND 7FH CP ' ' CALL NZ,BOUT DJNZ EFCBLP JR HELP1 NOEFCB: CALL EPRINT DB 'LPUT',0 HELP1: CALL EPRINT DB ' dir:lbrfile [dir:afn1.typ,dir:afn2.typ...etc[ +nn]]' DB CR,LF DB 'Omitting the input filespec results in an' DB CR,LF DB 'LBR directory format check and CRC update.' DB CR,LF DB 'An input filespec of dir: defaults to dir:*.*.' DB CR,LF,LF DB 'If "lbrfile" is not found, LPUT will create it.' DB CR,LF DB 'In that case, an input filespec of "/nn" makes an' DB CR,LF DB 'empty LBR for "nn" members and an optional trailing' DB CR,LF DB '"+nn" creates one with "nn" extra member slots.' DB 0 JP DIROK CHKAMB: CALL AMBCHK JR NZ,TSTMSG ; No match means OK. AMBFND: CALL EPRINT DB CR,LF,'No ambiguous LBR filenames allowed.',BEL,0 JP ERRJP TSTMSG: CALL GETMSG ; Do we have a message buffer? JR NZ,MSGBOK ; Abort if not. CALL EPRINT DB CR,LF,'Systems without ZCPR3 message buffer',0 JP ABTXIT ; Print rest of message and abort MSGBOK: XOR A ; Zero in A LD (MEMDIR+1),A ; Clear this, doubles as a flag. LD (NEWLBR),A ; Init. to "existing" LBR. CALL PUTER2 ; Poke into program error flag. DEC DE ; Point at requested library. CALL Z3LOG ; Log in temporarily. CALL DPARAMS ; Extract and store DPB data. CALL RETUD ; Retrieve drive and user area. LD (LBRDU),BC ; Store. EX DE,HL ; Stash FCB in HL. LD DE,LBRFCB ; Internal LBR FCB to DE. PUSH DE ; Save on stack. LD BC,9 ; Move only up to filetype. LDIR ; Do it. EX DE,HL ; HL points to LBR FCB filetype. LD (HL),'L' ; Plug in L B R. INC HL LD (HL),'B' INC HL LD (HL),'R' POP DE ; Get back LBR FCB start. CALL INITFCB ; Initialize for reentrance. CALL F$OPEN ; Anybody home? JR Z,LBRFND LD A,(FCB2+1) CP 20H JR Z,NOINPF LD BC,(LBRDU) CALL EPRINT DB CR,LF,'Making library: ',0 CALL PRNDU INC DE CALL PFN2 LD A,',' CALL BOUT LD A,0FFH LD (NEWLBR),A DEC DE CALL MKNLBR JR NZ,LBRFND NOINPF: CALL EPRINT DB BEL,CR,LF,'No input file(s), aborting!',0 JP ERRJP LBRFND: CALL GZMTOP ; Find top of tpa LD A,H ; ...using extended environment if available POKTOP: LD (RAMTOP),A LD (RAMDMA+1),A ; Store as buffer ptr. page. LD A,(FCB2+1) CP 20H JR Z,NOMEMS OR A JR NZ,LSIZER NOMEMS: LD HL,(CRCTBL) INC H INC H LD (RAMBOT),HL OR A JP Z,DODIR NMEMSG: CALL EPRINT DB CR,LF,'No input file specified, checking LBR' DB CR,LF,'directory format & updating its CRC.',0 JP DODIR LSIZER: CALL GETFS ; Size 'er up. JP NZ,ERROR ; VERY unlikely, but who knows? LD A,L OR H JP Z,FORMER ; Don't permit zero-length LBRs. LD (LBREND),HL ; Otherwise store as end marker. LD DE,FCB2 ; Point at requested new member. CALL GETUD ; Reassert original D/U. RENTER: CALL Z3LOG ; Log in as per Z3. CALL RETUD ; Retrieve drive and user area. LD (MEMDU),BC ; Store that locally. EX DE,HL ; FCB pointer to HL. LD DE,MEMFCB ; Internal member FCB to DE. PUSH DE ; Save on stack. LD BC,12 ; Move 0filenametyp. LDIR ; Do it. POP DE ; Get back member FCB start. CALL INITFCB ; Initialize for reentrance. CALL EXPAND ; Do wildcards (ref. BFRPTR). JR Z,NOTFND ; No file(s), go home. MEMBLP: PUSH DE ; Save member FCB pointer. LD HL,(BFRPTR) ; Get pointer to WILDEX entry. LD BC,16 ; Move into member FCB LDIR LD (BFRPTR),HL ; Poke in new BFRPTR value. LD A,(RAMTOP) ; Get end of free RAM. LD (RAMDMA+1),A ; Store as buffer ptr. page. POP DE ; Get back FCB. LD HL,10 ; Offset to $SYS attribute byte. ADD HL,DE ; Add it in, DE preserved. LD A,(HL) ; Character in A. OR A ; Test for high bit set. JP M,SYSSKP ; Skip the file if it's set. LD (CRUFLG),A ; Leave as a flag for DATER. PUSH DE ; Save FCB again. INC DE ; Point to 11 byte filenametyp. LD HL,LBRFCB+1 ; Same in LBR's FCB. LD B,11 ; Set counter for length. EATLP: LD A,(DE) ; Get character. AND 7FH ; Strip "attribit". CP (HL) ; Compare. JR NZ,NOTEAT ; Any mismatch is A.O.K. INC DE ; Bump both pointers. INC HL DJNZ EATLP ; Loop through all. POP DE ; Balance the stack. SYSSKP: LD DE,LBRFCB ; Point at LBR's FCB. JP SKIPIT ; Share code and loop. NOTEAT: POP DE ; Not a self-eat, proceed. CALL INITFCB ; Initialize. CALL F$OPEN JR NZ,NOTFND ; Should NEVER happen... CALL GETFS ; How big is YOUR member? JR Z,OKMEMB ; Barf if not found, etc. NOTFND: LD BC,(MEMDU) CALL EPRINT DB CR,LF,'Input file ',0 NFOUND: CALL PRNDU INC DE CALL PFN2 CALL EPRINT DB BEL,' not found.',0 LD A,(MEMDIR+1) OR A JP Z,ERRJP LD A,254 CALL PUTER2 LD BC,(LBRDU) CALL LOGUD LD DE,LBRFCB ABRT: CALL EPRINT DB CR,LF,'Aborting, saving what we have...',0 JP DODIR OKMEMB: LD (MEMSIZ),HL ; Store filesize in model. CALL DATER ; DRI-format date to storage LD DE,(MEMSIZ) ; Filesize into DE. LD HL,(BFRPTR) ; Get current WILDEX pointer. DEC HL ; Back up to prev. file's size. LD (HL),D ; Load MSB. DEC HL ; Back up one more. LD (HL),E ; Load LSB. LD HL,MEMFCB ; HL points to member FCB LD DE,MEMDIR ; DE to model LBR dir. entry. LD B,12 ; Move 0filenametyp. MVSTRL: LD A,(HL) AND 7FH ; The famous attribit strip. LD (DE),A INC HL INC DE DJNZ MVSTRL LD BC,(LBRDU) CALL LOGUD ; We log into LBR's DU LD DE,LBRFCB ; and point at its FCB. FILEOK: LD HL,0 ; Read 1st record into TBUFF. CALL R$READ JP NZ,ERROR LD HL,TBUFF ; Set pointer for format check. LD A,(HL) ; Get status byte of directory OR A ; Entry into A, test for zero. JP NZ,FORMER ; Abort if not zero. LD B,11 ; Set down-counter for 11 spaces. CHKDR1: INC HL ; Beginning of FCB-style filename LD A,(HL) ; Get byte CP 20H ; Must be a space. JP NZ,FORMER ; Abort if not DJNZ CHKDR1 ; Loop through all. INC HL ; Bump to index position. XOR A ; Both bytes must be zero. CP (HL) JP NZ,FORMER INC HL CP (HL) JP NZ,FORMER INC HL ; Bump to length LD A,(HL) ; Get LSB in A. LD B,A ; ..and in B INC HL ; Bump to length MSB. LD H,(HL) ; Get length in H. OR H ; Can't be double-precision 0. JP Z,FORMER LD L,B ; Length LSB to L PUSH HL ; Save as a 16-bit down-counter. LD HL,TBUFF+32 ; Ignore directory member for JR SECRD ; the first loop CHKSEC: PUSH HL ; Save as a 16-bit down-counter. LD HL,TBUFF ; Point at first status byte. SECRD: CALL CHKMCH ; Check for matching filename. JP Z,FOUND ; Use it if found. CALL CHKDEL ; Check for usable deleted entry. JP Z,FOUND ; That's the second choice. CALL CHKOPN ; Otherwise use first free spot. JP Z,FOUND ; That'll do in a pinch. NXSTAT: LD DE,32 ; Offset to next entry. ADD HL,DE ; Point at next entry. LD B,H ; When H has a 1 we're done. DJNZ SECRD ; Keep going until all 4 are read POP HL ; Otherwise get back 16-bit counter DEC HL ; Subtract one and LD A,L ; Do a test OR H ; For zero. JR Z,NOROOM ; If zero, there's no room here. LD DE,LBRFCB ; Otherwise read in another record CALL NRREAD ; from the library directory. JR Z,CHKSEC ; And loop if no BDOS error. JP ERROR ; BDOS errors land here. NOROOM: CALL EPRINT DB CR,LF,'No more room left in ',0 LD BC,(LBRDU) CALL PRNDU LD DE,LBRFCB+1 CALL PFN2 CALL EPRINT DB ',',CR,LF,'reorganize it or create a new LBR file.',0 DEC DE ; Point to LBR's FCB. LD A,253 CALL PUTER2 ; Report error to ZCPR3 flag. JP DODIR ; Assure correct directory CRC. FORMER: CALL CRLF ; Feed CRT a line. LD BC,(LBRDU) ; Retrieve LBR's D/U. CALL PRNDU ; Print with a colon. LD DE,LBRFCB+1 ; Point at filenametyp. CALL PFN2 ; Print with a period. CALL EPRINT DB ' is not a valid LBR file,' ABTMSG: DB BEL,CR,LF,'not supported, aborting.',0 JP ERRJP FOUND: POP AF ; Balance the stack harmlessly. CALL EPRINT DB CR,LF,'Putting file ',0 LD BC,(MEMDU) ; Get member's directory. CALL LOGUD ; Log in. CALL PRNDU ; Print DU:. LD DE,MEMFCB+1 ; Point at FCB+1. CALL PFN2 ; Print file's full name. LD HL,(MMDATE) LD A,L OR H LD HL,DATSTR CALL NZ,EPSTR CALL EPRINT DB ' in library,',0 LD HL,(MEMSIZ) ; Test for zero-length file. LD A,L OR H JR Z,ZEROLN ; We can skip lots of code if Z. PUSH HL ; Otherwise HL needed on stack. DEC DE ; Now point at FCB. CALL CRC3CLR ; Clear the CRC accumulator. LD HL,(MEMIDX) ; Destination record # in LBR. WRLOOP: CALL FBREAD ; Buffered read, input file. OR A JP NZ,ERROR CALL CCRC ; Update CRC for all of TBUFF. LD BC,(LBRDU) ; Get LBR's DU. CALL LOGUD ; Log in. LD DE,LBRFCB ; Point at FCB CALL R$WRITE ; "Random" write, output file. JP NZ,ERROR INC HL ; Bump record number. POP BC ; Get back member length. DEC BC ; Subtract one. LD A,C ; Check for zero. OR B JR Z,ZEROLN1 ; Done if zero. PUSH BC ; Otherwise save it on stack. LD BC,(MEMDU) ; Get member's DU. CALL LOGUD ; Log in. LD DE,MEMFCB ; Point at FCB. JR WRLOOP ; And loop. ZEROLN1: CALL CRC3DONE ; Finalize CRC if required. ZEROLN: LD (MEMCRC),HL ; Store CRC or 0000h in MEMDIR LD BC,(LBRDU) ; Get LBR's DU. CALL LOGUD ; (Sigh..) log in. LD DE,LBRFCB ; Point at FCB LD HL,(MEMREC) ; Get record # w/spot for entry. CALL R$READ ; "Random" read. JP NZ,ERROR PUSH DE ; LBRFCB PUSH HL ; (MEMREC) LD DE,(MEMPOS) ; Point DE at member location. LD HL,MEMDIR ; Point to model LD BC,26 ; Move 0filenametyp. LDIR ; Move 'em out. POP HL ; Select proper record #. POP DE ; Get FCB again. CALL R$WRITE ; "Random" write. JP NZ,ERROR SKIPIT: CALL BIST JR Z,NOABRT CALL BIN CP 3 JP Z,ABRT NOABRT: LD HL,(COUNT) ; Get WILDEX file count. DEC HL ; Subtract one. LD A,L ; Check if this is last one. OR H LD (COUNT),HL ; Always store updated count. JR NZ,DOLOOP ; More files left, branch ahead. LD HL,(CMDLIN) ; Otherwise get token pointer. LD A,(HL) ; Are we at the null? OR A JR Z,DODIR ; Then we're done. CALL SKSP LD A,',' ; Test for comma and CPI ; bump pointer. JR NZ,DODIR ; No comma, we're done. CALL SKSP ; Skip stray spaces & tabs. LD A,(HL) OR A ; Clear carry, test for zero. JR Z,DODIR LD BC,(CMDEND) ; Get string's end. SBC HL,BC ; Subtract used as compare. ADD HL,BC ; Token pointer back in HL. JR NC,DODIR ; Past end of string? LD A,(NEWLBR) ; New LBR mean no CLEAN needed. INC A JR NZ,OLDLBR ; Branch ahead, already "old". LD (NEWLBR),A ; If here, we are now an "old" JR NXTOK1 ; LBR for subsequent runs. OLDLBR: LD (CMDLIN),HL ; Store pointer for parsing. LD DE,LBRFCB ; Need LBR directory again. LD HL,0 ; First record. CALL R$READ JP NZ,ERROR LD HL,TBUFF+14 ; Read out directory length. LD C,(HL) INC HL LD B,(HL) ; In BC as 16-bit down-counter. LD HL,0 LD A,(RAMTOP) ; Get end of free RAM. LD (RAMDMA+1),A ; Store as buffer ptr. page. TKNCLP: CALL CLEAN ; Purge dupes. DEC BC ; Decrement count. LD A,C OR B JR Z,NXTOKE ; Branch to parser w/A=0. INC HL ; Otherwise bump record count. LD DE,LBRFCB ; Point to FCB CALL RBREAD ; Read record into TBUFF. JR Z,TKNCLP ; Loop if no BDOS error. JP ERROR ; BDOS failures wind up here. NXTOKE: LD HL,(CMDLIN) ; Get back command line pointer. NXTOK1: LD DE,FCB2 ; Use second default FCB. CALL GETUD ; Reassert home DU. CALL ZPARSE ; Do ZCPR3 parse of one token. LD (CMDLIN),HL ; Store new pointer. CALL MKWILD ; Make filespec *.* if only dir: given JP RENTER ; Do the big loop back. DOLOOP: LD BC,(MEMDU) ; Get input DU. CALL LOGUD ; Log in. LD DE,MEMFCB ; Point at member FCB. JP MEMBLP ; Do a big loop back. DODIR: LD HL,0 CALL R$READ ; Read first record into buffer. JP NZ,ERROR LD HL,TBUFF ; Point to TBUFF. CPI ; Compare to 0 in A, bump HL. JP NZ,FORMER ; Gotta match or it's NG. LD A,' ' ; We need a blank filenametyp. EX DE,HL CALL CHARCK JP NZ,FORMER ; Must match or we gots a botch. OKLBR: LD HL,TBUFF+14 ; Point at directory size LD C,(HL) ; Directory size to BC INC HL LD B,(HL) INC HL ; Bump to CRC XOR A ; Zero out A (saves a byte) LD E,(HL) ; Read out LSB to E LD (HL),A ; Replace with a zero INC HL ; Bump to MSB LD D,(HL) ; Read out to D LD (HL),A ; Replace with a zero PUSH DE ; Save on stack CALL CRC3CLR ; Clear out CRC accumulator LD HL,0 ; Prepare HL for RBREAD call. LD A,(RAMTOP) ; Get end of free RAM. LD (RAMDMA+1),A ; Store as buffer ptr. page. CRCDIR: LD A,(NEWLBR) INC A JR Z,SKPCLN ; New LBRs don't need CLEANing. LD A,(FCB2+1) ; Was this format/CRC-only run? CP 20H+1 ; If it wasn't, then we CALL NC,CLEAN ; check for duplicate filenames. SKPCLN: CALL CCRC ; Do CRC on (altered?) record. DEC BC ; Is this the last one? LD A,C OR B JR Z,DIRDON ; If so, that's that. INC HL ; Otherwise bump record number. LD DE,LBRFCB ; Point to FCB again. CALL RBREAD ; Read record into TBUFF. JR Z,CRCDIR ; And loop if no BDOS error. JR ERROR ; BDOS errors land here. DIRDON: CALL CRC3DONE ; Finalize CRC calculation. POP DE ; Get back original CRC. CALL COMPHD ; Non-destructive compare HL/DE. LD DE,LBRFCB ; Point to (yawn) FCB. JR Z,SGNOFF ; If identical, write nothing. LD B,H ; Otherwise, save HL to BC. LD C,L LD HL,0 ; Select first record CALL R$READ ; "Random" read. JR NZ,ERROR ; Trap BDOS errors. LD (TBUFF+16),BC ; Poke in value. CALL R$WRITE ; Write back record. JR NZ,ERROR SGNOFF: CALL F$CLOSE ; Close up shop for keeps. OR A ; Make sure we got a 0. JR NZ,ERROR INC DE ; Point at filenameLBR. LD BC,(LBRDU) ; Retrieve LBR's DU. CALL CRLF CALL PRNDU ; Print with colon. CALL PFN2 ; Print filename.LBR. CALL EPRINT DB ' closed, operation complete.',0 JR DIROK ERROR: CALL EPRINT DB BEL,CR,LF,'BDOS file access error, aborting.',0 ERRJP: XOR A DEC A CALL PUTER2 DIROK: CALL GETUD ; Not really needed, but W.T.H. LD SP,(STACK) RET ; SUBROUTINES FOLLOW: ; ; Service routine for S. Kluger's WILDEX and MYSORT (SORT) modules ; EXPAND: PUSH DE LD HL,(CRCTBL) ; Use boundary above CRC table. INC H INC H ; By exactly 512 bytes. LD (BFRPTR),HL ; Store that address. LD (CLNPTR),HL ; Again for CLEAN. CALL WILDEX ; Expand FCB at (DE) to (HL). JR Z,NOWILD LD (COUNT),HL ; Save count of files. LD (CCOUNT),HL ; Again for CLEAN. LD BC,16 ; 16 bytes per WILDEX entry. EX DE,HL ; Count to DE. LD HL,(BFRPTR) ; WILDEX listing start in HL. PTRLP: ADD HL,BC ; Add 16 bytes for each entry. DEC DE ; Decrement count. LD A,E ; Test for zero. OR D JR NZ,PTRLP OR L ; Coincidental boundary? JR Z,PUTBOT ; Otherwise find next one. INC H ; Next page. LD L,D ; L = D = 0: even boundary. PUTBOT: LD (RAMBOT),HL ; Save as bottom of file buffer. LD BC,(COUNT) ; Set up for sort. LD A,C DEC A OR B ; Only one file in list? JR Z,NOSORT ; No need to sort then... LD DE,16 ; Length per entry. LD HL,(BFRPTR) CALL SORT ; Sort WILDEX list. XOR A NOSORT: DEC A ; Assure NZ on return. NOWILD: POP DE RET ; And return to caller. ; Buffered file reader, acts like F$READ (for ONE file!) FBREAD: PUSH HL PUSH DE PUSH BC LD A,(RAMTOP) LD HL,(RAMDMA) SUB H JR NZ,NOFILL CALL FILRAM JR Z,NOFILL DEC A JR NZ,FILERT NOFILL: LD DE,TBUFF LD B,D LD C,E LDIR LD (RAMDMA),HL XOR A FILERT: POP BC POP DE POP HL RET FILRAM: LD HL,(RAMBOT) LD (RAMDMA),HL LD BC,80H FILLLP: CALL SETDMA CALL F$READ JR NZ,FILERR ADD HL,BC LD A,(RAMTOP) SUB H JR NZ,FILLLP FILERR: LD H,B LD L,C CALL SETDMA LD HL,(RAMDMA) RET ; Buffered file reader, acts like R$READ (for ONE file!) ; An initializing R$READ call is required before using! RBREAD: PUSH DE PUSH BC PUSH HL LD A,(RAMTOP) LD HL,(RAMDMA) SUB H JR NZ,NORILL CALL RILRAM JR Z,NORILL DEC A JR Z,NORILL SUB 3 JR NZ,RILERT NORILL: LD DE,TBUFF LD B,D LD C,E LDIR LD (RAMDMA),HL XOR A RILERT: POP HL POP BC POP DE RET RILRAM: LD HL,(RAMBOT) LD (RAMDMA),HL LD BC,80H RILLLP: CALL SETDMA CALL NRREAD OR A JR NZ,RILERR ADD HL,BC LD A,(RAMTOP) SUB H JR NZ,RILLLP RILERR: LD H,B LD L,C CALL SETDMA LD HL,(RAMDMA) RET ; Read "next" random record to current DMA buffer, DE points to FCB. NRREAD: PUSH HL PUSH BC LD HL,21H ; Offset AND function # too(!). LD C,L ; Into C for BDOS call. ADD HL,DE ; Add in offset. INC (HL) ; Pseudo 16-bit increment... INC HL JR NZ,JLSB INC (HL) JLSB: INC HL LD (HL),0 ; Got this from R$READ. CALL BDOS ; SYSLIB preserves DE for us. OR A ; <>0 is a BDOS error. POP BC POP HL RET ; Print "DU:" to CON: when B=Disk and C=User code. ; (COUT is public label for SYSLIB) PRNDU: LD A,B ADD A,'A' CALL BOUT LD A,C CALL PAFDC LD A,':' COUT: JP BOUT ; JP xxxx = CALL xxxx!RET ; Compute CRC for record in TBUFF (adapted from S.Kluger). ; (Services routine CRC3UPD) ; CCRC: PUSH HL LD HL,TBUFF CCRC1: LD A,(HL) CALL CRC3UPD INC L JR NZ,CCRC1 POP HL RET ; ; Check FCB-style filenametyp for ambiguity, alternate entry ; point CHARCK permits scanning from any character. ; AMBCHK: LD A,'?' ; For ambiguity ; CHARCK: LD H,D ; Copy DE LD L,E ; To HL LD BC,11 ; Check FILENAMETYP CPIR ; Z80-style RET ; Returns Z if found. ; ; Checks LBR directory entry pointed to by HL for a match with ; the model entry at MEMDIR, compares available space with size ; of proposed replacement. ; CHKMCH: PUSH HL ; Save pointer. LD DE,MEMDIR+1 ; Point at search "vector". LD B,11 ; Load B with length. EX DE,HL ; Swap registers. NMLOOP: INC DE ; Point at possible match. LD A,(DE) ; Get target character. AND 7FH ; Reset "attribit". CP (HL) ; Compare to pointed one. JR NZ,NOMTCH ; Must be alike. INC HL ; Bump and DJNZ NMLOOP ; `->loop. LENCH2: POP DE ; Retrieve pointer. LD (MEMPOS),DE ; Store to model. PUSH DE ; Save it again. LD HL,14 ; Offset to member length. ADD HL,DE ; Add in offset. LD C,(HL) ; Read out length INC HL LD B,(HL) ; To BC. LD HL,(MEMSIZ) ; Retrieve candidate's size. XOR A ; Reset carry flag. SBC HL,BC ; Subtract used as compare. JR NZ,NOMTCH ; Must be same size or no match. LD HL,12 ; Offset to member index. ADD HL,DE ; Add it in. LD C,(HL) ; Read out index INC HL ; LD B,(HL) ; To BC. LD (MEMIDX),BC ; Plug it into model. LENCHK: LD DE,LBRFCB LENCH3: CALL GETRR ; Get current record. JP NZ,ERROR ; Abort on error. LD (MEMREC),HL ; Save that to model. NOMTCH: POP HL ; Return with correct zero flag RET ; and original pointer in HL. ; ; Checks LBR directory entry pointed to by HL for deleted status. ; Entry is re-used if length matches candidate's. CHKDEL: PUSH HL ; Save pointer. LD A,0FEH ; LUDEF's "deleted" status byte. CP (HL) ; Compare to pointed value JR NZ,NOMTCH ; Return failed if no match. JR LENCH2 ; Share code to check length. ; ; Checks the LBR entry pointed to by HL for an open entry. ; First open entry is used if CHKMCH and CHKDEL keep failing. ; CHKOPN: LD A,(HL) ; Get status byte. INC A ; Test for 0FFH RET NZ ; Return failed if not. LD (MEMPOS),HL ; Otherwise record position. PUSH HL ; Will be popped at NOMTCH. CALL DFREE ; Compute free space in Kbytes. LD B,D ; Stash LD C,E ; in BC. LD HL,(MEMSIZ) ; Get member size into HL. LD DE,8 ; Divisor to DE CALL SDIV ; Convert record count to K. EX DE,HL ; Quotient to HL, remainder to DE. LD A,E ; Check for remainder OR A ; ..and clear carry. JR Z,MOREK INC HL ; Bump by one if there was a remainder. MOREK: SBC HL,BC ; Subtract used as compare. JR C,ENUFF ; BC should be larger. NOENUF: CALL EPRINT DB BEL,CR,LF,'Insufficient disk space for ',0 LD BC,(MEMDU) LD DE,MEMFCB+1 CALL PRNDU CALL PFN2 LD A,',' CALL BOUT POP HL POP DE JP SYSSKP ; ENUFF: LD DE,(LBREND) ; Get end of LBR file. LD (MEMIDX),DE ; Load to the model. LD HL,(MEMSIZ) ; Get member size into HL. ADD HL,DE ; Update end of LBR. LD (LBREND),HL ; Store it. JR LENCHK ; Share code and return. ; ; Scans for matching filenames with non-matching lengths on exit. ; This "cleans" the LBR directory of duplicate member names. ; CLEAN: PUSH BC ; Save down-counter. PUSH HL ; Save current random record #. CALL REFRSH ; Initialize file list data. JR NZ,GOCLEA ; No files added? Just return. POP HL POP BC RET GOCLEA: LD HL,TBUFF ; Point at first entry XOR A ; Dual-purpose 0 to accumulator. LD (WRTFLG),A ; First reset write flag. BGLOOP: CP (HL) ; Is this not an active entry? JR NZ,LOOPCN ; Not our concern then... PUSH HL ; Save pointer on the stack. LD DE,(BFRPTR) ; Get pointer to buffer entry. LD B,11 ; Compare filenametyp, 11 chars. CLNLOP: INC DE ; Line up target "vector". INC HL ; Bump model pointer. LD A,(DE) ; Target in A. AND 7FH ; Strip "attribit". CP (HL) ; Compare to model. JR NZ,OKCLN ; Any non-match disqualifies us. DJNZ CLNLOP ; Decrement counter and loop. POP HL ; Get pointer. PUSH HL ; Save it again LD DE,14 ; Offset to length of member. ADD HL,DE ; Add in offset (DE preserved). LD C,(HL) ; Read out value to BC. INC HL LD B,(HL) LD HL,(BFRPTR) ; Get pointer to list entry. ADD HL,DE ; Add in offset. LD A,(HL) ; Read out value to HL. INC HL LD H,(HL) LD L,A XOR A ; Reset carry flag. SBC HL,BC ; Subtract used as compare. POP HL ; Regardless, pointer back to HL. JR Z,LOOPCN ; This must be the Real McCoy. DEC (HL) ; Otherwise decrement the status DEC (HL) ; Byte to FEh (deleted). LD A,0FFH ; Write-needed value (non-zero). LD (WRTFLG),A ; Plant it. JR LOOPCN ; Go check for end of record. ; OKCLN: POP HL ; Get back entry pointer ; (80h, A0h, C0h or E0h allowed) LOOPCN: EX DE,HL ; Pointer to DE. LD HL,(BFRPTR) ; Get list pointer. LD BC,16 ; Offset to next entry. ADD HL,BC ; Add it in. LD (BFRPTR),HL ; Update storage. EX DE,HL ; Pointer to back in HL. LD DE,(COUNTC) ; Get count. DEC DE ; Subtract for one entry done. LD A,E ; Test for last one. OR D LD (COUNTC),DE ; Update storage. LD A,0 ; Zero to accumulator for loop. JR NZ,BGLOOP ; Loop if not finished. ; CALL REFRSH ; Restore WILDEX list data. LD DE,32 ; Offset to next entry. ADD HL,DE ; Add it in. LD B,H ; MSB to B register (1 = done). XOR A ; Zero to accumulator for loop. DJNZ BGLOOP ; Test for a 1, loop if not. POP HL ; Otherwise get back record # LD A,(WRTFLG) ; Get write flag. OR A ; Test for zero (don't write). LD DE,LBRFCB ; Point at FCB for write. CALL NZ,R$WRITE ; Write back record if required. JP NZ,ERROR ; We won't get this jump if Z. POP BC ; Get back the down-counter RET ; And return. REFRSH: PUSH HL LD HL,(CCOUNT) ; Get original WILDEX count. LD BC,(COUNT) ; Get leftovers or 0000H. XOR A ; Clear carry flag. SBC HL,BC ; 16-bit subtract. LD (COUNTC),HL ; Refresh our counter. LD HL,(CLNPTR) ; Get virgin buffer start. LD (BFRPTR),HL ; Refresh buffer pointer. POP HL RET ; Creates an LU3xx-compatible LBR file with enough room for all ; the requested input files. If the special input filespec ; "/xx" is encountered, creates an empty LBR with room for "xx" ; member files. MKNLBR: PUSH DE ; Save incoming DE. LD DE,FCB2+1 ; Point member FCB+1. LD A,(DE) ; Character in A. SUB '/' ; Want an empty LBR? JR NZ,NJLBR ; Branch ahead if not. JLBR: EX DE,HL ; Pointer to HL. LD (HL),A ; Plant flag for no member add. INC HL ; Bump to number. CALL EVAL10 ; Evaluate ASCII=16-bit binary. JR DOMKNE ; Go build LBR. NJLBR: DEC DE ; Point to FCB start. LD HL,(CMDLIN) ; Make local CMDLIN pointer. LD (MKNCMD),HL EX DE,HL ; Source FCB to HL. LD DE,MKNFCB ; Local FCB in DE. PUSH DE ; Save source. LD BC,16 ; Make local copy of FCB. LDIR POP DE ; Point to it. LD (MKNCNT),BC ; Init. local file count to 0. CALL GETUD ; Assert home (CPR's) DU:. MKNLP: CALL Z3LOG ; Log in to FCB's DU:. CALL INITFCB ; Initialize. LD HL,(CRCTBL) ; Establish a safe buffer. INC H ; Compute CRC_look-up_table+512. INC H CALL WILDEX ; Expand, Sigi-style. JR Z,NOMKWD ; No files, do next token. LD BC,(MKNCNT) ; Get current count. ADD HL,BC ; Add new ones to it. LD (MKNCNT),HL ; Store. NOMKWD: LD HL,(MKNCMD) ; Get local token pointer. CALL SKSP LD A,',' ; Test for comma and CPI ; bump pointer. JR NZ,DOMKN ; No comma, we're done. CALL SKSP ; Skip stray spaces & tabs. LD A,(HL) OR A ; Clear carry, test for zero. JR Z,DOMKN LD BC,(CMDEND) ; Get string's end. SBC HL,BC ; Subtract used as compare. ADD HL,BC ; Token pointer back in HL. JR NC,DOMKN ; Past end of string? CALL GETUD ; Assert home (CPR's) DU:. CALL ZPARSE ; Z3 parse into local FCB. LD (MKNCMD),HL ; Store new local token pointer. LD HL,MKNFCB+1 ; Point to first char of filename LD A,(HL) LD C,20H ; Space character in C for comparisons CP C CALL Z,MKWLD0 ; Make blank filename wild JR MKNLP ; Loop around. DOMKN: LD DE,(MKNCNT) ; Get final count. LD A,E ; Can't have zero members either. DOMKNE: OR D ; So check for that. JP Z,EREXIT ; Go home if zero members asked. LD BC,(LBRDU) ; Log in now, avoid rush later. CALL LOGUD INC DE ; Bump count for LBR directory. LD HL,(EXTRA) ; Get any requested extras ADD HL,DE ; Add 'em in to get total in HL LD DE,4 ; Divisor to DE. CALL SDIV ; SYSLIB's HL/DE with remainder. LD A,L ; Check for non-zero remainder OR A JR Z,PLUGIN INC DE ; Bump record count by one if so. PLUGIN: LD HL,ENTRY1 ; Init. model in DSEG. XOR A ; A = 0. LD (HL),A ; Set 1st byte to 0 PUSH HL ; Save address LD B,11 ; Prepare to space fill next 11 bytes SPCLP: INC HL LD (HL),20H DJNZ SPCLP LD B,ENDMDL-ENTRY1-12 ZERLP: ; Prepare to 0 fill rest of model INC HL LD (HL),A DJNZ ZERLP LD (STORE),DE ; Store length to the model. LD DE,TBUFF ; Point at our disk buffer. POP HL ; Point at beginning of model. MDLLOO: ; Build first record of LBR. PUSH HL ; Save that model pointer. LD BC,ENDMDL-ENTRY1 LDIR ; Move out model. POP HL ; Get back pointer. LD (HL),0FFH ; Store "open" status flag. LD (STORE),BC ; Store 0000H to length. LD B,D ; If we're done, D = 1. DJNZ MDLLOO ; Test and loop if it's not. LD DE,LBRFCB CALL F$MAKE INC A JP Z,ERROR CALL F$WRITE ; And write record #1 to disk. JP NZ,ERROR LD HL,TBUFF+14 ; If here, A = 0, point length. LD C,(HL) ; Read out & replace with zeros. LD (HL),A INC HL LD B,(HL) LD (HL),A DEC A ; A = 0FFh. LD (TBUFF),A ; Store "open" status flag. LD H,B ; Copy BC to HL. LD L,C ADD HL,HL ; Compute LBR capacity. ADD HL,HL DEC HL ; This HL will survive all else. FFLOOP: DEC BC ; Decrement record count by one. LD A,C OR B ; Test for zero. JR Z,FINIS ; Break loop if so. CALL F$WRITE ; Write record, BC, DE & HL ok. JR Z,FFLOOP ; Loop if no BDOS error. JP ERROR FINIS: CALL F$CLOSE ; Close up for now. OR A JP NZ,ERROR LD A,(FCB2+1) ; Are we gonna add members? OR A JR NZ,EREXIT ; We're done if so. DEC A ; Otherwise assure return w/NZ. CALL EPRINT ; Tell 'em how much room in LBR. DB ' for ',0 CALL PHLFDC CALL EPRINT DB ' members.',0 EREXIT: POP DE ; Restore incoming DE & go home. RET ; Use the best Z3 parser we can find... ZPARSE: CALL Z33CHK JP Z,Z33FNAME XOR A JP ZFNAME ; If the name portion of FCB2 is blank but a dir spec or filetype ; exists, make name all "?." If type blank, make it all "?" also. ; (Uses HL, BC) ; MKWILD: LD HL,FCB2+1 ; Point to first char of filename LD A,(HL) LD C,20H ; Space character in C for comparisons CP C RET NZ ; Return if filename not blank DEC HL ; Point to drive byte LD A,(FCB2+9) ; Get first char of filetype OR (HL) ; OR with drive byte CP C ; Will be a space if drive byte 0 or type blank RET Z ; Return in that case INC HL ; Point to filename again MKWLD0: LD B,8 ; Eight bytes to fill MKWLD1: LD (HL),'?' ; Make name wild INC HL DJNZ MKWLD1 LD A,(HL) ; Get first character of filetype CP C ; Blank? RET NZ ; Return if not LD B,3 MKWLD2: LD (HL),'?' ; Make filetype wild INC HL DJNZ MKWLD2 RET ; Dating routine, calls DSLIB and Sigi's UNDATE (@UDCVT) DATER: LD A,(CRUFLG) ; Is the file crunched? SUB 'Z' ; Zero means possibly crunched. JR Z,ISCRU INC A ; Zero here means possibly LZH encoded JR NZ,NOTCRU ; Otherwise no imbedded BCD date ISCRU: CALL F$READ ; Read a record into TBUFF LD HL,32 ; Offset to "next record" in fcb ADD HL,DE LD (HL),0 ; Reset next record LD HL,TBUFF ; Set pointer to first byte LD A,(HL) ; Get it SUB 76H ; Test for crunched file JR NZ,NOTCRU ; OK, no imbedded BCD if NZ INC HL ; Bump pointer to filename strg. INC HL ; (A = 0 if all's well) INC A ; Look for tell-tale 1 LD B,13 ; Search range CRULP1: CP (HL) ; Test INC HL ; Bump JR Z,GOTCRU ; OK, we point at BCD date JR NC,NOTCRU ; Hit a null, no imbedded BCD DJNZ CRULP1 ; Keep on loopin' JR NOTCRU ; Failed search, no imbedded BCD GOTCRU: LD B,15 LD DE,USRDAT ; Otherwise move to our buffer CRULOO: LD A,(HL) ; Testing for Bridger's INC A ; zero-surrogates all the while JR Z,FFTO0 ; If it's a zero, so be it DEC A ; Otherwise restore it FFTO0: LD (DE),A INC DE INC HL DJNZ CRULOO JR DONDAT ; Go do conversion stuff NOTCRU: CALL TIMINI ; Find The DateStamper JR Z,GFAIL LD HL,USRDAT ; Our buffer pointer in HL CALL GSTAMP ; Get DS dossier into buffer LD A,(DOSTYP) CP '3' ; Check for CP/M 3 CALL Z,INITFCB ; Freshen fcb and reopen if so CALL Z,F$OPEN ; GSTAMP messes up fcb under CP/M 3 LD A,(MONTH) ; Month in range? CP 12H+1 ; No month <12 JR NC,NOMNTH OR A ; No month #0 either JR NZ,DONDAT ; Non-zero is accepted now NOMNTH: LD HL,USRDAT CALL RCLOCK LD HL,MYEAR ; Fill in mod date also CALL Z,RCLOCK JR Z,DONDAT GFAIL: LD HL,MCDATE ; When no dates and times available LD B,8 ; ..clean out all four fields FAILLP: LD (HL),0 INC HL DJNZ FAILLP JR GFAIL1 ; On our way out DONDAT: CALL DONDAT1 ; Convert create date and time LD (MCDATE),HL ; ..and ret with 16 bit cre date LD (MCTIME),DE ; ..and 16 bit cre time LD HL,MYEAR ; Point to last mod stats LD DE,YEAR ; Point to where @UDCVT will look LD BC,5 ; Move 5 byte date/time LDIR CALL DONDAT1 ; Conver mod date and time LD (MMDATE),HL ; Store mod date for later LD (MMTIME),DE ; Store mod time GFAIL1: LD HL,TBUFF ; DSLIB munges DMA, JP SETDMA ; so restore DMA and return DONDAT1: LD A,(HOUR) ; Get BCD hours CALL BCD2BIN ; Convert to binary LD H,A ; Store in H LD A,(MINUTE) ; Now get BCD minutes CALL BCD2BIN ; Convert ADD A,A ; Shift left 2 bits ADD A,A LD L,A ; ..and store in L ADD HL,HL ; Shift HL left 3 bits ADD HL,HL ADD HL,HL ; HL has time in MSDOS format PUSH HL ; Store on stack LD A,(MONTH) ; Get BCD month LD HL,@DCFLD-1 ; Point byte before ASCII strg. CALL STOREA ; Store as ASCII in string LD A,(DAY) ; Get BCD day CALL STOREA ; Store as ASCII in string LD A,(YEAR) ; Get BCD year CALL STOREA ; Store as ASCII in string CALL @UDCVT ; Convert to DRI in HL POP DE ; Get time back in DE RET NC ; Carry set is format error LD HL,0 ; Null date and timeon failure LD E,L LD D,H RET ; Store ASCII STOREA: LD B,A ; Stash BCD in B RRCA ; Exchange nybbles RRCA RRCA RRCA CALL MASK DEC HL LD A,B ; Get other nybble ; fall through MASK: AND 0FH ; Mask ADD A,'0' ; ASCII INC HL ; Bump pointer LD (HL),A ; Store INC HL RET DATSTR: DB ' (' @DCFLD: DB '00/00/00)',0 $MEMRY: DS 2 ; Must be in CSEG or it's lost. DSEG ENTRY1: DS 14 ; Model LBR directory member STORE: DS 2 ; Save 16-bit record count here. DS 16 ENDMDL: DS 0 MKNFCB: DS 36 ; Working FCB for MKNLBR. MKNCNT: DS 2 ; Local filecount for MKNLBR. MKNCMD: DS 2 ; Local CMDLIN pointer for ^. NEWLBR: DS 1 ; 0FFh if we know LBR is clean. WRTFLG: DS 1 ; 0FFh if CLEAN must write. LBREND: DS 2 ; Holds end record # of LBR. LBRDU: DS 2 ; Holds LBR user code and drive. LBRFCB: DS 36 MEMDU: DS 2 ; Same thing for the member file. MEMFCB: DS 36 MEMREC: DS 2 ; Record # of LBR dir entry. MEMPOS: DS 2 ; Entry's start in TBUFF. MEMDIR: DS 12 ; Member 0filenametype. MEMIDX: DS 2 ; Member index in LBR. MEMSIZ: DS 2 ; Member's lusty length. MEMCRC: DS 2 ; Member's CRC. MCDATE: DS 2 ; Creation date. MMDATE: DS 2 ; Last modification date. MCTIME: DS 2 ; Creation time. MMTIME: DS 2 ; Last modification time. BFRPTR: DS 2 ; Pointer to expanded wildcards. COUNT: DS 2 ; Number of files in expansion. CLNPTR: DS 2 ; Duplicates for CLEAN routine. CCOUNT: DS 2 COUNTC: DS 2 CMDLIN: DS 2 ; Pointer to current cmd. token. CMDEND: DS 2 ; End of stored command line. CRCTBL DS 2 ; Pointer to CRC table RAMDMA: DS 2 ; Current pointer, input buffer. RAMBOT: DS 2 ; Start of input buffer. RAMTOP: DS 1 ; Last page of free RAM. CRUFLG: DS 1 EXTRA: DS 2 STACK: DS 2 ; The CPR stack pointer storage. USRDAT: YEAR: DS 1 ; Creation date MONTH: DS 1 DAY: DS 1 ; Creation day HOUR: DS 1 ; Creation hour MINUTE: DS 1 ; Creation minute DS 5 ; Last Access date and time MYEAR: DS 6 ; Last Mod date and time END