|
DataMuseum.dkPresents historical artifacts from the history of: Bogika Butler |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Bogika Butler Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 47360 (0xb900)
Types: TextFile
Names: »KNELOP.SAA«
└─⟦0b578df25⟧ Bits:30009789/_.ft.Ibm2.50006602.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »KNELOP.SAA«
└─⟦798d317aa⟧ Bits:30009789/_.ft.Ibm2.50006626.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦798d317aa⟧ Bits:30009789/_.ft.Ibm2.50006628.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »KNELOP.SAA«
***********************************************************************
* Copyright 1984 by *
* NCR Corporation *
* Dayton, Ohio U.S.A. *
* All Rights Reserved *
***********************************************************************
* EOS Software produced by: *
* NCR Systems Engineering - Copenhagen *
* Copenhagen *
* DENMARK *
***********************************************************************
ENDI END "INDIRECT";
LEA (A1,D1),A6 A6:=POINTER:=POINTER_STRUCT+POINTER_REL;
MOVE.B PT_KIN(A6),D2 D2:=POINTER.KIND; "WORD CLEARED AT ENTRY"
***
PRT_MEM C_PT,(A6),FP_SIZ
ELSE.S ELSE "VOID"
SUB #2,A4 ARGUMENT ADDR:=UPDATED
ENDI END;
MOVE (A7)+,D3 RESTORE D3;
***
PRT_REG C_PT
CMPA.L A2,A4 SR:=NE; "OK"
RTS RETURN
ER_ILLE EQU *
ADD #2,A7 RELEASE SAVED D3
BRA ER_ADDR GOTO ADDR_ILLEGAL;
PAGE
C_ENT EQU * CHECK ENTITY ARGUMENT, NORMAL CTX
* CALL: RETURN:
* A1 - POINTER STRUCT (UNDEF IF VOID ARG.)
* A2 CONTEXT SAME
* A4 ARGUMENT ADDR UPDATED
* A5 - ENTITY (ENV, OBJ, OR UNDEF)
* A6 - POINTER (UNDEF IF VOID ARG.)
* D1.W - POINTER REL (UNDEF IF VOID ARG.)
* D2.W - POINTER KIND (VOID KIND IF VOID ARG.)
* D4.W - CALL CAP, COPY CONTROL (AS IN PT_INF)
* D5.W - ENTITY KIND (ENV, OBJ, NIL, OR INTRPT)
* D6.W ARGUMENT# UPDATED
* D7.L - UNDEF IF OK, RESULT IF NOT OK.
* SR - NE = OK, EQ = NOT OK
* GETS A POINTER ARGUMENT AND RETRIEVES THE ENTITY FROM THE POINTER.
BSR C_PT CHECK POINTER ARG(A1:=PSTR,A6:=PT,
* D1:=PREL,D2:=PT KIND);
BEQ.S RETURN IF NOT OK THEN RETURN END;
C_ENTCOM EQU *
CLR D4 D4:=CAPS:=0;
MOVE D2,D5 D5:=POINTER_KIND*2
LSL #1,D5
CASEJMP D5 CASE POINTER_KIND OF
CASELAB NIL_2
CASELAB OBJ_2
CASELAB ENV_2
CASELAB OWN_2
CASELAB MAN_2
CASELAB ENV_2 "INTERRUPT POINTER"
CASELAB NIL_2 "VOID"
OBJ_2 EQU * OBJ_REF:
MOVE.B PT_INF(A6),D4 D4:=CALL CAP,COPY CONTROL;
AND #1<<PT_CC+1<<PT_CON,D4
ENV_2 EQU * ENV_REF, INTERRUPT POINTER:
MOVE.L PT_REF(A6),A5 A5:=ENTITY:=POINTER.REF;
MOVE.B PT_KIN(A6),D5 D5:=ENTITY KIND:=POINTER KIND;
EXT.W D5 "EXTEND TO WORD"; SR:=OK;
RTS RETURN
NIL_2 EQU * NIL, VOID;
CLR D5 D5:=ENTITY KIND:=NIL;
CMPA.L A2,A4 SR:=NE; "OK"
RTS RETURN
OWN_2 EQU * OWNER_SET:
MOVE.L 4(A6),A5 A5:=ENTITY:=LAST OBJ IN SET;
OWN_6A EQU * COMMON WITH FIRST IN SET:
BTST.B #OB_OCC,OB_STA(A5)
IF <NE> THEN.S IF OBJ.OWNERS_CALL_CAP THEN
BSET #PT_CC,D4 D4:=CAPS:=CALL CAP
ENDI END;
IF.B #OB_GEOB <EQ> OB_KIN(A5) THEN.S
TST GE_CON(A5) IF GENERAL OBJECT
IF <NE> THEN.S AND CONTROL PROC <> 0 THEN
BSET #PT_CON,D4 D4:=CAPS:=CAPS+COPY CONTROL
ENDI END;
ENDI
MOVEQ #PT_OBJ,D5 D5:=ENTITY KIND:=OBJ; SR:=OK;
RTS RETURN
MAN_2 EQU * MAN_SET:
MOVE.L 4(A6),A5 A5:=ENTITY:=LAST ENV IN SET;
MOVEQ #PT_ENV,D5 D5:=ENTITY KIND:=ENV; SR:=OK
RETURN EQU * "RETURN, COMMON FOR ALL PROCEDURES"
RTS RETURN
C_ENTRES EQU * CHECK ENTITY, NORMAL OR RESIDENT
* CALL: RETURN:
* D3 RESIDENT CTX (<>0) SAME
* OTHER: AS C_ENT
* IF CALLED FROM A RESIDENT CTX: CHECKS THAT THE POINTER IS
* NIL, VOID, OR RESIDENT. OTHERWISE AS C_ENT.
BSR C_PTRES CHECK POINTER RES(D3,...)
BEQ.S RETURN IF NOT OK THEN RETURN END;
BSR C_ENTCOM FIND ENTITY; "COMMON WITH C_ENT"
TST D3
IF <NE> THEN.S IF RESIDENT CTX
TST D5 AND ENTITY KIND <> NIL
IF <NE> THEN.S THEN
BTST.B #PT_RES,PT_INF(A6) IF POINTER NOT RESIDENT
BEQ ER_CAP THEN CAPABILITY VIOLATION END;
ENDI END;
ENDI
CMP.L A2,A4 SR:=NE; "OK"
RTS RETURN
PAGE
C_CALL EQU * CHECK CALLABLE OBJECT AND FUNCTION#
* CALL: RETURN:
* A0 EXT OR PROC OBJECT SAME (USED BY KERNEL OBJECTS)
* A2 CONTEXT SAME
* A4 ARGUMENT ADDR UPDATED (UNDEF IF SR=RETURN)
* A5 - OBJECT TO CALL (UNDEF IF SR=RETURN)
* D3.W RESIDENT CTX (<>0) UNDEF (USED BY KERNEL OBJECTS)
* D4 LOW ARG ADDR (PHYS) SAME (UNDEF IF SR=RETURN)
* D5.L - FUNCTION# (UNDEF IF SR=RETURN)
* D6.W ARGUMENT# UPDATED
* D7.L - RESULT IF SR=RETURN, UNDEF IF SR=ENTER
* SR - NE=ENTER CONTEXT, EQ=RETURN (IN THIS CASE
* A KERNEL OBJECT MAY HAVE BEEN CALLED
* AND SUSPENDED THE CONTEXT)
* OTHER - UNDEF
* USES A POINTER ARGUMENT TO DETERMINE THE OBJECT. CHECKS THE SIGN
* OF THE FUNCTION CODE ACCORDINGLY. CALLS A KERNEL OBJECT DIRECTLY.
* CHECKS REENTRANCY AND CALL CAP FOR GENERAL OBJECTS.
* IF CALLED FROM A RESIDENT CTX, CHECKS THAT THE POINTER IS RESIDENT OR NIL.
MOVE.L D4,D0 D0:=LOW ARG ADDR;
* CHECK ENTITY(A1/D1/A6:=...,A5:=ENTITY,
BSR C_ENTRES D2:=PTKIND,D4:=CAPS,D5:=ENTKIND);
EXG.L D4,D0 D0:=CAPS; D4:=LOW ARG ADDR; CCR UNCHANGED
BEQ RETURN IF NOT OK THEN RETURN END;
LSL #1,D5 D5:=ENTITY_KIND*2;
CASEJMP D5 CASE ENTITY_KIND OF
CASELAB NIL_3
CASELAB OBJ_3
CASELAB ENV_3
NIL_3 EQU * NIL OR VOID:
CMPI.B #PT_VOI,D2 IF POINTER KIND <> VOID
BNE ER_VALUE THEN POINTER VALUE ILLEGAL END;
MOVE.L CT_OBJ(A2),A5 A5:=OBJECT TO CALL:=CUR_OBJ;
MOVE.L -(A4),D5 D5:=FUNCTION#:=NEXT ARGUMENT;
ADD #1,D6 D6:=ARGUMENT# :=...+1;
RTS "SR=ENTER" RETURN;
OBJ_3 EQU * OBJECT:
ADD #1,D6 D6:=ARGUMENT# :=...+1;
MOVE.L -(A4),D5 D5:=FUNCTION# :=NEXT ARGUMENT;
BLE ER_FUNC IF FUNCTION#<=0 THEN FUNC_ILLEGAL END;
CLR D7
MOVE.B OB_KIN(A5),D7 D0.W :=OBJECT_KIND*2;
LSL #1,D7
CASEJMP D7 CASE OBJECT_KIND OF
CASELAB GEN_1
CASELAB GATE_OBJ
CASELAB COND_OBJ
CASELAB ER_STATE "OPEN OBJECT"
CASELAB ER_STATE "DORMANT OBJECT"
CASELAB ER_STATE "PROCESS OBJECT"
CASELAB ER_STATE "EXTENSION OBJECT"
CASELAB ER_STATE "SEGMENT OBJECT"
CASELAB ALLOC_OB
CASELAB SCHEDOBJ
* ENTRIES IN KERNEL OBJECTS: SEE SEPARATE MODULE"
GEN_1 EQU * GENERAL OBJECT:
BTST #PT_CC,D0 IF CALL CAP=0 THEN CAP_VIOLATION
BEQ ER_CAP END;
BTST.B #OB_REEN,OB_STA(A5)
IF <EQ> THEN.S IF OBJECT.NOT_REENTRANT THEN
LEA GE_EX(A5),A6 A6:=OBJECT.EXECUTES_HEAD;
CMPA.L GE_EX(A5),A6 IF CONTEXTS IN OBJ THEN CONC_ERROR
BNE ER_CONC END;
ENDI END;
CMPA.L A2,A4 SR:=ENTER CONTEXT; "NE"
RTS RETURN
ENV_3 EQU * ENVELOPE:
MOVE.L EN_OBJ(A5),A1 A1:=OBJECT:=ENVELOPE.HOLDING_OBJ;
CMP.B #OB_GEOB,OB_KIN(A1) IF OBJECT NOT GENERAL THEN STATE_ILLEGAL
BNE ER_STATE END;
MOVE.L OB_SPA(A1),A6 A6:=TOP_OBJ;
LEA SP_ENV(A6),A6 A6:=HEAD ENV CHAIN;
CMPA.L EN_STK(A5),A6 IF ENVELOPE NOT TOP ENVELOPE
BNE ER_STATE THEN STATE_ILLEGAL END;
MOVE.L A1,A5 A5:=OBJECT;
MOVE.L -(A4),D5 D5:=FUNCTION# :=NEXT ARGUMENT;
ADD #1,D6 ARGUMENT#:=...+1; SR:=ENTER;
RTS RETURN;
PAGE
C_SUB EQU * CHECK SUBSEGM ARGUMENT (NOT VOID)
* CALL: RETURN:
* A1 - POINTER STRUCT
* A2 CONTEXT SAME
* A4 ARGUMENT ADDR UPDATED
* A5 - BASE SEGM DESCRIPTOR
* D0.L - TOP RELATIVE ADDR IN BASE SEGM
* D1.W - POINTER REL
* D2.L - LENGTH OF SUBSEGM
* D4.W - CAPS (READ,WRITE,EXECUTE AS IN OB_STA)
* D5.L - FIRST RELATIVE ADDR IN BASE SEGM
* D6.W ARGUMENT# UPDATED
* D7.L - UNDEF IF OK, RESULT IF NOT OK
* SR - NE = OK, EQ = NOT OK
* GETS AND CHECKS A SUBSEGMENT ARGUMENT. CHECK FOR POSSIBLE VOID
* ARGUMENT MUST BE DONE BY CALLER.
MOVEM.L A6,-(A7) SAVE A6;
BSR C_ENT CHECK ENTITY (A1:=PSTR,A5:=BASE SEGM,
* A6:=PT,D1:=PREL,D5:=ENTKIN,D2/D4:=...);
MOVEM.L (A7)+,A6 RESTORE A6;
BEQ RETURN IF NOT OK THEN RETURN END;
CMP.B #PT_OBJ,D5 IF ENTKIN <> OBJECT THEN
BNE ER_VALUE REJECT END;
CMP.B #OB_SEOB,OB_KIN(A5) IF BASE_SEGM.OBJKIN <> SEGMENT THEN
BNE ER_STATE REJECT END;
MOVE.W -(A4),D4 D4:=NEXT ARGUMENT BITS 2:0;
AND #7,D4
LSL #OB_READ,D4 D4:=CAPS:=
AND.B OB_STA(A5),D4 USE BITS AND BASE_SEGM.CAPS;
MOVE.L -(A4),D5 D5:=FIRST REL:=NEXT ARGUMENT;
CMP.L SE_LEN(A5),D5 IF FIRST REL >= BASE_SEGM.LENGTH "UNSIGNED
BCC ER_DATA THEN REJECT END;
MOVE.L -(A4),D2 D2:=LENGTH:=NEXT ARGUMENT;
BLE ER_DATA IF LENGTH <= 0 THEN REJECT END;
MOVE.L D2,D0 D0:=TOPREL:=
ADD.L D5,D0 LENGTH+FIRST REL;
CMP.L SE_LEN(A5),D0 IF TOP REL > BASE_SEGM.LENGTH
BHI ER_DATA THEN REJECT END;
***
PRT_REG C_SUB
TST D6 SR:=NE; "OK"
RTS RETURN;
PAGE
C_OPEN EQU * CHECK OWNER POINTER AND OPEN OBJECT
* CALL: RETURN:
* A0 - OBJECT
* A1 - POINTER STRUCT
* A2 CONTEXT SAME
* A4 ARGUMENT ADDR UPDATED
* A5 - OBJECT (=A0)
* A6 - POINTER ADDR
* D1.W - POINTER REL
* D2.W - POINTER KIND ("OWN_SET" IF OK)
* D6.W ARGUMENT# UPDATED
* D7.L - UNDEF IF OK, RESULT IF NOT OK
* SR - NE = OK, EQ = NOT OK
* D4/D5 - UNDEF
* GETS AN ENTITY ARGUMENT AND CHECKS FOR OWNER POINTER AND OPEN OBJECT.
* (TYPICALLY USED WHEN ADDING ENV OR KERNEL ENVELOPE TO AN OBJECT).
BSR C_ENT CHECK ENTITY(A1:=PT_STR,A5:=OBJ,A6:=PT,
* D1:=PT_REL,D2:=PTKIND,D4/D5:=...);
BEQ RETURN IF NOT OK THEN RETURN END;
CMP.B #PT_OWN,D2 IF POINTER KIND <> OWN SET
BNE ER_VALUE THEN REJECT END;
CMP.B #OB_OPOB,OB_KIN(A5) IF OBJECT KIND <> OPEN
BNE ER_STATE THEN REJECT END;
MOVE.L A5,A0 A0:=A5:=OBJ;
CMPA.L A2,A4 SR:=NE; "OK"
RTS RETURN
PAGE
C_PRIM EQU * CHECK AND GET PRIMARY ENVELOPE
* CALL: RETURN:
* A0 - OBJECT HOLDING PRIMARY ENVELOPE
* A1 - POINTER STRUCT (UNDEF IF VOID ARG)
* A2 CONTEXT SAME
* A4 ARGUMENT ADDR UPDATED
* A5 - ENVELOPE (PRIMARY OF GENERAL OBJECT)
* A6 - UNDEF
* D1 - POINTER REL
* D2.W - POINTER KIND
* D6.W ARGUMENT# UPDATED
* D7.L - UNDEF IF OK, RESULT IF NOT OK
* SR - NE = OK, EQ = NOT OK
* D4/D5 - UNDEF
* GETS AN ENTITY ARGUMENT AND CHECKS FOR VOID OR PRIMARY ENVELOPE.
* (TYPICALLY USED WHEN MODIFYING A GENERAL OBJECT).
BSR C_ENT CHECK ENTITY(A1:=PSTR,A5:=ENV,D1:=PREL,
* D2:=PT_KIND,A6/D4/D5:=UNDEF);
BEQ RETURN IF NOT OK THEN RETURN END;
BTST.B D2,ENV_MAN IF POINTER KIND <> VOID, REF_ENV,MAN_SET
BEQ ER_VALUE THEN REJECT END;
IF.B #PT_VOI <EQ> D2 THEN.S IF POINTER KIND = VOID ARGUMENT THEN
MOVE.L CT_OBJ(A2),A0 A0:=OBJ:=CTX.CURRENT_OBJ;
MOVE.L OB_SPA(A0),A6 A6:=TOP OBJ;
MOVE.L SP_ENV+4(A6),A5 A5:=ENV:=OBJECT.TOP_ENVELOPE;
LEA -EN_STK(A5),A5 "OFFSET"
ELSE.S ELSE
MOVE.L EN_OBJ(A5),A0 A0:=OBJ:=ENV.HOLDER;
MOVE.L OB_SPA(A0),A6 A6:=TOP OBJ;
LEA SP_ENV(A6),A6 A6:=HEAD ENV CHAIN;
CMP.L EN_STK(A5),A6 IF ENV NOT TOP ENVELOPE
BNE ER_VALUE THEN REJECT END;
CMP.B #OB_GEOB,OB_KIN(A0) IF OBJ.KIND <> GENERAL OBJECT
BNE ER_STATE THEN REJECT END;
ENDI END;
CMPA.L A2,A4 SR:=NE; "OK"
RTS RETURN
ENV_MAN DC.B 1<<PT_VOI+1<<PT_ENV+1<<PT_MAN MASK FOR POINTER KIND
DS.W 0
PAGE
C_TOPOWN EQU * CHECK TOP STACK, OWNER OR SIMPLE POINTER
* CALL: RETURN:
* A0 - HOLDER (OBJECT HOLDING POINTER STRUCT)
* A1 - POINTER STRUCT
* A2 CONTEXT SAME
* A4 ARGUMENT ADDR UPDATED
* A6 - POINTER ADDR
* D1 - POINTER REL
* D2.W - POINTER KIND
* D6.W ARGUMENT# UPDATED
* D7.L - UNDEF IF OK, RESULT IF NOT OK
* SR - NE = OK, EQ = NOT OK
* GETS A POINTER ARGUMENT AND CHECKS FOR TEMP (I.E. TOP CONTEXT) OR
* LOCAL IN TOP ENVELOPE. CHECKS THAT POINTER CAN BECOME OWN_SET.
* (TYPICALLY USED WHEN CREATING EMBEDDED OBJECTS).
BSR C_PT CHECK POINTER(A1:=PSTR,A6:=PT,D1:=PREL,
* D2:=PT_KIND);
BEQ RETURN IF NOT OK THEN RETURN END;
BTST.B D2,SIM_OWN IF PT_KIND <> SIMPLE, OWN_SET
BEQ ER_VALUE THEN REJECT END;
BTST.B #PT_LSC,PT_INF(A6)
IF <NE> THEN.S IF LOCAL POINTER THEN
MOVE.L EN_OBJ(A1),A0 A0:=OBJECT HOLDING ENV;
MOVE.B OB_KIN(A0),D7 D7.B:= OBJ.KIND;
BTST.B D7,OBJUSER1 IF OBJ IS NOT A "USER OBJECT"
BEQ ER_SCOPE THEN REJECT;"TOP_ENV BELONGS TO KERNEL"
MOVE.L OB_SPA(A0),A0 A0:=TOP OBJ;
LEA SP_ENV(A0),A0 A0:=HEAD ENV CHAIN
CMP.L EN_STK(A1),A0 IF POINTER STRUCTURE NOT TOP ENVELOPE
BNE ER_SCOPE THEN REJECT END;
ELSE.S ELSE
BTST.B #PT_TSC,PT_INF(A6) IF NOT TEMP POINTER
BEQ ER_SCOPE THEN REJECT END;
ENDI END;
MOVE.L ST_HOLD(A1),A0 A0:=POINTER STRUCTURE.HOLDING OBJ;
TST.W D6 SR:=<NE> "=OK";
RTS RETURN
SIM_OWN DC.B 1<<PT_NIL+1<<PT_OBJ+1<<PT_ENV+1<<PT_OWN MASK FOR PT_KIND.
OBJUSER1 DC.B 1<<OB_GEOB+1<<OB_OPOB+1<<OB_DOOB "USER TOP MANAGED OBJECTS"
DS.W 0
PAGE
C_PTS EQU * CHECK #POINTERS
* CALL: RETURN:
* A4 ARGUMENT ADDR UPDATED
* D0.L - NUMBER OF POINTERS (< = MAX, >0)
* D6.W ARGUMENT# UPDATED
* D7.L - UNDEF IF OK, RESULT IF NOT OK
* SR - NE = OK, EQ = NOT OK
* GETS AND CHECKS AN INTEGER ARGUMENT SERVING AS NUMBER OF POINTERS.
ADD.W #1,D6 D6:=NEXT ARGUMENT#;
MOVE.L -(A4),D0 D0:=#POINTERS:=NEXT ARG;
BLE ER_DATA IF #POINTERS <= 0 THEN REJECT END;
CMP.L #PT_MASK-1,D0 IF #POINTERS >= MAX THEN REJECT END;
BGE ER_DATA "INCLUDE POSSIBLE T(0)". "SR = OK"
RTS RETURN
C_ADDR EQU * CHECK ADDRESS
* CALL: RETURN:
* A4 ARGUMENT ADDR UPDATED
* D0.L - ADDRESS (< 24BIT, >= 0)
* D6.W ARGUMENT# UPDATED
* D7.L - UNDEF IF OK, RESULT IF NOT OK
* SR - NE = OK, EQ = NOT OK
* GETS AND CHECKS AN INTEGER ARGUMENT SERVING AS ADDRESS.
ADD #1,D6 D6:=NEXT ARGUMENT#;
MOVE.L -(A4),D0 D0:=ADDRESS:=NEXT ARG;
BLT ER_DATA IF ADDRESS < 0 THEN REJECT END;
CMP.L #1<<24,D0 IF ADDRESS >= 2**24 THEN REJECT END;
BGE ER_DATA "SR = OK"
RTS RETURN
PAGE
C_SIZ EQU * CHECK SIZE ARGUMENT
* CALL: RETURN:
* A4 ARGUMENT ADDR UPDATED
* D0.L - SIZE USER PART (2**24-1 IF VOID)
* D1.W - SIZE KERNEL PART (2**16-1 IF VOID)
* D6.W ARGUMENT# UPDATED
* D7.L - UNDEF IF OK, RESULT IF NOT OK
* SR - NE = OK, EQ = NOT OK
* GETS AND CHECKS A SIZE ARGUMENT. IF BOTH COMPONENTS OF THE
* SIZE ARE < 0, A VOID ARGUMENT IS ASSUMED.
ADD #1,D6 D6:=NEXT ARGUMENT#;
MOVE -(A4),D1 D1:=SIZE_K_PART:=NEXT ARG WORD;
IF <GE> THEN.S IF NOT VOID THEN
MOVE.L -(A4),D0 D0:=SIZE_U_PART:=NEXT ARG LONG;
BLT ER_DATA IF SIZE_U_PART < 0 THEN REJECT END;
CMP.L #1<<24,D0 IF SIZE_U_PART >= 2**24
BGE ER_DATA THEN REJECT END; "SR=OK"
ELSE.S ELSE "VOID:"
MOVE.L -(A4),D0 D0:=SIZE_U_PART:=NEXT ARG LONG;
BGE ER_DATA IF SIZE_U_PART >= 0 THEN REJECT END;
MOVE.L #1<<24-1,D0 D0:=SIZE_U_PART:=MAX;
MOVE.L #1<<15-1,D1 D1:=SIZE_K_PART:=MAX;
ENDI END;
RTS RETURN;
TTL STACK CHECK
PAGE
S_MOVE EQU * STACK CHECK FOR MOVE OWNER
* CALL: RETURN:
* A1 POINTER STRUCT SAME (NEW OWNER POINTER)
* A5 OBJECT SAME (OBJECT TO GET NEW OWNER)
* D1.W POINTER REL SAME (NEW OWNER POINTER)
* D7.L - UNDEF IF OK, RESULT IF NOT OK
* SR - NE = OK, EQ = NOT OK
* A0/A6/D0/D4/D5: - UNDEF
* CHECKS WHETHER STACK REQUIREMENTS WOULD BE VIOLATED IF OBJECT
* GOT THE NEW OWNER POINTER. ALSO CHECKS WHETHER OBJECT IS AN ANCESTOR
* OF THE NEW OWNER (NORMALLY A PROCESS), SINCE THAT WOULD BE SELF-DELETION.
* (TYPICALLY USED FROM RET_FP, C_NXT_M (KERNEL ENVELOPE), AND MOVE_OWN).
MOVEM.L A1/A2/D1,-(A7) SAVE A1,A2,D1; "INITIAL PSTR, PREL"
BTST.B #OB_EMB,OB_STA(A5) TEST FOR EMBEDDED OBJECT;
IF <EQ> THEN.S IF NOT EMBEDDED THEN "ENV MAY BE PRESENT"
MOVE.L OB_SPA(A5),A6 A6:=TOP OBJECT;
MOVE.L SP_ENV+4(A6),A0 A0:=ENV:=OBJ.TOP ENVELOPE
LEA SP_ENV(A6),A2 A2:=HEAD ENV STACK;
IF.L A2 <NE> A0 THEN.S IF TOP ENVELOPE EXISTS THEN
LEA -EN_STK(A0),A0 A0:=ENV "OFFSET";
MOVE.L EN_TERMU(A0),D4 D4/D5:=ENV.TERM REQUIREMENT;
MOVE EN_TERMK(A0),D5
COM_MOV EQU * COMMON WITH S_TERM:
BSR S_GROW CHECK GROWTH (TERM REQ, PSTR, PREL
* A2/A6/D0:=UNDEF,
* A1:=PSTR, D1:=PREL "FOR STOP SEARCH");
BEQ.S RET_S4 IF NOT OK THEN REJECT END;
ENDI END "ENVELOPE EXISTS"
ENDI ENDI;"NOT EMBEDDED"
TST D1 "TEST FOR SELF DELETION:"
WHILE <NE> DO.S WHILE PREL <> 0 "NOT INITIAL POINTER" DO
***
PRT_REG SELF_DELETE
MOVE.L ST_HOLD(A1),A0 A0:=PARENT OBJ:=PSTR.HOLDER;
CMPA.L A0,A5 IF PARENT OBJ = OBJ
BEQ.S ER_SELF1 THEN REJECT "SELF DELETE" END;
MOVE.L OB_OWN(A0),A1 A1:=PSTR:=PARENT OBJ.OWNER STRUCT;
MOVE OB_OFF(A0),D1 D1:=PREL:=PARENT OBJ.OWNER REL;
ENDW END "INITIAL POINTER REACHED"
RET_S1 EQU * RETURN OK:
CMPA.L A1,A5 SE:=NE; "OK"
RET_S4 EQU * REJECT:
MOVEM.L (A7)+,A1/A2/D1 RESTORE A1,A2,D1; "INITIAL PSTR, PREL"
RTS RETURN
ER_SELF1 EQU * REJECT, SELF DELETION:
MOVEM.L (A7)+,A1/A2/D1 RESTORE;
BRA ER_SELF REJECT;
PAGE
S_TERM EQU * STACK CHECK BEFORE TERM PROC ENTRY
* CALL AND RETURN: LIKE S_MOVE.
* SIMILAR TO S_MOVE, BUT CONTEXT AND TEMP DATA (T(1)) HAVE BEEN
* CREATED. THUS THE REMAINING TERMINATION REQUIREMENT IS SMALLER.
* (USED BY C_NXT_M BEFORE ENTERING TERM PROC).
MOVEM.L A1/A2/D1,-(A7) SAVE AS IN S_MOVE;
MOVE.L OB_SPA(A5),A6 A6:=TOP OBJECT;
MOVE.L SP_ENV+4(A6),A0 A0:=ENV:=OBJ.TOP ENVELOPE; "EXISTS ALWAYS"
LEA -EN_STK(A0),A0 "OFFSET"
BSR S_CTX GET_TERM_CTX_REQ(ENV,D4/D5:=CTX_REQ,
* A6:=...);
* CTX_REQ IS SPACE FOR CONTEXT WITH DEFAULT PARAMS PLUS TEMP DATA.
NEG.L D4
NEG D5 D4/D5:=TERM REQUIREMENT:=
ADD.L EN_TERMU(A0),D4 ENV.TERM REQUIREMENT - CTX_REQ;
ADD EN_TERMK(A0),D5
BRA COM_MOV GOTO COMMON WITH S_TERM;
PAGE
S_GROW EQU * STACK CHECK FOR GROWTH
* CALL: RETURN:
* A1 POINTER STRUCT(NEW OWNER) PSTR FOR STOP CHECK
* D1 POINTER REL (NEW OWNER) PREL FOR STOP CHECK
* D4 TERM REQUIREMENT, USER UNDEF (TERM REQ FOR ENVELOPE DELETION)
* D5 TERM REQUIREMENT, KERNEL UNDEF ( - - - - - )
* D7.L - UNDEF IF OK, RESULT IF NOT OK
* SR - NE = OK, EQ = NOT OK
* A2/A6/D0: - UNDEF
* CHECKS WHETHER STACK REQUIREMENTS WOULD BE VIOLATED IF AN
* OBJECT HAD THE TERM REQUIREMENTS SPECIFIED AND THE OWNER SPECIFIED.
* (USED BY S_MOVE, S_TERM, S_ENV).
TST D1
WHILE <NE> DO.S WHILE PREL <> 0 "NOT INITIAL POINTER" DO
***
PRT_REG S_GROW
BTST.B #PT_LSC,PT_INF(A1,D1)
IF <EQ> THEN.S IF POINTER TEMP OR FORMAL THEN
LEA CT_STKU(A1),A6 "POINTER STRUCT = CTX"
BSR S_MAX D4/D5:=MAX(CTX.FREE STACK,TERM REQ);
BGT ER_CONLIM IF TERM REQ > CTX.FREE STACK
* THEN REJECT END;
BRA.S RET_S2 RETURN OK;
ENDI END;
MOVE.L EN_OBJ(A1),A2 "LOCAL POINTER: A1 = ENVELOPE"
MOVE.L OB_SPA(A2),A2 A2:=TOP OBJ HOLDING ENV;
LEA SP_ENV(A2),A2 A2:=HEAD ENV STACK;
REPEAT REPEAT "SCAN ENV AND YOUNGER ENV:"
MOVEM.L D4/D5,-(A7) SAVE TERM REQ;
LEA EN_MAXU(A1),A6 "CHECK AGAINST MAX STACK:"
BSR S_MAX D4/D5:=MAX(ENV.MAX STACK,TERM REQ);
MOVEM.L (A7)+,D4/D5 D4/D5:=RESTORE TERM REQ;
BGT ER_ENVLIM IF TERM REQ > ENV.MAX STACK
* THEN REJECT END;
ADD.L EN_FIXU(A1),D4 D4/D5:=TERM REQ:=
ADD EN_FIXK(A1),D5 TERM REQ+ENV.FIXED REQUIREMENTS;
LEA EN_TERMU(A1),A6 D4/D5:=MAX(ENV.TERM REQ, TERM REQ);
BSR S_MAX IF TERM REQ <= ENV.TERM REQ
BLE.S RET_S2 THEN RETURN OK END;
MOVE.L EN_STK(A1),A6 A6:=NEXT ENV(ENV);
LEA -EN_STK(A6),A1 A1:=ENV:="OFFSET NEXT ENV";
UNTIL.L A6 <EQ> A2 UNTIL ENV = HEAD ENV STACK;
MOVE.L (A2),A2 A2:=FIRST ENV;
MOVE.L EN_OBJ-EN_STK(A2),A2 A2:=OBJ HOLDING FIRST ENV;
MOVE.L OB_OWN(A2),A1 A1:=POINTER STRUCT:=OBJ.OWNER STRUCT;
MOVE OB_OFF(A2),D1 D1:=POINTER REL:=OBJ.OWNER REL;
ENDW END "INITIAL POINTER REACHED"
RET_S2 EQU * RETURN OK: "ALSO USED FROM S_LOC"
CMPA #0,A7 SR:=NE; "OK"
RTS RETURN;
PAGE
S_UPDATE EQU * STACK REQUIREMENT UPDATE
* CALL: RETURN:
* A5 OBJECT SAME
* A6/D0 - UNDEF
* UPDATES THE STACK REQUIREMENTS FOR ANCESTORS OF THE OBJECT.
* (USED BY MOVE_OWN, RET_FP, CRE_ENV, DECL_GEN).
MOVEM.L A1/A2/A5/D4/D5,-(A7) SAVE REGISTERS;
BTST.B #OB_EMB,OB_STA(A5) TEST FOR EMBEDDED OBJ;
IF <EQ> THEN.L IF NOT EMBEDDED THEN "ENV MAY BE PRESENT"
MOVE.L OB_SPA(A5),A6 A6:=TOP OBJ;
MOVE.L SP_ENV+4(A6),A1 A1:=TOP ENV:=OBJ.TOP ENV;
LEA SP_ENV(A6),A2 A2:=HEAD ENV STACK;
IF.L A1 <NE> A2 THEN.S IF TOP ENV EXISTS THEN
MOVE.L EN_TERMU-EN_STK(A1),D4 D4/D5:=TERM REQ:=TOP ENV.TERM REQ;
MOVE EN_TERMK-EN_STK(A1),D5
REPEAT REPEAT "NEXT ANCESTOR:"
MOVE.L OB_OWN(A5),A1 A1:=POINTER STRUCT:=OBJ.OWNER STRUCT;
MOVE OB_OFF(A5),D0 D0:=POINTER REL:=OBJ.OWNER REL;
***
PRT_REG S_UPDATE
BEQ.S RET_S3 IF INITIAL POINTER
BTST.B #PT_LSC,PT_INF(A1,D0) OR TEMP POINTER OR FORMAL POINTER
BEQ.S RET_S3 THEN RETURN END;
* "A1=ENV=OWNER ENVELOPE"
MOVE.L EN_OBJ(A1),A5 A5:=OBJ:=OBJ HOLDING OWNER ENV;
MOVE.L OB_SPA(A5),A6 A6:=TOP OBJ;
LEA SP_ENV(A6),A2 A2:=HEAD ENV STACK;
REPEAT REPEAT "ENV AND YOUNGER ENVELOPES:"
ADD.L EN_FIXU(A1),D4 D4/D5:=TERM REQ:=
ADD EN_FIXK(A1),D5 TERM REQ+ENV.FIXED REQUIREMENTS;
CLR D0 INCREMENT:=0;
IF.L D4 <GE> EN_TERMU(A1) THEN.S IF TERM REQ >= ENV.TERM REQ
IF D5 <GE> EN_TERMK(A1) THEN.S "BOTH COMPONENTS" THEN
MOVE #1,D0 INCREMENT:=1
ENDI END;
ENDI
LEA EN_TERMU(A1),A6 D4/D5:=
BSR S_MAX MAX(ENV.TERM REQ, TERM REQ);
IF <LE> THEN.S IF TERM REQ <= ENV.TERM REQ "BOTH COMPONENTS
ADD D0,EN_COU(A1) THEN ENV.TERM COUNT:=...+INCREMENT
BRA.S RET_S3 RETURN
ENDI END;
MOVE D0,EN_COU(A1) ENV.TERM COUNT:=INCREMENT;
MOVE.L D4,EN_TERMU(A1) "AT LEAST ONE NEW COMPONENT IN MAX"
MOVE D5,EN_TERMK(A1) ENV.TERM REQ:=TERM REQ;
MOVE.L EN_STK(A1),A6 A6:=NEXT ENV(ENV);
LEA -EN_STK(A6),A1 A1:=ENV:="OFFSET NEXT ENV";
UNTIL.L A6 <EQ> A2 UNTIL ENV = HEAD ENV STACK;
UNTIL <NE> UNTIL FALSE; "ALL ANCESTORS"
ENDI END "TOP ENV EXISTS";
ENDI ENDI;"NOT EMBEDDED"
RET_S3 EQU * RETURN:
MOVEM.L (A7)+,A1/A2/A5/D4/D5 RESTORE REGISTERS;
RTS RETURN;
PAGE
S_SHRINK EQU * SHRINK STACK REQUIREMENTS
* CALL: RETURN:
* A5 OBJECT SAME (NOT IN OWN_SET,BUT HAS REF TO OLD OWNSET
* A6/D0 - UNDEF
* UPDATES THE STACK REQUIREMENTS FOR ANCESTORS OF THE OBJECT, CORRESPONDING
* TO MOVING THE OBJECT TO ANOTHER OWNER.
* (USED BY M_OWN_OK).
MOVEM.L A1/A2/A5/D4/D5,-(A7) SAVE REGISTERS;
BTST.B #OB_EMB,OB_STA(A5) TEST FOR EMBEDDED OBJ;
IF <EQ> THEN.L IF NOT EMBEDDED THEN "ENV MAY BE PRESENT"
MOVE.L OB_SPA(A5),A6 A6:=TOP OBJ
MOVE.L SP_ENV+4(A6),A1 A1:=TOP ENV:=OBJ.TOP ENV;
LEA SP_ENV(A6),A2 A2:=HEAD ENV STACK;
IF.L A1 <NE> A2 THEN IF TOP ENV EXISTS THEN
MOVE.L EN_TERMU-EN_STK(A1),D4 D4/D5:=TERM REQ:=TOP ENV.TERM REQ;
MOVE EN_TERMK-EN_STK(A1),D5
REPEAT REPEAT "NEXT ANCESTOR:"
***
PRT_REG S_SHRINK
MOVE.L OB_OWN(A5),A1 A1:=POINTER STRUCT:=OBJ.OWNER STRUCT;
MOVE OB_OFF(A5),D0 D0:=POINTER REL:=OBJ.OWNER REL;
BEQ RET_S3 IF INITIAL POINTER
BTST.B #PT_LSC,PT_INF(A1,D0) OR TEMP POINTER OR FORMAL POINTER
BEQ RET_S3 THEN RETURN END;
* "A1=ENV=OWNER ENVELOPE"
MOVE.L EN_OBJ(A1),A5 A5:=OBJ:=OBJ HOLDING OWNER ENV;
MOVE.L OB_SPA(A5),A6 A6:=TOP OBJ;
LEA SP_ENV(A6),A2 A6:=HEAD ENV STACK;
REPEAT REPEAT "ENV AND YOUNGER ENVELOPES:"
ADD.L EN_FIXU(A1),D4 D4/D5:=TERM REQ:=
ADD EN_FIXK(A1),D5 TERM REQ+ENV.FIXED REQUIREMENTS;
IF.L D4 <EQ> EN_TERMU(A1) THEN.S IF TERM REQ = ENV.TERM REQ
IF D5 <EQ> EN_TERMK(A1) THEN.S "BOTH COMPONENTS" THEN
SUB #1,EN_COU(A1) ENV.TERM COUNT:=...-1;
ENDI END;
ENDI
TST EN_COU(A1) IF ENV.TERM COUNT <> 0
BNE RET_S3 THEN RETURN END;
IF.L D4 <LT> EN_TERMU(A1) THEN.S IF TERM REQ < ENV.TERM REQ
CMP EN_TERMK(A1),D5 "BOTH COMPONENTS" THEN
BLT RET_S3 RETURN
ENDI END;
* NO LOCALS ETC. HAVE TERM REQ = MAX FOR BOTH COMPONENTS.
* RECOMPUTE ENV.TERM REQ USING THE NEW VALUES FOR LOCALS AND OLDER ENVELOPES:
MOVEM.L D4/D5/A0,-(A7) SAVE "OLD" TERM REQ, A0;
MOVE.L A1,A0 A0:=ENV;
BSR S_CTX GET_TERM_CTX_REQ(ENV,D4/D5:=CTX_REQ,
* A6:=MANAGER OBJ);
BSR S_INITENV INIT TERM REQ(ENV,MANAGER OBJ,CTX_REQ,
* D4/D5:=TERM REQ NO LOCALS,D0:=UNDEF);
BSR S_MAXLOC MAX REQ WITH LOCALS(ENV,TERM REQ NO LOCALS
* D4/D5:=TERM REQ,D0:=TERM COUNT);
MOVE D0,EN_COU(A0) ENV.TERM COUNT:=TERM COUNT;
MOVE.L D4,EN_TERMU(A0) ENV.TERM REQ:=TERM REQ;
MOVE D5,EN_TERMK(A0)
MOVEM.L (A7)+,D4/D5/A0 D4/D5:=RESTORE OLD TERM REQ, A0;
MOVE.L EN_STK(A1),A6 A6:=NEXT ENV(ENV);
LEA -EN_STK(A6),A1 A1:=ENV:="OFFSET NEXT ENV";
UNTIL.L A6 <EQ> A2 UNTIL ENV = HEAD ENV STACK;
UNTIL <NE> UNTIL FALSE; "ALL ANCESTORS"
ENDI END "TOP ENV EXISTS"
ENDI ENDI;"NOT EMBEDDED"
BRA RET_S3 RETURN;
S_ENV EQU * INIT ALL ENVELOPE TERM REQUIREMENTS
* CALL: RETURN:
* A3 ENVELOPE SAME (NO LOCALS ASSUMED)
* D7.L - UNDEF IF OK, RESULT IF NOT OK
* SR - NE = OK, EQ = NOT OK
* ENV_FIXED REQ: DEALLOC STACK CTX REQUIREMENT+DEALLOC STACK
* INITIALIZES TERM REQUIREMENT, TERM COUNT. UPDATES FIXED REQUIREMENT.
* CHECKS THAT ANCESTOR REQUIREMENTS ARE NOT VIOLATED. (USED BY CRE_ENV).
MOVEM.L A0-A2/A6/D0/D1/D4/D5,-(A7) SAVE REGISTERS
MOVE.L A3,A0 A0:=ENVELOPE;
BSR S_CTX GET_TERM_CTX_REQ(ENV,D4/D5:=CTX_REQ,
* A6:=MANAGER OBJ);
ADD.L D4,EN_FIXU(A0) ENV.FIXED REQUIREMENTS:=
ADD D5,EN_FIXK(A0) ... "DEALLOC" + CTX_REQ;
BSR S_INITENV INIT ENV NO LOCALS(ENV,MANAGER OBJ,
* CTX_REQ,D4/D5:=TERM REQ,D0:=UNDEF);
MOVE.L EN_OBJ(A0),A6 A6:=OBJECT HOLDING ENV;
MOVE.L OB_OWN(A6),A1 A1:=OBJ.OWNER STRUCT;
MOVE OB_OFF(A6),D1 D1:=OBJ.OWNER REL;
BSR S_GROW CHECK GROWTH(PSTR,PREL,TERM REQ,
* A2/A6/D0:=UNDEF); SR:=...
MOVEM.L (A7)+,A0-A2/A6/D0/D1/D4/D5 RESTORE REGISTERS;
RTS RETURN
PAGE
S_LOC EQU * CHECK FREE STACK FOR DELETE LOCALS
* CALL: RETURN:
* A2 CONTEXT SAME
* A3 ENVELOPE SAME
* D7.L - UNDEF IF OK, RESULT IF NOT OK
* SR - NE = OK, EQ = NOT OK
* A0/A6/D0/D4/D5: - UNDEF
* CHECKS THAT THE FREE STACK IN "CONTEXT" IS SUFFICIENT FOR DELETING ALL
* LOCALS IN "ENVELOPE".
* A FAST CHECK IS MADE FIRST TO SEE WHETHER FREE STACK WOULD
* SUFFICE TO "EXECUTE" THE TERMINATION PROCEDURE OF THE ENVELOPE - FROM
* THE POINT WHERE IT HAS USED ITS "DEALLOC STACK". THIS CHECK IS
* PESSIMISTIC SINCE OLDER ENVELOPES AND CALL STACK REQUIREMENT IS INCLUDED.
* IF THE CHECK FAILS, A SLOWER BUT EXACT CHECK IS MADE.
* (USED BY DEL_ENV).
MOVE.L EN_TERMU(A3),D4 D4/D5:=ENV.TERM REQ - ENV.FIXED REQ;
MOVE EN_TERMK(A3),D5
SUB.L EN_FIXU(A3),D4
SUB EN_FIXK(A3),D5
LEA CT_STK(A2),A6 D4/D5:=MAX(...,CTX.FREE STACK);
BSR S_MAX IF ENV.TERM REQ - ENV.FIXED REQ <=
BLE RET_S2 CTX.FREE STACK THEN RETURN OK END;
MOVE.L EN_FIXU(A3),D4 "OLDER ENVELOPES OR CALL STACK MIGHT BE LARGER"
MOVE EN_FIXK(A3),D5 D4/D5:=INITIAL TERM REQ:=ENV.FIXED REQ;
MOVE.L A3,A0 A0:=ENV;
BSR S_MAXLOC MAX REQ WITH LOCALS(ENV,INITIAL TERM REQ,
* D4/D5:=TERM REQ,D0:=TERM COUNT);
SUB.L EN_FIXU(A3),D4 D4/D5:=TERM REQ:=...-ENV.FIXED REQ;
SUB EN_FIXK(A3),D5 "D4/D5=MAXIMUM OF LOCALS"
BSR S_MAX D4/D5:=MAX(TERM REQ,CTX.FREE STACK);
BLE RET_S2 IF TERM REQ <= CTX.FREE STACK
* THEN RETURN OK END;
BRA ER_PROSP REJECT, PROCESS SPACE LIMITED
PAGE
S_MAX EQU * FIND MAX SIZE AND COMPARE
* CALL: RETURN:
* A6 SIZE ADDR SAME (ADDR OF CT_STKU, EN_MAXU, ETC.)
* D4 TERM REQUIREMENT,USER MAX(TERM REQ, SIZE)
* D5 TERM REQUIREMENT,KERNEL MAX(TERM REQ, SIZE)
* SR - GT: TERM REQ > SIZE, LE: TERM REQ <= SIZE
* FINDS MAXIMUM OF TWO SIZES AND COMPARES THEM. EACH SIZE CONSISTS
* OF A USER SIZE AND A KERNEL SIZE. ONE SIZE IS GIVEN BY "SIZE ADDR",
* THE OTHER AS "TERM REQUIREMENT".
* TERM REQ <= SIZE MEANS: TERM REQ USER <= SIZE USER AND
* TERM REQ KERNEL <= SIZE KERNEL
* TERM REQ > SIZE IN ALL OTHER CASES.
IF.L D4 <LE> (A6) THEN.S IF TERM REQ USER <= SIZE USER THEN
MOVE.L (A6),D4 D4:=MAX USER:=SIZE USER;
IF D5 <LE> SZ_K(A6) THEN.S IF TERM REQ KERNEL <= SIZE KERNEL THEN
MOVE SZ_K(A6),D5 D5:=MAX KERNEL:=SIZE KERNEL;
MOVE #4,CCR SR:=LE, "BOTH ARE <= "
ELSE.S ELSE
MOVE #0,CCR SR:=GT; "ONE IS >"
ENDI END
ELSE.S ELSE "TERM REQ USER > SIZE USER:"
IF D5 <LE> SZ_K(A6) THEN.S IF TERM REQ KERNEL <= SIZE KERNEL THEN
MOVE SZ_K(A6),D5 D5:=MAX KERNEL:=SIZE KERNEL
ENDI END;
MOVE #0,CCR SR:=GT; "ONE OR TWO ARE >"
ENDI END;
***
PRT_REG S_MAX
RTS RETURN
PAGE
S_INITENV EQU * INIT ENVELOPE TERM WITHOUT LOCALS
* CALL: RETURN:
* A0 ENVELOPE SAME
* A6 MANAGER OBJ(MAYBE DUMMY) UNDEF
* D4.L CTX REQUIREM, USER TERM REQUIREM, USER "WITHOUT LOCALS"
* D5.W CTX REQUIREM, KERNEL TERM REQUIREM, KERNEL "WITHOUT LOCALS"
* D0 - UNDEF
* ENV.FIXED REQUIREMENT: CTX REQUIREMENT+DEALLOC (UNCHANGED)
* INITS THE TERMINATION REQUIREMENT OF THE ENVELOPE, DISREGARDING LOCALLY
* OWNED OBJECTS. THUS THE FOLLOWING IS INCLUDED:
* ROOM FOR CTX REQUIREMENT+DEALLOC+OLDER ENVELOPES
* ROOM FOR CTX REQUIREMENT+CALL STACK
ADD.L GE_STK(A6),D4 D4/D5:=CALL REQ:=CTX REQUIREMENT
ADD GE_STK+SZ_K(A6),D5 +MANAGER OBJ.CALL_STACK_REQ;
MOVE.L EN_FIXU(A0),EN_TERMU(A0) ENV.TERM REQ:=ENV.FIXED REQUIREMENT;
MOVE EN_FIXK(A0),EN_TERMK(A0) "CTX REQUIREMENT+DEALLOC"
MOVE.L EN_OBJ(A0),A6 A6:=OBJ HOLDING ENV;
MOVE.L OB_SPA(A6),A6 A6:=TOP OBJ;
LEA SP_ENV(A6),A6 A6:=HEAD ENVELOPE STACK;
IF.L A6 <NE> EN_STK+4(A0) THEN.S IF OLDER ENVELOPE EXISTS THEN
MOVE.L EN_STK+4(A0),A6 A6:=OLDER ENVELOPE; "OFFSET"
MOVE.L EN_TERMU-EN_STK(A6),D0 D0:=OLDER ENV.TERM REQUIREMENT;
ADD.L D0,EN_TERMU(A0) ENV.TERM REQ:=ENV.TERM REQ
MOVE EN_TERMK-EN_STK(A6),D0 + OLDER ENV.TERM REQ;
ADD D0,EN_TERMK(A0)
ENDI
LEA EN_TERMU(A0),A6
BSR S_MAX D4/D5:=MAX(CALL REQ, ENV.TERM REQ);
MOVE.L D4,EN_TERMU(A0) ENV.TERM REQ:=MAX(...);
MOVE D5,EN_TERMK(A0)
MOVE #1,EN_COU(A0) ENV.TERM COUNT:=1;
RTS RETURN;
PAGE
S_CTX EQU * GET TERMINATION CTX REQUIREMENTS
* CALL: RETURN:
* A0 ENVELOPE SAME
* A6 - MANAGER OBJECT (MAY BE THE DUMMY MANAGER)
* D4.L - CONTEXT REQUIREMENT, USER PART
* D5.W - CONTEXT REQUIREMENT, KERNEL PART
* FINDS THE MANAGER OBJECT. COMPUTES SPACE FOR TERM CONTEXT WITH DEFAULT
* PARAMS PLUS TEMP DATA.
TST EN_TERM(A0)
IF <GE> THEN.S IF ENV.TERM_PROC >= 0 "DUMMY" THEN
MOVE.L #DUM_MAN,A6 A6:=MAN_OBJ:=DUMMY MANAGER
ELSE.S ELSE
MOVE.L EN_MAN(A0),A6 A6:=ENV.MANAGER STRUCT;
MOVE EN_OFF(A0),D4 D4:=ENV.MANAGER REL;
BTST.B #PT_LSC,PT_INF(A6,D4)
IF <EQ> THEN.S IF NON LOCAL MAN_SET THEN
* "A6=CTX. MANAGER MAY BECOME CURRENT OBJ."
MOVE.L CT_OBJ(A6),A6 A6:=MAN_OBJ:=CTX.CURRENT OBJ;
IF A6 <EQ> #0 THEN.S IF CTX ABORTED THEN
MOVE.L #DUM_MAN,A6 A6:=MAN_OBJ:=DUMMY MANAGER
ENDI END
ELSE.S ELSE
MOVE.L EN_OBJ(A6),A6 A6:=MAN OBJ:=MANAGER STRUCT.HOLDER
ENDI END
ENDI END "MANAGER OBJECT FOUND".
MOVE.L GE_TEMD(A6),D4 D4:=CTX REQ USER PART:=
ADD.L #255,D4 ROUND (MAN_OBJ.TEMP DATA SIZE);
CLR.B D4
MOVE GE_TEMP(A6),D5 D5:=CTX REQ KERNEL PART:=
MULU #PT_SIZ,D5 MAN_OBJ.TEMP POINTERS * POINTER SIZE
ADD #CT_SIZ+2*FP_SIZ+SE_SIZ,D5 +CTX SIZE + 2 FORMALS + SEGM DESCR;
RTS RETURN
S_MAXLOC EQU * FIND MAX TERM REQUIREMENT OF LOCALS
* CALL: RETURN:
* A0 ENVELOPE SAME
* D0.W - TERM COUNT (NUMBER OF OCCURRENCES OF MAX)
* D4.L INITIAL TERM REQ, USER TERM REQ, USER
* D5.W INITIAL TERM REQ, KERNEL TERM REQ, KERNEL
* FINDS MAXIMUM OF THE INITIAL TERM REQ AND THE TERM REQUIREMENT OF
* ALL LOCALS. KEEPS TRACK OF OCCURRENCES OF MAXIMUM.
* (USED BY S_SHRINK AND DEL_ENV (THROUGH S_LOC)).
MOVEM.L A2/A3/A5/A6/D1/D2,-(A7) SAVE REGISTERS;
MOVE D5,-(A7) MAX TERM REQ:=INITIAL TERM REQ;
MOVE.L D4,-(A7) "SAVED IN SIZE FORMAT"
MOVEA.L A7,A6 A6:=ADDR OF MAX TERM REQ;
MOVE #1,D0 D0:=COUNT:=1;
MOVE #EN_SIZ,D1 D1:=CURRENT PREL:=L(1);
WHILE D1 <NE> EN_TOPL(A0) DO.S WHILE CURRENT PREL <> TOP LOCALS DO
IF.B PT_KIN(A0,D1) <EQ> #PT_OWN THEN.S
LEA (A0,D1),A3 IF CURRENT POINTER = OWN SET THEN
MOVE.L (A3),A5 A3:=PT ADDR; A5:=OBJ:=FIRST OBJ;
REPEAT FOR ALL OBJECTS IN OWN SET DO
BTST.B #OB_EMB,OB_STA(A5)
IF <EQ> THEN.S IF NOT EMBEDDED OBJECT THEN
MOVE.L OB_SPA(A5),A2 A2:=TOP OBJ;
LEA SP_ENV(A2),A2 A2:=HEAD ENV STACK;
IF.L A2 <NE> 4(A2) THEN.S IF ENVELOPE EXISTS THEN
MOVE.L 4(A2),A2 A2:=CUR ENV:=OBJ.TOP ENVELOPE;
MOVE.L EN_TERMU-EN_STK(A2),D4 D4/D5:=TERM REQ:=
ADD.L EN_FIXU(A0),D4 CUR ENV.TERM REQ + ENV.FIXED REQ;
MOVE EN_TERMK-EN_STK(A2),D5
ADD EN_FIXU(A0),D5
CLR D2 INCREMENT:=0;
IF.L D4 <GE> (A6) THEN.S IF TERM REQ >= MAX TERM REQ
IF D5 <GE> 4(A6) THEN.S "BOTH COMPONENTS" THEN
MOVE #1,D2 INCREMENT:=1
ENDI END;
ENDI
BSR S_MAX D4/D5:=MAX(TERM REQ,MAX TERM REQ);
IF <GT> THEN.S IF TERM REQ > MAX TERM REQ
MOVE D2,D0 "EITHER COMPONENT" THEN
MOVE.L D4,(A6) D0:=COUNT:=INCREMENT
MOVE D5,4(A6) MAX TERM REQ:=NEW MAX
ELSE.S ELSE
ADD D2,D0 D0:=COUNT:=COUNT + INCREMENT
ENDI END
ENDI END "ENVELOPE PRESENT";
ENDI END "NON-EMBEDDED OBJECT"
MOVE.L (A5),A5 A5:=OBJ:=NEXT (OBJ);
UNTIL.L A5 <EQ> A3 END "FOR ALL OBJECTS IN OWN SET";
ENDI END "OWNSET";
ADD #PT_SIZ,D1 D1:=CURRENT PREL:=NEXT;
ENDW END "FOR ALL LOCALS";
MOVE.L (A7)+,D4 D4/D5:=TERM REQ:=
MOVE (A7)+,D5 POP MAX TERM REQ;
MOVEM.L (A7)+,A2/A3/A5/A6/D1/D2 RESTORE REGISTERS;
RTS RETURN
END ! END KERNEL OPERATIONS
«eof»