; Package: CALCIOP.Z80
; Author:  Bruce Morgen
; Date:    December 27, 1990

; CALCIOP is an IOP version of the classic Eric Meyer HP calculator, 
; in ZRL format for JetLdr or the NZCOM loader.  The great bulk of the 
; code is from Carson Wilson's CALCRCP, grafted to a modified version 
; Joe Wright's NZIOP skeleton from NZ-SRC.LBR.  Unlike CALCRCP, there 
; is no "CALC" command -- CALCIOP is disabled by simply loading 
; another IOP.
; ____________________________________________________________________________
;
; Package: NZIOP.Z80
; Author:  Joe Wright
; Date:    30 July 1987
; Version: 1.0

; NZ-COM and all its associated files are Copyright (C) 1987, 1988
; by Joe Wright and by Alpha Systems Corporation.  This file is released
; for information and use by registered owners of NZ-COM for personal
; non-commercial purposes.  Any commercial use (resale) of any part of
; NZ-COM requires specific license by:
;
; Alpha Systems Corporation
; 711 Chatsworth Place
; San Jose, CA 95128
; 408/297-5594

; Version 1.2  24 Feb 88
; Modified to avoid Named COMMONs, checking everything dynamically.
; It is always assumed that TINIT is called by an appropriate Z3 loader.

; This is the basis of the 'extended' IOP.  This particular file
; is used by NZ-COM to create the initial IOP structure in memory.
; It may also be used as a 'DUMMY' to overlay (remove) an existing
; IOP.

; The discerning reader may determine to use this file as the basis
; for his own custom IOP.

	name	('IOP')		; REL module name
;
iop:	jp	status		; Internal status routine
	jp	select		; Device select routine
	jp	namer		; Device name routine
	jp	tinit		; Initialize terminal. ldr jumps here
;
cons:	jp	const		; Console input status
	jp	newin		; Console input char (was "jp conin")
	jp	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	newio		; New i/o driver installation routine
	jp	copen		; Open con: disk file
	jp	cclose		; Close con: disk file
	jp	lopen		; Open lst: disk file
	jp	lclose		; Close lst: disk file
;
;  I/O Package Identification at IOP+48
;
	db	'Z3IOP'		; Read by LDR.COM for identification.
;
;  Name of this package at IOP+53
;
	db	'Calc_1.0'	; Name of this package (always 8 bytes)
;
; Direct entry to the bios, filled in by TINIT (IOP+61).
;
auxjmp:
;
const:	jp	0
conin:	jp	0
conout:	jp	0
list:	jp	0
punch:	jp	0
reader:	jp	0
listst:	jp	0
;
; The main body of the IO Package starts here.
; The preceding jumps and package ID MUST remain in their present
; positions.  Code that follows is free-form.
;
status:				; Internal status 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 to this pak returns zero
	ret
;
; Select (B=0ffh) will effectively remove this IOP
;
select:	inc	b
	jr	nz,zero		; Not recognized
;
; Point our jump table to auxjmp so that all character IO
; is vectored directly to the bios, effectively removing us.
;
	ld	hl,cons		; Our jump table
	ld	de,auxjmp	; Our auxiliary jumps to bios
	ld	b,7		; Seven of them
	jr	target		; Change the jump targets
