erkyrath.infocom-zcode-terps/ibm/objops.ezp

	SUBTTL	OBJECT OPERATIONS
	PAGE	+

	PUBLIC	OPMOVE,OPREMO,OPQFSE,OPFSET
	;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
	PTAWRD	ES:[BP].PARENT,D	; (A0) PUT OBJ2 INTO OBJ1'S LOC SLOT
	GTAWRD	D,ES:[BX].CHILD1	; (A0) GET CONTENTS OBJ2'S FIRST SLOT
	PTAWRD	ES:[BX].CHILD1,C	; (A0) MAKE OBJ1 FIRST CONTENT OBJ2
	CMP	DX,0		;WERE THERE ANY OTHER CONTENTS?
	JE	OMV1$		;NO
	PTAWRD	ES:[BP].SIBLING,D	; YES, CHAIN ONTO OBJ1'S SIBLING SLOT
OMV1$:	RET
OPMOVE	ENDP

	;REMOVE (OBJ FROM ITS PARENT)
OPREMO	PROC
	MOV	DX,AX		; (A0) SAVE OBJ FOR LATER
	CALL	OBJLOC		;FIND ITS LOCATION
	MOV	BX,AX		;MOVE TO BASE
	GTAWRD	C,ES:[BX].PARENT	; (A0) GET ITS PARENT
	CMP	CX,0		;DOES IT HAVE A PARENT?
	JE	ORM3$		;IF NOT, WE'RE DONE
	MOV	AX,CX		; (A0) PARENT
	CALL	OBJLOC		;FIND PARENT'S LOCATION
	MOV	BP,AX		;MOVE TO BASE
	MOV	CX,DX		; (A0) MOVE OBJECT TO CX
	GTAWRD	D,ES:[BP].CHILD1	; (A0) GET PARENT'S FIRST CONTENT
	CMP	DX,CX		; (A0) IS IT OBJ?
	JNE	ORM1$		;NO
	MOVM	ES:[BP].CHILD1,ES:[BX].SIBLING,AX	;YES, CHANGE SLOT TO
							;OBJ'S SIBLING
	JMP	ORM2$		;AND RETURN
ORM1$:	MOV	AX,DX		; (A0) CURRENT SIBLING
	CALL	OBJLOC		;FIND ITS LOCATION
	MOV	BP,AX		;MOVE TO BASE
	GTAWRD	D,ES:[BP].SIBLING	; (A0) GET NEXT SIBLING IN CHAIN
	CMP	DX,CX		; (A0) IS IT OBJ?
	JNE	ORM1$		;NO, CONTINUE LOOP
	MOVM	ES:[BP].SIBLING,ES:[BX].SIBLING,AX	; (A0) 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,32		; (A0) FIND WHICH WORD TO SET FLAG IN
	JL	OQF0$		; (A0) NOT IN THE THIRD
	SUB	BX,32		; (A0) YES, IT IS
	ADD	AX,4		; (A0) SKIP OTHER FLAG WORDS IN OBJECT
	JMP	OQF1$		; (A0) AND SET THE FLAG
OQF0$:	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,32		; (A0) FIND WHICH WORD TO SET FLAG IN
	JL	OFS0$		; (A0) NOT IN THE THIRD
	SUB	BX,32		; (A0) YES, IT IS
	ADD	AX,4		; (A0) SKIP OTHER FLAG WORDS IN OBJECT
	JMP	OFS1$		; (A0) AND SET THE FLAG
OFS0$:	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

	PUBLIC	OPFCLE,OPLOC,OPQFIR,OPQNEX,OPQIN
	;FCLEAR (CLEAR A FLAG IN OBJ)
OPFCLE	PROC
	CALL	OBJLOC		;FIND OBJ'S LOCATION
	CMP	BX,32		; (A0) FIND WHICH FLAG WORD WE WANT
	JL	OFC0$		; (A0) MAYBE IN SECOND WORD
	ADD	AX,4		; (A0) POINT TO THIRD WORD
	SUB	BX,32		; (A0) BASIFY FLAG NUMBER
	JMP	OFC1$		; (A0) AND CLEAR FLAG
OFC0$:	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
	GTAWRD	A,ES:[BX].PARENT	; (A0) GET LOC SLOT
	JMP	PUTVAL		; (A0) RETURN THE WORD 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
	GTAWRD	A,ES:[BX].CHILD1	; (A0) GET FIRST SLOT
	PUSH	AX		;SAVE IT
	CALL	PUTVAL		; (A0) RETURN THE BYTE VALUE
	POP	AX		;RESTORE IT
	CMP	AX,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
	GTAWRD	A,ES:[BX].SIBLING	; (A0) GET SIBLING SLOT
	PUSH	AX		;SAVE IT
	CALL	PUTVAL		; (A0) RETURN THE BYTE VALUE
	POP	AX		;RESTORE IT
	CMP	AX,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
	XCHG	AH,AL		; (A0) FLOP BYTES
	CMP	ES:[BX].PARENT,AX	; (A0) IS OBJ1'S PARENT OBJ2?
	XCHG	AH,AL		; (A0) REFLOP BYTES
	JE	JPT1		;YES, PREDICATE TRUE
	JMP	JPF1		;NO, PREDICATE FALSE
OPQIN	ENDP

	PUBLIC	OPGETP
	;GETP (GET SPECIFIED PROPERTY OF OBJ, DEFAULT IF NONE)
OPGETP	PROC
	MOV	DX,BX		;PROPERTY
	CALL	OBJLOC		;FIND OBJ'S LOCATION
	CALL	FSTPRP		; (A0) GET FIRST PROPERTY POINTER
	JMP	OGP2$		;SKIP NEXT LINE FIRST TIME THROUGH LOOP
OGP1$:	CALL	NXTPRP		;POINT TO NEXT PROPERTY
OGP2$:	MOV	AL,ES:[BX]	; (A0) 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]	; (A0) NOW FIND PROPERTY SIZE
	INC	BX		; (A0) ADVANCE PROP BYTE POINTER
	AND	AL,3FH		; (A0) MASK OFF LENGTH BITS
	
	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)
	PUBLIC	OPPUTP,OPP2$
OPPUTP	PROC
	PUSH	CX		;SAVE NEW VALUE
	MOV	DX,BX		;PROPERTY
	CALL	OBJLOC		;FIND OBJ'S LOCATION
	CALL	FSTPRP		; (A0) GET FIRST PROPERTY
	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,3FH		; (A0) MASK OFF LENGTH BITS
	
	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)
	PUBLIC	OPNEXT,ONX2$
OPNEXT	PROC
	MOV	DX,BX		;PROPERTY
	CALL	OBJLOC		;FIND OBJ'S LOCATION
	CALL	FSTPRP		; (A0) POINT TO FIRST PROPERTY
	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

	; GIVEN OBJLOC IN AX, RETURN A PTR TO FIRST PROPERTY IN BX
	PUBLIC	FSTPRP
FSTPRP	PROC
	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
	XOR	AH,AH		; (A0) ZERO THE TOP HALF
	SHL	AX,1		;CONVERT TO BYTES
	ADD	BX,AX		;ADJUST POINTER TO SKIP IT
	INC	BX		; SKIP LENGTH BYTE
	RET
FSTPRP	ENDP