;--------------------------- Z40-9 ---------------------------------
; Extended routine consolidation.
; Changes for Z40 (C) Copyright 1992 by  Harold F. Bower
;-------------------------------------------------------------------
; Print HL as 4 Hexidecimal Characters

	  IF  peekon OR [pokeon AND NOT pokeq] OR porton
	   IF  BANKED		;4.0E
	COMMON	/BANK2/		;4.0E
	   ENDIF		;4.0E
PHL4HC:	LD	A,H		; Print H in Hex
	CALL	PASHC		; ..w/leading Space
	LD	A,L		; Now Print L in Hex
	JR	PAHC		; ..No leading Space

;.....
; Print A as 2 Hex Chars
;   PASHC - Leading Space

PASHC:	PUSH	AF		; Save a
	CALL	PRINT
	DEFC	' '
	POP	AF
PAHC:	PUSH	AF		; Save the Byte
	RRCA			; Exchange nybbles
	RRCA
	RRCA
	RRCA
	CALL	PAH		; Print hex char
	POP	AF		; Restore the byte, print low nybble
PAH:	AND	0FH		; Mask
	ADD	A,90H		; Convert to ASCII Char
	DAA
	ADC	A,40H
	DAA
	JP	CONOUT
	   IF  BANKED		;4.0E
	CSEG			;4.0E
	   ENDIF		;4.0E
	  ENDIF		; Peekon OR [pokeon AND NOT pokeq] OR porton

;=============================================================================
;	G E N E R A L    S U B R O U T I N E S    S E C T I O N
;=============================================================================

WHLCHK:	PUSH	HL
	LD	HL,(Z3ENV+29H)		; Get address of wheel byte
	LD	A,(HL)			; Get the wheel byte itself
	OR	A			; Set the flags
	POP	HL
	RET

;-----------------------------------------------------------------------------
;	CHARACTER I/O BDOS ROUTINES
;-----------------------------------------------------------------------------
; Check for any character from the user console.  Return with the character
; in A.  If the character is a control-C, then the zero flag will be set.

	  if  subon or diron or eraon or lton
BREAK:	LD	C,B_RSTS	; BDOS console status function
	CALL	BDOSTEST	; Call BDOS:  A=0FFH if Char Ready
				; ..then, BDOSTEST increments this to 0
	RET	NZ		; Quit if Char ready, else fall thru to CONIN
	  endif		;subon or diron or eraon or lton

;-----------------------------------------------------------------------------
; Get uppercase character from console (with ^S processing).  All registers
; except A and C are preserved.  The character is returned in A.

CONIN:	LD	C,B_RCON	; BDOS conin function
	CALL	BDOSSAVE
				; ..Fall through to UCASE
;--------------------
; Convert character in A to upper case.  All registers except A are preserved.

UCASE:	AND	7FH		; Mask out msb
	  IF  subon OR diron OR eraon OR lton
	CP	CTRLC		; Check for Abort
	RET	Z		; ..and quit if so
	  ENDIF
	CP	'a'		; Less than lower-case 'a'?
	RET	C		; If so, return
	CP	'z'+1		; Greater than lower-case 'z'?
	RET	NC		; If so, return
	AND	5FH		; Otherwise capitalize
	RET

;----------------------------------------
; Output CRLF

CRLF:	CALL	PRINT
	DEFC	CR,LF
	RET

;----------------------------------------
; Print the character string immediately following the call to this routine.
; The string terminates with a character whose high bit is set or with a null.
; At entry point PRINTC the string is automatically preceded by a
; carriage-return-linefeed sequence.  All registers are preserved except A.

PRINTC:	CALL	CRLF		; New line
PRINT:	EX	(SP),HL		; Get pointer to string
	CALL	PRINTHL		; Print string
	EX	(SP),HL		; Restore HL and set return address
	RET

;----------------------------------------
; Print the character string pointed to by HL.  Terminate on character with
; the high bit set or on a null character.  On return HL points to the byte
; after the last character displayed.  All other registers except A are
; preserved.

PRINTHL1:  CALL	CONOUT		; Print character
PRINTHL: LD	A,(HL)		; Get a character
	INC	HL		; Point to next byte
	RLC	A		; End of string null?
	RET	Z
	SRL	A		; Mask out msb (into C-flag)
	JR	NC,PRINTHL1	; More characters to come
				; Falls through to conout for last character
