github.com/erkyrath.infocom-zcode-terps
1
0
Fork 0
mirror of https://github.com/erkyrath/infocom-zcode-terps.git synced 2026-04-26 04:17:04 +00:00
Code Issues Packages Projects Releases Wiki Activity

Initial commit.

Browse Source
This commit is contained in:
Andrew Plotkin
2023-11-16 18:19:54 -05:00
commit b642da811e
796 changed files with 433816 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

13
acorn/--read.me Normal file
View File

@@ -0,0 +1,13 @@
******* Directory Update and Source File Archive Record ******
Date of Last Change Version Letter Who Made the Change
___________________ _____________ ____________________
1) 1.15.85 A Le
2)
3)
4)
5)
6)
7)
8)

52
acorn/cold.asm Normal file
View File

@@ -0,0 +1,52 @@
PAGE
SBTTL "--- MACHINE COLDSTART: ACORN ---"
ORG ZIP
;COLDSTART
COLD: LDA #MODE ;SET SCREEN TO MODE 7
JSR VDU
LDA #7
JSR VDU
LDA #229 ;SET ESCAPE KEY TO ASCII CODE ($1B)
LDX #1
JSR OSBYTE
LDA #4 ;DISABLE CURSOR EDIT KEYS
LDX #1
JSR OSBYTE
JMP WARM1
;***************
;WARMSTART ENTRY
;***************
SLOAD: DB "The story is loading ..."
; DB EOL
SLOADL EQU $-SLOAD
WARM1: CLD ;INSURE BINARY
LDX #$FF ;RESET MACHINE STACK
TXS
JSR CLS ;CLEAR SCREEN
LDA #MVTXC ;ALIGN "STORY LOADING"
JSR VDU
LDA #6 ;COL 6
JSR VDU
LDA #11 ;LINE 11
JSR VDU
LDX #LOW SLOAD
LDA #HIGH SLOAD
LDY #SLOADL
JSR DLINE ;"THE STORY IS LOADING ..."
;FALL THROUGH TO ZIP WARMSTART AT WARM2
END

53
acorn/disk.asm Normal file
View File

@@ -0,0 +1,53 @@
PAGE
SBTTL "DISK ACCESS: ACORN"
;****************************
;READ/WRITE A BLOCK TO IOBUFF
;****************************
;ENTRY: TRACK SET TO TRACK # (0-79)
; SECTOR SET TO SECTOR # (0-7)
; DRIVE SET TO 0 OR 1
; CARRY CLEAR TO READ, SET TO WRITE
;NOTE: PARAMS (NUMBER OF PARAMETERS) PERMANENTLY 3
; L (SECTOR LENGTH) PERMANENTLY $21 (ACORN CODE = 256 + 1)
DISK: BCS DWRITE
LDA #RDCMD ;SET INSTRUCTION BYTE TO READ A BLOCK
STA COMMD
JMP TODISK ;ALWAYS BRANCH
DWRITE: LDA #WTCMD ;ELSE SET TO WRITE A BLOCK
STA COMMD
TODISK: LDA #0 ;MAKE SURE RESULT BYTE IS CLEAR
STA RWRSLT
LDA #3 ;SET PARAMETER COUNT TO 3
STA PARAM
LDA #$21 ;SET SECTOR LENGTH TO 256
STA L
LDA #0
STA MEMADD+2 ;SET MEMORY ADDR TO RECEIVE BLOCK (IOBUFF)
STA MEMADD+3
LDY #HIGH IOBUFF
LDX #LOW IOBUFF
STY MEMADD+1 ;4 BYTES = LOW HIGHER HIGHER HIGHEST
STX MEMADD ;USE ONLY 2 BYTES SO 1ST 2 - LOWEST.
;READ/WRITE A SECTOR
LDY #HIGH SECBLK ;GET INSTRUCTION BLOCK
LDX #LOW SECBLK
LDA #$7F ;TELL OSWORD TO R/W A SECTOR
JSR OSWORD
LDA RWRSLT ;OK?
CMP #0
BNE BADWRT ;NO, FAILED
CLC
RTS ;RET OK
BADWRT: SEC
RTS ;RET CARRY SET = NO GOOD
END

92
acorn/dispatch.asm Normal file
View File

@@ -0,0 +1,92 @@
PAGE
SBTTL "--- OPCODE DISPATCH TABLES ---"
; 0-OPS
OPT0: DW ZRTRUE ; 0
DW ZRFALS ; 1
DW ZPRI ; 2
DW ZPRR ; 3
DW ZNOOP ; 4
DW ZSAVE ; 5
DW ZREST ; 6
DW ZSTART ; 7
DW ZRSTAK ; 8
DW POPVAL ; 9
DW ZQUIT ; 10
DW ZCRLF ; 11
DW ZUSL ; 12
DW ZVER ; 13
NOPS0 EQU 14 ; NUMBER OF 0-OPS
; 1-OPS
OPT1: DW ZZERO ; 0
DW ZNEXT ; 1
DW ZFIRST ; 2
DW ZLOC ; 3
DW ZPTSIZ ; 4
DW ZINC ; 5
DW ZDEC ; 6
DW ZPRB ; 7
DW BADOP1 ; 8 (UNDEFINED)
DW ZREMOV ; 9
DW ZPRD ; 10
DW ZRET ; 11
DW ZJUMP ; 12
DW ZPRINT ; 13
DW ZVALUE ; 14
DW ZBCOM ; 15
NOPS1 EQU 16 ; NUMBER OF 1-OPS
; 2-OPS
OPT2: DW BADOP2 ; 0 (UNDEFINED)
DW ZEQUAL ; 1
DW ZLESS ; 2
DW ZGRTR ; 3
DW ZDLESS ; 4
DW ZIGRTR ; 5
DW ZIN ; 6
DW ZBTST ; 7
DW ZBOR ; 8
DW ZBAND ; 9
DW ZFSETP ; 10
DW ZFSET ; 11
DW ZFCLR ; 12
DW ZSET ; 13
DW ZMOVE ; 14
DW ZGET ; 15
DW ZGETB ; 16
DW ZGETP ; 17
DW ZGETPT ; 18
DW ZNEXTP ; 19
DW ZADD ; 20
DW ZSUB ; 21
DW ZMUL ; 22
DW ZDIV ; 23
DW ZMOD ; 24
NOPS2 EQU 25 ; NUMBER OF 2-OPS
; X-OPS
OPTX: DW ZCALL ; 0
DW ZPUT ; 1
DW ZPUTB ; 2
DW ZPUTP ; 3
DW ZREAD ; 4
DW ZPRC ; 5
DW ZPRN ; 6
DW ZRAND ; 7
DW ZPUSH ; 8
DW ZPOP ; 9
DW ZSPLIT ; 10
DW ZSCRN ; 11
NOPSX EQU 12 ; NUMBER OF X-OPS
END

162
acorn/eq.asm Normal file
View File

@@ -0,0 +1,162 @@
PAGE
SBTTL "--- MEMORY ORGANIZATION ---"
TRUE EQU $FF
FALSE EQU 0
LO EQU 0
HI EQU 1
IOBUFF EQU $500 ; 256-BYTE DISK BUFFER
ZSTAKL EQU IOBUFF+$100 ; Z-STACK LSBS
ZSTAKH EQU IOBUFF+$200 ; Z-STACK MSBS
PTABL EQU IOBUFF+$300 ; PAGING TABLE LSBS
PTABH EQU IOBUFF+$400 ; PAGING TABLE MSBS
LOCALS EQU IOBUFF+$500 ; LOCAL VARIABLE STORAGE (32 BYTES)
BUFSAV EQU IOBUFF+$520 ; I/O AUX BUFFER (80 BYTES)
ZIP EQU MSTART ; START OF EXECUTABLE CODE
ZBEGIN EQU ZIP+$1800 ; START OF Z-CODE (ASSUME 6K ZIP)
; ---------------------
; Z-CODE HEADER OFFSETS
; ---------------------
ZVERS EQU 0 ; VERSION BYTE
ZMODE EQU 1 ; MODE SELECT BYTE
ZID EQU 2 ; GAME ID WORD
ZENDLD EQU 4 ; START OF NON-PRELOADED Z-CODE
ZGO EQU 6 ; EXECUTION ADDRESS
ZVOCAB EQU 8 ; START OF VOCABULARY TABLE
ZOBJEC EQU 10 ; START OF OBJECT TABLE
ZGLOBA EQU 12 ; START OF GLOBAL VARIABLE TABLE
ZPURBT EQU 14 ; START OF "PURE" Z-CODE
ZSCRIP EQU 16 ; FLAG WORD
ZSERIA EQU 18 ; 3-WORD ASCII SERIAL NUMBER
ZFWORD EQU 24 ; START OF FWORDS TABLE
ZLENTH EQU 26 ; LENGTH OF Z-PROGRAM IN WORDS
ZCHKSM EQU 28 ; Z-CODE CHECKSUM WORD
PAGE
SBTTL "--- ZIP Z-PAGE VARIABLES ---"
OPCODE EQU ZEROPG ; (BYTE) CURRENT OPCODE
NARGS EQU OPCODE+1 ; (BYTE) # ARGUMENTS
ARG1 EQU OPCODE+2 ; (WORD) ARGUMENT #1
ARG2 EQU OPCODE+4 ; (WORD) ARGUMENT #2
ARG3 EQU OPCODE+6 ; (WORD) ARGUMENT #3
ARG4 EQU OPCODE+8 ; (WORD) ARGUMENT #4
ABYTE EQU OPCODE+10 ; (BYTE) X-OP ARGUMENT BYTE
ADEX EQU OPCODE+11 ; (BYTE) X-OP ARGUMENT INDEX
VALUE EQU OPCODE+12 ; (WORD) VALUE RETURN REGISTER
I EQU VALUE+2 ; (WORD) GEN-PURPOSE REGISTER #1
J EQU VALUE+4 ; (WORD) GEN-PURPOSE REGISTER #2
K EQU VALUE+6 ; (WORD) GEN-PURPOSE REGISTER #3
ZSP EQU VALUE+8 ; (BYTE) Z-STACK POINTER
OLDZSP EQU ZSP+1 ; (BYTE) OLD Z-STACK POINTER
ZPC EQU ZSP+2 ; (3 BYTES) ZIP PROGRAM COUNTER
ZPCL EQU ZPC ; (BYTE) LOW 8 BITS OF [ZPC]
ZPCM EQU ZPC+1 ; (BYTE) MIDDLE 8 BITS OF [ZPC]
ZPCH EQU ZPC+2 ; (BYTE) HIGH BIT OF [ZPC]
ZPCFLG EQU ZPC+3 ; (BYTE) FLAG: "TRUE" IF [ZPCPNT] VALID
ZPCPNT EQU ZPC+4 ; (WORD) ABS POINTER TO CURRENT Z-PAGE
MPC EQU ZPC+6 ; (3 BYTES) MEMORY PROGRAM COUNTER
MPCL EQU MPC ; (BYTE) LOW 8 BITS OF [MPC]
MPCM EQU MPC+1 ; (BYTE) MIDDLE 8 BITS OF [MPC]
MPCH EQU MPC+2 ; (BYTE) HIGH BIT OF [MPC]
MPCFLG EQU MPC+3 ; (BYTE) FLAG: "TRUE" IF [MPCPNT] VALID
MPCPNT EQU MPC+4 ; (WORD) ABS POINTER TO CURRENT M-PAGE
LRU EQU MPC+6 ; (BYTE) PAGING INDEX
ZCODE EQU LRU+1 ; (BYTE) 1ST ABSOLUTE PAGE OF PRELOAD
ZPURE EQU LRU+2 ; (BYTE) 1ST VIRTUAL PAGE OF "PURE" Z-CODE
PAGE0 EQU LRU+3 ; (BYTE) 1ST PAGE OF ACTUAL SWAPPING SPACE
PMAX EQU LRU+4 ; (BYTE) MAXIMUM # OF SWAPPING PAGES
ZPAGE EQU LRU+5 ; (BYTE) CURRENT SWAPPING PAGE
TARGET EQU LRU+6 ; (WORD) TARGET PAGE FOR SWAPPING
GLOBAL EQU LRU+8 ; (WORD) GLOBAL VARIABLE POINTER
VOCAB EQU GLOBAL+2 ; (WORD) VOCAB TABLE POINTER
FWORDS EQU GLOBAL+4 ; (WORD) F-WORDS TABLE POINTER
OBJTAB EQU GLOBAL+6 ; (WORD) OBJECT TABLE POINTER
; Z-STRING MANIPULATION VARIABLES
IN EQU GLOBAL+8 ; (6 BYTES) INPUT BUFFER
OUT EQU IN+6 ; (6 BYTES) OUTPUT BUFFER
SOURCE EQU OUT+6 ; (BYTE) SOURCE BUFFER POINTER
RESULT EQU SOURCE+1 ; (BYTE) RESULT TABLE POINTER
LINLEN EQU SOURCE+2 ; (BYTE) LENGTH OF CURRENT LINE
WRDLEN EQU SOURCE+3 ; (BYTE) LENGTH OF CURRENT WORD
ENTRY EQU SOURCE+4 ; (WORD) ADDR OF CURRENT RESULT ENTRY
NENTS EQU SOURCE+6 ; (WORD) # ENTRIES IN VOCAB TABLE
ESIZE EQU SOURCE+8 ; (BYTE) SIZE OF VOCAB TABLE ENTRIES
PSET EQU SOURCE+9 ; (BYTE) PERMANENT CHARSET
TSET EQU SOURCE+10 ; (BYTE) TEMPORARY CHARSET
ZCHAR EQU SOURCE+11 ; (BYTE) CURRENT Z-CHAR
OFFSET EQU SOURCE+12 ; (BYTE) F-WORD TABLE OFFSET
ZFLAG EQU SOURCE+13 ; (BYTE) Z-WORD ACCESS FLAG
ZWORD EQU SOURCE+14 ; (WORD) CURRENT Z-WORD
CONCNT EQU SOURCE+16 ; (BYTE) Z-STRING SOURCE COUNTER
CONIN EQU SOURCE+17 ; (BYTE) CONVERSION SOURCE INDEX
CONOUT EQU SOURCE+18 ; (BYTE) CONVERSION DEST INDEX
QUOT EQU SOURCE+19 ; (WORD) QUOTIENT FOR DIVISION
REMAIN EQU QUOT+2 ; (WORD) REMAINDER FOR DIVISION
MTEMP EQU QUOT+4 ; (WORD) MATH TEMPORARY REGISTER
QSIGN EQU QUOT+6 ; (BYTE) SIGN OF QUOTIENT
RSIGN EQU QUOT+7 ; (BYTE) SIGN OF REMAINDER
DIGITS EQU QUOT+8 ; (BYTE) DIGIT COUNT FOR "PRINTN"
TIMEFL EQU QUOT+9 ; (BYTE) "TRUE" IF TIME MODE
LENGTH EQU TIMEFL+1 ; (BYTE) LENGTH OF LINE IN [LINBUF]
OLDLEN EQU TIMEFL+2 ; (BYTE) OLD LINE LENGTH
SCRIPT EQU TIMEFL+3 ; (BYTE) SCRIPT ENABLE FLAG
OLDX EQU TIMEFL+4 ; (BYTE) OLD CURSOR X
OLDY EQU TIMEFL+5 ; (BYTE) OLD CURSOR Y
LINCNT EQU TIMEFL+6 ; (BYTE) LINE COUNTER
;LMAX EQU TIMEFL+7 ; (BYTE) MAX # LINES/SCREEN
IOCHAR EQU TIMEFL+7 ; (BYTE) CHARACTER BUFFER
;SLINE EQU IOCHAR+1 ; (BYTE) BORDERLINE FOR SPLIT
;SPSTAT EQU IOCHAR+2 ; (BYTE) SPLIT SCREEN STATUS FLAG
LFROM EQU IOCHAR+1 ; (WORD) "FROM" LINE ADDRESS
LTO EQU IOCHAR+3 ; (WORD) "TO" LINE ADDRESS
PSTAT EQU IOCHAR+5 ; (BYTE) PRINTER STATUS FLAG
;STRING EQU IOCHAR+3 ; (WORD) STRING ADDRESS
;STRLEN EQU IOCHAR+5 ; (BYTE) STRING LENGTH
PRLEN EQU IOCHAR+6 ; (BYTE) SCRIPT LINE LENGTH
;LENDEX EQU IOCHAR+7 ; (BYTE) LINE PRINTING INDEX
DBLOCK EQU IOCHAR+7 ; (WORD) Z-BLOCK TO READ
DBUFF EQU DBLOCK+2 ; (WORD) RAM PAGE TO ACCESS (LSB = 0)
GPOSIT EQU DBLOCK+4 ; (BYTE) DEFAULT SAVE POSITION
GDRIVE EQU DBLOCK+5 ; (BYTE) DEFAULT SAVE DRIVE
TPOSIT EQU DBLOCK+6 ; (BYTE) TEMP SAVE POSITION
TDRIVE EQU DBLOCK+7 ; (BYTE) TEMP SAVE DRIVE
CFLAG EQU DBLOCK+8 ; (BYTE) CURSOR ON/OFF FLAG
;BLINK EQU DBLOCK+8 ; (WORD) CURSOR BLINK TIMER
SECBLK EQU DBLOCK+8 ; (LBL) DISK R/W INSTRUCTION BLOCK
DRIVE EQU SECBLK ; (BYTE) CURRENT DRIVE
MEMADD EQU SECBLK+1 ; (DBLWORD) MEMORY ADDRESS TO R/W TO/FROM
PARAM EQU SECBLK+5 ; (BYTE) # OF PARAMETERS, ALWAYS 3
COMMD EQU SECBLK+6 ; (BYTE) READ ($53) WRITE ($4B)
TRACK EQU SECBLK+7 ; (BYTE) TARGET TRACK
SECTOR EQU SECBLK+8 ; (BYTE) TARGET SECTOR
L EQU SECBLK+9 ; (BYTE) SECTOR LENGTH, ALWAYS $21 (= 256)
RWRSLT EQU SECBLK+10 ; (BYTE) R/W FAILED/SUCCEEDED
HOLDX EQU SECBLK+11 ; (BYTE) HOLD FOR SCROLL
NDEX EQU HOLDX+1 ; (BYTE) HOLD FOR SCROLL
RAND1 EQU HOLDX+2 ; (BYTE) RANDOM BYTE #1
RAND2 EQU RAND1+1 ; (BYTE) RANDOM BYTE #2
RNDFLG EQU RAND1+2 ; (BYTE) FLAG FOR 1ST CHAR ENTERED.
END

62
acorn/hardeq.asm Normal file
View File

@@ -0,0 +1,62 @@
PAGE
SBTTL "--- HARDWARE EQUATES: ACORN ---"
;VDU
;ENABLE EQU 2 ;ENABLE PRINTER
;DISABL EQU 3 ;DISABLE PRINTER
BELL EQU 7 ;MAKE SHORT SOUND
;FRWRD EQU 9 ;FORWARDSPACE CURSOR ONE CHAR
CLSCR EQU 12 ;CLEAR TEXT AREA
MODE EQU 22 ;SELECT SCREEN MODE
CURSOR EQU 23 ;TURN CURSOR ON/OFF
HOME EQU 30 ;HOME TEXT CURSOR
MVTXC EQU 31 ;MOVE TEXT CURSOR TO X,Y
BACKSP EQU 127 ;($7F) BACKSPACE & DELETE
BLUE EQU 134 ;SET CHARS TO BLUE (USED FOR STATUS LINE)
;OSBYTE CALLS
OUTSTR EQU 3 ;SET OUTPUT STREAM
TYPE EQU 5 ;SELECT PRINTER TYPE
;(SEND TO PARALLEL OR RS423 SERIAL OUTPUT)
IGNORE EQU 6 ;SET PRINTER IGNORE CHAR
BAUD EQU 8 ;SET RS423 TRANSMIT BAUD RATE
RDCPOS EQU 134 ;READ TEXT CURSOR POSITION
RDCHAR EQU 135 ;READ CHAR @ CURSOR POSITION
TV EQU 144 ;ALTER TV DISPLAY INTERLACE
ESCASC EQU 229 ;SET ESC TO RET ASCII CODE INSTEAD OF DOING ITS THING
;CONSTANTS
XSIZE EQU 39 ;X-SIZE (COLUMNS)OF SCREEN
YSIZE EQU 25 ;Y-SIZE (LINES) OF SCREEN
EOL EQU $0D ;END OF LINE (RET) CHAR
SPACE EQU $20 ;SPACE CHAR
OFF EQU 1 ;TV INTERLACE
RDCMD EQU $53 ;READ SECTOR
WTCMD EQU $4B ;WRITE SECTOR
LMAX EQU 24 ;MAX LINES ON SCREEN LESS STATUS LINE
;OS CALLS
OSRDCH EQU $FFE0 ;READ A CHAR FROM KEYBOARD (INPUT STREAM)
OSWRCH EQU $FFEE ;WRITE A CHAR TO SCREEN (INPUT STREAM)
OSWORD EQU $FFF1 ;MISC. - USED TO WRITE TO DISK
OSBYTE EQU $FFF4 ;MISC. INCLUDING VDU
VDU EQU OSWRCH ;VDU SENDS COMMANDS TO SCREEN
LBUFF EQU $0C00 ;89-BYTE LINE BUFFER
SBUFF EQU $0C77 ;40-BYTE SCROLL BUFFER
;(HOLDS 1 SCREEN LINE FOR SCROLLING TRANSFER)
SCREEN EQU $7C00 ;SCREEN RAM
END

