!
! To make S series supervisor requires:-
! 1) Change SSERIES=NO to SSERIES=YES in ctoptions file
!
!
! THESE CONST INTEGERS DEFINE SIZES AND LAYOUT OF IMPORTANT TABLES
! THEY HAVE TO BE HERE TO BE GLOBAL TO ALL ROUTINES INCLUDING IO ONES
!
CONSTINTEGER LSTLEN=192; ! LOCAL SEGMENT TABLE LENGTH
CONSTINTEGER CBTLEN=299; ! LENGTH OF CBT TABLE
CONSTLONGINTEGER LCACR=1; ! ACR OF LOCAL CONTROLLER
CONSTINTEGER DIRCSEG=10; ! SEG NO OF DIRECTOR COMMS SEG
CONSTINTEGER DIRCSEGOFFSET=0; ! FOR ALIGNMENT IF NEEDED
CONSTINTEGER DIRCSEGAD=DIRCSEG<<18; ! VIRTUAL ADDRESS OF DIR COM SEG
CONSTINTEGER DIRCSEGL=8*CBTLEN+255+2*LSTLEN; ! SIZE OF SAME
! MADE UP OF 2049 FOR CBT
! 2*LSTLEN FOR SST
! 48+64 FOR 2 BITS OF SYTEMCALL TABLE
! 32+48 FOR DIROUTP&SIGOUT
CONSTINTEGER LSTACKLEN=3; ! LOCAL CONT. STACK ELEN
CONSTINTEGER LSTACKLENP=2; ! PAGED PART
CONSTINTEGER LSTKN=3; ! NO OF LOCAL STACKS
CONSTLONGINTEGER DIRACR=2; ! DIRECTOR ACR LEVEL
CONSTLONGINTEGER NONSLAVED=X'2000000000000000'
CONSTINTEGER MAXIT=X'FFFFFF'
! THESE CONST INTEGERS LAYOUT THE DIRECTOR COMMS SEGMENT(LOCAL 10)
CONSTINTEGER SCTIENTRIES=6; ! VALID I VALUES FOR SCT
CONSTINTEGER SCTI0=DIRCSEGAD+DIRCSEGOFFSET;! SYSTEMCALL INDEX TABLE
CONSTINTEGER SCTILEN=SCTIENTRIES*8; ! OF SCTIENTRIES DOUBLE WORDS
CONSTINTEGER SCTJ30=SCTI0+SCTILEN; ! 3RD BRANCH OF SC TABLE
CONSTINTEGER SCTJ3LEN=4*16; ! 4ENTRIES FOR 3 LC ROUTINES
CONSTINTEGER DIROUTPAD=SCTJ30+SCTJ3LEN;! ADDRESS OR DIROUTP
CONSTINTEGER DIROUTPLEN=32; ! ONE 32 BYTE RECORD
CONSTINTEGER SIGOUTPAD=DIROUTPAD+DIROUTPLEN;! ADDR SIGOUTP
CONSTINTEGER SIGOUTPLEN=48; ! ONE 48 BYTE RECORD
CONSTINTEGER CBTAD=SIGOUTPAD+SIGOUTPLEN;! CLAIMED BLOCK TABLE AD
CONSTINTEGER SSTAD=CBTAD+8*CBTLEN; ! 2DRY SEG TABLE OF LSTLEN BYTES
CONSTINTEGER LSTVAD=0; ! VIRTUAL ADDRESS OF LOCAL SEG TABLE
!-----------------------------------------------------------------------
RECORDFORMAT IOSTATF(INTEGER IAD,STRING (15) INTMESS, C
INTEGER INBUFLEN,OUTBUFLEN,INSTREAM,OUTSTREAM)
RECORDFORMAT PARMF(INTEGER DEST,SRCE,(INTEGER P1,P2,P3,P4,P5,P6C
OR STRING (6)USER,BYTEINTEGER INCAR,STRING (15)INTMESS))
CONSTRECORD (PARMF)NAME DIROUTP=DIROUTPAD
CONSTRECORD (IOSTATF)NAME IOSTAT=X'140048'
!
! THESE ROUTINES MUST BE DEFINED VIA EXTERNALSPEC FOLLOWED BY EXTERNAL
! ROUTINE SO AS TO FORCE EXTERNAL ACCESS AT ALL CALLS. IF NOT CALLS
! MADE VIA THE SYSTEM CALL TABLE WILL BE FOR INTERNAL ACCESS AND
! THIS MAY BE DISASTEROUS
!
EXTERNALINTEGERFNSPEC REQUEST INPUT(INTEGER OUTPUT POSN,TRIGGER POSN)
EXTERNALINTEGERFNSPEC REQUEST OUTPUT(INTEGER OUTPUT POSN,TRIGGER POSN)
EXTERNALINTEGERFNSPEC CHANGE CONTEXT
LONGINTEGERFNSPEC RTDR(INTEGERFN A)
EXTERNALROUTINE SUP29
!-----------------------------------------------------------------------
OWNSTRING (3) SUPID="29G"
! MAIN CHANGES FOR 26I
!---------------------
! 1) CHANGES FOR BETTER ACCESSING OF SEQUENTIAL FILES
! TOGETHER WITH REDUCTION IN STROBING
! 2) CHANGES TO PREPAGING LC STACK TO AVOID USING PPCELLS
! 3) PENALISING PROCESS WITH LOTS OF P4 TO P4 TRANSITIONS
! MAIN CHANGES FOR 26J
! --------------------
! 1) CHANGE TO IMP80
! MAIN CHANGES FOR 27A
! 1) STORE LIST NOW CONSTRUCTED BY CHOPSUPE
!
! MAIN CHANGES FOR 27B
! 1) INDIVIDUAL TIMEOUTS ON SNOOZING
!
!
! MAIN CHANGES FOR 27C
! 1) CORRECTIONS AND EXTENSIONS TO CODE FOR SPLITTING A DUAL
! SERVICE TO A SINGLE SERVICE AND A DEVLOPMENT M-C
!
! MAIN CHANGES FOR 27D
! 1) CHANGE TO SCHEDULE FOR SMOOTHER TRANSITION FROM SNNOZING
! TO NON-SNOOZING AS LOAD INCREASE PAST OPTIMUM
!
! MAIN CHANGES FOR 27E
! 1) CHANGE TO COLLECTION OF TIMING INFORMATION TO ALLOW ACCESS
! FROM A PRIVILEGED PROCESS
! 2) ON A PAGE FAULT IF A SEGMENT APPEARS TO BE BEING ACCESSED
! SEQUENTIALLY A LOWER NUMBERED PAGE IS REMOVED FROM THE
! WORKING SET.
!
! MAIN CHANGES FOR 27F
! 1) SETTING NONSLAVED BITS ON CONFIGURING IN AN OPC SINCE THE
! IPL MIGHT HAVE BEEN DONE ON A SINGLE!
! MAIN CHANGES FOR 27G
! 1) CHANGES TO SNOOZING TO OMIT READ ONLY PAGES FROM SNOOZ SET
! WHEN STORE IS BUSY PRIOR TO ABANDONING SNOOZING ALLTOGETHER
! MAIN CHANGES FOR 27H
! 1) REMOVING CHANGE 1 OF 27G AFTER DEVASTATING ERTE FIGURES
! 2) IN PROCESS VS MONITORING VIA OUT20
! MAIN CHANGES FOR 27I
! 1) DIRECT CALLS OF COMMS CONTROLLER FROM REQUEST OUTPUT
! MAIN CHANGES FOR 27J
! 1) DEDICATED FLAG (RECONFIGURE=YES/NO) FOR CONDITIONAL COMPILATION
! OF RECONFIGURE CODE.
! Main changes for 28A
! 1) Fully "S" series compatible.
! 2) Report to OPER on illegal system call
! MAIN CHANGES FOR 28B
! 1) USES THE MULTIPLE CONNECTS BIT IN DRUM WSET COMPUTATION
! 2) REVISION TO SCHEDULING OF P4 JOBS
! Main changes for 28C
! 1) Uses the new GPC/DCU driver 'GDC'
!
! MAIN CHANGES FOR 28D
! 1) CORRECTION TO CLEAR CODE TO STOP FILES BEING RECONNECTED
! BEFORE ALL THE CLEARS HAVE BEEN COMPLETED AND TO PREVENT
! CLEARS OVERWRITING VALID DATA.
! 2) INCORPORATION OF CONDITIONAL "DAP" CODE
! Main changes for 28E
! 1) Changes to multi OCP code to handle dual "S" series processors
! 2) Change to insist on day of week in "DT" command
! 3) Addition of FEDOWN command
!
! Main changes for 29a
! 1) Chanegs to Dap Driver for better interactive access
! MAIN CHANGES FOR 29B
! 1) "DIRECT" STACK MOVED UP 100 EPAGES TO ALLOW MORE FIXED SITES
! MAIN CHANGES FOR 29C
! 1) DAP DRIVER ADAPTED FOR MULTIPLE DAPS
!
! MAIN CHANGES FOR 29D
! 1) DPA DRIVER TIMES OUT DUD DAPS AND GEN RESSES THEM
!
! Main changes for 29F
! 1) Clears store to remove parities when configuring on a SMAC
! 2) Periodically checks that 'other' OCP is still awake
!
! Main changes for 29G
! 1) Dap now restarts at once after check for file syncronising
! 2) L-C Stacks page 0 into proper smac not dap after uncured problems
! with OCP claiming SSN+1 not resident when its in Dap store.
!
CONSTSTRING (3) CHOPID="22B"; ! EARLIEST COMPATABLE CHOPSUPE
!-----------------------------------------------------------------------
!*
!* Communications record format - extant from CHOPSUPE 22B onwards *
!*
RECORDFORMAT CDRF(BYTEINTEGER IPDAPNO,DAPBLKS,DAPUSER,DAPSTATE, C
INTEGER DAP1,DAPINT)
RECORDFORMAT COMF(INTEGER OCPTYPE,SLIPL,SBLKS,SEPGS,NDISCS,DLVNADDR, C
(INTEGER GPCTABSIZE,GPCA OR INTEGER DCUTABSIZE,DCUA), C
INTEGER SFCTABSIZE,SFCA,SFCK,DIRSITE, C
DCODEDA,SUPLVN,TOJDAY,DATE0,DATE1,DATE2, C
TIME0,TIME1,TIME2,EPAGESIZE,USERS,CATTAD,SERVAAD, C
BYTEINTEGER NSACS,RESV1, C
(BYTEINTEGER SACPORT1,SACPORT0 OR BYTEINTEGER C
OCP1 SCU PORT,OCP0 SCU PORT), BYTEINTEGER C
NOCPS,SYSTYPE,OCPPORT1,OCPPORT0,INTEGER ITINT, C
(INTEGER CONTYPEA,GPCCONFA,FPCCONFA,SFCCONFA OR C
INTEGER DCU2HWNA,DCUCONFA,MIBA,SP0), C
INTEGER BLKADDR,RATION, C
(INTEGER SMACS OR INTEGER SCUS), C
INTEGER TRANS,LONGINTEGER KMON, C
INTEGER DITADDR,SMACPOS,SUPVSN,PSTVA,SECSFRMN,SECSTOCD, C
SYNC1DEST,SYNC2DEST,ASYNCDEST,MAXPROCS,INSPERSEC,ELAPHEAD, C
COMMSRECA,STOREAAD,PROCAAD,SFCCTAD,DRUMTAD,TSLICE,FEPS, C
MAXCBT,PERFORMAD,RECORD (CDRF)ARRAY CDR(1:2), C
INTEGER LSTL,LSTB,PSTL,PSTB,HKEYS,HOOT,SIM,CLKX,CLKY,CLKZ, C
HBIT,SLAVEOFF,INHSSR,SDR1,SDR2,SDR3, C
SDR4,SESR,HOFFBIT,BLOCKZBIT,BLKSHIFT,BLKSIZE,END)
!
! This format describes "The Communication Record" which is kept
! locked in store at Public address X'80C00000'. It is readable at
! all ACR levels but writeable at ACR 1 only. Its purpose is to describe
! the hardware on which the EMAS System is running. Each entry is now
! described in more detail:-
!
! OCPTYPE The 2900 Processor on this configuration as follows
! 1 = 2950 (S1)
! 2 = 2960 (P2) or 2956 (S2)
! 3 = 2970 (P3) or 2966 (S3)
! 4 = 2980 (P4)
! 5 = 2972 or non-interleaved 2976 (P4/1)
! 6 = Interleaved 2976 (P4/1)
!
! SLIPL bit 0 is set to 1 to force an AUTO IPL from RESTART.
! bits 1-15 are the SLOAD lvn & site >>4.
! (equivalent to the handkey settings for AUTO IPL).
! bits 16-31 are thehe port/trunk/stream(or DCU/stream) of the
! device used at IPL time.
! SBLKS The no of 128k blocks of main store present
! SEPGS The no of extended pages for paging(ie not including
! any pages occupied by resident code & data).
! NDISCS Then number of EDS drives avaliable
! DLVNADDR The address of an array which maps disc lvns to
! their ddt slots.
! GPCTABSIZE The size in bytes of the GPC (or DCU) table
! GPCA The address of the GPC (or DCU) table
! SFCTABSIZE The size of the SFC(ie DRUM) table
! SFCA The address of the SFC table
! SFCK The number of (useable) 1K page frames of Drum store
! available for paging.(0 = No drum configuration)
! DIRSITE The Director site address(eg X200) no longer reqd?
! DCODEDA The Disc Address of the Director (expressed as
! SUPLVN<<24!DIRSITE)
! SUPLVN The logical volume no of the disc from which the
! Sytem was "SLOADED". Various System components (eg
! DIRECT, VOLUMS will page from here
!
! TOJDAY Todays (Julien) day number.
! DATE0} These three integers define the current date(updated at
! DATE1} at 2400) as a character string such that
! DATE2} the length byte is in the bottom of DATE0
!
! TIME0} These three integers define the clock time as a string
! TIME1} in the same format as for DATE. The time is updated
! TIME2} about every 2 seconds
!
! EPAGESIZE The number of 1K pages combined together to make up
! the logical "Extended Page" used in Emas.Currently=4
! USERS The number of user processes (foreground+background)
! currently in existence.Includes DIRECT,VOLUMS&SPOOLR
! CATTAD Address of maxcat followed by category table.
! SERVAAD The address of the service array SERVA.
! NSACS The number of sacs found at grope time
! SACPORT1} Holds the Port no of the Store Access Controller(s)
! SACPORT0} found at grope time. SACPORT0 was used to IPL system.
! NOCPS The number of OCPS found at grope time.
! SYSTYPE System infrastructure:
! 0 = SMAC based
! 1 = SCU based (SCU1)
! 2 = SCU based (SCU2)
! OCPPORT1} Hold the Port no of the OCPs found at grope time.
! OCPPORT0} OCPPORT0 was used to IPL the system.
! ITINT The Interval Timer interval in microsecs. Varies
! between different members of the range
! CONTYPEA The address of a 31 byte area containing the codes
! of the controllers in port-trunk order. Codes are:-
! 0 = Not relevant to EMAS
! 1 = SFC1
! 2 = FPC2
! 3 = GPC1
!
! GPCCONFA} These three variables each point to a word array
! FPCCONFA} containing controller data. The first word in each
! SFCCONFA} case says how many controllers on the system. The
! remainder have Port&Trunk in top byte and Public
! segment no of comms segment in bottom byte. For GPCS
! the Public Seg no is apparently omitted!
! BLKADDR The address of first element of a word array bounds
! (1:SBLKS) containing the real address of each 128K
! block of main store. Real addresses are in the form
! RSN/SMAC NO/Address in SMAC
! RATION Information maintained by DIRECT concerning access
! rationing. Bytes from left indicate scarcity,
! pre-empt point, zero and interactive users
! respectively
! SMACS Bits 0-15 are a map of SMACS in use by the system.
! 2**16 bit set if SMAC0 in use etc.
! Bits 16-31 are a map of SMACS found at grope time.
! 2**0 bit set if SMAC0 found etc.
! TRANS The address of a 768 byte area containing 3 translate
! tables. The first is ISO to EBCDIC, the second the
! exact converse & the third is ISO to ISO with
! lower to upper case conversion.
! KMON A 64 bit bitmask controlling monitoring of Kernel
! services. Bit 2**n means monitor service n. Bits can
! be set by Operator command KMON.
! DITADDR Disc index table address. The address of first
! element of an array(0:NDISCS-1) containing the address
! of the disc device entries.
! SMACPOS The no of places that the Smac no must be left
! shifted to be in the right position to access
! a Smac image store location. Incredibly this varies
! between the 2980 and others!!
! SUPVSN The Supervisor id no as a three char string eg 22A
! PSTVA The virtual address of the Public Segment table which
! is itself a Public segment. All other information
! about PST can be found by looking at its own PST entry
! SECSFRMN The no of Seconds since midnight. Updated as for TIME
! SECSTOCD The number of seconds to System closedown if positive
! If zero or negative no close down time has yet been
! notified. Updated as for TIME
! SYNC1DEST} These are the service nos N2,N3 & N4 for process
! SYNC2DEST} parameter passing described in Supervisor Note 1
! ASYNCDEST}
! MAXPROCS The maximum number of paged processes that the
! Supervisor is configured to run. Also the size
! of the Process array.
! INSPERSECS The number of instructions the OCP executes in 1
! second divided by 1000(Approx average for EMAS)
! ELAPHEAD The head of a linked list of param cells holding
! service with an elapsed interval interrupt request
! outstanding
! COMMSRECA The address of an area containing details of the
! Communication streams.(private to COMMS Control)
! STOREAAD The address of first element of the store record array
! bounds (0:SEPGS-1)
! PROCAAD The address of first element of the process record
! array bounds(0:MAXPROCS)
! SFCCTAB} The addresses of two private tables provided by grope
! DRUMTAD} for use by the routine DRUM. They give details of
! the SFCS and DRUMS found on the system
! TSLICE Time slice in microsecs. Supervisor has to allow for
! differences in interval timer speeds accross the range
! FEPS Bits 0-15 are a map of FEPs found at grope time.
! 2**16 bit set if FE0 found etc.
! Bits 16-31 are a map of currently available FEPs.
! 2**0 bit set if FE0 available etc.
! MAXCBT Maximum cbt entry
! PERFORMAD Address of record holding timing information and counts
! for performance analysis.
! IPDAPNO PORT & SMAC number for the DAP
! DAPBLKS The number of 128K blocks in DAP
! DAPUSER The PROCESS currently holding the DAP
! DAPSTATE The state of the DAP
! DAP1 DAP control fields
! DAPBMASK Bit map of currently allocated DAP blocks
! SP1->SP3 Spare locations
! LSTL}
! LSTB}
! PSTL}
! PSTB} These are the image store addresses for the following
! HKEYS} control registers:-
! HOOT} Local Segment Table Limit & Base
! SIM } Public Segment Table Limit & Base
! CLKX} Handkeys,Hooter System Interrupt Mask Register
! CLKY} and the clock X,Y & Z Registers
! CLKZ}
! HBIT A bit pattern that when ORed into Control Register
! "HOOT" operates the Hooter.(0=Hooterless machine)
! SLAVEOFF A bit pattern (top 16 bits) and Image store address
! in bottom 16 bits. ORing the top 16 bits(after
! shifting) into the image store will stop all slaving of
! operands but not instructions
! INHSSR A bit pattern and image location as for SLAVEOFF.
! ORing the bits into the location will switch off
! reporting of successful system retry
! SDR1}
! SDR2} The image store addresses of SMAC internal registers
! SDR3} needed by the Engineers after Smac errors have
! SDR4} occurred
! SESR}
! HOFFBIT A bit pattern that when ORed into a Smac Engineers
! status register will stop reporting of error
! from that Smac
!
! BLOCKZBIT A bit pattern indicating the position of
! the block zero bit in the SMAC config register.
!
! BLKSHIFT Indicates which way to shift the BLOCKZBIT mask
! to correspond with subsequent store blocks.
!
! BLKSIZE Store block size.
!
CONSTRECORD (COMF)NAME COM=X'80000000'+48<<18
CONSTINTEGER VIRTAD=X'81000000'; ! CAN NOT BE USED IF PAGE FLAWED
CONSTINTEGER PUBSEG=X'80000000',SEG64=X'01000000'
COM_MAXPROCS=MAXPROCS
CONSTINTEGER EPAGESHIFT=12; ! 4*1024==1<<12
CONSTINTEGER SEGEPSIZE=256//EPAGESIZE
!-----------------------------------------------------------------------
! MISC. ROUTINE SPECS
EXTERNALROUTINESPEC SLAVESONOFF(INTEGER ONOFF)
EXTERNALSTRING (15)FNSPEC STRINT(INTEGER N)
EXTERNALSTRING (8)FNSPEC STRHEX(INTEGER N)
EXTERNALSTRING (63)FNSPEC STRSP(INTEGER N)
EXTERNALROUTINESPEC PKMONREC(STRING (20)TEXT,RECORD (PARMF)NAME P)
EXTERNALROUTINESPEC MONITOR(STRING (63) S)
EXTERNALROUTINESPEC OPMESS(STRING (63) S)
EXTERNALROUTINESPEC DISPLAY TEXT(INTEGER SCREEN,LINE,CHAR, C
STRING (41) S)
EXTERNALROUTINESPEC UPDATE TIME
EXTERNALROUTINESPEC DPONPUTONQ(RECORD (PARMF)NAME P)
EXTERNALROUTINESPEC TURNONER(RECORD (PARMF)NAME P)
EXTERNALROUTINESPEC DUMP TABLE(INTEGER TABNO,ADR,LEN)
IF SFCFITTED=YES THEN START
ROUTINESPEC BAD DRUM PAGE(INTEGER DTX)
EXTERNALROUTINESPEC DRUM(RECORD (PARMF)NAME P)
INTEGER DRUMSIZE,DRUMTASL,DRUMT ASL BTM,DRUMALLOC
FINISH
IF CSU FITTED=YES START
EXTERNALROUTINESPEC CSU(RECORD (PARMF)NAME P)
FINISH
IF MULTIOCP=YES THEN START
INTEGERFNSPEC REMOTE ACTIVATE(INTEGER PORT,AD)
EXTERNALROUTINESPEC CHECK OTHER OCP
EXTERNALROUTINESPEC HALT OTHER OCP
EXTERNALROUTINESPEC RESTART OTHER OCP(INTEGER MODE)
EXTERNALROUTINESPEC CLOCK TO THIS OCP
IF SSERIES=YES START
EXTERNALROUTINESPEC DCU1 RECOVERY(INTEGER PARM)
FINISH
FINISH
IF MONLEVEL&4#0 START
LONGINTEGERNAME IDLEIT,NOWORKIT,LCIT,FLPIT,BLPIT,PTIT,DRUMIT, C
PDISCIT,RETIT,AMIT
LONGINTEGERNAME LCIC,PTIC,DRUMIC,PDISCIC,RETIC,AMIC
INTEGERNAME IDLEN,NOWORKN,LCN,FLPN,BLPN,PTCALLN,DRUMCALLN, C
PDISCCALLN,RETCALLN,AMCALLN
FINISH
HALFINTEGERNAME FSTASL,BSTASL
INTEGER I,J,K,FREEEPAGES,SHAREDEPS,UNALLOCEPS,OVERALLOC, C
MAXP4PAGES,P4PAGES,SXPAGES,
NPQ,OLDLNB,IDLE,DONT SCHED,SMAC RCONFIG,SMACRPAGES, C
MPLEVEL,PAGEFREES,DCLEARS,GETEPN,PREEMPTED, C
MAX OVERALLOC,SNOOZTIME,SAC MASK
LONGINTEGER L,STKPSTE
STRING (3) STRPROC
!-----------------------------------------------------------------------
! CONFIGURATION DECLARATIONS
BYTEINTEGERARRAYNAME CONTYPE
BYTEINTEGERARRAYFORMAT CONTYPEF(0:31)
CONTYPE==ARRAY(COM_CONTYPEA,CONTYPEF)
INTEGERARRAYNAME BLOCKAD
INTEGERARRAYFORMAT BLOCKADF(0:127); ! ALLOW UP TO 16 MEGABYTES
BLOCKAD==ARRAY(COM_BLKADDR,BLOCKADF)
!-----------------------------------------------------------------------
RECORDFORMAT SSNP1F(INTEGER LNB,PSR,PC,SSR,SF,IT,IC,CTB,XNB,C
B,DR0,DR1,A0,A1,A2,A3,PEAD,II)
RECORDFORMAT ISTF(INTEGER LNB,PSR,PC,SSR,SF,IT,IC,CTB)
RECORD (ISTF) LSSNP1I,LSSNP1,ISTDUM
RECORD (ISTF)NAME LSSNP1P
RECORD (ISTF) GSSNP1
CONSTLONGINTEGERARRAYNAME PST=PSTVA; ! PST SEG
INTEGERARRAYFORMAT PTF(0:255); ! PAGE TABLE FORMAT
!-----------------------------------------------------------------------
! STORE TABLE ETC. DECLARATIONS
RECORDFORMAT STOREF(BYTEINTEGER FLAGS,USERS, C
HALFINTEGER LINK,BLINK,FLINK,INTEGER REALAD)
CONSTRECORD (STOREF)ARRAYNAME STORE=STORE0AD;! ONE RECORD PER EPAGE
CONSTINTEGER OVERALLOC PERCENT=25
CONSTINTEGER STOREFSIZE=12; ! SIZE OF ELEMENT OF STORE ARRAY
CONSTINTEGERNAME STORESEMA=STORE0AD+8;! USE STORE(0)_REALAD AS SEMA
INTEGER SPSTOREX; ! FOR KEEPING EMERGENCY SPARE PAGE
!-----------------------------------------------------------------------
! ACTIVE MEMORY TABLE DECLARATIONS
CONSTINTEGER MIN RESIDENCES=3,MAXRESIDENCES=15;! FOR AMT TIMEOUTS
OWNINTEGER RESIDENCES=MAXRESIDENCES; ! ADJUSTED DOWN AS DRUM FILLS
CONSTINTEGER AMTASEG=21
CONSTINTEGER MAXAMTAK=MAXPROCS//2//EPAGESIZE*EPAGESIZE
RECORDFORMAT AMTF(INTEGER DA,HALFINTEGER DDP,USERS,LINK, C
BYTEINTEGER LEN,OUTS)
! DA : DISC ADDRESS
! DDP : AMTDD POINTER
! LINK : COLLISION LINK
! USERS : NO OF USERS OF THIS BLOCK
! LEN : BLOCK LENGTH IN EPAGES
! OUTS : NO OF PAGE-OUTS OF
! PAGES IN THIS BLOCK IN PROGRESS
CONSTINTEGER AMTFLEN=12
CONSTRECORD (AMTF)ARRAYNAME AMTA=X'80000000'! C
AMTASEG<<18+(MAXAMTAK<<2-AMTFLEN)
CONSTINTEGER AMTDDSEG=22
CONSTINTEGER MAXAMTDDK=MAXPROCS//EPAGESIZE*EPAGESIZE
CONSTINTEGER DDFLEN=2
CONSTHALFINTEGERARRAYNAME AMTDD=X'80000000'! C
AMTDDSEG<<18+(MAXAMTDDK<<2-DDFLEN)
! EACH %HALF : NEW EPAGE(1) /
! STOREX-DRUMTX(1) / INDEX(14)
CONSTINTEGER MAXBLOCK=32; ! MAX BLOCK SIZE
IF SFCFITTED=YES THEN START
DRUMSIZE=COM_SFCK//EPAGESIZE
HALFINTEGERARRAY DRUMT(0:DRUMSIZE)
! SPARE(2) / STOREX(14)
FINISH
CONSTINTEGER DTEND=X'FFFF'
CONSTINTEGER NEWEPBIT=X'8000'
CONSTINTEGER DTXBIT=X'4000'
CONSTINTEGER STXMASK=X'3FFF'
CONSTINTEGER DDBIT=X'8000'
!-----------------------------------------------------------------------
! SCHEDULING CATEGORY TABLES
RECORDFORMAT CATTABF(BYTEINTEGER PRIORITY,EPLIM,RTLIM,MOREP,MORET, C
LESSP,SP0,SUSP,RQTS1,RQTS2,STROBEI,SP2)
OWNINTEGER MAXCAT
MAXCAT=INTEGER(COM_CATTAD)
RECORD (CATTABF)ARRAYFORMAT CATTABAF(0:MAXCAT)
RECORD (CATTABF)ARRAYNAME CATTAB
CATTAB==ARRAY(COM_CATTAD+4,CATTABAF)
OWNINTEGER MAXEPAGES
MAXEPAGES=CATTAB(MAXCAT-1)_EPLIM
IF MONLEVEL&32#0 THEN START
HALFINTEGERARRAY FLYCAT,CATREC(0:MAXCAT,0:MAXCAT)
FINISH
IF MONLEVEL&16#0 THEN START
INTEGERARRAY STROBEN,STREPN,STROUT,SEQOUT(0:MAXCAT)
FINISH
!-----------------------------------------------------------------------
! PON & POFF ETC. DECLARATIONS
RECORDFORMAT SERVF(INTEGER P,L)
EXTERNALROUTINESPEC PON(RECORD (PARMF)NAME P)
EXTERNALROUTINESPEC DPON(RECORD (PARMF)NAME P,INTEGER DELAY)
EXTERNALINTEGERFNSPEC NEWPPCELL
EXTERNALROUTINESPEC RETURN PP CELL(INTEGER CELL)
EXTERNALROUTINESPEC FASTPON(INTEGER PPCELL)
IF MULTIOCP=YES THEN START
EXTERNALROUTINESPEC SEMALOOP(INTEGERNAME SEMA,INTEGER PARM)
EXTERNALROUTINESPEC RESERVE LOG
EXTERNALROUTINESPEC RELEASE LOG
FINISH
EXTERNALROUTINESPEC SUPPOFF(RECORD (SERVF)NAME SERV, C
RECORD (PARMF)NAME P)
EXTERNALROUTINESPEC INHIBIT(INTEGER SERVICE)
EXTERNALROUTINESPEC UNINHIBIT(INTEGER SERVICE)
EXTERNALROUTINESPEC PINH(INTEGER PROCESS,MASK)
EXTERNALROUTINESPEC PUNINH(INTEGER PROCESS,MASK)
EXTERNALROUTINESPEC CLEAR PARMS(INTEGER SERVICE)
EXTERNALINTEGERFNSPEC PPINIT(INTEGERFN NEW EPAGE)
INTEGERFNSPEC NEW EPAGE
RECORDFORMAT PARMXF(INTEGER DEST,SRCE,P1,P2,P3,P4,P5,P6,LINK)
CONSTRECORD (PARMXF)ARRAYNAME PARM=PARM0AD
CONSTINTEGER LOCSN1= LOCSN0+MAXPROCS
COM_SYNC1DEST=LOCSN1
CONSTINTEGER LOCSN2= LOCSN0+2*MAXPROCS
COM_SYNC2DEST=LOCSN2
CONSTINTEGER LOCSN3= LOCSN0+3*MAXPROCS
COM_ASYNCDEST=LOCSN3
CONSTRECORD (SERVF)ARRAYNAME SERVA=SERVAAD
EXTRINSICINTEGER KERNELQ,RUNQ1,RUNQ2,MAINQSEMA
OWNINTEGER SCHEDSEMA=-1
EXTERNALLONGINTEGER KMON
KMON=COM_KMON
!-----------------------------------------------------------------------
! SERVICE ROUTINE SPECS
ROUTINESPEC SCHEDULE(RECORD (PARMF)NAME P)
ROUTINESPEC PAGETURN(RECORD (PARMF)NAME P)
ROUTINESPEC GET EPAGE(RECORD (PARMF)NAME P)
INTEGERFNSPEC QUICK EPAGE(INTEGER ZEROED,SMACMASK)
ROUTINESPEC RETURN EPAGE(RECORD (PARMF)NAME P)
ROUTINESPEC DEADLOCK
ROUTINESPEC OVERALLOC CONTROL
ROUTINESPEC CONFIG CONTROL(RECORD (PARMF)NAME P)
ROUTINESPEC SHUTDOWN(RECORD (PARMF)NAME P)
ROUTINESPEC ACTIVE MEM(RECORD (PARMF)NAME P)
EXTERNALLONGINTEGERFNSPEC CLOCK
ROUTINESPEC UPDISP(INTEGER PROCESS,OFFSET,STRING (13) S)
EXTERNALROUTINESPEC ELAPSEDINT(RECORD (PARMF)NAME P)
EXTERNALROUTINESPEC SEMAPHORE(RECORD (PARMF)NAME P)
EXTERNALROUTINESPEC GDC(RECORD (PARMF)NAME P)
EXTERNALROUTINESPEC DISC(RECORD (PARMF)NAME P)
EXTERNALROUTINESPEC PDISC(RECORD (PARMF)NAME P)
EXTERNALROUTINESPEC BMOVE(RECORD (PARMF)NAME P)
EXTERNALROUTINESPEC TAPE(RECORD (PARMF)NAME P)
EXTERNALROUTINESPEC OPER(RECORD (PARMF)NAME P)
EXTERNALROUTINESPEC PRINTER(RECORD (PARMF)NAME P)
EXTERNALROUTINESPEC LP ADAPTOR(RECORD (PARMF)NAME P)
IF CRFITTED=YES START
EXTERNALROUTINESPEC CR ADAPTOR(RECORD (PARMF)NAME P)
FINISH
EXTERNALINTEGERFNSPEC SAFE IS READ(INTEGER ISAD,INTEGERNAME VAL)
EXTERNALINTEGERFNSPEC SAFE IS WRITE(INTEGER ISAD,VAL)
IF CPFITTED=YES THEN START
EXTERNALROUTINESPEC CP ADAPTOR(RECORD (PARMF)NAME P)
FINISH
IF DAP FITTED=YES THEN START
CONSTINTEGER MAXLDAP=2
ROUTINESPEC DAP DRIVER(RECORD (PARMF)NAME P)
FINISH
IF MONLEVEL&256#0 START
EXTERNALROUTINESPEC COMBINE(RECORD (PARMF)NAME P)
EXTERNALROUTINESPEC HARVEST( C
INTEGER EVENT, PROCESS, LEN, A, B, C, D, E)
EXTRINSICINTEGER TRACE EVENTS
EXTRINSICINTEGER TRACE PROCESS
EXTRINSICINTEGER TRACE
FINISH
EXTERNALROUTINESPEC COMMS CONTROL(RECORD (PARMF)NAME P)
EXTERNALROUTINESPEC MK1FEADAPTOR(RECORD (PARMF)NAME P)
EXTERNALROUTINESPEC COMREP(RECORD (PARMF)NAME P)
EXTERNALROUTINESPEC BMREP(RECORD (PARMF)NAME P)
EXTERNALROUTINESPEC SYSERR(INTEGER STK,IP)
!-----------------------------------------------------------------------
! TIMING INFORMATION DECS.
IF MONLEVEL&X'3C'#0 THEN START
ROUTINESPEC TIMEOUT
ROUTINESPEC CLEAR TIME
FINISH
IF MONLEVEL&4#0 THEN START
RECORDFORMAT PERFORMF(INTEGER RECAPN,PTURNN,PSHAREN,NEWPAGEN,
PAGEOUTN,PAGEZN,SNOOZN,ABORTN,SNOOZOK,SNOOZTO,SNOOZAB,
LONGINTEGER CLOCK0,
LONGINTEGERARRAY SERVIT,SERVIC(0:LOCSN0+3),
INTEGERARRAY SERVN(0:LOCSN0+3))
RECORD (PERFORMF) PERFORM
COM_PERFORMAD=ADDR(PERFORM)
IDLEIT==PERFORM_SERVIT(0)
NOWORKIT==PERFORM_SERVIT(1)
PTIT==PERFORM_SERVIT(4)
RETIT==PERFORM_SERVIT(6)
AMIT==PERFORM_SERVIT(8)
PDISCIT==PERFORM_SERVIT(33)
DRUMIT==PERFORM_SERVIT(40)
LCIT==PERFORM_SERVIT(LOCSN0+1)
FLPIT==PERFORM_SERVIT(LOCSN0+2)
BLPIT==PERFORM_SERVIT(LOCSN0+3)
!
PTIC==PERFORM_SERVIC(4)
RETIC==PERFORM_SERVIC(6)
AMIC==PERFORM_SERVIC(8)
PDISCIC==PERFORM_SERVIC(33)
DRUMIC==PERFORM_SERVIC(40)
LCIC==PERFORM_SERVIC(LOCSN0+1)
!
IDLEN==PERFORM_SERVN(0)
NOWORKN==PERFORM_SERVN(1)
PTCALLN==PERFORM_SERVN(4)
RETCALLN==PERFORM_SERVN(6)
AMCALLN==PERFORM_SERVN(8)
PDISCCALLN==PERFORM_SERVN(33)
DRUMCALLN==PERFORM_SERVN(40)
LCN==PERFORM_SERVN(LOCSN0+1)
FLPN==PERFORM_SERVN(LOCSN0+2)
BLPN==PERFORM_SERVN(LOCSN0+3)
FINISH
!-----------------------------------------------------------------------
! PROCESS INORMATION ETC.
RECORDFORMAT PROCF(STRING (6) USER, C
BYTEINTEGER INCAR, CATEGORY, P4TOP4, RUNQ, ACTIVE, C
INTEGER ACTW0, LSTAD, BYTEINTEGER EPA,EPN,HALFINTEGER LAMTX,C
INTEGER STACK, STATUS)
RECORD (PROCF)ARRAY PROCA(0:MAXPROCS)
! 2**0 = HOLDS A SEMAPHORE
! 2**1 = ON A PAGE FAULT
! 2**2 = A BACKGROUND JOB
! 2**3 = DEALLOCATING AMT (&DRUM) ONLY
! 2**4 = AMT LOST
! 2**5 = HAD TIME ON FLY
! 2**6 = HAD EPAGES ON FLY
! 2**7 = SNOOZING
! 2**8 = LC STACK READ FAILURE
! 2**9 = STATE X(LC STK SNOOZED)
! 2**10 HAS PIECE OF DAP
! REMAINDER UNUSED
! DUMP PROGRAM NEED TO HAVE
! DETAILS OF ANY CHANGES !
CONSTINTEGER HADTONFLY=32,HADPONFLY=64,SNOOZED=128
CONSTINTEGER LCSTFAIL=256,AMTLOST=16,STATEX=512
CONSTINTEGER FIRST UPROC=6
CONSTINTEGER OPERSPACE=41*(6+MAXPROCS//3)
INTEGERARRAY PROC PICT(0:2+OPERSPACE>>2);! SPACE FOR PROCESS PICTURE
PROC PICT(0)=OPERSPACE; ! FIRST WORD=LENGTH OF REM
!-----------------------------------------------------------------------
! LOCAL CONTROLLER DECS ETC.
ROUTINESPEC LOCAL CONTROL
ROUTINESPEC GLOBAL CONTROL
OWNLONGINTEGERARRAYFORMAT LSTF(0:LSTLEN-1)
OWNINTEGER TIMESLICE=X'4000'; ! 131072 MICROSECS
OWNINTEGER OUT18CHARGE=X'800'; ! CHARGE FOR OUT116 =8 MILLESECS
OWNINTEGER OUT18INS; ! CHARGE *INS RATE
OWNINTEGER ALLOW PERI INTS=X'01803FFE';! CHANGED IN SCHEDULE ACT0
EXTERNALINTEGERFNSPEC SYSTEMCALL
!-----------------------------------------------------------------------
I=SYSTEM CALL; ! TO INITIALISE "COM" FILE
*STLN_OLDLNB
!
! CREATE LOCAL CONTROLLER CONTEXT
!
LSSNP1I=0
LSSNP1I_LNB=LSTLEN*8+LSTKN*X'80'+(DIRCSEGL+1)+X'50'
LSSNP1I_PSR=X'00140001'
*JLK_<LCCALL>
*LSS_TOS
*ST_I
LSSNP1I_PC=I; ! TO CALL OF L-C AFTER ACTIVATE
LSSNP1I_SSR=X'01803BFE'
LSSNP1I_SF=LSTLEN*8+LSTKN*X'80'+(DIRCSEGL+1)+X'80'
! SF AT 12 WORDS AFTER LNB
LSSNP1I_IT=MAXIT
LSSNP1I_IC=MAXIT
*LSS_(LNB +5); ! PRESERVE DISPLAY PTR
*ST_I
LSSNP1I_CTB=I
COM_DCODEDA=COM_SUPLVN<<24!COM_DIRSITE
!
! SET UP CLOCK REGS
!
I=COM_CLKZ
*LB_I
*LSS_13; ! INTERRUPT EVERY 2 SECS(APPROX)
*ST_(0+B ); ! Z-REG
IF COM_TSLICE>0 THEN TIMESLICE=COM_TSLICE//COM_ITINT
OUT18CHARGE=TIMESLICE>>3; ! ONE EIGHTH OF TSLICE
OUT18INS=OUT18CHARGE*COM_INSPERSEC*COM_ITINT//1000
!
! FIND END OF KERNEL STACK ETC.
!
PST(44)=0; PST(45)=0; ! CLEAR CHOPSUPE CODE GLA
PST(46)=0; PST(47)=0; ! & STACK SEGMENTS FROM PST
PST(13)=PST(5)-128; ! SSN FOR OCP PORT 2
PST(15)=PST(5)+128; ! SSN FOR OCP PORT 3
FSTASL==STORE(0)_FLINK
BSTASL==STORE(0)_BLINK
! SET KERNEL STACK SEGMENT LIMIT
! INCLUDING PROTEM 8 K FOR EACH OCP
! STACK. THESE WILL BE REMOVED
! ONCE THE OCPS ARE ACTIVATED
I=PST(4)&X'0FFFFFF8'; ! REALAD OF STACK
K=PST(4)>>32&X'3FF80'+128+I; ! REALAD OF MAX TOS
*STSF_J
L=(J&X'3FFFF'+X'7F'+X'2000')>>7
IF MULTIOCP=YES THEN L=L+X'2000'>>7
PST(4)=PST(4)&X'FFFC007FFFFFFFFF'!(L-1)<<39
STKPSTE=PST(4)-X'200000000000'
IF MULTIOCP=YES THEN STKPSTE=STKPSTE-X'200000000000'
J=EPAGESIZE<<10; ! ADD UNUSED KERNEL STACK TO FREE LIST
K=K//J-1
J=(I+L<<7+J-1)//J
STORESEMA=-1
SPSTOREX=0
GETEPN=0
PREEMPTED=0; ! NO PROCESS PRE-EMPTED
DONT SCHED=0
SMAC RCONFIG=0
SMAC RPAGES=0
IF SSERIES=NO START ; ! mask for configured in SACs
SAC MASK=1<<COM_SACPORT0
IF COM_NSACS>1 THEN SAC MASK=SAC MASK!(1<<COM_SACPORT1)
FINISH
FREE EPAGES=STORE(0)_LINK; ! LEFT HERE BY CHOPSUPE
BEGIN
RECORD (PARMF)P
CYCLE I=J,1,K
STORE(I)_FLAGS=0; ! NOT RECAPTURABLE
P_DEST=X'60001'
P_P2=I
RETURN EPAGE(P)
REPEAT
END
!-----------------------------------------------------------------------
COM_PROCAAD=ADDR(PROCA(0))
CYCLE I=0,1,MAXPROCS
PROCA(I)=0
REPEAT
IF SFC FITTED=YES THEN COM_DRUMTAD=ADDR(DRUMT(0))
I=PPINIT(NEW EPAGE)
OVERALLOC=OVERALLOC PERCENT*FREE EPAGES//100;! 25% OVERALLOCATION
MAX OVERALLOC=OVERALLOC
SHAREDEPS=0
UNALLOCEPS=FREEEPAGES+OVERALLOC
P4PAGES=0
SXPAGES=0
MAXP4PAGES=P4PERCENT*COM_SEPGS//100
NPQ=0
IDLE=0
IF SNOOZING=YES THEN SNOOZTIME=20
BEGIN
RECORD (PARMF) P
!-----------------------------------------------------------------------
! INITIALISE GPC, DRUM & DISC ROUTINES
P_DEST=X'300002'
IF SSERIES=NO THEN START ; ! ON P SERIES
P_P1=COM_GPCA
FINISH ELSE START ; ! ON S SERIES
P_P1=COM_DCUA
FINISH
P_P2=ADDR(PROC PICT(0)); ! SPACE FOR OPER PICTURE
PON(P)
P_DEST=X'370000'
P_P1=EPAGESIZE
P_P2=COMMS EPAGES; ! COMMSALLOC
P_P3=ADDR(PARM(0))
PON(P)
IF SSERIES=NO THEN START ; ! PSERIES INITIALISE DISC
P_DEST=X'200000'
PON(P)
FINISH
IF SFC FITTED=YES AND DRUMSIZE>0 THEN START
P_DEST=X'280000'
P_P1=EPAGESIZE
P_P2=COM_SFCA
P_P3=ADDR(STORE(0))
P_P4=ADDR(PARM(0))
PON(P)
FINISH
! INITIALISE SCHEDULE & ACTIVEMEM
INHIBIT(3); ! HOLD PON FOR DISC LABEL READS
P_DEST=X'30000'
PON(P); ! PONNED TO ALLOW DISC LABEL READING
!
! CLEAR TIMING ARRAY ETC.
!
IF MONLEVEL&4#0 THEN CLEAR TIME
P_DEST=X'A0001'
P_SRCE=0
P_P1=X'B0000'
P_P2=2
PON(P); ! KICK UPDATE TIME
P_P1=X'360000'
PON(P); ! KICK PRINTER
P_P1=X'E0004'
P_P2=10
PON(P); ! ACTIVE MEM
P_P1=X'70004'
PON(P); ! SEMAPHORE EVERY 10 SECS
P_P1=X'D0001'
PON(P); ! KICK ERROR REPORTING
P_P1=X'00100000'
P_P2=600
PON(P); ! KICK OVERALLOC CNTRL EVERY 10 MIN
IF STRING(ADDR(COM_SUPVSN))<CHOPID THEN C
OPMESS("WRONG CHOPSUPE")
STRING(ADDR(COM_SUPVSN))=SUPID
IF MULTIOCP=YES AND COM_NOCPS>1 START
P_DEST=X'110001'; P_P1=1<<16!COM_OCPPORT1
COM_NOCPS=1
PON(P); ! CONFIGURE IN 2ND OCP LATER
FINISH ELSE COM_NOCPS=1
END
!
! NOW ACTIVATE THIS OCP INTO GLOBAL CONTROLLER. ALSO REMOTE ACTIVATE
! OTHER OCP IF PRESENT. STACKS ARE PUBLIC 12 FOR PORT 2 AND 14 FOR PORT 3
!
IF SSERIES=YES THEN I=2*COM_OCPPORT0+12 ELSE C
I=2*COM_OCPPORT0+8; ! PST no. for local activate
K=I!!2; ! AND FOR REMOTE ACTIVATE
GSSNP1=LSSNP1I
*JLK_<GCCALL>
*LSS_TOS ; *ST_J
GSSNP1_PC=J
GSSNP1_LNB=X'80000004'+I<<18
GSSNP1_SF=GSSNP1_LNB+X'20'
GSSNP1_SSR=X'01803FFE'
RECORD(X'80000000'+(I+1)<<18)<-GSSNP1; ! context from record to SSN+1
*STSF_J
PST(I)=PST(4)&X'1FF000008FFFFF80'+X'1F8000000000'+ C
(J+128)&X'3FF80'
IF MULTIOCP=YES THEN PST(K)=PST(I)+X'2000'
*LSD_0; *SLSS_I; *USH_18; *OR_X'80000000'
*LUH_0; *ST_TOS ; *ACT_TOS
GCCALL:
*JLK_TOS
*STCT_(LNB +5)
*LSD_(CTB +3); *ST_(LNB +3); ! COPY ACROSS PLT DESCR
GLOBAL CONTROL; ! DOES NOT RETURN
!-----------------------------------------------------------------------
LCCALL:*JLK_TOS
*STCT_(LNB +5); ! DISPLAY PTR TO NEW STACK
! SO THAT THE LXN IN CALL SEQUENCE
! LINKS LOCAL TO GLOBAL CONTEXTS
*STB_(LNB +0); ! B HAS PROCESS NO IN IT PUTIN
! BY SCHEDULE AT CREATE
! AND IS PASSED ON BY THIS FRIG
*LSD_(CTB +3); *ST_(LNB +3); ! COPY ACROSS PLT DESCR
LOCAL CONTROL; ! INITIAL CALL(DOES NOT RETURN!)
ROUTINE GLOBAL CONTROL
!%ROUTINESPEC UNQUEUE(%INTEGERNAME QUEUE,UNQUED SERVICE)
INTEGER I,J,K,PORT,SEIP,SELN,SESTK,KSERVICE,LSERVICE,TSERVICE, C
MY OCP PORT,HIS OCP PORT,IS DIAG,ISTAD
LONGINTEGER WORK
IF MONLEVEL&4#0 THEN START
INTEGER IT,IC,IT CORRN
INTEGERNAME KIT; ! IT IN KERNEL CONTEXT
CONSTINTEGER IC CORRN=20; ! INSTRNS NOT COUNTED IN IDLE
FINISH
IF MULTI OCP=YES START
INTEGERNAME MY ALARM,HIS ALARM
CONSTINTEGER MAX ALARM=1024
! control words to catch other OCP going to sleep
FINISH
INTEGERNAME CURPROC; ! CURRENT PROCESS KEPT IN IST
! (LAST WRD) FOR DUMPS ETC
SWITCH CONROUT(0:3)
SWITCH SERVROUT(0:LOCSN0); ! KERNEL SERVICES
RECORD (PROCF)NAME PROC; ! STATUS BITS SIGNIFY AS FOLLOWS
RECORD (SERVF)NAME KSERV,LSERV,LSERVQ
RECORD (ISTF)NAME ISTP
RECORD (CDRF)NAME LDAP
INTEGERNAME RUNQ
RECORD (PARMF) P
!
! FIND WHICH OCP THIS ACTIVATION IS USING AND SET RELEVANT IST
!
*LSS_(3); *USH_-26
*AND_3; *ST_ MY OCP PORT
IF MULTI OCP=YES THEN HIS OCP PORT=MY OCP PORT!!1
PST(4)=STKPSTE; ! SHORTEN OLD STACK
*LSS_OLDLNB; *ST_(LNB +0); ! FOR %MONITOR
ISTAD=X'80000000'+MY OCP PORT<<18
ISTP==RECORD(ISTAD); ! IST BASE
*STLN_I; ! USED TO FRIG %MONITOR LATER
ISTP_LNB=I
ISTP_PSR=X'00140001'; ! ACR=1, PRIV=1, PM=0, ACS=1
ISTP_PC=0
ISTP_SSR=X'01803FFE'; ! ONLY SYSERR
*STSF_I
ISTP_SF=I
ISTP_IT=MAXIT
ISTP_IC=MAXIT
ISTP_CTB=0
RECORD(ISTAD+X'20')<-ISTP; ! EXTERNAL INTS
RECORD(ISTAD+X'40')<-ISTP; ! M-P INTS
RECORD(ISTAD+X'60')<-ISTP; ! PERIPHERAL INTS
RECORD(ISTAD+X'120')<-ISTP; ! EXTRACODE(!) INTS
RECORD(ISTAD+X'140')<-ISTP; ! EVEBT PENDING INTS
RECORD(ISTAD+X'180')<-ISTP; ! Primitive ints.
RECORD(ISTAD+X'1A0')<-ISTP; ! Unit ints.
LSSNP1P==RECORD(X'40000')
!
! MASK SYSERR& UNMASK OUT ON SYSERR. INTERRUPT
!
ISTP_SSR=X'01803EFF'
ISTP_SF=ISTP_SF+X'1000'; ! SET SYSTEM ERROR SF TO DISTANT PLACE
!
! INSERT PCS
!
*LXN_ISTAD
*JLK_<IST1I>; *LSS_TOS ; *ST_(XNB +2)
*JLK_<IST2I>; *LSS_TOS ; *ST_(XNB +10)
*JLK_<IST3I>; *LSS_TOS ; *ST_(XNB +18)
*JLK_<IST4I>; *LSS_TOS ; *ST_(XNB +26)
*JLK_<IST10I>; *LSS_TOS ; *ST_(XNB +74)
*JLK_<IST11I>; *LSS_TOS ; *ST_(XNB +82)
*JLK_<IST13I>; *LSS_TOS ; *ST_(XNB +98)
*JLK_<IST14I>; *LSS_TOS ; *ST_(XNB +106)
IF MULTI OCP=YES START
MY ALARM==INTEGER(ISTAD+4*94); ! uses IC field for IC int
HIS ALARM==INTEGER(ISTAD!!1<<18+4*94)
FINISH
CURPROC==INTEGER(ISTAD+4*95); ! onto CTB field for IC int
CURPROC=0
KSERVICE=0
KSERV==SERVA(0)
LSERV==KSERV; ! INITIALISE POINTERS. HERE AFTER
! ADDRESS FIELD ONLY UPDATE
! IN ASSEMBLER SEQUENCES
IF MONLEVEL&4#0 START
IT CORRN=1+1024*IC CORRN//(COM_INSPERSEC*COM_ITINT)
KIT==INTEGER(ISTP_SF&X'FFFC0000'+X'40014')
FINISH
IF MULTIOCP=YES AND COM_NOCPS>1 THEN START
! OPEN PATHS FOR MP INT ETC
! SET PORT DEPENDENT PHOTO(P4S)
IF SSERIES=NO START
IF BASIC PTYPE<=3 START
*LSS_1; *ST_(X'6009'); ! BROADCAST SE
*LSS_(X'600A')
*AND_X'CC'; *ST_(X'600A'); ! PERMIT MP INTS & ACTIVATES
*ST_IS DIAG
FINISH ELSE START
*LSS_(X'4012'); *OR_X'300C'; *ST_(X'4012');! PERMIT MPINTS
! AND SE INTS FROM OCP PORTS
*LSS_(X'4013'); *OR_X'8004'; *ST_(X'4013')
*ST_IS DIAG
FINISH
FINISH
IF MY OCP PORT#COM_OCPPORT0 START ;! IM NOT IPL PROCESSOR
IF SSERIES=YES START
J=COM_OCP0 SCU PORT
*LSS_J; *ST_(X'600F')
*LB_X'602B'; *LSS_0; *ST_(0+B ); ! unset selective masks
*LB_X'6011'; *LSS_(0+B ); *AND_X'FFFD'; *OR_1; *ST_(0+B ); ! miniphotos only
J=X'400C0000'!COM_OCP0 SCU PORT<<22
! set up UTBR
I=J!X'6004'; *LB_I; *LSS_(0+B ); *LB_X'6004'; *ST_(0+B )
I=J!X'6005'; *LB_I; *LSS_(0+B ); *LB_X'6005'; *ST_(0+B )
! set up MIB
UNLESS COM_MIBA=0 START
I=COM_MIBA+MY OCP PORT<<12
*LB_X'601A'; *LSS_I; *ST_(0+B )
FINISH
! set up cross reporting of errors
I=COM_OCP0 SCU PORT<<22
*LB_X'601D'; *LSS_I; *ST_(0+B )
I=J!X'601D'; J=COM_OCP1 SCU PORT<<22
*LB_I; *LSS_J; *ST_(0+B )
FINISH ELSE IF BASIC PTYPE<=3 START
J=X'80'>>COM_SACPORT0
IF COM_NSACS>1 THEN J=J!X'80'>>COM_SACPORT1
J=J!!(-1)
*LSS_(X'600A'); *AND_J; *ST_(X'600A')
! CLOSE OFF SAC INTS TO THIS OCP
IF BASIC PTYPE=2 START
*LSS_X'00011001'; *ST_(X'6011')
! INHIBIT PHOTO ON SOFT SYSTEM ERROR
FINISH
J=COM_OCPPORT0
*LSS_J; *ST_(X'600F');! OPEN ROUTE FOR RRTC
*ST_IS DIAG
FINISH ELSE START
IF COM_OCPTYPE=4 THEN J=COM_SACPORT0 ELSE C
J=COM_OCPPORT0
J=J<<20
*LSS_(X'4013'); *OR_J; *ST_(X'4013')
*ST_IS DIAG
*LSS_(X'4012'); *AND_X'FFFF3FCF'
*ST_(X'4012'); ! INHIBIT SAC INTERRUPTS
FINISH
FINISH
FINISH
!-----------------------------------------------------------------------
! TURN ON SLAVING WHICH HAS BEEN INHIBITED BY CHOPSUPE
SLAVESONOFF(-1)
!-----------------------------------------------------------------------
! SERVICE LOOPS
KSERVE: ! KERNEL SERVICES
IF MONLEVEL&4#0 THEN START
*LSS_X'FFFFFF'; ! SET IT & IC TO MAX.
*ST_(5)
*ST_(6)
FINISH
*LSS_ALLOW PERI INTS; ! LET INTERRUPTS IN
*ST_(3)
*LSS_X'01803FFE'
*ST_(3)
IF MULTIOCP=YES THEN START
*INCT_(MAINQSEMA)
*JCC_8,<MQGOT1>
SEMALOOP(MAINQSEMA,0)
MQGOT1:
FINISH
KSKIP: ! TRY NEXT WITHOUT RECLAIMING SEMA
IF KSERVICE!KERNELQ=0 THEN START
IF CURPROC#0 THEN START
! PROC MAPPED AT LAST LSERVE
IF RUNQ1#0 AND PREEMPTED=0 AND PROC_RUNQ=2 START
PREEMPTED=CURPROC
! RUNQ==RUNQ1
*LD_RUNQ1
*J_<LSERVE>; ! PREMPTED LOWPRIO FOR HIGHPRIO
FINISH
KACT: ! ACTIVATE DIRECT KERNEL->USER
IF MULTIOCP=YES START ; *TDEC_(MAINQSEMA); FINISH
IF MONLEVEL&4#0 THEN START
IF PROC_STATUS&4#0 THEN BLPN=BLPN+1 ELSE FLPN=FLPN+1
FINISH
*LXN_PROC+4
*ACT_(XNB +3); ! REACTIVATE INTERRUPTED PROCESS
FINISH
! %IF RUNQ1#0 %THEN RUNQ==RUNQ1 %AND ->LSERVE
*LSS_(RUNQ1); *JAF_4,<LSERVE>
IF PREEMPTED#0 START ; ! RESUME PREMPTED PROCESS
CURPROC=PREEMPTED
LSERVICE=CURPROC+LOCSN0
LSERV==SERVA(LSERVICE)
PREEMPTED=0
PROC==PROCA(CURPROC)
->KACT
FINISH
! %IF RUNQ2#0 %THEN RUNQ==RUNQ2 %AND ->LSERVE
*LSS_(RUNQ2); *JAF_4,<LSERVE>
!
! NO PROCESS NEEDS OCP. ENTER AND TIME THE IDLE LOOP
! WHICH IS DIFFERENT FOR MULTI OCPS WHERE OTHER OCP CAN GENERATE WORK
!
IF MULTIOCP=YES START ; *TDEC_(MAINQSEMA); FINISH
IF MONLEVEL&4#0 THEN START
IF MPLEVEL+NPQ<COM_NOCPS THEN NOWORKN=NOWORKN+1 ELSE C
IDLEN=IDLEN+1
IDLE=1
FINISH
*LSS_X'01800820'; ! ALL EXCEPT TIMER INTERRUPTS
*ST_(3)
IF MULTIOCP=NO THEN START
IDLE0: *IDLE_0
->IDLE0; ! IN CASE "EKS" SET
FINISH ELSE START ; ! IDLE IN DUALS
IF SSERIES=NO AND MY OCP PORT#COM_OCPPORT0 START
!
! for S series DCU2 interrupts are reported to the
! activating OCP & DCU1 ints. to the IPL (or S/W nominated) OCP
! so trying to grab outstanding ints. will not work!
!
PORT=COM_SACPORT0
*LSS_X'01803FFE'; *ST_(3)
J=X'44000000'!PORT<<20
*LB_J; *LSS_(0+B ); *ST_I
*JAF_4,<PROCESS INT>
IF COM_NSACS>1 START
PORT=COM_SACPORT1
J=X'44000000'!PORT<<20
*LB_J; *LSS_(0+B ); *ST_I
*JAF_4,<PROCESS INT>
FINISH
*LSS_X'01800820'; *ST_(3)
FINISH
*RRTC_0; *AND_1023;
*STUH_B ; *ST_B ; *ADB_2; ! RANDOM LOOP TIME
IL0: *LSS_1
*IAD_1
*DEBJ_<IL0>
IF MONLEVEL&4#0 START
*LSS_(5)
*IRSB_MAXIT
*IAD_IT CORRN; ! CORRECT FOR THESE INSTRNS
*ST_I
IF MPLEVEL+NPQ<COM_NOCPS THEN NOWORKIT=NOWORKIT+I C
ELSE IDLEIT=IDLEIT+I
IDLE=0
FINISH
->KSERVE
FINISH
FINISH
!
! MAIN QUEUE SERVICING SECTION
!
IF KSERVICE=0 THEN START
! UNQUEUE(KERNELQ,KSERVICE)
! KSERV==SERVA(KSERVICE)
*LD_KERNELQ; *JLK_<JLUNQ>
*STB_KSERVICE
*STXN_KSERV+4; ! COPY MAPPING FROM JLK SUBROUTINE
FINISH
I=KSERV_P&X'BFFFFFFF'; ! REMOVE EXECUTED BIT
IF I<=0 THEN KSERV_P=I AND KSERVICE=0 AND ->KSKIP
IF KSERVICE>LOCSN1 START ; ! SUSPEND REPLY
I=(KSERVICE-LOCSN0)&(MAXPROCS-1)+LOCSN1
SERVA(I)_P=SERVA(I)_P!X'80000000'
I=I+(LOCSN2-LOCSN1)
SERVA(I)_P=SERVA(I)_P!X'80000000'
I=I+(LOCSN3-LOCSN2)
SERVA(I)_P=SERVA(I)_P!X'80000000'
IF MULTIOCP=YES START ; *TDEC_(MAINQSEMA); FINISH
P_DEST=X'30007'; ! RESCHEDULE LOCAL CONTROLLER
P_SRCE=0
P_P1=I-LOCSN3
SCHEDULE(P)
TSERVICE=3
->KTIMES
FINISH
IF MULTIOCP=YES START ; *TDEC_(MAINQSEMA); FINISH
SUPPOFF(KSERV,P)
->SERVROUT(KSERVICE)
!-----------------------------------------------------------------------
! SERVICE ROUTINE CALLS
SERVROUT(1):
SNOOZTIME=P_P1; ->KEXIT
SERVROUT(2):
DEADLOCK; ->KEXIT
SERVROUT(3):
SERVROUT(15):
SCHEDULE(P); ->KEXIT
SERVROUT(4):
PAGETURN(P); ->KEXIT
SERVROUT(5):
GET EPAGE(P); ->KEXIT
SERVROUT(6):
RETURN EPAGE(P); ->KEXIT
SERVROUT(7):
SEMAPHORE(P); ->KEXIT
SERVROUT(8):
SERVROUT(14):
ACTIVE MEM(P); ->KEXIT
SERVROUT(9): ! ONLY FOR MONITORING
IF MONLEVEL&X'3C'#0 THEN TIMEOUT; ->KEXIT
SERVROUT(10):
ELAPSEDINT(P); ->KEXIT
SERVROUT(11):
UPDATE TIME; ->KEXIT
SERVROUT(12):
DPONPUTONQ(P); ->KEXIT
SERVROUT(13):
TURNONER(P); ->KEXIT
SERVROUT(16):
OVERALLOC CONTROL; ->KEXIT
SERVROUT(17):
CONFIG CONTROL(P); ->KEXIT
SERVROUT(18):
SHUTDOWN(P); ->KEXIT
SERVROUT(19):
IF MULTI OCP=YES AND COM_NOCPS>1 THEN CHECK OTHER OCP AND ->KEXIT
->INVALID
SERVROUT(20):SERVROUT(21):
SERVROUT(22):SERVROUT(23):SERVROUT(24):SERVROUT(25):SERVROUT(26):
SERVROUT(27):SERVROUT(28):SERVROUT(29):SERVROUT(30):
->INVALID
SERVROUT(31):
IF DAP FITTED=YES THEN DAP DRIVER(P) AND ->KEXIT
->INVALID
SERVROUT(32):
DISC(P)
->KEXIT
SERVROUT(33):
PDISC(P); ->KEXIT
SERVROUT(34):SERVROUT(35):
->INVALID
SERVROUT(36):SERVROUT(37):
BMOVE(P); ->KEXIT
SERVROUT(38):SERVROUT(39):
->INVALID
SERVROUT(40):
IF SFC FITTED=YES THEN DRUM(P) AND ->KEXIT ELSE ->INVALID
SERVROUT(41):
IF CSU FITTED=YES THEN CSU(P) AND ->KEXIT ELSE ->INVALID
SERVROUT(42):SERVROUT(43):SERVROUT(44):SERVROUT(45):SERVROUT(46):
SERVROUT(47):->INVALID
SERVROUT(48):
GDC(P); ->KEXIT
SERVROUT(49):
TAPE(P); ->KEXIT
SERVROUT(50):
OPER(P); ->KEXIT
SERVROUT(51):
LP ADAPTOR(P); ->KEXIT
SERVROUT(52):
IF CRFITTED=YES THEN CR ADAPTOR(P) AND ->KEXIT ELSE ->INVALID
SERVROUT(53):
IF CPFITTED=YES THEN CP ADAPTOR(P) AND ->KEXIT ELSE ->INVALID
SERVROUT(54):
PRINTER(P); ->KEXIT
SERVROUT(55):
COMMS CONTROL(P); ->KEXIT
SERVROUT(56):
IF MONLEVEL&256#0 THEN COMBINE(P) AND ->KEXIT ELSE -> INVALID
SERVROUT(57):
MK1FEADAPTOR(P); ->KEXIT
SERVROUT(58):SERVROUT(59):SERVROUT(60):->INVALID
SERVROUT(61):
BMREP(P); ->KEXIT
SERVROUT(62):
COMREP(P); ->KEXIT
SERVROUT(63): ! DELAYED RELAY
I=P_DEST&X'FFFF'; ! THE DELAY
P_DEST=P_P6
DPON(P,I)
->KEXIT
SERVROUT(64):SERVROUT(0):
->INVALID
!-----------------------------------------------------------------------
KEXIT:
IF MONLEVEL&4#0 THEN TSERVICE=KSERVICE
KTIMES: ! RECORD SERVICE ROUTINE TIMES
IF MONLEVEL&4#0 THEN START
*LSS_(6); *IRSB_MAXIT; *IAD_IC CORRN; *ST_IC
*LSS_(5); *IRSB_MAXIT; *IAD_IT CORRN; *ST_IT
PERFORM_SERVIT(TSERVICE)=IT+PERFORM_SERVIT(TSERVICE)
PERFORM_SERVIC(TSERVICE)=IC+PERFORM_SERVIC(TSERVICE)
PERFORM_SERVN(TSERVICE)=PERFORM_SERVN(TSERVICE)+1
FINISH
->KSERVE
!-----------------------------------------------------------------------
LINVALID: ! LOCAL CNTRL NOT RESIDENT
CURPROC=0
SUPPOFF(LSERV,P)
LSERV_P=LSERV_P&X'BFFFFFFF'; ! REMOVE EXECUTING BIT
IF MULTI OCP=YES START ; *TDEC_(MAINQSEMA); FINISH
! AND DROP THRO FOR MSG
INVALID: ! INVALID SERVICE CALLED
PKMONREC("INVALID POFF:",P)
->KSERVE
!-----------------------------------------------------------------------
LSERVE: ! LOCAL CONTROLLER SERVICES
*STD_RUNQ; ! COMPLETE MAPPING OF RUNQ
! UNQUEUE(RUNQ,LSERVICE)
! LSERV==SERVA(LSERVICE)
*JLK_<JLUNQ>; *STB_LSERVICE
*STXN_LSERV+4; ! COPY MAPPING FROM JLK SUBROUTINE
! THIS IS USED ON L-C EXIT
!
! L-C IS ONLY INHIBITIED BEFORE PROCESS START AND AFTER STOPPING
! SO THE LOGICALLY NECESSARY TEST FOR INHIBITION CAN BE OMITTED
! UNLESS CODEING ELSEWHERE IS CHANGED. CODE LEFT AS COMMENT AS
! A REMINDER
!
! I=LSERV_P&X'BFFFFFFF'; ! WITHOUT "EXECUTING" BIT
! %IF I<=0 %THEN LSERV_P=I %AND ->KSKIP;! INHIBITED
! CURPROC=LSERVICE-LOCSN0
*SBB_LOCSN0; *STB_(CURPROC)
PROC==PROCA(CURPROC)
IF PROC_ACTIVE#255 THEN ->LINVALID
IF MULTI OCP=YES START
*TDEC_(MAINQSEMA)
IF COM_NOCPS>1 START ; ! other OCP sleep check
HIS ALARM=HIS ALARM+1
IF HIS ALARM>MAX ALARM THEN CHECK OTHER OCP AND HIS ALARM=0
MY ALARM=0
FINISH
FINISH
!
! TO ACTIVATE TO LOCAL CONTROLLER USE THE ACTIVATE WORDS IN THE PROCESS
! LIST BUT SUBSTITUTE LC STACK NO(0) FOR PROCESS STACK NO
!
*LXN_PROC+4
*LSD_(XNB +3)
*SLSD_0; ! LC STACK NO NOT PARAMETERISED !
*ST_TOS
IF MONLEVEL&4#0 THEN START
LCN=LCN+1
*LSS_(6); *IRSB_MAXIT; *LUH_0; *IAD_(LCIC); *ST_(LCIC)
*LSS_(5); *IRSB_MAXIT; *LUH_0; *IAD_(LCIT); *ST_(LCIT)
FINISH
*ACT_TOS
!-----------------------------------------------------------------------
! EVENT PENDING (USED TO EXIT FROM LOCAL CONTROLLER)
IST11I:
*JLK_TOS
! LOCAL CONTROL RETURNS TO HERE
CURPROC=0
IF MULTIOCP=YES THEN START
IF COM_NOCPS>1 THEN MY ALARM=0
*INCT_(MAINQSEMA)
*JCC_8,<MQGOT2>
SEMALOOP(MAINQSEMA,0)
MQGOT2:
FINISH
LSERV_P=LSERV_P&X'BFFFFFFF'; ! REMOVE "EXECUTING" BIT
!
! IF THE PROCESS IS NOT SUSPENDED THERE WILL BE MORE PARAMETERS FOR IT
! AND IT MUST BE REQUEUED. NOTE THAT THE PROCESS MAY HAVE CHANGED
! ITS RUNQ BY TRANSITIONS MADE ON THE FLY!
!
IF LSERV_P>0 THEN START
IF PROC_RUNQ=1 THEN RUNQ==RUNQ1 ELSE RUNQ==RUNQ2
IF RUNQ=0 THEN LSERV_L=LSERVICE ELSE START
LSERVQ==SERVA(RUNQ)
LSERV_L=LSERVQ_L
LSERVQ_L=LSERVICE
FINISH
RUNQ=LSERVICE UNLESS PROC_STATUS&3#0 AND RUNQ#0
FINISH
IF MULTIOCP=YES START ; *TDEC_(MAINQSEMA); FINISH
->KSERVE
!-----------------------------------------------------------------------
! INTERRUPT ENTRY POINTS
IST1I:
*JLK_TOS ; ! ENTRY IS LINK PC I.E. NEXT INSTR
! SYSTEM ERROR INTS ENTER HERE
*LSS_TOS ; *ST_SESTK
*LSS_TOS ; *ST_SEIP
*LSS_(LNB +8); *ST_SELN; ! OLD LINE NUMBER
SYSERR(SESTK,SEIP); ! DOES NOT RETURN
->KSERVE
!-----------------------------------------------------------------------
IST2I:*JLK_TOS
! EXTERNAL INTS (CLOCK+DAP) ENTER HERE
*LSS_TOS ; *ST_I; ! OLD STACK
*LSS_TOS ; *ST_J; ! INTERRUPT PARAMETER
IF MONLEVEL&4#0 AND IDLE#0 THEN START
IF MPLEVEL+NPQ<COM_NOCPS THEN C
NOWORKIT=NOWORK IT+(MAXIT-KIT) ELSE C
IDLEIT=IDLEIT+(MAXIT-KIT)
IDLE=0
FINISH
P_P1=I
P_P2=J
PORT=J>>20&15
P_SRCE=0
IF DAP FITTED=YES AND 4<=PORT<=5 START ;! FROM DAP
FOR I=1,1,MAXLDAP CYCLE
LDAP==COM_CDR(I)
IF LDAP_IPDAPNO>>4=PORT START
J=LDAP_DAP1+7
*LB_J; *LSS_(0+B ); *ST_J; ! READ AND CLEAR INT
IF J#0 START ; ! WAS AN INTERRUPT
P_P3=J; ! DAP INT STATUS REG
P_P4=MY OCP PORT
P_DEST=X'1F0003'!I<<8
PON(P)
FINISH
FINISH
REPEAT
->KSERVE
FINISH
IF SSERIES=NO AND BASIC PTYPE=4 AND COM_OCPTYPE=4 START
! 2980 CLOCK IS IN SAC
I=COM_CLKX&X'FFF00000'!X'100'; ! SAC EXTERNAL INT REG
*LB_I; ! MUST BE READ&CLEARED
*LSS_(0+B ); ! OR INT WILL OCCUR AGAIN
*ST_J
P_P3=J
FINISH
IF BASIC PTYPE=4 AND COM_CLKX>>20&15#PORT THEN C
OPMESS("?? CLOCK INT PORT ".STRINT(PORT))
P_DEST=X'A0000'
IF MULTIOCP=YES THEN PON(P) AND ->KSERVE ELSE START
ELAPSEDINT(P)
IF MONLEVEL&4#0 THEN TSERVICE=10
->KTIMES
FINISH
!-----------------------------------------------------------------------
IST3I:*JLK_TOS ; ! multi-processor
MULT: ! or pseudo via PON 19
IF MULTIOCP=YES THEN START
*LSS_TOS ; *LSS_TOS ; *USH_-20
*AND_15; *ST_I; ! INTERRUPTING PORT
!
! A MULTIOCP INT MEANS THAT THE OTHER OCP IS DOWN (EVEN THO THE
! INT MAY HAVE COME FROM SELF). STEP1 IS TO READ AND CLEAR THE INT AND
! MASK OUT ANY FURTHER COMMUNICATION FRON THE DEAD OCP.
!
IF SSERIES=NO START
IF BASIC PTYPE<=3 START
*LSS_(X'6303'); ! CLEAR & DISCARD
*LSS_(X'600A'); *OR_X'33'
*ST_(X'600A')
*LSS_0; *ST_(X'6009'); ! DONT BROADCAST SE INTS
FINISH ELSE START
IF I=MY OCP PORT START ; ! MP INT FROM SELF
*LSS_(X'4012'); *AND_X'FFFFFDFF'
*ST_(X'4012')
FINISH ELSE START
J=X'42000006'!I<<20
*LB_J; *LSS_6; *ST_(0+B )
FINISH
*LSS_(X'4013'); *AND_X'FFFF7FFB'
*ST_(X'4013'); ! REMOVE MULT AND DD
FINISH
FINISH
!
! If the remaining OCP is not the IPL OCP then clock control must be
! established in this OCP. ALSO ALLOW SAC INTS
!
IF COM_OCP PORT0#MY OCP PORT START
IF SSERIES=NO START ; ! OPEN SAC INTERRUPT PATHS
I=X'8'>>COM_SACPORT0
IF COM_NSACS>1 THEN I=I!(X'8'>>COM_SACPORT1)
IF BASIC PTYPE<=3 START
J=(I!I<<4)!!(-1)
*LSS_(X'600A'); *AND_J; *ST_(X'600A')
FINISH ELSE START
J=I<<12!I<<2
*LSS_(X'4012'); *OR_J; *ST_(X'4012')
FINISH
FINISH
CLOCK TO THIS OCP
!
! ALLOW DAP INTERUPTS IF RELEVANT
!
IF DAP FITTED=YES THEN START
J=0
FOR I=1,1,MAXLDAP CYCLE
K=COM_CDR(I)_IPDAPNO
IF K#0 THEN J=J!(X'80000000'>>(K>>4))
REPEAT
IF J>0 START ; ! A DAP CONFIGURED IN
IF BASIC PTYPE<=3 START ;! DAP ON 2970
*LSS_(X'600A')
*AND_X'F3FFFFFF'
*ST_(X'600A')
FINISH ELSE START ; ! DAP ON P4
*LSS_(X'4012')
*OR_X'0C000000'
*ST_(X'4012')
FINISH
FINISH
FINISH
FINISH
!
! FREE UP ANY BUSY KERNEL SERVICE. THESE MUST BE DUE TO HIM
! SINCE MPINT IS MASKED DURING KERNEL
!
CYCLE I=1,1,LOCSN0
IF SERVA(I)_P&X'40000000'#0 THEN C
SERVA(I)_P=SERVA(I)_P!!X'40000000' C
AND UNINHIBIT(I)
REPEAT
!
! FREE UP EXECUTING PROCESS ON OTHER OCP IF RELEVANT
!
J=X'8000017C'+HIS OCP PORT<<18
I=INTEGER(J); INTEGER(J)=0; ! NO CURRENT PROC ON DEAD OCP
IF I#0 THEN START
OPMESS(PROCA(I)_USER." CRASHES OCP")
I=I+LOCSN0
CLEAR PARMS(I); ! ANY L-C SERVICES
CLEAR PARMS(I+(LOCSN2-LOCSN0));! ANY ASYNC SERVICES
SERVA(I)_P=SERVA(I)_P&X'BFFFFFFF'
UNINHIBIT(I)
P_DEST=I<<16!4; ! CATASTROPHIC HW ERROR
PON(P)
FINISH
P_DEST=X'110002'; P_P1=1<<16!HIS OCP PORT
CONFIG CONTROL(P); ! FINISH CONFIGURING OFF HIM
->KSERVE
FINISH
*IDLE_X'F3'
!-----------------------------------------------------------------------
IST4I:*JLK_TOS
! PERIPHERAL INTS ENTER HERE
*LSS_TOS ; ! OLD STACK
*LSS_TOS ; ! PARAMETER = SAC NUMBER<<20
*ST_I
IF MONLEVEL&4#0 AND IDLE#0 THEN START
IF MPLEVEL+NPQ<COM_NOCPS THEN C
NOWORKIT=NOWORKIT+(MAXIT-KIT) ELSE C
IDLEIT=IDLEIT+(MAXIT-KIT)
IDLE=0
FINISH
IF SSERIES=YES THEN START
P_SRCE=0
P_DEST=X'300003'
P_P1=I
GDC(P)
IF MONLEVEL&4#0 START
TSERVICE=58
->KTIMES
FINISH ELSE ->KSERVE
FINISH ELSE START ; ! FOR P SERIES
PORT=I>>20&3
*LSS_1
*USH_PORT
*AND_SACMASK
*JAT_4,<KSERVE>; ! IGNORE OTHERWISE
! *JAF_4,<SACOK>; ! SAC configured in
! OPMESS("Surprise int. - SAC ".STRINT(PORT).TOSTRING(17))
! ->KSERVE
SACOK:
I=X'44000000'!PORT<<20 ;! IMAGE STORE ADDR FOR TRUNK FLAGS
*LB_I
*LSS_(0+B )
*JAT_4,<KSERVE>; ! NO TRUNK FLAGS
*ST_I
PROCESS INT:
K=0
CYCLE
*LSS_I
*SHZ_J
*USH_1
*ST_I
P_SRCE=0
J=J+K
P_P1=PORT<<4!J
->CONROUT(CONTYPE(P_P1)) IF P_P1<=31
CONROUT(1): IF SFC FITTED=YES THEN START
P_DEST=X'280003'
DRUM(P)
IF MONLEVEL&4#0 THEN TSERVICE=42
->CONTINUE
FINISH
CONROUT(0): ! IN CASE OF SPURIOUS BITS
IF MONLEVEL&4#0 THEN TSERVICE=1
->CONTINUE
CONROUT(2): P_DEST=X'200003'
IF MULTI OCP=YES AND I#0 AND COM_NOCPS>1 THEN PON(P) C
ELSE DISC(P); ! PON if more ints. & multi ocp
IF MONLEVEL&4#0 THEN TSERVICE=34
->CONTINUE
CONROUT(3): P_DEST=X'300003'
P_SRCE=M'INT'
IF MULTI OCP=YES AND I#0 AND COM_NOCPS>1 THEN PON(P) C
ELSE GDC(P)
IF MONLEVEL&4#0 THEN TSERVICE=58
CONTINUE: IF I=0 THEN ->KTIMES
IF MONLEVEL&4#0 THEN START
*LSS_(6); *ST_IC; *LSS_(5); *ST_IT
*LSS_X'FFFFFF'; *ST_(5); *ST_(6)
PERFORM_SERVN(TSERVICE)=PERFORM_SERVN(TSERVICE)+1
PERFORM_SERVIT(TSERVICE)=PERFORM_SERVIT(TSERVICE)+ C
(MAXIT-IT)
PERFORM_SERVIC(TSERVICE)=PERFORM_SERVIC(TSERVICE)+ C
(MAXIT-IC)
FINISH
K=J+1
REPEAT
FINISH
!-----------------------------------------------------------------------
! EXTRACODE
IST10I:*JLK_TOS ; *IDLE_X'FA'
!-----------------------------------------------------------------------
! Primitive
IST13I:*JLK_TOS ; *IDLE_X'FB'
!-----------------------------------------------------------------------
! Unit
IST14I:
*JLK_TOS
IF SSERIES=YES START ; ! unit interrupts S series only
*LSS_TOS ; *LSS_TOS
*ST_I
IF MONLEVEL&4#0 AND IDLE#0 THEN START
IF MPLEVEL+NPQ<COM_NOCPS THEN C
NOWORKIT=NOWORKIT+(MAXIT-KIT) ELSE C
IDLEIT=IDLEIT+(MAXIT-KIT)
IDLE=0
FINISH
K=UT VA+(I&X'FFFF')*64; ! unit table entry
J=BYTEINTEGER(COM_DCU2HWNA+INTEGER(K+8)>>24)
IF J=0 START
OPMESS("Unit int.?? ".STRHEX(I))
->KSERVE
FINISH
J=J<<24!(INTEGER(K+8)>>8&255)
! h/w no./00/00/strm
K=I>>16&15; ! int. sub-class
IF K=0 THEN J=J!X'00208000' ELSE C { normal term }
IF K=1 THEN J=J!X'00208400' ELSE C { abterm }
IF K=4 THEN J=J!X'00204000' C { attention }
ELSE J=J!X'00201000' { control term }
P_DEST=X'300003'
P_P1=J
P_P2=I
GDC(P)
IF MONLEVEL&4#0 START
TSERVICE=58
->KTIMES
FINISH ELSE ->KSERVE
FINISH ELSE START ; ! P series
*IDLE_X'FC'; ! should not occur
FINISH
!-----------------------------------------------------------------------
JLUNQ: ! JUMP&LINK VERSION OF ROUTINE UNQUEUE
! DR DESCRIBES QUEUE
*LB_(DR ); *MYB_8; *ADB_SERVA+4
*LCT_B ; ! CTB TO SERVQ
*LB_(CTB +1); *STB_TOS
*MYB_8; *ADB_SERVA+4
*LXN_B ; ! XNB TO SERV
*LSS_(XNB +0); *OR_X'40000000'; *ST_(XNB +0)
*LB_TOS ; *CPB_(DR ); *JCC_7,<JLUNQA>
*LSS_0; *ST_(DR ); *J_<JLUNQB>
JLUNQA: *LSS_(XNB +1); *ST_(CTB +1)
JLUNQB: *LSS_0; *ST_(XNB +1)
*J_TOS ; ! SERVICE NO IN B
!%ROUTINE UNQUEUE(%INTEGERNAME QUEUE,UNQUED SERVICE)
!!***********************************************************************
!!* UNQUEUES A SERVICE FROM MAIN OR RUN QUEUES AND MARKS IT *
!!* AS BEING EXECUTED *
!!***********************************************************************
!%INTEGER SERVICE; ! LOCAL COPY OF UNQUED SERVICE
!%RECORD(SERVF)%NAME SERVQ; ! MAPPED ON TO SERVICE AT BACK OF Q
!%RECORD(SERVF)%NAME SERV; ! FOR UNQUED SERVICE
! SERVQ==SERVA(QUEUE); ! BACK OF Q. L POINTS TO FRNT
! SERVICE=SERVQ_L; ! SERVICE TO UNQUEUE
! SERV==SERVA(SERVICE)
! SERV_P=SERV_P!X'40000000'; ! MARK AS UNDER EXECUTION
! %IF SERVICE=QUEUE %THEN QUEUE=0 %ELSE SERVQ_L=SERV_L
! SERV_L=0
! UNQUED SERVICE=SERVICE
!%END
END ; ! OF GLOBAL CONTROLLER
ROUTINE SCHEDULE(RECORD (PARMF)NAME P)
!***********************************************************************
!* ACTIVITY 0 : INITIALISE *
!* ACTIVITY 1 : CREATE FOREGROUND PROCESS *
!* ACTIVITY 2 : REPLY FROM CREATE PROCESS *
!* ACTIVITY 3 : OUT OF EPAGES FROM LOCAL CONTROLLER *
!* ACTIVITY 4 : OUT OF TIME SLICES FROM LOCAL CONTROLLER *
!* ACTIVITY 5 : SUSPEND PROCESS *
!* ACTIVITY 6 : TRY AND LOAD FURTHER PROCESS *
!* ACTIVITY 7 : UNSUSPEND PROCESS *
!* ACTIVITY 8 : DESTROY PROCESS *
!* ACTIVITY 9 : REPLY FROM PAGE-IN OF LOCAL CONTROLLER STACK *
!* ACTIVITY 10: MORE EPAGES ON THE FLY ? *
!* ACTIVITY 11: MORE TIME ON THE FLY ? *
!* ACTIVITY 12: SNOOZING HAS TIMED OUT *
!* ACTIVITY 13: RESCHEDULE ALL RESIDENT TO FREE SMAC *
!* ACTIVITY 14: DEADLOCK RECOVERY *
!* ACTIVITY 15: UPDATE OPER DIPLAY *
!* ACTIVITY 16: CREATE BACKGROUND JOB *
!* ACTIVITY 17: START OR RESTART DIRECT *
!* ACTIVITY 18: SUSPEND ON FLY? *
!***********************************************************************
ROUTINESPEC PARE EPAGES
ROUTINESPEC ONPQ
CONSTINTEGER PRATMAX=255,PRIQS=5
CONSTBYTEINTEGERARRAY PRAT(0:PRATMAX)= C
1,1,2,1,3,1,1,2,1,1,2,1,1,4,1,2,1,1,2,1,1,1,2,1,1,3,1,1,2,1,1,2,
1,1,2,1,3,1,1,2,1,1,2,1,1,5,1,2,1,1,2,1,1,1,2,1,1,3,1,1,2,1,1,2,
1,1,2,1,3,1,1,2,1,1,2,1,1,4,1,2,1,1,2,1,1,1,2,1,1,3,1,1,2,1,1,2,
1,1,2,1,3,1,1,2,1,1,2,1,1,5,1,2,1,1,2,1,1,1,2,1,1,3,1,1,2,1,1,2,
1,1,2,1,3,1,1,2,1,1,2,1,1,4,1,2,1,1,2,1,1,1,2,1,1,3,1,1,2,1,1,2,
1,1,2,1,3,1,1,2,1,1,2,1,1,5,1,2,1,1,2,1,1,1,2,1,1,3,1,1,2,1,1,2,
1,1,2,1,3,1,1,2,1,1,2,1,1,4,1,2,1,1,2,1,1,1,2,1,1,3,1,1,2,1,1,2,
1,1,2,1,3,1,1,2,1,1,2,1,1,5,1,2,1,1,2,1,1,1,2,1,1,3,1,1,2,1,1,2;
OWNINTEGER PRATP=0,SCHTICKS=0
!-----------------------------------------------------------------------
! PRIORITY QUEUE ARRAY ETC.
OWNBYTEINTEGERARRAY PQ(1:MAXPROCS)=0(MAXPROCS)
OWNBYTEINTEGERARRAY PQH(1:PRIQS)=0(PRIQS);! NUMBER OF PRIORITIES=PRIQS
OWNBYTEINTEGERARRAY PQN(1:PRIQS)=0(PRIQS)
IF MONLEVEL&1#0 THEN START
OWNINTEGER SUSPN=0
CONSTSTRING (2)ARRAY STRPN(1:PRIQS)="P1","P2","P3","P4","P5"
FINISH
CONSTSTRING (16)ARRAY STARTMESS(0:3)=" PROCESS CREATED",
" : SYSTEM FULL"," : NO AMT"," : PROCESS RUNNG"
LONGINTEGERARRAYNAME LST
INTEGER SRCE,ACT,PROCESS,PTY,LSTAD,LSTVAD,LSTACKDA,DCODEDA,DSTACKDA,C
DGLADA,XEPS,OLDCATSLOT,NEWCATSLOT,INCAR,LCDDP,I,J,K,L,LCSTX
LONGINTEGER LIM
STRING (15) USER
STRING (2) PSTATE
RECORD (CATTABF)NAME OLDCAT,NEWCAT
RECORD (PROCF)NAME PROC
SWITCH ACTIVITY(0:20)
IF MONLEVEL&2#0 AND KMON&1<<3#0 THEN C
PKMONREC("SCHEDULE:",P)
ACT=P_DEST&X'FFFF'
PROCESS=P_P1
IF 0<PROCESS<=MAXPROCS THEN START
PROC==PROCA(PROCESS)
OLDCATSLOT=PROC_CATEGORY
OLDCAT==CATTAB(OLDCATSLOT)
FINISH
IF MULTIOCP=YES THEN START
*INCT_SCHEDSEMA
*JCC_8,<SSEMAGOT>
SEMALOOP(SCHEDSEMA,0)
SSEMAGOT:
FINISH
->ACTIVITY(ACT&255)
!-----------------------------------------------------------------------
ACTIVITY(0): ! INITIALISE
I=FREEEPAGES//2-LSTACKLEN
IF MAXEPAGES>I THEN START
MAXEPAGES=I
CYCLE I=1,1,MAXCAT-2; ! DONT ADJUST TRASHING CAT
IF CATTAB(I)_EPLIM>MAXEPAGES THEN C
CATTAB(I)_EPLIM=MAXEPAGES
REPEAT
FINISH
COM_USERS=0
MPLEVEL=0
PAGEFREES=0
DCLEARS=0
CYCLE I=1,1,MAXPROCS-1
PROCA(I)=0
PINH(I,X'F'); ! INHIBIT LOCSN0&1&2&3
REPEAT
!
! INITIALISE LEFT-HAND OPER SCREEN
!
DISPLAY TEXT(0,0,0," EMAS 2900 SUP".SUPID)
DISPLAY TEXT(0,0,22,STRING(ADDR(COM_DATE0)+3))
CYCLE I=1,1,MAXPROCS-1
STRPROC=STRINT(I)
UPDISP(I,3-LENGTH(STRPROC),STRPROC)
REPEAT
IF MONLEVEL&1#0 THEN START
DISPLAY TEXT(0,2,0,"RQ1 RQ2 P1 P2 P3 P4 P5 TOTAL STF")
DISPLAY TEXT(0,3,0," 0 0 0 0 0 0 0 0 100")
IF SFCFITTED=NO OR DRUMSIZE=0 THEN C
DISPLAY TEXT(0,2,36,"OUTS")
FINISH
user="OCP ".strint(com_ocpport0)
if multi ocp=yes and com_nocps>1 then charno(user,4)='s'
display text(0,4,13,user)
P_DEST=X'80000'
ACTIVE MEM(P)
IF SNOOZING=YES OR MONLEVEL&1#0 START
P_DEST=X'A0001'; ! REGULAR CLOCK TICK
P_SRCE=0
P_P1=X'F000F'; ! ON SCHED ALT SERVICE NO
P_P2=5; ! AT 5 SEC INTERVALS
PON(P); ! FOR VIDEO & BOOTING
FINISH
ALLOW PERI INTS=X'01800824'; ! PERMITS INTS BETWEEN KERNEL
! SERVICES NOW INITIALISATION
! IS COMPLETED(XCEPT IT,IC&MP INTS)
!
! START "DIRECT" PROCESS TAKING CARE ITS INCARNATION IS 0
! AND THAT ALL ITS TEMP SPACE IS IN X40 EPAGES(1 SEGMENT)
!
ACTIVITY(17): ! FOR DIRECTOR RESTARTS
P_DEST=X'30001'
P_SRCE=0; ! NO REPLY WANTED
P_P1=M'DIR'!6<<24
P_P2=M'ECT'<<8; ! ENSURE INCAR=0
P_P3=COM_SUPLVN<<24!X'500'; ! LSTACKDA(NEEDS 3 EPAGES ONLY)
P_P4=0; ! USE DEFAULT DIRVSN
P_P5=P_P3+LSTACKLEN; ! DSTACKDA(1SEG IN CBT BUT USES LESS)
P_P6=P_P3+(X'40'-8); ! DGLADA (ALLOW LAST 8 PAGES)
PON(P)
IF MULTIOCP=YES START ; *TDEC_SCHEDSEMA; FINISH
RETURN
!-----------------------------------------------------------------------
ACTIVITY(16): ! CREATE BATCH JOB
ACTIVITY(1): ! CREATE FORGROUND PROCESS
! P_P1/P2 : STRING(USER NAME)
! P_P3 : L-C STACK DISC ADDRESS
! P_P4 : DIRCODE DISC ADDRESS
! (<=0 FOR DEFAULT)
! P_P5 : DIR STACK DISC ADDRESS
! P_P6 : DIR GLA DISC ADDRESS
SRCE=P_SRCE
USER=P_USER
INCAR=P_INCAR
IF COM_USERS>=MAXPROCS-1 THEN P_P1=1 AND ->STARTREP;! SYSTEM FULL
PROCESS=0
IF USER="DIRECT" THEN PROCESS=1
IF USER="SPOOLR" THEN PROCESS=3
IF USER="VOLUMS" THEN PROCESS=2
IF USER="MAILER" THEN PROCESS=4
IF USER="FTRANS" THEN PROCESS=5
IF PROCESS>0 START
PROC==PROCA(PROCESS)
IF PROC_USER#"" THEN P_P1=3 AND ->STARTREP
FINISH ELSE START
CYCLE PROCESS=FIRST UPROC,1,MAXPROCS-1
PROC==PROCA(PROCESS)
IF PROC_USER="" THEN EXIT
REPEAT
FINISH
LSTACKDA=P_P3
IF P_P4<=0 THEN DCODEDA=COM_DCODEDA ELSE DCODEDA=P_P4
DSTACKDA=P_P5
DGLADA=P_P6
P_DEST=X'80001'; ! GET AMTX FOR LOCAL CNTRLRL STACK
P_SRCE=0
P_P1=0
P_P2=LSTACKDA
P_P3=X'FFFF0000'!(LSTACKLEN-1); ! "NEW" EPAGES
ACTIVE MEM(P)
IF P_P2<=0 THEN P_P1=2 AND ->STARTREP;! NO AMT
PROC_LAMTX=P_P2
COM_USERS=COM_USERS+1
PROC_USER=USER
PROC_STATUS=ACT>>2; ! SET 2**2 BIT FOR BATCH
PROC_ACTW0=(LSTLEN-1)<<18
PROC_INCAR=INCAR
PROC_ACTIVE=0; ! SUSPENDED
PROC_CATEGORY=0
IF MONLEVEL&1#0 THEN SUSPN=SUSPN+1
IF MULTIOCP=YES START ; *TDEC_SCHEDSEMA; FINISH
IF ACT=16 START
FOR I=1,1,6 CYCLE
J=BYTEINTEGER(ADDR(USER)+I)
IF 'A'<=J<='Z' THEN J=J!32
BYTEINTEGER(ADDR(USER)+I)=J
REPEAT
FINISH
UPDISP(PROCESS,4,USER)
CLEAR PARMS(PROCESS+LOCSN0)
CLEAR PARMS(PROCESS+LOCSN1) UNLESS PROCESS<FIRST UPROC
CLEAR PARMS(PROCESS+LOCSN2)
CLEAR PARMS(PROCESS+LOCSN3)
! PON TO INITIALIZE LOCAL CONTROLLER
P_DEST=(PROCESS+LOCSN0)<<16
P_SRCE=X'30002'
P_P1=PROCESS
P_P2=DCODEDA
P_P3=DGLADA
P_P4=DSTACKDA
PON(P); ! INHIBITED AS YET THOUGH
! REPLY TO START-UP
P_P1=0; ! PROCESS CREATED SUCCESSFULLY
P_P2=(PROCESS+LOCSN1)<<16
P_P3=(PROCESS+LOCSN2)<<16
P_P4=(PROCESS+LOCSN3)<<16!1; ! ASYNCH SNO FOR INPUT CONTROL MESS
P_P5=PROCESS
STARTREP:
IF SRCE<=0 THEN OPMESS(USER.STARTMESS(P_P1)) C
ELSE P_DEST=SRCE AND P_SRCE=X'30001' AND PON(P)
IF P_P1=0 THEN START
P_DEST=X'30007'; ! PON TO USUSPEND HIM
P_P1=PROCESS; ! IN PROPRELY SEMAPHORED WAY
PON(P)
FINISH ELSE START ; *TDEC_SCHEDSEMA; FINISH
RETURN
!-----------------------------------------------------------------------
ACTIVITY(2): ! REPLY FROM CREATE PROCESS
NEWCATSLOT=1+PROC_STATUS>>2&1; ! INITIAL CATEGORY =1 FORE =2BACKGROUND
NEWCAT==CATTAB(NEWCATSLOT)
PROC_CATEGORY=NEWCATSLOT
->STOUT
!-----------------------------------------------------------------------
ACTIVITY(3): ! OUT OF EPAGES
NEWCATSLOT=OLDCAT_MOREP
NEWCAT==CATTAB(NEWCATSLOT)
PROC_CATEGORY=NEWCATSLOT
->STOUT
!-----------------------------------------------------------------------
ACTIVITY(10): ! MORE EPAGES ON THE FLY ?
P_P1=0
NEWCATSLOT=OLDCAT_MOREP
NEWCAT==CATTAB(NEWCATSLOT)
XEPS=NEWCAT_EPLIM-OLDCAT_EPLIM
IF XEPS<=0 THEN ->WAYOUT
IF RECONFIGURE=YES AND SMAC RCONFIG#0 THEN ->WAYOUT
IF OLDCAT_PRIORITY<=3 AND PROC_STATUS&HADPONFLY=0 C
AND XEPS<FREE EPAGES+PAGE FREES THEN ->GIVE PAGES
->WAYOUT IF XEPS>SHAREDEPS+UNALLOCEPS
I=1; J=0; K=OLDCAT_PRIORITY; ! CHECK FOR HIGHER PRIORITY WK
IF K=5 THEN K=4; ! QUEUES 4 & 5 EQIVALENT
WHILE I<K CYCLE
J=J+PQN(I)
I=I+1
REPEAT
IF J#0 THEN ->WAYOUT; ! NO: MORE URGENT WORK
GIVE PAGES: ! WITHOUT BOUNCING
PROC_STATUS=PROC_STATUS!HADPONFLY;! SO HE WONT DO IT AGAIN
UNALLOCEPS=UNALLOCEPS-XEPS
PROC_CATEGORY=NEWCATSLOT
P_P1=NEWCAT_EPLIM
PROC_EPA=NEWCAT_EPLIM
CONT: P_P2=NEWCAT_RTLIM
P_P3=NEWCAT_STROBEI; ! SO L-C CAN DECIDE TO STROBE
IF OLDCAT_PRIORITY>=4 THEN P4PAGES=P4PAGES-OLDCAT_EPLIM
IF NEWCAT_PRIORITY>=4 THEN P4PAGES=P4PAGES+NEWCAT_EPLIM
IF NEWCAT_PRIORITY=4=OLDCAT_PRIORITY AND PROC_P4TOP4<255 C
AND PROCESS>=FIRST UPROC THEN PROC_P4TOP4=PROC_P4TOP4+1
IF MONLEVEL&32#0 THEN C
FLYCAT(NEWCATSLOT,OLDCATSLOT)<-FLYCAT(NEWCATSLOT,OLDCATSLOT)+1
WAYOUT:
IF MULTIOCP=YES START ; *TDEC_SCHEDSEMA; FINISH
RETURN
!-----------------------------------------------------------------------
ACTIVITY(4): ! OUT OF TIME
NEWCATSLOT=OLDCAT_MORET
PARE EPAGES
->STOUT
!-----------------------------------------------------------------------
ACTIVITY(11): ! MORE TIME ON THE FLY?
! BE KIND TO VOLUMS&SPOOLR
P_P1=0
IF OLDCAT_PRIORITY>=4 AND P4PAGES>=MAXP4PAGES AND SXPAGES> C
(SHAREDEPS+UNALLOCEPS) AND PROCESS>=FIRST UPROC THEN ->WAYOUT
IF RECONFIGURE=YES AND SMAC RCONFIG#0 THEN ->WAYOUT
NEWCATSLOT=OLDCAT_MORET
NEWCAT==CATTAB(NEWCATSLOT)
IF PROC_STATUS&HADTONFLY=0 AND C
(SFC FITTED=NO OR PQN(1)+PQN(2)=0) THEN ->GIVE TIME
I=1; J=0; K=NEWCAT_PRIORITY
IF K=4 THEN K=5; ! QUEUES 4 & 5 EQUIVALENT HERE
WHILE I<=K CYCLE
J=J+PQN(I)
I=I+1
REPEAT
IF J#0 AND PROCESS>=FIRST UPROC THEN ->WAYOUT
! CANNOT ALLOW VOLS&SPOOLR MORE
! TIME IF SYSTEM IS CONFGRD
! SO ONLY 1 P4 CAN BE IN STORE
IF PROCESS<FIRST UPROC AND PQN(4)>0 AND C
P4PAGES<=OLDCAT_EPLIM THEN ->WAYOUT
GIVE TIME: ! WITHOUT REQUEING
PROC_STATUS=PROC_STATUS! HADTONFLY
PARE EPAGES; ! AND MAP NEWCAT
UNALLOCEPS=UNALLOCEPS+OLDCAT_EPLIM-NEWCAT_EPLIM
P_P1=NEWCAT_EPLIM
PROC_EPA=NEWCAT_EPLIM
->CONT
!-----------------------------------------------------------------------
ACTIVITY(18): ! SUSPEND ON FLY(IE WITHOUT
! PAGING WOKSET OUT)?
IF SNOOZING=YES THEN START
! %IF SHAREDEPS+UNALLOCEPS<MAX EPAGES %AND OLDCAT_PRIORITY>1 %C
! %THEN ->WAYOUT; ! NO !
IF RECONFIGURE=YES AND SMAC RCONFIG#0 THEN ->WAYOUT
I=(PQN(1)+PQN(2))*MAXEPAGES>>1;! PAGES NEEDED TO CLERAR QS
!
! THE NEXT CONDITION IS CRUCIAL FOR SATISFACTORY SNOOZING
! CAN NOT AFFORD IN GENERAL TO ALLOW ANYONE TO SNOOZE WHEN THERE ARE
! NOT ENOUGH FREE PAGES TO CLEAR QUEUEING INTEGERACTIVE PROCESSES
! HOWEVER IN LARGE STORE NO DRUM CONFIGURATIONS QUEUEING MAY BE
! DUE TO LARGE NUMBER OF PAGE FREES BUILDING UP. IN THESE CIRCUMSTANCES
! IT IS BETTER TO LET THIS CHAP SNOOZE TILL THING QUIETEN DOWN.
! THE BIGGER THE STORE THE TRUEUER THIS IS SO DO NOT SCALE PAGE FREES
! FOR BIGGER CORE SIZES
!
IF I>FREE EPAGES+PAGE FREES AND (PAGE FREES<MAX EPAGES>>2 C
OR (SFC FITTED=YES AND DRUMSIZE>0)) THEN ->WAYOUT
NEWCATSLOT=OLDCAT_SUSP
IF MONLEVEL&1#0 THEN START
SUSPN=SUSPN+1
UPDISP(PROCESS,11,"Z ")
FINISH
I=8!(1<<((P_SRCE-LOCSN0)//MAXPROCS))
PUNINH(PROCESS,I)
PROC_ACTIVE=0
PROC_STATUS=PROC_STATUS!SNOOZED
PARE EPAGES
PROC_EPA=NEWCAT_EPLIM
UNALLOCEPS=UNALLOCEPS+OLDCAT_EPLIM-PROC_EPN
IF MONLEVEL&32#0 THEN FLYCAT(NEWCATSLOT,OLDCATSLOT) <- C
FLYCAT(NEWCATSLOT,OLDCATSLOT)+1
MPLEVEL=MPLEVEL-1
IF OLDCAT_PRIORITY>=4 THEN P4PAGES=P4PAGES-OLDCAT_EPLIM;! PEDANTIC !
P_DEST=X'A0002'; P_SRCE=X'30012';! KICK ELAPSED INT
P_P1=X'3000C'!PROCESS<<8
P_P2=SNOOZTIME; P_P3=PROCESS
PON(P)
P_P1=0; ! YES MAY SUSPEND ON FLY
FINISH
IF NPQ#0 THEN P_DEST=X'30006' AND PON(P)
->WAYOUT
!----------------------------------------------------------------------
ACTIVITY(5): ! SUSPEND
IF MONLEVEL&1#0 THEN SUSPN=SUSPN+1
I=8!(1<<((P_SRCE-LOCSN0)//MAXPROCS))
PUNINH(PROCESS,I)
PSTATE="S "
IF PROC_STATUS&AMT LOST=0 AND SMAC RCONFIG=0 AND C
(PROCESS<FIRST UPROC OR OLDCAT_PRIORITY*COM_USERS<=COM_SEPGS)C
THEN PROC_STATUS=PROC_STATUS!STATEX AND PSTATE="X "
IF MONLEVEL&1#0 THEN UPDISP(PROCESS,11,PSTATE)
PROC_ACTIVE=0
IF PROC_STATUS&8#0 START ; ! DELLOCATE AMT ONLY
PROC_STATUS=PROC_STATUS!!8
PROC_ACTIVE=3; ! GUESS.2-5 POSSIBLE DEPENDING
! ON CURRENT DRUN LOADING
FINISH
NEWCATSLOT=OLDCAT_SUSP
PARE EPAGES
IF NEWCAT_PRIORITY<4 AND PROC_STATUS&(STATEX!4)=STATEX THEN C
SXPAGES=SXPAGES+PROC_EPN
->STOUT
!-----------------------------------------------------------------------
ACTIVITY(7): ! UNSUSPEND
IF PROC_ACTIVE=255 THEN ->WAYOUT;! RACE CONDITION WITH BOOTONFLY
IF MONLEVEL&1#0 THEN SUSPN=SUSPN-1
IF SNOOZING=YES AND PROC_STATUS&SNOOZED#0 START ;! PROCESS IN STORE
PROC_STATUS=PROC_STATUS!!SNOOZED
MPLEVEL=MPLEVEL+1
PROC_RUNQ=OLDCAT_RQTS1
IF MONLEVEL&4#0 THEN PERFORM_SNOOZOK=PERFORM_SNOOZOK+1
IF MONLEVEL&1#0 THEN C
UPDISP(PROCESS,11,"R".TOSTRING(PROC_RUNQ+'0'))
P_DEST=(PROCESS+LOCSN0)<<16!3
P_SRCE=X'30000'
P_P1=OLDCAT_EPLIM
P_P2=OLDCAT_RTLIM
UNALLOCEPS=UNALLOCEPS+PROC_EPN-PROC_EPA
IF OLDCAT_PRIORITY>=4 THEN P4PAGES=P4PAGES+OLDCAT_EPLIM
PROC_ACTIVE=255
PON(P)
IF MONLEVEL&4#0 THEN PERFORM_SNOOZN=PERFORM_SNOOZN+LSTACKLENP
->WAYOUT
FINISH
PROC_ACTIVE=255
IF OLDCAT_PRIORITY<4 AND PROC_STATUS&(STATEX+4)=STATEX THEN C
SXPAGES=SXPAGES-PROC_EPN
ONPQ
->LOAD
!-----------------------------------------------------------------------
ACTIVITY(8): ! DESTROY PROCESS
MPLEVEL=MPLEVEL-1
DESTROY:
UPDISP(PROCESS,4," ")
COM_USERS=COM_USERS-1
PINH(PROCESS,X'F'); ! ALL PROCESS SERVICES
IF OLDCAT_PRIORITY>=4 THEN P4PAGES=P4PAGES-OLDCAT_EPLIM
P_DEST=X'40002'; ! PAGE-TURN OUT
P_SRCE=X'30008'
P_P2=0; ! REGARD AS NOT WRITTEN TO
CYCLE I=0,1,LSTACKLEN-1
P_P1=PROC_LAMTX<<16!I
PON(P)
REPEAT
P_DEST=X'80002'; ! RETURN AMTX FOR L-CNTRLR STACK
P_P1=0; ! ID NOT USED
P_P2=PROC_LAMTX
P_P3=1; ! DESTROY FLAG
PON(P)
PROC=0
->DEALL
!-----------------------------------------------------------------------
STOUT: ! PAGE-OUT LOCAL CONTROLLER STACK
IF NEWCAT_PRIORITY=4=OLDCAT_PRIORITY AND PROC_P4TOP4<255 C
AND PROCESS>=FIRST UPROC THEN PROC_P4TOP4=PROC_P4TOP4+1
IF MONLEVEL&32#0 THEN C
CATREC(NEWCATSLOT,OLDCATSLOT)<-CATREC(NEWCATSLOT,OLDCATSLOT)+1
ACTIVITY(14): ! DEADLOCK RECOVERY
MPLEVEL=MPLEVEL-1
P_DEST=X'40002'; ! PAGETURN/PAGE-OUT
P_SRCE=X'3008A'
IF PROC_STATUS&STATEX#0 THEN I=LSTACKLENP ELSE I=0
CYCLE I=I,1,LSTACKLEN-1
P_P1=PROC_LAMTX<<16!I
IF I>=LSTACKLENP THEN P_P2=2 ELSE P_P2=X'D';! MAKE END "NEW"
PON(P); ! NO REPLIES
REPEAT
IF OLDCAT_PRIORITY>=4 THEN P4PAGES=P4PAGES-OLDCAT_EPLIM
PROC_RUNQ=0
UNLESS ACT=5 THEN ONPQ; ! UNLESS SUSPENEDED
DEALL: ! DEALLOCATE PROCESSES EPAGES
UNALLOCEPS=UNALLOCEPS+OLDCAT_EPLIM+LSTACKLEN
PROC_EPA=0
!-----------------------------------------------------------------------
ACTIVITY(6): ! MORE LOADS
LOAD: ! LOAD FURTHER PROCESS(ES)
!
! TRY TO LOAD AS MANY WAITING
! PROCESSES AS POSSIBLE EXCEPT THAT ONLY "MAXP4PAGES" OF BIG JOBS ARE
! LOADED EXCEPT WHEN THERE ARE NO INTERACTIVE JOBS ASLEEP IN QUEUES 1-3
! THIS COUNT IS MAINTAINED IN 'NP4L'
!
IF NPQ=0 OR DONT SCHED#0 THEN ->WAYOUT
AGN:
CYCLE
PTY=PRAT(PRATP)
EXIT IF PQH(PTY)#0
PRATP=(PRATP+1)&PRATMAX
REPEAT
IF SFC FITTED=NO AND PTY>=3 AND PAGEFREES>=40 START ;! TOO MANY WRITEOUT
PRATP=(PRATP+1)&PRATMAX; ! PASS OVER BIG JOB
IF MULTIOCP=YES START ; *TDEC_SCHEDSEMA; FINISH
P_DEST=X'A0002'
P_P1=X'30006'; P_P2=1
PON(P); ! WAIT 1 SEC
RETURN
FINISH
PROCESS=PQ(PQH(PTY))
PROC==PROCA(PROCESS)
OLDCATSLOT=PROC_CATEGORY
OLDCAT==CATTAB(OLDCATSLOT)
!
! THE IDEA OF THE NEXT FEW LINES IS TO RESTRICT P4 JOBS TO 1 OR TO
! P4PAGES OF STORE EXCEPT WHEN THERE ARE SO FEW FOREGROUND USERS
! ASLLEEP THAT THEY WILL NOT BE INCONVENINECED.
!
IF PTY>=4 THEN START
IF P4PAGES>0 AND P4PAGES+OLDCAT_EPLIM>MAXP4PAGES AND C
SXPAGES>(SHAREDEPS+UNALLOCEPS) START
IF NPQ>PQN(4)+PQN(5) THEN C
PRATP=(PRATP-31)&PRATMAX AND ->AGN
->WAYOUT
FINISH
FINISH
I=OLDCAT_EPLIM+LSTACKLEN
IF I>SHAREDEPS+UNALLOCEPS AND MPLEVEL>0 THEN START ; ! NOT ENOUGH ROOM
->WAYOUT
FINISH
PROC_EPA=OLDCAT_EPLIM
UNALLOCEPS=UNALLOCEPS-I
PRATP=(PRATP+1)&PRATMAX; ! TO NEXT PRIORITY Q
IF PTY>=4 THEN P4PAGES=P4PAGES+OLDCAT_EPLIM
IF PROCESS=PQH(PTY) THEN PQH(PTY)=0 C
ELSE PQ(PQH(PTY))=PQ(PROCESS)
NPQ=NPQ-1
PQN(PTY)=PQN(PTY)-1
IF MULTIOCP=YES START ; *TDEC_SCHEDSEMA; FINISH
! PAGE IN LOCAL CONTROLLER STACK
P_SRCE=X'30009'
IF PROC_STATUS&STATEX#0 THEN I=LSTACKLENP ELSE I=0
PQ(PROCESS)=LSTACKLEN-I; ! TO COUNT PAGE-TURN REPLIES
CYCLE I=I,1,LSTACKLEN-1
IF I=0 THEN P_DEST=X'40009' ELSE P_DEST=X'40001';! PAGETURN/PAGE-IN
! BUT PAGE 0 TO SYSTEM SMAC NOT DAP
P_P1=PROC_LAMTX<<16!I
P_P2=PROCESS<<8!I
PON(P)
REPEAT
IF NPQ#0 AND SHAREDEPS+UNALLOCEPS>=LSTACKLEN START ;! ROOM FOR ANOTHER?
P_DEST=X'30006'; ! YES KICK OURSELVES AGAIN
P_SRCE=P_DEST; ! SINCE THIS IS NOT COMMON AND
PON(P); ! AND THIS SIMPLIFIES DUALS
FINISH
RETURN
!-----------------------------------------------------------------------
ACTIVITY(12): ! SNOOZING TIMED OUT FROM ELAPSED INT
IF SNOOZING=YES AND PROC_STATUS&SNOOZED#0 START
PROC_STATUS=PROC_STATUS&(¬SNOOZED)
PROC_ACTIVE=255
UNALLOCEPS=UNALLOCEPS+PROC_EPN-PROC_EPA
MPLEVEL=MPLEVEL+1
IF MONLEVEL&4#0 THEN PERFORM_SNOOZTO=PERFORM_SNOOZTO+1
IF MONLEVEL&1#0 THEN SUSPN=SUSPN-1
P_DEST=(PROCESS+LOCSN0)<<16!8
P_SRCE=X'3000C'
PON(P)
FINISH
IF MULTIOCP=YES START ; *TDEC_SCHEDSEMA; FINISH
RETURN
!-----------------------------------------------------------------------
ACTIVITY(13): ! RESCHEDULE ALL RESIDENT TO FREE SMAC
CYCLE I=1,1,MAXPROCS
PROC==PROCA(I)
IF PROC_USER#"" AND (PROC_ACTIVE=255 OR PROC_STATUS C
&(SNOOZED!STATEX)#0) START
P_DEST=(COM_ASYNCDEST+I)<<16
P_SRCE=X'3000D'
P_P1=3; ! DUMMY ACT
PON(P)
FINISH
REPEAT
->WAYOUT
!-----------------------------------------------------------------------
ACTIVITY(9): ! L-C STACK PAGE ARRIVED
I=P_P1&X'FF'; ! EPAGE NO
PROCESS=P_P1>>8&X'FF'
PROC==PROCA(PROCESS)
PQ(PROCESS)=PQ(PROCESS)-1
IF I=0 THEN PROC_LSTAD=P_P2; ! REAL ADDR OF NEW LST
IF P_P3#0 THEN PROC_STATUS=PROC_STATUS!LCSTFAIL;! FAIL FLAG
->WAYOUT UNLESS PQ(PROCESS)=0; ! WAIT UNTIL ALL PAGES HERE
OLDCATSLOT=PROC_CATEGORY
OLDCAT==CATTAB(OLDCATSLOT)
IF PROC_STATUS&LCSTFAIL#0 START ;! FAILED TO READ L-C STACK
! THIS IS NOT RECOVERABLE AS
! PAGETURN WILL HAVE TRIED DRUM
! AND DISC. MUST DESTROY PROCESS
PRINT STRING("LOCAL CONTROLLER STACK READ FAIL, PROCESS ".C
STRINT(PROCESS))
->DESTROY
FINISH
LSTAD=PROC_LSTAD
LSTVAD=(SEG64+LSTAD)!PUBSEG
LST==ARRAY(LSTVAD,LSTF); ! LOCAL SEG TABLE IN SEG 0
LIM=LSTACKLEN*EPAGESIZE-1
K=LSTAD+(LSTLEN*8+X'50')
LST(0)=X'4150038080000001'!LIM<<42!K
! FILL IN PAGE TABLE ENTRIES
! BY DIGGING IN AMT AND STORE TABLES
K=LSTVAD+(LSTLEN*8+X'50')
LCDDP=AMTA(PROC_LAMTX)_DDP; ! DD POINTER FOR PAGE O OF LC
IF PROC_STATUS&STATEX#0 THEN START
PROC_STATUS=PROC_STATUS!!STATEX
IF MONLEVEL&4#0 THEN PERFORM_SNOOZN=PERFORM_SNOOZN+LSTACKLENP
I=LSTACKLENP
FINISH ELSE I=0
CYCLE I=I,1,LSTACKLEN-1
LCSTX=AMTDD(LCDDP+I); ! DRUM OR STORE POINTER
! NB PAGE MUST BE INCORE
! NOT ALL CASES NEED TO BE TESTED
IF SFCFITTED=YES AND LCSTX&DTXBIT#0 THEN C
LCSTX=DRUMT(LCSTX&STXMASK)
L=X'80000001'!STORE(LCSTX)_REALAD
CYCLE J=0,1,EPAGESIZE-1
INTEGER(K+4*EPAGESIZE*I+J<<2)=L+J<<10
REPEAT
REPEAT
LST(1)=X'00F0000080000001'!LCACR<<56!(LSTAD+LSTLEN*8)
PROC_RUNQ=OLDCAT_RQTS1
IF MONLEVEL&1#0 THEN C
UPDISP(PROCESS,11,"R".TOSTRING(PROC_RUNQ+'0'))
MPLEVEL=MPLEVEL+1
IF OLDCATSLOT=0 THEN START ; ! PROCESS BEING CREATED
! LST ENTRIES >=2 ZERO ALREADY
I=LSTVAD+8*LSTLEN; ! PUBLIC ADR OF LOCAL SEG 1
RECORD(I)<-LSSNP1I; ! COPY LOCAL CONTROLLER CONTEXT IN
INTEGER(I+36)=PROCESS; ! PROCESS NO TO BREG &
! HENCE VIA FRIG TO LOCAL CONTRLR
UNINHIBIT(PROCESS+LOCSN0); ! LET CREATE PON GO
FINISH ELSE START
P_DEST=(PROCESS+LOCSN0)<<16!1; ! TO L-C : START NEW RESIDENCE
P_SRCE=X'30000'
P_P1=OLDCAT_EPLIM
P_P2=OLDCAT_RTLIM
!
! IF THE PERSON HAS USED A LOT OF P4 TIME FROM THE TERMINAL PENALISE
! HIM BY GRADUALLY REDUCING HIS RESIDENCE TIMES. IF HE GETS TIME ON
! THE FLY THEN HE AND THE SYSTEM WILL NOT BE AFFECTED
!
IF PROCESS>=FIRST UPROC AND OLDCAT_PRIORITY=4 AND C
PROC_P4TOP4>16 THEN P_P2=P_P2*(300-PROC_P4TOP4)//300
PON(P)
FINISH
IF MULTIOCP=YES START ; *TDEC_SCHEDSEMA; FINISH
RETURN
!-----------------------------------------------------------------------
ACTIVITY(15): ! UPDATE OPER INFO(EVERY 5 SECS)
SCHTICKS=SCHTICKS+1
IF SCHTICKS&3=0 START ; ! @EVERY 20 SECS
I=1; J=0
UNTIL J=COM_USERS OR I>MAXPROCS CYCLE
PROC==PROCA(I)
IF PROC_USER#"" THEN START
IF I>=FIRST UPROC AND PROC_ACTIVE=3*MINSINACTIVE C
AND PROC_STATUS&X'404'=0 START ;! NOT BATCH OR DAP
P_DEST=(I+LOCSN3)<<16+1
P_P1=-1; P_P2=-1
P_P3=X'01570000'; ! SEND INT W
PON(P)
FINISH
PROC_ACTIVE=PROC_ACTIVE+1 UNLESS PROC_ACTIVE>200
J=J+1
FINISH
I=I+1
REPEAT
FINISH
IF MULTIOCP=YES START ; *TDEC_SCHEDSEMA; FINISH
IF MONLEVEL&1#0 THEN START
BEGIN
INTEGERARRAY RUNQ(0:2)
IF MONLEVEL&256 # 0 START
INTEGER SNOOS, PGFLT
SNOOS = 0; PGFLT = 0
FINISH
CYCLE I=0,1,2
RUNQ(I)=0
REPEAT
J=0; I=1
UNTIL J=COM_USERS OR I>MAXPROCS CYCLE
PROC==PROCA(I)
IF PROC_USER#"" THEN START
J=J+1
IF PROC_ACTIVE=255 THEN RUNQ(PROC_RUNQ)=RUNQ(PROC_RUNQ)+1
IF MONLEVEL&256 # 0 START
IF PROC_STATUS&SNOOZED#0 THEN SNOOS = SNOOS+1
IF PROC_STATUS&2 # 0 THEN PGFLT = PGFLT+1
FINISH
FINISH
I=I+1
REPEAT
CYCLE I=1,1,2
DISPLAY TEXT(0,3,I*4-3,STRINT(RUNQ(I))." ")
REPEAT
CYCLE I=1,1,5
DISPLAY TEXT(0,3,I*3+7,STRINT(PQN(I))." ")
REPEAT
DISPLAY TEXT(0,3,27,STRINT(COM_USERS)." ")
I=100*FREE EPAGES//COM_SEPGS
DISPLAY TEXT(0,3,31,STRINT(I)."% ")
IF SFCFITTED=NO OR DRUMSIZE=0 THEN C
DISPLAY TEXT(0,3,36,STRINT(PAGEFREES)." ")
IF MON LEVEL&256 # 0 START ; ! include harvesting?
HARVEST(1,0,20,COM_USERS<<24!RUNQ(1)<<16!RUNQ(2)<<8!PGFLT,C
PQN(1)<<24!PQN(2)<<16!PQN(3)<<8!PQN(4), C
PQN(5)<<24!SUSPN<<16!SNOOS<<8, C
PAGEFREES<<16!UNALLOCEPS,FREEEPAGES<<16) C
IF TRACE = YES AND TRACE EVENTS&(1<<1) # 0
FINISH
END
FINISH
RETURN
!-----------------------------------------------------------------------
ACTIVITY(19): ! SET BITS IN P_P2 INTO STATUS
! OF PROCESS IN P_P1
PROC_STATUS=PROC_STATUS!P_P2
->WAYOUT
ACTIVITY(20): ! CONVERSE OF 19
PROC_STATUS=PROC_STATUS&(¬P_P2)
->WAYOUT
ROUTINE PARE EPAGES
!***********************************************************************
!* CHAIN BACK DOWN CATEGORY TABLE TO FIND THE BEST FIT *
!* AFTER ALLOWING SOME LEEWAY *
!***********************************************************************
CONSTINTEGER LEEWAY=2
CYCLE
NEWCAT==CATTAB(NEWCATSLOT)
IF NEWCAT_LESSP=0 OR C
P_P2+LEEWAY>CATTAB(NEWCAT_LESSP)_EPLIM THEN C
PROC_CATEGORY=NEWCATSLOT AND RETURN
NEWCATSLOT=NEWCAT_LESSP
REPEAT
END
!-----------------------------------------------------------------------
ROUTINE ONPQ
!***********************************************************************
!* PUT PROCESS ONTO APPROPIATE PRIORITY QUEUE AS GIVEN IN THE *
!* CATEGORY TABLE. NORMALLY PROCESSES GO TO THE BACK OF QUEUE BUT *
!* THEY ARE HOLDING A SEMA THEY GO TO THE FRONT *
!***********************************************************************
PTY=CATTAB(PROC_CATEGORY)_PRIORITY
IF PQH(PTY)=0 THEN PQ(PROCESS)=PROCESS ELSE C
PQ(PROCESS)=PQ(PQH(PTY)) AND PQ(PQH(PTY))=PROCESS
PQH(PTY)=PROCESS UNLESS (PROCESS=1 OR PROC_STATUS&1#0) C
AND PQH(PTY)#0
NPQ=NPQ+1; ! COUNT PROCESSES QUEUED
PQN(PTY)=PQN(PTY)+1
IF MONLEVEL&1#0 THEN UPDISP(PROCESS,11,STRPN(PTY))
END
END
!-----------------------------------------------------------------------
ROUTINE PAGETURN(RECORD (PARMF)NAME P)
!***********************************************************************
!* FOR ALL ACTS : P_P1=AMTX<<16!EPX *
!* ACTIVITY 1 : "PAGE IN" REQUEST FROM LOCAL CONTROLLER *
!* : P_P2=RETURNABLE IDENTIFIER *
!* ACTIVITY 2 : "PAGE OUT" REQUEST FROM LOCAL CONTROLLER *
!* : P_P2=FLAGS (BEING THE BOTTOM 4 BITS OF STOREFLAGS) *
!* ACTIVITY 3 : REPLY FROM "EPAGE" WITH EPAGE P_P2=STOREX *
!* ACTIVITY 4 : ZERO "NEW" DISC EPAGE *
!* ACTIVITY 5 : REPLY FROM DISC/WRITE *
!* ACTIVITY 6 : REPLY FROM DRUM/READ ON FAILURE ONLY *
!* ACTIVITY 7 : REPLY FROM DRUM/WRITE *
!* ACTIVITY 8 : REPLY FROM ZERO DISC EPAGE *
!* ACTIVITY 9 : AS ACT 1 BUT PLACE IN SYSTEM SMAC IF POSSIBLE *
!* STORE FLAGS SIGNIFY AS FOLLOWS : *
!* BIT 7 : DISC TRANSFER IN PROGRESS(1)/NOT IN PROGRESS(0) *
!* BIT 6 : DISC INPUT(0)/OUTPUT(1) *
!* BIT 5 : DRUM TRANSFER IN PROGRESS(1)/NOT IN PROGRESS(0) *
!* BIT 4 : DRUM INPUT(0)/OUTPUT(1) *
!* BIT 3 : WRITTEN TO MARKER *
!* BIT 2 : TYPE (0:DISC ONLY, 1:DISC & DRUM) *
!* BIT 1 : MAKE NEW IE DONT PAGE OUT & SUPPLY ZEROPAGE ON REREAD *
!* BIT 0 : RECAPTURABLE(IF ON FREE LIST ON PAGING OUT) *
!***********************************************************************
CONSTINTEGER ZEROPAGEAD=X'804C0000'
INTEGER AEX,AMTX,EPX,DDX,DTX,FLAGS,STOREX,SRCE,CALL,ID,I,B,F,PAGEMASK
IF MONLEVEL&12=12 THEN START
INTEGER IT,IC
FINISH
HALFINTEGERNAME AMTDDDDX
RECORD (AMTF)NAME AMT
RECORD (STOREF)NAME ST
RECORD (PARMXF)NAME PP
IF SFC FITTED=YES THEN START
RECORD (PARMF) TDRUM,TDISC
FINISH ELSE START
RECORD (PARMF) TDISC
FINISH
SWITCH ACTIVITY(0:9)
IF MONLEVEL&2#0 AND KMON&1<<4#0 THEN C
PKMONREC("PAGETURN:",P)
! AEX=P_P1
! AMTX=AEX>>16
! EPX=AEX&X'FFFF'
*LCT_P+4; *LSS_(CTB +2); *ST_AEX
*LUH_0; *USH_16; *SHS_-16; *ST_AMTX
! AMT==AMTA(AMTX)
*LB_AMTX; *MYB_AMTFLEN
*LD_AMTA; *MODD_B ; *STD_AMT
! DDX=AMT_DDP+EPX
*LDTB_X'58000002'; *LB_(DR +4)
*ADB_EPX; *STB_DDX;
! AMTDDDDX==AMTDD(DDX)
*ADB_B ; *LD_AMTDD
*INCA_B ; *STD_AMTDDDDX
IF MULTIOCP=YES THEN START
*INCT_(STORESEMA)
*JCC_8,<SSEMAGOT>
SEMALOOP(STORESEMA,0)
SSEMAGOT:
FINISH
I=AMTDDDDX
! %IF SFCFITTED=NO %OR I&DTXBIT=0 %START;! NO DRUM PAGE ALLOCATED
! STOREX=I&STXMASK
! DTX=-1
! %FINISH %ELSE %START
! DTX=I&STXMASK
! STOREX=DRUMT(DTX)
! %FINISH
IF SFC FITTED=YES THEN START
*LSS_I; *AND_DTXBIT; *JAT_4,<MCL1>
*LB_I; *SBB_DTXBIT; *STB_DTX
*ADB_B ; *LSS_(DRUMT+B )
*ST_STOREX; *J_<MCL2>
MCL1:
FINISH
*LSS_I
*AND_STXMASK; *ST_STOREX
*LSS_-1; *ST_DTX
MCL2:
->ACTIVITY(P_DEST-X'40000')
!-----------------------------------------------------------------------
ACTIVITY(9): ! PAGE INTO SYTEM SMACS
PAGEMASK=COM_SMACS>>16
->ACT1
ACTIVITY(1): ! PAGE-IN (ALLOWS PAGETURN TO BE CALLED)
PAGEMASK=-1
ACT1: IF MONLEVEL&4#0 THEN PERFORM_PTURNN=PERFORM_PTURNN+1
AMT_USERS=AMT_USERS+1
CALL=P_SRCE
SRCE=CALL&X'7FFFFFFF'
ID=P_P2
IF STOREX=STXMASK THEN ->FETCH PAGE
HERE: ! EPAGE ALLOCATED
ST==STORE(STOREX)
! ->NOTRECAP %UNLESS ST_FLAGS=1 %AND ST_USERS=0;! RECAPTURE
! ST_FLAGS=0
! ST_USERS=1
! ST_LINK=0
! F=ST_FLINK
! B=ST_BLINK
! ST_BLINK=AMTX
! ST_FLINK=EPX
*LCT_ST+4; *LSS_(CTB +0)
*USH_-16; *ICP_X'0100'; ! FLAGS=1 & USERS=0
*JCC_7,<NOTRECAP>
*LSS_(CTB +1); *LUH_0
*USH_16; *SHS_-16; *ST_B; ! UNPACK&STORE BOTH LINKS
*LSS_AEX; *LUH_X'00010000'; ! SET FLAGS,USERS&LINK IN ONE
*ST_(CTB +0)
STORE(B)_FLINK=F
STORE(F)_BLINK=B
FREEEPAGES=FREEEPAGES-1
IF FREEEPAGES=0 THEN INHIBIT(5)
IF MONLEVEL&4#0 THEN PERFORM_RECAPN=PERFORM_RECAPN+1
->PAGEIN REPLY
NOTRECAP: ! PAGE MUST BE SHARED
IF ST_USERS=0 THEN START ; ! PAGE-OUT IN PROGRESS
PAGEFREES=PAGEFREES-1
FINISH ELSE START
SHAREDEPS=SHAREDEPS+1
FINISH
ST_USERS=ST_USERS+1
IF MONLEVEL&4#0 THEN PERFORM_PSHAREN=PERFORM_PSHAREN+1;! PAGE SAVED BY SHARING
! IF PAGE IS COMING IN MUST AWAIT
! ITS ARRIVAL. USE PIT LIST
IF ST_FLAGS&X'C0'=X'80' OR C
(SFCFITTED=YES AND ST_FLAGS&X'30'=X'20') START
*JLK_<PUSHPIT>
MUST WAIT: ! FOR FREE PAGE OR TRANSFER
IF MULTIOCP=YES START ; *TDEC_(STORESEMA); FINISH
P_DEST=0; ! IF CALLED MEANS PAGE COMING
RETURN
FINISH
PAGEIN REPLY: ! INTACT COPY IN STORE IF
! RECAPTURED OR PAGING OUT:REPLY
! PAGE IMMEDIATELY AVAILABLE
P_P1=ID; ! IDENTIFIER
P_P2=ST_REALAD&X'0FFFFFFF'; ! MAY BE FLAWED(BIT SET IN TOP)
P_P3=0; ! SUCCESS
IF MONLEVEL&256#0 START
P_P5=ST_USERS
P_P6=ST_FLAGS
FINISH
IF MULTIOCP=YES START ; *TDEC_(STORESEMA); FINISH
IF CALL>0 THEN P_DEST=SRCE AND P_SRCE=X'40001' AND PON(P)
RETURN
FETCH PAGE: ! ALLOCATE EPAGE
IF AMTDDDDX&NEWEPBIT#0 THEN I=0 ELSE I=1;! CLEAR IF NEW
IF FREE EPAGES>0 THEN STOREX=QUICK EPAGE(I,PAGEMASK) AND ->ACT3
P_SRCE=X'40003'
P_P1=AEX
P_P2=I; ! =0 FOR ZEROED
P_P5=SRCE
P_P6=ID
IF LOCSN0<SRCE>>16<=LOCSN1 THEN GET EPN=GET EPN+1
IF MULTIOCP=YES START ; *TDEC_(STORESEMA); FINISH
IF PAGEFREES<=1 AND GETEPN>=MPLEVEL+1-COM_NOCPS THEN C
P_DEST=X'20000' AND PON(P)
P_DEST=X'50000'
PON(P)
P_DEST=0; ! IN CASE PAGETURNED CALLED
RETURN
!-----------------------------------------------------------------------
ACTIVITY(3): ! REPLY FROM GET EPAGE
CALL=1; ! I.E. >0
SRCE=P_P5
ID=P_P6
!
! THERE ARE TWO COMPLICATIONS WHICH MUST BE DEALT WITH BEFORE GOING
! ON TO SET UP THE TRANSFER. FIRSTLY WE MAY GET PAGE 0 MEANING THE SYSTEM
! HAS DEADLOCKED. PASS THIS BACK TO LOCAL CONTROLLER WITH SPECIAL FLAG
! MEANING "PLEASE DEPART AS FAST AS POSSIBLE".
! THE OTHER POSSIBILTY IS THAT MORE THAN ONE PROCESS HAS ASKED
! FOR THIS PAGE WHILE THE FIRST IS AWAITING STORE. CARE IS REQUIRED TO
! AVOID LOSING A PAGE IN THESE CIRCOMSTANCES
!
IF P_P2=0 THEN START ; ! DEADLOCK PAGE ZERO
P_DEST=SRCE!1; ! FAILED TO PRODUCE PAGE
P_P3=-1; ! PLEASE DEPART !
AMT_USERS=AMT_USERS-1
IF MULTIOCP=YES START ; *TDEC_(STORESEMA); FINISH
PON(P)
RETURN
FINISH
IF STOREX#STXMASK THEN START ; ! PAGE HAS ARRIVED BEFORE
P_DEST=X'60000'; ! RETURN EPAGE
P_SRCE=X'80040003'
PON(P)
->HERE
FINISH
STOREX=P_P2
ACT3: ! ENTERS HERE IF PAGE AVAILABLE
ST==STORE(STOREX)
! ST_USERS=1
! ST_LINK=0
! ST_BLINK=AMTX
! ST_FLINK=EPX
*LCT_ST+4; *LSS_AEX
*LUH_X'00010000'; *ST_(CTB +0)
IF AMTDDDDX&NEWEPBIT#0 THEN START ;! NEW EPAGE
AMTDDDDX=STOREX; ! NOT "NEW" & NOT DRUM
ST_FLAGS=8; ! "WRITTEN"
IF MONLEVEL&4#0 THEN PERFORM_NEWPAGEN=PERFORM_NEWPAGEN+1
->PAGEIN REPLY
FINISH
!
! IT IS NECESSARY TO TRANSFER THE PAGE IN FROM DRUM OR DISC
!
IF SFCFITTED=YES AND DTX>=0 START ;! PAGE ON DRUM
DRUMT(DTX)=STOREX
*JLK_<PUSHPIT>
ST_FLAGS=X'20'; ! DRUM->STORE TRANSIT
FLAGS=X'20'; ! DRUM TRANSFER TO BE STARTED
IF MULTIOCP=YES START ; *TDEC_(STORESEMA); FINISH
TDRUM_DEST=X'280001'
TDRUM_SRCE=X'80040006'
TDRUM_P1=AEX
TDRUM_P2=DTX
TDRUM_P3=STOREX
P_DEST=0; ! IN CASE CALLED
->TRANSFER NEEDED
FINISH
! NO DRUMS OR PAGE IS ON DISC
*JLK_<PUSHPIT>
DRUMRF: ! DRUM READ FAILURES REJOIN HERE
AMTDDDDX=STOREX
ST_FLAGS=X'80'; ! DISC->STORE TRANSIT
FLAGS=X'80'; ! DISC TRANSFER NEEDED
IF MULTIOCP=YES START ; *TDEC_(STORESEMA); FINISH
TDISC_DEST=X'210005'; ! DIRECT REPLIES TO LC
TDISC_SRCE=X'80040099'
TDISC_P1=AEX
TDISC_P2=AMT_DA+EPX ;! DISC ADDRESS
TDISC_P3=STOREX
P_DEST=0
->TRANSFER NEEDED
!-----------------------------------------------------------------------
ACTIVITY(6): ! FAILURE REPLY FROM DRUM/READ
IF SFCFITTED=YES THEN START
ST==STORE(STOREX)
BAD DRUM PAGE(DTX); ! DISCARD DRUM PAGE
->DRUMRF; ! AND FETCH FROM DISC
FINISH
!-----------------------------------------------------------------------
ACTIVITY(2): ! PAGE-OUT
ST==STORE(STOREX)
IF ST_USERS=0 OR AMT_USERS=0 START
OPMESS("? PAGEOUT ".STRHEX(AEX))
OPMESS("SRCE ".STRHEX(P_SRCE))
OPMESS("INFORM PDS")
IF MULTIOCP=YES START ; *TDEC_(STORESEMA); FINISH
RETURN
FINISH
AMT_USERS=AMT_USERS-1
ST_FLAGS=ST_FLAGS!P_P2; ! INSERT WRITTEN ETC. MARKERS
ST_USERS=ST_USERS-1
IF ST_USERS>0 THEN START
SHAREDEPS=SHAREDEPS-1
IF MULTIOCP=YES START ; *TDEC_(STORESEMA); FINISH
RETURN
FINISH
PAGEFREES=PAGEFREES+1; ! PAGE ABOUT TO BECOME FREE
IF ST_FLAGS&X'A0'#0 THEN ->MUST WAIT
! PREVIOUS WRITEOUTS STILL GOING
PAGEOUT: ! ACTUALLY PAGE IT OUT
FLAGS=0; ! NO TRANSFER SET UP YET
!
! FIRST UPDATE DISC COPY IF PAGE HAS BEEN UPDATED. THEN CONSIDER
! WHETHER TO UPDATE OR GENERATE A DRUM COPY
!
IF ST_FLAGS&X'0A'=8 THEN START ;! ¬NEW&WRITTEN THEN WRITE TO DISC
IF MONLEVEL&4#0 THEN PERFORM_PAGEOUTN=PERFORM_PAGEOUTN+1
ST_FLAGS=ST_FLAGS!X'C0'; ! DISC TRANSFER OUT BITS
FLAGS=X'C0'; ! TRANSFER INITIATED
AMT_OUTS=AMT_OUTS+1; ! AVOIDS AMT BEING DEALLOCATED
TDISC_DEST=X'210006'; ! STORE->DISC
TDISC_SRCE=X'80040005'
TDISC_P1=AEX
TDISC_P2=AMT_DA+EPX; ! DISC ADDR
TDISC_P3=STOREX
FINISH
IF SFCFITTED=YES THEN START
IF ST_FLAGS&4=0 START ; ! NO DRUM UPDATE
IF DTX>=0 THEN START ; ! RETURN DRUM PAGE(IF ANY)
AMTDDDDX=STOREX
DRUMT(DTX)=DRUMTASL
DRUMTASL=DTX
DRUMALLOC=DRUMALLOC-1
DTX=-1
FINISH
FINISH ELSE START ; ! DRUM UPDATE REQUIRED
IF DTX<0 AND DRUMTASL#DTEND START ;! NOT ON DRUM YET
DTX=DRUMTASL; ! GET DRUM PAGE
DRUMTASL=DRUMT(DRUMTASL)
DRUMALLOC=DRUMALLOC+1
AMTDDDDX=DTXBIT!DTX
DRUMT(DTX)=STOREX
ST_FLAGS=ST_FLAGS!8; ! FORCE DRUM UPDATE
FINISH
FINISH
FINISH
IF SFCFITTED=YES AND DTX>=0 AND ST_FLAGS&8#0 START
! UPDATE DRUM COPY
ST_FLAGS=ST_FLAGS!X'30'; ! DRUM TRANSFER OUT BITS
FLAGS=FLAGS!X'30'; ! TRANSFER INITIATED
AMT_OUTS=AMT_OUTS+1; ! AVOIDS AMT SPACE GOING
TDRUM_DEST=X'280002'; ! DRUM WRITE
TDRUM_SRCE=X'80040007'
TDRUM_P1=AEX
TDRUM_P2=DTX
TDRUM_P3=STOREX
TDRUM_P4=ADDR(AMT_OUTS)
FINISH
IF FLAGS=0 THEN START ; ! NO TRANSFERS INITIATED
IF ST_FLAGS&2#0 THEN AMTDDDDX=NEWEPBIT!STXMASK C
AND ST_FLAGS=0
->REP; ! TO RETURN EPAGE
FINISH
ST_FLAGS=ST_FLAGS&X'F1'
IF MULTIOCP=YES START ; *TDEC_(STORESEMA); FINISH
TRANSFER NEEDED: ! TO COMPLETE PAGETURN
IF FLAGS&X'80'#0 THEN START ; ! DISC TRANSFER TO START
IF MONLEVEL&12=12 THEN START
*LSS_(6); *ST_IC; *LSS_(5); *ST_IT
FINISH
PDISC(TDISC)
IF MONLEVEL&12=12 THEN START
*LSS_(5); *IRSB_IT; *IMYD_1; *ST_TOS
*IAD_(PDISCIT); *ST_(PDISCIT)
*LSD_(PTIT); *ISB_TOS ; *ST_(PTIT)
*LSS_(6); *IRSB_IC; *IMYD_1; *ST_TOS
*IAD_(PDISCIC); *ST_(PDISCIC)
*LSD_(PTIC); *ISB_TOS ; *ST_(PTIC)
PDISCCALLN=PDISCCALLN+1
FINISH
FINISH
IF SFCFITTED=YES AND FLAGS&X'20'#0 START ;! DRUM DIITO
IF MONLEVEL&12=12 START
*LSS_(6); *ST_IC; *LSS_(5); *ST_IT
FINISH
DRUM(TDRUM)
IF MONLEVEL&12=12 THEN START
*LSS_(5); *IRSB_IT; *IMYD_1; *ST_TOS
*IAD_(DRUMIT); *ST_(DRUMIT)
*LSD_(PTIT); *ISB_TOS ; *ST_(PTIT)
*LSS_(6); *IRSB_IC; *IMYD_1; *ST_TOS
*IAD_(DRUMIC); *ST_(DRUMIC)
*LSD_(PTIC); *ISB_TOS ; *ST_(PTIC)
DRUMCALLN=DRUMCALLN+1
FINISH
FINISH
RETURN
!-----------------------------------------------------------------------
ACTIVITY(4): ! ZERO "NEW" EPAGE ON DEACTIVATION
IF MONLEVEL&4#0 THEN PERFORM_PAGEZN=PERFORM_PAGEZN+1
IF MULTIOCP=YES START ; *TDEC_(STORESEMA); FINISH
FLAGS=X'80'; ! DISC WRITE INITIATED
TDISC_DEST=X'210002'; ! WRITEOUT
TDISC_SRCE=X'80040008'; ! REPLY TO ACT 8
TDISC_P1=AEX
TDISC_P2=AMT_DA+EPX
TDISC_P3=ZEROPAGEAD
->TRANSFER NEEDED
!----------------------------------------------------------------------
ACTIVITY(5): ! REPLY FROM DISC/WRITE
ST==STORE(STOREX)
!
! THERE ARE THREE POSSIBLE COURSES OF ACTION ON DISC FAILURE
! 1) FRIG THE USER COUNT SO IT STAYS IN CORE
! 2) TRY AGAIN (UNHELPFUL SINCE 42*8 TRIES ALREADY MADE)
! 3) DO NOTHING AND RELY ON NEXT READ FAILING
! FOR THE MOMENT FOLLOW COURSE 3
!
ST_FLAGS=ST_FLAGS&X'3F'; ! NO DISC TRANSFER
IF P_P2=4 THEN START ; ! WAS ABORTED
IF MONLEVEL&4#0 THEN PERFORM_ABORTN=PERFORM_ABORTN+1
ST_FLAGS=ST_FLAGS!8; ! PUT BACK WRITTEN MARKER
FINISH
AMT_OUTS=AMT_OUTS-1
IF ST_FLAGS&X'A0'#0 OR ST_USERS#0 THEN ->MUST WAIT
IF ST_FLAGS&X'E'#0 THEN ->PAGEOUT
REP: ! RETURN THE EPAGE
ST_FLAGS=ST_FLAGS&1
IF ST_FLAGS=0 START ; ! NOT RECAPTURABLE
IF SFCFITTED=NO OR DTX<0 THEN C
AMTDDDDX=AMTDDDDX!STXMASK ELSE DRUMT(DTX)=STXMASK
FINISH ELSE START
IF SFCFITTED=NO OR DTX<0 THEN ST_LINK=DDX C
ELSE ST_LINK=DDBIT!DTX
FINISH
P_DEST=X'60001'
P_P2=STOREX
PAGEFREES=PAGEFREES-1
IF MONLEVEL&12=12 THEN START
*LSS_(6); *ST_IC; *LSS_(5); *ST_IT
FINISH
RETURN EPAGE(P)
IF MONLEVEL&12=12 THEN START
*LSS_(5); *IRSB_IT; *IMYD_1; *ST_TOS
*IAD_(RETIT); *ST_(RETIT)
*LSD_(PTIT); *ISB_TOS ; *ST_(PTIT)
*LSS_(6); *IRSB_IC; *IMYD_1; *ST_TOS
*IAD_(RETIC); *ST_(RETIC)
*LSD_(PTIC); *ISB_TOS ; *ST_(PTIC)
RETCALLN=RETCALLN+1
FINISH
RAMTX: ! RETURN AMTX IF UNUSED
IF AMT_USERS=0 AND AMT_OUTS=0 THEN START
P_DEST=X'00080003'
P_P2=AMTX
IF MULTIOCP=YES THEN PON(P) ELSE START
IF MONLEVEL&12=12 THEN START
*LSS_(6); *ST_IC; *LSS_(5); *ST_IT
FINISH
ACTIVE MEM(P)
IF MONLEVEL&12=12 THEN START
*LSS_(5); *IRSB_IT; *IMYD_1; *ST_TOS
*IAD_(AMIT); *ST_(AMIT)
*LSD_(PTIT); *ISB_TOS ; *ST_(PTIT)
*LSS_(6); *IRSB_IC; *IMYD_1; *ST_TOS
*IAD_(AMIC); *ST_(AMIC)
*LSD_(PTIC); *ISB_TOS ; *ST_(PTIC)
AMCALLN=AMCALLN+1
FINISH
FINISH
FINISH
IF MULTIOCP=YES START ; *TDEC_(STORESEMA); FINISH
RETURN
!-----------------------------------------------------------------------
ACTIVITY(7): ! REPLY FROM DRUM/WRITE
IF SFCFITTED=YES THEN START
ST==STORE(STOREX)
IF P_P2<0 THEN START ; ! WRITE FAILURE
AMTDDDDX=STOREX; ! RETURN DRUM PAGE
BAD DRUM PAGE(DTX)
DTX=-1
FINISH
!
! NORMALLY DRUM AND DISC TRANSFERS ARE STARTED TOGETHER AND DRUM FINISHES
! FIRST. IN THESE CIRCUMSTANCES THE NEXT 2 LINES ARE DONE IN DRUM AND
! THERE IS NO REPLY. REPLIES COME IF DISC FININISHES FIRST OR DRUM
! TRANSFER FAILS OR THIS IS THE ONLY TRANSFER AS WHEN READONLY PAGE
! WRITTEN TO DRUM ON FIRST ACCESS
!
ST_FLAGS=ST_FLAGS&X'CF'; ! NO DRUM TRANSFER
AMT_OUTS=AMT_OUTS-1
IF ST_FLAGS&X'A0'#0 OR ST_USERS#0 THEN ->MUST WAIT
IF ST_FLAGS&X'E'#0 THEN ->PAGEOUT;! FURTHER UPDATES HAPPENED??
->REP; ! RETURN EPAGE
FINISH
!-----------------------------------------------------------------------
ACTIVITY(8): ! REPLY FROM ZERO DISCPAGE
! IGNORE FAILURES SEE ACT 5
DCLEARS=DCLEARS-1
AMTDDDDX=AMTDDDDX&(¬NEWEPBIT); ! CLEAR NEW MARKER
AMT_OUTS=AMT_OUTS-1
->RAMTX
!----------------------------------------------------------------------
PUSHPIT: ! AWAIT TRANSFER USING THE PIT LIST
I=NEWPPCELL
PP==PARM(I)
PP_DEST=SRCE
PP_SRCE=X'40003'
PP_P1=ID
PP_P2=ST_REALAD&X'0FFFFFFF'; ! MAY BE FLAWED
PP_P3=0; ! SUCCESS FLAG
PP_P6=DTX; ! TELL IF DRUM OR DISC IN DUMP
PP_LINK=ST_LINK
ST_LINK=I
*J_TOS
END
!----------------------------------------------------------------------
IF SFCFITTED = YES THEN START
ROUTINE BAD DRUM PAGE(INTEGER DTX)
!***********************************************************************
!* PUTS A DRUM PAGE ONTO BACK OF FREELIST. FREELIST IS NOT CIRCULAR *
!* TO MINIMISE OVERHEADS SO SOME SEARCHING MAY BE NEEDED HERE. *
!* DRUM ASL BTM POINTS TO LAST CELL UNLESS LIST HAS BEEN COMPLETELY *
!* EMPTY SINCE IPL. RELEVANT SEMA IS ASSUMED CLAIMED! *
!***********************************************************************
INTEGER I,J
IF DRUMTASL=DTEND THEN DRUMTASL=DTX AND ->ENTER
IF DRUMT(DRUMT ASL BTM)#DTEND START
I=DRUMTASL
CYCLE
J=DRUMT(I)
IF J=DTEND THEN EXIT
I=J
REPEAT
DRUMT ASL BTM=I
FINISH
DRUMT(DRUMT ASL BTM)=DTX
ENTER:
DRUMT(DTX)=DTEND
DRUMT ASL BTM=DTX
DRUM ALLOC=DRUM ALLOC-1
END
FINISH
INTEGERFN QUICK EPAGE(INTEGER ZEROED,SMACMASK)
!***********************************************************************
!* CAN BE CALLED BY ANYONE HOLDING STORESEMA TO GET THE NEXT FREE *
!* NEXT FREE EPAGE. GIVES THE STORE INDEX OR -1 *
!***********************************************************************
RECORD (STOREF)NAME ST
CONSTINTEGER CLEARTB=X'58000000'+1024*EPAGESIZE
INTEGER I,STAD,STOREX
IF FREE EPAGES=0 THEN RESULT =-1
STOREX=FSTASL
ST==STORE(STOREX)
IF SSERIES=YES OR RECONFIGURE=NO OR SMACMASK=-1 START
FSTASL=STORE(FSTASL)_FLINK
STORE(FSTASL)_BLINK=0
FINISH ELSE START
CYCLE
IF 1<<(ST_REALAD>>22&15)&SMACMASK#0 START
IF SMAC RCONFIG#0 AND FSTASL#STOREX#BSTASL START
STORE(ST_FLINK)_BLINK=0
STORE(ST_BLINK)_FLINK=0
STORE(BSTASL)_FLINK=FSTASL
STORE(FSTASL)_BLINK=BSTASL
BSTASL=ST_BLINK
FSTASL=ST_FLINK
FINISH ELSE START
STORE(ST_FLINK)_BLINK=ST_BLINK
STORE(ST_BLINK)_FLINK=ST_FLINK
FINISH
EXIT
FINISH
STOREX=ST_FLINK
IF STOREX=0 THEN RESULT =-1
ST==STORE(STOREX)
REPEAT
FINISH
ST_USERS=1
IF ST_FLAGS=1 THEN START ; ! RECAPTURABLE FLAG
I=ST_LINK
IF SFC FITTED=NO OR I&DDBIT=0 THEN C
AMTDD(I)=AMTDD(I)!STXMASK ELSE C
I=I&(¬DDBIT) AND DRUMT(I)=STXMASK
ST_FLAGS=0
FINISH
IF ZEROED=0 THEN START ; ! CLEAR TO ZERO
STAD=PUBSEG!(SEG64+ST_REALAD)
*LDTB_CLEARTB
*LDA_STAD
*MVL_L =DR ,0,0
FINISH
FREEEPAGES=FREEEPAGES-1
IF FREEEPAGES=0 THEN INHIBIT(5)
RESULT =STOREX
END
ROUTINE GET EPAGE(RECORD (PARMF)NAME P)
!***********************************************************************
!* CAN BE PONNED (BUT NOT CALLED!) TO PROVIDE AN EPAGE. *
!* REPLIES HAVE STORE INDEX IN P_P2 AND VIRTADDR IN P_P4 *
!***********************************************************************
INTEGER STOREX,PS
IF MULTIOCP=YES THEN START
*INCT_(STORESEMA)
*JCC_8,<SEMACL>
SEMALOOP(STORESEMA,0)
SEMACL:
FINISH
IF FREEEPAGES=0 THEN START ; ! SHOULD ONLY OCCUR IN MULTIOCPS
IF MULTIOCP=YES START ; *TDEC_(STORESEMA); FINISH
PON(P); ! SERVICE NOW INHIBITED
RETURN
FINISH
IF MONLEVEL&2#0 AND KMON&1<<5#0 THEN C
PKMONREC("GET EPAGE:",P)
STOREX=QUICK EPAGE(P_P2,-1)
P_P2=STOREX; ! LEAVE P1 & P3 & P5 & P6 INTACT
P_P4=(STORE(STOREX)_REALAD+SEG64)!PUBSEG
P_DEST=P_SRCE
P_SRCE=X'50000'
PS=P_DEST
IF PS=X'40003' THEN PS=P_P5
IF LOCSN0<PS>>16<=LOCSN1 THEN GETEPN=GETEPN-1
IF MULTIOCP=YES START ; *TDEC_(STORESEMA); FINISH
PON(P)
END
!-----------------------------------------------------------------------
INTEGERFN NEW EPAGE
!***********************************************************************
!* HANDS OUT A NEW EPAGE TO EXTEND A VITAL RESIDENT TABLE *
!***********************************************************************
INTEGER I
IF MULTIOCP=YES THEN START
*INCT_(STORESEMA)
*JCC_7,<USE SPARE>; ! CAN NOT LOOP HERE
FINISH
IF FREE EPAGES>0 THEN START
I=QUICK EPAGE(0,COM_SMACS>>16);! ZEROED & IN SYSTEM SMAC
IF I<0 THEN ->USE SPARE
IF MULTI OCP=YES START ; *TDEC_(STORESEMA); FINISH
STORE(I)_USERS=255
RESULT =STORE(I)_REALAD&X'0FFFFFFF';! MAY BE FLAWED
FINISH
USE SPARE: ! try emergency spare page
IF MULTIOCP=YES START ; *TDEC_(STORESEMA); FINISH
IF SPSTOREX>0 START
I=STORE(SPSTOREX)_REALAD; ! CANNOT BE FLAWED(SEE RETURNEPAGE)
SPSTOREX=0
RESULT =I
FINISH
RESULT =-1
END
!-----------------------------------------------------------------------
ROUTINE RETURN EPAGE(RECORD (PARMF)NAME P)
!***********************************************************************
!* PUT AN EPAGE BACK ON THE FREE LIST. FLAWED PAGES ARE ABANDONED *
!* IF THE PAGE IS MARKED AS 'RECAPTURABLE' IT GOES TO THE BACK OF *
!* OF THE FREELIST OTHERWISE IT GOES ON THE FRONT. THIS GIVES THE *
!* MAXIMUM CHANCES OF RECAPTURING ANYTHING USEFUL *
!***********************************************************************
CONSTINTEGER CLEARTB=X'58000000'+1024*EPAGESIZE
RECORD (STOREF)NAME ST
INTEGER I,STOREX,STAD,ACT
ACT=P_DEST&1
IF MULTIOCP=YES AND ACT=0 THEN START
*INCT_(STORESEMA)
*JCC_8,<SEMACL>
SEMALOOP(STORESEMA,0)
SEMACL:
FINISH
IF MONLEVEL&2#0 AND KMON&1<<6#0 THEN C
PKMONREC("RETURNEPAGE:",P)
STOREX=P_P2
ST==STORE(STOREX)
ST_USERS=0
! IF PAGE IS IN SMAC BEING
! RECONFIGURED THEN DISCARD
IF RECONFIGURE=YES AND 0#SMAC RCONFIG=ST_REALAD>>22&15 START
SMAC RPAGES=SMAC RPAGES-1
*JLK_<STOP RECAPTURE>
->RETURN
FINISH
IF ST_REALAD<=0 THEN START
IF STOREX=0 THEN MONITOR("PAGE 0 RETURNED???")
OPMESS("PAGE ".STRINT(STOREX)." ABANDONED")
*JLK_<STOP RECAPTURE>
->RETURN
FINISH
!
! REPLENSISH THE SPARE PAGE FROM THE ALLOWED SYSTEM SMACE ONLY
!
IF SPSTOREX=0 AND (SSERIES=YES OR RECONFIGURE=NO OR C
COM_SMACS&X'10000'<<(ST_REALAD>>22&15)#0) START
*JLK_<STOP RECAPTURE>
STAD=VIRTAD+ST_REALAD; ! CANNOT BE FLAWED
*LDTB_CLEARTB
*LDA_STAD
*MVL_L =DR ,0,0
SPSTOREX=STOREX
FINISH ELSE START
IF ST_FLAGS&1#0 START ; ! RECAPTURABLE TO BACK
ST_FLINK=0
ST_BLINK=BSTASL
STORE(BSTASL)_FLINK=STOREX
BSTASL=STOREX
FINISH ELSE START ; ! NOT RECAPTURABLE ON FRONT
ST_BLINK=0
ST_FLINK=FSTASL
STORE(FSTASL)_BLINK=STOREX
FSTASL=STOREX
FINISH
IF FREEEPAGES=0 THEN UNINHIBIT(5)
FREEEPAGES=FREEEPAGES+1
FINISH
RETURN:
IF MULTIOCP=YES AND ACT=0 START ; *TDEC_(STORESEMA); FINISH
RETURN
STOP RECAPTURE: ! JLK SUBROUTINE TO BREAK LINK
IF ST_FLAGS=1 THEN START ; ! RECAPTURABLE
I=ST_LINK
IF SFC FITTED=NO OR I&DDBIT=0 THEN C
AMTDD(I)=AMTDD(I)!STXMASK ELSE C
I=I&(¬DDBIT) AND DRUMT(I)=STXMASK
ST_FLAGS=0
FINISH
*J_TOS
END
!-----------------------------------------------------------------------
ROUTINE DEADLOCK
!***********************************************************************
!* CALLED WHEN THE NUMBER OF PROCESSES NOT WAITING ON A PAGE FAULT *
!* IS LESS THAN THE NUMBER OF OCPS TO EXECUTE THEM.THIS ROUTINE GOES*
!* DOWN THE LIST OF GET EPAGES UNTIL IT FIND A PROCESS AND GIVES IT *
!* PAGE ZERO AS A SIGNAL TO DEPART. NEEDS STORE SEMA TO CHECK FOR *
!* A DEADLOCK AND THE MAINQSEMA FOR SUPPOFFING *
!***********************************************************************
RECORD (PARMF) P
INTEGER I,N,K
IF MULTIOCP=YES THEN START
*INCT_(STORESEMA)
*JCC_8,<SEMAGOT>
SEMALOOP(STORESEMA,0)
SEMAGOT:
FINISH
UNLESS PAGEFREES<=1 AND GETEPN>=MPLEVEL+1-COM_NOCPS START
IF MULTIOCP=YES START ; *TDEC_(STORESEMA); FINISH
RETURN ; ! NOT A TRUE DEADLOCK
FINISH
N=GETEPN
GETEPN=GETEPN-1; ! ASSUMES WE WILL CURE DEADLOCK
IF MULTIOCP=YES START ; *TDEC_(STORESEMA); FINISH
CYCLE I=1,1,4*N; ! ALLOW FOR PLENTY OF OTHER RQS
SUPPOFF(SERVA(5),P); ! TAKE A GET PAGE REQUEST
IF (P_SRCE=X'40003' AND LOCSN0<P_P5>>16<=LOCSN1) OR C
LOCSN0<P_SRCE>>16<=LOCSN1 START
! 4-3=PAGEIN. P_P5 IS PT SRCE
! LC ACT 9 IS GET PAGE FOR PTS
! LC ACTF IS GET LOCKED PAGE
P_DEST=P_SRCE
P_SRCE=X'50000'; ! AS FROM GET EPAGE
P_P2=0; ! PAGE 0
P_P4=-1; ! WHICH HAS REALAD OF -1
PON(P)
PRINTSTRING("DEADLOCK RECOVERED
")
K=1+COM_SEPGS//100; ! 1% OF STORE
IF K>OVERALLOC THEN K=OVERALLOC
OVERALLOC=OVERALLOC-K
UNALLOCEPS=UNALLOCEPS-K
RETURN
FINISH
PON(P); ! NOT SUITABLE: RETURN TO QUEUE
REPEAT
GETEPN=GETEPN+1
OPMESS("DEADLOCK UNRECOVERABLE")
END
ROUTINE OVERALLOC CONTROL
!***********************************************************************
!* THIS ROUTINE IS KICKED PERIODICALLY TO TRY TO INCREASE THE STORE *
!* OVERALLOCATION. EACH TIME THERE IS A DEADLOCK THE OVERALLOCATION *
!* IS DECREASED. SYSTEM SHOULD SELF TUNE TO OCCAISIONAL DEADLOCKS *
!* (1 EVERY 10-15MINS) WHICH IS OPTIMAL STORE USE. *
!***********************************************************************
INTEGER K
K=1+COM_SEPGS//400; ! 0.25% OF STORE
IF OVERALLOC+K<MAX OVERALLOC THEN OVERALLOC=OVERALLOC+K AND C
UNALLOCEPS=UNALLOCEPS+K
END
!-----------------------------------------------------------------------
ROUTINE ACTIVE MEM(RECORD (PARMF)NAME P)
!***********************************************************************
!* CONTROLS THE ALLOCATION OF ACTIVE MEMORY *
!* ACTIVITY 0 INITIALISE *
!* ACTIVITY 1 GET AMT FOR SPECIFIED DISC ADDRESSS *
!* ACTIVITY 2 RETURN AMT FOR DITTO *
!* ACTIVITY 3 COMPLETE RETURN OF AMT AFTER TRANSFER COMPLETED *
!* ACTIVITY 4 ORGANISE TIMEOUT OF ACTIVE MEM *
!* ACTIVITY 5 CHECK IF DISC ADDRESS IS STILL ACTIVE *
!***********************************************************************
ROUTINESPEC COLLECT DD GARBAGE
ROUTINESPEC APPENDAMTA(INTEGER NEWSPACE,REALAD)
ROUTINESPEC APPENDAMTDD(INTEGER NEWSPACE,REALAD)
ROUTINESPEC DDASLALLOC(INTEGER FROM,TO)
ROUTINESPEC DEALLOCAMT
ROUTINESPEC DEALLOCDD(INTEGER DDX,LEN)
INTEGER HASH,DDX,GARB,AMTX,SRCE,ID,DA,LEN,MASK,REALAD,FREEMAX,I,J,K,CN
INTEGER DACT
IF MONLEVEL&12=12 THEN START
INTEGER IT,IC
FINISH
LONGINTEGER LIM
RECORD (PROCF)NAME PROC
RECORD (PARMF) Q
OWNHALFINTEGERARRAY AMTHASH(0:511)=0(512)
RECORD (AMTF)NAME AMT
OWNINTEGERARRAYNAME AMTAPT
OWNINTEGER AMTASIZE,AMTASL,AMTANEXT=0
OWNINTEGER AMTDDSIZE,AMTDDNEXT=0
OWNINTEGERARRAYNAME AMTDDPT
OWNINTEGERARRAY DDASL(1:MAXBLOCK)=0(MAXBLOCK)
SWITCH ACT(0:6)
IF MONLEVEL&2#0 AND KMON&1<<8#0 THEN C
PKMONREC("ACTIVEMEM:",P)
SRCE=P_SRCE
ID=P_P1
IF MULTIOCP=YES THEN START
*INCT_(STORESEMA)
*JCC_8,<ASEMAGOT>
SEMALOOP(STORESEMA,0)
ASEMAGOT:
FINISH
DACT=P_DEST&X'F'
->ACT(DACT)
!-----------------------------------------------------------------------
ACT(0): ! INITIALISE
IF MULTIOCP=YES START ; *TDEC_(STORESEMA); FINISH
REALAD=NEW EPAGE
LIM=MAXAMTAK-1
PST(AMTASEG)=X'4110038080000001'!LIM<<42!REALAD
IF MULTIOCP=YES THEN PST(AMTASEG)=PST(AMTASEG)!NONSLAVED
!
! SET UP PUBLIC SEGMENT 'AMTASEG' FOR AMTA RECORD ARRAY WITH
! PAGE TABLE FOR IT AT BEGINNING OF FIRST EPAGE OF ITSELF
!
AMTAPT==ARRAY((REALAD+SEG64)!PUBSEG,PTF)
APPENDAMTA(EPAGESIZE<<10-MAXAMTAK<<2,REALAD)
REALAD=NEW EPAGE
LIM=MAXAMTDDK-1
!
! PUBLIC SEGMENT 'AMTDDSEG' FOR AMTDD ARRAY WITH
! PAGE TABLE FOR IT AT BEGINNING OF FIRST EPAGE OF ITSELF
!
PST(AMTDDSEG)=X'4110038080000001'!LIM<<42!REALAD
IF MULTIOCP=YES THEN PST(AMTDDSEG)=PST(AMTDDSEG)!NONSLAVED
AMTDDPT==ARRAY((REALAD+SEG64)!PUBSEG,PTF)
APPENDAMTDD(EPAGESIZE<<10-MAXAMTDDK<<2,REALAD)
IF SFCFITTED=YES THEN START
IF DRUMSIZE=0 THEN DRUMTASL=DTEND ELSE START
CYCLE I=0,1,DRUMSIZE-2
DRUMT(I)=I+1
REPEAT
DRUMT ASL BTM=DRUMSIZE-1
DRUMT(DRUMT ASL BTM)=DTEND
DRUMTASL=0
DRUMALLOC=0
IF MONLEVEL&1#0 THEN START
DISPLAY TEXT(0,2,36,"DRMF")
DISPLAY TEXT(0,3,36," 99%")
FINISH
FINISH
FINISH
RETURN
!-----------------------------------------------------------------------
ACT(1): ! GET AMTX
DA=P_P2
LEN=P_P3&(MAXBLOCK-1)+1
MASK=P_P3; ! "NEW" EPAGE BIT MASK (TOP BITS)
*LSS_DA; *IMDV_509; *LSS_TOS ; *AND_511; *ST_HASH
AMTX=AMTHASH(HASH)
WHILE AMTX#0 CYCLE ; ! SCAN DOWN LIST
AMT==AMTA(AMTX)
IF AMT_DA=DA THEN START ; ! THIS DA ALREADY IN TABLE
IF AMT_LEN#LEN THEN START
IF AMT_USERS#0 THEN AMTX=-3 AND ->RETURN
IF AMT_LEN<LEN THEN AMTX=0 AND ->RETURN;! EXTEND ?
CYCLE I=AMT_DDP+LEN,1,AMT_DDP+AMT_LEN-1
! RETURN IF STILL IN USE
IF AMTDD(I)&STXMASK#STXMASK THEN C
AMTX=0 AND ->RETURN
REPEAT
DEALLOCDD(AMT_DDP+LEN,AMT_LEN-LEN)
AMT_LEN=LEN
FINISH
IF AMT_USERS=0 AND AMT_OUTS>0 START
CYCLE I=AMT_DDP,1,AMT_DDP+LEN-1
IF AMTDD(I)&NEWEPBIT#0 THEN AMTX=-4 AND ->RETURN
REPEAT
FINISH
AMT_USERS=AMT_USERS+1; ! USERS
->RETURN
FINISH
AMTX=AMT_LINK
REPEAT
IF AMTASL=0 THEN START ; ! NO AMT CELLS FREE
! TRY TO APPEND EPAGE TO AMTA
AMTX=-1
IF AMTANEXT>=MAXAMTAK THEN ->RETURN;! ALREADY MAX SIZE
REALAD=NEW EPAGE
IF REALAD<=0 THEN ->RETURN; ! NO FREE EPAGE
APPENDAMTA(EPAGESIZE<<10,REALAD)
FINISH
! ALLOCATE NEW SPACE
GARB=0; ! NOT GARBAGE COLLECTED YET
CYCLE
IF DDASL(LEN)#0 THEN START
DDX=DDASL(LEN)
DDASL(LEN)=AMTDD(DDX)
->SETAMT
FINISH
! TAKE SPACE FROM A BIGGER HOLE
I=LEN+1
WHILE I<=MAXBLOCK CYCLE
DDX=DDASL(I)
IF DDX#0 THEN START
DDASL(I)=AMTDD(DDX)
AMTDD(DDX+LEN)=DDASL(I-LEN)
DDASL(I-LEN)=DDX+LEN
->SETAMT
FINISH
I=I+1
REPEAT
! NO HOLES BIG ENOUGH
IF GARB#0 THEN AMTX=-2 AND ->RETURN;! STILL NOT ENOUGH SPACE
COLLECT DD GARBAGE
! TRY TO APPEND EPAGE TO AMTDD
IF FREEMAX<32 AND AMTDDNEXT<MAXAMTDDK START
REALAD=NEW EPAGE
IF REALAD>0 THEN APPENDAMTDD(EPAGESIZE<<10,REALAD)
FINISH
REPEAT
SETAMT: ! PUSHDOWN NEW AMT CELL
AMTX=AMTASL
AMT==AMTA(AMTX)
AMTASL=AMT_LINK
AMT_DA=DA
AMT_DDP=DDX
AMT_USERS=1
AMT_LEN=LEN
AMT_OUTS=0
AMT_LINK=AMTHASH(HASH)
AMTHASH(HASH)=AMTX
CYCLE I=DDX,1,DDX+LEN-1
AMTDD(I)=MASK>>31<<15!STXMASK
REPEAT
RETURN:
P_P1=ID
P_P2=AMTX
IF MULTIOCP=YES START ; *TDEC_(STORESEMA); FINISH
IF SRCE>0 THEN P_DEST=SRCE AND P_SRCE=X'80001' AND PON(P)
RETURN
!-----------------------------------------------------------------------
ACT(2): ! RETURN AMTX IN P_P2
! P_P3=0 FILE KEPT #0 DESTROY
BEGIN
INTEGERARRAY CLEARS(0:MAXBLOCK)
AMTX=P_P2
AMT==AMTA(AMTX)
IF AMT_DA=X'FF000000' OR AMT_DA=0 THEN OPMESS("RETURNED AMT??")
CN=0; ! NO CLEARS AS YET
IF P_P3=0 THEN START ; ! FILE BEING KEPT
CYCLE I=AMT_DDP,1,AMT_DDP+AMT_LEN-1;! CHECK "NEW" EPAGE BIT
! "NEW" SECTIONS NEVER SHARED
IF AMTDD(I)&NEWEPBIT#0 THEN START
CLEARS(CN)=AMTX<<16!(I-AMT_DDP)
CN=CN+1
AMT_OUTS=AMT_OUTS+1
FINISH
REPEAT
FINISH
AMT_USERS=AMT_USERS-1
!
! NOW IF THERE WERE ANY CLEARS SET THEM OFF. THIS IS DONE LATER
! SO THAT THE STORE SEMA CAN BE FREE ON DUALS. IMPORTANT AS IT MAY
! BE NECESSARY TO EXTEND THE PARM ASL IF VERY LARGE NO OF CLEARS
! ARE REQUIRED
!
P_P6=CN; ! SO L-C CAN ACCOUNT FOR CLEARS
IF CN>0 START
DCLEARS=DCLEARS+CN
IF MULTIOCP=YES START ; *TDEC_(STORESEMA); FINISH
Q_DEST=X'40004'; ! ZERO PAGE
Q_SRCE=X'80080002'
CYCLE I=0,1,CN-1
Q_P1=CLEARS(I)
PON(Q); ! PON to limit call depth & so
REPEAT ; ! avoid possible LC stack o'flow
FINISH
END
IF CN>0 THEN RETURN ; ! SEMA ALREADY RELEASED
! IF THERE WERE NO CLEARS THEN
! DROP THROUGH INTO ACT 3
!-----------------------------------------------------------------------
ACT(3): ! RETURN AMTX AFTER TRANFERS END
AMTX=P_P2
AMT==AMTA(AMTX)
UNLESS AMT_USERS=AMT_OUTS=0 AND AMT_DA#X'FF000000' START
IF MULTIOCP=YES START ; *TDEC_(STORESEMA); FINISH
RETURN ; ! AWAIT TRANSFERS
FINISH
DEALLOCDD(AMT_DDP,AMT_LEN)
DEALLOCAMT
IF MULTIOCP=YES START ; *TDEC_(STORESEMA); FINISH
RETURN
!-----------------------------------------------------------------------
ACT(4): ! ENTERED EVERY 10 SECS
IF MULTIOCP=YES START ; *TDEC_(STORESEMA); FINISH
IF SFCFITTED=YES AND DRUMSIZE#0 THEN C
I=100*DRUMALLOC//DRUMSIZE ELSE I=0
IF SFCFITTED=YES AND MONLEVEL&1#0 AND DRUMSIZE#0 THEN C
DISPLAY TEXT(0,3,37,STRINT(100-I)."% ")
RESIDENCES=MINRESIDENCES+(99-I)//2
RESIDENCES=MAXRESIDENCES IF RESIDENCES>MAXRESIDENCES
!
! EXAMINE PROCESS LIST EVERY 10 SECS. ALL PROCESSES THAT HAVE
! BEEN INACTIVE FOR MORE THAN 2 MINS ARE TOLD TO DEACTIVATE
! THEIR ACTIVE MEMORY FREEING DRUM & TABLESPACE
!
P_SRCE=X'80000'
K=(RESIDENCES-MINRESIDENCES+2)>>1;! HOW LONG CAN HE HANG ON TO DRUM
! MAX 7 MIN 1 IN 20 SEC TICKS
I=1; J=0
UNTIL J=COM_USERS OR I>MAXPROCS CYCLE
PROC==PROCA(I)
IF PROC_USER#"" THEN START
IF PROC_STATUS&AMTLOST=0 AND K<PROC_ACTIVE<=200 START
P_DEST=(I+LOCSN3)<<16; ! ASYNCH ACT 0
P_P1=2; ! RELEASE ACTIVE MEMORY
PON(P)
EXIT
FINISH
J=J+1
FINISH
I=I+1
REPEAT
RETURN
!-----------------------------------------------------------------------
ACT(5): ! CHECK DISC ADDRESS ACTIVE
ACT(6): ! TRAP ! VALIDATE BULKMOVE
DA=P_P1
*LSS_DA; *IMDV_509; *LSS_TOS ; *AND_511; *ST_HASH
AMTX=AMTHASH(HASH)
P_DEST=0
WHILE AMTX#0 CYCLE
AMT==AMTA(AMTX)
IF AMT_DA=DA THEN START
IF AMT_OUTS#0 OR (MULTIOCP=YES AND AMT_USERS=0) C
THEN P_DEST=1 AND EXIT
! HAVE BEATEN PONNED DEALOCATE
! IN MULTIOCP CASE
P_DEST=-1; ! REPORT BACK TO DIRECTOR
EXIT
FINISH
AMTX=AMT_LINK
REPEAT
IF MULTIOCP=YES START ; *TDEC_(STORESEMA); FINISH
! %IF DACT=6 %AND P_DEST#0 %START; ! TRAP SPRING
! OPMESS("ACTIVE BM--CALL PDS")
! OPMESS("DA=".STRHEX(DA))
! I=(P_SRCE>>16-LOCSN0)&(MAXPROCS-1)
! OPMESS("USER=".PROCA(I)_USER)
! %FINISH
RETURN
!-----------------------------------------------------------------------
ROUTINE COLLECT DD GARBAGE
!***********************************************************************
!* GARBAGE COLLECT AMTDD TO COUNTERACT FRAGMENTATION *
!* IN DUALS HALT OTHER OCP OR SEMA WILL TIMEOUT ! *
!***********************************************************************
INTEGER I
! CLEAR ALL FREE HOLES TO ZERO
IF MULTIOCP=YES AND COM_NOCPS>1 THEN HALT OTHER OCP
CYCLE I=1,1,MAXBLOCK
WHILE DDASL(I)#0 CYCLE
J=DDASL(I)
DDASL(I)=AMTDD(J)
AMTDD(J)=0
REPEAT
REPEAT
FREEMAX=0
I=AMTDDSIZE+1
ALLOC:WHILE I>1 CYCLE
I=I-1
IF AMTDD(I)=0 THEN START
DDX=I
WHILE I>1 CYCLE
I=I-1
IF AMTDD(I)#0 THEN DDASLALLOC(I+1,DDX) AND ->ALLOC
REPEAT
DDASLALLOC(1,DDX)
EXIT
FINISH
REPEAT
GARB=1
IF MULTIOCP=YES AND COM_NOCPS>1 THEN RESTART OTHER OCP(0)
END
ROUTINE APPENDAMTA(INTEGER NEWSPACE,REALAD)
!***********************************************************************
!* APPEND A NEW EPAGE AT "REALAD" TO THE AMT TABLE. ADD THE LAST *
!* NEWSPACE BYTES TO THE TABLE. NEWSPACE=EPAGESIZE FOR ALL EPAGES *
!* EXCEPT THE FIRST WHICH HOLDS THE PAGETABLE ALSO. *
!***********************************************************************
INTEGER FIRSTNEW,I,J
J=X'80000001'!REALAD
CYCLE I=0,1,EPAGESIZE-1
AMTAPT(I+AMTANEXT)=J+I<<10
REPEAT
AMTANEXT=AMTANEXT+EPAGESIZE
FIRSTNEW=AMTASIZE+1
AMTASIZE=AMTASIZE+NEWSPACE//AMTFLEN;! MIGHT WASTE THE ODD RECORD
CYCLE I=FIRSTNEW,1,AMTASIZE-1
AMTA(I)_LINK=I+1
REPEAT
AMTA(AMTASIZE)_LINK=AMTASL
AMTASL=FIRSTNEW
END
!-----------------------------------------------------------------------
ROUTINE APPENDAMTDD(INTEGER NEWSPACE,REALAD)
!***********************************************************************
!* APPEND A NEW EPAGE TO AMTDD. PARAMETERS AS FOR APPENDAMTA *
!***********************************************************************
INTEGER FIRSTNEW,I,J
J=X'80000001'!REALAD
CYCLE I=0,1,EPAGESIZE-1
AMTDDPT(I+AMTDDNEXT)=J+I<<10
REPEAT
AMTDDNEXT=AMTDDNEXT+EPAGESIZE
FIRSTNEW=AMTDDSIZE+1
AMTDDSIZE=AMTDDSIZE+NEWSPACE//DDFLEN
FREEMAX=0
DDASLALLOC(FIRSTNEW,AMTDDSIZE)
END
!-----------------------------------------------------------------------
ROUTINE DDASLALLOC(INTEGER FROM,TO)
!***********************************************************************
!* CHOP UP AMTDD (FROM:TO) INTO AS MANY MAXIMUM SIZED BLOCKS *
!* AS POSSIBLE AND A LEFTOVER *
!***********************************************************************
INTEGER LEN
CYCLE
LEN=TO-FROM+1
IF LEN>=MAXBLOCK THEN START
AMTDD(FROM)=DDASL(MAXBLOCK)
DDASL(MAXBLOCK)=FROM
FREEMAX=FREEMAX+1
FROM=FROM+MAXBLOCK
FINISH ELSE START
IF FROM<=TO THEN C
AMTDD(FROM)=DDASL(LEN) AND DDASL(LEN)=FROM
RETURN
FINISH
REPEAT
END
!-----------------------------------------------------------------------
ROUTINE DEALLOCAMT
!***********************************************************************
!* DEALLOCATE AMT ENTRY AND RETURN TO FREE LIST. RESETTING THE HASH *
!* CHAIN IS THE ONLY PROBLEM *
!***********************************************************************
INTEGER HASH,DA
RECORD (AMTF)NAME AMT
HALFINTEGERNAME PTR
AMT==AMTA(AMTX)
DA=AMT_DA
AMT_DA=X'FF000000'
*LSS_DA; *IMDV_509; *LSS_TOS ; *AND_511; *ST_HASH
PTR==AMTHASH(HASH)
PTR==AMTA(PTR)_LINK WHILE PTR#AMTX
PTR=AMT_LINK; ! RESET CHAIN OMITTING THIS ENTRY
AMT_LINK=AMTASL; ! RETURN CELL
AMTASL=AMTX
END
!-----------------------------------------------------------------------
ROUTINE DEALLOCDD(INTEGER DDX,LEN)
!***********************************************************************
!* DEALLOCATE A SECTION OF AMTDD. DIFFICULT IN DUALS AS STORE *
!* SEMA IS NEEDED TO CLEAR BACKLINKS *
!***********************************************************************
INTEGER I,J,DTX
CYCLE I=DDX,1,DDX+LEN-1
IF SFCFITTED=YES AND AMTDD(I)&DTXBIT#0 START ;! RETURN DRUM PAGE
DTX=AMTDD(I)&STXMASK
J=DRUMT(DTX)
IF J#STXMASK THEN STORE(J)_FLAGS=0
DRUMT(DTX)=DRUMTASL
DRUMTASL=DTX
DRUMALLOC=DRUMALLOC-1
FINISH ELSE START
J=AMTDD(I)&STXMASK
IF J#STXMASK THEN STORE(J)_FLAGS=0
FINISH
AMTDD(I)=0
REPEAT
I=DDASL(LEN)
AMTDD(DDX)=I
DDASL(LEN)=DDX
END
!-----------------------------------------------------------------------
END
!-----------------------------------------------------------------------
IF MONLEVEL&X'3C'#0 THEN START
EXTRINSICLONGINTEGER SEMATIME
ROUTINE TIMEOUT
!***********************************************************************
!* PRINT OUT THE SESSION TIMING MEASUREMENTS *
!***********************************************************************
CONSTSTRING (15)ARRAY SERVROUT(0:LOCSN0+3)="IDLE TIME",
"NOWORK TIME","DEADLOCK RCVRY","SCHEDULE",
"PAGETURN","GET EPAGE","RETURN EPAGE","FILE SEMAPHORE","ACTIVE MEM",
"","ELAPSEDINT","UPDATE TIME","DPONPUTONQ","TURNON ER",
"ACTIVEMEM(POLL)","SCHEDULE(OPER)","OVERALLOC CNTRL",""(14),
"DAP DRIVER",
"DISC","DISC TRANSFERS","DISC INTERRUPT","","MOVE REQUESTS",
"MOVE TRANSFERS",""(2),
"DRUM TRANSFERS","CSU","DRUM INTERRUPT",""(5),"GPC REQUESTS","TAPE",
"OPER","LP ADAPTOR","CR ADAPTOR","CP ADAPTOR","PRINTER",
"COMMS CONTROL","COMBINE","FEP ADAPTOR","GPC INTERRUPT",
""(2),"BMREP","COMREP",""(2),"LOCAL CONTROL","FOREGRND USERS",
"BACKGRND USERS"
INTEGER I,J,K
LONGREAL PERIOD, TOTAL, IDLETIME, PROCTIME, SERVTIME
STRING (15) S
STRING (31)FNSPEC STRPRINT(LONGREAL X,INTEGER A,B)
IF MULTIOCP=YES THEN RESERVE LOG
IF MONLEVEL&4#0 THEN START
PERIOD=CLOCK-PERFORM_CLOCK0
I=ADDR(COM_DATE0)+3
NEWPAGE
PRINT STRING("
EMAS2900 SUP".SUPID." TIMING MEASUREMENTS ".STRING(I)." ".STRING(I+12)."
PERIOD=".STRPRINT(PERIOD/1000000,1,3)." SECS")
IF MULTIOCP=YES THEN PERIOD=PERIOD*COM_NOCPS
PERFORM_SERVIC(0)=IDLEN
PERFORM_SERVIC(1)=NOWORKN
IDLETIME=COM_ITINT*(IDLEIT+NOWORKIT)
PROCTIME=COM_ITINT*(FLPIT+BLPIT)
PRINT STRING("
SERVICE CALLS TIME AVERAGE % OF "C
."% OF % OF INSTRNS AVERAGE
(SECS) (MSECS) TOTAL " C
."NON-IDLE SUPVSR
")
TOTAL=0
CYCLE I=0,1,LOCSN0+3
S=SERVROUT(I)
J=PERFORM_SERVN(I)
IF S#"" AND J>0 THEN START
PRINT STRING(" ".S.STRSP(16-LENGTH(S)).STRPRINT(J,9,0))
SERVTIME=COM_ITINT*PERFORM_SERVIT(I)
PRINT STRING(STRPRINT(SERVTIME/1000000,6,3). C
STRPRINT((SERVTIME/1000)/J,6,3). C
STRPRINT(100*SERVTIME/PERIOD,7,1)."%". C
STRPRINT(100*SERVTIME/(PERIOD-IDLETIME),6,1). C
"%".STRPRINT(100*SERVTIME/(PERIOD-IDLETIME- C
PROCTIME),6,1)."%".STRPRINT(PERFORM_SERVIC(I),11,0)C
.STRPRINT(PERFORM_SERVIC(I)/J,8,0)."
")
TOTAL=TOTAL+SERVTIME
FINISH
REPEAT
PRINT STRING("
INTERRUPT/ACTIVATE ETC.=".STRPRINT((PERIOD-TOTAL)/1000000,1,3). C
" SECS (".STRPRINT(100*(PERIOD-TOTAL)/PERIOD,1,1)."%)
SEMALOCKOUT=".STRPRINT(SEMATIME/1000000,1,3).C
"SECS(".STRPRINT(100*SEMATIME/PERIOD,1,1)."%)
")
IF SFC FITTED=YES THEN PRINTSTRING("DRUMSIZE=".STRINT(DRUMSIZE))
PRINTSTRING("
OVERALLOC=".STRINT(OVERALLOC)."
PAGEINS=".STRINT(PERFORM_PTURNN)."
RECAPTURES=".STRINT(PERFORM_RECAPN)."
SHARED PAGES=".STRINT(PERFORM_PSHAREN)."
NEW PAGES=".STRINT(PERFORM_NEWPAGEN)."
WRITEOUTS=".STRINT(PERFORM_PAGEOUTN)."
PAGES ZEROED=".STRINT(PERFORM_PAGEZN)."
PAGES SNOOZED=".STRINT(PERFORM_SNOOZN)."
PAGES ABORTED=".STRINT(PERFORM_ABORTN))
PRINTSTRING("
SNOOZES COMPLETE =".STRINT(PERFORM_SNOOZOK)."
SNOOZES TIMEDOUT =".STRINT(PERFORM_SNOOZTO)."
SNOOZES ABANDONED=".STRINT(PERFORM_SNOOZAB)."
SOFTWARE INWARD CALLS=".STRINT(INTEGER(X'800000E0'))."
")
FINISH
IF MONLEVEL&32#0 THEN START
NEWPAGE
PRINTSTRING("
CATEGORY TABLE TRANSITIONS
")
SPACES(3)
CYCLE I=1,1,MAXCAT
WRITE(I,5)
REPEAT
NEWLINE
CYCLE I=1,1,MAXCAT
WRITE(I,2)
CYCLE J=1,1,MAXCAT
K=CATREC(I,J)
WRITE(K,5)
REPEAT
NEWLINE
SPACES(3)
CYCLE J=1,1,MAXCAT
K=FLYCAT(I,J)
IF K#0 THEN WRITE(K,5) ELSE SPACES(6)
REPEAT
NEWLINE
REPEAT
FINISH
IF MONLEVEL&16#0 THEN START
PRINTSTRING("
CAT SEQOUT STROBES EPSEXAMINED EPSOUT
")
CYCLE I=1,1,MAXCAT
IF STROBEN(I)#0 START
WRITE(I,2)
WRITE(SEQOUT(I),7)
WRITE(STROBEN(I),7)
WRITE(STREPN(I),11)
WRITE(STROUT(I),6)
IF STROUT(I)#0 THEN WRITE(STREPN(I)//STROUT(I),6)
NEWLINE
FINISH
REPEAT
FINISH
NEWPAGE
PPROFILE
IF MULTIOCP=YES THEN RELEASE LOG
CLEAR TIME
RETURN
STRING (31) FN STRPRINT(LONGREAL X, INTEGER N, M)
!***********************************************************************
!* PRINTS A REAL NUMBER (X) ALLOWING N PLACES BEFORE THE DECIMAL *
!* POINT AND M PLACES AFTER.IT REQUIRES (M+N+2) PRINT PLACES *
!* UNLESS (M=0) WHEN (N+1) PLACES ARE REQUIRED. *
!* *
!* A LITTLE CARE IS NEEDED TO AVOID UNNECESSARY LOSS OF ACCURACY *
!* AND TO AVOID OVERFLOW WHEN DEALING WITH VERY LARGE NUMBERS *
!***********************************************************************
LONGREAL ROUND,Y,Z
STRING (127)S
INTEGER I,J,L,SIGN,SPTR
SIGN=' '; ! '+' IMPLIED
IF X<0 THEN SIGN='-'
Y=MOD(X); ! ALL WORK DONE WITH Y
ROUND= 0.5/10.0**M; ! ROUNDING FACTOR
Y=Y+ROUND
I=0;Z=1
UNTIL Z>Y CYCLE ; ! COUNT LEADING PLACES
I=I+1;Z=10*Z; ! NO DANGER OF OVERFLOW HERE
REPEAT
SPTR=1
WHILE SPTR<=N-I CYCLE
CHARNO(S,SPTR)=' '
SPTR=SPTR+1
REPEAT
CHARNO(S,SPTR)=SIGN
SPTR=SPTR+1
J=I-1; Z=10.0**J
CYCLE
UNTIL J<0 CYCLE
L=INT PT(Y/Z); ! OBTAIN NEXT DIGIT
Y=Y-L*Z;Z=Z/10; ! AND REDUCE TOTAL
CHARNO(S,SPTR)=L+'0'
SPTR=SPTR+1
J=J-1
REPEAT
IF M=0 THEN EXIT ; ! NO DECIMAL PART TO BE O/P
CHARNO(S,SPTR)='.'
SPTR=SPTR+1
J=M-1; Z=10.0**(J-1)
M=0
Y=10*Y*Z
REPEAT
LENGTH(S)=SPTR-1
RESULT =S
END
END
!-----------------------------------------------------------------------
ROUTINE CLEAR TIME
!***********************************************************************
!* CLEAR OUT THE TIMING MEASUREMENTS *
!***********************************************************************
INTEGER I, J
IF MONLEVEL&4#0 THEN START
CYCLE I=0,1,LOCSN0+3
PERFORM_SERVIT(I)=0
PERFORM_SERVIC(I)=0
PERFORM_SERVN(I)=0
REPEAT
PERFORM_RECAPN=0
PERFORM_PTURNN=0
PERFORM_PSHAREN=0
PERFORM_NEWPAGEN=0
PERFORM_PAGEOUTN=0
PERFORM_PAGEZN=0
PERFORM_SNOOZN=0
PERFORM_ABORTN=0
PERFORM_SNOOZOK=0
PERFORM_SNOOZTO=0
PERFORM_SNOOZAB=0
SEMATIME=0
PERFORM_CLOCK0=CLOCK
FINISH
IF MONLEVEL&32#0 THEN START
CYCLE I=0,1,MAXCAT
CYCLE J=0,1,MAXCAT
FLYCAT(I,J)=0; CATREC(I,J)=0
REPEAT
REPEAT
FINISH
IF MONLEVEL&16#0 THEN START
CYCLE I=0,1,MAXCAT
STROBEN(I)=0
STREPN(I)=0
STROUT(I)=0
SEQOUT(I)=0
REPEAT
FINISH
END
FINISH
!-----------------------------------------------------------------------
IF DAP FITTED=YES THEN START
ROUTINE DAP DRIVER(RECORD (PARMF)NAME P)
!***********************************************************************
!* THIS ROUTINE(SERVICE 31 X1F) HANDLES THE DAP *
!* ACT=0 INITIALISE *
!* ACT=1 ALLOCATE (SOME OF) THE DAP *
!* ACT=2 DEALLOCTE (SOME OF) THE DAP *
!* ACT=3 DAP INTERRUPT *
!* ACT=4 START THE DAP *
!* ACT=5 STOP THE DAP *
!* ACT=6 CLOSE DOWN THE DAP FOR RECONFIGN *
!* ACT=7 CLOCK TICK TO RETURN IDLE DAP TO STORE *
!* ACT=8 SET TIMEOUT TO P_P1 *
!* ACT=9 FROM LOCAL CNTRLR WHEN PROCESS DIES WITH DAP *
!* ACT=10 RETURN PROCESS LIST NOS OF DAP USERS *
!***********************************************************************
ROUTINESPEC DREPLY(INTEGER LDAPNO,FAIL)
ROUTINESPEC DSTATUS
INTEGER I,J,DACT,PROCNO,FAIL,PT0,PT1,LDAPNO,INIT,STEP,FINAL
INTEGER STATUS,STATUS2,STATUS3,ADVIOL,IT,IC,ILOG1,ILOG2,DLOG1,DLOG2,DPC
RECORD (PROCF)NAME PROC
RECORD (CDRF)NAME LDAP
RECORD (PARMXF)NAME PCELL
INTEGERNAME LINK
OWNINTEGER TOUT=180; ! AFTER 3 MINS REVERTS TO STORE
OWNINTEGER HWTOUT=60; ! AFTER 60 SECS INT IS CLASSED AS MISSING
STRING (5)DAPID
CONSTINTEGER MAXDACT=12
CONSTINTEGER SWOP DAP=X'80'
SWITCH ACT(0:MAXDACT)
OWNINTEGER CLOSING=0,PENDING=0,RESTART BITS=0
DACT=P_DEST&15
LDAPNO=P_DEST>>8&15
IF 1<=LDAPNO<=MAXLDAP THEN LDAP==COM_CDR(LDAPNO)
IF 1<<DACT&B'100011111101'#0 AND (LDAPNO<=0 OR LDAPNO>MAXLDAP) C
THEN ->REQERR
IF MONLEVEL&2#0 AND C
KMON>>31&1#0 THEN PKMONREC("DAP DRIVER:",P)
PROCNO=(P_SRCE>>16-LOCSN0)&(MAXPROCS-1)
PROC==PROCA(PROCNO)
IF 0<=DACT<=MAXDACT THEN ->ACT(DACT)
REQERR: ! ERROR IN REQUEST
OPMESS("INVALID DAP REQUEST")
PKMONREC("DAP ERR:",P)
DSTATUS
RETURN
ACT(0): ! INITIALISE(NO PARAMS)
*LSS_(3); *USH_-26
*AND_3; *ST_I
IF I#COM_OCP PORT 0 THEN DPON(P,1) AND RETURN
CLOSING=CLOSING&(¬(1<<LDAPNO))
LDAP_DAPUSER=0
LDAP_DAPSTATE=1
J=LDAP_DAP1+3
*LB_J; *LSS_(0+B ); *AND_15; ! INTERUPTING PORT
*ST_J
LDAP_IPDAPNO=LDAP_IPDAPNO&15!J<<4
J=X'80000000'>>J; ! INT PORT MASK BIT
IF BASIC PTYPE<=3 START ; ! DAP ON 2970
*LSS_(X'600A')
*SLSS_J; *NEQ_-1; *AND_TOS
*ST_(X'600A')
FINISH ELSE START ; ! DAP ON P4
*LSS_(X'4012')
*OR_J
*ST_(X'4012')
FINISH
J=LDAP_DAP1+5
*LB_J; *LSS_10; *ST_(0+B ); ! DIAG ALLOW AND STOP DAP
*ADB_X'EA'; *LSS_2; *ST_(0+B ); ! CLEAR FAILS AND GEN RES
DSTATUS IF PENDING=0
->DSCHED
ACT(1): ! ALLOCATE P_P1 BLOCKS OF DAP
!
! REPLIES ARE P_P1=1 NO DAP AVAILABLE
! P_P1=2 NOT ENOUGH CONTIGUOUS BLOCKS
! P_P1=3 DAP IS CLOSING DOWN
! P_P1=4 USER ALREADY HAS DAP
! P_P1=0 DAP ALLOCATED WHEREUPON:
! P_P2=LDAP<<16!PHYSICAL DAP NO
! P_P3=FIRST BLOCK ALLOCATED
! P_P4=NO OF BLOCKS ALLOCATED
!
INIT=1; STEP=1; FINAL=MAXLDAP
IF 2<=COM_CDR(1)_DAPSTATE<=3 THEN START
STEP=-1; INIT=MAXLDAP; FINAL=1
FINISH
CYCLE LDAPNO=INIT,STEP,FINAL; ! TRY FROM ALL DAPS
! TESTING BUSY ONES LAST
LDAP==COM_CDR(LDAPNO)
FAIL=0
IF LDAP_IPDAPNO=0 OR LDAP_DAPSTATE=0 THEN FAIL=1
IF P_P1<=0 OR P_P1>LDAP_DAPBLKS THEN FAIL=2
IF CLOSING&1<<LDAPNO#0 THEN FAIL=3
EXIT IF FAIL=0
REPEAT
IF FAIL#0 THEN DREPLY(0,FAIL) AND RETURN
FOR I=1,1,MAXLDAP CYCLE
IF COM_CDR(I)_DAPUSER=PROCNO THEN DREPLY(I,4) AND RETURN
REPEAT
IF LDAP_DAPSTATE=17 THEN DPON(P,2) AND RETURN
! MUST WAIT IF DAP RECONFIGURING
P_P4=PROCNO; ! REMEMBER FOR DACT10
STRING(ADDR(P_P5))=PROC_USER; ! REMEMBER OWNER
I=NEWPPCELL
PCELL==PARM(I)
PCELL<-P
LINK==PENDING
LINK==PARM(LINK)_LINK WHILE LINK#0;! TO LAST LINK IN CHAIN OF PENDING TRANSFERS
PCELL_LINK=0
LINK=I
IF LDAP_DAPSTATE>15 START ; ! DAP AS STORE GET IT BACK
P_DEST=X'110001'
P_SRCE=X'1F0001'
P_P1=4<<16!LDAP_IPDAPNO&15
PON(P)
RETURN
FINISH
DSCHED: ! TRY TO SCHEDULE ALL DAPS
FOR LDAPNO=1,1,MAXLDAP CYCLE
LDAP==COM_CDR(LDAPNO)
CONTINUE UNLESS LDAP_DAPSTATE=1;! DAP AVAILABLE TO BE SCHEDULED
LINK==PENDING
WHILE LINK>0 CYCLE ; ! DAP JOBS ON QUEUE
I=LINK
P<-PARM(I)
IF P_P1>LDAP_DAPBLKS THEN LINK==PARM(I)_LINK AND CONTINUE
PROCNO=(P_SRCE>>16-LOCSN0)&(MAXPROCS-1)
PROC==PROCA(PROCNO)
LINK=PARM(I)_LINK
RETURN PP CELL(I)
IF PROC_USER#STRING(ADDR(P_P5)) THEN CONTINUE ;! CLAIMER HAS GONE AWAY
LDAP_DAPSTATE=2
EXIT
REPEAT
IF LDAP_DAPSTATE=2 START ; ! DAP SCHEDULED
UPDISP(PROCNO,10,TOSTRING((LDAP_IPDAPNO>>4)*2+52));!< OR >
PROC_STATUS=PROC_STATUS!2****10
LDAP_DAPUSER=PROCNO
P_P4=P_P1
P_P2=LDAP_IPDAPNO&15!LDAPNO<<16
P_P3=0
DREPLY(LDAPNO,0)
FINISH
IF LDAP_DAPSTATE=1 START ; ! DAP IS IDLE
P_DEST=X'000A0002'
P_P1=X'1F0007'!LDAPNO<<8
P_P2=TOUT
P_SRCE=X'1F0001'
PON(P); ! TIMEOUT BACK TO STORE
FINISH
REPEAT ; ! FOR ALL DAPS
RETURN
ACT(2): ! DEALLOCATE P_P3 BLKS OF DAP
UNLESS P_P1&X'FFFF'=LDAP_IPDAPNO&15 AND LDAP_DAPUSER=PROCNO C
THEN DREPLY(LDAPNO,1) AND RETURN
DREPLY(LDAPNO,0)
RESET: ! ENTER AFTER PROC FAILS(ACT10)
UPDISP(PROCNO,10," ")
LDAP_DAPUSER=0
LDAP_DAPSTATE=1
PROC_STATUS=PROC_STATUS&(¬(2****10))
J=LDAP_DAP1+X'EF'; ! gen res DAP in case
*LB_J; *LSS_2; *ST_(0+B ); ! ended in disorder
IF CLOSING&(1<<LDAPNO)#0 START ; ! DAP IS NOW FREE
P_DEST=X'110000'
P_SRCE=X'1F0002'!LDAPNO<<8
P_P1=4<<16!LDAP_IPDAPNO&15; ! CONFIGURE OFF THIS DAP
PON(P)
CLOSING=CLOSING&(¬(1<<LDAPNO))
RETURN
FINISH
->DSCHED
ACT(11): ! FORM ELAPSED INT: INT LONG OVERDUE
IF LDAP_DAPSTATE=3 START ; ! DAP IS RUNNING
DAPID="DAP".TOSTRING(LDAP_IPDAPNO>>4+48)
OPMESS(DAPID." TIMES OUT".TOSTRING(17))
P_DEST=LDAP_DAPINT
P_SRCE=X'1F000B'
PON(P)
LDAP_DAPINT=0
LDAP_DAPSTATE=2
J=LDAP_DAP1+5
*LB_J; *LSS_10; *ST_(0+B ); ! STOP DAP AND DIAG ALLOW
*ADB_X'EA'; *LSS_2; *ST_(0+B );! AND GEN RES IT
FINISH ELSE OPMESS("SPURIOUS DAP TIMEOUT")
RETURN
ACT(3): ! DAP INTERRUPT
! P_P3 HAS INT STAT
IF LDAP_DAPSTATE=3 START ; ! DAP IS RUNNING
IF CLOSING&(1<<LDAPNO)=0 AND P_P3=X'22' START
! JUST ROUTINE TIMESLICE
! RESTART AT ONCE
J=LDAP_DAP1+X'3B'; ! IT REG
*LSS_X'FFFFF'; *LB_J; *ST_(0+B );! RESET IT
*SBB_X'36'; *LSS_0; *ST_(0+B );! AND RESTART IT
->SET TOUT
FINISH
J=LDAP_DAP1+9
*LB_J; *LSS_(0+B ); *ST_STATUS
*ADB_2; *LSS_(0+B ); *ST_ADVIOL
*ADB_X'2E'; *LSS_(0+B ); *ST_IC
*ADB_2; *LSS_(0+B ); *ST_IT
*ADB_2; *LSS_(0+B ); *ST_DPC
*ADB_2; *LSS_(0+B ); *ST_DLOG1
*ADB_2; *LSS_(0+B ); *ST_DLOG2
*ADB_2; *LSS_(0+B ); *ST_ILOG1
*ADB_2; *LSS_(0+B ); *ST_ILOG2
*ADB_8; *LSS_(0+B ); *ST_STATUS3
*ADB_2; *LSS_(0+B ); *ST_STATUS2
IF P_P3&8#0 START ; ! HARDWARE
DAPID="DAP".TOSTRING(LDAP_IPDAPNO>>4+48)." "
OPMESS(DAPID."H-W ERROR".TOSTRING(17))
PRINTSTRING(DAPID."H-W FAILURE INSTAT=".STRHEX(P_P3))
PRINTSTRING("
STATUS 1&2&3=".STRHEX(STATUS)." ".STRHEX(STATUS2)." ".STRHEX(STATUS3))
FOR I=0,1,3 CYCLE
J=LDAP_DAP1+X'50'+4*I
*LB_J; *LSS_(0+B ); *ST_PT0
*ADB_1; *LSS_(0+B ); *ST_PT1
PRINTSTRING("
PTYP"); WRITE(I,1)
PRINTSTRING(" ".STRHEX(PT0).STRHEX(PT1))
REPEAT
NEWLINE
FINISH
IF ILOG1=X'F7F00000' AND 1<<LDAPNO&RESTART BITS#0 START
! STOP IS FOR I-O SYNC BUT DIR HAS TOLD
! US VIA ACT12 THAT I-O HAS COMPLETED
RESTART BITS=RESTART BITS&(¬(1<<LDAPNO))
J=LDAP_DAP1+5
*LB_J; *LSS_0; *ST_(0+B )
->SET TOUT
FINISH
P_DEST=LDAP_DAPINT; P_SRCE=X'1F0003'
LDAP_DAPINT=0
P_P1=P_P3<<24!ADVIOL&X'00FFFF00'!STATUS
IF PENDING#0 THEN P_P1=P_P1!SWOP DAP
P_P2=DPC
P_P3=DLOG1<<15!DLOG2&X'7FFF'; P_P4=IC
P_P5=ILOG1
P_P6=ILOG2
PON(P)
IF MONLEVEL&2#0 AND KMON>>31&1#0 THEN C
PKMONREC("DAP INT :",P)
LDAP_DAPSTATE=2
P_DEST=X'A0001'
P_SRCE=X'1F0003'
P_P1=X'1F000B'!LDAPNO<<8
P_P2=-1; ! CANCELL ELAPSED INT REQUEST
PON(P); ! REMOVE TIMEOUT ON INT
FINISH ELSE START
OPMESS("SURPRISE DAP INTERRUPT")
PKMONREC("SPUR DAPINT:",P)
FINISH
RETURN
ACT(4): ! START THE DAP
! P_P1=DATUM,P_P2=LIMIT
! P_P3=COB(ASE),P_P4=COL(IMIT)
! P_P5=DAPPC,P_P6=DAPIC
DREPLY(LDAPNO,1) AND RETURN UNLESS C
PROCNO=LDAP_DAPUSER AND LDAP_DAPSTATE=2
DREPLY(LDAPNO,2) AND RETURN IF CLOSING&(1<<LDAPNO)#0
LDAP_DAPINT=P_SRCE
LDAP_DAPSTATE=3; ! DAP IS RUNNING
J=LDAP_DAP1+X'31'; ! TO IS DATUM
*LB_J; *LCT_P+4; ! CTB TO RECORD P
*LSS_(CTB +2); *ST_(0+B ); ! DATUM=P_P1
*ADB_2; *LSS_(CTB +4); *ST_(0+B );! COB=P_P3
*ADB_2; *LSS_(CTB +5); *ST_(0+B );! COL=P_P4
*ADB_2; *LSS_(CTB +3); *ST_(0+B );! LIMIT=P_P2
*ADB_2; *LSS_(CTB +7); *ST_(0+B );! DAPIC=P_P6
*ADB_2; *LSS_X'FFFFF'
*ST_(0+B ); ! DAPIT=X'FFFFF'
*ADB_2; *LSS_(CTB +6); *ST_(0+B );! DAPPC=P_P5
*SBB_X'38'; *LSS_0; *ST_(0+B ); ! START IT RUNNING
SET TOUT: ! TIME OUT MISSING INTS
P_DEST=X'A0002'
P_SRCE=X'1F0004'
P_P1=X'1F000B'!LDAPNO<<8
P_P2=HWTOUT
P_P3=-1
PON(P); ! SET TIMEOUT ON INT
RETURN
ACT(5): ! (CONDITIONALLY) ABORT THE DAP
IF LDAP_DAPSTATE=3 AND PROCNO=LDAP_DAPUSER START ;! EXECUTING FOR THIS USER
I=LDAP_DAP1+5
*LB_I; *LSS_2; *ST_(0+B ); ! ORDERLY STOP
RETURN ; ! UNTIL INT FROM STOPPING
FINISH
!
! DAP GOING FOR SOMEONE ELSE. CHECK PENDING QUEUE
!
LINK==PENDING
WHILE LINK>0 CYCLE
PCELL==PARM(LINK)
IF PROCNO=(PCELL_SRCE>>16-LOCSN0)&(MAXPROCS-1) START ;! FOUND RIGHT USER
PCELL_DEST=PCELL_SRCE
PCELL_SRCE=X'1F0005'
PCELL_P1=-1
J=LINK; LINK=PCELL_LINK
FASTPON(J)
RETURN
FINISH
LINK==PCELL_LINK
REPEAT
RETURN ; ! ALREADY STOPPED
ACT(6): ! CLOSE THE DAP
CLOSING=CLOSING!1<<LDAPNO
RETURN
ACT(7): ! TIMEOUT
IF SMAC RCONFIG#0 THEN DPON(P,5) AND RETURN
IF LDAP_DAPSTATE=1 AND COM_SEPGS<30*COM_USERS START ;! STILL IDLE
! AND SHORT OF REAL STORE
P_DEST=X'110000'
P_P1=4<<16!LDAP_IPDAPNO&15
LDAP_DAPSTATE=17; ! ON WAY BACK TO STORE
PON(P)
FINISH
->DSCHED; ! SET FURTHER TIMEOUT IN CASE
! NO OF USERS INCREASES
ACT(8): ! SET TIMEOUT
HWTOUT=P_P2 IF P_P2>10
TOUT=P_P1 IF P_P1>1
RETURN
ACT(9): ! PROCESS DIES WITH DAP
! ALLOW RESET BY HAIRY PON
FOR LDAPNO=1,1,MAXLDAP CYCLE
LDAP==COM_CDR(LDAPNO)
IF PROCNO=LDAP_DAPUSER THEN ->RESET
REPEAT
RETURN
ACT(10): ! RETURN CURRENT DAP USER LIST
FAIL=0
FOR I=1,1,MAXLDAP CYCLE
LDAP==COM_CDR(I)
IF LDAP_DAPUSER>0 THEN BYTEINTEGER(ADDR(P_P2)+FAIL)= C
LDAP_DAPUSER AND FAIL=FAIL+1
REPEAT
LINK==PENDING
WHILE LINK>0 CYCLE
PCELL==PARM(LINK)
BYTEINTEGER(ADDR(P_P2)+FAIL)=PCELL_P4
FAIL=FAIL+1
LINK==PCELL_LINK
REPEAT
DREPLY(0,FAIL)
RETURN
ACT(12): ! FROM DIR ASYNCH IO COMPLETE
IF LDAP_DAPSTATE=3 THEN RESTART BITS=RESTART BITS!(1<<LDAPNO)
RETURN
ROUTINE DREPLY(INTEGER LDAPNO,FAIL)
!************************************************************************
!* REPLIES TO THE CURRENT REQUEST AS FROM LOGIGAL DAP "LDAPNO" *
!************************************************************************
IF P_SRCE>0 START ; ! IF REPLY WANTED
P_P1=FAIL
P_P6=PROC_STATUS
*LSS_(3); *ST_I
P_P5=I
P_DEST=P_SRCE
P_SRCE=X'1F0000'!DACT!LDAPNO<<8
PON(P)
IF MONLEVEL&2#0 AND C
KMON>>31&1#0 THEN PKMONREC("DAP REPLY :",P)
FINISH
END
ROUTINE DSTATUS
INTEGER I
STRING (40)S
FOR I=1,1,MAXLDAP CYCLE
LDAP==COM_CDR(I)
S="LDAP".STRINT(I)
IF LDAP_IPDAPNO=0 THEN S=S." NONE" ELSE C
S=S." DAC".STRINT(LDAP_IPDAPNO&15)." BLKS ".STRINT(LDAP_DAPBLKS).C
" USER".STRINT(LDAP_DAPUSER)." STATE".STRINT(LDAP_DAPSTATE)
OPMESS(S)
REPEAT
END
END
FINISH
IF MULTIOCP=YES THEN START
INTEGERFN REMOTE ACTIVATE(INTEGER REMOTE PORT,ADDR)
!***********************************************************************
!* ACTIVATES A REMOTE OCP. ITS SSN+1 IS AT ADDR *
!***********************************************************************
INTEGER I,ISAD,STKAD,VAL,RES
RECORD (ISTF)NAME SSNP1
STKAD=ADDR&X'FFF80000'; ! REMOVE ODD BIT FROM SEGNO
SSNP1==RECORD(ADDR)
SSNP1=GSSNP1; ! COPY IN CONTEXT
SSNP1_LNB=SSNP1_LNB&X'3FFFF'!STKAD
SSNP1_SF=SSNP1_SF&X'3FFFF'!STKAD
CYCLE I=0,4,60
INTEGER(X'81000080'+I)=INTEGER(ADDR+I)
REPEAT ; ! COPY SSN+1 TO REAL ADRR 80
IF SSERIES=YES START
IF REMOTE PORT=COM_OCPPORT1 THEN REMOTE PORT=COM_OCP1 SCU PORT C
ELSE REMOTE PORT=COM_OCP0 SCU PORT
ISAD=X'40000000'!REMOTE PORT<<22
FINISH ELSE ISAD=X'42000000'!REMOTE PORT<<20
IF SSERIES=YES OR BASIC PTYPE<=3 START ; ! P2&P3
ISAD=ISAD!X'6014'
VAL=X'80'
FINISH ELSE START ; ! P4 PROCESSORS
ISAD=ISAD+2
VAL=X'40000000'
FINISH
RES=SAFE IS WRITE(ISAD,VAL)
CYCLE I=1,1,10000; REPEAT
CYCLE I=0,4,60
INTEGER(X'81000080'+I)=INTEGER(X'801C0000'+I)
REPEAT ; ! RESTORE RESTART REGS
RESULT =RES
END
FINISH
ROUTINE CONFIG CONTROL(RECORD (PARMF)NAME P)
!***********************************************************************
!* KERNEL SERVICE 17 DYNAMIC CONFIGURATION CHANGING *
!* CONFIGURE OFF(DACT=0) OR ON(DACT=1) A MAJOR UNIT *
!* P_P1=DEVICE<<16! IDENT NO *
!* WHERE DEV=1 FOR OCP *
!* DEV=2 FOR SAC *
!* DEV=3 FOR SMAC *
!* DEV=4 FOR DAP *
!* OTHER DACTS DESCRIBED IN COMMENTS *
!***********************************************************************
IF RECONFIGURE=YES OR DAP FITTED=YES THEN START
INTEGERFNSPEC SMAC PORT(INTEGER OPEN,PORT)
INTEGERFNSPEC MAPDAP
SWITCH DACT(0:7),CIN,COFF(1:4)
INTEGER DEV,IDENT,I,J,K,MYPORT,HISPORT,STACK,ACT,TOPST,BLKSIZE, C
CONFIG,BLKS,REALAD,LDAPNO
LONGINTEGER PSTE
RECORD (STOREF)NAME ST
RECORD (CDRF)NAME LDAP
OWNINTEGER PAGESONOFF,OCPGOING=-1,TRIES=0
STRING (9)DEVNAME,ONOFF
CONSTSTRING (5)ARRAY DEVS(1:4)="OCP ","SAC ","SMAC ","DAP ";
IF MONLEVEL&2#0 AND KMON&1<<17#0 THEN C
PKMONREC("CONFIG CONTROL",P)
DEV=P_P1>>16
IDENT=P_P1&X'FFFF'
IF 1<=DEV<=4 THEN DEVNAME=DEVS(DEV) ELSE DEVNAME="??? " AND ->FAIL
IF DEV=3 OR DEV=4 THEN TOPST=(((PST(STORESEG)>>32&X'3FF80'+128) C
-ADDR(STORE(0))&X'3FFFF')//STOREFSIZE)-1
*LSS_(3); *USH_-26
*AND_3; *ST_MYPORT
HISPORT=MYPORT!!1
ACT=P_DEST&15
IF DEV=4 AND MAPDAP=0 THEN ->FAIL;! DOES MAPPING OF LDAP
->DACT(ACT)
DACT(0): ! CONFIGURE OFF
->COFF(DEV)
DACT(1): ! CONFIGURE ON
->CIN(DEV)
COFF(1): ! CONFIGURE OFF OCP
IF MULTI OCP=YES START
->FAIL UNLESS COM_NOCPS=2 AND ((SSERIES=YES AND 0<=IDENT<=1) OR C
(SSERIES=NO AND 2<=IDENT<=3))
IF MYPORT #IDENT START ; ! CAN ONLY CONFIGURE OFF MYSELF
P_P6=P_DEST; P_DEST=X'3F0001'
PON(P); ! TRY AGAIN IN 1 SEC
RETURN
FINISH
!
OCPGOING=MYPORT
J=X'8000017C'+MY PORT<<18
I=INTEGER(J); INTEGER(J)=0; ! PROC I WAS RUNNING
IF I#0 START
I=I+LOCSN0
SERVA(I)_P=SERVA(I)_P&X'BFFFFFFF';! CLEAR EXECUTING BIT
UNINHIBIT(I)
P_DEST=I<<16!2; PON(P); ! SEND HIM A CONTINUE
FINISH
IF SSERIES=YES START
IF MYPORT=COM_OCPPORT0 START
HALT OTHER OCP
DCU1 RECOVERY(0); ! DCU1s to other OCP
RESTART OTHER OCP(0)
I=COM_OCP1 SCU PORT
J=I
FINISH ELSE I=COM_OCP0 SCU PORT AND J=I
I=X'4004601D'!I<<22
J=J<<22
*LB_I; *LSS_J; *ST_(0+B ); ! send mpint to other OCP &
! reset cross reporting
FINISH ELSE IF BASIC PTYPE<=3 START
I=X'42056011'!HISPORT<<20
*LB_I; *LSS_X'80010000'
*ST_(0+B )
FINISH ELSE START
*LSS_(X'4012'); *OR_X'100'
*ST_(X'4012')
FINISH
!
! HAVE TOLD REMAINING OCP THAT I HAVE DIED. SO NOW LOOP FOR EVER
!
CYCLE
*IDLE_X'F0FF'
REPEAT
RETURN
FINISH ELSE ->FAIL
CIN(1): ! CONFIGURE IN AN OCP
IF MULTI OCP=YES START
->FAIL UNLESS COM_NOCPS=1 AND IDENT#COM_OCPPORT0 AND C
((SSERIES=YES AND 0<=IDENT<=1) OR (SSERIES=NO AND 2<=IDENT<=3))
->FAIL IF SSERIES=NO AND SMAC PORT(0,IDENT)#0; ! open relevant port
!
! MARK COMMS,GLA,BASE STACK&STORE ARRAY SEGS AS NONSLAVED. THESE ARE
! SET SLAVED BY CHOPSUPE UNLESS 2 OCPS ARE PRESENT AL IPL
!
PST(4)=PST(4)!NONSLAVED
PST(9)=PST(9)!NONSLAVED
PST(STORESEG)=PST(STORESEG)!NONSLAVED
PST(48)=PST(48)!NONSLAVED
IF SSERIES=YES THEN STACK=2*IDENT+12 ELSE STACK=2*IDENT+8
IF SSERIES=NO AND BASIC PTYPE<=3 START
*LSS_(X'600A'); *AND_X'CC'; *ST_(X'600A');! ALLOW ACTIVATES
FINISH
COM_OCPPORT1=IDENT
COM_NOCPS=2
IF REMOTE ACTIVATE(IDENT,X'80000000'+(STACK+1)<<18)#0 START
COM_NOCPS=1
IF SSERIES=NO THEN J=SMACPORT(1,HISPORT)
->FAIL
FINISH
IF SSERIES=NO START
IF BASIC PTYPE<=3 START
*LSS_1; *ST_(X'6009')
FINISH ELSE START
*LSS_(X'4012'); *OR_X'300C'; *ST_(X'4012');! ALLOW MP INTS
*LSS_(X'4013'); *OR_X'8004'; *ST_(X'4013');! SET MULT&DD
FINISH
FINISH
->SUCC
FINISH ELSE ->FAIL
IF SSERIES=NO START
COFF(2): ! CONFIGURE OFF A SAC
->FAIL UNLESS COM_NSACS=2 AND 0<=IDENT<=1
IF BASIC PTYPE=4=COM_OCPTYPE AND COM_CLKX>>20&15=IDENT START
! PROBLEMS WITH CLOCK IN SAC
IF COM_NOCPS>1 THEN OPMESS("STILL DUAL OCPS") AND ->FAIL
K=IDENT!!1; ! REMAINING SAC
I=(IDENT-K)<<20
J=COM_CLKX; *LB_J
*LSS_(0+B ); *SBB_I
*ST_(0+B ); ! TRANSFER CLOCK REG TO OTHER SAC
*STB_J; COM_CLKX=J; ! AND UPDATE ADDRESS
J=COM_CLKY; *LB_J
*LSS_(0+B ); *SBB_I
*ST_(0+B ); ! TRANSFER CLOCK REG TO OTHER SAC
*STB_J; COM_CLKY=J; ! AND UPDATE ADDRESS
J=COM_CLKZ; *LB_J
*LSS_(0+B ); *SBB_I
*ST_(0+B ); ! TRANSFER CLOCK REG TO OTHER SAC
*STB_J; COM_CLKZ=J; ! AND UPDATE ADDRESS
J=X'80000000'>>K; ! EXTERNAL INT BIT
*LSS_(X'4012'); *AND_X'0FFFFFFF'
*OR_J; *ST_(X'4012')
*LSS_(X'4013'); *AND_X'000FFFFF'
*SLSS_K; *USH_20; *OR_TOS
*ST_(X'4013'); ! FOR RRTC INSTRUCTION
FINISH
P_DEST=X'200007'
P_SRCE=X'110005'
P_P2=IDENT
PON(P)
RETURN
DACT(5): ! REPLY FROM DISC
->SAC USED IF P_P2#0
P_DEST=X'300007'
P_SRCE=X'110003'
P_P2=IDENT
PON(P)
RETURN
DACT(3): ! REPLY FROM GPC
->SAC USED UNLESS P_P2=0
IF SFC FITTED=YES AND DRUMSIZE>0 START
P_DEST=X'280007'
P_SRCE=X'110006'
P_P2=IDENT
PON(P)
RETURN
FINISH
DACT(6): ! REPLY FROM DRUM(ALWAYS OK)
IF COM_NOCPS>1 AND MYPORT#COM_OCPPORT0 THEN C
DPON(P,1) AND RETURN
I=X'8'>>IDENT
IF BASIC PTYPE<=3 START
I=I!I<<4
*LSS_(X'600A'); *OR_I; *ST_(X'600A')
FINISH ELSE START
I=(I<<12!I<<2)!!(-1)
*LSS_(X'4012'); *AND_I; *ST_(X'4012')
FINISH
COM_NSACS=1
COM_SACPORT0=IDENT!!1
SAC MASK=SAC MASK&(¬(1<<IDENT))
ACT=0; ! ENSURE RIGHT MESSAGE
->FAIL UNLESS SMAC PORT(1,IDENT)=0
->SUCC
SAC USED: ! SOMETHING STILL ON SAC
OPMESS(STRING(ADDR(P_P2))." STILL ON SAC".STRINT(IDENT))
ACT=0; ->FAIL
CIN(2): ! CONFIGURE IN A SAC
->FAIL UNLESS COM_NSACS=1 AND 0<=IDENT<=1 AND C
IDENT#COM_SACPORT0
->FAIL UNLESS SMAC PORT(0,IDENT)=0
->FAIL UNLESS SAFE IS READ(X'44000400'!IDENT<<20,J)=0
DACT(7): ! CONTINUE TRYTING
IF COM_NOCPS>1 AND MYPORT#COM_OCPPORT0 START
P_DEST=X'110007'
P_SRCE=P_DEST
DPON(P,1)
RETURN
FINISH
I=X'8'>>IDENT
IF BASIC PTYPE=3 START
I=(I!I<<4)!!(-1)
*LSS_(X'600A'); *AND_I; *ST_(X'600A')
FINISH ELSE START
I=(I<<10!I)<<2
*LSS_(X'4012'); *OR_I; *ST_(X'4012')
FINISH
CYCLE I=16*IDENT,1,16*IDENT+15
K=CONTYPE(I)
P_P1=I; ! NEW PORT-TRUNK
P_P2=I; ! OLD PORT-TRUNK
P_DEST=0
P_SRCE=0
IF K=2 THEN P_DEST=X'20000A';! DISC RESET FPC
IF K=3 THEN P_DEST=X'30000A';! GPC RESET GPC
IF P_DEST#0 THEN PON(P)
REPEAT
COM_SACPORT1=IDENT
SAC MASK=SAC MASK!(1<<IDENT)
COM_NSACS=2
->SUCC
CIN(4): ! CONFIGURE IN A DAP
IF DAP FITTED=YES START
->FAIL UNLESS (IDENT=LDAP_IPDAPNO&15 AND LDAP_DAPSTATE&15=0 ) OR C
LDAP_IPDAPNO=0
IF SMAC RCONFIG#0 START
IF SMAC RCONFIG=IDENT THEN ->FAIL;! THIS ONE AGAIN
DPON(P,5); ! WAIT 5 SECS & RETRY
RETURN
FINISH
IF MYPORT#COM_OCPPORT0 THEN DPON(P,1) AND RETURN
K=COM_SDR4!IDENT<<COM_SMACPOS
->FAIL UNLESS SAFE IS READ(K,CONFIG)=0
->FAIL UNLESS CONFIG&X'02000000'#0
FINISH
COFF(3): ! CONFIGURE OFF A SMAC
->FAIL UNLESS 0<IDENT<=15; ! SMAC 0 NOT CONFIGURABLE
->FAIL UNLESS 1<<IDENT&COM_SMACS#0;! UNLESS SMAC IN CONFIGRNT
IF DAP FITTED=YES AND DEV=3 START ; ! CHECK FOR SMAC THAT IS ACTIVE DAP
FOR I=1,1,MAXLDAP CYCLE
LDAP==COM_CDR(I)
->FAIL IF LDAP_IPDAPNO&15=IDENT AND LDAP_DAPSTATE>0
REPEAT
FINISH
->FAIL IF (COM_OCPTYPE=4 OR COM_OCPTYPE=6) AND C
1<<(IDENT!!8)&COM_SMACS#0; ! & not interleavable
! full check very difficult!
->FAIL UNLESS X'10000'<<IDENT&COM_SMACS=0;! BUT NOT USED BY SYSTEM
IF SMAC RCONFIG#0 START ; ! ALREADY RECONFIGURING
IF SMAC RCONFIG=IDENT AND TRIES>150 THEN C
SMAC RPAGES=0 AND RETURN ;! 2ND REQUEST=FORCE IT OFF
->FAIL
FINISH
->FAIL UNLESS SAFE IS READ(COM_SDR4!IDENT<<COM_SMACPOS,J)=0
! CHECK CAN ACCESS SMAC IS
PAGESONOFF=0; J=0; ! WORK OUT NO OF PAGES
TRIES=0; ! COUNT IF ATTEMPTS TO CONFIGURE
IF MULTI OCP=YES THEN SEMALOOP(STORESEMA,1)
CYCLE I=1,1,TOPST
ST==STORE(I)
IF ST_REALAD>>22&15=IDENT START
PAGESONOFF=PAGESONOFF+1; ! IN RIGHT SMAC
IF ST_REALAD<0 AND ST_USERS=0 THEN J=J+1
! forget abandoned flawed pages
! REMEMBER 8K PHOTO AREA IN SMAC1
IF IDENT=1 AND ST_USERS=255 AND ST_REALAD&X'3FFFFF' C
<X'7FFF' THEN ST_USERS=0 AND J=J+1
IF ST_USERS=255 THEN ->FAIL;! SHOULD NOT OCCUR
FINISH
REPEAT
SMAC RCONFIG=IDENT
SMAC RPAGES=PAGES ONOFF-J
IF MULTIOCP=YES START ; *TDEC_(STORESEMA); FINISH ; ! cannot hold thru 2 loops
!
! GRAB ANY FREE PAGES FROM FREE LIST AT ONCE
!
IF MULTI OCP=YES THEN SEMALOOP(STORESEMA,1)
SMAC RPAGES=SMAC RPAGES-1 WHILE QUICK EPAGE(1,1<<IDENT)>0
IF MULTI OCP=YES START ; *TDEC_(STORESEMA); FINISH
P_DEST=X'3000D'
P_SRCE=X'110004'
PON(P); ! KICK SCHEDULE TO FREE STORE
P_DEST=X'110004'
P_P2=0
DPON(P,5); ! KICK SELF(P_P1 INTACT!)
RETURN
DACT(4): ! CONTINUE CONFIGURING OFF STORE
IF P_P2=0 THEN DONT SCHED=1; ! AFTER STOPPING SNOOZING
! NOW KEEP EVERYONE OUT
P_P2=P_P2+1
TRIES=P_P2; ! COUNT OF ATTEMPTS
IF SMAC RPAGES#0 START
P_P3=SMAC RPAGES; ! DEBUGGING ONLY
DPON(P,1)
RETURN UNLESS MPLEVEL=0 AND PAGEFREES=0 AND DONT SCHED#0;! CONTINUE WAITING
FINISH
!
! AFTER 15 SECS OR WHEN ALL PAGES FREE CHANGE SCHEDULING PARAMETER
! AND RESTART SCHEDULING
!
IF DONT SCHED#0 START ; ! SCHEDULING NOT YET RESET
UNALLOCEPS=UNALLOCEPS-OVER ALLOC-PAGES ONOFF
MAX OVERALLOC=OVERALLOC PERCENT*UNALLOCEPS//100
OVER ALLOC=MAX OVERALLOC
UNALLOCEPS=UNALLOCEPS+OVER ALLOC
P_DEST=X'30006'
DONT SCHED=0
PON(P); ! KICK SCHEDULE
RETURN UNLESS SMAC RPAGES=0
FINISH
!
! CLEAR OUT STORE TABLES
!
CYCLE I=1,1,TOPST
ST==STORE(I)
IF ST_REALAD>>22&15=SMAC RCONFIGTHEN ST=0
REPEAT
!
! CLOSEUP BLOCK ARRAY AND RESET COUNT
!
COM_SEPGS=COM_SEPGS-PAGES ONOFF
MAXP4PAGES=P4PERCENT*COM_SEPGS//100
J=0
CYCLE I=0,1,COM_SBLKS-1
K=BLOCKAD(I)
IF K>>22&15#SMAC RCONFIG THEN BLOCKAD(J)=K AND J=J+1
REPEAT
BLKS=COM_SBLKS-J; ! DAP SIE
COM_SBLKS=J
->DAPIN IF DAP FITTED=YES AND DEV=4; ! DAP IN NOT SMAC OFF
J=64+16*SMAC RCONFIG
PST(I)=0 FOR I=J,1,J+15
!
! FINISH OFF INCLUDING CLOSING SAC PORT UNLESS INTERLEAVED
!
COM_SMACS=COM_SMACS!!1<<SMAC RCONFIG
J=SMAC RCONFIG!!8; ! INTERLEAVED SMAC
IF COM_SMACS&1<<J=0 START ; ! IS NOT PRESENT
K=COM_SDR4!SMAC RCONFIG<<COM_SMACPOS
J=SAFE IS READ(K,I)
J=J!SAFE IS WRITE(K,I!X'3C')
FINISH
IF DAP FITTED=YES START
FOR I=1,1,MAXLDAP CYCLE
LDAP==COM_CDR(I)
IF SMAC RCONFIG=LDAP_IPDAPNO&15 THEN LDAP_IPDAPNO=0;! DAP REMOVED
REPEAT
FINISH
SMAC RCONFIG=0
->SUCC
COFF(4): ! CONFIGURE OFF A DAP
IF DAP FITTED=YES START
->FAIL UNLESS IDENT=LDAP_IPDAPNO&15 AND LDAP_DAPSTATE>0
->FAIL IF SMAC RCONFIG#0
IF 1<LDAP_DAPSTATE<16 START ; ! DAP STILL IN USE
P_SRCE=P_DEST
P_DEST=X'1F0006'!LDAPNO<<8; ! TELL DAPDRIVER AND WAIT
PON(P); ! P_P1 INTACT
RETURN
FINISH
IF MYPORT#COM_OCPPORT0 THEN DPON(P,1) AND RETURN
IF LDAP_DAPSTATE=16 THEN LDAP_DAPSTATE=0 AND ->SUCC
LDAP_DAPSTATE=LDAP_DAPSTATE&16;! NO LONGER A DAP
J=X'80000000'>>(LDAP_IPDAPNO>>4)
!
! NOW ACTIVE DAPS PRESENT. CLOSE OFF INTERRUPTS
!
IF BASIC PTYPE<=3 START ; ! DAP ON 2970
*LSS_(X'600A')
*OR_J
*ST_(X'600A')
FINISH ELSE START ; ! DAP ON P4 ARCHITECTURE
*LSS_(X'4012')
*SLSS_J; *NEQ_-1; *AND_TOS
*ST_(X'4012')
FINISH
! AND DROP THRO TO ADD AS STORE
FINISH
CIN(3): ! CONFIGURE IN A SMAC
->FAIL UNLESS DEV=4 OR COM_SMACS&1<<IDENT=0;! NOT ALREADY IN
K=COM_SDR4!IDENT<<COM_SMACPOS
J=SAFE IS READ(K,CONFIG)!SAFE IS READ(COM_SDR4,I)
J=J!SAFE IS WRITE(K,CONFIG&X'FFFFFFC3'!I&X'3C')
->FAIL UNLESS J=0
BLKS=0
BLKSIZE=COM_BLKSIZE
CONFIG=CONFIG!COM_BLOCKZBIT; ! MUST BE A BLOCK ZERO !
IF CONFIG&X'01000000'#0 THEN BLKSIZE=X'40000';! 16K CHIP STORE
!
! COUNT THE NUMBER OF (128K) BLOCKS AND ADD TO BLOCK ARRAY
! DONT UP THE BLOCK COUNT YET. ADDING THE SMAC CAN STILL FAIL
!
CYCLE I=0,1,15
IF CONFIG&COM_BLOCKZBIT<<(I*COM_BLKSHIFT)#0 START
! BLOCK I IS PRESENT
J=COM_SBLKS+BLKS
BLOCKAD(J)=IDENT<<22+I*BLKSIZE;! BLOCKS REAL ADDRESS
IF BLKSIZE=X'40000' THEN BLOCKAD(J+1)=BLOCKAD(J)+X'20000'
BLKS=BLKS+BLKSIZE//X'20000'
FINISH
REPEAT
PAGES ONOFF=(128//EPAGESIZE)*BLKS
!
! CHECK THE EMPTY SLOTS IN THE STORE ARRAY. IF NOT ENOUGH THEN GRAB
! EXTRA PAGES TO EXTEND AS NECESSARY
!
CYCLE
J=0
CYCLE I=1,1,TOPST
IF STORE(I)_REALAD=0 THEN J=J+1
REPEAT
EXIT IF J>=PAGES ONOFF
K=QUICK EPAGE(0,COM_SMACS>>16);! PAGE IN SYSTEM SMACS
->FAIL IF K<0; ! NO STORE TO EXTEND TABLE
K=STORE(K)_REALAD!X'80000001'
I=PST(STORESEG)>>42&255; ! PAGE NO OF LAST 1K PAGE
CYCLE J=0,1,EPAGESIZE-1; ! FILL IN PAGE TABLE
INTEGER(X'80000004'+STORESEG<<18+4*(I+J))=K+1024*J
REPEAT
PST(STORESEG)=PST(STORESEG)+LENGTHENI(EPAGESIZE*1024)<<32
TOPST=TOPST+1024*EPAGESIZE//STOREFSIZE
J=COM_PSTB; *LB_J
*LSS_(0+B ); *ST_(0+B ); ! CLEAR ATU SLAVE STORE
REPEAT
!
! CYCLE UP THE BLOCK ARRAY COMPLETEING STORE&PST ENTRIES
!
PSTE=PST(64)&X'FFFC000080000001'
K=1; P_DEST=X'60001'
IF MULTI OCP=YES THEN SEMALOOP(STORESEMA,1)
CYCLE I=COM_SBLKS,1,COM_SBLKS+BLKS-1
REALAD=BLOCKAD(I)
IF DEV=3 START ; ! DPAS HAVE PST SET
J=X'20000'; ! HALF A SEGMENT
IF REALAD&X'20000'#0 THEN J=X'40000'
PST(64+REALAD>>18)=PSTE!(REALAD&X'FFFC0000') ! C
LENGTHENI(J-X'80')<<32
FINISH
! clear store to remove parities
*LDTB_X'38002000'; *LDA_REALAD; *INCA_VIRTAD; *LB_0; *LSQ_0
AGN: *ST_(DR +B ); *CPIB_X'1FFF'; *JCC_4,<AGN>
CYCLE J=0,1,SEGEPSIZE//2-1
K=K+1 WHILE STORE(K)_REALAD#0
STORE(K)_REALAD=REALAD+EPAGESIZE*1024*J
IF IDENT=1 AND J<=1 AND REALAD&X'3FFFFF'=0 THEN C
STORE(K)_USERS=255 ELSE START
! DONT USE PHOTO ATEA IN SMAC 1
P_P2=K; ! STORE INDEX
RETURN EPAGE(P)
FINISH
REPEAT
REPEAT
! CHANGE SCHEDULING PARAMS
! FOR REALLOCATED STORE
J=PAGES ONOFF*OVERALLOC PERCENT//100
UNALLOCEPS=UNALLOCEPS+PAGESONOFF+J
OVERALLOC=OVERALLOC+J
MAX OVERALLOC=MAXOVERALLOC+J
COM_SEPGS=COM_SEPGS+PAGESONOFF
MAXP4PAGES=P4PERCENT*COM_SEPGS//100
COM_SBLKS=COM_SBLKS+BLKS
COM_SMACS=COM_SMACS!1<<IDENT
IF MULTI OCP=YES START ; *TDEC_(STORESEMA); FINISH
ACT=DEV&1; ! TO GET RIGHT MESSAGE AS DAP OFF
! IN FACT ALSO MEANS SMAC ON
->SUCC
IF DAP FITTED=YES START
DAPIN:
! DAP STORE MUST BE CONTIGUOUS
! OR DAP CAN ONLY BE USED AS SMAC
CYCLE I=1,1,COM_SBLKS-1
->FAIL UNLESS BLOCKAD(I)=BLOCKAD(I-1)+X'20000' OR C
BLOCKAD(I)>>22#IDENT OR IDENT#BLOCKAD(I-1)>>22
REPEAT
LDAP_IPDAPNO=IDENT
LDAP_DAP1=(COM_SDR4!(LDAP_IPDAPNO&15)<<COM_SMACPOS)&X'FFFFF000'!X'B00'
LDAP_DAPBLKS=BLKS
SMAC RCONFIG=0
P_DEST=X'1F0000'!LDAPNO<<8
P_SRCE=0
PON(P); ! INITIALISE DAP DRIVER
ACT=1
->SUCC
FINISH
FINISH
DACT(2): ! FINISH CONFIGURIN OFF HIM
IF MULTI OCP=YES START
IF OCPGOING<0 THEN DEVNAME=DEVNAME.TOSTRING(17)
OCPGOING=-1; ! IF DUE TO FAILURE FLASH MSG
IF SSERIES=YES AND MYPORT#COM_OCPPORT0 START ; ! swap SCU ports
J=COM_OCP0 SCU PORT
COM_OCP0 SCU PORT=COM_OCP1 SCU PORT
COM_OCP1 SCU PORT=J
FINISH
COM_NOCPS=1; COM_OCPPORT0=MYPORT
COM_OCPPORT1=HISPORT
IF SSERIES=NO THEN J=SMACPORT(1,HISPORT); ! CLOSE OFF HIS SMAC PORT
FINISH
SUCC:
IF ACT&1#0 THEN ONOFF="ON" ELSE C
IF DEV=4 THEN ONOFF="AS STORE" ELSE ONOFF="OFF"
OPMESS(DEVNAME.STRINT(IDENT)." CONFIGURED ".ONOFF)
if dev=1 start ; ! update oper info
if act&1=0 then onoff=" ".strint(com_ocpport0)." " else c
onoff="s ".strint(com_ocpport0)." ".strint(com_ocpport1)
p_dest=x'320006'; ! display text with pon
p_p1=x'04100000'; ! lest race with oper init
string(addr(p_p1)+3)=onoff
pon(p)
{ == display text(0,4,16,onoff) }
finish
RETURN
CIN(*):COFF(*):DACT(*):
FAIL: ! UNKNOWN DEVICE OR OTHERS
OPMESS("CANNOT CONFIGURE ".DEVNAME.STRINT(IDENT))
RETURN
INTEGERFN MAPDAP
!***********************************************************************
!* FINDS THE LOGICAL DAP NO CORRESPONDING TO THE DAC(SMAC) NO *
!***********************************************************************
IF DAP FITTED=YES START
FOR LDAPNO=1,1,MAXLDAP CYCLE
LDAP==COM_CDR(LDAPNO)
IF LDAP_IPDAPNO&15=IDENT THEN RESULT =LDAPNO
REPEAT
IF ACT=1 OR ACT=4 START ; ! CONFGR ON EMPTY SLOT OK
FOR LDAPNO=1,1,MAXLDAP CYCLE
LDAP==COM_CDR(LDAPNO)
IF LDAP_IPDAPNO=0 THEN RESULT =LDAPNO
REPEAT
FINISH
FINISH
RESULT =0
END
INTEGERFN SMAC PORT(INTEGER OPEN,PORT)
!***********************************************************************
!* OPEN (OPEN=0) %OR CLOSE A SMAC PORT IN ALL ONLINE SMACS *
!***********************************************************************
INTEGER I,J,K,L,P,VAL,RES,DAPS
K=X'20'>>PORT
P=K
L=K!!(-1)
IF OPEN=0 THEN K=0
RES=0; DAPS=0
IF DAP FITTED=YES START
FOR I=1,1,MAXLDAP CYCLE
IF COM_CDR(I)_IPDAPNO>0 THEN DAPS=DAPS!1<<COM_CDR(I)_IPDAPNO&15
REPEAT
FINISH
CYCLE I=0,1,15
IF 1<<I&COM_SMACS#0 OR 1<<I&DAPS#0 START
J=COM_SDR4!I<<COM_SMACPOS; ! SAMC CONFG REG
RES=RES!SAFE IS READ(J,VAL)
! for SMACs 0/8 if the block0 bit is not set (because some
! other block is configured as block0) then writing back
! the config reg will lose block0 with disastrous results!!
! So......
IF (I=0 OR ((COM_OCPTYPE=4 OR COM_OCPTYPE=6) AND I=8)) C
AND VAL&COM_BLOCKZBIT=0 START
IF (OPEN=0 AND VAL&P#0) OR (OPEN=1 AND VAL&P=0) START
IF OPEN=0 THEN ONOFF="Open " ELSE ONOFF="Close "
OPMESS(ONOFF."Port ".STRINT(PORT)." now!!!")
RES=-1 IF OPEN=0
FINISH
FINISH ELSE RES=RES!SAFE IS WRITE(J,VAL&L!K)
FINISH
REPEAT
RESULT =RES
END
FINISH
END
ROUTINE SHUTDOWN(RECORD (PARMF)NAME P)
!***********************************************************************
!* KERNEL service 18 - complete system shutdown. *
!* *
!* ACT 1 - when system quiescent then :- *
!* halt other OCP (if appropriate) *
!* inhibit interrupts *
!* master clear all controllers *
!* *
!* ACT 2 - as activity 1 plus:- *
!* disconnect all DFC & GPC devices *
!* *
!* ACT 0 - cancel request *
!* *
!***********************************************************************
RECORD (PARMF) PP
INTEGER I,J
OWNINTEGER ACT=0
IF MONLEVEL&2#0 AND KMON&1<<18#0 THEN C
PKMONREC("Shutdown:",P)
I=P_DEST&255
UNLESS I=255 THEN ACT=I; ! 255 is reply from ELAPSED INT.
RETURN IF ACT=0
UNLESS COM_USERS=0 START
PP_DEST=X'A0002'; ! Elapsed int
PP_SRCE=0
PP_P1=P_DEST!255
PP_P2=20
PON(PP)
RETURN
FINISH
IF MULTI OCP=YES AND COM_NOCPS>1 THEN HALT OTHER OCP
*LSS_X'382E'; *ST_(3); ! No unwanted interrupts
IF SSERIES=NO START
FOR I=0,1,31 CYCLE ; ! Master clear all controllers
J=BYTEINTEGER(COM_CONTYPEA+I); ! controller type
UNLESS J=0 START
IF COM_NSACS=1 AND I>>4#COM_SACPORT0 THEN CONTINUE ; ! SAC gone
IF ACT=2 START ; ! disconnect DFC & GPC devices
PP=0
PP_P1=I; ! port/trunk
IF J=2 THEN PP_DEST=11 AND DISC(PP) ELSE C
IF J=3 THEN PP_DEST=9 AND GDC(PP)
FINISH
J=X'40000800'!I<<16
*LB_J; *LSS_2; *ST_(0+B )
FINISH
REPEAT
FINISH
CYCLE
*IDLE_X'DEAF'; ! Go to sleep
REPEAT
END
!*
!*
!*
ROUTINE UPDISP(INTEGER PROCESS,OFFSET,STRING (13) S)
INTEGER LINE,POS
PROCESS=PROCESS-1
LINE=PROCESS//3; ! 3 PER LINE +HEADER
POS=(PROCESS-3*LINE)*13; ! 40CHARS FOR EACH 3 PROCS
DISPLAY TEXT(-1,LINE+5,POS+OFFSET,S);! CURRENTLY 5 HEADER LINES
END
!-----------------------------------------------------------------------
! THE LOCAL CONTROLLER STACK HAS SEVERAL OTHER SEGMENTS MAPPED ONTO ITS
! FIRST PART. IT IS IMPORTANT THAT THESE SEGMENTS ARE ACCESSED VIA
! THEIR PROPER ADDRESSES AND NOT VIA ADDRESSES IN THE LOCAL CONTROLLER
! STACK AS THE SLAVES ARE NOT PROOF AGAINST 2 VIRTUAL ADDRESSES
! HAVING THE SAME REAL ADDRESS
! THIS AREA IS CURRENTLY LAID OUT AS FOLLOWS:-
! 0 TO X600 THE LOCAL SEGMENT TABLE 192 8BYTE ENTRIES
! X600 TO X680 THE LOCAL CONTROLLER SSN+1
! X680 TO X700 SEGMENT 5 IE USER STACK SSN+1
! X700 TO X780 SEGMENT 7 IE SIGNAL STACK SSN+1
! X780 TO X800 RESERVED FOR SSN+1 OF CURRENTLY NOMINATED USER STACK
! X800 X1180 THE DIRERTOR-LOCALCONTROLLER COMMUNICATION SEGMENT(10)
!-----------------------------------------------------------------------
ROUTINE LOCAL CONTROL
! DIRECTOR COMMUNICATIONS RECORDS
RECORDFORMAT SIGOUTPF(INTEGER DEST,SRCE,P1,P2,P3,P4,P5,P6, C
TYPE,SSN,SSNAD,SUSP)
CONSTRECORD (SIGOUTPF)NAME SIGOUTP=SIGOUTPAD
!-----------------------------------------------------------------------
! CLAIMED BLOCK TABLES
CONSTHALFINTEGERARRAYNAME SST=SSTAD
RECORDFORMAT CBTF(INTEGER DA,HALFINTEGER AMTX,BYTEINTEGER TAGS,LINK)
CONSTRECORD (CBTF)ARRAYNAME CBTA=CBTAD
RECORD (CBTF)NAME CBT
INTEGER CBTP
!-----------------------------------------------------------------------
! CONSOLE IO & ACCOUNTS RECORDS
RECORD (IOSTATF)NAME IOSTAT
RECORDFORMAT ACNTF(LONGINTEGER LTIME,INTEGER PTURNS)
RECORD (ACNTF)NAME ACNT
INTEGERNAME ICREVS,SEMAHELD; ! INSTRUCTION COUNTER REVS WORD
!-----------------------------------------------------------------------
! ACTIVE SEGMENT TABLES
CONSTINTEGER MAXAS=31
CONSTINTEGER SMULTIPLE CON=X'20'; ! SYSTEM SHRD COMPONENT
CONSTINTEGER ADVISORY SEQ=X'40'; ! ADVISORY SEQUENTIAL ACCESS BIT
CONSTINTEGER CONTINUATN BLK=X'80'; ! CBT BLOCK IS NOT THE FIRST
LONGINTEGERARRAY AS(0:MAXAS)
BYTEINTEGERARRAY ASEG(0:MAXAS)
INTEGER ASFREE,ASWAP,ASWIP,ASSHR; ! %BITARRAY (0:MAXAS)
INTEGERARRAY OLDASWIPS(0:MAXRESIDENCES)
CONSTLONGINTEGER LTOPBIT=X'8000000000000000'
CONSTINTEGER TOPBIT=X'80000000'
!-----------------------------------------------------------------------
! LOCAL STACKS INFORMATION
BYTEINTEGERARRAY LSTKSSN(1:LSTKN)
!-----------------------------------------------------------------------
! CATEGORY INFORMATION
INTEGER EPLIM,EPN,UEPN,RTLIM,RTN
!-----------------------------------------------------------------------
CONSTINTEGER SMALL SEQUENTIAL=8; !USED TO DECIDE TO RECAP OR NOT
INTEGERFNSPEC CHECK RES(INTEGER WRITE,LEN,AD)
INTEGERFNSPEC CHECKDA(INTEGER DA)
ROUTINESPEC PAGEOUT(INTEGER VSSEG,VSEPAGE,RECORD (CBTF)NAME CBT)
ROUTINESPEC ASOUT(INTEGER ASP)
ROUTINESPEC STROBE(INTEGER SFLAGS)
ROUTINESPEC WORKSET(INTEGER RECAP)
ROUTINESPEC CLEAR ACCESSED BITS
ROUTINESPEC DEACTIVATE(INTEGER MASK)
ROUTINESPEC FREE AS
ROUTINESPEC RETURN PTS
INTEGERFNSPEC FIND PROCESS
INTEGERFNSPEC CURSSN
ROUTINESPEC WAIT(INTEGER DACT,N)
!-----------------------------------------------------------------------
RECORD (PARMF) P; ! FOR POFFING PARAMETERS
RECORD (PROCF)NAME PROC
RECORD (PARMF)NAME ALLOUTP; ! MAPPED ONTO DIROUTP OR
! SIGOUTP AS STACKS SWOP
RECORD (SERVF)NAME SERV0,SERV,SERV3
RECORD (PARMF) POUT
RECORD (SSNP1F)NAME SSNP1
RECORD (STOREF)NAME ST
CONSTLONGINTEGERARRAYNAME LST=LSTVAD
INTEGERARRAYNAME PT
INTEGER PROCESS,ME,LSN3,PTAD,VSPARM,PEPARM,VSSEG,VSEPAGE,EPX,I,J,K, C
NEWSTK,STOREX,DEST,SRCE,SUSP,SNOOZES,DA,LASTDA,NONSEQVSIS,LCERRS, C
XSTROBE,SEGLEN,PTEPS,ASDESTROY,PTP,ASP,ASB,OUTN,PTE, C
PROCACTAD1,PROCACTAD2,HIGHSEG,LOCKST,LOCKSTX,LTAD,TSTPTR
IF MONLEVEL&4#0 THEN START
INTEGER IT,ITT,IC,ICC,MONVAD,MONPTAD,MONLIM
ROUTINESPEC GARNER(INTEGER EVENT,PARAM)
LONGINTEGERNAME LPIT
FINISH
STRING (15) INTMESS
SWITCH ACTIVITY(0:16),VSCAUSE(0:4),ASYN0(1:3),AMTXSW(-4:0)
CONSTINTEGER MAXDIROUT=28
CONSTLONGINTEGER DGLAEPAGES=4; ! EPAGES OF DIRECTOR GLA SPACE
CONSTLONGINTEGER LONGONE=1; ! FOR COMPILE TIME COMPUTATIONS
SWITCH DIROUT(0:MAXDIROUT)
CONSTINTEGER MAXOUTACR=DIRACR; ! UP TO DIRECTOR LEVEL
CONSTBYTEINTEGERARRAY PAGEOUT DELAY(0:10)=1,2,4,8,15(7)
! TOTAL PAGEOUT DELAY>120 SECS
! TO ALLOW TIME TO AUTOLOAD DFC !
!-----------------------------------------------------------------------
! PROCESS CREATE ENTRY ONLY
*LSS_(LNB +0)
*ST_PROCESS; ! FIND PROCESS NO PASSED BY FRIG
PROCESS=INTEGER(PROCESS&X'FFFFFFFC')
*LSS_OLDLNB
*ST_(LNB +0); ! TO ENABLE %MONITOR TO FIND
! GLOBAL VARIABLES
PROC==PROCA(PROCESS)
ME=(PROCESS+LOCSN0)<<16
LSN3=PROCESS+LOCSN3
SERV0==SERVA(PROCESS+LOCSN0)
SERV3==SERVA(LSN3)
! ***** SEMAPHORE?********
SUPPOFF(SERV0,P); ! OBTAIN STARTUP RECORD
!
! INITIALIZE LOCAL STACKS INFO
!
LSTKSSN(1)=4; ! DIRECTOR/USER STACK SEGMENT
LST(5)=LST(1)+X'80'+(DIRACR-LCACR)<<56;! AND SSN+1
LSTKSSN(2)=6; ! SIGNAL STACK
LST(7)=LST(5)+X'80'; ! AND SIGNAL SSN+1
CYCLE I=3,1,LSTKN
LSTKSSN(I)=0
REPEAT
LST(DIRCSEG)=LST(0)&X'FFFC0000FFFFFFFF'+8+(DIRACR-LCACR)<<56+C
LENGTHENI(DIRCSEGL)<<32
ALLOUTP==DIROUTP
IF MONLEVEL&4#0 START
MONVAD=0
IF PROC_STATUS&4=0 THEN LPIT==PERFORM_SERVIT(LOCSN0+2) C
ELSE LPIT==PERFORM_SERVIT(LOCSN0+3)
FINISH
!-----------------------------------------------------------------------
! INITIALISE CLAIMED BLOCK TABLES
CYCLE I=0,1,LSTLEN-1
SST(I)<-X'FFFF'; ! ALL SEGMENTS UNCONNECTED
LST(I)=LST(I)!X'7F00000000'; ! ALL SEGMENTS INACTIVE
REPEAT
ASFREE=X'FFFFFFFF'; ! ALL FREE
ASWAP=0
ASSHR=0
ASWIP=0
PEPARM=-1
PROCACTAD1=X'28000004'
PROCACTAD2=ADDR(PROC_ACTW0); ! %INTEGERNAME DESCRIPTOR
SUSP=0
ASDESTROY=0
! FILL IN SCTI(3)[ALIGNED]
INTEGER(SCTI0+24)=X'38000004'
INTEGER(SCTI0+28)=SCTJ30
! AND J-VECTOR FOR SCTI(3)
LONG INTEGER(SCTJ30)=0
LONG INTEGER(SCTJ30+8)=0
! REQUEST INPUT AS J=1 ENTRY
LONG INTEGER(SCTJ30+16)=X'80F0000000140001'
LONG INTEGER(SCTJ30+24)=RTDR(REQUEST INPUT);! YIELDS DESCR-DESCR
! REQUEST OUTPUT AS J=2 ENTRY
LONG INTEGER(SCTJ30+32)=X'80F0000000140001'
LONG INTEGER(SCTJ30+40)=RTDR(REQUEST OUTPUT); ! YIELDS DESCR-DESCR
! CHANGE CONTEXT AS J=3 ENTRY
LONG INTEGER(SCTJ30+48)=X'80F0000000140001'
LONG INTEGER(SCTJ30+56)=RTDR(CHANGE CONTEXT)
!-----------------------------------------------------------------------
! CONNECT DIRECTOR FILES
! CODE AS SEG2 USING TOP 2 CBTS
! GLA AS SEG3 USING CBT0
! STACK AS SEG4 USING CBT1
SST(2)=CBTLEN-2; SST(3)=0; SST(4)=1
LST(2)=X'5003FFFF00000000'!DIRACR<<52;! EXECUTE &READ
CBTA(CBTLEN-2)_DA=P_P2
CBTA(CBTLEN-2)_TAGS=MAXBLOCK-1
CBTA(CBTLEN-2)_LINK=SMULTIPLE CON;! SYSTEM SHARING OF DIRECTOR
CBTA(CBTLEN-1)_DA=P_P2+MAXBLOCK
CBTA(CBTLEN-1)_TAGS=MAXBLOCK-1
CBTA(CBTLEN-1)_LINK=CONTINUATN BLK!SMULTIPLE CON
LST(3)=X'400003FF00000000'!DIRACR<<52!DIRACR<<56! C
(DGLAEPAGES*EPAGESIZE-1)<<42
CBTA(0)_DA=P_P3
CBTA(0)_TAGS=(DGLAEPAGES-1)!X'80';! GLA IS 'NEWCOPY'
LST(4)=X'4FF003FF00000000'!(LONGONE*MAXBLOCK*EPAGESIZE-1)<<42
CBTA(1)_DA=P_P4
CBTA(1)_TAGS=(MAXBLOCK-1)!X'80';! STACK IS 'NEWCOPY'
!-----------------------------------------------------------------------
IF PROCESS=1 THEN START ; ! SET UP IST ENTRIES ONCE ONLY
! BUT WRITE TO BOTH IST SEGMENTS
! FOR MULTI-PROCESSOR INSTALLATIONS
! SET UP DUMMY IST VECTOR
*STLN_I
ISTDUM_LNB=I
ISTDUM_PSR=X'00140001'
ISTDUM_PC=0
ISTDUM_SSR=X'01803BAE'; ! ONLY EVENT PENDING,PE,VSE&SYSERR
*STSF_I
ISTDUM_SF=I
ISTDUM_IT=MAXIT
ISTDUM_IC=MAXIT
ISTDUM_CTB=0
J=X'80000000'!COM_OCPPORT0<<18; ! IST ADDRESS FOR IPL PROC
K=J!!X'40000'; ! TOTHER OCP IIST
! SET VS ERROR IST ENTRY
*JLK_<VSERRI> ; *LSS_TOS ; *ST_I
ISTDUM_PC=I
RECORD(J+X'80')<-ISTDUM
IF MULTIOCP=YES THEN C
RECORD(K+X'80')<-ISTDUM
! SET INTERVAL TIMER IST ENTRY
*JLK_<ITIMERI> ; *LSS_TOS ; *ST_I
ISTDUM_PC=I
RECORD(J+X'A0')<-ISTDUM
IF MULTIOCP=YES THEN C
RECORD(K+X'A0')<-ISTDUM
! SET PROG ERROR IST ENTRY
*JLK_<PROGERRI> ; *LSS_TOS ; *ST_I
ISTDUM_PC=I
RECORD(J+X'C0')<-ISTDUM
IF MULTIOCP=YES THEN C
RECORD(K+X'C0')<-ISTDUM
! SET UP OUT IST ENTRY
*JLK_<OUTI> ; *LSS_TOS ; *ST_I
ISTDUM_PC=I
RECORD(J+X'100')<-ISTDUM
IF MULTIOCP=YES THEN C
RECORD(K+X'100')<-ISTDUM
! SET INSTRUCTION COUNTER IST ENTRY
*JLK_<ICOUNTERI> ; *LSS_TOS ; *ST_I
ISTDUM_PC=I
ISTDUM_IC=0
RECORD(J+X'160')<-ISTDUM
IF MULTIOCP=YES THEN C
RECORD(K+X'160')<-ISTDUM
! SET SYSTEM CALL IST ENTRY
ISTDUM_LNB=0
ISTDUM_PSR=X'00140001'
ISTDUM_PC=SYSTEMCALL
ISTDUM_SF=ADDR(PROCACTAD1)
ISTDUM_IC=X'30000000'+SCTIENTRIES;! 64 BIT VECTOR DESCRIPTOR TO SCTI
ISTDUM_CTB=SCTI0
RECORD(J+X'E0')<-ISTDUM
IF MULTIOCP=YES THEN C
RECORD(K+X'E0')<-ISTDUM
! SET LOCAL CNTRLR REACTIVATE CONTEXT
*STLN_I
LSSNP1_LNB=I
LSSNP1_PSR=X'00140001'
*JLK_<ENTERI> ; *LSS_TOS ; *ST_I
LSSNP1_PC=I
LSSNP1_SSR=X'01803BAE'
*STSF_I
LSSNP1_SF=I
LSSNP1_IT=MAXIT
LSSNP1_IC=MAXIT
LSSNP1_CTB=0
FINISH
!-----------------------------------------------------------------------
! SET UP DIRECTOR CONTEXT
NEWSTK=LSTKSSN(1)<<18
SSNP1==RECORD(NEWSTK!X'40000')
SSNP1=0
SSNP1_LNB=NEWSTK
SSNP1_PSR=X'00040001'!DIRACR<<20; ! PROG ERRORS UNMASKED
SSNP1_PC=X'00080010'; ! TO M-C CODE DIRLOADER
SSNP1_SSR=X'01800000'; ! ALL INTS ALLOWED
SSNP1_SF=NEWSTK!X'14'; ! 5 WORDS ON FROM LNB
SSNP1_IT=0
SSNP1_IC=MAXIT
SSNP1_B=DIROUTPAD
SSNP1_DR0=X'B1000000'; ! DESCRIPTOR TO ENTRY DESCRIPTOR
SSNP1_DR1=X'000C0000'; ! AT START OF GLA
PROC_STACK=NEWSTK; ! DIRECTOR STACK ON INITIAL ENTRY
!-----------------------------------------------------------------------
!
! THE FOLLOWING RECORDS ARE SQUEEZED INTO THE SPARE WORDS OF SEGMENT 5
! IOSTAT : WORDS 18 - 26
! ICREVS : WORD 27
! ACNT : WORDS 28 - 30
! WORD 31 : USED BY DIRECTOR FOR COUNT OF KINSTRNS
! THERE IS NO MORE SPACE LEFT !!!!
!
IOSTAT==RECORD(NEWSTK!X'40048')
IOSTAT=0
ACNT==RECORD(NEWSTK!X'40070')
ACNT=0
ICREVS==INTEGER(NEWSTK!X'4006C')
ICREVS=X'12345678'
!-----------------------------------------------------------------------
! SET UP SIGNAL CONTEXT
NEWSTK=LSTKSSN(2)<<18
SSNP1==RECORD(NEWSTK!X'40000')
SSNP1=0
SSNP1_LNB=NEWSTK
SSNP1_PSR=X'0004FF01'!DIRACR<<20; ! PROGRAM ERRORS MASKED
SSNP1_PC=X'00080010'; ! TO M-C DIRLOADER ENTRY POINT
SSNP1_SSR=X'01800800'; ! NO INSTRUCTION COUNTER INTS
SSNP1_SF=NEWSTK!X'14'
SSNP1_IT=0
SSNP1_IC=MAXIT
SSNP1_B=0; ! ZERO FOR SIGNAL ENTRY !!!!!
SSNP1_DR0=X'B1000000'
SSNP1_DR1=X'000C0000'
!
! THE FOLLOWING WORDS ARE SQUEEZED INTO SPARE WORDS OF SEGMENT 7
! IE SSN+1 OF THE SIGNAL STACK
! WORD18 = SEMAHELD SET BY DIRECTOR WHEN A SEMAPHORE IS HELD
!
SEMAHELD==INTEGER(NEWSTK!(X'40000'+4*18))
!-----------------------------------------------------------------------
! INITIALISATIONS FOR DIRECTOR
STRING(DIROUTPAD)=SUPID
DIROUTP_SRCE=EPAGESIZE<<16!MAXBLOCK
DIROUTP_P1=PROCESS
STRING(ADDR(DIROUTP_P2))=PROC_USER
BYTEINTEGER(ADDR(DIROUTP_P3)+3)=PROC_INCAR
DIROUTP_P4=SIGOUTPAD
DIROUTP_P5=SCTI0
DIROUTP_P6=1; ! DACT FOR INT MESSGES FROM FE
SIGOUTP_DEST=LSTLEN
SIGOUTP_SRCE=SSTAD
SIGOUTP_P1=CBTLEN-1; ! HIGHEST CBT ENTRY
! WAS ADDR(CBTASL)
SIGOUTP_P2=CBTAD
SIGOUTP_P3=ADDR(ACNT)
SIGOUTP_P4=ADDR(ICREVS)
SIGOUTP_P5=ADDR(IOSTAT)
SIGOUTP_P6=ADDR(SEMAHELD)
!-----------------------------------------------------------------------
! REPLY TO SCHEDULE
POUT=0
POUT_DEST=X'30002'; ! SCHEDULE PROCESS CREATED
POUT_SRCE=ME
POUT_P1=PROCESS
PON(POUT)
!-----------------------------------------------------------------------
RETURN: ! INTERRUPT BACK TO KERNEL
*LSS_X'01803FFF'; ! NO SYSTEM ERROR INTS
*ST_(3)
LSSNP1P=LSSNP1; ! LOCAL CNTRLR REACTIVATE CONTEXT
!
! TO RETURN TO KERNEL REACTIVATE LOCAL CONTROLLER WITH EP SET
! THIS HORRENDOUS PROCEDURE WORKS SINCE WE ARE CERTAIN THAT:-
! 1) II (INSTRUCTION INCOMPLETE) IS NOT SET IN LC CONTEXTJUST SET
! 2) ALL OTHER INTERUPTS ARE MASKED
! HENCE EFFECT IS OF AN "OUT" TO KERNEL !!!
! WILL WORK OK FOR MULTIPROCESSORS (UNLIKE ACTIVATING BACK)
!
*LXN_PROCACTAD2
*LSD_(XNB +0)
*OR_X'0000000100000000'
*SLSD_0; ! LC STACK ADDRESSS (0) NOT PARAMETERISED
*ST_TOS
IF MONLEVEL&4#0 THEN START
*LSS_(6); *ST_IC; *LSS_(5); *ST_IT
LCIC=LCIC+MAXIT-IC
LCIT=LCIT+MAXIT-IT
FINISH
*ACT_TOS
*IDLE_X'B00B'
!-----------------------------------------------------------------------
ENTERI:*JLK_TOS
! NORMAL CALLS REACTIVATE TO HERE
! ****SEMAPHORE********
SUPPOFF(SERV0,P); ! OBTAIN PARAMETER RECORD
IF MONLEVEL&2#0 AND KMON&1 #0 THEN C
PKMONREC("LOCALC:",P)
->ACTIVITY(P_DEST&X'FFFF')
!-----------------------------------------------------------------------
ACTIVITY(1): ! START RESIDENCE PERIOD
! P_P1=EPAGE LIMIT
! P_P2=RESIDENCE TIME LIMIT
! P_P3=ACTIVE EPAGES LIMIT
EPLIM=P_P1
RTLIM=P_P2
! SET UP SSN+1 CONTEXT ADDRESSES
K=INTEGER(LSTVAD+12); ! SEG 1 REAL ADDRESS
CYCLE I=1,1,LSTKN
J=LSTKSSN(I)
IF J#0 THEN INTEGER(LSTVAD+12+8*J)=K+I*X'80'
REPEAT
INTEGER(LSTVAD+4+8*DIRCSEG)=INTEGER(LSTVAD+4)+8
SEMAHELD=0
PROC_STATUS=PROC_STATUS&(¬(HADTONFLY!HADPONFLY!X'11'))
! RESET FOR NEW RESIDENCE
XSTROBE=0
IF SNOOZING=YES THEN SNOOZES=0 AND NONSEQVSIS=-1000
PTEPS=0
PTP=0
LASTDA=0
EPN=0; UEPN=0
PROC_EPN=0
HIGHSEG=2
RETIME: ! START NEW TIMESLICE
SSNP1==RECORD(PROC_STACK!X'40000');! PROCESS CONTEXT
IF SSNP1_IT&X'FF800000'=0 THEN START
IF MONLEVEL&4#0 THEN LPIT=LPIT-SSNP1_IT
ACNT_LTIME=ACNT_LTIME-COM_ITINT*SSNP1_IT;! UNUSED TIME
FINISH
SSNP1_IT=TIMESLICE; ! START NEW TIMESLICE
IF MONLEVEL&4#0 THEN LPIT=LPIT+TIMESLICE
ACNT_LTIME=ACNT_LTIME+COM_ITINT*TIMESLICE
RTN=0
! SEMAPHORE FOR TESTING SERV?
IF SERV3_P<<2#0 AND PROC_STACK#LSTKSSN(2)<<18 THEN ->ASYNCH
IF SUSP#0 THEN ->DIRPONREPLY
ACT: ! ACTIVATE INTO USER PROCESS
IF KERNELQ#0 THEN ->ONFRUNQ; ! DO ANY KERNEL SERVICES
!
! COUNT ACTIVATIONS TO PROCESS
!
IF MONLEVEL&4#0 THEN START
IF PROC_STATUS&4=0 THEN FLPN=FLPN+1 ELSE BLPN=BLPN+1
*LSS_(6); *ST_IC; *LSS_(5); *ST_IT
LCIC=LCIC+MAXIT-IC
LCIT=LCIT+MAXIT-IT
FINISH
*LSS_(3); *AND_X'FFFFCFF5'; *ST_(3);! UNMASK PERI&EXTERNAL INT
*LXN_PROCACTAD2; ! ADRRESS OF ACTIVATE WORDS
*ACT_(XNB +0)
!-----------------------------------------------------------------------
ACTIVITY(2): ! CONTINUE WITH CORE RESIDENCE
PROC_STATUS=PROC_STATUS&(¬2); ! IN CASE CAME FROM ONFRUNQ
ACTIVATE: ! CHECK ASYNCH MESSAGE
! **** SEMAPHORE FOR CHECK?
IF SERV3_P<<2=0 OR PROC_STACK=LSTKSSN(2)<<18 THEN ->ACT
IF SST(LSTKSSN(2))=X'FFFF' THEN ->ACT;! SIGNAL STACK NOT CREATED(STARTUP)
! OR HAS BEEN DESTROYED(CLOSEDOSN)
!-----------------------------------------------------------------------
ASYNCH: ! ASYNCHRONOUS MESSAGE POFFABLE
SUPPOFF(SERV3,P)
I=P_DEST&X'FFFF'
IF I=0 THEN ->ASYN0(P_P1)
IF I=X'FFFF' THEN OPMESS("PROCESS ".STRINT(PROCESS). C
" TERMINATED") AND NEWSTK=PROC_STACK AND ->TERMINATE
IF I=X'FFFE' THEN START
*OUT_99; ! CRASH WITH MASKED OUT INT
FINISH
IF I=X'FFFD' START
*PUT_0; *PUT_0; ! FAIL WITH ILLEGAL INSTRN
FINISH
UNLESS I=1 THEN ->SIGINT
INTMESS<-P_INTMESS
IF LENGTH(INTMESS)=1 THEN START
IF P_P2>=0 AND IOSTAT_IAD#P_P2 THEN IOSTAT_IAD=P_P2
SIGINT: SIGOUTP<-P
SIGOUTP_TYPE=3
SIGOUTP_SSN=CURSSN
SIGOUTP_SSNAD=PROC_STACK
SIGOUTP_SUSP=SUSP; ! PRESERVE SUSPEND STATUS
SUSP=0
NEWSTK=LSTKSSN(2)<<18
SIGACT: ! SWOP IT & IC
ALLOUTP==SIGOUTP
LONG INTEGER(NEWSTK!X'40014')=LONG INTEGER(PROC_STACK!X'40014')
PROC_STACK=NEWSTK
SSNP1==RECORD(NEWSTK!X'40000')
IF SSNP1_LNB>>18#NEWSTK>>18 OR SSNP1_LNB>>18#SSNP1_SF>>18 C
OR SSNP1_PSR&3=0 THEN PRINT STRING("
ACTIVATE CONTEXT INVALID") AND ->TERMINATE
->ACTIVATE
FINISH ELSE START
IF LENGTH(INTMESS)>1 THEN IOSTAT_INTMESS=INTMESS
IF P_P2>=0 AND IOSTAT_IAD#P_P2 THEN START
IOSTAT_IAD=P_P2
IF SUSP<0 THEN SUSP=0
FINISH
RESUSP:
! **** SEMAPHORE NEEDED FOR TEST?
IF SERV3_P<<2#0 THEN ->ASYNCH
IF SUSP=0 THEN ->ACT
! AVOID RESUSPENDING IF UNNECESSARY
IF SUSP&X'7FFFFFFF'<=LOCSN3 THEN START
SERV==SERVA(SUSP)
IF SERV_P<<2#0 THEN ->DPR;! DIRPONREPLY
FINISH
SRCE=SUSP
->SUSPWS; ! MAY JUST HAVE SWAPPED STACK !
FINISH
!-----------------------------------------------------------------------
ASYN0(1): ! DISC READ FAILS
PEPARM=P_P2!18; ! TOP 22 BITS ARE VIRTADDR OF PAGE
->PE
ASYN0(2): ! RELEASE ACTIVE BLOCKS
DEACTIVATE(¬ASFREE); ! IE ALL USED ACTIVATE BLKS
PROC_STATUS=PROC_STATUS!24; ! SET AMT GOING & AMT GONE BITS
->RESUSP
ASYN0(3): ! DUMMY AWAKEN FOR RECONFIGTN
IF SUSP#0 THEN SRCE=SUSP AND ->SUSPWS
IF LOCKST=0 THEN ->DEAD; ! DEPART IF NO LOCKED DOWN AREA
->ACT; ! RESUME TO FREE LOCKED DOWN AREA
!-----------------------------------------------------------------------
ACTIVITY(3): ! CONTINUE AFTER SUSP ON FLY
IF SNOOZING=YES THEN START
IF MONLEVEL&4#0 THEN PERFORM_SNOOZN=PERFORM_SNOOZN+EPN
EPLIM=P_P1
RTLIM=P_P2
! SNOOZES=SNOOZES+1
NONSEQVSIS=0
CLEAR ACCESSED BITS
! STROBE %IF SNOOZES&15=0
ACNT_PTURNS=ACNT_PTURNS+EPN
PROC_STATUS=PROC_STATUS&(¬(HADPONFLY!HADTONFLY))
! RESET FOR NEW RESIDENCE
->RETIME
FINISH
!----------------------------------------------------------------------
VSERRI:*JLK_TOS
! VIRTUAL STORE INTS ENTER HERE
*LSS_TOS ; *ST_I; ! OLD STACK
*LSS_TOS ; ! PARAMETER
*ST_VSPARM
IF I=0 THEN ->LCPE; ! LC CAN HAVE NO VSIS!
IF VSPARM<0 THEN PEPARM=9 AND ->PE;! PUBLIC VSI
VSSEG=VSPARM>>18
IF 0<VSSEG<LSTLEN THEN TSTPTR=LST(VSSEG)>>32&127
VSEPAGE=VSPARM>>EPAGESHIFT&(SEGEPSIZE-1)
IF MONLEVEL&4#0 AND MONVAD>0 THEN GARNER(0,VSPARM)
->VSCAUSE(VSPARM&7)
!-----------------------------------------------------------------------
VSCAUSE(0):VSCAUSE(2):VSCAUSE(3):
VSE: ! VS ERRORS
SIGOUTP_P1=VSPARM
SIGOUTP_P2=PROC_STACK
SIGOUTP_TYPE=1
SIGOUTP_SSN=CURSSN
SIGOUTP_SSNAD=PROC_STACK
SIGOUTP_SUSP=0
NEWSTK=LSTKSSN(2)<<18
IF PROC_STACK=NEWSTK THEN START
PRINT STRING("VS ERROR ON SIGNAL STACK PARM=".STRHEX(VSPARM)."
")
->TERMINATE
FINISH
->SIGACT
!-----------------------------------------------------------------------
VSCAUSE(1): ! SEGMENT NOT AVAILABLE
IF SST(VSSEG)=X'FFFF' THEN ->VSE;! NO CONNECTION
SEGLEN=LST(VSSEG)>>(32+EPAGESHIFT)&(SEGEPSIZE-1)+1
!
! IF THE SEGMENT IS NOT AVAILABLE THE HARDWARE HAS NOT CHECKED THAT
! THE PAGE IS WITHIN THE SEGMENT LIMIT. DO THIS BY SOFTWARE
!
IF VSEPAGE>=SEGLEN THEN VSPARM=VSPARM!3 AND ->VSE
IF SEGLEN<=PTEPS THEN ->OLDPTP
IF EPN>=EPLIM THEN ->NOPAGES
IF MULTIOCP=YES THEN START
*INCT_(STORESEMA)
*JCC_8,<SSEMAGOT>
SEMALOOP(STORESEMA,0)
SSEMAGOT:
FINISH
IF FREE EPAGES>0 START
STOREX=QUICK EPAGE(0,-1)
IF MULTI OCP=YES START ; *TDEC_(STORESEMA); FINISH
->ACT9
FINISH
POUT_SRCE=ME!9
POUT_P2=0; ! CLEAR TO ZERO
GET EPN=GET EPN+1
IF MULTIOCP=YES START ; *TDEC_(STORESEMA); FINISH
IF PAGEFREES<=1 AND GETEPN>=MPLEVEL+1-COM_NOCPS THEN C
POUT_DEST=X'20000' AND PON(POUT)
POUT_DEST=X'50000'
PON(POUT)
->RETURN
!-----------------------------------------------------------------------
ACTIVITY(9): ! REPLY FROM GET EPAGE FOR PT
STOREX=P_P2
IF STOREX=0 THEN ->DEAD; ! DEADLY EMBRACE RECOVERY
ACT9: ! PAGE TABLE EPAGE HERE
ST==STORE(STOREX)
ST_LINK=PTP; ! LIST OF PAGE TABLE PAGES
PTP=STOREX
PTAD=ST_REALAD
ST_USERS=1
EPN=EPN+1
UEPN=UEPN+1
PROC_EPN=EPN
PTEPS=256
OLDPTP: ! ROOM IN OLD PAGETABLE PAGE
LST(VSSEG)=LST(VSSEG)!X'0000000080000001'!PTAD
IF VSSEG>HIGHSEG THEN HIGHSEG=VSSEG
PTEPS=PTEPS-SEGLEN
PTAD=PTAD+((SEGLEN*EPAGESIZE+1)//2)<<3;! 8 BYTE BOUNDARY !
! RUN ON INTO A VSCAUSE(4)
!-----------------------------------------------------------------------
VSCAUSE(4): ! PAGE NOT AVAILABLE
IF EPN>=EPLIM THEN ->NOPAGES
CBTP=SST(VSSEG)+VSEPAGE//MAXBLOCK
EPX=VSEPAGE&(MAXBLOCK-1)
CBT==CBTA(CBTP)
IF CBT_TAGS&X'20'=0 THEN START ;! BLOCK NOT ACTIVE
IF TSTPTR&127=127 THEN START ;! SEGMENT NOT ACTIVE
IF ASFREE=0 THEN FREE AS; ! NO FREE SLOTS
*LSS_ASFREE
*SHZ_ASP
TSTPTR=ASP
I=LSTVAD+8*VSSEG
INTEGER(I)=INTEGER(I)&X'FFFFFF80'!ASP
ASEG(ASP)=VSSEG
AS(ASP)=0
ASB=TOPBIT>>ASP
ASWIP=ASWIP!ASB; ! INSERT BIT
IF CBT_LINK&SMULTIPLE CON#0 THEN ASSHR=ASSHR!ASB
ASFREE=ASFREE&(¬ASB); ! REMOVE BIT
FINISH
POUT_DEST=X'80001'; ! GET AMTX
POUT_SRCE=0
POUT_P1=PROCESS
POUT_P2=CBT_DA
POUT_P3=(CBT_TAGS&X'80')<<24!CBT_TAGS
! NEWBIT<<31 ! LENGTH
! %IF CBT_TAGS&X'80'#0 %AND LST(VSSEG)>>56&15=0 %THEN %START
! OPMESS(PROC_USER."CONNECT MODE?? CALL PDS")
! OPMESS("DA=".STRHEX(CBT_DA))
! %FINISH
IF MONLEVEL&12=12 THEN START
*LSS_(6); *ST_IC; *LSS_(5); *ST_IT
FINISH
ACTIVE MEM(POUT)
IF MONLEVEL&12=12 THEN START
*LSS_(5); *IRSB_IT; *IMYD_1; *ST_TOS
*IAD_(AMIT); *ST_(AMIT)
*LSD_(LCIT); *ISB_TOS ; *ST_(LCIT)
*LSS_(6); *IRSB_IC; *IMYD_1; *ST_TOS
*IAD_(AMIC); *ST_(AMIC)
*LSD_(LCIC); *ISB_TOS ; *ST_(LCIC)
AMCALLN=AMCALLN+1
FINISH
IF POUT_P2<=0 THEN ->AMTXSW(POUT_P2)
CBT_AMTX=POUT_P2
CBT_TAGS=CBT_TAGS&X'7F'!X'20'; ! NO LONGER NEW BUT ACTIVE
FINISH
POUT_DEST=X'40001'; ! PAGETURN/PAGE-IN
POUT_SRCE=ME!X'8000000A'; ! REPLY TO ACTIVITY 10
POUT_P1=CBT_AMTX<<16!EPX
IF MONLEVEL&2#0 THEN C
POUT_P2=VSPARM; ! NOT USED.FOR KMON ONLY
IF MONLEVEL&12=12 THEN START
*LSS_(6); *ST_IC; *LSS_(5); *ST_IT
FINISH
PAGETURN(POUT)
IF MONLEVEL&12=12 THEN START
*LSS_(5); *IRSB_IT; *IMYD_1; *ST_TOS
*IAD_(PTIT); *ST_(PTIT)
*LSD_(LCIT); *ISB_TOS ; *ST_(LCIT)
*LSS_(6); *IRSB_IC; *IMYD_1; *ST_TOS
*IAD_(PTIC); *ST_(PTIC)
*LSD_(LCIC); *ISB_TOS ; *ST_(LCIC)
PTCALLN=PTCALLN+1
FINISH
IF POUT_DEST#0 THEN PTE=X'80000001'!POUT_P2 AND ->ACT10
IF CBT_LINK&ADVISORY SEQ#0 OR C
(VSSEG#PROC_STACK>>18 AND AS(TSTPTR)<<VSEPAGE=0 AND C
AS(TSTPTR)>>(64-VSEPAGE)&3=3) THEN C
PAGEOUT(VSSEG,VSEPAGE-2,CBT) ELSE NONSEQVSIS=NONSEQVSIS+1
PROC_STATUS=PROC_STATUS!2; ! DEMAND PAGE PRIORITY
->RETURN
!-----------------------------------------------------------------------
ACTIVITY(10): ! EPAGE HERE
! P_P1=RUBBISH IDENT
! P_P2=STORE(EPAGE)_REALAD
! VSSEG,VSEPAGE&TSTPTR INTACT !!
EPH:
PROC_STATUS=PROC_STATUS&X'FFFFFFFD'
PTE=X'80000001'!P_P2
ACT10: ! ENTERS HERE IF PAGE NOT TRANFRD
ASP=TSTPTR
AS(ASP)=AS(ASP)!LTOPBIT>>VSEPAGE
ASB=TOPBIT>>ASP
ASWAP=ASWAP!ASB
ASWIP=ASWIP&(¬ASB)
EPN=EPN+1
IF CBT_LINK&SMULTIPLE CON=0 THEN UEPN=UEPN+1
PROC_EPN=EPN
ACNT_PTURNS=ACNT_PTURNS+1
!
! PT==ARRAY(VIRTAD+LST(VSSEG)&X'0FFFFFF8'+VSEPAGE*EPAGESIZE<<2,PTF)
! %CYCLE I=0,1,EPAGESIZE-1
! PT(I)=PTE+I<<10
! %REPEAT
! THIS HAND CODE ASSUMES EPAGESIZE=4
I=VIRTAD+LST(VSSEG)&X'0FFFFFF8'+VSEPAGE*16
*LXN_I
*LSS_PTE; *ST_(XNB +0)
*IAD_1024; *ST_(XNB +1)
*IAD_1024; *ST_(XNB +2)
*IAD_1024; *ST_(XNB +3)
->ACTIVATE
!--------------------------------------------
ACTIVITY(11): ! PAGE READ FAILURE
IF P_P3<0 THEN ->DEAD
POUT_DEST=LSN3<<16
POUT_P1=1
POUT_P2=VSSEG<<18!VSEPAGE*EPAGESIZE<<10
PON(POUT)
->EPH
!-----------------------------------------------------------------------
! DEADLOCK RECOVERY
DEAD: WORKSET(0); ! DEPART TO FREE STORE
POUT_DEST=X'3000E'
POUT_P1=PROCESS
PON(POUT)
->RETURN
!-----------------------------------------------------------------------
AMTXSW(0): ! CHANGE BLOCK SIZE IN SITU ?
AMTXSW(-4): ! clears still in progress
WAIT(2,1); ! TRY AGAIN IN 1 SEC
->RETURN
AMTXSW(-1): ! NO AMT CELLS AVAILABLE
AMTXSW(-2): ! NOT ENOUGH GARBAGE
DEACTIVATE(¬ASFREE)
->ACTIVATE
AMTXSW(-3): ! CHANGE BLOCK SIZE WHEN STILL IN USE
PEPARM=19
->PE
!-----------------------------------------------------------------------
ITIMERI:*JLK_TOS
! INTERVAL TIMER INTERRUPTS ENTER HERE
*LSS_TOS ; *LSS_TOS
!
! IF A SEMA HELD GIVE A SMALL AMOUNT MORE TIME WITHOUT LETTING NEXT
! PERSON ON RUNQ GET THE CPU AS HE MIGHT ALSO WANT THE SEMA
!
IF SEMAHELD#0 START
SEMAHELD=0
SSNP1==RECORD(PROC_STACK!X'40000')
SSNP1_IT=TIMESLICE>>3; ! EIGHTH OF TIME SLICE
IF MONLEVEL&4#0 THEN LPIT=LPIT+TIMESLICE>>3
ACNT_LTIME=ACNT_LTIME+COM_ITINT*(TIMESLICE>>3)
->ACT
FINISH
RTN=RTN+1
IF RTN=1 THEN START
PROC_RUNQ=CATTAB(PROC_CATEGORY)_RQTS2
IF MONLEVEL&1#0 THEN C
UPDISP(PROCESS,11,"R".TOSTRING(PROC_RUNQ+'0'))
FINISH ELSE START
IF RTN=RTLIM THEN START
POUT_DEST=X'3000B'; ! MORE TIME ON THE FLY ?
POUT_SRCE=0
POUT_P1=PROCESS
POUT_P2=EPN
IF MONLEVEL&4#0 AND MONVAD>0 THEN C
GARNER(7,2<<24!PROC_CATEGORY<<16!EPN)
IF MONLEVEL&12=12 THEN START
*LSS_(6); *ST_IC; *LSS_(5); *ST_IT
FINISH
SCHEDULE(POUT)
IF MONLEVEL&12=12 THEN START
*LSS_(6); *ST_ICC; *LSS_(5); *ST_ITT
PERFORM_SERVIT(3)=PERFORM_SERVIT(3)+(IT-ITT)
LCIT=LCIT-(IT-ITT)
PERFORM_SERVIC(3)=PERFORM_SERVIC(3)+(IC-ICC)
LCIC=LCIC-(IC-ICC)
PERFORM_SERVN(3)=PERFORM_SERVN(3)+1
FINISH
IF POUT_P1=0 THEN START
WORKSET(0)
POUT_DEST=X'30004'; ! OUT OF TIME
POUT_SRCE=ME!1
POUT_P1=PROCESS
POUT_P2=EPN; ! EPAGES USED SO FAR
PON(POUT)
->RETURN
FINISH
EPLIM=POUT_P1
RTLIM=POUT_P2
RTN=0
STROBE(0) IF POUT_P3#0; ! NEWCAT_STROBEI#0
FINISH ELSE START
I=CATTAB(PROC_CATEGORY)_STROBEI
IF I#0 AND RTN-(RTN//I)*I=0 THEN STROBE(0)
FINISH
FINISH
SSNP1==RECORD(PROC_STACK!X'40000')
SSNP1_IT=TIMESLICE
IF MONLEVEL&4#0 THEN LPIT=LPIT+TIMESLICE
ACNT_LTIME=ACNT_LTIME+COM_ITINT*TIMESLICE
IF PROCESS>1 AND (RUNQ1#0 OR (PREEMPTED!RUNQ2#0 AND PROC_RUNQ=2)) START
POUT_DEST=ME!2
->ONBRUNQA
FINISH
->ACTIVATE; ! START NEXT TSLICE AT ONCE
!-----------------------------------------------------------------------
ONFRUNQ: ! PUT ON FRONT OF RUNQ
POUT_DEST=ME!2
ONFRUNQA:
PROC_STATUS=PROC_STATUS!2; ! SET PRIORITY BIT
ONBRUNQA: ! TO THE BACK OF RUNQ
PON(POUT)
->RETURN
!-----------------------------------------------------------------------
NOPAGES: ! NO EPAGES FOR PAGEFLT
IF MONLEVEL&4#0 AND MONVAD>0 THEN C
GARNER(7,3<<24!PROC_CATEGORY<<16!EPN)
IF EPLIM<MAXEPAGES THEN START
POUT_DEST=X'3000A'; ! MORE EPAGES ON THE FLY ?
POUT_SRCE=0
POUT_P1=PROCESS
POUT_P2=RTN
POUT_P5=EPN
POUT_P6=PROC_CATEGORY
IF MONLEVEL&12=12 THEN START
*LSS_(6); *ST_IC; *LSS_(5); *ST_IT
FINISH
SCHEDULE(POUT)
IF MONLEVEL&12=12 THEN START
*LSS_(6); *ST_ICC; *LSS_(5); *ST_ITT
PERFORM_SERVIT(3)=PERFORM_SERVIT(3)+(IT-ITT)
LCIT=LCIT-(IT-ITT)
PERFORM_SERVIC(3)=PERFORM_SERVIC(3)+(IC-ICC)
LCIC=LCIC-(IC-ICC)
PERFORM_SERVN(3)=PERFORM_SERVN(3)+1
FINISH
IF POUT_P1#0 THEN START
EPLIM=POUT_P1
RTLIM=POUT_P2
RTN=0
STROBE(0) IF POUT_P3#0; ! NEWCAT_STROBEI#0
->ACTIVATE
FINISH
FINISH
IF XSTROBE<0 THEN START ; ! HAD A CHANGE CONTEXT SINCE LAST STROBE
STROBE(1)
IF EPN<EPLIM THEN ->ACTIVATE;! GOT SOME BACK !
FINISH
WORKSET(1)
POUT_DEST=X'30003'; ! OUT OF EPAGES
POUT_SRCE=ME!1
POUT_P1=PROCESS
POUT_P2=RTN; ! TIMESLICES USED SO FAR
IF EPLIM>=MAXEPAGES AND RTN=0 AND PROCESS>=FIRST UPROC THEN C
DPON(POUT,COM_USERS//10) ELSE PON(POUT)
->RETURN
!-----------------------------------------------------------------------
ACTIVITY(7): ! MORE ALLOCATION AVAILABLE
!-----------------------------------------------------------------------
PROGERRI:*JLK_TOS
! PROGRAM ERROR INTERRUPTS ENTER HERE
*LSS_TOS
*ST_I; ! CHECK OLD STACK FOR L-C STACK
*LSS_TOS
*ST_PEPARM
!
! SOME P4 TAKES PHOTO ON PROGERRORS SO CLEAR INHIBIT PHOTOT BIT OR WE
! MAY LOSE THE PHOTO ON SUBSEQUENT M-C FAILURE
!
IF BASICPTYPE=4 START
*LSS_(X'4012'); *AND_X'FEFFFFFF'; *ST_(X'4012')
FINISH
LCPE: ! L-C HAS PE OR ILLEAGL VSI
IF I=0 START ; ! I IS OLD STACK NO
*ASF_16; ! preserve stack top for diags
OPMESS("LOCAL CNTRLR FAILS".STRHEX(PEPARM))
*LSS_(3); *USH_-26; *AND_3; *ST_J
OPMESS("OCP".TOSTRING(J+48)." STK ".STRHEX(I))
DUMPTABLE(0,LST(1)&X'0FFFFF80'+X'81000000',72);! REGS
DUMPTABLE(1,INTEGER(X'660')&X'0FFFFF80'+X'81000000',4096)
! PAGE 1 OF LCSTACK
PEPARM=22; ! PASS TO DIRECTOR
LCERRS=LCERRS+1
IF LCERRS>3 THEN ->RETURN
FINISH
PE: ! SOFTWARE DETECTED ERRORS JOIN
! 16 = ILLEGAL SYSTEM CALL
! 17 = EXCESS INTRUCTIONS
! 18 = DISC READ FAILS
! 19 = CHANGE BLOCK SIZE
! 20 = H-W ERROR (OCP OR STORE)
! 21 = ILLEGAL OUT
! 22 = LOCAL CONTROLLER FAILS
SIGOUTP_P1=PEPARM
SIGOUTP_P2=PROC_STACK
SIGOUTP_TYPE=2
SIGOUTP_SSN=CURSSN
SIGOUTP_SSNAD=PROC_STACK
SIGOUTP_SUSP=0
NEWSTK=LSTKSSN(2)<<18
IF PROC_STACK=NEWSTK THEN START
PRINT STRING("PROGRAM ERROR ON SIGNAL STACK CLASS="C
.STRINT(PEPARM&255)." SUBCLASS=".STRINT(PEPARM>>8&255)."
")
->TERMINATE
FINISH
->SIGACT
!-----------------------------------------------------------------------
OUTI:*JLK_TOS
! LOCAL OUTS ENTER HERE
*LSS_TOS
*ST_J
*LSS_TOS
*ST_OUTN
IF 0<=OUTN<=MAXDIROUT THEN START
IF PROC_STACK=LSTKSSN(2)<<18 AND 1<<OUTN&X'1819C54B'=0 C
THEN -> ILLEGAL OUT
! ALLOWS OUT 0,1,3,6,8,10,14,15
! 16,19,20,27,28 FROM SIGNAL STACK
->DIROUT(OUTN) IF INTEGER(J!X'40004')>>20&X'F'<=MAXOUTACR
FINISH
ILLEGAL OUT: ! GIVE PROGRAM ERROR OUT ACR CHK
PEPARM=21!OUTN<<8
->PE
FREACT: ! REACTIVATE AFTER INVALID OUT
! NB OUT19 USES SIGOUTP!
ALLOUTP_DEST=-1
->ACTIVATE
REACT: ! REACTIVATE AFTER VALID OUT
ALLOUTP_DEST=0
->ACTIVATE
!-----------------------------------------------------------------------
TERMINATE: ! STOP THE PROCESS(EMERGENCY!)
J=NEWSTK>>18+1; ! SSN+1 NUMBER
J=LST(J)&X'0FFFFF80'; ! ITS REAL ADDRESS
PRINTSTRING(PROC_USER." FAILING SSN+1")
DUMP TABLE(0,X'81000000'+J,72)
! NEXT 2 LINES ARE TO HELP TONY
PRINTSTRING("SEGMENT 5")
DUMPTABLE(1,X'81000000'+LST(5)&X'0FFFFF80',72)
! CREATE STOPPING MSGE TO DIRECT
ALLOUTP_P1=PROCESS
ALLOUTP_P2=PROC_INCAR
STRING(ADDR(ALLOUTP_P3))=PROC_USER
ASDESTROY=0; ! PRESERVE EVERYTHING
DOUT0: ! NORMAL STOPS JOIN HERE
DEACTIVATE(¬ASFREE)
ASDESTROY=0
IF SEMAHELD#0 THEN C
OPMESS("PROC".STRINT(PROCESS)." DIES WITH SEMA")
RETURN PTS
ALLOUTP_DEST=(LOCSN1+1)<<16!X'17';! DIRECT=PROCESS 1
! X'17' NOT YET PARAMETERISED !!!
ALLOUTP_SRCE=(LOCSN1+PROCESS)<<16
PON(ALLOUTP)
IF DAP FITTED=YES AND PROC_STATUS&2****10#0 START ;! STILL HAS DAP
POUT_DEST=X'1F0009'
POUT_SRCE=ME
PON(POUT)
FINISH
POUT_DEST=X'30008'; ! SCHEDULE/DESTROY
POUT_SRCE=ME
POUT_P1=PROCESS
PON(POUT)
->RETURN
!-----------------------------------------------------------------------
DIROUT(0): ! DIRECTOR STOPS PROCESS(NORMAL)
ASDESTROY=1; ->DOUT0; ! DESTROY ALL (REMAINING) FILES
DIROUT(1): ! PRINT STRING FOR DIRECTOR
IF ALLOUTP_DEST>>24>31 THEN ->FREACT
PRINT STRING(STRING(ADDR(ALLOUTP_DEST)))
->REACT
!-----------------------------------------------------------------------
DIROUT(2): ! INPUT REQUEST MESSAGE
IF ALLOUTP_P3#IOSTAT_IAD THEN ->ACTIVATE;! INPUT ALREADY HERE
POUT=ALLOUTP
POUT_DEST=X'00370006'
POUT_SRCE=LSN3<<16!1
PON(POUT)
SRCE=X'80000000'!LSN3; ! TOP BIT SET FOR INPUT WAIT
->SUSPWS
!-----------------------------------------------------------------------
DIROUT(3): ! DISCONNECT SEGMENT
! ALLOUTP_P1=SEG, P2#0 DESTROY
VSSEG=ALLOUTP_P1
->FREACT UNLESS 0<=VSSEG<LSTLEN AND SST(VSSEG)#X'FFFF'
IF ALLOUTP_P2#0 THEN ASDESTROY=1
TSTPTR=LST(VSSEG)>>32&127
DA=CBTA(SST(VSSEG))_DA
J=ACNT_PTURNS
IF TSTPTR#127 THEN ASOUT(TSTPTR)
J=ACNT_PTURNS-J; ! NO OF TRANSFERS STARTED BY DCONNECT
ASDESTROY=0
LST(VSSEG)=LST(VSSEG)&X'FFFFFFFF00000000'
IF J=0 OR PROCESS<=3 THEN ->REACT
POUT_DEST=ME!16
->ONBRUNQA; ! WILL REENTER AT ACTIVITY(16)
!
! SINCE PROCESSES ARE ARE ALLOWED TO RUN ON AFTER DISCONNECT VERY
! LARGE NUMBERS OF PAGEOUTS AND CLEARS CAN BUILD UP. THIS RUINS RESPONSE
! SO IF THERE ARE A LARGE NUMBER OF CLEARS HOLD THIS PROCESS UNTIL
! PREVIOUS DISCONNECT(WHICH INVOLVED TRANSFERS) HAS COMPLETED
!
ACTIVITY(16): ! RE-ENTRY AFTER WAIT FOR CLEARS
IF DCLEARS+PAGEFREES>100 AND LASTDA#0 C
AND CHECKDA(LASTDA)>0 THEN WAIT(16,1) AND ->RETURN
LASTDA=DA
->REACT
!-----------------------------------------------------------------------
DIROUT(4): ! reactivate for director
->REACT
!-----------------------------------------------------------------------
DIROUT(5): ! PON FOR DIRECTOR
SRCE=PROCESS+LOCSN1
DIRPONS: ! OTHER PONS JOIN HERE
DEST=ALLOUTP_DEST>>16
IF DEST=X'FFFF' THEN START ; ! RELAY MESSAGE
IF FIND PROCESS=0 THEN ->ACTIVATE;! NOT LOGGED ON
FINISH ELSE START
J=DEST; IF J=63 THEN J=ALLOUTP_P6>>16
UNLESS 0<=J<LOCSN0 OR LOCSN1<J<=MAXSERV THEN ->FREACT
FINISH
IF DEST#0 THEN START
I=ALLOUTP_SRCE&X'FFFF'
IF SRCE=LSN3 AND (I=0 OR I=X'FFFF') THEN ->FREACT
ALLOUTP_SRCE=SRCE<<16!I
PON(ALLOUTP)
FINISH
POUT_DEST=ME!12
IF LOCKST#0 THEN ->ONBRUNQA; ! FOR EDAR AND TAPES
->ONFRUNQA
!-----------------------------------------------------------------------
ACTIVITY(12): ! RE-ENTRY AFTER DIRECTOR PON
PROC_STATUS=PROC_STATUS&(¬2)
IF SRCE>LOCSN3 THEN START
IF SERV3_P<<2#0 THEN ->ASYNCH
FINISH ELSE START
SERV==SERVA(SRCE)
IF SERV_P<<2#0 THEN SUPPOFF(SERV,ALLOUTP) AND ->ACTIVATE
FINISH
SUSPWS: !SUSPEND AWAITING A REPLY
! TRY TO STAY IN STORE IF CORE
! IS PLENTIFUL
IF SNOOZING=YES THEN START
->DEPART IF PROC_STATUS&AMTLOST#0
IF NONSEQVSIS>1 OR XSTROBE<0 THEN STROBE(1)
I=UEPN*COM_USERS
->DEPART UNLESS I<COM_SEPGS OR PROCESS<=3 OR C
(SFC FITTED=NO AND (PROC_CATEGORY=3 OR LOCKST#0 OR C
8*UEPN<FREEEPAGES-MAXEPAGES))
POUT_DEST=X'30012'
POUT_SRCE=SRCE&X'7FFFFFFF'
POUT_P1=PROCESS
POUT_P2=EPN
IF MONLEVEL&12=12 THEN START
*LSS_(6); *ST_IC; *LSS_(5); *ST_IT
FINISH
SCHEDULE(POUT)
IF MONLEVEL&12=12 THEN START
*LSS_(6); *ST_ICC; *LSS_(5); *ST_ITT
PERFORM_SERVIT(3)=PERFORM_SERVIT(3)+(IT-ITT)
LCIT=LCIT-(IT-ITT)
PERFORM_SERVIC(3)=PERFORM_SERVIC(3)+(IC-ICC)
LCIC=LCIC-(IC-ICC)
PERFORM_SERVN(3)=PERFORM_SERVN(3)+1
FINISH
IF POUT_P1=0 THEN START ; ! SUSPED ON FLY
IF MONLEVEL&4#0 AND MONVAD>0 THEN GARNER(5,EPN)
SUSP=SRCE; ->RETURN
FINISH
FINISH
ACTIVITY(8):DEPART: ! suspended but must now go
IF MONLEVEL&4#0 AND MONVAD>0 THEN C
GARNER(7,1<<24!PROC_CATEGORY<<16!EPN)
WORKSET(1)
POUT_DEST=X'30005'; ! SUSPEND
POUT_SRCE=SRCE&X'7FFFFFFF'; ! TO UNINHIBIT SRCE IN "SCHEDULE"
POUT_P1=PROCESS
POUT_P2=EPN; ! EPAGES USED SO FAR
POUT_P5=EPN
POUT_P6=PROC_CATEGORY
PON(POUT)
SUSP=SRCE
IF PROC_STACK=LSTKSSN(2)<<18 THEN PRINT STRING("
SUSPENDED IN SIGNAL STATE") AND NEWSTK=LSTKSSN(2)<<18 AND ->TERMINATE
->RETURN
!-----------------------------------------------------------------------
DIRPONREPLY: ! REPLY HAS WOKEN PROCESS UP
SERV==SERVA(SUSP)
DPR: SUPPOFF(SERV,ALLOUTP)
SUSP=0
->ACTIVATE
!-----------------------------------------------------------------------
DIROUT(6): ! PON & CONTINUE
SRCE=PROCESS+LOCSN1
DIRPONC: ! OTHER PONS JOIN HERE
DEST=ALLOUTP_DEST>>16
IF DEST=X'FFFF' THEN START
IF FIND PROCESS=0 THEN ->ACTIVATE
FINISH ELSE START
J=DEST; IF J=63 THEN J=ALLOUTP_P6>>16
UNLESS 0<=J<LOCSN0 OR LOCSN1<J<=MAXSERV THEN ->FREACT
FINISH
IF DEST#0 THEN START ; ! DEST#0 PON &CONTINUE
I=ALLOUTP_SRCE&X'FFFF'
IF SRCE=LSN3 AND (I=0 OR I=X'FFFF') THEN ->FREACT
ALLOUTP_SRCE=SRCE<<16!I
PON(ALLOUTP)
->ACTIVATE; ! PDS THINKS THIS WILL BE BETTER
! THAN THE ORIGINAL LINE
->ONFRUNQ
FINISH
! DEST=0 TOFF & CONTINUE
IF SRCE>LOCSN3 THEN START
IF SERV3_P<<2#0 THEN ->ASYNCH
ALLOUTP_DEST=0
FINISH ELSE START
SERV==SERVA(SRCE)
IF SERV_P<<2#0 THEN SUPPOFF(SERV,ALLOUTP) C
ELSE ALLOUTP_DEST=0
FINISH
->ACTIVATE
!----------------------------------------------------------------------
DIROUT(7): ! ALTERNATE PON FOR DIRECTOR
SRCE=PROCESS+LOCSN2
->DIRPONS
!-----------------------------------------------------------------------
DIROUT(8): ! ALT PON & CONTINUE
SRCE=PROCESS+LOCSN2
->DIRPONC
!-----------------------------------------------------------------------
DIROUT(9): ! ASYNCHRONOUS REPLY PON & SUSPEND
SRCE=LSN3
->DIRPONS
!-----------------------------------------------------------------------
DIROUT(10): ! ASYNCHRONOUS REPLY PON & CONTINUE
SRCE=LSN3
->DIRPONC
!-----------------------------------------------------------------------
DIROUT(11): ! PON & WAIT IN STORE
PONWAIT:
DEST=ALLOUTP_DEST>>16
UNLESS 0<DEST<=LOCSN0 THEN ->FREACT
SRCE=ALLOUTP_SRCE
ALLOUTP_SRCE=ME!13
PON(ALLOUTP)
J=PROC_RUNQ; PROC_RUNQ=1
IF MULTIOCP=YES THEN START
*INCT_SCHEDSEMA
*JCC_8,<SSEMAGOT1>
SEMALOOP(SCHEDSEMA,0)
SSEMAGOT1:
FINISH
MPLEVEL=MPLEVEL-1; ! DECREASE MPLEVEL&CHECK DEADLOCKS
IF PAGEFREES<=2 AND 0<GETEPN>=MPLEVEL-1 THEN C
P_DEST=X'20000' AND PON(P)
IF MULTIOCP=YES START ; *TDEC_SCHEDSEMA; FINISH
->RETURN; ! WAIT IN STORE FOR REPLY
!-----------------------------------------------------------------------
ACTIVITY(13): ! REPLY TO PON & WAIT IN STORE
IF MULTIOCP=YES THEN START
*INCT_SCHEDSEMA
*JCC_8,<SSEMAGOT2>
SEMALOOP(SCHEDSEMA,0)
SSEMAGOT2:
FINISH
MPLEVEL=MPLEVEL+1
PROC_RUNQ=J
IF MULTIOCP=YES START ; *TDEC_SCHEDSEMA; FINISH
ALLOUTP=P
ALLOUTP_DEST=SRCE
IF PROCESS>=FIRST UPROC START
I=PROC_STACK+X'40014'
INTEGER(I)=(INTEGER(I)-OUT18CHARGE)&X'1FFFFFF'
INTEGER(I+4)=(INTEGER(I+4)-OUT18INS)&X'1FFFFFF'
FINISH
->ACT
!-----------------------------------------------------------------------
DIROUT(12): ! NOMINATE STACK SSN
I=ALLOUTP_P1; ! STACK NO
J=ALLOUTP_P2; ! SSN
UNLESS 1<=I<=LSTKN AND LSTKSSN(I)=0 AND 4<=J<LSTLEN AND C
J&1=0 AND SST(J!1)=X'FFFF' THEN ->FREACT
LSTKSSN(I)=J
LST(J!1)=LST(5)+(I-1)*X'80'; ! USE USERSTACK SSN+1 TO GET ACRS
->REACT
!-----------------------------------------------------------------------
DIROUT(13): ! DENOMINATE STACK
I=ALLOUTP_P1; ! STACK NO
UNLESS 1<=I<=LSTKN THEN ->FREACT
J=LSTKSSN(I); ! SSN
UNLESS 0#J#PROC_STACK>>18 THEN ->FREACT
LST(J!1)=X'1FF3FF8000000000'
LSTKSSN(I)=0
->REACT
!-----------------------------------------------------------------------
DIROUT(14): ! SWOP STACK
DIROUT(19): ! SWOP STACK FROM SIGNAL STACK
I=ALLOUTP_P1; ! NEW LOCAL STACK NO
K=ALLOUTP_P2
UNLESS 1<=I<=LSTKN THEN ->FREACT
J=LSTKSSN(I)
UNLESS 0#J#PROC_STACK>>18 THEN ->FREACT
SSNP1==RECORD((J!1)<<18)
IF SSNP1_LNB>>18#J OR SSNP1_LNB>>18#SSNP1_SF>>18 OR C
SSNP1_PSR&3=0 THEN ->FREACT
NEWSTK=J<<18
! MOVE IT & IC TO NEW STACK
LONG INTEGER(NEWSTK!X'40014')=LONG INTEGER(PROC_STACK!X'40014')
PROC_STACK=NEWSTK
SUSP=K; ! GO BACK TO CORRECT SUSPEND STATUS
IF PROC_STACK=LSTKSSN(2)<<18 THEN ALLOUTP==SIGOUTP C
ELSE ALLOUTP==DIROUTP
->RESUSP
!-----------------------------------------------------------------------
DIROUT(15): ! SYSTEM CALL ERROR
! (AFTER STACK SWITCH)
J=INTEGER(PROC_STACK!X'40020')>>2; ! sub-ident. in old XNB
OPMESS(PROC_USER." bad syscall:".STRINT(J))
PEPARM=J<<8!16
->PE
!-----------------------------------------------------------------------
DIROUT(16): ! INSTRUCTION COUNTER INTERRUPT
! (AFTER STACK SWITCH)
PEPARM=17; ! TREAT AS PROGRAM ERROR
->PE
!-----------------------------------------------------------------------
DIROUT(17): ! CHECK ACTIVE BLOCKS ON DESTROY
J=0
CYCLE I=0,1,7
RECHECK: K=INTEGER(DIROUTPAD+4*I)
IF K=0 THEN EXIT
K=CHECKDA(K)
IF K#0 THEN START
IF K<0 AND J>0 THEN C
OPMESS("? BLK ACTIVTY ".STRHEX(INTEGER(DIROUTPAD+4*I)))C
AND ->FREACT
!
! CAN BE A RACE CONDITIONS BETWEEN PONS ON STOPPING A PROCESS. SO
! IF AMT BLOCK STILL HAS USERS WAIT JUST ONCE TO CLEAR ANY BACKLOG
! OF PONNED DEALLOCATES. CONDITION SEEN ON A DUAL SUSPECTED AT KENT
!
IF J=10 THEN OPMESS("BLOCK PAGE-OUTS ?") AND ->FREACT
WAIT(14,PAGEOUT DELAY(J))
->RETURN
FINISH
REPEAT
->REACT
!-----------------------------------------------------------------------
ACTIVITY(14): ! REPLY FROM DESTROY CHECK
J=J+1
->RECHECK
!-----------------------------------------------------------------------
DIROUT(18): ! CHECK & FORWARD I-O REQUEST
! P5=WRIT<<31!ACR<<24!LEN
! P6=ADDRESS
IF CHECK RES(ALLOUTP_P5>>31,ALLOUTP_P5&X'FFFFFF',ALLOUTP_P6)#0 C
THEN ->FREACT; ! NOT RESIDENT
ALLOUTP_P5=PROC_ACTW0!ALLOUTP_P5<<4>>28;! LSTBR!ACR
ALLOUTP_P6=PROC_LSTAD
->PONWAIT
!-------------------------------------------------------------------
!-----------------------------------------------------------------------
DIROUT(20): ! PROCMON ENABLE
IF MONLEVEL&4#0 START ; ! ENABLE INPROCESS MONITORING
MONVAD=ALLOUTP_P1
->REACT IF MONVAD<=0
MONVAD=0 AND ->FREACT UNLESS CHECKRES(0,4096,MONVAD)=0
->FREACT IF LOCKST=0
MONLIM=MONVAD+INTEGER(MONVAD+8)
MONPTAD=INTEGER(LOCKST&X'0FFFFFF0'+VIRTAD+8*(MONVAD>>18)+4)C
&X'0FFFFFF0'+VIRTAD
FOR I=0,1,(INTEGER(MONVAD+8)-1)>>10 CYCLE
->FREACT IF INTEGER(MONPTAD+4*I)&1=0
REPEAT
->REACT
FINISH
DIROUT(21): ! DISABLE PROCMON
DIROUT(22): ! PROCMON ON
DIROUT(23): ! PROCMON OFF
->FREACT
DIROUT(24): ! SPECIAL FOR REQUEST OUTPUT
SRCE=PROCESS+LOCSN2
->DIRPONS UNLESS ALLOUTP_DEST=X'370007'
ALLOUTP_SRCE=X'80000000'!SRCE<<16
IF MONLEVEL&12=12 START
*LSS_(6); *ST_IC; *LSS_(5); *ST_IT
FINISH
COMMS CONTROL(ALLOUTP)
IF MONLEVEL&12=12 START
*LSS_(6); *ST_ICC; *LSS_(5); *ST_ITT
PERFORM_SERVIT(55)=PERFORM_SERVIT(55)+(IT-ITT)
LCIT=LCIT-(IT-ITT)
PERFORM_SERVIC(55)=PERFORM_SERVIC(55)+(IC-ICC)
LCIC=LCIC-(IC-ICC)
PERFORM_SERVN(55)=PERFORM_SERVN(55)+1
FINISH
->ACTIVATE
DIROUT(25): ! LOCK IO AREA AND RETURN ST ADDR
! P_P5/P_P6=DESCR TO AREA.
ALLOUTP_P5=ALLOUTP_P5&X'FFFFFF'; ! P_P1=1 LOCK ,=-1 UNLOCK
IF ALLOUTP_P1>0 AND CHECK RES(0,ALLOUTP_P5,ALLOUTP_P6)#0 C
THEN ->FREACT
IF LOCKST=0 THEN START ; ! NO SEG TABLE AROUND
->FREACT UNLESS ALLOUTP_P1>0
IF MULTIOCP=YES THEN START
*INCT_(STORESEMA)
*JCC_8,<SSEMAGOT3>
SEMALOOP(STORESEMA,0)
SSEMAGOT3:
FINISH
IF FREE EPAGES>0 THEN START
STOREX=QUICK EPAGE(0,-1)
IF MULTIOCP=YES START ; *TDEC_(STORESEMA); FINISH
->ACTF
FINISH
POUT_SRCE=ME!X'F'
POUT_P2=0; ! CLEAR TO ZERO
GET EPN=GET EPN+1
IF MULTIOCP=YES START ; *TDEC_(STORESEMA); FINISH
IF PAGEFREES<=1 AND GETEPN>=MPLEVEL+1-COM_NOCPS THEN C
POUT_DEST=X'20000' AND PON(P)
POUT_DEST=X'50000'
PON(POUT)
->RETURN
!-----------------------------------------------------------------------
ACTIVITY(15): ! REPLY FROM GET EPAGE
! WITH PAGE FOR LOCKED SEG TABLE
STOREX=P_P2
IF STOREX=0 THEN ALLOUTP_DEST=-1 AND ->DEAD
! DEADLOCK PAGE. DIR WILLTRY AGN
ACTF: LOCKSTX=STOREX
LOCKST=STORE(STOREX)_REALAD&X'0FFFFFFF';! COULD BE FLAWED
K=LOCKST+VIRTAD
J=8*LSTLEN; ! USE REST OF EPAGE AS PAGETABLES
INTEGER(K+4)=J; ! HEAD OF PT LIST(F BIT NOT SET!)
WHILE J<=1024*(EPAGESIZE-2) CYCLE
INTEGER(K+J)=J+1024
J=J+1024
REPEAT
FINISH ELSE K=LOCKST&X'0FFFFFF0'+VIRTAD
VSSEG=ALLOUTP_P6>>18
IF ALLOUTP_P1>0 START ; ! LOCK AREA
IF LONGINTEGER(K+8*VSSEG)#0 THEN ->FREACT;! SEG LOCKED ALREADY
IF INTEGER(K+4)=0 THEN ->FREACT;! ALL PAGETABLES USED
LTAD=K+INTEGER(K+4); ! VIRT AD OF PAGETABLE
INTEGER(K+4)=INTEGER(LTAD)
LOCKST=LOCKST+(1<<28); ! KEEP COUNT IN TOP 4 BITS
LONGINTEGER(K+8*VSSEG)=LST(VSSEG)&X'EFFFFF8080000001' C
!(LTAD-VIRTAD)
FINISH ELSE START ; ! UNLOCK AREA
IF LONGINTEGER(K+8*VSSEG)=0 THEN ->FREACT
LTAD=(INTEGER(K+8*VSSEG+4)&X'0FFFFFF0'+VIRTAD)
INTEGER(LTAD)=INTEGER(K+4)
INTEGER(K+4)=LTAD-K
LONGINTEGER(K+8*VSSEG)=0
LOCKST=LOCKST-1<<28
IF LOCKST>>28=0 START
POUT_DEST=X'60000'
POUT_P2=LOCKSTX
P_SRCE=ME!15
IF MONLEVEL&12=12 THEN START
*LSS_(6); *ST_IC; *LSS_(5); *ST_IT
FINISH
RETURN EPAGE(POUT)
IF MONLEVEL&12=12 THEN START
*LSS_(5); *IRSB_IT; *IMYD_1; *ST_TOS
*IAD_(RETIT); *ST_(RETIT)
*LSD_(LCIT); *ISB_TOS ; *ST_(LCIT)
*LSS_(6); *IRSB_IC; *IMYD_1; *ST_TOS
*IAD_(RETIC); *ST_(RETIC)
*LSD_(LCIC); *ISB_TOS ; *ST_(LCIC)
RETCALLN=RETCALLN+1
FINISH
LOCKST=0
FINISH
FINISH
PT==ARRAY(VIRTAD+LST(VSSEG)&X'0FFFFFF8',PTF)
J=ALLOUTP_P6-VSSEG<<18
CYCLE I=J>>10,1,(J+ALLOUTP_P5-1)>>10
IF ALLOUTP_P1>0 THEN K=PT(I) ELSE K=0
INTEGER(LTAD+4*I)=K
REPEAT
CYCLE VSEPAGE=J>>EPAGESHIFT,1,(J+ALLOUTP_P5-1)>>EPAGESHIFT
CBTP=SST(VSSEG)+VSEPAGE//MAXBLOCK
EPX=VSEPAGE&(MAXBLOCK-1)
CBT==CBTA(CBTP)
IF CBT_AMTX=0 THEN ->FREACT
IF ALLOUTP_P1>0 START
POUT_DEST=X'40001'; ! PAGE IN AGAIN TO LOCK
POUT_SRCE=ME!X'8000000A'
POUT_P3=0
FINISH ELSE START
POUT_DEST=X'40002'; ! PAGE OUT TO UNLOCK
POUT_SRCE=0
POUT_P2=8+4; ! WRITTEN TO+UPDATE DRUM
FINISH
POUT_P1=CBT_AMTX<<16!EPX
IF MONLEVEL&12=12 THEN START
*LSS_(6); *ST_IC; *LSS_(5); *ST_IT
FINISH
PAGETURN(POUT)
IF MONLEVEL&12=12 THEN START
*LSS_(5); *IRSB_IT; *IMYD_1; *ST_TOS
*IAD_(PTIT); *ST_(PTIT)
*LSD_(LCIT); *ISB_TOS ; *ST_(LCIT)
*LSS_(6); *IRSB_IC; *IMYD_1; *ST_TOS
*IAD_(PTIC); *ST_(PTIC)
*LSD_(LCIC); *ISB_TOS ; *ST_(LCIC)
PTCALLN=PTCALLN+1
FINISH
IF POUT_DEST=0 AND ALLOUTP_P1>0 THEN C
MONITOR("LOCK GOES WRONG?")
REPEAT
ALLOUTP_P5=PROC_ACTW0
ALLOUTP_P6=LOCKST&X'0FFFFFF0'
->REACT
!-----------------------------------------------------------------------
DIROUT(26): ! CHANGE CONTEXT
CLEAR ACCESSED BITS
IF MONLEVEL&4#0 AND MONVAD>0 THEN GARNER(6,EPN)
XSTROBE=XSTROBE!X'80000000'; ! NOTE CHANGED CONTEXT
->ACTIVATE
DIROUT(27): ! EXIT TO NOMINATED ENV(SAME STK)
! ALLOUTP_P1-5==LNB->SF
K=PROC_STACK
->FREACT UNLESS K=ALLOUTP_P1>>18<<18=ALLOUTP_P5>>18<<18
K=K+X'40000'
CYCLE I=0,4,16
INTEGER(K+I)=INTEGER(ADDR(ALLOUTP)+8+I)
REPEAT
->ACTIVATE
!-----------------------------------------------------------------------
DIROUT(28): ! HARD STORE ERROR IN PROCESS
! FROM ROUTINE SYSERR
ACTIVITY(4): ! L-C HAS CRASHED ONE OCP IN DUAL
! FROM MULTIPROCESSOR INT ROUTINE
PEPARM=20
->PE
!-----------------------------------------------------------------------
ICOUNTERI:*JLK_TOS
! INSTRUCTION COUNTER INTERRUPTS
! STACK NOT SWITCHED YET !!!
*STXN_TOS ; ! SAVE XNB
*LXN_X'14006C'; ! ADDR(ICREVS)
*SLB_(XNB +0); ! SAVE B & LOAD ICREVS
*SBB_1
*STB_(XNB +0)
*CPB_0
*LB_TOS ; ! RESTORE B & XNB
*LXN_TOS
*JCC_11,<OUT16>; ! JUMP IF B>=0
*OUT_16; ! TO SWITCH STACKS
OUT16:*EXIT_-1; ! TO RESTORE PM,CC,ACS ETC.
! SIGNAL MECHANISM INVOKED AT DIROUT(16)
!-----------------------------------------------------------------------
INTEGERFN CHECKDA(INTEGER DA)
!***********************************************************************
!* CHECKS A DISC ADDRESSAND REPLIES AS FOLLOWS *
!* RESULT=0 ADDRESS NOT ACTIVE *
!* RESULT=1 TRANSFERS OR CLEARS IN PROGRESS *
!* RESULT<0 OTHER USERS OF SAME *
!***********************************************************************
RECORD (PARMF) POUT
POUT_DEST=X'80005'
POUT_P1=DA
IF MONLEVEL&12=12 THEN START
*LSS_(6); *ST_IC; *LSS_(5); *ST_IT
FINISH
ACTIVE MEM(POUT)
IF MONLEVEL&12=12 THEN START
*LSS_(5); *IRSB_IT; *IMYD_1; *ST_TOS
*IAD_(AMIT); *ST_(AMIT)
*LSD_(LCIT); *ISB_TOS ; *ST_(LCIT)
*LSS_(6); *IRSB_IC; *IMYD_1; *ST_TOS
*IAD_(AMIC); *ST_(AMIC)
*LSD_(LCIC); *ISB_TOS ; *ST_(LCIC)
AMCALLN=AMCALLN+1
FINISH
RESULT =POUT_DEST
END
INTEGERFN CHECK RES(INTEGER WRIT,LEN,AD)
!***********************************************************************
!* CHECKS THAT THE AREA OF LEN AT AD IS LOCKED DOWN AND ORS WRIT *
!* INTO THE WRITE MARKER IN THE PAGE TABLES *
!* RESULT=0 AREA LOCKED DOWN *
!* RESULT#0 SOME OF THE AREA IS NOT RESIDENT *
!***********************************************************************
INTEGER I,J
INTEGERARRAYNAME PT
CYCLE I=AD>>10,1,(AD+LEN-1)>>10; ! THROUGH THE EPAGES
PT==ARRAY(VIRTAD+(LST(I>>8)&X'0FFFFFF8'),PTF)
J=I&X'FF'
IF PT(J)&1=0 THEN RESULT =1
PT(J)=PT(J)!WRIT<<28
REPEAT
RESULT =0
END
!-----------------------------------------------------------------------
ROUTINE PAGEOUT(INTEGER VSSEG,VSEPAGE,RECORD (CBTF)NAME CBT)
!***********************************************************************
!* PAGES OUT A PAGE AS A RESULT OF WORKING ON A SEQUENTIAL FILE *
!* NOTE PAGE<0 IS VALID INDICATING PREVIOUS SEGMENT(MUST CHECK!) *
!***********************************************************************
RECORD (PARMF) P
INTEGER I,ASP
LONGINTEGER L
IF VSEPAGE<0 THEN START ; ! PREVIOUS SEGMENT
IF CBT_LINK&CONTINUATN BLK=0 THEN RETURN
VSSEG=VSSEG-1
VSEPAGE=VSEPAGE+SEGEPSIZE
FINISH
L=LST(VSSEG)
ASP=L>>32&127
IF ASP#127 AND AS(ASP)&(LTOPBIT>>VSEPAGE)#0 START ;! PAGE IN STORE
I=VIRTAD+L&X'0FFFFFF8'+VSEPAGE*16
*LXN_I
*LSS_(XNB +0); *OR_(XNB +1)
*OR_(XNB +2); *OR_(XNB +3)
*ST_I; *LSQ_0; *ST_(XNB +0); ! CLEAR PT AFTER NOTING MARKERS
I=I<<3>>31<<3
! IF DEDUCED RATHER THAN ADVISED
! SEQUENTIAL MAKE PAGE RECAP
! DEDUCTION SOMETIME WRONG!
IF CBT_LINK&(CONTINUATN BLK!ADVISORY SEQ)=0 THEN I=I!5
IF CBT_LINK&SMULTIPLE CON#0 THEN I=I!5
CBT==CBTA(SST(VSSEG)+VSEPAGE//MAXBLOCK)
P_DEST=X'40002'; ! PAGETURN/PAGE-OUT
P_P1=CBT_AMTX<<16!(VSEPAGE&(MAXBLOCK-1))
IF SFC FITTED=YES AND RESIDENCES>MIN RESIDENCES+1 THEN C
I=I!4; ! TO DRUM IF THERE IS ONE
P_P2=I
IF MONLEVEL&4#0 AND MONVAD>0 THEN C
GARNER(3+I>>3,VSSEG<<18!VSEPAGE<<12)
IF MONLEVEL&12=12 THEN START
*LSS_(6); *ST_IC; *LSS_(5); *ST_IT
FINISH
PAGETURN(P)
IF MONLEVEL&12=12 THEN START
*LSS_(5); *IRSB_IT; *IMYD_1; *ST_TOS
*IAD_(PTIT); *ST_(PTIT)
*LSD_(LCIT); *ISB_TOS ; *ST_(LCIT)
*LSS_(6); *IRSB_IC; *IMYD_1; *ST_TOS
*IAD_(PTIC); *ST_(PTIC)
*LSD_(LCIC); *ISB_TOS ; *ST_(LCIC)
PTCALLN=PTCALLN+1
FINISH
IF I&8#0 THEN ACNT_PTURNS=ACNT_PTURNS+1
IF CBT_LINK&SMULTIPLE CON=0 THEN UEPN=UEPN-1
EPN=EPN-1
IF EPN>0 THEN PROC_EPN=EPN
AS(ASP)=AS(ASP)!!(LTOPBIT>>VSEPAGE)
IF MONLEVEL&16#0 START
I=PROC_CATEGORY
SEQOUT(I)=SEQOUT(I)+1
FINISH
FINISH
END
ROUTINE ASOUT(INTEGER ASP)
!***********************************************************************
!* DISCARD ONE SEGMENT (INDEXED BY ASP) FROM ACTIVE STORAGE. *
!* MAY INVOLVE WRITING PAGES OUT FROM STORE AND WILL INVOLVE *
!* RETURNING ANY AMTXS ALLOCATED *
!***********************************************************************
RECORD (CBTF)NAME CBT
!%INTEGERARRAYNAME PT; ! NOT USED IN HAND CODING
INTEGER MARK,VSSEG,VSEPAGE,SH,CBTP,PBLENS,ASB,POFL,I,PTAD,LASTEP
LONGINTEGER MASK
VSSEG=ASEG(ASP)
IF ASDESTROY#0 AND 16<=VSSEG<=31 THEN ASDESTROY=0 AND C
OPMESS("INDEX DESTROY BY PROC".STRINT(PROCESS).TOSTRING(17))
LASTEP=(LST(VSSEG)>>(32+EPAGESHIFT))&(SEGEPSIZE-1)
IF AS(ASP)=0 THEN ->NOP
MASK=AS(ASP)
AS(ASP)=0
PTAD=VIRTAD+LST(VSSEG)&X'0FFFFFF8'
! PT==ARRAY(PTAD,PTF)
CBTP=SST(VSSEG)
CBT==CBTA(CBTP)
PBLENS=MAXBLOCK
VSEPAGE=-1
WHILE MASK#0 CYCLE
*LSD_MASK ; *SHZ_SH ; *USH_1 ; *ST_MASK
VSEPAGE=VSEPAGE+SH+1
IF VSEPAGE>=PBLENS START
PBLENS=PBLENS+MAXBLOCK
CBTP=CBTP+1
CBT==CBTA(CBTP)
FINISH
! PAGE=VSEPAGE*EPAGESIZE
! MARK=0
! %CYCLE I=PAGE,1,PAGE+EPAGESIZE-1
! MARK=MARK!PT(I); ! GANG MARKERS TOGETHER
! PT(I)=0; ! MARK PAGE AS UNAVAILABLE
! %REPEAT
! THIS HANDCODING ASSUMES EPAGESIZE=4
!
I=PTAD+4*EPAGESIZE*VSEPAGE
*LXN_I
*LSS_(XNB +0); *OR_(XNB +1); *OR_(XNB +2); *OR_(XNB +3)
*ST_MARK
*LSQ_0
*ST_(XNB +0)
IF ASDESTROY=0 THEN POFL=MARK<<3>>31<<3 ELSE POFL=0
! NOTE:- DRUM NOT UPDATED
POUT_DEST=X'40002'; ! PAGETURN/PAGE-OUT
POUT_P1=CBT_AMTX<<16!(VSEPAGE&(MAXBLOCK-1))
POUT_P2=POFL
! %IF CBT_AMTX=0 %OR CBT_TAGS&X'20'=0 %THEN %C
OPMESS("CBT STATE ??") AND CONTINUE ;! SHOULD NOT HAPPEN
IF MONLEVEL&4#0 AND MONVAD>0 THEN C
GARNER(1+POFL>>3,VSSEG<<18!VSEPAGE<<12)
IF MONLEVEL&12=12 THEN START
*LSS_(6); *ST_IC; *LSS_(5); *ST_IT
FINISH
PAGETURN(POUT)
IF MONLEVEL&12=12 THEN START
*LSS_(5); *IRSB_IT; *IMYD_1; *ST_TOS
*IAD_(PTIT); *ST_(PTIT)
*LSD_(LCIT); *ISB_TOS ; *ST_(LCIT)
*LSS_(6); *IRSB_IC; *IMYD_1; *ST_TOS
*IAD_(PTIC); *ST_(PTIC)
*LSD_(LCIC); *ISB_TOS ; *ST_(LCIC)
PTCALLN=PTCALLN+1
FINISH
IF POFL&8#0 THEN ACNT_PTURNS=ACNT_PTURNS+1
EPN=EPN-1
IF CBT_LINK&SMULTIPLE CON=0 THEN UEPN=UEPN-1
REPEAT
IF EPN>0 THEN PROC_EPN=EPN
NOP: CBTP=SST(VSSEG)
CBT==CBTA(CBTP)
CYCLE
IF CBT_TAGS&X'20'#0 THEN START
POUT_DEST=X'80002'; ! RETURN AMTX
POUT_SRCE=0
POUT_P1=PROCESS
POUT_P2=CBT_AMTX
POUT_P3=ASDESTROY; ! DESTROY FLAG
IF MONLEVEL&12=12 THEN START
*LSS_(6); *ST_IC; *LSS_(5); *ST_IT
FINISH
ACTIVE MEM(POUT)
IF MONLEVEL&12=12 THEN START
*LSS_(5); *IRSB_IT; *IMYD_1; *ST_TOS
*IAD_(AMIT); *ST_(AMIT)
*LSD_(LCIT); *ISB_TOS ; *ST_(LCIT)
*LSS_(6); *IRSB_IC; *IMYD_1; *ST_TOS
*IAD_(AMIC); *ST_(AMIC)
*LSD_(LCIC); *ISB_TOS ; *ST_(LCIC)
AMCALLN=AMCALLN+1
FINISH
CBT_AMTX=0; ! NEW BITS
CBT_TAGS=CBT_TAGS&X'DF'
ACNT_PTURNS=ACNT_PTURNS+POUT_P6;! CHARGE FOR ANY CLEARS
FINISH
IF LASTEP<MAXBLOCK THEN EXIT
LASTEP=LASTEP-MAXBLOCK
CBTP=CBTP+1
CBT==CBTA(CBTP)
REPEAT
LST(VSSEG)=LST(VSSEG)!X'7F00000000';! NOW MARKED AS INACTIVE
ASEG(ASP)=0; ! FOR DUMP CRACKING
! NOT OTHERWISE NEEDED
ASB=TOPBIT>>ASP
ASWAP=ASWAP&(¬ASB)
ASWIP=ASWIP&(¬ASB)
ASSHR=ASSHR&(¬ASB)
!
! IT IS JUST POSSIBLE FOR A SEGMENT TO BE REACTIVATED AND BECOME
! INACTIVE AGAIN IN THE SAME RESIDENCE(EXTENDED ON THE FLY) TO
! PREVENT PREMATURE DISCARDING OF DRUM IN THIS RARE CASE REMOVE BIT
! FROM OLD ASIPS
!
OLDASWIPS(0)=OLDASWIPS(0)&(¬ASB)
ASFREE=ASFREE!ASB
END
!-----------------------------------------------------------------------
ROUTINE STROBE(INTEGER SFLAGS)
!***********************************************************************
!* WHIP THROUGH ALL THE ACTIVE PAGES IN EACH ACTIVE SEGMENT *
!* ANY PAGES NOT REFERNECED ARE PAGED OUT. THE REFERENCE BITS ARE *
!* CLEARED IN CASE THIS PAGES IS NOT USED FURTHER. *
!* A CRITICAL ROUTINE FOR PERFORMANCE HENCE HAND CODING *
!* 2**0 OF SFLAGS SET FOR NOT CLEARING PT USE BITS *
!* 2**1 OF SFLAGS NOT USED *
!***********************************************************************
RECORD (CBTF)NAME CBT
!%INTEGERARRAYNAME PT; ! NOT USED IN HANDCODING
! %CONSTINTEGER USEMASK=X'DFFFFFFF'
CONSTLONGINTEGER DUSEMASK=X'DFFFFFFFDFFFFFFF'
INTEGER MARK,POFL,ASMASK,ASP,VSSEG,VSEPAGE,PTB,CBTP,PBLENS,ASB, C
PTEAD,I
IF MONLEVEL&16#0 THEN START
INTEGER CAT
FINISH
LONGINTEGER EPMASK
ASMASK=ASWAP; ! ALL SLOTS WITH ACTIVE PAGES
ASP=-1
IF MONLEVEL&16#0 THEN START
CAT=PROC_CATEGORY
STROBEN(CAT)=STROBEN(CAT)+1
STREPN(CAT)=STREPN(CAT)+EPN
FINISH
WHILE ASMASK#0 CYCLE ; ! FOR EACH ACTIVE SEGMENT
*LSS_ASMASK ; *SHZ_B ; *USH_1 ; *ST_ASMASK
*ADB_ASP; *ADB_1; *STB_ASP
VSSEG=ASEG(ASP)
CBTP=SST(VSSEG)
CBT==CBTA(CBTP)
IF CBT_LINK&ADVISORY SEQ#0 THEN CONTINUE
PBLENS=MAXBLOCK
EPMASK=AS(ASP)
VSEPAGE=-1
PTB=VIRTAD+LST(VSSEG)&X'0FFFFFF8'
! PT==ARRAY(PTB,PTF)
WHILE EPMASK#0 CYCLE ; ! FOR EACH ACTIVE PAGE
*LSD_EPMASK ; *SHZ_B ; *USH_1 ; *ST_EPMASK
*ADB_VSEPAGE; *ADB_1; *STB_VSEPAGE
IF VSEPAGE>=PBLENS START
PBLENS=PBLENS+MAXBLOCK
CBTP=CBTP+1
CBT==CBTA(CBTP)
FINISH
! PAGE=EPAGE*EPAGESIZE
! MARK=0
! %CYCLE I=PAGE,1,PAGE+EPAGESIZE-1
! MARK=MARK!PT(I); ! GANG MARKERS TOGETHER
! PT(I)=PT(I)&USEMASK %IF SFLAGS&1=0
! %REPEAT
!
! THIS HAND CODE ASSUMES THAT EPAGESIZE IS 4
!
PTEAD=PTB+4*EPAGESIZE*VSEPAGE
*LXN_PTEAD
*LSD_(XNB +0); *OR_(XNB +2)
*STUH_B ; *OR_B
*ST_MARK
IF SFLAGS&1=0 START
*LSD_(XNB +0) ; *AND_DUSEMASK ; *ST_(XNB +0)
*LSD_(XNB +2) ; *AND_DUSEMASK ; *ST_(XNB +2)
FINISH
POFL=MARK<<3>>31<<3!(1<<2!1);! WRIT,UPDATE DRUM&RECAPTURE
IF MARK>>29&1=0 START
! STROBE OUT NON USED
AS(ASP)=AS(ASP)&(¬(LTOPBIT>>VSEPAGE))
IF MONLEVEL&16#0 THEN STROUT(CAT)=STROUT(CAT)+1
POUT_DEST=X'40002'; ! PAGETURN/PAGE-OUT
POUT_P1=CBT_AMTX<<16!(VSEPAGE&(MAXBLOCK-1))
POUT_P2=POFL
IF MONLEVEL&4#0 AND MONVAD>0 THEN C
GARNER(3+POFL>>3,VSSEG<<18!VSEPAGE<<12)
IF MONLEVEL&12=12 THEN START
*LSS_(6); *ST_IC; *LSS_(5); *ST_IT
FINISH
PAGETURN(POUT)
IF MONLEVEL&12=12 THEN START
*LSS_(5); *IRSB_IT; *IMYD_1; *ST_TOS
*IAD_(PTIT); *ST_(PTIT)
*LSD_(LCIT); *ISB_TOS ; *ST_(LCIT)
*LSS_(6); *IRSB_IC; *IMYD_1; *ST_TOS
*IAD_(PTIC); *ST_(PTIC)
*LSD_(LCIC); *ISB_TOS ; *ST_(LCIC)
PTCALLN=PTCALLN+1
FINISH
IF POFL&8#0 THEN ACNT_PTURNS=ACNT_PTURNS+1
! %CYCLE I=PAGE,1,PAGE+EPAGESIZE-1
! PT(I)=0
! %REPEAT
!
! THIS BIT OF HAND CODE ASSUMES EPAGESIZE=4
!
*LXN_PTEAD
*LSQ_0
*ST_(XNB +0)
EPN=EPN-1
IF CBT_LINK&SMULTIPLE CON=0 THEN UEPN=UEPN-1
FINISH
REPEAT
IF AS(ASP)=0 THEN START
ASB=TOPBIT>>ASP
ASWAP=ASWAP&(¬ASB)
ASWIP=ASWIP!ASB
FINISH
REPEAT
IF EPN>0 THEN PROC_EPN=EPN
XSTROBE=XSTROBE&X'FFFF'+1; ! LOSE CHNGE CONTEXT BIT IF SET
END
!-----------------------------------------------------------------------
ROUTINE WORKSET(INTEGER RECAP)
!***********************************************************************
!* PAGE OUT THE WORKING SET BY GOING THROUGH THE ACTIVE SEGMENT *
!* LIST AND WRITING OUT ACTIVE EPAGES IN THAT SEGMENT *
!***********************************************************************
RECORD (CBTF)NAME CBT
!%INTEGERARRAYNAME PT; ! NEEDED IN ALL IMP VERSION ONLY
INTEGER MARK,POFL,ASMASK,VSSEG,VSEPAGE,ASP,CBTP,PBLENS,I,J,PTB
LONGINTEGER EPMASK
ASMASK=ASWAP
ASP=-1
WHILE ASMASK#0 CYCLE ; ! THROUGH ACTIVE SEGMENNTS
*LSS_ASMASK; *SHZ_B ; *USH_1
*ST_ASMASK; *ADB_1; *ADB_ASP; *STB_ASP
VSSEG=ASEG(ASP)
CBTP=SST(VSSEG)
CBT==CBTA(CBTP)
PBLENS=MAXBLOCK
EPMASK=AS(ASP)
AS(ASP)=0
VSEPAGE=-1
PTB=VIRTAD+LST(VSSEG)&X'0FFFFFF8'
! PT==ARRAY(PTB,PTF)
WHILE EPMASK#0 CYCLE
*LSD_EPMASK; *SHZ_B ; *USH_1; *ST_EPMASK
*ADB_1; *ADB_VSEPAGE; *STB_VSEPAGE
IF VSEPAGE>=PBLENS START
PBLENS=PBLENS+MAXBLOCK
CBTP=CBTP+1
CBT==CBTA(CBTP)
FINISH
! PAGE=VSEPAGE*EPAGESIZE
! MARK=0
! %CYCLE I=PAGE,1,PAGE+EPAGESIZE-1
! MARK=MARK!PT(I); ! GANG MARKERS TOGETHER
! %REPEAT
!
! THIS HAND CODING ASSUMES EPAGESIZE=4
!
I=PTB+4*EPAGESIZE*VSEPAGE
*LXN_I
*LSD_(XNB +0); *OR_(XNB +2)
*STUH_B ; *OR_B
*ST_MARK
POFL=MARK<<3>>31<<3!1<<2!RECAP;! WRIT & UPDATE DRUM & RECAPTURE
POUT_DEST=X'40002'; ! PAGETURN/PAGE-OUT
POUT_P1=CBT_AMTX<<16!(VSEPAGE&(MAXBLOCK-1))
POUT_P2=POFL
IF MONLEVEL&4#0 AND MONVAD>0 THEN C
GARNER(1+POFL>>3,VSSEG<<18!VSEPAGE<<12)
IF MONLEVEL&12=12 THEN START
*LSS_(6); *ST_IC; *LSS_(5); *ST_IT
FINISH
PAGETURN(POUT)
IF MONLEVEL&12=12 THEN START
*LSS_(5); *IRSB_IT; *IMYD_1; *ST_TOS
*IAD_(PTIT); *ST_(PTIT)
*LSD_(LCIT); *ISB_TOS ; *ST_(LCIT)
*LSS_(6); *IRSB_IC; *IMYD_1; *ST_TOS
*IAD_(PTIC); *ST_(PTIC)
*LSD_(LCIC); *ISB_TOS ; *ST_(LCIC)
PTCALLN=PTCALLN+1
FINISH
IF POFL&8#0 THEN ACNT_PTURNS=ACNT_PTURNS+1
IF MARK&(1<<29)=0 THEN START
EPN=EPN-1
IF CBT_LINK&SMULTIPLE CON=0 THEN UEPN=UEPN-1
FINISH
REPEAT
REPEAT
IF EPN>0 THEN PROC_EPN=EPN
ASWAP=0
!
! SHUFFLE DOWN LIST OF OLD ASWIPS AND REMOVE ANY SEGMENTS NOT USED OVER
! "RESIDENCES" RESIDENCES PERIODS FROM ACTIVE LIST
!
J=ASWIP&(¬ASSHR); ! ONLY PRIVATE SEGMENTS
CYCLE I=MAXRESIDENCES-1,-1,0
J=J&OLD ASWIPS(I) IF I<RESIDENCES
OLD ASWIPS(I+1)=OLD ASWIPS(I)
REPEAT
OLD ASWIPS(0)=ASWIP
!
! DEACTIVATE INACTIVE SEGMENTS
!
IF J#0 THEN DEACTIVATE(J)
ASWIP=¬ASFREE
IF SEMAHELD#0 THEN PROC_STATUS=PROC_STATUS!1 C
AND SEMAHELD=0
!
! REMOVE PAGE TABLE ADDRS( BUT NOT ANY DAP SEGMENTS) FROM SEGMENT TABLE
!
IF DAP FITTED=YES AND PROC_STATUS&2****10#0 START
! DAP SEGS HAVE TOP(SP) BIT SET IN LST
CYCLE I=2,1,HIGHSEG
IF LST(I)>0 THEN LST(I)=LST(I)&X'FFFFFFFF00000000'
REPEAT
FINISH ELSE START
! %CYCLE I=2,1,HIGHSEG
! LST(I)=LST(I)&X'FFFFFFFF00000000'
! %REPEAT
*LD_X'2800000100000014'
*LSS_0
*LB_HIGHSEG
*SBB_1
RPA: *ST_(DR )
*INCA_8
*DEBJ_<RPA>
FINISH
RETURN PTS
END
!-----------------------------------------------------------------------
IF MONLEVEL&4#0 START
ROUTINE GARNER(INTEGER FLAG,INTEGER PARAM)
!***********************************************************************
!* COLLECT PAGING MONITORING. A DOUBLE WORD OF FLAG<<28!ICCOUNT *
!* FOLLOWED BY 32BIT PARAM(NORMALLY VIRTUAL ADDRESS) IS *
!* WRITTEN INTO LOCKED DOWN FILE *
!* FLAG=0 FOR DEMAND PAGE *
!* FLAG=1&2 FOR PAGEOUTS & UPDATED PAGEOUTS *
!* FLAG=3&4 FOR STROBEOUTS & UPDATED STROBEOUTS *
!* FLAG=5 FOR A SNOOZE PARAM=EPN *
!* FLAG=6 FOR A CHANGE CONTEXT REQUEST. PARAM=EPN *
!***********************************************************************
INTEGER AD,W1,PVAD0,PVAD1
PVAD0=INTEGER(MONPTAD)&X'0FFFFFF0'+VIRTAD;! PUBLIC VIRTUAL AD OF P0
AD=MONVAD+INTEGER(PVAD0); ! CURRENT POSN
W1=FLAG<<28!(ICREVS&15)<<24!INTEGER(PROC_STACK!X'40018')
IF AD<MONLIM START
PVAD1=INTEGER(MONPTAD+4*(AD>>10&255))&X'0FFFFFF0' C
+VIRTAD+AD&X'3FF'
INTEGER(PVAD1)=W1
INTEGER(PVAD1+4)=PARAM
INTEGER(PVAD0)=INTEGER(PVAD0)+8
FINISH
END
FINISH
ROUTINE CLEAR ACCESSED BITS
!***********************************************************************
!* CALLED AFTER A "CHANGE CONTEXT" TO CLEAR THE USED BITS ON EACH *
!* PAGE ACTUALLY IN CORE. THEREAFTER A STROBE OR EXTRA STROBE WILL *
!* DISCARD ANY PAGES FROM THE OLD CONTEXT WITHOUT BOUNCING PROCESS *
!***********************************************************************
!%INTEGERARRAYNAME PT; ! NOT USED IN HAND CODED VERSION
CONSTINTEGER USEMASK=X'DFFFFFFF'
CONSTLONGINTEGER DUSEMASK=X'DFFFFFFFDFFFFFFF'
INTEGER ASMASK, PTB, VSEPAGE, ASP, I
LONGINTEGER EPMASK
ASMASK=ASWAP; ! ACTIVE SLOTS WITH ACTIVE PAGES
ASP=-1
WHILE ASMASK#0 CYCLE ; ! FOR EACH ACTIVE SEGMENT
*LSS_ASMASK; *SHZ_B ; *USH_1; *ST_ASMASK
*ADB_ASP; *ADB_1; *STB_ASP
VSSEG=ASEG(ASP)
VSEPAGE=-1
EPMASK=AS(ASP)
PTB=VIRTAD+LST(VSSEG)&X'0FFFFFF8'
! PT==ARRAY(PTB,PTF)
WHILE EPMASK#0 CYCLE ; ! FOR EACH ACTIVE PAGE
*LSD_EPMASK; *SHZ_B ; *USH_1; *ST_EPMASK
*ADB_VSEPAGE; *ADB_1; *STB_VSEPAGE
! PAGE=VSEPAGE*EPAGESIZE
! %CYCLE I=PAGE,1,PAGE+EPAGESIZE-1
! PT(I)=PT(I)&USEMASK
! %REPEAT
!
! THIS HAND CODE ASSUMES EPAGESIZE=4
!
I=PTB+4*EPAGESIZE*VSEPAGE
*LXN_I
*LSD_(XNB +0); *AND_DUSEMASK; *ST_(XNB +0)
*LSD_(XNB +2); *AND_DUSEMASK; *ST_(XNB +2)
REPEAT
REPEAT
END
!-----------------------------------------------------------------------
ROUTINE DEACTIVATE(INTEGER MASK)
!***********************************************************************
!* DEACTIVATE ALL ACTIVE SEGMENTS DEFINED BY BITMASK "MASK" *
!***********************************************************************
INTEGER ASP
ASP=-1
WHILE MASK#0 CYCLE
*LSS_MASK; *SHZ_B ; *USH_1; *ST_MASK
*ADB_ASP; *ADB_1; *STB_ASP
ASOUT(ASP)
REPEAT
END
ROUTINE FREE AS
!***********************************************************************
!* CALLED WHEN ASFREE IS ZERO. IT DEACTIVATES A SEGMENT. FIRST *
!* TRY TO DEACTIVATE THE OLDEST CURRENTLY INACTIVE SEGMENT. *
!* IF ALL SEGMENTS ARE ACTIVE ONE IS CHOSEN AT RANDOM *
!***********************************************************************
INTEGER I,J,K
IF ASWIP=0 THEN START
*RRTC_0; *AND_31; ! USE BOTTOM 5 BITS OF CLOCK
*ST_I; ! AS PSEUDO RANDOM NO
I=1<<J
FINISH ELSE START
I=ASWIP
CYCLE J=0,1,MAX RESIDENCES
K=I&OLD ASWIPS(J); ! BITS IN K FOR SEGMENTS THAT
! HAVE BEEN INACTIVE J RESIDENCIES
IF K=0 THEN EXIT ; ! LEAVING OLDEST IN I
I=K
REPEAT
FINISH
DEACTIVATE(I)
END
!-----------------------------------------------------------------------
ROUTINE RETURN PTS
!***********************************************************************
!* RETURN ALL THE EPAGES USED FOR PAGE TABLES. THE LIST HEADED BY *
!* "PTP" AND LINKED VIA THE STORE TABLE *
!***********************************************************************
POUT_DEST=X'60000'; ! DACT=0 DO YOUR OWN SEMAING
WHILE PTP#0 CYCLE
POUT_P2=PTP
STORE(PTP)_USERS=0
PTP=STORE(PTP)_LINK
IF MONLEVEL&12=12 THEN START
*LSS_(6); *ST_IC; *LSS_(5); *ST_IT
FINISH
RETURN EPAGE(POUT)
IF MONLEVEL&12=12 THEN START
*LSS_(5); *IRSB_IT; *IMYD_1; *ST_TOS
*IAD_(RETIT); *ST_(RETIT)
*LSD_(LCIT); *ISB_TOS ; *ST_(LCIT)
*LSS_(6); *IRSB_IC; *IMYD_1; *ST_TOS
*IAD_(RETIC); *ST_(RETIC)
*LSD_(LCIC); *ISB_TOS ; *ST_(LCIC)
RETCALLN=RETCALLN+1
FINISH
REPEAT
END
!-----------------------------------------------------------------------
INTEGERFN FIND PROCESS
!***********************************************************************
!* BY SEARCHING THE PROCESS LIST. USED FOR RELAY SERVICES *
!***********************************************************************
STRING (6) USER
INTEGER I,J,K,DACT,INCAR
USER=STRING(PROC_STACK!X'40030'); ! IN OLD ACC
J=INTEGER(PROC_STACK!X'4003C')
INCAR=BYTEINTEGER(PROC_STACK!X'40037');! LAST BYTE = INCARNATION
IF 1<=J<=3 THEN START
K=LOCSN0+J*MAXPROCS
DACT=ALLOUTP_DEST&X'FFFF'
UNLESS J=3 AND (DACT=0 OR DACT=X'FFFF') THEN START
CYCLE I=1,1,MAXPROCS-1
IF USER=PROCA(I)_USER AND PROCA(I)_INCAR=INCAR THEN C
ALLOUTP_DEST=(I+K)<<16!DACT AND RESULT =I
REPEAT
FINISH
FINISH
ALLOUTP_DEST=0
RESULT =0
END
!-----------------------------------------------------------------------
INTEGERFN CURSSN
!***********************************************************************
!* FIND THE CURRENT STACK NO *
!***********************************************************************
INTEGER I,J
J=PROC_STACK>>18
CYCLE I=1,1,LSTKN
IF J=LSTKSSN(I) THEN RESULT =I
REPEAT
MONITOR("CURRENT STACK ?")
END
!-----------------------------------------------------------------------
ROUTINE WAIT(INTEGER DACT,N)
POUT_DEST=X'A0002'
POUT_SRCE=0
POUT_P1=ME!DACT
POUT_P2=N
PON(POUT)
END
!-----------------------------------------------------------------------
END
!-----------------------------------------------------------------------
END
!***********************************************************************
!* THESE THREE ROUTINES ARE SYTEMCALLED DIRECTLY FROM USER *
!***********************************************************************
EXTERNALINTEGERFN REQUEST INPUT(INTEGER OUTPUT POSN,TRIGGER POSN)
UNLESS IOSTAT_OUTBUFLEN>0 AND 0<=OUTPUT POSN<IOSTAT_OUTBUFLEN C
AND IOSTAT_INBUFLEN>0 AND 0<=TRIGGER POSN<IOSTAT_INBUFLEN C
THEN RESULT =-1
IF IOSTAT_IAD#TRIGGER POSN THEN RESULT =0
DIROUTP_DEST=X'370006'
DIROUTP_P1=IOSTAT_INSTREAM
DIROUTP_P2=OUTPUT POSN
DIROUTP_P3=TRIGGER POSN
*OUT_2
RESULT =0
END
!-----------------------------------------------------------------------
EXTERNALINTEGERFN REQUEST OUTPUT(INTEGER OUTPUT POSN,TRIGGER POSN)
CONSTINTEGER INST REPLY=X'370007'; ! COMMC C REPLIES AT ONCE
CONSTINTEGER WAIT REPLY=X'370006'; ! REPLIES WHEN OPUT FINISHED
UNLESS IOSTAT_OUTBUFLEN>0 AND 0<=OUTPUT POSN<IOSTAT_OUTBUFLEN C
AND -1<=TRIGGER POSN<IOSTAT_OUTBUFLEN THEN RESULT =-1
IF TRIGGER POSN<0 THEN DIROUTP_DEST=INST REPLY C
ELSE DIROUTP_DEST=WAIT REPLY
DIROUTP_P1=IOSTAT_OUTSTREAM
DIROUTP_P2=OUTPUT POSN
DIROUTP_P3=TRIGGER POSN
*OUT_24
IF DIROUTP_P2#0 THEN RESULT =-2;! SOME COMMS DISASTER
RESULT =DIROUTP_P5
END
!-----------------------------------------------------------------------
EXTERNALINTEGERFN CHANGE CONTEXT
*OUT_26
RESULT =0
END
!-----------------------------------------------------------------------
LONGINTEGERFN RTDR(INTEGERFN A)
*LSD_(LNB +5)
*EXIT_-64
END
!-----------------------------------------------------------------------
ENDOFFILE