Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP
Path: utzoo!mnetor!uunet!husc6!mit-eddie!genrad!decvax!ucbvax!RSBS0.anu.OZ.AU!STRASSER
From: STRASSER@RSBS0.anu.OZ.AU
Newsgroups: comp.os.vms
Subject: DO & NOTIFY utilities (1 of 2)
Message-ID: <8709260339.AA20218@uunet.UU.NET>
Date: Mon, 21-Sep-87 16:04:45 EDT
Article-I.D.: uunet.8709260339.AA20218
Posted: Mon Sep 21 16:04:45 1987
Date-Received: Sun, 27-Sep-87 11:08:10 EDT
Sender: daemon@ucbvax.BERKELEY.EDU
Distribution: world
Organization: The ARPA Internet
Lines: 362


	Herewith, the SHAR'd source of my utility DO in Pascal.  This
utility sends commands to a slave subprocess to execute via a mailbox,
creating the subprocess (& mailbox) if necessary. 

	I find it very useful if I'm working on a program in a number of
files, where I get the subprocess to compile while I'm editing another.  
While this may involve some CPU hogging, it's fair when you're editing 
because you spend a lot of your time thinking (I do, anyway).

	DO is documented in its header, but briefly:  it should be set up 
as a foreign command, and it requires NOTIFY to be another foreign 
command (NOTIFY is in the other posting of this pair).

	An observation:  I originally wrote these utilities in VAX C, and 
re-wrote them in Pascal as an exercise, having discovered how versatile 
VAX Pascal is.  When written in C, the executables are about 65-70 blocks 
in size each; in Pascal they are 5 and 4 blocks.  Is this because of the 
amount of shareable code in the Pascal libraries?

	Please send me copies of any improvements/alterations you make to
the code.  I hope these are useful to someone.

Enjoy!
-------------------------------------------------------------------------------
Mike Strasser				Research School of Biological Sciences
					Australian National University

ACSnet, CSnet	:  strasser@rsbs0.anu.oz
INTERNET	:  strasser%rsbs0.anu.oz@uunet.uu.net
UUCP		:  {uunet,hplabs,ubc-vision,nttlab,mcvax,ukc}!munnari
			!rsbs0.anu.oz!strasser
-------------------------------------------------------------------------------
....................... Cut between dotted lines and save ......................
$!.............................................................................
$! VAX/VMS archive file created by VMS_SHAR V-4.03 05-Aug-1987
$! which was written by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au)
$! To unpack, simply save and execute (@) this file.
$!
$! This archive was created by STRASSER
$!      on Monday 14-SEP-1987 15:07:02.52
$!
$! It contains the following 1 file:
$! DO.PAS
$!=============================================================================
$ Set Symbol/Scope=(NoLocal,NoGlobal)
$ Version=F$GetSYI("VERSION") ! See what VMS version we have here:
$ If Version.ges."V4.4" then goto Version_OK
$ Write SYS$Output "Sorry, you are running VMS ",Version, -
                ", but this procedure requires V4.4 or higher."
$ Exit 44
$Version_OK: CR[0,8]=13
$ Pass_or_Failed="failed!,passed."
$ Goto Start
$Convert_File:
$ Read/Time_Out=0/Error=No_Error1/Prompt="creating ''File_is'" SYS$Command ddd
$No_Error1: Define/User_Mode SYS$Output NL:
$ Edit/TPU/NoSection/NoDisplay/Command=SYS$Input/Output='File_is' -
        VMS_SHAR_DUMMY.DUMMY
