Google
 

Trailing-Edge - PDP-10 Archives - BB-P363B-SM_1985 - mcb/cex/cex.b16
There are no other files named cex.b16 in the archive.
module CEX (					! Comm/Exec Auxilliary Process
		ident = 'X03420',
		language (bliss16),
		addressing_mode (absolute)
		) =
begin
!
!                    COPYRIGHT (c) 1980, 1981, 1982
!                    DIGITAL EQUIPMENT CORPORATION
!                        Maynard, Massachusetts
!
!     This software is furnished under a license and may  be  used
!     and copied only in accordance with the terms of such license
!     and with the inclusion of the above copyright notice.   This
!     software  or any other copies thereof may not be provided or
!     otherwise made available to any other person.  No  title  to
!     and ownership of the software is hereby transferred.
!
!     The information  in  this  software  is  subject  to  change
!     without  notice  and should not be construed as a commitment
!     by DIGITAL EQUIPMENT CORPORATION.
!
!     DIGITAL assumes no responsibility for the use or reliability
!     of  its  software  on  equipment  which  is  not supplied by
!     DIGITAL.
!

!++
!
! FACILITY: MCB Communicatios Executive
!
! ABSTRACT:
!
!	The CEX process handles Comm/Exec data base initialization,
!	timer support, process scheduling, and various functions which
!	are not time-critical and which can work with APR5 remapped.
!
! ENVIRONMENT: RSX kernel mode with EIS
!
! AUTHOR: Alan D. Peckham	CREATION DATE: 18-Mar-80
!
! MODIFIED BY:
!
!	Alan D. Peckham, 2-Jul-80: VERSION 3.0
! 01	- Clock CSR reference needs one more level of indirection...
! 02	- Change CRSH$ references to CRSH$S.
! 03	- Use macros to access APR6 mapping register.
! 04	- Moved global data to seperate module.
!	  Eliminated local data (process can now be made read-only).
! 05	- Make the CE: device busy at CEPWF so that timer works.
!	  Correct .RDBPD pointer initialization.
!	  Initialize $IGREG to .LEV0.
! 06	- Add initialization code to send CTL/STR to owners of lines
!	  after process initialization.
! 07	- Whoops! Must handle process initialization also.
!	  Also set system lines active before INITB.
! 08	- Make sure CCBs are long enough for our info.
! 09	- Correct RDB bias initialization bug.
!	  Reset .CRPIX before allocating and sending CTL/STR CCBs.
! 10	- Choose the proper lines in INTIM.
! 11	- Allocate CEXBUF from the bottom up instead of top down.
!	  Replace STBUF by FNBUF.
! 12	- Bad test in CETIM caused unwanted LLC TIM/LTM dispatches.
!	  Move system initialization to seperate INI process.
! 13	- Add support for SDB header.
! 14	- Fix SDB allocation bug introduced by 13.
! 15	- Update CRSH$S contexts.
! 16	- Add panic dumper.
! 17	- Move panic dumper to seperate process.
!	  Initialize .PBIAS to panic process mapping bias.
!	  Move our exception handler addresses into the trap
!	  vectors.
!	  Save the address of the master DTE for power failure.
! 18	- Initialize .DBIAS to debug process mapping bias.
! 19	- Alterations for new signalling strategy.
!	  Change ZF.TIM bit assignment.
!	  Eliminate direct access to PS.
! 20	- Set up default last-chance handler.
!	  Change $LLCDS input parameters.
!	  Set our bias in .FRKBK in INDAT.
! 21	- Correct bug in LAST.
!	  Get all of I/O page dump range.
! 22	- Turn off LF.ENA when line is disabled.
!	  Clear out allocated buffers in ALLOCATE_BUFFERS.
!	Alan D. Peckham, 10-Dec-80: VERSION 3.1
! 23	- Change calls to $DDMDS, $DLCDS, $LLCDS to $PRCDS.
!	  Merge system line/process initialization loops in CEPWF.
!	  Flag ZF.TIM now becomes ZF.LTM.
!	  Merge DLC and DDM data base timers into LLC timer loop
!	  in CETIM and eliminate INTIM.
!	  Find process paritions to get mapping bias and
!	  allow LLC data bases to be mapped in INPDT.
!	  Eliminate data base checking in INSLT.
! 24	- Set CE$CLN error to continue with our own length.
! 25	- Exchange ZF.UCB flag support for invalid UCB address in PD.
!	  Key missing data base to invalid address.
!	  Drivers with mapped data bases now allowed.
!	Alan D. Peckham, 30-Jan-80: VERSION 3.2
! 26	- Change input conditions for $PRCDS.
!	  Exception vector format changed.
!	  Alter process descriptor scanning to use PDB vector.
! 27	- Make sure processes have been built with this CEXCOM in INPDT.
!	  Add process destruction scheduler.
! 28	- Undetected syntax error in KILL_PROCESSES.
! 29	- Save partition size in process header in INPDB.
! 30	- Rewrite in BLISS.
!	  Remove interrupt transfer block initialization.
! 32	- Correct PDT address buf in CEX$$SET_LINE_PROCESSES.
!	  Compensate for 11/34 processer CLR instruction in ALLOCATE_BUFFERS
!	  (11/34 does read-modify-write, which does not fix parity).
! 33	- Correct partition name bug in CEX$$SET_PROCESS.
!	  Add missing assignment in CEX$$SET_LINE_PROCESSES.
!	  Add INITIALIZE_UNIBUS_MAPPING - support for 11/70 UNIBUS mapping.
! 34	- Reset CEX_SYNCH_BLOCK [SYN$A_DISPATCH] in KILL_PROCESSES to allow
!	  re-use.
! 35	- Add CEX$$GET_DEVICE_NAME.
!	  Allocate a common event logging buffer in INITIALIZE_CEXCOM_DATA.
! 36	- Remove CEX$$GET_LINE_NAME.
! 37	- Fix common event logging buffer length.
! 38	- Move code to clear out CEXBUF from ALLOCATE_BUFFERS to
!	  INITIALIZE_BLOCK_POOL.
! 39	- Support CEX$GW_SYNCH_COUNT in SCHEDULE.
!	  Support CEX$GW_CCB_DISPATCH_COUNT in SCHEDULE.
!	  Support CEX$GW_LONG_TIMER_COUNT in CETIM.
!	  Support CEX$GW_SHORT_TIMER_COUNT in CECLK.
!	  Support counter averaging in CETIM.
!	  Replace "HALT" with "BR ." in PANIC.
! 40	- Do not reset $SYSIZ in INITIALIZE_UNIBUS_MAPPING.
! 41	- Stick HALT back in PANIC (no improvement for MCBDA).
! 42	- Conditionalize the unibus mapping code.
!--

!
! INCLUDE FILES:
!

library 'XPORT';

library 'MCBLIB';

library 'RSXLIB';

library 'CEXLIB';

%if not %declared (CEX$CFG_UNIBUS_MAPPING)
%then compiletime CEX$CFG_UNIBUS_MAPPING = (1 eql 0); %fi

!
! TABLE OF CONTENTS:
!

linkage
    LINKAGE_ADR = jsr (register = 5),
    LINKAGE_ADR_CARRY = jsr (register = 1; register = 0) : clearstack valuecbit,
    LINKAGE_ADR_CNT = jsr (register = 5, register = 4; register = 5) : nopreserve (5),
    LINKAGE_ADR_NO_CARRY = jsr (register = 1),
    LINKAGE_BLKS = jsr (register = 1),
    LINKAGE_CLEAN = jsr : preserve (0, 1, 2, 3, 4, 5),
    LINKAGE_FUNCTION = jsr (register = 1) : nopreserve (0, 1, 2),
    LINKAGE_INTERRUPT = interrupt (standard, standard) : preserve (0, 1, 2, 3, 4, 5),
    LINKAGE_LIST_BUFFER = jsr : global (LIST = 5, BUFFER = 2) nopreserve (0, 1, 3, 4),
    RSX_CLK = jsr (register = 4) : nopreserve (0, 1, 2, 3, 4, 5),
    RSX_FRK = jsr (register = 4) : nopreserve (0, 1, 2, 3, 4, 5),
    RSX_UCB_SCB = jsr (register = 5, register = 4) : nopreserve (0, 1, 2, 3, 4, 5);

forward routine
    CEX$$CLEAR_PROCESS : CALL$,
    CEX$$CLEAR_PROCESS_NAME : CALL$,
    CEX$$CLEAR_VECTOR : CALL$,
    CEX$$GET_DEVICE_NAME : CALL$,
    CEX$$GET_LINE_PROCESSES : CALL$,
    CEX$$GET_PROCESS_INDEX : CALL$,
    CEX$$GET_PROCESS_NAME : CALL$,
    CEX$$SET_EXCEPTION : CALL$,
    CEX$$SET_LINE_PROCESSES : CALL$,
    CEX$$SET_PROCESS : CALL$,
    CEX$$SET_PROCESS_NAME : CALL$,
    CEX$$SET_VECTOR : CALL$,

    ALLOCATE_BUFFERS : LINKAGE_BLKS,
    ALLOCATE_BUFFER_POOL : LINKAGE_ADR novalue,
    ALLOCATE_CCB_AND_BUFFER_POOL : LINKAGE_ADR novalue,
    CECLK : RSX_CLK novalue,
    CEFRK : RSX_FRK novalue,
    CENOP : RSX_UCB novalue,
    CEPWF : RSX_UCB_SCB novalue,
    CETIM : RSX_UCB_SCB novalue,
    CHECK_BUFFER_ALLOCATIONS : novalue,
    FIND_LINE : LINKAGE_FUNCTION,
    FIND_PARTITION : LINKAGE_FUNCTION,
    FIND_PROCESS_NAME : LINKAGE_FUNCTION,
    INITIALIZE_BLOCK_POOL,
    INITIALIZE_BUFFER_POOL : LINKAGE_ADR_CNT novalue,
    INITIALIZE_CEXCOM_DATA : RSX_UCB novalue,
    INITIALIZE_DEVICE_NAMES : LINKAGE_ADR_CNT novalue,
    INITIALIZE_LINES : LINKAGE_ADR_CNT novalue,
    INITIALIZE_PROCESS_DESCRIPTORS : LINKAGE_ADR_CNT novalue,
    INITIALIZE_PROCESS_NAMES : LINKAGE_ADR_CNT novalue,
    INITIALIZE_UNIBUS_MAPPING : novalue,
    KILL_PROCESSES : MCB_ novalue,
    LAST,
    NULL : LINKAGE_INTERRUPT novalue,
    NXM_CATCHER : LINKAGE_INTERRUPT novalue,
    NXM_TESTER : LINKAGE_ADR_NO_CARRY,
    PANIC : MCB_ novalue,
    PDUMP : LINKAGE_LIST_BUFFER novalue,
    SCHEDULE : MCB_ novalue;

bind routine
    NXM = NXM_TESTER : LINKAGE_ADR_CARRY;

!
! MACROS:
!

macro
    $CEX_FATAL_ERROR (CODE) =
	(CEX$GG_SIGNAL_STATUS = CODE) %;

macro
     UBM_MAPPING =
     begin
     external SR3;
     local
         NXM_SAVE;
     NXM_SAVE = .VEC$AA_ADDRESS_ERROR [0];
     VEC$AA_ADDRESS_ERROR [0] = NXM_CATCHER;
     if not NXM (SR3)
     then
         begin
	 VEC$AA_ADDRESS_ERROR [0] = .NXM_SAVE;
         SR3 = .SR3 or %o'60';
         true
         end
     else
         begin
	 VEC$AA_ADDRESS_ERROR [0] = .NXM_SAVE;
         false
	 end
     end
       %;
!
! EQUATED SYMBOLS:
!

