/RETURN FILE WINDOW INDEX /CALL TAD POINTER TO FILE CONTROL / JMS FILIX / SEGMENT ADDRESS NOT IN WINDOW / NON-EXISTENT FILE ADDRESS / OK RETURN WITH ADDRESS OF SEGMENT POINTER FILIDA= C0004 /FILDA FILIX, 0 DCA FILICN /SAVE POINTER TO FILE CONTROL TAD FILICN TAD FILIDA /4 DATFLD DCA FILSP2 /POINTS TO FILE EXTENSION IN CONTROL BLOCK TAD I FILSP2 /FILE EXTENSION AND C0177 /LIMIT FILE SIZE TO 1777777 (?!?) DCA FILSP1 /HIGH ORDER COMPONENT OF SEG # ISZ FILSP2 /POINTS TO LOW ARDER ADD TAD I FILSP2 /LOW ORDER ADDRESS AND SEGLMK /GET RID OF ADDRESS IN SEGMENT CLL RAL TAD FILSP1 /HIGH ORDER PART RTL /"DIVIDE" BY 400 SEG SIZE RTL CIA /-(SEGMENT# -1) DCA FILISN TAD FILICN IAC DCA FILICA /POINTS TO SEGMENT # INDEX IN WINDOW TAD I FILICN /POINT TO WINDOW DCA FILICN TAD I FILICN /GET WORD 1 OF WINDOW AND C0007 /VALID WINDOW? SZA JMP FILIX5 /NO, IT IS A BASIC WINDOW TAD I FILICA /YES TAD FILISN SMA SZA /FILSCT-SN>0? JMP FILIX2 /YES, SEGMENT POINTER NOT IN CORE TAD C0006 /FILSCT+6-SN<0? SMA JMP FILIX1 CLA /YES, SEGMENT POINTER NOT IN CORE TAD I FILICN /ANY MORE SEGMENTS? SNA CLA ISZ FILIX /NO, NON-EXISTENT FILE ADDRESS FILIX2, CLA FILIX3, CDF JMP I FILIX /RETURN FILIX5, AND C0006 /IS IT BASIC OR INVALID WINDOW? SNA CLA JMP FILIX3 /INVALID WINDOW TAD FILISN /GET -(SEG # -1) TAD BASWIN CIA /AC=SEG # -1 SPA JMP FILIX4 JMP FILIX2-1 /BASIC BUT NON-EXISTENT FILIX1, CIA TAD C0007 /WINDOW INDEX TAD FILICN /START OF WINDOW FILIX4, DCA FILICA /POINTS TO SEGMENT # ISZ FILIX /SEGMENT ADDRESS IN CORE - EXIT TAD I FILICA /GET SEGMENT # FOR THIS FILE ADDRESS SNA CLA JMP FILIX3 /ZERO SEGMENT NUMBER IS NOT A SEGMENT! TAD FILICA /EXIT WITH POINTER TO THIS SEGMENT IN AC ISZ FILIX JMP FILIX3 FILISN, 0 FILICN, 0 /RETURN USER RUN TIME /USER CALLS WITH ADDRESS OF THREE WORD BLOCK /WORD 1 CONTAINS THE JOB # /THE HI AND LO ORDER RUN TIMES ARE RETURNED IN WORDS 2 AND 3 UURT, UDF /USER FIELD TAD I L2SA /JOB # JMS I JOBCHB /SEE IF IT'S A VALID JOB JMP UURT0 /IT WASN'T TAD JOBTBA GETJTI /LOW ORDER RUNTIME JOBRTM ISZ JOBSWA UURT0, DCA UCOP2 DATFLD TAD I JOBSWA DCA UCOP1 JMP UCOPY2-2 /COPY IN USER AREA JOBCHB, JOBCHK /RETURN THE TIME OF DAY IN SYSTEM TICKS SINCE MIDNIGHT. /USER CALLS WITH ADDRESS OF TWO WORD BLOCK IN AC. /HI AND LOW ORDER PARTS RETURNED IN WORDS 1 AND 2. UTOD, TAD CLK1 /-TIME TILL MIDNIGHT CLL TAD INKLK1 /TIME AT MIDNIGHT DCA UCOP2 /LOW ORDER TIME NOW RAL TAD CLK2 /-TIME TILL MIDNIGHT TAD INKLK2 /TIME AT MIDNIGHT DCA UCOP1 /TIME NOW (HIGH ORDER) JMP UCOPY2 /COPY IN USER AREA INKLK1, INCLK1 INKLK2, INCLK2 /RETURN THE USER'S STATUS REGISTERS /CALLED WITH ADDRESS OF THREE WORD BLOCK IN AC UCKS, GETJTW JOBSTS DCA UCOP0 /STATUS 0 DATFLD ISZ JOBSWA TAD I JOBSWA /STATUS 1 DCA UCOP1 ISZ JOBSWA TAD I JOBSWA DCA UCOP2 /STATUS 2 UDF /SELECT USER FIELD TAD UCOP0 DCA I L2SA ISZ L2SA /BUMP POINTER NOP UCOPY2, UDF /FOR LATER ENTRIES TAD UCOP1 /SECOND WORD DCA I L2SA ISZ L2SA NOP TAD UCOP2 /THIRD WORD DCA I L2SA DCA L2SA /CLEAR USER AC UUOEXT DEVJO0, UCOP0, FILSP1, 0 UCOP1, FILSP2, 0 UCOP2, 0 /ROUTINE TO EXTRACT JOB NUMBER FROM DDB /CALL / TAD (DDB ADDRESS) / JMS DEVJOB / RETURN WITH JOB # IN AC FILICA, DEVJOB, 0 IAC DCA DEVJO0 /POINTS TO WORD 1 OF DDB DATFLD TAD I DEVJO0 /GET WORD 1 AND C0037 /IGNORE JUNK JMP I DEVJOB /RETURN C7037, SWAP LOCK NOTRUN CJOB FIPLOA, FIPLOK L2FIP, TAD C7037 /OK - ALLOW FIP TO BE OVER-WRITTEN BY USER JOBS AGAIN DCA I FIPLOA EXIT /WE ENTER THIS ROUTINE AT LEVEL 2 /AFTER COMPLETING A DISK TRANSFER /IF A FILE TRANSFER IS INVOLVED, WE CONTINUE /WITH IT /IF OVERLAY, WE GO TO OVERLAY CONTROL /IF OVERLAY IS COMPLETED WE FORCE THE SCHEDULER TO RUN THE PHANTOM DSURT1= WS0 DSURT2= WS1 DSURDA= C0004 /FILDA DSUET1= WS0 DSURET, IAC /ERROR IN DISK TRANSFER DCA DSKCOD /SAVE ERROR CODE TAD DSKPTR /POINTS TO REQUEST CURRENTLY RUNNING TAD DSUMTB /FIND RELATIVE INDEX IN TABLE CLL RTR /DIVIDE BY FOUR AND C0007 /SAVE FIELD TAD CORTBA /INDEX INTO CORTBL DCA DSUCOR TAD I DSUCOR /GET CORTBL ENTRY AND C0037 /EXTRACT JOB # TAD JOBTBA /POINTS TO JOBTBL DCA DSUJTE /SAVE JOBTBL ADDRESS TAD DSUJTE GETJTA /GET ADDRESS OF STR0 JOBSTS DCA DSUJST /SAVE IT TAD DSKCOD /IS THERE AN ERROR? SZA JMP DSURER /YES - JMP OUT OF THE ROUTINE AS QUICKLY AS POSSIBLE JMS DSUPAR /PARAMETER BLOCK ADDRESS TAD DSURDA DCA DSURT1 /POINTS TO WORD 5 OF PARAMETERS TAD I DSURPA /ADDRESS OF PARAMETERS IAC DCA DSURT2 /POINTS TO DISK EXTENSION IN PARAMETERS DATFLD TAD I DSURT1 /DISC EXTENSION FROM CONTROL... DCA I DSURT2 / ... TO PARAMETERS TAD DSURT2 TAD C0004 DCA DSURT2 /POINTS TO DISC ADDRESS IN PARAMETERS ISZ DSURT1 /POINTS TO DISC ADDRESS IN FILE CONTROL TAD I DSURT1 /DISC ADDRESS FROM CONTROL... DCA I DSURT2 / ...TO PARAMETERS ISZ DSURT1 /POINTS TO WORD COUNT IN FILE CONTROL CLL CMA RAL TAD DSURT2 DCA DSURT2 /POINTS TO WORD COUNT IN PARAMETERS TAD I DSURT2 /SAVE TEMPORARILY -WC FROM PARAMETERS CIA DCA DSKCOD TAD I DSURT1 /MOVE WC FROM FILE CONTROL... DCA I DSURT2 / ...TO PARAMETERS ISZ DSURT2 /POINTS TO CORE ADD IN PARAM. TAD DSKCOD /UPDATE CORE ADD BY COUNT TRANSFERRED TAD I DSURT2 DCA I DSURT2 /SAVE NEW AADD TAD I DSURT1 /GET WORD COUNT FROM CONTROL CDF C7640, SZA CLA /ARE WE DONE? JMP DSURE2 /NO DSURER, DCA DSKCOD /SAVE ERROR STATUS IF IT IS AN ERROR TAD I DSURPA /GET ADDRESS OF PARAMETER BLOCK DCA .+3 /FOR CALL TO FILERR TAD DSKCOD /ERROR CODE JMS I DSUFEA /HANDLE ERROR 0 CLL TAD I DSUCOR TAD C7640 /SET "NOTRUN" IF NOT INHIBITED AND DSHOLD /SAVE "NOTRUN," "NOHOLD," & AND JOB SNL /ANY MORE BONUSES DUE? DCA I DSUCOR /YES - SET "NOTRUN" SO [S]HE WON'T BE SWAPPED OUT BEFORE BEING RUN AGAIN DSURE1, DCA DSFLAG ISZ DSUJST /SET INACTIVE FLAG IN STR1 TAD DSKPTR /FIGURE OUT WHICH INTERNAL FILE # TAD DSUMTB JMS I DGETJX DATFLD TAD I DSUJST /NOW SET FILE READY & DUMMY WAIT BIT DCA I DSUJST /SAVE STR1 JMS DSURE4 ISZ DSFLAG /THIS TRANSFER COMPLETE? RSCHED /YES - BUMP OOFF THE NULL JOB IF POSSIBLE TAD I DSUCOR JMP I .+1 /GO SET UP FOR THE NEXT PART OF THIS TRANSFER FILCON DSURPA, DSPARM DSUFEA, FILERR /MOVE SEGMENT WINDOW DSURE2, TAD DSUJTE /SET JOBLNK GETJTA JOBLNK DCA DSKCOD /SAVE POINTER TO JOBLNK TAD I DSURPA /GET ADDRESS OF PARAMETER BLOCK DATFLD DCA I DSKCOD /AND SAVE IN JOBLNK CDF DCA I DSURPA /CLEAR DSPARM STA /-1 TO SET TRANSFER INCOMPLETE FLAG JMP DSURE1 DSUCOR, 0 DSHOLD, NOTRUN NOHOLD CJOB DSUMTB, -DSUTBL DGETJX, GETJFX DSKCT, DSKCON DSKCOD, 0 DSURE4, 0 TAD DSKPTR /CURRENT REQUEST POINTER DCA DSUET1 DATFLD DCA I DSUET1 /CLEAR THIS REQUEST CDF TAD I DSURPA /RETURN PARAMETER BLOCK IF FINISHED SZA RETBLK /OK - RETURN IT JMS I DSKCT /DECREMENT BUSY - START ANY TRANSFER THAT'S WAITING JMP I DSURE4 DSUJST, 0 /POINTER TO JOB STATUS DSUJTE, 0 /JOB TABLE ENTRY DSFLAG, DSUPAR, 0 /GET PARAMETER BLOCK ADDRESS TAD I DSURPA /GET ADDRESS TAD C0007 /GET POINTER TO LAST WORD IN BLOCK DCA DSUET1 DATFLD TAD I DSUET1 /GET ADDRESS OF FILE CONTROL CDF JMP I DSUPAR /EXIT OVERL1, JMS DSUPAR /GET ADDRESS OF FILE CONTROL, & CLEAR DSFLAG SZA JMP OVE2 TAD I FANCOR TAD C1000 /NOT RUN YET DCA I FANCOR TAD SCHPHA OVE2, DCA DSFLAG /DISPATCH ADDRESS JMS DSURE4 JMP I DSFLAG SCHPHA, SCHFAN /GET JSFX /CALL TAD FILE # / JMS GETJFX / RETURN WITH JSFX IN AC GETJFX, 0 AND C0003 /FILE # ONLY CMA DCA TRAC /-SHIFT COUNT STL RAR RAR ISZ TRAC /DONE? JMP .-2 JMP I GETJFX /YES, EXIT WITH BIT SET IN AC USIZE, TAD SEGSIZ /RETURN SEGMENT SIZE IN AC JMP UUAC UUSE, TAD JOB /RETURN JOB # IN AC JMP UUAC TICSPS /# TICKS PER SECOND URCR, TAD .-1 /RETURN CLOCK RATE UUAC, DCA L2SA UUOEXT /ROUTINE TO RECOGNIZE AND REPLY TO ^C GIR9, TAD CONDDB JMS I PTJOB /GET HIS/HER JOB NUMBER FROM THE DDB CDF TAD JOBTBA DCA WS1 TAD WS1 /POINTS TO JOB DATA AREA GETJTI JOBSTS+1 /GET STR1 AND GIRFCL /CLEAR TIMER, AND DELIMITER FLAGS & JSWAIT DATFLD DCA I JOBSWA STL RTL TAD JOBSWA DCA WS0 /POINTS AT WAIT MASK 1 TAD I WS0 /ARE WE WAITING FOR A FILE TRANSFER? AND GIRFIL ISZ WS0 /POINTS AT WAIT 2 TAD I WS0 /OR - WAITING FOR DECTAPE, RK05, OR CARDREADER? SNA CLA ISZ I JOBSWA /NO - SET DUMMY WAIT BIT ISZ WS0 /POINT TO RESTART ADDRESS CDF TAD WS1 /GET POIONTER TO JOBREG GETJTI JOBREG CLA TAD CONDDB /GET JOB NUMBER JMS I PTJOB /AC=JOB; DATA FIELD=1 JMP I .+1 GIR90 /OFF TO PART TWO GIRCBF, CLRBUF GIRFIL, JSF0+JSF1+JSF2+JSF3 GIRFCL, -JSTIME-JSDEL-JSWAIT-1 SWBASE= C0004 /SWAP TRACK OF JOB 1 (SWDEX-1) /ROUTINE TO SET UP SWAP /CORTBL POINTER TO FIELD TO SWAPPED OUT IN WS0 /FINISH= +FIELD # FOR SWAP IN; FINISH= -FIELD # FOR SWAP OUT /FIT=JOB TO BE SWAPPED IN OR PHANTOM TO BE BROUGHT IN /FORCE=FIELD TO BE SWAPPED OUT /ENTER AT SWAPIN FOR SWAP IN /ENTER AT SWPOUT FOR SWAP OUT SWPOUT, TAD WS0 /OR SWAP BIT INTO CORTBL IOR SWAP TAD I WS0 /JOBS ARE THE ONLY ONES TO BE SWAPPED OUT JMS TRAC /GET THE TRACK # FOR THIS JOB DCA OUTTRC /SAVE IT SWAPIN, TAD FINISH /FINISH HAS FIELD # FOR SWAP ACTIVITY + OR - SPA CIA /GET THE ABSOLUTE VALUE CLL RTL RAL /IN POSITION 00X0 DCA SQREQ /SAVE IT FOR SETTING UP DISC I/O TAD FIT /IS A PHANTOM NEEDED? AND C0600 SNA JMP SWAP1 /NO JOB IS TO BROUGHT IN AND C0400 /IS FIP NEEDED? SZA CLA IFZERO RF08-40 /YES, DF32 NEEDS TRACK IN POSITION 0X00 IFZERO RF08 /YES, RF08 NEEDS TRACK IN POSITION 000X SWAP3, DCA INTRC ISZ DSBUSY /IS ANY DISC ACTIVITY GOING ON? SCHED /YES, SO FIND A RESIDENT JOB JMS I SWPIOA /NO, START THE SWAP I/O SCHED /FIND A RESIDENT JOB IN THE MEANTIME SWAP1, TAD FIT /GET THE JOB # TO BE SWAPPED IN JMS TRAC /GET ITS TRACK # JMP SWAP3 /ROUTINE TO SET FLAG IN USER STATUS REG AND EXIT /CALLING SEQUENCE: / CONDBA POINTS TO POSITION IN DEVTBL / TAD (FLAGS TO SET) / JMS PTSTAR / RETURN PTSTAR, 0 DCA PTFLAG /SAVE FLAGS TO SET TAD I CONDBA JMS I PTJOB /GET JOB # FROM DDB SNA JMP I PTSTAR TAD JOBTBA /START OF JOB TABLE DCA TRAC STL RTL TAD I TRAC /ADDRESS OF STR1 IOR /OR IN FLAGS PTFLAG, 0 JMP I PTSTAR PTJOB, DEVJOB /DECTAPE HANDLER CODE /FOR DISK TRANSFERS TO OR FROM USER SWAP AREA /ALSO FOR ALL LEVEL 2 COMPLETION DTDSF0, 0 /MAY RETURN UP TO 4 TIMES - EACH +1 FROM THE LAST DCA I DTDQUE /PUT THE DECTAPE'S DISK REQUEST IN THE QUEUE CDF ISZ DSBUSY /DISK ALREADY BUSY? SKP JMS I FIUSER /NO, START IT DTDXF0, CIF DATFLD JMP I DTDSF0 /BACK TO DECTAPE HANDLER DTL20, CIF DATFLD /LEVEL 2 DISPATCHER JMP I DTLEV2 DTDEF0, ERROR /DECTAPE DISK ERROR SWPRER DTDCF0, ISZ DTDSF0 /INCR. RETURN JMP DTDXF0 DTDSK, ISZ DTDSF0 /DISK ERROR - SKIP ON RETURN DATFLD DCA I DTDQUE /REMOVE REQUEST FROM QUEUE CDF JMS DSKCON /START ANYTHING ELSE THAT'S WAITING JMP DTDCF0 DTLEV2, DTL21 /POINTER TO DECTAPE LEVEL 2 COMPLETION ENTRY DTDQUE, DSUTBL+7 /POSITION FOR FIELD 1 REQUESTS DSKCON, 0 STA CLL /REDUCE COUNT FOR DSBUSY TAD DSBUSY DCA DSBUSY SZL /IS THERE ANYTHING ELSE TO RUN? JMS I FIUSER /YES -- START NEXT TRANSFER JMP I DSKCON TRAC, 0 AND C0037 /JUST GET THE JOB # TAD SWBASE /TRACK # WHERE SWAP AREA BEGINS -1 TO TAKE CARE OF JOB 1 IFZERO RF08-40< CLL RTL;RTL;RTL >/TRACK # IN POSITION 0X00 FOR DF32 JMP I TRAC /RETURN *6000 KBDMOD, 0 TAD I CONDDB AND C1000 SNA CLA /USER MODE? ISZ KBDMOD /YES; CAUSE SKIP ON EXIT JMP I KBDMOD XOFF= 3000 KBDFUL, -130 KBDOFF, -70 OFFBRK, KBDDLM KBD06, 0 /SIZE CHECK FOR KEYBOARD INPUT DCA KBDMOD /SAVE POINTER TO CHARACTER COUNT TAD I KBDMOD TAD KBDFUL SMA CLA /BUFFER FULL? JMP KBD07 /YES ISZ KBD06 /SKIP ON RETURN - OK TO GIVE ANOTHER BLOCK TAD I KBDMOD TAD KBDOFF /TIME FOR XOFF? SPA CLA JMP I KBD06 /NO TAD I CONDDB /GET DDB FLAGS RTL SZL SPA /SHOULD "XOFF" BE SENT? JMP I KBD06 /NO - EITHER IT HAS ALREADY BEEN SENT OR [S]HE'S IN SI MODE STL RTR /YES - REMEMBER TO SEND "XON" LATER DCA I CONDDB TAD I CONDBA /POINT TO WORD 2 OF OUTPUT SIDE IOR XOFF /SCHEDULE XOFF TO BE SENT JMS I TYPEC JMS I OFFBRK /SET KEYBOARD FLAG JMP I KBD06 KBD07, TAD C0400 TAD I CONDDB /SET BUFFER FULL BIT DCA I CONDDB JMP I KBD06 /EXIT - NO SKIP TYPEC, TYPE ALLOK, 0 ISZ ALLOK /WE DON'T CARE HOW BIG THE BUFFER IS DCA KBDMOD TAD I KBDMOD /THE COUNT TAD KBDFUL /THE LIMIT SMA SZA CLA JMP I ALLOK /TOO MANY - DON'T CLEAR "FULL STATUS" TAD I CONDDB AND CC7377 DCA I CONDDB JMP I ALLOK CC7377, 7377 /SEARCH FOR TTY /CALL TAD JOB # / TTYUSE / RETURN WITH DDB ADDR IN AC, 0 IF NOT FOUND TTYSRC, 0 AND C0037 /GET JOB # TAD TTYTBA /START OF TTY TABLE DCA CONDBA DATFLD TAD I CONDBA /GET UNIT # FROM TABLE CLL RAL /POSITION IN DEVTBL TAD DEVTBA /POINTER TO DEVTBL DCA CONDBA TAD I CONDBA /DDB ADDRESS CDF JMP I TTYSRC TTYTBA, TTYTBL JOBCHA, JOBCHK UCON, TAD L2SA /PICK UP JOB NO. JMS I JOBCHA /SEE IF IT'S A VALID JOB JMP UCON0 /IT WASN'T TTYUSE /GET DDB ADDRESS DCA WS0 DATFLD TAD I WS0 /GET WORD 1 OF DDB AND C0037 /ISOLATE CONSOLE NO. SKP UCON0, STA /RETURN A -1 DCA L2SA /STASH IT IN HIS/HER AC UUOEXT /DATE UDATE, TAD DATE JMP UCON0+1 /RETURN DATE IN AC /RESTORE JOB REGISTERS /CALL TAD JOB # / RESJOB / RETURN RESCOR, FIP SI CJOB RESJO0, 0 AND RESCOR /CLEAR CORE STATUS BITS DCA JOB /AND SAVE IN JOB TAD JOB AND C0037 TAD JOBTBA DCA RESJO1 /JOBTBL POINTER FOR THIS JOB DATFLD TAD I RESJO1 /GET ADDRESS OF JOB DATA AREA DCA I CJOBDA /AND SAVE IN FIELD 1 CDF TAD CLOCK /SUBTRACT THE CLOCKS STILL PENDING ON LEVEL 2 CMA DCA JOBTIM /THE NET RESULT IS ZERO TICKS WHEN WE ACTUALLY START HIM/HER DCA L2SV0 /SET PC=0 IN ANTICIPATION OF PHANTOMS TAD JOB /IS IT A PHANTOM? AND C0600 SZA CLA JMP I RESJO0 /YES; WE'RE RESTORED! / / NOW RESTORE THE EAE REGISTERS IF THEY EXIST / IFZERO EAE-20 < IFZERO CPU-2 < /PDP-8E GETJTW /PICK UP SC (AC5:9), THE MODE + GT FLAG IN AC10 + 11 JOBEAE+1 /IF AC10-11=00 THEN MODE=B GT=1 CMA /IF AC10-11=01 THEN MODE=B GT=0 /IF AC10-11=10 THEN MODE=A GT IS ALWAYS 0 IN MODE A SWAB /SWITCH TO MODE B AND LOAD THE MQ MQA LSR /SHIFT INTO THE GT FLAG (SETS TEMPORARILY IF WE WANT MODE A) 1 /MQ IS ALSO COPIED BACK INTO THE AC CMA RAR /POSITION THE SC FOR LOADING AND PUT THE MODE INTO THE LINK ACS /AC LOADS SC, AC IS CLEARED SZL /WHICH MODE? SWBA /"A," SO SWITCH MODES AND CLEAR THE GT FLAG > IFNZRO CPU-1 < /SORRY - THE PDP-8 CAN'T RESTORE ITS STEP COUNTER IFNZRO CPU-2 < / PDP-8/I AND PDP-12 GETJTW /PICK UP SC JOBEAE+1 CMA /COMPLEMENT AND STORE FOR DCA .+2 / OLD-STYLE EAE SCL /LOAD SC 0 >>> IFZERO MQREG-1 < GETJTW /RESTORE MQ JOBEAE MQL > TAD RESJO1 GETJTA /GEET ADDRESS OF PC IN JOB DATA AREA JOBREG /MOVE PC, LINK, AC TO LEVEL 2 REGISTERS DCA RESJO1 BLT DATFLD RESJO1, 0 UDFCDF, CDF L2SV0 -3 TAD L2SF AND C0070 TAD UDFCDF DCA UUDF /SET UP IN CASE OF USER INTERRUPT ISZ L2SVLK /DID [S]HE JUST TYPE CONTROL C? JMP I RESJO0 /ALL RESTORED DCA L2SA /YES - MAKE SURE HIS/HER AC AND LINK ARE CLEARED JMP I RESJO0 IFNZRO DC08A < ANSWER, CIF DATFLD-1 /DISPATCH TO FIELD 1 TO ANSWER PHONE JMP I .+1 DFRING >/END D689 *6200 /SERVICE ALL AC TRANSFER OUTPUT DEVICES (TELEPRINTERS, PAPER TAPE PUNCH, AND LINE PRINTER) /IF FILLER CHARACTERS ARE NEEDED, THE NEXT 3 WORDS MUST BE PATCHED ACCORDING TO YOUR NEEDS /THE VALUE OF DEVTBL IS ASSEMBLED HERE FOR YOUR CALCULATING CONVENIENCE FILHI, DEVTBL /-(DEVTBL+2*(KXX+1)) WHERE KXX IS THE HIGHEST LINE REQUIRING FILLER CHARACTERS FILLO, 0 /2 TIMES NUMBER OF LINES REQUIRING FILLER CHARACTERS FILLC, 0 /-(ASCII CHAR.) TO LOOK FOR - 7 BITS ONLY (CR=7763; LF=7766) TTIMEA, TTIME JMSTIM= JMS I TTIMEA CONCNT, -NULINE-3 IFNZRO DC08A T8OUT> /PASS OUTPUT CHARACTER TO DC08A *6206 DEVOUT, OUTDIF CONREG= C0200 CONDEV, SKPTP+1 TTOFLA, TTOFLG CONLPF, JSLPT C0014, 14 IFNZRO OUTREG-200 CONOUT, DCA I SETFLG /CLEAR SCHEDULER FLAG ION ISZ I TTOFLA /SHOW THAT OUTPUT IS BEING SERVICED DATFLD TAD CONREG DCA WS0 /OUTPUT REGISTER TABLE POINTER FOR OUTPUT SCAN TAD CONCNT DCA WS1 /NUMBER OF LINES TO CHECK + PUNCH & LINE PRINTER CONOU0, TAD I WS0 TTIMER, SPA CLA /DOES THIS DEVICE HAVE A REQUEST? JMP CONOU2 /YES CONOU1, ISZ WS0 /BUMP POINTER ISZ WS1 /AND THE COUNT JMP CONOU0 TAD CONSKP /RESTOORE THE NORMAL INSTRUCTION DCA TTIMER STA LSRP /LP08 OR LE8 ERROR? LIE /OK - TURN ON INTERRUPT ENABLE JMP I .+1 CONEXT CONOU2, JMS CONGET /FIND HIS/HER DDB DCA CONDDB TAD I CONDDB /GET OUTPUT STATUS SPA JMP CONOU9 /[S]HE HAS TYPED ^S RTL CONSKP, SPA CLA JMP CONJAM /SPECIAL CHARACTERS CONOU3, TAD CONDDB FETCH /GET A CHARACTER JMP CONOU9 /BUFFER EMPTY CONOU4, DCA TTCHAR TAD TTCHAR /CHECK FOR CARRIAGE RETURN (FOR SERIAL LA30'S @ 300 BAUD) AND C0177 /LET'S KEEP DAWNWOOD JUNIOR HIGH HAPPY TAD FILLC SZA CLA JMP CONOU5 /NORMAL CHARACTER TAD CONDBA TAD FILHI /HI LINE LIMIT FOR FILLERS CLL TAD FILL0 /LO LINE LIMIT FOR FILLERS SNL CLA JMP CONOU5 /NO FILLERS FOR THIS LINE TAD CONDDB TAD C0005 DCA WS2 /POINTER TO DDB CHARACTER COUNT STL RAR TAD I WS2 /INDICATE THE NEED FOR FILLERS DCA I WS2 CONOU5, IOF TAD I WS0 /WHAT'S THE HARDWARE DOING? RTL SNL CLA /HARDWARE BUSY FLAG IN THE LINK JMP CONOU6 /NOTHING - SEND TO IT TAD TTCHAR RAL /SET THE CHARACTER READY FLAG CONOU8, ION DCA I WS0 /NEW LINE STATUS JMP CONOU1 /CHECK NEXT LINE CONOU6, TAD WS1 IAC SZA /LINE PRINTER? JMP CONOU7 /NO - EITHER TTY OR PTP LIE /DISABLE LS08/LS8E INTERRUPTS LCP /DISABLE LP08/LE8 INTERRUPTS ION TAD CONLPF JMS I SETFLG /SET THE LINE PRINTER FLAG FOR THE USER TAD TTCHAR JMP CONLP2 CONLP1, TAD CONDDB FETCH /NO - GET ANOTHER CHARARCTER FOR THE LINE PRINTER JMP CONOU9 /LINE PRINTER BUFFER IS EMPTY LSF /IS IT READY FOR THE NEXT CHARACTER ALREADY? JMP CONOU4 /NO - JUST TUCK THIS ONE AWAY FOR AN INTERRUPT TO TAKE CONLP2, LPC STL CLA RTR DCA I WS0 /REMEMBER THE HHARDWARE IS BUSY JMP CONLP1 CONJAM, TAD I CONDDB AND C0037 /REMOVE THE JAM REQUEST DCA I CONDDB TAD C0007 /BELL? SZL TAD C0014 /NO - "XOFF" JMP CONOU4 CONOU7, TAD CONDEV DCA CONTLS TAD I CONTLS TAD C0005 /CONSTRUCT TLS, PLS, OR "JMP T8OUT" DCA CONTLS TAD TTCHAR CONTLS, .-. /TLS, PLS, OR "JMP T8OUT" STL CLA RTR /AC=2000 ION DCA I WS0 JMP CONOU3 /GET ANOTHER CHARACTER CONGET, 0 TAD WS0 STL RAL /TIMES 2 PLUS 1 TAD DEVOUT DCA CONDBA /DEVTBL POINTER TAD I CONDBA /IS THERE A DDB FOR THIS DEVICE? SZA JMP I CONGET CONOU9, CLL STA RAR CIF /NO INTERRUPTS AND I WS0 DCA I WS0 /CLEAR THE REQUEST FLAG TAD I CONDBA /DOES [S]HE EXIST? SNA JMP CONOU1 /NO - SO WE'RE FINISHED DCA AXS1 TAD I AXS1 /JOB SZA CLA JMP CONOU1 /STILL DEFINED DCA I CONDBA /CLEAR HIM/HER FROM DEVTBL TAD CONDDB /TIME TO RELEASE THE DDB CDF RETBLK DATFLD STA TTIME2, TAD AXS1 /ADDRESS OF DDB JMS I CONCLR /FLUSH OUT BUFFER DCA I WS0 JMP I .+1 CONOU2 TOFA1, TTIME, 0 AND C1000 C7740, SZA SMA CLA /SMA HERE TO MAKE CONSTANT JMP TTIME1 /OOPS! CIF /NO INTERRUPTS TAD I WS0 SZA SMA /REQUEST OR INACTIVE? TAD C1000 /NO - SET TIMER BIT SMA /HOW SHALL WE EXIT? ISZ TTIME /SKIP - [S]HE'S CURRENTLY ACTIVE DCA I WS0 /SAVE UPDATED STATUS JMP I TTIME /AND AWAY TTIME1, JMS I CONGEA /HUNG - FIND HIS/HER DDB DCA AXS1 JMS I CONSEA /WAKE HIM/HER UP STL RTL TAD WS1 SPA CLA /WHICH DEVICE IS IT? JMP TTIME2 /TELEPRINTER TAD I AXS1 /JOB OWNING DEVICE SNA JMP TTIME2-1 /NO JOB, HUNG -- LET'S GET RID OF HIS/HER BUFFER!! CDF ERROR /PASS THE ERROR TO HIM/HER HUNGDV DATFLD JMP I CONO1A /TRY AGAIN NOW CONGEA, CONGET CONSEA, CONSET CONO1A, CONOU1 CONCLR, CLRBUF TOFT1, TOFSET, 0 /ONLY CALLED BY "TOF TAD TOF SPA CLA /CALLED FROM INPUT OR OUTPUT HANDLER? JMS I CONSEA /SET OUTPUT FLAGS JMP I TOFSET /RETRIEVE A CHARACTER FROM LINKED BUFFER /CALL: DDB ADDRESS IN AC / JMS TOF / RETURN BUFFER EMPTY / RETURN CHARACTER IN AC TOF, 0 TAD C0005 /INDEX TO COUNT DCA TOFA1 TAD I TOFA1 SNA JMP I TOF /ALREADY EMPTY ISZ TOF /SHOW SUCCESS SPA JMP TOF3 /GENERATE A FILLER TAD C7740 SNA JMS TOFSET /TIME TO SET STR1 BIT TAD C0037 /AC NOW = COUNT -1 SNA JMP TOF4 /THIS WILL BE THE LAST CHARACTER TOF0, DCA I TOFA1 ISZ TOFA1 /POINT TO EMPTY COUNT ISZ I TOFA1 /ANY LEFT IN THIS BLOCK? JMP TOF1 /MUST BE TAD TC7766 DCA I TOFA1 /RESET THE EMPTY COUNT ISZ TOFA1 /EMPTY BLOCK TAD I TOFA1 CDF RETBLK /RETURN THE EMPTY BLOCK DATFLD DCA I TOFA1 /LINK TO NEXT BLOCK TAD TC7766 JMP TOF1+2 TOF1, TAD I TOFA1 /GET THE COUNT TO DETERMINE POSITION WITHIN THE BLOCK ISZ TOFA1 /POINT TO EMPTY BLOCK TAD C0003 SMA /UNPACK? STL RAL /YES (MULT BY 2 THEN ADD 1) FUDGE POSITION SPA /UNPACK? STL CIA /NO - MAKE OFFSET POSITIVE - SET LINK TO INDICATE NO UNPACKING NEEDED TAD I TOFA1 /ADD OFFSET TO EMPTY BLOCK POINTER DCA TOFA1 TAD I TOFA1 /GET CHARACTER; OR AT LEAST PART OF IT SZL /UNPACK? JMP TOF2 /NO AND C7400 /SAVE PERTINENT BITS DCA TOFT1 ISZ TOFA1 TAD I TOFA1 /GET THE OTHER HALF OF THE CHARACTER AND C7400 /THROW AWAY THE JUNK CLL RTR /START MOVING IT INTO PLACE RTR TAD TOFT1 /GET THE M.S. BITS RTR RTR /THAT SHOULD DO IT TOF2, AND C0377 /CLEAR ANY JUNK LEFT OVER JMP I TOF /AND AWAY TOF3, TAD C0400 /INCR. FILLER COUNT DCA I TOFA1 JMP I TOF /EXIT WITH FILLER (NULL) CHARACTER TOF4, JMS TOFSET /SET THE STR1 BIT FOR THIS DEVICE STA TAD TOFA1 DCA TOFT1 /POINTS TO FILL BLOCK POINTER TAD I TOFT1 CDF RETBLK /RETURN THE LAST BLOCK OF THE BUFFER DATFLD AND TOF SMA CLA /CALLED FROM INPUT OR OUTPUT HANDLER? TAD WS0 /INPUT - CHECK FOR NON-ZERO BREAK-MASK SNA CLA JMP TOF5 /NO "JSDEL" TO CLEAR TAD C0100 JMS I TOFCLR /CLEAR JSDEL - THIS IS THE LAST CHARACTER TOF5, DCA I TOFT1 /CLEAR FILL POINTER SO WE KNOW WE'RE EMPTY JMP TOF0 TC7766, 7766 TOFCLR, CLSTR1 /ROUTINE TO ALLOW SI & FIP TO CLEAR BUFFERS BY WAY OF FIELD 0 ROUTINE SICLR, 0 JMS I CONCLR CIF CDF 20 /BACK TO FIELD 2 JMP I SICLR /CLEAR STATUS UCLS, GETJTW /ADDRESS OF STR0 TO JOBSWA JOBSTS CLA CLL CMA RTL /-3 IN AC DCA WS0 TAD C2407 /DON'T LET HIM/HER MESS UP STR0 SKP Y1, STA /LET HIM/HER ANYTHING IN STR1 AND D.S.R. UDF /UP TO USER FIELD AND I L2SA /GET BITS TO CLEAR CMA DATFLD AND I JOBSWA /CLEAR THEM DCA I JOBSWA /SAVE NEW VALUE ISZ L2SA /BUMP POINTER C0020, 20 /NOP ISZ JOBSWA /BUMP POINTER ISZ WS0 /COUNT, 3 STATUS WORDS TO CLEAR JMP Y1 DCA L2SA /CLEAR HIS/HER AC UUOEXT C2407, JSEREN JSPEEK UUOERF SWPRER SWPWER DSKERR HUNGDV /RETURN CONTENT OF STATUS WORD IN AC /CALL TAD POINTER TO JOB STATUS ADDRESS / GETJTI / RELATIVE ADDR OF WORD / RETURN (ADDRESS OF WORD IN JOBSWA) CLR0, GETJI0, 0 CDF DCA JOBSWA /SAVE POINTER TO JOB STATUS TAD I GETJI0 /GET POSITION IN LIST DCA .+3 /SAVE IT TAD JOBSWA /NOW GET ADDRESS OF THIS ENTRY GETJTA 0 DCA JOBSWA /SAVE IT DATFLD SZL /IF LINK=0 THERE'S NOTHING TO GET TAD I JOBSWA /GET CONTENTS OF THAT ADDRESS CDF ISZ GETJI0 /INDEX RETURN JMP I GETJI0 /RETURN ALL BLOCKS OF LINKED BUFFER TO FREE CORE (EXCEPT DDB) /CLEAR ENTRIES IN DDB SO WE KNOW IT'S EMPTY CLRBUF, 0 SNA JMP I CLRBUF /OOPS! TAD C0004 /POINT TO WORD 4 (FILL POINTER DCA CLR0 TAD I CLR0 SNA CLA JMP I CLRBUF /BUFFER ALREADY EMPTY DCA I CLR0 /CLEAR FILL POINTER ISZ CLR0 DCA I CLR0 /CLEAR CHARACTER COUNT ISZ CLR0 ISZ CLR0 TAD I CLR0 /EMPTY BLOCK POINTER CDF RETBLK /RETURN A BLOCK TO FREE CORE SZA JMP .-2 /DELETE ANOTHER BLOCK DATFLD DCA I CLR0 /CLEAR THE EMPTY BLOCK POINTER JMP I CLRBUF SCHNUL, TAD C0100 /RUN NULL JOB IN USER MODE DCA L2SF /FIELD 0; USER MODE TAD SCHNJA DCA L2SV0 ISZ NULAC /BUMP NULL JOB'S AC TAD NULAC DCA L2SA /RESTORE IT EXIT /OFF TO NULL JOB NULAC, 0 SCHNJA, NULJOB /ROUTINE TO SET EITHER JSTEL, JSLPT, OR JSPTP IN STR1 CONSET, 0 CLA STL RTL TAD WS1 /FROM POSITION IN OUTREG DETERMINE DEVICE FLAG POSITION SNA JMP .+4 /IT'S THE PUNCH SMA CLA /SKIP IF TELEPRINTER TAD C0020 /IT'S THE LINE PRINTER TAD CC0014 TAD C0004 JMS I SETFLG /SET THE APPROPRIATE BIT IN STR1 JMP I CONSET /QUEUE DISC REQUEST /CALL TAD ADDRESS OF TRANSFER BLOCK / JMS DSQUE / RETURN DSQFLD= C0002 /FILPIF DSQUE, 0 DCA DSQUE1 /SAVE ADDRESS OF PARAMETER BLOCK TAD DSQUE1 /NOW GET POINTER TO WORD WITH FIELD & FILE DATA TAD DSQFLD DCA DSQUE2 /SAVE POINTER DATFLD TAD I DSQUE2 /GET FIELD # (BITS 7-9) AND FILE # (BITS 10-11) AND C0037 /USE THIS VALUE AS DSUTBL INDEX TAD DSUTBA DCA DSQUE2 /SAVE POINTER TO DSUTBL TAD DSQUE1 /GET PARAMETER ADDRESS DCA I DSQUE2 /SAVE IN DSUTBL UPEEK3, CDF /AND EXIT JMP I DSQUE /SUBROUTINE TO CHECK FOR PRIVILEGE CONDITION FOR USER DOING UUO /PRIVILEGE BITS ARE SET EITHER BY THE ACCOUNT NUMBER BEING LESS THAN /FOUR (FIP) OR BY A REQUEST TO RUN A LIBRARY PROGRAM USING R, KJOB, /SYSTAT, OR LOGOUT. THE LATTER BIT IS SET BY SI, AND CLEARED EVERY /TIME THAT SI IS ENTERED. DSQUE1, PRIV, 0 GETJTW JOBSTS /GET STR0 AND C0600 /IS EITHER PRIVILEGE BIT SET? SZA CLA JMP I PRIV /YES, OK JMP I .+1 /NO, ERROR; INVALID IOT UUOERR /LOGOUT IS A PRIVILEGED IOT, UNLESS THE AC=0 ULOGO, TAD L2SA /IS AC=0? SZA CLA JMS PRIV /NO - CHECK FOR PRIVILEGE ISZ AXS1 /FUDGE SO AXS1 WILL LEAD TO A 0 JMP I .+1 /NOW JUMP DIRECTLY TO THE NON-RESIDENT UUO6 /UUO CODE /PEEK IS A PRIVILEGED IOT UPEEK, JMS PRIV /MAKE SURE A PRIVILEGE BIT IS SET STA /BACK UP HIS/HER AC TAD L2SA DCA AXS1 /BECAUSE OF AUTO-INDEX UDF TAD I AXS1 /GET CORE-FIELD AND C0010 /LET HIM/HER SEE FIELDS 0,1 /COULD PROBABLY LET HIM/HER SEE MORE, BUT HAVE /TO WORRY ABOUT NON-EXISTENT CORE. TAD UPEEK3 /MAKE A CDF DCA UPEEK1 STA TAD I AXS1 /BEGINNING MONITOR ADDRESS-1 DCA AXS2 TAD I AXS1 /BEGINNING USER ADDRESS DCA WS0 TAD I AXS1 /MINUS HOW MANY WORDS DCA L2SA DSQUE2, UPEEK1, .-. /CDF TO MONITOR FIELD TAD I AXS2 /GET WORD UDF /USER DATA FIELD DCA I WS0 /GET RID OF WORD ISZ WS0 CC0014, 14 /NOP ISZ L2SA /THROUGH? JMP UPEEK1 /NO UUOEXT /YES -- AND HIS/HER AC=0!! *CORTBL LOCK /DATFLD LOCK /FIELD 2 LOCK /FIELD 3 LOCK /FIELD 4 LOCK /FIELD 5 LOCK /FIELD 6 LOCK /FIELD 7 /THE ABOVE ARE UNLOCKED BY INIT AS A FUNCTION OF # USER FIELDS *L2QTB ZBLOCK 20 /LEVEL 2 QUEUE /COMBINED RESIDENT IOTS UUOTBL, 6040 /TELEPRINTER 6660 /LPT 6030 /KEYBOARD 6010 /READER 6020 /PUNCH 6500 /RESERVED FOR FUTURE USE 0 /UNCOMBINED RESIDENT IOTS 6603 /RFILE 6605 /WFILE 6200 /CKS - CHECK STATUS 6405 /CLS - CLEAR STATUS 6400 /KSB - SET KEYBOARD BREAK 6401 /SBC - SELECTIVE BUFFER CLEAR 6402 /DUP - DUPLEX TELETYPE CONSOLE 6403 /UND - UNDUPLEX TTY 6411 /URT - USER RUN TIME 6412 /TOD - TIME OF DAY 6413 /RCR - RETURN CLOCK RATE 6414 /DATE 6415 /SYN - QUANTUM SYNCHRONIZATION 6416 /STM - SET TIMER 6417 /SRA - SET RESTART ADDRESS 6617 /ACT - RETURN ACCOUNT NUMBER 6420 /TSS - SKIP ON TSS/8 6421 /USE - USER 6422 /CON - USER CONSOLE 6423 /PEEK - LOOK IN MONITOR CORE 6430 /SSW - SET SWITCH REGISTER 6431 /SEA - SET ERROR ADDRESS 6614 /SIZE 6004 /GTF - GET FLAGS ( LINK AND GT ONLY ) 6005 /RTF - RESTORE FLAGS (LINK AND GT ONLY) 6006 /SGT - SKIP ON EAE GT FLAG 6764 /DTXA - DECTAPE READ OR WRITE 6771 /DTSF - DECTAPE SKIP 6772 /RDS - READ DEVICE STATUS REGISTER (DT, RK, & CDR) 6773 /DTSF RDS - MICROCODED 6743 /DLAG - RK05 READ OR WRITE 6632 /RCRA - READ CARD ALPHA 6634 /RCRB - READ CARD BINARY 6636 /RCRC - READ CARD COMPRESSED 6615 /LOGOUT - MUST BE LAST IN GROUP, SEE ULOGO FOR DETAILS 0 /NON-RESIDENT IOTS 6440 /ASD - ASSIGN DEVICE 6442 /REL - RELEASE DEVICE 6601 /OPEN - OPEN FILE 6602 /CLOS - CLOSE FILE 6600 /REN - RENAME FILE 6604 /PROT - PROTECT FILE 6610 /CRF - CREATE FILE 6611 /EXT - EXTEND FILE 6612 /RED - REDUCE FILE 6406 /SEGS - RETURN NUMBER OF FREE DISK SEGMENTS 0 /LONG NON-RESIDENT IOTS 6613 /FINF 6616 /WHO 0 /MICRO-CODED RESIDENT IOT DISPATCH UUODTB, UTEL /TELEPRINTER IFNZRO LPT /LINE PRINTER IFZERO LPT UKEY /KEYBOARD UPTR /READER IFNZRO PUNCH /PUNCH IFZERO PUNCH UUOERR /RESERVED FOR FUTURE USE 0 /NON-MICRO-CODED RESIDENT IOT DISPATCH UFILE UFILE UCKS UCLS UKSB USBC UDUP UUND UURT UTOD URCR UDATE USYN USTM USRA UACC UTSS UUSE UCON UPEEK USSW USEA USIZE IFNZRO CPU&7776 IFZERO CPU&7776 IFZERO CPU-2 IFNZRO CPU-2 IFNZRO TC01 IFZERO TC01 UUOEX2 UDTRB UDTRBS IFNZRO RK05 IFZERO RK05 IFNZRO CDR < UUCDR0+2 UUCDR0+1 IFNZRO CPU&7776 IFZERO CPU&7776 > IFZERO CDR ULOGO /LOGOUT - MUST BE FOLLOWED BY A 0 /SEE ULOGO FOR DETAILS 0 /-# ARGUMENTS FOR NON-RESIDENT IOTS 0 /ASD 0 /REL UFILCT, -6 /OPEN 0 /CLOS -6 /REN 0 /PROT -4 /CRF -4 /EXT -4 /RED 0 /SEGS 0 -2 /FINF -2 /WHO 0