erkyrath.infocom-zcode-terps/ibm/ibmzip.asm

	.LIST

	TITLE	ZIP	Z-LANGUAGE INTERPRETER		IBMPC VERSION

	PAGE 58,132

	SUBTTL	STACK AND DATA SEGMENTS INITIALIZATION
	
	; CHANGES ON "D" VERSION
	;
	; 1) SPLIT AND SCREEN OPCODES WORK
	; 2) RAGGED SCREEN FIXED
	; 3) DELETE KEY COLOR PROBLEM FIXED
	; 4) PRINTER PROBLEM FIXED
	; 5) COLOR QUESTION ON RESTART FIXED
	; 6) RANDOMNESS BUG FIXED - 06/25/84 - DAN HORN


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

ABS_SG	SEGMENT AT 0H
ABS_SG	ENDS

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

DATA_SG	SEGMENT	PARA

	;VARIBLE DEFINITIONS:

	;SCREEN COLOR ATTRIBUTES
NRMATR	DB	07H		;FOR B/W, NORMAL - IN COLOR, WHITE ON BLUE
USLATR	DB	70H		;B/W AND COLOR, BLACK ON WHITE
TYPATR	DB	07H		;FOR COLOR, YELLOW ON BLUE/ FOR B&W, ?
COLORQ	DB	"   Do you want color (Y/N)? ",80H
COLFLG	DB	0		;NON ZERO IF THEY WANT COLOR
OLDCUR	DW	0		; TEMP FOR OLD CURSOR POSITION
	;SCRIPTING STUFF
SCRFLG	DB	0
PRNRDY	DB	" * Printer not ready: Abort or Retry? ",80H

	;USL STUFF
USLMOD	DB	0		;FOR PUTCHR
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	25 DUP(32),"S:",4 DUP(32),"M:",7 DUP(32),0,80H
SLS40T	DW	-1
	DW	OPPRND
	DW	2
	DW	24
	DW	-1
	DW	OPPRNN
	DW	27
	DW	30
	DW	-1
	DW	OPPRNN
	DW	33
	DW	36

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

;80 COLUMN, SCORE
SLS80	DB	51 DUP(32),"Score:",8 DUP(32),"Moves:",9 DUP(32),0,80H
SLS80T	DW	-1
	DW	OPPRND
	DW	2
	DW	27
	DW	-1
	DW	OPPRNN
	DW	58
	DW	61
	DW	-1
	DW	OPPRNN
	DW	73
	DW	78

;80 COLUMN, TIME
SLT80	DB	60 DUP(32),"Time:",15 DUP(32),0,80H
SLT80T	DW	-1
	DW	OPPRND
	DW	2
	DW	27
	DW	-1
	DW	OPPRNH
	DW	69
	DW	71
	DW	-1
	DW	OPPRNM
	DW	72
	DW	77

	;REBOOT AT END OF GAME
REBOOT	DB	"  ** End of session **",0
REBOO1	DB	"Strike any key to reboot",0

	;VERIFY/INTERPRETER VERSION

INTMSG	DB	"IBM-PC Interpreter Version "
INTVER	DB	"D",80H

	;SAVE/RESTORE
NDISKS	DB	2
FUCK	DB	0

SRTXT0	DB	"Type backspace to abort",80H
SRTXT1	DB	"Disk drive (A-D)  (default = "
SRDRV	DB	"B"
	DB	"):",80H
SRTXT2	DB	"Position   (0-9)  (default = "
SRPOS	DB	"0"
	DB	"):",80H
SRTXT3	DB	"Insert SAVE disk, then hit a key:",80H
SRTXT4	DB	"Insert game disk, then hit a key:",80H

	;GTBLKS
DSKMOD	DB	0		;0 FOR GAME READ, 1 FOR SAVE/RESTORE
DSKDRV	DB	0		;CURRENT DRIVE
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
	;OPRAND
RSEED1	DW	?		;SEED FOR RANDOM NUMBERS
RSEED2	DW	?		;SEED TWO
RTEMP	DW	?		;TEMP FOR RANDOM ROUTINES
	;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	
RWIDTH	DW	0		;REAL TERMINAL WIDTH
SCRN0	DB	1		;START OF SCROLLING SCREEN
CURSCR	DB	0		;CURRENT SCREEN
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
BKBUF	DB	512 DUP(?)	;SCRATCH BUFFER FOR BACKUP
OUTBUF	DB	81 DUP(?)	;OUTPUT 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

INIFLG	DB	0
INIWID	EQU	1
INIMEM	EQU	2
INIRND	EQU	4

	;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
	;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


	;BACKUP COPY STUFF
SECCNT	DB	0
TRKCNT	DB	3
BKDSK	DB	0		;DRIVE TO BACKUP ONTO
BKFRST	DB	1

BKASK1	DB	"You may make one backup copy of your",0H
BKASK2	DB	"game. To do so you need a formatted",0H
BKASK3	DB	"COPY disk.  Also, neither MASTER",0H
BKASK4	DB	"nor COPY disk may be write-protected.",0H
BKASK5	DB	"Make COPY now? (Y/N) ",80H
BKYEP	DB	"[YES]",80H
BKNOPE	DB	"[NO]",80H
BKMC1	DB	"Insert MASTER disk in drive A",0H
BKMC2	DB	"Insert COPY disk in drive B",0H
BKMC3	DB	"Hit any key to start backup",80H
BKMAST	DB	"Insert MASTER disk; hit any key",80H
BKCOPY	DB	"Insert COPY disk; hit any key",80H
BKWPRT	DB	"Disk write-protected; hit any key",80H
BKNRDY	DB	"Disk error; hit any key",80H
BKDONE	DB	"Backup completed.",0H
BKFAIL	DB	"Disk error; backup aborted.",0H
BKWPS1	DB	"Please write-protect the disk in",0H
BKWPS2	DB	"drive A; hit any key",80H
DSK_SV1	DW	0
DSK_SV2	DW	0

DSK_PRM	DB	11001111B
	DB	2
	DB	37
	DB	3
	DB	4
	DB	02AH
	DB	0FFH
	DB	050H
	DB	0F6H
	DB	25
	DB	4

IDTBL	DB	1,0,1,3
	DB	1,0,2,3
	DB	1,0,3,3
	DB	1,0,4,3

	;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	OPSPLT		;234
	DW	OPSCRN		;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
	;.CRLF
MORE	DB	"**MORE** ",80H
MORLIN	DW	0
LINMAX	DW	23
LINMXX	EQU	23

	;.GETTM
TIME	DD	?

	;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

	;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
	;Fatal error header
FATHDR	DB	"Fatal error: ",80H
	;ZSTR CHARACTER CONVERSION VECTOR

ZCHRS	DB	"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
	DB	"  0123456789.,!?_#'"
	DB	'"/\-:()'
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	.PRINT
	POP	AX
	ENDM

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

CURGET	MACRO
	PUSH	AX
	SUB	BH,BH
	MOV	AH,3
	INT	10H
	POP	AX
	ENDM

CURSET	MACRO	POS
	PUSH	AX
	SUB	BH,BH
	MOV	AH,2
IFNB<POS>
	MOV	DX,POS
ENDIF
	INT	10H
	POP	AX
	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

;NEVER, EVEN FOR AN INSTANT, CONSIDER CHANGING THESE NEXT INSTRUCTIONS
;THE GAME CREATOR MODIFIES THEM AND THEY MUST REMAIN HERE

	MOVM	DS,DATA_SG,AX
	MOVM	ES,GAME_SG,AX
	MOVM	SS,STK_SG,AX

;END OF MAGIC SECTION.  HACK AND SLASH TO YOUR HEART'S CONTENT

	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	.TTYOUT		;BELL
	RET
FEEP	ENDP

OPVERI	PROC
	PRINT	INTMSG
	CALL	.CRLF
	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	BX,0
	JNZ	OPVX
	NOP
OPVX:	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

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

OPSAVE	PROC
	MOV	DSKDIR,1	;INDICATE WRITE
OSV0$:	PRINT	SRTXT0		;WRITE "TYPE BACKSPACE..."
	CALL	.CRLF
	PRINT	SRTXT2		;WRITE "POSITION (DEFAULT = X): "
