Google
 

Trailing-Edge - PDP-10 Archives - cuspjul86upd_bb-jf24a-bb - 10,7/decmai/mx/mxqman.bli
There are 7 other files named mxqman.bli in the archive. Click here to see a list.
MODULE mxqman =
BEGIN

!
!			  COPYRIGHT (c) 1984 BY
!	      DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!
! 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:	Decmail/MS Message eXchange (MX) Queue Management Routines
!
! ABSTRACT:	This module contains the data structures and routines used by
!          the Message Queue Manager.  All the queues and other global data
!          structures are defined here as well.
!
! ENVIRONMENT:	Tops-10/Tops-20 User Mode
!
! AUTHOR: Richard B. Waddington, CREATION DATE: 28 November, 1984
!
! MODIFIED BY:
!
!   MX: VERSION 1.0
! 01	-
!--
!
! INCLUDE FILES:
!
%IF %SWITCHES(TOPS20) %THEN
    LIBRARY 'monsym';
    UNDECLARE time;
    LIBRARY 'mxjlnk';
%ELSE
    LIBRARY 'tbl';
%FI
LIBRARY 'mxnlib' ;	! Our version of NML's utility library
LIBRARY 'mxlib';
!
! TABLE OF CONTENTS:
!
FORWARD	ROUTINE
    get_next_envelope_file,
    parse_envelope_file,
    par_work_req,
    convert_to_integer,
    reppar: NOVALUE,
    mx$change_ext,
    mx$unique_msg_file_name,
    mx$message_queue_routines,
    mx$message_queue_local_routines;
!
! MACROS:
!
MACRO
    prived =
%IF %SWITCHES(TOPS10) %THEN
    BEGIN
    BUILTIN UUO;
    REGISTER t;

    IF UUO(1,getppn(t))
    THEN
        1                   !Jacct set
    ELSE
        .t EQL (1^18)+2     !ppn EQL 1,2
    END
%ELSE
    BEGIN
    declare_jsys(rpcap);
    LOCAL
        caps;

    $$rpcap($fhslf;,caps);
    (.caps AND (sc_whl OR sc_opr)) NEQ 0    !True if SC_WHL or SC_OPR are set
    END
%FI %,
    get_my_node(buf_,len_) =
    %IF %SWITCHES(TOPS20) %THEN
        BEGIN
        LOCAL
            netptr;

        netptr = NMU$NETWORK_LOCAL();
        GETW(netptr);
        len_ = GETB(netptr);
        CH$WCHAR(0,CH$MOVE(.len_,.netptr,CH$PTR(buf_)));
        END
    %ELSE       !Throw together Tops-10 node name
        BEGIN
        BUILTIN UUO;

        LOCAL
            b: VECTOR[2];

        REGISTER
            r;

        r = $gtloc;
        IF UUO(1,GETTAB(r))
        THEN
            BEGIN
            b[0] = 2;
            b[1] = .r;
            r = $ndrnn^18 + b;
            IF UUO(1,node$(r))
            THEN
                BEGIN
                b = .r;
                CH$TRANSLATE(sx_asc,
		            6, CH$PTR(b,0,6),
                            0,
                            7, CH$PTR(buf_));
                len_ = CH$LEN(CH$PTR(buf_));
                END;
            END;
        END;
    %FI
%,

    SET_DEFAULT_FILE_PROTECTION =
        %IF %SWITCHES(TOPS10) %THEN
            BEGIN
            EXTERNAL ROUTINE SETPRO;

            SETPRO();
            END
        %FI %;

MACRO
    WAIT_FOR_UPS =
        %IF %SWITCHES(TOPS20) %THEN
        BEGIN
        DECLARE_JSYS(mstr,gjinf,thibr)
        LOCAL
            _ARG: VECTOR[$msgln],
            _TTY;

        _arg[$msgsn] = CH$PTR(UPLIT(%ASCIZ'UPS'));
        WHILE NOT $$mstr($msgln^18 + $msgss, _arg) DO
            BEGIN
            !Here if UPS: unavailable...
            $$gjinf(;,,,_tty);
            IF ._tty NEQ -1     !Blast to console if not detached
            THEN
                TASK_INFO('Waiting for UPS:');

            $$thibr(60); !Wait a minute and try again
            END
        END
    %FI %;
!
! EQUATED SYMBOLS:
!
%IF %SWITCHES(TOPS10) %THEN
BIND
   sx_asc = CH$TRANSTABLE(0,
		seq(%C'!', %C'_'));
%FI
!
! OWN STORAGE:
!
GLOBAL BIND
        logspc = UPLIT(%ASCIZ'UPS:MX.LOG');

GLOBAL
        mxlogf,
        mxlogm,
        nodlen:         INITIAL(10),
        nodnam:         BLOCK[4] INITIAL(%ASCIZ'LOCAL-NODE'),
	work_queue:	SQ_HEADER,
	dfer_queue:	Q_HEADER,
	done_queue:	SQ_HEADER,

	active_message_table: initial(0);

OWN
    env_cntr: INITIAL(0);
!
! EXTERNAL REFERENCES:
!

EXTERNAL
    nettab:	VECTOR[max_number_of_domains],
    verstr;

EXTERNAL ROUTINE
        parse_rcpt,
        scan_pkt,
        copy_string,
        copy_asciz,
        mx$validate_local_user,
        mx$file_routines,
        mx$error_routines,
        mx$database_routines,
	nmu$text_manager,
	nmu$sched_manager,
	nmu$queue_manager,
	nmu$memory_manager,
	nmu$page_get,
	nmu$page_release,
        nmu$network_local,
	nmu$table_routines;

%global_routine ('MX$MESSAGE_QUEUE_INITIALIZE') :NOVALUE =	!

!++
! FUNCTIONAL DESCRIPTION:
!	This routine initializes the queues and tables used by the MESSAGE QUEUE
!   MANAGMENT routines.
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	The headers of the various queues and tables.
!
! IMPLICIT OUTPUTS:
!
!	The headers of the various queues and tables.
!
! COMPLETION CODES:
!
!	NONE
!
! SIDE EFFECTS:
!
!	Tasks which service the above mentioned queues are scheduled to run.
!
!--

    BEGIN
    LOCAL
	tsk_nam,
        error,
	nam_buf: VECTOR[CH$ALLOCATION(132)],
        domain: REF domain_data_block;

    MACRO
        newpag = CH$PTR(UPLIT(%ASCIZ %CHAR(%O'14',%O'15',%O'12'))) %;

    IF NOT prived
    THEN
        BEGIN
        TASK_INFO('Insufficient privileges!');
        STOP_PROGRAM();
        END;

    WAIT_FOR_UPS;
    SET_DEFAULT_FILE_PROTECTION;
    !
    !Open the error log file...
    !
    IF mx$file_exists(CH$PTR(logspc))
    THEN
        mxlogm = file_access_append_only
    ELSE
        mxlogm = file_access_write_only;

    mxlogf = mx$file_open(CH$PTR(logspc), .mxlogm, error);

    IF .mxlogf EQL 0
    THEN
        BEGIN
        task_info('Could not create log file in UPS:');
        STOP_PROGRAM();
        END;

    mxlogm = 0;     !Clear the log modified flag...

    mx$file_write(.mxlogf, newpag, 3, 0);

    $trace_always('*** MX %A Log File Opened ***',CH$PTR(verstr));

    get_my_node(nodnam,nodlen);
    nmu$squeue_reset(work_queue);
    nmu$queue_reset(dfer_queue);
    nmu$squeue_reset(done_queue);

    nmu$table_clear(active_message_table);

    nmu$sched_create(mx$message_queue_cleanup,500,0,ch$asciz('CLEANUP'));
    nmu$sched_create(mx$message_queue_defer,500,0,ch$asciz('DEFER'));
    nmu$sched_create(mx$message_queue_manager,500,0,ch$asciz('QUEUE_MANAGER'));

