;=======================================================================
;
;
;				  H P
;
;		  Programmer's Integer RPN Calculator
;
;			 Copyright (c) 1989-91
;				  by
;			      Terry Hazen
;			 21460 Bear Creek Road
;			   Los Gatos CA 95030
;
;		    Voice.......... (408) 354-7188
;		    Zee-Machine.... (408) 245-1420
;		    Ladera Znode... (213) 670-9465
;
;
; HP14 is released for personal, non-commercial use only.  Any
; commercial use of HP14 where the user receives revenue by
; duplicating or distributing HP14 by itself or in conjunction with
; any hardware or software product is expressly prohibited unless
; authorized in writing by the author.	All rights reserved.
;
;=======================================================================
;
; Revision History
; ----------------
;
; 02/08/91	Revised as ZCPR3 type 3/4 utility now including all RSX
;   v1.4	and IOP code as assembly time options to allow the use 
;		of ZML to link the RSX and IOP PRL versions.  See 
;		HPRSX14.Z80/HPIOP14.Z80 for information about generation
;		of the HP RSX and IOP versions.
;			- Terry Hazen
;
; 12/22/89	Unreleased version.  Took TABS out of display to avoid
;   v1.3	problems with some terminals that won't expand them
;		properly.
;			- Terry Hazen
;
; 08/12/89	Added function to RSX version to write calculator
;   v1.2	display to host program.
;			- Terry Hazen
;
; 07/20/89	Extensively reorganized and rewritten to reduce code
;   v1.1	size, improve the user interface, including error
;		trapping, and to add last-x and stack roll functions.
;		Reduced the number of stack register levels from 8 to
;		4 and increased the number of memory registers from 3
;		to 6 (registers 0-5).  Deleted Remainder function and
;		save remainder in memory register R during division.
;			- Terry Hazen
;
; 09/xx/84	Original version.
Š;   v1.0		- Eric Meyer
;
;=======================================================================
;
; System equates
;
OFF	EQU	0
ON	EQU	0FFH
NO	EQU	0
YES	EQU	NOT NO
;
; Version
;
VERS		EQU	14	; Version number
MONTH		EQU	02	; Revision month
DAY		EQU	08	;	...day
YEAR		EQU	91	;	...year
;
; ZCPR3 utility type.  Use one of the following assembly/link aliases
; to produce the type of file desired.	ZTYPE is set interactively
; during assembly.
;
; ZTYPE=3 to make a type 3 utility.  To produce a type 3 utility loading
; and executing at 100h under ZCPR33+:
;
;		ZMAC HP;ZML HP
;	or	Z80ASM HP/M;SLRNKP HP/N,/A:100/J,HP,/E
;
; To produce a type 3 utility loading and executing at 8000h under
; ZCPR33+:
;		ZMAC HP;ZML HP,/A:8000
;	or	Z80ASM HP/M;SLRNKP HP/N,/A:8000/J,HP,/E
;
; ZTYPE=4 to make a type 4 utility loading under the CCP or lowest RSX
; and executing only under ZCPR34+:
;
;		ZMAC HP;ZML HP,T4LDR.HDR/P
;
; ZTYPE=5 to make the HP RSX version and use ZML to link it to a PRL
; file.  Use Joe Wright's CON20 to append HP.PRL to the loader utility,
; HPRSX14.BIN, to produce the final HPRSX.COM file:
;
;		ZMAC HP;ZML HP/P;CON20 HPRSX.COM=HPRSX14.BIN,HP.PRL /
;
; ZTYPE=6 to make the HP IOP version and use ZML to link it to a PRL
; file.  Use Joe Wright's CON20 to append HP.PRL to the loader utility,
; HPIOP14.BIN, to produce the final HPIOP.COM file:
;
;		ZMAC HP;ZML HP/P;CON20 HPIOP.COM=HPIOP14.BIN,HP.PRL /

;
; Rather than having to re-edit this file to change the ZTYPE, ask for
; the ZCPR3 utility type at assembly time:
;
.ACCEPT	'Configure the REL file for [Type3=3][Type4=4][RSX=5][IOP=6]? ',ZTYPE

	 if	(ztype=4)
	PUBLIC	$MEMRY
	 endif
Š;
; BDOS functions
;
CONIN	EQU	1		; Console input
CONOUT	EQU	2		; Console output
DCONIO	EQU	6		; Direct console I/O
;
; System addresses
;
WBOOT	EQU	0000H		; Warm boot jump address
BDOS	EQU	0005H		; BDOS entry address
CMDBUF	EQU	0080H		; Command line buffer address
;
; ASCII values
;
BELL	EQU	7		; Ring console bell
BS	EQU	8		; Back space
TAB	EQU	9		; Tab over
LF	EQU	10		; Line feed
CR	EQU	13		; Carriage return
ESC	EQU	1BH		; Escape
SPACE	EQU	32		; Space
;
CTRLC	EQU	'C'-040H	; Quit program execution
CTRLX	EQU	'X'-040H	; Clear stack

	 if 	ztype=6
;=======================================================================
;
; The following jumps and package ID are a fixed data structure
; and cannot be changed if this package is to work with standard
; loaders and SHOW programs.
;
	name	('IOP/HP14')	; REL module name

IOP:	JP	ZERO	; STATUS; Internal Status Routine
	JP	SELECT		; Device Select Routine
	JP	ZERO	; NAMER	; Device Name Routine
	JP	IOPINIT		; Initialize IOP.  LDR jumps here
;
CONS:	JP	ICONST		; Console Input Status
	JP	RSXSTART	; Console Input Char
	JP	BIOS$CONOUT	; Console Output Char
	JP	LIST		; List Output Char
	JP	PUNCH		; Punch Output Char
	JP	READER		; Reader Input Char
	JP	LISTST		; List Output Status
;
	JP	ZERO	; NEWIO	; New I/O Driver Installation Routine
	JP	ZERO	; COPEN	; Open CON: Disk File
	JP	ZERO	; CCLOSE; Close CON: Disk File
	JP	ZERO	; LOPEN	; Open LST: Disk File
	JP	ZERO    ; LCLOSE; Close LST: Disk File
;
;  I/O Package Identification
Š;
	DB	'Z3IOP'		; Read by LDR for identification.
;
	DB	'HP'		; Name of this package (8 bytes)
	DB	VERS/10+'0',VERS MOD 10+'0'
	DB	'    '
;
; The targets of the following seven jumps are filled in by NZCOM
; when it loads the IOP.  If not using NZCOM, the TINIT routine, always
; called by any IOP loader, must fill them.  See example TINIT below.
;
BIORET:
;
ICONST:	JP	0
BIOS$CONIN:
	JP	0
