1 /LAB8E ADVANCED AVERAGER MS-SIGNAL AVERAGER SECTION 1,
2 /PARAMETER SETUP AND TRIGGER.
7 /DIGITAL EQUIPMENT CORPORATION
8 /MAYNARD, MASSACHUSETTS 01754
11 /THE ADVANCED AVERAGER MS FOR OS-8 WILL AVERAGE DATA
12 /TAKEN FROM THE A/D , DISPLAY IT, AND WRITE IT TO
13 /MASS STORAGE IF DESIRED.
14 /SECTION I OF THE LAB8/E ADVANCED AVERAGER .
16 /ADVANCED AVG. TO RUN UNDER PS8.
27 DCA I KC7746 /0 PS8 JOB STATUS WORD.
43 /MEMORY BOUNDS FOR FIELD 0
44 LOCORE=230 /LISTS, BUFERS, DATA BLOCKS START HERE
45 HICORE=6300 /PROTECTED AREA BEGINS HERE
46 NXLOAD=7000 /NEXT SECTION LOADING BEGINS HERE
48 /AVERAGING PARAMETERS: LOCATIONS 20-64
49 MEMTOT=20 /FIELDS IN THIS MACHINE
50 FIELD0=21 /ROOM FOR DATA IN FIELD 0
52 /DIGITAL I/O OPTION, CONTINGENCY AND # OF SYNC INPUTS
53 XROPT=22 /0 IF I/O NOT IMPLEMENTED, 1 IF IT IS
56 ADJLIS=23 /START OF JOB LIST-1
57 ADCHNL=24 /START OF CHANNNEL DISPLAY LIST-1
59 /JOINT SWEEP PARAMETERS - 29 LOCATIONS
60 SMASK=25 /STIMULUS (SYNC) CHANNEL MASK
61 NSWEP=26 /-# OF SWEEPS IN AVERAGE
62 KSYTIM=27 /-(# OF ASI FROM STIM TO SYNC POINT -1)
63 KITIM=31 /-(# OF ASI FROM S0 TO S0)
64 KCTIM=33 /-(# OF ASI FROM STIM TO CONTINGENCY READING)
65 KWTIM=35 /(-# OF ASI FROM LAST STIM TO A/B OPENING)
66 ASI=37 /# OF USEC PER ASI
67 S0=41 /TEMPORARY TIMER
69 KMODE=43 /CONTAINS CLOCK RATE AND MODE
70 /SWEEP A LIST PARAMETERS
71 SAMA=44 /-# OF POINTS (ASI) IN SWEEP A (EACH CHANNEL)
72 NCHA=45 /# OF CHAN IN SWEEP A
73 ADPNTA=46 /LOGICAL 1 OF ADC BUFFER A-1 (GEN BY ON-LINE)
74 ADBUFA=47 /LOCATION -1 FOR START OF ADC BUFFER -A
75 LNBUFA=50 /PHYSICAL LENGTH OF BUFFER -A
79 /SWEEP B LIST PARAMETERS
80 SAMB=51 /-# 0F POINTS (BSI) IN SWEEP B
81 NCHB=52 /# 0F CHAN IN SWEEP B
82 ADPNTB=53 /LOGICAL 1 OF ADC BUFFER-B - 1
83 ADBUFB=54 /LOCATION-1 FOR START OF BUFFER
84 LNBUFB=55 /PHYSICAL LENGTH OF BUFFER-B
86 /SWEEP A - ON-LINE PARAMETERS
87 ADMPXA=56 /ADDRESS OF A SWEEP MPLX LIST -1
88 ADEL=57 /ADJUSTMENT AT SYNC POINT TO FIND LOGICAL 1 OF BUFFER-A
89 KBLA=60 /-# OF ASI FROM SYNC POINT TO LOGICAL END OF A-1
91 /SWEEP B - ON LINE PARAMTERS
92 KBTOA=61 /-# OF A'S TO B, 0 FOR NO B
93 ADMPXB=62 /ADDRESS OF B MPLX LIST - 0
94 BDEL=63 /ADJUSTMENT AT SYNC POINT TO FIND LOGICAL 1 OF BUFFER-B
95 KBLB=64 /-# OF BSI FROM SYNC POINT TO LOGICAL END OF B - 1
98 INTERX=65 /LINK TO INTERRUPT SERVICE
99 ASAVE=66 /AC AT INTERRUPT
100 LSAVE=67 /LINK AT INTERRUPT
102 /LINKAGES TO SUBROUTINES IN CORE FOR THIS SECTION
104 FRAME=JMS I 76 /Q & A WITH SCOPE
105 OCTARG=JMS I 77 /PICK UP OCTAL TYPEIN
106 DFIX=JMS I 100 /DOUBLE PRECISION FIX
108 /NUMERICAL I/O [SU56A]
109 DECARG=JMS I 101 /PICK UP DECIMAL TYPEIN
110 FLTARG=JMS I 102 /PICK UP FLOATING TYPEIN
111 FLTOUT=JMS I 103 /FLOATING AC TO TYPE BUFFER (FLOATING FORMAT)
112 OCTOUT=JMS I 104 /AC TO TYPE BUFFER (OCTAL FORMAT)
113 \f/FLOATING POINT ARITHMETIC [SU64A]
114 FADD=JMS I 105 /FLOATING ADD
115 FDIV=JMS I 106 /FLOATING DIVIDE
116 FLOAT=JMS I 107 /FLOAT AC TO FAC
117 FMUL=JMS I 110 /FLOATING MULTIPLY
118 FIX=JMS I 111 /FIX FAC TO AC
120 /BASIC SUBROUTINES [SU63A]
121 BRAN=JMS I 132 /BRANCH ACCORDING TO AC MATCH WITH LIST
122 SHFT=JMS I 133 /DOUBLE PRECISION ARITHMETIC SHIFT
123 DADD=JMS I 134 /DOUBLE PRECISION ADD
125 /HALFWORD SUBROUTINES [SU60A]
126 SETH=JMS I 135 /SET HALFWORD POINTER
127 TYPE=JMS I 136 /TYPE 6BIT IN AC
128 LDH=JMS I 137 /LOAD HALFWORD INTO AC
129 SRCH=JMS I 140 /SEARCH FOR HALFWORD THAT MATCHES AC6-11
130 ALPHA=JMS I 141 /GET FIRST CHARACTER OF A TYPE-IN
132 /FLOATING POINT HANDLERS [SU64A]
133 SAVE=JMS I 142 /SAVE FAC
134 LOAD=JMS I 143 /LOAD FAC
135 DCOM=JMS I 144 /DOUBLE PRECISION NEGATE
136 NORM=JMS I 145 /NORMALIZE FAC
160 \f/TEMPORARY STORAGE REGISTERS 146-177
180 /TEMPORARY STORAGE AND MULTIPLE ACCUMULATORS
200 /TEMPORARY STORAGE AND TTY-KBD BUFFERS
218 \f/IOT REFERENCES FOR THE LAB/8E
221 /AD8-EA 10 BIT A/D CONVERTER
224 ADLM=6531 /LOAD MPLXR
225 ADST=6532 /START CONVERSION
226 ADRB=6533 /READ AD BUFFER
227 ADSK=6534 /SKIP ON AD DONE
228 ADSE=6535 /SKIP ON TIMING ERROR
229 ADLE=6536 /LOAD ENABLE REGISTER
230 ADRS=6537 /READ STATUS REGISTER
232 /VC8-E POINT PLOT DISPLAY
235 DICD=6051 /CLEAR DONE FLAG
236 DISD=6052 /SKIP ON DONE FLAG
237 DILX=6053 /CLEAR DONE FLAG LOAD X
238 DILY=6054 /CLEAR DONE FLAG LOAD Y
239 DIXY=6055 /CLEAR DONE, INTENSIFY, SET DONE
240 DILE=6056 /LOAD ENABLE CLEAR AC
241 DIRE=6057 /ENABLE TO AC
243 /DK8-EP REAL TIME CLOCK
245 CLZE=6130 /ZERO TO ENABLE
246 CLSK=6131 /SKP ON CLOCK FG
247 CLOE=6132 /ONES TO ENABLE
248 CLAB=6133 /AC TO CLK BUF AND COUNTER REGISTER
249 CLEN=6134 /ENABLE TO AC
250 CLSA=6135 /STATUS TO AC AND AC ONE'S CLEAR STATUS REG.
251 CLBA=6136 /CLK BUF TO AC
252 CLCA=6137 /CLK CNTR TO AC AND TO AC
254 /DB8-EA 12 CHANNEL DIGITAL I/O
256 DBDI=6500 /DISABLE INTERRUPT
257 DBEI=6501 /ENABLE INTERRUPT
258 DBSK=6502 /SKIP ON INPUT
259 DBCI=6503 /CLEAR INPUT BITS WITH SET AC BIT
260 DBRI=6504 /READ INPUT
261 DBCO=6505 /CLEAR OUTPUT BITS WITH AC BITS
262 DBSO=6506 /SET OUTPUT BITS WITH AC BITS
263 DBRO=6507 /READ OUTPUT REGISTER
266 MTH=CLA CMA CLL RTL; MTW=CLA CMA CLL RAL
267 TWO=CLA CLL CML RTL; TWOK=CLA CLL CML RTR
270 CDF=6201; RDF=6214; RMF=6244
272 \f/PAGE ZERO FOR ADVANCED AVERAGER [U10ZC]
274 DCA ASAVE /INTERRUPT SERVICE DISPATCH
281 /INSTALLATION PARAMETERS: LOCATIONS 20-64
282 / 0 /FIELDS IN THIS MACHINE: MEMTOT
283 / HICORE-LOCORE-4 /ROOM FOR DATA IN FIELD 0: FIELD0
284 /XR-OPTION, CONTINGENCY AND # OF SYNC INPUTS
285 / 0 /0 IF XR NOT IMPLEMENTED, 1 IF IT IS: XROPT
287 / LOCORE-1 /START OF LISTS. BUFFERS, DATA: ADJLIS
288 / 0 /START OF CHANNEL DISPLAY WORDS: ADCHNL
289 /JOINT SWEEP PARAMETERS - 29 LOCATIONS
290 / 0 /STIMULUS (SYNC) CHANNEL MASK: SMASK
291 / 0 /-# OF SWEEPS IN AVERAGE: NSWEP
292 / 0 /-(# OF ASI FROM STIM TO SYNC POINT -1): KSYTIM
294 / 0 /-(# OF ASI FROM S0 TO S0): KITIM
296 / 0 /-(# OF ASI FROM STIM TO CONTINGENCY READING): KCTIM
298 / 0 /-(#OF ASI FROM LAST STIM TO A/B OPENING): KWTIM
300 / 0 /# OF USEC PER ASI: ASI
310 /SWEEP A LIST PARAMETERS
311 / 0 /-#OF POINTS (ASI) IN SWEEP A (EACH CHANNEL): SAMA
312 / 0 /# OF CHAN IN SWEEP A: NCHA
313 / 0 /LOGICAL 1 OF ADC BUFFERA - 1 (GEN BY ON-LINE): ADPNTA
314 / 0 /LOCATION -1 FOR START OF A: ADBUFA
315 / 0 /PHYSICAL LENGTH OF BUFFER A: LNBUFA
316 /SWEEP B LIST PARAMETERS
317 / 0 /-# OF POINTS (BSI) IN SWEEP B (EACH CHANNEL): SAMB
318 / 0 /# OF CHAN IN SWEEP B: NCHB
319 / 0 /LOGICAL 1 OF ADC-BUFFER-B-1 (GEN BV ONLINE): ADPNTB
320 / 0 /LOCATION -1 FOR START OF ADC BUFFER B
321 /SWEEP A - ON-LINE PARAMETERS
322 / 0 /ADDRESS OF A SWEEP MPLX LIST -1
323 / 0 /-# OF LOCATIONS FROM SYNC POINT TO LOGICAL 1 OF A
324 / 0 /-# OF ASI FROM SYNC POINT TO LOGICAL END OF A -1
325 /SWEEP B - ON LINE PARAMETERS
326 / 0 /-# OF A'S TO B, 0 FOR NO B
327 / 0 /ADDRESS OF B-SWEEP MPLX LIST -0
328 / 0 /-# OF LOCATIONS FROM SYNC POINT TO LOGICAL END OF B -1
329 / 0 /-# OF ASI FROM SYNC POINT TO LOGICAL 1 OF
331 /LINKAGES TO SECTION 2 SUBROUTINES
332 7200 /PICKUP NEXT JOB FROM JOB LIST: JGET
334 7243 /MOVE THRU DATA BLOCK: BLKCNT
336 6474 /SET ADC POINTERS: SETPNT
338 6451 /MOVE THRU ADC BUFFERS: IXPNT
340 7121 /SET UP DISPLAY: SDIS
342 DISPS /DISPLAY A POINT: DISP
344 /LINKAGES TO ALPHABETIC HANDLERS
345 FRAMES /Q AND A WITH THE SCOPE: FRAMES
347 OCTARS /PICK UP OCTAL TYPE-IN: OCTARG
350 DFIXS /DOUBLE PRECISION FIX: DFIX
352 /LINKAGES TO NUMERICAL IO
353 DECARS /PICK UP DECIMAL TYPE-IN: DECARG
355 FLTARS /PICK UP FLOATING TYPE-IN: FLTARG
357 FLTOUS /OUTPUT FAC TO TYPE BUFFER: FLTOUT
359 OCTOUS /OUTPUT AC (OCTAL FORMAT) TO TYPE BUFFER: OCTOUT
360 /FLTSUB USED BY FLTIO - DON'T RELOCATE
361 FADDS /FLOATING ADD: FADD
363 FDIVS /FLOATING DIVIDE: FDIV
365 FLOATS /FLOAT AC TO FAC: FLOAT
367 FMULS /FLOATING MULTIPLY: FMUL
369 FIXS /FIX FAC TO AC: FIX
371 /PAGE ZERO CONSTANTS - USED BY RESIDENT SUBROUTINES - DON'T RELOCATE
383 42 /"-PROGRAM OUTPUT MARKER: PROMRK
385 47 /'-KEYBORAD INPUT MARKER: TXMRK
386 45 /CR-CARRIAGE RETURN: KCR
387 -43 /LF-LINE FEED: KM0043
393 /LINKAGES TO BASIC SUBROUTINES
394 BRANS /BRANCH ACCORDING TO FOLLOWING LIST: BRAN
396 SHFTS /DOUBLE PRECISION ARITHMETIC SHIFT: SHFT
398 DADDS /DOUBLE PRECISION ADD: DADD
400 /LINKAGES TO HALFWORD SUBROUTINES
401 SETHS /SET HALFWORD POINTER: SETH
404 TYPES /TYPE 6BIT IN AC: TYPE
406 LDHS /GET NEXT HALFWORD TO AC: LDH
408 SRCHS /SEARCH FOR HALFWORD WATCH OF AC6-11: SRCH
410 ALPHAS /PICK UP ALPHABETIC TYPE-IN: ALPHA
412 /LINKAGES TO FLTSUB SUBROUTINES
413 SAVES /SAVE FAC: SAVE
415 LOADS /LOAD FAC: LOAD
417 DCOMS /DOUBLE PRECISION NEGATE: DCOM
419 NORMS /NORMALIZE FAC: NORM
421 /TEMPORARY STORAGE REGISTERS FROM 146-177
423 0 /SET 0 TO CONVERT WRONG DECIMAL
424 /PLACE IN DISPLAY CON09B
428 /SUBROUTINE FOR SECTION II TO DISPLAY POINT OF DATA: DISP
431 TAD YSX /AC+(YS)=#PLACES TO SHIFT RIGHT
434 TAD ARITH4 /MOVE X TO NEW VALUE
444 TAD DELX /LOAD INCREMENT FOR X
447 DCA ARITH2 /ADD TO PRESENT X
456 /OVERLAY LOOKUP FOR CAINING.
457 /START AT START0 (400) FOR SECTION 1
458 /START AT START1 (403) TO RUN WITH CONTROL TAPES.
460 JMS LINKLK /CALL CHAIN LOOKUP.
465 JMP I (CONTAP /READ IN CONTROL FILE.
470 DCA 7746 /SET PS-8 JOB STATUS WORD.
481 JMS I (7700 /LOCK IN USR.
484 CLA IAC /FIND BLOCK ADDRESS OF SECT. 2
494 TAD ARGA /STORE BLOCK ADD.IN CHAIN COMMAND
495 DCA XX0V1 /TO CALL SEC.2.
496 ARGBS, CLA IAC /FIND BLOCK ADD.OF SEC.3,4,
497 CDF 0 /AND WRITE OVERLAY.
507 DCA I XXT3 /STORE AT LOCS. 5,6,7.
517 JMS I (200 /UNLOCK USR.
521 DCA 7746 /RESET JOB STATUS WORD.
533 NAME1, FILENAME AAVG2.SV
534 NAME2, FILENAME AAVG3.SV
535 NAME3, FILENAME AAVG4.SV
536 NAME4, FILENAME AAVG5.SV
541 /LAB-8 ADVANCED AVERAGER - SECTION 1 - MAIN: U11MC
542 /ONCE ONLY CODE - INTIALIZATION
546 SETH /VERSION. CONFIGURATION MESSAGE
547 DIS99 /"(VAP,#DF-1, CORE LIMITS)"
550 /FIND # OF FIELDS AVAILABLE
551 TAD KMK /CDF N = CDF 0
553 MKLOOP, TAD MKTEST /CDF N+1
556 MKTEST, CDF /CHANGE TO N+1
557 RDF /IF 4K - THIS IS A NOP
558 DCA I TTYLST /PUTS DF# IN DF, 0000; FOR 4K, PUT 0 IN 0000 OF FIELD 0
559 TAD I TTYLST /GETS A 0 IF FIELD DOESN'T EXIST
560 TAD KMK /GETS A CDF N+1 IF FIELD DOES EXIST
563 ISZ MEMTOT /# OF FIELDS
564 SNA CLA /IF AC=0, FIELD N+1 EXISTS
565 JMP MKLOOP /LOOK AT NEXT FIELD
568 KMK, CDF 0 /NO MORE FIELDS
570 TAD MEMTOT /# OF FIELDS -1
572 TAD MEMTOT /PUT #DF-1 IN CONFIGURATION MESSAGE
574 TAD KJLIST /START OF JOB LIST -1
576 TAD KFIELD /LENGTH OF AVAILABLE FIELD 0
578 IAC /OUTPUT LOW CORE LIMIT
581 TAD ADJLIS /OUTPUT HIGH CORE LIMIT
582 TAD FIELD0 /START OF FIELD0 + LENGTH OF FIELD 0
583 TAD K0004 /+4 FOR END OF LIST MARKERS
585 PRES00, FRAME /"LAB-8 IS READY
586 DIS00 /HIT RETURN TO PROCEED"
590 PRES01, FRAME /DIGITAL I/O?'-'[Y OR N]
591 DIS00B /(Y FOR YES, N FOR NO)"
592 JMP PRES00 /LINE FEED - ASK PREVIOUS QUESTION
593 ALPHA /C.R. - GET ANSWER
598 DCA XROPT /AC=0 OTHERWISE, XROPT=1 IF YES, 0 FOR NO
605 KFIELD, HICORE-LOCORE-4
606 \f/DISPLAYS FOR ONCE ONLY CODE
607 DIS00, 1401 /"LAB8/E IS READY
608 0270 /HIT RETURN TO PROCEED''"
629 DIS00B, 0411 /"DIGITAL I/O? -
630 0711 /<Y FOR YES, N FOR NO>"
649 \f/DISPLAYS AND TEXTS FOR COMPILER [LB-U11*-PB]
650 CON00, /END OF ONCE ONLY AREA
651 DIS02, 2324 /"STANDARD RESOLUTION:
652 0116 /"'----' DATA POINTS
671 \fDIS03, 1405 /"LENGTH: '-----' '-'SEC"
684 DIS04, 0405 /"DELAY: '-----' '-'SEC"
696 DIS05, 1011 /"HIGH RESOLUTION EPOCH
697 0710 /'----' DATA POINTS"
717 \fDIS06, 1011 /"HI LENGTH: '-----' '-'SEC"
731 DIS07, 1011 /"HI DELAY: '-----' '-'SEC"
746 3116 /SYNC ON INPUT: S'-'
756 \fDIS09, 4002 / "BEGINS-AT RATE-ENDS
757 0507 /"XXXXXX""X""XXXXXX""X""XXXXXX""X"
758 1116 /"XXXXXX""X""XXXXXX""X""XXXXXX""X"
760 0124 /'-': CHANGE (H,L,&)"
811 \fDIS12, 2317 /"SORT AT '-----' '-'SEC"
824 DIS15, 0126 /"AVG #"XX"
826 3342 /ANALOG INPUT '--' "
840 DIS16, 2205 /"RESOLUTION: '-' (H,L)"
852 DIS17, 2317 /"SORT CODE: '---'"
861 \fDIS18, 0317 /"CONFIDENCE LIMITS?:'-'
879 DIS19, 0317 /"COMPUTE TREND?: '-'
894 \fDIS24, 1405 /"LEAST SWEEP INTERVAL:
895 0123 /'------' '-'S (>"XXXXX" "X"S)"
921 DIS25, 0126 /"AVERAGE '....' SWEEPS"
933 DIS27, 4416 /"$FA8/INPUTS$AP4/"
941 \fDIS27A, 4230 /"XX":"XX",X
948 DIS30, 4415 /"$EA8/AVERAGES"
960 DIS32, 2025 /"PUNCH CONTROL TAPE? '-'
977 \fDIS32A, 2411 /"TITLE:
978 2414 /'---------------------'"
995 ERR01, 7740 /"? SWEEP ENDS EARLY ' '"
1007 ERR02, 7740 /"? INSUFFICIENT MEMORY ' '"
1020 ERR03, 7740 /"? BAD SAMPLING RATIO ' '"
1032 \fERR04, 7740 /"? NO COMMON INTERVAL"
1046 ERR05, 7740 /"? TOO MANY INPUTS
1047 2417 / FOR SWEEP RATE"
1066 TXT32, 4545 /<CRLF><CRLF> SWEEP SUMMARY<CRLF>
1076 \fTXT32A, 4040 /" AVERAGES
1077 4040 /CHAN RATE TYPE SORT
1094 TXT33A, 4042 /" "XX" X "XX" "XXX"
1109 DIS99, 5026 /"(VAP,"X","XXXX"-"XXXX")
1123 TXT34B, 4023 /" SWEEPS AT "
1191 XX76NO, TAD FAC+2 /SUBTRACT 200 FOR EACH FIELD USED.
1192 TAD XXM200 /PS8 USES 7600 AND UP.
1198 TAD TEMP06 /SUBTRACT AGAIN IF ANOTHER FIELD
1212 \f/SELECT SWEEP PARAMETERS
1214 CON01, FRAME /"SYNC ON CHANNEL S'-'"
1216 JMP CON01 /L.F.: RESTART
1218 JMP CON01 /FORMAT ERROR - ASK AGAIN
1234 CON02, FRAME /"STANDARD RESOLUTION
1235 DIS02 /'---' DATA POINTS"
1236 JMP I CON01Z /L.F.: PREVIOUS QUESTION
1238 JMP CON02 /FORMAT ERROR - ASK AGAIN
1240 DCA SAMB /-# OF DATA POINTS IN LOW (OR ONLY) EPOCH
1241 JMP I .+1 /CHECK IF # OF POINTS IS LESS
1244 CON02P, FLOAT /FSAMB =-(#OF POINTS -1)
1253 TAD FIELD0 /DECREASE AVAILABLE FIELD0 BY ADC BUF
1254 SZL CLA /(+)+(-): LINK WILL BE 1 IF NO OVERFLOW
1256 FRAME /"? INSUFFICIENT MEMORY"
1258 JMP CON02 /ASK FOR # OF DATA POINTS
1265 MODE, 5057 /EXTERNAL ENABLE,SCHMITT ENABLE,RESET
1266 \fCON03, FRAME /"LENGTH: '----' '-'SEC"
1268 JMP CON02 /GO BACK TO PREVIOUS QUESTION
1270 JMP CON03 /FORMAT ERROR - ASK LENGTH AGAIN
1271 FDIV /GET TIME BETWEEN DATA POINTS
1276 TAD K0226 /MUST BE GREATER THAN OR EQUAL 150 USEC"
1282 JMP CON03 /.LT. 150 USEC, TRY AGAIN
1284 CON04, FRAME /"DELAY: '----' '-'SEC
1286 JMP CON03 /L.F.: PREVIOUS QUESTION
1288 JMP CON04 /FORMAT ERROR - ASK DELAY AGAIN
1290 FBLATT /LATENCY IN USEC
1292 FDIV /GET LATENCY IN TERMS OF SAMPLING INTERVAL
1294 SAVE /-LATENCY IN BSI
1298 FSAMB /-LENGTH OF SWEEP IN BSI
1300 SPA SNA CLA /DOES SWEEP END BEFORE SYNC PULSE?
1302 FRAME /YES;"? SWEEP ENDS EARLY"
1304 JMP CON03 /LF: GET NEW SWEEP LENGTH
1305 JMP CON04 /CR: GET NEW SWEEP DELAY
1311 FRAME /"HIGH RESOLUTION EPOCH
1312 DIS05 /'----' DATA POINTS"
1313 JMP CON04 /L.F.: LAST QUESTION
1315 JMP .-4 /FORMAT ERROR - ASK # POINTS AGAIN
1316 CMA IAC /-# DATA POINTS
1318 JMP I CON08X /0 DATA POINTS INDICATES SINGLE MODE
1319 DCA SAMA /- POINTS IN HI RESOLUTION EPOCH
1322 FLOAT /-(#DATA POINTS-1)
1330 TAD SAMA /PARTS OF FIELD 0 IN USE
1332 TAD FIELD0 /FIELD 0 AVAILABLE
1333 SNL CLA /LINK=1 IF OVERFLOW
1335 FRAME /"? INSUFFICIENT MEMORY"
1337 JMP CON02 /L.F.: RESPECIFY LO-EPOCH
1338 JMP CON05 /C.R.: RESPECIFY HI-EPOCH
1339 CON06, FRAME /"HI LENGTH: '----' '-'SEC"
1341 JMP CON05 /LF: PREVIOUS QUESTION
1343 JMP CON06 /FORMAT ERROR - ASK AGAIN
1344 FDIV /LENGTH\# POINTS= SAMPLING INTERVAL
1346 SAVE /GET ASI IN USEC
1349 TAD K0226 /IF ASI. .LT. 150 US, TOO FAST
1355 JMP CON06 /.LT. 150 US, TOO FAST
1356 LOAD /CHECK BSI/ASI RATIO
1361 FIX /.ABS. RATIO .LT. 1 OR .GT. 2^11 ?
1362 SZA /-BSI/ASI RATIO IN AC
1363 JMP I CON07X /NO - IS OK
1364 \f FRAME /"? BAD SAMPLING RATIO"
1366 JMP I CON02X /LF: CHANGE BOTH SWEEPS
1367 JMP I CON05Y /CR: CHANGE HIGH
1369 CON07A, DCA KBTOA /KBTOA HOLDS -RATIO
1370 CON07, FRAME /"HI DELAY: '----' '-'SEC"
1372 JMP I CON06X /LF: PREVIOUS QUESTION
1374 JMP CON07 /FORMAT ERROR: ASK AGAIN
1375 FDIV /-LATENCY IN TERMS OF ASI
1380 TAD KBTOA /BSI=-KBTOA*ASIF
1387 LOAD /GET LO SWEEP LATENCY IN TERMS OF ASI
1388 FBLATT /-LO-LATENCY IN USEC.
1391 SAVE /LO-LATENCY IN ASI.
1393 TAD KBTOA /GET END TIME OF LO SWEEP (IN ASI)
1396 FMUL /(B/A RATIO)*(-# OF POINTS)
1398 FADD /ADD -DELAY (IN ASI)
1401 SAVE /DELAY (IN ASI)+# OF POINTS*RATIO
1402 FBEND /POSITIVE SENSE
1413 \fCON08, LOAD /HERE FOR 1-EPOCH MODE
1417 LOAD /LO-LATENCY=HI-LATENCY
1421 JMS I FMINX /SYNC TIME IS AT MIN (SYNC PULSE, DELAY)
1424 SAVE /FAKE END OF B (SYNC TIME)
1430 CON08A, TAD KBTOA /COME HERE FOR 2-EPOCH MODE
1435 LOAD /GET AEND, AEND=-(ALAT+SAMA)
1436 FSAMA /AEND IS - TIME OF A-SWEEP ENDING
1438 FALAT /FALAT IS NEGATIVE SENSE A-DELAY
1440 FAEND /NEGATIVE SENSE.
1443 FBEND /FBEND IS POSITIVE SENSE END OF B-SWEEP
1444 TAD FAC+1 /DIFFERENCE BETWEEN END TIMES
1445 SMA SZA CLA /BEND .LT. AEND?
1446 JMP CON08C /YES, LO ENDS AFTER HI ENDS
1447 FIX /NO, HI ENDS AFTER LO ENDS
1448 FLOAT /TRUNCATE. ROUND UP
1449 SAVE /(LO ENDS FIRST)
1452 FBLA /-# OF POINTS LEFT IN A AT END OF B
1454 LOAD /SYNC TIME AT END OF LO SWEEP: KSYTIM=-(BEND-1)
1461 LOAD /DOES HI START AFTER LO ENDS?
1462 FBEND /+(END-OF-B TIME)
1464 FALAT /MINUS (START-OF-A TIME)
1465 TAD FAC+1 /(END B) - (START A) .LT 0?
1467 JMP CON08B /YES-NO COMMON INTERVAL
1468 \f FIX /NO - TRUNCATE, ROUND DOWN
1470 DCOM /LOGICAL START OF HI-SWEEP
1471 SAVE /[(END B) - (START A)] FROM SYNC TIME
1474 LOAD /LOGICAL START OF LO-SWEEP ENTIRE BUFFER BACK
1479 LOAD /CLOSE LO BUFFER AT SYNC TIME
1486 CON08B, FRAME /"? NO COMMON INTERVAL"
1488 JMP I CON04X /L.F.: GO BACK TO RESPECIFY LO-LATENCY
1489 JMP I CON02X /C.R.: RESPECIFY HI-LATENCY
1491 CON08C, FDIV /HI SWEEP ENDS BEFORE LO SWEEP ENDS
1492 FBTOA /KBLB=[(BEND-AEND)/KBTOA]-1
1493 FIX /-# OF POINTS LEFT TO GET IN B WHEN A STOPS
1494 FLOAT /TRUNCATE - ROUND UP
1495 SAVE /LO CLOSES KBLB AFTER SYNC TIME (IN BSI)
1497 LOAD /SYNC TIME AT END OF HI SWEEP
1503 LOAD /DOES HI END BEFORE LO BEGINS?
1506 FADD /(END A)-(START B) .LT. 0 ?
1510 JMP I CON08W /YES - NO COMMON INTERVAL
1511 FDIV /BDEL IS TIME FROM LOGICAL START TO SYNC TIME
1515 FLOAT /TRUNCATE, ROUND DOWN
1519 \f LOAD /LOGICAL START OF HI IS ENTIRE BUFFER BACK
1523 LOAD /THERE ARE NO MORE A-POINTS TO GET AT SYNC TIME
1525 SAVE /CLOSE HI BUFFER AT SYNC TIME
1528 CON09, TAD KSYTIM /SETUP SWEEP SUMMARY DISPLAY
1529 SPA CLA /UNLESS EITHER SWEEP ENDS BEFORE SYNC
1531 FRAME /"? SWEEP ENDS EARLY"
1533 JMP I CON04Y /LF: RESPECIFY LATENCY
1534 JMP I CON05X /CR: RESPECIFY HI SWEEP
1541 /SUBROUTINE TO GET MAX OF TWO FLOATING ARGUMENTS: FMAX
1543 TAD FMAXS /GET PARAMETER ADDRESS
1546 FMEXIT, SPA CLA /SIGN OF COMPARSION
1547 TAD K0003 /GET COMPARAND AS RESULT (FMARG2=FMARG1+3)
1548 TAD ADRARG /GET FAC AS RESULT
1554 /SUBROUTINE TO GET MIN OF TWO FLOATING ARGS: FMIN
1557 CMA IAC /REVERSE SIGN OF COMPARSION
1564 TAD I FMLOCS /GET ADDRESS OF COMPARAND
1566 LOAD /PUT COMPARAND IN FAC
1571 DCOM /FAC - COMPARAND
1574 TAD FAC+1 /SIGN OF (FAC-COMPARAND)
1575 ISZ FMLOCS /ADJUST RETURN ADDRESS
1578 CON09A, SETH /POSITION HALFWORD POINTER
1579 DIS09 /PICK UP ARGUMENTS FOR DISPLAY
1584 NORM /TRUNCATE, ROUND UP
1594 FMUL /SYNC POINT - DELAY (IN USEC)
1598 FASI /HI SWEEP SAMPLING RATE
1608 \f FMUL /SYNC POINT + POINTS LEFT (IN USEC)
1611 LOAD /GET START TIME OF LO SWEEP
1621 FMUL /SYNC POINT - DELAY
1624 LOAD /LO RESOLUTION SAMPLING INTERVAL
1635 DCOM /SYNC POINT + POINTS LEFT (IN USEC)
1641 LOAD /PRESET FAC TO -1 FOR NO XR
1643 CON09B, FRAME /"BEGINS -AT RATE- ENDS
1644 DIS09 /SDDDDDMSDDDDDMSDDDDDM
1645 JMP CON09B /SDDDDDMSDDDDDMSDDDDDM
1647 BRAN /'-': CHANGE [H,L,-]"
1648 HLSWIT /(S: - OR SPACE; D: 0-9, OR -; M: U, M, OR SPACE)
1649 JMP I CON05Z /CHANGE HI (H)
1650 JMP I CON02Y /CHANGE HI AND LO (L)
1652 \f/GET LAST SWEEP PARAMETER: SORT TIME
1653 CON12D, TAD XROPT /IF NO XR IN SYS, SKIP QUESTION
1655 JMP CON12E /ASSUME CTIME IS AT SYNC TIME
1656 FRAME /"SORT AT '-----' '-'SEC"
1658 JMP I CON9X /LF: LOOK AT SUMMARY AGAIN
1660 JMP CON12D /FORMAT ERROR - ASK AGAIN
1661 FDIV /TIME IN ASI - CAN NO LONGER CHANGE SW PARAMETERS
1665 TAD FAC+1 /-SORT TIME MUST BE .LT.0 (-1 IF UNSPEC)
1667 JMP CON12D /RE ASK QUESTION
1670 FCTIM=FLOT04 /FBSI. BLOCK 3-8
1675 JMS I FMINY /FIND END OF SW PHASE
1676 FCTIM /MAX (END-A, SORT TIME)= MIN (-END-A, -SORT TIME)
1678 JMS I FMAXX /MAX (END-A, SORT TIME, END-B) IS END OF SW PHASE
1680 SAVE /SWEEP PHASE END POINT (IN ASI)
1682 FSWEND=FLOT04 /FCTIM, BLOCK 12E
1685 JMS I FMAXX /FIND BEGIN TIME FOR SWEEP PHASE (IN ASI)
1686 FBLAT /MIN (START-A,START-B) = MAX (-START-A,-START-B)
1688 FSWBEG /-START TIME OF SWEEP PHASE
1689 FSWBEG=FLOT13 /12E,8-12
1690 FADD /+ END TIME OF SWEEP PHASE
1692 SAVE /LENGTH OF SWEEP PHASE IN ASI
1694 FSWTIM=FLOT04 /FSWEND, BLOCK 12E
1695 \f/ASK QUESTIONS AND GENERATE JOB LIST
1696 CON13, DCA TNJOB /INITIALIZE SECTION VARIABLES - JOB 0
1698 TAD KBTOA /SET ALLOWED MIN SAMPLING TIME
1702 FLOAT /125 US IF SINGLE
1703 SAVE /150 US IF DOUBLE MODE
1704 FTIMSV /HOLDS MIN SWEEP INTV PERMITTED
1705 FTIMSV=FLOT01 /INCREASED FOR JOBS AS CHOSEN
1706 LOAD /SET TIME USED TO ZERO
1710 CALTIM=FLOT05 /FBLATT, BLOCK 4-7
1711 LOAD /MEMORY AVAILABLE AT INSTALLATION
1714 DAVAIL /DBL PREC. FIXED POINT. # OF CELLS AVAIL IN ALL OF CORE
1716 TAD FIELD0 /FIELD0 AVAIL FOR BUFFERS & LISTS
1717 DCA TLEFT0 /# OF CELLS LEFT IN FIELD 0
1719 DCA NCHA /INITIALIZE # OF CHANNELS TO ZERO
1721 TAD ADJLIS /INITIALIZE JOB LIST POINTER
1725 DCA I TJPNTR /PUT EOL WORD IN JOB LIST (J1=0)
1726 TAD KMAXSZ /-MAXIMUM SIZE OF LIST +20
1729 TAD TLEFT0 /INITIALIZE FOR NEXT JOB
1730 DCA TAVAIL /TLEFT0 MODIFIED AT CON16
1732 LOAD /UPDATE TIME COUNT, FTIMSV MOD AT CON21
1736 FTIMIN=FLOT07 /FBEND. BLOCK 4-12E
1737 SETH /PUT AVERAGE # IN MESSAGE
1744 CON15, FRAME /"AVG XX
1745 DIS15 /AVERAGE INPUT '--'"
1746 JMP I CON22X /L.F.: ENOUGH AVERAGES
1748 JMP CON15 /FORMAT ERROR - ASK AGAIN
1749 DCA SHFR /SHFR HAS CHANNEL NUMBER
1750 \fCON16, TAD SAMA /INITIALIZE FOR SINGLE MODE (H RESOL)
1751 DCA TNSAM /NUMBER OF DATA POINTS THIS JOB
1753 TAD NCHA /ORDER OF THIS JOB IN JLIST
1756 TAD KBTOA /DUAL BEAM MODE?
1758 JMP CON16J /NO- OMIT QUESTION
1759 CON16A, FRAME /"RESOLUTION: '-' [H,L]"
1761 JMP CON15 /L.F.: RESTART JOB
1766 JMP CON16G /L. - READUST FOR LO
1767 JMP CON16A /OTHER - ERROR, ASK AGAIN
1781 KMAXSZ, CON00-LOCORE-16 /FROM LOCORE TO CON00 FOR LISTS (-16 FOR NEXT JOB)
1783 CON16G, TAD NCHB /ORDER IN MX-B LIST
1785 TAD K0040 /SET A/B BIT =1
1788 CON16J, TAD SAMB /LO RESOLUTION SWEEP POINTS
1792 CON16B, TAD K0003 /INITIALIZE FOR NEW CHANNEL
1793 DCA TCHINC /HOW MUCH TO INCREMENT CORE USED FOR MX, CD LIST ENTRY
1795 TAD K0006 /MOVE A/B, CHAN # TO TOP 6 BITS
1797 TAD TNSAM /IMAGE OF # DATA POINTS
1802 TAD K0040 /ADD IN 1(1), CHAN ORD (5) TO BOTTOM 6 BITS
1803 DCA TJCHAN /SAVE FOR J-LIST
1805 TAD ADJLIS /SET POINTER TO TOP OF JOB LIST
1807 \fCON16C, DCA TJPNTR /SEARCH FOR SWEEP, CHAN # ALREADY ON J-LIST
1810 JMP CON16E /FOUND END OF LIST (J1=0)
1811 AND K7700 /THESE BITS HOLD SWEEP TYPE AND CHAN #
1814 TAD TJCHAN /NEW JOB'S J1 WORD
1817 TAD TJMAT /MATCH BETWEEN TOP 6 BITS OF WORDS?
1819 JMP CON16D /NO MATCH, MOVE ON
1820 DCA TCHINC /FOUND A MATCH NO INCREASE IN MX- OR CD-LIST LENGTH
1821 DCA TNSAMM /NO NEW BUFFER AREA REQUIRED
1822 TAD I TJPNTR /CHAN ORDER IS SAME AS MATCHING J1'S
1824 CON16D, TAD K0007 /MOVE TO NEXT JOB
1827 CON16H, FRAME /"? INSUFFICIENT MEMORY"
1829 JMP I CON13X /LF: START AT JOB 1
1830 JMP I CON15X /CR: RESTART CURRENT JOB
1840 CON16E, TAD TCHINC /UPDATE MIN SAMP INTV
1843 TAD K0017 /NEW CHANNEL TAKES 15 USEC MORE TO ACQUIRE
1845 FADD /OLD MIN SAMP INTV
1849 FADD /REQUIRED SAMP INTV
1851 TAD FAC+1 /DOES THIS MAKE REQ. SAMPLING RATE IMPOSSIBLE?
1853 JMP CON16K /NO-IT'S OK
1854 FRAME /"? TOO MANY INPUTS
1855 ERR05 /FOR SWEEP RATE"
1856 JMP I CON13X /RESTART FROM JOB 1 (LF)
1857 JMP I CON15X /RESTART THIS JOB (CR)
1858 \fCON16K, TAD TCHINC /SEE IF THERE IS BUFFER ROOM
1862 DCA TDECF0 /HOW MUCH TO DECR FIELD0
1865 TAD TDECF0 /IS THERE ROOM?
1868 JMP CON16H /NO- INSUFFICIENT MEMORY
1870 CON16F, DCA TLEFT0 /FIELD 0 LEFT
1871 DCA TCMASK /INITIALIZE FOR NO CONTINGENCY MASK
1873 TAD XROPT /DOES INSTALLATION HAVE XR OPTION?
1875 JMP CON18 /NO-SKIP QUESTION
1877 CON17, FRAME /"SORT CODE: '---'"
1879 JMP I CON15X /LF: RESTART JOB
1881 JMP CON17 /FORMAT ERROR - ASK AGAIN
1882 AND K0377 /SET CONTINGENCY PART OF J2
1885 DCA TJTYPE /INITIALIZE JOB TYPE TO TYPE 1 (AVG ONLY)
1887 FRAME /"COMPUTE S.D.?: '-'
1889 JMP I CON15X /L.F.:RE-DO JOB
1895 JMP CON19A /OTHER - SAME AS N
1896 TWO /JOB TYPE SET TO TWO
1898 \fCON19, FRAME /"COMPUTE TREND?: '-'
1900 JMP CON18 /L.F. RE ASK VARIANCE
1904 ISZ TJTYPE /Y: YES - SET JOB TYPE = 3
1905 K7700, 7700 /N: NO (A NOP)
1906 CON19A, TAD TJTYPE /UPDATE TOTAL AVAILABLE CORE
1907 BRAN /AFTER THIS JOB'S CALC REGION
1909 TAD K0004 /TYPE 3, NCELL=9
1910 TAD K0003 /TYPE 2, NCELL=5
1911 TAD K0002 /TYPE 1, NCELL=2
1912 DCA TNCELL /LOCATIONS REQUIRED PER DATA POINT
1916 DCA TNCNT /FIND REQUIRED CORE FOR THIS JOB
1920 TAD TDECF0 /FIGURE IN INCREASE IN MX, CD, AND J LISTS
1923 DCA FAC+2 /ADD (# OF POINTS)*(# OF LOCATIONS PER POINT)
1927 ISZ TNCNT /ADD IN # OF POINTS. (# OF LOCS) TIMES
1929 LOAD /DECREASE CURRENTLY AVAIL. MEMORY
1934 TAD FAC+1 /# OF DATA FIELDS PREVIOUSLY AVAILABLE
1936 TAD FOP+1 /- OF DATA FIELDS NOW AVAILABLE+1
1939 DCA TLINKS /IS # OF BLOCKS (LINKAGE) REQUIRED
1941 CLA CMA /PUT-(3 LOCS+1 DATA POINT) IN FAC
1947 DADD /SUBTRACT THIS AMOUNT FOR EACH LINKAGE REQUIRED
1950 XX76BK, TAD FOP+1 /IS THERE ENOUGH MEMORY TO DO THIS JOB?
1952 JMP I CON16W /NO, INSUFFICIENT MEMORY
1954 \fCON20, LOAD /AMOUNT OF MEMORY LEFT (DBL PREC) WAS IN FOP
1958 TAD TJCHAN /PUT A/B(1), CHAN#(5), 1(1), CHAN ORDER(5) IN J1
1960 TAD TJTYPE /PUT TYPE (4), SORT CODE(8) IN J2
1961 CLL RTR /TYPE# TO AC0-3
1964 TAD TCMASK /SORT CODE TO AC 8-11
1967 TAD TNCELL /PUT NCELL IN J3 FOR NOW
1970 TAD TNSAM /PUT NSAM IN J4 FOR NOW
1973 TAD K0004 /SKIP OVER J5, J6, AND J7
1976 DCA I TJPNTR /PUT EOL WORD AT CURRENT END OF JOB LIST
1977 TAD TCHINC /WAS THIS A NEW CHANNEL?
1980 TAD TJCHAN /YES, INDEX CHANNEL COUNTER
1981 SMA CLA /WHICH ONE, A OR B?
1982 JMP CON21-1 /CHANNEL IS IN A-SWEEP
1983 ISZ NCHB /J1(0)=1 FOR B (LO-RESOLUTION)
1991 ISZ NCHA /J1(0)=0 FOR A (HI-RESOLUTION
1994 CON21, TAD TNSAM /-# OF DATA POINTS
1998 LOAD /PRESET FAC FOR JOB TYPE 1
1999 AVGTIM /TIME TO AVERAGE ONE POINT
2000 TAD TJTYPE /GET THE JOB TYPE
2003 JMP CON21B /JOB TYPE=2, AVG AND VAR
2004 JMP CON21A /JOB TYPE=1, AVG ONLY
2005 FADD /JOB TYPE=3 (OTHER), AVG, VAR, AND TREND
2006 TRNTIM /TIME TO TAKE TREND OF ONE POINT
2007 CON21B, FADD /ADD TIME TO TAKE VARIANCE ON ONE POINT
2009 \fCON21A, FMUL /MULTIPLY BY NUMBER OF POINTS
2011 FADD /UPDATE BUSY TIME
2015 ISZ TNJOB /UPDATE JOB NUMBER
2016 TAD TCHINC /INCREASE LIST LENGTH
2018 TAD TSZLST /UPDATE AREA LEFT FOR JOB LIST
2019 SMA /OUT OF RESERVED AREA?
2020 JMP I CON14X /NO- GET NEXT JOB'S PARAMETERS
2022 /FIX PARAMETERS AND POINTERS
2024 TAD TNJOB /JOBS HAVE ALL BEEN CHOSEN
2025 SNA CLA /THERE MUST BE AT LEAST ONE JOB
2026 JMP I CON15Y /IF NOT RETURN TO SPECIFY ONE
2027 TAD TJPNTR /SET UP MX AND CD LIST POINTERS
2028 DCA ADMPXA /START OF MX LIST-1 (HI RESOLUTION)
2032 DCA ADMPXB /START OF LO MPLX LIST
2035 DCA ADCHNL /START OF CHANNEL LIST-1
2039 CLL RAL /LENGTH OF CH LIST=2*NCHA+1+2*NCHB+1
2041 DCA ADBUFA /START OF ADC BUFFER-A
2042 LOAD /SAMPLES IN SWEEP-A
2048 TAD NCHA /# CHANNELS IN A
2052 FLOT01 /LENGTH OF BUFFER-A IS #SAMPLES * #CHANNELS
2058 DCA LNBUFA /LNBUFA IS POSITIVE
2061 \f FMUL /FADEL IS # OF SAMPLE TIMES BACK
2063 FIX /GET PHYSICAL DISTANCE BACK
2067 DCA ADEL /-(ADBUFA +DISTANCE BACK)=ADEL
2068 LOAD /GET SAMPLES IN B
2073 TAD NCHB /GET PHYS. LENGTH OF BUFFER-B
2083 DCA LNBUFB /LENGTH OF B (IN LOCATIONS)
2085 TAD ADBUFA /START OF ADC BUFFER FOR HIGH RESOLUTION-1
2087 DCA ADBUFB /START OF ADC BUFFER FOR LOW RESOLUTION-1
2089 LOAD /GET DISTANCE BACK IN BUFFER FOR START OF B
2097 DCA BDEL /-(ADBUFA+DISTANCE BACK IN B)
2099 TAD LNBUFA /IS THERE AN A-SWEEP?
2103 JMP .+5 /NO, SET KBLA TO 0
2104 LOAD /POINTS TO GET AT SYNC TIME IN A
2110 TAD LNBUFB /IS THERE A B-SWEEP?
2112 JMP CON22A /NO- THERE ARE 0 POINTS TO GET AT SYNC TIME
2117 \fCON22A, DCA KBLB /B-POINTS TO GET AT SYNC TIME
2118 LOAD /GET TIME FROM SYNC POINT TO SYNC TIME
2122 TAD ADJLIS /SET POINTER TO START OF JOB LIST
2124 CON23, DCA TJPNTR /MAKE UP MULTIPLEXOR LIST
2125 TAD I TJPNTR /GET J1
2127 JMP CON24 /J1=0 IMPLIES END OF LIST
2128 AND K4037 /GET CHANNEL ORDER AND SWEEP
2132 TAD NCHA /(ORDER 0, SWEEP A) OR SWEEP B
2135 DCA TCHLOC /ADDRESS FOR ENTRY IN MX-LIST
2137 TAD I TJPNTR /GET CHANNEL # FOR THIS JOB
2142 DCA I TCHLOC /STORE IN ADDRESS CALCULATED
2143 TAD K0007 /MOVE POINTER TO NEXT J1
2153 /THIS SUBROUTINE GETS MAX-X FOR A DISPLAY GROUP
2157 DCA TNPT /# OF POINTS
2159 JMS I SDISX /GET XZERO AND DELTAX
2160 JMP XMEXIT /NO MORE ENTRIES IN DISPLAY LIST
2161 LOAD /FIND #PTS*DELTAX+XZERO
2168 FLOT01 /DELTAX*2^12/2^12
2169 TAD FOP+1 /FOP HOLDS X0
2172 \f TAD TNPT /#PTS*DELTAX
2181 DCA I BXPNTR /MAXIMUM-X FOR THIS DISPLAY
2193 /ASK LAST OF SWEEP PARAMETER QUESTIONS
2194 CON24, TAD K0175A /SWEEP TIME+(CALCTIME*ASI)/(AS1-125US)
2199 FLOT01 /TIME LEFT FOR CALCULATIONS BETWEEN INTERRUPTS
2200 LOAD /-TIME TO DO CALCULATIONS AT 100% PROCESSOR AVAILABILITY
2202 FDIV /ADJUST FOR ACTUAL AVAILABILITY
2204 FADD /INCLUDE TIME TO ACCEPT SWEEP
2207 FASI /PUT IN TERMS OF USEC
2213 SETH /THIS IS MIN TIME BETWEEN SWEEPS
2216 CON24A, FRAME /"LEAST SWEEP INTERVAL
2217 DIS24 /'-----' ':'S [>SDDDDD MS]"
2218 JMP I CON13Z /L.F.: RE SELECT JOBS
2220 JMP CON24A /FORMAT ERROR-TRY AGAIN
2224 FADD /BUSY TIME (CALTIM) .GT. INTER SYNC TIME?
2228 JMP CON24A /YES-TRY AGAIN
2229 CLA CMA /NO- PUT EOL WORDS IN MX-LISTS
2233 CLL CLA CML RAR /FIRST PUT EOMX WORDS IN PLACE
2234 TAD I MPXPNT /4000+FIRST CHAN (ORD=0) IN A TO END OF MXA-LIST
2236 TAD I MPXPNT /4000+ORD(0) OF A TO END OF MXB-LIST
2238 LOAD /GET ITIM FOR S0 FIRING
2240 FDIV /PUT IN TERMS OF ASI
2242 SAVE /- TIME FOR S0 TO FIRE
2246 FSWBEG /GET TIME FOR ADC BUFFER OPENING
2249 TAD FAC+1 /DOES SWEEP BEGIN BEFORE SYNC?
2250 SPA CLA /- TIME OF SWEEP START
2252 FADD /YES- TIME IT FROM PREVIOUS SWEEP
2253 FITIM /CONSTRAINT IS THAT SWEEPS INTERVAL IS >ITIM
2255 KWTIM /TIME TO OPEN BUFFER WINDOWS
2258 DFIX /GET ASI IN USEC
2263 CON25, FRAME /"AVERAGE '----' SWEEPS"
2265 JMP CON25 /CAN'T CHANGE JOBS OR SWEEP PARAMETERS
2267 JMP CON25 /FORMAT ERROR - ASK AGAIN
2269 DCA NSWEP /-# OF SWEEPS REQUIRED
2275 \f/GET PARAMETERS REQUIRED FOR DISPLAY WORD GENERATION
2277 DCA ND /# OF CURVES TO FIT ON SCOPE
2279 TAD ND /SET COUNT OF REQUIRED DISPLAY ENTRIES
2281 JMP I PREDWS /COUNT IS 0. EXIT
2282 CLA CMA /GET # OF COLUMNS REQUIRED
2285 CLL RAR /(# OF CURVES/4)+1
2289 FLOT01 /# OF COLUMNS TO FIT ON SCOPE
2290 TAD ND /HOW MANY ROWS?
2293 IAC /IF # OF CURVES IS 2, 2 ROWS (SCALE Y BY 2^1)
2294 SKP /IF # OF CURVES IS 1. 1 ROW (SCALE Y BY 2^0)
2295 TWO /OTHERWISE , 4 ROWS (SCALE Y BY 2^2)
2298 TWOK /#POINTS ON DISPLAY *2
2303 DCA XZD /DISTANCE BETWEEN COLUMNS *2
2305 TAD YSS /GET Y-ZERO FOR 1ST ROW IN COLUMNS
2308 TAD K0010 /4 ROWS, START AT Y=300
2309 TAD K0020 /2 ROWS, START AT Y=200
2310 DCA YZZ /1 ROW, START AT Y=000
2312 TAD YSS /GET Y-ZERO DECR TO GO FROM NTH TO N+1TH ROW
2316 TAD KM0200 /(-200)/2^(Y-SCALE+1)
2320 DCA YZD /0,-40,OR -20
2323 JMS PRESTY /SET UP FOR 1ST COLUMN
2325 \f/SUBROUTINE PRESETS Y AND X FOR NEW COLUMN
2327 DCA XZ /X-ZERO IN AC
2329 TAD YZZ /RESET TO TOP OF COLUMN
2332 TAD KM0004 /4 ROWS (MAXIMUM) TO A COLUMN
2337 /GET DISPLAY WORDS FOR A GROUP - ENTER WITH # OF PTS IN AC
2339 CMA IAC /#OF POINTS TO DISPLAY
2343 TAD XZD /DISTANCE BETWEEN COLUMNS
2344 FLOAT /2*ROOM AVAILABLE/#POINTS = X-DIST BETWEEN POINTS*2
2347 TAD K0007 /SCALE BY 2^7
2349 AND K7760 /DELTAX(8),0(4)
2350 TAD YSS /DELTAX(8),Y-SCALE(4)
2351 DCA I AXPNTR /THIS IS D1.
2353 TAD XZ /GET X-ZER0*2
2355 AND K7700B /X-ZER0(6),0(6)
2356 TAD YZW /X-ZERO(6),Y-ZERO(6)
2357 DCA I AXPNTR /THIS IS D2.
2359 TAD YZW /MOVE TO NEXT ROW
2364 ISZ UPCNT /4 COLUMNS DONE?
2365 JMP .+4 /NO-CONTINUE
2366 TAD XZ /YES-MOVE TO NEXT COLUMN
2368 JMS PRESTY /SET UP FOR NEXT COLUMN.
2369 ISZ CHCNT /ALL GROUPS COMPLETE?
2370 JMP I GETDWS /NO-EXIT AT CALL+1
2371 ISZ GETDWS /YES-EXIT TO CALL+2
2374 \f/SET COUNT OF # OF GROUPS
2377 JMP I SETCNS /0, EXIT AT CALL+1
2381 ISZ SETCNS /NOT 0, EXIT AT CALL+2
2392 /MAKE UP DISPLAY ENTRIES FOR JOBS AND CHANNELS
2393 CON26, TAD ADJLIS /MAKE UP JOB DISPLAY WORDS
2395 TAD TNJOB /NUMBER OF CURVES ON SCOPE
2397 CON26A, TAD AXPNTR /SKIP J1,J2,J3
2400 TAD I AXPNTR /J4 HOLDS -#OF POINTS
2401 ISZ AXPNTR /SKIP OVER J5
2402 JMS I GETDWX /J6 AND J7 ARE DISPLAY WORDS
2403 JMP CON26A /DO NEXT JOB
2404 TAD ADCHNL /ALL DONE
2405 DCA AXPNTR /MAKE UP CHANNEL DISPLAY WORDS
2406 TAD NCHA /GET NUMBER OF CHANNELS IN ALL
2408 JMS I PREDWX /DIVIDE UP SCOPE FOR TOTAL # OF CHAN
2410 JMS I SETCNX /SET COUNT OF DISPLAYS WITH "SAMA" POINTS
2411 JMP CON26B /NONE-TRY LO-RESOLUTION
2412 TAD SAMA /SET UP DISPLAY FOR HI CHANS
2415 CON26B, DCA I AXPNTR /EOL WORD FOR HI INPUTS
2416 TAD NCHB /SET COUNT OF DISPLAYS WITH "SAMB" POINTS
2418 JMP CON26C /NONE-GO TO MODIFY
2419 TAD SAMB /SET UP DISPLAY FOR LO CHANS
2422 CON26C, DCA I AXPNTR /EOL WORD FOR LO INPUTS
2423 \f/DISPLAY AND MODIFY INPUT PRESENTATION
2424 TAD ADCHNL /GET X-MAXIMA FOR EACH INPUT
2426 TAD ADBUFA /PUT IN ADC BUFFER
2428 TAD I ADCHNL /PUT 1ST CHAN IN ADMPXA
2430 TAD SAMA /GET HI RESOLUTION X-MAX'S
2433 TAD SAMB /GET LO RESOLUTION X-MAX'S
2436 DCA TMOD /TMOD=0 FOR NO MODIFICATIONS
2438 CON27, TAD ADCHNL /DISPLAY WORDS BEGIN AT ADCHNL-1
2440 FRAME /"$FA41INPUTS$AP21"
2442 NOP /THIS IS SKIPPED
2443 JMS I CRBRAX /BRANCH ON KEYBOARD
2444 JMP .+3 /NO CHARACTER
2445 JMP CON29 /C.R.:ALLOCATION OK
2447 CLA CMA /OTHER: GET CHANNEL NUMBERS IN ORDER
2452 JMP CON27B /OUT OF HI CHANNELS-GO TO LOW
2453 TAD K1000B /PUT "H@" IN SWEEP MESSAGE
2454 JMS I CON2SX /DISPLAY DOTS AND MESSAGE
2455 JMP CON27A /GET NEXT CHANNEL
2456 CON27B, ISZ CXPNTR /SKIP OVER FIRST OF HI
2458 JMP CON27 /OUT OF CHANNELS, RESTART
2459 TAD K1400 /PUT "L@" IN SWEEP MESSAGE
2460 JMS I CON2SX /DISPLAY DOTS AND MESSAGE
2477 /THIS SUBROUTINE DECODES DISPLAY WORDS: SDIS
2478 /POINTER IS AUTOINDEX REGISTER "AXPNTR"
2480 / END OF LIST RETURN
2484 TAD I AXPNTR /DX (8),YS(4)
2486 JMP I SDISS /EOL IF D1=0, RETURN TO CALL+1
2489 AND K0017 /HAVE Y SCALE FACTOR
2492 DCA SHFR /0 TO HI FAC
2495 SHFT /MOVE BINARY POINT TO END OF SHFR+1
2496 SAVE /DX(8) IS INTEGER PART (5), FRACTIONAL PART (3)
2498 TAD I AXPNTR /XZ(6),YZ(6)
2500 TAD K0004 /MOVE YZ TO 10 SIGNIF, BITS
2503 DCA YZ /POSITION OF Y-ZERO
2505 TAD KM0006 /MOVE XZ TO 10 BITS OF SHFR+1
2508 AND KM0006 /7772 - IGNORE SCALE PART (MOSTLY)
2510 DCA DBLARG /DBLARG & DBLARG+1 HOLD X-POSITION
2511 ISZ SDISS /EXIT TO CALL+2
2513 \f/SUBROUTINE SCALES, BIASES, AND DISPLAYS Y: YDIS
2514 /USES "YS", "YZ", FROM SDIS, Y VALUE IN DBLAC AT CALL
2516 DCA SHFR /VALUE TO BE SCALED, BIASED
2521 TAD SHFR /GET SCALED VALUE
2529 CON29, DCA I ADMPXA /REPLACE EOL FOR JOB LIST
2530 LOAD /ASI BETWEEN SYNCS
2532 DFIX /FIX TO DOUBLE-WORD
2534 TAD ADBUFA /PUT X-MAXIMUMS IN ADC BUFFER
2536 TAD ADJLIS /TAKE PARAMETERS FROM JOB LIST
2538 CON29A, TAD I AXPNTR /LOOK AT J1
2540 JMP I OTTY /J1=0,END OF LIST
2541 ISZ AXPNTR /SKIP J2,J3
2543 TAD I AXPNTR /J4 HAS # OF POINTS
2545 JMS I XMAXY /FIND MAX-X USING J6 AND J7
2546 JMP I CON29B /GET NEXT JOB
2548 DCA TMOD /MODIFY WHICH? -0 (NONE) TO BEGIN WITH
2550 JMS I CON1SY /INITIALIZE POINTERS & COUNTERS
2551 FRAME /"$EA41AVERAGES$"
2553 CON1SY, CON1S /SKIPPED
2554 JMS CRBRAS /BRANCH ON CR OR LF
2555 JMP CON30A /NEITHER CR OR LF
2556 JMP CON32 /C.R.:ALLOCATION OK
2557 JMP CON30A /L.F.:CHANGE ALLOCATION
2562 \fCON30A, TAD I AXPNTR /DISPLAY AVERAGES ALLOCATIONS
2564 JMP CON30 /YES-START OVER
2565 ISZ AXPNTR /SKIP J2 AND J3
2567 TAD I AXPNTR /J4 HAS # OF POINTS
2571 JMS I SDISZ /SET UP DISPLAY: J6 J7 ARE DISPLAY WORDS
2572 DLIMX, DLIMS /SKIPPED
2574 DIS30A /DISPLAY LIMIT DOTS AND JOB #
2575 JMS I DLIMX /LIMIT DOTS, PUT JOB # IN BUFFER
2581 JMP CON30A /GET NEXT JOB
2596 /SUBROUTINE TO BRANCH AND ECHO KBD CR OR LF
2598 KSF /KEYBOARD STRUCK?
2599 JMP I CRBRAS /NO-EXIT TO CALL+1
2600 KRB /YES- READ IT IN
2601 BRAN /CHECK FOR CR OR LF
2603 ISZ CRBRAS /LF - EXITS TO CALL+3
2604 SKP /CR - EXITS TO CALL+2
2605 JMP I CRBRAS /OTHER - EXITS TO CALL+1
2606 TAD KCR /FOR CR OR LF - TYPE CRLF
2608 ISZ CRBRAS /EXIT TO CALL+2(CR) OR CALL+3(LF)
2611 /OUTPUT CONTROL TAPE OR MODIFY MEMORY
2612 CON32, FRAME /"PUNCH CONTROL TAPE? '-'
2614 JMP CON32 /LF: CAN'T GO BACK - ASK AGAIN
2615 DCA TENPUN /INITIALIZE FOR "NO PUNCH"
2620 ISZ TENPUN /Y: YES, TENPUN=1 TO ALLOW PUNCHING
2621 CLA /*** TITLE NOT ASKED,A MS. DEVICE WRITTEN ON.
2623 JMP CON32B /NO PUNCH - DON'T ASK FOR TITLE
2624 CON32A, FRAME /"TITLE:
2625 DIS32A /'-------------'"
2626 JMP CON32A /LF: ASK AGAIN
2627 JMS I INITOX /INITIALIZE SYS DEVICE (OUTPUT)
2628 TAD TXMRK /MOVE HALFWORD POINTER TO TITLE
2630 K0006B, 0006 /SKIPPED
2631 JMS I TITLEX /VISUAL MODE TITLE ON TAPE
2634 SETH /REPOSITION HALFWORD POINTER TO TITLE
2636 TPUNQ /OUTPUT TITLE TO SYS DEV.
2637 CON32B, TXPUN /"<CRLF>SWEEP SUMMARY<CRLF>"
2639 TXPUN /OUTPUT SUMMARY
2640 DIS09 /END WITH 2 CRLF'S
2642 TXT32A /CHAN RATE TYPE SORT<CRLF>"
2643 CON33, TAD ADJLIS /GO THRU JOB LIST FOR THIS INFO
2647 \fCON33A, SETH /".XX.....X....X....XXX<CRLF>"IS FORMAT
2651 JMP I CON34X /YES-END OF JOB LIST
2652 DCA SHFR /J1 = A/B(1), CHAN#(5), 1(1), CHAN ORDER (5)
2654 TAD I TOPNT /J2=TYPE (4), SORT CODE (8)
2656 TAD SHFR+1 /GET SORT CODE
2660 TAD KM06 /SHIFT J1,J2 RIGHT 6
2662 TAD SHFR /CHAN # IN AC7-11
2666 MTW /MOVE JOB TYPE TO SHFR+1 BITS 8-11
2668 TAD SHFR /SIGN EXTENSION IN SHFTS SO BIT 0 OF SHFR HOLDS A/B
2672 DCA I TXT33X /PUT IT IN MESSAGE
2676 TJOB=TEMP05 /OUTPUT CHAN # TO BUFFER
2679 TAD TJOB /OUTPUT TYPE TO BUFFER
2681 TAD TCNTG /OUTPUT SORT CODE TO BUFFER
2683 TXPUN /OUTPUT BUFFER TO TTY
2685 TAD K0006B /MOVE TO NEXT J1
2688 JMP CON33A /DO NEXT JOB
2689 \f/SUBROUTINE TO DISPLAY DOTS AT EXTREMA,POSITION, DSC,AND SEQ.
2691 TAD FOP+1 /SET X TO X-ZERO
2694 TAD KM1000 /SET Y TO BOTTOM
2695 JMS I YDISX /DISPLAY LOWER LEFT DOT
2696 TAD K0777 /SET Y TO TOP
2697 JMS I YDISX /DISPLAY UPPER LEFT
2698 TAD I BXPNTR /SET X TO MAX
2699 DILY /DISPLAY UPPER RIGHT
2704 TAD KM1000 /SET Y TO BOTTOM
2705 JMS I YDISX /DISPLAY BOTTOM RIGHT
2706 TAD FOP+1 /POSITION DSC
2708 TAD YZ /IN MIDDLE RIGHT OF FIELD
2710 ISZ TDCNTR /NEXT SEQUENCE #
2711 TAD TDCNTR /PUT IT IN MESSAGE FOR DISPLAY
2721 /SUBROUTINE TO INITIALIZE PARAM POINTERS AND DISPLAY MESSAGE
2723 DCA AXPNTR /POINTER TO DISPLAY WORDS
2724 TAD ADBUFA /POINTER TO X-MAX LIST
2726 DCA TDCNTR /SET SEQUENCE # TO 0
2728 TAD TMOD /SET MODIS COUNTER
2732 \f/SUBROUTINE TO DISPLAY LIMIT DOTS WITH MESSAGE FOR INPUT DISPLAY
2734 DCA I DIS27X /PUT SWEEP TYPE IN MESSAGE
2737 JMS DLIMS /DISPLAY LIMIT DOTS AND FILL ITEM #
2738 TAD I CXPNTR /GET CHANNEL NUMBER
2740 OCTOUT /FILL SPACE FOR CHAN # IN MESSAGE
2741 SETH /DISPLAY THE MESSAGE
2770 /SUBROUTINES TO HANDLE DISPLAY IO [SU46AB]
2771 /HAND READABLE PUNCH SUBROUTINE: TITLE
2775 / ADDR OF TEXT TO BE USED IN TITLE
2779 TAD K0377 /PUNCH A RUBOUT (BRACKET TITLE WITH RUBOUTS)
2781 JMP PSKIP-1 /PUNCH A SPACE (6-200 CODES)
2782 HRNXT, LDH /GET 6 BIT CHAR
2784 TAD ADRTBL /FIND ENTRY IN DISPLAY TABLE
2786 TAD I PNTR /GET THE ENTRY
2787 SNA CLA /SEE IF SPECIAL CHARACTER
2788 JMP HRCHK /SPECIAL - FIND OUT WHAT TO DO
2789 JMS I SHPX1 /SAVE HALFWORD POINTER FOR MORE CHARACTERS
2790 TAD KM0004 /FOUR HALF WORDS TO A CHARACTER
2793 PNTR, 0 /SET UP POINTER FOR TABLE PUNCH
2794 HRPUN, LDH /GET LINE
2795 TAD K0200A /8 HOLE PUNCHED TOO
2796 JMS I PUNX1 /PUNCH THE LINE
2798 JMP HRPUN /MORE HALVES
2799 JMS I RHPX1 /ALL PUNCHED - RESTORE TEXT POINTER
2802 HRCHK, ISZ PNTR /SPECIAL CHAR FIND OUT
2803 TAD I PNTR /WHAT TO DO
2804 SMA SZA /SPACE OR END OF TEXT?
2805 JMP HRNXT /NO, IGNORE AND GET NEXT CHARACTER
2806 SNA CLA /END OF TEXT?
2807 JMP TILEND /YES - GO PUNCH RUBOUT AND EXIT
2808 LDH /SPACE - SEE IF NEXT CHARACTER IS A SPACE
2811 JMP .-3 /YES - COMPRESS MULTIPLE SPACE TO 1 SPACE
2812 JMS I DHPX2 /MOVE BACK HALFWORD POINTER
2813 TAD KM006 /AND PUNCH A SPACE
2816 PSKIP, DCA HCNTR /PUNCH 6 LINES OF 200 CODE
2819 ISZ HCNTR /DONE 6 LINES?
2820 JMP .-3 /NO - CONTINUE
2821 JMP HRNXT /YES - GET NEXT CHARACTER
2822 TILEND, TAD K0377 /PUNCH A RUBOUT AND EXIT
2831 PUNX1, PUNCHS /PUNCH A CHARACTER
2832 DHPX2, DHPS /MOVE BACK 1 CHARACTER
2834 /SUBROUTINE TO DO Q AND A BETWEEN TTY AND DIS: FRAME
2836 / [FRAME NAME /ADDRESS OF TEXT TO BE DISPLAYED
2837 / L.F. RETN /L.F. AT ANYTIME RETURNS HERE
2838 / C.R. RETN /C.R. AFTER FINAL BLANK RETURNS HERE
2841 TAD I FRAMES /GET ADDRESS
2843 ISZ FRAMES /MOVE RETURN TO CALL+2
2844 JMS FRSETH /MOVE POINTER TO START OF TEXT
2845 JMS I TXIX /PUT BLANK MARKS IN KBD AREAS
2846 JMS FRDIS /DISPLAY THE TEXT
2847 JMS FRSETH /MOVE POINTER TO START OF TEXT
2848 FRQUES, TAD TXMRK /GET KBD AREA
2850 JMP FREND /END OF TEXT - EXIT
2851 FRLOOP, JMS I SHPX1 /SAVE TEXT POINTER
2852 JMS FRDIS /DISPLAY TEXT
2853 JMS I RHPX1 /RESTORE TEXT POINTER
2854 JMS I TXKX /ACCEPT A CHARACTER INTO BUFFER.
2855 JMP FRLOOP /NORMAL RETURN
2856 JMP FREND+1 /L.F. - EXIT TO CALL+2
2857 JMP FRQUES /C.R. - GET NEXT KBD AREA
2858 FREND, ISZ FRAMES /NO MORE KBD AREAS TO FILL
2859 JMS FRSETH /REPOSITION TEXT POINTER
2863 SETH /REPOSITION TEXT POINTER
2864 FRSET, 0 /TO START OF FRAME
2867 FRDIS, 0 /DISPLAY THE FRAME
2868 SETH /INITIALIZE DISPLAY
2870 LDH /X0,Y0,SIZE,INTENSITY
2873 JMS FRSETH /REPOSITION TEXT POINTER
2874 LDH /DISPLAY THE CHARACTERS
2875 JMS I DSCX1 /OF THE FRAME
2877 JMP I FRDIS /TEXT ENDED
2878 \f/DISPLAY INITIALIZE
2879 DSINIT, 4411 /$AH10@
2880 1010 /X=000, Y=001, SIZE=10,
2884 TXIX, TXIS /PUT BLANKMARKS IN KBD ENTRIES
2885 TXKX, TXKS /GET KBD INTO KBD AREA
2886 DSCX1, DSCS /DISPLAY CHARACTER
2887 RHPX1, RHPS /RESTORE HALFWORD POINTER
2888 SHPX1, SHPS /SAVE HALFWORD POINTER
2890 /THIS SUBROUTINE GETS OCTAL ARGUMENT: OCTARG
2893 JMS I ARSETX /GET TO KBD - ENTRY
2894 OCNEXT, LDH /GET CHARACTER
2896 OCSORT /IS IT SPACE OR TXMRK?
2897 JMP OCNEXT /SPACE IGNORE
2898 JMP OCEND /TXMRK - END
2899 JMS I STRNUX /OTHERS - IS IT A NUMERIC?
2900 JMP I OCTARS /NO - EXIT TO CALL+1 (ERROR RETURN)
2901 TAD KM007A /NUMERIC 0-7?
2903 JMP I OCTARS /NO - ERROR RETURN
2904 LOAD /SHIFT ACCUMULATED SUM 3 LEFT
2905 OCTOP-1 /(MULTIPLIES BY 8)
2906 TAD STRSAV /ADD CURRENT DIGIT
2909 SHFT /NEW ACCUMULATED SUM
2911 JMP OCNEXT /NEXT CHARACTER
2912 OCEND, TAD OCTOP /OVERFLOW ?
2914 JMP I OCTARS /YES - ERROR RETURN
2915 TAD OCTOP+1 /NO - GET ACCUMULATED SUM
2916 ISZ OCTARS /EXIT TO CALL+2
2919 /CONSTANTS THIS PAGE
2927 /REQ: [SU60A],[SU64A]; THIS IS [SU50AC]
2928 /DISPLAY STRIPPED ASCII CHAR IN AC: DSC
2929 /CALL: LDH /GET HALFWORD
2930 / DSC /DISPLAY IF NON ZERO
2931 / JMP .-2 /DISPLAY THE NEXT HALFWORD
2942 /DISPLAY TABLE EXCEPTIONS
2950 CLL RAL /TWICE STRIPPED ASCII
2951 TAD ADSTBL /FOR TABLE POINTER
2953 TAD I CHPNT /GET DISPLAY WORD 1
2954 ISZ CHPNT /SET FOR NEXT DISPLAY WORD 2
2955 SNA /NOT SPECIAL CHARACTER?
2956 JMP CHSPEC /SPECIAL CHARACTER
2958 CHSET1, DCA CHROT /HOLDS ROTATED DISPLAY WORD
2959 TAD CHXL /MOVE TO NEXT X POSITION
2961 MTW /NUMBER OF WORDS IS TWO
2963 CHSET2, MTW /NUMBER OF LINES PER WORD IS TWO
2965 CHSET3, TAD KM006A /NUMBER OF POINTS IN A LINE IS SIX
2967 TAD CHYL /REPOSITION Y AT BOTTOM OF CHARACTER
2970 CLL RAL /GET DISPLAY BIT FOR THIS POINT INTO LINK
2971 DCA CHROT /STORE CODE WORD FOR NEXT POINT
2972 TAD CHYS /LOAD INTENSIFICATION POSITION
2974 SNL /DISPLAY IF LINK=1
2979 TAD CHSIZ /GO NEXT POSSIBLE DOT
2980 DCA CHYS /KEEP RECORD OF PRESENT POSITION
2981 ISZ CHCNT1 /DO ALL THIS SIX TIMES
2983 TAD CHXL /MOVE X TO NEXT LINE
2987 ISZ CHCNT2 /HAS SECOND HALF BEEN DONE?
2988 JMP CHSET3 /NO, DO IT
2989 TAD I CHPNT /GET SECOND WORD
2990 DCA CHROT /AND DISPLAY IT
2993 TAD CHSIZ /BOTH WORDS DONE - DO TWO EMPTY ROWS
2994 CLL RAL /(SPACE OVER 2 LINES)
2997 JMP I DSCS /THEN EXIT AT CALL+1
2999 CHSPEC, TAD I CHPNT /SPECIAL CHARACTER-GET WORD 2 FOR BRANCH
3000 TAD CHJMP /SETUP FOR JMP TO
3001 DCA .+1 /SPECIAL ROUTINE
3002 JMP I CHJMPL /THIS IS THE JUMP
3004 /DISPATCH TABLE FOR ABOVE JMP
3005 CHJMPL, CHSPA /JUMP TABLE: SPACE
3007 CHREST /NEXT 4 CHARACTERS RESET X, Y, DELTA, INTENSITY
3008 CHCR /DO A CARRIAGE RETURN, LINE FEED
3011 CHEND, ISZ DSCS /ATTEMPT TO DSC E.O.T. MARK
3012 JMP I DSCS /EXIT TO CALL +2CS
3014 /SPACE: MOVE X RIGHT 6 INCREMENTS
3018 CLL RTL /4 TIMES SIZE
3021 CLL RAL /PLUS 2 TIMES SIZE
3022 TAD CHFAC /IS SIX TIMES SIZE
3023 TAD CHXL /MOVE X POINTER LEFT
3024 DCA CHXL /ONE CHARACTER (6 LINES)
3028 CHREST, LDH /NEXT HALFWORD "A"-"P"
3029 TAD KM0001 /GETS X POSITION
3030 AND K0017 /"A" IS LEFT MARGIN, "P" IS RIGHT MARGIN
3034 DCA CHXL /64 POINTS BETWEEN "A" AND "B"
3035 CHYPOS, LDH /NEXT HALF WORD GETS Y POSITION
3041 TAD K1001 /"A" IS TOP OF SCREEN. "B" IS BOTTOM
3042 DCA CHYL /64 POINTS BETWEEN "A" AND "B"
3043 CHCSZ, LDH /NEXT CHARACTER GETS SIZE OF CHARACTER -"4" IS NORMAL
3044 AND K0017 /ELIMINATE ALL BUT BITS 8-11
3045 DCA CHSIZ /STORE DESIRED CHARACTER SIZE
3048 /CR-LF: RETURN X TO LEFT MARGIN, MOVE Y DOWN 8 INCREMENTS
3050 DCA CHXL /RESET X TO 0
3051 TAD CHSIZ /8 TIMES CHAR SIZE
3054 CMA IAC /SUBTRACT FROM Y POSITION
3056 DCA CHYL /NEW Y POSITION
3059 /CONSTANTS USED THIS PAGE ONLY
3060 CHJMP, JMP I CHJMPL+1
3065 /VARIABLES FOR THIS PAGE
3066 CHXL, 0 /X LOCATION ON SCOPE
3067 CHYL, 0 /Y LOCATION OF CURRENT LINE
3068 CHSIZ, 0 /CHARACTER SIZE CONSTANT
3069 \f/DISPLAY TABLE - PATTERN MATRICES FOR CHARACTERS
3070 DSCTBL, 0 /@ SPECIAL, MEANS END OF TEXT
3151 0617 /[ DISPLAYED AS #
3154 1057 /\ DISPLAYED AS DOWN ARROW
3157 2313 /] DISPLAYED AS %
3166 0 /SPACE IS A SPECIAL CHARACTER
3172 0 /" SPECIAL, MARKS PROG INPUT TO TEXT, NOT DISPLAYED
3175 0 /# SPECIAL, IGNORES
3177 \f 0 /$ SPECIAL, DISPLAY RESET FOLLOWS
3180 0 /% SPECIAL, DOES CARRIAGE RETURN
3183 4040 /& - USED IN Q&A BLANKS
3186 0 /' SPECIAL, MARKS KBD INPUT TO TEXT, NOT DISPLAYED
3189 7741 /( DISPLAYED AS [
3192 0041 /) DISPLAYED AS ]
3195 2214 /* DISPLAYED AS LITTLE X
3260 \f/FLOATING VARIABLES
3290 /SUBROUTINES TO HANDLE FLOATING, DECIMAL, AND OCTAL IO [SU54AB]
3291 /REQUIRES [SU60A] [SU62A], [SU63A], [SU64A]
3293 /SUBROUTINE CONVERTS AC TO OCTAL CHARACTERS ON HALFWORD BUFFER: OCTOUT
3297 DCA SHFR+1 /PUT AC IN LOW ORDER SHIFT REGISTER
3298 TAD KM0004 /GET 4 CHARACTERS
3301 TAD KM0004 /AC=0 STORES AS "0 "
3303 TAD PROMRK /LOOK FOR ENTRY AREA
3305 MPRMRK, -42 /SKIPPED-PRESUME THERE IS AN ENTRY AREA LEFT
3306 OCVROT, TAD K0003 /OCTAL CHARACTER REPRESENTS 3 BITS
3308 TAD SHFR /# IS IN LEFT 3 BITS OF AC
3310 JMS OUTCH /OUTPUT THE #
3311 K0060, 0060 /LEADING 0 OR NO ROOM - "AND" WITH 0 IS NOP
3312 ISZ OCNT /MORE CHARACTERS?
3313 JMP OCVROT /YES-CONTINUE
3314 TAD KM0020 /NO-FILL REMAINING AREA WITH SPACES
3316 JMP I OCTOUS /AREA IS FULL-EXIT
3317 JMP .-3 /PUT IN SPACES
3319 /GENERALIZED NUMERICAL OUTPUT ROUTINE
3320 /SUBROUTINE STORES A CHAR AWAY IF NOT A LEADING 0 AND THERE IS ROOM
3321 /EXITS TO CALL+1 IF THESE CONDITIONS NOT MET, CALL+2 IF THEY ARE
3322 /TEMPORARY STORAGE ALLOCATION
3328 ISZ LSWIT /IS THIS A LEADING ZERO?
3331 JMP I OUTCH /AND IT'S A ZERO-EXIT TO CALL+1
3332 DCA STOR /NO-NOT A LEADING ZERO.
3333 CLA CMA /FIX UP LEAD SWITCH
3335 LDH /IS THERE ROOM IN THE BUFFER?
3338 JMP I OUTCH /NO MORE ROOM-EXIT TO CALL+1
3339 TAD STOR /ROOM AVAILABLE-MAKE 6BIT OUT OF #.
3342 ISZ OUTCH /PUT IT AWAY
3343 JMP I OUTCH /EXIT TO CALL+2
3344 \f/SUBROUTINE CONVERTS FLOATING AC TO ASCII STRING: FLTOUT
3345 /TEMPORARY STORAGE ALLOCATION
3353 TAD PROMRK /LOOK FOR A PLACE TO PUT CHARACTERS
3355 KM0033, -33 /SKIPPED
3357 SPA CLA /PUT IN A "-" OR A SPACE DEPENDING UPON SIGN
3360 JMS OUTCH /PUT OUT CHARACTER
3361 CHEXP, 0 /A NOP-BUT NOT REACHED ANYWAY
3363 SPA CLA /GET .ABS. FAC
3366 REMAIN /SET UP FOR RADIX DEFLATION
3368 DCA FCVCNT /WE WILL LOOK AT 9 POWERS OF 10
3369 DCA LSWIT /ENABLE SEARCH FOR LEADING 0'S
3371 DCA ZSWIT /DETECT FIRST NON ZERO LEAD
3372 LOAD /HOW MANY 100,000,000'S
3374 CVLOOP, SAVE /HOW MANY MULTIPLES OF RADIX?
3380 FIX /# OF MULT. OF RADIX
3382 TAD DIGIT /GET REMAINDER
3391 TAD DIGIT /PUT DIGIT OUT INTO BUFFER
3393 JMP CVRLZ /LEADING ZERO OR NO MORE ROOM
3394 ISZ ZSWIT /FIRST NON-ZERO?
3396 TAD KM0033 /YES, PUT "U" IN MULTIPLIER
3398 \f TAD FCVCNT /U:1-3, M:4-6, SPACE: 7-9=-FCVCNT
3399 TAD K0003 /9+FCVCNT (-) IS # OF LEADING ZEROES
3401 JMP CVRLZ /NEITHER, MULTIPLIER IS U, NO PERIOD
3404 JMP CVRSP /MULTIPLIER IS SPACE
3405 TAD KM0003 /MULTIPLIER IS M, COUNT UNTIL "."
3406 DCA PERCNT /3, 2, OR 1 CHARACTERS UNTIL "."
3407 TAD KM0043 /PUT M IN MULTIPLIER
3409 CVRSP, DCA PERCNT /3,2,OR 1 CHARACTERS BEFORE "."
3410 TAD KM0020 /PUT SPACE IN MULTIPLIER
3412 TAD KM0004 /AND PUT ONLY 4#'S IN BUFFER
3415 CVRNZ, ISZ PERCNT /NON-ZERO ENTRY WAS MADE
3416 JMP CVRLZ /NOT YET TIME FOR "."
3419 KM0020, -20 /THIS INSTRUCTION IS SKIPPED
3421 CVRLZ, LOAD /REDUCE THE RADIX BY A FACTOR OF 10
3425 ISZ FCVCNT /HAD ENOUGH?
3426 JMP CVLOOP /NO-CONTINUE
3427 TAD KM0020 /FILL REMAINING WITH SPACES
3431 CVREND, TAD PROMRK /MOVE TO FILL EXPONENT CHARACTER
3437 TAD KM0020 /NOW FILL REMAINING WITH SPACES
3441 LSWIT, -1 /-1 TO ACCEPT LEADING ZEROS
3444 STHX1, STHS /STH SUBROUTINE
3448 \f/TTY-LISTS USED TO SCAN FLOATING ARGUMENTS
3462 /THIS SUBROUTINE SCANS FOR DECIMAL ARGUMENT: DECARG
3464 JMS ARSET /POSITION HALFWORD POINTERS
3466 BRAN /LOOK FOR SPACES AND TXMRKS
3468 JMP DECNXT /SPACE - IGNORE
3470 JMS STRNUM /OTHERS-STRIP OFF 60
3471 JMP I DECARS /NOT A (6BIT) NUMERAL
3472 TAD KM0011 /0-9 ARE ALLOWED
3474 JMP I DECARS /NOT A DECIMAL NUMERAL
3475 TAD STRSAV /MULTIPLY PREVIOUS ACCUMULATION BY 10
3480 DECEND, TAD DBLARG /CHECK FOR OVERFLOW
3482 JMP I DECARS /GREATER THAN 4095, EXIT TO CALL+1
3483 TAD DBLARG+1 /ARGUMENT OK-EXIT AT CALL+2
3486 \f/THIS SUBROUTINE MULTIPLIES DXAC BY 10 AND ADDS CURRENT STRIPPED CHARACTER [IN AC]
3487 /TEMPORARY STORAGE ALLOCATION
3490 DCA DXCHAR /AC HOLDS NEXT # TO ADD
3493 CLA IAC /GET 2 * OLD SUM
3497 TWO /GET 8 * OLD SUM
3499 DADD /ADD TO 2 * OLD SUM
3501 DCA DBLAC+1 /ADD NEXT #
3504 JMP I DX10 /10 * OLD SUM + NEXT#
3506 /THIS SUBROUTINE SCANS FOR FLOATING ARGUMENT AND LEAVES IN FAC: FLTARG
3507 /ARITHMETIC REGISTER ALLOCATION
3509 /TEMPORARY STORAGE ALLOCATION
3516 DCA FRCNT /DECIMAL POINT INDICATOR
3518 DCA FLSGN /SIGN INDICATOR
3519 FLNEXT, LDH /GET NEXT CHARACTER FROM BUFFER
3521 FLSORT /SPECIAL CHARACTERS
3522 JMP FRCHK /. - CHECK FRCNT AND SET IT
3523 JMP FLTMOD /TXMRK - GO TO STAGE 2
3524 DCA FLSGN /- - SET SIGN = 0
3525 JMP FLNEXT /SPACE - IGNORE
3526 JMS STRNUM /OTHER - CHECK FOR 0,...,9
3527 JMP I FLTARS /NOT NUMERIC: ERROR RETURN
3528 TAD KM0011 /GREATER THAN 9?
3530 JMP I FLTARS /YES: ERROR RETURN
3531 TAD FLCHAR /NO, IN RANGE 0-9
3532 JMS DX10 /INCREASE RESULT
3533 ISZ FRCNT /ENOUGH CHARACTERS?
3535 JMP I FLTARS /YES-MORE THAN 3 DIGITS IN FRACTION-EXIT
3537 FRCHK, TAD KM0004 /ALLOW 3 DIGITS TO RIGHT OF "."
3540 \fFLTMOD, LOAD /GET MODIFY CHARACTER
3542 NORM /MAKE FLOATING POINT OF FIRST PART
3544 TAD FRCNT /HOW MANY DIGITS TO RIGHT OF DECIMAL?
3545 SPA CLA /POS INDICATES 0 DIGITS TO RIGHT
3547 TAD KM0004 /DIGITS TO RIGHT -4="FRCNT"
3549 ALPHA /GET "M" OR "SPACE"
3554 JMP I FLTARS /OTHER-ERROR RETURN
3555 TAD KM0002 /MULTIPLIER IS 10^[2+(-FRCNT)] IF "SPACE", 3 LESS IF "M"
3557 SMA SZA /.GT. 0 MEANS ERROR, FRACTION OF U
3560 JMP FLDONE /IF MULT IS 10^0,DONE
3561 DCA FRCNT /IF NOT. SET UP LOOP COUNT
3566 FLDONE, ISZ FLSGN /NOW ADJUST SIGN
3568 ISZ FLTARS /RETURN TO CALL+2 IF OK
3569 LDH /MOVE OVER NEXT CHAR (TXMRK)
3573 /THIS SUBROUTINE DOES GENERALIZED NUMERICAL INPUT - STRIPS 60 AND STORES
3574 /TEMPORARY STORAGE ALLOCATION
3578 TAD BSAVE /CHAR ASSUMED IN TEMP02
3579 TAD KM0060 /6BIT MUST BE .GE. 60
3581 JMP STRERR /IF NOT IS NOT A CHARACTER
3582 DCA STRSAV /STORE STRIPPED CHARACTER IN TEMP02
3583 TAD STRSAV /AND LEAVE IN AC
3589 \f/THIS SUBROUTINE INITIALIZES INPUT POINTERS
3590 /ARITHMETIC REGISTER ALLOCATION
3594 TAD TXMRK /MOVE TO INPUT REGION
3596 KM0002, -2 /THIS LOCATION SKIPPED
3597 DCA AROP /CLEAR SUM REGISTER
3618 /HALFWORD AND TEXT HANDLERS [SU60AB] - REQUIRES [SU63A]
3620 /TEMPORARY STORAGE ALLOCATION
3623 /SET H WORD POINTERS TO FIRST HALF OF AC HELD ADDRESS: SETH
3624 /TYPICAL CALLING SEQUENCE
3630 TAD I SETHS /GET ADDRESS FROM CALL+1
3631 DCA HPNT2 /PUT IT IN LDH POINTER
3634 ISZ SETHS /EXIT CALL+2
3637 /SAVE H WORD POINTERS: SHP
3640 TAD HPNT2 /GET LDH POINTERS
3646 /RESTORE HWORD POINTERS TO SAVED VALUES: RHP
3649 TAD HPSV /GET SAVED POINTERS
3651 TAD HSWSV /PUT IN LDH POINTERS
3655 /DECREMENT HALF-WORD POINTER: DHP
3658 ISZ HSW2 /SKIP IF LEFT HALF
3659 JMP HPD2 /RIGHT HALF
3660 TAD HPNT2 /LEFT HALF, MOVE TO RIGHT HALF OF PREVIOUS WORD
3663 HPD2, DCA HSW2 /RIGHT HALF, MOVE TO LEFT HALF, SAME WORD
3668 /HALF WORD LOAD AC: LDH
3669 LDHS, 0 /GET HALF WORD AND MOVE POINTER TO NEXT HALF
3670 CLL CLA /PUT LDH POINTERS IN STH POINTERS
3674 DCA HPNT1 /WHICH HALF ARE WE ON?
3682 LDH2, CMA /SET POINTER TO LEFT HALF (HSW2)
3685 AND K0077 /GET HALFWORD
3686 ISZ HPNT2 /NEXT HALF IS LEFT HALF OF NEXT WORD
3689 /HALF WORD STORE AC - FROM PLACE LDH WAS DONE: STH
3691 AND K0077 /SAVE RIGHT HALF OF AC
3692 ISZ HSW1 /STORE IN FIRST OR SECOND HALF?
3693 JMP STH2 /SECOND (RIGHT) HALF
3694 CLL RTL /POSITION IN LEFT HALF
3698 TAD I HPNT1 /GET OLD WORD FROM TEXT BFFER
3699 AND K0077 /CLEAR LEFT HALF
3700 JMP STH3 /GO STORE NEW VALUE
3702 STH2, DCA HSAVE /RIGHT HALF
3703 TAD I HPNT1 /GET OLD WORD
3704 AND K7700H /CLEAR RIGHT HALF
3705 STH3, TAD HSAVE /STORE WITH NEW VALUE
3709 \f/SEARCH HALF-WORD BUFFER FOR CHARACTER: SRCH
3710 /CALL: TAD [X /SEARCH FOR X
3718 CHNX, JMS LDHS /GET NEXT HALFWORD
3719 SNA /HALFWORD IS 0: END OF BUFFER REACHED
3721 TAD HSAVE /SUBTRACT SEARCH CHARACTER
3724 ISZ SRCHS /HAVE NOT FOUND IT, CONTINUE
3725 JMP I SRCHS /FOUND IT! EXIT TO CALL+2
3727 /THIS SUBROUTINE TYPES STRIPPED ASCII CHARACTERS: TYPE
3731 / END OF TEXT RETURN
3734 BRAN /CHECK AGAINST SPECIAL CHARACTER LIST
3736 ISZ TYPES /@-END OF RECORD- SPECIAL RETN
3737 K0100T, 0100 /" - IGNORE - "AND" WITH AC = 0
3738 NOP /$ - DISPLAY RESET IS IGNORED
3739 JMP I TYPES /' - KBD ENTRY DELIMITOR IS IGNORED
3740 JMP TCR /C.R. - DO C.R.L.F.
3741 JMP I TYPES /L.F. - IGNORE
3742 TAD BSAVE /NONE OF THE ABOVE
3743 TAD KM0040 /00-37 ARE 300-337; 40-77 ARE 240-277
3747 TPEX, JMS TOUT /TYPE IT
3750 TCR, TAD K215 /C.R.L.F. - DO CR FIRST
3752 TAD K212 /THEN DO LF
3758 \f/SUBROUTINE TYPES OUT 8BIT IN AC
3760 KXX46, TLS /THIS IS A CONSTANT
3763 TCF /LEAVES FLAG CLEARED
3767 /FILLS ALL ENTRY AREAS WITH BLANKMARKS: TXI
3769 / ADDRESS OF TEXT START
3774 TXSR1, TAD TXMRK /GET FIRST BREAK CHAR
3776 JMP I TXIS /END CHAR FOUND
3778 TXSR2, JMS LDHS /FIND BREAK 2
3779 TAD MTXMRK /PUT BLANKMARKS FROM BRK 1 TO 2
3781 JMP TXSR1 /FOUND 2ND BREAK
3782 TAD KXX46 /NOT FOUND YET
3783 JMS STHS /PUT IN BLANKMARKS
3786 /LOCAL VARIABLES THIS PAGE
3787 HPSV, 0 /SAVE ADDRESS
3789 HPNT2, 0 /LDH ADDRESS
3791 HPNT1, 0 /STH ADDRESS
3794 /CONSTANTS FOR THIS PAGE
3801 /TEXT-KEYBOARD HANDLES [SU62AB]
3804 /SUBROUTINE PICKS UP FIRST CHARACTER OF AN ENTRY
3806 TAD TXMRK /FIND TXMRX (KEYBOARD DELIMITOR)
3808 JMP I ALPHAS /NOT HERE, EXIT WITH AC=0
3809 LDH /GETS FIRST CHARACTER
3812 /LOADS KBD CHARACTERS INTO BUFFER: TXK
3820 JMP I TXKS /NO KEY - EXIT
3822 JMS I UCHECK /USER MUST HAVE SUBROUTINE AT 7540 OR NOP THIS LOCATION
3823 BRAN /CHECK AGAINST SPECIAL CHARACTERS
3829 TAD MTXMRK /CHECK THAT KEYBOARD AREA NOT FULL.
3831 JMP TXEN /NO MORE ROOM - EXIT WITHOUT ECHO
3833 AND K0077A /STRIP CHARACTER TO 6BIT
3834 BRAN /CHECK AGAINST SPECIAL 6BIT'S
3836 K0034A, 0034 /@ - END OF TEXT MARKER
3837 K0077A, 0077 /" - PROGRAMMED INPUT TEXT MARKER
3838 K0046, 0046 /$ - DISPLAY RESET
3839 JMP TXEN /' - KBD MARKER - FOR THIS AND ABOVE: EXIT WITHOUT ECHO
3840 K0070, 0070 /% - CONVERT TO ] WHICH IS DISPLAYED AS %
3841 TAD K0070 /# - CONVERT TO [ WHICH IS DISPLAYED AS #
3842 TAD BSAVE /NONE OF THE ABOVE
3844 TAD BSAVE /STORE AWAY
3847 \fTXLF, ISZ TXKS /C.R. OR L.F.
3848 LDH /FILL REST OF KBD AREA WITH SPACES
3849 TAD MTXMRK /END OF AREA?
3851 JMP TXER /YES - TYPE A CRLF AND EXIT
3852 TAD K0040 /NO - PUT ANOTHER SPACE IN.
3854 JMP TXLF+1 /AND CONTINUE
3856 TXER, TAD KCR /TYPE A CRLF
3858 JMP I TXKS /AND EXIT
3860 TXRUB, TAD K0034A /PROCESS A RUBOUT - DELETE 1 CHAR.
3862 JMS I DHPX1 /MOVE POINTER BACK 1 HALF WORD
3863 LDH /IS THAT HALFWORD A TXMRK?
3866 JMP TXER /YES - KBD AREA HAS BEEN ALL RUBBED OUT
3867 TAD K0046 /NO - PUT A BLANKMARK IN THERE
3870 TXEN, JMS I DHPX1 /IGNORE INPUT - MOVE POINTER BACK
3871 JMP I TXKS /AND EXIT
3882 /REFERENCE TO USER'S AREA - ROUTINE TO CHECK CTRLS MUST BE THERE
3891 /BASIC SUBROUTINES SHFT, DADD, AND BRAN [SU63AB]
3893 /SUBROUTINE TO SHIFT DOUBLE PRECISION WORD (SHFR): SHFT (10+6N)
3894 /CALL: TAD KXXXX /AC HOLDS SHFT COUNT, RIGHT IS NEGATIVE
3896 / RETURN /LINK=0, AC=0
3897 /FORMAT OF DOUBLE WORD IS (HI,LO) HI(0)-ONLY-HOLDS SIGN
3898 /SIGN BIT WILL BE REPLICATED IN RIGHT SHIFTS
3900 /TEMPORARY STORAGE ALLOCATION
3903 /ARITHMETIC REGISTER ALLOCATION
3904 SHFR=ARITH1 /ARITH1-2 ARE FOR SHIFTING
3908 SNA /IF SHIFT COUNT=0. EXIT
3910 SMA /SHIFT RIGHT OR LEFT
3911 CML CMA IAC /LEFT-SET LINK=1 AND COUNT NEGATIVE
3914 JMP SHLEFT /NO-SHIFT LEFT
3916 SHRIHT, TAD SHFR /SHIFT DONE ON ARITH1-2
3917 SPA /SET L=1 IF NEGATIVE
3920 DCA SHFR /SHIFT WITH SIGN REPLICATION
3921 TAD SHFR+1 /SHIFT LO ORDER HALF
3925 ISZ SHCNT /ENOUGH SHIFTS?
3926 JMP SHRIHT /NO-CONTINUE
3927 JMP I SHFTS /YES-EXIT
3929 SHLEFT, TAD SHFR+1 /SHIFT LO-ORDER
3932 TAD SHFR /SHIFT HI-ORDER
3937 JMP SHLEFT /NO-CONTINUE
3940 \f/SUBROUTINE FOR BRANCHING ON MATCH OF AC AGAINST TABLE: BRAN
3943 / RETURN HERE IF FIRST ENTRY MEETS MATCH
3950 /TEMPORARY STORAGE ALLOCATION
3955 TAD I BRANS /GET ADDRESS OF FIRST ENTRY OF MATCH LIST
3957 BRLOOP, TAD I BPNT /LOOK AT ENTRY
3960 ISZ BRANS /INDEX RETURN ADDRESS
3961 TAD BSAVE /MATCH FOUND?
3963 JMP I BRANS /YES-EXIT TO RETURN AS CALCULATED
3964 TAD I BPNT /NO-TEST FOR LAST ENTRY.
3965 ISZ BPNT /INDEX ENTRY POINTER
3966 SMA CLA /-INDICATES THIS WAS LAST ENTRY
3967 JMP BRLOOP /NOT LAST-CONTINUE
3968 ISZ BRANS /EXIT, NOT IN LIST, NONE MATCH
3971 /SUBROUTINE TO DO DOUBLE PRECISION ADD OF ARITH1-2, AND 4-5: DADD (21)
3972 /ARITHMETIC REGISTER ALLOCATION
3975 DADDS, 0 /ADD LO-ORDER
3981 TAD DBLAC /ADD HI-ORDER
3983 DCA DBLARG /LEAVE IN ARITH4-5.
3987 /FLOATING CONSTANT USED BY [SU54A]
3988 K100MF, 0033 /100,000,000(10)
3994 /2-PAGE FLOATING POINT PACKAGE [SU64AC] - REQUIRES [SU63A]
3995 /LOAD, SAVE, DCOM, NORM, FMUL, FIX, DFIX, FADD, FDIV, FLOAT
3996 /FLOATING POINT FORMAT
3997 / WORD1: EXPONENT (2'S COMPLEMENT)
3998 / WORD2: HI ORDER MANTISSA
3999 / WORD3: LO ORDER MANTISSA
4001 /MANTISSA IS REPRESENTED IN 24 BIT, 2'S COMPLEMENT NOTATION
4002 /A FLOATING POINT IS STORED AS MANTISSA*2^ EXPONENT
4003 /ZERO IS ALWAYS STORED AS 0*2^0
4004 /0.5 .LE. .ABS. MANTISSA .LT. 1.0
4006 /FLOATING POINT ACCUMULATOR
4008 /FLOATING POINT OPERATOR
4011 /SUBROUTINE TO LOAD FLOATING ACCUMULATOR: LOAD
4012 /TEMPORARY STORAGE ALLOCATION
4016 CLL CML CLA CMA /CALL: LOAD
4017 TAD I LOADS / ADDRESS
4018 DCA LDPNT /GETS ADDRESS, ADDRESS+1, ADDRESS+2 TO FAC
4020 TAD I LDPNT /ORDER IN MEMORY IS ASSUMED TO BE:
4029 /SUBROUTINE TO SAVE FLOATING ACCUMULATOR: SAVE
4030 /TEMPORARY STORAGE ALLOCATION
4034 CLL CML CLA CMA /CALL: SAVE
4035 TAD I SAVES / ADDRESS
4037 ISZ SAVES /SAVES FAC IN ADDRESS, ADDRESS+1, ADDRESS+2
4038 TAD FAC /ORDER: WORD1
4040 TAD FAC+1 /ORDER: WORD2
4042 TAD FAC+2 /ORDER: WORD3
4045 \f/SUBROUTINE TO FORM NEGATIVE OF ARITH1-2: DCOM
4050 DCA ARITH2 /-ARITH2 TO ARITH2
4051 TAD ARITH1 /CARRY IS IN LINK BIT
4058 /SUBROUTINE TO NORMALIZE MANTISSA IN FAC: NORM
4059 /MODIFIES ARITH 1-2 (NORHI,NORLO), TEMP01(IN SHFT), TEMP02(NORCNT)
4060 /LEAVES FAC MANTISSA NORMALIZED,
4061 /SIGN OF MANTISSA IN LINK BIT, EXPONENT IN AC
4062 /TEMPORARY STORAGE ALLOCATION
4065 /ARITHMETIC REGISTER ALLOCATION
4075 SMA SNL /TEST FOR L,AC0
4076 JMP NORSH /0,0 - SHIFT IT
4078 SPA SZL CLA /TEST FOR 1,1
4079 JMP NOREX /0,1 OR 1,0 - DONE
4080 TAD NORHI /1,1 - TEST FOR 6000
4083 JMP NORSH /NO - CONTINUE
4084 TAD NORLO /YES - TEST FOR 6000 0000
4086 JMP NOREX /YES AND L HOLD 1 FOR -
4089 ISZ NORCNT /23 TIMES?
4090 JMP NORLV /NO - LOOK AGAIN
4091 NOREX, CML /23 SHIFTS IS ENOUGH - OR DONE
4093 CMA IAC /L GETS COMPLEMENTED IF=0, NORM OF 0 LEAVES 0 IN L.
4098 \f/SUBROUTINE FOR FLOATING POINT MULTIPLICATION: FMUL
4099 /CALL: FMUL /ONE ARGUMENT
4100 / ARG ADDRESS /ARG IS THE OTHER
4101 / (RETURN) /AC=0, L UNSPECIFIED
4102 /MODIFIES ARITH0-5(FAC,FOP), TEMP01-12
4103 /USES SUBROUTINES NORM,SHFT,DADD,DCOM,SAVE,LOAD
4104 /LEAVES RESULT IN FAC
4105 /TEMPORARY STORAGE ALLOCATION
4106 FMULP=TEMP10 /11 AND 12
4110 JMS I GARGX /GET ARG AND FAC MAGNITUDE, SET SIGN
4111 ISZ FMULS /FIX UP RETURN ADDRESS
4114 DCA FOP+1 /CLEAR PRODUCT ACCUMULATION
4116 MULOOP, LOAD /SHIFT MULTIPLIER TO TEST
4117 FMULP /WHETHER TO INCREASE PRODUCT
4118 IAC /(FIRST TIME THRU IS ZERO SO WE
4122 LOAD /DECREASE POSSIBLE PRODUCT
4123 FARG /INCREMENT BY A FACTOR OF 2
4128 TAD FMULP+1 /BIT 0 IS FLAG FOR INCREASING
4129 SPA CLA /PRODUCT ACCUMULATION
4130 DADD /BY CURRENT INCREMENT
4131 ISZ FCNTR /DO THIS 23 TIMES
4133 LOAD /NORMALIZE RESULT MANTISSA
4135 JMS NORMS /ADJUST EXPONENT
4137 JMP FMEXP /MANTISSA WAS ZERO
4143 TAD FLSIGN /FIX SIGN OF RESULT
4150 \f/THIS SUBROUTINE FIXES FAC TO AC: FIX
4152 TAD FAC /AC BIASES FIX
4153 SPA SNA /FIX OF FAC .LT. 1 GIVES 0 IN AC
4156 SMA /FIX OF .ABS. FAC .GE. 2^11; EXITS 0 IN AC
4169 /SUBROUTINE TO FIX FAC TO DBL PREC IN FAC+1 AND FAC+2
4173 TAD FAC /AC BIASES FIX
4176 TAD I DFIXS /CALL+1 HOLDS ADDRESS OF HI ORDER FIX
4179 TAD FAC+1 /STORE AT C(CALL+1) AND C(CALL+1)+1
4184 JMP I DFIXS /EXIT TO CALL+2
4186 /PAGE 2 OF 2 PAGE FLOATING POINT PACKAGE [SU64A]
4189 /SUBROUTINE TO FLOATING ADD TO FAC: FADD
4192 /MODIFIES ARITH 0-5 (FAC,FOP), TEMP01(FADSHF),TEMP02-04(ADDEND),
4194 /USES SUBROUTINES: NORM, SHFT, DADD, SAVE, LOAD
4195 /RESULT IN FAC (RE-NORMALIZED),AC=0,L=U
4197 /TEMPORARY STORAGE ALLOCATION:
4199 ADDEND=TEMP02 /03 AND 04
4200 AUGEND=TEMP05 /06 AND 07
4202 /ARITHMETIC REGISTER ALLOCATION
4207 SHFT /PREPARE FOR POSSIBLE DADD OVERFLOW
4208 SAVE /LOSES LSB OF MANTISSA
4210 TAD I FADDS /GET ARGUMENT ADDRESS
4212 LOAD /ARGUMENT TO FAC
4214 CLA CMA /SHIFT FOR POSSIBLE OVERFLOW ALSO
4216 SAVE /SUM HAS 23 BITS PRECISION
4218 ISZ FADDS /SETUP FOR EXIT
4219 TAD ADDEND /COMPARE EXPONENTS
4220 CMA IAC /WHICH TO SHIFT (SMALLER ARGUMENT)
4221 TAD AUGEND /TO ALIGN BINARY POINTS
4222 SPA /EXP DIFFERENCE IN AC
4223 JMP FADADD /EXP OF AUGEND SMALLER
4224 CMA IAC /MAKE DIFFERENCE NEGATIVE
4225 DCA FADSHF /TO SHIFT RIGHT
4226 LOAD /AUGEND (OLD FAC) IS LARGER
4230 LOAD /PREPARE TO SHIFT ADDEND
4233 \fFADADD, DCA FADSHF /AUGEND (OLD FAC) IS SMALLER
4236 SAVE /SAVE ADDEND AS LARGER ARGUMENT
4238 LOAD /PREPARE TO SHIFT SMALLER ARG
4242 SHFT /ALIGN ARGUMENTS
4244 LOAD /NORMALIZE RESULT
4247 SNA /0 IF MANISSAS ADDED TO 0
4248 JMP FADEXP /ZERO SHOWN AS 0*2^0
4250 TAD BIGGER /ADD +1 TO -21(10) TO LARGER EXP
4251 FADEXP, DCA FAC /SAVE AS NEW EXPONENT
4257 /SUBROUTINE TO INITIALIZE COUNTERS AND SWITCHES USED IN FMUL AND FDIV
4260 FARG=TEMP05 /06 AND 07
4263 DCA LOCARG /AC HOLDS LOCATION OF ARGUMENT
4265 SMA CLA /SET FLSIGN WITH SIGN OF FAC
4268 ISZ FLSIGN /LEAVE FLSIGN=0 FOR +, 1 FOR -
4276 TAD FAC+1 /GET SIGN OF ARGUMENT
4279 TAD FLSIGN /+OP+=+, -OP-=+, +OP-=-, -OP+=-
4280 DCA FLSIGN /FLSIGN = 0 FOR +, .NE. 0 FOR -
4281 TAD FAC+1 /GET .ABS. ARG
4283 DCOM /.LT. 0: GET COMPLEMENT AND SET L=0
4287 \f/THIS SUBROUTINE FLOATS AC TO FAC: FLOAT
4290 TAD KM014 /SHIFT TO GET SIGN EXTENSION
4299 /SUBROUTINE TO FLOATING DIVIDE FAC BY ARGUMENT- FDIV
4301 / ARG ADDRESS /ARG ADDRESS HOLD ARGUMENT
4302 / (RETURN) /AC=0, L UNSPECIFIED
4303 /MODIFIES ARITH0-5 (FAC,FOP), TEMP01-14, REMAINDER IN FOP
4304 /TEMPORARY STORAGE ALLOCATION
4305 DVSOR=TEMP10 /11 AND 12
4306 QUO=TEMP05 /06 AND 07
4309 TAD I FDIVS /GET ADDRESS OF ARGUMENT
4310 ISZ FDIVS /EXIT TO CALL+2
4311 JMS GARG /GET .ABS. FAC, .ABS. ARG, SIGN OF RESULT
4313 SAVE /ARG IS DIVISOR
4315 LOAD /.ABS. FAC: DIVIDEND
4319 DCA FAC+1 /FAC WILL HOLD QUOTIENT
4326 DVSOR /TRIAL SUBTRACTION
4328 TAD FOP+1 /CHECK FOR - AS RESULT OF TRIAL
4330 JMP DVOK /POSITIVE, INCREASE QUOTIENT
4331 DCOM /NEGATIVE, REVERSE
4334 SKP /BUT DON'T INCREASE QUOTIENT
4335 \fDVOK, ISZ QUO+2 /MARK QUOTIENT
4336 CLA CMA /NEXT TIME REDUCE DIMINISHER
4340 LOAD /MAKE READY TO MULTIPLY QUOTIENT
4342 ISZ FCNTR /DO THIS 23 TIMES
4343 JMP DVLOOP /CONTINUE
4344 NORM /NORMALIZE MANTISSA
4346 JMP DVEXP /0 MANTISSA IMPLIES ZERO - EXIT IMMEDIATELY
4347 TAD FOP /ADJUST EXPONENT
4353 TAD FLSIGN /ADJUST SIGN
4354 SZA CLA /FLSIGN=0 FOR POSITIVE QUOTIENT
4360 /SUBROUTINE TO TYPE AND OUTPUT A MESSAGE UNTIL A TXMRK
4362 TAD I TXPUNS /GET MESSAGE ADDRESS
4365 SETH /SET HALFWD POINTERS
4367 JMS DBLPUN /TYPE AND PUNCH
4370 /SUBROUTINE TO TYPE AND OUTPUT A MESSAGE BETWEEN TXMRKS
4372 TAD TXMRK /MOVE TO MESSAGE
4374 JMP I TPUNQS /NO MESSAGE - EXIT
4375 JMS DBLPUN /TYPE & PUNCH UNTIL TXMRK
4378 /PUNCH AND TYPE UNTIL A TXMRK OR END OF RECORD
4380 TAD K0377 /PRECEED MESSAGE WITH RUBOUT
4382 DBLNXT, JMS PCOPYS /PUNCH FOR HI, NOP FOR LO SPEED PUNCH
4388 TAD BSAVE /OTHER - TYPE IT
4390 JMP DBLNXT /PUNCH THIS AND GET NEXT
4391 DBLEXT, TAD K0377 /E.O.R. OR TXMRK
4392 JMS I PUNCHX /BRACKET MESSAGE WITH RUBOUTS
4395 DBLCR, TAD K0215 /PUNCH CR
4399 JMP DBLTYP /AND THEN PUNCH LF
4401 /SUBROTINE TO PUNCH ON PC8I WHAT WAS TYPED OR NOP IF NO PC8I
4404 SPA CLA /+ FOR PC8I, - FOR ASR33
4405 JMP I PCOPYS /-, EXIT IMMEDIATELY
4406 TAD BSAVE /IS IT A LEGIT ASCII CODE?
4409 JMP I PCOPYS /NO - EXIT IMMEDIATELY
4410 TAD BSAVE /OK - PUNCH IT
4414 \f/SUBROUTINE TO PUNCH LEADER-TRAILER
4417 DCA TLTCNT /# OF 200 CODES TO PUNCH
4438 /OUTPUT REST OF TEXT AND PUNCH PARAMETER TAPE
4439 CON34, JMS TXPUNS /"<CRLF> SYNC ON CHANNEL: "-
4441 JMS DBLPUN /"<CRLF>SYNC ON CHANNEL:S#"
4442 JMS DBLPUN /"<CRLF>SYNC ON CHANNEL:S#<CRLF>"
4446 JMS TXPUNS /"#### SWEEPS AT"
4448 SETH /"#### SWEEPS AT ######"
4451 JMS TPUNQS /"#### SWEEPS AT ######*"
4452 JMS TXPUNS /"#### SWEEPS AT ######*S'<CRLF>"
4454 TAD XROPT /IS THERE A SORT?
4456 JMP CON34A /NO-SKIP AHEAD
4457 JMS TXPUNS /"SORT AT"
4459 JMS DBLPUN /"SORT AT ###### *S<CRLF>"
4463 \fCON34A, JMS TXPUNS /"(V**,#,####-####)<CRLF>"
4465 TAD LNBUFB /WAS THE B-SWEEP USED?
4467 DCA KBTOA /NO, DISABLE IT
4470 FASI /LOAD-A SWEEP SAMPLING RATE
4471 JMP INTO /JUMP TO TRIAL SUBTRACT
4475 TEN /REDUCE SAMPLING RATE BY TEN
4476 INTO, SAVE /SAVE RESULT
4477 TEMP /AND DO A TRIAL SUBTRACT
4480 ISZ RATE /RECORD THE SUBTRACT
4483 JMP SIZE /DO IT AGAIN
4485 DFIX /NOW FIX THE REMAINDER
4486 15 /AND FIX THE RATE FOR THE CLOCK
4488 BSW /1 GOES TO 100, 2 GOES TO 200, ETC.
4489 CMA /COMPLEMENT OF THESE THREE BITS IS THE RATE MODE
4493 JMS LTPUNS /PUNCH OUT 200 CODE
4494 TAD K16 /OUTPUT PARAMETERS (BIN)
4496 TAD ENPARA /OUTPUT FROM ADPARA TO END OF PARAMETERS
4498 TAD ADJLIS /OUTPUT LISTS (BIN)
4501 TAD ADBUFA /OUTPUT FROM ADJLIS TO ADBUFA
4505 CON34B, TAD ADJLIS /PUNCH OUT DATA BLOCK LINKAGES
4506 DCA AXPNTR /SET UP TO LOOK AT JOB LIST
4507 TAD MEMTOT /SET AVAILABLE FIELD COUNT
4509 DCA TFIELD /-# OF FIELDS IN CONFIGURATION
4511 TAD KHICOR /FIELD 0 MAX ALLOWABLE ADDR.
4518 \fCON35, TAD I AXPNTR /GET J1
4520 JMP CON37 /J1=0 FOR E.O.L.
4521 DCA LINST1 /SET LINK FLAG 0.
4523 TAD I AXPNTR /J3 HOLDS # OF CELLS/POINT
4529 TAD AXPNTR /ADDRESS OF LINKAGE (AXPNTR=J3)
4530 JMS I BINAY /PUNCH IT
4531 TAD I AXPNTR /GET # OF POINTS REQUIRED (J4)
4534 TAD K0003 /SKIP J5, J6, AND J7
4537 TWO /FIRST BLOCK HAS 1 LOCATION FOR SWEEP COUNT
4540 TAD K0003 /3 LOCATIONS FOR LINKAGES
4541 TAD TCURAD /CURRENT FREE ADDRESS
4543 TAD TMAXPG /COMPARE AGAINST MAX ALLOWABLE FOR FIELD
4546 NORM /# OF LOCATIONS AVAILABLE
4548 FDIV /LOCATIONS/LOC PER POINT
4551 DCA TSAM /#POINTS AVAIL FOR THIS BLOCK
4554 CON36, TAD TSAM /POINTS AVAILABLE
4555 TAD TPOINT /POINTS REQUIRED
4556 SMA /DECREASE POINTS REQ BY POINTS AVAIL
4557 CLA /UNLESS MORE ARE AVAIL THAN ARE REQ
4558 DCA TREQ /-POINTS REQ AFTER THIS BLOCK
4562 TAD TPOINT /+POINTS REQUIRED BEFORE THIS BLOCK
4563 DCA TBLK /POINTS IN THIS BLOCK.
4565 TAD TREQ /UPDATE POINTS REQUIRED
4567 TAD TBLK /LINK 1:-POINTS IN BLK (NEXT)
4568 JMS LINSTX /STORE LOC IN FIELD 1
4569 /*******OLD WAS JMS I BINDY
4570 TAD TFIELD /-# OF FIELDS LEFT
4571 TAD MEMTOT /+# OF FIELDS IN MACHINE -1
4572 IAC /+1: CURRENT FIELD
4573 CLL RTL /MAKE A CDF N INSTRUCTION
4575 TAD K6201 /LINK2: CDF N
4580 JMS LINSTX /******WAS JMS I BINDY
4581 TAD TCURAD /L3: NEXT BLOCK STARTS AT ...-1
4582 JMS LINSTX /***** WAS JMS I BINDY
4583 TAD TBLK /-POINTS IN BLOCK
4585 SNA /ANY POINTS IN BLOCK BEING LINKED TO?
4586 JMP CON35 /NO-GET NEXT JOB
4587 FLOAT /YES - GET BLOCK LENGTH
4588 FMUL /#CELLS IN BLK = PTS * CELLS/PNT
4595 TAD TCURAD /CURRENT ADDR+BLK LENGTH
4596 DCA TCURAD /GETS NEW CURADDR.(NEXT BLOCK START -1)
4597 ISZ LINST1 /SET FLAG TO STORE CORE LINKS.
4598 TAD NXTCDF /PUNCH LINKAGE WORDS
4600 TAD TCURAD /AND ADDRESS
4601 TAD INITOS /ADJUST FOR FIRST BLOCK LENGTH
4603 TAD K0003 /MOVE OVER L1,L2,L3
4608 TAD TPOINT /IF POINTS STILL REQ .NE. 0, NEW FIELD
4609 SNA CLA /IF .EQ. 0, PUT END-OF-BLOCK
4610 JMP CON36 /PUT E.O.B.
4611 CLA CMA /NEW FIELD, START AT 0000
4614 DCA TMAXPG /ALL BUT FIELD 0 HAVE 7600 CELLS
4615 IAC /TCURAD IS ADDR-1
4616 ISZ TFIELD /UPDATE FIELD COUNT
4617 JMP CON35A /BLOCK OUT NEXT FIELD
4618 \fCON37, TAD CHKSUM /FINISH OUTPUT DEVICE.
4620 JMS I LTPUNX /PUNCH CHECKSUM AND LEADER TRAILER.
4623 SZA CLA /PUNCHED CONTROL TAPE?
4624 JMP I PCONTX /YES WRITE CONTROL TAPE TO M.S.
4625 JMP I .+1 /STORE LINKS IN CORE AND DO TRIG.
4628 /SUBROUTINE INITIALIZES PC8I OR ASR33
4636 JMS I LINKSX /SAVE LINKS IN FIELD 1.
4668 \f/OUTPUTS BINARY GROUP STARTING AT BINA ADDRESS
4669 /AC HOLDS END ADDRESS FOR OUTPUT
4671 CMA /-(END ADDRESS+1)
4672 TAD SHFR /+ BEGIN ADDRESS
4673 DCA BINCNT /IS # OF LOCATIONS TO OUTPUT
4675 CMA /SET POINTER TO BEGIN ADDRESS
4679 JMS BINFS /SET DATA FIELD TO 0
4680 TAD I AXPNTR /GET DATA
4686 /SUBROUTINE TO PUNCH CHARACTER (8-BIT)
4688 DCA TCHAR /AC HOLDS 8BIT
4690 TAD TENPUN /=1 IF PUNCHING
4691 CLA /**** CONTROL TAPES NOT PUNCHED.
4692 JMP I PUNCHS /NO - EXIT
4693 LAS /LOOK AT SWITCHES
4694 SMA CLA /SR0=0 FOR HI SPEED
4695 JMP PUNCHI /HI SPEED
4696 PUNLO, TAD TCHAR /LO SPEED - GET CHARACTER
4700 TCF /LEAVE WITH CLEARED FLAG
4703 PUNCHI, TAD TCHAR /HI - GET CHARACTER
4705 LAS /IF SR WAS SET INCORRECTLY
4706 SPA CLA /ALLOW USER TO RECOVER
4707 JMP PUNLO /PUNCH THIS ON LO
4708 PSF /PUNCH THIS ON HI
4712 \f/SUBROUTINE CONVERTS AC TO TWO DATA FRAMES
4714 DCA SHFR+1 /DATA TO BE PUNCHED
4715 TAD TENPUN /PUNCH ENABLED?
4717 CLA /***** CONTROL TAPES NOT PUNCHED
4718 /****** THEY ARE WRITTEN ON MASS STORAGE.
4719 TAD SHFR+1 /NO - STORE IN MEMORY
4720 BINMX, CDF /SET BY BINFS
4721 DCA I BPNTR /BPNTR SET UP BY BINAS
4723 BINDO, JMS SHFT6 /GET HI ORDER 6 BITS
4724 JMS PUNWDS /PUNCH THEN GET NEXT 6 BITS AND PUNCH
4727 /SUBROUTINE CONVERTS AC TO TWO ADDRESS FRAMES
4730 CLA CMA /SET POINTER FOR STORING IN CORE (IF TENPUN=0)
4734 JMS SHFT6 /GET HI ORDER 6 BITS
4735 TAD K0100A /SIGNIFIES ADDRESS WORD TO BIN LOADER
4736 JMS PUNWDS /PUNCH THEN GET NEXT 6 BITS AND PUNCH
4739 /SUBROUTINE TO PUNCH TWO HALVES OF WORD
4741 JMS UPCHKS /UPDATE CHECKSUM WITH 6 BITS IN AC
4743 JMS SHFT6 /GET NEXT 6 BITS
4744 JMS UPCHKS /UPDATE CHECKSUM
4745 JMS PUNCHS /PUNCH IT OUT
4748 /SUBROUTINE SHIFTS FAC 6 PLACES AND PUTS OUT 6 RIGHT OF FAC+1
4750 TAD K0006A /SHIFT 6 PLACES LEFT
4752 TAD SHFR /GET RESULT
4753 AND K0077B /MASK OFF
4756 /SUBROUTINE CONVERTS AC 9-11 TO FIELDATA
4758 DCA BINMX /SET UP CDF N INSTRUCTION IF STORING IN CORE
4761 TAD K0300 /MAKE A FIELD WORD FOR BIN LOADER
4762 JMS PUNCHS /PUNCH IT
4764 \f/SUBROUTINE TO UPDATE CHECKSUM
4767 TAD CHKSUM /ADD TO CHECKSUM
4769 DCA CHKSUM /NEW CHECKSUM
4781 /COME TO 7540 TO CHECK FOR CTRL CHARACTERS
4782 /THIS VERSION IS FOR PC8I OR ASR 33
4788 TAD BSAVE /NOT ^Z, OR ^C
4791 /LIST OF CTRL CHARACTERS
4796 CTRLC, MONITR /7777 IF PAPER TAPE, 7600 FOR DSK OR DTA
4801 /WRITE OUT CONTROL FILE.
4804 CLA IAC /0-1777 OF FIELD 1 NEED NOT BE SAVED.
4808 5 /CALL COMMAND DECODER.
4813 SNA /TEST FOR NO OUTPUT FILE.
4818 ANS1, 7201 /ENTRY POINT.
4824 ANS2, 7601 /RETURN BLOCK START.
4825 ANS3, 0 /- BLOCK LENGTH RETURNED.
4828 CDF 0 /LOOK JOB LIST AND CONTROL LIST
4841 TAD 10 /CALCULATE # OF 128 RECORDS.
4844 DCA ARG1 /LOAD WRITE ARG.
4857 JMS FILSZC /TEST IF OUTPUT FILE FULL.
4858 JMS FILBWT /WRITE FIELD 0 STUFF.
4860 TAD ANS2 /RETURN WITH # OF BLOCKS WRITTEN.
4861 DCA ARG3 /NEW START BLOCK.
4862 TAD (CORSTG /START OF LINKS IN FIELD 1.
4865 TAD (100 /CAL. # OF 128 RECORDS TO WRITE.
4892 JMS FILSZC /TEST IF OUTPUT FILE FULL.
4893 JMS FILBWT /WRITE FIELD 1 LINKS.
4894 TAD ARG3 /RETURN WITH # OF BLOCKS USED,
4896 TAD ANS2 /CALCULATE # OF BLOCKS USED.
4899 TAD I (7600 /CLOSE FILE.
4910 JMS I ANS1 /WRITE THE FILE.
4916 TAD ARG1 /CALCULATE # OF 256 BLOCKS.
4929 WDONE, CDF CIF 0 /RETURN TO OS-8.
4933 \fFILSZC, 0 /TESTS IF FILE FULL.
4934 TAD ARG1 /GET # OF 128 RECORDS,
4935 AND (3700 /AND CALCULATE # OF BLOCKS.
4942 TAD ANS3 /TEST IF SIZE OVERFLOW.
4952 JMS I (7700 /ERROR MESSAGE.
4957 /READ IN CONTROL FILE
4960 CDF 0 /SAVE LINKS FOR CHAIN.
4969 JMS I (7700 /CALL COMMAND DECODER
4975 SNA /TEST FOR NO INPUT FILE.
4977 JMS I (7700 /FETCH DEVICE HANDLER
4979 CONTP1, 7201 /ENTRY POINT.
4982 TAD (200 /SETUP TO READ FILE.
4986 JMS FILERD /READ 1ST BLOCK.
4988 DCA CONSA5 /# OF LOC TO SEARCH.
4990 CONTP5, JMS FILERD /READ NEXT BLOCK.
4992 TAD I CONSA4 /SEARCH FOR END OF JOB LIST AND
4993 /OTHER PAR. 3 RD 0 IS END.
4998 CONTP4, ISZ CONSA5 /FIND END OF BLOCK READ.
5001 CONTP3, ISZ CONSA6 /CHECK FOR 3RD 0.
5003 TAD (210 /FIELD 0 DATA IN.
5004 DCA CONP1 /READ FIELD 1 DATA.
5009 CONTP9, JMS FILERD /READ NEXT BLOCK.
5010 CONTP8, TAD I CONSA4 /0 MARKS THE END OF THE LINKS
5011 /5 LOC. PER LINK,CDF,ORG.,AND 3 LINK WORDS.
5012 /IF CDF IS 0 ITS THE END.
5022 CONTP7, CDF 0 /RESTOR LINKS FOR CHAIN.
5044 CONP2, 0 /SET TO READ TO LOC 0 ON 1ST READ.
5057 DCA LK1 /SAVE LINK VALUE TO SAVE.
5059 TAD I (LINST1 /TEST TO STORE LINKS.
5062 ISZ LK2 /PROGRAM IS ONE PASS,LK2 SET ON LOAD.
5063 JMP LK3 /NOT A NEW LINK.
5064 TAD I (BINMX /NEW LINK SAVE CDF,ORG.
5069 TAD I (BPNTR /ADDRESS,SAVE AS ADDRESS-1.
5074 DCA LK2 /STORE 3 VALUES OF LINK.
5079 DCA I LINSPT /SET 0 TO MARK END IF SO.
5080 /NOTE IF NO AVERAGES SPECIFIED,CAN'T
5085 LK4, TAD LK1 /RETURN WITH JOB LIST VALUE FOR BINDS.
5093 TRIGSU, CDF 10 /MOVE TRIG AND LINK STORE CODE TO FIELD 0
5099 TAD (-EXITXX+CORFIX-1
5112 /LINKS SAVED IN FIELD 1 AS CDF,ORG. AND 3 LINK VALUES.
5114 CORFIX, CDF 0 /SAVE LINKS IN CORE.
5121 TAD I 10 /GET 5 WORDS OF LINKS.
5123 JMP CORFX6 /0 NO MORE LINKS.
5124 DCA CORFXX /SAVE CDF VALUE.
5126 TAD ZM6211 /IF CDF 10,SAVE IN FIELD 0.
5129 JMS CORFXS /STORE LINKS.
5131 CORFX4, TAD ZZM4 /SAVE FIELD 1 LINK IN FIELD 0.
5133 CDF 0 /SAVE AS 1,ORG,3 LINK VALUES.
5140 ISZ 14 /STORE ORG AND 3 LINKS.
5142 DCA I 13 /SET NEXT WORD 0 TO MARK END.
5147 CORFX6, TAD ZZ6777 /OTHER FIELDS DONE,
5148 DCA 10 /STORE FIELD 1 LINKS.
5154 TAD I 10 /GET 5 WORD LINK SET.
5156 JMP I (6600 /DONE GO TO TRIGGER.
5162 TAD I 10 /STORAGE ADD. IS LOC-1 FOR AUTO INDEX.
5166 CORFX2, JMS CORFRS /SET CDF WHERE TO FETCH LINK.
5168 JMS CORFXZ /SET CDF WHERE TO STORE LINK.
5170 ISZ 12 /STORE 3 LINKS.
5190 /THIS SECTION CALIBRATES A SCHMITT TRIGGER BY WIATING
5191 /FOR THE SPECIFIED TRIGGER TO FIRE AND THEN TAKING A
5192 /SWEEP OF ANALOG CHANNEL 0.
5198 SNA /IS THIS THE END OF LIST?
5205 DONE, TAD KMODE /NOW SET UP CLOCK
5215 AND SMASK /IS IT THE PROPER SYNC?
5261 EXITXX, 7600 /SHOULD BE LAST THING ON PAGE.
projects / pdp8.git / blob