Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-07 - decus/20-0172/blft10.bli
There is 1 other file named blft10.bli in the archive. Click here to see a list.
!<BLF/lowercase_user>
!<BLF/uppercase_key>
MODULE blft10 (					!
		MAIN = t10$main,
		IDENT = '8.6'
		) =
BEGIN

!++
! Facility:
!
!	BLISS Language Tools
!
!
! Environment:
!
!	DEC-10/20 Systems running TOPS-10
!
!
! REVISION HISTORY
!
!	17-Nov-81	TT	Updated user visible version number
!				from 7.3 to 8.0 and bumped date to Nov. 81.
!
!	20-Jan-82	TT	Version number to 8.1
!
!	20-Jan-82	TT	Remove logical name from Require declaration.
!
!	21-Jan-82	TT	Replace logical names, now that we agree with
!				Bliss-36 about what to find where.
!
!	15-Feb-82	TT	Add code to handle /LOG and /NOLOG in command
!				line.
!
!	25-Feb-82	TT	Version number to 8.2; ships with Bliss V3.0.
!
!	26-Feb-82	TT	Define Errors_detected. Inform user that
!				parsing errors were found if this is on and
!				/LOG is not present.
!
! END OF REVISION HISTORY
!--

!<BLF/page>
!
! Table of contents:
!--

FORWARD ROUTINE 				!
    alloc_input : NOVALUE,
    alloc_output : NOVALUE,
    clearer : NOVALUE,
    t10$main : NOVALUE,
    t10$open : NOVALUE,
    t10$rename : NOVALUE;

!
! Include files:
!--
REQUIRE 'BLFCSW';

REQUIRE 'BLFMAC';				! Common Macros

REQUIRE 'X10SCN';				! Definitions of SCAN tables, etc.


LITERAL
    true = 1 EQL 1,
    false = 1 NEQ 1,
    in = 0,
    out = 1,
    max_file_spec = 7 + 15 + 6 + 4;


EXTERNAL ROUTINE
    X10$RETURN;


EXTERNAL
    X10$EXIT_FLAG;


GLOBAL
    errors_detected,
    log_flag : INITIAL (-1);


OWN
    line : VECTOR [CH$ALLOCATION (23)],		! For timing report
    backup,					! true if backup file is to be used
    list_,					! true if listing file is to be used
    out_,					! true if output file is to be used
    ccl_mode,
    first_file,					! output/listing spec switch
    in_scan_spec : $scan_spec_info,
    out_scan_spec : $scan_spec_info,
    list_scan_spec : $scan_spec_info,
    command_block : $blf_cmd,
    in_file_spec :				! Space to reconstruct the input file spec.
	VECTOR [CH$ALLOCATION (max_file_spec)],
    out_file_spec :				! Space to reconstruct the output file-spec.
	VECTOR [CH$ALLOCATION (max_file_spec)],
    list_file_spec :				! Space to reconstruct the listing file-spec.
	VECTOR [CH$ALLOCATION (max_file_spec)];

    $scan_table( blf_switches,

		! Define /(NO)LOG

	$scan_sn ( switch = 'LOG',
		 result = log_flag,
		 flags = (fs_nfs, fs_nue, fs_nos)))


OWN
    iscan_list : $iscan_list (			!
	    command_list = (1, UPLIT (%SIXBIT'PRETTY')), 	!
	    ccl_name = %SIXBIT'   BLF', 	!
	    ccl_offset = ccl_mode, 		!
	    monitor_return = X10$RETURN),

    tscan_list : $tscan_list (			!
	    switch_table = blf_switches,	!
	    help_routine = -1, 			!
	    clear_all = clearer, 		!
	    input_area = alloc_input, 		!
	    output_area = alloc_output, 	!
	    flags = fs_mot);

GLOBAL
    in_iob : $xpo_iob (),
    out_iob : $xpo_iob (),
    list_iob : $xpo_iob (),
    req_iob : $xpo_iob (),
    tty_iob : $xpo_iob ();

!
! External references:
!--

LINKAGE
    scan_linkage = PUSHJ (REGISTER = 1);

