1 /LAB8E ADVANCED AVERAGER MS (HP7475A) - DISPLAY AND PLOT OUTPUT.
5 /VERSION FOR HP7475A PLOTTER
8 /DIGITAL EQUIPMENT CORPORATION
9 /MAYNARD, MASSACHUSETTS 01754
11 /UPDATE 7-AUG-1984 HA UNIVERSITY GOETTINGEN
12 /FIXES BUG IN OVRLAY ROUTINE
15 /UPDATE 29-JAN-1985 KJS UNIVERSITY GOETTINGEN
16 /PLOTTER CONTROL CHANGED
17 /COPYRIGHT 1985 BY KJS
19 /SECTION IV OF THE LAB8/E ADVANCED AVERAGER .
20 /THIS IS PART 4 OF ADVANCED AVERAGER FOR OS-8.
31 CDF 0 /CHAIN IN WRITE DATA TO DISK
32 DCA I KC7746 /0 PS8 JOB STATUS WORD.
33 TAD I XXOV4A /OVERLAY.
50 \f/LAB-8 ADVANCED AVERAGER - SECTION 4 - [U63A.4]
51 /COPYRIGHT 1971, DIGITAL EQUIPMENT CORP., MAYNARD, MASS. 01754
54 PWAITD=60 /CONTROLS PEN UP/DOWN DELAY TIME
56 /BASIC SUBROUTINES [SU63A]
57 BRAN=JMS I 132 /BRANCH ACCORDING TO AC MATCH WITH LIST
58 SHFT=JMS I 133 /DOUBLE PRECISION ARITHMETIC SHIFT
59 DADD=JMS I 134 /DOUBLE PRECISION ADD
72 /TEMPORARY STORAGE REGISTERS 146=177
92 /TEMPORARY STORAGE AND MULTIPLE ACCUMULATORS
111 /TEMPORARY STORAGE AND TTY-KBD BUFFERS
121 /IOT REFERENCES FOR THE LAB/8E
124 /AD8-EA 10 BIT A/D CONVERTER
128 ADLM=6531 /LOAD MPLXR
129 ADST=6532 /START CONVERSION
130 ADRB=6533 /READ AD BUFFER
131 ADSK=6534 /SKIP ON AD DONE
132 ADSE=6535 /SKIP ON TIMING ERROR
133 ADLE=6536 /LOAD ENABLE REGISTER
134 ADRS=6537 /READ STATUS REGISTER
136 /VC8-E POINT PLOT DISPLAY
139 DICD=6051 /CLEAR DONE FLAG
140 DISD=6052 /SKIP ON DONE FLAG
141 DILX=6053 /CLEAR DONE FLAG LOAD X
142 DILY=6054 /CLEAR DONE FLAG LOAD Y
143 DIXY=6055 /CLEAR DONE, INTENSIFY, SET DONE
144 DILE=6056 /LOAD ENABLE CLEAR AC
145 DIRE=6057 /ENABLE TO AC
147 /DK8-EP REAL TIME CLOCK
149 CLZE=6130 /ZERO TO ENABLE
150 CLSK=6131 /SKP ON CLOCK FG
151 CLOE=6132 /ONES TO ENABLE
152 CLAB=6133 /AC TO CLK BUF AND COUNTER REGISTER
153 CLEN=6134 /ENABLE TO AC
154 CLSA=6135 /STATUS TO AC AND AC ONE'S CLEAR STATUS REG.
155 CLBA=6136 /CLK BUF TO AC
156 CLCA=6137 /CLK CNTR TO AC AND TO AC
158 /DB8-EA 12 CHANNEL DIGITAL I/O
160 DBDI=6500 /DISABLE INTERRUPT
161 DBEI=6501 /ENABLE INTERRUPT
162 DBSK=6502 /SKIP ON INPUT
163 DBCI=6503 /CLEAR INPUT BITS WITH SET AC BIT
164 DBRI=6504 /READ INPUT
165 DBCO=6505 /CLEAR OUTPUT BITS WITH AC BITS
166 DBSO=6506 /SET OUTPUT BITS WITH AC BITS
167 DBRO=6507 /READ OUTPUT REGISTER
170 MTH=CLA CMA CLL RTL; MTW=CLA CMA CLL RAL
171 TWO=CLA CLL CML RTL; TWOK=CLA CLL CML RTR
175 CDF=6201; RDF=6214; RMF=6244
208 /SUBROUTINE TO READ VALUE OF A KNOB
212 TAD I KC7600 /RESTORE BLOCK ADD. FOR CHAIN IN LOC 7.
221 ADST /START CONVERSION
224 ADRB /READ RANGE: 777,-1000
225 TAD K6777 /RANGE -3777, -1
228 /SUBROUTINE TO LOAD Y DAC AND DISPLAY
232 DISD /WAIT FOR SETTLE
237 / LINKS TO PLOTTER SUBROUTINE IN FIELD 3
246 /THIS SECTION DISPLAYS, SCALES, AND OUTPUTS M, C, 1000T
248 /MAIN DISPLAY AND INITIATION FOR SECTION 5
249 START, TAD I K0200 /SET JOBLIST POINTER TO FIRST JOB
251 DCA JPNTR /JOB LIST POINTER
253 DCA SFACTR /PRESET SCALE FACTOR
255 TAD KPLOT /AUTO RESET AT 1 MS A TICK
261 DCA PMODE /PMODE .NE. 0 FOR NO PLOT
263 JMS I JSETX /SETUP DATA POINTERS, COUNTERS, DISPLAY
264 TAD TJTYPE /GET #LOC TO SKIP OVER WHEN DISPLAYING MEAN
267 IAC /SD. AND TREND, SKIP 3
268 TAD K0002 /S.D., SKIP 2
272 JMP DISAVG /NO, GO DISPLAY
273 KRB /YES, GET CHARACTER
274 BRAN /CHECK AGAINST RESPONSE LIST
276 MTW /X - EXPAND, SCALE UP
277 JMP NEWSF /C - CONTRACT, SCALE DOWN
278 JMP I PGRDAX /P - FIRST GRID, THAN DATA
279 JMP I PDAX /D - DATA ONLY
280 JMP I TDATAX /T - TYPE DATA
282 JMP NXTJOB /CR - DISPLAY NEXT JOB
283 JMP I IDATAX /I - INTEGRATE
284 JMP I OVRLAX /^W - WRITE DATA.
285 JMP I OS8 /^C - RETURN TO OS8.
286 JMP START /^Z - FIRST JOB
287 KECHO, TAD TEMP02 /ECHO
290 DISAVG, JMS GDATAS /GET M (2 WDS) AND SCALE
291 JMS I DISPX /DISPLAY M/2^K
292 JMS I BLKCNX /MOVE TO NEXT, CHECK FOR END
293 JMP DISAVG /NOT ENDED, DISPLAY NEXT POINT
294 CLA CMA /ENDED, IS JOB TYPE=1?
295 TAD TJTYPE /(1 FOR MEAN ONLY)
297 JMP DISEND /YES, DISPLAY OF JOBS IS DONE
298 JMS I JSETX /NO, SETUP TO DISPLAY MEAN + CF'S
300 DISPSD, JMS GDATAS /GET M AND SCALE
301 DCA TMEAN /SAVE M/(2^K)
303 JMS GDATAS /GET 2S/SQRT(N) AND SCALE
304 TAD TMEAN /[M+2S/SQRT(N)]/2^K
305 JMS I DISPX /DISPLAY IT
306 MTW /SKIP OVER TREND IF PRESENT
307 JMS I BLKCNX /MOVE TO NEXT DATA POINT, CHECK FOR END
308 JMP DISPSD /NOT ENDED, DISPLAY NEXT POINT
309 JMS I JSETX /ENDED, SETUP FOR DISPLAY OF MEAN - CF
310 DISMSD, JMS GDATAS /GET NM AND SCALE
311 DCA TMEAN /SAVE M/2^K
312 JMS GDATAS /GET 2S/SQRT(N) AND SCALE
314 TAD TMEAN /[M-2S/SQRT(N)]/2^K
315 JMS I DISPX /DISPLAY IT
316 MTW /SKIP OVER TREND IF PRESENT
317 JMS I BLKCNX /ANY MORE POINTS?
318 JMP DISMSD /MORE POINTS TO DISPLAY, CONTINUE
320 TAD TJTYPE /(3 FOR AVG, CF, AND TREND)
322 JMP DISEND /NO, DISPLAY OF THIS JOB IS DONE
323 JMS I JSETX /YES, SETUP TO DISPLAY 1000T
324 DCA TSKIP /SKIP NO POINTS AFTER TREND
325 DISTRN, TAD K0004 /SKIP MEAN AND CF
328 JMS I GCDFSX /GET 1000T
334 JMS I DISPX /DISPLAY RANGES FROM -377+0 TO -377+177
335 JMS I BLKCNX /MOVE TO NEXT DATA PNT, CHECK FOR DONE
336 JMP DISTRN /NOT DONE. DO NEXT POINT
338 DISEND, TAD PMODE /NO MORE POINTS IN THIS JOB
339 SZA CLA /ARE WE PLOTTING?
340 JMP DISJOB /NO, RESTART JOB
343 JMP DISJOB /RESUME DISPLAY MODE
345 \f/SUBROUTINE TO GET DBL DATA WORD AND SCALE
346 /RESULT IN ARITH2 AND AC
348 JMS I GCDFSX /GET CDF AND 1ST WORD
349 DCA ARITH1 /SAVE IN HI FAC (*)
350 TAD I GETPNT /GET LO ORDER PART (*)
352 CDF 0 /BACK TO FIELD 0 (*)
359 NEWSF, CMA /AC=-1 FOR C, +1 FOR X
384 /SAVE SCALE AND GO TO NEXT JOB
385 NXTJOB, TAD JPNTR /MASK SCALE FACTOR INTO J1 BITS 8-11
386 DCA PJPNT /ADDRESS OF J1 FOR CURRENT JOB
388 TAD I PJPNT /J1: A/B(1), SF(5), 1(1), CHORD(5)
389 AND K4077 /MASK OUT OLD SF
390 DCA I PJPNT /J1: A/B(1), 0(5), 1(1), CHORD(5)
392 SPA /SCALE FACTOR LESS THAN 0 ILLEGAL
396 TAD I PJPNT /J1: A/B(1),0(5), 1(1), CHORD(5)
397 DCA I PJPNT /J1: A/B(1), SF#(5), 1(1), CHORD(5)
398 TAD K0006 /MOVE TO NEXT JOB
401 JMS CRLFS /TYPE <CRLF>
404 JMP I DISJOX /DISPLAY NEXT JOB
405 JMP I .+1 /NO MORE JOBS, DISPLAY FIRST AGAIN
418 \f/SUBROUTINE TO SET UP DATA POINTERS, COUNTERS, AND DISPLAY
420 TAD I JPNTR /GET J2 TYPE (4), SORT CODE (8)
421 RTL /PUT TYPE IN AC8-11
424 AND K0017 /MASK OUT REST OF J2
425 DCA TJTYPE /TYPE CODE
427 TAD I JPNTR /J3: LINK 1 (- COUNT OF FIRST BLOCK)
430 TAD I JPNTR /J4: LINK 2 (DATA FIELD FOR FIRST BLOCK)
432 TAD I JPNTR /J5: LINK 3 (START OF FIRST BLOCK-1)
436 TAD I JPNTR /J6: DELTAX (8), YSCALE (4)
437 DCA ARITH2 /PREPARE TO SHIFT TO SETUP BINARY POINT OF DX
439 TAD K0005A /DELTAX (8): INTEGER PART (5), FRACTION (3)
446 TAD KM0005 /MOVE JOB POINTER BACK TO TOP OF JOB
449 TAD PMODE /PLOT MODE?
453 JMS I HPENU / P E N U P
455 DILX /SET DISPLAY X TO LEFT EDGE
457 \f JMS KNOBS /GET CURRENT CURSOR SETTING FROM KNOBS 0 AND 1
483 PGRDA, CLA / PLOT GRID AND DATA
496 \f/SUBROUTINE TO TYPE ASCII IN AC
505 /SUBROUTINE TO TYPE <CRLF>
514 /SUBROUTINE TO DISPLAY POINT: SCALE, BIAS, INCREMENT X
518 TAD ARITH4 /X FOR NEXT POINT
524 TAD PMODE /RUNNING PLOTTER?
526 JMP DXINC /NO, INCREMENT X AND CONTINUE
528 JMS I HPLOT / PLOT DATA (ARITH4,YSAVE)
530 DXINC, TAD DELTAX /SETUP X FOR NEXT POINT
534 DADD /INCREMENT BY DISTANCE BETWEEN POINTS
535 JMS CURSES /CURSOR REACHED?
540 CRCNTR=TEMP01 /INTENSIFY CURSOR
553 /SUBROUTINE TO MOVE TOWARD CURSOR
557 JMP I CURSES /EXIT, AT CURSOR1
559 ISZ CURSES /NOT AT CURSOR, EXIT TO CALL+2
560 JMP I CURSES /IF AT CURSOR2, EXIT TO CALL+1
562 /SUBROUTINE TO CHECK BLOCK AND LINK TO NEXT IF REQUIRED
563 /EXIT TO CALL +2 IF END OF FILE REACHED
565 TAD TSKIP /MOVE GETPNT TO NEXT DATA POINT
568 ISZ BLCNTR /BLOCK COMPLETE?
569 JMP I BLKCNS /NO, CONTINUE
570 JMS GCDFS /YES, END OF FILE?
571 SNA /L1: -COUNT FOR NEXT BLOCK (*)
572 ISZ BLKCNS /END OF FILE EXIT TO CALL+2(*)
573 DCA BLCNTR /RESET COUNTER(*)
574 TAD I GETPNT /L2: CDF N (*)
575 DCA GCDF /RESET DATA FIELD (*)
576 TAD I GETPNT /L3: START OF NEW BLOCK-1(*)
577 DCA GETPNT /RESET DATA POINTER(*)
581 /SUBROUTINE TO SET DATA FIELD AND GET 1 WORD
583 GCDF, CDF /CURRENT DATA FELD
584 TAD I GETPNT /GET DATA (*)
593 DCA TSKIP /SKIP NOTHING
594 TYPLUP, TAD TJTYPE /JOB TYPE: 1, 2, OR 3
598 JMS I CRLFX /NEW LINE
599 TAD CHANNL /TYPE DATA POINT #
601 JMS SHFTYP /TYPE SCALED MEAN IN MV
602 ISZ TYPCNT /CF COMPUTED?
605 JMS SHFTYP /TYPE SCALED CF IN MV
606 ISZ TYPCNT /TREND COMPUTED?
607 JMS ABSTYP /TYPE 1000T
608 TYPEND, JMS I CURSEY /REACHED SECOND CURSOR?
611 JMS I BLKCNY /CHECK FOR END OF JOB
612 JMP TYPLUP /NOT ENDED, CONTINUE
616 JMS I CRLFX /NEW LINE
617 JMP I DISJOY /DONE. RETURN TO DISPLAY
620 K0254, 254 /ASCII COMMA
622 KMD1K, -1750 /-1000(10)
624 KMD100, -144 /-100(10)
636 \f/GET DOUBLEWORD DATA POINT, SCALE BY 4, SIGN EXTEND, TYPE SIGNED
638 JMS I GDATAY /GET DOUBLEWORD AND SCALE BY SF
639 JMS I SGNTYX /TYPE SIGNED VALUE IN AC
642 /TYPE ABSOLUTE VALUE SINGLE WORD IN DATA BLOCK
644 JMS I GCDFSY /GET DATA WORD (*)
646 JMS NUMTYP /TYPE DECIMAL VALUE IN AC
649 /TYPE DECIMAL VALUE IN AC
651 DCA ARITH4 /# TO RADIX DEFLATE
652 TAD KMD1K /REDUCE BY FACTORS OF 1000(10)
653 JMS GDIGIT /TYPE DIGIT FOR 1000'S
654 TAD KMD100 /REDUCE BY FACTORS OF 100(10)
655 JMS GDIGIT /TYPE DIGIT FOR 100'S
656 TAD KMD010 /REDUCE BY FACTORS OF 10'S
657 JMS GDIGIT /TYPE DIGIT FOR 10'S
658 CLA CMA /REDUCE BY FACTORS OF 1
659 JMS GDIGIT /TYPE DIGIT FOR 1'S
661 JMS I TYPEY /TYPE 1 COMMA
664 /SUBROUTINE SETS UP FOR TYPING
667 CLA CMA /MOVE POINTER BACK TO SWEEP COUNT
670 JMS ABSTYP /# OF SWEEPS IN AVERAGE
671 TAD SFACTR /SCALE FACTOR
673 CLA CLL IAC /TYPEOUT IS IN MV (2MV/COUNT)
676 DCA CHANNL /DATA POINT # INIT TO 0
678 PRESKP, JMS I CURSEY /LOOK FOR FIRST CURSOR
679 JMP I PRETYP /FOUND IT, EXIT
680 ISZ CHANNL /NO CURSOR YET, INDEX POINT #
682 JMS I BLKCNY /STEP THRU DATA POINT
683 JMP PRESKP /MORE DATA POINTS, CONTINUE
684 JMP TYPDUN /END OF DATA POINTS AND NO CURSOR, GO BACK TO DISPLAY.
686 \f/SUBROUTINE TO PRINT MESSAGE AND WAIT FOR CR
688 TAD I TMESS /ADDR OF MESS-1 AT CALL+1
691 ISZ TMESS /EXIT TO CALL+2
692 TAD I TYPNTR /GET NEXT CHARACTER
693 SNA /0 INDICATES END OF MESS.
695 JMS I TYPEY /TYPE CHARACTER
698 TWAIT, KSF /END, WAIT FOR CR
703 JMP I DISJOY /^Q TYPED, RESTART DISPLAY
704 JMS I CRLFX /C.R. TYPED, ECHO IT
705 JMP I TMESS /OTHER OR CR, RESUME
707 /FINDS DIGIT AND TYPES IT
709 DCA ARITH1 /FACTOR TO DEFLATE BY
713 GLOOP, DCA ARITH4 /SAVE NEW REDUCED ARGUMENT
714 TAD ARITH4 /AND PREPARE TO REDUCE AGAIN
716 TAD ARITH1 /TRIAL SUBTRACTION
717 ISZ NDIGIT /INDEX DIGIT
719 JMP GLOOP /SUBTRACT SOME MORE
720 CLA /THAT'S ALL FOR THIS DIGIT
721 TAD K0257 /DIGIT IS NDIGIT-1
722 TAD NDIGIT /TYPE ASCII
724 KSF /CHECK FOR CTRL Q
725 JMP I GDIGIT /NO KEY, EXIT
726 KRB /KEY, BUT IS IT CTRL Q?
729 JMP I GDIGIT /NO, EXIT
730 JMP TYPDUN /YES RESUME DISPLAY
734 \f/INTEGRATE DATA BETWEEN CURSORS
735 IDATA, JMS PRETYP /INITIALIZE TYPEOUT
736 TAD CHANNL /LO LIMIT OF INTEGRATION
738 DCA AVGSUM /CLEAR PARTIAL SUMS
742 DCA AVGFLG /CLEAR OFLO FLAGS
746 ILOOP, TAD AVGSUM /PREPARE TO UPDATE SUMS
748 ISZ AVGFLG /OVERFLOW RETURN, SET FLAG
750 CLA CMA /CF'S COMPUTED?
753 JMP IDONE /NO, CONTINUE
754 TAD CFLSUM /YES UPDATE THAT SUM
756 ISZ CFLFLG /OVERFLOW RETURN, SET FLAG
758 MTW /ALREADY PAST CF'S.
759 IDONE, ISZ CHANNL /UPDATE DATA POINT #
760 JMS I BLKCNZ /MOVE TO NEXT DATA POINT
761 JMS I CURSEZ /REACHED SECOND CURSOR?
762 SKP /AT SECOND CURSOR OR OUT OF DATA
764 CLA CMA /GET # OF LAST DATA POINT
769 TAD AVGFLG /TYPE OVERFLOW MARK
771 CLA CMA /CFLSUM CALCULATED?
775 TAD CFLSUM /YES, OUTPUT INTEGRAL OF CFL'S.
777 TAD CFLFLG /OVERFLOW MARK IF REQ.
779 JMP I .+1 /TYPE SOME CRLF, RESTORE SCALE FACTOR
780 TYPDUN /AND RESUME DISPLAY
781 \f/SUBROUTINE TO TYPE SIGNED # IN AC
785 SPA CLA /TYPE CORRECT SIGN: " " OR "-"
786 TAD K0015 /MAKE A "-"
791 CMA IAC /GET ABS VALUE
792 JMS I NUMTYX /AND TYPE IT
802 /SUBROUTINE TO GET SUM OF AC AND NEXT DATA POINT
804 DCA INADD /SAVE ADDEND
806 JMS I GDATAZ /GET AUGEND
807 SPA /SET LINK BIT EQUAL TO SIGN BIT
809 TAD INADD /ADD ADDEND
812 TAD INADD /MODIFY LINK BIT IN ACCORD WITH SIGN
815 TAD INSUM /WE HAVE FAKED A 13 BIT ADD
816 SPA SZL /ARE THE LINK AND SIGN BITS EQUAL?
817 CML CMA /1,1 TO 0,0; 0,1 TO 1,0; 1,0 TO 0,1
818 SMA SNL CLA /0,1 AND 1,0 ARE OVERFLOW
819 ISZ UPSUM /L,S WERE 0,0 OR 1,1; NO OVERFLOW
820 TAD INSUM /GET THE RESULT AND EXIT
821 JMP I UPSUM /TO CALL+1 (OVRFLO) OR CALL+2 (NORMAL)
823 /SUBROUTINE TO TYPE "^" IF OVERFLOW (AC#0)
826 JMP I OMARK /YES, EXIT
827 TAD K0336 /NO, TYPE "^"
849 \f/ AAVG4 PLOTTER SUBROUTINES
851 / REV0.0 25-JAN-85 KJ.S.
857 H3PLOT, 0 / MOVE PEN; 'PA' COMMAND IS INITIATED
860 TAD I (ARITH4 / GET X POSITION
862 TAD I (YSAVE / GET Y POSITION
867 SNA CLA / FIRST 'PA'-COMMAND ?
869 TAD (HTPLPA / YES: OUTPUT 'PA'
873 TAD (1000 / MAKE STRAIGHT BINARY
889 SNA CLA / FIRST PA COMMAND ?
901 HTPLPA, TEXT /SP1;PA/;0
902 HTPLRD, TEXT /;PD;PA/;0
909 ISZ PLPAFL / SET FLAG
913 /1. TERMINATES A PROCEEDING 'PA'-COMMAND
916 HTPENU, TEXT /;PU;OE;/;0
926 /1. TERMINATES A PROCEEDING 'PA'-COMMAND
929 HTPEND, TEXT /;PD;OE;/;0
939 /1. TERMINATES A PROCEEDING 'PA'-COMMAND
941 /3. POSITIONS PEN TO UPPER LEFT CORNER
944 HTPLOF, TEXT /;PU;PA0,1150;SP0;OE;/;0
948 JMS TRI / READ ERROR STATUS
950 SNA / ERROR NUMBER = 0 ?
956 JMP I (DISJOB / CONTINUE DISPLAY
962 \fH3PLON, 0 / INIT PLOTTER
965 TAD (330 / SET INPUT DEV FOR ERROR CODE
967 TAD (340 / AND OUTPUT DEV TO 33/34
972 JMS TTO / OUTPUT ASCII STRING
977 /1. INITIALIZATION FOR DIN A4 SIZE
979 HTPLON, TEXT /$[$.N;19:$[$.H32;;17:IN;PS4;RO90;IP975,3800,7300,9800;/
980 TEXT /IW;SC0,1023,0,1023;SP0;OE;/;0
982 H3PLGR, 0 / PLOT GRID
992 /1. PLOT GRID WITH DIFFERENT PEN SIZES
993 HTPLGR, TEXT /$$SP1;PA0,0;PD;PA0,256,-15,256,0,256,/
994 TEXT /0,512,-15,512,0,512,0,768,-15,768,0,768,0,1023,/
995 TEXT /1023,1023,1023,-15,1023,0,819,0,819,-15,819,0,/
996 TEXT /614,0,614,-15,614,0,410,0,410,-15,410,0,/
997 TEXT /205,0,205,-15,205,0,0,0,0,-15,0,0;PU;/
998 TEXT /SR1.5,2.2;PA-8,-55;LB0$C$PA176,-55;LB100$C$/
999 TEXT /PA381,-55;LB200$C$PA585,-55;LB300$C$/
1000 TEXT /PA790,-55;LB400$C$PA994,-55;LB500$C$/
1001 TEXT /SR1.8,2.6;PA650,-120;LBZEIT [%MS%]$C$/
1002 TEXT /SR1.5,2.2;PA-68,245;LB-1$C$PA-68,501;LB 0$C$/
1003 TEXT /PA-68,757;LB 1$C$/
1004 TEXT /SP2;PA0,96;PD;PA1023,96;/
1005 TEXT /PU;PA1023,128;PD;PA0,128;PU;PA0,160;PD;PA1023,160;/
1006 TEXT /PU;PA1023,512;PD;PA0,512;PU;SP0;OE;/
1016 / READS CHARACTER FROM TTY
1018 / ENTRY: AC = NO CARE
1019 / EXIT: AC = CHARACTER
1023 / 02-MAY-84 REV 0.0 KJ.S.
1024 / 18-OCT-84 REV 0.1 KJ.S. HARDWARE INDEPENDENT
1037 / CHANGE SERIAL INPUT DEVICE CODE
1039 / ENTRY: AC = XNNX NN = DEV.CODE
1042 / SUBR: LOCATINONS IN TRI ARE CHANGED
1044 / 18-OCT-84 REV 0.0 KJ.S.
1063 / TELETYPE TEXT INPUT
1065 / READS INPUT FROM TTY AND STORES 2 CHARACTERS/WORD
1066 / INTO TEXT BUFFER. ACCEPTS ONLY PRINTABLE CHARACTERS.
1067 / ALL OTHER INPUT AND CHARACTERS AFTER BUFFER-OVERFLOW
1068 / IS ECHED AS 'BELL'. THE INPUT TERMINATOR IS NOT
1071 / ENTRY: AC = TERMINATOR, 0 = CR
1072 / ARG1 POINTER TO TEXT BUFFER
1073 / ARG2 LENGTH OF TEXT BUFFER (WORDS)
1078 / 16-JUL-84 REV 0.0 KJ.S.
1079 / 22-JUL-84 REV 0.1 KJ.S. SOME BUGS REMOVED
1080 / 23-JUL-84 REV 0.2 KJ.S. BUG AFTER 'DEL' REM.
1084 SNA / AC = TERMINATOR
1085 TAD (215 / AC = 0 TERMINATOR = CR
1089 TAD I TTI / GET ARG1 = BUFFER POINTER
1093 TAD I TTI / GET ARG2 = BUFFER LENGTH
1097 DCA TTIBLN / = - BUFFER LENGTH * 2 + 1
1099 DCA TTICNT / CLEAR CHARACTER COUNTER
1100 DCA TTIXF / CLEAR EXIT FLAG
1102 TTI1, JMS TRI / READ INPUT
1107 SZA CLA / TERMINATOR ?
1109 ISZ TTIXF / YES: SET EXIT FLAG
1110 DCA TTICH / PUT 'ZERO' INTO BUFFER
1113 TTI2, TAD TTICH / CHECK INPUT
1116 JMP TTI10 / NO: CONTROL CHAR
1118 SMA CLA / CHAR.LT.340 ?
1119 JMP TTI10 / N0: CONTROL CHAR
1121 TAD TTICNT / CHECK FOR BUFFER OVERFLOW
1123 SMA CLA / COUNTER.LT.BUFFER*2 ?
1124 JMP TTI10 / NO: BUFFER OVERFLOW
1128 TAD TTICH / MAKE 6-BIT-ASCII
1133 TAD TTICNT / CALCULATE BUFFER POINTER
1138 SZL / LINK=MSB OF TTICNT.EQ.0 ?
1139 JMP TTI4 / N0: 2. BYTE OF WORD
1140 TAD TTICH / YES: 1. BYTE
1143 TTI4, TAD I TTIPNT / ADD 1.BYTE
1146 TTI5, DCA I TTIPNT / STORE IN BUFFER
1147 ISZ TTICNT / INCREMENT COUNTER
1151 JMP TTI1 / NO: GET NEXT CHARACTER
1154 TTI10, CLA CLL / INPUT IS A CONTROL CHARACTER
1157 SNA CLA / CHAR.EQ.DEL ?
1159 TTI11, TAD (207 / NO: ILLEGAL INPUT
1164 SNA / BUFFER EMPTY ?
1166 TAD (-1 / NO: DECREMENT
1168 TAD (210 / BACKSPACE
1177 TTITM, 0 / MINUS INPUT TERMINATOR
1178 TTIBPT, 0 / BUFFER START POINTER
1179 TTIBLN, 0 / MINUS LENGTH OF BUFFER
1180 TTIPNT, 0 / CURRENT BUFFER POINTER
1181 TTICNT, 0 / CURRENT LENGTH COUNTER
1182 TTISWD, 0 / INPUT CONTROL FLAG
1183 TTICH, 0 / LAST INPUT CHAR
1184 TTIXF, 0 / EXIT FLAG
1189 / TYPES DECIMAL INTEGERS WITH DIFFERENT FORMATS
1191 / ENTRY: AC = NUMBER TO BE TYPED
1192 / ARG1 BIT 0 IF SET, TYPE SIGNED OUTPUT
1193 / BIT 1 IF SET, FILL FORMAT WITH ZEROS
1194 / UNSIGNED OUTPUT ONLY, BIT 0 IGNORED
1195 / BIT 6-11 OUTPUT FIELD WIDTH. IF ZERO,
1196 / NO LEADING ZEROS OR SPACES
1202 / 19-OCT-84 REV 0.0 KJ.S.
1206 DCA TION0 / SAVE NUMBER
1209 DCA TIOFL / SAVE FLAG
1210 TAD TDOTST / POINTER TO HEXADECIMAL TABLE
1214 TDOTST, .+1 / TABLE OF DECIMAL VALUES
1228 / TYPES OCTAL INTEGERS WITH DIFFERENT FORMATS
1230 / ENTRY: AC = NUMBER TO BE TYPED
1231 / ARG1 BIT 0 IF SET, TYPE SIGNED OUTPUT
1232 / BIT 1 IF SET, FILL FORMAT WITH ZEROS
1233 / UNSIGNED OUTPUT ONLY, BIT 0 IGNORED
1234 / BIT 6-11 OUTPUT FIELD WIDTH. IF ZERO,
1235 / NO LEADING ZEROS OR SPACES
1241 / 18-OCT-84 REV 0.0 KJ.S.
1242 / 18-OCT-84 REV 0.1 KJ.S. SOME BUGS REMOVED
1243 / 19-OCT-84 REV 1.0 KJ.S. USING SUBR. TIO
1247 DCA TION0 / SAVE NUMBER
1250 DCA TIOFL / SAVE FLAG
1251 TAD TOOTST / POINTER TO OCTAL TABLE
1255 TOOTST, .+1 / TABLE OF OCTAL VALUES
1269 / TYPES HEXADECIMAL INTEGERS WITH DIFFERENT FORMATS
1271 / ENTRY: AC = NUMBER TO BE TYPED
1272 / ARG1 BIT 0 IF SET, TYPE SIGNED OUTPUT
1273 / BIT 1 IF SET, FILL FORMAT WITH ZEROS
1274 / UNSIGNED OUTPUT ONLY, BIT 0 IGNORED
1275 / BIT 6-11 OUTPUT FIELD WIDTH. IF ZERO,
1276 / NO LEADING ZEROS OR SPACES
1282 / 19-OCT-84 REV 0.0 KJ.S.
1286 DCA TION0 / SAVE NUMBER
1289 DCA TIOFL / SAVE FLAG
1290 TAD THOTST / POINTER TO DECIMAL TABLE
1294 THOTST, .+1 / TABLE OF HEXADECIMAL VALUES
1306 \f/ TCR CARRIAGE RETURN
1308 / MOVES CURSOR TO THE BEGINNING OF THE
1311 / ENTRY: AC = NO CARE
1314 / 10-APR-84 REV 0.0 KJ.S.
1326 / POSITIONS CURSOR TO BEGINNING
1329 / ENTRY: AC = NO CARE
1332 / 10-APR-84 REV 0.0 KJ.S.
1341 TIOF, 0 / SUBROUTINE TO CHECK OUTPUT
1342 AND (17 / FORMAT AND TYPE
1344 ISZ TIOCT / INCREMENT DIGIT COUNTER
1347 SZA CLA / ZERO FLAG = 0 ?
1348 JMP TIOF2 / NO: TYPE DIGIT
1350 SZA CLA / DIGIT = 0 ?
1353 SNA CLA / FIELD WIDTH = 0 ?
1354 JMP I TIOF / YES: EXIT
1357 SPA CLA / FILL CHAR WITHIN FIELD ?
1358 JMP I TIOF / NO: EXIT
1359 TAD TIOFC / YES: TYPE FILL CHARACTER
1363 SNA / FIELD WIDTH = 0 ?
1364 JMP TIOF2 / YES: NO FIXED FIELD WIDTH
1366 SPA CLA / DIGIT WITHIN FIELD ?
1367 JMP TIOER / NO: FIELD WIDTH TOO SMALL
1368 TIOF2, ISZ TIOZF / SET ZERO FLAG
1370 SNA CLA / SIGN NEEDED ?
1372 DCA TIOSG / CLEAR SIGN FLAG
1373 TAD ("- / YES: TYPE IT
1375 TIOF3, TAD TIOPT / TYPE DIGIT
1378 TAD (7 / YES: MAKE A LETTER
1379 TAD (272 / NO: MAKE NUMBER
1384 \f / SUBROUTINE FOR TDO,TOO,THO
1385 / TION0 AND TIOFL MUST BE SET
1388 DCA TIOPT / AC = TABLE POINTER
1389 DCA TIOSG / CLEAR SIGN FLAG
1391 DCA TIOFC / FILL CHAR = SPACE
1394 SNA CLA / FILL CHAR = ZERO ?
1398 JMP TIOB / NO SIGN OPTION
1401 SMA CLA / SIGNED OUTPUT ?
1403 TAD TION0 / YES: COMPLEMENT NEGATIV NUMBER
1404 SMA / NEGATIV NUMBER ?
1406 CIA / YES: COMPLEMENT
1408 ISZ TIOSG / SET SIGN FLAG
1412 AND (77 / GET FIELD WIDTH
1413 DCA TIOFL / CLEAR UNUSED BITS
1415 SNA / FIELD WIDTH ZERO ?
1417 CIA / NO: COMPLEMENT
1418 TAD TIOSG / TAKE SIGN INTO ACCOUNT
1419 TAD (4 / MAX 4 DIGIT
1420 SMA / FILL CHARACTER NEEDED ?
1422 DCA TIOCT / YES: -# OF SPACE TO FILL FORMAT
1424 TIOC, TAD TIOFC / TYPE
1430 TAD (-13 / # OF SUBTRACTIONS
1431 DCA TIOCT / TO COUNTER
1434 TIOE, CLA CLL / SUCCESSIV SUBTRACTIONS OF
1435 TAD TION0 / DECIMAL VALUES FROM TABLE
1436 TAD I TIOPT / SUBTRACTION
1438 DCA TION0 / YES, NEW VALUE
1440 TAD TION1 / RESULT IN LINK
1442 DCA TION1 / SHIFTED INTO TION1
1443 ISZ TIOPT / INCREMENT POINTER
1445 JMP TIOE / NO, CONTINUE
1447 DCA TIOZF / CLEAR LEADING ZERO FLAG
1452 DCA TIOCT / SET DIGIT COUNTER, 4 DIGITS + SIGN
1454 TAD TION1 / 1. DIGIT
1459 TAD TION1 / 2. DIGIT
1464 TAD TION1 / 3. DIGIT
1467 ISZ TIOZF / 4. DIGIT ALWAYS TYPED
1473 TIOER, TAD TIOFL / ERROR, FILL FORMAT WITH ****
1477 JMS TCO / TYPE CHARACTER
1481 JMP I TDOHO / EXIT MAIN SUBROUTINE
1484 TION1, 0 / GETS 3 MSD
1488 TIOSG, 0 / SIGN FLAG
1489 TIOZF, 0 / ZERO SUPPRESS FLAG
1490 TIOFC, 0 / FILL CHARACTER
1491 \f/ TSO STRING OUTPUT
1493 / TYPES A STRING OF ASCII - CHARACTERS
1494 / BUFFER CONTAINS ONE CHARACTER PER
1495 / WORD AND MUST BE TERMINATED BY 0
1497 / ENTRY: AC = POINTER TO BUFFER
1500 / 10-APR-84 REV 0.0 KJ.S.
1504 DCA TSOPT / BUFFER POINTER
1505 TSOA, TAD I TSOPT / GET CHARACTER
1506 SNA / CHARACTER.EQ.0 ?
1507 JMP I TSO / YES: EXIT
1516 \f/ TCO CHARACTER OUTPUT
1518 / TYPES ONE ASCII-CHARACTER CALLING
1519 / CP-ROUTINE, RESPONS TO CTRL/S - CTRL/Q
1521 / ENTRY: AC = CHARACTER
1522 / EXIT: AC = 0 LINK UNCHANGED
1524 / 10-APR-84 REV 0.0 KJ.S.
1525 / 18-OCT-84 REV 0.1 KJ.S. HARDWARE INDEPENDENT
1526 / 18-OCT-84 REV 0.2 KJ.S. LINK PRESERVED
1530 DCA TCOSV / SAVE CHAR
1531 JMS TOKSF / CHECK XON/XOFF
1538 TCO1, CLA / YES: WAITING FOR CTRL/Q
1546 TCO2, TAD TCOSV / YES: TYPE CHARACTER
1555 / SUBROUTINES WITH I/O INSTRUCTIONS
1556 / DEVICE-CODE CAN BE SET BY TODC
1576 / CHANGE SERIAL OUTPUT DEVICE AND THE CORRESPONDING
1577 / INPUT DEVICE FOR XON/XOFF PROTOCOL
1579 / ENTRY: AC = XNNX NN = OUTPUT, NN-1 = INPUT DEVICE
1582 / 18-OCT-84 REV 0.0 KJ.S.
1594 TAD (-10 / CHANGE INPUT
1609 / TYPE TEXT FROM 6-BIT ASCII BUFFER CREATED WITH
1610 / PAL8 TEXT PSEUDO-OP.
1613 / CHARACTERS BETWEEN TWO $-CHARACTERS ARE CONVERTED
1614 / TO CONTROL CHARACTERS.
1617 / MULTIPLE OUTPUT OF SAME CHARACTER. THE FIRST CHARACTER
1618 / AFTER # IS TREATED AS NUMBER ( LOWER 6 BITS ) AND
1619 / THE SECOND CHARACTER IS PRINTED.
1622 / IF THE $- AND %-OPTIONS ARE USED, THE TEXT BUFFER MUST
1623 / TERMINATED WITH A ZERO WORD. THIS FEATURE COMBINES
1624 / SEVERAL TEXT BUFFERS TO ONE BUFFER WITH THE /F OPTION.
1627 / CHARACTERS BETWEEN TWO "-CHARACTERS ARE CONVERTED
1628 / TO LOWER CASE CHARACTER. MAY BE COMBINED WITH
1631 / ENTRY: AC = POINTER TO TEXT-BUFFER
1634 / 06-APR-84 REV 0.0 KJ.S.
1635 / 09-APR-84 REV 0.1 KJ.S. LOCATIONS RENAMED
1636 / 11-APR-84 REV 0.2 KJ.S. OUTPUT CODE CHANGED
1637 / 09-FEB-85 REV 0.3 KJ.S. #-OPTION ADDED
1638 / 13-FEB-85 REV 0.4 KJ.S. %-OPTION ADDED
1642 DCA TTOPNT / SAVE POINTER TO TEXT
1643 DCA TTOCFL / CLEAR CONTROL-FLAG
1644 DCA TTOEFL / AND END-FLAG
1649 JMP TTOR / YES: END OF BUFFER
1658 AND (77 / MAKE 6-BIT ASCII
1660 JMP TTOB2 / YES: CHECK IF END OF BUFFER
1662 SNA / CHAR = 43 = # ?
1663 JMP TTOB3 / YES: REP. OPTION
1665 SNA / CHAR = 44 = $ ?
1666 JMP TTOB1 / YES: TOGGLE CONTROL FLAG
1668 SNA / CHAR = 45 = % ?
1669 JMP TTOB5 / YES: TOGGLE CONTROL FLAG
1670 TAD (5 / NO, PRINT CHARACTER
1671 SPA / MAKE 8-BIT ASCII:
1672 TAD (100 / 01-37 TO 301-337
1673 TAD (240 / 40-77 TO 240-277
1674 TAD TTOCFL / ADD CTRL SET BY $
1675 TAD TTOLFL / AND LOWER FLAG SET BY %
1680 JMP TTOB4 / LAST CHAR WAS #, MAKE NUMBER
1684 JMP TTOB0 / LOOP FOR #-OPTION
1685 CLA CLL CMA RAL / DONE, FLAG = -2
1688 TTOB5, CLA / TOGGLE LOWER CASE FLAG
1690 SNA CLA / LOWER CASE FLAG ZERO ?
1691 TAD (40 / YES: SET TO 40
1692 DCA TTOLFL / NO: CLEAR FLAG
1695 TTOB1, CLA / TOGGLE CONTROL CHAR FLAG
1697 SNA CLA / CONTROL FLAG ZERO ?
1698 TAD (-100 / YES: SET TO -100
1699 DCA TTOCFL / NO: CLEAR FLAG
1700 TTOB6, CLA IAC / SET END FLAG
1706 SNA CLA / TTOEFL.GT.0 ?
1707 JMP TTOR / NO: END OF BUFFER, EXIT
1708 JMP I TTOB / YES: IGNORE ZERO CHAR AFTER USE OF $
1710 TTOB3, CLA CMA / CHAR = #
1711 JMP TTOBX / NEXT CHAR IS CONVERT TO NUMBER
1713 TTOB4, CLA IAC / MAKE NUMBER
1718 TTOBX, DCA TTONFL / SET FLAG
1721 TTOR, CLA / CLEAR ALL FLAGS
1724 JMP I TTO / AND EXIT