Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-07 - decus/20-0172/blfvms.bli
There is 1 other file named blfvms.bli in the archive. Click here to see a list.
%TITLE 'BLFVMS - BLF VMS Command Line Interface'
MODULE BLFVMS (	
		MAIN = BLFVMS,	! Entry point of main program
%IF %BLISS (BLISS32)
%THEN
		ADDRESSING_MODE( EXTERNAL=LONG_RELATIVE,
				 NONEXTERNAL=LONG_RELATIVE ),
%FI

		IDENT = '8.16'
		) =
BEGIN

!
! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
!

!++
!
! FACILITY:	PRETTY
!
! ABSTRACT:
!
!	This module is the PRETTY VMS Command Line interface module.
!
! ENVIRONMENT:  VAX/VMS User Mode
!
! CREATION DATE:  20 November 1981
!
! REVISION HISTORY
!
!	20-Nov-81	TT	Generate module from ---.
!
!	 4-Dec-81	TT	Make .BLI default input file extension
!
!	 4-Dec-81	TT	Fix code hack from snarfed --- code that didn't
!				correctly zero out the command block. Change
!				version message to make it appear like releaed
!				versions.
!
!	 8-Dec-81	TT	Cleaned up code. If an output file was opened,
!				it wasn't deleted if a listing file open
!				failed. Added code to close and delete out file
!				if list file open fails.
!
!	14-Jan-82	TT	Used message code from another project to talk
!				to Xport on errors for file opens. Other parts
!				of this code have been disabled for now (like
!				the Debug type message), but they may come in
!				handy in the future.
!
!	20-Jan-82	TT	Changed command line calls to get compatible
!				with VMS V2.4.
!
!	22-Jan-82	TT	Added default file specs: listing
!				file defaults to input file .LIS,
!				and output defaults back to input.
!
!	 4-Feb-82	TT	People complained about an unsupported tool
!				modifying VMS DCL command tables. SO, let's
!				look like a known command, but really call
!				the RTL to get the command line. This
!				necessitates snarfing a couple of .OBJs
!				from Starlet (Al has them as CLINT.OBS).
!				Also, remove some unneeded code and
!				declarations. Bumped version to 8.2.
!
!	11-Feb-82	TT	Looks ok so drop version back to 8.1.
!
!	12-Feb-82	TT	Add code to handle /LOG and /NOLOG
!				so we look more like a real product.
!				This was also a user request.
!
!	15-Feb-82	TT	Stick an edit number on the version.
!				start at 10 just for jollies.
!
!	25-Feb-82	TT	Diddle with version number again; ship 8.2.
!
!	26-Feb-82	TT	Inform user if errors found and /LOG not
!				present.
!
!	 6-Jun-83	TT	Get rid of explicit .L32 on library decl.
!
!	 6-Jun-83	TT	Just a note that CLINT.OBS (See 4-Feb-82)
!				  is no longer needed as of VMS V3.
!
!	17-Aug-83	TT	Local Once was uninitialized.
!
! END OF REVISION HISTORY
!--


!++
!	For the Command Line Descriptor, see BLFVMS.CLD
!
!--
%SBTTL 'Declarations';
!
! TABLE OF CONTENTS:
!

FORWARD ROUTINE
    blfvms : novalue;			! PRETTY VMS command interface routine

!
! INCLUDE FILES:
!

LIBRARY  'SYS$LIBRARY:STARLET';		! System macros
LIBRARY  'SYS$LIBRARY:XPORT' ;		! XPORT macro and field definitions
SWITCHES LIST (REQUIRE);		! Enable printing of REQUIRE files
REQUIRE  'BLFVMS' ;			! PRETTY macro and field definitions
REQUIRE	 'MSGMAC' ;			! VMS error message macros
SWITCHES LIST (NOREQUIRE);		! Disable printing of REQUIRE files
undeclare %quote $descriptor;


!	Define internal descripters

MACRO
    dyynamic =	BLOCK [DSC$K_D_BLN,BYTE]
		PRESET( [DSC$B_CLASS] = DSC$K_CLASS_D ) %;

BIND
    swch_input =    %ASCID 'INPUT',
    swch_output =   %ASCID 'OUTPUT',
    swch_listing =  %ASCID 'LISTING',
    swch_log =	    %ASCID 'LOG';


LITERAL
    true = 1,			! Used to turn indicators on.
    false = 0;			! Used to turn indicators off.

OWN
    pretty_command :  $blf_cmd;		! PRETTY command information block.


GLOBAL
    in_iob :	$xpo_iob (),
    out_iob :	$xpo_iob (),
    list_iob :	$xpo_iob (),
    req_iob :	$xpo_iob (),
    tty_iob :	$xpo_iob (),
    errors_detected,
    log_flag;				! True if /LOG is seen.

EXTERNAL ROUTINE
    blf$format,					! PRETTY entry point.
    lst$file : NOVALUE,
    out$file : NOVALUE,
    CLI$DCL_PARSE   : ADDRESSING_MODE(GENERAL),
    LIB$GET_FOREIGN : ADDRESSING_MODE(GENERAL),	! Get the command line.
    STR$PREFIX	    : ADDRESSING_MODE(GENERAL),	! To stick 'PRETTY' in front.
    CLI$GET_VALUE   : ADDRESSING_MODE(GENERAL),	! Gets switch value.
    CLI$PRESENT     : ADDRESSING_MODE(GENERAL),	! Checks for switch.
    CLI$END_PARSE   : ADDRESSING_MODE(GENERAL);	! Cleans up & reports garbage.

EXTERNAL
    BLFVMSCLI;					! "Tables for parsing"