;
; Modify  bios' jump targets at HL by DE
;
modjmp:	ld	l,6		; Bios CONST entry
	ld	b,l		; Six targets to change (was "ld b,6")
	call	target
	ld	l,45		; Point to LISTST
	inc	b		; One target (was "ld b,1)
				; (B=0 from CALL TARGET)
;
; Replace jump target at HL+1 with DE, increment HL and DE by 3.
;
target:	inc	hl		; Point to target
	ld	(hl),e
	inc	hl
	ld	(hl),d
	inc	hl
	inc	de
	inc	de
	inc	de
	djnz	target
	or	255		; Set NZ
	ret
;
; Initialize this package (called by NZCOM, LDR and/or JetLDR)
; Get address of bios in HL and bios aux jumps in DE
;
tinit:	ld	hl,(1)		; Bios entry
	dec	hl
	ld	d,(hl)
	dec	hl
	ld	e,(hl)
	ld	a,(108h)	; Z3 Environment Type (01h if LDR or JetLDR)
	dec	a
	jr	z,instal	; Called by LDR or JetLDR
;
	ld	hl,(145h)	; Indirect BIO address if NZCOM
	ld	d,h
	ld	e,82h		; Offset to NZBIO aux jumps
;
; Enter with DE pointing to BIOS aux jumps. Install ours.
;
instal:	push	hl		; Bios jumps
	ld	hl,auxjmp	; Our auxjmp table
	ld	b,7
	call	target
	pop	hl		; Bios jump table
;
; Point bios jumps to our jump table.
;  HL points into bios jumps
;
	ld	de,cons		; Our jump table
	jr	modjmp		; Quit.
;
trigger	equ	'\'-'@'
;
newin:	call	conin		; Bring key in
	cp	trigger		; Is it the trigger key?
	ret	nz		; No - business as usual
;
	ld	(savstk),sp	; Yes, run calculator
	ld	sp,newstk
;
	push	ix		; We probably don't need to do
	push	iy		; this, but cost is trivial...
	push	af
	push	bc
	push	de
	push	hl
;

;
; ********** Begin Calculator *********
;
; This is a modified disassembly of HP.COM by Eric Meyer.  In place
; of the HP prompt, I have substituted a more informative one.
; Relative jumps are substituted for absolute ones where possible.
; The exit and entry routines have been replaced by my own routines
; which appear immediately before and after the calculator routine.
; The exit key has been changed from ^C to ^\ to maintain
; consistency with the trigger key.  Finally, direct BIOS calls
; replace BDOS calls to conin and conout, and a routine which
; replaces echoed characters from BDOS conin is no longer
; necessary.
;
start:	xor	a
	ld	(r17),a
s9:	ld	hl,signon
	call	strout
	call	s2
	ld	hl,(r4)
	call	s3
	ld	hl,r5
	ld	b,8		; Print 8 spaces
prompt:	ld	(hl),' '
	inc	hl
	djnz	prompt
	ld	hl,r5		; Print prompt "H>"
	call	strout
	xor	a
	ld	(r3),a
getin:	call	s4		; Get input from BIOS
	cp	trigger		; RCP trigger key
	jp	z,quit		; End program
	cp	1bh
	jp	z,esc
	cp	'+'
	jp	z,plus
	cp	'-'
	jp	z,minus
	cp	'*'
	jp	z,times
	cp	'^'
	jp	z,exp
	cp	'/'
	jp	z,div
	cp	'%'
	jp	z,remain
	cp	'&'
	jp	z,bitand
	cp	'|'
	jp	z,bitor
	cp	'~'
	jp	z,negate
	cp	0dh
	jr	z,run
	cp	8
	jr	z,backsp
	cp	'='
	jp	z,equals
	cp	18h		; ^X
	jr	z,clear
	cp	'S'
	jp	z,save
	cp	's'
	jp	z,save
	cp	'R'
	jp	z,recall
	cp	'r'
	jp	z,recall
	cp	'!'		; Space or control char?
	jp	c,illegal	; Yes - error
s23:	ld	hl,r7
	ld	de,r5
	ld	bc,7
	ldir
	ld	(r8),a
	ld	a,0ffh
	ld	(r3),a
s8:	ld	hl,signon	; Reprint prompt
	call	strout
	call	s2
	ld	hl,r5
	call	strout
	jp	getin		; Get input
backsp:	ld	a,(r3)
	or	a
	jr	z,s7
	ld	hl,r9
	ld	de,r8
	ld	bc,7
	lddr
	ld	a,' '
	ld	(r5),a
	jr	s8
s7:	ld	hl,0
	ld	(r4),hl
	ld	a,0ffh
	ld	(r17),a
	jp	s9
clear:	ld	hl,r4		; Clear registers
	ld	b,10h		; (16 bytes)
s10:	ld	(hl),0
	inc	hl
	djnz	s10
	jp	s9
run:	call	s11
	call	s12
	ld	a,0ffh
	ld	(r17),a
	jp	s9
equals:	call	s11
	ld	hl,(r4)
	ex	de,hl
	ld	hl,(r10)
	ex	de,hl
	ld	(r10),hl
	ex	de,hl
	ld	(r4),hl
	jp	start
negate:	call	s11
	ld	hl,(r4)
	ld	a,h
	cpl
	ld	h,a
	ld	a,l
	cpl
	ld	l,a
	inc	hl
	ld	(r4),hl
	jp	start
bitor:	call	s11
	call	s14
	ld	a,h
	or	d
	ld	h,a
	ld	a,l
	or	e
	ld	l,a
s16:	ld	(r10),hl
	call	s15
	jp	start
bitand:	call	s11		; Bitwise and
	call	s14
	ld	a,h
	and	d
	ld	h,a
	ld	a,l
	and	e
	ld	l,a
	jr	s16
remain:	call	s11		; Remainder
	call	s14
	call	s17
	jp	c,s18
	ex	de,hl
	jr	s16
div:	call	s11
	call	s14
	call	s17
	jp	c,s18
	jr	s16
times:	call	s11
	call	s14
	call	s19
	jp	c,s18
	jr	s16
exp:	call	s11
	call	s14
	ld	a,d
	or	e
	jr	nz,s20
	ld	hl,1
	jr	s16
s20:	ld	b,d
	ld	c,e
	ld	d,h
	ld	e,l
s21:	dec	bc
	ld	a,b
	or	c
	jr	z,s16
	push	bc
	push	de
	call	s19
	pop	de
	pop	bc
	jp	c,s18
	jr	s21
minus:	call	s11
	call	s14
	sbc	hl,de
	jr	s16
plus:	call	s11
	call	s14
	add	hl,de
	jr	s16
save:	call	s11
	call	s4
	cp	'4'		; Legal register?
	jp	nc,s18
	sub	'1'		; Legal register?
	jp	c,s18
	add	a,a
	ld	e,a
	ld	d,0
	ld	hl,r11
	add	hl,de
	ld	a,(r4)
	ld	(hl),a
	inc	hl
	ld	a,(r12)
	ld	(hl),a
	jp	start
recall:	call	s11
	call	s4
	cp	'4'
	jp	nc,s18
	sub	'1'
	jp	c,s18
	add	a,a
	ld	e,a
	ld	d,0
	ld	hl,r11
	add	hl,de
	ld	a,(r17)
	or	a
	jr	nz,s22
	push	hl
	call	s12
	pop	hl
s22:	ld	a,(hl)
	ld	(r4),a
	inc	hl
	ld	a,(hl)
	ld	(r12),a
	jp	start
chars:	db	'+-*^/%&~=|SsRr' ; Legal commands
esc:	call	s4
	ld	hl,chars
	ld	b,0eh
s24:	cp	(hl)
	jp	z,s23
	inc	hl
	djnz	s24
	and	5fh
	push	af
	call	s11
	pop	af
	cp	'H'		; Switch to hex
	jr	z,hex
	cp	'D'		; Switch to decimal
	jr	z,dec
	cp	'B'		; Switch to binary
	jr	z,bin
	cp	'C'		; Switch to character
	jr	z,char
	jr	s18
hex:	ld	hl,s25
	ld	de,s26
	jr	s27
dec:	ld	hl,s28
	ld	de,s29
	jr	s27
bin:	ld	hl,s30
	ld	de,s31
	jr	s27
char:	ld	hl,s32
	ld	de,s33
s27:	ld	(r13),a
	ld	(scale),hl	; Store current scale = hex, dec, etc.
	ex	de,hl
	ld	(r14),hl
	jp	start
s14:	ld	hl,(r4)
	ex	de,hl
	ld	hl,(r10)
	ret
s11:	ld	a,(r3)
	or	a
	ret	z
	ld	hl,r5
	call	s35
	jr	c,s36		; Illegal - ring bell
	ld	a,(r17)
	or	a
	jr	nz,s37
	push	hl
	call	s12
	pop	hl
s37:	ld	(r4),hl
	xor	a
	ld	(r17),a
	ret
s36:	pop	hl
illegal:
	ld	a,7		; Ring bell
	call	charout
	jp	s8
s18:	ld	a,7
	call	charout
	jp	start
s15:	ld	hl,r10
	ld	de,r4
	ld	bc,0eh
	ldir
	ret
s12:	ld	hl,r15
	ld	de,r16
	ld	bc,0eh
	lddr
	ret
s2:	ld	a,(r13)
	call	charout
	ld	a,'>'		; Prompt
	call	charout
	ld	a,' '		; Prompt: "H> "
	jp	charout

s19:	ld	c,l
	ld	b,h
	ld	hl,0
	ld	a,0fh
s40:	push	af
	or	d
	jp	p,s38
	add	hl,bc
	jp	c,s39
s38:	add	hl,hl
	jp	c,s39
	ex	de,hl
	add	hl,hl
	ex	de,hl
	pop	af
	dec	a
	jr	nz,s40
	or	d
	ret	p
	add	hl,bc
	ret
s17:	ld	a,e
	or	d
	jr	z,s41
	ld	c,l
	ld	b,h
	ld	hl,0
	ld	a,10h
	or	a
s43:	ld	(r20),a
	rl	c
	rl	b
	rl	l
	rl	h
	ld	(r21),hl
	sbc	hl,de
	ccf
	jr	c,s42
	ld	hl,(r21)
s42:	ld	a,(r20)
	dec	a
	jr	nz,s43
	ex	de,hl
	rl	c
	ld	l,c
	rl	b
	ld	h,b
	or	a
	ret
s35:	push	hl
s45:	ld	a,(hl)
	or	a
	jr	z,s44
	cp	' '
	jr	nz,s44
	ld	(hl),'0'
	inc	hl
	jr	s45
s44:	pop	hl
	db	0c3h		; Jp
scale:	dw	s25		; Current scale (hex default)
s25:	ld	b,04h
	call	s46
	call	s47
	ret	c
	ld	d,a
	inc	hl
	call	s47
	ret	c
	ld	e,a
	ex	de,hl
	or	a
	ret
s47:	call	s48
	ret	c
	rlca
	rlca
	rlca
	rlca
	inc	hl
	ld	e,a
	call	s48
	ret	c
	add	a,e
	or	a
	ret
s48:	ld	a,(hl)
	and	7fh
	cp	'A'
	jr	c,s49
	and	5fh
	sub	7
s49:	sub	'0'
	jp	m,s41
	cp	10h
	jr	nc,s41
	or	a
	ret
s39:	pop	bc
s41:	scf
	ret
s46:	ld	a,(hl)
	cp	'0'
	jr	nz,s39
	inc	hl
	djnz	s46
	or	a
	ret
s28:	ld	b,3
	call	s46
	ld	de,0
	ld	bc,2710h	; Constant
	call	s50
	ld	bc,03e8h
	call	s50
	ld	bc,64h
	call	s50
	ld	bc,0ah
	call	s50
	ld	bc,1
	call	s50
	ex	de,hl
	or	a
	ret
s50:	ld	a,(hl)
	cp	':'
	jr	nc,s39
	sub	'0'
	jp	m,s39
	ex	de,hl
	or	a
s52:	jr	z,s51
	add	hl,bc
	jr	c,s39
	dec	a
	jr	s52
s51:	ex	de,hl
	inc	hl
	ret
s30:	ld	b,0
	ld	c,80h
s56:	ld	a,(hl)
	inc	hl
	cp	'0'
	jr	z,s53
	cp	'1'
	jr	z,s54
	jr	s41
s54:	ld	a,b
	or	c
	ld	b,a
s53:	ld	a,c
	cp	1
	jr	z,s55
	rrca
	ld	c,a
	jr	s56
s55:	ld	l,b
	ld	h,0
	or	a
	ret
s32:	ld	b,7
	call	s46
	ld	a,(hl)
	and	7fh
	ld	l,a
	ld	h,0
	or	a
	ret
s3:	db	0c3h		; Jp
r14:	dw	s26
s26:	ld	b,4
	call	s57
	ld	a,h
	call	s58
	ld	a,l

s58:	push	af
	and	0f0h
	rra
	rra
	rra
	rra
	call	hexout
	pop	af
	and	0fh

hexout:	add	a,'0'
	cp	':'		; Arabic number output?
	jp	c,charout	; Yes
	add	a,7		; No - get char. A-F for hex output
	jp	charout
s57:	ld	a,' '
	call	charout
	djnz	s57
	ret
s29:	ld	b,3
	call	s57
	ld	c,0
s74:	ld	a,h
	cp	''''
	jr	c,s60
	jr	nz,s61
	ld	a,l
	cp	10h
	jr	c,s60
s61:	inc	c
	ld	de,0d8f0h	; Constant
	add	hl,de
	jr	s74
s60:	ld	a,'0'
	add	a,c
	call	charout
	ld	c,0
s63:	ld	a,h
	cp	3
	jr	c,s62
	jr	nz,s75
	ld	a,l
	cp	0e8h
	jr	c,s62
s75:	inc	c
	ld	de,0fc18h	; Constant
	add	hl,de
	jr	s63
s62:	ld	a,'0'
	add	a,c
	call	charout
	ld	c,0
s66:	ld	a,h
	or	a
	jr	nz,s64
	ld	a,l
	cp	64h
	jr	c,s65
s64:	inc	c
	ld	de,0ff9ch	; Constant
	add	hl,de
	jr	s66
s65:	push	af
	ld	a,'0'		; 30h
	add	a,c
	call	charout
	pop	af
	ld	c,0
s68:	cp	0ah
	jr	c,s67
	inc	c
	sub	0ah
	jr	s68
s67:	push	af
	ld	a,'0'
	add	a,c
	call	charout
	pop	af
	add	a,'0'
	jr	charout

s31:	ld	c,80h
	ld	b,l
s70:	call	s69
	ld	a,c
	cp	1
	ret	z
	rrca
	ld	c,a
	jr	s70
s69:	ld	a,b
	and	c
	ld	a,'0'
	jr	z,s71
	ld	a,'1'
s71:	jr	charout

s33:	ld	b,7
	call	s57
	ld	a,l
	and	7fh
	cp	7fh
	jr	z,s72
	cp	' '
	jr	nc,charout
	or	'@'
	jr	s73
s72:	ld	a,'?'
s73:	push	af
	ld	a,8		; Backspace
	call	charout
	ld	a,5eh
	call	charout
	pop	af
charout:
	push	bc
	push	de
	push	hl
	ld	c,a		; Put char. in C, and
	call	conout		; BIOS console out
	pop	hl
	pop	de
	pop	bc
	ret
strout:	xor	a		; Print string
	add	a,(hl)
	ret	z
	push	hl
	call	charout
	pop	hl
	inc	hl
	jr	strout
s4:	call	conin
	and	7fh		; Strip high bit
	ret

r4:	db	0		; Registers cleared by "^X"
r12:	db	0
r10:	ds	11
r15:	dw	0
r16:	db	0
;
r11:	ds	6
r13:	db	'H'		; Hex scale is default
r5:	db	0
r7:	db	0,0,0,0,0
r9:	db	0
r8:	dw	0
r3:	db	0
r17:	db	0
r20:	db	0
r18:	db	0
r21:	dw	0
;
; ********* End Calculator *********
;

quit:				; Turn off calculator

	ld	a,0dh
	call	charout		; Print carriage return to indicate
				; Return to normal
;
	pop	hl		; Restore registers
	pop	de
	pop	bc
	pop	af
	pop	iy
	pop	ix
;
	ld	sp,(savstk)	; Restore stack pointer
;
	jp	conin		; = Call BIOS ConIn, ret to transient program
;
signon:	db	0dh
	db	'Calc-IOP (^\ = Off)   '
	db	'         ',0
;
savstk:	ds	2		; Save incoming stack pointer
;
	ds	32
newstk	equ	$		; Our own stack

;
	end
;
; End of CALCIOP.Z80