literal
    FALSE = 1 eql 0,
    NO_OPERATION = 0,
    TRUE = 1 eql 1;

$CEX_BFPDEF
$CEX_CBPDEF
$CEX_CCBDEF
$CEX_EXVDEF
$CEX_ITBDEF
$CEX_PDTDEF
$CEX_PNMDEF
$CEX_SLTDEF
$CEX_SYNDEF
$CEX_TMBDEF
$CEX_UBMDEF

macro
    RSX$GW_SYSTEM_SIZE = %name ('$SYSIZ') %;

bind
    BKP$W_LINK = %o'140000',
    BKP$H_SIZE = %o'140002';

bind
    VEC$AA_ADDRESS_ERROR = %o'4' : vector [2],
    VEC$AA_BREAKPOINT = %o'14' : vector [2],
    VEC$AA_EMT_INSTRUCTION = %o'30' : vector [2],
    VEC$AA_ILLEGAL_INSTRUCTION = %o'10' : vector [2],
    VEC$AA_IOT_INSTRUCTION = %o'20' : vector [2],
    VEC$AA_PARITY_ERROR = %o'114' : vector [2],
    VEC$AA_POWER_FAILURE = %o'24' : vector [2],
    VEC$AA_SEGMENT_FAULT = %o'250' : vector [2],
    VEC$AA_TRAP_INSTRUCTION = %o'34' : vector [2];

!
! OWN STORAGE:
!

external routine
    $DSPCR : novalue;

bind
    CEXTBL = TABLE$ ($DSPCR, 12^1,
	(MCB$K_CLEAR_PROCESS, CEX$$CLEAR_PROCESS),
	(MCB$K_CLEAR_PROCESS_NAME, CEX$$CLEAR_PROCESS_NAME),
	(MCB$K_CLEAR_VECTOR, CEX$$CLEAR_VECTOR),
	(MCB$K_GET_DEVICE_NAME, CEX$$GET_DEVICE_NAME),
	(MCB$K_GET_LINE_PROCESSES, CEX$$GET_LINE_PROCESSES),
	(MCB$K_GET_PROCESS_INDEX, CEX$$GET_PROCESS_INDEX),
	(MCB$K_GET_PROCESS_NAME, CEX$$GET_PROCESS_NAME),
	(MCB$K_SET_EXCEPTION, CEX$$SET_EXCEPTION),
	(MCB$K_SET_LINE_PROCESSES, CEX$$SET_LINE_PROCESSES),
	(MCB$K_SET_PROCESS, CEX$$SET_PROCESS),
	(MCB$K_SET_PROCESS_NAME, CEX$$SET_PROCESS_NAME),
	(MCB$K_SET_VECTOR, CEX$$SET_VECTOR));

global bind
    $CETBL = TABLE$ (CENOP, 6,
	(4, CETIM),
	(6, CEPWF));

$MCB_PROCESS (
    NAME = CEX,				! Process name
    CEX_DISPATCH = CEXTBL,		! Cex service table
    RSX_DISPATCH = $CETBL)		! RSX dispatch vector

!
! EXTERNAL REFERENCES:
!

external
    CEX$GW_AVG_CCB_DISPATCHES,
    CEX$GW_AVG_INTERRUPTS,
    CEX$GW_AVG_LONG_TIMERS,
    CEX$GW_AVG_SHORT_TIMERS,
    CEX$GW_AVG_SYNCHS,
    CEX$GW_BLOCK_POOL_BIAS,
    CEX$GH_BUFFER_POOL_COUNT,
    CEX$GA_BUFFER_POOL_TABLE : ref blockvector [,BFP$K_LENGTH] field ($CEX_BFPFIELDS),
    CEX$GW_CCB_DISPATCH_COUNT,
    CEX$AG_CCB_DSR_ALLOCATION : vector [2],
    CEX$GR_CCB_POOL : block [CBP$K_LENGTH] field ($CEX_CBPFIELDS),
    CEX$AA_CCB_QUEUE_H : vector [2],
    CEX$AA_CCB_QUEUE_L : vector [2],
    CEX$GA_CEX_FORK_BLOCK,
    CEX$AR_CEX_SYNCH_BLOCK : block [SYN$K_LENGTH] field ($CEX_SYNFIELDS),
    CEX$GA_CURRENT_PROCESS : ref block [PDT$K_LENGTH] field ($CEX_PDTFIELDS),
    CEX$GB_CURRENT_PROCESS_INDEX,
    CEX$GA_DTE_BOOT_ROM_ADDRESS,
    CEX$GR_DUMP_EXCEPTION : block [EXV$K_LENGTH] field ($CEX_EXVFIELDS),
    CEX$GR_INTERRUPT_4_BLOCK : block [IPB$K_LENGTH] field ($CEX_IPBFIELDS),
    CEX$GR_INTERRUPT_5_BLOCK : block [IPB$K_LENGTH] field ($CEX_IPBFIELDS),
    CEX$GR_INTERRUPT_6_BLOCK : block [IPB$K_LENGTH] field ($CEX_IPBFIELDS),
    CEX$GR_INTERRUPT_7_BLOCK : block [IPB$K_LENGTH] field ($CEX_IPBFIELDS),
    CEX$GR_LAST_CHANCE_EXCEPTION : block [EXV$K_LENGTH] field ($CEX_EXVFIELDS),
    CEX$GW_LONG_TIMER_COUNT,
    CEX$GA_PANIC_STACK,
    CEX$GW_PANIC_STATUS,
    CEX$GG_POWER_FAIL_COUNT,
    CEX$GR_PRIMARY_EXCEPTION : block [EXV$K_LENGTH] field ($CEX_EXVFIELDS),
    CEX$GH_PROCESS_COUNT,
    CEX$AG_PROCESS_DATA_BASE : vector [2],
    CEX$GH_PROCESS_NAME_COUNT,
    CEX$GA_PROCESS_NAME_TABLE : ref blockvector [,PNM$K_LENGTH] field ($CEX_PNMFIELDS),
    CEX$AA_PROCESS_TABLE : vector,
    CEX$GA_PROCESS_TABLE_END,
    CEX$AW_RANDOM_NUMBER_SEED : vector [2],
    CEX$AG_RDB_CORE_ALLOCATION : vector,
    CEX$AG_RDB_DSR_ALLOCATION : vector,
    CEX$GR_RDB_POOL : block [CBP$K_LENGTH] field ($CEX_CBPFIELDS),
    CEX$GR_SECONDARY_EXCEPTION : block [EXV$K_LENGTH] field ($CEX_EXVFIELDS),
    CEX$GH_SCHEDULING_REQUESTS,
    CEX$GW_SHORT_TIMER_COUNT,
    CEX$GA_SHORT_TIMER_DISPATCH,
    CEX$GG_SIGNAL_STATUS,			! NOT DEFINED YET
    CEX$GW_STATISTICS_INTERVAL,
    CEX$GW_STATISTICS_TIMER,
    CEX$GW_SYNCH_COUNT,
    CEX$AA_SYNCH_QUEUE : vector [2],
    CEX$GH_SYSTEM_LINE_COUNT,
    CEX$GA_SYSTEM_LINE_TABLE : ref blockvector [, SLT$K_LENGTH] field ($CEX_SLTFIELDS),
    MCB$GA_LOGGING_BUFFER,
    MCB$GW_RDB_SIZE,
    CEX$GA_UBM_DATA_BASE;

external routine
    CEX$$ADD_32 : CEX_LL_ADD_LOW_HIGH novalue,
    CEX$$ADDRESS_ERROR_TRAP : LINKAGE_INTERRUPT novalue,
    CEX$$ALLOCATE_CORE : CEX_LL_BLKS,
    CEX$$BREAKPOINT_TRAP : LINKAGE_INTERRUPT novalue,
    CEX$$DISPATCH_PROCESS : CEX_LL_PDB_FNC_MOD novalue,
    CEX$$DIVIDE_32 : CEX_LL_NUM_LOW_HIGH novalue,
    CEX$$EMT_INSTRUCTION_TRAP : LINKAGE_INTERRUPT novalue,
    CEX$$ENTER_CEX : LINKAGE_CLEAN novalue,
    CEX$$EXIT_CEX : LINKAGE_CLEAN novalue,
    CEX$$ILLEGAL_INSTRUCTION_TRAP : LINKAGE_INTERRUPT novalue,
    CEX$$IOT_INSTRUCTION_TRAP : LINKAGE_INTERRUPT novalue,
    CEX$$MULTIPLY_32 : CEX_LL_NUM_NUM novalue,
    CEX$$PARITY_ERROR_TRAP : LINKAGE_INTERRUPT novalue,
    CEX$$POWER_FAILURE_TRAP : LINKAGE_INTERRUPT novalue,
    CEX$$SEGMENT_FAULT_TRAP : LINKAGE_INTERRUPT novalue,
    CEX$$SHIFT_32 : CEX_LL_CNT_LOW_HIGH novalue,
    CEX$$SYNCHRONIZE_PROCESS : CEX_LL_PDB_DSP novalue,
    CEX$$TRAP_INSTRUCTION_TRAP : LINKAGE_INTERRUPT novalue;

bind
    INTERRUPT_PRIORITY_BLOCK = UPLIT (
	CEX$GR_INTERRUPT_4_BLOCK [IPB$V_JSR_4],
	CEX$GR_INTERRUPT_5_BLOCK [IPB$V_JSR_4],
	CEX$GR_INTERRUPT_6_BLOCK [IPB$V_JSR_4],
	CEX$GR_INTERRUPT_7_BLOCK [IPB$V_JSR_4]) : vector [4];
global routine CEX$$CLEAR_PROCESS : CALL$ =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin

    builtin
	actualcount,
	actualparameter;

    if actualcount () neq 0 then return $CEX_FATAL_ERROR (MCB$_PARAMETER_ERROR);

    if .CEX$AG_PROCESS_DATA_BASE [1] neqa 0
    then
	return $CEX_FATAL_ERROR (MCB$_PROCESS_STILL_ACTIVE);

    CEX$GA_CURRENT_PROCESS [PDT$V_KILL_PROCESS] = TRUE;
    begin

    local
	PS_SAVE;

    external
	PS;

    PS_SAVE = .PS;
    PS <0, 8> = 7^5;

    if .CEX$AR_CEX_SYNCH_BLOCK [SYN$A_DISPATCH] eqla 0
    then
	begin

	bind
	    CEX$AR_CEX_PROCESS = CEX$AA_PROCESS_TABLE [0] : ref block [PDT$K_LENGTH] field ($CEX_PDTFIELDS);

	CEX$AR_CEX_SYNCH_BLOCK [SYN$A_DISPATCH] = KILL_PROCESSES;
	CEX$AR_CEX_SYNCH_BLOCK [SYN$A_PROCESS] = .CEX$AR_CEX_PROCESS;

	if (CEX$AR_CEX_SYNCH_BLOCK [SYN$A_LINK] = .CEX$AA_SYNCH_QUEUE [0]) eqla 0
	then
	    CEX$AA_SYNCH_QUEUE [1] = CEX$AR_CEX_SYNCH_BLOCK;

	CEX$AA_SYNCH_QUEUE [0] = CEX$AR_CEX_SYNCH_BLOCK;
	end;

    PS <0, 8> = .PS_SAVE;
    end;
    MCB$_NORMAL
    end;				!of routine CEX$$CLEAR_PROCESS
