File TIHD2.

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

/TIME INTERVAL HISTOGRAM MS- CREATES HISTOGRAMS
/FROM SCHMITT TRIGGER INPUT.
/
/DEC-8E-ATIHA-A-LA
/
/COPYRIGHT 1972
/DIGITAL EQUIPMENT CORPORATION
/MAYNARD, MASSACHUSETTS 01754
/

/FILE TIH.2 /TIME INTERVAL HISTOGRM PROGRAM FOR THE LAB8/E /FOR PS8,READ AND WRITE DATA VIA MASS STORAGE. /IOT REFERENCES FOR THE LAB8/E / / /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 BSW=7002 /PAGE ZERO OF THE TIME INTERVAL HISTOGRAM PROGRAM / / *1 JMP I .+1 /GET OFF PAGE ZERO INTERP /TO THIS LOCATION / / *10 POINTA, 0 GETPNT, 0 / / *20 POINT, 0 /REGULAR POINTER MBINK, 0 /-NUMBER OF COUNTS PER BIN; A CONSTANT MBINW, 0 /THIS IS THE COUNTER MEPOCK, 0 /-NUMBER OF EPOCHS; A CONSTANT MEPOC, 0 /THE COUNTER MBINS, 0 /--NUMBER OF BINS PER EPOCH; CONSTANT MBIN, 0 /COUNTER ORD, 0 /POINTER OF ZEROTH ORDER HISTOGRAM MINTK, 0 /MINIMUM TIME; A CONSTANT MINT, 0 /THE COUNTER MONTR, 7600 /LOCATION OF MONITOR PERMLI, START0-1 TTYBUF, BUFFER /LOCATION OF TTY INPUT BUFFER TTYBUA, BUFFER-1 LENGTH, 0 SFACTR, 0 /SCALE FACTOR SUM, 0 /SUM FACTOR MSUM, 0 /- THE SUM PLSWT, 0 /PLOTTING SWITCH AXSWT, 0 /AXIS OR NO AXIS KDIM, -3 /DIMNESS SWITCH DIM, 0 CURSWT, 0 /CURSORS OR NO PNTSWT, 1 /POINT-PLOT DISPLAY OR BARS? ORDER, 0 /WHICH HISTOGRAM TO DISPLAY MLINES, 0 BINSTA, 0 TEMSTA, 0 TEMEND, 0 BUSY, 0 /TTY BUSY FLAG FIRST, 0 KMUNIT, 0 XINC, 0 / / /CONSTANTS /
K0011, 11 K0040, 40 K0077, 77 K0777, 777 K7027, 7027 M215, -215 M271, -271 KM0027, -27 KMODE, 5612 /ENABLE SCHMITT #2 TO INTERRUPT, ALSO CLOCK TICK AT 1U SEC / / / /LINKAGES TO FLOATING POINT PACKAGE ROUTINES SHFT=JMS I SHX SHX, SHFTS BRAN=JMS I BRX BRX, BRANS DADD=JMS I DAX DAX, DADDS LOAD=JMS I LOX LOX, LOADS SAVE=JMS I SAX SAX, SAVES DCOM=JMS I DCX DCX, DCOMS NORM=JMS I NOX NOX, NORMS FMUL=JMS I FMX FMX, FMULS FDIV=JMS I FDX FDX, FDIVS FIX=JMS I FIXX FIXX, FIXS DFIX=JMS I DFIXX DFIXX, DFIXS FADD=JMS I FAX FAX, FADDS FLOAT=JMS I FLX FLX, FLOATS / / *115 /LINKAGES TO SUBROUTINES CRLFX, CRLF TYPMX, TYPM TYPAX, TYPA OCTIZX, OCTIZ CTRLAX, CTRLA NECHOX, NECHO REASKX, REASK
DEFLAX, DEFLAT DEFSIX, DEFSIN TTINX, TTIN INTDLX, INITDL INTDSX, INITDS SETPTX, SETPNT KNOBSX, KNOBS GETDLX, GETDL FIXSTX, FIXSTA SPACEX, SPACE ADDISL, DISL-1 DELAYX, DELAY FXMSUM, FSUM / / /LINKAGES TO DISPLAY LISTS STRT0X, START0 /START-1 OF 0TH HISTO END0X, END0 /END-1 OF 0TH HISTO STRT1X, START1 /START-1 OF 1ST HISTO END1X, END1 /USE YOUR IMAGINATION / / / / / /ARITHMETIC REGISTERS ARITH0, 0 ARITH1, 0 ARITH2, 0 ARITH3, 0 ARITH4, 0 ARITH5, 0 FTEM1A, 0 FTEM1B, 0 FSAM, 0 0 0 TEMP0, 0 TEMP01, 0 TEMP02, 0 TEMP03, 0 TEMP04, 0 TEMP05, 0 TEMP06, 0 TEMP07, 0 TEMP10, 0 TEMP11, 0 TEMP12, 0 TEMP13, 0 TEMP14, 0
COMMAX, COMMA *200 /THIS IS THE MAIN FRAME OF THE PARAMETER SETUP PROGRAM JMP I .+1 ONCE, TRIG CTRLA, DCA BUSY CLA CLL CMA CLZE CLA JMS I CRLFX ABINW, JMS I TYPMX /ASK FOR BIN WIDTH BINW /HERE IS WHERE THE MESSAGE IS STORED JMS I TTINX /ACCEPT REPLY JMS I CBINWX /CHECK IT FOR VALIDITY ABINS, JMS I TYPMX /ASK FOR NUMBER OF BINS BINS JMS I TTINX JMS CBINS /CHECK REPLY AMIN, JMS I TYPMX MIN /WHAT IS MIN TIME JMS I TTINX JMS I CMINX /CHECK AND STORE ATIMUN, JMS I TYPMX /GET BASIC TIME UNIT TIME JMS I TTINX JMS I CTIMX /CHECK AND STORE AUNITS, JMS I TYPMX /GET NUMBER OF TIME UNITS UNITS JMS I TTINX JMS CUNITS /PARAMETERS ENTERED NOW INITIALIZE BUFFERS, POINERS,ETC. CLBUF, TAD I STRT0X DCA POINTA /GET START OF BUFFERS TAD I END1X /GET THE END OF THEM CIA /NEGATE IT TAD POINTA DCA TEMP0 /THIS MINUS NUMBER OF LOCATIONS CLEARL, DCA I POINTA ISZ TEMP0 JMP CLEARL /CLEAR SOME MORE LOCATIONS DCA I ER1X /CLEAR ERROR COUNTER JMS I INTDLX /INITIALIZE DISPLAY LISTS JMS I INTDSX /INITIALIZE DISPLAY SWITCHES RETAN, TAD I EXTENX SMA /FIX KBD BRANCH FOR DATA TAKING CIA DCA I EXTENX TAD MBINK /GET NEGATIVE BIN WIDTH DCA MBINW /FIX COUNTER TAD MEPOCK /- OF EPOCHS
DCA MEPOC TAD MBINS /- OF BINS IN EPOCH DCA MBIN TAD I STRT0X /START OF 0 ORDER HISTOGRAM IAC DCA ORD /SAVE IN POINTER FOR INCREMENT TAD MINTK /- BINS FOR MIN TIME DCA MINT TAD KMUNIT DCA I MUNITX TAD I SPTX DCA I SPT ISZ FIRST IAC /SET UP ORDER DCA ORDER CMA DCA DIM /FIX BRIGHTNESS OF AXIS DCA I TTYBUF /CLEAN AREA WAIT, KSF /WAIT FOR KBD BEFORE GOING ON JMP .-1 KRB /READ IT BRAN /CHECK FOR SPECIAL CHARACTERS STLIST /START BRANCH LIST JMP GO /^S START LISTENING FOR PULSES JMP I MONTR /^C GO TO MONITOR JMP I CTRLAX /^A REDEFINE PARAMETERS JMP AUNITS /LF; REASK QUESTION JMP WAIT /ALL OTHERS WAIT AGAIN GO, CLA CMA DCA FIRST JMS I MODEAX ION /INTERRUPTS ON JMP I DISUX /AND GO!!! /CBINS: SUBROUTINE TO CHECK VALIDITY AND STORE ANSWER /TO NUMBER OF BINS CBINS, 0 JMS I FDIGX /CHECK AND OCTIZE CIA /NEGATE ANSWER DCA MBINS CLA CLL /CLEAN AREA TAD AVAIL /GET AMOUNT OF AVAILABLE CORE TAD MBINS /SUBTRACT NUMBER OF BINS SNL /OK? JMP CORECH /NO. BAD BOY DCA AVAILA /YES. HOLD AVAILABLE SPACE AVAILA=TEMP10 JMP I CBINS /RETURN CORECH, CLL CLA /CLEAN AC AND LINK JMS I TYPMX /TELL THE USER HE EXCEEDED CORE CORE
JMP I REASKX /SUBROUTINE TO CHECK ANSWER TO NUMBER OF EPOCHS /STORE THE ANSWER AND ADJUST POINTERS OF STARTING AND /ENDING POINTS OF HISTOGRAMS CUNITS, 0 JMS I FDIGX /CHECK AND OCTIZE CIA DCA MEPOCK /SAVE IT IN THE NEGATIVE CLL /CLEAN LINK TAD AVAILA TAD MEPOCK /UPDATE AVAILABLE CORE SNL CLA /ARE WE STILL OK? JMP CORECH /NO. REASK TAD MEPOCK CIA /READY FOR POINTERS TAD I STRT0X /START +LENGTH=END DCA I END0X TAD I END0X /MARK START OF PST HISTOGRAM DCA I STRT1X /ITS RIGHT AFTER THE 0TH HISTOGRAM TAD MBINS CIA TAD I STRT1X /START +LENGTH=END DCA I END1X JMP I CUNITS EXTENX, EXTEND DISUX, DISUP FDIGX, FDIGC CBINWX, CBINW ER1X, ER1 AVAIL, 3542 CMINX, CMIN CTIMX, CTIME SPTX, SPOTER SPT, SPOT MUNITX, MUNIT MODEAX, MODEA / / / *400 /TTIN: A SUBROUTINE TO ACCEPT KEYBOARD INPUT OF UP TO FIVE CHARACTERS /INPUT IS CHECKED AGAINST A LIST FOR CONTROL CHARACTERS. ^R,^C,^A, /LF,AND CR ARE LOOKED FOR. MORE THAN FIVE CHARACTERS CAUSE THE /QUESTION TO BE REASKED /RUB OUT: ASK THE QUESTION AGAIN (RETURN -3) /^C: RETURN TO MONITOR /^A: ASK ALL QUESTIONS AGAIN /CR: TERMINATE ANSWER /LF: ASK LAST QUESTION TTIN, 0
TAD TTYBUA /LOCATION OF INPUT BUFFER DCA POINTA /AUTOINDEX IT DCA ENDA /ZERO END SWITCH DCA CNTR /ZERO COUNTER MORE, JMS I LISNX DCA TEMP0 /SAVE CHARACTER TAD TEMP0 /GET IT BACK FOR CHECKING BRAN /CHECK IT AGAINST THE FOLLOWING LIST SETBRA /SETUP BRANCH JMP CR /CR JMP REASK /RUB OUT JMP I CTRLAX /^A JMP I MONTR /^C JMP LF /LF JMP NOTH /NOTHING SPECIAL CR, ISZ ENDA /BUMP END SWITCH NOTH, TAD TEMP0 JMS I TYPAX /ECHO IT TAD TEMP0 DCA I POINTA /STORE IT TAD ENDA /ARE WE THOUGH ACCEPTING? SNA CLA JMP .+3 /NO, GO ON JMS I CRLFX /YES, DO A LF JMP I TTIN /AND RETURN ISZ CNTR /NO. RECORD CHARACTER TAD CNTR TAD M006 /NO MORE THAN 5 CHARACTERS PLEASE SZA CLA JMP MORE /OK TO ACCEPT MORE REASK, JMS I CRLFX /TOO MUCH ACTION ON THE KEYBOARD JMS I TYPMX QUES /TYPE QUESTION MARK TAD TTIN TAD M003 /ADJUST THE RETURN DCA TTIN JMP I TTIN LF, JMS I CRLFX TAD TTIN /DO A CR AND A LF AND GO BACK ONE QUESTION TAD M006 CMA IAC TAD BEGIN /DONT RETURN TOO FAR SMA CLA JMP REASK /THIS WAS THE FIRST QUESTION TAD TTIN TAD M007 /WE CAN SAFELY GO BACK ONE DCA TTIN JMP I TTIN /RETURN M003, -3 M006, -6
M007, -7 CNTR=TEMP04 ENDA=TEMP03 /FDIGC; SUBROUTINE TO CHECK TTBUF /FOR UP TO FIVE NUMBERS PLUS A CR /OCTIZE THEM AND EXIT WITH VALUE IN /THE AC. ALL OTHER RETURNS ARE TO /REASK THE QUESTION. / FDIGC, 0 JMS CHECK TAD M215 /CR? SZA CLA JMP REASK /NO INVALID JMS I OCTIZX /OK OCTIZE IT JMP I FDIGC /RETURN /CHECK; SUBROUTINE TO CHECK FOR AT LEAST /ONE NUMBER IN TTBUF.QUESTION REASKED IF /FIRST IS NOT A NUMBER. /EXITS WHEN A NON NUMERIC CHARACTER IS /FOUND.ON EXIT: LOCATION UNIT HOLDS NUM- /BER OF DIGITS FOUND AND NON-NUMERIC /CHARACTER IS IN AC. / CHECK, 0 DCA UNIT /INITIALIZE TAD RE DCA FIX2 TAD RE DCA FIX1 JMS I SETPTX /GET FIRST ONE LOOP2, TAD M271 SMA SZA FIX1, JMP REASK /NOT VALID TAD K0011 SMA CLA JMP VALID FIX2, JMP REASK TAD I POINT /GET VALUE IN AC JMP I CHECK /EXIT VALID, ISZ UNIT ISZ POINT /ADVANCE POINTER TAD CLEAR DCA FIX2 /NON-NUMERIC OK TAD JUMP DCA FIX1 TAD I POINT /GET NEXT CHAR JMP LOOP2 JUMP, JMP FIX2 CLEAR, CLA CLL
RE, JMP REASK UNIT, 0 LISNX, LISN BEGIN, ABINW INITDL, 0 /S.R TO SET UP DISPLAY WORDS TAD ADDISL /GET ADDRESS DCA POINTA /AUTO INDEX IT TAD I STRT0X /GET START OF BUFFER DCA I POINTA TAD I END0X /GET END ADDRESS DCA I POINTA DCA I POINTA /SCALE=0 IAC /SET SUM=1 DCA I POINTA TAD I STRT1X /GET START OF 1ST ORDER HISTOGRAM DCA I POINTA TAD I END1X DCA I POINTA DCA I POINTA /SCALE = 0 IAC DCA I POINTA /SUM=1 JMP I INITDL /RETURN BUFFER, 0 0 0 0 0 0 0 SETBRA, 215 /CR 377 /RUB OUT 201 /^A 203 /^C -212 /LF COMMA, 0 TAD K0254 JMS I TYPAX JMP I COMMA K0254, 254 / / / *600 /SUBROUTINE TO CHECK AND STORE ANSWER TO BIN WIDTH CBINW, 0 JMS I CHEX /MOVE TO FIRST NON NUMERIC TAD M256 /THIS MUST BE A PERIOD SZA CLA /IS IT? JMP I REASKX /NO. REASK QUESTION TAD POINT /YES.
DCA TEMP0 /SAVE LOCATION OF PERIOD ISZ POINT TAD I POINT /GET NEXT NUMBER TAD M271 /THIS ALSO MUST BE A NUMBER SMA SZA JMP I REASKX /THE USER IS A DUMMY TAD K0011 SPA CLA JMP I REASKX /OR PRODUCT TEST IS NASTY TAD I POINT /OK ITS VALID DCA I TEMP0 /PUT IT WHERE THE PERIOD WAS ISZ POINT /CHECK FOR CR TAD I POINT /GET VALUE TAD M215 SZA CLA /OK? JMP I REASKX /NO DUM DUM ISZ I UNTX /YES, INCREASE RADIX COUNTER JMS I OCTIZX /GET OCTAL OF THIS DECIMAL CIA /NEGATE IT DCA MBINK /SAVE THIS ANSWER JMP I CBINW /RETURN M256, -256 /TYPM: A SUBROUTINE TO TYPE A MESSAGE WHOSE ADDRESS IS HELD IN /CALL+1 TYPM, 0 TAD I TYPM /GET ADDRESS OF MESSAGE DCA POINT /MAKE A NONAUTOINDEX POINTER OF IT ISZ TYPM /FIX THE RETURN ADDRESS TLOOP, TAD I POINT BSW /SHIFT IT TO GET LEFT HALF JMS TCHAR /DO MASK AND TYPE ROUTINE TAD I POINT /GET THE SAME WORD FOR THE RIGHT HALF JMS TCHAR ISZ POINT /MOVE POINTER UP TO NEXT LETTERS JMP TLOOP /DO IT AGAIN TCHAR, 0 AND K0077 /MASK OUT THE LEFT HALF SNA /A ZERO HERE MEANS THE END OF THE MESSAGE JMP I TYPM /EXIT THIS ROUTINE TAD K0040 /MAKE THIS AN ASCII CHARACTER JMS I TYPAX /TYPE IT JMP I TCHAR /RETURN FROM THIS LITTLE LOOP /DISUP:A ROUTINE TO SET UP DISPLAY POINTERS SUCH AS STARTING /AND ENDING LOCATIONS, DELTA X, SCALE AND SUM FACTORS DISUP, JMS I GETDLX /ADJUST POINTER FOR ORDER DCA POINTA /AUTO INDEX IT TAD I POINTA /GET STATING ADDRESS FOR DISPLAY DCA GETPNT /ANOTHER AUTO POINTER TAD GETPNT CIA
TAD I POINTA /AC HOLDS NUMBER OF POINTS SNA /INSURE NON ZERO IAC CIA /AC HOLDS -POINTS. DCA MPOINT TAD MPOINT FLOAT /FLOAT IT SAVE FSAM /AND SAVE IT TAD KDSIZE /GET -DISPLAY SIZE FLOAT FDIV FSAM TAD K0014 /376 DFIX DELTAX TAD K7027 /LEFT HAND X EDGE DCA LENGTH DCA ARITH4 DCA ARITH5 TAD I POINTA /GET SCALE FACTOR DCA SFACTR TAD I POINTA /GET SUM DCA SUM JMS I FXMSUM /SET UP MSUM JMP I AXISX /DELAY: A SUBROUTINE TO DELAY A VARIABLE TIME ACCORDING TO KNOB 3 DELAY, 0 TAD PLSWT SNA CLA /IF WERE NOT PLOTTING, DONT DELAY JMP I DELAY CLA CLL CML IAC RAL /KNOB 3 ADLM /FOR PLOT SPEED ADST ADSK JMP .-1 /GET SAMPLE ADRB CIA TAD K6777 /RANGE -3777,-1 CLAB CLSA /LOAD COUNTER SNA CLA /CHECK FLAGS JMP .-2 /WAIT JMP I DELAY K6777, 6777 /GETDX: A SUBROUTINE TO GET DELTA X VIA SUM GETDX, 0 JMS I FXMSUM /SETUP MSUM TAD DELTAX DCA ARITH1
TAD DELTAX+1 DCA ARITH2 DELOOP, DADD ISZ MSUM /COMBINE DELTA XS THIS MANY TIMES JMP DELOOP TAD ARITH4 /WATCH OUT FOR OVERFLOW CIA /NEGATE TAD K1777A /AND CHECK FOR MAX SMA CLA JMP .+3 /ITS OK TAD K1777A /TOO MUCH; SET TO MAX JMP I GETDX /AND RETURN TAD ARITH4 JMP I GETDX /RETURN TO MAIN PROGRAM CHEX, CHECK MPOINT, 0 AXISX, AXIS UNTX, UNIT KDSIZE, -1750 K0014, 0014 K1777A, 1777 DELTAX, 0 0 MSIO, CDF CIF 10 JMP I .+1 MSSTRT / / / *1000 /THIS IS THE START OF THE DISPLAY SECTION AXIS, TAD K7027 DILY DCA I YTEMPX /SAVE IT FOR LATER TAD AXSWT SNA CLA /AXSWIT=1 FOR DISPLAY OF AXIS JMP CURDIS /NO AXIS. TRY CURSORS ISZ DIM /IF A POINT PLOT DISPLAY SPEND LESS TIME ON AXIS JMP CURDIS TAD KDIM DCA DIM TAD K0777 /SET X COORDINATE FOR RIGHT HAND EDGE DCA I XTEMPX TAD K7027 /LEFT HAND EDGE FOR X DCA LENGTH /STOP AXIS HERE JMS I XDSPX /DRAW THE LINE JMS I DELAYX /TRY NOT TO SKEW PEN TAD M31 /=-25 FOR HATCH MARKS ON Y AXIS DCA HATCH HACHL, TAD K0050 DCA LENGTH /ONE HATCH MARK EQUALS 20 POINTS JMS I YDISPX /DRAW A Y VECTOR JMS I DELAYX /DELAY FOR PEN
TAD K7016 /HATCH MARK GOES TO X=7 DCA LENGTH JMS I XDSPX /DRAW X VECTOR TAD K7027 /RETURN POSITION DCA LENGTH JMS I XDSPX JMS I DELAYX /DELAY FOR PEN ISZ HATCH JMP HACHL /DRAW SOMEMORE CURDIS, TAD CURSWT /SHOULD WE DISPLAY CURSORS/ SNA CLA /CURSWT=0 FOR NO CURSORS JMP HISDIS /DISPLAY THE HISOGRAM JMS DRCURS /DRAW APPROPRIATE LINE FOR CHAN CLA IAC /KNOB 1 JMS DRCURS JMP HISDIS DRCURS, 0 JMS I KNOBSX /GET VALUE OF APPROPRIATE KNOB TAD M1000 DILX /LOAD X DAC DCA I XTEMPX /THIS IS X COOD TAD K0777 DCA I YTEMPX /THIS IS Y COORDINATE TAD M1751 /THIS IS NUMBER OF POINTS TO MOVE DOWN DCA LENGTH JMS I YDISPX JMP I DRCURS HISDIS, TAD K7027 DILX DCA ARITH4 TAD ARITH4 DCA I XTEMPX /INITIALIZE X DAC TAD PNTSWT SZA CLA /POINT PLOT DISPLAY? JMP PPLOT /YES HISLP, JMS I GTDAX /NO, GET SOME DATA JMS I SCLDAX /SCALE IT TAD I YTEMPX /GET LAST Y: RANGE; 777,7026 TAD K752 /RANGE IT FROM 0 TO 1751 CIA TAD ARITH2 /THIS IS THE NUMBER OF POINTS TO GO DCA LENGTH JMS I YDISPX JMS I GETXX /GET DELTA X DCA LENGTH JMS I XDSPX /DRAW AN X VECTOR TAD LAST /HAVE WE REACHED THE LAST BAR? SNA CLA /AC=1 IF WE HAVE JMP HISLP /GO BACK AND DISPLAY MORE DCA LAST /RESET LAST POINT FLAG
TAD I YTEMPX /AND DRAW A LINE TO THE AXIS TAD K752 /CORRECT THE RANGE CIA DCA LENGTH JMS I YDISPX /COME ON DOWN, YOURE FINISHED ON1, TAD PLSWT /FIND OUT IF WE WERE PLOTTING SNA CLA JMP ON /NO PLOTTING TODAY DCA PLSWT /YES WE WERE BUT NOT NO MORE NO-HOW KSF /WAIT FOR SOMEONE TO TURN OFF THE PLOTTER JMP .-1 ON, KSF /WAS SOMEONE TALKING TO US? JMP I IKBRAX /NO. CHECK THE INTERRUPT KRB /YES. LETS SEE IF ITS IMPORTANT DCA I TTYBUF JMP I IKBRAX PPLOT, JMS I GTDAX JMS I SCLDAX TAD ARITH2 /RANGE; 0-1000 TAD M752 /RANGE; 777-7027 DILY CLA JMS I GETXX /GET THE X VALUE FOR THE POINT DILX /DISPLAY THE POINT DISD /WAIT FOR DISPLAY. JMP .-1 DIXY CLA TAD LAST /ARE WE DONE SNA CLA JMP PPLOT /NOOO SIR DCA LAST /YOUD BETTER BELIEVE IT JMP ON1 PANIC, IOF /THIS IS A PANIC STOP DCA I TTYBUF /CLEAR INPUT AREA JMP I .+1 ESTOP YTEMPX, YTEMP XTEMPX, XTEMP XDSPX, XDISP YDISPX, YDISP HATCH, 0 GTDAX, GETDAT SCLDAX, SCLDAT LAST, 0 GETXX, GETDX IKBRAX, IKBRAS K0050, 50 M1751, -1751 K752, 752 M31, -31
M752, -752 K7016, 7016 / / M1000, -1000 / *1200 /THIS IS THE BRANCH TO TABLE FOR ALL KEYBOARD COMMANDS IKBRAS, TAD I TTYBUF SNA /SEE IF THERE IS ANYTHING TO PROCESS JMP NECHO /EXIT BY CLEARING BUFFER BRAN /BRANCH ACCORDING TO FOLLOWING LIST IKLIST JMP HIGHER />: INCREASE ORDER OF DISPLAY JMP LOWER /<: DECREASE ORDER OF DISPLAY JMP CTRLZ /^Z: STOP, CLEAR BUFFERS,WAIT RESTART JMP CTROLA /^A: GO AND GET NEW PARAMETERS JMP CTRLQ /^Q: QUIT DATA TAKING AFTER THIS EPOCH JMP CTRLC /^C: RETURN TO MONITOR JMP I PANICX /^P: PANIC STOP JMP SCALUP /U: SCALE Y BY FACTOR OF 2 JMP SCALDN /D: SCALE Y BY FACTOR OF 1/2 JMP I EXPANX /E: EXPAND AREA BETWEEN CURSORS JMP BNSCAL /B: NEGATE ALL E COMMANDS JMP SUM1 /S: SUM ALL AJACENT BINS JMP ORIG /O: RETURN TO NON SUM MODE RESTRT, JMP UNALT /Z: RETURN TO UNALTERED DISPLAY JMP I AXNAX /A: COMPLEMENT AXIS-NOAXIS SWITCH JMP I CRNCRX /C: COMPLEMENT CURSOR-NOCURSOR SWITCH JMP I VIEWX /V: COMPLEMENT POINT PLOT OR BAR GRAPH SWITCH JMP I USER /^U: USER IMPLEMENTED GROUP I COMMAND JMP ECHO /GROUP I NOT FOUND ECHO AND IGNOR JMP PLOT /P: START OF GROUP II; PLOT HISTOGRAM JMP I KALIBX /K: KALIBRATE THE PLOTTER JMP I TYPOUT /T: TYPE AREA DEFINED BY CURSORS JMP I MSIOX /^W COMMAND TO FIELD 1. JMP I DUMPX /^B: DO A BINARY DUMP OF HISTOGRAM JMP I RETAIN /^R: RETAIN THE DATA AND READY FOR RESTART /A FEW SHORT BRANCH COMMANDS ECHO, TAD I TTYBUF JMS I TYPAX /ECHO THE CHARACTER NECHO, DCA I TTYBUF /CLEAR THE BUFFER JMP I DSUPX HIGHER, ISZ ORDER SKP LOWER, CLA CLL CMA /AC=-1 TAD ORDER SPA /INSURE AGAINST DISPLAYING A NONEXISTANT HIST. CLA CLL /MAKE ORDER 0 TAD M0001 /CANT BE LARGER THAN 1
SMA CLA IAC /MAKE IT JUST 1 NOP /FOR FUTURE VERSIONS HAVING MORE THAN TWO ORDERS DCA ORDER JMP ECHO PANICX, PANIC CTRLZ, IOF JMP I CLBUFX /CLEAR ALL BUFFERS CTROLA, IOF JMP I CTRLAX /GO TO START CTRLQ, CMA DCA MEPOC /SET EPOCH COUNTER TO ONE MORE JMP NECHO CTRLC, IOF CLA CMA CLZE CLA CLL JMP I MONTR SCALDN, CLA CMA CLL RAL /AC=-2 SCALUP, TAD SFACTR IAC /INCREASE BY ONE DCA SFACTR JMS I GETDLX /GET SCALE FACTOR TO MODIFY TAD K0003 /ADJUST POINTER TO SCALE WORD DCA POINT TAD SFACTR DCA I POINT /STORE NEW SCALE FACTOR JMP ECHO /MORE SHORT COMMANDS BNSCAL, JMS I GETDLX /FORGET ALL E COMMANDS DCA POINTA TAD ORDER CLL RAL TAD PERMLI /ADDRESS OF PERMANENT DISPLAY LIST DCA GETPNT TAD I GETPNT DCA I POINTA TAD I GETPNT DCA I POINTA JMP ECHO SUM1, CLL CLA CML RAL JMS I GETDLX /AC BIAS IN GETTING POINTER DCA POINT ISZ I POINT /SUM IS INCREASED BY ONE FOR THIS HISTOGRAM JMP ECHO ORIG, CLA CLL CML RAL JMS I GETDLX DCA POINT IAC DCA I POINT /SUM IS RETURNED TO 1
JMP ECHO UNALT, JMS I INTDLX /RETURN ORIGINAL DISPLAY JMS I INTDSX /RETURN ALL SWITCHES TO NORMAL JMP ECHO PLOT, DCA CURSWT /MAKE SURE THE CURSORS ARE OFF TAD PMODE /SET CLOCK CLOE CMA CLZE /DISABLE SCHMITTS DCA PLSWT /SET PLOTTING SWITCH TAD K0777 /SET DACS DILX /TO LOWER CLA TAD K7027 /RIGHT HAND CONER DILY CLA KSF /WAIT FOR PLOTTER TO BE TURNED ON JMP .-1 KCC /KNOCK DOWN THE FLAG JMP NECHO USER, NECHO MSIOX, MSIO EXPANX, EXPAND AXNAX, AXNA CRNCRX, CRNCR VIEWX, VIEW KALIBX, KALIB RETAIN, RETAN TYPOUT, TYPOX DSUPX, DISUP CLBUFX, CLBUF DUMPX, DUMP K0003, 3 M0001, -1 PMODE, 5400 / / COMBK, DCA BUSY /START HERE FOR JMP RESTRT /RESTART / / *1400 /THIS ROUTINE EXPANDS THE AREA BETWEEN THE CURSORS EXPAND, JMS TWOKNB /READ THE KNOBS JMS I FIXSTX /FIX THE BOUNDARIES JMP I NECHOX /EXIT WITH NON ECHO TWOKNB, 0 JMS KNOBS /READ AND SCALE IT DCA TEMP0 IAC
JMS KNOBS DCA TEMP01 /SAVE IT FOR A MOMENT TAD TEMP01 /THE MOMENT IS UP CIA /NEGATE THE VALUE TAD TEMP0 SMA CLA /WE MUST FIND OUT WHICH IS LEFT JMP KNOB1 /KNOB 0 IS ON THE RIGHT TAD TEMP01 /KNOB 1 IS ON RIGHT TAD M27 JMS DELTA /GET INCREMENT TO MOVE BOUNDARY DCA I ENDX TAD TEMP0 HARRY, TAD M27 JMS DELTA JMP I TWOKNB KNOB1, TAD TEMP0 TAD M27 JMS DELTA DCA I ENDX TAD TEMP01 JMP HARRY AXNA, TAD AXSWT CMA /INVERT THE SWITCH DCA AXSWT JMP I ECHOX CRNCR, TAD CURSWT CMA DCA CURSWT JMP I ECHOX VIEW, TAD PNTSWT SZA CLA /WERE WE DOING POINTS OR BAR JMP BAR /SWITCH TO BARS TAD MXXX DCA KDIM /FIX DIMNESS SWITCHW IAC JMP .+3 BAR, CLA CMA DCA KDIM DCA PNTSWT /=0 FOR BAR GRAPH JMP I ECHOX /KNOBS: SUBROUTINE TO READ AN ADC CHANNEL CONTAINED IN THE AC /RETURN A VALUE SCALED FROM 0027-1777 KNOBS, 0 ADLM /LOAD MUX ADST /START CONVERSION ADSK JMP .-1 ADRB /READ RANGE: 7000-777
TAD K0751 /RANGE IT, -27,1750 SPA CLA /<-27 TAD K0027 /RANGE 27,1777 JMP I KNOBS /A S.R. TO YIELD THE NUMBER OF POINTS CONTAINED IN THE AC /THIS IS FOUND USING THE CURRENT DELTA X AND SUM VALUES /AT THE END OF THE S.R. LOCATION "MANY" HOLDS THE NUMBER /OF BINS EQUAL TO THE AC VALUE AND THE AC HOLDS THE NUMBER OF /POINTS THE POINTER SHOULD BE MOVED DELTA, 0 CIA /NEGATE DCA TEMP06 CMA /AC=-1 DCA MANY DCA ARITH5 /CLEAR AREA DCA ARITH4 EXPNTR, JMS I GETDXX TAD TEMP06 /EACH LOOP WE MOVE ONE MORE DELTA X ISZ MANY NOP /WATCH OUT FOR FIRST SKIP SPA SNA CLA /AND SEE IF WEVE MOVED FAR ENOUGH JMP EXPNTR JMS I FXMSUM /FIX MSUM PNTS, TAD MANY ISZ MSUM JMP .-2 JMP I DELTA /RETURN WITH AC=NUMBER OF POINTS /GETDAT: A SUBROUTINE TO GET A CHUNK OF DATA VIA SUM /DATA IS IN AC ON EXIT GETDAT, 0 CLL CLA /MAKE SURE LINC IS CLEAN JMS I FXMSUM /FIX MSUM SUML, TAD I GETPNT SZL /IS THE NUMBER GETTING TOO LARGE? CLA CLL CMA /SET IT TO 7777 IF >4096 ISZ I MPNTX JMP .+3 ISZ I LASTX JMP I GETDAT /FORCE A DROP THROUGH THE LOOP ISZ MSUM /IS SUM THROUGH? JMP SUML /NO DO MORE JMP I GETDAT /RETURN /SCLDAT: A SUBROUTINE TO SCALE DATA IN ARITH2 ACCORDING TO SCFACTOR /THIS S.R. ALSO CHECKS FOR VALUES TOO LARGE FOR DISPLAY. IF ANY /ARE FOUND THE MAXIMUM VALUE IS RETURNED. SCLDAT, 0 DCA ARITH2 /DATA TO BE SCALED DCA ARITH1 /CLEAR SCALING AREA TAD SFACTR /GET THE SCALE FACTOR
SHFT /SHIFT TAD ARITH1 /LOOK FOR LARGE OVERFLO SZA CLA JMP OVFLO /OVERFLOW TAD ARITH2 /GET INFLATED VALUE SPA /IS IT TOO LARGE JMP OVFLO-1 TAD M1751A /-1000 DECIMAL SMA SZA /TOO LARGE STILL? CLA CLL /YES. SET TO MAX. OVFLO, TAD K1751 /THIS IS ORIGINAL VALUE OR MAX. DCA ARITH2 /SAVE IT HERE JMP I SCLDAT /GO BACK MXXX, -3 ENDX, END MANY, 0 LASTX, LAST MPNTX, MPOINT ECHOX, ECHO GETDXX, GETDX K0751, 751 K1751, 1751 M1751A, -1751 / / M27, -27 K0027, 27 / *1600 /INITDS: A SUBROUTINE TO INITIALIZE DISPLAY SWITCHES INITDS, 0 IAC DCA PNTSWT /NO BAR GRAPH DCA CURSWT /NO CURSORS DCA AXSWT /NO AXIS DCA PLSWT /NO PLOT MODE CMA DCA KDIM /DONT GO OUT OF YOUR WAY TO DIM THE AXIS CMA DCA DIM /READY FOR PLOT JMP I INITDS /GETDL: A SUBROUTINE TO MAKE THE AC EQUAL TO THE LOCATION OF /THE DISPLAY LIST PERTAINING TO THIS HISTOGRAM GETDL, 0 TAD ORDER /WHICH HISTOGRAM ARE WE LOOKING AT CLL RTL /CLEAR LINK AND ROTATE TAD ADDISL /ADDRESS-1 OF THE FIRST HISTOGRAM JMP I GETDL /YDISP: A SUBROUTINE TO DISPLAY OR PLOT A Y VECTOR /FROM THE CURRENT POSITION WHICH IS HELD IN YTEMP
/TO A NEW POSITION. LENGTH HOLDS THE NUMBER OF POSITIONS /TO MOVE. THE SIGN OF LENGTH INDICATES THE DIRECTION /TO MOVE; +UP,-DOWN. YDISP, 0 CLL CLA IAC RAL DCA YINC /SET MC. TO +2 INITIALLY TAD LENGTH SPA CLL CML RAR SNA /DIVIDE BY 2 JMP I YDISP SMA JMP UP /DRAW UP DCA LENGTH CLL CLA CMA RAL /AC=-2 DCA YINC JMP YMOVE YTEMP, 0 UP, CIA DCA LENGTH YMOVE, JMS I DELAYX /CHECK TO SEE IF WE ARE PLOTTING TAD YTEMP /CURRENT Y POSITION TAD YINC /ADD INCREMENT DIXY DILY DCA YTEMP /SAVE IT FOR NEXT TIME ISZ LENGTH /MOVED ENOUGH YET? JMP YMOVE /NO DO MORE JMP I YDISP /ALL DONE WITH VECTOR /XDIS: A SUBROUTINE TO DRAW AN X VECTOR FROM THE CURRENT /POSITION WHICH IS HELD IN XTEMP TO AN ENDING POSITION /WHICH IS HELD IN LENGTH. XDISP, 0 CMA CLA /AC=-1 DCA XINC /SET INITIALLY TO -1 TAD XTEMP /CURRENT POSITION CIA TAD LENGTH /AC HOLDS NUMBER OF POSITIONS TO MOVE SNA /CHECK FOR ZERO JMP I XDISP /RETURN SPA JMP .+5 /MOVE TO THE LEFT CIA ISZ XINC /TO MOVE RIGHT XINC MUST BE POSITIVE XTEMP, 0 /ALWAYS SKIPPED ISZ XINC DCA LENGTH XMOVE, JMS I DELAYX /CHECK TO SEE IF PLOTTING TAD XTEMP /GET CURRENT POSITION
TAD XINC /INCREMENT OR DECREMENT DIXY DILX /DISPLAY THIS POINT DCA XTEMP /SAVE IT FOR NEXT TIME ISZ LENGTH /DONE YET? JMP XMOVE /NO KEEP GOING JMP I XDISP /RETURN TO MAIN /OCTIZE: SUBROUTINE TO CONVERT TTYBUFF INTO OCTAL AND LEAVE /THE RESULT IN THE AC. LOCATION UNIT HOLDS THE NUMBER OF /DECIMAL PLACES IN THE ARGUMENT. OCTIZ, 0 TAD I UNITX /GET RADIX CIA DCA I UNITX /SAVE THIS NUMBER AS A POINTER DCA ARITH1 /CLEAR OUT SHIFTING AREA DCA ARITH2 DCA ARITH4 JMS I SETPTX /GET FIRST VALUE IN AC OCTIZL, AND K0017 /STRIP THE ASCII DCA ARITH5 /PUT IT SHIFTER CLA IAC /AC=1 SHFT DADD /MUTIPLY BY TWO AND ADD CLL CLA IAC RAL SHFT DADD /NOW MULTIPLY BY FOUR /2(X) + 8(X) =10(X) TAD ARITH4 /CHECK FOR OVERFLO SZA CLA JMP I REASKX /THERE WAS AN OVERFLO TAD ARITH5 /GET RESULT OF ADD ISZ I UNITX /ARE WE DONE CONVERSION? JMP .+2 /NO JMP I OCTIZ /YES RETURN FOR MORE INSTRUCTIONS DCA ARITH2 ISZ POINT /POINTER FOR TTYBUF TAD I POINT /GET ANOTHER VALUE JMP OCTIZL /GET MORE INFORMATION /THIS IS A SUBROUTINE TO INCREMENT THE STARTING ADDRESS OF THE /DISPLAY BUFFER WITH THE AC VALUE AND ALSO FIX /THE END OF DISPLAY POINTER WITH THE VALUE FOUND IN END. FIXSTA, 0 DCA FIXINC /HOLD THIS VALUE JMS GETDL /GET ADDRESS OF DISPLAY LIST IAC /MOVE POINTER UP ONE DCA POINT TAD I POINT /GET STARTING ADDRESS TAD END /FIRST FIX THE END DCA END TAD I POINT /GET STARTING ADDRESS
TAD FIXINC /ADJUST START DCA I POINT /AND STORE IT ISZ POINT /MOVE POINTER TO END DISPLAY ADDRESS TAD ORDER CLL CML RAL TAD STRT0X /GET LOCATION OF ENDING ADDRESS FOR THIS DISPLAY DCA TEMP14 TAD I TEMP14 /GET ADDRESS CIA TAD END /ENSURE CURSOR IS NOT PAST PHYSICAL END SPA CLA JMP TADEND TAD I TEMP14 /USE WHICH EVER IS SMALLEST JMP TADEND+1 TADEND, TAD END DCA I POINT JMP I FIXSTA END, 0 YINC, 0 UNITX, UNIT FIXINC=TEMP0 K0017, 17 / / *2000 /INTERRUPT SERVICE ROUTINES INTOUT, CLL CLA /CLEAR VITAL AREAS TAD LSAVE /GET LINK RAL /POSITION IT TAD ASAVE /GET AC ION JMP I 0 /RETURN LSAVE, 0 ASAVE, 0 /ENTRANCE INTERP, DCA ASAVE /SAVE AC RAR DCA LSAVE /AND LINK CLSA /READ AND CLEAR CLOCK RAL /ROTATE CLOCK BIT TO LINK DCA SAFE /SAVE TRIGGER ACTION SNL /TEST FOR TICK JMP SCHMIT /NO TICK ISZ MBINW /RECORD TICK, CHECK BIN WIDTH JMP TOTT /TALLY TOTAL TIME TAD MBINK /RESET BIN WIDTH DCA MBINW ISZ MINT /DONE WITH MIN TIME?
JMP TOTT /NO, GO TO TALLY TOTAL TIME CLA CLL CMA /YES DCA MINT /SET SWITCHES TO "NO MIN TIME" DCA SPOT ISZ MBIN /ARE WE OUTSIDE OF THE TIME FRAME? JMP INCB /NO, INCREMENT BIN POINTER CLA CLL CMA /YES DCA MBIN /STOP BIN POINTER AT OVERFLOW BIN. SKP INCB, ISZ BIN /INCREMENT BIN POINTER TOTT, ISZ MUNIT /TALLY TOTAL TIME JMP SCHMIT TAD KMUNIT DCA MUNIT /RESET TOTAL TIME TIMER ISZ ORD /INCREASE ZERO ORDER POINTER ISZ MEPOC /IS TOTAL TIME UP? JMP SCHMIT /NO JMP ESTOP /YES KBDC, TSF /TTY DONE? JMP TYIN /NO TCF /YES, KNOCK DOWN FLAG DCA BUSY /AND CLEAR SOFTWARE FLAG JMP INTOUT /AND LEAVE TYIN, KSF JMP INTOUT /NO KEYBOARD KRB DCA I TTYBUF /STORE FOR LATER JMP INTOUT SCHMIT, TAD SAFE SNA CLA /NOT HERE JMP KBDC /TRY KEYBOARD TAD M144 /RESET CLOCK CLAB CLA TAD FIRST /IS THIS THE FIRST PULSE OF THE RUN? SZA CLA JMP FST /YES, DON'T RECORD IT BUT RESET EVERYTHING TAD BIN /NO, RECORD PULSE TAD I STRT1X /GET START OF HISTOGRAM DCA INTTEM ISZ I INTTEM /AND RECORD FIRING JMP NOURFL /NO OVERFLOW OF BIN TAD SPOT /OVERFLOW OF BIN SNA CLA /BUT THIS IS OK IF IN MIN TIME ISZ ER1 /THIS IS AN ERROR CMA DCA I INTTEM /SET BIN TO MAX NOURFL, TAD SPOT SNA CLA /IF IN MIN TIME, DON'T RECORD PULSE ISZ I ORD /IN 0 ORDER HISTOGRAM
FST, DCA FIRST /TURN OFF 1ST PULSE SWITCH IAC DCA BIN /RESET BIN POINTER TAD MBINK /RESET BIN WIDTH DCA MBINW TAD MINTK /RESET MINTIM DCA MINT TAD SPOTER /RESET MINTIM SWITCH DCA SPOT TAD MBINS /ALSO OVERFLOW COUNTER DCA MBIN JMP INTOUT ESTOP, TAD I EXTEX /STOP THE RUN SPA /EXTEND KEY BOARD CIA /BRANCH LIST DCA I EXTEX JMS I CRLFX JMS I TYPMX /TYPE "OPM" OPM JMS I CRLFX TAD ER1 JMS I DEFSIX /TYPE OUT NUMBER OF ERRORS SINGLE-1 JMS I CRLFX JMP I DISUPX BIN, 1 MUNIT, 0 ER1, 0 EXTEX, EXTEND DISUPX, DISUP INTTEM, 0 SPOT, 0 SPOTER, 0 / M144, -144 SAFE, 0 MODEA, 0 TAD M144 /-100 CLAB /TO PRESET CLA CLL /CLEAR AC TAD KMODE /CLOCK MODE + RATE CLOE CMA CLZE CLSA /CLEAR CLOCK CLA JMP I MODEA / /
*2200 /THIS ROUTINE TYPES OUT THE VALUES OF THE BINS FOUND BETWEEN THE /CURSORS TYPOX, JMS I GETDLX DCA POINTA /AUTO INDEX POINTER TAD I POINTA DCA TEMSTA /SAVE VALUES FOR USE LATER TAD I POINTA DCA TEMEND JMS I TWOKNX /READ THE KNOBS JMS I FIXSTX /FIX DISPLAY POINTERS ACCORDINGLY JMS I GETDLX DCA POINTA TAD I POINTA /GET STARTING LOCATION OF FIRST VALUE DCA GETPNT TAD GETPNT DCA STAT TAD I POINTA DCA ENDCUR JMS I CRLFX /DO A CR LF TAD ORDER JMS I TYPNUM /TYPE THE ORDER NUMBER JMS I COMMAX JMS I SPACEX TAD SUM JMS I DEFSIX /TYPE SUM FACTOR SINGLE-1 JMS I SPACEX JMS I SPACEX TAD ENDCUR CIA TAD GETPNT /AC HOLDS -NUMBER OF POINTS SNA /INSURE NON ZERO CMA /SET -1 DCA MDATPN JMS I TADVAX /SUM THE POINTS DCA CURSLO /THIS IS THE LO ORDER TAD ARITH4 /THIS IS HIGH ORDER DCA CURSHI TAD ARITH5 JMS I DEFLAX DOUBLE-1 /DEFLATE THIS DOULBLE PRECISION WORD TAD ORDER CLL RAL TAD PERMLI /PERMANENT DISPLAY LIST DCA POINTA TAD I POINTA DCA GETPNT /SET UP FOR SUM OF ALL TAD I POINTA CIA
TAD GETPNT /AC HOLDS -OF POINTS TO SUM SNA /INSURE NON ZERO CMA DCA MDATPN JMS I TADVAX /GET SUM OF ALL ACTIVITY DCA HISLO /SAVE LO ORDER FOR LATER HISLO=FTEM1B TAD ARITH4 DCA HISHI /AND THE HIGH ORDER HISHI=FTEM1A TAD ARITH5 JMS I DEFLAX /DEFLATE AND TYPE OUT DOUBLE-1 /IN DOUBLE PRECISION JMS I DOUBLX /FLOAT A DOUBLE PRECISION WORD HISHI-1 /STARTING HERE SAVE DIVSRH /SAVE IT HERE JMS I DOUBLX CURSHI-1 SAVE DIVSRC /SAVE THE FLOATED QUANTITY FDIV DIVSRH /" DA DIVSRH /FORM RATIO OF ACTIVITY INSIDE CUSORS TO ALL JMS I FRCOUX /TYPE OUT THE FRACTION /TYPE OUT BIN #'S DELIMETED BY CURSORS TAD ORDER CLL RAL TAD KTAD DCA .+1 0 /GET THE ABSOLUTE STARTING LOCATION OF THIS HISTOGRAM CIA /NEGATE TAD STAT /GET THE STARTING LOCATION OF 1ST CURSOR DCA BINSTA /SAVE THE BIN NUMBER OF STARTING ADDRESS TAD BINSTA JMS I DEFSIX /TYPE OUT THE LEFT HAND BIN #. SINGLE-1 TAD STAT /NOW FIND THE ENDING BIN # CIA TAD ENDCUR /BY SUBTRACTING THE STARTING FROM ENDING ADDRESS DCA BINSTP /THIS IS # OF BINS BEING OUTPUT CMA TAD BINSTP TAD BINSTA /ADD TO THE STARTING BIN #. JMS I DEFSIX /TYPE OUT END BIN SINGLE-1 JMS I CRLFX /DO CARRIAGE RETURN LINEFEED DCA MLINES /NOW FIND OUT HOW MANY LINES OF OUTPUT JMS I FXMSUM TAD BINSTP /GET NUMBER OF POINTS JOE, TAD MSUM /SUBTRACT SUMFACTOR
ISZ MLINES SMA SZA JMP JOE CLA CLL TAD MLINES /THIS IS NUMBER OF LINES CIA DCA MLINES TAD BINSTP /ALSO HAVE A POINT COUNTER CIA /FOR FETCHING ROUTINE DCA I MPNTXX TAD STAT JMP SETGET KTAD, TAD I STRT0X TADVAX, TADVAL ENDCUR, 0 MDATPN, 0 CURSHI, 0 CURSLO, 0 DIVSRH, 0 0 0 DIVSRC, 0 0 0 TWOKNX, TWOKNB DOUBLX, DOUBLD FRCOUX, FRCOUT DELTX, DELTA BINSTP, 0 STAT, 0 TYPNUM, TYPNUX MPNTXX, MPOINT *2377 SETGET, DCA GETPNT BGLOOP, JMS I GETDAX /GET A BIN INTO ARITH2 SNA /YES? NO? JMP RIEN /NO! NOTHING DCA HOLD /YES! A NEURON HAS BEEN FIRING HOLD=FTEM1B DCA HOLD-1 /SINGLE PRECISION TAD BINSTA JMS I DEFSIX /TYPE OUT THE BIN NUMBER SINGLE-1 /IN SINGLE PRECISION TAD HOLD /FIRST TELL US DIRECTLY ABOUT THE ACTION JMS I DEFSIX /I.E. HOW MUCH ABSOLUTE ACTIVITY SINGLE-1 JMS DOUBLD /LETS GET A FEW RATIOS ALSO
HOLD-2 FDIV DIVSRC /ACIVITY OVER CURSOR ACTIVITY JMS FRCOUT /TYPE IT OUT JMS DOUBLD HOLD-2 /AGAIN FLOAT THE ACTION FDIV DIVSRH /DIVIDE BY ALL THE ACTION JMS FRCOUT /TYPE OUT THE FRACTION JMS I CRLFX RIEN, JMS I FXMSUM /FIX MSUM ISZ BINSTA /INCREMENT BIN POINTER ISZ MSUM /THIS MANY TIMES JMP .-2 KSF /IS SOMEONE TRYING TO TELL US SOMETHING? JMP SILENC /NO KRB /YES! IS IT IMPORTANT? TAD M221 /I.E. ^Q SNA CLA JMP QUIT /WHOA!! SILENC, ISZ MLINES /ARE WE DONE YET? JMP BGLOOP /NO. GO BACK TO THE BIG LOOP QUIT, JMS I GETDLX /YES. RESTORE THE DISPLAY DCA POINTA TAD TEMSTA DCA I POINTA TAD TEMEND DCA I POINTA JMP I NECHOX /THIS ROUTINE WILL CALIBRATE AN X Y PLOTTER KALIB, TAD K1001 /SET DACS TO LOWER LEFT DILY DILX JMS WAIT1 /WAIT FOR KEYBOARD TAD K0777 /SET DACS TO UPPER RIGHT DILY DILX JMS WAIT1 JMP KALIB WAIT1, 0 KSF JMP .-1 KRB TAD M221 /WAIT FOR ^Q SNA CLA JMP I NECHOX JMP I WAIT1 K1001, 1001 /SOME SUBROUTINES THAT GO WITH THE TYPE OUT ROUTINE TYPNUX, 0
TAD K0060 JMS I TYPAX JMP I TYPNUX FRCOUT, 0 FIX /IF ANS. IS 1 AC WILL EQUAL 1 OTHERWISE SZA /FAC IS LEFT UNCHANGED AND AC=0 JMP UNITY /TYPE OUT A ONE TAD FAC SHFT /FIX FAC WHERE IT LIES TAD K0256 /ASCII FOR . JMS I TYPAX TAD ARITH1 DCA ARITH4 TAD ARITH2 JMS I DEFLAX FRACTN-1 JMP I FRCOUT /EXIT UNITY, JMS TYPNUX JMS I COMMAX JMS I SPACEX JMS I SPACEX JMS I SPACEX JMS I SPACEX JMS I SPACEX JMS I SPACEX JMP I FRCOUT /DOUBLD: A S.R TO FLOAT AND LOAD A DOUBLE PRECISION /WORD TO FAC. LOCATION OF HI ORDER WORD IS CALL+1 DOUBLD, 0 TAD I DOUBLD ISZ DOUBLD /FIX RETURN DCA POINTA TAD I POINTA DCA ARITH1 TAD I POINTA /LO ORDER DCA ARITH2 NORM DCA FAC /PUT THE EXPONENT AWAY JMP I DOUBLD /TADVAL: A S.R. TO ADD ALL THE VALUES FROM LOCATION GETPNT /TO LOCATION GETPNT + (-(MDATPN)) TADVAL, 0 DCA ARITH1 DCA ARITH4 DCA ARITH5 TADLP, TAD I GETPNT DCA ARITH2 DADD /KEEP A RUNNING DOUBLE PRECISION SUM ISZ I MDATX /ENOUGH ADDED? JMP TADLP /NO GO BACK
TAD ARITH5 /HI ORDER IS PLACED FOR DEFLATION JMP I TADVAL /EXIT WITH LOW ORDER IN AC MDATX, MDATPN GETDAX, GETDAT K0060, 60 K0256, 256 M221, -221 YESNO, 331 /Y -316 /N / / / *2600 /MTSB: MORE KEY BOARD COMMAND DUMP, JMS I CRLFX JMS I TYPMX HIGH /ASK FOR HI OR LOW SPEED PUNCH KSF JMP .-1 /WAIT HERE FOR THE ANSWER KRB BRAN YESNO CMA /HIGH SPEED NOP /LO SPEED DCA SPEED /LOW SPEED SPEED=TEMP10 JMS I CRLFX JMS I TYPMX ID /ASK FOR ID NUMBER JMS I TTINX /ACCEPT ID NUMBER JMS LEADER /TYPE SOME LEADER TRAILER TAD TTYBUF /GET LOCATION OF BUFFER DCA POINT IDLOOP, TAD I POINT /GET A VALUE TAD M215 /LOOK FOR END OF ID CLA SNA JMP ENDID TAD I POINT ISZ POINT /MOVE POINTER ON JMS PUNCH /PUNCH OUT THAT CHARACTER JMP IDLOOP ENDID, JMS LEADER /DO LEADER BEFORE BINARY DCA CHECKS /CLEAR CHECK SUM AREA JMS ADDRES K4, 4000 /PUNCH THE ADDRESS OF DISPLAY LIST TAD PERMLI JMS PO /PUNCH DATA STARTING AT PERMLI+1 -4 /FOUR CHARACTERS TAD ORDER CLL RAL /TIMES TWO
TAD PERMLI DCA POINTA TAD I POINTA /GET STARTING ADDRESS DCA HISTA HISTA=TEMP01 TAD I POINTA /AND ENDING ADDRESS CIA TAD HISTA /AC HOLDS MINUS NUMBER OF POINTS TO PUNCH DCA HGRAM TAD HISTA IAC DCA AD JMS ADDRES /PUNCH ADDRESS AD, 0 TAD HISTA JMS PO HGRAM, 0 /PUNCH THIS MANY POINTS /NOW DO CHECK SUM TAD CHECKS JMS OUTPUT JMS LEADER /STICK IN SOME LEADER TRAILER JMP I NECHOX ROT, 0 RTR RTR RTR AND K0077 JMP I ROT ADDRES, 0 /SUB TO PUNCH OUT ADDRESS CONTAINED IN CALL+1 TAD I ADDRES JMS ROT /ROTATE IT TAD K0100 /ADDRESS CODE JMS PUNCH TAD I ADDRES AND K0077 JMS PUNCH ISZ ADDRES /ADJUST RETURN JMP I ADDRES /AND RETURN K0100, 100 PO, 0 /S.R. TO PUNCH OUT BUNCH OF DATA DCA POINTA /AUTO INDEX AC TAD I PO /GET NUMBER OF POINTS DCA TEMP03 ISZ PO /FIX RETURN LUCY, TAD I POINTA /GET A VALUE JMS OUTPUT /OUTPUT IT ISZ TEMP03 JMP LUCY JMP I PO CHECKS, 0
LEADER, 0 TAD M100 DCA LEAD LEAD=TEMP02 TAD K0200 JMS PUNCH ISZ LEAD JMP .-3 JMP I LEADER /OUTPUT A SUBROUTINE TO OUTPUT WORD IN AC TO HI OR LO /SPEED PUNCH LEFT HALF THEN RIGHT HALF OUTPUT, 0 DCA OUTBUF /SAVE THE CHARACTER TAD OUTBUF JMS ROT JMS PUNCH /CHARACTER WILL BE STRIPPED TAD OUTBUF AND K0077 JMS PUNCH JMP I OUTPUT PUNCH, 0 DCA OUT OUT=TEMP05 TAD LEAD /ARE WE PUNCH THINGS WHICH SHOULD SZA CLA /BE INCLUDED IN THE CHECKSUM? JMP SPD /NO TAD OUT /YES GET CHARACTER TAD CHECKS /ADD TO CHECKSUM DCA CHECKS /STORE IT AGAIN SPD, TAD SPEED /HIGH OR LOW SPEED PUNCH SZA CLA JMP HI /HIGH SPEED GO! TAD OUT /LOW SPEED HURRY UP JMS I TYPAX JMP I PUNCH HI, TAD OUT PLS /PUNCH IT PSF JMP .-1 /WAIT TIL ITS DONE PCF /KNOCK DOWN THE FLAG CLA JMP I PUNCH OUTBUF, 0 K0200, 0200 M100, -100 / / / / /
/THIS IS THE KEY BOARD BRANCH LIST FOR THE WAIT BEFORE START UP STLIST, 223 /^S 203 /^C 201 /^A -212 /LF AND END OF LIST /DEFLATION TABLES FOR DOUBLE, SINGLE PRECISION DOUBLE, 7413 /1 MILLION HI ORDER 6700 /LO ORDER 7747 /100,000 HI ORDER 4545 7775 /10,000 HI ORDER 4360 SINGLE, 7777 /1,000 HI ORDER 6030 7777 /100 HI ORDER 7634 7777 /10 HI ORDER 7766 7777 /1 HI ORDER 7777 0 /END OF LIST /MESSAGES THAT ARE TO BE TYPED ARE STORED HERE /LETTERS ARE STORED TWO TO A WORD. 40 MUST BE ADDED TO /THE HALF WORD TO GET A VALID ASCII CHARACTER /A ZERO WILL TERMINATE THE MESSAGE. QUES, 3700 /? END BINW, 4251 /BI 5667 /NW 3500 /= END BINS, 4251 /BI 5663 /NS 3500 /= END MIN, 5551 /MI 5664 /NT 5155 /IM 3500 /= END CORE, 4357 /CO 6245 /RE 3700 /? END HIGH, 5051 /HI 4750 /GH 3700 /? END ID, 5144 /ID 1600 /. END OPM, 5760 /OP 5500 /M END /COMMON SUBROUTINES (SUBS) / / /TYPA; TYPE CONTENTS OF AC
/RETURN WITH AC=0 TYPA, 0 DCA TEMP0 /SAVE THING TO BE TYPED OTTY, TAD BUSY /TTY BUSY? SZA CLA JMP COOLIT NOW, TAD TEMP0 /DO IT TLS CLA CLL ISZ BUSY /SET FLAG JMP I TYPA /RETURN COOLIT, TSF JMP OTTY /STILL BUSY TCF /DONE DCA BUSY /CLEAR FLAG JMP NOW /AND TYPE / / /CRLF; TYPE CR AND LF /RETURN AC=0 CRLF, 0 TAD K15 JMS TYPA TAD K12 JMS TYPA JMP I CRLF K15, 15 K12, 12 / / /SPACE;TYPE A SPACE SPACE, 0 TAD K0040 JMS TYPA JMP I SPACE / / /SETPNT;SET POINTR TO START OF TTYBUF /RETURN WITH FIRST VALUE IN AC SETPNT, 0 TAD TTYBUF DCA POINT TAD I POINT JMP I SETPNT / / /LISN; GET CHARACTER FROM KEYBOARD LISN, 0 KSF JMP .-1
KRB JMP I LISN /DEFLAT: A ROUTINE TO DEFLATE A NUMBER IN ARITH4 AND 5 /BY A TABLE OF VALUES WHOSE LOCATION IS FOUND IN /CALL +1. AC HOLDS THE LOW ORDER OF THE WORD TO BE DEFLATED /A ZERO IN THE TABLE INDICATES THE END OF DEFLATION DEFSIN, 0 /ENTRANCE FOR SINGLE PRECISION DEFLATE DCA ARITH5 TAD DEFSIN DCA DEFLAT /CORRECT EXIT DCA ARITH4 /CLEAR THE AREA JMP .+3 /GET INTO THE ROUTINE DEFLAT, 0 DCA ARITH5 /STORE LOW ORDER TAD I DEFLAT /GET LOCATION OF TABLE DCA POINTA ISZ DEFLAT /ADJUST RETURN DRADIX, TAD I POINTA SNA /ARE WE AT THE END OF THE LIST? JMP NOMORE /YES DCA ARITH1 /NO SET UP NEW DEFLATOR TAD I POINTA DCA ARITH2 /HI AND LO ORDER DCA RADIX /CLEAR THE RADIX INDICATOR DEFLOP, DADD TAD ARITH4 /CHECK TO SEE WHEN THE RESULT TURNS NEGATIVE SPA CLA JMP NEG ISZ RADIX /OK LETS GO SOME MORE JMP DEFLOP NEG, CLL /CLEANSE THE LINC TAD ARITH2 CIA /WE MUST CORRECT THE OVER INFLATION DCA ARITH2 TAD ARITH1 CMA SZL /ACCOUNT FOR ANY CARRIES IAC DCA ARITH1 DADD /NOW FAC HOLDS ORIGINAL VALUE TAD RADIX /GET NUMBER OF GOOD DEFLATIONS JMS I TYPNX JMP DRADIX NOMORE, JMS I COMMAX /ALL DONE STICK IN A SPACE JMS SPACE /AND ANOTHER JMP I DEFLAT TYPNX, TYPNUX RADIX, 0 FSUM, 0 TAD SUM
CIA DCA MSUM JMP I FSUM *3200 /FRACTIONS FRACTN, 7463 /0.1/10 HI ORDER 1464 /LO ORDER 7753 /0.1/100 HI ORDER 4122 7775 /0.1/1,000 HI ORDER 7473 7777 /0.1/10,000 6271 0 /END OF DEFLATION LIST /CMIN: CHECK ANSWER TO MIN TIME AND STORE CMIN, 0 JMS I FIGX CMA DCA MINTK /STORE NEGATIVE AWAY JMS I FIGX SZA CLA /SET UP FOR IAC DCA I SPOTX /NO MIN TIME JMP I CMIN /RETURN FOR SOME FUN NOW CTIME, 0 TAD MBINK DCA TMBIN TMBIN=TEMP12 JMS I CBINNX TAD MBINK DCA KMUNIT /STORE TAD TMBIN DCA MBINK JMP I CTIME TIME, 6451 /TI 5545 /ME 7465 / U 5651 /NI 6435 /T= 0000 /END UNITS, 0365 /#U 5651 /NI 6463 /TS 3500 /=END
SPOTX, SPOTER CBINNX, CBINW FIGX, FDIGC *3270 DISL, 0 /DISPLAY LIST 0 /FOR HISTOGRAMS 0 /BEING DISPLAYED 0 /STARTING ADDRESS 0 /THEN END ADDRESS 0 /SCALE FACTOR 0 /AND SUM FACTOR FOR EACH 0 /HISTOGRAM / *3300 /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 *3400 /2-PAGE FLOATING POINT PACKAGE [SU64AB] - REQUIRES [SU63A] /LOAD, SAVE, DCOM, NORM, FMUL, FIX, DFIX, FADD, FDIV, FLOAT /FLOATING POINT FORMAT /WORD1:EXPONENT (2S COMPLEMENT) /WORD2:HI ORDER MANTISSA /WORD3:LO ORDER MANTISSA / /MANTISSA IS REPRESENTED IN 24 BIT, 2S 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 SHFR 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 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 DONT 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 *4000 START0, 4003 /START-1 END0, 0 START1, 0 END1, 0 *7432 /ROUTINE TO LISTEN FOR SCHMITT TRIGGER /WHEN TRIGGER FOUND A SWEEP IS MADE OF ANALOG CHANNEL 2 /THIS FEATURE IS OF USE WHEN AN ANALOG /SIGNAL IS USED TO FIRE THE SCHMITT TRIGGER. TRIG, TAD CTRLAX DCA I ONCEX DCA BUSY /INCASE THIS IS DONE AGAIN JMS I TYPMX TRIGG /TYPE OUT THE MESSAGE SETCLK, CLA CLL IAC RAL /AC=2 CLOE CMA CLZE /CLOCK ENABLES ONLY SCHMITT 2 CMA IAC ADLM /LOAD MUX TO CHANNEL 3 TAD K0200A ADLE /A/D START ON CLOCK OVERFLOW DILC /CLEAR DISPLAY ADST ADSK JMP .-1 ADRB /READ THE A/D TAD K6677 /RANGE: -102,-2101 CLAB CLSA KBD, KSF JMP S1T /NO ACTION, TRY TRIGGER KRB /ACTION! READ IT! TAD M215 /CHECK FOR CLA SNA JMP I CTRLAX /PROCEED TO MAIN PROGRAM S1T, CLSA /CHECK FOR SCHMITT SNA JMP KBD ADLM /LOAD MUX WITH 2 ADST TAD K5640 CLOE
CMA CLZE ADSK JMP .-1 ADRB DCA BASE /THIS IS THE BASE LINE TAD M2000 DCA TEMP0 TAD KM1000 TSAM, IAC DILX DCA XCORD ADSK JMP .-1 ADRB DILY DISD JMP .-1 DIXY CLA TAD BASE DILY DISD JMP .-1 DIXY CLA TAD XCORD ISZ TEMP0 JMP TSAM CLA JMP SETCLK M2000, -2000 K0200A, 200 K6677, 6677 K5640, 5640 KM1000, -1000 XCORD, 0 BASE, 0 ONCEX, ONCE TRIGG, 6462 /TR 5147 /IG 4745 /GE 6200 /R END /THIS IS THE MAJOR BRANCHING LIST IKLIST, 276 /> 274 /< 232 /^Z 201 /^A 221 /^Q 203 /^C
220 /^P 325 /U 304 /D 305 /E 302 /B 323 /S 317 /O 332 /Z 301 /A 303 /C 326 /V EXTEND, 225 /^U AND LIST EXPANDER 000 /DUMMY FOR SKIP OF ECHO 320 /P 313 /K 324 /T 227 /^W 202 /^B -222 /^R
/ /ROUTINE TO READ AND WRITE DATA TO MASS STORAGE. FIELD 1 *7400 MSSTRT, CDF 0 TAD (2001 DCA I (7746 /SET JOB CONTROL WORD 0 CDF CIF 10 JMS I (7700 /CALL COMMAND DECODER. 5 0 0 TAD (7601 /SET FILE NAME ADD. DCA MSTR2 TAD I (7600 /CREATE FILE. SNA CLA /TEST FOR INPUT JMP MSTR7 /INPUT. TAD (221 /MAX. SIZE OF FILE IS 9. JMS I (7700 /CALL FILE CREATE. 3 MSTR2, 7601 /RETURN START BLOCK OF FILE. MSTR3, 0 /RETURN -BLOCK LENGTH. JMP ERRO TAD (2 /SET LOCATION 0=2 FOR TIH CODE. CDF 0 DCA I (0 CDF 10 TAD MSTR2 /SET ARG. TO WRITE PAGE 0 DCA MARG3 TAD (4200 DCA MARG1 DCA MARG2 JMS MSTRW /WRITE PAGE 0. TAD (-3577 /SET UP WRITE THE DATA /WRITE FROM 3600 TO INSURE FULL BLOCK /WRITES WHEN MAX HISTOGRAM USED. CDF 0 /CALCULATE SIZE OF DATA. TAD I (END1 /WRITE FROM 4000 TO END OF DATA /END1 HAS END OF DATA ADD. CDF 10 DCA MSTRW /SAVE # OF WORDS TO WRITE. TAD MSTRW /CALCULATE # OF 128 RECORDA TO WRITE. AND (7600 CLL RAR DCA MARG1 TAD MSTRW AND (177 /TEST FOR PARTIAL RECORD. SZA CLA TAD (100 TAD MARG1 TAD (4000 DCA MARG1 TAD (3600 DCA MARG2 ISZ MARG3 JMS MSTRW /WRITE DATA. TAD MARG1 /FIND # OF 256 BLOCKS USED. CLL RTR RTR RTR /SHIFT INTO BITS 7-11. RAR /DIVIDE BY 2. AND (17 /SAVE ONLY BITS 8-11. SZL IAC /ADD 1 FOR HALF A BLOCK. IAC /ADD 1 FOR BLOCK 1. DCA MARG4 CLA IAC /CLOSE FILE ON SYS: JMS I (7700 4 7601 /NAME ADDRESS. MARG4, 0 /NUMBER OF BLOCKS. JMP ERRO MEXIT, CDF CIF 0 CLA CLL JMP I .+1 COMBK MSTMP1, MSTRW, 0 /WRITE SUBROUTINE. CIF 0 JMS I (7607 /SYS: ONLY. MARG1, 0 MARG2, 0 MARG3, 0 JMP ERRO JMP I MSTRW ERRO, CDF 10 JMS I (7700 7 1 MSTR7, TAD I (7620 /READ PAGE 0 SNA /TEST FOR NO INPUT. JMP ERRO DCA MARG3 TAD (200 DCA MARG1 DCA MARG2 JMS MSTRW /READ EXECUTE. ISZ MARG3 /READ DATA TAD I (7617 /CALCULAT # 0F 128 BLOCKS TO READ. CMA /SET POSITIVE,DON'T ADD 20 AND (7760 /TO SUBTRACT 1ST BLOCK. CLL RTL /ROTATE TO BITS 1-5. RAL DCA MARG1 TAD (3600 DCA MARG2 JMS MSTRW JMP MEXIT $



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