Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

MODULE LSTCHK(MAIN=MAINROUTINE)=
BEGIN
!+
! FUNCTION:
!    This program reads its own BLISS compilation listing and checks
!    the compier version number in the heading.  It is used for
!    installation verification.
!-

LIBRARY 'XPORT' ;


LITERAL
    INPUT = 0;

LITERAL
    MAX_LINE_LENGTH = 130;

OWN
    TTY_INPUT :  $XPO_IOB(),
    TTY_OUTPUT :  $XPO_IOB(),
    INPUT_FILE :  $XPO_IOB(),
    VERSION_PTR,
    VERSION_LNG,
    LINE_LENGTH,
    LINE: VECTOR[CH$ALLOCATION(MAX_LINE_LENGTH)];

MACRO
    MSG(S) =
	%CHARCOUNT(S),CH$PTR(UPLIT(S)) %;

! Error message numbers.
LITERAL
    WRONG_VERSION_ERROR = 0,
    OPEN_ERROR = 1,
    BAD_HEADER_ERROR = 2,

    FIRST_ERROR = WRONG_VERSION_ERROR,
    LAST_ERROR = BAD_HEADER_ERROR;

%IF %VARIANT EQL 1
%THEN
%MESSAGE('Please type:')
%MESSAGE('	MACRO EXPECTED_VERSION = ''####'' %;')
%MESSAGE('	^Z')
%MESSAGE('Where #### represents the desired version number')
%MESSAGE('(include the quote marks)')
REQUIRE 'TTY:';
%MESSAGE('')
%MESSAGE('Please type:')
%MESSAGE('	MACRO LIST_FILE_NAME = ''XXXXXXX'' %;')
%MESSAGE('	^Z')
%MESSAGE('Where XXXXX represents a BLISS listing file name')
%MESSAGE('(include the quote marks)')
REQUIRE 'TTY:';
%MESSAGE('Thank you.')
%ELSE
MACRO
    LIST_FILE_NAME = 'LSTCHK.LST' %,
    EXPECTED_VERSION = '2(123)' %;
%FI

%MESSAGE(%STRING('Expects version ', EXPECTED_VERSION))
%MESSAGE(%STRING('Uses listing file ', LIST_FILE_NAME))

! This page contains a limited number of declartions for condition-handling.

LITERAL
    RESIGNAL = 0;

%IF %BLISS(BLISS36)
%THEN

$SHOW(ALL)

    $FIELD
	SIGNAL_FIELDS =
	    SET
	    WHOLE_VALUE = [$BYTES(4)],
		$OVERLAY (WHOLE_VALUE)
	    DUMMY_BITS = [$BITS(3)],
	    STS$V_COND_ID = [$BITS(29)]
		$CONTINUE
	    TES;

    LITERAL
	MY_SIGNAL = %O'20000400054';
%ELSE
    %ERROR('Not yet set up for BLISS-32 or BLISS-16')
%FI

ROUTINE INITIALIZE:NOVALUE =
    BEGIN

    ! Open terminal channel.
    $XPO_OPEN( IOB = TTY_INPUT,
		FILE_SPEC = $XPO_INPUT,
		OPTIONS = INPUT );

    $XPO_OPEN( IOB = TTY_OUTPUT,
		FILE_SPEC = $XPO_OUTPUT,
		OPTIONS = OUTPUT );

    ! Open the listing file on INPUT.
    IF NOT $XPO_OPEN( IOB = INPUT_FILE,
			FILE_SPEC = LIST_FILE_NAME,
			OPTIONS = INPUT,
			FAILURE = 0 )
    THEN
	SIGNAL_STOP(MY_SIGNAL, OPEN_ERROR);
    END;

ROUTINE MAKE_SPACES:NOVALUE =
    BEGIN
    MACRO MAKE_C[CHR_STR] = %C CHR_STR %;
    BIND
	TBL =
	    CH$TRANSTABLE(
		REP %O'40' OF (%C' '),
		MAKE_C(%EXPLODE(' !"#$%&''()*+,-./0123456789:;<=>?@',
		    'ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`',
		    ! Map to upper case while we are at it.
		    'ABCDEFGHIJKLMNOPQRSTUVWXYZ{|}~ ')));
    LOCAL
	TMP_LINE: VECTOR[CH$ALLOCATION(MAX_LINE_LENGTH)];

    CH$TRANSLATE(TBL, .LINE_LENGTH, CH$PTR(LINE),
	%C' ', MAX_LINE_LENGTH, CH$PTR(TMP_LINE));

    CH$MOVE(.LINE_LENGTH, CH$PTR(TMP_LINE), CH$PTR(LINE));
    END;

