!***********
!* SUP010 *
!*14.JUN.82*
!***********
CONTROL K'111011'; ! MUL+TRUSTED
PERMROUTINESPEC SVC
PERMINTEGERMAPSPEC INTEGER(INTEGER X); ! USED IN INIT
RECORDFORMAT DUMMY(INTEGER X)
CONSTRECORD (DUMMY) NAME NULL=0
BEGIN
CONSTINTEGER TASK LOW LIMIT=30
CONSTINTEGER TASK LIMIT=75
CONSTINTEGER FREE CELLS=80
CONSTINTEGER NO OF SERVICES=TASK LIMIT
CONSTINTEGER FRAG NO=15
CONSTINTEGER PSECT LENGTH=52
CONSTINTEGER SVC LIMIT=23
CONSTINTEGER INT LIMIT=-90
CONSTINTEGER K SEG LIMIT=125
CONSTINTEGER HIGHEST PRIORITY = 3
CONSTINTEGER TTID=30; ! TASK LO LIMIT
CONSTINTEGER DKID=31; ! " " " +1
CONSTINTEGER DIRID=32; ! " " " +2
CONSTINTEGER LOADID=33; ! " " " +2
CONSTINTEGER MOTHER=35; ! " " " +4
CONSTINTEGERNAME PS=K'177776'; ! STATUS WORD
CONSTINTEGERNAME STACK LIMIT=K'177774'
RECORDFORMAT EF(RECORD (EF) NAME LINK, INTEGER ID, A1)
RECORDFORMAT QF(RECORD (EF) NAME E)
RECORDFORMAT TF(RECORD (TF) NAME LINK, INTEGER ID, T)
RECORDFORMAT KSEGF(INTEGER USE, DADD, PAR, PDR)
RECORDFORMAT KSEGLF(RECORD (KSEGLF) NAME L, INTEGER B, C, D)
RECORDFORMAT UREGSF(INTEGER R0, R1, R2, R3, R4, R5, PC, C
PS, SP)
RECORDFORMAT SEGF(INTEGER PAR, PDR, RECORD (KSEGF) NAME KSL, C
INTEGER USE)
RECORDFORMAT PSECTF(RECORD (QF) NAME E,BYTEINTEGER ID, STATE, C
BYTEINTEGERARRAY NAME(0:3), C
INTEGER PRIO, RECORD (QF) POFFQ, C
RECORD (UREGSF) URS, INTEGER TRAPV, C
RECORD (SEGF) ARRAY SEG(0:8))
RECORDFORMAT PSTF(RECORD (PSECTF) NAME P)
RECORDFORMAT PF(BYTEINTEGER SERVICE, REPLY, C
INTEGER A1, A2, A3)
RECORDFORMAT P2F(INTEGER D, A1, A2, A3)
RECORDFORMAT MAINPF(RECORD (MAINPF) NAME L, RECORD (P2F) P)
RECORDFORMAT STOREF(INTEGER LEN, BLOCK NO)
RECORDFORMAT ADDRFN(RECORD (ADDRFN) NAME PSECTA, LAST32, COREA)
CONSTRECORD (ADDRFN) NAME ADDS=K'120'
RECORDFORMAT D1F(INTEGER X)
RECORDFORMAT D2F(RECORD (QF) NAME X)
RECORDFORMAT D3F(INTEGERNAME X)
RECORD (EF) NAME E
RECORD (TF) NAME T, T2, TN, TB
RECORD (PSECTF) NAME PSECT, PSECT2, PSECTN, PSECT3
RECORD (SEGF) NAME SEG1, SEG2
RECORD (KSEGF) NAME KS1, KS2
RECORD (KSEGLF) NAME KL
EXTERNALRECORD (KSEGLF) NAME FREE SEGL
OWNINTEGER IPL TICKS = 0
EXTERNALRECORD (QF) ARRAY CPUQ(0:HIGHEST PRIORITY)
!*
RECORD (PF) PX
RECORD (PF) NAME P, Q
RECORD (P2F) NAME P2, Q2, PXP
RECORD (MAINPF) NAME MAINP, MP2
EXTERNALRECORD (QF) NAME FREE PARAM
RECORD (QF) TIME Q; ! HEAD OF TIMER LIST
INTEGER QU, SERVICE, TICKS, LEN, I, PT, L2, BLOCK, S, ID, CALL SEG
INTEGER PAR, PDR
RECORD (D1F) NAME D1
RECORD (D2F) D2
RECORD (D3F) NAME D3
EXTERNALRECORD (PSTF) ARRAY PSECTA(TASK LOW LIMIT:TASK LIMIT)
EXTERNALRECORD (TF) ARRAY ONTMQ(TASK LOW LIMIT:TASK LIMIT)
EXTERNALRECORD (MAINPF) ARRAY PARAMS(0:FREE CELLS)
EXTERNALRECORD (STOREF) ARRAY STORE(0:FRAG NO)
RECORD (STOREF) NAME ST1, ST2
EXTERNALRECORD (KSEGLF) ARRAY KSEGL(1:K SEG LIMIT)
! %EXTERNALRECORD (P2F) %ARRAY LAST THIRTY2(0:15); %OWNINTEGER LAST=0
EXTERNALBYTEINTEGERARRAY SER MAP(INT LIMIT:NO OF SERVICES)= C
0(80), 0, 0, 0, 0, 0, 0, MOTHER, DKID, TTID, TTID, 0,
TTID, 0, DKID, DIRID, LOADID, 0, MOTHER, 0(68)
CONSTINTEGER FAULT SER=-4
!! TU 16 INT = -5
!! DQS11 TX INT = -6
!! DQS11 RX INT = -7
SYSTEMINTEGERFNSPEC RUN
EXTERNALROUTINESPEC INITIALISE
!! %PERMROUTINESPEC PUSH(%RECORD (QF) %NAME Q, %RECORD (EF) %NAME E)
!! %PERMRECORD (QF) %MAPSPEC POP(%RECORD (QF) %NAME Q)
!*
ROUTINESPEC SCHEDULE
ROUTINESPEC DEALLOCATE(RECORD (KSEGF) NAME KS)
ROUTINESPEC FAULT(INTEGER I)
!***********************************************
!* SUPERVISOR STATES *
!***********************************************
CONSTINTEGER IDLE ST=-1
CONSTINTEGER TASK ST=0
!**********************************************
!* TASK STATES *
!**********************************************
CONSTINTEGER T WAIT=1
CONSTINTEGER T POFF=2
CONSTBYTEINTEGER T CPUQ=8
CONSTBYTEINTEGER T RUN=16
CONSTBYTEINTEGER T SUSP=K'200'
!***********************************************
!* SVC SERVICES (BY EMT VALUE) *
!***********************************************
CONSTINTEGER INTERRUPT=-1
CONSTINTEGER WAIT=1
CONSTINTEGER PON R=2
CONSTINTEGER POFF R=3
CONSTINTEGER INSERT=4
CONSTINTEGER DELETE=5
CONSTINTEGER ALLOCATE CORE=6
CONSTINTEGER FREESP=7
CONSTINTEGER SET TIME=8
CONSTINTEGER SCHEDULE T=9
CONSTINTEGER MAP VIRT=10
CONSTINTEGER GET ABS=11
CONSTINTEGER GET ID=12
CONSTINTEGER LINKIN=13
CONSTINTEGER MAP SHARED=14
CONSTINTEGER MAP HREGS=15
CONSTINTEGER MAP PSECT=16
CONSTINTEGER PONPOFF=17
CONSTINTEGER SET PRIO=18
CONSTINTEGER SET T BIT = 19
CONSTINTEGER TOFF = 20
CONSTINTEGER GPSPEC = 21
CONSTINTEGER DPTAB = 22
CONSTINTEGER TIME SER = 23
!************************************************
!* STATIC CORE LOCATIONS *
!************************************************
CONSTINTEGERNAME INT VALUE=K'40'
CONSTINTEGERNAME ALARM F=K'44'
CONSTRECORD (PSTF) NAME PSECTX = K'46'
CONSTINTEGERNAME PSECT AREA=K'50'
CONSTINTEGERNAME FAULT TYPE=K'52'
CONSTRECORD (PSTF) NAME LAST PSECT = K'54'
CONSTRECORD (QF) NAME PXP PT = K'56'; ! POINTS TO PX&PXP
CONSTINTEGERNAME SVCADDRESS = K'30'
!*************************************************
SWITCH SER(-1:SVC LIMIT)
CONSTINTEGERARRAYNAME U PAR = K'177640'
CONSTINTEGERARRAYNAME U PDR = K'177600'
!***************************************************
!* START OF CODE PROPER *
!***************************************************
INITIALISE; ! HELD IN DE-ALLOCATABLE SPACE
!*****************************************************
!* BASIC LOOP IS CPU SCHEDULER *
!*****************************************************
*K'013700'; *K'30'; ! MOV SVC, R0
*K'010540'; ! MOV R5, -(R0)
*K'010440'; ! MOV R4, -(R0)
D1 == D2; D3 == D1; PXP == PX; PXP PT_E == PXP; PX_REPLY = 0
CYCLE
IF NOT CPUQ(3)_E == NULL START
PSECT == POP(CPUQ(3))
ELSE
IF NOT CPUQ(2)_E == NULL START
PSECT == POP(CPUQ(2))
ELSE
IF NOT CPUQ(1)_E == NULL START
PSECT == POP(CPUQ(1))
ELSE
IF NOT CPUQ(0)_E == NULL START
PSECT == POP(CPUQ(0))
ELSE
!! NOTHING TO DO
PSECT == NULL; PSECTX_P == NULL
->GO2
FINISH
FINISH
FINISH
FINISH
GO: IF PSECT_STATE&T SUSP#0 THENCONTINUE ; ! DON'T RUN IT
PSECT_STATE=T RUN
PSECTX_P == PSECT
GO2: SERVICE=RUN; ! EXTERNAL ROUTINE
->SER(SERVICE) IF SERVICE<=SVC LIMIT
FAULT TYPE=5
ERROR:
INT VALUE=FAULT SER
SER(INTERRUPT): ; ! DEVICE INTERRUPT
IF INT VALUE#FAULT SER START
SCHEDULE UNLESS PSECT == NULL
ELSE
PX_A2=PSECT_ID
PX_A3=FAULT TYPE
FINISH
-> CLOCKINT IF INT VALUE = 0
ID=SER MAP(INT VALUE)
PX_SERVICE=INT VALUE
P2==PXP; P==P2
!* AND SEND IT
!! SEND MESS TO RELEVANT TASK
->DO PON
SER(WAIT):
PSECT_STATE=T WAIT
CONTINUE ; ! FIND SOMETHING ELSE
SER(PON R):
SER(PONPOFF):; ! PON-POFF FROM USER
P2==PSECT_URS; ! MAP PARAM AREA TO HIS REGS
P==P2
!* NOW PLANT ON Q
!* AND SCHEDULE PROCESS IF NECESSARY
ID=SER MAP(P_SERVICE); ! AND FIND THE OWNING PROCESS
DO PON:
PSECT3==PSECTA(ID)_P; ! PSECT OF RECEIVING MESSAGE
IF PSECT3==NULL OR ID=0 START
FAULT TYPE=6; PX_A1 = P_SERVICE
-> ERROR
FINISH
Q==PSECT3_URS
IF PSECT3_STATE&T POFF#0 AND C
(Q_SERVICE=0 OR PSECT3_URS_R0=P2_D) START
!! IS WAITING FOR POFF, AND IS THE CORRECT MESSAGE
PSECT3_STATE = (PSECT3_STATE&T SUSP)!T CPUQ; ! CODE OF SCHEDULE
PUSH(CPUQ(PSECT3_PRIO), PSECT3)
PON EXECUTE:
Q = P2
! LAST THIRTY2(LAST)=P2; ! LAST=(LAST+1)&15
ELSE
MAINP==FREE PARAM; ! PICK UP NEW PARAM CELL
FAULT(9) IF MAINP == NULL
FREE PARAM==MAINP_L; ! RELINK FREE LIST
MAINP_P = P2
PUSH(PSECT3_POFFQ, MAINP); ! PUT ON TASK POFF Q
FINISH
IF SERVICE < 0 THEN CONTINUE ; ! (=INTERRUPT)DO A PRIO SCAN
IF SERVICE#PONPOFF THEN ->GO2; ! PON OR POFF, SO JUST REENTER
!**************************************************************
! THIS SECTION IS DEPENDENT ON THE FORMAT OF PSECTF
*K'013700'; *K'54'; ! MOV LAST PSECT, R0
*K'000360'; *K'14'; ! SWAB(LAST PSECT_URS_R0)
! WOULD BE PREFERABLE IN IMP, BUT WOULD COST AT LEAST 10 WORDS
!**************************************************************
SER(POFF R):; ! USER POFF
UNLESS PSECT_POFFQ_E==NULL START ; ! Q NON ZERO
MP2==PSECT_POFFQ_E; ! GET LAST ENTRY
Q==PSECT_URS; Q2==Q
UNTIL MP2==MAINP CYCLE ; ! CYCLE WHOLE Q
MAINP==POP(PSECT_POFFQ)
P==MAINP_P; P2==P
IF Q_SERVICE=0 OR Q2_D=P2_D START
MAINP_L==FREE PARAM; FREE PARAM==MAINP; ! RELINK ON Q
->PON EXECUTE
FINISH
PUSH(PSECT_POFFQ, MAINP)
REPEAT
FINISH
PSECT_STATE=T POFF
CONTINUE
SER(SCHEDULE T): ! R0 IS ID OF TASK TO BE SCHEDULED
I = PSECT_URS_R1; ! 0 = SCH, 1 = HOLD, X = ADDR
SCHEDULE; ! RE-SCHEDULE CALLER
PSECT==PSECTA(PSECT_URS_R0)_P
FAULT(7) IF PSECT==NULL
IF I&1 = 0 START
PSECT_STATE = PSECT_STATE&(¬T SUSP); ! ENSURE NOT SUSPENDED
IF I # 0 START ; ! FORCE NEWW ADDRESS AND START UP
PSECT_URS_PC = I
ELSE
IF PSECT_STATE&T POFF # 0 THEN CONTINUE
FINISH
SCHEDULE
ELSE
PSECT_STATE = PSECT_STATE!T SUSP; ! SUSP IT
FINISH
CONTINUE
SER(DELETE): ! DELETE THE RUNNING TASK
I = PSECT_URS_R0
IF PSECT_ID<=LOADID+1 OR I # 0 START
SCHEDULE; ! RE-SCHEDULE LOADER
PSECT==PSECTA(I)_P
FINISH
CYCLE ; ! CLEAR OUT THE POFF Q
MAINP==POP(PSECT_POFFQ)
EXITIF MAINP==NULL
MAINP_L==FREE PARAM; FREE PARAM==MAINP
REPEAT
CYCLE I=8, -1, 0; ! GO DOWN THE SEGS
KS1==PSECT_SEG(I)_KSL
UNLESS KS1 == NULL START
KS1_USE=KS1_USE-1
DEALLOCATE(KS1) IF KS1_USE=0
FINISH
REPEAT
PSECTA(PSECT_ID)_P==NULL
SEARCH CPU Q:
CONTINUE
CLOCKINT: ! CLOCK HAS TICKED
IPL TICKS = IPL TICKS+1
IF ALARMF # 0 START
ALARMF = ALARMF-1
IF ALARMF = 0 START
!* SEND MESSAGE TO FIRST TASK ON Q
!* SET CLOCK TO NEXT TIME
TN==POP(TIME Q)
UNLESS TIMEQ_E==NULL START
ALARM F=TIMEQ_E_LINK_A1
IF ALARMF=0 THEN ALARMF=1
FINISH
ID=TN_ID
PX_SERVICE=ID; PX_REPLY=0
P2==PX; TN_T=0
->DO PON
FINISH
FINISH
REPEAT ; ! OF MAIN LOOP
SER(SET TIME): ! SET TIMER FOR URS_R0 TICKS
ID=PSECT_ID
TN==ONTMQ(ID)
TICKS=PSECT_URS_R0; ! NO OF TICKS
IF TICKS=0 OR ONTMQ(ID)_T#0 THEN FAULT TYPE=7 AND ->ERROR
TB==TIMEQ_E; ! LAST ENTRY
->BOT IF TB==NULL
T==TB_LINK; ! POINT TO FIRST ENTRY, IF ONLY ONE IT IS A LOOPED POINTER
T_T=ALARM F; ! ADJUST FOR TIME PAST
T2==TB
CYCLE ; ! CHECK THE LIST
IF TICKS<T_T START ; ! PUT ON Q HERE
TN_LINK==T2_LINK; T2_LINK==TN
T_T=T_T-TICKS
EXIT
FINISH
TICKS=TICKS-T_T
IF T==TB START ; ! AT BOTTOM
BOT: PUSH(TIMEQ, TN); ! PLANT ON END
EXIT
FINISH
T2==T
T==T2_LINK
REPEAT
TN_T=TICKS
ALARM F = TIMEQ_E_LINK_A1
->GO; ! IMMEDIATE RESCHEDULE
SER(TIME SER):
PSECT_URS_R0 = IPL TICKS
->GO; ! IMMEDIATE RESCHEDULE
SER(ALLOCATE CORE):
LAST PSECT_P == NULL; ! MUST RELOAD SEG REGS ON EXIT
ST1 == NULL
IF PSECT_ID <= LOADID START
LEN=PSECT_URS_R0; ! CORE REQUIRED IN BLOCKS
PSECT_URS_R0=0; ! URS_R1 IS THE NEW SEG
L2=K'77777'
CYCLE I=FRAG NO, -1, 0
ST2 == STORE(I)
IF ST2_LEN>=LEN AND ST2_LEN<L2 THEN C
ST1 == ST2 AND L2=ST2_LEN
REPEAT
FINISH
IF ST1 == NULL OR FREE SEGL == NULL THEN ->GO; ! NO CORE
PAR=ST1_BLOCK NO; ! ADDRESS OF BLOCK (IN BLOCKS)
IF L2>LEN START ; ! EXCESS, SO TRIM
ST1_BLOCKNO=ST1_BLOCK NO+LEN
ST1_LEN=ST1_LEN-LEN
ELSE ST1 = 0
KL==FREE SEGL
!! FAULT(12) - NO FREE SEGMENT CELLS, NOW PASSED AS NO CORE
FREE SEGL==KL_L
KS1==KL; ! MAP THE 'REAL' TYPE ON
KS1_USE=0; ! 'SHARED' WILL MAKE IT '1'
S = 6
PDR=(LEN-1)<<8!6
KS1_PAR=PAR; KS1_PDR=PDR
CALL SEG = PSECT_URS_R1
SEG1==PSECTN_SEG(CALL SEG)
PSECT_URS_R0=BLOCK
->DO SHARED; ! FILL HIS SEG ENTRY
SER(GET ABS): ! GET ABSOLUTE ADDRESS OF VIRT SEG
! R0=TARGET ID
! R1=TARGET SEGMENT
! R2=0 - DROP =1 - GET
IF PSECT_URS_R2=0 THEN PSECT_URS_R1=-1 ELSEC
PSECT_URS_R2=8
!! THIS CHANGES IT TO THE FORMAT EXPECTED BY MAP VIRT
!! IT IS ALWAYS MAPPED TO THE CALLERS SEGMENT ZERO
SER(MAP VIRT): ! MAP USER A TO B
! R0 = TARGET ID
! R1 = TARGET SEG
! R2 = CALLERS SEG
! R1 = -1 SIGNIFIES DROP SEG
CALL SEG=PSECT_URS_R2; ! GET CALLERS SEG NO
SEG1==PSECT_SEG(CALL SEG)
MAP2:
S=0; PAR=0; PDR=0
IF PSECT_ID=LOADID THEN S=6
IF PSECT_URS_R1<0 START ; ! DROP SEGMENT
KS1==SEG1_KSL
IF KS1==NULL THEN ->MV FAIL; ! NO SEG
KS1_USE=KS1_USE-1
IF KS1_USE=0 THEN DEALLOCATE(KS1)
SEG1=0; ! ZERO CALLERS ENTRY
ELSE
!! MAP TO DESIRED SEG
I = SER MAP(PSECT_URS_R0)
-> MV FAIL UNLESS TASK LOW LIMIT <= I <= TASK LIMIT
PSECT2==PSECTA(I)_P
-> MV FAIL IF PSECT2==NULL
KS1==PSECT2_SEG(PSECT_URS_R1)_KSL
DO SHARED:
UNLESS KS1==NULL START
PAR=KS1_PAR; PDR=KS1_PDR!S
SEG1_PAR=PAR; SEG1_PDR=PDR
SEG1_KSL==KS1
KS1_USE=KS1_USE+1
FINISH
FINISH
MV FAIL: ! COMES HERE IF CALL FAILS OR IS OK
PSECT_URS_R0=PAR; PSECT_URS_R1=PDR; ! PASS RESULT BACK
-> GO IF SERVICE = GET ABS; ! CANT SET REAL SEG 8 !
SET SEGREGS:
UPAR(CALL SEG) = PAR
UPDR(CALL SEG) = PDR
->GO
SER(GET ID): ! RETURN ID OF TASK IN R0
PSECT_URS_R0=PSECT_ID
->GO
SER(LINKIN): ! R0 IS REQUIRED SERVICE
SER MAP(PSECT_URS_R0)=PSECT_ID
->GO
SER(MAP SHARED): ! R0 IS ID, R1=SEG, R2=SHARED NO
PSECT2==PSECTA(PSECT_URS_R0)_P
FAULT(8) IF PSECT2==NULL
SEG1==PSECT2_SEG(PSECT_URS_R1)
D1_X = PSECT_URS_R2
KS1 == D2_X; ! LOADER PASSES ADDRESS OF DESCRIPT
LAST PSECT_P == NULL
S=2; CALL SEG = 1
->DO SHARED
SER(INSERT): ! ALLOCATE A NEW PSECT (AND MAP TO R0?)
CYCLE ID=TASK LOW LIMIT, 1, TASK LIMIT
-> GOT FREE IF PSECTA(ID)_P==NULL
REPEAT
PSECT_URS_R0 = 0; ! PASS BACK FAILED
-> GO
GOT FREE:
D1_X=PSECT AREA+(ID-MOTHER-1)*(PSECT LENGTH*2)
!! SHOULD BE *(PSECT LENGTH*2)
PSECTA(ID)_P==D2_X
PSECTN==D2_X; ! MAP TO ARRAY AND PSECTN
PSECTN_ID=ID
SER MAP(ID)=ID
->MPS; ! RESTART LOADER
SER(MAP HREGS): ! MAP HARDWARE REGS TO SEG R0
SEG1==PSECT_SEG(PSECT_URS_R0)
SEG1_PAR=K'7600'; SEG1_PDR=K'77406'; SEG1_KSL==NULL
LAST PSECT_P == NULL; ! FORCE A RELOAD OF SEGMENT REGS
->GO
SER(MAP PSECT): ! MAP PSECT 'R0' TO SEG IN R1
ID = PSECT_URS_R0; ! TARGET TASK ID
MPS: CALL SEG=PSECT_URS_R1
SEG1==PSECT_SEG(CALL SEG)
PT=0
IF PSECT_ID=LOADID THEN PDR=2<<8!6 ELSE PDR=2<<8!2
D2_X==PSECTA(ID)_P
UNLESS D2_X==NULL START
PAR = D1_X>>6
SEG1_PAR=PAR; ! MAP TO THE START OF ITS BLOCK
SEG1_PDR=PDR; ! ACCESS DEPENDS ON TASK
SEG1_KSL == NULL
PT=CALL SEG<<13!(D1_X&K'77'); ! POINT R0 TO ITS BEGINNING
FINISH
PSECT_URS_R0=PT
->SET SEGREGS
SER(SET PRIO): ! SET PRIO BETWEEN 0 AND 3
PSECT_PRIO = PSECT_URS_R0&3
SCHEDULE; ! CHECK A HIGHER ONE NOT RUNNING
->SEARCH CPU Q
SER(SET T BIT): ! SET THE TRACE TRAP
PSECT_URS_PS = PSECT_URS_PS!K'20'
-> GO
SER(TOFF): ! TEST FOR MESSAGES
PSECT_URS_R0 = 0
IF NOT PSECT_POFFQ_E == NULL THEN PSECT_URS_R0 = 1
-> GO
SER(GPSPEC): ! PASS A CHAR TO APP TOWER PLOTTER
D1_X = SVCADDRESS-6; ! PICKUP POINTER TO GPCHAR
D1_X = D3_X; ! D1_X SHOULD NOW POINT TO GPCHAR ITSELF
D3_X = PSECT_URS_R0; ! PUT CHARINTO LOCATION
-> GO
SER(DPTAB):
D1_X = SVCADDRESS-6
I = D3_X; ! = 0 IF NO DP CODE IN BRUN
PT = PSECT_URS_R0; ! TARGET SEGMENT
PSECT_URS_R0 = I
PSECT_SEG(PT)_PAR = I>>6; PSECT_SEG(PT)_PDR = K'406'
PSECT_SEG(PT)_KSL == NULL; LAST PSECT_P == NULL; ! FORCE RELOAD
-> GO
ROUTINE SCHEDULE
PSECT_STATE=(PSECT_STATE&T SUSP)!T CPUQ
PUSH(CPUQ(PSECT_PRIO), PSECT)
END
ROUTINE DEALLOCATE(RECORD (KSEGF) NAME KS)
RECORD (STOREF) NAME S, S2, S3
RECORD (KSEGLF) NAME KSL
INTEGER I, BOT, BLOCK, LEN
BLOCK=KS_PAR; LEN=KS_PDR>>8+1
BOT=BLOCK+LEN; S2==NULL
CYCLE I=FRAG NO, -1, 0
S==STORE(I)
IF S_BLOCK NO+S_LEN=BLOCK START
IF S2==NULL START
S_LEN=S_LEN+LEN; ! ADD IT ON THE BOTTOM
S2==S; ! REMEMBER IT
ELSE
S_LEN=S_LEN+S2_LEN
S2 = 0
EXIT
FINISH
ELSE
IF S_BLOCK NO=BOT START
IF S2==NULL START ; ! NOT FOUND THE UPPER HALF
S_BLOCK NO=BLOCK; S_LEN=S_LEN+LEN
S2==S; ! MARK FOUND
ELSE
S_BLOCK NO=S2_BLOCK NO
S_LEN=S_LEN+S2_LEN
S2_BLOCK NO=0; S2_LEN=0
EXIT
FINISH
FINISH
FINISH
IF S_BLOCK NO=0 THEN S3==S; ! REMEMBER EMPTY SLOT
REPEAT
IF S2==NULL START
S3_BLOCK NO=BLOCK; S3_LEN=LEN
FINISH
KSL==KS
KSL_L==FREE SEGL
FREE SEGL==KSL; ! MAP SEG ENTRY BACK TO FREE LIST
END
ROUTINE FAULT(INTEGER I)
*K'016500'; *4; ! MOV 4(LNB),R0
*K'010046'; ! MOV R0,-(SP)
*K'004737'; *K'140'; ! JSR PC,@#140 - IE JUMP TO DUMP
END
ENDOFPROGRAM