Files
Andrew Plotkin b642da811e Initial commit.
2023-11-16 18:19:54 -05:00

682 lines
12 KiB
NASM

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 #>PSIDE1
BCC GETSD1 ; OK, SIDE1
BNE SID2
LDA DBLOCK+LO
CMP #<PSIDE1
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 #<PSIDE1 ; AMOUNT SO GET ACCURATE
PHA ; CALCULATION OF TRACK & SECTOR
LDA DBLOCK+HI
SBC #>PSIDE1
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 #3 ; SIDE 1 STARTS ON TRACK 3
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 TRKOVR
INC SECTOR
TRKOVR: RTS
TRKTBL: DB 21,21,21,21,21,21,21,21,21,21,21,21,21,21,21,21,21
DB 18,19,19,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 SECTOK
INC SECTOR ; SKIP 1ST SECTOR TRACK 18 (DIRECTORY)
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 #'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
; LDA #CLS
; JMP CHROUT ; HOME CURSOR & RETURN
; -----------------
; 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
GETYES: JSR GETKEY
CMP #'Y' ; IF REPLY IS "Y"
BEQ ALLSET ; ACCEPT RESPONSES
CMP #'y'
BEQ ALLSET
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
JMP PARAMS ; AND TRY AGAIN
ALLSET: LDX #<YES ; PRINT "YES"
LDA #>YES
LDY #YESL
JSR DLINE
; CALC START POSITION OF SAVE
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 SAVSIZ
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
SREADY: LDX #<INSM
LDA #>INSM
LDY #INSML
JSR DLINE ; "INSERT SAVE DISK IN DRIVE X."
JSR RETURN ; "PRESS [RETURN] TO CONTINUE."
TRYOPN: LDA TDRIVE ; TRY TO OPEN SPECIFIED DRIVE
CLC
ADC #8
JSR DOPEN ; THE DEFAULT DRIVE
RTS ; CARRY SET IF ERROR
; ---------------------
; "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: 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 ..."
; 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
; WRITE [LOCALS]/[BUFSAV] PAGE TO DISK
LDA #>LOCALS
STA DBUFF+HI ; POINT TO THE PAGE
JSR PUTDSK ; AND WRITE IT OUT
BCS BADSAV ; CATCH WRITE ERROR HERE
; WRITE CONTENTS OF Z-STACK TO DISK
ZSOK: LDA #>ZSTKBL ; POINT TO 1ST PAGE
STA DBUFF+HI
LDA #4 ; DO ALL 4 PAGES
STA L ; SET COUNTER
ZSOKLP: JSR PUTDSK ; WRITE THEM
BCS BADSAV
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: JSR PUTDSK
BCS BADSAV
DEC I+LO
BNE LSAVE
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
; ------------
; 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: 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 ..."
; SAVE LOCALS IN CASE OF ERROR
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
JSR GETRES ; RETRIEVE 1ST BLOCK OF PRELOAD
BCS BADRES
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: 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
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: 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
JSR SIDE2 ; PROMPT FOR GAME DISK
JSR VLDZPC ; MAKE VALID (12-2-86)
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
END