547a542cf82cb61f7aee801debbec445355fa7c3
[pdp8.git] / sw / src / adventure / 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