444
acorn/io.asm Normal file
View File

@@ -0,0 +1,444 @@
PAGE
SBTTL 'GAME I/O'
;INTERNAL ERROR
;ENTRY: ERROR CODE IN A
ERRM: DB "INTERNAL ERROR "
ENUMB: DB "00."
ERRML EQU $-ERRM
ZERROR: LDY #1 ;CONVERT ERROR BYTE IN A
ECON: JSR DIV10 ;TO ASCII DECIMAL IN ENUMB
ORA #'0' ;DIV10 RETS REMAINDER IN A (LSD)
STA ENUMB,Y
TXA ;AND QUOTIENT IN X (WILL BE MSD)
DEY
BPL ECON ;DO BOTH DIGITS
JSR ZCRLF ;CLEAR BUFFER
LDA #0
STA SCRIPT ;DISABLE SCRIPTING
LDX #LOW ERRM ;PRINT MSG
LDA #HIGH ERRM
LDY #ERRML
JSR DLINE
;FALL THROUGH ...
;QUIT/RESTART
ZSTART: ;FLUSH BUFFER, DEMAND <RET> TO RESTART, GO TO WARM START
JSR ZCRLF ;FLUSH BUFFER
LDX #LOW TORES
LDA #HIGH TORES
LDY #TORESL
JSR DLINE ;"PRESS <RET> TO RESTART"
JSR GETRET ;WAIT FOR <RET>
JMP WARM1 ;AND DO WARMSTART
TORES: DB "End of story."
DB EOL
DB "Press <RETURN> to restart."
DB EOL
TORESL EQU $-TORES
ZQUIT EQU ZSTART ;0-OP
;PRINT VERSION #
VERS: DB "ACORN Version A"
DB EOL
VERSL EQU $-VERS
VERNUM: JSR ZCRLF ;CLEAR BUFFER
LDX #LOW VERS
LDA #HIGH VERS
LDY #VERSL
JMP DLINE ;DISPL VERSION # (RET TO CALLING FROM DLINE)
;************************
;RETURN TOP RAM PAGE IN A
;************************
MEMTOP: LDA #$7B ;IT'S A GIVEN
RTS
;****************************
;RETURN RANDOM BYTES IN A & X
;****************************
RANDOM: LDA #3 ; READ INTERVAL TIMER
LDX #LOW CLOCK
LDY #HIGH CLOCK
JSR OSWORD
LDA CLOCK
ADC RAND1
TAX
LDA CLOCK+1
SBC RAND2
STA RAND1
STX RAND2
CLC
RTS
; CLOCK = LSB, CLOCK+4 = MSB
CLOCK: DB 0,0,0,0,0
;*******************
;Z-PRINT A CHARACTER MOVE A (1) CHAR TO LBUFF, IF EOL REACHED
;******************* (CHAR OR ACTUAL), DISPLAY/PRINT LINE
;ENTRY: ASCII CHAR IN A
COUT: CMP #EOL ;IF EOL
BNE COUT1
JMP ZCRLF
COUT1: CMP #SPACE ;IGNORE ALL OTHER CONTROLS
BCC CEX ;(OUT)
COUT2: LDX LENGTH ;ELSE GET LINE POINTER
STA LBUFF,X ;ADD CHAR TO BUFFER
CPX #XSIZE ;END OF LINE?
BCC COUT3
JMP FLUSH
COUT3: INC LENGTH ;ELSE UPDATE POINTER
CEX: RTS
;*******************
;FLUSH OUTPUT BUFFER - PRINT UP THRU LAST FULL WORD (MARKED BY BLANK)
;******************* IF NO BLANK PRINT ENTIRE BUFFR
; MOVE ANY REMAINING CHARS TO TOP OF BUFFER FOR
; NEXT LINE
;ENTRY: LENGTH OF BUFFER IN X
FLUSH: LDA #SPACE
FL0: CMP LBUFF,X ;FIND LAST SPACE CHAR
BEQ FL1 ;IN THE LINE
DEX
BNE FL0
LDX #XSIZE ;IF NONE FOUND, FLUSH ENTIRE LINE
FL1: STX OLDLEN ;SAVE OLD LINE END POS HERE
STX LENGTH ;MAKE IT NEW LINE LENGTH
JSR ZCRLF ;PRINT LINE UP TO LAST SPACE
;START NEW LINE WITH REMAINDER OF OLD
LDX OLDLEN ;GET OLD LINE POS
LDY #0 ;START NEW LINE AT BEGINNING
FL2: INX
CPX #XSIZE ;CONTINUE IF
BCC FL3 ;INSIDE OR
BEQ FL3 ;AT END OF LINE (ie NOT ENTIRE LINE)
STY LENGTH ;ELSE SET NEW LINE LENGTH TO 0
RTS
FL3: LDA LBUFF,X ;GET CHAR FROM OLD LINE
STA LBUFF,Y ;MOVE TO START OF NEW LINE
INY ;UPDATE LENGTH OF NEW LINE
BNE FL2 ;MOVE ALL CHARS
;**************
;CARRIAGE RETURN
;**************
ZCRLF: INC LINCNT ;NEW LINE GOING OUT
LDA LINCNT ;IS IT TIME TO
CMP #LMAX ;PRINT "MORE" YET?
BCC CR1 ;NO, CONTINUE
;SCREEN FULL; PRINT "MORE"
JSR ZUSL ;UPDATE STATUS LINE
LDX #LOW MORE
LDA #HIGH MORE
LDY #MOREL
JSR DLINE ;DISPLAY "MORE"
JSR OSRDCH ;WAIT FOR ANY CHAR
;ERASE "MORE"
LDY #MOREL ;GET # CHARS DISPLAYED
ZCR0: LDA #BACKSP
JSR OSWRCH ;BACK UP ERASING AS GO
DEY
BNE ZCR0 ;COVER ALL LETTERS
LDA #1
STA LINCNT ;RESET FOR NEW SCREEN FULL
;AND GO DO MORE
CR1: LDX LENGTH
LDA #EOL ;INSTALL EOL AT
STA LBUFF,X ;END OF CURRENT LINE
INC LENGTH ;UPDATE LINE LENGTH
LINOUT: LDY LENGTH ;IF BUFFER EMPTY
BEQ LINEX ;DON'T PRINT ANYTHING
STY PRLEN ;SAVE LENGTH FOR "PPRINT"
LDX #0 ;SEND CONTENTS OF LBUFF TO SCREEN
LOUT: LDA LBUFF,X
JSR CHAR
INX
DEY
BNE LOUT ;DO ALL CHARS
JSR PPRINT ;PRINT LBUFF IF ENABLED
LINEX: LDA #0 ;RESET LINE LENGTH TO TOP
STA LENGTH
RTS ;AND RETURN
MORE: DB "-MORE-"
MOREL EQU $-MORE
;**********************
;UPDATE THE STATUS LINE
;**********************
ZUSL: LDA LENGTH ;SAVE ALL STRING-PRINTING VARIABLES
PHA
LDA MPCH
PHA
LDA MPCM
PHA
LDA MPCL
PHA
LDA TSET
PHA
LDA PSET
PHA
LDA ZWORD+HI
PHA
LDA ZWORD+LO
PHA
LDA ZFLAG
PHA
LDA DIGITS
PHA
LDX #XSIZE
USL0: LDA LBUFF,X ;MOVE CONTENTS OF LBUFF
STA BUFSAV,X ;TO BUFSAV
LDA #SPACE ;CLEAR LBUFF WITH SPACES
STA LBUFF,X
DEX
BPL USL0
LDA #0
STA LENGTH ;RESET LINE LENGTH
STA SCRIPT ;DISABLE SCRIPTING
LDA #RDCPOS ;GET CURSOR POSITION
JSR OSBYTE
STX OLDX ;SAVE REGULAR POSITION OF CURSOR
STY OLDY
LDA #HOME ;HOME CURSOR
JSR VDU
LDA #BLUE ;SET STATUS LINE TO BLUE SO STANDS OUT
JSR COUT ;PLACE COLOR CONTROL IN LBUFF SO WHEN PRINTS
;WILL BE INCLUDED IN LINE COUNT
;(NO NEED TO RESET, COMMAND AFFECTS 1 LINE ONLY)
;MOVE ROOM DESCRIPTION TO LBUFF
LDA #16 ;GLOBAL VAR #16 9ROOM ID)
JSR GETVRG ;GET IT INTO VALUE
LDA VALUE+LO
JSR PRNTDC ;PRINT SHORT ROOM DESC.
LDA #23 ;MOVE LINE INDEX UP
STA LENGTH ;TO TIME/SCORE POSITION
LDA #SPACE
JSR COUT ; OUTPUT A SPACE FOR SAFETY
LDA #17 ;GLOBAL VAR #17 (SCORE/HOURS)
JSR GETVRG ;GET IT INTO VALUE
LDA TIMEFL ;GET MODE FLAG
BNE DOTIME ;USE TIME MODE IF NON-ZERO
;PRINT 'SCORE' (DO BY HAND NO REGISTERS PRESERVED THRU COUT)
LDA #'S'
JSR COUT
LDA #'c'
JSR COUT
LDA #'o'
JSR COUT
LDA #'r'
JSR COUT
LDA #'e'
JSR COUT
LDA #':'
JSR COUT
LDA #SPACE
JSR COUT
LDA VALUE+LO ;MOVE SCORE VALUE
STA QUOT+LO ;INTO QUOT
LDA VALUE+HI ;FOR PRINTING
STA QUOT+HI
JSR NUMBER ;CONVERT TO DECIMAL, MOVE TO LBUFF ("PRINT")
LDA #'/' ;PRINT A SLASH
BNE MOVMIN ;BRANCH ALWAYS
;PRINT 'TIME'
DOTIME: LDA #'T'
JSR COUT
LDA #'i'
JSR COUT
LDA #'m'
JSR COUT
LDA #'e'
JSR COUT
LDA #':'
JSR COUT
LDA #SPACE
JSR COUT
LDA VALUE+LO ;00 IS REALLY 24
BNE DTO
LDA #24
DTO: CMP #13 ;HOURS > 12?
BCC DT1 ;NO, SKIP THIS
SBC #12 ;CONVERT TO 1-12
DT1: STA QUOT+LO ;MOVE FOR PRINTING
LDA #0
STA QUOT+HI ;CLEAR MSB
JSR NUMBER
LDA #':' ;COLON
MOVMIN: JSR COUT ;PRINT SLASH OR COLON
LDA #18 ;GLOBAL VAR #18 (MOVES/MINUTES)
JSR GETVRG ;MOVE TO VALUE
LDA VALUE+LO ;MOVE TO QUOT
STA QUOT+LO
LDA VALUE+HI
STA QUOT+HI
LDA TIMEFL ;WHICH MODE?
BNE DOMINS ;TIME IF NZ
;PRINT # OF MOVES
JSR NUMBER ;CONVERT & MOVE TO LBUFF
JMP STATEX ;ALL DONE
;PRINT MINUTES
DOMINS: LDA VALUE+LO ;CHECK MINUTES
CMP #10 ;IF OVER 10
BCS DOMO ;CONTINUE
LDA #'0' ;ELSE PRINT A
JSR COUT ;PADDING "0" FIRST
DOMO: JSR NUMBER ;CONVERT, MOVE TO PRINT
LDA #SPACE
JSR COUT ;SEPARATE THINGS
LDA #17 ;CHECK 'HOURS' AGAIN
JSR GETVRG
LDA VALUE+LO
CMP #12 ;PAST NOON
BCS DOPM ;YES, "PM"
LDA #'a' ;ELSE "AM"
BNE DOXM ;BRANCH ALWAYS
DOPM: LDA #'p'
DOXM: JSR COUT
LDA #'m'
JSR COUT
;STATUS LINE READY
STATEX: LDA #40 ;PRINT THE ENTIRE STATUS LINE ***LINE LENGTH PROB?****
STA LENGTH
JSR CR1
LDX #XSIZE ;RESTORE OLD LBUFF
USLX: LDA BUFSAV,X
STA LBUFF,X
DEX
BPL USLX ;MOVE ALL CHARS
PLA ;RESTORE ALL SAVED VARIABLES
STA DIGITS
PLA
STA ZFLAG
PLA
STA ZWORD+LO
PLA
STA ZWORD+HI
PLA
STA PSET
PLA
STA TSET
PLA
STA MPCL
PLA
STA MPCM
PLA
STA MPCH
PLA
STA LENGTH
;RESTORE CURSOR
LDA #MVTXC ;MOVE TEXT CURSOR
JSR VDU
LDA OLDX ;TO OLD COORDINATES
JSR VDU
LDA OLDY
JSR VDU
LDX #$FF
STX SCRIPT ;RE-ENABLE SCRIPTING
INX
STX MPCFLG ;(0) INVALIDATE MPC
RTS
;****************
;DIVIDE [A] BY 10
;****************
;EXIT: QUOTIENT IN X, REMAINDER IN A
DIV10: LDX #0 ;START WITH ZERO QUOTIENT
D10L: CMP #10 ;IF DIVISOR < 10,
BCC D10EX ;WE'RE DONE
SBC #10 ;ELSE SUBTRACT ANOTHER 10
INX ;UPDATE QUOTIENT
BNE D10L ;BRANCH ALWAYS
D10EX: RTS
END

300
acorn/machine.asm Normal file
View File

@@ -0,0 +1,300 @@
PAGE
SBTTL 'MACHINE DEPENDENT I/O'
GETKEY: TXA ;SAVE X AND Y
PHA
TYA
PHA
GKEY0: JSR OSRDCH ;GET A CHAR
;CHECK TO MAKE SURE KEY IS VALID, ONLY ACCEPT IT IF IT IS
GKEY3: AND #$7F ;SCREEN OUT SHIFTS
CMP #EOL ;CHECK FOR GOOD (BAD) CHAR
BEQ OK
CMP #BACKSP
BEQ OK
CMP #SPACE
BCC BADKEY ;IF < SPACE, BAD
CMP #$40 ;@
BEQ BADKEY
CMP #$25 ;%
BCC OK ;BELOW RANGE
CMP #$27 ;'
BEQ OK ;GOOD CHAR
CMP #$2C ;+ +1
BCS MASK0 ;NOT IN THIS GROUP, TRY OTHER
ORA #$10 ;SET BIT 4, CHANGE %&()*+ TO 5689:;
;(FROM BAD TO GOOD CHAR AS SAME KEY LOCATION)
JMP OK ;GOOD, DONE NOW
MASK0: CMP #$3C ;<
BCC OK ;LESS
CMP #$3F ;> +1
BCS MASK1 ;OK, GO DO LETTERS
AND #$2F ;CLEAR BIT 4, CHANGE <=> TO ,-.
BNE OK ;BRANCH ALWAYS, DONE
MASK1: CMP #'z'+1
BCS BADKEY ;IF > BAD
CMP #'a'
BCS OK ;IF > OK
CMP #'Z'+1
BCC OK ;IF < OK
BADKEY: JSR BOOP ;BAD KEY, GIVE WARNING NOISE
JMP GKEY0 ;TRY AGAIN
OK: STA IOCHAR ;HOLD ON TO IT
ADC RAND1
STA RAND2
LSR A
STA RAND1
PLA
TAY
PLA
TAX
LDA IOCHAR ;RETRIEVE IT
RTS
BOOP: LDA #BELL ;(DOES NOT WORK, STOLE SOUND GENERATION MEMORY)
JSR OSWRCH
RTS
;PUT A CHAR TO SCREEN (PHYSICALLY), HANDLE EOL, SCROLLING IF NECESSARY
CHAR: STA IOCHAR ;PRESERVE X,Y SAVE A TO USE
TXA
PHA
TYA
PHA
LDA #RDCPOS ;READ TEXT CURSOR POS.
JSR OSBYTE ;GIVES X,Y
LDA IOCHAR
CMP #EOL
BEQ OUTEOL ;EOL = SPECIAL HANDLING
CMP #BACKSP ;IF DEL CHAR DON'T SCROLL
BEQ NOSCRL
CPY #YSIZE-1 ;ON LAST SCREEN LINE?
BCC NOSCRL ;NO, NO SCROLL NEEDED
CPX #XSIZE ;LAST CHAR ON LINE?
BCC NOSCRL ;NO, NO SCROLL YET
DOSCRL: LDA #11 ;MOVE CURSOR UP 1 LINE
JSR VDU ;FOR ALIGNMENT AFTER SCROLL
LDX #1 ;START TRANSFERING FROM LINE 1
SRL0: CPX #YSIZE
BEQ SRL2
LDA LOLINE,X ;GET ADDR OF DEST LINE
STA LTO+LO ;INTO [LTO]
LDA HILINE,X
STA LTO+HI
INX ;NEXT LINE
LDA LOLINE,X ;GET ADDR OF SOURCE LINE
STA LFROM+LO ;INTO [LFROM]
LDA HILINE,X
STA LFROM+HI
LDY #XSIZE
SRL1: LDA (LFROM),Y ;MOVE SOURCE LINE
STA (LTO),Y ;TO DEST LINE
DEY
BPL SRL1
BMI SRL0 ;LOOP TILL X = YSIZE
SRL2: LDX #XSIZE ;CLEAR LAST LINE
LDA #SPACE ;OF SCREEN RAM
SRL3: STA SCREEN+960,X
DEX
BPL SRL3
;DROP THRU TO SEND CHAR OUT NOW
NOSCRL: LDA IOCHAR
JSR OSWRCH ;SEND CHAR TO SCREEN
CMP #EOL ;IF CR
BNE NS1
LDA #$0A ;SEND LF
JSR OSWRCH
NS1: PLA
TAY
PLA
TAX
LDA IOCHAR
RTS
OUTEOL: CPY #YSIZE-1 ;LAST LINE ON SCREEN?
BCC NOSCRL ;NO
BCS DOSCRL ;YES, SO SCROLL
;*******
INPUT: ;FETCH A LINE OF INPUT FOR READ RTN
;ENTRY: ABS ADDR OF READ BUFFR IN ARG1
;EXIT: # CHARS READ IN A
JSR LINOUT ;FLUSH LBUFF
LDY #0
STY LINCNT ;RESET LINE COUNT
INLOOP: JSR GETKEY ;GET ASCII INTO A
CMP #EOL ;<RET>?
BEQ ENDLIN ;LINE DONE IF SO
CMP #BACKSP ;BACKSPACE?
BEQ BACKUP ;SPECIAL HANDLING
STA LBUFF,Y ;ELSE ADD CHAR TO INPUT BUFFR
INY ;NEXT POSITION IN LINE
SHOWIT: JSR CHAR ;DISPLAY CHAR
CPY #77 ;2 SCREEN LINES FULL?
BCC INLOOP ;NO, KEEP GOING
;HANDLE LINE OVERFLOW
NOMORE: JSR GETKEY
CMP #EOL ;IF EOL, WRAP UP THE LINE
BEQ ENDLIN
CMP #BACKSP ;BACKSPACE OK TOO
BEQ BACKUP
JSR BOOP ;ELSE COMPLAIN
JMP NOMORE ;AND INSIST
;HANDLE BACKSPACE
BACKUP: DEY ;BACKUP THE POINTER
BPL SHOWIT ;SEND BS IF NOT START OF LINE
JSR BOOP ;ELSE SAY BAD
LDY #0 ;RESET POINTER
BEQ INLOOP ;AND TRY AGAIN
;END OF LINE
ENDLIN: STA LBUFF,Y ;PLACE IN BUFFER
INY ;UPDATE INDEX
STY LINLEN ;SAVE FOR "READ"
STY PRLEN ;AND "PRINT"
JSR CHAR ;SEND EOL TO SCREEN
;MOVE LBUFF TO ARG1 W/LOWER CASE CONVERSION
LEX1: LDA LBUFF-1,Y ;GET A CHAR FROM LBUFF
CMP #'A' ;IF CHAR IS ALPHA
BCC LEX2 ;CONVERT TO LOWER CASE
CMP #'Z'+1
BCS LEX2
ADC #$20
LEX2: STA (ARG1),Y ;MOVE CHAR TO INPUT BUFF AT ARG1
DEY ;LOOP TILL ALL CHARS MOVED
BPL LEX1
JSR PPRINT ;SCRIPT LBUFF IF ENABLED
LDA LINLEN ;RESTORE # CHARS
RTS ;INTO A
DLINE: ;DISPLAY A STRING
;ENTRY: STRING ADDR X=LSB A=MSB
; STRING LENGTH IN Y
STX STRNG+LO ;DROP STRING ADDRESS
STA STRNG+HI ;INTO DUMMY BYTES
LDX #0 ;INIT INDEX
DOUT: DB $BD ;6502 "LDA nnnn,X" OPCODE
STRNG: DW $0000 ;DUMMY OPERAND BYTES
JSR CHAR
INX ;NEXT CHAR
DEY ;DECREMENT CHAR COUNT
BNE DOUT ;LOOP TILL OUT OF CHARS
RTS
;CLEAR SCREEN
CLS: LDA #HIGH SCREEN
STA I+HI
LDA #0
STA I+LO
TAY
LDX #$04
CLS0: STA (I),Y
INY
BNE CLS0
INC I+HI
DEX
BNE CLS0
LDA #MVTXC ;ALIGN CURSOR AT
JSR VDU ;TOP OF SCREEN
LDA #0 ;COL 0
JSR VDU
LDA #1 ;TOP LINE
JMP VDU
;*****
;PRINT ON PRINTER
;*****
PPRINT: LDA SCRIPT ;SCRIPTING INTERNALLY ENABLED?
BEQ PEX ;NO, LEAVE
LDA ZBEGIN+ZSCRIP+1 ;CHECK SCRIPT FLAG
AND #%00000001 ;SCRIPTING ON?
BEQ PEX ;NO, LEAVE
LDA #OUTSTR ;SET OUTPUT STREAM
LDX #2 ;TO PRINTER
JSR OSBYTE
LDA #IGNORE ;SET TO PRINT
LDX #0 ;LINE FEEDS
JSR OSBYTE
LDY #0 ;PRINT OUT LINE
POUT: LDA LBUFF,Y
JSR OSWRCH
INY
DEC PRLEN
BNE POUT ;DO WHOLE LINE
LDA #OUTSTR ;RESET OUTPUT STREAM
LDA #4 ;TO VIDEO
JSR OSBYTE
PEX: RTS ;AND LEAVE
; ************
;NO SPLIT SCREEN OPTION IS BEING INCLUDED SO I AM INSERTING
; ************ RETURNS FOR THE ROUTINES
ZSPLIT: RTS
ZSCRN: RTS
;*******************
;LINE ADDRESS TABLES
;*******************
LOLINE: DB $00,$28,$50,$78,$A0,$C8,$F0,$18
DB $40,$68,$90,$B8,$E0,$08,$30,$58
DB $80,$A8,$D0,$F8,$20,$48,$70,$98
DB $C0
HILINE: DB $7C,$7C,$7C,$7C,$7C,$7C,$7C,$7D
DB $7D,$7D,$7D,$7D,$7D,$7E,$7E,$7E
DB $7E,$7E,$7E,$7E,$7F,$7F,$7F,$7F
DB $7F
END

