perm filename NWORLD[10X,AIL]1 blob
sn#093273 filedate 1974-03-26 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00033 PAGES VERSION 17-1(13)
RECORD PAGE DESCRIPTION
00001 00001
00004 00002 HISTORY
00009 00003 MANY DECLARATIONS
00015 00004 PROCESS VARIABLE NUMBERS
00018 00005 event variables
00019 00006 procedure descriptors & null process skeleton
00021 00007 DSCR SPROUT -- THE PROCESS SPROUTER
00028 00008
00035 00009
00036 00010 routines for inserting & deleting set elements
00040 00011 USER REQUESTED SCHEDULING
00045 00012 HERE(RESUME)
00049 00013 SUSPEND and TERMINATE runtime routines
00052 00014 The JOIN runtime routine
00054 00015 THE MAIN PROCESS INITIALIZER
00056 00016 CALLER , MYPROC, AND PSTATUS
00058 00017 PRISET -- ROUTINE USER CALLS TO CHANGE PRIORITY
00059 00018 SPECIAL GC ROUTINE FOR PROCESSES
00060 00019 INTERRUPT ROUTINES
00064 00020 THE INTERRUPT PROCESS
00068 00021
00069 00022 CAUSE
00071 00023 CAUSE1 -- ROUTINE TO DO ACTUAL WORK
00074 00024 ANSWER -- subroutine used by CAUSE
00076 00025 DELWRQ -- delete all wait requests
00078 00026 INTERROGATE
00080 00027 ASK -- used by INTERROGATE
00083 00028 MKEVTT,SETCP,& SETIP
00084 00029 SPARE HERE TABLE ENTRIES
00085 00030 COMPIL(IRP,,,,,,DUMMYFORGDSCISS)
00087 00031 HERE(INTTBL)
00090 00032 PROCEDURES TO ENABLE FOR INTERRUPTS
00101 00033
00102 ENDMK
⊗;
COMMENT ⊗HISTORY
AUTHOR,REASON
021 102100000015 ⊗;
COMMENT ⊗
VERSION 17-1(13) 3-26-74 BY RLS INSTALL TENEX
VERSION 17-1(12) 12-8-73 BY JRL REMOVE SPECIAL STANFORD CHARACTERS(WHERE POSSIBLE)
VERSION 17-1(11) 12-8-73 BY RHT FIX IEXT5 SCREW FOR EXPO WORLD
VERSION 17-1(10) 12-8-73 BY RHT CHANGE PLACE WHERE REMEMBER THE APRENB BITS
VERSION 17-1(9) 12-4-73 BY rht fix process string garb coll routine
VERSION 17-1(8) 12-3-73 BY RHT MAKE SUSPEND(OTHERGUY) RETURN ANY
VERSION 17-1(7) 12-2-73 BY RHT ADD A FEW IRP SPARES
VERSION 17-1(6) 10-30-73 BY RHT BUG #OU# A TYPO IN %AA%
VERSION 17-1(5) 10-30-73 BY RHT BUG #OT# SPROUT APPLY BUG
VERSION 17-1(4) 10-28-73 BY RHT FEAT %AG% INITIALIZE RSMR←DADDY WHEN SPROUT
VERSION 17-1(27) 10-14-73 BY RHT BUG #OO# SPROUT APPLY TROUBLES
VERSION 17-1(26) 9-1-73 BY RHT FEATURE %AA% -- ADD CODE FOR SPROUT DEFAULTS
VERSION 17-1(25) 8-19-73 BY RHT FIX COMPIL FOR SAIIRP TO KNOW ABOUT APRACS
VERSION 17-1(24) 7-26-73 BY RHT **** VERSION 17 ****
VERSION 16-2(23) 7-15-73 BY RHT BUG #NC# ASKNTC WAS WRONG
VERSION 16-2(22) 7-15-73 BY RHT MORE OF BUG NB
VERSION 16-2(21) 7-15-73 BY RHT BUG #NB# NOT GETTING CONTXT RIGHT FOR USER IP
VERSION 16-2(20) 7-14-73 BY RHT MAKE SAIIRP A SEP COMPIL & PROVIDE FOR APPL$Y
VERSION 16-2(19) 7-14-73 BY RHT BUG #NA# RACE CONDITION IN URSCHD IWAIT
VERSION 16-2(18) 3-18-73 BY RHT MINOR MOD TO DFR1IN
VERSION 16-2(17) 2-4-73 BY RHT PROVIDE MORE HOOKS INTO EVENT ROUTINES
VERSION 16-2(16) 1-15-73 BY DCS BUG #LB# MINOR RESUME BUG
VERSION 16-2(15) 12-9-72 BY RHT MAKE MINOR ADJUSTMENTS TO RESUME
VERSION 16-2(14) 12-4-72 BY RHT INTERNAL PSTATUS
VERSION 16-2(13) 12-4-72 BY RHT CURE POTENTIAL LOSSAGE OF STATIC LINKAGE
VERSION 16-2(12) 12-2-72 BY RHT REWRITE RESUME
VERSION 16-2(11) 12-1-72 BY RHT PROVIDE FOR DEFAULTS AS CORE VARS
VERSION 16-2(10) 11-30-72 BY RHT ADD THE DDFINT ROUTINE & ZAP POLL
VERSION 16-2(9) 11-29-72 BY DCS ADD INTERRUPT THINGS TO ENTRIES IN COMPIL
VERSION 16-2(8) 11-29-72 BY RHT RESUME DISPATCH NEEDS @
VERSION 16-2(7) 11-26-72 BY DCS ALLOW <ESC>I AS IO INTERRUPT (AVOID "NO ONE TO RUN")
VERSION 16-2(6) 11-26-72 BY DCS CHANGE OPDEF FOR INTENS TO 400030 FROM ..31
VERSION 16-2(5) 11-25-72 BY RHT FIX DATAB & INFTAB REFERENCES
VERSION 16-2(4) 11-15-72 BY RHT ADD OPTIONS FOR RESUME
VERSION 16-2(3) 11-15-72 BY RHT ADD INTERRUPTS,SPARE HERE ENTRIES
VERSION 16-2(2) 11-15-72
VERSION 16-2(1) 11-15-72
⊗;
; MANY DECLARATIONS
TENX<
↓APRISW←←1 ;Not always what's wanted but better than 0.
>;TENX
COMPIL(PRC,,,,,,DUMMYFORGDSCISS)
DEFINE ENS1 < SPROUT,URSCHD,RESUME,SUSPEND,TERMINATE,JOIN,MAINPR,CALLER>
DEFINE ENS2 <%PSSGC,DDFINT,INTSET,CAUSE,ANSWER,INTERROGATE,SETCP>
DEFINE ENS3 <MKEVTT,SETIP,MYPROC,CLKMOD,DFR1IN,DFRINT,INTPRO>
DEFINE ENS4 <DFCPKT,PSTATUS,ASKNTC,CAUSE1,PRISET>
DEFINE EXT1 <LEAP,STKUWD,X44,GOGTAB,%ARSR1,SGINS,ALLPDP>
DEFINE EXT2 <CORGET,CORREL,INTRPT,INFTB,%SPGC,X22,%SPGC1,FP1DON,STACSV>
DEFINE EXT3 <X33,%ARRSR,DATM,SGLKBK,FP2DON,SGREM,STACRS,RUNNER,NOPOLL>
DEFINE EXT4 <X11,DEFSSS,DEFPSS,DEFPRI,DEFQNT,INTTBL,APPL$Y>
IFN APRISW <
DEFINE XJBCNI <JOBCNI>
DEFINE XJBTPC <JOBTPC>
DEFINE XJBAPR <JOBAPR>
DEFINE EXT5 <JOBCNI,JOBTPC,JOBAPR>
IFN ALWAYS <
EXTERN EXT5 ;THESE ARE ALWAYS EXTERNAL
>;IFN ALWAYS
>;IFN APRISW
IFE APRISW <
DEFINE EXT5 <XJBCNI,XJBTPC,XJBAPR,JOBINT>
IFN ALWAYS <
EXTERNAL JOBINT ;THIS FELLOW IS ALWAYS EXTERNAL
>;IFN ALWAYS
>;IFE APRISW
COMMENT ⊗THIS IS FOR THE STUPIDITY OF SCISS ⊗
COMPXX(PRC,<ENS1,ENS2,ENS3,ENS4>,<EXT1,EXT2,EXT3,EXT4,EXT5>
,<MULTIPLE PROCESS STUFF>,<SPRPDA>,HIIFPOSSIB)
BEGIN PROCSS
; (AC DEFNS)
; A,B,C,P,SP,RF AS BEFORE
KL ←D ;KILL LIST & SCRATCH
PB ←5 ;PROCESS BASE
OPTS ←6 ;HOLDS OPTIONS
PDA ←7 ;HOLDS PDA
EVT ←10 ;EVENT DATUM
NSP ←←10 ;NEW SP
NP ←11 ;NEW P
TMP ←LPSA ;TEMP AC
GLOB <
TABL ←← 7 ;NEEDED BY LIST CELL GETTER
>;GLOB
NOGLOB <
TABL ←← USER ;NEEDED BY LIST CELL GETTER
>;NOGLOB
FP ←← 6 ;NEEDED BY LIST CELL GETTER
; (LOCAL VARIABLES FOR SCHEDULER)
MAXPRI ←← 0 ;MAXIMUM PRIORITY
MINPRI ←← NPRIS-1
;REASONS FOR SUSPENSION
PSPF←←0 ;ONLY P, SP, F NEED BE RESTORED
SPNDR←←1 ;SUSPENDED (FROM READY) BY SUSPEND
JOINR←←2 ;SUSPENDED BECAUSE OF A JOIN
WAITNG←←3 ;WAITING ON AN EVENT OR SO
; ( CONSTANT DATA USED BY SPROUTER)
; FIELD DEFNS FOR OPTIONS WORD (SEE ALSO POINT S BELOW)
STSMSK← 77 ⊗ =8 ;MASK FOR P STACK SIZE FIELD
SSSMSK← 17 ⊗ =14;MASK FOR SP STACK SIZE FIELD OF OPTIONS WORD
PRIMSK← 17 ⊗ 4 ;MASK FOR PRIORITY FIELD
QNTMSK←← 17 ;MASK FOR QUANTUM
RUNME←← 1 ;RUN THE SPROUTING PROCESS
SPNDME←←2 ;SUSPEND THE SPROUTING PROCESS
SPNDNP←←10 ;SUSPEND THE NEW PROCESS
;MORE FIELD DEFS & BIT VALUES
TERM ←← 1 ;BIT (LH) IN DATUM OF TERMINATED PROCESS ITEM
;DEFAULT VALUES --INITIALLY SET BY MAINPR
STPSZ← 40 ;DEFAULT P- STACK SIZE (MINUS THE PROCESS TABLE AREA)
STSPST ←20 ;DEFAULT SP STACK SIZE
STDQNT ←← 4 ;DEFAULT STD QUANTUM IS 4
STDPRI ←←7 ;DEFAULT PRIORITY
;OPTIONS FOR RESUME
MSTMSK←←14 ;MASK FOR MY NEW STATUS FIELD
NOTNOW←←1 ;SET IF RESUMED PROCESS IS MERELY TO GO READY
;CONSTANTS USED BY RESUME
MSTBYT: POINT 2,OPTS,33 ;MY NEW STATUS
; (CONSTANTS USED BY SPROUTER)
SSSBYT: POINT 4,OPTS,21 ;STRING STACK FIELD (MOD 32)
STSBYT: POINT 6,OPTS,27 ;P - STACK FIELD (MOD 32)
PRIBYT: POINT 4,OPTS,31 ;PRIORITY FIELD
QNTBYT: POINT 4,OPTS,17 ;LOG2 (QUANTUM)
; MACROS USED TO GET LIST CELLS
DEFINE NCELL(AC) <
MOVE FP,FP1(TABL) ;USE WHERE SURE THE LIST SPACE IS INITIALIZED
HRRI AC,(FP)
SKIPN FP,(FP)
PUSHJ P,FP1DON
HRRM FP,FP1(TABL)
>
DEFINE NNCELL(AC) <
SKIPN FP,FP1(TABL) ;USE WHERE LIST SPACE MAY NEED INITIALIZATION
PUSHJ P,FP1DON
HRRI AC,(FP)
SKIPN FP,(FP)
PUSHJ P,FP1DON
HRRM FP,FP1(TABL)
>
DEFINE NNCLL2(AC) <
SKIPN FP,FP2(TABL) ;USE WHERE LIST SPACE MAY NEED INITIALIZATION
PUSHJ P,FP2DON
HRRI AC,(FP)
SKIPN FP,(FP)
PUSHJ P,FP2DON
HRRM FP,FP2(TABL)
>
NOTENX <
OPDEF INTENS [CALLI 400030]
OPDEF IWAIT [CALLI 400040]
>;NOTENX
;PROCESS VARIABLE NUMBERS
DEFINE PVAR (V,ATTRIB),
<↑V ←← NPVARS
NPVARS←← NPVARS+1
IFE ALWAYS,<
IFDIF <ATTRIB>,<> < ATTRIB V >
>;IFE ALWAYS
>
NPVARS←← 0
PVAR DYNL ;DYNAMIC LINK
PVAR STATL ;STATIC LINK
PVAR ISP ;REST OF MSCP
PVAR AC0 ;AC SAVE AREA
PVAR AC1
PVAR AC2
PVAR AC3
PVAR AC4
PVAR AC5
PVAR AC6
PVAR AC7
PVAR AC10
PVAR AC11
PVAR AC12
PVAR AC13
PVAR AC14
PVAR AC15
PVAR AC16
PVAR AC17
↑ACF ←← AC12
↑ACP ←← AC17
↑ACSP ←← AC16
PVAR PCW ;PC WORD
PVAR QUANTM ;TIME QUANTUM
PVAR PRIOR ;PRIORITY
PVAR PRCITM ;PROCESS ITEM OF THIS PROCESS
PVAR KLOWNR ;THE OWNER OF MY KILL LIST
PVAR STATUS ;-1 = RUNNING, 0 = SUSPEND, 1 = READY, 2 = TERMINATED
PVAR DADDY,INTERNAL ;PROCESS ITEM OF SPROUTING PROCESS
PVAR CAUSRA ;RETN ADDRESS FROM CAUSE
;THE FOLLOWING ARE ZEROED OUT ON CREATION
ZFIRST←←NPVARS
PVAR CURSCB,INTERNAL ;CURRENT SEARCH CONTROL BLOCK
PVAR REASON ;HOW GOT UNSCHEDULED (0 MEANS ONLY NEED ACS F,SP,P)
PVAR PLISTE ;PRIORITY LIST ENTRY
PVAR RSMR ;THE GUY WHO RESUMED ME (%AG% ** INIT TO DADDY ** )
PVAR JOINCT ;HOW MANY PROCESSES NEED TO JOIN THIS ONE
PVAR JOINS ;WHO IS WAITING TO FOR ME TO JOIN (A SET OF ITEMS)
PVAR WAITES ;LIST OF ALL EVENT TYPES ON WHICH I AM WAITING
PVAR INTRGC ;THE CONTROL WORD FOR MY CURENT INTERROGATION
PVAR CAUSES ;COUNT OF CAUSES PENDING
PVAR CAUSEQ ;QUEUE OF CAUSES TO BE MADE
ZLAST←←NPVARS-1
↑NPVARS ← NPVARS
↑STKBAS ← NPVARS ;STACK BASE SIZE (= #PROCESS VARS FOR NOW)
COMMENT ⊗event variables⊗
NEVARS←←0
DEFINE EVAR(V) ,
<↑↑V←←NEVARS
NEVARS←←NEVARS+1
>
EVAR NOTCLS ;LIST OF CURRENT NOTICES
EVAR WAITLS ;LIST OF CURRENTLY WAITING PROCESSES
EVAR CAUSEP ;USER SPEC CAUSE PROC
EVAR INTRGP ;USER SPEC INTERROGATE PROC
EVAR USER1 ;AVAIL TO USER
EVAR USER2 ;AVAIL TO USERR
;OPTIONS BITS FOR CAUSE
DNTSAV ←← 1
TELLAL ←← 2
SCHDIT ←← 4
;OPTIONS BITS FOR INTERROGATE
RETAIN ←← 1
WAIT ←← 2
SAYWCH ←← 10
MULTIN ←← 200000
NOJOY ←← 400000
COMMENT ⊗procedure descriptors & null process skeleton⊗
FLXXX←←0
UP <
FLXXX←←%FIRLOC-400000
>;UP
DEFINE PUTINLOC(LCN,V),<
UP <
SVPCXX ←← .
DEPHASE
>;UP
RELOC LCN+FLXXX
V
RELOC
UP <
PHASE SVPCXX
>;UP
>
;MAKE A PD FOR THE SPROUTER
↑SPRPDA:BLOCK PD.XXX+1
DEFINE FPDE(IX,V),<PUTINLOC (SPRPDA+IX,V)>
FPDE (PD.,SPROUT)
FPDE (PD.DSW,STKBAS)
FPDE (PD.PDA,<<XWD SPRPDA,0>>)
FPDE (PD.LLW,<SPRPDA+PD.XXX>)
FPDE (PD.DLW,<SPRPDA+PD.XXX>)
IFN 0,<
;NULL PROCESS
NULPDA: NULPRO ;PD OF NUL PROC
↑NULPRC: %NULPR ;NULL PROCESS
%NULPR: BLOCK STKBAS+=32 ;NULL PROCESS AREA
DEFINE NPE (IX,V), <PUTINLOC (%NULPR+IX,V)>
NPE (STATL,<<XWD SPRPDA,0>>)
NPE (ACF,STKBAS+%NULPR+1)
NPE (ACP,<<TPDL: XWD - =29,%NULPR+STKBAS+3>>)
NPE (STKBAS+1,%NULPR+DYNL)
NPE (STKBAS+2,<<XWD NULPDA,0>>)
↑NULPRO:
ERR <I SHOULD NEVER RUN>
>;IFN 0
DSCR SPROUT -- THE PROCESS SPROUTER
CAL PUSHJ
PARM -1(P) ;KILL LIST
-2(P) ;OPTIONS WORD
-3(P) ;PDA OF SPROUTED PROCESS
-4(P) ; PROCEDURE PARAMS
:
-?(P) ;LAST OF PROCEDURRE PARAMS
-?-1(P) ;PROCESS ITEM
DES
This procedure acts as the "process" procedure.
Roughly, it does the following:
1. Saves the return address in PCW(RUNNER)
2. gets stack space
3. puts self on appropriate kill list & priority list
4. copies over the procedure parameters.
5. sets status of new & SPROUTing process
&(eventually) calls the appropriate procedure.
6. when the procedure returns, SPROUT then kills the process.
⊗
HERE (SPROUT)
MOVE USER,RUNNER ;
POP P,PCW(USER) ;RETN ADDRESS
POP P,KL ;PICK UP KILLL LIST
POP P,OPTS ;OPTIONS
POP P,PDA ;FIND OUT WHO
;;%AA% -- 1 OF 1 DEFAULTS, ALSO THE POP P,PDA USED TO BE LATER
CAIN PDA,APPL$Y ;SPROUT APPLY IS A ROYAL PAIN
;;#OU# A TYPO RHT
SKIPA TMP,-1(P) ;REAL PDA FOR SPROUT APPLY
MOVE TMP,PDA ;
HRRZ A,PD.PDB(TMP) ;THE DEFAULTS
JUMPE A,SALCS ;NO DEFAULTS -- SPROUT ALLOCATIONS NOW
LSH A,4 ;INTO POSITION
TRNE OPTS,STSMSK ;P STACK
TRZ A,STSMSK
TRNE OPTS,SSSMSK ;SP STACK
TRZ A,SSSMSK
TRNE OPTS,PRIMSK ;PRIORITY
TRZ A,PRIMSK
TLNE OPTS,QNTMSK ;QUANTUM
TLZ A,QNTMSK ;
IOR OPTS,A ;OR IN THE BITS FOR DEFAULTS
SALCS:
;;%AA%
TRNE OPTS,SSSMSK ;SPECIFIED SP STACK SIZE ?
JRST [ LDB C,SSSBYT ;YES, GET IT
LSH C,5 ;TIMES 32
JRST .+2 ]
MOVE C,DEFSSS ;STANDARD SIZE
PUSHJ P,CORGET ;GET SPACE
ERR <NOT ENOUGH CORE -- SPROUT >
MOVN C,C ;MAKE PDP
HRLZI NSP,-1(C)
HRRI NSP,-1(B)
TRNE OPTS,STSMSK ;P - STACK
JRST [ LDB C,STSBYT ;YES, GET IT
LSH C,5 ;TIMES 32
JRST .+2]
MOVE C,DEFPSS ;STANDARD AMOUNT TO GET
ADDI C,STKBAS ;SPACE FOR BASE
PUSHJ P,CORGET ;GET ROOM
ERR <NOT ENOUGH CORE -- SPROUT >
MOVE PB,B ;PROCESS BASE
MOVN C,C
HRLZI NP,STKBAS(C) ;MAKE PDP
HRRI NP,STKBAS(PB)
;ZERO OUT SOME OF THE PROCESS VARS
HRLZI A,ZFIRST(PB) ;
HRRI A,ZFIRST+1(PB)
SETZM ZFIRST(PB)
BLT A,ZLAST(PB)
;REMEMBER DADDY
MOVE USER,RUNNER
MOVE A,PRCITM(USER)
MOVEM A,DADDY(PB)
;;%AG% ! REMEMBER SPROUTER AS THE FIRST CALLER. RHT
MOVEM A,RSMR(PB) ;SO CALLER(MYPROC) STARTS OUT AS DADDY
;BUILD MSCP, ETC.
SETZM DYNL(PB) ;NULL DYN LINK
CAIN PDA,APPL$Y ;IS IT A SPROUT APPLY?
JRST [ ;YES
UP <
MOVE PDA,(PDA) ;SINCE APPL$Y IS HERED
>;UP
POP P,TMP ;ARG LIST
POP P,A ;PDA OF TARGET
PUSH NP,A ;PUT ON CALL STACK
PUSH NP,TMP ;PUT ON CALL STACK
;;#OO# !(1 OF 2) A TYPO
HRLZI TMP,SPRPDA
HLRZ C,PD.DLW(A) ;LOOK FOR RIGHT LINK
;;#OT# ! RHT DONT LOOK IF THE FELLOW SUPPLIES AN ENVIRONMENT
TLNN A,-1 ;ENVIRON SUPPLIED??
CAIG C,1 ;GLOBAL??
JRST SSLON ;YES
HRRZ A,PD.PPD(A);
SKIPA TMP,RF
SSLFLP: HLRZ TMP,C
MOVS C,1(TMP)
CAIE A,(C)
JRST SSLFLP
;;#OO# ! (2 OF 2) NEED TO SAY A SPROUT
HRLI TMP,SPRPDA
SSLON: MOVEM TMP,STATL(PB)
MOVEM NSP,ISP(PB)
JRST APSON ]
HLRZ A,PD.DLW(PDA) ;DISPLAY LEVEL
HRLZI TMP,SPRPDA ;IN CASE OUTER LEVEL
CAIG A,1 ;OUTER BLOCK PROC?
JRST SLON ;YES -- NO LOOP
HRRZ A,PD.PPD(PDA) ;THE LEXICAL PARENT
SKIPA TMP,RF ;DYNL
SLFLP: HLRZ TMP,C ;BACK A STATL
MOVS C,1(TMP) ;SL,,PDA
CAIE A,(C) ;SAME AS DADDY?
JRST SLFLP ;NO
HRLI TMP,SPRPDA ;SPRPDA,,STATL
SLON: MOVEM TMP,STATL(PB) ;STATIC LINK WORD
MOVEM NSP,ISP(PB) ;SP WORD
;COPY PROC PARAMS
HLRZ TMP,PD.NPW(PDA) ;#STRING PARAMS*2
JUMPE TMP,STPSON ;HAVE ANY ?
HRL TMP,TMP ;YES, DO A BLT
HRRZI A,1(NSP) ;DEST
ADD NSP,TMP ;BUMP OLD STACK
SUB SP,TMP ;DECREMENT OLD STACK
HRLI A,1(SP) ;SOURCE
BLT A,(NSP) ;COPY THEM
STPSON: HRRZ TMP,PD.NPW(PDA) ;# ARITH PARMS +1
SOJLE TMP,APSON ;ANY TO BLT ?
HRL TMP,TMP ;MAKE XWD
HRRZI A,1(NP) ;DEST
ADD NP,TMP
SUB P,TMP
HRLI A,1(P)
BLT A,(NP) ;DO IT
APSON:
;NOW SET UP NEW PROCESS'S STATUS, QUANTUM, & PRIORITY
SETOM STATUS(PB) ;ASSUME RUNNING
TRNE OPTS,SPNDNP ;UNLESS SUSPEND
SETZM STATUS(PB) ;0 MEANS SUSPENDED
MOVE TMP,DEFQNT ;STANDARD QUANTUM
TLNN OPTS,QNTMSK ;GET LOG2 QUANTUM
JRST SVQNT ;NO NEED
LDB A,QNTBYT
MOVEI TMP,1
LSH TMP,(A)
SVQNT: MOVEM TMP,QUANTM(PB)
MOVE A,DEFPRI ;ASSUME STD PRIORITY
TRNE OPTS,PRIMSK ;SAID OTHERWISE?
LDB A,PRIBYT
PUSHJ P,SETPRI ;GO SET PRIORITY
;SET UP PROCESS ITEM
POP P,C ;PICK UP ITEM #
MOVEM C,PRCITM(PB) ;REMEMBER IT
MOVEI A,PRCTYP ;SAY IS OF TYPE PROCESS
COMMENT **** MAY WANT TO WORRY HERE ABOUT GLOBAL ITEMS **** ;
MOVE TABL,GOGTAB
DPB A,INFOTAB(TABL) ;SAY IS A PROCESS
HRRZM PB,@DATAB(TABL) ;SET DATUM VALUE
;KILL SET STUFF
MOVE B,C ;ITEM NUMBER
MOVEM KL,KLOWNR(PB) ;REMEMBER KILL LIST OWNER
JUMPE KL,NEWSTT ;ONLY PUT ON KILL SET IF HAVE ONE
PUSH P,TABL ;NEED TO SAVE THESE
PUSH P,FP ;
PUSHJ P,INSRTS ;GO PUT ITEM IN KILL SET
POP P,FP
POP P,TABL
;NOW DECIDE WHAT TO DO WITH SPROUTING PROCESS & DO THE RIGHT THING
NEWSTT: MOVE USER,RUNNER ;HOPE IT IS STILL HIM
TRNE OPTS,RUNME ; DOES SPROUTING PROCESS WANT TO RUN?
JRST RNSPRR ;YES
MOVEM P,ACP(USER) ;IF HERE, THEN WANT TO RUN NEW GUY
MOVEM SP,ACSP(USER) ;SAVE THE NECESSARY ACS
MOVEM RF,ACF(USER) ;
MOVNS STATUS(USER) ;RUNNING BECOMES READY
TRNE OPTS,SPNDME ;IF I WANTED SUSPENSION
SETZM STATUS(USER) ;DO IT
SKIPL STATUS(PB) ;DOES SPROUTED PROCESS WANT TO RUN
JRST NORFR ;NO
MOVE USER,GOGTAB
MOVE A,QUANTM(PB)
MOVEM A,TIMER(USER)
MOVE P,NP ;
MOVE SP,NSP ;GET READY
MOVEI RF,DYNL(PB) ;
MOVEM PB,RUNNER
CALLIT: PUSHJ P,@PD.(PDA) ;CALL THE SO AND SO
;HERE IS WHERE WE COME ON PROCEDURE EXIT
CALRET: MOVE PB,RUNNER ;I HOPE ITS ME
PUSHJ P,KACTS ;DO EVERYTHING BUT SPACE FREEING
MOVE P,ALLPDP ;USE THIS PDL FOR KILLING CORE
;NOW KILL CORE FOR SP STACK
HRRZ B,ISP(PB)
ADDI B,1
PUSHJ P,CORREL
;NOW KILL CORE FOR P-STACK
HRRZI B,(PB)
PUSHJ P,CORREL
;NOW ALL TRACES ARE GONE (I HOPE)
JRST FOTR ;GO FIND SOMETHING TO DO
;PROCEDURE THAT PERFORMS ALL KILL ACTIONS EXCEPT STACK RELEASING
;EXPECTS PB TO POINT AT THE CONDEMNED PROCESS
;USES A,B,C,KL
KACTS: HRRZ C,PRCITM(PB)
MOVE B,C ;
MOVE TABL,GOGTAB ;
TLO PB,TERM ;SET TERM BIT
MOVEM PB,@DATAB(TABL) ;TERMINATED
SKIPE KL,KLOWNR(PB) ;IF HAVE A KILL SET
PUSHJ P,DELTSE ;DELETE FROM SET
;NOW CHECK TO SEE IF WE WERE ON ANY JOIN LISTS
SKIPN A,JOINS(PB)
JRST REMPRI
MOVE KL,GOGTAB ;
KACT.1: HLRZ C,(A) ;THE ITEM
MOVE B,@DATAB(TABL) ;GET ADDRESS OF THE DATUM
TLNE B,TERM ;DEAD ALREADY??
JRST KACT.2 ;YES
SOSLE JOINCT(B) ;READY TO ROLL ??
JRST KACT.2 ;NO
SKIPN STATUS(B) ;CURRENT STATUS
AOS STATUS(B) ;READY
KACT.2: HRRZ B,(A)
HRR C,FP1(KL) ;RELEASE LIST CELL
HRRM C,(A)
HRRM A,FP1(KL) ;NEW FREE LIST
JUMPE B,REMPRI ;END OF LIST
MOVE A,B ;
JRST KACT.1
;NOW TAKE OFF PRIORITY LIST AND RETURN
;NOTE -- THE CODE FROM HERE TO THE POPJ IS ITSELF A PROCEDURE USED
;ELSEWHERE TO REMOVE PROCESS (PB) FROM ITS PRIORITY LIST
;SIDE EFFECTS -- USES A,B,C
REMPRI: MOVE A,PRIOR(PB)
ADD A,GOGTAB
HRRZ B,PLISTE(PB)
HLRZ C,PLISTE(PB)
JUMPN C,.+3
HRRM B,PRILIS(A) ;HEAD OF LIST
JRST .+2
HRRM B,PLISTE(C) ;NEXT(C)←B
JUMPN B,.+3
HRLM C,PRILIS(A) ;NEW TAIL
POPJ P,
HRLM C,PLISTE(B) ;PREV(B)←C
POPJ P,
;PROCEDURE TO PUT PROCESS (PB) ON PRIORITY LIST A
;SIDE EFFECT -- MODIFIES B
SETPRI: MOVEM A,PRIOR(PB) ;REMEMBER MY PRIORITY
ADD A,GOGTAB
SKIPE B,PRILIS(A) ;PRIORITY LIST OWNER
HRLM PB,PLISTE(B) ;LINK BACK
HRRZM B,PLISTE(PB) ;LIINK DOWM
HRRM PB,PRILIS(A) ;NEW RHS FOR OWNER IS PTR TO ME
TLNN B,-1 ;WAS THE LIST EMPTY ??
HRLM PB,PRILIS(A) ;YES -- THIS IS THE TAIL TOO
CPOPJ: POPJ P,
;HERE IF DONT WANT TO RUN NEW GUY RIGHT AWAY
NORFR: TROA B,1 ;FLAG
RNSPRR: MOVEI B,0
MOVNS STATUS(PB) ;IF NEW IS "RUNNING", THEN "READY"
PUSH NP,[CALRET] ;
MOVEM NP,ACP(PB) ;SET UP NEC. SAVES
MOVEM NSP,ACSP(PB)
MOVEI A,DYNL(PB)
MOVEM A,ACF(PB)
MOVE A,PD.(PDA) ;WHERE HE STARTS
MOVEM A,PCW(PB)
CAIN B, ;SPROUTER RUNS??
JRST @PCW(USER) ;YES --
JRST FOTR ;NO -- FIND SOMEONE TO RUN
COMMENT ⊗routines for inserting & deleting set elements⊗
;expects item no in B , (KL) = the owner
;mangles A,B,C,FP,TABL
INSRTS: MOVE TABL,GOGTAB
SKIPN A,(KL) ;GET OWNER
JRST NEWINS ;IT WAS NULL BEFORE
MOVE C,(A) ;POINT AT FIRST
ISCH: MOVS C,(C) ;CONTENTS (SWAPPED) OF THIS
CAILE B,(C) ;ELIGIBLE
JRST NX1 ;MUST GO FURTHER
CAIL B,(C) ;THERE ALREADY?
POPJ P, ;YES
NI: HRL B,(A) ;POINTER AT THIS
NCELL (C) ;GET A CELL FOR IT
MOVSM B,(C) ;SAVE CONTENTS OF CELL
HRRM C,(A) ;LINK TO NEW
HRLZI A,1
ADDB A,(KL) ;UPDATE COUNT -- POINT AT LAST,,FIRST
TLNN B,-1 ;AT THE END???
HRLM C,(A) ;YES
POPJ P,
NX1: HRRZ A,(A)
TLNN C,-1 ;END OF LIST
JRST NI ;YES -- PUT AT END
MOVSS C
JRST ISCH ;GO LOOK SOME MORE
NEWINS: NNCELL (A)
SETZM (A)
HRRZM A,(KL) ;IT USED TO BE NULL
JRST NI
;ROUTINES FOR ADDING TO LISTS
;EXPECT ITEM NO IN B, KL= ADRS OF OWNER
;MANGLE A,B,C,FP,TABL
;;#QK# RHT ! SET UP OF TABL NEEDED
IHEDLS: MOVE TABL,GOGTAB
SKIPN A,(KL) ;INSERT AT HEAD
JRST NEWINS
JRST NI
ITAILS:
;;#QK# ! SET UP TABL (2 OF 2)
MOVE TABL,GOGTAB ;
SKIPN A,(KL) ;INSERT AT TAIL
JRST NEWINS
MOVS A,(A)
JRST NI
;ROUTINE TO DELETE SET OR LIST ELEMENTS
;B = ITEM NO, (KL) IS THE OWNER
;MANGLES A,B,C,TABL
DELTLE:
DELTSE: SKIPN A,(KL) ;GET SET DESCRIPTOR
POPJ P, ;NULL ALREADY
MOVE C,(A)
DSCH: MOVE C,(C)
TLC C,(B)
TLNN C,-1 ;WAS IT THIS ONE???
JRST DIT ;YES
TRNN C,-1 ;END OF SEARCH
POPJ P, ;YES
MOVE A,(A) ;LINK
JRST DSCH ;GO LOOK
DIT: MOVE TABL,GOGTAB
MOVE B,(A) ;B PTR TO THIS CELL
HRRM C,(A) ;LINK PREV TO NEXT
HRL C,FP1(TABL) ;OLD FREE LIST
HLRM C,(B) ;LINK CELL
HRRM B,FP1(TABL) ;
HRLZI B,-1 ;ADJUST DESCRIPTOR
ADDB B,(KL)
TLNE B,-1 ;LIST NULL NOW???
JRST CKEND ;NO
SETZM (KL) ;YES
MOVSS (B) ;LAST,,FIRST CELL
;NOW IS 0,,PTR TO CELL JUST FREED UP
HRRM B,FP1(TABL) ;NEW FREE LIST
POPJ P,
CKEND: TRNN C,-1 ;WAS THIS THE END
HRLM A,(B) ;YES
POPJ P,
;ROUTINE TO DELETE FIRST ELT OF A LIST
;PUTS ITEM # INTO A
;EXPECTS (KL) = THE OWNER
;MODIFIES A,B,C,TABL
REMCAR: SKIPN A,(KL)
POPJ P, ;IF WAS NULL RETURN A 0
MOVE C,(A)
MOVE C,(C) ;FIRST REAL LIST CELL
HLRZ B,C ;FIRST ONE
PUSH P,B ;SAVE IT
PUSHJ P,DIT
POP P,A ;VALUE
POPJ P,
;USER REQUESTED SCHEDULING
HERE(URSCHD)
MOVE PB,RUNNER
SKIPL STATUS(PB) ;
JRST FOTR ;GO FIND ONE TO RUN
MOVNS STATUS(PB) ;SET TO READY
SPSRN1: SETZM REASON(PB) ;OTHER ACS NOT SAVED
SPSRN2: POP P,PCW(PB) ;DITTO -- BUT LEAVE REASON INTACT
;THESE TWO LABELS ARE USED
;BY SUSPEND, JOIN & THE LIKE
MOVEM P,ACP(PB)
MOVEM SP,ACSP(PB)
MOVEM RF,ACF(PB)
FOTR: HRRZ B,GOGTAB
TLO B,-NPRIS
MOVEI A,1 ;READY
SCHLIS: SKIPN PB,PRILIS(B) ;SEARCH DOWN THIS LIST
JRST NXLIS ;LIST IS EMPTY
TRYTHS: CAMN A,STATUS(PB) ;IS THIS READY
JRST SCDTHS ;YES -- DO HIM
HRRZ PB,PLISTE(PB) ;LINK DOWN LIST
JUMPN PB,TRYTHS ;IF ANY LEFT AT THIS LEVEL,TRY
NXLIS: AOBJN B,SCHLIS ;SEARCH LIST
IFE APRISW <
;;#NA# RACE CONDITION ON WHEN INTERRUPT HAPPENS
IMSKCL 1,[-1] ;MASK OFF ALL INTERRUPTS
SKIPE INTRPT ; A RECENT INTERRUPT
JRST [INGOSC: SETZM INTRPT ;GO TRY AGAIN TO SCCHEDULE
IMSKST 1,[-1]
JRST FOTR ]
INTENS B, ;GET INTERRUPT ENABLING
TLNN B,775204 ;IS HE ENABLED FOR SOMETHING
;THAT CAN STILL HAPPEN
ERR <NO ONE TO RUN>,1,INGOSC ;NO
IMSTW [-1 ;WAIT FOR AN INTERRUPT
1]
SETZM INTRPT ;ZERO THE FLAG
;;#NA# -- EVENTUALLY FIX THIS CROCK
>;IFE APRISW
IFN APRISW <
SKIPN INTRPT
ERR <NO ONE TO RUN>,1
SETZM INTRPT
>;IFN APRISW
JRST FOTR ;FIND SOMEONE TO RUN
SCDTHS:
;CIRCLE THE QUEUE
SKIPN A,PLISTE(PB) ;ONLY ONE ON THE LIST?
JRST RDYTHS ;YES
TRNN A,-1 ;ALREADY AT END?
JRST RDYTHS ;YES
HLLM A,PLISTE(A) ;PREV(NEXT(ME))←PREV(ME)
MOVS C,A ;NEXT(ME),,PREV(ME)
TRNE C,-1 ;ANY PREV?
HLRM C,PLISTE(C) ;YES -- NEXT(PREV(ME))←NEXT(ME)
TLNE A,-1 ;WAS I FIRST?
HRR A,PRILIS(B) ;NO -- FIRST WILL STAY FIRST
HRL A,PB ;NEW OWNER -- ME,,NEW FIRST
EXCH A,PRILIS(B) ;GET OLD LAST,,FIRST
HLLZM A,PLISTE(PB) ;MY NEW ENTRY IS OLD LAST,,0
MOVS A,A ; XXX,,OLD LAST
HRRM PB,PLISTE(A) ;POINT AT ME
RDYTHS: SETOM STATUS(PB) ;RUNNING
HRRM PB,RUNNER ;SAY SO
MOVE USER,GOGTAB
MOVE A,QUANTM(PB)
MOVEM A,TIMER(USER)
SKIPE A,REASON(PB)
JRST @SPCASE(A) ;SOME SPECIAL CASE
RPSPF: MOVE P,ACP(PB) ;GET THE NEEDED REGISTERS
MOVE SP,ACSP(PB)
MOVE RF,ACF(PB)
JRST @PCW(PB) ;GO START RUNNING THE SO AND SO
SPCASE: RPSPF ;0 THEN RESTORE P, SP, F
RSTACS ;1 THEN RESTORE ALL ACS
RPSPF ;2 THEN FROM JOINER
RST1 ;3 THEN FROM INTERROGATE
RSTACS: MOVE P,ACP(PB) ;PUT THE RETURN ADDRESS ON THE STACK
PUSH P,PCW(PB)
MOVEM P,ACP(PB)
HRLZI P,AC0(PB)
BLT P,P ;RESTORE THE OLD ACS
POPJ P, ;GO RUN
RST1: MOVE A,AC1(PB) ;RESTORE REG 1 , SP,P,F
JRST RPSPF
HERE(RESUME)
MOVE USER,RUNNER ;TAKE CARE OF RET ADDRS
POP P,PCW(USER)
POP P,OPTS ;OPTIONS
POP P,A ;RETURN VALUE
POP P,C ;WHO
MOVE TEMP,GOGTAB ;
LDB B,INFOTAB(TEMP) ;TEST THE TYPE
CAIE B,PRCTYP ;IS THE TYPE A PROCESS
ERR <ATTEMPT TO RESUME SOMETHING NOT A PROCESS>
MOVE PB,@DATAB(TEMP) ;GET THE DATUM
TLNE PB,TERM ;WAS IT TERMINATED?
ERR <ATTEMPT TO RESUME A TERMINATED PROCESS>
MOVE B,PRCITM(USER) ;MY NAME
MOVEM B,RSMR(PB) ;REMEMBER CALLER
SKIPE STATUS(PB) ;HIS STATUS BETTER BE 0
ERR <ATTEMPT TO RESUME NON-SUSPENDED PROCESS>,1,<@PCW(USER)>
JUMPN OPTS,NS.RSM ;NONSTANDARD IF JUMP
SETZM STATUS(USER)
RSM.H: SETOM STATUS(PB)
MOVEM P,ACP(USER) ;SAVE NEEDFUL REGISTERS
MOVEM RF,ACF(USER)
MOVEM SP,ACSP(USER)
SETZM REASON(USER) ;ONTL P, SP, F IMPORTANT
MOVEM PB,RUNNER ;
MOVE C,REASON(PB) ;
JRST @SPCASE(C) ;GO FIRE HIM UP
NS.RSM: TRNN OPTS,MSTMSK ;FUNNYNESS IN MY NEW STATUS?
JRST RSM.4 ;NO -- IT MUST BE NOTNOW
LDB D,MSTBYT ;GET INDEX
JRST @[ RSM.1 ;I GO READY
RSM.3 ;I DIE
RSM.4 ;I WANT TO KEEP RUNNING
]-1(D) ;SELECT
RSM.1: TRNN OPTS,NOTNOW ;HE RUNS?
JRST RSM.2 ;YES
AOS STATUS(PB) ;MAKE HIM READY
MOVE B,REASON(PB) ;WERE ALL REGISTERS SAVED
CAIN B,1 ;
JRST RSM.01 ;YES
MOVEM A,AC1(PB) ;
MOVEI A,3
MOVEM A,REASON(PB) ;A IS IMPORTANT
RSM.01: PUSH P,PCW(USER) ;RET AD
JRST URSCHD ;RESCHEDULE
RSM.2: MOVNS STATUS(USER) ;
JRST RSM.H ;GO GET HIM GOING
RSM.3: MOVE B,REASON(PB) ;
CAIN B,1 ;ALL ACS SAVED?
JRST RSM.3X ;YES
MOVEM A,AC1(PB) ;SAVE A
MOVEI A,3 ;
MOVEM A,REASON(PB) ;
RSM.3X: TRNE OPTS,NOTNOW ;HE RUNS?
JRST RSM.03 ;YES
AOS STATUS(PB) ;NO - I CAN COMMIT SUICIDE
MOVE PB,USER ;
JRST TERMPB ; I DIE
RSM.03: MOVE B,ACP(PB) ;
MOVEI C,RSM.T ;
EXCH C,PCW(PB) ;FIRST HE WILL KILL ME
PUSH B,C ;
PUSH B,PB ;
MOVEM B,ACP(PB) ;THE TERMPB POPJ WILL CONTINUE HIM
JRST RSM.H ;GO FIRE THE DEAR BOY UP
RSM.4: AOS STATUS(PB) ;GET HIM READY
MOVE B,REASON(PB) ;SHOULD WE SAVE 1
CAIE B,1 ;
JRST @PCW(USER) ;I GO ON MY WAY
MOVEM A,AC1(PB) ;SAVE IT
MOVEI A,3 ;
MOVEM A,REASON(PB) ;
;;#LB#! 1-15-73 DCS WAS @PCW(PB), THAT'S WRONG ("TYPO")
JRST @PCW(USER) ;
RSM.T: MOVE PB,(P) ;
PUSHJ P,TERMPB ;
MOVE PB,1(P) ;TERMPB BACKED UP THE STACK
POP P,PCW(PB) ;RET AD
MOVE C,REASON(PB) ;
JRST @SPCASE(C) ;GO DO RIGHT THING ABOUT ACS
COMMENT ⊗SUSPEND and TERMINATE runtime routines⊗
HERE(SUSPEND)
MOVE C,-1(P) ;THE ITEM
POP P,-1(P) ;BACK UP RETN ADDR
MOVE TABL,GOGTAB ;
LDB B,INFOTAB(TABL)
CAIE B,PRCTYP ;BE SURE A PROCESS ITEM
ERR <ATTEMPT TO SUSPEND A NON PROCESS ITEM>
MOVE PB,@DATAB(TABL)
TLNE PB,TERM ;IF TERMINATED ,
ERR <SUSPENDING A TERMINATED ITEM>
CAME PB,RUNNER ;IS IT THE RUNNER
JRST OTHGUY ;NO
SETZM STATUS(PB)
JRST SPSRN1 ;GO RESCHEDULE
OTHGUY: MOVEI A,SPNDR ;HE MUST HAVE BEEN READY
SKIPE STATUS(PB) ;IF HE WASNT SUSPENDED
MOVEM A,REASON(PB) ;THE REGISTERS MUST BE RESTORED
SETZM STATUS(PB) ;BE SURE
TENX <
IFDEF ITMANY, <
TIME-TO-FLUSH-A-CROCK-WITH-ITMANY-IN-NWORLD
>
IFNDEF ITMANY, <
ITMANY←←-1
>
>;TENX
MOVEI A,ITMANY ;GET THE ITEM ANY
POPJ P,
HERE(TERMINATE)
MOVE C,-1(P)
MOVE TABL,GOGTAB ;
LDB B,INFOTAB(TABL) ;IS HE A PROCESS
CAIE B,PRCTYP
ERR <TERMINATING A NON-PROCESS>
MOVE PB,@DATAB(TABL) ;POINT AT PROCESS
TLNE PB,TERM ;ALREADY DEAD
JRST RET1 ;YES
↑TERMPB:
MOVE USER,RUNNER ;COME HERE IF PB LOADED
CAMN PB,USER ;IS IT ME THAT IS TO DIE?
JRST KILLIT ;YES
PUSH P,PRIOR(USER) ;I AM ABOUT TO GET HIGH PRIORITY
PUSHJ P,REMPRI
MOVEI A,MAXPRI ;
PUSHJ P,SETPRI
MOVEI A,FIXPRI
MOVEM A,PCW(USER)
MOVEM P,ACP(USER)
MOVEM RF,ACF(USER)
MOVEM SP,ACSP(USER)
MOVE RF,ACF(PB)
MOVE P,ACP(PB)
MOVE SP,ACSP(PB)
MOVEI A,1 ;NOW FIX STATUS
MOVEM A,STATUS(USER) ;
MOVNM A,STATUS(PB)
MOVEM PB,RUNNER ;THE NEW RUNNER
KILLIT: MOVEI LPSA,SPRPDA ;THE SPROUTER IS WHERE WE GO BACK TO
PUSHJ P,STKUWD ;UNWIND THE STACK
JRST CALRET ;GO DIE
;IF LIVED THROUGH THE DESTRUCTION, WILL COME HERE
FIXPRI: PUSHJ P,REMPRI
POP P,A ;REAL PRIORITY
PUSHJ P,SETPRI
RET1: SUB P,[XWD 2,2] ;GET OFF THE PARAMETER
JRST @2(P) ;RETURN
COMMENT ⊗The JOIN runtime routine⊗
DSCR JOIN
CAL PUSH P,SET
PUSHJ P,JOIN
DES CAUSES YOUR PROCESS TO WAIT FOR THE TERMINATION OF ANY
PROCESSES NAMED IN ITS ARGUMENT SET
⊗
HERE(JOIN)
MOVE PB,RUNNER
MOVE B,-1(P) ;THE SET
POP P,-1(P) ;FOR LATER
JUMPE B,CPOPJ ;
MOVE TABL,GOGTAB ;GET READY FOR CELL GETTING
HRRZ A,(B) ;A NOW POINTS AT FIRST
HRLZ D,PRCITM(PB) ;THE PROCESS ITEM OF THE JOIN
;NOW LOOP ALONG SET, GIVING WARNINGS
JNST: HLRZ C,(A) ;THE ITEM NUMBER
LDB B,INFOTAB(TABL) ;GET TYPE
CAIE B,PRCTYP ;PROCESS?
ERR <ATTEMPT TO DO JOIN ON NON-PROCESS>
MOVE B,@DATAB(TABL) ;GET DATUM
TLNE B,TERM ;DEAD ???
JRST NXTJNR ;YES
AOS JOINCT(PB) ;ONE MORE TO DIE
NNCELL (C) ;GET (POSSIBLY FIRST) NEW CELL
HRR D,JOINS(B) ;LINK TO OLD JOIN LIST
MOVEM D,(C) ;NEW CONTENTS OF THIS CELL
HRRZM C,JOINS(B) ;NEW JOIN LIST
NXTJNR: HRRZ A,(A) ;GET NEXT ENTRY
JUMPN A,JNST
SKIPG JOINCT(PB) ;DO WE NEED TO WAIT?
POPJ P, ;NO
MOVEI A,JOINR ;REASON IS A JOIN
MOVEM A,REASON(PB) ;
SETZM STATUS(PB) ;I AM SUSPENDED
JRST SPSRN2 ;GO SAVE P,RF,SP & RUN SOMEONE
;(BUT DONT CHANGE REASON)
COMMENT ⊗THE MAIN PROCESS INITIALIZER⊗
HERE(MAINPR)
MOVE USER,GOGTAB
SKIPE GGDAD(USER) ;INITIALIZED ALREADY
POPJ P, ;YES
MOVEI C,NPVARS+40 ;HOW MUCH SPACE WE NEED
PUSHJ P,CORGET
ERR <NO ROOM FOR THE MAIN PROCESS>
HRRZ PB,B ;PROCESS BASE
MOVE A,SPDL(USER) ;STRING PDL
MOVEM A,ISP(PB)
SETOM DYNL(PB)
HLROI A,SPRPDA
MOVEM A,STATL(PB)
MOVEM PB,GGDAD(USER)
MOVEM PB,RUNNER ;SAY THIS IS THE RUNNER
HRLZI A,ZFIRST(PB)
HRRI A,ZFIRST+1(PB)
SETZM ZFIRST(PB)
BLT A,ZLAST(PB)
MOVEI C,MAINPI ;THE MAIN PROCESS ITEM NUMBER
MOVEI A,PRCTYP ;MAKE A PROCESS
DPB A,INFOTAB(USER)
HRRZM PB,@DATAB(USER)
MOVEM C,PRCITM(PB)
SETZM KLOWNR(PB) ;NASTY
SETOM STATUS(PB) ;I AM THE RUNNER
MOVEI A,STPSZ ;SET DEFAULTS
MOVEM A,DEFPSS ;P STACK
MOVEI A,STSPST ;
MOVEM A,DEFSSS ;SP STACK
MOVEI A,STDQNT ;
MOVEM A,DEFQNT ;QUANTUM
MOVEM A,QUANTM(PB) ;
MOVEI A,STDPRI ;STANDARD PRIORITY
MOVEM A,DEFPRI ;PRIORITY
PUSHJ P,SETPRI ;SET THE PRIORITY
PUSH P,[%SPGC]
PUSHJ P,SGREM
PUSH P,[%ARRSRT]
PUSHJ P,SGREM
PUSH P,[%PSSGC]
PUSH P,[SGLKBK+1]
PUSHJ P,SGINS
POPJ P,
COMMENT ⊗CALLER , MYPROC, AND PSTATUS ⊗
HERE(CALLER)
JSP TEMP,PDG
ERR <NOT A PROCESS ITEM>
TLNE A,TERM
ERR <PROCESS IS TERMINATED>
MOVE A,RSMR(A)
C.XIT1: EXCH C,-1(P)
C.XIT: SUB P,X22
JRST @2(P)
HERE(MYPROC)
MOVE USER,RUNNER
MOVE A,PRCITM(USER)
POPJ P,
HERE(PSTATUS)
JSP TEMP,PDG
ERR <NOT A PROCESS ITEM>
TLNN A,TERM
SKIPA A,STATUS(A)
MOVEI A,2
JRST C.XIT1
;PDG -- GETS PROC ITEM IN -1(P) INTO C , CHECKS TYPE, & PUTS DATUM INTO A
;CALLED BY JSP TEMP,PDG
;SIDE EFFECTS: USES USER, PUTS OLD VALUE OF C INTO -1(P), SKIP RETURNS IF
;THE ITEM WAS OK. OTHERWISE RETURNS WITH A= WHATEVER TYPE ITEM IN C IS
PDG: EXCH C,-1(P) ;ITEM NUMBER
MOVE USER,GOGTAB
LDB A,INFOTAB(USER)
CAIE A,PRCTYP
JRST (TEMP) ;WAS NOT A PROC ITEM
MOVE A,@DATAB(USER)
JRST 1(TEMP) ;RETURN
COMMENT ⊗ PRISET -- ROUTINE USER CALLS TO CHANGE PRIORITY ⊗
HERE(PRISET)
MOVE C,-2(P) ;ITEM
MOVE TABL,GOGTAB ;
LDB A,INFOTAB(TABL)
CAIE A,PRCTYP
ERR <ATTEMPT TO SET PRIORITY OF NON PROCESS ITEM>
MOVE PB,@DATAB(TABL) ;GET DATUM
TLNE PB,TERM
ERR <ATTEMPT TO SET PRIORITY OF TERMINATED PROCESS>
PUSHJ P,REMPRI ;TAKE OFF MY LIST
MOVE A,-1(P)
CAIG A,17 ;CHECK BOUNDS
CAIGE A,0
ERR <ERR ATTEMPT TO GIVE A PROCESS AN ILLEGAL PRIORITY>
PUSHJ P,SETPRI
SUB P,X33
JRST @3(P)
COMMENT ⊗SPECIAL GC ROUTINE FOR PROCESSES⊗
HERE(%PSSGC)
MOVE TEMP,RUNNER
MOVEM SP,ACSP(TEMP)
;; dont get it from here (assume was ok)
; MOVE RF,RACS+RF(USER)
MOVEM RF,ACF(TEMP)
HRLZI B,-NPRIS
HRR B,GOGTAB
SCHL1: SKIPN TEMP,PRILIS(B)
JRST NXLS
PUSH P,B
SCHL2: MOVE RF,ACF(TEMP)
PUSH P,TEMP
PUSHJ P,%ARSR1
MOVE TEMP,(P)
HRRZ A,ISP(TEMP)
MOVE SP,ACSP(TEMP)
PUSHJ P,%SPGC1
POP P,TEMP
HRRZ TEMP,PLISTE(TEMP)
JUMPN TEMP,SCHL2
POP P,B
NXLS: AOBJN B,SCHL1
MOVE TEMP,RUNNER
;; now get rf for this process back (also sp)
MOVE RF,ACF(TEMP)
MOVE SP,ACSP(TEMP)
POPJ P,
COMMENT ⊗INTERRUPT ROUTINES⊗
HERE(DDFINT) ;DO DEFERRED INTERRUPT
SKIPE NOPOLL ;IGNORING IT?
POPJ P, ;YES
SETZM INTRPT ;
MOVE USER,RUNNER ;NEED TO SAVE ACS
POP P,PCW(USER) ;SAVE PC WORD
MOVNS STATUS(USER) ;READY
MOVEI TEMP,AC0(USER) ;
BLT TEMP,ACP(USER) ;
MOVEI A,1 ;NEED ALL ACS
MOVEM A,REASON(USER) ;
JRST FOTR ;SEE WHOM TO RUN
HERE(INTSET)
;CALL IS INTSET(ITEM,SPROUT OPTS)
;ORS IN THE STATUS OPTIONS FOR SPNDNP+RUNME
;TURNS OFF THE OPTION FOR SPNDME
MOVE USER,GOGTAB ;
SKIPE DISPAT(USER) ;HAVE TABLES???
JRST .+3 ;YES
PUSH P,[=128] ;DEFAULT BUFFER SIZE
PUSHJ P,INTTBL ;GO GET EM
PUSH P,-2(P) ;ITEM
PUSH P,[INTPDA] ;INTERRUPT PROCEDURE
MOVE A,-2(P) ;GET OPTIONS
TRZ A,SPNDME ;SET UP STATUS FIELD
TRO A,SPNDNP+RUNME ;
PUSH P,A ;
PUSH P,[0] ;NO KILL SET
PUSHJ P,SPROUT ;SPROUT IT
MOVE C,-2(P) ;THE ITEM
MOVE A,@DATM
MOVE USER,GOGTAB
MOVEM A,INTPRC(USER) ;REMEMBER INTERRUPT PROCESS BASE
MOVE A,-1(P) ;
TRNE A,PRIMSK ;DID HE SPEC A PRIORITY
JRST POK
PUSH P,C ;ITEM
PUSH P,[0]
PUSHJ P,PRISET ;SET THE PRIORITY
POK:
SUB P,X33
JRST @3(P)
HERE(CLKMOD)
NOTENX<
MOVE USER,GOGTAB ;
SOSG TIMER(USER) ;IF COUNTDOWN COMPLETE THEN
SETOM INTRPT ;SIGNAL THE INTERRUPT
POPJ P, ;LET CALLER DISMIS
>;NOTENX
TENX<
ERR <CLKMOD not implemented.>
>;TENX
DEFINE QW(VALAC,WPAC,RPTR,WTOP,WBOT,OVINST) <
MOVEM VALAC,(WPAC)
ADDI WPAC,1
CAMLE WPAC,WTOP
MOVE WPAC,WBOT
CAMN WPAC,RPTR
OVINST
>
DEFINE QR(VALAC,WPTR,RPAC,WTOP,WBOT,OVINST) <
CAMN RPAC,WPTR
OVINST
MOVE VALAC,(RPAC)
ADDI RPAC,1
CAMLE RPAC,WTOP
MOVE RPAC,WBOT
>
DEFINE IQW(VAC) <
QW(VAC,11,<INTQRP(USER)>,<INTQWT(USER)>,<INTQWB(USER)>,< JRST IQWOV >)
>
HERE(DFR1IN)
MOVE USER,GOGTAB ;SO CAN CALL ANY TIME
MOVE 11,INTQWP(USER)
NOTENX <
IQW 1
IQW 6
MOVE TEMP,XJBCNI
IQW TEMP
MOVE TEMP,XJBTPC
IQW TEMP
>;NOTENX
TENX <
IQW 14 ;LPC WORD FOR THIS INTERRUPT.
>;TENX
MOVE TEMP,RUNNER
IQW TEMP
MOVE 1,-1(P)
VILOOP: MOVE TEMP,(1)
IQW TEMP
AOBJN 1,VILOOP
MOVEM 11,INTQWP(USER)
SETOM INTRPT
SKIPN 7,INTPRC(USER) ;INTERRUPT PROCESS
JRST DF.X
MOVEI TEMP,1 ;READY
SKIPL STATUS(7)
MOVEM TEMP,STATUS(7)
DF.X: SUB P,X22
JRST @2(P)
IQWOV: ERR <DRYROT IN INTMOD -- WRITER>
JRST DF.X
HERE(DFRINT)
NOTENX <
PUSH P,@DFRINF(USER)
>;NOTENX
TENX <
PUSH P,13 ;PUSH AOBJN PTR, 3RD ARG TO INTMAP
>;TENX
PUSHJ P,DFR1IN
POPJ P,
COMMENT ⊗THE INTERRUPT PROCESS⊗
DEFINE IQR(AC) <
QR (AC,<INTQWP(USER)>,D,<INTQWT(USER)>,<INTQWB(USER)>,<JRST QRERR>)
>
HERE(INTPRO)
PUSH P,RF
PUSH P,INPDA0
PUSH P,SP
MOVE USER,GOGTAB
DO1INT: MOVE D,INTQRP(USER) ;READER OF THE QUEUE
QR (1,<INTQWP(USER)>,D,<INTQWT(USER)>,<INTQWB(USER)>,< JRST ALDCIS >);
;ABOVE GETS LPC WORD ON TENEX, FOR IJBTPC
NOTENX <
IQR 6
IQR TEMP
MOVEM TEMP,IJBCNI(USER)
IQR TEMP
MOVEM TEMP,IJBTPC(USER)
>;NOTENX
TENX <
MOVEM 1,IJBTPC(USER)
>;TENX
IQR TEMP
MOVEM TEMP,IRUNNR(USER)
IQR B
TENX <
SUBI B,1 ;GROSS CROCK - FIND OUT WHY WORKS SOMEDAY
;ACTUALLY FIND OUT WHY STANFORD WORKS WITHOUT
;THE CROCK. SEEMS TO BE DISAGREEMENT BETWEEN
;QUEUE WRITER AND READER AS TO WHETHER THE COUNT
;WORD INCLUDES SELF OR NOT.
>;TENX
JUMPE B,DISDFI
DO1I.1:
IQR C
MOVEM D,INTQRP(USER)
SOJLE B,DO1I.2
PUSH P,C
JRST DO1I.1
DO1I.2: HLRZ D,C
CAIN D,-1 ;IS THIS A PDA
JRST DO1I.4 ;NO -- JUST ISSUE THE CALL
TLNN C,-1 ;WAS THERE A CONTEXT??
JRST DO1I.3 ;NO
MOVS D,C ;PDA,,STATIC LINK
HRRZ TEMP,PD.PPD(C) ;PARENTS PDA
PUSH P,[ DO1INT]
PUSH P,RF
HLRZ LPSA,1(D) ;THE PDA IIN THE STACK
CAIE LPSA,TEMP ;BETTER BE THE SAME
ERR <ATTEMPT TO REFERENCE A NON-EX ENVIRONMENT IN INTPRO >
PUSH P,D ;STATIC LINK
PUSH P,SP ;SAVE SP
HLRZ C,PD.PPD ;END OF MKSEMT
JRST (C)
DO1I.3: HRRZ C,PD.(C) ;ENTRY ADDRESS
DO1I.4: PUSHJ P,(C) ;CALL THE PROCEDURE
JRST DO1INT
ALDCIS: MOVE PB,RUNNER ;ALL DONE CURRENT INTERRUPTS
SETZM STATUS(PB) ;SUSPEND SELF
PUSHJ P,SPSRN1
JRST DO1INT
QRERR: ERR <DRYROT IN INTPRO -- READER>
JRST ALDCIS
DISDFI: ERR <STRANGENESS IN DEFERRED INTERRUPT>,1
JRST DO1INT
DEFINE IPDE(X,V), < PUTINLOC(INTPDA+X,V) >
INTPDA: BLOCK PD.XXX+1
IPDE (PD.,INTPRO)
IPDE (PD.DSW,3)
IPDE (PD.PDA,<<INPDA0: XWD INTPDA,0>>)
IPDE (PD.LLW,<INTPDA+PD.XXX>)
IPDE (PD.DLW,<INTPDA+PD.XXX>)
;DFCPKT(5 WD BLOCK ADDR,EVTYP,EVNOT,OPTS)
; CREATES A FIVE WORD BLOCK FOR A DEFERED CAUSE & RETURNS AN AOBJN
; POINTER TO THE BLOCK
; IF THE SUPPLIED BASE ADDRESS IS ≠0 THEN USES THAT ADDRESS
; OTHERWISE DOES A CORGET TO GET THE FIVE WORDS
HERE(DFCPKT)
SKIPE B,-4(P) ;DID USER GIVE ME A BLOCK
JRST DFC.1 ;YES
MOVEI C,5
PUSHJ P,CORGET
ERR <NO CORE LEFT>
DFC.1: HRLI B,-5
MOVE A,B ;AOBJN PTR
SUB B,X11 ;READY FOR PUSHES
PUSH B,[4]
PUSH B,-3(P)
PUSH B,-2(P)
PUSH B,-1(P)
PUSH B,[XWD -1,CAUSE]
SUB P,[XWD 5,5]
JRST @5(P) ;RETURN
COMMENT ⊗ CAUSE ⊗
HERE(CAUSE)
MOVE PB,RUNNER
AOS A,CAUSES(PB)
CAIE A,1 ;FIRST CAUSE?
JRST DFRCS ;NO -DEFER IT
POP P,CAUSRA(PB) ;SAVE RETN ADDRESS
CSIT: PUSHJ P,CAUSE1 ;DO THE WORK
MOVE PB,RUNNER
SOSG A,CAUSES(PB) ;DONE ONE
JRST CSE.X ;ALL ARE DONE -- CHECK FOR SCHED REQ
MOVEI KL,CAUSEQ(PB) ;GET NEXT FROM QUEUE
PUSHJ P,REMCAR
HLRZ B,(A) ;PICK UP TYPE
PUSH P,B
HRRZ B,(A) ;NOTICE
PUSH P,B
PUSH P,1(A) ;OPTIONS
MOVE TABL,GOGTAB
HRR B,FP2(TABL) ;RELEASE 2 WD BLOCK
HRRM B,(A)
HRRM A,FP2(TABL)
JRST CSIT ;GO WORK ON THIS
DFRCS: MOVE TABL,GOGTAB ;
NNCLL2 (B) ;GET 2 WD CELL
POP P,TMP ;RETURN ADDRESS
POP P,1(B) ;OPTS
POP P,(B) ;NOTICE
POP P,A ;TYPE
HRLM A,(B)
MOVEI KL,CAUSEQ(KL) ;PUT ON CAUSE QUEUE
PUSHJ P,ITAILS ;PUT ON TAIL OF QUEUE
JRST (TMP) ;RETURN
CSE.X: MOVE USER,GOGTAB
SKIPN SCHDRQ(USER) ;SCHEDULING REQUEST
JRST @CAUSRA(PB) ;NO
SETZM SCHDRQ(USER) ;YES
PUSH P,CAUSRA(PB) ;YES
JRST URSCHD ;RESCHEDULE
COMMENT ⊗CAUSE1 -- ROUTINE TO DO ACTUAL WORK ⊗
HERE(CAUSE1)
CSE1: JSP TMP,EVTCK3 ;VERIFY THAT THIS IS AN EVENT ITEM
;ALSO EVT ← DATUM ,B&C←ITEM #
SKIPE PDA,CAUSEP(EVT) ;DID THE USER SAY SOMETHING???
JRST USPPRC ;USER SPEC PROCEDURE
MOVE FF,-1(P) ;OPTIONS
SKIPN TMP,WAITLS(EVT) ;WAS ANYONE WAITING?
JRST SCA.2 ;NO
MOVE TEMP,B ;EV TYP NO
MOVE TMP,(TMP) ;LAST,,FIRST
MOVE D,-2(P) ;NOTICE NO
SCA.1: MOVE TMP,(TMP) ;WAIT ENTRY
HLRZ C,TMP ;PROCESS NO
MOVE TABL,GOGTAB ;SET TABL TO RIGHT THING
PUSHJ P,ANSWR1 ;SPECIAL ENTRY POINT IN ANSWER
TRNE A,NOJOY ;DID WE SUCCEED??
JRST SCA.1A ;NO
TRNN A,RETAIN ;KEEP THE NOTICE??
TRO FF,DNTSAV ;YES
TRNN FF,TELLAL ;TELL THE WHOLE WORLD?
JRST SCA.2 ;NO
SCA.1A: TRNE TMP,-1 ;ANY LEFT
JRST SCA.1 ;YES
SCA.2: TRNE FF,DNTSAV ;SAVE IT?
JRST SCA.3 ;NO
MOVE B,-2(P) ;ITEM NO OF NOTICE
MOVEI KL,NOTCLS(EVT) ;
PUSHJ P,ITAILS ;PUT ON END OF NOTIICE LIST
SCA.3:
MOVE USER,GOGTAB
TRNE FF,SCHDIT ;WANT TO RESCHEDULE
SETOM SCHDRQ(USER) ;RESCHEDULE REQUEST
SCA.X: SUB P,X44 ;RETURN
JRST @4(P)
USPPRC: MOVE B,PD.(PDA) ;HERE IF USER SPECIFIED A PROCEDURE
;;#NB# !TYPO -- WAS A TLNE
TLNN PDA,-1 ;CONTEXT GIVEN
JRST (B) ;NO
PUSH P,RF ;SET UP CONTEXT
HRRZ C,PD.PPD ;PARENTS PDA
MOVS A,PDA ;
HLRZ D,1(A)
CAME D,C ;SAME?
ERR <CONTEXT WRONG OR CLOBBERED IN INTERP CALL
USER SPEC EVENT PROC >
PUSH P,A ;STATL
PUSH P,SP
HLRZ B,PD.PPD(PDA)
JRST (B) ;GO TO INSTR AFTER THE MKSEMT
COMMENT ⊗ANSWER -- subroutine used by CAUSE⊗
HERE(ANSWER)
;A←ANSWER(EV!TYP,NOT,PROCESS!ITEM);
;IF ATTEMPT TO ANSWER INTERROGATE IS SUCCESSFUL, A ← REQUEST CODE
;OTHERWISE, NOJOY BIT IS ON IN A & REST OF WORD IS INVALID
MOVE TEMP,-3(P) ;EV TYPE
POP P,-3(P) ;RET ADRS
POP P,C ;PROCESS ITEM
POP P,D ;NOTICE
MOVE TABL,GOGTAB
LDB B,INFOTAB(TABL)
CAIE B,PRCTYP
ERR <NOT A PROCESS ITEM>
;THE REST OF THIS IS CALLED INTERNALLY
;EXPECTS D= NOIICE, C=PROCESS ITEM, TEMP=EV TYPE
; ALSO TABL SET UP FOR PROCESS ITEM
;MODIFIES A,B,C,TABL,PB,TEMP,USER
ANSWR1: MOVE PB,@DATAB(TABL) ;THE PROCESS BASE
TLNN PB,TERM ;TERMINATED?
SKIPE STATUS(PB) ;OR NOT SUSPENDED??
JRST NOANS ;YES
AOS STATUS(PB) ;MAKE READY
MOVEM D,AC1(PB)
ANSWR2: PUSHJ P,DELWRQ ;DELETE ALL WAIT REQUESTS
MOVE A,INTRGC(PB) ;THE INTERROG CONTROL WORD
TRNN A,SAYWCH ;ASKED FOR THE ASSOCIATION
POPJ P, ;NO
PUSH P,[EVTYPI] ;
PUSH P,D
PUSH P,TEMP
PUSHJ P,STACSV ;SAVE ALL ACS
MOVEI 5,16 ;MAKE
PUSHJ P,LEAP
PUSHJ P,STACRS ;GET ACS BACK
POPJ P,
NOANS: TRO A,NOJOY
POPJ P, ;RETURN
COMMENT ⊗DELWRQ -- delete all wait requests⊗
;EXPECTS PB = THIS PROCESS
;MANGLES A,B,C,TABL
DELWRQ: SKIPN A,WAITES(PB)
POPJ P,
PUSH P,KL
MOVE A,(A) ;A IS LAST,,FIRST
DTHSRQ: MOVE A,(A) ;NEXT ENTRY
HLRZ C,A ;ITEM NUMBER OF TYPE
PUSH P,A ;FOR SAFE KEEPING
MOVE TABL,GOGTAB ;
GLOB <
;;%BE%
CAIL C,GBRK ;GLOBAL ??
MOVEI TABL,GLUSER ;
>;GLOB
MOVE A,@DATAB(TABL)
MOVEI KL,WAITLS(A)
MOVE B,PRCITM(PB)
PUSHJ P,DELTLE ;DELETE ELEMENT
;SETS TABL BACK TO GOGTAB
;(MAYBE)
POP P,A
TRNE A,-1 ;ANY LEFT
JRST DTHSRQ ;YES
MOVE A,WAITES(PB)
MOVE TABL,GOGTAB
HLRZ B,(A) ;ADDRESS OF LAST
HRRZ C,FP1(TABL)
HRRM C,(B) ;RELEASE THE LOT
HRRM A,FP1(TABL)
SETZM WAITES(PB) ;NONE LEFT
POP P,KL
POPJ P,
COMMENT ⊗INTERROGATE⊗
HERE(INTERROGATE)
SKIPN B,-2(P) ;SET OR ITEM
ERR <NULL INTERROGATION???>
TLNN B,-1 ;SET?
JRST ASK1.0 ;NO
MOVEI FF,MULTIN
IORM FF,-1(P) ;SAY MULT REQUEST
MOVE TMP,(B) ;LAST,,FIRST
MPCI: MOVE TMP,(TMP) ;NEXT ENTRY
HLRZ B,TMP
PUSH P,TMP
PUSH P,B ;TYPE ITEM
PUSH P,-3(P) ;OPTIONS WORD
PUSHJ P,ASK1.0
POP P,TMP ;GET LIST BACK
CAIE A,NIC ;FIND ONE??
JRST ASK1.X ;YES
TRNE TMP,-1 ;DONE LIST???
JRST MPCI ;NO
MOVE FF,-1(P)
TRNN FF,WAIT ;WAITING REQUESTED
JRST ASK1.X ;NO
MOVE PB,RUNNER ;SUSPEND SELF
MOVE B,-2(P) ;THE LIST
MOVE TMP,(B) ;LAST,,FIRST
BWL: MOVEI KL,WAITES(PB)
MOVE TMP,(TMP) ;NEXT
HLRZ B,TMP ;ITEM NO
MOVE C,B
MOVE EVT,@DATM
PUSHJ P,ITAILS ;ON TAIL
MOVE B,PRCITM(PB) ;
MOVEI KL,WAITLS(EVT)
PUSHJ P,ITAILS ;ON EVENT WAIL LIST
TRNE TMP,-1
JRST BWL ;CDR DOWN LIST
JRST DOWAIT ;GO WAIT
COMMENT ⊗ASK -- used by INTERROGATE⊗
ASK1I: MOVE B,-2(P)
ASK1.0: JSP TMP,EVTCKB ;GET DATUM OF EVENT TYPE
;;#NB# ! WAS SKIPE A,...
SKIPE PDA,INTRGP(EVT) ;USER WAIT PROCESS??
JRST USPPRC ;YES
;;# #! ASKNTC POINTS HERE
ASKN: MOVE FF,-1(P) ;CONTROL WORD
SKIPN A,NOTCLS(EVT) ;ANY READY TO GO
JRST ASK1.4 ;NO
TRNE FF,RETAIN ;RETAIN THIS ONE??
JRST ASK1.1 ;YES
MOVEI KL,NOTCLS(EVT)
PUSHJ P,REMCAR ;GET THE FIRST
JRST ASK1.2 ;TEST SAYWCH
ASK1.1: MOVE A,(A)
HLRZ A,(A) ;THI FIRST ITEM
ASK1.2: TRNN FF,SAYWCH ;WANT ASSOCIATION
JRST ASK1.3 ;NO
PUSH P,[EVTYPI] ;EVENT TYPE
PUSH P,A ;NOTICE
PUSH P,-4(P) ;WHATEVER TYPE IT IS
PUSHJ P,STACSV ;SAVE REGS
MOVEI 5,16 ;MAKE
PUSHJ P,LEAP
PUSHJ P,STACRS ;GET ACS BACK
ASK1.3:
ASK1.X: SUB P,X33
JRST @3(P) ;RETURN
ASK1.4: MOVEI A,NIC
TRNE FF,WAIT ;IF NOT WAITING OR
TRNE FF,MULTIN ;MUL REQ
JRST ASK1.X ;ALL DONE
MOVE PB,RUNNER
MOVEI KL,WAITES(PB) ;WAIT ON THIS ONE
PUSHJ P,ITAILS ;PUT ON TAIL
MOVE B,PRCITM(PB)
MOVEI KL,WAITLS(EVT)
PUSHJ P,ITAILS
DOWAIT: SETZM STATUS(PB)
MOVEM FF,INTRGC(PB)
MOVEI A,WAITNG
MOVEM A,REASON(PB)
PUSHJ P,SPSRN2 ;WAIT
JRST ASK1.X ;RETURN
HERE(ASKNTC)
;;#NC# ! WAS A PUSHJ
JSP TMP,EVTCK3 ;CHECK EVENT TYPE
JRST ASKN ;GO DO IT
;ROUTINE TO SET UP EVENT TYPE ITEM
;SETS B & C TO ITEM #
;SETS EVT TO DATUM
;SETS TABL TO RIGHT THING FOR ITEM
;CALLED VIA JSP TMP,EVTCKX
EVTCK3: SKIPA B,-3(P)
EVTCK2: MOVE B,-2(P)
EVTCKB: MOVE TABL,GOGTAB
MOVE C,B
GLOB <
;;%BE% allow for global items RHT 1-8-74
CAIL C,GBRK ;IS THE ITEM GLOBAL
MOVEI TABL,GLUSER ;YES, USE GLOBAL INFO STUFF
>;GLOB
LDB A,INFOTAB(TABL)
CAIE A,EVTTYP
ERR <THIS ITEM IS NOT AN EVENT TYPE>,6
MOVE EVT,@DATAB(TABL)
GLOB <
;;%BE% real hack for now, only the item gets to be global.
MOVE TABL,GOGTAB
>;GLOB
JRST (TMP)
COMMENT ⊗MKEVTT,SETCP,& SETIP⊗
HERE(SETCP)
JSP TMP,EVTCK2
MOVE A,-1(P)
MOVEM A,CAUSEP(EVT)
XIT3: SUB P,X33
JRST @3(P)
HERE(SETIP)
JSP TMP,EVTCK2
MOVE A,-1(P)
MOVEM A,INTRGP(EVT)
JRST XIT3
HERE(MKEVTT) ;MAKE EVENT TYPE
MOVE C,-1(P)
MOVEI A,EVTTYP
MOVE TABL,GOGTAB
DPB A,INFOTAB(TABL)
MOVEI C,NEVARS
PUSHJ P,CORGET
ERR <NO CORE LEFT -- MKEVT>
MOVE C,-1(P)
MOVE TABL,GOGTAB
MOVEM B,@DATAB(TABL)
HRLI D,(B)
HRRI D,1(B)
SETZM (B)
BLT D,NEVARS-1(B)
SUB P,X22
JRST @2(P)
COMMENT ⊗SPARE HERE TABLE ENTRIES⊗
;THE IDEA IS THAT THIS WAY WE HAVE FLEXIBILITY
;WITHOUT GOING TO A NEW SEGMENT ALL THE TIME
HERE(NWLD1)
HERE(NWLD2)
HERE(NWLD3)
HERE(NWLD4)
HERE(NWLD5)
ERR <DRYROT IN NWORLD>
BEND PROCSS
ENDCOM(PRC)
COMPIL(IRP,,,,,,DUMMYFORGDSCISS)
NOTENX <
DEFINE IENS1 < INTTBL,INTMOD,ENABLE,DISABLE,INTMAP>
>;NOTENX
TENX <
DEFINE IENS1 < INTTBL,ENABLE,DISABLE,ATI,DTI,INTMAP,EINTA>
>;TENX
DEFINE IEXT1 < GOGTAB,INTRPT,X22,CORGET >
IFN APRISW <
DEFINE XJBCNI <JOBCNI>
DEFINE XJBTPC <JOBTPC>
DEFINE XJBAPR <JOBAPR>
DEFINE IEXT5 <JOBCNI,JOBTPC,JOBAPR,XJBENB,APRACS>
IFN ALWAYS <
EXTERN JOBCNI,JOBTPC,JOBAPR ;THESE ARE ALWAYS EXTERNAL
>;IFN ALWAYS
>;IFN APRISW
IFE APRISW <
DEFINE IEXT5 <XJBCNI,XJBTPC,XJBAPR,JOBINT>
IFN ALWAYS <
EXTERNAL JOBINT ;THIS FELLOW IS ALWAYS EXTERNAL
>;IFN ALWAYS
>;IFE APRISW
COMPXX(IRP,< IENS1 >,< IEXT1,IEXT5 >
,<INTERRUPT STUFF>,,HIIFPOSSIB)
BEGIN IRPPKG
INTDBG←←0
NOTENX<
IFE APRISW <
IFE INTDBG <
OPDEF DISMIS [ CALLI 400024]
>;IFE INTDBG
IFN INTDBG <
DEFINE DISMIS < JRST DSMMSR >
DSMMSR:
HRLZI P,INACS
BLT P,P
JRST @JOBTPC
INACS: BLOCK 20
>;IFN ITDBG
OPDEF INTORM [ CALLI 400026]
OPDEF INTACM [ CALLI 400027]
OPDEF INTENB [ CALLI 400025]
>;IFE APRISW
IFN APRISW <
OPDEF APRENB [ CALLI 16]
DEFINE DISMIS < JRST DSMSSR >
DSMSSR: HRLZI 17,APRACS
BLT 17,17 ;BLT BACK ALL ACS
JRST @XJBTPC
>;IFN APRISW
>;NOTENX
HERE(INTTBL)
;CALL IS INTTBL(BUFFER!SIZE)
;SETS UP TABLES NEEDED BY THE INTERRUPT SYSTEM
;ON TENEX, SEE DFEINT FOR OTHER TABLES OMITTED HERE
MOVE USER,GOGTAB ;
INTTB1:
NOTENX <
MOVEI C,=110
ADD C,-1(P)
>;NOTENX
TENX <
MOVE C,-1(P)
>;TENX
PUSHJ P,CORGET
ERR <NOT ENOUGH SPACE FOR INTSET>
NOTENX <
SKIPN D,DISPAT(USER) ;ALREADY HABE ONE?
JRST INTTB2 ;NO
MOVSS D
HRR D,B ;D ← OLD,,NEW
BLT D,=71(B) ;COPY OLD DISPAT TABLE
JRST INTTB3
INTTB2: SETZM (B)
HRL A,B
HRRI A,1(B)
ADDI C,-1(B)
BLT A,(C)
INTTB3: HRLI B,10
MOVEM B,DISPAT(USER)
ADDI B,=36
MOVEM B,DFRINF(USER)
ADDI B,=36
>;NOTENX
HRRZM B,INTQWB(USER)
HRRZM B,INTQWP(USER)
HRRZM B,INTQRP(USER)
ADD B,-1(P)
HRRZM B,INTQWT(USER)
NOTENX <
HRLI B,-20
MOVEM B,IPDP(USER)
ADD B,[XWD -10,20]
MOVEM B,ISPDP(USER)
>;NOTENX
SUB P,X22
JRST @2(P)
NOTENX <
;AGAIN SEE DFEINT FOR TENEX EQUIVALENT OF FOLLOWING STUFF.
IFN INTDBG,<
INTAPR: MOVEM P,INACS+17
MOVEI P,INACS
BLT P,INACS+16
>;IFN INTDBG
HERE(INTMOD)
IFN APRISW <
MOVEM 17,APRACS+17
MOVEI 17,APRACS
BLT 17,APRACS+16 ;SAVE THE ACS
>;IFN APRISW
MOVE USER,GOGTAB
MOVE 7,XJBCNI ;PICK UP THE BITS
IFN APRISW <
ANDI 7,235110 ;BE SURE LEGIT BITS ONLY
>;IFN APRISW
MOVE P,IPDP(USER) ;A PDL FOR THIS
MOVE SP,ISPDP(USER) ;A STRING PDL
DSPIT: JFFO 7,DODISP ;DISPATCH INDEX
ERR <DRYROT: INTMOD>
DODISP:
SKIPN 7,@DISPAT(USER) ;GO DISPATCH
DISMIS ;DISMISS
PUSHJ P,(7) ;
DISMIS
>;NOTENX
COMMENT ⊗PROCEDURES TO ENABLE FOR INTERRUPTS⊗
;ENABLE(INDEX) -- DOES AN INTORM, OR AIC ON TENEX
;DISABLE(INDEX) -- DOES AN INTACM, OR DIC ON TENEX
NOTENX <
IFE APRISW <
HERE(ENABLE)
SKIPA B,[ INTORM A, ]
HERE(DISABLE)
MOVE B,[ INTACM A, ]
MOVN C,-1(P)
HRLZI A,400000
LSH A,(C)
XCT B
SUB P,X22
JRST @2(P)
>;IFE APRISW
IFN APRISW <
HERE(ENABLE)
SKIPA B,[OR A,XJBENB]
HERE(DISABLE)
MOVE B,[ANDCA A,XJBENB]
MOVN C,-1(P) ;
HRLZI A,400000
LSH A,(C) ;THE BIT
EXPO <
TRO A,400000 ;REPETITIVE ENABLE (THIS MIGHT GET YOU
;IN TROUBLE WITH THE CLOCK INTERRUPT)
>;EXPO
XCT B
MOVEM A,XJBENB ;REMEMBER
APRENB A,
SUB P,X22
JRST @2(P)
>;IFN APRISW
>;NOTENX
TENX <
HERE(ENABLE)
SKIPA C,AIC1
HERE(DISABLE)
MOVE C,DIC1
MOVN A,-1(P)
HRLZI B,400000
LSH B,(A)
HRRZI A,400000 ;Fork handle for 'this fork'
XCT C
SUB P,X22
JRST @2(P)
AIC1: JSYS AIC
DIC1: JSYS DIC
HERE(DTI)
HRRZ A,-1(P) ;CHARACTER TO DE-ACTIVATE
JUMPL A,DTIERR
CAILE A,=35
DTIERR: ERR <DTI: Terminal interrupt code not in range>
JSYS DTI
SUB P,X22
JRST @2(P)
HERE(ATI)
HRRZ B,-2(P) ;1ST ARG IS "TERMINAL INTERRUPT CODE"
JUMPL B,.+2 ;31-35 UNUSED, 0 IS BREAK OR ↑@
CAILE B,=35 ;OTHERS OUT OF RANGE
ERR <ATI: Terminal Interrupt Code not in range>,1
MOVE A,-1(P) ;2nd arg is interrupt channel, 0-35
JUMPL A,BADCHN
CAILE A,=35
JRST BADCHN
CAIGE A,=24
CAIG A,=5
SKIPA
BADCHN: ERR <ATI: Term. Intrpt. Chnl. not 0-5 or 24-35 dec.>,1
HRL A,B ;MAKE XWD TERMINAL CODE, CHANNEL NUMBER
JSYS ATI
SUB P,X33
JRST @3(P)
ATI1: JSYS ATI
DTI1: JSYS DTI
;To arm a keybd interrupt on TENEX you must do the ATI in addition
;to the regular stuff (INTMAP's & ENABLE's) because any channel which
;can take a keybd interrupt (namely 0-5 and 24-35) can take any
;interrupt character so you must declare.
>;TENX
;INTMAP(INDEX,ENTRY!ADDR,PARAM);
NOTENX <
;DISPAT[INDEX]←ENTRY!ADDR
;DFRINF[INDEX]←PARAM
HERE(INTMAP)
IFE APRISW <
MOVEI A,XJBCNI
MOVEM A,JOBINT
>;IFE APRISW
IFE INTDBG,<
MOVEI A,INTMOD
>;IFE INTDBG
IFN INTDBG,<
MOVEI A,INTAPR
>;IFN INTDBG
MOVEM A,XJBAPR
MOVE USER,GOGTAB
SKIPE DISPAT(USER)
JRST .+3
PUSH P,[=128]
PUSHJ P,INTTB1 ;GET MINIMAL TABLES
MOVE 10,-3(P) ;GET INDEX
POP P,-3(P) ;RET ADR
POP P,@DFRINF(USER)
POP P,@DISPAT(USER)
POPJ P,
>;NOTENX
TENX <
HERE(INTMAP)
HRRZI A,400000
JSYS RIR
JUMPE 2,[MOVE 2,[XWD LEVTAB,CHNTAB]
JSYS SIR
JRST .+1]
JSYS EIR ;ENABLE INTERRUPT SYSTEM IN GENERAL
SKIPL A,-3(P) ;CHNL
CAILE A,=35
ERR <INTMAP: Channel # not between 0 and 35 dec.>
;The CHNL'th word of the actual TENEX channel table gets the value
; LVL,,jmpchn-slot The LVL is the interrupt level. The
;dispatch is to the parallel entry of JMPCHN, a table of 3-word slots,
;one per channel, addressed by the XX var JMPCHN, each of which
;looks like this if the channel is in use:
; JSA USER,EINT<N>
; Ptr to simple-procedure ;POPJ'D TO IN EINTA
; AOBJN ptr for calling block
;
;The EINTn is EINT1, EINT2, or EINT3, depending on the level of
;the interrupt. INTMAP always initializes an interrupt to level 3,
;i.e. EINT3, but in the future a subr may be provided to change the level
;after the INTMAP is done (or perhaps an argument to INTMAP).
;The three EINT's all immediately jrst to EINTA, but each must have
;its own return vector for reentrancy's sake.
ADDI 2,(A) ;2 pts to CHNTAB slot.
IMULI A,3
ADDI A,JMPCHN ;A pts to JMPCHN slot.
HRLI A,3 ;Level 3 assumed.
MOVEM A,(2) ;CHNTAB[chnl]←level3,,JMPCHN[3*chnl]
POP P,-3(P) ;Return goes over 1st arg (chnl)
POP P,2(A) ;3rd INTMAP arg, AOBJN ptr, to 3rd
;word of JMPCHN slot. DFRINT uses it.
POP P,1(A) ;2nd JMPCHN wrd gets XWD unused,user's simple
;procedure. Goes onto stack and is POPJ'd to.
MOVE B,[JSA USER,EINT3] ;Level 3 assumed.
MOVEM B,(A) ;1st JMPCHN slot word.
POPJ P,
;EINT1, EINT2, and EINT3 are in the XX table since they get JSA'd to.
;Each immediately JRST's to EINTA so that all share the code thru the
;DEBRK in EINTR. Note that the TENEX DEBRK call is the normal way to
;leave interrupt level whether continuing normally or forcing continuation
;at a specified place (this is different than Stanford's DEBRK call).
;The following code saves all accumulators because that's what the DEC
;monitor does and any other solution would have destroyed all semblance of
;compatibility between DECUS or Stanford SAIL and TENEX SAIL.
;Note however that the work of saving AC's has to be done somewhere
;if you are going to run SAIL code at interrupt level; and if you want to
;hack a very fast interrupt in machine language you can easily do it yourself
;by using RIR to find the channel table and so on.
;
;A few more stack words than are really necessary are covered by the
;ADD P,[XWD 21,21] deliberately, in order to leave some room in case the
;interrupted code was not observing stack discipline religiously, because
;it is fairly common in the SAIL system to see routines end with sequences like:
; SUB P,X44
; JRST 4(P)
;
;One non-obvious trick here is that the BLT's which save and restore ac's
;save and restore a clobbered value of USER, because the value of USER which
;prevailed in the nterrupted code is saved by the JSA/JRA pair around the
;whole mess. Finally it may be helpful to note that at the point just before
;EINTR, i.e. the POPJ, the top of the stack contains:
;0(P) USERCODE ;addr. of his simple procedure, so that we
;"call" it with POPJ
;-1(P) AOBJN ptr ;to the "calling block" parameters to his code
;-2(P) EINTR ;Fake return so his stuff returns to us.
;We also save 40 for reentrancy since his simple procedure may
;use compiler-emitted UUO's like any other code and thus clobber UUO's in
;progres in the interrupted code (obviously).
HERE(EINTA)
ADD P,[XWD 23,23]
TLNN P,400000 ;TEST FOR PDL OVERFLOW
ERR <EINTA: PDL overflow>
MOVEM 16,0(P)
HRRZI 16,-15(P)
BLT 16,-1(P)
MOVE 16,0(P)
PUSH P,40
PUSH P,1(USER) ;AOBJN PTR
PUSH P,[EINTR] ;FAKE RETURN TO REGAIN CONTROL FROM USERCODE
PUSH P,(USER) ;USERCODE
MOVE USER,GOGTAB
POPJ P, ;GO OFF TO RUN HIS STUFF AT INTERRUPT LEVEL
;IT RETURNS HERE BY VIRTUE OF FAKE RETURN WORD
EINTR: POP P,40
HRLZI 16,-15(P)
BLT 16,15
MOVE 16,0(P)
SUB P,[XWD 23,23]
JRA USER,.+1
JSYS DEBRK ;BACK TO INTERRUPTED CODE
>;TENX
HERE(IRPSP1)
HERE(IRPSP2)
HERE(IRPSP3)
BEND IRPPKG
ENDCOM(IRP)