;----------------------------------------
; Output character in A to the console.  All registers are preserved.

CONOUT:	PUSH	BC
	LD	C,B_SCON	; BDOS conout function
OUTPUT:	PUSH	DE		; Entry point for LCOUT (Z34-5.Z80)
	LD	E,A
	JR	BDOSSAV2

;---------------------------------------
; Output character to the Console.  LOUTP has char on stack top, LOUT in A.

	  IF  lton
	   IF  BANKED		;4.0E
	COMMON	/BANK2/		;4.0E
	   ENDIF		;4.0E
LOUTP	POP	AF		; Restore the character
LOUT:	PUSH	BC		; Output to list device (possibly used by FEED)
	LD	C,B_SLST	; LISTOUT function
	   IF  BANKED		;4.0E
	JP	OUTPUT		;4.0E Use Long jump if banked
	CSEG			;4.0E
	   ELSE			;4.0E
	JR	OUTPUT		; Use short jump if Not banked
	   ENDIF		;4.0E
	  ENDIF		; lton

;-----------------------------------------------------------------------------
;	FILE I/O BDOS ROUTINES
;-----------------------------------------------------------------------------
; Write From SYS Bank using CMDFCB insuring data comes from TPA Bank

	  IF  BANKED
WRFILB:	CALL	GO_TPA		; Insure TPA in context
	CALL	WRFILV		; .Write the file to FCB in DE
	JP	GO_SYS		; ..Restore SYS Bank and return
	  ENDIF

;.....
; Read a record from the command file named in CMDFCB

READCMD: LD	DE,CMDFCB

; Read a record from file whose FCB is pointed to by DE

READ:	PUSH	BC		; Save BC Regs
	LD	C,B_FRD		; Read-sequential function
	DEFB	06H		; ..fall thru to BDOSSAV1 trashing B

;--------------------
; Call BDOS for read and write operations.  The flags are set appropriately.
; The BC, DE, and HL registers are preserved.

BDOSSAVE: PUSH	 BC
BDOSSAV1: PUSH	 DE
BDOSSAV2: PUSH	 HL
	  CALL	 BDOS
	  POP	 HL
	  POP	 DE
	  POP	 BC
	  OR	 A		; Set flags
NOTE:	  RET			; This return is used for NOTE command, too

;-----------------------------------------------------------------------------
;	MISCELLANEOUS BDOS ROUTINES
;-----------------------------------------------------------------------------
; Set DMA address.  At the entry point DEFLTDMA the address is set to the
; default value of 80H.  At the entry point DMASET it is set to the value
; passed in the DE registers.

DEFLTDMA: LD	DE,TBUFF
DMASET:	  LD	C,B_SDMA
	  JR	BDOSSAVE

;----------------------------------------
; Log drive and user according to DE

LOGDE:	CALL	SETUSER1	; Log into the User in E
	LD	E,D		; .Position Drive number for Logging
	LD	C,B_SDRV	; ..load Command to Log Drive
	JR	BDOSSAVE	; ...and execute

;----------------------------------------
; Open a file.  At entry point OPENCMD the file is the one specified in
; CMDFCB, and the current record is set to zero.  At entry point OPEN
; the file whose FCB is pointed to by DE is used.

OPENCMD: XOR	A		; Set current record to 0
	LD	(CMDFCB+32),A
	LD	DE,CMDFCB	; Command File Control Block

OPEN:	LD	C,B_FOPN	; BDOS open function
				; Fall through to BDOSTEST
;--------------------
; Invoke BDOS for disk functions.  This routine increments the return code in
; register A so that the zero flag is set if there was an error.  Registers
; BC, DE, and HL are preserved.

BDOSTEST: CALL	BDOSSAVE
	INC	A		; Set zero flag for error return
	RET

;----------------------------------------
; Return Currently-logged Drive from Dos in [1..16]

GETDRV:	LD	C,B_GDRV	; Set Return Current Drive Function
	JR	BDOSTEST	; ..execute and return drive in 1..16

;----------------------------------------
; Close file described by TFCB

	  IF  saveon or copyon
CLOSETF: LD	DE,TFCB
	  ENDIF
			;..fall thru to..
;----------------------------------------
; Close file whose FCB is pointed to by DE.

	  IF  saveon OR subon
CLOSE:	LD	C,B_FCLS
	JR	BDOSTEST
	  ENDIF		;saveon or subon