215
acorn/main.asm Normal file
View File

@@ -0,0 +1,215 @@
PAGE
SBTTL "--- MAIN LOOP ---"
MLOOP: LDA #0
STA NARGS ; RESET # ARGUMENTS
INC RAND1
DEC RAND2
JSR NEXTPC ; GET NEXT INSTRUCTION INTO [A]
STA OPCODE ; SAVE IT HERE
IF DEBUG
STA MBYTE
LDA #0 ; BREAKPOINT #0
JSR DOBUG
LDA MBYTE
ENDIF
; DECODE AN OPCODE
TAX ; SET FLAGS
BMI DC0 ; IF POSITIVE,
JMP OP2 ; IT'S A 2-OP
DC0: CMP #$B0
BCS DC1
JMP OP1 ; OR MAYBE A 1-OP
DC1: CMP #$C0
BCS OPEXT
JMP OP0 ; PERHAPS A 0-OP
; --------------
; HANDLE AN X-OP
; --------------
OPEXT: JSR NEXTPC ; GRAB THE ARGUMENT ID BYTE
STA ABYTE ; HOLD IT HERE
LDX #0
STX ADEX ; INIT ARGUMENT INDEX
BEQ OPX1 ; JUMP TO TOP OF LOOP
OPX0: LDA ABYTE ; GET ARG BYTE
ASL A ; SHIFT NEXT 2 ARG BITS
ASL A ; INTO BITS 7 & 6
STA ABYTE ; HOLD FOR LATER
OPX1: AND #%11000000 ; MASK OUT GARBAGE BITS
BNE OPX2
JSR GETLNG ; 00 = LONG IMMEDIATE
JMP OPXNXT
OPX2: CMP #%01000000 ; IS IT A SHORT IMMEDIATE?
BNE OPX3 ; NO, KEEP GUESSING
JSR GETSHT ; 01 = SHORT IMMEDIATE
JMP OPXNXT
OPX3: CMP #%10000000 ; LAST TEST
BNE OPX4 ; 11 = NO MORE ARGUMENTS
JSR GETVAR ; 10 = VARIABLE
OPXNXT: LDX ADEX ; RETRIEVE ARGUMENT INDEX
LDA VALUE+LO ; GRAB LSB OF VALUE
STA ARG1+LO,X ; STORE IN ARGUMENT TABLE
LDA VALUE+HI ; GRAB MSB OF VALUE
STA ARG1+HI,X ; STORE THAT, TOO
INC NARGS ; UPDATE ARGUMENT COUNTER
INX
INX
STX ADEX ; UPDATE INDEX
CPX #8 ; DONE 4 ARGUMENTS YET?
BCC OPX0 ; NO, GET SOME MORE
; ALL X-OP ARGUMENTS READY
OPX4: LDA OPCODE ; IS THIS
CMP #$E0 ; AN EXTENDED 2-OP?
BCS DOXOP ; NO, IT'S A REAL X-OP
JMP OP2EX ; ELSE TREAT IT LIKE A 2-OP
DOXOP: LDX #LOW OPTX ; GET ADDR OF X-OP TABLE
LDY #HIGH OPTX ; INTO [X/Y]
AND #%00011111 ; ISOLATE OP ID BITS
CMP #NOPSX ; IS IT A LEGAL X-OP?
BCC DODIS ; YUP; TIME TO DISPATCH IT
; *** ERROR #1 -- ILLEGAL X-OP ***
LDA #1
JMP ZERROR
; ---------------
; OPCODE DISPATCH
; ---------------
; ENTRY: MASKED OPCODE INDEX IN [A]
; OP-TABLE ADDR IN X/Y (LSB/MSB)
DODIS: STX I+LO ; SAVE TABLE ADDRESS
STY I+HI ; IN A POINTER
ASL A ; WORD-ALIGN THE OP INDEX
TAY
LDA (I),Y ; GET LSB OF DISPATCH ADDRESS
STA GO+LO ; INSTALL AS JSR OPERAND
INY
LDA (I),Y ; SAME WITH MSB
STA GO+HI
DB $20 ; 6502 "JSR" OPCODE
GO: DW $0000 ; DUMMY OPERAND BYTES
JMP MLOOP ; GO BACK FOR ANOTHER OPCODE
; -------------
; HANDLE A 0-OP
; -------------
OP0: LDX #LOW OPT0 ; GET 0-OP TABLE ADDR
LDY #HIGH OPT0 ; INTO [X/Y]
AND #%00001111 ; ISOLATE 0-OP ID BITS
CMP #NOPS0 ; OUT OF RANGE?
BCC DODIS ; NO, DISPATCH IT
; *** ERROR #2 -- ILLEGAL 0-OP ***
LDA #2
JMP ZERROR
; -------------
; HANDLE A 1-OP
; -------------
OP1: AND #%00110000 ; ISOLATE ARGUMENT BITS
BNE OP1A
JSR GETLNG ; 00 = LONG IMMEDIATE
JMP OP1EX
OP1A: CMP #%00010000 ; TEST AGAIN
BNE OP1B
JSR GETSHT ; 01 = SHORT IMMEDIATE
JMP OP1EX
OP1B: CMP #%00100000 ; ONE MORE TEST
BNE BADOP1 ; UNDEFINED STATE!
JSR GETVAR ; 10 = VARIABLE
OP1EX: JSR V2A1 ; MOVE [VALUE] TO [ARG1], UPDATE [NARGS]
LDX #LOW OPT1 ; GET ADDR OF 1-OP TABLE
LDY #HIGH OPT1 ; INTO [X/Y]
LDA OPCODE ; RESTORE OPCODE
AND #%00001111 ; ISOLATE OP ID BITS
CMP #NOPS1 ; IF WITHIN RANGE,
BCC DODIS ; EXECUTE THE 1-OP
; *** ERROR #3 -- ILLEGAL 1-OP ***
BADOP1: LDA #3
JMP ZERROR
; -------------
; HANDLE A 2-OP
; -------------
OP2: AND #%01000000 ; ISOLATE 1ST ARG BIT
BNE OP2A
JSR GETSHT ; 0 = SHORT IMMEDIATE
JMP OP2B
OP2A: JSR GETVAR ; 1 = VARIABLE
OP2B: JSR V2A1 ; [VALUE] TO [ARG1], UPDATE [NARGS]
LDA OPCODE ; RESTORE OPCODE BYTE
AND #%00100000 ; ISOLATE 2ND ARG BIT
BNE OP2C
JSR GETSHT ; 0 = SHORT IMMEDIATE
JMP OP2D
OP2C: JSR GETVAR ; 1 = VARIABLE
OP2D: LDA VALUE+LO ; MOVE 2ND [VALUE]
STA ARG2+LO ; INTO [ARG2]
LDA VALUE+HI
STA ARG2+HI
INC NARGS ; UPDATE ARGUMENT COUNT
; EXECUTE A 2-OP OR EXTENDED 2-OP
OP2EX: LDX #LOW OPT2 ; LSB OF DISPATCH TABLE
LDY #HIGH OPT2 ; MSB
LDA OPCODE ; RESTORE OPCODE BYTE
AND #%00011111 ; ISOLATE OP ID BITS
CMP #NOPS2
BCS BADOP2 ; ERROR IF OUT OF RANGE
JMP DODIS ; ELSE DISPATCH
; *** ERROR #4 -- ILLEGAL 2-OP ****
BADOP2: LDA #4
JMP ZERROR
; --------------------------------------
; MOVE [VALUE] TO [ARG1], UPDATE [NARGS]
; --------------------------------------
V2A1: LDA VALUE+LO
STA ARG1+LO
LDA VALUE+HI
STA ARG1+HI
INC NARGS
RTS
END

160
acorn/objects.asm Normal file
View File

@@ -0,0 +1,160 @@
PAGE
SBTTL "--- OBJECT & PROPERTY HANDLERS ---"
; ----------------------------------
; GET ABSOLUTE ADDRESS OF OBJECT [A]
; ----------------------------------
; EXIT: ADDRESS IN [I]
OBJLOC: STA I+LO ; SAVE LSB FOR ADDING
LDX #0 ; CLEAR MSB
STX I+HI ; FOR SHIFTING
ASL A ; MULTIPLY BY 8
ROL I+HI
ASL A
ROL I+HI
ASL A
ROL I+HI
CLC ; ADD TO ITSELF
ADC I+LO ; TO GET TIMES 9
BCC OBJ1
INC I+HI
OBJ1: CLC
ADC #53 ; NOW ADD 53
BCC OBJ2 ; (THE OBJECT TABLE OFFSET)
INC I+HI
OBJ2: CLC ; NEXT ADD THE ABS ADDR
ADC OBJTAB+LO ; OF THE OBJECT TABLE
STA I+LO
LDA I+HI
ADC OBJTAB+HI
STA I+HI
RTS
; -----------------------------
; GET ADDRESS OF PROPERTY TABLE
; -----------------------------
; EXIT: [I] HAS ABSOLUTE ADDR OF PROPERTY TABLE
; [Y] HAS OFFSET TO START OF PROP IDS
PROPB: LDA ARG1+LO
JSR OBJLOC
LDY #7
LDA (I),Y ; GET MSB OF P-TABLE ADDRESS
CLC
ADC ZCODE ; MAKE IT ABSOLUTE
TAX ; AND SAVE HERE
INY
LDA (I),Y ; NOW GET LSB
STA I+LO
STX I+HI ; [I] NOW POINTS TO PROP TABLE
LDY #0
LDA (I),Y ; GET LENGTH OF SHORT DESC
ASL A ; WORD-ALIGN IT
TAY ; EXPECTED HERE
INY ; POINT JUST PAST THE DESCRIPTION
RTS
; -------------------
; FETCH A PROPERTY ID
; -------------------
; ENTRY: LIKE "PROPB" EXIT
PROPN: LDA (I),Y
AND #%00011111 ; MASK OUT LENGTH BITS
RTS
; -------------------------------
; FETCH # BYTES IN PROPERTY VALUE
; -------------------------------
; ENTRY: LIKE "PROPB" EXIT
PROPL: LDA (I),Y
LSR A ; LENGTH IS IN
LSR A ; BITS 7-5
LSR A ; SO SHIFT INTO PLACE
LSR A
LSR A
RTS
; ----------------------
; POINT TO NEXT PROPERTY
; ----------------------
; ENTRY: LIKE "PROPB" EXIT
PROPNX: JSR PROPL ; GET LENGTH OF CURRENT PROP
TAX ; SAVE HERE
PPX: INY ; LOOP UNTIL
DEX ; [Y] POINTS TO
BPL PPX ; START OF NEXT PROP
INY ; CORRECT ALIGNMENT
RTS
; ----------------
; GET OBJECT FLAGS
; ----------------
; ENTRY: OBJECT # IN [ARG1], FLAG # IN [ARG2]
; EXIT: FLAG WORD IN [K], BIT ID IN [J],
; FLAG WORD ADDRESS IN [I]
FLAGSU: LDA ARG1+LO
JSR OBJLOC ; GET OBJECT ADDR IN [I]
LDA ARG2+LO ; LOOK AT FLAG ID
CMP #$10 ; FIRST SET OF FLAGS?
BCC FLS1 ; YES, ADDR IN [I] IS CORRECT
SBC #16 ; ELSE ZERO-ALIGN FLAG INDEX
TAX ; SAVE IT HERE
LDA I+LO ; ADD 2 TO ADDRESS IN [I]
CLC ; TO POINT TO ADDRESS OF
ADC #2 ; 2ND FLAG WORD
STA I+LO
BCC FLS0
INC I+HI
FLS0: TXA ; RESTORE INDEX
FLS1: STA K+LO ; SAVE FLAG ID HERE
LDX #1 ; INIT THE
STX J+LO ; FLAG WORD TO
DEX ; $0001
STX J+HI
LDA #15 ; SUBTRACT THE BIT POSITION
SEC ; FROM 15
SBC K+LO ; TO GET THE SHIFT LOOP
TAX ; INDEX
BEQ FLS2 ; EXIT NOW IF NO SHIFT NEEDED
FLSL: ASL J+LO ; SHIFT THE BIT
ROL J+HI ; INTO POSITION
DEX
BNE FLSL
FLS2: LDY #0 ; MOVE THE FLAG WORD
LDA (I),Y ; INTO [J]
STA K+HI ; FIRST THE MSB
INY
LDA (I),Y
STA K+LO ; THEN THE LSB
RTS
END

135
acorn/ops0.asm Normal file
View File

@@ -0,0 +1,135 @@
PAGE
SBTTL "--- 0-OPS ---"
; -----
; RTRUE
; -----
; SIMULATE A "RETURN 1"
ZRTRUE: LDX #1
ZRT0: LDA #0
ZRT1: STX ARG1+LO ; GIVE TO
STA ARG1+HI ; [ARG1]
JMP ZRET ; AND DO THE RETURN
; ------
; RFALSE
; ------
; SIMULATE A "RETURN 0"
ZRFALS: LDX #0
BEQ ZRT0
; ------
; PRINTI
; ------
; PRINT Z-STRING FOLLOWING THE OPCODE
ZPRI: LDA ZPCH ; MOVE [ZPC] INTO [MPC]
STA MPCH
LDA ZPCM
STA MPCM
LDA ZPCL
STA MPCL
LDA #0
STA MPCFLG ; [MPC] NO LONGER VALID
JSR PZSTR ; PRINT THE Z-STRING AT [MPC]
LDX #5 ; COPY STATE OF [MPC]
PRIL: LDA MPC,X ; INTO [ZPC]
STA ZPC,X
DEX
BPL PRIL
RTS
; ------
; PRINTR
; ------
; DO A "PRINTI," FOLLOWED BY "CRLF" AND "RTRUE"
ZPRR: JSR ZPRI
JSR ZCRLF
JMP ZRTRUE
; ------
; RSTACK
; ------
; "RETURN" WITH VALUE ON STACK
ZRSTAK: JSR POPVAL ; GET VALUE INTO [X/A]
JMP ZRT1 ; AND GIVE IT TO "RETURN"
; ------
; VERIFY
; ------
; VERIFY GAME CODE ON DISK
ZVER: JSR VERNUM ; DISPLAY ZIP VERSION NUMBER
LDX #3
LDA #0
ZVR: STA J+LO,X ; CLEAR [J], [K]
STA MPC,X ; [MPC] AND [MPCFLG]
DEX
BPL ZVR
LDA #64 ; POINT [MPC] TO Z-ADDRESS $00040
STA MPCL ; 1ST 64 BYTES AREN'T CHECKED
LDA ZBEGIN+ZLENTH ; GET LENGTH OF Z-CODE
STA I+HI ; IN WORDS
LDA ZBEGIN+ZLENTH+1 ; FIRST MSB
STA I+LO ; THEN LSB
ASL I+LO ; CONVERT Z-CODE LENGTH
ROL I+HI ; TO # BYTES
ROL K+LO ; TOP BIT IN [K+LO]
LDA #K+HI ; PATCH THE "GETBYT" ROUTINE
STA PATCH ; TO USE [K+HI]=0 INSTEAD OF [ZPURE]
VSUM: JSR GETBYT ; GET A Z-BYTE INTO [A]
CLC
ADC J+LO ; ADD IT TO SUM
STA J+LO ; IN [J]
BCC VSUM0
INC J+HI
VSUM0: LDA MPCL ; END OF Z-CODE YET?
CMP I+LO ; CHECK LSB
BNE VSUM
LDA MPCM ; MIDDLE BYTE
CMP I+HI
BNE VSUM
LDA MPCH ; AND HIGH BIT
CMP K+LO
BNE VSUM
LDA #ZPURE ; UNPATCH "GETBYT"
STA PATCH
LDA ZBEGIN+ZCHKSM+1 ; GET LSB OF CHECKSUM
CMP J+LO ; DOES IT MATCH?
BNE BADVER ; NO, PREDICATE FAILS
LDA ZBEGIN+ZCHKSM ; ELSE CHECK MSB
CMP J+HI ; LOOK GOOD?
BNE BADVER ; IF MATCHED,
JMP PREDS ; GAME IS OKAY
BADVER: JMP PREDF
END

303
acorn/ops1.asm Normal file
View File

