WebSVN – Kolibri OS – Diff – /programs/develop/oberon07/Source/PROG.ob07

     All rights reserved.
 *)
 MODULE PROG;
-IMPORT SCAN, LISTS, ARITH, ERRORS, MACHINE, C := COLLECTIONS, mConst := CONSTANTS, CODE, UTILS;
+IMPORT SCAN, LISTS, ARITH, ERRORS, C := COLLECTIONS, mConst := CONSTANTS, IL, UTILS;
     stDISPOSE* = 23;  stLSR*     = 24;  stBITS*  = 25;  sysCODE*  = 26;
     sysMOVE*   = 27;  stLENGTH*  = 28;  stMIN*   = 29;  stMAX*    = 30;
     sysSADR*   = 31;  sysTYPEID* = 32;  sysCOPY* = 33;  sysINF*   = 34;
     sysPUT8*   = 35;  sysPUT16*  = 36;  stCOPY*  = 37;  stWCHR*   = 38;
+    sysWSADR*  = 39;  sysPUT32*  = 40;  (*sysNOP*  = 41;  sysEINT*  = 42;
-    sysWSADR*  = 39;  sysPUT32*  = 40;
+    sysDINT*   = 43;*)
-    default*   =  2;
+    default32* =  2;
     stdcall*   =  4;  _stdcall*   = stdcall + 1;
     ccall*     =  6;  _ccall*     = ccall + 1;
     ccall16*   =  8;  _ccall16*   = ccall16 + 1;
     win64*     = 10;  _win64*     = win64 + 1;
     stdcall64* = 12;  _stdcall64* = stdcall64 + 1;
+    default64* = 14;
+    systemv*   = 16;  _systemv*   = systemv + 1;
-    default64* = 14;
+    default16* = 18;
-    systemv*   = 16;  _systemv*   = systemv + 1;
+    code*      = 20;  _code*      = code + 1;
+    noalign* = 22;
-    noalign* = 20;
+    callee_clean_up* = {default32, stdcall, _stdcall, default64, stdcall64, _stdcall64};
+    sf_stdcall* = 0; sf_stdcall64* = 1; sf_ccall*   = 2; sf_ccall16* = 3;
+    sf_win64*   = 4; sf_systemv*   = 5; sf_windows* = 6; sf_linux*   = 7;
+    sf_code*    = 8;
-    callee_clean_up* = {default, stdcall, _stdcall, default64, stdcall64, _stdcall64};
+    sf_noalign* = 9;
     caller_clean_up* = {ccall, ccall16, win64, systemv, _ccall, _ccall16, _win64, _systemv};
+    proc_flags* = {sf_stdcall, sf_stdcall64, sf_ccall, sf_ccall16, sf_win64, sf_systemv, sf_windows, sf_linux, sf_code};
+    rec_flags*  = {sf_noalign};
+    STACK_FRAME = 2;
+TYPE
-    callconv32* = {default, stdcall, ccall, ccall16, _stdcall, _ccall, _ccall16};
+    OPTIONS* = RECORD
     callconv64* = {default64, win64, stdcall64, systemv, _win64, _stdcall64, _systemv};
         version*, stack*, base*, ram*, rom*: INTEGER;
         pos*:        SCAN.POSITION;
         notRecord*:  BOOLEAN
-    END;
-    IDENTS = POINTER TO RECORD (LISTS.LIST)
-        add*:   PROCEDURE (unit: UNIT; ident: SCAN.IDENT; typ: INTEGER): IDENT;
-        get*:   PROCEDURE (unit: UNIT; ident: SCAN.IDENT; currentScope: BOOLEAN): IDENT
     END;
     PROC* = POINTER TO RECORD (LISTS.ITEM)
     rUNIT = RECORD (LISTS.ITEM)
         program*:    PROGRAM;
         name*:       SCAN.IDENT;
-        idents*:     IDENTS;
+        idents*:     LISTS.LIST;
         frwPointers: LISTS.LIST;
         gscope:      IDENT;
         closed*:     BOOLEAN;
-        scopeLvl*:   INTEGER;
-        sysimport*:  BOOLEAN;
+        scopeLvl*:   INTEGER;
-        scopes*:     ARRAY MAXSCOPE OF PROC;
-        scope*:      RECORD
-            open*:   PROCEDURE (unit: UNIT; proc: PROC): BOOLEAN;
-            close*:  PROCEDURE (unit: UNIT; variables: LISTS.LIST)
-        END;
-        close*:      PROCEDURE (unit: UNIT);
-        setvars*:    PROCEDURE (unit: UNIT; type: TYPE_);
-        pointers*:   RECORD
-            add*:    PROCEDURE (unit: UNIT; type: TYPE_; baseIdent: SCAN.IDENT; pos: SCAN.POSITION);
-            link*:   PROCEDURE (unit: UNIT): FRWPTR
         sysimport*:  BOOLEAN;
