Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
COMMENT VALID 00042 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 HISTORY
C00009 00003 MANY DECLARATIONS
C00015 00004 PROCESS VARIABLE NUMBERS
C00018 00005 event variables
C00019 00006 procedure descriptors & null process skeleton
C00021 00007 DSCR SPROUT -- THE PROCESS SPROUTER
C00028 00008
C00035 00009
C00036 00010 routines for inserting & deleting set elements
C00040 00011 USER REQUESTED SCHEDULING
C00045 00012 HERE(RESUME)
C00051 00013 SUSPEND and TERMINATE runtime routines
C00054 00014 The JOIN runtime routine
C00057 00015 THE MAIN PROCESS INITIALIZER
C00059 00016 CALLER , MYPROC, AND PSTATUS
C00061 00017 PRISET -- ROUTINE USER CALLS TO CHANGE PRIORITY
C00062 00018 SPECIAL GC ROUTINE FOR PROCESSES
C00063 00019 INTERRUPT ROUTINES
C00067 00020
C00068 00021 THE INTERRUPT PROCESS
C00071 00022
C00072 00023 CAUSE
C00074 00024 CAUSE1 -- ROUTINE TO DO ACTUAL WORK
C00077 00025 ANSWER -- subroutine used by CAUSE
C00079 00026 DELWRQ -- delete all wait requests
C00081 00027 INTERROGATE
C00083 00028 ASK -- used by INTERROGATE
C00086 00029 MKEVTT,SETCP,& SETIP
C00088 00030 SPARE HERE TABLE ENTRIES
C00089 00031 COMPIL(IRP,,,,,,DUMMYFORGDSCISS)
C00091 00032 HERE(INTTBL)
C00093 00033 PROCEDURES TO ENABLE FOR INTERRUPTS
C00105 00034 HERE(IRPSP1)
C00106 00035
C00107 00036 HERE(INTTBL)
C00110 00037 DSCR
C00115 00038 HERE(PSIDISMS)
C00117 00039 HERE(PSIRUNTM)
C00121 00040 HERE(KPSITIME)
C00122 00041
C00123 00042
C00124 ENDMK
C;
COMMENT HISTORY
AUTHOR,REASON
021 102100000026 ;
COMMENT
VERSION 17-1(22) 2-13-75 BY RHT FIX THE FILE SO SCISS WILL WORK AGAIN
VERSION 17-1(21) 2-1-75 BY RLS TENEX
VERSION 17-1(20) 2-1-75 BY RLS INSTALL TENEX PSI SYSTEM
VERSION 17-1(20) 11-12-74 BY RHT FEAT %BX% MAKE SETPRI WORK FIFO
VERSION 17-1(19) 6-6-74 BY RHT MAKE KACTS USE ALLPDP
VERSION 17-1(18) 5-23-74 BY RHT BUG #SC# DOCUMENTATION BUG FIXED BY CODE CHANGE TO INTPRO
VERSION 17-1(17) 5-23-74
VERSION 17-1(16) 1-18-74 BY RHT BUG #QK# INSERTING AN ELEMENT IN A LIST W/O TABL SET UP FOR GLOBAL HACK
VERSION 17-1(15) 1-8-74 BY RHT FINISH %BE% HACK
VERSION 17-1(14) 1-8-74 BY RHT FEAT %BE% GLOBAL EVENTS OF A SORT
VERSION 17-1(13) 1-8-74
VERSION 17-1(12) 12-8-73 BY JRL REMOVE SPECIAL STANFORD CHARACTERS(WHERE POSSIBLE)
VERSION 17-1(11) 12-8-73 BY RHT FIX IEXT5 SCREW FOR EXPO WORLD
VERSION 17-1(10) 12-8-73 BY RHT CHANGE PLACE WHERE REMEMBER THE APRENB BITS
VERSION 17-1(9) 12-4-73 BY rht fix process string garb coll routine
VERSION 17-1(8) 12-3-73 BY RHT MAKE SUSPEND(OTHERGUY) RETURN ANY
VERSION 17-1(7) 12-2-73 BY RHT ADD A FEW IRP SPARES
VERSION 17-1(6) 10-30-73 BY RHT BUG #OU# A TYPO IN %AA%
VERSION 17-1(5) 10-30-73 BY RHT BUG #OT# SPROUT APPLY BUG
VERSION 17-1(4) 10-28-73 BY RHT FEAT %AG% INITIALIZE RSMR_DADDY WHEN SPROUT
VERSION 17-1(27) 10-14-73 BY RHT BUG #OO# SPROUT APPLY TROUBLES
VERSION 17-1(26) 9-1-73 BY RHT FEATURE %AA% -- ADD CODE FOR SPROUT DEFAULTS
VERSION 17-1(25) 8-19-73 BY RHT FIX COMPIL FOR SAIIRP TO KNOW ABOUT APRACS
VERSION 17-1(24) 7-26-73 BY RHT **** VERSION 17 ****
VERSION 16-2(23) 7-15-73 BY RHT BUG #NC# ASKNTC WAS WRONG
VERSION 16-2(22) 7-15-73 BY RHT MORE OF BUG NB
VERSION 16-2(21) 7-15-73 BY RHT BUG #NB# NOT GETTING CONTXT RIGHT FOR USER IP
VERSION 16-2(20) 7-14-73 BY RHT MAKE SAIIRP A SEP COMPIL & PROVIDE FOR APPL$Y
VERSION 16-2(19) 7-14-73 BY RHT BUG #NA# RACE CONDITION IN URSCHD IWAIT
VERSION 16-2(18) 3-18-73 BY RHT MINOR MOD TO DFR1IN
VERSION 16-2(17) 2-4-73 BY RHT PROVIDE MORE HOOKS INTO EVENT ROUTINES
VERSION 16-2(16) 1-15-73 BY DCS BUG #LB# MINOR RESUME BUG
VERSION 16-2(15) 12-9-72 BY RHT MAKE MINOR ADJUSTMENTS TO RESUME
VERSION 16-2(14) 12-4-72 BY RHT INTERNAL PSTATUS
VERSION 16-2(13) 12-4-72 BY RHT CURE POTENTIAL LOSSAGE OF STATIC LINKAGE
VERSION 16-2(12) 12-2-72 BY RHT REWRITE RESUME
VERSION 16-2(11) 12-1-72 BY RHT PROVIDE FOR DEFAULTS AS CORE VARS
VERSION 16-2(10) 11-30-72 BY RHT ADD THE DDFINT ROUTINE & ZAP POLL
VERSION 16-2(9) 11-29-72 BY DCS ADD INTERRUPT THINGS TO ENTRIES IN COMPIL
VERSION 16-2(8) 11-29-72 BY RHT RESUME DISPATCH NEEDS @
VERSION 16-2(7) 11-26-72 BY DCS ALLOW <ESC>I AS IO INTERRUPT (AVOID "NO ONE TO RUN")
VERSION 16-2(6) 11-26-72 BY DCS CHANGE OPDEF FOR INTENS TO 400030 FROM ..31
VERSION 16-2(5) 11-25-72 BY RHT FIX DATAB & INFTAB REFERENCES
VERSION 16-2(4) 11-15-72 BY RHT ADD OPTIONS FOR RESUME
VERSION 16-2(3) 11-15-72 BY RHT ADD INTERRUPTS,SPARE HERE ENTRIES
VERSION 16-2(2) 11-15-72
VERSION 16-2(1) 11-15-72
;
; MANY DECLARATIONS
COMPIL(PRC,,,,,,DUMMYFORGDSCISS)
DEFINE ENS1 < SPROUT,URSCHD,RESUME,SUSPEND,TERMINATE,JOIN,MAINPR,CALLER>
DEFINE ENS2 <%PSSGC,DDFINT,INTSET,CAUSE,ANSWER,INTERROGATE,SETCP>
DEFINE ENS3 <MKEVTT,SETIP,MYPROC,CLKMOD,DFR1IN,DFRINT,INTPRO>
DEFINE ENS4 <DFCPKT,PSTATUS,ASKNTC,CAUSE1,PRISET>
DEFINE EXT1 <LEAP,STKUWD,X44,GOGTAB,%ARSR1,SGINS,ALLPDP>
DEFINE EXT2 <CORGET,CORREL,INTRPT,INFTB,%SPGC,X22,%SPGC1,FP1DON,STACSV>
DEFINE EXT3 <X33,%ARRSR,DATM,SGLKBK,FP2DON,SGREM,STACRS,RUNNER,NOPOLL>
NOTYMSHR <
DEFINE EXT4 <X11,DEFSSS,DEFPSS,DEFPRI,DEFQNT,INTTBL,APPL$Y>>;NOTMSHR
TYMSHR <
DEFINE EXT4 <DDFINA,X11,DEFSSS,DEFPSS,DEFPRI,DEFQNT,INTTBL,APPL$Y>>;TYMSHR
IFN APRISW <
DEFINE XJBCNI <JOBCNI>
DEFINE XJBTPC <JOBTPC>
DEFINE XJBAPR <JOBAPR>
DEFINE EXT5 <JOBCNI,JOBTPC,JOBAPR>
IFN ALWAYS <
EXTERN EXT5 ;THESE ARE ALWAYS EXTERNAL
>;IFN ALWAYS
>;IFN APRISW
IFE APRISW <
DEFINE EXT5 <XJBCNI,XJBTPC,XJBAPR,JOBINT>
IFN ALWAYS <
EXTERNAL JOBINT ;THIS FELLOW IS ALWAYS EXTERNAL
>;IFN ALWAYS
>;IFE APRISW
COMMENT THIS IS FOR THE STUPIDITY OF SCISS
COMPXX(PRC,<ENS1,ENS2,ENS3,ENS4>,<EXT1,EXT2,EXT3,EXT4,EXT5>
,<MULTIPLE PROCESS STUFF>,<SPRPDA>,HIIFPOSSIB)
BEGIN PROCSS
; (AC DEFNS)
; A,B,C,P,SP,RF AS BEFORE
KL _D ;KILL LIST & SCRATCH
PB _5 ;PROCESS BASE
OPTS _6 ;HOLDS OPTIONS
PDA _7 ;HOLDS PDA
EVT _10 ;EVENT DATUM
NSP __10 ;NEW SP
NP _11 ;NEW P
TMP _LPSA ;TEMP AC
GLOB <
TABL __ 7 ;NEEDED BY LIST CELL GETTER
>;GLOB
NOGLOB <
TABL __ USER ;NEEDED BY LIST CELL GETTER
>;NOGLOB
FP __ 6 ;NEEDED BY LIST CELL GETTER
; (LOCAL VARIABLES FOR SCHEDULER)
MAXPRI __ 0 ;MAXIMUM PRIORITY
MINPRI __ NPRIS-1
;REASONS FOR SUSPENSION
PSPF__0 ;ONLY P, SP, F NEED BE RESTORED
SPNDR__1 ;SUSPENDED (FROM READY) BY SUSPEND
JOINR__2 ;SUSPENDED BECAUSE OF A JOIN
WAITNG__3 ;WAITING ON AN EVENT OR SO
; ( CONSTANT DATA USED BY SPROUTER)
; FIELD DEFNS FOR OPTIONS WORD (SEE ALSO POINT S BELOW)
STSMSK_ 77 =8 ;MASK FOR P STACK SIZE FIELD
SSSMSK_ 17 =14;MASK FOR SP STACK SIZE FIELD OF OPTIONS WORD
PRIMSK_ 17 4 ;MASK FOR PRIORITY FIELD
QNTMSK__ 17 ;MASK FOR QUANTUM
RUNME__ 1 ;RUN THE SPROUTING PROCESS
SPNDME__2 ;SUSPEND THE SPROUTING PROCESS
SPNDNP__10 ;SUSPEND THE NEW PROCESS
;MORE FIELD DEFS & BIT VALUES
TERM __ 1 ;BIT (LH) IN DATUM OF TERMINATED PROCESS ITEM
;DEFAULT VALUES --INITIALLY SET BY MAINPR
STPSZ_ 40 ;DEFAULT P- STACK SIZE (MINUS THE PROCESS TABLE AREA)
STSPST _20 ;DEFAULT SP STACK SIZE
STDQNT __ 4 ;DEFAULT STD QUANTUM IS 4
STDPRI __7 ;DEFAULT PRIORITY
;OPTIONS FOR RESUME
MSTMSK__14 ;MASK FOR MY NEW STATUS FIELD
NOTNOW__1 ;SET IF RESUMED PROCESS IS MERELY TO GO READY
;CONSTANTS USED BY RESUME
MSTBYT: POINT 2,OPTS,33 ;MY NEW STATUS
; (CONSTANTS USED BY SPROUTER)
SSSBYT: POINT 4,OPTS,21 ;STRING STACK FIELD (MOD 32)
STSBYT: POINT 6,OPTS,27 ;P - STACK FIELD (MOD 32)
PRIBYT: POINT 4,OPTS,31 ;PRIORITY FIELD
QNTBYT: POINT 4,OPTS,17 ;LOG2 (QUANTUM)
; MACROS USED TO GET LIST CELLS
DEFINE NCELL(AC) <
MOVE FP,FP1(TABL) ;USE WHERE SURE THE LIST SPACE IS INITIALIZED
HRRI AC,(FP)
SKIPN FP,(FP)
PUSHJ P,FP1DON
HRRM FP,FP1(TABL)
>
DEFINE NNCELL(AC) <
SKIPN FP,FP1(TABL) ;USE WHERE LIST SPACE MAY NEED INITIALIZATION
PUSHJ P,FP1DON
HRRI AC,(FP)
SKIPN FP,(FP)
PUSHJ P,FP1DON
HRRM FP,FP1(TABL)
>
DEFINE NNCLL2(AC) <
SKIPN FP,FP2(TABL) ;USE WHERE LIST SPACE MAY NEED INITIALIZATION
PUSHJ P,FP2DON
HRRI AC,(FP)
SKIPN FP,(FP)
PUSHJ P,FP2DON
HRRM FP,FP2(TABL)
>
NOTENX<
OPDEF INTENS [CALLI 400030]
OPDEF IWAIT [CALLI 400040]
>;NOTENX
;PROCESS VARIABLE NUMBERS
DEFINE PVAR (V,ATTRIB),
<^V __ NPVARS
NPVARS__ NPVARS+1
IFE ALWAYS,<
IFDIF <ATTRIB>,<> < ATTRIB V >
>;IFE ALWAYS
>
NPVARS__ 0
PVAR DYNL ;DYNAMIC LINK
PVAR STATL ;STATIC LINK
PVAR ISP ;REST OF MSCP
PVAR AC0 ;AC SAVE AREA
PVAR AC1
PVAR AC2
PVAR AC3
PVAR AC4
PVAR AC5
PVAR AC6
PVAR AC7
PVAR AC10
PVAR AC11
PVAR AC12
PVAR AC13
PVAR AC14
PVAR AC15
PVAR AC16
PVAR AC17
INTERNAL ACF
^ACF __ AC12
^ACP __ AC17
^ACSP __ AC16
PVAR PCW ;PC WORD
PVAR QUANTM ;TIME QUANTUM
PVAR PRIOR ;PRIORITY
PVAR PRCITM ;PROCESS ITEM OF THIS PROCESS
PVAR KLOWNR ;THE OWNER OF MY KILL LIST
PVAR STATUS ;-1 = RUNNING, 0 = SUSPEND, 1 = READY, 2 = TERMINATED
PVAR DADDY,INTERNAL ;PROCESS ITEM OF SPROUTING PROCESS
PVAR CAUSRA ;RETN ADDRESS FROM CAUSE
;THE FOLLOWING ARE ZEROED OUT ON CREATION
ZFIRST__NPVARS
PVAR CURSCB,INTERNAL ;CURRENT SEARCH CONTROL BLOCK
PVAR REASON ;HOW GOT UNSCHEDULED (0 MEANS ONLY NEED ACS F,SP,P)
PVAR PLISTE,INTERNAL ;PRIORITY LIST ENTRY
PVAR RSMR ;THE GUY WHO RESUMED ME (%AG% ** INIT TO DADDY ** )
PVAR JOINCT ;HOW MANY PROCESSES NEED TO JOIN THIS ONE
PVAR JOINS ;WHO IS WAITING TO FOR ME TO JOIN (A SET OF ITEMS)
PVAR WAITES ;LIST OF ALL EVENT TYPES ON WHICH I AM WAITING
PVAR INTRGC ;THE CONTROL WORD FOR MY CURENT INTERROGATION
PVAR CAUSES ;COUNT OF CAUSES PENDING
PVAR CAUSEQ ;QUEUE OF CAUSES TO BE MADE
ZLAST__NPVARS-1
^NPVARS _ NPVARS
^STKBAS _ NPVARS ;STACK BASE SIZE (= #PROCESS VARS FOR NOW)
COMMENT event variables
NEVARS__0
DEFINE EVAR(V) ,
<^^V__NEVARS
NEVARS__NEVARS+1
>
EVAR NOTCLS ;LIST OF CURRENT NOTICES
EVAR WAITLS ;LIST OF CURRENTLY WAITING PROCESSES
EVAR CAUSEP ;USER SPEC CAUSE PROC
EVAR INTRGP ;USER SPEC INTERROGATE PROC
EVAR USER1 ;AVAIL TO USER
EVAR USER2 ;AVAIL TO USERR
;OPTIONS BITS FOR CAUSE
DNTSAV __ 1
TELLAL __ 2
SCHDIT __ 4
;OPTIONS BITS FOR INTERROGATE
RETAIN __ 1
WAIT __ 2
SAYWCH __ 10
MULTIN __ 200000
NOJOY __ 400000
COMMENT procedure descriptors & null process skeleton
FLXXX__0
NOTENX<
UP <
FLXXX__%FIRLOC-400000
>;UP
>;NOTENX
TENX<
UP <
FLXXX__%FIRLOC-(SEGPAGE*1000)
>;UP
>;TENX
DEFINE PUTINLOC(LCN,V),<
UP <
SVPCXX __ .
DEPHASE
>;UP
RELOC LCN+FLXXX
V
RELOC
UP <
PHASE SVPCXX
>;UP
>
;MAKE A PD FOR THE SPROUTER
^SPRPDA:
;;#WV# used to be BLOCK PD.XXX+1
REPEAT PD.XXX+1, <0
>
DEFINE FPDE(IX,V),<PUTINLOC (SPRPDA+IX,V)>
FPDE (PD.,SPROUT)
FPDE (PD.ID1,6)
FPDE (PD.ID2,<<POINT 7,[ASCII/SPROUT/]>>)
FPDE (PD.DSW,STKBAS)
FPDE (PD.PDA,<<XWD SPRPDA,0>>)
FPDE (PD.LLW,<SPRPDA+PD.XXX>)
FPDE (PD.DLW,<SPRPDA+PD.XXX>)
IFN 0,<
;NULL PROCESS
NULPDA: NULPRO ;PD OF NUL PROC
^NULPRC: %NULPR ;NULL PROCESS
%NULPR: BLOCK STKBAS+=32 ;NULL PROCESS AREA
DEFINE NPE (IX,V), <PUTINLOC (%NULPR+IX,V)>
NPE (STATL,<<XWD SPRPDA,0>>)
NPE (ACF,STKBAS+%NULPR+1)
NPE (ACP,<<TPDL: XWD - =29,%NULPR+STKBAS+3>>)
NPE (STKBAS+1,%NULPR+DYNL)
NPE (STKBAS+2,<<XWD NULPDA,0>>)
^NULPRO:
ERR <I SHOULD NEVER RUN>
>;IFN 0
DSCR SPROUT -- THE PROCESS SPROUTER
CAL PUSHJ
PARM -1(P) ;KILL LIST
-2(P) ;OPTIONS WORD
-3(P) ;PDA OF SPROUTED PROCESS
-4(P) ; PROCEDURE PARAMS
:
-?(P) ;LAST OF PROCEDURRE PARAMS
-?-1(P) ;PROCESS ITEM
DES
This procedure acts as the "process" procedure.
Roughly, it does the following:
1. Saves the return address in PCW(RUNNER)
2. gets stack space
3. puts self on appropriate kill list & priority list
4. copies over the procedure parameters.
5. sets status of new & SPROUTing process
&(eventually) calls the appropriate procedure.
6. when the procedure returns, SPROUT then kills the process.
HERE (SPROUT)
MOVE USER,RUNNER ;
POP P,PCW(USER) ;RETN ADDRESS
POP P,KL ;PICK UP KILLL LIST
POP P,OPTS ;OPTIONS
POP P,PDA ;FIND OUT WHO
;;%AA% -- 1 OF 1 DEFAULTS, ALSO THE POP P,PDA USED TO BE LATER
CAIN PDA,APPL$Y ;SPROUT APPLY IS A ROYAL PAIN
;;#OU# A TYPO RHT
SKIPA TMP,-1(P) ;REAL PDA FOR SPROUT APPLY
MOVE TMP,PDA ;
HRRZ A,PD.PDB(TMP) ;THE DEFAULTS
JUMPE A,SALCS ;NO DEFAULTS -- SPROUT ALLOCATIONS NOW
LSH A,4 ;INTO POSITION
TRNE OPTS,STSMSK ;P STACK
TRZ A,STSMSK
TRNE OPTS,SSSMSK ;SP STACK
TRZ A,SSSMSK
TRNE OPTS,PRIMSK ;PRIORITY
TRZ A,PRIMSK
TLNE OPTS,QNTMSK ;QUANTUM
TLZ A,QNTMSK ;
IOR OPTS,A ;OR IN THE BITS FOR DEFAULTS
SALCS:
;;%AA%
TRNE OPTS,SSSMSK ;SPECIFIED SP STACK SIZE ?
JRST [ LDB C,SSSBYT ;YES, GET IT
LSH C,5 ;TIMES 32
JRST .+2 ]
MOVE C,DEFSSS ;STANDARD SIZE
PUSHJ P,CORGET ;GET SPACE
ERR <SPROUT: No core>
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 <SPROUT: No core>
MOVE PB,B ;PROCESS BASE
MOVN C,C
HRLZI NP,STKBAS(C) ;MAKE PDP
HRRI NP,STKBAS(PB)
;ZERO OUT SOME OF THE PROCESS VARS
HRLZI A,ZFIRST(PB) ;
HRRI A,ZFIRST+1(PB)
SETZM ZFIRST(PB)
BLT A,ZLAST(PB)
;REMEMBER DADDY
MOVE USER,RUNNER
MOVE A,PRCITM(USER)
MOVEM A,DADDY(PB)
;;%AG% ! REMEMBER SPROUTER AS THE FIRST CALLER. RHT
MOVEM A,RSMR(PB) ;SO CALLER(MYPROC) STARTS OUT AS DADDY
;BUILD MSCP, ETC.
SETZM DYNL(PB) ;NULL DYN LINK
CAIN PDA,APPL$Y ;IS IT A SPROUT APPLY?
JRST [ ;YES
UP <
MOVE PDA,(PDA) ;SINCE APPL$Y IS HERED
>;UP
POP P,TMP ;ARG LIST
POP P,A ;PDA OF TARGET
PUSH NP,A ;PUT ON CALL STACK
PUSH NP,TMP ;PUT ON CALL STACK
;;#OO# !(1 OF 2) A TYPO
HRLZI TMP,SPRPDA
HLRZ C,PD.DLW(A) ;LOOK FOR RIGHT LINK
;;#OT# ! RHT DONT LOOK IF THE FELLOW SUPPLIES AN ENVIRONMENT
TLNN A,-1 ;ENVIRON SUPPLIED??
CAIG C,1 ;GLOBAL??
JRST SSLON ;YES
HRRZ A,PD.PPD(A);
SKIPA TMP,RF
SSLFLP: HLRZ TMP,C
MOVS C,1(TMP)
CAIE A,(C)
JRST SSLFLP
;;#OO# ! (2 OF 2) NEED TO SAY A SPROUT
HRLI TMP,SPRPDA
SSLON: MOVEM TMP,STATL(PB)
MOVEM NSP,ISP(PB)
JRST APSON ]
HLRZ A,PD.DLW(PDA) ;DISPLAY LEVEL
HRLZI TMP,SPRPDA ;IN CASE OUTER LEVEL
CAIG A,1 ;OUTER BLOCK PROC?
JRST SLON ;YES -- NO LOOP
HRRZ A,PD.PPD(PDA) ;THE LEXICAL PARENT
SKIPA TMP,RF ;DYNL
SLFLP: HLRZ TMP,C ;BACK A STATL
MOVS C,1(TMP) ;SL,,PDA
CAIE A,(C) ;SAME AS DADDY?
JRST SLFLP ;NO
HRLI TMP,SPRPDA ;SPRPDA,,STATL
SLON: MOVEM TMP,STATL(PB) ;STATIC LINK WORD
MOVEM NSP,ISP(PB) ;SP WORD
;COPY PROC PARAMS
HLRZ TMP,PD.NPW(PDA) ;#STRING PARAMS*2
JUMPE TMP,STPSON ;HAVE ANY ?
HRL TMP,TMP ;YES, DO A BLT
HRRZI A,1(NSP) ;DEST
ADD NSP,TMP ;BUMP NEW STACK
JUMPL NSP,.+2
ERR <SPROUT: SP PDLOV>
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
JUMPL NP,.+2
ERR <SPROUT: P PDLOV>
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 #
JUMPN C,.+2
ERR <SPROUT: Illegal process item >,7
MOVEM C,PRCITM(PB) ;REMEMBER IT
MOVEI A,PRCTYP ;SAY IS OF TYPE PROCESS
COMMENT **** MAY WANT TO WORRY HERE ABOUT GLOBAL ITEMS **** ;
MOVE TABL,GOGTAB
DPB A,INFOTAB(TABL) ;SAY IS A PROCESS
HRRZM PB,@DATAB(TABL) ;SET DATUM VALUE
;KILL SET STUFF
MOVE B,C ;ITEM NUMBER
MOVEM KL,KLOWNR(PB) ;REMEMBER KILL LIST OWNER
JUMPE KL,NEWSTT ;ONLY PUT ON KILL SET IF HAVE ONE
PUSH P,TABL ;NEED TO SAVE THESE
PUSH P,FP ;
PUSHJ P,INSRTS ;GO PUT ITEM IN KILL SET
POP P,FP
POP P,TABL
;NOW DECIDE WHAT TO DO WITH SPROUTING PROCESS & DO THE RIGHT THING
NEWSTT: MOVE USER,RUNNER ;HOPE IT IS STILL HIM
TRNE OPTS,RUNME ; DOES SPROUTING PROCESS WANT TO RUN?
JRST RNSPRR ;YES
MOVEM P,ACP(USER) ;IF HERE, THEN WANT TO RUN NEW GUY
MOVEM SP,ACSP(USER) ;SAVE THE NECESSARY ACS
MOVEM RF,ACF(USER) ;
MOVNS STATUS(USER) ;RUNNING BECOMES READY
TRNE OPTS,SPNDME ;IF I WANTED SUSPENSION
SETZM STATUS(USER) ;DO IT
SKIPL STATUS(PB) ;DOES SPROUTED PROCESS WANT TO RUN
JRST NORFR ;NO
MOVE USER,GOGTAB
MOVE A,QUANTM(PB)
MOVEM A,TIMER(USER)
MOVE P,NP ;
MOVE SP,NSP ;GET READY
MOVEI RF,DYNL(PB) ;
MOVEM PB,RUNNER
CALLIT: PUSHJ P,@PD.(PDA) ;CALL THE SO AND SO
;HERE IS WHERE WE COME ON PROCEDURE EXIT
CALRET: MOVE PB,RUNNER ;I HOPE ITS ME
;;% % ! RHT MAY AS WELL USA ALLPDP FOR KACTS TOO
MOVE P,ALLPDP ;USE THIS PDL FOR KILLING CORE
PUSHJ P,KACTS ;DO EVERYTHING BUT SPACE FREEING
;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
;;%BX% RHT make this work fifo
; SKIPE B,PRILIS(A) ;PRIORITY LIST OWNER
; HRLM PB,PLISTE(B) ;LINK BACK
; HRRZM B,PLISTE(PB) ;LIINK DOWM
; HRRM PB,PRILIS(A) ;NEW RHS FOR OWNER IS PTR TO ME
; TLNN B,-1 ;WAS THE LIST EMPTY ??
; HRLM PB,PRILIS(A) ;YES -- THIS IS THE TAIL TOO
HLRZ B,PRILIS(A) ;OLD LAST ELEMENT
JUMPN B,OLDLST ;HAVE ONE
SETZM PLISTE(PB) ;DONT HAVE ONE, BOTH LINKS ARE NULL
HRRZM PB,PRILIS(A) ;NEW FIRST ELEMENT SINCE WAS EMPTY
JRST SETP.X ;GO FINISH OUT
OLDLST: HRRM PB,PLISTE(B) ;LINK ONTO END OF LIST
HRLZM B,PLISTE(PB)
SETP.X: HRLM PB,PRILIS(A) ;MAKE NEW LAST ELEMENT
;;%BX% ^
CPOPJ: POPJ P,
;HERE IF DONT WANT TO RUN NEW GUY RIGHT AWAY
NORFR: TROA B,1 ;FLAG
RNSPRR: MOVEI B,0
MOVNS STATUS(PB) ;IF NEW IS "RUNNING", THEN "READY"
PUSH NP,[CALRET] ;
MOVEM NP,ACP(PB) ;SET UP NEC. SAVES
MOVEM NSP,ACSP(PB)
MOVEI A,DYNL(PB)
MOVEM A,ACF(PB)
MOVE A,PD.(PDA) ;WHERE HE STARTS
MOVEM A,PCW(PB)
CAIN B, ;SPROUTER RUNS??
JRST @PCW(USER) ;YES --
JRST FOTR ;NO -- FIND SOMEONE TO RUN
COMMENT routines for inserting & deleting set elements
;expects item no in B , (KL) = the owner
;mangles A,B,C,FP,TABL
INSRTS: MOVE TABL,GOGTAB
SKIPN A,(KL) ;GET OWNER
JRST NEWINS ;IT WAS NULL BEFORE
MOVE C,(A) ;POINT AT FIRST
ISCH: MOVS C,(C) ;CONTENTS (SWAPPED) OF THIS
CAILE B,(C) ;ELIGIBLE
JRST NX1 ;MUST GO FURTHER
CAIL B,(C) ;THERE ALREADY?
POPJ P, ;YES
NI: HRL B,(A) ;POINTER AT THIS
NCELL (C) ;GET A CELL FOR IT
MOVSM B,(C) ;SAVE CONTENTS OF CELL
HRRM C,(A) ;LINK TO NEW
HRLZI A,1
ADDB A,(KL) ;UPDATE COUNT -- POINT AT LAST,,FIRST
TLNN B,-1 ;AT THE END???
HRLM C,(A) ;YES
POPJ P,
NX1: HRRZ A,(A)
TLNN C,-1 ;END OF LIST
JRST NI ;YES -- PUT AT END
MOVSS C
JRST ISCH ;GO LOOK SOME MORE
NEWINS: NNCELL (A)
SETZM (A)
HRRZM A,(KL) ;IT USED TO BE NULL
JRST NI
;ROUTINES FOR ADDING TO LISTS
;EXPECT ITEM NO IN B, KL= ADRS OF OWNER
;MANGLE A,B,C,FP,TABL
;;#QK# RHT ! SET UP OF TABL NEEDED
IHEDLS: MOVE TABL,GOGTAB
SKIPN A,(KL) ;INSERT AT HEAD
JRST NEWINS
JRST NI
ITAILS:
;;#QK# ! SET UP TABL (2 OF 2)
MOVE TABL,GOGTAB ;
SKIPN A,(KL) ;INSERT AT TAIL
JRST NEWINS
MOVS A,(A)
JRST NI
;ROUTINE TO DELETE SET OR LIST ELEMENTS
;B = ITEM NO, (KL) IS THE OWNER
;MANGLES A,B,C,TABL
DELTLE:
DELTSE: SKIPN A,(KL) ;GET SET DESCRIPTOR
POPJ P, ;NULL ALREADY
MOVE C,(A)
DSCH: MOVE C,(C)
TLC C,(B)
TLNN C,-1 ;WAS IT THIS ONE???
JRST DIT ;YES
TRNN C,-1 ;END OF SEARCH
POPJ P, ;YES
MOVE A,(A) ;LINK
JRST DSCH ;GO LOOK
DIT: MOVE TABL,GOGTAB
MOVE B,(A) ;B PTR TO THIS CELL
HRRM C,(A) ;LINK PREV TO NEXT
HRL C,FP1(TABL) ;OLD FREE LIST
HLRM C,(B) ;LINK CELL
HRRM B,FP1(TABL) ;
HRLZI B,-1 ;ADJUST DESCRIPTOR
ADDB B,(KL)
TLNE B,-1 ;LIST NULL NOW???
JRST CKEND ;NO
SETZM (KL) ;YES
MOVSS (B) ;LAST,,FIRST CELL
;NOW IS 0,,PTR TO CELL JUST FREED UP
HRRM B,FP1(TABL) ;NEW FREE LIST
POPJ P,
CKEND: TRNN C,-1 ;WAS THIS THE END
HRLM A,(B) ;YES
POPJ P,
;ROUTINE TO DELETE FIRST ELT OF A LIST
;PUTS ITEM # INTO A
;EXPECTS (KL) = THE OWNER
;MODIFIES A,B,C,TABL
REMCAR: SKIPN A,(KL)
POPJ P, ;IF WAS NULL RETURN A 0
MOVE C,(A)
MOVE C,(C) ;FIRST REAL LIST CELL
HLRZ B,C ;FIRST ONE
PUSH P,B ;SAVE IT
PUSHJ P,DIT
POP P,A ;VALUE
POPJ P,
;USER REQUESTED SCHEDULING
HERE(URSCHD)
MOVE PB,RUNNER
SKIPL STATUS(PB) ;
JRST FOTR ;GO FIND ONE TO RUN
MOVNS STATUS(PB) ;SET TO READY
SPSRN1: SETZM REASON(PB) ;OTHER ACS NOT SAVED
SPSRN2: POP P,PCW(PB) ;DITTO -- BUT LEAVE REASON INTACT
;THESE TWO LABELS ARE USED
;BY SUSPEND, JOIN & THE LIKE
MOVEM P,ACP(PB)
MOVEM SP,ACSP(PB)
MOVEM RF,ACF(PB)
FOTR: HRRZ B,GOGTAB
TLO B,-NPRIS
MOVEI A,1 ;READY
SCHLIS: SKIPN PB,PRILIS(B) ;SEARCH DOWN THIS LIST
JRST NXLIS ;LIST IS EMPTY
TRYTHS: CAMN A,STATUS(PB) ;IS THIS READY
JRST SCDTHS ;YES -- DO HIM
HRRZ PB,PLISTE(PB) ;LINK DOWN LIST
JUMPN PB,TRYTHS ;IF ANY LEFT AT THIS LEVEL,TRY
NXLIS: AOBJN B,SCHLIS ;SEARCH LIST
NOTENX<
IFE APRISW <
;;#NA# RACE CONDITION ON WHEN INTERRUPT HAPPENS
IMSKCL 1,[-1] ;MASK OFF ALL INTERRUPTS
SKIPE INTRPT ; A RECENT INTERRUPT
JRST [INGOSC: SETZM INTRPT ;GO TRY AGAIN TO SCCHEDULE
IMSKST 1,[-1]
JRST FOTR ]
INTENS B, ;GET INTERRUPT ENABLING
TLNN B,775204 ;IS HE ENABLED FOR SOMETHING
;THAT CAN STILL HAPPEN
ERR <NO ONE TO RUN>,1,INGOSC ;NO
IMSTW [-1 ;WAIT FOR AN INTERRUPT
1]
SETZM INTRPT ;ZERO THE FLAG
;;#NA# -- EVENTUALLY FIX THIS CROCK
>;IFE APRISW
IFN APRISW <
SKIPN INTRPT
ERR <NO ONE TO RUN>,1
SETZM INTRPT
>;IFN APRISW
>;NOTENX
TENX<
SKIPN INTRPT
ERR <NO ONE TO RUN>,1
SETZM INTRPT
>;TENX
JRST FOTR ;FIND SOMEONE TO RUN
SCDTHS:
;CIRCLE THE QUEUE
SKIPE A,PLISTE(PB) ;ONLY ONE ON THE LIST?
TRNN A,-1 ;ALREADY AT END?
JRST RDYTHS ;YES
HLLM A,PLISTE(A) ;PREV(NEXT(ME))_PREV(ME)
MOVS C,A ;NEXT(ME),,PREV(ME)
TRNE C,-1 ;ANY PREV?
HLRM C,PLISTE(C) ;YES -- NEXT(PREV(ME))_NEXT(ME)
TLNE A,-1 ;WAS I FIRST?
HRR A,PRILIS(B) ;NO -- FIRST WILL STAY FIRST
HRL A,PB ;NEW OWNER -- ME,,NEW FIRST
EXCH A,PRILIS(B) ;GET OLD LAST,,FIRST
HLLZM A,PLISTE(PB) ;MY NEW ENTRY IS OLD LAST,,0
MOVS A,A ; XXX,,OLD LAST
HRRM PB,PLISTE(A) ;POINT AT ME
RDYTHS: SETOM STATUS(PB) ;RUNNING
HRRM PB,RUNNER ;SAY SO
MOVE USER,GOGTAB
MOVE A,QUANTM(PB)
MOVEM A,TIMER(USER)
SKIPE A,REASON(PB)
JRST @SPCASE(A) ;SOME SPECIAL CASE
RPSPF: MOVE P,ACP(PB) ;GET THE NEEDED REGISTERS
MOVE SP,ACSP(PB)
MOVE RF,ACF(PB)
JRST @PCW(PB) ;GO START RUNNING THE SO AND SO
SPCASE: RPSPF ;0 THEN RESTORE P, SP, F
RSTACS ;1 THEN RESTORE ALL ACS
RPSPF ;2 THEN FROM JOINER
RST1 ;3 THEN FROM INTERROGATE
RSTACS: MOVE P,ACP(PB) ;PUT THE RETURN ADDRESS ON THE STACK
PUSH P,PCW(PB)
MOVEM P,ACP(PB)
HRLZI P,AC0(PB)
BLT P,P ;RESTORE THE OLD ACS
POPJ P, ;GO RUN
RST1: MOVE A,AC1(PB) ;RESTORE REG 1 , SP,P,F
JRST RPSPF
HERE(RESUME)
MOVE USER,RUNNER ;TAKE CARE OF RET ADDRS
POP P,PCW(USER)
POP P,OPTS ;OPTIONS
POP P,A ;RETURN VALUE
POP P,C ;WHO
MOVE TEMP,GOGTAB ;
LDB B,INFOTAB(TEMP) ;TEST THE TYPE
CAIE B,PRCTYP ;IS THE TYPE A PROCESS
JRST [ MOVEI LPSA,ER.NPI
RESERR: MOVSI TEMP,[ASCIZ/RESUME/]
PUSH P,PCW(USER) ;ENTRY CONVENTION OF ER.ITN
JRST (LPSA)]
MOVE PB,@DATAB(TEMP) ;GET THE DATUM
TLNE PB,TERM ;WAS IT TERMINATED?
JRST [MOVEI LPSA,ER.TRP
JRST RESERR]
MOVE B,PRCITM(USER) ;MY NAME
MOVEM B,RSMR(PB) ;REMEMBER CALLER
SKIPE STATUS(PB) ;HIS STATUS BETTER BE 0
JRST [MOVEI LPSA,ER.SUS
JRST RESERR]
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
;;#XL# ! JFR 8-17-76 WAS CAIE; C.F. RSM.3 ABOVE
CAIN B,1 ;
JRST @PCW(USER) ;I GO ON MY WAY
MOVEM A,AC1(PB) ;SAVE IT
MOVEI A,3 ;
MOVEM A,REASON(PB) ;
;;#LB#! 1-15-73 DCS WAS @PCW(PB), THAT'S WRONG ("TYPO")
JRST @PCW(USER) ;
RSM.T: MOVE PB,(P) ;
PUSHJ P,TERMPB ;
MOVE PB,1(P) ;TERMPB BACKED UP THE STACK
POP P,PCW(PB) ;RET AD
MOVE C,REASON(PB) ;
JRST @SPCASE(C) ;GO DO RIGHT THING ABOUT ACS
ER.SUS: HRRI TEMP,[ASCIZ/Non-suspended process/]
JRST ER.ITN
ER.TRP: TROA TEMP,[ASCIZ/Terminated process/]
ER.NPI: HRRI TEMP,[ASCIZ/Non-process item/]
ER.ITN:
;ENTER WITH (P)=RETURN WORD, TEMP=[ASCIZ/routine/],,[ASCIZ/msg/]
;C=ITEM NUMBER
MOVE LPSA,RUNNER ;STORE STATE
POP P,PCW(LPSA) ;RETURN WORD
MOVEM P,ACP(LPSA)
MOVEM SP,ACSP(LPSA)
MOVEM RF,ACF(LPSA)
MOVEI LPSA,(C) ;ITEM NUMBER (ERRSPL USES FF THRU D)
ERRSPL 1,[[ASCIZ/
@A: @A #@D/]
PLEFT TEMP ;routine
PRIGHT TEMP ;msg
PRIGHT LPSA] ;item number
MOVE PB,RUNNER ;TRY TO IGNORE THE CALL THAT GAVE THE ERROR
SETZ A, ;RETURN 0 (=ANY) IF IT MATTERS
JRST RPSPF ;RESTORE P, SP, F AND CONTINUE
COMMENT SUSPEND and TERMINATE runtime routines
HERE(SUSPEND)
MOVE C,-1(P) ;THE ITEM
POP P,-1(P) ;BACK UP RETN ADDR
MOVSI TEMP,[ASCIZ/SUSPEND/]
MOVE TABL,GOGTAB ;
LDB B,INFOTAB(TABL)
CAIE B,PRCTYP ;BE SURE A PROCESS ITEM
JRST ER.NPI
MOVE PB,@DATAB(TABL)
TLNE PB,TERM ;IF TERMINATED ,
JRST ER.TRP
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
MOVEI A,ITMANY ;GET THE ITEM ANY
POPJ P,
HERE(TERMINATE)
MOVE C,-1(P)
MOVE TABL,GOGTAB ;
LDB B,INFOTAB(TABL) ;IS HE A PROCESS
CAIE B,PRCTYP
JRST [ MOVSI TEMP,[ASCIZ/TERMINATE/]
NPIPOP: POP P,-1(P) ;MOVE RETURN WORD BACK
JRST ER.NPI]
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)
;#ZM# 78-12-12 DON/KS -- USE OF LEAP 117&120 ADDED TO AVOID ACCUMULATION OF SETS
HRROI 14,-1(P) ;POINTER TO THE SET
MOVEI 5,117 ;117=SETCOP (NOTE LEAP'S AC5 IS OUR PB)
PUSHJ P,LEAP ;COPY THE SET IF NOT TEMP
MOVE PB,RUNNER ;WHO AM US AHYHOW?
SKIPN B,-1(P) ;GET SET POINTER AGAIN (PERHAPS CHANGED BY LEAP)
JRST [PUSHJ P,JNREL ;NULL SET IS EASY, RELEASE IT
POPJ P,] ;AND WE'RE DONE
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?
JRST [MOVSI TEMP,[ASCIZ/JOIN/]
PUSHJ P,JNREL
JRST ER.NPI]
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
PUSHJ P,JNREL ;DONE WITH THE SET
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)
JNREL: HRROI 14,-2(P) ;GET SET POINTER AGAIN (-2(P) DUE TO OUR RET ADDR)
MOVEI 5,120 ;120=SETRCL
PUSH P,C ;ER.NPI MAY WANT THIS (GAD WHAT A CROCK!)
PUSHJ P,LEAP ;RELEASE THE SET
POP P,C
POP P,B ;SAVE OUR RETURN ADDR
POP P,-1(P) ;CLEAN UP STACK
MOVE PB,RUNNER ;REMEMBER AC5, USED BY LEAP, IS PB
JRST (B) ;ANOTHER GOOD DAY'S WORK DONE
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
JRST [MOVSI TEMP,[ASCIZ/CALLER/]
JRST NPIPOP]
TLNE A,TERM
JRST [ MOVSI TEMP,[ASCIZ/CALLER/]
TRPPOP: POP P,-1(P) ;BACK UP RETURN WORD
JRST ER.TRP]
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
JRST [MOVSI TEMP,[ASCIZ/PSTATUS/]
JRST NPIPOP]
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
JRST [ MOVEI LPSA,NPIPOP
PRIERR: MOVSI TEMP,[ASCIZ/PRISET/]
POP P,-1(P)
JRST (LPSA)]
MOVE PB,@DATAB(TABL) ;GET DATUM
TLNE PB,TERM
JRST [MOVEI LPSA,TRPPOP
JRST PRIERR]
PUSHJ P,REMPRI ;TAKE OFF MY LIST
MOVE A,-1(P)
CAIG A,17 ;CHECK BOUNDS
CAIGE A,0
JRST [MOVEI LPSA,ER.IPR
JRST PRIERR]
PUSHJ P,SETPRI
RET.3: SUB P,X33
JRST @3(P)
ER.IPR: HRRI TEMP,[ASCIZ/Illegal priority/]
POP P,-1(P)
POP P,-1(P)
JRST ER.ITN
COMMENT SPECIAL GC ROUTINE FOR PROCESSES
HERE(%PSSGC)
MOVE TEMP,RUNNER
MOVEM SP,ACSP(TEMP)
;; dont get it from here (assume was ok)
; MOVE RF,RACS+RF(USER)
MOVEM RF,ACF(TEMP)
HRLZI B,-NPRIS
HRR B,GOGTAB
SCHL1: SKIPN TEMP,PRILIS(B)
JRST NXLS
PUSH P,B
SCHL2: MOVE RF,ACF(TEMP)
PUSH P,TEMP
PUSHJ P,%ARSR1
MOVE TEMP,(P)
HRRZ A,ISP(TEMP)
MOVE SP,ACSP(TEMP)
PUSHJ P,%SPGC1
POP P,TEMP
HRRZ TEMP,PLISTE(TEMP)
JUMPN TEMP,SCHL2
POP P,B
NXLS: AOBJN B,SCHL1
MOVE TEMP,RUNNER
;; now get rf for this process back (also sp)
MOVE RF,ACF(TEMP)
MOVE SP,ACSP(TEMP)
POPJ P,
COMMENT INTERRUPT ROUTINES
HERE(DDFINT) ;DO DEFERRED INTERRUPT
SKIPE NOPOLL ;IGNORING IT?
POPJ P, ;YES
SETZM INTRPT ;
MOVE USER,RUNNER ;NEED TO SAVE ACS
POP P,PCW(USER) ;SAVE PC WORD
MOVNS STATUS(USER) ;READY
MOVEI TEMP,AC0(USER) ;
BLT TEMP,ACP(USER) ;
MOVEI A,1 ;NEED ALL ACS
MOVEM A,REASON(USER) ;
JRST FOTR ;SEE WHOM TO RUN
HERE(INTSET)
;CALL IS INTSET(ITEM,SPROUT OPTS)
;ORS IN THE STATUS OPTIONS FOR SPNDNP+RUNME
;TURNS OFF THE OPTION FOR SPNDME
MOVE USER,GOGTAB ;
SKIPE DISPAT(USER) ;HAVE TABLES???
JRST .+3 ;YES
PUSH P,[=128] ;DEFAULT BUFFER SIZE
PUSHJ P,INTTBL ;GO GET EM
PUSH P,-2(P) ;ITEM
PUSH P,[INTPDA] ;INTERRUPT PROCEDURE
;;#YM# ! was -2(P) typo WFW/JFR 1-21-77
MOVE A,-3(P) ;GET OPTIONS
TRZ A,SPNDME ;SET UP STATUS FIELD
TRO A,SPNDNP+RUNME ;
PUSH P,A ;
PUSH P,[0] ;NO KILL SET
PUSHJ P,SPROUT ;SPROUT IT
MOVE C,-2(P) ;THE ITEM
MOVE A,@DATM
MOVE USER,GOGTAB
MOVEM A,INTPRC(USER) ;REMEMBER INTERRUPT PROCESS BASE
MOVE A,-1(P) ;
TRNE A,PRIMSK ;DID HE SPEC A PRIORITY
JRST POK
PUSH P,C ;ITEM
PUSH P,[0]
PUSHJ P,PRISET ;SET THE PRIORITY
POK:
SUB P,X33
JRST @3(P)
HERE(CLKMOD)
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 USER,GOGTAB ;SO CAN CALL ANY TIME
MOVE 11,INTQWP(USER)
IQW 1
IQW 6
NOTENX<
MOVE TEMP,XJBCNI
IQW TEMP
MOVE TEMP,XJBTPC
IQW TEMP
>;NOTENX
TENX<
MOVE TEMP,-5(P)
IQW TEMP
MOVE TEMP,-4(P)
IQW TEMP
>;TENX
MOVE TEMP,RUNNER
IQW TEMP
MOVE 1,-1(P)
VILOOP: MOVE TEMP,(1)
IQW TEMP
AOBJN 1,VILOOP
MOVEM 11,INTQWP(USER)
SETOM INTRPT
SKIPN 7,INTPRC(USER) ;INTERRUPT PROCESS
JRST DF.X
MOVEI TEMP,1 ;READY
SKIPL STATUS(7)
MOVEM TEMP,STATUS(7)
DF.X: SUB P,X22
JRST @2(P)
IQWOV: ERR <DRYROT IN INTMOD -- WRITER>
JRST DF.X
HERE(DFRINT)
PUSH P,@DFRINF(USER)
PUSHJ P,DFR1IN
POPJ P,
TYMSHR <IFE ALWAYS <
TYSDFF: 0
XWD 0,TYSDF2
0
LINK %INLNK,TYSDFF
TYSDF2: PUSH P,[PUSHJ P,DDFINT]
POP P,DDFINA
POPJ P,
>>;TYMSHR
COMMENT THE INTERRUPT PROCESS
DEFINE IQR(AC) <
QR (AC,<INTQWP(USER)>,D,<INTQWT(USER)>,<INTQWB(USER)>,<JRST QRERR>)
>
HERE(INTPRO)
PUSH P,RF
;;#YE# 1! JFR 1-5-77 FIX OBSCURE PHASING BUG
PUSH P,INTPDA+PD.PDA
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
;;#SC# ! USED TO BE A JUMPE.
SOJLE 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)
;;#YE# 1! JFR 1-5-77 DONT LABEL COMPLEX ATOMS IN FAIL--PHASING PROBLEMS
IPDE (PD.PDA,<<XWD INTPDA,0>>)
IPDE (PD.LLW,<INTPDA+PD.XXX>)
IPDE (PD.DLW,<INTPDA+PD.XXX>)
;DFCPKT(5 WD BLOCK ADDR,EVTYP,EVNOT,OPTS)
; CREATES A FIVE WORD BLOCK FOR A DEFERED CAUSE & RETURNS AN AOBJN
; POINTER TO THE BLOCK
; IF THE SUPPLIED BASE ADDRESS IS 0 THEN USES THAT ADDRESS
; OTHERWISE DOES A CORGET TO GET THE FIVE WORDS
HERE(DFCPKT)
SKIPE B,-4(P) ;DID USER GIVE ME A BLOCK
JRST DFC.1 ;YES
MOVEI C,5
PUSHJ P,CORGET
ERR <NO CORE LEFT>
DFC.1: HRLI B,-5
MOVE A,B ;AOBJN PTR
SUB B,X11 ;READY FOR PUSHES
;;#SC# ! USED TO BE A 4
PUSH B,[5]
PUSH B,-3(P)
PUSH B,-2(P)
PUSH B,-1(P)
PUSH B,[XWD -1,CAUSE]
SUB P,[XWD 5,5]
JRST @5(P) ;RETURN
COMMENT CAUSE
HERE(CAUSE)
MOVE PB,RUNNER
AOS A,CAUSES(PB)
CAIE A,1 ;FIRST CAUSE?
JRST DFRCS ;NO -DEFER IT
POP P,CAUSRA(PB) ;SAVE RETN ADDRESS
CSIT: PUSHJ P,CAUSE1 ;DO THE WORK
MOVE PB,RUNNER
SOSG A,CAUSES(PB) ;DONE ONE
JRST CSE.X ;ALL ARE DONE -- CHECK FOR SCHED REQ
MOVEI KL,CAUSEQ(PB) ;GET NEXT FROM QUEUE
PUSHJ P,REMCAR
HLRZ B,(A) ;PICK UP TYPE
PUSH P,B
HRRZ B,(A) ;NOTICE
PUSH P,B
PUSH P,1(A) ;OPTIONS
MOVE TABL,GOGTAB
HRR B,FP2(TABL) ;RELEASE 2 WD BLOCK
HRRM B,(A)
HRRM A,FP2(TABL)
JRST CSIT ;GO WORK ON THIS
DFRCS: MOVE TABL,GOGTAB ;
NNCLL2 (B) ;GET 2 WD CELL
POP P,TMP ;RETURN ADDRESS
POP P,1(B) ;OPTS
POP P,(B) ;NOTICE
POP P,A ;TYPE
HRLM A,(B)
MOVEI KL,CAUSEQ(KL) ;PUT ON CAUSE QUEUE
PUSHJ P,ITAILS ;PUT ON TAIL OF QUEUE
JRST (TMP) ;RETURN
CSE.X: MOVE USER,GOGTAB
SKIPN SCHDRQ(USER) ;SCHEDULING REQUEST
JRST @CAUSRA(PB) ;NO
SETZM SCHDRQ(USER) ;YES
PUSH P,CAUSRA(PB) ;YES
JRST URSCHD ;RESCHEDULE
COMMENT CAUSE1 -- ROUTINE TO DO ACTUAL WORK
HERE(CAUSE1)
CSE1: JSP TMP,EVTCK3 ;VERIFY THAT THIS IS AN EVENT ITEM
;ALSO EVT _ DATUM ,B&C_ITEM #
SKIPE PDA,CAUSEP(EVT) ;DID THE USER SAY SOMETHING???
JRST USPPRC ;USER SPEC PROCEDURE
MOVE FF,-1(P) ;OPTIONS
SKIPN TMP,WAITLS(EVT) ;WAS ANYONE WAITING?
JRST SCA.2 ;NO
MOVE TEMP,B ;EV TYP NO
MOVE TMP,(TMP) ;LAST,,FIRST
MOVE D,-2(P) ;NOTICE NO
SCA.1: MOVE TMP,(TMP) ;WAIT ENTRY
HLRZ C,TMP ;PROCESS NO
MOVE TABL,GOGTAB ;SET TABL TO RIGHT THING
PUSHJ P,ANSWR1 ;SPECIAL ENTRY POINT IN ANSWER
TRNE A,NOJOY ;DID WE SUCCEED??
JRST SCA.1A ;NO
TRNN A,RETAIN ;KEEP THE NOTICE??
TRO FF,DNTSAV ;YES
TRNN FF,TELLAL ;TELL THE WHOLE WORLD?
JRST SCA.2 ;NO
SCA.1A: TRNE TMP,-1 ;ANY LEFT
JRST SCA.1 ;YES
SCA.2: TRNE FF,DNTSAV ;SAVE IT?
JRST SCA.3 ;NO
MOVE B,-2(P) ;ITEM NO OF NOTICE
MOVEI KL,NOTCLS(EVT) ;
PUSHJ P,ITAILS ;PUT ON END OF NOTIICE LIST
SCA.3:
MOVE USER,GOGTAB
TRNE FF,SCHDIT ;WANT TO RESCHEDULE
SETOM SCHDRQ(USER) ;RESCHEDULE REQUEST
SCA.X: SUB P,X44 ;RETURN
JRST @4(P)
USPPRC: MOVE B,PD.(PDA) ;HERE IF USER SPECIFIED A PROCEDURE
;;#NB# !TYPO -- WAS A TLNE
TLNN PDA,-1 ;CONTEXT GIVEN
JRST (B) ;NO
PUSH P,RF ;SET UP CONTEXT
HRRZ C,PD.PPD ;PARENTS PDA
MOVS A,PDA ;
HLRZ D,1(A)
CAME D,C ;SAME?
ERR <CONTEXT WRONG OR CLOBBERED IN INTERP CALL
USER SPEC EVENT PROC >
PUSH P,A ;STATL
PUSH P,SP
HLRZ B,PD.PPD(PDA)
JRST (B) ;GO TO INSTR AFTER THE MKSEMT
COMMENT ANSWER -- subroutine used by CAUSE
HERE(ANSWER)
;A_ANSWER(EV!TYP,NOT,PROCESS!ITEM);
;IF ATTEMPT TO ANSWER INTERROGATE IS SUCCESSFUL, A _ REQUEST CODE
;OTHERWISE, NOJOY BIT IS ON IN A & REST OF WORD IS INVALID
MOVE TEMP,-3(P) ;EV TYPE
POP P,-3(P) ;RET ADRS
POP P,C ;PROCESS ITEM
POP P,D ;NOTICE
MOVE TABL,GOGTAB
LDB B,INFOTAB(TABL)
CAIE B,PRCTYP
JRST [MOVSI TEMP,[ASCIZ/ANSWER/]
JRST ER.NPI]
;THE REST OF THIS IS CALLED INTERNALLY
;EXPECTS D= NOIICE, C=PROCESS ITEM, TEMP=EV TYPE
; ALSO TABL SET UP FOR PROCESS ITEM
;MODIFIES A,B,C,TABL,PB,TEMP,USER
ANSWR1: MOVE PB,@DATAB(TABL) ;THE PROCESS BASE
TLNN PB,TERM ;TERMINATED?
SKIPE STATUS(PB) ;OR NOT SUSPENDED??
JRST NOANS ;YES
AOS STATUS(PB) ;MAKE READY
MOVEM D,AC1(PB)
ANSWR2: PUSHJ P,DELWRQ ;DELETE ALL WAIT REQUESTS
MOVE A,INTRGC(PB) ;THE INTERROG CONTROL WORD
TRNN A,SAYWCH ;ASKED FOR THE ASSOCIATION
POPJ P, ;NO
PUSH P,[EVTYPI] ;
PUSH P,D
PUSH P,TEMP
PUSHJ P,STACSV ;SAVE ALL ACS
MOVEI 5,16 ;MAKE
PUSHJ P,LEAP
PUSHJ P,STACRS ;GET ACS BACK
POPJ P,
NOANS: TRO A,NOJOY
POPJ P, ;RETURN
COMMENT DELWRQ -- delete all wait requests
;EXPECTS PB = THIS PROCESS
;MANGLES A,B,C,TABL
DELWRQ: SKIPN A,WAITES(PB)
POPJ P,
PUSH P,KL
MOVE A,(A) ;A IS LAST,,FIRST
DTHSRQ: MOVE A,(A) ;NEXT ENTRY
HLRZ C,A ;ITEM NUMBER OF TYPE
PUSH P,A ;FOR SAFE KEEPING
MOVE TABL,GOGTAB ;
GLOB <
;;%BE%
CAIL C,GBRK ;GLOBAL ??
MOVEI TABL,GLUSER ;
>;GLOB
MOVE A,@DATAB(TABL)
MOVEI KL,WAITLS(A)
MOVE B,PRCITM(PB)
PUSHJ P,DELTLE ;DELETE ELEMENT
;SETS TABL BACK TO GOGTAB
;(MAYBE)
POP P,A
TRNE A,-1 ;ANY LEFT
JRST DTHSRQ ;YES
MOVE A,WAITES(PB)
MOVE TABL,GOGTAB
HLRZ B,(A) ;ADDRESS OF LAST
HRRZ C,FP1(TABL)
HRRM C,(B) ;RELEASE THE LOT
HRRM A,FP1(TABL)
SETZM WAITES(PB) ;NONE LEFT
POP P,KL
POPJ P,
COMMENT INTERROGATE
HERE(INTERROGATE)
SKIPN B,-2(P) ;SET OR ITEM
ERR <NULL INTERROGATION???>
TLNN B,-1 ;SET?
JRST ASK1.0 ;NO
MOVEI FF,MULTIN
IORM FF,-1(P) ;SAY MULT REQUEST
MOVE TMP,(B) ;LAST,,FIRST
MPCI: MOVE TMP,(TMP) ;NEXT ENTRY
HLRZ B,TMP
PUSH P,TMP
PUSH P,B ;TYPE ITEM
PUSH P,-3(P) ;OPTIONS WORD
PUSHJ P,ASK1.0
POP P,TMP ;GET LIST BACK
CAIE A,NIC ;FIND ONE??
JRST ASK1.X ;YES
TRNE TMP,-1 ;DONE LIST???
JRST MPCI ;NO
MOVE FF,-1(P)
TRNN FF,WAIT ;WAITING REQUESTED
JRST ASK1.X ;NO
MOVE PB,RUNNER ;SUSPEND SELF
MOVE B,-2(P) ;THE LIST
MOVE TMP,(B) ;LAST,,FIRST
BWL: MOVEI KL,WAITES(PB)
MOVE TMP,(TMP) ;NEXT
HLRZ B,TMP ;ITEM NO
MOVE C,B
MOVE EVT,@DATM
PUSHJ P,ITAILS ;ON TAIL
MOVE B,PRCITM(PB) ;
MOVEI KL,WAITLS(EVT)
PUSHJ P,ITAILS ;ON EVENT WAIL LIST
TRNE TMP,-1
JRST BWL ;CDR DOWN LIST
JRST DOWAIT ;GO WAIT
COMMENT ASK -- used by INTERROGATE
ASK1I: MOVE B,-2(P)
ASK1.0: JSP TMP,EVTCKB ;GET DATUM OF EVENT TYPE
;;#NB# ! WAS SKIPE A,...
SKIPE PDA,INTRGP(EVT) ;USER WAIT PROCESS??
JRST USPPRC ;YES
;;# #! ASKNTC POINTS HERE
ASKN: MOVE FF,-1(P) ;CONTROL WORD
SKIPN A,NOTCLS(EVT) ;ANY READY TO GO
JRST ASK1.4 ;NO
TRNE FF,RETAIN ;RETAIN THIS ONE??
JRST ASK1.1 ;YES
MOVEI KL,NOTCLS(EVT)
PUSHJ P,REMCAR ;GET THE FIRST
JRST ASK1.2 ;TEST SAYWCH
ASK1.1: MOVE A,(A)
HLRZ A,(A) ;THI FIRST ITEM
ASK1.2: TRNN FF,SAYWCH ;WANT ASSOCIATION
JRST ASK1.3 ;NO
PUSH P,[EVTYPI] ;EVENT TYPE
PUSH P,A ;NOTICE
PUSH P,-4(P) ;WHATEVER TYPE IT IS
PUSHJ P,STACSV ;SAVE REGS
MOVEI 5,16 ;MAKE
PUSHJ P,LEAP
PUSHJ P,STACRS ;GET ACS BACK
ASK1.3:
ASK1.X: SUB P,X33
JRST @3(P) ;RETURN
ASK1.4: MOVEI A,NIC
TRNE FF,WAIT ;IF NOT WAITING OR
TRNE FF,MULTIN ;MUL REQ
JRST ASK1.X ;ALL DONE
MOVE PB,RUNNER
MOVEI KL,WAITES(PB) ;WAIT ON THIS ONE
PUSHJ P,ITAILS ;PUT ON TAIL
MOVE B,PRCITM(PB)
MOVEI KL,WAITLS(EVT)
PUSHJ P,ITAILS
DOWAIT: SETZM STATUS(PB)
MOVEM FF,INTRGC(PB)
MOVEI A,WAITNG
MOVEM A,REASON(PB)
PUSHJ P,SPSRN2 ;WAIT
JRST ASK1.X ;RETURN
HERE(ASKNTC)
;;#NC# ! WAS A PUSHJ
JSP TMP,EVTCK3 ;CHECK EVENT TYPE
JRST ASKN ;GO DO IT
;ROUTINE TO SET UP EVENT TYPE ITEM
;SETS B & C TO ITEM #
;SETS EVT TO DATUM
;SETS TABL TO RIGHT THING FOR ITEM
;CALLED VIA JSP TMP,EVTCKX
EVTCK3: SKIPA B,-3(P)
EVTCK2: MOVE B,-2(P)
EVTCKB: MOVE TABL,GOGTAB
MOVE C,B
GLOB <
;;%BE% allow for global items RHT 1-8-74
CAIL C,GBRK ;IS THE ITEM GLOBAL
MOVEI TABL,GLUSER ;YES, USE GLOBAL INFO STUFF
>;GLOB
LDB A,INFOTAB(TABL)
CAIE A,EVTTYP
ERR <THIS ITEM IS NOT AN EVENT TYPE>,6
MOVE EVT,@DATAB(TABL)
GLOB <
;;%BE% real hack for now, only the item gets to be global.
MOVE TABL,GOGTAB
>;GLOB
JRST (TMP)
COMMENT MKEVTT,SETCP,& SETIP
HERE(SETCP)
JSP TMP,EVTCK2
MOVE A,-1(P)
MOVEM A,CAUSEP(EVT)
XIT3: SUB P,X33
JRST @3(P)
HERE(SETIP)
JSP TMP,EVTCK2
MOVE A,-1(P)
MOVEM A,INTRGP(EVT)
JRST XIT3
HERE(MKEVTT) ;MAKE EVENT TYPE
MOVE C,-1(P)
MOVEI A,EVTTYP
MOVE TABL,GOGTAB
GLOB <
;;%BE%
CAIL C,GBRK
JRST [ SETOM USCOR2(TABL) ;BLOCK IN UPPER
MOVEI TABL,GLUSER
JRST .+1 ]
>;GLOB
DPB A,INFOTAB(TABL)
MOVEI C,NEVARS
PUSHJ P,CORGET
ERR <MKEVT: No core>
MOVE C,-1(P)
MOVE TABL,GOGTAB
GLOB <
;;%BE%
CAIL C,GBRK
JRST [ SETZM USCOR2(TABL) ;UNDO ABOVE
MOVEI TABL,GLUSER
JRST .+1 ]
>;GLOB
MOVEM B,@DATAB(TABL)
HRLI D,(B)
HRRI D,1(B)
SETZM (B)
BLT D,NEVARS-1(B)
SUB P,X22
JRST @2(P)
COMMENT SPARE HERE TABLE ENTRIES
;THE IDEA IS THAT THIS WAY WE HAVE FLEXIBILITY
;WITHOUT GOING TO A NEW SEGMENT ALL THE TIME
HERE(NWLD1)
HERE(NWLD2)
HERE(NWLD3)
HERE(NWLD4)
HERE(NWLD5)
ERR <DRYROT IN NWORLD>
BEND PROCSS
ENDCOM(PRC)
COMPIL(IRP,,,,,,DUMMYFORGDSCISS)
NOTENX <
NOTYMSHR <
DEFINE IENS1 < INTTBL,INTMOD,ENABLE,DISABLE,INTMAP>>;NOTYMSHR
TYMSHR <DEFINE IENS1 <INTTBL,ENABLE,DISABLE,INTMAP>>;TYMSHR
DEFINE IEXT1 < GOGTAB,INTRPT,X22,CORGET >
IFN APRISW <
DEFINE XJBCNI <JOBCNI>
DEFINE XJBTPC <JOBTPC>
DEFINE XJBAPR <JOBAPR>
DEFINE IEXT5 <JOBCNI,JOBTPC,JOBAPR,XJBENB,APRACS>
IFN ALWAYS <
EXTERN JOBCNI,JOBTPC,JOBAPR ;THESE ARE ALWAYS EXTERNAL
>;IFN ALWAYS
>;IFN APRISW
IFE APRISW <
DEFINE IEXT5 <XJBCNI,XJBTPC,XJBAPR,JOBINT>
IFN ALWAYS <
EXTERNAL JOBINT ;THIS FELLOW IS ALWAYS EXTERNAL
>;IFN ALWAYS
>;IFE APRISW
COMPXX(IRP,< IENS1 >,< IEXT1,IEXT5 >
,<INTERRUPT STUFF>,,HIIFPOSSIB)
BEGIN IRPPKG
INTDBG__0
IFE APRISW <
IFE INTDBG <
OPDEF DISMIS [ CALLI 400024]
>;IFE INTDBG
IFN INTDBG <
DEFINE DISMIS < JRST DSMMSR >
DSMMSR:
HRLZI P,INACS
BLT P,P
JRST @JOBTPC
INACS: BLOCK 20
>;IFN ITDBG
OPDEF INTORM [ CALLI 400026]
OPDEF INTACM [ CALLI 400027]
OPDEF INTENB [ CALLI 400025]
>;IFE APRISW
NOTYMSHR <
IFN APRISW <
OPDEF APRENB [ CALLI 16]
DEFINE DISMIS < JRST DSMSSR >
DSMSSR: HRLZI 17,APRACS
BLT 17,17 ;BLT BACK ALL ACS
JRST @XJBTPC
>;IFN APRISW
HERE(INTTBL)
;CALL IS INTTBL(BUFFER!SIZE)
;SETS UP TABLES NEEDED BY THE INTERRUPT SYSTEM
MOVE USER,GOGTAB ;
INTTB1: MOVEI C,=110
ADD C,-1(P)
PUSHJ P,CORGET
ERR <INTSET: No core>
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)
ADD B,[XWD -10,20]
MOVEM B,ISPDP(USER)
SUB P,X22
JRST @2(P)
IFN INTDBG,<
INTAPR: MOVEM P,INACS+17
MOVEI P,INACS
BLT P,INACS+16
>;IFN INTDBG
HERE(INTMOD)
IFN APRISW <
MOVEM 17,APRACS+17
MOVEI 17,APRACS
BLT 17,APRACS+16 ;SAVE THE ACS
>;IFN APRISW
MOVE USER,GOGTAB
MOVE 7,XJBCNI ;PICK UP THE BITS
IFN APRISW <
ANDI 7,235110 ;BE SURE LEGIT BITS ONLY
>;IFN APRISW
MOVE P,IPDP(USER) ;A PDL FOR THIS
MOVE SP,ISPDP(USER) ;A STRING PDL
DSPIT: JFFO 7,DODISP ;DISPATCH INDEX
ERR <DRYROT: INTMOD>
DODISP:
SKIPN 7,@DISPAT(USER) ;GO DISPATCH
DISMIS ;DISMISS
PUSHJ P,(7) ;
DISMIS
COMMENT PROCEDURES TO ENABLE FOR INTERRUPTS
;ENABLE(INDEX) -- DOES AN INTORM
;DISABLE(INDEX) -- DOES AN INTACM
IFE APRISW <
HERE(ENABLE)
SKIPA B,[ INTORM A, ]
HERE(DISABLE)
MOVE B,[ INTACM A, ]
MOVN C,-1(P)
HRLZI A,400000
LSH A,(C)
XCT B
SUB P,X22
JRST @2(P)
>;IFE APRISW
IFN APRISW <
HERE(ENABLE)
SKIPA B,[OR A,XJBENB]
HERE(DISABLE)
MOVE B,[ANDCA A,XJBENB]
MOVN C,-1(P) ;
HRLZI A,400000
LSH A,(C) ;THE BIT
EXPO <
TRO A,400000 ;REPETITIVE ENABLE (THIS MIGHT GET YOU
;IN TROUBLE WITH THE CLOCK INTERRUPT)
>;EXPO
XCT B
MOVEM A,XJBENB ;REMEMBER
APRENB A,
SUB P,X22
JRST @2(P)
>;IFN APRISW
;INTMAP(INDEX,ENTRY!ADDR,PARAM);
;DISPAT[INDEX]_ENTRY!ADDR
;DFRINF[INDEX]_PARAM
HERE(INTMAP)
IFE APRISW <
MOVEI A,XJBCNI
MOVEM A,JOBINT
>;IFE APRISW
IFE INTDBG,<
MOVEI A,INTMOD
>;IFE INTDBG
IFN INTDBG,<
MOVEI A,INTAPR
>;IFN INTDBG
MOVEM A,XJBAPR
MOVE USER,GOGTAB
SKIPE DISPAT(USER)
JRST .+3
PUSH P,[=128]
PUSHJ P,INTTB1 ;GET MINIMAL TABLES
MOVE 10,-3(P) ;GET INDEX
POP P,-3(P) ;RET ADR
POP P,@DFRINF(USER)
POP P,@DISPAT(USER)
POPJ P,
> ;NOTYMSHR
TYMSHR <
COMMENT ! PROCEDURES TO ENABLE FOR INTERRUPTS
ENABLE (INDEX) -- ENABLES INTERUPT
DISABLE (INDEX) -- DISABLES
IN BOTH CASES IDEX MEANS:
IF INDEX LAND '777000 NEQ 0 THEN INDEX IS THE CHANNEL NUMBER
TO ENABLE OR DIABLE (WATCH USING CHANNELS 1 TO 4)
ELSE INDEX IS AN OLD STYLE NUMBER
29 FLOATING OVERFLOW CHL 1
32 OVERFLOW CHL 2
19 PDL OVERFLOW CHL 3
22 ILL MEM REF CHL 4
!
HERE (DISABLE)
TDZA B,B
HERE (ENABLE)
MOVSI B,400000 ;SET ON OR OFF BIT FOR INTENB
MOVE USER,GOGTAB
SKIPE DISPAT(USER)
JRST ENAB1
PUSH P,B
PUSH P,[=128]
PUSHJ P,INTTB1
POP P,B
ENAB1: HRRZ C,-1(P)
TRZN C,777000
JRST OLDENB
MOVNS C
MOVSI A,400000
LSH A,(C) ;GET A BIT FOR THE CHANNEL
OR B,A
ENBDO: INTENB B,
JFCL
ENBRT: SUB P,X22
JRST @2(P)
OLDENB: CAIN C,=29
JRST ENBFOV
CAIN C,=32
JRST ENBOV
CAIN C,=19
JRST ENBPDL
CAIE C,=22
JRST ENBRT ;JUST RETURN
TLO B,020000 ;SET BIT FOR CHANNEL 4
JRST ENBDO ;AND DO IT
ENBPDL: HRRZ A,IPDP(USER)
SUBI A,=6
TLNE B,400000 ;NEED JSR IF ENABLING
TLOA A,(<JSR>)
MOVSI A,1 ;OTHERWISE JUST SOMETHING NON-ZERO (MONTOR)
SETTR2 A,
JFCL
TLO B,040000
JRST ENBDO ;GO TURN ON CHL3
ENBOV: TLOA B,100000 ;FOR OVERFLOW
ENBFOV: TLO B,200000 ;OR FLOATING OVERFLOW
MOVEI C,0
INTENB C, ;JUST READ STATUS
JFCL
TLNN B,400000
TDZA C,B
IOR C,B ;MAKE IT LOOK LIKE IT WILL
HRRZ A,IPDP(USER)
SUBI A,=11
TLNE C,300000
TLOA A,(<JSR>) ;MAKE EITHER JSR OR JFCL
MOVSI A,(<JFCL>)
SETTR1 A,
JFCL
JRST ENBDO
COMMENT ! ROUTINE TO SET UP THE INTERUPT SYSTEM ORIGINALLY.
ALSO SETS UP THE DEFERED INTERUPT COMMUNICATION AREA
FROM SAIL PROGRAM CALL IS
INTTBL (SPACE DESIRED)
INTERNAL ROUTINES CALL AT INTTB1 WITHER USER SET UP !
HERE (INTTBL)
MOVE USER,GOGTAB
INTTB1: SKIPE DISPAT(USER) ;ONNLY ZERO THE FIRST TIME
JRST INTTB2
MOVEI C,=210+20+30+=72+1+5+5 ;SPACE FOR
;INTERUPT TABLE AND ROUTINES, PDL, SPDL, DISPAT
;AND DFRINF TABLES, SAVE INTERUPT PTR, OVERFLOW
;AND PDL OVERFLOW ROUTINES IN THAT ORDER
PUSHJ P,CORGET
ERR <NOT ENOUGH SPACE FOR INTSET>
HRLI B,10 ;MUST HAVE INDEX FIELD SET IN THESE TABLES
MOVEM B,DISPAT(USER)
ADDI B,=36
MOVEM B,DFRINF(USER)
ADDI B,=36
MOVE A,B
HRLI A,6
INTADR A, ;SET UP THE INTERUPT TABLE
JFCL
HRLI B,-=35 ;NOW SET UP THE ENTRIES
COMMENT !
FOR EACH OF THE 35 CHANNELS THERE ARE THREE ENTRIES
FIRST THE TWO WORDS OF THE INTERUPT TABLE
RETURN ADDRESS
INTERUPT ROUTINE ADDRESS
THEN THE TWO WORDS OF THE INTERUPT ROUTINE
MOVEM 16,<STORAGE WORD 1>
JSP 16,<COMMON INTERUPT ROUTINE>
THEN THE TWO STORAGE WORDS.
THE TOTAL STRUCTURE IS
70 WORDS OF TABLE
70 WORDS OF INTERUPT ROUTINE
70 WORDS OF STORAGE
!
MOVE C,[JSP 16,COMIMD]
MAKTB1: MOVEI A,=70(B)
MOVEM A,1(B)
MOVSI A,(<MOVEM 16,>)
HRRI A,=140(B)
MOVEM A,=70(B)
MOVEM C,=71(B)
ADDI B,1
AOBJN B,MAKTB1
ADDI B,=140
COMMENT ! NOW FOR THE OVERFLOW AND PDL OV ROUTINES. THESE ARE
CALLED WITH JSR AND LOOK LIKE
0 ;JSR HERE
MOVEM 16,.+2
JSP 16,<EITHER COMOVF OR COMPDL>
BLOCK 2
!
MOVEI A,3(B)
HRLI A,(<MOVEM 16,>)
MOVEM A,1(B)
HRRI A,=8(B)
MOVEM A,6(B)
MOVE A,[JSP 16,COMOVF]
MOVEM A,2(B)
HRRI A,COMPDL
MOVEM A,7(B)
ADDI B,=11 ;ALSO LEAVE SPACE FOR INTEUPT POINTERWORD
HRLI B,-20
MOVEM B,IPDP(USER)
ADD B,[XWD -10,20]
MOVEM B,ISPDP(USER)
INTTB2: MOVE C,-1(P) ;GET SPACE REQUESTED
PUSHJ P,CORGET
ERR <NOT ENOUGH SPACE FOR INTSET>
HRRZM B,INTQWB(USER)
HRRZM B,INTQWP(USER)
HRRZM B,INTQRP(USER)
ADD B,-1(P)
HRRZM B,INTQWT(USER)
SUB P,X22
JRST @2(P)
COMMENT ! HERE IS THE ACTUAL INTERUPT CODE !
COMIMD: MOVEM 17,=69(16) ;STORE ANOTHER AC IN PER CHL AREA
MOVSI 17,1
INTADR 17, ;TURN OFF PI SYSTEM TO PREVENT MULTIPLE
JFCL ;INTERUPTS
MOVEI 17,APRACS
BLT 17,APRACS+15
DMOVE 1,=68(16)
DMOVEM 1,APRACS+16 ;GET ALL ACS THERE
MOVE 1,-=72(16)
MOVEM 1,JOBTPC ;AND THE INTERUPT ADDRESS
IFN <SP-16>,<MOVE SP,16 ;JUST IN CASE ITS NOT 16>
MOVE USER,GOGTAB
MOVE P,IPDP(USER)
MOVEM SP,-1(P) ;STORE IT HERE FOR RETURN
MOVE SP,ISPDP(USER)
REDPIP 7,
JFCL
TLZ 7,400000 ;JUST IN CASE
JFFO 7,DODISP
ERR <DRYROT: INTMOD>
DODISP: CAIG 10,3
JRST [MOVE A,APRACS+16 ;THESE ARE SPECIAL
MOVE B,-3(A)
MOVEM B,JOBTPC
DMOVE A,(A)
DMOVEM A,APRACS+16
JRST .+1]
SKIPE 7,@DISPAT(USER)
PUSHJ P,(7)
MOVE 16,-1(P)
MOVE 1,JOBTPC ;GET SET TO PUT PC BACK
MOVE 2,-2(1)
CAMN 2,[SKIPE INTRPT] ;WOORY ABOUT RACE CONDITION
SUBI 1,2
MOVEM 1,-=72(16) ;THE DISPATCH LOCATION FOR DISMISS
DMOVE 2,APRACS+16
DMOVEM 2,=68(16)
MOVSI 15,APRACS
BLT 15,15 ;RRESTORE SOME ACS
MOVSI 17,300000
INTACT 17, ;CLEAR PENDING OVERFLOW INTERUPTS
JFCL
MOVSI 17,2
INTADR 17, ;NOW SYSTEM IS ON AGAIN
JFCL
DMOVE 16,=68(16)
DISMIS
COMMENT ! NOW FOR THE OVERFLOW AND PDL OV ROUTINES!
COMPDL: TLZ 16,440140 ;ZERO ALL OVERFLOW BITS
COMOVF: MOVEM 17,1(16)
MOVSI 17,640000 ;CAUSE SOME INTERUPTS
TLNN 16,040000
TLC 17,300000 ;IF FLOAT-OVEFLOW FLAG OFF CHANGE TO OVERFLOW
TLNN 16,440140 ;IF NO OVERFLOW BITS
TLZA 17,300000 ;TURN OFF OVERFLOW CHANNELS
TLZ 17,040000 ;ELSE PDL CHANNELS
TLZ 17,040000 ;SAME FOR PDL OV
INTACT 17,
JFCL
MOVE 17,1(16)
HRL 16,16
JRA 16,@-3(16)
COMMENT ! INTMAP SETS UP AN INTERUPT. THE CALL IS
INTMAP (INDEX,INTERUPT PROC,ARGS TO INT PROC)
INDEX TAKES ONE OF FOUR FORMS:
TYPE OF INT INDEX MONITOR CALL
OLD OLD INTERUPT NUMBER SPECIAL
INTASS (18) CAUSE (3) 001 (18) CAUSE (18) CHANNEL
(15) CHANNEL
TINASS (18) PORT (3) 101 (9) CAUSE (9) CHANNEL
(6) CAUSE (9) CHANNEL (18) PORT
INTRMT (18) DEV (3) 111 (9) CAUSE (9) CHANNEL
(6) CAUSE (9) CHANNEL (18) DEV
!
HERE (INTMAP)
MOVE USER,GOGTAB
SKIPE DISPAT(USER)
JRST .+3
PUSH P,[=128]
PUSHJ P,INTTB1
MOVE 10,-3(P) ;THE INDEX
TRZN 10,100000
JRST OLDMAP
TRZE 10,400000
JRST DEVMAP
COMMP2: MOVE A,10
MOVE B,[INTASS A,]
COMMAP: ANDI 10,777 ;GET CHANNEL
POP P,-3(P) ;RETURN ADDRESS
POP P,@DFRINF(USER)
POP P,@DISPAT(USER)
XCT B
JFCL
POPJ P,
DEVMAP: MOVS A,10 ;SET UP FOR MONITOR
TLZE A,200000
SKIPA B,[INTRMT A,]
MOVE B,[TINASS A,]
JRST COMMAP
OLDMAP: CAIN 10,=22
JRST [MOVE 10,[XWD 2,4] ;ILL MEM REF
JRST COMMP2]
CAIN 10,=19
MOVEI 10,3 ;PDL OV
CAIN 10,=32
MOVEI 10,2 ;OVERFLOW
CAIN 10,=29
MOVEI 10,1 ;FLOAT-OVERFLOW
MOVSI B,(<JFCL>) ;DON'T NEED ANYTING SPECIAL
CAILE 10,3
MOVEI 10,0
JRST COMMAP
> ;TYMSHR
HERE(IRPSP1)
HERE(IRPSP2)
HERE(IRPSP3)
BEND IRPPKG
>;NOTENX
TENX<
;; HERE IS THE TENEX VERSION
DEFINE IENS1 < INTTBL,PSIL1,PSIL2,PSIL3,ENABLE,DISABLE >
DEFINE IENS2 < ATI,DTI,RTIW,STIW,GTRPW,PSIMAP,INTMAP,PSIDISMS,PSIRUNTM,KPSITIME >
DEFINE IEXT1 < GOGTAB,INTRPT,JMPCHN,PS1CAS,PS2ACS,PS3ACS >
DEFINE IEXT2 < XJBCNI,XJBTPC,X22,X33,X44,CORGET,JOBUUO >
COMPXX(IRP,<IENS1,IENS2>
,<IEXT1,IEXT2>,<INTERRUPT STUFF FOR TENEX>,,HIIFPOSSIB)
BEGIN IRPPKG
HERE(INTTBL)
;CALL IS INTTBL(BUFFER!SIZE)
;SETS UP TABLES NEEDED BY THE INTERRUPT SYSTEM
MOVE USER,GOGTAB ;
INTTB1: MOVEI C,=194
ADD C,-1(P)
PUSHJ P,CORGET
ERR <INTSET: No core>
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
MOVEM B,TIMFRK(USER)
ADDI B,=36
HRRZM B,INTQWB(USER)
HRRZM B,INTQWP(USER)
HRRZM B,INTQRP(USER)
ADD B,-1(P)
HRRZM B,INTQWT(USER)
DEFINE XXX $ (LEV) <
MOVEI C,(B)
HRLI C,-20
MOVEM C,IPDP$LEV(USER)
ADDI B,20
MOVEI C,(B)
HRLI C,-10
MOVEM C,ISPDP$LEV(USER)
>
XXX(1)
XXX(2)
XXX(3)
SUB P,X22
JRST @2(P)
DEFINE XXX $ (LEV) <
HERE(PSIL$LEV)
MOVEM 16,PS$LEV$ACS+16 ;SAVE ACS
MOVEI 16,PS$LEV$ACS
BLT 16,PS$LEV$ACS+15
HRRZI 10,-JMPCHN-1(17) ;CHANNEL NUMBER INTO 10
MOVE USER,GOGTAB
MOVE P,IPDP$LEV(USER)
MOVE SP,ISPDP$LEV(USER)
SKIPN 7,@DISPAT(USER)
JRST DIS$LEV
MOVSI A,400000
MOVNI B,(10)
LSH A,(B)
PUSH P,A ;THE CHANNEL AS A BIT
MOVEI 1,400000 ;THIS FORK
JSYS RIR ;READ LEVTAB,CHNTAB
HLRZ 2,2 ;LEVTAB
PUSH P,@LEV-1(2) ;PC WORD FOR THIS LEVEL
PUSH P,JOBUUO ;SAVE JOBUUO
PUSHJ P,(7)
POP P,JOBUUO ;RESTORE JOBUUO
SUB P,X22 ;POINTLESS ACTUALLY
DIS$LEV:HRLZI 17,PS$LEV$ACS
BLT 17,17
JSYS DEBRK
>;END OF MACRO DEFINITION
XXX(1)
XXX(2)
XXX(3)
DSCR
ENABLE(PSICHAN)
Does an AIC on the pseudo-interrupt channel.
DISABLE(PSICHAN)
Does a DIC on the pseudo-interrupt channel.
HERE(ENABLE)
SKIPA C,AIC1
HERE(DISABLE)
MOVE C,DIC1
MOVN A,-1(P) ;NEGATED PSI CHAN
HRLZI B,400000
LSH B,(A) ;GET THE RIGHT BIT
HRRZI A,400000
XCT C
SUB P,X22
JRST @2(P)
AIC1: JSYS AIC ;AVOID A LITERAL
DIC1: JSYS DIC
DSCR
ATI(PSI,CHAR!CODE)
Assigns a character code to a PSI channel.
DTI(CHAR!CODE)
Deassigns a character code.
HERE(ATI)
HRRZ B,-1(P) ;GET THE CODE
JUMPL B,.+2 ;IF NOT (0 LEQ CODE LEQ =35) THEN ERR
CAILE B,=35
ERR <ATI: Terminal code not in range 0 thru 35>
MOVE A,-2(P) ;PSI CHANNEL
JUMPL A,BADCHN
CAILE A,=35
JRST BADCHN
CAIGE A,=24
CAIG A,=5
JRST .+2
BADCHN: ERR <ATI: Terminal interrupt channel not 0-5 or 24-35>
HRL A,B
JSYS ATI
SUB P,X33
JRST @3(P)
HERE(DTI)
HRRZ A,-1(P) ;TERMINAL CODE
JUMPL A,DTIERR
CAILE A,=35
DTIERR: ERR <DTI: Terminal interrupt code not in range>
JSYS DTI
SUB P,X22
JRST @2(P)
HERE(RTIW)
MOVE 1,-3(P)
JSYS RTIW
MOVEM 2,@-2(P)
MOVEM 3,@-1(P)
SUB P,X44
JRST @4(P)
HERE(STIW)
MOVE 1,-3(P)
MOVE 2,-2(P)
MOVE 3,-1(P)
JSYS STIW
SUB P,X44
JRST @4(P)
HERE(GTRPW)
MOVE 1,-2(P)
JSYS GTRPW
MOVEM 2,@-1(P)
SUB P,X33
JRST @3(P) ;CONTENTS OF 1 OK
HERE(PSIMAP)
MOVE USER,GOGTAB
SKIPE DISPAT(USER) ;ARE TABLES SET UP?
JRST .+3
PUSH P,[=128]
PUSHJ P,INTTB1 ;SO SET UP
MOVEI A,400000 ;THIS FORK
JSYS RIR ;READ ADDRESS
JUMPN 2,.+2
ERR <PSIMAP: DRYROT>
JSYS EIR ;TURN ON PSI SYSTEM
SKIPL 10,-4(P) ;CHANNEL
CAILE 10,=35 ;CHECK RANGE
ERR <PSIMAP: Channel number not between 0 and 35>
POP P,-4(P) ;RETURN ADDRESS
POP P,D ;LEVEL
CAIL D,1
CAILE D,3
ERR <PSIMAP: Level not between 1 and 3>
POP P,@DFRINF(USER) ;INFORMATION ABOUT DEFERRED INTERRUPT -- CHANNEL IN 10
POP P,@DISPAT(USER) ;DISPATCH ADDRESS -- CHANNEL IN 10
ADDI 2,(10) ;POSITION IN TENEX CHNTBL
ADDI 10,JMPCHN ;ADDRESS TO JMP TO FROM CHNTAB
HRLI A,(D) ;XWD LEVEL, ADDRESS
HRRI A,(10)
MOVEM A,(2) ;PUT INTO TENEX CHNTAB
MOVE A,LEVJMP-1(D) ;JUMP TO CORRECT LEVEL
MOVEM A,(10)
POPJ P, ;RETURN -- STACK IS OK
LEVJMP: JSA 17,PS1ACS+17
JSA 17,PS2ACS+17
JSA 17,PS3ACS+17
HERE(INTMAP)
PUSH P,(P) ;RETURN ADDR
MOVEI A,3 ;LEVEL 3
MOVEM A,-1(P) ;MAKE ANOTHER ARGUMENT
JRST PSIMAP ;AND CALL PSIMAP
DSCR
PSIDISMS(PSICHANNEL, TIME)
Causes an interrupt to occur on PSICHANNEL every
TIME ms. (Currently uses a lower fork for this.)
PSIRUNTM(PSICHANNEL TIME)
Causes an interrrupt to occur on PSICHANNEL after
each TIME increment in the runtime (according to the RUNTM jsys)
of this fork. TIME must be leq 777777 ms.
KPSITIME(PSICHANNEL)
Stops the interrupt from occurring on PSICHANNEL
that was initialized by PSIDISMS or PSIRUNTM. No-op if none there.
HERE(PSIDISMS)
BEGIN PSIDISMS
MOVE USER,GOGTAB
SKIPE DISPAT(USER) ;TABLES SET UP?
JRST .+3
PUSH P,[=128] ;DEFAULT DI BUFFER SIZE
PUSHJ P,INTTBL ;INITIALIZE
MOVE 10,-2(P) ;INTERRUPT CHANNEL
SKIPE 1,@TIMFRK(USER) ;GET FORK
JSYS KFORK ;KILL OLD ONE
MOVNI 1,(10) ;CHANNEL NEGATED
MOVSI 2,400000
LSH 2,(1) ;BIT MASK FOR CHANNEL IN 2
MOVE 3,-1(P) ;TIME TO DISMISS
ADD P,[XWD 20,20]
TLNN P,400000 ;OVERFLOW?
ERR <PSITIME: PDL overflow>
HRLI 4,PSTACS ;ADDRESS OF ACS
HRRI 4,-17(P) ;STACK ADDRESS
BLT 4,(P) ;ONTO STACK
MOVEM 3,-5(P) ;TIME
MOVEM 2,-6(P) ;CHANNEL MASK
MOVE 1,[XWD 240000,0] ;[3] SET ACS
MOVEI 2,-17(P) ;POINTER TO ACS
JSYS CFORK ;CREATE FORK
ERR <PSITIME: Cannot CFORK>
MOVEM 1,@TIMFRK(USER) ;SAVE HANDLE
JSYS RPCAP ;[3] SEE WHAT CAPABILITIES IT HAS
TLO 2,400 ;[3] ALLOW TO MANIPULATE SUPERIOR
TLO 3,400 ;[3]
JSYS EPCAP ;[3]
MOVEI 2,3 ;[3]
JSYS SFORK ;[3] START FORK AT AC 3
SUB P,[XWD 23,23] ;ADJUST STACK, INCLUDING ARGS
JRST @3(P) ;RETURN
;TEMPLATE FOR ACS FOR LOWER FORK
PSTACS: 0 ;0
0 ;1
0 ;2
MOVE 1,12 ;3
JSYS DISMS ;4
MOVEI 1,-1 ;HANDLE TO SUPERIOR FORK
MOVE 2,11 ;CHANNEL MASK
JSYS IIC ;CAUSE AN INTERRUPT
JRST 3 ;LOOP
0 ;11 --- CHANNEL MASK GOES HERE
0 ;12 -- TIME TO DISMISS GOES HERE
BLOCK 5 ;ACS 13-17 HERE
BEND PSIDISMS
HERE(PSIRUNTM)
BEGIN PSIRUNTM
MOVE USER,GOGTAB
SKIPE DISPAT(USER) ;TABLES SET UP?
JRST .+3
PUSH P,[=128] ;DEFAULT DI BUFFER SIZE
PUSHJ P,INTTBL ;INITIALIZE
MOVE 10,-2(P) ;INTERRUPT CHANNEL
SKIPE 1,@TIMFRK(USER) ;GET FORK
JSYS KFORK ;KILL OLD ONE
MOVNI 1,(10) ;CHANNEL NEGATED
MOVSI 2,400000
LSH 2,(1) ;BIT MASK FOR CHANNEL IN 2
CAIG 2,777777 ;IN LEFT HALF
JRST [HLL 2,[HRRZI 2,]
JRST GOTMSK]
HLR 2,2 ;MOVE MASK TO RIGHT HALF
HLL 2,[HRLZI 2,]
GOTMSK: MOVE 3,-1(P) ;TIME TO DISMISS
CAILE 3,777777 ;MAXIMUM IS 777777 MS
MOVEI 3,777777 ;FORCE TO MAXIMUM
ADD P,[XWD 20,20]
TLNN P,400000 ;OVERFLOW?
ERR <PSITIME: PDL overflow>
HRLI 4,PSTACS ;ADDRESS OF ACS
HRRI 4,-17(P) ;STACK ADDRESS
BLT 4,(P) ;ONTO STACK
HRRM 3,-5(P) ;TIME INTERVAL INTO AC 12
HRRM 3,-13(P) ;TIME INTERVAL INTO AC 4
MOVEM 2,-2(P) ;CHANNEL MASK INTO AC 15
PUSH P,3 ;SAVE TIME INTERVAL
MOVEI 1,400000 ;THIS FORK
JSYS RUNTM
POP P,3 ;RESTORE INTERVAL
ADD 1,3 ;NEXT TIME TO INTERRUPT
MOVEM 1,-17(P) ;STORE IN AC 0
MOVE 1,[XWD 240000,0] ;[3] SET ACS
MOVEI 2,-17(P) ;POINTER TO ACS
JSYS CFORK ;CREATE FORK
ERR <PSITIME: Cannot CFORK>
MOVEM 1,@TIMFRK(USER) ;SAVE HANDLE
JSYS RPCAP ;[3] SEE WHAT CAPABILITIES IT HAS
TLO 2,400 ;[3] ALLOW TO MANIPULATE SUPERIOR
TLO 3,400 ;[3]
JSYS EPCAP ;[3]
MOVEI 2,4 ;[3]
JSYS SFORK ;[3] START FORK AT AC 4
SUB P,[XWD 23,23] ;ADJUST STACK, INCLUDING ARGS
JRST @3(P) ;RETURN
;TEMPLATE FOR ACS FOR LOWER FORK
PSTACS: 0 ;0 NEXT RUNTM TO INTERRUPT
0 ;1
0 ;2
0 ;3
MOVEI 1,0 ;4 TIME INTERVAL IN THE RIGHT HALF
JSYS DISMS ;5 DISMISS FOR THIS LONG
MOVEI 1,-1 ;6 HANDLE TO SUPERIOR FORK
JSYS RUNTM ;7 GET RUNTIME IN AC 1
CAMGE 1,0 ;10 IS IT BEYOND THE INTERVAL?
JRST 4 ;11 NO DISMISS AGAIN
ADDI 1,0 ;12 NEXT PERIOD -- INTERVAL IN RIGHT HALF
MOVEM 1,0 ;13 AND SAVE IT
MOVEI 1,-1 ;14 HANDLE TO SUPERIOR FORK
HRRZ 2,0 ;15 CHANNEL MASK -- EITHER A HRRZ OR HRLZ INSTRUCTION, MODIFIED
JSYS IIC ;16 CAUSE AN INTERRUPT
JRST 4 ;17 AND CONTINUE
BEND PSIRUNTM
HERE(KPSITIME)
MOVE USER,GOGTAB
SKIPN TIMFRK(USER) ;CHECK SET UP
JRST KPSIRET ;NOT SET UP -- RETURN
MOVE 10,-1(P) ;CHANNEL NUMBER
SKIPE 1,@TIMFRK(USER)
JSYS KFORK ;KILL FORK
SETZM @TIMFRK(USER) ;REMEMBER NO FORK
KPSIRET:SUB P,X22
JRST @2(P) ;RETURN
HERE(IRPSP1)
HERE(IRPSP2)
HERE(IRPSP3)
BEND IRPPKG
>;TENX
ENDCOM(IRP)