OSV2A$:	CALL	.CHRIN
	CMP	AL,13
	JNE	OSV3$
	MOV	AL,SRPOS	;GET DEFAULT POSITION
OSV3$:	MOV	BL,AL
	CMP	AL,8
	JNE	OSV3X$
	CALL	.CRLF
	JMP	PFALSE
OSV3X$:	SUB	AL,"0"	
	CMP	AL,9
	JG	OSV3A$
	CMP	AL,0
	JGE	OSV3B$
OSV3A$:	CALL	FEEP
	JMP	OSV2A$
OSV3B$:	MOV	SRPOS,BL
	MOV	AL,BL
	MOV	AH,NRMATR
	CALL	.TTYOUT
	CALL	.CRLF
	PRINT	SRTXT1		;WRITE "DRIVE (DEFAULT = X): "
OSV0A$:	CALL	.CHRIN
	CMP	AL,13
	JNE	OSV1$
	MOV	AL,SRDRV	;GET DEFAULT DRIVE
OSV1$:	CMP	AL,8
	JNE	OSAB1$
	CALL	.CRLF
	JMP	PFALSE
OSAB1$:	CMP	AL,"a"
	JL	OSAB2$
	SUB	AL,32		;UPPERCASE DRIVE LETTERS
OSAB2$:	MOV	BL,AL
	SUB	AL,"A"		;GET DOWN TO BASICS
	CMP	AL,3
	JG	OSV1A$		;LOSING DRIVE NUMBER
	CMP	AL,0
	JGE	OSV1B$
OSV1A$:	CALL	FEEP		;EXPRESS DISPLEASURE
	JMP	OSV0A$
OSV1B$:	MOV	SRDRV,BL
	MOV	AL,BL
	MOV	AH,NRMATR
	CALL	.TTYOUT		;ECHO THE DRIVE LETTER
	CALL	.CRLF
	PRINT	SRTXT3		;WRITE "Insert save disk..."
	CALL	.CHRIN
	CMP	AL,8		;ABORT REQUESTED?
	JNE	OSV3Z$
	CALL	.CRLF
	JMP	PFALSE
OSV3Z$:	MOV	AL,SRPOS	;GET POSITION
	SUB	AL,"0"
	SUB	AH,AH
	MOV	BL,SRDRV
	SUB	BL,"A"
	MOV	DSKDRV,BL
	XCHG	DI,SP
	PUSH	ZPC1
	PUSH	ZPC2
	PUSH	ZLOCS
	PUSH	ZORKID	
	MOV	STKBOT,SP	;SAVE THE WORLD
	MOV	SP,DI
	MOV	CL,5
	SHL	AX,CL		;CHANGE TO BLOCK
	PUSH	AX		;SAVE STARTING BLOCK #
	PUSH	ES		;SAVE ES
	MOV	DX,SS
	MOV	ES,DX		;FAKE ES TO BE STACK SEGMENT
	MOV	BX,OFFSET STKBOT
	MOV	CX,1
	CALL	SRBLKS		;READ/WRITE STACK
	PUSHF
	MOV	DI,SP		;SAVE SP
	MOV	SP,STKBOT	;RETRIEVE SAVED USER STACK POINTER
	POP	AX
	CMP	AX,ZORKID	;CHECK GAME VERSIONS
	JE	OSVT0$
	FATAL	FTL4
OSVT0$:	POP	ZLOCS
	POP	ZPC2
	POP	ZPC1
	XCHG	DI,SP
	POPF
	POP	ES
	POP	AX
	JC	OSV4$		;DIE HERE IF FIRST READ/WRITE FAILED
	INC	AX		;NEXT BLOCK STARTS
	SUB	BX,BX		;START AT ES:0
	MOV	CX,PURBOT	;NUMBER OF PURE BLOCKS
	CALL	SRBLKS
	PUSHF			;SAVE FLAGS FROM CALL
	CALL	.CRLF
	CMP	DSKDRV,0	;CHECK FOR DRIVE 0
	JNZ	OSV3C$
	PRINT	SRTXT4		;WRITE "Insert game disk..."
	CALL	.CHRIN		;WAIT UNTIL READY
	CALL	.CRLF
OSV3C$:	CALL	NEWZPC		;PAGE MAY HAVE CHANGED, LOSER!
	POPF			;GET FLAGS BACK
	JC	OSV4$
	MOV	AL,SCRFLG	;GET CURRENT SCRIPT STATE
	PTAWRD	[PFLAGS],A	;AND MAKE RESTORED FLAGS REFLECT IT
	JMP	PTRUE
OSV4$:	CALL	.CRLF
	JMP	PFALSE
OPSAVE	ENDP

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

OPSCRN	PROC
	SUB	AH,AH		; ONLY HAVE LOWER BYTE
	MOV	CURSCR,AL	; put screen # into current screen
	CMP	AX,0		; was it 0
	JNE	OPSCR1		; no then test #1
	MOV	DX,OLDCUR	; save old cursor position
	CMP	COLFLG,0	; TEST IF COLOR ON
	JZ	DIP1
	MOV	NRMATR,17H	; give them color
	JMP	OPSCR2
DIP1:	MOV	NRMATR,07H	; GIVE THEN NOTHING
	JMP	OPSCR2

OPSCR1:	CMP	AX,1		; was it 1
	JNE	OPSCR3
	CURGET
	MOV	OLDCUR,DX	; no then ignore
	CMP	COLFLG,0	; TEST IF COLOR ON
	JZ	DIP3
	MOV	NRMATR,75H	; give them color
	JMP	DIP4

DIP3:	MOV	NRMATR,07H	; GIVE THEM NOTHING
DIP4:	MOV	DH,1		; put it at 1,1
	MOV	DL,LFTMAR	; UPPER LEFT-HAND CORNER
OPSCR2:	MOV	AH,2		; set cursor
	MOV	BH,0		; graphics page
	INT	10H
OPSCR3:	RET	
OPSCRN	ENDP

OPSPLT	PROC
	CMP	AX,0		; split zero
	JE	OPSPLU
	CURGET
	MOV	OLDCUR,DX
	SUB	LINMAX,AX	; subtract max plus one
	ADD	AX,1
	MOV	SCRN0,AL	; USED IN SCROLL FOR CRLF
	MOV	CL,LFTMAR
	MOV	CH,01		; UPPER LEFT CORNER
	MOV	DX,RWIDTH	; LOWER RIGHT ROW
	SUB	DL,LFTMAR
	SUB	DL,1
	MOV	DH,SCRN0	; LOWER RIGHT COLUMN
	MOV	AL,0		; blank entire screen
	MOV	AH,6		; clear the screen
	CMP	COLFLG,0	; IS IT COLOR?
	JZ	DAN1	
	MOV	BH,2FH		; WHITE ON GREEN
	JMP	DAN2
DAN1:	MOV	BH,07H		; IF NO COLOR THEN BLACK ON WHITE	
DAN2:	INT	10H		; CLEAR TOP WINDOW
	MOV	DX,OLDCUR	; GET BACK CURSOR POSITION
	MOV	AH,2		; set cursor
	SUB	BH,BH		; make sure it's zero
	INT	10H
	RET

OPSPLU:	MOV	SCRN0,1
	MOV	AX,LINMXX
	MOV	LINMAX,AX
	MOV	MORLIN,0	;RESET MORE COUNT
	RET
OPSPLT	ENDP

OPUSL	PROC
	PUSH	DI
	MOV	USLMOD,1
	CURGET			;GET THE CURSOR LOCATION
	PUSH	DX		;SAVE IT FOR A RAINY DAY
	MOV	AX,16		;FIRST GLOBAL (ROOM)
	MOV	DI,SLTAB	;USL TABLE IN FORCE
	MOV	CX,3		;NUMBER OF THINGS WE PRINT
USLLP$:	PUSH	AX
	CALL	GETVAR		;GET THE GLOBAL
	CMP	AX,[DI]		;HAS IT CHANGED
	JE	USL1$		;THANK GOD, NO
	CURSET	[DI+4]		;MOVE THE CURSOR TO THE RIGHT PLACE
	PUSH	CX
	PUSH	DI
	CALL	WORD PTR [DI+2]	;CALL THE PROPER ROUTINE
	CURGET			;WHERE IS THE CURSOR NOW?
	POP	DI
	SUB	DX,[DI+6]	;WHERE IS THE END OF THE FIELD?
	NEG	DX
	JLE	USLN$		;DONT PRINT ZERO OR LESS SPACES
	MOV	AL,DL
	MOV	AH,USLATR	;THIS IS REVERSE VIDEO
	PUSH	DI
	CALL	.SPACE		;PRINT THAT MANY SPACES
	POP	DI
