Module Error =
Begin

Require 'bliss.req';
Require 'errmsg.req';

!
! OUTPUT ERROR OR WARNING MESSAGE, WITH POINTERS, ETC.
!
Routine ERROUT(TYPE : Ref Vector[,Byte],LASTOPEN,NUM,POSN,arg1,arg2) : Novalue =
Begin
    Local
	save_device	: Integer,
	N		: Integer,
	C		: Integer,
	TEMP		: Vector[128,Byte];

! save the current output device and switch to the list file

    save_device = .DEVICE;
    DEVICE = LSTDEV;

! if /ERRORS then include the terminal

    If .swit_errors Then
	DEVICE = ERRDEV;

! but exclude the terminal if the list file and the terminal are
! one and the same.

    If .flg_tty Then
	DEVICE<0,1> = 0;

! flush out the list line

    FORCELINE();

! write '?' or '%' to the terminal as an eye catcher

    C = (If .TYPE[0] Eql 'E' Then '?' Else '%');
    If .DEVICE<0,1> Then
	Print(AZ('%b%1m%c%e'),.c);

! write a ';' to the list file so the assembler will see it as a comment

    Print(AZ('%b%2m;%e'));

! display the error number

    Print(AZ('%s#%3d'),.TYPE,.NUM);

! if we know the source position of the error...

    If .POSN Neq 0 Then
	Begin

! compute the position of the error

	N = .POSN<0,8>;
	If .N Lss .LASTOPEN<0,8> Then
	    N = .LASTOPEN<0,8>;
	If .LASTOPEN Neq 0 And .N Lss .pos_good<0,8> Then
	    N = .pos_good<0,8>;

! write out '.'s to span the error and '1', '2', and '3'
! at the positions of the errors

	Incr I From 1 To .N Do
	    Begin
	    C = '.';
	    Selectone .I Of Set
		[.POSN<0,8>]:
		    C = '1';
		[.LASTOPEN<0,8>]:
		    C = '2';
		[.pos_good<0,8>]:
		    If .LASTOPEN Neq 0 Then
			C = '3'
	    Tes;
	    TEMP[.I-1] = .C
	    End;
	TEMP[.N] = 0;
	Print(AZ('\t%s  L1:%4d'),TEMP,.POSN<16,16>);

! display the line numbers of the errors

	If .LASTOPEN Neq 0 Then 
	    Print(AZ('  L2:%4d  L3:%4d'),.LASTOPEN<16,16>,.pos_good<16,16>)
	End;

! display the error message now

    Print(AZ('\n; '));
    Print(.ERMSGPLIT[.NUM],.arg1,.arg2);
    Print(AZ('\n'));

! restore the original device and return

    DEVICE = .save_device
End;

! display an error message

Global Routine ERRPRNT(LASTOPEN : Integer,POSN : Integer,NUM : Integer,
				arg1,arg2)
						: Novalue =
Begin
    If Not .ERRLEVEL Then
	Begin
	ERROUT(AZ('ERR '),.LASTOPEN,.NUM,.POSN,.arg1,.arg2);
	num_error = .num_error + 1
	End
End;

! display a warning message

Global Routine WARNEM(POSN : Integer,NUM : Integer,arg1,arg2) : Novalue =
Begin
    ERROUT(AZ('WARN'),0,.NUM,.POSN,.arg1,.arg2);
    num_warning = .num_warning + 1
End;

