You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

1327 lines
26 KiB

page
; Library: RCPCLED for Z34RCP
; Author: Carson Wilson (modifications only) <crw>
; Version: 1.3b
; Date: October 8, 1989
; Changes: Civilian time now prints "12" instead of "0" for midnight hour.
; Put Z3PLUS time display capability back in.
; Z3PLUS time display disabled if date = 01/01/78 (no clock).
; Added Rob Friefeld's fix to SAVE_LINE.
;
; Author: rdf
; Version: 1.3a
; Date: October 2, 1989
; Changes: Changed order of installable highlight codes and history buffer
; addresses to simplify installing a ZRL file. Changed version
; number to guarantee compatibility with accessory programs.
; Option to print user number zero at prompt.
; Time string separator installable.
; Author: Carson Wilson (modifications only)
; Version: 1.2 B
; Date: September 29, 1989
; Changes: Made ">>" the prompt when previous commands are NOT being
; overwritten.
; Changed line edit commands to be closer to CP/M Plus.
; Shortened the clock read code (ZSDOS allows straight
; DateStamper calls).
; Uses DEFINE from RCPSUBS.LIB to save space.
; Does not print prompt user number if at user zero.
; Optional installable highlight codes for time in prompt.
; Time prompt shortened to "hh.mm" for easier reading.
; Author: Rob Friefeld
; Version: 1.2 a
; Date: September 20, 1989
; Syntax: CLED [/] if "/", then run for one command line only
; e.g. from a shell like ZFILER
;
; ===== D E F I N I T I O N S S E C T I O N =====================
;
clver equ 13 ; Version number (Install program compat.)
clrev equ 'b' ; Revision (Does not affect config.)
del equ 7fh ; not in sysdef.lib
;
;===== C O N F I G U R A T I O N A R E A ========================
;
; The installation program and buffer loader depend on the configuration
; of this data structure. It should not be changed.
shname: db 'CLED',0 ; Name put on shell stack
versid: db clver ; CLED version
ddsep: db dudir_sep ; DU:DIR separator char
ins_flag: db clins ; Yes = insert mode
minsave: db clmin ; Discard line =< this
era_flag: db clera ; Erase stored line on exit
save_flag: db clsav ; Save command lines
tim_sep: db timesep ; Time string separator
; ---------------------------
; Command list for RCPCLED, Version 1.3
; Set bit 7 to use a command with meta key
cmd_list:
db 'Q' ; Meta key 1
db 'H' ; Backspace
db 'S' ; Cursor left
db 'D' ; Cursor right
db 'A' ; Word left
db 'F' ; Word right
db 'B' ; Line end/ start
dc 'S' ; Line start
dc 'D' ; Line end
db 'G' ; Delete char
db DEL ; Delete left
db 'T' ; Delete word
db 'L' ; Delete word left
db 'X' ; Delete to SOL
db 'Y' ; Delete line
db 'K' ; Delete to EOL
db 'V' ; Toggle insert
db 'P' ; Enter control
db 'W' ; Recall line
db 'E' ; Recall reverse
db 'M' ; Execute line
db '[' ; ESC menu
cmdlen equ $ - cmd_list
; ---------------------------
; Highlight on/off codes for time display (installable)
;
stndout: db 0,0,0,0 ; Must terminate with hibit or binary 0
stndend: db 0,0,0,0 ; Ditto
; ---------------------------
; 4 bytes are used here for the information of the history save/load tool,
; CLEDSAVE
histaddr: dw history ; Pointer to history buffer
histsz: dw histsize ; Buffer size
;
;===== M A I N C O D E S E C T I O N ========================
;
cled:
call define ; Set pointer to free mem
ld de,-lbufwid-1
add hl,de
ld (line),hl ; Set line buffer location
xor a
ld (hl),a ; Zero line
ld hl,history ; History stack
ld (recall_ptr),hl ; Init position pointer to start
ld a,(fcb+1) ; Check command line option
cp '/'
jr z,cledit ; Go right to editing
ld a,(z3msg+3) ; QSHELL
dec a ; <> 1 on manual invocation
jr z,cledit ; Skip installation
;
;===== S H E L L I N S T A L L A T I O N =========================
;
sh_inst:
ld hl,shname
call shpush ; Z = OK
ret z
call print ; Complain about stack and cancel
dc cr,lf,'SH STK' ; Full or non-existent
ret
;
;===== L I N E E D I T ===========================================
;
; This is the main entry point for the shell
; 1 - Display prompt
; 2 - Get user input
; 3 - Reset shell bit
; 4 - Run command line
; Subtask 1 --
cledit:
call prompt ; Display system prompt
;----------------------------------------
; Subtask 2 --
; The editor returns NZ if the shell pop command has been given. If not, it
; returns the character count of the command line in B.
call EDIT
;----------------------------------------
; Subtask 3 --
push af ; Save return code
xor a
ld (z3msg+3),a ; PUTCST
pop af
;----------------------------------------
; Subtask 4 --
jp nz,shpop ; Quit shell
; Here we load the MCL directly from the line buffer. On OVFL, loop to edit.
loadcl:
ld a,(z3cl+2) ; MCL size
inc b ; B contains line count, include terminating 0
cp b ; Compare to line size
jr nc,loadcl1 ; OK
mclerr:
call print
dc cr,lf,'OVFL',cr,lf
jp cledit
loadcl1:
ld de,z3cl+4 ; Set MCL pointer to start
ld (z3cl),de
ld hl,(line)
ld c,b
ld b,0
ldir ; Move line buff to MCL
ret ; Run it
;
;===== S U B R O U T I N E S =======================================
;
; Prompt -- PRINT a DU:DIR prompt.
;
prompt:
if systime
call print_time
endif
ld bc,(cusr) ; GDEFDU
ld a,b ; Drive
add a,'A' ; Make it a letter
call conout ; Write it
ld a,c ; Get user
if puser0
call pusr ; Write it
else
or a
call nz,pusr ; Write it IF NONZERO
endif ;puser0
call dutdir ; Get the ndr
jr z,prompt1
ld a,(ddsep) ; DU:DIR separator
call conout
ld b,8 ; Eight chars max
nameloop:
ld a,(hl) ; Get the first char
cp ' '
call nz,conout ; Write it if not blank
inc hl
djnz nameloop
prompt1:
call prompt2
ld a,(save_flag) ; If save is OFF, prompt is >>
or a
ret nz
prompt2:
call print
dc '>'
ret
; PUSR -- Convert user # in A to decimal and print
;
pusr:
ld hl,10 shl 8 + '0'-1 ; H=10, L='0'-1
cp h ; User < 10 ?
jr c,pusr1
pusr0:
inc l ; Advance character for user number tens digit
sub h
jr nc,pusr0
add a,h
ld h,a ; Keep low digit of user number in H
ld a,l ; Display tens digit
call conout
ld a,h ; Ready to process units digit
pusr1:
jp decout ; Routine in RCPSUBS.LIB
; add '0'
;pusr2:
; jp conout
; Console input without echo
cin:
push hl
push de
push bc
cin1: ld c,dirconf ; DCIO
ld e,-1
call bdos
or a
jr z,cin1
pop bc
pop de
pop hl
ret
;
;===== E D I T O R S E C T I O N ================================
;
; Date: October 2, 1989
; Entry is EDIT
; Return Z = Execute command line, NZ = Quit shell, B = char count of line
; Initialize to on-line environment.
; While editing, HL -> current position in LINE, B = char count,
; C = cursor position (0 .. count), DE = scratch
edit:
ld hl,(line) ; Init to start of line
xor a
ld b,a ; Line count = 0
ld c,a ; Cursor pos = 0
push hl ; There may already be a line here
dec b ; Accumulate possible char count in B
edit1:
inc b
cp (hl) ; A = 0
inc hl
jr nz,edit1 ; Loop until 0 terminator
edit2:
pop hl ; Point to line again
call zline ; Zero the remainder of LINE buffer
call ptail ; Print the line from cursor position
;--------------------------------------------------------------------
; EDIT COMMAND LOOP
; Get a char. If it is text, enter it. If it is a control, scan the
; CMD_LIST for a match. If found, compute offset into jump table and go.
; A "shifted" key (high bit set in table) is matched after the "meta-key"
; has been entered.
ecmd:
exx ; Main regs must be preserved
ld hl,ecmd ; Save address so a return comes back here
push hl
no_match:
call cin ; Next key...
cp 'C'-'@' ; Warm boot?
jp z,0000h
ld hl,meta_flag ; Shift flag
or (hl) ; Mask in possible high bit
ld (hl),0 ; Reset flag
exx ; Recover main regs
cp 20h ; Test key
jr c,control_key ; Not text
cp del ; This control char > text chars
jp c,enter ; Input text
control_key:
call menuinp ; Convert control char to cap
exx ; Must preserve main regs
ld hl,cmd_list ; Scan command list
ld bc,cmdlen
cpir
jr nz,no_match
ld hl,cmd_vector
ld a,cmdlen-1 ; Point to address in vector table
sub c
add a,a
ld c,a
add hl,bc
ld c,(hl)
inc hl
ld b,(hl)
ld (cjump),bc ; Address to jump to
exx ; Restore regs!
cjump equ $+1
jp 0
; Convert a control key entry to cap char
menuinp:
push af
and 80h ; Keep high bit
ld e,a
pop af
and 7fh
call ucase
or e ; Restore high bit
ret
; Mark meta-key flag
meta_key1:
ld a,10000000b
ld (meta_flag),a
ret
meta_flag: db 0 ; Initial value 0 = no shift
; Jump table for commands
cmd_vector:
dw meta_key1 ; Shift key
dw bsp ; Backspace
dw bsp ; Cursor left
dw fsp ; Cursor right
dw bwrd ; Left word
dw fwrd ; Right word
dw linend ; To EOL
dw linbeg ; To SOL
dw linend1 ; To EOL/SOL
dw delete ; Delete char
dw delft ; Delete char left
dw delwrd ; Delete word right
dw delwlft ; Delete word left
dw delsol ; Delete to start of line
dw dline ; Delete line
dw deleol ; Delete to end of line
dw instog ; Toggle insert
dw ctl_entry ; Enter control char
dw recall_back ; Scroll back in history
dw recall_fwrd ; Scroll ahead in history
dw eds$ex ; Execute line
dw esc_menu ; Submenu
;--------------------------------------------------------------------
; ON-LINE ROUTINES, EDITING CURRENT LINE IN LINE BUFFER
; WHILE ON LINE:
; B = CHAR COUNT (0..lbufwid) C = CURSOR POSITION (0..lbufwid)
; HL = MEM POSITION
; Backspace
; Return Z = backspace not done, NZ = all OK
bsp:
xor a
cp c ; Cursor pos
ret z ; At start
dec hl ; Back up in mem
dec c ; Cursor pos back
bspace:
ld a,bs ; Back up on screen
or a ; Must ret nz
jp conout
; Forward space
; Return Z = not done
fsp:
ld a,(hl)
or a
ret z ; At EOL
inc hl
inc c
jp pctl ; Screen advance by reprinting char
; Back word
bwrd:
call bsp ; Backspace
ret z ; Nowhere to go
ld a,(hl)
cp ' '
jr z,bwrd ; Backspace over blanks
dec hl ; Now backspace until next wordsep
call wrdsep ; Look at char before this position
inc hl
jr nz,bwrd
ret
; Forward word
fwrd:
call wrdsep ; Are we on a word separator?
jr z,fwrd1 ; Yes
call fsp ; No, advance until we find one
jr fwrd
fwrd1: call fsp ; Word sep found, advance 1 more space
ld a,(hl) ; Are we on a blank?
cp ' '
jr z,fwrd1 ; Don't quit on a blank
ret
; Delete char left
delft:
call bsp ; Backspace and fall through to delete
; Delete char
delete:
call delmem ; In memory
jp ptail ; Refresh screen from cursor position
; Delete to start of line
delsol:
ld a,c ; Get cursor pos
or a
ret z ; Already at start
cp b
jr z,dline ; At end, so delete entire line (quicker)
ld e,a ; Cursor pos = # chars to delete
call linbeg ; Go to start
delcmd1:
call delmem ; Delete first char in memory
dec e ; Loop counter
jr nz,delcmd1
jp ptail ; Now update screen
; Delete word left
delwlft:
call bwrd ; Back a word and fall thru ...
; Delete word right
delwrd:
call wrdsep ; On a word sep?
jr z,delete ; Yes, kill it
ld a,b ; Compare line count to cursor pos
cp c
jr z,delete ; On last char of line
delwrd1:
call delmem ; Delete in mem, let screen catch up later
jr delwrd ; Go until word sep found
; Delete line
dline:
call linbeg ; Position at line start and fall thru ...
; Delete to eoln
deleol:
call ereol ; Clear on screen
ld b,c ; Char count = current position
jp zline ; Zero line tail in mem
; Insert/overwrite toggle
instog:
ld a,(ins_flag) ; Flag 0 -> owrt
cpl
ld (ins_flag),a
ret
; Enter a control
ctl_entry:
call cin
and 1fh ; Fall thru to normal char entry
; Enter a char
enter:
ex af,af' ; Save char
ld a,b ; At eoln?
cp c
jr z,ovrwrt ; Yes, no need for insert mode
ld a,(ins_flag) ; Which mode are we in?
or a ; 0 = overwrite, nz = insert
jr nz,insert
; Enter char in overwrite mode
ovrwrt:
ld a,b ; Char count
cp lbufwid-2 ; Line full?
jr c,ovr1 ; No
cp c ; At EOLN?
ret z ; Accept no more chars
ovr1: ex af,af' ; Recover char
ld (hl),a ; Put char in place
call fsp ; Advance by printing it
ld a,b ; Char count -> a
cp c
ret nc ; No need to incr char count inside line
inc b ; Else add to count
ret
; Enter char in insert mode
insert:
ld a,b ; Line full?
cp lbufwid-2
ret nc
insrt:
ld a,b ; At eoln?
sub c ; A = # chars to eoln
jr z,ovr1 ; Yes, really want overwrite
call insmem ; Push chars down to make room
ex af,af' ; Recover new char
ld (hl),a ; Place char in line
call ptail ; Reprint entire line from here
inc b ; Inc char count
jp fsp ; Advance cursor
; Line end/start toggle
linend: ; Go to eoln or, if there, to start of line
ld a,b
cp c
jr z,linbeg
linend1:
call fsp ; Print ahead until EOL
jr nz,linend1
ret
linbeg:
call bsp ; Backspace until start
jr nz,linbeg
ret
; Compare current char to list of word separators
wrdsep:
push hl
push bc
ld bc,wrdseplen
ld a,(hl)
ld hl,wrdseps
cpir
pop bc
pop hl
ret
wrdseps:
db 0,' ,;:.' ; Punctuation word separators
wrdseplen equ $ - wrdseps
; Delete current char from line
delmem:
ld (hl),0 ; Terminal 0 or char to be deleted
ld a,b
sub c ; A = (count-position) = chars from end
ret z ; At eoln, no char
dec b
ret z ; Single char line
dec a
ret z ; On last char, just deleted it
delmem1:
inc a ; To move terminal 0 in
push hl
push de
push bc
ld d,h ; Dest is current pos
ld e,l
inc hl ; Source, terminal 0
ld c,a ; Count, line tail
ld b,0
ldir ; Block move
pop bc
pop de
pop hl
ret
; Insert a char in line
insmem:
push bc ; Make room for char in line
push de
ld c,a ; Bc = # chars to move
ld b,0
add hl,bc ; Dest is new eoln
ld d,h ; Now in DE
ld e,l
dec hl ; Source is current eoln
lddr ; Tail move
pop de
pop bc ; Recover char count, crs pos info
inc hl ; Hl to next char
ret
; Print line tail from cursor position, return to position
ptail:
push hl ; Save mem pos
push bc ; Save screen pos
call linend1 ; Print ahead to end of line
call ereol ; Clean off danglers
ptail1:
ld a,c ; End of line cursor pos
pop bc
pop hl
sub c ; Current cursor pos
ret z ; At end of line already
ld e,a ; Loop counter
ptail2:
call bspace ; Else back up to where we were
dec e
jr nz,ptail2
ret
; Print a char, turn a control char into a cap char
pctl:
push af
cp 20h
jr nc,pctl1
add '@'
pctl1: call conout
pop af
ret
; Convert char or control key to upper case
ucase:
cp ' '
jr nc,notctl
add '@'
notctl: cp 'a'
ret c ; Not a lowercase
cp 'z'+1
ret nc ; Not a lowercase
sub ' ' ; Yes, a lowercase
ret
; Zero line tail
zline:
push hl
push bc
ld hl,(line) ; HL -> start of line
ld c,b ; BC = char count
ld b,0
add hl,bc ; HL -> EOLN
ld a,lbufwid
sub c
dec a
jr z,zline0
ld b,a ; # of 0's
xor a
zline1:
ld (hl),a
inc hl
djnz zline1
zline0:
pop bc
pop hl
ret
; ESC key pressed - get submenu command
esc_menu:
call cin
call ucase
cp 'Q' ; Quit
jr z,edquit
cp 'S' ; Toggle Save
ret nz ; Loop if none of these
; Toggle recording state
; - Alter line prompt to > if save ON, >> if save OFF
save_tog:
ld a,(save_flag) ; Flip flag byte
cpl
ld (save_flag),a
call crlf
call prompt ; Print new prompt string
pop af ; Lift ecmd from stack
jp edit ; Restart
; Exit editor
eds$ex:
pop af ; Lift ECMD from stack
ld a,(save_flag) ; Are we recording?
or a
ret z ; Nope
ld a,(minsave) ; Is line worth keeping?
cp b
push bc
call c,save_line
pop bc
edn$ex:
xor a ; Return Z
ret
; Exit and pop shell
edquit:
pop af ; Lift ECMD from stack
xor a ; Return NZ
dec a
ret
; ---------------------------
; HISTORY STACK ROUTINES for RCPCLED, Version 1.2
;Each command line is pushed onto the history stack before execution. As the
;older ones overflow, they are eliminated. The last character of each line
;has the high bit set. The buffer terminates with a 0.
;The history stack is internal to the RCP, but could be implemented in an RSX
; Save new line to stack
; - This routine called only on exit, so on-line regs not preserved.
; - Push contents down by size of current line
; - Move line buffer to start of stack
; - Terminate line with high bit set
; - Terminate history with 0 after last complete line
; - If current line is too big for buffer size chosen, do nothing
save_line:
ld c,b ; Line size from b to bc
xor a
ld b,a
push bc
ld hl,HISTSIZE
sbc hl,bc ; Buffer size - line length
jr z,savel_err ; Not enough room
jr c,savel_err ; Definitely not enough room!
push hl
ld hl,hbuf_top
push hl
sbc hl,bc ; hl -> bufftop - line size
pop de ; de -> bufftop
pop bc ; bc = buffsize - line size
lddr ; tail move
pop bc ; Recover line size in bc
ex de,hl
inc de ; de -> buffstart
ld hl,(line) ; Move in line
ldir
dec de
ex de,hl
set 7,(hl) ; Tag line terminus
ld hl,hbuf_top ; Terminate history after last complete line
savel1:
dec hl ; Back up to EOLN
bit 7,(hl)
jr z,savel1 ; Loop until hi-bit encountered
inc hl
ld (hl),0
ret
savel_err:
pop af ; Lift BC push
ret
; Recall command history, newest -> oldest
; - recall_ptr is init to start of buffer on each CLED invocation
; - return with pointer updated to next line
recall_back:
call check_recall ; Is there anything in buffer?
ret nc ; No
; Transfer from recall pointer to line buffer
; - enter hl @ recall_ptr
; - return ptr -> start of next command if no OVFL
rc_back1:
ld de,(line) ; Destination for move
rc_back1a:
ld a,(hl)
or a
jr z,recall_quit ; Buff end
ldi
bit 7,a
jr z,rc_back1a
ld (recall_ptr),hl ; Update ptr now
ex de,hl ; Point to end of line in line buffer
ld (hl),0 ; Terminate it
dec hl
res 7,(hl) ; Fix high bit from storage
pop af ; Lift ecmd from stack
jp edit ; Restart on this line
recall_quit0:
pop af ; Lift subroutine call from stack
recall_quit:
exx ; Recover main regs
ret ; Back to editing
; Recall command history, oldest -> newest
recall_fwrd:
call check_recall ; Anything in buffer?
ret nc ; No
call rc_fwrd1 ; Move to previous line
call rc_fwrd1 ; Don't repeat line on direction rev
jr rc_back1 ; Now same code as recall_back
rc_fwrd1:
dec hl ; Initially, HL -> next line to recall
ld de,history ; Underflow address
rc_fwrd1a:
push hl ; Compute position relative to top
xor a
sbc hl,de
pop hl
ret z ; Quit when start of buff reached
jr c,recall_quit0 ; Underflow
dec hl ; Going backwards in buffer
bit 7,(hl)
jr z,rc_fwrd1a
inc hl ; Point to char past command terminator
ret
; Check to see if anything in recall buffer yet
; - Ret NC = no, main regs preserved
; - Else switch main regs to alt, ret HL @ recall buffer line
check_recall:
ld a,(history) ; Is anything in buffer yet?
or a
ret z ; Nope
call linbeg
exx
ld hl,(recall_ptr)
scf
ret
; ---------------------------
; Routine: EREOL function for Z34RCP
; Author: Rob Friefeld
; Version: 1.0
; Date: September 19, 1989
;
; Entry: EREOL
; Function: To clear to end of line
; Comments: The setting of the ERLTCAP equate determines whether this
; command uses the TCAP information or not. If not, it uses the
; ereol string passed in macro CLR_EOL. That string should
; end with the high bit set. The setting of the ERLQUICK equate
; determines whether to simply output the TCAP string for this
; function or to interpret it as does Rick Conn's VLIB version.
; Uses RCPSUBS.LIB routines CONOUT and PRINTHL.
; -------------------------------------------------------------------
if [not erltcap]
; Erase to end of line. Return NZ.
ereol: call print
clr_eol
; or -1 ; For VLIB compatibility
ret
else
if erlquick
; ---------------------------
; This version just prints the EREOL string: no delay, no interpretation.
ereol:
push hl
ld hl,z3tcap+17h ; CLS string
xor a ; Skip to EREOL string
ereol1: cp (hl) ; Skip once
inc hl
jr nz,ereol1
ereol2: cp (hl) ; Skip twice
inc hl
jr nz,ereol2
call printhl ; Print it
pop hl
ret
; ---------------------------
; This is a disassembly of EREOL from VLIB
else
ereol:
push bc
push de
push hl
ld hl,z3tcap+16h ; Point to ereol delay
ld d,(hl)
inc hl
call vidskp
call vidskp
call vidout
pop hl
pop de
pop bc
xor a
dec a
ret
vidskp:
ld a,(hl)
inc hl
or a
ret z
cp '\'
jr nz,vidskp
inc hl
jr vidskp
vidout:
ld a,(hl)
or a
jr z,vid2
inc hl
cp '\'
jr nz,vid1
ld a,(hl)
vid1:
call conout
jr vidout
vid2:
ld a,d
or a
ret z
ld c,a
ld hl,z3env+2bh ; Processor speed
ld a,(hl)
or a
jr nz,vidl1
ld a,4
vidl1:
ld b,a
push bc
call vdelay
pop bc
dec c
jr nz,vidl2
ret
vdelay:
call vdel1
djnz vdelay
ret
vdel1:
ld c,20
vdel1a:
ex (sp),hl
ex (sp),hl
dec c
jr nz,vdel1a
ret
endif ;erlquick
endif ;not erltcap
;
;===== Z 3 L I B R O U T I N E S ================================
;
; Disassembly of Z3LIB routines DUTDIR, SHPUSH, SHPOP
; For use with CLED RCP segment ONLY
; Does not save regs as does Z3LIB, and has less env error checking
; rdf 10/2/89
DUTDIR:
ld a,z3ndirs ; No NDR
or a
ret z
ld hl,(z3ndir)
inc b
dutdir1:
ld a,(hl)
or a
jr nz,dutdir2
dec b
xor a
ret
dutdir2:
cp b
inc hl
jr nz,dutdir3
ld a,(hl)
cp c
jr nz,dutdir3
inc hl
dec b
xor a
dec a
ret
dutdir3:
push bc
ld bc,11h
add hl,bc
pop bc
jr dutdir1
shpop:
; ***
;Special function for RCPCLED -- null saved command line
ld a,(era_flag) ; Erase?
or a
jr z,eflag1 ; Z = NO
xor a
ld (history),a
eflag1:
; ***
;shpop:
call getsh ; HL -> stack, DE = size, B = entries
ret z ; No stack
ld c,e ; Entry size
ld a,(hl)
or a
ret z ; Empty
ex de,hl
add hl,de ; HL -> next entry, DE -> first entry
xor a
shpop1:
ld (de),a ; Zero entry
dec b
ret z ; Successful exit, no more entries
push bc ; Pop next entry
ld b,0
ldir
pop bc
jr shpop1
shpush:
push hl ; Save string pointer
call getsh
jr z,shpush_err1 ; No stack
shpush3:
ld a,(hl) ; Look for free entry
or a
jr z,shpush4
add hl,de
djnz shpush3
jr shpush_err2 ; Stack full
shpush4:
call getsh ; Point to top of stack
push bc
shpush5:
dec b
jr z,shpush6
add hl,de
jr shpush5
shpush6:
pop bc
ld c,e
dec hl
ex de,hl
add hl,de ; HL -> (entry-1) + size, DE -> (entry-1)
ex de,hl
shpush7:
ld a,b
cp 1
jr z,shpush8
dec b
push bc
ld b,0
lddr
pop bc
jr shpush7
shpush8:
call getsh
pop de
ex de,hl
shpush9:
ld a,(hl)
ldi
or a
jr nz,shpush9
shpushx:
ret
shpush_err1:
; ld a,1 ; No stack
; jr shpush_err
shpush_err2:
ld a,2 ; Stack full
shpush_err:
pop hl
or a
ret
; Get shell stack entry
; Return HL -> top of stack
; DE = entry size
; C = unchanged
; B = # entries
; A = # entries
; Z = no entries
getsh:
getsh2:
ld hl,(z3env+1eh) ; Stack
ld a,(z3env+20h) ; # entries
ld b,a
ld de,(z3env+21h) ; Entry size in E
ld d,0
or a
ret
;
;===== C L O C K R E A D I N G ==================================
;
if systime
; Print system time from DateStamper, ZS/ZDDOS/Z3PLUS clock
; Entry point
; Print the string with leading '0' suppression
; Format: "h.mm " or "hh.mm "
print_time:
; 1. Test for DateStamper/ZSDOS/Z3PLUS and read clock if present
ld c,12 ; Return version
ld e,'D' ; DateStamper test
call bdos
ld a,l ; Version #
cp 30h ; Z3PLUS?
jr nc,time1 ; Yes
ld a,h
cp 'D'
ret nz ; No clock
; 2. Get time
ld hl,time2
push hl ; Return address on stack
push de ; Clock address on stack
ld hl,dtbuf ; Point to buffer
ret ; Call clock, return to time2
time1: ; Z3PLUS entry point
ld c,105 ; CP/M Plus get time
ld de,dtbuf+1
push de
call bdos
pop hl
ld a,(hl)
inc hl
ld b,(hl)
dec a
or b
ret z ; No clock if date = 0001
time2:
; 3. Turn highlight on, if present
ld hl,stndout
call printhl
ld hl,dtbuf+3 ; Point to hours
; 4. Convert military time to civilian, if selected
if civtim
ld a,(hl) ; Hours
or a ; Midnight?
jr nz,time3 ; No
ld a,24h ; Yes, say "12"
time3: sub 13h ; Time past 12:59 pm?
jr c,time4 ; No, don't change
daa ; Decimal adjust
inc a ; Yes, xlate to 12-hour
daa
ld (hl),a ; ..and patch in.
endif ; civtim
; 5. Display time
time4:
xor a
call pmbcd ; Print hours as 1 or 2 digits
ld a,(tim_sep) ; Print separator between hours, minutes
call conout
inc hl ; Point to minutes
ld a,80h ; Say print leading 0
call pmbcd ; Print minutes as 2 digits
; 2. Turn highlight off, if present
ld hl,stndend
call printhl
jp spac ; Space before rest of prompt
;
;===== D A T A ====================================================
;
; Buffer for date/time for read/write system clock
dtbuf: ds 6
endif ;systime
line ds 2 ; Pointer to line buffer
recall_ptr ds 2 ; History position pointer
history ds HISTSIZE,0 ; History buffer
hbuf_top: equ $-1
; End RCPCLED.LIB