USLN$:	ADD	DI,8		;POINT TO NEXT TABLE ENTRY
	POP	CX		;RESTORE REGISTERS
USL1$:	POP	AX
	INC	AX		;POINT TO NEXT GLOBAL
	LOOP	USLLP$		;DO ALL THREE THEN LEAVE
	POP	DX
	CURSET	DX		;IT MAY OR MAY NOT BE RAINING, BUT....
	MOV	USLMOD,0
	POP	DI
	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
OPRAND	PROC
	SUB	AH,AH
	MOV	RTEMP,AX
	MOV	AX,RSEED1
	MOV	BX,RSEED2
	MOV	RSEED2,AX
	CLC
	RCR	AX,1
	RCR	BX,1
	XOR	RSEED1,BX
	MOV	AX,RSEED1
	AND	AX,0EFFFH
	SUB	DX,DX
	DIV	RTEMP
	MOV	AX,DX
	INC	AX		;MUST BE BETWEEN 1 AND N, INCLUSIVE
	TEST	INIFLG,INIRND
	JNZ	OPRN1$
	JMP	PUTVAL		;SIMPLY RETURN
OPRN1$:	PUSH	AX
	CALL	OPPRNN		;PRINT NUMBER
	MOV	AL,32
	CALL	PUTCHR
	POP	AX
	JMP	PUTVAL		;RETURN THE VALUE
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	+

EOLCHR	EQU	10		;LINE-FEED IS END-OF-LINE CHARACTER

GETLIN	PROC
	PUSH	BX
	MOV	AL,SCRFLG
	PUSH	AX
	MOV	SCRFLG,0	;DEFEAT SCRIPTING DURING INPUT
	MOV	DX,SI		;HOLD ON TO STA
	MOV	CL,ES:[SI]
	SUB	CH,CH		;CX HAS MAX # CHARACTERS TO READ
	INC	SI		;SI HAS POINTER TO LINE BUFFER
GTLL$:	CALL	.CHRIN		;GET A CHARACTER
	CMP	AL,EOLCHR	;IS IT END OF LINE?
	JE	GTLX$
	CMP	AL,13
	JNE	GTL0$
GTLX$:	CALL	.CRLF
	POP	AX
	MOV	SCRFLG,AL	;RESET SCRIPT FLAG
	POP	BX
	RET			;OUR WORK IS DONE
GTL0$:	CMP	AL,8		;WAS IT A BACKSPACE
	JNE	GTL1$
	MOV	AX,SI
	SUB	AL,1
	CMP	DX,AX		;ARE WE AT BEGINNING OF BUFFER?
	JNE	GTL2$
GTLF$:	MOV	AX,7
	CALL	.TTYOUT		;FEEP AT HIM NOW
	JMP	GTLL$
GTLL1$:	DEC	SI		;MOVE BUFFER AND COUNT BACK (OR FORWARD)
	INC	CX
	JMP	GTLL$
GTL2$:	PUSH	DX
	PUSH	CX
	CURGET			;READ THE CURSOR (DH = ROW, DL = COLUMN)
	POP	CX
	CMP	DL,LFTMAR	;ARE WE AT BEGINNING OF A LINE?
	JNE	GTL3$
	SUB	DH,1		;PREVIOUS LINE
	MOV	AX,TWIDTH
	MOV	DL,AL		;END OF LINE
GTL3$:	SUB	DL,1		;CURSET/GET ARE ZERO BASED
	CURSET			;MOVE IT THERE
	MOV	AL,1
	MOV	AH,NRMATR	;NO ATTRIBUTES, ONE SPACE
	CALL	.SPACE		;WRITE THE SPACE
	POP	DX
	JMP	GTLL1$		;LOOP BACK

GTL1$:	JCXZ	GTLF$		;BUFFER FULL
	MOV	AH,TYPATR	
	CALL	.TTYOUT		;ECHO THE CHARACTER
	PUSH	AX
	PUSH	DX
	PUSH	CX
	CURGET			;FIND THE CURSOR
	POP	CX
	MOV	AX,TWIDTH
	CMP	DL,AL		;CHECK IF AT END OF LINE
	JNZ	GTL5$
	CALL	.CRLF		;MAKE A NICE CRLF AT END OF LINE
GTL5$:	POP	DX
	POP	AX
GTL4$:	CMP	AL,"A"		; CHECK UPPER CASE RANGE A-Z
	JL	GTLD$
	CMP	AL,"Z"
	JG	GTLD$
	ADD	AL,20H		;ADJUST FOR LOWER CASE
GTLD$:	MOV	ES:[SI],AL	; *** THIS PUTS CHAR. IN BUFFER ***
	INC	SI		;MOVE POINTER, COUNT FORWARD
	DEC	CL
	JMP	GTLL$
GETLIN	ENDP

PRTLOS	PROC
	MOV	AL,SCRFLG
	PUSH	AX
	PUSH	DX
	MOV	SCRFLG,0	;TURN OFF SCRIPTING TO AVOID GETTING HUNG
	PRINT	PRNRDY
PRNL$:	CALL	.CHRIN
	CMP	AL,"A"
	JE	PRNA$
	CMP	AL,"a"
	JE	PRNA$
	CMP	AL,"R"
	JE	PRNR$
	CMP	AL,"r"
	JE	PRNR$
	MOV	AL,7
	CALL	.TTYOUT
	JMP	PRNL$
PRNA$:	CLC
PRNEX$:	PUSHF
	CALL	.CRLF
	POPF
	POP	DX
	POP	AX
	MOV	SCRFLG,AL	;RESTORE SCRIPT FLAG
	RET
PRNR$:	STC
	JMP	PRNEX$
PRTLOS	ENDP

PRTOUT	PROC
PRTRT$:	MOV	AH,0		;CODE FOR OUTPUT TO PRINTER PORT
	MOV	DX,0
	INT	17H		;FORCE IT OUT
	TEST	AH,1		;ERROR TIME OUT CODE
	JZ	PRTO1$		;LOST ON TIME OUT
	CALL	PRTLOS
	JC	PRTRT$		;RETRY IF SO ORDERED
	GTAWRD	A,[PFLAGS]
	AND	AX,0FFFEH	;TURN OFF THE SCRIPT BIT
	PTAWRD	[PFLAGS],A	
	MOV	SCRFLG,0	;AND UNSET THE FLAG
	STC			;INDICATE LOSER WANTS ABORT
	RET
PRTO1$:	CLC			;INDICATE WIN
	RET
PRTOUT	ENDP

SCRCHK	PROC
	PUSH	AX
	PUSH	BX
	PUSH	DX
	GTAWRD	A,[PFLAGS]
	TEST	AL,1		;CHECK IF SCRIPTING IS REQUESTED
	JZ	SCRNN$
	CMP	SCRFLG,0	;CHECK WHETHER THIS IS A NEW STATE
	JNE	SCR1$
SCRR1$:	PUSH	DX
	MOV	DX,0		;FIRST PRINTER SLOT
	MOV	AH,1
	INT	17H		;INITIALIZE PORT
	TEST	AH,0A1H		;CHECK FOR TIME OUT,BUSY, OUT OF PAPER
	JNZ	SCRR2$
	POP	DX
	JMP	SCR1$
SCRR2$:	POP	DX
	CALL	PRTLOS		;ASK USER WHAT TO DO NOW?
	JC	SCRR1$		;RETRY
	GTAWRD	A,[PFLAGS]
	AND	AX,0FFFEH	;TURN OFF THE SCRIPT BIT
	PTAWRD	[PFLAGS],A	
	MOV	SCRFLG,0	;AND FLAG
SCREX$:	POP	DX
	POP	BX
	POP	AX
	RET
SCR1$:	MOV	SCRFLG,1
	SUB	CX,CX		;COUNT OF CHARS PRINTED
	MOV	BP,DX		;START OF INPUT LINE
	INC	BP		;FIRST CHAR IS LENGTH OF BUFFER
