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