MODULE JCF$$$DCL ( IDENT = '01')  =
BEGIN
%( Fortran calleable routines to submit a command to DCL to be executed on
progam exit, define local and global symbols, and pause to dcl.
Written January, 1980, Neal Lippman, MIT-JCF
)%

LIBRARY 'DB0:[SYSLIB]STARLET.L32';
!Get cliblock fields

OWN
CLIBLOCK        :       BLOCK[28,BYTE];

LITERAL
TRUE=1,
FALSE=0;

EXTERNAL SYS$CLI        : ADDRESSING_MODE(GENERAL);



!Table of Contents:
FORWARD ROUTINE
DCL$$$GET_LEN,           !Utility routine to get actual len of string in
			 !descriptor
DCL$$_SYM_GBL,           !Define global DCL symbol
DCL$$_SYM_LOC,           !Define a local DCL symbol
DCL$$_PAUSE,             !Do a DCL pause
DCL$$_CRELOG,            !Create a process logical name table entry
DCL$$_DELLOG,            !Delete a process logical name table entry
DCL$$_DCTRLY,            !Disable control y
DCL$$_ECTRLY,            !Enable control y
DCL$$_CHAIN,             !Do a chain to another program
DCL$$_COMMAND;           !Pass a DCL command to be executed on program
			!completion


GLOBAL ROUTINE DCL$$_PAUSE =
BEGIN
%(The cruft involved here is a lot simpler than required for the other
routines because there are no parameters involved; therefore there is no 
hassle involved with passing in arguments according to Fortran
convention.
)%
LOCAL ISTAT;

CLIBLOCK[0,0,8,0] = CLI$K_CLISERV;   
CLIBLOCK[1,0,8,0] = CLI$K_PAUSE;
ISTAT = SYS$CLI(CLIBLOCK);
RETURN .ISTAT;
END;



GLOBAL ROUTINE DCL$$_SYM_LOC(symdescr,strdescr) =
BEGIN
%(This routine goes off and defines a dcl symbol.  
descr is a pointer to a character string descriptor which contains the symbol
equivalence string
	ie: .descr is the address of the descriptor for the symbol name,
		 or the equivalence name, respectively;
		..descr<0,16> is the length of the string,
		.(.descr+4) is the address of the string.
)%
LOCAL ISTAT;

CLIBLOCK[0,0,8,0] = CLI$K_CLISERV;  
CLIBLOCK[1,0,8,0] = CLI$K_DEFLOCAL;
CLIBLOCK[4,0,16,0] = DCL$$$GET_LEN(.SYMDESCR);
CLIBLOCK[8,0,32,0] = .(.SYMDESCR+4);
CLIBLOCK[12,0,16,0] = DCL$$$GET_LEN(.STRDESCR);
CLIBLOCK[16,0,32,0] = .(.STRDESCR+4);
ISTAT = SYS$CLI(CLIBLOCK);
RETURN .ISTAT;

END;

GLOBAL ROUTINE DCL$$_SYM_GBL(symdescr,strdescr) =
BEGIN
%(Same params as dcl$$_defsym_loc
)%

LOCAL ISTAT;
CLIBLOCK[0,0,8,0] = CLI$K_CLISERV;
CLIBLOCK[1,0,8,0] = CLI$K_DEFGLOBAL;
CLIBLOCK[4,0,16,0] = DCL$$$GET_LEN(.SYMDESCR);
CLIBLOCK[8,0,32,0] = .(.SYMDESCR+4);
CLIBLOCK[12,0,16,0] = DCL$$$GET_LEN(.STRDESCR);
CLIBLOCK[16,0,32,0] = .(.STRDESCR+4);

ISTAT = SYS$CLI(CLIBLOCK);
RETURN .ISTAT;
 
END;

GLOBAL ROUTINE DCL$$_CHAIN(DESCR) =
BEGIN
%(Routine to chain from one image to another...
	argument is pointer to character string descriptor. Note that user
should construct the descriptor himself, as it expects the lenght in the first
word of the descriptor to be the exact length of the filespec of the image to
run.
	usage of descr: 
		..descr<0,16> = the length of the string
		..descr<16,16> = the type of the string
		.(.descr+4) = the address of the string
)%
LOCAL ISTAT;

