File: VOCAB.RA of Disk: V50/Source/Source-Listing-FORTRAN-2

(Source file text) 

---

	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

---