;----------------------------------------
; Search for first matching file.  At entry point SRCHFST1 the first default
; FCB is used.  At entry point SRCHFST the FCB pointed to by DE is used.

	   IF  diron OR eraon OR renon OR saveon
SRCHFST1: LD	DE,TFCB		; Use first default FCB
	   ENDIF	;diron or eraon or renon or saveon
SRCHFST: LD	C,B_FSRF	; Bdos Search First Function
	JR	BDOSTEST

;-----------------------------------------------------------------------------
; Search for next matching file whose FCB is pointed to by DE.

	  IF  diron OR eraon	; Only needed by DIR and ERA functions
SRCHNXT: LD	C,B_FSRN	; Bdos Search Next function
	JR	BDOSTEST
	  ENDIF		; diron or eraon

;-----------------------------------------------------------------------------
; Kill any submit file that is executing.

	  IF  subon
SUBKIL:	LD	HL,SUBFLAG	; Check for submit file in execution
	LD	A,(HL)
	OR	A		; 0=no
	RET	Z		; If none executing, return now
				; Kill submit file
	XOR	A
	LD	(HL),A		; Zero submit flag

	   IF  subzero		; If all submits through user 0
	CALL	SETUSER		; Log in user 0
	   ENDIF	;subzero

	LD	DE,SUBFCB	; Delete submit file
	  ENDIF		; subon
				; ..by falling through to delete routine
;--------------------
; Delete file whose FCB is pointed to by DE.

	  IF  eraon OR renon OR saveon OR subon
DELETE:	LD	C,B_FERA
	JR	BDOSSAVE
	  ENDIF		;eraon or renon or saveon or subon

;-----------------------------------------------------------------------------
; Get and set user number.  Registers B, C, D, H, and L are preserved.
; Register E is also preserved at entry point SETUSER1.

;4.0E GETUSER: LD	A,0FFH		; Get current user number

SETUSER: LD	E,A		; User number in E
SETUSER1: PUSH	BC		; Preserve BC
	LD	C,B_SUSR	; Get/Set User BDOS function
	JR	BDOSSAV1

;----------------------------------------
; Subroutine to display the 'no file' error message for the built-in
; commands DIR, ERA, LIST, TYPE, and/or REN.

	  IF  diron OR eraon OR copyon OR proton
PRNNF:	CALL	PRINTC		; No file message
	DEFC	'No File'
	RET
	  ENDIF		; diron or eraon or copyon or proton

;-----------------------------------------------------------------------------
; Add A to HL (HL=HL+A)

ADDAH:	ADD	A,L
	LD	L,A
	RET	NC
	INC	H
	RET

;---------------------------------------------------------------------
; Print the contents of the HL register pair as up to 5 decimal digits

	  IF  BANKED		;4.0E
	COMMON	/BANK2/		;4.0E
	  ENDIF			;4.0E

	  IF  freeon OR incltim OR regon
PRSIZ16: LD	B,0		; Initialize flag for digits printed
	LD	DE,10000	; Divisor in DE
	CALL	DECDSP		; Print digit if there
PRSZ1K:	LD	DE,1000	
	CALL	DECDSP		; Print if non-0 or previous print
	LD	DE,100
	CALL	DECDSP		; Print if non-0 or previous print
	LD	DE,10
	CALL	DECDSP		; Print if non-0 or previous print
	LD	A,L		; Get 1's
	JR	DECDS0		; ..and print

;.....
; Divide HL by DE converting remainder to ascii digit and printing it if
; the number is Non-Zero or a digit was previously printed

DECDSP:	OR	-1		; Clear flag and set initial count
DECDSL:	SBC	HL,DE		; Divide by subtraction
	INC	A		; .adjust counter
	JR	NC,DECDSL	; ..loop til done
	ADD	HL,DE		; Compensate for underflow
	JR	NZ,DECDS0	; ..jump if Non-zero div result
	OR	B		; Else check for previous print
	RET	Z		; ..return if No prev char & Zero result
	XOR	A		; Otherwise print a Zero
DECDS0:	ADD	A,'0'		; Convert to Ascii digit
	LD	B,A		; ..and set flag for next pass
	JP	CONOUT		; Jump to Conout routine & return
	  ENDIF		; freeon OR incltim OR regon