SCR1L$:	MOV	AL,ES:[BP]
	INC	BP		;GET CHARACTER
	CMP	BP,SI		;END OF INPUT?
	JLE	SCR2L$
	CALL	PRTCRL
	JMP	SCREX$
SCR2L$:	CALL	PRTOUT		;OUTPUT ONE CHARACTER TO THE PRINTER
	JC	SCREX$		;THIS MEANS SCRIPTING ABORTED
	INC	CX
	CMP	CX,TWIDTH
	JNE	SCR1L$
	CALL	PRTCRL
	JC	SCREX$
	SUB	CX,CX		;RESTART COUNT
	JMP	SCR1L$		;GO FOR MORE	

SCRNN$:	MOV	SCRFLG,0
	JMP	SCREX$
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
	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	.PRINT		;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,0
	JNE	OPH00$
	MOV	AL,12
OPH00$:	CMP	AL,12
	JLE	OPH1$
	SUB	AL,12		;HOUR SLOT IS 24 HOUR TIME
OPH1$:	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	+

PADCHR	EQU	5		;ZSTR PADDING CHARACTER

	;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
	CMP	USLMOD,0
	JE	PTC0$
	PUSH	AX		;SAVE EVERYTHING
	PUSH	BX
	PUSH	CX
	PUSH	SI
	PUSH	DI
	SUB	BH,BH
	MOV	AH,9
	MOV	CX,1
	MOV	BL,USLATR
	INT	10H		;OUTPUT CHARACTER IN INVERSE VIDEO
	MOV	AH,3
	INT	10H		;READ CURSOR
	INC	DX
	MOV	AH,2
	INT	10H		;MOVE CURSOR FORWARD
	POP	DI
	POP	SI
	POP	CX
	POP	BX
	POP	AX
	POP	BP
	RET
PTC0$:	MOV	BP,CHRPTR	;END OF BUFFER?
	CMP	BP,ENDBUF
	JNE	PTC7$		;NO
	PUSH	AX		;YES, ENTER OUTPUT ROUTINE; SAVES
	PUSH	BX
	PUSH	SI
	MOV	BX,ENDBUF	;END OF BUFFER
	MOV	SI,OFFSET OUTBUF;BEGINNING OF BUFFER
PTC1$:	DEC	BX		;SEARCH FOR SPACE BACKWARDS FROM END
	CMP	BYTE PTR [BX]," "
	JE	PTC3$
	CMP	BX,SI		;STOP AT BEGINNING OF BUFFER
	JNE	PTC1$
PTC2$:	PRINT	OUTBUF		;NO SPACES, OUTPUT WHOLE LINE
	MOV	CHRPTR,SI	;RESTORE POINTER TO BEGINNING OF BUFFER
	MOV	BP,SP
	CMP	BYTE PTR [BP+4]," "  ;DID A SPACE CAUSE BUFFER OVERFLOW?
	JNE	PTC6$		;NO
	MOV	WORD PTR [BP+4],0	;YES, FLUSH IT
	JMP	PTC6$		;AND RETURN
PTC3$:	CMP	BX,SI		;DEGENERATE CASE WITH SPACE AT OUTBUF?
	JE	PTC2$		;YES, OUTPUT WHOLE LINE
	MOV	BYTE PTR [BX],0	;NO, OUTPUT UP TO SPACE
	PRINT	OUTBUF
	MOV	AX,ENDBUF	;END OF BUFFER
	INC	BX		;START GETTING CHARACTERS AFTER THE SPACE
PTC4$:	CMP	BX,AX		;AT END YET?
	JE	PTC5$		;YES
	MOV	BP,AX		;SAVE AX
	MOVM	[SI],[BX],AL	;NO, COPY NEXT CHAR TO BEGINNING OF BUF
	MOV	AX,BP		;RESTORE AX
	INC	BX
	INC	SI
	JMP	PTC4$		;AND CONTINUE
PTC5$:	MOV	CHRPTR,SI	;NEXT CHAR WILL GO AFTER COPIED STUFF
PTC6$:	POP	SI		;CLEAN UP
	POP	BX
	POP	AX
	CMP	AX,0		;AND IGNORE A NULL CHARACTER
	JE	PTC8$
PTC7$:	MOV	BP,CHRPTR	;NOW STORE THE CHARACTER IN BUFFER
	MOV	DS:[BP],AL
	INC	CHRPTR		;UPDATE POINTER
PTC8$:	POP	BP		;RESTORE
	RET			;AND RETURN
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

EOICHR	EQU	15		;CARRIAGE RETURN IS NORMAL END OF INPUT

	SUBTTL	TOP LEVEL STUFF
	PAGE	+

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

	;INITIALIZATION
TSETUP	PROC
	TEST	INIFLG,INIWID	;CHECK FOR FORCED 40 COLUMN MODE
	JZ	TS0$
	MOV	TWIDTH,38	;FORCE IT TO 40
TS0$:	MOV	BX,OFFSET OUTBUF	;START OF OUTPUT BUFFER
	ADD	BX,TWIDTH	;ADD LENGTH OF BUFFER
	SUB	BL,LFTMAR	; *** SUBTRACT THE LEFT MARGIN VALUE
	MOV	ENDBUF,BX	;THIS IS ENDBUF POINTER
	MOV	BYTE PTR [BX],0	;BUFFER IS FOLLOWED BY A 0 FOR CONVENIENCE
	MOV	BX,OFFSET SLSTAB ;GET STATUS LINE TABLE
	CMP	TIMEMD,0	;CHECK FOR SCORE/TIME MODE
	JE	TS1$
	ADD	BX,8		;THE TIME MODE TABLE IS OFFSET FOUR WORDS
TS1$:	MOV	SI,0		;OFFSET INTO PROPER TABLE
	CMP	TWIDTH,38	;CHECK TERMINAL WIDTH
	JE	TS2$
	ADD	SI,4		;OFFSET TO 80 COLUMN STUFF
TS2$:	MOV	AX,[BX][SI]
	MOV	SLSTR,AX
	MOV	CX,2[BX][SI]
	MOV	SLTAB,CX	;GET THE RIGHT POINTERS TO STRING/TABLE
	MOV	BL,USLATR	;INVERSE VIDEO, STRING ALREADY IN AX
	MOV	CX,0		;AT 0,LFTMAR
	CALL	.PRINTA		;PRINT THE STATUS LINE
	RET
TSETUP	ENDP

ZIPBGN	PROC
	CALL	SYSINI		;DO ANY SYSTEM INITIALIZATION
	CALL	BKCHK		;CHECK FOR MAKING BACKUP COPY
STR5$:	CALL	.GETMEM
	MOV	BX,ES
	SUB	AX,BX
	MOV	MEMTOP,AX	;LAST AVAILABLE PARAGRAPH LOCATION
	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
STR10$:	GTAWRD	A,[PZRKID]	;UNIQUE GAME & VERSION INDENTIFER
	MOV	ZORKID,AX
	OR	BYTE PTR ES:[PVERS2],0020H	 ;SET SPLIT BIT
	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	SI,ENDLOD	;GET # PAGES IN ENDLOD
	NEG	SI
	MOV	DI,MEMTOP	;GET PARAGRAPHS OF MEMORY
	MOV	CL,5
	SAR	DI,CL		;CHANGE TO PAGES
	ADD	SI,DI		;NUMBER OF PAGES FOR PAGING
	MOV	BUFPGS,SI	;SAVE THIS NUMBER FOR FUTURE REFERENCE
	CMP	BUFPGS,63
	JLE	STR16$
	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	.GETTM		;GET THE CURRENT TIME-OF-DAY
	MOVM	RSEED1,TIME[2],AX;USE IT TO INITIALIZE RANDOM NUMBER SEED
	MOVM	RSEED2,TIME,AX	;BE CONSISTENT
STR17$:	JMP	START1
ZIPBGN	ENDP

PRSPC	PROC
	PUSH	AX
	PUSH	BX
	PUSH	CX
	CALL	OPPRNN
	MOV	AL,32
	CALL	PUTCHR
	POP	CX
	POP	BX
	POP	AX
	RET
PRSPC	ENDP

	;RESTART EXECUTION HERE