f:=Get_Info(Command_Line,"File_Name");b:=Create_Buffer("",f);
o:=Get_Info(Command_Line,"Output_File");Set (Output_File,b,o);
Position (Beginning_of(b));Loop x:=Erase_Character(1); Loop ExitIf x<>"V";
Move_Vertical(1);x:=Erase_Character(1);Append_Line;Move_Horizontal
(-Current_Offset);EndLoop;Move_Vertical(1);ExitIf Mark(None)=End_of(b)
EndLoop;Exit;
$ Delete VMS_SHAR_DUMMY.DUMMY;*
$ Checksum 'File_is
$ Success=F$Element(Check_Sum_is.eq.CHECKSUM$CHECKSUM,",",Pass_or_Failed)+CR
$ Read/Time_Out=0/Error=No_Error2/Prompt=" CHECKSUM ''Success'" SYS$Command ddd
$No_Error2: Return
$Start:
$ File_is="DO.PAS"
$ Check_Sum_is=1046236136
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
V{==============================================================================
X}
V{                                 DO                                           
X}
V{                                                                              
X}
V{                 (c) Copyright Mike Strasser 1987                             
X}
V{                                                                              
X}
V{    This software is granted to the public domain.  It may be distributed     
X}
V{    freely provided that no payment is taken, and that this message remains   
X}
V{    intact.                                                                   
X}
V{                                                                              
X}
V{==============================================================================
X}
V{                                                                              
X}
V{    A program to send commands to a subprocess via a mailbox.  It will        
X}
V{  create the subprocess if necessary and, using the NOTIFY program, issues    
X}
V{  a message when the command has completed.                                   
X}
V{                                                                              
X}
V{    The images of DO and NOTIFY must be set up to run as foreign commands,    
X}
V{  Commands are sent to the subprocess as in this example:                     
X}
V{                                                                              
X}
V{          $ DO PAS MYPROGRAM                                                  
X}
V{                                                                              
X}
V{  The command "PAS MYPROGRAM" is sent to the subprocess, followed by the      
X}
V{  command "NOTIFY "Command PAS MYPROGRAM has completed"".                     
X}
V{                                                                              
X}
V{    The subprocess name is constructed from the MASTER_PID of the calling     
X}
V{  process and the mailbox logical name from that.  For example, if the        
X}
V{  MASTER_PID is 0000317F, the subprocess is called "0000317F_Slave" and the   
X}
V{  mailbox logical "MB_0000317F_Slave".                                        
X}
V{                                                                              
X}
V{    When the subprocess is created (using LIB$SPAWN), it has SYS$INPUT set    
X}
V{  to the mailbox logical name, and SYS$OUTPUT set to SYS$SCRATCH:SPAWN.LOG.   
X}
V{  It is also sent 2 commands:  (1) "DEFINE SYS$ERROR xxxx", where xxxx is     
X}
V{  the translation of 'TT' of the creating process.  (2) "SET NOON", because   
X}
V{  a process with SYS$INPUT equated to a mailbox behaves like a command        
X}
V{  procedure, and exits from its command level ON ERROR or worse.  This is     
X}
V{  undesired, the errors should just be reported to SYS$ERROR.  Unfortunately, 
X}
V{  informational messages are sent to SYS$ERROR, so they can clutter the       
X}
V{  screen.                                                                     
X}
V{                                                                              
X}
V{==============================================================================
X}
X
X[INHERIT( 'SYS$LIBRARY:STARLET' )]
XPROGRAM _DO( Output );
X
XCONST
X  OutputFile = 'SYS$SCRATCH:SPAWN.LOG';
X  Terminal = 'TT';
X
XTYPE
X  UnsignedWord = [WORD] 0..65535;
X  SignedWord = [WORD] -32768..32767;
X  UnsignedByte = [BYTE] 0..255;
X  StatusBlock = RECORD
X                  Status,
X                  TransferCount : UnsignedWord;
X                  Dummy : INTEGER;
X                END;
X  CondCode = UNSIGNED;
X  Mask = UNSIGNED;
X
XVAR
X  CommandLine : VARYING [255] OF CHAR;
X  SubprocessName : VARYING [15] OF CHAR;
X  MailboxLogicalName : VARYING [18] OF CHAR;
X  SendCommand : VARYING [287] OF CHAR;
X  ErrorLogical : VARYING [32] OF CHAR;
X
X  Status,
X  ProcessStatus : CondCode;
X  PID : INTEGER;
X  MailboxChannel : UnsignedWord;
X  IOStatusBlock : StatusBlock;
X
V{==============================================================================
X}
X
X  FUNCTION LIB$GET_FOREIGN(
X             %DESCR GetStr : VARYING [U1] OF CHAR;
X             %DESCR UserPrompt : [TRUNCATE] VARYING [U2] OF CHAR := %IMMED 0;
X             %REF OutLen : [TRUNCATE] UnsignedWord := %IMMED 0;
X             %REF ForcePrompt : [TRUNCATE] INTEGER := %IMMED 0
X           ) : CondCode; EXTERNAL;
X
X  FUNCTION LIB$GETJPI(
X             %REF ItemCode : INTEGER;
X             %REF ProcessID : [TRUNCATE] UNSIGNED := %IMMED 0;
X             %DESCR ProcessName : [TRUNCATE] VARYING [U1] OF CHAR := %IMMED 0;
X             %REF OutValue : [TRUNCATE] INTEGER := %IMMED 0;
X             %DESCR OutString : [TRUNCATE] VARYING [U2] OF CHAR := %IMMED 0;
X             %REF OutLen : [TRUNCATE] SignedWord := %IMMED 0
X           ) : CondCode; EXTERNAL;
X
X  FUNCTION LIB$SPAWN(
V             %DESCR CommandString : [TRUNCATE] VARYING [U1] OF CHAR := %IMMED 0
X;
X             %DESCR InputFile : [TRUNCATE] VARYING [U2] OF CHAR := %IMMED 0;
X             %DESCR OutputFile : [TRUNCATE] VARYING [U3] OF CHAR := %IMMED 0;
X             %REF Flags : [TRUNCATE] Mask := %IMMED 0;
X             %DESCR ProcessName : [TRUNCATE] VARYING [U4] OF CHAR := %IMMED 0;
X             %REF ProcessID : [TRUNCATE] UNSIGNED := %IMMED 0;
X             %REF CompletionStatus : [TRUNCATE] UNSIGNED := %IMMED 0;
X             %REF CompletionEFN : [TRUNCATE] UnsignedByte := %IMMED 0;
X             %IMMED [UNBOUND, ASYNCHRONOUS] PROCEDURE CompletionASTAdr
X                                              := %IMMED 0;
X             %IMMED CompletionASTPrm : UNSIGNED := %IMMED 0;
X             %DESCR Prompt : [TRUNCATE] VARYING [U5] OF CHAR := %IMMED 0;
X             %DESCR CLI : [TRUNCATE] VARYING [U6] OF CHAR := %IMMED 0
X           ) : CondCode; EXTERNAL;
X
X  FUNCTION LIB$SYS_TRNLOG(
X             %DESCR LogicalName : VARYING [U1] OF CHAR;
X             %REF DstLen : [TRUNCATE] SignedWord := %IMMED 0;
X             %DESCR DstStr : VARYING [U2] OF CHAR;
X             %REF Table : [TRUNCATE] SignedByte := %IMMED 0;
X             %REF AccMode : [TRUNCATE] SignedByte := %IMMED 0;
X             %REF DsbMsk : [TRUNCATE] UnsignedByte := %IMMED 0
X           ) : CondCode; EXTERNAL;
X
X  PROCEDURE LIB$SIGNAL( ConditionValue : CondCode ); EXTERNAL;
X
V{==============================================================================
X}
X
XBEGIN  (* Do *)
X
X  (* Get remainder of calling command line *)
X  Status := LIB$GET_FOREIGN( GetStr := CommandLine );
X  IF NOT ODD( Status ) THEN
X    LIB$SIGNAL( Status );
X
X  (* Get MASTER_PID of this process as a string *)
X  Status := LIB$GETJPI( ItemCode := JPI$_MASTER_PID,
X                        OutString := SubprocessName );
X  IF NOT ODD( Status ) THEN
X    LIB$SIGNAL( Status );
X
X  (* Make subprocess and mailbox logical names *)
X  SubprocessName := SubprocessName + '_Slave';
X  MailboxLogicalName := 'MB_' + SubprocessName;
X
X  (* This call to LIB$GETJPI is for finding out whether or not the subprocess
X     exists.  The "OutValue" argument must be specified, but PID is ignored *)
X  ProcessStatus := LIB$GETJPI( ItemCode := JPI$_PID,
X                               ProcessName := SubprocessName,
X                               OutValue := PID );
X
X  (* Either we've found it or it doesn't exist yet *)
X  IF ODD( ProcessStatus ) OR (ProcessStatus = SS$_NONEXPR) THEN
X  BEGIN  (* Everything's OK *)
X
X    (* This call to $CREMBX will create the mailbox if it doesn't exist, but
X       will assign a channel to it if it does *)
X    Status := $CREMBX( CHAN := MailboxChannel,
X                       ACMODE := PSL$C_SUPER,
X                       LOGNAM := MailboxLogicalName );
X    IF NOT ODD( Status ) THEN
X      LIB$SIGNAL( Status );
X
X    IF ProcessStatus = SS$_NONEXPR THEN
X    BEGIN  (* Create process *)
X
X      (* Create the process with the desired name, SYS$INPUT & SYS$OUTPUT set
X         as required, to execute concurrently, and to NOTIFY on completion *)
X      Status := LIB$SPAWN( InputFile := MailboxLogicalName,
X                           OutputFile := OutputFile,
X                           Flags := UOR( CLI$M_NOWAIT, CLI$M_NOTIFY ),
X                           ProcessName := SubprocessName );
X      IF NOT ODD( Status ) THEN
X        LIB$SIGNAL( Status );
X
X      (* Message to terminal *)
X      WRITELN( 'Subprocess ', SubprocessName, ' created' );
X
X      (* Translate the logical "TT" to be used as SYS$ERROR by the subprocess.
X         The disable mask specified prevents searches of group and system
X         tables *)
X      Status := LIB$SYS_TRNLOG( LogicalName := Terminal,
X                                DstStr := ErrorLogical,
X                                DsbMsk := %X'03' );
X      IF NOT ODD( Status ) THEN
X        LIB$SIGNAL( Status );
X
X      (* Send the command to set SYS$ERROR for the subprocess *)
X      SendCommand := 'DEFINE SYS$ERROR ' + ErrorLogical;
X      Status := $QIOW( CHAN := MailboxChannel,
X                       FUNC := INT( UOR( IO$_WRITEVBLK, IO$M_NOW ) ),
X                       IOSB := IOStatusBlock,
X                       P1 := SendCommand.BODY,
X                       P2 := SendCommand.LENGTH );
X      IF NOT ODD( Status ) THEN
X        LIB$SIGNAL( Status )
X      ELSE
X        IF NOT ODD( IOStatusBlock.Status ) THEN
X          LIB$SIGNAL( IOStatusBlock.Status );
X
X      (* Setting NOON in the subprocess prevents it bombing on mere ERRORS and
X         worse *)
X      SendCommand := 'SET NOON';
X      Status := $QIOW( CHAN := MailboxChannel,
X                       FUNC := INT( UOR( IO$_WRITEVBLK, IO$M_NOW ) ),
X                       IOSB := IOStatusBlock,
X                       P1 := SendCommand.BODY,
X                       P2 := SendCommand.LENGTH );
X      IF NOT ODD( Status ) THEN
X        LIB$SIGNAL( Status )
X      ELSE
X        IF NOT ODD( IOStatusBlock.Status ) THEN
X          LIB$SIGNAL( IOStatusBlock.Status );
X
X    END;  (* Create process *)
X
X    (* Send the command line *)
X    Status := $QIOW( CHAN := MailboxChannel,
X                     FUNC := INT( UOR( IO$_WRITEVBLK, IO$M_NOW ) ),
X                     IOSB := IOStatusBlock,
X                     P1 := CommandLine.BODY,
X                     P2 := CommandLine.LENGTH );
X    IF NOT ODD( Status ) THEN
X      LIB$SIGNAL( Status )
X    ELSE
X      IF NOT ODD( IOStatusBlock.Status ) THEN
X        LIB$SIGNAL( IOStatusBlock.Status );
X
X    (* Send the notification command:  NOTIFY needs the quotes *)
X    SendCommand := 'NOTIFY "Command ' + CommandLine + ' has completed"';
X    Status := $QIOW( CHAN := MailboxChannel,
X                     FUNC := INT( UOR( IO$_WRITEVBLK, IO$M_NOW ) ),
X                     IOSB := IOStatusBlock,
X                     P1 := SendCommand.BODY,
X                     P2 := SendCommand.LENGTH );
X    IF NOT ODD( Status ) THEN
X      LIB$SIGNAL( Status )
X    ELSE
X      IF NOT ODD( IOStatusBlock.Status ) THEN
X        LIB$SIGNAL( IOStatusBlock.Status );
X
X    (* Deassign the channel to the mailbox *)
X    Status := $DASSGN( CHAN := MailboxChannel );
X    IF NOT ODD( Status ) THEN
X      LIB$SIGNAL( Status );
X
X  END  (* Everything's OK *)
X  ELSE
X
X    (* Something wrong in the call to LIB$GETJPI *)
X    LIB$SIGNAL( ProcessStatus );
X
XEND.  (* Do *)
$ GoSub Convert_File
$ Exit