EXTERNAL ROUTINE
    scan$iscan : $scan_p1_t1234 NOVALUE,	! SCAN initialization
    scan$tscan : $scan_p1_t1234 NOVALUE,	! Traditional SCAN
    scan$oscan : $scan_p1_t1234 NOVALUE,	! Options SCAN
    scan$name : $scan_g178_t234 NOVALUE,	! SCAN keyword lookup routine
    scan$octnc : $scan_g78 NOVALUE,		! SCAN octal number routine
    scan$sixsc : $scan_g78_t1 NOVALUE,		! SCAN keyword parse routine
    scan$tiauc : $scan_g78 NOVALUE,		! SCAN get character routine
    scan$tisqt : $scan_g78 NOVALUE,		! SCAN quoted character routine
    scan$swasq,					! SCAN quoted ASCII string scanner
    scan$swdec,					! SCAN decimal number scanner
    x10$scan_spec;				! XPORT SCAN File Spec Area decoder

EXTERNAL ROUTINE 				!
    blf$format,
    lst$file : NOVALUE,
    out$file : NOVALUE,
    tim$format,					! TIMING
    tim$set_clocks,
    tim$read_wall,
    tim$_read_cpu;
GLOBAL ROUTINE t10$main (p1, p2, p3, p4, ccl_offset) : NOVALUE =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine uses the TOPS-10 SCAN routines to obtain command
!	line information which is in turn passed to the PRETTY application
!	in a transportable manner.
!
! FORMAL PARAMETERS:
!
!	p1, p2, p3, p4: 4 unused parameters
!	CCL_OFFSET - CCL mode indicator
!		( 0 = no arguments, 1 = arguments )
!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	None
!
! COMPLETION CODES:
!
!	Normal Completion (1)
!
! SIDE EFFECTS:
!
!	None
!
!--

    BEGIN

    LOCAL
	once : INITIAL (false),			! Been through once AND /LOG is true.
	status;					!.Temporary completion code

    !	Open the terminal for a command line.
    $xpo_iob_init (				!
	file_spec = $xpo_output, 		!
	iob = tty_iob);
    $xpo_open (					!
	options = output, 			!
	iob = tty_iob);


    !++
    !	Move the CCL indicator into an area
    !	pointed to by ISCAN_LIST.
    !--

    ccl_mode = .ccl_offset;

    !++
    !	If the user says RUN PRETTY, followed by a
    !	CTRL-Z, then terminate when BLF$MONITOR_RET
    !	is called the first time. Otherwise, make
    !	SCAN call BLF$MONITOR_RET twice before exit.
    !--

    X10$EXIT_FLAG = NOT (.ccl_mode EQL 0);
    scan$iscan (.iscan_list);			!.Initialize the SCAN facility.

    ! Process a single command line.

    WHILE 1 DO 					!.Setup to process multiple commands.
	BEGIN

	scan$tscan (.tscan_list);		!.Perform a "traditional" command scan.

	IF .log_flag eql -1			! If not explicitly given
	THEN					!  the default to /NOLOG.
	    log_flag = 0;

	IF .log_flag
	THEN
	    IF NOT .once
	    THEN
		BEGIN
		msg ('PRETTY Version 8.2 - February 1982');
		once = true;
		END;


	IF .in_scan_spec [scan$c_fxdev] NEQ 0	!.If the command line is non-null,
	THEN 					!
	    BEGIN				!
!
! Build a PRETTY command block from the information returned by SCAN.
!
	    $xpo_iob_init (			!.Initialize the input file IOB:
		default = '.BLI', 	!
		file_spec = (x10$scan_spec (in_scan_spec, in_file_spec),	!
		CH$PTR (in_file_spec)), 	!
		options = input,
		iob = in_iob);
	    command_block [blf$a_in_iob] = in_iob;	!.Put the input IOB address in the command block.
	    $xpo_iob_init (			!.Initialize the output file IOB:
		related = in_iob [iob$t_resultant], 	! Use fully resolved names
		options = output, 		!
		file_spec = (x10$scan_spec (out_scan_spec, out_file_spec),
						!.pointer to the output file spec
		CH$PTR (out_file_spec)), 	!
		iob = out_iob);
	    command_block [blf$a_out_iob] = out_iob;	!. Put the output IOB address in the command block.
	    $xpo_iob_init (			!.Initialize the listing file IOB:
		default = '.LST', 	!
		related = in_iob [iob$t_resultant], 	!
		options = output, 		!
		file_spec = (x10$scan_spec (list_scan_spec, list_file_spec),	!
		CH$PTR (list_file_spec)), 	!
		iob = list_iob);