global routine CEX$$CLEAR_PROCESS_NAME : CALL$ =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin

    builtin
	actualcount,
	actualparameter;

    if  actualcount () neq 1 then return $CEX_FATAL_ERROR (MCB$_PARAMETER_ERROR);

    begin

    local
	NAME_ENTRY : ref block [PNM$K_LENGTH] field ($CEX_PNMFIELDS),
	PROCESS_NAME;

    if (PROCESS_NAME = actualparameter (1)) eqlu 0 then return MCB$_UNKNOWN_PROCESS;

    if (NAME_ENTRY = FIND_PROCESS_NAME (.PROCESS_NAME)) eqla 0 then return MCB$_UNKNOWN_PROCESS;

    begin

    bind
	PROCESS = .NAME_ENTRY [PNM$A_PROCESS] : block [PDT$K_LENGTH] field ($CEX_PDTFIELDS);

    if .CEX$GA_CURRENT_PROCESS [PDT$W_CODE_BIAS] nequ .PROCESS [PDT$W_CODE_BIAS]
    then
	return $CEX_FATAL_ERROR (CE$ACV);

    NAME_ENTRY [PNM$A_PROCESS] = 0;
    NAME_ENTRY [PNM$W_NAME] = 0;
    end;
    end;
    MCB$_NORMAL
    end;				!of routine CEX$$CLEAR_PROCESS_NAME
global routine CEX$$CLEAR_VECTOR : CALL$ =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin

    builtin
	actualcount,
	actualparameter;

    if actualcount () neq 1 then return $CEX_FATAL_ERROR (MCB$_PARAMETER_ERROR);

    begin

    local
	VEC : ref vector [2];

    external
	%name ('V$$CTR');

    VEC = actualparameter (1);

    if .VEC geqa %name ('V$$CTR') or .VEC <0, 2> neq 0
    then
	return $CEX_FATAL_ERROR (CE$VEC);

    begin

    local
	ITB : ref block [ITB$K_LENGTH] field ($CEX_ITBFIELDS);

    external
	%name ('$NONSI');

    ITB = .VEC [0];

    if .ITB eqla %name ('$NONSI')
    then
	return $CEX_FATAL_ERROR (CE$VCF);

    if .CEX$GA_CURRENT_PROCESS neqa .ITB [ITB$A_PROCESS]
    then
	return $CEX_FATAL_ERROR (CE$ACV);

    VEC [0] = %name ('$NONSI');
    $RSX_RETURN_DSR (ITB$K_LENGTH*%upval, .ITB);
    end;
    end;
    MCB$_NORMAL
    end;				!of routine CEX$$CLEAR_VECTOR
global routine CEX$$GET_DEVICE_NAME : CALL$ =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin

    builtin
	actualcount,
	actualparameter;

    if actualcount () neq 2 then return $CEX_FATAL_ERROR (MCB$_PARAMETER_ERROR);

    ch$wchar (0, actualparameter (2));
    begin

    local
	SLT : ref block [SLT$K_LENGTH] field ($CEX_SLTFIELDS);

    if (SLT = FIND_LINE (actualparameter (1))) eqla 0
    then
	return $CEX_FATAL_ERROR (CE$LIX);

    ch$move (ch$rchar (.SLT [SLT$A_DEVICE]) + 1, .SLT [SLT$A_DEVICE], actualparameter (2));
    end;
    MCB$_NORMAL
    end;				!of routine CEX$$GET_DEVICE_NAME
global routine CEX$$GET_LINE_PROCESSES : CALL$ =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin

    builtin
	actualcount,
	actualparameter;

    if actualcount () neq 2 then return $CEX_FATAL_ERROR (MCB$_PARAMETER_ERROR);

    begin

    local
	BUF : ref vector [3];

    BUF = actualparameter (2);
    BUF [2] = BUF [1] = BUF [0] = 0;
    begin

    local
	SLT : ref block [SLT$K_LENGTH] field ($CEX_SLTFIELDS);

    if (SLT = FIND_LINE (actualparameter (1))) eqla 0
    then
	return CE$LIX;

    BUF [0] = .SLT [SLT$B_LLC_PROCESS_INDEX];
    BUF [1] = .SLT [SLT$B_DLC_PROCESS_INDEX];
    BUF [2] = .SLT [SLT$B_DDM_PROCESS_INDEX];
    end;
    end;
    MCB$_NORMAL
    end;				!of routine CEX$$GET_LINE_PROCESSES
global routine CEX$$GET_PROCESS_INDEX : CALL$ =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin

    builtin
	actualcount,
	actualparameter;

    if actualcount () neq 2 then return $CEX_FATAL_ERROR (MCB$_PARAMETER_ERROR);

    actualparameter (2) = 0;
    begin

    local
	PROCESS : ref block [PDT$K_LENGTH] field ($CEX_PDTFIELDS);

    if (PROCESS = FIND_PROCESS_NAME (actualparameter (1))) eqla 0 then return MCB$_UNKNOWN_PROCESS;

    actualparameter (2) = .PROCESS [PDT$B_INDEX];
    end;
    MCB$_NORMAL
    end;				!of routine CEX$$GET_PROCESS_INDEX
global routine CEX$$GET_PROCESS_NAME : CALL$ =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin

    builtin
	actualcount,
	actualparameter;

    if actualcount () neq 2 then return $CEX_FATAL_ERROR (MCB$_PARAMETER_ERROR);

    actualparameter (2) = 0;
    begin

    local
	PROCESS : ref block [PDT$K_LENGTH] field ($CEX_PDTFIELDS);

    if ((PROCESS = actualparameter (1)) gtru .CEX$GH_PROCESS_COUNT) or
	((PROCESS = .CEX$AA_PROCESS_TABLE [.PROCESS]) eqla 0)
    then
	return CE$PIX;

    begin
    $CEX_PHDDEF

    bind
	HEADER = %o'140000' : block field ($CEX_PHDFIELDS);

    local
	SAVE_MAP;

    SMAP$ (SAVE_MAP);
    MAP$ (.PROCESS [PDT$W_CODE_BIAS]);
    PROCESS = .HEADER [PHD$W_NAME];
    MAP$ (.SAVE_MAP);
    end;
    actualparameter (2) = .PROCESS;
    end;
    MCB$_NORMAL
    end;				!of routine CEX$$GET_PROCESS_NAME
global routine CEX$$SET_EXCEPTION : CALL$ =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin

    builtin
	actualcount,
	actualparameter;

    if actualcount () eql 0 then return $CEX_FATAL_ERROR (MCB$_PARAMETER_ERROR);

    begin

    bind
	MEXV = uplit (CEX$GR_PRIMARY_EXCEPTION,
	    CEX$GR_SECONDARY_EXCEPTION,
	    CEX$GR_LAST_CHANCE_EXCEPTION) : vector [2];

    local
	EXV : ref block [EXV$K_LENGTH] field ($CEX_EXVFIELDS);

    if (EXV = actualparameter (1)) gtru 2 then return CE$EXV;

    EXV = .MEXV [.EXV];

    if actualcount () gtru 3
    then
	begin

	local
	    OLD : ref vector [3];

	if (OLD = actualparameter (3)) neqa 0
	then
	    begin

	    bind
		PROCESS = EXV [EXV$A_PROCESS] : ref block [EXV$K_LENGTH] field ($CEX_PDTFIELDS);

	    OLD [0] = .EXV [EXV$A_DISPATCH];
	    OLD [1] = .PROCESS [PDT$B_INDEX];
	    OLD [2] = .EXV [EXV$A_ENABLE_DATA];
	    OLD = OLD [2];
	    end;

	end;

    if actualcount () gtru 2
    then
	begin

	local
	    NEW : ref vector [3];

	if (NEW = actualparameter (2)) neqa 0
	then
	    begin

	    local
		PROCESS : ref block [PDT$K_LENGTH] field ($CEX_PDTFIELDS);

	    if .CEX$GH_PROCESS_COUNT lssu .NEW [1] or
		(PROCESS = .CEX$AA_PROCESS_TABLE [.NEW [1]]) eqla 0
	    then
		return $CEX_FATAL_ERROR (CE$PIX);

	    codecomment 'Disable the exception' :
		begin EXV [EXV$A_DISPATCH] = 0; end;

	    EXV [EXV$A_ENABLE_DATA] = .NEW [2];
	    EXV [EXV$A_PROCESS] = .PROCESS;
	    EXV [EXV$A_DISPATCH] = .NEW [0];
	    end
	else
	    EXV [EXV$A_DISPATCH] = 0;

	end
    else
	EXV [EXV$A_DISPATCH] = 0;

    end;
    MCB$_NORMAL
    end;					!of routine CEX$$SET_EXCEPTION
global routine CEX$$SET_LINE_PROCESSES : CALL$ =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin

    builtin
	actualcount,
	actualparameter;

    if actualcount () neq 2 then return $CEX_FATAL_ERROR (MCB$_PARAMETER_ERROR);

    begin

    local
	SLT : ref block [SLT$K_LENGTH] field ($CEX_SLTFIELDS);

    if (SLT = FIND_LINE (actualparameter (1))) eqla 0 then return $CEX_FATAL_ERROR (CE$LIX);

    begin

    local
	BUF : ref vector [3],
	DDM_PROCESS : ref block [PDT$K_LENGTH] field ($CEX_PDTFIELDS),
	DLC_PROCESS : ref block [PDT$K_LENGTH] field ($CEX_PDTFIELDS),
	LLC_PROCESS : ref block [PDT$K_LENGTH] field ($CEX_PDTFIELDS);

    BUF = actualparameter (2);

    if (LLC_PROCESS = .BUF [0]) nequ 0
    then

	if .LLC_PROCESS gequ .CEX$GH_PROCESS_COUNT
	then
	    return $CEX_FATAL_ERROR (CE$PIX);

    if (LLC_PROCESS = .CEX$AA_PROCESS_TABLE [.LLC_PROCESS]) eqla 0
    then
	return $CEX_FATAL_ERROR (CE$PIX);

    if (DLC_PROCESS = .BUF [1]) nequ 0
    then

	if .DLC_PROCESS gequ .CEX$GH_PROCESS_COUNT
	then
	    return $CEX_FATAL_ERROR (CE$PIX);

    if (DLC_PROCESS = .CEX$AA_PROCESS_TABLE [.DLC_PROCESS]) eqla 0
    then
	return $CEX_FATAL_ERROR (CE$PIX);

    if (DDM_PROCESS = .BUF [2]) nequ 0
    then

	if .DDM_PROCESS gequ .CEX$GH_PROCESS_COUNT
	then
	    return $CEX_FATAL_ERROR (CE$PIX);

    if (DDM_PROCESS = .CEX$AA_PROCESS_TABLE [.DDM_PROCESS]) eqla 0
    then
	return $CEX_FATAL_ERROR (CE$PIX);

    SLT [SLT$B_LLC_PROCESS_INDEX] = .LLC_PROCESS [PDT$B_INDEX];
    SLT [SLT$B_DLC_PROCESS_INDEX] = .DLC_PROCESS [PDT$B_INDEX];
    SLT [SLT$B_DDM_PROCESS_INDEX] = .DDM_PROCESS [PDT$B_INDEX];
    end;
    end;
    MCB$_NORMAL
    end;				!of routine CEX$$SET_LINE_PROCESSES
