; Program: LUSH - Library Utility Shell for ZCPR 3.3 ; Author: Carson Wilson ; Version 1.0 ; Date: 1 December 1987 ; ; Notes: Does not test for shell stack, etc., as these are a ; required part of all Z33 systems. ; LUSH flushes pending commands from the MCL, and will not ; run under ZEX or SUBMIT. Since I cannot think of an instance ; where this will cause a problem, I have omitted ZEX/SUBMIT/MCL ; testing as outlined in Z33PNOTE.002 by Jay Sage. ; The structure and much of the code of LUSH are derived from ; Terry Carroll's ZLBR.COM, which in turn is derived from John ; Poplett's ZLUX.COM. vers equ 12 false equ 0 true equ not false z33only equ false ; Runs under Z33+ only (no BGii) intdir equ false ; Internal directory command? ; Version 1.2 modifications by Bruce Morgen, 6/18/91 ; Added LZH support via patched LHVW v1.1. Patch is LHVWZ3PT.Z80. ; Version 1.1 modifications by Bruce Morgen, 5/14/91 ; Major code crunching and the new LIBs result in a new LUSH that is ; smaller than the original, but with far greater functionality. ; Removed dependency on the ZCPR 3.3+ CCP parser (conditional on the ; "z33only" equate). LUSH will now run under BGii, NZCOM, Z3PLUS, ; Z34, and (as a Type 3) Z33. As a Type 4, LUSH allocates LBR ; directory buffer space dynamically, so no more crash worries! ; Added "ZMD" as the new "KMD" synonym, replacing obsolete "XMODEM." ; LUSH can now be renamed LUX (or any other name up to 4 letters in ; length) and its command table and HELP/? command text will reflect ; the selected name. Now handles ARC/ARK (via UNARC.COM) and ZIP ; (via ZD.COM and ZTYPE.COM). The "intdir" conditional allows use ; of LDIR.COM in lieu of the internal LUSH directory routine, ; a size-for-speed tradeoff. LUSH does not have a Type 3 safety ; header, and it is recommended that Type 3 versions be ORGed at ; 100H, if only to reduce the (very slim) chance of TPA overflow ; with the internal DIR command. ; ; ASCII characters and constants ; duoff equ 30 ; Offset to DU byte on shell stack ; = 'DUU:PROGNAME DUU:LIBRNAME.LBR',0 minstk equ duoff+2 ; Minimum shell stack entry size cmdlen equ 60 ; Internal command line length cr equ 0dh ; carriage return ctrlc equ 03h ; ctrl-c lf equ 0ah ; line feed del equ 7fh ; delete null equ 0 ; null bel equ 7 ; bell bs equ 8 ; backspace tab equ 9 ; tab ctrls equ 'S'-40h ; ctrl-s ctrlu equ 'U'-40h ; ctrl-u ctrlx equ 'X'-40h ; ctrl-x ctrly equ 'Y'-40h ; ctrl-y ; ; Base page address equates ; FCB1 equ 5ch ; ccp file control block DMAadr equ 80h ; default DMA buffer address (dbuf) TPA equ 100h ; Transient Program Area ; public $memry,cout ; ; ; Z3LIB & SYSLIB external references ; extrn scan if z33only extrn capstr else extrn zfname endif ;z33only if intdir extrn condin,luinit,ludir extrn pfn1,phldc extrn f$open,f$read endif ;intdir extrn z33chk,fcb1chk,gdefdu,gzmtop extrn getefcb,pdefdu,gcmddu extrn z3init,z3log,clrcl,putcl,putcst extrn getsh1,qshell,shfull,shpush,shpop extrn bout,cin,eprint,crlf,sknsp extrn epstr,f$exist,retud,sksp,phl4hc ; ; entry: jp begin ; Jump z33 header db 'Z3ENV' ; Z3 program type db 3 ; Type-3 environment z3eadr: dw 0 ; Environment address dw entry $memry: dw 0 ; Set up stack ; begin: ld (stack),sp ; save z3's stack pointer ld sp,stack ; set new stack pointer ; ; Initialize z3 environment ; ld hl,(z3eadr) ; get env ptr ld a,l or h jp z,notz3x call z3init ; inform z3lib if z33only call z33chk jp nz,notz3x endif ;z33only ; ; Clear Z3 CL buffer and set pointer to LBR's name ; call clrcl ; check for & clear z3 command line buffer ; call getsh1 ; shell stack address in hl (de preserved) ; ld a,minstk-1 ; Minimum stack entry size - 1 cp b ; Subtract B from accu. jp nc,shsmal ; Shell entry too small ; push hl ld de,sheltail-shdu ; offset to lbr name from our shell name add hl,de ; hl --> libname on shell stack ld (stklf$ptr),hl ; store pointer for use in DIR command ; pop hl ld de,duoff ; offset to DU bytes in entry add hl,de ld (stkdu$ptr),hl ; save pointer ; Test if GO or JUMP used, leave shell name intact if so. ; ld a,(goflg) ; GO or JUMP used? or a jr nz,GetOrig ; Yes, preserve shell name dec a ; No, set flag ld (goflg),a ; ..for future GO's ; Save invocation DU and name for 1st load and shell restarts, ; but not for GO or JUMP ; call gcmddu ; Get DU of command ld hl,shdu ; Point to DU of our buffer call dupoke ; ..HL points to next byte ; Get invocation name ; ex de,hl ; DE --> shell name call getefcb ; Get address of External FCB in HL jp z,noefcb ; No ext. FCB ; ; Save invocation name ; ld b,8 ; Copy file name only from eFCB efcblp: inc hl ; Point to command in eFCB ld a,(hl) ; Get char. and 7fh ; Strip any attribits ld (de),a ; Poke to shell name & ld (hl),a ; back into efcb inc de ; Bump shell name ptr & djnz efcblp ; Loop around ld a,' ' ; Dual-purpose blank dec hl ; Point efcb+5 dec hl dec hl cp (hl) ; Is it blank? jp nz,namlng ; If not, name is too long ld (de),a ; trailing space before libname dec hl ; Point 4th character of name ld de,lushcmd ; Command table location ld c,4 ; Length of move in BC (B = 0) lddr ; Move 'em out "backwards" inc hl ; Adjust source pointer ld de,lushhlp ; Help screen location ld c,4 ; Length of move (B still = 0) ldir ; Move 'em out "frontwards" ; fall thru GetOrig: call qshell ; Invoked as shell by CCP? jr z,restrt ; ..then don't resave call retud ; Return current DU in BC ld (du$orig),bc ; Save to put on sh. stk. later ; ; Skip to here on GO or JUMP ; ; Check for filename parameter and append to shell name if found ; ; Give help and abort if '', '/' or '//' entered at command line ; restrt: ld hl,(FCB1+1) ; 1st char. ld a,l or a ld de,'//' ; Slashes? sbc hl,de jr z,jpzhlp cp ' ' jpzhlp: jp z,z3hlp call fcb1chk ; Z33 test for bad dirspec jp nz,direrr ; ld (filtyp),a ld a,(FCB1) ; FCB1 drive byte into a or a ; current disk? jr nz,gotdrv ; otherwise a has it curdir: call gdefdu ; Z33 get defaults, B = drive, C = user ld a,b ; disk into a inc a gotdrv: add a,'A'-1 ; ASCII the drive ld hl,sheltail ; point to tail storage ld (hl),a ; plant drivespec of library file ld a,(FCB1+13) ; get ZCPR user number from FCB1 inc hl ; bump to user spot in our buffer call convert ; Store A as ASCII # at HL ; ..HL points to last byte of ; ..stored number putnam: ; Add library name after DU: ld de,fcb1+9 ld a,' ' ; Put a space at FCB1 type ld (de),a ; ..so we won't copy it push de ld de,FCB1+1 ; DE points to name ex de,hl ; swap pointers nloop: ldi cp (hl) jr nz,nloop ; Add "LBR" to FCB1 ; pop hl ; get back FCB1+9 typelp: call apnd1 ; Plug in L and B and R ex de,hl ; swap back ld (taildot),hl ; save location for later ; Add ".LBR" plus hex 0 to complete library name ; call apnd ; Append ".LBR" at HL ; Test for existence ; ld de,FCB1 ; point at FCB1 for the libs ld a,(filtyp) or a call z,z3log ; log in to DU of library via z3lib call f$exist ; check via syslib jr nz,found ld a,(filtyp) inc a ld (filtyp),a sub 5 jp z,err4 ; not found ld hl,fcb1+9 ld de,(taildot) jr typelp found: call retud ; get requested DU into BC call pdefdu ; make default DU for all ; ..LUSH commands ; Install command on shell stack, unless invoked as a shell or ; rerunning for LUSH command: ; ld a,(rerun) ; Rerun for LUSH command? or a ; ..rerun byte = 0 if reloaded jr z,shtest ; No, go see if invoked by CCP xor a ld (rerun),a ; Yes, reset flag ld hl,(stkdu$ptr) ; ..save DU of origin ld b,(hl) inc hl ld c,(hl) ld (du$orig),bc ; ..into buffer call shpop ; ..remove previous shell entry jr nushel ; ..and process as new shell shtest: call qshell ; Invoked as shell by CCP? jp z,getcmd ; ..then don't push on stack again nushel: call shfull ; Shell stack full? jr nz,makesh ; No, put us on stack ld bc,(du$orig) ; Yes, restore origin DU call pdefdu jp shfulerr ; ..and abort ; Put command name, library name, and origin DU on shell stack ; makesh: ld hl,shdu ; not full call shpush ; install us on shell stack ld hl,(stkdu$ptr) ; Point to sh stk location ld bc,(du$orig) ; Get original DU ld (hl),b ; Save origin DU inc hl ; ..on shell stack ld (hl),c ; Tell internal directory to display full directory on restarts. ; ld (cmdln),a ; A = 0 from "shpush" call above jp dir ; show directory, display prompt ; ..and wait for command ; ------------------------------------------------------------------ ; Display routines ; ----------------------- ; Command line help ; z3hlp: call pridpr db 'Library Utility Shell for ZCPR3' db cr,lf,lf db ' Syntax: ',0 ld hl,shdu+4 z3hlp1: ld a,(hl) call cout inc hl cp ' ' jr nz,z3hlp1 call eprint db '[dir: or du:]ufn[.LBR/ARK/ARC/ZIP/LZH]',0 jr jpcrex ; Program name ; progid: call eprint db cr,lf,'LUSH ' db [vers/10]+'0','.',[vers mod 10]+'0' db ' (Type ',0 ld a,(z3eadr-1) add a,'0' call cout call eprint db ' at ',0 ld hl,entry call phl4hc call eprint db 'h) - ',0 ret ; -------------------- ; Error routines ; ---------------- notz3x: call pridpr db 'Need ZCPR3' if z33only db '3+' endif ;z33only db 0 jr jpcrex ; namlng: call pridpr db 'Name too long',0 jpcrex: jr CRexit ; noeFCB: call pridpr db 'No Ext FCB',0 jr CRexit ; shsmal: call pridpr db 'Sh Stk too small',0 jr CRexit ; shfulerr: call pridpr db 'Sh Stk Full',0 jr CRexit ; ; err4: call pridpr db 'File not found',0 jr CRexit ; direrr: call pridpr db 'Illegal ZCPR directory',0 jr CRexit ; tpaerr: call pridpr db 'Library missing',0 ; fall thru ; -------------------------------------------------------------- ; Exit routines ; ------------------- CRexit: call crlf exit: ld sp,(stack) ; get old z3 stack ret ; return to cpr pridpr: call progid jp eprint ; --------------------------------------------------------------- ; Restore original DU from shell stack ; ------------------- restore: ld hl,(stkdu$ptr) ld b,(hl) inc hl ld c,(hl) if z33only jp pdefdu ; Restore default DU else ;if not z33only call pdefdu ; Restore default DU bc2mcl: call z33chk ret z ld hl,cmdln push hl call dupoke pop hl jp putcl endif ;z33only ; --------------------------------------------------------------- ; Internal command line routines ; ------------------------------ ; Print shell prompt ; getcmd: call pridpr db '^C to exit, ? for help' db cr,lf,lf,0 ; fall thru ; Print command line prompt and get user command ; hlfprt: call nameprt ; Print current library name ld a,'>' call cout ; fall thru ; ..and get command ; ----------------------------------------------------------------------- ; Internal command line editor (like ZRDOS's, but no ctrl chars printed) ; ------------------------ ; ; Main inline (modified from syslib) entry point ; Original author: Richard Conn ; Inline restart loop ; ; The cmdln buffer is cleared on each restart. ; inline: ld hl,cmdln ; get start of string ld c,0 ld (hl),c ; Main loop ; inl1: call cin ; get input char cp null ; do not permit jr z,inl1 cp ctrlc ; ^c? jp z,ccabrt cp bs ; backspace? jr z,inbs cp del ; delete? jr z,inbs cp ctrls ; ^s? jr z,inbs ; backspace -c.w. cp cr ; carriage return? jr z,incr cp ctrlx ; ctrl-x? jr z,rexstrt cp ctrly ; ^Y? jr z,rexstrt cp ctrlu ; ^U? b/m jr z,rexstrt cp ' ' jr c,inl1 ; skip control chars. ld (hl),a ; store char inc hl ; pt to next call cout inc c ; incr char cnt ld a,cmdlen ; max char cnt cp c ; compare jr nc,inl1 ; no overrun, loop ld a,bel ; load ASCII bell into a call cout ; sound bell ; FALL THROUGH ; to print backspace & loop ; Inline modules ; ; Backspace -- delete previous char and back up cursor ; inbs: call exbs ; execute jr inl1 ; Ctrl-X or Ctrl-Y ; Erase (and backspace) line and restart: ; rexstrt: call eralin ; erase line jr inline ; startover ; eralin: ld a,c ; check for empty line or a ; 0 chars? ret z call exbs ; jr eralin ; Backspace routine ; exbs: call BOL ; beginning of line? ret z ; continue if so dec c ; decr count dec hl ; back up call bsprnt ; print ld a,' ' ; call cout bsprnt: ld a,bs ; cout: jp bout ; Carriage return -- done; store ending zero ; incr: call crlf ; echo cr call BOL ; test if was at begin. of line jp z,getcmd ; yes, go back ld (hl),0 ; no, store ending zero jp gotcmd ; Support routines for command line editor ; ; BOL -- returns w/zero flag set if user at beginning of line ; BOL: ld de,cmdln ; get start adr or a sbc hl,de add hl,de ret ; -------------------------------------------------------------- ; Resident command scanner ; ------------------------ ; ; Cmdtbl (command table) scanner (adapted from ZCPR3.Z80). ; On exit, HL contains address of command if found, ; zero flag set means valid command. ; Original author: Richard Conn ; cmdser: ld hl,cmdtbl ; pt to command table ld b,4 ; get size of command text cms1: ld a,(hl) ; check for end of table or a jr nz,cms1a dec a ; set nz ret ; command not found if nz cms1a: ld de,FCB1+1 ; pt to stored command FCB1 push bc ; save size of command text cms2: ld a,(de) ; compare stored against table entry cp (hl) ; hl is command table pointer jr nz,cms3 ; no match inc de ; pt to next char inc hl djnz cms2 ; count down ld a,(de) ; next char in input command must be cp ' ' jr nz,cms4 pop bc ; clear stack ld a,(hl) ; get address from table into hl inc hl ld h,(hl) ld l,a ; hl contains address xor a ; zero flag set for command found ret ; command is resident (zero flag set) cms3: inc hl ; skip to next command table entry djnz cms3 cms4: pop bc ; get size of command text inc hl ; skip address inc hl jr cms1 ; ------------------------------------------------------------------ ; Resident command table ; ----------------------- CmdTbl: db 'HELP' dw help ; Display internal help db 'DIR ' dw dir ; Display current file's directory db 'LUS' lushcmd: ; Label for change from eFCB db 'H' dw lush ; Attach to another library file db 'KMD ' dw kmd ; Send file with KMD db 'ZMD ' dw kmd ; Send file with ZMD db 'TYPE' dw type db 0 ; Marks end of table ; -------------------------------------------------------------- ; Command processing routines ; ---------------------- ; Control-C entered -- ; ; 1. Display abort message ; 2. Restore original DU from shell stack ; 3. Pop shell stack ; 4. Return to CCP ; CCabrt: call eralin ; erase line call eprint ; print exit message db 'Control-C detected, returning to Z-System.',0 call restore ; Restore origin DU call shpop jp CRexit ; Process other commands: ; gotcmd: ld hl,cmdln ld a,(hl) ; Get first byte into A cp ';' ; Is it a comment line? jp z,hlfprt ; Yes, go back cp '?' ; A request for help? jp z,help ; If help char, go get help cp ' ' ; If headed with space then send jr z,noscan ; ..to ZCPR as "command [parm ...]" ld de,fcb1 call zfname ; CCP-style parse to FCB1 call cmdser ; ..and scan for resident commands ; CMDSER returns (Z), HL pointing to routine if command found. ; ; Command found? jp nz,pass ; No, pass to ZCPR as ; .."command DU:filename.LBR [parm ...]" jp (hl) ; Yes, process command ; Pass command to ZCPR as "command [parm parm ...]" ; noscan: inc hl ; Addr of command in HL call putcl ; Put on Z3 command line if not z33only noscn0: call gdefdu call bc2mcl ; If not Z33+, prepend "DU:;" endif ;not z33only xor a call putcst jp exit ; Let ZCPR3 process the command ; -------------------------------------------------------------- ; Resident command routines ; ------------------------- ; ; 1. DIR - display library's directory ; dir: ld a,(filtyp) or a jr z,dir0 ld bc,unarc dec a jr z,arczip dec a jr z,arczip ld bc,zipdir dec a jr z,arczip ld bc,lhvw arczip: jp type1 dir0: if not intdir ld bc,extdir jr arczip endif ;not initdir if intdir ld hl,(stklf$ptr) ; address of token into hl ld de,ludFCB ; address of lud FCB in de call zparse ; Z33 parse library name with dir. check ld hl,($memry) ; get "codend" for library buffers ld a,(z3eadr-1) ; get comfile type cp 4 ; type 4? jr nz,dir1 ; no, use codend call f$open ; otherwise open LBR jr nz,jptpae call f$read ; read record into DMAadr jr nz,jptpae ld h,a ld l,h ld de,(DMAadr+14) ; get directory length in records ld b,17*4 ; compute what we need in bytes dirlp: add hl,de jr c,jptpae djnz dirlp ex de,hl ; to DE ld hl,entry ; compute that much below us sbc hl,de jr c,jptpae ld de,TPA sbc hl,de jr c,jptpae add hl,de dir1: ld (lubuff),hl ; stash it ld de,lud ; point at SYSLIB library structure call luinit ; init w/syslib routine ld hl,cmdln call sknsp ; Point to dir. spec. call sksp ; ..if any ld de,lmbrn ; Point to FCB ld a,(hl) or a jr nz,dir3 ld b,11 ld a,'?' dir2: inc de ld (de),a djnz dir2 dir3: call nz,zfname ld hl,lmbrn+1 ld bc,(lubuff) ; start address in heap for dir buffers ld de,lud ; address of lu descriptor call ludir ; get directory (array of 17 byte elements) jptpae: jp nz,tpaerr ; jump on error call crlf ld b,2 ldhdr: call eprint defb 'Member name Recs Size CHEK ',0 djnz ldhdr call crlf ld hl,lbrflg ld (hl),b ld hl,(lubuff) ; get start address of array ld a,(hl) cp ' ' jr nz,prlibm ld c,17 ; offset in BC (B = 0) add hl,bc ; add offset to ptr prlibm: call condin ; see if user typed anything jr z,prlbm1 ; no, continue cp ctrlc ; yes, was it control-c? jr nz,prlbm1 ; if z, quit endif ;intdir ldone: call crlf jp getcmd if intdir prlbm1: ld a,(hl) ; get first byte into a or a ; check for end of array delimiter (null) jr z,ldone ; if null, quit printing loop n1stel: ex de,hl ; put filename ptr into de for call to pfn1 call pfn1 ; print the name of the library member ld a,' ' ; ASCII space into accumulator call cout ; print it ld hl,13 ; offset to rec size in hl add hl,de ; add it ex de,hl ; put address of lib member rec size in de call getwd ; get word pointed to by de into hl push de ; save ptr call phldc ; print rec size ld a,' ' ; print space call cout ld a,l or h jr z,nozero ld de,8 ; div by 8 to get size in kbytes call divhd ; hl = hl / de jr nc,nrmndr ; check for remainder (C flag) inc hl ; if remainder, bump up a kbyte nrmndr: ld a,l ; put lsb into accumulator or h ; or it with msb jr nz,nozero ; is it zero? inc hl ; yes, increment nozero: call phldc ; print result call eprint db 'k ',0 pop de ; restore ptr into array element call getwd ; get word pointed to by de into hl call phl4hc ; print crc value in hex ld a,(lbrflg) or a jr nz,nxtlin call eprint db ' ',0 cpl jr uniret nxtlin: call crlf xor a uniret: ld (lbrflg),a ex de,hl ; ptr to hl jr prlibm getwd: ld a,(de) ; get lsb of rec size ld l,a ; put it in l inc de ; increment pointer into array element ld a,(de) ; get msb ld h,a ; put it in h inc de ; increment ptr into array element ret ; Divhd -> HL = HL / DE. On entry, HL = dividend, DE = divisor, ; result in HL, carry flag set if remainder, dividend of zero ; returns zero quotient. Divisor is KNOWN to be a non-zero ; (does not test!). Uses BC, A. ; divhd: xor a ; Clear carry and ld b,a ; an accumulator ld c,a divlp: inc bc ; Accumulate one sbc hl,de ; Subtract jr z,done ; Exact if Z, done. jr nc,divlp ; If not too much, loop remain: dec bc ; Otherwise adjust by one done: ld h,b ; Into HL, which is junk anyway ld l,c ret ; C if remainder, Z if not endif ;intdir ; ; 2. HELP - display help message ; help: call eprint db cr,lf db '>DIR [afn]',0 ld b,11 call dots db 'Display this library/archive''s directory',cr,lf db '>TYPE ufn ',0 ld b,11 call dots db 'View the file "ufn" in this library/archive',cr,lf db '>KMD|ZMD S[K] ufn ',0 ld b,7 call dots db 'Send a member of this library/archive',cr,lf db '>' lushhlp: ; Label for change from eFCB db 'LUSH [du:|dir:]ufn[.TYP] . . . Attach to another ' db 'library/archive file',cr,lf db ' ("TYPs" of LBR, ARK, ARC, ZIP, and LZH are supported)' db cr,lf db '>',0 call command ld a,' ' call cout ld b,5 call dots db 'command ',0 call nameprt call pmsprn call eprint db cr,lf,'> ',0 call command ld b,5 call dots cmdpms: db 'command' pms: db ' [parameters]',0 jp ldone ; Exit via shared code in "dir" dots: call eprint db '. ',0 djnz dots jp eprint command: ld hl,cmdpms jr jepstr pmsprn: ld hl,pms jr jepstr ; Print current library name ; nameprt: ld hl,(stklf$ptr) jepstr: jp epstr ; ; 3. LUSH - attach to another library file, if found ; lush: ld hl,cmdln ; point to command buffer ld de,fcb1 call sknsp call sksp call zparse ; Parse 2nd token to FCB1 or 0ffh ; Set flag to push and pop ld (rerun),a ; ..shell stack with new name jp restrt ; restart lush ; ; 4. KMD - process KMD, XMODEM commands ; kmd: ld a,(filtyp) cp 3 jr c,kmd1 call eprint db 'Can''t send ZIP/LZH members',0 jp ldone kmd1: ld b,0ffh ; flag for PARMS ld hl,cmdln ; point to input command ld de,mcmdln ; point to our scratchpad buffer push de ; save addr for putcl push de ; and for us call strcp ; move (hl) to (de) to 0 terminator pop hl ; mcmdln in hl call sknsp ; skip to 1st space call sksp ; skip over spaces ld (hl),'L' ; For "KMD L" or "XMODEM L" inc hl ; Point to "K" or space inc hl ; Add it to command jr pass1 ; Build rest of command line ; 4. -- TYPE a member file type: ld a,(filtyp) or a jr z,pass ld bc,unarc dec a jr z,type1 dec a jr z,type1 ld bc,ztype dec a jr z,type1 ld bc,lhvw type1: ld de,mcmdln push de ld hl,cmdln push hl call sknsp call sksp call strcp ld h,b ld l,c pop de ; cmdln call strcp ld a,' ' ld (de),a inc de pop hl ; mcmdln call strcp jp gotcmd ; ------------------------------------------------------------- ; Resident command subroutines ; ---------------------------- ; Pass command as "command LIBNAME tail" ; pass: ld b,0 ; Not XMODEM/KMD command ld hl,cmdln ; point to input command ld de,mcmdln ; point to our scratchpad buffer push de ; save addr for putcl push de ; and for us call strcp ; move (hl) to (de) to 0 terminator pop hl ; mcmdln in hl call sknsp ; skip to 1st ' ' in scratch buffer pass1: ex de,hl ; append ; fall thru ; ; Build ZCPR command line and execute ; parms: ld a,' ' ; put in space ld (de),a ; ..in case there wasn't one inc de ld hl,(stklf$ptr) ; the lbr's full name after command 1 call strcp ; move that ld hl,cmdln ; inline's buffer call sknsp ; skip to 1st space or null inc b ; b is flag..KMD or XMODEM? call z,sksp ; Yes, call z,sknsp ; ..skip 2nd parm. call strcp ; add trailing parms w/null pop hl ; get back mcmdln call putcl ; give it to z3 if z33only xor a call putcst jp exit ; and boogie else ;if not z33only jp noscn0 ; and boogie endif ;z33only ; ----------------------------------------------------------- ; General support routines ; ------------------------ ; ; Use ZCPR3 parser ; zparse: if z33only zfname: call capstr jp scan else ;if not z33only call z33chk jp z,scan xor a ; assume dir: form 1st jp zfname endif ;z33only ; Convert hexadecimal user area number to 1- or 2-digit ASCII ; plus colon and store beginning at (HL). ; Exit: HL points to byte after colon. ; Registers affected: HL, BC, A ; convert: ld b,'0'-1 ; preset for two-digit calculation later cp 10 ; see if single digit jr nc,twodig ; if not, print two digits add a,'0' ; else convert to ASCII ld (hl),a ; and plant it jr putcln ; then do colon ; dupoke: ld a,b add a,'A' ld (hl),a inc hl ld a,c ; convert1: ; make 2 digits ld b,'0'-1 ; preset for two-digit calculation later twodig: inc b ; count tens digit in b sub 10 ; keep subtracting 10 until carry is set jr nc,twodig add a,10 ; get remainder (units digit) back ld c,a ; save it in c ld (hl),b inc hl ld a,c add a,'0' ld (hl),a putcln: inc hl ; Place colon after DU ld (hl),':' inc hl nultrm: ld (hl),0 ret ; Append .LBR extension to HL-pointed command string ; apnd: ld (hl),'.' inc hl apnd1: push de ex de,hl ld hl,lbrstr ld a,(filtyp) or a jr z,apnd2 ld hl,arcstr dec a jr z,apnd2 ld hl,arkstr dec a jr z,apnd2 ld hl,zipstr dec a jr z,apnd2 ld hl,lzhstr apnd2: ld bc,3 ldir ex de,hl pop de jr nultrm ; In case we change libraries ; ; Copy HL to DE up to null terminator ; Registers affected: HL, DE, AF StrCp: ld a,(hl) ; get ld (de),a ; put or a ; have we copied null terminator ret z ; yes, return inc hl ; no, point to next byte in source str inc de ; point to next byte in destination str jr strcp ; loop til null terminator copied ; --------------------------------------------------------------------- ; Data areas ; ---------------------------- ; Initialized storage ; lbrstr: db 'LBR' arcstr: db 'ARC' arkstr: db 'ARK' zipstr: db 'ZIP' lzhstr: db 'LZH' unarc: db 'UNARC',0 zipdir: db 'ZD',0 ztype: db 'ZTYPE',0 if not intdir extdir: db 'LDIR',0 endif ;not intdir lhvw: db 'LHVW',0 rerun: db 0 ; flag for "LUSH" command goflg: db 0 ; Flag set for GO or JUMP ; ----------------------- ; RAM area ; ----------------------- dseg ; ; LUSH installs shname in zcpr3's shell stack with du:lbrname.LBR as tail ; shdu: ds 13 ; Storage for shell duu: + name + " " sheltail: ds 17 ; Storage for 'duu:library .LBR',0 du$orig: ds 2 filtyp: ds 1 taildot: ds 2 if intdir ; Buffers for DIR command ; lbrflg: ds 1 lubuff: ds 2 lmbrn: ds 36 endif ;intdir ; Shell stack pointers ; stkdu$ptr: ds 2 ; Pointer to origin DU storage shellptr: ds 2 ; Pointer to shell stk. stklf$ptr: ds 2 ; pointer to libname string on shell stk. ; cmdln: ds cmdlen+2 ; Command line editor buffer ; mcmdln: ds cmdlen+2 ; Scratch buffer for processing commands if intdir ; ; SYSLIB LU routine buffers ; lud: ds 6 ; data for lu routines ds 11 ; name of current file ludFCB: ds 36 ; FCB of library file endif ;intdir ; ds 64 ; room for 32 level stack stack: ds 2 ; old system stack saved here ; end ; END LUSH.Z80