File:  [Infocom source] / coco / disk.src
Revision 1.1.1.3 (vendor branch): download - view: text, annotated - select for diffs
Fri Mar 20 10:20:13 2020 UTC (20 months, 2 weeks ago) by root
Branches: infocom, MAIN
CVS tags: VERSION_D, HEAD
coco interpeter version D

	PAGE
	;SBTTL "--- DISK I/O ---"

DSKCON	EQU	$C004		; CONTAINS DISK ACCESS VECTOR
DCB	EQU	$EA  		; ADDRESS OF DCB
MOTOR	EQU	$FF40		; DRIVE MOTOR ON/OFF SWITCH
BLOCK1	EQU	37		; 1ST Z-CODE BLOCK (TRACK 2, SECTOR 1)

	; ------------------------
	; READ A Z-BLOCK FROM DISK
	; ------------------------

	; ENTRY: DRIVE # (0 OR 1) IN [DRIVE]
	;        BLOCK # IN [DBLOCK]
	;        BUFFER ADDRESS IN [DBUFF]

GETDSK:	LDD	TEMP		; SAVE [TEMP] AND
	LDX	VAL		; [VAL] FOR DIVISION
	PSHS	X,D

	; CONVERT BLOCK # TO SECTOR/TRACK

	LDD	DBLOCK		; FETCH BLOCK #
	ADDD	#BLOCK1		; ADD DISK OFFSET
	CMPD	#16*18+1	; IF BELOW TRACK 16
	BLO	TRAKZ		; CONTINUE
	ADDD	#36		; ELSE SKIP OVER TRACKS 16 & 17
