Subversion Repositories Kolibri OS

Rev

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