CLIBLOCK[0,0,8,0] = CLI$K_CLISERV;
CLIBLOCK[1,0,8,0] = CLI$K_CHAIN;
CLIBLOCK[4,0,16,0] = DCL$$$GET_LEN(.DESCR);
CLIBLOCK[8,0,32,0] = .(.DESCR+4);

ISTAT = SYS$CLI(CLIBLOCK);
	RETURN .ISTAT; !If successful, no return...

END;

GLOBAL ROUTINE DCL$$_COMMAND(DESCR) =
BEGIN
%(Pass dcl command to be executed on image exit...
descr same as usual.
)%
LOCAL  ISTAT;
 
CLIBLOCK[0,0,8,0] = CLI$K_CLISERV;
CLIBLOCK[1,0,8,0] = CLI$K_COMMAND;
CLIBLOCK[4,0,16,0] = DCL$$$GET_LEN(.DESCR);
CLIBLOCK[8,0,32,0] = .(.DESCR+4);

ISTAT = SYS$CLI(CLIBLOCK);
RETURN .ISTAT;
END;

GLOBAL ROUTINE DCL$$_CRELOG(LOGDESCR,EQDESCR) =
BEGIN
%(This routine creates a process level logical name entry.
descr as usual.
)%
LOCAL ISTAT;

CLIBLOCK[0,0,8,0] = CLI$K_CLISERV;
CLIBLOCK[1,0,8,0] = CLI$K_CREALOG;
CLIBLOCK[4,0,16,0] = DCL$$$GET_LEN(.LOGDESCR);
CLIBLOCK[8,0,32,0] = .(.LOGDESCR+4);
CLIBLOCK[12,0,16,0] = DCL$$$GET_LEN(.EQDESCR);
CLIBLOCK[16,0,32,0] = .(.EQDESCR+4);

ISTAT = SYS$CLI(CLIBLOCK);
RETURN .ISTAT;

END;

GLOBAL ROUTINE DCL$$_DELLOG(LOGNAM) =
BEGIN
LOCAL ISTAT;

CLIBLOCK[0,0,8,0] = CLI$K_CLISERV;
CLIBLOCK[1,0,8,0] = CLI$K_DELELOG;
CLIBLOCK[4,0,16,0] = DCL$$$GET_LEN(.LOGNAM);
CLIBLOCK[8,0,32,0] = .(.LOGNAM+4);

ISTAT = SYS$CLI(CLIBLOCK);
RETURN .ISTAT;

END;

GLOBAL ROUTINE DCL$$_ECTRLY =
BEGIN
%(Enable control y
)%

LOCAL ISTAT;

CLIBLOCK[0,0,8,0] = CLI$K_CLISERV;
CLIBLOCK[1,0,8,0] = CLI$K_ENABCTRLY;

ISTAT = SYS$CLI(CLIBLOCK);
RETURN .ISTAT;

END;

GLOBAL ROUTINE DCL$$_DCTRLY =
BEGIN
LOCAL ISTAT;

CLIBLOCK[0,0,8,0] = CLI$K_CLISERV;
CLIBLOCK[1,0,8,0] = CLI$K_DISACTRLY;

ISTAT = SYS$CLI(CLIBLOCK);

RETURN .ISTAT;

END;


GLOBAL ROUTINE DCL$$$GET_LEN(descr) =
BEGIN
%(Return actual len of string in descr)%
LOCAL ACTUALEN,J;

BIND STRING = .(.DESCR+4);
MAP STRING : VECTOR[,BYTE];

DECR I FROM (..DESCR<0,16>)-1 TO 0 DO
BEGIN
J = .I;
      IF (STRING[I] NEQ 32) AND (STRING[I] NEQ 0) THEN        
			EXITLOOP;
IF .I EQL 0 THEN
	RETURN .I;
END;

J = .J+1;
RETURN .J;
END;
END
ELUDOM