|
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: 156288 (0x26280)
Types: TextFile
Names: »SC.SA«
└─⟦1ed910a99⟧ Bits:30009789/_.ft.Ibm2.50006596.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »SC.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⟧ »SC.SA«
***********************************************************************
* Copyright 1984 by *
* NCR Corporation *
* Dayton, Ohio U.S.A. *
* All Rights Reserved *
***********************************************************************
* EOS Software produced by: *
* NCR Systems Engineering - Co enhagen *
* Copenhagen *
* DENMARK *
***********************************************************************
SCHEDULE IDNT 1,0 SCHEDULER FACILITIES
OPT FRS FORWARD REFERENCE SHORT.
NOLIST
INCLUDE COMDEF.SA
LIST
* WRITTEN BY VILHELM ROSENQVIST
*
* THE FACILITIES OF THE SCHEDULER ARE:
* CENTRAL SCHEDULING ALGORITHMS (ROUND ROBIN ETC)
* CLOCK MANAGEMENT (TIME_OUT)
* SYNCHRONIZATION
* DRIVER AND INTERRUPT MANAGEMENT.
*
* THE FUNCTIONS APPEAR AS
* - SERVICE PROCEDURES FOR OTHER PARTS OF THE KERNEL (E.G. KNELWAIT)
* - KERNEL OPERATIONS (E.G. IO_BEGIN)
* - INITIAL OBJECT FUNCTIONS (E.G. NEW_COND)
* - PRIVILEGED OBJECT FUNCTIONS (E.G. DECL_GATE)
* - GENERAL OBJECT FUNCTIONS (E.G. NEW_SCHED)
*
* INITIALLY THREE SCHEDULER OBJECTS ARE PRESENT (GENERAL OBJECTS)
* 1: THE INITIAL SCHEDULER
* 2: A NORMAL SCHEDULER
* 3: AN INTERRUPT SCHEDULER
* THE STUB OBJECT GETS A REFERENCE (LOCAL-4 AND 5) TO THE
* NORMAL SCHEDULER AND TO THE INTERRUPT SCHEDULER
* THE INITIAL SCHEDULER CAN ONLY BE CALLED BY INTERRUPT SCHEDULERS.
* THE INITIAL SCHEDULER OWNS SUPERVISOR STACK EXTENSIONS (NOT IMPLEMENTED)
* PRIVILEGED OBJECT FUNCTIONS ARE CALLED BY THE SCHEDULERS USING
* A REFERENCE TO THE INITIAL "DECL_DIV" OBJECT.
* "DECL_DIV" IS THE ONLY KERNEL DEFINED OBJECT WITH OB_KIN=OB_SCHE.
*
* THE SCHEDULER OBJECTS MAY CREATE OTHER SCHEDULER OBJECTS AND
* PROCESSES, GATES, CONDITIONS AND CHANNELS (DRIVERS).
PAGE
* SCHEDULER DEFINITIONS
A_FORMAL EQU 0<<14 DIRECT ADDRESS OF FORMAL POINTER
A_LOCAL EQU 2<<14 DIRECT ADDRESS OF LOCAL POINTER
A_TEMP EQU 1<<14 DIRECT ADDRESS OF TEMP POINTER
ACT_SIZ EQU AR_SIZ SIZE OF ACTUAL ARG/SUBSEGM ARG/VOID VALUE ARG
XREF.S 9:RTEDUMMY DUMMY INTERRUPT PROCEDURE IN PREFACE
* USE PTMCHIP ADDRESS OF CLOCK DEVICE
* USE TIMER2 SINGLE SHOT TIMER
* USE TIMER3 FREE RUNNING COUNTER
* USE STATCON2 CLOCK STATUS
XREF.S 7:ALLOCOBJ ALLOCATE OBJECT ?
XREF 11:GETSTUBE GET ADDRESS OF STUB ENVELOPE
XREF 9:SIMPLEPT CREATE SIMPLE POINTER TO OBJECT
XREF 11:MAKESEGM CREATE A SEGMENT OBJECT
XREF 9:INIT_ENV INITIALIZE ENVELOPE OF INITIAL OBJECT
XREF 9:INITGEIN INITIALIZE INITIAL GENERAL OBJECT
XREF 9:MM_PUSHK,MM_POPO,MM_PUSHO
XREF 9:INITKNEL INITIALIZES A KERNEL PART AS AN OPEN OBJECT
XREF 9:TOP_RUNK TOP OF KERNEL RUNTIME SECTION (ROUNDED BELOW)
XREF.S 7:KV_INVEC EXCEPTION VECTOR (NORMALLY PLACED AT ADDRESS ZERO)
XREF.S 7:SUPV_STK CONTAINS THE ADDRESS OF THE LAST+1 BYTE OF SUPV. STACK
XREF.S 7:F_SUPVS CONTAINS THE ADDRESS OF THE FIRST BYTE OF SUPV. STACK
* PROCEDURES FROM KNELOP:
XREF 9:RET_FAST,C_PT,C_SUB,INT_EXC,PREP_RET,LOAD_MMU,C_ENTRES,CLR_SMP
XREF 9:TR_SPEED
XREF 11:I_KNELOP INITIALIZE KNELKOP
XDEF START_PROC,NEXT_PROC,DECLBOOT,DRIV_TAB,STAK_TAB,KNELSIGN,KNELWAIT
XDEF KV_CTX,RUNNING,TIMCHECK,I_SCHED,INT_CTX,SCHEDOBJ,GATE_OBJ,COND_OBJ
XDEF SAVE_STK,RSTO_STK,KV_SPSAVE,SAVE_SR,SAVE_PC,EOSBEGIN,FORCE_OPEN
XDEF TINTRUPT,RTCNT,INCRDECR,TERMDRIV,TERMGATE,TERMCOND,PROPSPED
XDEF NIOBEGIN,IIOBEGIN,RIOBEGIN,NIO_END,IIO_END,RIO_END,INT_SIGN
XDEF NABSADDR,IABSADDR,RABSADDR,KV_PROC,CONVADDR,GET_TIME
PAGE
SECTION.S 7 = KNEL_VAR. KERNEL VARIABLES OF THE SCHEDULER.
*
DRIV_TAB DS.L 256 ONE ENTRY FOR EACH CHANNEL (INTERRUPT SOURCE)
STAK_TAB DS.L 256 ONE ENTRY FOR EACH CHANNEL.
* BOTH ENTRIES ARE ZERO FOR AN UNUSED CHANNEL AND
* -1 FOR A PERMANTLY RESERVED CHANNEL.
* AFTER A DRIVER FOR A CHANNEL IS INSTALLED, DRIV_TAB(CHANNEL) CONTAINS
* THE ADDRESS OF THE FIELD "ENV.ENSTK" OF THE DRIVER ENVELOPE (<>0) AND
* STACK_TAB(CHANNEL) CONTAINS INT_STK <<16 + LEVEL (<>0).
* INT_STK TELLS THE MAX NUMBER OF BYTES USED DURING PROCESSING
* OF A CHANNEL INTERRUPT. LEVEL GIVES THE INTERRUPT LEVEL OF THE
* ASSOCIATED INTERRUPT SOURCE. THE INTERRUPT VECTOR OF A USED
* CHANNEL POINTS TO THE INTERRUPT PROCEDURE OF THE CHANNEL.
*
TIMER DS.W CHAIN PROCESSES WAITING FOR TIME_OUT
* PROC=RUNNING_CURRENT OR PROC.STATE=WAIT=2 OR =D_WAIT=4
RUNNING DS.W CHAIN PROCESSES EXECUTING NORMAL CONTEXTS.
* PROC.STATE=RUN=0
DRIVING DS.W CHAIN PROCESSES EXECUTING RESIDENT CONTEXTS
* PROC.STATE=RUN=0 OR =D_WAIT=4
KV_CTX DS.L 1 TOP CONTEXT OF CURRENT PROCESS.
* ZERO WHEN DUMMY PROCESS IS RUNNING
KV_PROC DS.L 1 CURRENT PROCESS, USED TO IDENTIFY THE PROCESS THAT CALLED
* THE KERNEL.
* UNDEF WHEN DUMMY PROCESS IS RUNNING
KV_SPSAVE DS.L 1 CURRENT SUPERVISOR STACK POINTER. CHANGES WHEN A RECURSION
* OF THE SCHEDULER IS CREATED OR REMOVED (SE TR_TR8 FF).
* POINTS TO SAVED A4,A5,A6,SR,PC IN THE STACK
SAVE_PC DS.L 1 USED BY SCHEDULER TO SAVE PC AND SR
SAVE_SR DS.W 1 OF CURRENT PROCESS
RTCNT DS.L 2 64 BIT REAL TIME COUNTER
* INITIALLY ZERO, COUNTS THE ELAPSED TIME IN MICRO SECONDS
*
* INITIAL OBJECTS
*
SCHEDSIZ EQU GE_SIZ+SP_SIZ+EN_SIZ+(PT_SIZ*6) SIZE OF GENERAL SCHEDULER OBJ.
*
INIT_SCH DS.B SCHEDSIZ INITIAL SCHEDULER OBJECT
*
NORM_SCH DS.B SCHEDSIZ NORMAL SCHEDULER OBJECT
*
INTR_SCH DS.B SCHEDSIZ INTERRUPT SCHEDULER OBJECT
*
DDIV_SCH DS.B OB_SIZ+SP_SIZ DECL_DIV OBJECT
*
SCH_CODE DS.B SE_SIZ+SP_SIZ SEGMENT OBJECT HOLDING CODE OF SCHED
INT_CTX DS.B ST_SIZ+2 ST_FIELDS+CT_TOPT ARE PRESENT IN THE INTERRUPT_CTX.
* THE CONTEXT IS "CURRENT CONTEXT" WHEN AN
* INTERRUPT PROCEDURE CALLS THE KERNEL.
DS.B ACT_SIZ*3 ROOM FOR THREE ACTUALS
SCHD_ARG EQU * USED WHEN A GATE CREATES A COND BY CALLING SCHEDULER OBJ.
PAGE
SECTION 11 = INITIALIZE INITIALIZE SCHEDULER
I_SCHED EQU * ENTRY TO INIT PART OF SCHEDULER
* THE SCHEDULER INITIALIZATION GETS CONTROL AFTER MM_PROC HAS INITIALIZED.
* THE FOLLOWING STEPS ARE CARRIED OUT:
* 1) INITIALIZE SIMPLE GLOBAL VARIABLES
* 2) INITIALIZE INITIAL OBJECTS
* 3) INITIALIZE STUB OBJECT
* 4) INITIALIZE TRAP#8 = INTERRUPT_END
* INITIALIZE SIMPLE VARIABLES
INIT_HEAD TIMER,A0 TIMERQUEUE IS EMPTY;
INIT_HEAD RUNNING,A0 RUNNING QUEUE:=EMPTY;
INIT_HEAD DRIVING,A0 DRIVING QUEUE:=EMPTY;
LEA RTCNT,A0 A0:=REAL TIME COUNTER; "64BITS"
CLR.L (A0)+ REAL TIME COUNTER:=0
CLR.L (A0) .
* INITIALIZE INTERRUPT CONTEXT AND SCHEDULER OBJECTS
* INT_CTX
LEA INT_CTX,A0 A0:=INT_CTX;
LEA 4-OB_SPA(A0),A1 A1:="EVALUATES" 4(A0)
MOVE.L A1,CT_OBJ(A0) INT_CTX.EXECUTES:="EVALUATES" 4(A0)
LEA 0-(SP_ENV+4)(A0),A1 A1:="EVALUATES" 0(A0)
MOVE.L A1,4(A0) 4(A0):="EVALUATES" 0(A0)
* AN ENVELOPE ADDRESS MAY NOW BE ASSIGNED TO 0(A0); THE POINTERS
* OF THE ENVELOPE WILL BE LOCAL POINTERS OF INT_CTX;
* "EVALUATES" ARE DEFINED ACCORDING TO THE ALGORITHM IN "C_PT"
* (LOCAL POINTER ARGUMENT).
* THE INT_CTX IS ALSO USED AS A DUMMY CONTEXT WHEN THE
* INITIAL CONTEXT OF THE BOOT PROCESS IS CREATED. THE VALUES INITIALIZED
* BELOW ARE USED BY "CRE_CTX"
MOVE.B #3,CT_MODE(A0) CTX.PROPAGATION_MODE:=SAME;
CLR.B CT_SPE(A0) CTX.SPEED_UP_STATUS:=NORMAL;
PRT_MEM INT_CTX,(A0),ST_SIZ+2 ********
* CODE SEGMENT FOR SCHEDULER OBJECTS
* THE CODE SEGMENT DESCRIBES SECTION 7+9 OF THE KERNEL CODE IN THIS RAM-VERSION
* OF THE KERNEL. IN A ROM-VERSION THIS SHOULD BE CHANGED TO SECTION 9+11.
LEA SCH_CODE,A0 A0:=CODE SEGMENT OBJECT;
MOVEQ.L #0,D2 D2:=FIRST BYTE OF SECTION 7 := 0;
TST.B D2 TEST_PAGE
IF <NE> THEN.S
ERROR 30 ERROR(30)
ENDI
MOVE.L #TOP_RUNK,D1 D1:=TOP_BYTE OF SECTION 9;
ADDI.W #255,D1 ROUND
CLR.B D1 UP;
SUB.L D2,D1 D1:=LENGTH OF CODE;
MOVE.L D2,A1 A1:=FIRST BYTE OF CODE;
MOVE.L #SE_SIZ+SP_SIZ,D0 D0:=SIZE OF SEGMENT OBJECT;
BSR.L INITKNEL INITKNEL(A0=OBJ,D0=SIZ);
BSR.L MAKESEGM MAKESEGM(A0=OBJ,A1=FIRST BYTE,D1=LENGTH);
LEA SCHEDENT,A2 A2:=ADDRESS OF SCHEDULER ENTRY
SUB.L D2,A2 A2:=ENTRY POINT OFFSET INTO CODE SEGM
* :=ENTRY ADDRESS - FIRST BYTE OF CODE;
PAGE
* DECL_DIV OBJECT (A2 MUST NOT BE DESTROYED)
*
LEA DDIV_SCH,A0 A0:=DECL_DIV OBJECT
MOVE.L #OB_SIZ+SP_SIZ,D0 D0:=SIZE OF DECL_DIV OBJECT
BSR.L INITKNEL INITKNEL(A0=OBJ,D0=SIZE);
MOVE.B #OB_SCHE,OB_KIN(A0) OBJECT.KIND:=DECL_DIV;
MOVE.B #1<<OB_REEN,OB_STA(A0) OBJECT.STATE:=REENTRANT OBJECT;
PRT_MEM DDIV_SCH,(A0),OB_SIZ+SP_SIZ ********
*
* GENERAL SCHEDULER OBJECTS; A2=ENTRY POINT
*
CLR.L -(A7) PUSH "END_OF_LIST"
PEA INIT_SCH PUSH ADDRESS OF INITIAL SCHEDULER
PEA NORM_SCH PUSH ADDRESS OF NORMAL SCHEDULER
LEA INTR_SCH,A0 A0:=ADDRESS OF INTERRUPT SCHEDULER
REPEAT REPEAT "A0=OBJECT"
MOVE.L #SCHEDSIZ,D0 D0:=SIZE OF OBJECT
BSR.L INITKNEL INITKNEL(A0=OBJ,D0=SIZE);
CLR.W OB_OFF(A0) INITIAL OWNER POINTER IS THE OWNER;
MOVE.L A2,A1 A1:=ENTRY POINT
BSR.L INITGEIN INIT_GENERAL(A0=OBJ,A1=ENTRY,A1:=UNDEF);
MOVE.L #EN_SIZ+(PT_SIZ*6),D0 D0:=SIZE OF PRIMARY ENVELOPE
BSR.L MM_PUSHK A3:=ENVELOPE,A6:=SPACE DESC;
BSR.L INIT_ENV INIT_ENV(A3=ENV,D0=SIZE,A6=SPACE DESC)
LEA EN_SIZ(A3),A0 A0:=LOCAL-1 OF ENVELOPE
LEA SCH_CODE,A4 A4:=CODE_SEGMENT;
BSR.L SIMPLEPT LOCAL-1 BECOMES POINTER TO CODE_SEGMENT
LEA PT_SIZ*2(A0),A0 A0:=LOCAL-3:=NEXT NEXT TO LOCAL-1
LEA ALLOCOBJ,A4 A4:=ALLOCOBJ;
BSR.L SIMPLEPT LOCAL-3 BECOMES POINTER TO ALLOC
LEA PT_SIZ(A0),A0 A0:=LOCAL-4:=NEXT TO LOCAL-3;
LEA DDIV_SCH,A4 A4:=DECL_DIV OBJECT
BSR.L SIMPLEPT LOCAL-4 BECOMES POINTER TO DECL_DIV;
PRT_MEM GEN_SCHED,(A3),SCHEDSIZ-GE_SIZ ********
MOVE.L (A7)+,A0 A0:=NEXT SCHEDULER OBJECT;
UNTIL.W A0 <EQ> #0 UNTIL NO MORE SCHEDULER OBJECTS
* AT EXIT A3=ENVELOPE OF INITIAL SCHEDULER
* FIND LOCAL-5 OF INTERRUPT SCHEDULER, CREATE A REF ENVELOPE TO
* INITIAL SCHEDULER IN LOCAL-5
LEA INTR_SCH,A0 A0:=OBJ;
MOVE.L OB_SPA(A0),A0 A0:=SPACE DESCR OF OBJ;
MOVE.L SP_ENV+4(A0),A0 A0:=TOP ENV OF OBJ;
LEA EN_SIZ-EN_STK+PT_SIZ*4(A0),A0 A0:=LOCAL-5 OF ENV;
MOVE.L A3,PT_REF(A0) LOCAL-5.REFERENCE:=ENVELOPE;
MOVE.B #PT_ENV,PT_KIN(A0) LOCAL-5.KIND:=REF_ENV;
LEA EN_REF(A3),A3 A3:=REF_ENV CHAIN
INS_ELEM A3,A0,A6,A3/A6 CHAIN LOCAL-5 TO ENVELOPE;
PAGE
* FINALIZE THE STUB OBJECT, LOCAL 4,5,7,8 AND 9
*
BSR.L GETSTUBE A3:=ENVELOPE OF STUB OBJECT
LEA EN_SIZ+PT_SIZ*3(A3),A0 A0:=LOCAL-4 OF STUB;
LEA NORM_SCH,A4 A4:=NORMAL SCHEDULER
BSR.L SIMPLEPT LET LOCAL-4 POINT TO NORMAL SCHEDULER
LEA PT_SIZ(A0),A0 A0:=LOCAL-5:=NEXT TO LOCAL-4
LEA INTR_SCH,A4 A4:=INTERRUPT SCHEDULER
BSR.L SIMPLEPT LET LOCAL-5 POINT TO INTERRUPT SCHEDULER
LEA PT_SIZ<<1(A0),A0 A0:=LOCAL-7:=NEXT NEXT TO LOCAL-5
* LOCAL-7 POINTS TO DEFVIRT OBJECT, REMAINS NIL
LEA PT_SIZ(A0),A0 A0:=LOCAL-8:=NEXT TO LOCAL-7
MOVE.L EN_OBJ(A3),A4 A4:=STUB OBJECT
BSR.L SIMPLEPT LET LOCAL-8 POINT TO THE STUB OBJECT
LEA PT_SIZ(A0),A0 A0:=LOCAL-9:=NEXT TO LOCAL-8;
MOVE.L A3,PT_REF(A0) LOCAL-9.REFERENCE:=STUB ENVELOPE
MOVE.B #PT_ENV,PT_KIN(A0) LOCAL-9.KIND:=REF_ENVELOPE;
LEA EN_REF(A3),A3 A3:=REF_ENV CHAIN
INS_ELEM A3,A0,A6,A3/A6 CHAIN LOCAL-9 TO ENVELOPE;
* LOCAL-9 HOLDS A REF_ENV TO THE STUBS OWN PRIMARY ENVELOPE.
* INITIALIZE TRAP#8
LEA KV_INVEC,A0 A0:= EXCEPTION VECTOR; "NORMALLY ZERO"
LEA DRIV_TAB,A2 A2:= DRIVER_TABLE;
LEA STAK_TAB,A3 A3:= STACK_TABLE;
MOVE.W #(32+8)<<2,D0 D0:= INDEX TO TRAP#8
MOVE.L #TR_TR8,(A0,D0.W) EXCEPT_ADDR(TRAP#8):= TR_TR8;"=INT_END"
MOVEQ.L #-1,D1 D1:= CHANNEL RESERVED:= -1;
MOVE.L D1,(A2,D0.W) DRIVER_TABLE(TRAP#8):= CHANNEL RESERVED;
MOVE.L D1,(A3,D0.W) STACK_TABLE(TRAP#8):= CHANNEL RESERVED;
PRT_MEM END_OF_SC_ETC.,TIMER,INIT_SCH-TIMER ********
BRA.L I_KNELOP GOTO INIT KNELOP;
* END OF INITIALIZE SECTION IN SCHEDULER;
PAGE
SECTION 9 = RUN_TIME
* RUNTIME SECTION OF SCHEDULER
TINTRUPT EQU * INTERRUPT PROCEDURE FOR THE PTMCHIP
* THE INTERRUPT PROCEDURE UPDATES THE REAL TIME COUNTER (RTCNT).
* IF A REQUESTED TIME OUT INTERRUPT OCCURED, THE TIME_OUT PROCEDURE
* OF THE SCHEDULER WILL BE CALLED AND TRAP #8 MAY BE CALLED TOO.
*
MOVEM.L D0-D7/A0-A6,-(A7) SAVE REGISTERS;
MOVE.W SR,D5 SAVE SR IN D5;
CLR.B D5 SAVED CCR:=0 => <NE>;
MOVE #$2700,SR PREVENT INTERRUPTS;
BSR.L RT_UPDAT D2/D3:=RTCNT; A4=TIMER CHIP
* D4:=TIMER STATUS
BTST.L #1,D4
IF <NE> THEN.S IF TIMER2-INTRPT IN TIME_STATUS THEN
MOVEP.W TIMER_2(A4),D4 CLEAR TIMER2-INTERPT;
* ENDI ENDI; THIS LINE IS A TEST LINE(SE TWO DOWN)
BSR.S TIME_OUT TIME_OUT(D2/D3=NOW,D5.W.B:=CCR);
ENDI ENDI; THIS LINE IS THE REAL LINE(SE TWO UP)
MOVE.W D5,SR RESTORE SR WITH UPDATED CCR FROM D5;
MOVEM.L (A7)+,D0-D7/A0-A6 RESTORE REGISTERS;
IF <EQ> THEN.S IF A WAITING DRIVER TIMED OUT THEN
TRAP #8 GOTO INTERRUPT_END;"
ENDI ENDI;
RTE RETURN;
TWAIT EQU * WAIT FOR TIMEOUT
* CALL: RETURN
* D0/D1 #USEC UNDEF
* A1 PROCESS SAME
* SPOILED D2/D3/D4/D5/A4/A5/A6
* THE PROCESS IS QUEUED IN THE TIMER QUEUE, AND WILL BE TIMED OUT AT:(NOW+USEC)
*
BSR.L RT_UPDAT D2/D3:=UPDATE REAL TIME COUNTER; A4/D4:=?
ADD.L D1,D3 D2/D3:=TIME_OUT_POINT:=
ADDX.L D0,D2 #USEC+REAL TIME COUNTER;
MOVEM.L D2/D3,PR_TIMO(A1) PROC.TIME_OUT:=TIME_OUT_POINT;
LEA TIMER,A4 A4:=TIMER QUEUE
MOVE.L (A4),A5 A5:=AFTER:=TIMER.FIRST;
WHILE.L A5 <NE> A4 DO.S WHILE AFTER <> TIMER DO "SCAN TIM_Q"
MOVEM.L PR_TIMO-PR_MAIN(A5),D4/D5 D4/D5:=AFTER.TIME_OUT;
SUB.L D3,D5 D4/D5:=AFTER.TIME_OUT-TIME_OUT_POINT;
SUBX.L D2,D4 .
IF <GE> THEN.S IF AFTER.TIME_OUT >= TIME_OUT_POINT THEN
BRA.S TWAITEXI GOTO POSITION_FOUND;
ENDI ENDI;
MOVE.L (A5),A5 A5=AFTER:=AFTER.NEXT
ENDW ENDW;
TWAITEXI EQU * POSITION_FOUND:
* A1 SHOULD BE CHAINED PRIOR TO A5 (=AFTER).
LEA PR_MAIN(A1),A4 A4:=SCHEDULER CHAIN ELEMENT;
INS_ELEM A5,A4,A6,A5/A6 INSERT A4 PRIOR TO A5; A6:=PROC.PREV;
IF.L A6 <NE> #TIMER THEN.S IF PROC IS NOT INSERTED FIRST_IN_QUEUE THEN
RTS RETURN;
ENDI ENDI;
BRA.L TO_UPDAT GOTO UPDATE TIME_OUT_COUNTER(D0/D1)
PAGE
TIME_OUT EQU * TIME_OUT CALL FROM DRIVER
* CALL: RETURN
* D2/D3 RTCNT=NOW UNDEF
* D5 SAVED SR WITH CCR=0 CCR.Z_BIT SET IF A DRIVER TIMES OUT
* OTHER EXCEPT A7 UNDEF
*
* SCAN THE TIMER QUEUE AND PERFORM THE PROPER TIME OUT ACTION
* FOR PROCESSES THAT HAVE TIMED OUT.
*
LEA TIMER,A0 A0:=TIMER_QUEUE
MOVE.L (A0),A1 A1:=PROC:=TIMER_QUEUE.FIRST
WHILE.L A1 <NE> A0 DO.L WHILE PROC <> END_OF_TIMER_QUEUE DO
MOVEM.L PR_TIMO-PR_MAIN(A1),D0/D1 D0/D1:=TIME_OUT_POINT
SUB.L D3,D1 D0/D1:=REST # USEC:=
SUBX.L D2,D0 TIME_OUT_POINT - NOW;
IF <GT> THEN.S IF REST # USEC > 0 THEN
BRA.L TO_UPDAT RETURN THRU "UPDATE_TIMEOUT_COUNTER"
ENDI ENDI;
* TIME_OUT HAS ACTUALLY OCCURED
PRT_MEM TIME_OUT_PROC,-PR_MAIN(A1),PR_SIZ ********
* REMOVE PROC FROM TIMER_QUEUE; PROC IS ALWAYS THE FIRST IN THE TIMER_QUEUE
MOVE.L (A1),A4 A4:=NEXT PROC IN TIMER_QUEUE;
MOVE.L A0,4(A4) NEXT.PREV:=TIMER_QUEUE;
MOVE.L A4,(A0) TIMER_QUEUE.FIRST:=NEXT;
MOVE.L A1,(A1) PROC.MAIN
MOVE.L A1,4(A1) := EMPTY;
* ENSURE THAT SCHEDULER WILL BE CALLED LATER:
BSR.L EN_STOPR ENSURE_STOP_RUNNING_PROCESS(D7/A4:=?);
PAGE
TST.B PR_STA-PR_MAIN(A1) TEST PROC STATE
IF <NE> THEN.S IF PROC STATE <> RUN THEN
* A1=PROC.MAIN. A COND.WAIT HAS TIMED OUT.
MOVE.W #ECRTIME,PR_SYN-PR_MAIN(A1) PROC.SYNC_RESULT:=REJECTED,TIMEOU
MOVE.L PR_CON-PR_MAIN(A1),A3 A3:=THE CONDITION THAT WAS "WAITED";
MOVE.L CO_GA(A3),A3 A3:=THE MANAGING GATE; "CANNOT BE ZERO"
MOVE.B GA_LEV(A3),D7 D7:=GATE.LEVEL
TAS.B GA_STA(A3) TEST FOR OPEN, AND LOCK THE GATE;
IF <EQ> THEN.S IF GATE WAS OPEN THEN
TST.B D7 TEST LEVEL
IF <EQ> THEN.S IF NORMAL GATE WAS OPEN THEN
LEA RUNNING,A3 A3:=RUNNING QUEUE;
LEA PR_AUX-PR_MAIN(A1),A4 A4:= PROC.AUX;
REM_ELEM (A4),A5,A6,A5/A6 REMOVE PROC.AUX FROM CONDITION;
INS_ELEM A3,A4,A6,A3/A6 INSERT PROC.AUX IN RUNNING;
CLR.B PR_STA-PR_AUX(A4) PROC.STATE:=RUN:=0;
ELSE.S ELSE "DEVICE GATE WAS OPEN"
BRA.S ASLOCKED GOTO ASLOCKED; "SAME PROCEDURE"
ENDI ENDI;
ELSE.S ELSE "GATE WAS LOCKED"
TST.B D7 TEST LEVEL
IF <EQ> THEN.S IF NORMAL GATE WAS LOCKED THEN
LEA GA_SPLOK(A3),A3 A3:=SPEED RELOCKING QUEUE;
INS_ELEM A3,A1,A6,A3/A6 INSERT PROC.MAIN IN RELOCKING;
ELSE.S ELSE "DEVICE GATE WAS LOCKED/OPEN"
ASLOCKED EQU * ASLOCKED:
LSL.B #4,D7 D7:=PRIO:=LEVEL<<4+0;
BSR.L QDRIV QUEUE PROC ACCORDING TO PRIO (A3/A6:=?);
* A DRIVER HAS TIMED OUT, PROC.STATE OF DRIVING PROC IS UNCHANGED (=D_WAIT=4).
BSET.L #2,D5 Z-BIT:= 1; <EQ> BECOMES TRUE;
ENDI ENDI; "DEVICE GATE"
ENDI ENDI; "GATE WAS LOCKED"
ENDI ENDI; "A COND.WAIT TIMED OUT"
MOVE.L (A0),A1 A1:=FIRST PROC IN TIMER QUEUE
ENDW ENDW;
* EXIT HERE SIGNALS THAT TIMER QUEUE IS EMPTY;
* NO NEW TIME_OUT INTERRUPT IS REQUESTED;
RTS RETURN;
PAGE
TO_UPDAT EQU * UPDATE TIME OUT COUNTER
* CALL RETURN:
* D0/D1 #USEC UNDEF
* A4 ANY UNDEF
*
* THE NEXT TIME_OUT INTERRUPT IS REQUESTED WITHIN #USEC (APROX).
* IF #USEC >=2**16, THE NEXT INTERRUPT IS REQUESTED
* WITHIN 2**16 USEC.
TST.L D0
IF <NE> THEN.S IF #USEC > 2**32 THEN
MOVE.W #$FFFF,D1 D1:=TOC:=2**16 -1
ELSE.S ELSE
SWAP.W D1
TST.W D1
IF <EQ> THEN.S IF #USEC < 2**16 THEN
SWAP.W D1 D1:=TOC:=#USEC;
ELSE.S ELSE
MOVE.W #$FFFF,D1 D1:=TOC:=2**16 -1
ENDI ENDI;
ENDI ENDI;
* D1.W = NEXT TIME_OUT PERIOD; SET UP TIMER2.
LEA PTMCHIP,A4
* PRT_REG TO_UPDAT_D1 TEST PRT CANNOT BE ACTIVE WHEN THE REAL TIMER IS ON
MOVEP.W D1,TIMER_2(A4)
RTS
RT_UPDAT EQU * UPDATE REAL TIME COUNTER (RTCNT)
* CALL: RETURN
* D2/D3 ANY UPDATED VALUE OF RTCNT
* D4.B ANY TIMER STATUS;
* A4 ANY TIMER CHIP ADDRESS
*
*
MOVEM.L RTCNT,D2/D3 D2/D3:=OLD RTCNT;
LEA PTMCHIP,A4 A4:=TIMER CHIP ADDRESS
MOVEP.W TIMER_3(A4),D3 RTCNT(0..15):=TIMER3;
MOVE.B STATCON2(A4),D4 D4:=TIMER STATUS;
BTST.L #2,D4 TEST CARRY(=INTERRUPT) OF TIMER3
IF <NE> THEN.S IF CARRY THEN "CARRY=1"
ADD.L #$10000,D3 RTCNT(16..31):=...+CARRY;
IF <CS> THEN.S IF CARRY THEN
ADDQ.L #1,D2 RTCNT(32..63):=...+CARRY;
ENDI ENDI;
MOVEP.W TIMER_3(A4),D3 RTCNT(0..15):=TIMER3; CLEAR INTERRUPT;
ENDI ENDI;
MOVEM.L D2/D3,RTCNT SAVE NEW RTCNT;
RTS RETURN;
GET_TIME EQU * KERNEL OPERATION #34; MAY ALSO BE CALLED FROM RESIDENT CTX.
* CALL: RETURN:
* A0 - CALLING PROCESS
* A2 CUR_CTX SAME
* D0/D1 - CPU TIME USED BY CALLING PROCESS
* D2/D3 - RTCNT
* D4/A4 - UNDEF
* D7 - OK-RESULT
* THE ADDRESSES USED BELOW ARE ALSO VALID WHEN CALLED FROM RESIDENT CTX
*
MOVE.L CT_HOLD(A2),A0 A0:= OBJECT HOLDING CTX;
MOVE.L EX_PR(A0),A0 A0:= PROCESS OF HOLDING OBJECT;
MOVEM.L PR_CPU(A0),D0/D1 D0/D1:= CPU_TIME OF PROCESS;
*IGET_TIME EQU * GET_TIME CALLED FROM INTERRUPT PROCEDURE COULD ENTER HERE
BSR.S RT_UPDAT D2/D3:= RTCNT;
MOVEQ.L #0,D7 RESULT:=OK;
BRA RET_FAST RETURN TO CALLER;
PAGE
*MEGADIV EQU * CONVERT D2/D3 FROM USECS TO SECS/USECS. D4-D7 SPOILED.
* A DIVISION BY 1000000 IS PERFORMED THROUGH TO DIVISIONS BY 1000.
*
* MOVE.W #1000,D7 D7:= 1000; D2/D3 = MICROSECS
* BSR.S KILODIV D4/D5:=MILLISECS:= MICROSECS DIV 1000;
* MOVE.W D2,D6 D6:=D0:=MICRO:= MICROSECS MOD 1000;
* MOVE.L D5,D3 D2/D3:=MILLISECS;
* MOVE.L D4,D2 (D4)/D5:= SECONDS:=MILLISECS DIV 1000;
* BSR.S KILODIV D0:= MILLI:=MILLISECS MOD 1000;
* MOVE.W D6,D3 D1:= USECS:=MILLI
* MULU D7,D3 * 1000
* ADD.L D2,D3 + MICRO;
* MOVE.L D5,D2 D2:= SECONDS;
* RTS
*KILODIV EQU * D4/D5:= D2/D3 DIV 1000; D2:= D2/D3 MOD 1000 D3:= UNDEF;
* DIFFICULT TO IMPLEMENT WITH 16 BITS ARITHMETIC.
PAGE
CONVADDR EQU * CONVERT ADDRESS FROM USER SPACE TO SUPERVISOR SPACE
* CALL: RETURN:
* D3 USER ADDR SUPV ADDR
* D5 - MMU_OFSET
* CCR ANY <NE>:OK, <EQ>:NOT_OK
* USED BY TRAP #8
MOVEM.L D3/D4/A0/A1,-(A7)
BTST.L #0,D3
IF <NE> THEN.S IF ODD ADDRESS THEN
MOVEQ.L #0,D5 CCR:=<EQ> = NOT OK;
BRA.S RET_CONV GOTO RETURN;
ENDI ENDI;
MOVE.L KV_CTX,A0 A0:= CURRENT CONTEXT
MOVEQ.L #0,D4 D4:= TABLE_INDEX:=0;
ROR.L #8,D3 D3.LOW:= ADDRESS.BITS(23..8)
REPEAT
MOVE.W MMU_TAB(PC,D4.W),D5 D5:= OFFSET TO NEXT MMU_DESC IN CTX
BEQ.S RET_CONV IF NO NEXT THEN RETURN WITH CCR=<EQ>
LEA MM_REG(A0,D5.W),A1 A1:= ADDRESS OF NEXT MMU LIMIT IN CTX
CMP.W (A1)+,D3 IF ADDR >= MMU.FIRST "UNSIGNED"
IF <CC> THEN.S AND
CMP.W (A1)+,D3 ADDR <= MMU.LAST "UNSIGNED"
IF <LS> THEN.S AND
BTST.B #0,3(A1) MMU ENABLED
IF <NE> THEN.S THEN
ADD.W (A1),D3 D3:= SUPV ADDR := USER ADDRESS + DIFF
ROL.L #8,D3 LOW ORDER BITS ARE UNCHANGED
MOVE.L D3,(A7) SAVED_D3:= SUPV ADDR; CCR:= <NE>;
RET_CONV EQU *
PRT_REG CONVADDR ********
MOVEM.L (A7)+,D3/D4/A0/A1
RTS
ENDI ENDI; MMU NOT ENABLED
ENDI ENDI; ADDR <= LAST
ENDI ENDI; ADDR >= FIRST
ADDQ.W #2,D4 D0:= NEXT INDEX
UNTIL <EQ> UNTIL FOREVER;
MMU_TAB DC.W CT_MM1,CT_MM0,CT_MM2,CT_MM3,0 OFFSETS TO MMU_DESC IN CTX
PAGE
* THE SCHEDULER IMPLEMENTS PROCESS SWITCHING.
* THE PROCESSES OF THE SYSTEM ARE:
*
* ØØPROCESS !
* ØØ PRIO ! ! !
* KIND ØØ ! ZERO PRIORITY ! DRIVER PRIORITY (>0) !
* OF PROCESS ØØ! ! !
* -------------!-------------------!----------------------!
* ! ! !
* REAL PROCS ! RUNNING PROCESSES ! DRIVING PROCESSES !
* ! ! !
* -------------!-------------------!----------------------!
* ! ! !
* FANTOM PROCS ! DUMMY PROCESS ! INTERRUPT PROCEDURES !
* ! ! !
* -------------!-------------------!----------------------!
*
*
* ALTHOUGH ALL RUNNING PROCESSES HAVE THE SAME LOW PRIORITY, THEY MAY HAVE
* DIFFERENT REQUIREMENTS TO RESPONSE TIME AND CPU-LOAD. AT PRESENT NOTHING
* IS DONE TO MEET SUCH INDIVIDUAL REQUIREMENTS, BUT NO PROCESS ARE ALLOWED
* TO USE THE CPU CONTINUEOUSLY FOR MORE THAN A FIXED PERIOD OF TIME.
*
* A DRIVING PROCESS HAS AN ABSOLUT PRIORITY IN THE RANGE 1 TO 6.
* AN INTERRUPT PROCEDURE HAS AN ABSOLUT PRIORITY IN THE RANGE 1 TO 7.
* HAVING AN ABSOLUT PRIORITY P MEANS THAT NO PROCESS WITH A PRIORITY N<P
* IS SCHEDULED AS LONG AS THE P-PROCESS IS READY TO RUN.
*
* A HIGH PRIORITY CORRESPONDES TO A SHORT RESPONSE TIME REQUIREMENT AND
* A LOW CPU-LOAD.
* NO SWITCHING TAKES PLACE BETWEEN PROCESSES AT THE SAME DRIVER LEVEL
* (SWITCHING TO A HIGER LEVEL MAY OCCUR), BECAUSE THE "QUEUE" OF INTERRUPT
* PROCEDURES ARE INVISIBLE TO THE SCHEDULER, AND BECAUSE NO IMPROVEMENTS IN
* PERFORMANCE (RESPONSE TIME) SEEMS TO FOLLOW:
* THE RESPONSE TIME EXPECTED AT A GIVEN LEVEL MAY BE CORRUPTED IF PROCESSES
* AT THE SAME OR HIGHER LEVELS ENFORCES A TOO BIG CPU-LOAD; BUT IMPLEMENTING
* A SWITCHING POLICY BETWEEN PROCESSES AT THE SAME LEVEL CANNOT REMOVE A BIG
* CPU-LOAD FROM PROCESSES AT HIGHER LEVELS.
* CONSEQUENTLY: DRIVER PRIORIOTY MUST BE USED CAREFULL.
*
* THE SCHEDULER IS A RECURSIVE ALGORITHM. A NEW LEVEL OF RECURSION IS
* INTRODUCED WHEN AN INTERRUPT PROCEDURE TERMINATES THROUGH 'INTERRUPT_END'
* (TRAP #8) TO ACTIVATE SIGNALED DRIVING PROCESSES. THE LEVEL OF RECURSION
* (CALLED PREVPRIO) IS IDENTIFIED BY THE PRIORITY LEVEL OF THE PROCESS
* (REAL OR FANTOM) THAT WAS INTERRUPTED.
* THE ALGORITHM SCHEDULES ALL PROCESSES HAVING A PRIORITY ABOVE PREVPRIO
* BEFORE IT RETURNS TO THE INTERRUPTED PROCESS WHICH WAS SCHEDULED BY A
* "LOWER_LEVEL INCARNATION" OF THE SCHEDULER ALGORITHM. IN THE "LOWEST"
* INCARNATION PREVPRIO EQUALS -1. THIS INCARNATION WILL NEVER RETURN, BUT
* SCHEDULE THE DUMMY PROCESS WHEN NO OTHER PROCESSES ARE FOUND.
*
* REAL PROCESSES ARE SELECTED EXPLICITLY FROM THE DRIVING QUEUE OR FROM
* THE RUNNING QUEUE. INTERRUPT PROCEDURES ARE SELECTED IMPLICITLY WHEN THE
* INTERRUPT MASK OF THE PROCESSOR IS DECREASED. THE DUMMY PROCESS IS SELECTED
* WHEN NO OTHER PROCESSES APPEAR.
*
PAGE
EN_STOPR EQU * ENSURE THAT RUNNING CURRENT PROCESS WILL BE STOPPPED.
* CALL: RETURN:
* D7/A4 ANY UNDEF
* SR 27XX 27XX
* CALLED FROM TIME_OUT, WHEN A PROCESS IN THE TIMER QUEUE ACTUALLY TIMES
* OUT.
*
MOVE.L SUPV_STK,A4 A4:= BOTTOM OF STACK;
SUBQ.L #8,A4 A4:= BOTTOM SR; "-1,PC,SR"
PRT_MEM EN_STOPR,(A4),8+4+4 ********
MOVEQ.L #$27,D7
AND.B (A4),D7 TEST SUPERVISOR BYTE OF BOTTOM SR
IF <EQ> THEN.S IF LEVEL=0 AND MODE=USER THEN
* A RUNNING PROCESS SHOULD BE STOPPED
MOVE.W (A4)+,SAVE_SR SAVE SR OF RUNNING CURRENT PROCESS
MOVE.L (A4),SAVE_PC SAVE PC OF RUNNING CURRENT PROCESS
MOVE.L #DO_STOPR,(A4) PC:= STOP RUNNING PROCESS
MOVE.W #$2000,-(A4) SR:= SUPERVISOR MODE/RUNNING PROCESS;
ENDI ENDI;
RTS RETURN, BUT CONTINUE LATER IN 'DO_STOPR' BELOW.
* THE PROCESS MAY STOP ITSELF(CALL SUSPEND),IF IT EXECUTES
* IN THE KERNEL. IN THIS CASE 'DO_STOPR' IS NOT ENTERED.
DO_STOPR EQU * STOP RUNNING CURRENT PROCESS FOR A WHILE
*
* ALL REGISTERS WILL BE UNCHANGED WHEN THE PROCESS IS RESUMED.
*
* THE STACK CONTAINS PREVPRIO OF THE BOTTOM SCHEDULER (=-1)
* AND THE SPECIAL VALUES FOR SR AND PC ASSIGNED BY EN_STOPR,
* BUT A7 POINTS TO PREVPRIO (RTE HAS BEEN EXECUTED).
*
MOVE.W #$2700,SR PREVENT INTERRUPTS IN THE SCHEDULER
SUBQ.L #6,A7 ALLOCATE SR,PC WHICH ARE STILL ON STACK
MOVEM.L A4-A6,-(A7) SAVE A4-A6 ON STACK
MOVE.L KV_PROC,A4 A4:= CURRENT PROCESS
REM_ELEM PR_MAIN(A4),A5,A6,A5/A6 REMOVE PROC FROM TIMER QUEUE
INIT_HEAD PR_MAIN(A4),A5 NOTE: PROC MAY HAVE BEEN REMOVE ALREADY
MOVEM.L D0-D7/A0-A3,PR_D0.A3(A4) SAVE REGS IN PROC DESCRIPTION
LEA PR_AUX(A4),A4 A4:= PROC.AUX_QUEUE;
REM_ELEM (A4),A0,A1,A0/A1 REMOVE PROC FROM RUNNING; A1:=RUNNING QUE
INS_ELEM A1,A4,A5,A1/A5 INSERT PROC AS LAST PROC IN RUNNING QUEUE
MOVE.L KV_CTX,A2 A2:= CURRENT CONTEXT
BSR.L SUSPEND SUSPEND EGO (A0/A1/A2/A3:=!,OTHER:=?)
START_PROC EQU * INITIAL RESUME POINT FOR INITIAL CTX IN CREATED PROCESSES.
* STACK AND USP IS UNCHANGED. CHECK FOR ABORT AND RESTORE MMU:
BSR.L PREP_RET PREPARE RETURN(A3=CTX,A4:=?,CCR:=SP_EXC);
MOVEM.L PR_D0.A3(A1),D0-D7/A0-A3 RESTORE REGS FROM PROC DESCR.CCR UNCHANG.
MOVEM.L (A7)+,A4-A6 RESTORE A4-A6 FROM STACK. CCR UNCHANGED.
BLT.L TR_SPEED IF SP_EXC THEN GOTO SPEEDUP EXCEPTION;
RTE RETURN TO USER MODE
PAGE
TR_TR8 EQU * INTERRUPT_END IS CALLED (TRAP #8)
* INTERUPT END IS CALLED FROM AN INTERRUPT PROCEDURE IN ORDER TO ACTIVATE
* SIGNALED PROCESSES. A NEW INSTANCE OF THE SCHEDULER IS CREATED. THE STATE
* OF THE INTERRUPTED LEVEL IS SAVED ON THE STACK.
*
PRT_REG TR_TR8 ********
MOVE.W #$2700,SR PREVENT INTERRUPTS
MOVE.W D3,-(A7) SAVE D3.W ON STACK
MOVE.B #$27,D3 D3:= MODE AND LEVEL OF CALLER
AND.B 2(A7),D3 TEST MODE AND LEVEL OF CALLER
IF.B D3 <LE> #$20 THEN.S IF CALLED FROM REAL PROCESS THEN
AND.B #$7,D3 D3:= LEVEL OF CALLER;
IF <EQ> THEN.S IF CALLED FROM NORMAL CONTEXT THEN
MOVE.W (A7)+,D3 RESTORE D3.W AND A7
SUBQ.L #8,A7 PUSH DUMMY INF
MOVE.L #32+8,-(A7) CAUSE:=TRAP #8;
BRA.L INT_EXC GOTO INTERNAL EXCEPTION;
ENDI ENDI;
* CALLER IS A RESIDENT CONTEXT, OPRATION IS: JSR (A0) INTO SUPV MODE
MOVE.W 2(A7),D3 D3.W:= NEW_SR:= OLD_SR
BSET.L #5+8,D3 + SUPERVISOR BIT;
SWAP.W D3 SAVE HIGHBITS OF D3 AND
MOVE.L D3,-(A7) NEW_SR ON STACK;
MOVE.L A0,D3 D3:=PROC_ADDR;
MOVE.L D5,-(A7) SAVE D5;
BSR.L CONVADDR CONVADDR(D3=USER_ADDR,D3:=ADDR,D5:=MMU);
IF <NE> THEN.S IF OK THEN D3=SUPV_ADDRESS
MOVE.L (A7)+,D5 RESTORE D5;
MOVE.L 2(A7),-(A7) PUSH SAVED D3;
MOVE.L D3,6(A7) SAVE PROC_ADDR ON STACK
MOVE.L (A7)+,D3 RESTORE D3;
RTE CALL PROCEDURE IN SUPERVISOR MODE;
* NOTE RTE IS EXECUTED BY THE CALLED PROCEDURE TO RETURN TO MAIN PROGRAM.
ENDI ENDI;
* ILLEGAL A0: D3=USER ADDR,RETURN TO ILLEGAL ADDR => EXCEPTION IN CALLING CTX
MOVE.L (A7)+,D5 RESTORE D5;
MOVE.L D3,8(A7) SAVE ILLEGAL ADDRESS IN RETURN POINT
MOVE.L 2(A7),D3 RESTORE D3;
ADDQ.L #6,A7 RESTORE A7
RTE RETURN AND PROVOKE EXCEPTION
ENDI ENDI; TRAP #8 FROM REAL PROCESS;
* THE CALL IS MADE BY AN INTERRUPT PROCEDURE (LEVEL AND MODE <> 0).
MOVE.W (A7)+,D3 RESTORE D3;
ADDQ.L #6,A7 POP RETURN POINT FROM TRAP #8
MOVEM.L D0-D7/A0-A6,-(A7) SAVE REGS ON STACK
MOVE.W 60(A7),D0 D0:= SR OF INTERRUPTED LEVEL
ANDI.W #$0700,D0 D0.B:= PREVPRIO:= SR.INT_MASK
ORI.W #$00F0,D0 << 4 + F;
LSR.W #4,D0
MOVE.L USP,A0 A0:= USP OF INTERUPTED LEVEL
MOVE.L A0,-(A7) SAVE USP ON STACK
MOVE.L KV_CTX,-(A7) SAVE KV_CTX ON STACK
MOVE.L KV_PROC,-(A7) SAVE KV_PROC ON STACK
MOVE.L KV_SPSAVE,-(A7) SAVE KV_SPSAVE ON STACK
EOSBEGIN EQU * CALLED FROM 'ENTER' AFTER THE INITIALIZATION;
MOVE.B D0,-(A7) PUSH PREVPRIO ON STACK
LEA -18(A7),A7 KV_SPSAVE:=A7:= VALUE OF KV_SPSAVE
MOVE.L A7,KV_SPSAVE IN THE NEW SCHEDULER;
CLR.B 12(A7) STACK(SR).SUPV_BYTE:=NO_TIMOUT_PENDING:=0
PRT_MEM EOSBEGIN,(A7),60 ********
PAGE
BSR.L FIND_NXT FIND_NXT(D0.B=PREVPRIO,D0-D5/A4-A6=?,
* A1:=PROC,CC:=RESULT);
WHILE <LE> DO.S WHILE MORE PROCESSES DO
* STACK CONTAINS 18 BYTES. STACK(SR).SUPV_BYTE=0.
IF <EQ> THEN.S IF REAL PROCESS THEN
BSR.L RSTO_ALL RESTORE_ALL(A0-A3:=!,D0/A5/A6:=?,USP:=!);
* USP AND STACK RESTORED, A0=EXT, A1=PROC=KV_PROC, A2=A3=KV_CTX, SR=27XX
PRT_REG RESUME_A0-A1 ********
PRT_MEM SC_STATE,TIMER,RTCNT+8-TIMER ********
RTS RESUME SELECTED PROCESS
SUSPEND EQU * SUSPEND SELECTED PROCESS; A2=CTX,SR=27XX;
PRT_REG SUSPEND_A2 ********
PRT_MEM SC_STATE,TIMER,RTCNT+8-TIMER ********
BSR.L SAVE_STK SAVE_STACK(A2=CTX,D0/A5/A6:=?,!:=USP);
ELSE.S ELSE "DUMMY PROCESS AT LEVEL ZERO"
CLR.L KV_CTX NO CTX DESCRIBED IN MMU
LEA 18(A7),A7 RESTORE DUMMY STACK "CONTAINS ZERO BYTES"
STOP #$2000 WAIT FOR INTERRUPT
MOVE.W #$2700,SR PREVENT INTERRUPT
LEA -18(A7),A7 SAVE DUMMY STACK "CONTAINS ZERO BYTES"
ENDI ENDI;
NEXT_PROC EQU * CALLED BY KNELOP WHEN A PROC HAS RETURNED FROM ITS INITIAL CTX
MOVE.B 18(A7),D0 D0:=PREVPRIO;
CLR.B 12(A7) STACK(SR).SUPV_BYTE:=NO_TIMOUT_PENDING: 0
BSR.S FIND_NXT FIND_NXT(D0=PREVPRIO,D0-D5/A4-A6:=?,
* A1:=PROC,CC:=RESULT);
ENDW END WHILE MORE PROCESSES;
* NO MORE PROCS, RESTORE AND RETURN TO PREVIOUS LEVEL.
LEA 20(A7),A7 POP PREVPRIO AND 18 BYTES DUMMY STACK
MOVE.L (A7)+,KV_SPSAVE KV_SPSAVE:= PREVIOUS VALUE
MOVE.L (A7)+,KV_PROC KV_PROC:= PREVIOUS VALUE
MOVE.L (A7)+,A3 A3:= PREVIOUS CONTEXT
MOVE.L (A7)+,A0 A0:= PREVIOUS USP
MOVE.L A3,KV_CTX KV_CTX:= PREVIOUS CONTEXT
IF <NE> THEN.S IF PREVIOUS CONTEXT <> DUMMY_PROC THEN
BSR.L LOAD_MMU LOAD_MMU(A3=CTX,A4:=?);
MOVE.L A0,USP USP:= PREVIOUS USP
ENDI ENDI;
MOVEM.L (A7)+,D0-D7/A0-A6 RESTORE REGS FROM STACK
PRT_REG RTE_TR8 ********
RTE RETURN TO INTERRUPTED LEVEL
PAGE
FIND_NXT EQU * FIND THE NEXT PROCESS TO BE RESUMED
* CALL: RETURN:
* D0.B PREVPRIO UNDEF
* A1 ANY PROCESS TO BE RESUMED
* D0-D5 ANY UNDEF
* A4-A6 ANY UNDEF
* CC ANY <LT> RESUME DUMMY PROCESS
* <EQ> RESUME REAL PROCESS (IN A1)
* <GT> NO PROCESS TO RESUME
*
MOVE.L DRIVING,A6 A6:= MAIN QUEUE OF FIRST DRIVING
IF.L A6 <NE> (A6) THEN.S IF ANY DRIVING PROCESSES AND
IF.B D0 <LT> PR_PRI-PR_MAIN(A6) THEN.S PREVPRIO < PRIO OF FIRST DRIVING THEN
LEA -PR_MAIN(A6),A1 A1:= FIRST DRIVING PROCESS;
* THE DRIVING PROCESS MAY STILL BE WAITING FOR A CONDITION.
TST.B PR_STA(A1)
IF <NE> THEN.S IF PROC.STATE <> RUN THEN
REM_ELEM PR_AUX(A1),A4,A6,A4/A6 REMOVE PROC.AUX FROM CONDITION QUEUE
INIT_HEAD PR_AUX(A1),A4
CLR.B PR_STA(A1) PROC.STATE:= RUN; CC:=<EQ>;
ENDI ENDI;
RTS RETURN, RESULT = RESUME REAL PROC = <EQ>;
ENDI
ENDI ENDI REAL DRIVING COULD BE RESUMED;
TST.B D0
IF <LT>THEN.S IF PREVPRIO=LOWEST PRIO THEN
* RUNNING PROCESSES MAY BE SCHEDULED
MOVE.L RUNNING,A6 A6:= AUX QUEUE OF FIRST RUNNING
IF.L A6 <NE> (A6) THEN.S IF ANY RUNNING PROCS THEN
LEA -PR_AUX(A6),A1 A1:= FIRST RUNNING PROCESS;
MOVEQ #0,D0
MOVE.L #TIMESLIC,D1 D0/D1:= TIME_SLICE IN #USEC;
BSR.L TWAIT INSERT IN TIMER QUEUE(D0/D1,A1=PROC,
* D0-D5:=?,A4-A6:=?);
CMP D0,D0 RESULT:= RESUME REAL PROCESS:= <EQ>;
RTS
ENDI ENDI REAL RUNNING PROCESS WAS PRESENT
MOVEQ.L #-1,D0 RESULT:= RESUME DUMMY PROCESS:= <LT>;
RTS RETURN
ENDI ENDI PREVPRIO=LOWEST PRIO ;
MOVEQ.L #+1,D0 RESULT:= NO PROC TO RESUME:= <GT>;
RTS RTS
PAGE
EN_DIS EQU * ENABLE AND DISABLE INTERRUPTS
* CALL: RETURN:
* SR 27XX SAME
* THIS PROCEDURE IS CALLED WHEN A NORMAL RUNNING PROCESS EXECUTING A
* KERNEL OPERATION WILL ALLOW INTERRUPT TO BE GRANTED.
* THE INTERRUPT MASK IS LOWERED TO ZERO AND RAISED AGAIN TO SEVEN.
* EN_DIS MUST NEVER BE CALLED FROM KERNEL OPERATIONS EXECUTED BY
* INTERRUPT PROCEDURES OR DRIVING PROCESSES.
*
MOVE.W SR,-(A7) SAVE SR; (INCL. CONDITION CODES)
MOVE.W #$2000,SR ALLOW INTERRUPTS TO BE GRANTED
RTE PREVENT INTERRUPTS AND RETURN;
RSTO_ALL EQU * RESTORE KV_CTX, KV_PROC, A0/A2/A3, USP, SUPV.STACK OF PROC.
* CALL: RETURN:
* A0 ANY EXTENSION OBJECT
* A1 PROCESS TO BE RESUMED SAME
* A2 ANY CURRENT CONTEXT
* A3 ANY CURRENT CONTEXT
* USP ANY LOADED FROM CURRENT CONTEXT
* STACK: 18 BYTES TO BE POPPED, BEFORE THE STACK IS RESTORED
* RSTO_ALL IS CALLED BY THE SCHEDULER WHEN A NEW REAL PROCESS IS RESUMED.
MOVE.L A1,KV_PROC KV_PROC:= PROCESS TO BE RESUMED;
MOVE.L EX_EXT+4(A1),A0 A0:= Q_ELEM OF LAST EXTENSION OBJECT
LEA EX_CTX-EX_EXT(A0),A2 A2:= CONTEXT STACK HEAD OF EXTENSION OBJ;
MOVE.L 4(A2),A3 A3:= LAST CONTEXT OF LAST EXTENSION;
IF.L A2 <EQ> A3 THEN.S IF NO CONTEXTS IN LAST EXTENSION THEN
MOVE.L 4(A0),A2 A2:= EXTENSION PRIOR TO LAST EXTENSION
MOVE.L EX_CTX+4-EX_EXT(A2),A3 A3:= LAST CONTEXT OF PRIOR EXTENSION
ENDI ENDI;
LEA -EX_EXT(A0),A0 A0:= FIRST OF EXTENSION OBJECT;
LEA -ST_STK(A3),A3 A3:= A2:=
MOVE.L A3,A2 KV_CTX:=
MOVE.L A2,KV_CTX FIRST OF LAST CONTEXT
* CONTINUE IN RSTO_STACK BELOW
PAGE
RSTO_STK EQU * RESTORE SUPERVISOR STACK
* CALL: RETURN:
* A3 CTX SAME
* D0/A5/A6 ANY UNDEF
* USP ANY LOADED FROM CTX
* STACK: 18 BYTES TO BE POPPED LOADED FROM CTX
*
MOVE.L (A7)+,A6 A6:= RETURNPOINT
MOVE.L CT_USP(A3),A5 A5:= SAVED USP
MOVE.L A5,USP USP:= SAVED USP
LEA CT_WRK(A3),A5 A5:= TOP OF CTX.SAVED_STACK
MOVE.W CT_COUNT(A3),D0 D0:= - #ADDITIONAL WORDS SAVED
BTST.B #5,12(A7) TEST SR OF STACK TO BE POPPED
IF <NE> THEN.S IF SUPERVISOR BIT IS ON THEN
MOVE.L -(A5),SAVE_PC SAVE_PC:= CTX.SAVED_PC
MOVE.W -(A5),SAVE_SR SAVE_SR:= CTX.SAVED_SR
LEA 12(A7),A7 PC,SR STILL IN STACK AS SET BY EN_STOPR
ELSE.S ELSE
LEA 18(A7),A7 POP OLD STACK CONTENT;
MOVE.L -(A5),-(A7) RESTORE PC
MOVE.W -(A5),-(A7) RESTORE SR
ENDI ENDI;
BCLR.L #0,D0 IF D0 IS ODD THEN D0:= D0-1;
IF <NE> THEN.S IF D0 WAS ODD THEN
ADDQ.W #2,D0 D0:= D0+2;
MOVE.W -(A5),-(A7) MOVE ONE WORD FROM CTX TO STACK
ENDI ENDI;
JMP RSTO_0_W(PC,D0.W) MOVE REMAINING WORDS, D0= -#EXTRA_WORDS.
* WHEN 14/15 ADDITIONAL WORDS ARE SAVED, THEN THE NEXT INSTRUCTION IS ENTERED
MOVE.L -(A5),-(A7) 15/14 ADDITIONAL WORDS
MOVE.L -(A5),-(A7) 13/12
MOVE.L -(A5),-(A7) 11/10
MOVE.L -(A5),-(A7) 9/8
MOVE.L -(A5),-(A7) 7/6
MOVE.L -(A5),-(A7) 5/4
MOVE.L -(A5),-(A7) 3/2
RSTO_0_W EQU *
MOVE.L -(A5),-(A7) 1/0 A4/A5/A6 ARE ALWAYS RESTORE
MOVE.L -(A5),-(A7)
MOVE.L -(A5),-(A7) A7 POINTS TO TOP OF RESTORED STACK
PRT_MEM RSTO_STK,(A7),CT_SIZW*4 ********
JMP (A6) GOTO RETURN POINT
PAGE
SAVE_STK EQU * SAVE SUPERVISOR STACK AND USP IN CONTEXT
* CALL: RETURN:
* A2 CTX SAME
* D4/D5 ENTRY ADDR/FUNCTION SAME
* USP WILL BE SAVED IN CTX SAME
* D0/A5/A6 ANY UNDEF
* SAVES THE SUPERVISOR STACK AND USP IN THE CONTEXT AND INITIALIZES A STANDARD
* SUPERVISOR STACK IN RETURN. KV_SPSAVE POINTS TO THE STANDARD STACK (CONTAINS
* 18 BYTES). A7 POINTS TO THE TOP OF THE STACK TO BE SAVED.
* CALL STACK: WORDS,A4,A5,A6,SR,PC RETURN STACK: FUNCTION,??,??,SR,ENTRY ADDR
*
PRT_MEM SAVE_STK,(A7),CT_SIZW*4 ********
MOVE.L (A7)+,A6 A6:= RETURN POINT
MOVE.L USP,A5 A5:= USP
MOVE.L A5,CT_USP(A2) SAVE USP IN CTX
MOVE.L A7,D0 D0:= -#ADDITIONAL BYTES TO SAVE
SUB.L KV_SPSAVE,D0 := ADDR ACT. STACK - ADDR STD. STACK
IF.W D0 <LT> #-(CT_SIZW*4-18) THEN.S IF STACK IS TOO BIG TO BE SAVED THEN
ERROR 99 ERROR(99);
ENDI ENDI;
LEA CT_WRK-18(A2),A5 A5:= FIRST BYTE OF CTX
ADD.W D0,A5 TO BE USED FOR SAVE.
ASR.W #1,D0 D0:= - #ADDITIONAL WORDS TO SAVE
MOVE.W D0,CT_COUNT(A2) SAVE -#ADDITIONAL WORDS IN CONTEXT
BCLR.L #0,D0 IF D0 IS ODD THEN D0:= D0-1;
IF <NE> THEN.S IF ODD #WORDS THEN
ADDQ.W #2,D0 D0:= D0+2;
MOVE.W (A7)+,(A5)+ SAVE ONE WORD;
ENDI ENDI;
JMP SAVE_0_W(PC,D0.W) SAVE REMAINING WORDS, D0= -#EXTRA_WORDS.
* WHEN 15/14 WORDS ARE SAVED, ENTRY IS MADE TO THE FOLLOWING INSTRUCTION
MOVE.L (A7)+,(A5)+ 15/14 ADDITIONAL WORDS
MOVE.L (A7)+,(A5)+ 13/12
MOVE.L (A7)+,(A5)+ 11/10
MOVE.L (A7)+,(A5)+ 9/8
MOVE.L (A7)+,(A5)+ 7/6
MOVE.L (A7)+,(A5)+ 5/4
MOVE.L (A7)+,(A5)+ 3/2
SAVE_0_W EQU *
MOVE.L (A7)+,(A5)+ 0/1 A4/A5/A6 ARE ALWAYS SAVED
MOVE.L (A7)+,(A5)+
MOVE.L (A7)+,(A5)+
BTST.B #5,(A7) TEST SUPERVISOR BIT OF SR
IF <NE> THEN.S IF ON THEN "EN_STOPR HAS BEEN CALLED"
MOVE.W SAVE_SR,(A5) SAVE_SR ARE SAVED IN CTX
MOVE.L SAVE_PC,2(A5) SAVE_PC ARE SAVED IN CTX
MOVE.L D4,SAVE_PC SAVE_PC:= ENTRY ADDR;
* SAVE_SR IS UNCHANGED;
ELSE.S ELSE
MOVE.W (A7),(A5) SAVE SR IN CTX
MOVE.L 2(A7),2(A5) SAVE PC IN CTX
MOVE.L D4,2(A7) PC := ENTRY ADDR
* SR IS UNCHANGED;
ENDI ENDI;
SUBQ.L #8,A7 A5/A6 OF NEW STACK IS UNDEFINED;
MOVE.L D5,-(A7) PUSH FUNCTION ON STACK
JMP (A6) GOTO RETURN POINT
PAGE
TIMCHECK EQU * ALLOW OTHER PROCESSES TO RUN IF TIMEOUT HAS OCCURED
*
* CALLER MUST BE A NORMAL PROCESS.
* ALL REGISTERS ARE SPOILED. AT RETURN A2=CURRENT CONTEXT
*
LEA RUNNING,A1 A1:= RUNNING QUEUE;
MOVE.L KV_CTX,A2 A2:= CURRENT CONTEXT;
MOVE.L SUPV_STK,A6 A6:= BOTTOM OF STACK;
BTST.B #5,-8(A6) TEST SR OF CALLING PROCESS;
BNE.S KNELWAIT WHEN SUPV_BYTE <> 0 PAUSE CURRENT PROC;
RTS RETURN;
SYNCSTOP EQU * SYNCRONIZING PROCESS IS STOPPED
* COMMON WAY TO WAIT IN GATE OR COND OBJECT
* CALL: RETURN:
* A0 ANY EXTENSION OBJECT
* A1 ANY PROCESS OBJECT
* A2 CURRENT CONTEXT CURRENT CONTEXT
* A3 ANY CURRENT CONTEXT
* D7 ANY PROC.SYNC_RESULT
* SR/CCR 27/XX 27/EQ
*
BSR.L SUSPEND STOP AND WAIT(A2=CTX,A0/A1/A2/A3:=!);
CLR.L D7 D7:=
MOVE.W PR_SYN(A1),D7 PROC.SYNC_RESULT
CLR.B PR_STA(A1) (PROC.STATE:=RUN:=0;)CCR:=<EQ>;
RTS RETURN;
PAGE
KNELSIGN EQU * KERNEL DEFINED SIGNAL OPERATION
* CALL RETURN
* A1 QUEUE TO SIGNAL SAME
* A4,A5,A6 ANY UNDEF
* CCR <NE>: NO PROC SCHEDULED
* CCR <EQ>: ONE PROC SCHEDULED
* A1 MAY BE ONE OF THE QUEUES MENTIONED IN KNELWAIT
*
PRT_MEM KNELSIGN,(A1),8 ********
MOVE.L (A1),A4 A4:=FIRST PROC IN QUEUE
IF.L A1 <NE> A4 THEN.S IF QUEUE IS NOT EMPTY THEN
REM_ELEM (A4),A5,A6,A5/A6 REMOVE PROC FROM QUEUE
LEA RUNNING,A5 A5:=RUNNING QUEUE;
INS_ELEM A5,A4,A6,A5/A6 INSERT PROC AS LAST MEMBER OF RUNNING QUEU
CMP.W D0,D0 CCR:=<EQ>;
ELSE.S ELSE
MOVE.W #0,CCR CCR:=<NE>;
ENDI ENDI;
RTS RETURN;
KNELWAIT EQU * KERNEL DEFINED WAIT OPERATION
* CALL RETURN
* A0 ANY EXTENSION OBJECT
* A1 QUEUE TO WAIT IN CURRENT PROCESS OBJECT
* A2 CURRENT CONTEXT CURRENT CONTEXT
* A3 ANY CURRENT CONTEXT
* OTHER ANY UNDEF
*
* THE PROCEDURE IS CALLED WHEN KERNEL DEFINED SYNCHRONIZATION APPEAR:
* 1) CURRENT PROCESS DELETES ANOTHER PROCESS (A1=PR_TERM OF PROC TO BE DELETED)
* 2) CURRENT PROCESS DELETES A SEGMENT (A1=SE_WAIT OF SEGM TO BE DELETED)
* 3) CURRENT PROCESS CALLS THE ALLOCATER (CREATE/DELETE OPEN OBJ,A1=MM_QUEUE)
* A1=RUNNING QUEUE IMPLEMENTS: ALLOW SCHEDULER TO RESCHEDULE - USED BY TIMCHECK
*
MOVE.L KV_PROC,A0 A0:=CURRENT PROCESS;
REM_ELEM PR_MAIN(A0),A3,A4,A3/A4 REMOVE CUR_PROC FROM TIMER QUEUE;
INIT_HEAD PR_MAIN(A0),A3 INIT MAIN QUEUE ELEMENT
LEA PR_AUX(A0),A3 A3:=AUX CHAIN OF CUR PROC
REM_ELEM (A3),A4,A5,A4/A5 REMOVE PROC FROM RUNNING QUEUE
INS_ELEM A1,A3,A4,A1/A4 INSERT PROC.AUX IN WAIT QUEUE
PRT_MEM KNELWAIT,(A1),8 ********
BRA.L SUSPEND SUSPEND(A2=CTX,A0-A4:=!);
* RETURN IS MADE DIRECTLY TO THE CALLER WHEN THE PROC IS RESUMED
PAGE
SCHEDOBJ EQU * SCHEDULER OBJECT FUNCTIONS EXECUTED IN KERNEL MODE
* CALL RETURN
* D0-D4 ANY UNDEF
* D5 FUNCTION UNDEF
* D6 ARG # RESULT
* D7 ANY RESULT
* A0 EXTENSION SAME
* A1/A3/A6 ANY UNDEF
* A2 CUR_CTX SAME
* A4 ARGUMENT ADDR (PHYS) UNDEF
* A5 DECL_DIV OBJECT UNDEF
* CCR <EQ>
* THE FUNCTIONS ARE INVOKED BY THE GENERAL SCHEDULER OBJECTS WHEN THEY
* CALL THE FUNCTIONS OF THE "DECL_DIV OBJECT". NO OTHER OBJECTS
* HOLD A REFERENCE TO THE DECL_DIV OBJECT. CONSEQUENTLY, THE CALLS TO
* DECL_DIV CANNOT HAVE AN ILLEGAL SYNTAX. ARGUMENTS TO DECL_DIV (DIV_PAR BELOW)
* ARE LOCATED BEFORE THE OBJ_CALL ARGUMENTS. CONSEQUENTLY,THEY MAY BE ADDRESSED
* RELATIVE TO A4. THE FUNCTIONS OF DECL_DIV ARE:
* 1: DECL_DORMANT: CHANGES AN OPEN OBJECT TO A DORMANT PROCESS
* 2: DECL_COND: CHANGES AN OPEN OBJECT TO A CONDITION OBJECT
* 3: DECL_GATE: CHANGES AN OPEN OBJECT TO A GATE OBJECT
* 4: DECL_CHANNEL: INSTALLS AN INTERRUPT PROCEDURE
* 5: REM_EXT: SELECTS A STACK EXTENSION OBJECT THAT CAN BE DELETED.
* TERMDRIV IS THE INVERSE OPERATION OF DECL_CHANNEL, BUT IT IS NOT
* CALLED EXPLICITLY. IT IS CALLED WHEN THE KERNEL REMOVES A
* DRIVER POINTER. AN EXPLICIT FUNCTION CALLED "REM_CHANNEL" MIGHT
* BE IMPLEMENTED.
DIV_PAR EQU 4+4+4 SIZE OF (RETURN-PC + POINTER_ARG + FUNCTION_ARG)
* DIV_PAR(A4) CONTAINS NONSTANDARD ARGUMENTS
* TO THE FUNCTIONS OF DECL_DIV;
* ARGUMENT FOR DECLCHAN:
DIV_EXT EQU DIV_PAR EXTENSION
DIV_CHA EQU DIV_EXT+4 CHANNEL
DIV_LEV EQU DIV_CHA+4 LEVEL
DIV_STK EQU DIV_LEV+4 STACK
DIV_ENT EQU DIV_STK+4 ENTRY
* THE VECTOR TABLE (KV_INVEC) HOLDS ADDRESSES OF INTERRUPT PROCEDURES.
* THE DRIVER TABLE (DRIV_TAB) HOLDS ADDRESSES OF ENVELOPES.
* THE STACK TABLE (STAK-TAB) HOLDS DESCRIPTIONS OF THE DRIVERS.
* THE CODE AND THE LOCAL POINTERS OF A CHANNEL CAN BE "ADDRESSED"
* BY AN INTERRUPT USING THE FIRST TWO TABLES. A DESCRIPTION IN
* THE STACK TABLE HOLDS STACK <<16+LEVEL OF THE INTERRUPT.
* IT IS USED BY THE KERNEL TO MONITOR THE SIZE OF THE
* SUPERVISOR STACK
* "UNASSIGNED" ENTRIES IN THE DRIVER - AND STACK TABLE WILL CONTAIN
* EITHER -1: A DRIVER CAN NEVER BE ASSIGNED TO THIS CHANNEL
* AND NO STACK REQUIREMENT IS CLAIMED BY THIS CHENNEL.
* OR = 0: FREE CHANNEL;
PAGE
MOVEQ.L #4,D6 D6:= ARG# CORRESPONDING TO FORMAL-1
LSL.W #1,D5 D5:=FUNC:=FUNCTION <<1;
CASEJMP D5 GOTO CASE FUNC OF
CASELAB CASE_ERR 0<1: NOT POSSIBLE
CASELAB DECLDORM 1<1: DECL_DORMANT PROCESS
CASELAB DECLCOND 2<1: DECL_CONDITION OBJECT
CASELAB DECLGATE 3<1: DECL_GATE OBJECT
CASELAB DECLCHAN 4<1: DECL_CHANNEL
* CASELAB REM_EXT NOT IMPL. 5<1: REMOVE_EXTENSION
DECLDORM EQU * DECL.DORMANT PROCESS
* THE PARAMETERS ARE AS FOLLOWS:
* FORMAL-1 OF CALLING CONTEXT (=A2) SHOULD BE AN OPEN OBJECT
*
BSR.L C_OPENF1 CHECK_F1(A3:=OBJECT,...
BNE.L ER_GIVEUP WHEN <NE>:NOT_OK GOTO GIVE_UP;
DECLBOOT EQU * DECLARE BOOT PROCESS: "CALLED FROM ENTER"
MOVE.W #PR_SIZ-OB_SIZ,D0 D0:=KNEL BYTES FOR PROCESS DESCR;
EXG.L A3,A0 A0:=OBJECT; SAVE A0 IN A3;
BSR.L MM_PUSHO RESERVE KNEL BYTES (D0=BYTES, A0=OBJECT)
EXG.L A0,A3 A3:=OBJECT, RESTORE A0 FROM A3
BEQ.L ER_GIVEUP WHEN NO ROOM GOTO GIVE_UP;
INIT_HEAD EX_CTX(A3),A6 CONTEXTS:=EMPTY
INIT_HEAD EX_EXT(A3),A6 EXTENSIONS:=EMPTY
MOVE.L A3,EX_PR(A3) PROC_ADDR:=PROC_OBJECT;
INIT_HEAD PR_MAIN(A3),A6 MAIN_QUEUE NOT USED
INIT_HEAD PR_AUX(A3),A6 AUX_QUEUE NOT USED
INIT_HEAD PR_TERM(A3),A6 NO PROC WAITING FOR TEMRINATION;
MOVE.B #OB_DOOB,OB_KIN(A3) OBJECT.KIND:=DORMANT PROCESS;
CLR.L PR_CPU(A3) CLEAR SIMPLE FIELDS OF PROCESS
CLR.L PR_CPU+4(A3)
CLR.B PR_PRI(A3)
CLR.B PR_STA(A3)
* PR_TIMO NEED NOT BE ASSIGNED
CLR.L D7 D7:=RESULT:=OK; CCR:=RETURN := <EQ>;
PRT_MEM DECLDORM,(A3),PR_SIZ ********
RTS RETURN;
PAGE
DECLCOND EQU * DECL.CONDITION OBJECT
* THE PARAMETERS ARE AS FOLLOWS:
* FORMAL -1 OF CALLING CONTEXT SHOULD BE AN OPEN OBJECT
* FORMAL -2 OF CALLING CONTEXT SHOULD BE A GATE OBJECT
* THE OPEN OBJECT IS CHANGED TO A CONDITION MANAGED BY THE GATE;
*
BSR.L C_OPENF1 CHECK_F1(A3:=OBJECT,D0:=INDEX TO FORMAL-1;
BNE.L ER_GIVEUP WHEN <NE>:NOT_OK GOTO GIVE_UP;
MOVE.L #5,D6 D6:= ARG# OF FORMAL-2
ADD.W #FP_SIZ,D0 D0:=INDEX TO FORMAL-2:=D0+SIZE OF FORMAL P
LEA (A2,D0.W),A1 A1:=FORMAL-2;
CMP.B #PT_OBJ,PT_KIN(A1) TEST POINTER; "GATE MAY HAVE BEEN DELETED"
BNE.L ER_DUMMY WHEN KIND <> REF_OBJ GOTO DUMMYFIED;
MOVE.L PT_REF(A1),A1 A1:=GATE OBJECT;
CMP.B #OB_GAOB,OB_KIN(A1) TEST OBJECT; "GATE MAY HAVE BEEN TERMINATE
BNE.L ER_DUMMY WHEN KIND<>GATE GOTO DUMMYFIED;
* A1 = GATE OBJECT.
MOVE.W #CO_SIZ-OB_SIZ,D0 D0:=KNEL BYTES FOR CONDITION DESCR.
EXG.L A3,A0
BSR.L MM_PUSHO RESERVE KNEL BYTES (D0=BYTES,...
EXG.L A0,A3
BEQ.L ER_GIVEUP WHEN NOT OK GOTO GIVE_UP;
MOVE.B #OB_COOB,OB_KIN(A3) COND.KIND:=COND OBJ;
MOVE.L A1,CO_GA(A3) COND.GATE:=GATE OBJECT;
INIT_HEAD CO_WAIT(A3),A6 COND.WAITING_PROCS:=EMPTY;
LEA GA_SET(A1),A1 A1:=MAN_SET OF GATE;
LEA CO_MAN(A3),A3 A3:=MEMBER OF MANSET;
INS_ELEM A1,A3,A6,A1/A6 INSERT CONDITION IN MAN_SET OF GATE;
CLR.L D7 D7:=RESULT:=OK; CCR:= RETURN := <EQ>;
PRT_MEM DECLCOND,-CO_MAN(A3),CO_SIZ ********
RTS RETURN;
PAGE
DECLGATE EQU * DECL.GATE OBJECT
* THE PARAMETERS ARE AS FOLLOWS:
* FORMAL-1 OF CALLING CONTEXT SHOULD BE AN OPEN OBJECT.
* CURRENT OBJECT OF CALLING CONTEXT BECOMES THE SCHEDULER OF THE GATE.
* DIV_PAR HOLDS A LONG INTEGER. IF THE CALLING SCHEDULER IS AN INTERRUPT
* SCHEDULER, THE INTEGER DESIGNATE THE LEVEL OF THE DEVICE GATE TO BE CREATED.
*
BSR.L C_OPENF1 CHECK_F1(A3:=OBJECT;
BNE.L ER_GIVEUP WHEN <NE>:NOT_OK GOTO GIVE_UP;
MOVEQ.L #0,D6 D6:= ARG# OF
SUBQ.B #1,D6 FIRST VALUE;
BSR.L C_SCHED CHECK_SCHED(A1:=SCHEDULER,...
IF <NE> THEN.S IF INTERRUPT SCHEDULER THEN
MOVE.L DIV_PAR(A4),D1 D1:=LEVEL OF DEVICE GATE;
BLE.L ER_DAILL WHEN LEVEL <=0 GOTO DATA_VALUE_ILLEGAL;
CMP.L #6,D1
BGT.L ER_DAILL WHEN LEVEL > 6 GOTO DATA_VALUE_ILLEGAL;
ELSE.S ELSE "NORMAL SCHEDULER"
CLR.W D1 D1:=0; "LEVEL OF NORMAL GATE"
ENDI ENDI;
* A3=OPEN OBJ, A1=SCHEDULER, D1.W=LEVEL OF NEW GATE OBJECT
MOVE.W #GA_SIZ-OB_SIZ,D0 D0:=SIZE OF GATE DESCR;
EXG.L A3,A0
BSR.L MM_PUSHO RESERVE(D0:=KNEL BYTES,...
EXG.L A0,A3
BEQ.L ER_GIVEUP WHEN NOT OK GOTO GIVE_UP;
MOVE.B #OB_GAOB,OB_KIN(A3) GATA.KIND:= GATE_OBJ;
INIT_HEAD GA_SET(A3),A6 MAN_SET:=EMPTY;
INIT_HEAD GA_LOK(A3),A6 LOCKING:=EMPTY;
INIT_HEAD GA_RELOK(A3),A6 RELOCKING:=EMPTY;
INIT_HEAD GA_SPLOK(A3),A6 SPEED RELOCKING:=EMPTY;
MOVE.W D1,GA_STA(A3) STATE:=OPEN; LEVEL:=LEVEL;
LEA GA_SCH(A3),A3 A3:=SP:=SCHEDULER POINTER
MOVE.W #PT_OBJ<<8,PT_KIN(A3) SP.KIND:=REF_OBJ; SP.SCOPE:=NO_SCOPE;
MOVE.L A1,PT_REF(A3) SP.REF:=SCHEDULER;
LEA OB_REF(A1),A1 A1:=REF OBJECT CHAIN
INS_ELEM A1,A3,A6,A1/A6 INSERT POINTER IN REFOBJ CHAIN OF SCHED;
CLR.L D7 D7:=RESULT:=0; CCR:=RETURN:=<EQ>;
PRT_MEM DECLGATE,-GA_SCH(A3),GA_SIZ ********
RTS RETURN;
PAGE
DECLCHAN EQU * DECL_CHANNEL
* THE PARAMETERS ARE AS FOLLOWS:
* THE ACTUAL OF FORMAL-1 IN CURRENT CONTEXT SHOULD BE A LOCAL SIMPLE POINTER.
* IT BECOMES A DRIVER POINTER. FORMAL-2 SHOULD POINT TO A SEGMENT OBJECT.
* IT HOLDS THE CODE OF THE INTERRUPT PROCEDURE OF THE NEW CHANNEL.
* DIV_PAR CONTAINS FIVE LONG INTEGERS: EXTENSION, CHANNEL, LEVEL, STACK, ENTRY.
* EXTENSION=0: SETUP CHANNEL OR CLAIM CHANNEL AND SUPERVISOR STACK SPACE.
* EXTENSION>0: EXTEND STACK AND SETUP CHANNEL; TEMP-2 HOLDS THE EXT_OBJ.
* DECLCHAN IS ONLY CALLED BY THE INITIAL SCHEDULER. EXTENSION > 0 NOT IMPL.
*
MOVEQ.L #0,D6 D6:= ARG# OF
SUBQ.B #1,D6 FIRST VALUE;
MOVE.L DIV_CHA(A4),D1 D1:=CHANNEL;
BLT.L ER_DAILL WHEN CHANNEL <0 GOTO DATA_VALUE_ILLEGAL;
CMP.L #255,D1
BGT.L ER_DAILL WHEN CHANNEL > 255 GOTO DATA_VALUE_ILLEGAL;
LSL.W #2,D1 D1:=CHANNEL INDEX:=CHANNEL *4
SUBQ.B #1,D6 D6:= ARG# OG 2. VALUE
MOVE.L DIV_LEV(A4),D3 D2:=LEVEL;
BLE.L ER_DAILL WHEN LEVEL <=0 GOTO DATA_VALUE_ILLEGAL;
CMP.L #7,D3
BGT.L ER_DAILL WHEN LEVEL > 7 GOTO DATA_VALUE_ILLEGAL;
SUBQ.B #1,D6 D6:= ARG# OF 3. VALUE
MOVE.L DIV_STK(A4),D2 D2:=STACK; "USED BY INTERRUPTS"
BLT.L ER_DAILL WHEN STACK <0 GOTO DATA_VALUE_ILLEGAL;
CMP.L #1<<11,D2
BGT.L ER_DAILL WHEN STACK >2K GOTO DATA VALUE ILLEGAL;
ADD.L #TRP7RESI,D2 D2:=STACK:=...+KERNEL_OVERHEAD+$FF;
CLR.B D2 D2:= AN INTEGRAL #PAGES;
SWAP D2 D2:=STACK<<16
MOVE.B D3,D2 +LEVEL;
* D1 = CHANNEL INDEX, D2=STACK<<16+LEVEL
*
MOVE.L DIV_EXT(A4),D7 D7:=EXT PARAM;
**IF <EQ> THEN.S IF EXT = 0 THEN "NO OBJECT IN TEMP -2"
LEA STAK_TAB,A6 A6:=STACK_TABLE
TST.L (A6,D1.W) TEST FOR FREE CHANNEL
BNE.L ER_INUSE WHEN CHANNEL IN USE GOTO CHANNEL_IN_USE;
MOVE.L D2,(A6,D1.W) STACK_TAB(CHANNEL):="IN_USE";
BSR.L COMPSTAK COMPSTAK(D6:=DIF,A6=STACK,D2/D3/D4:=?);
IF <GT> THEN.S IF STACK TOO SMALL THEN
CLR.L (A6,D1.W) RELEASE CHANNEL;
BRA.L ER_NORES GOTO NO RESOURSES(D6=MISSING SPACE);
ENDI ENDI;
BSR.L C_FORM12 CHK_FORMLS(A1/A3/A5/D0/D5:=!,D3/D6/A6:=?)
IF <EQ> THEN.S IF NOT OK THEN
LEA STAK_TAB,A6 A6:=STACK_TABLE;
CLR.L (A6,D1.W) STACK_TABLE(CHANNEL):="FREE"; CCR:=<EQ>
RTS RETURN;
ENDI ENDI;
BSR.L CRE_CHAN CREATE_CHANNEL(A1/A3/A5/D0/D1/D5=!,
* A1/A3/A5/D0/D1/D5/A6:=?)
CLR.L D7 RESULT:=OK; CCR:=RETURN:=<EQ>;
RTS RETURN;
**ENDI ENDI; "EXT=0"
PAGE
* EXT >0, TEMP-2 SHOULD HOLD AN OPEN OBJECT
* THE CHANNEL AND THE CURRENT STACK HAS BEEN CLAIMED
* WHILE THE OPEN OBJECT WAS CREATED.
*
* 1. CHECK TEMP-2, FREE USER SPACE MUST BE EQUAL TO EXT
* 2. MOVE OBJECT TO OWNERSET OF LOCAL-2.
* 3. REMOVE FREE USER SPACE FROM THE OBJECT AND EXTEND THE STACK
* 4. CHECK FORMAL-1 AND -2;
* A. IF NOT OK THEN UNDO STEP 2 AND 3 AND RELEASE THE CHANNEL
* B. IF OK THEN CREATE THE CHANNEL DESCRIPTIONS
* 5. REDUCE CLAIMERS BY ONE.
*
* AT PRESENT ONLY STEP 4 AND 5 ARE IMPLEMENTED. (RESULT ALWAYS <> OK);
* MOVE.L #ECRG_UP,D7 D7:=RESULT:=GIVE_UP;
* BSR.L C_FORM12 CHECK_FORMALS(... D7 MAY CHANGE)
* LEA STAK_TAB,A6
* SUBQ.W #1,CLAIMERS CLAIMERS:=...-1;
* CLR.L (A6,D1.W) STAK_TAB(CHANNEL):="FREE"; CCR:=<EQ>
* RTS RETURN;
TERMDRIV EQU * REMOVE CHANNEL DESCRIPTIONS;
* CALL: RETURN:
* D0/D1 ANY UNDEF
* A1/A3 ANY UNDEF
* A6 POINTER ADDRESS UNDEF POINTER BECOMES NIL
* CALLED BY THE KERNEL BEFORE DRIVER POINTER IS DESTROYED.
* DECREASE RESIDENT COUNTS OF ENVELOPE AND CODE SEGMENT OBJECT
* ASSIGN "FREE" TO INTERRUPT VECTOR, DRIVER_TABLE AND STACK_TABLE
*
PRT_MEM TERMDRIV,(A6),PT_SIZ ********
CLR.W D1 D1.W:=CHANNEL_INDEX
MOVE.B PT_INF(A6),D1 :=CHANNEL
LSL.W #2,D1 *4;
* CHANGE DRIVER TO A LOCAL-NIL-POINTER.
MOVE.B #1<<PT_LSC,PT_INF(A6) SCOPE:=LOCAL;
MOVE.B #PT_NIL,PT_KIN(A6) KIND:=NIL;
REM_ELEM (A6),A1,A3,A1/A3 REMOVE POINTER FROM SEGMENT CHAIN;
* PT_REF IS LEFT UNCHANGED FOR USE IN DECREASE RES_COUNT.
INIT_HEAD (A6),A3 POINTER CHAIN:=EMPTY;
LEA DRIV_TAB,A3 A3:=DRIVER TABLE;
MOVE.L (A3,D1.W),A1 A1:=EN_STK OF ENVELOPE HOLDING DRIVER PT.
SUBQ.W #1,EN_RES-EN_STK(A1) ENV.RES_COUNT:=...-1;
PRT_MEM DRIV_ENV,-EN_STK(A1),ST_SIZ ********
CLR.L (A3,D1.W) DRIVER_TABLE(CHANNEL):=FREE:=0;
PRT_MEM DRIV_TAB,<(A3,D1.W)>,4 ********
LEA STAK_TAB,A3 A3:=STACK_TABLE;
CLR.L (A3,D1.W) STACK_TABLE(CHANNEL):=FREE:=0;
LEA KV_INVEC,A3 A3:=INTERRUPT VECTOR(=0!)
LEA RTEDUMMY,A1 A1:=DUMMY INTERRUPT PROCEDURE;
MOVE.L A1,(A3,D1.W) INT_VECTOR(CHANNEL):=DUMMY_PROC;
PRT_MEM KV_INVEC,<(A3,D1.W)>,4 ********
MOVEQ #-1,D0 D0:=DECREASE:=-1;
MOVE.W #OB_RES,D1 D1:=ADDRESS OF RES_COUNT;
BSR.L INCRDECR DECREASE (PT_REF(A6),...
RTS RETURN;
PAGE
COMPSTAK EQU * COMPUTE DIFFERENCE=NEEDED_SUPVSIZE-ACTUAL_SUPVSIZE
* CALL RETURN:
* D2/D3/D4 ANY UNDEF
* D6 DIFFERENCE
* A6 STAK_TAB SAME
* CCR <LE>:DIFFERENCE<=0; <GE>:DIFFERENCE>=0
CLR.L D6 D6:=NEEDED_STACK:=0;
FOR.W D2=#0 TO #7 BY #1 DO.S FOR ALL LEVELS DO.S
CLR.L D3 MAX:=0;
FOR.W D4=#0 TO #255*4 BY #4 DO.S FOR ALL CHANNELS DO.S
* THIS FOR LOOP USES MAX 84 CYCLES/CHANNEL
TST.B D4 TEST (CHANNEL*4) MOD 256 = 0
IF <EQ> THEN.S IF CHANNEL MOD 64 = 0 THEN
BSR.L EN_DIS ALLOW INTERUPS TO BE GRANTED;
ENDI ENDI;
MOVE.L (A6,D4.W),D5 D5:=DESC:=STAK_TAB(CHANNEL)
IF <GT> THEN.S IF CHANNEL IN USE THEN
IF.B D2 <EQ> D5 THEN.S IF DESC.LEVEL=CUR_LEVEL THEN
IF.L D5 <GT> D3 THEN.S IF DESC > MAX THEN
MOVE.L D5,D3 D3:=MAX:=DESC
ENDI ENDI;
ENDI ENDI;
ENDI ENDI;
ENDF ENDF;
CLR.W D3
SWAP D3 D3:=STACK USED BY LEVEL;
ADD.L D3,D6 D6:=NEEDED_STACK:=...+STACK USED BY LEVEL
ENDF ENDF;
MOVE.L SUPV_STK,D2 D2:=ACTUAL_SIZE:= LAST+1 BYTE OF STACK
SUB.L F_SUPVS,D2 - FIRST BYTE OF STACK;
SUB.L D2,D6 D6:=DIF:=NEEDED_STACK-ACTUAL_SIZE;CCR:=!;
RTS RETURN;
PAGE
C_FORM12 EQU * CHECK FORMAL-1 AND -2 IN DECL_CHANNEL
* CALL: RETURN;
* A1 ANY SEGMENT DATA
* A2 CUR_CTX SAME
* A3 ANY SEGMENT OBJECT
* A4 ARGUMENT ADDR SAME
* A5 ANY DRIVER ENVELOPE
* A6 ANY UNDEF
* DO ANY DRIVER POINTER OFFSET
* D3 ANY UNDEF
* D5 ANY ENTRY ADDRESS
* D6 ANY UNDEF
* D7 RESULT WHEN CCR = <EQ>
* CCR <NE>:OK; <EQ>:NOT OK
*
* FORMAL-1 SPECIFIES THE DRIVER POINTER
* FORMAL-2 SPECIFIES THE CODE SEGMENT OF THE INTERRUPT PROCEDURE
*
MOVEQ.L #4,D6 D6:= ARG# OF FORMAL-1;
MOVE.W CT_TOPT(A2),D0 D0:=INDEX TO FORMAL-1
LEA (A2,D0.W),A3 A3:=ADDRESS OF FORMAL-1
MOVE.W FP_OFF(A3),A6 A6:=FORMAL-1 IN THE SCHEDULER CTX
ADD.L FP_STR(A3),A6 CALLED BY THE USER;
BCLR.B #PT_RET,PT_INF(A6) CLEAR RETURN BIT ON FORMAL;
MOVE.W FP_OFF(A6),D0 (A5,D0):=ACTUAL DRIVER POINTER
MOVE.L FP_STR(A6),A5 AS DEFINED BY THE USER;
IF.W A5 <EQ> #0 THEN.S IF ACTUAL = DUMMY ACTUAL THEN
MOVE.L #ECRRETURN,D7 RESULT:=RETURN_POINTER_ILLEGAL;
CMP.W D0,D0 CCR:=<EQ>
RTS RETURN;
ENDI ENDI;
LEA (A5,D0.W),A6 A6:=DRIVER POINTER;
BTST.B #PT_LSC,PT_INF(A6) TEST FOR LOCAL SCOPE
IF <EQ> THEN.S IF SCOPE <> LOCAL THEN
MOVE.L #ECRSCOPE,D7 D7:=RESULT:=POINTER_SCOPE_ILLEGAL;
CMP.W D0,D0 CCR:=<EQ>
RTS RETURN;
ENDI ENDI;
PAGE
IF.B PT_KIN(A6) <GT> #PT_ENV THEN.S IF KIND <> SIMPLE THEN
MOVE.L #ECRRETURN,D7 D7:=RESULT:=RETURN_POINTER_ILLEGAL;
CMP.W D0,D0 CCR:=<EQ>
RTS RETURN;
ENDI ENDI;
MOVEQ.L #5,D6 D6:= ARG# OF FORMAL-2;
LEA FP_SIZ(A3),A6 A6:=FORMAL-2:=NEXT TO FORMAL-1;
MOVE.B PT_KIN(A6),D2 D2:=POINTER_KIND
BSR.L C_SEGM CHECK_SEGMENT(A1/A3/D3/D5:=SEGM DESC...)
IF <EQ> THEN.S IF NOT OK THEN
RTS RETURN
ENDI ENDI;
BTST.L #2,D5 TEST EXECUTE BIT IN USE-BITS OF SEGMENT
IF <EQ> THEN.S IF NO EXECUTE BIT THEN
MOVE.L #ECRCAP,D7 D7:=RESULT:=CAPABILITY_VIOLATION;
CMP.W D0,D0 CCR:=<EQ>
RTS RETURN;
ENDI ENDI;
MOVEQ.L #0,D6 D6:= ARG# OF
SUBQ.B #4,D6 4. VALUE
MOVE.L DIV_ENT(A4),D5 D5:=ENTRY ADDRESS;
BLT.S C_FORMXX WHEN ENTRY <0 GOTO ENTRY_ILLEGAL;
BTST.L #0,D5 TEST BIT 0 IN ENTRY ADDRESS
BNE.S C_FORMXX WHEN UNEVEN ADDRESS GOTO ENTRY_ILLEGAL;
SUB.L D5,D3 D3:=DATA LENGTH - ENTRY ADDRESS;
BLE.S C_FORMXX WHEN ENTRY OUTSIDE GOTO ENTRY_ILLEGAL;
RTS RETURN; "CCR = <NE>"
C_FORMXX EQU * ENTRY_ILLEGAL:
MOVE.L #ECRDATA,D7 D7:=RESULT:=DATA_VALUE_ILLEGAL;
CMP.W D0,D0 CCR:=<EQ>
RTS RETURN;
PAGE
CRE_CHAN EQU * CREATE CHANNEL DESCRIPTIONS
* CALL: RETURN:
* A1 SEGM DATA (INT_PROC_CODE) UNDEF
* A3 SEGM OBJECT UNDEF
* A5 DRIVER ENVELOPE UNDEF
* A6 ANY UNDEF
* D0 DRIVER POINTER OFFSET UNDEF
* D1 CHANNEL INDEX UNDEF
* D5 ENTRY ADDRESS (OF INTRPT) UNDEF
*
*
* ASSIGN TO DRIVER TABLE, INTERRUPT VECTOR AND DRIVER POINTER;
* INCREASE RESIDENT COUNT OF ENVELOPE AND CODE SEGMENT OBJECT;
PRT_REG CRE_CHAN_D0/D1/D5/A1/A3/A5/ ********
LEA DRIV_TAB,A6 A6:=DRIVER_TABLE ADDRESS
LEA EN_STK(A5),A5 A5:= STK_EL_ADDR:= ADDR OF ENV.EN_STK;
MOVE.L A5,(A6,D1.W) DRIVER_TABLE(CHANNEL):=STK_EL_ADDR;
PRT_MEM DRIV_TAB,<(A6,D1.W)>,4 ********
LEA KV_INVEC,A6 A6:=INTERRUPT VECTOR ADDRESS;"NORMALLY=0"
ADD.L D5,A1 A1:=INTERRUPT ENTRY (PHYS);"=DATA+ENTRY"
MOVE.L A1,(A6,D1.W) INT_VECTOR(CHANNEL):=INTERRUPT ENTRY;
PRT_MEM KV_INVEC,<(A6,D1.W)>,4 ********
LEA -EN_STK(A5),A1 A1:= ENVELOPE;"OFFSET"
ADDQ.W #1,EN_RES(A1) ENV.RES_COUNT:=...+1;
EXG D0,D1 D1:=DRIVER POINTER REL; SAVE D1 IN D0;
BSR.L CLR_SMP CLR_SMP((A1,D1)=PT, A6:=PT);
MOVE.L A6,A5 A5:= DRIVER POINTER:=A6;
EXG D1,D0 RESTORE D0,D1
LEA OB_REF(A3),A1 A1:=REF_OBJ CHAIN OF SEGMENT;
INS_ELEM A1,A5,A6,A1/A6 CHAIN DRIVER POINTER TO SEGMENT;
MOVE.L A3,PT_REF(A5) POINTER.REF:=SEGMENT OBJECT;
MOVE.B #PT_INT,PT_KIN(A5) POINTER.KIND:=DRIVER_POINTER;
LSR.W #2,D1 D1.B:=CHANNEL:=CHANNEL_INDEX DIV 4;
MOVE.B D1,PT_INF(A5) POINTER.INF:=CHANNEL;
PRT_MEM DRIV_PT,(A5),PT_SIZ ********
MOVEQ. #1,D0 D0:=INCREASE:=+1;
MOVE.W #OB_RES,D1 D1:=ADDRESS OF RESIDENT COUNT;
MOVE.L A5,A6 A6:=POINTER TO SEGMENT:=DRIVER_POINTER;
BSR.L INCRDECR INCREASE RESIDENT COUNTS
RTS RETURN;
C_SCHED EQU * CHECK CALLING SCHEDULER;
* CALL: RETURN:
* A1 ANY SCHEDULER OBJECT
* A2 CUR_CTX SAME
* A6 ANY UNDEF
* D0.B ANY POINTER KIND OF LOCAL-5 OF SCHEDULER
* CCR <EQ>: NORMAL, <NE>: INTERRUPT SCHEDULER
*
MOVE.L CT_OBJ(A2),A1 A1:=SCHED:=CURRENT_OBJECT
MOVE.L OB_SPA(A1),A6 A6:=TOP_OBJ=SPACE DESC;
MOVE.L SP_ENV+4(A6),A6 A6:=PRIMARY ENVELOPE
LEA EN_SIZ-EN_STK+4*PT_SIZ(A6),A6 A6:= ADDRESS OF LOCAL-5;
* A6 = LOCAL-5 OF CALLING SCHEDULER; PT_KIN=NIL=0 FOR A NORMAL SCHEDULER
MOVE.B PT_KIN(A6),D0 D0:=LOCAL-5.KIND, CCR:=SCHEDULER KIND;
RTS RETURN;
PAGE
C_OPENF1 EQU * CHECK THAT ONE OPEN OBJECT IS PRESENT IN FORMAL-1
* CALL: RETURN:
* D0 ANY INDEX TO FORMAL-1
* A2 CUR_CTX SAME
* A3 ANY OPEN OBJECT
* CCR: OBS, OBS, OBS, <NE>: NOT OK, <EQ>: OK
*
MOVE.W CT_TOPT(A2),D0 D0:=INDEX TO FIRST FORMAL;
LEA (A2,D0.W),A3 A3:=ADDRESS OF FIRST FORMAL POINTER;
CMP.B #PT_OWN,PT_KIN(A3) TEST KIND OF FIRST FORMAL
BNE.S C_OPENFX WHEN NOT OWNER GOTO EXIT_NOT_OK
MOVE.L (A3),A3 A3:= FIRST OBJECT IN OWN_SET;
CMPA.L 4(A2,D0.W),A3 COMPARE FIRST AND LAST OF OWN_SET;
BNE.S C_OPENFX WHEN MORE THAN ONE OBJ IN SET GOTO EXIT....
CMP.B #OB_OPOB,OB_KIN(A3) CCR:= KIND=OPEN;
C_OPENFX EQU * EXIT_NOT_OK:
RTS RETURN;
PAGE
* LABELS WITH "ER_" ARE USED IN THE ENVIRONMENT OF C_CALL
ER_GIVEUP EQU * GIVE_UP:
MOVE.L #ECSG_UP,D7 D7:=RESULT:=STATUS,GIVE_UP;
BRA.S ER_RTS GOTO RETURN
*
ER_DUMMY EQU * DUMMYFIED:
MOVE.L #ECSDUMMY,D7 D7:=RESULT:=STATUS,DUMMYFIED;
BRA.S ER_RTS GOTO RETURN;
*
ER_DAILL EQU * DATA_VALUE_ILLEGAL:
MOVE.L #ECRDATA,D7 D7:=RESULT:=DATA_VALUE_ILLEGAL;
BRA.S ER_RTS GOTO RETURN
*
ER_INUSE EQU * CHANNEL_IN_USE: ****** BAD ERROR CAUSE*******
MOVE.L #ECRCONC,D7 D7:=RESULT:=CONCURRENCY_VIOLATION;
BRA.S ER_RTS GOTO RETURN
*
ER_STATE EQU * OBJECT_STATE_ILLEGAL:
MOVE.L #ECRSTATE,D7 D7:=RESULT:=OBJECT_STATE_ILLEGAL;
* BRA.S ER_RTS GOTO RETURN;
*
ER_RTS EQU * RETURN
CMP.W D0,D0 CCR:=<EQ>; "RETURN TO CALLER"
RTS RETURN;
*
ER_VAILL EQU * POINTER_VALUE_ILLEGAL:
MOVE.L #ECRVALUE,D7 D7:=RESULT:=POINTER_VALUE_ILLEGAL
BRA.S ER_RTS GOTO RETURN;
*
ER_FUILL EQU * FUNCTION_ILLEGAL:
MOVE.L #ECRFUNC,D7 D7:=RESULT:=FUNCTION_ILLEGAL
BRA.S ER_RTS GOTO RETURN
*
ER_CAILL EQU * CAPABILITY_VIOLATION:
MOVE.L #ECRCAP,D7 D7:=RESULT:=CAPABILITY_VIOLATION;
BRA.S ER_RTS GOTO RETURN;
*
ER_NORES EQU * NO_RESOURSES:
MOVE.L #ECRNO_RES,D7 D7:=RESULT:=NO RESOURCES;
BRA.S ER_RTS GOTO RETURN;
*
ER_ADILL EQU * ADDRESS_ILLEGAL:
MOVE.L #ECRADDR,D7 D7:=RESULT:=ADDRESS ILLEGAL;
BRA.S ER_RTS GOTO RETURN;
*
ER_ARGMIS EQU * ARGUMENT_MISSING:
MOVE.L #ECRARGMIS,D7 D7:=RESULT:=ARGUMENT_MISSING
BRA.S ER_RTS GOTO RETURN;
*
ER_VAL3MIS EQU * VALUES_MISSING:
MOVEQ.L #3,D6 D6:= ARG# OF VALUE DATA ARGUMENT;
ER_VALMIS EQU * VALUE_MISSING: "D6=ARG# OF VALUE"
MOVE.L #ECRVALMIS,D7 D7:=RESULT:=VALUE_MISSING;
BRA.S ER_RTS GOTO RETURN;
PAGE
SCHEDENT EQU * ENTRY OF GENERAL OBJECT BEING A SCHEDULER OBJECT
* OBJ_CALL: OBJ_RETURN:
* D0 FUNCTION
* D2 (IMPLI)
* D3 #FORMALS
* D4 (INDEX)
* D5 (BYTES)
* D6 ANY RESULT
* D7 ANY RESULT
* A4 ANY RESTORED BY OBJ_RETURN
* A5 FTMP MOVED TO A4 IMMEDIATLY RESTORED BY OBJ_RETURN
* A6 TOPVAL RESTORED BY OBJ_RETURN
* A7 FIRST VAL
* THE ENTRY SITUATION IS THE NORMAL ENTRY SITUATION FOR CONTEXTS
* IN GENERAL OBJECTS
* THE SCHEDULER OBJECT "TYPES" ARE: INITIAL, NORMAL OR INTERRUPT.
* THE GENERAL SCHEDULER OBJECT IS CALLED TO CREATE VARIOUS OBJECTS.
* IT CALLS AN ALLOC OBJECT TO ALLOCATE AN OPEN OBJECT.
* A SPECIAL KERNEL DEFINED OBJECT, IS CALLED TO ASSIGN
* VALUES TO THE PROTECTED PARTS OF THE NEW OBJECT. THIS
* TRICK IS NEEDED BECAUSE THE GENERAL SCHEDULER OBJECT
* RUNS IN A PROTECTED ENVIRONMENT (LIKE ALL OTHER GENERAL OBJECTS).
*
* D0 CONTAINS THE FUNCTION CODE. THE FUNCTIONS ARE:
* 1: NEW_PROC (ÆR,PROCÅ; SIZE)
* 2: NEW_SCHD (ÆR,SCHDÅ,ÆC,ALLOCÅ)
* 3: NEW_GATE (ÆR,GATEÅ; LEVEL) LEVEL IS OPTIONAL
* 4: NEW_CHANNEL (ÆR,INT_PTÅ,ÆCODESEGMÅ; CHANNEL,LEVEL,STACK,ENTRY)
* 5: DEL_EXT
* -1: NOT USED
* -2: NOT USED
* -3: NEWSCOND (ÆR,CONDÅ,ÆC,GATEÅ)
* -4: NEWICHAN (ÆC,INT_PTÅ,ÆC,CODESEGMÅ,ÆC,ALLOCÅ; 4LONGS)
* -5: DELIEXT
* THE LOCAL POINTERS OF A GENERAL SCHEDULER OBJECT ARE USED AS FOLLOWS
*
* LOCAL-1, POINTS TO THE CODE SEGMENT CREATED DURING INITIALIZATION;
* LOCAL-2, INITIAL SCHEDULER: OWN_SET HOLDING STACK EXTENSION OBJECTS;
* OTHER SCHEDULERS: NIL
* LOCAL-3, REF_OBJ: POINTS TO ALLOC OBJECT
* LOCAL-4, REF_OBJ: POINTS TO DECL_DIV OBJECT
* LOCAL-5, INTERRUPT SCHEDULERS: REF_ENV TO INITIAL SCHEDULER;
* OTHER SCHEDULERS: NIL
* LOCAL-6, MAN_SET: SCHEDULERS CREATED BY THIS SCHEDULER,
*
* AFTER INITIALIZATION, THE INITIAL SCHEDULER EXISTS AND IS KNOWN
* BY ONE INTERRUPT SCHEDULER. A NORMAL SCHEDULER IS ALSO CREATED.
* THE "DECL_DIV OBJECT" IS KNOWN BY ALL THREE SCHEDULERS.
* THE STUB OBJECT ENTERED AFTER INITIALIZATION HOLDS A REFERENCE TO THE
* NORMAL SCHEDULER AND THE INTERRUPT SCHEDULER.
* DECL_DIV AND THE INITIAL SCHEDULER WILL NEVER BE KNOWN
* OUTSIDE THE SCHEDULER MODULE.
*
* THE CODE SEGMENT CORRESPONDS TO THE RUN_TIME SECTION OF
* THE SCHEDULER SOURCE. PROCEDURES OUTSIDE THIS SCOPE CANNOT
* BE CALLED.
PAGE
MOVEQ.L #2,D6 D6:=ARG# OF FUNCTION;
MOVE.L A5,A4 A4:= FTMP; "FIRST OF TEMP DATA STACK"
MOVE.L A7,A5 A5:= LOW_VALUE; "LOWEST VALUE ADDRESS"
* A6 DEFINES THE NEXT VALUE TO BE READ BY "NEXTNUMB", INITIALLY=TOP_VALUE
* !---SELFTEST---!
IF.L D0 <LT> #-5 OR.L D0 <GT> #5 THEN.S IF FUNCTION ILLEGAL THEN
BRA.L RE_FUILL GOTO FUNCTION_ILLEGAL;
ENDI ENDI;
ADDQ.W #5,D0 D0:=JMP:=(FUNCTION+5)
LSL.W #1,D0 *2;
CASEJMP D0 GOTO CASE JMP OF
CASELAB DELIEXT -5: DELIEXT "INITIAL SCHEDULER"
CASELAB NEWICHAN -4: NEWICHAN "INITIAL SCHEDULER"
CASELAB NEWSCOND -3: NEWSCOND
CASELAB RE_FUILL -2: RE_FUILL
CASELAB RE_FUILL -1: RE_FUILL
CASELAB RE_GIVEUP 0: RE_GIVEUP
CASELAB NEW_PROC +1: NEW_PROC
CASELAB NEW_SCHD +2: NEW_SCHD
CASELAB NEW_GATE +3: NEW_GATE
CASELAB NEW_CHAN +4: NEW_CHAN
CASELAB DEL_EXT +5: DEL_EXT
*
NEW_PROC EQU * CREATE NEW DORMANT PROCESS OBJECT
* CHECK THE CALL: #FORMALS MUST BE ONE, VALUE DATA MUST CONTAIN PROC_SIZE;
TST.W D3
BEQ.L RE_ARGMIS WHEN #FORMALS <1 GOTO ARGUMENT_MISSING(D3);
MOVE.L A6,D0
SUB.L A5,D0 D0:=VAL_SIZE:=TOP_VALUE-LOW_VALUE;
CMP.L #8,D0 TEST D0=VAL_SIZE -8;
BLT.L RE_VAL3MIS WHEN VAL_SIZE <8 GOTO VALUES_MISSING;
MOVEQ.L #0,D6 D6:= ARG# OF
SUBQ.B #1,D6 FIRST VALUE;
CMP.W #6,-(A6) TEST LENGTH OF FIRST VALUE PARAM;
BNE.L RE_DAILL WHEN LENGTH <> 6 THEN GOTO DATA VALUE ILL;
SUBQ.L #6,A6 A6:= FIRST ADDRESS OF FIRST VALUE PARAM;
MOVE.L (A6),D0 D0:= SIZE.USER_BYTES;
MOVE.W SZ_K(A6),D1 D1:= SIZE.KNEL_BYTES;
ADD.W #(PR_SIZ-OB_SIZ),D1 D1:= ... + ROOM FOR SCHEDULERS ENVELOPE;
* THE PROC_SIZE NOW INCLUDES ROOM FOR PROCESS DESCRIPTION ETC.
MOVE.L #A_LOCAL+3,D6 D6:=ALLOC_POINTER:=LOCAL-3;
MOVE.L #A_FORMAL+1,D2 D2:=FORMAL-1
BSR.L NEW_OPEN NEW_OPEN_OBJECT(D0/D1=SIZE,D2=/D6=PT_ADDR)
MOVEQ #1,D5 D5:=DECL_DORMANT:=1;
BSR.L DECL_DIV DECL_DORMANT(D6/D7:=RESULT);
BRA.L RETURNOP RETURN(D6/D7=RESULT);
PAGE
NEW_SCHD EQU * CREATE NEW SCHEDULER OBJECT
* CHECK THE CALL: #FORMALS MUST BE 2,
*
CMP.W #2,D3
BLT.L RE_ARGMIS WHEN #FORMALS<2 GOTO ARGUMENT_MISSING(D3);
CLR.L D0 D0:=USER_BYTES:=0;
MOVE.W #GE_SIZ-OB_SIZ+EN_SIZ+(PT_SIZ*6),D1
* D1:= KNEL BYTES FOR GENERAL OBJECT + A PRIMARY ENVELOPE + 6 LOCAL POINTERS;
MOVE.L #A_FORMAL+2,D6 D6:=ALLOC POINTER:=FORMAL-2;
MOVE.L #A_FORMAL+1,D2 D2:=OWNER_POINTER:=FORMAL-1;
BSR.L NEW_OPEN NEW_OPEN_OBJECT (D0/D1=SIZE,...
LEA D_GEN1F(PC),A0 A0:=
MOVE.L A0,D4 D4:=LOW_ARG
MOVE.L #D_GEN1T-D_GEN1F,D2 D2:=LENGTH OF ARG:=TOP_ARG-LOW_ARG;
MOVEQ #2,D5 D5:=DECL_GEN:=2;
TRAP #7 CALL THE KERNEL
TST.W D7 TEST RESULT
BNE.L RE_GIVEUP WHEN NOT OK GIVE_UP;
* TEMP-2 POINTS TO THE PRIMARY ENVELOPE; INITIALIZE LOCAL POINTERS;
* AND MAKE OBJECT REENTRANT;
CLR.L -(A7) PUSH ZERO TO SIGNAL END OF LIST;
MOVE.L #1,-(A7) STACK:=LIST
MOVE.L #4,-(A7) :=(#1,#4,#5);
MOVE.L #5,-(A7) .
MOVE.L #A_LOCAL,A6 A6:=DIRECT LOCAL; "CALLED SCHED"
MOVE.L #(A_TEMP+2)<<16,A5 A5:=INDIRECT TEMP-2; "CREATED SCHED"
MOVE.L #A_FORMAL+2-A_LOCAL,D0 FIRST_FROM:=FORMAL-2 "BAD TRICK"
MOVEQ #3,D1 FIRST_TO :=TEMP(2,3)
REPEAT REPEAT "SCAN LIST"
* D0 = D1 = INDEX OF POINTER TO COPY, EXCEPT WHEN THE LOOP IS ENTERED!!!
MOVE.L A7,D2 D2:=TOPARG
PEA (A6,D0.L) FIRST_ARG:=FROM:=LOCAL(INDEX);
PEA (A5,D1.L) SECOND ARG:=TO:=TEMP(2,INDEX);
MOVE.L A7,D4 D4:=LOWARG
MOVE.L D2,A7 A7:=TOPARG; "RESTORE A7"
SUB.L D4,D2 D2:=LENGTH:=TOPARG-FIRSTARG
MOVEQ #13,D5 D5:=COPY:=13;
TRAP #7 CALL KERNEL OPERATION;
MOVE.L (A7)+,D0 GET NEXT INDEX FROM THE LIST;
MOVE.L D0,D1
UNTIL <EQ> UNTIL END OF INDEX LIST;
*
MOVE.L A7,D3 D3:=TOPARG
MOVE.L #A_TEMP+2,-(A7) ARGUMENT:=TEMP-2; "REF TO PRIMENV"
MOVE.L A7,D4 D4:=LOWARG
MOVE.L D3,A7 A7:=TOPARG; "RESTORE A7"
SUB.L D4,D3 D3:=LENGTH:= TOPARG-LOWARG;
MOVE.L D3,D2 D2:=LENGTH;
MOVEQ #10,D5 D5:=MAKE_REENTRANT:=10;
TRAP #7 CALL KERNEL OPERATION
BRA.L RE_OK GOTO RETURN OK;
PAGE
* ARGUMENT LIST FOR DECL_GEN; USED BY NEW_SCHEDULER;
D_GEN1F EQU * LOWARG:
DC.W -1 OWNER HAS CALL_CAP;
DC.L 0 CALL STACK USER BYTES
DC.W 0 CALL STACK KNEL BYTES
DC.L SCHEDENT ENTRY ADDRESS ******** ONLY FOR RAM-KNEL.
DC.L 0 NO CONTROL PROCEDURE
DC.L SCHTEMD TEMP DATA STACK SIZE IN CTX
DC.L SCHTEMP-1 TEMP POINTERS IN CTX, EXCL. T(0)
DC.L -1 MAX_STACK
DC.W -1 = NONE
DC.L 0 DEALLOC_STACK
DC.W 0 = 0
DC.L 0 NO TERM PROCEDURE
DC.L 6 SIX LOCAL POINTERS
DC.L A_TEMP+2 REF_ENV RETURNED IN TEMP-2
DC.L A_LOCAL+6 MAN_SET=LOCAL-6
DC.L A_FORMAL+1 OPEN_OBJ=FORMAL-1;
D_GEN1T EQU * TOP OF ARGUMENT LIST
NEWSCOND EQU * CREATE NEW CONDITION
* THIS CALL IS A REDIRECTION OF A CALL TO A GATE OBJECT (NEWGCOND);
* TWO FORMALS WILL ALWAYS BE PRESENT
CLR.L D0 D0:=USER_BYTES:=0;
MOVE.W #CO_SIZ-OB_SIZ,D1 D1:=KNEL_BYTES:=COND_ENV_SIZE;
MOVE.L #A_LOCAL+3,D6 D6:=ALLOC-POINTER:=LOCAL-3;
MOVE.L #A_FORMAL+1,D2 D2:=FORMAL-1;
BSR.L NEW_OPEN NEW_OPEN_OBJECT(D0/D1=SIZE,D2/D6=PT_ADDR)
MOVEQ #2,D5 D5:=FUNCTION:=DECL_CONDITION:=2;
BSR.L DECL_DIV DECL_CONDITION(D6/D7:=RESULT);
BRA.L RETURNOP RETURN(D6/D7=RESULT);
NEW_GATE EQU * CREATE NEW GATE OBJECT
* CHECK THE CALL: #FORMALS=1; VALUE DATE MAY CONTAIN A LEVEL PARAMETER
CMP.W #1,D3
BLT.L RE_ARGMIS WHEN #FORMALS < 1 GOTO ARGUMENT_MISSING(D3)
CLR.L D0 D0:=USER_BYTES:=0
MOVE.W #GA_SIZ-OB_SIZ,D1 D1:=KNEL_BYTES:=GATE_SIZE;
MOVE.L #A_LOCAL+3,D6 D6:=ALLOC_POINTER:=LOCAL-3;
MOVE.L #A_FORMAL+1,D2 D2:=FORMAL-1
BSR.L NEW_OPEN NEW_OPEN_OBJECT(D0/D1=SIZE,D2/D6=PT_ADDR);
BSR.L NEXTNUMB NEXTNUMB(D0:=NUMBER,CCR:=RESULT,A6:=!);
* WHEN FORMAT ERROR D0 <= 0, WHICH IS ACCEPTABLE FOR DECLARE_NORMAL_GATE
* BUT NOT FOR DECLARE_DEVICE_GATE .
MOVE.L D0,-(A7) PUSH LEVEL ON THE STACK;
MOVEQ #3,D5 D5:=DECL_GATE:=3;
BSR.L DECL_DIV DECL_GATE((A7)=LEVEL,D6/D7:=RESULT);
BRA.L RETURNOP RETURN (D6/D7=RESULT);
PAGE
NEW_CHAN EQU * CREATE NEW DEVICE CHANNEL
* THE CALL IS PAST ON TO THE INITIAL SCHEDULER
* CHECK THE CALL AND CALL THE INITIAL SCHEDULER.
* TWO FORMALS AND FOUR NUMBERS ARE REQUIRED.
*
CMP.W #2,D3
BLT.L RE_ARGMIS WHEN #FORMALS <2 GOTO ARGUMENT_MISSING(D3);
* A6=NEXT_VAL=TOP_VAL; A5=LOW_VAL
MOVEQ.L #0,D6
FOR.W D2=#1 TO #4 DO.S DO FOUR TIMES
* NOTE THE ORDER OF THE FOUR INTEGERS IS REVERSED BY THIS COPY LOOP
SUBQ.B #1,D6 D6:=ARG# OF NEXT VALUE;
BSR.L NEXTNUMB D0:=NEXT NUMBER PARAMETER;A6:=NEXT_VAL;
BLT.L RE_DAILL WHEN ERROR GOTO DATA_VALUE_ILLEGAL;
BEQ.L RE_VALMIS WHEN NO_NEXT GOTO VALUE_MISSING;
MOVE.L D0,(A4)+ SAVE NUMBER IN FUTURE VALUE SEGMENT
ENDF ENDDO;
LEA OCALL_1F(PC),A0
MOVE.L A0,D4 D4:=LOWARG OF OBJ_CALL ARGUMENTS
MOVE.L #OCALL_1T-OCALL_1F,D2 D2:=LENGTH OF OBJ_CALL ARGUMENTS
* :=TOPARG-LOWARG;
MOVEQ #0,D5 D5:=OBJ_CALL:=0;
TRAP #7 CALL KERNEL (D6/D7:=RESULT);
IF.B D7 <EQ> #ECRVALUE AND.B D6 <EQ> #1 THEN.S
* IF FIRST POINTER ARGUMENT ILLEGAL THEN "LOCAL-5=NIL"
MOVE.W #ECRFUNC,D7 D7:=RESULT:=REJECTED,FUNCTION ILLEGAL;
ENDI ENDI;
BRA.L RETURNOP RETURN (D6/D7=RESULT);
* ARGUMENTS FOR CALLING THE NEWICHAN FUNCTION OF THE
* INITIAL INTERRUPT SCHEDULER.
* INITSCHED.NEWICHAN(4LONGS, ÆC,F(1)Å,ÆC,F(2)Å,ÆC,L(3)Å)
OCALL_1F EQU * LOWARG:
DC.L 0,0,$10000 CALL POINTER
DC.W A_LOCAL+3 ACTUAL-3=LOCAL-3=ALLOC OBJECT
DC.L 0,0,$10000 CALL POINTER
DC.W A_FORMAL+2 ACTUAL-2=FORMAL-2=CODE SEGMENT
DC.L 0,0,$10000 CALL POINTER
DC.W A_FORMAL+1 ACTUAL-1=FORMAL-1=LINK TO DRIVER POINTER;
DC.L 16,0 VALUE_DATA:=16,FIRST BYTES
DC.W 3 MUST BE READ+WRITE
DC.L A_TEMP+1 FROM TEMP-1 (THE STACK)
DC.L -4 FUNCTION CODE=NEWICHAN=-4
DC.L A_LOCAL+5 REF_ENVELOPE OR NIL IN LOCAL-5
OCALL_1T EQU *
PAGE
NEWICHAN EQU * NEW_CHANNEL, EXECUTED IN INITIAL SCHEDULER.
* CONCURRENT CALLS ARE NOT PREVENTED
*
MOVEQ #4,D5 D5:=DECL_CHANNEL:=4;
MOVE.L #0,-(A7) PUSH ZERO ON TOP OF VALUE DATA
BSR.S DECL_DIV DECL_CHANNEL(A7)=FIVE LONG INTEGERS,
* FORMAL-1 LINKS TO DRIVER POINTER,
* FORMAL-2 MUST BE A CODE SEGMENT,
* D6/D7:=RESULT);
* STACK EXTENSION IS NOT IMPLEMENTED AT PRESENT
* TST.W D7
* BEQ.L RE_OK WHEN OK GOTO RETURN_OK;
* CMP.W #ECRNO_REC,D7 NO_RESOURCES IS NOT AN ERROR;
* BNE.L RE_SAME WHEN ERROR GOTO RETURN_SAME;
* D6 = NEEDED STACKSPACE IN BYTES (AN INTEGRAL NUMBER OF PAGES)
* MOVE.L D6,(A7) SAVE A7 ON TOP OF VALUE DATA
* MOVE.L D6,D0 D0:=USER_BYTES:=NEEDED STACK SPACE
* MOVE.W #OB_SIZ+6+SP_SIZ,D1 D1:=KNEL_BYTES:=OPEN_OBJECT+6 BYTES
* MOVE.L #A_FORMAL+3,D6 D6:=ALLOC_POINTER:=FORMAL-3;
* MOVE.L #A_TEMP+2,D2 D2:=OWNER_POINTER:=TEMP-2 *
*
* BSR.S NEW_OPEN NEW_OPEN(D0/D1=SIZE,D2/D6=PT_ADDR);
* NEW_OPEN WILL ALWAYS RETURN
* MOVEQ #4,D5 D5:=DECL_CHANNEL:=4;
* BSR.S DECL_DIV DECL_CHANNEL((A7)=FIVE LONG INTEGER,
* FORMAL-1, FORMAL-2 AS BEFORE,
* TEMP-2= ALLOCATED OBJECT,
* D6/D7:=RESULT);
* IF RESULT=OK, THE OBJECT HAS BEEN MOVED FROM TEMP-1 TO LOCAL-2 AND
* THE DRIVER POINTER HAS BEEN CREATED IN THE LOCAL POINTER OF THE
* DRIVER OBJECT (FOUND AS THE ORIGINAL ACTUAL OF FORMAL-1).
*
BRA.L RETURNOP RETURN(D6/D7=RESULT)
PAGE
DEL_EXT EQU * DELETE SUPERVISOR STACK EXTENSIONS
* THE SUPERVISOR STACK MAY GROW WHEN NEW_CHANNEL IS CALLED.
* THE INSTALLED CHANNEL IS REMOVED WHEN THE ASSOCIATED
* DRIVER POINTER IS REMOVED (DEALLOC OR DEL_ENV), BUT THE
* SIZE OF THE SUPERVISOR STACK IS NOT AFFECTED. WHEN DEL_EXT IS CALLED,
* THE SCHEDULER IS ALLOWED TO RECOMPUTE THE SIZE OF THE
* SUPERVISOR STACK. IF IT IS TO BIG (CHANNEL HAVE BEEN REMOVED),
* SOME OF THE OBJECTS USED AS STACK EXTENSIONS ARE
* DEALLOCATED BY THE CALLING PROCESS.
* THE FUNCTION CAN ONLY BE EXECUTED BY THE INITIAL
* SCHEDULER. CALL DELIEXT TO PERFORM THE FUNCTION.
*
* NOT INPLEMENTED
BRA.L RE_FUILL
DELIEXT EQU * DELETE EXTENSIONS EXECUTED IN INITIAL SCHEDULER
* DECL_DIV.DEL_EXT IS CALLED. IT RETURNS AN OBJECT REFERENCE
* TO ONE OF THE EXTENSION OBJECTS. THE INITIAL SCHEDULER DEALLOCATES
* THE OBJECT FROM THE OWNER SET (LOCAL-2). DEALLOC MAY
* BE REJECTED BY THE KERNEL (THE OBJECT IS "DANGLING". IT WILL BE
* DELETED BY THE NEXT PROCESS CALLING DEL_EXT)
*
* NOT IMPLEMENTED
BRA.L RE_FUILL
* ALTERNATIVE: DECL_DIV.DEL_EXT MAY CHECK THE STACK REQUIREMENT,
* AND RETURN AN OWNER POINTER TO THE OBJECT INSTEAD OF A
* SIMPLE REFERENCE. IN THIS WAY THE OBJECT WILL NEVER ENTER THE
* "DANGLING" STATE.
PAGE
NEW_OPEN EQU * CREATE NEW OPEN OBJECT
* CALL: RETURN:
* D0/D1 SIZE UNDEF
* D2/D6 POINTER ADDRESSES TO OWNER_POINTER/ALLOC_POINTER
* A4 FTEMP SAME
* A5/A6 ANY SAME
* OTHER ANY UNDEF
* THE OBJECT IS CREATED BY THE ALLOC OBJECT OF D6
* D2 IS THE ADDRESS, OF THE FUTURE OWNER POINTER OF THE NEW OBJECT.
* IF THE RESULT OF ALLOC.NEW_OBJ <> OK THE ACTION DEPENDS ON
* D2 (SEE RE_ALILL)
* SET UP OBJ_CALL TO ALLOC ON THE STACK.
MOVE.W D2,-(A7) PUSH OWNER POINTER ADDRESS
MOVE.L A7,D3 D3:=TOPARG OF OBJ_CALL ARGUMENTS
MOVE.L D6,-(A7) OBJECT POINTER:=ALLOC-POINTER;
MOVE.L #1,-(A7) FUNCTION_NUMBER:=1; "NEW_OBJ"
MOVE.L #A_TEMP+1,-(A7) VALUE DATA IN STACK
MOVE.W #2+1,-(A7) READ+WRITE ALLOWED
CLR.L -(A7) STARTS IN FIRST BYTE OF STACK
MOVE.L #14,-(A7) LENGTH IS 14 BYTES
MOVE.L D2,-(A7) FIRST ACTUAL:=D2;
MOVE.W #2,-(A7) CALL/RETURN:=RETURN TO ACTUAL;
CLR.L -(A7) .
CLR.L -(A7) .
MOVE.L A7,D4 D4:=LOW.ARG OF OBJ_CALL ARGUMENTS
MOVE.L D3,A7 RESTORE STACK POINTER
SUB.L D4,D3 D3:=LENGTHARG:=TOPARG-LOWARG;
* SET UP VALUE DATA IN FIRST BYTES, OF TEMP DATA STACK (-A4).
MOVE.W #6,12(A4) LENGTH OF SIZE TYPE IS 12
MOVE.L D0,6(A4) USER BYTES, "CALL VALUE"
MOVE.W D1,6+SZ_K(A4) KNEL BYTES; "CALL VALUE"
MOVE.W #4,4(A4) LENGTH OF INTEGER TYPE IS 4
* CLR.L (A4) BYTES USED IS A RETURN VALUE;
MOVE.L D3,D2 LENGTH MUST BE IN D2;
MOVEQ #0,D5 D5:=OBJ_CALL:=0;
TRAP #7 CALL KERNEL (D6/D7:=RESULT);
TST.W D7
BNE.S RE_ALILL WHEN RESULT <> OK GOTO ALLOC_ILLEGAL ((A7))
ADDQ.L #2,A7 POP OWNER POINTER ADDRESS
RTS RETURN;
PAGE
DECL_DIV EQU * DECLARE A KERNEL DEFINED OBJECT
* CALL: RETURN:
* D5 FUNCTION UNDEF
* D6/D7 ANY RESULT
* A4,A5,A6 ANY SAME
* OTHER ANY UNDEF
* THE STACK MAY CONTAIN "SPECIAL PARAMETERS", AND THE POINTERS OF THE
* CURRENT CONTEXT MAY ALSO BE PARAMETERS TO THE KERNEL
* FUNCTION INVOKED VIA OBJ_CALL BELOW
*
MOVE.L A7,D3 D3:=TOPARG OF OBJ_CALL ARGUMENTS
MOVE.L #A_LOCAL+4,-(A7) OBJECT POINTER:=LOCAL-4; "DECL_DIV_OBJ"
MOVE.L D5,-(A7) FUNCTION NUMBER:=D5
CLR.L -(A7) VALUE DATA:=VOID;
CLR.W -(A7) .
CLR.L -(A7) .
CLR.L -(A7) .
MOVE.L A7,D4 D4:=LOWARG OF OBJ_CALL ARGUMENTS
MOVE.L D3,A7 RESTORE STACK POINTER;
SUB.L D4,D3 D3:=LENGTHARG:=TOPARG-LOWARG;
MOVE.L D3,D2 LENGTH MUST BE IN D2;
MOVEQ #0,D5 D5:=OBJ_CALL:=0;
TRAP #7 CALL KERNEL (D6/D7:=RESULT);
RTS RETURN;
PAGE
NEXTNUMB EQU * GET NEXT NUMBER PARAMETER AMONG THE VALUE DATA;
* CALL: RETURN
* D0 ANY NUMBER/0/-1/
* A5 LOW_VAL (FIRST ADDRESS) SAME
* A6 NEXT_VAL (TOP ADDRESS) NEXT_VALUE (UPDATED) / UNDEFINED
* CCR <EQ>: END OF VALUEDATA, <GT>: OK, <LT>: FORMAT ERROR => A6=?
IF.L A6 <EQ> A5 THEN.S IF.NEXT_VAL=LOW_VAL THEN
CLR.L D0 D0:=0;
RTS RETURN WITH CCR = <EQ>;
ENDI ENDI;
MOVE.W -(A6),D0 D0.L:=SIZE OF NEXT VALUE
SUB.W D0,A6 A6:=NEXT_VAL:=NEXT_VAL-SIZE;
CMPA.L A6,A5 TEST A5-A6 (=LOW_VAL-NEXT_VAL)
IF <GT> THEN.S IF LOW_VAL > NEXT_VAL THEN "FORMAT ERROR"
MOVEQ #-1,D0 D0:=-1;
RTS RETURN WITH CCR = <LT>;
ENDI ENDI;
* A6 POINTS TO FIRST OF CURRENT VALUE IN CASE SIZE WAS POSITIVE
IF.W D0 <EQ> #4 THEN.S IF SIZE = 4 THEN "LONG INTEGER"
MOVE.L (A6),D0 D0:=LONG INTEGER;
ELSE.S ELSE
IF.W D0 <EQ> #2 THEN.S IF SIZE = 2 THEN "WORD INTEGER"
MOVE.W (A6),D0 D0:=WORD INTEGER
EXT.L D0 D0:=SIGN EXTEND TO LONG
ELSE.S ELSE "NOT A NUMBER"
MOVEQ #-1,D0 CCR:=<LT>; NOT A NUMBER
RTS RETURN;
ENDI ENDI;
ENDI ENDI;
CMPA.W #0,A5 CCR:=<GT>; "OK"
RTS RETURN;
PAGE
* LABELS WITH "RE_" ARE USED IN THE NORMAL "CONTEXT" -ENVIRONMENT
RE_ALILL EQU * ALLOC_ILLEGAL: "***BAD TRICK BELOW"
IF.W (A7)+ <EQ> #A_TEMP+2 THEN.S IF CALLED FROM NEWICHAN THEN
* RETURN TO NEWICHAN: DECL_DIV MUST BE
RTS CALLED, ALTHOUGH ALLOC DID NOT WORK WELL;
ENDI ENDI;
* CONTINUE IN RE_SAME BELOW
*
RE_SAME EQU * RETURN_SAME:
BRA.S RETURNOP GOTO CALL_RETURN;
*
RE_GIVEUP EQU * GIVE_UP:
MOVE.L #ECSG_UP,D7 D7:=STATUS, GIVE_UP
BRA.S RETURNOP GORO CALL_RETURN;
*
RE_FUILL EQU * FUNCTION_ILLEGAL
MOVE.L #ECRFUNC,D7 D7:=REJECTED, FUNCTION ILLEGAL
BRA.S RETURNOP GOTO CALL_RETURN;
*
RE_DAILL EQU * DATA_VALUE_ILLEGAL
MOVE.L #ECRDATA,D7 D7:=REJECTED, DATA VALUE ILLEGAL
BRA.S RETURNOP GOTO CALL_RETURN;
*
RE_VAILL EQU * POINTER_VALUE_ILLEGAL
MOVE.L #ECRVALUE,D7 D7:=REJECTED, POINTER VALUE ILLEGAL;
BRA.S RETURNOP GOTO CALL_RETURN;
*
RE_ARGMIS EQU * ARGUMENT_MISSING: D3=NO OF FORMALS
MOVEQ.L #4,D6 D6:= ARG# OF FIRST FORMAL
ADD.B D3,D6 D6:= ARG# OF FIRST MISSING FORMAL
MOVE.L #ECRARGMIS,D7 D7:=RESULT:=ARGUMENT_MISSING;
BRA.S RETURNOP GOTO CALL_RETURN;
*
RE_VAL3MIS EQU * VALUES_MISSING:
MOVEQ.L #3,D6 D6:=ARG# OF VALUE DATA SEGM;
RE_VALMIS EQU * VALUE_MISSING: D6=ARG# OF VALUE
MOVE.L #ECRVALMIS,D7 D7:=RESULT:=VALUE_MISSING;
BRA.S RETURNOP GOTO CALL_RETURN;
*
RE_OK EQU * RETURN_OK
CLR.L D7 D7:=OK:=0;
*
RETURNOP EQU * CALL_RETURN:
* CALL:
* D6/D7 RESULT
* CALL THE KERNEL TO RETURN TO CALLING CONTEXT;
MOVEQ.L #1,D5 D5:=RETURN:=1;
TRAP #7 CALL THE KERNEL;
PAGE
INT_SIGN EQU * INTERRUPT SIGNAL OPERATION
* CALL RETURN
* D2/D4 LENGTH ARG/LOW ARG UNDEF
* A4 ANY RESTORED FROM STACK
* A5 ANY RESTORED FROM STACK
* A6 ANY RESTORED FROM STACK
* D4 LOWARG ADDR UNDEF
* D6/D7 ARG#/ANY RESULT
* STACK: A4-A6,SR,PC. NO RETURN POINT ON STACK.
* OTHER REGISTERS ARE UNDEFINED AT RETURN
*
* INT_SIGN IS A KERNEL OPERATION. IT IS USED BY AN INTERRUPT
* PROCEDURE TO SIGNAL A CONDITION. A SUSPENDED RESIDENT CONTEXT
* MAY BE SCHEDULED AS A RESULT OF THIS OPERATION.
*
BSR.L CR_INCTX A2:=INT_CTX,D3:=RES_LOCK REQUIRED:=-1;
* A4:=ARGUMENT ADDRESS;
BEQ.S II_RETURN WHEN NOT OK GOTO RETURN_RESULT;
BSR.L C_ENTRES CHECK_ENTRES(A5:=ENTITY,D5:=ENT.KIND,...
BEQ.S II_RETURN WHEN NOT OK GOTO RETURN_RESULT;
IF.B D5 <NE> #PT_OBJ THEN.S IF ENTITY KIND <> OBJECT THEN
MOVE.L #ECRVALUE,D7 D7:=RESULT:=POINTER_VALUE_ILLEGAL
ELSE.S ELSE "ENTITY KIND = OBJECT"
IF.B OB_KIN(A5) <NE> #OB_COOB THEN.S IF OBJECT <> CONDITION THEN
DUMMYCOND EQU * REJECT_SIG:
MOVE.L #ECRSTATE,D7 D7:=RESULT:=OBJECT_STATE_ILLEGAL;
ELSE.S ELSE "OBJECT IS A CONDITION"
PRT_MEM INT_SIGN,(A5),CO_SIZ ********
MOVE.L A5,A1 A1:=CONDITION;
MOVE.L CO_GA(A1),A5 A5:=GATE MANAGING THE CONDITION;
MOVE.L A5,D7 TEST A5 INTO D7 "GATE=0 <=> DUMMYFIED"
BEQ.S DUMMYCOND WHEN DUMMYFIED CONDITION GOTO REJECT_SIG;
MOVE.B 12(A7),D7 D7:= SUPV BYTE OF CALLER
AND.W #7,D7 D7:=INTERRUPT_LEVEL OF CALLER "INT_PROC"
IF.B D7 <NE> GA_LEV(A5) THEN.S IF INTERRUPT_LEVEL <> GATE.LEVEL THEN
MOVE.L #ECRFUNC,D7 D7:=REJECT,FUNCTION ILLEGAL;
RTS RETURN
ELSE.S ELSE
BSR.L CONDSIGN CONDSIGN (A5=GATE,A1=COND,D7=LEVEL);
*
ENDI ENDI;
ENDI ENDI;
ENDI ENDI;
II_RETURN EQU * RETURN_RESULT:
BRA.L RET_FAST RETURN TO CALLER;
PAGE
NIOBEGIN EQU * IO_BEGIN FROM NORMAL CONTEXT
*
MOVEQ.L #-2,D3 D3:=RES_LOCK REQUIRED:=-2;
BRA.S IO_BEGIN GOTO IO_BEGIN
IIOBEGIN EQU * IO_BEGIN CALLED FROM INTERRUPT PROCEDURE
*
BSR.L CR_INCTX A2:=INT_CTX,D3:=RES_LOCK REQUIRED:=-1;
BEQ.S II_RETURN WHEN ERROR GOTO RETURN_RESULT;
* CONTINUE IN IO_BEGIN
*
RIOBEGIN EQU * IO_BEGIN CALLED FROM RESIDENT CONTEXT (D3<>0);
*
IO_BEGIN EQU * SET IO_LOCK ON POINTER AND UPDATE IO_COUNT ON SEGMENTS
* CALL RETURN TO CALLING CONTEXT.
* A1 ANY ADDRESS OF SEGMENT DATA
* A2 CUR_CTX OR INT_CTX UNDEF
* A4 ARGUMENT ADDR(PHYS) RESTORED FROM STACK
* A5 ANY RESTORED FROM STACK
* A6 ANY RESTORED FROM STACK
* D3 RESIDENT LOCK REQUIRED! LENGTH OF SEGMENT DATA
* D4 LOWARG ADDR. UNDEF
* D5 ANY USE_BITS OF SEGMENT OBJECT
* D6/D7 ARG#/ANY RESULT
* STACK: SAVED A4-A6,SR,PC
* OTHER REGISTERS ARE UNDEFINED AT RETURN;
*
* IO_BEGIN IS A KERNEL OPERATION. IT IS USED TO KEEP THE SEGMENT DATA OF
* A RESIDENT SEGMENT ON THE SAME PHYSICAL LOCATION DURING A
* DMA-TRANSPORT TO/FROM THE SEGMENT.
* D3 WILL ALWAYS BE NON ZERO (RESIDENT LOCK IS REQUIRED)
*
*
*
*
BSR.S PTANDSEG CHK_POINTER_&_SEGM(A6:=PT,A5:=STRUCT,...
IF <NE> THEN.S
BSET.B #PT_IO,PT_INF(A6) POINTER.IO_LOCK:=ON;
IF <EQ> THEN.S IF LOCK WAS OFF THEN "ADJUST IO_COUNT"
ADDQ.W #1,ST_IO(A5) CTX/ENV.IO_COUNT:=...+1;
MOVEQ #1,D0 D0:=INCREASE:=+1;
MOVE.W #SE_IO,D1 D1:=IO_COUNT;
BSR.L INCRDECR INCREASE(D0/D1/A6=!,A6/A3:=?);
ENDI ENDI;
CLR.L D7 RESULT:=OK;
ENDI ENDI;
BRA.L RET_FAST RETURN TO CALLER
PAGE
NIO_END EQU * IO_END CALLED FROM NORMAL CONTEXT
*
MOVEQ.L #-2,D3 D3:=RES_LOCK REQUIRED:=-2;
BRA.S IO_END GOTO IO_END;
IIO_END EQU * IO_END CALLED FROM INTERRUPT PROCEDURE
*
BSR.L CR_INCTX A2:=INT_CTX,D3:=RES_LOCK REQUIRED:=-1;
BEQ.S II_RETURN WHEN ERROR GOTO RETURN_RESULT;
* CONTINUE IN IO_END
RIO_END EQU * IO_END CALLED FROM RESIDENT CONTEXT (D3<>0);
*
IO_END EQU * RESET IO_LOCK ON POINTER AND ADJUST IO_COUNT ON SEGMENTS
*
* CALL AND RETURN AS FOR IO_BEGIN
* IO_END IS A KERNEL OPERATION
* IT SIGNALS THE END OF A DMA-TRANSPORT.
*
BSR.S PTANDSEG CHK_POINTER_&_SEG(A6:=PT,A5:=STRUCT,...
IF <NE> THEN.S IF OK THEN
BCLR.B #PT_IO,PT_INF(A6) POINTER.IO_LOCK:=OFF
IF <NE> THEN.S IF LOCK WAS ON THEN "ADJUST IO_COUNT"
SUBQ.W #1,ST_IO(A5) CTX/ENV.IO_COUNT:=...-1;
MOVEQ #-1,D0 D0:=DECREASE:=-1;
MOVE.W #SE_IO,D1 D1:=IO_COUNT;
BSR.L INCRDECR DECREASE(D0/D1/A6=!,A6/A3:=?);
ENDI ENDI;
CLR.L D7 RESULT:=OK;
ENDI ENDI;
BRA.L RET_FAST RETURN TO CALLER;
PAGE
IABSADDR EQU * ABS_ADDR CALLED FROM INTERRUPT PROCEDURE
BSR.S CR_INCTX A2:= INT_CTX, D3:=RES_LOCK REQUIRED:=-1;
BEQ.S II_RETURN WHEN ERROR GOTO RETURN_RESULT;
*
NABSADDR EQU * ABS_ADDR CALLED FROM NORMAL CONTEXT (D3=0)
*
RABSADDR EQU * ABS_ADDR CALLED FROM RESIDENT CONTEXT (D3<>0)
*
ABS_ADDR EQU * GET PHYSICAL ADDRESS OF RESIDENT SEGMENT;
*
* CALL AND RETURN AS FOR IO_BEGIN
* ABS_ADDR IS A KERNEL OPERATION
* ABS_ADDR IS USED BY THE INTERRUPT PROCEDURES, TO GET THE PHYSICAL
* ADDRESS OF SEGMENT DATA. THE ADDRESS MAY CHANGE BETWEEN
* TWO "CALLS" TO THE INTERRUPT PROCEDURE; BUT IS CONSTANT
* WHILE THE INTERRUPT PROCEDURE IS RUNNING, BECAUSE THE SEGMENT IS RESIDENT.
BSR.S PTANDSEG CHECK POINTER AND SEGMENT (......
IF <NE> THEN.S IF OK THEN
CLR.L D7 RESULT:=OK
ENDI ENDI
BRA.L RET_FAST RETURN TO CALLER;
*
* NOTE: THE FUNCTION MAY BE CALLED FROM A CONTEXT, BUT THE
* ADDRESS RETURNED MAY CHANGE WITHOUT NOTICE.
PAGE
PTANDSEG EQU * CHECK POINTER AND SEGMENT
* CALL: RETURN:
* A1 ANY SEGMENT DATA
* A2 CUR_CTX OR INT_CTX SAME
* A3 ANY SEGMENT OBJECT
* A4 ARGUMENT ADDRESS SAME (UPDATED ONCE)
* A5 ANY POINTER STRUCTURE (CTX/ENV)
* A6 ANY POINTER TO SEGMENT OBJECT
* D1/D2 ANY POINTER REL/POINTER KIND
* D3 RESIDENT LOCK REQUIRED? LENGTH OF SEGMENT DATA
* D4/D5 ANY UNDEF/USE-BITS OF SEGMENT OBJECT
* D6/D7 ARG#/ANY RESULT WHEN CCR = <EQ>
* CCR <EQ>: NOT OK; <NE>: OK
* A2 MUST CONTAIN CUR_CTX OR INT_CTX. C_ENTRES IS USED TO CHECK THE POINTER ARG
* D3 <> 0: RESIDENT LOCK MUST BE "ON" IN THE POINTER
* A CALL TO C_SEGM IS MADE TO CHECK THAT A SEGMENT IS "POINTED".
*
BSR.L C_ENTRES CHK_ENTRES(A6:=PT,D5:=ENTITY_KIND,
* A1:=PT_STRUCT,A5=ENTITY,...
IF <NE> THEN.S IF OK THEN
MOVE.L A5,A3 A3:= ENTITY; HOPEFULLY AN OBJECT;
MOVEA.L A1,A5 A5:= POINTER STRUCTURE;
CMP.B #PT_OBJ,D5 TEST ENTITY KIND;
BEQ.S C_SEGMPS WHEN ENTITY IS AN OBJECT GOTO CHK_SEGM;
ENDI ENDI;
RTS RETURN WITH CCR=<EQ>:NOT_OK;
C_SEGM EQU * CHECK THAT THE ARGUMENT IS A SEGMENT OBJECT
* CALL: RETURN:
* A1/A3 ANY SEGMENT DATA/SEGMENT OBJECT
* A6 POINTER (MUST BE SIMPLE) SAME
* D2 POINTER KIND SAME
* D3 ANY LENGTH OF SEGMENT DATA
* D5 ANY USE BITS OF SEGMENT OBJECT
* D6/D7 ARG#/UNDEF RESULT WHEN CCR = <EQ>
* CCR <EQ>: NOT OK; <NE>: OK
* ATTRIBUTES OF THE SEGMENT OBJECT IS RETURNED IN A1,D3 AND D5
*
IF.B D2 <EQ> #PT_OBJ THEN.S IF POINTER_KIND=REF_OBJ THEN
MOVE.L PT_REF(A6),A3 A3:=SEGMENT OBJECT
C_SEGMPS EQU * ENTRY FROM PTANDSEGM.
IF.B OB_KIN(A3) <EQ> #OB_SEOB THEN.S IF OBJECT.KIND=SEGMENT THEN
MOVE.L SE_FIR(A3),A1 A1:=ADDRESS OF SEGMENT DATA
MOVE.L SE_LEN(A3),D3 D3:=LENGTH OF SEGMENT DATA;
MOVE.B OB_STA(A3),D5 D5:=USE BITS (B0=R,B1=W,B2=E)
LSR.B #OB_READ,D5 :=OBJECT.STATE>>OB_READ;
IF <NE> THEN.S IF USE_BITS <> 0 THEN
RTS RETURN; CCR=<NE>:OK;
ENDI ENDI;
MOVE.L #ECRCAP,D7 D7:= CAPABILITY VIOLATION; "NO USE BITS"
ELSE.S ELSE "NOT A SEGMENT OBJECT"
MOVE.L #ECRSTATE,D7 D7:=RESULT:=OBJECT_STATE ILLEGAL
ENDI ENDI
ELSE.S ELSE
MOVE.L #ECRVALUE,D7 D7:=RESULT:=POINTER_VALUE ILLEGAL
ENDI ENDI
CMP.W D0,D0 CCR:=<EQ>;
RTS RETURN; "NOT OK"
PAGE
CR_INCTX EQU * CREATE INTERRUPT CONTEXT
* CALL: RETURN
* A1 ANY UNDEF
* A2 ANY INTERRUPT CONTEXT
* A4 ANY ARG ADDRESS
* D2 LENGTH ARGUMENT SAME
* D3 ANY -1 <=> RESIDENT LOCKS REQUIRED
* D4 LOWARG SAME
* D6/D7 ARG#/ANY RESULT WHEN CCR = <EQ>
* CCR <EQ>: NOT OK; <NE>: OK
* AT RETURN A2 CONTAINS THE ADDRESS OF A "CONTEXT". IT HAS NO
* FORMAL OR TEMP POINTERS, BUT "THE LOCAL POINTERS OF THE CONTEXT"
* ARE THE LOCAL POINTERS OF THE DRIVER.
* THE DRIVER ENVELOPE HOLDING THE LOCAL POINTERS IS DETERMINED
* FROM THE CHANNEL ARGUMENT IN THE CALL TO THE KERNEL OPERATION.
* ARG ADDRESS IS COMPUTED. NO ADDRESS CONVERSION IS NEEDED BECAUSE
* THE CALLING INTERRUPT PROCEDURE RUNS IN SUPERVISOR MODE (NO MMU INVOLVED)
*
MOVE.L D4,A4 A4:= ARGUMENT ADDRESS:= LOWARG
ADDA.L D2,A4 + LENGTH ARG;
LEA -AR_PTSIZ-1(A4),A1 A1:=ADDRESS OF CHANNEL ARGUMENT;
IF.L D4 <LE> A1 THEN.S IF CHANNEL ARG PRESENT THEN
CLR.W D3
MOVE.B (A1),D3 D3:=CHANNEL#; "0..255"
LSL.W #2,D3 D3:=CHANNEL INDEX:=CHANNEL# *4;
LEA DRIV_TAB,A1 A1:=DRIVER_TABLE;
LEA INT_CTX,A2 A2:=INTERRUPT_CONTEXT;
MOVE.L (A1,D3.W),(A2) CONTEXT.ENVELOPE:=DRIVER_TABLE(CHANNEL);
PRT_MEM CR_INCTX,(A2),ST_SIZ+2 ********
IF <NE> THEN.S IF ENVELOPE IS DEFINED THEN
MOVEQ #-1,D3 D3:=RES_LOCK REQUIRED:=-1;
RTS RETURN; CCR = <NE>:OK;
ENDI ENDI;
ENDI ENDI;
MOVE.L #ECRDATA,D7 D7:= CHANNEL# ILLEGAL
MOVEQ.L #2,D6 D6:= ARG# OF CHANNEL#:=2;
CMP.W D0,D0 CCR:=<EQ>:NOT_OK;
RTS RETURN;
PAGE
GATE_OBJ EQU * CALLABLE GATE OBJECT FUNCTIONS
*
* GATE_OBJ IS A "CASE-BLOCK" OF PROCEDURE C_CALL; IT IS ENTERED
* WHEN A GATE OBJECT IS CALLED VIA OBJ_CALL
* OPEN/LOCK/RESBEGIN NEW_COND
* CALL RETURN RETURN;
* D3 RESIDENT CALLER UNDEF UNDEF
* D4 LOW_ARG UNDEF SCHEDULER LOW_ARG
* D5 FUNCTION UNDEF NEWSCOND = -3
* D6/D7 ARG#/ANY ARG#/RESULT ARG#/UNDEF
* A0/A2 EXTENSION/CUR_CTX SAME SAME
* A1 ANY, USED FOR PROC ADDR. UNDEF UNDEF
* A4 ARG UNDEF SCHEDULER ARG
* A5 GATE UNDEF SCHEDULER OBJ
* A3/A6 ANY UNDEF UNDEF
* CCR ANY <EQ>:RETURN <NE>:CALL,EXCEPT WHEN
* STACK: RETURN_PC,A4,A5,A6,SR,PC SR MAY BE MODIFIED ERR.
* THE FOLLOWING FUNCTIONS APPEAR:
* 1: LOCK
* 2: OPEN
* 3: NEW_COND (ÆR,CONDÅ)
* 4: RESBEGIN (USE,Æ?,SIMPELÅ); "SIMPEL POINTER TO ENV OR OBJECT"
PRT_MEM GATE_OBJ,(A5),GA_SIZ ********
LSL.W #1,D5 D5:=FUNC:=FUNCTION *2;
CMP.W #8,D5 TEST FUNCTION
BGT.L ER_FUILL WHEN FUNCTION >4 GOTO FUNCTION_ILLEGAL;
MOVE.L KV_PROC,A1 A1:= CURRENT PROCESS;
PRT_MEM PROCESS,(A1),PR_SIZ ********
MOVE.B GA_LEV(A5),D7 D7:=LEVEL:=GATE.LEVEL;
IF <EQ> THEN.S IF LEVEL = 0 THEN "NORMAL GATE"
TST.W D3 TEST RESIDENT_CALLER;
BNE.L ER_FUILL WHEN RESIDENT CALLER THEN GOTO FUNCTION_ILLE
CASEJMP D5 GOTO CASE D5=FUNC(:=SPOILED) OF
CASELAB CASE_ERR 0<<1: NOT POSSIBLE;
CASELAB GATELOCK 1<<1: GATELOCK;
CASELAB GATEOPEN 2<<1: GATEOPEN;
CASELAB NEWGCOND 3<<1: NEWGCOND;
CASELAB ER_FUILL 4<<1: FUNCTION_ILLEGAL;
ENDI ENDI;
IF.W D5 <NE> #2*2 THEN.S IF FUNCTION <> DEVICE_OPEN THEN
TST.W D3 TEST RESIDENT_CALLER;
BNE.L ER_FUILL WHEN RESIDENT CALLER GOTO FUNCTION ILLEGAL;
ELSE.S ELSE "FUNCTION=DEVICE_OPEN"
TST.W D3 TEST RESIDENT_CALLER;
BEQ.L ER_FUILL WHEN NOT RESIDENT GOTO FUNCTION ILLEGAL;
BSR.L CHECKLEV IS A CORRECT "LEVELED" GATE OPENED ?
IF <EQ> THEN.S IF WRONG LEVEL THEN
RTS RETURN;
ENDI ENDI;
ENDI ENDI;
CASEJMP D5 GOTO CASE D5=FUNC(:=SPOILED) OF
CASELAB CASE_ERR 0<<1: NOT POSSIBLE
CASELAB DEVILOCK 1<<1: DEVILOCK
CASELAB DEVIOPEN 2<<1: DEVIOPEN
CASELAB NEWGCOND 3<<1: NEWGCOND
CASELAB RESBEGIN 4<<1: RESBEGIN
PAGE
GATELOCK EQU * LOCK NORMAL GATE
BSR.L SPEEDCHK IF SPEEDUP PROPAGATES INTO GATE
BNE.L ER_RTS THEN GOTO RETURN;
TAS.B GA_STA(A5) TEST FOR OPEN, AND LOCK GATE;
IF <PL> THEN.S IF GATE WAS OPEN THEN
CLR.L D7 D7:=RESULT:=OK; CCR:=RETURN:=<EQ>;
RTS RETURN;
ENDI ENDI;
LEA GA_LOK(A5),A3 A3:=LOCK_QUEUE OF GATE
REM_ELEM PR_AUX(A1),A5,A6,A5/A6 REMOVE CURRENT PROC FROM RUNNING QUEUE;
INIT_HEAD PR_AUX(A1),A6 .
MOVE.B #6,PR_STA(A1) PROC.STATE:= LOCK;
CLR.W PR_SYN(A1) PROC.SYNC_RESULT:= OK;
LEA PR_MAIN(A1),A1 A1:= PROC.MAIN;
REM_ELEM (A1),A5,A6,A5/A6 REMOVE CURRENT PROC FROM TIMER QUEUE;
INS_ELEM A3,A1,A6,A3/A6 INSERT PROC IN LOCK_QUEUE OF GATE;
BRA.L SYNCSTOP GOTO STOP AND WAIT FOR OPEN GATE;
* RETURN DIRECTLY TO CALLER WHEN PROC IS RESUMED
DEVILOCK EQU * LOCK DEVICE GATE
BSR.L SPEEDCHK IF SPEEDUP PROPAGATES INTO GATE
BNE.L ER_RTS THEN GOTO RETURN;
REM_ELEM PR_AUX(A1),A3,A6,A3/A6 REMOVE CALLING PROC FROM RUNNING QUEUE;
INIT_HEAD PR_AUX(A1),A6 .
BTST.B #5,16(A7) TEST SUPERVISOR BIT IN SR OF CALLING PROC
IF <NE> THEN.S IF SUPV_BIT ON THEN "CLEAR STOP_RUN REQUEST
MOVE.L SAVE_PC,18(A7) RESTORE PC;
MOVE.W SAVE_SR,16(A7) RESTORE SR;
ENDI ENDI;
OR.B D7,16(A7) STACK(SR).INT_MASK:= GATE_LEVEL;
MOVEQ #1,D0 D0:=INCREASE;
BSR.L SETRESET SETRESET(A2:=CTX,D1/D5/A3/A6:=UNDEF)
LSL.B #4,D7 D7:=PRIO:=LEVEL<<4 +1;
ADDQ #1,D7
LEA PR_MAIN(A1),A1 A1:=PROC.MAIN;
REM_ELEM (A1),A3,A6,A3/A6 REMOVE PROC FROM TIMER QUEUE;
BSR.L QDRIV QUEUE TO DRIVING(D7,A1,A3/A6:=?)
* PROC.STATE REMAINS UNCHANGED (=RUN=0).
* PROCS WITH HIGHER LEVELS MAY BE WAITING (TIMED OUT) IN DRIVING QUEUE.
MOVEQ #0,D7 D7:=RESULT:=OK; CCR:=RETURN := <EQ>;
RTS RETURN;
SPEEDCHK EQU *
* CALL: RETURN:
* A2 CUR_CTX SAME
* D5 - UNDEF
* D7 - RESULT OR SAME
* CCR - <NE>: SPEEDUP PRESENT, <EQ>: NO SPEEDUP
*
MOVE.B CT_SPE(A2),D5
AND.B CT_MODE(A2),D5 D5:=MINIMUM(SPEEDUP_SATE,PROP_MODE);
IF <NE> THEN.S IF SPEEDUP PRESENT THEN
MOVE.L #ECRSPEED,D7 D7:= RESULT:= SPEEDED UP; CCR:=<NE>;
ENDI ENDI;
RTS RETURN;
PAGE
GATEOPEN EQU * OPEN NORMAL GATE
* CALLED ALSO FROM COND.WAIT
* A5=GATE, A1/A3/A4/A6:=?, D7:=RESULT, CCR=<EQ>:NOT_OK OR CCR=<NE>:OK
* SELECT A WAITING PROCESS OR OPEN THE GATE
* PROCESS SELECTION FOLLOWS THE RULE SHOWN BELOW
LEA GA_RELOK(A5),A3 A3:=RELOCKING QUEUE OF GATE OBJECT;
MOVE.L (A3),A1 A1:=MAIN_QUEUE OF FIRST RELOCKING PROCESS;
IF.L A1 <EQ> A3 THEN.S IF NO RELOCKING PROCESSES THEN
LEA GA_SPLOK(A5),A3 A3:=SPEED RELOCKING QUEUE OF GATE OBJECT;
MOVE.L (A3),A1 A1:=MAIN_QUEUE OF FIRST SPEED RELOCKING;
IF.L A1 <EQ> A3 THEN.S IF NO SPEED RELOCKING PROCESSES THEN
LEA GA_LOK(A5),A3 A3:=LOCKING QUEUE OF GATE OBJECT
MOVE.L (A3),A1 A1:=MAIN_QUEUE OF FIRST LOCKING PROCESS;
IF.L A1 <EQ> A3 THEN.S IF NO LOCKING PROCESSES THEN "OPEN THE GATE"
CLR.B GA_STA(A5) GATE.STATE:=OPEN;
CLR.L D7 D7:=RESULT:=OK;CCR:=RETURN:=<EQ>;
RTS RETURN;
ENDI ENDI;
ELSE.S ELSE "SPEED RELOCKING WAS PRESENT"
REM_ELEM PR_AUX-PR_MAIN(A1),A4,A6,A4/A6 REMOVE PROC.AUX FROM COND QUEUE;
ENDI ENDI;
ENDI ENDI;
* A1 = MAIN QUEUE OF SELECTED PROCESS;
REM_ELEM (A1),A4,A6,A4/A6 REMOVE PROC FROM THE GATE QUEUE;
MOVE.L A1,(A1)
MOVE.L A1,4(A1) MAIN_QUEUE OF PROCESS:=EMPTY;
LEA PR_AUX-PR_MAIN(A1),A3 A3:=AUX_QUEUE OF PROCESS;
LEA RUNNING,A1 A1:=RUNNING QUEUE;
INS_ELEM A1,A3,A6,A1/A6 INSERT PROC IN RUNNING QUEUE;
CLR.B PR_STA-PR_AUX(A3) PROC.STATE:=RUN:=0;
PRT_MEM GATEOPEN,-PR_AUX(A3),PR_SIZ ********
CLR.L D7 D7:=RESULT:=OK; CCR:=RETURN:=<EQ>;
RTS RETURN;
PAGE
FORCE_OPEN EQU * OPEN UNKNOWN DEVICE GATE
* A2=CURRENT CONTEXT, RETURNS THROUGH SYNCSTOP(A0/A1/A2/A3/D7:=!).
* STACK MUST CONTAIN (RETURN_PC,A4,A5,A6,SR,PC) WHEN THE CALL IS MADE.
* FORCE_OPEN IS CALLED WHEN RETURN IS EXECUTED BY A RESIDENT CONTEXT.
* CHECKLEV CANNOT BE CALLED BECAUSE THE GATE IS UNKNOWN.
*
MOVE.L KV_PROC,A1 A1:= CURRENT PROCESS;
PRT_MEM FORCE_OPEN,(A1),PR_SIZ ********
* CONTINUE IN DEVIOPEN BELOW
DEVIOPEN EQU * OPEN DEVICEGATE
* THE GATE OBJECT IS NOT SEARCHED FOR WAITING PROCESSES. THESE
* PROCESSES WILL ALREADY BE PRESENT IN THE DRIVING QUEUE
* NEXT TO CALLING PROCESS. (GA_STA OF THE DECIVE GATE IS NOT USED).
* CALLING PROCESS IS MOVED FROM THE DRIVING QUEUE TO THE
* RUNNING QUEUE;
*
MOVEQ #-1,D0 D0:=DECREASE;
BSR.L SETRESET SETRESET(A2=CTX,D1/D5/A3/A6:=UNDEF)
LEA PR_MAIN(A1),A1 A1:= PROC.MAIN;
REM_ELEM (A1),A3,A6,A3/A6 REMOVE PROC.MAIN FROM DRIVING;
MOVE.L A1,(A1) PROC.MAIN
MOVE.L A1,4(A1) :=EMPTY;
LEA PR_AUX-PR_MAIN(A1),A1 A1:=PROC.AUX;
LEA RUNNING,A3 A3:=RUNNING QUEUE;
INS_ELEM A3,A1,A6,A3/A6 INSERT PROC.AUX IN RUNNING QUEUE;
CLR.B PR_PRI-PR_AUX(A1) PROC.PRIO:=0;
LEA -PR_AUX(A1),A1 A1:=PROCESS
ANDI.B #$F8,16(A7) STACK(SR).INT_MASK:=0;
CLR.W PR_SYN(A1) PROC.SYNC_RESULT:=OK:=0;
BRA.L SYNCSTOP STOP PROC AND RUN DRIVING PROCS
* RETURN IS MADE DIRECTLY TO THE CALLER
PAGE
NEWGCOND EQU * CREATE NEW CONDITION OBJECT
* A NEW CONDITION MANAGED BY THE CALLED GATE OBJECT
* SHOULD BE CREATED. THE CALL IS REDIRECTED TO THE SCHEDULER
* THAT CREATED THE GATE OBJECT. THE SCHEDULER WILL CREATE
* THE CONDITION.
MOVEQ.L #4,D6 D6:=ARG# OF 1. ACTUAL;
LEA -ACT_SIZ<<1(A4),A1 TEST #REMAINING ARGUMENTS > = 2;
CMPA.L D4,A1 TEST (ARG-(2*ACT_SIZ)-LOWARG;
BLT.L ER_ARGMIS WHEN REMAIN < 2 GOTO ARGUMENT_MISSING;
MOVEQ.L #2,D6 D6:=ARG# OF FUNCTION; EXPECTED BY OBJCALL
LEA SCHD_ARG,A3 A3:=ADDRESS OF ACTUALS; (GLOBAL KNEL_VAR)
MOVE.L -(A4),-(A3) COPY VALUE DATA ARGUMENT
MOVE.L -(A4),-(A3) AND THE FIRST ACTUAL ARGUMENT.
MOVE.L -(A4),-(A3) .
MOVE.L -(A4),-(A3) .
MOVE.L -(A4),-(A3) .
MOVE.L -(A4),-(A3) .
MOVE.L -(A4),-(A3) .
LEA 4+ACT_SIZ+ACT_SIZ(A4),A4 A4:=POINTER ARGUMENT POINTING TO GATE
MOVE.L (A4),-(A3) COPY POINTER ADDRESS TO ACTUAL -2
MOVE.W #1,-(A3) CALL/RETURN:=CALL
CLR.L -(A3) THE SECOND ACTUAL IS
CLR.L -(A3) A POINTER ACTUAL;
LEA SCHD_ARG,A4 A4:=NEW ARGUMENT LIST;
PRT_MEM NEWGCOND,-3*ACT_SIZ(A4),3*ACT_SIZ ********
MOVE.L A3,D4 ADJUST LOWARG;
TST.W GA_SCH+PT_KIN(A5) TEST KIND OF POINTER TO SCHEDULER
BEQ.L ER_DUMMY WHEN NIL_POINTER GOTO UNDEF, DUMMYFIED;
MOVE.L GA_SCH+CH_HOLD(A5),A5 A5:=ADDRESS OF SCHEDULER OBJECT;
MOVEQ.L #-3,D5 D5:=FUNCTION:=NEWSCOND:=-3;CCR:=<NE>;
RTS RETURN; DO CALL SCHEDULER
* NOTE THAT A GATE IS NOT DUMMYFIED BECAUSE ITS SCHEDULER IS DELETED
* NOTE ALSO THAT THE POINTER ARGUMENT THAT ADRESSES THE GATE OBJECT IS READ
* TWICE. FIRST IN PROC OBJ_CALL, AND NOW IN THE PROC ABOVE. THE KERNAL MUST
* NOT ENABLE INTERRUPTS IN BETWEEN, BECAUSE PROCESSES SCHEDULED THROUGH
* INTERRUPTS COULD MODIFY THE POINTER ARGUMENT. IT MAY STILL BE MODIFIED
* THROUGH A DMA-CHANNEL, AND THIS WILL CREATE A PROBLEM TO THE USER IF THE
* MODIFIED ARGUMENT ADDRESSES A POINTER TO ANOTHER GATE.
PAGE
RESBEGIN EQU * SET RESIDENT LOCK ON, AND UPDATE RESIDENT COUNTS
* VALUE DATA SPECIFIES "REQUIRED USE BITS". FIRST ACTUAL IS A
* SIMPLE POINTER TO A SEGMENT OBJECT. USE BITS OF THE SEGMENT MUST
* INCLUDE "REQUIRED USE BITS".
MOVEQ.L #4,D6 D6:=ARG# OF 1. ACTUAL;
LEA -ACT_SIZ<<1(A4),A1 TEST #REMAINING ARGUMENTS >=2;
CMPA.L D4,A1 TEST (ARG-(2*ACT_SIZE)) -LOW_ARG;
BLT.L ER_ARGMIS WHEN REMAIN < 2 GOTO ARGUMENT_MISSING;
TST.W -2(A4) TEST FOR VOID VALUE DATA
IF <EQ> THEN.S IF VOID VALUE DATA THEN
CLR.L D0 D0:=REQUIRED:=NO_BITS:=0;
LEA -ACT_SIZ(A4),A4 A4:=NEXT ARGUMENT
ELSE.S ELSE
MOVEQ.L #2,D6 D6:= ARG#;
BSR.L C_SUB CHECK_SUB(A5:=BSEG,D5:=FREL,D2:=LENGTH,..
IF <EQ> THEN.S IF NOT_OK THEN
RTS RETURN;
ENDI ENDI;
* SHOULD USE-BITS BE CHECKED ???
MOVE.L SE_FIR(A5),A5 A5:=FIRST OF BASE SEGMENT DATA
ADDA.L D5,A5 A5:=FIRST VALUE:=FIRST DATA + FREL;
MOVE.W A5,D5 BIT0 OF D5 := ODD VALUE SEGM:=
OR.B D2,D5 (BIT0 OF FIRST) OR (BIT0 OF LENGTH);
BTST.L #0,D5
BNE.L ER_ADILL WHEN ODD VALUE SEGM GOTO ADDRESS ILLEGAL
LEA (A5,D2.L),A6 A6:=TOP_VALUE:=FIRST_VALUE+LENGTH;
MOVEQ.L #0,D6 D6:= ARG# OF
SUBQ.B #1,D6 FIRST VALUE;
BSR.L NEXTNUMB NEXTNUMB(A5/A6=!,D0:=32 BITS INTEGER);
BLE.L ER_DAILL WHEN ERROR GOTO DATA_VALUE_ILLEGAL;
ENDI ENDI;
MOVEQ.L #4,D6 D6:=ARG# OF 1. ACTUAL;
PAGE
* D0 = REQUIRED USE-BITS, A4 = NEXT ARGUMENT, A5=UNDEF, D6=ARG#
BSR.L C_PT CHECK_POINTER(A6:=PT,D2:=PT_KIND,...
IF <EQ> THEN.S IF NOT OK THEN
RTS RETURN;
ENDI ENDI;
IF.B D2 <EQ> #PT_OBJ THEN.S IF POINTER = REF_OBJ THEN
MOVE.W #OB_RES,D1 D1:=ADDR:=RESIDENT COUNT OF OBJECT
BSR.L C_SEGM CHECK_SEGM(A1:=DATA,A3:=OBJECT,D5:=USE,..
IF <NE> THEN.S IF OBJ = SEGMENT THEN.S
AND.B D0,D5 D5:=REQUIRED AND USE
IF.B D0 <EQ> D5 THEN.S IF REQUIRED BITS WERE PRESENT IN USE THEN
BSET.B #PT_RES,PT_INF(A6) POINTER.RESIDENT_LOCK:=ON;
IF <EQ> THEN.S IF LOCK WAS OFF THEN
MOVEQ. #1,D0 D0:=INCRESES:=+1;
BSR.S INCRDECR INCREASE RESIDENT COUNT OF SEGM OBJECTS
ENDI ENDI;
CLR.L D7 D7:=RESULT:=OK; CCR:=<EQ>;
RTS RETURN;
ENDI ENDI; "USE-BITS WAS OK"
BRA.L ER_CAILL GOTO CAPABILITY_VIOLATION;
ENDI ENDI; "OBJ = SEGMENT"
ELSE.S ELSE "POINTER <> REF_OBJ"
CMP.B #PT_ENV,D2 TEST POINTER KIND
BNE.L ER_VAILL WHEN POINTER <> REF_ENV GOTO
* POINTER_VALUE_ILLEGAL;
MOVE.L PT_REF(A6),A3 A3:=ENVELOPE
MOVE.W #EN_RES,D1 D1:=ADDR:=RESIDENT COUNT OF ENVELOPE;
ENDI ENDI;
* A6=POINTER, A3=ENTITY (NON_SEGM_OBJ OR ENV), D1=ADDR OF RES_COUNT IN ENTITY.
BSET.B #PT_RES,PT_INF(A6) POINTER.RESIDENT_LOCK:=ON;
IF <EQ> THEN.S IF LOCK WAS OFF THEN
ADDQ.W #1,(A3,D1.W) ENTITY.RES_COUNT:=...+1;
PRT_MEM RESBEGIN,(A3),ST_SIZ ********
ENDI ENDI;
CLR.L D7 D7:=RESULT:=OK; CCR:=<EQ>;
RTS RETURN;
PAGE
SETRESET EQU * ADJUST RESIDENT COUNTS FOR RESIDENT CONTEXT
* CALL RETURN
* A2 CTX (TOP_CTX OF DRIVING PROC) SAME
* D0 +1(INCREASE) OR -1(DECREASE) SAME
* D1/D5/A3/A6 UNDEF
* 1 IN/DECREASE RESIDENT COUNT OF THE CONTEXT (FROM ZERO TO ONE)
* 2 IN/DECREASE RESIDENT COUNT OF PRIMARY ENVELOPE OF CURRENT OBJECT
* 3 IN/DECREASE RESIDENT COUNT OF SEGMENTS MAPPED IN THE MMUS OF CTX
*
ADD.W D0,CT_RES(A2) CTX.RES_COUNT:=...+/-1;
MOVE.L CT_OBJ(A2),D1 D1:=CUR_OBJ:=CTX.CT_OBJ;
IF <NE> THEN.S IF CTX NOT ABORTED THEN
MOVE.L D1,A3 A3:=CUR_OBJ;
MOVE.L OB_SPA(A3),A3 A3:=TOP_OBJ;
MOVE.L SP_ENV+4(A3),A3 A3:=PRIM_ENV OF OBJECT;
ADD.W D0,EN_RES(A3) ENV.RES_COUNT:=...+/-1;
ENDI ENDI;
MOVE.W #OB_RES,D1 D1:=COUNT ADDRESS:=OB_RES;
FOR.W D5=#CT_MM0 TO #CT_MM3 BY #MM_SIZ DO.S FOR ALL MMU_DESCR DO
LEA (A2,D5.W),A6 A6:=MMU-POINTER; PT_REF(A6)=0 OR SEGM;
BSR.S INCRDECR INCRDECR (D0=+1/-1,D1=OB_RES,A6=MMU,.
ENDF ENDF;
RTS RETURN;
INCRDECR EQU * INCREASE OR DECREASE COUNT IN SEGMENT OBJECTS
* CALL: RETURN:
* D0.W +1(INCREASE) OR -1 (DECREASE) SAME
* D1.W OB_RES OR SE_IO SAME
* A3 ANY UNDEF
* A6 POINTER UNDEF
* PT_REF(A6) MUST BE ZERO OR POINT TO A SEGMENT OBJECT;
*
REPEAT REPEAT
MOVE.L PT_REF(A6),A3 A3:=SEGMENT OBJECT
CMP.W #0,A3 TEST A3.L=0
IF <EQ> THEN.S IF NO SEGMENT OBJECT THEN
RTS RETURN; "ROOT SEGM NOT REACHED"
ENDI ENDI;
ADD.W D0,(A3,D1.W) INCREASE/DECREASE COUNT
IF <EQ> THEN.S IF COUNT DECREASED TO ZERO THEN
IF.W D1 <EQ> #SE_IO THEN.S IF IO_COUNT DECREASED TO ZERO THEN
MOVEM.L A1/A4/A5,-(A7) SAVE REGISTERS;
LEA SE_WAIT(A3),A1 A1:=WAIT QUEUE OF SEGMENT
REPEAT REPEAT
BSR.L KNELSIGN SIGNAL THE FIRST WAITING PROC
UNTIL <NE> UNTIL NO MORE WAITING PROCS
MOVEM.L (A7)+,A1/A4/A5 RESTORE REGISTERS;
ENDI ENDI;
ENDI ENDI;
PRT_MEM INCRDECR,(A3),SU_SIZ ********
LEA SU_P(A3),A6 A6:=POINTER TO NEXT SEGMENT
BTST.B #OB_SUB,OB_STA(A3) TEST SEGMENT KIND;
UNTIL <EQ> UNTIL SEGMENT.KIND = ROOT SEGM;
RTS RETURN;
PAGE
QDRIV EQU * QUEUE PROC IN THE DRIVING QUEUE
* CALL RETURN:
* A1 MAIN QUEUE OF PROC SAME
* D7 PRIO OF PROC SAME
* A3/A6 ANY UNDEF
* PRIO=LEVEL<<4 + 1/0 1:RELOCKING(SIGNALED)/0:OTHER
* THE PROC IS PLACED IN THE DRIVING QUEUE AFTER THE LAST
* PROCESS P WHERE P.PRIO >= D7.
*
MOVE.B D7,PR_PRI-PR_MAIN(A1) PROC.PRIO:=PRIO=D7;
LEA DRIVING,A6 A6:=DRIVING QUEUE;
MOVE.L (A6),A3 A3:=CUR_PROC:=FIRST DRIVING PROC;
WHILE.L A6 <NE> A3 DO.S WHILE MORE DRIVING PROCS DO
IF.B PR_PRI-PR_MAIN(A3) <LT> D7 THEN.S IF CUR_PROC.PRIO < PRIO THEN
MOVE.L A3,A6 "A6:=NO MORE PROCS"
ELSE.S ELSE
MOVE.L (A3),A3 A3:=CUR_PROC:=NEXT PROC;
ENDI ENDI;
ENDW ENDW;
INS_ELEM A3,A1,A6,A3/A6 QUEUE PROC.MAIN TO DRIVING QUEUE;
PRT_MEM QDRIV,-PR_MAIN(A1),PR_SIZ ********
* PROC.STATE IS ASSIGNED BY THE CALLER OF QDRIV.
RTS RETURN;
PAGE
COND_OBJ EQU * CALLABLE CONDITION OBJECT FUNCTIONS
*
* COND_OBJ IS A "CASE_BLOCK" OF PROCEDURE C_CALL; IT IS ENTERED
* WHEN A COND OBJECT IS CALLED VIA OBJ_CALL.
*
* CALL: RETURN:
* D3 RESIDENT CTX (WHEN<>0) UNDEF
* D5 FUNCTION UNDEF
* D6/D7 ARG#/ANY ARG#/RESULT
* A0 EXTENSION SAME
* A2 CUR_CTX SAME
* A4 ARG UNDEF
* A5 OBJECT=CONDITION UNDEF
* OTHER ANY UNDEF
* CCR ANY <EQ>
*
PRT_MEM COND_OBJ,(A5),CO_SIZ ********
MOVE.L A5,A1 A1:=COND;
LSL.W #1,D5 D5:=FUNCTION:=FUNCTION * 2;
* CHECK FOR A TIMEOUT PARAMETER
IF.W D5 <EQ> #1*2 THEN.S IF FUNCTION = WAIT THEN
TST.W -2(A4) TEST NEXT ACTUAL
IF <EQ> THEN.S IF VOID ACTUAL THEN
CLR.L D0 DO/D1:=NO_TIMEOUT :=0;
CLR.L D1 .
ELSE.S ELSE "GET SUBSEGMENT DESCRIPTION"
MOVEM.L D5/A5,-(A7) SAVE D5/A5;
BSR.L C_SUB C_SUB(A5,D0,D2,D5:=...
MOVEM.L (A7)+,D1/A1 RESTORE D5 INTO D1; A1:=COND; "A7=OK";
IF <EQ> THEN.S IF NOT_OK THEN
RTS RETURN;
ENDI ENDI;
MOVE.L SE_FIR(A5),A5 A5:=ADDRESS OF VALUE DATA:=
ADDA.L D5,A5 BASE SEGMENT DATA + FIRST_REL;
CMP.L #10,D2 TEST D5-10=LENGTH-10
BLT.L ER_VAL3MIS WHEN LENGTH <10 GOTO VALUES_MISSING;
MOVE.W A5,D5 BIT0 OF D5:= ODD VALUE SEGM:=
OR.B D2,D5 (BIT0 OF FIRST) OR (BIT0 OF LENGTH);
BTST.L #0,D5
BNE.L ER_ADILL WHEN ODD VALUE SEGM GOTO ADDRESS ILLEGAL;
MOVE.L D1,D5 RESTORE D5 (=FUNC*2) FROM D1;
MOVEQ.L #0,D6 D6:=ARG# OF
SUBQ.B #1,D6 FIRST VALUE;
LEA (A5,D2.L),A6 A6:= TOP_VAL;
CMP.W #8,-(A6) TEST LENGTH OF FIRST VALUE
BNE.L ER_DAILL WHEN LENGTH<>8 GOT DATA VALUE ILLEGAL;
MOVE.L -(A6),D1 D1:=BIT31..0 OF TIMEOUT
MOVE.L -(A6),D0 D0:=BIT63..32 OF TIMEOUT
BLT.L ER_DAILL WHEN <0 GOTO DATA_VALUE ILLEGAL;
ENDI ENDI; "VOID ACTUAL"
ENDI ENDI; "FUNC<>WAIT "
* A1=COND
MOVEQ.L #1,D6 D6:= ARG# OF CALLED CONDITION:=1;
MOVE.L CO_GA(A1),A5 A5:=GATE MANAGING THE CONDITION;
MOVE.L A5,D7 A7:= TEST A5=0;
BEQ.L ER_STATE WHEN COND TERMINATED GOTO OBJECT_STATE_ILL
ADDQ.L #1,D6 D6:=ARG# OF FUNCTION ARGUMENT:=2;
CMP.W #4,D5
BGT.L ER_FUILL WHEN FUNCTION*2>4 GOTO FUNCTION_ILL;
PAGE
MOVE.B GA_LEV(A5),D7 D7:=GATE.LEVEL
BNE.S DEVICOND WHEN GATE.LEVEL > 0 GOTO DEVICE_CONDITION;
* NORMAL CONDITION OBJECT
TST.W D3 TEST CALLER
BNE.L ER_FUILL WHEN RESIDENT GOTO FUNCTION_ILLEGAL
* CHECK THAT THE MANAGING GATE IS LOCKED
BTST.B #7,GA_STA(A5)
BEQ.L ER_STATE WHEN GATE OPEN GOTO OBJ_STATE_ILLEGAL;
CASEJMP D5 GOTO CASE D5=FUNCTION(:=SPOILED) OF
CASELAB CASE_ERR 0<<1: NOT POSSIBLE
CASELAB CONDWAIT 1<<1: CONDWAIT
CASELAB CONDSIGN 2<<1: CONDSIGN
DEVICOND EQU * DEVICE CONDITION OBJECT
TST.W D3 TEST CALLER
BEQ.L ER_FUILL WHEN NOT RESIDENT GOTO FUNCTION ILLEGAL
* CHECK THAT THE DEVICE GATE IS LOCKED
MOVE.L A1,A4 A4:= SAVE A1
MOVE.L KV_PROC,A1 A1:= CURRENT PROCESS
PRT_MEM PROCESS,(A1),PR_SIZ ********
BSR.L CHECKLEV CHECKLEV(A1=PROC,D7=LEVEL,D3:=UNDEF);
IF <EQ> THEN.S IF NOT_OK THEN
RTS RETURN;"FUNCTION ILLEGAL"
ENDI ENDI;
MOVE.L A4,A1 A1:= RESTORE COND FROM A4;
CASEJMP D5 GOTO CASE D5=FUNCTION (:=SPOILED) OF
CASELAB CASE_ERR 0<<1: NOT POSSIBLE
CASELAB DEVIWAIT 1<<1: DEVIWAIT
CASELAB CONDSIGN 2<<1: CONDSIGN
PAGE
CONDWAIT EQU * WAIT ON NORMAL CONDITION, A5=GATE, A1=COND
BSR.L SPEEDCHK IF SPEEDUP PROPAGATES INTO CONDITION
BNE.L ER_RTS THEN GOTO RETURN;
MOVE.L A1,D5 D5:= SAVE COND ADDR;
BSR.L GATEOPEN GATEOPEN(A5=GATE,A1/A3/A4/A6:=?);
MOVE.L D5,A5 A5:= SAVED COND ADDR;
MOVE.L KV_PROC,A1 A1:=CURRENT_PROCESS
PRT_MEM PROCESS,(A1),PR_SIZ ********
REM_ELEM PR_AUX(A1),A0,A6,A0/A6 REMOVE PROC FROM RUNNING QUEU
MOVEQ #2,D7 D7:=STATE:=WAIT:=2
BRA.S WAITWAIT GOTO WAIT_ON_CONDITION:
DEVIWAIT EQU * WAIT ON DEVICE CONDITION, A5=GATE, A1=COND
BSR.L SPEEDCHK IF SPEEDUP PROPAGATES INTO CONDITION
BNE.L ER_RTS THEN GOTO RETURN;
MOVE.L A1,A5 A5:=COND;
MOVE.L KV_PROC,A1 A1:=CURRENT PROCESS;
MOVEQ #4,D7 D7:=STATE:=DWAIT:=4;
WAITWAIT EQU * WAIT ON CONDITION:
* D0/D1=#USEC,A1=PROC,A2=CTX,A5=CONDITION
* D7:=STATE,
REM_ELEM PR_MAIN(A1),A0,A6,A0/A6 REMOVE PROC FROM TIMEOUT OR DRIVI
TST.L D0
BNE.S YES_TIMO
TST.L D1
IF <NE> THEN.S IF TIME OUT ON THE WAIT OPERATION THEN
YES_TIMO EQU *
MOVE.L A5,A3 A3:= SAVED COND ADDR
BSR.L TWAIT PROC.MAIN:=TIMER_QUEUE(D0-D5/A4-A6:=?)
MOVE.L A3,A5 A5:= SAVED COND ADDR
ELSE.S ELSE "TIME OUT NOT SPECIFIED"
INIT_HEAD PR_MAIN(A1),A6 PROC.MAIN:=EMPTY;
ENDI ENDI; "TIME_OUT"
* A1=PROC,A2=CTX,A5=CONDITION,D7=STATE
LEA CO_WAIT(A5),A0 A0:=WAIT QUEUE; "OF CONDITION"
LEA PR_AUX(A1),A3 A3:=AUX QUEUE OF PROCESS
INS_ELEM A0,A3,A6,A0/A6 CHAIN PROC TO WAIT QUEUE
MOVE.L A5,PR_CON(A1) PROC.COND:=CONDITION;
MOVE.B D7,PR_STA(A1) PROC.STATE:=STATE "2 OR 4"
* PROC.SYNC_RESULT IS NOT ASSIGNED;
BRA.L SYNCSTOP WAIT UNTIL SIGNAL OR ...
* RETURN IS MADE DIRECTLY TO THE CALLER WITH A0/A1/A2/A3/D7 ASSIGNED
PAGE
CONDSIGN EQU * SIGNAL NORMAL/DEVI_COND ,OR INTERRUPT_SIGNAL DEVI_COND.
* D7 = LEVEL, A1 = COND, A5=GATE
LEA CO_WAIT(A1),A4 A4:=WAIT QUEUE OF CONDITION;
MOVE.L (A4),A3 A3:=FIRST PROC WAITING;
IF.L A3 <EQ> A4 THEN.S IF NO PROCS WAITING THEN
CLR.L D7 D7:=OK; CCR:=<EQ>;
RTS RETURN;
ENDI ENDI;
* A3 = AUX_QUEUE OF PROCESS TO BE SIGNALED, D7 = LEVEL
REM_ELEM (A3),A4,A6,A4/A6 REMOVE PROC FROM WAIT QUEUE OF COND;
MOVE.L A3,(A3) AUX_QUEUE OF PROC
MOVE.L A3,4(A3) := EMPTY;
CLR.W PR_SYN-PR_AUX(A3) PROC.SYNC_RESULT:=OK;
LEA PR_MAIN-PR_AUX(A3),A3 A3:=MAIN QUEUE OF PROCESS
* PROC MAY BE IN THE TIMER QUEUE, THE DRIVING QUEUE, OR IN A SPEED_RELOCK QUEUE
REM_ELEM (A3),A4,A6,A4/A6 REMOVE PROC FROM THE QUEUE
* REM_ELEM DOES NOT HARM, WHEN MAIN QUEUE IS EMPTY;
TST.B D7 TEST LEVEL
IF <EQ> THEN.S IF NORMAL CONDITION SIGNAL THEN
MOVE.B #8,PR_STA-PR_MAIN(A3) PROC.STATE:= SIGNALED;
LEA GA_RELOK(A5),A5 A5:=RELOCK QUEUE OF GATE
INS_ELEM A5,A3,A6,A5/A6 QUEUE PROC.MAIN TO RELOCK
ELSE.S ELSE "DEVICE CONDITION SIGNAL"
LSL.B #4,D7 D7:=PRIO:=LEVEL<<4+1;
ADDQ.B #1,D7 QUEUE PROC.MAIN INTO DRIVING QUEUE:
MOVE.L A3,A1 A1:= PROC.MAIN;
BSR.L QDRIV QDRIV(A1=MAIN,D7=PRIO,A3/A6:=UNDEF);
CLR.B PR_STA-PR_MAIN(A1) PROC.STATE:= RUN;
ENDI
CLR.L D7 D7:=OK; CCR:=<EQ>
RTS RETURN;
CHECKLEV EQU * CHECK PRIO OF PROCESS AGAINST DEVICE-LEVEL
* CALL RETURN
* D7 LEVEL OF DEVICE > 0 SAME
* A1 PROCESS SAME
* D3 ANY UNDEF
* CCR=<NE>:OK WHEN DEVICE.LEVEL=PROC.LEVEL, OTHERWISE CCR=<EQ>:NOT_OK
*
MOVE.B PR_PRI(A1),D3 D3:=PROC.PRIO
LSR.B #4,D3 D3:=LEVEL OF PROCESS
IF.B D3 <NE> D7 THEN.S IF LEVEL OF PROCESS <> DEVICE_LEVEL THEN
MOVE.L #ECRSTATE,D7 D7:=RESULT:=REJECTED,OBJ_STATE ILLEGAL;
CMP.W D0,D0 CCR:=<EQ>:NOT_OK;
ELSE.S ELSE
TST.B D7 CCR:=<NE>:OK;
ENDI ENDI;
RTS RETURN;
PAGE
TERMGATE EQU * TERMINATE GATE OBJECT
* CALL RETURN:
* A0 GATE SAME
*
* RETURN ALL PROCESSES WAITING ON GATE OR MANAGED CONDITIONS TO RUNNING QUEUE
*
ENTRYSAV D0/A0/A1/A3/A5/A6,.TERMGAT
PRT_MEM TERMGATE,(A0),GA_SIZ ********
* PROCS WILL ONLY BE WAITING IN QUEUES OF A NORMAL GATE.
MOVE.W #ECSDUMMY,D0 D0:=RESULT:=STATUS,DUMMYFIED;
FOR.W D5=#GA_LOK TO #GA_SPLOK BY #CH_SIZ DO.S FOR ALL LOCKING QUEUE DO
LEA (A0,D5.W),A5 A5:=SOME LOCKING QUEUE;
WHILE.L (A5) <NE> A5 DO.S WHILE PROCS IN LOCKING QUEUE DO
MOVE.L (A5),A1 A1:=PROC.MAIN OF FIRST PROC IN QUEUE;
LEA -PR_MAIN(A1),A1 A1:=PROCESS;
BSR.L SPED_RUN SPEDRUN(A1=PROC,D0=RESULT,A3/A6:=UNDEF);
ENDW ENDW;
ENDF EDNF;
LEA GA_SET(A0),A5 A5:=MANAGED CONDITIONS;
WHILE.L (A5) <NE> A5 DO.S WHILE MORE CONDITIONS DO
MOVE.L (A5),A0 A0:=COND.CO_MAN;
LEA -CO_MAN(A0),A0 A0:=CONDITION;
BSR.S TERMCOND TERMCOND(A0=CONDITION);
ENDW ENDW;
REM_ELEM GA_SCH-GA_SET(A5),A3,A6,A3/A6 UNCHAIN POINTER TO SCHEDULER;
INIT_HEAD GA_SCH-GA_SET(A5),A6 INIT_HEAD IS NICE, BUT NOT REALY NEEDED
RETURN .TERMGAT RETURN;
TERMCOND EQU * ABORT CONDITION AND "CONTEXTS" IN THE CONDITION
* CALL RETURN:
* A0 CONDITION SAME
*
* RETURN ALL PROC WAITING ON CONDITION, TO THE RUNNING QUEUE
ENTRYSAV D0/D7/A1/A3/A5/A6,.TERMCON
PRT_MEM TERMCOND,(A0),CO_SIZ ********
REM_ELEM CO_MAN(A0),A3,A6,A3/A6 REMOVE COND FROM MANAGING GATE
INIT_HEAD CO_MAN(A0),A6
CLR.L CO_GA(A0) COND.MANAGING_GATE:=0;"CONDITION ABORTED"
LEA CO_WAIT(A0),A5 A5:=COND.WAIT QUEUE
WHILE.L (A5) <NE> A5 DO.S WHILE PROCS IN WAITING QUEUE DO
MOVE.L (A5),A1 A1:=PROC.AUX OF WAITING PROC;
LEA -PR_AUX(A1),A1 A1:=PROCESS;
IF.B PR_STA(A1) <EQ> #4 THEN.S IF PROCES WAITING IN DEVI.WAIT THEN
MOVE.W #ECRDUMMY,D0 D0:=RESULT:=REJECT,DUMMYFIED;
BSR.L SPEDDEVI SPEDDEVI(A1=PROC,D0=RES,D7/A3/A6:=?);
REM_ELEM PR_AUX(A1),A3,A6,A3/A6 REMOVE PROC FROM CONDITION QUEUE;
INIT_HEAD PR_AUX(A1),A6 THE CONDITION CANNOT BE SIGNALED ANYMORE.
CLR.B PR_STA(A1) PROC.STATE:= RUN; "SIGNAL NOT POSSIBLE"
ELSE.S ELSE PROCESS WAITING IN NORMAL WAIT
MOVE.W #ECSDUMMY,D0 D0:=RESULT:=STATUS,DUMMYFIED;
BSR.L SPED_RUN SPED_RUN(A1=PROC,D0=RESULT,A3/A6:=UNDEF);
* PROC HAS BEEN REMOVED FROM THE CONDITION QUEUE BY SPED_RUN.
ENDI ENDI;
ENDW ENDW;
RETURN .TERMCON RETURN;
PAGE
PROPSPED EQU * PROPOGATE SPEEDUP INTO GATE OR CONDITION OBJECT
* CALL RETURN
* D0.B 1=REJECT,3=UNDEF UNDEFINED
* A1 PROCESS SAME
* D7/A3/A6 ANY UNDEFINED
*
MOVEQ.L #0,D7
MOVE.B PR_STA(A1),D7 D7.W:=PROC.STATE;
IF <EQ> THEN.S IF PROC.STATE = RUN THEN
RTS RETURN;
ENDI ENDI;
IF.B D7 <EQ> #6 OR.B D7 <EQ> #4 THEN.S
* IF PROC.STATE = LOCK OR STATE = DEVI.WAIT THEN
MOVEQ.L #1,D0 D0:=REJECT;
ENDI ENDI;
SUBQ.B #1,D0 TEST IF D0.B=UNDEF
IF <NE> THEN.S IF UNDEF THEN
MOVE.W #ECSSPEEDUP,D0 D0:=RESULT:=STATUS,SPEEDUP;
BRA.L SPED_RUN GOTO SPED_RUN(A1=PROC,D0=RESULT,A3/A6:=?);
ENDI ENDI;
* OPERATION RETURNS REJECT,SPEEDUP.
MOVE.W #ECRSPEEDUP,D0 D0:=RESULT:=REJECT,SPEEDUP;
CASEJMP D7 GOTO CASE D7 = STATE OF
CASELAB CASE_ERR 0: NOT POSSIBLE
CASELAB SPEDWAIT 2: SPEDWAIT
CASELAB SPEDDEVI 4: SPEDDEVI
CASELAB SPED_RUN 6: SPED_RUN "=SPEDLOCK"
CASELAB SPEDSIGN 8: SPEDSIGN
SPEDSIGN EQU * SPEEDUP SIGNALED PROCESS
RTS RETURN; "DO NOTHING"
SPEDWAIT EQU * SPEED UP PROCESS WAITING ON NORMAL CONDITION;
MOVE.W D0,PR_SYN(A1) PROC.SYNC_RESULT:=RESULT;
REM_ELEM PR_MAIN(A1),A3,A6,A3/A6 REMOVE PROC.MAIN FROM "SOME" QUEUE
MOVE.L PR_CON(A1),A3 A3:=CONDITION;
MOVE.L CO_GA(A3),A6 A6:=GATE MANAGING CONDITION;
* A3/A6 CANNOT BE ZERO
TAS.B GA_STA(A6) LOCK THE GATE
IF <EQ> THEN.S IF GATE WAS OPEN THEN
INIT_HEAD PR_MAIN(A1),A6 PROC.MAIN:=EMPTY
REM_ELEM PR_AUX(A1),A3,A6,A3/A6 REMOVE PROC FROM CONDITION;
LEA RUNNING,A3 A3:=RUNNING QUEUE;
CLR.B PR_STA(A1) PROC.STATE:= RUNNING;
MOVE.W #PR_AUX,D0 D0:=AUX_QUEUE OFFSET
ELSE.S ELSE
LEA GA_SPLOK(A6),A3 A3:=GATE.SPEED_RELOCK QUEUE;
MOVE.W #PR_MAIN,D0 D0:=MAIN_QUEUE OFFSET
ENDI ENDI;
* A1=PROC, A3=QUEUE, D0=QUEUE ELEMENT OFFSET
ADD.W D0,A1 A1:= PROC.OFFSET_QUEUE
INS_ELEM A3,A1,A6,A3/A6 INSERT PROC.OFFSET IN SELECTED QUEUE;
SUB.W D0,A1 RESTORE A1 AS PROCESS ADDRESS;
PRT_MEM SPEDWAIT,(A1),PR_SIZ ********
RTS RETURN
PAGE
SPEDDEVI EQU * SPEED UP PROCESS WAITING ON DEVICE CONDITION;D7/A3/A6:=?
MOVE.W D0,PR_SYN(A1) PROC.SYNC_RESULT:=RESULT;
MOVE.B PR_PRI(A1),D7 D7:=LEVEL << 4 + X
BCLR.L #0,D7 D7:=LEVEL << 4 + 0
LEA PR_MAIN(A1),A1 A1:=PROC.MAIN;
REM_ELEM (A1),A3,A6,A3/A6 REMOVE PROC.MAIN FROM "SOME" QUEUE;
BSR.L QDRIV QDRIV(A1=PROC,D7=PRIO,A3/A6:=UNDEF);
* PROC.STATE REMAINS UNCHANGED (=D_WAIT=4). PROC.AUX IS QUEUED TO COND.
LEA -PR_MAIN(A1),A1 A1:= PROCESS;
PRT_MEM SPEDDEVI,(A1),PR_SIZ ********
MOVE.L A4,A3 SAVE A4 IN A3
BSR.L EN_STOPR ENSURE STOP RUNNING PROCESS(D7/A4:=?);
MOVE.L A3,A4 RESTORE A4 FROM A3
RTS RETURN;
* WHEN THE KERNEL OPERATION THAT CALLED SPEDDEVI RETURNS TO THE
* USER CONTEXT, THE SCHEDULER WILL GET CONTROL, AND ACTIVATE
* THE DRIVER JUST SPEEDED UP.
SPED_RUN EQU * PUT THE PROCESS BACK INTO RUNNING QUEUE;
* CALL RETURN
* D0 SYNC_RESULT SAME
* A1 PROCESS SAME
* A3/A6 ANY UNDEF
MOVE.W D0,PR_SYN(A1) PROC.SYNC_RESULT:=RESULT;
REM_ELEM PR_MAIN(A1),A3,A6,A3/A6 REMOVE PROC.MAIN FROM
INIT_HEAD PR_MAIN(A1),A3 "SOME" QUEUE
CLR.B PR_STA(A1) PROC.STATE:=RUN:=0;
CLR.B PR_PRI(A1) PROC.PRIO:=0;
LEA PR_AUX(A1),A1 A1:=PROC.AUX
REM_ELEM (A1),A3,A6,A3/A6 REMOVE PROC.AUX FROM "SOME" QUEUE
LEA RUNNING,A3 A3:=RUNNING;
INS_ELEM A3,A1,A6,A3/A6 INSERT PROC.AUX IN RUNNING QUEUE;
LEA -PR_AUX(A1),A1 RESTORE A1 = PROCESS
PRT_MEM SPED_RUN,(A1),PR_SIZ ********
RTS RETURN;
CASE_ERR EQU * CASE ERROR
ERROR 88 ERROR(88);
* END OF SCHEDULER RUNTIME SECTION
SCH_TRUN EQU * TOP ADDRESS OF SCHEDULER RUNTIME SECTION
END ! END OF SCHEDULER SOURCE
«eof»