erkyrath.infocom-zcode-terps/c-128/xzip/zdos.asm

	PAGE
	STTL "--- Z-DOS: CBM64 ---"


	; ---------------------
	; GET Z-BLOCK FROM DISK
	; ---------------------

	; ENTRY: Z-BLOCK # IN [BLOCK]
	;        TARGET PAGE IN [DBUFF+HI]

	; NOTE: USING VARIABLE SECTORS PER TRACK TO GET 170K ON DISK

GETDSK:	LDA	#8
	STA	DRIVE		; GAME ALWAYS PLAYS FROM DRIVE #8

	LDA	DBLOCK+HI
	CMP	ZPURE+HI	; check for on side 1
	BCC	GETSD1		; OK, SIDE1
	BNE	SID2
	LDA	DBLOCK+LO
	CMP	ZPURE+LO
	BCC	GETSD1

SID2:	LDA	SIDEFLG		; ON SIDE 2?
	CMP	#2
	BEQ	GETSD2		; YES
	JSR	SIDE2		; NO, ASK FOR IT

GETSD2:	LDA	DBLOCK+LO
	SEC			; SIDE 2, SO SUBTRACT SIDE 1 
	SBC	ZPURE+LO	; AMOUNT SO GET ACCURATE
	PHA			; CALCULATION OF TRACK & SECTOR
	LDA	DBLOCK+HI
	SBC	ZPURE+HI
	TAX
	PLA
	LDY	#1		; SIDE 2 STARTS ON TRACK 1
	JSR	SETTS		; SET TRACK & SECTOR
	JMP	GETRES		; AND GO READ

GETSD1:	LDA	SIDEFLG		; ARE WE ON SIDE 1
	CMP	#1
	BEQ	SID1
	JSR	SIDE1

SID1:	LDA	DBLOCK+LO
	LDX	DBLOCK+HI
	LDY	#5		; SIDE 1 STARTS ON TRACK 5 (XZIP)
	JSR	SETTS		; GO GET TRACK & SECTOR
	JMP	GETRES		; AND GO READ THE DISK


	; SET TRACK & SECTOR FROM A,X DBLOCK (A=LO) Y = STARTING TRACK

SETTS:	STY	TRACK
	DEY

TRKLP:	CMP	TRKTBL,Y	; CHECK IF REMAINDER LESS
	BCS	DOIT		; THAN 1 TRACK
	CPX	#0
	BEQ	TRKDUN		; YES

DOIT:	SEC			; SUBTRACT ANOTHER TRACKS WORTH
	SBC	TRKTBL,Y	; FROM THE SECTORS PER TRACK TABLE
	BCS	TRK1
	DEX			; BORROWED
TRK1:	INC	TRACK
	INY			; NEXT TRACK IN TABLE
	BNE	TRKLP		; JMP

TRKDUN:	STA	SECTOR
	LDA	TRACK
	CMP	#18		; IF ON TRACK 18, SKIP OVER 1ST SECTOR
	BNE	NOT18
	INC	SECTOR
	BNE	TRKOVR
NOT18:				; check for sector 20
	CMP	#20		; for fast code stuff
	BNE	TRKOVR
	INC	SECTOR		; so skip over sector 0
TRKOVR:
	RTS

;
; skip over Track 20, Sector 0 in case of fast code
;
TRKTBL:	DB	21,21,21,21,21,21,21,21,21,21,21,21,21,21,21,21,21
	DB	18,19,18,19,19,19,19
	DB	18,18,18,18,18,18
	DB	17,17,17,17,17

	; *** ERROR #12: DISK ADDRESS OUT OF RANGE ***

TRKERR:	LDA	#12
	JMP	ZERROR

	; *** ERROR #14: DRIVE ACCESS ***

DSKERR:	LDA	#14
	JMP	ZERROR



	; --------------------
	; PUT [DBLOCK] TO DISK
	; --------------------

	; ENTRY: [DBLOCK] & [DRIVE] ASSIGNED
	;        PAGE TO WRITE IN [DBUFF]

	; NOTE: AS THIS ONLY WRITES FROM MAIN BANK (BANK1)
	; CAN HAVE UP HERE

PUTDSK:	LDY	#0		; MOVE PAGE AT [DBUFF]
PTKL:	LDA	(DBUFF),Y	; INTO
	STA	IOBUFF,Y	; [IOBUFF] FOR I/O
	INY
	BNE	PTKL

	SEC			; CARRY SET = "WRITE BLOCK"
	JSR	DISK
	BCS	WRTERR		; CARRY SET IF ERROR

	INC	DBUFF+HI	; NEXT MEMORY PAGE

NXTDBL:	INC	DBLOCK+LO	; POINT TO NEXT VIRTUAL PAGE
	BNE	DBLOK
	INC	DBLOCK+HI
