Subversion Repositories Kolibri OS

Rev

Rev 7693 | Go to most recent revision | Blame | Last modification | View Log | Download | RSS feed

  1. (*
  2.     BSD 2-Clause License
  3.  
  4.     Copyright (c) 2018-2019, Anton Krotov
  5.     All rights reserved.
  6. *)
  7.  
  8. MODULE PARS;
  9.  
  10. IMPORT PROG, SCAN, ARITH, STRINGS, ERRORS, LISTS, IL, CONSOLE, PATHS, UTILS, C := COLLECTIONS, mConst := CONSTANTS;
  11.  
  12.  
  13. CONST
  14.  
  15.     eCONST*   =  1;  eTYPE*   =  2;  eVAR*     =  3;  eEXPR*    =  4;
  16.     eVREC*    =  5;  ePROC*   =  6;  eVPAR*    =  7;  ePARAM*   =  8;
  17.     eSTPROC*  =  9;  eSTFUNC* = 10;  eSYSFUNC* = 11;  eSYSPROC* = 12;
  18.     eIMP*     = 13;
  19.  
  20.  
  21. TYPE
  22.  
  23.     PATH* = PATHS.PATH;
  24.  
  25.     PARSER* = POINTER TO rPARSER;
  26.  
  27.     POSITION* = RECORD (SCAN.POSITION)
  28.  
  29.         parser*: PARSER
  30.  
  31.     END;
  32.  
  33.     EXPR* = RECORD
  34.  
  35.         obj*:         INTEGER;
  36.         type*:        PROG.TYPE_;
  37.         value*:       ARITH.VALUE;
  38.         stproc*:      INTEGER;
  39.         readOnly*:    BOOLEAN;
  40.         ident*:       PROG.IDENT
  41.  
  42.     END;
  43.  
  44.     STATPROC  = PROCEDURE (parser: PARSER);
  45.     EXPRPROC  = PROCEDURE (parser: PARSER; VAR e: EXPR);
  46.     RETPROC   = PROCEDURE (parser: PARSER; e: EXPR; t: PROG.TYPE_; pos: POSITION): BOOLEAN;
  47.  
  48.     rPARSER = RECORD (C.ITEM)
  49.  
  50.         fname*:      PATH;
  51.         path:        PATH;
  52.         lib_path:    PATH;
  53.         ext:         PATH;
  54.         modname:     PATH;
  55.         scanner:     SCAN.SCANNER;
  56.         lex*:        SCAN.LEX;
  57.         sym*:        INTEGER;
  58.         unit*:       PROG.UNIT;
  59.         constexp*:   BOOLEAN;
  60.         main*:       BOOLEAN;
  61.  
  62.         open*:       PROCEDURE (parser: PARSER; modname: ARRAY OF CHAR): BOOLEAN;
  63.         parse*:      PROCEDURE (parser: PARSER);
  64.         StatSeq*:    STATPROC;
  65.         expression*: EXPRPROC;
  66.         designator*: EXPRPROC;
  67.         chkreturn:   RETPROC;
  68.  
  69.         create*:     PROCEDURE (path, lib_path: PATH; StatSeq: STATPROC; expression, designator: EXPRPROC; chkreturn: RETPROC): PARSER
  70.  
  71.     END;
  72.  
  73.  
  74. VAR
  75.  
  76.     program*: PROG.PROGRAM;
  77.  
  78.     parsers: C.COLLECTION;
  79.  
  80.     lines*: INTEGER;
  81.  
  82.  
  83. PROCEDURE destroy* (VAR parser: PARSER);
  84. BEGIN
  85.     IF parser.scanner # NIL THEN
  86.         SCAN.close(parser.scanner)
  87.     END;
  88.  
  89.     C.push(parsers, parser);
  90.     parser := NIL
  91. END destroy;
  92.  
  93.  
  94. PROCEDURE getpos (parser: PARSER; VAR pos: POSITION);
  95. BEGIN
  96.     pos.line   := parser.lex.pos.line;
  97.     pos.col    := parser.lex.pos.col;
  98.     pos.parser := parser
  99. END getpos;
  100.  
  101.  
  102. PROCEDURE error* (pos: POSITION; errno: INTEGER);
  103. BEGIN
  104.     ERRORS.ErrorMsg(pos.parser.fname, pos.line, pos.col, errno)
  105. END error;
  106.  
  107.  
  108. PROCEDURE check* (condition: BOOLEAN; pos: POSITION; errno: INTEGER);
  109. BEGIN
  110.     IF ~condition THEN
  111.         error(pos, errno)
  112.     END
  113. END check;
  114.  
  115.  
  116. PROCEDURE check1* (condition: BOOLEAN; parser: PARSER; errno: INTEGER);
  117. VAR
  118.     pos: POSITION;
  119.  
  120. BEGIN
  121.     IF ~condition THEN
  122.         getpos(parser, pos);
  123.         error(pos, errno)
  124.     END
  125. END check1;
  126.  
  127.  
  128. PROCEDURE Next* (parser: PARSER);
  129. VAR
  130.     errno: INTEGER;
  131.  
  132. BEGIN
  133.     SCAN.Next(parser.scanner, parser.lex);
  134.     errno := parser.lex.error;
  135.     IF (errno = 0) & (program.target.sys = mConst.Target_iMSP430) THEN
  136.         IF parser.lex.sym = SCAN.lxFLOAT THEN
  137.             errno := -SCAN.lxERROR13
  138.         ELSIF (parser.lex.sym = SCAN.lxCHAR) & (parser.lex.value.typ = ARITH.tWCHAR) THEN
  139.             errno := -SCAN.lxERROR10
  140.         END
  141.     END;
  142.  
  143.     IF errno # 0 THEN
  144.         check1(FALSE, parser, errno)
  145.     END;
  146.     parser.sym := parser.lex.sym
  147. END Next;
  148.  
  149.  
  150. PROCEDURE NextPos (parser: PARSER; VAR pos: POSITION);
  151. BEGIN
  152.     Next(parser);
  153.     getpos(parser, pos)
  154. END NextPos;
  155.  
  156.  
  157. PROCEDURE checklex* (parser: PARSER; sym: INTEGER);
  158. VAR
  159.     err: INTEGER;
  160.  
  161. BEGIN
  162.  
  163.     IF parser.sym # sym THEN
  164.  
  165.         CASE sym OF
  166.         |SCAN.lxCOMMA:   err := 65
  167.         |SCAN.lxRROUND:  err := 33
  168.         |SCAN.lxPOINT:   err := 26
  169.         |SCAN.lxIDENT:   err := 22
  170.         |SCAN.lxRSQUARE: err := 71
  171.         |SCAN.lxRCURLY:  err := 35
  172.         |SCAN.lxUNDEF:   err := 34
  173.         |SCAN.lxTHEN:    err := 88
  174.         |SCAN.lxEND:     err := 27
  175.         |SCAN.lxDO:      err := 89
  176.         |SCAN.lxUNTIL:   err := 90
  177.         |SCAN.lxCOLON:   err := 53
  178.         |SCAN.lxOF:      err := 67
  179.         |SCAN.lxASSIGN:  err := 96
  180.         |SCAN.lxTO:      err := 57
  181.         |SCAN.lxLROUND:  err := 64
  182.         |SCAN.lxEQ:      err := 32
  183.         |SCAN.lxSEMI:    err := 24
  184.         |SCAN.lxRETURN:  err := 38
  185.         |SCAN.lxMODULE:  err := 21
  186.         |SCAN.lxSTRING:  err := 66
  187.         END;
  188.  
  189.         check1(FALSE, parser, err)
  190.     END
  191. END checklex;
  192.  
  193.  
  194. PROCEDURE ExpectSym* (parser: PARSER; sym: INTEGER);
  195. BEGIN
  196.     Next(parser);
  197.     checklex(parser, sym)
  198. END ExpectSym;
  199.  
  200.  
  201. PROCEDURE ImportList (parser: PARSER);
  202. VAR
  203.     name:    SCAN.IDENT;
  204.     parser2: PARSER;
  205.     pos:     POSITION;
  206.     alias:   BOOLEAN;
  207.     unit:    PROG.UNIT;
  208.     ident:   PROG.IDENT;
  209.  
  210. BEGIN
  211.     alias := FALSE;
  212.  
  213.     REPEAT
  214.  
  215.         ExpectSym(parser, SCAN.lxIDENT);
  216.         name := parser.lex.ident;
  217.  
  218.         getpos(parser, pos);
  219.  
  220.         IF ~alias THEN
  221.             ident := PROG.addIdent(parser.unit, name, PROG.idMODULE);
  222.             check(ident # NIL, pos, 30)
  223.         END;
  224.  
  225.         Next(parser);
  226.  
  227.         IF (parser.sym = SCAN.lxCOMMA) OR (parser.sym = SCAN.lxSEMI) THEN
  228.             alias := FALSE;
  229.             unit := PROG.getUnit(program, name);
  230.  
  231.             IF unit # NIL THEN
  232.                 check(unit.closed, pos, 31)
  233.             ELSE
  234.                 parser2 := parser.create(parser.path, parser.lib_path,
  235.                     parser.StatSeq, parser.expression, parser.designator, parser.chkreturn);
  236.  
  237.                 IF ~parser2.open(parser2, name.s) THEN
  238.                     IF parser.path # parser.lib_path THEN
  239.                         destroy(parser2);
  240.                         parser2 := parser.create(parser.lib_path, parser.lib_path,
  241.                             parser.StatSeq, parser.expression, parser.designator, parser.chkreturn);
  242.                         check(parser2.open(parser2, name.s), pos, 29)
  243.                     ELSE
  244.                         error(pos, 29)
  245.                     END
  246.                 END;
  247.  
  248.                 parser2.parse(parser2);
  249.                 unit := parser2.unit;
  250.                 destroy(parser2)
  251.             END;
  252.             IF unit = program.sysunit THEN
  253.                 parser.unit.sysimport := TRUE
  254.             END;
  255.             ident.unit := unit
  256.  
  257.         ELSIF parser.sym = SCAN.lxASSIGN THEN
  258.             alias := TRUE
  259.  
  260.         ELSE
  261.             check1(FALSE, parser, 28)
  262.         END
  263.  
  264.     UNTIL parser.sym = SCAN.lxSEMI;
  265.  
  266.     Next(parser)
  267.  
  268. END ImportList;
  269.  
  270.  
  271. PROCEDURE QIdent (parser: PARSER; forward: BOOLEAN): PROG.IDENT;
  272. VAR
  273.     ident: PROG.IDENT;
  274.     unit:  PROG.UNIT;
  275.  
  276. BEGIN
  277.     ASSERT(parser.sym = SCAN.lxIDENT);
  278.  
  279.     ident := PROG.getIdent(parser.unit, parser.lex.ident, FALSE);
  280.  
  281.     IF ~forward THEN
  282.         check1(ident # NIL, parser, 48)
  283.     END;
  284.  
  285.     IF (ident # NIL) & (ident.typ = PROG.idMODULE) THEN
  286.         unit := ident.unit;
  287.         ExpectSym(parser, SCAN.lxPOINT);
  288.         ExpectSym(parser, SCAN.lxIDENT);
  289.         ident := PROG.getIdent(unit, parser.lex.ident, FALSE);
  290.         check1((ident # NIL) & ident.export, parser, 48)
  291.     END
  292.  
  293.     RETURN ident
  294. END QIdent;
  295.  
  296.  
  297. PROCEDURE strcmp* (VAR v: ARITH.VALUE; v2: ARITH.VALUE; operator: INTEGER);
  298. VAR
  299.     str: SCAN.LEXSTR;
  300.     string1, string2: SCAN.IDENT;
  301.     bool: BOOLEAN;
  302.  
  303. BEGIN
  304.  
  305.     IF v.typ = ARITH.tCHAR THEN
  306.         ASSERT(v2.typ = ARITH.tSTRING);
  307.         ARITH.charToStr(v, str);
  308.         string1 := SCAN.enterid(str);
  309.         string2 := v2.string(SCAN.IDENT)
  310.     END;
  311.  
  312.     IF v2.typ = ARITH.tCHAR THEN
  313.         ASSERT(v.typ = ARITH.tSTRING);
  314.         ARITH.charToStr(v2, str);
  315.         string2 := SCAN.enterid(str);
  316.         string1 := v.string(SCAN.IDENT)
  317.     END;
  318.  
  319.     IF v.typ = v2.typ THEN
  320.         string1 := v.string(SCAN.IDENT);
  321.         string2 := v2.string(SCAN.IDENT)
  322.     END;
  323.  
  324.     CASE operator OF
  325.     |SCAN.lxEQ: bool := string1.s =  string2.s
  326.     |SCAN.lxNE: bool := string1.s #  string2.s
  327.     |SCAN.lxLT: bool := string1.s <  string2.s
  328.     |SCAN.lxGT: bool := string1.s >  string2.s
  329.     |SCAN.lxLE: bool := string1.s <= string2.s
  330.     |SCAN.lxGE: bool := string1.s >= string2.s
  331.     END;
  332.  
  333.     ARITH.setbool(v, bool)
  334. END strcmp;
  335.  
  336.  
  337. PROCEDURE ConstExpression* (parser: PARSER; VAR v: ARITH.VALUE);
  338. VAR
  339.     e: EXPR;
  340.     pos: POSITION;
  341.  
  342. BEGIN
  343.     getpos(parser, pos);
  344.     parser.constexp := TRUE;
  345.     parser.expression(parser, e);
  346.     parser.constexp := FALSE;
  347.     check(e.obj = eCONST, pos, 62);
  348.     v := e.value
  349. END ConstExpression;
  350.  
  351.  
  352. PROCEDURE FieldList (parser: PARSER; rec: PROG.TYPE_);
  353. VAR
  354.     name:   SCAN.IDENT;
  355.     export: BOOLEAN;
  356.     pos:    POSITION;
  357.  
  358. BEGIN
  359.     ASSERT(parser.sym = SCAN.lxIDENT);
  360.  
  361.     WHILE parser.sym = SCAN.lxIDENT DO
  362.  
  363.         getpos(parser, pos);
  364.  
  365.         name := parser.lex.ident;
  366.  
  367.         Next(parser);
  368.  
  369.         export := parser.sym = SCAN.lxMUL;
  370.  
  371.         IF export THEN
  372.             check1(parser.unit.scopeLvl = 0, parser, 61);
  373.             Next(parser)
  374.         END;
  375.  
  376.         check(PROG.addField(rec, name, export), pos, 30);
  377.  
  378.         IF parser.sym = SCAN.lxCOMMA THEN
  379.             ExpectSym(parser, SCAN.lxIDENT)
  380.         ELSE
  381.             checklex(parser, SCAN.lxCOLON)
  382.         END
  383.  
  384.     END
  385.  
  386. END FieldList;
  387.  
  388.  
  389. PROCEDURE FormalParameters (parser: PARSER; type: PROG.TYPE_);
  390. VAR
  391.     ident: PROG.IDENT;
  392.  
  393.  
  394.     PROCEDURE FPSection (parser: PARSER; type: PROG.TYPE_);
  395.     VAR
  396.         ident:   PROG.IDENT;
  397.         exit:    BOOLEAN;
  398.         vPar:    BOOLEAN;
  399.         dim:     INTEGER;
  400.         t0, t1:  PROG.TYPE_;
  401.  
  402.     BEGIN
  403.         vPar := parser.sym = SCAN.lxVAR;
  404.         IF vPar THEN
  405.             Next(parser)
  406.         END;
  407.  
  408.         checklex(parser, SCAN.lxIDENT);
  409.         exit := FALSE;
  410.  
  411.         WHILE (parser.sym = SCAN.lxIDENT) & ~exit DO
  412.             check1(PROG.addParam(type, parser.lex.ident, vPar), parser, 30);
  413.             Next(parser);
  414.             IF parser.sym = SCAN.lxCOMMA THEN
  415.                 ExpectSym(parser, SCAN.lxIDENT)
  416.             ELSIF parser.sym = SCAN.lxCOLON THEN
  417.                 Next(parser);
  418.                 dim := 0;
  419.                 WHILE parser.sym = SCAN.lxARRAY DO
  420.                     INC(dim);
  421.                     check1(dim <= PROG.MAXARRDIM, parser, 84);
  422.                     ExpectSym(parser, SCAN.lxOF);
  423.                     Next(parser)
  424.                 END;
  425.                 checklex(parser, SCAN.lxIDENT);
  426.                 ident := QIdent(parser, FALSE);
  427.                 check1(ident.typ = PROG.idTYPE, parser, 68);
  428.  
  429.                 t0 := ident.type;
  430.                 t1 := t0;
  431.  
  432.                 WHILE dim > 0 DO
  433.                     t1 := PROG.enterType(program, PROG.tARRAY, -1, 0, parser.unit);
  434.                     t1.base := t0;
  435.                     t0 := t1;
  436.                     DEC(dim)
  437.                 END;
  438.  
  439.                 PROG.setParams(type, t1);
  440.                 Next(parser);
  441.                 exit := TRUE
  442.             ELSE
  443.                 checklex(parser, SCAN.lxCOLON)
  444.             END
  445.         END
  446.  
  447.     END FPSection;
  448.  
  449.  
  450. BEGIN
  451.     IF parser.sym = SCAN.lxLROUND THEN
  452.  
  453.         Next(parser);
  454.  
  455.         IF (parser.sym = SCAN.lxVAR) OR (parser.sym = SCAN.lxIDENT) THEN
  456.             FPSection(parser, type);
  457.             WHILE parser.sym = SCAN.lxSEMI DO
  458.                 Next(parser);
  459.                 FPSection(parser, type)
  460.             END
  461.         END;
  462.  
  463.         checklex(parser, SCAN.lxRROUND);
  464.         Next(parser);
  465.  
  466.         IF parser.sym = SCAN.lxCOLON THEN
  467.             ExpectSym(parser, SCAN.lxIDENT);
  468.             ident := QIdent(parser, FALSE);
  469.             check1(ident.typ = PROG.idTYPE, parser, 68);
  470.             check1(~(ident.type.typ IN {PROG.tRECORD, PROG.tARRAY}), parser, 69);
  471.             check1( ~(ODD(type.call) & (ident.type.typ = PROG.tREAL)), parser, 113);
  472.             type.base := ident.type;
  473.             Next(parser)
  474.         ELSE
  475.             type.base := NIL
  476.         END
  477.  
  478.     END
  479. END FormalParameters;
  480.  
  481.  
  482. PROCEDURE sysflag (parser: PARSER; proc: BOOLEAN): INTEGER;
  483. VAR
  484.     res, sf: INTEGER;
  485.  
  486. BEGIN
  487.     IF parser.lex.s = "stdcall" THEN
  488.         sf := PROG.sf_stdcall
  489.     ELSIF parser.lex.s = "stdcall64" THEN
  490.         sf := PROG.sf_stdcall64
  491.     ELSIF parser.lex.s = "ccall" THEN
  492.         sf := PROG.sf_ccall
  493.     ELSIF parser.lex.s = "ccall16" THEN
  494.         sf := PROG.sf_ccall16
  495.     ELSIF parser.lex.s = "win64" THEN
  496.         sf := PROG.sf_win64
  497.     ELSIF parser.lex.s = "systemv" THEN
  498.         sf := PROG.sf_systemv
  499.     ELSIF parser.lex.s = "windows" THEN
  500.         sf := PROG.sf_windows
  501.     ELSIF parser.lex.s = "linux" THEN
  502.         sf := PROG.sf_linux
  503.     ELSIF parser.lex.s = "code" THEN
  504.         sf := PROG.sf_code
  505.     ELSIF parser.lex.s = "noalign" THEN
  506.         sf := PROG.sf_noalign
  507.     ELSE
  508.         check1(FALSE, parser, 124)
  509.     END;
  510.  
  511.     check1(sf IN program.target.sysflags, parser, 125);
  512.  
  513.     IF proc THEN
  514.         check1(sf IN PROG.proc_flags, parser, 123)
  515.     ELSE
  516.         check1(sf IN PROG.rec_flags, parser, 123)
  517.     END;
  518.  
  519.     CASE sf OF
  520.     |PROG.sf_stdcall:
  521.         res := PROG.stdcall
  522.     |PROG.sf_stdcall64:
  523.         res := PROG.stdcall64
  524.     |PROG.sf_ccall:
  525.         res := PROG.ccall
  526.     |PROG.sf_ccall16:
  527.         res := PROG.ccall16
  528.     |PROG.sf_win64:
  529.         res := PROG.win64
  530.     |PROG.sf_systemv:
  531.         res := PROG.systemv
  532.     |PROG.sf_code:
  533.         res := PROG.code
  534.     |PROG.sf_windows:
  535.         IF program.target.sys IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL} THEN
  536.             res := PROG.stdcall
  537.         ELSIF program.target.sys IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64} THEN
  538.             res := PROG.win64
  539.         END
  540.     |PROG.sf_linux:
  541.         IF program.target.sys IN {mConst.Target_iELF32, mConst.Target_iELFSO32} THEN
  542.             res := PROG.ccall16
  543.         ELSIF program.target.sys IN {mConst.Target_iELF64, mConst.Target_iELFSO64} THEN
  544.             res := PROG.systemv
  545.         END
  546.     |PROG.sf_noalign:
  547.         res := PROG.noalign
  548.     END
  549.  
  550.     RETURN res
  551. END sysflag;
  552.  
  553.  
  554. PROCEDURE procflag (parser: PARSER; VAR import: IL.IMPORT_PROC; isProc: BOOLEAN): INTEGER;
  555. VAR
  556.     call: INTEGER;
  557.     dll, proc: SCAN.LEXSTR;
  558.     pos: POSITION;
  559.  
  560. BEGIN
  561.  
  562.     import := NIL;
  563.  
  564.     IF parser.sym = SCAN.lxLSQUARE THEN
  565.         getpos(parser, pos);
  566.         check1(parser.unit.sysimport, parser, 54);
  567.         Next(parser);
  568.         call := sysflag(parser, TRUE);
  569.         Next(parser);
  570.         IF parser.sym = SCAN.lxMINUS THEN
  571.             Next(parser);
  572.             INC(call)
  573.         END;
  574.         IF ~isProc THEN
  575.             checklex(parser, SCAN.lxRSQUARE)
  576.         END;
  577.         IF parser.sym = SCAN.lxCOMMA THEN
  578.             ExpectSym(parser, SCAN.lxSTRING);
  579.             dll := parser.lex.s;
  580.             ExpectSym(parser, SCAN.lxCOMMA);
  581.             ExpectSym(parser, SCAN.lxSTRING);
  582.             proc := parser.lex.s;
  583.             Next(parser);
  584.             import := IL.AddImp(dll, proc)
  585.         END;
  586.         checklex(parser, SCAN.lxRSQUARE);
  587.         Next(parser)
  588.     ELSE
  589.         CASE program.target.bit_depth OF
  590.         |16: call := PROG.default16
  591.         |32: call := PROG.default32
  592.         |64: call := PROG.default64
  593.         END
  594.     END;
  595.  
  596.     IF import # NIL THEN
  597.         check(~(program.target.sys IN {mConst.Target_iELF32, mConst.Target_iELF64, mConst.Target_iELFSO32,
  598.             mConst.Target_iELFSO64, mConst.Target_iMSP430}), pos, 70)
  599.     END
  600.  
  601.     RETURN call
  602. END procflag;
  603.  
  604.  
  605. PROCEDURE type (parser: PARSER; VAR t: PROG.TYPE_; flags: SET);
  606. CONST
  607.     comma   = 0;
  608.     closed  = 1;
  609.     forward = 2;
  610.  
  611. VAR
  612.     arrLen:     ARITH.VALUE;
  613.     typeSize:   ARITH.VALUE;
  614.     ident:      PROG.IDENT;
  615.     unit:       PROG.UNIT;
  616.     pos, pos2:  POSITION;
  617.     fieldType:  PROG.TYPE_;
  618.     baseIdent:  SCAN.IDENT;
  619.     a, b:       INTEGER;
  620.     RecFlag:    INTEGER;
  621.     import:     IL.IMPORT_PROC;
  622.  
  623. BEGIN
  624.     unit := parser.unit;
  625.     t := NIL;
  626.  
  627.     IF parser.sym = SCAN.lxIDENT THEN
  628.         ident := QIdent(parser, forward IN flags);
  629.  
  630.         IF ident # NIL THEN
  631.             check1(ident.typ = PROG.idTYPE, parser, 49);
  632.             t := ident.type;
  633.             check1(t # NIL, parser, 50);
  634.             IF closed IN flags THEN
  635.                 check1(t.closed, parser, 50)
  636.             END
  637.         END;
  638.  
  639.         Next(parser)
  640.  
  641.     ELSIF (parser.sym = SCAN.lxARRAY) OR ((parser.sym = SCAN.lxCOMMA) & (comma IN flags)) THEN
  642.  
  643.         IF parser.sym = SCAN.lxARRAY THEN
  644.             getpos(parser, pos2)
  645.         END;
  646.         NextPos(parser, pos);
  647.  
  648.         ConstExpression(parser, arrLen);
  649.  
  650.         check(arrLen.typ = ARITH.tINTEGER, pos, 43);
  651.         check(ARITH.check(arrLen),         pos, 39);
  652.         check(ARITH.getInt(arrLen) > 0,    pos, 51);
  653.  
  654.         t := PROG.enterType(program, PROG.tARRAY, -1, ARITH.getInt(arrLen), unit);
  655.  
  656.         IF parser.sym = SCAN.lxCOMMA THEN
  657.             type(parser, t.base, {comma, closed})
  658.         ELSIF parser.sym = SCAN.lxOF THEN
  659.             Next(parser);
  660.             type(parser, t.base, {closed})
  661.         ELSE
  662.             check1(FALSE, parser, 47)
  663.         END;
  664.  
  665.         t.align := t.base.align;
  666.  
  667.         a := t.length;
  668.         b := t.base.size;
  669.         check(ARITH.mulInt(a, b), pos2, 104);
  670.         check(ARITH.setInt(typeSize, a), pos2, 104);
  671.         t.size := a;
  672.  
  673.         t.closed := TRUE
  674.  
  675.     ELSIF parser.sym = SCAN.lxRECORD THEN
  676.         getpos(parser, pos2);
  677.         Next(parser);
  678.  
  679.         t := PROG.enterType(program, PROG.tRECORD, 0, 0, unit);
  680.         t.align := 1;
  681.  
  682.         IF parser.sym = SCAN.lxLSQUARE THEN
  683.             check1(parser.unit.sysimport, parser, 54);
  684.             Next(parser);
  685.             RecFlag := sysflag(parser, FALSE);
  686.             t.noalign := RecFlag = PROG.noalign;
  687.             ExpectSym(parser, SCAN.lxRSQUARE);
  688.             Next(parser)
  689.         END;
  690.  
  691.         IF parser.sym = SCAN.lxLROUND THEN
  692.             check1(~t.noalign, parser, 111);
  693.             ExpectSym(parser, SCAN.lxIDENT);
  694.             getpos(parser, pos);
  695.  
  696.             type(parser, t.base, {closed});
  697.  
  698.             check(t.base.typ IN {PROG.tRECORD, PROG.tPOINTER}, pos, 52);
  699.  
  700.             IF t.base.typ = PROG.tPOINTER THEN
  701.                 t.base := t.base.base;
  702.                 check(t.base # NIL, pos, 55)
  703.             END;
  704.  
  705.             check(~t.base.noalign, pos, 112);
  706.  
  707.             checklex(parser, SCAN.lxRROUND);
  708.             Next(parser);
  709.  
  710.             t.size := t.base.size;
  711.             IF t.base.align > t.align THEN
  712.                 t.align := t.base.align
  713.             END
  714.         ELSE
  715.             t.base := program.stTypes.tANYREC
  716.         END;
  717.  
  718.         WHILE parser.sym = SCAN.lxIDENT DO
  719.             FieldList(parser, t);
  720.  
  721.             ASSERT(parser.sym = SCAN.lxCOLON);
  722.             Next(parser);
  723.  
  724.             type(parser, fieldType, {closed});
  725.             check(PROG.setFields(t, fieldType), pos2, 104);
  726.  
  727.             IF (fieldType.align > t.align) & ~t.noalign THEN
  728.                 t.align := fieldType.align
  729.             END;
  730.  
  731.             IF parser.sym = SCAN.lxSEMI THEN
  732.                 ExpectSym(parser, SCAN.lxIDENT)
  733.             ELSE
  734.                 checklex(parser, SCAN.lxEND)
  735.             END
  736.         END;
  737.  
  738.         t.closed := TRUE;
  739.  
  740.         IL.AddRec(t.base.num);
  741.  
  742.         IF ~t.noalign THEN
  743.             check(UTILS.Align(t.size, t.align), pos2, 104);
  744.             check(ARITH.setInt(typeSize, t.size), pos2, 104)
  745.         END;
  746.  
  747.         checklex(parser, SCAN.lxEND);
  748.         Next(parser)
  749.  
  750.     ELSIF parser.sym = SCAN.lxPOINTER THEN
  751.         ExpectSym(parser, SCAN.lxTO);
  752.         Next(parser);
  753.  
  754.         t := PROG.enterType(program, PROG.tPOINTER, program.target.adr, 0, unit);
  755.         t.align := program.target.adr;
  756.  
  757.         getpos(parser, pos);
  758.  
  759.         IF parser.sym = SCAN.lxIDENT THEN
  760.             baseIdent := parser.lex.ident
  761.         END;
  762.  
  763.         type(parser, t.base, {forward});
  764.  
  765.         IF t.base # NIL THEN
  766.             check(t.base.typ = PROG.tRECORD, pos, 58)
  767.         ELSE
  768.             PROG.frwPtr(unit, t, baseIdent, pos)
  769.         END
  770.  
  771.     ELSIF parser.sym = SCAN.lxPROCEDURE THEN
  772.         NextPos(parser, pos);
  773.         t := PROG.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit);
  774.         t.align := program.target.adr;
  775.         t.call := procflag(parser, import, FALSE);
  776.         FormalParameters(parser, t)
  777.     ELSE
  778.         check1(FALSE, parser, 49)
  779.     END
  780.  
  781. END type;
  782.  
  783.  
  784. PROCEDURE IdentDef (parser: PARSER; typ: INTEGER; VAR name: SCAN.IDENT): PROG.IDENT;
  785. VAR
  786.     ident:  PROG.IDENT;
  787.     pos:    POSITION;
  788.  
  789. BEGIN
  790.     ASSERT(parser.sym = SCAN.lxIDENT);
  791.  
  792.     name := parser.lex.ident;
  793.     getpos(parser, pos);
  794.     ident := PROG.addIdent(parser.unit, name, typ);
  795.     check(ident # NIL, pos, 30);
  796.     ident.pos := pos;
  797.     Next(parser);
  798.  
  799.     IF parser.sym = SCAN.lxMUL THEN
  800.         check1(ident.global, parser, 61);
  801.         ident.export := TRUE;
  802.         Next(parser)
  803.     END
  804.  
  805.     RETURN ident
  806. END IdentDef;
  807.  
  808.  
  809. PROCEDURE ConstTypeDeclaration (parser: PARSER; const: BOOLEAN);
  810. VAR
  811.     ident: PROG.IDENT;
  812.     name:  SCAN.IDENT;
  813.     pos:   POSITION;
  814.  
  815. BEGIN
  816.     IF const THEN
  817.         ident := IdentDef(parser, PROG.idNONE, name)
  818.     ELSE
  819.         ident := IdentDef(parser, PROG.idTYPE, name)
  820.     END;
  821.  
  822.     checklex(parser, SCAN.lxEQ);
  823.     NextPos(parser, pos);
  824.  
  825.     IF const THEN
  826.         ConstExpression(parser, ident.value);
  827.         IF ident.value.typ = ARITH.tINTEGER THEN
  828.             check(ARITH.check(ident.value), pos, 39)
  829.         ELSIF ident.value.typ = ARITH.tREAL THEN
  830.             check(ARITH.check(ident.value), pos, 40)
  831.         END;
  832.         ident.typ  := PROG.idCONST;
  833.         ident.type := PROG.getType(program, ident.value.typ)
  834.     ELSE
  835.         type(parser, ident.type, {})
  836.     END;
  837.  
  838.     checklex(parser, SCAN.lxSEMI);
  839.     Next(parser)
  840.  
  841. END ConstTypeDeclaration;
  842.  
  843.  
  844. PROCEDURE VarDeclaration (parser: PARSER);
  845. VAR
  846.     ident: PROG.IDENT;
  847.     name:  SCAN.IDENT;
  848.     t:     PROG.TYPE_;
  849.  
  850. BEGIN
  851.  
  852.     REPEAT
  853.         ident := IdentDef(parser, PROG.idVAR, name);
  854.  
  855.         IF parser.sym = SCAN.lxCOMMA THEN
  856.             ExpectSym(parser, SCAN.lxIDENT)
  857.         ELSIF parser.sym = SCAN.lxCOLON THEN
  858.             Next(parser);
  859.             type(parser, t, {});
  860.             PROG.setVarsType(parser.unit, t);
  861.             checklex(parser, SCAN.lxSEMI);
  862.             Next(parser)
  863.         ELSE
  864.             checklex(parser, SCAN.lxCOLON)
  865.         END
  866.  
  867.     UNTIL parser.sym # SCAN.lxIDENT
  868.  
  869. END VarDeclaration;
  870.  
  871.  
  872. PROCEDURE DeclarationSequence (parser: PARSER): BOOLEAN;
  873. VAR
  874.     ptr: PROG.FRWPTR;
  875.     endmod: BOOLEAN;
  876.     pos: POSITION;
  877.  
  878.  
  879.     PROCEDURE ProcDeclaration (parser: PARSER): BOOLEAN;
  880.     VAR
  881.         proc:       PROG.IDENT;
  882.         endname,
  883.         name:       SCAN.IDENT;
  884.         param:      PROG.PARAM;
  885.         unit:       PROG.UNIT;
  886.         ident:      PROG.IDENT;
  887.         e:          EXPR;
  888.         pos, pos1,
  889.         pos2:       POSITION;
  890.         label:      INTEGER;
  891.         enter:      IL.COMMAND;
  892.         call:       INTEGER;
  893.         t:          PROG.TYPE_;
  894.         import:     IL.IMPORT_PROC;
  895.         endmod, b:  BOOLEAN;
  896.         fparams:    SET;
  897.         variables:  LISTS.LIST;
  898.         int, flt:   INTEGER;
  899.         comma:      BOOLEAN;
  900.         code:       ARITH.VALUE;
  901.         codeProc:   BOOLEAN;
  902.  
  903.     BEGIN
  904.         endmod := FALSE;
  905.  
  906.         unit := parser.unit;
  907.  
  908.         call := procflag(parser, import, TRUE);
  909.  
  910.         getpos(parser, pos);
  911.         pos1 := pos;
  912.         checklex(parser, SCAN.lxIDENT);
  913.  
  914.         IF import # NIL THEN
  915.             proc := IdentDef(parser, PROG.idIMP, name);
  916.             proc.import := import;
  917.             program.procs.last(PROG.PROC).import := import
  918.         ELSE
  919.             proc := IdentDef(parser, PROG.idPROC, name)
  920.         END;
  921.  
  922.         check(PROG.openScope(unit, proc.proc), pos, 116);
  923.  
  924.         proc.type := PROG.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit);
  925.         t := proc.type;
  926.         t.align := program.target.adr;
  927.         t.call  := call;
  928.  
  929.         FormalParameters(parser, t);
  930.  
  931.         codeProc := call IN {PROG.code, PROG._code};
  932.  
  933.         IF call IN {PROG.systemv, PROG._systemv} THEN
  934.             check(t.parSize <= PROG.MAXSYSVPARAM, pos, 120)
  935.         END;
  936.  
  937.         param := t.params.first(PROG.PARAM);
  938.         WHILE param # NIL DO
  939.             ident := PROG.addIdent(unit, param.name, PROG.idPARAM);
  940.             ASSERT(ident # NIL);
  941.             ident.type := param.type;
  942.             ident.offset := param.offset;
  943.             IF param.vPar THEN
  944.                 ident.typ := PROG.idVPAR
  945.             END;
  946.             param := param.next(PROG.PARAM)
  947.         END;
  948.  
  949.         IF import = NIL THEN
  950.             label := IL.NewLabel();
  951.             proc.proc.label := label
  952.         END;
  953.  
  954.         IF codeProc THEN
  955.             enter := IL.EnterC(label);
  956.             comma := FALSE;
  957.             WHILE (parser.sym # SCAN.lxSEMI) OR comma DO
  958.                 getpos(parser, pos2);
  959.                 ConstExpression(parser, code);
  960.                 check(code.typ = ARITH.tINTEGER, pos2, 43);
  961.                 IF program.target.sys # mConst.Target_iMSP430 THEN
  962.                     check(ARITH.range(code, 0, 255), pos2, 42)
  963.                 END;
  964.                 IL.AddCmd(IL.opCODE, ARITH.getInt(code));
  965.                 comma := parser.sym = SCAN.lxCOMMA;
  966.                 IF comma THEN
  967.                     Next(parser)
  968.                 ELSE
  969.                     checklex(parser, SCAN.lxSEMI)
  970.                 END
  971.             END
  972.         END;
  973.  
  974.         checklex(parser, SCAN.lxSEMI);
  975.         Next(parser);
  976.  
  977.         IF import = NIL THEN
  978.  
  979.             IF parser.main & proc.export & program.dll THEN
  980.                 IF program.obj THEN
  981.                     check((proc.name.s # "lib_init") & (proc.name.s # "version"), pos, 114)
  982.                 END;
  983.                 IL.AddExp(label, proc.name.s);
  984.                 proc.proc.used := TRUE
  985.             END;
  986.  
  987.             IF ~codeProc THEN
  988.                 b := DeclarationSequence(parser)
  989.             END;
  990.  
  991.             program.locsize := 0;
  992.             IF call IN {PROG._win64, PROG.win64} THEN
  993.                 fparams := PROG.getFloatParamsPos(proc.type, 3, int, flt);
  994.                 enter := IL.Enter(label, LSL(ORD(fparams), 5) + MIN(proc.type.parSize, 4))
  995.             ELSIF call IN {PROG._systemv, PROG.systemv} THEN
  996.                 fparams := PROG.getFloatParamsPos(proc.type, PROG.MAXSYSVPARAM - 1, int, flt);
  997.                 enter := IL.Enter(label, -(LSL(ORD(fparams), 5) + proc.type.parSize))
  998.             ELSIF codeProc THEN
  999.  
  1000.             ELSE
  1001.                 enter := IL.Enter(label, 0)
  1002.             END;
  1003.             proc.proc.enter := enter;
  1004.  
  1005.             IF ~codeProc & (parser.sym = SCAN.lxBEGIN) THEN
  1006.                 Next(parser);
  1007.                 parser.StatSeq(parser)
  1008.             END;
  1009.  
  1010.             IF ~codeProc & (t.base # NIL) THEN
  1011.                 checklex(parser, SCAN.lxRETURN);
  1012.                 NextPos(parser, pos);
  1013.                 parser.expression(parser, e);
  1014.                 check(parser.chkreturn(parser, e, t.base, pos), pos, 87)
  1015.             END;
  1016.  
  1017.             IF ~codeProc THEN
  1018.                 proc.proc.leave := IL.Leave(t.base # NIL, (t.base # NIL) & (t.base.typ = PROG.tREAL), program.locsize,
  1019.                     t.parSize * ORD((t.call IN PROG.callee_clean_up) OR (t.call IN {PROG.systemv, PROG._systemv})));
  1020.                 enter.param2 := program.locsize;
  1021.                 checklex(parser, SCAN.lxEND)
  1022.             ELSE
  1023.                 proc.proc.leave := IL.LeaveC()
  1024.             END;
  1025.  
  1026.             IF program.target.sys = mConst.Target_iMSP430 THEN
  1027.                 check((enter.param2 * ORD(~codeProc) + proc.type.parSize) * 2 + 16 < program.target.options.ram, pos1, 63)
  1028.             END
  1029.         END;
  1030.  
  1031.         IF parser.sym = SCAN.lxEND THEN
  1032.             ExpectSym(parser, SCAN.lxIDENT);
  1033.             getpos(parser, pos);
  1034.             endname := parser.lex.ident;
  1035.             IF ~codeProc & (import = NIL) THEN
  1036.                 check(endname = name, pos, 60);
  1037.                 ExpectSym(parser, SCAN.lxSEMI);
  1038.                 Next(parser)
  1039.             ELSE
  1040.                 IF endname = parser.unit.name THEN
  1041.                     ExpectSym(parser, SCAN.lxPOINT);
  1042.                     Next(parser);
  1043.                     endmod := TRUE
  1044.                 ELSIF endname = name THEN
  1045.                     ExpectSym(parser, SCAN.lxSEMI);
  1046.                     Next(parser)
  1047.                 ELSE
  1048.                     error(pos, 60)
  1049.                 END
  1050.             END
  1051.         END;
  1052.  
  1053.         IF ~codeProc & (import = NIL) THEN
  1054.             variables := LISTS.create(NIL);
  1055.         ELSE
  1056.             variables := NIL
  1057.         END;
  1058.  
  1059.         PROG.closeScope(unit, variables);
  1060.  
  1061.         IF ~codeProc & (import = NIL) THEN
  1062.             enter.variables := variables
  1063.         END
  1064.  
  1065.         RETURN endmod
  1066.     END ProcDeclaration;
  1067.  
  1068.  
  1069. BEGIN
  1070.     IF parser.sym = SCAN.lxCONST THEN
  1071.         Next(parser);
  1072.         WHILE parser.sym = SCAN.lxIDENT DO
  1073.             ConstTypeDeclaration(parser, TRUE)
  1074.         END
  1075.     END;
  1076.  
  1077.     IF parser.sym = SCAN.lxTYPE THEN
  1078.         Next(parser);
  1079.         WHILE parser.sym = SCAN.lxIDENT DO
  1080.             ConstTypeDeclaration(parser, FALSE)
  1081.         END
  1082.     END;
  1083.  
  1084.     ptr := PROG.linkPtr(parser.unit);
  1085.     IF ptr # NIL THEN
  1086.         pos.line := ptr.pos.line;
  1087.         pos.col  := ptr.pos.col;
  1088.         pos.parser := parser;
  1089.         IF ptr.notRecord THEN
  1090.             error(pos, 58)
  1091.         ELSE
  1092.             error(pos, 48)
  1093.         END
  1094.     END;
  1095.  
  1096.     IF parser.sym = SCAN.lxVAR THEN
  1097.         Next(parser);
  1098.         IF parser.sym = SCAN.lxIDENT THEN
  1099.             VarDeclaration(parser)
  1100.         END
  1101.     END;
  1102.  
  1103.     endmod := FALSE;
  1104.     WHILE ~endmod & (parser.sym = SCAN.lxPROCEDURE) DO
  1105.         Next(parser);
  1106.         endmod := ProcDeclaration(parser)
  1107.     END
  1108.  
  1109.     RETURN endmod
  1110. END DeclarationSequence;
  1111.  
  1112.  
  1113. PROCEDURE parse (parser: PARSER);
  1114. VAR
  1115.     unit:     PROG.UNIT;
  1116.     label:    INTEGER;
  1117.     name:     INTEGER;
  1118.     endmod:   BOOLEAN;
  1119.     errlabel: INTEGER;
  1120.     errno:    INTEGER;
  1121.  
  1122. BEGIN
  1123.     ASSERT(parser # NIL);
  1124.     ASSERT(parser.scanner # NIL);
  1125.  
  1126.     ExpectSym(parser, SCAN.lxMODULE);
  1127.     ExpectSym(parser, SCAN.lxIDENT);
  1128.  
  1129.     IF ~parser.main THEN
  1130.         check1(parser.lex.s = parser.modname, parser, 23)
  1131.     END;
  1132.  
  1133.     unit := PROG.newUnit(program, parser.lex.ident);
  1134.  
  1135.     parser.unit := unit;
  1136.  
  1137.     ExpectSym(parser, SCAN.lxSEMI);
  1138.  
  1139.     Next(parser);
  1140.     IF parser.sym = SCAN.lxIMPORT THEN
  1141.         ImportList(parser)
  1142.     END;
  1143.  
  1144.     CONSOLE.String("compiling "); CONSOLE.String(unit.name.s);
  1145.     IF parser.unit.sysimport THEN
  1146.         CONSOLE.String(" (SYSTEM)")
  1147.     END;
  1148.     CONSOLE.Ln;
  1149.  
  1150.     label := IL.NewLabel();
  1151.     IL.AddJmpCmd(IL.opJMP, label);
  1152.  
  1153.     name := IL.putstr(unit.name.s);
  1154.  
  1155.     errlabel := IL.NewLabel();
  1156.     IL.SetLabel(errlabel);
  1157.     IL.StrAdr(name);
  1158.     IL.Param1;
  1159.     IL.AddCmd0(IL.opERR);
  1160.  
  1161.     FOR errno := 1 TO LEN(IL.codes.errlabels) - 1 DO
  1162.         IL.SetErrLabel(errno);
  1163.         IL.AddCmd(IL.opPUSHC, errno);
  1164.         IL.AddJmpCmd(IL.opJMP, errlabel)
  1165.     END;
  1166.  
  1167.     endmod := DeclarationSequence(parser);
  1168.  
  1169.     IL.SetLabel(label);
  1170.  
  1171.     IF ~endmod THEN
  1172.  
  1173.         IF parser.sym = SCAN.lxBEGIN THEN
  1174.             Next(parser);
  1175.             parser.StatSeq(parser)
  1176.         END;
  1177.  
  1178.         checklex(parser, SCAN.lxEND);
  1179.  
  1180.         ExpectSym(parser, SCAN.lxIDENT);
  1181.         check1(parser.lex.s = unit.name.s, parser, 25);
  1182.         ExpectSym(parser, SCAN.lxPOINT)
  1183.     END;
  1184.  
  1185.     INC(lines, parser.lex.pos.line);
  1186.     PROG.closeUnit(unit)
  1187. END parse;
  1188.  
  1189.  
  1190. PROCEDURE open (parser: PARSER; modname: ARRAY OF CHAR): BOOLEAN;
  1191. BEGIN
  1192.     ASSERT(parser # NIL);
  1193.  
  1194.     STRINGS.append(parser.fname, modname);
  1195.     STRINGS.append(parser.fname, parser.ext);
  1196.     STRINGS.append(parser.modname, modname);
  1197.  
  1198.     parser.scanner := SCAN.open(parser.fname)
  1199.  
  1200.     RETURN parser.scanner # NIL
  1201. END open;
  1202.  
  1203.  
  1204. PROCEDURE NewParser (): PARSER;
  1205. VAR
  1206.     pars:  PARSER;
  1207.     citem: C.ITEM;
  1208.  
  1209. BEGIN
  1210.     citem := C.pop(parsers);
  1211.     IF citem = NIL THEN
  1212.         NEW(pars)
  1213.     ELSE
  1214.         pars := citem(PARSER)
  1215.     END
  1216.  
  1217.     RETURN pars
  1218. END NewParser;
  1219.  
  1220.  
  1221. PROCEDURE create* (path, lib_path: PATH; StatSeq: STATPROC; expression, designator: EXPRPROC; chkreturn: RETPROC): PARSER;
  1222. VAR
  1223.     parser: PARSER;
  1224.  
  1225. BEGIN
  1226.     parser := NewParser();
  1227.  
  1228.     parser.path     := path;
  1229.     parser.lib_path := lib_path;
  1230.     parser.ext      := mConst.FILE_EXT;
  1231.     parser.fname    := path;
  1232.     parser.modname  := "";
  1233.     parser.scanner  := NIL;
  1234.     parser.unit     := NIL;
  1235.     parser.constexp := FALSE;
  1236.     parser.main     := FALSE;
  1237.  
  1238.     parser.open       := open;
  1239.     parser.parse      := parse;
  1240.     parser.StatSeq    := StatSeq;
  1241.     parser.expression := expression;
  1242.     parser.designator := designator;
  1243.     parser.chkreturn  := chkreturn;
  1244.     parser.create     := create
  1245.  
  1246.     RETURN parser
  1247. END create;
  1248.  
  1249.  
  1250. PROCEDURE init* (bit_depth, target: INTEGER; options: PROG.OPTIONS);
  1251. BEGIN
  1252.     program := PROG.create(bit_depth, target, options);
  1253.     parsers := C.create();
  1254.     lines   := 0
  1255. END init;
  1256.  
  1257.  
  1258. END PARS.
  1259.