global routine CEX$$SET_PROCESS : CALL$ =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin

    builtin
	actualcount,
	actualparameter;

    if actualcount () lss 1 or actualcount () gtr 2
    then
	return $CEX_FATAL_ERROR (MCB$_PARAMETER_ERROR);

    actualparameter (1) = 0;
    begin

    local
	PDT : ref vector;

    PDT = CEX$AA_PROCESS_TABLE [0];

    do
	begin

	if .PDT [0] eqla 0
	then
	    begin

	    local
		BIAS;

	    BIAS = .CEX$GA_CURRENT_PROCESS [PDT$W_CODE_BIAS];

	    if actualcount () eql 2
	    then
		begin

		local
		    PCB : ref block field (PCB_FIELDS),
		    PCB_NAME : vector [2];

		PCB_NAME [0] = %rad50_11 'NT.';
		PCB_NAME [1] = actualparameter (2);

		if (PCB = FIND_PARTITION (PCB_NAME)) eqla 0
		then
		    return $CEX_FATAL_ERROR (CE$ACV);

		BIAS = .PCB [P_REL];
		end;

	    begin

	    local
		PDB : ref block [PDT$K_LENGTH - 1] field ($CEX_PDTFIELDS);

	    if not $RSX_GET_DSR ((PDT$K_LENGTH - 1)*%upval, PDB)
	    then
		return $CEX_FATAL_ERROR (CE$RES);

	    begin
	    $CEX_PHDDEF

	    bind
		HEADER = %o'140000' : block field ($CEX_PHDFIELDS);

	    local
		SAVE_MAP;

	    SMAP$ (SAVE_MAP);
	    MAP$ (.BIAS);
	    PDB [PDT$W_CODE_BIAS] = .BIAS;
	    PDB [PDT$A_CODE_DISPATCH] = .HEADER [PHD$A_LLC_TABLE];
	    MAP$ (.SAVE_MAP);
	    end;
	    PDB [PDT$W_DATA_BIAS] = 0;
	    PDB [PDT$A_DATA_ADDRESS] = 0;
	    PDB [PDT$B_INDEX] = actualparameter (1) =
		%if %upval eql 1
		%then (.PDT - CEX$AA_PROCESS_TABLE [0])
		%else %if %upval eql 2
		%then (.PDT - CEX$AA_PROCESS_TABLE [0])^-1
		%else %if %upval eql 4
		%then (.PDT - CEX$AA_PROCESS_TABLE [0])^-2
		%else (.PDT - CEX$AA_PROCESS_TABLE [0])/%upval
		%fi %fi %fi;
	    PDB [PDT$V_FLAGS] = 0;
	    PDT [0] = .PDB;
	    end;
	    PDT = PDT [1];

	    if .PDT gtra .CEX$GA_PROCESS_TABLE_END
	    then
		CEX$GA_PROCESS_TABLE_END = .PDT;

	    return MCB$_NORMAL;
	    end;

	end
    while (PDT = PDT [1]) lssa CEX$GA_PROCESS_TABLE_END;

    end;
    return $CEX_FATAL_ERROR (CE$RES)
    end;				!of routine CEX$$SET_PROCESS
global routine CEX$$SET_PROCESS_NAME : CALL$ =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin

    builtin
	actualcount,
	actualparameter;

    if actualcount () neq 1 then return $CEX_FATAL_ERROR (MCB$_PARAMETER_ERROR);

    begin

    local
	NAME_ENTRY : ref block [PNM$K_LENGTH] field ($CEX_PNMFIELDS);

    if FIND_PROCESS_NAME (actualparameter (1)) neqa 0 then return MCB$_BUSY_NAME;

    if (NAME_ENTRY = FIND_PROCESS_NAME (0)) eqla 0 then return CE$RES;

    NAME_ENTRY [PNM$W_NAME] = actualparameter (1);
    NAME_ENTRY [PNM$A_PROCESS] = .CEX$GA_CURRENT_PROCESS;
    end;
    MCB$_NORMAL
    end;				!of routine CEX$$SET_PROCESS_NAME
global routine CEX$$SET_VECTOR : CALL$ =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin

    builtin
	actualcount,
	actualparameter;

    if actualcount () neq 3 then return $CEX_FATAL_ERROR (MCB$_PARAMETER_ERROR);

    begin

    local
	DSP,
	ITB : ref block [ITB$K_LENGTH] field ($CEX_ITBFIELDS),
	PRI,
	VEC : ref vector [2];

    external
	%name ('$NONSI'),
	%name ('V$$CTR');

    VEC = actualparameter (1);

    if .VEC geqa %name ('V$$CTR') or .VEC <0, 2> neq 0
    then
	return $CEX_FATAL_ERROR (CE$VEC);

    if .VEC [0] neqa %name ('$NONSI')
    then
	return $CEX_FATAL_ERROR (CE$VCU);

    if (DSP = actualparameter (2)) lssa %o'120000' or .DSP gtra %o'140000'
    then
	return $CEX_FATAL_ERROR (CE$DSP);

    if (PRI = actualparameter (3) - 4) gtru 7 - 4
    then
	return $CEX_FATAL_ERROR (CE$PRI);

    if not $RSX_GET_DSR (ITB$K_LENGTH*%upval, ITB)
    then
	return $CEX_FATAL_ERROR (CE$RES);

    ITB [ITB$W_JSR_5_INSTRUCTION] = %o'4537';
    ITB [ITB$A_JSR_5_ADDRESS] = .INTERRUPT_PRIORITY_BLOCK [.PRI];
    ITB [ITB$A_PROCESS] = .CEX$GA_CURRENT_PROCESS;
    ITB [ITB$A_DISPATCH] = .DSP;
    VEC [0] = ITB [ITB$V_JSR_5];
    end;
    MCB$_NORMAL
    end;				!of routine CEX$$SET_VECTOR
routine ALLOCATE_BUFFERS (BLKS) : LINKAGE_BLKS =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin

    local
	BIAS;

    BIAS = 0;

    if %(not)% CEX$$ALLOCATE_CORE (.BLKS) then return .BIAS;

    SMAP$ (BIAS);
    .BIAS
    end;					!of routine ALLOCATE_BUFFERS
routine ALLOCATE_BUFFER_POOL (BFP) : LINKAGE_ADR novalue =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin

    map
	BFP : ref block [BFP$K_LENGTH] field ($CEX_BFPFIELDS);

    local
	BIAS,
	COUNT;

    if (COUNT = .BFP [BFP$H_ALLOCATION_MAXIMUM]) leq 0 then return;

    begin

    local
	BLKS;

    begin

    local
	HIGH;

    CEX$$MULTIPLY_32 (.COUNT, (BFH$K_LENGTH*%upval) + .BFP [BFP$H_SIZE]; BLKS, HIGH);
    CEX$$ADD_32 (%o'77', .BLKS, .HIGH; BLKS, HIGH);
    CEX$$SHIFT_32 (-6, .BLKS, .HIGH; BLKS, HIGH);
    end;

    if (BIAS = ALLOCATE_BUFFERS (.BLKS)) eql 0 then return;

    BFP [BFP$W_ALLOCATED_BIAS] = .BIAS;
    BFP [BFP$W_ALLOCATED_BLKS] = .BLKS;
    end;
    BFP [BFP$H_ALLOCATED] = .COUNT;
    begin

    local
	ADDRESS : ref block [BFH$K_LENGTH] field ($CEX_BFHFIELDS);

    ADDRESS = %o'140000';

    do
	begin
	BFP [BFP$H_FREE_COUNT] = .BFP [BFP$H_FREE_COUNT] + 1;
	begin

	bind
	    LAST = .BFP [BFP$A_QUEUE_LAST_ADDR] : block field ($CEX_BFHFIELDS);

	MAP$ (.BFP [BFP$W_QUEUE_LAST_BIAS]);
	LAST [BFH$W_BIAS] = .BIAS;
	LAST [BFH$A_ADDRESS] = .ADDRESS;
	end;
	BFP [BFP$W_QUEUE_LAST_BIAS] = .BIAS;
	BFP [BFP$A_QUEUE_LAST_ADDR] = .ADDRESS;
	MAP$ (.BIAS);
	ADDRESS [BFH$W_BIAS] = 0;
	ADDRESS [BFH$A_ADDRESS] = 0;
	ADDRESS [BFH$H_SIZE] = 0;
	ADDRESS [BFH$A_PROCESS] = 0;
	ADDRESS = vector [.ADDRESS, BFH$K_LENGTH]; %(force auto-increment)%
	ADDRESS = .ADDRESS + .BFP [BFP$H_SIZE];
	BIAS = .BIAS + .ADDRESS <6, 7>;
	ADDRESS <6, 7> = 0;
	end
    while (COUNT = .COUNT - 1) neq 0;

    end;
    end;				!of routine ALLOCATE_BUFFER_POOL
routine ALLOCATE_CCB_AND_BUFFER_POOL (CBP) : LINKAGE_ADR novalue =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin

    map
	CBP : ref block [CBP$K_LENGTH] field ($CEX_CBPFIELDS);

    local
	ADDR : ref vector,
	BIAS,
	COUNT;

    if (COUNT = .CBP [CBP$H_ALLOCATION_MAXIMUM]) leq 0 then return;

    BIAS = 0;

    if .CBP [CBP$H_SIZE] neq 0
    then
	begin

	local
	    BLKS;

	begin

	local
	    HIGH;

	CEX$$MULTIPLY_32 (.COUNT, .CBP [CBP$H_SIZE]; BLKS, HIGH);
	CEX$$ADD_32 (%o'77', .BLKS, .HIGH; BLKS, HIGH);
	CEX$$SHIFT_32 (-6, .BLKS, .HIGH; BLKS, HIGH);
	end;

	if (BIAS = ALLOCATE_BUFFERS (.BLKS)) eql 0
	then
	    signal (CE$RBA);

	CBP [CBP$W_ALLOCATED_BIAS] = .BIAS;
	CBP [CBP$W_ALLOCATED_BLKS] = .BLKS;
	end;

    begin

    local
	LENGTH;

    if not $RSX_GET_DSR (CCB$K_LENGTH*%upval*.COUNT, ADDR, LENGTH)
    then
	signal (CE$CBA);

    CBP [CBP$A_ALLOCATED_ADDRESS] = .ADDR;
    CBP [CBP$W_ALLOCATED_LENGTH] = .LENGTH;
    end;
    CBP [CBP$H_ALLOCATED] = .COUNT;
    begin

    local
	ADDRESS : ref vector;

    ADDRESS = (if .BIAS neq 0 then %o'140000' else 0);

    do
	begin

	local
	    CCB : ref block [CCB$K_LENGTH] field ($CEX_CCBFIELDS);

	CCB = .ADDR;

	decr TEMP from CCB$K_LENGTH to 1 do
	    begin
	    ADDR [0] = 0;
	    ADDR = ADDR [1]; %(force auto-increment)%
	    end;

	if .CBP [CBP$H_SIZE] neq 0
	then
	    begin
	    CCB [CCB$W_BIAS] = .BIAS;
	    CCB [CCB$A_ADDRESS] = .ADDRESS;
	    CCB [CCB$V_RDB] = TRUE;
	    ADDRESS = .ADDRESS + .CBP [CBP$H_SIZE];
	    BIAS = .BIAS + .ADDRESS <6, 7>;
	    ADDRESS <6, 7> = 0;
	    end;

	CBP [CBP$H_FREE_COUNT] = .CBP [CBP$H_FREE_COUNT] + 1;
	begin

	bind
	    LAST = .CBP [CBP$A_QUEUE_LAST] : block field ($CEX_CCBFIELDS);

	LAST [CCB$A_LINK] = .CCB;
	end;
	CBP [CBP$A_QUEUE_LAST] = .CCB;
	end
    while (COUNT = .COUNT - 1) neq 0;

    end;
    end;				!of routine ALLOCATE_CCB_AND_BUFFER_POOL
routine CECLK (TIMER_BLOCK) : RSX_CLK novalue =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin

    map
	TIMER_BLOCK : ref block [TMB$K_LENGTH] field ($CEX_TMBFIELDS);

    CEX$$ENTER_CEX ();
    CEX$GW_SHORT_TIMER_COUNT = .CEX$GW_SHORT_TIMER_COUNT + 1;

    if .CEX$GW_SHORT_TIMER_COUNT eql 0
    then
	CEX$GW_SHORT_TIMER_COUNT = .CEX$GW_SHORT_TIMER_COUNT - 1;

    CEX$$DISPATCH_PROCESS (.TIMER_BLOCK [TMB$A_PROCESS], FC_TIM, FM_STM);
    SCHEDULE ();
    CEX$$EXIT_CEX ();
    end;				!of routine CECLK
