!COPYRIGHT 1972,1973,1974,1978 DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. 01754
MODULE	INDEX(STACK, VERSION=1(2))=
BEGIN



!   THIS FILE IS USED TO BUILD A MODULE FOR THE BLISS-10
!COMPILER WHICH CONTAINS A PLIT OF A TABLE OF ERROR CODE
!MNEMONICS, THEIR ERROR TYPE, AND THE BLOCK OFFSET FOR THE
!MESSAGE IN THE .ERR FILE.
!
!   THE INPUT FILE TO INDEX IS THE .ERR FILE, WHICH IS WRITTEN IN RUNOFF
!AND IS STRICTLY FORMATTED;  THE FORMAT OF THE .ERR FILE IS SPECIFIED
!BELOW:
!
!
!	<TYPE><MNEMONIC><2 SPACES><OLD CODE><2 SPACES><MESSAGE><CR>
!
!   WHERE:
!
!	<TYPE>     ::=   '%' IF THE MESSAGE IS A WARNING
!			 '?' IF AN ERROR
!			 '@' IF AN 'ABORT' ERROR
!
!	<MNEMONIC> ::=	 THE THREE LETTER CODE FOR THE MESSAGE
!
!	<OLD CODE> ::=	 IS THE OLD THREE DIGIT NUMERICAL ERROR CODE,
!			   STILL USED BY THE COMPILER TO IVOKE THE
!			   CORRECT MESSAGE
!
!	<MESSAGE>  ::=	 IS THE CORRECT ENGLISH LANGUAGE DIAGNOSTIC
!
!
!   ONLY LINES BEGINNING WITH A VALID <TYPE> ARE ASSUMED TO BE IN THIS
!FORMAT, THEREFORE, COMMENTS (SUCH AS ERR FILE VERSION #) AND EXTENDED
!ERROR DESCRIPTIONS (FOR THE BENEFIT OF THE MANUAL) MAY BE INCLUDED IN
!THE .ERR FILE WITHOUT BOTHERING THE LOGIC OF THE PROGRAM.  THE MESSAGE
!IS ASSUMED TO BE IN COLUMNS 12 THROUGH <CR>.
!   THE TABLE GENERATED BY THIS FILE IS IN THE FOLLOWING FORMAT:
!
!
!	ASCIZ '<CODE>' + <TYPE>^12 + <BLOCKOFFSET>
!
!   WHERE:
!
!	<CODE>	   ::= THE THREE LETTER MNEMONIC
!
!	<TYPE>	   ::= THE ERROR TYPE:  0 - WARNING
!					1 - ERROR
!					2 - 'ABORT' ERROR
!
!	<BLOCKOFFSET> ::= THE BLOCK OFFSET OF THE MESSAGE IN THE .ERR
!			     FILE.  THIS NUMBER IS THE BLOCK NUMBER TO
!			     BE 'USETI'ED TO BY THE COMPILER BEFORE
!			     READING.
!
!
!   THE TABLE IS TO BE INDEXED INTO BY THE ERROR CODE. I.E.  FOR PRO-
!CESSING OF AN ERROR CODE #450, THE COMPILER WILL RETRIEVE WORD
!TABLE + #450, WHICH IS IN THE FORMAT DESCRIBED ABOVE.  THE COMPILER
!WILL THEN TYPE THE CORRECT PRECEEDING ELEMENTS OF THE ERROR MESSAGE
!(THE LINE IN ERROR, A POINTER TO THE ERROR, ETC).  AT THIS POINT, THE
!COMPILER WILL USETI TO ENTRY<0,12> (THE <BLOCKOFFSET>) AND READ UNTIL
!IT FINDS A DELIMETER OF THE PROPER TYPE (%, ? OR @).  IT WILL THEN
!VERIFY THAT THE MNEMONIC FOLLOWING THE CHARACTER IS THE SAME AS THAT
!BEING SEARCHED FOR.  IF IT IS NOT, READING WILL CONTINUE.  IF IT IS,
!THE COMPILER WILL SPACE TO THE 12'TH COLUMN AND TYPE ALL CHARACTERS
!UNTIL A CARRAIGE RETURN IS INPUT.  THIS WILL TERMINATE THE MESSAGE.
!IF THE MESSAGE IS NOT FOUND IN THE .ERR FILE, A SPECIAL MESSAGE NEED
!BE OUTPUT SIGNALLING:  (1) THE USER'S ERROR AND (2) THE FACT THAT THE
!.ERR FILE IS IN INCORRECT FORMAT.
! PARAMETERS AND DEFINITIONS
! ==========================



GLOBAL	FILEIN[4], FILEOUT[4],	!FILENAME BUFFERS
	INHEAD[3], OUTHEAD[3],	!BUFFER HEADERS FOR THE MONITOR
	CMDL[10],		!THE COMMAND BUFFER AND TEMPORARY BUFFER
				!FOR BUILDTABLE
	OPENIN[3], OPENOUT[3],	!OPEN BLOCKS FOR FILES
	TABLE[#1000],		!BUILT DURING READING OF THE .ERR FILE,
				!AND USED TO OUTPUT THE TABLE IN H3ERR
	POSIT,			!CURRENT CHARACTER POSITION IN THE .ERR
				!FILE
	CHAR,			!LAST CHARACTER READ EITHER FROM THE
				!COMMAND BUFFER OR THE .ERR FILE
	INPOINT,		!INPUT POINTER TO THE COMMAND BUFFER
	CURRENT;		!POSIT WHEN LAST "%", "?" OR "@" WAS SEEN






BIND	INCH=1,			!INPUT CHANNEL DEFINITION
	OUTCH=2,		!OUTPUT CHANNEL DEF
	OPEN=#050,

				!THE FOLLOWING ARE INPUT FLAGS
	EOF=-1,		IOERR=-2,	IOERRBITS=#740000,

	BLOCKSIZE=#200;		!LENGTH OF ONE INPUT BLOCK
! MACHOPS AND MACROS
! ==================






MACHOP	LOOKUP=	#076,		!USEFUL OPCODES
	ENTER=	#077,
	CLOSE=	#070,
	STATZ=	#063,
	IN=	#056,
	OUT=	#057,
	TTCALL=	#051,
	XCT=	#256;






MACRO	OUTSTR(STR)=TTCALL(3, PLIT ASCIZ STR)$,		!OUTPUT STRING TO TTY

	OUTCHR(CHR)=VREG_ CHR<0,0>; TTCALL(1,VREG)$,	!OUTPUT CHARACTER TO TTY

	OUTSTRING(STR)=DOOUTSTRING(PLIT ASCIZ STR)$,	!OUTPUT STRING TO FILE

	FORM(OP,REG,ADDR)=(OP<0,0>^27 + (REG)<0,0>^23 + (ADDR)<0,0>)$,	!FORM OPCODE

	EXEC(INST)=(REGISTER X; X_ INST; IFSKIP XCT(0,X) THEN 1 ELSE 0)$,	!TRUE IF INST SKIPS

	ZEROBLOCK(BLOCK)=BLOCK_ BLOCK[1]_ BLOCK[2]_ BLOCK[3]_ 0$,	!ZERO FILENAME BLOCK

	PARSERR=(OUTSTR('?? SYNTAX ERROR'); RETURN 0)$,	!PARSING ERROR

	COUNT(HEAD)=HEAD[2]$,				!CHARACTER COUNT IN BUFFER

	POINT(HEAD)=HEAD[1]$,				!INPUT POINTER IN BUFFER

	BLOCK=(((.CURRENT DIV 5) DIV BLOCKSIZE)+1)$,	!CURRENT BLOCK NUMBER IN .ERR FILE

	ALWAYSTRUE=1$,					!FOR SOME LOOPS

	TTIN=(TTCALL(4,3); .VREG)$;			!VALUE IS CHARACTER FROM TTY




FORWARD	OUTNAME, OUTSIX;
! BASIC COMMAND STRING ATOM PARSER
! ================================




ROUTINE	PARSEFIELD(FILEBLOCK)=
			! RETURNS 0 IF NAME PARSED,
			!         1 IF DEVICE PARSED.

BEGIN	LABEL NAME;
	LOCAL OUTPOINT, VALUE;

	OUTPOINT_ (@FILEBLOCK)<36,6>;

    VALUE_ NAME:  DECR I FROM 5 TO 0 DO		!GET NEXT ATOM
		(IF (CHAR_ SCANI(INPOINT)) EQL 0 THEN
				RETURN 0;
		 IF (.CHAR EQL ".") OR (.CHAR EQL "=") OR (.CHAR EQL ":") THEN
				LEAVE NAME WITH 0;
		 REPLACEI(OUTPOINT, (.CHAR-#40)));

	IF .VALUE EQL -1 THEN %WE HAVEN'T FOUND A TERMINATING CHAR YET%
		(DO (CHAR_ SCANI(INPOINT)) UNTIL
			(.CHAR EQL ".") OR (.CHAR EQL "=") OR (.CHAR EQL ":") OR (.CHAR EQL 0));

	IF (.CHAR EQL 0) OR (.CHAR EQL "=") THEN RETURN 0;	!GOT OUR ATOM?
	IF .CHAR EQL ":" THEN RETURN 1;

	OUTPOINT_ (@FILEBLOCK)[1]<36,6>;

	DECR I FROM 2 TO 0 DO		!GOT NAME, NOW GET EXTENSION
		(IF ((CHAR_ SCANI(INPOINT)) EQL 0) OR (.CHAR EQL "=") THEN
				RETURN 0;
		 REPLACEI(OUTPOINT, .CHAR - #40));

	DO (CHAR_ SCANI(INPOINT)) UNTIL %TERMINATING CHARCTER SEEN%
		(.CHAR EQL 0) OR (.CHAR EQL "=");

	0
END;
! CHANNEL INITIALIZATION
! ======================


ROUTINE	DOOPEN(DEVICE, CHANNEL, OPENBLOCK)=
BEGIN

	(.OPENBLOCK)[1]_ .DEVICE;	!PUT DEVICE NAME IN OPEN BLOCK

	IF EXEC(FORM(OPEN,.CHANNEL,.OPENBLOCK)) THEN RETURN 1;
	OUTSTR('?? CAN''T OPEN ');  OUTSIX(.DEVICE); 0

END;






ROUTINE	DOLOOKUP(DEVICE, FILENAME)=
BEGIN

	OPENIN[2]_ INHEAD<0,0>;		!PUT POINTER TO INPUT BUFFER HEADER

	IF NOT DOOPEN(.DEVICE, INCH, OPENIN) THEN RETURN 0;	!OPEN DEVICE

	IFSKIP LOOKUP(INCH, @FILENAME) THEN RETURN 1;		!LOOKUP FILE

	OUTSTR('?? CAN''T FIND ');  OUTNAME(.FILENAME); 0

END;





ROUTINE	DOENTER(DEVICE, FILENAME)=
BEGIN

	OPENOUT[2]_ OUTHEAD<0,0>^18;		!POINTER TO OUTPUT BUFFER HEADER

	IF NOT DOOPEN(.DEVICE, OUTCH, OPENOUT) THEN RETURN 0;	!OPEN DEVICE

	IFSKIP ENTER(OUTCH, @FILENAME) THEN RETURN 1;		!ENTER FILE

	OUTSTR('?? CAN''T ENTER ');  OUTNAME(.FILENAME);  0

END;
! BASIC CHARACTER INPUT/OUTPUT ROUTINES
! =====================================



ROUTINE	INCHAR=		!GET CHARACTER FROM INPUT FILE
BEGIN

	IF (COUNT(INHEAD)_ .COUNT(INHEAD) - 1) LEQ 0 THEN	!THE BUFFER IS EMPTY
	   BEGIN
		IFSKIP IN(INCH) THEN				!SO GET A NEW ONE
			(IFSKIP STATZ(INCH, IOERRBITS) THEN EOF	!DETERMINE TYPE OF ERROR
				ELSE (OUTSTR('?? INPUT ERROR'); IOERR))
			 ELSE (POSIT_ .POSIT + 1; SCANI(POINT(INHEAD)))	!GET CHAR FROM NEW BUFFER
	   END
	   ELSE (POSIT_ .POSIT + 1;  SCANI(POINT(INHEAD)))	!BUFFER WASN'T EMPTY - GET CHARACTER

END;






ROUTINE	OUTCHAR(CHAR)=		!WRITE CHARACTER TO OUTPUT FILE
BEGIN

	IF (COUNT(OUTHEAD)_ .COUNT(OUTHEAD) - 1) LEQ 0 THEN	!NO ROOM IN BUFFER
		(IFSKIP OUT(OUTCH) THEN				!SO WRITE IT OUT
				RETURN (OUTSTR('?? OUTPUT ERROR'); 0));
	REPLACEI(POINT(OUTHEAD), .CHAR); 1			!PUT CHARACTER

END;
! CHUNK INPUT ROUTINES
! ====================





ROUTINE	GETCMD=		!GET A COMMAND STRING FROM THE TTY
BEGIN	LOCAL	VALUE, PTR;
	LABEL	LOOPX;

	INPOINT_ PTR_ CMDL<36,7>;		!POINTERS TO COMMAND BUFFER

	OUTSTR('?M?J*');			! PROMPT

    VALUE_ LOOPX: DECR I FROM 48 TO 0 DO	!LENGTH OF LONGEST ALLOWED CMD

		(DO (CHAR_ TTIN) UNTIL .CHAR NEQ #15;	!IGNORE <CR>
		 IF .CHAR EQL "_" THEN CHAR_ "=";	!FORCE "=" IF "_"
		 IF .CHAR NEQ #12 THEN REPLACEI(PTR, .CHAR);	!PUT CHAR
		 IF .CHAR EQL #12 THEN LEAVE LOOPX WITH 0);	!TERMINATE ON LF

	IF .VALUE EQL -1 THEN RETURN(OUTSTR('?? LINE TOO LONG'); 0);
	REPLACEI(PTR,0);  1				!PUT NULL

END;
! CHUNK OUTPUT ROUTINES
! =====================



ROUTINE	DOOUTSTRING(STRING)=		!PUT STRING ONTO OUTPUT FILE
BEGIN	LOCAL CHARAC, PTR;

	PTR_ (.STRING)<36,7>;
	WHILE (CHARAC_ SCANI(PTR)) NEQ 0 DO
		(IF NOT OUTCHAR(.CHARAC) THEN RETURN 0);	!PUT NEXT CHARACTER

END;




ROUTINE	OUTDEC(NUM)=	!PUT DECIMAL NUMBER ONTO OUTPUT FILE
BEGIN	OWN N;		!THIS ROUTINE COPIED FROM EXAMPLES

	ROUTINE	OUTDEX=
	BEGIN	LOCAL R;

		IF .N EQL 0 THEN RETURN 0;
		R_ .N MOD 10;  N_ .N / 10;  OUTDEX();
		OUTCHAR(.R + "0")

	END;

	IF .NUM EQL 0 THEN RETURN OUTCHAR("0");
	N_ .NUM;  OUTDEX();

END;




ROUTINE	OUTNAME(NAME)=(OUTSIX(..NAME); OUTSTR('.'); OUTSIX(.(.NAME)[1]));	!PUT NAME ONTO TTY



ROUTINE	OUTSIX(WORD)=		!PUT SIXBIT WORD ONTO TTY
BEGIN	LOCAL PTR, CHARAC;

	PTR_ WORD<36,6>;

	DECR I FROM 5 TO 0 DO
		(IF (CHARAC_ SCANI(PTR)) EQL 0 THEN RETURN;	!TERMINATE ON NULL
		 OUTCHR(.CHARAC + #40));			!PUT NEXT

END;
! HEADER/TRAILER ROUTINES
! =======================




ROUTINE	WRITEHEAD=		!PUT HEADER TO OUTPUT FILE
BEGIN
	LOCAL I,P;

	OUTSTRING('MODULE ');
	P _ FILEOUT<36,6>;
	DECR I FROM 5 TO 0 DO OUTCHAR(SCANI(P) + #40);
	OUTSTRING('=?M?JBEGIN?M?J?M?J?M?J');

	OUTSTRING('BIND ERRPLIT=PLIT(ERRTABLE GLOBALLY NAMES?M?J?I?I');

END;









ROUTINE	WRITECLOSE=		!PUT TRAILER TO OUTPUT FILE
BEGIN

	OUTSTRING(');?M?J?M?JEND;?M?J');

END;
! SEARCH AND WRITE ROUTINES
! =========================




ROUTINE	NEXT=		!FIND NEXT ENTRY IN .ERR FILE
BEGIN

	WHILE ALWAYSTRUE DO
	   BEGIN

		CHAR_ INCHAR();		!GET NEXT CHAR
		IF (.CHAR EQL EOF) OR (.CHAR EQL IOERR) THEN RETURN 0;	!CHECK FOR ERRORS

		IF (.CHAR EQL "??") OR (.CHAR EQL "%") OR (.CHAR EQL "@")
			THEN RETURN (CURRENT_ .POSIT; 1);	!FOUND THE NEXT

	   END;

END;





ROUTINE	GIVEINFO=		!GIVE INFO ON THE TABLE
BEGIN	LOCAL PTR;

	INCR I FROM 0 TO #1000-1 DO
	  BEGIN

	    IF .TABLE[.I] NEQ 0 THEN		!ENTRY FOR THIS CODE
		BEGIN

		   OUTSTRING('ASCIZ ''');

		   PTR_ TABLE[.I]<36,7>;

		   DECR I FROM 2 TO 0 DO OUTCHAR(SCANI(PTR));	!PUT MNEMONIC

		   OUTSTRING(''' + ');  OUTDEC(.TABLE[.I]<12,2>);	!AND ERROR TYPE

		   OUTSTRING('^12 + ');  OUTDEC(.TABLE[.I]<0,12>);	!AND BLOCK OFFSET

		END

		ELSE	OUTCHAR("0");				!SLOT EMPTY - GIVE ZERO

	    OUTSTRING(',?M?J?I?I');					!FORMAT

	  END;

END;
! BUILD TABLE
! ===========




ROUTINE	BUILDTABLE=		!CALLED IMMEDIATELY AFTER NEXT
BEGIN	LOCAL	PTR, TYPE, NUM;

	TYPE_ IF .CHAR EQL "%" THEN 0 ELSE
		IF .CHAR EQL "??" THEN 1 ELSE 2;	!TYPE OF ERROR

	PTR_ CMDL<36,7>;

	DECR I FROM 2 TO 0 DO REPLACEI(PTR,INCHAR());	!SAVE MNEMONIC

	INCHAR();  INCHAR();				!POSITION TO NUMBER FIELD

	NUM_ 0;

	DECR I FROM 2 TO 0 DO				!DECIFER NUMBER FIELD
	   BEGIN

		IF (CHAR_ INCHAR()) NEQ #40 THEN	!NOT LEAD SPACE
			NUM_ (.NUM * 8) + (.CHAR - #60);	!ADD TO TOTAL

	   END;



	TABLE[.NUM]_  .CMDL;		!PUT MNEMONIC

	TABLE[.NUM]<12,2>_  .TYPE;	!TYPE OF ERROR

	TABLE[.NUM]<0,12>_  BLOCK;	!AND BLOCK OFFSET

END;
! COMMAND STRING PARSING DRIVER ROUTINE
! =====================================





ROUTINE	PARSE=
BEGIN	LOCAL DEV, TEMP;

	GETCMD();			! GET LINE

	ZEROBLOCK(FILEIN);  ZEROBLOCK(FILEOUT);		!ZERO FILENAME BLOCK

	DEV_ IF PARSEFIELD(FILEOUT) %WE HAD A DEVICE NAME%
		THEN (TEMP_ .FILEOUT; PARSEFIELD(FILEOUT); .TEMP)	!SO USE IT AND GET FILENAME
		ELSE SIXBIT "DSK   ";

	IF (.CHAR OR .FILEOUT) EQL 0 THEN RETURN 0;	!IF NOTHING TYPED - RETURN
	IF .CHAR NEQ "=" THEN PARSERR();		!OUTPUT SIDE MUST BE DONE

	IF NOT DOENTER(.DEV,FILEOUT) THEN RETURN 0;	!ENTER NEW FILE


	DEV_ IF PARSEFIELD(FILEIN)			!DEVICE FOR INPUT SIDE
		THEN (TEMP_ .FILEIN; PARSEFIELD(FILEIN); TEMP)
		ELSE SIXBIT "DSK   ";

	IF .CHAR NEQ 0 THEN PARSERR();			!LINE MUST BE DONE

	DOLOOKUP(.DEV,FILEIN)				!AND LOOKUP FILE

END;
! MAIN DRIVER CODE
! ================





ROUTINE	DRIVER=
BEGIN	LABEL	PARSLOOP;	MACHOP	CALLI=#047;


	DECR I FROM #1000-1 TO 0 DO TABLE[.I]_ 0;	!ZERO TABLE

	CALLI(0);			!RESET

    PARSLOOP:  WHILE ALWAYSTRUE DO (IF PARSE() THEN LEAVE PARSLOOP);

	WRITEHEAD();			! WRITE HEADER

	WHILE NEXT() DO BUILDTABLE();	! BUILD TABLE FROM INPUT FILE

	GIVEINFO();			! GIVE TABLE IN CORRECT FORMAT

	WRITECLOSE();			! TRAILER

END;
! END PAGE
! ========






DRIVER();		! GO




END;