;Program: SHSET
;Version: 2.0
;Date: March 3, 1988
;Author:  Bruce Morgen
;Derivation: SHSET 1.0 by Richard Conn (source unavailable)

; Version 2.1 modification by Bruce Morgen, March 3, 1988
; Fixed buglet that gave Quiet Flag runs one less character of
; legal command line length than when Quiet Flag was reset.

; Version 2.0 rational
; This is a case of replacing a perfectly adequate tool with one
; that's barely better.  This new SHSET uses a substitute command
; separator ("&") which allows SHSET command lines to be built
; into aliases and ARUNZ scripts.  It also gives somewhat more
; informative error messages, is obedient to the Quiet Flag and
; places a meaningful value in the Program Error Flag on failure.
; SHSET now has a BDOS-based line editor interactive mode and a
; handy run-time quiet mode (prefix "|" to the command line) too.
; SHSET Version 2.0 is a ZCPR33 Type 3 program with safety header.

CR	EQU	0DH
LF	EQU	0AH
FCB	EQU	05CH
TBUFF	EQU	080H
SUBCLN	EQU	'&'
Z3ENV	EQU	0

	PUBLIC	$MEMRY
	EXTRN	Z3INIT,GETSH1,SHFULL,SHPUSH
	EXTRN	PUTER2,GETEFCB,GETWHL,GETQUIET
	EXTRN	EPRINT,EPSTR,COUT,CRLF,PAFDC,BLINE

; TYPE 3 HEADER

; Code modified as suggested by Charles Irvine to function correctly with
; interrupts enabled.  Program will abort with an error message when not
; loaded to the correct address (attempt to run it under CP/M or Z30).

ENTRY:
	JR	START0		; Must use relative jump
	NOP			; Filler
	DB	'Z3ENV',3	; Type-3 environment
Z3EADR:
	DW	Z3ENV		; Filled in by Z33
	DW	ENTRY		; Intended load address

START0:
	LD	HL,0		; Point to warmboot entry
	LD	A,(HL)		; Save the byte there
	DI			; Protect against interrupts
	LD	(HL),0C9H	; Replace warmboot with a return opcode
	RST	0		; Call address 0, pushing RETADDR
				; onto stack
RETADDR:
	LD	(HL),A		; Restore byte at 0
	DEC	SP		; Get stack pointer to point
	DEC	SP		; To the value of RETADDR
	POP	HL		; Get it into HL and restore stack
	EI			; We can allow interrupts again
	LD	DE,RETADDR	; This is where we should be
	XOR	A		; Clear carry flag
	PUSH	HL		; Save address again
	SBC	HL,DE		; Subtract -- we should have 0 now
	POP	HL		; Restore value of RETADDR
	JR	Z,START		; If addresses matched, begin real code

	LD	DE,NOTZ33MSG-RETADDR
				; Offset to message
	ADD	HL,DE
	EX	DE,HL		; Switch pointer to message into DE
	LD	C,9
	JP	0005H		; Return via BDOS print string function
NOTZ33MSG:
	DB	'Not Z33+$'	; Abort message if not Z33-compatible

START:
	LD	HL,(Z3EADR)
	LD	A,L
	OR	H
	JR	NZ,Z3INSD
	CALL	EPRINT
	DB	'Non-Z3 system or SHSET not installed with Z3INS.',0
	RET

Z3INSD:	CALL	Z3INIT
	XOR	A		; Clear any old program error
	CALL	PUTER2
	CALL	LSHUSH
	JR	NZ,NOBANR
	CALL	EPRINT
BANNER:	DB	'SHSET, Version 2.0  ',0
NOBANR:	CALL	GETSH1
	JR	NZ,GOTSTK
	CALL	EPRINT
	DB	'No Shell Stack, aborting.',0
	RET
GOTSTK:
	CALL	SHFULL
	JR	NZ,NOTFULL
	CALL	EPRINT
	DB	'Shell Stack full, aborting.',0
	CPL
	JP	PUTER2		; FFh signals a SHFULL error
