Subversion Repositories Kolibri OS

Rev

Rev 7696 | Go to most recent revision | Show entire file | Regard whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 7696 Rev 7983
Line 1... Line 1...
1
(*
1
(*
2
    BSD 2-Clause License
2
    BSD 2-Clause License
Line 3... Line 3...
3
 
3
 
4
    Copyright (c) 2018-2019, Anton Krotov
4
    Copyright (c) 2018-2019, Anton Krotov
5
    All rights reserved.
5
    All rights reserved.
Line 6... Line 6...
6
*)
6
*)
Line 7... Line 7...
7
 
7
 
Line 8... Line 8...
8
MODULE PROG;
8
MODULE PROG;
Line 9... Line 9...
9
 
9
 
Line 197... Line 197...
197
        rtl*:        UNIT;
197
        rtl*:        UNIT;
198
        bss*:        INTEGER;
198
        bss*:        INTEGER;
199
        locsize*:    INTEGER;
199
        locsize*:    INTEGER;
Line 200... Line 200...
200
 
200
 
-
 
201
        procs*:      LISTS.LIST;
201
        procs*:      LISTS.LIST;
202
 
202
        dll*:        BOOLEAN;
203
        sysflags*:   SET;
Line 203... Line 204...
203
        obj*:        BOOLEAN;
204
        options*:    OPTIONS;
Line 204... Line 205...
204
 
205
 
205
        stTypes*:    RECORD
206
        stTypes*:    RECORD
Line 206... Line -...
206
 
-
 
207
            tINTEGER*, tBYTE*, tCHAR*, tWCHAR*, tSET*, tBOOLEAN*, tREAL*,
-
 
208
            tSTRING*, tNIL*, tCARD32*, tANYREC*: TYPE_
-
 
209
 
-
 
210
        END;
-
 
211
 
-
 
212
        target*:     RECORD
-
 
213
 
-
 
214
            bit_depth*:  INTEGER;
-
 
215
            word*:       INTEGER;
-
 
216
            adr*:        INTEGER;
-
 
217
            sys*:        INTEGER;
207
 
Line 218... Line 208...
218
            sysflags*:   SET;
208
            tINTEGER*, tBYTE*, tCHAR*, tWCHAR*, tSET*, tBOOLEAN*, tREAL*,
Line 219... Line 209...
219
            options*:    OPTIONS
209
            tSTRING*, tNIL*, tCARD32*, tANYREC*: TYPE_
Line 247... Line 237...
247
END NewIdent;
237
END NewIdent;
Line 248... Line 238...
248
 
238
 
249
 
239
 
250
PROCEDURE getOffset* (program: PROGRAM; varIdent: IDENT): INTEGER;
-
 
251
VAR
240
PROCEDURE getOffset* (program: PROGRAM; varIdent: IDENT): INTEGER;
Line 252... Line 241...
252
    word: INTEGER;
241
VAR
253
    size: INTEGER;
242
    size: INTEGER;
254
 
243
 
Line 261... Line 250...
261
                    varIdent.offset := program.bss;
250
                    varIdent.offset := program.bss;
262
                    INC(program.bss, size)
251
                    INC(program.bss, size)
263
                END
252
                END
264
            END
253
            END
265
        ELSE
254
        ELSE
266
            word := program.target.word;
-
 
267
            IF UTILS.Align(size, word) THEN
255
            IF UTILS.Align(size, TARGETS.WordSize) THEN
268
                size := size DIV word;
256
                size := size DIV TARGETS.WordSize;
269
                IF UTILS.maxint - program.locsize >= size THEN
257
                IF UTILS.maxint - program.locsize >= size THEN
270
                    INC(program.locsize, size);
258
                    INC(program.locsize, size);
271
                    varIdent.offset := program.locsize
259
                    varIdent.offset := program.locsize
272
                END
260
                END
273
            END
261
            END
Line 680... Line 668...
680
    ident.type := program.stTypes.tSET;
668
    ident.type := program.stTypes.tSET;
Line 681... Line 669...
681
 
669
 
682
    ident      := addIdent(unit, SCAN.enterid("BOOLEAN"), idTYPE);
670
    ident      := addIdent(unit, SCAN.enterid("BOOLEAN"), idTYPE);
Line 683... Line 671...
683
    ident.type := program.stTypes.tBOOLEAN;
671
    ident.type := program.stTypes.tBOOLEAN;
684
 
672
 
685
    IF program.target.sys # mConst.Target_iMSP430 THEN
673
    IF TARGETS.RealSize # 0 THEN
-
 
674
        ident      := addIdent(unit, SCAN.enterid("REAL"), idTYPE);