routine CEFRK (FORK_BLOCK) : RSX_FRK novalue =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin
    CEX$$ENTER_CEX ();
    CEX$GA_CEX_FORK_BLOCK = .FORK_BLOCK;
    SCHEDULE ();
    CEX$$EXIT_CEX ();
    end;				!of routine CEFRK
routine CENOP : RSX_UCB novalue =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin
    NO_OPERATION
    end;				!of routine CENOP
routine CEPWF (UCB, SCB) : RSX_UCB_SCB novalue =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin

    map
	SCB : ref block field (SCB_FIELDS),
	UCB : ref block field (UCB_FIELDS);

    UCB [US_BSY] = TRUE;
    SCB [S_CTM] = 1;
    SCB = SCB [$SUB_FIELD (S_FRK, 1, 0, 16, 0)];
    begin

    map
	SCB : ref vector;

    external
	KISAR5;

    SCB [0] = CEFRK;
    SCB [2] = SCB [0];
    SCB [3] = .KISAR5;
    CEX$GA_CEX_FORK_BLOCK = .SCB;
    end;
%if CEX$CFG_UNIBUS_MAPPING
%then
    INITIALIZE_UNIBUS_MAPPING ();
%fi
    CEX$$ENTER_CEX ();
    begin

    local
	MODIFIER;

    MODIFIER = FM_PWF;

    if (CEX$GG_POWER_FAIL_COUNT = .CEX$GG_POWER_FAIL_COUNT + 1) eql 0
    then
	begin
	MODIFIER = FM_PIN;
	INITIALIZE_CEXCOM_DATA (.UCB);
	end;

    begin

    local
	PDT : ref vector;

    PDT = CEX$AA_PROCESS_TABLE [0];

    do
	begin

	local
	    PROCESS : ref block [PDT$K_LENGTH] field ($CEX_PDTFIELDS);

	if (PROCESS = .PDT [0]) neq 0
	then
	    CEX$$DISPATCH_PROCESS (.PROCESS, FC_SYS, .MODIFIER);

	end
    while (PDT = PDT [1]) lssa .CEX$GA_PROCESS_TABLE_END;

    end;
    end;
    SCHEDULE ();
    CEX$$EXIT_CEX ();
   end;				!of routine CEPWF
routine CETIM (UCB, SCB) : RSX_UCB_SCB novalue =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin

    map
	SCB : ref block field (SCB_FIELDS),
	UCB : ref block field (UCB_FIELDS);

    SCB [S_CTM] = .SCB [S_CTM] + 1;
    CEX$$ENTER_CEX ();
    begin

    local
	PDT : ref vector;

    PDT = CEX$AA_PROCESS_TABLE [0];

    do
	begin

	local
	    PROCESS : ref block [PDT$K_LENGTH] field ($CEX_PDTFIELDS);

	if (PROCESS = .PDT [0]) neq 0
	then
	    begin

	    if .PROCESS [PDT$V_LONG_TIMER]
	    then
		begin

		field
		    TIMER = [0, 0, 8, 0];

		bind
		    DB = PROCESS [PDT$A_DATA_ADDRESS] : ref block field (TIMER);

		MAP$ (.PROCESS [PDT$W_DATA_BIAS]);

		if .DB [TIMER] nequ 0
		then
		    begin
		    DB [TIMER] = .DB [TIMER] - 1;

		    if .DB [TIMER] eqlu 0
		    then
			begin
			CEX$GW_LONG_TIMER_COUNT = .CEX$GW_LONG_TIMER_COUNT + 1;

			if .CEX$GW_LONG_TIMER_COUNT eql 0
			then
			    CEX$GW_LONG_TIMER_COUNT = .CEX$GW_LONG_TIMER_COUNT - 1;

			CEX$$DISPATCH_PROCESS (.PROCESS, FC_TIM, FM_LTM);
			end;

		    end;

		end;

	    end;

	end
    while (PDT = PDT [1]) lssa .CEX$GA_PROCESS_TABLE_END;

    end;

    if .CEX$GW_STATISTICS_TIMER neq 0
    then
	begin
	CEX$GW_STATISTICS_TIMER = .CEX$GW_STATISTICS_TIMER - 1;

	if .CEX$GW_STATISTICS_TIMER eql 0
	then
	    begin
	    $MCB_DISABLE_INTERRUPT (VEC$AA_ADDRESS_ERROR);
	    begin

	    local
		INTERRUPTS : initial (0);

	    incra IPBA from INTERRUPT_PRIORITY_BLOCK [4 - 4]
		       to INTERRUPT_PRIORITY_BLOCK [7 - 4]
		        by %upval do
		begin

		builtin
		    ROT;

		bind
		    IPB = ..IPBA : block [IPB$K_LENGTH] field ($CEX_IPBFIELDS);

		if ROT (INTERRUPTS = .INTERRUPTS + .IPB [IPB$W_COUNT], 1)
		then
		    INTERRUPTS = -1;

		IPB [IPB$W_COUNT] = 0;
		end;

	    if .CEX$GW_AVG_INTERRUPTS lssu .INTERRUPTS
	    then
		CEX$GW_AVG_INTERRUPTS = .INTERRUPTS;

	    end;

	    if .CEX$GW_AVG_SYNCHS lssu .CEX$GW_SYNCH_COUNT
	    then
		CEX$GW_AVG_SYNCHS = .CEX$GW_SYNCH_COUNT;

	    if .CEX$GW_AVG_SHORT_TIMERS lssu .CEX$GW_SHORT_TIMER_COUNT
	    then
		CEX$GW_AVG_SHORT_TIMERS = .CEX$GW_SHORT_TIMER_COUNT;

	    if .CEX$GW_AVG_LONG_TIMERS lssu .CEX$GW_LONG_TIMER_COUNT
	    then
		CEX$GW_AVG_LONG_TIMERS = .CEX$GW_LONG_TIMER_COUNT;

	    if .CEX$GW_AVG_CCB_DISPATCHES lssu .CEX$GW_CCB_DISPATCH_COUNT
	    then
		CEX$GW_AVG_CCB_DISPATCHES = .CEX$GW_CCB_DISPATCH_COUNT;

	    CEX$GW_SYNCH_COUNT = 0;
	    CEX$GW_SHORT_TIMER_COUNT = 0;
	    CEX$GW_LONG_TIMER_COUNT = 0;
	    CEX$GW_CCB_DISPATCH_COUNT = 0;
	    $MCB_ENABLE_INTERRUPT (VEC$AA_ADDRESS_ERROR);
	    CEX$GW_STATISTICS_TIMER = .CEX$GW_STATISTICS_INTERVAL;
	    end;

	end;

    SCHEDULE ();
    CEX$$EXIT_CEX ();
    end;				!of routine CETIM
routine CHECK_BUFFER_ALLOCATIONS : novalue =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin

    local
	BLKS_AVAILABLE;

    label
	RECONCILIATION;

    begin

    local
	SAVE_MAP;

    BLKS_AVAILABLE = 0;
    SMAP$ (SAVE_MAP);

    if MAP$ (.CEX$GW_BLOCK_POOL_BIAS) nequ 0
    then
	BLKS_AVAILABLE = .BKP$H_SIZE;

    MAP$ (.SAVE_MAP);
    end;

    while TRUE do RECONCILIATION :
	begin

	local
	    BLKS_LEFT;

	BLKS_LEFT = .BLKS_AVAILABLE;
	begin

	local
	    BLKS,
	    HIGH;

	CEX$$MULTIPLY_32 (.CEX$GR_RDB_POOL [CBP$H_ALLOCATION_MAXIMUM], .CEX$GR_RDB_POOL [CBP$H_SIZE]; BLKS, HIGH);
	CEX$$ADD_32 (%o'77', .BLKS, .HIGH; BLKS, HIGH);
	CEX$$SHIFT_32 (-6, .BLKS, .HIGH; BLKS, HIGH);
	BLKS_LEFT = .BLKS_LEFT - .BLKS;
	end;
	begin

	local
	    BFP : ref block [BFP$K_LENGTH] field ($CEX_BFPFIELDS);

	BFP = .CEX$GA_BUFFER_POOL_TABLE;

	decru COUNT from .CEX$GH_BUFFER_POOL_COUNT to 1 do
	    begin

	    local
		HIGH,
		LOW;

	    CEX$$MULTIPLY_32 (.BFP [BFP$H_ALLOCATION_MAXIMUM], (BFH$K_LENGTH*%upval) + .BFP [BFP$H_SIZE]; LOW, HIGH);
	    CEX$$ADD_32 (%o'77', .LOW, .HIGH; LOW, HIGH);
	    CEX$$SHIFT_32 (-6, .LOW, .HIGH; LOW, HIGH);
	    BLKS_LEFT = .BLKS_LEFT - .LOW;
	    BFP = vector [.BFP, BFP$K_LENGTH];
	    end;

	end;

	if .BLKS_LEFT geq 0 then return;

	if .CEX$GR_RDB_POOL [CBP$H_ALLOCATION_MAXIMUM] gtr .CEX$GR_RDB_POOL [CBP$H_ALLOCATION_MINIMUM]
	then
	    begin
	    CEX$GR_RDB_POOL [CBP$H_ALLOCATION_MAXIMUM] = .CEX$GR_RDB_POOL [CBP$H_ALLOCATION_MAXIMUM] - 1;
	    BLKS_LEFT = 0;
	    end;

	begin

	local
	    BFP : ref block [BFP$K_LENGTH] field ($CEX_BFPFIELDS);

	BFP = .CEX$GA_BUFFER_POOL_TABLE;

	decru COUNT from .CEX$GH_BUFFER_POOL_COUNT to 1 do
	    begin

	    if .BFP [BFP$H_ALLOCATION_MAXIMUM] gtr .BFP [BFP$H_ALLOCATION_MINIMUM]
	    then
		begin
		BFP [BFP$H_ALLOCATION_MAXIMUM] = .BFP [BFP$H_ALLOCATION_MAXIMUM] - 1;
		BLKS_LEFT = 0;
		end;

	    BFP = vector [.BFP, BFP$K_LENGTH];
	    end;

	end;

	if .BLKS_LEFT lss 0 then return signal (CE$BFS);

	end;

    end;				!of routine CHECK_BUFFER_ALLOCATIONS
routine FIND_LINE (LINE_INDEX) : LINKAGE_FUNCTION =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin
    LINE_INDEX = .LINE_INDEX - 1;

    if .LINE_INDEX gequ .CEX$GH_SYSTEM_LINE_COUNT then return 0;

    CEX$GA_SYSTEM_LINE_TABLE [.LINE_INDEX, SLT$V_BASE]
    end;				!of routine FIND_LINE
routine FIND_PARTITION (NAME) : LINKAGE_FUNCTION =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin

    map
	NAME : ref vector [2];

    local
	PCB : ref block field (PCB_FIELDS);

    external
	%name ('$PARHD');

    PCB = .%name ('$PARHD');

    do
	begin

	bind
	    PNAME = PCB [P_NAM] : vector [2];

	if .NAME [0] eqlu .PNAME [0] and .NAME [1] eqlu .PNAME [1] then return .PCB;

	end
    while

	if .PCB [PS_SYS]
	then
	    begin

	    if .PCB [P_SUB] neqa 0
	    then
		begin
		PCB = .PCB [P_SUB];
		TRUE
		end
	    else
		begin
		PCB = .PCB [P_MAIN];
		(PCB = .PCB [P_LNK]) neqa 0
		end

	    end
	else
	    (PCB = .PCB [P_LNK]) neqa 0;

    0
    end;				!of routine FIND_PARTITION