@@ -0,0 +1,303 @@
PAGE
SBTTL "--- 1-OPS ---"
; -----
; ZERO?
; -----
; [ARG1] = 0?
ZZERO: LDA ARG1+LO
ORA ARG1+HI
BEQ PFINE
PYUCK: JMP PREDF
; -----
; NEXT?
; -----
; RETURN "NEXT" POINTER IN OBJECT [ARG1];
; FAIL IF LAST AND RETURN ZERO
ZNEXT: LDA ARG1+LO
JSR OBJLOC ; GET OBJECT ADDR INTO [I]
LDY #5 ; POINT TO "NEXT" SLOT
BNE FIRST1
; ------
; FIRST?
; ------
; RETURN "FIRST" POINTER IN OBJECT [ARG1];
; FAIL IF LAST AND RETURN ZERO
ZFIRST: LDA ARG1+LO
JSR OBJLOC ; GET OBJECT ADDR INTO [I]
LDY #6 ; POINT TO "FIRST" SLOT
FIRST1: LDA (I),Y ; GET CONTENTS OF SLOT
JSR PUTBYT ; PASS IT TO VARIABLE
LDA VALUE+LO ; EXAMINE THE VALUE JUST "PUT"
BEQ PYUCK ; FAIL IF IT WAS ZERO
PFINE: JMP PREDS ; ELSE REJOICE
; ---
; LOC
; ---
; RETURN THE OBJECT CONTAINING OBJECT [ARG1];
; RETURN ZERO IF NONE
ZLOC: LDA ARG1+LO
JSR OBJLOC ; GET ADDR OF OBJECT INTO [I]
LDY #4 ; POINT TO "LOC" SLOT
LDA (I),Y ; GET THE BYTE
JMP PUTBYT ; AND SHIP IT OUT
; ------
; PTSIZE
; ------
; RETURN LENGTH OF PROP TABLE [ARG1] IN BYTES
ZPTSIZ: LDA ARG1+HI ; MOVE ABS ADDR OF
CLC ; THE PROP TABLE
ADC ZCODE ; INTO [I]
STA I+HI
LDA ARG1+LO ; DECREMENT THE
SEC ; ADDRESS
SBC #1 ; WHILE MOVING LSB
STA I+LO
BCS PTZ0
DEC I+HI
PTZ0: LDY #0 ; GET THE LENGTH
JSR PROPL ; OF PROPERTY AT [I] INTO [A]
CLC
ADC #1 ; INCREMENT RESULT
JMP PUTBYT ; AND RETURN IT
; ---
; INC
; ---
; INCREMENT VARIABLE [ARG1]
ZINC: LDA ARG1+LO
JSR VARGET ; FETCH VARIABLE INTO [VALUE]
JSR INCVAL ; INCREMENT IT
JMP ZD0
; ---
; DEC
; ---
; DECREMENT VARIABLE [ARG1]
ZDEC: LDA ARG1+LO
JSR VARGET ; FETCH VAR INTO [VALUE]
JSR DECVAL ; DECREMENT IT
ZD0: LDA ARG1+LO ; PUT RESULT BACK
JMP VARPUT ; INTO THE SAME VARIABLE
; ------
; PRINTB
; ------
; PRINT Z-STRING AT [ARG1]
ZPRB: LDA ARG1+LO
STA I+LO
LDA ARG1+HI
STA I+HI
JSR SETWRD ; MOVE Z-ADDR TO [MPC]
JMP PZSTR ; AND PRINT
; ------
; REMOVE
; ------
; MOVE OBJECT [ARG1] INTO PSEUDO-OBJECT #0
ZREMOV: LDA ARG1+LO ; GET SOURCE OBJECT ADDR
JSR OBJLOC ; INTO [I]
LDA I+LO ; COPY THE SOURCE ADDR
STA J+LO ; INTO [J]
LDA I+HI ; FOR LATER REFERENCE
STA J+HI
LDY #4 ; POINT TO "LOC" SLOT
LDA (I),Y ; GET THE DATA
BEQ REMVEX ; SCRAM IF NO OBJECT
JSR OBJLOC ; ELSE GET ADDR OF OBJECT [A] INTO [I]
LDY #6 ; POINT TO "FIRST" SLOT
LDA (I),Y ; GRAB DATA
CMP ARG1+LO ; IS THIS THE FIRST?
BNE REMVC1 ; NO, KEEP SEARCHING
LDY #5 ; ELSE COPY SOURCE'S "NEXT" SLOT
LDA (J),Y
INY ; INTO DEST'S "FIRST" SLOT ([Y] = 6)
STA (I),Y
BNE REMVC2 ; BRANCH ALWAYS
REMVC1: JSR OBJLOC
LDY #5 ; GET "NEXT"
LDA (I),Y
CMP ARG1+LO ; FOUND IT?
BNE REMVC1 ; NO, KEEP TRYING
LDY #5 ; WHEN FOUND
LDA (J),Y ; MOVE "NEXT" SLOT OF SOURCE
STA (I),Y ; TO "NEXT" SLOT OF DEST
REMVC2: LDA #0
LDY #4 ; CLEAR "LOC"
STA (J),Y
INY ; AND "NEXT" SLOTS ([Y] = 5)
STA (J),Y ; OF SOURCE OBJECT
REMVEX: RTS
; ------
; PRINTD
; ------
; PRINT SHORT DESCRIPTION OF OBJECT [ARG1]
ZPRD: LDA ARG1+LO
; ENTRY POINT FOR "USL"
PRNTDC: JSR OBJLOC ; GET ADDR OF OBJECT INTO [I]
LDY #7 ; GET PROP TABLE POINTER
LDA (I),Y ; FETCH MSB
TAX ; SAVE IT HERE
INY
LDA (I),Y ; FETCH LSB
STA I+LO ; STORE LSB
STX I+HI ; AND MSB
INC I+LO ; POINT PAST THE
BNE PDC0 ; LENGTH BYTE
INC I+HI
PDC0: JSR SETWRD ; CALC Z-STRING ADDR
JMP PZSTR ; AND PRINT IT
; ------
; RETURN
; ------
; RETURN FROM "CALL" WITH VALUE [ARG1]
ZRET: LDA OLDZSP ; RE-SYNC THE
STA ZSP ; Z-STACK POINTER
JSR POPVAL ; POP # LOCALS INTO [X/A]
STX I+HI ; SAVE HERE
TXA ; SET FLAGS; ANY LOCALS?
BEQ RET2 ; SKIP IF NOT
; RESTORE PUSHED LOCALS
DEX ; ZERO-ALIGN
TXA ; AND
ASL A ; WORD-ALIGN # LOCALS
STA I+LO ; FOR USE AS A STORAGE INDEX
RET1: JSR POPVAL ; POP A LOCAL INTO [X/A]
LDY I+LO ; RETRIEVE STORAGE INDEX
STA LOCALS+HI,Y ; STORE MSB OF LOCAL
TXA ; MOVE LSB
STA LOCALS+LO,Y ; AND STORE THAT TOO
DEC I+LO
DEC I+LO ; UPDATE STORAGE INDEX
DEC I+HI ; AND LOCALS COUNT
BNE RET1 ; POP TILL NO MORE LOCALS
; RESTORE OTHER VARIABLES
RET2: JSR POPVAL ; POP [ZPCH] AND [ZPCM]
STX ZPCM
STA ZPCH
JSR POPVAL ; POP AND RESTORE
STX OLDZSP
STA ZPCL
LDA #0
STA ZPCFLG ; ZPC CHANGED!
JSR A12VAL ; MOVE [ARG1] TO [VALUE]
JMP PUTVAL ; AND RETURN IT
; ----
; JUMP
; ----
; JUMP TO Z-LOCATION IN [ARG1]
ZJUMP: JSR A12VAL ; MOVE [ARG1] TO [VALUE]
JMP PREDB3 ; A BRANCH THAT ALWAYS SUCCEEDS
; -----
; PRINT
; -----
; PRINT Z-STRING AT WORD POINTER [ARG1]
ZPRINT: LDA ARG1+LO
STA I+LO
LDA ARG1+HI
STA I+HI
JSR SETSTR ; CALC STRING ADDRESS
JMP PZSTR ; AND PRINT IT
; -----
; VALUE
; -----
; RETURN VALUE OF VARIABLE [ARG1]
ZVALUE: LDA ARG1+LO
JSR VARGET ; GET THE VALUE
JMP PUTVAL ; EASY ENOUGH
; ----
; BCOM
; ----
; COMPLEMENT [ARG1]
ZBCOM: LDA ARG1+LO
EOR #$FF
TAX
LDA ARG1+HI
EOR #$FF
; FALL THROUGH ...
; ---------------------
; RETURN VALUE IN [X/A]
; ---------------------
VEXIT: STX VALUE+LO
STA VALUE+HI
JMP PUTVAL
END

616
acorn/ops2.asm Normal file
View File

@@ -0,0 +1,616 @@
PAGE
SBTTL "--- 2-OPS ---"
; -----
; LESS?
; -----
; [ARG1] < [ARG2]?
ZLESS: JSR A12VAL ; MOVE [ARG1] TO [VALUE]
JMP DLS0 ; MOVE [ARG2] TO [I] & COMPARE
; ------
; DLESS?
; ------
; DECREMENT [ARG1]; SUCCEED IF < [ARG2]
ZDLESS: JSR ZDEC ; MOVES ([ARG1]-1) TO [VALUE]
DLS0: LDA ARG2+LO ; MOVE [ARG2] TO [I]
STA I+LO
LDA ARG2+HI
STA I+HI
JMP COMPAR ; COMPARE & RETURN
; -----
; GRTR?
; -----
; [ARG1] > [ARG2]?
ZGRTR: LDA ARG1+LO ; MOVE [ARG1] TO [I]
STA I+LO
LDA ARG1+HI
STA I+HI
JMP A2VAL ; MOVE [ARG2] TO [VALUE] & COMPARE
; ------
; IGRTR?
; ------
; INCREMENT [ARG1]; SUCCEED IF GREATER THAN [ARG2]
ZIGRTR: JSR ZINC ; GET ([ARG1]+1) INTO [VALUE]
LDA VALUE+LO ; MOVE [VALUE] TO [I]
STA I+LO
LDA VALUE+HI
STA I+HI
A2VAL: LDA ARG2+LO ; MOVE [ARG2] TO [VALUE]
STA VALUE+LO
LDA ARG2+HI
STA VALUE+HI
COMPAR: JSR SCOMP ; COMPARE [VALUE] AND [I]
BCC PGOOD
BCS PBAD
; -----------------
; SIGNED COMPARISON
; -----------------
; ENTRY: VALUES IN [VALUE] AND [I]
SCOMP: LDA I+HI
EOR VALUE+HI
BPL SCMP
LDA I+HI
CMP VALUE+HI
RTS
SCMP: LDA VALUE+HI
CMP I+HI
BNE SCEX
LDA VALUE+LO
CMP I+LO
SCEX: RTS
; ---
; IN?
; ---
; IS OBJECT [ARG1] CONTAINED IN OBJECT [ARG2]?
ZIN: LDA ARG1+LO
JSR OBJLOC ; GET ADDR OF TARGET OBJECT INTO [I]
LDY #4 ; POINT TO "LOC" SLOT
LDA (I),Y ; GET DATA
CMP ARG2+LO ; IS IT THERE?
BEQ PGOOD ; YES, SUCCEED
PBAD: JMP PREDF ; TOO BAD, CHUM ...
; ----
; BTST
; ----
; IS EVERY "ON" BIT IN [ARG1]
; ALSO "ON" IN [ARG2]?
ZBTST: LDA ARG2+LO ; FIRST CHECK LSBS
AND ARG1+LO
CMP ARG2+LO ; LSBS MATCH?
BNE PBAD ; NO, EXIT NOW
LDA ARG2+HI ; ELSE CHECK MSBS
AND ARG1+HI
CMP ARG2+HI ; MATCHED?
BNE PBAD ; SORRY ...
PGOOD: JMP PREDS
; ---
; BOR
; ---
; RETURN [ARG1] "OR" [ARG2]
ZBOR: LDA ARG1+LO
ORA ARG2+LO
TAX
LDA ARG1+HI
ORA ARG2+HI
JMP VEXIT
; ----
; BAND
; ----
; RETURN [ARG1] "AND" [ARG2]
ZBAND: LDA ARG1+LO
AND ARG2+LO
TAX
LDA ARG1+HI
AND ARG2+HI
JMP VEXIT
; -----
; FSET?
; -----
; IS FLAG [ARG1] SET IN OBJECT [ARG2]?
ZFSETP: JSR FLAGSU ; GET BITS INTO [K] AND [J]
LDA K+HI ; DO MSBS
AND J+HI
STA K+HI
LDA K+LO ; DO LSBS
AND J+LO
ORA K+HI ; ANY BITS ON?
BNE PGOOD ; TARGET BIT MUST BE ON
JMP PREDF
; ----
; FSET
; ----
; SET FLAG [ARG2] IN OBJECT [ARG1]
ZFSET: JSR FLAGSU ; GET BITS INTO [K] & [J], ADDR IN [I]
LDY #0
LDA K+HI ; FIRST DO MSBS
ORA J+HI
STA (I),Y
INY
LDA K+LO ; THEN LSBS
ORA J+LO
STA (I),Y
RTS
; ------
; FCLEAR
; ------
; CLEAR FLAG [ARG2] IN OBJECT [ARG1]
ZFCLR: JSR FLAGSU ; GETS BITS INTO [J] & [K], ADDR IN [I]
LDY #0
LDA J+HI ; FETCH MSB
EOR #$FF ; COMPLEMENT IT
AND K+HI ; RUB OUT FLAG
STA (I),Y
INY
LDA J+LO ; SAME FOR LSB
EOR #$FF
AND K+LO
STA (I),Y
RTS
; ---
; SET
; ---
; SET VARIABLE [ARG1] EQUAL TO [ARG2]
ZSET: LDA ARG2+LO ; MOVE THE VALUE
STA VALUE+LO ; INTO [VALUE]
LDA ARG2+HI
STA VALUE+HI
LDA ARG1+LO ; GET VARIABLE ID
JMP VARPUT ; AND CHANGE THE VARIABLE
; ----
; MOVE
; ----
; MOVE OBJECT [ARG1] INTO OBJECT [ARG2]
ZMOVE: JSR ZREMOV ; REMOVE FIRST
LDA ARG1+LO
JSR OBJLOC ; GET SOURCE OBJECT ADDR INTO [I]
LDA I+LO ; COPY SOURCE ADDRESS
STA J+LO ; INTO [J]
LDA I+HI
STA J+HI
LDA ARG2+LO ; GET DEST OBJECT ID
LDY #4 ; POINT TO "LOC" SLOT OF SOURCE
STA (I),Y ; AND MOVE IT IN
JSR OBJLOC ; GET ADDR OF DEST OBJECT INTO [I]
LDY #6 ; POINT TO "FIRST" SLOT
LDA (I),Y ; GET "FIRST" OF DEST
TAX ; SAVE HERE FOR A MOMENT
LDA ARG1+LO ; GET SOURCE OBJECT ID
STA (I),Y ; MAKE IT "FIRST" OF DEST
TXA ; RESTORE "FIRST" OF DEST
BEQ ZMVEX ; SCRAM IF ZERO
LDY #5 ; MAKE "FIRST" OF DEST
STA (J),Y ; THE "NEXT" OF SOURCE
ZMVEX: RTS
; ---
; GET
; ---
; RETURN ITEM [ARG2] IN WORD-TABLE [ARG1]
ZGET: JSR WCALC ; CALC ADDRESS
JSR GETBYT ; GET 1ST BYTE (MSB)
DOGET: STA VALUE+HI ; SAVE MSB
JSR GETBYT ; GET LSB
STA VALUE+LO ; SAVE AND
JMP PUTVAL ; HAND IT OVER
; ----
; GETB
; ----
; RETURN ITEM [ARG2] IN BYTE-TABLE AT [ARG1]
ZGETB: JSR BCALC
BEQ DOGET ; [A] = 0, SO CLEAR MSB OF [VALUE]
; --------------------
; CALC TABLE ADDRESSES
; --------------------
; WORD-ALIGNED ENTRY
WCALC: ASL ARG2+LO ; WORD-ALIGN FOR
ROL ARG2+HI ; WORD ACCESS
; BYTE-ALIGNED ENTRY
BCALC: LDA ARG2+LO ; ADD BASE ADDR OF TABLE
CLC ; TO ITEM
ADC ARG1+LO ; INDEX
STA MPCL
LDA ARG2+HI ; SAME FOR MSBS
ADC ARG1+HI
STA MPCM
LDA #0
STA MPCH ; CLEAR TOP BIT
STA MPCFLG ; & INVALIDATE [MPC]
RTS
; ----
; GETP
; ----
; RETURN PROPERTY [ARG2] OF OBJECT [ARG1];
; IF NO PROP [ARG2], RETURN [ARG2]'TH ELEMENT OF OBJECT #0
ZGETP: JSR PROPB
GETP1: JSR PROPN
CMP ARG2+LO
BEQ GETP3
BCC GETP2
JSR PROPNX
JMP GETP1 ; TRY AGAIN WITH NEXT PROP
GETP2: LDA ARG2+LO ; GET PROPERTY #
SEC ; ZERO-ALIGN IT
SBC #1
ASL A ; WORD-ALIGN IT
TAY ; USE AS AN INDEX
LDA (OBJTAB),Y ; GET MSB OF PROPERTY
STA VALUE+HI
INY
LDA (OBJTAB),Y ; DO SAME WITH LSB
STA VALUE+LO
JMP PUTVAL ; RETURN DEFAULT IN [VALUE]
GETP3: JSR PROPL
INY ; MAKE [Y] POINT TO 1ST BYTE OF PROP
TAX ; (SET FLAGS) IF LENGTH IN [A] = 0
BEQ GETPB ; GET A BYTE PROPERTY
CMP #1 ; IF LENGTH = 1
BEQ GETPW ; GET A WORD PROPERTY
; *** ERROR #7: PROPERTY LENGTH ***
LDA #7
JMP ZERROR
; GET A 1-BYTE PROPERTY
GETPB: LDA (I),Y ; GET LSB INTO [A]
LDX #0 ; CLEAR MSB IN [X]
BEQ ETPEX
; GET A 2-BYTE PROPERTY
GETPW: LDA (I),Y ; GET MSB
TAX ; INTO [X]
INY ; POINT TO LSB
LDA (I),Y ; GET IT INTO [A]
ETPEX: STA VALUE+LO ; STORE LSB
STX VALUE+HI ; AND MSB
JMP PUTVAL
; -----
; GETPT
; -----
; RETURN POINTER TO PROP TABLE [ARG2]
; IN OBJECT [ARG1]
ZGETPT: JSR PROPB
GETPT1: JSR PROPN ; RETURNS OFFSET IN [Y]
CMP ARG2+LO
BEQ GETPT2
BCC DORET
JSR PROPNX ; TRY NEXT PROPERTY
JMP GETPT1
GETPT2: INC I+LO
BNE GETPT3
INC I+HI
GETPT3: TYA ; FETCH OFFSET
CLC
ADC I+LO ; ADD LSB OF TABLE ADDRESS
STA VALUE+LO
LDA I+HI ; AND MSB
ADC #0
SEC ; STRIP OFF
SBC ZCODE ; RELATIVE POINTER
STA VALUE+HI
JMP PUTVAL ; AND RETURN
DORET: JMP RET0 ; ELSE RETURN A ZERO
; -----
; NEXTP
; -----
; RETURN INDEX # OF PROP FOLLOWING PROP [ARG2] IN OBJECT [ARG1];
; RETURN ZERO IF LAST; RETURN FIRST IF [ARG2]=0; ERROR IF NONE
ZNEXTP: JSR PROPB
LDA ARG2+LO ; IF [ARG2]=0
BEQ NXTP3 ; RETURN "FIRST" SLOT
NXTP1: JSR PROPN ; FETCH PROPERTY #
CMP ARG2+LO ; COMPARE TO TARGET #
BEQ NXTP2 ; FOUND IT!
BCC DORET ; LAST PROP, SO RETURN ZERO
JSR PROPNX ; ELSE TRY NEXT PROPERTY
JMP NXTP1
NXTP2: JSR PROPNX ; POINT TO FOLLOWING PROPERTY
NXTP3: JSR PROPN ; GET THE PROPERTY #
JMP PUTBYT ; AND RETURN IT
; ---
; ADD
; ---
; RETURN [ARG1] + [ARG2]
ZADD: LDA ARG1+LO ; ADD LSBS
CLC
ADC ARG2+LO
TAX ; SAVE LSB HERE
LDA ARG1+HI ; ADD MSBS
ADC ARG2+HI
JMP VEXIT
; ---
; SUB
; ---
; RETURN [ARG1] - [ARG2]
ZSUB: LDA ARG1+LO ; SUBTRACT LSBS
SEC
SBC ARG2+LO
TAX ; SAVE LSB HERE
LDA ARG1+HI ; SUBTRACT MSBS
SBC ARG2+HI
JMP VEXIT ; EXIT WITH [X]=LSB, [A]=MSB
; ---
; MUL
; ---
; RETURN [ARG1] * [ARG2]
ZMUL: JSR MINIT ; INIT THINGS
ZMLOOP: ROR MTEMP+HI
ROR MTEMP+LO
ROR ARG2+HI
ROR ARG2+LO
BCC ZMNEXT
LDA ARG1+LO
CLC
ADC MTEMP+LO
STA MTEMP+LO
LDA ARG1+HI
ADC MTEMP+HI
STA MTEMP+HI
ZMNEXT: DEX
BPL ZMLOOP
LDX ARG2+LO ; PUT LSB OF PRODUCT
LDA ARG2+HI ; AND MSB
JMP VEXIT ; WHERE "VEXIT" EXPECTS THEM
; ---
; DIV
; ---
; RETURN QUOTIENT OF [ARG1] / [ARG2]
ZDIV: JSR DIVIDE
LDX QUOT+LO
LDA QUOT+HI
JMP VEXIT
; ---
; MOD
; ---
; RETURN REMAINDER OF [ARG1] / [ARG2]
ZMOD: JSR DIVIDE
LDX REMAIN+LO ; FETCH THE REMAINDER
LDA REMAIN+HI ; IN [REMAIN]
JMP VEXIT ; AND RETURN IT
; ---------------
; SIGNED DIVISION
; ---------------
; ENTRY: DIVIDEND IN [ARG1], DIVISOR IN [ARG2]
; EXIT: QUOTIENT IN [QUOT], REMAINDER IN [REMAIN]
DIVIDE: LDA ARG1+HI ; SIGN OF REMAINDER
STA RSIGN ; IS THE SIGN OF THE DIVIDEND
EOR ARG2+HI ; SIGN OF QUOTIENT IS POSITIVE
STA QSIGN ; IF SIGNS OF TERMS ARE THE SAME
LDA ARG1+LO ; MOVE [ARG1] TO [QUOT]
STA QUOT+LO
LDA ARG1+HI
STA QUOT+HI ; IF DIVIDEND IS POSITIVE
BPL ABSDIV ; MOVE DIVISOR
JSR ABQUOT ; ELSE CALC ABS(DIVIDEND) FIRST
ABSDIV: LDA ARG2+LO
STA REMAIN+LO
LDA ARG2+HI
STA REMAIN+HI ; IF REMAINDER IS POSITIVE
BPL GODIV ; WE'RE READY TO DIVIDE
JSR ABREM ; ELSE CALC ABS(DIVISOR)
GODIV: JSR UDIV ; DO UNSIGNED DIVIDE
LDA QSIGN ; SHOULD QUOTIENT BE FLIPPED?
BPL RFLIP ; NO, TEST REMAINDER
JSR ABQUOT ; ELSE GET ABSOLUTE VALUE
RFLIP: LDA RSIGN ; SHOULD EMAINDER BE FLIPPED?
BPL DIVEX ; NO, WE'RE DONE
; ELSE FALL THROUGH ...
; ----------------
; CALC ABS(REMAIN)
; ----------------
ABREM: LDA #0
SEC
SBC REMAIN+LO
STA REMAIN+LO
LDA #0
SBC REMAIN+HI
STA REMAIN+HI
DIVEX: RTS
; --------------
; CALC ABS(QUOT)
; --------------
ABQUOT: LDA #0
SEC
SBC QUOT+LO
STA QUOT+LO
LDA #0
SBC QUOT+HI
STA QUOT+HI
RTS
; -----------------
; UNSIGNED DIVISION
; -----------------
; ENTRY: DIVIDEND IN [QUOT], DIVISOR IN [REMAIN]
; EXIT: QUOTIENT IN [QUOT], REMAINDER IN [REMAIN]
UDIV: LDA REMAIN+LO ; CHECK [REMAIN]
ORA REMAIN+HI ; BEFORE PROCEEDING
BEQ DIVERR ; CAN'T DIVIDE BY ZERO!
JSR MINIT ; SET IT ALL UP
UDLOOP: ROL QUOT+LO
ROL QUOT+HI
ROL MTEMP+LO
ROL MTEMP+HI
LDA MTEMP+LO
SEC
SBC REMAIN+LO
TAY ; SAVE HERE
LDA MTEMP+HI
SBC REMAIN+HI
BCC UDNEXT
STY MTEMP+LO
STA MTEMP+HI
UDNEXT: DEX
BNE UDLOOP
ROL QUOT+LO ; SHIFT LAST CARRY FOR QUOTIENT
ROL QUOT+HI
LDA MTEMP+LO ; MOVE REMAINDER
STA REMAIN+LO ; INTO [REMAIN]
LDA MTEMP+HI
STA REMAIN+HI
RTS
; *** ERROR #8: DIVISION BY ZERO ***
DIVERR: LDA #8
JMP ZERROR
; ---------
; MATH INIT
; ---------
MINIT: LDX #16 ; INIT LOOPING INDEX
LDA #0
STA MTEMP+LO ; CLEAR TEMP
STA MTEMP+HI ; REGISTER
CLC ; AND CARRY
RTS
END