DBLOK:	INC	SECTOR		; NEXT SECTOR
	LDY	TRACK		; CHECK IF NEXT TRACK
	DEY
	LDA	SECTOR
	CMP	TRKTBL,Y
	BCC	SECTOK
	INC	TRACK		; YES, RESET
	LDA	#0
	STA	SECTOR
	LDA	TRACK
	CMP	#18
	BNE	DNOT18
	INC	SECTOR		; SKIP 1ST SECTOR TRACK 18 (DIRECTORY)
	BNE	SECTOK
DNOT18:				; check for sector 20
	CMP	#20		; for fast code stuff
	BNE	SECTOK
	INC	SECTOR		; so skip over sector 0
SECTOK:	CLC

WRTERR:	RTS


	; --------------------
	; PROMPT FOR GAME DISK
	; --------------------

	; EZIP USES BOTH SIDES OF DISK

GAME:	DB	EOL
	DB	"Insert Side "
DSIDE:	DB	"* of the STORY disk into Drive #8."	; (CBD)
	DB	EOL	
GAMEL	EQU	$-GAME	
SD:	DB	"INFOCOM-S"	; (CBD)

SIDE1:	LDA	#'1'		; ASK FOR SIDE 1
	STA	DSIDE
	LDA	#1		; SET FOR SUCCESS
	STA	SIDEFLG	
SL1:	LDX	#<GAME
	LDA	#>GAME
	LDY	#GAMEL
	JSR	DLINE		; "INSERT STORY DISK"
	JSR	RETURN		; "PRESS [RETURN] TO CONTINUE:"
	LDX	#0		; READ DIRECTORY
	STX	SECTOR		; (CBD) MUST BE "INFOCOM-S1"
	LDX	#$12		; (CBD)
	STX	TRACK

	LDA	#8		; MAKE SURE WE'RE ON
	STA	DRIVE		; THE GAME DRIVE
	JSR	DOPEN

	CLC			; CARRY CLEAR = "READ BLOCK"
	JSR	DISK		; GO DO IT!
	BCC	SL3
	JMP	DSKERR		; ERROR IF CARRY SET

SL3:	LDY	#$99		; (CBD) OFFSET IN DIRECTORY SECTOR
	LDX	#9		; (CBD)
	LDA	#"1"		; (CBD)
	BNE	SL8		; (CBD)
SL7:	LDA	SD,X		; (CBD) "INFOCOM-S1"
SL8:	CMP	IOBUFF,Y	; (CBD) DIR ENTRY CORRECT?
	BNE	SL1		; (CBD) NO, GO ASK AGAIN
	DEY			; (CBD)
	DEX			; (CBD)
	BPL	SL7		; (CBD)
	BMI	ASK2		; (CBD) JUMP, GOOD


SIDE2:
	LDA	SIDEFLG		; see if we are on side 2
	CMP	#2		; well?
	BNE	SD2		; nope
	JMP	ASK2		; done then
SD2:	
	LDA	#'2'		; ASK FOR SIDE 2
	STA	DSIDE
	LDA	#2
	STA	SIDEFLG		; SET FOR SUCCESS
	LDA	DRIVE		; GET LAST DRIVE USED
	PHA			; HOLD IT A SEC
	LDA	#8		; MAKE SURE WE'RE ON
	STA	DRIVE		; THE BOOT DRIVE
	JSR	DOPEN
	PLA			; IF SAVED/RESTORED
	CMP	#9		; TO DRIVE 2, DON'T ASK
	BEQ	ASK2		; NOTE: THIS IS OK W/ VERIFY CAUSE ASKS
				; FOR SIDE 1 FIRST, RESETTING DRIVE TO 1

SL2:	LDX	#<GAME
	LDA	#>GAME
	LDY	#GAMEL
	JSR	DLINE		; "INSERT STORY DISK"
	JSR	RETURN		; "PRESS [RETURN] TO CONTINUE:"

	LDX	#0		; READ DIRECTORY 
	STX	SECTOR		; (CBD) MUST BE "INFOCOM-S2"
	LDX	#$12
	STX	TRACK
	CLC
	JSR	DISK
	BCC	SL4
	JMP	SL2		; BAD READ, GO ASK AGAIN

SL4:	LDY	#$99		; (CBD) OFFSET IN DIRECTORY SECTOR
	LDX	#9		; (CBD)
	LDA	#"2"		; (CBD)
	BNE	SL6		; (CBD)
SL5:	LDA	SD,X		; (CBD)
SL6:	CMP	IOBUFF,Y	; (CBD) DIR ENTRY CORRECT?
	BNE	SL2		; NO, GO ASK AGAIN
	DEY
	DEX
	BPL	SL5

ASK2:	LDA	#$FF		; RE-ENABLE
	STA	SCRIPT		; SCRIPTING
	RTS


	; -----------------------------
	; SET UP SAVE & RESTORE SCREENS
	; -----------------------------

