Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-04 - decus/20-0122/sklton.xpl
There are 2 other files named sklton.xpl in the archive. Click here to see a list.
 /*   SKELETON
  06-Jul-77, JBD - Changes made to SKLTON.XPL:
	References to TRACE and UNTRACE were removed. This of course,
	renders the $T switch completly useless.
	All "[" were changed to \. (character set incompatibilities)
	Reference to DATE_OF_GENERATION and TIME_OF_GENERATION were
	 removed.

  15-Jul-77, JBD - More changes:
	Code was added to take source from a file.
	The access mechanism to C1 had to be changed in order to
	handle 9-bit bytes...ugh.
	Stuff was added here and there to tell the user what was
	happening in Synthesize.
	X70 was all tabs, so I had to change that.
	It handles tabs, but the listing comes out jagging.
		THE PROTO-COMPILER OF THE XPL SYSTEM
 
 
W. M. MCKEEMAN	       J. J. HORNING	       D. B. WORTMAN
 
INFORMATION &	       COMPUTER SCIENCE        COMPUTER SCIENCE
COMPUTER SCIENCE,      DEPARTMENT,	       DEPARTMENT,
 
UNIVERSITY OF	       STANFORD 	       STANFORD
CALIFORNIA AT	       UNIVERSITY,	       UNIVERSITY,
 
SANTA CRUZ,	       STANFORD,	       STANFORD,
CALIFORNIA	       CALIFORNIA	       CALIFORNIA
95060		       94305		       94305
 
DEVELOPED AT THE STANFORD COMPUTATION CENTER, CAMPUS FACILITY,	 1966-69
AND THE UNIVERSITY OF CALIFORNIA COMPUTATION CENTER, SANTA CRUZ, 1968-69.
 
DISTRIBUTED THROUGH THE SHARE ORGANIZATION.
THIS VERSION OF SKELETON IS A SYNTAX CHECKER FOR THE FOLLOWING GRAMMAR:
 
<PROGRAM>  ::=	<STATEMENT LIST>
 
<STATEMENT LIST>  ::=  <STATEMENT>
		    ^  <STATEMENT LIST> <STATEMENT>
 
<STATEMENT>  ::=  <ASSIGNMENT> ;
 
<ASSIGNMENT>  ::=  <VARIABLE> = <EXPRESSION>
 
<EXPRESSION>  ::=  <ARITH EXPRESSION>
		^  <IF CLAUSE> THEN <EXPRESSION> ELSE <EXPRESSION>
 
<IF CLAUSE>  ::=  IF <LOG EXPRESSION>
 
<LOG EXPRESSION>  ::=  TRUE
		    ^  FALSE
		    ^  <EXPRESSION> <RELATION> <EXPRESSION>
		    ^  <IF CLAUSE> THEN <LOG EXPRESSION> ELSE <LOG EXPRESSION>
 
<RELATION>  ::=  =
	      ^  <
	      ^  >
 
<ARITH EXPRESSION>  ::=  <TERM>
		      ^  <ARITH EXPRESSION> + <TERM>
		      ^  <ARITH EXPRESSION> - <TERM>
 
<TERM>	::=  <PRIMARY>
	  ^  <TERM> * <PRIMARY>
	  ^  <TERM> / <PRIMARY>
 
<PRIMARY>  ::=	<VARIABLE>
	     ^	<NUMBER>
	     ^	( <EXPRESSION> )
 
<VARIABLE>  ::=  <IDENTIFIER>
	      ^  <VARIABLE> ( <EXPRESSION> )
									      */
 
   /*  FIRST WE INITIALIZE THE GLOBAL CONSTANTS THAT DEPEND UPON THE INPUT
      GRAMMAR.	THE FOLLOWING CARDS ARE PUNCHED BY THE SYNTAX PRE-PROCESSOR  */
 
   DECLARE NSY LITERALLY '32', NT LITERALLY '18';
   DECLARE V(NSY) CHARACTER INITIAL ( '<ERROR: TOKEN = 0>', ';', '=', '<', '>',
      '+', '-', '*', '/', '(', ')', 'IF', '_^_', 'THEN', 'ELSE', 'TRUE',
      'FALSE', '<NUMBER>', '<IDENTIFIER>', '<TERM>', '<PROGRAM>', '<PRIMARY>',
      '<VARIABLE>', '<RELATION>', '<STATEMENT>', '<IF CLAUSE>', '<ASSIGNMENT>',
      '<EXPRESSION>', '<STATEMENT LIST>', '<ARITH EXPRESSION>',
      '<LOG EXPRESSION>', 'ELSE', 'ELSE');
   DECLARE V_INDEX(12) BIT(16) INITIAL ( 1, 11, 12, 13, 16, 17, 17, 17, 18, 18,
      18, 18, 19);
   DECLARE C1(NSY) BIT(38) INITIAL (
      "(2) 00000 00000 00000 0000",
      "(2) 00000 00000 00200 0002",
      "(2) 00000 00003 03000 0033",
      "(2) 00000 00002 02000 0022",
      "(2) 00000 00002 02000 0022",
      "(2) 00000 00001 00000 0011",
      "(2) 00000 00001 00000 0011",
      "(2) 00000 00001 00000 0011",
      "(2) 00000 00001 00000 0011",
      "(2) 00000 00001 01000 0011",
      "(2) 02222 22222 20022 0000",
      "(2) 00000 00001 01000 1111",
      "(2) 00000 00000 00000 0001",
      "(2) 00000 00001 01000 1111",
      "(2) 00000 00002 02000 2222",
      "(2) 00000 00000 00022 0000",
      "(2) 00000 00000 00022 0000",
      "(2) 02222 22220 20022 0000",
      "(2) 02222 22222 20022 0000",
      "(2) 02222 22110 20022 0000",
      "(2) 00000 00000 00000 0000",
      "(2) 02222 22220 20022 0000",
      "(2) 02322 22221 20022 0000",
      "(2) 00000 00001 01000 0011",
      "(2) 00000 00000 00200 0002",
      "(2) 00000 00000 00010 0000",
      "(2) 01000 00000 00000 0000",
      "(2) 02333 00000 30023 0000",
      "(2) 00000 00000 00200 0001",
      "(2) 02222 11000 20022 0000",
      "(2) 00000 00000 00023 0000",
      "(2) 00000 00001 01000 0011",
      "(2) 00000 00001 01000 1111");
   DECLARE NC1TRIPLES LITERALLY '17';
   DECLARE C1TRIPLES(NC1TRIPLES) FIXED INITIAL ( 596746, 727810, 727811, 727812,
      792066, 858882, 858883, 858884, 858894, 859662, 1442313, 1442315, 1442321,
      1442322, 1840642, 2104066, 2104067, 2104068);
   DECLARE PRTB(28) FIXED INITIAL (0, 26, 0, 0, 0, 1444123, 2331, 0, 0, 0, 0, 0,
      0, 7429, 7430, 0, 4871, 4872, 0, 0, 28, 0, 420289311, 5634, 6935, 0, 0,
      420290080, 11);
   DECLARE PRDTB(28) BIT(8) INITIAL (0, 4, 13, 14, 15, 26, 24, 0, 0, 9, 10, 23,
      25, 17, 18, 16, 20, 21, 19, 22, 3, 2, 7, 5, 11, 1, 6, 12, 8);
   DECLARE HDTB(28) BIT(8) INITIAL (0, 24, 23, 23, 23, 22, 21, 31, 32, 30, 30,
      21, 22, 29, 29, 29, 19, 19, 19, 21, 28, 28, 27, 26, 30, 20, 27, 30, 25);
   DECLARE PRLENGTH(28) BIT(8) INITIAL (0, 2, 1, 1, 1, 4, 3, 1, 1, 1, 1, 1, 1,
      3, 3, 1, 3, 3, 1, 1, 2, 1, 5, 3, 3, 1, 1, 5, 2);
   DECLARE CONTEXT_CASE(28) BIT(8) INITIAL (0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0,
      0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
   DECLARE LEFT_CONTEXT(0) BIT(8) INITIAL ( 27);
   DECLARE LEFT_INDEX(14) BIT(8) INITIAL ( 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
      0, 1, 1);
   DECLARE CONTEXT_TRIPLE(0) FIXED INITIAL ( 0);
   DECLARE TRIPLE_INDEX(14) BIT(8) INITIAL ( 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
      0, 0, 1);
   DECLARE PR_INDEX(32) BIT(8) INITIAL ( 1, 2, 3, 4, 5, 5, 5, 5, 5, 5, 7, 7, 7,
      7, 9, 10, 11, 12, 13, 16, 16, 19, 20, 20, 22, 22, 22, 25, 26, 27, 29, 29,
      29);
 
   /*  END OF CARDS PUNCHED BY SYNTAX					   */
 
   /*  DECLARATIONS FOR THE SCANNER					   */
 
   /* TOKEN IS THE INDEX INTO THE VOCABULARY V() OF THE LAST SYMBOL SCANNED,
      CP IS THE POINTER TO THE LAST CHARACTER SCANNED IN THE CARDIMAGE,
      BCD IS THE LAST SYMBOL SCANNED (LITERAL CHARACTER STRING). */
   DECLARE (TOKEN, CP) FIXED, BCD CHARACTER;
 
   /* SET UP SOME CONVENIENT ABBREVIATIONS FOR PRINTER CONTROL */
   DECLARE EJECT_PAGE LITERALLY 'OUTPUT(1) = PAGE',
      PAGE CHARACTER INITIAL ('1'), DOUBLE CHARACTER INITIAL ('0'),
      DOUBLE_SPACE LITERALLY 'OUTPUT(1) = DOUBLE',
      X70 CHARACTER INITIAL ('                                                   
                    ');
 
   /* LENGTH OF LONGEST SYMBOL IN V */
   DECLARE (RESERVED_LIMIT, MARGIN_CHOP) FIXED;
 
   /* CHARTYPE() IS USED TO DISTINGUISH CLASSES OF SYMBOLS IN THE SCANNER.
      TX() IS A TABLE USED FOR TRANSLATING FROM ONE CHARACTER SET TO ANOTHER.
      CONTROL() HOLDS THE VALUE OF THE COMPILER CONTROL TOGGLES SET IN $ CARDS.
      NOT_LETTER_OR_DIGIT() IS SIMILIAR TO CHARTYPE() BUT USED IN SCANNING
      IDENTIFIERS ONLY.
 
      ALL ARE USED BY THE SCANNER AND CONTROL() IS SET THERE.
   */
   DECLARE (CHARTYPE, TX) (255) BIT(8),
	   (CONTROL, NOT_LETTER_OR_DIGIT)(255) BIT(1);
 
   /* ALPHABET CONSISTS OF THE SYMBOLS CONSIDERED ALPHABETIC IN BUILDING
      IDENTIFIERS     */
   DECLARE ALPHABET CHARACTER INITIAL ('ABCDEFGHIJKLMNOPQRSTUVWXYZ_$@#');
 
   /* BUFFER HOLDS THE LATEST CARDIMAGE,
      TEXT HOLDS THE PRESENT STATE OF THE INPUT TEXT
      (NOT INCLUDING THE PORTIONS DELETED BY THE SCANNER),
      TEXT_LIMIT IS A CONVENIENT PLACE TO STORE THE POINTER TO THE END OF TEXT,
      CARD_COUNT IS INCREMENTED BY ONE FOR EVERY SOURCE CARD READ,
      ERROR_COUNT TABULATES THE ERRORS AS THEY ARE DETECTED,
      SEVERE_ERRORS TABULATES THOSE ERRORS OF FATAL SIGNIFICANCE.
   */
   DECLARE (BUFFER, TEXT) CHARACTER,
      (TEXT_LIMIT, CARD_COUNT, ERROR_COUNT, SEVERE_ERRORS, PREVIOUS_ERROR) FIXED
      ;
 
   /* NUMBER_VALUE CONTAINS THE NUMERIC VALUE OF THE LAST CONSTANT SCANNED,
   */
   DECLARE NUMBER_VALUE FIXED;
 
   /* EACH OF THE FOLLOWING CONTAINS THE INDEX INTO V() OF THE CORRESPONDING
      SYMBOL.	WE ASK:    IF TOKEN = IDENT    ETC.    */
   DECLARE (IDENT, NUMBER, DIVIDE, EOFILE) FIXED;
 
   /* STOPIT() IS A TABLE OF SYMBOLS WHICH ARE ALLOWED TO TERMINATE THE ERROR
      FLUSH PROCESS.  IN GENERAL THEY ARE SYMBOLS OF SUFFICIENT SYNTACTIC
      HIERARCHY THAT WE EXPECT TO AVOID ATTEMPTING TO START CHECKING AGAIN
      RIGHT INTO ANOTHER ERROR PRODUCING SITUATION.  THE TOKEN STACK IS ALSO
      FLUSHED DOWN TO SOMETHING ACCEPTABLE TO A STOPIT() SYMBOL.
      FAILSOFT IS A BIT WHICH ALLOWS THE COMPILER ONE ATTEMPT AT A GENTLE
      RECOVERY.   THEN IT TAKES A STRONG HAND.	 WHEN THERE IS REAL TROUBLE
      COMPILING IS SET TO FALSE, THEREBY TERMINATING THE COMPILATION.
   */
   DECLARE STOPIT(100) BIT(1), (FAILSOFT, COMPILING) BIT(1);
 
   DECLARE S CHARACTER;  /* A TEMPORARY USED VARIOUS PLACES */
 
   /* THE ENTRIES IN PRMASK() ARE USED TO SELECT OUT PORTIONS OF CODED
      PRODUCTIONS AND THE STACK TOP FOR COMPARISON IN THE ANALYSIS ALGORITHM */
   DECLARE PRMASK(5) FIXED INITIAL (0, 0, "FF", "FFFF", "FFFFFF", "FFFFFFFF");
 
 
   /*THE PROPER SUBSTRING OF POINTER IS USED TO PLACE AN  ^  UNDER THE POINT
      OF DETECTION OF AN ERROR DURING CHECKING.  IT MARKS THE LAST CHARACTER
      SCANNED.	*/
   DECLARE POINTER CHARACTER INITIAL ('
					   ^');
   DECLARE CALLCOUNT(20) FIXED	 /* COUNT THE CALLS OF IMPORTANT PROCEDURES */
      INITIAL(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
 
   /* RECORD THE TIMES OF IMPORTANT POINTS DURING CHECKING */
   DECLARE CLOCK(5) FIXED;
 
 
   /* COMMONLY USED STRINGS */
   DECLARE X1 CHARACTER INITIAL(' '), X4 CHARACTER INITIAL('	');
   DECLARE PERIOD CHARACTER INITIAL ('.');
 
   /* TEMPORARIES USED THROUGHOUT THE COMPILER */
   DECLARE (I, J, K, L) FIXED;
 
   DECLARE TRUE LITERALLY '1', FALSE LITERALLY '0', FOREVER LITERALLY 'WHILE 1';
 
   /*  THE STACKS DECLARED BELOW ARE USED TO DRIVE THE SYNTACTIC
      ANALYSIS ALGORITHM AND STORE INFORMATION RELEVANT TO THE INTERPRETATION
      OF THE TEXT.  THE STACKS ARE ALL POINTED TO BY THE STACK POINTER SP.  */
 
   DECLARE STACKSIZE LITERALLY '75';  /* SIZE OF STACK	*/
   DECLARE PARSE_STACK (STACKSIZE) BIT(8); /* TOKENS OF THE PARTIALLY PARSED
					      TEXT */
   DECLARE VAR (STACKSIZE) CHARACTER;/* EBCDIC NAME OF ITEM */
   DECLARE FIXV (STACKSIZE) FIXED;   /* FIXED (NUMERIC) VALUE */
 
   /* SP POINTS TO THE RIGHT END OF THE REDUCIBLE STRING IN THE PARSE STACK,
      MP POINTS TO THE LEFT END, AND
      MPP1 = MP+1.
   */
   DECLARE (SP, MP, MPP1) FIXED;
 
 
 /*	TO MASK OUT THE REMAINING 4 BITS FROM A 36 BIT WORD	*/
   DECLARE B32 LITERALLY '&"FFFFFFFF"';
 
 
 
   /*		    P R O C E D U R E S 				 */
 
 
 
PAD:
   PROCEDURE (STRING, WIDTH) CHARACTER;
      DECLARE STRING CHARACTER, (WIDTH, L) FIXED;
 
      L = LENGTH(STRING);
      IF L >= WIDTH THEN RETURN STRING;
      ELSE RETURN STRING ^^ SUBSTR(X70, 0, WIDTH-L);
   END PAD;
 
I_FORMAT:
   PROCEDURE (NUMBER, WIDTH) CHARACTER;
      DECLARE (NUMBER, WIDTH, L) FIXED, STRING CHARACTER;
 
      STRING = NUMBER;
      L = LENGTH(STRING);
      IF L >= WIDTH THEN RETURN STRING;
      ELSE RETURN SUBSTR(X70, 0, WIDTH-L) ^^ STRING;
   END I_FORMAT;
 
ERROR:
   PROCEDURE(MSG, SEVERITY);
      /* PRINTS AND ACCOUNTS FOR ALL ERROR MESSAGES */
      /* IF SEVERITY IS NOT SUPPLIED, 0 IS ASSUMED */
      DECLARE MSG CHARACTER, SEVERITY FIXED;
      ERROR_COUNT = ERROR_COUNT + 1;
      /* IF LISTING IS SUPPRESSED, FORCE PRINTING OF THIS LINE */
      IF \ CONTROL(BYTE('L')) THEN
	 OUTPUT = I_FORMAT (CARD_COUNT, 4) ^^ ' ^' ^^ BUFFER ^^ '^';
      OUTPUT = SUBSTR(POINTER, TEXT_LIMIT-CP+MARGIN_CHOP);
      OUTPUT(-1), OUTPUT = '*** ERROR, ' ^^ MSG ^^
	    '.	LAST PREVIOUS ERROR WAS DETECTED ON LINE ' ^^
	    PREVIOUS_ERROR ^^ '.  ***';
      PREVIOUS_ERROR = CARD_COUNT;
      IF SEVERITY > 0 THEN
	 IF SEVERE_ERRORS > 25 THEN
	    DO;
	       OUTPUT = '*** TOO MANY SEVERE ERRORS, CHECKING ABORTED ***';
	       COMPILING = FALSE;
	    END;
	 ELSE SEVERE_ERRORS = SEVERE_ERRORS + 1;
   END ERROR;
 
 
 
 
 
  /*		       CARD IMAGE HANDLING PROCEDURE			  */
 
 
GET_CARD:
   PROCEDURE;
      /* DOES ALL CARD READING AND LISTING				   */
      DECLARE I FIXED, (TEMP, TEMP0, REST) CHARACTER, READING BIT(1);
	    BUFFER = INPUT;
	    IF LENGTH(BUFFER) = 0 THEN
	       DO; /* SIGNAL FOR EOF */
		  CALL ERROR ('EOF MISSING OR COMMENT STARTING IN COLUMN 1.',1);
		  BUFFER = PAD (' /*''/* */ EOF;END;EOF', 80);
	       END;
	    ELSE CARD_COUNT = CARD_COUNT + 1;  /* USED TO PRINT ON LISTING */
	     BUFFER = PAD(BUFFER,80);
      IF MARGIN_CHOP > 0 THEN
	 DO; /* THE MARGIN CONTROL FROM DOLLAR ^ */
	    I = LENGTH(BUFFER) - MARGIN_CHOP;
	    REST = SUBSTR(BUFFER, I);
	    BUFFER = SUBSTR(BUFFER, 0, I);
	 END;
      ELSE REST = '';
      TEXT = BUFFER;
      TEXT_LIMIT = LENGTH(TEXT) - 1;
      IF CONTROL(BYTE('M')) THEN OUTPUT = BUFFER;
      ELSE IF CONTROL(BYTE('L')) THEN
	 OUTPUT = I_FORMAT (CARD_COUNT, 4) ^^ ' ^' ^^ BUFFER ^^ '^' ^^ REST;
      CP = 0;
   END GET_CARD;
 
 
   /*		     THE SCANNER PROCEDURES		 */
 
 
CHAR:
   PROCEDURE;
      /* USED FOR STRINGS TO AVOID CARD BOUNDARY PROBLEMS */
      CP = CP + 1;
      IF CP <= TEXT_LIMIT THEN RETURN;
      CALL GET_CARD;
   END CHAR;
 
 
SCAN:
   PROCEDURE;
      DECLARE (S1, S2) FIXED;
      CALLCOUNT(3) = CALLCOUNT(3) + 1;
      FAILSOFT = TRUE;
      BCD = '';  NUMBER_VALUE = 0;
   SCAN1:
      DO FOREVER;
	 IF CP > TEXT_LIMIT THEN CALL GET_CARD;
	 ELSE
	    DO; /* DISCARD LAST SCANNED VALUE */
	       TEXT_LIMIT = TEXT_LIMIT - CP;
	       TEXT = SUBSTR(TEXT, CP);
	       CP = 0;
	    END;
	 /*  BRANCH ON NEXT CHARACTER IN TEXT		       */
	 DO CASE CHARTYPE(BYTE(TEXT));
 
	    /*	CASE 0	*/
 
	    /* ILLEGAL CHARACTERS FALL HERE  */
	    CALL ERROR ('ILLEGAL CHARACTER: ' ^^ SUBSTR(TEXT, 0, 1)
		 ^^ '(' ^^ BYTE(TEXT) ^^ ')');
 
	    /*	CASE 1	*/
 
	    /*	BLANK  */
	    DO;
	       CP = 1;
	       DO WHILE CHARTYPE(BYTE(TEXT,CP)) = 1 & CP <= TEXT_LIMIT;
		  CP = CP + 1;
	       END;
	       CP = CP - 1;
	    END;
 
	    /*	CASE 2	*/
 
	;   /*	NOT USED IN SKELETON (BUT USED IN XCOM)  */
 
	    /*	CASE 3	*/
 
	;   /*	NOT USED IN SKELETON (BUT USED IN XCOM)  */
 
	    /*	CASE 4	*/
 
	    DO FOREVER;  /* A LETTER:  IDENTIFIERS AND RESERVED WORDS */
	       DO CP = CP + 1 TO TEXT_LIMIT;
		  IF NOT_LETTER_OR_DIGIT(BYTE(TEXT, CP)) THEN
		     DO;  /* END OF IDENTIFIER	*/
			IF CP > 0 THEN BCD = BCD ^^ SUBSTR(TEXT, 0, CP);
			S1 = LENGTH(BCD);
			IF S1 > 1 THEN IF S1 <= RESERVED_LIMIT THEN
			   /* CHECK FOR RESERVED WORDS */
			   DO I = V_INDEX(S1-1) TO V_INDEX(S1) - 1;
			      IF BCD = V(I) THEN
				 DO;
				    TOKEN = I;
				    RETURN;
				 END;
			   END;
			/*  RESERVED WORDS EXIT HIGHER: THEREFORE <IDENTIFIER>*/
			TOKEN = IDENT;
			RETURN;
		     END;
	       END;
	       /*  END OF CARD	*/
	       BCD = BCD ^^ TEXT;
	       CALL GET_CARD;
	       CP = -1;
	    END;
 
	    /*	CASE 5	*/
 
	    DO;      /*  DIGIT:  A NUMBER  */
	       TOKEN = NUMBER;
	       DO FOREVER;
		  DO CP = CP TO TEXT_LIMIT;
		     S1 = BYTE(TEXT, CP);
		     IF (S1 < 48) ^ (S1 > 57) THEN RETURN;
		     NUMBER_VALUE = 10*NUMBER_VALUE + S1 - 48;
		  END;
		  CALL GET_CARD;
	       END;
	    END;
 
	    /*	CASE 6	*/
 
	    DO;      /*  A /:  MAY BE DIVIDE OR START OF COMMENT  */
	       CALL CHAR;
	       IF BYTE(TEXT, CP) \= BYTE('*') THEN
		  DO;
		     TOKEN = DIVIDE;
		     RETURN;
		  END;
	       /* WE HAVE A COMMENT  */
	       S1, S2 = BYTE(' ');
	       DO WHILE S1 \= BYTE('*') ^ S2 \= BYTE('/');
		  IF S1 = BYTE('$') THEN
		     DO;  /* A CONTROL CHARACTER  */
			CONTROL(S2) = \ CONTROL(S2);
			IF S2 = BYTE('^') THEN
			   IF CONTROL(S2) THEN
			      MARGIN_CHOP = TEXT_LIMIT - CP + 1;
			   ELSE
			      MARGIN_CHOP = 0;
		     END;
		  S1 = S2;
		  CALL CHAR;
		  S2 = BYTE(TEXT, CP);
	       END;
	    END;
 
	    /*	CASE 7	*/
	    DO;      /*  SPECIAL CHARACTERS  */
	       TOKEN = TX(BYTE(TEXT));
	       CP = 1;
	       RETURN;
	    END;
 
	    /*	CASE 8	*/
	;   /*	NOT USED IN SKELETON (BUT USED IN XCOM)  */
 
	 END;	  /* OF CASE ON CHARTYPE  */
	 CP = CP + 1;  /* ADVANCE SCANNER AND RESUME SEARCH FOR TOKEN  */
      END;
   END SCAN;
 
 
 
 
  /*			   TIME AND DATE				 */
 
 
PRINT_TIME:
   PROCEDURE (MESSAGE, T);
      DECLARE MESSAGE CHARACTER, T FIXED;
      MESSAGE = MESSAGE ^^ T/360000 ^^ ':' ^^ T MOD 360000 / 6000 ^^ ':'
	 ^^ T MOD 6000 / 100 ^^ '.';
      T = T MOD 100;  /* DECIMAL FRACTION  */
      IF T < 10 THEN MESSAGE = MESSAGE ^^ '0';
      OUTPUT = MESSAGE ^^ T ^^ '.';
   END PRINT_TIME;
 
PRINT_DATE_AND_TIME:
   PROCEDURE (MESSAGE, D, T);
      DECLARE MESSAGE CHARACTER, (D, T, YEAR, DAY, M) FIXED;
      DECLARE MONTH(11) CHARACTER INITIAL ('JANUARY', 'FEBRUARY', 'MARCH',
	 'APRIL', 'MAY', 'JUNE', 'JULY', 'AUGUST', 'SEPTEMBER', 'OCTOBER',
	 'NOVEMBER', 'DECEMBER'),
      DAYS(12) FIXED INITIAL (0, 31, 60, 91, 121, 152, 182, 213, 244, 274,
	 305, 335, 366);
      YEAR = D/1000 + 1900;
      DAY = D MOD 1000;
      IF (YEAR & "3") \= 0 THEN IF DAY > 59 THEN DAY = DAY + 1; /* NOT LEAP YEAR*/
      M = 1;
      DO WHILE DAY > DAYS(M);  M = M + 1;  END;
      CALL PRINT_TIME(MESSAGE ^^ MONTH(M-1) ^^ X1 ^^ DAY-DAYS(M-1) ^^  ', '
	 ^^ YEAR ^^ '.	CLOCK TIME = ', T);
   END PRINT_DATE_AND_TIME;
 
  /*			   INITIALIZATION				      */
 
 
 
INITIALIZATION:
   PROCEDURE;
   DECLARE FILEN CHARACTER, EXT FIXED;
	OUTPUT(-2) = 'FILENAME: ';
	FILEN = INPUT(-1);
	IF FILEN = ' ' THEN FILEN = '';
	IF LENGTH(FILEN) = 0 THEN DO;
		FILENAME(0) = 'TTY:SKELTN.SKL';
		FILENAME(1) = 'DSK:SKELTN.LST';
		OUTPUT(-1) = 'INPUT PROGRAM FROM TTY:';
		END;

	ELSE	DO;
		EXT = 0;
		DO I = 0 TO LENGTH(FILEN)-1;
			IF BYTE(FILEN,I) = BYTE('.') THEN EXT = I;
			END;
		IF EXT = 0 THEN DO;
			FILENAME(0) = FILEN ^^ '.SKL';
			FILENAME(1) = FILEN ^^ '.LST';
			END;
		ELSE	DO;
			FILENAME(0) = FILEN;
			FILENAME(1) = SUBSTR(FILEN,0,EXT+1)^^'.LST'^^
				      SUBSTR(FILEN,EXT+4);
			END;
		END;
      EJECT_PAGE;
   CALL PRINT_DATE_AND_TIME ('   SYNTAX CHECK -- UNIVERSITY OF LOUISVILLE -- III VERSION ', DATE, TIME);
      DOUBLE_SPACE;
      CALL PRINT_DATE_AND_TIME ('TODAY IS ', DATE, TIME);
      DOUBLE_SPACE;
      DO I = 1 TO NT;
	 S = V(I);
	 IF S = '<NUMBER>' THEN NUMBER = I;  ELSE
	 IF S = '<IDENTIFIER>' THEN IDENT = I;	ELSE
	 IF S = '/' THEN DIVIDE = I;  ELSE
	 IF S = '_^_' THEN EOFILE = I;	ELSE
	 IF S = ';' THEN STOPIT(I) = TRUE;  ELSE
	 ;
      END;
      IF IDENT = NT THEN RESERVED_LIMIT = LENGTH(V(NT-1));
      ELSE RESERVED_LIMIT = LENGTH(V(NT));
      V(EOFILE) = 'EOF';
      STOPIT(EOFILE) = TRUE;
      CHARTYPE(BYTE(' ')) = 1;
      CHARTYPE(9) = 1;     /* ASCII TAB CHARACTER */
      CHARTYPE(0) = 1;		/* DO SAME FOR NULL, WHICH POPS UP */
      DO I = 0 TO 255;
	 NOT_LETTER_OR_DIGIT(I) = TRUE;
      END;
      DO I = 0 TO LENGTH(ALPHABET) - 1;
	 J = BYTE(ALPHABET, I);
	 TX(J) = I;
	 NOT_LETTER_OR_DIGIT(J) = FALSE;
	 CHARTYPE(J) = 4;
      END;
      DO I = 0 TO 9;
	 J = BYTE('0123456789', I);
	 NOT_LETTER_OR_DIGIT(J) = FALSE;
	 CHARTYPE(J) = 5;
      END;
      DO I = V_INDEX(0) TO V_INDEX(1) - 1;
	 J = BYTE(V(I));
	 TX(J) = I;
	 CHARTYPE(J) = 7;
      END;
      CHARTYPE(BYTE('/')) = 6;
      /* FIRST SET UP GLOBAL VARIABLES CONTROLLING SCAN, THEN CALL IT */
      CP = 0;  TEXT_LIMIT = -1;
      TEXT = '';
      CONTROL(BYTE('L')) = TRUE;
      CALL SCAN;
 
      /* INITIALIZE THE PARSE STACK */
      SP = 1;	 PARSE_STACK(SP) = EOFILE; 
 
   END INITIALIZATION;
 
 
 
 
 
 
DUMPIT:
   PROCEDURE;	 /* DUMP OUT THE STATISTICS COLLECTED DURING THIS RUN  */
      DOUBLE_SPACE;
      /*  PUT OUT THE ENTRY COUNT FOR IMPORTANT PROCEDURES */
 
      OUTPUT = 'STACKING DECISIONS= ' ^^ CALLCOUNT(1);
      OUTPUT = 'SCAN		  = ' ^^ CALLCOUNT(3);
      OUTPUT = 'FREE STRING AREA  = ' ^^ FREELIMIT - FREEBASE;
   END DUMPIT;
 
 
STACK_DUMP:
   PROCEDURE;
      DECLARE LINE CHARACTER;
      LINE = 'PARTIAL PARSE TO THIS POINT IS: ';
      DO I = 2 TO SP;
	 IF LENGTH(LINE) > 105 THEN
	    DO;
	       OUTPUT = LINE;
	       LINE = X4;
	    END;
	 LINE = LINE ^^ X1 ^^ V(PARSE_STACK(I));
      END;
      OUTPUT = LINE;
   END STACK_DUMP;
 
 
  /*		      THE SYNTHESIS ALGORITHM FOR XPL			   */
 
 
SYNTHESIZE:
PROCEDURE(PRODUCTION_NUMBER);
   DECLARE PRODUCTION_NUMBER FIXED;
 
   /*  THIS PROCEDURE IS RESPONSIBLE FOR THE SEMANTICS (CODE SYNTHESIS), IF
      ANY, OF THE SKELETON COMPILER.  ITS ARGUMENT IS THE NUMBER OF THE
      PRODUCTION WHICH WILL BE APPLIED IN THE PENDING REDUCTION.  THE GLOBAL
      VARIABLES MP AND SP POINT TO THE BOUNDS IN THE STACKS OF THE RIGHT PART
      OF THIS PRODUCTION.
       NORMALLY, THIS PROCEDURE WILL TAKE THE FORM OF A GIANT CASE STATEMENT
      ON PRODUCTION_NUMBER.  HOWEVER, THE SYNTAX CHECKER HAS SEMANTICS (THE
      TERMINATION OF CHECKING) ONLY FOR PRODUCTION 1.			  */
 
   IF PRODUCTION_NUMBER = 1 THEN
 
 /*  <PROGRAM>	::=  <STATEMENT LIST>	 */
   DO;
      IF MP \= 2 THEN  /* WE DIDN'T GET HERE LEGITIMATELY  */
	 DO;
	    CALL ERROR ('EOF AT INVALID POINT', 1);
	    CALL STACK_DUMP;
	 END;
      COMPILING = FALSE;
   END;
  ELSE DO;
	OUTPUT(-1)='SYNTHESIZE--PRODUCTION#: '^^PRODUCTION_NUMBER;
	OUTPUT(-1)='SYNTHESIZE--TOKEN IS: '^^V(TOKEN);
	OUTPUT(-1) = 'SYNTHESIZE--SP: '^^SP^^' MP: '^^MP^^' PARSE_STACK IS:';
	DO I = 1 TO SP;
	  OUTPUT(-1) = 'SYNTHESIZE--'^^I^^' '^^V(PARSE_STACK(I));
		END;
	OUTPUT(-1)=' ';
	END;
END SYNTHESIZE;
 
 
 
 
  /*		  SYNTACTIC PARSING FUNCTIONS				   */
 
 
RIGHT_CONFLICT:
   PROCEDURE (LEFT) BIT(1);
      DECLARE LEFT FIXED;
	DECLARE (BIT#,BYTE#,CHECK,CASE#) FIXED;
      /*  THIS PROCEDURE IS TRUE IF TOKEN IS NOT A LEGAL RIGHT CONTEXT OF LEFT*/
 /*    RETURN ("C0" & SHL(BYTE(C1(LEFT), SHR(TOKEN,2)), SHL(TOKEN,1)
	 & "06")) = 0;	*/
	BIT# = SHL(TOKEN,1);
	BYTE# = BIT# / 9;
	CHECK = BIT# MOD 9;
	IF CHECK \= 8 THEN  /* EXTRACT DECISION FROM A BYTE */
		CASE# = SHR(BYTE(C1(PARSE_STACK(SP)),BYTE#),7-CHECK)&"3";
	ELSE  /* EXTRACT DECISION FROM 2 BYTES (CROSSES BOUNDARY) */
	CASE# = SHL(BYTE(C1(PARSE_STACK(SP)),BYTE#)&1,1) +
               SHR(BYTE(C1(PARSE_STACK(SP)),BYTE#+1),8);
	RETURN CASE#=0;
   END RIGHT_CONFLICT;
 
 
RECOVER:
   PROCEDURE;
      /* IF THIS IS THE SECOND SUCCESSIVE CALL TO RECOVER, DISCARD ONE SYMBOL */
      IF \ FAILSOFT THEN CALL SCAN;
      FAILSOFT = FALSE;
      DO WHILE \ STOPIT(TOKEN);
	 CALL SCAN;  /* TO FIND SOMETHING SOLID IN THE TEXT  */
      END;
      DO WHILE RIGHT_CONFLICT (PARSE_STACK(SP));
	 IF SP > 2 THEN SP = SP - 1;  /* AND IN THE STACK  */
	 ELSE CALL SCAN;  /* BUT DON'T GO TOO FAR  */
      END;
      OUTPUT = 'RESUME:' ^^ SUBSTR(POINTER, TEXT_LIMIT-CP+MARGIN_CHOP+7);
   END RECOVER;
 
STACKING:
   PROCEDURE BIT(1);  /* STACKING DECISION FUNCTION */
	DECLARE (BIT#,BYTE#,CHECK,CASE#) FIXED;
      CALLCOUNT(1) = CALLCOUNT(1) + 1;
      DO FOREVER;    /* UNTIL RETURN  */
      /* NOTE: THE DEC-10 IMPLEMENTATION HAS 9-BIT BYTES */
      BIT# = SHL(TOKEN,1);	/* (TOKEN * 2) */
      BYTE# = BIT#/9;
      CHECK = BIT# MOD 9;
      IF CHECK \= 8 THEN  /* EXTRACT DECISION FROM A BYTE */
         CASE# = SHR(BYTE(C1(PARSE_STACK(SP)),BYTE#),7-CHECK)&"3";
      ELSE  /* EXTRACT DECISION FROM 2 BYTES (CROSSES BOUNDARY) */
         CASE# = SHL(BYTE(C1(PARSE_STACK(SP)),BYTE#)&1,1) +
               SHR(BYTE(C1(PARSE_STACK(SP)),BYTE#+1),8);
      DO CASE CASE#;
 
	    /*	CASE 0	*/
	    DO;    /* ILLEGAL SYMBOL PAIR  */
	       CALL ERROR('ILLEGAL SYMBOL PAIR: ' ^^ V(PARSE_STACK(SP)) ^^ X1 ^^
		  V(TOKEN), 1);
	       CALL STACK_DUMP;
	       CALL RECOVER;
	    END;
 
	/* CASE 1 */
	DO;
	    RETURN TRUE;      /*  STACK TOKEN  */
	    END;
	    /*	CASE 2	*/
	    DO;
	    RETURN FALSE;     /* DON'T STACK IT YET  */
	    END;
	    /*	CASE 3	*/
 
	    DO;      /* MUST CHECK TRIPLES  */
	       J = SHL(PARSE_STACK(SP-1)&"FFFF",16)
		 + SHL(PARSE_STACK(SP)&"FFFFFF", 8) + TOKEN;
	       I = -1;	K = NC1TRIPLES + 1;  /* BINARY SEARCH OF TRIPLES  */
	       DO WHILE I + 1 < K;
		  L = SHR(I+K, 1);
		  IF C1TRIPLES(L) > J THEN K = L;
		  ELSE IF C1TRIPLES(L) < J THEN I = L;
		  ELSE RETURN TRUE;  /* IT IS A VALID TRIPLE  */
	       END;
	       RETURN FALSE;
	    END;
 
	 END;	 /* OF DO CASE	*/
      END;   /*  OF DO FOREVER */
   END STACKING;
 
PR_OK:
   PROCEDURE(PRD) BIT(1);
      /* DECISION PROCEDURE FOR CONTEXT CHECK OF EQUAL OR IMBEDDED RIGHT PARTS*/
      DECLARE (H, I, J, PRD) FIXED;
      DO CASE CONTEXT_CASE(PRD);
 
	 /*  CASE 0 -- NO CHECK REQUIRED  */
 
	 RETURN TRUE;
 
	 /*  CASE 1 -- RIGHT CONTEXT CHECK  */
 
	 RETURN \ RIGHT_CONFLICT (HDTB(PRD));
 
	 /*  CASE 2 -- LEFT CONTEXT CHECK  */
 
	 DO;
	    H = HDTB(PRD) - NT;
	    I = PARSE_STACK(SP - PRLENGTH(PRD));
	    DO J = LEFT_INDEX(H-1) TO LEFT_INDEX(H) - 1;
	       IF LEFT_CONTEXT(J) = I THEN RETURN TRUE;
	    END;
	    RETURN FALSE;
	 END;
 
	 /*  CASE 3 -- CHECK TRIPLES  */
 
	 DO;
	    H = HDTB(PRD) - NT;
	    I = SHL(PARSE_STACK(SP - PRLENGTH(PRD)), 8) + TOKEN;
	    DO J = TRIPLE_INDEX(H-1) TO TRIPLE_INDEX(H) - 1;
	       IF CONTEXT_TRIPLE(J) = I THEN RETURN TRUE;
	    END;
	    RETURN FALSE;
	 END;
 
      END;  /* OF DO CASE  */
   END PR_OK;
 
 
  /*			 ANALYSIS ALGORITHM				     */
 
 
 
REDUCE:
   PROCEDURE;
      DECLARE (I, J, PRD) FIXED;
      /* PACK STACK TOP INTO ONE WORD */
      DO I = SP - 4 TO SP - 1;
	 J = SHL(J, 8) + PARSE_STACK(I);
      END;
 
      DO PRD = PR_INDEX(PARSE_STACK(SP)-1) TO PR_INDEX(PARSE_STACK(SP)) - 1;
	 IF (PRMASK(PRLENGTH(PRD)) & J) = PRTB(PRD) THEN
	    IF PR_OK(PRD) THEN
	    DO;  /* AN ALLOWED REDUCTION */
	       MP = SP - PRLENGTH(PRD) + 1; MPP1 = MP + 1;
	       CALL SYNTHESIZE(PRDTB(PRD));
	       SP = MP;
	       PARSE_STACK(SP) = HDTB(PRD);
	       RETURN;
	    END;
      END;
 
      /* LOOK UP HAS FAILED, ERROR CONDITION */
      CALL ERROR('NO PRODUCTION IS APPLICABLE',1);
      CALL STACK_DUMP;
      FAILSOFT = FALSE;
      CALL RECOVER;
   END REDUCE;
 
COMPILATION_LOOP:
   PROCEDURE;
 
      COMPILING = TRUE;
      DO WHILE COMPILING;     /* ONCE AROUND FOR EACH PRODUCTION (REDUCTION)  */
	 DO WHILE STACKING;
	    SP = SP + 1;
	    IF SP = STACKSIZE THEN
	       DO;
		  CALL ERROR ('STACK OVERFLOW *** CHECKING ABORTED ***', 2);
		  RETURN;   /* THUS ABORTING CHECKING */
	       END;
	    PARSE_STACK(SP) = TOKEN;
	    VAR(SP) = BCD;
	    FIXV(SP) = NUMBER_VALUE;
	    CALL SCAN;
	 END;
 
	 CALL REDUCE;
      END;     /* OF DO WHILE COMPILING  */
   END COMPILATION_LOOP;
 
 
 
 
PRINT_SUMMARY:
   PROCEDURE;
      DECLARE I FIXED;
      CALL PRINT_DATE_AND_TIME ('END OF CHECKING ', DATE, TIME);
      OUTPUT = '';
      OUTPUT = CARD_COUNT ^^ ' CARDS WERE CHECKED.';
      IF ERROR_COUNT = 0 THEN OUTPUT = 'NO ERRORS WERE DETECTED.';
      ELSE IF ERROR_COUNT > 1 THEN
	 OUTPUT = ERROR_COUNT ^^ ' ERRORS (' ^^ SEVERE_ERRORS
	    ^^ ' SEVERE) WERE DETECTED.';
      ELSE IF SEVERE_ERRORS = 1 THEN OUTPUT = 'ONE SEVERE ERROR WAS DETECTED.';
	 ELSE OUTPUT = 'ONE ERROR WAS DETECTED.';
      IF PREVIOUS_ERROR > 0 THEN
	 OUTPUT = 'THE LAST DETECTED ERROR WAS ON LINE ' ^^ PREVIOUS_ERROR
	    ^^ PERIOD;
      IF CONTROL(BYTE('D')) THEN CALL DUMPIT;
      DOUBLE_SPACE;
      CLOCK(3) = TIME;
      DO I = 1 TO 3;   /* WATCH OUT FOR MIDNIGHT */
	 IF CLOCK(I) < CLOCK(I-1) THEN CLOCK(I) = CLOCK(I) +  8640000;
      END;
      CALL PRINT_TIME ('TOTAL TIME IN CHECKER	 ', CLOCK(3) - CLOCK(0));
      CALL PRINT_TIME ('SET UP TIME		 ', CLOCK(1) - CLOCK(0));
      CALL PRINT_TIME ('ACTUAL CHECKING TIME	 ', CLOCK(2) - CLOCK(1));
      CALL PRINT_TIME ('CLEAN-UP TIME AT END	 ', CLOCK(3) - CLOCK(2));
      IF CLOCK(2) > CLOCK(1) THEN   /* WATCH OUT FOR CLOCK BEING OFF */
      OUTPUT = 'CHECKING RATE: ' ^^ 6000*CARD_COUNT/(CLOCK(2)-CLOCK(1))
	 ^^ ' CARDS PER MINUTE.';
   END PRINT_SUMMARY;
 
MAIN_PROCEDURE:
   PROCEDURE;
      CLOCK(0) = TIME;	/* KEEP TRACK OF TIME IN EXECUTION */
      CALL INITIALIZATION;
	OUTPUT(-1)='MAIN_PROCEDURE--INITIALIZATION FINISHED';
 
      CLOCK(1) = TIME;
 
      CALL COMPILATION_LOOP;
	OUTPUT(-1) = 'MAIN_PROCEDURE--COMPILATION_LOOP FINISHED';
 
      CLOCK(2) = TIME;
 
      /* CLOCK(3) GETS SET IN PRINT_SUMMARY */
      CALL PRINT_SUMMARY;
 
   END MAIN_PROCEDURE;
 
 
CALL MAIN_PROCEDURE;
 
EOF EOF EOF