348
acorn/opsx.asm Normal file
View File

@@ -0,0 +1,348 @@
PAGE
SBTTL "--- X-OPS ---"
; ------
; EQUAL?
; ------
; IS [ARG1] = [ARG2] (OR [ARG3] OR [ARG4])?
ZEQUAL: DEC NARGS ; DOUBLE-CHECK # ARGS
BNE DOEQ ; MUST BE AT LEAST TWO, OR ...
; *** ERROR #9: NOT ENOUGH "EQUAL?" ARGS ***
LDA #9
JMP ZERROR
DOEQ: LDA ARG1+LO ; FETCH LSB
LDX ARG1+HI ; AND MSB OF [ARG1]
CMP ARG2+LO ; TEST LSB OF [ARG2]
BNE TRY2 ; NO GOOD, LOOK FOR ANOTHER ARG
CPX ARG2+HI ; ELSE TRY MSB OF [ARG2]
BEQ EQOK ; MATCHED!
TRY2: DEC NARGS ; OUT OF ARGS YET?
BEQ EQBAD ; YES, WE FAILED
CMP ARG3+LO ; TRY LSB OF [ARG3]
BNE TRY3 ; NO GOOD, LOOK FOR ANOTHER ARG
CPX ARG3+HI ; HOW ABOUT MSB OF [ARG3]?
BEQ EQOK ; YAY!
TRY3: DEC NARGS ; OUT OF ARGS YET?
BEQ EQBAD ; IF NOT ...
CMP ARG4+LO ; TRY [ARG4]
BNE EQBAD ; SORRY, CHUM
CPX ARG4+HI ; MSB MATCHED?
BNE EQBAD ; TOO BAD
EQOK: JMP PREDS ; FINALLY MATCHED!
EQBAD: JMP PREDF ; FAILURE (SNIFF!)
; ----
; CALL
; ----
; BRANCH TO FUNCTION AT ([ARG1]*2), PASSING
; OPTIONAL PARAMETERS IN [ARG2]-[ARG4]
ZCALL: LDA ARG1+LO
ORA ARG1+HI ; IS CALL ADDRESS ZERO?
BNE DOCALL ; NO, CONTINUE
JMP PUTBYT ; ELSE RETURN THE ZERO IN [A]
DOCALL: LDX OLDZSP ; SAVE OLD STACK POINTER
LDA ZPCL ; AND LSB OF [ZPC]
JSR PUSHXA ; ON THE Z-STACK
LDX ZPCM ; SAVE MIDDLE 8 BITS
LDA ZPCH ; AND TOP BIT OF [ZPC]
JSR PUSHXA ; AS WELL
; FORM 16-BIT ADDRESS FROM [ARG1]
LDA #0 ; CLEAR HIGH BIT FOR ROTATE
STA ZPCFLG ; AND INVALIDATE [ZPC]
ASL ARG1+LO ; MULTIPLY [ARG1]
ROL ARG1+HI ; BY TWO
ROL A ; HIGH BIT INTO [A]
STA ZPCH ; NEW HIGH BIT OF [ZPC]
LDA ARG1+HI ; GET NEW LOW BYTES
STA ZPCM
LDA ARG1+LO
STA ZPCL
JSR NEXTPC ; FETCH # LOCALS TO PASS
STA J+LO ; SAVE HERE FOR COUNTING
STA J+HI ; AND HERE FOR LATER REFERENCE
BEQ ZCALL2 ; SKIP IF NO LOCALS
LDA #0
STA I+LO ; ELSE INIT STORAGE INDEX
ZCALL1: LDY I+LO
LDX LOCALS+LO,Y ; GET LSB OF LOCAL INTO [X]
LDA LOCALS+HI,Y ; AND MSB INTO [A]
STY I+LO ; SAVE THE INDEX
JSR PUSHXA ; PUSH LOCAL IN [X/A] ONTO Z-STACK
JSR NEXTPC ; GET MSB OF NEW LOCAL
STA I+HI ; SAVE IT HERE
JSR NEXTPC ; NOW GET LSB
LDY I+LO ; RESTORE INDEX
STA LOCALS+LO,Y ; STORE LSB INTO [LOCALS]
LDA I+HI ; RETRIEVE MSB
STA LOCALS+HI,Y ; STORE IT INTO [LOCALS]
INY
INY ; UPDATE
STY I+LO ; THE STORAGE INDEX
DEC J+LO ; ANY MORE LOCALS?
BNE ZCALL1 ; YES, KEEP LOOPING
; MOVE UP TO 3 ARGUMENTS TO [LOCALS]
ZCALL2: DEC NARGS ; EXTRA ARGS IN THIS CALL?
BEQ ZCALL3 ; NO, CONTINUE
LDA ARG2+LO ; MOVE [ARG2] TO LOCAL #1
STA LOCALS+LO
LDA ARG2+HI
STA LOCALS+HI
DEC NARGS ; ANY LEFT?
BEQ ZCALL3 ; NO, SCRAM
LDA ARG3+LO ; MOVE [ARG3] TO LOCAL #2
STA LOCALS+LO+2
LDA ARG3+HI
STA LOCALS+HI+2
DEC NARGS ; ANY LEFT?
BEQ ZCALL3 ; NO, EXUENT
LDA ARG4+LO ; MOVE [ARG4] TO LOCAL #3
STA LOCALS+LO+4
LDA ARG4+HI
STA LOCALS+HI+4
ZCALL3: LDX J+HI ; RETRIEVE # LOCALS
TXA ; DUPE FOR NO GOOD REASON
JSR PUSHXA ; PUSH # LOCALS ONTO Z-STACK
LDA ZSP ; REMEMBER WHERE
STA OLDZSP ; WE CAME FROM
RTS ; WHEW!
; ---
; PUT
; ---
; SET ITEM [ARG2] IN WORD-TABLE [ARG1] EQUAL TO [ARG3]
ZPUT: ASL ARG2+LO ; WORD-ALIGN [ARG2]
ROL ARG2+HI
JSR PCALC ; GET ITEM ADDR INTO [I]
LDA ARG3+HI ; STORE MSB OF [ARG3]
STA (I),Y ; INTO MSB OF TABLE POSITION
INY ; POINT TO LSB
BNE PUTLSB ; BRANCH ALWAYS
; ----
; PUTB
; ----
; SET ITEM [ARG2] IN BYTE-TABLE [ARG1] EQUAL TO [ARG3]
ZPUTB: JSR PCALC
; ENTRY FOR "PUT"
PUTLSB: LDA ARG3+LO ; GET LSB OF [ARG3]
STA (I),Y ; STORE IN TABLE AT [Y]
RTS
; ---------------------------
; CALC ITEM ADDRESS FOR "PUT"
; ---------------------------
PCALC: LDA ARG2+LO ; ADD ITEM OFFSET IN [ARG2]
CLC ; TO TABLE ADDR IN [ARG1]
ADC ARG1+LO ; TO FORM A POINTER
STA I+LO ; IN [I]
LDA ARG2+HI ; SAME FOR MSB
ADC ARG1+HI
CLC
ADC ZCODE ; MAKE IT ABSOLUTE
STA I+HI
LDY #0 ; ZERO FOR INDEXING
RTS
; ----
; PUTP
; ----
; SET PROPERTY [ARG2] IN OBJECT [ARG1] EQUAL TO [ARG3]
ZPUTP: JSR PROPB
PUTP1: JSR PROPN
CMP ARG2+LO
BEQ PUTP2
BCC PNERR ; ERROR IF LOWER
JSR PROPNX ; TRY NEXT PROPERTY
JMP PUTP1
PUTP2: JSR PROPL
INY ; MAKE [Y] POINT TO 1ST PROPERTY BYTE
TAX ; (SET FLAGS) IF LENGTH IN [A] = 0
BEQ PUTP3 ; PUT A BYTE
CMP #1 ; PUT A WORD IF [A] = 1
BNE PLERR ; ELSE LENGTH IS BAD
LDA ARG3+HI ; GET MSB OF PROPERTY
STA (I),Y ; AND STORE IN OBJECT
INY ; POINT TO LSB SLOT
PUTP3: LDA ARG3+LO ; FETCH LSB
STA (I),Y ; AND STORE IN OBJECT
RTS
; *** ERROR #10: BAD PROPERTY NUMBER ***
PNERR: LDA #10
JMP ZERROR
; *** ERROR #11: PUTP PROPERTY LENGTH ***
PLERR: LDA #11
JMP ZERROR
; ------
; PRINTC
; ------
; PRINT CHAR WITH ASCII VALUE IN [ARG1]
ZPRC: LDA ARG1+LO ; GRAB THE CHAR
JMP COUT ; AND SHIP IT OUT
; ------
; PRINTN
; ------
; PRINT VALUE OF [ARG1] AS A SIGNED INTEGER
ZPRN: LDA ARG1+LO ; MOVE [ARG1] TO [QUOT]
STA QUOT+LO
LDA ARG1+HI
STA QUOT+HI
; PRINT [QUOT]
NUMBER: LDA QUOT+HI ; IF VALUE IS POSITIVE
BPL DIGCNT ; CONTINUE
LDA #$2D ; ELSE START WITH A MINUS SIGN
JSR COUT
JSR ABQUOT ; AND CALC ABS([QUOT])
; COUNT # OF DECIMAL DIGITS
DIGCNT: LDA #0 ; RESET
STA DIGITS ; DIGIT INDEX
DGC: LDA QUOT+LO ; IS QUOTIENT
ORA QUOT+HI ; ZERO YET?
BEQ PRNTN3 ; YES, READY TO PRINT
LDA #10 ; ELSE DIVIDE [QUOT]
STA REMAIN+LO ; BY 10 (LSB)
LDA #0
STA REMAIN+HI ; 10 (MSB)
JSR UDIV ; UNSIGNED DIVIDE
LDA REMAIN+LO ; FETCH LSB OF REMAINDER (THE DIGIT)
PHA ; SAVE IT ON STACK
INC DIGITS ; UPDATE DIGIT COUNT
BNE DGC ; LOOP TILL QUOTIENT=0
PRNTN3: LDA DIGITS ; IF DIGIT COUNT IS NZ
BNE PRNTN4 ; CONTINUE
LDA #'0' ; ELSE PRINT "0"
JMP COUT ; AND RETURN
PRNTN4: PLA ; PULL A DIGIT OFF THE STACK
CLC
ADC #'0' ; CONVERT TO ASCII
JSR COUT ; AND PRINT IT
DEC DIGITS ; OUT OF DIGITS YET?
BNE PRNTN4 ; NO, KEEP LOOPING
RTS
; ------
; RANDOM
; ------
; RETURN A RANDOM VALUE BETWEEN 0 AND [ARG1]
ZRAND: LDA ARG1+LO ; MAKE [ARG1] THE DIVISOR
STA ARG2+LO
LDA ARG1+HI
STA ARG2+HI
JSR RANDOM ; GET RANDOM BYTES INTO [A] AND [X]
STX ARG1+LO ; MAKE THEM THE DIVIDEND
AND #$7F ; MAKE SURE MSB IS POSITIVE
STA ARG1+HI
JSR DIVIDE ; SIGNED DIVIDE, [ARG1] / [ARG2]
LDA REMAIN+LO ; MOVE REMAINDER
STA VALUE+LO ; INTO [VALUE]
LDA REMAIN+HI
STA VALUE+HI
JSR INCVAL ; INCREMENT [VALUE]
JMP PUTVAL ; AND RETURN RESULT
; ----
; PUSH
; ----
; PUSH [ARG1] ONTO THE Z-STACK
ZPUSH: LDX ARG1+LO
LDA ARG1+HI
JMP PUSHXA
; ---
; POP
; ---
; POP WORD OFF Z-STACK, STORE IN VARIABLE [ARG1]
ZPOP: JSR POPVAL ; VALUE INTO [VALUE]
LDA ARG1+LO ; GET VARIABLE ID
JMP VARPUT ; AND CHANGE THE VARIABLE
END

205
acorn/paging.asm Normal file
View File