!
! Set up the domain spoolers, servers, and host tables for each defined domain.
!
    INCR i FROM 0 TO max_number_of_domains - 1 DO
	BEGIN
	domain = .nettab[.i];
	IF .domain[dom_name] NEQ 0
	THEN
	    BEGIN
	    domain[dom_spooler_queue] = nmu$memory_get(sq_header_size);
            nmu$squeue_reset(.domain[dom_spooler_queue]);

	    tsk_nam = ch$ptr(nam_buf);
	    $nmu$text(tsk_nam,132,'%A-SPOOLER',ch$ptr(.domain[dom_name]));
	    nmu$sched_create(.domain[dom_spooler_task],500,0,ch$ptr(nam_buf));

	    tsk_nam = ch$ptr(nam_buf);
	    $nmu$text(tsk_nam,132,'%A-SERVER',ch$ptr(.domain[dom_name]));
	    nmu$sched_create(.domain[dom_server_task],500,0,ch$ptr(nam_buf));

            IF NOT mx$data_initialize(.i)
            THEN
                BEGIN
                mx$data_get_space();
                IF NOT mx$data_initialize(.i)
                THEN
                    mx$fatal('Insuffient memory for Node data');
                END

	    END;
	END;

    mx$recovery();
    END;			!End of MX$MESSAGE_QUEUE_INITIALIZE

%routine ('MX$RECOVERY') :NOVALUE =

!++
! FUNCTIONAL DESCRIPTION
!	This routine handles startup processing for MX.  It searches the post
!   office directory for Envelope Files, and based on their contents,
!   re-generates work requests, and queues them to the WORK QUEUE.
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:	NONE
!
! SIDE EFFECTS:
!
!	NONE
!--
BEGIN
LOCAL
    spec,
    head:   list_blk,
    list:   REF list_blk,
    msg:    REF message_table_entry,
    tmp,
    envflg;

$TRACE('RECOVERY called');
spec = nmu$memory_get(CH$ALLOCATION(max_string_length));
head[lst_next] = 0;
list = head;
envflg = 0;
WHILE get_next_envelope_file(CH$PTR(.spec), envflg) DO
    BEGIN
    $TRACE_ALWAYS('Envelope file: %A', CH$PTR(.spec));
    list[lst_next] = mx$get_list_blk;
    list = .list[lst_next];
    list[lst_next] = 0;
    list[lst_data] = copy_asciz(CH$PTR(.spec));
    END;

list = .head[lst_next];
WHILE .list NEQ 0 DO
    BEGIN
    IF (msg = parse_envelope_file(.list[lst_data])) NEQ 0
    THEN
        mx$message_queue_post(.msg);

    tmp = .list;
    mx$release_asciz(.list[lst_data]);
    list = .list[lst_next];
    nmu$memory_release(.tmp,list_block_size);
    END;

nmu$memory_release(.spec,CH$ALLOCATION(max_string_length));
RETURN
END;

%routine ('GET_NEXT_ENVELOPE_FILE', ptr, flag_) =
BEGIN
BIND
    flag = .flag_;

%IF %SWITCHES(TOPS20) %THEN
declare_jsys(gtjfn,gnjfn,jfns,rljfn);
LOCAL
    tmp;

BIND
    envptr = CH$PTR(UPLIT(%ASCIZ'UPS:*.ENV'));

IF .flag EQL 0
THEN
    BEGIN
    IF NOT $$gtjfn(gj_sht OR gj_old OR gj_ifg OR gj_flg,
                   envptr; flag)
    THEN
        RETURN 0;
    END
ELSE
    IF NOT $$gnjfn(.flag)
    THEN
        RETURN 0;
$$jfns(.ptr, .flag<0,18,0>, %O'111110000001');

RETURN 1;
%ELSE
!    %WARN('GET_NEXT_ENVELOPE_FILE not yet implemented on TOPS-10')
STACKLOCAL
    nambuf: VECTOR[2];

LOCAL
    nam;

IF .flag EQL 0
THEN
    flag = nmu$page_get() * %O'1000';

IF bldque(.flag; nam)
THEN
    BEGIN
    CH$TRANSLATE(sx_asc,
		 6, CH$PTR(nam,0,6),
		 0,
		 7, CH$PTR(nambuf));

    $nmu$text(ptr,max_string_length,'UPS:%A.ENV',CH$PTR(nambuf));
    RETURN 1;
    END
ELSE
    BEGIN
    nmu$page_release(.flag/%O'1000');
    RETURN 0;
    END
%FI
END;

%routine ('PARSE_ENVELOPE_FILE', spec) =
BEGIN
LOCAL
    envfil,
    error,
    len,
    req:    REF work_request_block,
    msg:    REF message_table_entry,
    list:   REF list_blk;

STACKLOCAL
    linbuf: VECTOR[CH$ALLOCATION(max_string_length)];

$TRACE('PARSE_ENVELOPE_FILE called');

IF NOT (envfil = mx$file_open(
                    CH$PTR(.spec),
                    file_access_read_only,
                    error)) GTR 0
THEN
    RETURN $error(SEVERITY =        $warning,
                  FACILITY =        $internal,
                  CODE =            uf$fof,
                  MESSAGE_DATA =    CH$PTR(.spec),
                  OPTIONAL_MESSAGE= $error_code,
                  OPTIONAL_DATA =   .error);

WHILE (len = mx$file_read(.envfil, CH$PTR(linbuf), 132, error)) GTR 0 DO
    BEGIN
    linbuf<0,1,0> = 0;
    SELECTONE .linbuf OF
        SET
        ['FILE ']:  IF mx$file_exists(CH$PTR(linbuf[1]))
                    THEN
                        BEGIN
                        msg = mx$get_message_table_entry;
                        msg[msg_fil_spec] = copy_string(CH$PTR(linbuf[1]),
                                                        .len-6);
                        CH$WCHAR(0,CH$PLUS(CH$PTR(.msg[msg_fil_spec]),.len-7));
                        END
                    ELSE
                        BEGIN
                        msg = 0;
                        EXITLOOP;
                        END;

        ['SNDR ']:  BEGIN
                    msg[msg_sender_string] = copy_string(CH$PTR(linbuf[1]),
                                                         .len-6);
                    CH$WCHAR(0,CH$PLUS(CH$PTR(.msg[msg_sender_string]),.len-7))
                    END;

        ['STAT ']:  msg[msg_state] = convert_to_integer(CH$PTR(linbuf[1]),
                                                        .len-7);

        ['SDID ']:  msg[msg_sender_domain] = convert_to_integer(
                                                        CH$PTR(linbuf[1]),
                                                        .len-7);

        ['ERR  ']:  BEGIN
                    list = mx$get_list_blk;
                    list[lst_data] = copy_string(CH$PTR(linbuf[1]), .len-6);
                    CH$WCHAR(0,CH$PLUS(CH$PTR(.list[lst_data]),.len-7));
                    list[lst_next] = .msg[msg_err_list];
                    msg[msg_err_list] = .list;
                    END;

        ['WORK-']:  BEGIN
                    list = mx$get_list_blk;
                    list[lst_data] = req = par_work_req(.envfil, linbuf);
                    req[req_message_id] = .msg[msg_msg_id];
                    list[lst_next] = .msg[msg_work_req_list];
                    msg[msg_work_req_list] = .list;
                    msg[msg_work_req_count] = .msg[msg_work_req_count] + 1;
                    END;

        ['END -']:  ;
        TES;
    END;
