projects / pdp8.git / blob
? search:


4443493ccd9cc1c3fa21b3059b180b91f6eb4fcc
[pdp8.git] / sw / rescue / lab8e_goettingen / disk4_5 / rkb / paroff / aavg4c.pa
1 /LAB8E ADVANCED AVERAGER MS (HP7475A) - DISPLAY AND PLOT OUTPUT.
2 /
3 /DEC-8E-AAA4A-A-LA
4 /
5 /VERSION FOR HP7475A PLOTTER
6 /
7 /COPYRIGHT 1972
8 /DIGITAL EQUIPMENT CORPORATION
9 /MAYNARD, MASSACHUSETTS 01754
10 /
11 /UPDATE 7-AUG-1984 HA UNIVERSITY GOETTINGEN
12 /FIXES BUG IN OVRLAY ROUTINE
13 /COPYRIGHT 1984 BY HA
14 /
15 /UPDATE 29-JAN-1985 KJS UNIVERSITY GOETTINGEN
16 /PLOTTER CONTROL CHANGED
17 /COPYRIGHT 1985 BY KJS
18 \f/FILE AD4.1
19 /SECTION IV OF THE LAB8/E ADVANCED AVERAGER .
20 /THIS IS PART 4 OF ADVANCED AVERAGER FOR OS-8.
21 /OVERLAY FOR PS8.
22
23 *7557
24 OVRLAY, IOF
25 CLA CLL CMA
26 CLZE /DISABLE CLOCK
27 CLA
28 ADCL /AD
29 DILC /DISPLAY
30 DBDI /I/O
31 CDF 0 /CHAIN IN WRITE DATA TO DISK
32 DCA I KC7746 /0 PS8 JOB STATUS WORD.
33 TAD I XXOV4A /OVERLAY.
34 DCA XXOV4
35 CIF 10
36 JMS I CHAIN
37 6
38 XXOV4, 0
39 CHAIN, 7700
40 XXOV4A, PG0OV+2
41 PG0OV=5
42
43 MONITR=7600
44 CLZE=6130
45 ADCL=6530
46 DILC=6050
47 DBEI=6501
48
49
50 \f/LAB-8 ADVANCED AVERAGER - SECTION 4 - [U63A.4]
51 /COPYRIGHT 1971, DIGITAL EQUIPMENT CORP., MAYNARD, MASS. 01754
52
53 /
54 PWAITD=60 /CONTROLS PEN UP/DOWN DELAY TIME
55 /
56 /BASIC SUBROUTINES [SU63A]
57 BRAN=JMS I 132 /BRANCH ACCORDING TO AC MATCH WITH LIST
58 SHFT=JMS I 133 /DOUBLE PRECISION ARITHMETIC SHIFT
59 DADD=JMS I 134 /DOUBLE PRECISION ADD
60
61 /PAGE ZERO CONSTANTS
62 K0004=112
63 K0003=113
64 K0002=114
65 KM0001=115
66
67 K0007=116
68 KM0027=117
69 K0377=120
70 KM0004=121
71 \f
72 /TEMPORARY STORAGE REGISTERS 146=177
73 TEMP01=146
74 TEMP02=147
75 TEMP03=150
76 TEMP04=151
77 TEMP05=152
78 TEMP06=153
79 TEMP07=154
80 TEMP10=155
81
82 TEMP11=156
83 TEMP12=157
84 TEMP13=160
85 TEMP14=161
86 TEMP15=162
87 TEMP16=163
88 TEMP17=164
89 TEMP20=165
90 TEMP21=166
91
92 /TEMPORARY STORAGE AND MULTIPLE ACCUMULATORS
93 ARITH0=167
94 TEMP22=167
95
96 ARITH1=170
97 TEMP23=170
98
99 ARITH2=171
100 TEMP24=171
101
102 ARITH3=172
103 TEMP25=172
104
105 ARITH4=173
106 TEMP26=173
107
108 ARITH5=174
109 TEMP27=174
110
111 /TEMPORARY STORAGE AND TTY-KBD BUFFERS
112 KBDBUF=175
113 TEMP30=175
114
115 TTYBUF=176
116 TEMP31=176
117
118 TTYFLG=177
119 TEMP32=177
120 \f
121 /IOT REFERENCES FOR THE LAB/8E
122 /
123 /
124 /AD8-EA 10 BIT A/D CONVERTER
125 /
126
127 ADCL=6530 /CLEAR ALL
128 ADLM=6531 /LOAD MPLXR
129 ADST=6532 /START CONVERSION
130 ADRB=6533 /READ AD BUFFER
131 ADSK=6534 /SKIP ON AD DONE
132 ADSE=6535 /SKIP ON TIMING ERROR
133 ADLE=6536 /LOAD ENABLE REGISTER
134 ADRS=6537 /READ STATUS REGISTER
135 /
136 /VC8-E POINT PLOT DISPLAY
137 /
138 DILC=6050 /CLEAR ALL
139 DICD=6051 /CLEAR DONE FLAG
140 DISD=6052 /SKIP ON DONE FLAG
141 DILX=6053 /CLEAR DONE FLAG LOAD X
142 DILY=6054 /CLEAR DONE FLAG LOAD Y
143 DIXY=6055 /CLEAR DONE, INTENSIFY, SET DONE
144 DILE=6056 /LOAD ENABLE CLEAR AC
145 DIRE=6057 /ENABLE TO AC
146 /
147 /DK8-EP REAL TIME CLOCK
148 /
149 CLZE=6130 /ZERO TO ENABLE
150 CLSK=6131 /SKP ON CLOCK FG
151 CLOE=6132 /ONES TO ENABLE
152 CLAB=6133 /AC TO CLK BUF AND COUNTER REGISTER
153 CLEN=6134 /ENABLE TO AC
154 CLSA=6135 /STATUS TO AC AND AC ONE'S CLEAR STATUS REG.
155 CLBA=6136 /CLK BUF TO AC
156 CLCA=6137 /CLK CNTR TO AC AND TO AC
157 /
158 /DB8-EA 12 CHANNEL DIGITAL I/O
159 /
160 DBDI=6500 /DISABLE INTERRUPT
161 DBEI=6501 /ENABLE INTERRUPT
162 DBSK=6502 /SKIP ON INPUT
163 DBCI=6503 /CLEAR INPUT BITS WITH SET AC BIT
164 DBRI=6504 /READ INPUT
165 DBCO=6505 /CLEAR OUTPUT BITS WITH AC BITS
166 DBSO=6506 /SET OUTPUT BITS WITH AC BITS
167 DBRO=6507 /READ OUTPUT REGISTER
168
169 /COMBINED OPERATES
170 MTH=CLA CMA CLL RTL; MTW=CLA CMA CLL RAL
171 TWO=CLA CLL CML RTL; TWOK=CLA CLL CML RTR
172 BSW=7002
173
174 /EXTENDED MEMORY
175 CDF=6201; RDF=6214; RMF=6244
176
177 \f
178
179 /PAGE ZERO
180 /CONSTANTS
181
182 *112
183
184 K0004, 0004
185 K0003, 0003
186 K0002, 0002
187 KM0001, -1
188 K0007, 7
189 KM0027, -27
190 K0377, 377
191 KM0004, -4
192 K0005A, 0005
193 K0200, 200
194 KM1000, -1000
195 KM1777, -1777
196 K6777, 6777
197 KC7600, 7600
198
199 /LINKAGES
200
201 *132
202
203 6341 /BRAN
204 6302 /SHFT
205 6362 /DADD
206 KSTART, START
207
208 /SUBROUTINE TO READ VALUE OF A KNOB
209
210 *20
211 START0, CDF 10
212 TAD I KC7600 /RESTORE BLOCK ADD. FOR CHAIN IN LOC 7.
213 /SAVED BY SEC 3.
214 CDF 0
215 DCA 7
216 JMP I KSTART
217
218
219 KNOBS, 0
220 ADLM /LOAD MUX
221 ADST /START CONVERSION
222 ADSK /WAIT
223 JMP .-1
224 ADRB /READ RANGE: 777,-1000
225 TAD K6777 /RANGE -3777, -1
226 JMP I KNOBS
227
228 /SUBROUTINE TO LOAD Y DAC AND DISPLAY
229
230 DOY, 0
231 DILY /LOAD Y
232 DISD /WAIT FOR SETTLE
233 JMP .-1
234 DIXY /DISPLAY
235 JMP I DOY
236
237 / LINKS TO PLOTTER SUBROUTINE IN FIELD 3
238 HPLON, H3PLON
239 HPLOF, H3PLOF
240 HPENU, H3PENU
241 HPEND, H3PEND
242 HPLOT, H3PLOT
243 HPLGR, H3PLGR
244 \f
245 *6400
246 /THIS SECTION DISPLAYS, SCALES, AND OUTPUTS M, C, 1000T
247
248 /MAIN DISPLAY AND INITIATION FOR SECTION 5
249 START, TAD I K0200 /SET JOBLIST POINTER TO FIRST JOB
250 IAC
251 DCA JPNTR /JOB LIST POINTER
252 JPNTR=10
253 DCA SFACTR /PRESET SCALE FACTOR
254 SFACTR=TEMP32
255 TAD KPLOT /AUTO RESET AT 1 MS A TICK
256 CLOE
257 CMA
258 CLZE
259
260 DISJOB, CLA CMA
261 DCA PMODE /PMODE .NE. 0 FOR NO PLOT
262 PMODE=TEMP31
263 JMS I JSETX /SETUP DATA POINTERS, COUNTERS, DISPLAY
264 TAD TJTYPE /GET #LOC TO SKIP OVER WHEN DISPLAYING MEAN
265 BRAN
266 K0003
267 IAC /SD. AND TREND, SKIP 3
268 TAD K0002 /S.D., SKIP 2
269 DCA TSKIP
270 TSKIP=TEMP15
271 KSF /KBD STRUCK?
272 JMP DISAVG /NO, GO DISPLAY
273 KRB /YES, GET CHARACTER
274 BRAN /CHECK AGAINST RESPONSE LIST
275 KBDLST
276 MTW /X - EXPAND, SCALE UP
277 JMP NEWSF /C - CONTRACT, SCALE DOWN
278 JMP I PGRDAX /P - FIRST GRID, THAN DATA
279 JMP I PDAX /D - DATA ONLY
280 JMP I TDATAX /T - TYPE DATA
281 JMP I PGRX /G - GRID
282 JMP NXTJOB /CR - DISPLAY NEXT JOB
283 JMP I IDATAX /I - INTEGRATE
284 JMP I OVRLAX /^W - WRITE DATA.
285 JMP I OS8 /^C - RETURN TO OS8.
286 JMP START /^Z - FIRST JOB
287 KECHO, TAD TEMP02 /ECHO
288 JMS I TYPEX
289
290 DISAVG, JMS GDATAS /GET M (2 WDS) AND SCALE
291 JMS I DISPX /DISPLAY M/2^K
292 JMS I BLKCNX /MOVE TO NEXT, CHECK FOR END
293 JMP DISAVG /NOT ENDED, DISPLAY NEXT POINT
294 CLA CMA /ENDED, IS JOB TYPE=1?
295 TAD TJTYPE /(1 FOR MEAN ONLY)
296 SNA CLA
297 JMP DISEND /YES, DISPLAY OF JOBS IS DONE
298 JMS I JSETX /NO, SETUP TO DISPLAY MEAN + CF'S
299 \f
300 DISPSD, JMS GDATAS /GET M AND SCALE
301 DCA TMEAN /SAVE M/(2^K)
302 TMEAN=TEMP02
303 JMS GDATAS /GET 2S/SQRT(N) AND SCALE
304 TAD TMEAN /[M+2S/SQRT(N)]/2^K
305 JMS I DISPX /DISPLAY IT
306 MTW /SKIP OVER TREND IF PRESENT
307 JMS I BLKCNX /MOVE TO NEXT DATA POINT, CHECK FOR END
308 JMP DISPSD /NOT ENDED, DISPLAY NEXT POINT
309 JMS I JSETX /ENDED, SETUP FOR DISPLAY OF MEAN - CF
310 DISMSD, JMS GDATAS /GET NM AND SCALE
311 DCA TMEAN /SAVE M/2^K
312 JMS GDATAS /GET 2S/SQRT(N) AND SCALE
313 CMA IAC
314 TAD TMEAN /[M-2S/SQRT(N)]/2^K
315 JMS I DISPX /DISPLAY IT
316 MTW /SKIP OVER TREND IF PRESENT
317 JMS I BLKCNX /ANY MORE POINTS?
318 JMP DISMSD /MORE POINTS TO DISPLAY, CONTINUE
319 MTW /IS JOB TYPE=3?
320 TAD TJTYPE /(3 FOR AVG, CF, AND TREND)
321 SNA CLA
322 JMP DISEND /NO, DISPLAY OF THIS JOB IS DONE
323 JMS I JSETX /YES, SETUP TO DISPLAY 1000T
324 DCA TSKIP /SKIP NO POINTS AFTER TREND
325 DISTRN, TAD K0004 /SKIP MEAN AND CF
326 TAD GETPNT
327 DCA GETPNT
328 JMS I GCDFSX /GET 1000T
329 CDF 0 /(*)
330 CLL RTR
331 RTR
332 AND K0377
333 TAD KM0775
334 JMS I DISPX /DISPLAY RANGES FROM -377+0 TO -377+177
335 JMS I BLKCNX /MOVE TO NEXT DATA PNT, CHECK FOR DONE
336 JMP DISTRN /NOT DONE. DO NEXT POINT
337
338 DISEND, TAD PMODE /NO MORE POINTS IN THIS JOB
339 SZA CLA /ARE WE PLOTTING?
340 JMP DISJOB /NO, RESTART JOB
341 CIF 30 / PLOT DONE
342 JMS I HPLOF
343 JMP DISJOB /RESUME DISPLAY MODE
344
345 \f/SUBROUTINE TO GET DBL DATA WORD AND SCALE
346 /RESULT IN ARITH2 AND AC
347 GDATAS, 0
348 JMS I GCDFSX /GET CDF AND 1ST WORD
349 DCA ARITH1 /SAVE IN HI FAC (*)
350 TAD I GETPNT /GET LO ORDER PART (*)
351 DCA ARITH2 /(*)
352 CDF 0 /BACK TO FIELD 0 (*)
353 TAD SFACTR /SCALE
354 SHFT
355 TAD ARITH1
356 JMP I GDATAS
357
358 /NEW SCALE FACTOR
359 NEWSF, CMA /AC=-1 FOR C, +1 FOR X
360 TAD SFACTR
361 DCA SFACTR
362 JMP KECHO
363
364 /LOCAL CONSTANTS
365 K4077, 4077
366 KM0775, -775
367 KPLOT, 5400
368
369 /LOCAL CROSSPAGE
370 JSETX, JSETS
371 TYPEX, TYPES
372 GCDFSX, GCDFS
373 BLKCNX, BLKCNS
374 PGRDAX, PGRDA
375 PDAX, PDA
376 PGRX, PGR
377 TDATAX, TDATA
378 DISPX, DISPS
379 TMESSX, TMESS
380 IDATAX, IDATA
381 OVRLAX, OVRLAY
382 OS8, 7600
383 \f*6600
384 /SAVE SCALE AND GO TO NEXT JOB
385 NXTJOB, TAD JPNTR /MASK SCALE FACTOR INTO J1 BITS 8-11
386 DCA PJPNT /ADDRESS OF J1 FOR CURRENT JOB
387 PJPNT=TEMP01
388 TAD I PJPNT /J1: A/B(1), SF(5), 1(1), CHORD(5)
389 AND K4077 /MASK OUT OLD SF
390 DCA I PJPNT /J1: A/B(1), 0(5), 1(1), CHORD(5)
391 TAD SFACTR
392 SPA /SCALE FACTOR LESS THAN 0 ILLEGAL
393 CLA
394 BSW
395 AND K3700
396 TAD I PJPNT /J1: A/B(1),0(5), 1(1), CHORD(5)
397 DCA I PJPNT /J1: A/B(1), SF#(5), 1(1), CHORD(5)
398 TAD K0006 /MOVE TO NEXT JOB
399 TAD JPNTR
400 DCA JPNTR
401 JMS CRLFS /TYPE <CRLF>
402 TAD I JPNTR
403 SZA CLA
404 JMP I DISJOX /DISPLAY NEXT JOB
405 JMP I .+1 /NO MORE JOBS, DISPLAY FIRST AGAIN
406 START
407
408 /LOCAL CONSTANT
409 K0006, 6
410 K0212, 0212
411 K3700, 3700
412
413 /LOCAL CROSSPAGE
414 DISJOX, DISJOB
415 TMESSY, TMESS
416 GCDFY, GCDF
417 DISPY, DISPS
418 \f/SUBROUTINE TO SET UP DATA POINTERS, COUNTERS, AND DISPLAY
419 JSETS, 0
420 TAD I JPNTR /GET J2 TYPE (4), SORT CODE (8)
421 RTL /PUT TYPE IN AC8-11
422 RTL
423 RAL
424 AND K0017 /MASK OUT REST OF J2
425 DCA TJTYPE /TYPE CODE
426 TJTYPE=TEMP30
427 TAD I JPNTR /J3: LINK 1 (- COUNT OF FIRST BLOCK)
428 DCA BLCNTR
429 BLCNTR=TEMP25
430 TAD I JPNTR /J4: LINK 2 (DATA FIELD FOR FIRST BLOCK)
431 DCA I GCDFY
432 TAD I JPNTR /J5: LINK 3 (START OF FIRST BLOCK-1)
433 IAC
434 DCA GETPNT
435 GETPNT=12
436 TAD I JPNTR /J6: DELTAX (8), YSCALE (4)
437 DCA ARITH2 /PREPARE TO SHIFT TO SETUP BINARY POINT OF DX
438 DCA ARITH1
439 TAD K0005A /DELTAX (8): INTEGER PART (5), FRACTION (3)
440 SHFT
441 TAD ARITH1
442 DCA DELTAX
443 DELTAX=TEMP21
444 TAD ARITH2
445 DCA DELTAX+1
446 TAD KM0005 /MOVE JOB POINTER BACK TO TOP OF JOB
447 TAD JPNTR
448 DCA JPNTR
449 TAD PMODE /PLOT MODE?
450 SZA CLA
451 JMP CHAS
452 CIF 30
453 JMS I HPENU / P E N U P
454 CHAS, TAD KM1000
455 DILX /SET DISPLAY X TO LEFT EDGE
456 DCA ARITH4
457 \f JMS KNOBS /GET CURRENT CURSOR SETTING FROM KNOBS 0 AND 1
458 DCA CURSE1
459 CURSE1=TEMP20
460 CLA IAC
461 JMS KNOBS
462 DCA CURSE2
463 CURSE2=TEMP17
464 JMP I JSETS
465
466 /LOCAL CONSTANTS
467 K0017, +17
468 GDATAX, GDATAS
469 K0034, +34
470 K0062, 62
471 K0215, 215
472 KM0005, -05
473 KM0012, -12
474
475 PGR, CLA / PLOT GRID
476 CIF 30
477 JMS I HPLON
478 CIF 30
479 JMS I HPLGR
480 CLA
481 JMP DISJOB
482
483 PGRDA, CLA / PLOT GRID AND DATA
484 CIF 30
485 JMS I HPLON
486 CIF 30
487 JMS I HPLGR
488 CLA
489 JMP DISJOB+1
490
491 PDA, CLA / PLOT DATA
492 CIF 30
493 JMS I HPLON
494 CLA
495 JMP DISJOB+1
496 \f/SUBROUTINE TO TYPE ASCII IN AC
497 TYPES, 0
498 TLS
499 TSF
500 JMP .-1
501 TCF
502 CLA
503 JMP I TYPES
504
505 /SUBROUTINE TO TYPE <CRLF>
506 CRLFS, 0
507 TAD K0215
508 JMS TYPES
509 TAD K0212
510 JMS TYPES
511 JMP I CRLFS
512
513 \f *7000
514 /SUBROUTINE TO DISPLAY POINT: SCALE, BIAS, INCREMENT X
515 DISPS, 0
516 DCA YSAVE
517 YSAVE=TEMP14
518 TAD ARITH4 /X FOR NEXT POINT
519 DILX
520 CLA
521 TAD YSAVE /GET POINT
522 JMS DOY /DISPLAY IT
523 CLA
524 TAD PMODE /RUNNING PLOTTER?
525 SZA CLA
526 JMP DXINC /NO, INCREMENT X AND CONTINUE
527 CIF 30
528 JMS I HPLOT / PLOT DATA (ARITH4,YSAVE)
529
530 DXINC, TAD DELTAX /SETUP X FOR NEXT POINT
531 DCA ARITH1
532 TAD DELTAX+1
533 DCA ARITH2
534 DADD /INCREMENT BY DISTANCE BETWEEN POINTS
535 JMS CURSES /CURSOR REACHED?
536 SKP /YES
537 JMP I DISPS /NO
538 TAD KM0027
539 DCA CRCNTR
540 CRCNTR=TEMP01 /INTENSIFY CURSOR
541 DIXY
542 ISZ CRCNTR /POSITION
543 JMP .-2
544 JMP I DISPS
545 \f/LOCAL CROSSPAGE
546 TMESSZ, TMESS
547
548 /LOCAL CONSTANTS
549 K0777, 777
550 K1000, 1000
551 K0022, +022
552
553 /SUBROUTINE TO MOVE TOWARD CURSOR
554 CURSES, 0
555 ISZ CURSE1
556 SKP /NOT AT CURSOR1
557 JMP I CURSES /EXIT, AT CURSOR1
558 ISZ CURSE2
559 ISZ CURSES /NOT AT CURSOR, EXIT TO CALL+2
560 JMP I CURSES /IF AT CURSOR2, EXIT TO CALL+1
561
562 /SUBROUTINE TO CHECK BLOCK AND LINK TO NEXT IF REQUIRED
563 /EXIT TO CALL +2 IF END OF FILE REACHED
564 BLKCNS, 0
565 TAD TSKIP /MOVE GETPNT TO NEXT DATA POINT
566 TAD GETPNT
567 DCA GETPNT
568 ISZ BLCNTR /BLOCK COMPLETE?
569 JMP I BLKCNS /NO, CONTINUE
570 JMS GCDFS /YES, END OF FILE?
571 SNA /L1: -COUNT FOR NEXT BLOCK (*)
572 ISZ BLKCNS /END OF FILE EXIT TO CALL+2(*)
573 DCA BLCNTR /RESET COUNTER(*)
574 TAD I GETPNT /L2: CDF N (*)
575 DCA GCDF /RESET DATA FIELD (*)
576 TAD I GETPNT /L3: START OF NEW BLOCK-1(*)
577 DCA GETPNT /RESET DATA POINTER(*)
578 CDF 0 /(*)
579 JMP I BLKCNS
580
581 /SUBROUTINE TO SET DATA FIELD AND GET 1 WORD
582 GCDFS, 0
583 GCDF, CDF /CURRENT DATA FELD
584 TAD I GETPNT /GET DATA (*)
585 JMP I GCDFS /(*)
586 \f/KEYBOARD LIST
587 KBDCHK, +221 /CTRL/Q
588 -215 /CR
589
590 *7200
591 /TYPE DATA IN JOB
592 TDATA, JMS PRETYP
593 DCA TSKIP /SKIP NOTHING
594 TYPLUP, TAD TJTYPE /JOB TYPE: 1, 2, OR 3
595 CMA IAC
596 DCA TYPCNT
597 TYPCNT=TEMP02
598 JMS I CRLFX /NEW LINE
599 TAD CHANNL /TYPE DATA POINT #
600 JMS NUMTYP
601 JMS SHFTYP /TYPE SCALED MEAN IN MV
602 ISZ TYPCNT /CF COMPUTED?
603 SKP /YES
604 JMP TYPEND /NO
605 JMS SHFTYP /TYPE SCALED CF IN MV
606 ISZ TYPCNT /TREND COMPUTED?
607 JMS ABSTYP /TYPE 1000T
608 TYPEND, JMS I CURSEY /REACHED SECOND CURSOR?
609 JMP TYPDUN /YES
610 ISZ CHANNL /NO
611 JMS I BLKCNY /CHECK FOR END OF JOB
612 JMP TYPLUP /NOT ENDED, CONTINUE
613 TYPDUN, CLA CLL CMA
614 TAD SFACTR
615 DCA SFACTR
616 JMS I CRLFX /NEW LINE
617 JMP I DISJOY /DONE. RETURN TO DISPLAY
618
619 /LOCAL CONSTANTS
620 K0254, 254 /ASCII COMMA
621 K0257, 257
622 KMD1K, -1750 /-1000(10)
623 KMCTRL, -221
624 KMD100, -144 /-100(10)
625 KMD010, -12 /-10(10)
626
627 /LOCAL CROSSPAGE
628 CRLFX, CRLFS
629 TYPEY, TYPES
630 BLKCNY, BLKCNS
631 DISJOY, DISJOB
632 GDATAY, GDATAS
633 GCDFSY, GCDFS
634 CURSEY, CURSES
635 SGNTYX, SGNTYP
636 \f/GET DOUBLEWORD DATA POINT, SCALE BY 4, SIGN EXTEND, TYPE SIGNED
637 SHFTYP, 0
638 JMS I GDATAY /GET DOUBLEWORD AND SCALE BY SF
639 JMS I SGNTYX /TYPE SIGNED VALUE IN AC
640 JMP I SHFTYP
641
642 /TYPE ABSOLUTE VALUE SINGLE WORD IN DATA BLOCK
643 ABSTYP, 0
644 JMS I GCDFSY /GET DATA WORD (*)
645 CDF 0 /(*)
646 JMS NUMTYP /TYPE DECIMAL VALUE IN AC
647 JMP I ABSTYP
648
649 /TYPE DECIMAL VALUE IN AC
650 NUMTYP, 0
651 DCA ARITH4 /# TO RADIX DEFLATE
652 TAD KMD1K /REDUCE BY FACTORS OF 1000(10)
653 JMS GDIGIT /TYPE DIGIT FOR 1000'S
654 TAD KMD100 /REDUCE BY FACTORS OF 100(10)
655 JMS GDIGIT /TYPE DIGIT FOR 100'S
656 TAD KMD010 /REDUCE BY FACTORS OF 10'S
657 JMS GDIGIT /TYPE DIGIT FOR 10'S
658 CLA CMA /REDUCE BY FACTORS OF 1
659 JMS GDIGIT /TYPE DIGIT FOR 1'S
660 TAD K0254
661 JMS I TYPEY /TYPE 1 COMMA
662 JMP I NUMTYP
663
664 /SUBROUTINE SETS UP FOR TYPING
665 PRETYP, 0
666 JMS I CRLFX /<CRLF>
667 CLA CMA /MOVE POINTER BACK TO SWEEP COUNT
668 TAD GETPNT
669 DCA GETPNT
670 JMS ABSTYP /# OF SWEEPS IN AVERAGE
671 TAD SFACTR /SCALE FACTOR
672 JMS I SGNTYX
673 CLA CLL IAC /TYPEOUT IS IN MV (2MV/COUNT)
674 TAD SFACTR
675 DCA SFACTR
676 DCA CHANNL /DATA POINT # INIT TO 0
677 CHANNL=TEMP16
678 PRESKP, JMS I CURSEY /LOOK FOR FIRST CURSOR
679 JMP I PRETYP /FOUND IT, EXIT
680 ISZ CHANNL /NO CURSOR YET, INDEX POINT #
681 TWO
682 JMS I BLKCNY /STEP THRU DATA POINT
683 JMP PRESKP /MORE DATA POINTS, CONTINUE
684 JMP TYPDUN /END OF DATA POINTS AND NO CURSOR, GO BACK TO DISPLAY.
685
686 \f/SUBROUTINE TO PRINT MESSAGE AND WAIT FOR CR
687 TMESS, 0
688 TAD I TMESS /ADDR OF MESS-1 AT CALL+1
689 DCA TYPNTR
690 TYPNTR=13
691 ISZ TMESS /EXIT TO CALL+2
692 TAD I TYPNTR /GET NEXT CHARACTER
693 SNA /0 INDICATES END OF MESS.
694 JMP TWAIT /END
695 JMS I TYPEY /TYPE CHARACTER
696 JMP .-4 /CONTINUE
697
698 TWAIT, KSF /END, WAIT FOR CR
699 JMP .-1
700 KRB
701 BRAN
702 KBDCHK
703 JMP I DISJOY /^Q TYPED, RESTART DISPLAY
704 JMS I CRLFX /C.R. TYPED, ECHO IT
705 JMP I TMESS /OTHER OR CR, RESUME
706
707 /FINDS DIGIT AND TYPES IT
708 GDIGIT, 0
709 DCA ARITH1 /FACTOR TO DEFLATE BY
710 DCA NDIGIT /DIGIT=0
711 NDIGIT=TEMP01
712 TAD ARITH4
713 GLOOP, DCA ARITH4 /SAVE NEW REDUCED ARGUMENT
714 TAD ARITH4 /AND PREPARE TO REDUCE AGAIN
715 CLL
716 TAD ARITH1 /TRIAL SUBTRACTION
717 ISZ NDIGIT /INDEX DIGIT
718 SZL
719 JMP GLOOP /SUBTRACT SOME MORE
720 CLA /THAT'S ALL FOR THIS DIGIT
721 TAD K0257 /DIGIT IS NDIGIT-1
722 TAD NDIGIT /TYPE ASCII
723 JMS I TYPEY
724 KSF /CHECK FOR CTRL Q
725 JMP I GDIGIT /NO KEY, EXIT
726 KRB /KEY, BUT IS IT CTRL Q?
727 TAD KMCTRL
728 SZA CLA
729 JMP I GDIGIT /NO, EXIT
730 JMP TYPDUN /YES RESUME DISPLAY
731
732
733 ZBLOCK 5
734 \f/INTEGRATE DATA BETWEEN CURSORS
735 IDATA, JMS PRETYP /INITIALIZE TYPEOUT
736 TAD CHANNL /LO LIMIT OF INTEGRATION
737 JMS NUMTYP
738 DCA AVGSUM /CLEAR PARTIAL SUMS
739 AVGSUM=TEMP21
740 DCA CFLSUM
741 CFLSUM=TEMP22
742 DCA AVGFLG /CLEAR OFLO FLAGS
743 AVGFLG=TEMP14
744 DCA CFLFLG
745 CFLFLG=TEMP13
746 ILOOP, TAD AVGSUM /PREPARE TO UPDATE SUMS
747 JMS UPSUM
748 ISZ AVGFLG /OVERFLOW RETURN, SET FLAG
749 DCA AVGSUM
750 CLA CMA /CF'S COMPUTED?
751 TAD TJTYPE
752 SNA CLA
753 JMP IDONE /NO, CONTINUE
754 TAD CFLSUM /YES UPDATE THAT SUM
755 JMS UPSUM
756 ISZ CFLFLG /OVERFLOW RETURN, SET FLAG
757 DCA CFLSUM
758 MTW /ALREADY PAST CF'S.
759 IDONE, ISZ CHANNL /UPDATE DATA POINT #
760 JMS I BLKCNZ /MOVE TO NEXT DATA POINT
761 JMS I CURSEZ /REACHED SECOND CURSOR?
762 SKP /AT SECOND CURSOR OR OUT OF DATA
763 JMP ILOOP /CONTINUE
764 CLA CMA /GET # OF LAST DATA POINT
765 TAD CHANNL
766 JMS I NUMTYX
767 TAD AVGSUM /TYPE SUM
768 JMS SGNTYP
769 TAD AVGFLG /TYPE OVERFLOW MARK
770 JMS OMARK
771 CLA CMA /CFLSUM CALCULATED?
772 TAD TJTYPE
773 SNA CLA
774 JMP .+5 /NO, EXIT
775 TAD CFLSUM /YES, OUTPUT INTEGRAL OF CFL'S.
776 JMS I NUMTYX
777 TAD CFLFLG /OVERFLOW MARK IF REQ.
778 JMS OMARK
779 JMP I .+1 /TYPE SOME CRLF, RESTORE SCALE FACTOR
780 TYPDUN /AND RESUME DISPLAY
781 \f/SUBROUTINE TO TYPE SIGNED # IN AC
782 SGNTYP, 0
783 DCA ARITH4
784 TAD ARITH4
785 SPA CLA /TYPE CORRECT SIGN: " " OR "-"
786 TAD K0015 /MAKE A "-"
787 TAD K240
788 JMS I TYPEZ
789 TAD ARITH4
790 SPA
791 CMA IAC /GET ABS VALUE
792 JMS I NUMTYX /AND TYPE IT
793 JMP I SGNTYP
794
795 /LOCAL CROSSPAGE
796 NUMTYX, NUMTYP
797 BLKCNZ, BLKCNS
798 CURSEZ, CURSES
799 TYPEZ, TYPES
800 GDATAZ, GDATAS
801
802 /SUBROUTINE TO GET SUM OF AC AND NEXT DATA POINT
803 UPSUM, 0
804 DCA INADD /SAVE ADDEND
805 INADD=TEMP02
806 JMS I GDATAZ /GET AUGEND
807 SPA /SET LINK BIT EQUAL TO SIGN BIT
808 CML
809 TAD INADD /ADD ADDEND
810 DCA INSUM
811 INSUM=TEMP03
812 TAD INADD /MODIFY LINK BIT IN ACCORD WITH SIGN
813 SPA CLA
814 CML
815 TAD INSUM /WE HAVE FAKED A 13 BIT ADD
816 SPA SZL /ARE THE LINK AND SIGN BITS EQUAL?
817 CML CMA /1,1 TO 0,0; 0,1 TO 1,0; 1,0 TO 0,1
818 SMA SNL CLA /0,1 AND 1,0 ARE OVERFLOW
819 ISZ UPSUM /L,S WERE 0,0 OR 1,1; NO OVERFLOW
820 TAD INSUM /GET THE RESULT AND EXIT
821 JMP I UPSUM /TO CALL+1 (OVRFLO) OR CALL+2 (NORMAL)
822
823 /SUBROUTINE TO TYPE "^" IF OVERFLOW (AC#0)
824 OMARK, 0
825 SNA CLA /AC=0?
826 JMP I OMARK /YES, EXIT
827 TAD K0336 /NO, TYPE "^"
828 JMS I TYPEZ
829 JMP I OMARK
830
831 /LOCAL CONSTANTS
832 K0336, 336 /^
833 K0015, 015
834 K240, 240
835 \f/KBD RESPONSE LIST
836 KBDLST, +330 /X
837 +303 /C
838 +320 /P
839 +304 /D
840 +324 /T
841 +307 /G
842 +215 /CR
843 +311 /I
844 227 /^W
845 203 /^C
846 -232 /^Z
847 KC7746, 7746
848
849 \f/ AAVG4 PLOTTER SUBROUTINES
850 /
851 / REV0.0 25-JAN-85 KJ.S.
852 /
853
854 FIELD 3
855 *200
856
857 H3PLOT, 0 / MOVE PEN; 'PA' COMMAND IS INITIATED
858 CLA / BY H3PENX
859 CDF 0
860 TAD I (ARITH4 / GET X POSITION
861 DCA XPOS
862 TAD I (YSAVE / GET Y POSITION
863 DCA YPOS
864 CDF 30
865
866 TAD PLPAFL
867 SNA CLA / FIRST 'PA'-COMMAND ?
868 JMP H3PLT1 / NO:
869 TAD (HTPLPA / YES: OUTPUT 'PA'
870 JMS TTO
871
872 H3PLT1, TAD XPOS
873 TAD (1000 / MAKE STRAIGHT BINARY
874 AND (1777
875 JMS TDO
876 0
877 TAD (",
878 JMS TCO
879
880 TAD YPOS
881 TAD (1000
882 AND (1777
883 JMS TDO
884 0
885 TAD (",
886 JMS TCO
887
888 TAD PLPAFL
889 SNA CLA / FIRST PA COMMAND ?
890 JMP .+3 / NO: EXIT
891 TAD (HTPLRD
892 JMS TTO
893 DCA PLPAFL
894 CIF CDF 0
895 JMP I H3PLOT
896
897 XPOS, 0
898 YPOS, 0
899
900 PLPAFL, 1
901 HTPLPA, TEXT /SP1;PA/;0
902 HTPLRD, TEXT /;PD;PA/;0
903
904 H3PENU, 0 / PEN UP
905 CDF 30
906 CLA
907 TAD (HTPENU
908 JMS TTO
909 ISZ PLPAFL / SET FLAG
910 TAD H3PENU
911 JMP EXIT+1
912
913 /1. TERMINATES A PROCEEDING 'PA'-COMMAND
914 /2. SETS PEN UP
915 /3. ERROR STATUS
916 HTPENU, TEXT /;PU;OE;/;0
917
918 H3PEND, 0
919 CDF 30
920 TAD (HTPEND
921 JMS TTO
922 ISZ PLPAFL
923 TAD H3PEND
924 JMP EXIT+1
925
926 /1. TERMINATES A PROCEEDING 'PA'-COMMAND
927 /2. SETS PEN UP
928 /3. ERROR STATUS
929 HTPEND, TEXT /;PD;OE;/;0
930
931 H3PLOF, 0
932 CDF 30
933 CLA
934 TAD (HTPLOF
935 JMS TTO
936 TAD H3PLOF
937 JMP EXIT+1
938
939 /1. TERMINATES A PROCEEDING 'PA'-COMMAND
940 /2. SETS PEN UP
941 /3. POSITIONS PEN TO UPPER LEFT CORNER
942 /4. REMOVES PEN
943 /5. ERROR STATUS
944 HTPLOF, TEXT /;PU;PA0,1150;SP0;OE;/;0
945
946 EXIT, 0
947 DCA EXIT
948 JMS TRI / READ ERROR STATUS
949 TAD (-260
950 SNA / ERROR NUMBER = 0 ?
951 JMP EXITA / YES:
952 TAD (260 / NO:
953 TLS / TYPE NUMBER
954 CLA
955 CIF CDF 0
956 JMP I (DISJOB / CONTINUE DISPLAY
957
958 EXITA, CIF CDF 0
959 JMP I EXIT
960
961 PAGE
962 \fH3PLON, 0 / INIT PLOTTER
963 CDF 30
964 CLA CLL
965 TAD (330 / SET INPUT DEV FOR ERROR CODE
966 JMS TIDC
967 TAD (340 / AND OUTPUT DEV TO 33/34
968 JMS TODC
969
970 CLA
971 TAD (HTPLON
972 JMS TTO / OUTPUT ASCII STRING
973
974 TAD H3PLON
975 JMP EXIT+1
976
977 /1. INITIALIZATION FOR DIN A4 SIZE
978 /2. PLOT HEADER
979 HTPLON, TEXT /$[$.N;19:$[$.H32;;17:IN;PS4;RO90;IP975,3800,7300,9800;/
980 TEXT /IW;SC0,1023,0,1023;SP0;OE;/;0
981
982 H3PLGR, 0 / PLOT GRID
983 CDF 30
984 CLA
985 TAD (HTPLGR
986 JMS TTO
987 TAD H3PLGR
988 JMP EXIT+1
989
990 PAGE
991 \f
992 /1. PLOT GRID WITH DIFFERENT PEN SIZES
993 HTPLGR, TEXT /$$SP1;PA0,0;PD;PA0,256,-15,256,0,256,/
994 TEXT /0,512,-15,512,0,512,0,768,-15,768,0,768,0,1023,/
995 TEXT /1023,1023,1023,-15,1023,0,819,0,819,-15,819,0,/
996 TEXT /614,0,614,-15,614,0,410,0,410,-15,410,0,/
997 TEXT /205,0,205,-15,205,0,0,0,0,-15,0,0;PU;/
998 TEXT /SR1.5,2.2;PA-8,-55;LB0$C$PA176,-55;LB100$C$/
999 TEXT /PA381,-55;LB200$C$PA585,-55;LB300$C$/
1000 TEXT /PA790,-55;LB400$C$PA994,-55;LB500$C$/
1001 TEXT /SR1.8,2.6;PA650,-120;LBZEIT [%MS%]$C$/
1002 TEXT /SR1.5,2.2;PA-68,245;LB-1$C$PA-68,501;LB 0$C$/
1003 TEXT /PA-68,757;LB 1$C$/
1004 TEXT /SP2;PA0,96;PD;PA1023,96;/
1005 TEXT /PU;PA1023,128;PD;PA0,128;PU;PA0,160;PD;PA1023,160;/
1006 TEXT /PU;PA1023,512;PD;PA0,512;PU;SP0;OE;/
1007 0
1008
1009 PAGE
1010
1011 XLIST
1012 \f/ TRI.PA
1013 /
1014 / TTY READ INPUT
1015 /
1016 / READS CHARACTER FROM TTY
1017 /
1018 / ENTRY: AC = NO CARE
1019 / EXIT: AC = CHARACTER
1020 /
1021 / SUBRS: NONE
1022 /
1023 / 02-MAY-84 REV 0.0 KJ.S.
1024 / 18-OCT-84 REV 0.1 KJ.S. HARDWARE INDEPENDENT
1025 /
1026
1027 TRI, 0
1028 CLA
1029 TIKSF, KSF
1030 JMP .-1
1031 TIKRB, KRB
1032 AND (177
1033 TAD (200
1034 JMP I TRI
1035 \f/ TIDC.PA
1036 /
1037 / CHANGE SERIAL INPUT DEVICE CODE
1038 /
1039 / ENTRY: AC = XNNX NN = DEV.CODE
1040 / EXIT: AC = 0
1041 /
1042 / SUBR: LOCATINONS IN TRI ARE CHANGED
1043 /
1044 / 18-OCT-84 REV 0.0 KJ.S.
1045 /
1046
1047 TIDC, 0
1048 AND (770
1049 DCA TIDCSV
1050 TAD (6001
1051 TAD TIDCSV
1052 DCA TIKSF
1053 TAD (6006
1054 TAD TIDCSV
1055 DCA TIKRB
1056 JMP I TIDC
1057
1058 TIDCSV, 0
1059
1060 PAGE
1061 \f/ TTI.PA
1062 /
1063 / TELETYPE TEXT INPUT
1064 /
1065 / READS INPUT FROM TTY AND STORES 2 CHARACTERS/WORD
1066 / INTO TEXT BUFFER. ACCEPTS ONLY PRINTABLE CHARACTERS.
1067 / ALL OTHER INPUT AND CHARACTERS AFTER BUFFER-OVERFLOW
1068 / IS ECHED AS 'BELL'. THE INPUT TERMINATOR IS NOT
1069 / ECHOED.
1070 /
1071 / ENTRY: AC = TERMINATOR, 0 = CR
1072 / ARG1 POINTER TO TEXT BUFFER
1073 / ARG2 LENGTH OF TEXT BUFFER (WORDS)
1074 / EXIT: AC = 0
1075 /
1076 / SUBR TRI,TCO
1077 /
1078 / 16-JUL-84 REV 0.0 KJ.S.
1079 / 22-JUL-84 REV 0.1 KJ.S. SOME BUGS REMOVED
1080 / 23-JUL-84 REV 0.2 KJ.S. BUG AFTER 'DEL' REM.
1081 /
1082
1083 TTI, 0
1084 SNA / AC = TERMINATOR
1085 TAD (215 / AC = 0 TERMINATOR = CR
1086 AND (377
1087 CIA
1088 DCA TTITM / SAVE
1089 TAD I TTI / GET ARG1 = BUFFER POINTER
1090 DCA TTIBPT
1091 ISZ TTI
1092 CLA CLL
1093 TAD I TTI / GET ARG2 = BUFFER LENGTH
1094 RAL
1095 CIA
1096 IAC
1097 DCA TTIBLN / = - BUFFER LENGTH * 2 + 1
1098 ISZ TTI
1099 DCA TTICNT / CLEAR CHARACTER COUNTER
1100 DCA TTIXF / CLEAR EXIT FLAG
1101
1102 TTI1, JMS TRI / READ INPUT
1103 DCA TTICH
1104
1105 TAD TTICH
1106 TAD TTITM
1107 SZA CLA / TERMINATOR ?
1108 JMP TTI2 / NO:
1109 ISZ TTIXF / YES: SET EXIT FLAG
1110 DCA TTICH / PUT 'ZERO' INTO BUFFER
1111 JMP TTI3
1112
1113 TTI2, TAD TTICH / CHECK INPUT
1114 TAD (-240
1115 SPA / CHAR.GE.240 ?
1116 JMP TTI10 / NO: CONTROL CHAR
1117 TAD (-100
1118 SMA CLA / CHAR.LT.340 ?
1119 JMP TTI10 / N0: CONTROL CHAR
1120
1121 TAD TTICNT / CHECK FOR BUFFER OVERFLOW
1122 TAD TTIBLN
1123 SMA CLA / COUNTER.LT.BUFFER*2 ?
1124 JMP TTI10 / NO: BUFFER OVERFLOW
1125
1126 TAD TTICH / ECHO
1127 JMS TCO
1128 TAD TTICH / MAKE 6-BIT-ASCII
1129 AND (77
1130 DCA TTICH
1131
1132 TTI3, CLA CLL
1133 TAD TTICNT / CALCULATE BUFFER POINTER
1134 RAR
1135 TAD TTIBPT
1136 DCA TTIPNT
1137
1138 SZL / LINK=MSB OF TTICNT.EQ.0 ?
1139 JMP TTI4 / N0: 2. BYTE OF WORD
1140 TAD TTICH / YES: 1. BYTE
1141 BSW
1142 JMP TTI5
1143 TTI4, TAD I TTIPNT / ADD 1.BYTE
1144 AND (7700
1145 TAD TTICH
1146 TTI5, DCA I TTIPNT / STORE IN BUFFER
1147 ISZ TTICNT / INCREMENT COUNTER
1148
1149 TAD TTIXF
1150 SNA CLA / EXIT ?
1151 JMP TTI1 / NO: GET NEXT CHARACTER
1152 JMP I TTI / YES:
1153
1154 TTI10, CLA CLL / INPUT IS A CONTROL CHARACTER
1155 TAD TTICH
1156 TAD (-377
1157 SNA CLA / CHAR.EQ.DEL ?
1158 JMP TTI12 / YES:
1159 TTI11, TAD (207 / NO: ILLEGAL INPUT
1160 JMS TCO / ECHO BELL
1161 JMP TTI1 / CONTINUE
1162
1163 TTI12, TAD TTICNT
1164 SNA / BUFFER EMPTY ?
1165 JMP TTI11 / YES:
1166 TAD (-1 / NO: DECREMENT
1167 DCA TTICNT
1168 TAD (210 / BACKSPACE
1169 JMS TCO
1170 TAD (240
1171 JMS TCO
1172 TAD (210
1173 JMS TCO
1174 JMP TTI1
1175
1176
1177 TTITM, 0 / MINUS INPUT TERMINATOR
1178 TTIBPT, 0 / BUFFER START POINTER
1179 TTIBLN, 0 / MINUS LENGTH OF BUFFER
1180 TTIPNT, 0 / CURRENT BUFFER POINTER
1181 TTICNT, 0 / CURRENT LENGTH COUNTER
1182 TTISWD, 0 / INPUT CONTROL FLAG
1183 TTICH, 0 / LAST INPUT CHAR
1184 TTIXF, 0 / EXIT FLAG
1185
1186 PAGE
1187 \f/ TDO.PA
1188 /
1189 / TYPES DECIMAL INTEGERS WITH DIFFERENT FORMATS
1190 /
1191 / ENTRY: AC = NUMBER TO BE TYPED
1192 / ARG1 BIT 0 IF SET, TYPE SIGNED OUTPUT
1193 / BIT 1 IF SET, FILL FORMAT WITH ZEROS
1194 / UNSIGNED OUTPUT ONLY, BIT 0 IGNORED
1195 / BIT 6-11 OUTPUT FIELD WIDTH. IF ZERO,
1196 / NO LEADING ZEROS OR SPACES
1197 / EXIT: AC = 0
1198 /
1199 / SUBR: TIO,TCO
1200 /
1201 /
1202 / 19-OCT-84 REV 0.0 KJ.S.
1203 /
1204
1205 TDO, 0
1206 DCA TION0 / SAVE NUMBER
1207 TAD I TDO
1208 ISZ TDO
1209 DCA TIOFL / SAVE FLAG
1210 TAD TDOTST / POINTER TO HEXADECIMAL TABLE
1211 JMS TDOHO / PROCEED
1212 JMP I TDO
1213
1214 TDOTST, .+1 / TABLE OF DECIMAL VALUES
1215 140 / -4000
1216 4060 / -2000
1217 6030 / -1000
1218 6340 / -800
1219 7160 / -400
1220 7470 / -200
1221 7634 / -100
1222 7660 / -80
1223 7730 / -40
1224 7754 / -20
1225 7766 / -10
1226 \f/ TOO.PA
1227 /
1228 / TYPES OCTAL INTEGERS WITH DIFFERENT FORMATS
1229 /
1230 / ENTRY: AC = NUMBER TO BE TYPED
1231 / ARG1 BIT 0 IF SET, TYPE SIGNED OUTPUT
1232 / BIT 1 IF SET, FILL FORMAT WITH ZEROS
1233 / UNSIGNED OUTPUT ONLY, BIT 0 IGNORED
1234 / BIT 6-11 OUTPUT FIELD WIDTH. IF ZERO,
1235 / NO LEADING ZEROS OR SPACES
1236 / EXIT: AC = 0
1237 /
1238 / SUBR: TIO,TCO
1239 /
1240 /
1241 / 18-OCT-84 REV 0.0 KJ.S.
1242 / 18-OCT-84 REV 0.1 KJ.S. SOME BUGS REMOVED
1243 / 19-OCT-84 REV 1.0 KJ.S. USING SUBR. TIO
1244 /
1245
1246 TOO, 0
1247 DCA TION0 / SAVE NUMBER
1248 TAD I TOO
1249 ISZ TOO
1250 DCA TIOFL / SAVE FLAG
1251 TAD TOOTST / POINTER TO OCTAL TABLE
1252 JMS TDOHO / PROCEED
1253 JMP I TOO
1254
1255 TOOTST, .+1 / TABLE OF OCTAL VALUES
1256 4000
1257 6000
1258 7000
1259 0000
1260 7400
1261 7600
1262 7700
1263 0000
1264 7740
1265 7760
1266 7770
1267 \f/ THO.PA
1268 /
1269 / TYPES HEXADECIMAL INTEGERS WITH DIFFERENT FORMATS
1270 /
1271 / ENTRY: AC = NUMBER TO BE TYPED
1272 / ARG1 BIT 0 IF SET, TYPE SIGNED OUTPUT
1273 / BIT 1 IF SET, FILL FORMAT WITH ZEROS
1274 / UNSIGNED OUTPUT ONLY, BIT 0 IGNORED
1275 / BIT 6-11 OUTPUT FIELD WIDTH. IF ZERO,
1276 / NO LEADING ZEROS OR SPACES
1277 / EXIT: AC = 0
1278 /
1279 / SUBR: TIO,TCO
1280 /
1281 /
1282 / 19-OCT-84 REV 0.0 KJ.S.
1283 /
1284
1285 THO, 0
1286 DCA TION0 / SAVE NUMBER
1287 TAD I THO
1288 ISZ THO
1289 DCA TIOFL / SAVE FLAG
1290 TAD THOTST / POINTER TO DECIMAL TABLE
1291 JMS TDOHO / PROCEED
1292 JMP I THO
1293
1294 THOTST, .+1 / TABLE OF HEXADECIMAL VALUES
1295 0000
1296 0000
1297 0000
1298 4000
1299 6000
1300 7000
1301 7400
1302 7600
1303 7700
1304 7740
1305 7760
1306 \f/ TCR CARRIAGE RETURN
1307 /
1308 / MOVES CURSOR TO THE BEGINNING OF THE
1309 / PRESENT LINE
1310 /
1311 / ENTRY: AC = NO CARE
1312 / EXIT: AC = 0
1313 /
1314 / 10-APR-84 REV 0.0 KJ.S.
1315 /
1316
1317 TCR, 0
1318 CLA
1319 TAD (215
1320 JMS TCO / OUTPUT
1321 CLA
1322 JMP I TCR
1323
1324 \f/ TNL NEW LINE
1325 /
1326 / POSITIONS CURSOR TO BEGINNING
1327 / OF NEXT LINE
1328 /
1329 / ENTRY: AC = NO CARE
1330 / EXIT: AC = 0
1331 /
1332 / 10-APR-84 REV 0.0 KJ.S.
1333 /
1334
1335 TNL, 0
1336 JMS TCR
1337 TAD (212
1338 JMS TCO / LF
1339 JMP I TNL
1340 \f
1341 TIOF, 0 / SUBROUTINE TO CHECK OUTPUT
1342 AND (17 / FORMAT AND TYPE
1343 DCA TIOPT / STORE
1344 ISZ TIOCT / INCREMENT DIGIT COUNTER
1345
1346 TAD TIOZF
1347 SZA CLA / ZERO FLAG = 0 ?
1348 JMP TIOF2 / NO: TYPE DIGIT
1349 TAD TIOPT / YES:
1350 SZA CLA / DIGIT = 0 ?
1351 JMP TIOF1 / NO:
1352 TAD TIOFL / YES:
1353 SNA CLA / FIELD WIDTH = 0 ?
1354 JMP I TIOF / YES: EXIT
1355 TAD TIOFL
1356 TAD TIOCT
1357 SPA CLA / FILL CHAR WITHIN FIELD ?
1358 JMP I TIOF / NO: EXIT
1359 TAD TIOFC / YES: TYPE FILL CHARACTER
1360 JMP TIOF4
1361
1362 TIOF1, TAD TIOFL
1363 SNA / FIELD WIDTH = 0 ?
1364 JMP TIOF2 / YES: NO FIXED FIELD WIDTH
1365 TAD TIOCT / NO:
1366 SPA CLA / DIGIT WITHIN FIELD ?
1367 JMP TIOER / NO: FIELD WIDTH TOO SMALL
1368 TIOF2, ISZ TIOZF / SET ZERO FLAG
1369 TAD TIOSG
1370 SNA CLA / SIGN NEEDED ?
1371 JMP TIOF3 / NO:
1372 DCA TIOSG / CLEAR SIGN FLAG
1373 TAD ("- / YES: TYPE IT
1374 JMS TCO
1375 TIOF3, TAD TIOPT / TYPE DIGIT
1376 TAD (-12
1377 SMA / HEX - CHAR. ?
1378 TAD (7 / YES: MAKE A LETTER
1379 TAD (272 / NO: MAKE NUMBER
1380 TIOF4, JMS TCO
1381 JMP I TIOF / EXIT
1382
1383 PAGE
1384 \f / SUBROUTINE FOR TDO,TOO,THO
1385 / TION0 AND TIOFL MUST BE SET
1386
1387 TDOHO, 0
1388 DCA TIOPT / AC = TABLE POINTER
1389 DCA TIOSG / CLEAR SIGN FLAG
1390 TAD (240
1391 DCA TIOFC / FILL CHAR = SPACE
1392 TAD TIOFL
1393 AND (2000
1394 SNA CLA / FILL CHAR = ZERO ?
1395 JMP TIOA / NO:
1396 TAD (260 / YES:
1397 DCA TIOFC
1398 JMP TIOB / NO SIGN OPTION
1399
1400 TIOA, TAD TIOFL
1401 SMA CLA / SIGNED OUTPUT ?
1402 JMP TIOB / NO:
1403 TAD TION0 / YES: COMPLEMENT NEGATIV NUMBER
1404 SMA / NEGATIV NUMBER ?
1405 JMP TIOB / NO:
1406 CIA / YES: COMPLEMENT
1407 DCA TION0
1408 ISZ TIOSG / SET SIGN FLAG
1409
1410 TIOB, CLA
1411 TAD TIOFL
1412 AND (77 / GET FIELD WIDTH
1413 DCA TIOFL / CLEAR UNUSED BITS
1414 TAD TIOFL
1415 SNA / FIELD WIDTH ZERO ?
1416 JMP TIOD / YES:
1417 CIA / NO: COMPLEMENT
1418 TAD TIOSG / TAKE SIGN INTO ACCOUNT
1419 TAD (4 / MAX 4 DIGIT
1420 SMA / FILL CHARACTER NEEDED ?
1421 JMP TIOD / NO:
1422 DCA TIOCT / YES: -# OF SPACE TO FILL FORMAT
1423
1424 TIOC, TAD TIOFC / TYPE
1425 JMS TCO
1426 ISZ TIOCT
1427 JMP TIOC
1428
1429 TIOD, CLA
1430 TAD (-13 / # OF SUBTRACTIONS
1431 DCA TIOCT / TO COUNTER
1432 DCA TION1
1433
1434 TIOE, CLA CLL / SUCCESSIV SUBTRACTIONS OF
1435 TAD TION0 / DECIMAL VALUES FROM TABLE
1436 TAD I TIOPT / SUBTRACTION
1437 SZL / CARRY ?
1438 DCA TION0 / YES, NEW VALUE
1439 CLA
1440 TAD TION1 / RESULT IN LINK
1441 RAL
1442 DCA TION1 / SHIFTED INTO TION1
1443 ISZ TIOPT / INCREMENT POINTER
1444 ISZ TIOCT / DONE ?
1445 JMP TIOE / NO, CONTINUE
1446
1447 DCA TIOZF / CLEAR LEADING ZERO FLAG
1448
1449 TAD TIOSG
1450 CIA
1451 TAD (-5
1452 DCA TIOCT / SET DIGIT COUNTER, 4 DIGITS + SIGN
1453
1454 TAD TION1 / 1. DIGIT
1455 BSW
1456 RTR
1457 JMS TIOF
1458
1459 TAD TION1 / 2. DIGIT
1460 RTR
1461 RTR
1462 JMS TIOF
1463
1464 TAD TION1 / 3. DIGIT
1465 JMS TIOF
1466
1467 ISZ TIOZF / 4. DIGIT ALWAYS TYPED
1468 TAD TION0
1469 JMS TIOF
1470
1471 JMP I TDOHO
1472
1473 TIOER, TAD TIOFL / ERROR, FILL FORMAT WITH ****
1474 CIA
1475 DCA TIOCT
1476 TAD ("*
1477 JMS TCO / TYPE CHARACTER
1478 ISZ TIOCT
1479 JMP .-4
1480 CLA
1481 JMP I TDOHO / EXIT MAIN SUBROUTINE
1482
1483 TION0, 0 / GETS LSD
1484 TION1, 0 / GETS 3 MSD
1485 TIOPT, 0 / POINTER
1486 TIOCT, 0 / COUNTER
1487 TIOFL, 0 / FLAGS
1488 TIOSG, 0 / SIGN FLAG
1489 TIOZF, 0 / ZERO SUPPRESS FLAG
1490 TIOFC, 0 / FILL CHARACTER
1491 \f/ TSO STRING OUTPUT
1492 /
1493 / TYPES A STRING OF ASCII - CHARACTERS
1494 / BUFFER CONTAINS ONE CHARACTER PER
1495 / WORD AND MUST BE TERMINATED BY 0
1496 /
1497 / ENTRY: AC = POINTER TO BUFFER
1498 / EXIT: AC = 0
1499 /
1500 / 10-APR-84 REV 0.0 KJ.S.
1501 /
1502
1503 TSO, 0
1504 DCA TSOPT / BUFFER POINTER
1505 TSOA, TAD I TSOPT / GET CHARACTER
1506 SNA / CHARACTER.EQ.0 ?
1507 JMP I TSO / YES: EXIT
1508 JMS TCO / NO: PRINT
1509 ISZ TSOPT
1510 JMP TSOA
1511 JMP TSOA
1512
1513 TSOPT, 0
1514
1515 PAGE
1516 \f/ TCO CHARACTER OUTPUT
1517 /
1518 / TYPES ONE ASCII-CHARACTER CALLING
1519 / CP-ROUTINE, RESPONS TO CTRL/S - CTRL/Q
1520 /
1521 / ENTRY: AC = CHARACTER
1522 / EXIT: AC = 0 LINK UNCHANGED
1523 /
1524 / 10-APR-84 REV 0.0 KJ.S.
1525 / 18-OCT-84 REV 0.1 KJ.S. HARDWARE INDEPENDENT
1526 / 18-OCT-84 REV 0.2 KJ.S. LINK PRESERVED
1527 /
1528
1529 TCO, 0
1530 DCA TCOSV / SAVE CHAR
1531 JMS TOKSF / CHECK XON/XOFF
1532 JMP TCO2
1533 JMS TOKRB
1534 AND (177
1535 TAD (7755
1536 SZA CLA / CTRL/S ?
1537 JMP TCO2 / NO:
1538 TCO1, CLA / YES: WAITING FOR CTRL/Q
1539 JMS TOKSF
1540 JMP .-1
1541 JMS TOKRB
1542 AND (177
1543 TAD (7757
1544 SZA CLA / CTRL/Q ?
1545 JMP TCO1 / NO: WAIT
1546 TCO2, TAD TCOSV / YES: TYPE CHARACTER
1547 JMS TOTLS
1548 JMS TOTSF
1549 JMP .-1
1550 CLA
1551 JMP I TCO
1552
1553 TCOSV, 0
1554
1555 / SUBROUTINES WITH I/O INSTRUCTIONS
1556 / DEVICE-CODE CAN BE SET BY TODC
1557
1558 TOKSF, 0
1559 KSF
1560 SKP
1561 ISZ TOKSF
1562 JMP I TOKSF
1563 TOKRB, 0
1564 KRB
1565 JMP I TOKRB
1566 TOTSF, 0
1567 TSF
1568 SKP
1569 ISZ TOTSF
1570 JMP I TOTSF
1571 TOTLS, 0
1572 TLS
1573 JMP I TOTLS
1574 \f/ TODC.PA
1575 /
1576 / CHANGE SERIAL OUTPUT DEVICE AND THE CORRESPONDING
1577 / INPUT DEVICE FOR XON/XOFF PROTOCOL
1578 /
1579 / ENTRY: AC = XNNX NN = OUTPUT, NN-1 = INPUT DEVICE
1580 / EXIT: AC = 0
1581 /
1582 / 18-OCT-84 REV 0.0 KJ.S.
1583 /
1584
1585 TODC, 0
1586 AND (770
1587 DCA TODCSV
1588 TAD (6001
1589 TAD TODCSV
1590 DCA TOTSF+1
1591 TAD (6006
1592 TAD TODCSV
1593 DCA TOTLS+1
1594 TAD (-10 / CHANGE INPUT
1595 TAD TODCSV
1596 DCA TODCSV
1597 TAD (6001
1598 TAD TODCSV
1599 DCA TOKSF+1
1600 TAD (6006
1601 TAD TODCSV
1602 DCA TOKRB+1
1603 JMP I TODC
1604
1605 TODCSV, 0
1606 \f PAGE
1607 / TTO TEXT OUTPUT
1608 /
1609 / TYPE TEXT FROM 6-BIT ASCII BUFFER CREATED WITH
1610 / PAL8 TEXT PSEUDO-OP.
1611 /
1612 / $ - OPTION:
1613 / CHARACTERS BETWEEN TWO $-CHARACTERS ARE CONVERTED
1614 / TO CONTROL CHARACTERS.
1615 /
1616 / # - OPTION:
1617 / MULTIPLE OUTPUT OF SAME CHARACTER. THE FIRST CHARACTER
1618 / AFTER # IS TREATED AS NUMBER ( LOWER 6 BITS ) AND
1619 / THE SECOND CHARACTER IS PRINTED.
1620 /
1621 / NOTE:
1622 / IF THE $- AND %-OPTIONS ARE USED, THE TEXT BUFFER MUST
1623 / TERMINATED WITH A ZERO WORD. THIS FEATURE COMBINES
1624 / SEVERAL TEXT BUFFERS TO ONE BUFFER WITH THE /F OPTION.
1625 /
1626 / % - OPTION
1627 / CHARACTERS BETWEEN TWO "-CHARACTERS ARE CONVERTED
1628 / TO LOWER CASE CHARACTER. MAY BE COMBINED WITH
1629 / OTHER OPTIONS
1630 /
1631 / ENTRY: AC = POINTER TO TEXT-BUFFER
1632 / EXIT: AC = 0
1633 /
1634 / 06-APR-84 REV 0.0 KJ.S.
1635 / 09-APR-84 REV 0.1 KJ.S. LOCATIONS RENAMED
1636 / 11-APR-84 REV 0.2 KJ.S. OUTPUT CODE CHANGED
1637 / 09-FEB-85 REV 0.3 KJ.S. #-OPTION ADDED
1638 / 13-FEB-85 REV 0.4 KJ.S. %-OPTION ADDED
1639 /
1640
1641 TTO, 0
1642 DCA TTOPNT / SAVE POINTER TO TEXT
1643 DCA TTOCFL / CLEAR CONTROL-FLAG
1644 DCA TTOEFL / AND END-FLAG
1645
1646 TTOA, CLA
1647 TAD I TTOPNT
1648 SNA / ZERO WORD ?
1649 JMP TTOR / YES: END OF BUFFER
1650 BSW
1651 JMS TTOB
1652 TAD I TTOPNT
1653 JMS TTOB
1654 ISZ TTOPNT
1655 JMP TTOA
1656
1657 TTOB, 0
1658 AND (77 / MAKE 6-BIT ASCII
1659 SNA / CHAR = 0 ?
1660 JMP TTOB2 / YES: CHECK IF END OF BUFFER
1661 TAD (-43
1662 SNA / CHAR = 43 = # ?
1663 JMP TTOB3 / YES: REP. OPTION
1664 TAD (-1
1665 SNA / CHAR = 44 = $ ?
1666 JMP TTOB1 / YES: TOGGLE CONTROL FLAG
1667 TAD (-1
1668 SNA / CHAR = 45 = % ?
1669 JMP TTOB5 / YES: TOGGLE CONTROL FLAG
1670 TAD (5 / NO, PRINT CHARACTER
1671 SPA / MAKE 8-BIT ASCII:
1672 TAD (100 / 01-37 TO 301-337
1673 TAD (240 / 40-77 TO 240-277
1674 TAD TTOCFL / ADD CTRL SET BY $
1675 TAD TTOLFL / AND LOWER FLAG SET BY %
1676 DCA TTOSV
1677
1678 ISZ TTONFL
1679 SKP
1680 JMP TTOB4 / LAST CHAR WAS #, MAKE NUMBER
1681 TTOB0, TAD TTOSV
1682 JMS TCO
1683 ISZ TTONFL
1684 JMP TTOB0 / LOOP FOR #-OPTION
1685 CLA CLL CMA RAL / DONE, FLAG = -2
1686 JMP TTOBX
1687
1688 TTOB5, CLA / TOGGLE LOWER CASE FLAG
1689 TAD TTOLFL
1690 SNA CLA / LOWER CASE FLAG ZERO ?
1691 TAD (40 / YES: SET TO 40
1692 DCA TTOLFL / NO: CLEAR FLAG
1693 JMP TTOB6
1694
1695 TTOB1, CLA / TOGGLE CONTROL CHAR FLAG
1696 TAD TTOCFL
1697 SNA CLA / CONTROL FLAG ZERO ?
1698 TAD (-100 / YES: SET TO -100
1699 DCA TTOCFL / NO: CLEAR FLAG
1700 TTOB6, CLA IAC / SET END FLAG
1701 DCA TTOEFL
1702 JMP I TTOB
1703
1704 TTOB2, CLA
1705 TAD TTOEFL
1706 SNA CLA / TTOEFL.GT.0 ?
1707 JMP TTOR / NO: END OF BUFFER, EXIT
1708 JMP I TTOB / YES: IGNORE ZERO CHAR AFTER USE OF $
1709
1710 TTOB3, CLA CMA / CHAR = #
1711 JMP TTOBX / NEXT CHAR IS CONVERT TO NUMBER
1712
1713 TTOB4, CLA IAC / MAKE NUMBER
1714 TAD TTOSV
1715 AND (77
1716 CIA
1717
1718 TTOBX, DCA TTONFL / SET FLAG
1719 JMP I TTOB
1720
1721 TTOR, CLA / CLEAR ALL FLAGS
1722 DCA TTOCFL
1723 DCA TTOEFL
1724 JMP I TTO / AND EXIT
1725
1726 TTOPNT, 0
1727 TTOCFL, 0
1728 TTOLFL, 0
1729 TTOEFL, 0
1730 TTONFL, -2
1731 TTOSV, 0
1732
1733 PAGE
1734 \f\f\f\f\1a
My complete PDP-8 universe