|
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: 211328 (0x33980)
Types: TextFile
Names: »KNELOP.SA«
└─⟦0b578df25⟧ Bits:30009789/_.ft.Ibm2.50006602.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »KNELOP.SA«
└─⟦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.SA«
***********************************************************************
* Copyright 1984 by *
* NCR Corporation *
* Dayton, Ohio U.S.A. *
* All Rights Reserved *
***********************************************************************
* EOS Software produced by: *
* NCR Systems Engineering - Copenhagen *
* Copenhagen *
* DENMARK *
***********************************************************************
KNELOP IDNT 1,0
NOLIST
INCLUDE COMDEF.SA
LIST
* KERNEL OPERATIONS AND TRAP-ENTRIES. LIST OF CONTENTS:
*-----------------------------------------------------------------------
* TRAP ENTRIES:
* TR_TR7 TRAP7, NORMAL KERNEL ENTRIES
* TR_XXX INTERNAL EXCEPTIONS AND INITIALIZATION
* VARIOUS RETURNS THROUGH JUMPS
* CALL AND RETURN:
* OBJ_CALL * FROM NORMAL CONTEXT ( * INDICATES KERNEL OPERATION)
* OBJ_RES * FROM RESIDENT CONTEXT
* OBJ_RET * OBJ_RETURN, NORMAL CONTEXT
* OBJ_RRET * OBJ_RETURN, RES. CONTEXT
* SAVE_STK SAVE SUPERVISOR STACK
* RSTO_STK RESTORE SUPERVISOR STACK
* ENT_CTX ENTER CONTEXT
* PREP_RET PREPARE RETURN
* LOAD_MMU LOAD MMU REGISTERS
* CRE_CTX CREATE CONTEXT
* SET_FP SET FORMAL POINTERS
* SET_ACT SET ACTUAL REF
* RESETLMS RESET CHAIN IN ELEMENTS
* RET_FP RETURN FORMALS
* DEL_CTX DELETE CONTEXT
* OBJECT CREATION AND DELETION:
* DECL_GEN * DECLARE GENERAL
* CRE_ENV CREATE AND INIT ENVELOPE
* DECL_SEG * DECLARE SEGMENT (NON_EMBEDDED)
* DECL_SUB * DECLARE SUBSEGM (NON_EMBEDDED)
* NEW_SEG * NEW EMBEDDED SEGMENT
* NEW_SUB * NEW_EMBEDDED SUBSEGMENT
* CRE_SEG CREATE EMBEDDED SEGMENT
* CRE_SUB CREATE EMBEDDED SUBSEGMENT
* MAKE_REEN * MAKE GENERAL OBJECT REENTRANT
* SET_CALL_STK* SET CALL STACK FOR GENERAL OBJECT
* CLR_PT CLEAR POINTER (OF ANY KIND)
* DEL_EMB DELETE EMBEDDED OBJECTS (SEGMENTS ONLY)
* AB_SEGM ABORT SEGMENT
* DEL_ENV * DELETE ENVELOPE
* D_ENV_OK DELETE ENVELOPE (CHECKS OK)
* DEALLOC * DEALLOCATE OBJECT
* C_NXT_M CALL NEXT MANAGER AND DELETE OBJECT
* DUM_MAN DUMMY MANAGER OBJECT
* RSTO_STR RESTORE STRUCTURE HOLDING DELETING OBJECT
* POINTER MANIPULATION:
* COPY * COPY POINTER
* CLR_SMP CLEAR SIMPLE POINTER
* COPY_NIL COPY SIMPLE REF TO NIL POINTER
* MOVE_OWN * MOVE TO NEW OWNER SET
* MOVE_MAN * MOVE TO NEW MANAGER SET
* FIRSTINSET * GET FIRST MEMBER OF SET
* NXTINSET * GET NEXT MEMBER OF SET
* M_OWN_OK MOVE OWNER, CHECK PERFORMED
* INS_OWN INSERT IN OWNER SET
* M_MAN_OK MOVE MANAGER, CHECK PERFORMED
* INS_MAN INSERT IN MANAGER SET
* DUM_ACT DUMMYFY ACTUAL REFS
* DUM_ENV DUMMYFY ENV REFS AND REMOVE FROM MANSET
* DUM_OBJ DUMMYFY OBJ REFS AND REMOVE FROM OWN_SET
* EXECUTION CONTROL:
* MAP_SEGM * MAP SEGMENT, NORMAL OR RESIDENT CTX
* MAP_RESOK MAP RESIDENT OR NORMAL OK
* MAP_OK MAP SEGMENT INTO MMU DESCRIPTOR
* MAP_FIRST MAP SEGMENT INTO UNINITIALIZED MMU DESCR.
* PROCESS MANAGEMENT AND SYNC:
* DECL_PROC * DECLARE PROCESS
* STOP_PROC STOP PROCESS
* NEW_ST_CALL * NEW STACK CALL
* ABORT * ABORT GENERAL OBJECT
* SPEED_UP * SPEED UP GENERAL OBJECT
* ABORT_ONE ABORT ENVELOPE WITHOUT LOCAL TREE
* ABORT_ENV ABORT ENVELOPE AND LOCAL MANAGER TREE
* PROPAGATE PROPAGATE SPEED
* SET_MODE * SET PROPAGATION MODE
* TEST_SPEED * TEST SPEED-UP STATUS
* IDENTIFICATION CONTROL:
* DECL_ENV * DECLARE ENVELOPE
* INSP_OBJ * INSPECT OBJECT
* INSP_ACT * INSPECT HOLDER OF ACTUAL POINTER
* INSP_CALL * INSPECT CALLER
* INSP_PROC * INSPECT PROCESS
* INSP_INIT INSPECT INITIALIZATION
* INSP_COM COMMON INSPECT
* SET_CAPS * SET CALL CAPABILITY
* CHECK PROCEDURES:
* C_PT CHECK POINTER ARGUMENT, NORMAL CTX
* C_PTRES CHECK POINTER, NORMAL OR RESIDENT
* C_ENT CHECK ENTITY ARGUMENT, NORMAL CTX
* C_ENTRES CHECK ENTITY, NORMAL OR RESIDENT
* C_CALL CHECK CALLABLE OBJECT AND FUNCTION#
* C_SUB CHECK SUBSEGM ARGUMENT (NOT VOID)
* C_OPEN CHECK OWNER POINTER AND OPEN OBJECT
* C_PRIM CHECK AND GET PRIMARY ENVELOPE
* C_TOPOWN CHECK TOP STACK, OWNER OR SIMPLE POINTER
* C_PTS CHECK #POINTERS
* C_ADDR CHECK ADDRESS
* C_SIZ CHECK SIZE ARGUMENT
* STACK CHECK:
* S_MOVE STACK CHECK FOR MOVE OWNER
* S_TERM STACK CHECK BEFORE TERM PROC ENTRY
* S_GROW STACK CHECK FOR GROWTH
* S_UPDATE STACK REQUIREMENT UPDATE
* S_SHRINK SHRINK STACK REQUIREMENTS
* S_ENV INIT ALL ENVELOPE TERM REQUIREMENTS
* S_LOC CHECK FREE STACK FOR DELETE LOCALS
* S_MAX FIND MAX SIZE AND COMPARE
* S_INITENV INIT ENVELOPE TERM WITHOUT LOCALS
* S_CTX GET TERMINATION CTX REQUIREMENTS
* S_MAXLOC FIND MAX TERM REQUIREMENTS OF LOCALS
PAGE
SECTION 9 NORMAL CODE SECTION
XREF.S KV_CTX,SAVE_SR,SAVE_PC,RUNNING,KV_INVEC,DRIV_TAB,STAK_TAB
XREF I_ENTER,TERMGATE,TERMCOND,PROPSPED,START_PROC,NEXT_PROC
XREF GATE_OBJ,COND_OBJ,ALLOC_OB,SCHEDOBJ
XREF MM_PUSHU,MM_POPU,MM_PUSHK,MM_POPK
XREF MM_PUSHD,MM_POPD,MM_PUSHO,MM_POPO
XREF NIOBEGIN,NIO_END,NABSADDR,RIOBEGIN,RIO_END,RABSADDR
XREF IIOBEGIN,IIO_END,IABSADDR,INT_SIGN,TERMDRIV,FORCE_OPEN
XREF KNELWAIT,KNELSIGN,SAVE_STK,RSTO_STK,INCRDECR
XREF MM_LOCK,MM_QUEUE,MM_TERM,TEXTLINE,PRINTA02,CONVADDR,GET_TIME
XDEF I_KNELOP,STOP_PROC,CRE_CTX,SET_FP,INT_EXC,PREP_RET,LOAD_MMU
XDEF C_ENT,C_ENTRES,C_PT,C_SUB,CLR_SMP,RET_FAST,TR_SPEED
TR_TR7 EQU * TRAP7: NORMAL KERNEL ENTRIES.
* CALL: RETURN:
* A4-A6 -- SAME
* D2.W LENGTH ARG LIST UNDEF
* D4.L LOWEST ARG ADDR (LOGICAL)UNDEF
* D5.W KERNEL F UNCTION# UNDEF
* D6/D7 RESULT (OBJ_RETURN ONLY) RESULT
* OTHER REGS: -- UNDEF OR SPECIAL RETURN VALUES.
*** TEST OUTPUT
PRT_REG KNEL_ENTRY
PRT_MEM SUPV_STACK,(A7),20
MOVE (A7),D3 D3:=CALLERS SR;
MOVEM.L A4-A6,-(A7) SAVE A4-A6
MOVE #1<<13+7<<8,SR DISABLE;
ASL #1,D5 D5:=KERNEL FUNCTION *2;
AND #$2700,D3 D3:=CALLERS SUPV MODE + INTRPT MASK;
IF D3 <GT> #$2000 THEJ.S IF SUPV MODE AND INTRPT MASK > 0 THEN
MOVEQ.L #0,D6 D6:= ARG# := 0 ;
SUB #36*2,D5 "SUPERVISOR MODE:"
CMP #8,D5 IF FNC <36 OR >39
IF <HI> THEN.S THEN
MOVE.L #ECRADDR,D7 D7:= REJECT, ILL_ADDR;
BRA RET_FAST GOTO RETURN;
ENDI ENDI;
CASEJMP D5 CASE KERNEL FUNCTION OF
CASELAB IIOBEGIN 36:
CASELAB IIO_END 37:
CASELAB IABSADDR 38:
CASELAB INT_SIGN 39:
CASELAB ITSTDUMP 40: ONLY IN TEST VERSION OF KERNEL
ENDI END "SUPERVISOR MODE";
MOVE.L KV_CTX,A2 A2:= CURRENT CTX;
CMP #MAXFNC,D5
IF <HI> THEN.S IF FNC <0 OR >MAX THEN
MOVEQ.L #0,D6 D6:= ARG#:0;
BRA EE_ADDR GOTO REJECT ;
ENDI ENDI;
MOVE.W ARG_MIN(D5),D1 D1:= REQUIRED:= MIN(KNEL_FUNC);
IF <EQ> THEN.S IF REQUIRED=0 THEN
MOVE.L D4,A4 ARG_ADDR:= LOW_ARG; "SIMULATE EMPTY ARGS"
BRA PREP_OK GOTO OK; D6 IS LEFT UNCHANGED
ENDI ENDI;
MOVEQ.L #0,D6 D6:= ARG#:= 0;
CMP D1,D2 IF LENGTH ARG LIST < MIN(KERNEL FUNC)
BLT EE_ADDR THEN REJECT END;
AND.L #1<<24-2,D4 ROUND LOW ARG AND LENGTH TO WORD
AND.L #1<<16-2,D2 ADDR IN MAX ADDRESS RANGE;
ADD.L D4,D2 D2:=TOP ARG:=LOW ARG+LENGTH;
SUBQ.L #1,D2 D2:=LAST_OF_ARG:=TOP ARG -1;
ROR.L #8,D2 D2.W:=LAST_OF_ARG/256;
ROR.L #8,D4 D4.W:=LOW ARG/256;
LEA CT_MM0+MM_REG(A2),A1 A1:=ADDR OF CTX.MMU_DESCR_0;
MOVE #3,D1 D1:=COUNT:=3 MMU DESCRIPTORS;
REP_0 EQU * FOR ALL MMU DESCRIPTORS DO
CMP (A1)+,D4 IF LOW ARG >= MMU.FIRST "UNSIGNED"
IF <CC> THEN.S AND
CMP (A1)+,D2 LAST_OF_ARG <= MMU.LAST "UNSIGNED"
IF <LS> THEN.S AND
BTST.B #0,3(A1) MMU.ENABLED
IF <NE> THEN.S THEN
ADD (A1),D2 D2:=ARG ADDR:=LAST_OF_ARG + 1
ROL.L #8,D2 + DISPLACEMENT
ADDQ.L #1,D2
ADD (A1),D4 D4:=LOW ARG:=LOW ARG+DISPLACEMENT
ROL.L #8,D4
MOVE.L D2,A4 A4:=ARG ADDR;
BRA.S PREP_OK GOTO OK
ENDI END;
ENDI
ELSE.S ELSE "LOW_ARG < MMU.FIRST
ADDQ.L #2,A1 ADJUST A1 AS IF MMU.LAST HAS BEEN CHECKED
ENDI
ADD #MM_SIZ-4,A1 A1:=NEXT MMU DESCR;
DBF D1,REP_0 END "FOR ALL MMU DESCRIPTORS";
BRA EE_ADDR REJECT;
ARG_MIN EQU * MINIMAL LENGTH OF ARGUMENT LISTS:
DC.W AR_PTSIZ+4+AR_SIZ 0: OBJ_CALL
DC.W 0 1: OBJ_RET
DC.W 3*AR_PTSIZ+6*4+3*6+2 2: DECL_GEN
DC.W AR_PTSIZ+4 3: DECL_SEG
DC.W AR_PTSIZ+AR_SIZ 4: DECL_SUB
DC.W AR_PTSIZ+4 5: NEW_SEG
DC.W AR_PTSIZ+AR_SIZ 6: NEW_SUB
DC.W 2*AR_PTSIZ+AR_SIZ 7: DEALLOC
DC.W 2*AR_PTSIZ 8: DEL_ENV
DC.W AR_PTSIZ+6 9: SET_CALL_STK
DC.W AR_PTSIZ 10: MAKE_REENT
DC.W 0 11: NOT USED
DC.W 0 12: NOT USED
DC.W 2*AR_PTSIZ 13: COPY
DC.W 2*AR_PTSIZ 14: MOVE_OWN
DC.W 2*AR_PTSIZ 15: MOVE_MAN
DC.W 2*AR_PTSIZ 16: FIRSTINSET
DC.W 2*AR_PTSIZ 17: NXTINSET
DC.W 2*AR_PTSIZ 18: REFEQUAL
DC.W AR_PTSIZ+4+AR_SIZ 19: DECL_PROC
DC.W 2*AR_PTSIZ+4+AR_SIZ 20: NEW_ST_CALL
DC.W AR_PTSIZ 21: ABORT
DC.W AR_PTSIZ 22: SPEED_UP
DC.W 4 23: SET_MODE
DC.W 0 24: TEST_SPEED
DC.W 0 25: NOT USED
DC.W 3*AR_PTSIZ+2*4+2*6 26: DECL_ENV
DC.W 3*AR_PTSIZ 27: INSP_OBJ
DC.W 3*AR_PTSIZ 28: INSP_ACT
DC.W 2*AR_PTSIZ 29: INSP_CALL
DC.W 2*AR_PTSIZ 30: INSP_PROC
DC.W AR_PTSIZ+4 31: SET_CAPS
DC.W 0 32: NOT USED
DC.W AR_PTSIZ+2*4 33: MAP_SEGM
DC.W 0 34: GET_TIME
DC.W 4 35: SET_SLICE
DC.W AR_PTSIZ 36: IOBEGIN
DC.W AR_PTSIZ 37: IO_END
DC.W AR_PTSIZ 38: ABS_ADDR
DC.W 0 39: INT_SIGN (NOT USED)
DC.W 2 40: TESTDUMP, ONLY IN TEST VERSION OF KERNEL
PREP_OK EQU * OK:
PAGE
***
PRT_REG KNEL_SWITCH
AND #$700,D3 D3:=RESIDENT:=INTRPT MASK;
* IN NORMAL MODE A TIME OUT MAY BE PENDING. THEN CALLER'S
* SUPV_MODE = 1, INTRPT_MASK = 0.
IF <EQ> THEN.S IF CALLER IN NORMAL MODE THEN
CASEJMP D5 CASE KERNEL FUNCTION OF
CASELAB OBJ_CALL 0: CALL AND RETURN:
CASELAB OBJ_RET 1:
CASELAB DECL_GEN 2: OBJECT CREATE AND DELETE:
CASELAB DECL_SEG 3:
CASELAB DECL_SUB 4:
CASELAB NEW_SEG 5:
CASELAB NEW_SUB 6:
CASELAB DEALLOC 7:
CASELAB DEL_ENV 8:
CASELAB SET_CALL_STK 9:
CASELAB MAKE_REENTR 10:
CASELAB ER_ADDR1 11: NOT USED
CASELAB ER_ADDR1 12: NOT USED
CASELAB COPY 13: POINTER MANIPULATION:
CASELAB MOVE_OWN 14:
CASELAB MOVE_MAN 15:
CASELAB FIRSTINSET 16:
CASELAB NXTINSET 17:
CASELAB REFEQUAL 18:
CASELAB DECL_PROC 19: PROCESS MANAGEMENT:
CASELAB NEW_ST_CALL 20:
CASELAB ABORT 21:
CASELAB SPEED_UP 22:
CASELAB SET_MODE 23:
CASELAB TEST_SPEED 24:
CASELAB ER_ADDR1 25: NOT USED
CASELAB DECL_ENV 26: IDENTIFICATION CONTROL:
CASELAB INSP_OBJ 27:
CASELAB INSP_ACT 28:
CASELAB INSP_CALL 29:
CASELAB INSP_PROC 30:
CASELAB SET_CAPS 31:
CASELAB ER_ADDR1 32: NOT USED
CASELAB MAP_SEGM 33: EXECUTION CONTROL:
CASELAB GET_TIME 34: GET_TIME
CASELAB ER_ADDR1 35: SET_SLICE
CASELAB NIOBEGIN 36:
CASELAB NIO_END 37:
CASELAB NABSADDR 38:
CASELAB ER_ADDR1 39: INTERRUPT SIGNAL
CASELAB TESTDUMP 40: ONLY IN TEST VERSION OF KNEL
MAXFNC EQU 40*2
ENDI END "NORMAL MODE"
PAGE
* "CALLER IN RESIDENT MODE"
CASEJMP D5 CASE KERNEL FUNCTION OF
CASELAB OBJ_RES 0: CALL AND RETURN:
CASELAB OBJ_RRET 1:
CASELAB ER_ADDR1 2: OBJECT CREATE AND DELETE:
CASELAB ER_ADDR1 3:
CASELAB ER_ADDR1 4:
CASELAB ER_ADDR1 5:
CASELAB ER_ADDR1 6:
CASELAB ER_ADDR1 7:
CASELAB ER_ADDR1 8:
CASELAB ER_ADDR1 9:
CASELAB ER_ADDR1 10:
CASELAB ER_ADDR1 11:
CASELAB ER_ADDR1 12:
CASELAB ER_ADDR1 13: POINTER MANIPULATION:
CASELAB ER_ADDR1 14:
CASELAB ER_ADDR1 15:
CASELAB ER_ADDR1 16:
CASELAB ER_ADDR1 17:
CASELAB ER_ADDR1 18:
CASELAB ER_ADDR1 19: PROCESS MANAGEMENT:
CASELAB ER_ADDR1 20:
CASELAB ER_ADDR1 21:
CASELAB ER_ADDR1 22:
CASELAB SET_MODE 23: PROPAGATE MODE (TO DEVICE CONDITION)
CASELAB ER_ADDR1 24:
CASELAB ER_ADDR1 25:
CASELAB ER_ADDR1 26: IDENTIFICATION CONTROL:
CASELAB ER_ADDR1 27:
CASELAB ER_ADDR1 28:
CASELAB ER_ADDR1 29:
CASELAB ER_ADDR1 30:
CASELAB ER_ADDR1 31:
CASELAB ER_ADDR1 32:
CASELAB MAP_SEGM 33: EXECUTION CONTROL:
CASELAB GET_TIME 34: GET_TIME
CASELAB ER_ADDR1 35:
CASELAB RIOBEGIN 36:
CASELAB RIO_END 37:
CASELAB RABSADDR 38:
CASELAB ER_ADDR1 39:
CASELAB TESTDUMP 40:
PAGE
* INTERNAL EXCEPTIONS:
TR_BUS MOVE.L #2,-(A7) BUS ERROR: 8 BYTES INF SAVED BY HARDWARE
BRA.L INT_EXC GOTO COMMON ADDR EXC;
TR_ADDR MOVE.L #3,-(A7) ADDRESS ERROR: 8 BYTES INF SAVED BY H/W
BRA.L INT_EXC
TR_ILLE SUBQ.L #8,A7 PUSH DUMMY INF
MOVE.L #4,-(A7) ILLEGAL INSTRUCTION:
BRA.L INT_EXC
TR_ZDIV SUBQ.L #8,A7 PUSH DUMMY INF
MOVE.L #5,-(A7) ZERO DIVIDE:
BRA.L INT_EXC
TR_CHK SUBQ.L #8,A7 PUSH DUMMY INF
MOVE.L #6,-(A7) CHK INSTRUCTION:
BRA.L INT_EXC
TR_TRAPV SUBQ.L #8,A7 PUSH DUMMY INF
MOVE.L #7,-(A7) TRAPV INSTRUCTION:
BRA.L INT_EXC
TR_PRIV SUBQ.L #8,A7 PUSH DUMMY INF
MOVE.L #8,-(A7) PRIVILEGED INSTRUCTION:
BRA.L INT_EXC
TR_TRACE SUBQ.L #8,A7 PUSH DUMMY INF
MOVE.L #9,-(A7) TRACE
BRA.L INT_EXC
TR_1010 SUBQ.L #8,A7 PUSH DUMMY INF
MOVE.L #10,-(A7) 1010 EMULATOR
BRA.L INT_EXC
TR_1111 SUBQ.L #8,A7 PUSH DUMMY INF
MOVE.L #11,-(A7) 1111 EMULATOR
BRA.L INT_EXC
TR_TR0 SUBQ.L #8,A7 PUSH DUMMY INF
MOVE.L #32,-(A7) TRAP0
BRA.L INT_EXC
TR_TR1 SUBQ.L #8,A7 PUSH DUMMY INF
MOVE.L #33,-(A7) TRAP1
BRA.S INT_EXC
TR_TR2 SUBQ.L #8,A7 PUSH DUMMY INF
MOVE.L #34,-(A7) TRAP2
BRA.S INT_EXC
TR_TR3 SUBQ.L #8,A7 PUSH DUMMY INF
MOVE.L #35,-(A7) TRAP3
BRA.S INT_EXC
TR_TR4 SUBQ.L #8,A7 PUSH DUMMY INF
MOVE.L #36,-(A7) TRAP4
BRA.S INT_EXC
TR_TR5 SUBQ.L #8,A7 PUSH DUMMY INF
MOVE.L #37,-(A7) TRAP5
BRA.S INT_EXC
TR_TR6 SUBQ.L #8,A7 PUSH DUMMY INF
MOVE.L #38,-(A7) TRAP6
BRA.S INT_EXC
TR_TR9 SUBQ.L #8,A7 PUSH DUMMY INF
MOVE.L #41,-(A7) TRAP 9 (TRAP 7 AND 8: KERNEL ENTRY)
BRA.S INT_EXC
TR_TR10 SUBQ.L #8,A7 PUSH DUMMY INF
MOVE.L #42,-(A7) TRAP10
BRA.S INT_EXC
TR_TR11 SUBQ.L #8,A7 PUSH DUMMY INF
MOVE.L #43,-(A7) TRAP11
BRA.S INT_EXC
TR_TR12 SUBQ.L #8,A7 PUSH DUMMY INF
MOVE.L #44,-(A7) TRAP12
BRA.S INT_EXC
TR_TR13 SUBQ.L #8,A7 PUSH DUMMY INF
MOVE.L #45,-(A7) TRAP13
BRA.S INT_EXC
TR_TR14 SUBQ.L #8,A7 PUSH DUMMY INF
MOVE.L #46,-(A7) TRAP14
BRA.S INT_EXC
TR_TR15 SUBQ.L #8,A7 PUSH DUMMY INF
MOVE.L #47,-(A7) TRAP15
BRA.S INT_EXC
TR_SPEED SUBQ.L #8,A7 DUMMY INF
CLR.L -(A7) CAUSE:=0;
* BRA.S INT_EXC
INT_EXC EQU *
* CALL: THE STACK MUST CONTAIN: 12 BYTES INF, SR, PC
* INF IS LOADED INTO D3/D5/D6/D7 AS SHOWN BELOW
*
* AT RETURN TO ENTRY POINT OF THE USER CODE SEGMENT:
* D0 = 0 (EXCEPTION ENTRY),
* D1 = A7 <==> NO REGISTERS SAVED ON STACK
* D1 = A7-70 <==> REGISTERS SAVED ON STACK BETWEEN D1 AND A7
* D2 = SR , D3 = INF (CAUSE) , D4 = PC , D5 = INF (R/W,FUNCTION)
* D6 = INF (ACCESS ADDRESS) , D7 = INF (INSTRUCTION REGISTER)
* A0-A3 UNDEF, A4-A7 UNCHANGED
* MAPS THE CODE SEGMENT IN LOCAL(1) AND REENTERS THE CURRENT OBJECT.
* THE ORIGINAL USER REGISTERS ARE SAVED ON STACK
* OTHER SEGMENT MAPPING IS UNCHANGED - THUS THE USER MAY NOT
* HAVE A STACK SEGMENT AVAILABLE.
* RETURNS TO THE PREVIOUS CONTEXT IN ERROR CASES: LOCAL(1) IS
* NOT CODE SEGMENT, CONTEXT RESIDENT BUT CODE SEGMENT NOT.
* HALTS THE CPU WHEN SUPERVISOR MODE CAUSES EXCEPTION.
***
PRT_REG EXCEPTION
PRT_MEM SUPV_STACK,(A7),64
MOVE #$2700,SR DISABLE;
MOVEM.L D0-D7/A0-A3,-(A7) SAVE ORIGINAL REGISTERS
MOVE.L 48(A7),D3 D3.L:= CAUSE
MOVE.W 52(A7),D5 D5.W:= R/W, FUNCTION
MOVE.L 54(A7),D6 D6.L:= ACCESS ADDRESS
MOVE.W 58(A7),D7 D7.W:= INSTRUCTION REGISTER
MOVEM.L A4-A6,48(A7) INF:= ORIGINAL A4-A6
MOVE.W 60(A7),D4 D4:=CALLERS STATUS REGISTER
MOVEM.L D1/D3/D5/D6/D7,-(A7) SAVE ENTRY REGS, D1 IS ASSIGNED LATER
AND #$2700,D4 D4:=CALLERS SUPV MODE+INTRPT MASK;
CMP #$2000,D4 IF SUPV MODE AND INTRPT MASK >0
BGT HALT THEN HALT END;
AND #$700,D4 D4:=RESIDENT:=INTRPT MASK;
MOVE.L KV_CTX,A3 A3:=CURRENT CTX;
MOVE.L CT_OBJ(A3),A6 A6:=CTX.CURRENT OBJ; "NOT ABORTED"
MOVE.L OB_SPA(A6),A5
MOVE.L SP_ENV+4(A5),A5 A5:=TOP ENVELOPE;
MOVE.B PT_KIN+EN_SIZ-EN_STK(A5),D0 D0:=L(1).POINTER_KIND;
TST.W D4
IF <NE> THEN.S IF EXCEPTION FROM RESIDENT CTX THEN
BTST.B #PT_RES,PT_INF+EN_SIZ-EN_STK(A5)
BEQ.L EXC_UNDEF IF L(1) NOT RESIDENT THEN RETURN TO PREV
* THE SEGMENT ADDRESSED BY 'USP' BELOW WILL BE RESIDENT BECAUSE IT IS MAPPED
ENDI ENDI;
IF.B D0 <EQ> #PT_OBJ THEN.S IF OBJ_REF THEN
MOVE.L PT_REF+EN_SIZ-EN_STK(A5),A5 A5:=CODE OBJ:=OBJ REFERENCED
ELSE.S ELSE
CMP.B #PT_OWN,D0 IF NOT OWN SET
BNE.L EXC_UNDEF THEN RETURN TO PREV CTX END;
MOVE.L 4+EN_SIZ-EN_STK(A5),A5 A5:=CODE OBJ:=LAST IN SET
ENDI END;
CMP.B #OB_SEOB,OB_KIN(A5) IF CODE OBJ.KIND<>SEGMENT THEN
BNE.L EXC_UNDEF THEN GOTO ERROR
* PROBLEM:: SEGMENT MAY STILL BE A SUBSEGMENT WITH NO BASE SEGMENT !!!!!
CLR.L D0 D0:=LOGICAL ADDRESS:=0;
LEA CT_MM1(A3),A1 A1:=MMU DESCR 1;
TST D4
IF <NE> THEN.S IF CALLER RESIDENT THEN
TST OB_RES(A5) IF CODE_OBJ NOT RESIDENT
BEQ.L EXC_UNDEF THEN RETURN TO PREV CTX END;
ENDI END;
MOVE D4,D3 D3:=RESIDENT OR NORMAL;
BSR MAP_RESOK MAP RES OR NORMAL (MMU,SEGM,
* LOG ADDR,D1/D2:=UNDEF);
* A6 = OBJECT TO CALL DUMP REGISTERS ABOVE USP
MOVE.L USP,A4 A4:= USER STACK POINTER
MOVE.L A4,D3 D3:= USER STACK POINTER
BSR.L CONVADDR D3:= ABS_ADDR(USP); D5:= MMU
BEQ.S NOREGSAVE WHEN ERROR GOTO NOREGSAVE
MOVE.W D5,D4 D4:= MMU OF USP
LEA -70(A4),A0 A0:= DUMP ADDRESS; "FUTURE D1"
MOVE.L A0,D3 D3:= DUMP ADDRESS;
BSR.L CONVADDR D3:= ABS_ADDR(D3); D5:= MMU
BEQ.S NOREGSAVE WHEN ERROR GOTO NOREGSAVE
CMP.W D4,D5 WHEN MMU OF USP <> MMU OF DUMP ADDRESS
BNE.S NOREGSAVE THEN GOTO NOREGSAVE
* ROOM FOR DUMP IS AVAILABLE BETWEEN DUMP ADDRESS AND USP
MOVE.L A0,(A7) SAVED FUTURE D1:= USP-70;
MOVE.L D3,A5 A5:= DUMP ADDRESS
MOVEM.L 20(A7),D0-D7/A0-A3 MOVE REGISTERS TO DUMP ADDRESS
MOVEM.L D0-D7/A0-A3,(A5) D0-D7/A0-A3
MOVEM.L 68(A7),D4-D6
MOVEM.L D4-D6,48(A5) A4-A6
MOVE.L A4,60(A5) USP
MOVEQ.L #1,D3 REGSSAVED:= TRUE;
BRA.S CONTSAVE GOTO CONTINUE SAVE
NOREGSAVE EQU * NOREGSAVE:
MOVEQ.L #0,D3 REGSSAVED:= FALSE;
MOVE.L A4,(A7) SAVED FUTURE D1:= USP
CONTSAVE EQU * CONTINUE SAVE:
* A6=OBJ, D3 = REGSSAVED, A5 = DUMP ADDRESS / UNDEFINED
MOVE.W 80(A7),D2 D2:= SR FROM STACK
MOVE.L GE_ENT(A6),D0 D0:= ENTRY POINT OF OBJECT
BTST.L #5+8,D2
IF <EQ> THEN.S IF NO TIME OUT PENDING THEN
MOVE.L 82(A7),D4 D4:= ORIGINAL PC:= STACKED PC;
MOVE.L D0,82(A7) STACKED PC:= ENTRY POINT ADDRESS;
ELSE.S ELSE
MOVE.W SAVE_PC,D2 D2:= ORIGINAL SR:= SAVED SR;
MOVE.L SAVE_PC,D4 D4:= ORIGINAL PC:= SAVED PC;
MOVE.L D0,SAVE_PC SAVED_PC:= ENTRY POINT ADDRESS OF OBJ;
ENDI ENDI;
TST.B D3
IF <NE> THEN.S IF REGSSAVED THEN "SAVE SR AND PC"
MOVE.W D2,64(A5) DUMP.SR:= ORIGINAL SR;
MOVE.L D4,66(A5) DUMP.PC:= ORIGINAL PC;
ENDI ENDI;
MOVEQ.L #0,D0 D0:=ENTRY FUNC:= EXCEPTION ENTRY;
MOVEM.L (A7)+,D1/D3/D5/D6/D7 LOAD ENTRY REGISTERS
LEA 48(A7),A7 POP SAVED ORIGINAL REGS EXCEPT A4-A6
MOVE.L KV_CTX,A3 A3:= CURRENT CONTEXT;
BCLR.B #7,CT_SPE(A3) CLEAR SPEEDUP EXCEPTION (IF PENDING)
AND.B #3,CT_MODE(A3) CLEAR EXCEPTION MODE OF CONTEXT
*** PRT_MEM REENTER_CTX,(A3),CT_SIZ
BRA.L RET_OLD3 GOTO RETURN;"A4-A6,SR,PC ON STACK"
EXC_UNDEF EQU * RETURN TO PREV CTX:
ADD.W #68,A7 POP REGISTERS; A7.L:=A7.L + 68;
CLR.L D6 D6/D7:=RESULT:=STATUS,DUMMYFIED;
MOVE.L #ECSDUMMY,D7
MOVE.L A3,A2 A2:=CURRENT CTX;
TST D4 IF CALLER NORMAL MODE THEN
BEQ OBJ_RET OBJ_RETURN
BRA OBJ_RRET ELSE RESIDENT_RETURN END;
PAGE
SECTION 11 INITIALIZATION SECTION
I_KNELOP EQU *
LEA KV_INVEC,A0 A0:=BASE EXCEPTION VECTORS (ZERO NORMALLY)
MOVE.L #TR_ADDR,12(A0) INITIALIZE INTERNAL EXCEPTION VECTORS
MOVE.L #TR_BUS,8(A0)
MOVE.L #TR_ILLE,16(A0)
MOVE.L #TR_ZDIV,20(A0)
MOVE.L #TR_CHK,24(A0)
MOVE.L #TR_TRAPV,28(A0)
MOVE.L #TR_PRIV,32(A0)
MOVE.L #TR_TRACE,36(A0)
MOVE.L #TR_1010,40(A0)
MOVE.L #TR_1111,44(A0)
MOVE.L #TR_TR0,128(A0)
MOVE.L #TR_TR1,132(A0)
MOVE.L #TR_TR2,136(A0)
MOVE.L #TR_TR3,140(A0)
MOVE.L #TR_TR4,144(A0)
MOVE.L #TR_TR5,148(A0)
MOVE.L #TR_TR6,152(A0)
MOVE.L #TR_TR7,156(A0)
MOVE.L #-1,DRIV_TAB+156 RESERVE TRAP #7
MOVE.L #-1,STAK_TAB+156
MOVE.L #TR_TR10,168(A0)
MOVE.L #TR_TR11,172(A0)
MOVE.L #TR_TR12,176(A0)
MOVE.L #TR_TR13,180(A0)
MOVE.L #TR_TR14,184(A0)
MOVE.L #TR_TR15,188(A0)
BRA I_ENTER CONTINUE INITIALIZATION
SECTION 9 NORMAL CODE SECTION
PAGE
* RETURNS CAN TAKE PLACE THROUGH JUMPS TO THESE LABELS:
* RETURN: RTS (IN C_ENT).
* RET_OLD2: RETURN TO USER, A2=CUR_CTX, ABORT CHECKED AND MMU LOADED
* RET_OLD3: RETURN TO USER, A3=CUR_CTX, ABORT CHECKED AND MMU LOADED
* RET_FAST: RETURN TO USER, NO CHECK. (IN OBJ_CALL LIKE RET_OLD2, RET_OLD3)
* HALT: STOP, KERNEL ERROR. (IN C_NXT_M)
* ER_XXX: ERROR RETURN, SR:=EQ "NOT OK", RTS. (SEE BELOW)
* EE_XXX: ERROR EXIT, A2=CUR_CTX, RETURN TO USER. (SEE BELOW)
ER_ADDR MOVE.L #ECRADDR,D7 ADDRESS ILLEGAL: D7:=RESULT
CMP D7,D7 SR:=EQ; "NOT OK"
RTS RETURN
ER_ADDR1 EQU *
EE_ADDR MOVE.L #ECRADDR,D7
BRA RET_OLD2
ER_FUNC MOVE.L #ECRFUNC,D7 FUNCTION ILLEGAL:
CMP D7,D7
RTS
ER_SCOPE MOVE.L #ECRSCOPE,D7 POINTER SCOPE ILLEGAL:
CMP D7,D7
RTS
EE_SCOPE MOVE.L #ECRSCOPE,D7
BRA RET_OLD2
ER_VALUE MOVE.L #ECRVALUE,D7 POINTER VALUE ILLEGAL:
CMP D7,D7
RTS
EE_VALUE MOVE.L #ECRVALUE,D7
BRA RET_OLD2
* ER_RETURN RETURN POINTER ILLEGAL:
* SPECIAL CONVENTIONS, SEE RET_FP
ER_STATE MOVE.L #ECRSTATE,D7 OBJECT STATE ILLEGAL:
CMP D7,D7
RTS
EE_STATE MOVE.L #ECRSTATE,D7
BRA RET_OLD2
ER_DATA MOVE.L #ECRDATA,D7 DATA VALUE ILLEGAL:
CMP D7,D7
RTS
EE_DATA MOVE.L #ECRDATA,D7
BRA RET_OLD2
ER_CAP MOVE.L #ECRCAP,D7 CAPABILITY VIOLATION:
CMP D7,D7
RTS
ER_CONC MOVE.L #ECRCONC,D7 CONCURRENCY VIOLATION:
CMP D7,D7
RTS
ER_SELF MOVE.L #ECRSELF,D7 SELF DELETION:
CMP D7,D7
RTS
ER_OBJSP MOVE.L #ECROBJSP,D7 OBJECT SPACE LIMITED:
CMP D7,D7
RTS
EE_OBJSP MOVE.L #ECROBJSP,D7
BRA RET_OLD2
ER_PROSP MOVE.L #ECRPROSP,D7 PROCESS SPACE LIMITED:
CMP D7,D7
RTS
EE_PROSP MOVE.L #ECRPROSP,D7
BRA RET_OLD2
ER_ENVLIM MOVE.L #ECRENVLIM,D7 OWNER ENVELOPE LIMITED:
CMP D7,D7
RTS
ER_CONLIM MOVE.L #ECRCONLIM,D7 OWNER CONTEXT LIMITED:
CMP D7,D7
RTS
ITSTDUMP EQU * TESTDUMP CALLED FROM INTERRUP PROCEDURE, SET UP A4
MOVE.L D4,A4 A4:= TOP_ARG := LOW_ARG
ADDA.L D2,A4 + LENGTH;
TESTDUMP EQU * D5=OP=FUNC<<16+11, D4/A4 DEFINES AREA TO BE PRINTED
*
SWAP D5 D5.W:= FUNC
LSL.W #1,D5
CMP.W #2*2,D5
IF <HI> THEN.S
DUMP_ERR EQU *
MOVE.L #ECRADDR,D7
BRA.L RET_FAST
ENDI
CASEJMP D5
CASELAB DUMP_ERR
CASELAB TEXT_OUT
CASELAB HEX_OUT
TEXT_OUT EQU * FUNC=1,PRINT AS TEXT, AT RETURN: D0=0 <=> PANEL SWITCH ENABLED
MOVE.L D4,A3 A3:= FIRST OF TEXT
LEA 96(A3),A1
IF.L A4 <GT> A1 THEN.S IF MORE THEN ONE LINE THEN
MOVE.L A1,A4 CUT TO ONE LINE
ENDI ENDI;
BSR.L TEXTLINE TEXTLINE(A3,A4) D0:=ON/OFF
CLR.L D7 RESULT:= OK;
BRA.L RET_FAST RETURN
HEX_OUT EQU * FUNC=2,PRINT AS HEX DIGITS
MOVE.L D4,A0
MOVE.L A4,A2
BSR.L PRINTA02 PRINTA02(A0,A2)
CLR.L D7 RESULT:=OK
BRA.L RET_FAST RETURN
TTL CALL AND RETURN
PAGE
OBJ_CALL EQU * OBJ_CALL FROM NORMAL CONTEXT
* CALL: ENTER NEW CTX: RETURN OLD CTX:
* A0/A1 - UNDEF UNDEF
* A2 CUR_CTX UNDEF UNDEF
* A3 - UNDEF UNDEF
* A4 ARGUMENT ADDR (PHYS) UNDEF SAVED VALUE
* A5 - FIRST TEMP SAVED VALUE
* A6 - TOP VALUE SAVED VALUE
* D0 - FUNCTION CODE UNDEF
* D1-2 - UNDEF UNDEF
* D3.W 0 (NOT RESIDENT) #FORMALS UNDEF
* D4 LOW ARG ADDR (PHYS) UNDEF UNDEF
* D5 - UNDEF UNDEF
* D6-7 ARGUMENT#,UNDEF UNDEF RESULT
* STACK: SAVED A4-A6,SR,PC (USER STACK) (USER STACK)
MOVE.L CT_HOLD(A2),A0 A0:=CUR_CTX.EXTENSION_OBJ;
BSR C_CALL CHECK_CALL(A0,...,A5:=OBJ,D5:=FUNCTION);
* "WILL COMPLETE KERNEL OBJECT CALLS"
BEQ RET_OLD2 IF RETURN THEN RETURN (A2=CTX) END;
CLR D3 D3:=ADDITIONAL FORMALS:=0;
BSR CRE_CTX CREATE_CTX(...,A3:=NEW_CTX,D4:=ENTRY,
* A1/A5/A6/D0-D2:=UNDEF);
BEQ.S RET_FAST IF NOT OK THEN RETURN "NO ABORT" END;
MOVE USP,A1 "SAVE SUPV.STACK ETC. IN OLD_CTX:"
MOVE.L A1,CT_USP(A2) SAVE USER STACK POINTER;
MOVEM.L -2(A7),D0-D3/D7 D0-D3.LEFT:=SAVED A4-A6;
BTST.L #5+8,D3 D3.RIGHT:=SR; D7:=PC;
IF <NE> THEN.S IF TIME OUT PENDING "SUPV MODE" THEN
MOVE.W SAVE_SR,D3 D3.RIGHT:=SAVED SR;
MOVE.L SAVE_PC,D7 D7:=SAVED PC;
MOVE.L D4,SAVE_PC SAVED PC:=ENTRY
ELSE.S ELSE
MOVE.L D4,14(A7) SUPV_STACK.PC:=ENTRY;
ENDI END;
MOVEM.L D0-D3/D7,CT_WRK-20(A2) CTX.SAVE:=SAVED A4-A6,SR,PC;
MOVE.L D5,(A7) SUPV_STACK.FUNCTION:=FUNCTION;
CLR D3 D3:=ADDITIONAL FORMALS:=0;
BSR SET_FP SET_FORMALS(...,D3:=#FORMALS,USP:=...,
* A1/A5/A6/D0-D2/D4/D5:=UNDEF);
IF <NE> THEN.S IF OK THEN
BSR ENT_CTX ENTER CONTEXT(A3=CTX,D3=#FORMALS)
* "CONTINUES HERE AT OBJ_RETURN. A3=CTX"
BSR RET_FP RETURN FORMALS(A3=CTX,D6/D7:=UPDATED);
ENDI END;
BSR DEL_CTX DELETE_CTX(CTX,A3:=OLD CTX,A0:=EXT);
MOVEM.L CT_WRK-20(A3),D0-D4 "RESTORE SUPV_STACK AND USP FROM OLD CTX:"
BTST.B #5,12(A7) D0-D4:=CTX.SAVE A4-A6,SR,PC;
IF <NE> THEN.S IF TIME OUT PENDING "SUPV MODE" THEN
MOVE.W D3,SAVE_SR SAVED SR:=CTX.SR;
MOVE.L D4,SAVE_PC SAVED PC:=CTX.PC;
MOVE.W 12(A7),D3 D3.RIGHT:=SUPV_STACK.SR;
MOVEM.L D0-D3,-2(A7) SUPV STACK.A4-A6:=CTX.A4-A6;
ELSE.S ELSE
MOVEM.L D0-D4,-2(A7) SUPV STACK.A4-A6,SR,PC:=CTX. ...
ENDI END;
MOVE.L CT_USP(A3),A5 RESTORE USP;
MOVE A5,USP
RET_OLD3 EQU * RETURN_TO_OLD_CTX: "A3=CTX"
BSR PREP_RET PREPARE_RETURN; "MAY PERFORM OBJ_RETURN"
IF <LT> THEN.S IF SPEEDUP EXCEPTION THEN
MOVEM.L (A7)+,A4-A6 RESTORE REGS
BRA.L TR_SPEED GOTO SPEEDUP EXCEPTION
ENDI ENDI;
RET_FAST EQU * RETURN_FAST:
MOVEM.L (A7)+,A4-A6 RESTORE A4-A6;
***
PRT_REG KNEL_EXIT
RTE RETURN TO USER MODE;
PAGE
OBJ_RES EQU * OBJ_CALL FROM RESIDENT CONTEXT
* CALL AND RETURN AS FOR OBJ_CALL. HOWEVER, D3<> 0 "RESIDENT".
MOVE.L CT_HOLD(A2),A0 A0:=CUR_CTX.EXTENSION_OBJ;
BSR C_CALL CHECK_CALL(A0,...);
* "WILL COMPLETE KERNEL OBJECT CALLS"
BNE EE_STATE IF ENTER THEN REJECT END;
RET_OLD2 EQU * RETURN_TO_OLD_CTX: "A2=CTX"
MOVE.L A2,A3 A3:=CTX;
BRA RET_OLD3 RETURN (A3=CTX);
OBJ_RRET EQU * OBJ_RETURN, RESIDENT CONTEXT
* CALL AND RETURN: AS OBJ_RET
BSR FORCE_OPEN FORCE DEVICE GATE OPEN (A2=CTX);
* CONTINUE WITH OBJ_RET. OBJECT MAY BE ABORTED DURING FORCE_OPEN.
OBJ_RET EQU * OBJ_RETURN, NORMAL CONTEXT
* CALL: CONTINUE IN KERNEL:
* A2 CUR_CTX SAME
* A3 - CUR_CTX
* D6/D7 RESULT SAME
* STACK: SAVED A4-A6,SR,PC SAME
MOVE.L CT_CON(A2),-(A7)
MOVE.L A2,A3 A3:=CUR_CTX;
RTS RETURN TO CUR_CTX.CONTINUE_ADDR;
ENT_CTX EQU * ENTER CONTEXT
* CALL: ENTRY TO NEW CTX:
* A3 NEW CTX UNDEF
* D2-D5 ENTRY VALUES TO USER CTX SAME (IMPLICIT,#FORMALS,INDEX/CAP,BYTES)
* A5/A6/D0 - FTMP,TOPVAL,FNC
* STACK: RETURN,FNC,FTMP,TOPVAL,SR,PC (USER STACK)
* SAVES RETURN POINT IN CONTEXT. USES PREP_RET TO TEST FOR ABORTED AND
* LOAD MMU. ENTERS USER CONTEXT IF NOT ABORTED.
MOVE.L (A7)+,CT_CON(A3) CTX.CONTINUE_ADDR:=POP RETURN;
BSR.S PREP_RET PREPARE RETURN; "MAY PERFORM OBJ_RETURN"
MOVEM.L (A7)+,D0/A5/A6 D0/A5/A6:=POP;
* BLT.L TR_SPEED !!!CANNOT OCCUR, BECAUSE EXC_MODE OF A NEW CTX IS ZERO!!!
***
PRT_REG ENT_CTX
RTE RETURN TO USER MODE;
PAGE
PREP_RET EQU * PREPARE RETURN
* CALL: RETURN:
* A3 CTX SAME
* A4 - UNDEF
* CCR - LT <==> SPEEDUP EXCEPTION IS PENDING
* STACK: RETURN,SAVED A4-A6,SR,PC IF ABORTED: TO OBJ_RET
* ELSE: NORMAL RETURN
* IF CONTEXT IS ABORTED, CONTINUES WITH OBJ_RET.
* ELSE SETS CURRENT CONTEXT (KV_CTX) AND LOADS MMU.
* THE CALLER OF PREP_RET MUST CHECK THE CCR AT RETURN -
* IF CCR=<LT>, THE CALLER MUST RESTORE REGS AND GOTO TR_SPEED
TST.L CT_OBJ(A3)
IF <EQ> THEN.S IF CTX.CUR_OBJ=ABORTED THEN
MOVE.L A3,A2 A2:=CUR_CTX;
MOVE.L #ECSDUMMY,D7
CLR.L D6 D6/D7:=RESULT:=STATUS,DUMMYFIED;
TST.L (A7)+ POP RETURN;
TST CT_RES(A3) IF CTX NORMAL MODE THEN
BEQ OBJ_RET GOTO OBJ_RETURN, NORMAL
BRA OBJ_RRET END; GOTO OBJ_RETURN, RESIDENT;
ENDI END;
MOVE.L A3,KV_CTX CURRENT_CONTEXT:=CTX;
* CONTINUE IN LOAD_MMU
LOAD_MMU EQU * LOAD MMU REGISTERS
* CALL: RETURN:
* A3 CTX SAME
* A4 - UNDEF
* CCR - <LT> <==> SEE PREP_RET ABOVE
LEA KV_MMU,A4 A4:=MMU REG ADDR;
MOVE.L CT_MM0+MM_REG(A3),(A4)+ COPY FROM CTX.MMU TO MMU REG;
MOVE.L CT_MM0+MM_REG+4(A3),(A4)+
MOVE.L CT_MM1+MM_REG(A3),(A4)+
MOVE.L CT_MM1+MM_REG+4(A3),(A4)+
MOVE.L CT_MM2+MM_REG(A3),(A4)+
MOVE.L CT_MM2+MM_REG+4(A3),(A4)+
MOVE.L CT_MM3+MM_REG(A3),(A4)+
MOVE.L CT_MM3+MM_REG+4(A3),(A4)+
***
PRT_MEM MMU0,CT_MM0(A3),MM_SIZ
PRT_MEM MMU1,CT_MM1(A3),MM_SIZ
PRT_MEM MMU2,CT_MM2(A3),MM_SIZ
PRT_MEM MMU3,CT_MM3(A3),MM_SIZ
TST.B CT_SPE(A3) CCR:= SPEEDUP EXCEPTION;
RTS RETURN
PAGE
CRE_CTX EQU * CREATE CONTEXT
* CALL: RETURN:
* A0 EXT OBJECT SAME
* A2 OLD_CTX SAME (SPECIFIES OLD SPEED-UP ETC.)
* A3 - NEW_CTX
* A4 ARGUMENT ADDR SAME (FOR FINDING #FORMALS)
* A5 OBJECT TO CALL UNDEF (GENERAL OBJECT, POSSIBLY ABORTED)
* D3.W ADDITIONAL FORMALS SAME (0 FOR OBJ_CALL,2 FOR DEALLOC,
* 1 FOR CONTROL)
* D4.L LOW ARG ADDR (PHYS) ENTRY ADDRESS
* D7.L - UNDEF IF OK, RESULT IF NOT OK
* A1/A6/D0-D2 - UNDEF
* SR - NE=OK, EQ=NOT OK (NO SPACE ONLY)
* CREATES A CONTEXT INCLUDING TEMP AND FORMAL POINTERS.
* MAPS CODE SEGMENT TO MMU DESCR1 IF OBJECT IS NON-ABORTED (AVOIDS HAVING
* ENVELOPES ETC. IN A DUMMY MANAGER). INITIALIZES ALL FIELDS SO THAT
* DEL_CTX CAN BE PERFORMED IN CASE SET_FP FAILS.
* "RESERVE SPACE FOR CONTEXT:"
SUB.L A4,D4 D4:=NEGATIVE #FORMALS:=
DIVS #AR_SIZ,D4
BVS ER_PROSP (LOW_ARG-ARG)/ARG_SIZE+1
ADDQ #1,D4 "VAL DATA NOT IN FORMALS"
SUB D3,D4 -ADDITIONAL FORMALS;
BVS ER_PROSP "D4 WORD ENSURED"
MULS #FP_SIZ,D4 D4:=-SIZE OF FORMALS;
MOVE GE_TEMP(A5),D0 D0:=SIZE OF TEMPS:=
MULU #PT_SIZ,D0 OBJ.TEMP_POINTERS * POINTER SIZE;
SUB.L D4,D0 D0:=SIZE OF TEMPS AND FORMALS;
CMPI.L #$8000-CT_SIZ,D0 IF D0 >=1<<15-CTX_SIZE "UNSIGNED" THEN
BCC ER_PROSP REJECT END; "D0=WORD ENSURED"
ADD #CT_SIZ,D0 D0:=SIZE OF CONTEXT+TEMPS+FORMALS;
BSR MM_PUSHK RESERVE_STACK_ELEM(EXT OBJ,D0=SIZE,
* A3:=NEW CTX,A6:=TOP OBJ);
BEQ ER_PROSP IF NOT OK THEN REJECT END;
LEA EX_CTX(A0),A1 A1:=EXT_OBJ.CTX STACK HEAD;
LEA ST_STK(A3),A3 A3:=CTX.STACK ELEM;
INS_ELEM A1,A3,A6,A1/A6 INSERT(HEAD=EXT OBJ, NEW=CTX,A6:=PREV);
LEA -ST_STK(A3),A3 A3:=NEW CTX;
ADD D0,D4 D4:=NEW_CTX.TOP_TEMP:=
MOVE D4,CT_TOPT(A3) TOP_FORMAL - SIZE OF FORMALS;
MOVE.L A5,CT_OBJ(A3) NEW_CTX.EXECUTES:=OBJECT TO CALL;
LEA GE_EX(A5),A1
INS_ELEM A1,A3,A6,A1/A6
MOVE.L GE_ENT(A5),D4 D4:=ENTRY ADDRESS:=OBJECT TO CALL.ENTRY
BTST.B #OB_ABOR,OB_STA(A5)
IF <EQ> THEN.S IF OBJECT NOT ABORTED THEN
* "FIND CODE SEGMENT:"
MOVE.L OB_SPA(A5),A6 A6:=TOP OBJECT TO CALL;
MOVE.L SP_ENV+4(A6),A6 A6:=TOP ENVELOPE TO CALL; "OFFSET"
MOVE.B PT_KIN+EN_SIZ-EN_STK(A6),D0 D0:=L(1).POINTER_KIND;
IF.B D0 <EQ> #PT_OBJ THEN.S IF OBJ_REF THEN
MOVE.L PT_REF+EN_SIZ-EN_STK(A6),A5 A5:=CODE_OBJ:=OBJECT REFERENCED
ELSE.S ELSE
IF.B D0 <EQ> #PT_OWN THEN.S IF OWN_SET THEN
MOVE.L EN_SIZ+4-EN_STK(A6),A5 A5:=CODE_OBJ:=LAST IN SET
ENDI ELSE A5=GENERAL OBJECT END;
ENDI END;
CMP.B #OB_SEOB,OB_KIN(A5) SR:=CODE_OBJ IS SEGMENT;
ENDI END "OBJECT NOT ABORTED"
* "INITIALIZE EXECUTES, SPEED, MMU1:"
IF <NE> THEN.S IF ABORTED OR CODE OBJ NOT SEGMENT THEN
CLR.L CT_OBJ(A3) NEW_CTX.EXECUTES:=ABORTED;
MOVE.B #3,CT_MODE(A3) CTX.MODE:=NO_EXCEPTION/PROPAGATE_SAME;
MOVE.B #3,CT_SPE(A3) CTX.SPEED:= UNDEF;
INIT_HEAD CT_MM1(A3),A1 MMU1.REFERS TO:=DUMMY;
CLR.L MM_REF(A1) A1=MMU DESCR1;
CLR MM_REG+6(A1) MMU1.ENABLE:=DISABLED
ELSE.S ELSE
MOVE.B CT_MODE(A2),D0 D0:=NEW_CTX.SPEED:=
AND.B CT_SPE(A2),D0 MIN(OLD_CTX.MODE,OLD_CTX.SPEED);
MOVE.B D0,CT_SPE(A3) CTX.SPEEDEXC:=FALSE;
CLR.B CT_MODE(A3) NEW_CTX.MODE:=NO_EXCEPTION/STOP ;
CLR.L D0 D0:=LOGICAL ADDRESS:=0;
LEA CT_MM1(A3),A1 A1:=MMU DESCR1;
BSR MAP_FIRST MAP_FIRST_TIME(MMU1,CODE OBJ,LOG ADDR,
* D1-D2:=UNDEF);
ADD.L D0,D4 D4:=ENTRY:=...+ADJUSTED LOGICAL ADDR;
* "CODE SEGM MAY BE SUBSEGM"
ENDI END "INITIALIZE EXECUTES, ETC";
MOVE.B #PT_MMU,MM_KIN(A1) MMU1.KIND:=MMU_REF;
* "INIT OTHER MMU DESCRIPTORS"
INIT_HEAD CT_MM0(A3),A1 MMU0.REFERS TO:=DUMMY;
CLR.L MM_REF(A1)
CLR MM_REG+6(A1) MMU0.ENABLE:=DISABLED;
MOVE.B #PT_MMU,MM_KIN(A1) MMU0.KIND:=MMU_REF;
INIT_HEAD CT_MM2(A3),A1 MMU2 ...
CLR.L MM_REF(A1)
CLR MM_REG+6(A1)
MOVE.B #PT_MMU,MM_KIN(A1)
INIT_HEAD CT_MM3(A3),A1 MMU3 ...
CLR.L MM_REF(A1) A1=MMU DESCR3;
CLR MM_REG+6(A1)
MOVE.B #PT_MMU,MM_KIN(A1)
MOVE #CT_SIZ,D0 "INIT POINTERS:"
MOVE CT_TOPT(A3),D1 D1:=TOP TEMPS;
WHILE D0 <NE> D1 DO.S FOR ALL TEMPS IN NEW_CTX DO
INIT_HEAD <(A3,D0)>,A1 TEMP POINTER:=NIL, TEMP_SCOPE;
MOVE #PT_NIL<<8+1<<PT_TSC,PT_KIN(A1)
ADD #PT_SIZ,D0 ENDF;
ENDW
MOVE CT_TOPF(A3),D1 D1:=TOP FORMALS;
WHILE D0 <NE> D1 DO.S FOR ALL FPRMALS IN NEW_CTX DO
INIT_HEAD <(A3,D0)>,A1 FORMAL POINTER:=NIL, FORMAL SCOPE;
MOVE #PT_NIL<<8+1<<PT_FSC,PT_KIN(A1) "A1=POINTER"
INIT_HEAD FP_ACT(A1),A6 FORMAL POINTER.ACTUAL:=DUMMY
CLR.L FP_STR(A1) "FP_STR =0 USED BY INSPECT"
ADD #FP_SIZ,D0 D0:= INDEX TO NEXT FORMAL;
ENDW ENDF;
***
PRT_MEM NEW_CTX,(A3),CT_SIZ+4*PT_SIZ+3*FP_SIZ
TST D0 SR:=NE; "OK"
RTS RETURN;
PAGE
SET_FP EQU * SET FORMAL POINTERS
* CALL: RETURN:
* A0 EXT OBJECT SAME
* A2 OLD CTX SAME
* A3 NEW CTX SAME
* A4 ARGUMENT ADDR UPDATED
* D3.W ADDITIONAL FORMALS #FORMALS IN NEW CTX
* D6.W ARGUMENT# UPDATED
* D7.L - UNDEF IF OK, RESULT IF NOT OK
* A1/A5/A6/D0-D2/D4/D5 - UNDEF
* SR - NE = OK, EQ = NOT OK
* USP - INITIAL VALUE IN NEW CTX
* STACK: ROOM FOR FNC,A5,A6 SAME, FIRST TEMP, TOP VALUE
* CHECKS THE VALUE PARAMETER AND CREATES THE TEMP SEGMENT USED
* FOR STACK AND VALUE DATA. COPIES THE VALUE DATA.
* INITIALIZES T(1) AND MAPS IT TO MMU DESCR 0.
* INTERPRETES ARGUMENTS AND SETS UP FORMAL POINTERS. CHECKS FREE STACK.
TST -2(A4) "CHECK VAL SUBSEGM:"
IF <NE> THEN.S IF NEXT ARG <> VOID THEN
* CHECK SUBSEGMENT (A1:=PSTR,D1:=PREL,
BSR C_SUB A5:=BASE SEGM,D0:=TREL,D5:=FREL,
* D2:=LENGTH,D4:=CAPS);
BEQ RETURN IF NOT OK THEN RETURN END;
LEA OB_REF(A5),A6 A6:=BASE_SEGM.REF_HEAD
MOVE.L A6,D7 D7:=END OF REF_CHAIN;
MOVE.L (A6),A6 A6:= FIRST REF IN REF_CHAIN;
WHILE.L A6 <NE> D7 DO.S WHILE NOT END OF REF_CHAIN DO
IF.L A6 <LE> A2 THEN.S IF REF IS NOT AN MMU_REF
BRA ER_STATE (I.E. THE REF IS NOT LOCATED
ENDI IN THE FIXED PART
LEA -CT_SIZ(A6),A6 OF THE CALLING CONTEXT)
IF.L A6 <GE> A2 THEN.S THEN
BRA ER_STATE REJECT
ENDI ENDI;
MOVE.L CT_SIZ(A6),A6 A6:=NEXT REF;
ENDW ENDW;
BTST.B #OB_SUB,OB_STA(A5) IF BASE_SEGM IS A SUB_SEGM
BNE ER_STATE THEN REJECT END;
BTST.B #PT_TSC,PT_INF(A1,D1) IF VAL POINTER NOT TEMP
BEQ ER_SCOPE THEN REJECT END;
BCLR #OB_EXEC,D4 D4:=VAL SEGM USE BITS.READ AND WRITE;
CMPI #1<<OB_READ+1<<OB_WRIT,D4 IF VAL SEGM NOT READ AND WRITE
BNE ER_CAP THEN REJECT END;
CMP.L #AR_MAXVAL,D2 IF VAL SEGM LENGTH > MAX VAL LENGTH
BGT ER_ADDR THEN REJECT END;
BTST.L #0,D0 IF TOPREL IS ODD
BNE ER_ADDR THEN REJECT END;
BTST.L #0,D5 IF FIRSTREL IS ODD
BNE ER_ADDR THEN REJECT END;
MOVE D1,CT_VAL(A3) NEW_CTX.VAL_BASE_SEGM:=PREL;
MOVE.L D0,CT_TREL(A3) NEW_CTX.TOPREL:=TREL;
MOVE.L D5,CT_FREL(A3) NEW_CTX.FIRSTREL:=FREL;
ELSE.S ELSE "VOID VAL SEGM"
CLR.L D2 D2:=LENGTH:=0;
CLR.L CT_TREL(A3) NEW_CTX.TOPREL:=0;
CLR.L CT_FREL(A3) NEW_CTX.FIRSTREL:=0;
SUB #AR_SIZ,A4 ARGUMENT_ADDR:=NEXT ARGUMENT;
ADDQ #1,D6 ARGUMENT#:=...+1;
MOVE.L A3,A5 A5:=BASE_SEGM:=DUMMY "CTX"
ENDI END;
TST.L CT_OBJ(A3) "CREATE TEMP SEGMENT:"
IF <NE> THEN IF NEW_CTX NOT ABORTED THEN
MOVEM.L D2/A5,-(A7) SAVE LENGTH VAL DATA, BASESEGM;
MOVE.L CT_OBJ(A3),A6 A6:=OBJ:=NEW_CTX.CUROBJ;
MOVE.L GE_TEMD(A6),D0 D0:=SIZE:=OBJ.TEMP_DATA
ADD.L D2,D0 +LENGTH VAL DATA;
MOVE.L A3,A1 A1:=PSTR:=NEW CTX;
MOVE #CT_SIZ+PT_SIZ,D1 D1:=PREL:=T(1);
BSR CRE_SEG CREATE_SEGM (EXT,PSTR,PREL,SIZE,
* A5:=SEGM OBJ);
IF <EQ> THEN.S IF NOT OK THEN
ADD.L #8,A7 POP SAVED D2,D5;
BRA ER_PROSP REJECT
ENDI END;
* "MAP STACK SEGMENT AND INIT USP:"
MOVE.L GE_STKM(A6),D0 D0:=LOGICAL ADDR:=OBJ.STACK_MAP;
LEA CT_MM0(A3),A1 A1:=MMU DESCR0;
BSR MAP_FIRST MAP_FIRST_TIME(MMU0,SEGMOBJ,LOGADDR,
* D1,D2:=UNDEF);
MOVE.L D0,16(A7) STACK.FIRST_TEMP:=LOG ADDR;
MOVE.L SE_FIR(A5),A5 A5:=SEGM OBJ.FIRST_PHYS_ADDR
ADD.L GE_TEMD(A6),A5 +OBJ.TEMP DATA;
ADD.L GE_TEMD(A6),D0 D0:=LOGICAL ADDR+OBJ.TEMP DATA;
MOVE.L D0,A1 USP:=D0;
MOVE.L A1,USP
ADD.L (A7)+,D0 D0:=STACK.TOPVAL:=D0+LENGTH VAL DATA;
MOVE.L D0,16(A7)
MOVE.L (A7)+,A6 A6:=SAVED BASE SEGM;
* "COPY VAL DATA: A5=PHYS FIRST VAL ADDR"
MOVE.L SE_FIR(A6),A1 A1:=BASE_SEGM.FIRST_PHYS_ADDR;
* "NONSENSE IN CASE OF NO VAL DATA"
MOVE.L CT_TREL(A3),D0 D0:=NEW_CTX.TOPREL;
MOVE.L CT_FREL(A3),D5 D5:=CUR_REL:=NEW_CTX.FIRSTREL;
WHILE.L D5 <NE> D0 DO.S WHILE CUR_REL <> TOPREL DO
MOVE (A1,D5),(A5)+ COPY ONE WORD;
ADDQ #2,D5 D5:=CUR_REL:=...+2
ENDW END;
* THIS COPYING SHOULD BE IMPROVED IN TWO WAYS:
* (1) WHEN VAL DATA IS TOP OF CTX, VAL BASE SEGM MAY BE SHORTENED
* BEFORE TEMP IS CREATED. THEN NO COPYING IS NEEDED.
* (2) IN OTHER CASES, COPYING SHOULD USE LONGS, AVOID LOOP OVERHEAD, ETC.
* "INITIALIZE FORMALS:"
MULS #FP_SIZ,D3 D3:=CUR_FPREL:=ADDITIONAL FORMALS
ADD CT_TOPT(A3),D3 *FP_SIZE+NEW_CTX.FIRST_FPREL;
WHILE D3 <NE> CT_TOPF(A3) DO WHILE CUR_FPREL <> TOP FORMALS DO
TST -2(A4)
IF <EQ> THEN.S IF NEXT ARG = VOID THEN
SUB.L #AR_SIZ,A4 ARGUMENT_ADDR:=NEXT ARGUMENT;
ADDQ #1,D6 ARGUMENT#:=...+1
ELSE.S ELSE
TST.L -AR_SIZ(A4)
IF <NE> THEN.S IF NEXT ARG = SUBSEGM THEN
* CHECK SUBSEGMENT (A1:=PSTR,D1:=PREL,
BSR C_SUB A5:=BASESEGMENT,D0:=TREL,D5:=FREL,
* D2:=LENGTH,D4:=CAPS);
BEQ RETURN IF NOT OK THEN RETURN END;
IF.L A5 <EQ> A6 THEN.S IF BASESEGMENT = VAL BASE SEGM
IF.L D5 <LT> CT_TREL(A3) THEN.S AND FREL < NEW_CTX.TOPREL
CMP.L CT_FREL(A3),D0 AND TREL > NEW_CTX.FIRSTREL
BGT ER_ADDR THEN REJECT "OVERLAP"
ENDI END;
ENDI
MOVE.L A3,A1 A1:=PSTR:=NEW CTX;
MOVE D3,D1 D1:=PREL:=CURRENT FORMAL PREL;
BSR CRE_SUB CREATE_SUBSEGMENT(EXT,PSTR,PREL,
* BASESEGM,FREL,LENGTH,CAPS,A5:=SUBSEGM);
BEQ ER_PROSP IF NOT OK THEN REJECT END;
ELSE.S ELSE "POINTER ACTUAL:"
MOVE.L A6,-(A7) SAVE VAL BASE SEGM;
* CHECK ENTITY(A1:=PSTR,D1:=PREL,
BSR C_ENT A5:=ENTITY,A6:=PT,D2:=PTKIND,
* D4:=CAPS,D5:=ENTKIND);
MOVEA.L (A7)+,A6 A6:=RESTORE VAL BASE SEGM;
BEQ RETURN IF NOT OK THEN RETURN END;
SUB.L #AR_SIZ-AR_PTSIZ,A4 ARGUMENT ADDR:=NEXT ARGUMENT;
BSR SET_ACT SET ACTUAL REF(PSTR,PREL,FPREL);
BTST.B #0,9(A4)
IF <NE> THEN.S IF ACTUAL.CALL PARAM THEN
BTST.L #PT_CON,D4
IF <NE> THEN.S IF COPY CONTROL THEN
BCLR.L #PT_CC,D4 D4:=CAPS-CALL CAP
ENDI END;
MOVE.L A6,-(A7) SAVE VAL BASE SEGM;
LEA (A3,D3),A6 A6:=FORMAL POINTER ADDR;
BSR COPY_NIL COPY TO NIL(FORMAL POINTER,ENTITY,ENTKIND,
* CAP,A1:=UNDEF);
MOVEA.L (A7)+,A6 A6:=RESTORE VAL BASE SEGM;
ENDI END;
BTST.B #1,9(A4)
IF <NE> THEN.S IF ACTUAL.RETURN PARAM THEN
BSET.B #PT_RET,PT_INF(A3,D3) FORMAL POINTER.RETURN:=TRUE
ENDI END;
ENDI END "POINTER ACTUAL";
ENDI END "NOT VOID";
ADD #FP_SIZ,D3 D3:=NEXT FPREL;
ENDW END "FOR ALL FORMALS";
* "CHECK STACK SPACE"
MOVE.L OB_SPA(A0),A6 A6:=TOP EXTENSION OBJECT;
MOVE.L SP_FREU(A6),D0 D0/D1:=NEW_CTX.FREE_CALL_STACK
MOVE.L D0,CT_STKU(A3) :=EXT.FREE_SPACE;
MOVE SP_FREK(A6),D1
MOVE D1,CT_STKK(A3)
MOVE.L CT_OBJ(A3),A1 A1:=OBJ:=NEW_CTX.CUROBJ;
CMP.L GE_STK(A1),D0 IF FREE SPACE < OBJ.REQUIRED_CALL_STACK
BLT ER_PROSP THEN REJECT
CMP GE_STK+SZ_K(A1),D1 END;
BLT ER_PROSP
ELSE.S ELSE "CTX ABORTED"
CLR.L CT_TREL(A3) NO VALUE DATA TO RETURN IN THIS CASE;
MOVE.L OB_SPA(A0),A6 A6:= TOP OF EXTENSION OBJECT;
MOVE.L SP_FREU(A6),CT_STKU(A3) CTX.FREE_STK:= EXT.FREE_STK;
MOVE.W SP_FREK(A6),CT_STKK(A3) "MUST BE ASSIGNED TO SATISFY S_TERM"
ENDI ENDI;
MOVE CT_TOPF(A3),D3 D3:=#FORMALS:=
SUB CT_TOPT(A3),D3 (TOP FORMALS-TOP TEMPS)//FP_SIZE;
DIVU #FP_SIZ,D3
***
PRT_REG SET_FP
PRT_MEM FORMALS,CT_SIZ(A3),4*PT_SIZ+3*FP_SIZ
CMP.L A2,A3 SR:=NE; "OK"
RTS RETURN;
PAGE
SET_ACT EQU * SET ACTUAL REF
* CALL: RETURN:
* A1 POINTER STRUCT SAME (ACTUAL POINTER)
* D1.W POINTER REL SAME (ACTUAL POINTER)
* A3 FORMAL POINTER STRUCT SAME (=CTX)
* D3.W FORMAL POINTER REL SAME
* INSERT THE ACTUAL REF OF A FORMAL POINTER.
MOVEM.L A4-A6,-(A7) SAVE REGISTERS:
MOVE.L A1,FP_STR(A3,D3) FP.ACTUAL:=POINTER;
MOVE D1,FP_OFF(A3,D3)
LEA ST_ACT(A1),A4
LEA FP_ACT(A3,D3),A5 INSERT(HEAD=POINTER STRUCT,
INS_ELEM A4,A5,A6,A4/A6 NEW=FP,A6:=PREV);
MOVEM.L (A7)+,A4-A6 RESTORE REGISTERS
RTS RETURN
RESETLMS EQU * RESET CHAIN ELEMENT IN ARRAY OF REFS
* CALL: RETURN:
* A0 CHAIN ELEMENT OF FIRST REF UNDEF
* A1 CHAIN ELEMENT OF TOP REF SAME
* D0 SIZE OF ONE REF SAME
* A4/A6 - UNDEF
*
* USED IN DEL_CTX TO "UNCHAIN" FORMAL POINTERS AND MMU DESCRIPTORS
*
WHILE.L A0 <NE> A1 DO.S WHILE MORE ELEMENTS DO
MOVEM.L (A0),A4/A6 REMOVE
MOVE.L A4,(A6) ELEMENT
MOVE.L A6,4(A4) FROM CHAIN
MOVE.L A0,(A0) ELEMENT:=
MOVE.L A0,4(A0) SELFREF;
ADDA.W D0,A0 A0:=NEXT ELEMENT;
ENDW ENDW;
RTS RETURN;
PAGE
RET_FP EQU * RETURN FORMATLS
* CALL: RETURN:
* A3 CTX SAME
* D6 RESULT (SYSID,ERR#) SAME OR UPDATED (IF POINTER RETURN IMPOSSIBLE)
* D7 RESULT (CAUSE,MAIN) SAME OR UPDATED
* OTHER REGISTERS - UNDEF
* COPIES THE VALUE DATA. CHECKS THAT POINTER RETURN IS POSSIBLE FOR ALL
* POINTERS. IF IT IS, POINTERS ARE RETURNED.
MOVE.L CT_TREL(A3),D0 D0:=CTX.TOP_VAL_REL;
IF <NE> THEN.S IF VAL DATA EXISTS THEN
* "FIND VAL BASE SEGM:"
MOVE.L CT_HOLD(A3),A0 A0:=EXT:=CTX.HOLDER_OBJ;
LEA EX_CTX(A0),A0 "OFFSET"
IF.L CT_STK+4(A3) <NE> A0 THEN.S IF CTX.PREV_CTX <> EXT THEN
MOVE.L CT_STK+4(A3),A2 A2:=OLD_CTX:=CTX.PREV_CTX
ELSE.S ELSE
MOVE.L EX_EXT+4-EX_CTX(A0),A1 A1:=EXT.PREV_EXT;
MOVE.L EX_CTX+4-EX_EXT(A1),A2 A2:=OLD_CTX:=PREV_EXT.LAST_CTX;
ENDI END;
LEA -CT_STK(A2),A2 "OFFSET OLD CTX"
MOVE CT_VAL(A3),D2 D2:=PREL:=CTX.PREL_OF_VAL_BASE_SEGM;
* "POINTER IS OWN_SET"
MOVE.L 4(A2,D2),A1 A1:=BASE_SEGM:=POINTER.LAST
* "COPY VAL DATA:"
MOVE.L SE_FIR(A1),A1 A1:=BASE_SEGM.FIRST_PHYS_ADDR;
MOVE.L CT_FREL(A3),D5 D5:=CUR_REL:=CTX.FIRST REL;
MOVE.L SE_FIR-SE_SIZ(A3),A5 A5:=TOP TEMP:=
ADD.L SE_LEN-SE_SIZ(A3),A5 FIRST EMBEDDED.FIRST ADDR+LENGTH;
ADD.L D5,A5 A5:=FIRST VAL:=TOP TEMP
SUB.L D0,A5 -(CTX.TOP VAL REL-CTX.FIRST VAL REL);
***
PRT_REG VAL_DATA_RETURN
WHILE.L D5 <NE> D0 DO.S WHILE CUR_REL <> TOP REL DO
MOVE (A5)+,(A1,D5) COPY ONE WORD;
ADDQ #2,D5 D5:=CUR_REL:=...+2
ENDW END;
* THIS COPYING SHOULD BE IMPROVED. SEE NOTE IN SET_FP.
ENDI END "VAL DATA EXISTS"
TST.B D7 "CHECK RETURN POSSIBLE:"
IF.B <GE> THEN IF RESULT.MAIN <> REJECT THEN
CLR D2 D2:=INITIALLY NOTHING TO RETURN;
MOVE CT_TOPT(A3),D3 D3:=CUR_FP:=CTX.FIRST_FP_REL;
WHILE D3 <NE> CT_TOPF(A3) DO.S FOR ALL FORMALS DO
BTST.B #PT_RET,PT_INF(A3,D3)
IF <NE> THEN.S IF FP.RETURN THEN
MOVE.L FP_STR(A3,D3),A1 A1:=ACTUAL STRUCTURE;
CMPA.L #0,A1 IF DUMMY ACTUAL
BEQ ER_RETURN THEN REJECT END;
MOVE.B PT_KIN(A3,D3),D5 D5:=FP.KIND;
IF <NE> THEN.S IF FP NOT NIL THEN
MOVE FP_OFF(A3,D3),D1 D1:=ACTUAL REL;
MOVE.B PT_KIN(A1,D1),D4 D4:=ACTPT.KIND;
IF.B D5 <LE> #PT_ENV THEN.S IF FP SIMPLE THEN
CMP.B #PT_ENV,D4 IF ACT PT NOT SIMPLE
BGT ER_RETURN THEN REJECT END;
ELSE.S ELSE "FP IS OWN:"
CMP.B #PT_OWN,D4 IF ACTPT NOT SIMPLE OR OWN
BGT ER_RETURN THEN REJECT END;
MOVE.L (A3,D3),A5
REPEAT FOR A5:=OBJECTS IN OWN SET DO
BSR S_MOVE MOVE_STACK_CHECK(ACTSTR,ACTREL,OBJ);
BEQ ER_RET1 IF NOT OK THEN REJECT END;
LEA (A3,D3),A6 A6:=FP ADDR;
MOVE.L (A5),A5 A5:=NEXT OBJECT;
UNTIL.L A5 <EQ> A6 END FOR;
ENDI END "FP IS OWN";
MOVEQ #1,D2 D2:=SOMETHING TO RETURN;
ENDI END "FP NOT NIL";
ENDI END "FP.RETURN"
ADD #FP_SIZ,D3 D3:=CUR_FP:=NEXT FORMAL;
ENDW END "FOR ALL FORMALS";
TST D2
IF <NE> THEN.S IF SOMETHING TO RETURN THEN
MOVE CT_TOPT(A3),D3 D3:=CUR_FP:=CTX.FIRST_FP_REL;
WHILE D3 <NE> CT_TOPF(A3) DO.S FOR ALL FORMALS DO
MOVE.B PT_INF(A3,D3),D4 D4:=CUR_FP.CAPS_ETC;
BTST #PT_RET,D4
IF <NE> THEN.S IF FP.RETURN THEN
MOVE.B PT_KIN(A3,D3),D5 D5:=ENTITY KIND:=FP.KIND;
IF <NE> THEN.S IF FP NOT NIL THEN
MOVE.L FP_STR(A3,D3),A1 A1:=ACTUAL STRUCTURE;
MOVE FP_OFF(A3,D3),D1 D1:=ACTUAL REL;
IF.B D5 <LE> #PT_ENV THEN.S IF FP SIMPLE THEN
IF.B PT_KIN(A1,D1) <LE> #PT_ENV THEN.S IF ACTUAL STILL SIMPLE THEN
BSR CLR_SMP CLEAR SIMPLE (ACTUAL,A6:=ACTPT);
MOVE.L PT_REF(A3,D3),A5 A5:=ENTITY:=FP.REF;
BTST #PT_CON,D4
IF <NE> THEN.S IF COPY CONTROL THEN
BCLR #PT_CC,D4 D4:=CAPS:=CAPS-CALLCAP;
ENDI END;
AND.B #1<<PT_CC+1<<PT_CON,D4 D4:=CAPS,REMOVE OTHER BITS;
BSR COPY_NIL COPY TO NIL(ACT PT, ENTITY, CAP,
* ENTITY KIND, A1:=UNDEF);
ENDI END "ACTUAL STILL SIMPLE"
ELSE.S ELSE "FP IS OWN_SET"
MOVE.L (A3,D3),A5
REPEAT FOR A5:=OBJECTS IN OWN SET DO
BSR M_OWN_OK MOVE_OWNER (ACT STR, ACTREL, OBJECT,
* A6:=ACTPT);
BSR S_UPDATE UPDATE_STACK_REQUIREMENTS (OBJECT,
* A6/D0:=UNDEF);
LEA (A3,D3),A6 A6:=FP ADDR;
MOVEA.L (A6),A5 A5:=NEXT OBJ:=FIRST IN SET;
UNTIL.L A5 <EQ> A6 END FOR;
ENDI END "OWN SET";
ENDI END "FP NOT NIL";
ENDI END "FP.RETURN";
ADD #FP_SIZ,D3 D3:=CUR FP:=NEXT FORMAL;
ENDW END "FOR ALL FORMALS"
ENDI END "SOMETHING TO RETURN";
ENDI END "RESULT <> REJECT";
RTS RETURN
ER_RETURN EQU * RETURN POINTER ILLEGAL: "D3:=FP REL"
MOVE.L #ECRRETURN,D7 D7:=RESULT:=(REJECT,...)
ER_RET1 EQU * "AFTER STACK CHECK ERROR:"
SUB CT_TOPT(A3),D3 D3:=D6:=SYSID,ERROR#
DIVU #FP_SIZ,D3 :=(FP REL-FP FIRST)//FP_SIZE;
MOVE.L D3,D6
CMP D7,D7 SR:=EQ; "NOT OK"
RTS RETURN
PAGE
DEL_CTX EQU * DELETE CONTEXT
* CALL: RETURN:
* A0 - EXT OBJECT (USED BY NEW_STACK_CALL, ETC.)
* A3 CTX PREV CTX (NONSENSE IF FIRST IN EXT OBJECT)
* D6/D7 - SAME
* OTHER REGS - UNDEF (USER CONTEXTS MAY BE CALLED)
* REMOVES CTX FROM EXECUTES. DUMMYFIES ACTUAL REFS TO CONTEXT.
* REMOVES FORMAL PTS. FROM ACTUAL CHAINS. REMOVES MMU DESCRIPTORS FROM CHAINS.
* ACTUAL REFS TO THIS CONTEXT CANNOT EXIST (REMOVED WHEN YOUNGER CTX RETURNS).
* CLEARS POSSIBLE TEMP OR FORMAL IO-LOCKS. DELETES EMBEDDED SEGMENTS TO
* GET MAXIMAL FREE STACK BEFORE POINTER CLEARING.
* CLEARS ALL TEMP AND FORMAL POINTERS. RELEASES CTX SPACE.
PRT_MEM DEL_CTX,(A3),CT_SIZ+4*PT_SIZ+3*FP_SIZ
REM_ELEM (A3),A0,A4,A0/A4 REMOVE FROM EXECUTES;
* ACTUALS MAY HAVE FORMALS IN CONTEXTS IN OTHER PROCESSES (DECL_PROC);
MOVE.L A3,A5 A5:= STRUCT:= CTX;
BSR.L DUM_ACT DUMMYFY ACTUALS(STRUCT,A0/A4/A6:=?);
LEA FP_ACT(A3),A0 "RESET ACTUAL CHAIN IN FORMAL POINTERS"
MOVE.L A0,A1
ADDA.W CT_TOPT(A3),A0 A0:=ACT_CHAIN_ELEM OF FIRST FORMAL
ADDA.W CT_TOPF(A3),A1 A1:=ACT_CHAIN_ELEM OF TOP FORMAL
MOVEQ.L #FP_SIZ,D0 D0:= SIZE OF FORMAL POINTER
BSR RESETLMS RESET ELEMS(FIRST,TOP,SIZE,A0/A4/A6:=?);
LEA CT_MM0(A3),A0 "RESET SEGM CHAIN IM MMU DESCRIPTORS"
LEA CT_MM3+MM_SIZ(A3),A1 A0:= FIRST MMU; A1:= TOP MMU
MOVEQ.L #MM_SIZ,D0 D0:= SIZE OF MMU DESCRIPTOR
BSR RESETLMS RESET ELEMS(FIRST,TOP,SIZE,A0/A4/A6:=?);
MOVEM.L D6/D7,CT_MM0+MM_REG(A3) SAVE RESULT;
MOVE.L A3,A1 A1:=STRUCT:=CTX;
TST CT_IO(A3) "CLEAR POSSIBLE TEMP/FORMAL IO-LOCKS:"
IF <NE> THEN.S IF CTX.IO_COUNT <> 0 THEN
MOVE #CT_SIZ+PT_SIZ,D1 D1:=CUR_TMP:=CTX.TMP(1);
WHILE D1 <NE> CT_TOPT(A3) DO.S FOR D1:=ALL USER ACCESSIBLE TEMPS DO
BTST.B #PT_IO,PT_INF(A1,D1) "OBS: NO DRIVER POINTERS IN CTX"
IF <NE> THEN.S IF TMP.IO_LOCK THEN
BSR CLR_SMP CLEAR SIMPLE PT (STRUCT, PREL, A6:=PT)
ENDI END;
ADD #PT_SIZ,D1 D1:=CUR_TMP:=NEXT
ENDW END "FOR ALL TEMPS";
WHILE D1 <NE> CT_TOPF(A3) DO.S FOR D1:=ALL FORMALS DO
BTST.B #PT_IO,PT_INF(A1,D1) "OBS: NO DRIVER POINTERS IN CTX"
IF <NE> THEN.S IF FORMAL.IO_LOCK THEN
BSR CLR_SMP CLEAR SIMPLE PT(STRUCT, PREL, A6:=PT)
ENDI END;
ADD #FP_SIZ,D1 D1:=CUR_FP:=NEXT;
ENDW END "FOR ALL FORMALS";
ENDI END "IO_COUNT <> 0":
BSR DEL_EMB DELETE EMBEDDED(STRUCT,CTX,A6:=TOPEXT,
* A0/A2/A4/A5/D0-D7:=UNDEF);
MOVE.L SP_FREU(A6),CT_STKU(A3) CTX.FREE STACK:=EXT OBJECT.FREE SPACE
MOVE SP_FREK(A6),CT_STKK(A3) "FULL SPACE NEEDED FOR POSSIBLE OBJECT DEL
* "CLEAR ALL TEMPS AND FORMALS:"
MOVE #CT_SIZ+PT_SIZ,D1 D1:=CUR_TMP:=CTX.TMP(1);
WHILE D1 <NE> CT_TOPT(A3) DO.S FOR D1:=ALL USER ACCESSIBLE TEMPS DO
BSR CLR_PT CLEAR_POINTER(STRUCT, CTX, PREL,
* A0/A2/A4-A6/D0/D2-D7:=UNDEF);
ADD #PT_SIZ,D1 D1:=NEXT;
ENDW END "FOR ALL TEMPS";
WHILE D1 <NE> CT_TOPF(A3) DO.S FOR D1:=ALL FORMALS DO
BSR CLR_PT CLEAR_POINTER(...);
ADD #FP_SIZ,D1 D1:=NEXT;
ENDW END "FOR ALL FORMALS";
MOVEM.L CT_MM0+MM_REG(A3),D6/D7 RESTORE RESULT;
MOVE.L CT_HOLD(A3),A0 A0:=EXT_OBJECT:=CTX.HOLDER;
BSR MM_POPK POP_KERNEL_PART (CTX,A3:=NEW CTX,
* A6:=TOP HOLDER OBJ);
RTS RETURN
TTL OBJECT CREATION AND DELETION
PAGE
DECL_GEN EQU * DECLARE GENERAL
* CALL AND RETURN: AS OTHER KERNEL OPERATIONS.
BSR C_OPEN CHECK OPEN OBJ(A0:=A5:=OBJ,A1:=PSTR,
* D1:=PREL,A6:=PT);
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
MOVE #GE_SIZ-OB_SIZ,D0 D0:=SIZE OF GENERAL OBJ PART;
BSR MM_PUSHO RESERVE KERNEL ENV(OBJ,SIZE,A6:=TOP OBJ);
BEQ EE_OBJSP IF NOT OK THEN REJECT END;
BSR CRE_ENV CREATE ENV(OBJ,CTX,A1/D1:=REF ENV PT,
* A5/D5:=MAN SET PT,A3:=ENV,A6/D0:=UNDEF);
IF <NE> THEN IF OK THEN
MOVEM.L A1/A5/D1/D5,-(A7) SAVE A1,D1,A5,D5;
INIT_HEAD GE_EX(A0),A6 OBJ.EXECUTED_BY:=EMPTY;
BSR C_PTS CHECK POINTER COUNT(D0:=TEMPS);
BEQ GEN_REJ IF NOT OK THEN REJECT END;
ADD #1,D0 "INCLUDE T(0):"
MOVE D0,GE_TEMP(A0) OBJ.TEMP_POINTERS:=TEMPS+1;
BSR C_ADDR CHECK ADDR ARGUMENT(D0:=TEMP DATA);
BEQ GEN_REJ IF NOT OK THEN REJECT END;
ADDQ.L #1,D0 ROUND UP TEMP DATA
CMP.L #1<<22-AR_MAXVAL,D0 IF TEMP DATA > MAX
BGT.L GEN_DATA OR TEMP DATA = 0
BCLR.L #0,D0 EVEN TEMP DATA REQUIRED BY SET_FP
TST.L D0 THEN REJECT
BEQ.S GEN_DATA END;
MOVE.L D0,GE_TEMD(A0) OBJ.TEMP_DATA:=TEMP DATA;
ADD #1,D6 ARGUMENT#:=NEXT;
MOVE -(A4),GE_CON(A0) OBJ.CONTROL PROC:=NEXT ARGUMENT;
BGT.S GEN_DATA IF > 0 THEN REJECT END;
SUB #2,A4 SKIP REST OF ARGUMENT;
BSR C_ADDR CHECK ADDR ARGUMENT(D0:=ENTRY ADDR);
BEQ.S GEN_REJ IF NOT OK THEN REJECT END;
MOVE.L D0,GE_ENT(A0) OBJ.ENTRY:=ENTRY ADDR;
MOVE.L #$200000,GE_STKM(A0) OBJ.STACK ADDR:=DEFAULT;
BSR C_SIZ CHECK SIZE(D0:=SIZE_U,D1:=SIZE_K);
BEQ.S GEN_REJ IF NOT OK THEN REJECT END;
MOVE.L D0,GE_STK(A0) OBJ.STACK_REQUIREMENT_AT_ENTRY
MOVE D1,GE_STK+SZ_K(A0) :=SIZE ARGUMENT;
* NOW ALL CHECKS HAVE BEEN PASSED
TST.B -2(A4)
IF <NE> THEN.S IF CAPS <> 0 THEN
BSET.B #OB_OCC,OB_STA(A0) OBJ.OWNERS_CALL_CAP:=TRUE;
ENDI END;
MOVE.B #OB_GEOB,OB_KIN(A0) OBJ.KIND:=GENERAL OBJECT;
MOVEM.L (A7),D1/D5/A1/A5 RESTORE REFENV STRUCT AND REL;"DOM'T POP"
BSR CLR_SMP CLEAR SIMPLE POINTER(PSTR, PREL,A6:=PT);
MOVE.L A3,A5 A5:=ENVELOPE;
CLR D4 D4:=NO CAPS;
MOVE #PT_ENV,D5 D5:=REF_ENV;
BSR COPY_NIL COPY REF TO NIL(ENV,A6:=PT,A1:=UNDEF);
MOVEM.L (A7)+,D0/D1/D7/A1 RESTORE MAN SET STRUCT AND REL;"DO POP"
BSR INS_MAN INSERT IN MAN SET(PSTR,PREL,A5=ENV)
***
PRT_MEM DECL_GEN,(A0),GE_SIZ
MOVE.L A0,A5 A5:=OBJ;
BSR S_UPDATE STACK REQ UPDATE(OBJ,A6/D0:=UNDEF);
CLR.L D7 D7:=RESULT:=OK;
BRA RET_OLD2 RETURN TO USER; "RELOCATION POSSIBLE"
GEN_DATA EQU * DATA VALUE ILLEGAL:
MOVE.L #ECRDATA,D7 D7:=RESULT;
GEN_REJ EQU * REJECT AND RELEASE(A0=OBJ,A3=ENV):
BSR MM_POPK RELEASE STACK ELEM(ENV,A6:=TOP OBJ);
MOVEM.L (A7)+,D1/D5/A1/A5 RELEASE SAVED REGISTERS;
ENDI END "ONLY KERNEL ENVELOPE RESERVED"
MOVE #GE_SIZ-OB_SIZ,D0 D0:=SIZE OF GENERAL OBJ PART;
BSR MM_POPO RELEASE KERNEL ENV(OBJ,SIZE,A6:=TOPOBJ);
BRA RET_OLD2 RETURN TO USER; "RELOCATION POSSIBLE"
PAGE
CRE_ENV EQU * CREATE AND INIT ENVELOPE
* CALL: RETURN:
* A0 OBJECT SAME (UNDEF IF NOT OK)
* A1 - POINTER STRUCT OF SIMPLE REF (UNDEF IF NOT OK)
* A2 CTX SAME
* A3 - ENVELOPE (UNDEF IF NOT OK)
* A4 ARGUMENT ADDR UPDATED (UNDEF IF NOT OK)
* A5 - POINTER STRUCT OF MAN_SET (UNDEF IF NOT OK)
* D1 - POINTER REL OF SIMPLE REF (UNDEF IF NOT OK)
* D5 - POINTER REL OF MAN_SET (UNDEF IF NOT OK)
* D6.W ARGUMENT# UPDATED
* D7.L - RESULT IF NOT OK, UNDEF IF OK
* SR - NE = OK, EQ = NOT OK
* A6/D0 - UNDEF
* CREATES AN ENVELOPE AND INITIALIZES IT ACCORDING TO ARGUMENTS.
* ALSO CHECKS STACK. IN CASE OF ERRORS, THE ENVELOPE IS REMOVED.
* DOES NOT INSERT INTO MAN_SET AND SIMPLE REF SINCE THIS MAY BE SKIPPED
* IN CASE THE CALLER FINDS ERROR. DOES NOT UPDATE STACK REQUIREMENTS.
* "CHECK MAN_SET AND SIMPLE REF:"
BSR C_PT CHECK POINTER ARG(A1:=PSTR,D1:=PREL,
* D2:=PT KIND,A6:=PT);
BEQ RETURN IF NOT OK THEN REJECT END;
BTST.B #PT_LSC,PT_INF(A6)
IF <NE> THEN.S IF LOCAL POINTER THEN
MOVE.L EN_OBJ(A1),A6 A6:=OBJECT HOLDING ENV;
CMP.B #OB_GEOB,OB_KIN(A6) IF NOT GENERAL OBJECT
BNE ER_STATE THEN REJECT END;
MOVE.L OB_SPA(A6),A6 A6:=TOP OBJECT;
LEA SP_ENV(A6),A6 A6:=HEAD ENV CHAIN;
CMP.L EN_STK(A1),A6 IF POINTER STRUCT <> 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 "CHECK TEMP OR IN PRIMARY ENV"
MOVE.L A1,A5 A5:=POINTER STRUCT OF MAN_SET;
MOVE.L D1,D5 D5:=POINTER REL OF MAN_SET;
BTST.B D2,SIM_MAN IF POINTER KIND <> SIMPLE, MANAGER
BEQ ER_VALUE THEN REJECT END;
BSR C_PT CHECK POINTER ARG(A1:=PSTR,D1:=PREL,
* D2:=PT KIND,A6:=PT);
BEQ RETURN IF NOT OK THEN REJECT END;
CMP.B #PT_ENV,D2 IF POINTER KIND <> SIMPLE
BHI ER_VALUE THEN REJECT END;
* "RESERVE ENVELOPE:"
BSR C_PTS CHECK POINTER COUNT(D0:=#LOCALS);
BEQ RETURN IF NOT OK THEN REJECT END;
MULU #PT_SIZ,D0 D0:=SIZE:=
ADD #EN_SIZ,D0 #LOCALS * PT_SIZE + ENV SIZE;
BSR MM_PUSHK RESERVE STACK ELEM(OBJ,SIZE,
* A3:=ENVELOPE,A6:=TOP OBJ);
BEQ ER_OBJSP IF NOT OK THEN REJECT END;
MOVEM.L A1/A5/D1/D5,-(A7) SAVE A1,A5,D1,D5;
MOVE.L A5,EN_MAN(A3) ENV.MANAGER:=MAN_SET POINTER:
MOVE D5,EN_OFF(A3) "NEEDED BY STACK CHECK"
LEA SP_ENV(A6),A1 A1:=TOP OBJ.ENV_HEAD;
LEA EN_STK(A3),A5 A5:=ENV.ENV_STACK_MEMBER;
INS_ELEM A1,A5,A6,A1/A6 INSERT (HEAD=OBJ,NEW=ENV,A6:=PREV);
INIT_HEAD EN_REF(A3),A6 ENV.REFERRED_BY:=EMPTY;
ADD #1,D6 "INIT VARIOUS FIELDS:" ARGUMENT#:=NEXT;
MOVE -(A4),EN_TERM(A3) ENV.TERM_PROC:=NEXT ARGUMENT;
BGT.S ENV_DATA IF > 0 THEN REJECT END;
SUB #2,A4 SKIP REST OF ARGUMENT;
BSR C_SIZ CHECK SIZE(D0:=SIZE_U,D1:=SIZE_K);
BEQ.S ENV_REJ IF NOT OK THEN REJECT END;
MOVE.L D0,EN_FIXU(A3) ENV.FIXED_TERM_REQUIREMENT:=
MOVE D1,EN_FIXK(A3) DEALLOC REQUIREMENT;
BSR C_SIZ CHECK SIZE(D0:=SIZE_U,D1:=SIZE_K)
* "LARGE IN CASE MAX_STK < 0 (=NONE)"
BEQ.S ENV_REJ IF NOT OK THEN REJECT END;
MOVE.L D0,EN_MAXU(A3) ENV.MAX_STACK:=SIZE ARGUMENT;
MOVE D1,EN_MAXK(A3)
BSR S_ENV STACK CHECK ENV(A3=ENV);
BEQ.S ENV_REJ IF NOT OK THEN REJECT END;
MOVE #EN_SIZ,D0
WHILE D0 <NE> EN_TOPL(A3) DO.S FOR ALL LOCAL POINTERS DO
INIT_HEAD <(A3,D0)>,A6 POINTER:=NIL; A6:= POINTER;
MOVE #PT_NIL<<8+1<<PT_LSC,PT_KIN(A6)
ADD #PT_SIZ,D0
ENDW END;
MOVEM.L (A7)+,A1/A5/D1/D5 RESTORE A1,A5,D1,D5
***
PRT_MEM CRE_ENV,(A3),EN_SIZ+PT_SIZ
TST D0 SR:=NE; "OK"
RTS RETURN
SIM_MAN DC.B 1<<PT_NIL+1<<PT_OBJ+1<<PT_ENV+1<<PT_MAN MASK FOR MAN_SET.
DS.W 0 MAKE ADDRESS EVEN
ENV_DATA EQU * DATA VALUE ILLEGAL:
MOVE.L #ECRDATA,D7 D7:=RESULT;
ENV_REJ EQU * REJECT AND RELEASE ENV(A3=ENV):
BSR MM_POPK RELEASE STACK ELEM(ENV,A6:=TOPOBJ);
MOVEM.L (A7)+,A1/A5/D1/D5 RELEASE SAVED REGISTERS;
CMP D7,D7 SR:=EQ; "NOT OK"
RTS RETURN
PAGE
DECL_SEG EQU * DECLARE SEGMENT (NON-EMBEDDED)
* CALL AND RETURN: AS OTHER KERNEL OPERATIONS.
BSR C_OPEN CHECK OPEN OBJ(A0:=A5:=OBJ,A1:=PSTR,
* D1:=PREL,A6:=PT);
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
BSR C_ADDR CHECK ADDR(D0:=USER SIZE);
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
MOVE.L D0,D1 D1:=USER SIZE;
MOVE #SE_SIZ-OB_SIZ,D0 D0:=SIZE:=SIZE OF KERNEL ENVELOPE;
BSR MM_PUSHO RESERVE OBJECT PART(OBJ,SIZE,A6:=TOPOBJ);
BEQ EE_OBJSP IF NOT OK THEN REJECT END;
MOVE.L D1,D0
ADD.L #255,D0 D0:=USER SIZE ROUNDED TO MULTIPLE 256;
CLR.B D0
BSR MM_PUSHU RESERVE_U_SPACE (OBJ,SIZE,
* A4:=PHYS ADDR,A6:=TOP OBJ);
IF <EQ> THEN.S IF NOT OK THEN
MOVE #SE_SIZ-OB_SIZ,D0 D0:=SIZE OF KERNEL ENVELOPE;
BSR MM_POPO RELEASE OBJECT PART(OBJ,SIZE,A6:=TOPOBJ);
BRA EE_OBJSP REJECT
ENDI END;
CLR SE_IO(A0) OBJ.IO_COUNT:=0;
MOVE.L A4,SE_FIR(A0) OBJ.FIRST:=PHYS ADDR;
MOVE.L D1,SE_LEN(A0) OBJ.LENGTH:=USER SIZE; "UNROUNDED"
INIT_HEAD SE_WAIT(A0),A6 IO_LOCK_WAIT:=EMPTY;
MOVE #OB_SEOB<<8+1<<OB_READ+1<<OB_WRIT+1<<OB_EXEC,OB_KIN(A0)
***
PRT_MEM DECL_SEG,(A0),SE_SIZ
CLR.L D7 OBJ.KIND,STATE:=...;D7:=RESULT:=OK;
BRA RET_OLD2 RETURN TO USER; "RELOCATION POSSIBLE"
PAGE
DECL_SUB EQU * DECLARE SUBSEGMENT (NON-EMBEDDED)
* CALL AND RETURN: AS OTHER KERNEL OPERATIONS.
BSR C_OPEN CHECK OPEN OBJ(A0:=A5:=OBJ,A1:=PSTR,
* D1:=PREL,A6:=PT);
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
BSR C_SUB CHECK SUBSEGM(A1:=PSTR,A5:=BASE SEGM,
* D0:=TOPREL,D1:=PREL,D2:=LENGTH,D4/D5:=);
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
MOVE #SU_SIZ-OB_SIZ,D0 D0:=SIZE OF KERNEL ENVELOPE;
BSR MM_PUSHO RESERVE OBJECT PART(OBJ,SIZE,A6:=TOPOBJ);
BEQ EE_OBJSP IF NOT OK THEN REJECT END;
CLR SE_IO(A0) OBJ.IO_COUNT:=0;
ADD.L SE_FIR(A5),D5 D5:=OBJ.FIRST:=BASE SEGM.FIRST+FIRST REL;
MOVE.L D5,SE_FIR(A0)
MOVE.L D2,SE_LEN(A0) OBJ.LENGTH:=LENGTH;
INIT_HEAD SE_WAIT(A0),A6 IO_LOCK_WAIT:=EMPTY;
MOVE.L A5,SU_REF(A0) OBJ.BASE:=BASE SEGM;
MOVE.B #PT_SEG,SU_KIN(A0) OBJ.KIND:=REF FROM SUBSEGM;
ADD #OB_SEOB<<8+1<<OB_SUB,D4 D4:=OBJ.KIND:=...+CAPS;
MOVE D4,OB_KIN(A0)
LEA OB_REF(A5),A5 A5:=BASE SEGM.REFERRED_BY;
LEA SU_P(A0),A0 A0:=OBJ.BASE POINTER;
INS_ELEM A5,A0,A6,A5/A6 INSERT (HEAD=BASE SEGM,NEW=OBJ,
* A6:=PREV);
***
PRT_MEM DECL_SUB,-SU_P(A0),SU_SIZ
CLR.L D7 D7:=RESULT:=OK;
BRA RET_OLD2 RETURN TO USER; "RELOCATION POSSIBLE"
PAGE
NEW_SEG EQU * NEW EMBEDDED SEGMENT
* CALL AND RETURN: AS OTHER KERNEL OPERATIONS.
BSR C_TOPOWN CHECK TOP STACK,OWNER(A0:=HOLDER,
* A1:=PSTR,D1:=PREL,A6:=PT);
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
BSR C_ADDR CHECK ADDR(D0:=SIZE);
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
BSR CRE_SEG CREATE SEGM(HOLDER,SIZE,PSTR,PREL,
* A5:=SEGM OBJ);
BEQ.S EE_SPACE IF NOT OK THEN GOTO SPACE LIMIT END;
NEW_COM EQU *
IF.L CT_HOLD(A2) <EQ> A0 THEN.S IF CTX.HOLDER = HOLDER THEN
MOVE.L OB_SPA(A0),A6 A6:=TOP HOLDER
MOVE.L SP_FREU(A6),CT_STKU(A2) CTX.FREE_CALL_STACK:=
MOVE SP_FREK(A6),CT_STKK(A2) EXT.FREE_SPACE;
ENDI END;
CLR.L D7 D7:=RESULT:=OK;
BRA RET_OLD2 RETURN TO USER; "RELOCATION POSSIBLE"
EE_SPACE EQU * ERROR EXIT,SPACE LIMIT(A0=HOLDER,A2=CTX):
CMP.L CT_HOLD(A2),A0 IF CTX.HOLDER=HOLDER THEN
BEQ EE_PROSP REJECT "PROCESS SPACE LIMIT" END;
BRA EE_OBJSP REJECT "OBJECT SPACE LIMIT";
NEW_SUB EQU * NEW EMBEDDED SUBSEGMENT
* CALL AND RETURN: AS OTHER KERNEL OPERATIONS.
BSR C_TOPOWN CHECK TOP STACK, OWNER(A0:=HOLDER,
* A1:=PSTR,D1:=PREL,A6:=PT);
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
MOVEM.L A1/D1,-(A7) SAVE PSTR,PREL;
BSR C_SUB CHECK SUBSEGM(A1:=PSTR,A5:=BASE SEGM,
* D0:=TOPREL,D1:=PREL,D2:=LENGTH,D4/D5:=);
MOVEM.L (A7)+,A1/D1 RESTORE PSTR,PREL OF FUTURE OWNER;
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
BSR CRE_SUB CREATE SUBSEGM(HOLDER,PSTR,PREL,LENGHT,...
* BASE SEGM,A5:=SUBSEGM);
BEQ EE_SPACE IF NOT OK THEN GOTO SPACE LIMIT END;
BRA NEW_COM GOTO COMMON PART, NEW_SUB/NEW_SEG
PAGE
CRE_SEG EQU * CREATE EMBEDDED SEGMENT
* CALL: RETURN:
* A0 HOLDER SAME (EXT, OPEN, DORMANT, OR GENERAL OBJ)
* A1 POINTER STRUCT SAME (OWNER POINTER)
* A5 - SEGM OBJ
* D0 SIZE (UNROUNDED >0) SAME (SIZE OF USER PART)
* D1 POINTER REL SAME (OWNER POINTER)
* SR - NE=OK, EQ=NOT OK ("NO SPACE" ONLY)
* CREATES AN EMBEDDED SEGMENT IN THE HOLDER OBJECT. THE EMBEDDED SEGMENT
* CONSISTS OF USER PART AND KERNEL PART. THE POINTER BECOMES THE OWNER.
MOVEM.L D0/A4/A6,-(A7) SAVE USER SIZE,A4,A6;
MOVE #SE_SIZ,D0 D0:=SIZE:=SIZE OF SEGM DESCRIPTOR;
BSR MM_PUSHD RESERVE_DESCRIPTOR(HOLDER,SIZE,
* A5:=SEGM OBJ,A6:=TOP OBJ);
IF <NE> THEN.S IF OK THEN
MOVE.L (A7),D0 D0:=SAVED USER SIZE;
ADD.L #255,D0 D0:=SIZE ROUNDED TO MULTIPLE OF 256;
CLR.B D0
BSR MM_PUSHU RESERVE_U_SPACE(HOLDER,SIZE,
* A4:=PHYS ADDR,A6:=TOP OBJ);
IF <EQ> THEN.S IF NOT OK THEN
MOVE #SE_SIZ,D0 D0:=SIZE OF SEGM DESCRIPTOR;
BSR MM_POPD RELEASE_DESCRIPTOR(HOLDER,SIZE,SEGM OBJ)
CMP D0,D0 SR:=EQ; "NOT OK"
ELSE.S ELSE "SPACE SUFFICIENT"
SUB #SE_SIZ,ST_FIR(A1) STRUCT.FIRST_EMB:=...-DESCR_SIZE;
BSR INS_OWN INSERT_OWNER (PSTR,PREL,SEGM OBJ,
* A6:=PT ADDR);
CLR SE_IO(A5) SEGM.IO_COUNT:=0;
MOVE.L A4,SE_FIR(A5) SEGM.FIRST:=PHYS ADDR;
MOVE.L (A7),SE_LEN(A5) SEGM.LENGTH:=USER SIZE; "UNROUNDED"
INIT_HEAD SE_WAIT(A5),A6 IO_LOCK_WAIT:=EMPTY;
INIT_HEAD OB_REF(A5),A6 SEGM.REFERRED_BY:=EMPTY;
CLR OB_RES(A5) SEGM.RESIDENT_COUNT:=0;
MOVE #SE_SIZ,OB_SIZK(A5) SEGM.SIZE_KERNEL_PART:=SIZE OF DESCRIPTOR;
MOVE #OB_SEOB<<8+1<<OB_EMB+1<<OB_READ+1<<OB_WRIT+1<<OB_EXEC,OB_KIN(A5)
* SEGM.KIND,STATE:=...; SR:=NE; "OK"
***
PRT_MEM CRE_SEG,(A5),SE_SIZ
ENDI END "SPACE SUFFICIENT"
ENDI END "DESCRIPTOR RESERVED";
MOVEM.L (A7)+,D0/A4/A6 RESTORE A4,A6, USER SIZE;
RTS RETURN
PAGE
CRE_SUB EQU * CREATE EMBEDDED SUBSEGMENT
* CALL: RETURN:
* A0 HOLDER SAME (EXT,OPEN, OR GENERAL OBJECT)
* A1 POINTER STRUCT SAME (OWNER POINTER)
* A5 BASE SEGM OBJ SUBSEGM OBJ (IF OK)
* D1 POINTER REL SAME (OWNER POINTER)
* D2 LENGTH (UNROUNDED, >0) UNDEF
* D4 CAPS UNDEF (READ,WRITE,EXECUTE AS IN OB_STA)
* D5 FIRST REL UNDEF
* SR - NE = OK, EQ = NOT OK ("NO SPACE" ONLY)
* CREATES AN EMBEDDED SUBSEGMENT DESCRIPTOR WHICH REFERS TO A PART
* OF THE BASE SEGMENT. THE POINTER BECOMES THE OWNER POINTER.
MOVEM.L A4-A6,-(A7)
MOVE #SU_SIZ,D0 D0:=SIZE OF SUBSEGM DESCR;
BSR MM_PUSHD RESERVE_DESCRIPTOR(HOLDER,SIZE,
* A5:=SUBSEGM,A6:=TOP OBJ);
IF <NE> THEN.S IF OK THEN
SUB #SU_SIZ,ST_FIR(A1) STRUCT.FIRST_EMB:=...-DESCR_SIZE;
BSR INS_OWN INSERT_OWNER(PSTR,PREL,SUBSEGM,
* A6:=PT ADDR);
CLR SE_IO(A5) SUBSEGM.IO_COUNT:=0;
MOVE.L 4(A7),A4 A4:=BASE SEGMENT OBJ;
MOVE.L A5,4(A7) STACK.A5:=SUBSEGM;
ADD.L SE_FIR(A4),D5 D5:=SUBSEGM.FIRST:=FIRST REL
MOVE.L D5,SE_FIR(A5) + BASE SEGM.FIRST;
MOVE.L D2,SE_LEN(A5) SUBSEGM.LENGTH:=LENGTH;
INIT_HEAD SE_WAIT(A5),A6 IO_LOCK_WAIT:=EMPTY;
MOVE.L A4,SU_REF(A5) SUBSEGM.BASE:=BASE SEGM;
MOVE.B #PT_SEG,SU_KIN(A5) SUBSEGM.KIND:=REF FROM SUBSEGM;
INIT_HEAD OB_REF(A5),A6 SUBSEGM.REFERRED_BY:=EMPTY;
CLR OB_RES(A5) SUBSEGM.RESIDENT_COUNT:=0;
MOVE #SU_SIZ,OB_SIZK(A5) SUBSEGM.SIZE_KERNEL_PART:=DESCR SIZE;
ADD #OB_SEOB<<8+1<<OB_EMB+1<<OB_SUB,D4
MOVE D4,OB_KIN(A5) D4:=SUBSEGM.KIND:=...+CAPS;
LEA OB_REF(A4),A4 A4:=BASE_SEGM.REFERRED_BY;
LEA SU_P(A5),A5 A5:=SUBSEGM.BASE SEGM;
INS_ELEM A4,A5,A6,A4/A6 INSERT(HEAD=BASE SEGM, NEW = SUBSEGM,
* A6:=PREV); SR:=NE; "OK"
LEA -SU_P(A5),A5 A5:=SUBSEGM;
ENDI END "OK";
***
PRT_MEM CRE_SUB,(A5),SU_SIZ
MOVEM.L (A7)+,A4-A6 RESTORE A4,A5 (=SUBSEGM),A6
RTS
PAGE
MAKE_REENT EQU * MAKE GENERAL OBJECT REENTRANT
* CALL AND RETURN: AS OTHER KERNEL OPERATIONS.
BSR C_PRIM CHECK PRIMARY ENV(A0:=OBJ,
* A1/A5/A6/D1/D2/D4/D5:=...)
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
BSET.B #OB_REEN,OB_STA(A0) OBJ.REENTRANT:=TRUE
CLR.L D7 D7:=RESULT:=OK;
BRA RET_FAST RETURN TO USER;
SET_CALL_STK EQU * SET CALL STACK FOR GENERAL OBJECT
* CALL AND RETURN: AS OTHER KERNEL OPERATIONS.
BSR C_PRIM CHECK PRIMARY ENV(A0:=OBJ,A5:=TOP ENV
* A1/A6/D1/D2/D4/D5:=...);
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
* CHECK THAT NO OBJECT IS MANAGED BY THIS OBJECT: PREVENT TERM STACK VIOLATE.
MOVE #EN_SIZ,D5
WHILE D5 <NE> EN_TOPL(A5) DO.S FOR ALL LOCALS IN TOP ENV DO
CMP.B #PT_MAN,PT_KIN(A5,D5) IF LOCAL.KIND = MAN_SET
BEQ EE_STATE THEN REJECT END;
ADD #PT_SIZ,D5
ENDW END;
LEA GE_EX(A0),A3 A3:=HEAD EXECUTED BY;
MOVE.L (A3),A6 A6:=FIRST CTX EXECUTED;
WHILE.L A6 <NE> A3 DO.S FOR ALL CONTEXTS EXECUTED DO
MOVE #CT_SIZ+PT_SIZ,D3 D3:=T(1);
WHILE D3 <NE> CT_TOPT(A6) DO.S FOR ALL TEMPS IN CTX DO
CMP.B #PT_MAN,PT_KIN(A6,D3) IF TEMP.KIND=MAN_SET
BEQ EE_STATE THEN REJECT END;
ADD #PT_SIZ,D3
ENDW END "FOR ALL TEMPS"
MOVE.L (A6),A6 A6:=CTX:=NEXT(CTX);
ENDW END "FOR ALL CONTEXTS"
BSR C_SIZ CHECK SIZE(D0/D1:=SIZE);
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
MOVE.L D0,GE_STK(A0) OBJ.CALL STACK REQUIREMENT:=SIZE;
MOVE D1,GE_STK+SZ_K(A0)
CLR.L D7 D7:=RESULT:=OK;
BRA RET_FAST RETURN TO USER;
PAGE
CLR_PT EQU * CLEAR POINTER (OF ANY KIND)
* CALL: RETURN:
* A1 POINTER STRUCT SAME (RESTORED THROUGH T(0))
* A2 - IF OWNER POINTER: UNDEF, ELSE: SAME
* A3 CURRENT CTX SAME (UPDATED FOR RELOCATION).
* D1.W POINTER REL SAME
* OTHER REGS: - UNDEF
* T(0): NIL OR REF_ENV SAME (NIL: PT_STR=CTX, REF_ENV: PT_STR=ENV)
* DEPENDING ON POINTER KIND, THE POINTER IS CLEARED AS FOLLOWS:
* SIMPLE: AS CLEAR SIMPLE POINTER (CLR_SMP)
* OWN_SET: ALL OBJECTS IN OWNER SET ARE DELETED. NONE OF THEM ARE EMBEDDED
* SINCE EMBEDDED OBJECTS IN POINTER STRUCT HAVE BEEN DELETED.
* MAN_SET: ALL ENVELOPES IN MAN_SET ARE DEMANAGED AS FOLLOWS: REFS AND
* ACTUALS TO ENV ARE REMOVED, THE ENV IS REMOVED FROM MAN_SET
* AND GETS A DUMMY MANAGER, THE ENV AND POSSIBLE BRANCHES ARE ABORTED.
* INTRPT_PT: DRIVER IS REMOVED.
MOVEQ.L #0,D2
MOVE.B PT_KIN(A1,D1),D2 D2:=POINTER KIND *2;
LSL #1,D2
CASEJMP D2 CASE POINTER KIND OF
CASELAB RETURN NIL: RETURN;
CASELAB CLR_SMP REF_OBJ: CLEAR SIMPLE POINTER; RETURN;
CASELAB CLR_SMP REF_ENV: CLEAR SIMPLE POINTER; RETURN;
CASELAB OWN_4 OWN_SET: "SEE BELOW"
CASELAB MAN_4 MAN_SET: "SEE BELOW"
CASELAB INT_4 INTRPT_PT: "SEE BELOW"
OWN_4 EQU * OWN_SET:
REPEAT REPEAT
MOVE.L 4(A1,D1),A5 A5:=OBJ:=POINTER.LAST_OBJ;
MOVE.L OB_SPA(A5),A6 A6:=TOP OBJ;
LEA SP_ENV(A6),A0 A0:=HEAD OF ENV STACK;
MOVE.L SP_ENV+4(A6),A4 A4:=ENV:=TOP ENVELOPE;
IF.L A0 <NE> A4 THEN.S IF HEAD <> TOP ENVELOPE
LEA -EN_STK(A4),A4 "OFFSET ENV"
TST EN_TERM(A4) AND
IF <GT> THEN.S ENV.TERM_PROC=TERM PROC CALLED THEN
* "TOP ENVELOPE TO BE DELETED. POINTER CAN ONLY BE IN CURRENT CTX".
MOVE D1,-(A7) SAVE POINTER REL;
BSR D_ENV_OK DELETE_ENV(CTX,ENV,A3:=CTX,A5:=OBJ,
* OTHER REGS:=UNDEF);
MOVE (A7)+,D1 RESTORE POINTER REL;
MOVE.L A3,A1 POINTER STRUCT:=CURRENT CTX;
ENDI
ENDI END "DELETE TOP ENVELOPE";
LEA DEL_ARG,A4 A4/D4:=DEFAULT ARG LIST;
MOVE.L #LOW_ARG,D4 CALL NEXT MANAGER(CTX,OBJ,PREL,PSTR,
BSR C_NXT_M ARG,LOWARG,D6/D7:=RESULT,
* A0/A2/A4-A6/D0/D2-D5:=UNDEF);
UNTIL.B PT_KIN(A1,D1) <EQ> #PT_NIL UNTIL POINTER KIND=NIL;
RTS RETURN;
MAN_4 EQU * MAN_SET:
REPEAT REPEAT
MOVE.L 4(A1,D1),A5 A5:=ENV:=POINTER.LAST_ENV;
BSR DUM_ACT DUMMYFY ACTUAL REFS(ENV,A0/A4/A6:=UNDEF);
BSR DUM_ENV DUMMYFY ENV REFS(ENV,A0/A4/A6:=UNDEF);
* "ALSO REMOVES FROM MAN_SET"
CLR EN_TERM(A5) ENV.TERM PROC:=DUMMY;
BSR ABORT_ENV ABORT ENVELOPE(ENV);
* REMOVES ENV FROM MAN_SET. ABORTS POSSIBLE BRANCHES TOO
UNTIL.B PT_KIN(A1,D1) <EQ> #PT_NIL UNTIL POINTER KIND=NIL;
RTS RETURN
INT_4 EQU * INTERRUPT POINTER:
MOVEM.L D1/A1/A3,-(A7) SAVE D1,A1,A3;
LEA (A1,D1),A6 A6:=DRIVER POINTER;
BSR TERMDRIV TERMINATE DRIVER (DRIVPT,D0/D1/A1/A3/A6
* :=UNDEF)
MOVEM.L (A7)+,D1/A1/A3 RESTORE;
RTS RETURN
LOW_ARG DCB.B AR_SIZ,0 DEFAULT ARG LIST: VOID VAL SEGM;
DEL_ARG DS.W 0
PAGE
DEL_EMB EQU * DELETE EMBEDDED OBJECTS (SEGMENTS ONLY)
* CALL: RETURN:
* A1 STRUCTURE SAME (TOP_CTX OR TOP_ENV)
* A3 CURRENT CTX SAME (UPDATED FOR RELOCATION)
* A6 - TOP HOLDING OBJECT (FOR ADDRESSING SPACE DESC
* OTHER: - UNDEF
* T(0): NIL OR REF_ENV SAME (USED FOR RESTORING "STRUCTURE")
* ABORTS ALL EMBEDDED OBJECTS, RELEASES THE USER PART, AND REMOVES
* THE OBJECT FROM THE OWNER SET. FINALLY RELEASES THE KERNEL PARTS.
* IO-POINTERS IN STRUCTURE MUST HAVE BEEN CLEARED PRIOR TO DEL_EMB, SINCE
* OTHERWISE THE IO-LOCK MAY NEVER BE RELEASED.
* USE OF T(0) FOR RESTORING: SEE RSTO_STR.
MOVE ST_FIR(A1),D1 D1:=CUR_REL:=STRUCT.FIRST EMBEDDED;
WHILE <NE> DO.S WHILE MORE EMBEDDED OBJECTS DO
***
PRT_REG DEL_EMB
LEA (A1,D1),A5 A5:=OBJ:=STRUCT+CUR_REL;
BSR.S AB_SEGM ABORT SEGMENT(CTX,OBJ,STRUCT,CUR_REL,
* A1:=STRUCT "USING T(0)",D0:=SIZE KNEL EN
* A5:=OBJ,A0/A2/A4/A6/D2-D5:=UNDEF);
* ALSO RELEASES USER PART OF ROOT SEGMENTS.
BSR DUM_OBJ DUMMYFY OBJECT(OBJ,A0/A4/A6:=UNDEF);
* CLEARS OBJ_REFS TO OBJECT AND REMOVES FROM OWNER SET.
ADD OB_SIZK(A5),D1 D1:=CUR_REL:=...+OBJ.SIZE KNEL PART;
ENDW END;
MOVE ST_FIR(A1),D0 D0:=-SIZE:=STRUCT.FIRST EMBEDDED;
LEA (A1,D0),A5 A5:=FIRST OBJ:=STRUCT+FIRST EMBEDDED;
MOVE.L ST_HOLD(A1),A0 A0:=HOLDER:=STRUCT.HOLDER OBJECT;
NEG D0 D0:=SIZE OF ALL EMBEDDED KNEL PARTS;
BSR MM_POPD RELEASE DESCRIPTORS(HOLDER,FIRST OBJ,SIZE,
* A6:=TOP HOLDER);
MOVE #0,ST_FIR(A1) STRUCT.FIRST_EMB:=0;
RTS RETURN;
PAGE
AB_SEGM EQU * ABORT SEGMENT
* CALL: RETURN:
* A1 STRUCTURE (IF EMBEDDED) SAME OR STRUCTURE RESTORED THROUGH T(0).
* A3 CURRENT CTX SAME (UPDATED FOR RELOCATION)
* A5 SEGMENT OBJECT RESTORED THROUGH T(0) AND "REL".
* D0 - SIZE (OF KERNEL ENVELOPE PART)
* D1 REL SAME (IF < 0: EMBEDDED SEGM)
* OTHER: - UNDEF
* T(0): NIL,REF_ENV,OWN_SET SAME (USED FOR RESTORING SEGM AND STRUCTURE)
* WAITS FOR IO-COUNT TO BECOME ZERO.
* THIS SEGMENT AND THE BRANCH OF SUB-SEGMENTS ARE SEARCHED. ALL SEGMENTS GETS
* ALL SEGMENTS GET USE_BITS=0.(INACCESSIBLE SEGS. ARE EQUIVALENT TO "ABORTED").
* ALL MMU_DESCRIPTORS REFERRING TO THE SEGMENTS ARE DISABLED.
* ALL INTERRUPT POINTERS REFERING TO THE SEGMENTS ARE TERMINATED (BECOMES NIL).
* RESIDENT COUNT OF ALL SEGMENTS ON THE PATH TOWORDS THE ROOT SEGMENT ARE
* DECREASED WITH THE VALUE OF RESIDENT COUNT IN THIS SEGMENT, AND THE POINTER
* TO THE BASE SEGMENT IS CLEARED.
* IF THE SEGMENT IS A ROOT SEGMENT, THE USER PART OF IT IS RELEASED.
* "STRUCTURE" IS ONLY USED FOR EMBEDDED ROOT SEGMENTS AND MUST THEN
* BE THE STACK ELEMENT HOLDING THE EMBEDDED SEGMENT. SEE ALSO RSTO_STR.
***
PRT_REG AB_SEGM
WHILE SE_IO(A5) <NE> #0 DO.S WHILE SEGM.IO_COUNT <> 0 DO
MOVE D1,-(A7) SAVE REL;
LEA SE_WAIT(A5),A1 A1:=IO_CONDITION;
BSR KNELWAIT IO_CONDITION.WAIT(A2:=A3:=CTX,
* OTHER:=UNDEF);
MOVE (A7)+,D1 D1:=RESTORE REL;
BSR RSTO_STR RESTORE STRUCT(CTX,REL,A1:=STRUCT,A5:=SEGM
ENDW END "IO-COUNT";
* "ABORT TREE OF SUBSEGMENTS AND REFS:"
MOVE.L A5,A6 A6:=CUR_SEGM:=SEGM;
AB_NEXT1 EQU * PROCEDURE ABORT_NEXT(CUR_SEGM): "RECURSIVE"
AND.B #-1-(7<<OB_READ),OB_STA(A6) CUR_SEGM.USE_BITS:= NO_USEBITS=0;
LEA OB_REF(A6),A0 A0:=HEAD;
MOVE.L (A0),A2 A2:=CUR_REF:=CUR_SEGM.FIRST REF;
WHILE.L A2 <NE> A0 DO.S WHILE CUR_REF <> HEAD DO
CLR D0
MOVE.B PT_KIN(A2),D0 D0:=CUR_REF.REF_KIND;
***
PRT_REG AB_NEXTREF
LSL #1,D0
CASEJMP D0 CASE REF_KIND OF
CASELAB HALT NIL:
CASELAB NEXT_5 REF_OBJ: "NO ACTION"
CASELAB HALT REF_ENV:
CASELAB HALT OWN_SET:
CASELAB HALT MAN_SET:
CASELAB INT_5 INTERRUPT POINTER:
CASELAB MMU_5 MMU DESCR:
CASELAB SUB_5 SUB_SEGM DESCR:
INT_5 EQU * INTERRUPT POINTER:
MOVEM.L D1/A1/A3/A6,-(A7) SAVE REGISTERS;
MOVE.L A2,A6 A6:=DRIVER PT;
MOVE.L 4(A6),A2 A2:= PT.PREV; "POINTER BECOMES NIL"
BSR TERMDRIV TERMINATE DRIVER(DRIVPT,D0/D1/A1/A3:=?);
MOVEM.L (A7)+,D1/A1/A3/A6 RESTORE;
BRA.S NEXT_5 GOTO NEXT REF;
MMU_5 EQU * MMU DESCR:
CLR MM_REG+6(A2) MMU_DESCR.ENABLE:=DISABLE;
BRA.S NEXT_5 GOTO NEXT REF;
SUB_5 EQU * SUB_SEGM DESCR:
LEA -SU_P(A2),A6 A6:=CUR_SEGM:=SUB_SEGM;
BRA AB_NEXT1 ABORT_NEXT(SUB_SEGM); "SIMULATE CALL"
NEXT_5 EQU * NEXT REF:
MOVE.L (A2),A2 A2:=CUR_REF:=NEXT(CUR_REF)
ENDW END "FOR ALL REFS";
IF.L A6 <NE> A5 THEN.S IF CUR_SEGM <> SEGM THEN
* "SIMULATE RETURN FROM RECURSIVE ABORT_NEXT:"
LEA SU_P(A6),A2 A2:=CUR_REF:=CUR_SEGM.REF ADDR;
MOVE.L SU_REF(A6),A6 A6:=CUR_SEGM:=CUR_SEGM.BASE_SEGM;
LEA OB_REF(A6),A0 A0:=CUR_SEGM.HEAD;
BRA NEXT_5 GOTO NEXT_REF; "RETURN"
ENDI END; "END PROCEDURE ABORT_NEXT"
BTST.B #OB_SUB,OB_STA(A5)
IF <NE> THEN.S IF SEGM IS SUB_SEGM THEN
REM_ELEM SU_P(A5),A2,A6,A2/A6 REM. PT. TO BASE_SEGM. FRM CHAIN AND MAKE
INIT_HEAD SU_P(A5),A6 IT SELF_REF; A6:=PT; PT_REF IS STILL OK;
MOVE.W OB_RES(A5),D0 D0:=RES_COUNT OF SEGM.
IF <GT> THEN.S IF RES_COUNT > 0 THEN "DECR. IN BASE_SEGS"
MOVE.W D1,D3 D3:= SAVE PT_REL;
MOVE.L A3,A4 A4:= SAVE CTX;
MOVE.W #OB_RES,D1 D1:= ADDR OF RESIDENT COUNT
BSR.L INCRDECR DECREASE RESIDENT COUNTS;A3/A6:=?;
MOVE.W D3,D1 D1:= RESTORED PT_REL FROM D3;
MOVE.L A4,A3 A3:= RESTORED CTX FROM A4;
ENDI ENDI;
CLR.L SU_REF(A5) REF TO BASE SEGM:=0; " = NO BASE SEGM"
MOVE #SU_SIZ-OB_SIZ,D0 D0:=SIZE OF SUB_SEGM KERNEL ENVELOPE
ELSE.S ELSE
BTST.B #OB_EMB,OB_STA(A5) "ROOT SEGMENT:"
IF <NE> THEN.S IF SEGM IS EMBEDDED THEN
MOVE.L ST_HOLD(A1),A0 A0:=HOLDER:=STRUCTURE.HOLDER;
ELSE.S ELSE
MOVE.L A5,A0 A0:=HOLDER:=SEGM
ENDI END;
MOVE.L A5,A4 A4:=DESCRIPTOR:=SEGM;
MOVE.L SE_LEN(A4),D0
ADD.L #255,D0 D0:=SEGM.LENGTH ROUNDED TO MULTIPLE 256;
CLR.B D0
BSR MM_POPU RELEASE_U_SPACE(HOLDER,DESCRIPTOR,SIZE,
* A6:=TOP_HOLDER);
MOVE #SE_SIZ-OB_SIZ,D0 D0:=SIZE OF SEGM KERNEL ENVELOPE
ENDI END "ROOT SEGMENT"
RTS RETURN
PAGE
DEL_ENV EQU * DELETE ENVELOPE
* CALL AND RETURN: AS OTHER KERNEL OPERATIONS.
* "GET OWN_SET AND TOP ENVELOPE:"
BSR C_ENT CHECK ENTITY(A1:=PSTR,D1:=PREL,A6:=PT,
* A5:=OBJ,D2:=PTKIND,D4/D5:=...);
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
CMP.B #PT_OWN,D2 IF POINTER KIND <> OWN_SET
BNE EE_VALUE THEN REJECT END;
BTST.B #PT_LSC,PT_INF(A6) IF POINTER SCOPE = LOCAL
BNE EE_SCOPE THEN REJECT END;
MOVE.B OB_KIN(A5),D2 D2:=OBJ.KIND;
BTST.B D2,OBJ_USER IF OBJ.KIND <> GENERAL,OPEN
BEQ EE_STATE THEN REJECT END;
MOVE.L OB_SPA(A5),A6 A6:=TOP OBJ;
MOVE.L SP_ENV+4(A6),A3 A3:=OBJ.TOP ENV;
LEA SP_ENV(A6),A6 A6:=OBJ.ENV STACK HEAD
CMPA.L A6,A3 IF ENV STACK EMPTY
BEQ EE_STATE THEN REJECT END;
LEA -EN_STK(A3),A3 A3:=ENV:="OFFSET TOP ENV";
* "GET MAN_SET:"
BSR C_PT CHECK POINTER(A1:=PSTR,D1:=PREL,A6:=PT,
* D2:=PTKIND);
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
CMPA.L EN_MAN(A3),A1 IF ENV.MANAGER ENV <> POINTER STRUCT
BNE EE_VALUE THEN REJECT END;
CMP EN_OFF(A3),D1 IF ENV.MANAGER PREL <> POINTER REL
BNE EE_VALUE THEN REJECT END;
BSR S_LOC STACK CHECK LOCALS(A2=CTX,A3=ENV,
* A0/A6/D0/D4/D5:=UNDEF);
BEQ RET_FAST IF NOT OK THEN REUTRN TO USER END;
MOVE.L A3,A4 A4:=ENVELOPE;
MOVE.L A2,A3 A3:=CURRENT CTX;
BSR.S D_ENV_OK DELETE ENVELOPE(CTX,ENVELOPE,A5:=OBJ;
* OTHER REGS:=UNDEF);
CLR.L D7 D7:=RESULT:=OK;
BRA RET_OLD3 RETURN TO USER(A3=CTX);"DELETION POSSIBLE"
OBJ_USER DC.B 1<<OB_GEOB+1<<OB_OPOB MASK FOR USER OBJECT KINDS.
DS.W 0
* OBJ_USER MAY INCLUDE 1<<OB_DOOB WHEN SCHEDULER'S ENVELOPES
* ARE HANDLED "CORRECTLY".
PAGE
D_ENV_OK EQU * DELETE ENVELOPE (CHECKS OK)
* CALL: RETURN:
* A3 CURRENT CTX SAME (UPDATED FOR RELOCATION)
* A4 ENVELOPE UNDEF
* A5 - OBJECT HOLDING ENVELOPE
* OTHER REGS: - UNDEF
* T(0): NIL NIL (USED AS REF_ENV DURING D_ENV_OK)
* DUMMYFIES ALL REFS AND ACTUALS REFERRING TO THE ENVELOPE.
* REMOVES THE ENVELOPE FROM THE MAN_SET (AND GIVES IT A DUMMY MANAGER).
* ABORTS THE ENVELOPE (EXCLUDING POSSIBLE BRANCHES).
* CLEARS POSSIBLE LOCAL IO_LOCKS AND DELETES EMBEDDED SEGMENTS.
* CLEARS ALL LOCAL POINTERS (THIS WILL ABORT POSSIBLE BRANCHES).
* RELEASES ENV SPACE.
* IF THE OBJECT HOLDING THE ENVELOPE IS A GENERAL OBJECT, IT BECOMES AN OPEN OB
* T(0) OF CURRENT CTX IS USED TO KEEP TRACK OF THE ENV DURING DELETION.
MOVE.L A4,A5 A5:=ENV;
BSR DUM_ACT DUMMYFY ACTUAL REFS(ENV,A0/A4/A6:=UNDEF);
BSR DUM_ENV DUMMYFY ENV REFS(ENV,A0/A4/A6:=UNDEF);
* "ALSO REMOVES FROM MAN_SET"
BSR ABORT_ONE ABORT_ONE(ENV);
LEA CT_SIZ(A3),A6 A6:=PT_ADDR:=T(0);
MOVE #PT_ENV,D5 D5:=ENTITY KIND:=REF_ENV;
BSR COPY_NIL COPY TO NIL(A5=ENV,PT ADDR,ENT KIND,
* A1/D4:=UNDEF);
MOVE.L A5,A1 A1:=ENV;
TST EN_IO(A4) "CLEAR POSSIBLE IO-LOCKS:"
IF <NE> THEN.S IF ENV.IO_COUNT <> 0 THEN
MOVE #EN_SIZ,D1 D1:=CUR_LOCAL:=ENV.LOC(1);
WHILE D1 <NE> EN_TOPL(A1) DO.S FOR D1:=ALL LOCALS IN ENV DO
* IF LOCAL IS SIMPLE THEN
IF.B PT_KIN(A1,D1) <LE> #PT_ENV THEN.S "DRIVER POINTERS MAY BE PRESENT"
BSR CLR_SMP CLEAR SIMPLE PT(PSTRUCT=ENV,PREL,A6:=PT);
ENDI END;
ADD #PT_SIZ,D1 D1:=CUR_LOCAL:=NEXT
ENDW END "FOR ALL LOCALS";
ENDI END "IO COUNT <> 0";
BSR DEL_EMB DELETE EMBEDDED (A1=ENV,CTX,
* A0/A2/A4-A6/D0-D7:=UNDEF);
* "MAY RESTORE A1 THROUGH T(0)"
* "CLEAR ALL LOCAL POINTERS:"
MOVE #EN_SIZ,D1 D1:=CUR_LOCAL:=ENV.LOC(1)
WHILE D1 <NE> EN_TOPL(A1) DO.S FOR D1:=ALL LOCALS IN ENV DO
BSR CLR_PT CLEAR POINTER(PSTRUCT=ENV,CTX,PREL,
* A0/A2/A4-A6/D0/D2-D7:=UNDEF);
* "MAY RESTORE A1=ENV THROUGH T(0)"
ADD #PT_SIZ,D1 D1:=NEXT LOCAL;
ENDW END "FOR ALL LOCALS";
REM_ELEM CT_SIZ(A3),A4,A5,A4/A5 REMOVE (T(0),A4:=NEXT,A5:=PREV);
CLR.B PT_KIN+CT_SIZ(A3) T(0).KIND:=NIL;
MOVE.L EN_OBJ(A1),A5 A5:=OBJECT HOLDING ENV;
EXG.L A1,A3 A3:=ENV, A1:=CTX;
BSR MM_POPK RELEASE STACK ELEMENT(A3=ENV,A3:=PREV,
* A6:=TOP OBJ);
MOVE.L A1,A3 A3:=CTX;
IF.B OB_KIN(A5) <EQ> #OB_GEOB THEN.S
MOVE.L A5,A0 IF OBJ.KIND=GENERAL OBJECT THEN
MOVE #GE_SIZ-OB_SIZ,D0
BSR MM_POPO RELEASE KERNEL ENV(A0=OBJ,D0=SIZE,
MOVE.B #OB_OPOB,OB_KIN(A5) A6:=TOP OBJ); OBJ.KIND:=OPEN OBJECT
ENDI END;
RTS RETURN;
PAGE
DEALLOC EQU * DEALLOCATE OBJECT
* CALL AND RETURN: AS OTHER KERNEL OPERATIONS.
BSR C_PT CHECK POINTER(A6:=PT,D2:=PT KIND,
* A1/D1:=...);
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
CMP.B #PT_OWN,D2 IF POINTER KIND <> OWN SET
BNE EE_VALUE THEN REJECT END;
MOVE.L A6,D0 D0:=OWN PT ADDR;
MOVE.L D4,D3 D3:= LOWARG;
BSR C_ENT CHECK ENTITY(A5:=OBJ,D5:=ENT KIND,
* A1/A6/D1/D2/D4:=...);
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
MOVE.L D3,D4 D4:= LOWARG;
CMP.B #PT_OBJ,D5 IF ENTITY KIND <> OBJECT
BNE EE_VALUE THEN REJECT END;
SUB.L OB_OWN(A5),D0 IF OBJ.OWNER <> OWN PT ADDR
CMP OB_OFF(A5),D0 THEN REJECT END;
BNE EE_VALUE
BTST.B #OB_EMB,OB_STA(A5) IF OBJECT EMBEDDED
BNE EE_VALUE THEN REJECT END;
MOVE.L A2,A3 A3:=CURR CTX;
BSR.S C_NXT_M CALL NEXT MANAGER(CTX,ARG,OBJ,
* LOW ARG,PREL=NONSENSE,D6/D7:=RESULT,
* A0-A2/A4-A6/D0/D2-D5:=UNDEF);
BRA RET_OLD3 RETURN TO USER;
PAGE
C_NXT_M EQU * CALL NEXT MANAGER AND DELETE OBJECT
* CALL: RETURN:
* A1 POINTER STRUCTURE RESTORED THROUGH T(0)
* A3 CURRENT CTX SAME (UPDATED FOR RELOCATION)
* A4 ARGUMENT ADDR (PHYS) UNDEF
* A5 OBJECT TO BE DELETED UNDEF (ONLY NON-EMBEDDED OBJECTS ALLOWED)
* D1.W POINTER REL SAME (POINTER WHICH OWNED OBJECT)
* D4 LOW ARG ADDR (PHYS) UNDEF
* D6 ARGUMENT# UPDATED OR RESULT RETURNED BY TOP MANAGER
* D7 - REJECT RESULT OR RESULT RETURNED BY TOP MANAGE
* T(0): NIL OR REF_ENV SAME (IF REF_ENV, OBJ IS OWNED BY THAT ENV)
* OTHER REGS: - UNDEF
* CALLS THE NEXT MANAGER (IF ANY) AND EVENTUALLY DELETES THE OBJECT:
* IF THE OBJECT IS OF KERNEL TYPE, THE KERNEL TERMINATION PROCEDURE IS CALLED
* AND THE OBJECT BECOMES "OPEN". DURING THIS, THE OBJECT IS OWNED BY T(0)
* OR THE ENVELOPE SPECIFIED BY (T(0).
* NEXT, IF THE OBJECT HAS NO MORE ENVELOPES, IT IS ACTUALLY DELETED, USING
* AGAIN T(0) TO GIVE POINTER ACCESS TO IT.
* OTHERWISE, IF THE OBJECT HAS MORE ENVELOPES, THE NEXT MANAGER IS CALLED
* AND AT RETURN, DEL_CTX WILL TAKE CARE OF CONTINUEING DELETION.
* ALSO A DUMMY MANAGER WILL BE "CALLED" USING A CONTEXT TO HANDLE DEL_ENV.
MOVE D1,-(A7) SAVE POINTER REL;
MOVEQ #0,D2
MOVE.B OB_KIN(A5),D2 D2.W:=OBJ.KIND;
***
PRT_REG C_NXT_M
BTST.B D2,OBJ_USER IF NOT USER OBJECT "GENERAL,OPEN"THEN
IF <EQ> THEN "KERNEL OBJECTS:"
IF.B PT_KIN+CT_SIZ(A3) <EQ> #PT_NIL THEN.S "ESTABLISH POINTER ACCESS TO OBJ:
MOVE.L A3,A1 IF T(0).KIND = NIL THEN
MOVE #CT_SIZ,D1 A1:=NEW PSTR:=CTX; D1:=NEW PREL:=T(0);
BSR S_MOVE MOVE_STACK_CHECK(NEW PSTR,NEW PREL,OBJ);
BEQ RET_C_NXT IF NOT OK THEN RETURN END;
BSR M_OWN_OK MOVE OWNER(NEW PSTR,NEW PREL,OBJ,A6:=PT);
ENDI END "T(0) IS NOW REF_ENV OR OWN_SET";
* "PERFORM KERNEL TERMINATION PROCEDURE:"
LSL #1,D2 D2:=OBJECT KIND *2;
CASEJMP D2 CASE OBJECT KIND OF
CASELAB HALT GENERAL OBJECT:
CASELAB GATE_TERM
CASELAB COND_TERM
CASELAB HALT OPEN OBJECT
CASELAB DORM_TERM
CASELAB PROC_TERM
CASELAB HALT EXTENSION OBJECT
CASELAB SEGM_TERM
CASELAB HALT ALLOCATE
CASELAB HALT SCHEDULER
GATE_TERM EQU * GATE DELETE:
MOVE.L A5,A0 A0:=GATE;
BSR TERMGATE TERMINATE GATE(A0=GATE);
MOVE #GA_SIZ-OB_SIZ,D0 D0:=SIZE OF KERNEL ENVELOPE;
BRA.S D_K_ENV GOTO DELETE KERNEL ENVELOPE;
COND_TERM EQU * CONDITION DELETE:
MOVE.L A5,A0 A0:=CONDITION;
BSR TERMCOND TERMINATE CONDITION(A0=CONDITION);
MOVE #CO_SIZ-OB_SIZ,D0 D0:=SIZE OF KERNEL ENVELOPE;
BRA.S D_K_ENV GOTO DELETE KERNEL ENVELOPE;
PROC_TERM EQU * PROCESS DELETE:
* CHECK AGAINST SELF-DELETE WAS DONE AS PART OF MOVING OWNER-SHIP.
LEA PR_TERM(A5),A1 A1:=PROC TERM CONDITION;
MOVE.L A3,A2 A2:=CURRENT CTX;
BSR KNELWAIT PROC_TERM.WAIT(A3:=CTX,OTHERS:=UNDEF)
MOVE (A7),D1 D1:=POINTER REL;
BSR RSTO_STR RESTORE STRUCT(CTX,REL,A1:=STRUCT,A5:=OBJ)
DORM_TERM EQU * DORMANT DELETE:
MOVE #PR_SIZ-OB_SIZ,D0 D0:=SIZE KERNEL ENVELOPE;
BRA.S D_K_ENV GOTO DELETE KERNEL ENVELOPE;
SEGM_TERM EQU * SEGMENT DELETE: "CANNOT BE EMBEDDED"
MOVE (A7)+,D1 D1:=RESTORE POINTER REL; "OBS: MAX STACK"
BSR AB_SEGM ABORT SEGM(CTX,OBJ,POINTER REL, PSTR,
* D0:=SIZE OF KERNEL ENVELOPE,
* A0/A2/A4/A6/D2-D7:=UNDEF);
MOVE D1,-(A7) SAVE POINTER REL;
D_K_ENV EQU * DELETE KERNEL ENVELOPE:
MOVE.L A5,A0 A0:=OBJ;
BSR MM_POPO RELEASE KERNEL ENV(OBJ,SIZE,A6:=TOPOBJ)
MOVE #OB_OPOB<<8,OB_KIN(A5) OBJ.KIND,STATE:=OPEN OBJECT;
MOVE.L #LOW_ARG,D4 A4/D4:=DEFAULT ARG LIST;
LEA DEL_ARG,A4
* "THE FOLLOWING CORRESPONDS TO KERNEL_TERM PERFORMING DEALLOC(OBJ):"
* "TERM STACK CHECK HAS BEEN DONE PREVIOUSLY".
ENDI END "KERNEL OBJECTS";
MOVE.L OB_SPA(A5),A6 A6:=TOP OBJ;
MOVE.L SP_ENV+4(A6),A2 A2:=OBJ.TOP ENV;
LEA SP_ENV(A6),A6 A6:=OBJ.ENV STACK HEAD;
IF.L A6 <EQ> A2 THEN.S IF NO MORE ENVELOPES THEN
* "DELETE OBJECT:"
IF.B PT_KIN+CT_SIZ(A3) <EQ> #PT_NIL THEN.S "ESTABLISH POINTER ACCESS TO OBJ:"
MOVE.L A3,A1 IF T(0).KIND = NIL THEN
MOVE #CT_SIZ,D1 A1:=NEW PSTR:=CTX; D1:=NEW PREL:=T(0);
BSR M_OWN_OK MOVE OWNER(NEW_PSTR,NEW_PREL,OBJ,A6:=PT)
ENDI END "T(0) IS NOW REF_ENV OR OWN_SET";
TAS.B MM_LOCK LOCK THE MM_LOCK;
IF <NE> THEN.S IF LOCKED ALREADY THEN
LEA MM_QUEUE,A1 A1:=MM_QUEUE;
MOVE.L A3,A2 A2:=CUR_CTX;
BSR KNELWAIT MM_QUEUE.WAIT(A3:=CTX,OTHERS:=UNDEF);
MOVE (A7),D1 D1:=SAVED POINTER REL;
BSR RSTO_STR RESTORE STRUCT(CTX,REL,A1:=STRUCT,A5:=OBJ)
ENDI END;
BSR DUM_OBJ DUMMYFY OBJ(OBJ,A0/A4/A6:=UNDEF);
* CLEARS OBJ_REFS TO OBJECT AND REMOVES FROM OWN_SET. T(0) IS NOW NIL OR REF_EN
MOVE.L A5,A1 A1:=OBJECT;
BSR MM_TERM RELEASE OBJ SPACE(OBJ,A0/D0/D1:=UNDEF);
LEA MM_QUEUE,A1 A1:=MM_QUEUE;
BSR KNELSIGN MM_QUEUE.SIGNAL(A4/A5/A6:=UNDEF);
IF <NE> THEN.S IF NO PROC SCHEDULED THEN
BCLR.B #7,MM_LOCK OPEN MM_LOCK
ENDI END;
* D7:=RESULT:=OK IS SET AFTER 'ELSE'
ELSE ELSE "CALL TOP MANAGER:"
* T(0) IS NIL, REF_ENV OR OWN_SET (AFTER DELETE KERNEL ENVELOPE).
LEA -EN_STK(A2),A2 A2:=ENV:="OFFSET TOP ENV";
***
PRT_MEM TERM_ENV,(A2),EN_SIZ
MOVE EN_TERM(A2),D5 D5:=FUNCTION:=ENV.TERM_PROC;
IF <GT> THEN.S IF TERM PROC CALLED THEN
ADDQ.L #2,A7 POP PT_REL; "ONLY POSSIBLE WHEN DEALLOC
BRA ER_STATE GOTO REJECT; IS CALLED EXPLICIT ??"
ENDI ENDI;
MOVEM.L A2/A5,-(A7) SAVE ENV, OBJ;
IF <EQ> THEN.S IF DUMMY TERM PROC THEN
MOVE.L #DUM_MAN,A5 A5:=MANAGER OBJ:=DUMMY MANAGER
ELSE.S ELSE
MOVE.L EN_MAN(A2),A1 A1:=MANAGER STRUCT;
MOVE EN_OFF(A2),D1 D1:=MANAGER PT REL;
BTST.B #PT_LSC,PT_INF(A1,D1)
IF <EQ> THEN.S IF NON LOCAL MAN_SET THEN
MOVE.L #DUM_MAN,A5 A5:=MANAGER OBJ:=DUMMY MANAGER
ELSE.S ELSE
MOVE.L EN_OBJ(A1),A5 A5:=MANAGER OBJ:=MANAGER STRUCT.OBJECT;
ENDI END;
ENDI END "A5 = MANAGER OBJ";
* "CREATE CTX AND SET FORMALS:"
MOVE.L A3,A2 A2:=CUR_CTX;
MOVE.L CT_HOLD(A2),A0 A0:=CUR_CTX.EXTENSION_OBJ;
MOVE #2,D3 D3:=ADDITIONAL FORMALS:=2;
BSR CRE_CTX CREATE_CTX(...,A3:=NEW_CTX,D4:=ENTRY);
MOVEM.L (A7)+,D0/D2 D0:=RESTORE ENV; D2:=RESTORE OBJ;
BEQ R2_C_NXT IF NOT OK THEN RETURN END;
MOVE CT_TOPT(A3),D1 D1:=NEW_CTX.F(1);
MOVE.L D0,PT_REF+FP_SIZ(A3,D1) F(2).REF:=ENV; "POINTER MADE LATER"
MOVE.L D2,PT_REF(A3,D1) F(1).REF:=OBJ; "POINTER MADE LATER"
EXT.L D5 D5.L:=FUNCTION;
BSR SAVE_STK SAVE SUPV STACK(CTX,ENTRY,FUNCTION,
* A5/A6:=UNDEF);
BSR SET_FP SET_FORMALS(EXT,CTX,NEW CTX,ARG ADDR,
* ADDITIONAL FORMALS, ARG#,D3:=FORMALS,
* A1/A5/A6/D0-D2/D4/D5:=UNDEF)
IF <NE> THEN.S IF OK THEN
MOVE CT_TOPT(A3),D1 D1:=NEW PREL:=NEW_CTX.F(1);
MOVE.L A3,A1 A1:=NEW PSTR:=NEW_CTX;
MOVE.L PT_REF(A1,D1),A5 A5:=OBJ:=F(1).REF; "OBJ TO DELETE"
BSR S_TERM STACK CHECK TERM(NEW PSTR,NEW PREL,OBJ);
IF <NE> THEN.S IF OK THEN
* "SET F(1), F(2):"
BSR M_OWN_OK MOVE OWNER(NEW PSTR,NEW PREL,OBJ,A6:=PT);
CLR.L FP_STR(A1,D1) F(1).ACTUAL:=DUMMY;
MOVE.L PT_REF+FP_SIZ(A1,D1),A5 A5:=ENV:=F(2).REF;
MOVE #PT_ENV,D5 D5:=ENTITY KIND:=REF_ENV;
CLR D4 D4:=CAPS:=O;
LEA FP_SIZ(A1,D1),A6 A6:=F(2);
CLR.L FP_STR(A6) F(2).ACTUAL:=DUMMY;
BSR COPY_NIL COPY TO NIL(F(2),ENV,REF_ENV,A1:=UNDEF);
MOVE #1,EN_TERM(A5) ENV.TERM_PROC:=TERM PROC CALLED;
* "SET FORMAL ARGUMENTS:"
IF.L A4 <EQ> #LOW_ARG THEN.S IF ARG LIST = DEFAULT THEN
MOVE.L #-1,D2 D2:=DEALLOC MODE:=IMPLICIT; "-1"
ELSE.S ELSE
CLR D2 D2:=DEALLOC MODE:=EXPLICIT; "0"
ENDI END;
CLR.L D4 PREPARE DIVIDE;
MOVE EN_OFF(A5),D4 D4:=MANAGER INDEX:=
SUB #EN_SIZ-PT_SIZ,D4 (ENV.MAN OFFSET-L(0))/POINTER_SIZE;
DIVU #PT_SIZ,D4 "NOT USED FOR TEMP MAN_SETS"
MOVE.L (A3,D1),A1 A1:=OBJ:=F(1).FIRST; "OBJ TO DELETE"
CLR D5
MOVE OB_SIZK(A1),D5 D5.L:=TOTAL BYTES IN OBJ:=
MOVE.L OB_SPA(A1),A6 SIZE KERNEL PART +
ADD.L SP_SIZU(A6),D5 TOP OBJ.SIZE USER PART;
BSR ENT_CTX ENTER CONTEXT(A3=CTX,D2,D3,D4,D5=...);
* "CONTINUES HERE AT OBJ_RETURN.A3=CTX"
BSR RET_FP
ENDI END "STACK CHECK OK";
ENDI END "SET FORMALS OK";
BSR DEL_CTX DELETE_CTX(CTX,A3:=OLD CTX,A0:=EXT);
* "CONTINUES OBJECT DELETION ONLY AFTER A SUCCESSFUL CALL OF TERM PROC.
* IN OTHER CASES, F(1) IS NOT YET OWN_SET."
BSR RSTO_STK RESTORE SUPV STACK AND USP(OLD CTX);
ENDI END "CALL TOP MANAGER";
* AT PRESENT DEALLOC WILL IGNORE THE RESULT OF THE CALLED MANAGERS
* AND ALWAYS RETURN 'OK' IF THE OBJECT WAS DEALLOCATED.
MOVEQ.L #0,D7 D7:=RESULT:= OK;
RET_C_NXT EQU * RETURN FROM C_NXT_M:
MOVE (A7)+,D1 D1:=RESTORE POINTER REL;
BSR RSTO_STR RESTORE STRUCT (CTX,PREL,A1:=PSTR,
* A5:=UNDEF "NORMALLY A5:=OBJ");
RTS RETURN;
R2_C_NXT EQU * RETURN FROM C_NXT_M, A2=CTX:
MOVE.L A2,A3 A3:=CUR_CTX;
BRA.S RET_C_NXT GOTO RETURN;
HALT STOP #$2717 HALT: STOP "KERNEL ERROR"
BRA HALT
* * * * THIS DATA STRUCTURE SHOULD BE MOVED TO SECTION 7
* * * * AND INITIALIZED IN SECTION 11
DUM_MAN EQU * DUMMY MANAGER OBJECT:
DS.W MEMBER OWNER:
DS.W 1
DS.W CHAIN REFERRED BY:
DC.W 0 RESIDENT COUNT:
DC.W 0 SIZE OF KERNEL PART:
DC.B OB_GEOB OBJECT KIND: GENERAL OBJECT
DC.B 1<<OB_ABOR OBJECT STATE: ABORTED
DS.L 1 SPACE DESCR: "ABSENT, NOT USED"
DC.L * EXECUTED BY:=
DC.L *-4 EMPTY
DC.W 0 CONTROL PROCEDURE: DUMMY
DC.W 1 TEMP POINTERS: 1 "T(0)"
DC.L 2 TEMP STACK: > 0, EVEN
DC.L 0 REQUIRED FREE CALL STACK: 0
DC.W 0
DC.L $200000 LOGICAL ADDRESS FOR TEMP STACK:
DC.L 0 ENTRY ADDRESS:
* CHECK LENGTH OF OBJECT AT ASSEMBLY TIME.
IFNE *-DUM_MAN-GE_SIZ
FAIL *-DUM_MAN-GE_SIZ
ENDC
PAGE
RSTO_STR EQU * RESTORE STRUCTURE HOLDING DELETING OBJECT
* CALL: RETURN:
* A1 - POINTER STRUCT (CTX OR T(0).ENV)
* A3 CTX SAME
* A5 - OBJECT (NONSENSE IF T(0) IS NIL)
* D1.W REL SAME (PT_REL IN T(0).ENV OR REL OF EMB OBJ)
* T(0): NIL,REF_ENV,OR OWN_SET SAME
* USES T(0) TO FIND THE STRUCTURE WHICH HOLDS/HELD AN OBJECT.
* FINDS THE OBJECT IF IT STILL EXISTS.
* RESTORING IS DONE A FOLLOWS: (USED IN CALL PATH:)
* T(0)=NIL, REL <0: STRUCT:=CTX, OBJ:=CTX+REL (DEL_CTX, DEL_EMB, AB_SEGM)
* REL >0: STRUCT:=CTX, OBJ:=NONSENSE (DEL_CTX, CLR_PT, C_NXT_M)
* (DEALLOC, C_NXT_M)
* T(0)=OWN, REL <0: STRUCT:=CTX, OBJ:=CTX+REL (NOT USED)
* REL >0: STRUCT:=CTX, OBJ:=T(0).LAST (DEL_CTX,CLR_PT,C_NXT_M,AB_SEGM)
* (DEALLOC, C_NXT_M, AB_SEGM)
* T(0)=ENV, REL <0: STRUCT:=ENV, OBJ:=ENV+REL (D_ENV_OK, DEL_EMB, AB_SEGM)
* REL >0: STRUCT:=ENV, OBJ:=ENV(REL).LAST (D_ENV_OK,CLR_PT,C_NXT_M)
IF.B CT_SIZ+PT_KIN(A3) <EQ> #PT_ENV THEN.S
MOVE.L CT_SIZ+PT_REF(A3),A1 IF T(0)=REF_ENV THEN A1:=STRUCT:=T(0).ENV
MOVE.L 4(A1,D1),A5 A5:=OBJ:=STRUCT(REL).LAST_OBJ;
ELSE.S ELSE
MOVE.L A3,A1 A1:=STRUCT:=CTX;
MOVE.L CT_SIZ+4(A3),A5 A5:=OBJ:=T(0).LAST_OBJ;
* "NONSENSE WHEN T(0) IS NIL"
ENDI END;
TST D1 IF REL < 0 THEN
IF <LT> THEN.S "EMBEDDED OBJECT:"
LEA (A1,D1),A5 A5:=OBJ:=STRUCT+REL;
ENDI END;
***
PRT_REG RSTO_STR
RTS RETURN
TTL POINTER MANIPULATION
PAGE
COPY EQU * COPY
* CALL AND RETURN: AS OTHER KERNEL OPERATIONS.
BSR C_ENT CHECK ENTITY(A5:=ENTITY,D4:=CAPS,
* D5:=ENTITY KIND, A1/A6/D1/D2:=...);
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
SET_SIMPLE EQU * SET SIMPLE REF: "COMMON WITH FIRST IN SET"
BSR C_PT CHECK POINTER(A1:=PSTR,D1:=PREL,D2:=PTKIND
* A6:=...);
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
CMP.B #PT_ENV,D2 IF PT KIND > REF_ENV "NOT SIMPLE"
BGT EE_VALUE THEN REJECT END;
STO_SIMPLE EQU * STORE SIMPLE REF: "COMMON WITH NEXT IN SET"
BSR.S CLR_SMP CLEAR SIMPLE(PSTR,PREL,A6:=PT ADDR);
BSR COPY_NIL COPY TO NIL(ENTITY,PT ADDR,CAPS,ENT KIND);
CLR.L D7 D7:=RESULT:=OK;
BRA RET_FAST RETURN TO USER;
PAGE
CLR_SMP EQU * CLEAR SIMPLE POINTER
* CALL: RETURN:
* A1 POINTER_STRUCT SAME
* A6 POINTER (NIL, REF_ENV, REF_OBJ)
* D1 POINTER_REL SAME
* MAKES THE SIMPLE POINTER NIL. UPDATES IO-COUNT AND RESIDENT COUNT.
LEA (A1,D1),A6 A6:=POINTER ADDR;
TST.B PT_KIN(A6)
IF <NE> THEN IF NOT NIL POINTER THEN
MOVEM.L D0/A4/A5,-(A7) SAVE REGISTERS;
BTST.B #PT_IO,PT_INF(A6)
IF <NE> THEN.S IF IO_POINTER THEN
MOVE.L PT_REF(A6),A5 A5:=OBJ;
SUB #1,ST_IO(A1) POINTER_STRUCT.IO_COUNT:=...-1;
REPEAT REPEAT
SUB #1,SE_IO(A5) SEGM_OBJ.IO_COUNT:=...-1;
IF <EQ> THEN.S IF COUNT = 0 THEN
MOVEM.L A1/A4/A5/A6,-(A7) SAVE REGS;
LEA SE_WAIT(A5),A1 A1:=IO_CONDITION;
REPEAT REPEAT
BSR KNELSIGN IO_CONDITION.SIGNAL(A4/A5/A6:=UNDEF);
UNTIL <NE> UNTIL NO PROCS ACTIVATED;
MOVEM.L (A7)+,A1/A4/A5/A6 RESTORE REGS;
ENDI END;
BTST.B #OB_SUB,OB_STA(A5)
IF <NE> THEN.S IF SUB_SEGM_OBJ THEN
MOVE.L SU_REF(A5),D0 A5:=D0:=OBJ:=BASE_SEGM;
MOVE.L D0,A5
ENDI END;
UNTIL <EQ> UNTIL NO_BASE_SEGMENT;
ENDI END "IO_POINTER HANDLING";
BTST.B #PT_RES,PT_INF(A6)
IF <NE> THEN.S IF RESIDENT POINTER THEN
MOVE.L PT_REF(A6),A5 A5:=OBJ OR ENV;
IF.B #PT_ENV <EQ> PT_KIN(A6) THEN.S IF PT_KIND = ENV_REF THEN
SUB #1,EN_RES(A5) ENV.RES_COUNT:=...-1
ELSE.S ELSE
REPEAT REPEAT
SUB #1,OB_RES(A5) OBJ.RES_COUNT:=...-1;
BTST.B #OB_SUB,OB_STA(A5)
IF <NE> THEN.S IF SUB_SEGM_OBJ THEN
MOVE.L SU_REF(A5),D0 A5:=D0:=OBJ:=BASE_SEGM;
MOVE.L D0,A5
ENDI END;
UNTIL <EQ> UNTIL NO_BASE_SEGMENT;
ENDI END;
ENDI END "RESIDENT POINTER HANDLING";
MOVEQ #-1-1<<PT_CC-1<<PT_CON-1<<PT_IO-1<<PT_RES,D0
AND.B D0,PT_INF(A6) POINTER.CAPABILITIES:=0;
CLR.B PT_KIN(A6) POINTER.KIND:=NIL;
REM_ELEM (A6),A4,A5,A4/A5 REMOVE FROM REFERRED_BY(POINTER);
MOVE.L A6,(A6) POINTER.CHAIN:=SELF_REF;
MOVE.L A6,4(A6)
MOVEM.L (A7)+,D0/A4/A5 RESTORE REGISTERS;
ENDI END "NOT NIL POINTER";
RTS RETURN
PAGE
COPY_NIL EQU * COPY SIMPLE REF TO NIL POINTER
* CALL: RETURN:
* A5 ENTITY (ENV OR OBJ) SAME
* A6 POINTER SAME
* D4.B CALL_CAP,COPY_CONTROL UNDEFINED
* D5.B ENT_KIND (FUTURE PT_KIN) SAME
* A1 - UNDEFINED
* CREATES A SIMPLE REF IN THE POINTER, WHICH MUST BE NIL AT CALL TIME.
* ENT_KIND CAN BE NIL, ENV, OR OBJ.
***
PRT_REG COPY_NIL
OR.B D4,PT_INF(A6) POINTER.CALL_CAP:=CALL_CAP
CLR D4 POINTER.COPY_CONTROL:=COPY_CONTROL
MOVE.B D5,D4 D4:=ENTITY KIND *2; "WORD"
LSL #1,D4
CASEJMP D4 CASE ENTITY KIND OF
CASELAB NIL_1
CASELAB OBJ_1
CASELAB ENV_1
OBJ_1 EQU * OBJECT:
LEA OB_REF(A5),A1 A1:=HEAD:=OBJ.REFERRED_BY;
BRA.S COM_1 GOTO COMMON;
ENV_1 EQU * ENVELOPE:
LEA EN_REF(A5),A1 A1:=HEAD:=ENV.REFERRED_BY;
COM_1 EQU * COMMON:
MOVE.L A5,PT_REF(A6) POINTER.REF:=ENTITY;
INS_ELEM A1,A6,A5,A1/A5 INSERT(HEAD,NEW=POINTER,A5:=PREV)
MOVE.L PT_REF(A6),A5 A5:= ENTITY; "RESTORE A5"
NIL_1 EQU * NIL:
MOVE.B D5,PT_KIN(A6) POINTER.KIND:=ENTITY_KIND;
***
PRT_MEM SIMPLE_PT,(A6),FP_SIZ
RTS RETURN
PAGE
MOVE_OWN EQU * MOVE TO NEW OWNER SET
* CALL AND RETURN: AS OTHER KERNEL OPERATIONS.
BSR C_ENT CHECK ENTITY (A5:=OBJ,D5:=ENTITY KIND,
* A1/A6/D1/D2/D4:=...);
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
CMP.B #PT_OBJ,D5 IF ENTITY KIND <> OBJECT
BNE EE_VALUE THEN REJECT END;
BSR C_PT CHECK POINTER(A1:=NEW PSTR,D1:=NEW PREL,
* D2:=PT_KIND,A6:=...);
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
BTST.B D2,SIM_OWN IF PT_KIND <> SIMPLE, OWN_SET
BEQ EE_VALUE THEN REJECT END;
MOVE.L OB_OWN(A5),A3 A3:=OLD PSTR:=OBJ.OWNER STRUCT;
MOVE OB_OFF(A5),D3 D3:=OLD PREL:=OBJ.OWNER REL;
BTST.B #PT_FSC,PT_INF(A3,D3) IF OLD OWNER FORMAL
BNE EE_SCOPE THEN REJECT END;
BTST.B #PT_FSC,PT_INF(A1,D1) IF NEW OWNER FORMAL
BNE EE_SCOPE THEN REJECT END;
IF.L A3 <NE> A1 THEN.S IF OLD PSTR <> NEW PSTR THEN
BTST.B #OB_EMB,OB_STA(A5) IF OBJECT EMBEDDED
BNE EE_SCOPE THEN REJECT END;
MOVE.L CT_OBJ(A2),A6 A6:=CURRENT OBJ;
MOVE.L OB_SPA(A6),A6
MOVE.L SP_ENV+4(A6),A6 A6:=CUR ENV:=CURRENT OBJ.TOP ENV;
LEA -EN_STK(A6),A6 "OFFSET"
IF.L A3 <EQ> A2 THEN.S IF OLD PSTR = CTX THEN
CMPA.L A1,A6 IF NEW PSTR <> CUR ENV
BNE EE_SCOPE THEN REJECT END;
ELSE.S ELSE "OLD PSTR <> CTX:"
CMPA.L A3,A6 IF OLD PSTR <> CUR ENV
BNE EE_SCOPE THEN REJECT END;
CMPA.L A1,A2 IF NEW PSTR <> CTX
BNE EE_SCOPE THEN REJECT END;
ENDI END;
ENDI END "OLD PSTR <> NEW PSTR";
BSR S_MOVE CHECK STACK(OBJ,NEW PSTR, NEW PREL,
* A0/A6/D0/D4/D5:=UNDEF);
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
BSR M_OWN_OK MOVE OWNER(OBJ,NEW PSTR,NEW PREL,A6:=PT);
BSR S_UPDATE UPDATE STACK REQ(OBJ,A6/D0:=UNDEF);
CLR.L D7 D7:=RESULT:=OK;
BRA RET_FAST RETURN TO USER;
*** MIGHT OPTIMIZE WHEN OLD PSTR=NEW PSTR TO AVOID STACK CHECK AND M_OWN_OK.
PAGE
MOVE_MAN EQU * MOVE TO NEW MANAGER SET
* CALL AND RETURN: AS OTHER KERNEL OPERATIONS.
BSR C_ENT CHECK ENTITY(A5:=ENV,D5:=ENTITY KIND,
* A1/A6/D1/D2/D4:=...);
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
CMP.B #PT_ENV,D5 IF ENTITY KIND <> ENVELOPE
BNE EE_VALUE THEN REJECT END;
BSR C_PT CHECK POINTER(A1:=NEW PSTR,D1:=NEW PREL,
* D2:=PT_KIND,A6:=...);
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
BTST.B D2,SIM_MAN IF PT_KIND <> SIMPLE, MAN_SET
BEQ EE_VALUE THEN REJECT END;
MOVE.L EN_MAN(A5),A3 A3:=OLD PSTR:=ENV.MAN_STRUCT;
MOVE EN_OFF(A5),D3 D3:=OLD PREL:=ENV.MAN_REL;
BTST.B #PT_FSC,PT_INF(A1,D1) IF NEW MANAGER FORMAL
BNE EE_SCOPE THEN REJECT END;
IF.L A3 <NE> A1 THEN.S IF OLD PSTR <> NEW PSTR THEN
MOVE.L CT_OBJ(A2),A6 A6:=CURRENT OBJ;
MOVE.L OB_SPA(A6),A6
MOVE.L SP_ENV+4(A6),A6 A6:=CUR ENV:=CURRENT OBJ.TOP ENV;
LEA -EN_STK(A6),A6 "OFFSET"
IF.L A3 <EQ> A2 THEN.S IF OLD PSTR = CTX THEN
CMPA.L A1,A6 IF NEW PSTR <> CUR ENV
BNE EE_SCOPE THEN REJECT END;
ELSE.S ELSE "OLD PSTR <> CTX:"
CMPA.L A3,A6 IF OLD PSTR <> CUR ENV
BNE EE_SCOPE THEN REJECT END;
CMPA.L A1,A2 IF NEW PSTR <> CTX
BNE EE_SCOPE THEN REJECT END;
ENDI END;
ENDI END "OLD PSTR <> NEW PSTR";
BSR M_MAN_OK MOVE MANAGER(ENV,NEW PSTR,NEW PREL,
* A6:=PT);
CLR.L D7 D7:=RESULT:=OK;
BRA RET_FAST RETURN TO USER;
PAGE
FIRSTINSET EQU * GET FIRST MEMBER OF SET
* CALL AND RETURN: AS OTHER KERNEL OPERATIONS.
BSR C_PT CHECK POINTER(A6:=PT,D2:=PT KIND,
* A1/D1:=...);
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
CLR D4 D4:=CAPS:=0;
LSL #1,D2
CASEJMP D2 CASE POINTER KIND OF
CASELAB EE_VALUE NIL: REJECT
CASELAB EE_VALUE REF OBJ: REJECT
CASELAB EE_VALUE REF ENV: REJECT
CASELAB OWN_6
CASELAB MAN_6
CASELAB EE_VALUE INTERRUPT POINTER: REJECT
CASELAB EE_VALUE VOID: REJECT
OWN_6 EQU * OWNER SET:
MOVE.L (A6),A5 A5:=ENTITY:=FIRST OBJ IN SET;
BSR OWN_6A GET OWNER CAPS(D4:=CAPS,D5:=ENT KIND);
* "PART OF C_ENT, D4=0 AT CALL"
BRA SET_SIMPLE GOTO SET SIMPLE REF; "IN COPY"
MAN_6 EQU * MANAGER SET:
MOVE.L (A6),A5 A5:=ENTITY:=FIRST ENV IN SET;
MOVEQ #PT_ENV,D5 D5:=ENTITY KIND:=ENV;
BRA SET_SIMPLE GOTO SET SIMPLE REF; "IN COPY"
PAGE
NXTINSET EQU * GET NEXT MEMBER OF SET
* CALL AND RETURN: AS OTHER KERNEL OPERATIONS.
BSR C_PT CHECK POINTER(A1:=SET STR,D1:=SET REL,
* D2:=PT KIND,A6:=PT);
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
MOVE.L A1,A3 A3:=SET STRUCTURE;
MOVE D1,D3 D3:=SET RELATIVE;
BSR C_ENT CHECK ENTITY(A5:=ENTITY,D2:=PT KIND,
* A1/A6/D1/D4/D5:=...);
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
CLR D4 D4:=CAPS:=0;
IF.B #PT_OBJ <EQ> D2 THEN.S IF OBJ REF THEN "A5=OBJ"
CMP.L OB_OWN(A5),A3 IF OWNER STRUCT <> SET STRUCTURE
BNE EE_VALUE THEN REJECT END;
CMP OB_OFF(A5),D3 IF OWNER REL <> SET REL
BNE EE_VALUE THEN REJECT END;
CMP.L 4(A3,D3),A5 IF OBJ = LAST IN SET
BEQ.S END_SET THEN GOTO END_SET END;
MOVE.L (A5),A5 A5:=OBJ:=NEXT IN SET;
BSR OWN_6A GET OWNER CAPS(D4:=CAPS,D5:=ENT KIND);
BRA STO_SIMPLE GOTO STORE SIMPLE REF; "IN COPY"
ENDI END; "OBJ REF"
CMP.B #PT_ENV,D2 IF NOT ENV REF
BNE EE_VALUE THEN REJECT END;
CMP.L EN_MAN(A5),A3 IF MAN STRUCT <> SET STRUCTURE
BNE EE_VALUE THEN REJECT END;
CMP EN_OFF(A5),D3 IF MAN REL <> SET REL
BNE EE_VALUE THEN REJECT END;
CMP.L 4(A3,D3),A5 IF ENV = LAST IN SET
BEQ.S END_SET THEN GOTO END_SET END;
MOVE.L (A5),A5 A5:=ENV:=NEXT IN SET;
MOVEQ #PT_ENV,D5 D5:=ENTITY KIND:=ENV;
BRA STO_SIMPLE GOTO STORE SIMPLE REF; "IN COPY"
END_SET EQU * END SET:
MOVE.L #ECRNOT_IN,D7 D7:=RESULT:=NOT_IN_SET;
BRA RET_FAST RETURN TO USER;
REFEQUAL EQU * SAME ENTITY OR NOT ???
* CALL AND RETURN AS OTHER KERNEL OPERATIONS.
BSR.L C_ENT CHECK_ENTITY(A5:=ENTITY,D5:=KIND);
BEQ.L RET_FAST
MOVE.W D5,D0 A0/D0:= FIRST ENTITY;
MOVE.L A5,A0
BSR.L C_ENT CHECK_ENTITY(A5:=ENTITY,D5:=KIND);
BEQ.L RET_FAST
IF.W D5 <EQ> D0 THEN.S IF SAME KIND THEN
TST.W D5
IF <NE> THEN.S IF NOT NIL THEN
CMP.L A5,A0 SAME:= SAME ENTITY ADDRESS
ENDI ELSE SAME:=TRUE ENDI;
ENDI ELSE SAME:=FALSE ENDI;
IF <EQ> THEN.S IF SAME THEN
MOVEQ.L #0,D7 D7:= RESULT:= OK;
ELSE.S ELSE
MOVEQ.L #ECSVALUE,D7 D7:= STATUS,POINTER VALUE ILLEGAL;
ENDI ENDI;
BRA.L RET_FAST GOTO FAST RETURN
PAGE
M_OWN_OK EQU * MOVE OWNER, CHECK PERFORMED
* CALL: RETURN:
* A1 POINTER STRUCT SAME (NEW OWNER POINTER)
* A5 OBJECT SAME
* A6 POINTER
* D1 POINTER REL SAME (NEW OWNER POINTER)
* REMOVES OBJECT FROM ITS OLD OWNER SET AND INSERTS IT IN THE NEW.
* SHRINKS STACK REQUIREMENT FOR OLD OWNER SET. CLEARS NEW POINTER IF NOT OWN.
MOVEM.L A2/A3,-(A7) SAVE REGISTERS;
REM_ELEM (A5),A2,A3,A2/A3 REMOVE FROM OWN_SET(OBJ,
IF.L A2 <EQ> A3 THEN.S A2:=NEXT,A3:=PREV);
CLR.B PT_KIN(A2) IF NEXT=PREV THEN OLD_PT.KIND:=NIL
ENDI END;
BSR S_SHRINK SHRINK STACK REQUIREMENTS(OBJ,A6:=UNDEF);
* "REF FROM OBJ TO OWN SET STILL EXISTS"
MOVEM.L (A7)+,A2/A3 RESTORE REGISTERS; GOTO INS_OWN;
INS_OWN EQU * INSERT IN OWNER SET
* CALL/RETURN AS M_OWN_OK
* CLEARS POINTER IF NOT OWNER POINTER. INSERTS OBJECT.
MOVE.L A2,-(A7) SAVE A2;
LEA (A1,D1),A2 A2:=POINTER ADDR;
MOVE.L A1,OB_OWN(A5) OBJECT.OWNER:=(PSTR,PREL);
MOVE D1,OB_OFF(A5)
IF.B PT_KIN(A2) <NE> #PT_OWN THEN.S IF SIMPLE POINTER THEN
BSR CLR_SMP CLEAR SIMPLE (PSTR,PREL,A6:=POINTER);
MOVE.B #PT_OWN,PT_KIN(A6) POINTER.KIND:=OWN_SET
ENDI END;
INS_ELEM A2,A5,A6,A2/A6 INSERT(HEAD=POINTER,NEW=OBJ,A6:=PREV)
MOVE.L A2,A6 A6:=POINTER ADDR
MOVE.L (A7)+,A2 RESTORE A2;
***
PRT_MEM INS_OWN,(A6),FP_SIZ
RTS RETURN
PAGE
M_MAN_OK EQU * MOVE MANAGER, CHECK PERFORMED
* CALL: RETURN:
* A1 POINTER STRUCT SAME
* A5 ENVELOPE SAME
* A6 POINTER
* D1 POINTER REL SAME
* REMOVES ENVELOPE FROM ITS OLD MANAGER SET AND INSERTS IT IN THE NEW.
* CLEARS NEW POINTER IF NOT MAN_SET.
MOVEM.L A2/A3,-(A7) SAVE REGISTERS;
REM_ELEM (A5),A2,A3,A2/A3 REMOVE FROM MAN_SET(OBJ,
IF.L A2 <EQ> A3 THEN.S A2:=NEXT,A3:=PREV);
CLR.B PT_KIN(A2) IF NEXT=PREV THEN OLD_PT.KIND:=NIL
ENDI END;
MOVEM.L (A7)+,A2/A3 RESTORE REGISTERS; GOTO INS_MAN;
INS_MAN EQU * INSERT IN MANAGER SET
* CALL/RETURN AS M_MAN_OK
* CLEARS POINTER IF NOT MAN_SET. INSERTS ENVELOPE.
MOVE.L A2,-(A7) SAVE A2;
LEA (A1,D1),A2 A2:=POINTER;
MOVE.L A1,EN_MAN(A5) ENVELOPE.MANAGER:=(PSTR,PREL);
MOVE D1,EN_OFF(A5)
IF.B PT_KIN(A2) <NE> #PT_MAN THEN.S IF SIMPLE POINTER THEN
BSR CLR_SMP CLEAR SIMPLE(PSTR,PREL,A6:=POINTER);
MOVE.B #PT_MAN,PT_KIN(A6) POINTER.KIND:=MAN_SET
ENDI END;
INS_ELEM A2,A5,A6,A2/A6 INSERT(HEAD=POINTER,NEW=ENV,A6:=PREV);
MOVE.L A2,A6 A6:=POINTER;
MOVE.L (A7)+,A2 RESTORE A2;
***
PRT_MEM INS_MAN,(A6),FP_SIZ
RTS RETURN
PAGE
DUM_ACT EQU * DUMMYFY ACTUAL REFS
* CALL: RETURN:
* A5 STRUCT (ENV OR CTX) SAME
* A0/A4/A6 UNDEFINED
* DUMMYFIES ACTUAL REFERENCES TO STRUCT. ACTUAL HEAD BECOMES EMPTY.
LEA ST_ACT(A5),A6 A6:=ACTUAL HEAD;
MOVE.L (A6),A4 A4:=CUR_FP:=HEAD.FIRST;
WHILE.L A4 <NE> A6 DO.S WHILE CUR_FP <> HEAD DO
MOVE.L (A4),A0 A0:=NEXT(CUR_FP);
MOVE.L A4,(A4) CUR_FP.ACTUAL_CHAIN:=SELF_REF;
MOVE.L A4,4(A4)
CLR.L CH_HOLD(A4) CUR_FP.STRUCTURE:=DUMMY ACTUAL
MOVE.L A0,A4 A4:=CUR_FP:=NEXT;
ENDW ENDW;
MOVE.L A6,(A6) ACTUAL_HEAD:=SELF_REF;
MOVE.L A6,4(A6)
RTS RETURN
DUM_ENV EQU * DUMMYFY ENV REFS AND REMOVE FROM MANSET
* CALL: RETURN:
* A5 ENVELOPE SAME
* A0/A4/A6 UNDEFINED
* CLEARS ALL ENV_REFS TO ENVELOPE. REFERRED_BY HEAD BECOMES EMPTY.
* THE ENVELOPE IS REMOVED FROM ITS MANAGER SET.
LEA EN_REF(A5),A6 A6:=REFERRED_BY HEAD:
BRA.S DUM_COM GOTO COMMON DUMMYFY;
PAGE
DUM_OBJ EQU * DUMMYFY OBJ REFS AND REMOVE FROM OWN_SET
* CALL: RETURN:
* A5 OBJECT SAME
* A0/A4/A6 UNDEFINED
* CLEARS ALL OBJ_REFS TO OBJECT. REFERRED_BY HEAD BECOMES EMPTY.
* IO_REFS TO THE OBJECT DO NOT EXIST SINCE DELETION SUSPENDS UNTIL IO_COUNT
* IS 0. RESIDENT_REFS ARE SIMPLY CLEARED. INTERRUPT POINTERS HAVE BEEN
* ABORTED. THE OBJECT IS REMOVED FROM ITS OWN SET.
LEA OB_REF(A5),A6 A6:=REFERRED_BY HEAD;
DUM_COM EQU * COMMON DUMMYFY:
MOVE.L (A6),A4 A4:=CUR_PT:=HEAD.FIRST;
WHILE.L A4 <NE> A6 DO.S WHILE CUR_PT <> HEAD DO
MOVE.L (A4),A0 A0:=NEXT(CUR_PT);
MOVE.L A4,(A4) CUR_PT.CHAIN:=SELF_REF;
MOVE.L A4,4(A4)
IF.B PT_KIN(A4) <LE> #PT_ENV THEN.S IF SIMPLE REF THEN
CLR.B PT_KIN(A4) CUR_PT.KIND:=NIL;
BCLR.B #PT_RES,PT_INF(A4) CUR_PT.RESIDENT:=0;
ELSE.S ELSE "MMU OR SUBSEGM"
CLR.L PT_REF(A4) CUR_PT.REFERENCE:=NIL;
ENDI END;
MOVE.L A0,A4 A4:=CUR_PT:=NEXT;
ENDW END "FOR ALL REFS";
MOVE.L A6,(A6) HEAD:=SELF_REF;
MOVE.L A6,4(A6) REMOVE FROM OWN OR MANSET(OBJ OR ENV,
REM_ELEM (A5),A0,A4,A0/A4 A0:=NEXT,A4:=PREV);
IF.L A0 <EQ> A4 THEN.S IF NEXT=PREV THEN
CLR.B PT_KIN(A4) OWN OR MANSET.KIND:=NIL
ENDI END;
MOVE.L A5,(A5) OBJ OR ENV.CHAIN:=SELF_REF;
MOVE.L A5,4(A5)
CLR.L CH_HOLD(A5) OBJ OR ENV.HOLDER:=DUMMY HOLDER;
RTS RETURN
TTL EXECUTION CONTROL
PAGE
MAP_SEGM EQU * MAP SEGMENT, NORMAL OR RESIDENT CTX
* CALL AND RETURN: AS OTHER KERNEL OPERATIONS.
* D3=RESIDENT OR NORMAL. A1:=LOGICAL ADDR, D3:=LENGTH, D5:=USE BITS.
BSR C_ENTRES CHECK ENTITY(A1/D1/A6/D2/D4:=...,
* A5:=SEGMENT,D5:=ENTKIND);
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
IF.B D5 <EQ> #PT_NIL THEN.S IF ENT_KIND=NIL THEN
MOVE #0,A5 A5:=SEGMENT:=0 "DUMMY"
ELSE.S ELSE
CMP.B #PT_OBJ,D5 IF ENT_KIND <> OBJ THEN
BNE EE_VALUE REJECT END;
CMPI.B #OB_SEOB,OB_KIN(A5) IF SEGMENT.KIND <> SEGM OBJ THEN
BNE EE_STATE REJECT END;
ENDI END;
BSR C_ADDR CHECK ADDR(D0:=LOG ADDR);
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
MOVE.L -(A4),D1 D1:=MMU#:=NEXT ARG;
ADD #1,D6 ARGUMENT#:=...+1;
CMP.L #3,D1 IF MMU# >3 "UNSIGNED"
BHI EE_DATA THEN REJECT END;
MULU #MM_SIZ,D1 D1:=MMU DESCR SIZE * MMU#;
LEA CT_MM0(A2,D1),A1 A1:=MMU DESCR;
BSR.S MAP_RESOK MAP RES OR NORMAL(MMU,SEGM OR 0,LOG ADDR);
MOVE.L D0,A1 A1:=LOGICAL ADDR;
MOVE.L SE_LEN(A5),D3 D3:=SEGMENT LENGTH;
MOVE.B OB_STA(A5),D5 D5:=OBJECT STATE;
LSR.B #OB_READ,D5 D5:= USE BITS OF SEGMENT;
CLR.L D7 D7:=RESULT:=OK;
BRA RET_OLD2 LOAD MMU AND RETURN TO USER;
MAP_RESOK EQU * MAP RESIDENT OR NORMAL OK
* CALL AND RETURN: AS MAP OK, BUT D3=RESIDENT OR NORMAL
TST D3 IF NORMAL CTX THEN
IF <EQ> THEN.S MAP OK(MMU DESCR,SEGM OR 0,LOG ADDR,
BSR.S MAP_OK D0:=ADJUSTED LOG ADDR,D1/D2:=UNDEF);
ELSE.S ELSE
MOVEM.L D0/A3/A6,-(A7) SAVE LOG ADDR,A3,A6;
MOVEQ #-1,D0 D0:=DECREASE;
MOVE #OB_RES,D1 D1:=COUNT ADDR:=RESIDENT COUNTER;
MOVE.L A1,A6 A6:=MMU PT;
BSR INCRDECR DECREASE(COUNT ADDR,MMU PT,A3:=UNDEF);
MOVE.L (A7),D0 D0:=LOG ADDR;
BSR.S MAP_OK MAP OK(...,D1/D2:=UNDEF);
MOVE.L D0,(A7) SAVE LOG ADDR;
MOVEQ #1,D0 D0:=INCREASE;
MOVE #OB_RES,D1 D1:=COUNT ADDR;
BSR INCRDECR INCREASE(COUNT ADDR,MMU PT,A3:=UNDEF);
MOVEM.L (A7)+,D0/A3/A6 RESTORE LOG ADDR,A3,A6;
ENDI END
RTS RETURN
PAGE
MAP_OK EQU * MAP SEGMENT INTO MMU DESCRIPTOR
* CALL: RETURN:
* A1 MM_DESCR SAME
* A5 SEGM OR 0 SAME (ROOT SEGMENT OR SUBSEGMENT)
* D0 LOG ADDR UPDATED (NORMALLY THE SAME)
* D1-D2 - UNDEF
* UNMAPS THE MMU DESCRIPTOR. THEN MAPS THE SEGMENT IF IT IS SPECIFIED.
* THE LOGICAL ADDRESS AT RETURN GIVES THE ACTUAL LOGICAL ADDRESS WHERE
* THE FIRST WORD OF THE SEGMENT IS FOUND. (THE RETURN VALUE MAY
* DIFFER FROM THE CALL VALUE IN ONLY THE LAST 8 BITS).
MOVEM.L A2/A3,-(A7) SAVE A2,A3;
REM_ELEM (A1),A2,A3,A2/A3 REMOVE FROM REFERRED BY (MM_DESCR,
* A2:=NEXT,A3:=PREV);
CMPA #0,A5 IF SEGMENT NOT SPECIFIED THEN
BNE.S MAP_COM
MOVE.L A1,(A1) MMU_REF
MOVE.L A1,4(A1) := EMPTY;
CLR.L MM_REF(A1) MM_DESCR.BASE:=NONE;
CLR MM_REG+6(A1) MM_DESCR.ENABLE:=FALSE;
MOVEM.L (A7)+,A2/A3 RESTORE A2,A3; RETURN
RTS END;
* CONTINUE IN MAP_FIRST BUT SKIP SAVING A2/A3 AGAIN.
MAP_FIRST EQU * MAP SEGMENT INTO UNINITIALIZED MMU DESCR.
* LIKE MAP_OK, BUT SEGM CANNOT BE 0. DOES NOT UNMAP FIRST.
MOVEM.L A2/A3,-(A7) SAVE A2,A3;
MAP_COM EQU *
MOVE.L A5,MM_REF(A1) MM_DESCR.BASE:=SEGMENT;
LEA OB_REF(A5),A2 INSERT(HEAD=SEGMENT,NEW=MM_DESCR,
INS_ELEM A2,A1,A3,A2/A3 A3:=PREV);
MOVEM.L (A7)+,A2/A3 RESTORE A2,A3;
LSR.L #8,D0 D0:=FIRST LOGICAL:=LOG ADDR/256;
MOVE.L SE_FIR(A5),D2
MOVE.L D2,D1 D1:=SEGM.FIRST_PHYS;
* D2_LEFT:=SEGM.FIRST PHYS MOD 256;
ROR.L #8,D2 D2:=OFFSET:=
SUB.W D0,D2 SEGM.FIRST_PHYS/256-FIRST LOGICAL;
AND.L #255,D1 D1:=LAST LOGICAL:=
ADD.L SE_LEN(A5),D1 (SEGM.FIRST PHYS MOD 255+SEGM.LENGTH
SUBQ #1,D1 -1)/256
LSR.L #8,D1 +FIRST LOGICAL;
ADD.W D0,D1 MM_DESCR.FIRST_LOGICAL,LAST_LOGICAL,
MOVEM.W D0-D2,MM_REG(A1) OFFSET:=D0/D1/D2; "WORD"
MOVE.W D0,D2 D2_RIGHT:=FIRST LOGICAL;
ROL.L #8,D2 D0:=D2:=LOG ADDR:=FIRST LOGICAL *256
MOVE.L D2,D0 +SEGM.FIRST PHYS MOD 256;
MOVE.W OB_KIN(A5),D2 D2:= SEGM.USE_BITS * 2;
LSR.W #OB_READ-1,D2
AND.W #7<<1,D2
MOVE.W MMCONTRL(D2),MM_REG+6(A1) MM_DESCR.(ENABLE+READ_ONLY) := ! ;
RTS RETURN;
* USE_BITS = 0 1 2 3 4 5 6 7
MMCONTRL DC.W 0,3,1,1,3,3,1,1 0=DISABLE, 3=READ_ONLY, 1=READ+WRITE
TTL PROCESS MANAGEMENT AND SYNC
PAGE
DECL_PROC EQU * DECLARE PROCESS
* CALL AND RETURN: AS OTHER KERNEL OPERATIONS.
MOVE.L D4,D3 D3:=LOW_ARG;
BSR C_ENT CHECK ENTITY(A5:=PROC,D2:=PT_KIND,
* A1/A6/D1/D4/D5:=...);
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
CMP.B #PT_OWN,D2 IF POINTER KIND <> OWN
BNE EE_VALUE THEN REJECT END;
CMP.B #OB_DOOB,OB_KIN(A5) IF PROC KIND <> DORMANT
BNE EE_STATE THEN REJECT END;
MOVE.L A5,A0 A0:=EXT OBJ:=PROC;
MOVE.L CT_OBJ(A2),A5 A5:=OBJ TO CALL:=CUR_CTX.OBJECT;
MOVE.L D3,D4 D4:=LOW_ARG;
CLR D3 D3:=ADDITIONAL FORMALS:=0;
MOVE.L -(A4),D5 D5:=FUNCTION:=NEXT ARGUMENT;
ADD #1,D6 D6:=ARGUMENT#:=...+1;
BSR CRE_CTX CREATE_CTX(...,A3:=NEW CTX,D4:=ENTRY;
* A1/A5/A6/D0-D2:=UNDEF);
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
MOVE.L D4,CT_WRK-4(A3) NEW_CTX.PC:=ENTRY;
MOVE.L D5,PR_D0.A3(A0) PROC.SAVED_D0:=FUNCTION;
BSR SAVE_STK SAVE SUPV STACK(CUR_CTX,ENTRY,FUNCTION,
* A5/A6/D0:=UNDEF);
BSR SET_FP SET FORMALS(EXT,CUR_CTX,NEW CTX,ARG ADDR,
* ADDITIONAL FORMALS,ARG#,D3:=#FORMALS,
* A1/A5/A6/D0-D2/D4/D5:=UNDEF);
IF <NE> THEN.S IF OK THEN
MOVE.B #OB_PROB,OB_KIN(A0) PROC.KIND:=PROCESS OBJECT;
MOVE.L D3,PR_D0.A3+12(A0) PROC.SAVED_D3:=#FORMALS;
LEA CT_WRK-4(A3),A6 A6:=NEW_CTX.SAVED STACK;
CLR.W -(A6) SAVED STACK.SR:=0;
MOVE.L 8(A7),-(A6) SAVED STACK.A6:=TOP VALUE;
MOVE.L 4(A7),-(A6) SAVED STACK.A5:=FIRST TEMP;
CLR.L -(A6) SAVED STACK.A4:=0;
MOVE #-2,CT_COUNT(A3) NEW_CTX.#ADDITIONAL WORDS:=-2;
MOVE.L #START_PROC,-(A6) SAVED STACK.RESUME:=START PROCESS;
MOVE.L USP,A6 A6:=NEW CTX.USP:=USP;
MOVE.L A6,CT_USP(A3)
MOVE.L #STOP_PROC,CT_CON(A3) NEW_CTX.CONTINUE AT RETURN:=STOP_PROC;
LEA PR_AUX(A0),A0 A0:=PROCESS.AUX QUEUE;
LEA RUNNING,A1 A1:=RUNNING QUEUE;
INS_ELEM A1,A0,A6,A1/A6 INSERT PROCESS IN RUNNING QUEUE
MOVEQ.L #0,D7 RESULT:= OK;
ELSE.S ELSE
BSR DEL_CTX DELETE_CTX(NEW_CTX,A0:=PROC,
* A1-A6/D0-D5:=UNDEF);
ENDI END;
MOVE.L KV_CTX,A3 A3:=CUR_CTX;
BSR RSTO_STK RESTORE SUPV STACK AND USP(CUR_CTX);
BRA RET_OLD3 RETURN TO USER;
STOP_PROC EQU * STOP PROCESS: "RETURN FROM INITIAL CTX"
* RET_FP NOT CALLED SINCE NO RETURN POINTERS OR VALUES ARE HANDLED.
* (THIS WOULD CAUSE TROUBLE WHEN A NORMAL CALL ADDRESSES ITS VALUE BASE
* AT RETURN. A DIFFERENT REPRESENTATION WOULD BE NEEDED.)
BSR DEL_CTX DELETE_CTX(CUR_CTX,A0:=PROC,
* A1-A6/D0-D5:=UNDEF);
MOVE.B #OB_DOOB,OB_KIN(A0) PROC.KIND:=DORMANT;
REM_ELEM PR_MAIN(A0),A1,A6,A1/A6 REMOVE PROC FROM TIMER Q (MAY BE EMPTY)
INIT_HEAD PR_MAIN(A0),A1 MAIN:=SELF_REF;
REM_ELEM PR_AUX(A0),A1,A6,A1/A6 REMOVE PROC FROM RUNNING QUEUE;
INIT_HEAD PR_AUX(A0),A1 AUX:= SELF_REF;
LEA PR_TERM(A0),A1 A1:=PROC TERM CONDITION;
BSR KNELSIGN PROC TERM.SIGNAL(A4/A5/A6:=UNDEF);
* AT PRESENT ONLY ONE PROC MAY BE WAITING (CALLER OF DEALLOC)
* CONTEXT AND EXTENSION QUEUE ARE EMPTY.
BRA NEXT_PROC GOTO ACTIVATE NEXT PROCESS;
PAGE
NEW_ST_CALL EQU * NEW STACK CALL
* CALL AND RETURN: AS OTHER KERNEL OPERATIONS.
MOVE.L D4,D3 D3:= LOW_ARG;
BSR C_OPEN CHECK OPEN OBJ(A0:=A5:=EXT,A6:=PT,A1/D1:=...);
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
MOVE.L D3,D4 D4:= LOW_ARG;
BTST.B #PT_TSC,PT_INF(A6) IF POINTER SCOPE <> TEMP
BEQ EE_SCOPE THEN REJECT END;
MOVE #EX_SIZ-OB_SIZ,D0 D0:=SIZE OF EXT OBJ PART;
BSR MM_PUSHO RESERVE KERNEL ENV(EXT,SIZE,A6:=TOP OBJ);
BEQ EE_OBJSP IF NOT OK THEN REJECT END;
MOVE.B #OB_EXOB,OB_KIN(A0) EXT.KIND:=EXT OBJECT;
INIT_HEAD EX_CTX(A0),A1 EXT.CONTEXTS:=EMPTY;
MOVE.L CT_HOLD(A2),A1 A1:=CUR_CTX.HOLDER;
MOVE.L EX_PR(A1),A1 A1:=PROC:=HOLDER.PROCESS;
MOVE.L A1,EX_PR(A0) EXT.PROCESS:=PROC;
LEA EX_EXT(A1),A1 A1:=PROC.HEAD EXT;
LEA EX_EXT(A0),A6 A6:=EXT.MEMBER;
INS_ELEM A1,A6,A3,A1/A3 INSERT(HEAD=PROC,NEW=EXT,A3:=PREV);
MOVEQ.L #0,D3 D3:= CALLER IS NOT RESIDENT;
BSR C_CALL CHECK CALL(EXT,CUR CTX,A5:=OBJ,D5:=FUNC);
* "WILL COMPLETE KERNEL OBJECT CALLS"
IF <NE> THEN.S IF NOT RETURN THEN
CLR D3 D3:=ADDITIONAL FORMALS:=0;
BSR CRE_CTX CREATE_CTX(...,A3:=NEW CTX,D4:=ENTRY,
* A1/A5/A6/D0-D2:=UNDEF);
IF <NE> THEN.S IF OK THEN
BSR SAVE_STK SAVE SUPV STACK(CUR_CTX,ENTRY,FUNCTION,
* A5/A6/D0:=UNDEF);
BSR SET_FP SET FORMALS(EXT,CUR_CTX,NEW_CTX,ARG ADDR,
* ADDITIONAL FORMALS,ARG#,D3:=#FORMALS,
* A1/A5/A6/D0-D2/D4/D5:=UNDEF);
IF <NE> THEN.S IF OK THEN
BSR ENT_CTX ENTER CONTEXT(A3=CTX,D3=#FORMALS);
* "CONTINUES HERE AT OBJ_RETURN. A3=CTX"
BSR RET_FP RETURN FORMALS(A3=CTX,D6/D7:=UPDATED);
ENDI END "CALL CARRIED OUT";
BSR DEL_CTX DELETE CTX(CTX,A0:=EXT,
* A1-A6/D0-D5:=UNDEF);
MOVE.L EX_EXT+4(A0),A1 A1:=OLD EXT:=EXT.PREV EXT;
MOVE.L EX_CTX+4-EX_EXT(A1),A3 A3:=OLD CTX:=OLD EXT.LAST CTX;
LEA -CT_STK(A3),A3 "OFFSET"
BSR RSTO_STK RESTORE SUPV STACK AND USP(OLD CTX);
MOVE.L A3,A2 A2:=CTX:=OLD CTX
ENDI END "CONTEXT CREATED";
ENDI END "CALL ATTEMPTED";
* A0=EXT, A2=CTX
REM_ELEM EX_EXT(A0),A1,A6,A1/A6 REMOVE FROM EXT CHAIN(EXT,A1/A6:=...);
MOVE.B #OB_OPOB,OB_KIN(A0) EXT.KIND:=OPEN OBJECT;
MOVE #EX_SIZ-OB_SIZ,D0 D0:=SIZE OF EXT OBJ PART;
BSR MM_POPO RELEASE KERNEL ENV(EXT,SIZE,A6:=TOP OBJ);
BRA RET_OLD2 RETURN TO USER; "A2=CTX"
PAGE
ABORT EQU * ABORT GENERAL OBJECT
* CALL AND RETURN: AS OTHER KERNEL OPERATIONS
BSR C_PRIM CHECK PRIMARY ENV(A5:=ENV,
* A0/A1/A6/D1/D2/D4/D5:=...);
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
BSR ABORT_ENV ABORT ENVELOPE(ENV);
CLR.L D7 D7:=RESULT:=OK;
BRA RET_OLD2 RETURN TO USER "SELF-ABORT POSSIBLE"
SPEED_UP EQU * SPEED UP GENERAL OBJECT
* CALL AND RETURN: AS OTHER KERNEL OPERATIONS.
BSR C_PRIM CHECK PRIMARY ENV(A0:=OBJ,
* A1/A5/A6/D1/D2/D4/D5:=...);
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
MOVE.L GE_EX(A0),A1 A1:=CTX:=OBJ.FIRST CTX EXECUTED;
LEA GE_EX(A0),A5 A5:=OBJ.CTX HEAD;
WHILE.L A1 <NE> A5 DO.S WHILE CTX <> CTX_HEAD DO
MOVE #1,D1 D1:=SPEED:=REJECT;
BSR PROPAGATE PROPAGATE SPEED (CTX,SPEED);
MOVE.L (A1),A1 A1:=NEXT CTX
ENDW END;
CLR.L D7 D7:=RESULT:=OK;
BRA RET_OLD2 RETURN TO USER;
ABORT_ONE EQU * ABORT ENVELOPE WITHOUT LOCAL TREE
* CALL: RETURN:
* A5 ENVELOPE (ROOT_ENV) SAME
* DUMMY IF THE ENVELOPE IS NOT TOP ENVELOPE OF A NON-ABORTED GENERAL OBJECT.
* OTHERWISE, THE GENERAL OBJECT BECOMES ABORTED AND ALL CONTEXTS EXECUTING
* IN IT ARE ABORTED. ABORTING A CONTEXT MEANS PROPAGATING SPEED-UP STATUS
* AND ABORTING POSSIBLE TEMPORARY MAN_SET AND IO-LOCKS. (USED BY D_ENV_OK).
MOVEM.L A1/A2/A4/A6/D1,-(A7) SAVE REGISTERS;
MOVE.L A5,A4 A4:=CUR_ENV:=ROOT_ENV;
BRA AB_ONE GOTO ABORT WITHOUT LOCALS;
PAGE
ABORT_ENV EQU * ABORT ENVELOPE AND LOCAL MANAGER TREE
* CALL: RETURN:
* A5 ENVELOPE (ROOT_ENV) SAME
* CLEARS POSSIBLE LOCAL IO-LOCKS AND ABORTS ALL ENVELOPES IN LOCAL MAN_SETS
* (RECURSIVELY). IF AN ENVELOPE IS THE TOP ENVELOPE OF A NON-ABORTED
* GENERAL OBJECT, THE GENERAL OBJECT BECOMES ABORTED AND ALL CONTEXTS
* EXECUTING IN IT ARE ABORTED. THIS INVOLVES PROPAGATING SPEED-UP STATUS
* AND ABORTING POSSIBLE TEMPORARY MAN_SET AND IO-LOCKS.
* (USED BY CLR_PT AND ABORT).
MOVEM.L A1/A2/A4/A6/D1,-(A7) SAVE REGISTERS;
MOVE.L A5,A4 A4:=CUR_ENV:=ROOT_ENV;
AB_NEXT3 EQU * PROCEDURE ABORT_ENV(CUR_ENV): "RECURSIVE"
***
PRT_REG AB_ENV
MOVE.L A4,A1 A1:=P_STR:=CUR_ENV;
MOVE #EN_SIZ,D1 D1:=P_REL:=L(1);
REPEAT FOR D1:=ALL LOCALS IN CUR_ENV DO
IF.B PT_KIN(A1,D1) <LE> #PT_ENV THEN.S "CLEAR POSSIBLE IO_LOCK:"
* IF LOCAL IS SIMPLE THEN
BSR CLR_SMP CLEAR SIMPLE PT(PSTR,PREL,A6:=PT);
ENDI END;
IF.B #PT_MAN <EQ> PT_KIN(A1,D1) THEN.S IF LOCAL.MAN_SET THEN
MOVE.L (A1,D1),A4 A4:=CUR_ENV:=MAN_SET.FIRST;
REPEAT FOR A4:=ALL ENVELOPES IN SET DO
BRA AB_NEXT3 ABORT_ENV(CUR_ENV); "SIMULATE CALL"
AB_LOC EQU * NEXT LOCALLY MANAGED: "A1,D1,A4 RESTORED"
LEA (A1,D1),A2 A2:=HEAD MAN_SET;
MOVE.L (A4),A4 A4:=NEXT ENVELOPE IN SET;
UNTIL.L A4 <EQ> A2 END "FOR ALL ENVELOPES IN SET";
ENDI END "LOCAL.MAN_SET";
ADD #PT_SIZ,D1 D1:=NEXT LOCAL;
UNTIL D1 <EQ> EN_TOPL(A1) END "FOR ALL LOCALS"
MOVE.L A1,A4 A4:=CUR_ENV:=P_STR;
AB_ONE EQU * ABORT WITHOUT LOCALS: "A4=CUR_ENV"
MOVE.L EN_OBJ(A4),A2 A2:=OBJ:=OBJECT HOLDING CUR_ENV;
MOVE.L OB_SPA(A2),A6 A6:=TOP OBJ;
LEA SP_ENV(A6),A6 A6:=ENV HEAD;
IF.L EN_STK(A4) <EQ> A6 THEN IF CUR ENV = TOP ENV OF GENERAL OBJ
IF.B OB_KIN(A2) <EQ> #OB_GEOB THEN
BSET.B #OB_ABOR,OB_STA(A2) AND OBJ NOT ABORTED
IF <EQ> THEN THEN OBJ.ABORTED:=TRUE;
MOVE.L GE_EX(A2),A1 A1:=CTX:=OBJ.FIRST CTX EXECUTED;
LEA GE_EX(A2),A2 A2:=OBJ.CTX HEAD;
WHILE.L A2 <NE> A1 DO WHILE CTX <> CTX HEAD DO "A4=TOP_ENV"
MOVE.W CT_RES(A1),D1 D1:= CTX.RES_COUNT; "EQUALS ZERO OR ONE"
IF <NE> THEN.S IF CTX IS RESIDENT THEN DECREASE RES_COUNT
SUB.W D1,EN_RES(A4) OF TOP_ENV NOW. NORMALLY IT IS DONE BY
ENDI SETRESET, WHEN THE CTX OPENS THE DEVI_GATE.
MOVE.B #3,CT_MODE(A1) CTX.MODE:=SAME;
MOVE.B #3,D1 D1:=SPEED:=UNDEF;
BSR PROPAGATE PROPAGATE SPEED(CTX,SPEED);
MOVE #CT_SIZ+PT_SIZ,D1 D1:=P_REL:=T(1);
REPEAT FOR D1:=ALL TEMPS IN CTX DO
BTST.B #PT_IO,PT_INF(A1,D1)
IF <NE> THEN.S IF TEMP.IO_LOCK THEN
BSR CLR_SMP CLEAR SIMPLE(PSTR=CTX,PREL,A6:=PT);
ENDI END;
IF.B #PT_MAN <EQ> PT_KIN(A1,D1) THEN.S IF TEMP.MAN_SET THEN
MOVE.L (A1,D1),A4 A4:=CUR_ENV:=MAN_SET.FIRST;
REPEAT FOR A4:=ALL ENVELOPES IN SET DO
BRA AB_NEXT3 ABORT_ENV(CUR_ENV); "SIMULATE CALL"
AB_TMP EQU * NEXT TEMP MANAGED: "A1,D1,A4 RESTORED"
LEA (A1,D1),A2 A2:=HEAD MAN_SET;
MOVE.L (A4),A4 A4:=NEXT ENVELOPE IN SET;
UNTIL.L A4 <EQ> A2 END "FOR ALL ENVELOPES IN SET";
ENDI END "TEMP MAN_SET";
ADD #PT_SIZ,D1 D1:=NEXT TEMP;
UNTIL D1 <EQ> CT_TOPT(A1) END "FOR ALL TEMPS";
WHILE D1 <NE> CT_TOPF(A1) DO.S FOR D1:=ALL FORMALS IN CTX DO
BTST.B #PT_IO,PT_INF(A1,D1)
IF <NE> THEN.S IF FORMAL.IO_LOCK THEN
BSR CLR_SMP CLEAR SIMPLE (PSTR=CTX,PREL,A6:=PT)
ENDI END
ADD #FP_SIZ,D1 D1:=NEXT FORMAL;
ENDW END "FOR ALL FORMALS";
CLR.L CT_OBJ(A1) CTX.EXECUTES:=ABORTED;
REM_ELEM (A1),A2,A6,A2/A6 REMOVE CTX FROM EXECUTES CHAIN;
EXG.L A2,A6 A2:=CTX HEAD; A6:=NEXT CTX;
MOVE.L A1,(A1) CTX.EXECUTES CHAIN:=DUMMY;
MOVE.L A1,4(A1)
MOVE.L A6,A1 A1:=CTX:=NEXT CTX;
MOVE.L OB_SPA-GE_EX(A2),A6 A6:=TOP OBJ;
MOVE.L SP_ENV+4(A6),A4 A4:=CUR_ENV:=OBJ.TOP ENV; A4 USED IN
LEA -CT_STK(A4),A4 "AJUST FOR OFF-SET" LOOP START.
ENDW ENDW "FOR ALL CTX EXECUTING OBJ"
ENDI END "TOP ENV OF NON-ABORTED GENERAL";
ENDI
ENDI
* "SIMULATE RETURN FROM ABORT_ENV/AB_ONE:"
IF.L A4 <NE> A5 THEN.S IF CUR_ENV <> ROOT ENV THEN
MOVE.L EN_MAN(A4),A1 A1:=P_STR:=CUR_ENV.MANAGER_ENV;
MOVE EN_OFF(A4),D1 D1:=P_REL:=CUR_ENV.MANAGER_REL;
BTST.B #PT_LSC,PT_INF(A1,D1) IF NOT LOCAL MAN_SET
BEQ AB_TMP THEN GOTO NEXT TEMP MANAGER END;
BRA AB_LOC GOTO NEXT LOCALLY MANAGED
ENDI END;
MOVEM.L (A7)+,A1/A2/A4/A6/D1 RESTORE REGISTERS;
RTS RETURN
PAGE
PROPAGATE EQU * PROPAGATE SPEED
* CALL: RETURN:
* A1 CONTEXT SAME
* D1 SPEED UNDEF (1=REJECT,3=SPEED UNDEF)
* A6 - UNDEF
* PROPAGATES "SPEED" STARTING IN "CONTEXT" AND PROCEEDING THROUGH YOUNGER
* CONTEXTS. THE CONTEXT SPEED BECOMES MAX(SPEED,OLD CONTEXT SPEED).
* THE PROPAGATED VALUE IS SPEED = MIN(SPEED, OLD CONTEXT MODE).
MOVEM.L D0/A1,-(A7) SAVE CTX AND WORKING REG;
REPEAT REPEAT "FOR ALL CONTEXTS"
OR.B D1,CT_SPE(A1) CTX.SPEED:=MAX(SPEED,CTX.SPEED);
BSR.S SPEEDEXC CHECK_SPEED_EXC(A1=CTX,D0:=?);
AND.B CT_MODE(A1),D1 SPEED:=MIN(SPEED,CTX.MODE);
***
PRT_REG PROPAGATE
IF <NE> THEN.S IF SPEED <> NORMAL THEN
MOVE.L CT_HOLD(A1),A6 A6:=EXT OBJECT HOLDING CTX;
PROP_REP EQU * GET_FIRST_CONTEXT_IN_NEW_EXTENSION_OBJ:
LEA EX_CTX(A6),A6 A6:=HEAD CTX STACK;
IF.L CT_STK(A1) <NE> A6 THEN.S IF NEXT CTX(CTX) <> HEAD CTX STACK THEN
MOVE.L CT_STK(A1),A1 A1:=NEXT CTX(CTX)
LEA -CT_STK(A1),A1 "ADJUST FOR OFF-SET"
ELSE.S ELSE
MOVE.L EX_EXT-EX_CTX(A6),A6 A6:=EXT:=NEXT EXT(EXT OBJECT);
LEA -EX_EXT(A6),A6 "OFF-SET TO EXT OBJECT BASE"
IF.B OB_KIN(A6) <EQ> #OB_EXOB THEN.S
LEA EX_CTX-CT_STK(A6),A1 IF EXT.KIND=EXT THEN
BRA.S PROP_REP CT_STK(A1) == CTX_HEAD OF EXT_OBJ; GOTO GET_FIRST.....
ELSE.S ELSE "EXT.KIND=PROCESS: END CONTEXTS"
MOVEM.L D7/A3,-(A7) SAVE REGISTERS;
MOVE.L A6,A1 A1:=PROCESS;
MOVE D1,D0 D0:=SPEED;
BSR PROPSPED PROPAGATE TO GATE OR COND(A1=PROC,
* D0=SPEED,D7/A3/A6:=UNDEF);
MOVEM.L (A7)+,D7/A3 RESTORE;
CLR D1 SPEED:=NORMAL
ENDI END;
ENDI END "NEXT EXT OBJECT";
ENDI END "SPEED <> NORMAL";
UNTIL.B D1 <EQ> 0 UNTIL SPEED = NORMAL;
MOVEM.L (A7)+,D0/A1 RESTORE CTX AND WORKING REG;
RTS RETURN
SPEEDEXC EQU * CHECK FOR SPEEDUP EXCEPTION
* CALL: RETURN:
* D0 - UNDEF
* A1 CTX SAME
*
* SHOULD A SPEEDUP EXCEPTION BE GENERATED ACORDING TO STATE AND MODE
*
MOVE.B CT_MODE(A1),D0
LSR.B #2,D0 D0:= EXCEPTION MODE OF CTX
AND.B CT_SPE(A1),D0 D0:= EXC:= MINIMUM(MODE,SPEED);
IF <NE> THEN.S IF EXC THEN
BSET.B #7,CT_SPE(A1) CTX.SPEEDEXC:= TRUE;
ENDI ENDI;
RTS RETURN;
* SPEEDEXC IS CHECKED BY PREP_RET
PAGE
SET_MODE EQU * SET PROPAGATION MODE
* EXCEPTION MODE IS ALSO SET. LATER A NEW PROC MAY BE DEFINED
* CALL AND RETURN: AS OTHER KERNEL OPERATIONS.
ADD #1,D6 ARGUMENT#:=...+1;
MOVE.L -(A4),D0 D0:=MODE:=INTEGER ARGUMENT;
CMP.L #15,D0 IF MODE <0 OR >15
BHI EE_DATA THEN REJECT END;
BTST.L #1,D0
IF <NE> THEN.S IF PROP_MODE = 2 OR 3 THEN
BSET.L #0,D0 D0.PROP_MODE:=3; "SAME"
ENDI ENDI;
BTST.L #2,D0
IF <NE> THEN.S IF EXC_MODE = 1 OR 3 THEN
BSET.L #3,D0 D0.EXC_MODE:= 3; "REJECT AND UNDEF"
ENDI ENDI;
MOVE.B D0,CT_MODE(A2) CURRENT_CTX.MODE:=MODE;
MOVE.L A2,A1 A1:= CTX;
BSR.S SPEEDEXC CKECK FOR SPEEDEXC IN CALLING CTX
*** PRT_MEM CTX_MODE,(A2),CT_SIZ
CLR.L D7 D7:=RESULT:=OK;
BRA RET_OLD2 RETURN TO USER;
TEST_SPEED EQU * TEST SPEED-UP STATUS
* CALL AND RETURN: AS OTHER KERNEL OPERATIONS. D4:=SPEED.
* RETRIEVES THE SPEED-UP STATUS FROM THE CONTEXT. RE-COMPUTES THE
* SPEED-UP STATUS FROM THE PREVIOUS CONTEXT. (THE RECOMPUTED VALUE
* CAN ONLY DIFFER FROM THE CURRENT VALUE AFTER "SPEED-UP" IN THE CONTEXT).
CLR.L D4
MOVE.B CT_SPE(A2),D4 D4.L:=SPEED:=CURRENT_CTX.SPEED;
IF.B D4 <EQ> #3 THEN.S IF SPEED = UNDEF THEN
MOVE #2,D4 D4.L:=SPEED:=UNDEF; "USER FORM"
ENDI END;
IF.B D4 <EQ> #1 THEN.S IF SPEED = REJECT THEN
MOVE.L CT_HOLD(A2),A6 A6:=EXT OBJ HOLDING CTX;
LEA EX_CTX(A6),A6 A6:=CTX HEAD;
IF.L CT_STK+4(A2) <NE> A6 THEN.S
MOVE.L CT_STK+4(A2),A5 IF NOT FIRST CTX IN EXT OBJECT THEN
LEA -CT_STK(A5),A5 A5:=PREV CTX
ELSE.S ELSE IF NOT PROCESS OBJECT THEN
IF.B OB_KIN-EX_CTX(A6) <NE> #OB_PROB THEN.S
MOVE.L EX_EXT+4-EX_CTX(A6),A6 A6:=PREVIOUS EXTENSION;
MOVE.L EX_CTX+4-EX_EXT(A6),A5
LEA -CT_STK(A5),A5 A5:=PREV EXTENSION.LAST CTX;
ELSE.S ELSE
CLR.B CT_SPE(A2) CURRENT_CTX.SPEED:=NORMAL;
MOVE.L A2,A5 A5:=CURRENT_CTX
ENDI END
ENDI END "FIND PREVIOUS CONTEXT"
MOVE.B CT_SPE(A5),D0
AND.B CT_MODE(A5),D0 D0:=MIN(PREV SPEED,PREV MODE);
MOVE.B D0,CT_SPE(A2) CURRENT_CTX.SPEED:=MIN(...);
AND.B #3,CT_MODE(A2) CLEAR SPEEDEXC AND EXCMODE;
ENDI END "SPEED = REJECT";
CLR.L D7 D7:=RESULT;
BRA RET_OLD2 RETURN TO USER;
TTL IDENTIFICATION CONTROL
PAGE
DECL_ENV EQU * DECLARE ENVELOPE
* CALL AND RETURN: AS OTHER KERNEL OPERATIONS.
BSR C_ENT CHECK ENTITY(A5:=OBJ,D2:=PT_KIND,
* A1/A6/D1/D4/D5:=...);
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
MOVE.L A5,A0 A0:=OBJECT;
CMP.B #PT_OWN,D2 IF POINTER KIND <> OWN SET
BNE EE_VALUE THEN REJECT END;
MOVE.B OB_KIN(A5),D0 D0:=OBJECT KIND;
BTST.B D0,OPENDORM IF OBJECT KIND <> OPEN, DORMANT
BEQ EE_STATE THEN REJECT END;
BSR CRE_ENV CREATE ENV(OBJ,CTX,A1/D1:=REF ENV PT,
* A5/D5:=MAN SET PT,A3:=ENV,A6/D0:=UNDEF);
BEQ RET_OLD2 IF NOT OK THEN RETURN TO USER END;
BSR CLR_SMP CLEAR SIMPLE POINTER(REF ENV STR,
* REF ENV REL, A6:=PT ADDR);
MOVE.L D5,D1 D1:=MAN SET REL;
EXG.L A3,A5 A5:=ENVELOPE; A3:=MAN SET STRUCT;
MOVEQ #0,D4 D4:=NO CAPS;
MOVEQ #PT_ENV,D5 D5:=REF_ENV;
BSR COPY_NIL COPY REF TO NIL(ENV,A6=PT,A1:=UNDEF);
MOVE.L A3,A1 A1:=MAN SET STRUCT; "D1=MAN SET REL"
BSR INS_MAN INSERT IN MAN SET(PSTR,PREL,A5=ENV);
***
PRT_MEM DECL_ENV,(A5),EN_SIZ
MOVE.L A0,A5 A5:=OBJ;
BSR S_UPDATE STACK REQ UPDATE(OBJ,A6/D0:=UNDEF);
CLR.L D7 D7:=RESULT:=OK;
BRA RET_OLD2 RETURN TO USER;
OPENDORM DC.B 1<<OB_OPOB+1<<OB_DOOB MASK FOR OBJ KIND;
DS.W 0
INSP_OBJ EQU * INSPECT OBJECT
* CALL AND RETURN: AS OTHER KERNEL OPERATIONS. D4:=INDEX.
BSR INSP_INIT INSPECT INIT(A5:=ENV,A1:=REF STR,
* D1:=REF REL,A0/A3/A6/D2/D4/D5:=...)
MOVE.L A5,A0 A0:=ENV;
MOVEM.L A0/A1/D1,-(A7) SAVE ENV,REF STR,REF REL;
BSR C_ENT CHECK ENTITY(A5:=OBJ,D5:=ENTITY KIND,
* A1/A6/D1/D2/D4:=...);
MOVEM.L (A7)+,A0/A1/D1 RESTORE ENV,REF STR,REF REL;
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
CMP.B #PT_OBJ,D5 IF ENTITY KIND <> OBJECT
BNE EE_VALUE THEN REJECT END;
EXG.L A5,A0 A0:=OBJ; A5:=ENV;
BRA INSP_COM GOTO COMMON INSPECT;
PAGE
INSP_ACT EQU * INSPECT HOLDER OF ACTUAL POINTER
* CALL AND RETURN: AS OTHER KERNEL OPERATIONS. D4:=INDEX,D5:=COUNT.
BSR INSP_INIT INSPECT INIT(A5:=ENV,A1:=REF STR,
* D1:=REF REL,A0/A3/A6/D2/D4/D5:=...);
MOVEM.L A1/D1,-(A7) SAVE REF STR,REF REL;
BSR C_PT CHECK POINTER(A6:=FP ADDR,D2:=FP KIND,
* A1/D1:=...);
MOVEM.L (A7)+,A1/D1 RESTORE REF STR,REF REL;
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
CMP.B #PT_VOI,D2 IF FP KIND = VOID
BEQ EE_SCOPE THEN REJECT END;
BTST.B #PT_FSC,PT_INF(A6) IF FP SCOPE <> FORMAL
BEQ EE_SCOPE THEN REJECT END;
CLR.L D5 D5:=COUNT:=0;
REPEAT REPEAT
ADD.L #1,D5 D5:=COUNT:=COUNT+1;
MOVE.L FP_STR(A6),A3 A3:=FP.ACTUAL STRUCT;
MOVE.L A3,D3 IF DUMMY ACTUAL
BEQ INSP_STA THEN STATUS RESULT END;
MOVE FP_OFF(A6),D3 D3:=FP.ACTUAL REL;
LEA (A3,D3),A6 A6:=FP:=FP.ACTUAL;
BTST.B #PT_FSC,PT_INF(A6)
UNTIL <EQ> UNTIL FP NOT FORMAL;
BTST.B #PT_TSC,PT_INF(A6) "FP = ACTUAL"
IF <NE> THEN.S IF ACTUAL TEMP THEN
MOVE.L CT_OBJ(A3),A0 A0:=OBJ:=ACTUAL STRUCT.CUR_OBJECT;
ELSE.S ELSE
MOVE.L EN_OBJ(A3),A0 A0:=OBJ:=ACTUAL STRUCT.HOLDER;
ENDI END;
BRA INSP_COM GOTO COMMON INSPECT;
PAGE
INSP_CALL EQU * INSPECT CALLER
* CALL AND RETURN: AS OTHER KERNEL OPERATIONS. D4:=INDEX.
BSR.S INSP_INIT INSPECT INIT(A5:=ENV,A1:=REF STR,
* D1:=REF REL,A0/A3/A6/D2/D4/D5:=...);
ADD #1,D6 ARG#:=ARG#+1;
MOVE.L -(A4),D5 D5:=COUNT:=INTEGER ARGUMENT;
BLT EE_DATA IF COUNT <0 THEN REJECT END;
MOVE.L CT_HOLD(A2),A0 A0:=EXT:=CUR_CTX.HOLDER;
MOVE.L A2,A3 A3:=CTX:=CUR_CTX;
WHILE <NE> DO.S WHILE COUNT <> 0 DO
LEA EX_CTX(A0),A6 A6:=HEAD CTX STACK;
IF.L CT_STK+4(A3) <NE> A6 THEN.S
MOVE.L CT_STK+4(A3),A3 IF CTX.PREV <> HEAD CTX STACK THEN
LEA -CT_STK(A3),A3 A3:=CTX:=PREVIOUS CTX;
ELSE.S ELSE
CMP.B #OB_PROB,OB_KIN(A0) IF EXT IS PROCESS
BEQ EE_DATA THEN REJECT "COUNT TOO LARGE END";
MOVE.L EX_EXT+4(A0),A0 A0:=EXT:=PREVIOUS EXT;
LEA -EX_EXT(A0),A0 "OFFSET ADJUST"
MOVE.L EX_CTX+4(A0),A3 A3:=CTX:=EXT.LAST CTX;
LEA -CT_STK(A3),A3 "OFFSET ADJUST"
ENDI END;
SUB #1,D5 D5:=COUNT:=COUNT-1
ENDW END "UNTIL COUNT = 0"
MOVE.L CT_OBJ(A3),A0 A0:=CTX.CUR_OBJECT;
BRA.S INSP_COM GOTO COMMON INSPECT;
INSP_PROC EQU * INSPECT PROCESS
* CALL AND RETURN: AS OTHER KERNEL OPERATIONS. D4:=INDEX;
BSR.S INSP_INIT INSPECT INIT(A5:=ENV,A1:=REF STR,
* D1:=REF REL,A0/A3/A6/D2/D4/D5:=...);
MOVE.L CT_HOLD(A2),A0 A0:=EXT:=CUR_CTX.HOLDER;
MOVE.L EX_PR(A0),A0 A0:=PROC:=EXT.PROCESS;
BRA.S INSP_COM GOTO COMMON INSPECT;
PAGE
INSP_INIT EQU * INSPECT INITIALIZATION
* CALL: RETURN:
* A1 - REF STRUCT (STRUCTURE OF FUTURE REF_ENV)
* A2 CONTEXT SAME
* A4 ARGUMENT ADDR UPDATED
* A5 - ENVELOPE (OF MANAGER OBJECT)
* D1 - REF REL (RELATIVE OF FUTURE REF_ENV)
* D6 ARGUMENT# UPDATED
* A0/A3/A6/D2/D4/D5/D7: - UNDEF
* EXITS TO USER IN CASE OF ERRORS.
* CHECKS FIRST TWO POINTER ARGUMENTS TO FIND ENVELOPE (MANAGER OBJECT)
* AND FUTURE REF_ENV.
MOVE.L (A7)+,A3 A3:=POP RETURN;
BSR C_PRIM CHECK PRIMARY ENV(A5:=ENV,
* A0/A1/A6/D1/D2/D4/D5:=...);
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
BSR C_PT CHECK POINTER(A1:=REF STR,D1:=REF REL,
* D2:=PT KIND,A6:=PT_ADDR);
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
CMP.B #PT_ENV,D2 IF PT KIND <> SIMPLE
BGT EE_VALUE THEN REJECT END;
JMP (A3) RETURN;
PAGE
INSP_COM EQU * COMMON INSPECT
* CALL: RETURN:
* A0 OBJECT UNDEF (ZERO FOR ABORTED OBJECTS)
* A1 REF STRUCT(OF REF_ENV) UNDEF
* A2 CUR CTX UNDEF
* A5 MANAGER ENVELOPE UNDEF
* D1 REF REL (OF REF_ENV) UNDEF
* D4 - INDEX (OF MAN_SET WITHIN ENVELOPE)
* D5 COUNT OR UNDEF SAME
* D7 - RESULT
* RETURNS TO USER, STACK AS AT ENTRY TO KERNEL OPERATIONS.
MOVE.L A0,D0 IF OBJ=0 "ABORTED CONTEXT"
BEQ.S INSP_STA THEN STATUS RESULT END;
BTST.B #OB_EMB,OB_STA(A0) IF EMBEDDED OBJECT
BNE.S INSP_STA THEN STATUS RESULT END;
MOVE.L OB_SPA(A0),A6 A6:=TOP OBJ;
MOVE.L SP_ENV+4(A6),A3 A3:=ENV:=OBJ.TOP ENV; "OFFSET"
LEA SP_ENV(A6),A6 A6:=ENV_HEAD;
WHILE.L A3 <NE> A6 DO.S WHILE ENV <> ENV_HEAD DO
CMP.L EN_MAN-EN_STK(A3),A5
IF <EQ> THEN.S IF ENV.MAN_STRUCT=MANAGER ENV THEN
MOVE EN_OFF-EN_STK(A3),D4 D4:=INDEX:=
SUB #EN_SIZ-PT_SIZ,D4 (ENV.MAN_REL-BASE)/POINTER SIZE;
EXT.L D4
DIVU #PT_SIZ,D4
EXT.L D4 "LONG INTEGER"
MOVEM.L D4/D5,-(A7) SAVE INDEX,COUNT
BSR CLR_SMP CLEAR SIMPLE (REF STR, REF REL,A6:=PT);
LEA -CT_STK(A3),A5 A5:=ENV;
MOVE #PT_ENV,D5 D5:=ENTITY KIND:=REF_ENV;
CLR D4 D4:=NO CAPS;
BSR COPY_NIL COPY TO NIL(ENV,PT,REF_ENV,CAPS,A1:=...)
MOVEM.L (A7)+,D4/D5 D4/D5:=INDEX,COUNT;
CLR.L D7 D7:=RESULT:=OK;
BRA RET_OLD2 RETURN TO USER;
ENDI END;
MOVE.L 4(A3),A3 A3:=PREV ENV; "OFFSET"
ENDW END "UNTIL NO MORE ENVELOPES";
INSP_STA EQU * STATUS RESULT:
MOVE.L #ECRNOT_IN,D7 D7:=RESULT:=NOT_IN_SET
BRA RET_OLD2 RETURN TO USER;
PAGE
SET_CAPS EQU * SET CALL CAPABILITY
* CALL AND RETURN: AS OTHER KERNEL OPERATIONS.
MOVE.L D4,D0 D0:= LOW_ARG; "SAVED FOR CRE_CTX"
BSR C_ENT CHECK ENTITY(A5:=OBJ,D2:=PTKIND,
* A1:=PSTR,D1:=PREL,A6/D4/D5:=...);
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
CMP.B #PT_OBJ,D2 IF PT KIND <> REF OBJ
BNE EE_VALUE THEN REJECT END;
CMP.B #OB_GEOB,OB_KIN(A5) IF OBJ.KIND <> GENERAL OBJ
BNE EE_STATE THEN REJECT END;
MOVEM.L D0/D1/D4/A1/A5,-(A7) SAVE OBJ, PSTR, CAPS, PREL, LOW_ARG;
MOVE GE_CON(A5),D5 D5:=FUNCTION:=OBJ.CONTROL_PROC;
IF <EQ> THEN.S IF DUMMY CONTROL PROC THEN
MOVE.L #DUM_MAN,A5 A5:=MAN_OBJ:=DUMMY MANAGER
ELSE.S ELSE
MOVE.L OB_SPA(A5),A6 A6:=TOP OBJ;
MOVE.L SP_ENV+4(A6),A6 A6:=OBJ.TOP_ENV; "OFFSET"
MOVE EN_OFF-EN_STK(A6),D0 D0:=TOP ENV.MAN_REL;
MOVE.L EN_MAN-EN_STK(A6),A5 A5:=TOP ENV.MAN_STRUCT;
IF.L A5 <EQ> #0 THEN.S IF DUMMY MANAGER THEN
CLR D5 D5:=FUNCTION:=DUMMY;
MOVE.L #DUM_MAN,A5 A5:=MAN_OBJ:=DUMMY MANAGER;
ELSE.S ELSE
BTST.B #PT_LSC,PT_INF(A5,D0)
IF <EQ> THEN.S IF TEMP MANAGER POINTER THEN
CLR D5 D5:=FUNCTION:=DUMMY;
MOVE.L #DUM_MAN,A5 A5:=MAN_OBJ:=DUMMY MANAGER;
ELSE.S ELSE
MOVE.L EN_OBJ(A5),A5 A5:=MAN_OBJ:=MAN_STRUCT.HOLDER;
ENDI END
ENDI END
ENDI END "FIND MANAGER"
MOVE.L CT_HOLD(A2),A0 A0:=EXT:=CUR_CTX.HOLDER;
MOVE.L (A7)+,D4 D4:= LOW_ARG; "RESTORED"
MOVE #1,D3 D3:=ADDITIONAL FORMALS:=1;
BSR CRE_CTX CREATE CTX(EXT,...,A3:=NEW CTX,D4:=ENTRY,
* A1/A5/A6/D0-D2:=UNDEF);
MOVEM.L (A7)+,D1/D2/A1/A5 RESTORE OBJ, PSTR, CAPS, PREL;
BEQ RET_FAST IF NOT OK THEN RETURN TO USER END;
MOVE D5,-(A7) SAVE FUNCTION;
MOVE CT_TOPT(A3),D3 D3:=NEW CTX.F(1); "FP REL"
BSR SET_ACT SET ACTUAL REF(P STR,PREL,FP REL,NEW CTX);
LEA (A3,D3),A6 A6:=FP:=NEW CTX.F(1);
EXG.L D4,D2 D2:=ENTRY; D4:= CAPS;
MOVE #PT_OBJ,D5 D5:=ENTITY KIND:=OBJECT;
BSR COPY_NIL COPY TO NIL(F(1),OBJ,CAPS,A1:=UNDEF);
BSET.B #PT_RET,PT_INF(A6) F(1).RETURN:=TRUE;
MOVE.L D2,D4 D4:=ENTRY;
MOVE (A7)+,D5 RESTORE FUNCTION;
EXT.L D5 FUNCTION:=32 BITS;
BSR SAVE_STK SAVE SUPV STACK(CUR_CTX,ENTRY,FUNCTION,
* A5/A6/D0:=UNDEF);
MOVE #1,D3 D3:=ADDITIONAL FORMALS:=1;
BSR SET_FP SET FORMALS(EXT,CUR_CTX,NEW_CTX,ARG ADDR,
* ADDITIONAL FORMALS,ARG#,D3:=#FORMALS,
* A1/A5/A6/D0-D2/D4/D5:=UNDEF);
IF <NE> THEN.S IF OK THEN
TST.L (A7)
IF <NE> THEN.S IF FUNCTION <> 0 "STACKED BY SAVE_STK" THEN
BSR ENT_CTX ENTER CONTEXT(A3=CTX,D3:=#FORMALS)
* "CONTINUES HERE AT OBJ_RETURN. A3=CTX"
ELSE.S ELSE
CLR.L D7 D7:=RESULT:=OK
ENDI END;
BSR RET_FP RETURN FORMALS(A3=CTX,D6/D7:=UPDATED);
TST.W D7 IF RESULT=OK
IF <EQ> THEN.S THEN
MOVE.W CT_TOPT(A3),D3 D3:=INDEX TO FIRST FORMAL
MOVE.L FP_STR(A3,D3),A6 A6:=ACTUAL POINTER :=
ADDA.W FP_OFF(A3,D3),A6 FML.STRUCT+FML.OFFSET;
IF.B PT_KIN(A6) <EQ> #PT_OBJ THEN.S
MOVE.L PT_REF(A6),A5 IF ACTUAL IS REF_OBJ AND A5:=ACT.OBJECT;
IF.B OB_KIN(A5) <EQ> #OB_GEOB THEN.S IF OBJECT IS GENERAL THEN
BSET.B #PT_CC,PT_INF(A6) PUT ON CALL CAP IN ACTUAL POINTER;
ENDI ENDI; OBJ IS GENERAL
ENDI ENDI; ACTUAL IS REF_OBJ
ENDI ENDI; RESULT=OK
ENDI END "SET FP CARRIED OUT"
BSR DEL_CTX DELETE CTX(CTX,A3:=OLD CTX,A0:=EXT);
BSR RSTO_STK RESTORE SUPV STACK(OLD CTX,A5/A6/D0:=UNDEF
BRA RET_OLD3 RETURN TO USER;
TTL CHECK PROCEDURES
PAGE
C_PT EQU * CHECK POINTER ARGUMENT, NORMAL CTX
* CALL: RETURN:
* A1 - POINTER STRUCT (UNDEF IF VOID ARG.)
* A2 CONTEXT SAME
* A4 ARGUMENT ADDR UPDATED
* A6 - POINTER (UNDEF IF VOID ARG.)
* D1.W - POINTER REL (UNDEF IF VOID ARG.)
* D2.W - POINTER KIND (VOID KIND IF VOID ARG.)
* D6.W ARGUMENT# UPDATED
* D7.L - UNDEF IF OK, RESULT IF NOT OK
* SR - NE=OK, EQ=NOT OK
* TRANSFORMS A POINTER ARGUMENT (OR THE FIRST PART OF A SUBSEGM
* ARGUMENT) INTO A POINTER ADDRESS, ETC.
MOVE D3,-(A7) SAVE D3
CLR D3 D3:=RESIDENT:=NORMAL CTX
BRA.S C_PTCOM GOTO COMMON WITH C_PTRES
C_PTRES EQU * CHECK POINTER, NORMAL OR RESIDENT
* CALL: RETURN:
* D3 RESIDENT CTX (<>0) SAME
* OTHER: AS C_PT
* IF CALLED FROM A RESIDENT CTX: CHECKS THAT AN
* INDIRECT ADDRESS HAS A RESIDENT FIRST PART. OTHERWISE AS C_PT.
MOVE D3,-(A7) SAVE D3
C_PTCOM EQU *
ADD #1,D6 ARGUMENT#:=...+1;
MOVEQ #PT_VOI,D2 D2:=POINTER_KIND:=VOID;
MOVE -(A4),D7 D7:=F/T/L,INDEX1 OR INDEX2;
IF <NE> THEN IF NOT VOID THEN
MOVE -(A4),D1 D1:=0 OR F/T/L, INDEX1;
IF <EQ> THEN.S IF DIRECT THEN
EXG D1,D7 D1:=F/T/L,INDEX1; D7:=0
TST D1 END;
ENDI "D1=F/T/L,INDEX1; D7=0 OR INDEX2"
IF <LT> THEN.S IF LOCAL THEN
AND #PT_MASK,D1 D1:=INDEX1; "MULT OVERFLOW PREVENTED"
BEQ ER_ILLE IF INDEX1 = 0 THEN ADDR_ILLEGAL END;
MULU #PT_SIZ,D1 D1:=POINTER_REL:=
ADD #EN_SIZ-PT_SIZ,D1 INDEX1*POINTER_SIZE+BASE;
MOVE.L CT_OBJ(A2),A6 A6:=CURRENT_OBJECT(CTX);
MOVE.L OB_SPA(A6),A6 A6:=TOP_OBJ;
MOVE.L SP_ENV+4(A6),A1 A1:=POINTER STRUCT:=TOP_ENV(OBJ);
LEA -EN_STK(A1),A1 A1:= FIRST OF STRUCT;
CMP EN_TOPL(A1),D1 IF POINTER REL >= TOP_ENV.TOP_LOCAL
BCC ER_ILLE THEN ADDR_ILLEGAL END;
ELSE.S ELSE "END LOCAL"
MOVE.L A2,A1 A1:=POINTER STRUCT:=CTX;
BTST.L #14,D1
IF <NE> THEN.S IF TEMP THEN
AND #PT_MASK,D1 D1:=INDEX1; "MULT OVERFLOW PREVENTED"
BEQ ER_ILLE IF INDEX1=0 THEN ADDR_ILLEGAL END;
MULU #PT_SIZ,D1 D1:=POINTER_REL:=
ADD #CT_SIZ,D1 INDEX1*POINTER_SIZE + BASE
CMP CT_TOPT(A1),D1 IF POINTER REL >= CTX.TOP_LOCAL
BCC ER_ILLE THEN ADDR_ILLEGAL END;
ELSE.S ELSE "FORMAL"
AND #PT_MASK,D1 D1:=INDEX1; "MULT OVERFLOW PREVENTED"
BEQ ER_ILLE IF INDEX1 = 0 THEN ADDR_ILLEGAL END;
SUB #1,D1 D1:=POINTER_REL:=
MULU #FP_SIZ,D1 (INDEX1-1)*FP_SIZE+BASE;
ADD CT_TOPT(A1),D1
CMP CT_TOPF(A1),D1 IF POINTER REL >= CTX.TOP_FORMAL
BCC.S ER_ILLE THEN ADDR_ILLEGAL END;
ENDI END "FORMAL"
ENDI END "NON-LOCAL"
AND #PT_MASK,D7 D7:=INDEX2; "MULT OVERFLOW PREVENTED"
IF <NE> THEN.S IF INDEX2 <> 0 THEN "INDIRECT"
IF.B PT_KIN(A1,D1) <EQ> #PT_ENV THEN.S IF POINTER.KIND = ENV_REF
MOVE.L PT_REF(A1,D1),A1 THEN A1:=POINTER_STRUCT:=ENVELOPE
ELSE.S ELSE "INDIRECT THROUGH MAN_SET"
CMPI.B #PT_MAN,PT_KIN(A1,D1) IF POINTER.KIND <> MAN_SET
BNE.S ER_ILLE THEN ADDR_ILLEGAL END;
TST D3
IF <NE> THEN.S IF RESIDENT CTX THEN
BTST.B #PT_RES,PT_INF(A1,D1) IF POINTER NOT RESIDENT
BEQ.S ER_ILLE THEN ADDR_ILLEGAL END
ENDI END;
MOVE.L 4(A1,D1),A1 POINTER_STRUCT:=MAN_SET.LAST_ENV;
ENDI END "ENVELOPE FOUND"
MOVE D7,D1
MULU #PT_SIZ,D1 D1:=POINTER_REL:=
ADD #EN_SIZ-PT_SIZ,D1 INDEX2*PT_SIZE+BASE;
CMP EN_TOPL(A1),D1 IF POINTER REL >= ENV.TOP_LOCAL
BCC.S ER_ILLE THEN ADDR ILLEGAL END;
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;
«eof»