BIOS$CONOUT:
	JP	0
LIST:	JP	0
PUNCH:	JP	0
READER:	JP	0
LISTST:	JP	0
;
; Device Select Routine.  Calling Select with B=0FFH will effectively 
; remove this IOP.
;
SELECT:	INC	B
	JR	NZ,ZERO		; Not recognized
;
; Point our jump table to BIORET so that all character IO
; is vectored directly to the BIOS, effectively removing us.
;
	LD	HL,CONS		; Our jump table
	LD	DE,BIORET	; Our auxiliary jumps to bios
	LD	B,3		; Do the first 3
;
; Replace jump target at HL+1 with DE, increment HL and DE by 3.
;
TARGET:	INC	HL		; Point to our jump target
	LD	(HL),E		; Low order
	INC	HL		; Increment pointer
	LD	(HL),D		; High order
	INC	HL		; Increment pointer
	INC	DE		; Point DE to next BIOS jump
	INC	DE		
	INC	DE		
	DJNZ	TARGET		; Loop till done
	OR	ON		; Set good return
	RET
;
; Any IOP functions not implemented return ZERO to the caller.
;
;STATUS:			; Internal Status Routine
;SELECT:			; Device Select Routine
;NAMER:				; Device Name Routine
;NEWIO:				; New I/O Driver Installation Routine
;COPEN:				; Open CON: Disk File
;CCLOSE:			; Close CON: Disk File
;LOPEN:				; Open LST: Disk File
;LCLOSE:			; Close LST: Disk File
ZERO:	XOR	A		; Any call here returns ZERO
	RET

	 endif	;ztype=6
	 if	ztype=5
;=======================================================================
;
; Standard Plu*Perfect RSX header:
;
RSX:	JP	RSXSTART	; RSX / BDOS intercept		;  00
	JP	RSXWB		; Warm boot intercept		; +03
	JP	RSXREMOVE	; Remove RSX routine		; +06
;
RSXWBA:	DW	0		; Original 0001 address 	; +09
RSXPROT:DW	RSX		; Lowest RSX address		; +0B
	DW	RSXNAME		; Pointer to RSX name		; +0D
;
RSXNEXT:JP	0		; Pointer to next WB or CCP	; +0F
NEXT:	JP	0		; Pointer to next RSX or BDOS	; +12
;
NEXTWB:	DW	0		; Original BIOS wb jump address ; +15
Š	 endif 	;ztype=5
	 if 	ztype=5 or ztype=6
;-----------------------------------------------------------------------
;
; Initiation character
;
INITCHR:DB	0		 				; +17

	 endif	
	 if	ztype=5
;-----------------------------------------------------------------------
;
; Local copy of BIOS jump tables from WB to CONOUT
;
BIOS$WB:DS	3
	DS	3
BIOS$CONIN:
	DS	3
BIOS$CONOUT:
	DS	3
;
RSXNAME:DB	'HP'		; RSX name for RSX ID and HELP screens
	DB	VERS/10+'0',VERS MOD 10+'0'
	DB	0		; Termination

;-----------------------------------------------------------------------
;
; RSX remove routine
;
RSXREMOVE:
	LD	HL,BIOS$WB	; Copy our local BIOS jump table fragment
	LD	DE,(RSXWBA)	;    back to BIOS
	LD	BC,9		; Just wb thru conin
	LDIR
;
FIX0001:LD	HL,(RSXWBA)	; Restore (0001) in case it was modified
	LD	(1),HL
	SCF			; Set CARRY to signal success
	RET

;-----------------------------------------------------------------------
;
; RSX warm boot routine
;
RSXWB:	CALL	FIX0001		; Ensure correct page 0
;
	LD	DE,RSX+3	; Point to loaded RSX wb jump
	LD	HL,(BIOS$WB+1)	; Get BIOS wb jump vector
	OR	A
	SBC	HL,DE		; Does it point to us?
	JR	Z,RSXWB1	; No, we're not the bottom RSX
;
	LD	HL,(RSXPROT)	; We are, so set our protect address
	LD	(6),HL
;
ŠRSXWB1:	LD	BC,(4)		; Get C=logged DU for CCP
	JR	RSXNEXT		;    in case we're also top RSX
	 endif	;ztype=5

	 if	ztype=5 or ztype=6	
;-----------------------------------------------------------------------
;
; Intecepts BIOS conin jumps and checks for HP INITCHR.
; If found, initiates HP.  If not found, return character in A.
;
RSXSTART:
	LD	A,(WFLAG)	; Write routine?
	OR	A
	JR	Z,RSXS0		; No, continue
;
WLOOP:	LD	HL,(WPNTR)	; Get display pointer
;
WLOOP0:	LD	A,(HL)		; And current character
	INC	HL		; Point to next
	LD	(WPNTR),HL	; Save new pointer
	OR	A		; End?
	JR	Z,ENDWRT	; Yes, return to calculator
;
	CP	SPACE		; Ignore spaces
	JR	Z,WLOOP0	; Skip space and do next character
	RET			; Else send character
;
ENDWRT:	XOR	A		; Reset write flag
	LD	(WFLAG),A	; And go back to calculator
	JR	START
;
RSXS0:	CALL	BIOS$CONIN
	LD	HL,INITCHR	; Point to initiation character
	CP	(HL)		; Initiate HP?
	RET	NZ		; No, pass character on
	JR	START		; Go to calculator
;
; End of RSX code
;
;=======================================================================
	 else	;not ztype=5 or ztype=6
;
ENTRY:	 if	ztype=3
	JP	START	; Executes under ZCPR33+
	 else
	RST	0	; Executes only under ZCPR34+
	DW	START
	 endif

Z3ENV:	DB	'Z3ENV'	; ZCPR3 indentifier
	DB	ZTYPE	; Default is type 3 utility
ENVPTR:	DW	0	; Z3ENV address

	 if	ztype=3
LOAD:	DW	ENTRY	; Load at ENTRY for type 3
Š	 else
$MEMRY:	DW	0	; Code size for type 4 filled in by linker
	 endif
;
	DB	'HP'	; Default CFG filename for types 3 and 4
	DB	VERS/10+'0',VERS MOD 10+'0'
	DB	'    '	; 8 characters
;
	DB	'Copyright (c) 1989-'
	DB	YEAR/10+'0',YEAR MOD 10+'0'   	
	DB	' by Terry Hazen'
	 endif	;not ztype=5

