File AAVG1.

Directory of image this file is from
This file as a plain text file

/LAB8E ADVANCED AVERAGER MS-SIGNAL AVERAGER SECTION 1,
/PARAMETER SETUP AND TRIGGER.
/
/DEC-8E-AAA1A-A-LA
/
/COPYRIGHT 1972
/DIGITAL EQUIPMENT CORPORATION
/MAYNARD, MASSACHUSETTS 01754
/

/AD1.5 /THE ADVANCED AVERAGER MS FOR OS-8 WILL AVERAGE DATA /TAKEN FROM THE A/D , DISPLAY IT, AND WRITE IT TO /MASS STORAGE IF DESIRED. /SECTION I OF THE LAB8/E ADVANCED AVERAGER . /FOR DSK/DTA SYSTEMS. /ADVANCED AVG. TO RUN UNDER PS8. *7557 OVRLAY, IOF CLA CLL CMA CLZE /DISABLE CLOCK CLA ADCL /AD DILC /DISPLAY DBDI /I/O CDF 0 /CHAIN IN SEC.2 DCA I KC7746 /0 PS8 JOB STATUS WORD. CIF 10 JMS I CHAIN 6 XX0V1, 0 CHAIN, 7700 KC7746, 7746 MONITR=7600 CLZE=6130 ADCL=6530 DILC=6050 DBEI=6501
/MEMORY BOUNDS FOR FIELD 0 LOCORE=230 /LISTS, BUFERS, DATA BLOCKS START HERE HICORE=6300 /PROTECTED AREA BEGINS HERE NXLOAD=7000 /NEXT SECTION LOADING BEGINS HERE /AVERAGING PARAMETERS: LOCATIONS 20-64 MEMTOT=20 /FIELDS IN THIS MACHINE FIELD0=21 /ROOM FOR DATA IN FIELD 0 /DIGITAL I/O OPTION, CONTINGENCY AND # OF SYNC INPUTS XROPT=22 /0 IF I/O NOT IMPLEMENTED, 1 IF IT IS /LIST ADDRESSES ADJLIS=23 /START OF JOB LIST-1 ADCHNL=24 /START OF CHANNNEL DISPLAY LIST-1 /JOINT SWEEP PARAMETERS - 29 LOCATIONS SMASK=25 /STIMULUS (SYNC) CHANNEL MASK NSWEP=26 /-# OF SWEEPS IN AVERAGE KSYTIM=27 /-(# OF ASI FROM STIM TO SYNC POINT -1) KITIM=31 /-(# OF ASI FROM S0 TO S0) KCTIM=33 /-(# OF ASI FROM STIM TO CONTINGENCY READING) KWTIM=35 /(-# OF ASI FROM LAST STIM TO A/B OPENING) ASI=37 /# OF USEC PER ASI S0=41 /TEMPORARY TIMER K0017=42 KMODE=43 /CONTAINS CLOCK RATE AND MODE /SWEEP A LIST PARAMETERS SAMA=44 /-# OF POINTS (ASI) IN SWEEP A (EACH CHANNEL) NCHA=45 /# OF CHAN IN SWEEP A ADPNTA=46 /LOGICAL 1 OF ADC BUFFER A-1 (GEN BY ON-LINE) ADBUFA=47 /LOCATION -1 FOR START OF ADC BUFFER -A LNBUFA=50 /PHYSICAL LENGTH OF BUFFER -A EJECT /SWEEP B LIST PARAMETERS SAMB=51 /-# 0F POINTS (BSI) IN SWEEP B NCHB=52 /# 0F CHAN IN SWEEP B ADPNTB=53 /LOGICAL 1 OF ADC BUFFER-B - 1 ADBUFB=54 /LOCATION-1 FOR START OF BUFFER LNBUFB=55 /PHYSICAL LENGTH OF BUFFER-B /SWEEP A - ON-LINE PARAMETERS ADMPXA=56 /ADDRESS OF A SWEEP MPLX LIST -1 ADEL=57 /ADJUSTMENT AT SYNC POINT TO FIND LOGICAL 1 OF BUFFER-A KBLA=60 /-# OF ASI FROM SYNC POINT TO LOGICAL END OF A-1 /SWEEP B - ON LINE PARAMTERS KBTOA=61 /-# OF A'S TO B, 0 FOR NO B ADMPXB=62 /ADDRESS OF B MPLX LIST - 0 BDEL=63 /ADJUSTMENT AT SYNC POINT TO FIND LOGICAL 1 OF BUFFER-B KBLB=64 /-# OF BSI FROM SYNC POINT TO LOGICAL END OF B - 1 /INTERRUPT REFERENCES INTERX=65 /LINK TO INTERRUPT SERVICE ASAVE=66 /AC AT INTERRUPT LSAVE=67 /LINK AT INTERRUPT /LINKAGES TO SUBROUTINES IN CORE FOR THIS SECTION /MISC. SUBROUTINES FRAME=JMS I 76 /Q & A WITH SCOPE OCTARG=JMS I 77 /PICK UP OCTAL TYPEIN DFIX=JMS I 100 /DOUBLE PRECISION FIX /NUMERICAL I/O [SU56A] DECARG=JMS I 101 /PICK UP DECIMAL TYPEIN FLTARG=JMS I 102 /PICK UP FLOATING TYPEIN FLTOUT=JMS I 103 /FLOATING AC TO TYPE BUFFER (FLOATING FORMAT) OCTOUT=JMS I 104 /AC TO TYPE BUFFER (OCTAL FORMAT)
/FLOATING POINT ARITHMETIC [SU64A] FADD=JMS I 105 /FLOATING ADD FDIV=JMS I 106 /FLOATING DIVIDE FLOAT=JMS I 107 /FLOAT AC TO FAC FMUL=JMS I 110 /FLOATING MULTIPLY FIX=JMS I 111 /FIX FAC TO AC /BASIC SUBROUTINES [SU63A] BRAN=JMS I 132 /BRANCH ACCORDING TO AC MATCH WITH LIST SHFT=JMS I 133 /DOUBLE PRECISION ARITHMETIC SHIFT DADD=JMS I 134 /DOUBLE PRECISION ADD /HALFWORD SUBROUTINES [SU60A] SETH=JMS I 135 /SET HALFWORD POINTER TYPE=JMS I 136 /TYPE 6BIT IN AC LDH=JMS I 137 /LOAD HALFWORD INTO AC SRCH=JMS I 140 /SEARCH FOR HALFWORD THAT MATCHES AC6-11 ALPHA=JMS I 141 /GET FIRST CHARACTER OF A TYPE-IN /FLOATING POINT HANDLERS [SU64A] SAVE=JMS I 142 /SAVE FAC LOAD=JMS I 143 /LOAD FAC DCOM=JMS I 144 /DOUBLE PRECISION NEGATE NORM=JMS I 145 /NORMALIZE FAC /PAGE ZERO CONSTANTS K0004=112 K0003=113 K0002=114 KM0001=115 K0007=116 KM0027=117 K0377=120 KM0004=121 /TTY-LIST TTYLST=122 PROMRK=123 TXMRK=125 KCR=126 KM0043=127 /OCSORT OCSORT=130 K0040=130 MTXMRK=131
/TEMPORARY STORAGE REGISTERS 146-177 TEMP01=146 TEMP02=147 TEMP03=150 TEMP04=151 TEMP05=152 TEMP06=153 TEMP07=154 TEMP10=155 TEMP11=156 TEMP12=157 TEMP13=160 TEMP14=161 TEMP15=162 TEMP16=163 TEMP17=164 TEMP20=165 TEMP21=166 /TEMPORARY STORAGE AND MULTIPLE ACCUMULATORS ARITH0=167 TEMP22=167 ARITH1=170 TEMP23=170 ARITH2=171 TEMP24=171 ARITH3=172 TEMP25=172 ARITH4=173 TEMP26=173 ARITH5=174 TEMP27=174 /TEMPORARY STORAGE AND TTY-KBD BUFFERS KBDBUF=175 TEMP30=175 TTYBUF=176 TEMP31=176 TTYFLG=177 TEMP32=177 /FLOATING VARIABLES FLOT01=5772 FLOT02=5775 FLOT03=5347 FLOT04=5352 FLOT05=5355 FLOT06=5360 FLOT07=5363 FLOT10=5366
/IOT REFERENCES FOR THE LAB/8E / / /AD8-EA 10 BIT A/D CONVERTER / ADCL=6530 /CLEAR ALL ADLM=6531 /LOAD MPLXR ADST=6532 /START CONVERSION ADRB=6533 /READ AD BUFFER ADSK=6534 /SKIP ON AD DONE ADSE=6535 /SKIP ON TIMING ERROR ADLE=6536 /LOAD ENABLE REGISTER ADRS=6537 /READ STATUS REGISTER / /VC8-E POINT PLOT DISPLAY / DILC=6050 /CLEAR ALL DICD=6051 /CLEAR DONE FLAG DISD=6052 /SKIP ON DONE FLAG DILX=6053 /CLEAR DONE FLAG LOAD X DILY=6054 /CLEAR DONE FLAG LOAD Y DIXY=6055 /CLEAR DONE, INTENSIFY, SET DONE DILE=6056 /LOAD ENABLE CLEAR AC DIRE=6057 /ENABLE TO AC / /DK8-EP REAL TIME CLOCK / CLZE=6130 /ZERO TO ENABLE CLSK=6131 /SKP ON CLOCK FG CLOE=6132 /ONES TO ENABLE CLAB=6133 /AC TO CLK BUF AND COUNTER REGISTER CLEN=6134 /ENABLE TO AC CLSA=6135 /STATUS TO AC AND AC ONE'S CLEAR STATUS REG. CLBA=6136 /CLK BUF TO AC CLCA=6137 /CLK CNTR TO AC AND TO AC / /DB8-EA 12 CHANNEL DIGITAL I/O / DBDI=6500 /DISABLE INTERRUPT DBEI=6501 /ENABLE INTERRUPT DBSK=6502 /SKIP ON INPUT DBCI=6503 /CLEAR INPUT BITS WITH SET AC BIT DBRI=6504 /READ INPUT DBCO=6505 /CLEAR OUTPUT BITS WITH AC BITS DBSO=6506 /SET OUTPUT BITS WITH AC BITS DBRO=6507 /READ OUTPUT REGISTER /COMBINED OPERATES MTH=CLA CMA CLL RTL; MTW=CLA CMA CLL RAL TWO=CLA CLL CML RTL; TWOK=CLA CLL CML RTR /EXTENDED MEMORY CDF=6201; RDF=6214; RMF=6244
/PAGE ZERO FOR ADVANCED AVERAGER [U10ZC] *1 DCA ASAVE /INTERRUPT SERVICE DISPATCH RAR DCA LSAVE JMP I INTERX PG0OV, 0 0 0 /INSTALLATION PARAMETERS: LOCATIONS 20-64 / 0 /FIELDS IN THIS MACHINE: MEMTOT / HICORE-LOCORE-4 /ROOM FOR DATA IN FIELD 0: FIELD0 /XR-OPTION, CONTINGENCY AND # OF SYNC INPUTS / 0 /0 IF XR NOT IMPLEMENTED, 1 IF IT IS: XROPT /LIST ADDRESSES / LOCORE-1 /START OF LISTS. BUFFERS, DATA: ADJLIS / 0 /START OF CHANNEL DISPLAY WORDS: ADCHNL /JOINT SWEEP PARAMETERS - 29 LOCATIONS / 0 /STIMULUS (SYNC) CHANNEL MASK: SMASK / 0 /-# OF SWEEPS IN AVERAGE: NSWEP / 0 /-(# OF ASI FROM STIM TO SYNC POINT -1): KSYTIM / 0 /(DBL PRECISION) / 0 /-(# OF ASI FROM S0 TO S0): KITIM / 0 /(DBL) / 0 /-(# OF ASI FROM STIM TO CONTINGENCY READING): KCTIM / 0 /(DBL) / 0 /-(#OF ASI FROM LAST STIM TO A/B OPENING): KWTIM / 0 /(DBL) / 0 /# OF USEC PER ASI: ASI / 0 /(DBL) / 0 /S0 EJECT *41 K1001A, 7001 K0017, 17 / 0 /K0017 / 0 /KMODE /SWEEP A LIST PARAMETERS / 0 /-#OF POINTS (ASI) IN SWEEP A (EACH CHANNEL): SAMA / 0 /# OF CHAN IN SWEEP A: NCHA / 0 /LOGICAL 1 OF ADC BUFFERA - 1 (GEN BY ON-LINE): ADPNTA / 0 /LOCATION -1 FOR START OF A: ADBUFA / 0 /PHYSICAL LENGTH OF BUFFER A: LNBUFA /SWEEP B LIST PARAMETERS / 0 /-# OF POINTS (BSI) IN SWEEP B (EACH CHANNEL): SAMB / 0 /# OF CHAN IN SWEEP B: NCHB / 0 /LOGICAL 1 OF ADC-BUFFER-B-1 (GEN BV ONLINE): ADPNTB / 0 /LOCATION -1 FOR START OF ADC BUFFER B /SWEEP A - ON-LINE PARAMETERS / 0 /ADDRESS OF A SWEEP MPLX LIST -1 / 0 /-# OF LOCATIONS FROM SYNC POINT TO LOGICAL 1 OF A / 0 /-# OF ASI FROM SYNC POINT TO LOGICAL END OF A -1 /SWEEP B - ON LINE PARAMETERS / 0 /-# OF A'S TO B, 0 FOR NO B / 0 /ADDRESS OF B-SWEEP MPLX LIST -0 / 0 /-# OF LOCATIONS FROM SYNC POINT TO LOGICAL END OF B -1 / 0 /-# OF ASI FROM SYNC POINT TO LOGICAL 1 OF
*70 /LINKAGES TO SECTION 2 SUBROUTINES 7200 /PICKUP NEXT JOB FROM JOB LIST: JGET 7243 /MOVE THRU DATA BLOCK: BLKCNT 6474 /SET ADC POINTERS: SETPNT 6451 /MOVE THRU ADC BUFFERS: IXPNT 7121 /SET UP DISPLAY: SDIS DISPS /DISPLAY A POINT: DISP /LINKAGES TO ALPHABETIC HANDLERS FRAMES /Q AND A WITH THE SCOPE: FRAMES OCTARS /PICK UP OCTAL TYPE-IN: OCTARG /LINKAGE TO DFIX DFIXS /DOUBLE PRECISION FIX: DFIX /LINKAGES TO NUMERICAL IO DECARS /PICK UP DECIMAL TYPE-IN: DECARG FLTARS /PICK UP FLOATING TYPE-IN: FLTARG FLTOUS /OUTPUT FAC TO TYPE BUFFER: FLTOUT OCTOUS /OUTPUT AC (OCTAL FORMAT) TO TYPE BUFFER: OCTOUT /FLTSUB USED BY FLTIO - DON'T RELOCATE FADDS /FLOATING ADD: FADD FDIVS /FLOATING DIVIDE: FDIV FLOATS /FLOAT AC TO FAC: FLOAT FMULS /FLOATING MULTIPLY: FMUL FIXS /FIX FAC TO AC: FIX /PAGE ZERO CONSTANTS - USED BY RESIDENT SUBROUTINES - DON'T RELOCATE 0004 /K0004 0003 /K0003 0002 /K0002 -001 /KM0001 +0007 /K0007 -0027 /KM0027 +0377 /K0377 -0004 /KM0004
/TTY-LIST 0 /@-END OF LIST 42 /"-PROGRAM OUTPUT MARKER: PROMRK 44 /$-DISPLAY RESET 47 /'-KEYBORAD INPUT MARKER: TXMRK 45 /CR-CARRIAGE RETURN: KCR -43 /LF-LINE FEED: KM0043 /OCSORT 40 /SPACE: K0040 -47 /': MTXMRK /LINKAGES TO BASIC SUBROUTINES BRANS /BRANCH ACCORDING TO FOLLOWING LIST: BRAN SHFTS /DOUBLE PRECISION ARITHMETIC SHIFT: SHFT DADDS /DOUBLE PRECISION ADD: DADD /LINKAGES TO HALFWORD SUBROUTINES SETHS /SET HALFWORD POINTER: SETH TYPES /TYPE 6BIT IN AC: TYPE LDHS /GET NEXT HALFWORD TO AC: LDH SRCHS /SEARCH FOR HALFWORD WATCH OF AC6-11: SRCH ALPHAS /PICK UP ALPHABETIC TYPE-IN: ALPHA /LINKAGES TO FLTSUB SUBROUTINES SAVES /SAVE FAC: SAVE LOADS /LOAD FAC: LOAD DCOMS /DOUBLE PRECISION NEGATE: DCOM NORMS /NORMALIZE FAC: NORM /TEMPORARY STORAGE REGISTERS FROM 146-177 *162 0 /SET 0 TO CONVERT WRONG DECIMAL /PLACE IN DISPLAY CON09B
*200 /SUBROUTINE FOR SECTION II TO DISPLAY POINT OF DATA: DISP DISPS, 0 TAD YSX /AC+(YS)=#PLACES TO SHIFT RIGHT CMA IAC SHFT /SCALE TAD ARITH4 /MOVE X TO NEW VALUE DILX /LOAD X CLA /AND CLEAR TAD YZX /BIAS TAD ARITH2 DILY /LOAD Y DISD /WAIT JMP .-1 DIXY /DISPLAY CLA /CLEAR TAD DELX /LOAD INCREMENT FOR X DCA ARITH1 TAD DELXY DCA ARITH2 /ADD TO PRESENT X DADD JMP I DISPS YSX, 0 YZX, 0 DELX, 0 DELXY, 0
*400 /OVERLAY LOOKUP FOR CAINING. /START AT START0 (400) FOR SECTION 1 /START AT START1 (403) TO RUN WITH CONTROL TAPES. START0, CDF 0 JMS LINKLK /CALL CHAIN LOOKUP. JMP START START1, CDF 0 JMS LINKLK CDF CIF 10 JMP I (CONTAP /READ IN CONTROL FILE. LINKLK, 0 CLL CLA TAD (2001 DCA 7746 /SET PS-8 JOB STATUS WORD. TAD (PG0OV DCA XXT3 TAD (NAMES DCA XXT2 TAD (-3 DCA XXT1 CDF 0 CIF 10 JMS I (7700 /LOCK IN USR. 10 CLA IAC /FIND BLOCK ADDRESS OF SECT. 2 CDF 0 CIF 10 JMS I (200 2 ARGA, NAME1 0 JMP ERRXX CLA CLL TAD ARGA /STORE BLOCK ADD.IN CHAIN COMMAND DCA XX0V1 /TO CALL SEC.2. ARGBS, CLA IAC /FIND BLOCK ADD.OF SEC.3,4, CDF 0 /AND WRITE OVERLAY. CIF 10 JMS I (200 2 ARGB, NAME2 0 JMP ERRXX CLA CLL TAD ARGB DCA I XXT3 /STORE AT LOCS. 5,6,7. TAD I XXT2 DCA ARGB ISZ XXT2 ISZ XXT3 ISZ XXT1 JMP ARGBS CDF 0 CIF 10 JMS I (200 /UNLOCK USR. 11 CLA CLL DCA 7746 /RESET JOB STATUS WORD. JMP I LINKLK ERRXX, CDF 0 CIF 10 JMS I (200 7 1 /USER ERROR 1 HLT XXT1, 0 XXT2, 0 XXT3, 0 NAME1, FILENAME AAVG2.SV NAME2, FILENAME AAVG3.SV NAME3, FILENAME AAVG4.SV NAME4, FILENAME AAVG5.SV NAMES, NAME3 NAME4 EJECT *600 /LAB-8 ADVANCED AVERAGER - SECTION 1 - MAIN: U11MC /ONCE ONLY CODE - INTIALIZATION START, CLL CLA DILC ADCL SETH /VERSION. CONFIGURATION MESSAGE DIS99 /"(VAP,#DF-1, CORE LIMITS)" DCA MEMTOT /FIND # OF FIELDS AVAILABLE TAD KMK /CDF N = CDF 0 DCA MKTEST MKLOOP, TAD MKTEST /CDF N+1 TAD KP10 DCA MKTEST MKTEST, CDF /CHANGE TO N+1 RDF /IF 4K - THIS IS A NOP DCA I TTYLST /PUTS DF# IN DF, 0000; FOR 4K, PUT 0 IN 0000 OF FIELD 0 TAD I TTYLST /GETS A 0 IF FIELD DOESN'T EXIST TAD KMK /GETS A CDF N+1 IF FIELD DOES EXIST CMA IAC TAD MKTEST ISZ MEMTOT /# OF FIELDS SNA CLA /IF AC=0, FIELD N+1 EXISTS JMP MKLOOP /LOOK AT NEXT FIELD EJECT KMK, CDF 0 /NO MORE FIELDS CLA CMA TAD MEMTOT /# OF FIELDS -1 DCA MEMTOT TAD MEMTOT /PUT #DF-1 IN CONFIGURATION MESSAGE OCTOUT TAD KJLIST /START OF JOB LIST -1 DCA ADJLIST TAD KFIELD /LENGTH OF AVAILABLE FIELD 0 DCA FIELD0 IAC /OUTPUT LOW CORE LIMIT TAD ADJLIS OCTOUT TAD ADJLIS /OUTPUT HIGH CORE LIMIT TAD FIELD0 /START OF FIELD0 + LENGTH OF FIELD 0 TAD K0004 /+4 FOR END OF LIST MARKERS OCTOUT PRES00, FRAME /"LAB-8 IS READY DIS00 /HIT RETURN TO PROCEED" JMP PRES00
PRES01, FRAME /DIGITAL I/O?'-'[Y OR N] DIS00B /(Y FOR YES, N FOR NO)" JMP PRES00 /LINE FEED - ASK PREVIOUS QUESTION ALPHA /C.R. - GET ANSWER BRAN /BRANCH ON Y YESNO IAC /AC=1 IF Y NOP /AC=0 IF N DCA XROPT /AC=0 OTHERWISE, XROPT=1 IF YES, 0 FOR NO JMP I .+1 CON01 /LOCAL CONSTANTS KP10, 0010 KJLIST, LOCORE-1 KFIELD, HICORE-LOCORE-4
/DISPLAYS FOR ONCE ONLY CODE DIS00, 1401 /"LAB8/E IS READY 0270 /HIT RETURN TO PROCEED''" 5705 4011 2340 2205 0104 3140 4045 1011 2440 2205 2425 2216 4024 1740 2022 1703 0505 0447 4700 DIS00B, 0411 /"DIGITAL I/O? - 0711 /<Y FOR YES, N FOR NO>" 2401 1440 1157 1777 4047 5547 4045 7431 4006 1722 4031 0523 5440 1640 0617 2240 1617 7600
/DISPLAYS AND TEXTS FOR COMPILER [LB-U11*-PB] CON00, /END OF ONCE ONLY AREA DIS02, 2324 /"STANDARD RESOLUTION: 0116 /"'----' DATA POINTS 0401 2204 4022 0523 1714 2524 1117 1672 4547 5555 5555 4740 0401 2401 4020 1711 1624 2300
DIS03, 1405 /"LENGTH: '-----' '-'SEC" 1607 2410 7240 4755 5555 5555 4740 4755 4723 0503 0000 DIS04, 0405 /"DELAY: '-----' '-'SEC" 1401 3172 4047 5555 5555 5547 4047 5547 2305 0300 DIS05, 1011 /"HIGH RESOLUTION EPOCH 0710 /'----' DATA POINTS" 4022 0523 1714 2524 1117 1640 0520 1703 1045 4347 5555 5555 4740 0401 2401 4020 1711 1624 2300
DIS06, 1011 /"HI LENGTH: '-----' '-'SEC" 4014 0516 0724 1072 4047 5555 5555 5547 4047 5547 2305 0300 DIS07, 1011 /"HI DELAY: '-----' '-'SEC" 4004 0514 0131 7240 4755 5555 5555 4740 4755 4723 0503 0000 DIS01, 4523 /" 3116 /SYNC ON INPUT: S'-' 0340 /" 1716 4011 1620 2524 7240 2347 5547 4500
DIS09, 4002 / "BEGINS-AT RATE-ENDS 0507 /"XXXXXX""X""XXXXXX""X""XXXXXX""X" 1116 /"XXXXXX""X""XXXXXX""X""XXXXXX""X" 2355 / 0124 /'-': CHANGE (H,L,&)" 4022 0124 0555 0516 0423 4542 3030 3030 3030 4242 3042 4230 3030 3030 3042 4230 4242 3030 3030 3030 4242 3042 4542 3030 3030 3030 4242 3042 4230 3030 3030 3042 4230 4242 3030 3030 3030 4242 3042 4545 4755 4772 4003 1001 1607 0540 5010 5414 5446 5100
DIS12, 2317 /"SORT AT '-----' '-'SEC" 2224 4001 2440 4755 5555 5555 4740 4755 4723 0503 0000 DIS15, 0126 /"AVG #"XX" 0740 3342 /ANALOG INPUT '--' " 3030 4245 4501 1601 1417 0740 1116 2025 2440 4755 5547 0000 DIS16, 2205 /"RESOLUTION: '-' (H,L)" 2317 1425 2411 1716 7240 4755 4740 5010 5414 5100 DIS17, 2317 /"SORT CODE: '---'" 2224 4003 1704 0572 4047 5555 5547 0000
DIS18, 0317 /"CONFIDENCE LIMITS?:'-' 1606 /<Y:YES>" 1104 0516 0305 4014 1115 1124 2377 7240 4755 4745 7431 7240 3105 2376 0000 DIS19, 0317 /"COMPUTE TREND?: '-' 1520 /<Y: YES>" 2524 0540 2422 0516 0477 7240 4755 4745 7431 7240 3105 2376 0000
DIS24, 1405 /"LEAST SWEEP INTERVAL: 0123 /'------' '-'S (>"XXXXX" "X"S)" 2440 2327 0505 2040 1116 2405 2226 0114 7245 4755 5555 5555 4740 4755 4723 4050 7642 3030 3030 3030 4240 4230 4223 5100 DIS25, 0126 /"AVERAGE '....' SWEEPS" 0522 0107 0540 4755 5555 5547 4023 2705 0520 2300 DIS27, 4416 /"$FA8/INPUTS$AP4/" 0170 1116 2025 2423 4411 2064 0000
DIS27A, 4230 /"XX":"XX",X 3042 7242 3030 4254 3000 DIS30, 4415 /"$EA8/AVERAGES" 0170 0126 0522 0107 0523 0000 DIS30A, 4230 /-"XX"- 3042 0000 DIS32, 2025 /"PUNCH CONTROL TAPE? '-' 1603 /<Y: YES>" 1040 0317 1624 2217 1440 2401 2005 7740 4755 4745 7431 7240 3105 2376 0000
DIS32A, 2411 /"TITLE: 2414 /'---------------------'" 0572 4547 5555 5555 5555 5555 5555 5555 5555 5555 5555 5555 5547 4545 0000 ERR01, 7740 /"? SWEEP ENDS EARLY ' '" 2327 0505 2040 0516 0423 4005 0122 1431 4747 0000 ERR02, 7740 /"? INSUFFICIENT MEMORY ' '" 1116 2325 0606 1103 1105 1624 4015 0515 1722 3147 4700 ERR03, 7740 /"? BAD SAMPLING RATIO ' '" 0201 0440 2301 1520 1411 1607 4022 0124 1117 4747 0000
ERR04, 7740 /"? NO COMMON INTERVAL" 1617 4003 1715 1517 1640 1116 2405 2226 0114 4747 0000 ERR05, 7740 /"? TOO MANY INPUTS 2417 / FOR SWEEP RATE" 1740 1501 1631 4011 1620 2524 2345 4040 0617 2240 2327 0505 2040 2201 2405 4747 0000 TXT32, 4545 /<CRLF><CRLF> SWEEP SUMMARY<CRLF> 4040 4023 2705 0520 4023 2515 1501 2231 4500
TXT32A, 4040 /" AVERAGES 4040 /CHAN RATE TYPE SORT 0126 0522 0107 0523 4503 1001 1640 2201 2405 4024 3120 0540 2317 2224 4500 TXT33A, 4042 /" "XX" X "XX" "XXX" 3030 /" 4240 4040 4030 4040 4040 4042 3030 4240 4042 3030 3042 4500 DIS99, 5026 /"(VAP,"X","XXXX"-"XXXX") 0120 5442 3042 5442 3030 3030 4255 4230 3030 3042 5145 0000 TXT34B, 4023 /" SWEEPS AT " 2705 0520 2340 0124 4000
TXT34C, 2345 /"S /TTYLST: H,L HLSWIT, 0010 /H -014 /L TXCRLF, 4545 4500 /TTYLST: LF,CR CRLF, +212 -215 /FLOATING VARIABLES FLOT11, 0 0 0 FLOT12, 0 0 0 FLOT13, 0 0 0 FLOT14, 0 0 0 FLOT15, 0 0 0 FLOT16, 0 0 0 FLOT17, 0 0 0 FLOT20, 0 0 0 /FLOATING CONSTANT VARTIM, 0011 3100 0000 CON02A, TAD SAMB TAD CON02H SMA CLA JMP I CON02J TAD SAMB IAC JMP I CON02K CON02K, CON02P CON02J, CON02 CON02H, 100 XX76NO, TAD FAC+2 /SUBTRACT 200 FOR EACH FIELD USED. TAD XXM200 /PS8 USES 7600 AND UP. DCA FAC+2 JMP .+2 DADD ISZ TLINKS JMP .-2 TAD TEMP06 /SUBTRACT AGAIN IF ANOTHER FIELD CIA /WAS USED. TAD FOP+1 SZA CLA DADD JMP I .+1 XX76BK XXM200, -200 *1763 /FLOATING CONSTANT AVGTIM, 0007 2770 0000
/SELECT SWEEP PARAMETERS CHASX, CHAS CON01, FRAME /"SYNC ON CHANNEL S'-'" DIS01 JMP CON01 /L.F.: RESTART OCTARG JMP CON01 /FORMAT ERROR - ASK AGAIN SNA JMP I CHASX DCA SMASK TAD SMASK BRAN K0004 JMP OK JMP I CON01Z JMP OK JMP OK JMP I CON01Z CHAS, CLL CML RAR DCA SMASK OK, TAD MODE DCA KMODE CON02, FRAME /"STANDARD RESOLUTION DIS02 /'---' DATA POINTS" JMP I CON01Z /L.F.: PREVIOUS QUESTION DECARG JMP CON02 /FORMAT ERROR - ASK AGAIN CMA IAC DCA SAMB /-# OF DATA POINTS IN LOW (OR ONLY) EPOCH JMP I .+1 /CHECK IF # OF POINTS IS LESS /THAN 65. CON02A CON02P, FLOAT /FSAMB =-(#OF POINTS -1) SAVE FSAMB FSAMB=FLOT03 FADD KM001F SAVE /-# OF POINTS FLOT01 TAD SAMB TAD FIELD0 /DECREASE AVAILABLE FIELD0 BY ADC BUF SZL CLA /(+)+(-): LINK WILL BE 1 IF NO OVERFLOW JMP CON03 FRAME /"? INSUFFICIENT MEMORY" ERR02 JMP CON02 /ASK FOR # OF DATA POINTS JMP CON02 /LOCAL CONSTANTS K0226, +226 CON01Z, CON01 MODE, 5057 /EXTERNAL ENABLE,SCHMITT ENABLE,RESET
CON03, FRAME /"LENGTH: '----' '-'SEC" DIS03 / JMP CON02 /GO BACK TO PREVIOUS QUESTION FLTARG JMP CON03 /FORMAT ERROR - ASK LENGTH AGAIN FDIV /GET TIME BETWEEN DATA POINTS FLOT01 SAVE FBSI FBSI=FLOT04 TAD K0226 /MUST BE GREATER THAN OR EQUAL 150 USEC" FLOAT FADD /150US-RATE FBSI TAD FAC+1 SMA SZA CLA JMP CON03 /.LT. 150 USEC, TRY AGAIN CON04, FRAME /"DELAY: '----' '-'SEC DIS04 JMP CON03 /L.F.: PREVIOUS QUESTION FLTARG JMP CON04 /FORMAT ERROR - ASK DELAY AGAIN SAVE FBLATT /LATENCY IN USEC FBLATT=FLOT05 FDIV /GET LATENCY IN TERMS OF SAMPLING INTERVAL FBSI SAVE /-LATENCY IN BSI FBLAT FBLAT=FLOT06 FADD FSAMB /-LENGTH OF SWEEP IN BSI TAD FAC+1 SPA SNA CLA /DOES SWEEP END BEFORE SYNC PULSE? JMP CON05 /NO, OK. FRAME /YES;"? SWEEP ENDS EARLY" ERR01 JMP CON03 /LF: GET NEW SWEEP LENGTH JMP CON04 /CR: GET NEW SWEEP DELAY /LOCAL CROSSPAGE CON08X, CON08 CON07X, CON07A
CON05, DCA KBTOA FRAME /"HIGH RESOLUTION EPOCH DIS05 /'----' DATA POINTS" JMP CON04 /L.F.: LAST QUESTION DECARG JMP .-4 /FORMAT ERROR - ASK # POINTS AGAIN CMA IAC /-# DATA POINTS SNA JMP I CON08X /0 DATA POINTS INDICATES SINGLE MODE DCA SAMA /- POINTS IN HI RESOLUTION EPOCH TAD SAMA IAC FLOAT /-(#DATA POINTS-1) SAVE FSAMA=FLOT10 FSAMA /FSAMA=FLOT10 FADD KM001F SAVE /-#DATA POINTS FLOT01 TAD SAMA /PARTS OF FIELD 0 IN USE TAD SAMB TAD FIELD0 /FIELD 0 AVAILABLE SNL CLA /LINK=1 IF OVERFLOW JMP CON06 FRAME /"? INSUFFICIENT MEMORY" ERR02 JMP CON02 /L.F.: RESPECIFY LO-EPOCH JMP CON05 /C.R.: RESPECIFY HI-EPOCH CON06, FRAME /"HI LENGTH: '----' '-'SEC" DIS06 JMP CON05 /LF: PREVIOUS QUESTION FLTARG JMP CON06 /FORMAT ERROR - ASK AGAIN FDIV /LENGTH\# POINTS= SAMPLING INTERVAL FLOT01 SAVE /GET ASI IN USEC FASI FASI=FLOT11 TAD K0226 /IF ASI. .LT. 150 US, TOO FAST FLOAT FADD /150US-ASI FASI TAD FAC+1 SMA CLA JMP CON06 /.LT. 150 US, TOO FAST LOAD /CHECK BSI/ASI RATIO FBSI FDIV FASI DCOM FIX /.ABS. RATIO .LT. 1 OR .GT. 2^11 ? SZA /-BSI/ASI RATIO IN AC JMP I CON07X /NO - IS OK
FRAME /"? BAD SAMPLING RATIO" ERR03 JMP I CON02X /LF: CHANGE BOTH SWEEPS JMP I CON05Y /CR: CHANGE HIGH CON07A, DCA KBTOA /KBTOA HOLDS -RATIO CON07, FRAME /"HI DELAY: '----' '-'SEC" DIS07 JMP I CON06X /LF: PREVIOUS QUESTION FLTARG JMP CON07 /FORMAT ERROR: ASK AGAIN FDIV /-LATENCY IN TERMS OF ASI FASI SAVE FALAT FALAT=FLOT12 TAD KBTOA /BSI=-KBTOA*ASIF CMA IAC FLOAT FMUL FASI SAVE FBSI LOAD /GET LO SWEEP LATENCY IN TERMS OF ASI FBLATT /-LO-LATENCY IN USEC. FDIV FASI SAVE /LO-LATENCY IN ASI. FBLAT TAD KBTOA /GET END TIME OF LO SWEEP (IN ASI) CMA IAC FLOAT FMUL /(B/A RATIO)*(-# OF POINTS) FSAMB FADD /ADD -DELAY (IN ASI) FBLAT DCOM SAVE /DELAY (IN ASI)+# OF POINTS*RATIO FBEND /POSITIVE SENSE FBEND=FLOT07 JMP CON08A /LOCAL CROSS-PAGE CON02X, CON02 CON04X, CON04 CON05Y, CON05 CON06X, CON06 CON09X, CON09 FMINX, FMINS
CON08, LOAD /HERE FOR 1-EPOCH MODE FBSI SAVE /BSI=ASI FASI LOAD /LO-LATENCY=HI-LATENCY FBLAT SAVE FALAT JMS I FMINX /SYNC TIME IS AT MIN (SYNC PULSE, DELAY) KZEROF DCOM SAVE /FAKE END OF B (SYNC TIME) FBEND LOAD FSAMB SAVE FSAMA CON08A, TAD KBTOA /COME HERE FOR 2-EPOCH MODE FLOAT SAVE /-BSI/ASI FBTOA FBTOA=FLOT20 LOAD /GET AEND, AEND=-(ALAT+SAMA) FSAMA /AEND IS - TIME OF A-SWEEP ENDING FADD FALAT /FALAT IS NEGATIVE SENSE A-DELAY SAVE FAEND /NEGATIVE SENSE. FAEND=FLOT13 FADD FBEND /FBEND IS POSITIVE SENSE END OF B-SWEEP TAD FAC+1 /DIFFERENCE BETWEEN END TIMES SMA SZA CLA /BEND .LT. AEND? JMP CON08C /YES, LO ENDS AFTER HI ENDS FIX /NO, HI ENDS AFTER LO ENDS FLOAT /TRUNCATE. ROUND UP SAVE /(LO ENDS FIRST) EJECT FBLA /-# OF POINTS LEFT IN A AT END OF B FBLA=FLOT14 LOAD /SYNC TIME AT END OF LO SWEEP: KSYTIM=-(BEND-1) FBEND DCOM FADD KM001F SAVE KSYTIM-1 LOAD /DOES HI START AFTER LO ENDS? FBEND /+(END-OF-B TIME) FADD FALAT /MINUS (START-OF-A TIME) TAD FAC+1 /(END B) - (START A) .LT 0? SPA CLA JMP CON08B /YES-NO COMMON INTERVAL
FIX /NO - TRUNCATE, ROUND DOWN FLOAT DCOM /LOGICAL START OF HI-SWEEP SAVE /[(END B) - (START A)] FROM SYNC TIME FADEL /NEGATIVE FADEL=FLOT15 LOAD /LOGICAL START OF LO-SWEEP ENTIRE BUFFER BACK FSAMB SAVE FBDEL FBDEL=FLOT16 LOAD /CLOSE LO BUFFER AT SYNC TIME KZEROF SAVE FBLB FBLB=FLOT17 JMP I CON09X CON08B, FRAME /"? NO COMMON INTERVAL" ERR04 JMP I CON04X /L.F.: GO BACK TO RESPECIFY LO-LATENCY JMP I CON02X /C.R.: RESPECIFY HI-LATENCY CON08C, FDIV /HI SWEEP ENDS BEFORE LO SWEEP ENDS FBTOA /KBLB=[(BEND-AEND)/KBTOA]-1 FIX /-# OF POINTS LEFT TO GET IN B WHEN A STOPS FLOAT /TRUNCATE - ROUND UP SAVE /LO CLOSES KBLB AFTER SYNC TIME (IN BSI) FBLB LOAD /SYNC TIME AT END OF HI SWEEP FAEND FADD KM001F SAVE KSYTIM-1 LOAD /DOES HI END BEFORE LO BEGINS? FAEND DCOM FADD /(END A)-(START B) .LT. 0 ? FBLAT TAD FAC+1 SPA CLA JMP I CON08W /YES - NO COMMON INTERVAL FDIV /BDEL IS TIME FROM LOGICAL START TO SYNC TIME FBTOA /IN ASI DCOM FIX FLOAT /TRUNCATE, ROUND DOWN DCOM SAVE FBDEL
LOAD /LOGICAL START OF HI IS ENTIRE BUFFER BACK FSAMA SAVE FADEL LOAD /THERE ARE NO MORE A-POINTS TO GET AT SYNC TIME KZEROF SAVE /CLOSE HI BUFFER AT SYNC TIME FBLA CON09, TAD KSYTIM /SETUP SWEEP SUMMARY DISPLAY SPA CLA /UNLESS EITHER SWEEP ENDS BEFORE SYNC JMP CON09A FRAME /"? SWEEP ENDS EARLY" ERR01 JMP I CON04Y /LF: RESPECIFY LATENCY JMP I CON05X /CR: RESPECIFY HI SWEEP /LOCAL CROSSPAGE CON04Y, CON04 CON05X, CON05 CON08W, CON08B /SUBROUTINE TO GET MAX OF TWO FLOATING ARGUMENTS: FMAX FMAXS, 0 TAD FMAXS /GET PARAMETER ADDRESS DCA FMLOCS JMS FMARGS /COMPARE FMEXIT, SPA CLA /SIGN OF COMPARSION TAD K0003 /GET COMPARAND AS RESULT (FMARG2=FMARG1+3) TAD ADRARG /GET FAC AS RESULT DCA .+2 LOAD /PUT INTO FAC 0 JMP I FMLOCS /EXIT /SUBROUTINE TO GET MIN OF TWO FLOATING ARGS: FMIN FMINS, 0 JMS FMARGS /COMPARE CMA IAC /REVERSE SIGN OF COMPARSION JMP FMEXIT
FMLOCS=FMINS FMARGS, 0 SAVE /SAVE THE FAC ADRARG, FMARG1 FMARG1=FLOT01 TAD I FMLOCS /GET ADDRESS OF COMPARAND DCA .+2 LOAD /PUT COMPARAND IN FAC 0 SAVE /AND SAVE IT FMARG2 FMARG2=FLOT02 DCOM /FAC - COMPARAND FADD FMARG1 TAD FAC+1 /SIGN OF (FAC-COMPARAND) ISZ FMLOCS /ADJUST RETURN ADDRESS JMP I FMARGS CON09A, SETH /POSITION HALFWORD POINTER DIS09 /PICK UP ARGUMENTS FOR DISPLAY LOAD KSYTIM-1 DFIX /-SYNC POINT+1 FAC+1 NORM /TRUNCATE, ROUND UP DCA FAC SAVE KSYTIM-1 DCOM FADD KM001F FADD /A-START TIME FADEL DCOM FMUL /SYNC POINT - DELAY (IN USEC) FASI FLTOUT LOAD FASI /HI SWEEP SAMPLING RATE DCOM FLTOUT LOAD /A-END TIME KM001F DCOM FADD KSYTIM-1 FADD FBLA
FMUL /SYNC POINT + POINTS LEFT (IN USEC) FASI FLTOUT LOAD /GET START TIME OF LO SWEEP FBDEL FMUL FBTOA FADD KSYTIM-1 DCOM FADD KM001F DCOM FMUL /SYNC POINT - DELAY FASI FLTOUT LOAD /LO RESOLUTION SAMPLING INTERVAL FBTOA FMUL FASI FLTOUT LOAD /B-END TIME FBLB FMUL FBTOA FADD KM001F DCOM /SYNC POINT + POINTS LEFT (IN USEC) FADD KSYTIM-1 FMUL FASI FLTOUT LOAD /PRESET FAC TO -1 FOR NO XR KM001F CON09B, FRAME /"BEGINS -AT RATE- ENDS DIS09 /SDDDDDMSDDDDDMSDDDDDM JMP CON09B /SDDDDDMSDDDDDMSDDDDDM ALPHA / BRAN /'-': CHANGE [H,L,-]" HLSWIT /(S: - OR SPACE; D: 0-9, OR -; M: U, M, OR SPACE) JMP I CON05Z /CHANGE HI (H) JMP I CON02Y /CHANGE HI AND LO (L)
/GET LAST SWEEP PARAMETER: SORT TIME CON12D, TAD XROPT /IF NO XR IN SYS, SKIP QUESTION SNA CLA JMP CON12E /ASSUME CTIME IS AT SYNC TIME FRAME /"SORT AT '-----' '-'SEC" DIS12 JMP I CON9X /LF: LOOK AT SUMMARY AGAIN FLTARG JMP CON12D /FORMAT ERROR - ASK AGAIN FDIV /TIME IN ASI - CAN NO LONGER CHANGE SW PARAMETERS FASI FADD KM001F TAD FAC+1 /-SORT TIME MUST BE .LT.0 (-1 IF UNSPEC) SMA CLA JMP CON12D /RE ASK QUESTION CON12E, SAVE FCTIM FCTIM=FLOT04 /FBSI. BLOCK 3-8 DFIX KCTIM LOAD FAEND JMS I FMINY /FIND END OF SW PHASE FCTIM /MAX (END-A, SORT TIME)= MIN (-END-A, -SORT TIME) DCOM JMS I FMAXX /MAX (END-A, SORT TIME, END-B) IS END OF SW PHASE FBEND SAVE /SWEEP PHASE END POINT (IN ASI) FSWEND FSWEND=FLOT04 /FCTIM, BLOCK 12E LOAD FALAT JMS I FMAXX /FIND BEGIN TIME FOR SWEEP PHASE (IN ASI) FBLAT /MIN (START-A,START-B) = MAX (-START-A,-START-B) SAVE FSWBEG /-START TIME OF SWEEP PHASE FSWBEG=FLOT13 /12E,8-12 FADD /+ END TIME OF SWEEP PHASE FSWEND SAVE /LENGTH OF SWEEP PHASE IN ASI FSWTIM FSWTIM=FLOT04 /FSWEND, BLOCK 12E
/ASK QUESTIONS AND GENERATE JOB LIST CON13, DCA TNJOB /INITIALIZE SECTION VARIABLES - JOB 0 TNJOB=TEMP30 TAD KBTOA /SET ALLOWED MIN SAMPLING TIME SZA CLA TAD K0031 /25 (10) TAD K0175 /125(10) FLOAT /125 US IF SINGLE SAVE /150 US IF DOUBLE MODE FTIMSV /HOLDS MIN SWEEP INTV PERMITTED FTIMSV=FLOT01 /INCREASED FOR JOBS AS CHOSEN LOAD /SET TIME USED TO ZERO KZEROF SAVE CALTIM CALTIM=FLOT05 /FBLATT, BLOCK 4-7 LOAD /MEMORY AVAILABLE AT INSTALLATION MEMTOT-1 SAVE DAVAIL /DBL PREC. FIXED POINT. # OF CELLS AVAIL IN ALL OF CORE DAVAIL=FLOT02 TAD FIELD0 /FIELD0 AVAIL FOR BUFFERS & LISTS DCA TLEFT0 /# OF CELLS LEFT IN FIELD 0 TLEFT0=TEMP15 DCA NCHA /INITIALIZE # OF CHANNELS TO ZERO DCA NCHB TAD ADJLIS /INITIALIZE JOB LIST POINTER IAC DCA TJPNTR TJPNTR=TEMP21 DCA I TJPNTR /PUT EOL WORD IN JOB LIST (J1=0) TAD KMAXSZ /-MAXIMUM SIZE OF LIST +20 CON14, DCA TSZLST TSZLST=TEMP13 TAD TLEFT0 /INITIALIZE FOR NEXT JOB DCA TAVAIL /TLEFT0 MODIFIED AT CON16 TAVAIL=TEMP14 LOAD /UPDATE TIME COUNT, FTIMSV MOD AT CON21 FTIMSV SAVE FTIMIN FTIMIN=FLOT07 /FBEND. BLOCK 4-12E SETH /PUT AVERAGE # IN MESSAGE DIS15 TAD TNJOB IAC OCTOUT EJECT CON15, FRAME /"AVG XX DIS15 /AVERAGE INPUT '--'" JMP I CON22X /L.F.: ENOUGH AVERAGES OCTARG JMP CON15 /FORMAT ERROR - ASK AGAIN DCA SHFR /SHFR HAS CHANNEL NUMBER
CON16, TAD SAMA /INITIALIZE FOR SINGLE MODE (H RESOL) DCA TNSAM /NUMBER OF DATA POINTS THIS JOB TNSAM=TEMP16 TAD NCHA /ORDER OF THIS JOB IN JLIST DCA TORDER TORDER=TEMP17 TAD KBTOA /DUAL BEAM MODE? SNA CLA JMP CON16J /NO- OMIT QUESTION CON16A, FRAME /"RESOLUTION: '-' [H,L]" DIS16 JMP CON15 /L.F.: RESTART JOB ALPHA /GET ANSWER BRAN HLSWIT JMP CON16B /H - OK JMP CON16G /L. - READUST FOR LO JMP CON16A /OTHER - ERROR, ASK AGAIN /LOCAL CONSTANTS K0006, 0006 K0031, 31 /25(10) K0175, 175 /125(10) /LOCAL CROSS-PAGE CON9X, CON09B CON02Y, CON02 CON05Z, CON05 CON22X, CON22 FMINY, FMINS FMAXX, FMAXS KMAXSZ, CON00-LOCORE-16 /FROM LOCORE TO CON00 FOR LISTS (-16 FOR NEXT JOB) CON16G, TAD NCHB /ORDER IN MX-B LIST DCA TORDER TAD K0040 /SET A/B BIT =1 TAD SHFR DCA SHFR CON16J, TAD SAMB /LO RESOLUTION SWEEP POINTS DCA TNSAM EJECT CON16B, TAD K0003 /INITIALIZE FOR NEW CHANNEL DCA TCHINC /HOW MUCH TO INCREMENT CORE USED FOR MX, CD LIST ENTRY TCHINC=TEMP20 TAD K0006 /MOVE A/B, CHAN # TO TOP 6 BITS SHFT TAD TNSAM /IMAGE OF # DATA POINTS DCA TNSAMM TNSAMM=TEMP10 TAD SHFR TAD TORDER TAD K0040 /ADD IN 1(1), CHAN ORD (5) TO BOTTOM 6 BITS DCA TJCHAN /SAVE FOR J-LIST TJCHAN=TEMP12 TAD ADJLIS /SET POINTER TO TOP OF JOB LIST IAC
CON16C, DCA TJPNTR /SEARCH FOR SWEEP, CHAN # ALREADY ON J-LIST TAD I TJPNTR SNA JMP CON16E /FOUND END OF LIST (J1=0) AND K7700 /THESE BITS HOLD SWEEP TYPE AND CHAN # DCA TJMAT TJMAT=TEMP01 TAD TJCHAN /NEW JOB'S J1 WORD AND K7700 CMA IAC TAD TJMAT /MATCH BETWEEN TOP 6 BITS OF WORDS? SZA CLA JMP CON16D /NO MATCH, MOVE ON DCA TCHINC /FOUND A MATCH NO INCREASE IN MX- OR CD-LIST LENGTH DCA TNSAMM /NO NEW BUFFER AREA REQUIRED TAD I TJPNTR /CHAN ORDER IS SAME AS MATCHING J1'S DCA TJCHAN CON16D, TAD K0007 /MOVE TO NEXT JOB TAD TJPNTR JMP CON16C CON16H, FRAME /"? INSUFFICIENT MEMORY" ERR02 JMP I CON13X /LF: START AT JOB 1 JMP I CON15X /CR: RESTART CURRENT JOB /TTY LIST YESNO, 31 /Y -16 /N /LOCAL CROSSPAGE CON13X, CON13 CON15X, CON15 CON16E, TAD TCHINC /UPDATE MIN SAMP INTV SNA CLA JMP CON16K TAD K0017 /NEW CHANNEL TAKES 15 USEC MORE TO ACQUIRE FLOAT FADD /OLD MIN SAMP INTV FTIMIN SAVE FTIMSV FADD /REQUIRED SAMP INTV FASI TAD FAC+1 /DOES THIS MAKE REQ. SAMPLING RATE IMPOSSIBLE? SPA SNA CLA JMP CON16K /NO-IT'S OK FRAME /"? TOO MANY INPUTS ERR05 /FOR SWEEP RATE" JMP I CON13X /RESTART FROM JOB 1 (LF) JMP I CON15X /RESTART THIS JOB (CR)
CON16K, TAD TCHINC /SEE IF THERE IS BUFFER ROOM TAD K0007 CMA TAD TNSAMM DCA TDECF0 /HOW MUCH TO DECR FIELD0 TDECF0=TEMP10 CLL TAD TDECF0 /IS THERE ROOM? TAD TAVAIL SNL JMP CON16H /NO- INSUFFICIENT MEMORY CON16F, DCA TLEFT0 /FIELD 0 LEFT DCA TCMASK /INITIALIZE FOR NO CONTINGENCY MASK TCMASK=TEMP11 TAD XROPT /DOES INSTALLATION HAVE XR OPTION? SNA CLA JMP CON18 /NO-SKIP QUESTION CON17, FRAME /"SORT CODE: '---'" DIS17 JMP I CON15X /LF: RESTART JOB OCTARG JMP CON17 /FORMAT ERROR - ASK AGAIN AND K0377 /SET CONTINGENCY PART OF J2 DCA TCMASK CON18, IAC DCA TJTYPE /INITIALIZE JOB TYPE TO TYPE 1 (AVG ONLY) TJTYPE=TEMP07 FRAME /"COMPUTE S.D.?: '-' DIS18 /(Y: YES)" JMP I CON15X /L.F.:RE-DO JOB ALPHA /GET ANSWER BRAN /Y FOR YES YESNO JMP .+3 /Y: YES JMP CON19A /N: NO JMP CON19A /OTHER - SAME AS N TWO /JOB TYPE SET TO TWO DCA TJTYPE
CON19, FRAME /"COMPUTE TREND?: '-' DIS19 /(Y: YES)" JMP CON18 /L.F. RE ASK VARIANCE ALPHA /GET ANSWER BRAN YESNO ISZ TJTYPE /Y: YES - SET JOB TYPE = 3 K7700, 7700 /N: NO (A NOP) CON19A, TAD TJTYPE /UPDATE TOTAL AVAILABLE CORE BRAN /AFTER THIS JOB'S CALC REGION K0003 /IS SET ASIDE TAD K0004 /TYPE 3, NCELL=9 TAD K0003 /TYPE 2, NCELL=5 TAD K0002 /TYPE 1, NCELL=2 DCA TNCELL /LOCATIONS REQUIRED PER DATA POINT TNCELL=TEMP02 TAD TNCELL CMA IAC DCA TNCNT /FIND REQUIRED CORE FOR THIS JOB TNCNT=TEMP01 CLA CMA DCA FOP+1 TAD TDECF0 /FIGURE IN INCREASE IN MX, CD, AND J LISTS DCA FOP+2 TAD TNSAM DCA FAC+2 /ADD (# OF POINTS)*(# OF LOCATIONS PER POINT) CMA DCA FAC+1 DADD ISZ TNCNT /ADD IN # OF POINTS. (# OF LOCS) TIMES JMP .-2 LOAD /DECREASE CURRENTLY AVAIL. MEMORY DAVAIL DADD TAD FOP+1 DCA TEMP06 TAD FAC+1 /# OF DATA FIELDS PREVIOUSLY AVAILABLE CMA TAD FOP+1 /- OF DATA FIELDS NOW AVAILABLE+1 EJECT DCA TLINKS /IS # OF BLOCKS (LINKAGE) REQUIRED TLINKS=TEMP01 CLA CMA /PUT-(3 LOCS+1 DATA POINT) IN FAC DCA FAC+1 TAD TNCELL TAD K0003 CMA IAC DCA FAC+2 DADD /SUBTRACT THIS AMOUNT FOR EACH LINKAGE REQUIRED JMP I .+1 XX76NO XX76BK, TAD FOP+1 /IS THERE ENOUGH MEMORY TO DO THIS JOB? SPA CLA JMP I CON16W /NO, INSUFFICIENT MEMORY
CON20, LOAD /AMOUNT OF MEMORY LEFT (DBL PREC) WAS IN FOP FOP SAVE DAVAIL TAD TJCHAN /PUT A/B(1), CHAN#(5), 1(1), CHAN ORDER(5) IN J1 DCA I TJPNTR TAD TJTYPE /PUT TYPE (4), SORT CODE(8) IN J2 CLL RTR /TYPE# TO AC0-3 RTR RAR TAD TCMASK /SORT CODE TO AC 8-11 ISZ TJPNTR DCA I TJPNTR TAD TNCELL /PUT NCELL IN J3 FOR NOW ISZ TJPNTR DCA I TJPNTR TAD TNSAM /PUT NSAM IN J4 FOR NOW ISZ TJPNTR DCA I TJPNTR TAD K0004 /SKIP OVER J5, J6, AND J7 TAD TJPNTR DCA TJPNTR DCA I TJPNTR /PUT EOL WORD AT CURRENT END OF JOB LIST TAD TCHINC /WAS THIS A NEW CHANNEL? SNA CLA JMP CON21 /NO. TAD TJCHAN /YES, INDEX CHANNEL COUNTER SMA CLA /WHICH ONE, A OR B? JMP CON21-1 /CHANNEL IS IN A-SWEEP ISZ NCHB /J1(0)=1 FOR B (LO-RESOLUTION) JMP CON21 /LOCAL CROSS-PAGE CON15Y, CON15 CON14X, CON14 CON16W, CON16H ISZ NCHA /J1(0)=0 FOR A (HI-RESOLUTION EJECT CON21, TAD TNSAM /-# OF DATA POINTS FLOAT SAVE FLOT01 LOAD /PRESET FAC FOR JOB TYPE 1 AVGTIM /TIME TO AVERAGE ONE POINT TAD TJTYPE /GET THE JOB TYPE BRAN K0002 JMP CON21B /JOB TYPE=2, AVG AND VAR JMP CON21A /JOB TYPE=1, AVG ONLY FADD /JOB TYPE=3 (OTHER), AVG, VAR, AND TREND TRNTIM /TIME TO TAKE TREND OF ONE POINT CON21B, FADD /ADD TIME TO TAKE VARIANCE ON ONE POINT VARTIM
CON21A, FMUL /MULTIPLY BY NUMBER OF POINTS FLOT01 FADD /UPDATE BUSY TIME CALTIM SAVE CALTIM ISZ TNJOB /UPDATE JOB NUMBER TAD TCHINC /INCREASE LIST LENGTH TAD K0007 TAD TSZLST /UPDATE AREA LEFT FOR JOB LIST SMA /OUT OF RESERVED AREA? JMP I CON14X /NO- GET NEXT JOB'S PARAMETERS /FIX PARAMETERS AND POINTERS CON22, CLA TAD TNJOB /JOBS HAVE ALL BEEN CHOSEN SNA CLA /THERE MUST BE AT LEAST ONE JOB JMP I CON15Y /IF NOT RETURN TO SPECIFY ONE TAD TJPNTR /SET UP MX AND CD LIST POINTERS DCA ADMPXA /START OF MX LIST-1 (HI RESOLUTION) TAD ADMPXA TAD NCHA IAC DCA ADMPXB /START OF LO MPLX LIST TAD ADMPXB TAD NCHB DCA ADCHNL /START OF CHANNEL LIST-1 TAD NCHA TAD NCHB IAC CLL RAL /LENGTH OF CH LIST=2*NCHA+1+2*NCHB+1 TAD ADCHNL DCA ADBUFA /START OF ADC BUFFER-A LOAD /SAMPLES IN SWEEP-A FSAMA FIX TAD KM0001 DCA SAMA TAD NCHA /# CHANNELS IN A CMA IAC FLOAT SAVE FLOT01 /LENGTH OF BUFFER-A IS #SAMPLES * #CHANNELS TAD SAMA FLOAT FMUL FLOT01 FIX DCA LNBUFA /LNBUFA IS POSITIVE LOAD FLOT01
FMUL /FADEL IS # OF SAMPLE TIMES BACK FADEL FIX /GET PHYSICAL DISTANCE BACK TAD ADBUFA TAD KM0001 CMA IAC DCA ADEL /-(ADBUFA +DISTANCE BACK)=ADEL LOAD /GET SAMPLES IN B FSAMB FIX TAD KM0001 DCA SAMB TAD NCHB /GET PHYS. LENGTH OF BUFFER-B CMA IAC FLOAT SAVE FLOT01 TAD SAMB FLOAT FMUL FLOT01 FIX DCA LNBUFB /LENGTH OF B (IN LOCATIONS) TAD ADBUFA /START OF ADC BUFFER FOR HIGH RESOLUTION-1 TAD LNBUFA DCA ADBUFB /START OF ADC BUFFER FOR LOW RESOLUTION-1 LOAD /GET DISTANCE BACK IN BUFFER FOR START OF B FLOT01 FMUL FBDEL FIX TAD ADBUFB TAD KM0001 CMA IAC DCA BDEL /-(ADBUFA+DISTANCE BACK IN B) TAD LNBUFA /IS THERE AN A-SWEEP? SNA CLA EJECT JMP .+5 /NO, SET KBLA TO 0 LOAD /POINTS TO GET AT SYNC TIME IN A FBLA FIX TAD KM0001 DCA KBLA TAD LNBUFB /IS THERE A B-SWEEP? SNA CLA JMP CON22A /NO- THERE ARE 0 POINTS TO GET AT SYNC TIME LOAD /YES FBLB FIX TAD KM0001
CON22A, DCA KBLB /B-POINTS TO GET AT SYNC TIME LOAD /GET TIME FROM SYNC POINT TO SYNC TIME KSYTIM-1 DFIX KSYTIM TAD ADJLIS /SET POINTER TO START OF JOB LIST IAC CON23, DCA TJPNTR /MAKE UP MULTIPLEXOR LIST TAD I TJPNTR /GET J1 SNA JMP CON24 /J1=0 IMPLIES END OF LIST AND K4037 /GET CHANNEL ORDER AND SWEEP SPA IAC /SWEEP-B SNA SPA TAD NCHA /(ORDER 0, SWEEP A) OR SWEEP B AND K0037A TAD ADMPXA DCA TCHLOC /ADDRESS FOR ENTRY IN MX-LIST TCHLOC=TEMP01 TAD I TJPNTR /GET CHANNEL # FOR THIS JOB RTR RTR RTR AND K0037A DCA I TCHLOC /STORE IN ADDRESS CALCULATED TAD K0007 /MOVE POINTER TO NEXT J1 TAD TJPNTR JMP CON23 /LOCAL CONSTANTS KM0014, -0014 K4037, 4037 K0037A, 0037 K0175A, 0175 /THIS SUBROUTINE GETS MAX-X FOR A DISPLAY GROUP EJECT XMAXS, 0 DCA TNPT /# OF POINTS TNPT=TEMP03 JMS I SDISX /GET XZERO AND DELTAX JMP XMEXIT /NO MORE ENTRIES IN DISPLAY LIST LOAD /FIND #PTS*DELTAX+XZERO DELTAX DELTAX=FLOT01 NORM /DELTAX*2^12 TAD KM0014 DCA FAC SAVE FLOT01 /DELTAX*2^12/2^12 TAD FOP+1 /FOP HOLDS X0 DCA TXZ TXZ=TEMP13
TAD TNPT /#PTS*DELTAX FLOAT FMUL FLOT01 DCOM TAD K0002 FIX CLL RTR TAD TXZ /+(X-ZERO) DCA I BXPNTR /MAXIMUM-X FOR THIS DISPLAY TAD TXZ DCA FOP+1 JMP I XMAXS XMEXIT, ISZ XMAXS JMP I XMAXS /LOCAL CROSSPAGE CON13Z, CON13 SDISX, SDISS /ASK LAST OF SWEEP PARAMETER QUESTIONS CON24, TAD K0175A /SWEEP TIME+(CALCTIME*ASI)/(AS1-125US) FLOAT FADD FASI SAVE /(ASI-125US) FLOT01 /TIME LEFT FOR CALCULATIONS BETWEEN INTERRUPTS LOAD /-TIME TO DO CALCULATIONS AT 100% PROCESSOR AVAILABILITY CALTIM FDIV /ADJUST FOR ACTUAL AVAILABILITY FLOT01 FADD /INCLUDE TIME TO ACCEPT SWEEP FSWTIM FMUL FASI /PUT IN TERMS OF USEC FADD FASI SAVE CALTIM DCOM SETH /THIS IS MIN TIME BETWEEN SWEEPS DIS24 FLTOUT CON24A, FRAME /"LEAST SWEEP INTERVAL DIS24 /'-----' ':'S [>SDDDDD MS]" JMP I CON13Z /L.F.: RE SELECT JOBS FLTARG JMP CON24A /FORMAT ERROR-TRY AGAIN
SAVE FSYNTM FSYNTM=FLOT01 FADD /BUSY TIME (CALTIM) .GT. INTER SYNC TIME? CALTIM TAD FAC+1 SPA CLA JMP CON24A /YES-TRY AGAIN CLA CMA /NO- PUT EOL WORDS IN MX-LISTS TAD ADMPXB DCA MPXPNT MPXPNT=TEMP01 CLL CLA CML RAR /FIRST PUT EOMX WORDS IN PLACE TAD I MPXPNT /4000+FIRST CHAN (ORD=0) IN A TO END OF MXA-LIST DCA I MPXPNT TAD I MPXPNT /4000+ORD(0) OF A TO END OF MXB-LIST DCA I ADCHNL LOAD /GET ITIM FOR S0 FIRING FSYNTM FDIV /PUT IN TERMS OF ASI FASI SAVE /- TIME FOR S0 TO FIRE FITIM FITIM=FLOT02 LOAD FSWBEG /GET TIME FOR ADC BUFFER OPENING FADD KM001F TAD FAC+1 /DOES SWEEP BEGIN BEFORE SYNC? SPA CLA /- TIME OF SWEEP START JMP CON24B /NO FADD /YES- TIME IT FROM PREVIOUS SWEEP FITIM /CONSTRAINT IS THAT SWEEPS INTERVAL IS >ITIM CON24B, DFIX KWTIM /TIME TO OPEN BUFFER WINDOWS LOAD FASI DFIX /GET ASI IN USEC ASI EJECT CON25, FRAME /"AVERAGE '----' SWEEPS" DIS25 JMP CON25 /CAN'T CHANGE JOBS OR SWEEP PARAMETERS DECARG JMP CON25 /FORMAT ERROR - ASK AGAIN CMA IAC DCA NSWEP /-# OF SWEEPS REQUIRED JMP CON26 /AUTO INDEX USE AXPNTR=10 BXPNTR=11
/GET PARAMETERS REQUIRED FOR DISPLAY WORD GENERATION PREDWS, 0 DCA ND /# OF CURVES TO FIT ON SCOPE ND=TEMP03 TAD ND /SET COUNT OF REQUIRED DISPLAY ENTRIES JMS SETCNS JMP I PREDWS /COUNT IS 0. EXIT CLA CMA /GET # OF COLUMNS REQUIRED TAD ND CLL RAR CLL RAR /(# OF CURVES/4)+1 IAC FLOAT SAVE FLOT01 /# OF COLUMNS TO FIT ON SCOPE TAD ND /HOW MANY ROWS? BRAN K0002 IAC /IF # OF CURVES IS 2, 2 ROWS (SCALE Y BY 2^1) SKP /IF # OF CURVES IS 1. 1 ROW (SCALE Y BY 2^0) TWO /OTHERWISE , 4 ROWS (SCALE Y BY 2^2) DCA YSS YSS=TEMP14 TWOK /#POINTS ON DISPLAY *2 FLOAT FDIV FLOT01 FIX DCA XZD /DISTANCE BETWEEN COLUMNS *2 XZD=TEMP15 TAD YSS /GET Y-ZERO FOR 1ST ROW IN COLUMNS BRAN K0002 TAD K0010 /4 ROWS, START AT Y=300 TAD K0020 /2 ROWS, START AT Y=200 DCA YZZ /1 ROW, START AT Y=000 YZZ=TEMP16 TAD YSS /GET Y-ZERO DECR TO GO FROM NTH TO N+1TH ROW CMA DCA TYSC TYSC=TEMP01 TAD KM0200 /(-200)/2^(Y-SCALE+1) CLL CML RAR ISZ TYSC JMP .-2 DCA YZD /0,-40,OR -20 YZD=TEMP17 TAD K1001A JMS PRESTY /SET UP FOR 1ST COLUMN JMP I PREDWS
/SUBROUTINE PRESETS Y AND X FOR NEW COLUMN PRESTY, 0 DCA XZ /X-ZERO IN AC XZ=TEMP20 TAD YZZ /RESET TO TOP OF COLUMN DCA YZW YZW=TEMP21 TAD KM0004 /4 ROWS (MAXIMUM) TO A COLUMN DCA UPCNT UPCNT=TEMP30 JMP I PRESTY /GET DISPLAY WORDS FOR A GROUP - ENTER WITH # OF PTS IN AC GETDWS, 0 CMA IAC /#OF POINTS TO DISPLAY FLOAT SAVE FLOT01 TAD XZD /DISTANCE BETWEEN COLUMNS FLOAT /2*ROOM AVAILABLE/#POINTS = X-DIST BETWEEN POINTS*2 FDIV FLOT01 TAD K0007 /SCALE BY 2^7 FIX /(DELTA-X)*2^8 AND K7760 /DELTAX(8),0(4) TAD YSS /DELTAX(8),Y-SCALE(4) DCA I AXPNTR /THIS IS D1. TAD XZ /GET X-ZER0*2 RTL AND K7700B /X-ZER0(6),0(6) TAD YZW /X-ZERO(6),Y-ZERO(6) DCA I AXPNTR /THIS IS D2. TAD YZW /MOVE TO NEXT ROW TAD YZD AND K0077C DCA YZW ISZ UPCNT /4 COLUMNS DONE? JMP .+4 /NO-CONTINUE TAD XZ /YES-MOVE TO NEXT COLUMN TAD XZD JMS PRESTY /SET UP FOR NEXT COLUMN. ISZ CHCNT /ALL GROUPS COMPLETE? JMP I GETDWS /NO-EXIT AT CALL+1 ISZ GETDWS /YES-EXIT TO CALL+2 JMP I GETDWS
/SET COUNT OF # OF GROUPS SETCNS, 0 SNA JMP I SETCNS /0, EXIT AT CALL+1 CMA IAC DCA CHCNT CHCNT=TEMP13 ISZ SETCNS /NOT 0, EXIT AT CALL+2 JMP I SETCNS /LOCAL CONSTANTS K0077C, 0077 K7700B, +7700 K0020, +0020 KM0200, -0200 K7760, +7760 K0010, 10 /MAKE UP DISPLAY ENTRIES FOR JOBS AND CHANNELS CON26, TAD ADJLIS /MAKE UP JOB DISPLAY WORDS DCA AXPNTR TAD TNJOB /NUMBER OF CURVES ON SCOPE JMS I PREDWX CON26A, TAD AXPNTR /SKIP J1,J2,J3 TAD K0003 DCA AXPNTR TAD I AXPNTR /J4 HOLDS -#OF POINTS ISZ AXPNTR /SKIP OVER J5 JMS I GETDWX /J6 AND J7 ARE DISPLAY WORDS JMP CON26A /DO NEXT JOB TAD ADCHNL /ALL DONE DCA AXPNTR /MAKE UP CHANNEL DISPLAY WORDS TAD NCHA /GET NUMBER OF CHANNELS IN ALL TAD NCHB JMS I PREDWX /DIVIDE UP SCOPE FOR TOTAL # OF CHAN TAD NCHA JMS I SETCNX /SET COUNT OF DISPLAYS WITH "SAMA" POINTS JMP CON26B /NONE-TRY LO-RESOLUTION TAD SAMA /SET UP DISPLAY FOR HI CHANS JMS I GETDWX JMP .-2 CON26B, DCA I AXPNTR /EOL WORD FOR HI INPUTS TAD NCHB /SET COUNT OF DISPLAYS WITH "SAMB" POINTS JMS I SETCNX JMP CON26C /NONE-GO TO MODIFY TAD SAMB /SET UP DISPLAY FOR LO CHANS JMS I GETDWX JMP .-2 CON26C, DCA I AXPNTR /EOL WORD FOR LO INPUTS
/DISPLAY AND MODIFY INPUT PRESENTATION TAD ADCHNL /GET X-MAXIMA FOR EACH INPUT DCA AXPNTR TAD ADBUFA /PUT IN ADC BUFFER DCA BXPNTR TAD I ADCHNL /PUT 1ST CHAN IN ADMPXA DCA I ADMPXA TAD SAMA /GET HI RESOLUTION X-MAX'S JMS I XMAXX JMP .-2 TAD SAMB /GET LO RESOLUTION X-MAX'S JMS I XMAXX JMP .-2 DCA TMOD /TMOD=0 FOR NO MODIFICATIONS TMOD=TEMP16 CON27, TAD ADCHNL /DISPLAY WORDS BEGIN AT ADCHNL-1 JMS I CON1SX FRAME /"$FA41INPUTS$AP21" DIS27 NOP /THIS IS SKIPPED JMS I CRBRAX /BRANCH ON KEYBOARD JMP .+3 /NO CHARACTER JMP CON29 /C.R.:ALLOCATION OK NOP /L.F. FORGET IT CLA CMA /OTHER: GET CHANNEL NUMBERS IN ORDER TAD ADMPXA DCA CXPNTR CXPNTR=12 CON27A, JMS SDISS JMP CON27B /OUT OF HI CHANNELS-GO TO LOW TAD K1000B /PUT "H@" IN SWEEP MESSAGE JMS I CON2SX /DISPLAY DOTS AND MESSAGE JMP CON27A /GET NEXT CHANNEL CON27B, ISZ CXPNTR /SKIP OVER FIRST OF HI JMS SDISS JMP CON27 /OUT OF CHANNELS, RESTART TAD K1400 /PUT "L@" IN SWEEP MESSAGE JMS I CON2SX /DISPLAY DOTS AND MESSAGE JMP CON27B+1 /LOCAL CONSTANTS K1000B, 1000 K1400, 1400 KM0006, -0006
/LOCAL CROSSPAGE XMAXX, XMAXS OTTY, CON30-1 CON1SX, CON1S CON2SX, CON2S CRBRAX, CRBRAS GETDWX, GETDWS PREDWX, PREDWS SETCNX, SETCNS /THIS SUBROUTINE DECODES DISPLAY WORDS: SDIS /POINTER IS AUTOINDEX REGISTER "AXPNTR" /CALL: SDIS / END OF LIST RETURN / NORMAL RETURN SDISS, 0 TAD I AXPNTR /DX (8),YS(4) SNA JMP I SDISS /EOL IF D1=0, RETURN TO CALL+1 DCA SHFR+1 TAD SHFR+1 AND K0017 /HAVE Y SCALE FACTOR DCA YS YS=TEMP17 DCA SHFR /0 TO HI FAC TAD K0004 IAC SHFT /MOVE BINARY POINT TO END OF SHFR+1 SAVE /DX(8) IS INTEGER PART (5), FRACTIONAL PART (3) DELTAX TAD I AXPNTR /XZ(6),YZ(6) DCA SHFR+1 TAD K0004 /MOVE YZ TO 10 SIGNIF, BITS SHFT TAD SHFR+1 DCA YZ /POSITION OF Y-ZERO YZ=TEMP20 TAD KM0006 /MOVE XZ TO 10 BITS OF SHFR+1 SHFT TAD SHFR+1 AND KM0006 /7772 - IGNORE SCALE PART (MOSTLY) DILX /LOAD X DCA DBLARG /DBLARG & DBLARG+1 HOLD X-POSITION ISZ SDISS /EXIT TO CALL+2 JMP I SDISS
/SUBROUTINE SCALES, BIASES, AND DISPLAYS Y: YDIS /USES "YS", "YZ", FROM SDIS, Y VALUE IN DBLAC AT CALL YDISS, 0 DCA SHFR /VALUE TO BE SCALED, BIASED TAD YS /SCALE IT CMA IAC SHFT TAD YZ /ADD BIAS TAD SHFR /GET SCALED VALUE DILY /DISPLAY IT CLA DISD JMP .-1 DIXY JMP I YDISS CON29, DCA I ADMPXA /REPLACE EOL FOR JOB LIST LOAD /ASI BETWEEN SYNCS FITIM DFIX /FIX TO DOUBLE-WORD KITIM TAD ADBUFA /PUT X-MAXIMUMS IN ADC BUFFER DCA BXPNTR TAD ADJLIS /TAKE PARAMETERS FROM JOB LIST DCA AXPNTR CON29A, TAD I AXPNTR /LOOK AT J1 SNA CLA JMP I OTTY /J1=0,END OF LIST ISZ AXPNTR /SKIP J2,J3 ISZ AXPNTR TAD I AXPNTR /J4 HAS # OF POINTS ISZ AXPNTR /SKIP J5 JMS I XMAXY /FIND MAX-X USING J6 AND J7 JMP I CON29B /GET NEXT JOB DCA TMOD /MODIFY WHICH? -0 (NONE) TO BEGIN WITH CON30, TAD ADJLIS JMS I CON1SY /INITIALIZE POINTERS & COUNTERS FRAME /"$EA41AVERAGES$" DIS30 CON1SY, CON1S /SKIPPED JMS CRBRAS /BRANCH ON CR OR LF JMP CON30A /NEITHER CR OR LF JMP CON32 /C.R.:ALLOCATION OK JMP CON30A /L.F.:CHANGE ALLOCATION /LOCAL CROSSPAGE SDISZ, SDISS CON29B, CON29A
CON30A, TAD I AXPNTR /DISPLAY AVERAGES ALLOCATIONS SNA CLA /J1=0? JMP CON30 /YES-START OVER ISZ AXPNTR /SKIP J2 AND J3 ISZ AXPNTR TAD I AXPNTR /J4 HAS # OF POINTS DCA TPSAVE TPSAVE=TEMP02 ISZ AXPNTR /SKIP J5 JMS I SDISZ /SET UP DISPLAY: J6 J7 ARE DISPLAY WORDS DLIMX, DLIMS /SKIPPED SETH DIS30A /DISPLAY LIMIT DOTS AND JOB # JMS I DLIMX /LIMIT DOTS, PUT JOB # IN BUFFER SETH DIS30A /JOB# LDH JMS I DSCX JMP .-2 JMP CON30A /GET NEXT JOB
F4K, 0015 2000 0000 TEMP, 0 0 0
/LOCAL CROSSPAGE XMAXY, XMAXS DSCX, DSCS /SUBROUTINE TO BRANCH AND ECHO KBD CR OR LF CRBRAS, 0 KSF /KEYBOARD STRUCK? JMP I CRBRAS /NO-EXIT TO CALL+1 KRB /YES- READ IT IN BRAN /CHECK FOR CR OR LF CRLF ISZ CRBRAS /LF - EXITS TO CALL+3 SKP /CR - EXITS TO CALL+2 JMP I CRBRAS /OTHER - EXITS TO CALL+1 TAD KCR /FOR CR OR LF - TYPE CRLF TYPE ISZ CRBRAS /EXIT TO CALL+2(CR) OR CALL+3(LF) JMP I CRBRAS
*4372 /OUTPUT CONTROL TAPE OR MODIFY MEMORY CON32, FRAME /"PUNCH CONTROL TAPE? '-' DIS32 /(Y: YES)" JMP CON32 /LF: CAN'T GO BACK - ASK AGAIN DCA TENPUN /INITIALIZE FOR "NO PUNCH" TENPUN=TEMP30 ALPHA /GET RESPONSE BRAN YESNO ISZ TENPUN /Y: YES, TENPUN=1 TO ALLOW PUNCHING CLA /*** TITLE NOT ASKED,A MS. DEVICE WRITTEN ON. SNA CLA /OTHER JMP CON32B /NO PUNCH - DON'T ASK FOR TITLE CON32A, FRAME /"TITLE: DIS32A /'-------------'" JMP CON32A /LF: ASK AGAIN JMS I INITOX /INITIALIZE SYS DEVICE (OUTPUT) TAD TXMRK /MOVE HALFWORD POINTER TO TITLE SRCH K0006B, 0006 /SKIPPED JMS I TITLEX /VISUAL MODE TITLE ON TAPE TXPUN /DO 3 CRLF'S TXCRLF SETH /REPOSITION HALFWORD POINTER TO TITLE DIS32A TPUNQ /OUTPUT TITLE TO SYS DEV. CON32B, TXPUN /"<CRLF>SWEEP SUMMARY<CRLF>" TXT32 TXPUN /OUTPUT SUMMARY DIS09 /END WITH 2 CRLF'S TXPUN /" AVERAGES TXT32A /CHAN RATE TYPE SORT<CRLF>" CON33, TAD ADJLIS /GO THRU JOB LIST FOR THIS INFO IAC DCA TOPNT TOPNT=TEMP07
CON33A, SETH /".XX.....X....X....XXX<CRLF>"IS FORMAT TXT33A TAD I TOPNT /GET J1 SNA /J1=0? JMP I CON34X /YES-END OF JOB LIST DCA SHFR /J1 = A/B(1), CHAN#(5), 1(1), CHAN ORDER (5) ISZ TOPNT TAD I TOPNT /J2=TYPE (4), SORT CODE (8) DCA SHFR+1 TAD SHFR+1 /GET SORT CODE AND K0377 DCA TCNTG TCNTG=TEMP03 TAD KM06 /SHIFT J1,J2 RIGHT 6 SHFT TAD SHFR /CHAN # IN AC7-11 AND K0037B DCA TCHN TCHN=TEMP04 MTW /MOVE JOB TYPE TO SHFR+1 BITS 8-11 SHFT TAD SHFR /SIGN EXTENSION IN SHFTS SO BIT 0 OF SHFR HOLDS A/B SPA CLA TAD K0004 /L FOR LO TAD K4010 /H FOR HI DCA I TXT33X /PUT IT IN MESSAGE TAD SHFR+1 AND K0017 /GET TYPE DCA TJOB TJOB=TEMP05 /OUTPUT CHAN # TO BUFFER TAD TCHN OCTOUT TAD TJOB /OUTPUT TYPE TO BUFFER OCTOUT TAD TCNTG /OUTPUT SORT CODE TO BUFFER OCTOUT TXPUN /OUTPUT BUFFER TO TTY TXT33A TAD K0006B /MOVE TO NEXT J1 TAD TOPNT DCA TOPNT JMP CON33A /DO NEXT JOB
/SUBROUTINE TO DISPLAY DOTS AT EXTREMA,POSITION, DSC,AND SEQ. DLIMS, 0 TAD FOP+1 /SET X TO X-ZERO DILX CLA IAC TAD KM1000 /SET Y TO BOTTOM JMS I YDISX /DISPLAY LOWER LEFT DOT TAD K0777 /SET Y TO TOP JMS I YDISX /DISPLAY UPPER LEFT TAD I BXPNTR /SET X TO MAX DILY /DISPLAY UPPER RIGHT DISD JMP .-1 DIXY CLA IAC TAD KM1000 /SET Y TO BOTTOM JMS I YDISX /DISPLAY BOTTOM RIGHT TAD FOP+1 /POSITION DSC DCA I XDSCX TAD YZ /IN MIDDLE RIGHT OF FIELD DCA I YDSCX ISZ TDCNTR /NEXT SEQUENCE # TAD TDCNTR /PUT IT IN MESSAGE FOR DISPLAY OCTOUT JMP I DLIMS /LOCAL CROSSPAGE XDSCX, CHXL YDSCX, CHYL YDISX, YDISS K0777, 777 /SUBROUTINE TO INITIALIZE PARAM POINTERS AND DISPLAY MESSAGE CON1S, 0 DCA AXPNTR /POINTER TO DISPLAY WORDS TAD ADBUFA /POINTER TO X-MAX LIST DCA BXPNTR DCA TDCNTR /SET SEQUENCE # TO 0 TDCNTR=TEMP14 TAD TMOD /SET MODIS COUNTER DCA TMDCNT TMDCNT=TEMP15 JMP I CON1S
/SUBROUTINE TO DISPLAY LIMIT DOTS WITH MESSAGE FOR INPUT DISPLAY CON2S, 0 DCA I DIS27X /PUT SWEEP TYPE IN MESSAGE SETH /"XX:XX,X" DIS27A JMS DLIMS /DISPLAY LIMIT DOTS AND FILL ITEM # TAD I CXPNTR /GET CHANNEL NUMBER AND K0037B OCTOUT /FILL SPACE FOR CHAN # IN MESSAGE SETH /DISPLAY THE MESSAGE DIS27A LDH JMS I DSCY JMP .-2 JMP I CON2S /LOCAL CROSSPAGE DSCY, DSCS DIS27X, DIS27A+5 /LOCAL CONSTANTS KM1000, -1000 K4010, 4010 K0037B, 0037 KM06, -6 /LOCAL CROSSPAGE INITOX, INITOS TPUNQ=JMS I . TPUNQS TXPUN=JMS I . TXPUNS TITLEX, TITLES TXT33X, TXT33A+4 CON34X, CON34
*4603 /SUBROUTINES TO HANDLE DISPLAY IO [SU46AB] /HAND READABLE PUNCH SUBROUTINE: TITLE HCNTR=TEMP02 /CALL: SETH / ADDR OF TEXT TO BE USED IN TITLE / TITLE TITLES, 0 TAD K0377 /PUNCH A RUBOUT (BRACKET TITLE WITH RUBOUTS) JMS I PUNX1 JMP PSKIP-1 /PUNCH A SPACE (6-200 CODES) HRNXT, LDH /GET 6 BIT CHAR CLL RAL TAD ADRTBL /FIND ENTRY IN DISPLAY TABLE DCA PNTR TAD I PNTR /GET THE ENTRY SNA CLA /SEE IF SPECIAL CHARACTER JMP HRCHK /SPECIAL - FIND OUT WHAT TO DO JMS I SHPX1 /SAVE HALFWORD POINTER FOR MORE CHARACTERS TAD KM0004 /FOUR HALF WORDS TO A CHARACTER DCA HCNTR SETH PNTR, 0 /SET UP POINTER FOR TABLE PUNCH HRPUN, LDH /GET LINE TAD K0200A /8 HOLE PUNCHED TOO JMS I PUNX1 /PUNCH THE LINE ISZ HCNTR JMP HRPUN /MORE HALVES JMS I RHPX1 /ALL PUNCHED - RESTORE TEXT POINTER MTW /SKIP TWO LINES JMP PSKIP HRCHK, ISZ PNTR /SPECIAL CHAR FIND OUT TAD I PNTR /WHAT TO DO SMA SZA /SPACE OR END OF TEXT? JMP HRNXT /NO, IGNORE AND GET NEXT CHARACTER SNA CLA /END OF TEXT? JMP TILEND /YES - GO PUNCH RUBOUT AND EXIT LDH /SPACE - SEE IF NEXT CHARACTER IS A SPACE TAD KM040A SNA CLA JMP .-3 /YES - COMPRESS MULTIPLE SPACE TO 1 SPACE JMS I DHPX2 /MOVE BACK HALFWORD POINTER TAD KM006 /AND PUNCH A SPACE EJECT PSKIP, DCA HCNTR /PUNCH 6 LINES OF 200 CODE TAD K0200A JMS I PUNX1 ISZ HCNTR /DONE 6 LINES? JMP .-3 /NO - CONTINUE JMP HRNXT /YES - GET NEXT CHARACTER TILEND, TAD K0377 /PUNCH A RUBOUT AND EXIT JMS I PUNX1 JMP I TITLES
/LOCAL CONSTANTS KM006, -6 KM040A, -40 ADRTBL, DSCTBL /LOCAL CROSSPAGE PUNX1, PUNCHS /PUNCH A CHARACTER DHPX2, DHPS /MOVE BACK 1 CHARACTER /SUBROUTINE TO DO Q AND A BETWEEN TTY AND DIS: FRAME / FRAME / [FRAME NAME /ADDRESS OF TEXT TO BE DISPLAYED / L.F. RETN /L.F. AT ANYTIME RETURNS HERE / C.R. RETN /C.R. AFTER FINAL BLANK RETURNS HERE FRAMES, 0 CLA TAD I FRAMES /GET ADDRESS DCA FRSET ISZ FRAMES /MOVE RETURN TO CALL+2 JMS FRSETH /MOVE POINTER TO START OF TEXT JMS I TXIX /PUT BLANK MARKS IN KBD AREAS JMS FRDIS /DISPLAY THE TEXT JMS FRSETH /MOVE POINTER TO START OF TEXT FRQUES, TAD TXMRK /GET KBD AREA SRCH JMP FREND /END OF TEXT - EXIT FRLOOP, JMS I SHPX1 /SAVE TEXT POINTER JMS FRDIS /DISPLAY TEXT JMS I RHPX1 /RESTORE TEXT POINTER JMS I TXKX /ACCEPT A CHARACTER INTO BUFFER. JMP FRLOOP /NORMAL RETURN JMP FREND+1 /L.F. - EXIT TO CALL+2 JMP FRQUES /C.R. - GET NEXT KBD AREA FREND, ISZ FRAMES /NO MORE KBD AREAS TO FILL JMS FRSETH /REPOSITION TEXT POINTER JMP I FRAMES /EXIT FRSETH, 0 SETH /REPOSITION TEXT POINTER FRSET, 0 /TO START OF FRAME JMP I FRSETH FRDIS, 0 /DISPLAY THE FRAME SETH /INITIALIZE DISPLAY DSINIT LDH /X0,Y0,SIZE,INTENSITY JMS I DSCX1 JMP .-2 JMS FRSETH /REPOSITION TEXT POINTER LDH /DISPLAY THE CHARACTERS JMS I DSCX1 /OF THE FRAME JMP .-2 JMP I FRDIS /TEXT ENDED
/DISPLAY INITIALIZE DSINIT, 4411 /$AH10@ 1010 /X=000, Y=001, SIZE=10, 0000 /LOCAL CROSSPAGE TXIX, TXIS /PUT BLANKMARKS IN KBD ENTRIES TXKX, TXKS /GET KBD INTO KBD AREA DSCX1, DSCS /DISPLAY CHARACTER RHPX1, RHPS /RESTORE HALFWORD POINTER SHPX1, SHPS /SAVE HALFWORD POINTER /THIS SUBROUTINE GETS OCTAL ARGUMENT: OCTARG OCTOP=ARITH4 OCTARS, 0 JMS I ARSETX /GET TO KBD - ENTRY OCNEXT, LDH /GET CHARACTER BRAN OCSORT /IS IT SPACE OR TXMRK? JMP OCNEXT /SPACE IGNORE JMP OCEND /TXMRK - END JMS I STRNUX /OTHERS - IS IT A NUMERIC? JMP I OCTARS /NO - EXIT TO CALL+1 (ERROR RETURN) TAD KM007A /NUMERIC 0-7? SMA SZA CLA JMP I OCTARS /NO - ERROR RETURN LOAD /SHIFT ACCUMULATED SUM 3 LEFT OCTOP-1 /(MULTIPLIES BY 8) TAD STRSAV /ADD CURRENT DIGIT DCA OCTOP+1 TAD K0003 SHFT /NEW ACCUMULATED SUM DADD JMP OCNEXT /NEXT CHARACTER OCEND, TAD OCTOP /OVERFLOW ? SZA CLA JMP I OCTARS /YES - ERROR RETURN TAD OCTOP+1 /NO - GET ACCUMULATED SUM ISZ OCTARS /EXIT TO CALL+2 JMP I OCTARS /CONSTANTS THIS PAGE KM007A, -7 K0200A, 0200 ARSETX, ARSET STRNUX, STRNUM
*5000 /REQ: [SU60A],[SU64A]; THIS IS [SU50AC] /DISPLAY STRIPPED ASCII CHAR IN AC: DSC /CALL: LDH /GET HALFWORD / DSC /DISPLAY IF NON ZERO / JMP .-2 /DISPLAY THE NEXT HALFWORD /TEMPORARY STORAGE: CHCNT3=TEMP02 CHCNT2=TEMP03 CHCNT1=TEMP04 CHROT=TEMP05 CHFAC=TEMP01 CHPNT=TEMP06 CHYS=TEMP01 /DISPLAY TABLE EXCEPTIONS SPACE=7777 ENDIS=0 RESET=1 CRETN=2 IGNOR=3 DSCS, 0 CLL RAL /TWICE STRIPPED ASCII TAD ADSTBL /FOR TABLE POINTER DCA CHPNT TAD I CHPNT /GET DISPLAY WORD 1 ISZ CHPNT /SET FOR NEXT DISPLAY WORD 2 SNA /NOT SPECIAL CHARACTER? JMP CHSPEC /SPECIAL CHARACTER CHSET1, DCA CHROT /HOLDS ROTATED DISPLAY WORD TAD CHXL /MOVE TO NEXT X POSITION DILX MTW /NUMBER OF WORDS IS TWO DCA CHCNT3 CHSET2, MTW /NUMBER OF LINES PER WORD IS TWO DCA CHCNT2 CHSET3, TAD KM006A /NUMBER OF POINTS IN A LINE IS SIX DCA CHCNT1 TAD CHYL /REPOSITION Y AT BOTTOM OF CHARACTER DCA CHYS
CHDIS, TAD CHROT CLL RAL /GET DISPLAY BIT FOR THIS POINT INTO LINK DCA CHROT /STORE CODE WORD FOR NEXT POINT TAD CHYS /LOAD INTENSIFICATION POSITION DILY SNL /DISPLAY IF LINK=1 JMP .+4 DISD JMP .-1 DIXY TAD CHSIZ /GO NEXT POSSIBLE DOT DCA CHYS /KEEP RECORD OF PRESENT POSITION ISZ CHCNT1 /DO ALL THIS SIX TIMES JMP CHDIS TAD CHXL /MOVE X TO NEXT LINE TAD CHSIZ DILX DCA CHXL ISZ CHCNT2 /HAS SECOND HALF BEEN DONE? JMP CHSET3 /NO, DO IT TAD I CHPNT /GET SECOND WORD DCA CHROT /AND DISPLAY IT ISZ CHCNT3 JMP CHSET2 TAD CHSIZ /BOTH WORDS DONE - DO TWO EMPTY ROWS CLL RAL /(SPACE OVER 2 LINES) TAD CHXL DCA CHXL JMP I DSCS /THEN EXIT AT CALL+1 CHSPEC, TAD I CHPNT /SPECIAL CHARACTER-GET WORD 2 FOR BRANCH TAD CHJMP /SETUP FOR JMP TO DCA .+1 /SPECIAL ROUTINE JMP I CHJMPL /THIS IS THE JUMP /DISPATCH TABLE FOR ABOVE JMP CHJMPL, CHSPA /JUMP TABLE: SPACE CHEND /END OF TEXT CHREST /NEXT 4 CHARACTERS RESET X, Y, DELTA, INTENSITY CHCR /DO A CARRIAGE RETURN, LINE FEED CHEND+1 /IGNORE CHEND, ISZ DSCS /ATTEMPT TO DSC E.O.T. MARK JMP I DSCS /EXIT TO CALL +2CS /SPACE: MOVE X RIGHT 6 INCREMENTS EJECT CHSPA, TAD CHSIZ CLL RTL /4 TIMES SIZE DCA CHFAC TAD CHSIZ CLL RAL /PLUS 2 TIMES SIZE TAD CHFAC /IS SIX TIMES SIZE TAD CHXL /MOVE X POINTER LEFT DCA CHXL /ONE CHARACTER (6 LINES) JMP I DSCS
/$-DISPLAY RESET CHREST, LDH /NEXT HALFWORD "A"-"P" TAD KM0001 /GETS X POSITION AND K0017 /"A" IS LEFT MARGIN, "P" IS RIGHT MARGIN CLL RTL RTL RTL DCA CHXL /64 POINTS BETWEEN "A" AND "B" CHYPOS, LDH /NEXT HALF WORD GETS Y POSITION AND K0017 /"A"-"P" CLL RTL RTL RTL CMA IAC TAD K1001 /"A" IS TOP OF SCREEN. "B" IS BOTTOM DCA CHYL /64 POINTS BETWEEN "A" AND "B" CHCSZ, LDH /NEXT CHARACTER GETS SIZE OF CHARACTER -"4" IS NORMAL AND K0017 /ELIMINATE ALL BUT BITS 8-11 DCA CHSIZ /STORE DESIRED CHARACTER SIZE JMP I DSCS /CR-LF: RETURN X TO LEFT MARGIN, MOVE Y DOWN 8 INCREMENTS CHCR, TAD K1001 DCA CHXL /RESET X TO 0 TAD CHSIZ /8 TIMES CHAR SIZE CLL RTL RAL CMA IAC /SUBTRACT FROM Y POSITION TAD CHYL DCA CHYL /NEW Y POSITION JMP I DSCS /CONSTANTS USED THIS PAGE ONLY CHJMP, JMP I CHJMPL+1 ADSTBL, DSCTBL KM006A, -6 K1001, 1001 /VARIABLES FOR THIS PAGE CHXL, 0 /X LOCATION ON SCOPE CHYL, 0 /Y LOCATION OF CURRENT LINE CHSIZ, 0 /CHARACTER SIZE CONSTANT
/DISPLAY TABLE - PATTERN MATRICES FOR CHARACTERS DSCTBL, 0 /@ SPECIAL, MEANS END OF TEXT ENDIS 7711 /A 1177 7745 /B 4532 3641 /C 4122 7741 /D 4136 7751 /E 5141 7711 /F 1101 3641 /G 5132 7710 /H 1077 0077 /I 0000 2040 /J 4037 7714 /K 2241 7740 /L 4040 7706 /M 0677 7704 /N 1077 3641 /O 4136 7711 /P 1106 1621 /Q 3156
7711 /R 3146 2245 /S 4530 0101 /T 7701 7740 /U 4077 3740 /V 2017 7730 /W 4077 6314 /X 1463 0770 /Y 7007 6151 /Z 4543 0617 /[ DISPLAYED AS # 1706 1057 /\ DISPLAYED AS DOWN ARROW 1000 2313 /] DISPLAYED AS % 6462 0475 /^ 0400 0416 /_ 2504 0 /SPACE IS A SPECIAL CHARACTER SPACE 0057 /! 0000 0 /" SPECIAL, MARKS PROG INPUT TO TEXT, NOT DISPLAYED IGNOR 0 /# SPECIAL, IGNORES IGNOR
0 /$ SPECIAL, DISPLAY RESET FOLLOWS RESET 0 /% SPECIAL, DOES CARRIAGE RETURN CRETN 4040 /& - USED IN Q&A BLANKS 4040 0 /' SPECIAL, MARKS KBD INPUT TO TEXT, NOT DISPLAYED IGNOR 7741 /( DISPLAYED AS [ 4100 0041 /) DISPLAYED AS ] 4177 2214 /* DISPLAYED AS LITTLE X 1422 0010 /+ 3410 0050 /, 3000 0404 /- 0400 0040 /. 0000 2010 // 0402 3651 /0 4536 0042 /1 7740 6251 /2 5146 2241 /3 4532 1412 /4 7710 2745 /5 4531
3645 /6 4530 4111 /7 0503 3245 /8 4532 0651 /9 5136 2400 /: 0000 0040 /; 3200 1422 /< 4100 0012 /= 1212 4122 /> 1400 0251 /? 0502
/FLOATING VARIABLES FLOT03, 0 0 0 FLOT04, 0 0 0 FLOT05, 0 0 0 FLOT06, 0 0 0 FLOT07, 0 0 0 FLOT10, 0 0 0 /TTY-LST CRTX, 45 /CR -47 /TXMRK
*5400 /SUBROUTINES TO HANDLE FLOATING, DECIMAL, AND OCTAL IO [SU54AB] /REQUIRES [SU60A] [SU62A], [SU63A], [SU64A] /SUBROUTINE CONVERTS AC TO OCTAL CHARACTERS ON HALFWORD BUFFER: OCTOUT /USES TEMP01-02 OCTOUS, 0 DCA SHFR+1 /PUT AC IN LOW ORDER SHIFT REGISTER TAD KM0004 /GET 4 CHARACTERS DCA OCNT OCNT=TEMP02 TAD KM0004 /AC=0 STORES AS "0 " DCA LSWIT TAD PROMRK /LOOK FOR ENTRY AREA SRCH MPRMRK, -42 /SKIPPED-PRESUME THERE IS AN ENTRY AREA LEFT OCVROT, TAD K0003 /OCTAL CHARACTER REPRESENTS 3 BITS SHFT TAD SHFR /# IS IN LEFT 3 BITS OF AC AND K0007 JMS OUTCH /OUTPUT THE # K0060, 0060 /LEADING 0 OR NO ROOM - "AND" WITH 0 IS NOP ISZ OCNT /MORE CHARACTERS? JMP OCVROT /YES-CONTINUE TAD KM0020 /NO-FILL REMAINING AREA WITH SPACES JMS OUTCH JMP I OCTOUS /AREA IS FULL-EXIT JMP .-3 /PUT IN SPACES /GENERALIZED NUMERICAL OUTPUT ROUTINE /SUBROUTINE STORES A CHAR AWAY IF NOT A LEADING 0 AND THERE IS ROOM /EXITS TO CALL+1 IF THESE CONDITIONS NOT MET, CALL+2 IF THEY ARE /TEMPORARY STORAGE ALLOCATION STOR=TEMP01 EJECT OUTCH, 0 ISZ LSWIT /IS THIS A LEADING ZERO? SZA /IT'S LEADING SKP JMP I OUTCH /AND IT'S A ZERO-EXIT TO CALL+1 DCA STOR /NO-NOT A LEADING ZERO. CLA CMA /FIX UP LEAD SWITCH DCA LSWIT LDH /IS THERE ROOM IN THE BUFFER? TAD MPRMRK SNA CLA JMP I OUTCH /NO MORE ROOM-EXIT TO CALL+1 TAD STOR /ROOM AVAILABLE-MAKE 6BIT OUT OF #. TAD K0060 JMS I STHX1 ISZ OUTCH /PUT IT AWAY JMP I OUTCH /EXIT TO CALL+2
/SUBROUTINE CONVERTS FLOATING AC TO ASCII STRING: FLTOUT /TEMPORARY STORAGE ALLOCATION FCVCNT=TEMP14 DIGIT=TEMP13 PERCNT=TEMP15 ZSWIT=TEMP16 FLTOUS, 0 DCA CHEXP TAD PROMRK /LOOK FOR A PLACE TO PUT CHARACTERS SRCH KM0033, -33 /SKIPPED TAD FAC+1 SPA CLA /PUT IN A "-" OR A SPACE DEPENDING UPON SIGN TAD K0015 TAD KM0020 JMS OUTCH /PUT OUT CHARACTER CHEXP, 0 /A NOP-BUT NOT REACHED ANYWAY TAD FAC+1 SPA CLA /GET .ABS. FAC DCOM SAVE REMAIN /SET UP FOR RADIX DEFLATION TAD KM011 DCA FCVCNT /WE WILL LOOK AT 9 POWERS OF 10 DCA LSWIT /ENABLE SEARCH FOR LEADING 0'S CLA CMA DCA ZSWIT /DETECT FIRST NON ZERO LEAD LOAD /HOW MANY 100,000,000'S K100MF CVLOOP, SAVE /HOW MANY MULTIPLES OF RADIX? RADIX LOAD /DEFLATE REMAIN FDIV RADIX FIX /# OF MULT. OF RADIX DCA DIGIT TAD DIGIT /GET REMAINDER FLOAT FMUL RADIX DCOM FADD REMAIN SAVE REMAIN TAD DIGIT /PUT DIGIT OUT INTO BUFFER JMS OUTCH JMP CVRLZ /LEADING ZERO OR NO MORE ROOM ISZ ZSWIT /FIRST NON-ZERO? JMP CVRNZ /NO TAD KM0033 /YES, PUT "U" IN MULTIPLIER DCA CHEXP
TAD FCVCNT /U:1-3, M:4-6, SPACE: 7-9=-FCVCNT TAD K0003 /9+FCVCNT (-) IS # OF LEADING ZEROES SMA /M OR SPACE? JMP CVRLZ /NEITHER, MULTIPLIER IS U, NO PERIOD TAD K0003 SPA JMP CVRSP /MULTIPLIER IS SPACE TAD KM0003 /MULTIPLIER IS M, COUNT UNTIL "." DCA PERCNT /3, 2, OR 1 CHARACTERS UNTIL "." TAD KM0043 /PUT M IN MULTIPLIER JMP .+3 CVRSP, DCA PERCNT /3,2,OR 1 CHARACTERS BEFORE "." TAD KM0020 /PUT SPACE IN MULTIPLIER DCA CHEXP TAD KM0004 /AND PUT ONLY 4#'S IN BUFFER DCA FCVCNT CVRNZ, ISZ PERCNT /NON-ZERO ENTRY WAS MADE JMP CVRLZ /NOT YET TIME FOR "." MTW /PUT IN THE "." JMS OUTCH KM0020, -20 /THIS INSTRUCTION IS SKIPPED CVRLZ, LOAD /REDUCE THE RADIX BY A FACTOR OF 10 RADIX FDIV K10F ISZ FCVCNT /HAD ENOUGH? JMP CVLOOP /NO-CONTINUE TAD KM0020 /FILL REMAINING WITH SPACES JMS OUTCH SKP JMP .-3 CVREND, TAD PROMRK /MOVE TO FILL EXPONENT CHARACTER SRCH KM011, -11 TAD CHEXP /STORE IT JMS OUTCH JMP I FLTOUS TAD KM0020 /NOW FILL REMAINING WITH SPACES JMP .-3 /LOCAL VARIABLES LSWIT, -1 /-1 TO ACCEPT LEADING ZEROS /LOCAL CROSSPAGE STHX1, STHS /STH SUBROUTINE /LOCAL CONSTANTS KM0003, -3
/TTY-LISTS USED TO SCAN FLOATING ARGUMENTS MODCHR, K0015, 15 /M -40 /SPACE FLSORT, 56 /. 47 /' 55 /- -40 /SPACE K10F, 0004 2400 0000 /THIS SUBROUTINE SCANS FOR DECIMAL ARGUMENT: DECARG DECARS, 0 JMS ARSET /POSITION HALFWORD POINTERS DECNXT, LDH BRAN /LOOK FOR SPACES AND TXMRKS OCSORT JMP DECNXT /SPACE - IGNORE JMP DECEND /TXMRK JMS STRNUM /OTHERS-STRIP OFF 60 JMP I DECARS /NOT A (6BIT) NUMERAL TAD KM0011 /0-9 ARE ALLOWED SMA SZA CLA JMP I DECARS /NOT A DECIMAL NUMERAL TAD STRSAV /MULTIPLY PREVIOUS ACCUMULATION BY 10 JMS DX10 JMP DECNXT DECEND, TAD DBLARG /CHECK FOR OVERFLOW SZA CLA JMP I DECARS /GREATER THAN 4095, EXIT TO CALL+1 TAD DBLARG+1 /ARGUMENT OK-EXIT AT CALL+2 ISZ DECARS JMP I DECARS
/THIS SUBROUTINE MULTIPLIES DXAC BY 10 AND ADDS CURRENT STRIPPED CHARACTER [IN AC] /TEMPORARY STORAGE ALLOCATION DXCHAR=TEMP02 DX10, 0 DCA DXCHAR /AC HOLDS NEXT # TO ADD LOAD DBLARG-1 CLA IAC /GET 2 * OLD SUM SHFT SAVE /STORE IT DBLARG-1 TWO /GET 8 * OLD SUM SHFT DADD /ADD TO 2 * OLD SUM TAD DXCHAR DCA DBLAC+1 /ADD NEXT # DCA DBLAC DADD JMP I DX10 /10 * OLD SUM + NEXT# /THIS SUBROUTINE SCANS FOR FLOATING ARGUMENT AND LEAVES IN FAC: FLTARG /ARITHMETIC REGISTER ALLOCATION FLOPR=ARITH4 /TEMPORARY STORAGE ALLOCATION FLCHAR=TEMP01 FRCNT=TEMP13 FLSGN=TEMP14 FLTARS, 0 JMS ARSET DCA FRCNT /DECIMAL POINT INDICATOR CLA CMA DCA FLSGN /SIGN INDICATOR FLNEXT, LDH /GET NEXT CHARACTER FROM BUFFER BRAN FLSORT /SPECIAL CHARACTERS JMP FRCHK /. - CHECK FRCNT AND SET IT JMP FLTMOD /TXMRK - GO TO STAGE 2 DCA FLSGN /- - SET SIGN = 0 JMP FLNEXT /SPACE - IGNORE JMS STRNUM /OTHER - CHECK FOR 0,...,9 JMP I FLTARS /NOT NUMERIC: ERROR RETURN TAD KM0011 /GREATER THAN 9? SMA SZA CLA JMP I FLTARS /YES: ERROR RETURN TAD FLCHAR /NO, IN RANGE 0-9 JMS DX10 /INCREASE RESULT ISZ FRCNT /ENOUGH CHARACTERS? JMP FLNEXT /NO JMP I FLTARS /YES-MORE THAN 3 DIGITS IN FRACTION-EXIT FRCHK, TAD KM0004 /ALLOW 3 DIGITS TO RIGHT OF "." DCA FRCNT JMP FLNEXT
FLTMOD, LOAD /GET MODIFY CHARACTER DBLARG-1 NORM /MAKE FLOATING POINT OF FIRST PART DCA FAC TAD FRCNT /HOW MANY DIGITS TO RIGHT OF DECIMAL? SPA CLA /POS INDICATES 0 DIGITS TO RIGHT JMP .+3 TAD KM0004 /DIGITS TO RIGHT -4="FRCNT" DCA FRCNT ALPHA /GET "M" OR "SPACE" BRAN MODCHR TAD K0003 /M SKP /SPACE JMP I FLTARS /OTHER-ERROR RETURN TAD KM0002 /MULTIPLIER IS 10^[2+(-FRCNT)] IF "SPACE", 3 LESS IF "M" TAD FRCNT SMA SZA /.GT. 0 MEANS ERROR, FRACTION OF U JMP FLEND SNA JMP FLDONE /IF MULT IS 10^0,DONE DCA FRCNT /IF NOT. SET UP LOOP COUNT FMUL K10F ISZ FRCNT JMP .-3 FLDONE, ISZ FLSGN /NOW ADJUST SIGN DCOM ISZ FLTARS /RETURN TO CALL+2 IF OK LDH /MOVE OVER NEXT CHAR (TXMRK) FLEND, CLL CLA JMP I FLTARS /EXIT /THIS SUBROUTINE DOES GENERALIZED NUMERICAL INPUT - STRIPS 60 AND STORES /TEMPORARY STORAGE ALLOCATION STRSAV=TEMP01 STRNUM, 0 TAD BSAVE /CHAR ASSUMED IN TEMP02 TAD KM0060 /6BIT MUST BE .GE. 60 SPA JMP STRERR /IF NOT IS NOT A CHARACTER DCA STRSAV /STORE STRIPPED CHARACTER IN TEMP02 TAD STRSAV /AND LEAVE IN AC ISZ STRNUM JMP I STRNUM STRERR, CLL CLA JMP I STRNUM
/THIS SUBROUTINE INITIALIZES INPUT POINTERS /ARITHMETIC REGISTER ALLOCATION AROP=ARITH4 ARSET, 0 TAD TXMRK /MOVE TO INPUT REGION SRCH KM0002, -2 /THIS LOCATION SKIPPED DCA AROP /CLEAR SUM REGISTER DCA AROP+1 JMP I ARSET /LOCAL CONSTANTS KM0060, -60 KM0011, -11 /FLOATING VARIABLES FLOT01, 0 0 0 RADIX=FLOT01 FLOT02, 0 0 0 REMAIN=FLOT02
*6000 /HALFWORD AND TEXT HANDLERS [SU60AB] - REQUIRES [SU63A] /TEMPORARY STORAGE ALLOCATION HSAVE=TEMP01 /SET H WORD POINTERS TO FIRST HALF OF AC HELD ADDRESS: SETH /TYPICAL CALLING SEQUENCE / SETH / ADDRESS / RETURN SETHS, 0 TAD I SETHS /GET ADDRESS FROM CALL+1 DCA HPNT2 /PUT IT IN LDH POINTER CMA /LEFT HALF DCA HSW2 ISZ SETHS /EXIT CALL+2 JMP I SETHS /SAVE H WORD POINTERS: SHP SHPS, 0 CLA TAD HPNT2 /GET LDH POINTERS DCA HPSV /ADDRESS TAD HSW2 /HALF WORD DCA HSWSV JMP I SHPS /RESTORE HWORD POINTERS TO SAVED VALUES: RHP RHPS, 0 CLA TAD HPSV /GET SAVED POINTERS DCA HPNT2 TAD HSWSV /PUT IN LDH POINTERS DCA HSW2 JMP I RHPS /DECREMENT HALF-WORD POINTER: DHP DHPS, 0 CLA CMA ISZ HSW2 /SKIP IF LEFT HALF JMP HPD2 /RIGHT HALF TAD HPNT2 /LEFT HALF, MOVE TO RIGHT HALF OF PREVIOUS WORD DCA HPNT2 JMP I DHPS HPD2, DCA HSW2 /RIGHT HALF, MOVE TO LEFT HALF, SAME WORD JMP I DHPS
BSW=7002 /HALF WORD LOAD AC: LDH LDHS, 0 /GET HALF WORD AND MOVE POINTER TO NEXT HALF CLL CLA /PUT LDH POINTERS IN STH POINTERS TAD HSW2 DCA HSW1 TAD HPNT2 DCA HPNT1 /WHICH HALF ARE WE ON? ISZ HSW2 /RIGHT JMP LDH2 /LEFT TAD I HPNT2 AND K7700H BSW JMP I LDHS LDH2, CMA /SET POINTER TO LEFT HALF (HSW2) DCA HSW2 TAD I HPNT2 AND K0077 /GET HALFWORD ISZ HPNT2 /NEXT HALF IS LEFT HALF OF NEXT WORD JMP I LDHS /HALF WORD STORE AC - FROM PLACE LDH WAS DONE: STH STHS, 0 AND K0077 /SAVE RIGHT HALF OF AC ISZ HSW1 /STORE IN FIRST OR SECOND HALF? JMP STH2 /SECOND (RIGHT) HALF CLL RTL /POSITION IN LEFT HALF RTL RTL DCA HSAVE TAD I HPNT1 /GET OLD WORD FROM TEXT BFFER AND K0077 /CLEAR LEFT HALF JMP STH3 /GO STORE NEW VALUE STH2, DCA HSAVE /RIGHT HALF TAD I HPNT1 /GET OLD WORD AND K7700H /CLEAR RIGHT HALF STH3, TAD HSAVE /STORE WITH NEW VALUE DCA I HPNT1 JMP I STHS /RETURN
/SEARCH HALF-WORD BUFFER FOR CHARACTER: SRCH /CALL: TAD [X /SEARCH FOR X / SRCH / CAN'T FIND / NORMAL RETURN SRCHS, 0 CMA IAC DCA HSAVE CHNX, JMS LDHS /GET NEXT HALFWORD SNA /HALFWORD IS 0: END OF BUFFER REACHED JMP I SRCHS TAD HSAVE /SUBTRACT SEARCH CHARACTER SZA CLA JMP CHNX ISZ SRCHS /HAVE NOT FOUND IT, CONTINUE JMP I SRCHS /FOUND IT! EXIT TO CALL+2 /THIS SUBROUTINE TYPES STRIPPED ASCII CHARACTERS: TYPE /CALL: LDH / TYPE / JMP .-2 / END OF TEXT RETURN TYPES, 0 BRAN /CHECK AGAINST SPECIAL CHARACTER LIST TTYLST ISZ TYPES /@-END OF RECORD- SPECIAL RETN K0100T, 0100 /" - IGNORE - "AND" WITH AC = 0 NOP /$ - DISPLAY RESET IS IGNORED JMP I TYPES /' - KBD ENTRY DELIMITOR IS IGNORED JMP TCR /C.R. - DO C.R.L.F. JMP I TYPES /L.F. - IGNORE TAD BSAVE /NONE OF THE ABOVE TAD KM0040 /00-37 ARE 300-337; 40-77 ARE 240-277 SPA TAD K0100T /00-37 TAD K0240 TPEX, JMS TOUT /TYPE IT JMP I TYPES TCR, TAD K215 /C.R.L.F. - DO CR FIRST JMS TOUT TAD K212 /THEN DO LF JMP TPEX /EXIT /LOCAL CONSTANTS K215, 215 K212, 212
/SUBROUTINE TYPES OUT 8BIT IN AC TOUT, 0 KXX46, TLS /THIS IS A CONSTANT TSF JMP .-1 TCF /LEAVES FLAG CLEARED DCA TEMP02 JMP I TOUT /FILLS ALL ENTRY AREAS WITH BLANKMARKS: TXI /CALL: SETH / ADDRESS OF TEXT START / TXI / RETURN TXIS, 0 TXSR1, TAD TXMRK /GET FIRST BREAK CHAR JMS SRCHS JMP I TXIS /END CHAR FOUND TXSR2, JMS LDHS /FIND BREAK 2 TAD MTXMRK /PUT BLANKMARKS FROM BRK 1 TO 2 SNA CLA JMP TXSR1 /FOUND 2ND BREAK TAD KXX46 /NOT FOUND YET JMS STHS /PUT IN BLANKMARKS JMP TXSR2 /CONTINUE /LOCAL VARIABLES THIS PAGE HPSV, 0 /SAVE ADDRESS HSWSV, 0 /SAVE HALF HPNT2, 0 /LDH ADDRESS HSW2, 0 /LDH HALF HPNT1, 0 /STH ADDRESS HSW1, 0 /STH HALF /CONSTANTS FOR THIS PAGE K0077, 0077 K7700H, 7700 K0240, 0240 KM0040, -0040
*6200 /TEXT-KEYBOARD HANDLES [SU62AB] /REQUIRES [SU63A] /SUBROUTINE PICKS UP FIRST CHARACTER OF AN ENTRY ALPHAS, 0 TAD TXMRK /FIND TXMRX (KEYBOARD DELIMITOR) SRCH JMP I ALPHAS /NOT HERE, EXIT WITH AC=0 LDH /GETS FIRST CHARACTER JMP I ALPHAS /EXIT /LOADS KBD CHARACTERS INTO BUFFER: TXK /CALL: TXK / NORMAL EXIT / LINE FEED / CARRIAGE RETURN TXKS, 0 KSF JMP I TXKS /NO KEY - EXIT KRB JMS I UCHECK /USER MUST HAVE SUBROUTINE AT 7540 OR NOP THIS LOCATION BRAN /CHECK AGAINST SPECIAL CHARACTERS TXKEY ISZ TXKS /C.R. JMP TXLF /L.F. JMP TXRUB /RUBOUT LDH /OTHER TAD MTXMRK /CHECK THAT KEYBOARD AREA NOT FULL. SNA CLA JMP TXEN /NO MORE ROOM - EXIT WITHOUT ECHO TAD BSAVE AND K0077A /STRIP CHARACTER TO 6BIT BRAN /CHECK AGAINST SPECIAL 6BIT'S TTYLST K0034A, 0034 /@ - END OF TEXT MARKER K0077A, 0077 /" - PROGRAMMED INPUT TEXT MARKER K0046, 0046 /$ - DISPLAY RESET JMP TXEN /' - KBD MARKER - FOR THIS AND ABOVE: EXIT WITHOUT ECHO K0070, 0070 /% - CONVERT TO ] WHICH IS DISPLAYED AS % TAD K0070 /# - CONVERT TO [ WHICH IS DISPLAYED AS # TAD BSAVE /NONE OF THE ABOVE TYPE /ECHO TAD BSAVE /STORE AWAY JMS I STHX2 JMP I TXKS
TXLF, ISZ TXKS /C.R. OR L.F. LDH /FILL REST OF KBD AREA WITH SPACES TAD MTXMRK /END OF AREA? SNA CLA JMP TXER /YES - TYPE A CRLF AND EXIT TAD K0040 /NO - PUT ANOTHER SPACE IN. JMS I STHX2 JMP TXLF+1 /AND CONTINUE TXER, TAD KCR /TYPE A CRLF TYPE JMP I TXKS /AND EXIT TXRUB, TAD K0034A /PROCESS A RUBOUT - DELETE 1 CHAR. TYPE /TYPE "\" JMS I DHPX1 /MOVE POINTER BACK 1 HALF WORD LDH /IS THAT HALFWORD A TXMRK? TAD MTXMRK SNA CLA JMP TXER /YES - KBD AREA HAS BEEN ALL RUBBED OUT TAD K0046 /NO - PUT A BLANKMARK IN THERE JMS I STHX2 TXEN, JMS I DHPX1 /IGNORE INPUT - MOVE POINTER BACK JMP I TXKS /AND EXIT /TTY-LST TXKEY, 215 /CR 212 /LF -377 /RUBOUT /LOCAL CROSSPAGE DHPX1, DHPS STHX2, STHS /REFERENCE TO USER'S AREA - ROUTINE TO CHECK CTRLS MUST BE THERE UCHECK, KBRANS /FLOATING CONSTANT KM001F, 0001 6000 0000
*6302 /BASIC SUBROUTINES SHFT, DADD, AND BRAN [SU63AB] /SUBROUTINE TO SHIFT DOUBLE PRECISION WORD (SHFR): SHFT (10+6N) /CALL: TAD KXXXX /AC HOLDS SHFT COUNT, RIGHT IS NEGATIVE / SHFT / RETURN /LINK=0, AC=0 /FORMAT OF DOUBLE WORD IS (HI,LO) HI(0)-ONLY-HOLDS SIGN /SIGN BIT WILL BE REPLICATED IN RIGHT SHIFTS /TEMPORARY STORAGE ALLOCATION SHCNT=TEMP01 /ARITHMETIC REGISTER ALLOCATION SHFR=ARITH1 /ARITH1-2 ARE FOR SHIFTING SHFTS, 0 CLL SNA /IF SHIFT COUNT=0. EXIT JMP I SHFTS SMA /SHIFT RIGHT OR LEFT CML CMA IAC /LEFT-SET LINK=1 AND COUNT NEGATIVE DCA SHCNT SZL /RIGHT SHIFT? JMP SHLEFT /NO-SHIFT LEFT SHRIHT, TAD SHFR /SHIFT DONE ON ARITH1-2 SPA /SET L=1 IF NEGATIVE CML RAR DCA SHFR /SHIFT WITH SIGN REPLICATION TAD SHFR+1 /SHIFT LO ORDER HALF RAR DCA SHFR+1 CLL ISZ SHCNT /ENOUGH SHIFTS? JMP SHRIHT /NO-CONTINUE JMP I SHFTS /YES-EXIT SHLEFT, TAD SHFR+1 /SHIFT LO-ORDER CLL RAL /0 TO LSB DCA SHFR+1 TAD SHFR /SHIFT HI-ORDER RAL DCA SHFR CLL ISZ SHCNT /ENOUGH? JMP SHLEFT /NO-CONTINUE JMP I SHFTS
/SUBROUTINE FOR BRANCHING ON MATCH OF AC AGAINST TABLE: BRAN / BRAN / ADDRESS OF TABLE / RETURN HERE IF FIRST ENTRY MEETS MATCH / ETC. / NONE MATCH /TABLE, FIRST ENTRY / SECOND ENTRY / -LAST ENTRY /TEMPORARY STORAGE ALLOCATION BPNT=TEMP01 BSAVE=TEMP02 BRANS, 0 DCA BSAVE TAD I BRANS /GET ADDRESS OF FIRST ENTRY OF MATCH LIST DCA BPNT BRLOOP, TAD I BPNT /LOOK AT ENTRY SMA /GET MAGNITUDE CMA IAC ISZ BRANS /INDEX RETURN ADDRESS TAD BSAVE /MATCH FOUND? SNA CLA JMP I BRANS /YES-EXIT TO RETURN AS CALCULATED TAD I BPNT /NO-TEST FOR LAST ENTRY. ISZ BPNT /INDEX ENTRY POINTER SMA CLA /-INDICATES THIS WAS LAST ENTRY JMP BRLOOP /NOT LAST-CONTINUE ISZ BRANS /EXIT, NOT IN LIST, NONE MATCH JMP I BRANS /SUBROUTINE TO DO DOUBLE PRECISION ADD OF ARITH1-2, AND 4-5: DADD (21) /ARITHMETIC REGISTER ALLOCATION DBLAC=ARITH1 DBLARG=ARITH4 DADDS, 0 /ADD LO-ORDER CLL CLA TAD DBLAC+1 TAD DBLARG+1 DCA DBLARG+1 RAL /CARRY TAD DBLAC /ADD HI-ORDER TAD DBLARG DCA DBLARG /LEAVE IN ARITH4-5. CLL JMP I DADDS /FLOATING CONSTANT USED BY [SU54A] K100MF, 0033 /100,000,000(10) 2765 7020
*6400 /2-PAGE FLOATING POINT PACKAGE [SU64AC] - REQUIRES [SU63A] /LOAD, SAVE, DCOM, NORM, FMUL, FIX, DFIX, FADD, FDIV, FLOAT /FLOATING POINT FORMAT / WORD1: EXPONENT (2'S COMPLEMENT) / WORD2: HI ORDER MANTISSA / WORD3: LO ORDER MANTISSA / /MANTISSA IS REPRESENTED IN 24 BIT, 2'S COMPLEMENT NOTATION /A FLOATING POINT IS STORED AS MANTISSA*2^ EXPONENT /ZERO IS ALWAYS STORED AS 0*2^0 /0.5 .LE. .ABS. MANTISSA .LT. 1.0 /FLOATING POINT ACCUMULATOR FAC=ARITH0 /FLOATING POINT OPERATOR FOP=ARITH3 /SUBROUTINE TO LOAD FLOATING ACCUMULATOR: LOAD /TEMPORARY STORAGE ALLOCATION LDPNT=17 LOADS, 0 CLL CML CLA CMA /CALL: LOAD TAD I LOADS / ADDRESS DCA LDPNT /GETS ADDRESS, ADDRESS+1, ADDRESS+2 TO FAC ISZ LOADS TAD I LDPNT /ORDER IN MEMORY IS ASSUMED TO BE: DCA FAC / WORD1 TAD I LDPNT DCA FAC+1 / WORD2 TAD I LDPNT DCA FAC+2 / WORD3 JMP I LOADS /SUBROUTINE TO SAVE FLOATING ACCUMULATOR: SAVE /TEMPORARY STORAGE ALLOCATION SVPNT=17 SAVES, 0 CLL CML CLA CMA /CALL: SAVE TAD I SAVES / ADDRESS DCA SVPNT ISZ SAVES /SAVES FAC IN ADDRESS, ADDRESS+1, ADDRESS+2 TAD FAC /ORDER: WORD1 DCA I SVPNT TAD FAC+1 /ORDER: WORD2 DCA I SVPNT TAD FAC+2 /ORDER: WORD3 DCA I SVPNT JMP I SAVES
/SUBROUTINE TO FORM NEGATIVE OF ARITH1-2: DCOM DCOMS, 0 CLL CLA TAD ARITH2 CMA IAC DCA ARITH2 /-ARITH2 TO ARITH2 TAD ARITH1 /CARRY IS IN LINK BIT CMA SZL /DO CARRY IAC DCA ARITH1 JMP I DCOMS /SUBROUTINE TO NORMALIZE MANTISSA IN FAC: NORM /MODIFIES ARITH 1-2 (NORHI,NORLO), TEMP01(IN SHFT), TEMP02(NORCNT) /LEAVES FAC MANTISSA NORMALIZED, /SIGN OF MANTISSA IN LINK BIT, EXPONENT IN AC /TEMPORARY STORAGE ALLOCATION NORCNT=TEMP02 /ARITHMETIC REGISTER ALLOCATION NORHI=FAC+1 NORLO=FAC+2 NORMS, 0 CLL CLA TAD KM0027 /-23(10) DCA NORCNT NORLV, TAD NORHI CLL RAL SMA SNL /TEST FOR L,AC0 JMP NORSH /0,0 - SHIFT IT CMA CML /1,1 TO 0,0 SPA SZL CLA /TEST FOR 1,1 JMP NOREX /0,1 OR 1,0 - DONE TAD NORHI /1,1 - TEST FOR 6000 AND K1777 SZA CLA JMP NORSH /NO - CONTINUE TAD NORLO /YES - TEST FOR 6000 0000 SNA CLA JMP NOREX /YES AND L HOLD 1 FOR - NORSH, CLL CLA IAC SHFT /1 LEFT ISZ NORCNT /23 TIMES? JMP NORLV /NO - LOOK AGAIN NOREX, CML /23 SHIFTS IS ENOUGH - OR DONE TAD NORCNT CMA IAC /L GETS COMPLEMENTED IF=0, NORM OF 0 LEAVES 0 IN L. JMP I NORMS /LOCAL CONSTANT K1777, +1777
/SUBROUTINE FOR FLOATING POINT MULTIPLICATION: FMUL /CALL: FMUL /ONE ARGUMENT / ARG ADDRESS /ARG IS THE OTHER / (RETURN) /AC=0, L UNSPECIFIED /MODIFIES ARITH0-5(FAC,FOP), TEMP01-12 /USES SUBROUTINES NORM,SHFT,DADD,DCOM,SAVE,LOAD /LEAVES RESULT IN FAC /TEMPORARY STORAGE ALLOCATION FMULP=TEMP10 /11 AND 12 FMULS, 0 TAD I FMULS JMS I GARGX /GET ARG AND FAC MAGNITUDE, SET SIGN ISZ FMULS /FIX UP RETURN ADDRESS SAVE FMULP DCA FOP+1 /CLEAR PRODUCT ACCUMULATION DCA FOP+2 MULOOP, LOAD /SHIFT MULTIPLIER TO TEST FMULP /WHETHER TO INCREASE PRODUCT IAC /(FIRST TIME THRU IS ZERO SO WE SHFT /SKIP IT) SAVE FMULP LOAD /DECREASE POSSIBLE PRODUCT FARG /INCREMENT BY A FACTOR OF 2 CLA CMA SHFT SAVE FARG TAD FMULP+1 /BIT 0 IS FLAG FOR INCREASING SPA CLA /PRODUCT ACCUMULATION DADD /BY CURRENT INCREMENT ISZ FCNTR /DO THIS 23 TIMES JMP MULOOP LOAD /NORMALIZE RESULT MANTISSA FOP JMS NORMS /ADJUST EXPONENT SNA JMP FMEXP /MANTISSA WAS ZERO TAD FMULP TAD FARG TAD KM0027 FMEXP, DCA FAC TAD FLSIGN /FIX SIGN OF RESULT SZA CLA DCOM JMP I FMULS /LOCAL CROSSPAGE GARGX, GARG
/THIS SUBROUTINE FIXES FAC TO AC: FIX FIXS, 0 TAD FAC /AC BIASES FIX SPA SNA /FIX OF FAC .LT. 1 GIVES 0 IN AC JMP FIXNG TAD KM14 SMA /FIX OF .ABS. FAC .GE. 2^11; EXITS 0 IN AC JMP FIXNG IAC SHFT TAD ARITH1 JMP I FIXS FIXNG, CLL CLA JMP I FIXS /LOCAL CONSTANT KM14, -0014 /SUBROUTINE TO FIX FAC TO DBL PREC IN FAC+1 AND FAC+2 DFIXL=TEMP01 DFIXS, 0 TAD FAC /AC BIASES FIX TAD KM0027 SHFT TAD I DFIXS /CALL+1 HOLDS ADDRESS OF HI ORDER FIX ISZ DFIXS DCA DFIXL TAD FAC+1 /STORE AT C(CALL+1) AND C(CALL+1)+1 DCA I DFIXL ISZ DFIXL TAD FAC+2 DCA I DFIXL JMP I DFIXS /EXIT TO CALL+2
*.-1 177+1 /PAGE 2 OF 2 PAGE FLOATING POINT PACKAGE [SU64A] /FADD, FDIV, FLOAT /SUBROUTINE TO FLOATING ADD TO FAC: FADD /CALL: FADD / ADDRESS /MODIFIES ARITH 0-5 (FAC,FOP), TEMP01(FADSHF),TEMP02-04(ADDEND), /TEMP05-07(AUGEND) /USES SUBROUTINES: NORM, SHFT, DADD, SAVE, LOAD /RESULT IN FAC (RE-NORMALIZED),AC=0,L=U /TEMPORARY STORAGE ALLOCATION: FADSHF=TEMP01 ADDEND=TEMP02 /03 AND 04 AUGEND=TEMP05 /06 AND 07 /ARITHMETIC REGISTER ALLOCATION BIGGER=FOP FADDS, 0 CLA CMA SHFT /PREPARE FOR POSSIBLE DADD OVERFLOW SAVE /LOSES LSB OF MANTISSA ADDEND TAD I FADDS /GET ARGUMENT ADDRESS DCA .+2 LOAD /ARGUMENT TO FAC 0 CLA CMA /SHIFT FOR POSSIBLE OVERFLOW ALSO SHFT SAVE /SUM HAS 23 BITS PRECISION AUGEND ISZ FADDS /SETUP FOR EXIT TAD ADDEND /COMPARE EXPONENTS CMA IAC /WHICH TO SHIFT (SMALLER ARGUMENT) TAD AUGEND /TO ALIGN BINARY POINTS SPA /EXP DIFFERENCE IN AC JMP FADADD /EXP OF AUGEND SMALLER CMA IAC /MAKE DIFFERENCE NEGATIVE DCA FADSHF /TO SHIFT RIGHT LOAD /AUGEND (OLD FAC) IS LARGER AUGEND SAVE BIGGER LOAD /PREPARE TO SHIFT ADDEND ADDEND JMP FADFIN
FADADD, DCA FADSHF /AUGEND (OLD FAC) IS SMALLER LOAD ADDEND SAVE /SAVE ADDEND AS LARGER ARGUMENT BIGGER LOAD /PREPARE TO SHIFT SMALLER ARG AUGEND FADFIN, TAD FADSHF SHFT /ALIGN ARGUMENTS DADD /ADD MANTISSAS LOAD /NORMALIZE RESULT FOP NORM SNA /0 IF MANISSAS ADDED TO 0 JMP FADEXP /ZERO SHOWN AS 0*2^0 TAD KM0026 /-22(10) TAD BIGGER /ADD +1 TO -21(10) TO LARGER EXP FADEXP, DCA FAC /SAVE AS NEW EXPONENT JMP I FADDS /LOCAL CONSTANT KM0026, -0026 /SUBROUTINE TO INITIALIZE COUNTERS AND SWITCHES USED IN FMUL AND FDIV FLSIGN=TEMP03 FCNTR=TEMP04 FARG=TEMP05 /06 AND 07 GARG, 0 DCA LOCARG /AC HOLDS LOCATION OF ARGUMENT TAD FAC+1 SMA CLA /SET FLSIGN WITH SIGN OF FAC CMA DCA FLSIGN ISZ FLSIGN /LEAVE FLSIGN=0 FOR +, 1 FOR - DCOM /GET .ABS. FAC SAVE FARG LOAD EJECT LOCARG, 0 TAD FAC+1 /GET SIGN OF ARGUMENT SPA CLA CLA CMA TAD FLSIGN /+OP+=+, -OP-=+, +OP-=-, -OP+=- DCA FLSIGN /FLSIGN = 0 FOR +, .NE. 0 FOR - TAD FAC+1 /GET .ABS. ARG SPA CLA DCOM /.LT. 0: GET COMPLEMENT AND SET L=0 TAD KM0027 /-23(10) DCA FCNTR JMP I GARG
/THIS SUBROUTINE FLOATS AC TO FAC: FLOAT FLOATS, 0 DCA FAC+1 TAD KM014 /SHIFT TO GET SIGN EXTENSION SHFT NORM DCA FAC /NORMALIZE JMP I FLOATS /LOCAL CONSTANT KM014, -0014 /SUBROUTINE TO FLOATING DIVIDE FAC BY ARGUMENT- FDIV /CALL: FDIV / ARG ADDRESS /ARG ADDRESS HOLD ARGUMENT / (RETURN) /AC=0, L UNSPECIFIED /MODIFIES ARITH0-5 (FAC,FOP), TEMP01-14, REMAINDER IN FOP /TEMPORARY STORAGE ALLOCATION DVSOR=TEMP10 /11 AND 12 QUO=TEMP05 /06 AND 07 FDIVS, 0 TAD I FDIVS /GET ADDRESS OF ARGUMENT ISZ FDIVS /EXIT TO CALL+2 JMS GARG /GET .ABS. FAC, .ABS. ARG, SIGN OF RESULT DCOM SAVE /ARG IS DIVISOR DVSOR LOAD /.ABS. FAC: DIVIDEND FARG SAVE FOP DCA FAC+1 /FAC WILL HOLD QUOTIENT DCA FAC+2 DVLOOP, IAC /QUO*2 SHFT SAVE QUO LOAD DVSOR /TRIAL SUBTRACTION DADD TAD FOP+1 /CHECK FOR - AS RESULT OF TRIAL SMA CLA JMP DVOK /POSITIVE, INCREASE QUOTIENT DCOM /NEGATIVE, REVERSE DADD DCOM SKP /BUT DON'T INCREASE QUOTIENT
DVOK, ISZ QUO+2 /MARK QUOTIENT CLA CMA /NEXT TIME REDUCE DIMINISHER SHFT SAVE DVSOR LOAD /MAKE READY TO MULTIPLY QUOTIENT QUO ISZ FCNTR /DO THIS 23 TIMES JMP DVLOOP /CONTINUE NORM /NORMALIZE MANTISSA SNA JMP DVEXP /0 MANTISSA IMPLIES ZERO - EXIT IMMEDIATELY TAD FOP /ADJUST EXPONENT TAD KM0026 CMA IAC TAD DVSOR CMA IAC DVEXP, DCA FAC TAD FLSIGN /ADJUST SIGN SZA CLA /FLSIGN=0 FOR POSITIVE QUOTIENT DCOM JMP I FDIVS
*7000 /SUBROUTINE TO TYPE AND OUTPUT A MESSAGE UNTIL A TXMRK TXPUNS, 0 TAD I TXPUNS /GET MESSAGE ADDRESS ISZ TXPUNS DCA .+2 SETH /SET HALFWD POINTERS 0 JMS DBLPUN /TYPE AND PUNCH JMP I TXPUNS /SUBROUTINE TO TYPE AND OUTPUT A MESSAGE BETWEEN TXMRKS TPUNQS, 0 TAD TXMRK /MOVE TO MESSAGE SRCH JMP I TPUNQS /NO MESSAGE - EXIT JMS DBLPUN /TYPE & PUNCH UNTIL TXMRK JMP I TPUNQS /PUNCH AND TYPE UNTIL A TXMRK OR END OF RECORD DBLPUN, 0 TAD K0377 /PRECEED MESSAGE WITH RUBOUT DCA BSAVE DBLNXT, JMS PCOPYS /PUNCH FOR HI, NOP FOR LO SPEED PUNCH LDH /GET CHARACTER BRAN /CR OR TX MRK? CRTX JMP DBLCR /C.R. JMP DBLEXT /TX MARK TAD BSAVE /OTHER - TYPE IT DBLTYP, TYPE JMP DBLNXT /PUNCH THIS AND GET NEXT DBLEXT, TAD K0377 /E.O.R. OR TXMRK JMS I PUNCHX /BRACKET MESSAGE WITH RUBOUTS JMP I DBLPUN /EXIT DBLCR, TAD K0215 /PUNCH CR DCA BSAVE JMS PCOPYS TAD KCR /TYPE CRLF JMP DBLTYP /AND THEN PUNCH LF /SUBROTINE TO PUNCH ON PC8I WHAT WAS TYPED OR NOP IF NO PC8I PCOPYS, 0 LAS /CHECK SWITCHES SPA CLA /+ FOR PC8I, - FOR ASR33 JMP I PCOPYS /-, EXIT IMMEDIATELY TAD BSAVE /IS IT A LEGIT ASCII CODE? AND K0200 SNA CLA JMP I PCOPYS /NO - EXIT IMMEDIATELY TAD BSAVE /OK - PUNCH IT JMS I PUNCHX JMP I PCOPYS
/SUBROUTINE TO PUNCH LEADER-TRAILER LTPUNS, 0 TAD KM0043 DCA TLTCNT /# OF 200 CODES TO PUNCH TLTCNT=TEMP02 TAD K0200 /200 JMS I PUNCHX /PUNCH ISZ TLTCNT JMP .-3 JMP I LTPUNS /LOCAL CONSTANTS K16, 16 ENPARA, KBLB K0200, 0200 K0215, 0215 RATE, 0 K0700, 700 /LOCAL CROSSPAGE BINAX, BINAS BINGX, BINGS PUNCHX, PUNCHS /OUTPUT REST OF TEXT AND PUNCH PARAMETER TAPE CON34, JMS TXPUNS /"<CRLF> SYNC ON CHANNEL: "- DIS01 JMS DBLPUN /"<CRLF>SYNC ON CHANNEL:S#" JMS DBLPUN /"<CRLF>SYNC ON CHANNEL:S#<CRLF>" SETH DIS25 JMS TPUNQS /"####" JMS TXPUNS /"#### SWEEPS AT" TXT34B SETH /"#### SWEEPS AT ######" DIS24 JMS TPUNQS JMS TPUNQS /"#### SWEEPS AT ######*" JMS TXPUNS /"#### SWEEPS AT ######*S'<CRLF>" TXT34C TAD XROPT /IS THERE A SORT? SNA CLA JMP CON34A /NO-SKIP AHEAD JMS TXPUNS /"SORT AT" DIS12 JMS DBLPUN /"SORT AT ###### *S<CRLF>" JMS TPUNQS JMS TXPUNS TXT34C
CON34A, JMS TXPUNS /"(V**,#,####-####)<CRLF>" DIS99 TAD LNBUFB /WAS THE B-SWEEP USED? SNA CLA DCA KBTOA /NO, DISABLE IT DCA RATE LOAD /CLEAR RATE FASI /LOAD-A SWEEP SAMPLING RATE JMP INTO /JUMP TO TRIAL SUBTRACT SIZE, LOAD TEMP FDIV TEN /REDUCE SAMPLING RATE BY TEN INTO, SAVE /SAVE RESULT TEMP /AND DO A TRIAL SUBTRACT FADD F4K ISZ RATE /RECORD THE SUBTRACT TAD FAC+1 SPA CLA /TEST IT JMP SIZE /DO IT AGAIN NOP DFIX /NOW FIX THE REMAINDER 15 /AND FIX THE RATE FOR THE CLOCK TAD RATE BSW /1 GOES TO 100, 2 GOES TO 200, ETC. CMA /COMPLEMENT OF THESE THREE BITS IS THE RATE MODE AND K0700 TAD KMODE DCA KMODE JMS LTPUNS /PUNCH OUT 200 CODE TAD K16 /OUTPUT PARAMETERS (BIN) JMS I BINAX TAD ENPARA /OUTPUT FROM ADPARA TO END OF PARAMETERS JMS I BINGX TAD ADJLIS /OUTPUT LISTS (BIN) IAC JMS I BINAX TAD ADBUFA /OUTPUT FROM ADJLIS TO ADBUFA JMS I BINGX EJECT CON34B, TAD ADJLIS /PUNCH OUT DATA BLOCK LINKAGES DCA AXPNTR /SET UP TO LOOK AT JOB LIST TAD MEMTOT /SET AVAILABLE FIELD COUNT CMA DCA TFIELD /-# OF FIELDS IN CONFIGURATION TFIELD=TEMP16 TAD KHICOR /FIELD 0 MAX ALLOWABLE ADDR. DCA TMAXPG TMAXPG=TEMP17 TAD ADBUFB TAD LNBUFB DCA TCURAD TCURAD=TEMP20
CON35, TAD I AXPNTR /GET J1 SNA CLA JMP CON37 /J1=0 FOR E.O.L. DCA LINST1 /SET LINK FLAG 0. ISZ AXPNTR /SKIP J2 TAD I AXPNTR /J3 HOLDS # OF CELLS/POINT FLOAT SAVE FLOT01 TAD K6201 /CDF 0 JMS I BINFY TAD AXPNTR /ADDRESS OF LINKAGE (AXPNTR=J3) JMS I BINAY /PUNCH IT TAD I AXPNTR /GET # OF POINTS REQUIRED (J4) DCA TPOINT TPOINT=TEMP15 TAD K0003 /SKIP J5, J6, AND J7 TAD AXPNTR DCA AXPNTR TWO /FIRST BLOCK HAS 1 LOCATION FOR SWEEP COUNT CON35A, DCA INITOS TAD K0003 /3 LOCATIONS FOR LINKAGES TAD TCURAD /CURRENT FREE ADDRESS CMA IAC TAD TMAXPG /COMPARE AGAINST MAX ALLOWABLE FOR FIELD DCA FAC+2 DCA FAC+1 NORM /# OF LOCATIONS AVAILABLE DCA FAC FDIV /LOCATIONS/LOC PER POINT FLOT01 FIX DCA TSAM /#POINTS AVAIL FOR THIS BLOCK TSAM=TEMP13 CON36, TAD TSAM /POINTS AVAILABLE TAD TPOINT /POINTS REQUIRED SMA /DECREASE POINTS REQ BY POINTS AVAIL CLA /UNLESS MORE ARE AVAIL THAN ARE REQ DCA TREQ /-POINTS REQ AFTER THIS BLOCK TREQ=TEMP01
TAD TREQ CMA IAC TAD TPOINT /+POINTS REQUIRED BEFORE THIS BLOCK DCA TBLK /POINTS IN THIS BLOCK. TBLK=TEMP02 TAD TREQ /UPDATE POINTS REQUIRED DCA TPOINT TAD TBLK /LINK 1:-POINTS IN BLK (NEXT) JMS LINSTX /STORE LOC IN FIELD 1 /*******OLD WAS JMS I BINDY TAD TFIELD /-# OF FIELDS LEFT TAD MEMTOT /+# OF FIELDS IN MACHINE -1 IAC /+1: CURRENT FIELD CLL RTL /MAKE A CDF N INSTRUCTION RAL TAD K6201 /LINK2: CDF N DCA NXTCDF NXTCDF=TEMP14 TAD NXTCDF JMS LINSTX /******WAS JMS I BINDY TAD TCURAD /L3: NEXT BLOCK STARTS AT ...-1 JMS LINSTX /***** WAS JMS I BINDY TAD TBLK /-POINTS IN BLOCK CMA IAC SNA /ANY POINTS IN BLOCK BEING LINKED TO? JMP CON35 /NO-GET NEXT JOB FLOAT /YES - GET BLOCK LENGTH FMUL /#CELLS IN BLK = PTS * CELLS/PNT FLOT01 CLA CMA FIX CLA IAC SHFT TAD SHFR TAD TCURAD /CURRENT ADDR+BLK LENGTH DCA TCURAD /GETS NEW CURADDR.(NEXT BLOCK START -1) ISZ LINST1 /SET FLAG TO STORE CORE LINKS. TAD NXTCDF /PUNCH LINKAGE WORDS JMS I BINFY /FIELD TAD TCURAD /AND ADDRESS TAD INITOS /ADJUST FOR FIRST BLOCK LENGTH JMS I BINAY TAD K0003 /MOVE OVER L1,L2,L3 EJECT TAD TCURAD DCA TCURAD TAD TPOINT /IF POINTS STILL REQ .NE. 0, NEW FIELD SNA CLA /IF .EQ. 0, PUT END-OF-BLOCK JMP CON36 /PUT E.O.B. CLA CMA /NEW FIELD, START AT 0000 DCA TCURAD TAD K7577 DCA TMAXPG /ALL BUT FIELD 0 HAVE 7600 CELLS IAC /TCURAD IS ADDR-1 ISZ TFIELD /UPDATE FIELD COUNT JMP CON35A /BLOCK OUT NEXT FIELD
CON37, TAD CHKSUM /FINISH OUTPUT DEVICE. JMS I BINDY JMS I LTPUNX /PUNCH CHECKSUM AND LEADER TRAILER. CIF 10 TAD TENPUN SZA CLA /PUNCHED CONTROL TAPE? JMP I PCONTX /YES WRITE CONTROL TAPE TO M.S. JMP I .+1 /STORE LINKS IN CORE AND DO TRIG. TRIGSU /SUBROUTINE INITIALIZES PC8I OR ASR33 /NOT USED ANY MORE. INITOS, 0 CLA CHKSUM=TEMP21 JMP I INITOS LINSTX, 0 CDF CIF 10 JMS I LINKSX /SAVE LINKS IN FIELD 1. JMS I BINDY JMP I LINSTX LINKSX, LINKS LINST1, 0 *7364 /LOCAL CROSSPAGE BINDY, BINDS BINAY, BINAS BINFY, BINFS LTPUNX, LTPUNS PCONTX, PCONTT K7577, 7577 /LOCAL CONSTANTS K6201, 6201 K0036, 36 KMCTRL, -220 KHICOR, HICORE-1 /FLOATING CONSTANTS TRNTIM, 0011 3330 KZEROF, 0000 0000 0000 TEN, 0004 2400 0000
/OUTPUTS BINARY GROUP STARTING AT BINA ADDRESS /AC HOLDS END ADDRESS FOR OUTPUT BINGS, 0 CMA /-(END ADDRESS+1) TAD SHFR /+ BEGIN ADDRESS DCA BINCNT /IS # OF LOCATIONS TO OUTPUT BINCNT=TEMP02 CMA /SET POINTER TO BEGIN ADDRESS TAD SHFR DCA AXPNTR TAD KCDF0 JMS BINFS /SET DATA FIELD TO 0 TAD I AXPNTR /GET DATA JMS BINDS /PUNCH IT ISZ BINCNT /ENOUGH? JMP .-3 /NO - AGAIN JMP I BINGS /SUBROUTINE TO PUNCH CHARACTER (8-BIT) PUNCHS, 0 DCA TCHAR /AC HOLDS 8BIT TCHAR=TEMP01 TAD TENPUN /=1 IF PUNCHING CLA /**** CONTROL TAPES NOT PUNCHED. JMP I PUNCHS /NO - EXIT LAS /LOOK AT SWITCHES SMA CLA /SR0=0 FOR HI SPEED JMP PUNCHI /HI SPEED PUNLO, TAD TCHAR /LO SPEED - GET CHARACTER TLS /PUNCH IT TSF JMP .-1 TCF /LEAVE WITH CLEARED FLAG CLA JMP I PUNCHS PUNCHI, TAD TCHAR /HI - GET CHARACTER PLS /PUNCH IT LAS /IF SR WAS SET INCORRECTLY SPA CLA /ALLOW USER TO RECOVER JMP PUNLO /PUNCH THIS ON LO PSF /PUNCH THIS ON HI JMP .-4 PCF JMP I PUNCHS
/SUBROUTINE CONVERTS AC TO TWO DATA FRAMES BINDS, 0 DCA SHFR+1 /DATA TO BE PUNCHED TAD TENPUN /PUNCH ENABLED? SZA CLA CLA /***** CONTROL TAPES NOT PUNCHED /****** THEY ARE WRITTEN ON MASS STORAGE. TAD SHFR+1 /NO - STORE IN MEMORY BINMX, CDF /SET BY BINFS DCA I BPNTR /BPNTR SET UP BY BINAS CDF 0 BINDO, JMS SHFT6 /GET HI ORDER 6 BITS JMS PUNWDS /PUNCH THEN GET NEXT 6 BITS AND PUNCH JMP I BINDS /SUBROUTINE CONVERTS AC TO TWO ADDRESS FRAMES BINAS, 0 DCA SHFR+1 /ADDRESS CLA CMA /SET POINTER FOR STORING IN CORE (IF TENPUN=0) TAD SHFR+1 DCA BPNTR BPNTR=11 JMS SHFT6 /GET HI ORDER 6 BITS TAD K0100A /SIGNIFIES ADDRESS WORD TO BIN LOADER JMS PUNWDS /PUNCH THEN GET NEXT 6 BITS AND PUNCH JMP I BINAS /SUBROUTINE TO PUNCH TWO HALVES OF WORD PUNWDS, 0 JMS UPCHKS /UPDATE CHECKSUM WITH 6 BITS IN AC JMS PUNCHS /PUNCH JMS SHFT6 /GET NEXT 6 BITS JMS UPCHKS /UPDATE CHECKSUM JMS PUNCHS /PUNCH IT OUT JMP I PUNWDS /SUBROUTINE SHIFTS FAC 6 PLACES AND PUTS OUT 6 RIGHT OF FAC+1 SHFT6, 0 TAD K0006A /SHIFT 6 PLACES LEFT SHFT TAD SHFR /GET RESULT AND K0077B /MASK OFF JMP I SHFT6 /SUBROUTINE CONVERTS AC 9-11 TO FIELDATA BINFS, 0 DCA BINMX /SET UP CDF N INSTRUCTION IF STORING IN CORE TAD BINMX AND K0070A TAD K0300 /MAKE A FIELD WORD FOR BIN LOADER JMS PUNCHS /PUNCH IT JMP I BINFS
/SUBROUTINE TO UPDATE CHECKSUM UPCHKS, 0 DCA TEMP01 /SAVE TAD CHKSUM /ADD TO CHECKSUM TAD TEMP01 DCA CHKSUM /NEW CHECKSUM TAD TEMP01 /RESTORE JMP I UPCHKS /LOCAL CONSTANTS K0006A, 0006 K0070A, 0070 K0077B, 0077 K0100A, 0100 K0300, 0300 KCDF0, 6201 /COME TO 7540 TO CHECK FOR CTRL CHARACTERS /THIS VERSION IS FOR PC8I OR ASR 33 KBRANS, 0 BRAN CTRLST JMP I CTRLC /^C JMP I PRES0Y /^Z TAD BSAVE /NOT ^Z, OR ^C JMP I KBRANS /LIST OF CTRL CHARACTERS CTRLST, +203 /^C -232 /^Z /INDIRECT BRANCHES CTRLC, MONITR /7777 IF PAPER TAPE, 7600 FOR DSK OR DTA PRES0Y, PRES00
EJECT FIELD 1 /WRITE OUT CONTROL FILE. *2000 PCONTT, CDF 0 CLA IAC /0-1777 OF FIELD 1 NEED NOT BE SAVED. DCA I (7746 CDF 10 JMS I (7700 5 /CALL COMMAND DECODER. 0 0 TAD I (7600 SNA /TEST FOR NO OUTPUT FILE. JMP ERR AND (17 JMS I (7700 1 ANS1, 7201 /ENTRY POINT. JMP ERR TAD I (7600 JMS I (7700 3 ANS2, 7601 /RETURN BLOCK START. ANS3, 0 /- BLOCK LENGTH RETURNED. JMP ERR CDF 0 /LOOK JOB LIST AND CONTROL LIST TAD (230 /END. DCA 10 TAD (-3 DCA 11 TAG1, TAD I 10 SZA CLA JMP .-2 ISZ 11 JMP TAG1 CDF 10 CLA IAC TAD 10 /CALCULATE # OF 128 RECORDS. AND (7600 CLL RAR DCA ARG1 /LOAD WRITE ARG. IAC TAD 10 AND (177 SZA CLA TAD (100 TAD ARG1 TAD (4000 DCA ARG1 DCA ARG2 TAD ANS2 DCA ARG3 JMS FILSZC /TEST IF OUTPUT FILE FULL. JMS FILBWT /WRITE FIELD 0 STUFF. TAD ANS2 /RETURN WITH # OF BLOCKS WRITTEN. DCA ARG3 /NEW START BLOCK. TAD (CORSTG /START OF LINKS IN FIELD 1. DCA ARG2 TAD (100 /CAL. # OF 128 RECORDS TO WRITE. DCA ARG1 TAD (CORSTG DCA 20 TAG3, TAD (-200 DCA 21 TAG2, TAD I 20 SNA CLA JMP TAG4 TAD 20 TAD (5 DCA 20 TAD 21 TAD (5 DCA 21 TAD 21 SPA CLA JMP TAG2 TAD (100 TAD ARG1 DCA ARG1 TAD 21 JMP TAG3 TAG4, TAD (4010 TAD ARG1 DCA ARG1 JMS FILSZC /TEST IF OUTPUT FILE FULL. JMS FILBWT /WRITE FIELD 1 LINKS. TAD ARG3 /RETURN WITH # OF BLOCKS USED, CIA TAD ANS2 /CALCULATE # OF BLOCKS USED. CIA DCA ARG4 TAD I (7600 /CLOSE FILE. AND (17 JMS I (7700 4 7601 ARG4, 0 JMP ERR JMP WDONE FILBWT, 0 CIF 0 JMS I ANS1 /WRITE THE FILE. ARG1, 0 ARG2, 0 ARG3, 0 JMP ERR TAD ARG1 /CALCULATE # OF 256 BLOCKS. AND (3700 CLL RTR RTR RTR RAR SZL IAC JMP I FILBWT *2200 WDONE, CDF CIF 0 /RETURN TO OS-8. JMP I .+1 7600
FILSZC, 0 /TESTS IF FILE FULL. TAD ARG1 /GET # OF 128 RECORDS, AND (3700 /AND CALCULATE # OF BLOCKS. CLL RTR RTR RTR RAR SZL IAC CLL TAD ANS3 /TEST IF SIZE OVERFLOW. SNL JMP .+3 SZA JMP ERR DCA ANS3 JMP I FILSZC ERR, HLT CLA CLL JMS I (7700 /ERROR MESSAGE. 7 0 HLT /READ IN CONTROL FILE CONTAP, CLA CLL CDF 0 /SAVE LINKS FOR CHAIN. TAD I (5 DCA CONSA1 TAD I (6 DCA CONSA2 TAD I (7 DCA CONSA3 CDF 10 JMS I (7700 /CALL COMMAND DECODER 5 0 0 TAD I (7617 SNA /TEST FOR NO INPUT FILE. JMP ERR JMS I (7700 /FETCH DEVICE HANDLER 1 CONTP1, 7201 /ENTRY POINT. JMP ERR TAD (200 /SETUP TO READ FILE. DCA CONP1 TAD I (7620 DCA CONP3 JMS FILERD /READ 1ST BLOCK. TAD (-150 DCA CONSA5 /# OF LOC TO SEARCH. JMP .+2 CONTP5, JMS FILERD /READ NEXT BLOCK. CONTP2, CDF 0 TAD I CONSA4 /SEARCH FOR END OF JOB LIST AND /OTHER PAR. 3 RD 0 IS END. ISZ CONSA4 CDF 10 SNA CLA JMP CONTP3 CONTP4, ISZ CONSA5 /FIND END OF BLOCK READ. JMP CONTP2 JMP CONTP5 CONTP3, ISZ CONSA6 /CHECK FOR 3RD 0. JMP CONTP4 TAD (210 /FIELD 0 DATA IN. DCA CONP1 /READ FIELD 1 DATA. TAD (CORSTG DCA CONP2 CONTP6, TAD (CORSTG DCA CONSA4 CONTP9, JMS FILERD /READ NEXT BLOCK. CONTP8, TAD I CONSA4 /0 MARKS THE END OF THE LINKS /5 LOC. PER LINK,CDF,ORG.,AND 3 LINK WORDS. /IF CDF IS 0 ITS THE END. SNA CLA JMP CONTP7 TAD (5 TAD CONSA4 DCA CONSA4 ISZ CONSA5 JMP CONTP8 JMP CONTP9 CONTP7, CDF 0 /RESTOR LINKS FOR CHAIN. TAD CONSA1 DCA I (5 TAD CONSA2 DCA I (6 TAD CONSA3 DCA I (7 JMP I (TRIGSU CONSA1, 0 CONSA2, 0 CONSA3, 0 CONSA4, 230 CONSA5, 0 CONSA6, -3 FILERD, 0 CIF 0 JMS I CONTP1 CONP1, 0 CONP2, 0 /SET TO READ TO LOC 0 ON 1ST READ. CONP3, 0 JMP ERR TAD (-400 DCA CONSA5 ISZ CONP3 TAD CONP2 TAD (400 DCA CONP2 JMP I FILERD
*2400 LINKS, 0 DCA LK1 /SAVE LINK VALUE TO SAVE. CDF 0 TAD I (LINST1 /TEST TO STORE LINKS. SNA CLA JMP LK4 /NO IF 0. ISZ LK2 /PROGRAM IS ONE PASS,LK2 SET ON LOAD. JMP LK3 /NOT A NEW LINK. TAD I (BINMX /NEW LINK SAVE CDF,ORG. CDF 10 DCA I LINSPT ISZ LINSPT CDF 0 TAD I (BPNTR /ADDRESS,SAVE AS ADDRESS-1. CDF 10 DCA I LINSPT ISZ LINSPT TAD (-3 DCA LK2 /STORE 3 VALUES OF LINK. LK3, TAD LK1 CDF 10 DCA I LINSPT ISZ LINSPT DCA I LINSPT /SET 0 TO MARK END IF SO. /NOTE IF NO AVERAGES SPECIFIED,CAN'T /GET HERE. ISZ LINKS CDF CIF 0 JMP I LINKS LK4, TAD LK1 /RETURN WITH JOB LIST VALUE FOR BINDS. CDF CIF 0 JMP I LINKS CORSTG=3200 LINSPT, CORSTG LK1, 0 LK2, -1 TRIGSU, CDF 10 /MOVE TRIG AND LINK STORE CODE TO FIELD 0 /THEN EXECUTE IT. TAD (6377 DCA 10 TAD (CORFIX-1 DCA 11 TAD (-EXITXX+CORFIX-1 DCA 12 TRGSU1, CDF 10 TAD I 11 CDF 0 DCA I 10 ISZ 12 JMP TRGSU1 CDF CIF 0 JMP .+1 6400
*2600 /LINKS SAVED IN FIELD 1 AS CDF,ORG. AND 3 LINK VALUES. CORFIX, CDF 0 /SAVE LINKS IN CORE. TAD ZZ3177 DCA 10 TAD ZZ6777 DCA 13 DCA I ZZ7000 CORFX3, CDF 10 TAD I 10 /GET 5 WORDS OF LINKS. SNA JMP CORFX6 /0 NO MORE LINKS. DCA CORFXX /SAVE CDF VALUE. TAD CORFXX TAD ZM6211 /IF CDF 10,SAVE IN FIELD 0. SNA CLA JMP CORFX4 JMS CORFXS /STORE LINKS. JMP CORFX3 CORFX4, TAD ZZM4 /SAVE FIELD 1 LINK IN FIELD 0. DCA 14 CDF 0 /SAVE AS 1,ORG,3 LINK VALUES. IAC DCA I 13 CORFX5, CDF 10 TAD I 10 CDF 0 DCA I 13 ISZ 14 /STORE ORG AND 3 LINKS. JMP CORFX5 DCA I 13 /SET NEXT WORD 0 TO MARK END. CLA CMA TAD 13 DCA 13 JMP CORFX3 CORFX6, TAD ZZ6777 /OTHER FIELDS DONE, DCA 10 /STORE FIELD 1 LINKS. TAD ZZ6201 DCA CORFRS+1 TAD ZZ6211 DCA CORFXX CORFX7, CDF 0 TAD I 10 /GET 5 WORD LINK SET. SNA CLA JMP I (6600 /DONE GO TO TRIGGER. JMS CORFXS JMP CORFX7 CORFXS, 0 JMS CORFRS TAD I 10 /STORAGE ADD. IS LOC-1 FOR AUTO INDEX. DCA 11 TAD ZZM3 DCA 12 CORFX2, JMS CORFRS /SET CDF WHERE TO FETCH LINK. TAD I 10 JMS CORFXZ /SET CDF WHERE TO STORE LINK. DCA I 11 ISZ 12 /STORE 3 LINKS. JMP CORFX2 JMP I CORFXS CORFRS, 0 CDF 10 JMP I CORFRS ZZ3177, 3177 ZZM3, -3 ZZ6777, 6777 ZZ7000, 7000 ZZ6201, CDF 0 ZZ6211, CDF 10 ZM6211, -6211 ZZM4, -4 CORFXZ, 0 CORFXX, 0 JMP I CORFXZ
*3000 /THIS SECTION CALIBRATES A SCHMITT TRIGGER BY WIATING /FOR THE SPECIFIED TRIGGER TO FIRE AND THEN TAKING A /SWEEP OF ANALOG CHANNEL 0. TRIG, CDF 0 KCC TAD TTYLIS DCA 10 TYP, TAD I 10 SNA /IS THIS THE END OF LIST? JMP DONE /YES TLS CLA TSF JMP .-1 JMP TYP DONE, TAD KMODE /NOW SET UP CLOCK CLOE CMA CLZE CLA ADCL TAD K200 ADLE CLSA TWAIT, CLSA AND SMASK /IS IT THE PROPER SYNC? SNA CLA JMP HELEN TAD 16 CLAB CLA CLL TAD M1000 DCA PNTCNT PNTCNT=TEMP01 TAD M1000 DCA XREF XREF=TEMP02 ALOOP, ADSK JMP .-1 ADRB DILY CLL CLA IAC RAL TAD XREF DILX DCA XREF DISD JMP .-1 DIXY ISZ PNTCNT JMP ALOOP JMP TWAIT-1 HELEN, KSF JMP TWAIT KRB TAD ZZM203 SNA CLA JMP I EXITXX JMP I SECT2 TTYLIS, 6665 LIST, 324 322 311 307 307 305 322 0 K200, 200 M1000, -1000 SECT2, OVRLAY ZZM203, -203 EXITXX, 7600 /SHOULD BE LAST THING ON PAGE. $



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search