IF .len LSS 0
THEN
    $error( SEVERITY            = $warning,
            FACILITY            = $internal,
            CODE                = uf$frf,
            MESSAGE_DATA        = CH$PTR(.spec),
            OPTIONAL_MESSAGE    = $error_code,
            OPTIONAL_DATA       = .error);

mx$file_close(.envfil, file_abort, error);
mx$file_delete(.spec);
RETURN .msg;
END;
%routine ('PAR_WORK_REQ', handle, buffer_) =
BEGIN
BIND
    buffer = .buffer_: VECTOR;

LOCAL
    len,
    error,
    list: REF list_blk,
    req: REF work_request_block,
    rdata: REF rb_block;

$TRACE('PAR_WORK_REQ called');

req = mx$get_work_request;
WHILE (len = mx$file_read(.handle, CH$PTR(buffer), 132, error)) GTR 0 DO
    BEGIN
    buffer<0,1,0> = 0;
    SELECTONE .buffer OF
        SET
        ['RDID ']:  req[req_domain_id] = convert_to_integer(CH$PTR(buffer[1]),
                                                            .len-7);

        ['RNOD ']:  BEGIN
                    LOCAL
                        ptr;

                    req[req_destination_node] = 
                                nmu$memory_get(CH$ALLOCATION((.len-7+3+1),8));
                    ptr = CH$PTR(.req[req_destination_node],0,8);
                    CH$WCHAR_A(0,ptr);
                    CH$WCHAR_A(0,ptr);
                    CH$WCHAR_A(.len-7, ptr);
                    ptr = CH$MOVE(.len-7, CH$PTR(buffer[1]), .ptr);
                    CH$WCHAR(0,.ptr);
                    END;

        ['RTIM ']:  req[req_time_stamp] = convert_to_integer(CH$PTR(buffer[1]),
                                                             .len-7);

        ['RTTL ']:  req[req_time_to_live]=convert_to_integer(CH$PTR(buffer[1]),
                                                             .len-7);

        ['RCPT ']:  BEGIN
                    list = mx$get_list_blk;
                    list[lst_data] = copy_string(CH$PTR(buffer[1]), .len-6);
                    CH$WCHAR(0,CH$PLUS(CH$PTR(.list[lst_data]),.len-7));
                    list[lst_next] = .req[req_recipient_list];
                    rdata = list[lst_xtra] = 
                        parse_rcpt(CH$PTR(.list[lst_data]));

                    IF .req[req_domain_id] EQL $local
                    THEN
                        IF NOT mx$validate_local_user(.rdata[rb_name_len],
                                                      .rdata[rb_name_ptr],
                                                      buffer)
                        THEN
                            $error(
                                SEVERITY=$warning,
                                FACILITY=$protocol,
                                CODE=mg$nsu,
                                MESSAGE_DATA=(CH$PTR(UPLIT(%ASCIZ'ENVELOPE')),
                                                CH$PTR(buffer)))
    
                                                    %IF %SWITCHES(TOPS10) %THEN

                        ELSE                        !Tops-10 Save the profile
                            rdata[rb_profile] = .buffer   %FI ;

                    req[req_recipient_list] = .list;
                    END;

        ['END -']:  RETURN .req
        TES;
    END;
RETURN 0;
END;
%routine('CONVERT_TO_INTEGER', ptr, len) =
BEGIN
LOCAL
    num;

$TRACE('CONVERT_TO_INTEGER called');

num = 0;
INCR i FROM 1 TO .len DO num = (.num * 10) + CH$RCHAR_A(ptr) - %C'0';
RETURN .num;
END;
%global_routine ('MX$MESSAGE_QUEUE_POST', entry: REF message_table_entry) =

!++
! FUNCTIONAL DESCRIPTION:
!
!       This routine posts a message to the message queue manager.  It is the
!   interface from the outside world.  It takes a message table entry as input.
!   The calling routine is responsible for setting up the following fields of
!   the message table entry:
!
!       MSG_FIL_SPEC:       The address of an ASCIZ string containing the
!                           filespec of the "message text file".
!
!       MSG_SENDER_STRING:  The address of an ASCIZ string.
!
!       MSG_WORK_REQ_LIST:  The address of a linked list of WORK-REQUESTS.
!
!       MSG_SENDER_PID:     The sender's PID
!
!       MSG_SENDER_UID:     The sender's UID
!
!       MSG_SENDER_CAP:     The sender's enabled capabilities
!
!       All other fields in the message_table_entry should not be used by the
!   calling routine.  The work requests must have all their pertinant fields
!   built, including the recipient list (which is a linked list of ASCIZ
!   recipient strings).  The REQ_MESSAGE_ID, the REQ_STATE, and the
!   REQ_STATE_SPECIFIC_FIELD should not be used by the calling routine.
!       This routine initializes the remaining fields of the message table
!   entry, and queues each work request to the queue manager task.
!
! FORMAL PARAMETERS:
!
!	ENTRY:  the address of the message table entry.
!
! IMPLICIT INPUTS:
!
!       NONE
!
! IMPLICIT OUTPUTS:
!
!	This routine puts WORK_REQUEST's in the WORK_QUEUE, and initializes the
!   following fields of the message_table_entry:
!
!       MSG_WORK_REQ_COUNT
!       MSG_ERR_LIST
!
!       It also initializes the REQ_MESSAGE_ID, REQ_STATE, and the
!   REQ_STATE_SPECIFIC_FIELDs of each WORK_REQUEST.
!
! ROUTINE VALUE:	NONE
!
! SIDE EFFECTS:
!
!	The QMAN task is scheduled to run.
!
!--

    BEGIN
    LOCAL
        old_fil_spec,
        list:           REF list_blk;

    $TRACE('MX$MESSAGE_QUEUE_POST was called ');

    IF (list = .entry[msg_work_req_list]) EQL 0
    THEN 
        BEGIN
        mx$file_delete(.entry[msg_fil_spec]);
        mx$file_delete(.entry[msg_env_spec]);
        mx$release_message(.entry);
        RETURN 0;
        END;

!    old_fil_spec = .entry[msg_fil_spec];
!    entry[msg_fil_spec] = mx$change_ext(CH$PTR(.old_fil_spec),
!                                        CH$PTR(UPLIT(%ASCIZ'MX')));

    IF .entry[msg_env_spec] EQL 0
    THEN
        entry[msg_env_spec] = mx$build_envelope_spec();

    entry[msg_state] = $msg_complete;
    entry[msg_work_req_count] = 0;

    $trace_always(%STRING(  '  From: %A%/',
       '                       File: %A'),
                    CH$PTR(.entry[msg_sender_string]),
                    CH$PTR(.entry[msg_fil_spec]));

    WHILE .list NEQ 0 DO
	BEGIN
        BIND
            request = .list[lst_data]: work_request_block;

        $trace_always('  Node: %A',
                        CH$PTR(.request[req_destination_node],3,8));
        entry[msg_work_req_count] = .entry[msg_work_req_count] + 1;
        request[req_message_id] = .entry[msg_msg_id];
        request[req_state_specific_field] = 0;
        $mx$change_state(request, $send);
        list = .list[lst_next];
	END;

    mx$message_queue_checkpoint(.entry);