routine FIND_PROCESS_NAME (NAME) : LINKAGE_FUNCTION =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin

    local
	NAME_ENTRY : ref block [PNM$K_LENGTH] field ($CEX_PNMFIELDS);

    NAME_ENTRY = .CEX$GA_PROCESS_NAME_TABLE;

    decru COUNT from .CEX$GH_PROCESS_COUNT to 1 do

	if .NAME_ENTRY [PNM$W_NAME] eql .NAME
	then
	    return .NAME_ENTRY [PNM$A_PROCESS]
	else
	    NAME_ENTRY = vector [.NAME_ENTRY, PNM$K_LENGTH];

    0
    end;				!of routine FIND_PROCESS_NAME
routine INITIALIZE_BLOCK_POOL =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin

    local
	BLKS,
	PCB : ref block field (PCB_FIELDS),
	SAVE_MAP,
	ZERO;

    external
	KISAR6,
	RSX$GW_SYSTEM_SIZE;

    if (PCB = FIND_PARTITION (UPLIT (%rad50_11 'CEXBUF'))) eqla 0
    then
	begin
	SIGNAL (CE$BFP);
	return FALSE;
	end;

    if not .PCB [PS_COM] or (.PCB [P_MAIN] neqa .PCB) or (.PCB [P_LNK] neqa 0)
    then
	begin
	SIGNAL (CE$BFI);
	return FALSE;
	end;

    BLKS = PCB [P_BLKS] = .RSX$GW_SYSTEM_SIZE - .PCB [P_REL] - 1;

    if .BLKS leq 0
    then
	begin
	SIGNAL (CE$BFS);
	return FALSE;
	end;

    SMAP$ (SAVE_MAP);
    MAP$ (CEX$GW_BLOCK_POOL_BIAS = .PCB [P_REL]);
    !
    ! The 11/34A does a read-modify-write on a CLR instruction,
    ! and thus is unsuitable to reset bad parity in memory.
    !
    ZERO = 0; %(this to cause a MOV instead of CLR instruction)%

    do
	begin

	local
	    ADDR : ref vector;

	ADDR = %o'140000';
	ADDR [4] = ADDR [3] = ADDR [2] = ADDR [1] = ADDR [0] = .ZERO;
	ADDR [9] = ADDR [8] = ADDR [7] = ADDR [6] = ADDR [5] = .ZERO;
	ADDR [14] = ADDR [13] = ADDR [12] = ADDR [11] = ADDR [10] = .ZERO;
	ADDR [19] = ADDR [18] = ADDR [17] = ADDR [16] = ADDR [15] = .ZERO;
	ADDR [24] = ADDR [23] = ADDR [22] = ADDR [21] = ADDR [20] = .ZERO;
	ADDR [29] = ADDR [28] = ADDR [27] = ADDR [26] = ADDR [25] = .ZERO;
	ADDR [31] = ADDR [30] = .ZERO;
	ADDR = ADDR [31]; %(to force auto-increment)%
	KISAR6 = .KISAR6 + 1;
	end
    while (BLKS = .BLKS - 1) neq 0;

    MAP$ (.PCB [P_REL]);
    BKP$W_LINK = 0;
    BKP$H_SIZE = .PCB [P_BLKS];
    MAP$ (.SAVE_MAP);
    TRUE
    end;				!of routine INITIALIZE_BLOCK_POOL
routine INITIALIZE_BUFFER_POOL (BFP, BFP_COUNT; NEW_BFP) : LINKAGE_ADR_CNT novalue =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin

    map
	BFP : ref block [BFP$K_LENGTH] field ($CEX_BFPFIELDS);

    CEX$GA_BUFFER_POOL_TABLE = .BFP;
    CEX$GH_BUFFER_POOL_COUNT = .BFP_COUNT;

    decru COUNT from .BFP_COUNT to 1 do
	begin
	BFP [BFP$H_SIZE] = .BFP [BFP$H_SIZE] + 1;
	BFP [$SUB_FIELD (BFP$H_SIZE, 0, 0, 1, 0)] = 0;
	BFP [BFP$A_QUEUE_LAST_ADDR] = BFP [BFP$W_QUEUE_FIRST_BIAS];
	BFP = vector [.BFP, BFP$K_LENGTH];
	end;

    NEW_BFP = .BFP;
    end;				!of routine INITIALIZE_BUFFER_POOL
routine INITIALIZE_CEXCOM_DATA (UCB) : RSX_UCB novalue =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin

    map
	UCB : ref block field (UCB_FIELDS);

    !
    ! Initialize CEX data
    !

    CEX$GA_SHORT_TIMER_DISPATCH = CECLK;
    UCB = UCB [$SUB_FIELD (U_CNT, 1, 0, 16, 0)];
    begin

    map
	UCB : ref vector;

    local
	BUF : ref vector [8];

    BUF = .UCB;
    UCB = UCB [9];
    CEX$GR_CCB_POOL [CBP$H_ALLOCATION_MINIMUM] = .BUF [0];
    CEX$GR_CCB_POOL [CBP$H_ALLOCATION_MAXIMUM] = .BUF [1];
    MCB$GW_RDB_SIZE = (.BUF [2] + 1) and not 1;
    CEX$GR_RDB_POOL [CBP$H_ALLOCATION_MINIMUM] = .BUF [3];
    CEX$GR_RDB_POOL [CBP$H_ALLOCATION_MAXIMUM] = .BUF [4];
    BUF = BUF [5];		%(force auto-increment)%
    INITIALIZE_PROCESS_DESCRIPTORS (.UCB, .BUF [0]; UCB);
    INITIALIZE_PROCESS_NAMES (.UCB, .BUF [1]; UCB);
    INITIALIZE_LINES (.UCB, .BUF [2]; UCB);
    INITIALIZE_DEVICE_NAMES (.UCB, .BUF [2]; UCB);
    INITIALIZE_BUFFER_POOL (.UCB, .BUF [3]; UCB);
    INITIALIZE_BLOCK_POOL ();
    BUF = BUF [4];		%(force auto-increment)%
    end;

    !
    ! Check DTE control
    !

    begin

    local
	NXM_SAVE;

    NXM_SAVE = .VEC$AA_ADDRESS_ERROR [0];
    VEC$AA_ADDRESS_ERROR [0] = NXM_CATCHER;
    begin

    literal
	DTE$K_LENGTH = 16;

    bind
	DR$A_DTE_REGISTERS = %o'174400' : block [DTE$K_LENGTH];

    local
	DTE_ADDRESS : ref block [DTE$K_LENGTH];

    DTE_ADDRESS = DR$A_DTE_REGISTERS;

    decru COUNT from 4 to 1 do

	if not NXM (.DTE_ADDRESS)
	then
	    begin
	    CEX$GA_DTE_BOOT_ROM_ADDRESS = %o'173000';
	    exitloop;
	    end
	else
	    DTE_ADDRESS = vector [.DTE_ADDRESS, DTE$K_LENGTH];

    end;
    VEC$AA_ADDRESS_ERROR [0] = .NXM_SAVE;
    end;
    CEX$GR_LAST_CHANCE_EXCEPTION [EXV$A_PROCESS] = .CEX$AA_PROCESS_TABLE [0];
    CEX$GR_LAST_CHANCE_EXCEPTION [EXV$A_DISPATCH] = LAST;
    CEX$GR_LAST_CHANCE_EXCEPTION [EXV$A_ENABLE_DATA] = 0;
    CEX$GR_DUMP_EXCEPTION [EXV$A_PROCESS] = .CEX$AA_PROCESS_TABLE [0];
    CEX$GR_DUMP_EXCEPTION [EXV$A_DISPATCH] = PANIC;

    !
    ! Determine dump process
    !

    begin

    local
	DEVICE : ref vector;

    bind
	DEVICE_LIST = uplit ('XM', %rad50_11 'NT.XMD', 0) : vector;

    DEVICE = DEVICE_LIST [0];

    while .DEVICE [0] neq 0 do
	begin

	external
	    RSX$GW_SYSTEM_SIZE : vector;

	if .RSX$GW_SYSTEM_SIZE [3] eqlu .DEVICE [0]
	then
	    begin

	    local
		PCB : ref block field (PCB_FIELDS);
	
	    DEVICE = DEVICE [1];

	    if (PCB = FIND_PARTITION (.DEVICE)) neqa 0
	    then
		CEX$GR_DUMP_EXCEPTION [EXV$A_ENABLE_DATA] = .PCB [P_REL];

	    exitloop;
	    end
	else
	    DEVICE = DEVICE [3];

	end;

    end;
    begin

    local
	PS_SAVE;

    external
	PS;

    PS_SAVE = .PS;
    PS <0, 8> = 7^5;

    !
    ! Set traps
    !

    begin

    local
	TRAP : ref vector;

    bind
	TRAPS = uplit (
	    CEX$$ADDRESS_ERROR_TRAP, VEC$AA_ADDRESS_ERROR [0],
	    CEX$$ILLEGAL_INSTRUCTION_TRAP, VEC$AA_ILLEGAL_INSTRUCTION [0],
	    CEX$$BREAKPOINT_TRAP, VEC$AA_BREAKPOINT [0],
	    CEX$$IOT_INSTRUCTION_TRAP, VEC$AA_IOT_INSTRUCTION [0],
	    CEX$$POWER_FAILURE_TRAP, VEC$AA_POWER_FAILURE [0],
	    CEX$$EMT_INSTRUCTION_TRAP, VEC$AA_EMT_INSTRUCTION [0],
	    CEX$$TRAP_INSTRUCTION_TRAP, VEC$AA_TRAP_INSTRUCTION [0],
	    CEX$$PARITY_ERROR_TRAP, VEC$AA_PARITY_ERROR [0],
	    CEX$$SEGMENT_FAULT_TRAP, VEC$AA_SEGMENT_FAULT [0],
	    0) : vector;

    TRAP = TRAPS [0];

    do
	begin
	.TRAP [1] = .TRAP [0];
	TRAP = TRAP [2];
	end
    while .TRAP [0] neq 0;

    end;

    !
    ! Randomize
    !

    begin

    field
	MONITOR = [0, 7, 1, 1];

    local
	SEED0, SEED1;

    external
	%name ('$CKCSR') : ref block field (MONITOR);

    SEED0 = .CEX$AW_RANDOM_NUMBER_SEED [0];
    SEED1 = .CEX$AW_RANDOM_NUMBER_SEED [1];

    do
	begin

	builtin
	    ROT;

	if ROT (SEED0 = .SEED0^1, 1)
	then
	    SEED1 = .SEED1 + 1;

	if ROT (SEED1 = .SEED1^1, 1)
	then
	    SEED0 = .SEED0 + 1;

	end
    while not .%name ('$CKCSR') [MONITOR];

    CEX$AW_RANDOM_NUMBER_SEED [1] = .SEED1;
    CEX$AW_RANDOM_NUMBER_SEED [0] = .SEED0;

    end;
    PS <0, 8> = .PS_SAVE;
    end;

    !
    ! Allocate buffers
    !

    CHECK_BUFFER_ALLOCATIONS ();
    ALLOCATE_CCB_AND_BUFFER_POOL (CEX$GR_CCB_POOL);
    ALLOCATE_CCB_AND_BUFFER_POOL (CEX$GR_RDB_POOL);
    begin

    local
	BFP : ref block [BFP$K_LENGTH] field ($CEX_BFPFIELDS);

    BFP = .CEX$GA_BUFFER_POOL_TABLE;

    decru COUNT from .CEX$GH_BUFFER_POOL_COUNT to 1 do
	begin
	ALLOCATE_BUFFER_POOL (.BFP);
	BFP = vector [.BFP, BFP$K_LENGTH];
	end;

    end;

    !
    ! Allocate common event logging buffer
    !

    begin

    local
	BUF,
	LEN;

    if $RSX_GET_DSR (100, BUF, LEN)
    then
	begin
	LEN = .LEN - 1;
	ch$wchar_a (.LEN, BUF);
	MCB$GA_LOGGING_BUFFER = .BUF;
	end;

    end;

    !
    ! Start stastics gathering
    !

    if .CEX$GW_STATISTICS_INTERVAL eql 0
    then
	CEX$GW_STATISTICS_INTERVAL = .CEX$GW_STATISTICS_INTERVAL + 1;

    CEX$GW_STATISTICS_TIMER = .CEX$GW_STATISTICS_INTERVAL;
    end;				!of routine INITIALIZE_CEXCOM_DATA
