TITLE	ZIP	Z-LANGUAGE INTERPRETER      MS-DOS 2.0 VERSION

	PAGE	58,132
	.LIST

	; Modification History -
	;---------------------------------------------------
	;
	; 1) REWORKED FOR NEW SETUP FILE USAGE
	; 2) FIXED NON-WORKING STACK SAVE AND RESTORE FILE
	; 3) FIX RANDOM BUG - 6/25/84
	; 4) FIXED STATUS LINE (LONG ROOM DESCRIPTION) - 07/24/84
	; 5) Fixed status line bug on restart 22-Oct-84 - PHG
	;
	
	SUBTTL	STACK AND DATA SEGMENTS INITIALIZATION

ZVERSN	EQU	"G"		;ZIP VERSION NUMBER
ZMVERS	EQU	3		;Z-MACHINE VERSION NUMBER
LSTACK	EQU	512		;LENGTH OF USER STACK(MUST BE 1 PAGE FOR NOW)

PVERS1	EQU	0		;POSITION OF ZVERSION VERSION BYTE
PVERS2	EQU	1		;ZVERSION MODE BYTE
PZRKID	EQU	2		;ZORKID
PENDLD	EQU	4		;ENDLOD
PSTART	EQU	6		;START
PVOCTB	EQU	10Q		;VOCAB
POBJTB	EQU	12Q		;OBJECT
PGLOTB	EQU	14Q		;GLOBALS
PPURBT	EQU	16Q		;PURBOT
PFLAGS	EQU	20Q		;USER FLAG WORD
PSERNM	EQU	22Q		;SERIAL NUMBER (6 BYTES)
PWRDTB	EQU	30Q		;WORDS
PLENTH	EQU	32Q		;GAME LENGTH
PCHKSM	EQU	34Q		;GAME CHECKSUM
LMOUTB	EQU	80		;MAX LENGTH OF OUTBUF, EXCLUDING TERMINAL 0
LDOUTB	EQU	80		;DEFAULT LENGTH OF OUTBUF
LPAGES	EQU	128		;MAX NUMBER OF PAGES EXPECTED
LXBYTS	EQU	LSTACK+LMOUTB+(4*LPAGES)+2000Q  ;LENGTH OF EXTRA BYTES NEEDED

EOICHR	EQU	15		;CARRIAGE RETURN IS NORMAL END OF INPUT
EOLCHR	EQU	10		;LINE FEED CHARACTER
PADCHR	EQU	5		;PADDING CHARACTER

SSVER	EQU	"A"-10		; ADD THIS TO THE VERTICAL SETUP HEIGHT
SSHOR	EQU	-6		; ADD THIS TO THE HORIZONTAL SETUP WIDTH
SSLNT	EQU	3		; LENGTH OF SETUP FILE


CRESET	EQU	0H		;MS-DOS FUNCTION CALLS WITH INT 21H
CCONIN	EQU	1H
CPROUT	EQU	5H
CCONIO	EQU	6H
CRDLIN	EQU	0AH
CFOPEN	EQU	0FH
CFCLOS	EQU	10H
CFDELE	EQU	13H
CFMAKE	EQU	16H
CSDMAO	EQU	1AH
CRDRND	EQU	21H
CWRRND	EQU	22H
CPRSNM	EQU	29H

GAME_SG	SEGMENT PARA
	DB	0E000H DUP(?)
GAME_SG	ENDS

ABS_SG	SEGMENT AT 0H
ABS_SG	ENDS

STK_SG	SEGMENT	PARA STACK
	DW	200H DUP(?)
STK_TOP	LABEL	WORD
STKBOT	DW	LSTACK DUP(?)
ZSTK_TP	LABEL	WORD
STK_SG	ENDS

DATA_SG	SEGMENT	PARA

	;VARIBLE DEFINITIONS:

	;GTBLKS
GAMFCB	DB	0,"WITNESS DAT",30 DUP(0)
SAVFCB	DB	0,"WITNESS SAV",30 DUP(0)
SSFCB	DB	0,"SETUP   INF",30 DUP(0)
DSKFCB	DW	0
DSKDIR	DB	0		;0 FOR READ, 1 FOR WRITE
GTBCNT	DW	0		;REMAINING BLOCKS TO BE READ
GTBSTT	DW	0		;STARTING BLOCK
GTBCOR	DW	0		;STARTING CORE ADDRESS
DSKBUF	DB	512 DUP(0)	;DISK BUFFER FOR TRANSFERS
SSBUF	DB	SSLNT DUP (0)

	; SCREEN DEFINITIONS
SCPL	DB	78
SLPP	DB	24
STINIT	DB	16
	DB	27,"[2J",27,"[0m",27,"[01;01H"
STRESET	DB	0
SBLINE	DB	12
	DB	27,"[7m",27,"[01;01H"
SELINE	DB	12
	DB	27,"[0m",27,"["
SELINE1	DB	"25;01H"
SPINIT	DB	0
RADIX	DB	10		; THE DEFAULT RADIX FOR THE SCREEN
	;SCRIPTING STUFF
SCRFLG	DB	0
PRNRDY	DB	" * Printer not ready: Abort or Retry? ",80H

	;USL STUFF
SLFLG	DB	1		;STATUS LINE ASSUMED PRESENT
PMFLAG	DB	0		;AM/PM

SLSTR	DW	0		;TOP OF SCREEN STRING
SLTAB	DW	0		;TABLE USED BY OPUSL

SLSTAB	DW	SLS40
	DW	SLS40T
	DW	SLS80
	DW	SLS80T
SLTTAB	DW	SLT40
	DW	SLT40T
	DW	SLT80
	DW	SLT80T

;40 COLUMN, SCORE
SLS40	DB	40 DUP(32),"S:",5 DUP(32),"M:",6 DUP(32),0,80H
SLS40T	DW	-1
	DW	OPPRND
	DW	1
	DW	25
	DW	-1
	DW	OPPRNN
	DW	28
	DW	30
	DW	-1
	DW	OPPRNN
	DW	35
	DW	40

;40 COLUMN, TIME
SLT40	DB	40 DUP(32),"Time:",10 DUP(32),0,80H
SLT40T	DW	-1
	DW	OPPRND
	DW	1
	DW	24
	DW	-1
	DW	OPPRNH
	DW	31
	DW	33
	DW	-1
	DW	OPPRNM
	DW	34
	DW	40

;80 COLUMN, SCORE
SLS80	DB	110 DUP(32),"Score:", 10 DUP(32),"Moves:",7 DUP(32),0,80H
SLS80T	DW	-1
	DW	OPPRND
	DW	1
	DW	27
	DW	-1
	DW	OPPRNN
	DW	58
	DW	62
	DW	-1
	DW	OPPRNN
	DW	74
	DW	80

;80 COLUMN, TIME
SLT80	DB	120 DUP(32),"Time:", 13 DUP(32),0,80H
SLT80T	DW	-1
	DW	OPPRND
	DW	3
	DW	29
	DW	-1
	DW	OPPRNH
	DW	69
	DW	71
	DW	-1
	DW	OPPRNM
	DW	72
	DW	80

	;OPRAND
RSEED1	DW	?		;SEED1 FOR RANDOM NUMBERS
RSEED2	DW	?		;SEED2 FOR RANDOM NUMBERS
RTEMP	DW	?		;TEMP FOR RANDOM ROUTINE

	;READ
RDWSTR	DW	4 DUP(0)	;WORD STRING BUFFER FOR ZWORD
RDBOS	DW	0		;BEGINNING OF STRING POINTER
RDEOS	DW	0		;END OF STRING POINTER
RDRET	DW	0		;RETURN TABLE POINTER
RDNWDS	DB	0		;NUMBER OF WORDS READ
	;PUTSTR
WRDOFF	DW	0		;OFFSET INTO WORD TABLE FOR CURRENT SET
	;PUTCHR
CHRPTR	DW	0		;POINTS TO NEXT CHARACTER POSITION
ENDBUF	DW	0		;POINTS JUST PAST END OF OUTPUT BUFFER (0)
	;GETNUM
STATUS	DW	0		;STATUS-LINE-REQUESTED FLAG
	;ZIPBGN
IRBRKS	DB	" ",9,13,12,".,?",0  ;INITIAL SET OF READ BREAK CHARS
TWIDTH	DW	0		;TERMINAL WIDTH	
LFTMAR	DB	1		;LEFT MARGIN DEFAULT = 1 (2 FOR 80-COLUMN)
MEMTOP	DW	0		;LAST AVAILABLE LOCATION
TIMEMD	DW	0		;TIME(VERSUS SCORE)-MODE-FOR-STATUS-LINE FLAG
ZORKID	DW	0		;UNIQUE GAME & VERSION IDENTIFIER
ENDLOD	DW	0		;ENDLOD BLOCK NUMBER
VOCTAB	DW	0		;SAVE VOCABULARY TABLE POINTER
OBJTAB	DW	0		;OBJECT TABLE POINTER
GLOTAB	DW	0		;GLOBAL TABLE POINTER
WRDTAB	DW	0		;WORD TABLE POINTER
PURBOT	DW	0		;PURE CODE POINTER
ESIBKS	DW	0		;END OF SELF-INSERTING BREAK CHARACTERS
VWLEN	DW	0		;NUMBER OF BYTES IN A VOCABULARY WORD ENTRY
VWORDS	DW	0		;NUMBER OF WORD ENTRIES IN VOCABULARY
VOCBEG	DW	0		;BEGINNING OF ACTUAL VOCABULARY
OUTBUF	DB	81 DUP(?)	;OUTPUT BUFFER
INBUF	DB	150 DUP(?)	;INPUT BUFFER
RBRKS	DB	32 DUP(?)	;STRING OF READ BREAK CHARACTERS
PAGTAB	DB	64 DUP(254,0,0,0)	;PAGE INFORMATION TABLE
	DB	255
PAGES	DW	0		;SWAPPING AREA
BUFPGS	DW	0
CHRFLG	DB	0

	;RESTRT
ZLOCS	DW	0		;POINTER TO LOCALS
ZPC1	DW	0		;ZPC BLOCK-POINTER
ZPC2	DW	0		;ZPC BYTE-POINTER
ARGBLK	DW	4 DUP(?)	;ARGUMENT BLOCK FOR EXTENDED OPERATIONS
SAVDS	DW	0

	;NEWZPC
CURPAG	DW	0		;CURRENT PAGE (WHERE ZPC IS) POINTER
CURBLK	DW	0		;CURRENT BLOCK, USUALLY SAME AS ZPC1
CURTAB	DW	0		;CURRENT PAGE TABLE POINTER +1
	;GETPAG
RTIME1	DB	0		;REFERENCE TIME, 1 1/2 WORDS USED
RTIME2	DW	0
LPAGE	DW	0		;LAST REFERENCED PAGE NUMBER
LPLOC	DW	0		;AND ITS CORE LOCATION
LPTAB	DW	0		;AND ITS TABLE POINTER

	;OPERATION TABLES:
	;ZERO ARGUMENT OPERATIONS
ZEROOP	DW	OPRTRU		;176
	DW	OPRFAL		;177
	DW	OPPRNI		;178
	DW	OPPRNR		;179
	DW	OPNOOP		;180
	DW	OPSAVE		;181
	DW	OPREST		;182
	DW	OPRSTT		;183
	DW	OPRSTA		;184
	DW	OPFSTA		;185
	DW	OPQUIT		;186
	DW	OPCRLF		;187
	DW	OPUSL		;188
	DW	OPVERI		;189
	DW	0		;190
	DW	0		;191
	;ONE ARGUMENT OPERATIONS
ONEOP	DW	OPQZER		;128
	DW	OPQNEX		;129
	DW	OPQFIR		;130
	DW	OPLOC		;131
	DW	OPPTSI		;132
	DW	OPINC		;133
	DW	OPDEC		;134
	DW	OPPRNB		;135
	DW	0		;136
	DW	OPREMO		;137
	DW	OPPRND		;138
	DW	OPRETU		;139
	DW	OPJUMP		;140
	DW	OPPRIN		;141
	DW	OPVALU		;142
	DW	OPBCOM		;143
	;TWO ARGUMENT AND EXTENDED ARGUMENT OPERATIONS
EXTOP	DW	0		;0
	DW	OPQEQU		;1
	DW	OPQLES		;2
	DW	OPQGRT		;3
	DW	OPQDLE		;4
	DW	OPQIGR		;5
	DW	OPQIN		;6
	DW	OPBTST		;7
	DW	OPBOR		;8
	DW	OPBAND		;9
	DW	OPQFSE		;10
	DW	OPFSET		;11
	DW	OPFCLE		;12
	DW	OPSET		;13
	DW	OPMOVE		;14
	DW	OPGET		;15
	DW	OPGETB		;16
	DW	OPGETP		;17
	DW	OPGTPT		;18
	DW	OPNEXT		;19
	DW	OPADD		;20
	DW	OPSUB		;21
	DW	OPMUL		;22
	DW	OPDIV		;23
	DW	OPMOD		;24
	DW	0		;25
	DW	0		;26
	DW	0		;27
	DW	0		;28
	DW	0		;29
	DW	0		;30
	DW	0		;31
	DW	OPCALL		;224
	DW	OPPUT		;225
	DW	OPPUTB		;226
	DW	OPPUTP		;227
	DW	OPREAD		;228
	DW	OPPRNC		;229
	DW	OPPRNN		;230
	DW	OPRAND		;231
	DW	OPPUSH		;232
	DW	OPPOP		;233
	DW	0		;234
	DW	0		;235
	DW	0		;236
	DW	0		;237
	DW	0		;238
	DW	0		;239
	DW	0		;240
	DW	0		;241
	DW	0		;242
	DW	0		;243
	DW	0		;244
	DW	0		;245
	DW	0		;246
	DW	0		;247
	DW	0		;248
	DW	0		;249
	DW	0		;250
	DW	0		;251
	DW	0		;252
	DW	0		;253
	DW	0		;254
	DW	0		;255

	;MCRLF
MORE	DB	"**MORE** ",80H
EMORE	DB	13,"         ",13,80H
MORLIN	DW	0

	;STRUCTURE AND RECORD DEFINITIONS:
	;OBJECT OPERATIONS
OBJECT	STRUC
FLAGS1	DW	?
FLAGS2	DW	?
PARENT	DB	?
SIBLING	DB	?
CHILD1	DB	?
PROPS	DW	?
OBJECT	ENDS
PROPID	RECORD	PROPSIZE:3,PROPNUM:5

	;STRING DEFINITIONS
	
	;STATION IDENTIFICATION
IDSTR	DB	"MS-DOS 2.0 Interpreter Version G",0

	;TERMINAL SETUP
SSMSG1	DB	"Cannot open Setup File.",0
SSMSG2	DB	"Cannot read Setup File.",0
SSMSG3	DB	"Cannot close Setup File.",0

	;SAVE/RESTORE
SAV0	DB	"Insert save disk then enter file name.",0
SAV1	DB	"(Default is ",80H
SAV2	DB	"): ",80H
SAV3	DB	"Insert game disk then hit RETURN to continue.",0

ERR1	DB	"SAVE file not found",0
ERR3	DB	"Bad file name syntax",0
ERR4	DB	"No room in directory for SAVE file",0
ERR5	DB	"No room on diskette for SAVE file",0
ERR6	DB	"Read of SAVE file failed",0
	;READ
ERR2	DB	"Too many words typed, flushing: ",80H

	;OPNEXT/OPPUTP
FTL2	DB	"No such property",0
	;ZIPBGN
FTL4	DB	"Wrong game or version",0
	;NXTINS
FTL5	DB	"Illegal operation",0
	;FINDPG
FTL6	DB	"No free pages",0
	;GTBLKS
FTL7	DB	"Game file read error",0
	;SYSINI
FTL9	DB	"Game file not found",0
	;Fatal error header
FATHDR	DB	"Fatal error: ",80H
	;ZSTR CHARACTER CONVERSION VECTOR

ZCHRS	DB	"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
	DB	"  0123456789.,!?_#'"
	DB	'"/\-:()'

DBGFLG	DB	0
INSCNT	DW	0

DATA_SG	ENDS

	SUBTTL	MACROS
	PAGE	+

GTAWRD	MACRO	D,S		;;GET ABSOLUTE WORD
	MOV	D&X,ES:&S
	XCHG	D&H,D&L
	ENDM

PTAWRD	MACRO	D,S		;;PUT ABSOLUTE WORK
	XCHG	S&H,S&L
	MOV	ES:&D,S&X
	ENDM

MOVM	MACRO	D,S,R		;;MOVE MEMORY TO MEMORY
	MOV	R,S
	MOV	D,R
	ENDM

PUSHZ	MACRO	S		;;PUSH ONTO Z STACK
	XCHG	SP,DI
	PUSH	S
	XCHG	SP,DI
	ENDM

POPZ	MACRO	D		;;POP FROM Z STACK
	XCHG	SP,DI
	POP	D
	XCHG	SP,DI
	ENDM

POPZT	MACRO	D		;;GET TOP OF Z STACK
	MOV	D,SS:[DI]
	ENDM

PUSHZT	MACRO	S		;;PUT TOP OF Z STACK
	MOV	SS:[DI],S
	ENDM

PRINT	MACRO	STR		;;PRINT A STRING, POINTER IS ARGUMENT
	PUSH	AX
	MOV	AX,OFFSET STR
	CALL	MPRNT
	POP	AX
	ENDM