@@ -0,0 +1,205 @@
PAGE
SBTTL "--- PAGING ROUTINES ---"
; -------------------------
; FETCH NEXT BYTE OF Z-CODE
; -------------------------
; EXIT: BYTE AT [ZPC] IN [A] & [Y], FLAGS SET
NEXTPC: LDA ZPCFLG ; HAS PAGE CHANGED?
BEQ NEWZ ; APPARENTLY SO
NPC: LDY ZPCL
LDA (ZPCPNT),Y ; GRAB A Z-BYTE
IF DEBUG
STA MBYTE
LDA #1 ; BREAKPOINT #1
JSR DOBUG
LDA MBYTE
ENDIF
INC ZPCL
BNE NXTX
LDY #0
STY ZPCFLG
INC ZPCM ; POINT [ZPC] TO NEXT PAGE
BNE NXTX
INC ZPCH
NXTX: TAY ; SET FLAGS
RTS
; --------------
; SWITCH Z-PAGES
; --------------
NEWZ: LDA ZPCM ; GET LSB OF TARGET INTO [A]
LDY ZPCH ; AND MSB INTO [Y]
BNE NZ0 ; SWAP IF MSB <> 0
CMP ZPURE ; IS PAGE IN PRELOAD?
BCS NZ0 ; NO, SWAP IT IN
ADC ZCODE ; ELSE CALC ABSOLUTE PAGE
BNE NZ1 ; AND GIVE IT TO [ZPCPNT]
NZ0: LDX #0
STX MPCFLG ; INVALIDATE [MPC]
JSR PAGE ; LOCATE PAGE [A/Y] IN SWAPPING SPACE
NZ1: STA ZPCPNT+HI ; AND UPDATE MSB OF POINTER
LDX #$FF
STX ZPCFLG ; VALIDATE [ZPC]
INX ; (= 0) CLEAR LSB
STX ZPCPNT+LO ; OF [ZPCPNT]
BEQ NPC ; GET THE BYTE
; -------------------------------
; GET NEXT BYTE OF VIRTUAL MEMORY
; -------------------------------
; EXIT: BYTE AT [MPC] IN [A] & [Y], FLAGS SET
GETBYT: LDA MPCFLG ; [MPC] VALID?
BEQ NEWM ; NO, SWITCH PAGES
GTB: LDY MPCL ; GRAB NEXT BYTE
LDA (MPCPNT),Y
IF DEBUG
STA MBYTE
LDA #2 ; BREAKPOINT #2
JSR DOBUG
LDA MBYTE
ENDIF
INC MPCL ; END OF THIS PAGE?
BNE NXMX ; NO, CONTINUE
LDY #0 ; ELSE INVALIDATE
STY MPCFLG ; [MPC]
INC MPCM ; POINT [MPC] TO
BNE NXMX ; NEXT PAGE
INC MPCH
NXMX: TAY ; SET FLAGS
RTS
; --------------
; SWITCH M-PAGES
; --------------
NEWM: LDA MPCM ; GET LSB AND
LDY MPCH ; MSB OF TARGET PAGE
BNE NM0 ; SWAP IF MSB <> 0
PATCH EQU $+1 ; PATCH POINT FOR "VERIFY"
CMP ZPURE ; TARGET IN PRELOAD?
BCS NM0 ; NO, SWAP IT IN
ADC ZCODE ; ELSE MAKE IT ABSOLUTE
BNE NM1 ; AND GIVE TO [MPCPNT]
NM0: LDX #0
STX ZPCFLG ; INVALIDATE [ZPC]
JSR PAGE ; GET PAGE OF TARGET BLOCK IN [A/Y]
NM1: STA MPCPNT+HI ; SET MSB OF POINTER
LDX #$FF
STX MPCFLG ; [MPC] IS NOW VALID
INX ; CLEAR LSB
STX MPCPNT+LO ; OF [MPCPNT]
BEQ GTB
; -------------------------------
; LOCATE A PAGE OF VIRTUAL MEMORY
; -------------------------------
; ENTRY: TARGET PAGE IN [A/Y] (LSB/MSB)
; EXIT: ABSOLUTE PAGE ADDRESS IN [A]
PAGE: STA TARGET+LO ; SAVE THE
STY TARGET+HI ; TARGET PAGE FOR REFERENCE
LDX #0 ; INIT INDEX
STX ZPAGE ; KEEP A RUNNING TALLY
PG1: CMP PTABL,X ; SEARCH FOR LSB IN [A]
BEQ PG3 ; IF FOUND, CHECK MSB
PG2: INC ZPAGE ; UPDATE TALLY
INX
CPX PMAX ; OUT OF PAGING SPACE?
BCC PG1 ; NO, KEEP LOOKING
BCS SWAP ; ELSE PAGE MUST BE SWAPPED IN
PG3: TYA ; GET MSB OF TARGET
CMP PTABH,X ; MATCHED?
BEQ PFOUND ; YES, PAGE IS IN [ZPAGE]
LDA TARGET+LO ; ELSE RESTORE LSB OF TARGET
JMP PG2 ; AND RESUME SEARCH
; SWAP IN TARGET PAGE IN [TARGET]
SWAP: LDX LRU ; SPLICE THE
LDA TARGET+LO ; TARGET PAGE
STA PTABL,X ; INTO THE PAGING TABLES
STA DBLOCK+LO ; AND GIVE IT TO ZDOS
LDA TARGET+HI ; SAME FOR MSB
STA PTABH,X
STA DBLOCK+HI
TXA
STA ZPAGE ; SAVE FOR "PFOUND"
CLC
ADC PAGE0 ; MAKE IT ABSOLUTE
STA DBUFF+HI ; GIVE PAGE ADDRESS TO ZDOS
JSR GETDSK ; GET BLOCK INTO SWAPPING SPACE
INC LRU ; UPDATE PAGE POINTER
LDA LRU
CMP PMAX ; TOP OF PAGING SPACE?
BCC PFOUND ; NO, EXIT
LDA #0
STA LRU ; ELSE RESET POINTER
PFOUND: LDA ZPAGE ; GET SWAPPING PAGE INDEX
CLC
ADC PAGE0 ; MAKE IT ABSOLUTE
RTS ; AND RETURN IT IN [A]
; -------------------------
; POINT [MPC] TO V-ADDR [I]
; -------------------------
SETWRD: LDA I+LO
STA MPCL
LDA I+HI
STA MPCM
LDA #0
STA MPCH ; ZERO TOP BIT
STA MPCFLG ; INVALIDATE [MPC]
RTS
; ----------------------------
; GET Z-WORD AT [MPC] INTO [I]
; ----------------------------
GETWRD: JSR GETBYT
STA I+HI
JSR GETBYT
STA I+LO
RTS
END

304
acorn/read.asm Normal file
View File

@@ -0,0 +1,304 @@
PAGE
SBTTL "--- READ HANDLER ---"
; ----
; READ
; ----
; READ LINE INTO TABLE [ARG1]; PARSE INTO TABLE [ARG2]
ZREAD: JSR ZUSL ; UPDATE THE STATUS LINE
LDA ARG1+HI ; MAKE THE TABLE ADDRESSES
CLC ; ABSOLUTE
ADC ZCODE ; LSBS NEED NOT CHANGE
STA ARG1+HI
LDA ARG2+HI
CLC
ADC ZCODE
STA ARG2+HI
JSR INPUT ; READ LINE; RETURN LENGTH IN [A]
STA LINLEN ; SAVE # CHARS IN LINE
LDA #0
STA WRDLEN ; INIT # CHARS IN WORD COUNTER
LDY #1 ; POINT TO "# WORDS READ" SLOT
STA (ARG2),Y ; AND CLEAR IT ([A] = 0)
STY SOURCE ; INIT SOURCE TABLE PNTR ([Y] = 1)
INY ; = 2
STY RESULT ; AND RESULT TABLE POINTER
; MAIN LOOP STARTS HERE
READL: LDY #0 ; POINT TO "MAX WORDS" SLOT
LDA (ARG2),Y ; AND READ IT
INY ; POINT TO "# WORDS READ" SLOT
CMP (ARG2),Y ; TOO MANY WORDS?
BCS RL1 ; NOT YET
; *** ERROR #13: PARSER OVERFLOW ***
LDA #13
JMP ZERROR
RL1: LDA LINLEN
ORA WRDLEN ; OUT OF CHARS AND WORDS?
BNE RL2 ; NOT YET
RLEX: RTS ; ELSE EXIT
RL2: LDA WRDLEN ; GET WORD LENGTH
CMP #6 ; 6 CHARS DONE?
BCC RL3 ; NO, KEEP GOING
JSR FLUSHW ; ELSE FLUSH REMAINDER OF WORD
RL3: LDA WRDLEN ; GET WORD LENGTH AGAIN
BNE READL2 ; CONTINUE IF NOT FIRST CHAR
; START A NEW WORD
LDX #5 ; CLEAR Z-WORD INPUT BUFFER
RLL: STA IN,X ; [A] = 0
DEX
BPL RLL
JSR EFIND ; GET BASE ADDRESS INTO [ENTRY]
LDA SOURCE ; STORE THE START POS OF THE WORD
LDY #3 ; INTO THE "WORD START" SLOT
STA (ENTRY),Y ; OF THE RESULT TABLE
TAY
LDA (ARG1),Y ; GET A CHAR FROM SOURCE BUFFER
JSR SIB ; IS IT A SELF-INSERTING BREAK?
BCS DOSIB ; YES IF CARRY WAS SET
JSR NORM ; IS IT A "NORMAL" BREAK?
BCC READL2 ; NO, CONTINUE
INC SOURCE ; ELSE FLUSH THE STRANDED BREAK
DEC LINLEN ; UPDATE # CHARS LEFT IN LINE
JMP READL ; AND LOOP
READL2: LDA LINLEN ; OUT OF CHARS YET?
BEQ READL3 ; LOOKS THAT WAY
LDY SOURCE
LDA (ARG1),Y ; ELSE GRAB NEXT CHAR
JSR BREAK ; IS IT A BREAK?
BCS READL3 ; YES IF CARRY WAS SET
LDX WRDLEN ; ELSE STORE THE CHAR
STA IN,X ; INTO THE INPUT BUFFER
DEC LINLEN ; ONE LESS CHAR IN LINE
INC WRDLEN ; ONE MORE IN WORD
INC SOURCE ; POINT TO NEXT CHAR IN SOURCE
JMP READL ; AND LOOP BACK
DOSIB: STA IN ; PUT THE BREAK INTO 1ST WORD SLOT
DEC LINLEN ; ONE LESS CHAR IN LINE
INC WRDLEN ; ONE MORE IN WORD BUFFER
INC SOURCE ; POINT TO NEXT SOURCE CHAR
READL3: LDA WRDLEN ; ANY CHARS IN WORD YET?
BEQ READL ; APPARENTLY NOT, SO LOOP BACK
JSR EFIND ; GET ENTRY ADDR INTO [ENTRY]
LDA WRDLEN ; GET ACTUAL LNGTH OF WORD
LDY #2 ; STORE IT IN "WORD LENGTH" SLOT
STA (ENTRY),Y ; OF THE CURRENT ENTRY
JSR CONZST ; CONVERT ASCII IN [IN] TO Z-STRING
JSR FINDW ; AND LOOK IT UP IN VOCABULARY
LDY #1
LDA (ARG2),Y ; FETCH THE # WORDS READ
CLC
ADC #1 ; INCREMENT IT
STA (ARG2),Y ; AND UPDATE
JSR EFIND ; MAKE [ENTRY] POINT TO ENTRY
LDY #0
STY WRDLEN ; CLEAR # CHARS IN WORD
LDA VALUE+HI ; GET MSB OF VOCAB ENTRY ADDRESS
STA (ENTRY),Y ; AND STORE IN 1ST SLOT OF ENTRY
INY
LDA VALUE+LO ; ALSO STORE LSB IN 2ND SLOT
STA (ENTRY),Y
LDA RESULT ; UPDATE THE
CLC ; RESULT TABLE POINTER
ADC #4 ; SO IT POINTS TO THE
STA RESULT ; NEXT ENTRY
JMP READL ; AND LOOP BACK
; -----------------------------------
; FIND BASE ADDR OF RESULT ENTRY SLOT
; -----------------------------------
EFIND: LDA ARG2+LO ; LSB OF RESULT TABLE BASE
CLC
ADC RESULT ; AND CURRENT POINTER
STA ENTRY+LO ; SAVE IN [ENTRY]
LDA ARG2+HI ; ALSO ADD MSB
ADC #0
STA ENTRY+HI
RTS
; ----------
; FLUSH WORD
; ----------
FLUSHW: LDA LINLEN ; ANY CHARS LEFT IN LINE?
BEQ FLEX ; NO, SCRAM
LDY SOURCE ; GET CURRENT CHAR POINTER
LDA (ARG1),Y ; AND GRAB A CHAR
JSR BREAK ; IS IT A BREAK?
BCS FLEX ; EXIT IF SO
DEC LINLEN ; ELSE UPDATE CHAR COUNT
INC WRDLEN ; AND WORD-CHAR COUNT
INC SOURCE ; AND CHAR POINTER
BNE FLUSHW ; AND LOOP BACK (ALWAYS)
FLEX: RTS
; ---------------------------------
; IS CHAR IN [A] ANY TYPE OF BREAK?
; ---------------------------------
BREAK: JSR SIB ; CHECK FOR A SIB FIRST
BCS FBRK ; EXIT NOW IF MATCHED
; ELSE FALL THROUGH ...
; --------------------------------
; IS CHAR IN [A] A "NORMAL" BREAK?
; --------------------------------
NORM: LDX #NBRKS-1 ; NUMBER OF "NORMAL" BREAKS
NBL: CMP BRKTBL,X ; MATCHED?
BEQ FBRK ; YES, EXIT
DEX
BPL NBL ; NO, KEEP LOOKING
CLC ; NO MATCH, CLEAR CARRY
RTS ; AND RETURN
; ------------------
; NORMAL BREAK CHARS
; ------------------
BRKTBL: DB "!?,." ; IN ORDER OF
DB EOL ; ASCENDING FREQUENCY
DB SPACE ; SPACE CHAR IS TESTED FIRST FOR SPEED
NBRKS EQU $-BRKTBL ; # NORMAL BREAKS
; ---------------------
; IS CHAR IN [A] A SIB?
; ---------------------
SIB: TAX ; SAVE TEST CHAR
LDY #0 ; 1ST BYTE IN VOCAB TABLE
LDA (VOCAB),Y ; HAS # SIBS
TAY ; USE AS AN INDEX
TXA ; RESTORE TEST CHAR
SBL: CMP (VOCAB),Y ; MATCHED?
BEQ FBRK ; YES, REPORT IT
DEY
BNE SBL ; ELSE KEEP LOOPING
CLC ; NO MATCH, SO
RTS ; EXIT WITH CARRY CLEAR
FBRK: SEC ; EXIT WITH CARRY SET
RTS ; IF MATCHED WITH A BREAK CHAR
; -----------------
; VOCABULARY SEARCH
; -----------------
; ENTRY: 4-BYTE TARGET Z-WORD IN [OUT]
; EXIT: ABS ENTRY ADDRESS IN [VALUE] IF FOUND;
; OTHERWISE [VALUE] = 0
FINDW: LDY #0 ; GET # SIBS
LDA (VOCAB),Y ; IN VOCAB TABLE
CLC ; INCREMENT IT
ADC #1 ; FOR PROPER ALIGNMENT
ADC VOCAB+LO ; NOW ADD THE BASE ADDR OF THE TABLE
STA VALUE+LO ; TO GET THE ACTUAL BASE ADDR
LDA VOCAB+HI ; OF THE VOCAB ENTRIES
ADC #0 ; WHICH IS SAVED
STA VALUE+HI ; IN [VALUE]
LDA (VALUE),Y ; GET # BYTES PER ENTRY ([Y] = 0)
STA ESIZE ; SAVE IT HERE
JSR INCVAL ; POINT TO NEXT BYTE
LDA (VALUE),Y ; GET # ENTRIES IN TABLE (MSB)
STA NENTS+HI ; AND STUFF IT IN [NENTS]
JSR INCVAL ; NEXT BYTE
LDA (VALUE),Y ; DON'T FORGET THE LSB!
STA NENTS+LO
JSR INCVAL ; [VALUE] NOW POINTS TO 1ST ENTRY
; BEGIN THE SEARCH!
FWL1: LDY #0
LDA (VALUE),Y ; GET 1ST BYTE OF ENTRY
CMP OUT ; MATCHED 1ST BYTE OF TARGET?
BNE WNEXT ; NO, SKIP TO NEXT WORD
INY
LDA (VALUE),Y
CMP OUT+1 ; 2ND BYTE MATCHED?
BNE WNEXT ; NOPE
INY
LDA (VALUE),Y
CMP OUT+2 ; 3RD BYTE?
BNE WNEXT ; SORRY ...
INY
LDA (VALUE),Y
CMP OUT+3 ; LAST BYTE
BEQ FWSUCC ; FOUND IT!
WNEXT: LDA ESIZE ; GET ENTRY SIZE
CLC ; AND ADD IT TO ENTRY ADDRESS
ADC VALUE+LO ; TO MAKE [VALUE]
STA VALUE+LO ; POINT TO THE NEXT ENTRY
BCC WNX
INC VALUE+HI
WNX: LDA NENTS+LO ; DECREMENT THE
SEC ; ENTRY COUNTER
SBC #1
STA NENTS+LO
BCS WNX1
DEC NENTS+HI
WNX1: ORA NENTS+HI ; KEEP SEARCHING
BNE FWL1 ; UNTIL COUNT IS ZERO
STA VALUE+LO
STA VALUE+HI
RTS ; THEN RETURN WITH [VALUE] = 0
; ENTRY MATCHED!
FWSUCC: LDA VALUE+HI ; CONVERT ABSOLUTE ENTRY ADDRESS
SEC ; IN [VALUE]
SBC ZCODE ; TO RELATIVE Z-ADDRESS
STA VALUE+HI ; LSB NEEDN'T CHANGE
RTS
END

347
acorn/subs.asm Normal file
View File

