Subversion Repositories Kolibri OS

Rev

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

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