NOTFULL:
	LD	A,(FCB+1)	; Good old help tester
	CP	'/'
	JR	Z,HELP
	CP	' '
	JP	NZ,SHSET
	CALL	GETWHL
	JR	Z,HELP
	DEC	B
	LD	HL,($MEMRY)
	LD	(HL),B
	CALL	EPRINT
	DB	CR,LF,'Enter your shell command line below:',CR,LF,0
	CALL	BLINE
	OR	A
	CALL	NZ,CRLF
	JP	NZ,SHOK1

HELP:	LD	HL,BANNER
	CALL	LSHUSH
	CALL	NZ,EPSTR
	CALL	EPRINT
	DB	CR,LF
	DB	'SHSET asserts its command input '
	DB	'as a ZCPR3 shell.',CR,LF
	DB	'Syntax:',CR,LF,' ',0
	CALL	COMNAM
	CALL	EPRINT
	DB	' [|]cmd1['
	DB	SUBCLN
	DB	'cmd2'
	DB	SUBCLN
	DB	'cmd3]',CR,LF
	DB	'("'
	DB	SUBCLN
	DB	'" is translated to ";", "|" for quiet operation)',0
	CALL	GETWHL
	RET	Z
	CALL	EPRINT
	DB	CR,LF
	DB	'Use ',0
	CALL	COMNAM
	CALL	EPRINT
	DB	' alone for interactive mode.',0
	RET

SHSET:
	LD	HL,TBUFF
	LD	C,(HL)		; Tail length in C
;	CALL	LSHUSH
;	JR	Z,SHTAIL
	LD	A,(TBUFF+2)
	CP	"|"
	JR	NZ,SHTAIL
	DEC	C
	DEC	C
	JP	Z,HELP
	INC	C
SHTAIL:
	LD	A,C
	CP	B		; Compare
	JR	Z,SHOK		; B = A is OK
	JR	C,SHOK		; B > A is OK
	CALL	EPRINT		; Anything else is not
	DB	'Command line too long, must be ',0
	LD	A,B
	DEC	A		; Allow for terminating NULL
	CALL	PAFDC		; Print decimal value
	CALL	EPRINT
	DB	' characters or fewer',0
	LD	A,B
	JP	PUTER2		; Entry size is a GETSH1 error
SHOK:
	INC	HL
	INC	HL
SHOK1:
	LD	A,(HL)
	CP	'|'
	JR	NZ,SHOK2
	LD	(TBUFF+2),A	; Looks funny, but needed this
	INC	HL
SHOK2:
	LD	D,H		; Command line pointer in HL, DE
	LD	E,L
LOOP:	INC	HL		; HL is working pointer
	LD	A,(HL)
	OR	A		; End of command tail?
	JR	Z,DONE		; Yes, all done
	CP	SUBCLN		; Substitute separator?
	JR	NZ,LOOP		; No, loop to next character
	LD	(HL),';'	; Otherwise substitute real sep.
	JR	LOOP		; and then loop
DONE:
	CALL	LSHUSH
	JR	NZ,QUINS
	CALL	EPRINT		; Say verb if not muzzled
	DB	'Installing "',0
QUINS:	EX	DE,HL		; Tail pointer to HL
	CALL	SHPUSH		; The real work via Z3LIB
	PUSH	AF
	CALL	LSHUSH
	CALL	Z,EPSTR		; Show our new shell
	LD	A,'"'
	CALL	Z,COUT		; Close quotes
	POP	AF
	RET	Z		; All done unless screwy error
	CALL	EPRINT		; Report the head-scratcher
	DB	CR,LF,'Unknown Shell Stack Error, aborting',0
	JP	PUTER2		; 1, 2, or 3 is a SHPUSH error
				; (which should NEVER happen)

; Subroutine prints actual program name if possible,
; otherwise prints the "official" name.

COMNAM:	CALL	GETEFCB
	JR	Z,NOEFCB
	LD	B,8
CMNMLP:	INC	HL
	LD	A,(HL)
	AND	7FH
	CP	' '
	CALL	NZ,COUT
	DJNZ	CMNMLP
	RET
;
NOEFCB:	CALL	EPRINT
	DB	'SHSET',0
	RET

; Augmented version of GETQUIET checks "internal flag" first

LSHUSH:	LD	A,(TBUFF+2)
	SUB	'|'
	JP	NZ,GETQUIET
	DEC	A
	RET

$MEMRY:	DS	2

	END