Subversion Repositories Kolibri OS

Rev

Rev 9579 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | Download | RSS feed

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