!    IF mx$file_rename(CH$PTR(.old_fil_spec),CH$PTR(.entry[msg_fil_spec]))
!    THEN
!        mx$release_asciz(.old_fil_spec)
!    ELSE
!        BEGIN
!        $TRACE_ALWAYS('RENAME FAILED - %A => %A',
!            CH$PTR(.old_fil_spec),
!            CH$PTR(.entry[msg_fil_spec]));
!        mx$release_asciz(.entry[msg_fil_spec]);
!        entry[msg_fil_spec] = .old_fil_spec;
!        mx$message_queue_checkpoint(.entry);
!        END;

    RETURN 0;
    END;			!End of MX$MESSAGE_QUEUE_POST

%global_routine ('MX$MESSAGE_QUEUE_MANAGER') :NOVALUE =	!

!++
! FUNCTIONAL DESCRIPTION:
!	This task decides which action to take based on the type of the
!   WORK_REQUEST.
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	This task processes WORK_REQUEST's from the WORK_QUEUE.
!
! IMPLICIT OUTPUTS:
!
!	This task puts WORK_REQUEST's in the DONE_QUEUE, DFER_QUEUE,
!   RJCT_QUEUE, or the appropriate SPOOLER QUEUE.
!
! ROUTINE VALUE:	NONE
! COMPLETION CODES:
!
!	NONE
!
! SIDE EFFECTS:
!
!	Tasks which service the above mentioned queues may be scheduled to run.
!
!--

    BEGIN
    LOCAL
        message:        REF message_table_entry,
	domain:		REF domain_data_block,
	request:	REF work_request_block;

    WHILE 1 DO					!Do this task forever...
	BEGIN
        request = nmu$squeue_remove (work_queue);
	$TRACE('Queue Manager Running ');
	domain = .nettab[.request[req_domain_id]];

        CASE .request[req_state]
      	    FROM min_request_type TO max_request_type OF
                SET
                [$send]:        nmu$squeue_insert(.domain[dom_spooler_queue],
                                                   .request);

        	[$done]:        nmu$squeue_insert(done_queue,.request);

		[$defer,$hold]: BEGIN
                                nmu$table_fetch(
                                            active_message_table,
                                            .request[req_message_id],
                                            message);

                                SELECTONE .message[msg_state] OF
                                    SET
                                    [$msg_canceled]:
                                       BEGIN
                                       request[req_state] = $reject;
                                       nmu$squeue_insert(done_queue, .request)
                                       END;
                                    [$msg_restart]:
                                       nmu$squeue_insert(done_queue, .request);
                                    [OTHERWISE]:
                                       nmu$queue_insert(dfer_queue,.request);
                                    TES;
                                END;

		[$reject]:      nmu$squeue_insert(done_queue,.request)
		TES
	END;

    END;			!End of MX$MESSAGE_QUEUE_MANAGER

%global_routine ('MX$MESSAGE_QUEUE_CLEANUP'):NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!	This task checks the ACTIVE_MESSAGE_TABLE and when all work requests
!   are done, performs cleanup operations such as deleting message and envelope
!   files.
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	This task takes work requests from the DONE_QUEUE.
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! COMPLETION CODES:
!
!	NONE
!
! SIDE EFFECTS:
!
!	Messages will be removed from the ACTIVE_MESSAGE_TABLE.
!--

    BEGIN

    LOCAL
	msg:		REF message_table_entry,
	request:        REF work_request_block,
        old_msg_spec;

    WHILE 1 DO
	BEGIN
	request = nmu$squeue_remove(done_queue);
	$TRACE('Cleanup running');
	IF nmu$table_fetch(active_message_table,
                            .request[req_message_id], msg)
	THEN
	    BEGIN
            LOCAL ptr;

	    $TRACE('Decrementing Work Request Count');

            msg[msg_work_req_count] = .msg[msg_work_req_count] - 1;

            IF (.request[req_state] EQL $done) OR
               (.request[req_state] EQL $reject)
            THEN
                mx$remove_request(.msg, .request);

	    IF .msg[msg_work_req_count] GTR 0
	    THEN
                mx$message_queue_checkpoint(.msg)
            ELSE
		BEGIN
                CASE .msg[msg_state] FROM $msg_complete TO $msg_canceled OF
                    SET
                    [$msg_complete,
                     $msg_incomplete]:  BEGIN

               $Trace_always(%STRING(
                        'Message from file %A%/',
                        '                          delivered to node %A%/'),
                                CH$PTR(.msg[msg_fil_spec]),
                                CH$PTR(.request[req_destination_node],3,8));

                                        mx$file_delete(.msg[msg_fil_spec]);
                                        mx$file_delete(.msg[msg_env_spec]);
                                        mx$release_message(.msg)
                                        END;

                    [$msg_restart]:     BEGIN
                                        mx$communicate(.msg);
                                        mx$message_queue_post(.msg);
                                        END;

                    [$msg_canceled]:    BEGIN

               $Trace_always(%STRING(
                       'Message from file %A%/',
                       '                          NOT delivered to node %A%/'),
                                CH$PTR(.msg[msg_fil_spec]),
                                CH$PTR(.request[req_destination_node],3,8));

                                        old_msg_spec = .msg[msg_fil_spec];
                                        msg[msg_fil_spec] =
                                            mx$change_ext(
                                                CH$PTR(.msg[msg_fil_spec]),
                                                CH$PTR(UPLIT(%ASCIZ 'RPR')));

                                        IF mx$file_rename(
                                            CH$PTR(.old_msg_spec),
                                            CH$PTR(.msg[msg_fil_spec]))
                                        THEN
                                            mx$release_asciz(.old_msg_spec)
                                        ELSE
                                            BEGIN
                                            $TRACE_ALWAYS(
                                                'RENAME FAILED %A => %A',
                                                CH$PTR(.old_msg_spec),
                                                CH$PTR(.msg[msg_fil_spec]));

                                            mx$release_asciz(
                                                .msg[msg_fil_spec]);
                                            msg[msg_fil_spec] = .old_msg_spec;
                                            END;

                                        mx$communicate(.msg);
                                        mx$file_delete(.msg[msg_env_spec]);
                                        mx$release_message(.msg);
                                        END;
                    TES;
                END;
            END;
	END;

    END;			!End of MX$MESSAGE_QUEUE_CLEANUP
%routine('MX$REMOVE_REQUEST',
            msg: REF message_table_entry,
            request: REF work_request_block): NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
!   	This routine searches the work_req_list of the message_table_entry
!   for the request whose address is in REQUEST.  When it finds it, it is
!   removed from the list, and its memory is released.
!
! FORMAL PARAMETERS:
!
!	MSG:        The message table entry.
!       REQUEST:    The work request to remove.
!
! IMPLICIT INPUTS:
!
!       NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! COMPLETION CODES:
!
!	NONE
!
! SIDE EFFECTS:
!
!	NONE
!--

    BEGIN
    MACRO
        release_profile(rbblock) =
            %IF %SWITCHES(TOPS10) %THEN
            BEGIN
            BIND
                _rb = (rbblock):rb_block,
                _pr = ._rb[rb_profile];

            IF _pr NEQ 0
            THEN
                nmu$memory_release(_pr, ._pr<0,18,0> + 1);
            END
            %FI %;

    LOCAL
        prv_list: REF list_blk,
        list: REF list_blk;

    $TRACE('LIST_REMOVE called');
    list = .msg[msg_work_req_list];
    IF .list EQL 0
    THEN
        RETURN;

    IF .list[lst_data] EQL .request
    THEN
        msg[msg_work_req_list] = .list[lst_next]
    ELSE
        BEGIN
        prv_list = .list;
        list = .list[lst_next];
        WHILE .list NEQ 0 DO
            BEGIN
            IF .list[lst_data] EQL .request
            THEN
                EXITLOOP;
            prv_list = .list;
            list = .list[lst_next];
            END;

        IF .list NEQ 0
        THEN
            BEGIN
            prv_list[lst_next] = .list[lst_next];
            nmu$memory_release(.list, list_block_size);
            list = .request[req_recipient_list];
            WHILE .list NEQ 0 DO
                BEGIN
                prv_list = .list;
                list = .list[lst_next];
                mx$release_asciz(.prv_list[lst_data]);
                release_profile(.prv_list[lst_xtra]);
                nmu$memory_release(.prv_list[lst_xtra], rb_block_size);
                nmu$memory_release(.prv_list, list_block_size);
                END
            END
        END;
    nmu$memory_release(.request, work_request_size);
    END;
