X-Git-Url: http://gitweb.hachti.de/?a=blobdiff_plain;f=sw%2Fadventure%2FVOCAB.RA;fp=sw%2Fadventure%2FVOCAB.RA;h=555a462138689e35e223ef47ee69dc51cd2cae11;hb=84b5715c66b026062d9c455da3509b814bc32b1b;hp=0000000000000000000000000000000000000000;hpb=9107854b0bc70913de9757805c976b7442d88178;p=pdp8.git

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