;---------------------------------------------------------------------
; Print file name pointed to by HL

	  IF  diron OR renon OR saveon OR eraon
PRFN:	LD	B,8		; Display 8 characters in name
	CALL	PRFN1
	CALL	PRINT		; Put in dot
	DEFC	'.'
	LD	B,3		; Display 3 characters in type
PRFN1:	LD	A,(HL)		; Get character
	INC	HL		; Point to next
	CALL	CONOUT		; Print character
	DJNZ	PRFN1		; Loop through them all
	RET
	  ENDIF		;diron or renon or saveon or eraon

;---------------------------------------------------------------------
; Print the Time String if requested by INCLTIM equate.  The Time is read to
; the current Bank, Not TPA as with Disk Accesses.

	  IF  BANKED		;4.0E
	COMMON	/BANK2/		;4.0E
	  ENDIF			;4.0E

	  IF  incltim
PRTIME:	CALL	RDCLOK		; Try to read a clock (Zsdos or DateStamper)
	LD	HL,TBUFF+3	; Point to Hours byte
	LD	B,2		; .set for two bytes of real time
	CALL	Z,PRHMS		; ..print if Good read
	CALL	PRINT		; Print separator
	DEFC	' - '
	RET			; ..and return
	  ENDIF		; Incltim

;-----------------------------------------------------------------------
; Set the ZSDos clock from default Buffer

	  IF  dateon OR timeon

STCLOK:
	   IF  zsdos
	LD	C,B_STIM
	JR	RDCLOV
	   ENDIF
	  ENDIF

;-----------------------------------------------------------------------

; Read the ZSDos or DateStamper clock to the default Buffer

	  IF  incltim OR dateon OR timeon
RDCLOK:
	   IF  zsdos
	LD	C,B_GTIM	; ZsDos Get Time Function
RDCLOV:	LD	DE,TBUFF	; Get it here
	CALL	BDOSSAVE
	DEC	A		; Good Read? (return Zero if so)
	RET
	   ELSE			; If Not Zsdos, try to read DateStamper
	LD	E,'D'		; See if Date Stamper is installed
	LD	C,B_GVER	; Get Dos Version # w/CPM call
	CALL	BDOS
	CP	22H		; Is the DOS 2.2 compatible?
	RET	NZ		; ..quit here if Not
	LD	A,H		; Check DS return char
	CP	'D'		; Is it the DateStamper flag?
	RET	NZ		; ..quit here if Not
	LD	A,E		; Is a clock installed?
	OR	D
	JR	Z,NOCLK		; ..return bad if Not
	LD	HL,DSRETN	; Load return addr
	PUSH	HL		; .to stack
	PUSH	DE		; ..along with Clock addr
	LD	HL,TBUFF	; Set buffer for Time
	RET			; "Call" clock returning to Good Exit

NOCLK:	DEFB	0F6H		; On Bad exit, do "OR  0AFH" to set Non-zero
DSRETN:	XOR	A		; Return Good on assumption
	RET
	   ENDIF	; Not Zsdos
	  ENDIF		; incltim or dateon or timeon

;.....
; Print Hours, Minutes, and/or Seconds
; Enter with HL pointing to Hours field, B containing number of fields [1..3]

	  IF  incltim OR timeon
PRHMS:	BIT	7,(HL)		; Is it Relative Time?
	JR	Z,PRRTC		; ..jump if Real Time, Not Rel
	LD	A,(HL)		; Else Get 15-bit count
	INC	HL
	LD	L,(HL)
	AND	7FH
	LD	H,A		; .to HL
	CALL	PRINT		; Print Rel indicator
	DEFC	'+'
	CALL	PRSIZ16		; .print Count
	RET			; ..and return

PRRTC0:	CALL	PRINT		; Print Time sep
	DEFC	':'
PRRTC:	LD	A,(HL)		; Get a byte Directly
	INC	HL		; ..advancing ptr
	CALL	PAHC		; Print 2 BCD digits
	DJNZ	PRRTC0		; .looping til done
	RET			; ..then quit
	  ENDIF		;incltim or timeon

	  IF  BANKED		;4.0E
	CSEG			;4.0E
	  ENDIF			;4.0E

;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;		S U P P O R T    R O U T I N E S
;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;.....
; Scan for first Non-blank char in Command Line Tail returning ptr in HL.
; If No line (Null detected), print No Args Error Message.

	  IF  pokeon OR porton
