disk8: Initial commit

[pdp8.git] / sw / adventure / VOCAB.RA

	SECT	VOCAB\r
	EXTERN	SIXOUT\r
/	SUBROUTINE VOCAB(ID1,ID2,INIT,V)\r
/	OS/8: SUBROUTINE VOCAB(ID, INIT, V)\r
/C\r
/C LOOK UP ID1:ID2 IN THE VOCABULARY (ATAB AND A2TAB)\r
/C Note: A2TAB not used on the '8\r
/C AND RETURN ITS "DEFINITION" (KTAB), OR\r
/C -1 IF NOT FOUND. IF INIT IS POSITIVE, THIS IS AN INIT CALL SETTING\r
/C UP A KEYWORD VARIABLE, AND NOT FINDING IT CONSTITUTES A BUG. IT ALSO MEANS\r
/C THAT ONLY KTAB VALUES WHICH TAKEN OVER 1000 EQUAL INIT MAY BE CONSIDERED.\r
/C (THUS "STEPS", WHICH IS A MOTION VERB AS WELL AS AN OBJECT, MAY BE LOCATED\r
/C AS AN OBJECT.) AND IT ALSO MEANS THE KTAB VALUE IS TAKEN MOD 1000.\r
/C\r
/	IMPLICIT INTEGER (A-Z)\r
/	COMMON /VOCCOM/ KTAB,ATAB,A2TAB,TABSIZ\r
/	DIMENSION KTAB(300),ATAB(300),A2TAB(300)\r
\r
	EXTERN	BUG\r
	EXTERN	MOD\r
	JA	#ST\r
#XR,	ORG	.+10\r
	TEXT	+VOCAB+\r
#RET,	SETX	#XR\r
	SETB	#BASE\r
	JA	.+3\r
#BASE,	ORG	.+3\r
ID,	ORG	.+3\r
INIT,	ORG	.+3\r
ONE,	F 1.0\r
FOUR,	F 4.0\r
THOUS,	F 1000.0\r
TWO,	F 2.0\r
SIX,	F 6.0\r
	ORG	#BASE+30\r
	FNOP\r
	JA	#RET\r
	FNOP\r
#GOBAK,	0;0\r
#VAL,	ORG	.+6\r
ZERO,	F 0.0\r
I,	ORG	.+3\r
KTABI,	ORG	.+3\r
K21,	F 21.0\r
K5,	F 5.0\r
	#LBL=.\r
	COMMON	VOCCOM\r
KTAB,	ORG	.+1604\r
ATAB,	ORG	.+1604\r
TABSIZ,	ORG	.+3\r
	ORG	#LBL\r
#RTN,	BASE	#BASE\r
	FLDA	#VAL\r
	JA	#GOBAK\r
#ST,	STARTD\r
	0210\r
	FSTA	#GOBAK,0\r
	0200\r
	SETX	#XR\r
	SETB	#BASE\r
	LDX	0,1\r
	FSTA	#BASE\r
	FLDA%	#BASE,1+\r
	FSTA	ID\r
	FLDA%	#BASE,1+\r
	FSTA	INIT\r
	STARTF\r
	FLDA%	INIT\r
	FSTA	INIT\r
	FLDA%	ID\r
	FSTA	ID\r
/	 DO 1 I=1,TABSIZ\r
	FLDA	ONE\r
	FSTA	I\r
\r
/	 IF(KTAB(I).EQ.-1)GOTO 2\r
#G0001,	FLDA	I\r
	ATX	7\r
	FLDA	KTAB-3,7\r
	FSTA	KTABI\r
	FADD	ONE\r
	JEQ	#2\r
/	 IF(INIT.GE.0.AND.KTAB(I)/1000.NE.INIT)GOTO 1\r
	FLDA	INIT\r
	JLT	#M1\r
	FLDA	KTABI\r
	FDIV	THOUS\r
	EXTERN	#FIX\r
	JSA	#FIX\r
	FSUB	INIT\r
	JNE	#1\r
/	 IF(ATAB(I).EQ.ID1 .AND. A2TAB(I).EQ.ID2)GOTO 3\r
/	 OS/8: IF(ATAB(I).EQ.ID)GOTO 3\r
#M1,	FLDA	ATAB-0003,7\r
	FSUB	ID\r
	JEQ	#3\r
/1	 CONTINUE\r
/ do loop end\r
#1,	FLDA	I\r
	FADD	ONE\r
	FSTA	I\r
	FSUB	TABSIZ\r
	JLE	#G0001\r
/	 CALL BUG(21)\r
	JSR	BUG\r
	JA	.+0004\r
	JA	K21\r
\r
/2	 V=-1\r
#2,	FLDA	ONE\r
	FNEG\r
	FSTA	#VAL\r
/	 IF(INIT.LT.0)RETURN\r
	FLDA	INIT\r
	JLT	#RTN\r
\r
/	 TYPE 100,ID\r
#G0002,	JSR	SIXOUT\r
	JA	.+10\r
	JA	#100\r
	JA	ZERO\r
	JA	TWO\r
\r
	JSR	SIXOUT\r
	JA	.+10\r
	JA	ID\r
	JA	TWO\r
	JA	ONE\r
\r
/	 CALL BUG(5)\r
	JSR	BUG\r
	JA	.+0004\r
	JA	K5\r
\r
/3	 V=KTAB(I)\r
#3,	FLDA	KTABI\r
	FSTA	#VAL\r
/	 IF(INIT.GE.0)V=MOD(V,1000)\r
	FLDA	INIT\r
	JLT	#RTN\r
	JSR	MOD\r
	JA	.+0006\r
	JA	#VAL\r
	JA	THOUS\r
	FSTA	#VAL\r
/	 RETURN\r
/	 END\r
	JA	#RTN\r
/100	 FORMAT(' KEYWORD = ',2A2)\r
/ OS/8: ,A4\r
#100,	 TEXT	'K]EYWORD = @'\r
	END\r