SAVRES:	JSR	ZCRLF		; CLEAR THE BUFFER
	LDX	#0
	STX	SCRIPT		; DISABLE SCRIPTING
	LDA	TOP		; SET TO REFILL SCREEN
	STA	LINCNT
	RTS

	; -----------------
	; DISPLAY A DEFAULT
	; -----------------

	; ENTRY: DEFAULT (0-8) IN [A]

DEFAL:	DB	" (Default is "
DEFNUM:	DB	"*):"
DEFALL	EQU	$-DEFAL

DODEF:	CLC
	ADC	#'1'		; CONVERT TO ASCII 1-9
	STA	DEFNUM		; INSERT IN STRING

	LDX	#<DEFAL
	LDA	#>DEFAL
	LDY	#DEFALL
	JMP	DLINE		; PRINT THE STRING


	; -----------------------------
	; GET SAVE & RESTORE PARAMETERS
	; -----------------------------

POSIT:	DB	EOL
	DB	"Position 1-"
POSTOP:	DB	"*"
POSITL	EQU	$-POSIT

WDRIV:	DB	EOL
	DB	"Drive 8 or 9"
WDRIVL	EQU	$-WDRIV

MIND:	DB	EOL
	DB	EOL
	DB	"Position "
MPOS:	DB	"*; Drive #"
MDRI:	DB	"*."
	DB	EOL
	DB	"Are you sure? (Y or N):"
MINDL	EQU	$-MIND

INSM:	DB	EOL
	DB	"Insert SAVE disk into Drive #"
SAVDRI:	DB	"*."
INSML	EQU	$-INSM

YES:	DB	'YES'
	DB	EOL
YESL	EQU	$-YES

NO:	DB	'NO'
	DB	EOL
NOL	EQU	$-NO

PARAMS:	LDX	#<POSIT
	LDA	#>POSIT
	LDY	#POSITL
	JSR	DLINE		; "POSITION (1-5)"

	; GET GAME POSITION

CHANGE:	LDA	GPOSIT		; SHOW THE CURRENT
	JSR	DODEF		; DEFAULT POSITION

GETPOS:	JSR	GETKEY		; WAIT FOR A KEY
	CMP	#EOL		; IF [RETURN],
	BEQ	POSSET		; USE DEFAULT
	SEC
	SBC	#'1'		; ELSE CONVERT ASCII TO BINARY
	CMP	NUMSAV		; IF BELOW "6"
	BCC	SETPOS		; MAKE IT THE NEW DEFAULT
	JSR	BOOP		; ELSE RAZZ
	JMP	GETPOS		; AND TRY AGAIN

POSSET:	LDA	GPOSIT		; USE DEFAULT

SETPOS:	STA	TPOSIT		; USE KEYPRESS
	CLC
	ADC	#'1'		; CONVERT TO ASCII "1"-"5"
	STA	MPOS		; STORE IN TEMP STRING
	STA	SVPOS
	STA	RSPOS
	JSR	LETTER		; AND DISPLAY IT

	; GET DRIVE ID

	LDX	#<WDRIV
	LDA	#>WDRIV
	LDY	#WDRIVL
	JSR	DLINE		; "DRIVE 8 OR 9"

	LDA	GDRIVE		; SHOW DEFAULT
	CLC			; CONVERT 0 OR 1
	ADC	#7		; TO 7 OR 8
	JSR	DODEF		; SO DEFAULT WILL BE CORRECT

GETDRV:	JSR	GETKEY		; GET A KEYPRESS
	CMP	#EOL		; IF [RETURN],
	BEQ	DRVSET		; USE DEFAULT
	SEC
	SBC	#'8'		; CONVERT TO BINARY 0 OR 1
	CMP	#2		; IF WITHIN RANGE,
	BCC	SETDRV		; SET NEW DEFAULT
	JSR	BOOP
	JMP	GETDRV		; ELSE TRY AGAIN

DRVSET:	LDA	GDRIVE		; USE DEFAULT

SETDRV:	STA	TDRIVE		; USE [A]
	CLC
	ADC	#'8'		; CONVERT TO ASCII 8 OR 9
	STA	SAVDRI		; STORE IN DRIVE STRING
	STA	MDRI		; AND IN TEMP STRING
	JSR	LETTER		; AND SHOW NEW SETTING

	LDX	#<MIND	; SHOW TEMPORARY SETTINGS
	LDA	#>MIND
	LDY	#MINDL
	JSR	DLINE

	JSR	GETYES
	BCC	ALLSET		; YES
	RTS			; carry set, means it didn't work

	; GET DISK AND MAKE SURE IT'S ACCESSIBLE

ALLSET:	LDX	#<INSM
	LDA	#>INSM
	LDY	#INSML
	JSR	DLINE		; "INSERT SAVE DISK IN DRIVE X."
	JSR	RETURN		; "PRESS [RETURN] TO CONTINUE."

