sw/adventure/0906/A5TOA1.RA

   1 /       SUBROUTINE A5TOA1(A,B,D)
   2 /(pdp11:)SUBROUTINE A5TOA1(A,B,C,D)
   3 /
   4 / THIS ROUTINE TAKES THE UP TO 6 CHARACTER "WORD" IN A:B:C
   5 / AND TYPES IT OUT, FOLLOWED BY THE PUNCTUATION MARK IN D.
   6 / IT ALSO APPENDS A CRLF TO GET TO A NEW LINE.
   7 / For OS/8: the word is in A,B with nothing in C.
   8 /
   9 /       IMPLICIT INTEGER (A-Z)
  10 /       COMMON  /ALPHAS/ BLANK
  11
  12         EXTERN  SIXOUT
  13         EXTERN  CGET
  14         EXTERN  CPUT
  15         SECT    A5TOA1
  16         JA      #ST
  17 #XR,    ORG     .+10
  18         TEXT    +A5TOA1+
  19 #RET,   SETX    #XR
  20         SETB    #BASE
  21         JA      .+3
  22 #BASE,  ORG     .+6
  23 A,      ORG     .+3
  24 B,      ORG     .+3
  25 D,      ORG     .+3
  26 BLANK,  TEXT +      +
  27 ZERO,   F 0
  28 THREE,  F 3
  29         ORG     #BASE+30
  30         FNOP
  31         JA      #RET
  32         FNOP
  33 #GOBAK, 0;0
  34
  35 #RTN,   BASE    #BASE
  36         JA      #GOBAK
  37
  38 FIVE,   F 5
  39 SEVEN,  F 7
  40
  41 #ST,    STARTD
  42         0210
  43         FSTA    #GOBAK,0
  44         0200
  45         SETX    #XR
  46         SETB    #BASE
  47         LDX     0,1
  48         FSTA    #BASE
  49         FLDA%   #BASE,1+
  50         FSTA    A
  51         FLDA%   #BASE,1+
  52         FSTA    B
  53         FLDA%   #BASE,1+
  54         FSTA    D
  55         STARTF
  56         FLDA%   A
  57         FSTA    A
  58         FLDA%   B
  59         FSTA    B
  60         FLDA%   D
  61         FSTA    D
  62 /       IF (A .NE. BLANK) TYPE 1,A
  63         FLDA    A
  64         FSUB    BLANK
  65         JEQ     #G0001
  66         JSR     TRIM
  67         JA      .+4
  68         JA      A
  69         JSR     SIXOUT
  70         JA      .+10
  71         JA      A
  72         JA      ZERO
  73         JA      SEVEN
  74 /       IF (B .NE. BLANK) TYPE 1,B
  75 #G0001, FLDA    B
  76         FSUB    BLANK
  77         JEQ     #G0002
  78         JSR     TRIM
  79         JA      .+4
  80         JA      B
  81         JSR     SIXOUT
  82         JA      .+10
  83         JA      B
  84         JA      ZERO
  85         JA      SEVEN
  86 /       IF (C .NE. BLANK) TYPE 1,C
  87 /       TYPE 2,D
  88 #G0002, JSR     TRIM
  89         JA      .+4
  90         JA      D
  91         JSR     SIXOUT
  92         JA      #RTN
  93         JA      D
  94         JA      ZERO
  95         JA      FIVE
  96 /       RETURN
  97 /       END
  98
  99 /1      FORMAT('+',A2,$)
 100 /2      FORMAT('+',A2)
 101
 102         SECT    TRIM
 103         JA      #TST
 104 #TXR,   ORG     .+10
 105         TEXT    +TRIM  +
 106 #TRET,  SETX    #TXR
 107         SETB    #TBASE
 108         JA      .+3
 109 #TBASE, ORG     .+6
 110 PSTR,   ORG     .+3
 111 I,      ORG     .+3
 112 CH,     ORG     .+3
 113 K1,     F 1
 114 K6,     F 6
 115 K32,    F 32
 116         ORG     #TBASE+30
 117         FNOP
 118         JA      #TRET
 119         FNOP
 120 #TGOBK, 0;0
 121
 122 #TRTN,  BASE    #TBASE
 123         JA      #TGOBK
 124 #TST,   STARTD
 125         0210
 126         FSTA    #TGOBK,0
 127         0200
 128         SETX    #TXR
 129         SETB    #TBASE
 130         LDX     0,1
 131         FSTA    #TBASE
 132         FLDA%   #TBASE,1+
 133         FSTA    PSTR
 134         STARTF
 135
 136         FLDA    K6
 137         FSTA    I
 138 #T10,   FLDA    PSTR
 139         STARTD
 140         FSTA    #TG001
 141         FSTA    #TG002
 142         STARTF
 143         JSR     CGET
 144         JA      .+0010
 145 #TG001, JA      .
 146         JA      I
 147         JA      CH
 148         FLDA    CH
 149         FSUB    K32
 150         JNE     #TRTN
 151         JSR     CPUT
 152         JA      .+0010
 153 #TG002, JA      .
 154         JA      I
 155         JA      ZERO
 156         FLDA    I
 157         FSUB    K1
 158         FSTA    I
 159         JGT     #T10
 160
 161         JA      #TRTN