TITLE EXEC - PPL EXECUTIVE, I/O, AND UTILITY ROUTINES /EAT/ 19-NOV-72 SUBTTL PROGRAM STARTUP GLISTN==1 ;CAUSE GLOBAL.MAC TO BE LISTED HISEG SEARCH PPL ;DRAG IN UNIVERSAL DEFINITIONS ;SET LOW CORE LOCATIONS LOC JOB41 PUSHJ P,UUOCON ;ENTER UUO HANDLER LOC JOBREN EXP PPLREN ;REENTER FROM MONITOR IFN MITS,< LOC 42 JSR TSINT ;ENTER MITS TRAP HANDLER > RELOC PPL: TDZA AC7,AC7 ;REMEMBER NORMAL ENTRY PPLRST: MOVSI AC7,400000 ;REMEMBER OFFSET ENTRY OR RESTART MOVE R,[XWD PPLLOW,PPLLOW+1] SETZB FF,PPLLOW ;CLEAR THE LOW SEGMENT BLT R,LOWEND-1 MOVE P,[IOWD STKLEN,SYSSTK] IFN FTCCIN,< MOVEI R,INTVEC-1 ;SETUP CONTROL-C INTERRUPT VECTOR PUSH R,[4,,CNCINT] ;DISPATCH POINTER HRRM R,JOBINT ;POINTER TO JOBINT VECTOR PUSH R,TWO ;INTERRUPT TYPE > IFN ARDS,< MOVEI R,34 ;SET CURRENT ARDS MODE TO CHARACTER MOVEM R,AMODE > CALL IOINI ;RESET THE UNIVERSE, INITIALIZE TTY, ;ENABLE TRAPPING, ETC. HRRZ R,JOBFF ;GET START OF FREE AREA MOVEM R,PZBEG ;MAKE THAT BE PZ START ADDI R,2000 ;AT LEAST 1K LONG ORI R,1777 ;MUST END AT 1K BOUNDARY MOVEM R,PZEND ADDI R,1 ;SET DZ START MOVEM R,DZBEG ADDI R,3777 ;INITIALIZE IT TO 2K MOVEM R,DZEND CORE R, ;REQUEST CORE ERROR MSG(ICORI) ;INSUFFICIENT CORE TO INITIALIZE PUSHJ P,PDZINI ;OK, INITIALIZE THE ZONES PUSHJ P,PPLINI ;INITIALIZE STANDARD INTERNAL DATA MSTIME R, ;INITIALIZE RANDOM NUMBER GENERATOR TLZ R,760000 ;ONLY 31 BITS USED JUMPN R,.+2 ;IF ZERO, HRLOI R,1 ; USE STANDARD STARTING VALUE OF ^D524287 MOVEM R,RANDOM MOVSI R,'TTY' ;GET TTY DEVICE CHARACTERISTICS DEVCHR R, TRNE R,1_10 ;IS IMAGE MODE LEGAL FOR TTY? AOS IMGFLG ;YES. (I.E. 5.02 MONITOR OR LATER) MOVE R,[34,,11] ;READ MONITOR VERSION NUMBER GETTAB R, MOVNS IMGFLG ;EARLIER THAN 5.03, SET TO -1 FOR 5.02 JUMPL AC7,SUPVSR ;OMIT STARTUP MSG IF OFFSET ENTRY OR RESTART TTOS PPLHDR ;PRINT VERSION AND DATE IFN FDATA!HARVN,< INIT RD,0 ;OPEN CHANNEL TO LOOK FOR NEWS FILE SIXBIT /DSK/ 0 JRST NOMESS ;NO DISK?????? OH WELL, FORGET IT MOVE AC1,[SIXBIT/NEWS/] ;LOOKUP DSK:NEWS.PPL[LIBPPN] MOVSI AC2,'PPL' MOVE AC4,LIBPPN LOOKUP RD,AC1 JRST NOMESS ;NOT THERE, FORGET IT TTOS [SIXBIT/FOR NEWS AS OF !/] ANDI AC3,7777 ;TYPE OUT CREATION DAT OF NEWS FILE IDIVI AC3,^D31 ;EXTRACT DAY-1 MOVEI AC1,1(AC4) CALL INTPR ;PRINT DAY IN DECIMAL IDIVI AC3,^D12 ;SEPARATE MONTH AND YEAR TTOA MONTAB(AC4) ;PRINT MONTH - MONTAB IN SYSFUN MOVNI AC1,^D64(AC3) ;COMPUTE YEAR - NEG TO GET SECOND DASH CALL INTPR ;PRINT YEAR IN DECIMAL TTOA [ASCIZ/, PLEASE TYPE: READ("LIB:NEWS") /] NOMESS: RELEAS RD, ;GET RID OF INPUT CHANNEL > JRST SUPVSR ;**** BEGIN CONVERSATION **** IFN FDATA,< LIBPPN: 3400,, 102 ;LIB PROJECT-PROGRAMMER NUMBER > IFN HARVN,< LIBPPN: 1,, 4 ;ESSENTIALLY USE SYS: AT HARVARD > SUBTTL UUO CONTROL ;THIS ROUTINE IS CALLED BY A PUSHJ FROM JOB41 T== AC1 ;TEMP UUOCON: MOVEM T,TSAV ;SAVE AN AC HLRZ T,JOBUUO ;GET OP CODE ROT T,-^D10 ;ONE TOO MANY PLACES JUMPGE T,.+2 ;USE LOWEST BIT TO INDICATE LH OR RH OF SKIPA T,UUOTAB(T) ; UUO DISPATCH TABLE MOVS T,UUOTAB(T) HRLI T,TSAV ;RESTORE T AND ENTER UUO SERVICE ROUTINE JRA T,(T) ;GENERATE UUO DISPATCH TABLE UUOLH== 0 UUON== 1 DEFINE UUO(A,B) < IFE UUON,< UUOLH== EXP B > IFN UUON,< XWD UUOLH,B > UUON== 1-UUON > UUOTAB: UUOS IFN UUON,< XWD UUOLH,0 > SUBTTL ERRORS, TRAPS, DDT ENTRY ;HERE FROM MONITOR ON APR TRAP FOR FLOATING OVERFLOW, PUSHDOWN OVERFLOW, ; OR ILL MEM REF. TRAPS: MOVEM FF,CRSHSV ;SAVE AC 0 FOR PROCESSING IFE FTBAKG,< HRRZ FF,JOBCNI ;PICK UP APR STATUS > IFN FTBAKG,< MOVE FF,ENBWRD ;MASK APR STATUS TO THAT ACTUALLY ENABLED FOR ANDB FF,JOBCNI > TRNE FF,AP.ILM+AP.POV ;ILL MEM REF OR PDL OV? JRST TRAPS2 ;YES, DO SYSTEM ERROR PROCESSING IFN FTBAKG,< TRNE FF,AP.FOV ;ASSUME CLOCK IF NO FLAG (4-SERIES BUG) TRNE FF,AP.CLK ;CLOCK TICK? PUSHJ P,CLKTIC ;YES, HANDLE IT > TRNE FF,AP.FOV ;FLOATING OVERFLOW TRAP? JRST OVTRAP ;YES, GO PERFORM FLOATING FIXUP JRST TRPX2 ;NO, RESTORE EVERYTHING AND DISMISS ;HERE ON PDL OV OR ILL MEM REF TRAPS2: JSP FF,SAVACS ;DUMP ALL AC'S IN CRSHSV BLOCK HRRZ FF,JOBCNI ;GET APR STATUS AGAIN MOVEI AC2,MSG(PDLOV) ;PDL OV TRNE FF,AP.ILM ;ILL MEM REF? MOVEI AC2,MSG(ILMEM) ;ILL MEM REF JRST CRASH ;GO DO CRASH STOP AND/OR RECOVERY ;HERE FOR ERROR UUO, WHICH IS IN THE FORM ; ERROR [SIXBIT/ERROR MESSAGE#/] ; AND IS USED WHEN INTERNAL ERRORS ARE DISCOVERED. SYSERR: POP P,JOBTPC ;REMEMBER PC OF ERROR MOVEM FF,CRSHSV ;SAVE AN AC FOR PROCESSING JSP FF,SAVACS ;DUMP ALL AC'S IN CRSHSV BLOCK MOVE AC2,JOBUUO ;REMEMBER ADDRESS OF MESSAGE ;CODE TO PRINT ERROR MESSAGE, DROP INTO DDT IF LOADED, AND ATTEMPT ; RECOVERY. CRASH: MOVEI P,CRSHPD-1 ;SETUP TEMPORARY PUSHDOWN LIST PUSH P,OFILE ;SAVE OUTPUT FILE POINTER SETZM OFILE ;CAUSE MESSAGE TO COME OUT ON TTY TTOS [SIXBIT/SYSTEM ERROR DETECTED AT !/] SOS AC1,JOBTPC ;PICK UP ADDRESS OF ERROR CALL OCTPRT ;OCTAL CONVERSION TO SIXBIT MOVSI R2,(SIXBIT/; !/) ;APPEND TERMINATOR TTOS R ;PRINT ADDRESS OF ERROR TTOS (AC2) ;PRINT ERROR MESSAGE IFE MITS,< POP P,OFILE ;RESTORE OLD OFILE CALL GODDT0 ;TRANSFER TO DDT IF LOADED > RESETF: MOVE P,[IOWD STKLEN,SYSSTK] ;RESET STACK SETZB FF,OFILE ;CLEAR FLAGS AND OUTPUT FCB POINTER SETZM INTFLG ;CLEAR ^C/REENTER FLAGS CALL KILLIO ;TERMINATE FILE OPERATIONS ;HERE TO PERFORM RESET OPERATION AND PRINT ADVISORY MESSAGE. RESETP: TTOS 1,[SIXBIT/[RESET EXECUTED]#/] ;HERE TO PERFORM RESET OPERATION WITHOUT ADVISORY MESSAGE. RESETN: SETZM RAF ;CLEAR RING OF ACTIVE FUNCTIONS SETZM RSF ;CLEAR RING OF SUSPENDED FUNCTIONS MOVE P,[IOWD STKLEN,SYSSTK] ;CLEAR SYSTEM STACK JRST SUPVSR ;RESTART THE SUPERVISOR IFE MITS,< ;ROUTINE TO TRANSFER TO DDT WITH ALL AC'S SAVED, IN SUCH A WAY THAT ; WHEN CONT$G OR JRSTF @JOBOPC IS EXECUTED IN DDT, CONTROL WILL ; RETURN WITH ALL AC'S RESTORED. GODDT: POP P,JOBERR ;POP OFF RETURN PC AND SAVE IT MOVEM FF,CRSHSV ;SAVE AN AC FOR PROCESSING JSP FF,SAVACS ;SAVE THE REST OF THE AC'S JRST .+2 ;DDT ENTRY ROUTINE CALLED FROM SYSTEM ERROR PROCESSING CODE. GODDT0: POP P,JOBERR ;STASH AWAY RETURN ADDRESS SETZ R, ;CLEAR TRAP ENABLES APRENB R, ; SO THAT DDT DOESN'T TRAP INTO PPL IFN FTCCIN,< AOS INTVEC+2 ;DISABLE CONTROL-C INTERCEPT > SKIPE P,JOBDDT ;IS DDT LOADED? JSP R,GODDT1 ;YES, TRANSFER TO IT IFE FTBAKG,< MOVEI R,AP.REN+AP.POV+AP.ILM+AP.FOV ;RESTORE APR ENABLE BITS > IFN FTBAKG,< MOVE R,ENBWRD ;RESTORE APR ENABLE BITS > APRENB R, IFN FTCCIN,< SOS INTVEC+2 ;REENABLE ^C INTERCEPT IF ENABLED BEFORE > MOVSI P,CRSHSV ;NOW RESTORE ALL THE AC'S FROM CRSHSV BLOCK BLT P,P JRSTF @JOBERR ;RETURN TO CALLER OF GODDT GODDT1: MOVEM R,JOBOPC ;SETUP PC FOR RETURN FROM DDT MOVSI R,CRSHSV ;RESTORE ALL AC'S EXCEPT P BLT R,R HRLI P,CRSHSV+P ;SETUP POINTER TO SAVED P JRA P,(P) ;JUMP TO DDT, RESTORING P ;IN DDT, ALL THE AC'S AND LOW SEGMENT LOCATIONS ARE EXACTLY THE WAY ; THEY WERE AT THE TIME OF THE ERROR OR WHEN GODDT WAS INVOKED VIA ^Z. ; HOWEVER, IT IS IMPOSSIBLE TO CLOBBER THE AC'S (E.G. USING DBGPRT), ; SINCE THEY ARE RESTORED AGAIN UPON RETURNING FROM DDT. > ;ROUTINE TO SAVE AC'S 1-17 (AC1-P) IN THE CRSHSV BLOCK. IT IS ASSUMED ; THAT FF HAS ALREADY BEEN SAVED. CALL BY: ; JSP FF,SAVACS SAVACS: MOVEM P,CRSHSV+P ;SAVE ANOTHER AC FOR PROCESSING MOVE P,[AC1,,CRSHSV+AC1] ;SETUP BLT POINTER BLT P,CRSHSV+R2 ;SAVE ALL AC'S BETWEEN FF AND P JRST @FF ;RETURN IFN FTBAKG,< ;THE FOLLOWING SUBROUTINE IS EXECUTED EVERY CLOCK TICK (IF BACKGROUND ; MODE IS ENABLED) TO SEE WHETHER ANY OTHER USER WANTS TO RUN, AND ; IF SO, GO TO SLEEP FOR A WHILE. THIS CODE ATTEMPTS TO KEEP OUR JOB ; RUNNING REASONABLY EFFICIENTLY IF THE SYSTEM IS LIGHTLY LOADED, ; BUT CAUSE THE MINIMUM POSSIBLE INTERFERENCE TO OTHER USERS IF THE ; SYSTEM IS HEAVILY LOADED. ;THE ALGORITHM IS ROUGHLY AS FOLLOWS: ; (1) COMPUTE A MINIMUM TIME-TO-RUN, BASED ON THE AMOUNT OF CORE ; WE ARE USING. ALWAYS RUN AT LEAST AS LONG AS OUR IN-CORE ; PROTECT TIME (ELSE WE WON'T SWAP OUT WHEN WE SLEEP). ; (2) SCAN THE JOB STATUS TABLES AND SEE IF ANY OTHER USER WANTS TO ; RUN. IF NOT, RUN FOR 1/6 SECOND (10 JIFFIES) AND GO TO 2. ; (3) COMPUTE A TIME-TO-SLEEP BY THE FOLLOWING FORMULA: ; I1 - I0 ; S = ( 1 - ------- ) * (MAXSLP-MINSLP) + MINSLP ; T1 - T0 ; WHERE: ; I0 AND I1 ARE THE AMOUNT OF SYSTEM IDLE TIME AT THE BEGINNING ; AND END OF THE LAST SLEEP PERIOD. ; T0 AND T1 ARE THE VALUE OF SYSTEM UPTIME AT THE BEGINNING ; AND END OF THE LAST SLEEP PERIOD. ; MINSLP IS A MINIMUM SLEEP TIME (E.G. 5 SECONDS) ; MAXSLP IS A MAXIMUM SLEEP TIME (E.G. 60 SECONDS). ; IDLE TIME IS DEFINED AS TOTAL NULL TIME MINUS LOST TIME. THIS ; ALGORITHM PRODUCES SHORT SLEEP TIMES IF THE IDLE TIME IS VERY ; HIGH (I.E. THE SYSTEM IS LIGHTLY LOADED) AND LONG SLEEP TIMES ; IF THE IDLE TIME IS LOW (I.E. THE SYSTEM IS HEAVILY LOADED). ; (4) SLEEP THE SPECIFIED LENGTH OF TIME, THEN GO BACK TO 1. ;STILL IN FTBAKG CONDITIONAL ;CALLED FROM APR TRAP HANDLER CLKTIC: SKIPN SUSPND ;NEVER SLEEP IF USER TRYING TO SUSPEND SOSLE JIFCNT ;END OF MEASURED RUNTIME? POPJ P, ;NO, DON'T CHECK FOR OTHER USERS NOW PUSHJ P,SAVE4 ;YES, SAVE SOME AC'S MOVE AC1,[15,,11] ;GET -#HISEGS,,+#JOBS IN SYSTEM GETTAB AC1, ; FROM THE MONITOR JRST CLKCLR ;UNLIKELY ERROR--ASSUME NO OTHER USERS MOVNI AC1,-1(AC1) ;TAKE NEGATIVE, ELIMINATING NULL JOB MOVSI AC1,(AC1) ;MAKE AOBJN POINTER PJOB AC2, ;GET OUR JOB NUMBER CLKT1: MOVSI AC3,1(AC1) ;PUT JOB NUMBER IN LH GETTAB AC3, ;RETURN STATUS FOR THAT JOB SETZ AC3, ;VERY UNLIKELY ERROR--ASSUME NONEXISTENT TLNE AC3,400000 ;JOB RUNNABLE? TLNN AC3,40000 ;JOB EXIST EVEN? JRST CLKT2 ;NO TO EITHER, SKIP IT TLNN AC3,(37B14) ;YES, JOB IN WAIT STATE 0 (RUNNING)? CAIN AC2,1(AC1) ;AND SOME JOB BESIDES OURSELF? CLKT2: AOBJN AC1,CLKT1 ;NO, SKIP THAT JOB JUMPL AC1,CLKSLP ;GO SLEEP IF WE FOUND SOMEONE TRYING TO RUN ;HERE WHEN NOBODY ELSE WANTS TO RUN. LET'S RUN 10 MORE TICKS CLKCLR: SETZM SLPTIM ;CLEAR PREVIOUS SLEEP TIME (ANCIENT INFO) MOVEI AC1,^D10 ;RESET MEASURED RUNTIME TO 10 TICKS JRST CLKT3 ;SET IT AND RETURN ;REMEMBER WHEN WE STARTED TO SLEEP, THEN GO TO SLEEP FOR PREVIOUSLY ; COMPUTED TIME. CLKSLP: PUSHJ P,CLKTIM ;GET CURRENT UPTIME AND IDLE TIME MOVE AC3,AC1 ;SAVE CURRENT UPTIME MOVE AC4,AC2 ;SAVE CURRENT IDLE TIME SKIPN AC1,SLPTIM ;FETCH PREVIOUSLY-COMPUTED SLEEP TIME MOVEI AC1,MINSLP ;USE MINIMUM IF NOT AVAILABLE SLEEP AC1, ;ZZZZZZ ;COMPUTE THE TIME FOR THE NEXT SLEEP PUSHJ P,CLKTIM ;GET CURRENT UPTIME AND IDLE TIME SUB AC1,AC3 ;COMPUTE UPTIME DIFFERENCE (T1-T0) SUB AC2,AC4 ;COMPUTE IDLE TIME DIFFERENCE (I1-I0) SUBM AC1,AC2 ;COMPUTE SLEEP TIME IN SECONDS MOVEI AC3,MAXSLP-MINSLP ; (SEE FORMULA PREVIOUS PAGE) MUL AC3,AC2 DIV AC3,AC1 ADDI AC3,MINSLP MOVEM AC3,SLPTIM ;SAVE IT FOR NEXT TIME ;NOW COMPUTE THE MINIMUM TIME WE WANT TO STAY AWAKE. MOVE AC1,JOBREL ;GET JOB SIZE IN WORDS LSH AC1,-^D10 ;CONVERT TO (K-1) MOVE AC2,[2,,15] ;GET IN-CORE-PROTECT-TIME MULTIPLIER GETTAB AC2, ; FROM THE MONITOR MOVEI AC2,3 ;ERROR--ASSUME 3 JIFFIES PER K IMULI AC1,(AC2) ;PERFORM MULTIPLICATION MOVE AC2,[3,,15] ;GET IN-CORE-PROTECT-TIME ADDER GETTAB AC2, ; FROM THE MONITOR MOVEI AC2,6 ;ERROR--ASSUME 6 JIFFIES AVERAGE SEEK TIME ADDI AC1,(AC2) ;ADD IT ON ;HERE WITH TIME-TO-RUN IN AC1 CLKT3: MOVEM AC1,JIFCNT ;STORE TIME TO RUN IN JIFFIES POPJ P, ;RETURN TO START RUNNING ;ROUTINE TO RETURN THE CURRENT UPTIME AND IDLE TIME IN AC1 AND AC2. CLKTIM: MOVE AC1,[15,,12] ;GET SYSTEM UPTIME GETTAB AC1, TIMER AC1, ;USE TIME-OF-DAY IF UNAVAILABLE PUSH P,AC1 ;REMEMBER IT MOVEI AC2,4 ;GET TOTAL SYSTEM NULL TIME GETTAB AC2, ; (RECORDED AS TIME FOR JOB 0) MOVE AC2,AC1 ;ASSUME ALL UPTIME WAS NULL IF UNAVAILABLE MOVE AC1,[22,,12] ;GET TOTAL SYSTEM LOST TIME GETTAB AC1, SETZ AC1, ;ASSUME NONE IF UNAVAILABLE SUB AC2,AC1 ;COMPUTE IDLE TIME JRST X1 ;RESTORE AC1 AND RETURN >;END CONDITIONAL ON FTBAKG IFN FTCCIN,< ;HERE ON CONTROL-C INTERCEPT. IF THIS IS THE FIRST, THEN PERFORM ; NORMAL USER SUSPENSION (SIMILAR TO ^C, REENTER). IF NOT THE FIRST ; IN A ROW, EXIT TO THE MONITOR AS IF ^C HADN'T BEEN INTERCEPTED. CNCINT: SKIPGE INTFLG ;IS THIS THE 2ND INTERCEPT IN A ROW? EXIT 1, ;YES, SILENTLY EXIT TO THE MONITOR MOVEM R,JOBOPC ;SAVE AN AC FOR PROCESSING MOVEI R,TT ;SETUP ARG FOR RESDV. UUO RESDV. R, ;RESET TTY CHAN TO AVOID STRANGE HANGING BUG JFCL ;^C-INT AVAILABLE AND NOT RESDV.??? IFN TT,< SETZ R, ;CLEAR R > EXCH R,INTVEC+2 ;GET TRAP PC, ENABLE FOR NEXT INTERCEPT HRROS INTFLG ;REMEMBER AN INTERCEPT OCCURRED EXCH R,JOBOPC ;REMEMBER INTERCEPT PC, RESTORE R JRST INTUSR ;GO PERFORM USER SUSPENSION > ;HERE WHEN (NON-INTERCEPTED) CONTROL-C, REENTER SEQUENCE HAVE BEEN TYPED. ; CHECK FOR SECOND IN A ROW, AND IF SO ASSUME USER WAS BREAKING OUT ; OF SOME KIND OF INTERNAL LOOP, ILLEGAL UUO, ETC., AND DO A RESET. PPLREN: MOVSS INTFLG ;PUT REENTER FLAG IN LH SKIPGE INTFLG ;PREVIOUS REENTER STILL PENDING? JRST RESETF ;YES, GIVE UP AND DO A RESET HRLOS INTFLG ;NO, SWAP HALVES BACK AND SET REENTER FLAG ;HERE TO PERFORM USER SUSPENSION INTUSR: MOVEM R,SUSPND ;SAVE AN AC MOVS R,@JOBOPC ;GET INST BEING EXECUTED (SWAPPED) CAME R,[SLEEP,,(CALLI AC1,)] ;IS IT A SLEEP? CAMN R,[EXIT,,(CALLI 1,)] ;IS IT A SOFT EXIT? AOS JOBOPC ;YES, DON'T DO IT AGAIN ANDI R,777740 ;KEEP OPCODE AND AC FIELD CAIN R,(TTCALL 1,) ;TTY OUTPUT INSTRUCTION? AOS JOBOPC ;YES, DON'T REPEAT IT CAIE R,(TTCALL 0,) ;INPUT CHARACTER FROM TTY? CAIN R,(TTCALL 4,) JRST TTWSUS ;YES, HANDLE SUSPENSION IMMEDIATELY EXCH R,SUSPND ;NO, JUST SET SUSPENSION FLAG CONT: JRSTF @JOBOPC ;GO BACK TO WHAT WE WERE DOING BEFORE ;'EDIERR' UUO PROCESSING - RECOVERY POINT IN EDIREC EDTERR: CALL KILLIO ;KILL FILE I/O ON ERROR CALL SAVCLR ;CLEAR PZ SAVE STACK TTOS @JOBUUO ;PRINT MESSAGE MOVE P,EDIREC ;RESTORE P FOR RECOVERY TRNN FF,FOPN ;IS A FUNCTION OPEN? JRST ACCL1 ;NO AOS PZSAV ;YES. DON'T CLOBBER SAVED STUFF JRST EDIMOD ;RESUME EDITING AT SAME STATEMENT ;DOUBLE PRECISION ARITHMETIC ROUTINES ;FIRST OPERAND AND RESULT IN R,R2 ;SECOND OPERAND IN (E),(E)+1 OF UUO ;ADDITION XDFAD: MOVEM R+2,TSAV ;SAVE 3RD AC MOVE R+2,JOBUUO ;GET ADDR OF MEM ARG UFA R+1,1(R+2) ;ADD LOW PARTS FADL R,@JOBUUO ;ADD HIGH PARTS JFOV .+3 ;IF OV, FIX AND EXIT UFA R+1,R+2 ;COMPLETE CARRIES FADL R,R+2 MOVE R+2,TSAV ;RESTORE AC POPJ P, ;SUBTRACTION XDFSB: DFN R,R+1 ;(AC)-(MEM) = -((MEM)-(AC)) PUSHJ P,XDFAD DFN R,R+1 POPJ P, ;MULTIPLICATION XDFMP: MOVEM R+2,TSAV MOVE R+2,R ;COPY HIGH AC ARG AOS JOBUUO FMPR R+2,@JOBUUO ;FORM ONE CROSS PRODUCT JFCL ;IGNORE OVERFLOW SOS JOBUUO FMPR R+1,@JOBUUO ;FORM OTHER CROSS PRODUCT JFCL ;IGNORE OVERFLOW UFA R+1,R+2 ;ADD CROSS PRODUCTS JFCL ;IGNORE OVERFLOW FMPL R,@JOBUUO ;FORM HIGH PRODUCTS JFOV DFX ;FIXUP, SET FOV AND EXIT NOW IF OV UFA R+1,R+2 ;ADD CROSS PRODUCTS AND LOW AC RESULT FADL R,R+2 ;FINISH CARRIES MOVE R+2,TSAV POPJ P, ;DIVISION XDFDV: FDVL R,@JOBUUO ;GET QUOTIENT AND REMAINDER JFOV DFX1 ;CHECK OVERFLOW, FIX UP AND EXIT IF OV MOVEM R+2,TSAV MOVN R+2,R ;GET NEGATIVE QUOTIENT AOS JOBUUO FMPR R+2,@JOBUUO ;MUL THE LOW ORDER ANSWERS JFCL ;IGNORE OV UFA R+1,R+2 ;ADD LOW PRODUCT TO - QUOTIENT SOS JOBUUO FDVR R+2,@JOBUUO ;DIVIDE LOW PART JFCL ;IGNORE OV FADL R,R+2 ;COMBINE DFX: MOVE R+2,TSAV DFX1: POPJ P, SUBTTL PPL I/O ROUTINES AND CONTROLS REPEAT 0,< ******* TELETYPE I/O ********* TTY INPUT AND OUTPUT IS HANDLED BY UUOS RATHER THAN BY DIRECT CALLS ON THE TTCALL UUO. THIS IS SO THAT FUTURE MODIFICATIONS TO CHARACTER HANDLING MAY BE IMPLEMENTED ENTIRELY WITHIN THIS ROUTINE. **** TTY INPUT - TTI UUO ******* "TTI ADR" WILL READ THE NEXT CHARACTER AND PLACE IT IN LOCATION ADR. A AFTER A WILL BE SUPPRESSED. TTI DOES SINGLE CHARACTER MODE INPUT ***** TTY OUTPUT - TTO, TTOI, TTOS, TTOA UUOS ****** "TTO ADR" WILL PRINT THE ASCII CHAR. AT ADR. "TTOI E" WILL PRINT THE ASCII CHARACTER E. "TTOS ADR" WILL PRINT THE SIXBIT STRING STARTING AT ADR. THE STRING MUST BE TERMINATED EITHER BY "#" (CRLF) OR BY "!" (NO CRLF). "TTOA ADR" WILL PRINT THE ASCIZ STRING AT ADR. FOR ALL OUTPUT UUO'S, OUTPUT IS SUPPRESSED IF RDFLG IS SET (IN FF) AND THE AC FIELD OF THE UUO IS NONZERO. > ;ROUTINE TO RESET EVERYTHING - I/O, TELETYPE, TRAPPING, ETC. IOINI: RESET ;RESET THE UNIVERSE IFE MITS,< MOVEI R,TRAPS ;ENABLE APR TRAPPING FOR FOV,PDL OV, ILL MEM MOVEM R,JOBAPR MOVEI R,AP.REN+AP.POV+AP.ILM+AP.FOV IFN FTBAKG,< MOVEM R,ENBWRD ;SAVE APR ENABLE BITS > APRENB R, ;WILL TRAP TO LOCATION "TRAPS" > ;CALL HERE TO KILL OPEN USER FILES (BUT NOT STATISTICS OR APR TRAPS) KILLIO: RELEAS RD, ;RELEASE USER CHANNELS, IF OPEN IFN RD-WR,< RELEAS WR, > TLZ FF,RDFLG ;CLEAR SPECIAL I/O MODES SETZM IFILE SETZM OFILE ;ROUTINE TO INIT THE TTY TO GIVE FULL-CHARACTER-SET INPUT MODE AND ;NO DOLLAR-SIGN ECHO ON ALTMODE INITTY: SETZM SUSPND ;CLEAR USER SUSPENSION AND OUTPUT SUPPRESSION SKIPE IFILE ;INPUT FROM A FILE? RETURN ;YES, DON'T BOTHER INITTING TTY. IFE MITS,< TTCALL 13, ;TERMINATE EFFECT OF ^O, IF ANY JFCL ; (INST IS SKIP IF INPUT CHARACTER) MOVEI R,500 ;SUPPRESS ALTMODE ECHO, FULL CHAR SET IFN HARVN,< SKIPLE IMGFLG ;5.03 OR LATER MONITOR? IORI R,1000 ;YES, SUPPRESS CONTROL CHAR ECHOES > SKIPE JOBDDT ;BUT IF DDT IS LOADED, MOVEI R,100 ; THEN DON'T WANT "$" SUPPRESSED IN DDT INIT TT,(R) ;INITIALIZE TTY STATUS BITS SIXBIT /TTY/ EXP 0 ;WE NEVER USE TTY BUFFERS ERROR MSG(TTFAL) ;INIT FAILED FOR TTY > IFN MITS,< SETZM TTYOFL ;TERMINATE EFFECT OF ^O > IFN ARDS,< SAVE JOBUUO ;SAVE LOC. OF ERROR MESSAGE IF THERE IS ONE ARDMODE 34 ;ENTER ARDS CHARACTER MODE RESTORE JOBUUO ;RECOVER JOBUUO ACROSS ARDMODE CALL IFE MITS,< SKIPE T37 ;IN SPECIAL ARDS MODE? TTCALL 7,T37 ;YES, SET BACK TO TTY MODE SETZM T37 ;SIGNAL TTY MODE >> RETURN ;ALL IS WELL ;TTI - TTY INPUT UUO SERVICE ROUTINE. T== AC1 ;TEMP TTYI: PUSH P,T SKIPE IFILE ;INPUT FROM A FILE? JRST TTIFIL ;YES, DO IT IFN CTRLUB+CTRLZU,< TLNE FF,TTIFLG ;CHAR. OR LINE MODE INPUT? JRST .+3 ;CHAR MODE FOR SPECIAL EDITING TTIWT4: TTCALL 4,T ;LINE MODE TO REDUCE SWAPPING LOAD NORMALLY JRST .+2 > IFE MITS,< TTYIWT: TTCALL 0,T ;GET AN INPUT CHARACTER CAIN T,32 ;IF ^Z, GO TO DDT IF LOADED PUSHJ P,GODDT > IFN MITS,< SETZM TTYOFL ;TERMINATE ^O ON ANY INPUT TTYIWT: .IOT .TTYI,T ;GET CHARACTER, IMAGE MODE CAIN T,CR ;CARRIAGE RETURN? JRST ECHCR ;YES, GO ECHO IT AND LF CAIN T,TAB ;TAB? JRST ECHTAB ;YES, ECHO 8 SPACES CAIE T,LF ;OTHER FORMAT CHARACTERS? CAIN T,14 JRST ECH ;YES CAIL T," " ;NO. PRINTING CHAR? CAILE T,172 JRST NOECH ;NO, DON'T ECHO ECH: .IOT .TTYO,T ;ECHO CHARACTER JRST NOECH ECHTAB: MOVEI T,10 ;ECHO 8 SPACES FOR TAB .IOT .TTYO,[" "] SOJG T,.-1 MOVEI T,TAB ;BUT RETURN TAB JRST NOECH ECHCR: .IOT .TTYO,T ;ECHO CR,LF FOR CR .IOT .TTYO,[LF] NOECH: > CAIE T,33 ;SOME KIND OF ALTMODE? CAIN T,176 MOVEI T,175 ;YES, USE STANDARD KIND IFE MITS,< CAIN T,15 ;A CARRIAGE RETURN? TTCALL 0,TSAV ;YES, THROW AWAY FOLLOWING LF > TTIRET: EXCH T,(P) ;RETURN THE CHARACTER POP P,@JOBUUO HLLZS OUTPOS ;CLEAR KNOWLEDGE OF TYPEHEAD POSITION POPJ P, ;HERE TO INPUT THE NEXT CHARACTER FROM THE COMMAND INPUT FILE TTIFIL: SAVE ;PROTECT SOME REGISTERS TTIF1: CALL NXTBYT ;INPUT A BYTE JRST TTIF6 ;EOF, RETURN A CR MOVE T,R ;GET THE BYTE CAIE T,CR ;CR? JRST TTIF9 ;NO, RETURN CHAR AS IS TTIF2: CALL NXTBYT ;YES, GET NEXT CHAR AFTER CR JRST TTIF6 ;EOF, JUST RETURN CR CAIN R,LF ;LINE FEED? JRST TTIF8 ;YES, THROW IT AWAY AND RETURN CR MOVE R2,IFILE ;GET ADR OF FCB EXCH AC10,FILPTR(R2) ;AC10 (BP) _ INPUT BYTE PTR PUSHJ P,BACKBP ;BACK IT UP 1 CHARACTER EXCH AC10,FILPTR(R2) ;PUT IT BACK IN FILE BLOCK DPB R,FILPTR(R2) ;SAVE CHAR IN CASE AT BEGINNING OF BUFFER AOS FILCTR(R2) ;INCREMENT BYTE COUNTER JRST TTIF8 ;RETURN CR FOR CALL TO TTI ;HERE ON END-OF-FILE TTIF6: SKIPN EVALBP ;IS IT DOING AN EXECUTE? JRST TTIF7 ;NO, DO NORMAL THINGS SETZM EVALBP ;SET EVALBP TO ZERO SETZM IFILE ;ALSO IFILE TRNE FF,FOPN ;IS A FUNCTION OPEN SFNERR MSG(EOFOP) ;END OF FILE WITH FUNCTION OPEN JRST TTIF8 TTIF7: MOVE R,IFILE ;GET INPUT FCB ADR CAIN R,RWFCB ;INPUT VIA READ SYSTEM FN? TLZ FF,RDFLG ;YES, CLEAR READ MODE TRNE FF,FOPN ;IS A FUNCTION DEFINITION OPEN? FILERR R,MSG(EOFOP) ;END OF FILE WITH FUNCTION OPEN TTIF8: MOVEI T,CR TTIF9: RESTOR ;RESTORE SAVED REGISTERS JRST TTIRET ;RETURN CHARACTER TO UUO HANDLER ;TTY OUTPUT (EXPANDED TO DO FILE OUTPUT IF OFILE IS NONZERO) ;TTOA - OUTPUT ADDRESSED ASCIZ STRING TTYOA: PUSH P,AC1 ;SAVE A REGISTER MOVE AC1,JOBUUO ;GET THE UUO EXECUTED PUSHJ P,SUSCHK ;SHOULD OUTPUT BE SUPPRESSED? JRST X1 ;YES, DON'T DO ANYTHING HRLI AC1,(POINT 7,0) ;SET UP BYTE POINTER FOR UNPACKING PUSH P,AC1 ;SAVE IT ON STACK TTOA1: MOVE AC1,-1(P) ;RESTORE AC1 IN CASE IT WAS TEXT ITSELF ILDB AC1,(P) ;LOAD A CHARACTER JUMPE AC1,TTOAX ;EXIT IF END OF STRING TTOI (AC1) ;NO, OUTPUT AN ASCII CHARACTER JRST TTOA1 ;GO GET ANOTHER TTOAX: POP P,AC1 ;POP OFF SAVED POINTER JRST X1 ;RESTORE AC1 AND RETURN ;ROUTINE TO CHECK FOR OUTPUT SUPPRESSION BECAUSE ; (1) NONZERO AC IN OUTPUT UUO AND INPUT IS FROM A FILE, OR ; (2) USER SUSPENSION HAS OCCURRED AND OUTPUT IS TO THE TTY ; MOVE AC1,OUTPUT UUO ; PUSHJ P,SUSCHK ; OUTPUT TO BE SUPPRESSED RETURN ; NORMAL RETURN SUSCHK: TLNE AC1,(Z 17,) ;NONZERO AC IN OUTPUT UUO? SKIPN IFILE ;YES, INPUT FROM A FILE? JRST .+2 ;NO TO EITHER POPJ P, ;YES, TAKE SUPPRESS OUTPUT RETURN SKIPE SUSPND ;HAS USER SUSPENSION OCCURRED? SKIPE OFILE ;YES, IS OUTPUT TO THE TELETYPE JRST CPOPJ1 ;NO TO EITHER, TAKE NORMAL RETURN POPJ P, ;YES, TAKE SUPPRESS OUTPUT RETURN ;TTOS - OUTPUT SIXBIT STRING, ENDING WITH EITHER # OR !. TTYOS: PUSH P,AC1 ;SAVE A REGISTER MOVE AC1,JOBUUO ;GET THE UUO EXECUTED PUSHJ P,SUSCHK ;CHECK FOR OUTPUT SUPPRESSION JRST X1 ;YES, DON'T DO ANYTHING IFN FTEMF,< MOVEI AC1,(AC1) ;CLEAR LH OF UUO CAIGE AC1,700000 ;ADDRESS IN ERROR MESSAGE FILE? JRST NOTEMF ;NO, IN CORE. PRINT DIRECTLY SAVE ;YES, SAVE SOME AC'S TLOE FF,EMFOPN ;ERROR MESSAGE FILE OPEN? JRST EMFRD1 ;YES, GO READ AT ONCE SETZB AC3,AC4 ;NO. ASSUME MY DIRECTORY OR SYS MOVSI AC2,'SYS' ;ASSUME SYS IF MONITOR WON'T TELL US SKIPE JOBDDT ;UNLESS DDT IS LOADED, MOVSI AC2,'DSK' ; IN WHICH CASE ASSUME DSK HRROI AC1,14 ;GET HI-SEG INDEX FOR THIS JOB GETTAB AC1, SETZ AC1, ;NOT AVAILABLE (PROBABLY 1-SEG MACHINE) JUMPLE AC1,EMFRD0 ;IF NO HI-SEG INDEX, ASSUME SYS OR DSK MOVSI AC4,(AC1) ;PUT HI-SEG INDEX IN LH HRRI AC4,2 ;GET HI-SEG PPN GETTAB AC4, SETZ AC4, ;THIS ISN'T SUPPOSED TO HAPPEN JUMPE AC4,EMFRD0 ;IF NO HI-SEG PPN, ASSUME SYS OR DSK MOVSI AC2,(AC1) ;PUT HI-SEG INDEX IN LH HRRI AC2,24 ;GET HI-SEG DEVICE GETTAB AC2, SKIPGE AC2,AC4 ;LEVEL C, DEV IN PPN IF NEGATIVE JRST EMFRD0 ;LEVEL D, OR LEVEL C NON-DSK MOVSI AC2,'DSK' ;LEVEL C DISK ;STILL IN FTEMF CONDITIONAL ;CONTINUATION OF CODE TO READ ERROR MESSAGE FILE EMFRD0: MOVEI AC1,17 ;OPEN ERROR MESSAGE FILE IN DUMP MODE OPEN EMF,AC1 JRST EMFERR ;CAN'T OPEN DEVICE??? HRROI AC1,3 ;GET PROGRAM NAME FROM MONITOR GETTAB AC1, ; TO FIND OUT WHAT WE ARE CALLED MOVSI AC1,'PPL' ;ASSUME "PPL" IF MONITOR WON'T TELL US JUMPE AC1,.-1 ;OR IF MONITOR BLEW IT MOVSI AC2,'ERR' LOOKUP EMF,AC1 JRST EMFERR ;NOT FOUND ;HERE TO READ THE FILE AND SETUP TO PRINT THE APPROPRIATE MESSAGE EMFRD1: HRRZ AC1,JOBUUO ;FETCH EFF ADR OF UUO AGAIN IDIVI AC1,200 ;COMPUTE RELATIVE BLOCK OF MESSAGE USETI EMF,1-<700000_-7>(AC1) ;SELECT CORRECT BLOCK MOVE AC3,[IOWD 200,EMFBUF] ;SETUP DUMP COMMAND LIST MOVEM AC3,EMFLST IN EMF,EMFLST ;INPUT THE PROPER BLOCK OF THE FILE JRST EMFROK ;NORMAL RETURN ;HERE WHEN ANY ERROR IS ENCOUNTERED WHILE TRYING TO READ THE ERROR ; MESSAGE FILE EMFERR: MOVEI AC1,[SIXBIT/?CANNOT READ ERROR MESSAGE FILE#/] JRST EMFER2 ;GO PRINT THIS MESSAGE INSTEAD ;HERE WHEN BLOCK HAS BEEN READ OK EMFROK: MOVEI AC1,EMFBUF(AC2) ;COMPUTE ABS ADR OF MESSAGE MOVE AC2,EMFBUF ;FETCH FIRST WORD OF BLOCK CAMN AC2,VERCHK ;CHECK FOR CORRECT FILE VERSION JRST EMFRD2 ;OK MOVEI AC1,[SIXBIT/?IMPROPER VERSION ERROR MESSAGE FILE#/] EMFER2: RELEAS EMF, ;RELEASE ERROR MESSAGE CHANNEL TLZ FF,EMFOPN ;REMEMBER FILE NOT OPEN ANY MORE ;HERE WITH ADR OF MESSAGE TO PRINT IN AC1 EMFRD2: RESTOR ;RESTORE SAVED ACCUMULATORS NOTEMF: >; END CONDITIONAL ON FTEMF ;ADR OF STRING TO BE OUTPUT IS IN AC1 HRLI AC1,(POINT 6,0) ;SET UP SIXBIT BYTE POINTER PUSH P,AC1 ;SAVE POINTER ON STACK TTOS1: MOVE AC1,-1(P) ;RESTORE IN CASE DATA IN AC1 ILDB AC1,(P) ;GET A SIXBIT CHARACTER CAIN AC1,"#"-40 ;IF #, DO CRLF AND TERMINATE JRST TTOSX1 CAIN AC1,"!"-40 ;IF !, JUST QUIT PRINTING JRST TTOSX2 TTOI 40(AC1) ;NEITHER. OUTPUT ASCII EQUIVALENT JRST TTOS1 TTOSX1: TLNE FF,NOCRLF ;# ACTION SUPPRESSED? JRST TTOSX2 ;YES, DON'T DO CRLF TTOI CR ;OUTPUT CR/LF TTOI LF TTOSX2: JRST TTOAX ;RESTORE AC1 AND EXIT ;TTO - OUTPUT A SINGLE ASCII CHARACTER ADDRESSED BY THE UUO TTYO: SAVE ;SAVE AN ACCUMULATOR HRRZ AC1,@JOBUUO ;GET THE CHARACTER HLL AC1,JOBUUO ;PUT LH OF UUO IN LH OF AC1 JRST TTYO2 ;GO PROCESS ;TTOI - OUTPUT IMMEDIATE (I.E. ASCII CHAR IS EFFECTIVE ADDRESS OF UUO TTYOI: SAVE ;SAVE AN ACCUMULATOR MOVE AC1,JOBUUO ;RH_CHAR TO BE OUTPUT TTYO2: PUSHJ P,SUSCHK ;CHECK FOR OUTPUT SUPPRESSION JRST X1 ;YES, DON'T DO ANYTHING ANDI AC1,177 ;MASK JUST CHARACTER BITS SKIPE OFILE ;SPECIAL OUTPUT FILE? JRST FILOUT ;YES, GO DO IT IFE MITS,< TTCALL 1,AC1 ;NO, OUTPUT CHARACTER TO TTY > IFN MITS,< SKIPE TTYOFL ;NO, IS THE ^O FLAG SET? JRST X1 ;YES, DON'T OUTPUT CAIN AC1,TAB ;TAB? JRST OUTTAB ;YES, GO INDICATE WITH 8 SPACES .IOT .TTYO,T ;NO, OUTPUT CHAR TO TTY JRST X1 ;RESTORE AC1 AND RETURN OUTTAB: MOVEI T,8 ;INDICATE TAB WITH 8 SPACES .IOT .TTYO,[" "] SOJG T,.-1 > ;KEEP TRACK OF OUTPUT TYPEHEAD POSITION CAIN AC1,15 ;RETURN? HLLZS OUTPOS ;YES, RESET COUNTER CAIE AC1,11 ;TAB? JRST TTYO3 ;NO HRROI AC1,777770 ;YES, ADVANCE TO TAB STOP ORCAM AC1,OUTPOS ;(STRANGE MEANS TO FORCE AOS BELOW) TTYO3: TRNE T,140 ;OTHER CONTROL CHARACTER? AOS OUTPOS ;NO, COUNT CHARACTER NORMALLY JRST X1 ;RESTORE AC1 AND RETURN FROM UUO ;HERE TO OUTPUT CHARACTER TO A FILE FILOUT: SAVE ;SAVE AC'S CLOBBERED BY OUTBYT CALL OUTBYT ;OUTPUT CHAR TO FILE RESTOR ;RESTORE AC'S JRST X1 ;RESTORE AC1 AND RETURN SUBTTL FLOATING FIXUPS REPEAT 0,< ALL FLOATING OVERFLOWS, UNDERFLOWS, AND DIVIDE CHECKS ARE TRAPPED. THE RESULTS ARE FIXED UP AS FOLLOWS: 1) UNDERFLOW: THE ANSWER IS SET TO ZERO. 2) OVERFLOW OR DIVIDE CHECK: THE RESULT IS SET APPROPRIATELY TO PLUS OR MINUS INFINITY. FURTHER ACTION DEPENDS ON WHAT THE NEXT INSTRUCTION (AFTER THE ONE THAT CAUSED THE TRAP) IS: 1) JFCL WITH BIT 12 (FOV) A ZERO: NO ACTION. CONTROL RETURNS TO PROGRAM. 2) JFCL WITH BIT 12 A ONE (JFOV): SET FF FLAG FOV AND JUMP TO THE EFFECTIVE ADDRESS OF THE JFOV 3) ANYTHING ELSE: SET FF FLAG FOV AND RETURN TO THE NEXT INSTRUCTION. RESTRICTIONS::::: 1) OVERFLOWING INSTRUCTION MUST NOT BE IN ACCUMULATOR 0. IT MAY BE EXECUTED BY AN XCT. 2) NO ANSWER MAY BE IN ACCUMULATOR 0. THIS INCLUDES THE LOW ORDER PART OF A LONG MODE INSTRUCTION. 3) ACCUMULATOR 0 MAY NOT BE PART OF THE INDIRECT CHAIN FOR THE FLOATING POINT INSTRUCTION. 4) NO PART OF THE INDIRECT CHAIN FOR EITHER THE INSTRUCTION OR FOR AN XCT CALLING THE INSTRUCTION MAY BE CLOBBERED BY A RESULT. > ;OVERFLOW TRAP COMES HERE - FF ALREADY SAVED IN CRSHSV OVTRAP: MOVE FF,JOBTPC ;GET PC WORD SUBI FF,1 ;POINT TO OFFENDING INSTRUCTION OVTRP1: MOVE FF,@FF ;GET INSTRUCTION MOVEM FF,OVINST ;AND STORE IT TLC FF,() ;AN XCT? TLNN FF,777000 JRST OVTRP1 ;YES, FOLLOW XCT CHAIN DOWN HLRZ FF,JOBTPC ;GET FLAGS MOVEM FF,OVFIX ;SAVE FOR LATER CHECK TRZ FF,440040 ;CLEAR FOV,DCK TRZE FF,100 ;FXU? JRST UNTRAP ;YES, HANDLE UNDERFLOW TRAP HRLM FF,JOBTPC ;NO, OVERFLOW; STORE CLEARED FLAGS ;COME HERE TO FIX UP FLOATING OVERFLOW LDB FF,[POINT 4,OVINST,12] ;GET AND SAVE AC FIELD MOVEM FF,OVAC MOVE FF,OVINST ;GET THE F.P. INSTRUCTION TLC FF,042000 ;CHANGE MODE 2 TO 0 AND 140-177 TO 100-137 HRR FF,OVFIX ;GET TRAP FLAGS INTO RH TDNE FF,[XWD 643000,40] ;SKIP ON "TO MEMORY" AND NO DIVIDE CHECK JRST OVAC1 HRLOI FF,377777 ;GET PROPER SIGN FROM MEMORY SKIPGE @OVINST MOVN FF,FF JRST .+4 OVAC1: HRLOI FF,377777 ;GET PROPER SIGN FROM AC SKIPGE @OVAC MOVN FF,FF MOVEM FF,OVFIX ;SAVE PROPER OVERFLOW FIXUP LDB FF,[POINT 9,OVINST,8] ;GET INST CODE CAIN FF,(_-9) ;UFA? JRST OVUFA ;YES, SPECIAL HANDLING CAIN FF,(_-9) ;NO, FSC? MOVEI FF,(_-9) ;YES, PRETEND IT IS FAD ANDI FF,7 ;EXTRACT INSTRUCTION MODE ADDI FF,FIXTAB ;POINT TO INSTRUCTION TO FIX UP THIS MODE EXCH FF,OVFIX ;STORE POINTER AND GET FIXUP WORD XCT @OVFIX ;FIX THE ANSWERS JRST TRPX ;OVERFLOW FIXUP TABLE FIXTAB: MOVEM FF,@OVAC ;MODE 0 - AC JRST OVLNG ;MODE 1 - LONG MOVEM FF,@OVINST ;MODE 2 - MEMORY JRST OVBOTH ;MODE 3 - BOTH MOVEM FF,@OVAC ;MODE 4 - AC MOVEM FF,@OVAC ;MODE 5 - AC (IMMEDIATE ROUND) MOVEM FF,@OVINST ;MODE 6 - MEMORY JRST OVBOTH ;MODE 7 - BOTH OVBOTH: MOVEM FF,@OVAC ;BOTH MODE - FIX AC AND MEMORY MOVEM FF,@OVINST JRST TRPX OVLNG: MOVEM FF,OVINST ;LONG MODE, SAVE SIGN OF FIXUP HRLOI FF,344777 ;MAKE A POSITIVE LOW WORD MOVEM FF,OVFIX ;AND SAVE FOR LATER HRLOI FF,377777 ;MAKE A POSITIVE HIGH WORD SKIPGE OVINST ;SHOULD RESULT BE NEGATIVE? DFN FF,OVFIX ;YES, NEGATE DOUBLE LENGTH FIXUP MOVEM FF,@OVAC ;STORE HIGH ORDER OVUFA: MOVE FF,OVFIX ;GET LOW ORDER AOS OVAC ;PREPARE TO STORE LOW ORDER MOVEM FF,@OVAC JRST TRPX ;FLOATING UNDERFLOW FIXUP; SET RESULT TO ZERO UNTRAP: HRLM FF,JOBTPC ;STORE CLEARED FLAGS FOR RETURN MOVE FF,OVINST ;GET OFFENDING INSTRUCTION TLNN FF,006000 ;LONG MODE? (1) TLNN FF,001000 JRST TRPNL ;NO LSH FF,^D23 ;YES, RIGHT-JUSTIFY AC FIELD ADDI FF,1 ;SET UP FOR SETZB AC,AC+1 HLL FF,OVINST ;RESTORE LH AND FF,[XWD 777740,17] ;MASK ONLY INST,AC,AND AC+1 IN RH TLO FF,003000 ;SETZB=MODE 3 TRPNL: TLC FF,130000 ;IS IT FSC? TLZN FF,774000 TLZ FF,003000 ;YES, CONVERT TO AC MODE TLO FF,() ;MAKE SETZ SAME MODE XCT FF ;CLEAR PROPER ANSWERS ;NOW CHECK THE FOLLOWING INSTRUCTION AND TAKE APPROPRIATE ACTION TRPX: MOVE FF,@JOBTPC ;GET AND SAVE IT TLC FF,() ;IS IT JFCL? TLZE FF,777000 JRST TRPX1 ;NO, SET FF FOV UNCONDITIONALLY TLNN FF,000040 ;YES, IS FOV BIT SET (JFOV) ? JRST TRPX2 ;NO, JFCL ALONE = NO ACTION TAKEN MOVEI FF,@FF ;YES, USE EFFECTIVE ADDR. OF JFOV HRRM FF,JOBTPC TRPX1: MOVEI FF,FOV ;SET FLOATING OVERFLOW FLAG IORM FF,CRSHSV ; IN SAVED FLAG REGISTER TRPX2: IFE FTBAKG,< MOVE FF,CRSHSV ;RESTORE FF JRSTF @JOBTPC ;RETURN TO USER > IFN FTBAKG,< MOVE FF,JOBTPC ;PICK UP RETURN PC WORD HRRI FF,.+2 ;RESTORE FLAGS HERE JRSTF @FF PUSH P,JOBTPC ;STACK RETURN PC WORD PUSH P,CRSHSV ;STACK FLAGS TO BE RESTORED MOVE FF,ENBWRD ;PICK UP APRENB BITS APRENB FF, ;ENABLE POP P,FF ;RESTORE FLAG REGISTER POPJ P, ;RETURN TU INTERRUPTED PROGRAM > SUBTTL UTILITY ROUTINES ;OCTPRT, DECPRT ;ROUTINES TO CONVERT A NUMBER TO A DIGIT STRING. ;OCTPRT FOR OCTAL, DECPRT FOR DECIMAL. RH OF NUMBER IS CONVERTED TO ;A RIGHT-JUSTIFIED SIXBIT STRING AND RETURNED IN R. LEADING ZEROES ;ARE CONVERTED TO SPACES N== AC1 ;ARG - NUMBER TO BE PRINTED T1== AC2 ;TEMP T2== AC3 OCTPRT::MOVEI R2,^D8 ;OCTAL ENTRY JRST .+2 DECPRT: MOVEI R2,^D10 ;DECIMAL ENTRY PUSH P,T1 PUSH P,T2 HRRZ T1,N ;GET RH OF NUMBER SETZM R IDIV T1,R2 ;PEEL OFF LSD ADDI R,20(T2) ;PLACE SIXBIT DIGIT RIGHT-JUSTIFIED IN R ROT R,-^D6 ;ROTATE RIGHT 6 FOR NEXT JUMPN T1,.-3 ;CONTINUE IF ANY DIGITS REMAIN TRNE R,77 ;DONE, NOW RIGHT-JUSTIFY RESULT JRST .+3 LSH R,-^D6 JRST .-3 POP P,T2 POP P,T1 POPJ P, ;SAVALL ;SAVE AC'S 1 THROUGH 14 ON THE STACK SAVALL: EXCH AC1,(P) ;SAVE AC1 AND GET RETURN ADDR. MOVEM AC1,TSAV ;STORE RETURN MOVEI AC1,1(P) ;MAKE BLT POINTER TO SAVE 2-14 HRLI AC1,2 ADD P,[XWD 13,13] ;POINT P TO NEW TOP BLT AC1,(P) ;SAVE 2-14 MOVE AC1,-13(P) ;RESTORE AC1 JUMPL P,@TSAV ;EXIT SAVALL ERROR MSG(PDLSV) ;PDL OV - SAVALL ;RSTALL ;JRST HERE TO RESTORE AC'S 1-14 AND RETURN RSTALL: MOVSI 14,-13(P) ;GET WHERE AC1 IS SAVED HRRI 14,1 ;MAKE BLT POINTER BLT 14,14 ;MOVE CONTENTS OF STACK TO AC'S SUB P,[XWD 14,14] ;MOVE P BACK TO SAVED PC RETURN ;USE PC TO RETURN IFN FTSTAT,< ;CODE FOR WRITING STATISTICAL REPORTING FILE ;SYSTEM FUNCTION STAT(A) ; IF A # 0, OPENS FILE PPLSTM.BIN FOR STATISTICAL REPORTING. ; IF A = 0, CLOSES FILE SSTAT: EXP 1 ;TAKES ONE ARG CALL GRAB1 ;FETCH A SINGLE ATOMIC ARG JUMPE R,STOFF ;TURN OFF STATISTICS IF ZERO ;TURN ON REPORTING BY OPENING BINARY FILE PPLSTM.BIN SKIPE STFLG ;ERROR IF FILE ALREADY OPEN SFNERR MSG(ALROP) ;FILE ALREADY OPEN INIT STCH,14 ;OK, OPEN CHANNEL IN BINARY MODE SIXBIT/DSK/ STHDR,,0 ;OUTPUT ONLY SFNERR MSG(OPFAI) ;OPEN FAILURE MOVEI R,STBUF ;LD ADDR OF I/O BUFFER MOVEM R,JOBFF ;STORE FOR MONITOR OUTBUF STCH,2 ;ALLOCATE 2 OUTPUT BUFFERS MOVE AC1,[SIXBIT/PPLSTM/] ;SETUP FILENAME MOVSI AC2,(SIXBIT/BIN/) SETZB AC3,AC4 ENTER STCH,AC1 ;OPEN THE FILE FOR OUTPUT SFNERR MSG(ENFAI) ;ENTER FAILURE FILE PPLSTM.BIN SETOM STFLG ;OK, SIGNAL FILE OPEN MOVEI R,(POINT 18,) ;SET BYTE SIZE TO 18 BITS HRLM R,STHDR+1 ;MONITOR EXPECTED TO COMPUTE PROPER BYTE ; COUNT BASED ON BYTE SIZE FIELD IN ; BYTE PTR (AT LEASE, IT DOES IN 4S72) MOVE R,DZEND ;COMPUTE SIZE OF DZ SUB R,DZBEG STAT .DZS,1(R) ;OUTPUT SIZE OF DZ CALL GARCOL ;GARBAGE COLLECT SO AS TO OUTPUT INITIAL STATE JRST RETNUL ;RETURN NULL AS VALUE OF CALL TO STAT ;TURN OFF REPORTING BY CLOSING OUTPUT CHANNEL STOFF: SKIPN STFLG ;IS CHANNEL OPEN? SFNERR MSG(NOTOP) ;FILE NOT OPEN CLOSE STCH, ;CLOSE THE FILE STATZ STCH,740000 ;CHECK FOR ERRORS SFNERR MSG(STERR) ;STATISTICS OUTPUT ERROR RELEAS STCH, ;OK, RELEASE CHANNEL SETZM STFLG ;SIGNAL FILE CLOSED JRST RETNUL ;RETURN NULL AS VALUE OF CALL TO STAT ;STILL IN FTSTAT CONDITIONAL ;STAT UUO HANDLER. ; STAT CODE,ARG ; OUTPUTS AN 18-BIT DATUM ENCODED AS FOLLOWS: ; FIRST 3 BITS: CODE ; LAST 15 BITS: ARG XSTAT: SKIPN STFLG ;ENABLED FOR STATISTICS? RETURN ;NO, UUO IS A NO-OP SAVE ;YES, SAVE 2 REGS HLRZ R,JOBUUO ;GET LH OF UUO LSH R,^D10 ;SHIFT AC FIELD TO B20 ANDI R,700000 ;EXTRACT LOW 3 BITS OF AC FIELD FOR CODE HRRZ R2,JOBUUO ;FETCH ARG JUMPE R,.+2 ;ZERO AC FIELD (IF SO, DATA IS 18 BITS) ANDI R2,77777 ;NO, TAKE ONLY LOW 15 BITS IORI R,(R2) ;COMBINE CODE AND ARG XSTAT1: SOSL STHDR+2 ;SPACE IN OUTPUT BUFFER? JRST XSTAT2 ;YES OUT STCH, ;NO, OUTPUT BUFFERFUL JRST XSTAT1 ;OK RETURN, TRY AGAIN EXERR MSG(STERR) ;STATISTICS OUTPUT ERROR XSTAT2: IDPB R,STHDR+1 ;STORE 18-BIT BYTE RESTOR ;RESTORE SAVED AC'S RETURN ;EXIT UUO LEVEL >;END CONDITIONAL ON FTSTAT ;ROUTINE TO SAVE AC1 THROUGH AC4, WITH THE RETURN MADE AT A LEVEL ; DEEPER THAN THE CALL SO THAT THE AC'S ARE RESTORED WHEN THE CALLER ; RETURNS (IT MAY DO A SKIP OR NON-SKIP RETURN) SAVE4: EXCH AC1,(P) ;SAVE AC1, FETCH CALLER PC HRLI AC1,(P) ;REMEMBER ADR OF SAVED AC1 PUSH P,AC2 ;SAVE OTHER AC'S PUSH P,AC3 PUSH P,AC4 PUSH P,CPOPJ ;PUT RETURN TO SV4RET ON TOP OF STACK JRA AC1,(AC1) ;RESTORE AC1 AND JUMP TO CALLER+1 SV4RET: JRST X4321 ;NON-SKIP RETURN, RESTORE AC'S AND RETURN AOS -4(P) ;SKIP RETURN, FIX SO WE SKIP ALSO ;COMMON SUBROUTINE RETURNS X4321: POP P,AC4 ;RESTORE AC4,3,2,1 AND RETURN X321: POP P,AC3 ;RESTORE AC3,2,1 AND RETURN X21: POP P,AC2 ;RESTORE AC2,1 AND RETURN X1: POP P,AC1 ;RESTORE AC1 AND RETURN CPOPJ: POPJ P,SV4RET ;RETURN REPEAT 0,< ;------NOT USED NOW S4321: POP P,AC4 ;RESTORE AC4,3,2,1 AND SKIP RETURN S321: POP P,AC3 ;RESTORE AC3,2,1 AND SKIP RETURN S21: POP P,AC2 ;RESTORE AC2,1 AND SKIP RETURN > ;------ S1: POP P,AC1 ;RESTORE AC1 AND SKIP RETURN CPOPJ1: AOSA (P) ;SKIP RETURN BPOPJ: HRRZ B,(CAR) ;RESTORE B AS BASE ADR OF CAR AND RETURN POPJ P, ;ENUIDT ;ROUTINE TO ENUMERATE EVERY ENTRY IN THE IDT, CALLING, FOR EACH ONE, ;THE ROUTINE WHOSE ADDRESS IS THE ARG (IN AC1). EACH TIME THE ;CALLEE ROUTINE IS EXECUTED IT HAS THE FOLLOWING INFORMATION AVAILABLE ; AC1: INTERNAL NAME (REL. ADDR.) OF STE ; AC2: ABSOLUTE ADDRESS OF STE ENUIDT: SAVE HRRZ AC2,@IDTP ;POINT TO DZ ADDR OF IDT HLRZ AC3,(AC2) ;GET WLENGTH ADDI AC2,1 ;POINT ABSOLUTELY TO FIRST STE MOVEI AC1,1 ;POINT RELATIVELY TO SAME ENUID1: CALL @-2(P) ;CALL THE SPECIFIED ROUTINE LDB R,[POINT 6,1(AC2),5] ;GET INCREMENT TO NEXT STE ADD AC1,R ;UPDATE POINTERS HRRZ AC2,@IDTP ;RECOMPUTE ABS ADDRESS SINCE GC ADDI AC2,(AC1) ; MAY OCCUR IN ENUMERATORS CAMGE AC1,AC3 ;CHECK FOR END OF IDT JUMPN R,ENUID1 JRST X321 ;RESTORE AC'S 3,2,1 AND RETURN ;ROUTINE TO MAKE AN ATOM ;CALL WITH THE VALUE IN (AC1,AC2) AND THE USERTYPE IN AC3. ;RETURNS IN R A PZ POINTER TO THE BLOCK. SHARED REFERENCES MAY ;BE MADE HERE FOR COMMONLY-USED ATOMIC VALUES ATOM: SAVE LSH AC3,-1 ;HALVE TYPE INDEX TO COMPACT TYPE SPACE JRST .+1(AC3) ;DISPATCH ON USERTYPE JRST MINT ;INT JRST MREAL ;REAL JRST MDBL ;DBL JRST MBOOL ;BOOL JRST MBLK2 ;CHAR MOVEI R,NULL ;NONE - RETURN PTR TO NULL JRST ATOMX ;HERE TO MAKE A BLOCK OF LENGTH 2 AND STUFF THE VALUE MBLK2: SKIPA AC1,TWO ;SET UP BLOCK LENGTH OF 2 ;HERE FOR A DBL MDBL: MOVEI AC1,3 ;SET UP BLOCK LENGTH OF 3 CALL ALLOC ;CONSTRUCT BLOCK. R_PZADR, R2_DZADR RESTORE ;RESTORE SAVED AC'S HRLM AC3,(R) ;STORE BLOCK TYPE MOVEM AC1,1(R2) ;STORE HIGH WORD CAIN AC3,U.DBL ;IF DOUBLE, MOVEM AC2,2(R2) ; THEN STORE LOW WORD RETURN ;HERE FOR AN INT MINT: CAML AC1,MINUS2 ;IF VALUE >5 OR <-2, CAILE AC1,5 JRST MBLK2 ; THEN CONSTRUCT SEPARATE BLOCK MOVEI R,INTTAB(AC1) ;OTHERWISE, USE BUILT-IN VALUE JRST ATOMX ;HERE FOR A REAL MREAL: MOVEI R,FLTZER ;SET UP ADDRESS OF BUILT IN FLOATING ZERO JUMPE AC1,ATOMX ;JUMP IF ZERO CAME AC1,FONE ;NO, IS IT 1.0? JRST MBLK2 ;NO, CONSTRUCT SEPARATE BLOCK MOVEI R,FLTONE ;YES, SET UP ADR OF FLOATING ONE JRST ATOMX ;HERE FOR A BOOL MBOOL: MOVEI R,FALSE(AC1) ;MAKE POINTER TO BUILT-IN FALSE OR TRUE ATOMX: RESTORE AC3 JRST X1 ;FREQUENTLY-USED ATOMIC DATA ;********* DON'T SEPARATE OR CHANGE ORDER *********** FALSE: XWD U.BOOL,CNS0 ;VALUE FALSE TRUE: XWD U.BOOL,CNS1 ;VALUE TRUE XWD U.INT,CNSM2 ;INTEGER -2 XWD U.INT,CNSM1 ;INTEGER -1 INTTAB: XWD U.INT,CNS0 ;INTEGER 0 XWD U.INT,CNS1 ;INTEGER 1 XWD U.INT,CNS2 ;INTEGER 2 XWD U.INT,CNS3 ;INTEGER 3 XWD U.INT,CNS4 ;INTEGER 4 XWD U.INT,CNS5 ;INTEGER 5 FLTZER: XWD U.REAL,CNS0 ;REAL 0 FLTONE: XWD U.REAL,FLT1 ;REAL 1 NULL: XWD U.NONE,NULLV ;NULL VALUE (TYPE NONE) DEFUP: XWD U.INT,DEFUPV DEFBP: XWD U.INT,DEFBPV DEFUPV: XWD 2,0 DEC 100 DEFBPV: XWD 2,0 DEC 25 ;********* END OF DON'T SEPARATE ********** ;CONSTANTS AND ATOMIC DATA BLOCKS. WARNING: BACK-POINTERS ARE BLANK. ;THUS, CODE SHOULD BE CAREFUL NEVER TO FOLLOW BACK POINTERS OF ATOMS. CNSM2: XWD 2,0 ;CONSTANT -2 MINUS2: EXP -2 CNSM1: XWD 2,0 ;CONSTANT -1 MINUS1: EXP -1 CNS0: XWD 2,0 ;CONSTANT 0 ZERO: EXP 0 CNS1: XWD 2,0 ;CONSTANT 1 ONE: EXP 1 CNS2: XWD 2,0 ;CONSTANT 2 TWO: EXP 2 CNS3: XWD 2,0 ;CONSTANT 3 THREE: EXP 3 CNS4: XWD 2,0 ;CONSTANT 4 FOUR: EXP 4 CNS5: XWD 2,0 ;CONSTANT 5 FIVE: EXP 5 FLT1: XWD 2,0 ;FLOATING 1.0 FONE: EXP 1.0 NULLV: XWD 1,0 ;NULL VALUE LIT IFE FTEMF,< END PPL > IFN FTEMF,< END ;START IS IN MESSAG.MAC (INITIALIZATION) >