;=======================================================================
;
; Program ID
;
HEADER:	DB	CR,'HP '
	DB	VERS/10+'0','.',VERS MOD 10+'0'
;
	 if	ztype=6
	DB	' (IOP)            '
	 else
	 if	ztype=5
	DB	' (RSX'
	 else
	DB	' (Type '
	DB	ZTYPE+30h	; ZCPR3 utility type
	 endif	;ztype=5
	DB	' at '
PLADDR:	DB	'xxxxH)'	; Load address
	 endif	;ztype=6
;
SPACER:	DB	'        '
;
MODE:	DB	'H> '		; Calculator mode display.
				; Note: Check MODE using BIT x,(IX-xx).
				;    - Bit 0 identifies Character mode
				;    - Bit 2 identifies Decimal mode
				;    - Bit 3 identifies Hex mode
				; (Binary mode 'B' has no single id bit)
;
; Digit display
;
DDIG8:	DB	MONTH/10+'0'	; Display digit 8
DDIG7:	DB	MONTH MOD 10+'0'; Display digit 7
DDIG6:	DB	'/'		; Display digit 6
DDIG5:	DB	DAY/10+'0'	; Display digit 5
DDIG4:	DB	DAY MOD	10+'0'	; Display digit 4
DDIG3:	DB	'/'		; Display digit 3
DDIG2:	DB	YEAR/10+'0'	; Display digit 2
DDIG1:	DB	YEAR MOD 10+'0'	; Display digit 1
	DB	0		; Termination for PRINT

;-----------------------------------------------------------------------
Š;
; Flags - bitmapped at (IX+FLAGS-NOENTR)
;
FLAGS:	DB	0		; Bit 0: PCFLAG - ON if pending char
				; Bit 1: PSFLAG - ON if stack pushed

;-----------------------------------------------------------------------
;
START:	LD	(OLDSP+1),SP	; Save old stack pointer
	LD	SP,STACK	; Point to local stack
;
	 iff	ztype=6
	LD	DE,PLADDR	; Point to header message
	 if	ztype=5
	LD	HL,RSX		; Get load address
	 else
	LD	HL,ENTRY	; Get load address
	 endif
	CALL	MOVHEX		; Move it to header
	 endif
	CALL	INITINDEX	; Initialize index registers
;
NOENTR:	RES	1,(IX+FLAGS-NOENTR); Clear push stack flag
;
; Main loop
;
MAIN:	CALL	INITBUF		; Put contents of X in display buffer
	CALL	CALCDISP	; Calculator display
;
; Initialize buffer
;
	LD	HL,DDIG8	; Point to input buffer
	LD	B,8		; Fill all digit positions with spaces
	LD	A,SPACE
	CALL	PAD
	CALL	TYPE		; Parks cursor one space away
;
	RES	0,(IX+FLAGS-NOENTR); Clear pending character flag
;
; Get next character and parse it
;
GETNEXT:CALL	GETKEY		; Get next character
;
	LD	BC,CMDLEN	; Size of command table
	LD	HL,COMMANDS	; Point to command table
	CPIR			; Command?
	JR	NZ,CHKRANGE	; No, check for valid input character

;-----------------------------------------------------------------------
;
; Jump to proper command routine
;
JMPCMD:	LD	HL,CMDADDR	; Point to address table
	ADD	HL,BC		; Add command offset*2 for word address
	ADD	HL,BC		; HL has command pointer
Š	LD	A,(HL)		; Get low byte
	INC	HL		; Point to high
	LD	H,(HL)		; Get high byte
	LD	L,A		; Contents of HL now in HL
	JP	(HL)		; And jump to the proper routine

;-----------------------------------------------------------------------
;
; Check for valid input character
;
CHKRANGE:
	BIT	0,(IY+MODE-MAIN);  Test for character mode
	JR	Z,CHKR1		; No, do validity testing
;
CHKR0:	LD	A,(TEMP1)	; Get original character
	LD	L,A		; Put it in HL
	LD	H,0
	JR	LASTX0		; Save it in X
;
CHKR1:	LD	HL,NUMBERS	; Point to range of permitted numbers
	LD	BC,16		; Start out with hex
NORANGE:EQU	$-2		; Patch acceptable range per current
				;    display mode
	CPIR			; Check validity
	JR	Z,ENTERCHR	; Ok

;-----------------------------------------------------------------------
;
; Character out of current valid range
;
BADCHR:	LD	A,BELL		; Ring console bell
	CALL	TYPE
	JR	REFRESH		; Go refresh calculator display

;-----------------------------------------------------------------------
;
; Enter character into right hand digit of calculator display, shifting
; existing digits one position to the left, discarding highest digit.
;
ENTERCHR:
	OR	A		; Clear CARRY
	LD	BC,3		; Number of digits allowed - 1
RANGE:	EQU	$-2		;    per current mode
	LD	HL,DDIG1	; Calculate start of move
	SBC	HL,BC
	LD	D,H		; DE now points to highest digit
	LD	E,L
	INC	HL		; HL points one lower
	LDIR
;
	SET	0,(IX+FLAGS-NOENTR); Set pending character flag
	LD	(DDIG1),A	; Save character as lowest digit

;-----------------------------------------------------------------------
;
Š; Refresh calculator display
;
REFRESH:CALL	CALCDISP	; Calculator display
	JR	GETNEXT		; And get next character

;-----------------------------------------------------------------------
;
; Delete last character
;
DELAST:	BIT	0,(IX+FLAGS-NOENTR); Check for pending characters
	JR	Z,CLEARX	; None, so clear register X
;
	LD	HL,DDIG2	; Point to second digit
	LD	DE,DDIG1	; Point to lowest digit
	LD	BC,7		; Move everything right one digit
	LDDR
;
	LD	A,SPACE		; Get space
	LD	(DDIG8),A	; Store it in highest digit
	JR	REFRESH		; Go refresh calculator display

;-----------------------------------------------------------------------
;
; Move contents of Last-X register to register X.
;
LASTX:	CALL	GETPENDING	; Put any pending characters into X
	CALL	PSHSTK		; Push stack if required
	LD	HL,(LX)		; Get contents of Last-X register
;
LASTX0:	LD	(SRX),HL	; Store in register X
	JP	(IX)		; Wait for next character

;-----------------------------------------------------------------------
;
; Clear register X
;
CLEARX:	LD	HL,0
	LD	(SRX),HL	; Clear register X
	JR	ENTER0		; Set push stack flag