%SBTTL 'ROUTINE BLFVMS - Primary PRETTY CLI Interface Routine'
GLOBAL ROUTINE blfvms : novalue =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine uses the VMS DCL CLE routines to obtain command
!	line information which is in turn passed to the PRETTY application
!	in a transportable manner.
!
! FORMAL PARAMETERS:
!
!	None
!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	None
!
! COMPLETION CODES:
!
!	completion code from PRETTY
!
! SIDE EFFECTS:
!
!	None
!
!--

BEGIN

    LOCAL
	desc :  dyynamic,	! Command line.
	list_,			! Listing file requested & successfully opened.
	out_,			! Output file requested & successfully opened.
	once : initial(0),
	xpo_status,		! Xport status for message interface.
	status;			! Temporary routine completion code

!+
! Initialize the PRETTY command block.
!-
    $STR_DESC_INIT( DESCRIPTOR = desc,  CLASS = DYNAMIC);


    $xpo_iob_init (				! Open the Terminal
	file_spec = $xpo_output,
	iob = tty_iob);

    $xpo_open (
	options = output,
	iob = tty_iob);


    LIB$GET_FOREIGN ( desc );			! Get "rest-of-line" and make
    STR$PREFIX ( desc, %ASCID 'PRETTY ');	!  it look like subcommand.
    CLI$DCL_PARSE (desc, BLFVMSCLI );		! Pre-load parsing routines.

    status = 0;
    errors_detected = false;

    WHILE cli$get_value (swch_input, desc)
    DO
	BEGIN

	!
	! Form the PRETTY command block (PTYCMD) from the information
	! returned by the DCL CLI.
	!

	$STR_DESC_INIT( DESCRIPTOR = pretty_command [blf$t_input],
		CLASS = DYNAMIC);

	$STR_COPY(STRING = desc, TARGET = pretty_command [blf$t_input]);

	$STR_DESC_INIT( DESCRIPTOR = pretty_command [blf$t_output],
		CLASS = DYNAMIC);

	$STR_DESC_INIT( DESCRIPTOR = pretty_command [blf$t_listing],
		CLASS = DYNAMIC);

	list_ = out_ = false;

	IF cli$present (swch_log)
	THEN
	    log_flag = true			! /LOG
	ELSE
	    log_flag = false;

	IF .log_flag AND NOT .once
	THEN
	    BEGIN
	    $blf_message ( type = output,
		   string = 'PRETTY version 8.2' );
	    once = true;
	    END;


	IF NOT $xpo_open ( iob = in_iob,
		    file_spec = pretty_command [blf$t_input],
		    related = pretty_command [blf$t_input],
		    default = '.BLI',				! TT   4-Dec-81
		    failure = 0,
		    options = input )
	THEN					! Input open failed.
	    BEGIN

	    $blf_message ( type = fatal,
			   code = pretty_badinfile,
			   xcode = .in_iob [IOB$G_COMP_CODE],
			   fao1 = pretty_command [blf$t_input] );
	    EXITLOOP
	    END;

	IF cli$present(swch_output)
	THEN					! /OUTPUT: is present.
	    BEGIN
	    cli$get_value(swch_output, pretty_command [blf$t_output]);
	    IF $xpo_open ( iob = out_iob,
		    file_spec = pretty_command [blf$t_output],
		    related = in_iob [IOB$T_RESULTANT],
		    failure = 0,
		    options = output )
	    THEN
		out_ = true			! Success.
	    ELSE
		BEGIN
		$blf_message ( type = fatal,
			       code = pretty_badoutfil,
			       xcode = .out_iob [IOB$G_COMP_CODE],
			       fao1 = pretty_command [blf$t_output] );
		EXITLOOP
		END;
	    END
	ELSE
	    out_ = false;			! No output file requested.

	out$file (.out_);


	IF cli$present(swch_listing)
	THEN					! /LISTING: is present
	    BEGIN
	    cli$get_value (swch_listing, pretty_command [blf$t_listing]);
	    IF $xpo_open ( iob = list_iob,
			file_spec = pretty_command [blf$t_listing],
			related = in_iob [IOB$T_RESULTANT],
			default = '.LIS',
			failure = 0,
			options = output )
	    THEN
		list_ = true			! Listing file open succeeded.
	    ELSE
		BEGIN
		IF .out_			! Failed; can output file too.
		THEN
		    BEGIN
		    $xpo_close (iob = out_iob, options = remember);
		    $xpo_delete (iob = out_iob);
		    END;

		$blf_message ( type = fatal,
			       code = pretty_badlisfil,
			       xcode = .list_iob [IOB$G_COMP_CODE],
			       fao1 = pretty_command [blf$t_listing] );
		EXITLOOP
		END;
	    END
	ELSE
	    list_ = false;			! Listing file not requested.

	lst$file (.list_);

	errors_detected = false;

	status =  blf$format ();

	IF NOT .status			! Pretty trashed out somewhere.
	THEN
	    EXITLOOP;

	IF NOT .log_flag AND .errors_detected
	THEN
	    $blf_message ( type = informational,
			   code = pretty_errsfound);
	
	! Clean up

	$xpo_close (iob = in_iob);	! Close current input file if open.

	IF .out_
	THEN
	    $xpo_close (iob = out_iob);

	IF .list_
	THEN
	    $xpo_close (iob = list_iob);


	END;

    CLI$END_PARSE();		! Signal VMS to report an error if the user
				! puts junk on the command line.  Junk is
				! anything that we didn't ask for.
    !
    ! Return to the system.
    !
    RETURN .status		! Return the final PRETTY completion code to the caller.

    END;

END
ELUDOM