%global_routine('MX$MESSAGE_QUEUE_CHECKPOINT',
                    msg: REF message_table_entry): NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
!   	This routine takes the message table entry, and based on its contents,
!   writes out an Envelope File.  ***NOTE*** It is not yet implemented.
!
! FORMAL PARAMETERS:
!
!	MSG:        The message table entry.
!
! IMPLICIT INPUTS:
!
!       NONE
!
! IMPLICIT OUTPUTS:
!
!	The envelope file.
!
! COMPLETION CODES:
!
!	NONE
!
! SIDE EFFECTS:
!
!       NONE
!--

    BEGIN
    STACKLOCAL
        linbuf: VECTOR[CH$ALLOCATION(max_string_length)];

    $LITERAL
        done = $distinct,
        msginfo = $distinct,
        msgerrs = $distinct,
        reqinfo = $distinct,
        rcptlst = $distinct,
        minstate = msginfo,
        maxstate = rcptlst;

    LOCAL
        req: REF work_request_block,
        list: REF list_blk,
        rlist: REF list_blk,
        errstr,
        error,
        state,
        len,
        envfil,
        rc,
        ptr;

    $TRACE('CHECKPOINT called');

    mx$file_delete(.msg[msg_env_spec]);
    IF NOT (envfil = mx$file_open(
                        CH$PTR(.msg[msg_env_spec]),
                        file_access_write_only,
                        error)) GTR 0
    THEN
        RETURN $error(SEVERITY =        $warning,
                      FACILITY =        $internal,
                      CODE =            uf$fof,
                      MESSAGE_DATA =    CH$PTR(.msg[msg_env_spec]),
                      OPTIONAL_MESSAGE= $error_code,
                      OPTIONAL_DATA =   .error);

    state = msginfo;
    WHILE .state NEQ done DO
        BEGIN
        ptr = CH$PTR(linbuf);
        CASE .state FROM minstate TO maxstate OF
            SET
            [msginfo]:  BEGIN
                        $TRACE('State = msginfo');
                        len = $nmu$text(ptr,max_string_length,
                                'FILE %A%/SNDR %A%/STAT %D%/SDID %D%/',
                                CH$PTR(.msg[msg_fil_spec]),
                                CH$PTR(.msg[msg_sender_string]),
                                .msg[msg_state],
                                .msg[msg_sender_domain]) - 1;
                        list = .msg[msg_err_list];
                        IF .list EQL 0
                        THEN
                            BEGIN
                            list = .msg[msg_work_req_list];
                            state = reqinfo;
                            END
                        ELSE
                            state = msgerrs;
                        END;

            [msgerrs]:  IF .list EQL 0
                        THEN
                            BEGIN
                            $TRACE('State = msgerrs/EOL');
                            len = $nmu$text(ptr,max_string_length,
                                    'END - ERR-LIST%/')-1;
                            list = .msg[msg_work_req_list];
                            state = reqinfo;
                            END
                        ELSE
                            BEGIN
                            $TRACE('State = msgerrs/ERR');
                            len = $nmu$text(ptr,max_string_length,
                                    'ERR  %A%/',
                                    CH$PTR(.list[lst_data])) - 1;
                            list = .list[lst_next];
                            END;

            [reqinfo]:  BEGIN
                        IF .list EQL 0
                        THEN
                            BEGIN
                            $TRACE('State = reqinfo/EWR');
                            len = $nmu$text(ptr,max_string_length,
                                    'END - WRQ-LIST%/')-1;
                            state = done;
                            END
                        ELSE
                            BEGIN
                            $TRACE('State = reqinfo/REQ');
                            req = .list[lst_data];
                            len = $nmu$text(ptr,max_string_length,
                                    %STRING('WORK-REQUEST%/RDID %D%/RNOD %A%/',
                                            'RTIM %D%/RTTL %D%/'),
                                    .req[req_domain_id],
                                    CH$PTR(.req[req_destination_node],3,8),
                                    .req[req_time_stamp],
                                    .req[req_time_to_live]) - 1;

                            rlist = .req[req_recipient_list];
                            IF .rlist EQL 0
                            THEN
                                state = reqinfo
                            ELSE
                                BEGIN
                                state = rcptlst;
                                rlist = .req[req_recipient_list];
                                END;
                            END;
                        list = .list[lst_next];
                        END;

            [rcptlst]:  IF .rlist EQL 0
                        THEN
                            BEGIN
                            $TRACE('State = rcptlst/EOL');
                            len = $nmu$text(ptr,max_string_length,
                                    'END - RCP-LIST%/')-1;
                            state = reqinfo;
                            END
                        ELSE
                            BEGIN
                            $TRACE('State = rcptlst(%D)/RCPT: %A',(rc=.rc+1),
                                    CH$PTR(.rlist[lst_data]));
                            len = $nmu$text(ptr, max_string_length,
                                    'RCPT %A%/',
                                    CH$PTR(.rlist[lst_data]))-1;
                            rlist = .rlist[lst_next];
                            END;
            TES;

        if not mx$file_write(.envfil, CH$PTR(linbuf), .len, error)
        THEN
            BEGIN
            $error(SEVERITY =          $warning,
                   CODE =              uf$fwf,
                   FACILITY =          $internal,
                   MESSAGE_DATA =      CH$PTR(.msg[msg_env_spec]),
                   optional_message =  $error_code,
                   optional_data =     .error);

            mx$file_close(.envfil, file_abort, error);
            RETURN
            END;

        END;

    IF NOT mx$file_close(.envfil, file_keep, error)
    THEN
        RETURN $error(
                    SEVERITY =          $warning,
                    CODE =              uf$fcf,
                    FACILITY =          $internal,
                    MESSAGE_DATA =      .msg[msg_env_spec],
                    OPTIONAL_MESSAGE =  $error_code,
                    OPTIONAL_DATA =     .error);

    END;
%global_routine('MX$RELEASE_MESSAGE',
                    msg: REF message_table_entry): NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
!       This routine flushes a message from the queue manager.  After this
!   routine finishes, there is no trace of the message left in the system.
!
! FORMAL PARAMETERS:
!
!	MSG:        The message table entry.
!
! IMPLICIT INPUTS:
!
!       NONE
!
! IMPLICIT OUTPUTS:
!
!	The envelope file.
!
! COMPLETION CODES:
!
!	NONE
!
! SIDE EFFECTS:
!
!       NONE
!--

    BEGIN
    LOCAL
        list:     REF list_blk VOLATILE,
        prv_list: REF list_blk;


    $TRACE('RELEASE_MESSAGE called');

    mx$release_asciz(.msg[msg_env_spec]);
    mx$release_asciz(.msg[msg_fil_spec]);
    mx$release_asciz(.msg[msg_sender_string]);
    mx$release_asciz(.msg[msg_subject_string]);

    list = .msg[msg_work_req_list];
    WHILE .list NEQ 0 DO
        BEGIN
        mx$remove_request(.msg,.list[lst_data]);
        list = .list[lst_next];
        END;

    list = .msg[msg_err_list];
    msg[msg_err_list] = 0;
    WHILE .list NEQ 0 DO
        BEGIN
        prv_list = .list;
        list = .list[lst_next];
        mx$release_asciz(.prv_list[lst_data]);
        IF .prv_list[lst_xtra] NEQ 0
        THEN
            nmu$memory_release(.prv_list[lst_xtra], rb_block_size);
        prv_list[lst_data] = prv_list[lst_next] = prv_list[lst_xtra] = 0;
        nmu$memory_release(.prv_list, list_block_size);
        END;

    nmu$memory_release(.msg, message_table_entry_size);
    END;