;-----------------------------------------------------------------------
;
; Clear stack
;
CLRSTK:	LD	HL,SRX		; Point to register X
	LD	B,STKLEN	; Length of stack
	XOR	A		; Pad with zeros
	CALL	PAD	
	JP	(IY)		; Wait for next character

;-----------------------------------------------------------------------
;
; Enter number into register X, pushing stack
;
ENTER:	CALL	GETPENDING	; Put any pending characters into X
Š	CALL	PUSHSTK		; Push stack so Y = X
;
ENTER0:	SET	1,(IX+FLAGS-NOENTR); Set push stack flag
	JP	(IY)		; Wait for next character

;-----------------------------------------------------------------------
;
; Write register X display to host program (RSX or IOP versions only)
;
	 if	ztype=5 or ztype=6; - RSX or IOP version
WRITE:	CALL	GETPENDING	; Put any pending characters into X
	CALL	INITBUF		; Put contents of X in display buffer
;
	LD	HL,DDIG8	; Point to start of display
	LD	(WPNTR),HL	; Save it
	LD	A,ON
	LD	(WFLAG),A	; Set Write Flag
	JP	DONE		; And quit
	 endif

;-----------------------------------------------------------------------
;
; Store the number from register X (the display) in the memory register
; (0-5) entered from the keyboard.
;
STOREX:	CALL	GETREG		; Get memory register pointer in HL
	LD	DE,SRX		; Source is register X
	EX	DE,HL		; DE->mem reg, HL->reg X
	JR	RECX0		; Store word

;-----------------------------------------------------------------------
;
; Recall the number from the memory register (0-5) entered from the
; keyboard to register X.
;
RECALLX:CALL	GETREG		; Get memory register pointer in HL
	CALL	PSHSTK		; Push stack if required
	LD	DE,SRX		; DE->reg X, HL->mem reg
;
RECX0:	LDI			; Move word
	LDI
	JP	(IX)		; Wait for next character

;-----------------------------------------------------------------------
;
; Roll stack down one level.  Contents of register X go to register T.
;
ROLLDWN:CALL	GETPENDING	; Put any pending characters into X, HL
	CALL	POPSTK		; Pop stack
	LD	(SRT),HL	; Save old X in register T
	JP	(IY)		; Wait for next character

;-----------------------------------------------------------------------
;
; Roll stack up one level.  Contents of register T go to register X.
Š;
ROLLUP:	CALL	GETPENDING	; Put any pending characters into X
	LD	HL,(SRT)	; Get register T in HL
	CALL	PUSHSTK		; Push stack
	LD	(SRX),HL	; Save old T in X
	JP	(IY)		; Wait for next character

;-----------------------------------------------------------------------
;
; Exchange X<>Y
;
EXCH:	CALL	GETXY		; Get X in DE, Y in HL
	LD	(SRY),DE	; Save DE in register Y
;
EXCH0:	LD	(SRX),HL	; Save HL in register X
	JP	(IX)		; Wait for next character