routine INITIALIZE_DEVICE_NAMES (NAM, SLT_COUNT; NEW_NAM) : LINKAGE_ADR_CNT novalue =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin

    local
	SLT : ref block [SLT$K_LENGTH] field ($CEX_SLTFIELDS);

    SLT = .CEX$GA_SYSTEM_LINE_TABLE;

    decru COUNT from .SLT_COUNT to 1 do
	begin
	SLT [SLT$A_DEVICE] = .NAM;
	NAM = ch$plus (ch$rchar_a (NAM), .NAM);
	SLT = vector [.SLT, SLT$K_LENGTH];
	end;

    NAM = .NAM + 1;
    NAM <0, 1> = 0;
    NEW_NAM = .NAM;
    end;				!of routine INITIALIZE_DEVICE_NAMES
routine INITIALIZE_LINES (SLT, SLT_COUNT; NEW_SLT) : LINKAGE_ADR_CNT novalue =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin

    map
	SLT : ref block [SLT$K_LENGTH] field ($CEX_SLTFIELDS);

    CEX$GA_SYSTEM_LINE_TABLE = .SLT;
    CEX$GH_SYSTEM_LINE_COUNT = .SLT_COUNT;

    decru COUNT from .SLT_COUNT to 1 do
	begin

	local
	    INDEX;

	if (INDEX = .SLT [SLT$B_LLC_PROCESS_INDEX]) nequ 0
	then

	    if .CEX$AA_PROCESS_TABLE [.INDEX] eqla 0
	    then
		SLT [SLT$B_LLC_PROCESS_INDEX] = 0;

	if (INDEX = .SLT [SLT$B_DLC_PROCESS_INDEX]) nequ 0
	then

	    if .CEX$AA_PROCESS_TABLE [.INDEX] eqla 0
	    then
		SLT [SLT$B_DLC_PROCESS_INDEX] = 0;

	if (INDEX = .SLT [SLT$B_DDM_PROCESS_INDEX]) nequ 0
	then

	    if .CEX$AA_PROCESS_TABLE [.INDEX] eqla 0
	    then
		SLT [SLT$B_DDM_PROCESS_INDEX] = 0;

	SLT = vector [.SLT, SLT$K_LENGTH];
	end;

    NEW_SLT = .SLT;
    end;				!of routine INITIALIZE_LINES
routine INITIALIZE_PROCESS_DESCRIPTORS (PDB, PDB_COUNT; NEW_PDB) : LINKAGE_ADR_CNT novalue =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin

    map
	PDB : ref block [PDT$K_LENGTH] field ($CEX_PDTFIELDS);

    label
	ASSIGN_PDB;

    decru COUNT from .PDB_COUNT to 1 do
	begin
	ASSIGN_PDB: begin
	$CEX_PHDDEF

	bind
	    HEADER = %o'140000' : block field ($CEX_PHDFIELDS);

	begin

	local
	    PCB : ref block field (PCB_FIELDS);

	begin

	local
	    PCB_NAME : vector [2];

	PCB_NAME [1] = .PDB [PDT$W_CODE_NAME];
	PCB_NAME [0] = %rad50_11 'NT.';

	if (PCB = FIND_PARTITION (PCB_NAME)) eqla 0 then leave ASSIGN_PDB;

	end;
	MAP$ (PDB [PDT$W_CODE_BIAS] = .PCB [P_REL]);
	HEADER [PHD$W_BLKS] = .PCB [P_BLKS];
	end;
	begin

	external
	    CEXVER : vector [2];

	if .CEXVER [0] neq .HEADER [PHD$W_CEX_IDENT_1] or
	   .CEXVER [1] neq .HEADER [PHD$W_CEX_IDENT_2] then leave ASSIGN_PDB;

	end;
	PDB [PDT$V_PERMANENT] = TRUE;
	begin

	local
	    DISPATCH;

	external
	    %name ('.DSPCR');

	if (DISPATCH = .PDB [PDT$A_DISPATCH_ADDRESS_ADDRESS]) eqla 0
	then
	    DISPATCH = %name ('.DSPCR')
	else

	    if (DISPATCH = .(.DISPATCH + %o'20000')) eqla 0
	    then
		DISPATCH = %name ('.DSPCR');

	PDB [PDT$A_CODE_DISPATCH] = .DISPATCH;
	end;

	if .PDB [PDT$V_DATA_BASE_INCLUDED] and (.PDB [PDT$A_DATA_ADDRESS] eqla 0)
	then
	    leave ASSIGN_PDB;

	if .PDB [PDT$V_UCB_INCLUDED]
	then
	    begin

	    local
		UCB : ref block field (UCB_FIELDS);

	    if (UCB = .PDB [PDT$A_UCB]) eqla 0
	    then
		leave ASSIGN_PDB;

	    UCB [U_CW2] = .PDB [PDT$B_INDEX];

	    if .HEADER [PHD$V_RSX_TABLE_INCLUDED]
	    then
		begin

		bind
		    DCB = .UCB [U_DCB] : block field (DCB_FIELDS);

		DCB [D_DSP] = .HEADER [PHD$A_RSX_TABLE];
		end;

	    end;

	begin

	local
	    PDT : ref vector;

	if (PDT = .PDB [PDT$B_INDEX]) gequ .CEX$GH_PROCESS_COUNT
	then
	    leave ASSIGN_PDB;

	PDT = CEX$AA_PROCESS_TABLE [.PDT];
	PDT [0] = .PDB;
	PDT = PDT [1];

	if .PDT gtra .CEX$GA_PROCESS_TABLE_END
	then
	    CEX$GA_PROCESS_TABLE_END = .PDT;

	end;
	end;

	if not .PDB [PDT$V_UCB_INCLUDED]
	then
	    PDB = PDB [PDT$A_UCB]
	else
	    PDB = vector [.PDB, PDT$K_LENGTH];

	end;

    NEW_PDB = .PDB;
    end;				!of routine INITIALIZE_PROCESS_DESCRIPTORS
routine INITIALIZE_PROCESS_NAMES (PNM, PNM_COUNT; NEW_PNM) : LINKAGE_ADR_CNT novalue =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin

    map
	PNM : ref block [PNM$K_LENGTH] field ($CEX_PNMFIELDS);

    CEX$GA_PROCESS_NAME_TABLE = .PNM;
    CEX$GH_PROCESS_NAME_COUNT = .PNM_COUNT;

    decru COUNT from .PNM_COUNT to 1 do
	begin

	local
	    INDEX;

	INDEX = .PNM [PNM$W_PROCESS_INDEX];

	if .INDEX gequ .CEX$GH_PROCESS_COUNT
	then
	    PNM [PNM$W_NAME] = PNM [PNM$A_PROCESS] = 0
	else

	    if (PNM [PNM$A_PROCESS] = .CEX$AA_PROCESS_TABLE [.INDEX]) eqla 0
	    then
		PNM [PNM$W_NAME] = 0;

	PNM = vector [.PNM, PNM$K_LENGTH];
	end;

    NEW_PNM = .PNM
    end;				!of routine INITIALIZE_PROCESS_NAMES
routine INITIALIZE_UNIBUS_MAPPING : novalue  =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin
%if CEX$CFG_UNIBUS_MAPPING
%then

    local
        UBM_DATA_BASE : block [UBM$K_LENGTH] field ($CEX_UBMFIELDS);

    external
        UBMPR : vector [31*2],
        RSX$GW_SYSTEM_SIZE,
	%name ('$EXSIZ'),
        %name ('$PARHD');

    if not UBM_MAPPING then return;

    UBM_DATA_BASE [UBM$A_LINK] = 0;
    UBM_DATA_BASE [UBM$W_START_BLK] = %o'0000';
    UBM_DATA_BASE [UBM$W_END_BLK] = .%name ('$EXSIZ')^-6;
    RSX$GW_SYSTEM_SIZE = %o'20000'; %(temporary for SYS880)%
    begin

    local
        PCB : ref block field (PCB_FIELDS),
        UBM : ref block field ($CEX_UBMFIELDS);

    label
	PCB_BAD,
	PCB_GOOD;

    UBM = UBM_DATA_BASE;
    PCB = .%name ('$PARHD');

    do				! Sloppy PCB checks
        PCB_BAD : begin
	PCB_GOOD : begin

	bind
	    PNAME = PCB [P_NAM] : vector [2];

        if .PNAME [0] eqlu %rad50_11 'NT.' then leave PCB_BAD;

	if .PCB [P_TCB] neq 0 then leave PCB_GOOD;

	if .PCB [PS_SYS] and (.PCB eqla .PCB [P_MAIN]) then leave PCB_BAD;

	end;

        if .PCB [P_REL] nequ .UBM [UBM$W_END_BLK]
        then
            begin

	    local
		NEW_UBM : ref block field ($CEX_UBMFIELDS);

            if not $RSX_GET_DSR (UBM$K_LENGTH*%upval, NEW_UBM) then return;

	    UBM [UBM$A_LINK] = .NEW_UBM;
            NEW_UBM [UBM$A_LINK] = 0;
            NEW_UBM [UBM$W_START_BLK] = .PCB [P_REL];
            NEW_UBM [UBM$W_END_BLK] = .PCB [P_REL];
	    NEW_UBM [UBM$B_BASE_UBMR] = 0;
	    NEW_UBM = NEW_UBM [UBM$B_BASE_UBMR]; %(force auto-increment)%
	    UBM = .UBM [UBM$A_LINK];
            end;

	UBM [UBM$W_END_BLK] = .UBM [UBM$W_END_BLK] + .PCB [P_BLKS];
        end
    while

	if .PCB [PS_SYS]
	then
	    begin

	    if .PCB [P_SUB] neqa 0
	    then
		begin
		PCB = .PCB [P_SUB];
		TRUE
		end
	    else
		begin
		PCB = .PCB [P_MAIN];
		(PCB = .PCB [P_LNK]) neqa 0
		end

	    end
	else
	    (PCB = .PCB [P_LNK]) neqa 0;

    UBM [UBM$W_END_BLK] = .RSX$GW_SYSTEM_SIZE;
    end;
    begin

    local
	BIAS,
        UBM : ref block field ($CEX_UBMFIELDS),
	UBMN,
	UBMR : ref vector;

    UBMN = 0;
    UBMR = UBMPR;
    UBM = UBM_DATA_BASE;

    do
	begin
	UBM [UBM$B_BASE_UBMR] = .UBMN;
	BIAS = .UBM [UBM$W_START_BLK];

	do
	    begin

	    if .UBMN gtr 31 then exitloop UBM [UBM$W_END_BLK] = .BIAS;

	    CEX$$SHIFT_32 (6, .BIAS, 0; UBMR [0], UBMR [1]);
	    UBMR = UBMR [2];
	    UBMN = .UBMN + 1;
	    end
	while (BIAS = .BIAS + %o'200') lssu .UBM [UBM$W_END_BLK];

	end
    while (UBM = .UBM [UBM$A_LINK]) neqa 0;

    CEX$$SHIFT_32 (-6, .UBMR [-2], .UBMR [-1];, UBM);
    end;
    CEX$GA_UBM_DATA_BASE = .UBM_DATA_BASE [UBM$A_LINK];
%else
    0					! (avoid empty expression)
