projects / pdp8.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
A large commit.
[pdp8.git] / sw / rescue / lab8e_goettingen / disk4_5 / rkb / paroff / aavg1.pa
CommitLineData
81e70d48
PH		 1/LAB8E ADVANCED AVERAGER MS-SIGNAL AVERAGER SECTION 1,\r
2/PARAMETER SETUP AND TRIGGER.\r
3/\r
4/DEC-8E-AAA1A-A-LA\r
5/\r
6/COPYRIGHT 1972\r
7/DIGITAL EQUIPMENT CORPORATION\r
8/MAYNARD, MASSACHUSETTS 01754\r
9/\r
10\f/AD1.5\r
11/THE ADVANCED AVERAGER MS FOR OS-8 WILL AVERAGE DATA\r
12/TAKEN FROM THE A/D , DISPLAY IT, AND WRITE IT TO\r
13/MASS STORAGE IF DESIRED.\r
14/SECTION I OF THE LAB8/E ADVANCED AVERAGER .\r
15/FOR DSK/DTA SYSTEMS.\r
16/ADVANCED AVG. TO RUN UNDER PS8.\r
17\r
18*7557\r
19OVRLAY, IOF\r
20 CLA CLL CMA\r
21 CLZE /DISABLE CLOCK\r
22 CLA\r
23 ADCL /AD\r
24 DILC /DISPLAY\r
25 DBDI /I/O\r
26 CDF 0 /CHAIN IN SEC.2\r
27 DCA I KC7746 /0 PS8 JOB STATUS WORD.\r
28 CIF 10\r
29 JMS I CHAIN\r
30 6\r
31XX0V1, 0\r
32CHAIN, 7700\r
33KC7746, 7746\r
34\r
35 MONITR=7600\r
36 CLZE=6130\r
37 ADCL=6530\r
38 DILC=6050\r
39 DBEI=6501\r
40\r
41\r
42\f\r
43/MEMORY BOUNDS FOR FIELD 0\r
44 LOCORE=230 /LISTS, BUFERS, DATA BLOCKS START HERE\r
45 HICORE=6300 /PROTECTED AREA BEGINS HERE\r
46 NXLOAD=7000 /NEXT SECTION LOADING BEGINS HERE\r
47\r
48/AVERAGING PARAMETERS: LOCATIONS 20-64\r
49 MEMTOT=20 /FIELDS IN THIS MACHINE\r
50 FIELD0=21 /ROOM FOR DATA IN FIELD 0\r
51\r
52/DIGITAL I/O OPTION, CONTINGENCY AND # OF SYNC INPUTS\r
53 XROPT=22 /0 IF I/O NOT IMPLEMENTED, 1 IF IT IS\r
54\r
55/LIST ADDRESSES\r
56 ADJLIS=23 /START OF JOB LIST-1\r
57 ADCHNL=24 /START OF CHANNNEL DISPLAY LIST-1\r
58\r
59/JOINT SWEEP PARAMETERS - 29 LOCATIONS\r
60 SMASK=25 /STIMULUS (SYNC) CHANNEL MASK\r
61 NSWEP=26 /-# OF SWEEPS IN AVERAGE\r
62 KSYTIM=27 /-(# OF ASI FROM STIM TO SYNC POINT -1)\r
63 KITIM=31 /-(# OF ASI FROM S0 TO S0)\r
64 KCTIM=33 /-(# OF ASI FROM STIM TO CONTINGENCY READING)\r
65 KWTIM=35 /(-# OF ASI FROM LAST STIM TO A/B OPENING)\r
66 ASI=37 /# OF USEC PER ASI\r
67 S0=41 /TEMPORARY TIMER\r
68 K0017=42\r
69 KMODE=43 /CONTAINS CLOCK RATE AND MODE\r
70/SWEEP A LIST PARAMETERS\r
71 SAMA=44 /-# OF POINTS (ASI) IN SWEEP A (EACH CHANNEL)\r
72 NCHA=45 /# OF CHAN IN SWEEP A\r
73 ADPNTA=46 /LOGICAL 1 OF ADC BUFFER A-1 (GEN BY ON-LINE)\r
74 ADBUFA=47 /LOCATION -1 FOR START OF ADC BUFFER -A\r
75 LNBUFA=50 /PHYSICAL LENGTH OF BUFFER -A\r
76\r
77EJECT\r
78 \r
79/SWEEP B LIST PARAMETERS\r
80 SAMB=51 /-# 0F POINTS (BSI) IN SWEEP B\r
81 NCHB=52 /# 0F CHAN IN SWEEP B\r
82 ADPNTB=53 /LOGICAL 1 OF ADC BUFFER-B - 1\r
83 ADBUFB=54 /LOCATION-1 FOR START OF BUFFER\r
84 LNBUFB=55 /PHYSICAL LENGTH OF BUFFER-B\r
85\r
86/SWEEP A - ON-LINE PARAMETERS\r
87 ADMPXA=56 /ADDRESS OF A SWEEP MPLX LIST -1\r
88 ADEL=57 /ADJUSTMENT AT SYNC POINT TO FIND LOGICAL 1 OF BUFFER-A\r
89 KBLA=60 /-# OF ASI FROM SYNC POINT TO LOGICAL END OF A-1\r
90\r
91/SWEEP B - ON LINE PARAMTERS\r
92 KBTOA=61 /-# OF A'S TO B, 0 FOR NO B\r
93 ADMPXB=62 /ADDRESS OF B MPLX LIST - 0\r
94 BDEL=63 /ADJUSTMENT AT SYNC POINT TO FIND LOGICAL 1 OF BUFFER-B\r
95 KBLB=64 /-# OF BSI FROM SYNC POINT TO LOGICAL END OF B - 1\r
96\r
97/INTERRUPT REFERENCES\r
98 INTERX=65 /LINK TO INTERRUPT SERVICE\r
99 ASAVE=66 /AC AT INTERRUPT\r
100 LSAVE=67 /LINK AT INTERRUPT\r
101\r
102/LINKAGES TO SUBROUTINES IN CORE FOR THIS SECTION\r
103/MISC. SUBROUTINES\r
104 FRAME=JMS I 76 /Q & A WITH SCOPE\r
105 OCTARG=JMS I 77 /PICK UP OCTAL TYPEIN\r
106 DFIX=JMS I 100 /DOUBLE PRECISION FIX\r
107\r
108/NUMERICAL I/O [SU56A]\r
109 DECARG=JMS I 101 /PICK UP DECIMAL TYPEIN\r
110 FLTARG=JMS I 102 /PICK UP FLOATING TYPEIN\r
111 FLTOUT=JMS I 103 /FLOATING AC TO TYPE BUFFER (FLOATING FORMAT)\r
112 OCTOUT=JMS I 104 /AC TO TYPE BUFFER (OCTAL FORMAT)\r
113\f/FLOATING POINT ARITHMETIC [SU64A]\r
114 FADD=JMS I 105 /FLOATING ADD\r
115 FDIV=JMS I 106 /FLOATING DIVIDE\r
116 FLOAT=JMS I 107 /FLOAT AC TO FAC\r
117 FMUL=JMS I 110 /FLOATING MULTIPLY\r
118 FIX=JMS I 111 /FIX FAC TO AC\r
119\r
120/BASIC SUBROUTINES [SU63A]\r
121 BRAN=JMS I 132 /BRANCH ACCORDING TO AC MATCH WITH LIST\r
122 SHFT=JMS I 133 /DOUBLE PRECISION ARITHMETIC SHIFT\r
123 DADD=JMS I 134 /DOUBLE PRECISION ADD\r
124\r
125/HALFWORD SUBROUTINES [SU60A]\r
126 SETH=JMS I 135 /SET HALFWORD POINTER\r
127 TYPE=JMS I 136 /TYPE 6BIT IN AC\r
128 LDH=JMS I 137 /LOAD HALFWORD INTO AC\r
129 SRCH=JMS I 140 /SEARCH FOR HALFWORD THAT MATCHES AC6-11\r
130 ALPHA=JMS I 141 /GET FIRST CHARACTER OF A TYPE-IN\r
131\r
132/FLOATING POINT HANDLERS [SU64A]\r
133 SAVE=JMS I 142 /SAVE FAC\r
134 LOAD=JMS I 143 /LOAD FAC\r
135 DCOM=JMS I 144 /DOUBLE PRECISION NEGATE\r
136 NORM=JMS I 145 /NORMALIZE FAC\r
137\r
138/PAGE ZERO CONSTANTS\r
139 K0004=112\r
140 K0003=113\r
141 K0002=114\r
142 KM0001=115\r
143\r
144 K0007=116\r
145 KM0027=117\r
146 K0377=120\r
147 KM0004=121\r
148\r
149/TTY-LIST\r
150 TTYLST=122\r
151 PROMRK=123\r
152 TXMRK=125\r
153 KCR=126\r
154 KM0043=127\r
155\r
156/OCSORT\r
157 OCSORT=130\r
158 K0040=130\r
159 MTXMRK=131\r
160\f/TEMPORARY STORAGE REGISTERS 146-177\r
161 TEMP01=146\r
162 TEMP02=147\r
163 TEMP03=150\r
164 TEMP04=151\r
165 TEMP05=152\r
166 TEMP06=153\r
167 TEMP07=154\r
168 TEMP10=155\r
169\r
170 TEMP11=156\r
171 TEMP12=157\r
172 TEMP13=160\r
173 TEMP14=161\r
174 TEMP15=162\r
175 TEMP16=163\r
176 TEMP17=164\r
177 TEMP20=165\r
178 TEMP21=166\r
179\r
180/TEMPORARY STORAGE AND MULTIPLE ACCUMULATORS\r
181 ARITH0=167\r
182 TEMP22=167\r
183\r
184 ARITH1=170\r
185 TEMP23=170\r
186\r
187 ARITH2=171\r
188 TEMP24=171\r
189\r
190 ARITH3=172\r
191 TEMP25=172\r
192\r
193 ARITH4=173\r
194 TEMP26=173\r
195\r
196\r
197 ARITH5=174\r
198 TEMP27=174\r
199\r
200/TEMPORARY STORAGE AND TTY-KBD BUFFERS\r
201 KBDBUF=175\r
202 TEMP30=175\r
203\r
204 TTYBUF=176\r
205 TEMP31=176\r
206\r
207 TTYFLG=177\r
208 TEMP32=177\r
209/FLOATING VARIABLES\r
210 FLOT01=5772\r
211 FLOT02=5775\r
212 FLOT03=5347\r
213 FLOT04=5352\r
214 FLOT05=5355\r
215 FLOT06=5360\r
216 FLOT07=5363\r
217 FLOT10=5366\r
218\f/IOT REFERENCES FOR THE LAB/8E\r
219/\r
220/\r
221/AD8-EA 10 BIT A/D CONVERTER\r
222/\r
223 ADCL=6530 /CLEAR ALL\r
224 ADLM=6531 /LOAD MPLXR\r
225 ADST=6532 /START CONVERSION\r
226 ADRB=6533 /READ AD BUFFER\r
227 ADSK=6534 /SKIP ON AD DONE\r
228 ADSE=6535 /SKIP ON TIMING ERROR\r
229 ADLE=6536 /LOAD ENABLE REGISTER\r
230 ADRS=6537 /READ STATUS REGISTER\r
231/\r
232/VC8-E POINT PLOT DISPLAY\r
233/\r
234 DILC=6050 /CLEAR ALL\r
235 DICD=6051 /CLEAR DONE FLAG\r
236 DISD=6052 /SKIP ON DONE FLAG\r
237 DILX=6053 /CLEAR DONE FLAG LOAD X\r
238 DILY=6054 /CLEAR DONE FLAG LOAD Y\r
239 DIXY=6055 /CLEAR DONE, INTENSIFY, SET DONE\r
240 DILE=6056 /LOAD ENABLE CLEAR AC\r
241 DIRE=6057 /ENABLE TO AC\r
242/\r
243/DK8-EP REAL TIME CLOCK\r
244/\r
245 CLZE=6130 /ZERO TO ENABLE\r
246 CLSK=6131 /SKP ON CLOCK FG\r
247 CLOE=6132 /ONES TO ENABLE\r
248 CLAB=6133 /AC TO CLK BUF AND COUNTER REGISTER\r
249 CLEN=6134 /ENABLE TO AC\r
250 CLSA=6135 /STATUS TO AC AND AC ONE'S CLEAR STATUS REG.\r
251 CLBA=6136 /CLK BUF TO AC\r
252 CLCA=6137 /CLK CNTR TO AC AND TO AC\r
253/\r
254/DB8-EA 12 CHANNEL DIGITAL I/O\r
255/\r
256 DBDI=6500 /DISABLE INTERRUPT\r
257 DBEI=6501 /ENABLE INTERRUPT\r
258 DBSK=6502 /SKIP ON INPUT\r
259 DBCI=6503 /CLEAR INPUT BITS WITH SET AC BIT\r
260 DBRI=6504 /READ INPUT\r
261 DBCO=6505 /CLEAR OUTPUT BITS WITH AC BITS\r
262 DBSO=6506 /SET OUTPUT BITS WITH AC BITS\r
263 DBRO=6507 /READ OUTPUT REGISTER\r
264\r
265/COMBINED OPERATES\r
266MTH=CLA CMA CLL RTL; MTW=CLA CMA CLL RAL\r
267TWO=CLA CLL CML RTL; TWOK=CLA CLL CML RTR\r
268\r
269/EXTENDED MEMORY\r
270CDF=6201; RDF=6214; RMF=6244\r
271\r
272\f/PAGE ZERO FOR ADVANCED AVERAGER [U10ZC]\r
273*1\r
274 DCA ASAVE /INTERRUPT SERVICE DISPATCH\r
275 RAR\r
276 DCA LSAVE\r
277 JMP I INTERX\r
278PG0OV, 0\r
279 0\r
280 0\r
281/INSTALLATION PARAMETERS: LOCATIONS 20-64\r
282 / 0 /FIELDS IN THIS MACHINE: MEMTOT\r
283/ HICORE-LOCORE-4 /ROOM FOR DATA IN FIELD 0: FIELD0\r
284/XR-OPTION, CONTINGENCY AND # OF SYNC INPUTS\r
285/ 0 /0 IF XR NOT IMPLEMENTED, 1 IF IT IS: XROPT\r
286/LIST ADDRESSES\r
287/ LOCORE-1 /START OF LISTS. BUFFERS, DATA: ADJLIS\r
288/ 0 /START OF CHANNEL DISPLAY WORDS: ADCHNL\r
289/JOINT SWEEP PARAMETERS - 29 LOCATIONS\r
290/ 0 /STIMULUS (SYNC) CHANNEL MASK: SMASK\r
291/ 0 /-# OF SWEEPS IN AVERAGE: NSWEP\r
292/ 0 /-(# OF ASI FROM STIM TO SYNC POINT -1): KSYTIM\r
293/ 0 /(DBL PRECISION)\r
294/ 0 /-(# OF ASI FROM S0 TO S0): KITIM\r
295/ 0 /(DBL)\r
296/ 0 /-(# OF ASI FROM STIM TO CONTINGENCY READING): KCTIM\r
297/ 0 /(DBL)\r
298/ 0 /-(#OF ASI FROM LAST STIM TO A/B OPENING): KWTIM\r
299/ 0 /(DBL)\r
300/ 0 /# OF USEC PER ASI: ASI\r
301/ 0 /(DBL)\r
302/ 0 /S0\r
303EJECT\r
304 \r
305*41\r
306K1001A, 7001\r
307K0017, 17\r
308/ 0 /K0017\r
309/ 0 /KMODE\r
310/SWEEP A LIST PARAMETERS\r
311/ 0 /-#OF POINTS (ASI) IN SWEEP A (EACH CHANNEL): SAMA\r
312/ 0 /# OF CHAN IN SWEEP A: NCHA\r
313/ 0 /LOGICAL 1 OF ADC BUFFERA - 1 (GEN BY ON-LINE): ADPNTA\r
314/ 0 /LOCATION -1 FOR START OF A: ADBUFA\r
315/ 0 /PHYSICAL LENGTH OF BUFFER A: LNBUFA\r
316/SWEEP B LIST PARAMETERS\r
317/ 0 /-# OF POINTS (BSI) IN SWEEP B (EACH CHANNEL): SAMB\r
318/ 0 /# OF CHAN IN SWEEP B: NCHB\r
319/ 0 /LOGICAL 1 OF ADC-BUFFER-B-1 (GEN BV ONLINE): ADPNTB\r
320/ 0 /LOCATION -1 FOR START OF ADC BUFFER B\r
321/SWEEP A - ON-LINE PARAMETERS\r
322/ 0 /ADDRESS OF A SWEEP MPLX LIST -1\r
323/ 0 /-# OF LOCATIONS FROM SYNC POINT TO LOGICAL 1 OF A\r
324/ 0 /-# OF ASI FROM SYNC POINT TO LOGICAL END OF A -1\r
325/SWEEP B - ON LINE PARAMETERS\r
326/ 0 /-# OF A'S TO B, 0 FOR NO B\r
327/ 0 /ADDRESS OF B-SWEEP MPLX LIST -0\r
328/ 0 /-# OF LOCATIONS FROM SYNC POINT TO LOGICAL END OF B -1\r
329/ 0 /-# OF ASI FROM SYNC POINT TO LOGICAL 1 OF\r
330\f*70\r
331/LINKAGES TO SECTION 2 SUBROUTINES\r
332 7200 /PICKUP NEXT JOB FROM JOB LIST: JGET\r
333\r
334 7243 /MOVE THRU DATA BLOCK: BLKCNT\r
335\r
336 6474 /SET ADC POINTERS: SETPNT\r
337\r
338 6451 /MOVE THRU ADC BUFFERS: IXPNT\r
339\r
340 7121 /SET UP DISPLAY: SDIS\r
341\r
342 DISPS /DISPLAY A POINT: DISP\r
343\r
344/LINKAGES TO ALPHABETIC HANDLERS\r
345 FRAMES /Q AND A WITH THE SCOPE: FRAMES\r
346\r
347 OCTARS /PICK UP OCTAL TYPE-IN: OCTARG\r
348\r
349/LINKAGE TO DFIX\r
350 DFIXS /DOUBLE PRECISION FIX: DFIX\r
351\r
352/LINKAGES TO NUMERICAL IO\r
353 DECARS /PICK UP DECIMAL TYPE-IN: DECARG\r
354\r
355 FLTARS /PICK UP FLOATING TYPE-IN: FLTARG\r
356\r
357 FLTOUS /OUTPUT FAC TO TYPE BUFFER: FLTOUT\r
358\r
359 OCTOUS /OUTPUT AC (OCTAL FORMAT) TO TYPE BUFFER: OCTOUT\r
360/FLTSUB USED BY FLTIO - DON'T RELOCATE\r
361 FADDS /FLOATING ADD: FADD\r
362\r
363 FDIVS /FLOATING DIVIDE: FDIV\r
364\r
365 FLOATS /FLOAT AC TO FAC: FLOAT\r
366\r
367 FMULS /FLOATING MULTIPLY: FMUL\r
368\r
369 FIXS /FIX FAC TO AC: FIX\r
370\r
371/PAGE ZERO CONSTANTS - USED BY RESIDENT SUBROUTINES - DON'T RELOCATE\r
372 0004 /K0004\r
373 0003 /K0003\r
374 0002 /K0002\r
375 -001 /KM0001\r
376\r
377 +0007 /K0007\r
378 -0027 /KM0027\r
379 +0377 /K0377\r
380 -0004 /KM0004\r
381\f/TTY-LIST\r
382 0 /@-END OF LIST\r
383 42 /"-PROGRAM OUTPUT MARKER: PROMRK\r
384 44 /$-DISPLAY RESET\r
385 47 /'-KEYBORAD INPUT MARKER: TXMRK\r
386 45 /CR-CARRIAGE RETURN: KCR\r
387 -43 /LF-LINE FEED: KM0043\r
388\r
389/OCSORT\r
390 40 /SPACE: K0040\r
391 -47 /': MTXMRK\r
392\r
393/LINKAGES TO BASIC SUBROUTINES\r
394 BRANS /BRANCH ACCORDING TO FOLLOWING LIST: BRAN\r
395\r
396 SHFTS /DOUBLE PRECISION ARITHMETIC SHIFT: SHFT\r
397\r
398 DADDS /DOUBLE PRECISION ADD: DADD\r
399\r
400/LINKAGES TO HALFWORD SUBROUTINES\r
401 SETHS /SET HALFWORD POINTER: SETH\r
402\r
403\r
404 TYPES /TYPE 6BIT IN AC: TYPE\r
405\r
406 LDHS /GET NEXT HALFWORD TO AC: LDH\r
407\r
408 SRCHS /SEARCH FOR HALFWORD WATCH OF AC6-11: SRCH\r
409\r
410 ALPHAS /PICK UP ALPHABETIC TYPE-IN: ALPHA\r
411\r
412/LINKAGES TO FLTSUB SUBROUTINES\r
413 SAVES /SAVE FAC: SAVE\r
414\r
415 LOADS /LOAD FAC: LOAD\r
416\r
417 DCOMS /DOUBLE PRECISION NEGATE: DCOM\r
418\r
419 NORMS /NORMALIZE FAC: NORM\r
420\r
421/TEMPORARY STORAGE REGISTERS FROM 146-177\r
422*162\r
4230 /SET 0 TO CONVERT WRONG DECIMAL\r
424 /PLACE IN DISPLAY CON09B\r
425\f\r
426\r
427*200\r
428/SUBROUTINE FOR SECTION II TO DISPLAY POINT OF DATA: DISP\r
429\r
430DISPS, 0\r
431 TAD YSX /AC+(YS)=#PLACES TO SHIFT RIGHT\r
432 CMA IAC\r
433 SHFT /SCALE\r
434 TAD ARITH4 /MOVE X TO NEW VALUE\r
435 DILX /LOAD X\r
436 CLA /AND CLEAR\r
437 TAD YZX /BIAS\r
438 TAD ARITH2\r
439 DILY /LOAD Y\r
440 DISD /WAIT\r
441 JMP .-1\r
442 DIXY /DISPLAY\r
443 CLA /CLEAR\r
444 TAD DELX /LOAD INCREMENT FOR X\r
445 DCA ARITH1\r
446 TAD DELXY\r
447 DCA ARITH2 /ADD TO PRESENT X\r
448 DADD\r
449 JMP I DISPS\r
450YSX, 0\r
451YZX, 0\r
452DELX, 0\r
453DELXY, 0\r
454\f\r
455*400\r
456/OVERLAY LOOKUP FOR CAINING.\r
457/START AT START0 (400) FOR SECTION 1\r
458/START AT START1 (403) TO RUN WITH CONTROL TAPES.\r
459START0, CDF 0\r
460 JMS LINKLK /CALL CHAIN LOOKUP.\r
461 JMP START\r
462START1, CDF 0\r
463 JMS LINKLK\r
464 CDF CIF 10\r
465 JMP I (CONTAP /READ IN CONTROL FILE.\r
466\r
467LINKLK, 0\r
468 CLL CLA\r
469 TAD (2001\r
470 DCA 7746 /SET PS-8 JOB STATUS WORD.\r
471\r
472 TAD (PG0OV\r
473 DCA XXT3\r
474 TAD (NAMES\r
475 DCA XXT2\r
476 TAD (-3\r
477 DCA XXT1\r
478\r
479 CDF 0\r
480 CIF 10\r
481 JMS I (7700 /LOCK IN USR.\r
482 10\r
483\r
484 CLA IAC /FIND BLOCK ADDRESS OF SECT. 2\r
485 CDF 0\r
486 CIF 10\r
487 JMS I (200\r
488 2\r
489ARGA, NAME1\r
490 0\r
491 JMP ERRXX\r
492\r
493 CLA CLL\r
494 TAD ARGA /STORE BLOCK ADD.IN CHAIN COMMAND\r
495 DCA XX0V1 /TO CALL SEC.2.\r
496ARGBS, CLA IAC /FIND BLOCK ADD.OF SEC.3,4,\r
497 CDF 0 /AND WRITE OVERLAY.\r
498 CIF 10\r
499 JMS I (200\r
500 2\r
501ARGB, NAME2\r
502 0\r
503 JMP ERRXX\r
504\r
505 CLA CLL\r
506 TAD ARGB\r
507 DCA I XXT3 /STORE AT LOCS. 5,6,7.\r
508 TAD I XXT2\r
509 DCA ARGB\r
510 ISZ XXT2\r
511 ISZ XXT3\r
512 ISZ XXT1\r
513 JMP ARGBS\r
514\r
515 CDF 0\r
516 CIF 10\r
517 JMS I (200 /UNLOCK USR.\r
518 11\r
519\r
520 CLA CLL\r
521 DCA 7746 /RESET JOB STATUS WORD.\r
522 JMP I LINKLK\r
523\r
524ERRXX, CDF 0\r
525 CIF 10\r
526 JMS I (200\r
527 7\r
528 1 /USER ERROR 1\r
529 HLT\r
530XXT1, 0\r
531XXT2, 0\r
532XXT3, 0\r
533NAME1, FILENAME AAVG2.SV\r
534NAME2, FILENAME AAVG3.SV\r
535NAME3, FILENAME AAVG4.SV\r
536NAME4, FILENAME AAVG5.SV\r
537NAMES, NAME3\r
538 NAME4\r
539 EJECT\r
540*600\r
541/LAB-8 ADVANCED AVERAGER - SECTION 1 - MAIN: U11MC\r
542/ONCE ONLY CODE - INTIALIZATION\r
543START, CLL CLA\r
544 DILC\r
545 ADCL\r
546 SETH /VERSION. CONFIGURATION MESSAGE\r
547 DIS99 /"(VAP,#DF-1, CORE LIMITS)"\r
548 DCA MEMTOT\r
549\r
550/FIND # OF FIELDS AVAILABLE\r
551 TAD KMK /CDF N = CDF 0\r
552 DCA MKTEST\r
553MKLOOP, TAD MKTEST /CDF N+1\r
554 TAD KP10\r
555 DCA MKTEST\r
556MKTEST, CDF /CHANGE TO N+1\r
557 RDF /IF 4K - THIS IS A NOP\r
558 DCA I TTYLST /PUTS DF# IN DF, 0000; FOR 4K, PUT 0 IN 0000 OF FIELD 0\r
559 TAD I TTYLST /GETS A 0 IF FIELD DOESN'T EXIST\r
560 TAD KMK /GETS A CDF N+1 IF FIELD DOES EXIST\r
561 CMA IAC\r
562 TAD MKTEST\r
563 ISZ MEMTOT /# OF FIELDS\r
564 SNA CLA /IF AC=0, FIELD N+1 EXISTS\r
565 JMP MKLOOP /LOOK AT NEXT FIELD\r
566EJECT\r
567 \r
568KMK, CDF 0 /NO MORE FIELDS\r
569 CLA CMA\r
570 TAD MEMTOT /# OF FIELDS -1\r
571 DCA MEMTOT\r
572 TAD MEMTOT /PUT #DF-1 IN CONFIGURATION MESSAGE\r
573 OCTOUT\r
574 TAD KJLIST /START OF JOB LIST -1\r
575 DCA ADJLIST\r
576 TAD KFIELD /LENGTH OF AVAILABLE FIELD 0\r
577 DCA FIELD0\r
578 IAC /OUTPUT LOW CORE LIMIT\r
579 TAD ADJLIS\r
580 OCTOUT\r
581 TAD ADJLIS /OUTPUT HIGH CORE LIMIT\r
582 TAD FIELD0 /START OF FIELD0 + LENGTH OF FIELD 0\r
583 TAD K0004 /+4 FOR END OF LIST MARKERS\r
584 OCTOUT\r
585PRES00, FRAME /"LAB-8 IS READY\r
586 DIS00 /HIT RETURN TO PROCEED"\r
587 JMP PRES00\r
588\r
589\f\r
590PRES01, FRAME /DIGITAL I/O?'-'[Y OR N]\r
591 DIS00B /(Y FOR YES, N FOR NO)"\r
592 JMP PRES00 /LINE FEED - ASK PREVIOUS QUESTION\r
593 ALPHA /C.R. - GET ANSWER\r
594 BRAN /BRANCH ON Y\r
595 YESNO\r
596 IAC /AC=1 IF Y\r
597 NOP /AC=0 IF N\r
598 DCA XROPT /AC=0 OTHERWISE, XROPT=1 IF YES, 0 FOR NO\r
599 JMP I .+1\r
600 CON01\r
601\r
602/LOCAL CONSTANTS\r
603KP10, 0010\r
604KJLIST, LOCORE-1\r
605KFIELD, HICORE-LOCORE-4\r
606\f/DISPLAYS FOR ONCE ONLY CODE\r
607DIS00, 1401 /"LAB8/E IS READY\r
608 0270 /HIT RETURN TO PROCEED''"\r
609 5705\r
610 4011\r
611 2340\r
612 2205\r
613 0104\r
614 3140\r
615 4045\r
616 1011\r
617 2440\r
618 2205\r
619 2425\r
620 2216\r
621 4024\r
622 1740\r
623 2022\r
624 1703\r
625 0505\r
626 0447\r
627 4700\r
628\r
629DIS00B, 0411 /"DIGITAL I/O? -\r
630 0711 /<Y FOR YES, N FOR NO>"\r
631 2401\r
632 1440\r
633 1157\r
634 1777\r
635 4047\r
636 5547\r
637 4045\r
638 7431\r
639 4006\r
640 1722\r
641 4031\r
642 0523\r
643 5440\r
644 1640\r
645 0617\r
646 2240\r
647 1617\r
648 7600\r
649\f/DISPLAYS AND TEXTS FOR COMPILER [LB-U11*-PB]\r
650CON00, /END OF ONCE ONLY AREA\r
651DIS02, 2324 /"STANDARD RESOLUTION:\r
652 0116 /"'----' DATA POINTS\r
653 0401\r
654 2204\r
655 4022\r
656 0523\r
657 1714\r
658 2524\r
659 1117\r
660 1672\r
661 4547\r
662 5555\r
663 5555\r
664 4740\r
665 0401\r
666 2401\r
667 4020\r
668 1711\r
669 1624\r
670 2300\r
671\fDIS03, 1405 /"LENGTH: '-----' '-'SEC"\r
672 1607\r
673 2410\r
674 7240\r
675 4755\r
676 5555\r
677 5555\r
678 4740\r
679 4755\r
680 4723\r
681 0503\r
682 0000\r
683\r
684DIS04, 0405 /"DELAY: '-----' '-'SEC"\r
685 1401\r
686 3172\r
687 4047\r
688 5555\r
689 5555\r
690 5547\r
691 4047\r
692 5547\r
693 2305\r
694 0300\r
695\r
696DIS05, 1011 /"HIGH RESOLUTION EPOCH\r
697 0710 /'----' DATA POINTS"\r
698 4022\r
699 0523\r
700 1714\r
701 2524\r
702 1117\r
703 1640\r
704 0520\r
705 1703\r
706 1045\r
707 4347\r
708 5555\r
709 5555\r
710 4740\r
711 0401\r
712 2401\r
713 4020\r
714 1711\r
715 1624\r
716 2300\r
717\fDIS06, 1011 /"HI LENGTH: '-----' '-'SEC"\r
718 4014\r
719 0516\r
720 0724\r
721 1072\r
722 4047\r
723 5555\r
724 5555\r
725 5547\r
726 4047\r
727 5547\r
728 2305\r
729 0300\r
730\r
731DIS07, 1011 /"HI DELAY: '-----' '-'SEC"\r
732 4004\r
733 0514\r
734 0131\r
735 7240\r
736 4755\r
737 5555\r
738 5555\r
739 4740\r
740 4755\r
741 4723\r
742 0503\r
743 0000\r
744\r
745DIS01, 4523 /"\r
746 3116 /SYNC ON INPUT: S'-'\r
747 0340 /"\r
748 1716\r
749 4011\r
750 1620\r
751 2524\r
752 7240\r
753 2347\r
754 5547\r
755 4500\r
756\fDIS09, 4002 / "BEGINS-AT RATE-ENDS\r
757 0507 /"XXXXXX""X""XXXXXX""X""XXXXXX""X"\r
758 1116 /"XXXXXX""X""XXXXXX""X""XXXXXX""X"\r
759 2355 /\r
760 0124 /'-': CHANGE (H,L,&)"\r
761 4022\r
762 0124\r
763 0555\r
764 0516\r
765 0423\r
766 4542\r
767 3030\r
768 3030\r
769 3030\r
770 4242\r
771 3042\r
772 4230\r
773 3030\r
774 3030\r
775 3042\r
776 4230\r
777 4242\r
778 3030\r
779 3030\r
780 3030\r
781 4242\r
782 3042\r
783 4542\r
784 3030\r
785 3030\r
786 3030\r
787 4242\r
788 3042\r
789 4230\r
790 3030\r
791 3030\r
792 3042\r
793 4230\r
794 4242\r
795 3030\r
796 3030\r
797 3030\r
798 4242\r
799 3042\r
800 4545\r
801 4755\r
802 4772\r
803 4003\r
804 1001\r
805 1607\r
806 0540\r
807 5010\r
808 5414\r
809 5446\r
810 5100\r
811\fDIS12, 2317 /"SORT AT '-----' '-'SEC"\r
812 2224\r
813 4001\r
814 2440\r
815 4755\r
816 5555\r
817 5555\r
818 4740\r
819 4755\r
820 4723\r
821 0503\r
822 0000\r
823\r
824DIS15, 0126 /"AVG #"XX"\r
825 0740\r
826 3342 /ANALOG INPUT '--' "\r
827 3030\r
828 4245\r
829 4501\r
830 1601\r
831 1417\r
832 0740\r
833 1116\r
834 2025\r
835 2440\r
836 4755\r
837 5547\r
838 0000\r
839\r
840DIS16, 2205 /"RESOLUTION: '-' (H,L)"\r
841 2317\r
842 1425\r
843 2411\r
844 1716\r
845 7240\r
846 4755\r
847 4740\r
848 5010\r
849 5414\r
850 5100\r
851\r
852DIS17, 2317 /"SORT CODE: '---'"\r
853 2224\r
854 4003\r
855 1704\r
856 0572\r
857 4047\r
858 5555\r
859 5547\r
860 0000\r
861\fDIS18, 0317 /"CONFIDENCE LIMITS?:'-'\r
862 1606 /<Y:YES>"\r
863 1104\r
864 0516\r
865 0305\r
866 4014\r
867 1115\r
868 1124\r
869 2377\r
870 7240\r
871 4755\r
872 4745\r
873 7431\r
874 7240\r
875 3105\r
876 2376\r
877 0000\r
878\r
879DIS19, 0317 /"COMPUTE TREND?: '-'\r
880 1520 /<Y: YES>"\r
881 2524\r
882 0540\r
883 2422\r
884 0516\r
885 0477\r
886 7240\r
887 4755\r
888 4745\r
889 7431\r
890 7240\r
891 3105\r
892 2376\r
893 0000\r
894\fDIS24, 1405 /"LEAST SWEEP INTERVAL:\r
895 0123 /'------' '-'S (>"XXXXX" "X"S)"\r
896 2440\r
897 2327\r
898 0505\r
899 2040\r
900 1116\r
901 2405\r
902 2226\r
903 0114\r
904 7245\r
905 4755\r
906 5555\r
907 5555\r
908 4740\r
909 4755\r
910 4723\r
911 4050\r
912 7642\r
913 3030\r
914 3030\r
915 3030\r
916 4240\r
917 4230\r
918 4223\r
919 5100\r
920\r
921DIS25, 0126 /"AVERAGE '....' SWEEPS"\r
922 0522\r
923 0107\r
924 0540\r
925 4755\r
926 5555\r
927 5547\r
928 4023\r
929 2705\r
930 0520\r
931 2300\r
932\r
933DIS27, 4416 /"$FA8/INPUTS$AP4/"\r
934 0170\r
935 1116\r
936 2025\r
937 2423\r
938 4411\r
939 2064\r
940 0000\r
941\fDIS27A, 4230 /"XX":"XX",X\r
942 3042\r
943 7242\r
944 3030\r
945 4254\r
946 3000\r
947\r
948DIS30, 4415 /"$EA8/AVERAGES"\r
949 0170\r
950 0126\r
951 0522\r
952 0107\r
953 0523\r
954 0000\r
955\r
956DIS30A, 4230 /-"XX"-\r
957 3042\r
958 0000\r
959\r
960DIS32, 2025 /"PUNCH CONTROL TAPE? '-'\r
961 1603 /<Y: YES>"\r
962 1040\r
963 0317\r
964 1624\r
965 2217\r
966 1440\r
967 2401\r
968 2005\r
969 7740\r
970 4755\r
971 4745\r
972 7431\r
973 7240\r
974 3105\r
975 2376\r
976 0000\r
977\fDIS32A, 2411 /"TITLE:\r
978 2414 /'---------------------'"\r
979 0572\r
980 4547\r
981 5555\r
982 5555\r
983 5555\r
984 5555\r
985 5555\r
986 5555\r
987 5555\r
988 5555\r
989 5555\r
990 5555\r
991 5547\r
992 4545\r
993 0000\r
994\r
995ERR01, 7740 /"? SWEEP ENDS EARLY ' '"\r
996 2327\r
997 0505\r
998 2040\r
999 0516\r
1000 0423\r
1001 4005\r
1002 0122\r
1003 1431\r
1004 4747\r
1005 0000\r
1006\r
1007ERR02, 7740 /"? INSUFFICIENT MEMORY ' '"\r
1008 1116\r
1009 2325\r
1010 0606\r
1011 1103\r
1012 1105\r
1013 1624\r
1014 4015\r
1015 0515\r
1016 1722\r
1017 3147\r
1018 4700\r
1019\r
1020ERR03, 7740 /"? BAD SAMPLING RATIO ' '"\r
1021 0201\r
1022 0440\r
1023 2301\r
1024 1520\r
1025 1411\r
1026 1607\r
1027 4022\r
1028 0124\r
1029 1117\r
1030 4747\r
1031 0000\r
1032\fERR04, 7740 /"? NO COMMON INTERVAL"\r
1033 1617\r
1034 4003\r
1035 1715\r
1036 1517\r
1037 1640\r
1038 1116\r
1039 2405\r
1040 2226\r
1041 0114\r
1042 4747\r
1043 0000\r
1044\r
1045\r
1046ERR05, 7740 /"? TOO MANY INPUTS\r
1047 2417 / FOR SWEEP RATE"\r
1048 1740\r
1049 1501\r
1050 1631\r
1051 4011\r
1052 1620\r
1053 2524\r
1054 2345\r
1055 4040\r
1056 0617\r
1057 2240\r
1058 2327\r
1059 0505\r
1060 2040\r
1061 2201\r
1062 2405\r
1063 4747\r
1064 0000\r
1065\r
1066TXT32, 4545 /<CRLF><CRLF> SWEEP SUMMARY<CRLF>\r
1067 4040\r
1068 4023\r
1069 2705\r
1070 0520\r
1071 4023\r
1072 2515\r
1073 1501\r
1074 2231\r
1075 4500\r
1076\fTXT32A, 4040 /" AVERAGES\r
1077 4040 /CHAN RATE TYPE SORT\r
1078 0126\r
1079 0522\r
1080 0107\r
1081 0523\r
1082 4503\r
1083 1001\r
1084 1640\r
1085 2201\r
1086 2405\r
1087 4024\r
1088 3120\r
1089 0540\r
1090 2317\r
1091 2224\r
1092 4500\r
1093\r
1094TXT33A, 4042 /" "XX" X "XX" "XXX"\r
1095 3030 /"\r
1096 4240\r
1097 4040\r
1098 4030\r
1099 4040\r
1100 4040\r
1101 4042\r
1102 3030\r
1103 4240\r
1104 4042\r
1105 3030\r
1106 3042\r
1107 4500\r
1108\r
1109DIS99, 5026 /"(VAP,"X","XXXX"-"XXXX")\r
1110 0120\r
1111 5442\r
1112 3042\r
1113 5442\r
1114 3030\r
1115 3030\r
1116 4255\r
1117 4230\r
1118 3030\r
1119 3042\r
1120 5145\r
1121 0000\r
1122\r
1123TXT34B, 4023 /" SWEEPS AT "\r
1124 2705\r
1125 0520\r
1126 2340\r
1127 0124\r
1128 4000\r
1129\f\r
1130TXT34C, 2345 /"S\r
1131\r
1132/TTYLST: H,L\r
1133HLSWIT, 0010 /H\r
1134 -014 /L\r
1135\r
1136TXCRLF, 4545\r
1137 4500\r
1138\r
1139/TTYLST: LF,CR\r
1140CRLF, +212\r
1141 -215\r
1142\r
1143/FLOATING VARIABLES\r
1144FLOT11, 0\r
1145 0\r
1146 0\r
1147\r
1148FLOT12, 0\r
1149 0\r
1150 0\r
1151\r
1152FLOT13, 0\r
1153 0\r
1154 0\r
1155\r
1156FLOT14, 0\r
1157 0\r
1158 0\r
1159\r
1160FLOT15, 0\r
1161 0\r
1162 0\r
1163\r
1164FLOT16, 0\r
1165 0\r
1166 0\r
1167\r
1168FLOT17, 0\r
1169 0\r
1170 0\r
1171\r
1172FLOT20, 0\r
1173 0\r
1174 0\r
1175\r
1176/FLOATING CONSTANT\r
1177VARTIM, 0011\r
1178 3100\r
1179 0000\r
1180\r
1181CON02A, TAD SAMB\r
1182 TAD CON02H\r
1183 SMA CLA\r
1184 JMP I CON02J\r
1185 TAD SAMB\r
1186 IAC\r
1187 JMP I CON02K\r
1188CON02K, CON02P\r
1189CON02J, CON02\r
1190CON02H, 100\r
1191XX76NO, TAD FAC+2 /SUBTRACT 200 FOR EACH FIELD USED.\r
1192 TAD XXM200 /PS8 USES 7600 AND UP.\r
1193 DCA FAC+2\r
1194 JMP .+2\r
1195 DADD\r
1196 ISZ TLINKS\r
1197 JMP .-2\r
1198 TAD TEMP06 /SUBTRACT AGAIN IF ANOTHER FIELD\r
1199 CIA /WAS USED.\r
1200 TAD FOP+1\r
1201 SZA CLA\r
1202 DADD\r
1203 JMP I .+1\r
1204 XX76BK\r
1205XXM200, -200\r
1206 *1763\r
1207/FLOATING CONSTANT\r
1208AVGTIM, 0007\r
1209 2770\r
1210 0000\r
1211\r
1212\f/SELECT SWEEP PARAMETERS\r
1213CHASX, CHAS\r
1214CON01, FRAME /"SYNC ON CHANNEL S'-'"\r
1215 DIS01\r
1216 JMP CON01 /L.F.: RESTART\r
1217 OCTARG\r
1218 JMP CON01 /FORMAT ERROR - ASK AGAIN\r
1219 SNA\r
1220 JMP I CHASX\r
1221 DCA SMASK\r
1222 TAD SMASK\r
1223 BRAN\r
1224 K0004\r
1225 JMP OK\r
1226 JMP I CON01Z\r
1227 JMP OK\r
1228 JMP OK\r
1229 JMP I CON01Z\r
1230CHAS, CLL CML RAR\r
1231 DCA SMASK\r
1232OK, TAD MODE\r
1233 DCA KMODE\r
1234CON02, FRAME /"STANDARD RESOLUTION\r
1235 DIS02 /'---' DATA POINTS"\r
1236 JMP I CON01Z /L.F.: PREVIOUS QUESTION\r
1237 DECARG\r
1238 JMP CON02 /FORMAT ERROR - ASK AGAIN\r
1239 CMA IAC\r
1240 DCA SAMB /-# OF DATA POINTS IN LOW (OR ONLY) EPOCH\r
1241 JMP I .+1 /CHECK IF # OF POINTS IS LESS\r
1242 /THAN 65.\r
1243 CON02A\r
1244CON02P, FLOAT /FSAMB =-(#OF POINTS -1)\r
1245 SAVE\r
1246 FSAMB\r
1247 FSAMB=FLOT03\r
1248 FADD\r
1249 KM001F\r
1250 SAVE /-# OF POINTS\r
1251 FLOT01\r
1252 TAD SAMB\r
1253 TAD FIELD0 /DECREASE AVAILABLE FIELD0 BY ADC BUF\r
1254 SZL CLA /(+)+(-): LINK WILL BE 1 IF NO OVERFLOW\r
1255 JMP CON03\r
1256 FRAME /"? INSUFFICIENT MEMORY"\r
1257 ERR02\r
1258 JMP CON02 /ASK FOR # OF DATA POINTS\r
1259 JMP CON02\r
1260\r
1261/LOCAL CONSTANTS\r
1262K0226, +226\r
1263CON01Z, CON01\r
1264\r
1265MODE, 5057 /EXTERNAL ENABLE,SCHMITT ENABLE,RESET\r
1266\fCON03, FRAME /"LENGTH: '----' '-'SEC"\r
1267 DIS03 /\r
1268 JMP CON02 /GO BACK TO PREVIOUS QUESTION\r
1269 FLTARG\r
1270 JMP CON03 /FORMAT ERROR - ASK LENGTH AGAIN\r
1271 FDIV /GET TIME BETWEEN DATA POINTS\r
1272 FLOT01\r
1273 SAVE\r
1274 FBSI\r
1275 FBSI=FLOT04\r
1276 TAD K0226 /MUST BE GREATER THAN OR EQUAL 150 USEC"\r
1277 FLOAT\r
1278 FADD /150US-RATE\r
1279 FBSI\r
1280 TAD FAC+1\r
1281 SMA SZA CLA\r
1282 JMP CON03 /.LT. 150 USEC, TRY AGAIN\r
1283\r
1284CON04, FRAME /"DELAY: '----' '-'SEC\r
1285 DIS04\r
1286 JMP CON03 /L.F.: PREVIOUS QUESTION\r
1287 FLTARG\r
1288 JMP CON04 /FORMAT ERROR - ASK DELAY AGAIN\r
1289 SAVE\r
1290 FBLATT /LATENCY IN USEC\r
1291 FBLATT=FLOT05\r
1292 FDIV /GET LATENCY IN TERMS OF SAMPLING INTERVAL\r
1293 FBSI\r
1294 SAVE /-LATENCY IN BSI\r
1295 FBLAT\r
1296 FBLAT=FLOT06\r
1297 FADD\r
1298 FSAMB /-LENGTH OF SWEEP IN BSI\r
1299 TAD FAC+1\r
1300 SPA SNA CLA /DOES SWEEP END BEFORE SYNC PULSE?\r
1301 JMP CON05 /NO, OK.\r
1302 FRAME /YES;"? SWEEP ENDS EARLY"\r
1303 ERR01\r
1304 JMP CON03 /LF: GET NEW SWEEP LENGTH\r
1305 JMP CON04 /CR: GET NEW SWEEP DELAY\r
1306\r
1307/LOCAL CROSSPAGE\r
1308CON08X, CON08\r
1309CON07X, CON07A\r
1310\fCON05, DCA KBTOA\r
1311 FRAME /"HIGH RESOLUTION EPOCH\r
1312 DIS05 /'----' DATA POINTS"\r
1313 JMP CON04 /L.F.: LAST QUESTION\r
1314 DECARG\r
1315 JMP .-4 /FORMAT ERROR - ASK # POINTS AGAIN\r
1316 CMA IAC /-# DATA POINTS\r
1317 SNA\r
1318 JMP I CON08X /0 DATA POINTS INDICATES SINGLE MODE\r
1319 DCA SAMA /- POINTS IN HI RESOLUTION EPOCH\r
1320 TAD SAMA\r
1321 IAC\r
1322 FLOAT /-(#DATA POINTS-1)\r
1323 SAVE\r
1324 FSAMA=FLOT10\r
1325 FSAMA /FSAMA=FLOT10\r
1326 FADD\r
1327 KM001F\r
1328 SAVE /-#DATA POINTS\r
1329 FLOT01\r
1330 TAD SAMA /PARTS OF FIELD 0 IN USE\r
1331 TAD SAMB\r
1332 TAD FIELD0 /FIELD 0 AVAILABLE\r
1333 SNL CLA /LINK=1 IF OVERFLOW\r
1334 JMP CON06\r
1335 FRAME /"? INSUFFICIENT MEMORY"\r
1336 ERR02\r
1337 JMP CON02 /L.F.: RESPECIFY LO-EPOCH\r
1338 JMP CON05 /C.R.: RESPECIFY HI-EPOCH\r
1339CON06, FRAME /"HI LENGTH: '----' '-'SEC"\r
1340 DIS06 \r
1341 JMP CON05 /LF: PREVIOUS QUESTION\r
1342 FLTARG\r
1343 JMP CON06 /FORMAT ERROR - ASK AGAIN\r
1344 FDIV /LENGTH\# POINTS= SAMPLING INTERVAL\r
1345 FLOT01\r
1346 SAVE /GET ASI IN USEC\r
1347 FASI \r
1348 FASI=FLOT11\r
1349 TAD K0226 /IF ASI. .LT. 150 US, TOO FAST\r
1350 FLOAT\r
1351 FADD /150US-ASI\r
1352 FASI\r
1353 TAD FAC+1\r
1354 SMA CLA\r
1355 JMP CON06 /.LT. 150 US, TOO FAST\r
1356 LOAD /CHECK BSI/ASI RATIO\r
1357 FBSI\r
1358 FDIV\r
1359 FASI\r
1360 DCOM\r
1361 FIX /.ABS. RATIO .LT. 1 OR .GT. 2^11 ?\r
1362 SZA /-BSI/ASI RATIO IN AC\r
1363 JMP I CON07X /NO - IS OK\r
1364\f FRAME /"? BAD SAMPLING RATIO"\r
1365 ERR03\r
1366 JMP I CON02X /LF: CHANGE BOTH SWEEPS\r
1367 JMP I CON05Y /CR: CHANGE HIGH\r
1368\r
1369CON07A, DCA KBTOA /KBTOA HOLDS -RATIO\r
1370CON07, FRAME /"HI DELAY: '----' '-'SEC"\r
1371 DIS07 \r
1372 JMP I CON06X /LF: PREVIOUS QUESTION\r
1373 FLTARG\r
1374 JMP CON07 /FORMAT ERROR: ASK AGAIN\r
1375 FDIV /-LATENCY IN TERMS OF ASI\r
1376 FASI\r
1377 SAVE\r
1378 FALAT\r
1379 FALAT=FLOT12\r
1380 TAD KBTOA /BSI=-KBTOA*ASIF\r
1381 CMA IAC\r
1382 FLOAT\r
1383 FMUL\r
1384 FASI\r
1385 SAVE\r
1386 FBSI\r
1387 LOAD /GET LO SWEEP LATENCY IN TERMS OF ASI\r
1388 FBLATT /-LO-LATENCY IN USEC.\r
1389 FDIV\r
1390 FASI\r
1391 SAVE /LO-LATENCY IN ASI.\r
1392 FBLAT\r
1393 TAD KBTOA /GET END TIME OF LO SWEEP (IN ASI)\r
1394 CMA IAC\r
1395 FLOAT\r
1396 FMUL /(B/A RATIO)*(-# OF POINTS)\r
1397 FSAMB\r
1398 FADD /ADD -DELAY (IN ASI)\r
1399 FBLAT\r
1400 DCOM\r
1401 SAVE /DELAY (IN ASI)+# OF POINTS*RATIO\r
1402 FBEND /POSITIVE SENSE\r
1403 FBEND=FLOT07\r
1404 JMP CON08A\r
1405\r
1406/LOCAL CROSS-PAGE\r
1407CON02X, CON02\r
1408CON04X, CON04\r
1409CON05Y, CON05\r
1410CON06X, CON06\r
1411CON09X, CON09\r
1412FMINX, FMINS\r
1413\fCON08, LOAD /HERE FOR 1-EPOCH MODE\r
1414 FBSI\r
1415 SAVE /BSI=ASI\r
1416 FASI\r
1417 LOAD /LO-LATENCY=HI-LATENCY\r
1418 FBLAT\r
1419 SAVE\r
1420 FALAT\r
1421 JMS I FMINX /SYNC TIME IS AT MIN (SYNC PULSE, DELAY)\r
1422 KZEROF\r
1423 DCOM\r
1424 SAVE /FAKE END OF B (SYNC TIME)\r
1425 FBEND\r
1426 LOAD\r
1427 FSAMB\r
1428 SAVE\r
1429 FSAMA\r
1430CON08A, TAD KBTOA /COME HERE FOR 2-EPOCH MODE\r
1431 FLOAT\r
1432 SAVE /-BSI/ASI\r
1433 FBTOA\r
1434 FBTOA=FLOT20\r
1435 LOAD /GET AEND, AEND=-(ALAT+SAMA)\r
1436 FSAMA /AEND IS - TIME OF A-SWEEP ENDING\r
1437 FADD\r
1438 FALAT /FALAT IS NEGATIVE SENSE A-DELAY\r
1439 SAVE\r
1440 FAEND /NEGATIVE SENSE.\r
1441 FAEND=FLOT13\r
1442 FADD\r
1443 FBEND /FBEND IS POSITIVE SENSE END OF B-SWEEP\r
1444 TAD FAC+1 /DIFFERENCE BETWEEN END TIMES\r
1445 SMA SZA CLA /BEND .LT. AEND?\r
1446 JMP CON08C /YES, LO ENDS AFTER HI ENDS\r
1447 FIX /NO, HI ENDS AFTER LO ENDS\r
1448 FLOAT /TRUNCATE. ROUND UP\r
1449 SAVE /(LO ENDS FIRST)\r
1450EJECT\r
1451 \r
1452 FBLA /-# OF POINTS LEFT IN A AT END OF B\r
1453 FBLA=FLOT14\r
1454 LOAD /SYNC TIME AT END OF LO SWEEP: KSYTIM=-(BEND-1)\r
1455 FBEND\r
1456 DCOM\r
1457 FADD\r
1458 KM001F\r
1459 SAVE\r
1460 KSYTIM-1\r
1461 LOAD /DOES HI START AFTER LO ENDS?\r
1462 FBEND /+(END-OF-B TIME)\r
1463 FADD\r
1464 FALAT /MINUS (START-OF-A TIME)\r
1465 TAD FAC+1 /(END B) - (START A) .LT 0?\r
1466 SPA CLA\r
1467 JMP CON08B /YES-NO COMMON INTERVAL\r
1468\f FIX /NO - TRUNCATE, ROUND DOWN\r
1469 FLOAT\r
1470 DCOM /LOGICAL START OF HI-SWEEP\r
1471 SAVE /[(END B) - (START A)] FROM SYNC TIME\r
1472 FADEL /NEGATIVE\r
1473 FADEL=FLOT15\r
1474 LOAD /LOGICAL START OF LO-SWEEP ENTIRE BUFFER BACK\r
1475 FSAMB\r
1476 SAVE\r
1477 FBDEL\r
1478 FBDEL=FLOT16\r
1479 LOAD /CLOSE LO BUFFER AT SYNC TIME\r
1480 KZEROF\r
1481 SAVE\r
1482 FBLB\r
1483 FBLB=FLOT17\r
1484 JMP I CON09X\r
1485\r
1486CON08B, FRAME /"? NO COMMON INTERVAL"\r
1487 ERR04\r
1488 JMP I CON04X /L.F.: GO BACK TO RESPECIFY LO-LATENCY\r
1489 JMP I CON02X /C.R.: RESPECIFY HI-LATENCY\r
1490\r
1491CON08C, FDIV /HI SWEEP ENDS BEFORE LO SWEEP ENDS\r
1492 FBTOA /KBLB=[(BEND-AEND)/KBTOA]-1\r
1493 FIX /-# OF POINTS LEFT TO GET IN B WHEN A STOPS\r
1494 FLOAT /TRUNCATE - ROUND UP\r
1495 SAVE /LO CLOSES KBLB AFTER SYNC TIME (IN BSI)\r
1496 FBLB\r
1497 LOAD /SYNC TIME AT END OF HI SWEEP\r
1498 FAEND\r
1499 FADD\r
1500 KM001F\r
1501 SAVE\r
1502 KSYTIM-1\r
1503 LOAD /DOES HI END BEFORE LO BEGINS?\r
1504 FAEND\r
1505 DCOM\r
1506 FADD /(END A)-(START B) .LT. 0 ?\r
1507 FBLAT\r
1508 TAD FAC+1\r
1509 SPA CLA\r
1510 JMP I CON08W /YES - NO COMMON INTERVAL\r
1511 FDIV /BDEL IS TIME FROM LOGICAL START TO SYNC TIME\r
1512 FBTOA /IN ASI\r
1513 DCOM\r
1514 FIX\r
1515 FLOAT /TRUNCATE, ROUND DOWN\r
1516 DCOM\r
1517 SAVE\r
1518 FBDEL\r
1519\f LOAD /LOGICAL START OF HI IS ENTIRE BUFFER BACK\r
1520 FSAMA\r
1521 SAVE\r
1522 FADEL\r
1523 LOAD /THERE ARE NO MORE A-POINTS TO GET AT SYNC TIME\r
1524 KZEROF\r
1525 SAVE /CLOSE HI BUFFER AT SYNC TIME\r
1526 FBLA\r
1527\r
1528CON09, TAD KSYTIM /SETUP SWEEP SUMMARY DISPLAY\r
1529 SPA CLA /UNLESS EITHER SWEEP ENDS BEFORE SYNC\r
1530 JMP CON09A\r
1531 FRAME /"? SWEEP ENDS EARLY"\r
1532 ERR01\r
1533 JMP I CON04Y /LF: RESPECIFY LATENCY\r
1534 JMP I CON05X /CR: RESPECIFY HI SWEEP\r
1535\r
1536/LOCAL CROSSPAGE\r
1537CON04Y, CON04\r
1538CON05X, CON05\r
1539CON08W, CON08B\r
1540\r
1541/SUBROUTINE TO GET MAX OF TWO FLOATING ARGUMENTS: FMAX\r
1542FMAXS, 0\r
1543 TAD FMAXS /GET PARAMETER ADDRESS\r
1544 DCA FMLOCS\r
1545 JMS FMARGS /COMPARE\r
1546FMEXIT, SPA CLA /SIGN OF COMPARSION\r
1547 TAD K0003 /GET COMPARAND AS RESULT (FMARG2=FMARG1+3)\r
1548 TAD ADRARG /GET FAC AS RESULT\r
1549 DCA .+2\r
1550 LOAD /PUT INTO FAC\r
1551 0\r
1552 JMP I FMLOCS /EXIT\r
1553\r
1554/SUBROUTINE TO GET MIN OF TWO FLOATING ARGS: FMIN\r
1555FMINS, 0\r
1556 JMS FMARGS /COMPARE\r
1557 CMA IAC /REVERSE SIGN OF COMPARSION\r
1558 JMP FMEXIT\r
1559\f FMLOCS=FMINS\r
1560FMARGS, 0\r
1561 SAVE /SAVE THE FAC\r
1562ADRARG, FMARG1\r
1563 FMARG1=FLOT01\r
1564 TAD I FMLOCS /GET ADDRESS OF COMPARAND\r
1565 DCA .+2\r
1566 LOAD /PUT COMPARAND IN FAC\r
1567 0\r
1568 SAVE /AND SAVE IT\r
1569 FMARG2\r
1570 FMARG2=FLOT02\r
1571 DCOM /FAC - COMPARAND\r
1572 FADD\r
1573 FMARG1\r
1574 TAD FAC+1 /SIGN OF (FAC-COMPARAND)\r
1575 ISZ FMLOCS /ADJUST RETURN ADDRESS\r
1576 JMP I FMARGS\r
1577\r
1578CON09A, SETH /POSITION HALFWORD POINTER\r
1579 DIS09 /PICK UP ARGUMENTS FOR DISPLAY\r
1580 LOAD\r
1581 KSYTIM-1\r
1582 DFIX /-SYNC POINT+1\r
1583 FAC+1\r
1584 NORM /TRUNCATE, ROUND UP\r
1585 DCA FAC\r
1586 SAVE\r
1587 KSYTIM-1\r
1588 DCOM\r
1589 FADD\r
1590 KM001F\r
1591 FADD /A-START TIME\r
1592 FADEL\r
1593 DCOM\r
1594 FMUL /SYNC POINT - DELAY (IN USEC)\r
1595 FASI\r
1596 FLTOUT\r
1597 LOAD\r
1598 FASI /HI SWEEP SAMPLING RATE\r
1599 DCOM\r
1600 FLTOUT\r
1601 LOAD /A-END TIME\r
1602 KM001F\r
1603 DCOM\r
1604 FADD\r
1605 KSYTIM-1\r
1606 FADD\r
1607 FBLA\r
1608\f FMUL /SYNC POINT + POINTS LEFT (IN USEC)\r
1609 FASI\r
1610 FLTOUT\r
1611 LOAD /GET START TIME OF LO SWEEP\r
1612 FBDEL\r
1613 FMUL\r
1614 FBTOA\r
1615 FADD\r
1616 KSYTIM-1\r
1617 DCOM\r
1618 FADD\r
1619 KM001F\r
1620 DCOM\r
1621 FMUL /SYNC POINT - DELAY\r
1622 FASI\r
1623 FLTOUT\r
1624 LOAD /LO RESOLUTION SAMPLING INTERVAL\r
1625 FBTOA\r
1626 FMUL\r
1627 FASI\r
1628 FLTOUT\r
1629 LOAD /B-END TIME\r
1630 FBLB\r
1631 FMUL\r
1632 FBTOA\r
1633 FADD\r
1634 KM001F\r
1635 DCOM /SYNC POINT + POINTS LEFT (IN USEC)\r
1636 FADD\r
1637 KSYTIM-1\r
1638 FMUL\r
1639 FASI\r
1640 FLTOUT\r
1641 LOAD /PRESET FAC TO -1 FOR NO XR\r
1642 KM001F\r
1643CON09B, FRAME /"BEGINS -AT RATE- ENDS\r
1644 DIS09 /SDDDDDMSDDDDDMSDDDDDM\r
1645 JMP CON09B /SDDDDDMSDDDDDMSDDDDDM\r
1646 ALPHA /\r
1647 BRAN /'-': CHANGE [H,L,-]"\r
1648 HLSWIT /(S: - OR SPACE; D: 0-9, OR -; M: U, M, OR SPACE)\r
1649 JMP I CON05Z /CHANGE HI (H)\r
1650 JMP I CON02Y /CHANGE HI AND LO (L)\r
1651\r
1652\f/GET LAST SWEEP PARAMETER: SORT TIME\r
1653CON12D, TAD XROPT /IF NO XR IN SYS, SKIP QUESTION\r
1654 SNA CLA\r
1655 JMP CON12E /ASSUME CTIME IS AT SYNC TIME\r
1656 FRAME /"SORT AT '-----' '-'SEC"\r
1657 DIS12\r
1658 JMP I CON9X /LF: LOOK AT SUMMARY AGAIN\r
1659 FLTARG\r
1660 JMP CON12D /FORMAT ERROR - ASK AGAIN\r
1661 FDIV /TIME IN ASI - CAN NO LONGER CHANGE SW PARAMETERS\r
1662 FASI\r
1663 FADD\r
1664 KM001F\r
1665 TAD FAC+1 /-SORT TIME MUST BE .LT.0 (-1 IF UNSPEC)\r
1666 SMA CLA\r
1667 JMP CON12D /RE ASK QUESTION\r
1668CON12E, SAVE\r
1669 FCTIM\r
1670 FCTIM=FLOT04 /FBSI. BLOCK 3-8\r
1671 DFIX\r
1672 KCTIM\r
1673 LOAD\r
1674 FAEND\r
1675 JMS I FMINY /FIND END OF SW PHASE\r
1676 FCTIM /MAX (END-A, SORT TIME)= MIN (-END-A, -SORT TIME)\r
1677 DCOM\r
1678 JMS I FMAXX /MAX (END-A, SORT TIME, END-B) IS END OF SW PHASE\r
1679 FBEND\r
1680 SAVE /SWEEP PHASE END POINT (IN ASI)\r
1681 FSWEND\r
1682 FSWEND=FLOT04 /FCTIM, BLOCK 12E\r
1683 LOAD\r
1684 FALAT\r
1685 JMS I FMAXX /FIND BEGIN TIME FOR SWEEP PHASE (IN ASI)\r
1686 FBLAT /MIN (START-A,START-B) = MAX (-START-A,-START-B)\r
1687 SAVE\r
1688 FSWBEG /-START TIME OF SWEEP PHASE\r
1689 FSWBEG=FLOT13 /12E,8-12\r
1690 FADD /+ END TIME OF SWEEP PHASE\r
1691 FSWEND\r
1692 SAVE /LENGTH OF SWEEP PHASE IN ASI\r
1693 FSWTIM\r
1694 FSWTIM=FLOT04 /FSWEND, BLOCK 12E\r
1695\f/ASK QUESTIONS AND GENERATE JOB LIST\r
1696CON13, DCA TNJOB /INITIALIZE SECTION VARIABLES - JOB 0\r
1697 TNJOB=TEMP30\r
1698 TAD KBTOA /SET ALLOWED MIN SAMPLING TIME\r
1699 SZA CLA\r
1700 TAD K0031 /25 (10)\r
1701 TAD K0175 /125(10)\r
1702 FLOAT /125 US IF SINGLE\r
1703 SAVE /150 US IF DOUBLE MODE\r
1704 FTIMSV /HOLDS MIN SWEEP INTV PERMITTED\r
1705 FTIMSV=FLOT01 /INCREASED FOR JOBS AS CHOSEN\r
1706 LOAD /SET TIME USED TO ZERO\r
1707 KZEROF\r
1708 SAVE\r
1709 CALTIM\r
1710 CALTIM=FLOT05 /FBLATT, BLOCK 4-7\r
1711 LOAD /MEMORY AVAILABLE AT INSTALLATION\r
1712 MEMTOT-1\r
1713 SAVE\r
1714 DAVAIL /DBL PREC. FIXED POINT. # OF CELLS AVAIL IN ALL OF CORE\r
1715 DAVAIL=FLOT02\r
1716 TAD FIELD0 /FIELD0 AVAIL FOR BUFFERS & LISTS\r
1717 DCA TLEFT0 /# OF CELLS LEFT IN FIELD 0\r
1718 TLEFT0=TEMP15\r
1719 DCA NCHA /INITIALIZE # OF CHANNELS TO ZERO\r
1720 DCA NCHB\r
1721 TAD ADJLIS /INITIALIZE JOB LIST POINTER\r
1722 IAC\r
1723 DCA TJPNTR\r
1724 TJPNTR=TEMP21\r
1725 DCA I TJPNTR /PUT EOL WORD IN JOB LIST (J1=0)\r
1726 TAD KMAXSZ /-MAXIMUM SIZE OF LIST +20\r
1727CON14, DCA TSZLST\r
1728 TSZLST=TEMP13\r
1729 TAD TLEFT0 /INITIALIZE FOR NEXT JOB\r
1730 DCA TAVAIL /TLEFT0 MODIFIED AT CON16\r
1731 TAVAIL=TEMP14\r
1732 LOAD /UPDATE TIME COUNT, FTIMSV MOD AT CON21\r
1733 FTIMSV\r
1734 SAVE\r
1735 FTIMIN\r
1736 FTIMIN=FLOT07 /FBEND. BLOCK 4-12E\r
1737 SETH /PUT AVERAGE # IN MESSAGE\r
1738 DIS15\r
1739 TAD TNJOB\r
1740 IAC\r
1741 OCTOUT\r
1742EJECT\r
1743 \r
1744CON15, FRAME /"AVG XX\r
1745 DIS15 /AVERAGE INPUT '--'"\r
1746 JMP I CON22X /L.F.: ENOUGH AVERAGES\r
1747 OCTARG\r
1748 JMP CON15 /FORMAT ERROR - ASK AGAIN\r
1749 DCA SHFR /SHFR HAS CHANNEL NUMBER\r
1750\fCON16, TAD SAMA /INITIALIZE FOR SINGLE MODE (H RESOL)\r
1751 DCA TNSAM /NUMBER OF DATA POINTS THIS JOB\r
1752 TNSAM=TEMP16\r
1753 TAD NCHA /ORDER OF THIS JOB IN JLIST\r
1754 DCA TORDER\r
1755 TORDER=TEMP17\r
1756 TAD KBTOA /DUAL BEAM MODE?\r
1757 SNA CLA\r
1758 JMP CON16J /NO- OMIT QUESTION\r
1759CON16A, FRAME /"RESOLUTION: '-' [H,L]"\r
1760 DIS16\r
1761 JMP CON15 /L.F.: RESTART JOB\r
1762 ALPHA /GET ANSWER\r
1763 BRAN\r
1764 HLSWIT\r
1765 JMP CON16B /H - OK\r
1766 JMP CON16G /L. - READUST FOR LO\r
1767 JMP CON16A /OTHER - ERROR, ASK AGAIN\r
1768\r
1769/LOCAL CONSTANTS\r
1770K0006, 0006\r
1771K0031, 31 /25(10)\r
1772K0175, 175 /125(10)\r
1773\r
1774/LOCAL CROSS-PAGE\r
1775CON9X, CON09B\r
1776CON02Y, CON02\r
1777CON05Z, CON05\r
1778CON22X, CON22\r
1779FMINY, FMINS\r
1780FMAXX, FMAXS\r
1781KMAXSZ, CON00-LOCORE-16 /FROM LOCORE TO CON00 FOR LISTS (-16 FOR NEXT JOB)\r
1782\r
1783CON16G, TAD NCHB /ORDER IN MX-B LIST\r
1784 DCA TORDER\r
1785 TAD K0040 /SET A/B BIT =1\r
1786 TAD SHFR\r
1787 DCA SHFR\r
1788CON16J, TAD SAMB /LO RESOLUTION SWEEP POINTS\r
1789 DCA TNSAM\r
1790EJECT\r
1791 \r
1792CON16B, TAD K0003 /INITIALIZE FOR NEW CHANNEL\r
1793 DCA TCHINC /HOW MUCH TO INCREMENT CORE USED FOR MX, CD LIST ENTRY\r
1794 TCHINC=TEMP20\r
1795 TAD K0006 /MOVE A/B, CHAN # TO TOP 6 BITS\r
1796 SHFT\r
1797 TAD TNSAM /IMAGE OF # DATA POINTS \r
1798 DCA TNSAMM\r
1799 TNSAMM=TEMP10\r
1800 TAD SHFR\r
1801 TAD TORDER\r
1802 TAD K0040 /ADD IN 1(1), CHAN ORD (5) TO BOTTOM 6 BITS\r
1803 DCA TJCHAN /SAVE FOR J-LIST\r
1804 TJCHAN=TEMP12\r
1805 TAD ADJLIS /SET POINTER TO TOP OF JOB LIST\r
1806 IAC\r
1807\fCON16C, DCA TJPNTR /SEARCH FOR SWEEP, CHAN # ALREADY ON J-LIST\r
1808 TAD I TJPNTR\r
1809 SNA\r
1810 JMP CON16E /FOUND END OF LIST (J1=0)\r
1811 AND K7700 /THESE BITS HOLD SWEEP TYPE AND CHAN #\r
1812 DCA TJMAT\r
1813 TJMAT=TEMP01\r
1814 TAD TJCHAN /NEW JOB'S J1 WORD\r
1815 AND K7700\r
1816 CMA IAC\r
1817 TAD TJMAT /MATCH BETWEEN TOP 6 BITS OF WORDS?\r
1818 SZA CLA\r
1819 JMP CON16D /NO MATCH, MOVE ON\r
1820 DCA TCHINC /FOUND A MATCH NO INCREASE IN MX- OR CD-LIST LENGTH\r
1821 DCA TNSAMM /NO NEW BUFFER AREA REQUIRED\r
1822 TAD I TJPNTR /CHAN ORDER IS SAME AS MATCHING J1'S\r
1823 DCA TJCHAN\r
1824CON16D, TAD K0007 /MOVE TO NEXT JOB\r
1825 TAD TJPNTR\r
1826 JMP CON16C\r
1827CON16H, FRAME /"? INSUFFICIENT MEMORY"\r
1828 ERR02\r
1829 JMP I CON13X /LF: START AT JOB 1\r
1830 JMP I CON15X /CR: RESTART CURRENT JOB\r
1831\r
1832/TTY LIST\r
1833YESNO, 31 /Y\r
1834 -16 /N\r
1835\r
1836/LOCAL CROSSPAGE\r
1837CON13X, CON13\r
1838CON15X, CON15\r
1839\r
1840CON16E, TAD TCHINC /UPDATE MIN SAMP INTV\r
1841 SNA CLA\r
1842 JMP CON16K\r
1843 TAD K0017 /NEW CHANNEL TAKES 15 USEC MORE TO ACQUIRE\r
1844 FLOAT\r
1845 FADD /OLD MIN SAMP INTV\r
1846 FTIMIN\r
1847 SAVE\r
1848 FTIMSV\r
1849 FADD /REQUIRED SAMP INTV\r
1850 FASI\r
1851 TAD FAC+1 /DOES THIS MAKE REQ. SAMPLING RATE IMPOSSIBLE?\r
1852 SPA SNA CLA\r
1853 JMP CON16K /NO-IT'S OK\r
1854 FRAME /"? TOO MANY INPUTS\r
1855 ERR05 /FOR SWEEP RATE"\r
1856 JMP I CON13X /RESTART FROM JOB 1 (LF)\r
1857 JMP I CON15X /RESTART THIS JOB (CR)\r
1858\fCON16K, TAD TCHINC /SEE IF THERE IS BUFFER ROOM\r
1859 TAD K0007\r
1860 CMA\r
1861 TAD TNSAMM\r
1862 DCA TDECF0 /HOW MUCH TO DECR FIELD0\r
1863 TDECF0=TEMP10\r
1864 CLL\r
1865 TAD TDECF0 /IS THERE ROOM?\r
1866 TAD TAVAIL\r
1867 SNL\r
1868 JMP CON16H /NO- INSUFFICIENT MEMORY\r
1869\r
1870CON16F, DCA TLEFT0 /FIELD 0 LEFT\r
1871 DCA TCMASK /INITIALIZE FOR NO CONTINGENCY MASK\r
1872 TCMASK=TEMP11\r
1873 TAD XROPT /DOES INSTALLATION HAVE XR OPTION?\r
1874 SNA CLA\r
1875 JMP CON18 /NO-SKIP QUESTION\r
1876\r
1877CON17, FRAME /"SORT CODE: '---'"\r
1878 DIS17\r
1879 JMP I CON15X /LF: RESTART JOB\r
1880 OCTARG\r
1881 JMP CON17 /FORMAT ERROR - ASK AGAIN\r
1882 AND K0377 /SET CONTINGENCY PART OF J2\r
1883 DCA TCMASK\r
1884CON18, IAC\r
1885 DCA TJTYPE /INITIALIZE JOB TYPE TO TYPE 1 (AVG ONLY)\r
1886 TJTYPE=TEMP07\r
1887 FRAME /"COMPUTE S.D.?: '-'\r
1888 DIS18 /(Y: YES)"\r
1889 JMP I CON15X /L.F.:RE-DO JOB\r
1890 ALPHA /GET ANSWER\r
1891 BRAN /Y FOR YES\r
1892 YESNO\r
1893 JMP .+3 /Y: YES\r
1894 JMP CON19A /N: NO\r
1895 JMP CON19A /OTHER - SAME AS N\r
1896 TWO /JOB TYPE SET TO TWO\r
1897 DCA TJTYPE\r
1898\fCON19, FRAME /"COMPUTE TREND?: '-'\r
1899 DIS19 /(Y: YES)"\r
1900 JMP CON18 /L.F. RE ASK VARIANCE\r
1901 ALPHA /GET ANSWER\r
1902 BRAN\r
1903 YESNO\r
1904 ISZ TJTYPE /Y: YES - SET JOB TYPE = 3\r
1905K7700, 7700 /N: NO (A NOP)\r
1906CON19A, TAD TJTYPE /UPDATE TOTAL AVAILABLE CORE\r
1907 BRAN /AFTER THIS JOB'S CALC REGION\r
1908 K0003 /IS SET ASIDE\r
1909 TAD K0004 /TYPE 3, NCELL=9\r
1910 TAD K0003 /TYPE 2, NCELL=5\r
1911 TAD K0002 /TYPE 1, NCELL=2\r
1912 DCA TNCELL /LOCATIONS REQUIRED PER DATA POINT\r
1913 TNCELL=TEMP02\r
1914 TAD TNCELL\r
1915 CMA IAC\r
1916 DCA TNCNT /FIND REQUIRED CORE FOR THIS JOB\r
1917 TNCNT=TEMP01\r
1918 CLA CMA\r
1919 DCA FOP+1\r
1920 TAD TDECF0 /FIGURE IN INCREASE IN MX, CD, AND J LISTS\r
1921 DCA FOP+2\r
1922 TAD TNSAM\r
1923 DCA FAC+2 /ADD (# OF POINTS)*(# OF LOCATIONS PER POINT)\r
1924 CMA\r
1925 DCA FAC+1\r
1926 DADD\r
1927 ISZ TNCNT /ADD IN # OF POINTS. (# OF LOCS) TIMES\r
1928 JMP .-2\r
1929 LOAD /DECREASE CURRENTLY AVAIL. MEMORY\r
1930 DAVAIL\r
1931 DADD\r
1932 TAD FOP+1\r
1933 DCA TEMP06\r
1934 TAD FAC+1 /# OF DATA FIELDS PREVIOUSLY AVAILABLE\r
1935 CMA\r
1936 TAD FOP+1 /- OF DATA FIELDS NOW AVAILABLE+1\r
1937EJECT\r
1938 \r
1939 DCA TLINKS /IS # OF BLOCKS (LINKAGE) REQUIRED\r
1940 TLINKS=TEMP01\r
1941 CLA CMA /PUT-(3 LOCS+1 DATA POINT) IN FAC\r
1942 DCA FAC+1\r
1943 TAD TNCELL\r
1944 TAD K0003\r
1945 CMA IAC\r
1946 DCA FAC+2\r
1947 DADD /SUBTRACT THIS AMOUNT FOR EACH LINKAGE REQUIRED\r
1948 JMP I .+1\r
1949 XX76NO\r
1950XX76BK, TAD FOP+1 /IS THERE ENOUGH MEMORY TO DO THIS JOB?\r
1951 SPA CLA\r
1952 JMP I CON16W /NO, INSUFFICIENT MEMORY\r
1953\r
1954\fCON20, LOAD /AMOUNT OF MEMORY LEFT (DBL PREC) WAS IN FOP\r
1955 FOP\r
1956 SAVE\r
1957 DAVAIL\r
1958 TAD TJCHAN /PUT A/B(1), CHAN#(5), 1(1), CHAN ORDER(5) IN J1\r
1959 DCA I TJPNTR\r
1960 TAD TJTYPE /PUT TYPE (4), SORT CODE(8) IN J2\r
1961 CLL RTR /TYPE# TO AC0-3\r
1962 RTR\r
1963 RAR\r
1964 TAD TCMASK /SORT CODE TO AC 8-11\r
1965 ISZ TJPNTR\r
1966 DCA I TJPNTR\r
1967 TAD TNCELL /PUT NCELL IN J3 FOR NOW\r
1968 ISZ TJPNTR\r
1969 DCA I TJPNTR\r
1970 TAD TNSAM /PUT NSAM IN J4 FOR NOW\r
1971 ISZ TJPNTR\r
1972 DCA I TJPNTR\r
1973 TAD K0004 /SKIP OVER J5, J6, AND J7\r
1974 TAD TJPNTR\r
1975 DCA TJPNTR\r
1976 DCA I TJPNTR /PUT EOL WORD AT CURRENT END OF JOB LIST\r
1977 TAD TCHINC /WAS THIS A NEW CHANNEL?\r
1978 SNA CLA\r
1979 JMP CON21 /NO.\r
1980 TAD TJCHAN /YES, INDEX CHANNEL COUNTER\r
1981 SMA CLA /WHICH ONE, A OR B?\r
1982 JMP CON21-1 /CHANNEL IS IN A-SWEEP\r
1983 ISZ NCHB /J1(0)=1 FOR B (LO-RESOLUTION)\r
1984 JMP CON21\r
1985\r
1986/LOCAL CROSS-PAGE\r
1987CON15Y, CON15\r
1988CON14X, CON14\r
1989CON16W, CON16H\r
1990\r
1991 ISZ NCHA /J1(0)=0 FOR A (HI-RESOLUTION\r
1992EJECT\r
1993 \r
1994CON21, TAD TNSAM /-# OF DATA POINTS\r
1995 FLOAT\r
1996 SAVE\r
1997 FLOT01\r
1998 LOAD /PRESET FAC FOR JOB TYPE 1\r
1999 AVGTIM /TIME TO AVERAGE ONE POINT\r
2000 TAD TJTYPE /GET THE JOB TYPE\r
2001 BRAN\r
2002 K0002\r
2003 JMP CON21B /JOB TYPE=2, AVG AND VAR\r
2004 JMP CON21A /JOB TYPE=1, AVG ONLY\r
2005 FADD /JOB TYPE=3 (OTHER), AVG, VAR, AND TREND\r
2006 TRNTIM /TIME TO TAKE TREND OF ONE POINT\r
2007CON21B, FADD /ADD TIME TO TAKE VARIANCE ON ONE POINT\r
2008 VARTIM\r
2009\fCON21A, FMUL /MULTIPLY BY NUMBER OF POINTS\r
2010 FLOT01\r
2011 FADD /UPDATE BUSY TIME\r
2012 CALTIM\r
2013 SAVE\r
2014 CALTIM\r
2015 ISZ TNJOB /UPDATE JOB NUMBER\r
2016 TAD TCHINC /INCREASE LIST LENGTH\r
2017 TAD K0007\r
2018 TAD TSZLST /UPDATE AREA LEFT FOR JOB LIST\r
2019 SMA /OUT OF RESERVED AREA?\r
2020 JMP I CON14X /NO- GET NEXT JOB'S PARAMETERS\r
2021\r
2022/FIX PARAMETERS AND POINTERS\r
2023CON22, CLA\r
2024 TAD TNJOB /JOBS HAVE ALL BEEN CHOSEN\r
2025 SNA CLA /THERE MUST BE AT LEAST ONE JOB\r
2026 JMP I CON15Y /IF NOT RETURN TO SPECIFY ONE\r
2027 TAD TJPNTR /SET UP MX AND CD LIST POINTERS\r
2028 DCA ADMPXA /START OF MX LIST-1 (HI RESOLUTION)\r
2029 TAD ADMPXA\r
2030 TAD NCHA\r
2031 IAC\r
2032 DCA ADMPXB /START OF LO MPLX LIST\r
2033 TAD ADMPXB\r
2034 TAD NCHB\r
2035 DCA ADCHNL /START OF CHANNEL LIST-1\r
2036 TAD NCHA\r
2037 TAD NCHB\r
2038 IAC\r
2039 CLL RAL /LENGTH OF CH LIST=2*NCHA+1+2*NCHB+1\r
2040 TAD ADCHNL\r
2041 DCA ADBUFA /START OF ADC BUFFER-A\r
2042 LOAD /SAMPLES IN SWEEP-A\r
2043 FSAMA\r
2044 FIX\r
2045 TAD KM0001\r
2046 DCA SAMA\r
2047\r
2048 TAD NCHA /# CHANNELS IN A\r
2049 CMA IAC\r
2050 FLOAT\r
2051 SAVE\r
2052 FLOT01 /LENGTH OF BUFFER-A IS #SAMPLES * #CHANNELS\r
2053 TAD SAMA\r
2054 FLOAT\r
2055 FMUL\r
2056 FLOT01\r
2057 FIX\r
2058 DCA LNBUFA /LNBUFA IS POSITIVE\r
2059 LOAD\r
2060 FLOT01\r
2061\f FMUL /FADEL IS # OF SAMPLE TIMES BACK\r
2062 FADEL\r
2063 FIX /GET PHYSICAL DISTANCE BACK\r
2064 TAD ADBUFA\r
2065 TAD KM0001\r
2066 CMA IAC\r
2067 DCA ADEL /-(ADBUFA +DISTANCE BACK)=ADEL\r
2068 LOAD /GET SAMPLES IN B\r
2069 FSAMB\r
2070 FIX\r
2071 TAD KM0001\r
2072 DCA SAMB\r
2073 TAD NCHB /GET PHYS. LENGTH OF BUFFER-B\r
2074 CMA IAC\r
2075 FLOAT\r
2076 SAVE\r
2077 FLOT01\r
2078 TAD SAMB\r
2079 FLOAT\r
2080 FMUL\r
2081 FLOT01\r
2082 FIX\r
2083 DCA LNBUFB /LENGTH OF B (IN LOCATIONS)\r
2084\r
2085 TAD ADBUFA /START OF ADC BUFFER FOR HIGH RESOLUTION-1\r
2086 TAD LNBUFA\r
2087 DCA ADBUFB /START OF ADC BUFFER FOR LOW RESOLUTION-1\r
2088\r
2089 LOAD /GET DISTANCE BACK IN BUFFER FOR START OF B\r
2090 FLOT01\r
2091 FMUL\r
2092 FBDEL\r
2093 FIX\r
2094 TAD ADBUFB\r
2095 TAD KM0001\r
2096 CMA IAC\r
2097 DCA BDEL /-(ADBUFA+DISTANCE BACK IN B)\r
2098\r
2099 TAD LNBUFA /IS THERE AN A-SWEEP?\r
2100 SNA CLA\r
2101EJECT\r
2102 \r
2103 JMP .+5 /NO, SET KBLA TO 0\r
2104 LOAD /POINTS TO GET AT SYNC TIME IN A\r
2105 FBLA\r
2106 FIX\r
2107 TAD KM0001\r
2108 DCA KBLA\r
2109\r
2110 TAD LNBUFB /IS THERE A B-SWEEP?\r
2111 SNA CLA\r
2112 JMP CON22A /NO- THERE ARE 0 POINTS TO GET AT SYNC TIME\r
2113 LOAD /YES\r
2114 FBLB\r
2115 FIX\r
2116 TAD KM0001\r
2117\fCON22A, DCA KBLB /B-POINTS TO GET AT SYNC TIME\r
2118 LOAD /GET TIME FROM SYNC POINT TO SYNC TIME\r
2119 KSYTIM-1\r
2120 DFIX\r
2121 KSYTIM\r
2122 TAD ADJLIS /SET POINTER TO START OF JOB LIST\r
2123 IAC\r
2124CON23, DCA TJPNTR /MAKE UP MULTIPLEXOR LIST\r
2125 TAD I TJPNTR /GET J1\r
2126 SNA\r
2127 JMP CON24 /J1=0 IMPLIES END OF LIST\r
2128 AND K4037 /GET CHANNEL ORDER AND SWEEP\r
2129 SPA\r
2130 IAC /SWEEP-B\r
2131 SNA SPA\r
2132 TAD NCHA /(ORDER 0, SWEEP A) OR SWEEP B\r
2133 AND K0037A\r
2134 TAD ADMPXA\r
2135 DCA TCHLOC /ADDRESS FOR ENTRY IN MX-LIST\r
2136 TCHLOC=TEMP01\r
2137 TAD I TJPNTR /GET CHANNEL # FOR THIS JOB\r
2138 RTR\r
2139 RTR\r
2140 RTR\r
2141 AND K0037A\r
2142 DCA I TCHLOC /STORE IN ADDRESS CALCULATED\r
2143 TAD K0007 /MOVE POINTER TO NEXT J1\r
2144 TAD TJPNTR\r
2145 JMP CON23\r
2146\r
2147/LOCAL CONSTANTS\r
2148KM0014, -0014\r
2149K4037, 4037\r
2150K0037A, 0037\r
2151K0175A, 0175\r
2152\r
2153/THIS SUBROUTINE GETS MAX-X FOR A DISPLAY GROUP\r
2154EJECT\r
2155 \r
2156XMAXS, 0\r
2157 DCA TNPT /# OF POINTS\r
2158 TNPT=TEMP03\r
2159 JMS I SDISX /GET XZERO AND DELTAX\r
2160 JMP XMEXIT /NO MORE ENTRIES IN DISPLAY LIST\r
2161 LOAD /FIND #PTS*DELTAX+XZERO\r
2162 DELTAX\r
2163 DELTAX=FLOT01\r
2164 NORM /DELTAX*2^12\r
2165 TAD KM0014\r
2166 DCA FAC\r
2167 SAVE\r
2168 FLOT01 /DELTAX*2^12/2^12\r
2169 TAD FOP+1 /FOP HOLDS X0\r
2170 DCA TXZ\r
2171 TXZ=TEMP13\r
2172\f TAD TNPT /#PTS*DELTAX\r
2173 FLOAT\r
2174 FMUL\r
2175 FLOT01\r
2176 DCOM\r
2177 TAD K0002\r
2178 FIX\r
2179 CLL RTR\r
2180 TAD TXZ /+(X-ZERO)\r
2181 DCA I BXPNTR /MAXIMUM-X FOR THIS DISPLAY\r
2182 TAD TXZ\r
2183 DCA FOP+1\r
2184 JMP I XMAXS\r
2185\r
2186XMEXIT, ISZ XMAXS\r
2187 JMP I XMAXS\r
2188\r
2189/LOCAL CROSSPAGE\r
2190CON13Z, CON13\r
2191SDISX, SDISS\r
2192\r
2193/ASK LAST OF SWEEP PARAMETER QUESTIONS\r
2194CON24, TAD K0175A /SWEEP TIME+(CALCTIME*ASI)/(AS1-125US)\r
2195 FLOAT\r
2196 FADD\r
2197 FASI\r
2198 SAVE /(ASI-125US)\r
2199 FLOT01 /TIME LEFT FOR CALCULATIONS BETWEEN INTERRUPTS\r
2200 LOAD /-TIME TO DO CALCULATIONS AT 100% PROCESSOR AVAILABILITY\r
2201 CALTIM\r
2202 FDIV /ADJUST FOR ACTUAL AVAILABILITY\r
2203 FLOT01\r
2204 FADD /INCLUDE TIME TO ACCEPT SWEEP\r
2205 FSWTIM\r
2206 FMUL\r
2207 FASI /PUT IN TERMS OF USEC\r
2208 FADD\r
2209 FASI\r
2210 SAVE\r
2211 CALTIM\r
2212 DCOM\r
2213 SETH /THIS IS MIN TIME BETWEEN SWEEPS\r
2214 DIS24\r
2215 FLTOUT\r
2216CON24A, FRAME /"LEAST SWEEP INTERVAL\r
2217 DIS24 /'-----' ':'S [>SDDDDD MS]"\r
2218 JMP I CON13Z /L.F.: RE SELECT JOBS\r
2219 FLTARG\r
2220 JMP CON24A /FORMAT ERROR-TRY AGAIN\r
2221\f SAVE\r
2222 FSYNTM\r
2223 FSYNTM=FLOT01\r
2224 FADD /BUSY TIME (CALTIM) .GT. INTER SYNC TIME?\r
2225 CALTIM\r
2226 TAD FAC+1\r
2227 SPA CLA\r
2228 JMP CON24A /YES-TRY AGAIN\r
2229 CLA CMA /NO- PUT EOL WORDS IN MX-LISTS\r
2230 TAD ADMPXB\r
2231 DCA MPXPNT\r
2232 MPXPNT=TEMP01\r
2233 CLL CLA CML RAR /FIRST PUT EOMX WORDS IN PLACE\r
2234 TAD I MPXPNT /4000+FIRST CHAN (ORD=0) IN A TO END OF MXA-LIST\r
2235 DCA I MPXPNT\r
2236 TAD I MPXPNT /4000+ORD(0) OF A TO END OF MXB-LIST\r
2237 DCA I ADCHNL\r
2238 LOAD /GET ITIM FOR S0 FIRING\r
2239 FSYNTM\r
2240 FDIV /PUT IN TERMS OF ASI\r
2241 FASI\r
2242 SAVE /- TIME FOR S0 TO FIRE\r
2243 FITIM\r
2244 FITIM=FLOT02\r
2245 LOAD\r
2246 FSWBEG /GET TIME FOR ADC BUFFER OPENING\r
2247 FADD\r
2248 KM001F\r
2249 TAD FAC+1 /DOES SWEEP BEGIN BEFORE SYNC?\r
2250 SPA CLA /- TIME OF SWEEP START\r
2251 JMP CON24B /NO\r
2252 FADD /YES- TIME IT FROM PREVIOUS SWEEP\r
2253 FITIM /CONSTRAINT IS THAT SWEEPS INTERVAL IS >ITIM\r
2254CON24B, DFIX\r
2255 KWTIM /TIME TO OPEN BUFFER WINDOWS\r
2256 LOAD\r
2257 FASI\r
2258 DFIX /GET ASI IN USEC\r
2259 ASI\r
2260\r
2261EJECT\r
2262 \r
2263CON25, FRAME /"AVERAGE '----' SWEEPS"\r
2264 DIS25\r
2265 JMP CON25 /CAN'T CHANGE JOBS OR SWEEP PARAMETERS\r
2266 DECARG\r
2267 JMP CON25 /FORMAT ERROR - ASK AGAIN\r
2268 CMA IAC\r
2269 DCA NSWEP /-# OF SWEEPS REQUIRED\r
2270 JMP CON26\r
2271\r
2272/AUTO INDEX USE\r
2273 AXPNTR=10\r
2274 BXPNTR=11\r
2275\f/GET PARAMETERS REQUIRED FOR DISPLAY WORD GENERATION\r
2276PREDWS, 0\r
2277 DCA ND /# OF CURVES TO FIT ON SCOPE\r
2278 ND=TEMP03\r
2279 TAD ND /SET COUNT OF REQUIRED DISPLAY ENTRIES\r
2280 JMS SETCNS\r
2281 JMP I PREDWS /COUNT IS 0. EXIT\r
2282 CLA CMA /GET # OF COLUMNS REQUIRED\r
2283 TAD ND\r
2284 CLL RAR\r
2285 CLL RAR /(# OF CURVES/4)+1\r
2286 IAC\r
2287 FLOAT\r
2288 SAVE\r
2289 FLOT01 /# OF COLUMNS TO FIT ON SCOPE\r
2290 TAD ND /HOW MANY ROWS?\r
2291 BRAN\r
2292 K0002\r
2293 IAC /IF # OF CURVES IS 2, 2 ROWS (SCALE Y BY 2^1)\r
2294 SKP /IF # OF CURVES IS 1. 1 ROW (SCALE Y BY 2^0)\r
2295 TWO /OTHERWISE , 4 ROWS (SCALE Y BY 2^2)\r
2296 DCA YSS\r
2297 YSS=TEMP14\r
2298 TWOK /#POINTS ON DISPLAY *2\r
2299 FLOAT\r
2300 FDIV\r
2301 FLOT01\r
2302 FIX\r
2303 DCA XZD /DISTANCE BETWEEN COLUMNS *2\r
2304 XZD=TEMP15\r
2305 TAD YSS /GET Y-ZERO FOR 1ST ROW IN COLUMNS\r
2306 BRAN\r
2307 K0002\r
2308 TAD K0010 /4 ROWS, START AT Y=300\r
2309 TAD K0020 /2 ROWS, START AT Y=200\r
2310 DCA YZZ /1 ROW, START AT Y=000\r
2311 YZZ=TEMP16\r
2312 TAD YSS /GET Y-ZERO DECR TO GO FROM NTH TO N+1TH ROW\r
2313 CMA\r
2314 DCA TYSC\r
2315 TYSC=TEMP01\r
2316 TAD KM0200 /(-200)/2^(Y-SCALE+1)\r
2317 CLL CML RAR\r
2318 ISZ TYSC\r
2319 JMP .-2\r
2320 DCA YZD /0,-40,OR -20\r
2321 YZD=TEMP17\r
2322 TAD K1001A\r
2323 JMS PRESTY /SET UP FOR 1ST COLUMN\r
2324 JMP I PREDWS\r
2325\f/SUBROUTINE PRESETS Y AND X FOR NEW COLUMN\r
2326PRESTY, 0\r
2327 DCA XZ /X-ZERO IN AC\r
2328 XZ=TEMP20\r
2329 TAD YZZ /RESET TO TOP OF COLUMN\r
2330 DCA YZW\r
2331 YZW=TEMP21\r
2332 TAD KM0004 /4 ROWS (MAXIMUM) TO A COLUMN\r
2333 DCA UPCNT\r
2334 UPCNT=TEMP30\r
2335 JMP I PRESTY\r
2336\r
2337/GET DISPLAY WORDS FOR A GROUP - ENTER WITH # OF PTS IN AC\r
2338GETDWS, 0\r
2339 CMA IAC /#OF POINTS TO DISPLAY\r
2340 FLOAT\r
2341 SAVE\r
2342 FLOT01\r
2343 TAD XZD /DISTANCE BETWEEN COLUMNS\r
2344 FLOAT /2*ROOM AVAILABLE/#POINTS = X-DIST BETWEEN POINTS*2\r
2345 FDIV\r
2346 FLOT01\r
2347 TAD K0007 /SCALE BY 2^7\r
2348 FIX /(DELTA-X)*2^8\r
2349 AND K7760 /DELTAX(8),0(4)\r
2350 TAD YSS /DELTAX(8),Y-SCALE(4)\r
2351 DCA I AXPNTR /THIS IS D1.\r
2352\r
2353 TAD XZ /GET X-ZER0*2\r
2354 RTL\r
2355 AND K7700B /X-ZER0(6),0(6)\r
2356 TAD YZW /X-ZERO(6),Y-ZERO(6)\r
2357 DCA I AXPNTR /THIS IS D2.\r
2358\r
2359 TAD YZW /MOVE TO NEXT ROW\r
2360 TAD YZD\r
2361 AND K0077C\r
2362 DCA YZW\r
2363\r
2364 ISZ UPCNT /4 COLUMNS DONE?\r
2365 JMP .+4 /NO-CONTINUE\r
2366 TAD XZ /YES-MOVE TO NEXT COLUMN\r
2367 TAD XZD\r
2368 JMS PRESTY /SET UP FOR NEXT COLUMN.\r
2369 ISZ CHCNT /ALL GROUPS COMPLETE?\r
2370 JMP I GETDWS /NO-EXIT AT CALL+1\r
2371 ISZ GETDWS /YES-EXIT TO CALL+2\r
2372 JMP I GETDWS\r
2373\r
2374\f/SET COUNT OF # OF GROUPS\r
2375SETCNS, 0\r
2376 SNA\r
2377 JMP I SETCNS /0, EXIT AT CALL+1\r
2378 CMA IAC\r
2379 DCA CHCNT\r
2380 CHCNT=TEMP13\r
2381 ISZ SETCNS /NOT 0, EXIT AT CALL+2\r
2382 JMP I SETCNS\r
2383\r
2384/LOCAL CONSTANTS\r
2385K0077C, 0077\r
2386K7700B, +7700\r
2387K0020, +0020\r
2388KM0200, -0200\r
2389K7760, +7760\r
2390K0010, 10\r
2391\r
2392/MAKE UP DISPLAY ENTRIES FOR JOBS AND CHANNELS\r
2393CON26, TAD ADJLIS /MAKE UP JOB DISPLAY WORDS\r
2394 DCA AXPNTR\r
2395 TAD TNJOB /NUMBER OF CURVES ON SCOPE\r
2396 JMS I PREDWX\r
2397CON26A, TAD AXPNTR /SKIP J1,J2,J3\r
2398 TAD K0003\r
2399 DCA AXPNTR\r
2400 TAD I AXPNTR /J4 HOLDS -#OF POINTS\r
2401 ISZ AXPNTR /SKIP OVER J5\r
2402 JMS I GETDWX /J6 AND J7 ARE DISPLAY WORDS\r
2403 JMP CON26A /DO NEXT JOB\r
2404 TAD ADCHNL /ALL DONE\r
2405 DCA AXPNTR /MAKE UP CHANNEL DISPLAY WORDS\r
2406 TAD NCHA /GET NUMBER OF CHANNELS IN ALL\r
2407 TAD NCHB\r
2408 JMS I PREDWX /DIVIDE UP SCOPE FOR TOTAL # OF CHAN\r
2409 TAD NCHA\r
2410 JMS I SETCNX /SET COUNT OF DISPLAYS WITH "SAMA" POINTS\r
2411 JMP CON26B /NONE-TRY LO-RESOLUTION\r
2412 TAD SAMA /SET UP DISPLAY FOR HI CHANS\r
2413 JMS I GETDWX\r
2414 JMP .-2\r
2415CON26B, DCA I AXPNTR /EOL WORD FOR HI INPUTS\r
2416 TAD NCHB /SET COUNT OF DISPLAYS WITH "SAMB" POINTS\r
2417 JMS I SETCNX\r
2418 JMP CON26C /NONE-GO TO MODIFY\r
2419 TAD SAMB /SET UP DISPLAY FOR LO CHANS\r
2420 JMS I GETDWX\r
2421 JMP .-2\r
2422CON26C, DCA I AXPNTR /EOL WORD FOR LO INPUTS\r
2423\f/DISPLAY AND MODIFY INPUT PRESENTATION\r
2424 TAD ADCHNL /GET X-MAXIMA FOR EACH INPUT\r
2425 DCA AXPNTR\r
2426 TAD ADBUFA /PUT IN ADC BUFFER\r
2427 DCA BXPNTR\r
2428 TAD I ADCHNL /PUT 1ST CHAN IN ADMPXA\r
2429 DCA I ADMPXA\r
2430 TAD SAMA /GET HI RESOLUTION X-MAX'S\r
2431 JMS I XMAXX\r
2432 JMP .-2\r
2433 TAD SAMB /GET LO RESOLUTION X-MAX'S\r
2434 JMS I XMAXX\r
2435 JMP .-2\r
2436 DCA TMOD /TMOD=0 FOR NO MODIFICATIONS\r
2437 TMOD=TEMP16\r
2438CON27, TAD ADCHNL /DISPLAY WORDS BEGIN AT ADCHNL-1\r
2439 JMS I CON1SX\r
2440 FRAME /"$FA41INPUTS$AP21"\r
2441 DIS27\r
2442 NOP /THIS IS SKIPPED\r
2443 JMS I CRBRAX /BRANCH ON KEYBOARD\r
2444 JMP .+3 /NO CHARACTER\r
2445 JMP CON29 /C.R.:ALLOCATION OK\r
2446 NOP /L.F. FORGET IT\r
2447 CLA CMA /OTHER: GET CHANNEL NUMBERS IN ORDER\r
2448 TAD ADMPXA \r
2449 DCA CXPNTR\r
2450 CXPNTR=12\r
2451CON27A, JMS SDISS\r
2452 JMP CON27B /OUT OF HI CHANNELS-GO TO LOW\r
2453 TAD K1000B /PUT "H@" IN SWEEP MESSAGE\r
2454 JMS I CON2SX /DISPLAY DOTS AND MESSAGE\r
2455 JMP CON27A /GET NEXT CHANNEL\r
2456CON27B, ISZ CXPNTR /SKIP OVER FIRST OF HI\r
2457 JMS SDISS\r
2458 JMP CON27 /OUT OF CHANNELS, RESTART\r
2459 TAD K1400 /PUT "L@" IN SWEEP MESSAGE\r
2460 JMS I CON2SX /DISPLAY DOTS AND MESSAGE\r
2461 JMP CON27B+1\r
2462\r
2463/LOCAL CONSTANTS\r
2464K1000B, 1000\r
2465K1400, 1400\r
2466KM0006, -0006\r
2467\f/LOCAL CROSSPAGE\r
2468XMAXX, XMAXS\r
2469OTTY, CON30-1\r
2470CON1SX, CON1S\r
2471CON2SX, CON2S\r
2472CRBRAX, CRBRAS\r
2473GETDWX, GETDWS\r
2474PREDWX, PREDWS\r
2475SETCNX, SETCNS\r
2476\r
2477/THIS SUBROUTINE DECODES DISPLAY WORDS: SDIS\r
2478/POINTER IS AUTOINDEX REGISTER "AXPNTR"\r
2479/CALL: SDIS\r
2480/ END OF LIST RETURN\r
2481/ NORMAL RETURN\r
2482\r
2483SDISS, 0\r
2484 TAD I AXPNTR /DX (8),YS(4)\r
2485 SNA\r
2486 JMP I SDISS /EOL IF D1=0, RETURN TO CALL+1\r
2487 DCA SHFR+1\r
2488 TAD SHFR+1\r
2489 AND K0017 /HAVE Y SCALE FACTOR\r
2490 DCA YS\r
2491 YS=TEMP17\r
2492 DCA SHFR /0 TO HI FAC\r
2493 TAD K0004\r
2494 IAC\r
2495 SHFT /MOVE BINARY POINT TO END OF SHFR+1\r
2496 SAVE /DX(8) IS INTEGER PART (5), FRACTIONAL PART (3)\r
2497 DELTAX\r
2498 TAD I AXPNTR /XZ(6),YZ(6)\r
2499 DCA SHFR+1\r
2500 TAD K0004 /MOVE YZ TO 10 SIGNIF, BITS\r
2501 SHFT\r
2502 TAD SHFR+1\r
2503 DCA YZ /POSITION OF Y-ZERO\r
2504 YZ=TEMP20\r
2505 TAD KM0006 /MOVE XZ TO 10 BITS OF SHFR+1\r
2506 SHFT\r
2507 TAD SHFR+1\r
2508 AND KM0006 /7772 - IGNORE SCALE PART (MOSTLY)\r
2509 DILX /LOAD X\r
2510 DCA DBLARG /DBLARG & DBLARG+1 HOLD X-POSITION\r
2511 ISZ SDISS /EXIT TO CALL+2\r
2512 JMP I SDISS\r
2513\f/SUBROUTINE SCALES, BIASES, AND DISPLAYS Y: YDIS\r
2514/USES "YS", "YZ", FROM SDIS, Y VALUE IN DBLAC AT CALL\r
2515YDISS, 0\r
2516 DCA SHFR /VALUE TO BE SCALED, BIASED\r
2517 TAD YS /SCALE IT\r
2518 CMA IAC\r
2519 SHFT\r
2520 TAD YZ /ADD BIAS\r
2521 TAD SHFR /GET SCALED VALUE\r
2522 DILY /DISPLAY IT\r
2523 CLA\r
2524 DISD\r
2525 JMP .-1\r
2526 DIXY\r
2527 JMP I YDISS\r
2528\r
2529CON29, DCA I ADMPXA /REPLACE EOL FOR JOB LIST\r
2530 LOAD /ASI BETWEEN SYNCS\r
2531 FITIM\r
2532 DFIX /FIX TO DOUBLE-WORD\r
2533 KITIM\r
2534 TAD ADBUFA /PUT X-MAXIMUMS IN ADC BUFFER\r
2535 DCA BXPNTR\r
2536 TAD ADJLIS /TAKE PARAMETERS FROM JOB LIST\r
2537 DCA AXPNTR\r
2538CON29A, TAD I AXPNTR /LOOK AT J1\r
2539 SNA CLA\r
2540 JMP I OTTY /J1=0,END OF LIST\r
2541 ISZ AXPNTR /SKIP J2,J3\r
2542 ISZ AXPNTR\r
2543 TAD I AXPNTR /J4 HAS # OF POINTS\r
2544 ISZ AXPNTR /SKIP J5\r
2545 JMS I XMAXY /FIND MAX-X USING J6 AND J7\r
2546 JMP I CON29B /GET NEXT JOB\r
2547\r
2548 DCA TMOD /MODIFY WHICH? -0 (NONE) TO BEGIN WITH\r
2549CON30, TAD ADJLIS\r
2550 JMS I CON1SY /INITIALIZE POINTERS & COUNTERS\r
2551 FRAME /"$EA41AVERAGES$"\r
2552 DIS30\r
2553CON1SY, CON1S /SKIPPED\r
2554 JMS CRBRAS /BRANCH ON CR OR LF\r
2555 JMP CON30A /NEITHER CR OR LF\r
2556 JMP CON32 /C.R.:ALLOCATION OK\r
2557 JMP CON30A /L.F.:CHANGE ALLOCATION\r
2558\r
2559/LOCAL CROSSPAGE\r
2560SDISZ, SDISS\r
2561CON29B, CON29A\r
2562\fCON30A, TAD I AXPNTR /DISPLAY AVERAGES ALLOCATIONS\r
2563 SNA CLA /J1=0?\r
2564 JMP CON30 /YES-START OVER\r
2565 ISZ AXPNTR /SKIP J2 AND J3\r
2566 ISZ AXPNTR\r
2567 TAD I AXPNTR /J4 HAS # OF POINTS\r
2568 DCA TPSAVE\r
2569 TPSAVE=TEMP02\r
2570 ISZ AXPNTR /SKIP J5\r
2571 JMS I SDISZ /SET UP DISPLAY: J6 J7 ARE DISPLAY WORDS\r
2572DLIMX, DLIMS /SKIPPED\r
2573 SETH\r
2574 DIS30A /DISPLAY LIMIT DOTS AND JOB #\r
2575 JMS I DLIMX /LIMIT DOTS, PUT JOB # IN BUFFER\r
2576 SETH\r
2577 DIS30A /JOB#\r
2578 LDH\r
2579 JMS I DSCX\r
2580 JMP .-2\r
2581 JMP CON30A /GET NEXT JOB\r
2582\f\r
2583F4K, 0015\r
2584 2000\r
2585 0000\r
2586\r
2587TEMP, 0\r
2588 0\r
2589 0\r
2590\f\r
2591/LOCAL CROSSPAGE\r
2592XMAXY, XMAXS\r
2593DSCX, DSCS\r
2594\r
2595\r
2596/SUBROUTINE TO BRANCH AND ECHO KBD CR OR LF\r
2597CRBRAS, 0\r
2598 KSF /KEYBOARD STRUCK?\r
2599 JMP I CRBRAS /NO-EXIT TO CALL+1\r
2600 KRB /YES- READ IT IN\r
2601 BRAN /CHECK FOR CR OR LF\r
2602 CRLF\r
2603 ISZ CRBRAS /LF - EXITS TO CALL+3\r
2604 SKP /CR - EXITS TO CALL+2\r
2605 JMP I CRBRAS /OTHER - EXITS TO CALL+1\r
2606 TAD KCR /FOR CR OR LF - TYPE CRLF\r
2607 TYPE\r
2608 ISZ CRBRAS /EXIT TO CALL+2(CR) OR CALL+3(LF)\r
2609 JMP I CRBRAS\r
2610\f *4372\r
2611/OUTPUT CONTROL TAPE OR MODIFY MEMORY\r
2612CON32, FRAME /"PUNCH CONTROL TAPE? '-'\r
2613 DIS32 /(Y: YES)"\r
2614 JMP CON32 /LF: CAN'T GO BACK - ASK AGAIN\r
2615 DCA TENPUN /INITIALIZE FOR "NO PUNCH"\r
2616 TENPUN=TEMP30\r
2617 ALPHA /GET RESPONSE\r
2618 BRAN\r
2619 YESNO\r
2620 ISZ TENPUN /Y: YES, TENPUN=1 TO ALLOW PUNCHING\r
2621 CLA /*** TITLE NOT ASKED,A MS. DEVICE WRITTEN ON.\r
2622 SNA CLA /OTHER\r
2623 JMP CON32B /NO PUNCH - DON'T ASK FOR TITLE\r
2624CON32A, FRAME /"TITLE:\r
2625 DIS32A /'-------------'"\r
2626 JMP CON32A /LF: ASK AGAIN\r
2627 JMS I INITOX /INITIALIZE SYS DEVICE (OUTPUT)\r
2628 TAD TXMRK /MOVE HALFWORD POINTER TO TITLE\r
2629 SRCH\r
2630K0006B, 0006 /SKIPPED\r
2631 JMS I TITLEX /VISUAL MODE TITLE ON TAPE\r
2632 TXPUN /DO 3 CRLF'S\r
2633 TXCRLF\r
2634 SETH /REPOSITION HALFWORD POINTER TO TITLE\r
2635 DIS32A\r
2636 TPUNQ /OUTPUT TITLE TO SYS DEV.\r
2637CON32B, TXPUN /"<CRLF>SWEEP SUMMARY<CRLF>"\r
2638 TXT32\r
2639 TXPUN /OUTPUT SUMMARY\r
2640 DIS09 /END WITH 2 CRLF'S\r
2641 TXPUN /" AVERAGES\r
2642 TXT32A /CHAN RATE TYPE SORT<CRLF>"\r
2643CON33, TAD ADJLIS /GO THRU JOB LIST FOR THIS INFO\r
2644 IAC\r
2645 DCA TOPNT\r
2646 TOPNT=TEMP07\r
2647\fCON33A, SETH /".XX.....X....X....XXX<CRLF>"IS FORMAT\r
2648 TXT33A\r
2649 TAD I TOPNT /GET J1\r
2650 SNA /J1=0?\r
2651 JMP I CON34X /YES-END OF JOB LIST\r
2652 DCA SHFR /J1 = A/B(1), CHAN#(5), 1(1), CHAN ORDER (5)\r
2653 ISZ TOPNT\r
2654 TAD I TOPNT /J2=TYPE (4), SORT CODE (8)\r
2655 DCA SHFR+1\r
2656 TAD SHFR+1 /GET SORT CODE\r
2657 AND K0377\r
2658 DCA TCNTG\r
2659 TCNTG=TEMP03\r
2660 TAD KM06 /SHIFT J1,J2 RIGHT 6\r
2661 SHFT\r
2662 TAD SHFR /CHAN # IN AC7-11\r
2663 AND K0037B\r
2664 DCA TCHN\r
2665 TCHN=TEMP04\r
2666 MTW /MOVE JOB TYPE TO SHFR+1 BITS 8-11\r
2667 SHFT\r
2668 TAD SHFR /SIGN EXTENSION IN SHFTS SO BIT 0 OF SHFR HOLDS A/B\r
2669 SPA CLA\r
2670 TAD K0004 /L FOR LO\r
2671 TAD K4010 /H FOR HI\r
2672 DCA I TXT33X /PUT IT IN MESSAGE\r
2673 TAD SHFR+1\r
2674 AND K0017 /GET TYPE\r
2675 DCA TJOB\r
2676 TJOB=TEMP05 /OUTPUT CHAN # TO BUFFER\r
2677 TAD TCHN\r
2678 OCTOUT\r
2679 TAD TJOB /OUTPUT TYPE TO BUFFER\r
2680 OCTOUT\r
2681 TAD TCNTG /OUTPUT SORT CODE TO BUFFER\r
2682 OCTOUT\r
2683 TXPUN /OUTPUT BUFFER TO TTY\r
2684 TXT33A\r
2685 TAD K0006B /MOVE TO NEXT J1\r
2686 TAD TOPNT\r
2687 DCA TOPNT\r
2688 JMP CON33A /DO NEXT JOB\r
2689\f/SUBROUTINE TO DISPLAY DOTS AT EXTREMA,POSITION, DSC,AND SEQ.\r
2690DLIMS, 0\r
2691 TAD FOP+1 /SET X TO X-ZERO\r
2692 DILX\r
2693 CLA IAC\r
2694 TAD KM1000 /SET Y TO BOTTOM\r
2695 JMS I YDISX /DISPLAY LOWER LEFT DOT\r
2696 TAD K0777 /SET Y TO TOP\r
2697 JMS I YDISX /DISPLAY UPPER LEFT\r
2698 TAD I BXPNTR /SET X TO MAX\r
2699 DILY /DISPLAY UPPER RIGHT\r
2700 DISD\r
2701 JMP .-1\r
2702 DIXY\r
2703 CLA IAC\r
2704 TAD KM1000 /SET Y TO BOTTOM\r
2705 JMS I YDISX /DISPLAY BOTTOM RIGHT\r
2706 TAD FOP+1 /POSITION DSC\r
2707 DCA I XDSCX\r
2708 TAD YZ /IN MIDDLE RIGHT OF FIELD\r
2709 DCA I YDSCX\r
2710 ISZ TDCNTR /NEXT SEQUENCE #\r
2711 TAD TDCNTR /PUT IT IN MESSAGE FOR DISPLAY\r
2712 OCTOUT\r
2713 JMP I DLIMS\r
2714\r
2715/LOCAL CROSSPAGE\r
2716XDSCX, CHXL\r
2717YDSCX, CHYL\r
2718YDISX, YDISS\r
2719K0777, 777\r
2720\r
2721/SUBROUTINE TO INITIALIZE PARAM POINTERS AND DISPLAY MESSAGE\r
2722CON1S, 0\r
2723 DCA AXPNTR /POINTER TO DISPLAY WORDS\r
2724 TAD ADBUFA /POINTER TO X-MAX LIST\r
2725 DCA BXPNTR\r
2726 DCA TDCNTR /SET SEQUENCE # TO 0\r
2727 TDCNTR=TEMP14\r
2728 TAD TMOD /SET MODIS COUNTER\r
2729 DCA TMDCNT\r
2730 TMDCNT=TEMP15\r
2731 JMP I CON1S\r
2732\f/SUBROUTINE TO DISPLAY LIMIT DOTS WITH MESSAGE FOR INPUT DISPLAY\r
2733CON2S, 0\r
2734 DCA I DIS27X /PUT SWEEP TYPE IN MESSAGE\r
2735 SETH /"XX:XX,X"\r
2736 DIS27A\r
2737 JMS DLIMS /DISPLAY LIMIT DOTS AND FILL ITEM #\r
2738 TAD I CXPNTR /GET CHANNEL NUMBER\r
2739 AND K0037B\r
2740 OCTOUT /FILL SPACE FOR CHAN # IN MESSAGE\r
2741 SETH /DISPLAY THE MESSAGE\r
2742 DIS27A\r
2743 LDH\r
2744 JMS I DSCY\r
2745 JMP .-2\r
2746 JMP I CON2S\r
2747\r
2748/LOCAL CROSSPAGE\r
2749DSCY, DSCS\r
2750DIS27X, DIS27A+5\r
2751\r
2752\r
2753/LOCAL CONSTANTS\r
2754KM1000, -1000\r
2755K4010, 4010\r
2756K0037B, 0037\r
2757KM06, -6\r
2758\r
2759/LOCAL CROSSPAGE\r
2760INITOX, INITOS\r
2761TPUNQ=JMS I .\r
2762 TPUNQS\r
2763TXPUN=JMS I .\r
2764 TXPUNS\r
2765TITLEX, TITLES\r
2766TXT33X, TXT33A+4\r
2767CON34X, CON34\r
2768\f\r
2769*4603\r
2770/SUBROUTINES TO HANDLE DISPLAY IO [SU46AB]\r
2771/HAND READABLE PUNCH SUBROUTINE: TITLE\r
2772 HCNTR=TEMP02\r
2773\r
2774/CALL: SETH\r
2775/ ADDR OF TEXT TO BE USED IN TITLE\r
2776/ TITLE\r
2777\r
2778TITLES, 0\r
2779 TAD K0377 /PUNCH A RUBOUT (BRACKET TITLE WITH RUBOUTS)\r
2780 JMS I PUNX1\r
2781 JMP PSKIP-1 /PUNCH A SPACE (6-200 CODES)\r
2782HRNXT, LDH /GET 6 BIT CHAR\r
2783 CLL RAL\r
2784 TAD ADRTBL /FIND ENTRY IN DISPLAY TABLE\r
2785 DCA PNTR\r
2786 TAD I PNTR /GET THE ENTRY\r
2787 SNA CLA /SEE IF SPECIAL CHARACTER\r
2788 JMP HRCHK /SPECIAL - FIND OUT WHAT TO DO\r
2789 JMS I SHPX1 /SAVE HALFWORD POINTER FOR MORE CHARACTERS\r
2790 TAD KM0004 /FOUR HALF WORDS TO A CHARACTER\r
2791 DCA HCNTR\r
2792 SETH\r
2793PNTR, 0 /SET UP POINTER FOR TABLE PUNCH\r
2794HRPUN, LDH /GET LINE\r
2795 TAD K0200A /8 HOLE PUNCHED TOO\r
2796 JMS I PUNX1 /PUNCH THE LINE\r
2797 ISZ HCNTR\r
2798 JMP HRPUN /MORE HALVES\r
2799 JMS I RHPX1 /ALL PUNCHED - RESTORE TEXT POINTER\r
2800 MTW /SKIP TWO LINES\r
2801 JMP PSKIP\r
2802HRCHK, ISZ PNTR /SPECIAL CHAR FIND OUT\r
2803 TAD I PNTR /WHAT TO DO\r
2804 SMA SZA /SPACE OR END OF TEXT?\r
2805 JMP HRNXT /NO, IGNORE AND GET NEXT CHARACTER\r
2806 SNA CLA /END OF TEXT?\r
2807 JMP TILEND /YES - GO PUNCH RUBOUT AND EXIT\r
2808 LDH /SPACE - SEE IF NEXT CHARACTER IS A SPACE\r
2809 TAD KM040A\r
2810 SNA CLA\r
2811 JMP .-3 /YES - COMPRESS MULTIPLE SPACE TO 1 SPACE\r
2812 JMS I DHPX2 /MOVE BACK HALFWORD POINTER\r
2813 TAD KM006 /AND PUNCH A SPACE\r
2814EJECT\r
2815 \r
2816PSKIP, DCA HCNTR /PUNCH 6 LINES OF 200 CODE\r
2817 TAD K0200A\r
2818 JMS I PUNX1\r
2819 ISZ HCNTR /DONE 6 LINES?\r
2820 JMP .-3 /NO - CONTINUE\r
2821 JMP HRNXT /YES - GET NEXT CHARACTER\r
2822TILEND, TAD K0377 /PUNCH A RUBOUT AND EXIT\r
2823 JMS I PUNX1\r
2824 JMP I TITLES\r
2825\f/LOCAL CONSTANTS\r
2826KM006, -6\r
2827KM040A, -40\r
2828ADRTBL, DSCTBL\r
2829\r
2830/LOCAL CROSSPAGE\r
2831PUNX1, PUNCHS /PUNCH A CHARACTER\r
2832DHPX2, DHPS /MOVE BACK 1 CHARACTER\r
2833\r
2834/SUBROUTINE TO DO Q AND A BETWEEN TTY AND DIS: FRAME\r
2835/ FRAME\r
2836/ [FRAME NAME /ADDRESS OF TEXT TO BE DISPLAYED\r
2837/ L.F. RETN /L.F. AT ANYTIME RETURNS HERE\r
2838/ C.R. RETN /C.R. AFTER FINAL BLANK RETURNS HERE\r
2839FRAMES, 0\r
2840 CLA\r
2841 TAD I FRAMES /GET ADDRESS\r
2842 DCA FRSET\r
2843 ISZ FRAMES /MOVE RETURN TO CALL+2\r
2844 JMS FRSETH /MOVE POINTER TO START OF TEXT\r
2845 JMS I TXIX /PUT BLANK MARKS IN KBD AREAS\r
2846 JMS FRDIS /DISPLAY THE TEXT\r
2847 JMS FRSETH /MOVE POINTER TO START OF TEXT\r
2848FRQUES, TAD TXMRK /GET KBD AREA\r
2849 SRCH\r
2850 JMP FREND /END OF TEXT - EXIT\r
2851FRLOOP, JMS I SHPX1 /SAVE TEXT POINTER\r
2852 JMS FRDIS /DISPLAY TEXT\r
2853 JMS I RHPX1 /RESTORE TEXT POINTER\r
2854 JMS I TXKX /ACCEPT A CHARACTER INTO BUFFER.\r
2855 JMP FRLOOP /NORMAL RETURN\r
2856 JMP FREND+1 /L.F. - EXIT TO CALL+2\r
2857 JMP FRQUES /C.R. - GET NEXT KBD AREA\r
2858FREND, ISZ FRAMES /NO MORE KBD AREAS TO FILL\r
2859 JMS FRSETH /REPOSITION TEXT POINTER\r
2860 JMP I FRAMES /EXIT\r
2861\r
2862FRSETH, 0\r
2863 SETH /REPOSITION TEXT POINTER\r
2864FRSET, 0 /TO START OF FRAME\r
2865 JMP I FRSETH\r
2866\r
2867FRDIS, 0 /DISPLAY THE FRAME\r
2868 SETH /INITIALIZE DISPLAY\r
2869 DSINIT\r
2870 LDH /X0,Y0,SIZE,INTENSITY\r
2871 JMS I DSCX1\r
2872 JMP .-2\r
2873 JMS FRSETH /REPOSITION TEXT POINTER\r
2874 LDH /DISPLAY THE CHARACTERS\r
2875 JMS I DSCX1 /OF THE FRAME\r
2876 JMP .-2\r
2877 JMP I FRDIS /TEXT ENDED\r
2878\f/DISPLAY INITIALIZE\r
2879DSINIT, 4411 /$AH10@\r
2880 1010 /X=000, Y=001, SIZE=10,\r
2881 0000\r
2882\r
2883/LOCAL CROSSPAGE\r
2884TXIX, TXIS /PUT BLANKMARKS IN KBD ENTRIES\r
2885TXKX, TXKS /GET KBD INTO KBD AREA\r
2886DSCX1, DSCS /DISPLAY CHARACTER\r
2887RHPX1, RHPS /RESTORE HALFWORD POINTER\r
2888SHPX1, SHPS /SAVE HALFWORD POINTER\r
2889\r
2890/THIS SUBROUTINE GETS OCTAL ARGUMENT: OCTARG\r
2891 OCTOP=ARITH4\r
2892OCTARS, 0\r
2893 JMS I ARSETX /GET TO KBD - ENTRY\r
2894OCNEXT, LDH /GET CHARACTER\r
2895 BRAN\r
2896 OCSORT /IS IT SPACE OR TXMRK?\r
2897 JMP OCNEXT /SPACE IGNORE\r
2898 JMP OCEND /TXMRK - END\r
2899 JMS I STRNUX /OTHERS - IS IT A NUMERIC?\r
2900 JMP I OCTARS /NO - EXIT TO CALL+1 (ERROR RETURN)\r
2901 TAD KM007A /NUMERIC 0-7?\r
2902 SMA SZA CLA\r
2903 JMP I OCTARS /NO - ERROR RETURN\r
2904 LOAD /SHIFT ACCUMULATED SUM 3 LEFT\r
2905 OCTOP-1 /(MULTIPLIES BY 8)\r
2906 TAD STRSAV /ADD CURRENT DIGIT\r
2907 DCA OCTOP+1\r
2908 TAD K0003\r
2909 SHFT /NEW ACCUMULATED SUM\r
2910 DADD\r
2911 JMP OCNEXT /NEXT CHARACTER\r
2912OCEND, TAD OCTOP /OVERFLOW ?\r
2913 SZA CLA\r
2914 JMP I OCTARS /YES - ERROR RETURN\r
2915 TAD OCTOP+1 /NO - GET ACCUMULATED SUM\r
2916 ISZ OCTARS /EXIT TO CALL+2\r
2917 JMP I OCTARS\r
2918\r
2919/CONSTANTS THIS PAGE\r
2920KM007A, -7\r
2921K0200A, 0200\r
2922ARSETX, ARSET\r
2923STRNUX, STRNUM\r
2924\r
2925\r
2926\f*5000\r
2927/REQ: [SU60A],[SU64A]; THIS IS [SU50AC]\r
2928/DISPLAY STRIPPED ASCII CHAR IN AC: DSC\r
2929/CALL: LDH /GET HALFWORD\r
2930/ DSC /DISPLAY IF NON ZERO\r
2931/ JMP .-2 /DISPLAY THE NEXT HALFWORD\r
2932\r
2933/TEMPORARY STORAGE:\r
2934 CHCNT3=TEMP02\r
2935 CHCNT2=TEMP03\r
2936 CHCNT1=TEMP04\r
2937 CHROT=TEMP05\r
2938 CHFAC=TEMP01\r
2939 CHPNT=TEMP06\r
2940 CHYS=TEMP01\r
2941\r
2942/DISPLAY TABLE EXCEPTIONS\r
2943 SPACE=7777\r
2944 ENDIS=0\r
2945 RESET=1\r
2946 CRETN=2\r
2947 IGNOR=3\r
2948\r
2949DSCS, 0\r
2950 CLL RAL /TWICE STRIPPED ASCII\r
2951 TAD ADSTBL /FOR TABLE POINTER\r
2952 DCA CHPNT\r
2953 TAD I CHPNT /GET DISPLAY WORD 1\r
2954 ISZ CHPNT /SET FOR NEXT DISPLAY WORD 2\r
2955 SNA /NOT SPECIAL CHARACTER?\r
2956 JMP CHSPEC /SPECIAL CHARACTER\r
2957\r
2958CHSET1, DCA CHROT /HOLDS ROTATED DISPLAY WORD\r
2959 TAD CHXL /MOVE TO NEXT X POSITION\r
2960 DILX\r
2961 MTW /NUMBER OF WORDS IS TWO\r
2962 DCA CHCNT3\r
2963CHSET2, MTW /NUMBER OF LINES PER WORD IS TWO\r
2964 DCA CHCNT2\r
2965CHSET3, TAD KM006A /NUMBER OF POINTS IN A LINE IS SIX\r
2966 DCA CHCNT1\r
2967 TAD CHYL /REPOSITION Y AT BOTTOM OF CHARACTER\r
2968 DCA CHYS\r
2969\fCHDIS, TAD CHROT\r
2970 CLL RAL /GET DISPLAY BIT FOR THIS POINT INTO LINK\r
2971 DCA CHROT /STORE CODE WORD FOR NEXT POINT\r
2972 TAD CHYS /LOAD INTENSIFICATION POSITION\r
2973 DILY\r
2974 SNL /DISPLAY IF LINK=1\r
2975 JMP .+4\r
2976 DISD\r
2977 JMP .-1\r
2978 DIXY\r
2979 TAD CHSIZ /GO NEXT POSSIBLE DOT\r
2980 DCA CHYS /KEEP RECORD OF PRESENT POSITION\r
2981 ISZ CHCNT1 /DO ALL THIS SIX TIMES\r
2982 JMP CHDIS\r
2983 TAD CHXL /MOVE X TO NEXT LINE\r
2984 TAD CHSIZ\r
2985 DILX\r
2986 DCA CHXL\r
2987 ISZ CHCNT2 /HAS SECOND HALF BEEN DONE?\r
2988 JMP CHSET3 /NO, DO IT\r
2989 TAD I CHPNT /GET SECOND WORD\r
2990 DCA CHROT /AND DISPLAY IT\r
2991 ISZ CHCNT3\r
2992 JMP CHSET2\r
2993 TAD CHSIZ /BOTH WORDS DONE - DO TWO EMPTY ROWS\r
2994 CLL RAL /(SPACE OVER 2 LINES)\r
2995 TAD CHXL\r
2996 DCA CHXL\r
2997 JMP I DSCS /THEN EXIT AT CALL+1\r
2998\r
2999CHSPEC, TAD I CHPNT /SPECIAL CHARACTER-GET WORD 2 FOR BRANCH\r
3000 TAD CHJMP /SETUP FOR JMP TO\r
3001 DCA .+1 /SPECIAL ROUTINE\r
3002 JMP I CHJMPL /THIS IS THE JUMP\r
3003\r
3004/DISPATCH TABLE FOR ABOVE JMP\r
3005CHJMPL, CHSPA /JUMP TABLE: SPACE\r
3006 CHEND /END OF TEXT\r
3007 CHREST /NEXT 4 CHARACTERS RESET X, Y, DELTA, INTENSITY\r
3008 CHCR /DO A CARRIAGE RETURN, LINE FEED\r
3009 CHEND+1 /IGNORE\r
3010\r
3011CHEND, ISZ DSCS /ATTEMPT TO DSC E.O.T. MARK\r
3012 JMP I DSCS /EXIT TO CALL +2CS\r
3013\r
3014/SPACE: MOVE X RIGHT 6 INCREMENTS\r
3015EJECT\r
3016 \r
3017CHSPA, TAD CHSIZ\r
3018 CLL RTL /4 TIMES SIZE\r
3019 DCA CHFAC\r
3020 TAD CHSIZ\r
3021 CLL RAL /PLUS 2 TIMES SIZE\r
3022 TAD CHFAC /IS SIX TIMES SIZE\r
3023 TAD CHXL /MOVE X POINTER LEFT\r
3024 DCA CHXL /ONE CHARACTER (6 LINES)\r
3025 JMP I DSCS\r
3026\r
3027\f/$-DISPLAY RESET\r
3028CHREST, LDH /NEXT HALFWORD "A"-"P"\r
3029 TAD KM0001 /GETS X POSITION\r
3030 AND K0017 /"A" IS LEFT MARGIN, "P" IS RIGHT MARGIN\r
3031 CLL RTL\r
3032 RTL\r
3033 RTL\r
3034 DCA CHXL /64 POINTS BETWEEN "A" AND "B"\r
3035CHYPOS, LDH /NEXT HALF WORD GETS Y POSITION\r
3036 AND K0017 /"A"-"P"\r
3037 CLL RTL\r
3038 RTL\r
3039 RTL\r
3040 CMA IAC\r
3041 TAD K1001 /"A" IS TOP OF SCREEN. "B" IS BOTTOM\r
3042 DCA CHYL /64 POINTS BETWEEN "A" AND "B"\r
3043CHCSZ, LDH /NEXT CHARACTER GETS SIZE OF CHARACTER -"4" IS NORMAL\r
3044 AND K0017 /ELIMINATE ALL BUT BITS 8-11\r
3045 DCA CHSIZ /STORE DESIRED CHARACTER SIZE\r
3046 JMP I DSCS\r
3047\r
3048/CR-LF: RETURN X TO LEFT MARGIN, MOVE Y DOWN 8 INCREMENTS\r
3049CHCR, TAD K1001\r
3050 DCA CHXL /RESET X TO 0\r
3051 TAD CHSIZ /8 TIMES CHAR SIZE\r
3052 CLL RTL\r
3053 RAL\r
3054 CMA IAC /SUBTRACT FROM Y POSITION\r
3055 TAD CHYL\r
3056 DCA CHYL /NEW Y POSITION\r
3057 JMP I DSCS\r
3058\r
3059/CONSTANTS USED THIS PAGE ONLY\r
3060CHJMP, JMP I CHJMPL+1\r
3061ADSTBL, DSCTBL\r
3062KM006A, -6\r
3063K1001, 1001\r
3064\r
3065/VARIABLES FOR THIS PAGE\r
3066CHXL, 0 /X LOCATION ON SCOPE\r
3067CHYL, 0 /Y LOCATION OF CURRENT LINE\r
3068CHSIZ, 0 /CHARACTER SIZE CONSTANT\r
3069\f/DISPLAY TABLE - PATTERN MATRICES FOR CHARACTERS\r
3070DSCTBL, 0 /@ SPECIAL, MEANS END OF TEXT\r
3071 ENDIS\r
3072\r
3073 7711 /A\r
3074 1177\r
3075\r
3076 7745 /B\r
3077 4532\r
3078\r
3079 3641 /C\r
3080 4122\r
3081\r
3082 7741 /D\r
3083 4136\r
3084\r
3085 7751 /E\r
3086 5141\r
3087\r
3088 7711 /F\r
3089 1101\r
3090\r
3091\r
3092 3641 /G\r
3093 5132\r
3094\r
3095 7710 /H\r
3096 1077\r
3097\r
3098 0077 /I\r
3099 0000\r
3100\r
3101 2040 /J\r
3102 4037\r
3103\r
3104 7714 /K\r
3105 2241\r
3106\r
3107 7740 /L\r
3108 4040\r
3109\r
3110 7706 /M\r
3111 0677\r
3112\r
3113 7704 /N\r
3114 1077\r
3115\r
3116 3641 /O\r
3117 4136\r
3118\r
3119 7711 /P\r
3120 1106\r
3121\r
3122 1621 /Q\r
3123 3156\r
3124\f 7711 /R\r
3125 3146\r
3126\r
3127 2245 /S\r
3128 4530\r
3129\r
3130 0101 /T\r
3131 7701\r
3132\r
3133 7740 /U\r
3134 4077\r
3135\r
3136 3740 /V\r
3137 2017\r
3138\r
3139 7730 /W\r
3140 4077\r
3141\r
3142 6314 /X\r
3143 1463\r
3144\r
3145 0770 /Y\r
3146 7007\r
3147\r
3148 6151 /Z\r
3149 4543\r
3150\r
3151 0617 /[ DISPLAYED AS #\r
3152 1706\r
3153\r
3154 1057 /\ DISPLAYED AS DOWN ARROW\r
3155 1000\r
3156\r
3157 2313 /] DISPLAYED AS %\r
3158 6462\r
3159\r
3160 0475 /^\r
3161 0400\r
3162\r
3163 0416 /_\r
3164 2504\r
3165\r
3166 0 /SPACE IS A SPECIAL CHARACTER\r
3167 SPACE\r
3168\r
3169 0057 /!\r
3170 0000\r
3171\r
3172 0 /" SPECIAL, MARKS PROG INPUT TO TEXT, NOT DISPLAYED\r
3173 IGNOR\r
3174\r
3175 0 /# SPECIAL, IGNORES\r
3176 IGNOR\r
3177\f 0 /$ SPECIAL, DISPLAY RESET FOLLOWS\r
3178 RESET\r
3179\r
3180 0 /% SPECIAL, DOES CARRIAGE RETURN\r
3181 CRETN\r
3182\r
3183 4040 /& - USED IN Q&A BLANKS\r
3184 4040\r
3185\r
3186 0 /' SPECIAL, MARKS KBD INPUT TO TEXT, NOT DISPLAYED\r
3187 IGNOR\r
3188\r
3189 7741 /( DISPLAYED AS [\r
3190 4100\r
3191\r
3192 0041 /) DISPLAYED AS ]\r
3193 4177\r
3194\r
3195 2214 /* DISPLAYED AS LITTLE X\r
3196 1422\r
3197\r
3198 0010 /+\r
3199 3410\r
3200\r
3201 0050 /,\r
3202 3000\r
3203\r
3204 0404 /-\r
3205 0400\r
3206\r
3207 0040 /.\r
3208 0000\r
3209\r
3210 2010 //\r
3211 0402\r
3212\r
3213 3651 /0\r
3214 4536\r
3215\r
3216 0042 /1\r
3217 7740\r
3218\r
3219 6251 /2\r
3220 5146\r
3221\r
3222 2241 /3\r
3223 4532\r
3224\r
3225 1412 /4\r
3226 7710\r
3227\r
3228 2745 /5\r
3229 4531\r
3230\f 3645 /6\r
3231 4530\r
3232\r
3233 4111 /7\r
3234 0503\r
3235\r
3236\r
3237 3245 /8\r
3238 4532\r
3239\r
3240 0651 /9\r
3241 5136\r
3242\r
3243 2400 /:\r
3244 0000\r
3245\r
3246 0040 /;\r
3247 3200\r
3248\r
3249 1422 /<\r
3250 4100\r
3251\r
3252 0012 /=\r
3253 1212\r
3254\r
3255 4122 />\r
3256 1400\r
3257\r
3258 0251 /?\r
3259 0502\r
3260\f/FLOATING VARIABLES\r
3261FLOT03, 0\r
3262 0\r
3263 0\r
3264\r
3265FLOT04, 0\r
3266 0\r
3267 0\r
3268\r
3269FLOT05, 0\r
3270 0\r
3271 0\r
3272\r
3273FLOT06, 0\r
3274 0\r
3275 0\r
3276\r
3277FLOT07, 0\r
3278 0\r
3279 0\r
3280\r
3281FLOT10, 0\r
3282 0\r
3283 0\r
3284\r
3285/TTY-LST\r
3286CRTX, 45 /CR\r
3287 -47 /TXMRK\r
3288\r
3289\f*5400\r
3290/SUBROUTINES TO HANDLE FLOATING, DECIMAL, AND OCTAL IO [SU54AB]\r
3291/REQUIRES [SU60A] [SU62A], [SU63A], [SU64A]\r
3292\r
3293/SUBROUTINE CONVERTS AC TO OCTAL CHARACTERS ON HALFWORD BUFFER: OCTOUT\r
3294/USES TEMP01-02\r
3295\r
3296OCTOUS, 0\r
3297 DCA SHFR+1 /PUT AC IN LOW ORDER SHIFT REGISTER\r
3298 TAD KM0004 /GET 4 CHARACTERS\r
3299 DCA OCNT\r
3300 OCNT=TEMP02\r
3301 TAD KM0004 /AC=0 STORES AS "0 "\r
3302 DCA LSWIT\r
3303 TAD PROMRK /LOOK FOR ENTRY AREA\r
3304 SRCH\r
3305MPRMRK, -42 /SKIPPED-PRESUME THERE IS AN ENTRY AREA LEFT\r
3306OCVROT, TAD K0003 /OCTAL CHARACTER REPRESENTS 3 BITS\r
3307 SHFT\r
3308 TAD SHFR /# IS IN LEFT 3 BITS OF AC\r
3309 AND K0007\r
3310 JMS OUTCH /OUTPUT THE #\r
3311K0060, 0060 /LEADING 0 OR NO ROOM - "AND" WITH 0 IS NOP\r
3312 ISZ OCNT /MORE CHARACTERS?\r
3313 JMP OCVROT /YES-CONTINUE\r
3314 TAD KM0020 /NO-FILL REMAINING AREA WITH SPACES\r
3315 JMS OUTCH\r
3316 JMP I OCTOUS /AREA IS FULL-EXIT\r
3317 JMP .-3 /PUT IN SPACES\r
3318\r
3319/GENERALIZED NUMERICAL OUTPUT ROUTINE\r
3320/SUBROUTINE STORES A CHAR AWAY IF NOT A LEADING 0 AND THERE IS ROOM\r
3321/EXITS TO CALL+1 IF THESE CONDITIONS NOT MET, CALL+2 IF THEY ARE\r
3322/TEMPORARY STORAGE ALLOCATION\r
3323 STOR=TEMP01\r
3324\r
3325EJECT\r
3326 \r
3327OUTCH, 0\r
3328 ISZ LSWIT /IS THIS A LEADING ZERO?\r
3329 SZA /IT'S LEADING\r
3330 SKP\r
3331 JMP I OUTCH /AND IT'S A ZERO-EXIT TO CALL+1\r
3332 DCA STOR /NO-NOT A LEADING ZERO.\r
3333 CLA CMA /FIX UP LEAD SWITCH\r
3334 DCA LSWIT\r
3335 LDH /IS THERE ROOM IN THE BUFFER?\r
3336 TAD MPRMRK\r
3337 SNA CLA\r
3338 JMP I OUTCH /NO MORE ROOM-EXIT TO CALL+1\r
3339 TAD STOR /ROOM AVAILABLE-MAKE 6BIT OUT OF #.\r
3340 TAD K0060\r
3341 JMS I STHX1\r
3342 ISZ OUTCH /PUT IT AWAY\r
3343 JMP I OUTCH /EXIT TO CALL+2\r
3344\f/SUBROUTINE CONVERTS FLOATING AC TO ASCII STRING: FLTOUT\r
3345/TEMPORARY STORAGE ALLOCATION\r
3346 FCVCNT=TEMP14\r
3347 DIGIT=TEMP13\r
3348 PERCNT=TEMP15\r
3349 ZSWIT=TEMP16\r
3350\r
3351FLTOUS, 0\r
3352 DCA CHEXP\r
3353 TAD PROMRK /LOOK FOR A PLACE TO PUT CHARACTERS\r
3354 SRCH\r
3355KM0033, -33 /SKIPPED\r
3356 TAD FAC+1\r
3357 SPA CLA /PUT IN A "-" OR A SPACE DEPENDING UPON SIGN\r
3358 TAD K0015\r
3359 TAD KM0020\r
3360 JMS OUTCH /PUT OUT CHARACTER\r
3361CHEXP, 0 /A NOP-BUT NOT REACHED ANYWAY\r
3362 TAD FAC+1\r
3363 SPA CLA /GET .ABS. FAC\r
3364 DCOM\r
3365 SAVE\r
3366 REMAIN /SET UP FOR RADIX DEFLATION\r
3367 TAD KM011\r
3368 DCA FCVCNT /WE WILL LOOK AT 9 POWERS OF 10\r
3369 DCA LSWIT /ENABLE SEARCH FOR LEADING 0'S\r
3370 CLA CMA\r
3371 DCA ZSWIT /DETECT FIRST NON ZERO LEAD\r
3372 LOAD /HOW MANY 100,000,000'S\r
3373 K100MF\r
3374CVLOOP, SAVE /HOW MANY MULTIPLES OF RADIX?\r
3375 RADIX\r
3376 LOAD /DEFLATE\r
3377 REMAIN\r
3378 FDIV\r
3379 RADIX\r
3380 FIX /# OF MULT. OF RADIX\r
3381 DCA DIGIT\r
3382 TAD DIGIT /GET REMAINDER\r
3383 FLOAT\r
3384 FMUL\r
3385 RADIX\r
3386 DCOM\r
3387 FADD\r
3388 REMAIN\r
3389 SAVE\r
3390 REMAIN\r
3391 TAD DIGIT /PUT DIGIT OUT INTO BUFFER\r
3392 JMS OUTCH\r
3393 JMP CVRLZ /LEADING ZERO OR NO MORE ROOM\r
3394 ISZ ZSWIT /FIRST NON-ZERO?\r
3395 JMP CVRNZ /NO\r
3396 TAD KM0033 /YES, PUT "U" IN MULTIPLIER\r
3397 DCA CHEXP\r
3398\f TAD FCVCNT /U:1-3, M:4-6, SPACE: 7-9=-FCVCNT\r
3399 TAD K0003 /9+FCVCNT (-) IS # OF LEADING ZEROES\r
3400 SMA /M OR SPACE?\r
3401 JMP CVRLZ /NEITHER, MULTIPLIER IS U, NO PERIOD\r
3402 TAD K0003\r
3403 SPA\r
3404 JMP CVRSP /MULTIPLIER IS SPACE\r
3405 TAD KM0003 /MULTIPLIER IS M, COUNT UNTIL "."\r
3406 DCA PERCNT /3, 2, OR 1 CHARACTERS UNTIL "."\r
3407 TAD KM0043 /PUT M IN MULTIPLIER\r
3408 JMP .+3\r
3409CVRSP, DCA PERCNT /3,2,OR 1 CHARACTERS BEFORE "."\r
3410 TAD KM0020 /PUT SPACE IN MULTIPLIER\r
3411 DCA CHEXP\r
3412 TAD KM0004 /AND PUT ONLY 4#'S IN BUFFER\r
3413 DCA FCVCNT\r
3414\r
3415CVRNZ, ISZ PERCNT /NON-ZERO ENTRY WAS MADE\r
3416 JMP CVRLZ /NOT YET TIME FOR "."\r
3417 MTW /PUT IN THE "."\r
3418 JMS OUTCH\r
3419KM0020, -20 /THIS INSTRUCTION IS SKIPPED\r
3420\r
3421CVRLZ, LOAD /REDUCE THE RADIX BY A FACTOR OF 10\r
3422 RADIX\r
3423 FDIV\r
3424 K10F\r
3425 ISZ FCVCNT /HAD ENOUGH?\r
3426 JMP CVLOOP /NO-CONTINUE\r
3427 TAD KM0020 /FILL REMAINING WITH SPACES\r
3428 JMS OUTCH\r
3429 SKP\r
3430 JMP .-3\r
3431CVREND, TAD PROMRK /MOVE TO FILL EXPONENT CHARACTER\r
3432 SRCH\r
3433KM011, -11\r
3434 TAD CHEXP /STORE IT\r
3435 JMS OUTCH\r
3436 JMP I FLTOUS\r
3437 TAD KM0020 /NOW FILL REMAINING WITH SPACES\r
3438 JMP .-3\r
3439\r
3440/LOCAL VARIABLES\r
3441LSWIT, -1 /-1 TO ACCEPT LEADING ZEROS\r
3442\r
3443/LOCAL CROSSPAGE\r
3444STHX1, STHS /STH SUBROUTINE\r
3445\r
3446/LOCAL CONSTANTS\r
3447KM0003, -3\r
3448\f/TTY-LISTS USED TO SCAN FLOATING ARGUMENTS\r
3449MODCHR,\r
3450K0015, 15 /M\r
3451 -40 /SPACE\r
3452\r
3453FLSORT, 56 /.\r
3454 47 /'\r
3455 55 /-\r
3456 -40 /SPACE\r
3457\r
3458K10F, 0004\r
3459 2400\r
3460 0000\r
3461\r
3462/THIS SUBROUTINE SCANS FOR DECIMAL ARGUMENT: DECARG\r
3463DECARS, 0\r
3464 JMS ARSET /POSITION HALFWORD POINTERS\r
3465DECNXT, LDH\r
3466 BRAN /LOOK FOR SPACES AND TXMRKS\r
3467 OCSORT\r
3468 JMP DECNXT /SPACE - IGNORE\r
3469 JMP DECEND /TXMRK\r
3470 JMS STRNUM /OTHERS-STRIP OFF 60\r
3471 JMP I DECARS /NOT A (6BIT) NUMERAL\r
3472 TAD KM0011 /0-9 ARE ALLOWED\r
3473 SMA SZA CLA\r
3474 JMP I DECARS /NOT A DECIMAL NUMERAL\r
3475 TAD STRSAV /MULTIPLY PREVIOUS ACCUMULATION BY 10\r
3476 JMS DX10\r
3477 JMP DECNXT\r
3478\r
3479\r
3480DECEND, TAD DBLARG /CHECK FOR OVERFLOW\r
3481 SZA CLA\r
3482 JMP I DECARS /GREATER THAN 4095, EXIT TO CALL+1\r
3483 TAD DBLARG+1 /ARGUMENT OK-EXIT AT CALL+2\r
3484 ISZ DECARS\r
3485 JMP I DECARS\r
3486\f/THIS SUBROUTINE MULTIPLIES DXAC BY 10 AND ADDS CURRENT STRIPPED CHARACTER [IN AC]\r
3487/TEMPORARY STORAGE ALLOCATION\r
3488 DXCHAR=TEMP02\r
3489DX10, 0\r
3490 DCA DXCHAR /AC HOLDS NEXT # TO ADD\r
3491 LOAD\r
3492 DBLARG-1\r
3493 CLA IAC /GET 2 * OLD SUM\r
3494 SHFT\r
3495 SAVE /STORE IT\r
3496 DBLARG-1\r
3497 TWO /GET 8 * OLD SUM\r
3498 SHFT\r
3499 DADD /ADD TO 2 * OLD SUM\r
3500 TAD DXCHAR\r
3501 DCA DBLAC+1 /ADD NEXT #\r
3502 DCA DBLAC\r
3503 DADD\r
3504 JMP I DX10 /10 * OLD SUM + NEXT#\r
3505\r
3506/THIS SUBROUTINE SCANS FOR FLOATING ARGUMENT AND LEAVES IN FAC: FLTARG\r
3507/ARITHMETIC REGISTER ALLOCATION\r
3508 FLOPR=ARITH4\r
3509/TEMPORARY STORAGE ALLOCATION\r
3510 FLCHAR=TEMP01\r
3511 FRCNT=TEMP13\r
3512 FLSGN=TEMP14\r
3513\r
3514FLTARS, 0\r
3515 JMS ARSET\r
3516 DCA FRCNT /DECIMAL POINT INDICATOR\r
3517 CLA CMA\r
3518 DCA FLSGN /SIGN INDICATOR\r
3519FLNEXT, LDH /GET NEXT CHARACTER FROM BUFFER\r
3520 BRAN\r
3521 FLSORT /SPECIAL CHARACTERS\r
3522 JMP FRCHK /. - CHECK FRCNT AND SET IT\r
3523 JMP FLTMOD /TXMRK - GO TO STAGE 2\r
3524 DCA FLSGN /- - SET SIGN = 0\r
3525 JMP FLNEXT /SPACE - IGNORE\r
3526 JMS STRNUM /OTHER - CHECK FOR 0,...,9\r
3527 JMP I FLTARS /NOT NUMERIC: ERROR RETURN\r
3528 TAD KM0011 /GREATER THAN 9?\r
3529 SMA SZA CLA\r
3530 JMP I FLTARS /YES: ERROR RETURN\r
3531 TAD FLCHAR /NO, IN RANGE 0-9\r
3532 JMS DX10 /INCREASE RESULT\r
3533 ISZ FRCNT /ENOUGH CHARACTERS?\r
3534 JMP FLNEXT /NO\r
3535 JMP I FLTARS /YES-MORE THAN 3 DIGITS IN FRACTION-EXIT\r
3536\r
3537FRCHK, TAD KM0004 /ALLOW 3 DIGITS TO RIGHT OF "."\r
3538 DCA FRCNT\r
3539 JMP FLNEXT\r
3540\fFLTMOD, LOAD /GET MODIFY CHARACTER\r
3541 DBLARG-1\r
3542 NORM /MAKE FLOATING POINT OF FIRST PART\r
3543 DCA FAC\r
3544 TAD FRCNT /HOW MANY DIGITS TO RIGHT OF DECIMAL?\r
3545 SPA CLA /POS INDICATES 0 DIGITS TO RIGHT\r
3546 JMP .+3\r
3547 TAD KM0004 /DIGITS TO RIGHT -4="FRCNT"\r
3548 DCA FRCNT\r
3549 ALPHA /GET "M" OR "SPACE"\r
3550 BRAN\r
3551 MODCHR\r
3552 TAD K0003 /M\r
3553 SKP /SPACE\r
3554 JMP I FLTARS /OTHER-ERROR RETURN\r
3555 TAD KM0002 /MULTIPLIER IS 10^[2+(-FRCNT)] IF "SPACE", 3 LESS IF "M"\r
3556 TAD FRCNT\r
3557 SMA SZA /.GT. 0 MEANS ERROR, FRACTION OF U\r
3558 JMP FLEND\r
3559 SNA\r
3560 JMP FLDONE /IF MULT IS 10^0,DONE\r
3561 DCA FRCNT /IF NOT. SET UP LOOP COUNT\r
3562 FMUL\r
3563 K10F\r
3564 ISZ FRCNT\r
3565 JMP .-3\r
3566FLDONE, ISZ FLSGN /NOW ADJUST SIGN\r
3567 DCOM\r
3568 ISZ FLTARS /RETURN TO CALL+2 IF OK\r
3569 LDH /MOVE OVER NEXT CHAR (TXMRK)\r
3570FLEND, CLL CLA\r
3571 JMP I FLTARS /EXIT\r
3572\r
3573/THIS SUBROUTINE DOES GENERALIZED NUMERICAL INPUT - STRIPS 60 AND STORES\r
3574/TEMPORARY STORAGE ALLOCATION\r
3575 STRSAV=TEMP01\r
3576\r
3577STRNUM, 0\r
3578 TAD BSAVE /CHAR ASSUMED IN TEMP02\r
3579 TAD KM0060 /6BIT MUST BE .GE. 60\r
3580 SPA\r
3581 JMP STRERR /IF NOT IS NOT A CHARACTER\r
3582 DCA STRSAV /STORE STRIPPED CHARACTER IN TEMP02\r
3583 TAD STRSAV /AND LEAVE IN AC\r
3584 ISZ STRNUM\r
3585 JMP I STRNUM\r
3586\r
3587STRERR, CLL CLA\r
3588 JMP I STRNUM\r
3589\f/THIS SUBROUTINE INITIALIZES INPUT POINTERS\r
3590/ARITHMETIC REGISTER ALLOCATION\r
3591 AROP=ARITH4\r
3592\r
3593ARSET, 0\r
3594 TAD TXMRK /MOVE TO INPUT REGION\r
3595 SRCH\r
3596KM0002, -2 /THIS LOCATION SKIPPED\r
3597 DCA AROP /CLEAR SUM REGISTER\r
3598 DCA AROP+1\r
3599 JMP I ARSET\r
3600\r
3601\r
3602/LOCAL CONSTANTS\r
3603KM0060, -60\r
3604KM0011, -11\r
3605\r
3606/FLOATING VARIABLES\r
3607FLOT01, 0\r
3608 0\r
3609 0\r
3610RADIX=FLOT01\r
3611\r
3612FLOT02, 0\r
3613 0\r
3614 0\r
3615REMAIN=FLOT02\r
3616\r
3617\f*6000\r
3618/HALFWORD AND TEXT HANDLERS [SU60AB] - REQUIRES [SU63A]\r
3619\r
3620/TEMPORARY STORAGE ALLOCATION\r
3621 HSAVE=TEMP01\r
3622\r
3623/SET H WORD POINTERS TO FIRST HALF OF AC HELD ADDRESS: SETH\r
3624/TYPICAL CALLING SEQUENCE\r
3625/ SETH\r
3626/ ADDRESS\r
3627/ RETURN\r
3628\r
3629SETHS, 0\r
3630 TAD I SETHS /GET ADDRESS FROM CALL+1\r
3631 DCA HPNT2 /PUT IT IN LDH POINTER\r
3632 CMA /LEFT HALF\r
3633 DCA HSW2\r
3634 ISZ SETHS /EXIT CALL+2\r
3635 JMP I SETHS\r
3636\r
3637 /SAVE H WORD POINTERS: SHP\r
3638SHPS, 0\r
3639 CLA\r
3640 TAD HPNT2 /GET LDH POINTERS\r
3641 DCA HPSV /ADDRESS\r
3642 TAD HSW2 /HALF WORD\r
3643 DCA HSWSV\r
3644 JMP I SHPS\r
3645\r
3646/RESTORE HWORD POINTERS TO SAVED VALUES: RHP\r
3647RHPS, 0\r
3648 CLA\r
3649 TAD HPSV /GET SAVED POINTERS\r
3650 DCA HPNT2\r
3651 TAD HSWSV /PUT IN LDH POINTERS\r
3652 DCA HSW2\r
3653 JMP I RHPS\r
3654\r
3655/DECREMENT HALF-WORD POINTER: DHP\r
3656DHPS, 0\r
3657 CLA CMA\r
3658 ISZ HSW2 /SKIP IF LEFT HALF\r
3659 JMP HPD2 /RIGHT HALF\r
3660 TAD HPNT2 /LEFT HALF, MOVE TO RIGHT HALF OF PREVIOUS WORD\r
3661 DCA HPNT2\r
3662 JMP I DHPS\r
3663HPD2, DCA HSW2 /RIGHT HALF, MOVE TO LEFT HALF, SAME WORD\r
3664 JMP I DHPS\r
3665\f\r
3666BSW=7002\r
3667\r
3668/HALF WORD LOAD AC: LDH\r
3669LDHS, 0 /GET HALF WORD AND MOVE POINTER TO NEXT HALF\r
3670 CLL CLA /PUT LDH POINTERS IN STH POINTERS\r
3671 TAD HSW2\r
3672 DCA HSW1\r
3673 TAD HPNT2\r
3674 DCA HPNT1 /WHICH HALF ARE WE ON?\r
3675 ISZ HSW2 /RIGHT\r
3676 JMP LDH2 /LEFT\r
3677 TAD I HPNT2\r
3678 AND K7700H\r
3679 BSW\r
3680 JMP I LDHS\r
3681\r
3682LDH2, CMA /SET POINTER TO LEFT HALF (HSW2)\r
3683 DCA HSW2\r
3684 TAD I HPNT2\r
3685 AND K0077 /GET HALFWORD\r
3686 ISZ HPNT2 /NEXT HALF IS LEFT HALF OF NEXT WORD\r
3687 JMP I LDHS\r
3688\r
3689/HALF WORD STORE AC - FROM PLACE LDH WAS DONE: STH\r
3690STHS, 0\r
3691 AND K0077 /SAVE RIGHT HALF OF AC\r
3692 ISZ HSW1 /STORE IN FIRST OR SECOND HALF?\r
3693 JMP STH2 /SECOND (RIGHT) HALF\r
3694 CLL RTL /POSITION IN LEFT HALF\r
3695 RTL\r
3696 RTL\r
3697 DCA HSAVE\r
3698 TAD I HPNT1 /GET OLD WORD FROM TEXT BFFER\r
3699 AND K0077 /CLEAR LEFT HALF\r
3700 JMP STH3 /GO STORE NEW VALUE\r
3701\r
3702STH2, DCA HSAVE /RIGHT HALF\r
3703 TAD I HPNT1 /GET OLD WORD\r
3704 AND K7700H /CLEAR RIGHT HALF\r
3705STH3, TAD HSAVE /STORE WITH NEW VALUE\r
3706 DCA I HPNT1\r
3707 JMP I STHS /RETURN\r
3708\r
3709\f/SEARCH HALF-WORD BUFFER FOR CHARACTER: SRCH\r
3710/CALL: TAD [X /SEARCH FOR X\r
3711/ SRCH\r
3712/ CAN'T FIND\r
3713/ NORMAL RETURN\r
3714\r
3715SRCHS, 0\r
3716 CMA IAC\r
3717 DCA HSAVE\r
3718CHNX, JMS LDHS /GET NEXT HALFWORD\r
3719 SNA /HALFWORD IS 0: END OF BUFFER REACHED\r
3720 JMP I SRCHS\r
3721 TAD HSAVE /SUBTRACT SEARCH CHARACTER\r
3722 SZA CLA\r
3723 JMP CHNX\r
3724 ISZ SRCHS /HAVE NOT FOUND IT, CONTINUE\r
3725 JMP I SRCHS /FOUND IT! EXIT TO CALL+2\r
3726\r
3727/THIS SUBROUTINE TYPES STRIPPED ASCII CHARACTERS: TYPE\r
3728/CALL: LDH\r
3729/ TYPE\r
3730/ JMP .-2\r
3731/ END OF TEXT RETURN\r
3732\r
3733TYPES, 0\r
3734 BRAN /CHECK AGAINST SPECIAL CHARACTER LIST\r
3735 TTYLST\r
3736 ISZ TYPES /@-END OF RECORD- SPECIAL RETN\r
3737K0100T, 0100 /" - IGNORE - "AND" WITH AC = 0\r
3738 NOP /$ - DISPLAY RESET IS IGNORED\r
3739 JMP I TYPES /' - KBD ENTRY DELIMITOR IS IGNORED\r
3740 JMP TCR /C.R. - DO C.R.L.F.\r
3741 JMP I TYPES /L.F. - IGNORE\r
3742 TAD BSAVE /NONE OF THE ABOVE\r
3743 TAD KM0040 /00-37 ARE 300-337; 40-77 ARE 240-277\r
3744 SPA\r
3745 TAD K0100T /00-37\r
3746 TAD K0240\r
3747TPEX, JMS TOUT /TYPE IT\r
3748 JMP I TYPES\r
3749\r
3750TCR, TAD K215 /C.R.L.F. - DO CR FIRST\r
3751 JMS TOUT\r
3752 TAD K212 /THEN DO LF\r
3753 JMP TPEX /EXIT\r
3754\r
3755/LOCAL CONSTANTS\r
3756K215, 215\r
3757K212, 212\r
3758\f/SUBROUTINE TYPES OUT 8BIT IN AC\r
3759TOUT, 0\r
3760KXX46, TLS /THIS IS A CONSTANT\r
3761 TSF\r
3762 JMP .-1\r
3763 TCF /LEAVES FLAG CLEARED\r
3764 DCA TEMP02\r
3765 JMP I TOUT\r
3766\r
3767/FILLS ALL ENTRY AREAS WITH BLANKMARKS: TXI\r
3768/CALL: SETH\r
3769/ ADDRESS OF TEXT START\r
3770/ TXI\r
3771/ RETURN\r
3772\r
3773TXIS, 0\r
3774TXSR1, TAD TXMRK /GET FIRST BREAK CHAR\r
3775 JMS SRCHS\r
3776 JMP I TXIS /END CHAR FOUND\r
3777\r
3778TXSR2, JMS LDHS /FIND BREAK 2\r
3779 TAD MTXMRK /PUT BLANKMARKS FROM BRK 1 TO 2\r
3780 SNA CLA\r
3781 JMP TXSR1 /FOUND 2ND BREAK\r
3782 TAD KXX46 /NOT FOUND YET\r
3783 JMS STHS /PUT IN BLANKMARKS\r
3784 JMP TXSR2 /CONTINUE\r
3785\r
3786/LOCAL VARIABLES THIS PAGE\r
3787HPSV, 0 /SAVE ADDRESS\r
3788HSWSV, 0 /SAVE HALF\r
3789HPNT2, 0 /LDH ADDRESS\r
3790HSW2, 0 /LDH HALF\r
3791HPNT1, 0 /STH ADDRESS\r
3792HSW1, 0 /STH HALF\r
3793\r
3794/CONSTANTS FOR THIS PAGE\r
3795K0077, 0077\r
3796K7700H, 7700\r
3797K0240, 0240\r
3798KM0040, -0040\r
3799\r
3800\f*6200\r
3801/TEXT-KEYBOARD HANDLES [SU62AB]\r
3802/REQUIRES [SU63A]\r
3803\r
3804/SUBROUTINE PICKS UP FIRST CHARACTER OF AN ENTRY\r
3805ALPHAS, 0\r
3806 TAD TXMRK /FIND TXMRX (KEYBOARD DELIMITOR)\r
3807 SRCH\r
3808 JMP I ALPHAS /NOT HERE, EXIT WITH AC=0\r
3809 LDH /GETS FIRST CHARACTER\r
3810 JMP I ALPHAS /EXIT\r
3811\r
3812/LOADS KBD CHARACTERS INTO BUFFER: TXK\r
3813/CALL: TXK\r
3814/ NORMAL EXIT\r
3815/ LINE FEED\r
3816/ CARRIAGE RETURN\r
3817\r
3818TXKS, 0\r
3819 KSF\r
3820 JMP I TXKS /NO KEY - EXIT\r
3821 KRB\r
3822 JMS I UCHECK /USER MUST HAVE SUBROUTINE AT 7540 OR NOP THIS LOCATION\r
3823 BRAN /CHECK AGAINST SPECIAL CHARACTERS\r
3824 TXKEY\r
3825 ISZ TXKS /C.R.\r
3826 JMP TXLF /L.F.\r
3827 JMP TXRUB /RUBOUT\r
3828 LDH /OTHER\r
3829 TAD MTXMRK /CHECK THAT KEYBOARD AREA NOT FULL.\r
3830 SNA CLA\r
3831 JMP TXEN /NO MORE ROOM - EXIT WITHOUT ECHO\r
3832 TAD BSAVE\r
3833 AND K0077A /STRIP CHARACTER TO 6BIT\r
3834 BRAN /CHECK AGAINST SPECIAL 6BIT'S\r
3835 TTYLST\r
3836K0034A, 0034 /@ - END OF TEXT MARKER\r
3837K0077A, 0077 /" - PROGRAMMED INPUT TEXT MARKER\r
3838K0046, 0046 /$ - DISPLAY RESET\r
3839 JMP TXEN /' - KBD MARKER - FOR THIS AND ABOVE: EXIT WITHOUT ECHO\r
3840K0070, 0070 /% - CONVERT TO ] WHICH IS DISPLAYED AS %\r
3841 TAD K0070 /# - CONVERT TO [ WHICH IS DISPLAYED AS #\r
3842 TAD BSAVE /NONE OF THE ABOVE\r
3843 TYPE /ECHO\r
3844 TAD BSAVE /STORE AWAY\r
3845 JMS I STHX2\r
3846 JMP I TXKS\r
3847\fTXLF, ISZ TXKS /C.R. OR L.F.\r
3848 LDH /FILL REST OF KBD AREA WITH SPACES\r
3849 TAD MTXMRK /END OF AREA?\r
3850 SNA CLA\r
3851 JMP TXER /YES - TYPE A CRLF AND EXIT\r
3852 TAD K0040 /NO - PUT ANOTHER SPACE IN.\r
3853 JMS I STHX2\r
3854 JMP TXLF+1 /AND CONTINUE\r
3855\r
3856 TXER, TAD KCR /TYPE A CRLF\r
3857 TYPE\r
3858 JMP I TXKS /AND EXIT\r
3859\r
3860TXRUB, TAD K0034A /PROCESS A RUBOUT - DELETE 1 CHAR.\r
3861 TYPE /TYPE "\"\r
3862 JMS I DHPX1 /MOVE POINTER BACK 1 HALF WORD\r
3863 LDH /IS THAT HALFWORD A TXMRK?\r
3864 TAD MTXMRK\r
3865 SNA CLA\r
3866 JMP TXER /YES - KBD AREA HAS BEEN ALL RUBBED OUT\r
3867 TAD K0046 /NO - PUT A BLANKMARK IN THERE\r
3868 JMS I STHX2\r
3869\r
3870TXEN, JMS I DHPX1 /IGNORE INPUT - MOVE POINTER BACK\r
3871 JMP I TXKS /AND EXIT\r
3872\r
3873/TTY-LST\r
3874TXKEY, 215 /CR\r
3875 212 /LF\r
3876 -377 /RUBOUT\r
3877\r
3878/LOCAL CROSSPAGE\r
3879DHPX1, DHPS\r
3880STHX2, STHS\r
3881\r
3882/REFERENCE TO USER'S AREA - ROUTINE TO CHECK CTRLS MUST BE THERE\r
3883UCHECK, KBRANS\r
3884\r
3885/FLOATING CONSTANT\r
3886KM001F, 0001\r
3887 6000\r
3888 0000\r
3889\r
3890\f*6302\r
3891/BASIC SUBROUTINES SHFT, DADD, AND BRAN [SU63AB]\r
3892\r
3893/SUBROUTINE TO SHIFT DOUBLE PRECISION WORD (SHFR): SHFT (10+6N)\r
3894/CALL: TAD KXXXX /AC HOLDS SHFT COUNT, RIGHT IS NEGATIVE\r
3895/ SHFT\r
3896/ RETURN /LINK=0, AC=0\r
3897/FORMAT OF DOUBLE WORD IS (HI,LO) HI(0)-ONLY-HOLDS SIGN\r
3898/SIGN BIT WILL BE REPLICATED IN RIGHT SHIFTS\r
3899\r
3900/TEMPORARY STORAGE ALLOCATION\r
3901 SHCNT=TEMP01\r
3902\r
3903/ARITHMETIC REGISTER ALLOCATION\r
3904 SHFR=ARITH1 /ARITH1-2 ARE FOR SHIFTING\r
3905\r
3906SHFTS, 0\r
3907 CLL\r
3908 SNA /IF SHIFT COUNT=0. EXIT\r
3909 JMP I SHFTS\r
3910 SMA /SHIFT RIGHT OR LEFT\r
3911 CML CMA IAC /LEFT-SET LINK=1 AND COUNT NEGATIVE\r
3912 DCA SHCNT\r
3913 SZL /RIGHT SHIFT?\r
3914 JMP SHLEFT /NO-SHIFT LEFT\r
3915\r
3916SHRIHT, TAD SHFR /SHIFT DONE ON ARITH1-2\r
3917 SPA /SET L=1 IF NEGATIVE\r
3918 CML\r
3919 RAR\r
3920 DCA SHFR /SHIFT WITH SIGN REPLICATION\r
3921 TAD SHFR+1 /SHIFT LO ORDER HALF\r
3922 RAR\r
3923 DCA SHFR+1\r
3924 CLL\r
3925 ISZ SHCNT /ENOUGH SHIFTS?\r
3926 JMP SHRIHT /NO-CONTINUE\r
3927 JMP I SHFTS /YES-EXIT\r
3928\r
3929SHLEFT, TAD SHFR+1 /SHIFT LO-ORDER\r
3930 CLL RAL /0 TO LSB\r
3931 DCA SHFR+1\r
3932 TAD SHFR /SHIFT HI-ORDER\r
3933 RAL\r
3934 DCA SHFR\r
3935 CLL\r
3936 ISZ SHCNT /ENOUGH?\r
3937 JMP SHLEFT /NO-CONTINUE\r
3938 JMP I SHFTS\r
3939\r
3940\f/SUBROUTINE FOR BRANCHING ON MATCH OF AC AGAINST TABLE: BRAN\r
3941/ BRAN\r
3942/ ADDRESS OF TABLE\r
3943/ RETURN HERE IF FIRST ENTRY MEETS MATCH\r
3944/ ETC.\r
3945/ NONE MATCH\r
3946/TABLE, FIRST ENTRY\r
3947/ SECOND ENTRY\r
3948/ -LAST ENTRY\r
3949\r
3950/TEMPORARY STORAGE ALLOCATION\r
3951 BPNT=TEMP01\r
3952 BSAVE=TEMP02\r
3953BRANS, 0\r
3954 DCA BSAVE\r
3955 TAD I BRANS /GET ADDRESS OF FIRST ENTRY OF MATCH LIST\r
3956 DCA BPNT\r
3957BRLOOP, TAD I BPNT /LOOK AT ENTRY\r
3958 SMA /GET MAGNITUDE\r
3959 CMA IAC\r
3960 ISZ BRANS /INDEX RETURN ADDRESS\r
3961 TAD BSAVE /MATCH FOUND?\r
3962 SNA CLA\r
3963 JMP I BRANS /YES-EXIT TO RETURN AS CALCULATED\r
3964 TAD I BPNT /NO-TEST FOR LAST ENTRY.\r
3965 ISZ BPNT /INDEX ENTRY POINTER\r
3966 SMA CLA /-INDICATES THIS WAS LAST ENTRY\r
3967 JMP BRLOOP /NOT LAST-CONTINUE\r
3968 ISZ BRANS /EXIT, NOT IN LIST, NONE MATCH\r
3969 JMP I BRANS\r
3970\r
3971/SUBROUTINE TO DO DOUBLE PRECISION ADD OF ARITH1-2, AND 4-5: DADD (21)\r
3972/ARITHMETIC REGISTER ALLOCATION\r
3973 DBLAC=ARITH1\r
3974 DBLARG=ARITH4\r
3975DADDS, 0 /ADD LO-ORDER\r
3976 CLL CLA\r
3977 TAD DBLAC+1\r
3978 TAD DBLARG+1\r
3979 DCA DBLARG+1\r
3980 RAL /CARRY\r
3981 TAD DBLAC /ADD HI-ORDER\r
3982 TAD DBLARG\r
3983 DCA DBLARG /LEAVE IN ARITH4-5.\r
3984 CLL\r
3985 JMP I DADDS\r
3986\r
3987/FLOATING CONSTANT USED BY [SU54A]\r
3988K100MF, 0033 /100,000,000(10)\r
3989 2765\r
3990 7020\r
3991\r
3992\r
3993\f*6400\r
3994/2-PAGE FLOATING POINT PACKAGE [SU64AC] - REQUIRES [SU63A]\r
3995/LOAD, SAVE, DCOM, NORM, FMUL, FIX, DFIX, FADD, FDIV, FLOAT\r
3996/FLOATING POINT FORMAT\r
3997/ WORD1: EXPONENT (2'S COMPLEMENT)\r
3998/ WORD2: HI ORDER MANTISSA\r
3999/ WORD3: LO ORDER MANTISSA\r
4000/\r
4001/MANTISSA IS REPRESENTED IN 24 BIT, 2'S COMPLEMENT NOTATION\r
4002/A FLOATING POINT IS STORED AS MANTISSA*2^ EXPONENT\r
4003/ZERO IS ALWAYS STORED AS 0*2^0\r
4004/0.5 .LE. .ABS. MANTISSA .LT. 1.0\r
4005\r
4006/FLOATING POINT ACCUMULATOR\r
4007 FAC=ARITH0\r
4008/FLOATING POINT OPERATOR\r
4009 FOP=ARITH3\r
4010\r
4011/SUBROUTINE TO LOAD FLOATING ACCUMULATOR: LOAD\r
4012/TEMPORARY STORAGE ALLOCATION\r
4013 LDPNT=17\r
4014\r
4015LOADS, 0\r
4016 CLL CML CLA CMA /CALL: LOAD\r
4017 TAD I LOADS / ADDRESS\r
4018 DCA LDPNT /GETS ADDRESS, ADDRESS+1, ADDRESS+2 TO FAC\r
4019 ISZ LOADS\r
4020 TAD I LDPNT /ORDER IN MEMORY IS ASSUMED TO BE:\r
4021 DCA FAC / WORD1\r
4022 TAD I LDPNT\r
4023 DCA FAC+1 / WORD2\r
4024 TAD I LDPNT\r
4025 DCA FAC+2 / WORD3\r
4026 JMP I LOADS\r
4027\r
4028\r
4029/SUBROUTINE TO SAVE FLOATING ACCUMULATOR: SAVE\r
4030/TEMPORARY STORAGE ALLOCATION\r
4031 SVPNT=17\r
4032\r
4033SAVES, 0\r
4034 CLL CML CLA CMA /CALL: SAVE\r
4035 TAD I SAVES / ADDRESS\r
4036 DCA SVPNT\r
4037 ISZ SAVES /SAVES FAC IN ADDRESS, ADDRESS+1, ADDRESS+2\r
4038 TAD FAC /ORDER: WORD1\r
4039 DCA I SVPNT\r
4040 TAD FAC+1 /ORDER: WORD2\r
4041 DCA I SVPNT\r
4042 TAD FAC+2 /ORDER: WORD3 \r
4043 DCA I SVPNT\r
4044 JMP I SAVES\r
4045\f/SUBROUTINE TO FORM NEGATIVE OF ARITH1-2: DCOM\r
4046DCOMS, 0\r
4047 CLL CLA\r
4048 TAD ARITH2\r
4049 CMA IAC\r
4050 DCA ARITH2 /-ARITH2 TO ARITH2\r
4051 TAD ARITH1 /CARRY IS IN LINK BIT\r
4052 CMA\r
4053 SZL /DO CARRY\r
4054 IAC\r
4055 DCA ARITH1\r
4056 JMP I DCOMS\r
4057\r
4058/SUBROUTINE TO NORMALIZE MANTISSA IN FAC: NORM\r
4059/MODIFIES ARITH 1-2 (NORHI,NORLO), TEMP01(IN SHFT), TEMP02(NORCNT)\r
4060/LEAVES FAC MANTISSA NORMALIZED, \r
4061/SIGN OF MANTISSA IN LINK BIT, EXPONENT IN AC\r
4062/TEMPORARY STORAGE ALLOCATION\r
4063 NORCNT=TEMP02\r
4064\r
4065/ARITHMETIC REGISTER ALLOCATION\r
4066 NORHI=FAC+1\r
4067 NORLO=FAC+2\r
4068\r
4069NORMS, 0\r
4070 CLL CLA\r
4071 TAD KM0027 /-23(10)\r
4072 DCA NORCNT\r
4073NORLV, TAD NORHI\r
4074 CLL RAL\r
4075 SMA SNL /TEST FOR L,AC0\r
4076 JMP NORSH /0,0 - SHIFT IT\r
4077 CMA CML /1,1 TO 0,0\r
4078 SPA SZL CLA /TEST FOR 1,1\r
4079 JMP NOREX /0,1 OR 1,0 - DONE\r
4080 TAD NORHI /1,1 - TEST FOR 6000\r
4081 AND K1777\r
4082 SZA CLA\r
4083 JMP NORSH /NO - CONTINUE\r
4084 TAD NORLO /YES - TEST FOR 6000 0000\r
4085 SNA CLA\r
4086 JMP NOREX /YES AND L HOLD 1 FOR -\r
4087NORSH, CLL CLA IAC\r
4088 SHFT /1 LEFT\r
4089 ISZ NORCNT /23 TIMES?\r
4090 JMP NORLV /NO - LOOK AGAIN\r
4091NOREX, CML /23 SHIFTS IS ENOUGH - OR DONE\r
4092 TAD NORCNT\r
4093 CMA IAC /L GETS COMPLEMENTED IF=0, NORM OF 0 LEAVES 0 IN L.\r
4094 JMP I NORMS\r
4095\r
4096/LOCAL CONSTANT\r
4097K1777, +1777\r
4098\f/SUBROUTINE FOR FLOATING POINT MULTIPLICATION: FMUL\r
4099/CALL: FMUL /ONE ARGUMENT\r
4100/ ARG ADDRESS /ARG IS THE OTHER\r
4101/ (RETURN) /AC=0, L UNSPECIFIED\r
4102/MODIFIES ARITH0-5(FAC,FOP), TEMP01-12\r
4103/USES SUBROUTINES NORM,SHFT,DADD,DCOM,SAVE,LOAD\r
4104/LEAVES RESULT IN FAC\r
4105/TEMPORARY STORAGE ALLOCATION\r
4106 FMULP=TEMP10 /11 AND 12\r
4107\r
4108FMULS, 0\r
4109 TAD I FMULS\r
4110 JMS I GARGX /GET ARG AND FAC MAGNITUDE, SET SIGN\r
4111 ISZ FMULS /FIX UP RETURN ADDRESS\r
4112 SAVE\r
4113 FMULP\r
4114 DCA FOP+1 /CLEAR PRODUCT ACCUMULATION\r
4115 DCA FOP+2\r
4116MULOOP, LOAD /SHIFT MULTIPLIER TO TEST\r
4117 FMULP /WHETHER TO INCREASE PRODUCT\r
4118 IAC /(FIRST TIME THRU IS ZERO SO WE\r
4119 SHFT /SKIP IT)\r
4120 SAVE\r
4121 FMULP\r
4122 LOAD /DECREASE POSSIBLE PRODUCT\r
4123 FARG /INCREMENT BY A FACTOR OF 2\r
4124 CLA CMA\r
4125 SHFT\r
4126 SAVE\r
4127 FARG\r
4128 TAD FMULP+1 /BIT 0 IS FLAG FOR INCREASING\r
4129 SPA CLA /PRODUCT ACCUMULATION\r
4130 DADD /BY CURRENT INCREMENT\r
4131 ISZ FCNTR /DO THIS 23 TIMES\r
4132 JMP MULOOP\r
4133 LOAD /NORMALIZE RESULT MANTISSA\r
4134 FOP\r
4135 JMS NORMS /ADJUST EXPONENT\r
4136 SNA\r
4137 JMP FMEXP /MANTISSA WAS ZERO\r
4138 TAD FMULP\r
4139 TAD FARG\r
4140 TAD KM0027\r
4141\r
4142FMEXP, DCA FAC\r
4143 TAD FLSIGN /FIX SIGN OF RESULT\r
4144 SZA CLA\r
4145 DCOM\r
4146 JMP I FMULS\r
4147\r
4148/LOCAL CROSSPAGE\r
4149GARGX, GARG\r
4150\f/THIS SUBROUTINE FIXES FAC TO AC: FIX\r
4151FIXS, 0\r
4152 TAD FAC /AC BIASES FIX\r
4153 SPA SNA /FIX OF FAC .LT. 1 GIVES 0 IN AC\r
4154 JMP FIXNG\r
4155 TAD KM14\r
4156 SMA /FIX OF .ABS. FAC .GE. 2^11; EXITS 0 IN AC\r
4157 JMP FIXNG\r
4158 IAC\r
4159 SHFT\r
4160 TAD ARITH1\r
4161 JMP I FIXS\r
4162\r
4163FIXNG, CLL CLA\r
4164 JMP I FIXS\r
4165\r
4166/LOCAL CONSTANT\r
4167KM14, -0014\r
4168\r
4169/SUBROUTINE TO FIX FAC TO DBL PREC IN FAC+1 AND FAC+2\r
4170 DFIXL=TEMP01\r
4171\r
4172DFIXS, 0\r
4173 TAD FAC /AC BIASES FIX\r
4174 TAD KM0027\r
4175 SHFT\r
4176 TAD I DFIXS /CALL+1 HOLDS ADDRESS OF HI ORDER FIX\r
4177 ISZ DFIXS\r
4178 DCA DFIXL\r
4179 TAD FAC+1 /STORE AT C(CALL+1) AND C(CALL+1)+1\r
4180 DCA I DFIXL\r
4181 ISZ DFIXL\r
4182 TAD FAC+2\r
4183 DCA I DFIXL\r
4184 JMP I DFIXS /EXIT TO CALL+2\r
4185\f*.-1 177+1\r
4186/PAGE 2 OF 2 PAGE FLOATING POINT PACKAGE [SU64A]\r
4187/FADD, FDIV, FLOAT\r
4188\r
4189/SUBROUTINE TO FLOATING ADD TO FAC: FADD\r
4190/CALL: FADD\r
4191/ ADDRESS\r
4192/MODIFIES ARITH 0-5 (FAC,FOP), TEMP01(FADSHF),TEMP02-04(ADDEND),\r
4193/TEMP05-07(AUGEND)\r
4194/USES SUBROUTINES: NORM, SHFT, DADD, SAVE, LOAD\r
4195/RESULT IN FAC (RE-NORMALIZED),AC=0,L=U\r
4196\r
4197/TEMPORARY STORAGE ALLOCATION:\r
4198 FADSHF=TEMP01\r
4199 ADDEND=TEMP02 /03 AND 04\r
4200 AUGEND=TEMP05 /06 AND 07\r
4201\r
4202/ARITHMETIC REGISTER ALLOCATION\r
4203 BIGGER=FOP\r
4204\r
4205FADDS, 0\r
4206 CLA CMA\r
4207 SHFT /PREPARE FOR POSSIBLE DADD OVERFLOW\r
4208 SAVE /LOSES LSB OF MANTISSA\r
4209 ADDEND\r
4210 TAD I FADDS /GET ARGUMENT ADDRESS\r
4211 DCA .+2\r
4212 LOAD /ARGUMENT TO FAC\r
4213 0\r
4214 CLA CMA /SHIFT FOR POSSIBLE OVERFLOW ALSO\r
4215 SHFT\r
4216 SAVE /SUM HAS 23 BITS PRECISION\r
4217 AUGEND\r
4218 ISZ FADDS /SETUP FOR EXIT\r
4219 TAD ADDEND /COMPARE EXPONENTS\r
4220 CMA IAC /WHICH TO SHIFT (SMALLER ARGUMENT)\r
4221 TAD AUGEND /TO ALIGN BINARY POINTS\r
4222 SPA /EXP DIFFERENCE IN AC\r
4223 JMP FADADD /EXP OF AUGEND SMALLER\r
4224 CMA IAC /MAKE DIFFERENCE NEGATIVE\r
4225 DCA FADSHF /TO SHIFT RIGHT\r
4226 LOAD /AUGEND (OLD FAC) IS LARGER\r
4227 AUGEND\r
4228 SAVE\r
4229 BIGGER\r
4230 LOAD /PREPARE TO SHIFT ADDEND\r
4231 ADDEND\r
4232 JMP FADFIN\r
4233\fFADADD, DCA FADSHF /AUGEND (OLD FAC) IS SMALLER\r
4234 LOAD\r
4235 ADDEND\r
4236 SAVE /SAVE ADDEND AS LARGER ARGUMENT\r
4237 BIGGER\r
4238 LOAD /PREPARE TO SHIFT SMALLER ARG\r
4239 AUGEND\r
4240\r
4241FADFIN, TAD FADSHF\r
4242 SHFT /ALIGN ARGUMENTS\r
4243 DADD /ADD MANTISSAS\r
4244 LOAD /NORMALIZE RESULT\r
4245 FOP\r
4246 NORM\r
4247 SNA /0 IF MANISSAS ADDED TO 0\r
4248 JMP FADEXP /ZERO SHOWN AS 0*2^0\r
4249 TAD KM0026 /-22(10)\r
4250 TAD BIGGER /ADD +1 TO -21(10) TO LARGER EXP\r
4251FADEXP, DCA FAC /SAVE AS NEW EXPONENT\r
4252 JMP I FADDS\r
4253\r
4254/LOCAL CONSTANT\r
4255KM0026, -0026\r
4256\r
4257/SUBROUTINE TO INITIALIZE COUNTERS AND SWITCHES USED IN FMUL AND FDIV\r
4258 FLSIGN=TEMP03\r
4259 FCNTR=TEMP04\r
4260 FARG=TEMP05 /06 AND 07\r
4261\r
4262GARG, 0\r
4263 DCA LOCARG /AC HOLDS LOCATION OF ARGUMENT\r
4264 TAD FAC+1\r
4265 SMA CLA /SET FLSIGN WITH SIGN OF FAC\r
4266 CMA\r
4267 DCA FLSIGN\r
4268 ISZ FLSIGN /LEAVE FLSIGN=0 FOR +, 1 FOR -\r
4269 DCOM /GET .ABS. FAC\r
4270 SAVE\r
4271 FARG\r
4272 LOAD\r
4273EJECT\r
4274 \r
4275LOCARG, 0\r
4276 TAD FAC+1 /GET SIGN OF ARGUMENT\r
4277 SPA CLA\r
4278 CLA CMA\r
4279 TAD FLSIGN /+OP+=+, -OP-=+, +OP-=-, -OP+=-\r
4280 DCA FLSIGN /FLSIGN = 0 FOR +, .NE. 0 FOR -\r
4281 TAD FAC+1 /GET .ABS. ARG\r
4282 SPA CLA\r
4283 DCOM /.LT. 0: GET COMPLEMENT AND SET L=0\r
4284 TAD KM0027 /-23(10)\r
4285 DCA FCNTR\r
4286 JMP I GARG \r
4287\f/THIS SUBROUTINE FLOATS AC TO FAC: FLOAT\r
4288FLOATS, 0\r
4289 DCA FAC+1\r
4290 TAD KM014 /SHIFT TO GET SIGN EXTENSION\r
4291 SHFT\r
4292 NORM\r
4293 DCA FAC /NORMALIZE\r
4294 JMP I FLOATS\r
4295\r
4296/LOCAL CONSTANT\r
4297KM014, -0014\r
4298\r
4299/SUBROUTINE TO FLOATING DIVIDE FAC BY ARGUMENT- FDIV\r
4300/CALL: FDIV\r
4301/ ARG ADDRESS /ARG ADDRESS HOLD ARGUMENT\r
4302/ (RETURN) /AC=0, L UNSPECIFIED\r
4303/MODIFIES ARITH0-5 (FAC,FOP), TEMP01-14, REMAINDER IN FOP\r
4304/TEMPORARY STORAGE ALLOCATION\r
4305 DVSOR=TEMP10 /11 AND 12\r
4306 QUO=TEMP05 /06 AND 07\r
4307\r
4308FDIVS, 0\r
4309 TAD I FDIVS /GET ADDRESS OF ARGUMENT\r
4310 ISZ FDIVS /EXIT TO CALL+2\r
4311 JMS GARG /GET .ABS. FAC, .ABS. ARG, SIGN OF RESULT\r
4312 DCOM\r
4313 SAVE /ARG IS DIVISOR\r
4314 DVSOR\r
4315 LOAD /.ABS. FAC: DIVIDEND\r
4316 FARG\r
4317 SAVE\r
4318 FOP\r
4319 DCA FAC+1 /FAC WILL HOLD QUOTIENT\r
4320 DCA FAC+2\r
4321DVLOOP, IAC /QUO*2\r
4322 SHFT\r
4323 SAVE\r
4324 QUO\r
4325 LOAD\r
4326 DVSOR /TRIAL SUBTRACTION\r
4327 DADD\r
4328 TAD FOP+1 /CHECK FOR - AS RESULT OF TRIAL\r
4329 SMA CLA\r
4330 JMP DVOK /POSITIVE, INCREASE QUOTIENT\r
4331 DCOM /NEGATIVE, REVERSE\r
4332 DADD\r
4333 DCOM\r
4334 SKP /BUT DON'T INCREASE QUOTIENT\r
4335\fDVOK, ISZ QUO+2 /MARK QUOTIENT\r
4336 CLA CMA /NEXT TIME REDUCE DIMINISHER\r
4337 SHFT\r
4338 SAVE\r
4339 DVSOR\r
4340 LOAD /MAKE READY TO MULTIPLY QUOTIENT\r
4341 QUO\r
4342 ISZ FCNTR /DO THIS 23 TIMES\r
4343 JMP DVLOOP /CONTINUE\r
4344 NORM /NORMALIZE MANTISSA\r
4345 SNA\r
4346 JMP DVEXP /0 MANTISSA IMPLIES ZERO - EXIT IMMEDIATELY\r
4347 TAD FOP /ADJUST EXPONENT\r
4348 TAD KM0026\r
4349 CMA IAC\r
4350 TAD DVSOR\r
4351 CMA IAC\r
4352DVEXP, DCA FAC\r
4353 TAD FLSIGN /ADJUST SIGN\r
4354 SZA CLA /FLSIGN=0 FOR POSITIVE QUOTIENT\r
4355 DCOM\r
4356 JMP I FDIVS\r
4357\r
4358\f\r
4359*7000\r
4360/SUBROUTINE TO TYPE AND OUTPUT A MESSAGE UNTIL A TXMRK\r
4361TXPUNS, 0\r
4362 TAD I TXPUNS /GET MESSAGE ADDRESS\r
4363 ISZ TXPUNS\r
4364 DCA .+2\r
4365 SETH /SET HALFWD POINTERS\r
4366 0\r
4367 JMS DBLPUN /TYPE AND PUNCH\r
4368 JMP I TXPUNS\r
4369\r
4370/SUBROUTINE TO TYPE AND OUTPUT A MESSAGE BETWEEN TXMRKS\r
4371TPUNQS, 0\r
4372 TAD TXMRK /MOVE TO MESSAGE\r
4373 SRCH\r
4374 JMP I TPUNQS /NO MESSAGE - EXIT\r
4375 JMS DBLPUN /TYPE & PUNCH UNTIL TXMRK\r
4376 JMP I TPUNQS\r
4377\r
4378/PUNCH AND TYPE UNTIL A TXMRK OR END OF RECORD\r
4379DBLPUN, 0\r
4380 TAD K0377 /PRECEED MESSAGE WITH RUBOUT\r
4381 DCA BSAVE\r
4382DBLNXT, JMS PCOPYS /PUNCH FOR HI, NOP FOR LO SPEED PUNCH\r
4383 LDH /GET CHARACTER\r
4384 BRAN /CR OR TX MRK?\r
4385 CRTX\r
4386 JMP DBLCR /C.R.\r
4387 JMP DBLEXT /TX MARK\r
4388 TAD BSAVE /OTHER - TYPE IT\r
4389DBLTYP, TYPE\r
4390 JMP DBLNXT /PUNCH THIS AND GET NEXT\r
4391DBLEXT, TAD K0377 /E.O.R. OR TXMRK\r
4392 JMS I PUNCHX /BRACKET MESSAGE WITH RUBOUTS\r
4393 JMP I DBLPUN /EXIT\r
4394\r
4395DBLCR, TAD K0215 /PUNCH CR\r
4396 DCA BSAVE\r
4397 JMS PCOPYS\r
4398 TAD KCR /TYPE CRLF\r
4399 JMP DBLTYP /AND THEN PUNCH LF\r
4400\r
4401/SUBROTINE TO PUNCH ON PC8I WHAT WAS TYPED OR NOP IF NO PC8I\r
4402PCOPYS, 0\r
4403 LAS /CHECK SWITCHES\r
4404 SPA CLA /+ FOR PC8I, - FOR ASR33\r
4405 JMP I PCOPYS /-, EXIT IMMEDIATELY\r
4406 TAD BSAVE /IS IT A LEGIT ASCII CODE?\r
4407 AND K0200\r
4408 SNA CLA\r
4409 JMP I PCOPYS /NO - EXIT IMMEDIATELY\r
4410 TAD BSAVE /OK - PUNCH IT\r
4411 JMS I PUNCHX\r
4412 JMP I PCOPYS\r
4413\r
4414\f/SUBROUTINE TO PUNCH LEADER-TRAILER\r
4415LTPUNS, 0\r
4416 TAD KM0043\r
4417 DCA TLTCNT /# OF 200 CODES TO PUNCH\r
4418 TLTCNT=TEMP02\r
4419 TAD K0200 /200\r
4420 JMS I PUNCHX /PUNCH\r
4421 ISZ TLTCNT\r
4422 JMP .-3\r
4423 JMP I LTPUNS\r
4424\r
4425/LOCAL CONSTANTS\r
4426K16, 16\r
4427ENPARA, KBLB\r
4428K0200, 0200\r
4429K0215, 0215\r
4430RATE, 0\r
4431K0700, 700\r
4432\r
4433/LOCAL CROSSPAGE\r
4434BINAX, BINAS\r
4435BINGX, BINGS\r
4436PUNCHX, PUNCHS\r
4437\r
4438/OUTPUT REST OF TEXT AND PUNCH PARAMETER TAPE\r
4439CON34, JMS TXPUNS /"<CRLF> SYNC ON CHANNEL: "-\r
4440 DIS01\r
4441 JMS DBLPUN /"<CRLF>SYNC ON CHANNEL:S#"\r
4442 JMS DBLPUN /"<CRLF>SYNC ON CHANNEL:S#<CRLF>"\r
4443 SETH\r
4444 DIS25\r
4445 JMS TPUNQS /"####"\r
4446 JMS TXPUNS /"#### SWEEPS AT"\r
4447 TXT34B\r
4448 SETH /"#### SWEEPS AT ######"\r
4449 DIS24\r
4450 JMS TPUNQS\r
4451 JMS TPUNQS /"#### SWEEPS AT ######*"\r
4452 JMS TXPUNS /"#### SWEEPS AT ######*S'<CRLF>"\r
4453 TXT34C\r
4454 TAD XROPT /IS THERE A SORT?\r
4455 SNA CLA\r
4456 JMP CON34A /NO-SKIP AHEAD\r
4457 JMS TXPUNS /"SORT AT"\r
4458 DIS12\r
4459 JMS DBLPUN /"SORT AT ###### *S<CRLF>"\r
4460 JMS TPUNQS\r
4461 JMS TXPUNS\r
4462 TXT34C\r
4463\fCON34A, JMS TXPUNS /"(V**,#,####-####)<CRLF>"\r
4464 DIS99\r
4465 TAD LNBUFB /WAS THE B-SWEEP USED?\r
4466 SNA CLA\r
4467 DCA KBTOA /NO, DISABLE IT\r
4468 DCA RATE\r
4469 LOAD /CLEAR RATE\r
4470 FASI /LOAD-A SWEEP SAMPLING RATE\r
4471 JMP INTO /JUMP TO TRIAL SUBTRACT\r
4472SIZE, LOAD\r
4473 TEMP\r
4474 FDIV\r
4475 TEN /REDUCE SAMPLING RATE BY TEN\r
4476INTO, SAVE /SAVE RESULT\r
4477 TEMP /AND DO A TRIAL SUBTRACT\r
4478 FADD\r
4479 F4K\r
4480 ISZ RATE /RECORD THE SUBTRACT\r
4481 TAD FAC+1\r
4482 SPA CLA /TEST IT\r
4483 JMP SIZE /DO IT AGAIN\r
4484 NOP\r
4485 DFIX /NOW FIX THE REMAINDER\r
4486 15 /AND FIX THE RATE FOR THE CLOCK\r
4487 TAD RATE\r
4488 BSW /1 GOES TO 100, 2 GOES TO 200, ETC.\r
4489 CMA /COMPLEMENT OF THESE THREE BITS IS THE RATE MODE\r
4490 AND K0700\r
4491 TAD KMODE\r
4492 DCA KMODE\r
4493 JMS LTPUNS /PUNCH OUT 200 CODE\r
4494 TAD K16 /OUTPUT PARAMETERS (BIN)\r
4495 JMS I BINAX\r
4496 TAD ENPARA /OUTPUT FROM ADPARA TO END OF PARAMETERS\r
4497 JMS I BINGX\r
4498 TAD ADJLIS /OUTPUT LISTS (BIN)\r
4499 IAC\r
4500 JMS I BINAX\r
4501 TAD ADBUFA /OUTPUT FROM ADJLIS TO ADBUFA\r
4502 JMS I BINGX\r
4503EJECT\r
4504 \r
4505CON34B, TAD ADJLIS /PUNCH OUT DATA BLOCK LINKAGES\r
4506 DCA AXPNTR /SET UP TO LOOK AT JOB LIST\r
4507 TAD MEMTOT /SET AVAILABLE FIELD COUNT\r
4508 CMA\r
4509 DCA TFIELD /-# OF FIELDS IN CONFIGURATION\r
4510 TFIELD=TEMP16\r
4511 TAD KHICOR /FIELD 0 MAX ALLOWABLE ADDR.\r
4512 DCA TMAXPG\r
4513 TMAXPG=TEMP17\r
4514 TAD ADBUFB\r
4515 TAD LNBUFB\r
4516 DCA TCURAD\r
4517 TCURAD=TEMP20\r
4518\fCON35, TAD I AXPNTR /GET J1\r
4519 SNA CLA\r
4520 JMP CON37 /J1=0 FOR E.O.L.\r
4521 DCA LINST1 /SET LINK FLAG 0.\r
4522 ISZ AXPNTR /SKIP J2\r
4523 TAD I AXPNTR /J3 HOLDS # OF CELLS/POINT\r
4524 FLOAT\r
4525 SAVE\r
4526 FLOT01\r
4527 TAD K6201 /CDF 0\r
4528 JMS I BINFY\r
4529 TAD AXPNTR /ADDRESS OF LINKAGE (AXPNTR=J3)\r
4530 JMS I BINAY /PUNCH IT\r
4531 TAD I AXPNTR /GET # OF POINTS REQUIRED (J4)\r
4532 DCA TPOINT\r
4533 TPOINT=TEMP15\r
4534 TAD K0003 /SKIP J5, J6, AND J7\r
4535 TAD AXPNTR\r
4536 DCA AXPNTR\r
4537 TWO /FIRST BLOCK HAS 1 LOCATION FOR SWEEP COUNT\r
4538\r
4539CON35A, DCA INITOS\r
4540 TAD K0003 /3 LOCATIONS FOR LINKAGES\r
4541 TAD TCURAD /CURRENT FREE ADDRESS\r
4542 CMA IAC\r
4543 TAD TMAXPG /COMPARE AGAINST MAX ALLOWABLE FOR FIELD\r
4544 DCA FAC+2\r
4545 DCA FAC+1\r
4546 NORM /# OF LOCATIONS AVAILABLE\r
4547 DCA FAC\r
4548 FDIV /LOCATIONS/LOC PER POINT\r
4549 FLOT01\r
4550 FIX\r
4551 DCA TSAM /#POINTS AVAIL FOR THIS BLOCK\r
4552 TSAM=TEMP13\r
4553\r
4554CON36, TAD TSAM /POINTS AVAILABLE\r
4555 TAD TPOINT /POINTS REQUIRED\r
4556 SMA /DECREASE POINTS REQ BY POINTS AVAIL\r
4557 CLA /UNLESS MORE ARE AVAIL THAN ARE REQ\r
4558 DCA TREQ /-POINTS REQ AFTER THIS BLOCK\r
4559 TREQ=TEMP01\r
4560\f TAD TREQ \r
4561 CMA IAC\r
4562 TAD TPOINT /+POINTS REQUIRED BEFORE THIS BLOCK\r
4563 DCA TBLK /POINTS IN THIS BLOCK.\r
4564 TBLK=TEMP02\r
4565 TAD TREQ /UPDATE POINTS REQUIRED\r
4566 DCA TPOINT\r
4567 TAD TBLK /LINK 1:-POINTS IN BLK (NEXT)\r
4568 JMS LINSTX /STORE LOC IN FIELD 1\r
4569 /*******OLD WAS JMS I BINDY\r
4570 TAD TFIELD /-# OF FIELDS LEFT \r
4571 TAD MEMTOT /+# OF FIELDS IN MACHINE -1\r
4572 IAC /+1: CURRENT FIELD\r
4573 CLL RTL /MAKE A CDF N INSTRUCTION\r
4574 RAL\r
4575 TAD K6201 /LINK2: CDF N\r
4576 DCA NXTCDF\r
4577 NXTCDF=TEMP14\r
4578\r
4579 TAD NXTCDF\r
4580 JMS LINSTX /******WAS JMS I BINDY\r
4581 TAD TCURAD /L3: NEXT BLOCK STARTS AT ...-1\r
4582 JMS LINSTX /***** WAS JMS I BINDY\r
4583 TAD TBLK /-POINTS IN BLOCK\r
4584 CMA IAC\r
4585 SNA /ANY POINTS IN BLOCK BEING LINKED TO?\r
4586 JMP CON35 /NO-GET NEXT JOB\r
4587 FLOAT /YES - GET BLOCK LENGTH\r
4588 FMUL /#CELLS IN BLK = PTS * CELLS/PNT\r
4589 FLOT01\r
4590 CLA CMA\r
4591 FIX\r
4592 CLA IAC\r
4593 SHFT\r
4594 TAD SHFR\r
4595 TAD TCURAD /CURRENT ADDR+BLK LENGTH\r
4596 DCA TCURAD /GETS NEW CURADDR.(NEXT BLOCK START -1)\r
4597 ISZ LINST1 /SET FLAG TO STORE CORE LINKS.\r
4598 TAD NXTCDF /PUNCH LINKAGE WORDS\r
4599 JMS I BINFY /FIELD\r
4600 TAD TCURAD /AND ADDRESS\r
4601 TAD INITOS /ADJUST FOR FIRST BLOCK LENGTH\r
4602 JMS I BINAY\r
4603 TAD K0003 /MOVE OVER L1,L2,L3\r
4604EJECT\r
4605 \r
4606 TAD TCURAD\r
4607 DCA TCURAD\r
4608 TAD TPOINT /IF POINTS STILL REQ .NE. 0, NEW FIELD\r
4609 SNA CLA /IF .EQ. 0, PUT END-OF-BLOCK\r
4610 JMP CON36 /PUT E.O.B.\r
4611 CLA CMA /NEW FIELD, START AT 0000\r
4612 DCA TCURAD\r
4613 TAD K7577\r
4614 DCA TMAXPG /ALL BUT FIELD 0 HAVE 7600 CELLS\r
4615 IAC /TCURAD IS ADDR-1\r
4616 ISZ TFIELD /UPDATE FIELD COUNT\r
4617 JMP CON35A /BLOCK OUT NEXT FIELD\r
4618\fCON37, TAD CHKSUM /FINISH OUTPUT DEVICE.\r
4619 JMS I BINDY\r
4620 JMS I LTPUNX /PUNCH CHECKSUM AND LEADER TRAILER.\r
4621 CIF 10\r
4622 TAD TENPUN\r
4623 SZA CLA /PUNCHED CONTROL TAPE?\r
4624 JMP I PCONTX /YES WRITE CONTROL TAPE TO M.S.\r
4625 JMP I .+1 /STORE LINKS IN CORE AND DO TRIG.\r
4626 TRIGSU\r
4627\r
4628/SUBROUTINE INITIALIZES PC8I OR ASR33\r
4629/NOT USED ANY MORE.\r
4630INITOS, 0\r
4631 CLA\r
4632 CHKSUM=TEMP21\r
4633 JMP I INITOS\r
4634LINSTX, 0\r
4635 CDF CIF 10\r
4636 JMS I LINKSX /SAVE LINKS IN FIELD 1.\r
4637 JMS I BINDY\r
4638 JMP I LINSTX\r
4639LINKSX, LINKS\r
4640LINST1, 0\r
4641\r
4642\r
4643*7364\r
4644/LOCAL CROSSPAGE\r
4645BINDY, BINDS\r
4646BINAY, BINAS\r
4647BINFY, BINFS\r
4648LTPUNX, LTPUNS\r
4649PCONTX, PCONTT\r
4650\r
4651K7577, 7577\r
4652/LOCAL CONSTANTS\r
4653K6201, 6201\r
4654K0036, 36\r
4655KMCTRL, -220\r
4656KHICOR, HICORE-1\r
4657\r
4658\r
4659/FLOATING CONSTANTS\r
4660TRNTIM, 0011\r
4661 3330\r
4662KZEROF, 0000\r
4663 0000\r
4664 0000\r
4665TEN, 0004\r
4666 2400\r
4667 0000\r
4668\f/OUTPUTS BINARY GROUP STARTING AT BINA ADDRESS\r
4669/AC HOLDS END ADDRESS FOR OUTPUT\r
4670BINGS, 0\r
4671 CMA /-(END ADDRESS+1)\r
4672 TAD SHFR /+ BEGIN ADDRESS\r
4673 DCA BINCNT /IS # OF LOCATIONS TO OUTPUT\r
4674 BINCNT=TEMP02\r
4675 CMA /SET POINTER TO BEGIN ADDRESS\r
4676 TAD SHFR\r
4677 DCA AXPNTR\r
4678 TAD KCDF0\r
4679 JMS BINFS /SET DATA FIELD TO 0\r
4680 TAD I AXPNTR /GET DATA\r
4681 JMS BINDS /PUNCH IT\r
4682 ISZ BINCNT /ENOUGH?\r
4683 JMP .-3 /NO - AGAIN\r
4684 JMP I BINGS\r
4685\r
4686/SUBROUTINE TO PUNCH CHARACTER (8-BIT)\r
4687PUNCHS, 0\r
4688 DCA TCHAR /AC HOLDS 8BIT\r
4689 TCHAR=TEMP01\r
4690 TAD TENPUN /=1 IF PUNCHING\r
4691 CLA /**** CONTROL TAPES NOT PUNCHED.\r
4692 JMP I PUNCHS /NO - EXIT\r
4693 LAS /LOOK AT SWITCHES\r
4694 SMA CLA /SR0=0 FOR HI SPEED\r
4695 JMP PUNCHI /HI SPEED\r
4696PUNLO, TAD TCHAR /LO SPEED - GET CHARACTER\r
4697 TLS /PUNCH IT\r
4698 TSF\r
4699 JMP .-1\r
4700 TCF /LEAVE WITH CLEARED FLAG\r
4701 CLA\r
4702 JMP I PUNCHS\r
4703PUNCHI, TAD TCHAR /HI - GET CHARACTER\r
4704 PLS /PUNCH IT\r
4705 LAS /IF SR WAS SET INCORRECTLY\r
4706 SPA CLA /ALLOW USER TO RECOVER\r
4707 JMP PUNLO /PUNCH THIS ON LO\r
4708 PSF /PUNCH THIS ON HI\r
4709 JMP .-4\r
4710 PCF\r
4711 JMP I PUNCHS\r
4712\f/SUBROUTINE CONVERTS AC TO TWO DATA FRAMES\r
4713BINDS, 0\r
4714 DCA SHFR+1 /DATA TO BE PUNCHED\r
4715 TAD TENPUN /PUNCH ENABLED?\r
4716 SZA CLA\r
4717 CLA /***** CONTROL TAPES NOT PUNCHED\r
4718 /****** THEY ARE WRITTEN ON MASS STORAGE.\r
4719 TAD SHFR+1 /NO - STORE IN MEMORY\r
4720BINMX, CDF /SET BY BINFS\r
4721 DCA I BPNTR /BPNTR SET UP BY BINAS\r
4722 CDF 0\r
4723BINDO, JMS SHFT6 /GET HI ORDER 6 BITS\r
4724 JMS PUNWDS /PUNCH THEN GET NEXT 6 BITS AND PUNCH\r
4725 JMP I BINDS\r
4726\r
4727/SUBROUTINE CONVERTS AC TO TWO ADDRESS FRAMES\r
4728BINAS, 0\r
4729 DCA SHFR+1 /ADDRESS\r
4730 CLA CMA /SET POINTER FOR STORING IN CORE (IF TENPUN=0)\r
4731 TAD SHFR+1\r
4732 DCA BPNTR\r
4733 BPNTR=11\r
4734 JMS SHFT6 /GET HI ORDER 6 BITS\r
4735 TAD K0100A /SIGNIFIES ADDRESS WORD TO BIN LOADER\r
4736 JMS PUNWDS /PUNCH THEN GET NEXT 6 BITS AND PUNCH\r
4737 JMP I BINAS\r
4738\r
4739/SUBROUTINE TO PUNCH TWO HALVES OF WORD\r
4740PUNWDS, 0\r
4741 JMS UPCHKS /UPDATE CHECKSUM WITH 6 BITS IN AC\r
4742 JMS PUNCHS /PUNCH\r
4743 JMS SHFT6 /GET NEXT 6 BITS\r
4744 JMS UPCHKS /UPDATE CHECKSUM\r
4745 JMS PUNCHS /PUNCH IT OUT\r
4746 JMP I PUNWDS\r
4747\r
4748/SUBROUTINE SHIFTS FAC 6 PLACES AND PUTS OUT 6 RIGHT OF FAC+1\r
4749SHFT6, 0\r
4750 TAD K0006A /SHIFT 6 PLACES LEFT\r
4751 SHFT\r
4752 TAD SHFR /GET RESULT\r
4753 AND K0077B /MASK OFF\r
4754 JMP I SHFT6\r
4755\r
4756/SUBROUTINE CONVERTS AC 9-11 TO FIELDATA\r
4757BINFS, 0\r
4758 DCA BINMX /SET UP CDF N INSTRUCTION IF STORING IN CORE\r
4759 TAD BINMX\r
4760 AND K0070A\r
4761 TAD K0300 /MAKE A FIELD WORD FOR BIN LOADER\r
4762 JMS PUNCHS /PUNCH IT\r
4763 JMP I BINFS\r
4764\f/SUBROUTINE TO UPDATE CHECKSUM\r
4765UPCHKS, 0\r
4766 DCA TEMP01 /SAVE\r
4767 TAD CHKSUM /ADD TO CHECKSUM\r
4768 TAD TEMP01\r
4769 DCA CHKSUM /NEW CHECKSUM\r
4770 TAD TEMP01 /RESTORE\r
4771 JMP I UPCHKS\r
4772\r
4773/LOCAL CONSTANTS\r
4774K0006A, 0006\r
4775K0070A, 0070\r
4776K0077B, 0077\r
4777K0100A, 0100\r
4778K0300, 0300\r
4779KCDF0, 6201\r
4780\r
4781/COME TO 7540 TO CHECK FOR CTRL CHARACTERS\r
4782/THIS VERSION IS FOR PC8I OR ASR 33 \r
4783KBRANS, 0\r
4784 BRAN\r
4785 CTRLST\r
4786 JMP I CTRLC /^C\r
4787 JMP I PRES0Y /^Z\r
4788 TAD BSAVE /NOT ^Z, OR ^C\r
4789 JMP I KBRANS\r
4790\r
4791/LIST OF CTRL CHARACTERS\r
4792CTRLST, +203 /^C\r
4793 -232 /^Z\r
4794\r
4795/INDIRECT BRANCHES\r
4796CTRLC, MONITR /7777 IF PAPER TAPE, 7600 FOR DSK OR DTA\r
4797PRES0Y, PRES00\r
4798\r
4799\f EJECT\r
4800 FIELD 1\r
4801 /WRITE OUT CONTROL FILE.\r
4802*2000\r
4803PCONTT, CDF 0\r
4804 CLA IAC /0-1777 OF FIELD 1 NEED NOT BE SAVED.\r
4805 DCA I (7746\r
4806 CDF 10\r
4807 JMS I (7700\r
4808 5 /CALL COMMAND DECODER.\r
4809 0\r
4810 0\r
4811\r
4812 TAD I (7600\r
4813 SNA /TEST FOR NO OUTPUT FILE.\r
4814 JMP ERR\r
4815 AND (17\r
4816 JMS I (7700\r
4817 1\r
4818ANS1, 7201 /ENTRY POINT.\r
4819 JMP ERR\r
4820\r
4821 TAD I (7600\r
4822 JMS I (7700\r
4823 3\r
4824ANS2, 7601 /RETURN BLOCK START.\r
4825ANS3, 0 /- BLOCK LENGTH RETURNED.\r
4826 JMP ERR\r
4827\r
4828 CDF 0 /LOOK JOB LIST AND CONTROL LIST\r
4829 TAD (230 /END.\r
4830 DCA 10\r
4831 TAD (-3\r
4832 DCA 11\r
4833\r
4834TAG1, TAD I 10\r
4835 SZA CLA\r
4836 JMP .-2\r
4837 ISZ 11\r
4838 JMP TAG1\r
4839 CDF 10\r
4840 CLA IAC\r
4841 TAD 10 /CALCULATE # OF 128 RECORDS.\r
4842 AND (7600\r
4843 CLL RAR\r
4844 DCA ARG1 /LOAD WRITE ARG.\r
4845 IAC\r
4846 TAD 10\r
4847 AND (177\r
4848 SZA CLA\r
4849 TAD (100\r
4850 TAD ARG1\r
4851 TAD (4000\r
4852 DCA ARG1\r
4853 DCA ARG2\r
4854 TAD ANS2\r
4855 DCA ARG3\r
4856\r
4857 JMS FILSZC /TEST IF OUTPUT FILE FULL.\r
4858 JMS FILBWT /WRITE FIELD 0 STUFF.\r
4859\r
4860 TAD ANS2 /RETURN WITH # OF BLOCKS WRITTEN.\r
4861 DCA ARG3 /NEW START BLOCK.\r
4862 TAD (CORSTG /START OF LINKS IN FIELD 1.\r
4863 DCA ARG2\r
4864\r
4865 TAD (100 /CAL. # OF 128 RECORDS TO WRITE.\r
4866 DCA ARG1\r
4867 TAD (CORSTG\r
4868 DCA 20\r
4869TAG3, TAD (-200\r
4870 DCA 21\r
4871TAG2, TAD I 20\r
4872 SNA CLA\r
4873 JMP TAG4\r
4874 TAD 20\r
4875 TAD (5\r
4876 DCA 20\r
4877 TAD 21\r
4878 TAD (5\r
4879 DCA 21\r
4880 TAD 21\r
4881 SPA CLA\r
4882 JMP TAG2\r
4883 TAD (100\r
4884 TAD ARG1\r
4885 DCA ARG1\r
4886 TAD 21\r
4887 JMP TAG3\r
4888\r
4889TAG4, TAD (4010\r
4890 TAD ARG1\r
4891 DCA ARG1\r
4892 JMS FILSZC /TEST IF OUTPUT FILE FULL.\r
4893 JMS FILBWT /WRITE FIELD 1 LINKS.\r
4894 TAD ARG3 /RETURN WITH # OF BLOCKS USED,\r
4895 CIA\r
4896 TAD ANS2 /CALCULATE # OF BLOCKS USED.\r
4897 CIA\r
4898 DCA ARG4\r
4899 TAD I (7600 /CLOSE FILE.\r
4900 AND (17\r
4901 JMS I (7700\r
4902 4\r
4903 7601\r
4904ARG4, 0\r
4905 JMP ERR\r
4906 JMP WDONE\r
4907\r
4908FILBWT, 0\r
4909 CIF 0\r
4910 JMS I ANS1 /WRITE THE FILE.\r
4911ARG1, 0\r
4912ARG2, 0\r
4913ARG3, 0\r
4914 JMP ERR\r
4915\r
4916 TAD ARG1 /CALCULATE # OF 256 BLOCKS.\r
4917 AND (3700\r
4918 CLL RTR\r
4919 RTR\r
4920 RTR\r
4921 RAR\r
4922 SZL\r
4923 IAC\r
4924 JMP I FILBWT\r
4925\r
4926\r
4927*2200\r
4928\r
4929WDONE, CDF CIF 0 /RETURN TO OS-8.\r
4930 JMP I .+1\r
4931 7600\r
4932\r
4933\fFILSZC, 0 /TESTS IF FILE FULL.\r
4934 TAD ARG1 /GET # OF 128 RECORDS,\r
4935 AND (3700 /AND CALCULATE # OF BLOCKS.\r
4936 CLL RTR\r
4937 RTR\r
4938 RTR\r
4939 RAR\r
4940 SZL\r
4941 IAC CLL\r
4942 TAD ANS3 /TEST IF SIZE OVERFLOW.\r
4943 SNL\r
4944 JMP .+3\r
4945 SZA\r
4946 JMP ERR\r
4947 DCA ANS3\r
4948 JMP I FILSZC\r
4949\r
4950ERR, HLT\r
4951 CLA CLL\r
4952 JMS I (7700 /ERROR MESSAGE.\r
4953 7\r
4954 0\r
4955 HLT\r
4956\r
4957 /READ IN CONTROL FILE\r
4958\r
4959CONTAP, CLA CLL\r
4960 CDF 0 /SAVE LINKS FOR CHAIN.\r
4961 TAD I (5\r
4962 DCA CONSA1\r
4963 TAD I (6\r
4964 DCA CONSA2\r
4965 TAD I (7\r
4966 DCA CONSA3\r
4967\r
4968 CDF 10\r
4969 JMS I (7700 /CALL COMMAND DECODER\r
4970 5\r
4971 0\r
4972 0\r
4973\r
4974 TAD I (7617\r
4975 SNA /TEST FOR NO INPUT FILE.\r
4976 JMP ERR\r
4977 JMS I (7700 /FETCH DEVICE HANDLER\r
4978 1\r
4979CONTP1, 7201 /ENTRY POINT.\r
4980 JMP ERR\r
4981\r
4982 TAD (200 /SETUP TO READ FILE.\r
4983 DCA CONP1\r
4984 TAD I (7620\r
4985 DCA CONP3\r
4986 JMS FILERD /READ 1ST BLOCK.\r
4987 TAD (-150\r
4988 DCA CONSA5 /# OF LOC TO SEARCH.\r
4989 JMP .+2\r
4990CONTP5, JMS FILERD /READ NEXT BLOCK.\r
4991CONTP2, CDF 0\r
4992 TAD I CONSA4 /SEARCH FOR END OF JOB LIST AND\r
4993 /OTHER PAR. 3 RD 0 IS END.\r
4994 ISZ CONSA4\r
4995 CDF 10\r
4996 SNA CLA\r
4997 JMP CONTP3\r
4998CONTP4, ISZ CONSA5 /FIND END OF BLOCK READ.\r
4999 JMP CONTP2\r
5000 JMP CONTP5\r
5001CONTP3, ISZ CONSA6 /CHECK FOR 3RD 0.\r
5002 JMP CONTP4\r
5003 TAD (210 /FIELD 0 DATA IN.\r
5004 DCA CONP1 /READ FIELD 1 DATA.\r
5005 TAD (CORSTG\r
5006 DCA CONP2\r
5007CONTP6, TAD (CORSTG\r
5008 DCA CONSA4\r
5009CONTP9, JMS FILERD /READ NEXT BLOCK.\r
5010CONTP8, TAD I CONSA4 /0 MARKS THE END OF THE LINKS\r
5011/5 LOC. PER LINK,CDF,ORG.,AND 3 LINK WORDS.\r
5012/IF CDF IS 0 ITS THE END.\r
5013 SNA CLA\r
5014 JMP CONTP7\r
5015 TAD (5\r
5016 TAD CONSA4\r
5017 DCA CONSA4\r
5018 ISZ CONSA5\r
5019 JMP CONTP8\r
5020 JMP CONTP9\r
5021\r
5022CONTP7, CDF 0 /RESTOR LINKS FOR CHAIN.\r
5023\r
5024 TAD CONSA1\r
5025 DCA I (5\r
5026 TAD CONSA2\r
5027 DCA I (6\r
5028 TAD CONSA3\r
5029 DCA I (7\r
5030\r
5031 JMP I (TRIGSU\r
5032\r
5033CONSA1, 0\r
5034CONSA2, 0\r
5035CONSA3, 0\r
5036CONSA4, 230\r
5037CONSA5, 0\r
5038CONSA6, -3\r
5039\r
5040FILERD, 0\r
5041 CIF 0\r
5042 JMS I CONTP1\r
5043CONP1, 0\r
5044CONP2, 0 /SET TO READ TO LOC 0 ON 1ST READ.\r
5045CONP3, 0\r
5046 JMP ERR\r
5047 TAD (-400\r
5048 DCA CONSA5\r
5049 ISZ CONP3\r
5050 TAD CONP2\r
5051 TAD (400\r
5052 DCA CONP2\r
5053 JMP I FILERD\r
5054\r
5055\f*2400\r
5056LINKS, 0\r
5057 DCA LK1 /SAVE LINK VALUE TO SAVE.\r
5058 CDF 0\r
5059 TAD I (LINST1 /TEST TO STORE LINKS.\r
5060 SNA CLA\r
5061 JMP LK4 /NO IF 0.\r
5062 ISZ LK2 /PROGRAM IS ONE PASS,LK2 SET ON LOAD.\r
5063 JMP LK3 /NOT A NEW LINK.\r
5064 TAD I (BINMX /NEW LINK SAVE CDF,ORG.\r
5065 CDF 10\r
5066 DCA I LINSPT\r
5067 ISZ LINSPT\r
5068 CDF 0\r
5069 TAD I (BPNTR /ADDRESS,SAVE AS ADDRESS-1.\r
5070 CDF 10\r
5071 DCA I LINSPT\r
5072 ISZ LINSPT\r
5073 TAD (-3\r
5074 DCA LK2 /STORE 3 VALUES OF LINK.\r
5075LK3, TAD LK1\r
5076 CDF 10\r
5077 DCA I LINSPT\r
5078 ISZ LINSPT\r
5079 DCA I LINSPT /SET 0 TO MARK END IF SO.\r
5080 /NOTE IF NO AVERAGES SPECIFIED,CAN'T\r
5081 /GET HERE.\r
5082 ISZ LINKS\r
5083 CDF CIF 0\r
5084 JMP I LINKS\r
5085LK4, TAD LK1 /RETURN WITH JOB LIST VALUE FOR BINDS.\r
5086 CDF CIF 0\r
5087 JMP I LINKS\r
5088CORSTG=3200\r
5089LINSPT, CORSTG\r
5090LK1, 0\r
5091LK2, -1\r
5092\r
5093TRIGSU, CDF 10 /MOVE TRIG AND LINK STORE CODE TO FIELD 0\r
5094 /THEN EXECUTE IT.\r
5095 TAD (6377\r
5096 DCA 10\r
5097 TAD (CORFIX-1\r
5098 DCA 11\r
5099 TAD (-EXITXX+CORFIX-1\r
5100 DCA 12\r
5101TRGSU1, CDF 10\r
5102 TAD I 11\r
5103 CDF 0\r
5104 DCA I 10\r
5105 ISZ 12\r
5106 JMP TRGSU1\r
5107 CDF CIF 0\r
5108 JMP .+1\r
5109 6400\r
5110\f*2600\r
5111\r
5112/LINKS SAVED IN FIELD 1 AS CDF,ORG. AND 3 LINK VALUES.\r
5113\r
5114CORFIX, CDF 0 /SAVE LINKS IN CORE.\r
5115 TAD ZZ3177\r
5116 DCA 10\r
5117 TAD ZZ6777\r
5118 DCA 13\r
5119 DCA I ZZ7000\r
5120CORFX3, CDF 10\r
5121 TAD I 10 /GET 5 WORDS OF LINKS.\r
5122 SNA\r
5123 JMP CORFX6 /0 NO MORE LINKS.\r
5124 DCA CORFXX /SAVE CDF VALUE.\r
5125 TAD CORFXX\r
5126 TAD ZM6211 /IF CDF 10,SAVE IN FIELD 0.\r
5127 SNA CLA\r
5128 JMP CORFX4\r
5129 JMS CORFXS /STORE LINKS.\r
5130 JMP CORFX3\r
5131CORFX4, TAD ZZM4 /SAVE FIELD 1 LINK IN FIELD 0.\r
5132 DCA 14\r
5133 CDF 0 /SAVE AS 1,ORG,3 LINK VALUES.\r
5134 IAC\r
5135 DCA I 13\r
5136CORFX5, CDF 10\r
5137 TAD I 10\r
5138 CDF 0\r
5139 DCA I 13\r
5140 ISZ 14 /STORE ORG AND 3 LINKS.\r
5141 JMP CORFX5\r
5142 DCA I 13 /SET NEXT WORD 0 TO MARK END.\r
5143 CLA CMA\r
5144 TAD 13\r
5145 DCA 13\r
5146 JMP CORFX3\r
5147CORFX6, TAD ZZ6777 /OTHER FIELDS DONE,\r
5148 DCA 10 /STORE FIELD 1 LINKS.\r
5149 TAD ZZ6201\r
5150 DCA CORFRS+1\r
5151 TAD ZZ6211\r
5152 DCA CORFXX\r
5153CORFX7, CDF 0\r
5154 TAD I 10 /GET 5 WORD LINK SET.\r
5155 SNA CLA\r
5156 JMP I (6600 /DONE GO TO TRIGGER.\r
5157 JMS CORFXS\r
5158 JMP CORFX7\r
5159\r
5160CORFXS, 0\r
5161 JMS CORFRS\r
5162 TAD I 10 /STORAGE ADD. IS LOC-1 FOR AUTO INDEX.\r
5163 DCA 11\r
5164 TAD ZZM3\r
5165 DCA 12\r
5166CORFX2, JMS CORFRS /SET CDF WHERE TO FETCH LINK.\r
5167 TAD I 10\r
5168 JMS CORFXZ /SET CDF WHERE TO STORE LINK.\r
5169 DCA I 11\r
5170 ISZ 12 /STORE 3 LINKS.\r
5171 JMP CORFX2\r
5172 JMP I CORFXS\r
5173\r
5174CORFRS, 0\r
5175 CDF 10\r
5176 JMP I CORFRS\r
5177ZZ3177, 3177\r
5178ZZM3, -3\r
5179ZZ6777, 6777\r
5180ZZ7000, 7000\r
5181ZZ6201, CDF 0\r
5182ZZ6211, CDF 10\r
5183ZM6211, -6211\r
5184ZZM4, -4\r
5185\r
5186CORFXZ, 0\r
5187CORFXX, 0\r
5188 JMP I CORFXZ\r
5189\f*3000\r
5190/THIS SECTION CALIBRATES A SCHMITT TRIGGER BY WIATING\r
5191/FOR THE SPECIFIED TRIGGER TO FIRE AND THEN TAKING A\r
5192/SWEEP OF ANALOG CHANNEL 0.\r
5193TRIG, CDF 0\r
5194 KCC\r
5195 TAD TTYLIS\r
5196 DCA 10\r
5197TYP, TAD I 10\r
5198 SNA /IS THIS THE END OF LIST?\r
5199 JMP DONE /YES\r
5200 TLS\r
5201 CLA\r
5202 TSF\r
5203 JMP .-1\r
5204 JMP TYP\r
5205DONE, TAD KMODE /NOW SET UP CLOCK\r
5206 CLOE\r
5207 CMA\r
5208 CLZE\r
5209 CLA\r
5210 ADCL\r
5211 TAD K200\r
5212 ADLE\r
5213 CLSA\r
5214TWAIT, CLSA\r
5215 AND SMASK /IS IT THE PROPER SYNC?\r
5216 SNA CLA\r
5217 JMP HELEN\r
5218 TAD 16\r
5219 CLAB\r
5220 CLA CLL\r
5221 TAD M1000\r
5222 DCA PNTCNT\r
5223 PNTCNT=TEMP01\r
5224 TAD M1000\r
5225 DCA XREF\r
5226 XREF=TEMP02\r
5227ALOOP, ADSK\r
5228 JMP .-1\r
5229 ADRB\r
5230 DILY\r
5231 CLL CLA IAC RAL\r
5232 TAD XREF\r
5233 DILX\r
5234 DCA XREF\r
5235 DISD\r
5236 JMP .-1\r
5237 DIXY\r
5238 ISZ PNTCNT\r
5239 JMP ALOOP\r
5240 JMP TWAIT-1\r
5241HELEN, KSF\r
5242 JMP TWAIT\r
5243 KRB\r
5244 TAD ZZM203\r
5245 SNA CLA\r
5246 JMP I EXITXX\r
5247 JMP I SECT2\r
5248TTYLIS, 6665\r
5249LIST, 324\r
5250 322\r
5251 311\r
5252 307\r
5253 307\r
5254 305\r
5255 322\r
5256 0\r
5257K200, 200\r
5258M1000, -1000\r
5259SECT2, OVRLAY\r
5260ZZM203, -203\r
5261EXITXX, 7600 /SHOULD BE LAST THING ON PAGE.\r
5262\r
5263 $\r
5264\f\1a\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0
My complete PDP-8 universe