FATAL	MACRO	ERR		;;PRINT FATAL ERROR AND DIE
	CALL	MCRLF
	MOV	AX,OFFSET FATHDR
	CALL	MPRNT
	MOV	AX,OFFSET ERR
	CALL	MPRNT
	JMP	FINISH
	ENDM

	SUBTTL	SYSTEM INITIALIZATION
	PAGE	+

CODE_SG	SEGMENT	PARA
ASSUME	CS:CODE_SG,DS:DATA_SG,ES:GAME_SG,SS:STK_SG

START	PROC	FAR
	MOVM	DS,DATA_SG,AX
	MOVM	ES,GAME_SG,AX
	MOVM	SS,STK_SG,AX
	MOV	SP,OFFSET STK_TOP
	MOV	DI,OFFSET ZSTK_TP
	JMP	ZIPBGN		;JUMP TO BEGINNING OF ZIP CODE
START	ENDP

FEEP	PROC
	MOV	AX,7
	CALL	MTTYO		;BELL
	RET
FEEP	ENDP
;
; VERIFY
;
OPVERI	PROC
	PRINT	IDSTR
	MOV	AX,ES:[PLENTH]
	XCHG	AH,AL
	PUSH	SI
	PUSH	DI
	PUSH	ENDLOD
	CALL	BSPLIT
	MOV	SI,AX
	MOV	DI,BX
	MOV	AX,0
	MOV	BX,64
	MOV	DX,0
	MOV	ENDLOD,0
OPVR1:	PUSH	SI
	PUSH	DI
	PUSH	DX
	CALL	GETBYT
	POP	DX
	POP	DI
	POP	SI
	ADD	DX,CX
	CMP	AX,SI
	JNE	OPVR1
	CMP	BX,DI
	JNE	OPVR1
	MOV	AX,ES:[PCHKSM]
	XCHG	AH,AL
	POP	ENDLOD
	POP	DI
	POP	SI
	CMP	AX,DX
	JE	OPVR2
	JMP	PFALSE
OPVR2:	JMP	PTRUE
OPVERI	ENDP

;
; RESTORE
;
OPREST	PROC
	MOV	DSKDIR,0	;INDICATE RESTORE (READ)
	JMP	OSV0$
OPREST	ENDP

;
; SAVE
;
OPSAVE	PROC
	MOV	DSKDIR,1	;INDICATE SAVE (WRITE)

;
;COMMON ENTRYPOINT FOR SAVE AND RESTORE
;

;  DO A DISK RESET IN CASE THEY WANT TO CHANGE DISKS
;    UNFORTUNATELY WE HAVE TO ASSUME A 1 DRIVE SYSTEM AT THIS POINT
OSV0$:	MOV	AH,0DH		;CLOSE ALL OPEN FILES
	INT	21H

;  PRINT "FILENAME (DEFAULT IS drv:filename.ext):"

;    PRINT "FILENAME (DEFAULT IS drv:"
	PRINT 	SAV0		;PRINT "INSERT SAVE DISK THEN ENTER FILE NAME."
	PRINT	SAV1		;PRINT "FILE NAME (DEFAULT IS "
	MOV	AL,SAVFCB	;AL <= DRIVE NO.
	CMP	AL,0		;DRIVE A?
	JE	OSVD1		;....YES
	ADD	AL,64		;....NO. ADD 64 TO GET ASCII CHARACTER
	CALL	MTTYO		;PRINT DRIVE B, C, OR D
	MOV	AL,":"		;PRINT ":"
	CALL	MTTYO

;   PRINT "filename"
OSVD1:	MOV	CX,8			;8 CHARACTERS
	MOV	BX,OFFSET SAVFCB	;^ FCB
OSVD3:	INC	BX			;^ NEXT CHARACTER
	MOV	AL,BYTE PTR [BX]	;GET IT IN AL
	CMP	AL,20H			;IS IT A " "?
	JE	OSVD2			;....YES. WE'RE DONE
	CALL	MTTYO			;....NO. PRINT IT
	LOOP	OSVD3			;LOOP FOR NEXT CHARACTER

;   PRINT ".ext"
OSVD2:	MOV	AL,"."			;PRINT "."
	CALL	MTTYO
	MOV	CX,3			;3 CHARACTERS IN EXTENSION
	MOV	BX,OFFSET SAVFCB	;^ FCB
	ADD	BL,8			;CORRECT TO POINT AT ext-1
OSVD4:	INC	BX			;^ NEXT CHARACTER
	MOV	AL,BYTE PTR [BX]	;GET IT IN AL
	CALL	MTTYO			;PRINT IT
	LOOP	OSVD4			;LOOP UNTIL ALL THREE ARE PRINTED

;    PRINT " ): "
	PRINT	SAV2			;PRINT " ): "
	CMP	SCPL,50			;ARE MAX CHARS/LINE >50?
	JG	OSVD4A			;....YES
	CALL	MCRLF			;....NO. PRINT A <cr><lf>

; GET LOSER'S SAVE FILENAME FROM THE KEYBOARD
OSVD4A:	MOV	BX,OFFSET INBUF		;^ KEYBOARD INPUT BUFFER
	MOV	AL,15			;X:FIRSTNAM.EXT<CR>
	MOV	BYTE PTR [BX],AL	;SET UP BUFFER TO TAKE 15 CHARACTERS
	MOV	DX,BX			;DX ^ BUFFER
	MOV	AH,CRDLIN		;READ A LINE FROM THE KEYBOARD
	INT	21H
	MOV	AL,10			;PRINT A <lf>
	CALL	MTTYO

; PARSE THE FILENAME
	PUSH	ES			;SAVE'M
	PUSH	SI
	PUSH	DI
	MOV	SI,OFFSET INBUF
	ADD	SI,2			;SI ^ FIRST CHARACTER IN BUFFER
	MOV	AX,DS			;ES<=DS
	MOV	ES,AX
	MOV	DI,OFFSET SAVFCB	;DI ^FCB
	MOV	AH,CPRSNM		;SELECT DOS FUNCTION
	MOV	AL,0EH			;USE DEFAULTS IN SAVFCB
	INT	21H			;PARSE FILE NAME (FCB AT SAVFCB)
	POP	DI			;RESTORE'M
	POP	SI
	POP	ES

;  OPEN THE FILE IF OP RESTORE
	CMP	DSKDIR,1		;OP SAVE?
	JE	OSVOPW			;....YES
	MOV	DX,OFFSET SAVFCB	;....NO. OP RESTORE. DX ^ FCB
	MOV	AH,CFOPEN		;SELECT DOS OPEN FUNCTION 
	INT	21H			;OPEN THE FILE
	CMP	AL,0FFH			;FILE EXISTS?
	JE	OSVPSX			;....NO. FILE NOT FOUND
	JMP	OSVPS			;....YES
;
;  **** ERROR ****  [File Not Found]
;
OSVPSX:	MOV	AX,OFFSET ERR1		;^ "SAVE FILE NOT FOUND" MSG
	JMP	OSVPER			;ERROR EXIT

;  CREATE THE FILE IF OP SAVE
OSVOPW:	MOV	DX,OFFSET SAVFCB	;^ FCB
	MOV	AH,CFDELE		;DELETE FILE BEFORE OPENING
	INT	21H
	MOV	DX,OFFSET SAVFCB	;^FCB
	MOV	AH,CFMAKE		;SELECT DOS CREATE FUNCTION
	INT	21H
	CMP	AL,0FFH			;SUCCESS?
	JNE	OSVPS			;....YES
;
;  **** ERROR ****   [Directory Full]
;
	MOV	AX,OFFSET ERR4		;....NO. ^ "NO ROOM IN DIRECTORY" MSG
	JMP	OSVPER			;HOP TO ERROR EXIT
;
;WE'VE GOT AN OPEN FILE (WHICH WE CREATED IF IT WAS A SAVE FUNCTION)
;AND ARE READY TO EITHER READ (RESTORE) OR WRITE (SAVE) AS REQUIRED
;
OSVPS:	XCHG	DI,SP
	PUSH	ZPC1		; PUSH VITALS ONTO ZSTACK
	PUSH	ZPC2
	PUSH	ZLOCS
	PUSH	ZORKID

	MOV	STKBOT,SP	; PUT DEST. INDEX INTO STACKBOTTOM
	MOV	SP,DI		; RESTORE SP

	PUSH	AX		; HAS RESULT OF FILE CREATE
	PUSH	ES

	MOV	AX,SS		; FLOP STACK SEG AND EXTRA SEG
	MOV	ES,AX		; ES<=SS

	MOV	AX,0			; BLOCK NUMBER OF DISK
	MOV	BX,OFFSET STKBOT	; CORE LOCATION
	MOV	CX,2		; TRANSFER CX*4 (128 BYTES PER)BLOCKS
	CALL	SRBLKS		; DO THE BLOCK TRANSFER
	PUSHF			;SAVE RETURN CODE
	MOV	DI,SP		;DI ^ CURRENT ZSTACK POSITION
	MOV	SP,STKBOT	;SP <= ZSTACK POINTER
	POP	AX		; POP OFF AND COMPARE FOR ZORKID
	CMP	AX,ZORKID	;ID OK?
	JE	OSVT0		;....YES
	FATAL	FTL4		;....NO. FATAL ERROR

OSVT0:	POP	ZLOCS		;RESTORE LOCALS AND ZIP PROGRAM COUNTERS
	POP	ZPC2
	POP	ZPC1

	XCHG	DI,SP		;RESTORE MACHINE SP AND ZSTACK POINTER
	POPF			;RESTORE REGS
	POP	ES
	POP	AX
	JC	OSV4Y		;TRANSFER WAS UNSUCCESSFUL
;
; THE OPEN/CREATE FILE WAS SUCCESSFUL, AND SO WAS THE BLOCK TRANSFER
; SO TRANSFER THE REST
;
OSV4X:	MOV	AX,2		;BLOCK NUMBER OF DISK
	SUB	BX,BX		;START AT THE BEGINING
	MOV	CX,PURBOT	;CX * 4 BLOCKS TO READ OR WRITE
	CALL	SRBLKS
OSV4Y:	PUSHF			;SAVE DOS RETURN CODE
	MOV	AH,CFCLOS	;CLOSE THE FILE
	MOV	DX,OFFSET SAVFCB
	INT	21H
OSVCC:
	MOV	AL,SAVFCB	;AL <= DRIVE NO.
	CMP	AL,0		;DRIVE A?
	JNE	OSV2C		;....NO
OSV1C:	MOV	AH,0DH		;....YES. DO A DISK RESET BEFORE THEY
	INT	21H		;CHANGE DISKS
	PRINT	SAV3		;PRINT "INSERT GAME DISK" MSG
	CALL	MCHRI		;WAIT FOR KEYPRESS
	CALL	MCRLF		;PRINT <cr><lf>
OSV2C:	MOV	AH,CFOPEN	;OPEN THE GAME FILE
	MOV	DX,OFFSET GAMFCB
	INT	21H
	CMP	AL,0FFH
	JE	OSV1C		;LOOP UNTIL THEY DO IT
	CALL	NEWZPC		;GET A NEW PC
	POPF			;RESTORE DOS RETURN CODE
	JC	OSV4		;ERROR EXIT
;
;ELSE EVERYTHING WORKED SUCCESSFULLY
;AND WE CAN GO BACK TO WHAT WE WERE
;DOING..........
;
	MOV	AL,SCRFLG	;reenable scripting
	XCHG	AH,AL
	MOV	ES:[PFLAGS],AX
	JMP	PTRUE
;
;  **** ERROR **** [Unable to Read File]
;
OSV4:	MOV	AX,OFFSET ERR6	;^ "Read of SAVE file failed."
	CMP	DSKDIR,1	;OP SAVE?
	JNE	OSVPRR		;....NO
	MOV	AH,CFCLOS	;....YES. CLOSE IT
	MOV	DX,OFFSET SAVFCB
	INT	21H
;
;  **** ERROR **** [Diskette Full]
;
	MOV	AX,OFFSET ERR5	;^ "No room on diskette for SAVE file."
OSVPRR:	JMP	OSVPER
OPSAVE	ENDP
;
; ERROR EXIT R/W operations
;
OSVPER	PROC
	CALL	MPRNT		;PRINT ERROR MESSAGE
	MOV	AL,SCRFLG	;REENABLE SCRIPTING
	XCHG	AH,AL
	MOV	ES:[PFLAGS],AX
	JMP	PFALSE
OSVPER	ENDP
;
; OP RESTART
;
OPRSTT	PROC
	MOV	BP,CHRPTR
	MOV	BYTE PTR DS:[BP],0	;FORCE OUT THE BUFFER
	PRINT	OUTBUF
	JMP	RESTRT			;JUMP TO RESTART ADDRESS
OPRSTT	ENDP

OPQUIT	PROC
	JMP	FINISH
OPQUIT	ENDP

OPUSL	PROC
	CMP	SLFLG,0
	JNE	OPUSL1
	RET
OPUSL1:	PUSH	DI
	PUSH	CHRPTR
	MOV	BX,SLSTR
	MOV	CHRPTR,BX
	MOV	AX,16
	MOV	DI,SLTAB
	MOV	CX,3
USLLP:	PUSH	AX
	CALL	GETVAR
	MOV	DX,[DI+4]
	CALL	USLSET
	PUSH	CX
	PUSH	DI
	CALL	WORD PTR [DI+2]
	POP	DI
	MOV	DX,[DI+6]
	CALL	USLSPC
USLN:	ADD	DI,8
	POP	CX
USL1:	POP	AX
	INC	AX
	LOOP	USLLP
	MOV	AX,"$"
	CALL	PUTCHR
	CALL	MSOUT
	POP	CHRPTR
	POP	DI
	RET

USLSET:	MOV	BX,SLSTR
	MOV	CHRPTR,BX
	ADD	CHRPTR,DX
	RET

USLSPC:	MOV	CX,CHRPTR
	SUB	CX,SLSTR
	SUB	DX,CX
	MOV	CX,DX
	JLE	USLSP1
USLSPL:	MOV	AX,20H
	CALL	PUTCHR
	LOOP	USLSPL
USLSP1:	RET
OPUSL	ENDP

	SUBTTL	ARITHMETIC OPERATIONS
	PAGE	+

	;ADD
OPADD	PROC
	ADD	AX,BX		;ADD OPR1 AND OPR2
	JMP	PUTVAL		;RETURN THE VALUE
OPADD	ENDP

	;SUB
OPSUB	PROC
  	SUB	AX,BX		;SUBTRACT OPR2 FROM OPR1
	JMP	PUTVAL		;RETURN THE VALUE
OPSUB	ENDP

	;MULTIPLY AX BY BX
OPMUL	PROC
	IMUL	BX		;MULTIPLY OPR1 BY OPR2,IGNORING OVERFLOW(DX)
	JMP	PUTVAL		;RETURN THE VALUE
OPMUL	ENDP

	;DIVIDE AX BY BX
OPDIV	PROC
	CWD			;CLEAR HIGH WORD AND EXTEND SIGN FOR DIVIDE
	IDIV	BX		;DIVIDE OPR1 BY OPR2
	JMP	PUTVAL		;RETURN THE VALUE
OPDIV	ENDP

	;MOD
OPMOD	PROC
	CWD			;CLEAR HIGH WORD AND EXTEND SIGN FOR DIVIDE
	IDIV	BX		;DIVIDE OPR1 BY OPR2
	MOV	AX,DX		;WE WANT REMAINDER
	JMP	PUTVAL		;RETURN THE VALUE
OPMOD	ENDP

	;RANDOM BY DAN
OPRAND	PROC
	SUB	AH,AH		; HACK RANDOM TO ONE BYTE
	MOV	RTEMP,AX	; SAVE ARGUMENT FOR LATER
	MOV	AX,RSEED1
	MOV	BX,RSEED2
	MOV	RSEED2,AX
	CLC
	RCR	AX,1
	RCR	BX,1
	XOR	RSEED1,BX	;PUT XOR'D NUBMER INTO RSEED1
	MOV	AX,RSEED1	;THIS IS RANDOM VALUE

	AND	AX,0EFFFH	;CHOP HIGH BIT FOR DIVIDE
	SUB	DX,DX		;CLEAR MOST SIGN. PORTION OF 32 BIT WORD
	DIV	RTEMP		;DIVIDE WORD BY WORD
	MOV	AX,DX		;MOVE REMAINDER INTO AX
	INC	AX		;MAKE SURE NO ZERO
	JMP	PUTVAL
OPRAND	ENDP

	;RANDOM
;OPRAND	PROC
;	MOV	BX,AX		;SAVE OPR
;	MOV	AX,RSEED	;GET THE SEED
;	MOV	CX,257		;TRANSFORM IT
;	MUL	CX
;	ADD	AX,11
;	MOV	RSEED,AX	;SAVE NEW VALUE
;	SUB	DX,DX		;TRIM IT TO PROPER SIZE
;	AND	AX,0EFFFH	;CLEAR BIT TO PREVENT POSSIBLE OVERFLOW
;	DIV	BX
;	MOV	AX,DX
;	INC	AX		;MUST BE BETWEEN 1 AND N, INCLUSIVE
;	JMP	PUTVAL		;SIMPLY RETURN
;OPRAND	ENDP

	;LESS?
OPQLES	PROC
	CMP	AX,BX		;IS OPR1 LESS THAN OPR2?
	JL 	JPT		;YES, PREDICATE TRUE
