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 |