Line -... Line 675...
-
 
675
        ident.type := program.stTypes.tREAL
686
        ident      := addIdent(unit, SCAN.enterid("REAL"), idTYPE);
676
    END;
687
        ident.type := program.stTypes.tREAL;
677
 
688
 
678
    IF TARGETS.BitDepth >= 32 THEN
Line 689... Line 679...
689
        ident      := addIdent(unit, SCAN.enterid("WCHAR"), idTYPE);
679
        ident      := addIdent(unit, SCAN.enterid("WCHAR"), idTYPE);
Line 735... Line 725...
735
    EnterFunc(unit, "LSR",    stLSR);
725
    EnterFunc(unit, "LSR",    stLSR);
736
    EnterFunc(unit, "LENGTH", stLENGTH);
726
    EnterFunc(unit, "LENGTH", stLENGTH);
737
    EnterFunc(unit, "MIN",    stMIN);
727
    EnterFunc(unit, "MIN",    stMIN);
738
    EnterFunc(unit, "MAX",    stMAX);
728
    EnterFunc(unit, "MAX",    stMAX);
Line 739... Line 729...
739
 
729
 
740
    IF unit.program.target.sys # mConst.Target_iMSP430 THEN
730
    IF TARGETS.RealSize # 0 THEN
741
        EnterProc(unit, "PACK",    stPACK);
731
        EnterProc(unit, "PACK",  stPACK);
742
        EnterProc(unit, "UNPK",    stUNPK);
-
 
743
        EnterProc(unit, "DISPOSE", stDISPOSE);
-
 
744
 
-
 
745
        EnterFunc(unit, "WCHR",    stWCHR);
732
        EnterProc(unit, "UNPK",  stUNPK);
746
        EnterFunc(unit, "FLOOR",   stFLOOR);
733
        EnterFunc(unit, "FLOOR", stFLOOR);
-
 
734
        EnterFunc(unit, "FLT",   stFLT)
-
 
735
    END;
-
 
736
 
-
 
737
    IF TARGETS.BitDepth >= 32 THEN
-
 
738
        EnterFunc(unit, "WCHR", stWCHR)
-
 
739
    END;
-
 
740
 
-
 
741
    IF TARGETS.Dispose THEN
747
        EnterFunc(unit, "FLT",     stFLT)
742
        EnterProc(unit, "DISPOSE", stDISPOSE)
Line 748... Line 743...
748
    END
743
    END
Line 780... Line 775...
780
    unit.scopeLvl := 0;
775
    unit.scopeLvl := 0;
781
    unit.scopes[0] := NIL;
776
    unit.scopes[0] := NIL;
Line 782... Line 777...
782
 
777
 
Line 783... Line 778...
783
    unit.sysimport := FALSE;
778
    unit.sysimport := FALSE;
784
 
779
 
785
    IF unit.name.s = mConst.RTL_NAME THEN
780
    IF unit.name.s = UTILS.RTL_NAME THEN
Line 786... Line 781...
786
        program.rtl := unit
781
        program.rtl := unit
787
    END
782
    END
Line 1035... Line 1030...
1035
    t.fields  := LISTS.create(NIL);
1030
    t.fields  := LISTS.create(NIL);
1036
    t.params  := LISTS.create(NIL);
1031
    t.params  := LISTS.create(NIL);
1037
    t.unit    := unit;
1032
    t.unit    := unit;
1038
    t.num     := 0;
1033
    t.num     := 0;
Line 1039... Line 1034...
1039
 
1034
 
1040
    CASE program.target.bit_depth OF
1035
    CASE TARGETS.BitDepth OF
1041
    |16: t.call := default16
1036
    |16: t.call := default16
1042
    |32: t.call := default32
1037
    |32: t.call := default32
1043
    |64: t.call := default64
1038
    |64: t.call := default64
Line 1117... Line 1112...
1117
        EnterProc(unit, "NOP",  idSYSPROC, sysNOP);
1112
        EnterProc(unit, "NOP",  idSYSPROC, sysNOP);
1118
        EnterProc(unit, "EINT", idSYSPROC, sysEINT);
1113
        EnterProc(unit, "EINT", idSYSPROC, sysEINT);
1119
        EnterProc(unit, "DINT", idSYSPROC, sysDINT)
1114
        EnterProc(unit, "DINT", idSYSPROC, sysDINT)
1120
    END;
1115
    END;
1121
         *)
1116
         *)
1122
    IF program.target.sys # mConst.Target_iMSP430 THEN
1117
    IF TARGETS.RealSize # 0 THEN
1123
        EnterProc(unit, "WSADR",  idSYSFUNC, sysWSADR);