%routine('MX$COMMUNICATE', msg: REF message_table_entry): NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
!       This routine formats up a mail message back to the user based on the
!   linked list of error strings contained in the message table entry.
!   ***NOTE*** This is not yet implemented.
!
! FORMAL PARAMETERS:
!
!	MSG:        The message table entry.
!
! IMPLICIT INPUTS:
!
!       NONE
!
! IMPLICIT OUTPUTS:
!
!	The envelope file.
!
! COMPLETION CODES:
!
!	NONE
!
! SIDE EFFECTS:
!
!       NONE
!--

    BEGIN
    BIND
        crlf = CH$PTR(UPLIT(%ASCIZ %CHAR(%O'15', %O'12')));

    STACKLOCAL
        buffer: VECTOR[CH$ALLOCATION(max_string_length)],
        timbuf: VECTOR[CH$ALLOCATION(30)];

    LOCAL
        msgblk: REF list_blk,
        msgfil,
        page: REF ipcf_hdr,
        rec: REF ipcf_rec,
        inpfil,
        fil,
        len,
        ptr,
        error;

    MACRO
        pm_string = 'POSTMASTER' %;

    %IF %SWITCHES(TOPS20) %THEN declare_jsys(odtim); %FI

    $TRACE('COMMUNICATE called');

    page = nmu$page_get() * %O'1000';
    page[hdr_type] = lcl_post;
    page[hdr_domain_id] = $local;
    page[hdr_id] = 0;
    page[hdr_sequence] = 1;
    page[hdr_status] = lcl_complete;
    page[hdr_record_count] = 3;
    rec = page[hdr_record];

    fil = mx$unique_msg_file_name();
    len = CH$LEN(CH$PTR(.fil)) + 1;
    rec[rec_seq] = 1;
    rec[rec_type] = rec_file;
    rec[rec_error] = 0;
    rec[rec_length] = 3 + CH$ALLOCATION(.len);
    CH$MOVE(.len, CH$PTR(.fil), CH$PTR(rec[rec_data]));
 
    rec = .rec + .rec[rec_length];
    len = %CHARCOUNT(pm_string) + 1;
    rec[rec_seq] = 2;
    rec[rec_type] = rec_sender;
    rec[rec_error] = 0;
    rec[rec_length] = 3 + CH$ALLOCATION(.len);
    CH$MOVE(.len, CH$PTR(UPLIT(%ASCIZ pm_string)), CH$PTR(rec[rec_data]));
 
    rec = .rec + .rec[rec_length];
    len = CH$LEN(CH$PTR(.msg[msg_sender_string])) + 1;
    rec[rec_seq] = 3;
    rec[rec_type] = rec_dest;
    rec[rec_error] = 0;
    rec[rec_length] = 3 + CH$ALLOCATION(.len);
    CH$MOVE(.len, CH$PTR(.msg[msg_sender_string]), CH$PTR(rec[rec_data]));

    %IF %SWITCHES(TOPS20) %THEN
        $$odtim(CH$PTR(timbuf),-1,ot_tmz);
    %ELSE
        udtdat(-1,timbuf);
    %FI

    ptr = CH$PTR(buffer);
    len = $nmu$text(ptr,max_string_length,%STRING(
            'Date: %A%/',
            'From: Postmaster <POSTMASTER@%A>%/',
            'To: %A%/',
            'Subject: Undeliverable Mail%/%/',
 
       'MX%A was unable to deliver some (or all) of the mail contained%/',
       'in the file %A because:%/%/%/'),
 
            CH$PTR(timbuf),
            CH$PTR(nodnam),
            CH$PTR(.msg[msg_sender_string]),
            CH$PTR(verstr),
            CH$PTR(.msg[msg_fil_spec])) - 1;
 

    IF NOT (msgfil = mx$file_open(
                        CH$PTR(.fil),
                        file_access_write_only,
                        error)) GTR 0
    THEN
        RETURN $error(SEVERITY =        $warning,
                      FACILITY =        $internal,
                      CODE =            uf$fof,
                      MESSAGE_DATA =    CH$PTR(.fil),
                      OPTIONAL_MESSAGE= $error_code,
                      OPTIONAL_DATA =   .error);
 
    IF NOT mx$file_write(.msgfil, CH$PTR(buffer), .len, error)
    THEN
        BEGIN
        $error(SEVERITY =          $warning,
               CODE =              uf$fwf,
               FACILITY =          $internal,
               MESSAGE_DATA =      CH$PTR(.fil),
               OPTIONAL_MESSAGE =  $error_code,
               OPTIONAL_DATA =     .error); 
 
        mx$file_close(.msgfil, file_abort, error);
        RETURN
        END;
       
    msgblk = .msg[msg_err_list];

    WHILE .msgblk NEQ 0 DO
        BEGIN
        ptr = CH$PTR(buffer);
        len = $nmu$text(ptr,max_string_length,
                        '%A%/',CH$PTR(.msgblk[lst_data])) - 1;

        $TRACE('"%A" has %D characters',CH$PTR(buffer),.len);

        IF NOT mx$file_write(.msgfil, CH$PTR(buffer), .len, error)
        THEN
            BEGIN
            $error(SEVERITY =          $warning,
                   CODE =              uf$fwf,
                   FACILITY =          $internal,
                   MESSAGE_DATA =      CH$PTR(.fil),
                   OPTIONAL_MESSAGE =  $error_code,
                   OPTIONAL_DATA =     .error); 
 
            mx$file_close(.msgfil, file_abort, error);
            RETURN
            END;

        msgblk = .msgblk[lst_next];
        END;

    IF .msg[msg_sender_domain] EQL $local
    THEN
        BEGIN
        LOCAL
            repbuf;

        REPPAR(.msg[msg_fil_spec], repbuf);
        ptr = CH$PTR(buffer);
        len = $nmu$text(ptr,max_string_length,%ASCIZ %STRING(
              '%/You may use the command "REPAIR %A" to repair the message.%/',
              '   --------%/'),
              CH$PTR(repbuf)) - 1;

        IF NOT mx$file_write(.msgfil, CH$PTR(buffer), .len, error)
        THEN
            BEGIN
            $error(SEVERITY =          $warning,
                   CODE =              uf$fwf,
                   FACILITY =          $internal,
                   MESSAGE_DATA =      CH$PTR(.fil),
                   OPTIONAL_MESSAGE =  $error_code,
                   OPTIONAL_DATA =     .error); 

            mx$file_close(.msgfil, file_abort, error);
            RETURN
            END;
        END
    ELSE
        BEGIN
        MACRO utxt = %STRING(
                    %CHAR(%O'15',%O'12'),
                    'The text of the unsent message follows:',
                    %CHAR(%O'15',%O'12'),
                    '  ========',
                    %CHAR(%O'15',%O'12')) %;

        IF NOT (inpfil = mx$file_open(
                            CH$PTR(.msg[msg_fil_spec]),
                            file_access_read_only,
                            error)) GTR 0
        THEN
            BEGIN
            mx$file_close(.msgfil, file_abort, error);
            RETURN $error(SEVERITY =        $warning,
                          FACILITY =        $internal,
                          CODE =            uf$fof,
                          MESSAGE_DATA =    CH$PTR(.fil),
                          OPTIONAL_MESSAGE= $error_code,
                          OPTIONAL_DATA =   .error);
            END;

        IF NOT mx$file_write(   .msgfil, 
                                CH$PTR(UPLIT(utxt)),
                                %CHARCOUNT(utxt),
                                error)
        THEN
            BEGIN
            mx$file_close(.msgfil, file_abort, error);
            mx$file_close(.inpfil, file_abort, error);
            RETURN $error(SEVERITY =          $warning,
                          CODE =              uf$fwf,
                          FACILITY =          $internal,
                          MESSAGE_DATA =      CH$PTR(.fil),
                          OPTIONAL_MESSAGE =  $error_code,
                          OPTIONAL_DATA =     .error); 
            END;

        WHILE (len = mx$file_read
                 (.inpfil, CH$PTR(buffer), max_string_length, error)) GTR 0 DO

            IF NOT mx$file_write(   .msgfil, 
                                    CH$PTR(buffer),
                                    .len,
                                    error)
            THEN
                BEGIN
                mx$file_close(.msgfil, file_abort, error);
                mx$file_close(.inpfil, file_abort, error);
                RETURN $error(SEVERITY =          $warning,
                              CODE =              uf$fwf,
                              FACILITY =          $internal,
                              MESSAGE_DATA =      CH$PTR(.fil),
                              OPTIONAL_MESSAGE =  $error_code,
                              OPTIONAL_DATA =     .error); 
                END;

        IF .len NEQ 0
        THEN
            BEGIN
            mx$file_close(.msgfil, file_abort, error);
            mx$file_close(.inpfil, file_abort, error);
            RETURN $error(SEVERITY =          $warning,
                          CODE =              uf$fwf,
                          FACILITY =          $internal,
                          MESSAGE_DATA =      CH$PTR(.msg[msg_fil_spec]),
                          OPTIONAL_MESSAGE =  $error_code,
                          OPTIONAL_DATA =     .error); 
            END;

        mx$file_close(.inpfil, file_keep, error);
        mx$file_delete(.msg[msg_fil_spec]);
        END;
       
    mx$file_close(.msgfil, file_keep, error);

    %IF %SWITCHES(TOPS20) %THEN scan_pkt(.page,
                                         0,
                                         -1^18+UPLIT(%ASCIZ'POSTMASTER'),
                                         sc_whl);
                          %ELSE scan_pkt(.page,0,1^18+2,0); %FI

    nmu$page_release(.page/%O'1000');
    END;

