sw/adventure/work/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 ZERO,   F 0
  24 A,      ORG     .+3
  25 B,      ORG     .+3
  26 D,      ORG     .+3
  27 ONE,    F 1
  28 THREE,  F 3
  29 BLANK,  TEXT +      +
  30         ORG     #BASE+30
  31         FNOP
  32         JA      #RET
  33         FNOP
  34 #GOBAK, 0;0
  35 #RTN,   BASE    #BASE
  36         JA      #GOBAK
  37 #ST,    STARTD
  38         0210
  39         FSTA    #GOBAK,0
  40         0200
  41         SETX    #XR
  42         SETB    #BASE
  43         LDX     0,1
  44         FSTA    #BASE
  45         FLDA%   #BASE,1+
  46         FSTA    A
  47         FLDA%   #BASE,1+
  48         FSTA    B
  49         FLDA%   #BASE,1+
  50         FSTA    D
  51         STARTF
  52         FLDA%   A
  53         FSTA    A
  54         FLDA%   B
  55         FSTA    B
  56         FLDA%   D
  57         FSTA    D
  58 /       IF (A .NE. BLANK) TYPE 1,A
  59         FLDA    A
  60         FSUB    BLANK
  61         JEQ     #G0001
  62         JSR     TRIM
  63         JA      .+4
  64         JA      A
  65         JSR     SIXOUT
  66         JA      .+10
  67         JA      A
  68         JA      ZERO
  69         JA      THREE
  70 /       IF (B .NE. BLANK) TYPE 1,B
  71 #G0001, FLDA    B
  72         FSUB    BLANK
  73         JEQ     #G0002
  74         JSR     TRIM
  75         JA      .+4
  76         JA      B
  77         JSR     SIXOUT
  78         JA      .+10
  79         JA      B
  80         JA      ZERO
  81         JA      THREE
  82 /       IF (C .NE. BLANK) TYPE 1,C
  83 /       TYPE 2,D
  84 #G0002, JSR     TRIM
  85         JA      .+4
  86         JA      D
  87         JSR     SIXOUT
  88         JA      #RTN
  89         JA      D
  90         JA      ZERO
  91         JA      ONE
  92 /       RETURN
  93 /       END
  94
  95 /1      FORMAT('+',A2,$)
  96 /2      FORMAT('+',A2)
  97
  98         SECT    TRIM
  99         JA      #TST
 100 #TXR,   ORG     .+10
 101         TEXT    +TRIM  +
 102 #TRET,  SETX    #TXR
 103         SETB    #TBASE
 104         JA      .+3
 105 #TBASE, ORG     .+6
 106 PSTR,   ORG     .+3
 107 I,      ORG     .+3
 108 CH,     ORG     .+3
 109 K1,     F 1
 110 K6,     F 6
 111 K32,    F 32
 112         ORG     #TBASE+30
 113         FNOP
 114         JA      #TRET
 115         FNOP
 116 #TGOBK, 0;0
 117
 118 #TRTN,  BASE    #TBASE
 119         JA      #TGOBK
 120 #TST,   STARTD
 121         0210
 122         FSTA    #TGOBK,0
 123         0200
 124         SETX    #TXR
 125         SETB    #TBASE
 126         LDX     0,1
 127         FSTA    #TBASE
 128         FLDA%   #TBASE,1+
 129         FSTA    PSTR
 130         STARTF
 131
 132         FLDA    K6
 133         FSTA    I
 134 #T10,   FLDA    PSTR
 135         STARTD
 136         FSTA    #TG001
 137         FSTA    #TG002
 138         STARTF
 139         JSR     CGET
 140         JA      .+0010
 141 #TG001, JA      .
 142         JA      I
 143         JA      CH
 144         FLDA    CH
 145         FSUB    K32
 146         JNE     #TRTN
 147         JSR     CPUT
 148         JA      .+0010
 149 #TG002, JA      .
 150         JA      I
 151         JA      ZERO
 152         FLDA    I
 153         FSUB    K1
 154         FSTA    I
 155         JGT     #T10
 156
 157         JA      #TRTN