100 " &177 110 " &177 120 " &177 130 " &177 140 "S&177 150 "T&177+40 160 "A&177+40 170 "T&177+40 180 "U&177+40 190 "S&177+40 200 ":&177 210 " &177 220 STATBLB,ZBLOCK 4 /STATUS DIGITS WILL GO HERE 230 "M&37 / 240 "J&37 / 250 "J&37 / 260 0 /THIS ENDS THE MESSAGE 270 280 PAGE 290 EJECT 300 / LPT: SUPPORT ROUTINES. 310 320 LPOUT, .-. /LPT: OUTPUT ROUTINE 330 DCA BUFCHK /SAVE PASSED VALUE 340 TAD BUFCHK /GET IT BACK 350 TAD (-177) /ADD ON UPPER LIMIT 360 CLL /CLEAR LINK FOR TEST 370 TAD (37) /ADD ON RANGE 380 SZL CLA /SKIP IF OUT OF RANGE 390 TAD LCMODE /ELSE ADD ON FOLD VALUE 400 TAD BUFCHK /GET ORIGINAL EITHER WAY 410 DCA BUFCHK /STORE BACK 420 TAD LSTATUS /GET CURRENT STATUS 430 SMA CLA /SKIP IF IN <^S>/<^Q> WAIT 440 JMP LPOTEST /JUMP IF NOT 450 JMS LINPUT /TRY TO CHANGE STATUS 460 SPA SNA CLA /SKIP IF <^Q> RECEIVED 470 JMP I LPOUT /ELSE TAKE FAILURE RETURN 480 LPOTEST,SKP /**** NOT 6120 **** 0000 490 JMP LPOCIF /KEEP GOING 500 SKON /INTERRUPT ON? 510 IAC /TAD (IOF-ION) /NO, MAKE IT "IOF" 520 TAD [ION] /GET "ION" INSTRUCTION 530 DCA LOBARE /STORE IN-LINE 540 SKP /DON'T DO CIF OUR FIELD 550 LPOCIF, .-. /WILL BE CIF OUR FIELD 560 TAD LPTFLAG /GET OUTPUT FLAG 570 LSFIOT /FLAG UP NOW? 580 SKP /SKIP IF NOT 590 NL7777 /ELSE SET FLAG VALUE 600 SNA /SKIP IF EITHER FLAG IS OR WAS SET 610 JMP LOBARE /JUMP IF NEITHER 620 AND BUFCHK /GET THE CHARACTER 630 LLSIOT /OUTPUT IT NOW 640 CLA /CLEAN UP 650 DCA LPTFLAG /CLEAR EVENT FLAG 660 ISZ LPOUT /BUMP TO SKIP RETURN 670 LOBARE, NOP /**** 6120 **** ION OR IOF 680 JMS LINPUT /GET NEW INPUT STATUS 690 DCA LSTATUS /STORE IT 700 JMP I LPOUT /RETURN 710 EJECT 720 BUFCHK, .-. /BUFFER STATUS ROUTINE 730 NL0001 /SETUP INCREMENT 740 TAD FILLPTR /GET FILL POINTER+1 750 CIA /INVERT FOR TESTING 760 TAD EMPTPTR /COMPARE TO EMPTYING POINTER 770 AND (BUFSIZE-1) /JUST RELATIVE BITS 780 SNA /SKIP IF BUFFER IS NOT FULL 790 JMP I BUFCHK /TAKE FIRST RETURN 800 ISZ BUFCHK /BUMP TO SKIP RETURN 810 IAC /CHECK IF EMPTY 820 AND (BUFSIZE-1) /JUST RELATIVE BITS 830 SNA CLA /SKIP IF PARTIALLY USED 840 ISZ BUFCHK /ELSE TAKE DOUBLE-SKIP EMPTY RETURN 850 JMP I BUFCHK /RETURN EITHER WAY 860 870 LPFILL, .-. /BUFFER FILL ROUTINE 880 NL0001 /SET INCREMENT 890 TAD FILLPTR /GET THE POINTER 900 AND (BUFSIZE-1) /JUST RELATIVE BITS 910 TAD [LPTBUFFER] /ADD ON BUFFER BASE 920 DCA FILLPTR /STORE UPDATED POINTER 930 LPFCDF, .-. /WILL BE CDF OUR FIELD 940 TAD LPTCHAR /GET THE CHARACTER 950 DCA I FILLPTR /STORE IN THE BUFFER 960 JMP I LPFILL /RETURN 970 980 LPEMPTY,.-. /BUFFER EMPTY ROUTINE 990 NL0001 /SET INCREMENT 1000 TAD EMPTPTR /GET THE POINTER 1010 AND (BUFSIZE-1) /JUST RELATIVE BITS 1020 TAD [LPTBUFFER] /ADD ON BUFFER BASE 1030 DCA EMPTR /STORE IN TEMPORARY POINTER 1040 LPECDF, .-. /WILL BE CDF OUR FIELD 1050 TAD I EMPTR /GET THE CHARACTER 1060 JMP I LPEMPTY /RETURN 1070 EJECT 1080 LINPUT, .-. /LPT: INPUT ROUTINE 1090 LINPROT,SKP /**** NOT 6120 **** 0000 1100 JMP LICIF1 /KEEP GOING 1110 SKON /INTERRUPT ON? 1120 IAC /TAD (IOF-ION) /NO, MAKE IT "IOF" 1130 TAD [ION] /GET "ION" INSTRUCTION 1140 DCA LINBARE /STORE IN-LINE 1150 SKP /DON'T DO CIF OUR FIELD 1160 LICIF1, .-. /WILL BE CIF OUR FIELD 1170 TAD LINFLAG /GET INPUT FLAG 1180 SNA /SKIP IF SET 1190 JMP LIFLGTEST /JUMP IF NOT 1200 DCA LINCHAR /STORE FOR NOW 1210 DCA LINFLAG /CLEAR EVENT FLAG 1220 TAD LINCHAR /GET THE CHARACTER 1230 JMP GOTLINPUT /CONTINUE THERE 1240 1250 LIFLGTE,SKP /**** NOT 6120 **** 0000 1260 LICIF2, .-. /WILL BE CIF OUR FIELD