A large commit.
[pdp8.git] / sw / adventure / src / A5TOA1.RA
diff --git a/sw/adventure/src/A5TOA1.RA b/sw/adventure/src/A5TOA1.RA
new file mode 100644 (file)
index 0000000..f99270e
--- /dev/null
@@ -0,0 +1,157 @@
+/      SUBROUTINE A5TOA1(A,B,D)\r
+/(pdp11:)SUBROUTINE A5TOA1(A,B,C,D)\r
+/\r
+/ THIS ROUTINE TAKES THE UP TO 6 CHARACTER "WORD" IN A:B:C\r
+/ AND TYPES IT OUT, FOLLOWED BY THE PUNCTUATION MARK IN D.\r
+/ IT ALSO APPENDS A CRLF TO GET TO A NEW LINE.\r
+/ For OS/8: the word is in A,B with nothing in C.\r
+/\r
+/      IMPLICIT INTEGER (A-Z)\r
+/      COMMON  /ALPHAS/ BLANK\r
+\r
+       EXTERN  SIXOUT\r
+       EXTERN  CGET\r
+       EXTERN  CPUT\r
+       SECT    A5TOA1\r
+       JA      #ST\r
+#XR,   ORG     .+10\r
+       TEXT    +A5TOA1+\r
+#RET,  SETX    #XR\r
+       SETB    #BASE\r
+       JA      .+3\r
+#BASE, ORG     .+6\r
+ZERO,  F 0\r
+A,     ORG     .+3\r
+B,     ORG     .+3\r
+D,     ORG     .+3\r
+ONE,   F 1\r
+THREE, F 3\r
+BLANK, TEXT +      +\r
+       ORG     #BASE+30\r
+       FNOP\r
+       JA      #RET\r
+       FNOP\r
+#GOBAK,        0;0\r
+#RTN,  BASE    #BASE\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    A\r
+       FLDA%   #BASE,1+\r
+       FSTA    B\r
+       FLDA%   #BASE,1+\r
+       FSTA    D\r
+       STARTF\r
+       FLDA%   A\r
+       FSTA    A\r
+       FLDA%   B\r
+       FSTA    B\r
+       FLDA%   D\r
+       FSTA    D\r
+/      IF (A .NE. BLANK) TYPE 1,A\r
+       FLDA    A\r
+       FSUB    BLANK\r
+       JEQ     #G0001\r
+       JSR     TRIM\r
+       JA      .+4\r
+       JA      A\r
+       JSR     SIXOUT\r
+       JA      .+10\r
+       JA      A\r
+       JA      ZERO\r
+       JA      THREE\r
+/      IF (B .NE. BLANK) TYPE 1,B\r
+#G0001,        FLDA    B\r
+       FSUB    BLANK\r
+       JEQ     #G0002\r
+       JSR     TRIM\r
+       JA      .+4\r
+       JA      B\r
+       JSR     SIXOUT\r
+       JA      .+10\r
+       JA      B\r
+       JA      ZERO\r
+       JA      THREE\r
+/      IF (C .NE. BLANK) TYPE 1,C\r
+/      TYPE 2,D\r
+#G0002,        JSR     TRIM\r
+       JA      .+4\r
+       JA      D\r
+       JSR     SIXOUT\r
+       JA      #RTN\r
+       JA      D\r
+       JA      ZERO\r
+       JA      ONE\r
+/      RETURN\r
+/      END\r
+\r
+/1     FORMAT('+',A2,$)\r
+/2     FORMAT('+',A2)\r
+\r
+       SECT    TRIM\r
+       JA      #TST\r
+#TXR,  ORG     .+10\r
+       TEXT    +TRIM  +\r
+#TRET, SETX    #TXR\r
+       SETB    #TBASE\r
+       JA      .+3\r
+#TBASE,        ORG     .+6\r
+PSTR,  ORG     .+3\r
+I,     ORG     .+3\r
+CH,    ORG     .+3\r
+K1,    F 1\r
+K6,    F 6\r
+K32,   F 32\r
+       ORG     #TBASE+30\r
+       FNOP\r
+       JA      #TRET\r
+       FNOP\r
+#TGOBK,        0;0\r
+\r
+#TRTN, BASE    #TBASE\r
+       JA      #TGOBK\r
+#TST,  STARTD\r
+       0210\r
+       FSTA    #TGOBK,0\r
+       0200\r
+       SETX    #TXR\r
+       SETB    #TBASE\r
+       LDX     0,1\r
+       FSTA    #TBASE\r
+       FLDA%   #TBASE,1+\r
+       FSTA    PSTR\r
+       STARTF\r
+\r
+       FLDA    K6\r
+       FSTA    I\r
+#T10,  FLDA    PSTR\r
+       STARTD\r
+       FSTA    #TG001\r
+       FSTA    #TG002\r
+       STARTF\r
+       JSR     CGET\r
+       JA      .+0010\r
+#TG001,        JA      .\r
+       JA      I\r
+       JA      CH\r
+       FLDA    CH\r
+       FSUB    K32\r
+       JNE     #TRTN\r
+       JSR     CPUT\r
+       JA      .+0010\r
+#TG002,        JA      .\r
+       JA      I\r
+       JA      ZERO\r
+       FLDA    I\r
+       FSUB    K1\r
+       FSTA    I\r
+       JGT     #T10\r
+\r
+       JA      #TRTN\r