adventure: Initial commit

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

diff --git a/sw/adventure/VOCAB.RA b/sw/adventure/VOCAB.RA
new file mode 100644 (file)
index 0000000..555a462
--- /dev/null
+++ b/sw/adventure/VOCAB.RA
@@ -0,0 +1,152 @@
+       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