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