!++
! Call the PRETTY application to process a single command line.
!--


	    tim$set_clocks ();			! Begin timing
	    t10$open ();			! Open the files

!++
!	Here the formatter is called. The address of the
!	complete command block is passed, but is not used
!	by PRETTY.
!--
	    errors_detected = false;
	    status = blf$format (command_block);
	    ! Set the next call to BLF$MONITOR_RET to exit to the monitor.
	    X10$EXIT_FLAG = true;

!++
!	Now we close the files and, if necessary, backup the
!	input file to 'INPUT.BLF'.
!--

	    $xpo_close (			!
		options = remember, 		!
		iob = in_iob);
	    $xpo_close (iob = out_iob);

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

	    t10$rename ();			! Handle backup for input file

	    IF NOT .status			!.If PRETTY returns a failure code,
	    THEN 				!.terminate PRETTY processing rather than
		RETURN .status;			!.trying another command.

	    IF .log_flag
	    THEN
		BEGIN

		CH$MOVE (15, CH$PTR (UPLIT ('CPU time =     ')), CH$PTR (line));
		tim$format (tim$_read_cpu (), CH$PTR (line, 15));
		$xpo_put (				!
		    string = (23, CH$PTR (line)), 	!
		    iob = tty_iob);
		CH$MOVE (15, CH$PTR (UPLIT ('Elapsed time = ')), CH$PTR (line));
		tim$format (tim$read_wall (), CH$PTR (line, 15));
		$xpo_put (				!
		    string = (23, CH$PTR (line)), 	!
		    iob = tty_iob);
		END
	    ELSE
		IF .errors_detected
		THEN
		   msg ('; Errors detected parsing input file.');
	    END;				!.End of processing an actual (non-null) command.

	END;					!.End of processing any command line.

    END;					!.End of routine 't10$main'
ROUTINE alloc_input : NOVALUE =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine returns the address and length of an input
!	file-specification information area for use by SCAN.
!
! FORMAL PARAMETERS:
!
!	None
!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	None
!
! ROUTINE VALUE:
!
!	Register 1 = Address of file-specification area
!	Register 2 = Length of file-specification area
!
! SIDE EFFECTS:
!
!	None
!
!--

    BEGIN

    GLOBAL REGISTER 				! Define return value registers:
	address = 1,				!    address of input file-spec area
	length = 2;				!    length of input file-spec area

    address = in_scan_spec;			! Put the file-spec area address and
    length = scan$k_fxlen;			! length into SCAN-specific registers.
    RETURN;					! Return to the caller (SCAN).
    END;					! End of routine 'alloc_input'
ROUTINE alloc_output : NOVALUE =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine returns the address and length of an output
!	file-specification information area for use by SCAN.
!
! FORMAL PARAMETERS:
!
!	None
!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	None
!
! ROUTINE VALUE:
!
!	Register 1 = Address of file-specification area
!	Register 2 = Length of file-specification area
!
! SIDE EFFECTS:
!
!	None
!
!--

    BEGIN

    GLOBAL REGISTER 				! Define return value registers:
	address = 1,				!    address of output file-spec area
	length = 2;				!    length of output file-spec area

    IF .first_file
    THEN
	BEGIN
	first_file = false;
	address = out_scan_spec			! Put the file-spec area address and
	END
    ELSE
	address = list_scan_spec;

    length = scan$k_fxlen;			! length into SCAN-specific registers.
    RETURN;					! Return to the caller (SCAN).
    END;					! End of routine 'alloc_output'


