perm filename NWORLD.TNX[IMS,AIL] blob
sn#051738 filedate 1973-07-03 generic text, type T, neo UTF8
00100 COMMENT ⊗ VALID 00029 PAGES VERSION 16-2(18)
00200 RECORD PAGE DESCRIPTION
00300 00001 00001
00400 00007 00002 HISTORY
00500 00009 00003 MANY DECLARATIONS
00600 00015 00004 PROCESS VARIABLE NUMBERS
00700 00018 00005 event variables
00800 00019 00006 procedure descriptors & null process skeleton
00900 00021 00007 DSCR SPROUT -- THE PROCESS SPROUTER
01000 00025 00008
01100 00032 00009
01200 00033 00010 routines for inserting & deleting set elements
01300 00037 00011 USER REQUESTED SCHEDULING
01400 00041 00012 HERE(RESUME)
01500 00045 00013 SUSPEND and TERMINATE runtime routines
01600 00048 00014 The JOIN runtime routine
01700 00050 00015 THE MAIN PROCESS INITIALIZER
01800 00052 00016 CALLER , MYPROC, AND PSTATUS
01900 00054 00017 PRISET -- ROUTINE USER CALLS TO CHANGE PRIORITY
02000 00055 00018 SPECIAL GC ROUTINE FOR PROCESSES
02100 00056 00019 INTERRUPT ROUTINES
02200 00062 00020 THE INTERRUPT PROCESS
02300 00065 00021 PROCEDURES TO ENABLE FOR INTERRUPTS
02400 00068 00022 CAUSE
02500 00070 00023 CAUSE1 -- ROUTINE TO DO ACTUAL WORK
02600 00073 00024 ANSWER -- subroutine used by CAUSE
02700 00075 00025 DELWRQ -- delete all wait requests
02800 00076 00026 INTERROGATE
02900 00078 00027 ASK -- used by INTERROGATE
03000 00081 00028 MKEVTT,SETCP,& SETIP
03100 00082 00029 SPARE HERE TABLE ENTRIES
03200 00083 ENDMK
03300 ⊗;
00100 COMMENT ⊗HISTORY
00200 AUTHOR,REASON
00300 021 202000000022 ⊗;
00400
00500
00600 COMMENT ⊗
00700 VERSION 16-2(18) 3-18-73 BY RHT MINOR MOD TO DFR1IN
00800 VERSION 16-2(17) 2-4-73 BY RHT PROVIDE MORE HOOKS INTO EVENT ROUTINES
00900 VERSION 16-2(16) 1-15-73 BY DCS BUG #LB# MINOR RESUME BUG
01000 VERSION 16-2(15) 12-9-72 BY RHT MAKE MINOR ADJUSTMENTS TO RESUME
01100 VERSION 16-2(14) 12-4-72 BY RHT INTERNAL PSTATUS
01200 VERSION 16-2(13) 12-4-72 BY RHT CURE POTENTIAL LOSSAGE OF STATIC LINKAGE
01300 VERSION 16-2(12) 12-2-72 BY RHT REWRITE RESUME
01400 VERSION 16-2(11) 12-1-72 BY RHT PROVIDE FOR DEFAULTS AS CORE VARS
01500 VERSION 16-2(10) 11-30-72 BY RHT ADD THE DDFINT ROUTINE & ZAP POLL
01600 VERSION 16-2(9) 11-29-72 BY DCS ADD INTERRUPT THINGS TO ENTRIES IN COMPIL
01700 VERSION 16-2(8) 11-29-72 BY RHT RESUME DISPATCH NEEDS @
01800 VERSION 16-2(7) 11-26-72 BY DCS ALLOW <ESC>I AS IO INTERRUPT (AVOID "NO ONE TO RUN")
01900 VERSION 16-2(6) 11-26-72 BY DCS CHANGE OPDEF FOR INTENS TO 400030 FROM ..31
02000 VERSION 16-2(5) 11-25-72 BY RHT FIX DATAB & INFTAB REFERENCES
02100 VERSION 16-2(4) 11-15-72 BY RHT ADD OPTIONS FOR RESUME
02200 VERSION 16-2(3) 11-15-72 BY RHT ADD INTERRUPTS,SPARE HERE ENTRIES
02300 VERSION 16-2(2) 11-15-72
02400 VERSION 16-2(1) 11-15-72
02500
02600 ⊗;
00100 ; MANY DECLARATIONS
00200 COMPIL(PRC,,,,,,DUMMYFORGDSCISS)
00300 DEFINE ENS1 < SPROUT,URSCHD,RESUME,SUSPEND,TERMINATE,JOIN,MAINPR,CALLER>
00400 NOTENX<
00500
00600 DEFINE ENS2 <%PSSGC,DDFINT,INTSET,INTMOD,CAUSE,ANSWER,INTERROGATE,SETCP>
00700 DEFINE ENS3 <MKEVTT,SETIP,MYPROC,INTTBL,CLKMOD,DFR1IN,DFRINT,INTPRO>
00800 >;NOTENX
00900 TENX<
01000
01100 DEFINE ENS2 <%PSSGC,DDFINT,INTSET,CAUSE,ANSWER,INTERROGATE,SETCP>
01200 DEFINE ENS3 <MKEVTT,SETIP,MYPROC,INTTBL,DFR1IN,INTPRO>
01300 >;TENX
01400 DEFINE ENS4 <ENABLE,DISABLE,INTMAP,DFCPKT,PSTATUS,ASKNTC,CAUSE1,PRISET>
01500 DEFINE EXT1 <JOBAPR,LEAP,STKUWD,X44,GOGTAB,%ARSR1,SGINS,ALLPDP>
01600 DEFINE EXT2 <CORGET,CORREL,INTRPT,INFTB,%SPGC,X22,%SPGC1,FP1DON,STACSV>
01700 DEFINE EXT3 <X33,%ARRSR,DATM,SGLKBK,FP2DON,SGREM,STACRS,RUNNER,NOPOLL>
01800 DEFINE EXT4 <X11,DEFSSS,DEFPSS,DEFPRI,DEFQNT>
01900
02000 COMMENT ⊗THIS IS FOR THE STUPIDITY OF SCISS ⊗
02100
02200 COMPXX(PRC,<ENS1,ENS2,ENS3,ENS4>,<EXT1,EXT2,EXT3,EXT4>
02300 ,<MULTIPLE PROCESS STUFF>,<SPRPDA>,HIIFPOSSIB)
02400
02500
02600
02700 BEGIN PROCSS
02800
02900 ; (AC DEFNS)
03000
03100 ; A,B,C,P,SP,RF AS BEFORE
03200 KL ←D ;KILL LIST & SCRATCH
03300 PB ←5 ;PROCESS BASE
03400 OPTS ←6 ;HOLDS OPTIONS
03500 PDA ←7 ;HOLDS PDA
03600 EVT ←10 ;EVENT DATUM
03700 NSP ←←10 ;NEW SP
03800 NP ←11 ;NEW P
03900 TMP ←LPSA ;TEMP AC
04000
04100 GLOB <
04200 TABL ←← 7 ;NEEDED BY LIST CELL GETTER
04300 >;GLOB
04400 NOGLOB <
04500 TABL ←← USER ;NEEDED BY LIST CELL GETTER
04600 >;NOGLOB
04700 FP ←← 6 ;NEEDED BY LIST CELL GETTER
04800
04900 ; (LOCAL VARIABLES FOR SCHEDULER)
05000 MAXPRI ←← 0 ;MAXIMUM PRIORITY
05100 MINPRI ←← NPRIS-1
05200
05300 ;REASONS FOR SUSPENSION
05400 PSPF←←0 ;ONLY P, SP, F NEED BE RESTORED
05500 SPNDR←←1 ;SUSPENDED (FROM READY) BY SUSPEND
05600 JOINR←←2 ;SUSPENDED BECAUSE OF A JOIN
05700 WAITNG←←3 ;WAITING ON AN EVENT OR SO
05800
05900 ; ( CONSTANT DATA USED BY SPROUTER)
06000
06100 ; FIELD DEFNS FOR OPTIONS WORD (SEE ALSO POINT S BELOW)
06200
06300 STSMSK← 77 ⊗ =8 ;MASK FOR P STACK SIZE FIELD
06400 SSSMSK← 17 ⊗ =14;MASK FOR SP STACK SIZE FIELD OF OPTIONS WORD
06500 PRIMSK← 17 ⊗ 4 ;MASK FOR PRIORITY FIELD
06600 QNTMSK←← 17 ;MASK FOR QUANTUM
06700 RUNME←← 1 ;RUN THE SPROUTING PROCESS
06800 SPNDME←←2 ;SUSPEND THE SPROUTING PROCESS
06900 SPNDNP←←10 ;SUSPEND THE NEW PROCESS
07000
07100 ;MORE FIELD DEFS & BIT VALUES
07200 TERM ←← 1 ;BIT (LH) IN DATUM OF TERMINATED PROCESS ITEM
07300
07400 ;DEFAULT VALUES --INITIALLY SET BY MAINPR
07500
07600 STPSZ← 40 ;DEFAULT P- STACK SIZE (MINUS THE PROCESS TABLE AREA)
07700 STSPST ←20 ;DEFAULT SP STACK SIZE
07800 STDQNT ←← 4 ;DEFAULT STD QUANTUM IS 4
07900 STDPRI ←←7 ;DEFAULT PRIORITY
08000
08100 ;OPTIONS FOR RESUME
08200 MSTMSK←←14 ;MASK FOR MY NEW STATUS FIELD
08300 NOTNOW←←1 ;SET IF RESUMED PROCESS IS MERELY TO GO READY
08400
08500 ;CONSTANTS USED BY RESUME
08600 MSTBYT: POINT 2,OPTS,33 ;MY NEW STATUS
08700
08800 ; (CONSTANTS USED BY SPROUTER)
08900 SSSBYT: POINT 4,OPTS,21 ;STRING STACK FIELD (MOD 32)
09000 STSBYT: POINT 6,OPTS,27 ;P - STACK FIELD (MOD 32)
09100 PRIBYT: POINT 4,OPTS,31 ;PRIORITY FIELD
09200 QNTBYT: POINT 4,OPTS,17 ;LOG2 (QUANTUM)
09300
09400
09500 ; MACROS USED TO GET LIST CELLS
09600 DEFINE NCELL(AC) <
09700 MOVE FP,FP1(TABL) ;USE WHERE SURE THE LIST SPACE IS INITIALIZED
09800 HRRI AC,(FP)
09900 SKIPN FP,(FP)
10000 PUSHJ P,FP1DON
10100 HRRM FP,FP1(TABL)
10200 >
10300
10400 DEFINE NNCELL(AC) <
10500 SKIPN FP,FP1(TABL) ;USE WHERE LIST SPACE MAY NEED INITIALIZATION
10600 PUSHJ P,FP1DON
10700 HRRI AC,(FP)
10800 SKIPN FP,(FP)
10900 PUSHJ P,FP1DON
11000 HRRM FP,FP1(TABL)
11100 >
11200
11300 DEFINE NNCLL2(AC) <
11400 SKIPN FP,FP2(TABL) ;USE WHERE LIST SPACE MAY NEED INITIALIZATION
11500 PUSHJ P,FP2DON
11600 HRRI AC,(FP)
11700 SKIPN FP,(FP)
11800 PUSHJ P,FP2DON
11900 HRRM FP,FP2(TABL)
12000 >
12100
12200 NOTENX<
12300 OPDEF INTENS [CALLI 400030]
12400 OPDEF IWAIT [CALLI 400040]
12500 >;NOTENX
00100 ;PROCESS VARIABLE NUMBERS
00200
00300 DEFINE PVAR (V,ATTRIB),
00400 <↑V ←← NPVARS
00500 NPVARS←← NPVARS+1
00600 IFE ALWAYS,<
00700 IFDIF <ATTRIB>,<> < ATTRIB V >
00800 >;IFE ALWAYS
00900 >
01000
01100
01200 NPVARS←← 0
01300
01400 PVAR DYNL ;DYNAMIC LINK
01500 PVAR STATL ;STATIC LINK
01600 PVAR ISP ;REST OF MSCP
01700 PVAR AC0 ;AC SAVE AREA
01800 PVAR AC1
01900 PVAR AC2
02000 PVAR AC3
02100 PVAR AC4
02200 PVAR AC5
02300 PVAR AC6
02400 PVAR AC7
02500 PVAR AC10
02600 PVAR AC11
02700 PVAR AC12
02800 PVAR AC13
02900 PVAR AC14
03000 PVAR AC15
03100 PVAR AC16
03200 PVAR AC17
03300 ↑ACF ←← AC12
03400 ↑ACP ←← AC17
03500 ↑ACSP ←← AC16
03600 PVAR PCW ;PC WORD
03700 PVAR QUANTM ;TIME QUANTUM
03800 PVAR PRIOR ;PRIORITY
03900 PVAR PRCITM ;PROCESS ITEM OF THIS PROCESS
04000 PVAR KLOWNR ;THE OWNER OF MY KILL LIST
04100 PVAR STATUS ;-1 = RUNNING, 0 = SUSPEND, 1 = READY, 2 = TERMINATED
04200 PVAR DADDY,INTERNAL ;PROCESS ITEM OF SPROUTING PROCESS
04300 PVAR CAUSRA ;RETN ADDRESS FROM CAUSE
04400 ;THE FOLLOWING ARE ZEROED OUT ON CREATION
04500 ZFIRST←←NPVARS
04600 PVAR CURSCB,INTERNAL ;CURRENT SEARCH CONTROL BLOCK
04700 PVAR REASON ;HOW GOT UNSCHEDULED (0 => ONLY NEED ACS F,SP,P)
04800 PVAR PLISTE ;PRIORITY LIST ENTRY
04900 PVAR RSMR ;THE GUY WHO RESUMED ME
05000 PVAR JOINCT ;HOW MANY PROCESSES NEED TO JOIN THIS ONE
05100 PVAR JOINS ;WHO IS WAITING TO FOR ME TO JOIN (A SET OF ITEMS)
05200 PVAR WAITES ;LIST OF ALL EVENT TYPES ON WHICH I AM WAITING
05300 PVAR INTRGC ;THE CONTROL WORD FOR MY CURENT INTERROGATION
05400 PVAR CAUSES ;COUNT OF CAUSES PENDING
05500 PVAR CAUSEQ ;QUEUE OF CAUSES TO BE MADE
05600 ZLAST←←NPVARS-1
05700
05800 ↑NPVARS ← NPVARS
05900 ↑STKBAS ← NPVARS ;STACK BASE SIZE (= #PROCESS VARS FOR NOW)
00100 COMMENT ⊗event variables⊗
00200
00300 NEVARS←←0
00400
00500 DEFINE EVAR(V) ,
00600 <↑↑V←←NEVARS
00700 NEVARS←←NEVARS+1
00800 >
00900
01000 EVAR NOTCLS ;LIST OF CURRENT NOTICES
01100 EVAR WAITLS ;LIST OF CURRENTLY WAITING PROCESSES
01200 EVAR CAUSEP ;USER SPEC CAUSE PROC
01300 EVAR INTRGP ;USER SPEC INTERROGATE PROC
01400 EVAR USER1 ;AVAIL TO USER
01500 EVAR USER2 ;AVAIL TO USERR
01600
01700 ;OPTIONS BITS FOR CAUSE
01800 DNTSAV ←← 1
01900 TELLAL ←← 2
02000 SCHDIT ←← 4
02100
02200 ;OPTIONS BITS FOR INTERROGATE
02300 RETAIN ←← 1
02400 WAIT ←← 2
02500 SAYWCH ←← 10
02600 MULTIN ←← 200000
02700 NOJOY ←← 400000
02800
00100 COMMENT ⊗procedure descriptors & null process skeleton⊗
00200
00300 FLXXX←←0
00400 UP <
00500 FLXXX←←%FIRLOC-400000
00600 >;UP
00700
00800
00900 DEFINE PUTINLOC(LCN,V),<
01000 RELOC LCN+FLXXX
01100 V
01200 RELOC
01300 >
01400
01500 ;MAKE A PD FOR THE SPROUTER
01600 ↑SPRPDA:BLOCK PD.XXX+1
01700
01800 DEFINE FPDE(IX,V),<PUTINLOC (SPRPDA+IX,V)>
01900
02000 FPDE (PD.,SPROUT)
02100 FPDE (PD.DSW,STKBAS)
02200 FPDE (PD.PDA,<<XWD SPRPDA,0>>)
02300 FPDE (PD.LLW,<SPRPDA+PD.XXX>)
02400 FPDE (PD.DLW,<SPRPDA+PD.XXX>)
02500
02600
02700 IFN 0,<
02800
02900 ;NULL PROCESS
03000 NULPDA: NULPRO ;PD OF NUL PROC
03100 ↑NULPRC: %NULPR ;NULL PROCESS
03200
03300 %NULPR: BLOCK STKBAS+=32 ;NULL PROCESS AREA
03400
03500 DEFINE NPE (IX,V), <PUTINLOC (%NULPR+IX,V)>
03600
03700 NPE (STATL,<<XWD SPRPDA,0>>)
03800 NPE (ACF,STKBAS+%NULPR+1)
03900 NPE (ACP,<<TPDL: XWD - =29,%NULPR+STKBAS+3>>)
04000 NPE (STKBAS+1,%NULPR+DYNL)
04100 NPE (STKBAS+2,<<XWD NULPDA,0>>)
04200
04300
04400
04500 ↑NULPRO:
04600 ERR <I SHOULD NEVER RUN>
04700 >;IFN 0
04800
04900
05000
05100
05200
05300
05400
00100 DSCR SPROUT -- THE PROCESS SPROUTER
00200 CAL PUSHJ
00300 PARM -1(P) ;KILL LIST
00400 -2(P) ;OPTIONS WORD
00500 -3(P) ;PDA OF SPROUTED PROCESS
00600 -4(P) ; PROCEDURE PARAMS
00700 :
00800 -?(P) ;LAST OF PROCEDURRE PARAMS
00900 -?-1(P) ;PROCESS ITEM
01000 DES
01100 This procedure acts as the "process" procedure.
01200 Roughly, it does the following:
01300
01400 1. Saves the return address in PCW(RUNNER)
01500 2. gets stack space
01600 3. puts self on appropriate kill list & priority list
01700 4. copies over the procedure parameters.
01800 5. sets status of new & SPROUTing process
01900 &(eventually) calls the appropriate procedure.
02000 6. when the procedure returns, SPROUT then kills the process.
02100
02200 ⊗
02300 HERE (SPROUT)
02400 MOVE USER,RUNNER ;
02500 POP P,PCW(USER) ;RETN ADDRESS
02600 POP P,KL ;PICK UP KILLL LIST
02700 POP P,OPTS ;OPTIONS
02800
02900 TRNE OPTS,SSSMSK ;SPECIFIED SP STACK SIZE ?
03000 JRST [ LDB C,SSSBYT ;YES, GET IT
03100 LSH C,5 ;TIMES 32
03200 JRST .+2 ]
03300 MOVE C,DEFSSS ;STANDARD SIZE
03400 PUSHJ P,CORGET ;GET SPACE
03500 ERR <NOT ENOUGH CORE -- SPROUT >
03600 MOVN C,C ;MAKE PDP
03700 HRLZI NSP,-1(C)
03800 HRRI NSP,-1(B)
03900 TRNE OPTS,STSMSK ;P - STACK
04000 JRST [ LDB C,STSBYT ;YES, GET IT
04100 LSH C,5 ;TIMES 32
04200 JRST .+2]
04300 MOVE C,DEFPSS ;STANDARD AMOUNT TO GET
04400 ADDI C,STKBAS ;SPACE FOR BASE
04500 PUSHJ P,CORGET ;GET ROOM
04600 ERR <NOT ENOUGH CORE -- SPROUT >
04700 MOVE PB,B ;PROCESS BASE
04800 MOVN C,C
04900 HRLZI NP,STKBAS(C) ;MAKE PDP
05000 HRRI NP,STKBAS(PB)
05100
05200 ;ZERO OUT SOME OF THE PROCESS VARS
05300 HRLZI A,ZFIRST(PB) ;
05400 HRRI A,ZFIRST+1(PB)
05500 SETZM ZFIRST(PB)
05600 BLT A,ZLAST(PB)
05700
05800 ;REMEMBER DADDY
05900 MOVE USER,RUNNER
06000 MOVE A,PRCITM(USER)
06100 MOVEM A,DADDY(PB)
06200
06300 ;BUILD MSCP, ETC.
06400
06500 POP P,PDA ;FIND OUT WHO
06600 SETZM DYNL(PB) ;NULL DYN LINK
06700 HLRZ A,PD.DLW(PDA) ;DISPLAY LEVEL
06800 HRLZI TMP,SPRPDA ;IN CASE OUTER LEVEL
06900 CAIG A,1 ;OUTER BLOCK PROC?
07000 JRST SLON ;YES -- NO LOOP
07100 HRRZ A,PD.PPD(PDA) ;THE LEXICAL PARENT
07200 SKIPA TMP,RF ;DYNL
07300 SLFLP: HLRZ TMP,C ;BACK A STATL
07400 MOVS C,1(TMP) ;SL,,PDA
07500 CAIE A,(C) ;SAME AS DADDY?
07600 JRST SLFLP ;NO
07700 HRLI TMP,SPRPDA ;SPRPDA,,STATL
07800 SLON: MOVEM TMP,STATL(PB) ;STATIC LINK WORD
07900 MOVEM NSP,ISP(PB) ;SP WORD
08000
08100 ;COPY PROC PARAMS
08200
08300 HLRZ TMP,PD.NPW(PDA) ;#STRING PARAMS*2
08400 JUMPE TMP,STPSON ;HAVE ANY ?
08500 HRL TMP,TMP ;YES, DO A BLT
08600 HRRZI A,1(NSP) ;DEST
08700 ADD NSP,TMP ;BUMP OLD STACK
08800 SUB SP,TMP ;DECREMENT OLD STACK
08900 HRLI A,1(SP) ;SOURCE
09000 BLT A,(NSP) ;COPY THEM
09100 STPSON: HRRZ TMP,PD.NPW(PDA) ;# ARITH PARMS +1
09200 SOJLE TMP,APSON ;ANY TO BLT ?
09300 HRL TMP,TMP ;MAKE XWD
09400 HRRZI A,1(NP) ;DEST
09500 ADD NP,TMP
09600 SUB P,TMP
09700 HRLI A,1(P)
09800 BLT A,(NP) ;DO IT
09900 APSON:
10000
00100
00200 ;NOW SET UP NEW PROCESS'S STATUS, QUANTUM, & PRIORITY
00300
00400 SETOM STATUS(PB) ;ASSUME RUNNING
00500 TRNE OPTS,SPNDNP ;UNLESS SUSPEND
00600 SETZM STATUS(PB) ;0 MEANS SUSPENDED
00700 MOVE TMP,DEFQNT ;STANDARD QUANTUM
00800 TLNN OPTS,QNTMSK ;GET LOG2 QUANTUM
00900 JRST SVQNT ;NO NEED
01000 LDB A,QNTBYT
01100 MOVEI TMP,1
01200 LSH TMP,(A)
01300 SVQNT: MOVEM TMP,QUANTM(PB)
01400 MOVE A,DEFPRI ;ASSUME STD PRIORITY
01500 TRNE OPTS,PRIMSK ;SAID OTHERWISE?
01600 LDB A,PRIBYT
01700 PUSHJ P,SETPRI ;GO SET PRIORITY
01800
01900 ;SET UP PROCESS ITEM
02000
02100 POP P,C ;PICK UP ITEM #
02200 MOVEM C,PRCITM(PB) ;REMEMBER IT
02300 MOVEI A,PRCTYP ;SAY IS OF TYPE PROCESS
02400
02500 COMMENT **** MAY WANT TO WORRY HERE ABOUT GLOBAL ITEMS **** ;
02600
02700 MOVE TABL,GOGTAB
02800 DPB A,INFOTAB(TABL) ;SAY IS A PROCESS
02900 HRRZM PB,@DATAB(TABL) ;SET DATUM VALUE
03000
03100 ;KILL SET STUFF
03200 MOVE B,C ;ITEM NUMBER
03300 MOVEM KL,KLOWNR(PB) ;REMEMBER KILL LIST OWNER
03400 JUMPE KL,NEWSTT ;ONLY PUT ON KILL SET IF HAVE ONE
03500 PUSH P,TABL ;NEED TO SAVE THESE
03600 PUSH P,FP ;
03700 PUSHJ P,INSRTS ;GO PUT ITEM IN KILL SET
03800 POP P,FP
03900 POP P,TABL
04000
04100 ;NOW DECIDE WHAT TO DO WITH SPROUTING PROCESS & DO THE RIGHT THING
04200
04300 NEWSTT: MOVE USER,RUNNER ;HOPE IT IS STILL HIM
04400 TRNE OPTS,RUNME ; DOES SPROUTING PROCESS WANT TO RUN?
04500 JRST RNSPRR ;YES
04600 MOVEM P,ACP(USER) ;IF HERE, THEN WANT TO RUN NEW GUY
04700 MOVEM SP,ACSP(USER) ;SAVE THE NECESSARY ACS
04800 MOVEM RF,ACF(USER) ;
04900 MOVNS STATUS(USER) ;RUNNING →→ READY
05000 TRNE OPTS,SPNDME ;IF I WANTED SUSPENSION
05100 SETZM STATUS(USER) ;DO IT
05200 SKIPL STATUS(PB) ;DOES SPROUTED PROCESS WANT TO RUN
05300 JRST NORFR ;NO
05400 MOVE USER,GOGTAB
05500 MOVE A,QUANTM(PB)
05600 MOVEM A,TIMER(USER)
05700 MOVE P,NP ;
05800 MOVE SP,NSP ;GET READY
05900 MOVEI RF,DYNL(PB) ;
06000 MOVEM PB,RUNNER
06100 CALLIT: PUSHJ P,@PD.(PDA) ;CALL THE SO AND SO
06200
06300 ;HERE IS WHERE WE COME ON PROCEDURE EXIT
06400 CALRET: MOVE PB,RUNNER ;I HOPE ITS ME
06500 PUSHJ P,KACTS ;DO EVERYTHING BUT SPACE FREEING
06600 MOVE P,ALLPDP ;USE THIS PDL FOR KILLING CORE
06700
06800 ;NOW KILL CORE FOR SP STACK
06900
07000 HRRZ B,ISP(PB)
07100 ADDI B,1
07200 PUSHJ P,CORREL
07300
07400 ;NOW KILL CORE FOR P-STACK
07500
07600 HRRZI B,(PB)
07700 PUSHJ P,CORREL
07800
07900 ;NOW ALL TRACES ARE GONE (I HOPE)
08000
08100 JRST FOTR ;GO FIND SOMETHING TO DO
08200
08300 ;PROCEDURE THAT PERFORMS ALL KILL ACTIONS EXCEPT STACK RELEASING
08400 ;EXPECTS PB TO POINT AT THE CONDEMNED PROCESS
08500 ;USES A,B,C,KL
08600
08700 KACTS: HRRZ C,PRCITM(PB)
08800 MOVE B,C ;
08900 MOVE TABL,GOGTAB ;
09000 TLO PB,TERM ;SET TERM BIT
09100 MOVEM PB,@DATAB(TABL) ;TERMINATED
09200 SKIPE KL,KLOWNR(PB) ;IF HAVE A KILL SET
09300 PUSHJ P,DELTSE ;DELETE FROM SET
09400
09500 ;NOW CHECK TO SEE IF WE WERE ON ANY JOIN LISTS
09600
09700 SKIPN A,JOINS(PB)
09800 JRST REMPRI
09900 MOVE KL,GOGTAB ;
10000 KACT.1: HLRZ C,(A) ;THE ITEM
10100 MOVE B,@DATAB(TABL) ;GET ADDRESS OF THE DATUM
10200 TLNE B,TERM ;DEAD ALREADY??
10300 JRST KACT.2 ;YES
10400 SOSLE JOINCT(B) ;READY TO ROLL ??
10500 JRST KACT.2 ;NO
10600 SKIPN STATUS(B) ;CURRENT STATUS
10700 AOS STATUS(B) ;READY
10800 KACT.2: HRRZ B,(A)
10900 HRR C,FP1(KL) ;RELEASE LIST CELL
11000 HRRM C,(A)
11100 HRRM A,FP1(KL) ;NEW FREE LIST
11200 JUMPE B,REMPRI ;END OF LIST
11300 MOVE A,B ;
11400 JRST KACT.1
11500
11600
11700
11800 ;NOW TAKE OFF PRIORITY LIST AND RETURN
11900 ;NOTE -- THE CODE FROM HERE TO THE POPJ IS ITSELF A PROCEDURE USED
12000 ;ELSEWHERE TO REMOVE PROCESS (PB) FROM ITS PRIORITY LIST
12100 ;SIDE EFFECTS -- USES A,B,C
12200
12300 REMPRI: MOVE A,PRIOR(PB)
12400 ADD A,GOGTAB
12500 HRRZ B,PLISTE(PB)
12600 HLRZ C,PLISTE(PB)
12700 JUMPN C,.+3
12800 HRRM B,PRILIS(A) ;HEAD OF LIST
12900 JRST .+2
13000 HRRM B,PLISTE(C) ;NEXT(C)←B
13100 JUMPN B,.+3
13200 HRLM C,PRILIS(A) ;NEW TAIL
13300 POPJ P,
13400 HRLM C,PLISTE(B) ;PREV(B)←C
13500 POPJ P,
13600
13700 ;PROCEDURE TO PUT PROCESS (PB) ON PRIORITY LIST A
13800 ;SIDE EFFECT -- MODIFIES B
13900 SETPRI: MOVEM A,PRIOR(PB) ;REMEMBER MY PRIORITY
14000 ADD A,GOGTAB
14100 SKIPE B,PRILIS(A) ;PRIORITY LIST OWNER
14200 HRLM PB,PLISTE(B) ;LINK BACK
14300 HRRZM B,PLISTE(PB) ;LIINK DOWM
14400 HRRM PB,PRILIS(A) ;NEW RHS FOR OWNER IS → ME
14500 TLNN B,-1 ;WAS THE LIST EMPTY ??
14600 HRLM PB,PRILIS(A) ;YES -- THIS IS THE TAIL TOO
14700 CPOPJ: POPJ P,
14800
00100
00200 ;HERE IF DONT WANT TO RUN NEW GUY RIGHT AWAY
00300 NORFR: TROA B,1 ;FLAG
00400 RNSPRR: MOVEI B,0
00500 MOVNS STATUS(PB) ;IF NEW IS "RUNNING", THEN "READY"
00600 PUSH NP,[CALRET] ;
00700 MOVEM NP,ACP(PB) ;SET UP NEC. SAVES
00800 MOVEM NSP,ACSP(PB)
00900 MOVEI A,DYNL(PB)
01000 MOVEM A,ACF(PB)
01100 MOVE A,PD.(PDA) ;WHERE HE STARTS
01200 MOVEM A,PCW(PB)
01300 CAIN B, ;SPROUTER RUNS??
01400 JRST @PCW(USER) ;YES --
01500 JRST FOTR ;NO -- FIND SOMEONE TO RUN
01600
00100 COMMENT ⊗routines for inserting & deleting set elements⊗
00200
00300 ;expects item no in B , (KL) = the owner
00400 ;mangles A,B,C,FP,TABL
00500
00600 INSRTS: MOVE TABL,GOGTAB
00700 SKIPN A,(KL) ;GET OWNER
00800 JRST NEWINS ;IT WAS NULL BEFORE
00900 MOVE C,(A) ;POINT AT FIRST
01000 ISCH: MOVS C,(C) ;CONTENTS (SWAPPED) OF THIS
01100 CAILE B,(C) ;ELIGIBLE
01200 JRST NX1 ;MUST GO FURTHER
01300 CAIL B,(C) ;THERE ALREADY?
01400 POPJ P, ;YES
01500 NI: HRL B,(A) ;POINTER AT THIS
01600 NCELL (C) ;GET A CELL FOR IT
01700 MOVSM B,(C) ;SAVE CONTENTS OF CELL
01800 HRRM C,(A) ;LINK TO NEW
01900 HRLZI A,1
02000 ADDB A,(KL) ;UPDATE COUNT -- POINT AT LAST,,FIRST
02100 TLNN B,-1 ;AT THE END???
02200 HRLM C,(A) ;YES
02300 POPJ P,
02400 NX1: HRRZ A,(A)
02500 TLNN C,-1 ;END OF LIST
02600 JRST NI ;YES -- PUT AT END
02700 MOVSS C
02800 JRST ISCH ;GO LOOK SOME MORE
02900 NEWINS: NNCELL (A)
03000 SETZM (A)
03100 HRRZM A,(KL) ;IT USED TO BE NULL
03200 JRST NI
03300
03400 ;ROUTINES FOR ADDING TO LISTS
03500 ;EXPECT ITEM NO IN B, KL= ADRS OF OWNER
03600 ;MANGLE A,B,C,FP,TABL
03700 IHEDLS: SKIPN A,(KL) ;INSERT AT HEAD
03800 JRST NEWINS
03900 JRST NI
04000 ITAILS: SKIPN A,(KL) ;INSERT AT TAIL
04100 JRST NEWINS
04200 MOVS A,(A)
04300 JRST NI
04400
04500
04600 ;ROUTINE TO DELETE SET OR LIST ELEMENTS
04700 ;B = ITEM NO, (KL) IS THE OWNER
04800 ;MANGLES A,B,C,TABL
04900
05000 DELTLE:
05100 DELTSE: SKIPN A,(KL) ;GET SET DESCRIPTOR
05200 POPJ P, ;NULL ALREADY
05300 MOVE C,(A)
05400 DSCH: MOVE C,(C)
05500 TLC C,(B)
05600 TLNN C,-1 ;WAS IT THIS ONE???
05700 JRST DIT ;YES
05800 TRNN C,-1 ;END OF SEARCH
05900 POPJ P, ;YES
06000 MOVE A,(A) ;LINK
06100 JRST DSCH ;GO LOOK
06200 DIT: MOVE TABL,GOGTAB
06300 MOVE B,(A) ;B →→ TO THIS CELL
06400 HRRM C,(A) ;LINK PREV TO NEXT
06500 HRL C,FP1(TABL) ;OLD FREE LIST
06600 HLRM C,(B) ;LINK CELL
06700 HRRM B,FP1(TABL) ;
06800 HRLZI B,-1 ;ADJUST DESCRIPTOR
06900 ADDB B,(KL)
07000 TLNE B,-1 ;LIST NULL NOW???
07100 JRST CKEND ;NO
07200 SETZM (KL) ;YES
07300 MOVSS (B) ;LAST,,FIRST CELL
07400 ;NOW IS 0,,→CELL JUST FREED UP
07500 HRRM B,FP1(TABL) ;NEW FREE LIST
07600 POPJ P,
07700 CKEND: TRNN C,-1 ;WAS THIS THE END
07800 HRLM A,(B) ;YES
07900 POPJ P,
08000
08100
08200 ;ROUTINE TO DELETE FIRST ELT OF A LIST
08300 ;PUTS ITEM # INTO A
08400 ;EXPECTS (KL) = THE OWNER
08500 ;MODIFIES A,B,C,TABL
08600
08700 REMCAR: SKIPN A,(KL)
08800 POPJ P, ;IF WAS NULL RETURN A 0
08900 MOVE C,(A)
09000 MOVE C,(C) ;FIRST REAL LIST CELL
09100 HLRZ B,C ;FIRST ONE
09200 PUSH P,B ;SAVE IT
09300 PUSHJ P,DIT
09400 POP P,A ;VALUE
09500 POPJ P,
09600
09700
09800
09900
10000
00100 ;USER REQUESTED SCHEDULING
00200
00300
00400 HERE(URSCHD)
00500 MOVE PB,RUNNER
00600 SKIPL STATUS(PB) ;
00700 JRST FOTR ;GO FIND ONE TO RUN
00800 MOVNS STATUS(PB) ;SET TO READY
00900 SPSRN1: SETZM REASON(PB) ;OTHER ACS NOT SAVED
01000 SPSRN2: POP P,PCW(PB) ;DITTO -- BUT LEAVE REASON INTACT
01100 ;THESE TWO LABELS ARE USED
01200 ;BY SUSPEND, JOIN & THE LIKE
01300 MOVEM P,ACP(PB)
01400 MOVEM SP,ACSP(PB)
01500 MOVEM RF,ACF(PB)
01600 FOTR: HRRZ B,GOGTAB
01700 TLO B,-NPRIS
01800 MOVEI A,1 ;READY
01900 SCHLIS: SKIPN PB,PRILIS(B) ;SEARCH DOWN THIS LIST
02000 JRST NXLIS ;LIST IS EMPTY
02100 TRYTHS: CAMN A,STATUS(PB) ;IS THIS READY
02200 JRST SCDTHS ;YES -- DO HIM
02300 HRRZ PB,PLISTE(PB) ;LINK DOWN LIST
02400 JUMPN PB,TRYTHS ;IF ANY LEFT AT THIS LEVEL,TRY
02500 NXLIS: AOBJN B,SCHLIS ;SEARCH LIST
02600
02700 NOTENX<
02800 INTENS B, ;GET INTERRUPT ENABLING
02900 TLNN B,775204 ;IS HE ENABLED FOR SOMETHING
03000 ;THAT CAN STILL HAPPEN
03100 >;NOTENX
03200 ;GOTTA PUT TENEX EQUIVALENT IN HERE
03300 ERR <NO ONE TO RUN> ;NO
03400 ERR <IWAIT not implemented yet>
03500 ;WAIT FOR AN INTERRUPT
03600 SETZM INTRPT ;ZERO THE FLAG
03700 JRST FOTR ;FIND SOMEONE TO RUN
03800
03900 SCDTHS:
04000 ;CIRCLE THE QUEUE
04100 SKIPN A,PLISTE(PB) ;ONLY ONE ON THE LIST?
04200 JRST RDYTHS ;YES
04300 TRNN A,-1 ;ALREADY AT END?
04400 JRST RDYTHS ;YES
04500 HLLM A,PLISTE(A) ;PREV(NEXT(ME))←PREV(ME)
04600 MOVS C,A ;NEXT(ME),,PREV(ME)
04700 TRNE C,-1 ;ANY PREV?
04800 HLRM C,PLISTE(C) ;YES -- NEXT(PREV(ME))←NEXT(ME)
04900 TLNE A,-1 ;WAS I FIRST?
05000 HRR A,PRILIS(B) ;NO -- FIRST WILL STAY FIRST
05100 HRL A,PB ;NEW OWNER -- ME,,NEW FIRST
05200 EXCH A,PRILIS(B) ;GET OLD LAST,,FIRST
05300 HLLZM A,PLISTE(PB) ;MY NEW ENTRY IS OLD LAST,,0
05400 MOVS A,A ; XXX,,OLD LAST
05500 HRRM PB,PLISTE(A) ;POINT AT ME
05600
05700
05800 RDYTHS: SETOM STATUS(PB) ;RUNNING
05900 HRRM PB,RUNNER ;SAY SO
06000 MOVE USER,GOGTAB
06100 MOVE A,QUANTM(PB)
06200 MOVEM A,TIMER(USER)
06300 SKIPE A,REASON(PB)
06400 JRST @SPCASE(A) ;SOME SPECIAL CASE
06500 RPSPF: MOVE P,ACP(PB) ;GET THE NEEDED REGISTERS
06600 MOVE SP,ACSP(PB)
06700 MOVE RF,ACF(PB)
06800 JRST @PCW(PB) ;GO START RUNNING THE SO AND SO
06900
07000
07100 SPCASE: RPSPF ;0 →→ RESTORE P, SP, F
07200 RSTACS ;1 →→ RESTORE ALL ACS
07300 RPSPF ;2 →→ FROM JOINER
07400 RST1 ;3 →→ FROM INTERROGATE
07500
07600 RSTACS: MOVE P,ACP(PB) ;PUT THE RETURN ADDRESS ON THE STACK
07700 PUSH P,PCW(PB)
07800 MOVEM P,ACP(PB)
07900 HRLZI P,AC0(PB)
08000 BLT P,P ;RESTORE THE OLD ACS
08100 POPJ P, ;GO RUN
08200
08300
08400 RST1: MOVE A,AC1(PB) ;RESTORE REG 1 , SP,P,F
08500 JRST RPSPF
08600
00100 HERE(RESUME)
00200 MOVE USER,RUNNER ;TAKE CARE OF RET ADDRS
00300 POP P,PCW(USER)
00400 POP P,OPTS ;OPTIONS
00500 POP P,A ;RETURN VALUE
00600 POP P,C ;WHO
00700 MOVE TEMP,GOGTAB ;
00800 LDB B,INFOTAB(TEMP) ;TEST THE TYPE
00900 CAIE B,PRCTYP ;IS THE TYPE A PROCESS
01000 ERR <ATTEMPT TO RESUME SOMETHING NOT A PROCESS>
01100 MOVE PB,@DATAB(TEMP) ;GET THE DATUM
01200 TLNE PB,TERM ;WAS IT TERMINATED?
01300 ERR <ATTEMPT TO RESUME A TERMINATED PROCESS>
01400 MOVE B,PRCITM(USER) ;MY NAME
01500 MOVEM B,RSMR(PB) ;REMEMBER CALLER
01600 SKIPE STATUS(PB) ;HIS STATUS BETTER BE 0
01700 ERR <ATTEMPT TO RESUME NON-SUSPENDED PROCESS>,1,<@PCW(USER)>
01800 JUMPN OPTS,NS.RSM ;NONSTANDARD IF JUMP
01900 SETZM STATUS(USER)
02000 RSM.H: SETOM STATUS(PB)
02100 MOVEM P,ACP(USER) ;SAVE NEEDFUL REGISTERS
02200 MOVEM RF,ACF(USER)
02300 MOVEM SP,ACSP(USER)
02400 SETZM REASON(USER) ;ONTL P, SP, F IMPORTANT
02500 MOVEM PB,RUNNER ;
02600 MOVE C,REASON(PB) ;
02700 JRST @SPCASE(C) ;GO FIRE HIM UP
02800
02900
03000 NS.RSM: TRNN OPTS,MSTMSK ;FUNNYNESS IN MY NEW STATUS?
03100 JRST RSM.4 ;NO -- IT MUST BE NOTNOW
03200 LDB D,MSTBYT ;GET INDEX
03300 JRST @[ RSM.1 ;I GO READY
03400 RSM.3 ;I DIE
03500 RSM.4 ;I WANT TO KEEP RUNNING
03600 ]-1(D) ;SELECT
03700
03800 RSM.1: TRNN OPTS,NOTNOW ;HE RUNS?
03900 JRST RSM.2 ;YES
04000 AOS STATUS(PB) ;MAKE HIM READY
04100 MOVE B,REASON(PB) ;WERE ALL REGISTERS SAVED
04200 CAIN B,1 ;
04300 JRST RSM.01 ;YES
04400 MOVEM A,AC1(PB) ;
04500 MOVEI A,3
04600 MOVEM A,REASON(PB) ;A IS IMPORTANT
04700 RSM.01: PUSH P,PCW(USER) ;RET AD
04800 JRST URSCHD ;RESCHEDULE
04900
05000
05100
05200 RSM.2: MOVNS STATUS(USER) ;
05300 JRST RSM.H ;GO GET HIM GOING
05400
05500
05600
05700 RSM.3: MOVE B,REASON(PB) ;
05800 CAIN B,1 ;ALL ACS SAVED?
05900 JRST RSM.3X ;YES
06000 MOVEM A,AC1(PB) ;SAVE A
06100 MOVEI A,3 ;
06200 MOVEM A,REASON(PB) ;
06300 RSM.3X: TRNE OPTS,NOTNOW ;HE RUNS?
06400 JRST RSM.03 ;YES
06500 AOS STATUS(PB) ;NO - I CAN COMMIT SUICIDE
06600 MOVE PB,USER ;
06700 JRST TERMPB ; I DIE
06800 RSM.03: MOVE B,ACP(PB) ;
06900 MOVEI C,RSM.T ;
07000 EXCH C,PCW(PB) ;FIRST HE WILL KILL ME
07100 PUSH B,C ;
07200 PUSH B,PB ;
07300 MOVEM B,ACP(PB) ;THE TERMPB POPJ WILL CONTINUE HIM
07400 JRST RSM.H ;GO FIRE THE DEAR BOY UP
07500
07600 RSM.4: AOS STATUS(PB) ;GET HIM READY
07700 MOVE B,REASON(PB) ;SHOULD WE SAVE 1
07800 CAIE B,1 ;
07900 JRST @PCW(USER) ;I GO ON MY WAY
08000 MOVEM A,AC1(PB) ;SAVE IT
08100 MOVEI A,3 ;
08200 MOVEM A,REASON(PB) ;
08300 ;;#LB#↓ 1-15-73 DCS WAS @PCW(PB), THAT'S WRONG ("TYPO")
08400 JRST @PCW(USER) ;
08500
08600 RSM.T: MOVE PB,(P) ;
08700 PUSHJ P,TERMPB ;
08800 MOVE PB,1(P) ;TERMPB BACKED UP THE STACK
08900 POP P,PCW(PB) ;RET AD
09000 MOVE C,REASON(PB) ;
09100 JRST @SPCASE(C) ;GO DO RIGHT THING ABOUT ACS
09200
00100 COMMENT ⊗SUSPEND and TERMINATE runtime routines⊗
00200 HERE(SUSPEND)
00300 MOVE C,-1(P) ;THE ITEM
00400 POP P,-1(P) ;BACK UP RETN ADDR
00500 MOVE TABL,GOGTAB ;
00600 LDB B,INFOTAB(TABL)
00700 CAIE B,PRCTYP ;BE SURE A PROCESS ITEM
00800 ERR <ATTEMPT TO SUSPEND A NON PROCESS ITEM>
00900 MOVE PB,@DATAB(TABL)
01000 TLNE PB,TERM ;IF TERMINATED ,
01100 ERR <SUSPENDING A TERMINATED ITEM>
01200 CAME PB,RUNNER ;IS IT THE RUNNER
01300 JRST OTHGUY ;NO
01400 SETZM STATUS(PB)
01500 JRST SPSRN1 ;GO RESCHEDULE
01600 OTHGUY: MOVEI A,SPNDR ;HE MUST HAVE BEEN READY
01700 SKIPE STATUS(PB) ;IF HE WASNT SUSPENDED
01800 MOVEM A,REASON(PB) ;THE REGISTERS MUST BE RESTORED
01900 SETZM STATUS(PB) ;BE SURE
02000 POPJ P,
02100
02200 HERE(TERMINATE)
02300 MOVE C,-1(P)
02400 MOVE TABL,GOGTAB ;
02500 LDB B,INFOTAB(TABL) ;IS HE A PROCESS
02600 CAIE B,PRCTYP
02700 ERR <TERMINATING A NON-PROCESS>
02800 MOVE PB,@DATAB(TABL) ;POINT AT PROCESS
02900 TLNE PB,TERM ;ALREADY DEAD
03000 JRST RET1 ;YES
03100 ↑TERMPB:
03200 MOVE USER,RUNNER ;COME HERE IF PB LOADED
03300 CAMN PB,USER ;IS IT ME THAT IS TO DIE?
03400 JRST KILLIT ;YES
03500 PUSH P,PRIOR(USER) ;I AM ABOUT TO GET HIGH PRIORITY
03600 PUSHJ P,REMPRI
03700 MOVEI A,MAXPRI ;
03800 PUSHJ P,SETPRI
03900 MOVEI A,FIXPRI
04000 MOVEM A,PCW(USER)
04100 MOVEM P,ACP(USER)
04200 MOVEM RF,ACF(USER)
04300 MOVEM SP,ACSP(USER)
04400 MOVE RF,ACF(PB)
04500 MOVE P,ACP(PB)
04600 MOVE SP,ACSP(PB)
04700 MOVEI A,1 ;NOW FIX STATUS
04800 MOVEM A,STATUS(USER) ;
04900 MOVNM A,STATUS(PB)
05000 MOVEM PB,RUNNER ;THE NEW RUNNER
05100 KILLIT: MOVEI LPSA,SPRPDA ;THE SPROUTER IS WHERE WE GO BACK TO
05200 PUSHJ P,STKUWD ;UNWIND THE STACK
05300 JRST CALRET ;GO DIE
05400
05500 ;IF LIVED THROUGH THE DESTRUCTION, WILL COME HERE
05600 FIXPRI: PUSHJ P,REMPRI
05700 POP P,A ;REAL PRIORITY
05800 PUSHJ P,SETPRI
05900 RET1: SUB P,[XWD 2,2] ;GET OFF THE PARAMETER
06000 JRST @2(P) ;RETURN
06100
00100 COMMENT ⊗The JOIN runtime routine⊗
00200
00300 DSCR JOIN
00400 CAL PUSH P,SET
00500 PUSHJ P,JOIN
00600 DES CAUSES YOUR PROCESS TO WAIT FOR THE TERMINATION OF ANY
00700 PROCESSES NAMED IN ITS ARGUMENT SET
00800 ⊗
00900
01000 HERE(JOIN)
01100 MOVE PB,RUNNER
01200 MOVE B,-1(P) ;THE SET
01300 POP P,-1(P) ;FOR LATER
01400 JUMPE B,CPOPJ ;
01500 MOVE TABL,GOGTAB ;GET READY FOR CELL GETTING
01600 HRRZ A,(B) ;A NOW POINTS AT FIRST
01700 HRLZ D,PRCITM(PB) ;THE PROCESS ITEM OF THE JOIN
01800
01900 ;NOW LOOP ALONG SET, GIVING WARNINGS
02000
02100 JNST: HLRZ C,(A) ;THE ITEM NUMBER
02200 LDB B,INFOTAB(TABL) ;GET TYPE
02300 CAIE B,PRCTYP ;PROCESS?
02400 ERR <ATTEMPT TO DO JOIN ON NON-PROCESS>
02500 MOVE B,@DATAB(TABL) ;GET DATUM
02600 TLNE B,TERM ;DEAD ???
02700 JRST NXTJNR ;YES
02800 AOS JOINCT(PB) ;ONE MORE TO DIE
02900 NNCELL (C) ;GET (POSSIBLY FIRST) NEW CELL
03000 HRR D,JOINS(B) ;LINK TO OLD JOIN LIST
03100 MOVEM D,(C) ;NEW CONTENTS OF THIS CELL
03200 HRRZM C,JOINS(B) ;NEW JOIN LIST
03300 NXTJNR: HRRZ A,(A) ;GET NEXT ENTRY
03400 JUMPN A,JNST
03500 SKIPG JOINCT(PB) ;DO WE NEED TO WAIT?
03600 POPJ P, ;NO
03700 MOVEI A,JOINR ;REASON IS A JOIN
03800 MOVEM A,REASON(PB) ;
03900 SETZM STATUS(PB) ;I AM SUSPENDED
04000 JRST SPSRN2 ;GO SAVE P,RF,SP & RUN SOMEONE
04100 ;(BUT DONT CHANGE REASON)
04200
04300
04400
04500
04600
04700
04800
00100 COMMENT ⊗THE MAIN PROCESS INITIALIZER⊗
00200
00300 HERE(MAINPR)
00400 MOVE USER,GOGTAB
00500 SKIPE GGDAD(USER) ;INITIALIZED ALREADY
00600 POPJ P, ;YES
00700 MOVEI C,NPVARS+40 ;HOW MUCH SPACE WE NEED
00800 PUSHJ P,CORGET
00900 ERR <NO ROOM FOR THE MAIN PROCESS>
01000 HRRZ PB,B ;PROCESS BASE
01100 MOVE A,SPDL(USER) ;STRING PDL
01200 MOVEM A,ISP(PB)
01300 SETOM DYNL(PB)
01400 HLROI A,SPRPDA
01500 MOVEM A,STATL(PB)
01600 MOVEM PB,GGDAD(USER)
01700 MOVEM PB,RUNNER ;SAY THIS IS THE RUNNER
01800 HRLZI A,ZFIRST(PB)
01900 HRRI A,ZFIRST+1(PB)
02000 SETZM ZFIRST(PB)
02100 BLT A,ZLAST(PB)
02200
02300 MOVEI C,MAINPI ;THE MAIN PROCESS ITEM NUMBER
02400 MOVEI A,PRCTYP ;MAKE A PROCESS
02500 DPB A,INFOTAB(USER)
02600 HRRZM PB,@DATAB(USER)
02700 MOVEM C,PRCITM(PB)
02800
02900 SETZM KLOWNR(PB) ;NASTY
03000 SETOM STATUS(PB) ;I AM THE RUNNER
03100 MOVEI A,STPSZ ;SET DEFAULTS
03200 MOVEM A,DEFPSS ;P STACK
03300 MOVEI A,STSPST ;
03400 MOVEM A,DEFSSS ;SP STACK
03500 MOVEI A,STDQNT ;
03600 MOVEM A,DEFQNT ;QUANTUM
03700 MOVEM A,QUANTM(PB) ;
03800 MOVEI A,STDPRI ;STANDARD PRIORITY
03900 MOVEM A,DEFPRI ;PRIORITY
04000 PUSHJ P,SETPRI ;SET THE PRIORITY
04100 PUSH P,[%SPGC]
04200 PUSHJ P,SGREM
04300 PUSH P,[%ARRSRT]
04400 PUSHJ P,SGREM
04500 PUSH P,[%PSSGC]
04600 PUSH P,[SGLKBK+1]
04700 PUSHJ P,SGINS
04800
04900 POPJ P,
05000
05100
00100 COMMENT ⊗CALLER , MYPROC, AND PSTATUS ⊗
00200
00300 HERE(CALLER)
00400 JSP TEMP,PDG
00500 ERR <NOT A PROCESS ITEM>
00600 TLNE A,TERM
00700 ERR <PROCESS IS TERMINATED>
00800 MOVE A,RSMR(A)
00900 C.XIT1: EXCH C,-1(P)
01000 C.XIT: SUB P,X22
01100 JRST @2(P)
01200
01300 HERE(MYPROC)
01400 MOVE USER,RUNNER
01500 MOVE A,PRCITM(USER)
01600 POPJ P,
01700
01800 HERE(PSTATUS)
01900 JSP TEMP,PDG
02000 ERR <NOT A PROCESS ITEM>
02100 TLNN A,TERM
02200 SKIPA A,STATUS(A)
02300 MOVEI A,2
02400 JRST C.XIT1
02500
02600
02700 ;PDG -- GETS PROC ITEM IN -1(P) INTO C , CHECKS TYPE, & PUTS DATUM INTO A
02800 ;CALLED BY JSP TEMP,PDG
02900 ;SIDE EFFECTS: USES USER, PUTS OLD VALUE OF C INTO -1(P), SKIP RETURNS IF
03000 ;THE ITEM WAS OK. OTHERWISE RETURNS WITH A= WHATEVER TYPE ITEM IN C IS
03100
03200 PDG: EXCH C,-1(P) ;ITEM NUMBER
03300 MOVE USER,GOGTAB
03400 LDB A,INFOTAB(USER)
03500 CAIE A,PRCTYP
03600 JRST (TEMP) ;WAS NOT A PROC ITEM
03700 MOVE A,@DATAB(USER)
03800 JRST 1(TEMP) ;RETURN
03900
00100 COMMENT ⊗ PRISET -- ROUTINE USER CALLS TO CHANGE PRIORITY ⊗
00200
00300 HERE(PRISET)
00400 MOVE C,-2(P) ;ITEM
00500 MOVE TABL,GOGTAB ;
00600 LDB A,INFOTAB(TABL)
00700 CAIE A,PRCTYP
00800 ERR <ATTEMPT TO SET PRIORITY OF NON PROCESS ITEM>
00900 MOVE PB,@DATAB(TABL) ;GET DATUM
01000 TLNE PB,TERM
01100 ERR <ATTEMPT TO SET PRIORITY OF TERMINATED PROCESS>
01200 PUSHJ P,REMPRI ;TAKE OFF MY LIST
01300 MOVE A,-1(P)
01400 CAIG A,17 ;CHECK BOUNDS
01500 CAIGE A,0
01600 ERR <ERR ATTEMPT TO GIVE A PROCESS AN ILLEGAL PRIORITY>
01700 PUSHJ P,SETPRI
01800 SUB P,X33
01900 JRST @3(P)
02000
00100 COMMENT ⊗SPECIAL GC ROUTINE FOR PROCESSES⊗
00200
00300
00400 HERE(%PSSGC)
00500 MOVE TEMP,RUNNER
00600 MOVEM SP,ACSP(TEMP)
00700 MOVE RF,RACS+RF(USER)
00800 MOVEM RF,ACF(TEMP)
00900 HRLZI B,-NPRIS
01000 HRR B,GOGTAB
01100 SCHL1: SKIPN TEMP,PRILIS(B)
01200 JRST NXLS
01300 PUSH P,B
01400 SCHL2: MOVE RF,ACF(TEMP)
01500 PUSH P,TEMP
01600 PUSHJ P,%ARSR1
01700 MOVE TEMP,(P)
01800 HRRZ A,ISP(TEMP)
01900 MOVE SP,ACSP(TEMP)
02000 PUSHJ P,%SPGC1
02100 POP P,TEMP
02200 HRRZ TEMP,PLISTE(TEMP)
02300 JUMPN TEMP,SCHL2
02400 POP P,B
02500 NXLS: AOBJN B,SCHL1
02600 MOVE TEMP,RUNNER
02700 MOVE SP,ACSP(TEMP)
02800 POPJ P,
02900
03000
03100
03200
03300
03400
00100 COMMENT ⊗INTERRUPT ROUTINES⊗
00200
00300 INTDBG←←0
00400 NOTENX<
00500
00600 IFE INTDBG <
00700 OPDEF DISMIS [ CALLI 400024]
00800 >;IFE INTDBG
00900 IFN INTDBG <
01000 DEFINE DISMIS < JRST DSMMSR >
01100 DSMMSR: HRLZI P,INACS
01200 BLT P,P
01300 JRST @JOBTPC
01400 INACS: BLOCK 20
01500 >;IFN INTDBG
01600 OPDEF INTORM [ CALLI 400026]
01700 OPDEF INTACM [ CALLI 400027]
01800 OPDEF INTENB [ CALLI 400025]
01900
02000 >;NOTENX
02100
02200 HERE(DDFINT) ;DO DEFERRED INTERRUPT
02300 SKIPE NOPOLL ;IGNORING IT?
02400 POPJ P, ;YES
02500 SETZM INTRPT ;
02600 MOVE USER,RUNNER ;NEED TO SAVE ACS
02700 MOVNS STATUS(USER) ;READY
02800 MOVEI TEMP,AC0(USER) ;
02900 BLT TEMP,ACP(USER) ;
03000 MOVEI A,1 ;NEED ALL ACS
03100 MOVEM A,REASON(USER) ;
03200 JRST FOTR ;SEE WHOM TO RUN
03300
03400 HERE(INTSET)
03500
03600 ;CALL IS INTSET(ITEM,SPROUT OPTS)
03700 ;ORS IN THE STATUS OPTIONS FOR SPNDNP+RUNME
03800 ;TURNS OFF THE OPTION FOR SPNDME
03900 NOTENX<
04000 PUSHJ P,INTTBG ;BE SURE HAVE TABLES
04100 >;NOTENX
04200 PUSH P,-2(P) ;ITEM
04300 PUSH P,[INTPDA] ;INTERRUPT PROCEDURE
04400 MOVE A,-2(P) ;GET OPTIONS
04500 TRZ A,SPNDME ;SET UP STATUS FIELD
04600 TRO A,SPNDNP+RUNME ;
04700 PUSH P,A ;
04800 PUSH P,[0] ;NO KILL SET
04900 PUSHJ P,SPROUT ;SPROUT IT
05000
05100 MOVE C,-2(P) ;THE ITEM
05200 MOVE A,@DATM
05300 MOVE USER,GOGTAB
05400 MOVEM A,INTPRC(USER) ;REMEMBER INTERRUPT PROCESS BASE
05500 MOVE A,-1(P) ;
05600 TRNE A,PRIMSK ;DID HE SPEC A PRIORITY
05700 JRST POK
05800
05900 PUSH P,C ;ITEM
06000 PUSH P,[0]
06100 PUSHJ P,PRISET ;SET THE PRIORITY
06200 POK:
06300 SUB P,X33
06400 JRST @3(P)
06500
06600 NOTENX<
06700 INTTBG: MOVE USER,GOGTAB ;
06800 SKIPE DISPAT(USER) ;HAVE TABLES???
06900 POPJ P, ;YES
07000 PUSH P,[=128] ;DEFAULT BUFFER SIZE
07100 PUSHJ P,INTTB1 ;GO GET EM
07200 POPJ P,
07300
07400
07500 HERE(INTTBL)
07600 ;CALL IS INTTBL(BUFFER_SIZE)
07700 ;SETS UP TABLES NEEDED BY THE INTERRUPT SYSTEM
07800
07900 MOVE USER,GOGTAB ;
08000 INTTB1: MOVEI C,=100
08100 ADD C,-1(P)
08200 PUSHJ P,CORGET
08300 ERR <NOT ENOUGH SPACE FOR INTSET>
08400 SKIPN D,DISPAT(USER) ;ALREADY HABE ONE?
08500 JRST INTTB2 ;NO
08600 MOVSS D
08700 HRR D,B ;D ← OLD,,NEW
08800 BLT D,=71(B) ;COPY OLD DISPAT TABLE
08900 JRST INTTB3
09000 INTTB2: SETZM (B)
09100 HRL A,B
09200 HRRI A,1(B)
09300 ADDI C,-1(B)
09400 BLT A,(C)
09500 INTTB3: HRLI B,10
09600 MOVEM B,DISPAT(USER)
09700 ADDI B,=36
09800 MOVEM B,DFRINF(USER)
09900 ADDI B,=36
10000 HRRZM B,INTQWB(USER)
10100 HRRZM B,INTQWP(USER)
10200 HRRZM B,INTQRP(USER)
10300 ADD B,-1(P)
10400 HRRZM B,INTQWT(USER)
10500 HRLI B,-20
10600 MOVEM B,IPDP(USER)
10700 SUB P,X22
10800 JRST @2(P)
10900
11000
11100
11200 TIEMB: HRLZI A,000200 ;INTCLK BIT(I THINK)
11300 CALLI A,400026 ;INTORM
11400 POPJ P,
11500
11600 IFN INTDBG,<
11700 INTAPR: MOVEM P,INACS+17
11800 MOVEI P,INACS
11900 BLT P,INACS+16
12000 >;IFN INTDBG
12100
12200 HERE(INTMOD)
12300 MOVE USER,GOGTAB
12400 MOVE 7,JOBCNI ;PICK UP THE BITS
12500 MOVE P,IPDP(USER) ;A PDL FOR THIS
12600 DSPIT: JFFO 7,DODISP ;DISPATCH INDEX
12700 ERR < DRYROT IN INTMOD >
12800 DODISP: SKIPN 7,@DISPAT(USER) ;GO DISPATCH
12900 DISMIS ;DISMISS
13000 PUSHJ P,(7) ;
13100 DISMIS
13200
13300 HERE(CLKMOD)
13400 MOVE USER,GOGTAB ;
13500 SOSG TIMER(USER) ;IF COUNTDOWN COMPLETE THEN
13600 SETOM INTRPT ;SIGNAL THE INTERRUPT
13700 POPJ P, ;LET CALLER DISMIS
13800
13900 DEFINE QW(VALAC,WPAC,RPTR,WTOP,WBOT,OVINST) <
14000 MOVEM VALAC,(WPAC)
14100 ADDI WPAC,1
14200 CAMLE WPAC,WTOP
14300 MOVE WPAC,WBOT
14400 CAMN WPAC,RPTR
14500 OVINST
14600 >
14700
14800 DEFINE QR(VALAC,WPTR,RPAC,WTOP,WBOT,OVINST) <
14900 CAMN RPAC,WPTR
15000 OVINST
15100 MOVE VALAC,(RPAC)
15200 ADDI RPAC,1
15300 CAMLE RPAC,WTOP
15400 MOVE RPAC,WBOT
15500 >
15600
15700 DEFINE IQW(VAC) <
15800 QW(VAC,11,<INTQRP(USER)>,<INTQWT(USER)>,<INTQWB(USER)>,< JRST IQWOV >)
15900 >
16000
16100 HERE(DFR1IN)
16200 MOVE USER,GOGTAB ;SO CAN CALL ANY TIME
16300 MOVE 11,INTQWP(USER)
16400 IQW 1
16500 IQW 6
16600 MOVE TEMP,JOBCNI
16700 IQW TEMP
16800 MOVE TEMP,JOBTPC
16900 IQW TEMP
17000 MOVE TEMP,RUNNER
17100 IQW TEMP
17200 MOVE 1,-1(P)
17300 VILOOP: MOVE TEMP,(1)
17400 IQW TEMP
17500 AOBJN 1,VILOOP
17600 MOVEM 11,INTQWP(USER)
17700 SETOM INTRPT
17800 SKIPN 7,INTPRC(USER) ;INTERRUPT PROCESS
17900 JRST DF.X
18000 MOVEI TEMP,1 ;READY
18100 SKIPL STATUS(7)
18200 MOVEM TEMP,STATUS(7)
18300 DF.X: SUB P,X22
18400 JRST @2(P)
18500
18600 IQWOV: ERR <DRYROT IN INTMOD -- WRITER>
18700 JRST DF.X
18800
18900 HERE(DFRINT)
19000 PUSH P,@DFRINF(USER)
19100 PUSHJ P,DFR1IN
19200 POPJ P,
19300
19400
19500
00100
00200 >;NOTENX
00300
00400 TENX<
00500 HERE(INTTBL)
00600 ;Ought to call INTPRO at this point, just to make sure any pending
00700 ;interrupts have been processed before we rearrange the buffers, but
00800 ;INTPRO is a separate process and I can't just PUSHJ so stare at it later
00900 HRRZ C,(P)
01000 PUSHJ P,CORGET
01100 ERR <Can't allocate core for larger interupt buffers - INTTBL>
01200 HRRZI B,(B)
01300 EXCH B,DFIBUF
01400 PUSHJ P,CORREL
01500 POP P,DFIBT ;Ptr to highest addr in DFI buffer
01600 SUBI B,4 ;Good luck margin
01700 PUSHJ P,INDFIB ;Inits the other pointers.
01800 POPJ P,
01900
02000
02100 HERE(DFR1IN)
02200 ;This routine is normally called from interrupt level by the user's
02300 ;interrupt fn (given to INTMAP).
02400 POP P,@DFIBP ;Store arg into DFI buffer
02500 AOS A,DFIBP ;Step control ptr
02600 CAMLE A,DFIBT
02700 ERR <Defferred-interrupt buffer overflowed in DFR1IN>
02800 SUB A,LSTDFI
02900 ;Now compute number of buffer words used between this call to DFR1IN
03000 ;and the last. They are pseudo-args for the fn buffered by last DFR1IN
03100 ;They get put in by another fn run at interrupt level by user's INTMAP
03200 ;fn, namely STASH.
03300 SUBI A,2
03400 HRLM A,@LSTDFI ;Count goes in LH of last DFR1IN entry
03500 HRRZ A,DFIBP ;Then update LSTDFI to point to entry just made
03600 HRRZM A,LSTDFI
03700 POPJ P,
03800
03900
04000 HERE(STASH)
04100 ;Called by user code (in the fn he gave to INTMAP) while at interrupt
04200 ;level. Puts one word of data into DFI buffer for use at a polling pt
04300 ;by the fn last buffered by DFR1IN.
04400 POP P,@DFIBP
04500 AOS A,DFIBP
04600 CAMLE A,DFIBT
04700 ERR <Deferred interrupt buffer overflowed in STASH>
04800 POPJ P,
04900 >;TENX
00100 COMMENT ⊗THE INTERRUPT PROCESS⊗
00200
00300
00400 DEFINE IQR(AC) <
00500 QR (AC,<INTQWP(USER)>,D,<INTQWT(USER)>,<INTQWB(USER)>,<JRST QRERR>)
00600 >
00700
00800 HERE(INTPRO)
00900 PUSH P,RF
01000 PUSH P,INPDA0
01100 PUSH P,SP
01200 MOVE USER,GOGTAB
01300 NOTENX<
01400 DO1INT: MOVE D,INTQRP(USER) ;READER OF THE QUEUE
01500 QR (1,<INTQWP(USER)>,D,<INTQWT(USER)>,<INTQWB(USER)>,< JRST ALDCIS >);
01600 IQR 6
01700 IQR TEMP
01800 MOVEM TEMP,IJBCNI(USER)
01900 IQR TEMP
02000 MOVEM TEMP,IJBTPC(USER)
02100 IQR TEMP
02200 MOVEM TEMP,IRUNNR(USER)
02300 IQR B
02400 JUMPE B,DISDFI
02500 DO1I.1:
02600 IQR C
02700 MOVEM D,INTQRP(USER)
02800 SOJLE B,DO1I.2
02900 PUSH P,C
03000 JRST DO1I.1
03100 DO1I.2: HLRZ D,C
03200 CAIN D,-1 ;IS THIS A PDA
03300 JRST DO1I.4 ;NO -- JUST ISSUE THE CALL
03400 TLNN C,-1 ;WAS THERE A CONTEXT??
03500 JRST DO1I.3 ;NO
03600 MOVS D,C ;PDA,,STATIC LINK
03700 HRRZ TEMP,PD.PPD(C) ;PARENTS PDA
03800 PUSH P,[ DO1INT]
03900 PUSH P,RF
04000 HLRZ LPSA,1(D) ;THE PDA IIN THE STACK
04100 CAIE LPSA,TEMP ;BETTER BE THE SAME
04200 ERR <ATTEMPT TO REFERENCE A NON-EX ENVIRONMENT IN INTPRO >
04300 PUSH P,D ;STATIC LINK
04400 PUSH P,SP ;SAVE SP
04500 HLRZ C,PD.PPD ;END OF MKSEMT
04600 JRST (C)
04700 DO1I.3: HRRZ C,PD.(C) ;ENTRY ADDRESS
04800 DO1I.4: PUSHJ P,(C) ;CALL THE PROCEDURE
04900 JRST DO1INT
05000 >;NOTENX
05100 TENX<
05200 PUSH P,[[AOS (P)
05300 POPJ P,]] ;Push ptr to skipping dummy routine
05400 PUSHJ P,DFR1IN ;Completes count field for prev. call
05500 ;to DFR1IN and provides skip out of loop below
05600 SKIPA A,DFIBUF ;Omit doing first DFI entry -another dummy
05700 DO1INT: HRRZ A,DFIBP ;A -> last DFI block done
05800 HLRZ B,(A) ;# data words this block
05900 ADDI A,1(B) ;Plus 1 for header itself
06000 HRRZM A,DFIBP ;Step ptr over to next block
06100 HRRZI B,1(A) ;ptr to data
06200 PUSH P,B ;is first arg for userfn
06300 HLRZ B,(A) ;Count of data
06400 PUSH P,B ;is 2nd
06500 HRRZ A,(A)
06600 PUSHJ P,(A) ;Run the user fn now addressed by A
06700 JRST DO1INT ;and loop. Our dummy skips when we're
06800 PUSHJ P,INDFIB ;done so reset buffer ptrs.
06900 >;TENX
07000 ALDCIS: MOVE PB,RUNNER ;ALL DONE CURRENT INTERRUPTS
07100 SETZM STATUS(PB) ;SUSPEND SELF
07200 PUSHJ P,SPSRN1
07300 JRST DO1INT
07400
07500 TENX<
07550 INTERNAL INDFIB
07600 HERE(INDFIB)
07700 HRRZ A,DFIBUF ;Clear buffer by resetting control ptrs
07800 HRRZM A,LSTDFI ;First buffer word is a 1-word null block
07900 ADDI A,1 ;in case user STASHes w/o doing DFR1IN FIRST
08000 SETZM @DFIBUF ;zero it
08100 POPJ P,
08200 >;TENX
08300 NOTENX<
08400 QRERR: ERR <DRYROT IN INTPRO -- READER>
08500 JRST ALDCIS
08600
08700
08800 DISDFI: ERR <STRANGENESS IN DEFERRED INTERRUPT>,1
08900 JRST DO1INT
09000 >;NOTENX
09100
09200 DEFINE IPDE(X,V), < PUTINLOC(INTPDA+X,V) >
09300
09400 INTPDA: BLOCK PD.XXX+1
09500
09600 IPDE (PD.,INTPRO)
09700 IPDE (PD.DSW,3)
09800 IPDE (PD.PDA,<<INPDA0: XWD INTPDA,0>>)
09900 IPDE (PD.LLW,<INTPDA+PD.XXX>)
10000 IPDE (PD.DLW,<INTPDA+PD.XXX>)
10100
10200
00100 COMMENT ⊗PROCEDURES TO ENABLE FOR INTERRUPTS⊗
00200
00300 NOTENX<
00400 ;ENABLE(INDEX) -- DOES AN INTORM
00500 ;DISABLE(INDEX) -- DOES AN INTACM
00600
00700 HERE(ENABLE)
00800 SKIPA B,[ INTORM A, ]
00900 HERE(DISABLE)
01000 MOVE B,[ INTACM A, ]
01100 MOVN C,-1(P)
01200 HRLZI A,400000
01300 LSH A,(C)
01400 XCT B
01500 SUB P,X22
01600 JRST @2(P)
01700
01800
01900 ;INTMAP(INDEX,ENTRY_ADDR,PARAM);
02000 ;DISPAT[INDEX]←ENTRY_ADDR
02100 ;DFRINF[INDEX]←PARAM
02200
02300 HERE(INTMAP)
02400
02500 IFE INTDBG,<
02600 MOVEI A,INTMOD
02700 >;IFE INTDBG
02800 IFN INTDBG,<
02900 MOVEI A,INTAPR
03000 >;IFN INTDBG
03100 MOVEM A,JOBAPR
03200 PUSHJ P,INTTBG ;BE SURE HAVE TABLES
03300 MOVE 10,-3(P) ;GET INDEX
03400 POP P,-3(P) ;RET ADR
03500 POP P,@DFRINF(USER)
03600 POP P,@DISPAT(USER)
03700 POPJ P,
03800 >;NOTENX
03900 TENX<
04000 HERE(ENABLE)
04100 SKIPA C,[JSYS AIC]
04200 HERE(DISABLE)
04300 MOVE C,[JSYS DIC]
04400 MOVN A,-1(P)
04500 HRLZI B,400000
04600 LSH B,(A)
04700 HRRZI A,400000 ;Fork handle for 'this fork'
04800 XCT C
04900 SUB P,X22
05000 JRST @2(P)
05100
05200 HERE(INTMAP)
05300 MOVE B,-2(P)
05400 HRLI B,3 ;Interrupt level 3
05500 HRRZ A,-1(P)
05600 CAIG A,=36
05700 JUMPGE A,.+1
05800 ERR <INTMAP: Channels must be between 0 and 36 decimal>
05900 MOVEM B,CHNTAB(A)
06000 SUB P,X33
06100 JRST @3(P)
06200 >;TENX
06300
06400
06500
06600
06700 ;DFCPKT(5 WD BLOCK ADDR,EVTYP,EVNOT,OPTS)
06800 ; CREATES A FIVE WORD BLOCK FOR A DEFERED CAUSE & RETURNS AN AOBJN
06900 ; POINTER TO THE BLOCK
07000 ; IF THE SUPPLIED BASE ADDRESS IS ≠0 THEN USES THAT ADDRESS
07100 ; OTHERWISE DOES A CORGET TO GET THE FIVE WORDS
07200
07300 HERE(DFCPKT)
07400 SKIPE B,-4(P) ;DID USER GIVE ME A BLOCK
07500 JRST DFC.1 ;YES
07600 MOVEI C,5
07700 PUSHJ P,CORGET
07800 ERR <NO CORE LEFT>
07900 DFC.1: HRLI B,-5
08000 MOVE A,B ;AOBJN PTR
08100 SUB B,X11 ;READY FOR PUSHES
08200 PUSH B,[4]
08300 PUSH B,-3(P)
08400 PUSH B,-2(P)
08500 PUSH B,-1(P)
08600 PUSH B,[XWD -1,CAUSE]
08700 SUB P,[XWD 5,5]
08800 JRST @5(P) ;RETURN
08900
00100 COMMENT ⊗ CAUSE ⊗
00200
00300 HERE(CAUSE)
00400 MOVE PB,RUNNER
00500 AOS A,CAUSES(PB)
00600 CAIE A,1 ;FIRST CAUSE?
00700 JRST DFRCS ;NO -DEFER IT
00800 POP P,CAUSRA(PB) ;SAVE RETN ADDRESS
00900 CSIT: PUSHJ P,CAUSE1 ;DO THE WORK
01000 MOVE PB,RUNNER
01100 SOSG A,CAUSES(PB) ;DONE ONE
01200 JRST CSE.X ;ALL ARE DONE -- CHECK FOR SCHED REQ
01300 MOVEI KL,CAUSEQ(PB) ;GET NEXT FROM QUEUE
01400 PUSHJ P,REMCAR
01500 HLRZ B,(A) ;PICK UP TYPE
01600 PUSH P,B
01700 HRRZ B,(A) ;NOTICE
01800 PUSH P,B
01900 PUSH P,1(A) ;OPTIONS
02000 MOVE TABL,GOGTAB
02100 HRR B,FP2(TABL) ;RELEASE 2 WD BLOCK
02200 HRRM B,(A)
02300 HRRM A,FP2(TABL)
02400 JRST CSIT ;GO WORK ON THIS
02500 DFRCS: MOVE TABL,GOGTAB ;
02600 NNCLL2 (B) ;GET 2 WD CELL
02700 POP P,TMP ;RETURN ADDRESS
02800 POP P,1(B) ;OPTS
02900 POP P,(B) ;NOTICE
03000 POP P,A ;TYPE
03100 HRLM A,(B)
03200 MOVEI KL,CAUSEQ(KL) ;PUT ON CAUSE QUEUE
03300 PUSHJ P,ITAILS ;PUT ON TAIL OF QUEUE
03400 JRST (TMP) ;RETURN
03500 CSE.X: MOVE USER,GOGTAB
03600 SKIPN SCHDRQ(USER) ;SCHEDULING REQUEST
03700 JRST @CAUSRA(PB) ;NO
03800 SETZM SCHDRQ(USER) ;YES
03900 PUSH P,CAUSRA(PB) ;YES
04000 JRST URSCHD ;RESCHEDULE
04100
00100 COMMENT ⊗CAUSE1 -- ROUTINE TO DO ACTUAL WORK ⊗
00200
00300 ;;# #↓ THIS SHOULD BE CAUSE1 -- SEE EXTRA HERE AREA AT END OF FILE
00400 CSE1: JSP TMP,EVTCK3 ;VERIFY THAT THIS IS AN EVENT ITEM
00500 ;ALSO EVT ← DATUM ,B&C←ITEM #
00600 SKIPE PDA,CAUSEP(EVT) ;DID THE USER SAY SOMETHING???
00700 JRST USPPRC ;USER SPEC PROCEDURE
00800 MOVE FF,-1(P) ;OPTIONS
00900 SKIPN TMP,WAITLS(EVT) ;WAS ANYONE WAITING?
01000 JRST SCA.2 ;NO
01100 MOVE TEMP,B ;EV TYP NO
01200 MOVE TMP,(TMP) ;LAST,,FIRST
01300 MOVE D,-2(P) ;NOTICE NO
01400 SCA.1: MOVE TMP,(TMP) ;WAIT ENTRY
01500 HLRZ C,TMP ;PROCESS NO
01600 MOVE TABL,GOGTAB ;SET TABL TO RIGHT THING
01700 PUSHJ P,ANSWR1 ;SPECIAL ENTRY POINT IN ANSWER
01800 TRNE A,NOJOY ;DID WE SUCCEED??
01900 JRST SCA.1A ;NO
02000 TRNN A,RETAIN ;KEEP THE NOTICE??
02100 TRO FF,DNTSAV ;YES
02200 TRNN FF,TELLAL ;TELL THE WHOLE WORLD?
02300 JRST SCA.2 ;NO
02400 SCA.1A: TRNE TMP,-1 ;ANY LEFT
02500 JRST SCA.1 ;YES
02600
02700 SCA.2: TRNE FF,DNTSAV ;SAVE IT?
02800 JRST SCA.3 ;NO
02900 MOVE B,-2(P) ;ITEM NO OF NOTICE
03000 MOVEI KL,NOTCLS(EVT) ;
03100 PUSHJ P,ITAILS ;PUT ON END OF NOTIICE LIST
03200 SCA.3:
03300 MOVE USER,GOGTAB
03400 TRNE FF,SCHDIT ;WANT TO RESCHEDULE
03500 SETOM SCHDRQ(USER) ;RESCHEDULE REQUEST
03600 SCA.X: SUB P,X44 ;RETURN
03700 JRST @4(P)
03800
03900 USPPRC: MOVE B,PD.(PDA) ;HERE IF USER SPECIFIED A PROCEDURE
04000 TLNE PDA,-1 ;CONTEXT GIVEN
04100 JRST (B) ;NO
04200 PUSH P,RF ;SET UP CONTEXT
04300 HRRZ C,PD.PPD ;PARENTS PDA
04400 MOVS A,PDA ;
04500 HLRZ D,1(A)
04600 CAME D,C ;SAME?
04700 ERR <CONTEXT WRONG OR CLOBBERED IN INTERP CALL
04800 USER SPEC EVENT PROC >
04900 PUSH P,A ;STATL
05000 PUSH P,SP
05100 HLRZ B,PD.PPD(PDA)
05200 JRST (B) ;GO TO INSTR AFTER THE MKSEMT
05300
00100 COMMENT ⊗ANSWER -- subroutine used by CAUSE⊗
00200
00300 HERE(ANSWER)
00400
00500 ;A←ANSWER(EV_TYP,NOT,PROCESS_ITEM);
00600 ;IF ATTEMPT TO ANSWER INTERROGATE IS SUCCESSFUL, A ← REQUEST CODE
00700 ;OTHERWISE, NOJOY BIT IS ON IN A & REST OF WORD IS INVALID
00800
00900 MOVE TEMP,-3(P) ;EV TYPE
01000 POP P,-3(P) ;RET ADRS
01100 POP P,C ;PROCESS ITEM
01200 POP P,D ;NOTICE
01300 MOVE TABL,GOGTAB
01400 LDB B,INFOTAB(TABL)
01500 CAIE B,PRCTYP
01600 ERR <NOT A PROCESS ITEM>
01700
01800 ;THE REST OF THIS IS CALLED INTERNALLY
01900 ;EXPECTS D= NOIICE, C=PROCESS ITEM, TEMP=EV TYPE
02000 ; ALSO TABL SET UP FOR PROCESS ITEM
02100 ;MODIFIES A,B,C,TABL,PB,TEMP,USER
02200
02300 ANSWR1: MOVE PB,@DATAB(TABL) ;THE PROCESS BASE
02400 TLNN PB,TERM ;TERMINATED?
02500 SKIPE STATUS(PB) ;OR NOT SUSPENDED??
02600 JRST NOANS ;YES
02700 AOS STATUS(PB) ;MAKE READY
02800 MOVEM D,AC1(PB)
02900 ANSWR2: PUSHJ P,DELWRQ ;DELETE ALL WAIT REQUESTS
03000 MOVE A,INTRGC(PB) ;THE INTERROG CONTROL WORD
03100 TRNN A,SAYWCH ;ASKED FOR THE ASSOCIATION
03200 POPJ P, ;NO
03300 PUSH P,[EVTYPI] ;
03400 PUSH P,D
03500 PUSH P,TEMP
03600 PUSHJ P,STACSV ;SAVE ALL ACS
03700 MOVEI 5,16 ;MAKE
03800 PUSHJ P,LEAP
03900 PUSHJ P,STACRS ;GET ACS BACK
04000 POPJ P,
04100 NOANS: TRO A,NOJOY
04200 POPJ P, ;RETURN
00100 COMMENT ⊗DELWRQ -- delete all wait requests⊗
00200
00300 ;EXPECTS PB = THIS PROCESS
00400 ;MANGLES A,B,C,TABL
00500
00600 DELWRQ: SKIPN A,WAITES(PB)
00700 POPJ P,
00800 PUSH P,KL
00900 MOVE A,(A) ;A IS LAST,,FIRST
01000 DTHSRQ: MOVE A,(A) ;NEXT ENTRY
01100 HLRZ C,A ;ITEM NUMBER OF TYPE
01200 PUSH P,A ;FOR SAFE KEEPING
01300 MOVE TABL,GOGTAB ;
01400 MOVE A,@DATAB(TABL)
01500 MOVEI KL,WAITLS(A)
01600 MOVE B,PRCITM(PB)
01700 PUSHJ P,DELTLE ;DELETE ELEMENT
01800 POP P,A
01900 TRNE A,-1 ;ANY LEFT
02000 JRST DTHSRQ ;YES
02100 MOVE A,WAITES(PB)
02200 MOVE TABL,GOGTAB
02300 HLRZ B,(A) ;ADDRESS OF LAST
02400 HRRZ C,FP1(TABL)
02500 HRRM C,(B) ;RELEASE THE LOT
02600 HRRM A,FP1(TABL)
02700 SETZM WAITES(PB) ;NONE LEFT
02800 POP P,KL
02900 POPJ P,
00100 COMMENT ⊗INTERROGATE⊗
00200 HERE(INTERROGATE)
00300 SKIPN B,-2(P) ;SET OR ITEM
00400 ERR <NULL INTERROGATION???>
00500 TLNN B,-1 ;SET?
00600 JRST ASK1.0 ;NO
00700 MOVEI FF,MULTIN
00800 IORM FF,-1(P) ;SAY MULT REQUEST
00900 MOVE TMP,(B) ;LAST,,FIRST
01000 MPCI: MOVE TMP,(TMP) ;NEXT ENTRY
01100 HLRZ B,TMP
01200 PUSH P,TMP
01300 PUSH P,B ;TYPE ITEM
01400 PUSH P,-3(P) ;OPTIONS WORD
01500 PUSHJ P,ASK1.0
01600 POP P,TMP ;GET LIST BACK
01700 CAIE A,NIC ;FIND ONE??
01800 JRST ASK1.X ;YES
01900 TRNE TMP,-1 ;DONE LIST???
02000 JRST MPCI ;NO
02100 MOVE FF,-1(P)
02200 TRNN FF,WAIT ;WAITING REQUESTED
02300 JRST ASK1.X ;NO
02400 MOVE PB,RUNNER ;SUSPEND SELF
02500 MOVE B,-2(P) ;THE LIST
02600 MOVE TMP,(B) ;LAST,,FIRST
02700 BWL: MOVEI KL,WAITES(PB)
02800 MOVE TMP,(TMP) ;NEXT
02900 HLRZ B,TMP ;ITEM NO
03000 MOVE C,B
03100 MOVE EVT,@DATM
03200 PUSHJ P,ITAILS ;ON TAIL
03300 MOVE B,PRCITM(PB) ;
03400 MOVEI KL,WAITLS(EVT)
03500 PUSHJ P,ITAILS ;ON EVENT WAIL LIST
03600 TRNE TMP,-1
03700 JRST BWL ;CDR DOWN LIST
03800 JRST DOWAIT ;GO WAIT
00100 COMMENT ⊗ASK -- used by INTERROGATE⊗
00200
00300 ASK1I: MOVE B,-2(P)
00400 ASK1.0: JSP TMP,EVTCKB ;GET DATUM OF EVENT TYPE
00500 SKIPE A,INTRGP(EVT) ;USER WAIT PROCESS??
00600 JRST USPPRC ;YES
00700 ;;# #↓ ASKNTC POINTS HERE-- SEE EXTRA HERE AREA AT EOF
00800 ASKN: MOVE FF,-1(P) ;CONTROL WORD
00900 SKIPN A,NOTCLS(EVT) ;ANY READY TO GO
01000 JRST ASK1.4 ;NO
01100 TRNE FF,RETAIN ;RETAIN THIS ONE??
01200 JRST ASK1.1 ;YES
01300 MOVEI KL,NOTCLS(EVT)
01400 PUSHJ P,REMCAR ;GET THE FIRST
01500 JRST ASK1.2 ;TEST SAYWCH
01600 ASK1.1: MOVE A,(A)
01700 HLRZ A,(A) ;THI FIRST ITEM
01800 ASK1.2: TRNN FF,SAYWCH ;WANT ASSOCIATION
01900 JRST ASK1.3 ;NO
02000 PUSH P,[EVTYPI] ;EVENT TYPE
02100 PUSH P,A ;NOTICE
02200 PUSH P,-4(P) ;WHATEVER TYPE IT IS
02300 PUSHJ P,STACSV ;SAVE REGS
02400 MOVEI 5,16 ;MAKE
02500 PUSHJ P,LEAP
02600 PUSHJ P,STACRS ;GET ACS BACK
02700 ASK1.3:
02800 ASK1.X: SUB P,X33
02900 JRST @3(P) ;RETURN
03000
03100 ASK1.4: MOVEI A,NIC
03200 TRNE FF,WAIT ;IF NOT WAITING OR
03300 TRNE FF,MULTIN ;MUL REQ
03400 JRST ASK1.X ;ALL DONE
03500 MOVE PB,RUNNER
03600 MOVEI KL,WAITES(PB) ;WAIT ON THIS ONE
03700 PUSHJ P,ITAILS ;PUT ON TAIL
03800 MOVE B,PRCITM(PB)
03900 MOVEI KL,WAITLS(EVT)
04000 PUSHJ P,ITAILS
04100 DOWAIT: SETZM STATUS(PB)
04200 MOVEM FF,INTRGC(PB)
04300 MOVEI A,WAITNG
04400 MOVEM A,REASON(PB)
04500 PUSHJ P,SPSRN2 ;WAIT
04600 JRST ASK1.X ;RETURN
04700
04800 ;ROUTINE TO SET UP EVENT TYPE ITEM
04900 ;SETS B & C TO ITEM #
05000 ;SETS EVT TO DATUM
05100 ;SETS TABL TO RIGHT THING FOR ITEM
05200 ;CALLED VIA JSP TMP,EVTCKX
05300
05400
05500 EVTCK3: SKIPA B,-3(P)
05600 EVTCK2: MOVE B,-2(P)
05700 EVTCKB: MOVE TABL,GOGTAB
05800 MOVE C,B
05900 LDB A,INFOTAB(TABL)
06000 CAIE A,EVTTYP
06100 ERR <THIS ITEM IS NOT AN EVENT TYPE>,6
06200 MOVE EVT,@DATAB(TABL)
06300 JRST (TMP)
00100 COMMENT ⊗MKEVTT,SETCP,& SETIP⊗
00200 HERE(SETCP)
00300 JSP TMP,EVTCK2
00400 MOVE A,-1(P)
00500 MOVEM A,CAUSEP(EVT)
00600 XIT3: SUB P,X33
00700 JRST @3(P)
00800
00900
01000 HERE(SETIP)
01100 JSP TMP,EVTCK2
01200 MOVE A,-1(P)
01300 MOVEM A,INTRGP(EVT)
01400 JRST XIT3
01500
01600 HERE(MKEVTT) ;MAKE EVENT TYPE
01700 MOVE C,-1(P)
01800 MOVEI A,EVTTYP
01900 MOVE TABL,GOGTAB
02000 DPB A,INFOTAB(TABL)
02100 MOVEI C,NEVARS
02200 PUSHJ P,CORGET
02300 ERR <NO CORE LEFT -- MKEVT>
02400 MOVE C,-1(P)
02500 MOVE TABL,GOGTAB
02600 MOVEM B,@DATAB(TABL)
02700 HRLI D,(B)
02800 HRRI D,1(B)
02900 SETZM (B)
03000 BLT D,NEVARS-1(B)
03100 SUB P,X22
03200 JRST @2(P)
03300
00100 COMMENT ⊗SPARE HERE TABLE ENTRIES⊗
00200
00300 ;THE IDEA IS THAT THIS WAY WE HAVE FLEXIBILITY
00400 ;WITHOUT GOING TO A NEW SEGMENT ALL THE TIME
00500
00600 HERE(ASKNTC)
00700 PUSHJ P,EVTCK3 ;CHECK EVENT TYPE
00800 JRST ASKN ;GO DO IT
00900 HERE(CAUSE1)
01000 JRST CSE1 ;HERE CROCK
01100 HERE(NWLD3)
01200 HERE(NWLD4)
01300 HERE(NWLD5)
01400 ERR <DRYROT IN NWORLD>
01500
01600 BEND PROCSS
01700
01800 ENDCOM(PRC)
01900