TRYOPN:
	LDA	#$FF		; show bad side
	STA	SIDEFLG
	LDA	TDRIVE		; TRY TO OPEN SPECIFIED DRIVE
	CLC
	ADC	#8
	JSR	DOPEN		; THE DEFAULT DRIVE
	RTS			; CARRY SET IF ERROR

	; ------
	; GETYES
	; ------

	; CALLED BY PARAMS AND WARM

GETYES:	JSR	GETKEY

	CMP	#'Y'		; IF REPLY IS "Y"
	BEQ	YUP		; ACCEPT RESPONSES
	CMP	#'y'
	BEQ	YUP

	CMP	#'N'		; IF REPLY IS N,
	BEQ	RETRY		; DO A RETRY
	CMP	#'n'
	BEQ	RETRY

	JSR	BOOP		; INSIST ON Y/RETURN
	JMP	GETYES		; OR N

RETRY:	LDX	#<NO		; ELSE PRINT "NO"
	LDA	#>NO
	LDY	#NOL
	JSR	DLINE
	SEC
	RTS

YUP:	LDX	#<YES	; PRINT "YES"
	LDA	#>YES
	LDY	#YESL
	JSR	DLINE
	CLC
	RTS


	; --------------------------------
	; SET START SECTOR OF SAVE/RESTORE
	; --------------------------------

	; THERE IS A BIT OF INFORMATION ON THE LAST SECTOR OF SAVE DISKS -
	; THE WORD "INFOSAVES " AND THE SIZE OF A SAVE TO USE IN THE
	; CALCULATION OF THE STARTING LOCATION OF EACH OF THE SAVES ON
	; THAT DISK, THIS IS USED FOR PARTIAL RESTORES, BECAUSE PARTIAL
	; SAVES MAY BE RESTORED INTO A DIFFERENT GAME AND THAT GAME MAY
	; ALLOW A DIFFERENT NUMBER OF SAVES. IN ORDER TO FIND THE START OF
	; THE PARTIAL RESTORE THE SIZE OF SAVES ON THE SAVE DISK IS TAKEN 
	; FROM THE DISK AND USED FOR A PARTIAL RESTORE. IN ORDER THAT PART
	; OF THOSE RESTORES ARE NOT OVERWRITTEN WITH DIFFERENT ALIGNMENT
	; ONLY BLANK DISKS OR DISKS WITH THE SAME SAVE SIZE MAY BE USED
	; FOR NEW SAVES. BLANK DISKS ARE MARKED WITH THE INFOSAVES INFO
	; ON FIRST USE


SAVSTRT: JSR	CHKINF		; CHECK IF DISK OK
	BCS	SBLANK		; BLANK MEANS NEW DISK

	LDX	#INFML		; GET OFFSET OF SIZE BYTE 
	LDA	IOBUFF,X	; AND PICK IT UP FROM BUFFER
	CMP	SAVSIZ
	BEQ	SIZOK		; SAME SIZE, JUST USE DISK

	;ASK IF WANT TO USE, WILL OVERWRITE ANYTHING ON DISK

REUSE:	LDX	#<STILL
	LDA	#>STILL
	LDY	#STILLL
	JSR	DLINE
	JSR	GETYES
	BCC	SBLANK		; YES
	RTS			; NO, RET CARRY SET

SBLANK:	LDA	#LASTT
	STA	TRACK
	LDA	#LASTS
	STA	SECTOR
	LDX	#INFML-1	; MOVE IN "INFOSAVES "
BLOOP:	LDA	INFM,X
	STA	IOBUFF,X
	DEX
	BPL	BLOOP
	LDA	SAVSIZ
	LDX	#INFML
	STA	IOBUFF,X

	SEC			; WRITE INFO SECTOR TO DISK
	JSR	DISK
	BCS	RET		; CARRY SET IF ERROR

SIZOK:	LDA	SAVSIZ
	JSR	SETSTRT		; SET STARTING SECTOR FOR THIS SAVE
	CLC
RET:	RTS


	; NUMBER OF SECTORS REQUIRED FOR SAVE IN [A]
	; FINDS STARTING TRACK & SECTOR FOR CURRENT POSITION 

SETSTRT: STA	IOCHAR		; BORROW THIS SPACE
	LDA	#0		; SET FOR POSITION 1
	STA	DBLOCK+LO
	STA	DBLOCK+HI

	LDX	TPOSIT		; GET # OF SAVES IN TO MOVE
	BEQ	FINDTS
CALC:	CLC			; AND FIND WHAT SECTOR TO START WITH
	ADC	IOCHAR		; MAY BE GAME SIZE OR PARTIAL RESTORE SIZE
	BCC	CALC1
	INC	DBLOCK+HI
CALC1:	DEX
	BNE	CALC
	STA	DBLOCK+LO	; IN THE FORM OF DBLOCKS