-
 
1124
        EnterProc(unit, "INF",    idSYSFUNC, sysINF);
1118
        EnterProc(unit, "INF",    idSYSFUNC, sysINF);
-
 
1119
    END;
-
 
1120
 
-
 
1121
    IF TARGETS.CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64} THEN
-
 
1122
        EnterProc(unit, "COPY",   idSYSPROC, sysCOPY)
-
 
1123
    END;
-
 
1124
 
-
 
1125
    IF TARGETS.BitDepth >= 32 THEN
-
 
1126
        EnterProc(unit, "WSADR",  idSYSFUNC, sysWSADR);
1125
        EnterProc(unit, "PUT32",  idSYSPROC, sysPUT32);
1127
        EnterProc(unit, "PUT32",  idSYSPROC, sysPUT32);
1126
        EnterProc(unit, "PUT16",  idSYSPROC, sysPUT16);
1128
        EnterProc(unit, "PUT16",  idSYSPROC, sysPUT16);
1127
        EnterProc(unit, "COPY",   idSYSPROC, sysCOPY);
-
 
Line 1128... Line 1129...
1128
 
1129
 
1129
        ident := addIdent(unit, SCAN.enterid("CARD32"), idTYPE);
1130
        ident := addIdent(unit, SCAN.enterid("CARD32"), idTYPE);
1130
        ident.type := program.stTypes.tCARD32;
1131
        ident.type := program.stTypes.tCARD32;
1131
        ident.export := TRUE
1132
        ident.export := TRUE
Line 1189... Line 1190...
1189
    END
1190
    END
Line 1190... Line 1191...
1190
 
1191
 
Line 1191... Line 1192...
1191
END DelUnused;
1192
END DelUnused;
1192
 
1193
 
1193
 
1194
 
Line 1194... Line 1195...
1194
PROCEDURE create* (bit_depth, target: INTEGER; options: OPTIONS): PROGRAM;
1195
PROCEDURE create* (options: OPTIONS): PROGRAM;
1195
VAR
1196
VAR
Line 1196... Line 1197...
1196
    program: PROGRAM;
1197
    program: PROGRAM;
1197
 
1198
 
Line 1198... Line -...
1198
BEGIN
-
 
1199
    idents := C.create();
-
 
1200
 
-
 
1201
    UTILS.SetBitDepth(bit_depth);
-
 
1202
    NEW(program);
1199
BEGIN
1203
 
-
 
1204
    program.target.bit_depth := bit_depth;
-
 
1205
    program.target.word      := bit_depth DIV 8;
-
 
1206
    program.target.adr       := bit_depth DIV 8;
-
 
1207
    program.target.sys       := target;
-
 
1208
    program.target.options   := options;
-
 
1209
 
-
 
1210
    CASE target OF
-
 
1211
    |mConst.Target_iConsole,
-
 
1212
     mConst.Target_iGUI,
-
 
1213
     mConst.Target_iDLL:        program.target.sysflags := {sf_windows, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign}
-
 
1214
 
-
 
1215
    |mConst.Target_iELF32,
-
 
1216
     mConst.Target_iELFSO32:    program.target.sysflags := {sf_linux, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign}
-
 
1217
 
-
 
1218
    |mConst.Target_iKolibri,
-
 
1219
     mConst.Target_iObject:     program.target.sysflags := {sf_stdcall, sf_ccall, sf_ccall16, sf_noalign}
-
 
1220
 
-
 
Line -... Line 1200...
-
 
1200
    idents := C.create();
-
 
1201
 
-
 
1202
    UTILS.SetBitDepth(TARGETS.BitDepth, TARGETS.RealSize = 8);
-
 
1203
    NEW(program);
-
 
1204
 
-
 
1205
    program.options := options;
1221
    |mConst.Target_iConsole64,
1206
 
1222
     mConst.Target_iGUI64,
1207
    CASE TARGETS.OS OF
Line 1223... Line 1208...
1223
     mConst.Target_iDLL64:      program.target.sysflags := {sf_windows, sf_stdcall64, sf_win64, sf_systemv, sf_noalign}
1208
    |TARGETS.osWIN32:    program.sysflags := {sf_windows, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign}
1224
 
1209
    |TARGETS.osLINUX32:  program.sysflags := {sf_linux, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign}
Line 1225... Line 1210...
1225
    |mConst.Target_iELF64,
1210
    |TARGETS.osKOS:      program.sysflags := {sf_stdcall, sf_ccall, sf_ccall16, sf_noalign}
1226
     mConst.Target_iELFSO64:    program.target.sysflags := {sf_linux, sf_stdcall64, sf_win64, sf_systemv, sf_noalign}