@@ -0,0 +1,347 @@
PAGE
SBTTL "--- OPCODE SUPPORT SUBROUTINES ---"
; -----------------------
; FETCH A SHORT IMMEDIATE
; -----------------------
GETSHT: LDA #0 ; MSB IS ZERO
BEQ GETV ; FETCH LSB FROM Z-CODE
; ----------------------
; FETCH A LONG IMMEDIATE
; ----------------------
GETLNG: JSR NEXTPC ; GRAB MSB
GETV: STA VALUE+HI
JSR NEXTPC ; GRAB LSB
STA VALUE+LO
RTS
; ----------------
; FETCH A VARIABLE
; ----------------
; FROM INSIDE AN OPCODE (VARIABLE ID IN [A])
VARGET: TAX ; IF NON-ZERO,
BNE GETVR1 ; ACCESS A VARIABLE
JSR POPVAL ; ELSE PULL VAR OFF Z-STACK
JMP PSHVAL ; WITHOUT ALTERING STACK
; FROM THE MAIN LOOP (VARIABLE ID IN Z-CODE)
GETVAR: JSR NEXTPC ; GRAB VAR-TYPE BYTE
BEQ POPVAL ; VALUE IS ON Z-STACK
; IS VARIABLE LOCAL OR GLOBAL?
GETVR1: CMP #$10 ; IF >= 16,
BCS GETVRG ; IT'S GLOBAL
; HANDLE A LOCAL VARIABLE
GETVRL: SEC
SBC #1 ; FORM A ZERO-ALIGNED
ASL A ; WORD INDEX
TAX ; INTO THE [LOCALS] TABLE
LDA LOCALS+LO,X ; GRAB LSB
STA VALUE+LO
LDA LOCALS+HI,X ; AND MSB
STA VALUE+HI
RTS
; HANDLE A GLOBAL VARIABLE
GETVRG: JSR GVCALC ; GET ADDRESS OF GLOBAL INTO [I]
LDA (I),Y ; MSB OF GLOBAL ([Y] = 0)
STA VALUE+HI
INY ; = 1
LDA (I),Y ; LSB OF GLOBAL
STA VALUE+LO ; SAVE IT
RTS ; AND WE'RE DONE
; ----------------------------------
; POP Z-STACK INTO [VALUE] AND [X/A]
; ----------------------------------
POPVAL: DEC ZSP
BEQ UNDER ; UNDERFLOW IF ZERO!
LDY ZSP ; READ STACK POINTER
LDX ZSTAKL,Y ; GRAB LSB OF STACK VALUE
STX VALUE+LO ; GIVE TO [VALUE]
LDA ZSTAKH,Y ; ALSO GRAB MSB
STA VALUE+HI ; A SIMILAR FATE
RTS
; *** ERROR #5 -- Z-STACK UNDERFLOW ***
UNDER: LDA #5
JMP ZERROR
; -----------------------
; PUSH [VALUE] TO Z-STACK
; -----------------------
PSHVAL: LDX VALUE+LO
LDA VALUE+HI
; ---------------------
; PUSH [X/A] TO Z-STACK
; ---------------------
PUSHXA: LDY ZSP ; READ STACK POINTER
STA ZSTAKH,Y ; PUSH MSB IN [A]
TXA
STA ZSTAKL,Y ; AND LSB IN [X]
INC ZSP ; UPDATE Z-STACK POINTER
BEQ OVER ; OVERFLOW IF ZEROED!
RTS
; *** ERROR #6 -- Z-STACK OVERFLOW ***
OVER: LDA #6
JMP ZERROR
; --------------
; RETURN A VALUE
; --------------
; FROM WITHIN AN OPCODE (VARIABLE ID IN [A])
VARPUT: TAX ; IF ZERO,
BNE PUTVR1
DEC ZSP ; FLUSH TOP WORD OFF STACK
BNE PSHVAL ; AND REPLACE WITH [VALUE]
BEQ UNDER ; ERROR IF [ZSP] BECAME ZERO!
; RETURN A ZERO
RET0: LDA #0
; RETURN BYTE IN [A]
PUTBYT: STA VALUE+LO
LDA #0
STA VALUE+HI ; CLEAR MSB
; RETURN [VALUE]
PUTVAL: JSR NEXTPC ; GET VARIABLE ID BYTE
BEQ PSHVAL ; [VALUE] GOES TO Z-STACK
; LOCAL OR GLOBAL VARIABLE?
PUTVR1: CMP #$10 ; IF >= 16,
BCS PUTVLG ; IT'S GLOBAL
; PUT A LOCAL VARIABLE
PUTVLL: SEC
SBC #1 ; FORM A ZERO-ALIGNED
ASL A ; WORD INDEX
TAX ; INTO THE [LOCALS] TABLE
LDA VALUE+LO ; GRAB LSB
STA LOCALS+LO,X ; SAVE IN LOCAL TABLE
LDA VALUE+HI ; DO SAME TO
STA LOCALS+HI,X ; MSB
RTS
; RETURN A GLOBAL VARIABLE
PUTVLG: JSR GVCALC
LDA VALUE+HI ; GET MSB
STA (I),Y ; STORE AS 1ST BYTE ([Y] = 0)
INY ; = 1
LDA VALUE+LO ; NOW GET LSB
STA (I),Y ; STORE AS 2ND BYTE
RTS
; -----------------------
; CALC GLOBAL WORD OFFSET
; -----------------------
; ENTRY: VAR-ID BYTE (16-255) IN [A]
; EXIT: ABSOLUTE ADDRESS OF GLOBAL VAR IN [I]
; [Y] = 0 FOR INDEXING
GVCALC: SEC
SBC #$10 ; FORM A ZERO-ALIGNED INDEX
LDY #0 ; MAKE SURE MSB OF OFFSET AND [Y]
STY I+HI ; ARE CLEARED
ASL A ; MULTIPLY OFFSET BY 2
ROL I+HI ; TO WORD-ALIGN IT
CLC ; ADD OFFSET TO ADDR OF GLOBAL TABLE
ADC GLOBAL+LO ; TO FORM THE ABSOLUTE
STA I+LO ; ADDRESS OF THE
LDA I+HI ; DESIRED GLOBAL VARIABLE
ADC GLOBAL+HI ; STORE ADDRESS BACK IN [VAL]
STA I+HI ; AS A POINTER
WCEX: RTS
; ---------------
; PREDICATE FAILS
; ---------------
PREDF: JSR NEXTPC ; GET 1ST BRANCH BYTE
BPL PREDB ; DO BRANCH IF BIT 7 OFF
; -----------------------
; IGNORE PREDICATE BRANCH
; -----------------------
; ENTRY: 1ST BRANCH BYTE IN [A]
PREDNB: AND #%01000000 ; TEST BIT 6
BNE WCEX ; SHORT BRANCH IF SET
JMP NEXTPC ; ELSE SKIP OVER 2ND BRANCH BYTE
; ------------------
; PREDICATE SUCCEEDS
; ------------------
PREDS: JSR NEXTPC ; GET 1ST BRANCH BYTE
BPL PREDNB ; DON'T BRANCH IF BIT 7 CLEAR
; --------------------------
; PERFORM A PREDICATE BRANCH
; --------------------------
; ENTRY: 1ST PRED BYTE IN [A]
PREDB: TAX ; SAVE HERE
AND #%01000000 ; LONG OR SHORT BRANCH?
BEQ PREDLB ; LONG IF BIT 6 IS CLEAR
; HANDLE A SHORT BRANCH
TXA ; RESTORE PRED BYTE
AND #%00111111 ; FORM SHORT OFFSET
STA VALUE+LO ; USE AS LSB OF BRANCH OFFSET
LDA #0
STA VALUE+HI ; MSB OF OFFSET IS ZERO
BEQ PREDB1 ; DO THE BRANCH
; HANDLE A LONG BRANCH
PREDLB: TXA ; RESTORE 1ST PRED BYTE
AND #%00111111 ; FORM MSB OF OFFSET
TAX ; SAVE HERE FOR REFERENCE
AND #%00100000 ; CHECK SIGN OF 14-BIT VALUE
BEQ DOB2 ; POSITIVE IF ZERO, SO USE [X]
TXA ; ELSE RESTORE BYTE
ORA #%11100000 ; EXTEND THE SIGN BIT
TAX ; BACK HERE FOR STORAGE
DOB2: STX VALUE+HI
JSR NEXTPC ; FETCH LSB OF 14-BIT OFFSET
STA VALUE+LO
; BRANCH TO Z-ADDRESS IN [VALUE]
PREDB1: LDA VALUE+HI ; CHECK MSB OF OFFSET
BNE PREDB3 ; DO BRANCH IF NZ
LDA VALUE+LO ; IF LSB IS NON-ZERO,
BNE PREDB2 ; MAKE SURE IT ISN'T 1
JMP ZRFALS ; ELSE DO AN "RFALSE"
PREDB2: CMP #1 ; IF OFFSET = 1
BNE PREDB3
JMP ZRTRUE ; DO AN "RTRUE"
; ENTRY POINT FOR "JUMP"
PREDB3: JSR DECVAL ; SUBTRACT 2 FROM THE OFFSET
JSR DECVAL ; IN [VALUE]
LDA #0 ; CLEAR THE MSB
STA I+HI ; OF [I]
LDA VALUE+HI ; MAKE MSB OF OFFSET
STA I+LO ; THE LSB OF [I]
ASL A ; EXTEND THE SIGN OF OFFSET
ROL I+HI ; INTO MSB OF [I]
LDA VALUE+LO ; GET LSB OF OFFSET
CLC
ADC ZPCL ; ADD LOW 8 BITS OF ZPC
BCC PREDB5 ; IF OVERFLOWED,
INC I+LO ; UPDATE UPPER 9 BITS
BNE PREDB5
INC I+HI
PREDB5: STA ZPCL ; UPDATE ZPC
LDA I+LO ; IF UPPER 9 BITS ARE ZERO,
ORA I+HI ; NO NEED TO CHANGE PAGES
BEQ ZNOOP
LDA I+LO ; ELSE CALC NEW UPPER BITS
CLC
ADC ZPCM
STA ZPCM
LDA I+HI
ADC ZPCH
AND #%00000001 ; USE ONLY BIT 0
STA ZPCH
LDA #0
STA ZPCFLG ; [ZPC] NO LONGER VALID
; FALL THROUGH ...
; ----
; NOOP
; ----
ZNOOP: RTS
; -----------------
; DECREMENT [VALUE]
; -----------------
DECVAL: LDA VALUE+LO
SEC
SBC #1
STA VALUE+LO
BCS DVX
DEC VALUE+HI
DVX: RTS
; -----------------
; INCREMENT [VALUE]
; -----------------
INCVAL: INC VALUE+LO
BNE IVX
INC VALUE+HI
IVX: RTS
; ----------------------
; MOVE [ARG1] TO [VALUE]
; ----------------------
A12VAL: LDA ARG1+LO
STA VALUE+LO
LDA ARG1+HI
STA VALUE+HI
RTS
END

1
acorn/tftpsrc.rno Normal file
View File

File diff suppressed because one or more lines are too long

109
acorn/warm.asm Normal file
View File

@@ -0,0 +1,109 @@
PAGE
SBTTL "--- WARMSTART ROUTINE ---"
; -------------
; ZIP WARMSTART
; -------------
WARM2: LDA #0 ; CLEAR ALL Z-PAGE VARIABLES
LDX #ZEROPG
ST0: STA 0,X
INX
CPX #ZPGTOP
BCC ST0
; INIT THE PAGING TABLE
TAX ; = 0
LDA #$FF
ST1: STA PTABL,X
STA PTABH,X
INX
BNE ST1
INC ZSP ; INIT Z-STACK POINTERS
INC OLDZSP ; TO "1"
INC SCRIPT ; ENABLE SCRIPTING
; GRAB THE FIRST BLOCK OF PRELOAD
LDA #HIGH ZBEGIN ; MSB OF PRELOAD START ADDRESS
STA ZCODE ; FREEZE IT HERE
STA DBUFF+HI ; LSB IS ALWAYS ZERO
JSR GETDSK ; [DBLOCK] SET TO Z-BLOCK 0
; EXTRACT GAME DATA FROM Z-CODE HEADER
LDX ZBEGIN+ZENDLD ; MSB OF ENDLOAD POINTER
INX ; ADD 1 TO GET
STX ZPURE ; 1ST "PURE" PAGE OF Z-CODE
TXA ; ADD START PAGE OF PRELOAD
CLC ; TO CALC ABSOLUTE START ADDRESS
ADC ZCODE ; OF PAGING SPACE
STA PAGE0
JSR MEMTOP ; RETURNS TOP RAM PAGE IN [A]
SEC
SBC PAGE0 ; SUBTRACT ADDRESS OF PAGING SPACE
BEQ NORAM
BCS SETNP ; ERROR IF NOT ENOUGH RAM
; *** ERROR #0 -- INSUFFICIENT RAM ***
NORAM: LDA #0
JMP ZERROR
SETNP: STA PMAX ; SET # SWAPPING PAGES
LDA ZBEGIN+ZMODE
AND #%00000010 ; ISOLATE STATUS-FORMAT BIT
STA TIMEFL ; 0=SCORE, NZ=TIME
LDA ZBEGIN+ZGLOBA ; GET MSB OF GLOBAL TABLE ADDR
CLC ; CONVERT TO
ADC ZCODE ; ABSOLUTE ADDRESS
STA GLOBAL+HI
LDA ZBEGIN+ZGLOBA+1 ; LSB NEEDN'T CHANGE
STA GLOBAL+LO
LDA ZBEGIN+ZFWORD ; DO SAME FOR FWORDS TABLE
CLC
ADC ZCODE
STA FWORDS+HI
LDA ZBEGIN+ZFWORD+1 ; NO CHANGE FOR LSB
STA FWORDS+LO
LDA ZBEGIN+ZVOCAB ; NOW DO VOCABULARY TABLE
CLC
ADC ZCODE
STA VOCAB+HI
LDA ZBEGIN+ZVOCAB+1 ; LSB SAME
STA VOCAB+LO
LDA ZBEGIN+ZOBJEC ; NOT TO MENTION
CLC ; THE OBJECT TABLE
ADC ZCODE
STA OBJTAB+HI
LDA ZBEGIN+ZOBJEC+1 ; LSB SAME
STA OBJTAB+LO
; FETCH THE REST OF THE PRELOAD
LDPRE: LDA DBLOCK+LO ; CHECK CURRENT BLOCK #
CMP ZPURE ; LOADED LAST PRELOAD PAGE YET?
BCS WARMEX ; YES, TIME TO PLAY!
JSR GETDSK ; ELSE GRAB NEXT Z-BLOCK
JMP LDPRE
WARMEX: LDA ZBEGIN+ZGO ; GET START ADDRESS OF Z-CODE
STA ZPCM ; MSB
LDA ZBEGIN+ZGO+1 ; AND LSB
STA ZPCL ; HIGH BIT ALREADY ZEROED
JSR CLS ; CLEAR SCREEN, DISABLE SPLIT
; ... AND FALL INTO MAIN LOOP
END

530
acorn/zdos.asm Normal file
View File