RESTRT	PROC
	INT	19H		; REBOOT THE SUCKER FOR NOW
	RET			; I'M SENTIMENTAL

START1:	CALL	WPCHK		;MAKE SURE GAME DISK IS WRITE-PRO
	CALL	TSETUP		;SETUP TERMINAL/STATUS LINE
	CALL	CLRSCR		;CLEAR THE REMAINDER OF THE SCREEN
	MOV	SP,OFFSET STK_TOP	;INIT OUR STACK POINTER
	MOV	DI,OFFSET ZSTK_TP	;INIT USER STACK POINTER
	MOV	CHRPTR,OFFSET OUTBUF	;INIT OUTPUT CHAR. POINTER
	MOV	ZLOCS,DI		; LOCALS WOULD START AT FIRST SLOT,
	SUB	ZLOCS,2			; IF THERE WERE ANY
	GTAWRD	A,[PSTART]
	CALL	BSPLTB		;SPLIT BLOCK & BYTE POINTERS
	MOV	ZPC1,AX		;INIT ZPC BLOCK-POINTER
	MOV	ZPC2,BX		;INIT ZPC BYTE-POINTER
	CALL	NEWZPC		;GET PAGE TO EXECUTE
	CMP	INIFLG,5
	JNE	FUBAR$
	MOV	AX,CS
	CALL	PRSPC
	MOV	AX,DS
	CALL	PRSPC
	MOV	AX,ES
	CALL	PRSPC
	MOV	AX,SS
	CALL 	PRSPC
	MOV	AX,ENDLOD
	CALL	PRSPC
	MOV	AX,PAGES
	CALL	PRSPC
	MOV	AX,BUFPGS
	CALL	PRSPC
	MOV	AX,MEMTOP
	CALL	PRSPC
FUBAR$:	MOV	FUCK,1
	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,15
	INT	10H		;CHECK VIDEO STATE
	MOV	BL,AH		;GET SCREEN WIDTH
	SUB	BH,BH		;AND ZERO HIGH END
	MOV	TWIDTH,BX	;SAVE IT AWAY
	MOV	RWIDTH,BX
	SUB	TWIDTH,2
	INC	LFTMAR		; FIX FOR OVERSCAN
	CMP	AL,7
	JE	SINIX$
	TEST	AL,1
	JZ	SINIX$
	PRINT	COLORQ		;ASK IF COLOR IS REALLY NEEDED
	CALL	.CHRIN		;READ A CHARACTER
	CMP	AL,"Y"
	JE	SINC$		;REALLY WANTS COLOR IF Y OR y
	CMP	AL,"y"
	JNE	SINIX$
SINC$:	MOV	COLFLG,AL	; NON-ZERO = THEY WANT COLOR
	MOV	USLATR,74H	;MAKE STATUS LINE RED ON WHITE IN COLOR MODE
	MOV	NRMATR,17H	;WHITE ON BLUE FOR THE REST
	MOV	TYPATR,1FH	;INPUT WILL BE YELLOW ON BLUE

SINIX$:	MOV	AH,1
	INT	16H		;CHECK KEYBOARD
	JZ	SINI0$		;NO CHARACTER AVAILABLE
	SUB	AL,"0"
	JL	SINIF$
	CMP	AL,9
	JG	SINIF$
	MOV	INIFLG,AL	;SET UP INIT FLAG IF 0-9
SINIF$:	MOV	AH,0
	INT	16H		;BE NICE AND READ THE CHARACTER

SINI0$:	INT	11H		;DEVICE DETERMINATION
	TEST	AL,0C0H		;TEST BITS 7&6 FOR # DRIVES
	JNZ	SINI1$
	MOV	SRDRV,"A"	;MAKE DEFAULT DRIVE A FOR 1 DRIVE SYSTEM
	MOV	NDISKS,1

SINI1$:	TEST	INIFLG,INIMEM
	JZ	SIN1A$
	MOV	NDISKS,1
SIN1A$:	TEST	INIFLG,8	;CHECK FOR COLOR SETUP
	JZ	SINI2$
	MOV	AL,"U"
	CALL	GETNUM		;READ NUMBER FOR USL ATTRIBUTE
	MOV	USLATR,AL
	CALL	.CRLF
	MOV	AL,"N"
	CALL	GETNUM
	MOV	NRMATR,AL
SINI2$:	RET
SYSINI	ENDP

CLRSCR	PROC
	MOV	CH,1	;CLEAR ACTIVE SCREEN AREA
	MOV	CL,0
	MOV	DX,TWIDTH
	INC	DL
	CMP	DL,40
	JLE	CLRSC1
	INC	DL
CLRSC1:	MOV	DH,18H
	MOV	AX,0600H
	MOV	BH,NRMATR
	INT	10H		;CLEAR SCREEN, I HOPE
	RET
CLRSCR	ENDP

GETNUM	PROC
	MOV	BH,0
	MOV	AH,7
	CALL	.TTYOUT		;WHAT A PROMPT!
	CALL	.CHRIN
	MOV	AH,7
	CALL	.TTYOUT		;ECHO
	SUB	AL,"0"
	MOV	BL,AL
	CALL	.CHRIN
	MOV	AH,7
	CALL	.TTYOUT		;ECHO
	SUB	AL,"0"
	MOV	CL,4
	SHL	BL,CL
	ADD	BL,AL
	MOV	AX,BX
	RET
GETNUM	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

GAMETRK	EQU	6		;FIRST GAME TRACK (0-39)

SRBLKS	PROC
	MOV	DSKMOD,1	;SAVE/RESTORE MODE
	JMP	GTBKI$
SRBLKS	ENDP

PTBLKS	PROC
	MOV	DSKDIR,1	;SET FLAG FOR WRITE
	MOV	DSKDRV,0	;ALWAYS FROM DRIVE 0
	MOV	DSKMOD,0	;GAME MODE
	JMP	GTBKI$
PTBLKS	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	DSKDRV,0	;ALWAYS FROM DRIVE 0
	MOV	DSKMOD,0	;GAME MODE
GTBKI$:	PUSH	DX		;SAVES
	PUSH	BP
GTBX0$:	MOV	GTBCNT,CX	;SAVE NUMBER OF BLOCKS TO READ
	MOV	GTBSTT,AX	;SAVE FIRST BLOCK
	MOV	GTBCOR,BX	;SAVE STARTING LOCATION
	MOV	BP,8		;8 BLOCKS PER TRACK
	SUB	DX,DX		;CLEAR HIGH WORD FOR DIVIDE
	DIV	BP		;DETERMINE TRACK AND SECTOR OFFSETS
	XCHG	AX,CX		;SECTOR OFFSET & NUMBER OF BLOCKS
	CMP	DSKMOD,0	;CHECK FOR GAME VS. SAVE/RESTORE
	JNE	GTBXN$
	ADD	CX,GAMETRK	;ADD IN FIRST GAME TRACK
GTBXN$:	MOV	CH,CL		;POSITION TRACK NUMBER
	INC	DX		;CONVERT TO ONE-BASED SECTOR NUMBER
	MOV	CL,DL		;POSITION SECTOR NUMBER
	MOV	AH,DSKDRV	;ALWAYS DRIVE 0
	MOV	DL,9
	SUB	DL,CL		;DL NOW HAS MAXIMUM SECTORS LEFT THIS TRACK
	CMP	AL,DL		;SEE IF WE WANT MORE THAN THE MAX
	JLE	GTBX1$
	MOV	AL,DL		;MAKE IT THE MAX THEN
	MOV	DH,1		;SIGNAL ANOTHER PASS NEEDED
GTBX1$:	CALL	.RDWRT		;PERFORM THE DISK OPERATION
	JC	GTB1$		;READ/WRITE FAILED IF CARRY SET
	CMP	DH,1		;TEST FOR ANOTHER PASS
	JNZ	GTBX2$
	SUB	DH,DH		;CLEAN UP SO THAT DL IS # SECTORS JUST HACKED
	MOV	AX,GTBSTT
	ADD	AX,DX		;START N SECTORS HIGHER
	MOV	CX,GTBCNT
	SUB	CX,DX		;AND N LESS SECTORS LEFT TO HACK
	MOV	BX,GTBCOR
	PUSH	CX
	MOV	CX,9		;SHIFT #SECTORS BY 9 FOR NEW CORE ADDRESS
	SHL	DX,CL
	POP	CX
	ADD	BX,DX		;HERE'S WHERE TO READ INTO NEXT PASS
	JMP	GTBX0$
