mirror of
https://github.com/SEPPDROID/Digital-Research-Source-Code.git
synced 2025-10-22 07:54:25 +00:00
313 lines
13 KiB
Plaintext
313 lines
13 KiB
Plaintext
BASPAR:
|
|
DO;
|
|
/* PARSER MODULE FOR THE BASIC - E COMPILER */
|
|
$INCLUDE (:F1:BASCOM.LIT)
|
|
|
|
/* GLOBAL PROCEDURES */
|
|
PRINT: PROCEDURE(A) EXTERNAL;
|
|
DECLARE A ADDRESS;
|
|
END PRINT;
|
|
|
|
CRLF: PROCEDURE EXTERNAL;
|
|
END CRLF;
|
|
|
|
IN$SYMTBL: PROCEDURE EXTERNAL;
|
|
END IN$SYMTBL;
|
|
|
|
IN$SCANNER: PROCEDURE EXTERNAL;
|
|
END IN$SCANNER;
|
|
|
|
IN$SYN: PROCEDURE EXTERNAL;
|
|
END IN$SYN;
|
|
|
|
|
|
SCANNER: PROCEDURE EXTERNAL;
|
|
END SCANNER;
|
|
|
|
SYNTHESIZE: PROCEDURE(PROD) EXTERNAL;
|
|
DECLARE PROD BYTE;
|
|
END SYNTHESIZE;
|
|
|
|
ERROR: PROCEDURE(ERR) EXTERNAL;
|
|
DECLARE ERR ADDRESS;
|
|
END ERROR;
|
|
|
|
|
|
/* GLOBAL VARIABLES */
|
|
DECLARE
|
|
/* SCANNER PARAMETERS USED IN PARSING */
|
|
TOKEN BYTE EXTERNAL,
|
|
SUBTYPE BYTE EXTERNAL,
|
|
HASHCODE BYTE EXTERNAL,
|
|
ACCLEN BYTE EXTERNAL,
|
|
ACCUM(IDENTSIZE) BYTE EXTERNAL,
|
|
|
|
/* PASS CONTROLS */
|
|
LISTSOURCE BYTE EXTERNAL,
|
|
(PASS1, PASS2) BYTE EXTERNAL;
|
|
|
|
/* LOCAL VARIABLES AND PROCEDURES */
|
|
INITIALIZE: PROCEDURE;
|
|
CALL IN$SYMTBL;
|
|
CALL IN$SYN;
|
|
CALL IN$SCANNER;
|
|
END INITIALIZE;
|
|
|
|
DECLARE
|
|
I INDEXSIZE,
|
|
J INDEXSIZE,
|
|
K INDEXSIZE,
|
|
INDEX BYTE;
|
|
|
|
|
|
GETIN1: PROCEDURE INDEXSIZE;
|
|
RETURN INDEX1(STATE);
|
|
END GETIN1;
|
|
|
|
|
|
GETIN2: PROCEDURE INDEXSIZE;
|
|
RETURN INDEX2(STATE);
|
|
END GETIN2;
|
|
|
|
|
|
INCSP: PROCEDURE;
|
|
IF (SP := SP + 1) = LENGTH(STATESTACK) THEN
|
|
CALL ERROR('SO');
|
|
RETURN;
|
|
END INCSP;
|
|
|
|
|
|
LOOKAHEAD: PROCEDURE;
|
|
IF NOLOOK THEN
|
|
DO;
|
|
CALL SCANNER;
|
|
NOLOOK = FALSE;
|
|
END;
|
|
RETURN;
|
|
END LOOKAHEAD;
|
|
SET$VARC$I: PROCEDURE(I);
|
|
DECLARE I BYTE;
|
|
/* SET VARC AND INCREMENT VARINDEX */
|
|
VARC(VARINDEX) = I;
|
|
IF (VARINDEX := VARINDEX + 1) > LENGTH(VARC) THEN
|
|
CALL ERROR('VO');
|
|
END SET$VARC$I;
|
|
|
|
DECLARE /* PARSE TABLES AND RELATED VARIABLES */
|
|
EXTERN LITERALLY 'EXTERNAL',
|
|
COMPILING BYTE EXTERN,
|
|
STATE STATESIZE EXTERN, /* CURRENT STATE OF FSM */
|
|
STATESTACK(PSTACKSIZE) STATESIZE EXTERN,/* HOLDS STATES DURING PARSE */
|
|
HASH(PSTACKSIZE) BYTE EXTERN, /* HASH CODE OF CURRENT SYMBOL */
|
|
SYMLOC(PSTACKSIZE) ADDRESS EXTERN, /* CURRENT SYMBOL LOCATION */
|
|
SRLOC(PSTACKSIZE) ADDRESS EXTERN,
|
|
VAR(PSTACKSIZE) BYTE EXTERN, /* INDEX TO VARC */
|
|
TYPE(PSTACKSIZE) BYTE EXTERN, /* TYPE OF CURRENT SYMBOL */
|
|
STYPE(PSTACKSIZE) BYTE EXTERN, /* SUBTYPE OF CURRENT SYMBOL */
|
|
VARC(VARCSIZE) BYTE EXTERN, /* CHARACTERS FOR CURRENT SYMBOL */
|
|
VARINDEX BYTE EXTERN, /* CURRENT TOP OF VARC */
|
|
SP BYTE EXTERN, /* CURRENT TOP OF STACKS */
|
|
MP BYTE EXTERN, /* CURRENT "FRONT" OF PRODUCTIONS */
|
|
MPP1 BYTE EXTERN, /* MP + 1 */
|
|
NOLOOK BYTE EXTERN; /* TRUE IF NOT LOOKED-AHEAD */
|
|
|
|
DECLARE MAXRNO LITERALLY '120',/* MAX READ COUNT */
|
|
MAXLNO LITERALLY '175',/* MAX LOOK COUNT */
|
|
MAXPNO LITERALLY '189',/* MAX PUSH COUNT */
|
|
MAXSNO LITERALLY '341',/* MAX STATE COUNT */
|
|
STARTS LITERALLY '121',/* START STATE */
|
|
PRODNO LITERALLY '152';/* NUMBER OF PRODUCTIONS */
|
|
DECLARE READ1(*) BYTE
|
|
DATA(0,49,10,13,2,49,50,52,53,54,49,13,22,32,2,3,7,27,30
|
|
,49,50,52,53,54,2,3,7,30,49,50,52,53,54,54,52,12,52,2,3,7,49,50,52
|
|
,53,54,12,52,49,49,50,2,3,7,12,30,49,50,52,53,54,2,2,2,9,5,9,49,4,8
|
|
,49,16,20,28,29,31,35,36,37,38,40,42,43,44,45,46,48,49,51,52,49,14,6
|
|
,22,13,52,9,52,9,23,9,21,33,41,16,21,33,36,43,9,21,33,5,9,21,33,5,21
|
|
,33,5,9,21,33,5,9,21,33,6,9,21,33,21,33,39,21,33,41,5,21,33,6,21,33
|
|
,9,6,9,16,17,20,25,26,27,28,29,31,35,36,37,38,40,42,43,44,45,46,48
|
|
,51,52,2,16,20,28,29,31,35,36,37,38,40,42,43,44,45,46,48,51,52,52,13
|
|
,24,11,34,9,2,1,3,7,10,13,15,18,19,3,7,9,0);
|
|
DECLARE LOOK1(*) BYTE
|
|
DATA(0,49,0,10,13,0,13,0,11,23,34,0,52,0,12,52,0,49,50,0,6
|
|
,9,11,23,34,0,2,0,2,0,9,0,4,8,0,4,8,0,4,8,0,4,8,0,4,8,0,11,23,34,0
|
|
,14,0,14,0,14,0,9,0,9,0,9,0,9,0,9,0,21,33,0,21,33,0,21,33,0,21,33,0
|
|
,21,33,39,0,21,33,0,21,33,0,21,33,0,23,0,21,33,0,21,33,0,9,0,9,0,6,9
|
|
,0,52,0,11,23,0,11,23,34,0,2,0,11,23,0,52,0,24,0,24,0,11,0,23,0,11,0
|
|
,9,0,2,0,1,3,7,10,13,15,18,19,0,3,7,0,9,0);
|
|
DECLARE APPLY1(*) BYTE
|
|
DATA(0,0,0,0,55,105,0,19,0,0,32,47,0,0,3,4,12,14,16,17,20
|
|
,21,22,26,27,34,36,38,40,98,100,102,103,114,116,0,0,46,0,28,0,33,0
|
|
,63,0,5,6,8,9,0,7,10,0,23,0,13,19,32,35,47,55,99,101,105,106,0,0,0,0
|
|
,0,39,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,11,0,0,0,0,0,0,0,99
|
|
,106,0,0,0,0,0,40,0,0,0,0,0,0,62,0,0,74,0,74,0,0,0,0,0,0,0,0,0);
|
|
DECLARE READ2(*) ADDRESS DATA
|
|
(0,191,264,260,3,255,256,129,254,253,326,258,329,331,3
|
|
,5,8,31,33,255,256,129,254,253,3,5,8,33,255,256,129,254,253,279,42
|
|
,21,129,3,5,8,255,256,129,254,253,20,129,273,255,256,3,5,8,20,33,255
|
|
,256,129,254,253,247,294,4,335,280,283,320,7,10,327,24,26,268,32,34
|
|
,285,328,125,126,338,38,330,127,128,337,340,275,341,129,325,23,302
|
|
,27,220,130,17,131,13,190,14,223,224,277,24,223,224,328,330,12,223
|
|
,224,246,248,223,224,244,223,224,249,252,223,224,293,295,223,224,316
|
|
,16,223,224,223,224,36,223,224,37,288,223,224,317,223,224,15,318,319
|
|
,24,25,26,29,30,339,268,32,34,285,328,125,126,338,38,330,127,128,337
|
|
,340,341,129,251,24,26,268,32,34,285,328,125,126,338,38,330,127,128
|
|
,337,340,341,129,45,22,28,124,276,286,282,122,6,9,123,257,259,261
|
|
,265,6,9,11,0);
|
|
DECLARE LOOK2(*) ADDRESS DATA
|
|
(0,1,176,2,2,263,18,262,177,177,177,19,334,333,35,35
|
|
,178,39,39,179,180,180,180,180,180,40,41,245,43,181,44,332,49,49,231
|
|
,50,50,234,51,51,235,52,52,232,53,53,233,182,182,182,55,57,236,58
|
|
,237,59,238,66,308,68,300,69,299,70,301,72,296,76,76,297,77,77,309
|
|
,78,78,219,84,84,312,85,85,85,183,87,87,336,88,88,298,89,89,310,278
|
|
,91,93,93,313,94,94,269,95,321,96,322,97,97,184,99,185,186,186,101
|
|
,314,314,314,102,104,250,187,187,105,106,188,109,221,110,222,111,193
|
|
,274,112,113,272,115,284,117,189,118,118,118,118,118,118,118,118,229
|
|
,119,119,230,120,290);
|
|
DECLARE APPLY2(*) ADDRESS DATA
|
|
(0,0,161,71,169,170,168,199,198,200,218,267,201,98,80
|
|
,90,151,152,92,155,83,86,154,74,150,75,156,146,147,148,149,153,82,79
|
|
,81,73,46,167,166,226,225,228,227,174,173,133,135,134,136,132,139
|
|
,140,138,240,239,305,64,64,304,64,64,304,64,64,304,241,114,243,116
|
|
,163,60,242,63,202,61,47,266,194,271,164,137,197,172,108,107,204,65
|
|
,171,287,196,175,292,291,103,205,145,206,210,165,143,144,142,207,159
|
|
,141,307,100,160,162,208,213,56,62,158,157,209,323,48,324,54,203,67
|
|
,216,212,211,195,214,215);
|
|
DECLARE INDEX1(*) ADDRESS DATA
|
|
(0,1,2,24,24,4,4,4,4,4,4,34,24,36,24,10,24,24,11,168
|
|
,24,24,24,4,12,14,24,24,24,33,34,35,36,37,24,45,24,47,24,48,50,60,61
|
|
,62,63,64,24,36,66,67,67,67,67,67,69,70,89,90,90,90,91,92,89,37,93
|
|
,94,95,96,97,97,97,98,99,100,103,108,100,100,100,111,115,118,122,126
|
|
,100,130,133,100,100,100,136,100,139,100,100,142,142,143,24,36,24
|
|
,145,24,24,167,168,36,186,187,188,188,189,189,189,24,191,24,192,193
|
|
,201,203,1,3,6,8,12,14,17,20,26,28,30,32,35,38,41,44,47,51,53,55,57
|
|
,59,61,63,65,67,70,73,76,79,83,86,89,92,94,97,100,102,104,107,109
|
|
,112,116,118,121,123,125,127,129,131,133,135,137,146,149,192,217,306
|
|
,303,311,289,217,270,315,306,217,217,306,281,1,2,2,3,3,3,3,3,4,4,7,7
|
|
,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,9,10,13,14,14,36,36,37,37,39,39,41
|
|
,41,43,43,43,43,43,45,45,45,50,50,53,53,53,53,55,55,66,66,67,67,68
|
|
,68,69,69,70,70,72,72,72,72,72,72,72,72,72,73,74,75,76,76,77,77,77
|
|
,78,78,79,80,81,82,83,83,84,84,85,86,86,87,88,88,89,90,90,91,93,93
|
|
,94,95,95,96,96,97,98,98,99,99,99,102,102,103,103,103,104,104,105
|
|
,105,106,106,108,108,109,110,110,111,112,113,113,115,116,116,118,118
|
|
,120,120,121,121,122,123,124,125,126,127);
|
|
DECLARE INDEX2(*) BYTE
|
|
DATA(0,1,2,9,9,6,6,6,6,6,6,1,9,1,9,1,9,9,1,18,9,9,9,6,2
|
|
,10,9,9,9,1,1,1,1,8,9,2,9,1,9,2,10,1,1,1,1,2,9,1,1,2,2,2,2,2,1,19,1
|
|
,1,1,1,1,1,1,8,1,1,1,1,1,1,1,1,1,3,5,3,2,2,2,4,3,4,4,4,2,3,3,2,2,2,3
|
|
,2,3,2,2,1,1,2,9,1,9,22,9,9,1,18,1,1,1,1,1,1,2,1,9,1,9,1,8,2,1,2,3,2
|
|
,4,2,3,3,6,2,2,2,3,3,3,3,3,4,2,2,2,2,2,2,2,2,3,3,3,3,4,3,3,3,2,3,3,2
|
|
,2,3,2,3,4,2,3,2,2,2,2,2,2,2,2,9,3,2,1,19,35,39,40,43,55,85,97,99
|
|
,101,105,106,117,2,0,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,1,1,1,0,2,0,0,0,2,0,1,0,2,0,2,2,1,1,0,2,2,0,2,0,0,0,2,0,2,1,2,2
|
|
,0,1,2,0,0,0,0,0,1,0,1,0,0,0,1,0,3,1,0,1,0,0,1,5,1,1,2,2,3,1,2,0,0,2
|
|
,1,0,2,1,2,0,1,0,2,2,1,2,1,0,2,2,1,2,1,0,0,2,0,2,2,0,2,0,0,2,0,0,2,4
|
|
,0,0,1,1,1,2,2,0,2,1,0,1,0,1,1,0,0,2,3,0,0,0,0,0);
|
|
|
|
/*
|
|
*********************************************************
|
|
* *
|
|
* EXECUTION OF THE COMPILER BEGINS HERE *
|
|
* *
|
|
* THE OUTPUT FILE IS CREATED AND THE *
|
|
* SYMBOLTABLE, SYNTHESIZE AND SCANNER *
|
|
* ARE INITIALIZED. THEN THE PARSER *
|
|
* BEGINS PROCESSING THE SOURCE PROGRAM. *
|
|
* PROCESSING CONTINUES UNTIL AN END *
|
|
* STATEMENT IS INCOUNTERED OR UNTIL THE *
|
|
* END OF THE SOURCE FILE IS DETECTED. *
|
|
* AT THIS TIME THE THREE MAIN PROCEDURES *
|
|
* ARE INITIALIZED FOR PASS 2 AND THE *
|
|
* PARSER PROCESSES THE SOURCE FILE A *
|
|
* SECOND TIME. AT THE END OF EACH STATE- *
|
|
* MENT (WHICH TO THE PARSER IS A PROGRAM) *
|
|
* AND IF AN ERROR IS DETECTED THE PARSER *
|
|
* VARIABLES ARE REINITIALIZED BY SETTING *
|
|
* COMPILING FALSE. *
|
|
* *
|
|
*********************************************************
|
|
*/
|
|
|
|
CALL PRINT(.('BASIC-E COMPILER VER 2.1$'));
|
|
CALL CRLF;
|
|
CALL INITIALIZE; /* INITIALIZE MAJOR SYSTEMS PRIOR TO PARSING */
|
|
|
|
DO FOREVER; /* THIS LOOP CONTROLS THE 2 PASSES OF THE COMPILER */
|
|
DO WHILE (PASS1 OR PASS2);/* THIS LOOP REINITIALIZES ON ERR OR OOC */
|
|
/* INITIALIZE VARIABLES */
|
|
COMPILING,NOLOOK=TRUE; STATE=STARTS;
|
|
SP=255;
|
|
VARINDEX, VAR(0) = 0;
|
|
|
|
DO WHILE COMPILING;
|
|
IF STATE <= MAXRNO THEN /* READ STATE */
|
|
DO;
|
|
CALL INCSP;
|
|
STATESTACK(SP) = STATE;
|
|
I = GETIN1;
|
|
CALL LOOKAHEAD;
|
|
J = I + GETIN2 - 1;
|
|
DO I = I TO J;
|
|
IF READ1(I) = TOKEN THEN /* SAVE TOKEN */
|
|
DO;
|
|
VAR(SP) = VARINDEX;
|
|
DO INDEX = 0 TO ACCLEN;
|
|
CALL SET$VARC$I(ACCUM(INDEX));
|
|
END;
|
|
HASH(SP) = HASHCODE;
|
|
STYPE(SP) = SUBTYPE;
|
|
STATE = READ2(I);
|
|
NOLOOK = TRUE;
|
|
I = J;
|
|
END;
|
|
ELSE
|
|
IF I = J THEN
|
|
CALL ERROR('NP');
|
|
END;
|
|
END;
|
|
|
|
ELSE
|
|
IF STATE > MAXPNO THEN /* APPLY PRODUCTION STATE */
|
|
DO;
|
|
MP = SP - GETIN2;
|
|
MPP1 = MP + 1;
|
|
CALL SYNTHESIZE(STATE - MAXPNO);
|
|
IF COMPILING THEN
|
|
DO;
|
|
SP = MP;
|
|
I = GETIN1;
|
|
VARINDEX = VAR(SP);
|
|
J = STATESTACK(SP);
|
|
DO WHILE (K := APPLY1(I)) <> 0
|
|
AND J <> K;
|
|
I = I + 1;
|
|
END;
|
|
IF(STATE := APPLY2(I)) = 0 THEN
|
|
COMPILING = FALSE;
|
|
END;
|
|
END;
|
|
ELSE
|
|
IF STATE<= MAXLNO THEN /* LOOKAHEAD STATE */
|
|
DO;
|
|
I = GETIN1;
|
|
CALL LOOKAHEAD;
|
|
DO WHILE (K := LOOK1(I)) <> 0 AND
|
|
TOKEN <> K;
|
|
I = I + 1;
|
|
END;
|
|
STATE = LOOK2(I);
|
|
END;
|
|
ELSE /* PUSH STATE */
|
|
DO;
|
|
CALL INCSP;
|
|
STATESTACK(SP) = GETIN2;
|
|
STATE = GETIN1;
|
|
END;
|
|
END; /* OF WHILE COMPILING */
|
|
END; /* OF WHILE PASS1 OR PASS2 */
|
|
|
|
LISTSOURCE = TRUE;
|
|
CALL INITIALIZE;
|
|
PASS2 = TRUE;
|
|
END; /* OF DO FOREVER */
|
|
END; /* OF PARSER MODULE */
|