SETLN:	LD	HL,TBUFF+1	; Point to 1st char in Command Tail
	CALL	SKSP		; .skip to first Non-Blank Char
	RET	NZ		; ..return if we found one
	POP	HL		; Else Clear Return Addr from Stack
NOARGS:	CALL	PRINT		; Print Err Msg and return
	DEFC	' Arg?'
	RET			;..and return to ZCPR
	  ENDIF		; Pokeon or porton

;.....
; Print Spaces to console

	  IF  peekon OR helpon
SPACP:
	   IF  BANKED
	LD	B,12		; Space farther for Bank # print
	   ELSE
	LD	B,9		; Output leading spaces
	   ENDIF
SPACER:	CALL	PRINT
	DEFC	' '
	DJNZ	SPACER
	RET
	  ENDIF

;.....
;4.0E Check for "fn.ft=fn.ft" format or "fn.ft fn.ft" format, reverse if latter
;4.0E  Used by CP and REN commands

	  IF  BANKED		;4.0E
	COMMON	/BANK2/		;4.0E
	  ENDIF			;4.0E
CHKREV:	LD	A,(DELIM2)	;4.0E Load the parse delimiter
	CP	'='		;4.0E Normal fn.ft=fn.ft syntax?
	RET	Z		;4.0E ..return if So
	LD	HL,TFCB		;4.0E Point to start of first FCB
	LD	DE,TFCB2	;4.0E .and start of Second FCB
	LD	B,16		;4.0E ..Exchange 16 bytes
SWPFCL:	LD	C,(HL)		;4.0E Get byte from 1st
	LD	A,(DE)		;4.0E .byte from 2nd
	EX	DE,HL		;4.0E ..exchange ptrs
	LD	(HL),C		;4.0E Store 1st's byte in 2nd
	LD	(DE),A		;4.0E .and 2nd's byte in 1st
	EX	DE,HL		;4.0E ..swap ptrs back again
	INC	HL		;4.0E
	INC	DE		;4.0E Bump ptrs
	DJNZ	SWPFCL		;4.0E .loop til done
	RET			;4.0E ..and return

;.....
; Build a buffer of Directory entries matching the FCB pted to by DE
;  immediately below the lowest reserved point in memory insuring that
;  it doesn't extend below 8000H

GETDIR:	CALL	GETTOP		; Get base of OS
	DEC	HL		; .down one to keep from clobbering it
	LD	(HL),0		; ..add an ending Null
	LD	(NXTFIL),HL	; ...and store this address
	CALL	SRCHFST1	; Search for first match on FCB
	RET	Z		; ..return if No files
GETDI0:	DEC	A		; Else make 1..4 to 0..3
	RRCA			; Rotate
	RRCA
	RRCA			; ..to give index * 32
	LD	HL,TBUFF	; Set base address
	CALL	ADDAH		; .add offset for desired file
	INC	HL		; ..and advance to 1st char of FN
	EX	DE,HL		; Save Source in DE
	LD	BC,-11		; Subtract size of entries
	LD	HL,(NXTFIL)	; .from base of Directory array
	ADD	HL,BC		; ..by adding negative of size
	BIT	7,H		; Did we go below 8000H?
	JR	NZ,GETDI1	; ..jump if Not to continue
	CALL	PRINT		; Else say we have an error
	DEFB	'Too Many Files!',CR,LF+80H
	JR	GETOKX		; ..exit saying we have files

GETDI1:	LD	(NXTFIL),HL	; Save new base pointer
	EX	DE,HL		; .place Source and Dest in correct regs
	LD	BC,11		; ..set size of move
	LDIR			; ...and insert new fn.ft
	CALL	BREAK		; Are we aborting?
	JR	NZ,GETDI2	; ..jump if No break
	POP	DE		; Else trash return addr here
	RET			; ..and quit whole routine if Abort

GETDI2:	LD	DE,TFCB		; Else set for search next
	CALL	SRCHNXT		; Any more files there?
	JR	NZ,GETDI0	; .jump to try again if we have a file
GETOKX:	OR	0FFH		; ..say we have some files
	RET			; ...return to caller

;---------------------------------------------------------------------
; Get a byte from an alternate bank if operating in Banked Mode (Peek)

	  IF  BANKED AND peekon