-        END
+        scopes*:     ARRAY MAXSCOPE OF PROC
-    END;
-    FIELD* = POINTER TO rFIELD;
-    PARAM* = POINTER TO rPARAM;
-    FIELDS = POINTER TO RECORD (LISTS.LIST)
-        add*:        PROCEDURE (rec: TYPE_; name: SCAN.IDENT; export: BOOLEAN): BOOLEAN;
-        get*:        PROCEDURE (rec: TYPE_; name: SCAN.IDENT; unit: UNIT): FIELD;
-        set*:        PROCEDURE (rec: TYPE_; type: TYPE_): BOOLEAN
-    END;
-    PARAMS = POINTER TO RECORD (LISTS.LIST)
-        size*:       INTEGER;
-        add*:        PROCEDURE (proc: TYPE_; name: SCAN.IDENT; vPar: BOOLEAN): BOOLEAN;
-        get*:        PROCEDURE (proc: TYPE_; name: SCAN.IDENT): PARAM;
+    END;
         set*:        PROCEDURE (proc: TYPE_; type: TYPE_);
-        getfparams*: PROCEDURE (proc: TYPE_; maxparam: INTEGER; VAR int, flt: INTEGER): SET
+    FIELD* = POINTER TO rFIELD;
     PARAM* = POINTER TO rPARAM;
     END;
     rTYPE_ = RECORD (LISTS.ITEM)
-    rTYPE_ = RECORD (LISTS.ITEM)
+        typ*:        INTEGER;
-        typ*:        INTEGER;
+        size*:       INTEGER;
-        size*:       INTEGER;
+        parSize*:    INTEGER;
         length*:     INTEGER;
         align*:      INTEGER;
         base*:       TYPE_;
         proc*:       PROC;
         pos*:        SCAN.POSITION
-    END;
-    UNITS* = POINTER TO RECORD (LISTS.LIST)
-        program:     PROGRAM;
-        create*:     PROCEDURE (units: UNITS; name: SCAN.IDENT): UNIT;
-        get*:        PROCEDURE (units: UNITS; name: SCAN.IDENT): UNIT
     END;
     rPROGRAM = RECORD
         recCount:    INTEGER;
-        units*:      UNITS;
+        units*:      LISTS.LIST;
         types*:      LISTS.LIST;
         sysunit*:    UNIT;
         dll*:        BOOLEAN;
         obj*:        BOOLEAN;
-        stTypes*:     RECORD
+        stTypes*:    RECORD
-            tINTEGER*, tBYTE*, tCHAR*, tWCHAR*, tSET*, tBOOLEAN*, tREAL*, tSTRING*, tNIL*,
+            tINTEGER*, tBYTE*, tCHAR*, tWCHAR*, tSET*, tBOOLEAN*, tREAL*,
-            tCARD16*, tCARD32*, tANYREC*: TYPE_
+            tSTRING*, tNIL*, tCARD16*, tCARD32*, tANYREC*: TYPE_
         END;
         target*:     RECORD
+            bit_depth*:  INTEGER;
+            word*:       INTEGER;
-            bit_depth*:  INTEGER;
-            word*:       INTEGER;
-            adr*:        INTEGER;
-            sys*:        INTEGER
+            adr*:        INTEGER;
             sys*:        INTEGER;
     size: INTEGER;
 BEGIN
     IF varIdent.offset = -1 THEN
         IF varIdent.global THEN
-            IF MACHINE.Align(program.bss, varIdent.type.align) THEN
+            IF UTILS.Align(program.bss, varIdent.type.align) THEN
                 IF UTILS.maxint - program.bss >= varIdent.type.size THEN
                     varIdent.offset := program.bss;
                     INC(program.bss, varIdent.type.size)
                 END
             END
         ELSE
             word := program.target.word;
             size := varIdent.type.size;
-            IF MACHINE.Align(size, word) THEN
+            IF UTILS.Align(size, word) THEN
                 size := size DIV word;
                 IF UTILS.maxint - program.locsize >= size THEN
                     INC(program.locsize, size);
                     varIdent.offset := program.locsize;
     RETURN varIdent.offset
 END getOffset;