%fi
    end;				!of routine INITIALIZE_UNIBUS_MAPPING
routine KILL_PROCESSES : MCB_ novalue =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin

    local
	LAST_PDT,
	PDT : ref vector;

    CEX$AR_CEX_SYNCH_BLOCK [SYN$A_DISPATCH] = 0;

    if (PDT = .CEX$GA_PROCESS_TABLE_END) eqla 0 then return;

    do
	begin

	local
	    PDB : ref block [PDT$K_LENGTH] field ($CEX_PDTFIELDS);

	LAST_PDT = .PDT;

	if (PDB = .(PDT = PDT [-1])) neqa 0
	then
	    begin

	    if .PDB [PDT$V_KILL_PROCESS]
	    then
		begin

		local
		    LENGTH;

		PDT [0] = 0;

		if .CEX$GA_PROCESS_TABLE_END eqla .LAST_PDT
		then
		    CEX$GA_PROCESS_TABLE_END = .LAST_PDT;

		LENGTH = PDT$K_LENGTH - 1;

		if .PDB [PDT$V_UCB_INCLUDED]
		then
		    begin

		    bind
			UCB = .PDB [PDT$A_UCB] : block field (UCB_FIELDS);

		    UCB [U_CW2] = 0;
		    LENGTH = .LENGTH + 1;
		    end;

		if not .PDB [PDT$V_PERMANENT]
		then
		    begin
		    LENGTH = .LENGTH*%upval;
		    $RSX_RETURN_DSR (.LENGTH, .PDB);
		    end;

		end;

	    end;

	end
    while .PDT gtra CEX$AA_PROCESS_TABLE [0];

    end;				!of routine KILL_PROCESSES
routine LAST (SIG, MCH, ENB) =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin

    map
	ENB : ref vector,
	MCH : ref vector,
	SIG : ref vector;

    if .SIG [0] eql 0 then return FALSE;

    (.SIG [1] and 7) lss 4
    end;				!of routine LAST
routine NULL (PS, PC) : LINKAGE_INTERRUPT novalue =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin
    NO_OPERATION
    end;				!of routine NULL
routine NXM_CATCHER (PS, PC) : LINKAGE_INTERRUPT novalue =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin
    PS = .PS + 1;
    end;				!of routine NXM_CATCHER
routine NXM_TESTER (ADR) : LINKAGE_ADR_NO_CARRY =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin
    .(.ADR)<0, 8, 0>
    end;				!of routine NXM_TESTER
routine PANIC : MCB_ novalue =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin

    macro
	POP (address) =
	    (builtin sp; map sp : ref vector; (address) = .sp [0]; sp = sp [1]) %,
	PUSH (value) =
	    (builtin sp; map sp : ref vector; (sp = sp [-1]) = (value)) %;

    (external PS; CEX$GW_PANIC_STATUS = .PS);
    (external PS; PS = 3^12 + 7^5);
    (builtin sp; CEX$GA_PANIC_STACK = .sp);
    (builtin sp; sp = CEX$GA_PANIC_STACK);
    (builtin r5; PUSH (.r5));
    (builtin r4; PUSH (.r4));
    (builtin r3; PUSH (.r3));
    (builtin r2; PUSH (.r2));
    (builtin r1; PUSH (.r1));
    (builtin r0; PUSH (.r0));
    (external KISAR6; PUSH (.KISAR6));
    (builtin mfpi; PUSH (mfpi (sp)));
    PUSH (.VEC$AA_POWER_FAILURE [0]);
    VEC$AA_POWER_FAILURE [0] = NULL;
    begin

    global register
	BUFFER = 2,
	LIST = 5;

    if (LIST = .CEX$AA_PROCESS_TABLE [0]) neq 0
    then
	begin

	map
	    LIST : ref block [PDT$K_LENGTH] field ($CEX_PDTFIELDS);

	MAP$ (.LIST [PDT$W_DATA_BIAS]);
	if (LIST = .LIST [PDT$A_DATA_ADDRESS]) neqa 0
	then
	    begin

	    map
		LIST : ref vector;

	    BUFFER = .LIST;
	    LIST = .LIST + .LIST [0];
	    PDUMP ();
	    end;

	end;

    end;
    POP (VEC$AA_POWER_FAILURE [0]);
    begin

    local
	DUMPER_BIAS;

    if (DUMPER_BIAS = .CEX$GR_DUMP_EXCEPTION [EXV$A_ENABLE_DATA]) neqa 0
    then
	begin
	$CEX_PHDDEF

	bind
	    HEADER = %o'120000' : block field ($CEX_PHDFIELDS);

	external
	    KISAR5 : volatile,
	    KISAR6 : volatile;

	KISAR6 = .KISAR5;
	(builtin pc; pc = .pc + %o'20000');
	KISAR5 = .DUMPER_BIAS;
	(builtin pc; pc = .HEADER [PHD$A_SIGNAL]);
	end
    else
	while TRUE do (builtin halt; halt ());

    end;
    end;				!of routine PANIC
routine PDUMP : LINKAGE_LIST_BUFFER novalue =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin

    external register
	BUFFER : ref vector,
	LIST: ref vector;

    local
	BEGIN_ADR : ref vector,
	END_ADR : ref vector,
	NEW_WINDOW : ref vector,
	NXM_SAVE;

    NXM_SAVE = .VEC$AA_ADDRESS_ERROR [0];
    VEC$AA_ADDRESS_ERROR [0] = NXM_CATCHER;

    if
	begin
	BEGIN_ADR = .LIST [0];
	LIST = LIST [1];
	.BEGIN_ADR eqla 0
	end
    then return;

    do
	begin
	NEW_WINDOW = 0;
	END_ADR = .LIST [0];
	LIST = LIST [1];

	do
	    begin

	    if .NEW_WINDOW eql 0
	    then
		begin

		if not NXM (BEGIN_ADR [0])
		then
		    begin
		    BUFFER [0] = BEGIN_ADR [0];
		    BUFFER = BUFFER [1];
		    NEW_WINDOW = .BUFFER;
		    BUFFER [0] = 0;
		    BUFFER = BUFFER [1];

		    if .BUFFER lssa .LIST
		    then
			begin
			BUFFER [0] = .BEGIN_ADR [0];
			BUFFER = BUFFER [1];
			NEW_WINDOW [0] = .BEGIN_ADR;
			end
		    else
			begin
			VEC$AA_ADDRESS_ERROR [0] = .NXM_SAVE;
			return
			end;

		    end;

		end
	    else
		begin

		local
		    DATA;

		if NXM (BEGIN_ADR [0])
		then
		    begin
		    NEW_WINDOW = 0;
		    BUFFER [0] = 0;
		    end
		else

		    if .BUFFER lssa .LIST
		    then
			begin
			BUFFER [0] = .BEGIN_ADR [0];
			BUFFER = BUFFER [1];
			NEW_WINDOW [0] = .BEGIN_ADR;
			end
		    else
			begin
			VEC$AA_ADDRESS_ERROR [0] = .NXM_SAVE;
			return
			end;

		end;

	    end
	while (BEGIN_ADR = BEGIN_ADR [1]) leqa .END_ADR;

	end
    while
	begin
	BEGIN_ADR = .LIST [0];
	LIST = LIST [1];
	.BEGIN_ADR neqa 0
	end;

    VEC$AA_ADDRESS_ERROR [0] = .NXM_SAVE;
    end;				!of routine PDUMP
routine SCHEDULE : MCB_ novalue =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin

    external
	%name ('$INTCT'),
	%name ('$PWRFL');

    do
	begin
	CEX$GH_SCHEDULING_REQUESTS = 0;

	selectone TRUE of
	    set
	    [.CEX$AA_SYNCH_QUEUE [0] neq 0] :
		begin

		register
		    SYN = 4 : ref block [SYN$K_LENGTH] field ($CEX_SYNFIELDS);

		begin

		local
		    PS_SAVE;

		external
		    PS;

		PS_SAVE = .PS;
		PS <0, 8> = 7^5;
		SYN = .CEX$AA_SYNCH_QUEUE [0];

		if (CEX$AA_SYNCH_QUEUE [0] = .SYN [SYN$A_LINK]) eqla 0
		then
		    CEX$AA_SYNCH_QUEUE [1] = CEX$AA_SYNCH_QUEUE [0];

		PS <0, 8> = .PS_SAVE;
		end;
		SYN [SYN$A_LINK] = 0;
		CEX$GW_SYNCH_COUNT = .CEX$GW_SYNCH_COUNT + 1;

		if .CEX$GW_SYNCH_COUNT eql 0
		then
		    CEX$GW_SYNCH_COUNT = .CEX$GW_SYNCH_COUNT - 1;

		begin

		local
		    DISPATCH,
		    PROCESS : ref block [PDT$K_LENGTH] field ($CEX_PDTFIELDS);

		PROCESS = .SYN [SYN$A_PROCESS];
		DISPATCH = .SYN [SYN$A_DISPATCH];
		SYN [SYN$A_PROCESS] = 0;
		CEX$$SYNCHRONIZE_PROCESS (.PROCESS, .DISPATCH);
		end;
		end;
	    [.%name ('$PWRFL') neq 0] :
		begin
		CEX$GA_CEX_FORK_BLOCK = 0;
		return;
		end;
	    [.%name ('$INTCT') geq 0] :
		begin
		CEX$GH_SCHEDULING_REQUESTS = .CEX$GH_SCHEDULING_REQUESTS + 1;
		return;
		end;
	    [.CEX$AA_CCB_QUEUE_L [0] neq 0] :
		begin

		register
		    CCB = 4 : ref block [CCB$K_LENGTH] field ($CEX_CCBFIELDS);

		CCB = .CEX$AA_CCB_QUEUE_L [0];

		if (CEX$AA_CCB_QUEUE_L [0] = .CCB [CCB$A_LINK]) eqla 0
		then
		    CEX$AA_CCB_QUEUE_L [1] = CEX$AA_CCB_QUEUE_L [0];

		CCB [CCB$A_LINK] = 0;
		CEX$GW_CCB_DISPATCH_COUNT = .CEX$GW_CCB_DISPATCH_COUNT + 1;

		if .CEX$GW_CCB_DISPATCH_COUNT eql 0
		then
		    CEX$GW_CCB_DISPATCH_COUNT = .CEX$GW_CCB_DISPATCH_COUNT - 1;

		CEX$$DISPATCH_PROCESS (.CCB [CCB$A_DESTINATION_PROCESS],
		    .CCB [CCB$B_FUNCTION], .CCB [CCB$B_MODIFIER]);
		end;
	    [.CEX$AA_CCB_QUEUE_H [0] neq 0] :
		begin

		register
		    CCB = 4 : ref block [CCB$K_LENGTH] field ($CEX_CCBFIELDS);

		CCB = .CEX$AA_CCB_QUEUE_H [0];

		if (CEX$AA_CCB_QUEUE_H [0] = .CCB [CCB$A_LINK]) eqla 0
		then
		    CEX$AA_CCB_QUEUE_H [1] = CEX$AA_CCB_QUEUE_H [0];

		CCB [CCB$A_LINK] = 0;
		CEX$GW_CCB_DISPATCH_COUNT = .CEX$GW_CCB_DISPATCH_COUNT + 1;

		if .CEX$GW_CCB_DISPATCH_COUNT eql 0
		then
		    CEX$GW_CCB_DISPATCH_COUNT = .CEX$GW_CCB_DISPATCH_COUNT - 1;

		CEX$$DISPATCH_PROCESS (.CCB [CCB$A_DESTINATION_PROCESS],
		    .CCB [CCB$B_FUNCTION], .CCB [CCB$B_MODIFIER]);
		end;
	    [otherwise] :
		return;
	    tes;

	end
    while TRUE;

    end;				!of routine SCHEDULE
end
eludom