GBBYT:	PUSH	BC		; Save regs
PBANK:	LD	C,00		; .to correct register (inline mod)
	  ENDIF
	  IF  BANKED AND [peekon OR echoon OR lton]
GBBYT0:	CALL	GETBYT		; ..fetch byte to reg A using banked routine
	POP	BC		; Restore regs
	RET
	  ENDIF

;--------------------------------------------------------------------
; Put a byte from A reg to Address in (DE) in Bank # contained in C

	  IF  BANKED AND pokeon	;4.0E
PUTCHB:	EX	DE,HL		;4.0E Dest ptr to HL
	CALL	PUTBYT		;4.0E .Save A at Bank in C, Address in (HL)
	EX	DE,HL		;4.0E ..restore regs
	RET			;4.0E
	CSEG			;4.0E
	  ENDIF			;4.0E

;.....
; Return the lowest point in the OS, BDOS Vector or base of CCP

GETTOP:	LD	DE,ENTRY	; Point to start of CPR
	LD	HL,(BDOS+1)	; Get Bdos vector in case of RSX
	LD	A,L
	SUB	E
	LD	A,H
	SBC	A,D		; Do we have RSX (Bdos < CPR)?
	RET	C		; ..return with Bdos Vector if so
	EX	DE,HL		; Else place CPR start as vector
	RET			; ..and return it

;---------------------------------------------------------------------
;  The following routines are only needed in Banked portions of
;  routines, and are placed in the System bank if possible.

;.....
; Convert character in A to Lowercase if possible

	  IF  helpon OR echoon
LCASE:	AND	7FH		; Insure normal ASCII Char
	CP	'A'		; Less than 'A'?
	RET	C		; ..exit here if so
	CP	'Z'+1		; Greater than 'Z'?
	RET	NC		; ..exit here if so
	ADD	A,20H		; Else convert to lower case
	RET			; ..and return to caller
	  ENDIF		; helpon or echoon

;.....
; Copy TFCB and TFCB2 data into High Memory at the External FCB at CMDFCB

	  IF  BANKED		;4.0E

MOV2CMD: PUSH	HL		; Save any pointer here
	LD	HL,TFCB		; Source is Beginning of FCB
	LD	DE,CMDFCB	; .dest is CMDFCB
	LD	BC,33		; ..for full FCB + NR
	LDIR			; ...move it!
	POP	HL		; Restore reg
	RET			; ..and back to caller

	CSEG			;4.0E If banked, restore Code Segment
	  ENDIF			;4.0E

;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;	B A N K I N G    S U P P O R T    R O U T I N E S
;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

	  IF  BANKED

; Switch SYStem Bank in Context

GO_SYS:	PUSH	AF		;4.0E Save Regs
	LD	A,(SYSBNK)	;4.0E Get system bank #
	JR	GO_V		;4.0E ..and vector to set bank

DOITMV:	PUSH	HL		;4.0E Save regs
	PUSH	DE		;4.0E
	LD	BC,(TPABNK)	;4.0E Get TPA(C) and SYS(B) Bank #s
	CALL	XMOVE		;4.0E ..set as Source and Destination
	LD	HL,TFCB		;4.0E Move from FCB in TPA
	LD	E,L		;4.0E
	LD	D,H		;4.0E .to FCB in SYS Bank
	LD	BC,100H-TFCB	;4.0E ..through end of TBUFF
	CALL	MOVE		;4.0E ...returning via Stack
	POP	DE		;4.0E Restore regs
	POP	HL		;4.0E
			;..fall thru to Execute the banked routine
; Switch SYStem bank in Context, Call routine at (HL), and return TPA Context

DOIT:	CALL	GO_SYS		;4.0E Place SYStem Bank in Context
	CALL	JPHL		;4.0E .call the routine pted to by HL
			;4.0E..fall thru to restore TPA to Context & quit..
; Switch TPA Bank in Context

GO_TPA:	PUSH	AF		;4.0E Save Regs
	LD	A,(TPABNK)	;4.0E Get TPA bank #
GO_V:	CALL	SELMEM		;4.0E .and activate with B/P Bios Jump 27
	POP	AF		;4.0E ...restore regs afterwards
	RET			;4.0E

; Execute the routine addressed by (HL).  Call here is CALL to (HL)

JPHL:	JP	(HL)		;4.0E Jump to Routine addr in HL
	  ENDIF

;  End of Z40-9.Z80