perm filename NWORLD[S,AIL]5 blob
sn#015980 filedate 1972-12-09 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00029 PAGES VERSION 16-2(15)
RECORD PAGE DESCRIPTION
00001 00001
00007 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
00025 00008
00032 00009
00033 00010 routines for inserting & deleting set elements
00037 00011 USER REQUESTED SCHEDULING
00041 00012 HERE(RESUME)
00045 00013 SUSPEND and TERMINATE runtime routines
00048 00014 The JOIN runtime routine
00050 00015 THE MAIN PROCESS INITIALIZER
00052 00016 CALLER , MYPROC, AND PSTATUS
00054 00017 PRISET -- ROUTINE USER CALLS TO CHANGE PRIORITY
00055 00018 SPECIAL GC ROUTINE FOR PROCESSES
00056 00019 INTERRUPT ROUTINES
00062 00020 THE INTERRUPT PROCESS
00065 00021 PROCEDURES TO ENABLE FOR INTERRUPTS
00068 00022 CAUSE
00070 00023 CAUSE1 -- ROUTINE TO DO ACTUAL WORK
00073 00024 ANSWER -- subroutine used by CAUSE
00075 00025 DELWRQ -- delete all wait requests
00076 00026 INTERROGATE
00078 00027 ASK -- used by INTERROGATE
00081 00028 MKEVTT,SETCP,& SETIP
00082 00029 SPARE HERE TABLE ENTRIES
00083 ENDMK
⊗;
COMMENT ⊗HISTORY
AUTHOR,REASON
021 202000000017 ⊗;
COMMENT ⊗
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
COMPIL(PRC,,,,,,DUMMYFORGDSCISS)
DEFINE ENS1 < SPROUT,URSCHD,RESUME,SUSPEND,TERMINATE,JOIN,MAINPR,CALLER>
DEFINE ENS2 <%PSSGC,DDFINT,INTSET,INTMOD,CAUSE,ANSWER,INTERROGATE,SETCP>
DEFINE ENS3 <MKEVTT,SETIP,MYPROC,INTTBL,CLKMOD,DFR1IN,DFRINT,INTPRO>
DEFINE ENS4 <ENABLE,DISABLE,INTMAP,DFCPKT,PSTATUS>
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,NOPOLL>
DEFINE EXT4 <DEFSSS,DEFPSS,DEFPRI,DEFQNT>
COMMENT ⊗THIS IS FOR THE STUPIDITY OF SCISS ⊗
COMPXX(PRC,<ENS1,ENS2,ENS3,ENS4>,<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 --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)
>
OPDEF INTENS [CALLI 400030]
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 ]
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)
;BUILD MSCP, ETC.
POP P,PDA ;FIND OUT WHO
SETZM DYNL(PB) ;NULL DYN LINK
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 →→ 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 → 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
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,775204 ;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
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) ;
JRST @PCW(PB) ;
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
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)
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 ⊗INTERRUPT ROUTINES⊗
INTDBG←←0
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]
HERE(DDFINT) ;DO DEFERRED INTERRUPT
SKIPE NOPOLL ;IGNORING IT?
POPJ P, ;YES
SETZM INTRPT ;
MOVE USER,RUNNER ;NEED TO SAVE ACS
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
PUSHJ P,INTTBG ;BE SURE HAVE TABLES
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)
INTTBG: MOVE USER,GOGTAB ;
SKIPE DISPAT(USER) ;HAVE TABLES???
POPJ P, ;YES
PUSH P,[=128] ;DEFAULT BUFFER SIZE
PUSHJ P,INTTB1 ;GO GET EM
POPJ P,
HERE(INTTBL)
;CALL IS INTTBL(BUFFER_SIZE)
;SETS UP TABLES NEEDED BY THE INTERRUPT SYSTEM
MOVE USER,GOGTAB ;
INTTB1: MOVEI C,=100
ADD C,-1(P)
PUSHJ P,CORGET
ERR <NOT ENOUGH SPACE FOR INTSET>
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
HRRZM B,INTQWB(USER)
HRRZM B,INTQWP(USER)
HRRZM B,INTQRP(USER)
ADD B,-1(P)
HRRZM B,INTQWT(USER)
HRLI B,-20
MOVEM B,IPDP(USER)
SUB P,X22
JRST @2(P)
TIEMB: HRLZI A,000200 ;INTCLK BIT(I THINK)
CALLI A,400026 ;INTORM
POPJ P,
IFN INTDBG,<
INTAPR: MOVEM P,INACS+17
MOVEI P,INACS
BLT P,INACS+16
>;IFN INTDBG
HERE(INTMOD)
MOVE USER,GOGTAB
MOVE 7,JOBCNI ;PICK UP THE BITS
MOVE P,IPDP(USER) ;A PDL FOR THIS
DSPIT: JFFO 7,DODISP ;DISPATCH INDEX
ERR < DRYROT IN INTMOD >
DODISP: SKIPN 7,@DISPAT(USER) ;GO DISPATCH
DISMIS ;DISMISS
PUSHJ P,(7) ;
DISMIS
HERE(CLKMOD)
MOVE USER,GOGTAB ;
SOSG TIMER(USER) ;IF COUNTDOWN COMPLETE THEN
SETOM INTRPT ;SIGNAL THE INTERRUPT
POPJ P, ;LET CALLER DISMIS
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 11,INTQWP(USER)
IQW 1
IQW 6
MOVE TEMP,JOBCNI
IQW TEMP
MOVE TEMP,JOBTPC
IQW TEMP
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)
PUSH P,@DFRINF(USER)
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 >);
IQR 6
IQR TEMP
MOVEM TEMP,IJBCNI(USER)
IQR TEMP
MOVEM TEMP,IJBTPC(USER)
IQR TEMP
MOVEM TEMP,IRUNNR(USER)
IQR B
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>)
COMMENT ⊗PROCEDURES TO ENABLE FOR INTERRUPTS⊗
;ENABLE(INDEX) -- DOES AN INTORM
;DISABLE(INDEX) -- DOES AN INTACM
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)
;INTMAP(INDEX,ENTRY_ADDR,PARAM);
;DISPAT[INDEX]←ENTRY_ADDR
;DFRINF[INDEX]←PARAM
HERE(INTMAP)
IFE INTDBG,<
MOVEI A,INTMOD
>;IFE INTDBG
IFN INTDBG,<
MOVEI A,INTAPR
>;IFN INTDBG
MOVEM A,JOBAPR
PUSHJ P,INTTBG ;BE SURE HAVE TABLES
MOVE 10,-3(P) ;GET INDEX
POP P,-3(P) ;RET ADR
POP P,@DFRINF(USER)
POP P,@DISPAT(USER)
POPJ P,
;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 ⊗
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
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
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,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 ;
MOVE A,@DATAB(TABL)
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
;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
LDB A,INFOTAB(TABL)
CAIE A,EVTTYP
ERR <THIS ITEM IS NOT AN EVENT TYPE>,6
MOVE EVT,@DATAB(TABL)
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 PROCESS
ENDCOM(PRC)