1211
    |TARGETS.osWIN64:    program.sysflags := {sf_windows, sf_stdcall64, sf_win64, sf_systemv, sf_noalign}
1227
 
1212
    |TARGETS.osLINUX64:  program.sysflags := {sf_linux, sf_stdcall64, sf_win64, sf_systemv, sf_noalign}
Line 1228... Line 1213...
1228
    |mConst.Target_iMSP430:     program.target.sysflags := {sf_code}
1213
    |TARGETS.osNONE:     program.sysflags := {sf_code}
1229
    END;
1214
    END;
1230
 
1215
 
1231
    program.recCount := -1;
1216
    program.recCount := -1;
1232
    program.bss := 0;
1217
    program.bss := 0;
Line -... Line 1218...
-
 
1218
 
-
 
1219
    program.units := LISTS.create(NIL);
-
 
1220
    program.types := LISTS.create(NIL);
-
 
1221
    program.procs := LISTS.create(NIL);
-
 
1222
 
-
 
1223
    program.stTypes.tINTEGER := enterType(program, tINTEGER, TARGETS.WordSize, 0, NIL);
1233
 
1224
    program.stTypes.tBYTE    := enterType(program, tBYTE,                   1, 0, NIL);
1234
    program.units := LISTS.create(NIL);
1225
    program.stTypes.tCHAR    := enterType(program, tCHAR,                   1, 0, NIL);
1235
    program.types := LISTS.create(NIL);
1226
    program.stTypes.tSET     := enterType(program, tSET,     TARGETS.WordSize, 0, NIL);
-
 
1227
    program.stTypes.tBOOLEAN := enterType(program, tBOOLEAN,                1, 0, NIL);
-
 
1228
 
-
 
1229
    program.stTypes.tINTEGER.align := TARGETS.WordSize;
-
 
1230
    program.stTypes.tBYTE.align    := 1;
-
 
1231
    program.stTypes.tCHAR.align    := 1;
1236
    program.procs := LISTS.create(NIL);
1232
    program.stTypes.tSET.align     := TARGETS.WordSize;
-
 
1233
    program.stTypes.tBOOLEAN.align := 1;
1237
 
1234
 
Line 1238... Line 1235...
1238
    program.stTypes.tINTEGER := enterType(program, tINTEGER,  program.target.word, 0, NIL);
1235
    IF TARGETS.BitDepth >= 32 THEN
1239
    program.stTypes.tBYTE    := enterType(program, tBYTE,                       1, 0, NIL);
1236
        program.stTypes.tWCHAR  := enterType(program, tWCHAR,  2, 0, NIL);
Line 1240... Line 1237...
1240
    program.stTypes.tCHAR    := enterType(program, tCHAR,                       1, 0, NIL);
1237
        program.stTypes.tCARD32 := enterType(program, tCARD32, 4, 0, NIL);
1241
    program.stTypes.tSET     := enterType(program, tSET,      program.target.word, 0, NIL);
1238
        program.stTypes.tWCHAR.align  := 2;
Line 1242... Line -...
1242
    program.stTypes.tBOOLEAN := enterType(program, tBOOLEAN,                    1, 0, NIL);
-
 
1243
 
-
 
1244
    IF target # mConst.Target_iMSP430 THEN
-
 
1245
        program.stTypes.tWCHAR   := enterType(program, tWCHAR,  2, 0, NIL);
-
 
1246
        program.stTypes.tREAL    := enterType(program, tREAL,   8, 0, NIL);
-
 
1247
        program.stTypes.tCARD32  := enterType(program, tCARD32, 4, 0, NIL)
-
 
1248
    END;
-
 
1249
 
-
 
1250
    program.stTypes.tSTRING  := enterType(program, tSTRING, program.target.word, 0, NIL);
-
 
1251
    program.stTypes.tNIL     := enterType(program, tNIL,    program.target.word, 0, NIL);
-
 
1252
 
-
 
1253
    program.stTypes.tANYREC  := enterType(program, tRECORD, 0, 0, NIL);
-
 
1254
    program.stTypes.tANYREC.closed := TRUE;
-
 
1255
 
-
 
1256
    program.stTypes.tINTEGER.align := program.stTypes.tINTEGER.size;
-
 
1257
    program.stTypes.tBYTE.align    := 1;
1239
        program.stTypes.tCARD32.align := 4
Line 1258... Line 1240...
1258
    program.stTypes.tCHAR.align    := program.stTypes.tCHAR.size;
1240
    END;
1259
    program.stTypes.tSET.align     := program.stTypes.tSET.size;
1241