FINDTS:	LDA	DBLOCK+LO
	LDX	DBLOCK+HI
	LDY	#1
	JSR	SETTS		; GET TRACK & SECTOR
	RTS


	; THIS RTN LOOKS FOR "INFOSAVES " ON (ASSUMED) SAVE DISK
	; IF NOT THERE RTNS BAD - NO SAVES ON DISK
	; IF THERE SETS UP TRACK & SECTOR FOR THE RESTORE
	; USES SAVE SIZE ON DISK, FULL OR PARTIAL SAVE SHOULD BE CORRECT 
	; SIZE 

RESSTRT: JSR	CHKINF		; CHECK IF DISK OK
	BCC	SETRES		; IF NO "INFOSAVES " NO SAVES ON THIS DISK
	RTS			; RET WITH CARRY SET

SETRES:	LDX	#INFML		; GET OFFSET OF SIZE BYTE 
	LDA	IOBUFF,X	; AND PICK IT UP FROM BUFFER
	JSR	SETSTRT
	CLC
	RTS


	; THIS RTN LOOKS AT THE LAST SECTOR OF (ASSUMED) SAVE DISK
	; AND RTNS WHETHER "INFOSAVES " IS ON IT (C = 0) OR NOT (C = 1)

CHKINF:	LDA	#LASTT
	STA	TRACK
	LDA	#LASTS
	STA	SECTOR
	LDA	#>IOBUFF	; READ LAST SECTOR ON SAVE DISK
	STA	DBUFF+HI
	JSR	GETRES
	LDX	#INFML-1	; CHECK FOR "INFOSAVES"
CHKLP:	LDA	IOBUFF,X
	CMP	INFM,X
	BNE	NOTINF
	DEX
	BPL	CHKLP
	CLC
	RTS
NOTINF:	SEC
	RTS

INFM:	DB	"INFOSAVES "
INFML	EQU	$-INFM

STILL:	DB	EOL
	DB	"USING THIS DISK WILL DESTROY PREVIOUS SAVES ON THIS DISK."
	DB	EOL
	DB	"DO YOU STILL WISH TO USE THIS DISK? (Y/N)  "
STILLL	EQU	$-STILL


	; ---------------------
	; "PRESS RETURN" PROMPT
	; ---------------------

RETURN:	LDX	#<RTN
	LDA	#>RTN
	LDY	#RTNL
	JSR	DLINE		; SHOW PROMPT

	; ENTRY FOR QUIT/RESTART

GETRET:	JSR	GETIN		; WAIT FOR [RETURN]
	CMP	#0
	BEQ	GETRET		; GET A CHAR 1ST
	AND	#%01111111	; CLEAR SHIFT
	CMP	#EOL
	BEQ	RETEX
	JSR	BOOP		; ACCEPT NO
	JMP	GETRET		; SUBSTITUTES!

RETEX:	RTS

RTN:	DB	EOL
	DB	"Press [RETURN] to continue."
	DB	EOL,EOL
RTNL	EQU	$-RTN


	; ---------
	; SAVE GAME
	; ---------

SAV:	DB	"Save Position"
	DB	EOL
SAVL	EQU	$-SAV

SVING:	DB	EOL
	DB	"Saving position "
SVPOS:	DB	"* ..."
	DB	EOL
SVINGL	EQU	$-SVING


ZSAVE:	LDA	#'N'
	LDX	NARGS
	BEQ	OLDSAV		; NORMAL, COMPLETE SAVE
	LDA	#'P'
OLDSAV:	STA	TYPE

	JSR	SAVRES		; SET UP SCREEN
	LDX	#<SAV
	LDA	#>SAV
	LDY	#SAVL
	JSR	DLINE		; "SAVE POSITION"

	JSR	PARAMS		; GET PARAMETERS
	BCC	DOSAVE		; ERROR IF CARRY SET
BADSAV:
	JSR	SIDE2		; PROMPT FOR GAME DISK
	JMP	RET0		; AND FAIL

DOSAVE:	LDX	#<SVING
	LDA	#>SVING
	LDY	#SVINGL
	JSR	DLINE		; "SAVING POSITION X ..."

	JSR	SAVSTRT		; READ/MAKE DIRECTORY FOR PARTIAL SAV/RES'S
	BCS	BADSAV		; OOPS

	JSR	SAVGUTS		; do all the work here

	JSR	SIDE2		; PROMPT FOR GAME DISK
	LDA	TDRIVE		; IF SAVE SUCCESSFUL
	STA	GDRIVE		; SAVE PARAMS FOR
	LDA	TPOSIT
	STA	GPOSIT
	LDA	#1		; SET TO MARK
	LDX	#0
	JMP	PUTBYT		; SUCCESS