%global_routine('REPPAR', spec, buf):NOVALUE =
    BEGIN
%IF %SWITCHES(TOPS20) %THEN
    LOCAL
        found,
        c,
        ptr;

    found = $false;
    spec = CH$PTR(.spec);
    c = CH$RCHAR_A(spec);
    WHILE .c NEQ 0 DO
        SELECTONE .c OF
            SET
            [%C'>', %C']']: BEGIN
                            IF CH$RCHAR_A(spec) EQL %C'M'
                            THEN
                                IF CH$RCHAR_A(spec) EQL %C'S'
                                THEN
                                    found = $true;
                            EXITLOOP;
                            END;

            [%C':']:        IF CH$RCHAR(.spec) EQL %C'M'
                            THEN
                                c = %C'>'
                            ELSE
                                c = CH$RCHAR_A(spec);

            [otherwise]:    c = CH$RCHAR_A(spec);
            TES;

    IF .found
    THEN
        BEGIN
        ptr = CH$PTR(.buf);
        INCR i FROM 1 TO 4 DO
            SELECTONE (c = CH$RCHAR_A(spec)) OF
                SET
                [%C'.']:        CH$WCHAR_A(0, ptr);
                [OTHERWISE]:    CH$WCHAR_A(.c, ptr);
                TES;
        END
    ELSE
        .buf = 0
%ELSE
    LOCAL
        found,
        c,
        ptr;

    found = $false;
    spec = CH$PTR(.spec);
    c = CH$RCHAR_A(spec);
    WHILE .c NEQ 0 DO
        SELECTONE .c OF
            SET
            [%C':']:        BEGIN
                            IF CH$RCHAR_A(spec) EQL %C'M'
                            THEN
                                IF CH$RCHAR_A(spec) EQL %C'S'
                                THEN
                                    found = $true;
                            EXITLOOP;
                            END;

            [otherwise]:    c = CH$RCHAR_A(spec);
            TES;

    IF .found
    THEN
        BEGIN
        ptr = CH$PTR(.buf);
        INCR i FROM 1 TO 4 DO
            SELECTONE (c = CH$RCHAR_A(spec)) OF
                SET
                [%C'.']:        CH$WCHAR_A(0, ptr);
                [OTHERWISE]:    CH$WCHAR_A(.c, ptr);
                TES;
        END
    ELSE
        .buf = 0
%FI
    END;

%global_routine('MX$RELEASE_ASCIZ', string_) :NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
!       This routine calculates the number of words in an ASCIZ string, and
!   calls NMU$MEMORY_RELEASE to release the memory.
!
! FORMAL PARAMETERS:
!
!       STRING: The address of the ASCIZ string.
!
! IMPLICIT INPUTS:
!
!       NONE
!
! IMPLICIT OUTPUTS:
!
!       NONE
!
! COMPLETION CODES:
!
!	NONE
!
! SIDE EFFECTS:
!
!       NONE
!--

    BEGIN
    BIND
        string = .string_;

    LOCAL
        length,
        pointer;

    $TRACE('Release ASCIZ called');
    IF (string EQL 0)
    THEN
        RETURN;

    pointer = CH$PTR(string,0,8);
    IF CH$RCHAR_A(pointer) EQL 0
    THEN
        BEGIN
        pointer = CH$PLUS(.pointer, 1);
        length = CH$ALLOCATION(CH$RCHAR_A(pointer) + 4, 8);
        END
    ELSE
        length = CH$ALLOCATION(CH$LEN(CH$PTR(string), max_string_length) + 1);

    nmu$memory_release(string, .length);
    END;
%global_routine('MX$BUILD_ENVELOPE_SPEC') =
!++
! FUNCTIONAL DESCRIPTION:
!
!       This routine formats up an envelope file spec.  The spec has the
!   following form: LOG:6-hex-digits.ENV where LOG is the logicalname of MX's
!   directory.
!
! FORMAL PARAMETERS:
!
!       NONE
!
! IMPLICIT INPUTS:
!
!       ENV_CNTER:  The counter used to format the 6-hex-digits used in the
!                   file spec.  It gets incremented each time this routine is
!                   called.
!
! IMPLICIT OUTPUTS:
!
!       NONE
!
! ROUTINE VALUE:
!
!	The address of the asciz file spec.
!
! SIDE EFFECTS:
!
!       NONE
!--

    BEGIN
    STACKLOCAL
        spec_buf:   VECTOR[max_file_name_length];

    LOCAL
        adr,
        buf_ptr,
        len;

    env_cntr = .env_cntr + 1;
    buf_ptr = CH$PTR(spec_buf);

    len = $nmu$text(buf_ptr, max_file_name_length, 'UPS:%(6)H.ENV', .env_cntr);

    adr = nmu$memory_get(CH$ALLOCATION(.len));
    CH$MOVE(.len, CH$PTR(spec_buf), CH$PTR(.adr));
    RETURN .adr
    END;