ROUTINE ERROR_HANDLER(SV, MV, EV)=
    BEGIN
    MAP
	SV: REF BLOCKVECTOR[,1] FIELD(SIGNAL_FIELDS),
	MV: REF VECTOR,
	EV: REF VECTOR;

    IF .SV[1, STS$V_COND_ID] NEQ .BLOCK[UPLIT(MY_SIGNAL), STS$V_COND_ID]
    THEN
	RETURN RESIGNAL;

    CASE .SV[2, WHOLE_VALUE] FROM FIRST_ERROR TO LAST_ERROR OF
	SET
	[WRONG_VERSION_ERROR]:
	    BEGIN
	    MACRO
		EXTRA_MESSAGE = '?	it is: '%;
	    OWN
		OUTBUF:
		    VECTOR[CH$ALLOCATION(80)]
		    INITIAL(EXTRA_MESSAGE);
	    LITERAL
		EXTRA_LNG = %CHARCOUNT(EXTRA_MESSAGE);

	    $XPO_PUT( IOB = TTY_OUTPUT,
			STRING = '? Wrong compiler version --' );
	    $XPO_PUT( IOB = TTY_OUTPUT,
			STRING = %STRING('?	it should be: ', EXPECTED_VERSION ));
	    CH$MOVE(.VERSION_LNG, .VERSION_PTR,
		CH$PTR(OUTBUF, EXTRA_LNG));
	    $XPO_PUT( IOB = TTY_OUTPUT,
			STRING = ( .VERSION_LNG+EXTRA_LNG, CH$PTR(OUTBUF)) );
	    END;

	[BAD_HEADER_ERROR]:
	    $XPO_PUT( IOB = TTY_OUTPUT,
			STRING = '? Header of list file is not in correct format');

	[OPEN_ERROR]:
	    $XPO_PUT( IOB = TTY_OUTPUT,
			STRING =%STRING(
		'? Could not open listing file "',
		LIST_FILE_NAME,
		'" for input.'));

	[INRANGE, OUTRANGE]:
	    $XPO_PUT( IOB = TTY_OUTPUT,
			STRING = '? Unidentified error' );

	TES;

    SETUNWIND();
    RETURN 0;
    END;

ROUTINE COMPARE_VERSION_STRINGS:NOVALUE =
    BEGIN

    IF CH$NEQ(.VERSION_LNG, .VERSION_PTR, MSG(EXPECTED_VERSION))
    THEN
	SIGNAL_STOP(MY_SIGNAL, WRONG_VERSION_ERROR);

    END;

ROUTINE GET_VERSION_STRING:NOVALUE=
    BEGIN
    LOCAL
	SRC_PTR,
	SRC_LNG,
	END_PTR;

     ! Convert all control characters to spaces.
     MAKE_SPACES();

    ! Find the Compiler name.
    SRC_PTR = CH$FIND_SUB( .LINE_LENGTH, CH$PTR(LINE), MSG('BLISS-'));

    IF CH$FAIL(.SRC_PTR)
    THEN
	SIGNAL_STOP(MY_SIGNAL, BAD_HEADER_ERROR);

    SRC_LNG = .LINE_LENGTH - CH$DIFF(.SRC_PTR, CH$PTR(LINE));

    ! Skip over the complete compiler name.
    SRC_PTR = CH$FIND_CH(.SRC_LNG, .SRC_PTR, %C' ');

    IF CH$FAIL(.SRC_PTR)
    THEN
	SIGNAL_STOP(MY_SIGNAL, BAD_HEADER_ERROR);

    SRC_LNG = .LINE_LENGTH - CH$DIFF(.SRC_PTR, CH$PTR(LINE));

    ! Skip over the seperating spaces.
    SRC_PTR = CH$FIND_NOT_CH(.SRC_LNG, .SRC_PTR, %C' ');

    IF CH$FAIL(.SRC_PTR)
    THEN
	SIGNAL_STOP(MY_SIGNAL, BAD_HEADER_ERROR);

    SRC_LNG = .LINE_LENGTH - CH$DIFF(.SRC_PTR, CH$PTR(LINE));

    ! Find the end of the version number.
    END_PTR = CH$FIND_CH(.SRC_LNG, .SRC_PTR, %C' ');

    VERSION_PTR = .SRC_PTR;

    IF CH$FAIL(.END_PTR)
    THEN
	VERSION_LNG = .SRC_LNG
    ELSE
	VERSION_LNG = CH$DIFF(.END_PTR, .SRC_PTR);
    END;

ROUTINE GET_HEADER:NOVALUE=
    BEGIN

%IF NOT %BLISS(BLISS36)
%THEN
    ! First record is a form-feed, dump it.
    $XPO_GET( IOB = INPUT_FILE );
%FI

    ! Put the second record in the line buffer, it should be the first
    ! line of the header.
    $XPO_GET( IOB = INPUT_FILE );

    $STR_COPY( STRING = INPUT_FILE[IOB$T_STRING],
		TARGET = ( MAX_LINE_LENGTH, CH$PTR(LINE) ),
		OPTION = TRUNCATE );

    IF .INPUT_FILE[IOB$H_LENGTH] GTR MAX_LINE_LENGTH
    THEN
	LINE_LENGTH = MAX_LINE_LENGTH
    ELSE
	LINE_LENGTH = .INPUT_FILE[IOB$H_STRING];

    END;

ROUTINE MAINROUTINE:NOVALUE=
    BEGIN
    ENABLE
	ERROR_HANDLER;

    INITIALIZE();
    GET_HEADER();
    GET_VERSION_STRING();
    COMPARE_VERSION_STRINGS();
    $XPO_PUT( IOB = TTY_OUTPUT,
		STRING = 'Listing was produced by the correct version of the compiler');
    END;

END ELUDOM