Subversion Repositories Kolibri OS

Rev

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

  1. (*
  2.     BSD 2-Clause License
  3.  
  4.     Copyright (c) 2018-2020, Anton Krotov
  5.     All rights reserved.
  6. *)
  7.  
  8. MODULE PROG;
  9.  
  10. IMPORT SCAN, LISTS, ARITH, ERRORS, C := COLLECTIONS, IL, UTILS, TARGETS, STRINGS;
  11.  
  12.  
  13. CONST
  14.  
  15.     MAXARRDIM*    = 5;
  16.     MAXSCOPE      = 16;
  17.     MAXSYSVPARAM* = 26;
  18.  
  19.     idNONE*    =  0;  idGUARD   =  1;  idMODULE* =  2;  idCONST*   =  3;
  20.     idTYPE*    =  4;  idSTFUNC* =  5;  idSTPROC* =  6;  idVAR*     =  7;
  21.     idPROC*    =  8;  idVPAR*   =  9;  idPARAM*  = 10;  idSYSFUNC* = 11;
  22.     idSYSPROC* = 12;  idIMP*    = 13;
  23.  
  24.     tINTEGER* =  1;  tBYTE*      =  2;  tCHAR*   =  3;  tSET*    =  4;
  25.     tBOOLEAN* =  5;  tREAL*      =  6;  tARRAY*  =  7;  tRECORD* =  8;
  26.     tPOINTER* =  9;  tPROCEDURE* = 10;  tSTRING* = 11;  tNIL*    = 12;
  27.     tCARD32*  = 13;  tANYREC*    = 14;  tWCHAR*  = 15;  tNONE*   = 16;
  28.  
  29.     BASICTYPES* = {tINTEGER, tBYTE, tCHAR, tSET, tBOOLEAN, tREAL, tCARD32, tWCHAR};
  30.  
  31.     stABS*  =  1;  stASR*  =  2;  stCHR*    =  3;  stFLOOR* =  4;
  32.     stFLT*  =  5;  stLEN*  =  6;  stLSL*    =  7;  stODD*   =  8;
  33.     stORD*  =  9;  stROR*  = 10;  stASSERT* = 11;  stDEC*   = 12;
  34.     stEXCL* = 13;  stINC*  = 14;  stINCL*   = 15;  stNEW*   = 16;
  35.     stPACK* = 17;  stUNPK* = 18;  sysADR*   = 19;  sysSIZE* = 20;
  36.     sysGET* = 21;  sysPUT* = 22;
  37.  
  38.     stDISPOSE* = 23;  stLSR*     = 24;  stBITS*   = 25;  sysCODE*  = 26;
  39.     sysMOVE*   = 27;  stLENGTH*  = 28;  stMIN*    = 29;  stMAX*    = 30;
  40.     sysSADR*   = 31;  sysTYPEID* = 32;  sysCOPY*  = 33;  sysINF*   = 34;
  41.     sysPUT8*   = 35;  sysPUT16*  = 36;  stCOPY*   = 37;  stWCHR*   = 38;
  42.     sysWSADR*  = 39;  sysPUT32*  = 40;  (*sysNOP*   = 41;  sysEINT*  = 42;
  43.     sysDINT*   = 43;*)sysGET8*   = 44;  sysGET16* = 45;  sysGET32* = 46;
  44.  
  45.     default32* =  2;  _default32* = default32 + 1;
  46.     stdcall*   =  4;  _stdcall*   = stdcall + 1;
  47.     ccall*     =  6;  _ccall*     = ccall + 1;
  48.     ccall16*   =  8;  _ccall16*   = ccall16 + 1;
  49.     win64*     = 10;  _win64*     = win64 + 1;
  50.     stdcall64* = 12;  _stdcall64* = stdcall64 + 1;
  51.     default64* = 14;  _default64* = default64 + 1;
  52.     systemv*   = 16;  _systemv*   = systemv + 1;
  53.     default16* = 18;
  54.     code*      = 20;  _code*      = code + 1;
  55.  
  56.     noalign* = 22;
  57.  
  58.     callee_clean_up* = {default32, stdcall, _stdcall, default64, stdcall64, _stdcall64};
  59.  
  60.     sf_stdcall* =  0; sf_stdcall64* = 1; sf_ccall*   = 2; sf_ccall16* = 3;
  61.     sf_win64*   =  4; sf_systemv*   = 5; sf_windows* = 6; sf_linux*   = 7;
  62.     sf_code*    =  8; sf_oberon*    = 9;
  63.     sf_noalign* = 10;
  64.  
  65.     proc_flags* = {sf_stdcall, sf_stdcall64, sf_ccall, sf_ccall16, sf_win64, sf_systemv, sf_windows, sf_linux, sf_code, sf_oberon};
  66.     rec_flags*  = {sf_noalign};
  67.  
  68.     STACK_FRAME = 2;
  69.  
  70.  
  71. TYPE
  72.  
  73.     OPTIONS* = RECORD
  74.  
  75.         version*, stack*, ram*, rom*: INTEGER;
  76.         pic*, lower*: BOOLEAN;
  77.         checking*: SET
  78.  
  79.     END;
  80.  
  81.     IDENT* = POINTER TO rIDENT;
  82.  
  83.     UNIT* = POINTER TO rUNIT;
  84.  
  85.     _TYPE* = POINTER TO rTYPE;
  86.  
  87.     FRWPTR* = POINTER TO RECORD (LISTS.ITEM)
  88.  
  89.         _type:       _TYPE;
  90.         baseIdent:   SCAN.IDENT;
  91.         linked:      BOOLEAN;
  92.  
  93.         pos*:        SCAN.POSITION;
  94.         notRecord*:  BOOLEAN
  95.  
  96.     END;
  97.  
  98.     PROC* = POINTER TO RECORD (LISTS.ITEM)
  99.  
  100.         label*:      INTEGER;
  101.         used*:       BOOLEAN;
  102.         processed*:  BOOLEAN;
  103.         _import*:    LISTS.ITEM;
  104.         using*:      LISTS.LIST;
  105.         enter*,
  106.         leave*:      LISTS.ITEM
  107.  
  108.     END;
  109.  
  110.     USED_PROC = POINTER TO RECORD (LISTS.ITEM)
  111.  
  112.         proc: PROC
  113.  
  114.     END;
  115.  
  116.     rUNIT = RECORD (LISTS.ITEM)
  117.  
  118.         name*:       SCAN.IDENT;
  119.         idents*:     LISTS.LIST;
  120.         frwPointers: LISTS.LIST;
  121.         gscope:      IDENT;
  122.         closed*:     BOOLEAN;
  123.         scopeLvl*:   INTEGER;
  124.         sysimport*:  BOOLEAN;
  125.         scopes*:     ARRAY MAXSCOPE OF PROC
  126.  
  127.     END;
  128.  
  129.     FIELD* = POINTER TO rFIELD;
  130.  
  131.     PARAM* = POINTER TO rPARAM;
  132.  
  133.     rTYPE = RECORD (LISTS.ITEM)
  134.  
  135.         typ*:        INTEGER;
  136.         size*:       INTEGER;
  137.         parSize*:    INTEGER;
  138.         length*:     INTEGER;
  139.         align*:      INTEGER;
  140.         base*:       _TYPE;
  141.         fields*:     LISTS.LIST;
  142.         params*:     LISTS.LIST;
  143.         unit*:       UNIT;
  144.         closed*:     BOOLEAN;
  145.         num*:        INTEGER;
  146.         call*:       INTEGER;
  147.         _import*:    BOOLEAN;
  148.         noalign*:    BOOLEAN
  149.  
  150.     END;
  151.  
  152.     rFIELD = RECORD (LISTS.ITEM)
  153.  
  154.         _type*:      _TYPE;
  155.         name*:       SCAN.IDENT;
  156.         export*:     BOOLEAN;
  157.         offset*:     INTEGER
  158.  
  159.     END;
  160.  
  161.     rPARAM = RECORD (LISTS.ITEM)
  162.  
  163.         name*:       SCAN.IDENT;
  164.         _type*:      _TYPE;
  165.         vPar*:       BOOLEAN;
  166.         offset*:     INTEGER
  167.  
  168.     END;
  169.  
  170.     rIDENT = RECORD (LISTS.ITEM)
  171.  
  172.         name*:       SCAN.IDENT;
  173.         typ*:        INTEGER;
  174.         export*:     BOOLEAN;
  175.         _import*:    LISTS.ITEM;
  176.         unit*:       UNIT;
  177.         value*:      ARITH.VALUE;
  178.         _type*:      _TYPE;
  179.         stproc*:     INTEGER;
  180.         global*:     BOOLEAN;
  181.         scopeLvl*:   INTEGER;
  182.         offset*:     INTEGER;
  183.         proc*:       PROC;
  184.         pos*:        SCAN.POSITION
  185.  
  186.     END;
  187.  
  188.     PROGRAM = RECORD
  189.  
  190.         recCount:    INTEGER;
  191.         units*:      LISTS.LIST;
  192.         types*:      LISTS.LIST;
  193.         sysunit*:    UNIT;
  194.         rtl*:        UNIT;
  195.         bss*:        INTEGER;
  196.         locsize*:    INTEGER;
  197.  
  198.         procs*:      LISTS.LIST;
  199.  
  200.         sysflags*:   SET;
  201.         options*:    OPTIONS;
  202.  
  203.         stTypes*:    RECORD
  204.  
  205.             tINTEGER*, tBYTE*, tCHAR*, tWCHAR*, tSET*, tBOOLEAN*, tREAL*,
  206.             tSTRING*, tNIL*, tCARD32*, tANYREC*, tNONE*: _TYPE
  207.  
  208.         END
  209.  
  210.     END;
  211.  
  212.     DELIMPORT = PROCEDURE (_import: LISTS.ITEM);
  213.  
  214.  
  215. VAR
  216.  
  217.     LowerCase: BOOLEAN;
  218.     idents: C.COLLECTION;
  219.     program*: PROGRAM;
  220.  
  221.  
  222. PROCEDURE NewIdent (): IDENT;
  223. VAR
  224.     ident: IDENT;
  225.     citem: C.ITEM;
  226.  
  227. BEGIN
  228.     citem := C.pop(idents);
  229.     IF citem = NIL THEN
  230.         NEW(ident)
  231.     ELSE
  232.         ident := citem(IDENT)
  233.     END
  234.  
  235.     RETURN ident
  236. END NewIdent;
  237.  
  238.  
  239. PROCEDURE getOffset* (varIdent: IDENT): INTEGER;
  240. VAR
  241.     size: INTEGER;
  242.  
  243. BEGIN
  244.     IF varIdent.offset = -1 THEN
  245.         size := varIdent._type.size;
  246.         IF varIdent.global THEN
  247.             IF UTILS.Align(program.bss, varIdent._type.align) THEN
  248.                 IF UTILS.maxint - program.bss >= size THEN
  249.                     varIdent.offset := program.bss;
  250.                     INC(program.bss, size)
  251.                 END
  252.             END
  253.         ELSE
  254.             IF UTILS.Align(size, TARGETS.WordSize) THEN
  255.                 size := size DIV TARGETS.WordSize;
  256.                 IF UTILS.maxint - program.locsize >= size THEN
  257.                     INC(program.locsize, size);
  258.                     varIdent.offset := program.locsize
  259.                 END
  260.             END
  261.         END;
  262.  
  263.         IF varIdent.offset = -1 THEN
  264.             ERRORS.Error(204)
  265.         END
  266.     END
  267.  
  268.     RETURN varIdent.offset
  269. END getOffset;
  270.  
  271.  
  272. PROCEDURE closeUnit* (unit: UNIT);
  273. VAR
  274.     ident, prev: IDENT;
  275.     offset: INTEGER;
  276.  
  277. BEGIN
  278.     ident := unit.idents.last(IDENT);
  279.     WHILE (ident # NIL) & (ident.typ # idGUARD) DO
  280.         IF (ident.typ = idVAR) & (ident.offset = -1) THEN
  281.             ERRORS.HintMsg(ident.name.s, ident.pos.line, ident.pos.col, 0);
  282.             IF ident.export THEN
  283.                 offset := getOffset(ident)
  284.             END
  285.         END;
  286.         ident := ident.prev(IDENT)
  287.     END;
  288.  
  289.     ident := unit.idents.last(IDENT);
  290.     WHILE ident # NIL DO
  291.         prev := ident.prev(IDENT);
  292.         IF ~ident.export THEN
  293.             LISTS.delete(unit.idents, ident);
  294.             C.push(idents, ident)
  295.         END;
  296.         ident := prev
  297.     END;
  298.  
  299.     unit.closed := TRUE
  300. END closeUnit;
  301.  
  302.  
  303. PROCEDURE unique (unit: UNIT; ident: SCAN.IDENT): BOOLEAN;
  304. VAR
  305.     item: IDENT;
  306.  
  307. BEGIN
  308.     ASSERT(ident # NIL);
  309.  
  310.     item := unit.idents.last(IDENT);
  311.     WHILE (item.typ # idGUARD) & (item.name # ident) DO
  312.         item := item.prev(IDENT)
  313.     END
  314.  
  315.     RETURN item.typ = idGUARD
  316. END unique;
  317.  
  318.  
  319. PROCEDURE addIdent* (unit: UNIT; ident: SCAN.IDENT; typ: INTEGER): IDENT;
  320. VAR
  321.     item:  IDENT;
  322.     res:   BOOLEAN;
  323.     proc:  PROC;
  324.  
  325. BEGIN
  326.     ASSERT(unit # NIL);
  327.     ASSERT(ident # NIL);
  328.  
  329.     res := unique(unit, ident);
  330.  
  331.     IF res THEN
  332.         item := NewIdent();
  333.  
  334.         item.name    := ident;
  335.         item.typ     := typ;
  336.         item.unit    := NIL;
  337.         item.export  := FALSE;
  338.         item._import := NIL;
  339.         item._type   := NIL;
  340.         item.value.typ := 0;
  341.         item.stproc := 0;
  342.  
  343.         item.global := unit.scopeLvl = 0;
  344.         item.scopeLvl := unit.scopeLvl;
  345.         item.offset := -1;
  346.  
  347.         IF item.typ IN {idPROC, idIMP} THEN
  348.             NEW(proc);
  349.             proc._import := NIL;
  350.             proc.label := 0;
  351.             proc.used := FALSE;
  352.             proc.processed := FALSE;
  353.             proc.using := LISTS.create(NIL);
  354.             LISTS.push(program.procs, proc);
  355.             item.proc := proc
  356.         END;
  357.  
  358.         LISTS.push(unit.idents, item)
  359.     ELSE
  360.         item := NIL
  361.     END
  362.  
  363.     RETURN item
  364. END addIdent;
  365.  
  366.  
  367. PROCEDURE UseProc* (unit: UNIT; call_proc: PROC);
  368. VAR
  369.     procs: LISTS.LIST;
  370.     cur:   LISTS.ITEM;
  371.     proc:  USED_PROC;
  372.  
  373. BEGIN
  374.     IF unit.scopeLvl = 0 THEN
  375.         call_proc.used := TRUE
  376.     ELSE
  377.         procs := unit.scopes[unit.scopeLvl].using;
  378.  
  379.         cur := procs.first;
  380.         WHILE (cur # NIL) & (cur(USED_PROC).proc # call_proc) DO
  381.             cur := cur.next
  382.         END;
  383.  
  384.         IF cur = NIL THEN
  385.             NEW(proc);
  386.             proc.proc := call_proc;
  387.             LISTS.push(procs, proc)
  388.         END
  389.     END
  390. END UseProc;
  391.  
  392.  
  393. PROCEDURE setVarsType* (unit: UNIT; _type: _TYPE);
  394. VAR
  395.     item: IDENT;
  396.  
  397. BEGIN
  398.     ASSERT(_type # NIL);
  399.  
  400.     item := unit.idents.last(IDENT);
  401.     WHILE (item # NIL) & (item.typ = idVAR) & (item._type = NIL) DO
  402.         item._type := _type;
  403.         item := item.prev(IDENT)
  404.     END
  405. END setVarsType;
  406.  
  407.  
  408. PROCEDURE getIdent* (unit: UNIT; ident: SCAN.IDENT; currentScope: BOOLEAN): IDENT;
  409. VAR
  410.     item: IDENT;
  411.  
  412. BEGIN
  413.     ASSERT(ident # NIL);
  414.  
  415.     item := unit.idents.last(IDENT);
  416.  
  417.     IF item # NIL THEN
  418.  
  419.         IF currentScope THEN
  420.             WHILE (item.name # ident) & (item.typ # idGUARD) DO
  421.                 item := item.prev(IDENT)
  422.             END;
  423.             IF item.name # ident THEN
  424.                 item := NIL
  425.             END
  426.         ELSE
  427.             WHILE (item # NIL) & (item.name # ident) DO
  428.                 item := item.prev(IDENT)
  429.             END
  430.         END
  431.  
  432.     END
  433.  
  434.     RETURN item
  435. END getIdent;
  436.  
  437.  
  438. PROCEDURE openScope* (unit: UNIT; proc: PROC): BOOLEAN;
  439. VAR
  440.     item: IDENT;
  441.     res:  BOOLEAN;
  442.  
  443. BEGIN
  444.     INC(unit.scopeLvl);
  445.  
  446.     res := unit.scopeLvl < MAXSCOPE;
  447.  
  448.     IF res THEN
  449.  
  450.         unit.scopes[unit.scopeLvl] := proc;
  451.  
  452.         NEW(item);
  453.         item := NewIdent();
  454.  
  455.         item.name := NIL;
  456.         item.typ  := idGUARD;
  457.  
  458.         LISTS.push(unit.idents, item)
  459.     END
  460.  
  461.     RETURN res
  462. END openScope;
  463.  
  464.  
  465. PROCEDURE closeScope* (unit: UNIT; variables: LISTS.LIST);
  466. VAR
  467.     item: IDENT;
  468.     del:  IDENT;
  469.     lvar: IL.LOCALVAR;
  470.  
  471. BEGIN
  472.     item := unit.idents.last(IDENT);
  473.  
  474.     WHILE (item # NIL) & (item.typ # idGUARD) DO
  475.         del  := item;
  476.         item := item.prev(IDENT);
  477.         IF (del.typ = idVAR) & (del.offset = -1) THEN
  478.             ERRORS.HintMsg(del.name.s, del.pos.line, del.pos.col, 0)
  479.         END;
  480.         IF (variables # NIL) & (del.typ IN {idVAR, idPARAM}) & (del.offset # -1) THEN
  481.             IF del._type.typ IN BASICTYPES - {tREAL} + {tPOINTER, tPROCEDURE} THEN
  482.                 lvar := IL.NewVar();
  483.                 lvar.offset := del.offset;
  484.                 lvar.size   := del._type.size;
  485.                 IF del.typ = idVAR THEN
  486.                     lvar.offset := -lvar.offset
  487.                 END;
  488.                 LISTS.push(variables, lvar)
  489.             END
  490.         END;
  491.         LISTS.delete(unit.idents, del);
  492.         C.push(idents, del)
  493.     END;
  494.  
  495.     IF (item # NIL) & (item.typ = idGUARD) THEN
  496.         LISTS.delete(unit.idents, item);
  497.         C.push(idents, item)
  498.     END;
  499.  
  500.     DEC(unit.scopeLvl)
  501. END closeScope;
  502.  
  503.  
  504. PROCEDURE frwPtr* (unit: UNIT; _type: _TYPE; baseIdent: SCAN.IDENT; pos: SCAN.POSITION);
  505. VAR
  506.     newptr: FRWPTR;
  507.  
  508. BEGIN
  509.     ASSERT(unit # NIL);
  510.     ASSERT(_type # NIL);
  511.     ASSERT(baseIdent # NIL);
  512.  
  513.     NEW(newptr);
  514.  
  515.     newptr._type      := _type;
  516.     newptr.baseIdent := baseIdent;
  517.     newptr.pos       := pos;
  518.     newptr.linked    := FALSE;
  519.     newptr.notRecord := FALSE;
  520.  
  521.     LISTS.push(unit.frwPointers, newptr)
  522. END frwPtr;
  523.  
  524.  
  525. PROCEDURE linkPtr* (unit: UNIT): FRWPTR;
  526. VAR
  527.     item:  FRWPTR;
  528.     ident: IDENT;
  529.     res:   FRWPTR;
  530.  
  531. BEGIN
  532.     res  := NIL;
  533.     item := unit.frwPointers.last(FRWPTR);
  534.  
  535.     WHILE (item # NIL) & ~item.linked & (res = NIL) DO
  536.         ident := getIdent(unit, item.baseIdent, TRUE);
  537.  
  538.         IF (ident # NIL) THEN
  539.             IF (ident.typ = idTYPE) & (ident._type.typ = tRECORD) THEN
  540.                 item._type.base := ident._type;
  541.                 item.linked := TRUE
  542.             ELSE
  543.                 item.notRecord := TRUE;
  544.                 res := item
  545.             END
  546.         ELSE
  547.             item.notRecord := FALSE;
  548.             res := item
  549.         END;
  550.  
  551.         item := item.prev(FRWPTR)
  552.     END
  553.  
  554.     RETURN res
  555. END linkPtr;
  556.  
  557.  
  558. PROCEDURE isTypeEq* (t1, t2: _TYPE): BOOLEAN;
  559. VAR
  560.     res: BOOLEAN;
  561.     param1, param2: LISTS.ITEM;
  562.  
  563. BEGIN
  564.     IF t1 = t2 THEN
  565.         res := TRUE
  566.     ELSIF (t1 = NIL) OR (t2 = NIL) THEN
  567.         res := FALSE
  568.     ELSIF (t1.typ = tPROCEDURE) & (t2.typ = tPROCEDURE) THEN
  569.  
  570.         param1 := t1.params.first;
  571.         param2 := t2.params.first;
  572.  
  573.         res := ((t1.call = t2.call) OR (t1.call IN {code, _code}) OR (t2.call IN {code, _code})) & ((param1 # NIL) = (param2 # NIL));
  574.  
  575.         WHILE res & (param1 # NIL) & (param2 # NIL) DO
  576.             res := (param1(PARAM).vPar = param2(PARAM).vPar) & isTypeEq(param1(PARAM)._type, param2(PARAM)._type);
  577.             param1 := param1.next;
  578.             param2 := param2.next;
  579.             res := res & ((param1 # NIL) = (param2 # NIL))
  580.         END;
  581.  
  582.         res := res & isTypeEq(t1.base, t2.base)
  583.  
  584.     ELSIF (t1.typ = tARRAY) & (t2.typ = tARRAY) THEN
  585.         res := (t1.length = 0) & (t2.length = 0) & isTypeEq(t1.base, t2.base)
  586.     ELSE
  587.         res := FALSE
  588.     END
  589.  
  590.     RETURN res
  591. END isTypeEq;
  592.  
  593.  
  594. PROCEDURE isBaseOf* (t0, t1: _TYPE): BOOLEAN;
  595. VAR
  596.     res: BOOLEAN;
  597.  
  598. BEGIN
  599.     res := (t0.typ = t1.typ) & (t0.typ IN {tPOINTER, tRECORD});
  600.  
  601.     IF res & (t0.typ = tPOINTER) THEN
  602.         t0 := t0.base;
  603.         t1 := t1.base
  604.     END;
  605.  
  606.     IF res THEN
  607.         WHILE (t1 # NIL) & (t1 # t0) DO
  608.             t1 := t1.base
  609.         END;
  610.         res := t1 # NIL
  611.     END
  612.  
  613.     RETURN res
  614. END isBaseOf;
  615.  
  616.  
  617. PROCEDURE isOpenArray* (t: _TYPE): BOOLEAN;
  618.     RETURN (t.typ = tARRAY) & (t.length = 0)
  619. END isOpenArray;
  620.  
  621.  
  622. PROCEDURE arrcomp* (src, dst: _TYPE): BOOLEAN;
  623.     RETURN (dst.typ = tARRAY) & isOpenArray(src) &
  624.             ~isOpenArray(src.base) & ~isOpenArray(dst.base) &
  625.             isTypeEq(src.base, dst.base)
  626. END arrcomp;
  627.  
  628.  
  629. PROCEDURE getUnit* (name: SCAN.IDENT): UNIT;
  630. VAR
  631.     item: UNIT;
  632.  
  633. BEGIN
  634.     ASSERT(name # NIL);
  635.  
  636.     item := program.units.first(UNIT);
  637.  
  638.     WHILE (item # NIL) & (item.name # name) DO
  639.         item := item.next(UNIT)
  640.     END;
  641.  
  642.     IF (item = NIL) & ((name.s = "SYSTEM") OR LowerCase & (name.s = "system")) THEN
  643.         item := program.sysunit
  644.     END
  645.  
  646.     RETURN item
  647. END getUnit;
  648.  
  649.  
  650. PROCEDURE enterStTypes (unit: UNIT);
  651.  
  652.  
  653.     PROCEDURE enter (unit: UNIT; name: SCAN.LEXSTR; _type: _TYPE);
  654.     VAR
  655.         ident: IDENT;
  656.         upper: SCAN.LEXSTR;
  657.  
  658.     BEGIN
  659.         IF LowerCase THEN
  660.             ident := addIdent(unit, SCAN.enterid(name), idTYPE);
  661.             ident._type := _type
  662.         END;
  663.         upper := name;
  664.         STRINGS.UpCase(upper);
  665.         ident := addIdent(unit, SCAN.enterid(upper), idTYPE);
  666.         ident._type := _type
  667.     END enter;
  668.  
  669.  
  670. BEGIN
  671.     enter(unit, "integer", program.stTypes.tINTEGER);
  672.     enter(unit, "byte",    program.stTypes.tBYTE);
  673.     enter(unit, "char",    program.stTypes.tCHAR);
  674.     enter(unit, "set",     program.stTypes.tSET);
  675.     enter(unit, "boolean", program.stTypes.tBOOLEAN);
  676.  
  677.     IF TARGETS.RealSize # 0 THEN
  678.         enter(unit, "real", program.stTypes.tREAL)
  679.     END;
  680.  
  681.     IF TARGETS.BitDepth >= 32 THEN
  682.         enter(unit, "wchar", program.stTypes.tWCHAR)
  683.     END
  684. END enterStTypes;
  685.  
  686.  
  687. PROCEDURE enterStProcs (unit: UNIT);
  688.  
  689.  
  690.     PROCEDURE EnterProc (unit: UNIT; name: SCAN.LEXSTR; proc: INTEGER);
  691.     VAR
  692.         ident: IDENT;
  693.         upper: SCAN.LEXSTR;
  694.  
  695.     BEGIN
  696.         IF LowerCase THEN
  697.             ident := addIdent(unit, SCAN.enterid(name), idSTPROC);
  698.             ident.stproc := proc;
  699.             ident._type := program.stTypes.tNONE
  700.         END;
  701.         upper := name;
  702.         STRINGS.UpCase(upper);
  703.         ident := addIdent(unit, SCAN.enterid(upper), idSTPROC);
  704.         ident.stproc := proc;
  705.         ident._type := program.stTypes.tNONE
  706.     END EnterProc;
  707.  
  708.  
  709.     PROCEDURE EnterFunc (unit: UNIT; name: SCAN.LEXSTR; func: INTEGER);
  710.     VAR
  711.         ident: IDENT;
  712.         upper: SCAN.LEXSTR;
  713.  
  714.     BEGIN
  715.         IF LowerCase THEN
  716.             ident := addIdent(unit, SCAN.enterid(name), idSTFUNC);
  717.             ident.stproc := func;
  718.             ident._type := program.stTypes.tNONE
  719.         END;
  720.         upper := name;
  721.         STRINGS.UpCase(upper);
  722.         ident := addIdent(unit, SCAN.enterid(upper), idSTFUNC);
  723.         ident.stproc := func;
  724.         ident._type := program.stTypes.tNONE
  725.     END EnterFunc;
  726.  
  727.  
  728. BEGIN
  729.     EnterProc(unit, "assert", stASSERT);
  730.     EnterProc(unit, "dec",    stDEC);
  731.     EnterProc(unit, "excl",   stEXCL);
  732.     EnterProc(unit, "inc",    stINC);
  733.     EnterProc(unit, "incl",   stINCL);
  734.     EnterProc(unit, "new",    stNEW);
  735.     EnterProc(unit, "copy",   stCOPY);
  736.  
  737.     EnterFunc(unit, "abs",    stABS);
  738.     EnterFunc(unit, "asr",    stASR);
  739.     EnterFunc(unit, "chr",    stCHR);
  740.     EnterFunc(unit, "len",    stLEN);
  741.     EnterFunc(unit, "lsl",    stLSL);
  742.     EnterFunc(unit, "odd",    stODD);
  743.     EnterFunc(unit, "ord",    stORD);
  744.     EnterFunc(unit, "ror",    stROR);
  745.     EnterFunc(unit, "bits",   stBITS);
  746.     EnterFunc(unit, "lsr",    stLSR);
  747.     EnterFunc(unit, "length", stLENGTH);
  748.     EnterFunc(unit, "min",    stMIN);
  749.     EnterFunc(unit, "max",    stMAX);
  750.  
  751.     IF TARGETS.RealSize # 0 THEN
  752.         EnterProc(unit, "pack",  stPACK);
  753.         EnterProc(unit, "unpk",  stUNPK);
  754.         EnterFunc(unit, "floor", stFLOOR);
  755.         EnterFunc(unit, "flt",   stFLT)
  756.     END;
  757.  
  758.     IF TARGETS.BitDepth >= 32 THEN
  759.         EnterFunc(unit, "wchr", stWCHR)
  760.     END;
  761.  
  762.     IF TARGETS.Dispose THEN
  763.         EnterProc(unit, "dispose", stDISPOSE)
  764.     END
  765.  
  766. END enterStProcs;
  767.  
  768.  
  769. PROCEDURE newUnit* (name: SCAN.IDENT): UNIT;
  770. VAR
  771.     unit: UNIT;
  772.  
  773. BEGIN
  774.     ASSERT(name # NIL);
  775.  
  776.     NEW(unit);
  777.  
  778.     unit.name        := name;
  779.     unit.closed      := FALSE;
  780.     unit.idents      := LISTS.create(NIL);
  781.     unit.frwPointers := LISTS.create(NIL);
  782.  
  783.     ASSERT(openScope(unit, NIL));
  784.  
  785.     enterStTypes(unit);
  786.     enterStProcs(unit);
  787.  
  788.     ASSERT(openScope(unit, NIL));
  789.  
  790.     unit.gscope := unit.idents.last(IDENT);
  791.  
  792.     LISTS.push(program.units, unit);
  793.  
  794.     unit.scopeLvl := 0;
  795.     unit.scopes[0] := NIL;
  796.  
  797.     unit.sysimport := FALSE;
  798.  
  799.     IF unit.name.s = UTILS.RTL_NAME THEN
  800.         program.rtl := unit
  801.     END
  802.  
  803.     RETURN unit
  804. END newUnit;
  805.  
  806.  
  807. PROCEDURE getField* (self: _TYPE; name: SCAN.IDENT; unit: UNIT): FIELD;
  808. VAR
  809.     field: FIELD;
  810.  
  811. BEGIN
  812.     ASSERT(self # NIL);
  813.     ASSERT(name # NIL);
  814.     ASSERT(unit # NIL);
  815.  
  816.     field := NIL;
  817.     WHILE (self # NIL) & (field = NIL) DO
  818.  
  819.         field := self.fields.first(FIELD);
  820.  
  821.         WHILE (field # NIL) & (field.name # name) DO
  822.             field := field.next(FIELD)
  823.         END;
  824.  
  825.         IF field = NIL THEN
  826.             self := self.base
  827.         END
  828.  
  829.     END;
  830.  
  831.     IF (field # NIL) & (self.unit # unit) & ~field.export THEN
  832.         field := NIL
  833.     END
  834.  
  835.     RETURN field
  836. END getField;
  837.  
  838.  
  839. PROCEDURE addField* (self: _TYPE; name: SCAN.IDENT; export: BOOLEAN): BOOLEAN;
  840. VAR
  841.     field: FIELD;
  842.     res:   BOOLEAN;
  843.  
  844. BEGIN
  845.     ASSERT(name # NIL);
  846.  
  847.     res := getField(self, name, self.unit) = NIL;
  848.  
  849.     IF res THEN
  850.         NEW(field);
  851.  
  852.         field.name   := name;
  853.         field.export := export;
  854.         field._type  := NIL;
  855.         field.offset := self.size;
  856.  
  857.         LISTS.push(self.fields, field)
  858.     END
  859.  
  860.     RETURN res
  861. END addField;
  862.  
  863.  
  864. PROCEDURE setFields* (self: _TYPE; _type: _TYPE): BOOLEAN;
  865. VAR
  866.     item: FIELD;
  867.     res:  BOOLEAN;
  868.  
  869. BEGIN
  870.     ASSERT(_type # NIL);
  871.  
  872.     item := self.fields.first(FIELD);
  873.  
  874.     WHILE (item # NIL) & (item._type # NIL) DO
  875.         item := item.next(FIELD)
  876.     END;
  877.  
  878.     res := TRUE;
  879.  
  880.     WHILE res & (item # NIL) & (item._type = NIL) DO
  881.         item._type := _type;
  882.         IF ~self.noalign THEN
  883.             res := UTILS.Align(self.size, _type.align)
  884.         ELSE
  885.             res := TRUE
  886.         END;
  887.         item.offset := self.size;
  888.         res := res & (UTILS.maxint - self.size >= _type.size);
  889.         IF res THEN
  890.             INC(self.size, _type.size)
  891.         END;
  892.         item := item.next(FIELD)
  893.     END
  894.  
  895.     RETURN res
  896. END setFields;
  897.  
  898.  
  899. PROCEDURE getParam* (self: _TYPE; name: SCAN.IDENT): PARAM;
  900. VAR
  901.     item: PARAM;
  902.  
  903. BEGIN
  904.     ASSERT(name # NIL);
  905.  
  906.     item := self.params.first(PARAM);
  907.  
  908.     WHILE (item # NIL) & (item.name # name) DO
  909.         item := item.next(PARAM)
  910.     END
  911.  
  912.     RETURN item
  913. END getParam;
  914.  
  915.  
  916. PROCEDURE addParam* (self: _TYPE; name: SCAN.IDENT; vPar: BOOLEAN): BOOLEAN;
  917. VAR
  918.     param: PARAM;
  919.     res:   BOOLEAN;
  920.  
  921. BEGIN
  922.     ASSERT(name # NIL);
  923.  
  924.     res := getParam(self, name) = NIL;
  925.  
  926.     IF res THEN
  927.         NEW(param);
  928.  
  929.         param.name  := name;
  930.         param._type := NIL;
  931.         param.vPar  := vPar;
  932.  
  933.         LISTS.push(self.params, param)
  934.     END
  935.  
  936.     RETURN res
  937. END addParam;
  938.  
  939.  
  940. PROCEDURE Dim* (t: _TYPE): INTEGER;
  941. VAR
  942.     res: INTEGER;
  943.  
  944. BEGIN
  945.     res := 0;
  946.     WHILE isOpenArray(t) DO
  947.         t := t.base;
  948.         INC(res)
  949.     END
  950.     RETURN res
  951. END Dim;
  952.  
  953.  
  954. PROCEDURE OpenBase* (t: _TYPE): _TYPE;
  955. BEGIN
  956.     WHILE isOpenArray(t) DO t := t.base END
  957.     RETURN t
  958. END OpenBase;
  959.  
  960.  
  961. PROCEDURE getFloatParamsPos* (self: _TYPE; maxoffs: INTEGER; VAR int, flt: INTEGER): SET;
  962. VAR
  963.     res: SET;
  964.     param: PARAM;
  965.  
  966. BEGIN
  967.     res := {};
  968.     int := 0;
  969.     flt := 0;
  970.     param := self.params.first(PARAM);
  971.     WHILE (param # NIL) & (param.offset <= maxoffs + STACK_FRAME) DO
  972.         IF ~param.vPar & (param._type.typ = tREAL) THEN
  973.             INCL(res, param.offset - STACK_FRAME);
  974.             INC(flt)
  975.         END;
  976.         param := param.next(PARAM)
  977.     END;
  978.  
  979.     int := self.parSize - flt
  980.  
  981.     RETURN res
  982. END getFloatParamsPos;
  983.  
  984.  
  985. PROCEDURE setParams* (self: _TYPE; _type: _TYPE);
  986. VAR
  987.     item: LISTS.ITEM;
  988.     param: PARAM;
  989.     word, size: INTEGER;
  990.  
  991. BEGIN
  992.     ASSERT(_type # NIL);
  993.  
  994.     word := UTILS.target.bit_depth DIV 8;
  995.  
  996.     item := self.params.first;
  997.  
  998.     WHILE (item # NIL) & (item(PARAM)._type # NIL) DO
  999.         item := item.next
  1000.     END;
  1001.  
  1002.     WHILE (item # NIL) & (item(PARAM)._type = NIL) DO
  1003.         param := item(PARAM);
  1004.         param._type := _type;
  1005.         IF param.vPar THEN
  1006.             IF _type.typ = tRECORD THEN
  1007.                 size := 2
  1008.             ELSIF isOpenArray(_type) THEN
  1009.                 size := Dim(_type) + 1
  1010.             ELSE
  1011.                 size := 1
  1012.             END;
  1013.             param.offset := self.parSize + ORD(_type.typ = tRECORD) + Dim(_type) + STACK_FRAME;
  1014.             INC(self.parSize, size)
  1015.         ELSE
  1016.             IF _type.typ IN {tRECORD, tARRAY} THEN
  1017.                 IF isOpenArray(_type) THEN
  1018.                     size := Dim(_type) + 1
  1019.                 ELSE
  1020.                     size := 1
  1021.                 END
  1022.             ELSE
  1023.                 size := _type.size;
  1024.                 ASSERT(UTILS.Align(size, word));
  1025.                 size := size DIV word
  1026.             END;
  1027.             param.offset := self.parSize + Dim(_type) + STACK_FRAME;
  1028.             INC(self.parSize, size)
  1029.         END;
  1030.  
  1031.         item := item.next
  1032.     END
  1033.  
  1034. END setParams;
  1035.  
  1036.  
  1037. PROCEDURE enterType* (typ, size, length: INTEGER; unit: UNIT): _TYPE;
  1038. VAR
  1039.     t: _TYPE;
  1040.  
  1041. BEGIN
  1042.     NEW(t);
  1043.  
  1044.     t.typ     := typ;
  1045.     t.size    := size;
  1046.     t.length  := length;
  1047.     t.align   := 0;
  1048.     t.base    := NIL;
  1049.     t.fields  := LISTS.create(NIL);
  1050.     t.params  := LISTS.create(NIL);
  1051.     t.unit    := unit;
  1052.     t.num     := 0;
  1053.  
  1054.     CASE TARGETS.BitDepth OF
  1055.     |16: t.call := default16
  1056.     |32: t.call := default32
  1057.     |64: t.call := default64
  1058.     END;
  1059.  
  1060.     t._import := FALSE;
  1061.     t.noalign := FALSE;
  1062.     t.parSize := 0;
  1063.  
  1064.     IF typ IN {tARRAY, tRECORD} THEN
  1065.         t.closed := FALSE;
  1066.         IF typ = tRECORD THEN
  1067.             INC(program.recCount);
  1068.             t.num := program.recCount
  1069.         END
  1070.     ELSE
  1071.         t.closed := TRUE
  1072.     END;
  1073.  
  1074.     LISTS.push(program.types, t)
  1075.  
  1076.     RETURN t
  1077. END enterType;
  1078.  
  1079.  
  1080. PROCEDURE getType* (typ: INTEGER): _TYPE;
  1081. VAR
  1082.     res: _TYPE;
  1083.  
  1084. BEGIN
  1085.  
  1086.     CASE typ OF
  1087.     |ARITH.tINTEGER: res := program.stTypes.tINTEGER
  1088.     |ARITH.tREAL:    res := program.stTypes.tREAL
  1089.     |ARITH.tSET:     res := program.stTypes.tSET
  1090.     |ARITH.tBOOLEAN: res := program.stTypes.tBOOLEAN
  1091.     |ARITH.tCHAR:    res := program.stTypes.tCHAR
  1092.     |ARITH.tWCHAR:   res := program.stTypes.tWCHAR
  1093.     |ARITH.tSTRING:  res := program.stTypes.tSTRING
  1094.     END
  1095.  
  1096.     RETURN res
  1097. END getType;
  1098.  
  1099.  
  1100. PROCEDURE createSysUnit;
  1101. VAR
  1102.     ident: IDENT;
  1103.     unit:  UNIT;
  1104.  
  1105.  
  1106.     PROCEDURE EnterProc (sys: UNIT; name: SCAN.LEXSTR; idtyp, proc: INTEGER);
  1107.     VAR
  1108.         ident: IDENT;
  1109.         upper: SCAN.LEXSTR;
  1110.  
  1111.     BEGIN
  1112.         IF LowerCase THEN
  1113.             ident := addIdent(sys, SCAN.enterid(name), idtyp);
  1114.             ident.stproc := proc;
  1115.             ident._type := program.stTypes.tNONE;
  1116.             ident.export := TRUE
  1117.         END;
  1118.         upper := name;
  1119.         STRINGS.UpCase(upper);
  1120.         ident := addIdent(sys, SCAN.enterid(upper), idtyp);
  1121.         ident.stproc := proc;
  1122.         ident._type := program.stTypes.tNONE;
  1123.         ident.export := TRUE
  1124.     END EnterProc;
  1125.  
  1126.  
  1127. BEGIN
  1128.     unit := newUnit(SCAN.enterid("$SYSTEM"));
  1129.  
  1130.     EnterProc(unit, "adr",    idSYSFUNC, sysADR);
  1131.     EnterProc(unit, "size",   idSYSFUNC, sysSIZE);
  1132.     EnterProc(unit, "sadr",   idSYSFUNC, sysSADR);
  1133.     EnterProc(unit, "typeid", idSYSFUNC, sysTYPEID);
  1134.  
  1135.     EnterProc(unit, "get",    idSYSPROC, sysGET);
  1136.     EnterProc(unit, "get8",   idSYSPROC, sysGET8);
  1137.     EnterProc(unit, "put",    idSYSPROC, sysPUT);
  1138.     EnterProc(unit, "put8",   idSYSPROC, sysPUT8);
  1139.     EnterProc(unit, "code",   idSYSPROC, sysCODE);
  1140.     EnterProc(unit, "move",   idSYSPROC, sysMOVE);
  1141.            (*
  1142.     IF program.target.sys = mConst.Target_iMSP430 THEN
  1143.         EnterProc(unit, "nop",  idSYSPROC, sysNOP);
  1144.         EnterProc(unit, "eint", idSYSPROC, sysEINT);
  1145.         EnterProc(unit, "dint", idSYSPROC, sysDINT)
  1146.     END;
  1147.          *)
  1148.     IF TARGETS.RealSize # 0 THEN
  1149.         EnterProc(unit, "inf",    idSYSFUNC, sysINF);
  1150.     END;
  1151.  
  1152.     IF TARGETS.CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64} THEN
  1153.         EnterProc(unit, "copy",   idSYSPROC, sysCOPY)
  1154.     END;
  1155.  
  1156.     IF TARGETS.BitDepth >= 32 THEN
  1157.         EnterProc(unit, "wsadr",  idSYSFUNC, sysWSADR);
  1158.         EnterProc(unit, "put16",  idSYSPROC, sysPUT16);
  1159.         EnterProc(unit, "put32",  idSYSPROC, sysPUT32);
  1160.         EnterProc(unit, "get16",  idSYSPROC, sysGET16);
  1161.         EnterProc(unit, "get32",  idSYSPROC, sysGET32);
  1162.  
  1163.         IF LowerCase THEN
  1164.             ident := addIdent(unit, SCAN.enterid("card32"), idTYPE);
  1165.             ident._type := program.stTypes.tCARD32;
  1166.             ident.export := TRUE
  1167.         END;
  1168.         ident := addIdent(unit, SCAN.enterid("CARD32"), idTYPE);
  1169.         ident._type := program.stTypes.tCARD32;
  1170.         ident.export := TRUE;
  1171.     END;
  1172.  
  1173.     closeUnit(unit);
  1174.  
  1175.     program.sysunit := unit
  1176. END createSysUnit;
  1177.  
  1178.  
  1179. PROCEDURE DelUnused* (DelImport: DELIMPORT);
  1180. VAR
  1181.     proc: PROC;
  1182.     flag: BOOLEAN;
  1183.  
  1184.  
  1185.     PROCEDURE process (proc: PROC);
  1186.     VAR
  1187.         used_proc: LISTS.ITEM;
  1188.  
  1189.     BEGIN
  1190.         proc.processed := TRUE;
  1191.  
  1192.         used_proc := proc.using.first;
  1193.         WHILE used_proc # NIL DO
  1194.             used_proc(USED_PROC).proc.used := TRUE;
  1195.             used_proc := used_proc.next
  1196.         END
  1197.  
  1198.     END process;
  1199.  
  1200.  
  1201. BEGIN
  1202.  
  1203.     REPEAT
  1204.         flag := FALSE;
  1205.         proc := program.procs.first(PROC);
  1206.  
  1207.         WHILE proc # NIL DO
  1208.             IF proc.used & ~proc.processed THEN
  1209.                 process(proc);
  1210.                 flag := TRUE
  1211.             END;
  1212.             proc := proc.next(PROC)
  1213.         END
  1214.  
  1215.     UNTIL ~flag;
  1216.  
  1217.     proc := program.procs.first(PROC);
  1218.  
  1219.     WHILE proc # NIL DO
  1220.         IF ~proc.used THEN
  1221.             IF proc._import = NIL THEN
  1222.                 IL.delete2(proc.enter, proc.leave)
  1223.             ELSE
  1224.                 DelImport(proc._import)
  1225.             END
  1226.         END;
  1227.         proc := proc.next(PROC)
  1228.     END
  1229.  
  1230. END DelUnused;
  1231.  
  1232.  
  1233. PROCEDURE ResetLocSize*;
  1234. BEGIN
  1235.     program.locsize := 0
  1236. END ResetLocSize;
  1237.  
  1238.  
  1239. PROCEDURE create* (options: OPTIONS);
  1240. BEGIN
  1241.     LowerCase := options.lower;
  1242.     SCAN.init(options.lower);
  1243.     idents := C.create();
  1244.  
  1245.     UTILS.SetBitDepth(TARGETS.BitDepth, TARGETS.RealSize = 8);
  1246.  
  1247.     program.options := options;
  1248.  
  1249.     CASE TARGETS.OS OF
  1250.     |TARGETS.osWIN32:    program.sysflags := {sf_oberon, sf_windows, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign}
  1251.     |TARGETS.osLINUX32:  program.sysflags := {sf_oberon, sf_linux, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign}
  1252.     |TARGETS.osKOS:      program.sysflags := {sf_oberon, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign}
  1253.     |TARGETS.osWIN64:    program.sysflags := {sf_oberon, sf_windows, sf_stdcall64, sf_win64, sf_systemv, sf_noalign}
  1254.     |TARGETS.osLINUX64:  program.sysflags := {sf_oberon, sf_linux, sf_stdcall64, sf_win64, sf_systemv, sf_noalign}
  1255.     |TARGETS.osNONE:     program.sysflags := {sf_code}
  1256.     END;
  1257.  
  1258.     program.recCount := -1;
  1259.     program.bss := 0;
  1260.  
  1261.     program.units := LISTS.create(NIL);
  1262.     program.types := LISTS.create(NIL);
  1263.     program.procs := LISTS.create(NIL);
  1264.  
  1265.     program.stTypes.tINTEGER := enterType(tINTEGER, TARGETS.WordSize, 0, NIL);
  1266.     program.stTypes.tBYTE    := enterType(tBYTE,                   1, 0, NIL);
  1267.     program.stTypes.tCHAR    := enterType(tCHAR,                   1, 0, NIL);
  1268.     program.stTypes.tSET     := enterType(tSET,     TARGETS.WordSize, 0, NIL);
  1269.     program.stTypes.tBOOLEAN := enterType(tBOOLEAN,                1, 0, NIL);
  1270.  
  1271.     program.stTypes.tINTEGER.align := TARGETS.WordSize;
  1272.     program.stTypes.tBYTE.align    := 1;
  1273.     program.stTypes.tCHAR.align    := 1;
  1274.     program.stTypes.tSET.align     := TARGETS.WordSize;
  1275.     program.stTypes.tBOOLEAN.align := 1;
  1276.  
  1277.     IF TARGETS.BitDepth >= 32 THEN
  1278.         program.stTypes.tWCHAR  := enterType(tWCHAR,  2, 0, NIL);
  1279.         program.stTypes.tCARD32 := enterType(tCARD32, 4, 0, NIL);
  1280.         program.stTypes.tWCHAR.align  := 2;
  1281.         program.stTypes.tCARD32.align := 4
  1282.     END;
  1283.  
  1284.     IF TARGETS.RealSize # 0 THEN
  1285.         program.stTypes.tREAL := enterType(tREAL, TARGETS.RealSize, 0, NIL);
  1286.         program.stTypes.tREAL.align := TARGETS.RealSize
  1287.     END;
  1288.  
  1289.     program.stTypes.tSTRING := enterType(tSTRING, TARGETS.WordSize, 0, NIL);
  1290.     program.stTypes.tNIL    := enterType(tNIL,    TARGETS.WordSize, 0, NIL);
  1291.     program.stTypes.tNONE   := enterType(tNONE,   0, 0, NIL);
  1292.     program.stTypes.tANYREC := enterType(tRECORD, 0, 0, NIL);
  1293.     program.stTypes.tANYREC.closed := TRUE;
  1294.  
  1295.     createSysUnit
  1296. END create;
  1297.  
  1298.  
  1299. END PROG.