@@ -0,0 +1,530 @@
PAGE
SBTTL 'ZDOS'
;*********************
;GET Z-BLOCK FROM DISK
;*********************
; (GET ACTUAL 256 BYTE BLOCK (= 1 SECTOR)
; OF GAME FROM DISK)
;ENTRY: Z-BLOCK # IN DBLOCK
; TARGET PAGE IN DBUFF+HI
GETDSK: ;SET DRIVE
;USING ONLY 8 SECTORS PER TRACK SO, USING 9 LSBITS OF DBLOCK(WORD)
;BITS 0-2 = SECTOR BITS 3-8 = TRACK
LDA DBLOCK+LO ;GET LSB OF BLOCK ID
AND #%00000111 ;MASK FOR SECTOR #
STA SECTOR
LDA DBLOCK+HI ;GET MSB OF BLOCK ID
AND #%00000001 ;ONLY BIT 0 APPLIES, CLEAR OTHERS
ASL A ;SHIFT LEFT TO BIT 5
ASL A
ASL A
ASL A
ASL A
STA TRACK ;HOLD A SEC
LDA DBLOCK+LO ;GET LSB OF BLOCK AGAIN
LSR A ;SHIFT OVER TRACK # FOR USE
LSR A ;(COVERING SECTOR)
LSR A
ORA TRACK ;ADD HIGH BIT
CLC
ADC #4 ;ZCODE STARTS ON TRACK 4. ADD OFFSET TO
;ALIGN #
CMP #80 ;HIGHEST TRACK IS 79
BCS TRKERR
STA TRACK ;SAVE TRACK FOR REAL
;ENTRY FOR "RESTORE" (TRACK, SECTOR, DRIVE PRE-ASSIGNED)
;(SETS TO READ DISK AND MOVES EACH BLOCK TO MEMORY)
GETRES: CLC ;CARRY CLEAR = READ BLOCK
JSR DISK ;GO READ THE BLOCK
BCS DSKERR ;CARRY = ERROR
LDY #0 ;ELSE, MOVE CONTENTS OF IOBUFF
GDKL: LDA IOBUFF,Y ;TO TARGET PAGE IN DBUFF
STA (DBUFF),Y
INY
BNE GDKL ;LOOP TO DO ALL 256 BYTES
INC DBLOCK+LO ;POINT TO NEXT Z-BLOCK
BNE GDEX ;NO OVERFLOW
INC DBLOCK+HI ;OTHERWISE INC HI BYTE ALSO
GDEX: JMP NXTSEC ;POINT TO NEXT SECTOR & PAGE
;******************
;PUT DBLOCK TO DISK
;******************
;(WHEN SAVE GAME, SETS TO WRITE TO DISK
;AFTER MOVING MEMORY PAGE TO TRANSFER BUFFER (IOBUFF))
;ENTRY: TRACK, SECTOR, DRIVE ASSIGNED
; PAGE TO WRITE IN DBUFF
PUTDSK: LDY #0 ;MOVE PAGE AT DBUFF TO IOBUFF FOR I/O
PTKL: LDA (DBUFF),Y
STA IOBUFF,Y
INY
BNE PTKL ;LOOP TILL ALL 256 BYTES DONE
SEC ;CARRY SET = WRITE BLOCK
JSR DISK ;GO WRITE
BCS DSKERR ;CARRY = ERROR
NXTSEC: INC SECTOR ;POINT TO NEXT SECTOR
LDA SECTOR
AND #%00000111 ;OVERFLOWED (ZERO RESULT)
BNE SECTOK ;NO, CONT
INC TRACK ;ELSE UPDATE TRACK #
SECTOK: STA SECTOR ;AND SECTOR #
INC DBUFF+HI ;POINT TO NEXT RAM PAGE
RTS
;*** ERROR 12: DISK ADDRESS OUT OF RANGE ***
TRKERR: LDA #12
JMP ZERROR
;*** ERROR 14: DISK ACCESS ***
DSKERR: LDA #14
JMP ZERROR
;SET UP SAVE & RESTORE SCREENS
SAVRES: JSR ZCRLF ;CLEAR THE BUFFER
JSR CLS ;CLEAR SCREEN
LDX #0
STX SCRIPT ;DISABLE SCRIPTING (SAVE CMDS SHOULD
;NOT GO ON PAPER)
RTS
;DISPLAY A DEFAULT
;ENTRY: DEFAULT IN A
DEFAL: DB " (Default is "
DEFNUM: DB "*):"
DEFALL EQU $-DEFAL
DODEF: CLC
ADC #'0' ;CONVERT TO ASCII
STA DEFNUM ;INSERT IN STRING
LDX #LOW DEFAL
LDA #HIGH DEFAL
LDY #DEFALL
JSR DLINE ;DISPLAY
RTS
; *****************************
; GET SAVE & RESTORE PARAMETERS
; *****************************
;THESE INCLUDE POSITION (1-5 AS CHOSEN BE PLAYER), DRIVE (0-1 AS
;CHOSEN BY PLAYER), TRACK AND SECTOR (CALCULATED FROM POSITION)
POSIT: DB EOL
DB "Position 1-5"
POSITL EQU $-POSIT
WDRIV: DB EOL
DB "Drive 0, 1, 2, or 3"
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 #LOW POSIT
LDA #HIGH POSIT
LDY #POSITL
JSR DLINE ;"POSITION 1-5"
;GET GAME POSITION
CHANGE: LDA GPOSIT ;SHOW CURRENT
CLC
ADC #1 ;SO 0 = '1'
JSR DODEF ;DEFAULT POSITION
GETPOS: JSR GETKEY ;WAIT FOR A KEY
CMP #EOL ;IF [RET]
BEQ POSSET ;USE DEFAULT
SEC
SBC #'1' ;ELSE CONVERT ASCII TO BINARY
CMP #5 ;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 OSWRCH ;AND DISPLAY IT
;GET DRIVE ID
LDX #LOW WDRIV
LDA #HIGH WDRIV
LDY #WDRIVL
JSR DLINE ;"DRIVE 0 1 2 3"
LDA GDRIVE ;SHOW DEFAULT
JSR DODEF
GETDRV: JSR GETKEY ;GET A KEYPRESS
CMP #EOL ;IF [RET]
BEQ DRVSET ;USE DEFAULT
SEC
SBC #'0' ;CONVERT TO BINARY
CMP #4 ;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 #'0' ;CONVERT TO ASCII
STA SAVDRI ;STORE TO DRIVE STRING
STA MDRI ;AND IN TEMP STRING
JSR OSWRCH ;AND SHOW NEW SETTING
LDX #LOW MIND ;SHOW TEMP SETTINGS
LDA #HIGH 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 ;TRY AGAIN
CMP #'n'
BEQ RETRY
JSR BOOP ;INSIST ON Y/N
JMP GETYES
RETRY: LDX #LOW NO ;PRINT NO
LDA #HIGH NO
LDY #NOL
JSR DLINE
JMP PARAMS ;AND TRY AGAIN (LOOPS BACK)
ALLSET: LDX #LOW YES ;PRINT "YES"
LDA #HIGH YES
LDY #YESL
JSR DLINE
LDA TDRIVE ;MAKE THE TEMP DRIVE
STA GDRIVE ;THE DEFAULT DRIVE
STA DRIVE ;SET FOR ACTUAL WRITE
LDA TPOSIT ;AND TEMP POSITION
STA GPOSIT ;THE DEFAULT POSITION
;CALC TRACK & SECTOR OF GAME POSITION ON SAVE DISK
;EACH POSITION REQUIRES 12 TRACKS (8 SECTORS EA)
;A = POSITION#
ASL A ; * 2
ASL A ; * 4
STA TRACK ; SAVE HERE A SEC
ASL A ; * 8
CLD
ADC TRACK ; * 12
STA TRACK
LDA #0
STA SECTOR ;ALWAYS START @ SECTOR #0
LDX #LOW INSM
LDA #HIGH INSM
LDY #INSML
JSR DLINE ;"INSERT SAVE DISK IN DRIVE X."
JSR RETURN ;"HIT [RET] TO CONTINUE."
CLC ;FOR SUCCESS
RTS
;*********************
;"PRESS RETURN" PROMPT
;*********************
RETURN: LDX #LOW RTN
LDA #HIGH RTN
LDY #RTNL
JSR DLINE
;ENTRY FOR QUIT/RESTART (INTERNAL OF 'RETURN')
GETRET: JSR GETKEY ;WAIT FOR <RET>
CMP #EOL
BEQ RETEX ;GOT IT
JSR BOOP ;ACCEPT NO SUBSTITUTES
JMP GETRET
RETEX: RTS
RTN: DB EOL
DB "Press <RETURN> to continue."
DB EOL
RTNL EQU $-RTN
;********************
;PROMPT FOR GAME DISK
;********************
GAME: DB EOL
DB "Insert STORY disk into drive #0."
GAMEL EQU $-GAME
TOBOOT: LDX #LOW GAME
LDA #HIGH GAME
LDY #GAMEL
JSR DLINE ;"INSERT DISK"
JSR RETURN ;"PRESS [RET]"
LDA #$FF ;RE-ENABLE SCRIPTING
STA SCRIPT
JMP CLS ;CLEAR SCREEN & RETURN
; *********
; 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 IS A 0-OP)
ZSAVE: JSR SAVRES ;SET UP SCREEN
LDX #LOW SAV
LDA HIGH SAV
` LDY #SAVL
JSR DLINE ;"SAVE POSITION"
JSR PARAMS ;GET PARAMETERS
BCC DOSAVE ;ERROR IF CARRY SET
BADSAV: LDA #0 ;RESET DRIVE TO GAME DRIVE
STA DRIVE
JSR TOBOOT ;GET BOOT DISK
JMP PREDF ;PREDICATE FAILS
DOSAVE: LDX #LOW SVING
LDA #HIGH 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 ;MOVE Z-STACK POINTER
STA BUFSAV+2 ;TO 3RD BYTE
LDA OLDZSP ;MOVE OLD ZSP
STA BUFSAV+3 ;TO 4TH
LDX #2 ;MOVE CONTERNTS OF ZPC
ZPCSAV: LDA ZPC,X ;TO BYTES 5-7
STA BUFSAV+4,X ;OF BUFSAV
DEX
BPL ZPCSAV ;3 BYTES, 3 TIMES
;WRITE LOCALS/BUFSAV PAGE TO DISK
LDA #HIGH LOCALS
STA DBUFF+HI ;POINT TO THE PAGE
JSR PUTDSK ;AND WRITE IT OUT
BCS BADSAV ;CATCH WRITE ERROR HERE
;WRITE CONTENTS OF Z-STCK TO DISK
LDA #HIGH ZSTAKL ;POINT TO 1ST PAGE
STA DBUFF+HI
JSR PUTDSK ;WRITE 1ST AND
JSR PUTDSK ;2ND PAGE OF Z-STACK
;WRITE ENTIRE GAME PRELOAD TO DISLK
LDA ZCODE ;POINT TO 1ST PAGE
STA DBUFF+HI ;OF PRELOAD (HIGH ONLY, PAGE ALIGNED)
LDX ZBEGIN+ZPURBT ;GET # IMPURE PAGES
INX ;USE FOR INDEXING
STX I+LO
LSAVE: JSR PUTDSK
DEC I+LO
BNE LSAVE ;DO ALL PAGES OF PRELOAD
LDA #0 ;RESET TO GAME DRIVE
STA DRIVE
JSR TOBOOT ;PROMPT FOR GAME DISK
JMP PREDS ;ELSE PREDICATE SUCCEEDS
; ************
; 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 ;SET UP SCREEN
LDX #LOW RES
LDA #HIGH RES
LDY #RESL
JSR DLINE ;"RESTORE POSITION"
JSR PARAMS ;GET PARAMETERS
BCS BADRES ;ERROR IF CARRY SET
LDX #LOW RSING
LDA #HIGH 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 ;ALL
LDA #HIGH LOCALS
STA DBUFF+HI
JSR GETRES ;RETRIEVE 1ST BLOCK OF PRELOAD
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 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 ;ALL
BADRES: LDA #0 ;RESET TO GAME DRIVE
STA DRIVE
JSR TOBOOT ;PROMPT FOR GAME DISK
JMP PREDF ;PREDICATE FAILS
;CONTINUE RESTORE
RIGHT: LDA ZBEGIN+ZSCRIP ;SAVE BOTH FLAG BYTES
STA I+LO
LDA ZBEGIN+ZSCRIP+1
STA I+HI
LDA #HIGH ZSTAKL ;RETRIEVE OLD CONTENTS OF
STA DBUFF+HI ;Z-STACK
JSR GETRES ;GET 1ST BLOCK OF Z-STACK
JSR GETRES ;AND 2ND BLOCK
LDA ZCODE
STA DBUFF+HI
JSR GETRES ;GET 1ST BLOCK OF PRELOAD
LDA I+LO ;RSTORE 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
DEC I+LO ;OF THE PRELOAD
BNE LREST
;RESTORE THE STATE OF THE SAVED GAME
LDA BUFSAV+2 ;RESTORE THE ZSP
STA ZSP
LDA BUFSAV+3 ;AND THE OLDZSP
STA OLDZSP
LDX #2 ;RESTORE THE ZPC
RESZPC: LDA BUFSAV+4,X
STA ZPC,X
DEX
BPL RESZPC
LDA #FALSE
STA ZPCFLG ;INVALIDATE ZPC
LDA #0 ;RESET TO GAME DRIVE
STA DRIVE
JSR TOBOOT ;PROMPT FOR GAME DISK
JMP PREDS ;PREDICATE SUCCEEDS
END

79
acorn/zip.asm Normal file
View File

@@ -0,0 +1,79 @@
TITLE "ZIP/6502 INFOCOM, INC. --- EQUATES"
; --------------------------
; ZIP/6502 2.0
; Z-CODE INTERPRETER PROGRAM
; FOR BBC ACORN
; --------------------------
; INFOCOM, INC.
; 55 WHEELER STREET
; CAMBRIDGE, MA 02136
; COMPANY PRIVATE -- NOT FOR DISTRIBUTION
MSTART EQU $1100 ; START OF FREE PROGRAM RAM
ZEROPG EQU $00 ; START OF FREE Z-PAGE RAM
ZPGTOP EQU $8F ; END OF FREE Z-PAGE RAM
DEBUG EQU 0 ; ASSEMBLY FLAG FOR DEBUGGER
; -----------
; ERROR CODES
; -----------
; 00 -- INSUFFICIENT RAM
; 01 -- ILLEGAL X-OP
; 02 -- ILLEGAL 0-OP
; 03 -- ILLEGAL 1-OP
; 04 -- ILLEGAL 2-OP
; 05 -- Z-STACK UNDERFLOW
; 06 -- Z-STACK OVERFLOW
; 07 -- ILLEGAL PROPERTY LENGTH (GETP)
; 08 -- DIVISION BY ZERO
; 09 -- ILLEGAL ARGUMENT COUNT (EQUAL?)
; 10 -- ILLEGAL PROPERTY ID (PUTP)
; 11 -- ILLEGAL PROPERTY LENGTH (PUTP)
; 12 -- DISK ADDRESS OUT OF RANGE
; 13 -- PARSER OVERFLOW
; 14 -- DRIVE ACCESS
; INCLUD SHAKE.ASM NOT APPLICABLE TO ACORN
INCLUD EQ.ASM
TITLE "ZIP/6502 INFOCOM, INC. --- MACHINE DEPENDENT INIT"
INCLUD HARDEQ.ASM ; M
INCLUD COLD.ASM ; M
TITLE "ZIP/6502 INFOCOM, INC. --- INIT & MAINLINE"
INCLUD WARM.ASM
INCLUD MAIN.ASM
INCLUD SUBS.ASM
INCLUD DISPATCH.ASM
TITLE "ZIP/6502 INFOCOM, INC. --- OPCODE EXECUTORS"
INCLUD OPS0.ASM
INCLUD OPS1.ASM
INCLUD OPS2.ASM
INCLUD OPSX.ASM
INCLUD READ.ASM
TITLE "ZIP/6502 INFOCOM, INC. --- OP SUPPORT & MEMORY MANAGEMENT"
INCLUD PAGING.ASM
INCLUD ZSTRING.ASM
INCLUD OBJECTS.ASM
TITLE "ZIP/6502 INFOCOM, INC. --- MACHINE DEPENDENT I/O"
INCLUD IO.ASM ; M
INCLUD MACHINE.ASM ; M
INCLUD ZDOS.ASM ; M
INCLUD DISK.ASM ; M
IF DEBUG
INCLUD BUGGER.ASM ; M
ENDIF
TITLE "ZIP/6502 INFOCOM, INC."
END

437
acorn/zstring.asm Normal file
View File

@@ -0,0 +1,437 @@
PAGE
SBTTL "--- Z-STRING HANDLERS ---"
; -----------------------
; POINT TO ZSTRING IN [I]
; -----------------------
SETSTR: LDA I+LO ; WORD-ALIGN THE ADDRESS
ASL A
STA MPCL
LDA I+HI
ROL A
STA MPCM
LDA #0
STA MPCFLG ; [MPC] IS CHANGING!
ROL A
STA MPCH
ZSTEX: RTS
; -----------------------
; PRINT Z-STRING AT [MPC]
; -----------------------
PZSTR: LDX #0
STX PSET ; ASSUME PERMANENT CHARSET
STX ZFLAG ; CLEAR BYTE FLAG
DEX ; = $FF
STX TSET ; NO TEMPSET ACTIVE
PZTOP: JSR GETZCH ; GET A Z-CHAR
BCS ZSTEX ; END OF STRING IF CARRY IS SET
STA ZCHAR ; ELSE SAVE CHAR HERE
TAX ; SET FLAGS
BEQ BLANK ; PRINT SPACE IF CHAR = 0
CMP #4 ; IS THIS AN F-WORD?
BCC DOFREQ ; APPARENTLY SO
CMP #6 ; PERHAPS A SHIFT CODE?
BCC NEWSET ; YES, CHANGE CHARSETS
JSR GETSET ; ELSE GET CHARSET
TAX ; SET FLAGS
BNE SET1 ; SKIP IF NOT CHARSET #0
; PRINT A LOWER-CASE CHAR (CHARSET #0)
LDA #$61-6 ; ASCII "a" MINUS Z-OFFSET
TOASC: CLC
ADC ZCHAR ; ADD Z-CHAR INDEX
SHOVE: JSR COUT ; SHOW THE CHAR
JMP PZTOP ; AND GRAB NEXT CHAR
; PRINT AN UPPER-CASE CHAR (CHARSET #1)
SET1: CMP #1 ; MAKE SURE IT'S SET #1
BNE SET2 ; ELSE MUST BE SET #2
LDA #$41-6 ; ASCII "A" MINUS Z-OFFSET
BNE TOASC ; SAME AS SET #0
; PRINT FROM CHARSET #2
SET2: LDA ZCHAR ; RETRIEVE THE Z-CHAR
SEC
SBC #6 ; ZERO-ALIGN IT
BEQ DIRECT ; IF ZERO, IT'S A "DIRECT" ASCII
TAX ; OTHERWISE USE CODE AS AN INDEX
LDA CHRTBL,X ; INTO THE CHARSET TABLE
JMP SHOVE ; AND PRINT THE CHAR
; DECODE A "DIRECT" ASCII CHAR
DIRECT: JSR GETZCH ; FETCH NEXT Z-CHAR
ASL A
ASL A
ASL A
ASL A
ASL A ; SHIFT INTO POSITION
STA ZCHAR ; AND SAVE HERE
JSR GETZCH ; GRAB YET ANOTHER Z-CHAR
ORA ZCHAR ; SUPERIMPOSE THE 2ND BYTE
JMP SHOVE ; AND PRINT THE RESULT
; PRINT A SPACE
BLANK: LDA #SPACE ; ASCII SPACE CHAR
BNE SHOVE
; CHANGE CHARSET
NEWSET: SEC ; CONVERT THE SHIFT CODE
SBC #3 ; TO 1 OR 2
TAY
JSR GETSET ; IS MODE TEMPORARY?
BNE TOPERM ; YES, DO A PERMSHIFT
STY TSET ; ELSE JUST A TEMPSHIFT
JMP PZTOP ; AND CONTINUE
TOPERM: STY PSET ; SET PERM CHARSET
CMP PSET ; SAME AS BEFORE?
BEQ PZTOP ; YES, CONTINUE
LDA #0
STA PSET ; ELSE RESET CHARSET
BEQ PZTOP ; BEFORE LOOPING BACK
; PRINT AN F-WORD
DOFREQ: SEC
SBC #1 ; ZERO-ALIGN THE CODE
ASL A ; AND MULTIPLY TIMES 64
ASL A ; TO OBTAIN THE SEGMENT OFFSET
ASL A ; INTO THE F-WORDS TABLE
ASL A
ASL A
ASL A
STA OFFSET ; SAVE OFFSET FOR LATER
JSR GETZCH ; NOW GET THE F-WORD POINTER
ASL A ; WORD-ALIGN IT
CLC ; AND
ADC OFFSET ; ADD THE SEGMENT OFFSET
TAY ; TO GET THE OFFSET OF THE F-WORD
LDA (FWORDS),Y ; FROM THE START OF THE F-WORDS TABLE
STA I+HI ; SAVE MSB OF F-WORD ADDRESS
INY
LDA (FWORDS),Y ; ALSO SAVE LSB
STA I+LO ; Z-ADDRESS OF F-WORD IS IN [I]
; SAVE THE STATE OF CURRENT Z-STRING
LDA MPCH
PHA
LDA MPCM
PHA
LDA MPCL
PHA
LDA PSET
PHA
LDA ZFLAG
PHA
LDA ZWORD+HI
PHA
LDA ZWORD+LO
PHA
JSR SETSTR ; PRINT THE Z-STRING
JSR PZSTR ; IN [I]
; RESTORE OLD Z-STRING
PLA
STA ZWORD+LO
PLA
STA ZWORD+HI
PLA
STA ZFLAG
PLA
STA PSET
PLA
STA MPCL
PLA
STA MPCM
PLA
STA MPCH
LDX #$FF
STX TSET ; DISABLE TEMP CHARSET
INX ; = 0
STX MPCFLG ; [MPC] HAS CHANGED
JMP PZTOP ; CONTINUE INNOCENTLY
; ----------------------
; RETURN CURRENT CHARSET
; ----------------------
GETSET: LDA TSET
BPL GS
LDA PSET
RTS
GS: LDY #$FF
STY TSET
RTS
; -----------------
; FETCH NEXT Z-CHAR
; -----------------
GETZCH: LDA ZFLAG ; WHICH BYTE IS THIS?
BPL GTZ0 ; $FF = LAST
SEC ; SET CARRY TO INDICATE
RTS ; NO MORE CHARS
GTZ0: BNE GETZ1 ; NOT FIRST CHAR, EITHER
; GET A Z-WORD INTO [ZWORD], RETURN 1ST CHAR IN TRIPLET
INC ZFLAG ; UPDATE CHAR COUNT
JSR GETBYT ; GET TRIPLET AT [MPC]
STA ZWORD+HI ; INTO [ZWORD]
JSR GETBYT
STA ZWORD+LO
LDA ZWORD+HI
LSR A
LSR A ; SHIFT 1ST CHAR INTO PLACE
JMP GTEXIT ; AND RETURN IT
GETZ1: SEC
SBC #1
BNE GETZ2 ; LAST CHAR IN TRIPLET IF ZERO
LDA #2 ; ELSE
STA ZFLAG ; RESET CHAR INDEX
LDA ZWORD+LO ; GET BOTTOM HALF OF TRIPLET
STA I+LO ; MOVE HERE FOR SHIFTING
LDA ZWORD+HI ; GET TOP HALF
ASL I+LO ; SHIFT THE TOP 3 BITS OF LOWER HALF
ROL A ; INTO THE BOTTOM OF THE TOP HALF
ASL I+LO
ROL A
ASL I+LO
ROL A
JMP GTEXIT
GETZ2: LDA #0 ; SET FLAG TO INDICATE
STA ZFLAG ; END OF TRIPLET
LDA ZWORD+HI ; TEST TOP HALF OF TRIPLET
BPL GETZ3 ; CONTINUE IF NOT END OF STRING
LDA #$FF ; ELSE
STA ZFLAG ; INDICATE LAST TRIPLET IN STRING
GETZ3: LDA ZWORD+LO ; GET BOTTOM HALF OF TRIPLET
GTEXIT: AND #%00011111 ; MASK OUT GARBAGE BITS
CLC
RTS
; ---------------------------------
; CONVERT [IN] TO Z-STRING IN [OUT]
; ---------------------------------
CONZST: LDA #$05 ; FILL OUTPUT BUFFER
TAX ; WITH PAD CHARS ($05)
CZSL: STA OUT,X
DEX
BPL CZSL
LDA #6 ; INIT
STA CONCNT ; CHAR COUNT
LDA #0 ; CLEAR
STA CONIN ; SOURCE AND
STA CONOUT ; OUTPUT INDEXES
CONTOP: LDX CONIN ; FETCH SOURCE INDEX
INC CONIN ; AND UPDATE
LDA IN,X ; GRAB AN ASCII CHAR
STA ZCHAR ; SAVE IT HERE
BNE NEXTZ ; CONTINUE IF CHAR WAS NZ
LDA #5 ; ELSE SHIP OUT
BNE CSHIP ; A PAD CHAR
NEXTZ: LDA ZCHAR
JSR SAYSET ; WHICH CHARSET TO USE?
BEQ CSET0 ; LOWER-CASE IF ZERO
CLC ; ELSE DO A TEMP-SHIFT
ADC #3 ; 4 = CHARSET 1, 5 = CHARSET 2
LDX CONOUT ; FETCH OUTPUT INDEX
STA OUT,X ; SEND THE SHIFT CHAR
INC CONOUT ; UPDATE INDEX
DEC CONCNT ; AND CHAR COUNT
BNE CTEST ; IF OUT OF CHARS
JMP ZCRUSH ; CRUSH 'EM!
CTEST: LDA ZCHAR ; TEST CHAR AGAIN
JSR SAYSET
CMP #2
BEQ CSET2 ; CHARSET #2
; HANDLE CHARSET #1 (UPPER CASE ALPHA)
LDA ZCHAR
SEC
SBC #$41-6 ; CONVERT TO Z-CHAR
BPL CSHIP ; AND SEND TO OUTPUT
; HANDLE CHARSET #0 (LOWER CASE ALPHA)
CSET0: LDA ZCHAR
SEC
SBC #$61-6 ; CONVERT TO Z-CHAR
; SHIP Z-CHAR TO OUTPUT BUFFER
CSHIP: LDX CONOUT ; FETCH OUTPUT INDEX
STA OUT,X
INC CONOUT ; UPDATE INDEX
DEC CONCNT ; DONE 6 CHARS YET?
BNE CONTOP ; NO, LOOP BACK
JMP ZCRUSH ; ELSE CRUSH
; HANDLE CHARSET #2 (MISCELLANEOUS)
CSET2: LDA ZCHAR ; GRAB CHAR
JSR CTABLE ; IS IT IN CHARSET #3 TABLE?
BNE CSHIP ; YES, SEND IT TO OUTPUT
; SEND A "DIRECT" ASCII CHAR
LDA #6 ; ASCII ALERT!
LDX CONOUT
STA OUT,X
INC CONOUT ; UPDATE INDEX
DEC CONCNT ; AND CHAR COUNT
BEQ ZCRUSH ; BUFFER FULL!
; SEND 1ST HALF OF "DIRECT"
LDA ZCHAR
LSR A
LSR A
LSR A
LSR A
LSR A
AND #%00000011 ; MASK GARBAGE
LDX CONOUT
STA OUT,X
INC CONOUT
DEC CONCNT
BEQ ZCRUSH ; BUFFER FULL!
; SEND 2ND HALF OF "DIRECT"
LDA ZCHAR ; GET CHAR YET AGAIN
AND #%00011111 ; MASK JUNK
JMP CSHIP ; AND SHIP IT OUT
; ---------------------
; IS [A] IN CHARSET #3?
; ---------------------
; EXIT: [A] = CHAR CODE IF FOUND, Z-FLAG CLEARED
; Z-FLAG SET IF NOT FOUND
CTABLE: LDX #25
CNL: CMP CHRTBL,X
BEQ CNOK
DEX
BNE CNL
RTS ; Z-FLAG SET IF NO MATCH
CNOK: TXA ; CHAR CODE IS INDEX
CLC
ADC #6 ; PLUS 6
RTS
; -----------------------------
; RETURN CHARSET OF CHAR IN [A]
; -----------------------------
SAYSET: CMP #'a'
BCC SAY1
CMP #'z'+1
BCS SAY1
LDA #0 ; IT'S CHARSET #0
RTS
SAY1: CMP #'A'
BCC SAY2
CMP #'Z'+1
BCS SAY2
LDA #1 ; IT'S CHARSET #1
RTS
SAY2: LDA #2 ; IT'S CHARSET #2
RTS
; ----------------------
; CRUSH Z-CHARS IN [OUT]
; ----------------------
ZCRUSH: LDA OUT+1 ; GET 2ND Z-CHAR
ASL A ; SHIFT BITS INTO POSITION
ASL A
ASL A
ASL A
ROL OUT ; ALONG WITH 1ST Z-CHAR
ASL A
ROL OUT
ORA OUT+2 ; SUPERIMPOSE 3RD Z-CHAR
STA OUT+1
LDA OUT+4 ; GET 5TH Z-CHAR
ASL A ; SHIFT BITS
ASL A
ASL A
ASL A
ROL OUT+3 ; ALONG WITH 4TH Z-CHAR
ASL A
ROL OUT+3
ORA OUT+5 ; SUPERIMPOSE 6TH Z-CHAR
TAX ; SAVE HERE
LDA OUT+3 ; GRAB 4TH Z-CHAR
ORA #%10000000 ; SET HIGH BIT
STA OUT+2 ; MOVE CRUSHED Z-WORD
STX OUT+3 ; INTO PLACE
RTS
; -----------------------
; CHARSET #2 DECODE TABLE
; -----------------------
CHRTBL: DB 0 ; DUMMY BYTE FOR "DIRECT"
DB $0D ; EOL
DB "0123456789.,!?_#"
DB $27 ; SINGLE QUOTE
DB $22 ; DOUBLE QUOTE
DB "/\-:()"
END