!I. GENERAL:
!
!	1. THIS ROUTINE IS CALLED WHEN AN ERROR IS ENCOUNTERED.
!	   IT RUNS ALONG AT THE SAME LEVEL AS THE ERROR WAS
!	   FOUND AT, IGNORING THINGS UNTIL IT THINKS IT
!	   CAN GET BACK INTO CONTEXT.
!
!II. SPECIFIC:
!
!	1. *
!
!		A. KEEP READING AND MOVING THE WINDOW UNTIL
!		   ONE OF THREE (3) CASES HOLDS, WHEN PROCESSING
!		   WILL CONTINUE:
!
!			1.IF A '=' IS FOUND. IN THIS CASE, WE
!			   NOW KNOW WHERE THE VALUE OF THE
!			   EXPRESSION WILL BE, AND WE CAN
!			   RESUME PROCESSING AT THE LEVEL
!			   WHERE THE ERROR OCCURRED.
!
!			2. IF WE FIND THE MATCHING CLOSE
!			   BRACKET WHICH EXITS THE LEVEL WHERE
!			   THE ERROR WAS FOUND (IE, THE BRACKET
!			   WHICH MATCHES THE OPEN BRACKET FOR
!			   THIS LEVEL.
!
!			3. IF WE SEE AN OPEN BRACKET, THEN WE
!			   CAN PROCESS EVERYTHING WITHIN
!			   THAT BRACKET AND ITS MATCHING CLOSE,
!			   AT A LEVEL ONE DEEPER THAN THE 
!			   LEVEL AT WHICH THE ERROR OCCURRED.
!			   WHEN WE RETURN FROM PROCESSING THE
!			   BRACKET PAIR, WE AGAIN SKIP UNTIL ONE
!			   OF THESE CONDITIONS IS SATISFIED.

Routine RUNC(FIRSTRUNC : Boolean) : Novalue =
Begin
    Local
	DUMMY;
    Label
	aaa;

    While TRUE Do
	Case .DEL<lex_class> From LO_CLASS_TYPE To HI_CLASS_TYPE Of Set

	    [CL_OPEN]:
		aaa: Begin
		If .FIRSTRUNC Then
		    If .DEL Eql TK_MODULE Or .DEL Eql TK_RETURN
				Or .DEL Eql TK_EXITLOOP Then
			Begin
			RUND(QL_LEXEME);
			Leave aaa
			End;
		ERRLEVEL = FALSE;
		If .INDECL Then
		    Selectone .DEL Of Set
			[TK_LPAREN]:
			    SPLITB(DUMMY);
			[TK_LBRACKET]:
			    Begin
			    Do
				(RUND(QL_LEXEME); EXPRESSION())
			    Until .DEL Eql TK_RBRACKET;
			    RUND(QL_LEXEME)
			    End;
			[TK_LANGLE]:
			    Begin
			    Do
				(RUND(QL_LEXEME); EXPRESSION())
			    Until .DEL Eql TK_RANGLE;
			    RUND(QL_LEXEME)
			    End;
			[Otherwise]:
			    execute_syntax()
		    Tes
		Else
		    execute_syntax();
		ERRLEVEL = TRUE
		End;

	    [CL_OPER]:
		If .DEL Eql TK_STORE Then
		    Return
		Else
		    RUND(QL_LEXEME);

	    [CL_CLOSE]:
		Return;

	    [CL_DECL]:
		Begin
		ERRLEVEL = FALSE;
		ERRDECL();
		ERRLEVEL = TRUE
		End
	Tes
End;

!I. GENERAL:
!
!	1. THIS ROUTINE WRITES AN ERROR MESSAGE, ATTEMPTS TO
!	   TO GET BACK INTO CONTEXT AFTER AN ERROR, AND 
!	   RECORDS THAT AN ERROR HAS OCCURRED.
!
!	2. PARAMETERS:
!
!		A. NUM - ERROR NUMBER; THIS IS JUST PASSED BY
!			 THIS ROUTINE TO 'ERRPRNT'.
!
!		B. TYPE - TYPE OF CLOSING BRACKET REQUIRED TO
!			  RECOVER FROM ERROR. (SEE PART II.1.C)
!
!		C. POS - POSITION OF ERROR; JUST PASSED TO
!			 'ERRPRNT'.
!
!		D. LASTOPEN - LOCATION OF THE LAST GOOD OPEN
!			      BRACKET.
!
!	3. EXTERNAL ROUTINES USED:
!
!		A. ERRPRNT - ROUTINE TO PRINT ERROR MESSAGE.
!
!		B. RUND - ROUTINE TO MOVE THE WINDOW.
!
!		C. RUNC - ROUTINE FOR PROCESSING UNTIL ERROR
!		          RECOVERY. IGNORES MOST PROCESSING.
!
!II. SPECIFIC:
!
!	1. *
!
!		A. WRITE AN ERROR MESSAGE.
!
!		B. SKIP TO THE FIRST CLOSING BRACKET,
!		   DISREGARDING ALL SYNTAX ANALYSIS AT THE
!		   LEVEL AT WHICH THE ERROR OCCURRED. NOTE
!		   HOWEVER, THAT IF AN OPEN BRACKET IS
!		   SPOTTED WHILE SKIPPING, THEN WE WILL 
!		   PROCESS WHATEVER IS WITHIN THE SET OF
!		   BRACKETS (THE OPEN BRACKET SPOTTED AND ITS
!		   MATCHING CLOSING BRACKET), AND KEEP SKIPPING
!		   AFTER THAT IS PROCESSED.
!
!		C. NOW THERE ARE THREE DISTINCT CASES WHICH WE
!		   CAN PERFORM DEPENDING ON THE PARAMETER 'TYPE'
!
!			1. DON'T DO ANY MORE SKIPPING, AND
!			   ATTEMPT TO KEEP GOING.
!
!			2. KEEP SKIPPING OVER THINGS IN THE SAME
!			   WAY AS ABOVE, UNTIL WE SEE EITHER
!			   A ';' OR ')'.
!
!			3. KEEP SKIPPING UNTIL WE SEE EITHER
!			   A ';' OR 'END'.

Global Routine ERROR(LASTOPEN,POS,TYPE,NUM) : Novalue =
Begin
    Local
	k		: Integer,
	mask		: BitVector[64],
	saverl		: Integer;
    Own
	tbl		: Vector[HI_PS_TYPE+1,Long] Preset(
				[PS_END]	= TK_END,
				[PS_PAREN]	= TK_RPAREN,
				[PS_SEMICOLON]	= TK_SEMICOLON,
				[PS_COLON]	= TK_COLON,
				[PS_COMMA]	= TK_COMMA,
				[PS_THEN]	= TK_THEN,
				[PS_TES]	= TK_TES,
				[PS_OF]		= TK_OF,
				[PS_DO]		= TK_DO2,
				[PS_WHILE]	= TK_WHILE2,
				[PS_UNTIL]	= TK_UNTIL2,
				[PS_RANGLE]	= TK_RANGLE,
				[PS_RBRACKET]	= TK_RBRACKET,
				[PS_ELBANE]	= TK_ELBANE);

    SAVERL = .ERRLEVEL;
    ERRPRNT(.LASTOPEN,.POS,.NUM);
    ERRLEVEL = TRUE;
    RUNC(TRUE);
    mask = .lastend;
    If .type Neq 0 Then
	mask[.type] = TRUE;
    While Not .flg_eof Do
	Begin
	k = 1+(Incr i From LO_PS_TYPE To HI_PS_TYPE Do
			If .DEL Eql .tbl[.i] Then
			    Exitloop .i);
	If .mask[.k] Neq 0 Then
	    Exitloop;
	RUND(QL_LEXEME);
	RUNC(FALSE)
	End;
    ERRLEVEL = .SAVERL;
    Return 1			!NOT SURE THIS IS USEFUL
End;

End
Eludom