JPF:	JMP	PFALSE		;NO, PREDICATE FALSE
JPT:	JMP	PTRUE
OPQLES	ENDP

	;GRTR?
OPQGRT	PROC
	CMP	AX,BX		;IS OPR1 GREATER THAN OPR2?
	JG 	JPT		;YES, PREDICATE TRUE
	JMP	JPF		;NO, PREDICATE FALSE
OPQGRT	ENDP

	SUBTTL	LOGICAL OPERATIONS
	PAGE	+

	;BTST
OPBTST	PROC
	NOT	AX		;TURN OFF BITS IN OPR2 THAT ARE ON IN OPR1
	AND	BX,AX
	JE	JPT		;SUCCESS IF OPR2 COMPLETELY CLEARED
	JMP	JPF
OPBTST	ENDP

	;BOR
OPBOR	PROC
	OR	AX,BX		;LOGICAL OR
	JMP	PUTVAL		;RETURN THE VALUE
OPBOR	ENDP

	;BCOM
OPBCOM	PROC	
	NOT	AX		;LOGICAL COMPLEMENT
	JMP	PUTVAL		;RETURN THE VALUE
OPBCOM	ENDP

	;BAND
OPBAND	PROC
	AND	AX,BX		;LOGICAL AND
	JMP	PUTVAL		;RETURN THE VALUE
OPBAND	ENDP

	SUBTTL	GENERAL PREDICATES
	PAGE	+

	;EQUAL?
OPQEQU	PROC
	NOP			;TELL CALLER TO USE ARGUMENT BLOCK
	MOV	BX,ARGBLK	;GET OPR1
	CMP	BX,ARGBLK[2]	;IS OPR1 EQUAL TO OPR2?
	JE	OQE1$		;YES
	CMP	AX,3		;NO, IS THERE A THIRD OPERAND?
	JL	OQE2$		;NO
	CMP	BX,ARGBLK[4]	;YES, IS IT EQUAL TO OPR1?
	JE	OQE1$		;YES
	CMP	AX,4		;NO, IS THERE A FOURTH?
	JL	OQE2$		;NO
	CMP	BX,ARGBLK[6]	;YES, IS IT EQUAL TO OPR1?
	JNE	OQE2$		;NO
OQE1$:	JMP	PTRUE		;PREDICATE TRUE IF EQUAL
OQE2$:	JMP	PFALSE		;PREDICATE FALSE IF NOT
OPQEQU	ENDP

	;ZERO?
OPQZER	PROC
	CMP	AX,0		;IS OPR ZERO?
	JNE	OQZ1$		;NO, PREDICATE FALSE
	JMP	PTRUE		;YES, PREDICATE TRUE
OQZ1$:	JMP	PFALSE
OPQZER	ENDP

	SUBTTL	OBJECT OPERATIONS
	PAGE	+

	;MOVE (OBJ1 INTO OBJ2)
OPMOVE	PROC
	PUSH	AX		;PROTECT OPRS FROM REMOVE CALL
	PUSH	BX
	CALL	OPREMO		;REMOVE OBJ1 FROM WHEREVER IT IS
	POP	DX		;OBJ2
	MOV	AX,DX
	CALL	OBJLOC		;FIND ITS LOCATION
	MOV	BX,AX		;MOVE TO BASE
	POP	CX		;OBJ1
	MOV	AX,CX
	CALL	OBJLOC		;FIND ITS LOCATION
	MOV	BP,AX		;MOVE TO BASE
	MOV	ES:[BP].PARENT,DL	;PUT OBJ2 INTO OBJ1'S LOC SLOT
	MOV	DH,ES:[BX].CHILD1	;GET CONTENTS OF OBJ2'S FIRST SLOT
	MOV	ES:[BX].CHILD1,CL	;MAKE OBJ1 FIRST CONTENT OF OBJ2
	CMP	DH,0		;WERE THERE ANY OTHER CONTENTS?
	JE	OMV1$		;NO
	MOV	ES:[BP].SIBLING,DH	;YES, CHAIN ONTO OBJ1'S SIBLING SLOT
OMV1$:	RET
OPMOVE	ENDP

	;REMOVE (OBJ FROM ITS PARENT)
OPREMO	PROC
	MOV	CX,AX		;SAVE OBJ FOR LATER
	CALL	OBJLOC		;FIND ITS LOCATION
	MOV	BX,AX		;MOVE TO BASE
	MOV	CH,ES:[BX].PARENT	;GET ITS PARENT
	CMP	CH,0		;DOES IT HAVE A PARENT?
	JE	ORM3$		;IF NOT, WE'RE DONE
	MOV	AL,CH		;PARENT
	CALL	OBJLOC		;FIND PARENT'S LOCATION
	MOV	BP,AX		;MOVE TO BASE
	MOV	DL,ES:[BP].CHILD1	;GET PARENT'S FIRST CONTENT
	CMP	DL,CL		;IS IT OBJ?
	JNE	ORM1$		;NO
	MOVM	ES:[BP].CHILD1,ES:[BX].SIBLING,AL	;YES, CHANGE SLOT TO
							;OBJ'S SIBLING
	JMP	ORM2$		;AND RETURN
ORM1$:	MOV	AL,DL		;CURRENT SIBLING
	CALL	OBJLOC		;FIND ITS LOCATION
	MOV	BP,AX		;MOVE TO BASE
	MOV	DL,ES:[BP].SIBLING	;GET NEXT SIBLING IN CHAIN
	CMP	DL,CL		;IS IT OBJ?
	JNE	ORM1$		;NO, CONTINUE LOOP
	MOVM	ES:[BP].SIBLING,ES:[BX].SIBLING,AL	;YES, CHANGE IT TO
							;OBJ'S SIBLING
ORM2$:	MOV	ES:[BX].PARENT,0	;OBJ NOW HAS NO PARENT
	MOV	ES:[BX].SIBLING,0	;OR SIBLING
ORM3$:	RET
OPREMO	ENDP

	;FSET? (IS FLAG SET IN OBJ?)
OPQFSE	PROC
	CALL	OBJLOC		;FIND OBJ'S LOCATION
	CMP	BX,16		;SECOND WORD FLAG?
	JL	OQF1$		;NO
	SUB	BX,16		;YES, SUBTRACT 16 FROM FLAG NUMBER
	INC	AX		;AND USE SECOND FLAG WORD
	INC	AX
OQF1$:	MOV	CX,BX		;MOVE TO COUNT
	MOV	BX,AX		;MOVE TO BASE
	GTAWRD	A,[BX]		;GET THE FLAG WORD
	MOV	DX,8000H	;SHIFT A BIT TO PROPER POSITION
	SHR	DX,CL
	TEST	AX,DX		;IS THIS BIT SET IN FLAG WORD?
	JE	OQF2$		;NO, PREDICATE FALSE
	JMP	PTRUE		;YES, PREDICATE TRUE
OQF2$:	JMP	PFALSE
OPQFSE	ENDP

	;FSET (SET A FLAG IN OBJ)
OPFSET	PROC
	CALL	OBJLOC		;FIND OBJ'S LOCATION
	CMP	BX,16		;SECOND WORD FLAG?
	JL	OFS1$		;NO
	SUB	BX,16		;YES, SUBTRACT 16 FROM FLAG NUMBER
	INC	AX		;AND USE SECOND FLAG WORD
	INC	AX
OFS1$:	MOV	CX,BX		;MOVE TO COUNT
	MOV	BX,AX		;MOVE TO BASE
	GTAWRD	A,[BX]		;GET THE FLAG WORD
	MOV	DX,8000H	;SHIFT A BIT TO PROPER POSITION
	SHR	DX,CL
	OR	AX,DX		;SET THIS BIT IN FLAG WORD
	PTAWRD	[BX],A		;STORE THE NEW FLAG WORD
	RET
OPFSET	ENDP

	;FCLEAR (CLEAR A FLAG IN OBJ)
OPFCLE	PROC
	CALL	OBJLOC		;FIND OBJ'S LOCATION
	CMP	BX,16		;SECOND WORD FLAG?
	JL	OFC1$		;NO
	SUB	BX,16		;YES, SUBTRACT 16 FROM FLAG NUMBER
	INC	AX		;AND USE SECOND FLAG WORD
	INC	AX
OFC1$:	MOV	CX,BX		;MOVE TO COUNT
	MOV	BX,AX		;MOVE TO BASE
	GTAWRD	A,[BX]		;GET THE FLAG WORD
	MOV	DX,7FFFH	;SHIFT A BIT TO PROPER POSITION
	ROR	DX,CL
	AND	AX,DX		;CLEAR THIS BIT IN FLAG WORD
	PTAWRD	[BX],A		;STORE THE NEW FLAG WORD
	RET
OPFCLE	ENDP

	;LOC (RETURN CONTAINER OF OBJ)
OPLOC	PROC
	CALL	OBJLOC		;FIND OBJ'S LOCATION
	MOV	BX,AX		;MOVE TO BASE
	MOV	AL,ES:[BX].PARENT	;GET LOC SLOT
	JMP	BYTVAL		;RETURN THE BYTE VALUE
OPLOC	ENDP

	;FIRST? (RETURN FIRST SLOT OF OBJ, FAIL IF NONE)
OPQFIR	PROC
	CALL	OBJLOC		;FIND OBJ'S LOCATION
	MOV	BX,AX		;MOVE TO BASE
	MOV	AL,ES:[BX].CHILD1	;GET FIRST SLOT
	PUSH	AX		;SAVE IT
	CALL	BYTVAL		;RETURN THE BYTE VALUE
	POP	AX		;RESTORE IT
	CMP	AL,0		;WAS IT ZERO?
	JE	JPF1		;YES, PREDICATE FALSE
JPT1:	JMP	PTRUE		;NO, PREDICATE TRUE
JPF1:	JMP	PFALSE
OPQFIR	ENDP

	;NEXT? (RETURN THE NEXT (SIBLING) SLOT OF OBJ, FAIL IF NONE)
OPQNEX	PROC
	CALL	OBJLOC		;FIND OBJ'S LOCATION
	MOV	BX,AX		;MOVE TO BASE
	MOV	AL,ES:[BX].SIBLING	;GET SIBLING SLOT
	PUSH	AX		;SAVE IT
	CALL	BYTVAL		;RETURN THE BYTE VALUE
	POP	AX		;RESTORE IT
	CMP	AL,0		;WAS IT ZERO?
	JE	JPF1		;YES, PREDICATE FALSE
	JMP	JPT1		;NO, PREDICATE TRUE
OPQNEX	ENDP

	;IN? (IS OBJ1 CONTAINED IN OBJ2?)
OPQIN	PROC
	CALL	OBJLOC		;FIND OBJ1'S LOCATION
	XCHG	AX,BX		;MOVE TO BASE
	CMP	ES:[BX].PARENT,AL	;IS OBJ1'S PARENT OBJ2?
	JE	JPT1		;YES, PREDICATE TRUE
	JMP	JPF1		;NO, PREDICATE FALSE
OPQIN	ENDP

	;GETP (GET SPECIFIED PROPERTY OF OBJ, DEFAULT IF NONE)
OPGETP	PROC
	MOV	DX,BX		;PROPERTY
	CALL	OBJLOC		;FIND OBJ'S LOCATION
	MOV	BP,AX		;MOVE TO BASE
	GTAWRD	B,[BP].PROPS	;GET LOCATION OF ITS PROPERTY TABLE
	MOV	AL,ES:[BX]	;LENGTH OF SHORT DESCRIPTION IN WORDS
	SUB	AH,AH		;CLEAN OFF ANY HIGH-ORDER BYTE
	SHL	AX,1		;CONVERT TO BYTES
	ADD	BX,AX		;ADJUST POINTER TO SKIP IT
	INC	BX		;ALSO SKIP LENGTH BYTE
	JMP	OGP2$		;SKIP NEXT LINE FIRST TIME THROUGH LOOP
OGP1$:	CALL	NXTPRP		;POINT TO NEXT PROPERTY
OGP2$:	MOV	AL,ES:[BX]	;GET PROPERTY IDENTIFIER
	AND	AL,MASK	PROPNUM	;CLEAN OFF LENGTH BITS
	CMP	AL,DL		;COMPARE PROPERTY NUMBER WITH DESIRED ONE
	JG	OGP1$		;IF GREATER, LOOP (TABLE SORTED IN REVERSE)
	JL	OGP3$		;IF LESS, NO SUCH PROPERTY HERE
	MOV	AL,ES:[BX]	;GOT IT, NOW FIND LENGTH OF PROPERTY
	INC	BX		;POINT TO PROPERTY VALUE
	AND	AL,MASK PROPSIZE;GET LENGTH BITS
	MOV	CL,PROPSIZE
	SHR	AL,CL
	CMP	AL,0		;BYTE VALUE?
	JNE	OGP5$		;NO
	MOV	AL,ES:[BX]	;GET THE BYTE
	JMP	BYTVAL		;AND RETURN IT
OGP3$:	DEC	DX		;POINT INTO DEFAULT PROPERTY TABLE
	SHL	DX,1
	MOV	BX,DX
OGP4$:	ADD	BX,OBJTAB	;GET THE WORD
OGP5$:	GTAWRD	A,[BX]	
	JMP	PUTVAL		;AND RETURN IT
OPGETP	ENDP

	;PUTP (CHANGE VALUE OF A PROPERTY, ERROR IF BAD NUMBER)
OPPUTP	PROC
	PUSH	CX		;SAVE NEW VALUE
	MOV	DX,BX		;PROPERTY
	CALL	OBJLOC		;FIND OBJ'S LOCATION
	MOV	BP,AX		;MOVE TO BASE
	GTAWRD	B,[BP].PROPS	;GET LOCATION OF ITS PROPERTY TABLE
	MOV	AL,ES:[BX]	;LENGTH OF SHORT DESCRIPTION IN WORDS
	SUB	AH,AH		;CLEAN OFF ANY HIGH-ORDER BYTE
	SHL	AX,1		;CONVERT TO BYTES
	ADD	BX,AX		;ADJUST POINTER TO SKIP IT
	INC	BX		;ALSO SKIP LENGTH BYTE
	JMP	OPP2$		;SKIP NEXT LINE FIRST TIME THROUGH LOOP
OPP1$:	CALL	NXTPRP		;POINT TO NEXT PROPERTY
OPP2$:	MOV	AL,ES:[BX]	;GET PROPERTY IDENTIFIER
	AND	AL,MASK PROPNUM	;CLEAN OFF LENGTH BITS
	CMP	AL,DL		;COMPARE PROPERTY NUMBER WITH DESIRED ONE
	JE	OPP3$		;IF EQUAL, GOT IT
	JG	OPP1$		;IF GREATER, LOOP (TABLE SORTED IN REVERSE)
	FATAL	FTL2		;OTHERWISE, FATAL ERROR
OPP3$:	MOV	AL,ES:[BX]	;NOW FIND LENGTH OF PROPERTY
	INC	BX		;POINT TO PROPERTY VALUE
	AND	AL,MASK PROPSIZE;GET LENGTH BITS
	MOV	CL,PROPSIZE
	SHR	AL,CL
	CMP	AL,0		;BYTE VALUE?
	POP	AX		;RESTORE NEW VALUE
	JNE	OPP4$		;ZERO MEANS BYTE VALUE
	MOV	ES:[BX],AL	;STORE THE NEW BYTE
	RET			;AND RETURN
OPP4$:	PTAWRD	[BX],A		;STORE THE NEW WORD VALUE
	RET
OPPUTP	ENDP

	;NEXTP (RETURN NUMBER OF NEXT PROP FOLLOWING GIVEN PROB IN OBJ)
OPNEXT	PROC
	MOV	DX,BX		;PROPERTY
	CALL	OBJLOC		;FIND OBJ'S LOCATION
	MOV	BP,AX		;MOVE TO BASE
	GTAWRD	B,[BP].PROPS	;GET ITS LOCATION
	MOV	AL,ES:[BX]	;LENGTH OF SHORT DESCRIPTION IN WORDS
	SUB	AH,AH		;CLEAN OFF ANY HIGH-ORDER BYTE
	SHL	AX,1		;CONVERT TO BYTES
	ADD	BX,AX		;ADJUST POINTER TO SKIP IT
	INC	BX		;ALSO SKIP LENGTH BYTE
	CMP	DX,0		;WERE WE GIVEN ZERO AS PROP?
	JE	ONX4$		;YES, GO RETURN FIRST PROPERTY NUMBER
	JMP	ONX2$		;NO, SKIP NEXT LINE FIRST TIME THROUGH LOOP
ONX1$:	CALL	NXTPRP		;POINT TO NEXT PROPERTY
ONX2$:	MOV	AL,ES:[BX]	;GET PROPERTY IDENTIFIER
	AND	AL,MASK PROPNUM	;CLEAN OFF LENGTH BITS
	CMP	AL,DL		;COMPARE PROPERTY NUMBER WITH DESIRED ONE
	JE	ONX3$		;IF EQUAL, GOT IT
	JG	ONX1$		;IF GREATER, LOOP (TABLE SORTED IN REVERSE)
	FATAL	FTL2		;OTHERWISE, FATAL ERROR
ONX3$:	CALL	NXTPRP		;POINT TO NEXT PROPERTY
ONX4$:	MOV	AL,ES:[BX]	;GET PROPERTY IDENTIFIER
	AND	AL,MASK PROPNUM	;EXTRACT PROPERTY NUMBER
	JMP	PUTVAL		;AND RETURN IT
