File: LE.TK of Tape: Sources/Multi8/m8-tk-etc-20-10-80
(Source file text)
/LE.TK 9-JUN-80 /**UASEM VERSION** / IOTS ARE EMULATED AS FOLLOWS: / 6000 :BACKUP PC, EXIT FROM EMULATOR / 6660 :OVERLAYED BY A PERMANENT NOP / 6570 :OVERLAYED BY A PERMANENT SKIP / 6XY1 :OVERLAYED BY A PERMANENT SKIP / 6XY2 :OVERLAYED BY A PERMANENT NOP / 6XY3 :OVERLAYED BY A PERMANENT NOP / 6XY4 :SEND CHARACTER / 6XY5 :OVERLAYED BY A PERMANENT NOP / 6XY6 :SEND CHARACTER / 6XY7 :OVERLAYED BY A PERMANENT NOP / 6000 :SEND ONE BUFFER (USED BY FAKE HANDLER) /AS COMPARED TO THE VERSION 6 LINEPRINTER EMULATOR, /THE FOLLOWING DIFFERENCES SHOULD BE NOTED: /* THE PATCHING OF 6661 ETC. IS NO LONGER / DONE BY LE, BUT IS LEFT TO / THE CENTRAL EMULATOR. PATCHING IS / SIGNALED BY TAKING THE NEW INSTRUCTION / IN THE AC WHEN RETURNING TO THE CENTRAL / EMULATOR. (AC<0, IF AC>0 THEN ERROR) /* THE LINEPRINTER BLOCKDRIVER (LP OR LPSPL) / IS CALLED A FINAL TIME / WITH AC IS 0 TO SIGNAL END OF FILE /* NO DOUBLE BUFFERING. (NOT NECESSARY BECAUSE / OF THE SPOOLED DRIVER) /* IF 6000 WHILE IN CHARACTER MODE, OR 666X WHILE IN / BLOCK MODE, THE EMULATOR CLOSES THE CURRENT FILE / AND EXITS WITH THE INSTRUCTION IN AC. SO / THE CENTRAL EMULATOR WILL PATCH THE INSTRUCTION / BY ITSELF AND RESTART THE BG AT PC-1. AT THAT / POINT A FRESH COPY OF LE IS CALLED THAT / STARTS WORKING IN THE PROPER MODE. / LEBUFMAX=400 /LENGTH OF BUFFER, MUST BE 400 IFNZRO BGMAX-1 <IFNZRO BGFLDS-4&4000 < IFNDEF SINGL8 <FLIP=1 /DE- OR ACTIVATE BG >>> /SETUP EMTAB *0 CDF 10 /EMTAB IS IN FIELD 1 EMTAB+66 /DEVICE CODE 66 "L^100+"E&3777 /NAME OF THIS EMULATOR TASK IFNDEF FLIP < *0 CDF 10 EMTAB+57 /OTHER (PDP8A) DEVICE CODE "L^100+"E&3777 /SAME TASK > *200 "L^100+"E&3777 /"LE" 200+400 /ONE PAGE PLUS BUFFER LEBUFI, LEBUF /START OF BUFFER LETVI, LETV /POINTER TO TRANSFER VECTOR LEUSTAT,. LECA, 0 LE, JMS I LEBUFI /DO INITIALISATION. OVERLAYED WITH: / SZL CLA JMP LECLR /END OF JOB TAD I LEUINST /FETCH INSTRUCTION IFNDEF FLIP < TAD LM6660 /SET LINK IF STANDARD LP > AND C7 /GET FUNCTION BITS TAD LEJMP /MAKE BRANCH INSTRUCTION DCA LEPACK LEPACK, 0 /ROUTINE TO PACK CHAR'S IN OS/8 FORMAT AND K377 /TAKE 8 BITS ONLY CDTOIF /BUFFER IS IN THIS FIELD JMP I LEP /COROUTINES ! LEP, 0 /ROUTINE TO GET NEXT CHAR FROM THE USER JMP I LEPACK JMP0, JMP LEERR /6000,6660,6570=GO DECIDE WHICH JMP LESKIP /6661=SKP K377, 377 /6662=NOP JMP LENOOP /6663=NOP JMP LEOUT /6664=OUTPUT LESKP, SKP /6665=NOP JMP LEOUT /6666=OUTPUT LENOOP, TAD LENOP /(NOP-SKP 6667=NOP LESKIP, TAD LESKP /(SKP JMP LERET /THE CENTRAL EMULATOR DOES THE PATCHING LEOUT, TAD I LEUAC /6666 OR 6664 IFNDEF FLIP < SNL /PRINTING ON 6666 DEVICE? CMA /NO, COMPLEMENT THE COMPLEMENTED AC FOR 6574 DCA LEPACK /STORE A WEE WHILE TAD LEPACK / > TAD LE7546 /-232 SNA CLA /A ^Z IS CONSIDERRED END OF INPUT JMP LECLR /SO THE EDITOR VIEW COMMAND WILL TERMINATE IFNDEF FLIP <TAD LEPACK / > IFDEF FLIP <TAD I LEUAC/ > JMS LEPACK /PACK CHARACTER IN BUFFER LERET, JMS MONITOR /RETURN TO CENTRAL EMULATOR RETURN LEP0, JMS LEP /GET FIRST CHAR LEP1, DCA I LECA /STORE IN BUFFER JMS LEP /GET SECOND CHAR DCA LETMP /SET ASIDE FOR A WILE JMS LEP /GET THIRD CHAR RTL RTL DCA ZTEM1 /8 BITS LEFT JUSTIFIED TAD ZTEM1 AND C7400 /TAKE FOUR HIGH ORDER BITS TAD I LECA /ADD INTO FIRST BUFFER WORD DCA I LECA /THATS ONE ISZ LECA /BUMP POINTER TO NEXT BUFFER WORD TAD ZTEM1 RTL RTL AND C7400 /FOR LOW ORDER BITS TAD LETMP /ADD SECOND CHAR DCA I LECA /STORE IN SECOND BUFFER WORD ISZ LECA /BUMP POINTER FOR NEXT TIME ISZ LEWC /INCREMENT DOUBLE-WORD COUNTER JMP LEP0 /BUFFER NOT FULL YET, GO ON LEPAT1, IFNDEF FLIP <NOP / > IFDEF FLIP <JMS LEFLIP /DEACTIVATE THE BG > TAD LEBUFI DCA LECA TAD M200 /-LEBUFMAX%2!4000 DCA LEWC /RESET WORDCOUNT LECALL, TAD LETVI /GET POINTER TO TRANSFER VECTOR JMS MONITOR CALL "L^100+"P&3777 JMP LEWAIT /PRINTER ALREADY IN USE BY FOREGROUND, WAIT DCA .+3 /THIS IS THE EVENT # JMS MONITOR /GO WAIT FOR COMPLETION WAIT LETMP, 0 /SHARED LOCATION SZA /ERRORS ? JMP LERET /YES, FORCE EMULATION ERROR (AC IS POS.) LEPAT2, IFNDEF FLIP <NOP / > IFDEF FLIP <JMS LEFLIP /ACTIVATE THE BG > JMP LEP0 /AND CONTINUE (ZEROED FOR CLOSE) CDF 10 JMS MONITOR EXIT SWPOUT LEERR, IFNDEF FLIP < SZL /WAS IT EITHER 6000 OR 6570? JMP LENOOP /NO, IT WAS 6660 - NOP IT TAD I LEUINST /DECODE DEVICE CODE AND LE770 SZA CLA /IF ZERO GO TO FAKE-HANDLER JMP LESKIP /NO, IT WAS 6570, THE PDP8A SKIP > TAD I LEUINST /LET THIS INSTRUCTION BE PATCHED... DCA LETRIK /TO ITSELF AND FALL INTO SHUTUP ROUTINE LECLR, DCA LEPAT1 /DISABLE LEFLIP CALLS DCA LEPAT2 TAD C232 /ADD A CONTROL/Z JMS LEPACK ISZ LEPCNT /ONCE-ONLY COUNTER JMP .-2 /BE SURE TO WRITE THE BUFFER DCA LEPAT2+1 /MAKE SKIP OUT OF LOOP DCA LETVI /FOR CLOSE CALL TAD LETRIK /WAS IT AN ERROR? SNA /IF SO, PATCH 6000 TO 6000 JMP LECALL /NO, CALL LP FOR CLOSE JMS MONITOR /NO CLEAR, WE COME BACK RETURN SWPOUT IFDEF FLIP < LEFLIP, 0 /ACTIVAT/DEACTIVATE BG CDF 10 TAD I LEUSTAT RAL CML RAL /COMPLEMENT INACTIVE BIT CML RTR /COMPLEMENT EMULATE BIT DCA I LEUSTAT JMS MONITOR /KICK THE BG-SCHEDULER SO HE KNOWS SIGNAL BSSLOT CDTOIF JMP I LEFLIP / > LEWAIT, JMS MONITOR STALL DGNTICK / CLA JMP LECALL LETV, ZBLOCK 2 /THIS IS THE ACTUAL TRANSFER VECTOR /BLOCK NUMBER NOT USED LETRIK, 0 LEUAC, 0 LEPCNT, -600 LEWC, -200 LENOP, NOP-SKP LEJMP, JMP JMP0 LE7546, -232 LEUINST, 0 C232, 232 IFNDEF FLIP < LM6660, -6660 LE770, 770 / > PAGE /THIS IS THE FIRST PAGE OF THE BUFFER AND CONTAINS /A LOT OF INITIALISATION CODE. LEBUF0, LEBUFI LEBUF1, LETV LEBUF2, LETV+1 LEBUF3, LE LEBUF5, LEUSTAT LEBUF6, LEUINST LEBUF7, LEUAC LEBUF8, LEP LEBUF9, LEP1 LBUF11, .&7600 /START ADDRESS OF THIS PAGE LBUF12, LECA LBUF14, LE&7600+400+2 LBUF15, 200+2 LBUF17, L2UAC LBUF19, L2UDTV LBUF20, L2UDT2 LBUF21, L2USLT LBUF22, L2UINST LBUF23, L2USTAT LBUF24, L2CAO LBUF25, L2TV LEBUF, 0 /INITIALISATION SUBROUTINE SZL /JUST A CLOSE ? JMP ICLOSE /YES, DO NOTHING ! ISZ LEBUF /ADJUST RETURN ADDRESS DCA ZTEM1 /POINTER TO BG-AREA TAD ZTEM1 /GET BG-USTAT AGAIN TAD (UASEM-1 /SETUP POINTER TO UASEM DCA ZTEM7 /IN OUR BG TABLE LEASLP, ISZ ZTEM7 TAD I ZTEM7 /LOOK AT ENTRY SNA /IS IT FREE ? JMP LEASFR /YES, GO PUT IN MY NAME CIA TAD LENAME /WAS IT ALREADY USED BY ME ? SZA CLA JMP LEASLP /NO, SOME OTHER TASK, LOOK FOR MORE LEASFR, TAD LENAME DCA I ZTEM7 /OK, PUT MY NAME IN UASEM TABLE TAD ZTEM1 TAD (UINST JMS DEFER /GET UINST TAD (-6000 /IS IT 6000 SNA CLA /NO JMP LEFAK /Y:MOVE FAKE EMULATOR CDTOIF TAD ZTEM1 DCA I LEBUF5 /SET UP LEUSTAT TAD ZTEM1 TAD (UAC DCA I LEBUF7 /SET UP LEUAC TAD ZTEM1 TAD (UINST DCA I LEBUF6 /SET UP LEUINST TAD (4200 RIF DCA I LEBUF1 /FIRST WRD OF TRANSFER VECTOR TAD LBUF11 DCA I LEBUF2 /BUFFER ADDRESS IN TRANSFER VECTOR TAD LBUF11 DCA I LEBUF0 /BUFFER POINTER TAD (SZL CLA DCA I LEBUF3 /PATCH INITIALISATION CALL TAD LEBUF9 DCA I LEBUF8 /INITILAISE COROUTINES TAD LBUF11 DCA I LBUF12 /INITIALISE BUFFER POINTER INEX, CDF 10 CLL JMP I LEBUF LENAME, "L^100+"E&3777 LEFAK, CDTOIF TAD I LBUF14 /MOVE FAKE HANDLER EMULATOR DCA I LBUF15 ISZ LBUF14 ISZ LBUF15 ISZ LEFT /READY? JMP LEFAK+1 /N TAD ZTEM1 DCA I LBUF23 /SET L2USTAT TAD ZTEM1 TAD (UAC DCA I LBUF17 /SET L2UAC TAD ZTEM1 TAD (UDTV DCA I LBUF19 /SET L2UDTV CLA IAC TAD I LBUF19 /SET L2UDTV+1 DCA I LBUF20 TAD ZTEM1 TAD (USLOT CDF 10 JMS DEFER CDTOIF DCA I LBUF21 /SET L2USLT TAD ZTEM1 TAD (UINST DCA I LBUF22 /SET UINST TAD LBUF11 DCA I LBUF24 /SET BUFFER POINTER TAD (4200 RDF DCA I LBUF25 /SET FUNCTION WORD FOR LINEPRINTER CALL TAD ZTEM1 /GET ORIG. AC CONTENTS JMP INEX /START TASK ICLOSE, CLA JMS MONITOR EXIT SWPOUT LEFT, -200+2 /FOR ONE PAGE PAGE /THIS IS THE EMULATOR FOR THE FAKE LPT HANDLER /THE PROGRAM IS MOVED BY THE INITIALIZE ROUTINE /AT THE FIRST CALL TROUGH THE FAKE HANDLER /IT COPIES THE BG-DATA TO THE BUFFER /AND CALLS "LP" / RELOC 200 LRESET, . 200+400 /DON'T TOUCH, V7A NEEDS IT ! L2TV, . /XFER WORDS L2BUFI, 400 /---------- L2TVI, L2TV L2CAI, 0 /NOTE: LE MUST BE ON THE SAME PAGE LOC. AS LE LE, SZL CLA /AC=POINTER TO USERS DTV JMP L2CLR /LINK=1: JUST A "CLEAR" AC2000 /IS THIS REALY 6000 ? TAD I L2UINST SZA CLA /Y JMP L2ERR /N:ERROR DCA I L2UAC /CLEAR USERS AC TAD I L2UDTV /GET FUNCTION SMA /WRITE IS OK JMP L2ERR1 /READ IS BAD BSW AND C37 SNA JMP L2RET /WC=0 : OS/8 CLOSE , IGNORE CMA DCA L2CNTI /SAVE -# OF PAGES-1 TAD I L2UDTV / AND C70 /GET VIRTUAL BUFFER FIELD IFNZRO INCORE-100 <INCORE,Q> TAD C100 /(INCORE DCA L2BFLD /SAVE IT TAD I L2UDT2 /GET CA DCA L2CAI L2NEW, JMS L2FLD /SETUP CDF TO REAL BUFFER FLD TAD L2BUFI / DCA L2CAO / ACM2 / DCA L2CNTO / L2CONT, JMS MONITOR /GIVE OTHERS A CHANCE PRECEDE / ISZ L2CNTI /DONE ALL INPUT ? JMP L2LP1 /N: CONTINUE L2RET, JMS MONITOR RETURN L2LP1, TAD M200 /SET TALLY FOR ONE PAGE DCA L2PGCT L2LP2, L2CDFI, CDF /'CDF INPUT FLD TAD I L2CAI /GET A WORD FROM BG ISZ L2CAI / CDTOIF /BUFFER IS IN THIS FIELD DCA I L2CAO /TO BUFFER ISZ L2CAO / ISZ L2PGCT /DONE 200 WORDS ? JMP L2LP2 /N ISZ L2CNTO /OUTPUT BUFFER FULL? JMP L2CONT /NO IFNDEF SINGL8 < AC2000 /(INACTIVE-EMULATE JMS L2FLIP /SET BG INACTIVE > IFDEF SINGL8 < CDF 10 / CLA / > JMS L2OUT /CALL LP TO OUTPUT BUFFER IFNDEF SINGL8 < AC4000 /(-INACTIVE > JMP L2NEW /GET BUFFER FLD IN CORE AND SETUP L2CDFI L2CNTO, L2FLD, -2 /GET BUFFER FIELD IN CORE TAD L2BFLD /VIRTUAL FIELD BITS+INCORE JMS L2FLIP /CHANGE STATUS AND SIGNAL BS JMS MONITOR /GO WAIT FOR FIELD SWAP NOW WAIT L2USLT, 0 TAD C6201 /REAL FIELD BITS IN AC DCA L2CDFI / JMP I L2FLD L2WAIT, JMS MONITOR STALL DGNTICK SKP CLA L2CAO, L2OUT, .&7600+200 /OUTPUT BUFFER CDTOIF TAD L2TVI JMS MONITOR /OUTPUT BUFFER CALL "L^100+"P&3777 JMP L2WAIT /LP IS BUSY DCA L2PGCT /SAVE SLOT # JMS MONITOR WAIT L2PGCT, 0 /SLOTNUMBER/COUNTER SNA CLA /ERROR ? JMP I L2OUT /NO, RETURN L2ERR1, AC4000 CDF 10 DCA I L2UAC /FORCE FATAL HANDLER ERROR DCA L2TVI /DO CLOSE CALLS ONLY JMP L2RET /AND RETURN NOW L2FLIP, 0 /ACTIVATE/DEACTIVATE BG CDF 10 TAD I L2USTAT AND CLONG /CLEAR LONG SO WE GET PRIORITY DCA I L2USTAT JMS MONITOR /KICK BS SIGNAL BSSLOT / JMP I L2FLIP /RETURN L2ERR, TAD I L2UINST /SET L2TRIK TO INSTRUCTION L2CLR, DCA L2TRIK /OR ZERO CDTOIF /MAKE SURE THAT THERE IS TAD L2C232 /A CONTROL/Z IN THE DCA I L2CAO / JMS L2OUT /OUTPUT LAST BUFFER TAD L2TRIK /WAS IT AN ERROR OR CLOSE? SZA JMP L2PATC /GO PATCH DCA L2TVI /NO, MAKE A CLOSE CALL JMS L2OUT /CALL LP CDF 10 // JMS MONITOR / EXIT EXIT SWPOUT L2PATC, JMS MONITOR /RETURN AND PATCH RETURN SWPOUT L2CNTI, 0 L2USTAT,0 L2UAC, 0 L2UDTV, 0 L2UDT2, 0 L2UINST, 0 L2BFLD, 0 IFNDEF SINGL8 < CLONG, -LONG-1 /> IFDEF SINGL8 < CLONG, -LONG-EMULATE-1 / > L2C232, 232 LEERST=L2BFLD L2TRIK=L2CDFI PAGE RELOC BUFEND=.-1 $