GTBX2$:	CLC			;INDICATE DISK OPERATION WON
GTBX3$:	POP	BP		;RESTORES
	POP	DX
	RET
GTB1$:	CMP	DSKMOD,0	;CHECK WHETHER THIS IS GAME MODE
	JZ	GTB2$		;YES, FATAL OUT
	STC			;SET CARRY FLAG TO INDICATE LOSSAGE
	JMP	GTBX3$		;RETURN NORMALLY
GTB2$:	FATAL	FTL7
GTBLKS	ENDP

	SUBTTL	FRIGGING BACKUP COPY ROUTINE
	PAGE	+

WPCHK	PROC
	MOV	DSKDIR,1	; WRITE
	MOV	DSKDRV,0	; DRIVE 0
	MOV	DSKMOD,1	; ABSOLUTE SECTORS
	MOV	AX,2FH		; RANDOM SPOT
	MOV	BX,0
	MOV	CX,1		; ONE BLOCK
	CALL	GTBKI$
	CMP	AH,3		; HOPE IT FAILS WITH W/P FAILURE
	JE	WPCHK1		; GOOD. WIN
	PRINT	BKWPS1		; TELL USER TO W/P DISK
	PRINT	BKWPS2
	CALL	.CHRIN		; WAIT FOR CHARACTER
	CALL	.CRLF
	JMP	WPCHK		; AND TRY AGAIN
WPCHK1:	MOV	MORLIN,0
	RET
WPCHK	ENDP

	;CHECK WHETHER BACKUP IS POSSIBLE
BKCHK	PROC
	CALL	TSETUP
	CALL	BKSTAT		;GET STATUS BITS INTO AL
	CMP	AL,3		;THIS IS MASTER/BACKUP ALLOWED
	JE	BKUP	
	RET

BKUP:	PRINT	BKASK1		;ASK WHETHER BACKUP WANTED
	PRINT	BKASK2
	PRINT	BKASK3
	PRINT	BKASK4
	PRINT	BKASK5
	CALL	.CHRIN		;GET A CHARACTER
	CMP	AL,"!"
	JE	BKUPF
	CMP	AL,"Y"
	JE	BKUP1
	CMP	AL,"y"
	JE	BKUP1
	PRINT	BKNOPE
	CALL	.CRLF
	MOV	MORLIN,0
	RET			;DOESN'T WANT TO, APPARENTLY...

BKUPF:	MOV	NDISKS,1
BKUP1:	PRINT	BKYEP
	CALL	.CRLF
	MOV	AL,NDISKS
	CMP	AL,1
	JE	BKUP1Z
	MOV	BKDSK,1		;MAKE COPY DISK DRIVE 1 FOR >1 DRIVE SYSTEMS
BKUP1Z:	CMP	NDISKS,1
	JE	BKZZ
	CALL	BKIFST		;INSERT MASTER DISK
	JMP	BKZZ
BKZZ:	MOV	AX,0		;SECTOR 0
	MOV	BX,0		;LOCATION 0
	MOV	CX,1		;ONE SECTOR (BOOTSTRAP)
	MOV	DSKDIR,0	;READ
	MOV	DSKDRV,0
	CALL	GTBKI$
	JNC	BKUP1A
	JMP	BKABRT
BKUP1A:	CALL	BKICOP		;INSERT COPY DISK
	MOV	AX,0
	MOV	BX,0
	MOV	CX,1
	MOV	DSKDIR,1
	MOVM	DSKDRV,BKDSK,DL
	CALL	GTBKI$		;WRITE BOOTSTRAP ONTO COPY
	JNC	BKUP1B
	JMP	BKABRT
BKUP1B:	CALL	BKIMST		;ASK TO INSERT MASTER

;CODE HERE FOR FORMATTING/COPYING INTERPRETER IS TAKEN
;FROM CREATE.ASM  -- IT'S ALL MAGIC

	CALL	DSKHAK

	MOV	DX,3
	SUB	BX,BX
	MOV	CH,1
BKRIL:	PUSH	DX
	MOV	CL,1
	PUSH	CX
	SUB	DX,DX
	MOV	AX,0204H
	INT	13H
	JC	BKRIF
	POP	CX
	INC	CH
	ADD	BX,1000H
	POP	DX
	DEC	DX
	JNZ	BKRIL
	JMP	BKWINT

BKRIF:	POP	DX
	POP	DX
	JMP	BKABRT

BKWINT:	CALL	DSKFIX

	CALL	BKICOP		;LOAD COPY DISK

	CALL	DSKHAK

; NOW WRITE IT OUT

	MOV	CX,0101H
FRML:	MOV	BX,OFFSET IDTBL
	MOV	SECCNT,4
FRMLL:	MOV	[BX],CH
	ADD	BX,4
	DEC	SECCNT
	JNZ	FRMLL

	MOV	BX,OFFSET IDTBL
	MOV	DH,0
	MOV	DL,BKDSK
	PUSH	ES
	MOV	AX,DS
	MOV	ES,AX
	MOV	AX,0504H
	INT	13H		;ES MUST BE = TO DS FOR FORMAT
	POP	ES		
	ADD	CH,1		;PUT CHECK FOR FAILURE HERE
	DEC	TRKCNT
	JNZ	FRML

	MOV	TRKCNT,3
	MOV	BX,0
	MOV	CX,0101H
	MOV	DH,0
	MOV	DL,BKDSK
WLP:	MOV	AX,0304H
	INT	13H
	ADD	BX,1000H
	INC	CH
	DEC	TRKCNT
	JNZ	WLP

	CALL	DSKFIX

	MOV	TRKCNT,4	;READ MAX. 96 K (THIS WILL CHANGE)
	MOV	SECCNT,30H	;START OF GAME
BKUPGL:	CALL	BKIMST		;GET MASTER BACK INTO DRIVE
	MOV	DSKDIR,0	;READ
	MOV	DSKDRV,0
	MOV	AL,SECCNT
	SUB	AH,AH		;FIRST SECTOR HERE
	MOV	BX,0
	MOV	CX,40H		;GET 32K (64 SECTORS)
	CALL	GTBKI$		;READ SOME GAME STUFF
	JNC	BKUPG1
	JMP	BKABRT
BKUPG1:	CMP	TRKCNT,1
	JNE	BKUP2		;CONTINUE
	MOV	DSKDIR,1	;WRITE
	MOV	DSKDRV,0
	MOV	BX,OFFSET BKBUF
	MOV	CX,1
	MOV	BKBUF,1		;PVERS1=0
	PUSH	ES
	MOV	AX,DS
	MOV	ES,AX
	MOV	AX,2EH
	CALL	GTBKI$		;FIX SO IT CAN'T BE COPIED
	POP	ES
	JNC	BKUP2
	JMP	BKABRT
BKUP2:	CALL	BKICOP		;GET COPY NOW
	MOV	DSKDIR,1	;WRITE
	MOVM	DSKDRV,BKDSK,DL
	MOV	AL,SECCNT
	SUB	AH,AH
	MOV	BX,0
	MOV	CX,40H
	CALL	GTBKI$		;WRITE SOME GAME STUFF
	JNC	BKUP2A
	JMP	BKABRT
BKUP2A:	SUB	TRKCNT,1
	JZ	BKUP3		;DONE WITH BACKUP
	ADD	SECCNT,40H
	JMP	BKUPGL

BKUP3:	PRINT	BKDONE
	CALL	BKIMST		;ENSURE MASTER IN PLACE
	MOV	MORLIN,0
	RET

BKABRT:	PRINT	BKFAIL
	CALL	BKIMST		;ENSURE MASTER IN PLACE
	MOV	MORLIN,0
	RET

BKCHK	ENDP
	
DSKHAK	PROC
	MOV	DI,DS
	MOV	SI,OFFSET DSK_PRM
	PUSH	DS
	SUB	AX,AX
	MOV	DS,AX
ASSUME	DS:ABS_SG
	MOV	BX,78H
	MOV	CX,[BX]
	MOV	DX,[BX+2]
	MOV	[BX],SI
	MOV	[BX+2],DI
	POP	DS
