home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
CPM
/
RCPM
/
LUX80.ARK
/
LUX80.MAC
< prev
next >
Wrap
Text File
|
1987-03-04
|
59KB
|
2,107 lines
;
; LUX v8.0 - 03/04/87 {tmb}
;
; LUX enables you to "enter" .LBR, .ARK and .ARC files to view, transfer
; and otherwise manipulate their individual file members.
;
; LUX Version 1.2B was Copyright 1983 by Steven R. Holtzclaw
; and entered into the public domain.
;
; 03/04/87 Unfortunately for all of us, Irv Hoff now considers LUX to
; v8.0 be "his" -- where he gets the idea that LUX5x is a series
; unto itself, much less that I claim it as my own, is beyond
; my comprehension. LUX is a terrific public domain utility,
; which has grown in quality as a result of various people's
; contributions. In an effort to keep LUX free of Irv Hoff's
; attempts to claim ownership of yet another fine public domain
; work (not to mention ignoring the LUX v5.4 I released, which
; predated his v7.0 release by a month), I will continue to
; return all the features/code which he decided none of us want
; or need. I also did nothing so feeble/petty as renaming v5.4
; to v7.5 to prevent him from "contributing to the development"
; of this utility -- I merely added the abort support which he
; had put into v7.0 and made an appropriate note to this effect.
; His actions are clear and are not a "contribution" to the
; majority of us who believe CP/M public domain exists for all
; to enjoy and benefit from. I leave Irv's comments below,
; although, as he states, v7.7 is nothing more than v7.0 renamed.
; Irv, if you want to grab onto yet another public domain work
; and claim it as your own, I suggest that you give it a different
; name and "contribute to its development" as you see fit.
; Otherwise, follow the proper update tradition and leave code/mods
; and comments in as contributors intend and as the majority of
; users/sysops want.
;
; The code which was in my release v5.4 already supported MBKMD,
; so only the addition of an MBKMD equate was required, along with
; MBKMD being added to NUKMD conditionals. Irv's v7.0 assumes
; those who run NUKMD/MBKMD force their users to learn yet another
; command - wrong -- the "KMD" command option is adopted as a
; fairly "universal" user command, so a bunch of duplicated code
; is not required as is found in v7.0/7.7.... Most of us try to
; make life easier for the user and have their file transfer
; program (whatever it may be) online as KMD.COM and XMODEM.COM.
;
; Have added a couple of RCP/M equate options (Gary Inman is
; using similar features and suggested some of these) - will
; display on menu, only if set YES (and then some by WHEEL state):
;
; CHATOK for those who allow online CHAT attempts - you provide
; your own CHAT program.
; NOTEOK for those who allow NOTE to be left to sysop - you provide
; your own NOTE program - if you CHAT program already has this
; feature built-in, set NOTEOK to NO.
; SZAPOK for those who want optional WHEEL access to the John
; Hastwell-Batten utility, SuperZAP -- v3.3 is included. If you
; prefer a different disk-editor, set this equate YES and rename
; yours to ZAP.COM for LUX to find.
; NSWPOK for those who wish to have WHEEL access to Dave Rand's
; NSWEEP utility -- v2.07 is included.
;
; Simplified setting drive areas for various files -- just
; enter the letter of each drive as required for LUX to find
; each utility.
; {tmb}
;
; 03/01/78 NOTICE TO TOM BRADY: LEAVE YOUR FINGERS OFF THIS PROGRAM.
; v77 IF YOU WANT TO CONTINUE MUCKING WITH LUX, SUGGEST YOU USE
; THE NUMBER LUX55 TO FOLLOW YOUR OWN LUX54. I INTENTIONALLY
; SKIPPED TO LUX70 SO AS TO NOT PROHIBIT YOU FROM DOING JUST
; THAT, BUT WILL NOT TOLERATE YOUR USING THIS SERIES IN AN
; OBVIOUS ATTEMPT TO PREVENT ME FROM CONTRIBUTING TO THE DE-
; VELOPMENT OF THIS PROGRAM.
;
; Restored LUX v77 to the original intent of the LUX 7x ver-
; sion. I had already skipped to LUX70 to not place Tom Brady
; in a position where he could not continue working with his
; LUX54, calling any subsequent version LUX55. Instead he
; elected to try to totally obliterate any work I had put into
; this program. I will not allow that to occur. Many people
; prefer my version to his, since it can be installed on any
; RCPM as fast as you can extract the files from the libaray.
;
; (Tom Brady totally replaced everything in the LUX70A version
; including all auxiliary programs in the library with his own
; LUX54 version. He further decided to jump to LUX75. This
; was done in an obvious attempt to force people to use only
; his version.)
; - Irv Hoff
;
; 03/01/87 Removed excessive code incorporated by {nlb} and {kdj} in
; v7.5 .ARK/.ARC file check routines and replaced with simple loop
; routines.
;
; This returns the fine LUX RCP/M utility to its former
; "pre-Irv Hoff" quality, including WHEEL and MAX D/U
; checking. Also returned is the perfectly fine LUXCRC,
; LUXCHK and LUXDIR files -- .MAC (source) and .COM files.
; Every time Irv Hoff decides to put his fingers into things
; another twist of the knife speeds along the agonizing death
; of the public domain CP/M world and I'm sick and tired of
; this crap. I like LUXDIR's simple handling of listing the
; .LBR's internal file members -- SD (and those similar) are
; far too busy and are best used by LUX when listing other
; .LBR/.ARK/.ARC files on the drive/user areas. LT18 is also
; returned, as is the UNARC overlay for easy customization.
;
; Irv Hoff may well have been "testing" his own personal LUX
; version on various of his friend's systems, but I worked
; extensively on release v5.4 and released same before he decided
; the world was ready for "his" blessed release. So, as I have
; come to expect from those quarters, all historical update notes
; from my v5.4 release were conveniently missing from "his" v7.0
; release. As far as his comments about NUKMD regularly
; adopting features found in KMD, *bull* -- the *only* feature
; adopted from KMD since I broke away from my work on KMD (way
; back in KMD v1.5E) has been the .ARK/.ARC member extraction
; support -- NOTHING ELSE. Lies are easily spread and just as
; easily believed, but the record is quite clear.
;
; Irv claimed v7.0 was a "radical departure" -- yes, he removed
; much useful code, removed source files of useful LUX utilities
; and added his magic touch to what has always been a fine RCP/M
; utility. However, a major update it was not, nor does that
; give him the right to jump from v5.x to v7.x at a whim. What
; was actually added/modified is acredited in the history notes
; below - my v5.4 already had many updates which he claimed as
; his own with v7.0 release almost a month later. [tmb]
;
; 02/22/87 Removed "EQU $" at START {it's back - tmb}. Added support for
; v7.0 abort from LUX with ^X and ^K. Irv Hoff
;
; 02/10/87 Modified to use command "DU" to get directory of
; v5.41 a different drive/user than now in, no need to leave
; LUX to see what's on another drive. Just "DU", then
; LUX to the next drive/file. Also, fixed so you may now
; move from an .ARK to an .ARC (or vice versa) from within
; LUX. [kdj]
;
; 02/01/87 Modified to support NUKMD (v1.10 & later), which uses
; v5.4 "L" for .LBR and "A" for .ARK/.ARC member extractions.
; Set NUKMD or KMD to YES, depending on which you use.
; There are many MS-DOS .ARC files which are required to
; be passed on intact -- for those of you who wish to
; honor this tradition, set EXTARC to NO and users will
; be able to manipulate .ARC member files in every way but
; will not be able to download them (does not effect .LBR
; member extractions). Removed the unecessary code which
; told you NULU was unavailable in .ARC files -- this menu
; option is only shown when in .LBR files. Also, eliminated
; the unecessary code which told you that CHEK and CRCK were
; unavailable in .ARC files -- just defaulted to UNARC. When
; in .LBR files, added support to also get a directory listing
; of .ARK/.ARC files (i.e. AFILES) -- when in .ARK/.ARC files,
; you may also get a directory listing of .LBR files (LFILES).
; The FILES command will display a directory of files which
; match the currently open file type, as always. Restored
; operation of BYE from within LUX. Removed LUXTYP22 from
; distribution file -- this is an antiquated utility, which
; I have replaced with the excellent LT utility. LT will
; display ASCII, squeezed and crunched files -- also accepts
; wildcards. [tmb]
;
; 06-27-86 Modified for .ARC file support, using UNARCxx for dir
; v5.2 and Type commands....fully automatic determination of
; ARC or LBR file extents, (ext not necessary) Supports
; Arc member transfer... [nlb]
;
; 08-26-85 Modified for KMD support throughout. Other cosmetic
; v5.1k changes. KMD04 (and up) offers total automatic protocol
; detect, as well as YAM-mode batch transfers (NOT supported
; in LUX, though). - [tmb]
;
; 07-21-85 Added new XMODEM SK and SENDK options for new 1k packet
; v5.0 protocol used by MEX114 and XMODEM110. - [sls]
;
; 11-29-84 Added a NOGOT routine for CHAT, NEW, and TIME commands
; v4.4 to tell user to exit LUX to use the above mentioned
; commands. Also added OFF, QUIT, and /OFF synonyms for
; the BYE command.
;
; NOTE: This is a special version for use with XMODEM.COM called
; LUXMODEM.COM (modified XMDM105). - [sls]
;
; 11-09-84 Changed LUX commands, removed CHAT & TIME for internal
; v4.3 reasons. Also removed NEW command. - [sls]
;
; 10-07-84 Changed extended command mode to be useable with NULU10
; v4.2 instead of LU300's command structure. NULU is re-entrant
; and only needs to be loaded into memory for use.
; The extended commands are now "-L" to load NULU into the
; command mode and list the directory, or "-F" which loads
; NULU into the filesweep mode. From either mode, NULU is
; left in command mode until terminated. - [sls]
;
; 09-12-84 Added HARDCD equate for those of us supporting ZCPRs wheel
; v4.1 but not using the maxdrv/maxusr values poked by ZCPR.
; Also added RCPM functions for TIME (TOS) and NEW (WHATSNEW)
; modules (impliment them as desired.) Also added CMDJMP
; equates for D and SD commands to work the same as DIR.
; Changed internal error-handling to point out command
; in error. - [sls]
;
; 09-07-84 Added auto-directory logic, added BYE function, with vector
; v4.0 accessible from external program to force the removal of LUX.
; Removed system-specific and trivial textual code.
; Condensed revision info for quick reading. - [ mah ]
;
;
; [ srh ] - Steve R. Holtzclaw
; [ mah ] - Mark A. Howard CNY TECHNICAL RCP/M (315) 437-4890
; [ sls ] - Steve L. Sanders DATA COM NETWORK SYSTEMS (813) 937-3608
; [ tmb ] - Tom M. Brady DECIBEL PBBS (404) 288-6858
; [ nlb ] - Norman L. Beeler ZeeMachine RBBS -RAS (408) 245-1420
; Multi-User/Line (408) 735-0176
; [ kdj ] - Kim D. Johnson Midwest Sysop Board (612) 824-7550
;
; 11/26/83 Original release. Adapted from ATTACH program. - [ srh ]
;
; -----
;
.Z80
;
NO EQU 0
YES EQU NOT NO
;
;
; ==========================
; USER CONFIGURATION EQUATES
; ==========================
;
AUTODR EQU yes ; YES, if auto-dir wanted when LUX is
; first attached to a LBR file
BELL EQU 7 ; Set to 20H for silence, or 7 for bells...
HLPERS EQU 2 ; Give auto-help after this many errors
HLPMSG EQU yes ; YES, if helpful messages are wanted
;
; Note: If RCPM is YES and your logoff program is NOT online as
; BYE.COM, edit at label BYECMD: (near end of file) as necessary.
;
RCPM EQU yes ; YES, if being used with a RCP/M system
;
; Note: If RCPM is YES, the following options are available. SZAPOK and
; NSWPOK are only available when WHEEL is on.
;
BYEOK EQU yes ; YES, exit system from within LUX
CHATOK EQU yes ; YES, if CHAT is available
NOTEOK EQU yes ; YES, if NOTE is available
SZAPOK EQU yes ; YES, if SuperZAP or similar is available
NSWPOK EQU yes ; YES, if NSWEEP is available
NULUOK EQU yes ; YES, if you want to use NULU or similar
;
; NUKMD and MBKMD differentiates between the "L" option (.LBR member
; extractions) and the "A" option (.ARK/.ARC member extractions), while
; KMD does not.
;
NUKMD EQU yes ; YES, if using NUKMD (v1.10 or higher)
MBKMD EQU no ; YES, if using MBKMD
KMD EQU no ; YES, if using KMD
;
; If you want users to use LUX to "enter" .ARK/.ARC files, but do not want
; to allow them to extract any individual members, set EXTARC to NO.
;
EXTARC EQU yes ; YES, if allowing .ARK/.ARC extractions
;
; ---
;
; The following equates define the drive/user area where each required
; .COM utility is to be found by LUX (i.e. TYPE, DIR, UNARC, LUXDIR,
; LUXCHK, LUXCRC, NUKMD, MBKMD, KMD, CHAT, NOTE, NSWEEP, ZAP and NULU).
;
; Note: DIR.COM is used for "DIR *.LBR" and "DIR *.AR?" displays, so
; can be most any kind. It is also used to provide support of
; the DU command which will allow full DIR command options as if
; outside of LUX.
; LUXDIR.COM is called by LUX to actually display an internal
; DIRectory listing of .LBR files.
; LUXCRC/CHK provides crc/checksum of file members.
; NUKMD/MBKMD/KMD provide file transfer support.
; TYPE.COM is LTxx, which displays normal ASCII, squeezed and
; crunched files -- also accepts wild cards.
; UNARC.COM is used for all .ARK/.ARC file manipulations.
; CHAT.COM is supplied by you for online CHAT in LUX.
; NOTE.COM is supplied by you (not needed if CHAT has NOTE feature).
; NULU.COM is NULU151 or higher for .LBR member manipulations (WHEEL).
; ZAP.COM is SUPZAP33 or higher (a disk editor - WHEEL).
; SWEEP.COM is NSWP207 or higher (general file maintenance - WHEEL).
;
; Place required drive letter between the quotations as shown.
;
TYPDRV EQU 'A' ; drive for TYPE.COM
TYPUSR EQU 0 ; and user number
DIRDRV EQU 'A' ; drive for DIR.COM and UNARC.COM
DIRUSR EQU 0 ; and user number
CHTDRV EQU 'A' ; drive for CHAT.COM
CHTUSR EQU 0 ; and user number
NOTDRV EQU 'A' ; drive for NOTE.COM
NOTUSR EQU 0 ; and user number
;
LDIRDR EQU 'B' ; drive for LUXDIR.COM
LDIRUS EQU 15 ; and user number
;
CHKDRV EQU 'B' ; drive for LUXCHK
CHKUSR EQU 15 ; and user number
CRCDRV EQU 'B' ; drive for LUXCRC
CRCUSR EQU 15 ; and user number
;
XFRDRV EQU 'A' ; drive for NUKMD/MBKMD/KMD
XFRUSR EQU 0 ; and user number
;
; -----
;
ZCPR EQU yes ; YES, if using nzcpr/zcmd/zcpr2/zcpr3
ZPRDRV EQU 3DH ; zcpr max drive location
ZPRUSR EQU 3FH ; zcpr max user location
WHEEL EQU 3EH ; zcpr wheel byte location
;
; Note: If ZCPR is YES, the following are only available (and extended
; command options will be shown in help menu) when WHEEL byte
; is ON. If ZCPR is NO and any of these are YES, they will be
; available to everyone...
;
; Place required drive letter between the quotations as shown.
;
LUDRV EQU 'A' ; drive for NULU
LUUSR EQU 15 ; and user number
ZAPDRV EQU 'A' ; drive for SuperZAP
ZAPUSR EQU 15 ; and user number
NSWDRV EQU 'A' ; drive for NSWEEP
NSWUSR EQU 15 ; and user number
;
; If running MBBS, PBBS or similar message base which sets a user's
; maximum accessible drive/user area, leave HARDCD set NO. If your
; message base does not do this, set HARDCD to YES which forces LUX
; to follow the HARD CODED choice...
;
HARDCD EQU no ; YES, use hard coded max values instead of
; BYE's maximum drive/user settings.
IF HARDCD
MAXDRV EQU 3 ; Max drive (0-15) 0=A, 1=B, etc...
MAXUSR EQU 5 ; Max user area (0-31)
ENDIF
;
; end of user configurable EQUates
;
; -----
;
VERS EQU 80 ; version number
MODLVL EQU ' ' ; modification level
BDOS EQU 5
TPA EQU 100H ; cpm program area
FCB1 EQU 5CH ; first file control block
FCB2 EQU 6CH ; second file control block
REBOOT EQU 0 ;
CBUFF EQU 80H ; default command buffer
;
; Macros used
;
DRVUSR MACRO DRIVNO,USERNO,FNCNAM,RTN1,RTN2,RTN3,RTN4
CALL FILTYP
DEFB DRIVNO+'A'
USERN1 DEFL USERNO
IF USERN1 GT 9
DEFB (USERN1 /10)+'0'
USERN1 DEFL USERN1-10
ENDIF
DEFB USERN1+'0'
DEFB ':'
DEFB FNCNAM
DEFB 0
IF NOT NUL RTN1
CALL RTN1
ENDIF
IF NOT NUL RTN2
CALL RTN2
ENDIF
IF NOT NUL RTN3
CALL RTN3
ENDIF
IF NOT NUL RTN4
CALL RTN4
ENDIF
JP PROCES
ENDM
;
DVUS MACRO DRIVNO,USERNO,FNCNAM,RTN1,RTN2,RTN3,RTN4
CALL FILTYP
DEFB DRIVNO+'A'
USERN2 DEFL USERNO
IF USERN2 GT 9
DEFB (USERN2 /10)+'0'
USERN2 DEFL USERN2-10
ENDIF
DEFB USERN2+'0'
DEFB ':'
DEFB FNCNAM
DEFB 0
ENDM
;
CMDJMP MACRO VERB,VECTOR
CALL ILCMP
DEFB VERB
DEFB 0
JP NC,VECTOR
ENDM
;
START EQU $
LD SP,SSTACK ; starting stack
CALL ILPRT
DEFB 13,10,'LUX v',(VERS/10)+'0','.'
DEFB (VERS MOD 10)+'0',MODLVL
DEFB ' 03/04/87 [tmb]',13,10,0
;
; set up max drive/user
;
IF HARDCD ; if HARDCD true, use spec'd values
LD A,MAXDRV ; hard coded max drive
LD (DRVMAX),A
LD A,MAXUSR ; hard coded max user
LD (USRMAX),A
;
ELSE
;
LD A,(ZPRDRV) ; if not HARDCD, use ZCPR maximums
LD (DRVMAX),A ; max drive
LD A,(ZPRUSR) ; max user
DEC A
LD (USRMAX),A
ENDIF
;
; check for a blank or null command line
;
LD A,(CBUFF+1) ; get byte from default command buffer
OR A ; if non-zero then there is a possible
JP NZ,GTDVUS ; file specified
;
SPCERR: CALL ILPRT ; print the error message
DEFB 13,10
DEFB '++ Examples of valid LUX commands ++',13,10
DEFB ' (Extension is optional)',13,10,10
DEFB ' LUX filename <- Attach to FILENAME'
DEFB ' on current drive/user',13,10
DEFB ' LUX A4:filename <- Attach to FILENAME'
DEFB ' on drive A:- USER 4',13,10
DEFB ' LUX B1:filename <- Attach to FILENAME'
DEFB ' on drive B:- USER 1',13,10,10
DEFB ' Note: FILENAME must be a .LBR/.ARK/.ARC file',13,10
DEFB 0
JP REBOOT ; reboot since we have destroyed the ccp
;
BDDRUS: CALL ILPRT
DEFB 13,10
DEFB '++ Invalid drive/user area ++',BELL,13,10,0
JP SPCERR
;
;
GTDVUS: LD HL,CBUFF+2 ; index default key buffer
CALL DRUSR ; get requested drive/user
JP C,SPCERR
;
; test for drive/user within range
;
PUSH BC ; save drive/user spec
PUSH HL ; save command line pointer
LD A,(DRVMAX) ; get max drive
CP C
JP C,BDDRUS
LD A,(USRMAX)
CP B
JP C,BDDRUS
POP HL
POP BC
LD (RQDDRV),BC ; set the requested drive/user
EX DE,HL ; de is source address to create new fcb
LD HL,FCB1 ; index fcb
CALL SCANR1 ; create the new fcb
;
; force the default file type
;
LD HL,'BL' ; set 'LB' into first two bytes of file type
LD (FCB1+9),HL
LD A,'R' ; set 'R' into last byte of file type
LD (FCB1+11),A
;
; get the library name from the fcb and store it
;
LD HL,FCB1 ; source for move
LD DE,LBRNAM-1 ; destination for move
LD BC,9 ; max 8 character filename
LDIR ; move to local name
;
AMBTST: LD HL,FCB1+1 ; first byte of filename
LD A,'?' ; character to look for
LD BC,11 ; search thru 11 bytes
CPIR ; do search
JR NZ,LOOKUP ; no ? found - continue
;
NOAMBG: CALL ILPRT ; print the error message
DEFB 13,10
DEFB '++ Ambiguous filename not allowed ++',BELL,13,10,0
JP SPCERR
;
; look for the filename on directory
;
LOOKUP: CALL GETOLD ; get the current drive/user
CALL SETNEW ; set requested drive/user
LD DE,80H ; default dma address
LD C,26
CALL BDOS ; set the dma address
;
LKUP00: LD DE,FCB1 ; index filename specified
LD C,17
CALL BDOS ; search for first
INC A ; does file exist?
JP NZ,LKUP1 ; yes, skip rest
LD A,(TRYCHR)
CP 'C' ; done with arc?
JP Z,LKUP01 ; yes, skip next
CP 'K' ; tried both already?
JP Z,NOFILE ; yes, report
LD HL,'RA' ; check for arc file
LD (FCB1+9),HL
LD A,'C'
LD (FCB1+11),A
LD (TRYCHR),A
JP LKUP00 ; loop back for test
;
LKUP01: LD A,'K' ; force .arK
LD (FCB1+11),A
LD (TRYCHR),A
JP LKUP00 ; loop back for test
;
LKUP1: LD A,(TRYCHR)
OR A ; .lbr?
JP Z,PGMSTR ; yes, else fall through
XOR A
LD (TRYCHR),A ; clear flag for later
LD A,0FFH ; set arcflg true
LD (ARCFLG),A
LD HL,FCB1
LD DE,LBRNAM-1 ; update library name (arc)
LD BC,12
LDIR
JP PGMSTR ; go do it
;
NOFILE: CALL ILPRT
DEFB 13,10,'Can''t find ',0
CALL DVUPRT ; show d/u
CALL NAMPRT ; show name of checked file
CALL ILPRT
DEFB ' - check the DIRectory...',BELL,13,10,10,0
CALL SETOLD
JP 0 ; reboot since we have destroyed the ccp
;
DEFS 64 ; 32 level stack for here
SSTACK EQU $
FINIS EQU $ ; finish of program loader
;
LODLEN EQU FINIS-START ; length of loader
; keep the program in line
DEFS 300H-LODLEN ; add extra bytes here to make
; 'PGMSTR' start on a 100h byte boundary
;
; -----
; this is the start of the relocated program - all of the code
; from 'START' to here is thrown away once lux begins execution
; -----
;
; set up the bdos and bios patches
;
PGMSTR: JP INIT ; jump to start of this module
DEFB 'LUX v8.0 [tmb]' ; the name 'LUX' is a clue to other
; programs that enables them to determine
; if lux is resident. 'L' is at bdos+3 when
; lux is resident
;
; this is the LUX removal routine, jumped to by the BYE command
; it is accessable to external programs, and is defined to exist at
; LUX+12 (looks like BDOS+12 when LUX is resident)
;
REMOVE: IF RCPM
LD SP,TPA+100H ; use the TPA for a stack
LD BC,0 ; first select A0:
CALL RESET
LD DE,80H ; clear the DMA buffer
PUSH DE
PUSH DE
LD B,80H ; bytes to clear
XOR A
;
RZRLP: LD (DE),A
INC DE
DJNZ RZRLP
LD A,BYELEN ; store away the length of the command
LD HL,BYECMD ; now move the commands to the DMA
LD (HL),A
POP DE ; restore the DMA addr
LD BC,BYELEN
LDIR
POP DE ; restore it again
LD C,26 ; reset the DMA
CALL BDOS
LD DE,SUBFCB ; address the .SUB file FCB
LD C,22 ; make the file
CALL BDOS
INC A ; check for errors
JR Z,EXITER ; oooops, no dir space
LD DE,SUBFCB ; else write the data
LD C,21
CALL BDOS
INC A
JR Z,EXITER ; oooops, no space left
LD DE,SUBFCB
LD C,16 ; now close the file
CALL BDOS
LD HL,0 ; now make the exit routine go to A0:
LD (OLDDRV),HL
ENDIF ;RCPM
;
JP UNPATH ; unpatch the jump table, and warm boot
;
; error handler for REMOVE routine
;
IF RCPM
EXITER: CALL ILPRT ; we had an error trying to make the .sub file
DB 13,10,BELL,'+ Error: Can''t remove LUX! Please +'
DB 13,10,'+ type CTRL-C to exit LUX, +'
DB 13,10,'+ then type BYE to logoff. +',0
LD SP,STACK ;
JP GETCMD ;
ENDIF
;
; this is the LUX intialization
;
INIT: LD HL,(1) ; get warm boot vector
LD (BIOS3),HL ; save old warm boot vector
LD HL,(6) ; get bdos start
LD (PGMSTR+1),HL ; set new jump to bdos
LD HL,PGMSTR ; get local bdos vector
LD (6),HL ; set it in low memory
LD SP,STACK ; reset stack
;
; save the old bios vectors
;
LD HL,(BIOS3) ; bios wboot address
LD DE,OWBOOT ; local wboot address
LD BC,12 ; 12 bytes to move
LDIR ; move the block
;
; set up the new bios vectors
;
LD HL,WBOOT ; source is local table
LD DE,(BIOS3) ; destination is old bios
LD BC,12 ; 12 bytes to move
LDIR ; move the block
LD A,0FFH ; set the auto-dir byte
LD (DOADIR),A ;
XOR A ; reset the error count
LD (HLPCNT),A ;
JP ENTRY ; initialize
;
OWBOOT: DEFB 0,0,0 ; old wboot vector is moved to here
OCONST: DEFB 0,0,0 ; old constat vector is moved to here
OCONIN: DEFB 0,0,0 ; old conin vector is moved to here
OCONOU: DEFB 0,0,0 ; old conout vector is moved to here
;
WBOOT: JP ENTRY ; vector warm boot to entry
CONST: JP VCONST ; check for carrier
CONIN: JP VCONIN ; vector conin to vconin
CONOU: JP VCONOU ; vector to conout
;
VCONST: JP OCONST ; jump to old constat routine
VCONOU: JP OCONOU ; jump to old conout routine
VCONIN: CALL OCONIN ; get a byte
CP 'C'-40H ; ^C?
JR Z,VCON1
CP 'K'-40H ; ^K?
JR Z,VCON1
CP 'X'-40H ; ^X?
RET NZ ; nope - let bios have it
;
VCON1: LD A,(ACTIVE) ; is lux segment active?
OR A
LD A,3
RET Z ; not active - let bios have it
LD SP,TPA ; re initialize the stack
CALL ILPRT
DEFB 13,10,10
DEFB ' >> exiting LUX - standby',0
;
UNPATH: LD HL,OWBOOT ; index old warm boot vector
LD DE,(BIOS3) ; bios jump table
LD BC,12 ; 12 bytes to move
LDIR ; move the old table back
CALL SETOLD ; set old drive/user
JP 0 ; warm boot - end of program
;
; This is the LUX entry point
;
ENTRY: LD SP,STACK ; set up local stack
LD HL,PGMSTR ; dummy bdos vector
LD (6),HL ; set it
LD HL,(BIOS3) ; bios warm boot vector
LD (1),HL ; set it
LD A,0C3H ; (jmp)
LD (0),A ; reset warm boot jump
LD (5),A ; ...and bdos jump
CALL OCONST ; see if character waiting
OR A ; test result
JR Z,ENTR1 ; ...if no character is waiting
CALL OCONIN ; get the console character
; this is done to gobble any
; possible garbage character
;
ENTR1: LD A,0FFH
LD (ACTIVE),A ; set LUX active
;
GETCMD: CALL SETNEW ; reset drive/user
LD IX,CBUFF+1 ; place to put command string
LD IY,CBUFF+0 ; length of command
XOR A
LD (IY+0),A
;
IF AUTODR
LD A,(DOADIR) ; shall we do a directory?
OR A
JR Z,PROMPT ; guess not
XOR A ; else zap the byte
LD (DOADIR),A
LD A,3 ; fake a DIR command
LD (CMDLEN),A
LD HL,'ID'
LD (CMDLIN+2),HL
LD L,'R'
LD H,0
LD (CMDLIN+4),HL
JP GOCNV ; and do it
ENDIF
;
PROMPT: IF HLPMSG
CALL ILPRT ; print the entry message
DEFB 13,10
DEFB '[ in LUX ^C, ^K or ^X exits -- ? for Command Menu ]'
DEFB 13,10,0
ENDIF
;
PRMPT2: CALL CRLF
CALL DVUPRT ; print the LUX prompt
CALL NAMPRT ; drive/user, library name
CALL ILPRT
DEFB ' -->',0
LD DE,CMDLIN ; index command line
LD C,10
CALL BDOS ; read console buffer
LD A,(CMDLEN) ; get command length
OR A ; test it
JP Z,GETCMD ; if null command
LD A,(CMDLIN+2) ; get first character
CP ';' ; ignore all after this?
JP Z,PRMPT2 ; yes
;
GOCNV: CALL CNVBUF ; convert the command line to upper case
;
GETCM4: LD DE,CMDLIN+2 ; index data from the command line
CMDJMP '?',QKHELP ; alternate for HELP
CMDJMP 'LUX',LUX ; lux command process
CMDJMP 'SD',SD ; normal DIR of d/u area with/without filespec
;
IF RCPM AND BYEOK
CMDJMP 'BYE',REMOVE ; Leave system via BYE - remove LUX first
ENDIF
;
IF RCPM AND CHATOK
CMDJMP 'CHAT',CHAT ; Chat with sysop if available
ENDIF
;
IF RCPM AND NOTEOK
CMDJMP 'NOTE',NOTE ; Leave note to sysop
ENDIF
;
LD A,(ARCFLG)
OR A ; in .arc file?
JR Z,LBRCMD ; nope, do .lbr cmds
CMDJMP 'TYPE',ATYPE ; view ASCII text file
CMDJMP 'DIR',UNARC
CMDJMP 'D',UNARC
CMDJMP 'FILES',AFILES ; display files (defaults to *.ARC)
CMDJMP 'LFILES',FILES ; display .LBR files
CMDJMP 'CHEK',UNARC ; CRC displayed with normal UNARC directory
CMDJMP 'CRCK',UNARC ; CRC displayed with normal UNARC directory
;
IF RCPM AND EXTARC
CMDJMP 'KMD',XFR
CMDJMP 'SEND',SENDA ; i.e. 'KMD A'
CMDJMP 'SENDK',SENDAK ; i.e. 'KMD AK'
ENDIF
;
JP LSTCHK ; Final check of NOGOTs before error
;
LBRCMD: CMDJMP 'TYPE',TIPE ; file type command process
CMDJMP 'DIR',DIR ; dir command process
CMDJMP 'D',DIR ; alternate for DIR
CMDJMP 'FILES',FILES ; display files (defaults to *.LBR)
CMDJMP 'AFILES',AFILES ; display .ARC files
CMDJMP 'CHEK',CHEK ; run lchek
CMDJMP 'CRCK',CRCK ; run lcrck
;
IF RCPM
CMDJMP 'KMD',XFR
CMDJMP 'SEND',SEND ; i.e. 'KMD L'
CMDJMP 'SENDK',SENDK ; i.e. 'KMD LK'
ENDIF
;
IF ZCPR AND RCPM AND (NULUOK OR SZAPOK OR NSWPOK)
LD A,(WHEEL)
OR A ; WHEEL?
JP Z,LSTCHK ; No, skip NULU and check NOGOTs before error
ENDIF
;
IF NULUOK
CMDJMP '-L',LOAD ; load NULU in command mode and display dir
CMDJMP '-F',FSWP ; load NULU in filesweep mode
ENDIF
;
IF SZAPOK
CMDJMP 'ZAP',SZAP ; Run disk-editor
ENDIF
;
IF NSWPOK
CMDJMP 'SWEEP',NSWP ; Run NSWEEP
ENDIF
;
; If there are other commands a user may use on your system, and you want
; to tell him to exit LUX first, then enter below: CMDJMP 'cmd',NOGOT.
; Place your command in 'cmd' and it will tell the user that that command
; is only available outside of LUX.
;
LSTCHK: IF RCPM
CMDJMP 'command',NOGOT ; tell user NOGOT here
ENDIF
;
; this is where the actual error is displayed after all other checks fail...
;
; ERROR --> dur <-- is not a valid LUX command.
;
CMDERR: CALL ILPRT
DEFB 13,10,10,'ERROR --> ',0
CALL PRTERR ; display the command just entered
KPTRYN: CALL ILPRT
DEFB ' <-- Is not a valid LUX command.',BELL,13,10,0
LD HL,HLPCNT ; get error counter
INC (HL) ; bump it up one
LD A,HLPERS ; get error limit
CP (HL) ; reached it?
JP NZ,GETCMD ; no, skip rest and try again, else...
LD (HL),0 ; reset the count
JP QKHELP ; and give help anyway
;
PRTERR: LD HL,CMDLIN+2 ; index command just entered
LD A,(CMDLEN) ; get the length
LD B,A ; into 'B'
GETCM5: LD A,(HL) ; get a byte
CP ' ' ; space ?
JR Z,GETCM6 ; yes - dont print it
CP 0 ; null
JR Z,GETCM6 ; yes - all done
CALL CTYPE ; print the character
INC HL ; next character
DJNZ GETCM5 ; loop for the rest
;
GETCM6: RET
;
; COMMAND TRANSLATION VECTORS
;
; SUMMARY OF AUX ROUTINES:
;
; 'FILTYP' installs the following 'DEFB' into new command line
; specify the drive and user area for each command as in
; the vectors below. remember each 'DEFB' must end with a
; zero.
;
; 'FILNAM' installs the current .lbr name into the new command line
;
; 'FILSPC' installs a space character into the new command line
;
; 'FILMEM' installs the requested member name into the new command line
;
;
TIPE: DRVUSR TYPDRV-41H,TYPUSR,'TYPE ',FILNAM,FILSPC,FILMEM
ATYPE: DRVUSR TYPDRV-41H,TYPUSR,'UNARC ',FILNAM,FILSPC,FILMEM
;
DIR: DRVUSR LDIRDR-41H,LDIRUS,'LUXDIR ',FILNAM,FILSPC,FILMEM
UNARC: DRVUSR DIRDRV-41H,DIRUSR,'UNARC ',FILNAM
;
SD: DRVUSR DIRDRV-41H,DIRUSR,'DIR',FILSPC,FILMEM
FILES: DRVUSR DIRDRV-41H,DIRUSR,'DIR *.LBR'
AFILES: DRVUSR DIRDRV-41H,DIRUSR,'DIR *.AR?'
;
CHEK: DRVUSR CHKDRV-41H,CHKUSR,'LUXCHK ',FILNAM,FILSPC,FILMEM
CRCK: DRVUSR CRCDRV-41H,CRCUSR,'LUXCRC ',FILNAM,FILSPC,FILMEM
;
IF RCPM AND CHATOK
CHAT: DRVUSR CHTDRV-41H,CHTUSR,'CHAT'
ENDIF
;
IF RCPM AND NOTEOK
NOTE: DRVUSR NOTDRV-41H,NOTUSR,'NOTE'
ENDIF
;
IF SZAPOK
SZAP: DRVUSR ZAPDRV-41H,ZAPUSR,'ZAP ',FILSPC,FILMEM
ENDIF
;
IF NSWPOK
NSWP: DRVUSR NSWDRV-41H,NSWUSR,'SWEEP ',FILSPC,FILMEM
ENDIF
;
IF RCPM
SEND: DRVUSR XFRDRV-41H,XFRUSR,'KMD L ',FILNAM,FILSPC,FILMEM
SENDK: DRVUSR XFRDRV-41H,XFRUSR,'KMD LK ',FILNAM,FILSPC,FILMEM
ENDIF
;
IF RCPM AND (NUKMD OR MBKMD) AND EXTARC
SENDA: DRVUSR XFRDRV-41H,XFRUSR,'KMD A ',FILNAM,FILSPC,FILMEM
SENDAK: DRVUSR XFRDRV-41H,XFRUSR,'KMD AK ',FILNAM,FILSPC,FILMEM
ENDIF
;
IF NULUOK
LOAD: DVUS LUDRV-41H,LUUSR,'NULU -O '
CALL FILNAM
CALL FILTYP ; * load NULU in command mode *
DEFB ' -L',0 ; * and display the directory *
JP PROCES
;
FSWP: DVUS LUDRV-41H,LUUSR,'NULU -O '
CALL FILNAM
CALL FILTYP
DEFB ' -F',0 ; * load NULU in filesweep mode *
JP PROCES
;
; parse the ambiguous user/drive spec & filename, and place in command line
;
AFNPRS: CALL FNDSPC ; find the first space
JP C,CMDERR ; error if all scanned and no space
CALL ADVANC ; advance to next non-blank
JP C,CMDERR ; premature eol is error
PUSH IX ; drusr uses this ...
CALL DRUSR ; get drive/user, if any
POP IX
OR A ; did drive/user change?
JP Z,SKPDVU
PUSH BC ; skip over the drive spec in cmd line
LD B,A ; get bytes to skip
LD HL,NXTWRD ; address cmd pointer
;
SKPTR: INC (HL)
DJNZ SKPTR
POP BC ; restore user/drive spec
CALL BDSDVU ; convert to BDS usr/drv
JP C,BDDRUS ; if cy, then limits exceeded
;
SKPDVU: CALL FILMEM ; the rest is normal stuff
JP PROCES
ENDIF ;NULUOK
;
; quick help summary
;
QKHELP: CALL ILPRT
DEFB 13,10,10
DEFB 'You are "inside" an .LBR or .ARC file via LUX and may',13,10
DEFB 'manipulate file members using these commands:',13,10,10
DEFB '? - Displays this help menu'
DEFB 13,10
DEFB 'DIR or D - Display DIRectory of file members'
DEFB 13,10
DEFB 'SD du: - Display full external du: DIRectory'
DEFB 13,10
DEFB ' (du:filename.ext or *.??? optional)'
DEFB 13,10
DEFB 'LUX filename - Attach to another .LBR/.ARC file'
DEFB 13,10
DEFB 'FILES - Display current type files this du:'
DEFB 13,10,0
LD A,(ARCFLG)
OR A ; in .arc file?
JP NZ,QKHLP1 ; Yes, don't show AFILES option
CALL ILPRT
DEFB 'AFILES - Display .ARC files this du:'
DEFB 13,10,0
JR QKHLP2 ; skip LFILES option
;
QKHLP1: CALL ILPRT
DEFB 'LFILES - Display .LBR files this du:'
DEFB 13,10,0
;
QKHLP2: CALL ILPRT
DEFB 'TYPE filename.ext - View ASCII text files'
DEFB 13,10
DEFB 'CHEK filename.ext - Get CRC on .LBR/.ARC member'
DEFB 13,10
DEFB 'CRCK filename.ext - Get CRC on .LBR/.ARC member'
DEFB 13,10
;
IF RCPM AND EXTARC
DEFB 'SEND filename.ext - Sends .LBR/.ARC member using'
ENDIF
;
IF RCPM AND (NOT EXTARC)
DEFB 'SEND filename.ext - Sends .LBR member using'
ENDIF
;
IF RCPM
DEFB 13,10
DEFB ' automatic protocol detect'
DEFB 13,10
ENDIF
;
IF RCPM AND EXTARC
DEFB 'SENDK filename.ext - Sends .LBR/.ARC member manually'
ENDIF
;
IF RCPM AND (NOT EXTARC)
DEFB 'SENDK filename.ext - Sends .LBR member manually'
ENDIF
;
IF RCPM
DEFB 13,10
DEFB ' setting 1k Ymodem protocol'
DEFB 13,10
DEFB 'KMD S filename.ext - Same as SEND'
DEFB 13,10
DEFB 'KMD SK filename.ext - Same as SENDK'
DEFB 13,10
ENDIF
;
IF RCPM AND CHATOK
DEFB 'CHAT - CHAT with Sysop (if available)'
DEFB 13,10
ENDIF
;
IF RCPM AND NOTEOK
DEFB 'NOTE - Leave private note to Sysop'
DEFB 13,10
ENDIF
;
IF RCPM AND BYEOK
DEFB 'BYE - Log off system {Goodbye...}'
DEFB 13,10
ENDIF
;
IF NOT HLPMSG
DEFB 13,10,'[ in LUX ^C exits, ? for Command Menu ]',13,10
ENDIF
;
DEFB 0
;
IF RCPM AND ZCPR AND (NULUOK OR SZAPOK OR NSWPOK)
LD A,(WHEEL) ; should we display extended commands?
OR A
JP Z,GETCMD ; if wheel byte is reset, no
CALL ILPRT
DEFB 13,10,'[Hit any key] ',0
LD C,1
CALL BDOS
ENDIF
;
IF NULUOK OR SZAPOK OR NSWPOK
CALL ILPRT
DEFB 13,' ++ Extended Commands ++',13,10,10
ENDIF
;
IF SZAPOK
DEFB 'ZAP - SuperZAP Disk-Editor'
DEFB ' (du:filename.ext optional)'
DEFB 13,10
ENDIF
;
IF NSWPOK
DEFB 'NSWEEP - Disk/File maintenance'
DEFB ' (du:filename.ext optional)'
DEFB 13,10
ENDIF
;
IF NULUOK OR SZAPOK OR NSWPOK
DEFB 0
ENDIF
;
IF NULUOK
LD A,(ARCFLG)
OR A ; in .arc file?
JP NZ,GETCMD ; Yes, NULU unavailable
CALL ILPRT
DEFB '-L - Load NULU in command mode and display'
DEFB ' DIRectory',13,10
DEFB '-F - Load NULU in filesweep mode'
DEFB 13,10,10,0
ENDIF
;
JP GETCMD
;
; Tried entering a command specifically set as NOGOT -- tell user to exit
; LUX and use the command in normal CP/M.
;
NOGOT: CALL CRLF
CALL CRLF
CALL PRTERR ;print the command
CALL ILPRT ;and then this
DEFB ' <-- command only used in CP/M, must exit LUX with ^C'
DEFB BELL,13,10,10 ;ring bell and point at the error
DEFB 0
JP GETCMD ;go back for another command
;
; NUKMD/MBKMD can handle the 'L' option, while KMD can't.
;
IF RCPM
XFR: CALL ADVANC ; go to next character
LD A,(HL) ; get the character
CP 'S' ; upload?
JR Z,XFR1 ; check for 'K'
CP 'R' ; upload?
JR Z,XFR2 ; no can do...
CP 'L' ; .LBR?
ENDIF
;
IF RCPM AND (NUKMD OR MBKMD)
JR NZ,XFR0 ; no, check for 'A'
LD A,(ARCFLG)
OR A ; in .ARC file?
JR Z,XFR1 ; no, leave as is, else...
LD (HL),'A' ; replace 'L' with 'A'
JR XFR1
ENDIF
;
IF RCPM AND KMD
JR Z,XFR3 ; KMD can't handle 'L' option
ENDIF
;
XFR0: IF RCPM AND EXTARC
CP 'A' ; .ARC?
JR Z,XFR1 ; yes, check for 'K'
ENDIF
;
IF RCPM
DRVUSR XFRDRV-41H,XFRUSR,'KMD'
;
XFR1: INC HL ; get next chr
LD A,(HL)
CP ' ' ; space?
JR Z,XFR1A ; yes
CP 'K' ; 1k request?
JR Z,XFRK ; yes
;
XFR1A: CALL NXTSPC
ENDIF
;
IF RCPM AND EXTARC
LD A,(ARCFLG) ; Are we in an arc file?
OR A
JP NZ,SENDA ; Yes, send arc
ENDIF
;
IF RCPM
JP SEND ; No, send regular
;
XFRK: CALL NXTSPC
ENDIF
;
IF RCPM AND EXTARC
LD A,(ARCFLG) ; Are we in an arc file?
OR A
JP NZ,SENDAK ; Yes, send arc
ENDIF
;
IF RCPM
JP SENDK ; Nope, send regular
;
XFR2: CALL CRLF
CALL PRTERR ; print the command
CALL ILPRT ; print the following
DEFB ' can''t (R)eceive while in LUX',BELL,13,10,0
JP GETCMD ; return to command
ENDIF
;
IF RCPM AND KMD
XFR3: CALL CRLF
CALL PRTERR ; print the command
CALL ILPRT ; print the following
DEFB ' use S or SK options while in LUX',BELL,13,10,0
JP GETCMD
ENDIF
;
; 'LUX' command process
;
LUX: LD A,(CMDLEN) ; get the length of the command line
CP 3 ; was input only 'LUX'
JP Z,LUX04 ; error...
CALL FNDSPC ; find a space in command line
JP C,LUX05 ; error if no space found
CALL ADVANC ; search for the next non-blank character
JP C,LUX05 ; error if no more characters left
CALL DRUSR ; get drive/user
JP C,LUX05 ; if drive/user specification error
LD (TMPDRV),BC ; save the temporary drive/user
PUSH BC ; save drive/user spec
PUSH HL ; save command line pointer
LD A,(DRVMAX) ; get max drive
CP C
JP C,LUX03 ; if out of range
LD A,(USRMAX)
CP B
JP C,LUX03 ; if out of range
POP HL
POP BC
EX DE,HL ; de is source address to create new fcb
LD HL,TMPFCB ; index temporary fcb
CALL SCANR1 ; create the new fcb
LD HL,'BL' ; set 'LB' into first two bytes of file type
LD (TMPFCB+9),HL
LD A,'R' ; set 'R' into last byte of file type
LD (TMPFCB+11),A
CALL SETTMP ; log into the requested drive/user
;
LUX000: LD DE,80H
LD C,26 ; bdos set dma function
CALL 5 ; set dma address to 80h
LD DE,TMPFCB ; index temporary fcb
LD C,17 ; bdos search first function
CALL 5
INC A ; test for existence
JR NZ,LUX01 ; OK, go
LD A,(TRYCHR)
CP 'C' ; done with arc?
JP Z,LUX001 ; yes, skip next
CP 'K' ; tried both already?
JP Z,LUX05 ; Yes, report
LD HL,'RA' ; check for arc file
LD (TMPFCB+9),HL
LD A,'C'
LD (TMPFCB+11),A
LD (TRYCHR),A
JP LUX000 ; loop back for test
;
LUX001: LD A,'K' ; force .arK
LD (TMPFCB+11),A
LD (TRYCHR),A
JP LUX000 ; loop back for test
;
LUX01: LD A,(TRYCHR)
OR A ; .lbr?
JP Z,LUX01X ; yes, else fall through
LD (ARCFLG),A ; set flag true
XOR A
LD (TRYCHR),A ; clear flag for later use
JP LUX02
;
LUX01X: XOR A ; clear register
LD (ARCFLG),A ; set flag false
;
LUX02: LD HL,(TMPDRV) ; get temporary drive/user
LD (RQDDRV),HL ; set new drive/user
LD HL,TMPFCB+1 ; source address of new name
LD DE,LBRNAM ; current .lbr name
LD BC,12 ; 8 character file name
LDIR ; move it
CALL CRLF ; for neatness
LD A,0FFH ; set the auto-directory flag
LD (DOADIR),A
JP GETCMD
;
LUX03: POP HL
POP BC
;
LUX04: CALL ILPRT
DEFB 13,10,'++ Invalid drive/user number ++',BELL,13,10,0
JP GETCMD
;
LUX05: CALL ILPRT
DEFB 13,10,10,'Can''t find ',0
CALL DVUPR1
LD B,8
LD HL,TMPFCB+1
CALL NAMPR1 ; print the file name
CALL ILPRT
DEFB 8,8,8
DEFB 'LBR/.ARK/.ARC - check your spelling',BELL,13,10,0
XOR A
LD (TRYCHR),A ; clear flag for later use
JP GETCMD
;
PROCES: XOR A ; zero last byte of new command line
LD (IX+0),A
LD HL,CBUFF+1
LD (HLPCNT),A ; reset the error count
CALL DRUSR ; get drive/user
LD (COMDRV),BC ; set the com drive/user
EX DE,HL ; de is source address to create new fcb
CALL SCANER ; create the new fcb
EX DE,HL ; into 'HL'
LD DE,CBUFF+1 ; start of command buffer
PUSH HL
PUSH DE
OR A ; clear any cy
SBC HL,DE ; calculate length of move
LD A,(CBUFF) ; get command line length
SUB L ; calculate new length
LD (CBUFF),A ; put new length
LD A,7EH ; calculate length of block move
SUB L
LD C,A ; set into c
LD B,0 ; 'b' gets zero
POP DE ; restore destination
POP HL ; and source
LDIR ; move the block down
LD HL,FCB1 ; set up first fcb
LD DE,CBUFF+1
CALL SCANR1
LD HL,FCB2 ; set up second fcb
CALL SCANR1
;
; force the default file type (.com)
;
LD HL,'OC' ; 'CO'
LD (DEFFCB+9),HL
LD A,'M' ; 'M'
LD (DEFFCB+11),A
XOR A ; zero the record count and
; the extent number
LD (DEFFCB+15),A
LD (DEFFCB+32),A
CALL SETCOM ; set com drive/user
LD DE,TPA
LD C,1AH
CALL BDOS ; set dma to tpa
LD DE,DEFFCB
LD C,11H
CALL BDOS ; search for first
INC A
JR NZ,PROCE1 ; file found
CALL ILPRT
DEFB 13,10,'Can''t find ',0
LD B,8
LD HL,DEFFCB+1
CALL NAMPR1 ; print the file name
CALL ILPRT ; cr/lf
DEFB BELL,13,10,0
JP ENTRY ; go for more commands
;
PROCE1: LD DE,TPA
LD C,1AH
CALL BDOS ; set dma to tpa
LD DE,DEFFCB
LD C,0FH
CALL BDOS ; open file
INC A
JR NZ,PROCE2
CALL ILPRT
DEFB 13,10,'.COM File error - notify SYSOP',BELL,BELL,13,10,0
JP ENTRY
;
; load the .com file into memory @100h and call it
;
PROCE2: LD HL,80H
LD DE,80H
;
LODCOM: ADD HL,DE ; add record size offset
EX DE,HL ; get dma address into 'DE'
PUSH DE ; save 'DE' and 'HL'
PUSH HL
LD C,1AH
CALL BDOS ; set dma
LD DE,DEFFCB ; index .com file name
LD C,14H
CALL BDOS ; read a record
POP HL ; restore 'DE' and 'HL'
POP DE
EX DE,HL ; 'HL' is dma address again
OR A ; end of file ?
JR Z,LODCOM ; no - read another record
LD C,13
CALL BDOS ; reset drive system
CALL SETNEW ; set new drive/user
XOR A
LD (ACTIVE),A ; clear command mode active
CALL CRLF
CALL TPA ; call the loaded file @100h
LD DE,35 ; zero out fcb1
LD HL,FCB1
;
ZEROFCB: LD (HL),0
INC HL
DJNZ ZEROFCB
JP ENTRY ; go for more commands
;
NAMPRT: LD B,8 ; 8 character file name
LD HL,LBRNAM ; index .lbr name
;
NAMPR1: LD A,(HL) ; get a byte
CP ' ' ; space?
JR Z,NAMPR2 ; yes - dont print
CALL CTYPE ; else print the character
;
NAMPR2: INC HL ; next character
DJNZ NAMPR1 ; process 8 characters
LD A,'.' ; print a seperator
CALL CTYPE
LD B,3 ; 3 character file type
;
NAMPR3: LD A,(HL) ; get a character
CALL CTYPE ; print it
INC HL ; next character
DJNZ NAMPR3 ; process 3 characters
RET
;
; write a string of characters to the crt
;
ILPRT: EX (SP),HL ; save return address/get character pointer
;
ILPRT1: LD A,(HL) ; get a byte
OR A ; test it
JR Z,ILPRT2 ; null - end of string
CALL CTYPE ; else type the character
INC HL ; next character
JR ILPRT1 ; loop for more
;
ILPRT2: INC HL
EX (SP),HL ; restore return address
RET ; return to caller
;
; write a string of characters to the command line
;
; works like ilprt above
;
FILTYP: EX (SP),HL
;
FILTY1: LD A,(HL)
OR A
JR Z,FILTY2
CALL PUTIN
INC HL
JR FILTY1
;
FILTY2: EX (SP),HL
RET
;
; fill command line with a space
;
FILSPC: LD A,' '
CALL PUTIN ; fill in
RET
;
; fill command line with .lbr name
;
FILNAM: LD B,8 ; 8 character file name
LD HL,LBRNAM ; index .lbr name
;
FILNA1: LD A,(HL) ; get a character
CP ' ' ; space ?
JR Z,FILNA2 ; yes - dont add to command line
CALL PUTIN ; put character into command line
;
FILNA2: INC HL ; next character
DJNZ FILNA1 ; process 8 characters
LD A,'.' ; put in a seperator character
CALL PUTIN
LD B,3 ; 3 character file type
;
FILNA3: LD A,(HL) ; get a character
CALL PUTIN ; put in command line
INC HL ; next character
DJNZ FILNA3 ; process 3 characters
RET ; return to caller
;
; fill command line with member name
;
FILMEM: CALL PARSER ; parse member name
LD HL,MEMBER ; index member name
LD B,12 ; 12 character max
;
FILME1: LD A,(HL) ; get a byte
OR A ; end of input
RET Z ; yes - return
CALL PUTIN ; fill in one character
INC HL ; next character
DJNZ FILME1 ; continue looping
RET ; done
;
PUTIN: LD (IX+0),A ; stuff the character into command line
INC IX ; get ready for next character
INC (IY+0) ; bump command line length
RET ; return to caller
;
; parse out a member name
;
PARSER: LD HL,MEMBER ; index member name
LD B,12 ; max 12 character filename
;
PARSE1: LD (HL),0 ; zero character
INC HL ; next character
DJNZ PARSE1 ; clear the entire member name
CALL ADVANC ; advance to the next non blank character
RET C ; if at the end of the line
LD DE,MEMBER ; de is index to member (hl set by advanc)
LD HL,(NXTWRD)
;
PARSE2: LD A,(HL) ; get source byte
OR A ; end of input line ?
RET Z ; yes - return
LD (DE),A ; put byte
INC HL ; next source
INC DE ; next destination
JR PARSE2 ; continue looping
;
; advanc - advance the word at nxtwrd to the next non blank address
; of the command line. set carry if no more characters available
;
ADVANC: LD HL,(NXTWRD) ; get pointer to next word
;
ADVAN1: LD A,(HL) ; get a byte
OR A ; test flags
JR Z,ADVAN3 ; error - null character
CP ' ' ; space ?
JR NZ,ADVAN2 ; yes - done
INC HL
LD (NXTWRD),HL ; put pointer back
JR ADVAN1 ; loop for more
;
ADVAN2: OR A ; clear any carry
RET
;
ADVAN3: SCF ; set error condition
RET
;
FNDSPC: LD HL,CMDLIN+2 ; index command line
;
FND01: LD A,(HL) ; get a byte from command line
OR A ; eol ?
JP Z,FNDER ; error...
CP ' ' ; space?
JP Z,FNDEX ; ...yes - go find requested file name
INC HL ; next character
JR FND01 ; else continue the search
;
FNDER: SCF ; all characters scanned and no space found
RET ;
;
FNDEX: LD (NXTWRD),HL ; set character location
OR A ; assure carry reset
RET ;
;
NXTSPC: LD HL,(NXTWRD) ; get pointer to next word
;
NXTSP1: LD A,(HL) ; get a byte
OR A ; is it a null?
JR Z,NXTSP2 ; ...yes - return
CP ' ' ; if at a space?
JR Z,NXTSP2 ; ...yes - return
INC HL ; next character
JR NXTSP1 ; and continue looking
;
NXTSP2: LD (NXTWRD),HL
RET
;
; in-line compare. compares string addressed by 'de' to string after
; call (ends with zero). return with carry set means strings not the
; same. all registers except 'a'-reg are unaffected.
;
ILCMP: EX (SP),HL
PUSH DE
;
ILCMP1: LD A,(HL) ; get a byte from source
OR A ; null
JR Z,SAME1 ; yes - same so far - test next char
LD A,(DE) ; get a byte from command string
CP (HL) ; same as source
JR NZ,NOTSAM ; no - not the same
INC HL ; next source
INC DE ; next compare
JR ILCMP1 ; loop again
;
NOTSAM: XOR A ; zero for the test
;
NSLP: INC HL ; next immediate byte
CP (HL) ; null yet ?
JR NZ,NSLP ; no - continue
;
SAME2: SCF ; set error condition
;
SAME: EX DE,HL ; get command string pointer
LD (NXTWRD),HL ; store it
EX DE,HL ; restore return address
POP DE ; restore source address
INC HL ; adjust to stack
EX (SP),HL ; replace return address/
RET ; return
;
SAME1: LD A,(DE) ; get the next byte from command line
OR A ; null ?
JR Z,SAME ; yes - its ok
CP ' ' ; space ?
JR Z,SAME ; yes - thats ok too...
JR SAME2 ; not ok- must be another character
;
CTYPE: PUSH AF ; save all registers
PUSH BC
PUSH DE
PUSH HL
AND 7FH ; be sure its ascii
LD E,A ; into 'E'
LD C,2 ; cpm console function
CALL BDOS
POP HL ; restore all registers
POP DE
POP BC
POP AF
RET ; return to caller
;
CRLF: CALL ILPRT
DEFB 13,10,0
RET
;
; get the drive and user number for a file from command string
; index by 'HL'
;
; on entry:
;
; 'HL' points to first byte of the command string
;
; on exit:
;
; 'HL' points to the byte following ':' in the command string if
; the ':' was found in the first 4 character positions.
; -or-
; 'HL' points to the first byte of the command string if no ':'
; was found.
;
; 'C' contains the requested drive number (0-15)
; 'B' contains the requested user number (0-15)
; 'AF' the number of characters thru the ':' in the command string.
; 'CY' is set if drive or user number is out of range (0-15)
;
DRUSR: LD (TEMPHL),HL ; save the pointer address
LD IX,(TEMPHL) ; 'IX' get the pointer address
LD BC,5 ;
LD A,':'
CPIR ; search for the ':'
LD A,C ; get 'B' result from 'CPIR' instruction
LD (LENGTH),A ; keep for possible adjust
EX DE,HL ; de points to the byte following ':'
LD HL,VTABLE ; index address table
ADD HL,BC ; add word offset
ADD HL,BC
LD A,(HL) ; get routine lsb
INC HL
LD H,(HL) ; get routine msb
LD L,A
LD BC,0 ; set up drive/user storage
JP (HL) ; execute
;
VTABLE: DEFW DRUS0 ; b=0 - filename.ext
DEFW DRUS1 ; b=1 - a15:filename.ext
DEFW DRUS2 ; b=2 - a1:filename.ext
DEFW DRUS3 ; b=3 - a:filename.ext
DEFW DRUS4 ; b=4 - :filename.ext
;
; format was - filename.ext
;
DRUS0: CALL GETDFU ; get the default user
CALL GETDFD ; get the default drive
LD HL,(TEMPHL) ; get old buffer pointer back
XOR A ; zero move length
RET ; all done
;
; format was - duu:filename.ext
;
DRUS1: CALL GETDRV ; get the drive parameter
LD A,(IX+0)
CP '0'
JR C,ERROR
CP '9'+1
JR NC,ERROR
SUB '0'
LD B,A ; put in drive number
SLA B ; * 2
SLA B ; * 4
SLA B ; * 8
ADD A,A ; a * 2
ADD A,B ; + c
LD B,A
INC IX ; skip the tens digit
JR GETUSR ; get the user number
;
; format was - du:filename.ext
;
DRUS2: CALL GETDRV ; get the drive parameter
JR GETUSR ; get the user number
;
; format was - d:filename.ext
;
DRUS3: CALL GETDRV ; get the drive parameter
CALL GETDFU ; get the default user
;
; format was - :filename.ext
;
DRUS4: JR DRUS5
;
GETDRV: LD A,(IX+0)
CP 'A'
JR C,ERROR1
CP 'Q'
JR NC,ERROR1
SUB 'A'
LD C,A ; put in drive number
INC IX
RET
;
GETUSR: LD A,(IX+0)
CP '0'
JR C,ERROR
CP '9'+1
JR NC,ERROR
SUB '0'
ADD A,B
LD B,A
;
; adjust the byte in 'LENGTH'
;
DRUS5: EX DE,HL ; hl points to byte following ':' if any
LD A,(LENGTH) ; get length of move
OR A ; test it
RET Z ; return if null/ clear carry
LD E,A
LD A,5
SUB E
LD (LENGTH),A
OR A ; clear any error
RET
;
ERROR1: POP DE ; kill return address from subroutine
;
ERROR: SCF ; set error condition
RET
;
; get default user
;
GETDFU: PUSH BC
PUSH DE
PUSH HL
LD C,20H
LD E,0FFH
CALL BDOS
POP HL
POP DE
POP BC
LD B,A ; set 'B' register to current user
RET
;
; get default drive
;
GETDFD: PUSH BC
PUSH DE
PUSH HL
LD C,19H
CALL BDOS
POP HL
POP DE
POP BC
LD C,A ; set 'C' register to current drive
RET
;
; convert the drive/user bytes in BC to a BDS-C user/drive specification
; and place in command line
;
BDSDVU: PUSH BC ; save drive/user spec
PUSH HL ; save command line pointer
LD A,(DRVMAX) ; check for max's exceeded
CP C
JP C,DUERR
LD A,(USRMAX)
CP B
JP C,DUERR
POP HL
POP BC
LD A,B ; get the user number
CP 10 ; is it less than 10?
JR C,BDS2 ; yes, don't insert the '1'
LD A,'1'
CALL PUTIN
LD A,B ; reget the user number
SUB 10 ; subtract 10
;
BDS2: ADD A,'0' ; add in ascii bias
CALL PUTIN
LD A,'/' ; now the stupid bds-c slash
CALL PUTIN
LD A,C ; get the drive number
ADD A,'A' ; add ascii bias
CALL PUTIN
LD A,':'
CALL PUTIN
XOR A ; to indicate successfullness
RET
;
DUERR: POP HL ; justify the stack
POP BC
SCF ; error flag
RET
;
; extract token from command line and place it into deffcb;
; format deffcb fcb if token resembles file name and type (filename.typ);
; on input, cibptr pts to char at which to start scan;
; on output, cibptr pts to char at which to continue and zero flag is reset
; if '?' is in token
;
; entry points:
; scaner - load token into first fcb
; scanr1 - load token into fcb pted to by hl
;
SCANER: LD HL,DEFFCB ; point to deffcb
;
SCANR1: XOR A ; set temporary drive number to default
LD (TEMPDR),A
CALL ADVNCE ; skip to non-blank or end of line
LD (CIPTR),DE ; set ptr to non-blank or end of line
LD A,(DE)
OR A
JR Z,SCANR2
SBC A,'A'-1
LD B,A
INC DE
LD A,(DE)
CP ':'
JR Z,SCANR3
DEC DE
;
SCANR2: LD A,(TDRIVE) ; set 1st byte of deffcb as default drive
LD (HL),A
JR SCANR4
;
SCANR3: LD A,B
LD (TEMPDR),A
LD (HL),B
INC DE
;
SCANR4: XOR A ; a=0
LD (QMCNT),A ; init count of number of question marks in fcb
LD B,8 ; max of 8 chars in file name
CALL SCANF ; fill fcb file name
;
; extract file type from possible filename.typ
;
LD B,3 ; prepare to extract type
CP '.' ; if (de) delimiter is a '.', we have a type
JR NZ,SCANR5 ; fill file type bytes with <sp>
INC DE ; pt to char in command line after '.'
CALL SCANF ; fill fcb file type
JR SCANR6 ; skip to next processing
;
SCANR5: CALL SCANF4 ; space fill
;
; fill in ex, s1, s2, and rc with zeroes
;
SCANR6: LD B,4 ; 4 bytes
;
SCANR7: INC HL ; pt to next byte in deffcb
LD (HL),0
DJNZ SCANR7
;
; scan complete -- de pts to delimiter byte after token
;
LD (CIBPTR),DE
;
; set zero flag to indicate presence of '?' in filename.typ
;
LD A,(QMCNT) ; get number of question marks
OR A ; set zero flag to indicate any '?'
RET
;
; scanf -- scan token pted to by de for a max of b bytes; place it into
; file name field pted to by hl; expand and interpret wild cards of
; '*' and '?'; on exit, de pts to terminating delimiter
;
SCANF: CALL SDELM ; done if delimiter encountered - <sp> fill
JR Z,SCANF4
INC HL ; pt to next byte in deffcb
CP '*' ; is (de) a wild card?
JR NZ,SCANF1 ; continue if not
LD (HL),'?' ; place '?' in deffcb and dont advance de if so
CALL SCQ ; scanner count question marks
JR SCANF2
;
SCANF1: LD (HL),A ; store filename char in deffcb
INC DE ; pt to next char in command line
CP '?' ; check for question mark (wild)
CALL Z,SCQ ; scanner count question marks
;
SCANF2: DJNZ SCANF ; decrement char count until 8 elapsed
;
SCANF3: CALL SDELM ; 8 chars or more - skip until delimiter
RET Z ; zero flag set if delimiter found
INC DE ; pt to next char in command line
JR SCANF3
;
; fill memory pointed to by hl with spaces for b bytes
;
SCANF4: INC HL ; pt to next byte in deffcb
LD (HL),' ' ; fill filename part with <sp>
DJNZ SCANF4
RET
;
; increment question mark count for scanner
; this routine increments the count of the number of question marks in
; the current fcb entry
;
SCQ: LD A,(QMCNT) ; get count
INC A ; increment
LD (QMCNT),A ; put count
RET
;
; check to see if de pts to delimiter; if so, ret w/zero flag set
;
SDELM: LD A,(DE)
OR A ; 0=delimiter
RET Z
CP ' ' ; error if < <sp>
RET Z ; <sp>=delimiter
CP '=' ; '='=delimiter
RET Z
CP 5FH ; underscore=delimiter
RET Z
CP '.' ; '.'=delimiter
RET Z
CP ':' ; ':'=delimiter
RET Z
CP ';' ; ';'=delimiter
RET Z
CP '<' ; '<'=delimiter
RET Z
CP '>' ; '>'=delimiter
RET
;
; advance input ptr to first non-blank and fall through to sblank
;
ADVNCE: LD (CIBPTR),DE
;
; skip string pted to by de (string ends in 0) until end of string
; or non-blank encountered (beginning of token)
;
SBLANK: LD A,(DE)
OR A
RET Z
CP ' '
RET NZ
INC DE
JR SBLANK
;
; capitalize string (ending in 0) in cmdlin and set ptr for parsing
;
CNVBUF: LD HL,CMDLIN+1 ; pt to users command
LD B,(HL) ; char count in b
INC B ; add 1 in case of zero
;
CNVBF1: INC HL ; pt to 1st valid char
LD A,(HL) ; capitalize command char
CALL UCASE
LD (HL),A
DJNZ CNVBF1 ; continue to end of command line
;
CNVBF2: LD (HL),0 ; store ending <null>
LD HL,CMDLIN+2 ; set command line ptr to 1st char
LD (CIBPTR),HL
RET
;
; convert char in a to upper case
;
UCASE: CP 61H ; lower-case a
RET C
CP 7BH ; greater than lower-case z?
RET NC
AND 5FH ; capitalize
RET
;
GETOLD: CALL GETDFU ; get current user into 'B'
CALL GETDFD ; get current driv into 'C'
LD (OLDDRV),BC ; get the parameters
RET
;
SETTMP: LD BC,(TMPDRV)
JR RESET
;
SETOLD: LD BC,(OLDDRV)
JR RESET
;
SETNEW: LD BC,(RQDDRV) ; get the old drive number
JR RESET
;
SETCOM: LD BC,(COMDRV) ; get the old drive number
;
RESET: PUSH BC ; save drive/user
PUSH BC
LD E,C ; get selected drive
LD C,14 ; bdos function
CALL BDOS
POP BC ; restore drive/user
LD E,B ; get selected user
LD C,32 ; bdis set user function
CALL BDOS
;
; set up byte at 4h - some programs may look at it
;
POP BC
LD A,B ; get user number
RLA
RLA
RLA
RLA
AND 0F0H
OR C
LD (4),A
RET
;
DVUPR1: LD A,(TMPUSR)
PUSH AF
LD A,(TMPDRV)
JR DVUPR3
;
DVUPRT: LD A,(RQDUSR) ; get requested drive
PUSH AF
LD A,(RQDDRV) ; get the requested user
;
DVUPR3: ADD A,'A'
CALL CTYPE ; print the drive 'A'-'P'
POP AF
CP 10 ; less that 10?
JR C,DVUPR2 ; yes - dont print the '1'
PUSH AF
LD A,'1'
CALL CTYPE
POP AF
SUB 10
;
DVUPR2: ADD A,'0'
CALL CTYPE
LD A,':'
JP CTYPE
;
IF RCPM
SUBFCB: DEFB 0 ; use current drive
DEFB '$$$ SUB' ;
DEFB 0,0,0,0,0 ; rest of the fcb
DEFB 0,0,0,0,0
DEFB 0,0,0,0,0
DEFB 0,0,0,0,0
DEFB 0,0,0,0,0
;
; Edit this to contain the console commands necessary to
; execute the logoff sequence for your system.
;
BYECMD: DEFB 0 ;<====== do not modify
DEFB 'BYE',13,10 ;<====== put any number of cmds here
DEFB 'Z'-40H ;<====== do not modify
;
BYELEN EQU $-BYECMD-1
ENDIF
;
TRYCHR: DEFB 0
ARCFLG: DEFB 0
DOADIR: DEFB 0
HLPCNT: DEFB 0
BIOS3: DEFW 0
DRVMAX: DEFB 0
USRMAX: DEFB 0
TEMPDR: DEFB 0
CIPTR: DEFW 0
TDRIVE: DEFB 0
QMCNT: DEFB 0
CIBPTR: DEFW 0
TEMPHL: DEFW 0
LENGTH: DEFB 0
OLDDRV: DEFB 0
OLDUSR: DEFB 0
RQDDRV: DEFB 0 ; requested drive
RQDUSR: DEFB 0 ; requested user
COMDRV: DEFB 0 ; drive to load com file
COMUSR: DEFB 0 ; user to load com file
TMPDRV: DEFB 0 ; temporary drive number
TMPUSR: DEFB 0 ; temporary user number
ACTIVE: DEFB 0 ; attach command mode active
NXTWRD: DEFW 0
DEFW 0
CMDLIN: DEFB 79
CMDLEN: DEFB 0
DEFS 79
DEFB 0
;
MEMBER: DEFB ' '
DEFB 0
DEFB 0
LBRNAM: DEFB ' ' ; library file name
DEFB 'LBR'
;
TMPFCB: DEFS 36
DEFFCB: DEFS 36
DEFS 80
STACK EQU $
;
END