OPNEXT	ENDP

	SUBTTL	TABLE OPERATIONS
	PAGE	+

	;GET (GET THE ITEM'TH WORD FROM TABLE)
OPGET	PROC
	SHL	BX,1		;CONVERT ITEM TO BYTE COUNT
	ADD	AX,BX		;INDEX INTO TABLE
	CALL	BSPLTB		;SPLIT THE POINTER
	CALL	GETWRD		;GET THE WORD
	MOV	AX,CX
	JMP	PUTVAL		;AND RETURN IT
OPGET	ENDP

	;GETB (GET THE ITEM'TH BYTE FROM TABLE)
OPGETB	PROC
	ADD	AX,BX		;INDEX INTO TABLE
	CALL	BSPLTB		;SPLIT THE POINTER
	CALL	GETBYT		;GET THE BYTE
	MOV	AX,CX
	JMP	BYTVAL		;AND RETURN IT
OPGETB	ENDP

	;PUT (REPLACE THE ITEM'TH WORD IN TABLE)
OPPUT	PROC
	SHL	BX,1		;CONVERT ITEM TO BYTE COUNT
	ADD	BX,AX		;INDEX INTO TABLE
	PTAWRD	[BX],C		;STORE THE WORD
	RET
OPPUT	ENDP

	;PUTB (REPLACE ITEM'TH BYTE IN TABLE)
OPPUTB	PROC
	ADD	BX,AX		;INDEX INTO TABLE
	MOV	ES:[BX],CL	;STORE BYTE
	RET
OPPUTB	ENDP

	;GETPT (GET POINTER TO PROPERTY TABLE FOR GIVEN PROP)
OPGTPT	PROC
	MOV	DX,BX		;PROPERTY
	CALL	OBJLOC		;FIND OBJ'S LOCATION
	MOV	BP,AX		;MOVE TO BASE
	GTAWRD	B,[BP].PROPS	;GET LOCATION OF ITS PROPERTY TABLE
	MOV	AL,ES:[BX]	;LENGTH OF SHORT DESCRIPTION IN WORDS
	SUB	AH,AH		;CLEAN OFF ANY HIGH-ORDER BYTE
	SHL	AX,1		;CONVERT TO BYTES
	ADD	BX,AX		;ADJUST POINTER TO SKIP IT
	INC	BX		;ALSO SKIP LENGTH BYTE
	JMP	OGT2$		;SKIP NEXT LINE FIRST TIME THROUGH LOOP
OGT1$:	CALL	NXTPRP		;POINT TO NEXT PROPERTY
OGT2$:	MOV	AL,ES:[BX]	;GET PROPERTY IDENTIFIER
	AND	AL,MASK PROPNUM	;CLEAN OFF LENGTH BITS
	CMP	AL,DL		;COMPARE PROPERTY NUMBER WITH DESIRED ONE
	JG	OGT1$		;IF GREATER, LOOP (TABLE SORTED IN REVERSE)
	JE	OGT3$		;FOUND THE PROPERTY
	SUB	AX,AX		;RETURN ZERO FOR NO SUCH PROPERTY
	JMP	OGT4$
OGT3$:	INC	BX		;POINT TO PROPERTY VALUE
	MOV	AX,BX		;AND RETURN IT
OGT4$:	JMP	PUTVAL
OPGTPT	ENDP

	;PTSIZE (RETURN SIZE OF PROPERTY TABLE)
OPPTSI	PROC
	MOV	BX,AX		;TABLE POINTER
	MOV	AL,ES:[BX-1]	;GET PROPERTY INDENTIFIER
	AND	AL,MASK PROPSIZE;EXTRACT LENGTH BITS
	SUB	AH,AH
	MOV	CL,PROPSIZE
	SHR	AX,CL
	INC	AX		;ADJUST TO ACTUAL LENGTH
	JMP	PUTVAL		;RETURN IT
OPPTSI	ENDP

	SUBTTL	VARIABLE OPERATIONS
	PAGE	+

	;VALUE (GET VALUE OF VAR)
OPVALU	PROC
	CALL	GETVAR		;GET THE VALUE
	JMP	PUTVAL		;AND RETURN IT
OPVALU	ENDP

	;SET (VAR TO VALUE)
OPSET	PROC
	JMP	PUTVAR		;STORE THE VALUE
OPSET	ENDP

	;PUSH (A VALUE ONTO THE STACK)
OPPUSH	PROC
	PUSHZ	AX		;PUSH THE VALUE
	RET
OPPUSH	ENDP

	;POP (A VALUE OFF THE STACK INTO VAR)
OPPOP	PROC
	POPZ	BX		;POP A VALUE
	JMP	PUTVAR		;AND STORE IT
OPPOP	ENDP

	;INC (INCREMENT VAR)
OPINC	PROC
	MOV	CX,AX		;VARIABLE
	CALL	GETVAR		;GET VAR'S VALUE
	INC	AX		;INCREMENT IT
OPINC1:	MOV	BX,AX		;VALUE
	MOV	AX,CX		;VARIABLE
	JMP	PUTVAR		;STORE NEW VALUE
OPINC	ENDP

	;DEC (DECREMENT VAR)
OPDEC	PROC
	MOV	CX,AX		;VARIABLE
	CALL	GETVAR		;GET VAR'S VALUE
	DEC	AX		;DECREMENT IT
	JMP	OPINC1		;STORE NEW VALUE
OPDEC	ENDP

	;IGRTR? (INCREMENT VAR & TEST IF GREATER THAN VAL)
OPQIGR	PROC
	PUSH	AX		;SAVE VARIABLE
	CALL	GETVAR		;GET VAR'S VALUE
	INC	AX		;INCREMENT IT
	SUB	CX,CX		;SET FLAG FALSE
	CMP	AX,BX		;NEW VALUE GREATER THAN VAL?
	JLE	OPQIG1		;NO
OPQIG0:	INC	CX		;YES, CHANGE FLAG TO TRUE
OPQIG1:	MOV	BX,AX		;VALUE
	POP	AX		;RESTORE VARIABLE
	CALL	PUTVAR		;STORE NEW VALUE
	CMP	CX,0		;TEST FLAG
	JE	OQI1$		;FALSE, PREDICATE FALSE
	JMP	PTRUE		;ELSE, PREDICATE TRUE
OQI1$:	JMP	PFALSE
OPQIGR	ENDP

	;DLESS? (DECREMENT VAR & TEST IF LESS THAN VAL)
OPQDLE	PROC
	PUSH	AX		;SAVE VARIABLE
	CALL	GETVAR		;GET VAR'S VALUE
	DEC	AX		;DECREMENT IT
	SUB	CX,CX		;SET FLAG FALSE
	CMP	AX,BX		;NEW VALUE LESS THAN VAL?
	JGE	OPQIG1		;NO, PREDICATE FALSE
	JMP	OPQIG0		;YES, PREDICATE TRUE
OPQDLE	ENDP

	SUBTTL	I/O OPERATIONS
	PAGE	+

GETLIN	PROC
	PUSH	BX
	MOV	AL,SCRFLG
	PUSH	AX
	MOV	SCRFLG,0
	PUSH	SI
	MOV	CL,ES:[SI]
	MOV	BX,OFFSET INBUF
	MOV	BYTE PTR [BX],CL
	MOV	DX,BX
	MOV	AH,CRDLIN
	INT	21H
	MOV	AH,CCONIO
	MOV	DL,10
	INT	21H
	POP	DX
	MOV	BX,OFFSET INBUF
	MOV	CL,BYTE PTR [BX+1]
	SUB	CH,CH
	INC	BX
	CMP	CL,0
	JE	GETLEM
GETLLP:	INC	SI
	INC	BX
	MOV	AL,BYTE PTR [BX]
	CMP	AL,"A"
	JL	GETLLC
	CMP	AL,"Z"
	JG	GETLLC
	ADD	AL,32
GETLLC:	MOV	ES:[SI],AL
	LOOP	GETLLP
GETLEM:	INC	SI
	SUB	AL,AL
	MOV	ES:[SI],AL
	POP	AX
	MOV	SCRFLG,AL
	POP	BX
	RET
GETLIN	ENDP

PRTOUT	PROC
	PUSH	AX
	PUSH	BX
	PUSH	CX
	MOV	DL,AL
	MOV	AH,CPROUT
	INT	21H
	POP	CX
	POP	BX
	POP	AX
	RET
PRTOUT	ENDP

SCRCHK	PROC
	PUSH	AX
	PUSH	BX
	PUSH	DX
	GTAWRD	A,[PFLAGS]
	TEST	AL,1		;CHECK IF SCRIPTING IS REQUESTED
	JZ	SCRNN$
	MOV	SCRFLG,1
	SUB	CX,CX
	MOV	BP,DX
	INC	BP
SCR1L$:	MOV	AL,ES:[BP]
	INC	BP
	CMP	BP,SI
	JLE	SCR2L$
	CALL	PRTCRL
	JMP	SCREX$
SCR2L$:	CALL	PRTOUT
	INC	CX
	CMP	CL,SCPL
	JNE	SCR1L$
	CALL	PRTCRL
	JC	SCREX$
	SUB	CX,CX
	JMP	SCR1L$

SCRNN$:	MOV	SCRFLG,0
SCREX$:	POP	DX
	POP	BX
	POP	AX
	RET
SCRCHK	ENDP

PRTCRL	PROC
	MOV	AL,13		;FINISH UP WITH CRLF
	CALL	PRTOUT
	MOV	AL,10
	CALL	PRTOUT
	RET
PRTCRL	ENDP

	;READ (A LINE OF INPUT & PARSE IT, LINE BUF IN ES:AX,
	;RETURN BUF IN ES:BX)
OPREAD	PROC
	MOV	INSCNT,0
	PUSH	AX		;SAVE LINE BUF
	PUSH	AX
	PUSH	BX
	CALL	OPUSL		;UPDATE STATUS LINE
	POP	BX
	POP	AX
	MOV	BP,CHRPTR	;NEXT CHARACTER POSITION
	MOV	BYTE PTR DS:[BP],80H ;DON'T END OUTPUT, IF ANY, WITH NEW LINE
ORD1$:	PRINT	OUTBUF		;FORCE OUT ANY QUEUED TEXT
	MOV	CHRPTR,OFFSET OUTBUF  ;RESET CHARACTER POINTER
	POP	SI		;INPUT BUFFER POINTER
	MOV	MORLIN,0	;RE-INITIALIZE MORE COUNT FROM HERE
	CALL	GETLIN		;GET SOME CHARACTERS
	CALL	SCRCHK		;CHECK FOR SCRIPTING, SCRIPT INPUT IF ON
ORDNS$:	PUSH	DI
	MOV	RDBOS,DX	;INITIALIZE RDBOS
	MOV	RDEOS,SI	;AND RDEOS
	MOV	RDRET,BX	;STORE RET POINTER
	MOV	RDNWDS,0	;NO WORDS SO FAR
	INC	DX		;SKIP LENGTH BYTE
	MOV	DI,BX		;THIS WILL BE WORD ENTRY POINTER
	INC	DI		;SKIP MAX WORDS & NWORDS BYTES
	INC	DI
ORD8$:	MOV	CX,OFFSET RDWSTR;HERE FOR NEXT WORD, POINT TO WORD STRING
	MOV	BX,DX		;AND SAVE BEGINNING OF WORD POINTER
ORD9$:	CMP	DX,RDEOS	;END OF STRING?
	JNE	ORD10$		;NO
	CMP	CX,OFFSET RDWSTR;YES, WAS A WORD FOUND?
	JNE	ORD15$		;YES, WE STILL HAVE TO LOOKUP WORD
	JMP	ORD23$		;NO, WE'RE DONE
ORD10$:	MOV	BP,DX		;GET NEXT CHARACTER FROM BUFFER
	MOV	AL,ES:[BP]
	CMP	AL,"A"
	JL	ORD1A$
	CMP	AL,"Z"
	JG	ORD1A$
	ADD	AL,32		;LOWERCASIFY ALPHABETICS
ORD1A$:	INC	DX
	MOV	SI,OFFSET RBRKS	;LIST OF READ BREAK CHARACTERS
ORD11$:	INC	SI
	CMP	AL,[SI-1]	;SEARCH LIST FOR THIS ONE
	JE	ORD12$		;FOUND IT
	CMP	BYTE PTR [SI],0  ;END OF LIST?
	JNE	ORD11$		;NO, CONTINUE SEARCH
	CMP	CX,OFFSET RDWSTR[6]  ;YES, NOT A BREAK, WORD STRING FULL?
	JE	ORD9$		;YES, LOOP UNTIL END OF WORD
	MOV	BP,CX		;NO, TACK THIS CHARACTER ONTO STRING
	MOV	DS:[BP],AL
	INC	CX
	JMP	ORD9$		;AND LOOP
ORD12$:	CMP	CX,OFFSET RDWSTR;WORD READ BEFORE THIS BREAK?
	JNE	ORD14$		;YES
	CMP	SI,ESIBKS	;NO, BUT IS IT A SELF-INSERTING BREAK?
	JBE	ORD13$		;YES
	INC	BX		;NO, UPDATE BEGINNING OF WORD TO SKIP BREAK
	JMP	ORD9$		;AND RETURN TO LOOP TO FIND A WORD
ORD13$:	MOV	BP,CX		;STORE THE BREAK IN WORD STRING
	MOV	DS:[BP],AL
	INC	CX
	JMP	ORD15$		;AND GO FOR THE WORD
ORD14$:	DEC	DX		;UNREAD TERMINATING BREAK IN CASE IT WAS SI
ORD15$:	INC	RDNWDS		;INCREMENT FOUND WORD COUNT
	MOV	BP,BX		;GREATER THAN MAX ALLOWED?
	MOV	BX,RDRET
	MOV	BL,ES:[BX]
	CMP	RDNWDS,BL
	MOV	BX,BP
	JLE	ORD16$		;NO
	PRINT	ERR2		;YES, INFORM LOSER
	MOV	AX,BX		;BEGINNING OF THIS WORD
	MOV	BP,RDEOS	;SAVE BYTE AFTER EOS
	MOV	BL,ES:[BP]
	MOV	BYTE PTR ES:[BP],0  ;ZERO IT TO MAKE STRING ASCIZ
	CALL	MPRNT		;PRINT IT
	MOV	ES:[BP],BL	;AND RESTORE OLD BYTE
	DEC	RDNWDS		;REMEMBER THAT WE FLUSHED THIS WORD
	JMP	ORD23$		;AND WE'RE DONE
ORD16$:	MOV	AX,BX		;CALCULATE NUMBER OF CHARACTERS IN WORD
	NEG	AX
	ADD	AX,DX
	MOV	ES:[DI+2],AL	;SAVE THE NUMBER IN RET TABLE
	SUB	BX,RDBOS	;BYTE OFFSET FOR BEGINNING OF WORD
	MOV	ES:[DI+3],BL	;STORE IT, TOO
	MOV	BP,CX		;MAKE WORD STRING ASCIZ
	MOV	BYTE PTR DS:[BP],0
	MOV	AX,OFFSET RDWSTR;POINT TO IT
	CALL	ZWORD		;AND CONVERT TO (2-WORD) ZWORD
	PUSH	DX		;SAVE CHAR & WORD ENTRY POINTERS
	PUSH	DI
	MOV	DI,AX		;FIRST ZWORD WORD
	MOV	SI,VWORDS	;NUMBER OF VOCABULARY WORDS
	MOV	AX,SI
	DEC	AX		;WE WANT TO POINT TO LAST WORD
	MUL	VWLEN		;MULTIPLY BY WORD LENGTH IN BYTES
	ADD	AX,VOCBEG	;ADD POINTER TO BEGINNING TO FIND LAST WORD
	MOV	CX,AX		;POINTER TO LAST WORD
	MOV	DX,DI		;FIRST ZWORD WORD
	MOV	DI,BX		;SECOND ZWORD WORD
	MOV	BX,VWLEN	;CALCULATE INITIAL OFFSET FOR BINARY SEARCH
	SAR	SI,1
ORD17$:	SAL	BX,1
	SAR	SI,1
	CMP	SI,0
	JNE	ORD17$
	MOV	SI,VOCBEG	;BEGINNING OF WORD TABLE
	ADD	SI,BX		;ADD CURRENT OFFSET(HALF OF POWER-OF-2 TABLE)
	PUSH	AX		;SAVE
	MOV	AX,VWLEN	;AVOID FENCEPOST BUG FOR EXACT POWER-OF-2 TBL
	SUB	SI,AX
	POP	AX		;RESTORE
ORD18$:	SAR	BX,1		;NEXT OFFSET WILL BE HALF OF PREVIOUS ONE
	GTAWRD	A,[SI]		;GET FIRST HALF OF CURRENT ZWORD
	CMP	DX,AX		;COMPARE DESIRED ONE TO IT
	JA	ORD19$		;GREATER, WE'LL HAVE TO MOVE UP
	JB	ORD20$		;LESS, WE'LL HAVE TO MOVE DOWN
	MOV	BP,SI		;SAME, GET SECOND HALF
	INC	BP
	INC	BP
	GTAWRD	A,[BP]
	CMP	DI,AX		;COMPARE DESIRED WORD WITH IT
	JA	ORD19$		;GREATER, WE'LL HAVE TO MOVE UP
	JB	ORD20$		;LESS, WE'LL HAVE TO MOVE DOWN
	JMP	ORD22$		;SAME, WE'VE FOUND IT, RETURN IT
ORD19$:	ADD	SI,BX		;TO MOVE UP, ADD CURRENT OFFSET
	CMP	SI,CX		;HAVE WE MOVED PAST END OF TABLE?
	JBE	ORD21$		;NO
	MOV	SI,CX		;YES, POINT TO END OF TABLE INSTEAD
	JMP	ORD21$
ORD20$:	SUB	SI,BX		;TO MOVE DOWN, SIMPLY SUBTRACT OFFSET
ORD21$:	CMP	BX,VWLEN	;IS OFFSET RESOLUTION BELOW ONE WORD?
	JGE	ORD18$		;NO, CONTINUE LOOP
	SUB	SI,SI		;YES, WORD NOT FOUND, RETURN ZERO
ORD22$:	POP	DI		;RESTORE WORD ENTRY POINTER
	MOV	DX,SI		;POINTER TO WORD FOUND
	XCHG	DH,DL
	MOV	ES:[DI],DX	;STORE IT
	POP	DX		;RESTORE CHAR POINTER
	ADD	DI,4		;UPDATE POINTER FOR NEXT WORD ENTRY
	JMP	ORD8$		;GO FOR IT
ORD23$:	INC	RDRET		;DONE, STORE NUMBER OF WORDS FOUND
	MOV	BP,RDRET
	MOVM	ES:[BP],RDNWDS,DL
	POP	DI		;RESTORE USER STACK POINTER
	RET			;AND RETURN
OPREAD	ENDP

	;PRINTC (PRINT CHAR WHOSE ASCII VALUE IS GIVEN)
OPPRNC	PROC
	JMP	PUTCHR		;QUEUE THE CHARACTER FOR PRINTING
OPPRNC	ENDP

	;PRINTN (PRINT A NUMBER)
OPPRNN	PROC
	MOV	BX,AX		;NUMBER TO PRINT
	CMP	BX,0
	JNE	OPN1$		;NON-ZERO
	MOV	AX,"0"		;SPECIAL CASE ZERO
	JMP	PUTCHR
OPN1$:	JG	OPN2$		;POSITIVE?
	MOV	AX,"-"		;NO, PRINT MINUS SIGN
	CALL	PUTCHR
	NEG	BX		;AND MAKE IT POSITIVE
OPN2$:	SUB	CX,CX		;COUNT OF DIGITS ON STACK
	JMP	OPN4$		;START WITH GREATER-THAN-10 TEST
OPN3$:	MOV	AX,BX		;EXTRACT A DIGIT
	MOV	BP,10
	CWD
	IDIV	BP
	PUSH	DX		;PUSH IT
	INC	CX		;BUMP COUNT
	MOV	BX,AX		;GET QUOTIENT
OPN4$:	CMP	BX,10		;MORE DIGITS TO EXTRACT?
	JGE	OPN3$		;YES, GO LOOP
	MOV	AX,BX		;NO, GET LAST (FIRST) DIGIT
	JMP	OPN6$		;ALREADY IN PLACE
OPN5$:	POP	AX		;POP NEXT DIGIT
OPN6$:	ADD	AX,"0"		;ASCIIZE IT
	CALL	PUTCHR		;QUEUE IT
	DEC	CX		;REDUCE DIGIT COUNT
	JGE	OPN5$		;LOOP IF SOME LEFT
	RET			;ELSE, RETURN
OPPRNN	ENDP

	;PRINT (THE STRING POINTED TO BY ES:AX)
OPPRIN	PROC
	CALL	BSPLIT		;SPLIT THE BLOCK & WORD NUMBERS
	JMP	PUTSTR		;PRINT THE STRING
OPPRIN	ENDP

	;PRINTB (PRINT THE STRING POINTED TO BY THE BYTE-POINTER ES:AX)
OPPRNB	PROC
	CALL	BSPLTB		;SPLIT THE BLOCK & BYTE NUMBERS
	JMP	PUTSTR		;PRINT THE STRING
OPPRNB	ENDP

;PSEUDO-INSTRUCTIONS FOR HOURS/MINUTES HERE FOR STATUS LINE
OPPRNH	PROC
	MOV	PMFLAG,0
	CMP	AL,12
	JL	OPH0$
	MOV	PMFLAG,1
OPH0$:	CMP	AL,12
	JLE	OPH1$
	SUB	AL,12		;HOUR SLOT IS 24 HOUR TIME
OPH1$:	CMP	AL,0
	JNE	OPHZ$
	MOV	AL,12
OPHZ$:	CMP	AL,9
	JG	OPH2$
	PUSH	AX
	MOV	AL,32
	CALL	PUTCHR		;OUTPUT SPACE FOR HOUR LESS THAN 10
	POP	AX
OPH2$:	CALL	OPPRNN
	MOV	AL,":"
	JMP	PUTCHR		;AND COLON
OPPRNH	ENDP

OPPRNM	PROC
	CMP	AL,9
	JG	OPM1$
	PUSH	AX
	MOV	AL,"0"
	CALL	PUTCHR
	POP	AX
OPM1$:	CALL	OPPRNN
	MOV	AL,32
	CALL	PUTCHR
	MOV	AL,"a"
	CMP	PMFLAG,0
	JE	OPM2$
	MOV	AL,"p"
OPM2$:	CALL	PUTCHR
	MOV	AL,"m"
	JMP	PUTCHR
OPPRNM	ENDP
	
	;PRINTD (PRINT OBJ'S SHORT DESCRIPTION)
OPPRND	PROC
	CALL	OBJLOC		;FIND OBJ'S LOCATION
	ADD	AX,7		;PROPERTY TABLE POINTER
	MOV	BP,AX
	GTAWRD	A,[BP]		;GET IT
	INC	AX		;POINT TO STRING
	CALL	BSPLTB		;SPLIT POINTER
	JMP	PUTSTR		;AND PRINT THE STRING
OPPRND	ENDP

	;PRINTI (PRINT THE STRING FOLLOWING THIS INSTRUCTION)
OPPRNI	PROC
	MOV	AX,ZPC1		;GET POINTER TO STRING
	MOV	BX,ZPC2
	CALL	PUTSTR		;AND PRINT IT
	MOV	ZPC1,AX		;UPDATE ZPC
	MOV	ZPC2,BX
	JMP	NEWZPC
OPPRNI	ENDP

	;PRINTR (PRINTI FOLLOWED BY RTRUE)
OPPRNR	PROC
	CALL	OPPRNI		;DO A PRINTI
	CALL	OPCRLF		;A CRLF
	JMP	OPRTRU		;AND AN RTRUE
OPPRNR	ENDP

	;CRLF (DO A NEWLINE)
OPCRLF	PROC
	JMP	NEWLIN		;DO A NEWLINE
OPCRLF	ENDP

	SUBTTL	CONTROL OPERATIONS
	PAGE	+

	;CALL (A FUNCTION WITH OPTIONAL ARGUMENTS), # OF ARGS IN AX
OPCALL	PROC
	NOP			;TELL CALLER TO USE ARGUMENT BLOCK
	MOV	DX,AX		;NUMBER OF ARGUMENTS TO CALL
	MOV	AX,ARGBLK	;FUNCTION TO CALL
	CMP	AX,0
	JNE	OCL1$		;ZERO?
	SUB	AX,AX		;YES, SIMPLY RETURN A ZERO
	JMP	PUTVAL
OCL1$:	PUSHZ	ZPC1		;OTHERWISE, SAVE OLD ZPC
	PUSHZ	ZPC2
	MOV	CX,ZLOCS	;AND OLD LOCAL POINTER
;	SUB	CX,STKBOT	;BUT RELATIVIZE IT IN CASE OF SAVE
	PUSHZ	CX		;AND SAVE IT
	CALL	BSPLIT		;SPLIT FUNCTION POINTER
	MOV	ZPC1,AX		;MAKE IT THE NEW ZPC
	MOV	ZPC2,BX
	CALL	NEWZPC		;UPDATE ZPC STUFF
	MOV	ZLOCS,DI	;LOCALS WILL START AT NEXT STACK SLOT
	SUB	ZLOCS,2
	CALL	NXTBYT		;NUMBER OF LOCALS
	MOV	BX,AX
	MOV	BP,OFFSET ARGBLK[2]  ;POINT TO FIRST OPTIONAL ARG
OCL2$:	DEC	BX		;ANY MORE LOCALS?
	JL	OCL4$		;NO, WE'RE DONE
	CALL	NXTWRD		;YES, GET THE NEXT LOCAL DEFAULT VALUE
	DEC	DX		;ANY MORE OPTIONALS GIVEN?
	JLE	OCL3$		;NO
	PUSHZ	DS:[BP]		;YES, USE ITS VALUE
	ADD	BP,2
	JMP	OCL2$		;AND CONTINUE LOOP
OCL3$:	PUSHZ	AX		;OTHERWISE, USE DEFAULT
	JMP	OCL2$		;AND LOOP
OCL4$:	RET
OPCALL	ENDP

	;RETURN (FROM CURRENT FUNCTION CALL)
OPRETU	PROC
	MOV	DI,ZLOCS	;RESTORE OLD TOP OF STACK
	POPZ	DX		;DUMMY POP			[WHY?]
	POPZ	ZLOCS		;AND OTHER VALUES

;	MOV	DX,STKBOT	;RE-ABSOLUTIZE THIS ONE
;	ADD	ZLOCS,DX	

	POPZ	ZPC2
	POPZ	ZPC1
	PUSH	AX		;VALUE TO RETURN
	CALL	NEWZPC		;UPDATE ZPC STUFF
	POP	AX
	JMP	PUTVAL		;RETURN THE VALUE
OPRETU	ENDP

	;RTRUE
OPRTRU	PROC
	MOV	AX,1		;RETURN A 1
	JMP	OPRETU
OPRTRU	ENDP

	;RFALSE
OPRFAL	PROC
	SUB	AX,AX		;RETURN A 0
	JMP	OPRETU
OPRFAL	ENDP

	;JUMP (TO A NEW LOCATION)
OPJUMP	PROC
	ADD	ZPC2,AX		;ADD OFFSET TO CURRENT ZPC
	SUB	ZPC2,2		;ADJUST IT
	JMP	NEWZPC		;NORMALIZE IT & UPDATE ZPC STUFF
OPJUMP	ENDP

	;RSTACK (RETURN STACK)
OPRSTA	PROC
	POPZ	AX		;POP A VALUE
	JMP	OPRETU		;AND RETURN IT
OPRSTA	ENDP

	;FSTACK (FLUSH A VALUE OFF THE STACK)
OPFSTA	PROC
	POPZ	DX		;FLUSH ONE
	RET
OPFSTA	ENDP

	;NOOP (NO OPERATION)
OPNOOP	PROC
	RET			;DO NOTHING
OPNOOP	ENDP

	SUBTTL	LOW LEVEL FUNCTIONS
	PAGE	+

	;GET A BYTE, BLOCK-POINTER ES:AX, BYTE-POINTER ES:BX, RESULT IN CX,
	;UPDATE AX & BX TO REFLECT BYTE GOTTEN
GETBYT	PROC
	PUSH	AX		;SAVE BLOCK-POINTER
	CMP	AX,ENDLOD	;IS THIS A PRELOADED LOCATION?
	JGE	GTY1$		;NO
	MOV	CL,9		;YES, RECONSTRUCT POINTER
	SHL	AX,CL		;SHIFT BLOCK POINTER BY 9
	OR	AX,BX		;ADD IN THE OFFSET
	XCHG	AX,BX
	MOV	CL,ES:[BX]	;GET THE BYTE
	JMP	GTY2$		;CLEAR UNWANTED BYTE & RETURN IT
GTY1$:	CALL	GETPAG		;FIND THE PROPER PAGE
	ADD	AX,BX		;POINT TO DESIRED BYTE
	XCHG	AX,BX
	MOV	CL,ES:[BX]	;GET IT
GTY2$:	SUB	CH,CH		;CLEAR UNWANTED BYTE & RETURN IT
	MOV	BX,AX
	POP	AX		;RESTORE BLOCK-POINTER
	INC	BX		;UPDATE POINTER
	CMP	BX,200H		;END-OF-PAGE?
	JNE	GTY3$		;NO
	SUB	BX,BX		;YES, CLEAR BYTE-POINTER
	INC	AX		;AND UPDATE BLOCK-POINTER
GTY3$:	RET
GETBYT	ENDP

	;GET A WORD, BLOCK POINTER ES:AX, BYTE-POINTER ES:BX, RESULT IN CX
GETWRD	PROC
	PUSH	DX		;SAVE
	CALL	GETBYT		;GET HIGH-ORDER BYTE
	PUSH	CX		;SAVE IT
	CALL	GETBYT		;GET LOW-ORDER BYTE
	POP	DX		;GET OTHER BYTE
	MOV	CH,DL		;POSITION IT
	POP	DX		;RESTORE
	RET
GETWRD	ENDP

	;GET THE NEXT BYTE, RETURN IT IN AX
NXTBYT	PROC
	PUSH	BX		;SAVE
	MOV	BX,ZPC2		;BYTE POINTER
	ADD	BX,CURPAG	;INDEX INTO CURRENT PAGE
	PUSH	ES:[BX]		;SAVE BYTE
	INC	ZPC2		;UPDATE PC
	CMP	ZPC2,200H	;END-OF-PAGE?
	JL	NXB1$		;NO
	CALL	NEWZPC		;YES, UPDATE PAGE
NXB1$:	POP	AX		;RETRIEVE BYTE
	SUB	AH,AH		;CLEAR UNWANTED BYTE
	POP	BX		;RESTORE
	RET			;AND RETURN IT
NXTBYT	ENDP

	;GET THE NEXT WORD, RETURN IT IN AX
NXTWRD	PROC
	PUSH	BX		;SAVE
	CALL	NXTBYT		;GET HIGH-ORDER BYTE
	PUSH	AX		;SAVE IT
	CALL	NXTBYT		;GET LOW-ORDER BYTE
	POP	BX		;GET HIGH-ORDER BYTE
	MOV	AH,BL		;POSITION IT
	POP	BX		;RESTORE
	RET			;RETURN THE WORD
NXTWRD	ENDP

	;GET AN ARGUMENT GIVEN ITS TYPE IN AX
GETARG	PROC
	DEC	AX		;EXAMINE ARGUMENT
	JL	NXTWRD		;0 MEANT LONG IMMEDIATE
	JE	NXTBYT		;1 MEANT SHORT IMMEDIATE
	CALL	NXTBYT		;2 MEANT VARIABLE, GET THE VAR
	CMP	AX,0		;STACK?
	JNE	GETVAR		;NO, JUST GET THE VAR'S VALUE
	POPZ	AX		;YES, POP THE STACK
	RET
GETARG	ENDP

	;GET VALUE OF A VARIABLE, VAR IN AX, VALUE RETURNED IN AX
GETVAR	PROC
	CMP	AX,0		;STACK?
	JNE	GTV1$		;NO
	POPZT	AX		;YES, GET TOP-OF-STACK
	RET
GTV1$:	PUSH	BP		;SAVE
	CMP	AX,16		;LOCAL?
	JGE	GTV3$		;NO
	DEC	AX		;YES, POINT TO PROPER STACK ELEMENT
	SHL	AX,1
	MOV	BP,ZLOCS
	SUB	BP,AX
	MOV	AX,[BP]		;AND GET IT
GTV2$:	POP	BP		;RESTORE
	RET
GTV3$:	SUB	AX,16		;GLOBAL, POINT TO PROPER GLOBAL TABLE ELEMENT
	SHL	AX,1
	ADD	AX,GLOTAB
	MOV	BP,AX		;AND GET IT
	GTAWRD	A,[BP]
	JMP	GTV2$
GETVAR	ENDP

	;UPDATE VALUE OF A VARIABLE, VAR IN AX, NEW VALUE IN BX
PUTVAR	PROC
	CMP	AX,0		;STACK?
	JNE	PTV1$		;NO
	PUSHZT	BX		;YES, UPDATE TOP-OF-STACK
	RET
PTV1$:	CMP	AX,16		;LOCAL?
	JGE	PTV2$		;NO
	PUSH	BP		;SAVE
	DEC	AX		;YES, POINT TO PROPER STACK ELEMENT
	SHL	AX,1
	MOV	BP,ZLOCS
	SUB	BP,AX
	MOV	[BP],BX		;AND UPDATE IT
	POP	BP		;RESTORE
	RET
PTV2$:	SUB	AX,16		;GLOBAL, POINT TO PROPER GLOBAL TABLE ELEMENT
	SHL	AX,1
	ADD	AX,GLOTAB
	XCHG	AX,BX		;AND UPDATE IT
	PTAWRD	[BX],A
	RET
PUTVAR	ENDP

	;RETURN VAL IN AX TO LOCATION SPECIFIED BY NEXTBYTE
	;DESTROYS BX, BUT IS USUALLY CALLED AT END OF TOP-LEVEL FUNCTION
BYTVAL	PROC
	SUB	AH,AH		;THIS ENTRY FOR BYTE VALUE TO CLEAR HIGH BYTE
	JMP	PUTVAL
BYTVAL	ENDP
	
PUTVAL	PROC
	MOV	BX,AX		;NORMAL ENTRY
	CALL	NXTBYT		;GET VAR TO USE
	CMP	AX,0		;STACK?
	JNE	PUTVAR		;NO, GO STORE VALUE
	PUSHZ	BX		;YES, PUSH ONTO STACK
	RET			;AND RETURN
PUTVAL	ENDP

	;PREDICATE HANDLERS TRUE & FALSE
	;DESTROYS REGISTERS, BUT ARE ONLY CALLED FROM END OF TOP-LEVEL FCNS
PFALSE	PROC
	SUB	BX,BX		;PREDICATE WAS FALSE, CLEAR FLAG
	JMP	PPRED
PFALSE	ENDP

PTRUE	PROC
	MOV	BX,1		;PREDICATE WAS TRUE, SET FLAG
	JMP	PPRED
PTRUE	ENDP
	
PPRED	PROC
	CALL	NXTBYT		;GET FIRST (OR ONLY) PREDICATE JUMP BYTE
	TEST	AX,80H		;NORMAL POLARITY PREDICATE?
	JE	PPR1$		;NO, LEAVE FLAG ALONE
	INC	BX		;YES, INCREMENT FLAG
PPR1$:	TEST	AX,40H		;ONE-BYTE JUMP OFFSET?
	JE	PPR2$		;NO
	AND	AX,0FF3FH	;YES, CLEAR SPECIAL BITS
	JMP	PPR3$
PPR2$:	AND	AX,0FF3FH	;CLR SPECIAL BITS FROM HIGH-ORDER OFFSET BYTE
	MOV	CX,AX		;HIGH-ORDER BYTE
	CALL	NXTBYT		;GET LOW-ORDER BYTE
	MOV	AH,CL		;MOVE IN HIGH-ORDER BITS
	TEST	AX,2000H	;IS NUMBER NEGATIVE (14-BIT 2'S COMP NUMBER)?
	JE	PPR3$		;NO
	OR	AX,0C000H	;YES, MAKE 16-BIT NUMBER NEGATIVE
PPR3$:	DEC	BX		;TEST FLAG
	JE	PPR6$		;WAS 1, THAT MEANS DO NOTHING
	CMP	AX,0		;ZERO JUMP?
	JNE	PPR4$		;NO
	JMP	OPRFAL		;YES, THAT MEANS DO AN RFALSE
PPR4$:	DEC	AX		;ONE JUMP?
	JNE	PPR5$		;NO
	JMP	OPRTRU		;YES, THAT MEANS DO AN RTRUE
PPR5$:	DEC	AX		;ADJUST OFFSET
	ADD	ZPC2,AX		;ADD TO PC
	JMP	NEWZPC		;AND UPDATE ZPC STUFF
PPR6$:	RET
PPRED	ENDP

	;SPLIT BYTE-POINTER IN AX TO BLOCK-POINTER IN AX & BYTE OFFSET IN BX
BSPLTB	PROC
	MOV	BX,AX
	XCHG	AL,AH		;EXTRACT BLOCK BITS
	SHR	AX,1
	AND	AX,7FH		;CLEAR UNWANTED BITS
	AND	BX,1FFH		;CLEAR ALL BUT BYTE OFFSET BITS
	RET
BSPLTB	ENDP

	;SPLIT WORD-POINTER IN AX TO BLOCK-POINTER IN AX & BYTE-OFFSET IN BX
BSPLIT	PROC
	MOV	BX,AX
	MOV	AL,AH		;EXTRACT BLOCK BITS
	SUB	AH,AH		;CLEAR UNWANTED BITS
	SUB	BH,BH		;CLEAR ALL BUT WORD OFFSET BITS
	SHL	BX,1		;CONVERT TO BYTE OFFSET
	RET
BSPLIT	ENDP
	
	SUBTTL	OBJECT HACKERS
	PAGE	+

	;GIVEN OBJ NUMBER IN AX, RETURN OBJ LOCATION IN AX
OBJLOC	PROC
	SUB	AH,AH		;CLEAR UNWANTED BITS
	PUSH	BX		;MULTIPLY BY 9 THE LAZY WAY
	MOV	BX,AX
	SHL	AX,1
	SHL	AX,1
	SHL	AX,1
	ADD	AX,BX
	POP	BX		;RESTORE
	ADD	AX,OBJTAB	;INDEX INTO OBJECT TABLE
	ADD	AX,53		;SKIPPING DEFAULT PROPERTY TABLE
	RET
OBJLOC	ENDP

	;GIVEN POINTER TO A PROPERTY IN BX!, UPDATE IT TO POINT TO NEXT PROP
NXTPRP	PROC
	PUSH	AX		;SAVE
	PUSH	CX		;SAVE
	MOV	AL,ES:[BX]	;GET PROPERTY IDENTIFIER
	AND	AL,MASK PROPSIZE;EXTRACT PROPERTY LENGTH (MINUS 1)
	MOV	CL,PROPSIZE
	SHR	AL,CL
	SUB	AH,AH
	ADD	BX,AX		;ADD IT TO OLD POINTER
	ADD	BX,2		;ADJUST FOR EXTRA LENGTH BYTE PLUS IDENTIFIER
	POP	CX		;RESTORE
	POP	AX		;RESTORE
	RET
NXTPRP	ENDP
	
	SUBTTL	STRING FUNCTIONS
	PAGE	+

	;OUTPUT A ZSTR, BLOCK-POINTER IN AX, BYTE-POINTER IN BX
	;RETURN UPDATED POINTER
PUTSTR	PROC
	PUSH	SI		;SAVE
	PUSH	CX		;SAVE
	PUSH	DX		;SAVE
	PUSH	DI		;SAVE
	PUSH	BP		;SAVE
	SUB	DX,DX		;TEMP CS STARTS AT 0
	SUB	DI,DI		;PERM CS STARTS AT 0
PTS1$:	CALL	GETWRD		;GET NEXT STRING WORD
	MOV	SI,CX
	PUSH	AX		;SAVE POINTER & COPY OF STRING WORD
	PUSH	BX
	PUSH	SI
	MOV	CX,3		;3 BYTES IN WORD
PTS2$:	PUSH	SI		;SAVE CURRENT BYTE (IN LOW-ORDER POSITION)
	MOV	BP,CX		;SHIFT TO NEXT BYTE
	MOV	CL,5
	SAR	SI,CL
	MOV	CX,BP
	LOOP	PTS2$		;LOOP UNTIL DONE
	MOV	CX,3		;RETRIEVE THE 3 BYTES
PTS3$:	POP	SI		;GET NEXT BYTE
	AND	SI,1FH		;CLEAR UNWANTED BITS
	CMP	DX,0		;IN WORD MODE?
	JGE	PTS4$		;NO			{WAS BPL, CHECK}
	SAL	SI,1		;YES, CALCULATE WORD OFFSET
	ADD	SI,WRDTAB	;POINT INTO WORD TABLE
	ADD	SI,WRDOFF	;USING PROPER 32-WORD BLOCK
	GTAWRD	A,[SI]		;POINT TO WORD STRING
	CALL	BSPLIT		;SPLIT IT
	CALL	PUTSTR		;AND PRINT IT
	JMP	PTS15$		;CONT. WHERE WE LEFT OFF WITH TEMP CS RESET
PTS4$:	CMP	DX,3		;CS 3 SELECTED (ASCII MODE)?
	JL	PTS6$		;NO, NORMAL CS
	JNE	PTS5$		;NO, BUT WE ARE IN ASCII MODE
	XCHG	DL,DH		;SHIFT SOME BITS HIGH TO MAKE NUMBER LARGE
	OR	DX,SI		;SAVE HIGH-ORDER ASCII BITS HERE
	JMP	PTS16$		;GO GET NEXT BYTE
PTS5$:	AND	DX,3		;EXTRACT PREVIOUSLY SAVED HIGH-ORDER BITS
	MOV	BP,CX		;POSITION THEM
	MOV	CL,5
	SAL	DX,CL
	MOV	CX,BP
	OR	DX,SI		;OR IN LOW-ORDER BITS
	MOV	AX,DX
	JMP	PTS14$		;GO PRINT THE CHARACTER
PTS6$:	CMP	SI,6		;SPECIAL CODE?
	JL	PTS9$		;YES, SPACE, WORD, OR SHIFT
	CMP	DX,2		;MIGHT ALSO BE SPECIAL IF IN CS 2
	JNE	PTS8$		;BUT WE'RE NOT
	CMP	SI,7		;CRLF?
	JE	PTS7$		;YES
	JG	PTS8$		;NO, NOT ASCII MODE, EITHER?
	INC	DX		;YES IT IS, SWITCH TO ASCII MODE
	JMP	PTS16$		;AND GO GET NEXT BYTE
PTS7$:	CALL	NEWLIN		;CRLF REQUESTED, DO A NEWLINE
	JMP	PTS15$
PTS8$:	MOV	AX,DX		;NORMAL CHARACTER, GET CS
	MOV	BP,26		;CALCULATE OFFSET FOR THIS CS
	MUL	BP
	ADD	AX,SI		;ADD IN CHARACTER OFFSET (+6)
	SUB	AX,6		;CHARACTER OFFSET
	MOV	BX,OFFSET ZCHRS	;GET THE CHARACTER FROM CONVERSION VECTOR
	XLAT	ZCHRS
	JMP	PTS14$		;GO PRINT IT
PTS9$:	CMP	SI,0		;IS IT A SPACE?
	JNE	PTS10$		;NO
	MOV	AX," "		;YES, GO PRINT A SPACE
	JMP	PTS14$
PTS10$:	CMP	SI,3		;IS IT A WORD?
	JG	PTS11$		;NO, MUST BE A SHIFT
	OR	DX,8000H	;SWITCH TO WORD MODE FOR NEXT BYTE
	DEC	SI		;CALCULATE WORD-TABLE BLOCK OFFSET
	MOV	BP,CX		;64 BYTES IN A BLOCK
	MOV	CL,6
	SHL	SI,CL
	MOV	CX,BP
	MOV	WRDOFF,SI	;SAVE IT AND LOOP
	JMP	PTS16$
PTS11$:	SUB	SI,3		;CALCULATE NEW CS
	CMP	DX,0		;TEMPORARY SHIFT (FROM CS 0)?
	JNE	PTS12$		;NO
	MOV	DX,SI		;YES, JUST SAVE NEW TEMP CS
	JMP	PTS16$
PTS12$:	CMP	SI,DX		;IS THIS THE CURRENT CS?
	JE	PTS13$		;YES, DO A PERM SHIFT TO IT
	SUB	DX,DX		;OTHERWISE, PERM SHIFT TO CS 0
PTS13$:	MOV	DI,DX		;TEMP & PERM CS'S ARE SAME NOW
	JMP	PTS16$
PTS3A$:	JMP	PTS3$		;DUMMY FOR NON-SHORT LOOP
PTS14$:	CALL	PUTCHR		;PRINT THE CHARACTER
PTS15$:	MOV	DX,DI		;RESET TEMP CS TO PERM CS
PTS16$:	LOOP	PTS3A$		;NEXT BYTE
	POP	SI		;RESTORE POINTERS & ORIGINAL STRING WORD
	POP	BX
	POP	AX
	CMP	SI,0		;END-OF-STRING?
	JL	PTS1A$		;YES, CLEAN UP & RETURN UPDATED POINTER
	JMP	PTS1$		;NO, GET NEXT WORD
PTS1A$:	POP	BP		;RESTORES
	POP	DI
	POP	DX
	POP	CX
	POP	SI
	RET
PUTSTR	ENDP

	;GIVEN AN ASCII CHARACTER IN AX, RETURN THE CHARACTER SET # IN AX
CHRCS	PROC
	CMP	AX,0		;IS THIS A NULL?
	JNE	CCS1$		;NO
	MOV	AX,3		;YES, RETURN DUMMY CS NUMBER
	RET
CCS1$:	PUSH	BX		;SAVE
	MOV	BX,OFFSET ZCHRS	;POINT TO CONVERSION VECTOR
CCS2$:	INC	BX		;FOUND THE CHARACTER?
	CMP	AL,[BX-1]
	JE	CCS3$		;YES
	CMP	BYTE PTR [BX],0	;NO, END OF STRING?
	JNE	CCS2$		;NO, CONTINUE LOOP
	MOV	AX,2		;YES, CALL IT CS 2
	JMP	CCS5$
CCS3$:	SUB	BX,OFFSET ZCHRS	;FIND CHARACTER POSITION
	SUB	AX,AX		;START WITH CS 0
CCS4$:	SUB	BX,26		;EVERY 26 CHARACTERS IS A NEW CS
	JLE	CCS5$		;DONE
	INC	AX		;INCREMENT CS # & CONTINUE LOOP
	JMP	CCS4$
CCS5$:	POP	BX
	RET
CHRCS	ENDP

	;GIVEN AN ASCII CHARACTER IN AX, RETURN ZSTR BYTE VALUE IN AX
CHRBYT	PROC
	PUSH	BX		;SAVE
	MOV	BX,OFFSET ZCHRS	;POINT TO CHARACTER CONVERSION TABLE
CHB1$:	INC	BX	;FOUND THE CHARACTER?
	CMP	AL,[BX-1]
	JE	CHB2$		;YES
	CMP	BYTE PTR [BX],0	;NO, END OF STRING?
	JNE	CHB1$		;NO, CONTINUE LOOP
	SUB	AX,AX		;YES, RETURN ZERO FOR FAILURE
	JMP	CHB4$
CHB2$:	SUB	BX,OFFSET ZCHRS-5  ;ADJUST POINTER SO FIRST CHARACTER IS 6
	MOV	AX,BX
CHB3$:	CMP	AX,32		;SUBTRACT MULTIPLES OF 26 UNTIL BASE CODE
	JL	CHB4$
	SUB	AX,26
	JMP	CHB3$
CHB4$:	POP	BX		;RESTORE
	RET
CHRBYT	ENDP

	;CONVERT UP TO 6 ASCIZ CHARS POINTED TO BY DS:AX
	;TO A 2-WORD ZSTR RETURNED IN AX & BX
ZWORD	PROC
	PUSH	SI		;SAVES
	PUSH	CX
	PUSH	DX
	PUSH	DI
	PUSH	BP
	MOV	SI,AX		;CHARACTER STRING POINTER
	SUB	DI,DI		;CS STARTS AT 0
	MOV	CX,6		;MAKE 6 ZSTR BYTES
ZWD1$:	INC	SI		;GET NEXT CHARACTER
	MOV	BL,[SI-1]
	CMP	BL,0
	JNE	ZWD3$		;NOT END-OF-STRING
	MOV	AX,OFFSET PADCHR;AT END-OF-STRING, PAD WITH PAD CHARACTER
ZWD2$:	PUSH	AX		;SAVE A PAD BYTE
	LOOP	ZWD2$		;LOOP UNTIL DONE
	JMP	ZWD6$		;THEN GO FORM ZWORD
ZWD3$:	MOV	AX,BX
	CALL	CHRCS		;FIND THE CS NUMBER FOR THIS CHAR
	CMP	AX,0		;CS 0?
	JE	ZWD4$		;YES
	ADD	AX,3		;NO, CALCULATE TEMP SHIFT BYTE
	PUSH	AX		;SAVE THE SHIFT BYTE
	DEC	CX		;REDUCE BYTE COUNT
	JE	ZWD6$		;DONE
ZWD4$:	MOV	AX,BX		;FIND THE PROPER BYTE VALUE FOR THIS CHAR
	CALL	CHRBYT
	CMP	AX,0		;IN NORMAL CS'S?
	JNE	ZWD5$		;YES
	MOV	AX,6		;NO, USE ASCII SHIFT
	PUSH	AX
	DEC	CX		;DONE YET?
	JE	ZWD6$		;YES
	MOV	AX,BX		;NO, SAVE HIGH-ORDER ASCII BITS
	MOV	BP,CX
	MOV	CL,5
	SAR	AX,CL
	MOV	CX,BP
	PUSH	AX
	DEC	CX		;DONE YET?
	JE	ZWD6$		;YES
	AND	BX,1FH		;NO, SAVE LOW-ORDER ASCII BITS
	MOV	AX,BX
ZWD5$:	PUSH	AX		;SAVE THIS BYTE
	LOOP	ZWD1$		;LOOP UNTIL ZWORD FULL
ZWD6$:	MOV	BP,SP		;BUILD ZWORD WORDS FROM 6 SAVED BYTES
	MOV	AX,[BP+10]
	MOV	CL,5
	SHL	AX,CL
	OR	AX,[BP+8]
	SHL	AX,CL
	OR	AX,[BP+6]
	MOV	BX,[BP+4]
	SHL	BX,CL
	OR	BX,[BP+2]
	SHL	BX,CL
	OR	BX,[BP]
	OR	BX,8000H	;SET END-OF-STRING BIT IN SECOND WORD
	ADD	SP,12		;FLUSH STACK
	POP	BP		;RESTORES
	POP	DI
	POP	DX
	POP	CX
	POP	SI
	RET
ZWORD	ENDP
	
	SUBTTL	TERMINAL I/O
	PAGE	+

	;QUEUE CHARACTER IN AX FOR OUTPUT
PUTCHR	PROC
	PUSH	BP
	MOV	BP,CHRPTR
	CMP	BP,ENDBUF
	JNE	PTC7
	PUSH	AX
	PUSH	BX
	PUSH	SI
	MOV	BX,ENDBUF
	MOV	SI,OFFSET OUTBUF
PTC1:	DEC	BX
	CMP	BYTE PTR [BX]," "
	JE	PTC3
	CMP	BX,SI
	JNE	PTC1
PTC2:	PRINT	OUTBUF
	MOV	CHRPTR,SI
	MOV	BP,SP
	CMP	BYTE PTR 4 [BP]," "
	JNE	PTC6
	MOV	WORD PTR 4 [BP],0
	JMP	PTC6
PTC3:	CMP	BX,SI
	JE	PTC2
	MOV	BYTE PTR [BX],0
	PRINT	OUTBUF
	MOV	AX,ENDBUF
	INC	BX
PTC4:	CMP	BX,AX
	JE	PTC5
	MOV	BP,AX
	MOV	AL,[BX]
	MOV	[SI],AL
	MOV	AX,BP
	INC	BX
	INC	SI
	JMP	PTC4
PTC5:	MOV	CHRPTR,SI
PTC6:	POP	SI
	POP	BX
	POP	AX
	CMP	AX,0
	JE	PTC8
PTC7:	MOV	BP,CHRPTR
	MOV	DS:[BP],AL
	INC	CHRPTR
PTC8:	POP	BP
	RET	
PUTCHR	ENDP

	;GO TO NEW LINE, OUTPUTTING CURRENT BUFFER
NEWLIN	PROC
	PUSH	BX		;SAVE
	MOV	BX,CHRPTR	;END LINE AT CURRENT POINT
	MOV	BYTE PTR [BX],0
	MOV	CHRPTR,OFFSET OUTBUF  ;RESET CHARACTER POINTER
	POP	BX		;RESTORE
	PRINT	OUTBUF		;AND OUTPUT LINE
	RET
NEWLIN	ENDP

	SUBTTL	TOP LEVEL STUFF
	PAGE	+

	; READ THE SETUP FILE
SSETUP	PROC	NEAR
	MOV	DX,OFFSET SSFCB
	MOV	AH,CFOPEN	; TRY OPENING THE SETUP FILE
	INT	21H
	CMP	AL,0FFH
	JE	SSET1		; IF OPEN FAIL, COMPLAIN
	MOV	BX,OFFSET SSFCB
	MOV	WORD PTR [BX+14],SSLNT
	MOV	DX,OFFSET SSBUF
	MOV	AH,CSDMAO	; POINT TO THE INPUT BUFFER
	INT	21H
	MOV	DX,OFFSET SSFCB
	MOV	AH,CRDRND	; READ INTO THE BUFFER
	INT	21H
	CMP	AL,0
	JNE	SSET2		; IF READ FAIL, COMPLAIN
	MOV	BX,OFFSET SSBUF
	MOV	AL,[BX]
	SUB	AL,SSVER
	DEC	AL		; FOR A 25 LINE SCREEN, SLPP HAS 24 IN IT
	MOV	SLPP,AL
	MOV	AL,[BX+1]
	SUB	AL,SSHOR
	MOV	SCPL,AL
	MOV	SLFLG,1		; SET IT TO ANSI
	MOV	AL,[BX+2]
	CMP	AL,"N"		; IS IT ASCII
	JNE	SSET4		; NO, THEN LEAVE IT ALONE
	MOV	SLFLG,0		; YES, THEN SET IT TO ASCII
SSET4:	MOV	DX,OFFSET SSFCB
	MOV	AH,CFCLOS	; CLOSE THE SETUP FILE
	INT	21H
	CMP	AL,0FFH
	JE	SSET3		; IF CANNOT CLOSE FILE, COMPLAIN
	RET
SSET1:	PRINT	SSMSG1
	RET
SSET2:	PRINT	SSMSG2
	RET
SSET3:	PRINT	SSMSG3
	RET
SSETUP	ENDP

	;INITIALIZATION
TSETUP	PROC
	MOV	BX,OFFSET SELINE1
	MOV	AL,SLPP
	SUB	AH,AH
	INC	AX			; FOR SLPP = 24, THE CURSOR IS AT 25
	DIV	RADIX
	ADD	AH,"0"
	ADD	AL,"0"
	MOV	[BX],AX
	MOV	BX,OFFSET OUTBUF
	MOV	CL,SCPL
	SUB	CH,CH
	ADD	BX,CX
	MOV	ENDBUF,BX
	MOV	BYTE PTR [BX],0
	MOV	BX,OFFSET SLSTAB
	CMP	TIMEMD,0
	JE	TSET1
	ADD	BX,8
TSET1:	CMP	CX,55
	JL	TSET2
	MOV	AX,60
	SUB	CX,80
	MOV	SI,4
	JMP	TSET3
TSET2:	MOV	AX,15
	SUB	CX,40
	SUB	SI,SI
TSET3:	SUB	AX,CX
	ADD	AX,[BX][SI]
	MOV	BX,2[BX][SI]
	TEST	CX,CX
	JG	TSET4
	ADD	6[BX],CX
TSET4:	ADD	12[BX],CX
	ADD	14[BX],CX
	ADD	20[BX],CX
	ADD	22[BX],CX
	MOV	SLSTR,AX
	MOV	SLTAB,BX
	CALL	MINIT
	RET
TSETUP	ENDP

	;INITIALIZATION
TTSETUP	PROC
	MOV	BX,OFFSET OUTBUF
	MOV	AL,SCPL
	SUB	AH,AH
	ADD	BX,AX
	MOV	ENDBUF,BX
	MOV	BYTE PTR [BX],0
	MOV	BX,OFFSET SLSTAB
	CMP	TIMEMD,0
	JE	TSET1
	ADD	BX,8
TTSET1:	MOV	SI,0
	CMP	SCPL,39
	JE	TSET2
	ADD	SI,4
TTSET2:	MOV	AX,[BX][SI]
	MOV	SLSTR,AX
	MOV	CX,2[BX][SI]
	MOV	SLTAB,CX
	CALL	MINIT
	RET
TTSETUP	ENDP

ZIPBGN	PROC
	CALL	SYSINI		;DO ANY SYSTEM INITIALIZATION
STR5$:	SUB	AX,AX		;BLOCK 0
	SUB	BX,BX		;PUT AT BEGINNING OF GAME SEGMENT
	CALL	GETBLK		;GET THE BLOCK
	CMP	BYTE PTR ES:[PVERS1],ZMVERS  ;PROPER Z-MACHINE VERSION?
	JNE	STR8$		;NO
	TEST	BYTE PTR ES:[PVERS2],1  ;YES,PROPER MODE BITS?
	JE	STR9$		;YES
STR8$:	FATAL	FTL4		;SOMETHING WRONG, DIE
STR9$:	TEST	BYTE PTR ES:[PVERS2],2  ;TIME MODE REQUESTED?
	JE	STR10$		;NO
	INC	TIMEMD		;YES, SET TIME-MODE FLAG
STR10$:	MOV	AL,BYTE PTR ES:[PVERS2]
	CMP	SLFLG,0
	JNE	STR11$
	OR	AL,10H		;TURN ON THE NO STATUS LINE BIT
	MOV	BYTE PTR ES:[PVERS2],AL
STR11$:	GTAWRD	A,[PZRKID]	;UNIQUE GAME & VERSION INDENTIFIER
	MOV	ZORKID,AX
	GTAWRD	A,[PENDLD]	;GET ENDLOD POINTER
	TEST	AX,1FFH		;ROUND UP TO NEXT BLOCK
	JE	STR12$
	AND	AX,0FE00H
	ADD	AX,200H
STR12$:	MOV	CX,AX
	MOV	BP,CX		;EXTRACT ENDLOD BLOCK
	MOV	CL,9
	SAR	BP,CL
	MOV	CX,BP
	MOV	ENDLOD,CX	;SAVE ENDLOD BLOCK NUMBER
	DEC	CX		;NUMBER OF BLOCKS LEFT TO LOAD
	MOV	AX,1		;STARTING WITH BLOCK 1
	MOV	BX,200H		;LOCATION TO PUT THEM
	CALL	GTBLKS		;GET THE BLOCKS
	GTAWRD	A,[PVOCTB]	;VOCAB LOCATION
	MOV	VOCTAB,AX	;SAVE VOCABULARY TABLE POINTER
	GTAWRD	A,[POBJTB]	;GET OBJECT TABLE POINTER
	MOV	OBJTAB,AX
	GTAWRD	A,[PGLOTB]	;GET GLOBAL TABLE POINTER
	MOV	GLOTAB,AX
	GTAWRD	A,[PWRDTB]	;GET WORD TABLE POINTER
	MOV	WRDTAB,AX
	GTAWRD	A,[PPURBT]	;GET PURE CODE POINTER
	TEST	AX,1FFH		;ROUND UP TO NEXT BLOCK
	JE	STR13$
	ADD	AX,200H
STR13$:	MOV	CL,9		;EXTRACT BLOCK NUMBER
	SAR	AX,CL
	AND	AX,7FH		;CLEAR UNWANTED BITS
	MOV	PURBOT,AX	;SAVE IT
	MOV	BX,OFFSET RBRKS	;START OF READ BREAK CHARACTER TABLE
	MOV	SI,VOCTAB	;VOCAB TABLE POINTER
	MOV	CL,BYTE PTR ES:[SI]  ;1ST BYTE IN VOCTAB IS # OF SIBREAKS
	SUB	CH,CH		;CLEAR HIGH BYTE
	INC	SI
STR14$:	MOVM	[BX],ES:[SI],AL ;TRANSFER THEM
	INC	BX
	INC	SI
	LOOP	STR14$
	MOV	ESIBKS,BX	;REMEMBER END OF SI BREAKS
	MOV	BP,OFFSET IRBRKS;ALWAYS END WITH INITIAL BREAK CHARACTERS
STR15$:	MOVM	[BX],DS:[BP],AL	;TRANSFER THEM
	INC	BX
	INC	BP
	CMP	AL,0
	JNE	STR15$
	MOV	AL,ES:[SI]	;GET VOCABULARY ENTRY LENGTH
	SUB	AH,AH
	MOV	VWLEN,AX	;AND STORE IT AWAY
	INC	SI
	GTAWRD	A,[SI]		;GET NEXT WORD IN TABLE
	MOV	VWORDS,AX	;NUMBER OF WORD ENTRIES IN VOCABULARY
	ADD	SI,2		;MOVE TO NEXT WORD
	MOV	VOCBEG,SI	;BEGINNING OF ACTUAL VOCABULARY

	MOV	SI,ENDLOD	;GET # PAGES IN ENDLOD
	MOV	CL,9
	SHL	SI,CL		;THIS IS FIRST LOCATION (ES:) OF PAGING 
	MOV	PAGES,SI	;SAVE THIS TO USE AS AN OFFSET

	MOV	BUFPGS,63	;OUR TABLE IS ONLY SO BIG....
	MOV	SI,63
STR16$:	SHL	SI,1
	SHL	SI,1		;EACH PAGE HAS 4 BYTES OF INFO
	MOV	BX,OFFSET PAGTAB  ;POINT INTO PAGE INFO TABLE
	ADD	SI,BX
	MOV	WORD PTR [SI],-1  ;MAKE THIS THE END OF TABLE MARK
	CALL	MTIME
STR17$:	JMP	START1
ZIPBGN	ENDP

	;RESTART EXECUTION HERE
RESTRT	PROC
	SUB	AX,AX		;REREAD ALL OF THE IMPURE STUFF
	SUB	BX,BX
	MOV	CX,PURBOT
	CALL	GTBLKS
	JMP	RESTRT1		; PATCH TO FIX STATUS LINE BUG (5)/PHG
START1:	

;	MOV	AL,BYTE PTR ES:[PVERS2]
;	ADD	AL,8		;TANDY BIT
;	MOV	BYTE PTR ES:[PVERS2],AL
	
	CALL	TSETUP		;SETUP TERMINAL/STATUS LINE
RESTRT1:CALL	CLRSCR		;CLEAR THE REMAINDER OF SCREEN
	MOV	SP,OFFSET STK_TOP  ;INITIALIZE OUR STACK POINTER
	MOV	DI,OFFSET ZSTK_TP  ;INITIALIZE USER STACK POINTER
	MOV	CHRPTR,OFFSET OUTBUF  ;INITIALIZE OUTPUT CHARACTER POINTER
	MOV	ZLOCS,DI	;LOCALS WOULD START AT FIRST SLOT,
	SUB	ZLOCS,2		;IF THERE WERE ANY
	GTAWRD	A,[PSTART]	;GET STARTING LOCATION
	CALL	BSPLTB		;SPLIT BLOCK & BYTE POINTERS
	MOV	ZPC1,AX		;INITIALIZE ZPC BLOCK-POINTER
	MOV	ZPC2,BX		;INITIALIZE ZPC BYTE-POINTER
	CALL	NEWZPC		;GET PAGE TO EXECUTE
	JMP	NXTINS
RESTRT	ENDP
	
	;MAIN INSTRUCTION INTERPRETATION LOOP
NXTINS	PROC
	CALL	NXTBYT		;GET THE OPERATION BYTE
	MOV	DX,AX		;SAVE A COPY
	CMP	AX,80H		;IS IT A 2OP?
	JL	NXI9$		;YES
	CMP	AX,0B0H		;NO, IS IT A 1OP?
	JGE	NXI0A$		;NO
	JMP	NXI12$		;YES
NXI0A$:	CMP	AX,0C0H		;IS IT A 0OP?
	JG	NXI0B$		;NO
	JMP	NXI13$		;YES
NXI0B$:	AND	AX,3FH		;IT'S EXTENDED, GET THE OPCODE
	SHL	AX,1		;MAKE IT A WORD OFFSET
	MOV	BP,AX		;GET THE OPERATOR POINTER
	MOV	SI,DS:[BP+EXTOP]
	CMP	SI,0
	JNE	NXI0C$		;OPERATION EXISTS
	JMP	NXI14$		;NO SUCH OPERATION
NXI0C$:	CALL	NXTBYT		;GET THE ARGUMENT BYTE
	MOV	CX,4		;SPLIT IT INTO 4 2-BIT MODE BYTES
NXI1$:	PUSH	AX
	SAR	AX,1
	SAR	AX,1
	LOOP	NXI1$
	MOV	CX,4		;RETRIEVE THE 4 BYTES IN PROPER ORDER
	SUB	DX,DX
	MOV	BX,OFFSET ARGBLK;FIRST ARGUMENT SLOT
NXI2$:	POP	AX		;GET NEXT MODE BYTE?
	AND	AX,3		;CLEAR OFF UNWANTED BITS
	CMP	AX,3		;NO MORE ARGUMENTS?
	JE	NXI4$		;YES, FLUSH ANY OTHER MODE BYTES
	CALL	GETARG		;ELSE, GET THE NEXT ARGUMENT
	MOV	[BX],AX		;SAVE IT IN ARGUMENT BLOCK
	ADD	BX,2
	INC	DX		;REMEMBER NUMBER OF ARGS GOTTEN
NXI3$:	LOOP	NXI2$		;LOOP FOR REST OF MODE BYTES
	JMP	NXI5$
NXI4$:	DEC	CX		;DETERMINE NUMBER OF REMAINING MODE BYTES
	SHL	CX,1		;WORD COUNT
	ADD	SP,CX		;FLUSH THEM
NXI5$:	XCHG	CX,DX
	MOV	AX,CX		;NUMBER OF ARGS GOES HERE FOR OPERATOR TO USE
	CMP	CS:BYTE PTR [SI],90H  ;DOES OPERATOR WANT ARGBLK POINTER?
	JE	NXI8A$		;YES, CALL OPERATOR NOW
	DEC	CX		;NO, IT WANTS ARGS IN REGISTERS
	JL	NXI8A$		;NO ARGS, JUST CALL OPERATOR
	JE	NXI8$		;1 ARG, GET IT
	SUB	CX,2
	JL	NXI7$		;2 ARGS
	JE	NXI6$		;3 ARGS
	MOV	DX,ARGBLK[6]	;ELSE, 4 ARGS, GET 4TH
NXI6$:	MOV	CX,ARGBLK[4]	;GET 3RD
NXI7$:	MOV	BX,ARGBLK[2]	;GET 2ND
NXI8$:	MOV	AX,ARGBLK	;GET FIRST ARG
NXI8A$:	JMP	NXI15$		;AND CALL OPERATOR
NXI9$:	AND	AX,1FH		;2OP, EXTRACT OPERATION BITS
	SHL	AX,1		;MAKE IT A WORD OFFSET
	MOV	BP,AX		;FIND POINTER TO OPERATOR ROUTINE
	MOV	SI,DS:[BP+EXTOP]
	CMP	SI,0
	JE	NXI14$		;NO SUCH OPERATION
	MOV	AX,1		;ASSUME FIRST ARG IS AN IMMEDIATE
	TEST	DX,40H		;IS IT INSTEAD A VARIABLE?
	JE	NXI10$		;NO
	INC	AX		;YES, CHANGE MODE
NXI10$:	CALL	GETARG		;GET THE FIRST ARG
	PUSH	AX		;SAVE IT
	MOV	AX,1		;ASSUME SECOND ARG IS AN IMMEDIATE
	TEST	DX,20H		;IS IT INSTEAD A VARIABLE?
	JE	NXI11$		;NO
	INC	AX		;YES, CHANGE MODE
NXI11$:	CALL	GETARG		;GET THE SECOND ARG
	MOV	BX,AX		;POSITION IT
	POP	AX		;RECOVER FIRST ARG
	CMP	CS:BYTE PTR [SI],90H  ;DOES ROUTINE WANT ARGUMENT BLOCK?
	JNE	NXI15$		;NO, GO CALL IT
	MOV	ARGBLK,AX	;YES, MOVE ARGS TO ARGBLK
	MOV	ARGBLK[2],BX
	MOV	AX,2		;ALWAYS 2 ARGS
	JMP	NXI15$		;NOW CALL OPERATOR
NXI12$:	AND	DX,0FH		;1OP, EXTRACT OPERATION BITS
	SHL	DX,1		;MAKE IT A WORD OFFSET
	MOV	BP,DX		;GET OPERATOR ROUTINE POINTER
	MOV	SI,DS:[BP+ONEOP]
	CMP	SI,0
	JE	NXI14$		;ILLEGAL OPERATION
	SAR	AX,1		;EXTRACT MODE BITS
	SAR	AX,1
	SAR	AX,1
	SAR	AX,1
	AND	AX,3
	CALL	GETARG		;GET THE ARGUMENT
	JMP	NXI15$		;AND CALL OPERATOR
NXI13$:	AND	AX,0FH		;0OP, EXTRACT OPERATION BITS
	SHL	AX,1		;MAKE IT A WORD OFFSET
	MOV	BP,AX		;GET OPERATOR ROUTINE POINTER
	MOV	SI,DS:[BP+ZEROOP]
	CMP	SI,0
	JNE	NXI15$		;IT'S A LEGAL OPERATION
NXI14$:	FATAL	FTL5		;OTHERWISE, COMPLAIN
NXI15$:	CALL	SI		;CALL THE OPERATOR ROUTINE
	JMP	NXTINS		;AND LOOP FOR NEXT INSTRUCTION
NXTINS	ENDP

	SUBTTL	PAGING ROUTINES
	PAGE	+

	;NORMALIZE ZPC & GET PROPER PAGE
NEWZPC	PROC
	PUSH	SI		;SAVES
	PUSH	BP
	PUSH	BX
	PUSH	CX
	PUSH	DX
	SUB	AX,AX		;USE DOUBLE-WORD ARITHMETIC
	MOV	BX,ZPC1		;GET BLOCK-POINTER
	MOV	BH,BL		;POSITION IT
	SUB	BL,BL
	SHL	BX,1
	ADC	AX,0
	MOV	SI,ZPC2		;GET BYTE-OFFSET
	XCHG	SI,AX		;DOUBLE-WORDIFY IT (MIGHT BE NEGATIVE)
	CWD
	XCHG	SI,AX
	ADD	BX,SI		;ADD IT TO OTHER DOUBLE WORD
	ADC	AX,DX
	MOV	DX,BX
	AND	DX,1FFH		;EXTRACT BYTE-OFFSET
	MOV	ZPC2,DX		;SAVE IT
	MOV	CL,9		;EXTRACT BLOCK-POINTER
	SAR	BX,CL
	AND	BX,7FH
	TEST	AX,1		;TEST 17TH BIT
	JE	NWZ1$		;WAS 0
	OR	BX,80H		;WAS 1, SET PROPER BIT IN BLOCK-POINTER
NWZ1$:	MOV	ZPC1,BX		;SAVE IT
	CMP	BX,CURBLK	;HAS IT CHANGED?
	JE	NWZ5$		;NO
	MOV	CURBLK,BX	;YES, REMEMBER NEW BLOCK
	MOV	AX,CURTAB	;IS OLD PAGE IN PAGING SPACE?
	CMP	AX,0
	JE	NWZ2$		;NO
	MOV	BP,AX		;YES, STORE CURRENT REF TIME FOR OLD PAGE
	MOVM	DS:[BP],RTIME1,CL
	MOVM	DS:[BP+1],RTIME2,CX
	INC	AX
NWZ2$:	CMP	BX,ENDLOD	;NEW PAGE ALREADY IN CORE?
	JL	NWZ3$		;YES
	MOV	AX,BX		;NO, GET NEW PAGE
	CALL	GETPAG
	MOV	BX,AX
	MOV	AX,LPTAB	;GET NEW PAGE TABLE POINTER
	INC	AX		;POINT TO REF SLOT
	MOV	CURTAB,AX	;SAVE THIS POINTER FOR LATER
	MOV	BP,AX		;STORE HIGHEST RTIME TO KEEP PAGE FOR US
	MOV	BYTE PTR DS:[BP],-1
	MOV	WORD PTR DS:[BP+1],-1
	INC	AX
	JMP	NWZ4$
NWZ3$:	MOV	CL,9		;CALCULATE PAGE ADDRESS
	SHL	BX,CL
	MOV	CURTAB,0	;CLEARING POINTER MEANS PAGE IS PRELOADED
NWZ4$:	MOV	CURPAG,BX	;UPDATE PAGE POINTER
NWZ5$:	POP	DX		;RESTORES
	POP	CX
	POP	BX
	POP	BP
	POP	SI
	RET			;AND RETURN
NEWZPC	ENDP

	;GET THE PAGE WHOSE NUMBER IS IN AX, RETURN A POINTER TO IT IN AX
GETPAG	PROC
	CMP	AX,LPAGE	;IS THIS THE SAME PAGE AS LAST REFERENCED?
	JNE	GTP1$		;NO
	MOV	AX,LPLOC	;YES, WE ALREADY HAVE LOCATION
	RET			;RETURN IT
GTP1$:	MOV	LPAGE,AX	;SAVE NEW PAGE NUMBER
	PUSH	CX		;SAVES
	PUSH	BX
	ADD	RTIME2,1	;UPDATE REFERENCE TIME (COUNT)
	ADC	RTIME1,0
	MOV	BX,OFFSET PAGTAB;PAGE INFORMATION TABLE
GTP2$:	INC	BX
	CMP	AL,[BX-1]	;SEARCH FOR DESIRED BLOCK
	JNE	GTP3$		;NOT IT
	CMP	AX,CURBLK	;IS THIS THE CURRENT CODE PAGE?
	JE	GTP2A$		;DON'T UPDATE REFERENCE TIME
	MOVM	[BX],RTIME1,CL	;FOUND IT, UPDATE ITS REFERENCE TIME
	MOVM	[BX+1],RTIME2,CX
GTP2A$:	DEC	BX		;BACKUP TO BEGINNING OF TABLE ENTRY
	MOV	LPTAB,BX	;SAVE IT
	SUB	BX,OFFSET PAGTAB;CALCULATE ADDRESS OF PAGE
	MOV	CL,7
	SHL	BX,CL
	ADD	BX,PAGES
	JMP	GTP4$		;AND RETURN PAGE POINTER
GTP3$:	ADD	BX,3		;SKIP REFERENCE TIME
	CMP	WORD PTR [BX],-1;END OF TABLE?
	JNE	GTP2$		;NO, CONTINUE SEARCH
	CALL	FINDPG		;YES, FIND A PAGE TO LOAD INTO
	PUSH	AX		;PAGE POINTER
	MOV	LPTAB,BX	;SAVE PAGE TABLE POINTER
	MOV	AX,LPAGE	;SAVE NEW BLOCK NUMBER
	MOV	[BX],AL
	MOVM	[BX+1],RTIME1,CL;AND CURRENT REF TIME
	MOVM	[BX+2],RTIME2,CX
	POP	BX		;PAGE POINTER
	CALL	GETBLK		;GET THE BLOCK
GTP4$:	MOV	AX,BX		;RETURN PAGE POINTER
	MOV	LPLOC,AX	;AND SAVE IT FOR LATER
	POP	BX		;RESTORES
	POP	CX
	RET
GETPAG	ENDP

	;FIND A GOOD PAGE, RETURN PAGE POINTER IN AX & PAGTAB POINTER IN BX
FINDPG	PROC
	PUSH	CX
	MOV	BX,OFFSET PAGTAB
	MOV	CX,-1		;FAKE BEST-CASE REFERENCE COUNT
	MOV	DX,CX
	INC	BX		;SKIP BLOCK NUMBER FOR NOW
FNP1$:	INC	BX		;IS THIS REF TIME WORSE THAN CURRENT WORST?
	CMP	[BX-1],CL
	JA	FNP3$		;NO
	JB	FNP2$		;YES
	CMP	[BX],DX		;MAYBE, COMPARE LOW-ORDER WORDS, WORSE?
	JAE	FNP3$		;NO
FNP2$:	MOV	CL,[BX-1]	;YES, SAVE ITS REF COUNT
	MOV	DX,[BX]
	MOV	AX,BX		;AND LOCATION (+2)
FNP3$:	ADD	BX,3		;SKIP SECOND WORD
	CMP	BYTE PTR [BX-1],-1	;LOOP UNTIL END OF TABLE
	JNE	FNP1$
	INC	CX		;WAS A PAGE REALLY FOUND?
	JE	FNP4$		;NO, GROSS BUG!
	SUB	AX,2		;YES, CALCULATE CORE LOCATION OF PAGE
	MOV	BX,AX
	SUB	AX,OFFSET PAGTAB
	MOV	CL,7
	SHL	AX,CL
	ADD	AX,PAGES
	POP	CX		;RESTORES
	RET
FNP4$:	FATAL	FTL6
FINDPG	ENDP

	SUBTTL	HIGH LEVEL IBMPC DEPENDENT STUFF

	;SYSTEM INITIALIZATION
SYSINI	PROC
	MOV	AH,CFOPEN
	MOV	DX,OFFSET GAMFCB
	INT	21H
	CMP	AL,0FFH
	JE	SYSFTL
	CALL	SSETUP
	RET
SYSFTL:	FATAL	FTL9	
SYSINI	ENDP

CLRSCR	PROC
	RET
CLRSCR	ENDP

	;GET A GAME FILE BLOCK, BLOCK NUMBER IN AX, CORE LOCATION IN ES:BX
GETBLK	PROC
	PUSH	CX		;SAVE
	MOV	CX,1		;CALL GTBLKS FOR 1 BLOCK ONLY
	CALL	GTBLKS
	POP	CX		;RESTORE
	RET
GETBLK	ENDP

SRBLKS	PROC
	MOV	DSKFCB,OFFSET SAVFCB
	JMP	GTBKI$
SRBLKS	ENDP

	;GET A SERIES OF GAME FILE BLOCKS,
	;FIRST BLOCK NUMBER IN AX, CORE LOCATION IN ES:BX # OF BLOCKS IN CX
GTBLKS	PROC
	MOV	DSKDIR,0	;READ MODE
	MOV	DSKFCB,OFFSET GAMFCB
GTBKI$:	PUSH	BX
	PUSH	DX
	PUSH	BP
	SHL	AX,1
	SHL	AX,1
	SHL	CX,1
	SHL	CX,1
	MOV	GTBSTT,AX
	MOV	GTBCOR,BX
	MOV	GTBCNT,CX
GTBLP:	MOV	AH,CSDMAO
	MOV	DX,OFFSET DSKBUF
	INT	21H
	MOV	AX,GTBSTT
	MOV	BX,DSKFCB
	MOV	[BX+33],AX
	MOV	AH,CRDRND
	CMP	DSKDIR,0
	JE	GTBKIR
	PUSH	SI
	PUSH	DI
	PUSH	DS
	PUSH	ES
	PUSH	CX
	MOV	CX,GTBCOR
	MOV	SI,DS
	MOV	DI,ES
	MOV	ES,SI
	MOV	DS,DI		; SWAP DS,ES
	MOV	SI,CX
	MOV	DI,OFFSET DSKBUF
	MOV	CX,128
REP	MOVSB
	POP	CX
	POP	ES
	POP	DS
	POP	DI
	POP	SI
	MOV	AH,CWRRND
GTBKIR:	MOV	DX,DSKFCB
	INT	21H
	CMP	AL,2	;GOOD/0=successful read, 3=partial record zero padded
	JE	GTB2	;BAD/2=not enough space on disk, 1=no data available
	CMP	AL,1
	JE	GTB2
	CMP	DSKDIR,0
	JNE	GTBKK
	PUSH	SI
	PUSH	DI
	PUSH	CX
	MOV	SI,OFFSET DSKBUF
	MOV	DI,GTBCOR
	MOV	CX,128
REP	MOVSB
	POP	CX
	POP	DI
	POP	SI	
GTBKK:	DEC	GTBCNT
	JZ	GTBFIN
	ADD	GTBCOR,128
	MOV	BX,GTBCOR
	INC	GTBSTT
	JMP	GTBLP

GTBFIN:	CLC
GTBOUT:	POP	BP
	POP	DX
	POP	BX
	RET

GTB2:	CMP	DSKFCB,OFFSET GAMFCB
	JE	GTB3
	STC
	JMP	GTBOUT

GTB3:	FATAL	FTL7
GTBLKS	ENDP

	SUBTTL  IBMPC SYSTEM ROUTINES
	PAGE	+

	;READ A CHARACTER INTO AX, WAITING UNTIL ONE IS AVAILABLE, NO ECHO
MCHRI	PROC
	PUSH	CX
	PUSH	DX
	CMP	CHRFLG,0
	JNZ	MCHR1
	MOV	CHRFLG,1
MCHR1:	MOV	AH,CCONIN
	INT	21H
	SUB	AH,AH
	POP	DX
	POP	CX
	RET
MCHRI	ENDP

	;PRINT THE CHARACTER IN AL, FOREGROUND IN AH
MTTYO	PROC
	PUSH	AX
	PUSH	BX		;SAVES
	PUSH	CX
	PUSH	DX
	PUSH	BP
	PUSH	AX
	MOV	AH,CCONIO
	MOV	DL,AL
	INT	21H
	POP	AX
	CMP	SCRFLG,0
	JZ	MTYO1
	CALL	PRTOUT
MTYO1:	POP	BP
	POP	DX
	POP	CX
	POP	BX
	POP	AX
	RET
MTTYO	ENDP

	;PRINT SPACES, WITHOUT MOVING CURSOR, NUMBER IN AL, ATTRIBUTE IN AH
MSPC	PROC
	RET
MSPC	ENDP

	;PRINT A CARRIAGE RETURN/LINE FEED WITH MORE MODE
MCRLF	PROC
	PUSH	AX		;SAVES
	PUSH	BX
	PUSH	CX
	PUSH	DX
	PUSH	BP
	INC	MORLIN		;INCREMENT NUMBER OF LINES OUTPUT
	MOV	AH,CCONIO
	MOV	DL,13
	INT	21H
	MOV	AH,CCONIO
	MOV	DL,10
	INT	21H
	MOV	AL,SLPP
	SUB	AH,AH
	CMP	MORLIN,AX
	JL	MCR1
	MOV	MORLIN,0
	MOV	AL,SCRFLG
	PUSH	AX
	MOV	SCRFLG,0
	PRINT	MORE
	CALL	MCHRI
	PRINT	EMORE
	POP	AX
	MOV	SCRFLG,AL
MCR1:	CMP	SCRFLG,0
	JE	MCR2
	CALL	PRTCRL
MCR2:	POP	BP
	POP	DX
	POP	CX
	POP	BX
	POP	AX
	RET
MCRLF	ENDP

	;OUTPUT STATUS LINE HERE
MSOUT	PROC
	MOV	BX,OFFSET SBLINE
	CALL	MSPRT
	MOV	AH,09H
	MOV	DX,SLSTR
	INT	21H
	MOV	BX,OFFSET SELINE
	CALL	MSPRT
	RET
MSOUT	ENDP

MSPRT	PROC
	MOV	CL,BYTE PTR [BX]
	SUB	CH,CH
	CMP	CL,0
	JE	MSPRT1
MSPLP:	INC	BX
	MOV	DL,BYTE PTR [BX]
	MOV	AH,06H
	PUSH	BX
	INT	21H
	POP	BX
	LOOP	MSPLP
MSPRT1:	RET
MSPRT	ENDP

MINIT	PROC
	CMP	SLFLG,0
	JNE	MINIT1
	RET
MINIT1:	MOV	BX,OFFSET STINIT
	CALL	MSPRT
	MOV	BX,OFFSET SELINE
	CALL	MSPRT
	RET
MINIT	ENDP

	;PRINT A STRING, POINTER (TO DATA SEGMENT) IN AX, WHITE FOREGROUND
MPRNT	PROC
	PUSH	BX		;SAVE BX
	MOV	BX,AX		;STRING POINTER
MPR1:	MOV	AL,[BX]		;GET NEXT CHARACTER
	CMP	AL,0		;END OF LINE, WITH CRLF?
	JE	MPR2		;YES
	CMP	AL,80H		;END OF LINE, NO CRLF?
	JE	MPR3		;YES
	CALL	MTTYO		;PRINT CHARACTER
	INC	BX		;POINT TO NEXT CHARACTER
	JMP	MPR1		;REPEAT
MPR2:	CALL	MCRLF		;PRINT A CRLF
MPR3:	POP	BX		;RESTORE BX
	RET
MPRNT	ENDP

	;GET TIME
MTIME	PROC
	PUSH	CX
	PUSH	DX
	MOV	AH,2CH
	INT	21H
	MOV	RSEED1,CX	; HOURS & MINUTES
	MOV	RSEED2,DX	; SECONDS & 100THS
	POP	DX
	POP	CX
	RET
MTIME	ENDP

FINISH	PROC
	CALL	MCRLF
	MOV	BX,OFFSET STRESET
	CALL	MSPRT
	MOV	AH,4CH
	INT	21H
FINISH	ENDP

CODE_SG	ENDS

	END	START