From:	SMTP%"RELAY-INFO-VAX@CRVAX.SRI.COM" 25-MAY-1993 14:56:15.41
To:	EVERHART
CC:	
Subj:	Re: Communication between processes using Mailboxes

Date: Tue, 25 May 1993 09:37 +1000
From: "Tony Farrell, Anglo-Australian Observatory." <TJF@aaoepp2.aao.GOV.AU>
Subject: Re: Communication between processes using Mailboxes
To: info-vax@kl.sri.com
Message-Id: <689E8FD180600FCE@aaoepp.oz.au>
X-Envelope-To: info-vax@kl.sri.com
X-Vms-To: IN%"info-vax@kl.sri.com"
X-Vms-Cc: TJF

Below is a bit of Vax-Pascal code which implements communication between
processes using mailboxes  in order to run a DCL subprocess.  It has been 
handed down though a few generations but does work.  You will have to 
replace SIN_WRITE_A_LINE and UTASK_MESSAGE with your own versions.  
(They both basically just write to the screen but use different string 
types due to the messing around with interfacing to fortran)

Tony Farrell
Anglo-Australian Observatory.


[INHERIT ('SYS$LIBRARY:STARLET.PEN',
	  'SYS$LIBRARY:PASCAL$LIB_ROUTINES')]
MODULE DCL(OUTPUT);

