perm filename NWORLD.OLD[S,AIL]1 blob
sn#010864 filedate 1972-11-15 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00025 PAGES
RECORD PAGE DESCRIPTION
00001 00001
00007 00002 MANY DECLARATIONS
00012 00003 PROCESS VARIABLE NUMBERS
00015 00004 event variables
00016 00005 procedure descriptors & null process skeleton
00018 00006 DSCR SPROUT -- THE PROCESS SPROUTER
00022 00007
00028 00008
00029 00009 routines for inserting & deleting set elements
00033 00010 USER REQUESTED SCHEDULING
00037 00011 RESUME
00039 00012 SUSPEND and TERMINATE runtime routines
00042 00013 The JOIN runtime routine
00044 00014 THE MAIN PROCESS INITIALIZER
00046 00015 CALLER AND MYPROC
00047 00016 SPECIAL GC ROUTINE FOR PROCESSES
00048 00017 TIMER & OTHER INTERRUPTS
00049 00018 CAUSE
00051 00019 CAUSE1 -- ROUTINE TO DO ACTUAL WORK
00054 00020 ANSWER -- subroutine used by CAUSE
00056 00021 DELWRQ -- delete all wait requests
00057 00022 INTERROGATE
00059 00023 ASK -- used by INTERROGATE
00062 00024 MKEVTT,SETCP,& SETIP
00063 00025
00064 ENDMK
⊗;
; MANY DECLARATIONS
COMPIL(PRC,,,,,,DUMMYFORGDSCISS)
DEFINE ENS1 < SPROUT,URSCHD,RESUME,SUSPEND,TERMINATE,JOIN,MAINPR,CALLER>
DEFINE ENS2 <%PSSGC,POLL,INTSET,INTMOD,CAUSE,ANSWER,INTERROGATE,SETCP>
DEFINE ENS3 <MKEVTT,SETIP,MYPROC>
DEFINE EXT1 <JOBAPR,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>
COMMENT ⊗THIS IS FOR THE STUPIDITY OF SCISS ⊗
COMPXX(PRC,<ENS1,ENS2,ENS3>,<EXT1,EXT2,EXT3>
,<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
STPSZ← 200 ;DEFAULT P- STACK SIZE (MINUS THE PROCESS TABLE AREA)
STSPST ←100 ;DEFAULT SP STACK SIZE
STDQNT ←← 2 ;DEFAULT (LOG2(QUANTUM)) -- STD QUANTUM IS 4
STDPRI ←←7 ;DEFAULT PRIORITY
; (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)
>
OPDEF INTENS [ CALLI 400031]
OPDEF IWAIT [ CALLI 400040]
;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 => ONLY NEED ACS F,SP,P)
PVAR PLISTE ;PRIORITY LIST ENTRY
PVAR RSMR ;THE GUY WHO RESUMED ME
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),<
RELOC LCN+FLXXX
V
RELOC
>
;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
TRNE OPTS,SSSMSK ;SPECIFIED SP STACK SIZE ?
JRST [ LDB C,SSSBYT ;YES, GET IT
LSH C,5 ;TIMES 32
JRST .+2 ]
MOVEI C,STSPST ;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
ADDI C,STKBAS;SPACE FOR BASE
JRST .+2]
MOVEI C,STPSZ+STKBAS ;STANDARD AMOUNT TO GET
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)
;BUILD MSCP, ETC.
MOVEM RF,DYNL(PB) ;
HRLI RF,SPRPDA
MOVEM RF,STATL(PB) ;MAKE LINKS THE SAME
MOVEM NSP,ISP(PB) ;
;COPY PROC PARAMS
POP P,PDA ;FIND OUT WHO
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
MOVEI A,STDQNT ;STANDARD QUANTUM
TLNE OPTS,QNTMSK ;GET LOG2 QUANTUM
LDB A,QNTBYT
MOVEI TMP,1
LSH TMP,(A)
MOVEM TMP,QUANTM(PB)
MOVEI A,STDPRI ;ASSUME STD PRIORITY
TRNE OPTS,PRIMSK ;SAID OTHERWISE?
LDB A,PRIBYT
PUSHJ P,SETPRI ;GO SET PRIORITY
;SET UP PROCESS ITEM
POP P,B ;PICK UP ITEM #
MOVEM B,PRCITM(PB) ;REMEMBER IT
MOVEI A,PRCTYP ;SAY IS OF TYPE PROCESS
COMMENT **** MAY WANT TO WORRY HERE ABOUT GLOBAL ITEMS **** ;
HRRZM A,@INFTB ;SAY IS A PROCESS
MOVE C,B ;
HRRZM PB,@DATM ;SET DATUM VALUE
;KILL SET STUFF
MOVEM KL,KLOWNR(PB) ;REMEMBER KILL LIST OWNER
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
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 →→ 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 KL,KLOWNR(PB) ;GET OWNER OF KILL SET
HRRZ B,PRCITM(PB)
MOVE C,B ;
TLO PB,TERM ;SET TERM BIT
MOVEM PB,@DATM ;TERMINATED
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,@DATM ;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
CPOPJ: 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 → ME
TLNN B,-1 ;WAS THE LIST EMPTY ??
HRLM PB,PRILIS(A) ;YES -- THIS IS THE TAIL TOO
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
IHEDLS: SKIPN A,(KL) ;INSERT AT HEAD
JRST NEWINS
JRST NI
ITAILS: 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 →→ 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,,→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
INTENS B, ;GET INTERRUPT ENABLING
TLNN B,775200 ;IS HE ENABLED FOR SOMETHING
;THAT CAN STILL HAPPEN
ERR <NO ONE TO RUN> ;NO
IWAIT ;WAIT FOR AN INTERRUPT
SETZM INTRPT ;ZERO THE FLAG
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 →→ RESTORE P, SP, F
RSTACS ;1 →→ RESTORE ALL ACS
RPSPF ;2 →→ FROM JOINER
RST1 ;3 →→ 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
;RESUME
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,B ;WHO
MOVE C,@INFTB ;TEST THE TYPE
CAIE C,PRCTYP ;IS THE TYPE A PROCESS
ERR <ATTEMPT TO RESUME SOMETHING NOT A PROCESS>
MOVE C,B
MOVE PB,@DATM ;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
MOVEM P,ACP(USER) ;SAVE NEEDFUL REGISTERS
MOVEM RF,ACF(USER)
MOVEM SP,ACSP(USER)
SETZM REASON(USER) ;ONTL P, SP, F IMPORTANT
MOVE P,ACP(PB) ;SET UP REGISTERS FOR THIS
MOVE RF,ACF(PB)
MOVE SP,ACSP(PB)
;***** IGNORE OPTIONS FOR NOW *****
SETZM STATUS(USER)
SETOM STATUS(PB)
MOVEM PB,RUNNER
;*******************
JRST @PCW(PB) ;GO TO IT
COMMENT ⊗SUSPEND and TERMINATE runtime routines⊗
HERE(SUSPEND)
MOVE B,-1(P) ;THE ITEM
POP P,-1(P) ;BACK UP RETN ADDR
MOVE C,@INFTB
CAIE C,PRCTYP ;BE SURE A PROCESS ITEM
ERR <ATTEMPT TO SUSPEND A NON PROCESS ITEM>
MOVE C,B
MOVE PB,@DATM
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
POPJ P,
HERE(TERMINATE)
MOVE B,-1(P)
MOVE C,@INFTB ;IS HE A PROCESS
CAIE C,PRCTYP
ERR <TERMINATING A NON-PROCESS>
MOVE C,B ;FOR DATUM
MOVE PB,@DATM ;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 B,(A) ;THE ITEM NUMBER
MOVE C,@INFTB ;GET TYPE
CAIE C,PRCTYP ;PROCESS?
ERR <ATTEMPT TO DO JOIN ON NON-PROCESS>
MOVE C,B
MOVE B,@DATM ;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⊗
↑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 B,MAINPI ;THE MAIN PROCESS ITEM NUMBER
MOVEI A,PRCTYP ;MAKE A PROCESS
MOVEM A,@INFTB
MOVE C,B
HRRZM PB,@DATM
MOVEM C,PRCITM(PB)
MOVEI A,[0]
MOVEM A,KLOWNR(PB) ;NASTY
SETOM STATUS(PB) ;I AM THE RUNNER
MOVEI A,STDPRI ;STANDARD 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 AND MYPROC ⊗
HERE(CALLER)
EXCH B,-1(P) ;ITEM NUMBER -- SAVE OLD B
HRRZ A,@INFTB
CAIE A,PRCTYP
ERR <NOT A PROCESS ITEM>
EXCH C,B
EXCH B,-1(P)
MOVE A,@DATM
TLNE A,TERM
ERR <PROCESS IS TERMINATED>
MOVE A,RSMR(A)
EXCH C,-1(P)
SUB P,X22
JRST @2(P)
HERE(MYPROC)
MOVE USER,RUNNER
MOVE A,PRCITM(USER)
POPJ P,
COMMENT ⊗SPECIAL GC ROUTINE FOR PROCESSES⊗
HERE(%PSSGC)
MOVE TEMP,RUNNER
MOVEM SP,ACSP(TEMP)
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
MOVE SP,ACSP(TEMP)
POPJ P,
COMMENT ⊗ TIMER & OTHER INTERRUPTS⊗
HERE(POLL);
SKIPN TEMP,INTRPT ;WERE WE INTERRUPTED
POPJ P, ;NO
MOVEI A,1
ANDCAM A,INTRPT
JRST URSCHD ;FOR NOW
HERE(INTSET)
MOVEI A,INTMOD
MOVEM A,JOBAPR
TIEMB: HRLZI A,000200 ;INTCLK BIT(I THINK)
CALLI A,400026 ;INTORM
POPJ P,
HERE(INTMOD)
MOVE USER,GOGTAB
SOSLE TIMER(USER)
JRST DSMSIT
MOVEI A,1
IORM A,INTRPT
DSMSIT: CALLI 400024 ;DISMIS
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 ⊗
CAUSE1: 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
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
TLNE 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,B ;PROCESS ITEM
POP P,D ;NOTICE
MOVE C,@INFTB ;VERIFY PROCESS ITEM
CAIE C,PRCTYP
ERR <NOT A PROCESS ITEM>
MOVE C,B
;THE REST OF THIS IS CALLED INTERNALLY
;EXPECTS D= NOIICE, C=PROCESS ITEM, TEMP=EV TYPE
;MODIFIES A,B,C,TABL,PB
ANSWR1: MOVE PB,@DATM ;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 A,@DATM
MOVEI KL,WAITLS(A)
MOVE B,PRCITM(PB)
PUSHJ P,DELTLE ;DELETE ELEMENT
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
SKIPE A,INTRGP(EVT) ;USER WAIT PROCESS??
JRST USPPRC ;YES
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
;ROUTINE TO SET UP EVENT TYPE ITEM
;SETS B & C TO ITEM #
;SETS EVT TO DATUM
;CALLED VIA JSP TMP,EVTCKX
EVTCK3: SKIPA B,-3(P)
EVTCK2: MOVE B,-2(P)
EVTCKB: MOVE A,@INFTB
CAIE A,EVTTYP
ERR <THIS ITEM IS NOT AN EVENT TYPE>,6
MOVE C,B
MOVE EVT,@DATM
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 B,-1(P)
MOVEI A,EVTTYP
MOVEM A,@INFTB
MOVEI C,NEVARS
PUSHJ P,CORGET
ERR <NO CORE LEFT -- MKEVT>
MOVE C,-1(P)
MOVEM B,@DATM
HRLI D,(B)
HRRI D,1(B)
SETZM (B)
BLT D,NEVARS-1(B)
SUB P,X22
JRST @2(P)
BEND PROCESS
ENDCOM(PRC)