TRAKZ:	STD	TEMP		; USE AS DIVIDEND
	LDD	#18
	STD	VAL		; DIVIDE BY 18 (# SECTORS PER TRACK)
	JSR	UDIV		; UNSIGNED DIVIDE
	LDA	TEMP+1		; [TEMP] HAS QUOTIENT (TRACK #)
	LDB	VAL+1		; [VAL] HAS REMAINDER (SECTOR #)
	BNE	NXTSEC		; IF REMAINDER WAS ZERO,
	LDB	#18		; CHANGE IT TO 18
	DECA			; AND PATCH TRACK #
NXTSEC:	STD	TRACK
	JSR	DREAD		; ACCESS THE DISK
	INC	DBLOCK+1	; POINT TO NEXT Z-BLOCK
	BNE	REND
	INC	DBLOCK
REND:	PULS	X,D		; RESTORE VARIABLES
	STX	VAL
	STD	TEMP
	RTS

	; -----------------
	; SAVE/RESTORE INIT
	; -----------------

SAVRES:	JSR	ZCRLF		; FLUSH OUTPUT BUFFER
	JSR	CLS
	LDD	#SCREEN
	STD	CURSOR		; MOVE CURSOR TO STATUS LINE
	CLR	SCRIPT		; DISABLE SCRIPTING
	RTS

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

ZSAVE:	BSR	SAVRES		; INIT THINGS
	LDX	#SAV
	LDB	#SAVL
	JSR	DLINE		; "SAVE POSITION"

	JSR	PARAMS		; GET POSITION AND DRIVE

	TSTA			; IS A ZERO?
	BEQ	ZSAVE		; THEN LOOP

	LDX	#SING
	LDB	#SINGL
	JSR	DLINE		; "SAVING"
	JSR	TIONP		; "POSITION X ..."

	LDX	#BUFSAV		; POINT TO AUX BUFFER
	LDD	ZCODE+ZID	; GET GAME ID CODE
	STD	,X++		; SAVE IN BUFFER
	LDD	OZSTAK		; OLD STACK POINTER
	STD	,X++
	STU	,X++		; AND CURRENT STACK POINTER
	LDA	ZPCH		; HI BYTE OF ZPC
	STA	,X+
	LDD	ZPCM		; LOW ZPC BYTES
	STD	,X

	LDD	#LOCALS
	STD	DBUFF
	BSR	DWRITE		; WRITE LOCAL/BUFFER PAGE

	LDD	#ZSTACK		; SAVE CONTENTS
	STD	DBUFF		; OF Z-STACK (2 PAGES)
	BSR	DWRITE		; FIRST HALF
	BSR	DWRITE		; 2ND HALF

	; SAVE GAME PRELOAD

	LDD	#ZCODE		; START OF PRELOAD
	STD	DBUFF
	LDA	ZCODE+ZPURBT	; SIZE OF PRELOAD (MSB, # PAGES)
	INCA			; ROUND UP
	STA	TEMP		; USE [TEMP] AS INDEX

LSAVE:	BSR	DWRITE		; SAVE A PAGE
	DEC	TEMP		; SAVED ENTIRE PRELOAD YET?
	BNE	LSAVE		; NO, KEEP SAVING
	JMP	RESUME

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

DSKERR:	LDA	#12
	BRA	DSKEX

	; *** ERROR #14: DISK ACCESS ***

DERR2:	LDA	#14
DSKEX:	JSR	ZERROR

	; ------------
	; ACCESS DRIVE
	; ------------

	; ENTRY: [DBUFF] HOLDS BUFFER ADDRESS
	;        [TRACK] HOLDS TRACK, SECTOR ADDRESS
	;        [DRIVE] HOLDS DRIVE #

DWRITE:	LDX	#IOBUFF		; POINT TO DISK I/O BUFFER
	LDY	DBUFF		; AND RAM PAGE TO BE WRITTEN
DRLOOP:	LDD	,Y++		; GRAB A WORD OUT OF RAM
	STD	,X++		; MOVE IT INTO THE BUFFER
	CMPX	#IOBUFF+$100	; BUFFER FILLED YET?
	BLO	DRLOOP		; NO, KEEP MOVING
	LDA	#3		; "WRITE SECTOR" COMMAND
	BRA	DIO

DREAD:	LDA	#2		; "READ SECTOR" COMMAND

DIO:	JSR	ROMIN		; ENABLE ROMS  [TAKEN OUT BY ASK 5/15/85]

     	LDX	#DCB		; GET ADDR OF DCB
	LDB	DRIVE		; DRIVE # (0 OR 1)
	STD	,X		; PASS TO [DSKCON]
	LDD	TRACK		; TRACK & SECTOR ADDRESSES
	CMPA	#35
	BHS	DSKERR		; NO TRACKS HIGHER THAN 34
	CMPB	#19
	BHS	DSKERR		; OR SECTORS HIGHER THAN 18
	STD	2,X		; PASS IT
	LDD	#IOBUFF		; BUFFER ADDRESS
	STD	4,X

	; ACCESS THE DRIVE

	JSR	MYCON   	; (NOT ANY MORE-->) LET OS DO THE DIRTY WORK

	JSR	ROMOUT		; THEN TURN ROMS OFF AGAIN [ASK 5/15/85]

	; CHECK FOR ACCESS ERRORS

	LDA	6,X		; GET STATUS BYTE
	BITA	#%01000000	; WRITE-PROTECT ERROR?
	BNE	WPERR		; YES, GO REPORT IT
	TSTA			; ANY OTHER ERRORS?
	BNE	DERR2		; ERROR IF ANY BIT SET

	LDX	#IOBUFF		; MOVE CONTENTS OF I/O BUFFER
	LDY	DBUFF		; TO DESIRED RAM ADDRESS
QLOOP:	LDD	,X++
	STD	,Y++
	CMPX	#IOBUFF+$100
	BLO	QLOOP

	INC	DBUFF		; POINT TO NEXT PAGE OF RAM
	LDD	TRACK		; AND NEXT SECTOR
	INCB
	CMPB	#19
	BLO	DIOEX
	LDB	#1
	INCA
DIOEX:	STD	TRACK
	RTS

	; -------------------
	; WRITE-PROTECT ERROR
	; -------------------

WPERR:	PULS	D		; PULL RETURN ADDRESS OFF STACK
	BRA	ERRWP		; PROMPT FOR GAME DISK

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

ZREST:	JSR	SAVRES

	LDX	#RES
	LDB	#RESL
	JSR	DLINE		; "RESTORE POSITION"

	JSR	PARAMS

	TSTA			; IS A ZERO?
	BEQ	ZREST		; THEN LOOP

	LDX	#RING
	LDB	#RINGL
	JSR	DLINE		; "RESTORING"
	JSR	TIONP		; "POSITION X ..."

	; SAVE LOCALS ON MACHINE STACK
	; IN CASE OF ERROR

	LDX	#LOCALS		; POINT TO LOCALS STORAGE
	STX	DBUFF		; POINT TO 1ST PAGE TO RESTORE
LOCLP:	LDD	,X++		; GRAB A LOCAL
	PSHS	D		; AND PUSH IT
	CMPX	#LOCALS+30	; SAVED 15 LOCALS YET?
	BLO	LOCLP		; NO, KEEP PUSHING

	JSR	DREAD		; RETRIEVE LOCALS/BUFFER PAGE

	LDD	BUFSAV		; READ SAVED GAME ID
	CMPD	ZCODE+ZID	; IF IT MATCHES CURRENT GAME ID,
	BEQ	VERSOK		; PROCEED WITH THE RESTORE

	; WRONG SAVE DISK, ABORT RESTORE

	LDX	#LOCALS+30	; RESTORE PUSHED LOCALS
RESLP:	PULS	D
	STD	,--X
	CMPX	#LOCALS
	BHI	RESLP
ERRWP:	BSR	TOBOOT		; PROMPT FOR GAME DISK
	JMP	PREDF		; PREDICATE FAILS

VERSOK:	LEAS	+30,S		; POP OLD LOCALS OFF STACK
	LDD	ZCODE+ZSCRIP
	STD	VAL		; SAVE FLAGS

	LDD	#ZSTACK		; RETRIEVE
	STD	DBUFF		; CONTENTS OF Z-STACK
	JSR	DREAD
	JSR	DREAD

DOREST:	LDD	#ZCODE		; NOW RETRIEVE
	STD	DBUFF		; 1ST PAGE OF PRELOAD
	JSR 	DREAD

	LDA	ZCODE+ZPURBT	; DETERMINE # PAGES
	STA	TEMP		; TO RETRIEVE

LREST:	JSR	DREAD		; FETCH REMAINDER OF PRELOAD
	DEC	TEMP
	BNE	LREST

	; RESTORE STATE OF SAVED GAME

	LDX	#BUFSAV+2	; POINT TO SAVED VARIABLES
	LDD	,X++
	STD	OZSTAK		; RESTORE OLD STACK POINTERS
	LDU	,X++
	LDA	,X+
	STA	ZPCH		; HIGH BYTE OF ZPC
	LDD	,X		; LOW BYTES OF ZPC
	STD	ZPCM
	CLR	ZPCFLG		; PC HAS CHANGED!

	LDD	VAL		; RESTORE FLAGS
	STD	ZCODE+ZSCRIP

	; RESUME GAME AFTER SAVE OR RESTORE

RESUME:	BSR	TOBOOT		; PROMPT FOR GAME DISK
	JMP	PREDS		; PREDICATE SUCCEEDS

TOBOOT:	CLR	DRIVE		; BACK TO BOOT DRIVE
	LDX	#GAME
	LDB	#GAMEL
	JSR	DLINE		; "INSERT STORY DISK IN DRIVE 0,"
	JSR	ENTER		; "PRESS <ENTER> TO CONTINUE"
	COM	SCRIPT		; RE-ENABLE SCRIPTING
	JMP	CLS		; CLEAR SCREEN AND RETURN

	; ---------------------------
	; "PRESS <ENTER> TO CONTINUE"
	; ---------------------------

ENTER:	LDX	#PRESS
	LDB	#PRESSL
	STB	CFLAG		; ENABLE CURSOR
	JSR	LINE		; "PRESS <ENTER> TO CONTINUE"
	JSR	GETKEY		; GET A KEY
	CLR	CFLAG		; DISABLE CURSOR
	LDA	#EOL
	JMP	COUT		; DO EOL AND RETURN

	; --------------------------------
	; PROMPT SEQUENCE FOR SAVE/RESTORE
	; --------------------------------

PARAMS:	LDX	#POSIT
	LDB	#POSITL
	JSR	DLINE		; "GAME ... POSITION 1-7 "
	JSR	INVERT		; FLIP STATUS LINE

	LDA	#TRUE
	STA	CFLAG		; ENABLE CURSOR

	; GET POSITION

	LDA	GPOSIT		; GET DEFAULT POSITION
	INCA			; 1-ALIGN IT
	JSR	DODEF

GETPOS:	JSR	GETKEY
	CMPA	#EOL
	BEQ	SETPOS
	SUBA	#$31		; CONVERT "1-7" TO 0-6
	CMPA	#7		; IF LOWER THAN "7"
	BLO	POSSET		; SET NEW POSITION
	JSR	BOOP		; ELSE RAZZ
	BRA	GETPOS		; AND TRY AGAIN

SETPOS:	LDA	GPOSIT		; USE DEFAULT
POSSET:	STA	TPOSIT		; TEMP DEFAULT
	ADDA	#$31		; CONVERT TO ASCII
	STA	PDO		; HERE TOO

	STA	PDTNPO		; AND HERE

	JSR	OUTCHR		; AND SHOW CHOICE

	; GET DRIVE #

	LDX	#WDRIV
	LDB	#WDRIVL
	JSR	DLINE		; "DRIVE 0 OR 1 "

	LDA	GDRIVE
	BSR	DODEF		; SHOW DEFAULT

GETDRV:	JSR	GETKEY
	CMPA	#EOL
	BEQ	DRVSET
	SUBA	#$30		; CONVERT TO ASCII
	CMPA	#2
	BLO	SETDRV
	JSR	BOOP
	BRA	GETDRV		; DRIVE # NO GOOD

DRVSET:	LDA	GDRIVE
SETDRV:	STA	TDRIVE		; TEMP DEFAULT
	ADDA	#$30		; CONVERT TO ASCII
	STA	GAMDRI		; FOR PROMPT

	STA     PDTNDR		; SAVE IN PDTION STRING

	JSR     OUTCHR		; AND SHOW CHOICE

	LDX     #PDTION
	LDB     #PDTIONL
	JSR     DLINE		; "\n\nPOSITION *, DRIVE *. ARE YOU SURE? (Y/N) >"

SDLOOP:	JSR	GETKEY 		; SHOW CHOICE

	CMPA	#'Y'		; CHOICE IS 'Y'?
	BEQ     SDSAVE
	CMPA	#EOL		; CHOICE IS <ENTER>? (SAME AS 'Y')
	BEQ     SDSAVE
	CMPA	#'N'		; CHOICE IS 'N'?
	BEQ     SDABRT
        JSR     BOOP		; BOOP AT BAD CHOICE
	BRA     SDLOOP		; AND LOOP
SDABRT:	LDA	#$00
	RTS

SDSAVE:	LDA	TDRIVE		; SAVE NEW DEFAULT DRIVE
	STA	GDRIVE
	STA	DRIVE
	LDA	TPOSIT		; SAVE NEW DEFAULT POSITION
	STA	GPOSIT

	LDB	#5		; CALC BLOCK OFFSET (5 TRACKS/GAME)
	MUL
	STB	TRACK		; TRACK ADDRESS
	LDB	#1		; START ON SECTOR 1
	STB	TRACK+1		; SECTOR ADDRESS

	LDX	#INSERM
	LDB	#INSERML
	JSR	DLINE		; "INSERT SAVE DISK IN DRIVE X,"
	JSR	ENTER		; ETC.

	LDA	#$FF
	RTS

	; ------------
	; SHOW DEFAULT
	; ------------

DODEF:	ADDA	#$30		; CONVERT # TO ASCII
	STA	DEFNUM		; INSERT IN STRING
	LDX	#DEFALT
	LDB	#DEFALL
	STB	CFLAG		; ENABLE CURSOR

	; FALL THROUGH TO ...

	; --------------------
	; DIRECT SCREEN OUTPUT
	; --------------------

	; ENTRY: SAME AS "LINE" ROUTINE

DLINE:	LDA	,X+
	JSR	OUTCHR
	DECB
	BNE	DLINE
	RTS

	; ----------------------
	; PRINT "POSITION X ..."
	; ----------------------

TIONP:	LDX	#PTION
	LDB	#PTIONL
	BRA	DLINE

	; ---------------------
	; TEXT FOR SAVE/RESTORE
	; ---------------------

RES:	.STR	"RESTORE"
RESL	EQU	*-RES

SAV:	.STR	"SAVE"
SAVL	EQU	*-SAV

INSERM:	.DB	EOL
	.DB	EOL
	.STR	"INSERT SAVE DISK IN DRIVE "
GAMDRI:	.STR	"0."
	.DB	EOL
INSERML	EQU	*-INSERM

GAME:	.DB	EOL
	.STR	"INSERT STORY DISK IN DRIVE 0."
	.DB	EOL
GAMEL	EQU	*-GAME

PRESS:	.STR	"PRESS <ENTER> TO CONTINUE."
	.DB	EOL
	.STR	">"
PRESSL	EQU	*-PRESS

POSIT:	.STR	" POSITION"
	.DB	EOL
	.DB	EOL
	.STR	"POSITION 1-7 "
POSITL	EQU	*-POSIT

WDRIV:	.DB	EOL
	.STR	"DRIVE 0 OR 1 "
WDRIVL	EQU	*-WDRIV

DEFALT:	.STR	"(DEFAULT = "
DEFNUM:	.STR	"*) >"
DEFALL	EQU	*-DEFALT

SING:	.DB	EOL
	.STR	"SAVING"
SINGL	EQU	*-SING

RING:	.DB	EOL
	.STR	"RESTORING"
RINGL	EQU	*-RING

PTION:	.STR	" POSITION "
PDO:	.STR	"* ..."
	.DB	EOL
PTIONL	EQU	*-PTION

PDTION:	.db	EOL
	.db	EOL
	.STR	"POSITION "
PDTNPO:	.STR	"*, DRIVE "
PDTNDR:	.STR	"*."
	.db	EOL
	.STR	"ARE YOU SURE? (Y/N) >"
PDTIONL	EQU	*-PDTION

ENDTST:	.STR	"END"

	;END


unix.superglobalmegacorp.com