%global_routine('MX$UNIQUE_MSG_FILE_NAME') =
!++
! FUNCTIONAL DESCRIPTION:
!
!       This routine formats up an envelope file spec.  The spec has the
!   following form: LOG:6-hex-digits.ENV where LOG is the logicalname of MX's
!   directory.
!
! FORMAL PARAMETERS:
!
!       NONE
!
! IMPLICIT INPUTS:
!
!       ENV_CNTER:  The counter used to format the 6-hex-digits used in the
!                   file spec.  It gets incremented each time this routine is
!                   called.
!
! IMPLICIT OUTPUTS:
!
!       NONE
!
! ROUTINE VALUE:
!
!	The address of the asciz file spec.
!
! SIDE EFFECTS:
!
!       NONE
!--

    BEGIN
    STACKLOCAL
        spec_buf:   VECTOR[max_file_name_length];

    LOCAL
        adr,
        buf_ptr,
        len;

    env_cntr = .env_cntr + 1;
    buf_ptr = CH$PTR(spec_buf);

    len = $nmu$text(buf_ptr, max_file_name_length, 'UPS:%(6)H.MSG', .env_cntr);

    adr = nmu$memory_get(CH$ALLOCATION(.len));
    CH$MOVE(.len, CH$PTR(spec_buf), CH$PTR(.adr));
    RETURN .adr
    END;
%routine('MX$CHANGE_EXT',spec,ext) =
    BEGIN
    LOCAL
        ptr,
        c,
        dflag,
        ext_count,
        nam_count,
        rem_count,
        rem,
        new_spec;

    nam_count = ext_count = rem_count = dflag = 0;
    ptr = .ext;
    WHILE CH$RCHAR_A(ptr) NEQ 0 DO ext_count = .ext_count + 1;
    ptr = .spec;

%IF %SWITCHES(TOPS20) %THEN
    BEGIN
    LOCAL
        jfn;
    STACKLOCAL
        buffer: VECTOR[CH$ALLOCATION(max_string_length)];

    declare_jsys(gtjfn,jfns,rljfn);

    $$gtjfn(gj_sht OR gj_old,.ptr;jfn);
    $$jfns(CH$PTR(buffer),.jfn,
            FLD($jsaof,js_dev) OR FLD($jsaof,js_dir) OR FLD($jsaof,js_nam) OR
            FLD($jsaof,js_typ) OR js_paf);
    $$rljfn(.jfn);

    ptr = CH$PTR(buffer);
            
    !
    ! The following loop ignores "." within "[...]" or "<...>"
    !
    WHILE (c = CH$RCHAR(.ptr)) NEQ 0 DO
        BEGIN
        ptr = CH$PLUS(.ptr, 1);
        nam_count = .nam_count + 1;
        SELECTONE .c OF
            SET
            [%C'.']:        IF .dflag EQL 0 THEN EXITLOOP;
            [%C'<',%C'[']:  dflag = .dflag + 1;
            [%C'>',%C']']:  dflag = .dflag - 1;
            TES;
        END;
    new_spec = nmu$memory_get(CH$ALLOCATION(.nam_count + .ext_count + 1)); 
    CH$COPY(.nam_count, CH$PTR(buffer),
            .ext_count, .ext,
            0,
            .nam_count + .ext_count +  1, CH$PTR(.new_spec));
    END;
%ELSE
    nam_count = 1;
    WHILE CH$RCHAR_A(ptr) NEQ %C'.' DO nam_count = .nam_count + 1;

    WHILE $true DO
        BEGIN
        SELECTONE CH$RCHAR(.ptr) OF
            SET
            [%C'[', 0]: EXITLOOP;
            TES;

        ptr = CH$PLUS(.ptr,1);
        END;

    rem = .ptr;
    WHILE CH$RCHAR_A(ptr) NEQ 0 DO rem_count = .rem_count + 1;

    new_spec = nmu$memory_get(
                    CH$ALLOCATION(.nam_count + .ext_count + .rem_count + 1));

    CH$COPY(.nam_count, .spec,
            .ext_count, .ext,
            .rem_count, .rem,
            0,
            .nam_count + .ext_count + .rem_count + 1, CH$PTR(.new_spec));
%FI
    RETURN .new_spec;
    END;

%global_routine('MX$MESSAGE_QUEUE_DEFER'):NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!	This task handle's deferal processing of work requests.  This task
!   scans its queue for any requests that have been defered long enough.  These
!   tasks get their state set to send, and get requeued to the WORK-QUEUE.
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	This task takes work requests from the DFER_QUEUE.
!
! IMPLICIT OUTPUTS:
!
!	Work requests get requeued to the WORK_QUEUE after they have been
!   defered.
!
! COMPLETION CODES:
!
!	NONE
!
! SIDE EFFECTS:
!
!	NONE
!
!--

    BEGIN
    LITERAL
	wake_up_interval = 2*60; !Seconds

    LOCAL
        error,
        last_change,
        domain: REF domain_data_block,
	current_time;

    WHILE 1 DO
	BEGIN
	$TRACE('Defer running');
!
! Get the current time
!
	time_current(0, current_time);
!
! Scan the queue, rescheduling any request whose sleep-time has expired...
!
        nmu$queue_scan(dfer_queue,.current_time,mx$wake_up);
!
! Check to see if the error log file has been modified, CKP if so...
!
        IF .mxlogm 
        THEN
            BEGIN
            mx$file_close(.mxlogf, file_keep, error);
            mxlogf = mxlogm = 0;
            END;

!
! Scan each domain, and check to see if any of the database files have changed
!
        INCR i FROM 0 TO max_number_of_domains - 1 DO
            BEGIN
            domain = .nettab[.i];
            IF .domain[dom_init_file] NEQ 0
            THEN
                BEGIN
                last_change = 
                    mx$file_written_date(CH$PTR(.domain[dom_init_file]));

                IF time_test(last_change, GTR, domain[dom_last_init_time])
                THEN
                    mx$data_initialize(.i);
                END;

            END;

	nmu$sched_sleep(wake_up_interval);

	END;
    END;			!End of MX$MESSAGE_QUEUE_DEFER
%global_routine('MX$WAKE_UP', request: REF work_request_block, tim) =

!++
! FUNCTIONAL DESCRIPTION:
!	This task requeues work_requests that have been sleeping for at least
!   their sleep time.
!
! FORMAL PARAMETERS:
!
!	REQUEST	- A queue entry containing a work request.
!	TIME	- The current time.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	Work requests get inserted into the WORK_QUEUE.
!
! COMPLETION CODES:
!
!	Returns 0 always to tell NMU$QUEUE_SCAN to continue scanning.
!
! SIDE EFFECTS:
!
!	NONE
!
!--

    BEGIN
    LOCAL
        msg: REF message_table_entry,
        wake_time;

    wake_time = .request[req_state_specific_field];
    IF time_test(wake_time, LEQ, tim)
    THEN
	BEGIN
	nmu$queue_scan_extract(.request);
	$mx$change_state(.request, $send);
	END
    ELSE
        BEGIN
        nmu$table_fetch(active_message_table,
                        .request[req_message_id],
                        msg);

        IF ((.msg[msg_state] EQL $msg_canceled) OR
            (.msg[msg_state] EQL $msg_restart))
        THEN
            BEGIN
            nmu$queue_scan_extract(.request);
            $mx$change_state(.request)
            END
        ELSE
	    IF .request[req_state] EQL $defer
	    THEN
	        IF time_test(request[req_time_to_live], LEQ, tim)
	        THEN
		    BEGIN
		    nmu$queue_scan_extract(.request);
		    $mx$change_state(.request, $reject); !Msg has expired
		    END;
        END;
    RETURN 0
    END;			!End of MX$WAKE_UP

END				!End of module MXQMAN
ELUDOM