SAVGUTS:
	; SAVE GAME PARAMETERS IN [BUFSAV]

	LDA	ZBEGIN+ZID	; MOVE GAME ID
	STA	BUFSAV+0	; INTO 1ST 2 BYTES
	LDA	ZBEGIN+ZID+1	; OF THE AUX LINE BUFFER
	STA	BUFSAV+1

	LDA	ZSP+LO		; MOVE [ZSP]
	STA	BUFSAV+2	
	LDA	ZSP+HI	
	STA	BUFSAV+3	
	LDA	OLDZSP+LO	
	STA	BUFSAV+4	
	LDA	OLDZSP+HI	; MOVE [OLDZSP]
	STA	BUFSAV+5	

	LDX	#2		; MOVE CONTENTS OF [ZPC]
ZPCSAV:	LDA	ZPC,X		; TO BYTES 5-7
	STA	BUFSAV+6,X	; OF [BUFSAV]
	DEX
	BPL	ZPCSAV

	LDA	TYPE
	STA	BUFSAV+9	; NORMAL OR PARTIAL
	CMP	#'P'
	BNE	ZSNONM		; NORMAL SAVE SO NO name TO SAVE
	LDY	#0
	LDA	(ARG3),Y
	TAY			; MOVE NAME TO BUFSAV
ZSL3:	LDA	(ARG3),Y
	STA	BUFSAV+10,Y
	DEY
	BPL	ZSL3		; INCLUDE LENGTH BYTE

	; WRITE [LOCALS]/[BUFSAV] PAGE TO DISK

ZSNONM:	LDA	#>LOCALS
	STA	DBUFF+HI	; POINT TO THE PAGE

	LDA	ISRFLAG		; is it an i-save to ex-mem?
	BEQ	ZSNOj		; nope

 	JSR	DOISAVE		; this does it
	BNE	ZSNOj1		; always returns <> 0
ZSNOj:
	JSR	PUTDSK		; AND WRITE IT OUT
	BCS	BADSAV		; CATCH WRITE ERROR HERE
ZSNOj1:
	; IF A PARTIAL SAVE WRITE FROM ARG1 FOR ARG2 BYTES TO DISK
	; (ROUNDED TO PGS) SKIPPING ZSTACK WRITE

	LDA	TYPE
	CMP	#'P'
	BNE	ZSALL
	LDA	ARG1+HI		; FIND WHERE TO START & HOW FAR TO GO
	CLC
	ADC	ZCODE		; MAKE IT ABSOLUTE
	STA	DBUFF+HI
	LDX	ARG2+HI
	INX			; TO GET WHOLE OF LAST PG
	STX	I+LO
	JMP	LSAVE		; JMP

	; WRITE CONTENTS OF Z-STACK TO DISK

ZSALL:	LDA	#>ZSTKBL	; POINT TO 1ST PAGE
	STA	DBUFF+HI	
	LDA	#4		; DO ALL 4 PAGES
	STA	L		; SET COUNTER
ZSOKLP:
	LDA	ISRFLAG		; is it an i-save to ex-mem?
	BEQ	ZSOKj		; nope

	JSR	DOISAVE		; this does it
	BNE	ZSOK		; always returns <> 0
ZSOKj:
	JSR	PUTDSK		; WRITE THEM
	BCC	ZSOK
	JMP	BADSAV		; OOPS
ZSOK:	DEC	L
	BNE	ZSOKLP

	; WRITE ENTIRE GAME PRELOAD TO DISK

	LDA	ZCODE		; POINT TO 1ST PAGE
	STA	DBUFF+HI	; OF PRELOAD

	LDX	ZBEGIN+ZPURBT	; GET # IMPURE PAGES
	INX			; USE FOR INDEXING
	STX	I+LO
LSAVE:
	LDA	ISRFLAG		; is it an i-save to ex-mem?
	BEQ	LSVj		; nope

	JSR	DOISAVE		; this does it
	BNE	DECCNT		; always returns <> 0
LSVj:
	JSR	PUTDSK
	BCC	DECCNT
	JMP	BADSAV
DECCNT:	DEC	I+LO
	BNE	LSAVE
	RTS			; done with it

	; ------------
	; RESTORE GAME
	; ------------

RES:	DB	"Restore Position"
	DB	EOL
RESL	EQU	$-RES

RSING:	DB	EOL
	DB	"Restoring position "
RSPOS:	DB	"* ..."
	DB	EOL
RSINGL	EQU	$-RSING


ZREST:	LDA	#'N'
	LDX	NARGS
	BEQ	OLDRES		; NORMAL, COMPLETE RESTORE
	LDA	#'P'
OLDRES:	STA	TYPE

	JSR	SAVRES
	LDX	#<RES
	LDA	#>RES
	LDY	#RESL
	JSR	DLINE		; "RESTORE POSITION"

	JSR	PARAMS		; GET PARAMETERS
	BCS	BADRES		; ERROR IF CARRY SET

	LDX	#<RSING
	LDA	#>RSING
	LDY	#RSINGL
	JSR	DLINE		; "RESTORING POSITION X ..."

	JSR	RESSTRT		; READ/MAKE DIRECTORY FOR PARTIAL SAV/RES'S
	BCS	BADRES		; OOPS

	JSR	RESGUTS		; do all the real work

	JSR	SIDE2		; PROMPT FOR GAME DISK
	LDA	TDRIVE		; IF RESTORE SUCCESSFUL
	STA	GDRIVE		; SAVE PARAMS FOR
	LDA	TPOSIT		; NEXT TIME
	STA	GPOSIT
	LDA	#2		; SET TO
	LDX	#0
	JMP	PUTBYT		; SUCCESS

