STRASSER@RSBS0.anu.OZ.AU (09/21/87)
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
$ ExitSTRASSER@RSBS0.anu.OZ.AU (09/21/87)
Herewith, the SHAR'd source of my utility NOTIFY in Pascal. This
utility sends a message to all terminals logged in with the current
username as specified in the command, using the $BRKTHRU system service.
It is used by DO, and could be used in command procedures as well.
NOTIFY is documented in its header, but note that it must be set
up as a foreign command. The procedure RemoveLoneQuotes was written
because LIB$GET_FOREIGN returns the entire command line with quotes
intact, when they were put there to prevent DCL converting characters to
uppercase. (This seems a bit silly to me.) I couldn't be bothered working
out how to use LIB$TPARSE or whether CLI$xxx is suitable: someone out
there may know how to do this, and can improve on this.
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:08:53.51
$!
$! It contains the following 1 file:
$! NOTIFY.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="NOTIFY.PAS"
$ Check_Sum_is=862926229
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
V{==============================================================================
X}
V{ NOTIFY
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 utility to send messages to terminals logged in with the current
X}
V{ username (this requires no priviledge). It must be set up as a foreign
X}
V{ command, and sends the remainder of the command line. It was written
X}
V{ primarily for use with the DO utility. Example of use:
X}
V{
X}
V{ $ NOTIFY "Today is the first day of the rest of your life"
X}
V{
X}
V{ Quotes are necessary to preserve case, otherwise DCL converts everything
X}
V{ to uppercase. The message is sent using $BRKTHRU, and preceded by two
X}
V{ BEL (CTRL-G) characters.
X}
V{
X}
V{==============================================================================
X}
X
X[INHERIT( 'SYS$LIBRARY:STARLET' )]
XPROGRAM Notify;
X
XTYPE
X String = VARYING [256] OF CHAR;
X SignedWord = [WORD] -32768..32767;
X UnsignedWord = [WORD] 0..65535;
X StatusBlock = RECORD
X Status,
X TransferCount : UnsignedWord;
X Dummy : INTEGER;
X END;
X CondCode = UNSIGNED;
X
XVAR
X MessageString : String;
X Username : VARYING [12] OF CHAR;
X Status : CondCode;
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 PROCEDURE LIB$SIGNAL( ConditionValue : CondCode ); EXTERNAL;
X
V{==============================================================================
X}
X
X (* This procedure removes lone quotation marks from a string. Thus, the
X string >"Hello there"< becomes >Hello there<, but >"""Hello there"""<
X becomes >"Hello there"<. *)
X PROCEDURE RemoveLoneQuotes( VAR Str : String );
X
X VAR
X Pos : INTEGER;
X NewStr : String;
X
X BEGIN (* RemoveLoneQuotes *)
X Pos := INDEX( Str, '"' );
X IF Pos <> 0 THEN
X BEGIN
X IF Pos = Str.LENGTH THEN
X Str := SUBSTR( Str, 1, Pos - 1 )
X ELSE
X BEGIN
X Str := SUBSTR( Str, 1, Pos - 1 ) +
X SUBSTR( Str, Pos + 1, Str.LENGTH - Pos );
X IF Pos < Str.LENGTH THEN
X BEGIN
X NewStr := SUBSTR( Str, Pos + 1, Str.LENGTH - Pos );
X RemoveLoneQuotes( NewStr );
X Str := SUBSTR( Str, 1, Pos ) + NewStr;
X END;
X END;
X END;
X END; (* RemoveLoneQuotes *)
X
V{------------------------------------------------------------------------------
X}
X
XBEGIN (* Notify *)
X
X (* Get remainder of command line to send *)
X Status := LIB$GET_FOREIGN( GetStr := MessageString );
X IF NOT ODD( Status ) THEN
X LIB$SIGNAL( Status );
X
X (* Remove lone quotes from string. This is necessary because LIB$GET_FOREIGN
X returns the command line with the quotes intact. *)
X RemoveLoneQuotes( MessageString );
X
X (* Start message with 2 x BEL *)
X MessageString := ''(7) + ''(7) + MessageString;
X
X (* Get current username *)
X Status := LIB$GETJPI( ItemCode := JPI$_USERNAME, OutString := Username );
X IF NOT ODD( Status ) THEN
X LIB$SIGNAL( Status );
X
X (* Send to current username *)
X Status := $BRKTHRUW( MSGBUF := MessageString,
X SENDTO := Username,
X SNDTYP := BRK$C_USERNAME,
X IOSB := IOStatusBlock );
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
XEND. (* Notify *)
$ GoSub Convert_File
$ Exit