home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
SIMTEL
/
CPMUG
/
CPMUG030.ARK
/
BASPAR.PLM
< prev
next >
Wrap
Text File
|
1984-04-29
|
14KB
|
313 lines
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 */