;
; RESGUTS - major grunt work for saving is done here
;
RESGUTS:
	LDA	TYPE		; PARTIAL SAVE DIFFERS STARTING HERE
	CMP	#'P'
	BNE	ZRNRML
	JMP	ZPARTR

	; SAVE LOCALS IN CASE OF ERROR

ZRNRML:	LDX	#31
LOCSAV:	LDA	LOCALS,X	; COPY ALL LOCALS
	STA	$0100,X		; TO BOTTOM OF MACHINE STACK
	DEX
	BPL	LOCSAV

	LDA	#MAIN
	STA	DSKBNK		; SET TO WRITE TO MAIN BANK
	LDA	#>LOCALS
	STA	DBUFF+HI

	LDA	ISRFLAG		; internal restore?
	BEQ	GRj		; nope

	JSR	DOIRES		; do the work
	BNE	GRj1		; always branch
GRj:	
	JSR	GETRES		; RETRIEVE 1ST BLOCK OF PRELOAD
	BCS	WRONG
GRj1:
	LDA	BUFSAV+0	; DOES 1ST BYTE OF SAVED GAME ID
	CMP	ZBEGIN+ZID	; MATCH THE CURRENT ID?
	BNE	WRONG		; WRONG DISK IF NOT

	LDA	BUFSAV+1	; WHAT ABOUT THE 2ND BYTE?
	CMP	ZBEGIN+ZID+1
	BEQ	RIGHT		; CONTINUE IF BOTH BYTES MATCH

	; HANDLE INCORRECT SAVE DISK

WRONG:	LDX	#31		; RESTORE ALL SAVED LOCALS
WR0:	LDA	$0100,X
	STA	LOCALS,X
	DEX
	BPL	WR0

BADRES:	JSR	SIDE2		; PROMPT FOR GAME DISK
	JMP	RET0		; AND FAIL

	; CONTINUE RESTORE

RIGHT:
	LDA	ZBEGIN+ZSCRIP	; SAVE BOTH FLAG BYTES
	STA	I+LO
	LDA	ZBEGIN+ZSCRIP+1
	STA	I+HI

	LDA	#>ZSTKBL	; RETRIEVE OLD CONTENTS OF
	STA	DBUFF+HI	; Z-STACK
	LDA	#4		; DO 4 PAGES
	STA	L		; SET COUNTER
ZROKLP:
	LDA	ISRFLAG		; are we doing i-restore
	BEQ	ZROKj		; nope
	JSR	DOIRES		; so do i-restore
	BNE	ZROKL1		; always returns <>0
ZROKj:
	JSR	GETRES		; GET 4 PAGES OF Z-STACK
	BCC	ZROKL1
	JMP	DSKERR		; IF HERE, MIX OF GOOD & BAD SO DIE

ZROKL1:	DEC	L
	BNE	ZROKLP

	LDA	ZCODE
	STA	DBUFF+HI

	LDA	ISRFLAG		; are we doing i-restore
	BEQ	ZROKLj		; nope
	JSR	DOIRES		; so do i-restore
	BNE	ZROKL2		; always returns <>0
ZROKLj:
	JSR	GETRES		; GET 1ST BLOCK OF PRELOAD
	BCC	ZROKL2
	JMP	DSKERR
ZROKL2:
	LDA	I+LO		; RESTORE THE STATE
	STA	ZBEGIN+ZSCRIP	; OF THE FLAG WORD
	LDA	I+HI
	STA	ZBEGIN+ZSCRIP+1

	LDA	ZBEGIN+ZPURBT	; GET # PAGES TO LOAD
	STA	I+LO

LREST:
	LDA	ISRFLAG		; are we doing i-restore
	BEQ	LRESTj		; nope
	JSR	DOIRES		; so do i-restore
	BNE	LREST0		; always returns <>0
LRESTj:
	JSR	GETRES		; FETCH THE REMAINDER
	BCC	LREST0
	JMP	DSKERR
LREST0:
	DEC	I+LO		; OF THE PRELOAD
	BNE	LREST

	; RESTORE THE STATE OF THE SAVED GAME

	LDA	BUFSAV+2	; RESTORE THE [ZSP]
	STA	ZSP+LO	
	LDA	BUFSAV+3	
	STA	ZSP+HI	
	LDA	BUFSAV+4	
	STA	OLDZSP+LO	
	LDA	BUFSAV+5	; AND THE [OLDZSP]
	STA	OLDZSP+HI	

	LDX	#2		; RESTORE THE [ZPC]