-PROCEDURE close (unit: UNIT);
+PROCEDURE closeUnit* (unit: UNIT);
 VAR
     ident, prev: IDENT;
     offset: INTEGER;
 BEGIN
     ident := unit.idents.last(IDENT);
     WHILE (ident # NIL) & (ident.typ # idGUARD) DO
         IF (ident.typ = idVAR) & (ident.offset = -1) THEN
-            ERRORS.hintmsg(ident.name.s, ident.pos.line, ident.pos.col, 0);
+            ERRORS.HintMsg(ident.name.s, ident.pos.line, ident.pos.col, 0);
             IF ident.export THEN
         END;
         ident := prev
     END;
     unit.closed := TRUE
-END close;
+END closeUnit;
     RETURN item.typ = idGUARD
 END unique;
-PROCEDURE addIdent (unit: UNIT; ident: SCAN.IDENT; typ: INTEGER): IDENT;
+PROCEDURE addIdent* (unit: UNIT; ident: SCAN.IDENT; typ: INTEGER): IDENT;
 VAR
-    item:   IDENT;
+    item:  IDENT;
         END
     END
 END UseProc;
-PROCEDURE setvars (unit: UNIT; type: TYPE_);
+PROCEDURE setVarsType* (unit: UNIT; type: TYPE_);
 VAR
     item: IDENT;
     item := unit.idents.last(IDENT);
     WHILE (item # NIL) & (item.typ = idVAR) & (item.type = NIL) DO
         item.type := type;
         item := item.prev(IDENT)
     END
-END setvars;
+END setVarsType;
-PROCEDURE getIdent (unit: UNIT; ident: SCAN.IDENT; currentScope: BOOLEAN): IDENT;
+PROCEDURE getIdent* (unit: UNIT; ident: SCAN.IDENT; currentScope: BOOLEAN): IDENT;
 VAR
     item: IDENT;
 BEGIN
     ASSERT(ident # NIL);
     item := unit.idents.last(IDENT);
-        WHILE (item # NIL) & (item.name # ident) DO
+            WHILE (item # NIL) & (item.name # ident) DO
-            item := item.prev(IDENT)
+                item := item.prev(IDENT)
-        END
+            END
-    END
+        END
+    END
     RETURN item
 END getIdent;
-PROCEDURE openScope (unit: UNIT; proc: PROC): BOOLEAN;
+PROCEDURE openScope* (unit: UNIT; proc: PROC): BOOLEAN;
 VAR
     RETURN res
 END openScope;
-PROCEDURE closeScope (unit: UNIT; variables: LISTS.LIST);
+PROCEDURE closeScope* (unit: UNIT; variables: LISTS.LIST);
 VAR
     item: IDENT;
     del:  IDENT;
-    lvar: CODE.LOCALVAR;
+    lvar: IL.LOCALVAR;
 BEGIN
     item := unit.idents.last(IDENT);
     WHILE (item # NIL) & (item.typ # idGUARD) DO
         del  := item;
         item := item.prev(IDENT);
         IF (del.typ = idVAR) & (del.offset = -1) THEN
-            ERRORS.hintmsg(del.name.s, del.pos.line, del.pos.col, 0)
+            ERRORS.HintMsg(del.name.s, del.pos.line, del.pos.col, 0)
         END;
         IF (variables # NIL) & (del.typ IN {idVAR, idPARAM}) & (del.offset # -1) THEN
             IF del.type.typ IN BASICTYPES - {tREAL} + {tPOINTER, tPROCEDURE} THEN
-                lvar := CODE.NewVar();
+                lvar := IL.NewVar();
     DEC(unit.scopeLvl)
 END closeScope;
-PROCEDURE frwptr (unit: UNIT; type: TYPE_; baseIdent: SCAN.IDENT; pos: SCAN.POSITION);
+PROCEDURE frwPtr* (unit: UNIT; type: TYPE_; baseIdent: SCAN.IDENT; pos: SCAN.POSITION);
 VAR
-    newptr.pos        := pos;
+    newptr.pos       := pos;
-    newptr.linked     := FALSE;
+    newptr.linked    := FALSE;
-    newptr.notRecord  := FALSE;
+    newptr.notRecord := FALSE;
     LISTS.push(unit.frwPointers, newptr)
-END frwptr;
+END frwPtr;
-PROCEDURE linkptr (unit: UNIT): FRWPTR;
+PROCEDURE linkPtr* (unit: UNIT): FRWPTR;
 VAR
     item:  FRWPTR;
     ident: IDENT;
     res:   FRWPTR;
 BEGIN
     res  := NIL;
     item := unit.frwPointers.last(FRWPTR);
     WHILE (item # NIL) & ~item.linked & (res = NIL) DO
         item := item.prev(FRWPTR)
     END
     RETURN res
-END linkptr;
+END linkPtr;
     ELSIF (t1.typ = tPROCEDURE) & (t2.typ = tPROCEDURE) THEN
         param1 := t1.params.first;
         param2 := t2.params.first;
-        res := (t1.call = t2.call) & ((param1 # NIL) = (param2 # NIL));
+        res := ((t1.call = t2.call) OR (t1.call IN {code, _code}) OR (t2.call IN {code, _code})) & ((param1 # NIL) = (param2 # NIL));
         WHILE res & (param1 # NIL) & (param2 # NIL) DO
 PROCEDURE isBaseOf* (t0, t1: TYPE_): BOOLEAN;
 VAR
     res: BOOLEAN;
 BEGIN
-    res := ((t0.typ = tPOINTER) & (t1.typ = tPOINTER)) OR ((t0.typ = tRECORD) & (t1.typ = tRECORD));
+    res := (t0.typ = t1.typ) & (t0.typ IN {tPOINTER, tRECORD});
-    IF (t0.typ = tPOINTER) & (t1.typ = tPOINTER) THEN
+    IF res & (t0.typ = tPOINTER) THEN
         t0 := t0.base;
+        t1 := t1.base
-        t1 := t1.base
+    END;
     END;
+    IF res THEN
+        WHILE (t1 # NIL) & (t1 # t0) DO
             t1 := t1.base
-    WHILE res & (t1 # NIL) & (t1 # t0) DO
+        END;
-        t1 := t1.base
+        res := t1 # NIL
     END
-    RETURN res & (t1 = t0)
+    RETURN res
 END isBaseOf;
 PROCEDURE isOpenArray* (t: TYPE_): BOOLEAN;
     RETURN (t.typ = tARRAY) & (t.length = 0)
 END isOpenArray;
-PROCEDURE getunit (units: UNITS; name: SCAN.IDENT): UNIT;
+PROCEDURE getUnit* (program: PROGRAM; name: SCAN.IDENT): UNIT;
 VAR
     item: UNIT;
 BEGIN
     ASSERT(name # NIL);
-    item := units.first(UNIT);
+    item := program.units.first(UNIT);
-    WHILE (item # NIL) & (item.name # name) DO
-        item := item.next(UNIT)
+    WHILE (item # NIL) & (item.name # name) DO
-    END;
-    IF (item = NIL) & (name.s = "SYSTEM") THEN
+        item := item.next(UNIT)
-        item := units.program.sysunit
+    END;
-    END
-    RETURN item
+    IF (item = NIL) & (name.s = "SYSTEM") THEN
-END getunit;
+        item := program.sysunit
     END
-PROCEDURE enterStTypes (unit: UNIT; program: PROGRAM);
-VAR
-    ident:   IDENT;
-    stName:  SCAN.IDENT;
-BEGIN
     RETURN item
-    stName     := SCAN.enterid("INTEGER");
-    ident      := addIdent(unit, stName, idTYPE);
+END getUnit;
     ident.type := program.stTypes.tINTEGER;
-    stName     := SCAN.enterid("BYTE");
+PROCEDURE enterStTypes (unit: UNIT; program: PROGRAM);
-    ident      := addIdent(unit, stName, idTYPE);
+VAR
+    ident: IDENT;
+BEGIN
+    ident      := addIdent(unit, SCAN.enterid("INTEGER"), idTYPE);
-    ident.type := program.stTypes.tBYTE;
+    ident.type := program.stTypes.tINTEGER;
-    stName     := SCAN.enterid("CHAR");
+    ident      := addIdent(unit, SCAN.enterid("BYTE"), idTYPE);
-    ident      := addIdent(unit, stName, idTYPE);
+    ident.type := program.stTypes.tBYTE;
     ident.type := program.stTypes.tCHAR;
     ident      := addIdent(unit, SCAN.enterid("CHAR"), idTYPE);
-    stName     := SCAN.enterid("WCHAR");
+    ident.type := program.stTypes.tCHAR;
     ident      := addIdent(unit, stName, idTYPE);
-    ident.type := program.stTypes.tWCHAR;
+    ident      := addIdent(unit, SCAN.enterid("SET"), idTYPE);
+    ident.type := program.stTypes.tSET;
+    ident      := addIdent(unit, SCAN.enterid("BOOLEAN"), idTYPE);
+    ident.type := program.stTypes.tBOOLEAN;
+    IF program.target.sys # mConst.Target_iMSP430 THEN
+        ident      := addIdent(unit, SCAN.enterid("REAL"), idTYPE);
+        ident.type := program.stTypes.tREAL;
         ident      := addIdent(unit, SCAN.enterid("WCHAR"), idTYPE);
-    stName     := SCAN.enterid("SET");
+        ident.type := program.stTypes.tWCHAR
-    ident      := addIdent(unit, stName, idTYPE);
+    END
-    ident.type := program.stTypes.tSET;
+END enterStTypes;
-    stName     := SCAN.enterid("BOOLEAN");
-    ident      := addIdent(unit, stName, idTYPE);
-    ident.type := program.stTypes.tBOOLEAN;
+PROCEDURE enterStProcs (unit: UNIT);
-    stName     := SCAN.enterid("REAL");
+    PROCEDURE EnterProc (unit: UNIT; name: SCAN.LEXSTR; proc: INTEGER);
-    ident      := addIdent(unit, stName, idTYPE);
+    VAR
-    ident.type := program.stTypes.tREAL;
+        ident: IDENT;
-END enterStTypes;
+    BEGIN
+        ident := addIdent(unit, SCAN.enterid(name), idSTPROC);
+        ident.stproc := proc
-PROCEDURE enterStProcs (unit: UNIT);
+    END EnterProc;
-    PROCEDURE EnterProc (unit: UNIT; name: SCAN.LEXSTR; idtyp, proc: INTEGER);
+    PROCEDURE EnterFunc (unit: UNIT; name: SCAN.LEXSTR; func: INTEGER);
     VAR
         ident: IDENT;
+    BEGIN
+        ident := addIdent(unit, SCAN.enterid(name), idSTFUNC);
-    BEGIN
+        ident.stproc := func
-        ident := addIdent(unit, SCAN.enterid(name), idtyp);
+    END EnterFunc;
-        ident.stproc := proc
-    END EnterProc;
+BEGIN
+    EnterProc(unit, "ASSERT", stASSERT);
+    EnterProc(unit, "DEC",    stDEC);
+    EnterProc(unit, "EXCL",   stEXCL);
+    EnterProc(unit, "INC",    stINC);
-BEGIN
+    EnterProc(unit, "INCL",   stINCL);
-    EnterProc(unit, "ASSERT",   idSTPROC,  stASSERT);
+    EnterProc(unit, "NEW",    stNEW);
-    EnterProc(unit, "DEC",      idSTPROC,  stDEC);
+    EnterProc(unit, "COPY",   stCOPY);
     EnterProc(unit, "EXCL",     idSTPROC,  stEXCL);
-    EnterProc(unit, "INC",      idSTPROC,  stINC);
-    EnterProc(unit, "INCL",     idSTPROC,  stINCL);
+    EnterFunc(unit, "ABS",    stABS);
-    EnterProc(unit, "NEW",      idSTPROC,  stNEW);
+    EnterFunc(unit, "ASR",    stASR);
-    EnterProc(unit, "PACK",     idSTPROC,  stPACK);
+    EnterFunc(unit, "CHR",    stCHR);
-    EnterProc(unit, "UNPK",     idSTPROC,  stUNPK);
+    EnterFunc(unit, "LEN",    stLEN);
-    EnterProc(unit, "DISPOSE",  idSTPROC,  stDISPOSE);
-    EnterProc(unit, "COPY",     idSTPROC,  stCOPY);
-    EnterProc(unit, "ABS",      idSTFUNC,  stABS);
-    EnterProc(unit, "ASR",      idSTFUNC,  stASR);
-    EnterProc(unit, "CHR",      idSTFUNC,  stCHR);
-    EnterProc(unit, "WCHR",     idSTFUNC,  stWCHR);
+    EnterFunc(unit, "LSL",    stLSL);
-    EnterProc(unit, "FLOOR",    idSTFUNC,  stFLOOR);
+    EnterFunc(unit, "ODD",    stODD);
-    EnterProc(unit, "FLT",      idSTFUNC,  stFLT);
+    EnterFunc(unit, "ORD",    stORD);
-    EnterProc(unit, "LEN",      idSTFUNC,  stLEN);
+    EnterFunc(unit, "ROR",    stROR);
-    EnterProc(unit, "LSL",      idSTFUNC,  stLSL);
+    EnterFunc(unit, "BITS",   stBITS);
-    EnterProc(unit, "ODD",      idSTFUNC,  stODD);
-    EnterProc(unit, "ORD",      idSTFUNC,  stORD);
-    EnterProc(unit, "ROR",      idSTFUNC,  stROR);
-    EnterProc(unit, "BITS",     idSTFUNC,  stBITS);
-    EnterProc(unit, "LSR",      idSTFUNC,  stLSR);
-    EnterProc(unit, "LENGTH",   idSTFUNC,  stLENGTH);
-    EnterProc(unit, "MIN",      idSTFUNC,  stMIN);
-    EnterProc(unit, "MAX",      idSTFUNC,  stMAX);
+    EnterFunc(unit, "LSR",    stLSR);
-END enterStProcs;
+    EnterFunc(unit, "LENGTH", stLENGTH);
     EnterFunc(unit, "MIN",    stMIN);
+    EnterFunc(unit, "MAX",    stMAX);
 PROCEDURE newunit (units: UNITS; name: SCAN.IDENT): UNIT;
-VAR
+    IF unit.program.target.sys # mConst.Target_iMSP430 THEN
-    unit:    UNIT;
+        EnterProc(unit, "PACK",    stPACK);
-    idents:  IDENTS;
+        EnterProc(unit, "UNPK",    stUNPK);
         EnterProc(unit, "DISPOSE", stDISPOSE);
 BEGIN
-    ASSERT(units # NIL);
+        EnterFunc(unit, "WCHR",    stWCHR);
-    ASSERT(name # NIL);
+        EnterFunc(unit, "FLOOR",   stFLOOR);
         EnterFunc(unit, "FLT",     stFLT)
-    NEW(unit);
+    END
-    NEW(idents);
+END enterStProcs;
     ASSERT(LISTS.create(idents) = idents);
-    idents.add       := addIdent;
+PROCEDURE newUnit* (program: PROGRAM; name: SCAN.IDENT): UNIT;
     RETURN field
 END getField;
-PROCEDURE addField (self: TYPE_; name: SCAN.IDENT; export: BOOLEAN): BOOLEAN;
+PROCEDURE addField* (self: TYPE_; name: SCAN.IDENT; export: BOOLEAN): BOOLEAN;
 VAR
     RETURN res
 END addField;
-PROCEDURE setFields (self: TYPE_; type: TYPE_): BOOLEAN;
+PROCEDURE setFields* (self: TYPE_; type: TYPE_): BOOLEAN;
 VAR
     res := TRUE;
     WHILE res & (item # NIL) & (item.type = NIL) DO
         item.type := type;
         IF ~self.noalign THEN
-            res := MACHINE.Align(self.size, type.align)
+            res := UTILS.Align(self.size, type.align)
         ELSE
             res := TRUE
         END;
         item.offset := self.size;
     RETURN res
 END setFields;
-PROCEDURE getParam (self: TYPE_; name: SCAN.IDENT): PARAM;
+PROCEDURE getParam* (self: TYPE_; name: SCAN.IDENT): PARAM;
 VAR
     RETURN item
 END getParam;
-PROCEDURE addParam (self: TYPE_; name: SCAN.IDENT; vPar: BOOLEAN): BOOLEAN;
+PROCEDURE addParam* (self: TYPE_; name: SCAN.IDENT; vPar: BOOLEAN): BOOLEAN;
 VAR
-    param:  PARAM;
+    param: PARAM;
-    res:    BOOLEAN;
+    res:   BOOLEAN;
 BEGIN
     ASSERT(name # NIL);
     WHILE isOpenArray(t) DO t := t.base END
     RETURN t
 END OpenBase;
-PROCEDURE getFloatParamsPos (self: TYPE_; maxoffs: INTEGER; VAR int, flt: INTEGER): SET;
+PROCEDURE getFloatParamsPos* (self: TYPE_; maxoffs: INTEGER; VAR int, flt: INTEGER): SET;
 VAR
     res: SET;
             INC(flt)
         END;
         param := param.next(PARAM)
     END;
-    int := self.params.size - flt
+    int := self.parSize - flt
     RETURN res
 END getFloatParamsPos;
-PROCEDURE setParams (self: TYPE_; type: TYPE_);
+PROCEDURE setParams* (self: TYPE_; type: TYPE_);
 VAR
     item: LISTS.ITEM;
     param: PARAM;
     word, size: INTEGER;
 BEGIN
             ELSIF isOpenArray(type) THEN
                 size := Dim(type) + 1
             ELSE
                 size := 1
             END;
-            param.offset := self.params.size + ORD(type.typ = tRECORD) + Dim(type) + STACK_FRAME;
+            param.offset := self.parSize + ORD(type.typ = tRECORD) + Dim(type) + STACK_FRAME;
-            INC(self.params.size, size)
+            INC(self.parSize, size)
         ELSE
             IF type.typ IN {tRECORD, tARRAY} THEN
                 IF isOpenArray(type) THEN
                     size := Dim(type) + 1
                 ELSE
                     size := 1
                 END
             ELSE
                 size := type.size;
-                ASSERT(MACHINE.Align(size, word));
+                ASSERT(UTILS.Align(size, word));
                 size := size DIV word
             END;
-            param.offset := self.params.size + Dim(type) + STACK_FRAME;
+            param.offset := self.parSize + Dim(type) + STACK_FRAME;
-            INC(self.params.size, size)
+            INC(self.parSize, size)
         END;
         item := item.next
     END
 END setParams;
-PROCEDURE enterType (program: PROGRAM; typ, size, length: INTEGER; unit: UNIT): TYPE_;
 VAR
-    t:        TYPE_;
+PROCEDURE enterType* (program: PROGRAM; typ, size, length: INTEGER; unit: UNIT): TYPE_;
-    fields:   FIELDS;
-    params:   PARAMS;
-BEGIN
-    NEW(t);
-    NEW(fields);
+VAR
-    ASSERT(LISTS.create(fields) = fields);
+    t: TYPE_;
-    NEW(params);
+BEGIN
-    ASSERT(LISTS.create(params) = params);
+    NEW(t);
     t.typ     := typ;
     t.size    := size;
     t.length  := length;
+    t.align   := 0;
-    t.align   := 0;
+    t.base    := NIL;
-    t.base    := NIL;
+    t.fields  := LISTS.create(NIL);
-    t.fields  := fields;
+    t.params  := LISTS.create(NIL);
-    t.params  := params;
+    t.unit    := unit;
-    t.unit    := unit;
+    t.num     := 0;
-    t.num     := 0;
+    CASE program.target.bit_depth OF
-    IF program.target.bit_depth = 32 THEN
+    |16: t.call := default16
-        t.call := default
-    ELSIF program.target.bit_depth = 64 THEN
-        t.call := default64
-    END;
-    t.import  := FALSE;
-    t.noalign := FALSE;
-    t.fields.add := addField;
-    t.fields.get := getField;
-    t.fields.set := setFields;
+    |32: t.call := default32
     |64: t.call := default64
-    t.params.add := addParam;
+    END;
     t.params.get := getParam;
-    t.params.getfparams := getFloatParamsPos;
+    t.import  := FALSE;
     RETURN t
 END enterType;
-PROCEDURE getType (program: PROGRAM; typ: INTEGER): TYPE_;
+PROCEDURE getType* (program: PROGRAM; typ: INTEGER): TYPE_;
         ident.export := TRUE
     END EnterProc;
 BEGIN
-    unit := program.units.create(program.units, SCAN.enterid("$SYSTEM"));
+    unit := newUnit(program, SCAN.enterid("$SYSTEM"));
-    EnterProc(unit, "ADR",    idSYSFUNC, sysADR);
-    EnterProc(unit, "SIZE",   idSYSFUNC, sysSIZE);
+    EnterProc(unit, "ADR",    idSYSFUNC, sysADR);
-    EnterProc(unit, "SADR",   idSYSFUNC, sysSADR);
-    EnterProc(unit, "WSADR",  idSYSFUNC, sysWSADR);
+    EnterProc(unit, "SIZE",   idSYSFUNC, sysSIZE);
-    EnterProc(unit, "TYPEID", idSYSFUNC, sysTYPEID);
-    EnterProc(unit, "INF",    idSYSFUNC, sysINF);
+    EnterProc(unit, "SADR",   idSYSFUNC, sysSADR);
-    EnterProc(unit, "GET",    idSYSPROC, sysGET);
+    EnterProc(unit, "TYPEID", idSYSFUNC, sysTYPEID);
     EnterProc(unit, "PUT",    idSYSPROC, sysPUT);
-    EnterProc(unit, "PUT8",   idSYSPROC, sysPUT8);
+    EnterProc(unit, "GET",    idSYSPROC, sysGET);
+    EnterProc(unit, "PUT8",   idSYSPROC, sysPUT8);
+    EnterProc(unit, "PUT",    idSYSPROC, sysPUT);
+    EnterProc(unit, "CODE",   idSYSPROC, sysCODE);
+    EnterProc(unit, "MOVE",   idSYSPROC, sysMOVE);
+           (*
+    IF program.target.sys = mConst.Target_iMSP430 THEN
+        EnterProc(unit, "NOP",  idSYSPROC, sysNOP);
+        EnterProc(unit, "EINT", idSYSPROC, sysEINT);
+        EnterProc(unit, "DINT", idSYSPROC, sysDINT)
+    END;
+         *)
+    IF program.target.sys # mConst.Target_iMSP430 THEN
-    EnterProc(unit, "PUT16",  idSYSPROC, sysPUT16);
+        EnterProc(unit, "WSADR",  idSYSFUNC, sysWSADR);
-    EnterProc(unit, "PUT32",  idSYSPROC, sysPUT32);
+        EnterProc(unit, "INF",    idSYSFUNC, sysINF);
-    EnterProc(unit, "CODE",   idSYSPROC, sysCODE);
+        EnterProc(unit, "PUT32",  idSYSPROC, sysPUT32);
-    EnterProc(unit, "MOVE",   idSYSPROC, sysMOVE);
+        EnterProc(unit, "PUT16",  idSYSPROC, sysPUT16);
-    EnterProc(unit, "COPY",   idSYSPROC, sysCOPY);
+        EnterProc(unit, "COPY",   idSYSPROC, sysCOPY);
-    ident := addIdent(unit, SCAN.enterid("CARD16"), idTYPE);
+        ident := addIdent(unit, SCAN.enterid("CARD16"), idTYPE);
+        ident.type := program.stTypes.tCARD16;
-    ident.type := program.stTypes.tCARD16;
+        ident.export := TRUE;
     ident.export := TRUE;
         ident := addIdent(unit, SCAN.enterid("CARD32"), idTYPE);
-BEGIN
 BEGIN
     REPEAT
     REPEAT
         flag := FALSE;
     proc := program.procs.first(PROC);
     WHILE proc # NIL DO
         IF ~proc.used THEN
             IF proc.import = NIL THEN
-                CODE.delete2(proc.enter, proc.leave)
+                IL.delete2(proc.enter, proc.leave)
             ELSE
                 DelImport(proc.import)
             END
         END;
         proc := proc.next(PROC)
     END
 END DelUnused;
 PROCEDURE create* (bit_depth, sys: INTEGER): PROGRAM;
-VAR
+PROCEDURE create* (bit_depth, target: INTEGER; options: OPTIONS): PROGRAM;
-    program: PROGRAM;
+VAR
-    units:   UNITS;
+    program: PROGRAM;
-BEGIN
     idents := C.create();
 BEGIN
-    MACHINE.SetBitDepth(bit_depth);
+    idents := C.create();
-    NEW(program);
+    UTILS.SetBitDepth(bit_depth);
+    NEW(program);
+    program.target.bit_depth := bit_depth;
+    program.target.word      := bit_depth DIV 8;
+    program.target.adr       := bit_depth DIV 8;
+    program.target.sys       := target;
+    program.target.options   := options;
+    CASE target OF
+    |mConst.Target_iConsole,
+     mConst.Target_iGUI,
+     mConst.Target_iDLL:        program.target.sysflags := {sf_windows, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign}
+    |mConst.Target_iELF32,
+     mConst.Target_iELFSO32:    program.target.sysflags := {sf_linux, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign}
+    |mConst.Target_iKolibri,
+     mConst.Target_iObject:     program.target.sysflags := {sf_stdcall, sf_ccall, sf_ccall16, sf_noalign}
+    |mConst.Target_iConsole64,
+     mConst.Target_iGUI64,
-    NEW(units);
+     mConst.Target_iDLL64:      program.target.sysflags := {sf_windows, sf_stdcall64, sf_win64, sf_systemv, sf_noalign}
     ASSERT(LISTS.create(units) = units);
+    |mConst.Target_iELF64,
-    program.target.bit_depth := bit_depth;
+     mConst.Target_iELFSO64:    program.target.sysflags := {sf_linux, sf_stdcall64, sf_win64, sf_systemv, sf_noalign}
-    program.target.word      := bit_depth DIV 8;
     program.target.adr       := bit_depth DIV 8;
-    program.target.sys       := sys;
-    program.recCount := -1;
-    program.bss := 0;
+    |mConst.Target_iMSP430:     program.target.sysflags := {sf_code}
     END;
     program.units := units;
-    program.types := LISTS.create(NIL);
     program.recCount := -1;
-    program.procs := LISTS.create(NIL);
+    program.bss := 0;
+    program.units := LISTS.create(NIL);
+    program.types := LISTS.create(NIL);
     program.procs := LISTS.create(NIL);
+    program.stTypes.tINTEGER := enterType(program, tINTEGER,  program.target.word, 0, NIL);
+    program.stTypes.tBYTE    := enterType(program, tBYTE,                       1, 0, NIL);
+    program.stTypes.tCHAR    := enterType(program, tCHAR,                       1, 0, NIL);
-    program.enterType := enterType;
+    program.stTypes.tSET     := enterType(program, tSET,      program.target.word, 0, NIL);
-    program.getType   := getType;
+    program.stTypes.tBOOLEAN := enterType(program, tBOOLEAN,                    1, 0, NIL);
-    program.stTypes.tINTEGER := enterType(program, tINTEGER,  program.target.word, 0, NIL);
-    program.stTypes.tBYTE    := enterType(program, tBYTE,                       1, 0, NIL);
+    IF target # mConst.Target_iMSP430 THEN
-    program.stTypes.tCHAR    := enterType(program, tCHAR,                       1, 0, NIL);
+        program.stTypes.tWCHAR   := enterType(program, tWCHAR,  2, 0, NIL);
-    program.stTypes.tWCHAR   := enterType(program, tWCHAR,                      2, 0, NIL);
+        program.stTypes.tREAL    := enterType(program, tREAL,   8, 0, NIL);
-    program.stTypes.tSET     := enterType(program, tSET,      program.target.word, 0, NIL);
+        program.stTypes.tCARD16  := enterType(program, tCARD16, 2, 0, NIL);
-    program.stTypes.tBOOLEAN := enterType(program, tBOOLEAN,                    1, 0, NIL);
+        program.stTypes.tCARD32  := enterType(program, tCARD32, 4, 0, NIL)
-    program.stTypes.tREAL    := enterType(program, tREAL,                       8, 0, NIL);
-    program.stTypes.tSTRING  := enterType(program, tSTRING,   program.target.word, 0, NIL);
+    END;
     program.stTypes.tNIL     := enterType(program, tNIL,      program.target.word, 0, NIL);
+    program.stTypes.tSTRING  := enterType(program, tSTRING, program.target.word, 0, NIL);
+    program.stTypes.tNIL     := enterType(program, tNIL,    program.target.word, 0, NIL);
-    program.stTypes.tCARD16  := enterType(program, tCARD16,                     2, 0, NIL);
+    program.stTypes.tANYREC  := enterType(program, tRECORD, 0, 0, NIL);
-    program.stTypes.tCARD32  := enterType(program, tCARD32,                     4, 0, NIL);
+    program.stTypes.tANYREC.closed := TRUE;
-    program.stTypes.tANYREC  := enterType(program, tRECORD,                     0, 0, NIL);
-    program.stTypes.tANYREC.closed := TRUE;
-    program.stTypes.tINTEGER.align := program.stTypes.tINTEGER.size;
-    program.stTypes.tBYTE.align    := 1;
-    program.stTypes.tCHAR.align    := program.stTypes.tCHAR.size;
+    program.stTypes.tINTEGER.align := program.stTypes.tINTEGER.size;
-    program.stTypes.tWCHAR.align   := program.stTypes.tWCHAR.size;
+    program.stTypes.tBYTE.align    := 1;
-    program.stTypes.tSET.align     := program.stTypes.tSET.size;
+    program.stTypes.tCHAR.align    := program.stTypes.tCHAR.size;
-    program.stTypes.tBOOLEAN.align := program.stTypes.tBOOLEAN.size;
+    program.stTypes.tSET.align     := program.stTypes.tSET.size;

Subversion Repositories Kolibri OS

(root)/programs/develop/oberon07/Source/PROG.ob07 – Rev 7597 → 7693