{**********************************************************************}
{                                                                      }
{   Module DCL    -    Send commands to DCL sub-process                }
{                                                                      }
{   DCL_COM  -   Issue a DCL command                                   }
{   DCL_TIDY -   Tidy up DCL subprocess after interrupt                }
{   DCL_DEL  -   Delete the DCL subprocess                             }
{   DCL_ON   -   Test whether DCL subprocess running                   }
{                                                                      }
{   William Lupton   1989 Sep 13                                       }
{                                                                      }
{   Based on parts of Jeremy Bailey's ICLIO module; all routines not   }
{   relevant to DCL commands cut out; routines made global and Fortran }
{   callable. SIN_WRITE_LINE80 and UTASK_READ used.                    }
{                                                                      }
{   21-Sep-89 - WFL - Use mailbox for both SYS$INPUT and SYS$OUTPUT    }
{   22-Sep-89 - WFL - Avoid use of ASTs - use QIO setting event flags  }
{		on completion (cannot support responding to prompts    }
{		from images in the DCL sub-process any more); use two  }
{		mailboxes                                              }
{   08-Feb-91 - TJF - Use SIN_WRITE_LINE80 to output to avoid UTASK's  }
{		formating of output.				       }
{   12-Feb-91 - TJF - ADD fuction CHECK_SYS_OUTPUT.  This function is  }
{		used to ensure the definition of SYS$OUTPUT for the    }
{		spawed process is not overwritten by a user mode       }
{		logical name.  If it is we must deassign it in the     }
{		subprocess to ensure output goes to the correct spot.  }
{		Also, use pascal$lib_routines to get the definitions   }
{		of the lib$ routines.  This led to some changes in      }
{		variable declarations to get the types correct	       }
{   13-Feb-91 - TJF - Ensure SIN_WRITE_LINE80 is not passed a string   }
{	        longer than 80 characters.			       }
{   23-Apr-91 - TJF - Use SIN_WRITE_A_LINE instead of SIN_WRITE_LINE80 }
{		It handles lines greater then 80 characters line       }
{                                                                      }
{**********************************************************************}

[HIDDEN] CONST
    NAMLEN = 20;
    STRLEN = 256;
    UTASK__OK = 0;

[HIDDEN] TYPE
    UWORD = [WORD] 0..65535;
    UBYTE = [BYTE] 0..255;

[HIDDEN] VAR
    DCL_RUNNING: BOOLEAN := FALSE;
    SUBPRC: VARYING[NAMLEN] OF CHAR;
    READCHAN: UWORD;
    READBUF: PACKED ARRAY[1..STRLEN] OF CHAR;
    READBUFLEN: INTEGER;
    READIOSB: PACKED ARRAY[1..4] OF UWORD;
    READEFN: UNSIGNED;
    WRITCHAN: UWORD;
    WRITBUF: PACKED ARRAY[1..STRLEN] OF CHAR;
    WRITBUFLEN: INTEGER;
    WRITIOSB: PACKED ARRAY[1..4] OF UWORD;
    WRITEFN: UNSIGNED;
    COMPEFN: UBYTE;

[EXTERNAL] PROCEDURE SIN_WRITE_A_LINE(
    MESSAGE: VARYING[L] OF CHAR;
    BELLSEEN : BOOLEAN := FALSE); EXTERNAL;

[EXTERNAL] PROCEDURE UTASK_MESSAGE(
    MESSAGE: [CLASS_S] PACKED ARRAY[$L1..$U1:INTEGER] OF CHAR;
    VAR STAT : INTEGER); EXTERNAL;

[EXTERNAL] PROCEDURE UTASK_READ(
    PROMPT: [CLASS_S] PACKED ARRAY[$L1..$U1:INTEGER] OF CHAR;
    VAR VALUE: [CLASS_S] PACKED ARRAY[$L2..$U2:INTEGER] OF CHAR;
    VAR STAT: INTEGER); EXTERNAL;

[HIDDEN]
PROCEDURE MBX_READ;

{ Initiate a read from the sub-process' output mailbox }

    VAR
	STAT: INTEGER;

    BEGIN
	READBUFLEN := LENGTH(READBUF);
	STAT := $QIO(EFN  := READEFN,
		     CHAN := READCHAN,
		     FUNC := IO$_READVBLK,
		     IOSB := READIOSB,
		     P1   := READBUF,
		     P2   := READBUFLEN);
    END;



[HIDDEN]
PROCEDURE MBX_READSTR(VAR STR: VARYING[L] OF CHAR);

{ Return string read from the mailbox - for use by DCL_COM }

    BEGIN
	STR := SUBSTR(READBUF,1,READIOSB[2])
    END;



[HIDDEN]
PROCEDURE MBX_WRIT(COM: VARYING[L] OF CHAR);

{ Write to the sub-process' input mailbox }

    VAR
	STAT: INTEGER;

    BEGIN
	WRITBUFLEN := LENGTH(COM);
	WRITBUF := SUBSTR(COM,1,WRITBUFLEN);
	STAT := $QIO(EFN  := WRITEFN,
		     CHAN := WRITCHAN,
		     FUNC := IO$_WRITEVBLK,
		     IOSB := WRITIOSB,
		     P1   := WRITBUF,
		     P2   := WRITBUFLEN)
    END;



[HIDDEN]
PROCEDURE MBX_WRITEOF;

{ Write EOF to the sub-process' input mailbox }

    VAR
	STAT: INTEGER;

    BEGIN
	STAT := $QIO(EFN  := WRITEFN,
		     CHAN := WRITCHAN,
		     FUNC := IO$_WRITEOF,
		     IOSB := WRITIOSB)
    END;

[HIDDEN]
FUNCTION CHECK_SYS_OUTPUT : BOOLEAN;

{ Returns true if sys$output is defined at user mode in the process table }
{ If this is the case, then the output from any command before an image   }
{ rundown will go astray, so it must be deleted				  }
    CONST
	BELL = ''(7);	     { BELL character }
    VAR 
	STAT : INTEGER;
	TRANSLATION : PACKED ARRAY[1..255] OF CHAR;
	MES: PACKED ARRAY[1..100] OF CHAR;	
	MODE : [BYTE] 0..255 VALUE PSL$C_USER;
	LEN: [WORD] 0..65535;

    BEGIN
	STAT := LIB$SYS_TRNLOG(LOGICAL_NAME := 'SYS$OUTPUT',
			      DESTINATION_STRING := TRANSLATION,
			      ACCESS_MODE := MODE);
	IF STAT = SS$_NORMAL THEN
	    CHECK_SYS_OUTPUT := TRUE
        ELSE IF STAT <> SS$_NOTRAN THEN
	    BEGIN
	    $GETMSG(STAT,LEN,MES,FLAGS:=0);
	    STAT := 0;
	    UTASK_MESSAGE(SUBSTR(MES,1,LEN)+BELL,STAT);
	    CHECK_SYS_OUTPUT := FALSE
	    END
	ELSE
	    CHECK_SYS_OUTPUT := FALSE;
	    
    END;

[GLOBAL]
PROCEDURE DCL_DEL;

{  Delete the DCL subprocess }

    BEGIN

{ Mark mailboxes for deletion }

	$DELMBX(CHAN := READCHAN);
	$DELMBX(CHAN := WRITCHAN);

{ Deassign channels to mailbox }

	$DASSGN(CHAN := READCHAN);
	$DASSGN(CHAN := WRITCHAN);

{ Delete the subprocess }

	DCL_RUNNING := FALSE;
	LIB$FREE_EF(READEFN);
	LIB$FREE_EF(WRITEFN);
	$DELPRC(PRCNAM := SUBPRC);
	$WAITFR(COMPEFN);
	LIB$FREE_EF(COMPEFN)
    END;



[GLOBAL]
PROCEDURE DCL_COM(DCL_COMMAND: [CLASS_S] PACKED ARRAY[B..L:INTEGER] OF CHAR);

{ Issue a DCL command - This is done by running the command in a
  permanent subprocess with its input connected to a mailbox.
  The subprocess is created on the first call to DCL_COM       }

    LABEL 1;

    VAR
	INITIALIZED: [STATIC] BOOLEAN := FALSE;
	PRCNAM: [STATIC] PACKED ARRAY[1..NAMLEN] OF CHAR;
	EFMASK: [STATIC,LONG] PACKED SET OF 0..31;
	EF: 0..31;
	LEN: UWORD;
	READMBX: VARYING[NAMLEN] OF CHAR;
	WRITMBX: VARYING[NAMLEN] OF CHAR;
	STR: VARYING[STRLEN] OF CHAR;
	IMAGE: PACKED ARRAY[1..STRLEN] OF CHAR;
	STAT: INTEGER;
	STATE: UNSIGNED;
	SHOWSENT: BOOLEAN;
	FINISHED: BOOLEAN;
	I: INTEGER;
	J: UNSIGNED;

    BEGIN
	STAT := $READEF(COMPEFN,STATE);
	IF STAT = SS$_WASSET THEN
	    DCL_DEL;
	IF (NOT INITIALIZED) OR (STAT = SS$_WASSET) THEN
	BEGIN

{ Create two mailboxes - deriving the logical names from the current process }
{ name }

	    STAT := UTASK__OK;
	    SIN_WRITE_A_LINE('Creating DCL subprocess');
	    LEN := 0;
	    LIB$GET_EF(J);
	    COMPEFN := ORD(J);
	    LIB$GETJPI(item_code := JPI$_PRCNAM,
		       resultant_string := PRCNAM,
                       resultant_length := LEN);
	    FOR I := 1 TO LEN DO
	        IF NOT (PRCNAM[I] IN ['A'..'Z','a'..'z','1'..'9','_']) THEN
		    PRCNAM[I] := '_';
	    IF LEN > 13 THEN LEN := 13;
	    READMBX := 'RM'+SUBSTR(PRCNAM,1,LEN);
	    WRITMBX := 'WM'+SUBSTR(PRCNAM,1,LEN);
	    SUBPRC := 'SP'+SUBSTR(PRCNAM,1,LEN);
	    STAT := $CREMBX( CHAN := READCHAN,
                              LOGNAM := READMBX);
	    IF NOT ODD(STAT) THEN GOTO 1;
	    STAT := $CREMBX( CHAN := WRITCHAN,
                              LOGNAM := WRITMBX);
	    IF NOT ODD(STAT) THEN GOTO 1;

{ Spawn a subprocess with input connected to the mailbox }
{ If a duplicate name status is returned, cycle the first letter }
{ to try to find a unique name  }

	    REPEAT
	        STAT := LIB$SPAWN(Input_file := WRITMBX, 
				  Output_file := READMBX,
				  Flags := 1,
				  Process_name := SUBPRC,
				  Byte_integer_event_flag_num := COMPEFN);
		IF STAT = SS$_DUPLNAM THEN
		BEGIN
		    SUBPRC[1] := SUCC(SUBPRC[1]);
		    IF SUBPRC[1] = 'Z' THEN SUBPRC[1] := 'A'
		END;
	    UNTIL (NOT (STAT = SS$_DUPLNAM)) AND (SUBPRC[1] <> 'R');
	    IF NOT ODD(STAT) THEN GOTO 1;	    	    

{ Build Event Flag Mask }

	    LIB$GET_EF(READEFN);
	    LIB$GET_EF(WRITEFN);
	    EFMASK := [];
	    EF := (READEFN::INTEGER) MOD 32;
	    EFMASK := EFMASK + [EF];
	    EF := (WRITEFN::INTEGER) MOD 32;
	    EFMASK := EFMASK + [EF];
	    I := COMPEFN;
	    EF := I MOD 32;
	    EFMASK := EFMASK + [EF];
	    MBX_WRIT('SET NOON');
	    IF CHECK_SYS_OUTPUT THEN 
		MBX_WRIT('DEASSIGN/USER_MODE SYS$OUTPUT');
	    INITIALIZED := TRUE;
	    DCL_RUNNING := TRUE;
	    1:
	END;
	IF INITIALIZED THEN
	BEGIN

{ Send the command to the subprocess and initiate a read }

	    MBX_WRIT(DCL_COMMAND);
	    MBX_READ;

{ Wait until the command is complete (indicated by the next command being }
{ read by DCL) }

	    SHOWSENT := FALSE;
	    FINISHED := FALSE;
	    REPEAT
		$WFLOR(COMPEFN,EFMASK::UNSIGNED);

{ Check whether the DCL sub-process has died }

		STAT := $READEF(COMPEFN,STATE);
		IF STAT = SS$_WASSET THEN
		BEGIN
		    DCL_DEL;
		    STAT := UTASK__OK;
		    SIN_WRITE_A_LINE('The DCL Subprocess has died');
		    FINISHED := TRUE
		END

{ Check whether the DCL sub-process wants to write a string }

		ELSE
		BEGIN
		    STAT := $READEF(READEFN,STATE);
		    IF STAT = SS$_WASSET THEN
		    BEGIN
			MBX_READSTR(STR);
			IF SUBSTR(STR,1,MIN(13,LENGTH(STR))) <>
							'  $STATUS == ' THEN
			BEGIN
			    STAT := UTASK__OK;
			    SIN_WRITE_A_LINE(STR);
			    MBX_READ
			END
			ELSE
			BEGIN
			    FINISHED := TRUE
			END
		    END

{ The DCL sub-process wants to read a string. Check that the image is DCL. }
{ If not, the subprocess is prompting for input from some other image, so }
{ abort the image }

		    ELSE
		    BEGIN
			STAT := LIB$GETJPI(Item_code := JPI$_IMAGNAME,
					   Process_name := SUBPRC,
					   resultant_string := IMAGE,
					   resultant_length := LEN);
		      { WRITELN('STAT=',HEX(STAT),',IMAGE="',SUBSTR(IMAGE,1,
				LEN),'"'); }
			IF IMAGE <> '' THEN
		     	BEGIN
			  { STAT := UTASK__OK;
			    SIN_WRITE_A_LINE('Read complete; not DCL; sending '+
					  'EOF...'); }
			    MBX_WRITEOF
			END
			ELSE IF NOT SHOWSENT THEN
			BEGIN
			    MBX_WRIT('SHOW SYMBOL $STATUS');
			    SHOWSENT := TRUE
			END
			ELSE
			BEGIN
			    $CLREF(WRITEFN)
			END
		    END
		END
	    UNTIL FINISHED
        END
	ELSE
	BEGIN
	    STAT := UTASK__OK;
	    SIN_WRITE_A_LINE('Could Not Create DCL Subprocess')
	END
    END;



[GLOBAL]
PROCEDURE DCL_TIDY;

{ Tidy DCL subprocess after an interrupt by forcing image exit if there
  is an image running }

    VAR
	LEN: UWORD;
	IMAGE: PACKED ARRAY[1..STRLEN] OF CHAR;
	STAT: INTEGER;
	FINISHED: BOOLEAN;

    BEGIN
        FINISHED := FALSE;
	REPEAT
	    LEN := 0;
 	    STAT := LIB$GETJPI(Item_code := JPI$_IMAGNAME,
			       Process_name := SUBPRC,
			       resultant_string := IMAGE,
			       resultant_length := LEN);
	    IF IMAGE <> '' THEN
	    BEGIN
	        $FORCEX(PRCNAM := SUBPRC);
	        LIB$WAIT(1.0)
	    END
	    ELSE
	        FINISHED := TRUE;
	UNTIL FINISHED
    END;



[GLOBAL]
FUNCTION DCL_ON: BOOLEAN;

{ Test whether DCL subprocess running }

    BEGIN
	DCL_ON := DCL_RUNNING
    END;

END.

