sw/adventure/VOCAB.RA

   1         SECT    VOCAB
   2         EXTERN  SIXOUT
   3 /       SUBROUTINE VOCAB(ID1,ID2,INIT,V)
   4 /       OS/8: SUBROUTINE VOCAB(ID, INIT, V)
   5 /C
   6 /C LOOK UP ID1:ID2 IN THE VOCABULARY (ATAB AND A2TAB)
   7 /C Note: A2TAB not used on the '8
   8 /C AND RETURN ITS "DEFINITION" (KTAB), OR
   9 /C -1 IF NOT FOUND. IF INIT IS POSITIVE, THIS IS AN INIT CALL SETTING
  10 /C UP A KEYWORD VARIABLE, AND NOT FINDING IT CONSTITUTES A BUG. IT ALSO MEANS
  11 /C THAT ONLY KTAB VALUES WHICH TAKEN OVER 1000 EQUAL INIT MAY BE CONSIDERED.
  12 /C (THUS "STEPS", WHICH IS A MOTION VERB AS WELL AS AN OBJECT, MAY BE LOCATED
  13 /C AS AN OBJECT.) AND IT ALSO MEANS THE KTAB VALUE IS TAKEN MOD 1000.
  14 /C
  15 /       IMPLICIT INTEGER (A-Z)
  16 /       COMMON /VOCCOM/ KTAB,ATAB,A2TAB,TABSIZ
  17 /       DIMENSION KTAB(300),ATAB(300),A2TAB(300)
  18
  19         EXTERN  BUG
  20         EXTERN  MOD
  21         JA      #ST
  22 #XR,    ORG     .+10
  23         TEXT    +VOCAB+
  24 #RET,   SETX    #XR
  25         SETB    #BASE
  26         JA      .+3
  27 #BASE,  ORG     .+3
  28 ID,     ORG     .+3
  29 INIT,   ORG     .+3
  30 ONE,    F 1.0
  31 FOUR,   F 4.0
  32 THOUS,  F 1000.0
  33 TWO,    F 2.0
  34 SIX,    F 6.0
  35         ORG     #BASE+30
  36         FNOP
  37         JA      #RET
  38         FNOP
  39 #GOBAK, 0;0
  40 #VAL,   ORG     .+6
  41 ZERO,   F 0.0
  42 I,      ORG     .+3
  43 KTABI,  ORG     .+3
  44 K21,    F 21.0
  45 K5,     F 5.0
  46         #LBL=.
  47         COMMON  VOCCOM
  48 KTAB,   ORG     .+1604
  49 ATAB,   ORG     .+1604
  50 TABSIZ, ORG     .+3
  51         ORG     #LBL
  52 #RTN,   BASE    #BASE
  53         FLDA    #VAL
  54         JA      #GOBAK
  55 #ST,    STARTD
  56         0210
  57         FSTA    #GOBAK,0
  58         0200
  59         SETX    #XR
  60         SETB    #BASE
  61         LDX     0,1
  62         FSTA    #BASE
  63         FLDA%   #BASE,1+
  64         FSTA    ID
  65         FLDA%   #BASE,1+
  66         FSTA    INIT
  67         STARTF
  68         FLDA%   INIT
  69         FSTA    INIT
  70         FLDA%   ID
  71         FSTA    ID
  72 /        DO 1 I=1,TABSIZ
  73         FLDA    ONE
  74         FSTA    I
  75
  76 /        IF(KTAB(I).EQ.-1)GOTO 2
  77 #G0001, FLDA    I
  78         ATX     7
  79         FLDA    KTAB-3,7
  80         FSTA    KTABI
  81         FADD    ONE
  82         JEQ     #2
  83 /        IF(INIT.GE.0.AND.KTAB(I)/1000.NE.INIT)GOTO 1
  84         FLDA    INIT
  85         JLT     #M1
  86         FLDA    KTABI
  87         FDIV    THOUS
  88         EXTERN  #FIX
  89         JSA     #FIX
  90         FSUB    INIT
  91         JNE     #1
  92 /        IF(ATAB(I).EQ.ID1 .AND. A2TAB(I).EQ.ID2)GOTO 3
  93 /        OS/8: IF(ATAB(I).EQ.ID)GOTO 3
  94 #M1,    FLDA    ATAB-0003,7
  95         FSUB    ID
  96         JEQ     #3
  97 /1       CONTINUE
  98 / do loop end
  99 #1,     FLDA    I
 100         FADD    ONE
 101         FSTA    I
 102         FSUB    TABSIZ
 103         JLE     #G0001
 104 /        CALL BUG(21)
 105         JSR     BUG
 106         JA      .+0004
 107         JA      K21
 108
 109 /2       V=-1
 110 #2,     FLDA    ONE
 111         FNEG
 112         FSTA    #VAL
 113 /        IF(INIT.LT.0)RETURN
 114         FLDA    INIT
 115         JLT     #RTN
 116
 117 /        TYPE 100,ID
 118 #G0002, JSR     SIXOUT
 119         JA      .+10
 120         JA      #100
 121         JA      ZERO
 122         JA      TWO
 123
 124         JSR     SIXOUT
 125         JA      .+10
 126         JA      ID
 127         JA      TWO
 128         JA      ONE
 129
 130 /        CALL BUG(5)
 131         JSR     BUG
 132         JA      .+0004
 133         JA      K5
 134
 135 /3       V=KTAB(I)
 136 #3,     FLDA    KTABI
 137         FSTA    #VAL
 138 /        IF(INIT.GE.0)V=MOD(V,1000)
 139         FLDA    INIT
 140         JLT     #RTN
 141         JSR     MOD
 142         JA      .+0006
 143         JA      #VAL
 144         JA      THOUS
 145         FSTA    #VAL
 146 /        RETURN
 147 /        END
 148         JA      #RTN
 149 /100     FORMAT(' KEYWORD = ',2A2)
 150 / OS/8: ,A4
 151 #100,    TEXT   'K]EYWORD = @'
 152         END