!++
! FUNCTIONAL DESCRIPTION:
!
!	BLF$MONITOR_RET is called by SCAN when
!		1. A ^Z was typed on the command line, or
!		2. The user said PRETTY, without specifying a file, or
!		3. After processing a file specified via CCL mode.
!
!	PRETTY's actions should be: (respectively)
!		1. Exit to the monitor
!		2. Tell SCAN to try again (prompt with a '*')
!		3. Exit to the monitor
!
!	BLF$MONITOR_RET ensures that that is the action taken.
!	Note that if the standard SCAN monitor return is used
!	instead, PRETTY will not prompt with a '*' in the second
!	case.
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	Implicit to the operation of this routine is how SCAN uses it.
!	If PRETTY is started via RUN this routine is called only when
!	a ^Z is seen.  If PRETTY is started a`la CCL mode, this routine
!	is called
!		1. Immediately, if no file was specified, or
!		2. The next time SCAN is called, if a file was specified.
!
! IMPLICIT OUTPUTS:
!
!	Implicit is how PRETTY acts, as follows:
!		1.  Starting PRETTY a`la CCL mode, but without
!			specifying a file, is, by definition,
!			equivalent to saying RUN PRETTY.
!		2.  If PRETTY is started a`la CCL mode, but with
!			a file specified, PRETTY exits to the monitor
!			after that file is processed.
!		3.  If the user says RUN PRETTY, PRETTY processes
!			files until a ^Z is typed to SCAN, at which
!			time it exits to the monitor.
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS:
!
!	NONE
!
!--
ROUTINE clearer : NOVALUE =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine zeros all PRETTY command line information in
!	preparation for processing a new command line.
!
! FORMAL PARAMETERS:
!
!	None
!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	None
!
! ROUTINE VALUE:
!
!	None
!
! SIDE EFFECTS:
!
!	None
!
!--

    BEGIN

    BIND
	blf_cmd = command_block : VECTOR;	! Redefine command block for easy initialization.

    MAP
	in_scan_spec : VECTOR,			! Change the structure of the
	out_scan_spec : VECTOR,			! file-spec areas from block
	list_scan_spec : VECTOR;		! of these areas easier

    first_file = true;

    INCR INDEX FROM 0 TO blf$k_cmd_lng DO 	! Zero the PRETTY command information block
	blf_cmd [.INDEX] = 0;			! one element at a time.

    log_flag = -1;				! Clear /LOG-/NOLOG flag. SCAN wants this as -1.

    INCR INDEX FROM 0 TO scan$k_fxlen - 1 DO 	! Zero the input and output file-spec areas.
	BEGIN					!
	in_scan_spec [.INDEX] = 0;		!
	out_scan_spec [.INDEX] = 0;		!
	list_scan_spec [.INDEX] = 0;		!
	END;


    RETURN;					! Return to the caller (SCAN).
    END;
GLOBAL ROUTINE t10$open : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	I/O Interface routine for BLISS Formatter
!
! FORMAL PARAMETERS:
!
!	None
!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	None
!
! ROUTINE VALUE:
!
!
! SIDE EFFECTS:
!
!	None
!
!--

    BEGIN

    !+
    ! Decide which files need to be opened.
    !-

    out_ = x10$scan_spec (out_scan_spec, out_file_spec) NEQ 0;
    list_ = x10$scan_spec (list_scan_spec, list_file_spec) NEQ 0;
    backup = NOT .out_;				! Output defaults to input,
    						!.so we must backup if no output specified.

    IF xpo$_normal NEQ $xpo_open (		!
	    iob = in_iob)
    THEN
	RETURN;

    IF .backup
    THEN
	$xpo_open (				!
	    file_spec = $xpo_temporary, 	!
	    iob = out_iob);

    IF .out_
    THEN
	$xpo_open (				!
	    iob = out_iob);

    ! Since TOPS-10 won't permit output suppression, always output.
    out$file (true);
    lst$file (.list_);

    IF .list_
    THEN
	$xpo_open (				!
	    options = output, 			!
	    iob = list_iob);

    END;					! End of routine 'T10$OPEN'
GLOBAL ROUTINE t10$rename : NOVALUE = 		!

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine perfoms the task of backing up the input file
!	and creating a new one. The input file is renamed to
!	'input.BLF', and the output source file, BLFTMP.TMP, is
!	renamed to the name of the input source file.
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

    BEGIN

    LOCAL
	in_chan,
	out_chan;

    IF .backup
    THEN
	BEGIN
	$xpo_backup (				!
	    old_iob = in_iob, 			!
	    new_iob = out_iob, 			!
	    file_type = ('.BLF'));
	END;

    END;					! End of routine 't10$rename'
%TITLE 'Final page of file BLFT10.BLI'
END						! End of module 'BLFT10'

ELUDOM