ASSUME	DS:DATA_SG
	MOV	DSK_SV1,CX
	MOV	DSK_SV2,DX
	RET
DSKHAK	ENDP

DSKFIX	PROC
	PUSH	DS
	MOV	CX,DSK_SV1
	MOV	DX,DSK_SV2
	SUB	AX,AX
	MOV	DS,AX
ASSUME	DS:ABS_SG
	MOV	BX,78H
	MOV	[BX],CX
	MOV	[BX+2],DX
	POP	DS
ASSUME	DS:DATA_SG
	RET
DSKFIX	ENDP

	;READ THE STATUS BLOCK FROM DISK
BKSTAT	PROC
	PUSH	ES
	MOV	AX,DS
	MOV	ES,AX
BKSTRT:	MOV	DSKDIR,0	;READ
	MOV	DSKMOD,1	;ABSOLUTE SECTORS
	MOV	AX,2EH		;STATUS SECTOR
	MOV	BX,OFFSET BKBUF	;READ AT BKBUF (IN DS)
	MOV	CX,1		;ONE SECTOR
	CALL	GTBKI$		;READ IT
	JC	BKST1		;FAILED?
	CMP	BKFRST,1
	JE	BKSEND
	MOV	DSKDIR,1	;WRITE
	MOV	AX,2FH		;RANDOM SPOT
	MOV	BX,0
	MOV	CX,1
	CALL	GTBKI$		;WRITE SOMETHING OR OTHER
	JC	BKST0		;LOSER!
BKSEND:	MOV	BKFRST,0
	POP	ES
	MOV	AL,BKBUF	;GET FIRST BYTE
	RET
BKST0:	CMP	AH,3		;CHECK SPECIFICALLY FOR WRITE-PROTECT
	JNE	BKST1
	PRINT	BKWPRT		;TELL LOSER ABOUT WRITE PROTECTEDNESS
	JMP	BKST2

