A large commit.
[pdp8.git] / sw / os8 / v3d / sources / fortran / dectapes / dectape1 / realtm.ra
CommitLineData
81e70d48
PH
1/ A-D CLOCKED, BUFFERED SAMPLING ROUTINE
2/
3/ VERSION 5A 4-27-77 PT
4/
5 ADSK=6534
6 ADRB=6533
7 ADST=6532
8 ADLM=6531
9 ADLE=6536
10 ADCL=6530
11 CLZE=6130
12 ESF=4
13 LINC=6141
14 PDP=2
15 SAM=100
16 CLEN=6134
17 FIELD1 SAMPLE
18 0 /INTERRUPT TIME AD SAMPLER
19 IFNSW 8 <
20 JMS LNCSAM /INITIATE SAMPLE
21NEXTCH, ISZ SAMINS /UPDATE SAM INST FOR NEXT CHAN
22 JMS LNCSAM /SAM AND INITIATE NEXT CHANNEL
23 >
24 TAD SAMPTR /SAVE THE OLD SAM BUFFER POINTER
25 DCA OLDPTR
26 TAD BUFFLD /AND THE FIELD
27 DCA OLDFLD
28 ISZ SAMPTR /BUMP BUFFER POINTER
29 JMP FLDOK /FIELD IS OK
30 TAD BUFFLD /BUMP FIELD
31 TAD L10
32 DCA BUFFLD
33FLDOK, ISZ SAMCNT /BUMP BUFFER COUNT
34 JMP BUFFLD /NOT END OF BUFFER
35 TAD ARRAY+2 /RESET POINTER TO START OF BUFFER
36 DCA SAMPTR
37 TAD FLDBUF /RESET BUFFER FIELD
38 DCA BUFFLD
39 TAD BUFSIZ /RESET COUNT
40 DCA SAMCNT
41BUFFLD, HLT /GET FIELD OF NEW ADB STOP CODE
42 TAD% SAMPTR /IS THIS THE SAM STOP CODE ?
43 TAD M3776 /(ILLEGAL AS A SAMPLE)
44 SZA CLA
45 JMP NOERR
46 ISZ TOOFAS /SET TOO FAST SWITCH
47SAMPLD, CDF 10
48 DCA% XCLINT+1 /STOP SAMPLING
49 JMP% SAMPLE
50NOERR, CLL CMA RAR /SET ADB STOP CODE
51 DCA% SAMPTR
52OLDFLD, HLT /GET TO FIELD OF SAMPLE
53 IFSW 8 <
54 ADRB /READ SAMPLE
55 >
56 IFNSW 8 <
57 TAD SAMTMP /GET PREVIOUSLY READ SAMPLE
58 >
59 DCA% OLDPTR /INTO BUFFER
60 ISZ NPOINT+2 /ANY MORE SAMPLES
61 SKP /YES
62 ISZ NPOINT+1 /MORE THAN 7777 ?
63 SKP /YES
64 JMP SAMPLD /NO
65 ISZ NCHANL+1 /ANY MORE CHANNELS TO SAMPLE ?
66 JMP NEXTCH /YES GO START SAMPLING
67 TAD CSTART+2 /STARTING CHANNEL
68 IFSW 8 <
69 ADLM
70 >
71 IFNSW 8 <
72 DCA SAMINS
73 JMS LNCSAM /SET CHANNEL TO START
74 /IN CASE CLOCK INITIATED
75 >
76 TAD NCHANL+2 /NUMBER OF CHANNELS
77 DCA NCHANL+1 /INTO COUNTER
78 CDF 10
79 JMP% SAMPLE
80 IFSW 8 <
81NEXTCH, ADST /SAMPLE NEXT CHANNEL
82 ADSK /WAIT FOR SAMPLE
83 JMP .-1
84 JMP SAMPLE+1
85 >
86 IFNSW 8 <
87LNCSAM, 0 /LINC SAM SUBROUTINE
88 LINC
89SAMINS, SAM 0 /SAMPLE AND SELECT NEXT CHANNEL
90 PDP
91 DCA SAMTMP /SAVE IT
92 JMP% LNCSAM
93 >
94ADSETU, 0 /SET UP ROUTINE
95 DCA TOOFAS /CLEAR TOO FAST SWITCH
96 TAD ARRAY+1 /GET FIELD OF BUFFER
97 AND L7
98 CLL RTL
99 RAL
100 TAD CDF0
101 DCA FLDBUF
102 TAD FLDBUF
103 DCA BUFFLD /SAVE IN SAMPLER CODE
104 TAD ARRAY+2 /SET SAMPLER BUFFER POINTER
105 IAC
106 DCA SAMPTR
107 TAD LENGTH+2 /SIZE OF BUFFER
108 CLL RAL
109 TAD LENGTH+2 /TIMES THREE
110 DCA BUFSIZ /SAVE IT
111 TAD BUFSIZ /SET INITIAL COUNT
112 IAC
113 DCA SAMCNT
114 TAD NCHANL+2 /SET CHANNEL COUNT
115 DCA NCHANL+1
116 IFSW 8 <
117 CLA CMA /STOP THE CLOCK
118 CLZE
119 CLA
120 ADCL /CLEAR AD LOGIC JUST IN CASE
121 TAD L300 /SET AD ENABLE BITS
122 ADLE
123 TAD CSTART+2 /STARTING CHANNEL NUMBER
124 ADLM
125 >
126 IFNSW 8 <
127 CLEN /STOP THE CLOCK
128 TAD CSTART+2 /SET UP INITIAL SAM INSTRUCTION
129 TAD L100
130 DCA CSTART+2
131 TAD CSTART+2
132 DCA SAMST /STARTING SAM
133 TAD SAMST /ALSO INTERRUPT TIME SAM
134 DCA SAMINS
135 TAD L100 /SET FAST SAM BIT
136 IOF /TURN OFF INTERRUPTS IN LINC MODE
137 LINC /ENTER LINC MODE
138 ESF
139SAMST, SAM 0 /SET INITIAL SAM CHANNEL
140 PDP
141 ION
142 CLA
143 >
144 CIF CDF
145 JMP% ADSETU
146BASEX, FNOP
147M3776, -3776
148L10, 10
149SAMPTR,
150ARRAY, 0;0;0
151LENGTH, 0;0
152BUFSIZ, 0
153SAMCNT,
154CSTART, 0
155OLDPTR, 0;0
156SAMTMP,
157NCHANL, 0;0;0
158NPOINT, 0;0;0
159FLDBUF,
160XCLINT, ADDR #CLINT
161 IFSW 8 <
162L300, 300
163 >
164 IFNSW 8 <
165L100, 100
166 >
167SAMXR, 0;0
168TOOFAS, 0
169 ORG 10*3+BASEX
170 0
171 JA NAME+3
172 0
173SAMRTN, JA .
174CDF0, CDF
175L7, 7
176\f SECT REALTM
177 BASE 0
178 STARTD
179 FLDA 30 /GET RETURN ADDR
180 FSTA SAMRTN
181 FLDA 0 /GET ARG POINTER
182 BASE BASEX
183 SETB BASEX
184 SETX SAMXR
185 FSTA NPOINT /SAVE ARG POINTER
186 FCLA
187 EXTERN #CLINT
188 FSTA #CLINT /STOP ANY SAMPLING NOW!
189 LDX 1,1
190 FLDA% NPOINT,1 /GET BUFFER ADDRESS
191 FSTA ARRAY
192 FLDA% NPOINT,1+ /GET ADDR OF LENGTH
193 FSTA LENGTH
194 FLDA% NPOINT,1+ /ADDR OFHANNEL START
195 FSTA CSTART
196 FLDA% NPOINT,1+ /ADDR OF # CHANNELS
197 FSTA NCHANL
198 FLDA% NPOINT,1+ /ADDR OF NUMBER OF POINTS
199 FSTA NPOINT
200 FLDA ARRAY /CREATE SETX INS
201 FADD STXMJA
202 FSTA BUFSTX
203 FSTA ADBSTX /AND SAVE IT IN TWO PLACES
204 STARTF
205 FLDA% LENGTH /INTEGERIZE AND NEGATE SOME ARGS
206 FNEG
207 ALN 0
208 FSTA LENGTH
209 FNORM
210 ATX 1 /SET BUFFER COUNT
211 FLDA% CSTART /GET STARTING CHANNEL
212 ALN 0
213 FSTA CSTART
214 FLDA% NCHANL
215 FNEG
216 ALN 0
217 FSTA NCHANL
218 FLDA% NPOINT
219 FNEG
220 ALN 0
221 FSTA NPOINT
222 LDX -1,2 /SET UP FOR BUFFER CLEAR
223 FCLA
224CLRBUF, FSTA% ARRAY,2+
225 JXN CLRBUF,1+
226 TRAP4 ADSETU /SET UP AD STUFF
227 FLDA LENGTH /RE-GET BUFFER SIZE
228 FNORM
229 ATX 1 /BUT NOW ITS TIMES THREE
230 FLDA STPCOD /STORE STOP CODES
231 FSTA% ARRAY /INTO FIRST 3 WORD
232 STARTD
233 FLDA SAMADR /SET UP SAMPLER INTERRUPT HANDLER
234 FSTA #CLINT
235 STARTF
236 JA SAMRTN /RETURN
237NAME, TEXT +RTMADB+
238SAMADR, ADDR SAMPLE
239STPCOD, 3776;3777;0
240STXMJA, 1100-1030;0
241L2047, F 2047.
242L511, F 511.
243\f ENTRY ADB
244ADB, BASE 0 /FETCH SAMPLE FROM BUFFER
245 STARTD
246 FLDA 30 /SAVE REUTRN
247 FSTA SAMRTN
248 SETB BASEX
249 SETX SAMXR
250 BASE BASEX
251 JXN SPEEDK,2 /CLOCK TOO FAST
252 FLDA ADBSTX /SAVE OLD SETX
253 FSTA OLDSTX
254 FADD L1 /ADD ONE TO IT
255 FSTA ADBSTX /AND SAVE IT BACK
256 JXN NORINQ,1+ /END OF BUFFER ?
257 FLDA BUFSTX /YES, RESTART
258 FSTA ADBSTX
259 FLDA LENGTH /RESET COUNT
260 ATX 1
261NORINQ, STARTF
262ADBSTX, SETX 0 /SET XR0 TO NEXT SAMPLE
263WAIT, XTA 0 /GET THE NEXT SAMPLE
264 FSUB L2047 /IS IT THE STOP CODE
265 JEQ WAIT /YES
266 XTA 0 /NO, FETCH THE SAMPLE
267 LDX 3776,0 /SET SAMPLE STOP CODE
268OLDSTX, SETX 0 /SET XR0 TO PREVIOUS STOP CODE
269 LDX 0,0 /NOW ZERO IT
270 JA SAMRTN /RETURN
271SPEEDK, EXTERN #WRITO /USE FORTRAN I/O
272 TRAP3 #WRITO /TO WRITE A MESSAGE
273 JA TTYUNT /ON THE TTY
274 JA MESSAG
275 EXTERN #RENDO
276 TRAP3 #RENDO /CLOSE THE RECORD
277 LDX 0,2 /KILL TOO FAST SWITCH
278 JA SAMRTN /RETURN FROM ADB
279TTYUNT, F 0.
280MESSAG, TEXT '(" SAMPLING TOO FAST")'
281BUFSTX, SETX 0
282L1, 0;1
283 END
284\f