File: A5TOA1.LS of Disk: V50/Source/Source-Listing-FORTRAN-2
(Source file text)
RALF V50A 24-JUL-20 PAGE 1
/ SUBROUTINE A5TOA1(A,B,D)
/(pdp11:)SUBROUTINE A5TOA1(A,B,C,D)
/
/ THIS ROUTINE TAKES THE UP TO 6 CHARACTER "WORD" IN A:B:C
/ AND TYPES IT OUT, FOLLOWED BY THE PUNCTUATION MARK IN D.
/ IT ALSO APPENDS A CRLF TO GET TO A NEW LINE.
/ For OS/8: the word is in A,B with nothing in C.
/
/ IMPLICIT INTEGER (A-Z)
/ COMMON /ALPHAS/ BLANK
EXTERN SIXOUT
EXTERN CGET
EXTERN CPUT
SECT A5TOA1
00000 1030 JA #ST
00001 0063
#XR, ORG .+10
00012 0165 TEXT +A5TOA1+
00013 2417
00014 0161
00015 1100 #RET, SETX #XR
00016 0002
00017 1110 SETB #BASE
00020 0023
00021 1030 JA .+3
00022 0024
#BASE, ORG .+6
00031 0000 ZERO, F 0
00032 0000
00033 0000
A, ORG .+3
B, ORG .+3
D, ORG .+3
00045 0001 ONE, F 1
00046 2000
00047 0000
00050 0002 THREE, F 3
00051 3000
00052 0000
00053 4040 BLANK, TEXT + +
00054 4040
00055 4040
ORG #BASE+30
00053 0040 FNOP
00054 1030 JA #RET
00055 0015
00056 0040 FNOP
00057 0000 #GOBAK, 0;0
00060 0000
#RTN, BASE #BASE
00061 1030 JA #GOBAK
00062 0057
00063 0006 #ST, STARTD
00064 0210 0210
00065 6400 FSTA #GOBAK,0
RALF V50A 24-JUL-20 PAGE 1-1
00066 0057
00067 0200 0200
00070 1100 SETX #XR
00071 0002
00072 1110 SETB #BASE
00073 0023
00074 0101 LDX 0,1
00075 0000
00076 6200 FSTA #BASE
00077 0710 FLDA% #BASE,1+
00100 6203 FSTA A
00101 0710 FLDA% #BASE,1+
00102 6204 FSTA B
00103 0710 FLDA% #BASE,1+
00104 6205 FSTA D
00105 0005 STARTF
00106 0603 FLDA% A
00107 6203 FSTA A
00110 0604 FLDA% B
00111 6204 FSTA B
00112 0605 FLDA% D
00113 6205 FSTA D
/ IF (A .NE. BLANK) TYPE 1,A
00114 0203 FLDA A
00115 2210 FSUB BLANK
00116 1000 JEQ #G0001
00117 0140
00120 1130 JSR TRIM
00121 0000
00122 1030 JA .+4
00123 0126
00124 1030 JA A
00125 0034
00126 1130 JSR SIXOUT
00127 0000
00130 1030 JA .+10
00131 0140
00132 1030 JA A
00133 0034
00134 1030 JA ZERO
00135 0031
00136 1030 JA THREE
00137 0050
/ IF (B .NE. BLANK) TYPE 1,B
00140 0204 #G0001, FLDA B
00141 2210 FSUB BLANK
00142 1000 JEQ #G0002
00143 0164
00144 1130 JSR TRIM
00145 0000
00146 1030 JA .+4
00147 0152
00150 1030 JA B
00151 0037
00152 1130 JSR SIXOUT
00153 0000
RALF V50A 24-JUL-20 PAGE 1-2
00154 1030 JA .+10
00155 0164
00156 1030 JA B
00157 0037
00160 1030 JA ZERO
00161 0031
00162 1030 JA THREE
00163 0050
/ IF (C .NE. BLANK) TYPE 1,C
/ TYPE 2,D
00164 1130 #G0002, JSR TRIM
00165 0000
00166 1030 JA .+4
00167 0172
00170 1030 JA D
00171 0042
00172 1130 JSR SIXOUT
00173 0000
00174 1030 JA #RTN
00175 0061
00176 1030 JA D
00177 0042
00200 1030 JA ZERO
00201 0031
00202 1030 JA ONE
00203 0045
/ RETURN
/ END
/1 FORMAT('+',A2,$)
/2 FORMAT('+',A2)
SECT TRIM
00000 1030 JA #TST
00001 0063
#TXR, ORG .+10
00012 2422 TEXT +TRIM +
00013 1115
00014 4040
00015 1100 #TRET, SETX #TXR
00016 0002
00017 1110 SETB #TBASE
00020 0023
00021 1030 JA .+3
00022 0024
#TBASE, ORG .+6
PSTR, ORG .+3
I, ORG .+3
CH, ORG .+3
00042 0001 K1, F 1
00043 2000
00044 0000
00045 0003 K6, F 6
00046 3000
00047 0000
00050 0006 K32, F 32
RALF V50A 24-JUL-20 PAGE 1-3
00051 2000
00052 0000
ORG #TBASE+30
00053 0040 FNOP
00054 1030 JA #TRET
00055 0015
00056 0040 FNOP
00057 0000 #TGOBK, 0;0
00060 0000
#TRTN, BASE #TBASE
00061 1030 JA #TGOBK
00062 0057
00063 0006 #TST, STARTD
00064 0210 0210
00065 6400 FSTA #TGOBK,0
00066 0057
00067 0200 0200
00070 1100 SETX #TXR
00071 0002
00072 1110 SETB #TBASE
00073 0023
00074 0101 LDX 0,1
00075 0000
00076 6200 FSTA #TBASE
00077 0710 FLDA% #TBASE,1+
00100 6202 FSTA PSTR
00101 0005 STARTF
00102 0206 FLDA K6
00103 6203 FSTA I
00104 0202 #T10, FLDA PSTR
00105 0006 STARTD
00106 6400 FSTA #TG001
00107 0117
00110 6400 FSTA #TG002
00111 0135
00112 0005 STARTF
00113 1130 JSR CGET
00114 0000
00115 1030 JA .+0010
00116 0125
00117 1030 #TG001, JA .
00120 0117
00121 1030 JA I
00122 0034
00123 1030 JA CH
00124 0037
00125 0204 FLDA CH
00126 2207 FSUB K32
00127 1040 JNE #TRTN
00130 0061
00131 1130 JSR CPUT
00132 0000
00133 1030 JA .+0010
00134 0143
RALF V50A 24-JUL-20 PAGE 1-4
00135 1030 #TG002, JA .
00136 0135
00137 1030 JA I
00140 0034
00141 1030 JA ZERO
00142 0031
00143 0203 FLDA I
00144 2205 FSUB K1
00145 6203 FSTA I
00146 1060 JGT #T10
00147 0104
00150 1030 JA #TRTN
00151 0061
RALF V50A 24-JUL-20 PAGE 1-5
NO ERRORS
35 SYMBOLS, NO ABS REFS
# C 00000 #BASE 00023 #GOBAK 00057 #G0001 00140
#G0002 00164 #MAIN S 00000 #RET 00015 #RTN 00061
#ST 00063 #TBASE 00023 #TGOBK 00057 #TG001 00117
#TG002 00135 #TRET 00015 #TRTN 00061 #TST 00063
#TXR 00002 #T10 00104 #XR 00002 A 00034
A5TOA1 S 00204 B 00037 BLANK 00053 CGET X 00000
CH 00037 CPUT X 00000 D 00042 I 00034
K1 00042 K32 00050 K6 00045 ONE 00045
PSTR 00031 SIXOUT X 00000 THREE 00050 TRIM S 00152
ZERO 00031