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