BKST1:	PRINT	BKNRDY		;TELL LOSER DISK ISN`T WINNING
BKST2:	CALL	.CHRIN		;GET SOME RANDOM CHARACTER
	CALL	.CRLF
	JMP	BKSTRT		;TRY, TRY AGAIN

BKSTAT	ENDP

	;ASK LOSER TO INSERT MASTER DISK, CHECK FOR MASTERHOOD
BKIFST	PROC
	PRINT	BKMC1
	PRINT	BKMC2
	PRINT	BKMC3
	CALL	.CHRIN
	CALL	.CRLF
	CALL	BKIMST
	CALL	BKICOP
	RET
BKIFST	ENDP

BKIMST	PROC
	CMP	BKDSK,0
	JNE	BKIMS1
BKIMSR:	PRINT	BKMAST		;PRINT MESSAGE
	CALL	.CHRIN		;GET SOME CHARACTER
	CALL	.CRLF
BKIMS1:	MOV	DSKDRV,0
	CALL	BKSTAT		;GET STATUS FROM DISK, ENSURE NOT W/P
	CMP	AL,3
	JE	BKIMSX		;IT'S NOT A MASTER DISK....
	CMP	AL,1
	JE	BKIMSX
	JMP	BKIMSR
BKIMSX:	RET
BKIMST	ENDP

	;ASK LOSER TO INSERT COPY DISK, CHECK FOR COPYHOOD
BKICOP	PROC
	CMP	BKDSK,0
	JNE	BKICP1
BKICPR:	PRINT	BKCOPY		;PRINT MESSAGE
	CALL	.CHRIN
	CALL	.CRLF
BKICP1:	MOVM	DSKDRV,BKDSK,DL
	CALL	BKSTAT
	TEST	AL,1
	JNZ	BKICPR		;IT'S NOT A COPY DISK....
	RET
BKICOP	ENDP	

	SUBTTL  IBMPC SYSTEM ROUTINES
	PAGE	+

	;READ A CHARACTER INTO AX, WAITING UNTIL ONE IS AVAILABLE, NO ECHO
.CHRIN	PROC
	CMP	CHRFLG,0
	JNZ	.CHR1$
	MOV	CHRFLG,1
	PUSH	CX
	PUSH	DX
	SUB	AH,AH
	INT	1AH		;READ THE SYSTEM TIME AT FIRST CHARACTER
	XOR	RSEED1,CX	;DO SOME MORE RANDOMIZING
	XOR	RSEED2,DX	;BE CONSISTENT
	POP	DX
	POP	CX
.CHR1$:	SUB	AH,AH		;SET UP FOR READ NEXT CHARACTER STRUCK
	INT	16H		;CALL BIOS KEYBOARD I/O ROUTINE
	SUB	AH,AH		;CLEAR HIGH BYTE
	RET
.CHRIN	ENDP

	;PRINT THE CHARACTER IN AL, FOREGROUND IN AH
.TTYOUT	PROC
	PUSH	AX
	PUSH	BX		;SAVES
	PUSH	DX
	PUSH	BP
	PUSH	AX
	MOV	BL,AH		;FOREGROUND
	MOV	AH,14		;SET UP FOR TELETYPE OUTPUT
	SUB	BH,BH		;PAGE 0
	INT	10H		;CALL BIOS DISPLAY I/O ROUTINE
	POP	AX
	CMP	SCRFLG,0
	JZ	.TYO1$
	CALL	PRTOUT
.TYO1$:	POP	BP		;RESTORES
	POP	DX
	POP	BX
	POP	AX
	RET
.TTYOUT	ENDP

	;PRINT THE CHARACTER IN AL, ATTRIBUTES IN AH, ROW IN BH, COLUMN IN BL
.CHROUT	PROC
	PUSH	CX		;SAVES
	PUSH	DX
	PUSH	BP
	PUSH	AX		;SAVE CHARACTER AND ATTRIBUTES
	MOV	AH,2		;SET UP FOR SET CURSOR POSITION
	MOV	DX,BX		;ROW AND COLUMN
	SUB	BH,BH		;PAGE 0
	INT	10H		;CALL BIOS DISPLAY I/O ROUTINE
	POP	AX		;RESTORE CHARACTER AND ATTRIBUTES
	MOV	AH,9		;SET UP FOR WRITE ATTRIBUTE/CHARACTER
	SUB	BH,BH		;PAGE 0
	MOV	BL,NRMATR	;NORMAL ATTRIBUTES
	MOV	CX,1		;WRITE 1 CHARACTER
	INT	10H		;CALL BIOS DISPLAY I/O ROUTINE
	POP	BP		;RESTORES
	POP	DX
	POP	CX
	RET
.CHROUT	ENDP

	;PRINT SPACES, WITHOUT MOVING CURSOR, NUMBER IN AL, ATTRIBUTE IN AH
.SPACE	PROC
	PUSH	BX		;SAVES
	PUSH	CX
	PUSH	BP
	MOV	BL,AH		;ATTRIBUTE
	SUB	AH,AH		;CLEAR HIGH BYTE
	MOV	CX,AX		;NUMBER OF SPACES
	MOV	AH,9		;SET UP FOR WRITE ATTRIBUTE/CHARACTER
	MOV	AL,32		;WRITE SPACES
	SUB	BH,BH		;PAGE 0
	MOV	BL,NRMATR	;****** THIS SHOULD HELP
	INT	10H		;CALL BIOS DISPLAY I/O ROUTINE
	POP	BP		;RESTORES
	POP	CX
	POP	BX
	RET
.SPACE	ENDP

	;MOVE TO FIRST COLUMN OF SCREEN BOTTOM
.CRBT	PROC
	PUSH	AX		;SAVES
	PUSH	BX
	PUSH	DX
	PUSH	BP
	MOV	AH,2		;SET UP FOR SET CURSOR POSITION
	SUB	BH,BH		;PAGE 0
	MOV	DL,LFTMAR	;MOVE TO FIRST COLUMN
	MOV	DH,24		;MOVE TO BOTTOM ROW
	INT	10H		;CALL BIOS DISPLAY I/O ROUTINE
	POP	BP		;RESTORES
	POP	DX
	POP	BX
	POP	AX
	RET
.CRBT	ENDP

	;PRINT A CARRIAGE RETURN/LINE FEED, WITH MORE MODE (ASSUMING SCREEN
	;BOTTOM)
.CRLF	PROC
	PUSH	AX		;SAVES
	PUSH	BX
	PUSH	CX
	PUSH	DX
	PUSH	BP
	CMP	CURSCR,0
	JE	.CRLFN

	CURGET			;HERE FOR SCREEN 1, PUT CURSOR ON NEXT LINE
	ADD	DH,1
	MOV	DL,2		; ADJUST FOR SONAR IN SEA STALKER

.CRLF1:	CURSET
	JMP	.CR1$

.CRLFN:	INC	MORLIN		;INCREMENT NUMBER OF LINES OUTPUT
	MOV	AH,6		;SET UP FOR SCROLL PAGE UP
	MOV	AL,1		;ONE LINE UP
	MOV	BH,NRMATR	;NORMAL DISPLAY ATTRIBUTE
	MOV	CL,0
	MOV	CH,SCRN0
	MOV	DX,TWIDTH
	MOV	DH,18H		;END AT LINE 24, COLUMN TWIDTH+1
	INT	10H		;CALL BIOS DISPLAY I/O ROUTINE
	CALL	.CRBT		;MOVE TO BEGINNING OF NEW LINE
	MOV	AX,MORLIN
	CMP	AX,LINMAX	;FULL PAGE OUTPUT?
	JL	.CR1$		;NOT YET
	MOV	MORLIN,0	;RESET COUNTER
	MOV	AX,OFFSET MORE	;ADDRESS OF MORE MODE PROMPT STRING
	MOV	BL,USLATR	;INVERSE VIDEO
	MOV	CH,18H		;STARTING IN ROW 24, COLUMN LFTMAR
	MOV	CL,LFTMAR
	CALL	.PRINTA		;PRINT IT WITH ATTRIBUTES
	CALL	.CHRIN		;READ A CHARACTER TO CONTINUE
	CALL	.CRBT		;MOVE TO BEGINNING OF NEW LINE
	MOV	AL,9		;9 SPACES
	MOV	AH,NRMATR	;NORMAL DISPLAY
	CALL	.SPACE		;PRINT THEM (CURSOR UNAFFECTED)
.CR1$:	CMP	SCRFLG,0
	JE	.CR2$
	CALL	PRTCRL		;CRLF TO PRINTER
.CR2$:	POP	BP		;RESTORES
	POP	DX
	POP	CX
	POP	BX
	POP	AX
	RET
.CRLF	ENDP

	;PRINT A STRING, POINTER (TO DATA SEGMENT) IN AX, WHITE FOREGROUND
.PRINT	PROC
	PUSH	BX		;SAVE BX
	MOV	BX,AX		;STRING POINTER
.PR1$:	MOV	AL,[BX]		;GET NEXT CHARACTER
	CMP	AL,0		;END OF LINE, WITH CRLF?
	JE	.PR2$		;YES
	CMP	AL,80H		;END OF LINE, NO CRLF?
	JE	.PR3$		;YES
	MOV	AH,NRMATR	;WHITE FOREGROUND
	CALL	.TTYOUT		;PRINT CHARACTER
	INC	BX		;POINT TO NEXT CHARACTER
	JMP	.PR1$		;REPEAT
.PR2$:	CALL	.CRLF		;PRINT A CRLF
.PR3$:	POP	BX		;RESTORE BX
	RET
.PRINT	ENDP

	;PRINT A STRING, POINTER (TO DATA SEGMENT) IN AX, ATTRIBUTES IN BX,
	;STARTING ROW IN CH, STARTING COLUMN IN CL
.PRINTA	PROC
	PUSH	CX		;SAVE CX
	PUSH	DX		;SAVE DX
	PUSH	SI		;SAVE SI
	PUSH	DI		;SAVE DI
	MOV	SI,AX		;STRING POINTER
	MOV	DX,BX		;ATTRIBUTES
	MOV	DI,CX		;ROW AND COLUMN
.PA1$:	MOV	AL,[SI]		;GET NEXT CHARACTER
	CMP	AL,0		;END OF LINE, WITH CRLF?
	JE	.PA2$		;YES
	CMP	AL,80H		;END OF LINE, NO CRLF?
	JE	.PA3$		;YES
	MOV	AH,DL		;ATTRIBUTES
	MOV	BX,DI		;ROW AND COLUMN
	CALL	.CHROUT		;PRINT CHARACTER
	INC	SI		;POINT TO NEXT CHARACTER
	INC	DI		;MOVE TO NEXT COLUMN
	JMP	.PA1$		;REPEAT
.PA2$:	CALL	.CRLF		;PRINT A CRLF
.PA3$:	POP	DI		;RESTORE DI
	POP	SI		;RESTORE SI
	POP	DX		;RESTORE DX
	POP	CX		;RESTORE CX
	RET
.PRINTA	ENDP

	;READ AL SECTORS FROM DRIVE AH STARTING AT TRACK CH, SECTOR CL
	;TO MEMORY STARTING AT ES:BX
.RDWRT	PROC
	PUSH	DX		;SAVES
	PUSH	BP
	PUSH	SI
	CMP	FUCK,0
	JE	.RDX$
	CMP	INIFLG,5
	JNE	.RDX$
	CALL	PRSPC
	MOV	AX,BX
	CALL	PRSPC
	MOV	AX,CX
	CALL	PRSPC
	CALL	.CRLF
.RDX$:	MOV	BP,4		;TRY READING 4 TIMES BEFORE FAILING
	MOV	DL,AH		;DRIVE NUMBER
	MOV	AH,2		;SET UP FOR DISK READ
	CMP	DSKDIR,0
	JE	.RD0$
	ADD	AH,1		;WRITE IS CONVENIENTLY 3
.RD0$:	MOV	SI,AX		;SAVE SET UP DATA FOR RETRIES
	SUB	DH,DH		;HEAD 0
.RD1$:	MOV	AX,SI		;RESTORE SET UP DATA
	INT	13H		;CALL BIOS DISKETTE I/O ROUTINE
	JNC	.RD2$		;READ SUCCEEDED
	DEC	BP		;DECREMENT TRY COUNTER
	JNE	.RD1$		;RETRY IF COUNTER NON-ZERO
	CMP	FUCK,0
	JE	.RDFL$
	CMP	INIFLG,5
	JNE	.RDFL$
	CALL	PRSPC
	CALL	.CRLF
.RDFL$:	STC			;INDICATE READ FAILED
.RD2$:	POP	SI		;RESTORES
	POP	BP
	POP	DX
	RET
.RDWRT	ENDP

	;GET MEMORY SIZE (IN PARAGRAPHS)
.GETMEM	PROC
	TEST	INIFLG,INIMEM	;CHECK FOR FORCED MEMORY
	JZ	.GTM1$
	MOV	AX,0C00H	;48K (IN PARAGRAPHS)
	RET
.GTM1$:	INT	12H		;CALL BIOS MEMORY SIZE DETERMINATION ROUTINE
	CMP	AX,512		;CHECK FOR >512K
	JL	.GTMX$
	MOV	AX,500
.GTMX$:	SHL	AX,1		;CONVERT FROM K TO PARAGRAPHS
	SHL	AX,1
	SHL	AX,1
	SHL	AX,1
	SHL	AX,1
	SHL	AX,1
	CMP	AX,1000H	;MAXIMUM ALLOWED IS 64K (CROCK)
	JLE	.GTM2$
	MOV	AX,1000H
.GTM2$:	RET
.GETMEM	ENDP

	;GET TIME
.GETTM	PROC
	PUSH	AX		;SAVES
	PUSH	CX
	PUSH	DX
	SUB	AH,AH		;SET UP FOR READ TIME OF DAY
	INT	1AH		;CALL BIOS TIME OF DAY ROUTINE
	MOV	TIME,CX		;STORE IN VARIABLE
	MOV	TIME[2],DX
	POP	DX		;RESTORES
	POP	CX
	POP	AX
	RET
.GETTM	ENDP

FINISH	PROC
	CALL	.CRLF
	PRINT	REBOOT
	PRINT	REBOO1
	CALL	.CHRIN		;GET A CHARACTER
	INT	19H		;REBOOT
FINISH	ENDP

CODE_SG	ENDS

GAME_SG	SEGMENT	PAGE AT 800H
GAME_SG	ENDS

	END	START