RESZPC:	LDA	BUFSAV+6,X
	STA	ZPC,X
	DEX
	BPL	RESZPC

ZROUT:
	JSR	VLDZPC		; MAKE VALID (12-2-86)
	RTS

	; DO PARTIAL RESTORE GETTING 1ST PAGE 
	; AND LAST PAGE BYTE ALIGNMENT CORRECT

ZPARTR:	; WRITE LOCALS TO IOBUFF JUST TO LOOK AT NAME

	LDA	#MAIN
	STA	DSKBNK
	LDA	#>IOBUFF	; DON'T READ TO LOCALS YET (X)
	STA	DBUFF+HI
	JSR	GETRES		; RETRIEVE 1ST BLOCK OF PRELOAD
	BCS	ZPBAD		; BAD DISK READ IF CARRY CLEAR

	LDY	#0		; ADD ALL OFFSETS TOGETHER TO
	LDA	(ARG3),Y	; COMPARE PARTIAL NAME (LENGTH)
	TAY			; COUNTER
	CLC
	ADC	#<BUFSAV	; GET OFFSET IN IOBUFF TO BUFSAV'D STUFF
	CLC
	ADC	#10		; OFFSET OF NAME IN BUFSAV
	TAX

ZPCMP:	LDA	(ARG3),Y	; COMPARE PARTIAL NAME
	CMP	IOBUFF,X
	BNE	ZPBAD
	DEX
	DEY
	BPL	ZPCMP

	LDA	ARG1+HI		; FIND WHERE TO START & HOW FAR TO GO
	CLC
	ADC	ZCODE		; MAKE IT ABSOLUTE
	STA	I+HI
	LDA	#0
	STA	I+LO
	LDA	ARG2+LO
	CLC
	ADC	ARG1+LO
	STA	J+LO		; LAST BYTE OF LAST PAGE
	LDA	ARG2+HI
	ADC	#0		; PICK UP CARRY
	STA	J+HI		; # OF PAGES TO RESTORE

	JSR	DECJ		; CORRECT ALIGNMENT FOR THIS USAGE

	LDA	#>IOBUFF	; GET 1ST PAGE
	STA	DBUFF+HI	; GETRES SHOULD KEEP IN IOBUFF
	JSR	GETRES
	BCC	POK
	JMP	DSKERR		; ALL MESSED UP, JUST QUIT

POK:	LDY	ARG1+LO		; START BYTE FIRST PAGE
ZPART0:	LDA	IOBUFF,Y
	STA	(I),Y
	JSR	DECJ
	BCC	ZROUT		; CARRY CLEAR IF $FFFF RESULT
	INY
	BNE	ZPART0

	LDA	#>IOBUFF	; GET SUBSEQUENT PAGES
	STA	DBUFF+HI	; GETRES SHOULD KEEP IN IOBUFF
	JSR	GETRES
	BCC	POK2
	JMP	DSKERR
POK2:	LDY	#0
	JMP	ZPART0

ZPBAD:	JMP	BADRES		; NAMES DON'T MATCH, DIE

	; THE OLD SAVE & RESTORE STILL HAVE OPCODES
	; SO JUST PUT IN A PLACE FOR THEM HERE FOR NOW

OSAVE:
OREST:	RTS

ZISAVE:
	LDA	ISRBANK		; can we do it?
	BNE	ZIS1		; no i-saving here

	LDA	#$FF		; SET TO
	LDX	#$FF
	JMP	PUTBYT		; FAILURE FOREVER
ZIS1:
	STA	ISRFLAG		; show we are i-saving
	LDA	#'N'		; make a full save
	STA	TYPE		; and show savguts
	LDA	#0		; start ISRBANK, Page 0
	STA	ISRPAGE		; show it to DOISAVE

	JSR	SAVGUTS		; save the world

	LDY	#0		; turn off i-saving
	STY	ISRFLAG		; turned off
	INY			; and show we done it
	STY	ISAVED		; for restore to check
	LDA	#1		; SET TO
	LDX	#0
	JMP	PUTBYT		; SUCCESS

ZIREST:
	LDA	ISRBANK		; can we do it?
	BEQ	ZIR0		; no i-restoring here
	LDA	ISAVED		; if either are zero then
	BEQ	ZIR0		; none can be done

	STA	ISRFLAG		; show we are i-saving
	LDA	#'N'		; make a full save
	STA	TYPE		; and show savguts
	LDA	#0		; start ISRBANK, Page 0
	STA	ISRPAGE		; show it to DOIREST

	JSR	RESGUTS		; save the world

	LDA	#0		; turn off i-saving
	STA	ISRFLAG		; turned off
	LDA	#2		; SET TO
	LDX	#0
	JMP	PUTBYT		; SUCCESS
ZIR0:
	JMP	RET0		; DIDN'T WORK

	END