github.com/erkyrath.infocom-zcode-terps
1
0
Fork 0
mirror of https://github.com/erkyrath/infocom-zcode-terps.git synced 2026-02-27 17:12:48 +00:00
Code Issues Packages Projects Releases Wiki Activity
Files
master
erkyrath.infocom-zcode-terps/msx/zorkmsx.asm
Andrew Plotkin b642da811e Initial commit.
2023-11-16 18:19:54 -05:00

4287 lines
75 KiB
NASM
Raw Permalink Blame History

; **********************************************************************
; * *
; * ZIP80 - MSX VERSION *
; * Z-CODE INTERPRETER PROGRAM *
; * FOR ZILOG Z80 MICROPROCESSOR *
; * COPYRIGHT 1984, INFOCOM, INC. *
; * COMPANY PRIVATE -- NOT FOR DISTRIBUTION *
; * *
; **********************************************************************
;
;
;
; **********************************************************************
; * *
; * REVISION HISTORY *
; * *
; * 7/27/84 RML *
; * 12/19/84 LS (First MSX version) *
; * 2/5/85 LS (Reset random flag) *
; * *
; **********************************************************************
;
;
; *************************************
; * EQUATES *
; *************************************
;
;--------------------------------------
; SOME COMMON DEFINITIONS
;--------------------------------------
;
FALSE EQU 00H ;STANDARD FALSE VALUE
TRUE EQU 0FFH ;STANDARD TRUE VALUE
;
;--------------------------------------
; CPM EQUATES
;--------------------------------------
;
WARM EQU 0000H ;WARM START IN BIOS
IOBYTE EQU 0003H ;I/O DEVICE BLOCK
CDISK EQU 0004H ;CURRENT DISK DRIVE
BDOS EQU 0005H ;CPM FUNCTION ENTRY POINT
LSTADR EQU 0006H ;LAST ADDRESS
CPMFCB EQU 005CH ;DEFAULT FILE CONTROL BLOCK
CPMBUF EQU 0080H ;DEFAULT FILE TRANSFER BUFFER
TPA EQU 0100H ;TRANSIENT PROGRAM AREA
;
; FILE CONTROL BLOCK OFFSETS
;
CPMDRV EQU CPMFCB+0 ;DRIVE
CPMFNB EQU CPMFCB+1 ;NAME STORAGE
CPMFEX EQU CPMFCB+9 ;EXTENTION
CPMCR EQU CPMFCB+32 ;CURRENT RECORD
CPMREC EQU CPMFCB+33 ;RECORD NUMBER FOR RANDOM ACCESS
;
; CPM FUNCTION EQUATES
;
CRESET EQU 0 ;SYSTEM RESET
CCI EQU 1 ;CHARACTER INPUT
CCO EQU 2 ;CHARACTER OUTPUT
CLO EQU 5 ;LIST OUTPUT
CDIO EQU 6 ;DIRECT I/O
CPSTNG EQU 9 ;PRINT STRING
CRCBUF EQU 10 ;READ CONSOLE BUFFER
CGCONS EQU 11 ;GET CONSOLE STATUS
CPMRDS EQU 13 ;RESET DISK SYSTEM
CPMSEL EQU 14 ;SELECT DISK
OPEN EQU 15 ;ACTIVATES EXISTING FILE FOR R/W OPERATIONS
CLOSE EQU 16 ;INACTIVATES OPEN FILE AND RECORDS NEW FCB IN DIRECTORY
DELETE EQU 19 ;REMOVE EXISTING FILE FROM THE DIRECTORY
RETCUR EQU 25 ;RETURN CURRENT DEFAULT DISK
;
;SEQUENTIAL OPERATIONS
READS EQU 20 ;READ THE NEXT 128-BYTE RECORD FROM AN OPEN FILE
WRITES EQU 21 ;WRITE A SEQUENTIAL 128-BYTE RECORD ONTO AN OPEN FILE
;
MAKEF EQU 22 ;CREATE AND OPEN A NEW FILE
CPMRCD EQU 25 ;RETURN CURRENT DISK
;
;RANDOM OPERATIONS
READR EQU 33 ;READ A SPECIFIED 128-BYTE RECORD FROM AN OPEN FILE
WRITER EQU 34 ;WRITE A 128-BYTE RECORD TO A SPECIFIED RECORD NUMBER
; IN AN OPEN FILE
;
;MISC. EQUATES
CPLMAX EQU 133 ;MAXIMUM CHARACTERS PER LINE
;
;--------------------------------------
; APPLICATION EQUATES
;--------------------------------------
;
MAXPGS EQU 64 ;MUST BE 64 FOR TRSN VERSIONS
ROOMG EQU 16 ;ROOM # (USED TO DISPLAY SHORT DESCRIPTION)
SCOREG EQU 17 ;SCORE
MOVESG EQU 18 ;NUMBER OF MOVES
ZSTAKL EQU 224 ;LENGTH OF THE ZSTACK IN WORDS
;
;ZCODE HEADER OFFSETS INIT VALUES
ZVERS EQU 0 ;VERSION BYTE
ZSWAP EQU 1 ;BIT FLAGS - SEE BELOW
ZID EQU 2 ;GAME ID WORD
ZENDLD EQU 4 ;START OF NON-PRELOADED ZCODE
ZSTART EQU 6 ;ZCODE 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" ZCODE
ZSCRIP EQU 16 ;WORD FLAG FOR CONTROLLING SCRIPT FEATURE
ZSERNM EQU 18 ;18 THROUGH 23 ARE ASCII SERIAL NUMBER, UNIQUE TO EACH COPY
ZFWORD EQU 24 ;TABLE OF COMMON WORDS
ZCKLEN EQU 26 ;LENGTH TO USE FOR CHECKSUM
ZCKSUM EQU 28 ;SUM OF ALL WORDS AFTER WORD 64
;
;BIT FLAGS IN ZSWAP
ZSWAPF EQU 1 ;NOT USED
ZTIMEF EQU 2 ;IF SET, DISPLAY TIME IN STATUS LINE
ZSPLIT EQU 4 ;SET BY MAKDAT TO INDICATE SPLIT FILE
ZTANDY EQU 8 ;SET BY INTERPRETER TO DESIGNATE TANDY MACHINE
ZSTATB EQU 10H ;SET BY CPM CONSOLE PROGRAM, 1 IMPLIES NO STATUS LINE
;END OF COMMON EQUATES
;
LPDL EQU 400 ;200 LEVELS OF PUSH AND POP
;
; *************************************
; * *
; * PROGRAM START *
; * *
; *************************************
;
ORG 100H ;START OF THE TPA
START:
JP CPMSTR ;JUMP AROUND CONFIGURATION DATA
;
; *************************************
; * CONFIGURATION DATA *
; *************************************
;
CPMCPL: DB 79 ;CHARACTERS PER LINE
CPMLPP: DB 23 ;LINES PER PAGE EXCLUDING STATUS LINE
CPMFN: DB 'SUSPECT ' ;FILE PREFIX NAME (GAME DEPENDENT)
; PADDED AT THE END WITH BLANKS (' ') SO AS
; TO TOTAL 8 CHARACTERS
;
CPMCLF: DB 1 ;1 FOR LF AFTER CR ON CONSOLE
CPMLLF: DB 0 ;1 FOR LF AFTER CR ON LIST
CPMINV: DB 80H ;NUMBER ADDED TO CHARACTERS FOR INVERSE VIDEO
;THE FOLLOWING STRINGS HAVE A COUNT FIELD FOLLOWED BY UP TO 32 CHARACTERS
ITRMST:
DB 6 ;INIT TERMINAL, CLEAR SCREEN, LOWER LEFT,SCROLL MODE
DB 1EH,1AH,1BH,'=',55,32
DS 33-($-ITRMST)
RTRMST: DB 0 ;RESET TERMINAL
DS 33-($-RTRMST)
BSTLIN: DB 4 ;BEGIN STATUS LINE STRING
DB 1BH,'=',32,32
DS 33-($-BSTLIN)
ESTLIN: DB 4 ;END STATUS LINE STRING
DB 1BH,'=',55,32
DS 33-($-ESTLIN)
PSTUPS: DB 0 ;PRINTER SETUP STRING
DS 33-($-PSTUPS)
TWODSK: DB 0 ;SET TO 1 IF TWO DISKS ARE AVAILABLE
;
DS 200H-$ ;TO FIX THE ENTRY POINT REGUARDLESS OF
; VARIABLE LENGTH CONFIGURATION DATA
;
; *************************************
; * CPM START *
; *************************************
;
CPMSTR: ;LOCATION 200H
LD SP,PDL+LPDL ;INIT MACHINE STACK
JP BODY ;JUMP AROUND SUBROUTINE SECTION
;
; *************************************
; * SUBROUTINES *
; *************************************
;
ZER: JP RESTAR
;
MEMTOP: LD HL,(LSTADR) ;HL <= BDOS ENTRY VECTOR
LD A,L ;
CP 0FFH ;
; JP Z,MEMTP1 ;PREVIOUSLY COMMENTED OUT LINE (SCOTT)
LD L,0FFH ;SUBTRACT 1 BYTE
DEC H ;
MEMTP1: LD A,(ZCODEP+1) ;GET MSB OF LOW MEM STARTING POINTER
XOR H ;
AND 1 ;
RET NZ ;
DEC H ;WASTE 256 MORE IF NECESSARY
RET
;
;OPEN FILE
OPNDK1: LD (FILTYP),A ;SAVE FILETYPE
LD HL,CPMFCB ;XFER DRIVE NUMBER AND FILE NAME TO FCB
LD B,12
CALL MOVIT
XOR A
LD (CPMCR),A ;SET CURRENT RECORD=0 (SEQUENTIAL FILE)
LD HL,0
LD (CPMFCB+12),HL ;SET EXTENT "EX" AND S1=0
LD (CPMFCB+14),HL ;SET S2 AND RECORD COUNT FOR EXTENT "EX"=0
LD DE,CPMFCB ;^FCB
XOR A
LD (CPMFCB),A ;SELECT DEFAULT DRIVE
LD C,OPEN ;SELECT OPEN FUNCTION
CALL BDOS ;DO IT
INC A ;INCREMENT DIRECTORY CODE TO TEST FOR FILE NOT FOUND
; Z FLAG SET IF FILE NOT FOUND
RET NZ ;IF FILE EXISTS THEN RETURN WITH Z FLAG RESET A=0
; ELSE
;TEST FOR TWO DISKS
LD A,(TWODSK) ;MULTIPLE DISKS?
OR A
RET Z ;NO ONLY 1, ZFLAG SET AND RETURN
;
;TWO DISKS
LD A,1 ;AUTO DISK SELECT DRIVE A
LD (CPMFCB),A ;SET UP THE PARAMETERS
XOR A
LD (CPMCR),A
LD HL,0
LD (CPMFCB+12),HL
LD (CPMFCB+14),HL
LD DE,CPMFCB
LD C,OPEN ;TRY DRIVE 1
CALL BDOS
INC A
RET NZ ;RETURN IF FOUND WITH ZFLAG RESET
LD A,2 ; ELSE AUTO DISK SELECT DRIVE B
LD (CPMFCB),A ;SET UP THE PARAMETERS
XOR A
LD (CPMCR),A
LD HL,0
LD (CPMFCB+12),HL
LD (CPMFCB+14),HL
LD DE,CPMFCB
LD C,OPEN ;TRY DRIVE 2
CALL BDOS
INC A
RET ;IF NOT FOUND, THEN Z WILL BE SET
PCSTR: LD A,(HL) ;PRINT STRING, GET COUNT
PCSTRL: INC HL ;POINT TO NEXT CHARACTER
OR A
RET Z ;DONE
PUSH AF
PUSH BC
PUSH DE
PUSH HL
LD E,(HL)
LD C,CDIO
CALL BDOS
POP HL
POP DE
POP BC
POP AF
DEC A
JP PCSTRL
PCPST: LD A,(HL) ;PRINT PRINTER SETUP STRING, GET COUNT
PCPSTL: INC HL ;POINT TO NEXT CHARACTER
OR A
RET Z ;DONE
PUSH AF
PUSH BC
PUSH DE
PUSH HL
LD E,(HL)
LD C,CLO
CALL BDOS
POP HL
POP DE
POP BC
POP AF
DEC A
JP PCPSTL
SETFIL: LD HL,FNDAT+1 ;APPEND TO THE FILE EXTENSION NAMES
CALL SETFL1 ;THE GAME NAME SUFFIX
LD HL,FNPRE+1
CALL SETFL1
LD HL,FNPUR+1
CALL SETFL1
LD HL,SRDFNM+1
SETFL1: LD DE,CPMFN
LD B,8
JP MOVIT
FNDAT: DB 0,'........DAT'
FNPUR: DB 0,'........PUR'
FNPRE: DB 0,'........PRE'
SRDFNM: DB 0,'........SAV'
GETDSK: LD (DBUFP),HL
CALL LFILS ;OPEN ZORK/DAT FILE IF NOTHING OPEN
LD L,A
LD A,(FILTYP)
CP 3 ;DATA TYPE OF FILE?
LD A,L
JP Z,GETDK2
LD HL,ZMEMT
CP (HL)
JP C,GETPRE ;MAKE SURE ZORK/PRE IS OPEN
SUB (HL) ;REAL OFFSET
CALL LFILD ;MAKE SURE ZORK/DAT IS OPEN
JP GETDK2
GETPRE: CALL LFILP ;GET ZORK/PRE
GETDK2: LD L,A
LD H,0
ADD HL,HL
ADD HL,HL ;*4 FOR 128 BYTE BLOCKS
CALL GTDSK1
CALL GTDSK1
CALL GTDSK1
GTDSK1: PUSH HL
LD (CPMREC),HL
XOR A
LD (CPMREC+2),A
LD DE,CPMFCB
LD C,READR ;READ RANDOM RECORD
CALL BDOS
OR A
CALL NZ,ZER
LD DE,CPMBUF
LD HL,(DBUFP)
LD B,128
CALL MOVIT
LD (DBUFP),HL
POP HL
INC HL ;INCREMENT FOR NEXT TIME
RET
MOVIT: LD A,(DE) ;TRANSFER (D) TO (H) COUNT IN B
LD (HL),A
INC HL
INC DE
DEC B
JP NZ,MOVIT
RET
READBF: LD A,(CPMLPP)
DEC A
LD (MORCNT),A
CALL FLSLIN
LD A,1
LD (NOLPT),A ;TURN OFF LPT DURING READ
LD D,77 ;D CONTAINS MAX CHARS CAN READ
LD E,0 ;E CONTAINS HOW MANY HAVE BEEN READ
LD HL,(ARG1) ;READ A BUFFER
INC HL
READB1: CALL CIN
CP 08H
JP Z,RDBFRO
CP 7FH
JP Z,RDBFRO
CP 0DH
JP Z,RDBFCR
CP 18
JP Z,RDBFRT
CP 20H
JP C,READB1
LD C,A
CALL COUT
LD A,C
CP 'A'
JP C,READB2
CP 'Z'+1
JP NC,READB2
ADD A,'a'-'A' ;CONVERT TO LOWER CASE
READB2: LD (HL),A
INC HL
INC E
LD A,D
CP E
JP Z,RDBFFL
JP READB1
RDBFRO: LD A,E ;CHECK IF 1ST CHAR
CP 0 ;IF SO DON'T DELETE
JP Z,READB1 ;GO GET ANOTHER CHAR
DEC E
DEC HL
CALL COUTBS
JP READB1
COUTBS: LD C,08H
CALL COUT
LD C,20H
CALL COUT
LD C,08H ;DEVINE RUBOUT
JP COUT
RDBFCR: PUSH HL
PUSH DE
XOR A
LD (NOLPT),A
LD HL,(ZCODEP)
LD DE,ZSCRIP+1
ADD HL,DE
LD A,(HL)
AND 1
JP Z,RDBFC2 ;NO LPT
POP DE
PUSH DE
LD A,E
OR A
JP Z,RDBFC2 ;NOTHING TYPED
LD HL,(ARG1)
INC HL
RDBFC3: LD A,(HL)
CP 'a'
JP C,RDBFC4 ;NOT LOWER CASE
SUB 'a'-'A'
RDBFC4: LD C,A
INC HL
CALL LPTO
DEC E
JP NZ,RDBFC3
RDBFC2: POP DE
POP HL
LD A,D
CP E
JP Z,RDBFC1
INC E
LD (HL),0DH
RDBFC1: CALL PCRLFD
LD A,E
RET
RDBFRT: PUSH DE
PUSH HL
LD HL,(ARG1)
INC HL
CALL PCRLFD
RDBFR1: LD A,E
OR A
JP Z,RDBFR2
LD C,(HL)
CALL COUT
DEC E
INC HL
JP RDBFR1
RDBFR2: POP HL
POP DE
JP READB1
RDBFFL: CALL CIN
CP 0DH ;ACCEPT <RET>
JP Z,RDBFCR
CP 08
JP Z,RDBFRO
CP 7FH
JP Z,RDBFRO
PUSH DE
LD E,7 ;OTHERWISE
LD C,CDIO ;RING BELL
CALL BDOS
POP DE
JP RDBFFL ;AND LOOP TIL GET WHAT WE WANT
CIN: PUSH BC
PUSH DE
PUSH HL
CIN1: LD E,0FFH
LD C,CDIO ;READ DIRECT
CALL BDOS
OR A
JP Z,CIN2 ;NO CHARACTER YET
LD HL,RDFLG
LD (HL),0FFH ;NOT FIRST READ ANY MORE
POP HL
POP DE
POP BC
AND 7FH
RET
CIN2: LD A,(RDFLG)
OR A
JP NZ,CIN1 ;NOT FIRST READ
CALL RND
JP CIN1
COUTD: LD HL,COUTDC ;INCREASE COUNT
INC (HL)
LD A,(CPMINV) ;INVERSE VIDEO ADDER
LD HL,STAFLG
AND (HL) ;ADD ONLY IF IN STATUS MODE
ADD A,C
LD E,A
LD C,CDIO
CALL BDOS
JP POPRET
PCRLFD: PUSH BC
PUSH DE
PUSH HL
LD E,0DH
LD C,CDIO
CALL BDOS
LD A,(CPMCLF)
OR A
JP Z,PCRLD1 ;NO LINE FEED
LD E,0AH
LD C,CDIO
CALL BDOS
PCRLD1: LD C,0DH
CALL LPCHK
LD HL,MORCNT
DEC (HL)
CALL Z,MORE
POPRET: POP HL
POP DE
POP BC
RET
LPCHK: PUSH BC
PUSH DE
PUSH HL
LD HL,(ZCODEP)
LD DE,ZSCRIP+1
ADD HL,DE
LD A,(HL)
AND 1
CALL NZ,LPTO
JP POPRET
COUTCR: CALL LINOCR
JP CORET
PCRLF: LD C,0DH
COUT: PUSH BC
PUSH DE
PUSH HL
LD A,C
CP 8
JP Z,COUT1
CP 1BH
JP Z,CLEARS
CP 12
JP Z,CLEARS
CP 0DH
JP Z,COUTCR
COUT2: CP 20H
JP C,CORET ;NON PRINTING
COUT1: LD A,(NOLPT)
OR A
JP NZ,COUTD
LD A,(NCHARS)
LD HL,CPMCPL
CP (HL)
CALL NC,LINOCR ;OUTPUT LINE IF FULL
LD A,(NCHARS)
INC A
LD (NCHARS),A
LD HL,(CHRPNT)
LD (HL),C
INC HL
LD (CHRPNT),HL
CORET: POP HL
POP DE
POP BC
RET
FLSLIN: PUSH BC
LD A,(NCHARS)
OR A
JP Z,LINOTR ;NO CHARS
JP LINFUL ;PRINT ALL
LINOUT: PUSH BC
LD A,(NCHARS)
OR A
JP Z,LINOTR ;NO CHARACTERS
DEC A
LD B,A
LD A,C
CP 0DH
JP Z,LINFUL
LD HL,(CHRPNT) ;FIND LAST SPACE
DEC HL
LINOT1: LD A,(HL)
CP 20H
JP Z,LINOT2 ;FOUND SPACE
DEC HL
DEC B
JP P,LINOT1
LINFUL: LD HL,(CHRPNT) ;PRINT WHOLE LINE
LD A,(NCHARS)
LD B,A
LINOT2: PUSH BC
PUSH HL
LD HL,CHARS
LD A,B
OR A
JP Z,LINOT6
LINOT3: PUSH BC
PUSH DE
PUSH HL
LD E,(HL)
LD C,CDIO
CALL BDOS
POP HL
PUSH HL
LD C,(HL)
CALL LPCHK
POP HL
POP DE
INC HL
POP BC
DEC B
JP NZ,LINOT3
LINOT6: POP HL
INC HL
POP BC
LD A,(NCHARS)
SUB B
DEC A
JP P,LINOT7
XOR A
;
LINOT7: LD (NCHARS),A ;CHARACTERS NOT YET PRINTED
JP Z,LINOT5
LD DE,CHARS
LINOT4: LD A,(HL)
LD (DE),A
INC HL
INC DE
DEC B
JP NZ,LINOT4
LINOT5: LD HL,CHARS
LD A,(NCHARS)
CALL HLOFF
LD (CHRPNT),HL
LINOTR: POP BC
RET
LINOCR: CALL LINOUT
JP PCRLFD
TMCHK: LD HL,(ZCODEP) ;RETURNS NON ZERO IF IN TIME DISPLAY MODE
LD DE,ZSWAP
ADD HL,DE
LD A,(HL)
AND ZTIMEF
RET
CLEARS:
RET ;NOT YET IMPLEMENTED
LPTO: LD A,(NOLPT)
OR A
RET NZ ;SOME ITEMS DON'T GO TO LPT
LD A,(PRFLG)
OR A
CALL Z,LPINIT
PUSH BC
PUSH DE
PUSH HL
LD E,C
PUSH BC
LD C,CLO ;LIST OUT
CALL BDOS
POP BC
LD A,C
CP 0DH
JP NZ,POPRET ;NOT CR
LD A,(CPMLLF)
OR A
JP Z,POPRET
LD E,0AH
LD C,CLO ;OUTPUT LF IF NEEDED
CALL BDOS
JP POPRET
LPINIT: INC A
LD (PRFLG),A
PUSH HL
LD HL,PSTUPS
CALL PCPST ;PRINTER SETUP STRING
POP HL
RET
WHOLIN: LD HL,BSTLIN
LD A,(HL) ;DO WE HAVE A STATUS LINE?
OR A
RET Z ;NO, RETURN
LD A,(CSPERM) ;SAVE DATA CLOBERED BY PRNTDC
LD H,A
LD A,(STBYTF)
LD L,A
PUSH HL
LD HL,(ZSTWRD)
PUSH HL
LD HL,(MPCL)
PUSH HL
LD HL,(MPCH)
PUSH HL
LD HL,BSTLIN
CALL PCSTR ;POSITON TO TOP OF SCREEN
XOR A
LD (COUTDC),A ;BEGINNING OF LINE
LD A,1
LD (NOLPT),A
LD A,0FFH
LD (STAFLG),A ;STATUS LINE FLAG (ANDED WITH CPMINV ADDER)
CALL TMCHK
JP NZ,WHOLT
CALL WHOLN1 ;COMMON TIME/ROOM PRINTING
LD HL,WHOMSG ;PRINT 'SCORE'
CALL POSPST ;POSITION THEN PRINT
LD A,SCOREG
CALL VARGET
CALL PRNTNC
LD C,'/'
CALL COUT
LD A,MOVESG
CALL VARGET
CALL PRNTNC
WHOLN2: LD A,(CPMCPL)
LD B,A
CALL CHRPOS ;BLANK REST OF LINE
LD HL,ESTLIN
CALL PCSTR ;POSITION BACK TO LOWER LEFT
XOR A
LD (NOLPT),A
LD (STAFLG),A
LD (MPCFLG),A ;RESTORE STRING VALUES
POP HL
LD A,L
LD (MPCH),A
POP HL
LD (MPCL),HL
POP HL
LD (ZSTWRD),HL
POP HL
LD A,H
LD (CSPERM),A
LD A,L
LD (STBYTF),A
CALL GETMOD
RET
WHOLN1: LD C,' ' ;PRINT A ' '
CALL COUT
LD A,ROOMG ;GET THE CURRENT ROOM NO.
CALL VARGET
LD A,L
JP PRNTDC ;PRINT THE SHORT DESCRIPTION
;
; PRINT THE TIME (HOURS)
WHOLT: CALL WHOLN1
LD HL,WHOTMS ;PRINT '.......TIME' MESSAGE
CALL POSPST
LD A,SCOREG ;GET HOURS IN MILITARY TIME (24 HR CLOCK)
CALL VARGET
LD A,L ;A <= HOURS
PUSH AF ;SAVE HOURS
OR A ;HOURS=0?
JP NZ,WHOLT0 ; NO.
LD L,12 ; YES. 0 HRS IS REALLY 12 HOURS
JP WHOLT1
;
WHOLT0: CP 13 ;COMPARE HOURS (24 HR CLOCK) WITH 13
JP C,WHOLT1 ; IF < 13 THEN PRINT HOURS
SUB 12 ; ELSE A <= A-12
LD L,A ; L <= ADJUSTED TIME (12 HR CLOCK)
WHOLT1: CALL PRNTNC ;PRINT THE HOURS
LD C,':' ;PRINT ':'
CALL COUT
;
; PRINT TIME (MINUTES)
LD A,MOVESG ;GET THE MINUTES
CALL VARGET ;A <= MINUTES
CALL PNTTIM ;PRINT THE MINUTES
LD C,' ' ;PRINT A ' '
CALL COUT
;
; PRINT 'AM/PM'
LD C,'a'
POP AF ;RESTORE HOURS
CP 24 ;24 HOURS IS AM
JP Z,WHOLT2
CP 12 ;< 12 HOURS IS AM
JP C,WHOLT2
LD C,'p' ;ELSE IT'S PM
WHOLT2: CALL COUT ;PRINT 'A/P'
LD C,'m'
CALL COUT ;PRINT 'M'
JP WHOLN2
;
CHRPOS: LD A,(COUTDC) ;SPACE UNTILE COUTDC=(B)
CP B
RET NC
PUSH BC
LD C,20H
CALL COUT
POP BC
JP CHRPOS
POSPST: LD A,(CPMCPL)
CP 39 ;VERY SHORT
JP C,POSPS1 ;DON'T PRINT WORDS
SUB 16
PUSH HL
LD B,A
CALL CHRPOS ;SPACE OVER
POP HL
LD B,(HL)
POSPS2: INC HL
LD C,(HL)
CALL COUT
DEC B
JP NZ,POSPS2
RET
POSPS1: SUB 8 ;MOVE OVER 8 FROM EDGE
LD B,A
JP CHRPOS
WHOMSG: DB 7,'Score:',20H
WHOTMS: DB 6,'Time:',20H
MORMSG: DB '-------------More-------------',0
LMORE EQU $-MORMSG
MORE: LD A,(CPMLPP)
OR A
RET Z ;NO MORE LINE IF 0
DEC A
LD (HL),A
CALL WHOLIN ;SHOW STATUS
LD A,1
LD (NOLPT),A ;DON'T SCRIPT MORE MESSAGE
LD HL,MORMSG
CALL MSGOUT
CALL CIN
LD E,0DH
LD C,CDIO ;CR WITHOUT LF
CALL BDOS
LD B,LMORE
MORE1: PUSH BC
LD E,20H
LD C,CDIO
CALL BDOS
POP BC
DEC B
JP NZ,MORE1
LD E,0DH
LD C,CDIO
CALL BDOS
XOR A
LD (NOLPT),A
RET ;NOW AT BEGINNING OF CLEAR LINE
PNTTIM: LD DE,10
CALL HLGEDE
LD C,'0'
CALL NC,COUT
JP PRNTNC
;ZZZZZZZZZZZZZZZZZZZZZZZZZZZ
QUIT: LD HL,RTRMST
CALL PCSTR
LD C,CRESET
CALL BDOS
JP QUIT
RESTAR:
LD DE,CPMFCB
LD C,CLOSE
CALL BDOS
LD HL,RTRMST
CALL PCSTR
JP START
SAVE:
XOR A
LD (FILTYP),A
LD DE,CPMFCB
LD C,CLOSE
CALL BDOS
CALL SRGFNM
LD DE,CPMFCB
LD C,DELETE
CALL BDOS
LD DE,CPMFCB
LD C,MAKEF
CALL BDOS
INC A
JP Z,SFAIL ;DID NOT OPEN
LD HL,(ZCODEP)
LD BC,ZVERS
ADD HL,BC
LD A,(HL) ;STORE VERSION NUMBER
LD (CPMBUF),A
LD HL,(ZSTAKP)
LD (CPMBUF+1),HL
LD HL,CPMBUF+3
LD DE,SRND
LD BC,SRNDC ;TO MAKE EXTERNALS WORK
LD B,C
CALL MOVIT
LD DE,CPMFCB
LD C,WRITES
CALL BDOS
OR A
JP NZ,SFAIL ;WRITE OUT INITIAL STUFF
LD C,0+(((ZSTAKL*2)+127)/128)
LD DE,ZSTACK ;NEXT WRITE OUT STACK
SAVEA: LD B,128
LD HL,CPMBUF
CALL MOVIT
PUSH BC
PUSH DE
LD DE,CPMFCB
LD C,WRITES
CALL BDOS
OR A
JP NZ,SRFAIL
POP DE
POP BC
DEC C
JP NZ,SAVEA
LD HL,(ZCODEP)
LD DE,ZPURBT
ADD HL,DE
LD C,(HL) ;COUNT OF PAGES
LD HL,(ZCODEP)
EX DE,HL ;WHERE TO START FROM
LD B,2 ;128 BYTE RECORDS
SAVE1: PUSH BC
LD HL,CPMBUF
LD B,128
CALL MOVIT ;GET NEXT RECORD TO TRANSFER
PUSH DE
LD DE,CPMFCB
LD C,WRITES ;WRITE IT TO DISK
CALL BDOS
POP DE
POP BC
OR A
JP NZ,SFAIL ;WRITE ERROR
DEC B
JP NZ,SAVE1 ;GO DO 2ND HALF OF PAGE
LD B,2 ;RESET FOR 2 RECORDS PER PAGE
DEC C ;NEXT PAGE
JP P,SAVE1
SRCLOS: LD DE,CPMFCB ;CLOSE FILE, DONE
LD C,CLOSE
CALL BDOS
LD DE,CPMFCB ;OPEN FILE AGAIN TO FORCE
LD C,OPEN ;WRITE TO DISK
CALL BDOS
LD DE,CPMFCB ;AND CLOSE AGAIN TO BE SURE
LD C,OPEN
CALL BDOS
CALL SRSWPD ;TELL PLAYER SWAP GAME DISK BACK IN
CALL PCRLF
XOR A
LD (ZPCFLG),A
JP PREDS
SFAIL: LD DE,CPMFCB
LD C,CLOSE
CALL BDOS
LD DE,CPMFCB
LD C,DELETE
CALL BDOS
JP SFAIL1
SRFAIL: LD DE,CPMFCB
LD C,CLOSE
CALL BDOS
LD DE,CPMFCB ;REOPEN TO FORCE WRITE TO DISK
LD C,OPEN
CALL BDOS
LD DE,CPMFCB ;CLOSE FOR SECURITY
LD C,CLOSE
CALL BDOS
SFAIL1: CALL SRSWPD
XOR A
LD (ZPCFLG),A
JP PREDF
SRGFNM: LD HL,SRMSG1 ;/LOAD SAVE DISK/
CALL MSGOUT
LD B,8
LD HL,SRDFNM+1 ;FILENAME
CALL SRGFNA ;DISPLAY CHARS TILL HIT BLANKS
LD HL,SRMSG3
CALL MSGOUT
LD B,3
LD HL,SRDFNM+9
CALL SRGFNA
LD HL,SRMSG2
CALL MSGOUT
LD HL,0
LD (CPMFCB+12),HL ;CLEAR EX,S1
LD (CPMFCB+14),HL ; S2,RC
XOR A
LD (CPMCR),A ; CR
LD DE,CPMBUF
LD A,14
LD (DE),A
LD C,CRCBUF ;READ CONSOLE BUFFER
CALL BDOS
CALL PCRLFD
LD A,(CPMBUF+1)
OR A
JP Z,SRGDFN ;USE DEFAULT, SKIP THIS NEXT PART
LD B,11
LD HL,SRDFNM
INC HL ;SKIP OVER DRIVE, LEAVE AS WAS SO PLAYER
;NEED ONLY SPECIFY IT ONCE
SRGFM1: LD (HL),20H
INC HL
DEC B
JP NZ,SRGFM1 ;FILL WITH BLANK FILE NAME
LD B,A ;SAVE COUNT OF CHARACTERS
LD HL,CPMBUF+2 ;BEG OF FILE NAME
LD DE,SRDFNM+1 ;STORAGE FOR FILE NAME
CP 3
JP C,SRGFN2 ;NO DRIVE SPEC
LD A,(CPMBUF+3)
CP ':' ;DRIVE SPEC?
JP NZ,SRGFN2 ;NONE THIS TIME
DEC B
DEC B
LD A,(HL)
AND 0FH ;DRIVE NUMBER
LD (SRDFNM),A
INC HL
INC HL ;POINTER PAST DRIVE SPEC
SRGFN2: DEC B
JP M,SRGDFN ;FILE NAME NOW DEFAULT
LD A,(HL)
CALL UPPER
INC HL
CP '.'
JP Z,SRGFN3 ;EXTENTION
LD (DE),A
INC DE
JP SRGFN2
SRGFNA: LD A,(HL)
CP ' '
JP Z,SRGFNB
LD C,A
PUSH BC
PUSH DE
PUSH HL
LD E,(HL)
LD C,CDIO
CALL BDOS
POP HL
PUSH HL
CALL MSGCRC ;SEND LF IF NECESSARY
POP HL
POP DE
POP BC
CALL LPCHK
SRGFNB: INC HL
DEC B
JP NZ,SRGFNA
RET
UPPER: CP 'a'
RET C
CP 'z'+1
RET NC
SUB 'a'-'A'
RET
SRGFN3: LD DE,SRDFNM+9
LD A,B
AND 3 ;MAX OF 3 CHARACTERS
LD B,A
JP SRGFN2
SRGDFN: LD DE,SRDFNM ;DEFAULT FILE NAME
LD HL,CPMFCB
LD B,12
JP MOVIT
SRSWPD: LD HL,LFILDG
MSGRES: CALL MSGOUT ;MESSAGE THEN RESPONSE
CALL CIN ;WAIT FOR CHARACTER
LD HL,CRMSG
JP MSGOUT
CRMSG: DB 0DH,0
LFILDG: DB 'Load Game Disk if it was removed.',0DH
DB 'Type <ENTER> to continue >',0
LFILDM: DB 'Load Disk 2, type <ENTER> to continue >',0
LFILPM: DB 'Load Disk 1, type <ENTER> to continue >',0
LFILGM: DB 'Load Game Disk, type <ENTER> to continue >',0
SRMSG1: DB 'Load SAVE disk then enter file name.',0DH
DB '(default file name is ',0
SRMSG2: DB ').',0DH
DB 'Type <ENTER> to continue > ',0
SRMSG3: DB '.',0
MSGOUT: LD C,(HL)
LD A,(HL)
OR A
RET Z
PUSH BC
PUSH DE
PUSH HL
LD E,(HL)
LD C,CDIO
CALL BDOS
POP HL
PUSH HL
CALL MSGCRC
POP HL
POP DE
POP BC
CALL LPCHK
INC HL
JP MSGOUT
MSGCRC: LD A,(CPMCLF)
OR A
RET Z ;NO LF AFTER CR
LD A,(HL)
CP 0DH
RET NZ ;NOT CR
LD E,0AH ;PRINT A LF
LD C,CDIO
CALL BDOS
RET
RESTOR: XOR A
LD (FILTYP),A
LD DE,CPMFCB
LD C,CLOSE
CALL BDOS
CALL SRGFNM
LD DE,CPMFCB
LD C,OPEN
CALL BDOS
INC A
JP Z,SRFAIL
LD DE,CPMFCB
LD C,READS
CALL BDOS
OR A
JP NZ,SRFAIL
LD HL,(ZCODEP)
LD DE,ZVERS
ADD HL,DE
LD A,(CPMBUF)
CP (HL)
JP NZ,SRFAIL ;VERSIONS DIFFER
LD HL,(CPMBUF+1)
LD (ZSTAKP),HL ;STACK POINTER
LD DE,CPMBUF+3
LD HL,SRND
LD BC,SRNDC ;TO MAKE EXTERNALS WORK
LD B,C
CALL MOVIT ;RESTORE RANDOM DATA
LD C,0+(((ZSTAKL*2)-1)/128) ;ONE TOO FEW
LD HL,ZSTACK ;NEXT WRITE OUT STACK
RESTA: PUSH BC
PUSH HL
LD DE,CPMFCB
LD C,READS
CALL BDOS
POP HL
POP BC
OR A
JP NZ,SRFAIL
LD DE,CPMBUF
LD B,128
CALL MOVIT
DEC C
JP NZ,RESTA
PUSH HL ;READ LAST BLOCK
LD DE,CPMFCB
LD C,READS
CALL BDOS
POP HL
OR A
JP NZ,SRFAIL
LD DE,CPMBUF
LD B,0+((ZSTAKL*2)-((((ZSTAKL*2)-1)/128)*128))
CALL MOVIT
LD HL,(ZCODEP)
LD DE,ZSCRIP+1
ADD HL,DE
LD (SCPLOC),HL ;LOCATION OF SCRIPT FLAG
LD A,(HL)
AND 1 ;ISOLATE SCRIPT BIT
LD (SCPVAL),A ;AND SAVE
LD HL,(ZCODEP)
LD DE,ZPURBT
ADD HL,DE
LD C,(HL)
LD HL,(ZCODEP) ;POINTER TO BEGINNING OF DATA
LD B,2 ;128 BYTE RECORDS
REST1: PUSH BC
PUSH HL
LD DE,CPMFCB
LD C,READS
CALL BDOS
POP HL
POP BC
OR A
JP NZ,RESTAR
LD DE,CPMBUF
PUSH BC
LD B,128
CALL MOVIT
POP BC
DEC B
JP NZ,REST1
LD B,2
DEC C
JP P,REST1
LD HL,(SCPLOC)
LD A,(HL)
AND 0FEH ;CLEAR SCRIPT BIT
PUSH HL
LD HL,SCPVAL
OR (HL) ;OR IN VALUE FROM MEMORY
POP HL
LD (HL),A
JP SRCLOS ;ALL DONE
LFILS: PUSH AF
LD A,(FILTYP)
CP 3 ;.DAT FILE ALREADY OPEN?
JP Z,LFILR ; YES. RETURN.
OR A ; NO. SOME OTHER TYPE OPEN?
JP NZ,LFILR ; YES. RETURN.
LFILS1: LD DE,FNDAT ; NO. ^ DATA FILE NAME
LD A,3 ;OPEN TYPE 3
CALL OPNDK1 ;TRY TO OPEN FILE
JP NZ,LFILR ;OPEN .DAT FILE COMPLETE?
;YES. RETURN.
LD A,(TWODSK) ;CHECK IF STORY ON 2 DISKS
CP 1
JP Z,LFILF ;IF 1, 2 DISKS
LD HL,LFILGM ;ASK FOR DISK
CALL MSGRES
JP LFILS1 ;TRY AGAIN
LFILF: XOR A ; NO. SET FILTYP=0
LD (FILTYP),A ;OPEN FAILED TRY OTHER TYPE
JP LFILR
LFILD: PUSH AF
LD A,(FILTYP)
CP 2 ;.PUR FILE ALREADY OPEN?
JP Z,LFILR ; YES.ALREADY OPEN
CALL LFILC ;CLOSE EXISTING FILE IF ANY
LFILD1: LD DE,FNPUR
LD A,2
CALL OPNDK1 ;TRY TO OPEN PURELOAD FILE
JP NZ,LFILR ;OPEN OK
LD HL,LFILDM
CALL MSGRES ;ASK TO LOAD DISK
JP LFILD1 ;TRY AGAIN
LFILP: PUSH AF
LD A,(FILTYP)
CP 1 ;PRELOAD TYPE?
JP Z,LFILR ;OPEN
CALL LFILC
LFILP1: LD DE,FNPRE
LD A,1
CALL OPNDK1
JP NZ,LFILR ;OPEN OK
LD HL,LFILPM
CALL MSGRES ;LOAD PROPER DISK
JP LFILP1
LFILR: POP AF
RET
LFILC: OR A
RET Z ;NONE OPEN
LD DE,CPMFCB
LD C,CLOSE
CALL BDOS
XOR A
LD (FILTYP),A
RET
;DATA
STAFLG: DB 0 ;0FFH WHEN IN STATUS LINE MODE
COUTDC: DB 0 ;CHARACTER COUNT UNDER STATUS LINE
RDFLG: DB 0 ;0 FOR FIRST READ
PRFLG: DB 0 ;0 FOR FIRST PRINT
SCPLOC: DW 0 ;SCRIPT LOCATION
SCPVAL: DB 0 ;SCRIPT VALUE
DBUFP: DW 0 ;DSK POINTER
NCHARS: DB 0
CHARS: DS CPLMAX
CHRPNT: DW CHARS
FILTYP: DB 0 ;0 FOR NONE, 1 FOR PRE, 2 FOR PUR, 3 FOR DAT
MORCNT: DB 23
;(PUT IN CODE SEGMENT TO PRESERVE COMMON ZORKBODY)
PDL: DS LPDL ;CONTROL STACK
ZSTAKP: DW ZSTACK+(2*ZSTAKL) ;POINTER TO CURRENT ZSTACK
ZSTACK: DS ZSTAKL*2 ;ZSTACK
PGTBL: DS MAXPGS ;PAGE NUMBER, 0 ALWAYS IN MEMORY, THUS 0=FREE
PGTBLF: DS MAXPGS ;NEXT LINK POINTER, 0FFH IMPLIES END POINT
PGTBLB: DS MAXPGS ;PREVIOUS LINK POINTER
PGTFD EQU PGTBLF-PGTBL
PGTBD EQU PGTBLB-PGTBL
VRS: DB 0DH,'UPDATED 2.5.85',0DH,0
VRLINE: DB 0DH,'VERSION C',0DH,0
;
; **********************************************************************
; * *
; * WARMSTART ENTRY *
; * *
; **********************************************************************
;
;
; MAIN BODY OF CODE STARTS HERE.
;
BODY: XOR A
LD (ZPCFLG),A ;DISABLE TIME IN STATUS LINE, NO SPLIT FILE, NOT TANDY
LD (MPCFLG),A ;NO VALID MEMORY IN FROM DISK (MPCPNT NOT VALID)
LD (PGTOP),A ;SET TOP OF LIST PAGE
LD C,RETCUR ;GET CURRENT DEFAULT DRIVE
CALL BDOS ;RETS IN A
LD E,A ;SET DEFAULT DRIVE
LD C,CPMSEL ;THIS SEEMS REDUNDENT BUT THE MACHINE IS NOT
CALL BDOS ;RECOGNIZING RESETS FROM BOOT DRIVE DONE BEFORE
;STARTING THE GAME
;
; INITIALIZE ZSTACK
;
LD A,1
LD (ZSTAKC),A ;INITIALIZE ZSTACK POSITION COUNTER
LD HL,ZSTACK+(2*ZSTAKL)
LD (ZSTAKP),HL ;SAVE THE LOCATION OF THE BOTTOM OF ZSTACK IN
; ZSTACK POINTER
;
; INITIALIZE PAGE TABLES
;
LD DE,PGTBL ;DE ^ TOP OF PAGE TABLE
LD BC,0+(MAXPGS*256) ;FOR NUMBER OF PAGES (IN B)
;
START1:
; INITIALIZE PGTBL
XOR A
LD (DE),A ;(PGTBL+PAGE NUMBER) <= 0
; FREE THE PAGE (NO PAGE IN MEMORY)
;
LD HL,PGTFD ;HL <= MAXIMUM NUMBER OF PAGES
; USED AS AN OFFSET INTO PGTBLF
;
; INITIALIZE FOWARD POINTER
ADD HL,DE ;HL ^ PAGE FORWARD POINTER TABLE SLOT
LD (HL),C ;SAVE CURRENT POINTER
INC (HL) ;ADD 1 TO MAKE IT A FORWARD POINTER
;
; INITIALIZE PREVIOUS POINTER
LD HL,PGTBD ;HL ^ PAGE PREVIOUS POINTER TABLE BASE ADDRESS
ADD HL,DE ;ADD OFFSET
LD (HL),C ;SAVE CURRENT POINTER
DEC (HL) ;SUBTRACT 1 TO MAKE IT A PREVIOUS POINTER
;
; UPDATE
INC C ;NEXT PAGE
INC DE ;NEXT SLOT IN TABLES
;
; TEST LOOP FOR DONE
DEC B ;DECREMENT NUMBER OF SLOTS REMAINING
JP NZ,START1 ;>0? YES. CONTINUE LOOPING.
;
; CORRECT FOR NO FORWARD POINTER FOR LAST PAGE
;
LD HL,PGTFD-1
ADD HL,DE
LD (HL),0FFH
;
; SET BOTTOM PAGE NO.
;
LD A,MAXPGS-1
LD (PGBOT),A
;
; COMPUTE ZCODE STARTING ADDRESSS
;
LD HL,LMEMRY ;POINT HL PAST ZIP
LD DE,0FFH ;ADJUST ADDRESS TO A PAGE BOUNDRY
ADD HL,DE
LD L,0
LD (ZCODEP),HL ;SAVE ZCODE STARTING ADDRESS
;
; SET UP FILE NAMES FOR DAT, PRE, PUR AND SAV
;
CALL SETFIL ;APPEND GAME NAME PREFIX TO FILE NAME EXTENSIONS
;
; RESET FILE TYPE
;
XOR A ;RESET FILTYP
LD (FILTYP),A
;
; INITIALIZE TERMINAL
;
LD HL,ITRMST ;POINT TO TERMINAL INITIALIZATION STRING
CALL PCSTR ; FOR HOME, CLEAR SCREEN AND PRINT IT
;
; INITIALIZE TERMINAL RELATED COUNTERS
;
LD A,(CPMLPP) ;INITIALIZE LINES/PAGE (EXCLUDING STATUS LINE)
DEC A ;COUNTER (MORCNT) =(CPMLPP)-1
LD (MORCNT),A ; WHICH TELLS THE PROGRAM WHEN TO PRINT ....MORE....
XOR A ;A<=0
LD (NCHARS),A ;RESET (NCHARS)
LD HL,CHARS ;SET UP CHARACTERS/LINE
LD (CHRPNT),HL
;
; GET THE FIRST SECTOR OF ZCODE
;
LD HL,(ZCODEP) ;^ TOP OF ZCODE BUFFER
XOR A
CALL GETDSK ;READ IN FIRST SECTION
;
; EXTRACT GAME DATA FROM ZCODE HEADER
;
LD HL,(ZCODEP) ;HL ^ TOP OF ZCODE BUFFER
LD DE,ZENDLD ;DE <= OFFSET TO NON-PRELOADED ZCODE
ADD HL,DE ;HL ^ START OF NON-PRELOADED ZCODE
LD D,(HL) ;GET MSB OF ENDLOAD POINTER
INC HL ; ADD 1
LD E,(HL) ;GET LSB OF ENDLOAD POINTER
LD HL,200H ;HL <= 256
ADD HL,DE ;HL <= ENDLOAD POINTER + 200H
LD A,H ;A <= MSB
AND 0FEH ;
LD H,A ;
LD L,0 ;
DEC HL ;ALL THIS TO GET TO BLOCK BOUNDRY
EX DE,HL ;DE <= CORRECTED ENDLOAD POINTER
LD BC,ZENDLD ;BC <= OFFSET TO NON-PRELOADED ZCODE
LD HL,(ZCODEP) ;HL ^ TOP OF ZCODE BUFFER
ADD HL,BC ;HL ^ START OF NON-PRELOADED ZCODE
LD (HL),D ;SAVE MSB OF CORRECTED ENDLOAD POINTER
INC HL
LD (HL),E ;SAVE LSB OF CORRECTED ENDLOAD POINTER
LD HL,(ZCODEP) ;HL ^ TOP OF ZCODE BUFFER
PUSH DE ;SAVE CORRECTED ENDLOAD POINTER ON STACK
ADD HL,DE ;HL ^ END OF PRELOAD
EX DE,HL ;DE ^ END OF PRELOAD
CALL MEMTOP ;DETERMINE WHERE THE TOP OF MEMORY IS (IN HL)
EX DE,HL ;DE <= TOP OF MEMORY, HL <= END OF THE PRELOAD
CALL HLGEDE ;CARRY FLAG SET IF HL G.E. DE
POP DE ;RESTORE CORRECTED ENDLOAD POINTER
CALL C,ZER ;NO ROOM FOR ANY BUFFERS
LD A,D
RRCA
AND 7FH
LD D,A ;NUMBER OF PAGES IN REST OF THE PRELOAD
INC A
LD (ZMEMT),A ;PAGE NUMBER
LD HL,(ZCODEP) ;^ START OF ZCODE BUFFER
LD BC,200H
LD E,0
;
; LOAD PRELOAD
;
START2: LD A,D ;A <= PAGES REMAINING TO BE LOADED
OR A ;DONE?
JP Z,START3 ; YES.
DEC D
ADD HL,BC
INC E
LD A,E
PUSH BC
PUSH DE
PUSH HL
CALL GETDSK
POP HL
POP DE
POP BC
JP START2
START3: LD HL,(ZCODEP)
EX DE,HL
LD HL,ZSWAP
ADD HL,DE
LD A,(HL)
AND 1
CALL NZ,ZER ;SWAPPED
LD HL,ZSTART+1
ADD HL,DE
LD A,(HL)
LD (ZPCL),A
DEC HL
LD A,(HL)
AND 1
LD (ZPCL+1),A
LD A,(HL)
RRCA
AND 7FH
LD (ZPCH),A
LD HL,ZGLOBA
ADD HL,DE ;GET RELATIVE ADDRESS OF GLOBAL TABLE
PUSH DE
LD D,(HL)
INC HL
LD E,(HL)
EX DE,HL
POP DE
ADD HL,DE ;REAL ADDRESS OF GLOBAL TABLE
LD (GLOBAL),HL ;STORE IT
LD HL,ZFWORD
ADD HL,DE ;GET RELATIVE ADDRESS OF FWORDS TABLE
PUSH DE
LD D,(HL)
INC HL
LD E,(HL)
EX DE,HL
POP DE
ADD HL,DE ;REAL ADDRESS OF FWORDS TABLE
LD (FWORDS),HL ;STORE IT
LD HL,ZENDLD ;CALCULATE ^ TO BEGINNING OF PAGE BUFFERS
ADD HL,DE
PUSH DE
LD D,(HL)
INC HL
LD E,(HL)
POP HL
ADD HL,DE
INC HL
LD (PGBUFP),HL ;STORE IT
DEC HL ;CALCULATE NO. OF AVAILABLE PAGES
EX DE,HL ;TOP LOCATION
CALL MEMTOP
LD A,H
SUB D
RRCA
AND 7FH ;SWAPPING SPACE
CP MAXPGS
JP C,STAR3A
LD A,MAXPGS
STAR3A: LD (NPGS),A ;SAVE NUMBER OF PAGES
DEC A
LD (PGBOT),A
LD HL,PGTBLF
CALL HLOFF
LD (HL),0FFH ;SET LAST PAGE
;
; INITIALIZE RANDOM NUMBER
;
LD B,5
LD HL,0FFFFH
LD (SHIFT),HL
LD (SHIFT+2),HL
LD HL,RDFLG ;ET FLAG TO 1ST READ
LD (HL),0
START4: CALL RND
DEC B
JP NZ,START4
;
;
;
XOR A
LD (NOLPT),A ;USE LPT
LD HL,(ZCODEP)
LD DE,ZSWAP
ADD HL,DE
LD A,(HL)
LD B,A
LD A,(BSTLIN) ;IS THERE A STATUS LINE?
OR A
LD A,B
JP NZ,START5
OR ZSTATB ;INDICATE NO STATUS LINE
START5: LD (HL),A
; JP MLOOP ;COMMENTED OUT FOR FALL THROUGH
;
; **********************************************************************
; * *
; * MAINLOOP *
; * *
; **********************************************************************
;
;
;MAIN LOOP, READ AN INSTRUCTION AND ITS ARGS, THEN DISPATCH
MLOOP: XOR A
LD (ARGCNT),A ;ZERO ARG COUNT
CALL NEXTPC ;GET NEXT OPCODE IN A
LD (OPCODE),A ;SAVE IT
CP 128
JP C,OP2 ;2-OP
CP 176
JP C,OP1 ;1-OP
CP 192
JP C,OP0 ;0-OP
;
; HANDLE AN X-OP
;
OPEXT: CALL NEXTPC ;GET VAR TYPES, THIS IS AN EXT OP
LD DE,ARG1
LD B,4 ;MAX NUMBER OF ARGS
LD C,A
OPEXTL: PUSH BC
PUSH DE
LD A,C
AND 0C0H ;ISOLATE BIT7, BIT6 TO DETERMINE ARG TYPE
CALL Z,GETLNG ;00=LONG IMMEDIATE
CP 80H
CALL Z,GETVAR ;10=VARIABLE
CP 40H
CALL Z,GETSHT ;01=SHORT IMMEDIATE
POP DE
POP BC
CP 0C0H ;11=NO MORE VARIABLES
JP Z,OPEXTF ;ALL DONE?
EX DE,HL ;NO. STORE VALUE
LD (HL),E
INC HL
LD (HL),D
INC HL
EX DE,HL ;POINTER BACK IN DE
LD HL,ARGCNT
INC (HL) ;ONE MORE ARG
LD A,C
RLCA
RLCA ;GET TO NEXT ARG TYPE
LD C,A
DEC B ;DECREMENT ARG COUNT
JP NZ,OPEXTL ;LOOP FOR MORE
;
; DISPATCH THE X-OP
;
OPEXTF: LD HL,OPEXTT ;COMPUTE DISPATCH POINTER
LD A,(OPCODE) ;RETRIEVE THE OPCODE
CP 224 ;IS IT AN EXTENDED 2-OP?
JP C,OP2EX ; YES.
SUB 224 ; NO.
CP OPEXTM ;IS IT A LEGAL X-OP?
JP NC,BADOP ; NO.
;
; GENERALIZED DISPATCH
;
OPDSPH:
ADD A,A ;FORM A WORD OFFSET (*2)
LD C,A ;PUT OFFSET INTO BC
LD B,0
ADD HL,BC ;ADD OFFSET TO DISPATCH POINTER
LD E,(HL) ;ADDRESS LSB
INC HL
LD D,(HL) ;ADDRESS MSB
LD HL,(ARG1) ;FIRST ARG
EX DE,HL ;HL ^ TABLE ADDRESS OF ROUTINE
; DE <= FIRST ARG
LD A,(ARGCNT) ;B <= ARG COUNT
LD B,A
JP (HL) ;GO TO IT
;
; HANDLE A 0-OP
;
OP0: SUB 176 ;ADJUST VALUE
CP OP0M ;IS IT A LEGAL 0-OP?
JP NC,BADOP ; NO.
LD HL,OP0T ; YES. HL ^ 0-OP TABLE
JP OPDSPH ;DISPATCH IT
;
; HANDLE A 1-OP
;
OP1: AND 30H ;1 OP, ISOLATE BITS 5,4
CALL Z,GETLNG ;00=LONG IMMEDIATE
CP 10H
CALL Z,GETSHT ;01=SHORT IMMEDIATE
CP 20H
CALL Z,GETVAR ;10=VARIABLE
LD A,1
LD (ARGCNT),A ;1 ARG
LD (ARG1),HL ;STORE IT
LD A,(OPCODE) ;RESTORE OPCODE
AND 0CFH ;(NOT 30H) TURN OFF MODE BITS
SUB 128 ;ADJUST VALUE
CP OP1M ;LEGAL 1-OP?
JP NC,BADOP ; NO.
LD HL,OP1T ; YES. HL ^ 1-OP TABLE
JP OPDSPH ;DISPATCH IT
;
; HANDLE A 2-OP
;
OP2: AND 40H ;ISOLATE 1ST. ARG BIT
CALL NZ,GETVAR ;1=VARIABLE
CALL Z,GETSHT ;0=SHORT IMMEDIATE
LD (ARG1),HL ;STORE ARG1
LD A,(OPCODE) ;RESTORE OPCODE
AND 20H ;ISOLATE 2ND. ARG BIT
CALL NZ,GETVAR ;1=VARIABLE
CALL Z,GETSHT ;2=SHORT IMMEDIATE
LD (ARG2),HL ;STORE ARG 2
LD A,2
LD (ARGCNT),A ;TWO ARGS
LD A,(OPCODE) ;RESTORE OPCODE
OP2EX: AND 1FH ;(NOT 0E0H) TURN OFF MODE BITS
CP OP2M ;LEGAL 2-OP?
JP NC,BADOP ; NO.
LD HL,OP2T ; YES. HL ^ 2-OP TABLE
JP OPDSPH ;DISPATCH IT
;
;*************************************
;* OPCODE ARGUMENT FETCH SUBROUTINES *
;*************************************
;
; -----------------------
; FETCH A SHORT IMMEDIATE
; -----------------------
GETSHT: PUSH AF ;SAVE OPCODE
CALL NEXTPC ;GET NEXT ZBYTE
LD L,A ;MAKING IT THE LSB OF ARGUMENT
LD H,0 ;MSB IS 0
POP AF ;RESTORE OPCODE
RET
; ----------------------
; FETCH A LONG IMMEDIATE
; ----------------------
GETLNG: PUSH AF ;SAVE OPCODE
CALL NEXTPC ;GET NEXT ZBYTE
LD H,A ;MAKING IT THE MSB OF ARGUMENT
PUSH HL ;SAVE IT ON THE STACK
CALL NEXTPC ;GET NEXT ZBYTE
POP HL ;RESTORE MSB OF ARGUMENT
LD L,A ;AND FILL IN LSB OF ARGUMENT
POP AF ;RESTORE OPCODE
RET
; ----------------
; FETCH A VARIABLE
; ----------------
GETVAR: PUSH AF ;GET VAR, FIRST FIND TYPE
CALL NEXTPC
OR A
JP Z,GETVRS ;FROM STACK
GETVR1: CP 16
JP NC,GETVRG ;GLOBAL
GETVRL: DEC A ;LOCAL
ADD A,A
LD E,A
LD D,0
LD HL,LOCALS
GETVL1: ADD HL,DE ;POINTER TO VARIABLE
LD D,(HL)
INC HL
LD E,(HL)
EX DE,HL ;RETURN VALUE IN HL
POP AF
RET
;
GETVRG: SUB 16
LD E,A ;GET GLOBAL
LD D,0
LD HL,(GLOBAL)
ADD HL,DE ;PRE ADD SO IT GETS DONE TWICE
JP GETVL1
;
GETVRS: CALL POPSTK ;VAR FROM STACK
POP AF
RET
;
;*********************
;* MISC. SUBROUTINES *
;*********************
RET0: XOR A ;RETURN 0
PUTBYT: LD L,A
LD H,0
PUTVAL: CALL PUTVLC ;STORE VALUE
JP MLOOP
;
PUTVLC: PUSH HL ;SAVE VALUE
CALL NEXTPC ;GET TYPE
POP HL
PUTVR1: OR A
JP Z,PSHSTK ;SAVE ON STACK AND RETURN
EX DE,HL ;VALUE IN DE
CP 16
JP NC,PUTVLG ;GLOBAL
PUTVLL: DEC A ;LOCAL
ADD A,A
LD C,A
LD B,0
LD HL,LOCALS
PUTVL1: ADD HL,BC ;COMPUTE ADDRESS
LD (HL),D
INC HL
LD (HL),E
RET
;
PUTVLG: SUB 16
LD C,A ;STORE GLOBAL
LD B,0
LD HL,(GLOBAL) ;GLOBAL POINTER
ADD HL,BC ;PRE ADD
JP PUTVL1
;
;*********************
;* DATA MANIPULATION *
;*********************
;
; -----------------
; RECALL A VARIABLE
; -----------------
VARGET: PUSH AF ;SAVE OPCODE
OR A ;IF NON-ZERO
JP NZ,GETVR1 ; THEN GET A VARIABLE FROM LOCAL OR GLOBAL TABLE
; ELSE TAKE VAR OFF STACK
VARGTS: POP AF ;RESTORE OPCODE
CALL POPSTK ;POP A WORD FROM ZSTACK
JP PSHSTK ;PUT IT BACK AND RETURN THE VALUE IN HL
; ----------------
; STORE A VARIABLE
; ----------------
VARPUT: OR A ;IF NON-ZERO
JP NZ,PUTVR1 ; THEN PUT A VARIABLE IN LOCAL OR GLOBAL TABLE
; ELSE REPLACE A WORD ON Z-STACK
VARPTS: PUSH HL ;SAVE NEW VALUE
CALL POPSTK ;POP OLD WORD OFF Z-STACK
POP HL ;RESTORE NEW VALUE
JP PSHSTK ;AND PUSH IT ON TOP OF ZSTACK
;
;************************
;* PREDICATE PROCESSING *
;************************
;
; ---------------
; PREDICATE FAILS
; ---------------
PREDF: CALL NEXTPC ;FETCH NEXT BYTE OF ZCODE
OR A
JP P,PREDB ;BRANCH IF < 128
PREDNB: AND 40H ;CHECK FOR MULTI BYTE HACK
CALL Z,NEXTPC ;GET NEXT BYTE IF SO
JP MLOOP ;CONTINUE IN SEQUENCE
; ------------------
; PREDICATE SUCCEEDS
; ------------------
PREDS: CALL NEXTPC ;FETCH NEXT BYTE OF ZCODE
OR A ;IF BIT 7 IS NOT SET
JP P,PREDNB ;BRANCH ON PREDICATE FAILURE
; ELSE FALL THROUGH TO PREDB
; ----------------
; PERFORM A BRANCH
; ----------------
PREDB: LD B,A ;SAVE OPCODE
AND 40H ;LONG BRANCH?
JP Z,PREDLB ; YES. (BIT 6 WAS OFF)
; NO. SHORT BRANCH
LD A,B ;RESTORE OPCODE
AND 3FH ;FORM SHORT OFFSET
LD C,A ;USE AS LSB OF BRANCH OFFSET
LD B,0 ;ZERO MSB OF OFFSET
JP PREDB1 ;SIMULATE LONG BRANCH TO A CLOSE PLACE
;
; HANDLE A LONG BRANCH
PREDLB: LD A,B ;RESTORE OPCODE
AND 3FH ;FORM MSB OF OFFSET
LD B,A ;B <= MSB OF OFFSET
PUSH BC
CALL NEXTPC ;GET SECOND BYTE
POP BC
LD C,A ;C <= LSB OF OFFSET
LD A,B ;A <= MSB OF OFFSET
AND 20H ;CHECK SIGN OF 14 BIT VALUE
JP Z,PREDB1 ;POSITIVE
LD A,B ;ELSE EXTEND THE SIGN (A <= MSB)
OR 0C0H ;AND MAKE THE FULL WORD NEG
LD B,A ;SAVE THE RESULT IN B
;
; BRANCH TO THE Z-ADDRESS AT $(ZPC) + OFFSET (IN BC)
; (ZPC RELATIVE ADDRESSING)
PREDB1: LD A,B
OR C ;IS OFFSET=0?
JP Z,RFALSE ; YES. DO AN RFALSE
DEC BC
LD A,B
OR C ;WAS OFFSET=1
JP Z,RTRUE ; YES. DO AN RTRUE
PREDB3: DEC BC ;2 NOW SUBTRACTED FROM JUMP ADDRESS
LD H,B ;HL <= JUMP ADDRESS
LD L,C
LD (ZPCOFF),HL ;ZPCOFF <= JUMP ADDRESS
LD HL,(ZPCL) ;HL <= LOW ORDER 9 BITS OF ZIP PROGRAM COUNTER
LD E,C ;E <= LSB OF JUMP ADDRESS
LD A,B ;A <= MSB OF JUMP ADDRESS
AND 1
LD D,A ;ZPCL ADDER
LD A,B ;ARITHMETICALLY SHIFT B RIGHT 1
RLCA ;FIRST SET CARRY
LD A,B
RRA
LD B,A ;CUTE
ADD HL,DE
LD A,H
AND 2
JP Z,PREDB2 ;NO OVERFLOW
DEC H
DEC H ;OVERFLOW
INC B
PREDB2: LD (ZPCL),HL ;STORE LOW BYTES
LD HL,ZPCH ;MODIFY UPPER
LD A,B
OR A
JP Z,PREDB4 ;NO CHANGE IN PACE, DO FASTER JUMP
ADD A,(HL)
LD (HL),A
XOR A
LD (ZPCFLG),A ;CHANGED PAGES
JP MLOOP ;FINISHED
;
PREDB4: LD HL,(ZPCPNT)
EX DE,HL
LD HL,(ZPCOFF)
ADD HL,DE ;CALCULATE NEW PC POINTER
LD (ZPCPNT),HL
JP MLOOP
;
; **********************************************************************
; * *
; * OPCODE PROCESSING SECTION *
; * *
; **********************************************************************
;
; ****************************
; * DISPATCH TABLES *
; ****************************
;
; -----
; 0-OPS
; -----
OP0T: DW RTRUE ;0
DW RFALSE ;1
DW PRINTI ;2
DW PRINTR ;3
DW ZNOP ;4
DW ZSAVE ;5
DW ZRSTOR ;6
DW ZRSTAR ;7
DW RSTACK ;8
DW FSTACK ;9
DW ZQUIT ;10
DW CRLF ;11
DW USL ;12
DW VERIFY ;13
OP0M EQU ($-OP0T)/2 ;NUMBER OF 0-OPS
;
; -----
; 1-OPS
; -----
OP1T: DW ZEROQ ;0
DW NEXTQ ;1
DW FIRSTQ ;2
DW LOC ;3
DW PTSIZE ;4
DW INC ;5
DW DEC ;6
DW PRINTB ;7
DW BADOP ;8 (UNDEFINED)
DW REMOVE ;9
DW PRINTD ;10
DW RETURN ;11
DW JUMP ;12
DW PRINT ;13
DW VALUE ;14
DW BCOM ;15
OP1M EQU ($-OP1T)/2 ;NUMBER OF 1-OPS
;
; -----
; 2-OPS
; -----
OP2T: DW BADOP
DW EQUALQ
DW LESSQ
DW GRTRQ
DW DLESSQ
DW IGRTRQ
DW INQ
DW BTST
DW BOR
DW BAND
DW FSETQ
DW FSET
DW FCLEAR
DW ZSET
DW MOVE
DW GET
DW GETB
DW GETP
DW GETPT
DW NEXTP
DW ZADD
DW ZSUB
DW MUL
DW DIV
DW ZMOD
OP2M EQU ($-OP2T)/2
;
; -----
; X-OPS
; -----
OPEXTT: DW ZCALL
DW PUT
DW PUTB
DW PUTP
DW ZREAD
DW PRINTC
DW PRINTN
DW RANDOM
DW ZPUSH
DW ZPOP
OPEXTM EQU ($-OPEXTT)/2
; **********************************************************************
; * *
; * ZCODE EXECUTION ROUTINES *
; * *
; **********************************************************************
;
; *******************
; * 0-OPS *
; *******************
;
;
; ----------
; RTRUE [0]
; ----------
; SIMULATE A RETURN 1
RTRUE: LD HL,1
RTRUE1: LD (ARG1),HL
JP RETURN
;
; -----------
; RFALSE [1]
; -----------
; SIMULATE A RETURN 0
RFALSE: LD HL,0
JP RTRUE1
;
; -----------
; PRINTI [2]
; -----------
; PRINT THE Z-STRING IMMEDIATELY FOLLOWING THE OPCODE
PRINTI: CALL PRNTI1
JP MLOOP
;
PRNTI1: LD HL,(ZPCL)
LD (MPCL),HL ;SET UP MPC TO EQUAL ZPC
LD A,(ZPCH)
LD (MPCH),A
XOR A
LD (MPCFLG),A ;ZERO MPC FLAG
CALL PZSTR ;PRINT THE STRING
LD HL,(MPCL) ;NOW CHANGE BACK ZPC TO END OF STRING
LD (ZPCL),HL
LD A,(MPCH)
LD (ZPCH),A
LD A,(MPCFLG)
LD (ZPCFLG),A ;UPDATE FLAG
LD HL,(MPCPNT)
LD (ZPCPNT),HL ;AND PAGE POINTER
RET
;
; -----------
; PRINTR [3]
; -----------
; EXECUTE A PRINTI, FOLLOWED BY A CRLF, AND A RTRUE
PRINTR: CALL PRNTI1
CALL PCRLF
JP RTRUE
;
; ---------
; ZNOP [4]
; ---------
; EXECUTE A NOP
ZNOP: JP MLOOP
;
; ----------
; ZSAVE [5]
; ----------
; SAVE GAME
ZSAVE: JP SAVE ;MACHINE DEPENDENT
;
; -----------
; ZRSTOR [6]
; -----------
; RESTORE SAVED GAME
ZRSTOR: JP RESTOR ;MACHINE DEPENDENT
;
; -----------
; ZRSTAR [7]
; -----------
; RESTART GAME
ZRSTAR: JP RESTAR ;MACHINE DEPENDENT
;
; -----------
; RSTACK [8]
; -----------
; EXECUTE A RETURN WITH CALL VALUE ON TOP OF THE STACK
RSTACK: CALL POPSTK
LD (ARG1),HL
JP RETURN
;
; -----------
; FSTACK [9]
; -----------
FSTACK: CALL POPSTK
JP MLOOP
;
; -----------
; ZQUIT [10]
; -----------
ZQUIT: JP QUIT ;MACHINE DEPENDENT
;
; ----------
; CRLF [11]
; ----------
; PRINT CARRIAGE RETURN/LINE FEED
CRLF: CALL PCRLF
JP MLOOP
;
; ---------
; USL [12]
; ---------
; UPDATE STATUS LINE
USL: CALL WHOLIN
JP MLOOP
;
; ------------
; VERIFY [13]
; ------------
; VERIFY THE GAME CODE
VERIFY: LD A,1 ;SELF CHECK
LD (VERF),A ;IN VERIFY MODE, ALWAYS GET NEW PAGE
LD HL,VRS
CALL MSGOUT ;OUTPUT LAST UPDATE
LD HL,VRLINE
CALL MSGOUT ;OUTPUT VERSION
LD HL,(ZCODEP) ;^ TOP OF ZCODE
LD DE,ZCKLEN
ADD HL,DE
LD D,(HL)
INC HL
LD E,(HL)
LD HL,-32
ADD HL,DE
EX DE,HL ;DE HAVE COUNT
LD BC,0 ;SUM IN BC
LD HL,32*2
CALL SETWRD
VERIFL: PUSH BC
PUSH DE
CALL GETWRD ;GUARENTEED TO GET FRESH WORD
POP DE
POP BC
LD A,H
LD H,0
ADD HL,BC
CALL HLOFF
LD B,H
LD C,L ;TOTAL IN BC
DEC DE
LD A,D
OR E
JP NZ,VERIFL ;SUM ALL BYTES
LD DE,ZCKSUM
LD HL,(ZCODEP)
ADD HL,DE
LD D,(HL)
INC HL
LD E,(HL) ;GET CHECKSUM
LD H,B
LD L,C
XOR A
LD (VERF),A
CALL HLGEDE ;COMPARE CALCULATED WITH ACTUAL
JP Z,PREDS
JP PREDF ;FAIL IF DIFFERENT
;
; *******************
; * 1-OPS *
; *******************
;
; ----------
; ZERO? [0]
; ----------
; IS ARG1 EQUAL TO ZERO? [PRED]
ZEROQ: LD HL,(ARG1)
LD A,H
OR L
JP Z,PREDS
JP PREDF
;
; ----------
; NEXT? [1]
; ----------
; RETURN THE NEXT POINTER IN OBJRCT "ARG1"; FAIL IF
; NONE LEFT, AND RETURN ZERO [VALUE][PRED]
NEXTQ: LD A,(ARG1)
CALL OBJLOC
LD DE,5
JP FRSTQ1 ;SAME AS FIRST?
;
; -----------
; FIRST? [2]
; -----------
; RETURN THE FIRST POINTER IN OBJECT "ARG1"; FAIL IF
; NONE, AND RETURN ZERO [VALUE][PRED]
;
FIRSTQ: LD A,(ARG1)
CALL OBJLOC
LD DE,6
FRSTQ1: ADD HL,DE
LD A,(HL)
PUSH AF ;SAVE VALUE
LD L,A
LD H,0
CALL PUTVLC ;STORE VALUE
POP AF
OR A
JP NZ,PREDS ;FOUND FIRST
JP PREDF ;FIRST NOT FOUND
;
; --------
; LOC [3]
; --------
; RETURN THE OBJECT CONTAINING OBJECT "ARG1"; ZERO IF NONE [VALUE]
LOC: LD A,(ARG1)
CALL OBJLOC
LD DE,4
ADD HL,DE
LD L,(HL)
LD H,0
JP PUTVAL
;
; -----------
; PTSIZE [4]
; -----------
; RETURN LENGTH OF PROP TABLE "ARG1" IN BYTES [VALUE]
PTSIZE: LD HL,(ARG1)
EX DE,HL
LD HL,(ZCODEP)
ADD HL,DE ;POINTER TO PROP ENTRY
DEC HL
CALL PROPL
INC A
JP PUTBYT
;
; --------
; INC [5]
; --------
; INCREMENT ARG1 [VALUE]
INC: CALL INC1
JP MLOOP
;
; --------
; DEC [6]
; --------
; DECREMENT ARG1 [VALUE]
DEC: CALL DEC1
JP MLOOP
;
INC1: LD A,(ARG1)
CALL VARGET
INC HL
INC2: PUSH HL
CALL VARPUT
POP HL
RET
;
DEC1: LD A,(ARG1)
CALL VARGET
DEC HL
JP INC2
;
; -----------
; PRINTB [7]
; -----------
; PRINT THE STRING POINTED TO BY BYTE POINTER ARG1
PRINTB: LD HL,(ARG1)
PRINT2: CALL SETWRD
JP PRINT1
;
; ----------
; BADOP [8]
; ----------
BADOP: JP MLOOP
;
; -----------
; REMOVE [9]
; -----------
; MOVE OBJECT [ARG1] TO PSEUDO-OBJECT #0
REMOVE: CALL REMOVC
JP MLOOP
;
REMOVC: LD A,(ARG1)
LD B,A ;SAVE IT
CALL OBJLOC
EX DE,HL ;SAVE IN DE
LD HL,4
ADD HL,DE
LD A,(HL)
OR A
RET Z ;NO OBJECT
PUSH DE ;SAVE VALUE
CALL OBJLOC ;PARENT OBJECT
LD DE,6
EX DE,HL ;LP IN D
ADD HL,DE
LD C,(HL) ;SIBL
LD A,B
CP C
JP NZ,REMVC1 ;NOT SAME
POP HL
PUSH HL ;L1
LD BC,5
ADD HL,BC
LD A,(HL)
LD HL,6 ;PARENT'S FIRST SLOT GETS LOC SLOT
ADD HL,DE
LD (HL),A
JP REMVC2
REMVC1: LD A,C ;GET SIBL
CALL OBJLOC
LD DE,5
ADD HL,DE
LD D,H
LD E,L ;SAVE LS+5
LD C,(HL) ;NEW SIBL
LD A,B
CP C
JP NZ,REMVC1 ;NOT END OF CHAIN
LD BC,5
POP HL
PUSH HL
ADD HL,BC ;OLD NEXT
LD A,(HL)
LD (DE),A
REMVC2: POP HL
LD DE,4
ADD HL,DE
LD (HL),0
INC HL
LD (HL),0
RET
; ------------
; PRINTD [10]
; ------------
; PRINT SHORT DESCRIPTION OF OBJECT [ARG1]
PRINTD: LD A,(ARG1)
CALL PRNTDC
JP MLOOP
;
PRNTDC: CALL OBJLOC
LD DE,7
ADD HL,DE
LD D,(HL)
INC HL
LD E,(HL)
EX DE,HL
INC HL
CALL SETWRD
JP PZSTR
;
; ------------
; RETURN [11]
; ------------
; RETURN FROM A CALL WITH VALUE ARG1
RETURN: LD HL,(OZSTKP) ;RESET STACK FROM CALL
LD (ZSTAKP),HL
LD A,(OZSTKC)
LD (ZSTAKC),A
CALL POPSTK ;RESET Z-STACK
LD A,L
LD (ZPCH),A ;SAVE UPPER PC
LD B,H ;H HAS NUMBER OF LOCALS
LD A,H
ADD A,A ;WORD
JP Z,RET2 ;NO LOCALS
LD HL,LOCALS-2
CALL HLOFF ;POSITION HL TO RESTORE LOCALS
RET1: EX DE,HL
CALL POPSTK ;GET THE LOCAL, REVERSE ORDER FIRST
EX DE,HL
LD (HL),D
INC HL
LD (HL),E
DEC HL ;NOW BACK UP ONE ELEMENT
DEC HL
DEC HL
DEC B
JP NZ,RET1 ;LOOP
RET2: CALL POPSTK
LD (ZPCL),HL ;REST OF PC
CALL POPSTK
LD (OZSTKP),HL
CALL POPSTK
LD A,L
LD (OZSTKC),A ;RESTORE OLD VALUES
XOR A
LD (ZPCFLG),A ;PC CHANGED
LD HL,(ARG1) ;ARGUMENT TO BE RETURNED
JP PUTVAL ;STORE AND RETURN
;
; ----------
; JUMP [12]
; ----------
; BRANCH TO Z-LOCATION POINTED TO BY 16-BIT 2'S COMPLIMENT ARG1
JUMP: LD HL,(ARG1) ;RELATIVE JUMP
LD B,H
LD C,L
DEC BC
JP PREDB3 ;TREAT AS A SUCCESSFUL JUMP
;
; -----------
; PRINT [13]
; -----------
; PRINT THE Z-STRING POINTED TO BY THE WORD-POINTER ARG1
PRINT: LD HL,(ARG1) ;TELL SETSTR WHERE THE STRING
CALL SETSTR ;RESIDES AND
PRINT1: CALL PZSTR ;PRINT THE STRING
JP MLOOP
;
; -----------
; VALUE [14]
; -----------
; RETURN VALUE OF ARG1 [VALUE]
VALUE: LD A,(ARG1)
CALL VARGET
JP PUTVAL
;
; ----------
; BCOM [15]
; ----------
; COMPLIMENT ARG1 [VALUE]
BCOM: LD HL,(ARG1)
LD A,H
CPL
LD H,A
LD A,L
CPL
LD L,A
JP PUTVAL
;
; *******************
; * 2-OPS *
; *******************
;
; ----------
; LESS? [0]
; ----------
; IS ARG1 LESS THAN ARG2? [PRED]
LESSQ: CALL GETARG
EX DE,HL
CALL SHLGED
JP NC,PREDS
JP PREDF
;
; ----------
; GRTR? [1]
; ----------
; IS ARG1 GREATER THAN ARG2? [PRED]
GRTRQ: CALL GETARG
CALL SHLGED
JP NC,PREDS
JP PREDF
;
; -----------
; DLESS? [2]
; -----------
; DECREMENT ARG1: SUCCEED IF ARG1 (-1) IS LESS THAN ARG2 [PRED]
DLESSQ: CALL DEC1
EX DE,HL
LD HL,(ARG2)
EX DE,HL
JP IGRTQ1
;
; -----------
; IGRTR? [3]
; -----------
; INCREMENT ARG1: SUCCEED IF ARG1 (+1) IS GREATER THAN ARG2 [PRED]
IGRTRQ: CALL INC1
EX DE,HL
LD HL,(ARG2)
IGRTQ1: CALL SHLGED
JP NC,PREDS
JP PREDF
;
; ----------
; IN? [4]
; ----------
; IS OBJECT [ARG1] CONTAINED IN OBJECT [ARG2] [PRED]
INQ: LD A,(ARG1)
CALL OBJLOC
LD DE,4
ADD HL,DE
LD A,(ARG2)
CP (HL)
JP Z,PREDS ;SUCCESS IF OBJ 2 IN 1
JP PREDF
;
; ---------
; BTST [5]
; ---------
; IS EVERY "ON" BIT IN ARG1 ALSO "ON" IN ARG2 [PRED]
BTST: CALL GETARG
LD A,H
AND D
LD D,A
LD A,L
AND E
LD E,A
CALL HLGEDE
JP Z,PREDS
JP PREDF
;
; --------
; BOR [6]
; --------
; RETURN BITWISE OR OF ARG1 AND ARG2 [VALUE]
BOR: CALL GETARG
LD A,D
OR H
LD H,A
LD A,E
OR L
LD L,A
JP PUTVAL
;
; ---------
; BAND [7]
; ---------
; RETURN BITWISE AND OF ARG1 AND ARG2 [VALUE]
BAND: CALL GETARG
LD A,H
AND D
LD H,A
LD A,L
AND E
LD L,A
JP PUTVAL
;
; ----------
; FSET? [8]
; ----------
; IS FLAG "ARG2" SET IN OBJECT "ARG1"? [PRED]
FSETQ: CALL FLAGSU ;GET BIT
LD A,D
AND B
LD D,A
LD A,E
AND C
OR D ;CHECK FOR ON
JP NZ,PREDS ;BIT ON
JP PREDF ;BIT OFF
;
; ---------
; FSET [9]
; ---------
; SET FLAG "ARG2" IN OBJECT "ARG1"
FSET: CALL FLAGSU
LD A,D
OR B
LD (HL),A
INC HL
LD A,E
OR C
LD (HL),A
JP MLOOP
;
; ------------
; FCLEAR [10]
; ------------
; CLEAR FLAG "ARG2" IN OBJECT "ARG1"
FCLEAR: CALL FLAGSU
LD A,B
CPL
AND D
LD (HL),A
INC HL
LD A,C
CPL
AND E
LD (HL),A
JP MLOOP
;
; ---------
; SET [11]
; ---------
; SET VARIABLE "ARG1" EQUAL TO VALUE "ARG2"
ZSET: LD A,(ARG1)
LD HL,(ARG2)
VARPTR: CALL VARPUT
JP MLOOP
;
; ----------
; MOVE [12]
; ----------
; PUT OBJECT "ARG1" INTO OBJECT "ARG2"
MOVE: CALL REMOVC ;REMOVE OBJECT FIRST
LD A,(ARG1)
CALL OBJLOC
PUSH HL ;SAVE LOC OF FIRST ARG
LD DE,4
ADD HL,DE ;LOC SLOT
LD A,(ARG2)
LD (HL),A
CALL OBJLOC
LD DE,6
ADD HL,DE ;FIRST SLOT
LD B,(HL)
LD A,(ARG1)
LD (HL),A
POP HL
LD A,B
OR A
JP Z,MLOOP
LD DE,5
ADD HL,DE
LD (HL),A ;NEXT SLOT
JP MLOOP
;
; ---------
; GET [13]
; ---------
; RETURN VALUE OF ITEM "ARG2" IN WORD-TABLE AT "ARG1"
GET: LD HL,(ARG2)
ADD HL,HL ;ITEM NUMBER*2
EX DE,HL
LD HL,(ARG1)
ADD HL,DE ;POINTER TO ITEM
CALL SETWRD
CALL GETWRD ;GET VALUE
JP PUTVAL
;
; ----------
; GETB [14]
; ----------
; RETURN VALUE OF ITEM "ARG2" IN BYTE-TABLE AT "ARG1" [VALUE]
GETB: LD HL,(ARG2)
EX DE,HL
LD HL,(ARG1)
ADD HL,DE
CALL SETWRD
CALL GETBYT
LD L,A
LD H,0
JP PUTVAL
;
; ----------
; GETP [15]
; ----------
; RETURN PROP "ARG2" OF OBJECT "ARG1"; IF SPECIFIED PROP DOES
; NOT EXIST, RETUURN PROP'TH ELEMENT OF DEFAULT OBJECT [VALUE]
GETP: CALL PROPB ;GET POINTER TO PROPS IN PROP TABLE
GETP1: CALL PROPN
LD B,A
LD A,(ARG2)
CP B
JP Z,GETP2 ;FOUND PROP
JP NC,GETP3 ;GET PROP FROM DEFAULT TABLE
CALL PROPNX ;TRY AGAIN WITH NEXT PROP
JP GETP1
GETP3: LD HL,(ZCODEP)
LD DE,ZOBJEC
ADD HL,DE
LD D,(HL)
INC HL
LD E,(HL)
LD HL,(ZCODEP)
ADD HL,DE ;BEG OF OBJECT TABLE
LD A,(ARG2)
ADD A,A
CALL HLOFF
DEC HL
LD E,(HL)
DEC HL
LD D,(HL)
EX DE,HL
JP PUTVAL ;RETURN DEFAULT VALUE
GETP2: CALL PROPL ;GET LENGTH
INC HL
DEC A
JP M,GETP2A ;1 BYTE
CALL NZ,ZER ;BAD PROP LENGTH
LD D,(HL)
INC HL
LD E,(HL)
EX DE,HL
JP PUTVAL ;RETURN TWO BYTE PROP
GETP2A: LD L,(HL)
LD H,0
JP PUTVAL
GETPT: CALL PROPB
GETPT1: CALL PROPN
LD B,A
LD A,(ARG2)
CP B
JP Z,GETPT2 ;FOUND PROP
JP NC,RET0
CALL PROPNX
JP GETPT1
GETPT2: INC HL
EX DE,HL
LD HL,(ZCODEP) ;SUBRACT OFF RELATIVE POINTER
LD A,E
SUB L
LD L,A
LD A,D
SBC A,H
LD H,A
JP PUTVAL
NEXTP: CALL PROPB ;POINT TO PROP VALUE
LD A,(ARG2)
OR A
JP Z,NEXTP2 ;PROP0
NEXTP1: CALL PROPN
LD B,A
LD A,(ARG2)
CP B
JP Z,NEXTP3 ;FOUND PROP
JP NC,RET0 ;RETURN 0
CALL PROPNX
JP NEXTP1 ;LOOP
NEXTP2: CALL PROPN
JP PUTBYT
NEXTP3: CALL PROPNX
JP NEXTP2 ;PROPN OF NEXT
ZADD: CALL GETARG
ADD HL,DE
JP PUTVAL
ZSUB: CALL GETARG
LD A,E
SUB L
LD L,A
LD A,D
SBC A,H
LD H,A
JP PUTVAL
MUL: CALL GETARG
EX DE,HL
CALL SIGNC ;CHECK SIGN
PUSH HL
LD HL,2
CALL HLGEDE
JP Z,MUL2
LD HL,4
CALL HLGEDE
JP Z,MUL4
POP HL
CALL MULT ;DO THE MULTIPLY
MUL1: CALL SIGNS ;SET THE SIGN
JP PUTVAL ;THEN STORE RESULT
MUL4: POP HL
ADD HL,HL
PUSH HL
MUL2: POP HL
ADD HL,HL
JP MUL1
DIV: CALL GETARG
EX DE,HL
CALL SIGNC ;CHECK SIGNS
PUSH HL
LD HL,2
CALL HLGEDE
JP Z,DIV2 ;DIVIDE BY 2
LD HL,4
CALL HLGEDE
JP Z,DIV4 ;DIVIDE BY 4
POP HL
CALL DIVIDE ;DO THE DIVIDE
JP MUL1 ;SET SIGN AND RETURN
DIV2: POP HL
DIV2B: CALL DIV2A
JP MUL1
DIV4: POP HL
CALL DIV2A
JP DIV2B
DIV2A: OR A ;CLEAR CARRY
LD A,H
RRA
LD H,A
LD A,L
RRA
LD L,A
RET
ZMOD: CALL GETARG
EX DE,HL
CALL SIGNC ;MAKE THEM POSITIVE
CALL DIVIDE ;DO THE DIVIDE
EX DE,HL ;GET THE REMAINDER
JP PUTVAL
;
; *******************
; * X-OPS *
; *******************
;
EQUALQ: LD HL,(ARG1)
EX DE,HL
LD A,(ARGCNT)
LD B,A
DEC B
CALL Z,ZER
LD HL,(ARG2)
CALL EQUAQ1
LD HL,(ARG3)
CALL EQUAQ1
LD HL,(ARG4)
CALL EQUAQ1
CALL ZER
EQUAQ1: CALL HLGEDE ;DO COMPARISON
POP HL ;RESTORE RETURN ADDRESS
JP Z,PREDS ;DON'T BOTHER RETURNING
DEC B ;ARG COUNT
JP Z,PREDF ;OUT OF ARGS, FAIL
JP (HL) ;ELSE RETURN
ZCALL: LD HL,(ARG1)
LD A,H
OR L
JP Z,PUTVAL
LD HL,(OZSTKC)
CALL PSHSTK
LD HL,(OZSTKP)
CALL PSHSTK
LD HL,(ZPCL)
CALL PSHSTK ;SAVE OLD PC LOWER
LD HL,(ZPCH) ;SAVE HIGH IN L
PUSH HL
XOR A
LD (ZPCFLG),A ;PC HAS CHANGED
LD H,A
LD A,(ARG1)
LD L,A
ADD HL,HL ;NEW ZPCL
LD (ZPCL),HL
LD A,(ARG1+1)
LD (ZPCH),A ;NEW ZPCH
CALL NEXTPC ;GET NUMBER OF LOCALS
POP HL
LD B,A ;B HAS NUMBER OF LOCALS
LD H,A
PUSH HL ;SAVE VALUE
LD HL,LOCALS ;STORE OLD LOCALS
OR A
JP Z,ZCALL2 ;NO LOCALS
ZCALL1: PUSH BC
LD D,(HL)
INC HL
LD E,(HL)
EX DE,HL
CALL PSHSTK
DEC DE
PUSH DE
CALL NEXTPC ;GET NEW DEFAULT VALUE FOR LOCAL
LD D,A
PUSH DE
CALL NEXTPC ;WORD VALUE
POP DE
LD E,A
POP HL ;POINTER TO STORE NEW LOCAL
LD (HL),D
INC HL
LD (HL),E
INC HL
POP BC
DEC B
JP NZ,ZCALL1 ;LOOP THROUGH ALL LOCALS
ZCALL2: LD A,(ARGCNT) ;PASS ARGS
LD B,A
DEC B
JP Z,ZCALL4 ;NO ARGS TO PASS
LD HL,ARG2 ;POINTER TO FIRST ARG
LD DE,LOCALS
ZCALL3: LD A,(HL)
INC HL
INC DE
LD (DE),A
DEC DE
LD A,(HL)
INC HL
LD (DE),A
INC DE
INC DE
DEC B
JP NZ,ZCALL3
ZCALL4: POP HL ;GET BACK ZPCH AND NUMBER OF LOCALS
CALL PSHSTK
LD A,(ZSTAKC)
LD (OZSTKC),A
LD HL,(ZSTAKP)
LD (OZSTKP),HL ;FOR KNOWING WHERE TO RETURN
JP MLOOP
PUT: LD HL,(ARG2)
ADD HL,HL
EX DE,HL
LD HL,(ARG1)
ADD HL,DE ;Z ADDRESS
EX DE,HL
LD HL,(ZCODEP)
ADD HL,DE ;REAL POINTER
EX DE,HL
LD HL,(ARG3) ;VALUE TO STORE
EX DE,HL
LD (HL),D
INC HL
LD (HL),E
JP MLOOP
PUTB: LD HL,(ARG2)
EX DE,HL
LD HL,(ARG1)
ADD HL,DE
EX DE,HL
LD HL,(ZCODEP)
ADD HL,DE
LD A,(ARG3)
LD (HL),A ;STORE ONE BYTE IN RANDOM TABLE
JP MLOOP
PUTP: CALL PROPB ;SET PROP
PUTP1: CALL PROPN ;GET PROP NUMBER
LD B,A
LD A,(ARG2)
CP B
JP Z,PUTP2 ;FOUND PROPERTY
CALL NC,ZER ;BAD PROP NUMBER
CALL PROPNX ;TRY NEXT
JP PUTP1
PUTP2: CALL PROPL ;GET LENGTH
INC HL
EX DE,HL
LD HL,(ARG3)
DEC A
JP M,PUTP2A ;STORE 1 BYTE
CALL NZ,ZER ;TOO LONG
EX DE,HL
LD (HL),D
INC HL
LD (HL),E
JP MLOOP ;RETURN
PUTP2A: EX DE,HL
LD (HL),E
JP MLOOP ;SET AND RETURN
ZREAD:
CALL WHOLIN
CALL RND ;RANDOMIZE
LD HL,(ZCODEP) ;MAIN READ CODE
EX DE,HL ;GET REAL POINTERS TO TABLES
LD HL,(ARG1)
ADD HL,DE ;BUFFER TABLE
LD (ARG1),HL
LD HL,(ARG2)
ADD HL,DE ;RESULT TABLE
LD (ARG2),HL
CALL READBF ;READ THE BUFFER
LD B,A ;CHARACTER COUNT IN B
LD C,0 ;C HAS CHARACTERS IN WORD
LD HL,(ARG2)
INC HL
LD (HL),0 ;SET WORDS READ TO 0
INC HL
LD (RTABP),HL ;INITIALIZE RESULT TABLE POINTER
LD HL,(ARG1)
INC HL ;HL HAS POINTER TO INPUT CHARACTERS
READL: PUSH HL
LD HL,(ARG2)
LD A,(HL)
INC HL
CP (HL)
POP HL
JP Z,MLOOP ;TOO MANY WORDS
;ERROR HERE IF DESIRED INSTEAD OF JZ
LD A,B
OR C
JP Z,MLOOP ;OUT OF CHARACTERS AND WORDS
LD A,C
CP 6
CALL Z,FLUSHW ;FLUSH CHARS IN A WORD OVER 6 CHARACTERS
LD A,C
OR A
JP NZ,READL2 ;NOT FIRST CHARACTER IN WORD
PUSH HL
LD D,6
LD HL,ZSTBUI ;INITIALIZE WORD BUFFER
RD0PL: LD (HL),0
INC HL
DEC D
JP NZ,RD0PL
POP HL
LD A,(ARG1)
LD D,A
LD A,L
SUB D ;POSITION OF START OF WORD
PUSH HL
LD HL,(RTABP)
INC HL
INC HL
INC HL
LD (HL),A ;STORE IN RESULT TABLE
POP HL
LD A,(HL)
CALL SIBRKQ ;SELF INSERTING BREAK?
JP C,RSIBRK
LD A,(HL)
CALL RBRKQ ;NORMAL BREAK?
JP NC,READL2 ;NO
INC HL ;YES, FLUSH STRANDED BREAKS
DEC B
JP READL ;LOOP BACK
READL2: LD A,B
OR A
JP Z,READL3 ;OUT OF CHARACTERS, SIMULATE WORD ENDING
LD A,(HL)
CALL RBRKQ ;WORD BREAK?
JP C,READL3 ;FOUND A BREAK
LD D,(HL)
PUSH HL
LD HL,ZSTBUI
LD A,C
CALL HLOFF
LD (HL),D ;STORE CHARACTER IN BUFFER
POP HL
DEC B ;ONE LESS CHARACTER
INC C ;ONE MORE CHARACTER IN WORD
INC HL ;POINT TO NEXT CHARACTER
JP READL
RSIBRK: LD (ZSTBUI),A ;STORE SELF INSERTING BREAK
INC C ;1 CHAR
DEC B ;1 LESS CHAR
INC HL
READL3: LD A,C ;INSERT WORD IF ANY CHARACTERS IN WORD
OR A
JP Z,READL ;NO CHARACTERS IN WORD
PUSH HL
PUSH BC
LD HL,(RTABP) ;STORE PARAMS IN TABLE
INC HL
INC HL
LD (HL),C ;REAL LENGTH OF WORD
CALL CONZST ;CONVERT TO ZSTRING
CALL FINDW ;LOOK UP WORD IN VOCAB TABLE
LD HL,(RTABP) ;STORE RESULT
LD (HL),D
INC HL
LD (HL),E
INC HL
INC HL
INC HL
LD (RTABP),HL ;POINTER TO NEXT WORD
LD HL,(ARG2)
INC HL
INC (HL) ;ONE MORE WORD
POP BC
POP HL
LD C,0 ;ZERO CHARACTERS IN NEXT WORD
JP READL
FLUSHW: LD A,B
OR A ;FLUSH CHARACTERS TILL BREAD OR END OF BUFFER
RET Z
LD A,(HL)
CALL RBRKQ
RET C ;FOUND A BREAK
INC HL
DEC B
INC C
JP FLUSHW
RBRKQ: CALL SIBRKQ ;FIRST CHECK SELF INSERTING BREAKS
RET C ;YES
PUSH HL
LD HL,BRKTBL
LD D,NBRKS
RBRK1: CP (HL)
JP Z,FBRK ;MATCH
INC HL
DEC D
JP NZ,RBRK1
RBRK2: POP HL ;NOT FOUND
OR A ;CLEAR CARRY
RET
FBRK: POP HL
SCF
RET ;FOUND A BREAK, SET CARRY AND RETURN
SIBRKQ: PUSH HL
CALL GETVOC
LD D,(HL) ;NUMBER OF SELF INSERTING BREAKS
DEC D
INC D
JP Z,RBRK2 ;FAIL
INC HL
JP RBRK1
GETVOC: LD HL,(ZCODEP)
LD DE,ZVOCAB
ADD HL,DE
LD D,(HL)
INC HL
LD E,(HL)
LD HL,(ZCODEP)
ADD HL,DE
RET
BRKTBL: DB ' .,?'
DB 0DH,0AH,9H,0CH
DB 22H,22H
NBRKS EQU $-BRKTBL
FINDW: CALL GETVOC ;FIND WORD IN VOCAB TABLE, ASSUMES VOCAB IN MEMORY
LD A,(HL)
INC HL
CALL HLOFF ;SKIP OVER SELF INSERTING BREAKS
LD A,(HL)
ADD A,A
ADD A,A
ADD A,A
ADD A,A
LD C,A ;C HAS 16 TIMES VOCAB ENTRY SIZE
INC HL
LD D,(HL)
INC HL
LD E,(HL)
INC HL ;HL POINTS TO VOCAB TABLE
LD A,(ZSTBUO+1) ;GET FIRST CHARACTER
LD B,A ;PUT IT IN B
JP FWL2 ;WE CAN'T START AT THE BEGINNING
FWL1A: OR D ;HERE ON 16 WORD BOUNDRY
JP Z,FWL3 ;END OF TABLE
FWL1: LD A,(HL)
CP B ;CHECK ONLY FIRST BYTE
JP NC,FWL3 ;FOUND PROPER AREA FOR FINE SEARCH
FWL2: LD A,L
ADD A,C
LD L,A
LD A,H
ADC A,0
LD H,A ;POINTER TO NEXT BLOCK (HLOFF NOT USED FOR SPEED)
LD A,E
SUB 16 ;16 MORE WORDS
LD E,A
JP Z,FWL1A
JP NC,FWL1
DEC D
JP P,FWL1 ;NOT OUT OF WORDS
FWL3: LD A,L ;NOW DO FINE CHECK
SUB C ;BACKUP 16 WORDS
LD L,A
LD A,H
SBC A,0
LD H,A
LD A,E
ADD A,16
LD E,A
LD A,D
ADC A,0
LD D,A ;BACKUP COUNT
LD A,C
RRCA
RRCA
RRCA
RRCA
LD C,A ;REAL ENTRY SIZE
FWL4:
LD A,(ZSTBUO+1)
CP (HL)
JP C,FWFAIL
JP NZ,FWL4A ;CHECK ALL 4 BYTES
INC HL
LD A,(ZSTBUO)
CP (HL)
JP C,FWFAIL
JP NZ,FWL4B
INC HL
LD A,(ZSTBUO+3)
CP (HL)
JP C,FWFAIL
JP NZ,FWL4C
INC HL
LD A,(ZSTBUO+2)
CP (HL)
JP C,FWFAIL
JP Z,FWSUCC ;MATCH
DEC HL
FWL4C: DEC HL
FWL4B: DEC HL
FWL4A: LD A,C
CALL HLOFF
DEC DE
LD A,D
OR E
JP NZ,FWL4 ;NOT OUT OF WORDS YET
FWFAIL: LD DE,0
RET
FWSUCC: DEC HL
DEC HL
DEC HL
EX DE,HL
LD HL,(ZCODEP)
LD A,E
SUB L
LD E,A
LD A,D
SBC A,H
LD D,A
RET
PRINTC: LD A,(ARG1)
LD C,A
CALL COUT
JP MLOOP
PRINTN: LD HL,(ARG1)
CALL PRNTNC
JP MLOOP
PRNTNC: LD A,H
OR A
CALL M,PRNTNG ;NEGATIVE NUMBER
LD B,0 ;DIGIT COUNT
PRNTN1: LD A,H
OR L
JP Z,PRNTN3
LD DE,10
CALL DIVIDE
PUSH DE
INC B
JP PRNTN1
PRNTN3: XOR A
ADD A,B
JP Z,PRNTN6 ;PRINT AT LEAST 0
PRNTN4: POP DE
LD A,'0'
ADD A,E
LD C,A
CALL COUT
DEC B
JP NZ,PRNTN4
RET
PRNTN6: LD C,'0'
JP COUT
PRNTNG: LD C,'-' ;PRINT -
CALL COUT
JP SIGNCN ;CHANGE SIGN
RANDOM: LD HL,(ARG1) ;RANDOM GENERATOR
EX DE,HL
CALL RND ;GET THE BASE NUMBER
CALL DIVIDE
EX DE,HL ;GET REMAINDER
INC HL ;MAKE NOT EQUAL TO 0
JP PUTVAL
ZPUSH: LD HL,(ARG1)
CALL PSHSTK
JP MLOOP
ZPOP: CALL POPSTK
LD A,(ARG1)
JP VARPTR
;
; **********************************************************************
; * *
; * ZORK - RANDOM ROUTINES *
; * *
; **********************************************************************
;
RND: PUSH BC
LD C,2 ;2 TIMES THROUGH LOOP
RND2: LD B,8
LD HL,SHIFT
LD A,(HL)
RND1: RLCA
RLCA
RLCA
XOR (HL)
RLA
RLA
LD HL,SHIFT
LD A,(HL)
RLA
LD (HL),A
INC HL
LD A,(HL)
RLA
LD (HL),A
INC HL
LD A,(HL)
RLA
LD (HL),A
INC HL
LD A,(HL)
RLA
LD (HL),A
DEC B
JP NZ,RND1
DEC C
JP NZ,RND2
POP BC
LD HL,(SHIFT+2) ;GET THE NUMBER
RET
MULT: PUSH BC ;DEHL <=DE*HL
LD BC,0
LD A,16 ;LOOP COUNTER
MULT1: PUSH AF
LD A,E
AND 1 ;CHECK BIT FOR ADD
JP Z,MULT2 ;SKIP ADD PART IF 0
PUSH HL ;SAVE MULTIPLIER
ADD HL,BC ;ADD PART
LD B,H
LD C,L
POP HL ;RESTORE H
MULT2: LD A,B ;32 BIT SHIFT REMEMBERING CARRY
RRA
LD B,A
LD A,C
RRA
LD C,A
LD A,D
RRA
LD D,A
LD A,E
RRA
LD E,A
POP AF ;GET BACK LOOP COUNT
DEC A
JP NZ,MULT1
LD H,D ;PUT LOW ORDER ANSWER IN HL
LD L,E
LD D,B ;HIGH PART IN DE
LD E,C
POP BC
RET
DIVIDE: PUSH BC ;HL<=HL/DE, REMAINDER IN DE
LD B,H
LD C,L
LD A,D ;NEGATE DIVISOR
CPL
LD D,A
LD A,E
CPL
LD E,A
INC DE ;FOR TWO'S COMPLEMENT
LD HL,0 ;INITIAL VALUE FOR REMAINDER
LD A,17 ;INIT LOOP COUNTER
DDIV0: PUSH HL ;SAVE REMAINDER
ADD HL,DE ;SUB DIVIS
JP NC,DDIV1 ;UNDERFLOW, RESTORE HL
EX (SP),HL
DDIV1: POP HL
PUSH AF ;SAVE LOOP COUNTER
LD A,C ;4 REG SHIFT LEFT
RLA ;WITH CARRY
LD C,A ;CY->C->B->L->H
LD A,B
RLA
LD B,A
LD A,L
RLA
LD L,A
LD A,H
RLA
LD H,A
POP AF ;RESTORE LOOP COUNTER
DEC A ;DECREMENT IT
JP NZ,DDIV0 ;KEEP LOOPING
;CLEANUP, SHIFT REMAINDER RIGHT AND RETURN IN DE
OR A
LD A,H
RRA
LD D,A
LD A,L
RRA
LD E,A
LD H,B
LD L,C
POP BC
RET
SIGNC: XOR A
LD (SIGNF),A ;SET SIGNF
CALL SIGNPC ;POS CHECK
EX DE,HL
CALL SIGNPC
EX DE,HL
RET
SIGNS: LD A,(SIGNF) ;CHECK FOR SIGN
AND 1 ;EVEN OR ODD
RET Z ;EVEN NUMBER OF NEGATIVES, ANSWER OK
SIGNCN: XOR A ;CHANGE SIGN
SUB L
LD L,A
LD A,0
SBC A,H
LD H,A ;INVERTED HL
RET
SIGNPC: LD A,H
OR A
RET P ;POSITIVE
LD A,(SIGNF)
INC A
LD (SIGNF),A
JP SIGNCN ;CHANGE SIGN
FLAGSU: LD A,(ARG1) ;SETUP FOR FLAG ROUTINES
CALL OBJLOC ;BC WILL HAVE BIT POSITION, DE FLAG VALUE
LD A,(ARG2) ;HL WILL GET OBJ POINTER
CP 16
JP C,FLGSU1 ;NEXT WORD
SUB 16 ;SECOND SET OF FLAGS
INC HL
INC HL
FLGSU1: PUSH HL
LD B,A
LD A,15
SUB B
LD HL,1
FLGSU2: JP Z,FLGSU3 ;BIT IN POSITION
ADD HL,HL
DEC A
JP FLGSU2
FLGSU3: LD B,H
LD C,L
POP HL
LD D,(HL)
INC HL
LD E,(HL)
DEC HL
RET
PROPB: LD A,(ARG1) ;BEG OF PROPERTY PART OF OBJECT
CALL OBJLOC
LD DE,7
ADD HL,DE
LD D,(HL)
INC HL
LD E,(HL)
LD HL,(ZCODEP)
ADD HL,DE
LD A,(HL) ;LENGTH OF DESCRIPTION
ADD A,A ;*2
INC A ;+1
JP HLOFF ;INDEX AND RETURN
PROPN: LD A,(HL) ;HL HAS REAL PROP POINTER
AND 1FH
RET
PROPL: LD A,(HL) ;PROP LENGTH, HL HAS REAL PROP POINTER
RLCA
RLCA
RLCA
AND 7
RET
PROPNX: CALL PROPL
ADD A,2
JP HLOFF ;NEXT PROP POINTER
OBJLOC: PUSH DE ;GET OBJECT LOCATION, A HAS OBJECT NUMBER
LD L,A
LD H,0
LD D,H
LD E,L
ADD HL,HL
ADD HL,HL
ADD HL,HL
ADD HL,DE
LD DE,53
ADD HL,DE ;9*NUMBER + 53
PUSH HL ;OBJECT OFFSET
LD HL,(ZCODEP)
LD DE,ZOBJEC
ADD HL,DE
LD D,(HL)
INC HL
LD E,(HL)
LD HL,(ZCODEP)
ADD HL,DE
POP DE
ADD HL,DE ;REAL ADDRESS
POP DE
RET
GETARG: LD HL,(ARG1)
EX DE,HL
LD HL,(ARG2) ;GET BOTH ARGS
RET
SHLGED: LD A,D
XOR H
JP P,HLGEDE ;BOTH OF SAME SIGN
LD A,H
CP D ;CARRY WILL BE SET IF D NEG AND THUS LESS THAN H
RET
HLGEDE: LD A,D ;RETURN WITH CARRY SET IF HL>=DE
CP H
RET NZ
LD A,L
CP E
CCF
RET
PSHSTK: PUSH DE
EX DE,HL ;PUSH STACK
LD HL,(ZSTAKP) ;STACK POINTER
DEC HL
LD (HL),E
DEC HL
LD (HL),D
LD (ZSTAKP),HL ;SAVE POINTER
LD HL,ZSTAKC ;COUNT
INC (HL)
LD A,(HL)
CP ZSTAKL
CALL Z,ZER
EX DE,HL
POP DE
RET
; ---------
; POP STACK
; ---------
; POP WORD OFF Z-STACK AND RETURN IT IN HL
POPSTK: PUSH DE ;SAVE DE
LD HL,(ZSTAKP) ;HL <= Z-STACK POINTER
LD D,(HL) ;GET MSB OF WORD
INC HL
LD E,(HL) ;GET LSB OF WORD
INC HL
LD (ZSTAKP),HL ;SAVE NEW Z-STACK POINTER
LD HL,ZSTAKC ;CHECK COUNT
DEC (HL)
CALL Z,ZER ;OVER POP ERROR
EX DE,HL ;VALUE IN HL
POP DE ;RESTORE DE
RET
;
; **********************************************************************
; * *
; * ZORK - PAGING ROUTINES *
; * *
; **********************************************************************
;
NEXTPC: LD A,(ZPCFLG) ;HAS PAGE MOVED?
OR A
JP Z,NXTPC1 ;PAGE HAS MOVED
LD HL,(ZPCPNT)
LD B,(HL) ;GET VALUE IN B
INC HL
LD (ZPCPNT),HL ;STORE BACK POINTER
LD HL,(ZPCL)
INC L
LD (ZPCL),HL ;ASSUME OK AT FIRST
LD A,B
RET NZ ;OK IF L NOT ZERO
LD A,H ;CROSSED 256 BYTE BOUNDRY
INC H
LD (ZPCL),HL ;AGAIN ASSUME NOT PASSED 256 BOUNTRY
OR A
LD A,B
RET Z ;DID NOT CROSS 512 BOUNDRY
XOR A
LD (ZPCL+1),A ;0 ZPCL
LD (ZPCFLG),A ;BAD DATA IN PCPNT, WILL HAVE TO FETCH NEW BLOCK
LD HL,ZPCH ;INCREMENT ZPC HIGH
INC (HL)
LD A,B
RET ;RETURN, TROUBLE NEXT TIME
NXTPC1: LD A,(ZPCH) ;GET ZPAGE NUMBER
LD HL,ZMEMT ;TOP OF LOW MEM
CP (HL)
LD HL,(ZCODEP) ;PRELOAD PORTION
JP C,NXTPCL
CALL FNDPGE
LD (ZPCPG),A ;STORE PAGE
JP C,NXTPC2 ;COULD NOT FIND PAGE, SWAP IT IN (OH WHAT A SHAME)
NXTPC3: CALL SPLICE ;PUT AT TOP OF LIST
LD A,(ZPCPG) ;SET UP POINTER TO PAGE
LD HL,(PGBUFP) ;POINTER TO BEGINNING OF PAGE BUFFERS
NXTPCL:
ADD A,A
ADD A,H
LD H,A
EX DE,HL ;DE NOW HAS POINTER TO BEG OF BUFFER
LD HL,(ZPCL)
ADD HL,DE ;ADD IN OFFSET
LD (ZPCPNT),HL ;ZPCPNT NOW VALID
LD A,0FFH
LD (ZPCFLG),A
JP NEXTPC ;TRY AGAIN, THIS TIME IT WILL NOT FAIL
NXTPC2: LD HL,MPCPG ;CHECK IF DISTROYING MPC
CP (HL)
JP NZ,NXTPC4 ;NOT DISTROYING PAGE
LD B,A
XOR A
LD (MPCFLG),A
LD A,B
NXTPC4: LD HL,(PGBUFP)
ADD A,A
ADD A,H
LD H,A ;POINTER TO BEGINNING OF BUFFER
LD A,(ZPCH)
CALL GETDSK
LD A,(ZPCPG)
LD B,A
LD HL,PGTBL
CALL HLOFF
LD A,(ZPCH)
LD (HL),A ;SET PAGE TABLE ENTRY
LD A,B
JP NXTPC3 ;PAGE NOW IN MEMORY
SETWRD: LD A,H
OR A
RRA
LD (MPCH),A
SETWR1: LD A,H
AND 1
LD H,A
LD (MPCL),HL
XOR A
LD (MPCFLG),A
RET
SETSTR: LD A,H
LD (MPCH),A
ADD HL,HL
JP SETWR1
GETFRE: XOR A
LD (MPCFLG),A ;NO MEM PAGE LEFT
LD A,(PGBOT)
LD (MPCPG),A
CALL CKZPCP
CALL SPLICE
LD A,(MPCPG)
LD B,A
LD HL,(PGBUFP)
ADD A,A
ADD A,H
LD H,A
LD (MPCPNT),HL
LD A,B
LD HL,PGTBL
CALL HLOFF
LD (HL),0
RET
GETWRD: CALL GETBYT
PUSH AF
CALL GETBYT ;GET A FULL WORD
LD L,A
POP AF
LD H,A
RET
GETBYT: LD A,(MPCFLG) ;HAS PAGE MOVED?
OR A
JP Z,GETBT1 ;PAGE HAS MOVED
LD HL,(MPCPNT)
LD B,(HL) ;GET VALUE IN B
INC HL
LD (MPCPNT),HL ;STORE BACK POINTER
LD HL,(MPCL)
INC L
LD (MPCL),HL ;ASSUME OK AT FIRST
LD A,B
RET NZ ;OK IF L NOT ZERO
LD A,H ;CROSSED 256 BYTE BOUNDRY
INC H
LD (MPCL),HL ;AGAIN ASSUME NOT PASSED 256 BOUNTRY
OR A
LD A,B
RET Z ;DID NOT CROSS 512 BOUNDRY
XOR A
LD (MPCL+1),A ;0 MPCL
LD (MPCFLG),A ;BAD DATA IN PCPNT, WILL HAVE TO FETCH NEW BLOCK
LD HL,MPCH ;INCREMENT ZPC HIGH
INC (HL)
LD A,B
RET ;RETURN, TROUBLE NEXT TIME
GETBT1: LD A,(VERF)
OR A
JP NZ,GETB1A ;IN VERIFY MODE
LD A,(MPCH) ;GET MPAGE NUMBER
LD HL,ZMEMT ;TOP OF LOW MEM
CP (HL)
LD HL,(ZCODEP) ;PRELOAD PORTION
JP C,GETBTL
CALL FNDPGE
LD (MPCPG),A ;STORE PAGE
JP C,GETBT2 ;COULD NOT FIND PAGE, SWAP IT IN (OH WHAT A SHAME)
GETBT3: CALL SPLICE ;PUT AT TOP OF LIST
LD A,(MPCPG) ;SET UP POINTER TO PAGE
LD HL,(PGBUFP) ;POINTER TO BEGINNING OF PAGE BUFFERS
GETBTL:
ADD A,A
ADD A,H
LD H,A
EX DE,HL
LD HL,(MPCL)
ADD HL,DE
LD (MPCPNT),HL
LD A,0FFH
LD (MPCFLG),A
JP GETBYT ;TRY AGAIN, THIS TIME IT WILL NOT FAIL
CKZPCP: LD HL,ZPCPG ;CHECK IF DISTROYING ZPC
CP (HL)
RET NZ ;NOT DISTROYING PAGE
LD B,A
XOR A
LD (ZPCFLG),A
LD A,B
RET
GETB1A: LD A,(PGBOT)
LD (MPCPG),A ;NEW PAGE
GETBT2: CALL CKZPCP
LD HL,(PGBUFP)
ADD A,A
ADD A,H
LD H,A ;POINTER TO BEGINNING OF BUFFER
LD A,(MPCH)
CALL GETDSK
LD A,(MPCPG)
LD B,A
LD HL,PGTBL
CALL HLOFF
LD A,(MPCH)
LD (HL),A ;SET PAGE TABLE ENTRY
LD A,B
JP GETBT3 ;PAGE NOW IN MEMORY
SPLICE: LD C,A ;SPLICE PAGE IN A TO TOP OF LIST
LD A,(PGTOP) ;GET OLD TOP
CP C
RET Z ;SAME TOP AS LAST
LD B,A
LD A,C
LD (PGTOP),A ;NEW TOP
LD HL,PGTBLF
CALL HLOFF
LD E,(HL) ;E HAS OLD FORWARD POINTER
LD (HL),B ;NEW FORWARD TO OLD TOP
LD HL,PGTBLB
LD A,C
CALL HLOFF
LD D,(HL) ;D GETS OLD BACK POINTER
LD (HL),0FFH ;TOP HAS NO BACK
LD A,D
LD HL,PGTBLF
CALL HLOFF
LD (HL),E ;PATCH FORWARD POINTER
LD A,B
LD HL,PGTBLB
CALL HLOFF
LD (HL),C
LD A,E
INC A
JP Z,SPLIC1 ;WAS LAST BLOCK WITHOUT FORWARD POINTER
LD HL,PGTBLB-1 ;OFFSET INC A
CALL HLOFF
LD (HL),D ;SPLICE BACK POINTER
RET
SPLIC1: LD A,D
LD (PGBOT),A ;NEW BOTTOM OF LIST
RET
HLOFF:
ADD A,L ;INDIRECT HL THROUGH A
LD L,A
LD A,0
ADC A,H
LD H,A
RET
FNDPGE: LD HL,NPGS ;FIND PAGE IN A, RETURN WITH CARRY
;SET IF NOT FOUND. A WILL HAVE FOUND PAGE OR
;BOTTOM OF PAGE LIST
LD B,(HL)
LD C,0
LD HL,PGTBL
FNDPGL: CP (HL)
JP Z,FNDPG1 ;SUCCESS
INC C
INC HL
DEC B
JP NZ,FNDPGL
LD A,(PGBOT) ;NOT FOUND
SCF ;SET CARRY AND RETURN BOTTOM
RET
FNDPG1: LD A,C
RET ;CARRY WILL BE CLEARED
;
; **********************************************************************
; * *
; * ZORK - STRING ROUTINES *
; * *
; **********************************************************************
;
; ---------------
; PRINT Z-STRING
; ---------------
PZSTR: XOR A ;PRINT ZSTRING POINTED TO BY MPC (NOT REENTRENT)
LD (CSPERM),A ;PERMANENT CHARSET
LD (STBYTF),A ;RESET STRING BYTE FLAG
DEC A
LD (CSTEMP),A ;NO TEMP CHARSET IN EFFECT
PZSTRL: CALL GETZCH ;GET A Z-CHARACTER
RET C ;END OF STRING IF CARRY SET
LD B,A
OR A
JP Z,PZSTRS ;0=SPACE
CP 4 ;IS THIS AN F-WORD?
JP C,PZFWRD ; YES.
CP 6 ;IS IT A SHIFT CHAR?
JP C,PZSTRP ; YES. CHANGE CHAR SET
CALL GETMOD
OR A ;IS IT CHARSET 0?
JP NZ,PZSTR1 ; NOPE.
;PRINT LOWER CASE CHAR (CHARSET 0)
LD A,'a'-6 ;ASCII "a" MINUS Z-OFFSET
PZSTP0:
ADD A,B ;ADD CHARACTER
LD C,A
PZSTP1: CALL COUT ;PRINT RESULT
JP PZSTRL ;AND FETCH ANOTHER Z-CHAR
;CHARSET 1 OR 2?
PZSTR1: DEC A ;SET 1?
JP NZ,PZSTR2 ; NOPE, IT'S SET 2
;PRINT UPPER-CASE CHAR (CHARSET 1)
LD A,'A'-6 ;ASCII "A" MINUS Z-OFFSET
JP PZSTP0 ;PROCESS IT
;DECODE/PRINT CHARSET 2
PZSTR2: LD A,B ;MODE 2
CP 6 ;DIRECT ASCII CHARACTER?
JP Z,PZSTRA ; YES.
CP 7 ;CARRIAGE RETURN?
JP Z,PZSTRC ; YES.
LD HL,CHRTBL-8 ; NO. SUBTRACT OFFSET
CALL HLOFF
LD C,(HL) ;GET CHARACTER FROM TABLE
JP PZSTP1
PZSTRA: CALL GETZCH ;FORM CHARACTER FROM TWO BYTES
RRCA
RRCA
RRCA
LD C,A
PUSH BC
CALL GETZCH
POP BC
ADD A,C
LD C,A
CP 9 ;TAB?
JP NZ,PZSTP1
LD C,20H
JP PZSTP1 ;PRINT IT
PZFWRD: DEC A
ADD A,A
ADD A,A
ADD A,A
ADD A,A
ADD A,A ;SET NUMBER -1 TIMES 32
LD (FWSET),A
CALL GETZCH ;GET STRING NUMBER
RET C ;BAD IF OUT OF CHARACTERS
LD B,A
LD A,(CSPERM) ;PRINT ZSTRING POINTED TO BY MPC
LD H,A ;MAKE IT REENTERENT
LD A,(STBYTF)
LD L,A
PUSH HL
LD HL,(ZSTWRD)
PUSH HL
LD HL,(MPCL)
PUSH HL
LD HL,(MPCH)
PUSH HL
LD HL,(FWORDS)
LD A,(FWSET)
ADD A,B ;ENTRY INTO 96 WORD TABLE
ADD A,A
CALL HLOFF ;POINTER TO SPECIAL STRING
LD A,(HL)
LD (MPCH),A
INC HL
LD L,(HL)
LD H,0
ADD HL,HL
LD (MPCL),HL ;SET NEW MPC
XOR A
LD (MPCFLG),A ;MPCPNT NOT VALID
CALL PZSTR ;PRINT SUB STRING (REENTRENT VERSION)
XOR A ;RESTORE REENTRENT VALUES
LD (MPCFLG),A
POP HL
LD A,L
LD (MPCH),A
POP HL
LD (MPCL),HL
POP HL
LD (ZSTWRD),HL
POP HL
LD A,H
LD (CSPERM),A
LD A,L
LD (STBYTF),A
CALL GETMOD
JP PZSTRL
PZSTRS: LD C,20H
JP PZSTP1 ;PRINT SPACE
PZSTRC: LD C,0DH ;CR-LF
CALL COUT
LD C,0AH
JP PZSTP1
PZSTRT: LD A,B ;SET TEMP MODE
SUB 3
LD (CSTEMP),A
JP PZSTRL
PZSTRP: CALL GETMOD ;SET CHAR MODE
OR A ;MODE 0 IS TEMPORARY
JP Z,PZSTRT
DEC A
ADD A,A
ADD A,B
SUB 4 ;INDEX INTO PERMTB
PUSH HL
LD HL,PERMTB
CALL HLOFF
LD A,(HL)
POP HL
LD (CSPERM),A
JP PZSTRL
PERMTB: DB 1,0,0,2
CHRTBL: DB '0123456789.,!?_#'
DB $27,$22
DB '/\-:()'
GETMOD: LD A,(CSTEMP)
INC A
LD A,(CSPERM)
RET Z ;RETURN WITH PERM MODE IF NO TEMP MODE
PUSH HL
LD HL,CSTEMP
LD A,(HL)
LD (HL),0FFH ;CLEAR MODE AFTER GETTING IT
POP HL
RET
GETZCH: LD A,(STBYTF) ;FIND OUT WHICH BYTE
OR A
SCF
RET M ;OUT OF CHARACTERS
JP NZ,GETZH1 ;NOT FIRST BYTE
INC A
LD (STBYTF),A
CALL GETWRD
LD (ZSTWRD),HL ;SAVE WORD
LD A,H
RRCA
RRCA
AND 1FH
RET
GETZH1: DEC A
JP NZ,GETZH2 ;LAST CHAR IN WORD
LD A,2
LD (STBYTF),A
LD HL,(ZSTWRD)
ADD HL,HL
ADD HL,HL
ADD HL,HL
LD A,H
AND 1FH
RET
GETZH2: XOR A
LD (STBYTF),A
LD HL,(ZSTWRD)
LD A,H
OR A
JP P,GETZH3 ;NOT LAST CHAR IN STRING
LD A,0FFH
LD (STBYTF),A ;INDICATE END OF STRING
GETZH3: LD A,L
AND 1FH
RET
CONZST: XOR A ;CONVERT TO Z STRING
LD (CSPERM),A
LD HL,ZSTBUO ;POINTER TO OUTPUT BUFFER
LD B,6 ;OUTPUT 6 CHARACTERS TO CONVERT
CONZSL: LD (HL),5
INC HL
DEC B
JP NZ,CONZSL ;FILL BUFFER WITH PAD CHARACTERS
LD B,6
LD DE,ZSTBUO ;OUTPUT
LD HL,ZSTBUI ;INPUT
CNZSL1: LD C,(HL)
INC HL
LD A,C
OR A
LD A,5
JP Z,CNZSLO ;BLANKS
LD A,C
CP ' '
LD A,0
JP Z,CNZSLO ;SPACE
CNZSL2: PUSH DE
LD A,C
CALL ZCHRCS ;WHICH CHARACTER SET
LD E,A ;E HAS CHARACTER SET OF CURRENT CHAR
LD A,(CSPERM)
CP E
JP Z,CNZSLC ;CONVERT THEN OUTPUT
LD A,E
ADD A,3
POP DE
LD (DE),A ;OUTPUT TEMP SHIFT
INC DE
DEC B
JP Z,CNZSLE
PUSH DE
CNZSLC: LD A,C
POP DE
CALL ZCHRCS
DEC A
JP P,CNZSC1 ;NOT LOWER CASE
LD A,C
SUB 'a'-6
CNZSLO: LD (DE),A
INC DE
DEC B
JP NZ,CNZSL1 ;NEXT
JP CNZSLE ;END
CNZSC1: JP NZ,CNZSC3 ;NOT UPPER CASE
LD A,C
SUB 'A'-6
JP CNZSLO
CNZSC3: LD A,C
CP 0DH
JP NZ,CNZSC4
LD A,(HL)
CP 0AH
JP NZ,CNZSC4
INC HL
LD A,7
JP CNZSLO ;CR-LF
CNZSC4: LD A,C
CALL CNZS2M
JP NZ,CNZSLO ;FOUND IN TABLE
LD A,6
LD (DE),A
INC DE
DEC B
JP Z,CNZSLE ;STORE ASCII VERSION
LD A,C
RLCA
RLCA
RLCA
AND 3
LD (DE),A
INC DE
DEC B
JP Z,CNZSLE
LD A,C
AND 1FH
JP CNZSLO
CNZS2M: PUSH BC
PUSH HL
LD HL,CHRTBL+23 ;SEARCH TABLE
LD B,24
CNZS2L: CP (HL)
JP Z,CNZS2P ;FOUND
DEC HL
DEC B
JP NZ,CNZS2L
POP HL ;NOT FOUND
POP BC
RET ;FAIL, ZERO SET
CNZS2P: LD A,B
ADD A,7
POP HL
POP BC
RET ;PASSED, ZERO CLEARED
ZCHRCS: CP 'a'
JP C,ZCHRC1
CP 'z'+1
JP NC,ZCHRC1
XOR A
RET ;SET 0
ZCHRC1: CP 'A'
JP C,ZCHRC2
CP 'Z'+1
JP NC,ZCHRC2
LD A,1
RET
ZCHRC2: OR A
RET Z
RET M ;END
LD A,2
RET ;ELSE SET 2
CNZSLE: LD BC,ZSTBUO ;CONVERT OUTPUT STRING
LD HL,0
LD D,H
CALL CNZSE1
CALL CNZSE1
CALL CNZSE1
LD (ZSTBUO),HL
LD HL,1
CALL CNZSE1
CALL CNZSE1
CALL CNZSE1
LD (ZSTBUO+2),HL
RET
CNZSE1: LD A,(BC)
INC BC
LD E,A
ADD HL,HL
ADD HL,HL
ADD HL,HL
ADD HL,HL
ADD HL,HL
ADD HL,DE
RET
;
; **********************************************************************
; * *
; * ZORK - DATA SECTION *
; * *
; **********************************************************************
;
SRND: ;RANDOM INFO FOR SAVE, KEEP TOGETHER
LOCALS: DS 15*2 ;STORAGE FOR LOCALS
ZPCH: DB 0 ;HIGH ORDER 8 BITS OF ZPC
ZPCL: DW 0 ;LOW ORDER 9 BITS OF ZPC
ZSTAKC: DB 1 ;STACK COUNT, 1=>0 IMPLIES OVERPOP, NEG=> OVER PUSH
OZSTKP: DW 0 ;OLD ZSTACK POINTER
OZSTKC: DB 0 ;OLD ZSTACK COUNT
;
SHIFT: DB 6AH,57H,3CH,99H
SRNDC EQU $-SRND
ZSTBUI: DS 6 ;ZSTR INPUT BUFFER
DB 0FFH ;END MARKER
NOLPT: DB 1 ;NON ZERO IMPLIES DO NOT USE LPT
VERF: DB 0 ;1 IF IN VERIFY MODE.
ZMEMT: DB 1 ;FIRST PAGE IN SWAPPING SPACE
PURSTP: ;END OF PURE
SIGNF: DB 0 ;STORAGE FOR SIGN IN MULT AND DIVIDE
ARG1: DW 0 ;OPERRAND 1
ARG2: DW 0 ;" 2
ARG3: DW 0 ;" 3
ARG4: DW 0 ;" 4
ARGCNT: DB 0 ;ARG COUNT
OPCODE: DB 0 ;CURRENT OPCODE
GLOBAL: DW 0 ;POINTER TO GLOBAL 0
FWSET: DB 0 ;TEMPORARY STORAGE FOR FWORDS CALCULATION
FWORDS: DW 0 ;COMMON WORDS POINTER
ZPCOFF: DW 0 ;OFFSET FOR FAST JUMPS
ZPCPNT: DW 0 ;REAL POINTER TO PC
ZPCFLG: DB 0 ;0FFH IF VALID PC POINTER
ZPCPG: DB 0 ;PAGE OF ZPC
MPCH: DB 0 ;HIGH ORDER 8 BITS OF MEMORY POINTER
MPCL: DW 0 ;LOW ORDER 9 BITS OF MEMPOINTER
MPCPNT: DW 0 ;REAL POINTER TO MEMORY LOCATION
MPCFLG: DB 0 ;0FF IF VALID MPCPNT
MPCPG: DB 0 ;PAGE NUMBER OF PC PAGE
;
;PAGE TABLES
PGBUFP: DW 0 ;BUFFER POINTER
ZCODEP: DW 0 ;LOW MEM STARTING POINTER
;
NPGS: DB 0 ;NUMBER OF PAGES
PGTOP: DB 0 ;TOP OF LIST PAGE
PGBOT: DB MAXPGS-1 ;BOTTOM OF LIST
;
CSTEMP: DB 0 ;-1 IF NOT TEMP CHAR SET, ELSE SET
CSPERM: DB 0 ;PERM CHARACTER SET
STBYTF: DB 0 ;0 FOR FIRST BYTE, 1 FOR 2, 2 FOR 3, 0FFH FOR END
ZSTWRD: DW 0 ;WORD STORRAGE
ZSTBUO: DS 6 ;OUTPUT BUFFER
RTABP: DW 0 ;TEMP FOR ZREAD, RESULT TABLE POINTER
;
LMEMRY: DW 0 ;LAST LOCATION IN MEMORY, FILLED IN BY LOADER
;
END START
Reference in New Issue View Git Blame Copy Permalink