;-----------------------------------------------------------------------
;
; Negation (2's complement) ~X
;
NEGX:	CALL	GETPENDING	; Put any pending characters into X, HL
	LD	(LX),HL		; Save contents of X in Last-X register
;
	LD	A,H		; Complement contents of X, result in HL
	CPL
	LD	H,A
	LD	A,L
	CPL
	LD	L,A
	INC	HL
	JR	EXCH0

;-----------------------------------------------------------------------
;
; Exponentiate Y^X
;
YEXPX:	CALL	GETXY		; Get X in DE, Y in HL
	LD	A,D		; Power 0?
	OR	E
	JR	NZ,EXP0		; No, continue
;
	LD	HL,1		; Make it one
	JR	SAVEHL		; And save it
;
EXP0:	LD	B,D		; DE -> BC
	LD	C,E
	LD	D,H		; HL -> DE and HL
	LD	E,L
;
EXP1:	DEC	BC		; Done?
	LD	A,B
	OR	C
	JR	Z,SAVEHL	; Yes, save result
;
Š	PUSH	BC		; Save registers
	PUSH	DE
	CALL	MULTIPLY	; HL*DE
	POP	DE		; Restore registers
	POP	BC
	JR	NC,EXP1		; Loop till done
	JR	ERROR		; Ring console bell if overflow

;-----------------------------------------------------------------------
;
; Subtract Y-X
;
SUBXY:	CALL	GETXY		; Get X in DE, Y in HL
	SBC	HL,DE
	JR	SAVEHL		; Save result

;-----------------------------------------------------------------------
;
; Add Y+X
;
ADDXY:	CALL	GETXY		; Get X in DE, Y in HL
	ADD	HL,DE
	JR	SAVEHL		; Save result

;-----------------------------------------------------------------------
;
; Bitwise X|Y
;
XORY:	CALL	GETXY		; Get X in DE, Y in HL
	LD	A,H		; OR X with Y, result in HL
	OR	D
	LD	H,A
	LD	A,L
	OR	E
	LD	L,A		; And fall thru

;-----------------------------------------------------------------------
;
; Save contents of HL in register Y, and pop stack to put it in X.
;
SAVEHL:	LD	(SRY),HL	; Save result in register Y
	CALL	POPSTK		; Pop stack, putting result in X
	JP	(IX)		; Wait for next character

;-----------------------------------------------------------------------
;
; Bitwise X&Y
;
XANDY:	CALL	GETXY		; Get X in DE, Y in HL
	LD	A,H		; AND X with Y, result in HL
	AND	D
	LD	H,A
	LD	A,L
	AND	E
	LD	L,A
Š	JR	SAVEHL		; Save result

;-----------------------------------------------------------------------
;
; Divide Y/X (Remainder X*(Y/X-INT(Y/X)) -> Memory Register R)
;
DIVYX:	CALL	GETXY		; Get X in DE, Y in HL
	CALL	DIVIDE		; Do division
	LD	(MREGR),DE	; Store remainder
	JR	MULT0

;-----------------------------------------------------------------------
;
; Multiply Y*X
;
MULTXY:	CALL	GETXY		; Get X in DE, Y in HL
	CALL	MULTIPLY	; Do multiplication
;
MULT0:	JR	NC,SAVEHL	; Save result, else fall thru if ovrflow

;-----------------------------------------------------------------------
;
; Input or function error
;
ERROR:	LD	A,BELL		; Ring console bell
	CALL	TYPE
	JP	(IX)		; Wait for next character

;-----------------------------------------------------------------------
;
; Check to see if character is a mode selection character.  If not,
; check for character mode.  If so, enter character exactly as typed.
;
MODECHK:CALL	GETPENDING	; Put any pending characters into X
	CALL	GETKEY		; Get character from keyboard
;
; Check for calculator mode selection
;
	CP	'H'		; Hex
	JR	Z,SETHEX
	CP	'D'		; Decimal
	JR	Z,SETDEC
	CP	'B'		; Binary
	JR	Z,SETBIN
	CP	'C'		; Character
	JR	Z,SETCHR
;
; Not mode spec, check for character mode
;
	BIT	0,(IY+MODE-MAIN); Test for character mode
	JR	Z,ERROR		; Bad character
	JP	CHKR0		; Save character

;-----------------------------------------------------------------------
;
Š; Set hex mode
;
SETHEX:	LD	HL,HEX$IN	; Point to hex mode routines
	LD	DE,HEX$OUT
	LD	BC,16		; Range of valid characters
	EXX
	LD	HL,3		; Number of digits allowed - 1
	JR	MODESET

;-----------------------------------------------------------------------
;
; Set decimal mode
;
SETDEC:	LD	HL,DEC$IN	; Point to decimal mode routines
	LD	DE,DEC$OUT
	LD	BC,10		; Range of valid characters
	EXX
	LD	HL,4		; Number of digits allowed - 1
	JR	MODESET

;-----------------------------------------------------------------------
;
; Set binary mode
;
SETBIN:	LD	HL,BIN$IN	; Point to binary mode routines
	LD	DE,BIN$OUT
	LD	BC,2		; Range of valid characters
	EXX
	LD	HL,7		; Number of digits allowed - 1
	JR	MODESET

;-----------------------------------------------------------------------
;
; Set character mode
;
SETCHR:	LD	HL,CHR$IN	; Point to character mode routines
	LD	DE,CHR$OUT	;    and fall thru to MODESET
	EXX

;-----------------------------------------------------------------------
;
; Set mode by modifying jump or call destinations to point to the mode
; routines for the newly specified calculator mode.
;
MODESET:LD	(MODE),A	; Store mode character in display header
	LD	(RANGE),HL	; Set number of allowable digits - 1
	EXX
	LD	(RDBUFJP),HL	; Modify input jump for current mode
	LD	(DISPCAL),DE	; Modify display call for current mode
	LD	(NORANGE),BC	; Set number of permitted numbers
	JP	(IX)		; Wait for next character

;=======================================================================
;
; Subroutines
Š;
;-----------------------------------------------------------------------
;
; GETREG
;
; Description:
;	Get memory register specification character from keyboard and
;	parse it.  Set up to store or recall word from memory register.
;
; Exit:
;	HL points to selected register
;
GETREG:	CALL	GETPENDING	; Put any pending characters into X
	CALL	GETKEY		; Get character from keyboard
;
	CP	'R'		; Remainder register?
	JR	Z,RREG		; Yes, get address
;
	CP	'6'		; Greater than 5?
	JR	NC,ERROR	; Yes, ring bell and continue
	SUB	'0'		; Less than 0?
	JR	C,ERROR		; Yes, ring bell and continue
;
	ADD	A,A		; Register is two bytes
	LD	E,A		; Put offset in DE
	LD	D,0
	LD	HL,MREG0	; Point to memory register 0
	ADD	HL,DE		; HL now points to selected register
	RET
;
RREG:	LD	HL,MREGR	; Point to remainder register
	RET

;-----------------------------------------------------------------------
;
; GETXY
;
; Description:
;	Get any pending characters into X.  Get contents of register Y
;	in HL, contents of register X in DE.  Save contents of register
;	X in Last-X register.
;
; Exit:
;	HL = (SRY)
;
GETXY:	CALL	GETPENDING	; Get any pending characters into X, HL
	EX	DE,HL		; Contents of register X in DE
	LD	(LX),DE		; Save in Last-X register
	LD	HL,(SRY)	; Get contents of register Y in HL
	RET

;-----------------------------------------------------------------------
;
; GETPENDING
;
Š; Description:
;	Get any pending characters from the input buffer and put them in
;	register X, HL.
;
; Exit:
;	HL = (SRX)
;
GETPENDING:
	LD	HL,(SRX)	; Get old X in case nothing pending
	BIT	0,(IX+FLAGS-NOENTR); Any pending characters?
	RET	Z		; No, quit
;
	CALL	PARSEBUF	; Get input in HL
	CALL	PSHSTK		; Push stack if required
	LD	(SRX),HL	; Save HL in register X
;
	RES	1,(IX+FLAGS-NOENTR); Clear push stack flag
	RET

;-----------------------------------------------------------------------
;
; PSHSTK
;
; Description:
;	If PSFLAG is not set, fall thru to PUSHSTK to push stack.
;
PSHSTK:	BIT	1,(IX+FLAGS-NOENTR); Check push stack flag
	RET	NZ		; Yes, quit now, else fall thru

;-----------------------------------------------------------------------
;
; PUSHSTK
;
; Description:
;	Push contents of stack.  X=Y, contents of register T are
;	discarded.
;
PUSHSTK:EXX			; Save HL
	LD	HL,SRT-1	; Point to stack top +2
	LD	DE,SRT+1	; Point to stack top
	LD	BC,SRT-SRX	; Stack length - 2
	LDDR
	EXX			; Restore HL
	RET

;-----------------------------------------------------------------------
;
; POPSTK
;
; Description:
;	Pop contents of stack.	Old X is discarded.  Contents of
;	register T are copied to next lower entry.
;
POPSTK:	EXX			; Save HL
	LD	HL,SRY		; Transfer from register Y
Š	LD	DE,SRX		; Transfer to register X
	LD	BC,SRT-SRX	; Stack length - 2
	LDIR
	EXX			; Restore HL
	RET

;-----------------------------------------------------------------------
;
; MULTIPLY
;
; Description:
;	Multiply HL*DE.
;
; Exit:
;	HL = result
;	CARRY SET if overflow
;
MULTIPLY:
	LD	C,L
	LD	B,H
	LD	HL,0
	LD	A,15
;
MLP:	PUSH	AF
	OR	D
	JP	P,MLP0
;
	ADD	HL,BC
	JR	C,FERR
;
MLP0:	ADD	HL,HL
	JR	C,FERR
;
	EX	DE,HL
	ADD	HL,HL
	EX	DE,HL
	POP	AF
	DEC	A
	JR	NZ,MLP
;
	OR	D
	RET	P
;
	ADD	HL,BC
	RET
;
; Function error return
;
FERR:	POP	BC		; Clear stack
;
ERR:	SCF			; Set CARRY to indicate error
	RET

;-----------------------------------------------------------------------
;
Š; DIVIDE
;
; Description:
;	Divide HL/DE.
;
; Exit:
;	HL = quotient
;	DE = remainder -> (MREGR)
;	CARRY SET if divide by 0
;
DIVIDE:	LD	A,E
	OR	D
	JR	Z,ERR		; Divide by 0 error

	LD	C,L
	LD	B,H
	LD	HL,0
	LD	A,16
	OR	A
;
DLP:	LD	(TEMP1),A
	RL	C
	RL	B
	RL	L
	RL	H
	LD	(TEMP2),HL
	SBC	HL,DE
	CCF
	JR	C,DLP0
;
	LD	HL,(TEMP2)
;
DLP0:	LD	A,(TEMP1)
	DEC	A
	JR	NZ,DLP
;
	EX	DE,HL		; Put it in DE
	RL	C
	LD	L,C
	RL	B
	LD	H,B		; Quotient in HL
	OR	A
	RET

;-----------------------------------------------------------------------
;
; INITDISP
;
; Description:
;	Strip leading zeros and point to most significant display digit.
;
INITDISP:
	LD	A,(HL)		; Get character
	CP	'0'		; Leading zero?
	JR	NZ,FERR		; No, too many characters for mode
Š;
	INC	HL
	DJNZ	INITDISP	; And repeat till character found
	RET

;-----------------------------------------------------------------------
;
; PARSEBUF
;
; Description:
;	Converts ASCII string in input buffer per current display mode
;	to number in HL.
;
; Exit:
;	HL = number
;
PARSEBUF:
	LD	HL,DDIG8	; Point to highest digit
	PUSH	HL		; Save pointer
;
ZEROSPACE:
	LD	A,(HL)		; Get character
	OR	A		; End of buffer?
	JR	Z,NOTSPACE	; Yes
;
	CP	SPACE		; Space?
	JR	NZ,NOTSPACE	; No, we're at the highest digit
;
	LD	(HL),'0'	; Space, so store a zero
	INC	HL		; Point to next character
	JR	ZEROSPACE	; And continue
;
NOTSPACE:
	POP	HL		; Restore pointer, fall thru

;-----------------------------------------------------------------------
;
; Input routines.  Jump modified to suit current calculator mode.
;
; Entry:
;	HL points to ASCII input buffer
;
; Exit:
;	HL = number
;
	JP	HEX$IN
RDBUFJP:EQU	$-2

;-----------------------------------------------------------------------
;
; Hex input routine, result in HL.
;
HEX$IN:	LD	B,4		; Number of leading 0's to skip
	CALL	INITDISP	; Strip leading 0's, point to msdigit
	CALL	HBIN		; Convert first two ASCII digits
Š	LD	D,A		; Save first byte in D
;
	INC	HL		; Point to next ASCII digit
	CALL	HBIN		; Convert next ASCII digit
	LD	E,A		; Save second byte in E
	EX	DE,HL		; Put results in HL
	RET
;
HBIN:	CALL	HDIN		; Convert first ASCII digit
	RLCA			; Get high hibble
	RLCA
	RLCA
	RLCA
	INC	HL		; Point to next ASCII digit
	LD	E,A		; Save high nibble
	CALL	HDIN		; Convert second ASCII digit
	ADD	A,E		; Add it in
	RET
;
HDIN:	LD	A,(HL)		; Get ASCII digit
	CP	'A'		; Letter?
	JR	C,HDIN0		; No
	SUB	7		; Letter offset
;
HDIN0:	SUB	'0'		; Make it binary
	RET

;-----------------------------------------------------------------------
;
; Decimal input routine, result in HL.
;
DEC$IN:	LD	B,3		; Number of leading 0's to skip
	CALL	INITDISP	; Strip leading 0's, point to msdigit
	LD	DE,0		; Initialize DE
;
DECIN0:	LD	A,(HL)		; Get digit
	OR	A		; Check for end of buffer
	JR	NZ,MUL10	; Not yet
;
	EX	DE,HL		; Put value in HL
	RET
;
;  Multiply DE by 10
;
MUL10:	SUB	'0'		; Convert to binary
	PUSH	AF		; Save value
	PUSH	HL		; Save HL
	LD	HL,10
	CALL	MULTIPLY	; DE*10
	EX	DE,HL		; Result in DE
	POP	HL		; Restore HL
	POP	AF		; Restore value
;
	ADD	A,E		; A=A+E
	LD	E,A
Š	LD	A,D		; Add to D if necessary
	ADC	A,0
	LD	D,A
;
	INC	HL		; Point to next digit
	JR	DECIN0

;-----------------------------------------------------------------------
;
; Binary input routine, result in HL.
;
BIN$IN:	LD	B,0		; Initialize binary digit accumulator
	LD	C,80H		; Start with leading ASCII digit
;
BILP:	LD	A,(HL)		; Get ASCII digit
	INC	HL		; Point to next
	CP	'0'		; '0'?
	JR	Z,B0		; Yes
;
B1:	LD	A,B		; '1', so put that binary digit in B
	OR	C
	LD	B,A
;
B0:	LD	A,C		; Check if last ASCII digit
	CP	1
	JR	Z,BFIN		; Yes
;
	RRCA			; Otherwise shift to next digit
	LD	C,A
	JR	BILP		; And process it
;
BFIN:	LD	L,B		; Put digit in HL
	LD	H,0
	RET

;-----------------------------------------------------------------------
;
; Character input routine, result in HL.
;
CHR$IN:	LD	B,7		; Skip 7 leading 0's
	CALL	INITDISP	; Strip leading 0's, point to ms digit
;
	LD	A,(HL)		; Get character
	LD	L,A		; Put it in HL
	LD	H,0
	RET

;-----------------------------------------------------------------------
;
; Put contents of register X in display buffer
;
INITBUF:LD	HL,DDIG8	; Initialize display pointer
	LD	(WPNTR),HL
;
	LD	HL,(SRX)	; Get contents of register X
Š	JP	HEX$OUT		; Fill buffer with register X contents
DISPCAL:EQU	$-2		; Modify call address to suit current
				;    calculator display mode

;-----------------------------------------------------------------------
;
; Convert contents of register X to hex ASCII string
;
HEX$OUT:LD	B,4		; First 4 positions are spaces
	CALL	BUFSP
;
	LD	A,H		; Get high byte
	CALL	HBOUT		; Display as hex digits
;
	LD	A,L		; Get low byte and fall thru
;
HBOUT:	PUSH	AF		; Save character
	AND	0F0H		; Get high nibble
	RRA			; Make it low
	RRA
	RRA
	RRA
	CALL	HDOUT		; Display as hex digit
	POP	AF		; Restore character
;
	AND	0FH		; Get low nibble and fall thru
;
HDOUT:	ADD	A,'0'		; Make it a number
	CP	':'
	JP	C,FBUF		; Add it to buffer if number
;
	ADD	A,7		; Make it a letter
	JP	FBUF		; Add it to buffer if letter

;-----------------------------------------------------------------------
;
; Convert contents of register X to decimal ASCII string
;
DEC$OUT:LD	B,3		; First 3 positions are spaces
	CALL	BUFSP
;
	LD	DE,10000	; Display 10000's
	CALL	DODIV
	LD	DE,1000		; Display 1000's
	CALL	DODIV
	LD	DE,100		; Display 100's
	CALL	DODIV
	LD	DE,10		; Display 10's
	CALL	DODIV
	LD	A,L		; Display 1's
	ADD	'0'		; Convert to ASCII
	JR	FBUF		; Add it to buffer and we're done
;
; Divide HL/DE and display quotient
;
ŠDODIV:	CALL	DIVIDE		; Quotient in HL
	LD	A,L		; Get low byte
	EX	DE,HL		; Put remainder in HL
	ADD	'0'		; Make ASCII
	JR	FBUF		; Add it to buffer

;-----------------------------------------------------------------------
;
; Convert contents of register X to binary ASCII string
;
BIN$OUT:LD	C,80H		; Start with msdigit
	LD	B,L		; Put low byte in L
;
BOLP:	CALL	BDOUT		; Display current binary digit
	LD	A,C		; Last binary digit?
	CP	1
	RET	Z
;
	RRCA			; Shift to next lower binary digit
	LD	C,A		; Save it
	JR	BOLP

;
BDOUT:	LD	A,B		; Get byte
	AND	C		; Get current binary digit
	LD	A,'0'		; Make it ASCII
	JR	Z,BDOUT0	; '0'
	INC	A		; Else make it '1'
;
BDOUT0:	JR	FBUF		; Add it to buffer

;-----------------------------------------------------------------------
;
; Convert contents of register X to ASCII character
;
CHR$OUT:LD	B,7		; Pad first 7 spaces
	CALL	BUFSP
;
	LD	A,L		; Get character
	CP	07FH		; Delete?
	JR	NZ,CO0		; No
;
	LD	L,0FFH		; Yes, set up to display it as ^?
	JR	CO1
;
CO0:	CP	' '		; Control character?
	JR	NC,FBUF		; No, just add it as is
;
CO1:	PUSH	HL		; Save character
	LD	HL,WPNTR	; Point to buffer pointer
	DEC	(HL)		; Back up one
	LD	A,'^'
	CALL	FBUF
	POP	HL		; Restore character
;
Š	LD	A,L		; Restore character
	ADD	40H		; Make it displayable and fall thru

;-----------------------------------------------------------------------
;
; FBUF
;
; Description:
;	Add digit in A to calculator digit buffer at position in WPNTR.
;
FBUF:	EXX			; Save registers
	LD	HL,(WPNTR)	; Get current buffer pointer
	LD	(HL),A		; Add current character
	INC	HL		; Bump pointer
	LD	(WPNTR),HL	; And save it
	EXX			; Restore registers
	RET

;-----------------------------------------------------------------------
;
; TYPE
;
; Description:
;	Console I/O routine also used by GETKEY.  Display character in
;	A on console, or if A=0FFh, get character from keyboard.
;
TYPE:	PUSH	BC		; Save registers
	PUSH	DE
	PUSH	HL
;
	 if	ztype=5 or ztype=6; - RSX or IOP version
	LD	C,A		; BIOS wants character in C
	CALL	BIOS$CONOUT	; <- Address filled in by HPRSX
	 else			; - COM version
	LD	C,DCONIO
	LD	E,A		; BDOS wants character in E
	CALL	BDOS
	 endif
;
	POP	HL		; Restore registers
	POP	DE
	POP	BC
;
; Re-initialize index registers in case BIOS messes with them
;
INITINDEX:
	LD	IX,NOENTR
	LD	IY,MAIN
	RET

;-----------------------------------------------------------------------
;
; CALCDISP
;
; Description:
Š;	Display header, mode and digits.
;
CALCDISP:
	LD	HL,HEADER	; Point to header message and fall thru

;-----------------------------------------------------------------------
;
; PRINT
;
; Description:
;	Display zero-terminated string pointed to by HL.
;
PRINT:	LD	A,(HL)		; Get character
	INC	HL		; Point to next
	OR	A
	RET	Z		; Quit if zero
	CALL	TYPE		; Display character
	JR	PRINT

;-----------------------------------------------------------------------
;
; GETKEY
;
; Description:
;	Wait for and get character from keyboard.
;
GETKEY:	 if	ztype=5	or ztype=6; - RSX or IOP version
	CALL	BIOS$CONIN
	 else			; - COM version
	LD	A,ON		; Get console input
	CALL	TYPE		; Direct console I/O
	OR	A		; Wait for character
	JR	Z,GETKEY	; And loop till we have one
	 endif
;
	LD	(TEMP1),A	; Save original character
;
; If lower case character, convert to upper case
;
	CP	'a'		; Skip if not lower case character
	RET	C
	CP	'z'+1
	RET	NC
	AND	05FH		; Otherwise make it upper case
	RET

;-----------------------------------------------------------------------
;
; PAD
;
; Entry:
;	A = character
;	B = number of characters to pad
;	HL = starting address
;
ŠPAD:	LD	(HL),A		; Store character in memory
	INC	HL		; Increment pointer
	DJNZ	PAD		; And pad till done
	RET

;-----------------------------------------------------------------------
;
; BUFSP
;
; Description:
;	Pad the buffer with a number of spaces.
;
; Entry:
;	B= number of spaces to fill
;
BUFSP:	LD	A,SPACE
;
BUFSP0:	CALL	FBUF
	DJNZ	BUFSP0
	RET

	 iff	ztype=6
;-----------------------------------------------------------------------
;
; MOVHEX
;
; Description:
;	Moves value in HL as 4 digit hex number to header message
;
; Entry:
;	DE = header message pointer
;	HL = value
;
; Exit:
;	Hex characters in header message
;
MOVHEX:	PUSH	AF		; Save AF
	LD	A,H		; Print H
	CALL	HEXA
	LD	A,L		; Print L
	CALL	HEXA
	POP	AF		; Restore AF
	RET
;
HEXA:	PUSH	AF		; Save AF
	PUSH	AF
	RRCA			; Exchange nybbles
	RRCA
	RRCA
	RRCA
	CALL	HEXA0		; Print low-order nybble as hex
	POP	AF		; Restore AF
	CALL	HEXA0		; Print low-order nybble as hex
	POP	AF		; Restore AF
	RET
Š;
HEXA0:	AND	0FH		; Mask for low nybble
	CP	10		; Letter or digit?
	JP	C,HEXDIG	; Digit if carry
;
	ADD	'A'-10		; Convert to 'A'-'F'
	JR	MOVA		; Move it
;
HEXDIG:	ADD	'0'		; Convert to '0'-'9'
;
MOVA:	LD	(DE),A		; Move it
	INC	DE		; Bump pointer
	RET
	 endif

;======================================================================
;
; Command tables
;
COMMANDS:
	DB	CTRLC		; Quit
	DB	ESC		; Prefix for command characters
	DB	CR		; Enter number
	DB	BS		; Delete last character
	DB	CTRLX		; Clear stack
;
; Commands that can be entered as characters
;
CMDTBL:	DB	'+'		; Add Y+X
	DB	'-'		; Subtract Y-X
	DB	'*'		; Multiply Y*X
	DB	'^'		; Exponentiate Y^X
	DB	'/'		; Divide Y/X
	DB	'&'		; Bitwise X&Y
	DB	'|'		; Bitwise X|Y
	DB	'~'		; Negation (2's complement) ~X
	DB	'='		; Exchange X<>Y
	DB	'S'		; Store X in memory register
	DB	'R'		; Recall memory register to X
	DB	'>'		; Roll stack up
	DB	'.'		; Roll stack up
	DB	'<'		; Roll stack down
	DB	','		; Roll stack down
	DB	'L'		; Restore last value of X
	 if	ztype=5 or ztype=6; - RSX or IOP version only
	DB	'W'		; Write display to host program
	 endif
;
CTLEN	EQU	$-CMDTBL	; Length of CMDTBL table
CMDLEN	EQU	$-COMMANDS	; Length of COMMAND table
;
; Command routine addresses in reverse order
;
CMDADDR: if	 ztype=5 or ztype=6; - RSX or IOP version only
	DW	WRITE		; Write display to host program
Š	 endif
	DW	LASTX		; Restore last value of X
	DW	ROLLDWN		; Roll stack down
	DW	ROLLDWN		; Roll stack down
	DW	ROLLUP		; Roll stack up
	DW	ROLLUP		; Roll stack up
	DW	RECALLX		; Recall memory register to X
	DW	STOREX		; Store X in memory register
	DW	EXCH		; Exchange X<>Y
	DW	NEGX		; Negation (2's complement) ~X
	DW	XORY		; Bitwise X|Y
	DW	XANDY		; Bitwise X&Y
	DW	DIVYX		; Divide Y/X
	DW	YEXPX		; Exponentiate Y^X
	DW	MULTXY		; Multiply Y*X
	DW	SUBXY		; Subtract Y-X
	DW	ADDXY		; Add Y+X
	DW	CLRSTK		; Clear stack
	DW	DELAST		; Delete last character
	DW	ENTER		; Enter number
	DW	MODECHK		; Check for command characters
	DW	DONE		; Quit

;-----------------------------------------------------------------------
;
; Range of characters permitted as numbers per current display mode.
;
NUMBERS:DB	'0123456789ABCDEF' ; Valid range of number characters

;-----------------------------------------------------------------------
;
; Exit point - old stack pointer stored in LD SP,xx instruction.
;
DONE:	 if	ztype=5 or ztype=6
	LD	A,CR		; Clear display on exit - RSX or IOP 
	CALL	TYPE		;    version
;
	LD	A,SPACE		; Clear display with spaces
	LD	B,45		; Number of spaces
;
FILL:	CALL	TYPE
	DJNZ	FILL
;
	LD	A,CR		; Park cursor at start of line
	CALL	TYPE
	 endif
;
OLDSP:	LD	SP,0		; Restore old stack pointer
	 if	ztype=5 or ztype=6; - RSX or IOP version
	JP	RSXSTART	; Return still waiting for input
	 else			; - COM version
	RET			; Quit
	 endif

;=======================================================================
Š;
; Data area
;
;-----------------------------------------------------------------------
;
; Stack registers
;
SRX:	DW	0		; Stack register X
SRY:	DW	0		; Stack register Y
SRZ:	DW	0		; Stack register Z
;
; NOTE:  Additional stack registers may be added here without
; changing any of the working code.  Just add them and reassemble.
;
SRT:	DW	0		; Stack register T (top of stack)
STKLEN	EQU	$-SRX		; Length of stack
;
LX:	DW	0		; Last-X value
;
; Memory registers
;
MREG0:	DW	0		; Memory register 0
	DW	0		; Memory register 1
	DW	0		; Memory register 2
	DW	0		; Memory register 3
	DW	0		; Memory register 4
	DW	0		; Memory register 5
MREGR:	DW	0		; Memory register R (for Remainder)
;
; Intermediate storage for DIVIDE
;
TEMP1:	DB	0		; Also used for original character
TEMP2:	DW	0
	 if	ztype=5 or ztype=6
WFLAG:	DB	0		; Write flag
	 endif
WPNTR:	DW	0		; Calculator display pointer
	 if	ztype=6
;-----------------------------------------------------------------------
;
; IOPINIT is always called by the IOP loader when the IOP is first
; loaded and never again.  The space used by this one-time code
; is then re-used as stack space.
;
; The seven character IO jumps in the main BIOS jump table are vectored
; to main IOP jump table.  The BIOS has a jump table similar to our 
; BIORET table whose targets go directly to the BIOS character IO routines.  
; The address of this table, IOPRET:, is maintained at BIOS+1.  The IOP
; is 'installed' by pointing the jumps in our table to the BIOS table. 
; If no IOP action is to take place, our jump table vectors through
; BIORET to the BIOS IOPRET table. 
;
IOPINIT:LD	HL,(1)		; BIOS +3
	DEC	HL		; BIOS +2
	LD	D,(HL)
Š	DEC	HL		; BIOS +1
	LD	E,(HL)		; BIOS IOPRET table
	LD	HL,BIORET	; Our BIOS return table
;
	LD	B,7		; Seven Jumps
	JP	TARGET
;
	DS	24+IOPINIT-$	; Additional stack area
	 else
;
; Local stack
;
	DS	24		
	 endif	;ztype=6
STACK	EQU	$

	END