/programs/develop/oberon07/Compiler.kex |
---|
Cannot display: file marked as a binary type. |
svn:mime-type = application/octet-stream |
/programs/develop/oberon07/Docs/About1251.txt |
---|
17,6 → 17,7 |
"kos" - KolibriOS |
"obj" - KolibriOS DLL |
"elfexe" - Linux ELF-EXEC |
"elfso" - Linux ELF-SO |
4) íåîáÿçàòåëüíûå ïàðàìåòðû-êëþ÷è |
-stk <size> ðàçìåð ñòýêà â ìåãàáàéòàõ (ïî óìîë÷àíèþ 2 Ìá) |
-base <address> àäðåñ çàãðóçêè èñïîëíÿåìîãî ôàéëà â êèëîáàéòàõ |
144,10 → 145,10 |
äî 32 áèò, äëÿ çàïèñè áàéòîâ èñïîëüçîâàòü SYSTEM.PUT8, |
äëÿ WCHAR -- SYSTEM.PUT16 |
PROCEDURE PUT8(a: INTEGER; x: INTEGER, BYTE, CHAR, WCHAR) |
PROCEDURE PUT8(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR) |
Ïàìÿòü[a] := ìëàäøèå 8 áèò (x) |
PROCEDURE PUT16(a: INTEGER; x: INTEGER, BYTE, CHAR, WCHAR) |
PROCEDURE PUT16(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR) |
Ïàìÿòü[a] := ìëàäøèå 16 áèò (x) |
PROCEDURE MOVE(Source, Dest, n: INTEGER) |
358,8 → 359,8 |
Âñå ïðîãðàììû íåÿâíî èñïîëüçóþò ìîäóëü RTL. Êîìïèëÿòîð òðàíñëèðóåò |
íåêîòîðûå îïåðàöèè (ïðîâåðêà è îõðàíà òèïà, ñðàâíåíèå ñòðîê, ñîîáùåíèÿ îá |
îøèáêàõ âðåìåíè âûïîëíåíèÿ è äð.) êàê âûçîâû ïðîöåäóð ýòîãî ìîäóëÿ. Íå |
ñëåäóåò ÿâíî âûçûâàòü ýòè ïðîöåäóðû, çà èñêëþ÷åíèåì ïðîöåäóðû SetDll, |
åñëè ïðèëîæåíèå êîìïèëèðóåòñÿ êàê Windows DLL: |
ñëåäóåò ÿâíî âûçûâàòü ýòè ïðîöåäóðû, çà èñêëþ÷åíèåì ïðîöåäóð SetDll è SetFini |
åñëè ïðèëîæåíèå êîìïèëèðóåòñÿ êàê Windows DLL èëè Linux SO, ñîîòâåòñòâåííî: |
PROCEDURE SetDll |
(process_detach, thread_detach, thread_attach: DLL_ENTRY); |
372,8 → 373,15 |
- ñîçäàíèè íîâîãî ïîòîêà (thread_attach) |
- óíè÷òîæåíèè ïîòîêà (thread_detach) |
Äëÿ ïðî÷èõ òèïîâ ïðèëîæåíèé, âûçîâ ïðîöåäóðû SetDll íå âëèÿåò íà |
PROCEDURE SetFini (ProcFini: PROC); |
ãäå TYPE PROC = PROCEDURE (* áåç ïàðàìåòðîâ *) |
SetFini íàçíà÷àåò ïðîöåäóðó ProcFini âûçûâàåìîé ïðè âûãðóçêå so-áèáëèîòåêè. |
Äëÿ ïðî÷èõ òèïîâ ïðèëîæåíèé, âûçîâ ïðîöåäóð SetDll è SetFini íå âëèÿåò íà |
ïîâåäåíèå ïðîãðàììû. |
Ñîîáùåíèÿ îá îøèáêàõ âðåìåíè âûïîëíåíèÿ âûâîäÿòñÿ â äèàëîãîâûõ îêíàõ |
(Windows), â òåðìèíàë (Linux), íà äîñêó îòëàäêè (KolibriOS). |
395,6 → 403,4 |
PROCEDURE [stdcall] lib_init (): INTEGER |
Ýòà ïðîöåäóðà äîëæíà áûòü âûçâàíà ïåðåä èñïîëüçîâàíèåì DLL. |
Ïðîöåäóðà âñåãäà âîçâðàùàåò 1. |
Äëÿ Linux, ãåíåðàöèÿ äèíàìè÷åñêèõ áèáëèîòåê íå ðåàëèçîâàíà. |
Ïðîöåäóðà âñåãäà âîçâðàùàåò 1. |
/programs/develop/oberon07/Docs/About866.txt |
---|
17,6 → 17,7 |
"kos" - KolibriOS |
"obj" - KolibriOS DLL |
"elfexe" - Linux ELF-EXEC |
"elfso" - Linux ELF-SO |
4) ¥®¡ï§ ⥫ìë¥ ¯ à ¬¥âàë-ª«îç¨ |
-stk <size> à §¬¥à áâíª ¢ ¬¥£ ¡ ©â å (¯® 㬮«ç ¨î 2 ¡) |
-base <address> ¤à¥á § £à㧪¨ ¨á¯®«ï¥¬®£® ä ©« ¢ ª¨«®¡ ©â å |
144,10 → 145,10 |
¤® 32 ¡¨â, ¤«ï § ¯¨á¨ ¡ ©â®¢ ¨á¯®«ì§®¢ âì SYSTEM.PUT8, |
¤«ï WCHAR -- SYSTEM.PUT16 |
PROCEDURE PUT8(a: INTEGER; x: INTEGER, BYTE, CHAR, WCHAR) |
PROCEDURE PUT8(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR) |
¬ïâì[a] := ¬« ¤è¨¥ 8 ¡¨â (x) |
PROCEDURE PUT16(a: INTEGER; x: INTEGER, BYTE, CHAR, WCHAR) |
PROCEDURE PUT16(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR) |
¬ïâì[a] := ¬« ¤è¨¥ 16 ¡¨â (x) |
PROCEDURE MOVE(Source, Dest, n: INTEGER) |
358,8 → 359,8 |
ᥠ¯à®£à ¬¬ë ¥ï¢® ¨á¯®«ì§ãîâ ¬®¤ã«ì RTL. ®¬¯¨«ïâ®à âà ᫨àã¥â |
¥ª®â®àë¥ ®¯¥à 樨 (¯à®¢¥àª ¨ ®åà ⨯ , áà ¢¥¨¥ áâப, á®®¡é¥¨ï ®¡ |
®è¨¡ª å ¢à¥¬¥¨ ¢ë¯®«¥¨ï ¨ ¤à.) ª ª ¢ë§®¢ë ¯à®æ¥¤ãà í⮣® ¬®¤ã«ï. ¥ |
á«¥¤ã¥â  ¢ë§ë¢ âì í⨠¯à®æ¥¤ãàë, § ¨áª«î票¥¬ ¯à®æ¥¤ãàë SetDll, |
¥á«¨ ¯à¨«®¦¥¨¥ ª®¬¯¨«¨àã¥âáï ª ª Windows DLL: |
á«¥¤ã¥â  ¢ë§ë¢ âì í⨠¯à®æ¥¤ãàë, § ¨áª«î票¥¬ ¯à®æ¥¤ãà SetDll ¨ SetFini |
¥á«¨ ¯à¨«®¦¥¨¥ ª®¬¯¨«¨àã¥âáï ª ª Windows DLL ¨«¨ Linux SO, ᮮ⢥âá⢥®: |
PROCEDURE SetDll |
(process_detach, thread_detach, thread_attach: DLL_ENTRY); |
372,8 → 373,15 |
- ᮧ¤ ¨¨ ®¢®£® ¯®â®ª (thread_attach) |
- ã¨ç⮦¥¨¨ ¯®â®ª (thread_detach) |
«ï ¯à®ç¨å ⨯®¢ ¯à¨«®¦¥¨©, ¢ë§®¢ ¯à®æ¥¤ãàë SetDll ¥ ¢«¨ï¥â |
PROCEDURE SetFini (ProcFini: PROC); |
£¤¥ TYPE PROC = PROCEDURE (* ¡¥§ ¯ à ¬¥â஢ *) |
SetFini § ç ¥â ¯à®æ¥¤ãàã ProcFini ¢ë§ë¢ ¥¬®© ¯à¨ ¢ë£à㧪¥ so-¡¨¡«¨®â¥ª¨. |
«ï ¯à®ç¨å ⨯®¢ ¯à¨«®¦¥¨©, ¢ë§®¢ ¯à®æ¥¤ãà SetDll ¨ SetFini ¥ ¢«¨ï¥â |
¯®¢¥¤¥¨¥ ¯à®£à ¬¬ë. |
®®¡é¥¨ï ®¡ ®è¨¡ª å ¢à¥¬¥¨ ¢ë¯®«¥¨ï ¢ë¢®¤ïâáï ¢ ¤¨ «®£®¢ëå ®ª å |
(Windows), ¢ â¥à¬¨ « (Linux), ¤®áªã ®â« ¤ª¨ (KolibriOS). |
395,6 → 403,4 |
PROCEDURE [stdcall] lib_init (): INTEGER |
â ¯à®æ¥¤ãà ¤®«¦ ¡ëâì ¢ë§¢ ¯¥à¥¤ ¨á¯®«ì§®¢ ¨¥¬ DLL. |
à®æ¥¤ãà ¢á¥£¤ ¢®§¢à é ¥â 1. |
«ï Linux, £¥¥à æ¨ï ¤¨ ¬¨ç¥áª¨å ¡¨¡«¨®â¥ª ¥ ॠ«¨§®¢ . |
à®æ¥¤ãà ¢á¥£¤ ¢®§¢à é ¥â 1. |
/programs/develop/oberon07/Docs/KOSLib1251.txt |
---|
98,8 → 98,8 |
CONST |
pi = 3.141592653589793D+00 |
e = 2.718281828459045D+00 |
pi = 3.141592653589793E+00 |
e = 2.718281828459045E+00 |
PROCEDURE IsNan(x: REAL): BOOLEAN |
153,13 → 153,13 |
PROCEDURE tanh(x: REAL): REAL |
ãèïåðáîëè÷åñêèé òàíãåíñ x |
PROCEDURE arcsinh(x: REAL): REAL |
PROCEDURE arsinh(x: REAL): REAL |
îáðàòíûé ãèïåðáîëè÷åñêèé ñèíóñ x |
PROCEDURE arccosh(x: REAL): REAL |
PROCEDURE arcosh(x: REAL): REAL |
îáðàòíûé ãèïåðáîëè÷åñêèé êîñèíóñ x |
PROCEDURE arctanh(x: REAL): REAL |
PROCEDURE artanh(x: REAL): REAL |
îáðàòíûé ãèïåðáîëè÷åñêèé òàíãåíñ x |
PROCEDURE round(x: REAL): REAL |
181,6 → 181,9 |
åñëè x < 0 âîçâðàùàåò -1 |
åñëè x = 0 âîçâðàùàåò 0 |
PROCEDURE fact(n: INTEGER): REAL |
ôàêòîðèàë n |
------------------------------------------------------------------------------ |
MODULE Debug - âûâîä íà äîñêó îòëàäêè |
Èíòåðôåéñ êàê ìîäóëü Out |
337,7 → 340,7 |
PROCEDURE Encode(Year, Month, Day, Hour, Min, Sec: INTEGER): REAL |
âîçâðàùàåò äàòó, ïîëó÷åííóþ èç êîìïîíåíòîâ |
Year, Month, Day, Hour, Min, Sec; |
ïðè îøèáêå âîçâðàùàåò êîíñòàíòó ERR = -7.0D5 |
ïðè îøèáêå âîçâðàùàåò êîíñòàíòó ERR = -7.0E5 |
PROCEDURE Decode(Date: REAL; VAR Year, Month, Day, |
Hour, Min, Sec: INTEGER): BOOLEAN |
/programs/develop/oberon07/Docs/KOSLib866.txt |
---|
98,8 → 98,8 |
CONST |
pi = 3.141592653589793D+00 |
e = 2.718281828459045D+00 |
pi = 3.141592653589793E+00 |
e = 2.718281828459045E+00 |
PROCEDURE IsNan(x: REAL): BOOLEAN |
153,13 → 153,13 |
PROCEDURE tanh(x: REAL): REAL |
£¨¯¥à¡®«¨ç¥áª¨© â £¥á x |
PROCEDURE arcsinh(x: REAL): REAL |
PROCEDURE arsinh(x: REAL): REAL |
®¡à âë© £¨¯¥à¡®«¨ç¥áª¨© á¨ãá x |
PROCEDURE arccosh(x: REAL): REAL |
PROCEDURE arcosh(x: REAL): REAL |
®¡à âë© £¨¯¥à¡®«¨ç¥áª¨© ª®á¨ãá x |
PROCEDURE arctanh(x: REAL): REAL |
PROCEDURE artanh(x: REAL): REAL |
®¡à âë© £¨¯¥à¡®«¨ç¥áª¨© â £¥á x |
PROCEDURE round(x: REAL): REAL |
181,6 → 181,9 |
¥á«¨ x < 0 ¢®§¢à é ¥â -1 |
¥á«¨ x = 0 ¢®§¢à é ¥â 0 |
PROCEDURE fact(n: INTEGER): REAL |
ä ªâ®à¨ « n |
------------------------------------------------------------------------------ |
MODULE Debug - ¢ë¢®¤ ¤®áªã ®â« ¤ª¨ |
â¥àä¥©á ª ª ¬®¤ã«ì Out |
337,7 → 340,7 |
PROCEDURE Encode(Year, Month, Day, Hour, Min, Sec: INTEGER): REAL |
¢®§¢à é ¥â ¤ âã, ¯®«ãç¥ãî ¨§ ª®¬¯®¥â®¢ |
Year, Month, Day, Hour, Min, Sec; |
¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â ª®áâ âã ERR = -7.0D5 |
¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â ª®áâ âã ERR = -7.0E5 |
PROCEDURE Decode(Date: REAL; VAR Year, Month, Day, |
Hour, Min, Sec: INTEGER): BOOLEAN |
/programs/develop/oberon07/Lib/KolibriOS/Math.ob07 |
---|
1,5 → 1,5 |
(* |
Copyright 2013, 2014, 2018 Anton Krotov |
Copyright 2013, 2014, 2018, 2019 Anton Krotov |
This program is free software: you can redistribute it and/or modify |
it under the terms of the GNU Lesser General Public License as published by |
251,58 → 251,45 |
PROCEDURE sinh* (x: REAL): REAL; |
VAR |
res: REAL; |
BEGIN |
IF IsZero(x) THEN |
res := 0.0 |
ELSE |
res := (exp(x) - exp(-x)) / 2.0 |
END |
RETURN res |
x := exp(x) |
RETURN (x - 1.0 / x) * 0.5 |
END sinh; |
PROCEDURE cosh* (x: REAL): REAL; |
VAR |
res: REAL; |
BEGIN |
IF IsZero(x) THEN |
res := 1.0 |
ELSE |
res := (exp(x) + exp(-x)) / 2.0 |
END |
RETURN res |
x := exp(x) |
RETURN (x + 1.0 / x) * 0.5 |
END cosh; |
PROCEDURE tanh* (x: REAL): REAL; |
VAR |
res: REAL; |
BEGIN |
IF IsZero(x) THEN |
res := 0.0 |
IF x > 15.0 THEN |
x := 1.0 |
ELSIF x < -15.0 THEN |
x := -1.0 |
ELSE |
res := sinh(x) / cosh(x) |
x := exp(2.0 * x); |
x := (x - 1.0) / (x + 1.0) |
END |
RETURN res |
RETURN x |
END tanh; |
PROCEDURE arcsinh* (x: REAL): REAL; |
RETURN ln(x + sqrt((x * x) + 1.0)) |
END arcsinh; |
PROCEDURE arsinh* (x: REAL): REAL; |
RETURN ln(x + sqrt(x * x + 1.0)) |
END arsinh; |
PROCEDURE arccosh* (x: REAL): REAL; |
RETURN ln(x + sqrt((x - 1.0) / (x + 1.0)) * (x + 1.0)) |
END arccosh; |
PROCEDURE arcosh* (x: REAL): REAL; |
RETURN ln(x + sqrt(x * x - 1.0)) |
END arcosh; |
PROCEDURE arctanh* (x: REAL): REAL; |
PROCEDURE artanh* (x: REAL): REAL; |
VAR |
res: REAL; |
315,7 → 302,7 |
res := 0.5 * ln((1.0 + x) / (1.0 - x)) |
END |
RETURN res |
END arctanh; |
END artanh; |
PROCEDURE floor* (x: REAL): REAL; |
374,8 → 361,24 |
ELSE |
res := 0 |
END |
RETURN res |
END sgn; |
PROCEDURE fact* (n: INTEGER): REAL; |
VAR |
res: REAL; |
BEGIN |
res := 1.0; |
WHILE n > 1 DO |
res := res * FLT(n); |
DEC(n) |
END |
RETURN res |
END fact; |
END Math. |
/programs/develop/oberon07/Lib/KolibriOS/NetDevices.ob07 |
---|
1,4 → 1,4 |
(* |
(* |
Copyright 2017 Anton Krotov |
This program is free software: you can redistribute it and/or modify |
/programs/develop/oberon07/Lib/KolibriOS/RTL.ob07 |
---|
22,11 → 22,13 |
DLL_PROCESS_DETACH = 0; |
SIZE_OF_DWORD = 4; |
MAX_SET = 31; |
TYPE |
DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER); |
PROC = PROCEDURE; |
VAR |
40,7 → 42,9 |
thread_attach: DLL_ENTRY |
END; |
fini: PROC; |
PROCEDURE [stdcall] _move* (bytes, source, dest: INTEGER); |
BEGIN |
SYSTEM.CODE( |
107,18 → 111,12 |
END _arrcpy; |
PROCEDURE [stdcall] _strcpy* (chr_size, len_dst, dst, len_src, src: INTEGER); |
PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER); |
BEGIN |
_move(MIN(len_dst, len_src) * chr_size, src, dst) |
END _strcpy; |
PROCEDURE [stdcall] _strcpy2* (chr_size, len_src, src, len_dst, dst: INTEGER); |
BEGIN |
_move(MIN(len_dst, len_src) * chr_size, src, dst) |
END _strcpy2; |
PROCEDURE [stdcall] _rot* (VAR A: ARRAY OF INTEGER); |
VAR |
i, n, k: INTEGER; |
137,30 → 135,27 |
END _rot; |
PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER; |
VAR |
res: INTEGER; |
PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER; |
BEGIN |
IF (a <= b) & (a <= 31) & (b >= 0) THEN |
IF b > 31 THEN |
b := 31 |
IF (a <= b) & (a <= MAX_SET) & (b >= 0) THEN |
IF b > MAX_SET THEN |
b := MAX_SET |
END; |
IF a < 0 THEN |
a := 0 |
END; |
res := LSR(ASR(ROR(1, 1), b - a), 31 - b) |
a := LSR(ASR(ROR(1, 1), b - a), MAX_SET - b) |
ELSE |
res := 0 |
a := 0 |
END |
RETURN res |
END _set2; |
RETURN a |
END _set; |
PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER; |
RETURN _set2(a, b) |
END _set; |
PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER; |
RETURN _set(b, a) |
END _set2; |
PROCEDURE [stdcall] divmod (a, b: INTEGER; VAR mod: INTEGER): INTEGER; |
185,7 → 180,7 |
END divmod; |
PROCEDURE div_ (x, y: INTEGER): INTEGER; |
PROCEDURE [stdcall] _div2* (x, y: INTEGER): INTEGER; |
VAR |
div, mod: INTEGER; |
196,10 → 191,10 |
END |
RETURN div |
END div_; |
END _div2; |
PROCEDURE mod_ (x, y: INTEGER): INTEGER; |
PROCEDURE [stdcall] _mod2* (x, y: INTEGER): INTEGER; |
VAR |
div, mod: INTEGER; |
210,29 → 205,19 |
END |
RETURN mod |
END mod_; |
END _mod2; |
PROCEDURE [stdcall] _div* (b, a: INTEGER): INTEGER; |
RETURN div_(a, b) |
RETURN _div2(a, b) |
END _div; |
PROCEDURE [stdcall] _div2* (a, b: INTEGER): INTEGER; |
RETURN div_(a, b) |
END _div2; |
PROCEDURE [stdcall] _mod* (b, a: INTEGER): INTEGER; |
RETURN mod_(a, b) |
RETURN _mod2(a, b) |
END _mod; |
PROCEDURE [stdcall] _mod2* (a, b: INTEGER): INTEGER; |
RETURN mod_(a, b) |
END _mod2; |
PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER); |
BEGIN |
ptr := API._NEW(size); |
251,50 → 236,6 |
END _dispose; |
PROCEDURE strncmp (a, b, n: INTEGER): INTEGER; |
VAR |
A, B: CHAR; |
res: INTEGER; |
BEGIN |
res := 0; |
WHILE n > 0 DO |
SYSTEM.GET(a, A); INC(a); |
SYSTEM.GET(b, B); INC(b); |
DEC(n); |
IF A # B THEN |
res := ORD(A) - ORD(B); |
n := 0 |
ELSIF A = 0X THEN |
n := 0 |
END |
END |
RETURN res |
END strncmp; |
PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER; |
VAR |
A, B: WCHAR; |
res: INTEGER; |
BEGIN |
res := 0; |
WHILE n > 0 DO |
SYSTEM.GET(a, A); INC(a, 2); |
SYSTEM.GET(b, B); INC(b, 2); |
DEC(n); |
IF A # B THEN |
res := ORD(A) - ORD(B); |
n := 0 |
ELSIF A = 0X THEN |
n := 0 |
END |
END |
RETURN res |
END strncmpw; |
PROCEDURE [stdcall] _length* (len, str: INTEGER): INTEGER; |
BEGIN |
SYSTEM.CODE( |
345,16 → 286,71 |
END _lengthw; |
PROCEDURE strncmp (a, b, n: INTEGER): INTEGER; |
VAR |
A, B: CHAR; |
res: INTEGER; |
BEGIN |
res := minint; |
WHILE n > 0 DO |
SYSTEM.GET(a, A); INC(a); |
SYSTEM.GET(b, B); INC(b); |
DEC(n); |
IF A # B THEN |
res := ORD(A) - ORD(B); |
n := 0 |
ELSIF A = 0X THEN |
res := 0; |
n := 0 |
END |
END |
RETURN res |
END strncmp; |
PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER; |
VAR |
A, B: WCHAR; |
res: INTEGER; |
BEGIN |
res := minint; |
WHILE n > 0 DO |
SYSTEM.GET(a, A); INC(a, 2); |
SYSTEM.GET(b, B); INC(b, 2); |
DEC(n); |
IF A # B THEN |
res := ORD(A) - ORD(B); |
n := 0 |
ELSIF A = 0X THEN |
res := 0; |
n := 0 |
END |
END |
RETURN res |
END strncmpw; |
PROCEDURE [stdcall] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN; |
VAR |
res: INTEGER; |
bRes: BOOLEAN; |
c: CHAR; |
BEGIN |
res := strncmp(str1, str2, MIN(len1, len2)); |
IF res = 0 THEN |
res := _length(len1, str1) - _length(len2, str2) |
IF res = minint THEN |
IF len1 > len2 THEN |
SYSTEM.GET(str1 + len2, c); |
res := ORD(c) |
ELSIF len1 < len2 THEN |
SYSTEM.GET(str2 + len1, c); |
res := -ORD(c) |
ELSE |
res := 0 |
END |
END; |
CASE op OF |
370,21 → 366,25 |
END _strcmp; |
PROCEDURE [stdcall] _strcmp2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN; |
RETURN _strcmp(op, len2, str2, len1, str1) |
END _strcmp2; |
PROCEDURE [stdcall] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN; |
VAR |
res: INTEGER; |
bRes: BOOLEAN; |
c: WCHAR; |
BEGIN |
res := strncmpw(str1, str2, MIN(len1, len2)); |
IF res = 0 THEN |
res := _lengthw(len1, str1) - _lengthw(len2, str2) |
IF res = minint THEN |
IF len1 > len2 THEN |
SYSTEM.GET(str1 + len2 * 2, c); |
res := ORD(c) |
ELSIF len1 < len2 THEN |
SYSTEM.GET(str2 + len1 * 2, c); |
res := -ORD(c) |
ELSE |
res := 0 |
END |
END; |
CASE op OF |
400,11 → 400,6 |
END _strcmpw; |
PROCEDURE [stdcall] _strcmpw2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN; |
RETURN _strcmpw(op, len2, str2, len1, str1) |
END _strcmpw2; |
PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR); |
VAR |
c: CHAR; |
470,7 → 465,7 |
END append; |
PROCEDURE [stdcall] _error* (module, err: INTEGER); |
PROCEDURE [stdcall] _error* (module, err, line: INTEGER); |
VAR |
s, temp: ARRAY 1024 OF CHAR; |
477,7 → 472,7 |
BEGIN |
s := ""; |
CASE err MOD 16 OF |
CASE err OF |
| 1: append(s, "assertion failure") |
| 2: append(s, "NIL dereference") |
| 3: append(s, "division by zero") |
494,7 → 489,7 |
append(s, API.eol); |
append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol); |
append(s, "line: "); IntToStr(LSR(err, 4), temp); append(s, temp); |
append(s, "line: "); IntToStr(line, temp); append(s, temp); |
API.DebugMsg(SYSTEM.ADR(s[0]), name); |
502,69 → 497,42 |
END _error; |
PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): BOOLEAN; |
PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): INTEGER; |
BEGIN |
(* r IS t0 *) |
WHILE (t1 # 0) & (t1 # t0) DO |
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) |
END |
RETURN t1 = t0 |
SYSTEM.GET(t0 + t1 + types, t0) |
RETURN t0 MOD 2 |
END _isrec; |
PROCEDURE [stdcall] _is* (t0, p: INTEGER): BOOLEAN; |
VAR |
t1: INTEGER; |
PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER; |
BEGIN |
(* p IS t0 *) |
IF p # 0 THEN |
DEC(p, SIZE_OF_DWORD); |
SYSTEM.GET(p, t1); |
WHILE (t1 # 0) & (t1 # t0) DO |
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) |
SYSTEM.GET(p - SIZE_OF_DWORD, p); |
SYSTEM.GET(t0 + p + types, p) |
END |
ELSE |
t1 := -1 |
END |
RETURN t1 = t0 |
RETURN p MOD 2 |
END _is; |
PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): BOOLEAN; |
PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): INTEGER; |
BEGIN |
(* r:t1 IS t0 *) |
WHILE (t1 # 0) & (t1 # t0) DO |
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) |
END |
RETURN t1 = t0 |
SYSTEM.GET(t0 + t1 + types, t0) |
RETURN t0 MOD 2 |
END _guardrec; |
PROCEDURE [stdcall] _guard* (t0, p: INTEGER): BOOLEAN; |
VAR |
t1: INTEGER; |
PROCEDURE [stdcall] _guard* (t0, p: INTEGER): INTEGER; |
BEGIN |
(* p IS t0 *) |
SYSTEM.GET(p, p); |
IF p # 0 THEN |
DEC(p, SIZE_OF_DWORD); |
SYSTEM.GET(p, t1); |
WHILE (t1 # t0) & (t1 # 0) DO |
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) |
END |
SYSTEM.GET(p - SIZE_OF_DWORD, p); |
SYSTEM.GET(t0 + p + types, p) |
ELSE |
t1 := t0 |
p := 1 |
END |
RETURN t1 = t0 |
RETURN p MOD 2 |
END _guard; |
613,18 → 581,50 |
END _exit; |
PROCEDURE [stdcall] _init* (modname: INTEGER; typesc, _types: INTEGER; code, param: INTEGER); |
PROCEDURE [stdcall] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER); |
VAR |
t0, t1, i, j: INTEGER; |
BEGIN |
SYSTEM.CODE(09BH, 0DBH, 0E3H); (* finit *) |
API.init(param, code); |
types := _types; |
types := API._NEW(tcount * tcount + SYSTEM.SIZE(INTEGER)); |
ASSERT(types # 0); |
FOR i := 0 TO tcount - 1 DO |
FOR j := 0 TO tcount - 1 DO |
t0 := i; t1 := j; |
WHILE (t1 # 0) & (t1 # t0) DO |
SYSTEM.GET(_types + t1 * SIZE_OF_DWORD, t1) |
END; |
SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1)) |
END |
END; |
name := modname; |
dll.process_detach := NIL; |
dll.thread_detach := NIL; |
dll.thread_attach := NIL; |
fini := NIL |
END _init; |
PROCEDURE [stdcall] _sofinit*; |
BEGIN |
IF fini # NIL THEN |
fini |
END |
END _sofinit; |
PROCEDURE SetFini* (ProcFini: PROC); |
BEGIN |
fini := ProcFini |
END SetFini; |
END RTL. |
/programs/develop/oberon07/Lib/KolibriOS/Vector.ob07 |
---|
1,4 → 1,4 |
(* |
(* |
Copyright 2016 Anton Krotov |
This program is free software: you can redistribute it and/or modify |
/programs/develop/oberon07/Lib/Linux32/LINAPI.ob07 |
---|
38,16 → 38,6 |
clock_gettime* : PROCEDURE [linux] (clock_id: INTEGER; VAR tp: TP): INTEGER; |
PROCEDURE dlopen* (filename: ARRAY OF CHAR): INTEGER; |
RETURN API.dlopen(SYSTEM.ADR(filename[0]), 1) |
END dlopen; |
PROCEDURE dlsym* (handle: INTEGER; symbol: ARRAY OF CHAR): INTEGER; |
RETURN API.dlsym(handle, SYSTEM.ADR(symbol[0])) |
END dlsym; |
PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR); |
VAR |
i, len, ptr: INTEGER; |
/programs/develop/oberon07/Lib/Linux32/RTL.ob07 |
---|
22,11 → 22,13 |
DLL_PROCESS_DETACH = 0; |
SIZE_OF_DWORD = 4; |
MAX_SET = 31; |
TYPE |
DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER); |
PROC = PROCEDURE; |
VAR |
40,7 → 42,9 |
thread_attach: DLL_ENTRY |
END; |
fini: PROC; |
PROCEDURE [stdcall] _move* (bytes, source, dest: INTEGER); |
BEGIN |
SYSTEM.CODE( |
107,18 → 111,12 |
END _arrcpy; |
PROCEDURE [stdcall] _strcpy* (chr_size, len_dst, dst, len_src, src: INTEGER); |
PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER); |
BEGIN |
_move(MIN(len_dst, len_src) * chr_size, src, dst) |
END _strcpy; |
PROCEDURE [stdcall] _strcpy2* (chr_size, len_src, src, len_dst, dst: INTEGER); |
BEGIN |
_move(MIN(len_dst, len_src) * chr_size, src, dst) |
END _strcpy2; |
PROCEDURE [stdcall] _rot* (VAR A: ARRAY OF INTEGER); |
VAR |
i, n, k: INTEGER; |
137,30 → 135,27 |
END _rot; |
PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER; |
VAR |
res: INTEGER; |
PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER; |
BEGIN |
IF (a <= b) & (a <= 31) & (b >= 0) THEN |
IF b > 31 THEN |
b := 31 |
IF (a <= b) & (a <= MAX_SET) & (b >= 0) THEN |
IF b > MAX_SET THEN |
b := MAX_SET |
END; |
IF a < 0 THEN |
a := 0 |
END; |
res := LSR(ASR(ROR(1, 1), b - a), 31 - b) |
a := LSR(ASR(ROR(1, 1), b - a), MAX_SET - b) |
ELSE |
res := 0 |
a := 0 |
END |
RETURN res |
END _set2; |
RETURN a |
END _set; |
PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER; |
RETURN _set2(a, b) |
END _set; |
PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER; |
RETURN _set(b, a) |
END _set2; |
PROCEDURE [stdcall] divmod (a, b: INTEGER; VAR mod: INTEGER): INTEGER; |
185,7 → 180,7 |
END divmod; |
PROCEDURE div_ (x, y: INTEGER): INTEGER; |
PROCEDURE [stdcall] _div2* (x, y: INTEGER): INTEGER; |
VAR |
div, mod: INTEGER; |
196,10 → 191,10 |
END |
RETURN div |
END div_; |
END _div2; |
PROCEDURE mod_ (x, y: INTEGER): INTEGER; |
PROCEDURE [stdcall] _mod2* (x, y: INTEGER): INTEGER; |
VAR |
div, mod: INTEGER; |
210,29 → 205,19 |
END |
RETURN mod |
END mod_; |
END _mod2; |
PROCEDURE [stdcall] _div* (b, a: INTEGER): INTEGER; |
RETURN div_(a, b) |
RETURN _div2(a, b) |
END _div; |
PROCEDURE [stdcall] _div2* (a, b: INTEGER): INTEGER; |
RETURN div_(a, b) |
END _div2; |
PROCEDURE [stdcall] _mod* (b, a: INTEGER): INTEGER; |
RETURN mod_(a, b) |
RETURN _mod2(a, b) |
END _mod; |
PROCEDURE [stdcall] _mod2* (a, b: INTEGER): INTEGER; |
RETURN mod_(a, b) |
END _mod2; |
PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER); |
BEGIN |
ptr := API._NEW(size); |
251,50 → 236,6 |
END _dispose; |
PROCEDURE strncmp (a, b, n: INTEGER): INTEGER; |
VAR |
A, B: CHAR; |
res: INTEGER; |
BEGIN |
res := 0; |
WHILE n > 0 DO |
SYSTEM.GET(a, A); INC(a); |
SYSTEM.GET(b, B); INC(b); |
DEC(n); |
IF A # B THEN |
res := ORD(A) - ORD(B); |
n := 0 |
ELSIF A = 0X THEN |
n := 0 |
END |
END |
RETURN res |
END strncmp; |
PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER; |
VAR |
A, B: WCHAR; |
res: INTEGER; |
BEGIN |
res := 0; |
WHILE n > 0 DO |
SYSTEM.GET(a, A); INC(a, 2); |
SYSTEM.GET(b, B); INC(b, 2); |
DEC(n); |
IF A # B THEN |
res := ORD(A) - ORD(B); |
n := 0 |
ELSIF A = 0X THEN |
n := 0 |
END |
END |
RETURN res |
END strncmpw; |
PROCEDURE [stdcall] _length* (len, str: INTEGER): INTEGER; |
BEGIN |
SYSTEM.CODE( |
345,16 → 286,71 |
END _lengthw; |
PROCEDURE strncmp (a, b, n: INTEGER): INTEGER; |
VAR |
A, B: CHAR; |
res: INTEGER; |
BEGIN |
res := minint; |
WHILE n > 0 DO |
SYSTEM.GET(a, A); INC(a); |
SYSTEM.GET(b, B); INC(b); |
DEC(n); |
IF A # B THEN |
res := ORD(A) - ORD(B); |
n := 0 |
ELSIF A = 0X THEN |
res := 0; |
n := 0 |
END |
END |
RETURN res |
END strncmp; |
PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER; |
VAR |
A, B: WCHAR; |
res: INTEGER; |
BEGIN |
res := minint; |
WHILE n > 0 DO |
SYSTEM.GET(a, A); INC(a, 2); |
SYSTEM.GET(b, B); INC(b, 2); |
DEC(n); |
IF A # B THEN |
res := ORD(A) - ORD(B); |
n := 0 |
ELSIF A = 0X THEN |
res := 0; |
n := 0 |
END |
END |
RETURN res |
END strncmpw; |
PROCEDURE [stdcall] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN; |
VAR |
res: INTEGER; |
bRes: BOOLEAN; |
c: CHAR; |
BEGIN |
res := strncmp(str1, str2, MIN(len1, len2)); |
IF res = 0 THEN |
res := _length(len1, str1) - _length(len2, str2) |
IF res = minint THEN |
IF len1 > len2 THEN |
SYSTEM.GET(str1 + len2, c); |
res := ORD(c) |
ELSIF len1 < len2 THEN |
SYSTEM.GET(str2 + len1, c); |
res := -ORD(c) |
ELSE |
res := 0 |
END |
END; |
CASE op OF |
370,21 → 366,25 |
END _strcmp; |
PROCEDURE [stdcall] _strcmp2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN; |
RETURN _strcmp(op, len2, str2, len1, str1) |
END _strcmp2; |
PROCEDURE [stdcall] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN; |
VAR |
res: INTEGER; |
bRes: BOOLEAN; |
c: WCHAR; |
BEGIN |
res := strncmpw(str1, str2, MIN(len1, len2)); |
IF res = 0 THEN |
res := _lengthw(len1, str1) - _lengthw(len2, str2) |
IF res = minint THEN |
IF len1 > len2 THEN |
SYSTEM.GET(str1 + len2 * 2, c); |
res := ORD(c) |
ELSIF len1 < len2 THEN |
SYSTEM.GET(str2 + len1 * 2, c); |
res := -ORD(c) |
ELSE |
res := 0 |
END |
END; |
CASE op OF |
400,11 → 400,6 |
END _strcmpw; |
PROCEDURE [stdcall] _strcmpw2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN; |
RETURN _strcmpw(op, len2, str2, len1, str1) |
END _strcmpw2; |
PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR); |
VAR |
c: CHAR; |
470,7 → 465,7 |
END append; |
PROCEDURE [stdcall] _error* (module, err: INTEGER); |
PROCEDURE [stdcall] _error* (module, err, line: INTEGER); |
VAR |
s, temp: ARRAY 1024 OF CHAR; |
477,7 → 472,7 |
BEGIN |
s := ""; |
CASE err MOD 16 OF |
CASE err OF |
| 1: append(s, "assertion failure") |
| 2: append(s, "NIL dereference") |
| 3: append(s, "division by zero") |
494,7 → 489,7 |
append(s, API.eol); |
append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol); |
append(s, "line: "); IntToStr(LSR(err, 4), temp); append(s, temp); |
append(s, "line: "); IntToStr(line, temp); append(s, temp); |
API.DebugMsg(SYSTEM.ADR(s[0]), name); |
502,69 → 497,42 |
END _error; |
PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): BOOLEAN; |
PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): INTEGER; |
BEGIN |
(* r IS t0 *) |
WHILE (t1 # 0) & (t1 # t0) DO |
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) |
END |
RETURN t1 = t0 |
SYSTEM.GET(t0 + t1 + types, t0) |
RETURN t0 MOD 2 |
END _isrec; |
PROCEDURE [stdcall] _is* (t0, p: INTEGER): BOOLEAN; |
VAR |
t1: INTEGER; |
PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER; |
BEGIN |
(* p IS t0 *) |
IF p # 0 THEN |
DEC(p, SIZE_OF_DWORD); |
SYSTEM.GET(p, t1); |
WHILE (t1 # 0) & (t1 # t0) DO |
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) |
SYSTEM.GET(p - SIZE_OF_DWORD, p); |
SYSTEM.GET(t0 + p + types, p) |
END |
ELSE |
t1 := -1 |
END |
RETURN t1 = t0 |
RETURN p MOD 2 |
END _is; |
PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): BOOLEAN; |
PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): INTEGER; |
BEGIN |
(* r:t1 IS t0 *) |
WHILE (t1 # 0) & (t1 # t0) DO |
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) |
END |
RETURN t1 = t0 |
SYSTEM.GET(t0 + t1 + types, t0) |
RETURN t0 MOD 2 |
END _guardrec; |
PROCEDURE [stdcall] _guard* (t0, p: INTEGER): BOOLEAN; |
VAR |
t1: INTEGER; |
PROCEDURE [stdcall] _guard* (t0, p: INTEGER): INTEGER; |
BEGIN |
(* p IS t0 *) |
SYSTEM.GET(p, p); |
IF p # 0 THEN |
DEC(p, SIZE_OF_DWORD); |
SYSTEM.GET(p, t1); |
WHILE (t1 # t0) & (t1 # 0) DO |
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) |
END |
SYSTEM.GET(p - SIZE_OF_DWORD, p); |
SYSTEM.GET(t0 + p + types, p) |
ELSE |
t1 := t0 |
p := 1 |
END |
RETURN t1 = t0 |
RETURN p MOD 2 |
END _guard; |
613,18 → 581,50 |
END _exit; |
PROCEDURE [stdcall] _init* (modname: INTEGER; typesc, _types: INTEGER; code, param: INTEGER); |
PROCEDURE [stdcall] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER); |
VAR |
t0, t1, i, j: INTEGER; |
BEGIN |
SYSTEM.CODE(09BH, 0DBH, 0E3H); (* finit *) |
API.init(param, code); |
types := _types; |
types := API._NEW(tcount * tcount + SYSTEM.SIZE(INTEGER)); |
ASSERT(types # 0); |
FOR i := 0 TO tcount - 1 DO |
FOR j := 0 TO tcount - 1 DO |
t0 := i; t1 := j; |
WHILE (t1 # 0) & (t1 # t0) DO |
SYSTEM.GET(_types + t1 * SIZE_OF_DWORD, t1) |
END; |
SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1)) |
END |
END; |
name := modname; |
dll.process_detach := NIL; |
dll.thread_detach := NIL; |
dll.thread_attach := NIL; |
fini := NIL |
END _init; |
PROCEDURE [stdcall] _sofinit*; |
BEGIN |
IF fini # NIL THEN |
fini |
END |
END _sofinit; |
PROCEDURE SetFini* (ProcFini: PROC); |
BEGIN |
fini := ProcFini |
END SetFini; |
END RTL. |
/programs/develop/oberon07/Lib/Windows32/API.ob07 |
---|
13,12 → 13,14 |
eol*: ARRAY 3 OF CHAR; |
base*: INTEGER; |
heap: INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "ExitProcess"] ExitProcess (code: INTEGER); |
PROCEDURE [windows-, "kernel32.dll", "ExitThread"] ExitThread (code: INTEGER); |
PROCEDURE [windows-, "kernel32.dll", "GlobalAlloc"] Alloc (uFlags, dwBytes: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "GlobalFree"] Free (hMem: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "GetProcessHeap"] GetProcessHeap (): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "HeapAlloc"] HeapAlloc (hHeap, dwFlags, dwBytes: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "HeapFree"] HeapFree(hHeap, dwFlags, lpMem: INTEGER); |
PROCEDURE [windows-, "user32.dll", "MessageBoxA"] MessageBoxA (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER; |
30,12 → 32,14 |
PROCEDURE _NEW* (size: INTEGER): INTEGER; |
RETURN Alloc(64, size) |
RETURN HeapAlloc(heap, 8, size) |
END _NEW; |
PROCEDURE _DISPOSE* (p: INTEGER): INTEGER; |
RETURN Free(p) |
BEGIN |
HeapFree(heap, 0, p) |
RETURN 0 |
END _DISPOSE; |
42,7 → 46,8 |
PROCEDURE init* (reserved, code: INTEGER); |
BEGIN |
eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X; |
base := code - 4096 |
base := code - 4096; |
heap := GetProcessHeap() |
END init; |
/programs/develop/oberon07/Lib/Windows32/RTL.ob07 |
---|
22,11 → 22,13 |
DLL_PROCESS_DETACH = 0; |
SIZE_OF_DWORD = 4; |
MAX_SET = 31; |
TYPE |
DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER); |
PROC = PROCEDURE; |
VAR |
40,7 → 42,9 |
thread_attach: DLL_ENTRY |
END; |
fini: PROC; |
PROCEDURE [stdcall] _move* (bytes, source, dest: INTEGER); |
BEGIN |
SYSTEM.CODE( |
107,18 → 111,12 |
END _arrcpy; |
PROCEDURE [stdcall] _strcpy* (chr_size, len_dst, dst, len_src, src: INTEGER); |
PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER); |
BEGIN |
_move(MIN(len_dst, len_src) * chr_size, src, dst) |
END _strcpy; |
PROCEDURE [stdcall] _strcpy2* (chr_size, len_src, src, len_dst, dst: INTEGER); |
BEGIN |
_move(MIN(len_dst, len_src) * chr_size, src, dst) |
END _strcpy2; |
PROCEDURE [stdcall] _rot* (VAR A: ARRAY OF INTEGER); |
VAR |
i, n, k: INTEGER; |
137,30 → 135,27 |
END _rot; |
PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER; |
VAR |
res: INTEGER; |
PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER; |
BEGIN |
IF (a <= b) & (a <= 31) & (b >= 0) THEN |
IF b > 31 THEN |
b := 31 |
IF (a <= b) & (a <= MAX_SET) & (b >= 0) THEN |
IF b > MAX_SET THEN |
b := MAX_SET |
END; |
IF a < 0 THEN |
a := 0 |
END; |
res := LSR(ASR(ROR(1, 1), b - a), 31 - b) |
a := LSR(ASR(ROR(1, 1), b - a), MAX_SET - b) |
ELSE |
res := 0 |
a := 0 |
END |
RETURN res |
END _set2; |
RETURN a |
END _set; |
PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER; |
RETURN _set2(a, b) |
END _set; |
PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER; |
RETURN _set(b, a) |
END _set2; |
PROCEDURE [stdcall] divmod (a, b: INTEGER; VAR mod: INTEGER): INTEGER; |
185,7 → 180,7 |
END divmod; |
PROCEDURE div_ (x, y: INTEGER): INTEGER; |
PROCEDURE [stdcall] _div2* (x, y: INTEGER): INTEGER; |
VAR |
div, mod: INTEGER; |
196,10 → 191,10 |
END |
RETURN div |
END div_; |
END _div2; |
PROCEDURE mod_ (x, y: INTEGER): INTEGER; |
PROCEDURE [stdcall] _mod2* (x, y: INTEGER): INTEGER; |
VAR |
div, mod: INTEGER; |
210,29 → 205,19 |
END |
RETURN mod |
END mod_; |
END _mod2; |
PROCEDURE [stdcall] _div* (b, a: INTEGER): INTEGER; |
RETURN div_(a, b) |
RETURN _div2(a, b) |
END _div; |
PROCEDURE [stdcall] _div2* (a, b: INTEGER): INTEGER; |
RETURN div_(a, b) |
END _div2; |
PROCEDURE [stdcall] _mod* (b, a: INTEGER): INTEGER; |
RETURN mod_(a, b) |
RETURN _mod2(a, b) |
END _mod; |
PROCEDURE [stdcall] _mod2* (a, b: INTEGER): INTEGER; |
RETURN mod_(a, b) |
END _mod2; |
PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER); |
BEGIN |
ptr := API._NEW(size); |
251,50 → 236,6 |
END _dispose; |
PROCEDURE strncmp (a, b, n: INTEGER): INTEGER; |
VAR |
A, B: CHAR; |
res: INTEGER; |
BEGIN |
res := 0; |
WHILE n > 0 DO |
SYSTEM.GET(a, A); INC(a); |
SYSTEM.GET(b, B); INC(b); |
DEC(n); |
IF A # B THEN |
res := ORD(A) - ORD(B); |
n := 0 |
ELSIF A = 0X THEN |
n := 0 |
END |
END |
RETURN res |
END strncmp; |
PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER; |
VAR |
A, B: WCHAR; |
res: INTEGER; |
BEGIN |
res := 0; |
WHILE n > 0 DO |
SYSTEM.GET(a, A); INC(a, 2); |
SYSTEM.GET(b, B); INC(b, 2); |
DEC(n); |
IF A # B THEN |
res := ORD(A) - ORD(B); |
n := 0 |
ELSIF A = 0X THEN |
n := 0 |
END |
END |
RETURN res |
END strncmpw; |
PROCEDURE [stdcall] _length* (len, str: INTEGER): INTEGER; |
BEGIN |
SYSTEM.CODE( |
345,16 → 286,71 |
END _lengthw; |
PROCEDURE strncmp (a, b, n: INTEGER): INTEGER; |
VAR |
A, B: CHAR; |
res: INTEGER; |
BEGIN |
res := minint; |
WHILE n > 0 DO |
SYSTEM.GET(a, A); INC(a); |
SYSTEM.GET(b, B); INC(b); |
DEC(n); |
IF A # B THEN |
res := ORD(A) - ORD(B); |
n := 0 |
ELSIF A = 0X THEN |
res := 0; |
n := 0 |
END |
END |
RETURN res |
END strncmp; |
PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER; |
VAR |
A, B: WCHAR; |
res: INTEGER; |
BEGIN |
res := minint; |
WHILE n > 0 DO |
SYSTEM.GET(a, A); INC(a, 2); |
SYSTEM.GET(b, B); INC(b, 2); |
DEC(n); |
IF A # B THEN |
res := ORD(A) - ORD(B); |
n := 0 |
ELSIF A = 0X THEN |
res := 0; |
n := 0 |
END |
END |
RETURN res |
END strncmpw; |
PROCEDURE [stdcall] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN; |
VAR |
res: INTEGER; |
bRes: BOOLEAN; |
c: CHAR; |
BEGIN |
res := strncmp(str1, str2, MIN(len1, len2)); |
IF res = 0 THEN |
res := _length(len1, str1) - _length(len2, str2) |
IF res = minint THEN |
IF len1 > len2 THEN |
SYSTEM.GET(str1 + len2, c); |
res := ORD(c) |
ELSIF len1 < len2 THEN |
SYSTEM.GET(str2 + len1, c); |
res := -ORD(c) |
ELSE |
res := 0 |
END |
END; |
CASE op OF |
370,21 → 366,25 |
END _strcmp; |
PROCEDURE [stdcall] _strcmp2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN; |
RETURN _strcmp(op, len2, str2, len1, str1) |
END _strcmp2; |
PROCEDURE [stdcall] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN; |
VAR |
res: INTEGER; |
bRes: BOOLEAN; |
c: WCHAR; |
BEGIN |
res := strncmpw(str1, str2, MIN(len1, len2)); |
IF res = 0 THEN |
res := _lengthw(len1, str1) - _lengthw(len2, str2) |
IF res = minint THEN |
IF len1 > len2 THEN |
SYSTEM.GET(str1 + len2 * 2, c); |
res := ORD(c) |
ELSIF len1 < len2 THEN |
SYSTEM.GET(str2 + len1 * 2, c); |
res := -ORD(c) |
ELSE |
res := 0 |
END |
END; |
CASE op OF |
400,11 → 400,6 |
END _strcmpw; |
PROCEDURE [stdcall] _strcmpw2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN; |
RETURN _strcmpw(op, len2, str2, len1, str1) |
END _strcmpw2; |
PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR); |
VAR |
c: CHAR; |
470,7 → 465,7 |
END append; |
PROCEDURE [stdcall] _error* (module, err: INTEGER); |
PROCEDURE [stdcall] _error* (module, err, line: INTEGER); |
VAR |
s, temp: ARRAY 1024 OF CHAR; |
477,7 → 472,7 |
BEGIN |
s := ""; |
CASE err MOD 16 OF |
CASE err OF |
| 1: append(s, "assertion failure") |
| 2: append(s, "NIL dereference") |
| 3: append(s, "division by zero") |
494,7 → 489,7 |
append(s, API.eol); |
append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol); |
append(s, "line: "); IntToStr(LSR(err, 4), temp); append(s, temp); |
append(s, "line: "); IntToStr(line, temp); append(s, temp); |
API.DebugMsg(SYSTEM.ADR(s[0]), name); |
502,69 → 497,42 |
END _error; |
PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): BOOLEAN; |
PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): INTEGER; |
BEGIN |
(* r IS t0 *) |
WHILE (t1 # 0) & (t1 # t0) DO |
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) |
END |
RETURN t1 = t0 |
SYSTEM.GET(t0 + t1 + types, t0) |
RETURN t0 MOD 2 |
END _isrec; |
PROCEDURE [stdcall] _is* (t0, p: INTEGER): BOOLEAN; |
VAR |
t1: INTEGER; |
PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER; |
BEGIN |
(* p IS t0 *) |
IF p # 0 THEN |
DEC(p, SIZE_OF_DWORD); |
SYSTEM.GET(p, t1); |
WHILE (t1 # 0) & (t1 # t0) DO |
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) |
SYSTEM.GET(p - SIZE_OF_DWORD, p); |
SYSTEM.GET(t0 + p + types, p) |
END |
ELSE |
t1 := -1 |
END |
RETURN t1 = t0 |
RETURN p MOD 2 |
END _is; |
PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): BOOLEAN; |
PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): INTEGER; |
BEGIN |
(* r:t1 IS t0 *) |
WHILE (t1 # 0) & (t1 # t0) DO |
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) |
END |
RETURN t1 = t0 |
SYSTEM.GET(t0 + t1 + types, t0) |
RETURN t0 MOD 2 |
END _guardrec; |
PROCEDURE [stdcall] _guard* (t0, p: INTEGER): BOOLEAN; |
VAR |
t1: INTEGER; |
PROCEDURE [stdcall] _guard* (t0, p: INTEGER): INTEGER; |
BEGIN |
(* p IS t0 *) |
SYSTEM.GET(p, p); |
IF p # 0 THEN |
DEC(p, SIZE_OF_DWORD); |
SYSTEM.GET(p, t1); |
WHILE (t1 # t0) & (t1 # 0) DO |
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) |
END |
SYSTEM.GET(p - SIZE_OF_DWORD, p); |
SYSTEM.GET(t0 + p + types, p) |
ELSE |
t1 := t0 |
p := 1 |
END |
RETURN t1 = t0 |
RETURN p MOD 2 |
END _guard; |
613,18 → 581,50 |
END _exit; |
PROCEDURE [stdcall] _init* (modname: INTEGER; typesc, _types: INTEGER; code, param: INTEGER); |
PROCEDURE [stdcall] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER); |
VAR |
t0, t1, i, j: INTEGER; |
BEGIN |
SYSTEM.CODE(09BH, 0DBH, 0E3H); (* finit *) |
API.init(param, code); |
types := _types; |
types := API._NEW(tcount * tcount + SYSTEM.SIZE(INTEGER)); |
ASSERT(types # 0); |
FOR i := 0 TO tcount - 1 DO |
FOR j := 0 TO tcount - 1 DO |
t0 := i; t1 := j; |
WHILE (t1 # 0) & (t1 # t0) DO |
SYSTEM.GET(_types + t1 * SIZE_OF_DWORD, t1) |
END; |
SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1)) |
END |
END; |
name := modname; |
dll.process_detach := NIL; |
dll.thread_detach := NIL; |
dll.thread_attach := NIL; |
fini := NIL |
END _init; |
PROCEDURE [stdcall] _sofinit*; |
BEGIN |
IF fini # NIL THEN |
fini |
END |
END _sofinit; |
PROCEDURE SetFini* (ProcFini: PROC); |
BEGIN |
fini := ProcFini |
END SetFini; |
END RTL. |
/programs/develop/oberon07/Source/AMD64.ob07 |
---|
7,7 → 7,7 |
MODULE AMD64; |
IMPORT CODE, BIN, WR := WRITER, CHL := CHUNKLISTS, MACHINE, LISTS, PATHS, |
IMPORT IL, BIN, WR := WRITER, CHL := CHUNKLISTS, LISTS, PATHS, PROG, |
REG, C := CONSOLE, UTILS, mConst := CONSTANTS, S := STRINGS, PE32, ELF, X86; |
31,7 → 31,7 |
sete = 94H; setne = 95H; setl = 9CH; setge = 9DH; setle = 9EH; setg = 9FH; setc = 92H; setnc = 93H; |
shl = CODE.opLSL2; shr = CODE.opLSR2; sar = CODE.opASR2; ror = CODE.opROR2; |
shl = IL.opLSL2; shr = IL.opLSR2; sar = IL.opASR2; ror = IL.opROR2; |
sCODE = BIN.PICCODE; |
sDATA = BIN.PICDATA; |
41,7 → 41,7 |
TYPE |
COMMAND = CODE.COMMAND; |
COMMAND = IL.COMMAND; |
Number = POINTER TO RECORD (LISTS.ITEM) value: INTEGER END; |
58,8 → 58,10 |
prog: BIN.PROGRAM; |
dllret: INTEGER; |
tcount: INTEGER; |
dllret, sofinit: INTEGER; |
Win64RegPar: ARRAY 4 OF INTEGER; |
SystemVRegPar: ARRAY 6 OF INTEGER; |
87,10 → 89,10 |
PROCEDURE OutInt (n: INTEGER); |
BEGIN |
OutByte(MACHINE.Byte(n, 0)); |
OutByte(MACHINE.Byte(n, 1)); |
OutByte(MACHINE.Byte(n, 2)); |
OutByte(MACHINE.Byte(n, 3)) |
OutByte(UTILS.Byte(n, 0)); |
OutByte(UTILS.Byte(n, 1)); |
OutByte(UTILS.Byte(n, 2)); |
OutByte(UTILS.Byte(n, 3)) |
END OutInt; |
112,7 → 114,7 |
PROCEDURE OutIntByte (n: INTEGER); |
BEGIN |
IF isByte(n) THEN |
OutByte(MACHINE.Byte(n, 0)) |
OutByte(UTILS.Byte(n, 0)) |
ELSE |
OutInt(n) |
END |
120,7 → 122,7 |
PROCEDURE isLong (n: INTEGER): BOOLEAN; |
RETURN (n > MACHINE.max32) OR (n < MACHINE.min32) |
RETURN (n > UTILS.max32) OR (n < UTILS.min32) |
END isLong; |
139,7 → 141,7 |
PROCEDURE NewLabel (): INTEGER; |
BEGIN |
BIN.NewLabel(prog) |
RETURN CODE.NewLabel() |
RETURN IL.NewLabel() |
END NewLabel; |
257,12 → 259,22 |
END drop; |
PROCEDURE GetAnyReg (): INTEGER; |
RETURN REG.GetAnyReg(R) |
END GetAnyReg; |
PROCEDURE GetVarReg (offs: INTEGER): INTEGER; |
RETURN REG.GetVarReg(R, offs) |
END GetVarReg; |
PROCEDURE callimp (label: INTEGER); |
VAR |
reg: INTEGER; |
BEGIN |
reg := REG.GetAnyReg(R); |
reg := GetAnyReg(); |
lea(reg, label, sIMP); |
IF reg >= 8 THEN // call qword[reg] |
OutByte(41H) |
277,7 → 289,7 |
reg: INTEGER; |
BEGIN |
reg := REG.GetAnyReg(R); |
reg := GetAnyReg(); |
lea(reg, offs, sDATA); |
push(reg); |
drop |
290,7 → 302,7 |
BEGIN |
REG.Store(R); |
label := CODE.codes.rtl[proc]; |
label := IL.codes.rtl[proc]; |
IF label < 0 THEN |
callimp(-label) |
ELSE |
315,7 → 327,7 |
PROCEDURE PushAll (NumberOfParameters: INTEGER); |
BEGIN |
REG.PushAll(R); |
R.pushed := R.pushed - NumberOfParameters |
DEC(R.pushed, NumberOfParameters) |
END PushAll; |
327,7 → 339,7 |
Rex(reg, 0); |
OutByte(0B8H + reg MOD 8); // movabs reg, n |
FOR i := 0 TO 7 DO |
OutByte(MACHINE.Byte(n, i)) |
OutByte(UTILS.Byte(n, i)) |
END |
END movabs; |
336,6 → 348,8 |
BEGIN |
IF isLong(n) THEN |
movabs(reg, n) |
ELSIF n = 0 THEN |
xor(reg, reg) |
ELSE |
Rex(reg, 0); |
OutByte2(0C7H, 0C0H + reg MOD 8); |
355,7 → 369,7 |
reg2: INTEGER; |
BEGIN |
reg2 := REG.GetAnyReg(R); |
reg2 := GetAnyReg(); |
movabs(reg2, n); |
oprr(reg, reg2); |
drop |
404,7 → 418,7 |
BEGIN |
IF isLong(n) THEN |
reg2 := REG.GetAnyReg(R); |
reg2 := GetAnyReg(); |
movabs(reg2, n); |
push(reg2); |
drop |
642,14 → 656,14 |
END shiftrc; |
PROCEDURE getVar (variables: LISTS.LIST; offset: INTEGER): CODE.LOCALVAR; |
PROCEDURE getVar (variables: LISTS.LIST; offset: INTEGER): IL.LOCALVAR; |
VAR |
cur: CODE.LOCALVAR; |
cur: IL.LOCALVAR; |
BEGIN |
cur := variables.first(CODE.LOCALVAR); |
cur := variables.first(IL.LOCALVAR); |
WHILE (cur # NIL) & (cur.offset # offset) DO |
cur := cur.next(CODE.LOCALVAR) |
cur := cur.next(IL.LOCALVAR) |
END |
RETURN cur |
662,7 → 676,7 |
leaf: BOOLEAN; |
cur: COMMAND; |
variables: LISTS.LIST; |
lvar, rvar: CODE.LOCALVAR; |
lvar, rvar: IL.LOCALVAR; |
reg: INTEGER; |
max: INTEGER; |
loop: INTEGER; |
677,83 → 691,76 |
cur := cmd.next(COMMAND); |
REPEAT |
CASE cur.opcode OF |
|CODE.opLLOAD64, |
CODE.opLLOAD8, |
CODE.opLLOAD16, |
CODE.opLLOAD32, |
CODE.opLLOAD64_PARAM, |
CODE.opLLOAD32_PARAM, |
CODE.opLADR_SAVE, |
CODE.opLADR_INC1, |
CODE.opLADR_DEC1, |
CODE.opLADR_INC, |
CODE.opLADR_DEC, |
CODE.opLADR_INC1B, |
CODE.opLADR_DEC1B, |
CODE.opLADR_INCB, |
CODE.opLADR_DECB, |
CODE.opLADR_INCL, |
CODE.opLADR_EXCL, |
CODE.opLADR_UNPK: |
|IL.opLLOAD64, |
IL.opLLOAD8, |
IL.opLLOAD16, |
IL.opLLOAD32, |
IL.opLLOAD64_PARAM, |
IL.opLLOAD32_PARAM, |
IL.opLADR_SAVE, |
IL.opLADR_INC, |
IL.opLADR_DEC, |
IL.opLADR_INCB, |
IL.opLADR_DECB, |
IL.opLADR_INCL, |
IL.opLADR_EXCL, |
IL.opLADR_UNPK: |
lvar := getVar(variables, cur.param2); |
IF (lvar # NIL) & (lvar.count # -1) THEN |
INC(lvar.count, loop) |
END |
|CODE.opLADR_SAVEC, |
CODE.opLADR_INCC, |
CODE.opLADR_DECC, |
CODE.opLADR_INCCB, |
CODE.opLADR_DECCB, |
CODE.opLADR_INCLC, |
CODE.opLADR_EXCLC: |
|IL.opLADR_SAVEC, |
IL.opLADR_INCC, |
IL.opLADR_INCCB, |
IL.opLADR_DECCB, |
IL.opLADR_INCLC, |
IL.opLADR_EXCLC: |
lvar := getVar(variables, cur.param1); |
IF (lvar # NIL) & (lvar.count # -1) THEN |
INC(lvar.count, loop) |
END |
|CODE.opLADR: |
|IL.opLADR: |
lvar := getVar(variables, cur.param2); |
IF (lvar # NIL) & (lvar.count # -1) THEN |
lvar.count := -1 |
END |
|CODE.opLOOP: |
|IL.opLOOP: |
INC(loop, 10) |
|CODE.opENDLOOP: |
|IL.opENDLOOP: |
DEC(loop, 10) |
|CODE.opLEAVE, |
CODE.opLEAVER, |
CODE.opLEAVEF: |
|IL.opLEAVE, |
IL.opLEAVER, |
IL.opLEAVEF: |
leave := TRUE |
|CODE.opCALL, CODE.opCALLP, CODE.opCALLI, |
CODE.opWIN64CALL, CODE.opWIN64CALLP, CODE.opWIN64CALLI, |
CODE.opSYSVCALL, CODE.opSYSVCALLP, CODE.opSYSVCALLI, |
|IL.opCALL, IL.opCALLP, IL.opCALLI, |
IL.opWIN64CALL, IL.opWIN64CALLP, IL.opWIN64CALLI, |
IL.opSYSVCALL, IL.opSYSVCALLP, IL.opSYSVCALLI, |
CODE.opSAVES, CODE.opRSET, CODE.opRSETR, |
CODE.opRSETL, CODE.opRSET1, |
CODE.opEQS .. CODE.opGES, |
CODE.opEQS2 .. CODE.opGES2, |
CODE.opEQSW .. CODE.opGESW, |
CODE.opEQSW2 .. CODE.opGESW2, |
CODE.opCOPY, CODE.opMOVE, CODE.opCOPYA, |
CODE.opCOPYS, CODE.opCOPYS2, CODE.opROT, |
CODE.opNEW, CODE.opDISP, CODE.opISREC, |
CODE.opIS, CODE.opTYPEGR, CODE.opTYPEGP, |
CODE.opCASET, CODE.opDIV, |
CODE.opDIVL, CODE.opMOD, |
CODE.opMODL, CODE.opLENGTH, CODE.opLENGTHW: |
IL.opSAVES, IL.opRSET, IL.opRSETR, |
IL.opRSETL, IL.opRSET1, |
IL.opEQS .. IL.opGES, |
IL.opEQSW .. IL.opGESW, |
IL.opCOPY, IL.opMOVE, IL.opCOPYA, |
IL.opCOPYS, IL.opROT, |
IL.opNEW, IL.opDISP, IL.opISREC, |
IL.opIS, IL.opTYPEGR, IL.opTYPEGP, |
IL.opCASET, IL.opDIV, |
IL.opDIVL, IL.opMOD, |
IL.opMODL, IL.opLENGTH, IL.opLENGTHW: |
leaf := FALSE |
|CODE.opDIVR, CODE.opMODR: |
|IL.opDIVR, IL.opMODR: |
param2 := cur.param2; |
IF param2 >= 1 THEN |
param2 := X86.log2(param2) |
param2 := UTILS.Log2(param2) |
ELSIF param2 <= -1 THEN |
param2 := X86.log2(-param2) |
param2 := UTILS.Log2(-param2) |
ELSE |
param2 := -1 |
END; |
772,13 → 779,13 |
reg := -1; |
max := -1; |
rvar := NIL; |
lvar := variables.first(CODE.LOCALVAR); |
lvar := variables.first(IL.LOCALVAR); |
WHILE lvar # NIL DO |
IF lvar.count > max THEN |
max := lvar.count; |
rvar := lvar |
END; |
lvar := lvar.next(CODE.LOCALVAR) |
lvar := lvar.next(IL.LOCALVAR) |
END; |
IF rvar # NIL THEN |
878,30 → 885,30 |
cc, reg: INTEGER; |
BEGIN |
reg := REG.GetAnyReg(R); |
reg := GetAnyReg(); |
xor(reg, reg); |
CASE op OF |
|CODE.opEQF, CODE.opEQFI: |
|IL.opEQF: |
comisd(xmm - 1, xmm); |
cc := sete |
|CODE.opNEF, CODE.opNEFI: |
|IL.opNEF: |
comisd(xmm - 1, xmm); |
cc := setne |
|CODE.opLTF, CODE.opGTFI: |
|IL.opLTF: |
comisd(xmm - 1, xmm); |
cc := setc |
|CODE.opGTF, CODE.opLTFI: |
|IL.opGTF: |
comisd(xmm, xmm - 1); |
cc := setc |
|CODE.opLEF, CODE.opGEFI: |
|IL.opLEF: |
comisd(xmm, xmm - 1); |
cc := setnc |
|CODE.opGEF, CODE.opLEFI: |
|IL.opGEF: |
comisd(xmm - 1, xmm); |
cc := setnc |
END; |
915,7 → 922,7 |
VAR |
cmd, next: COMMAND; |
param1, param2, param3, a, b, c, n, label, L, i, cc: INTEGER; |
opcode, param1, param2, param3, a, b, c, n, label, L, i, cc: INTEGER; |
reg1, reg2, xmm: INTEGER; |
931,22 → 938,24 |
param1 := cmd.param1; |
param2 := cmd.param2; |
CASE cmd.opcode OF |
opcode := cmd.opcode; |
|CODE.opJMP: |
CASE opcode OF |
|IL.opJMP: |
jmp(param1) |
|CODE.opCALL, CODE.opWIN64CALL, CODE.opSYSVCALL: |
|IL.opCALL, IL.opWIN64CALL, IL.opSYSVCALL: |
REG.Store(R); |
CASE cmd.opcode OF |
|CODE.opCALL: |
|CODE.opWIN64CALL: Win64Passing(param2) |
|CODE.opSYSVCALL: SysVPassing(param2) |
CASE opcode OF |
|IL.opCALL: |
|IL.opWIN64CALL: Win64Passing(param2) |
|IL.opSYSVCALL: SysVPassing(param2) |
END; |
X86.call(param1); |
REG.Restore(R) |
|CODE.opCALLP, CODE.opWIN64CALLP, CODE.opSYSVCALLP: |
|IL.opCALLP, IL.opWIN64CALLP, IL.opSYSVCALLP: |
UnOp(reg1); |
IF reg1 # rax THEN |
GetRegA; |
955,35 → 964,35 |
END; |
drop; |
REG.Store(R); |
CASE cmd.opcode OF |
|CODE.opCALLP: |
|CODE.opWIN64CALLP: Win64Passing(param2) |
|CODE.opSYSVCALLP: SysVPassing(param2) |
CASE opcode OF |
|IL.opCALLP: |
|IL.opWIN64CALLP: Win64Passing(param2) |
|IL.opSYSVCALLP: SysVPassing(param2) |
END; |
OutByte2(0FFH, 0D0H); // call rax |
REG.Restore(R); |
ASSERT(R.top = -1) |
|CODE.opCALLI, CODE.opWIN64CALLI, CODE.opSYSVCALLI: |
|IL.opCALLI, IL.opWIN64CALLI, IL.opSYSVCALLI: |
REG.Store(R); |
CASE cmd.opcode OF |
|CODE.opCALLI: |
|CODE.opWIN64CALLI: Win64Passing(param2) |
|CODE.opSYSVCALLI: SysVPassing(param2) |
CASE opcode OF |
|IL.opCALLI: |
|IL.opWIN64CALLI: Win64Passing(param2) |
|IL.opSYSVCALLI: SysVPassing(param2) |
END; |
callimp(param1); |
REG.Restore(R) |
|CODE.opLABEL: |
X86.SetLabel(param2) |
|IL.opLABEL: |
X86.SetLabel(param1) |
|CODE.opERR: |
CallRTL(CODE._error) |
|IL.opERR: |
CallRTL(IL._error) |
|CODE.opERRC: |
|IL.opPUSHC: |
pushc(param2) |
|CODE.opPRECALL: |
|IL.opPRECALL: |
n := param2; |
IF (param1 # 0) & (n # 0) THEN |
subrc(rsp, 8) |
997,7 → 1006,7 |
ASSERT(xmm = -1); |
PushAll(0) |
|CODE.opWIN64ALIGN16: |
|IL.opWIN64ALIGN16: |
ASSERT(rax IN R.regs); |
mov(rax, rsp); |
andrc(rsp, -16); |
1004,7 → 1013,7 |
push(rax); |
subrc(rsp, (MAX(param2 - 4, 0) MOD 2 + MAX(4 - param2, 0) + 1) * 8) |
|CODE.opSYSVALIGN16: |
|IL.opSYSVALIGN16: |
ASSERT(rax IN R.regs); |
mov(rax, rsp); |
andrc(rsp, -16); |
1013,7 → 1022,7 |
push(rax) |
END |
|CODE.opRESF: |
|IL.opRESF: |
ASSERT(xmm = -1); |
INC(xmm); |
n := param2; |
1030,7 → 1039,7 |
DEC(n) |
END |
|CODE.opRES: |
|IL.opRES: |
ASSERT(R.top = -1); |
GetRegA; |
n := param2; |
1041,7 → 1050,7 |
DEC(n) |
END |
|CODE.opENTER: |
|IL.opENTER: |
ASSERT(R.top = -1); |
X86.SetLabel(param1); |
1122,8 → 1131,8 |
allocReg(cmd) |
END |
|CODE.opLEAVE, CODE.opLEAVER, CODE.opLEAVEF: |
IF cmd.opcode = CODE.opLEAVER THEN |
|IL.opLEAVE, IL.opLEAVER, IL.opLEAVEF: |
IF opcode = IL.opLEAVER THEN |
UnOp(reg1); |
IF reg1 # rax THEN |
GetRegA; |
1135,13 → 1144,16 |
ASSERT(R.top = -1); |
IF cmd.opcode = CODE.opLEAVEF THEN |
IF opcode = IL.opLEAVEF THEN |
DEC(xmm) |
END; |
ASSERT(xmm = -1); |
mov(rsp, rbp); |
IF param1 > 0 THEN |
mov(rsp, rbp) |
END; |
pop(rbp); |
IF param2 > 0 THEN |
OutByte3(0C2H, (param2 * 8) MOD 256, (param2 * 8) DIV 256) // ret param2 |
1150,40 → 1162,36 |
END; |
REG.Reset(R) |
|CODE.opSAVES: |
UnOp(reg1); |
drop; |
PushAll(0); |
push(reg1); |
|IL.opSAVES: |
PushAll(1); |
pushDA(stroffs + param2); |
pushc(param1); |
CallRTL(CODE._move) |
CallRTL(IL._move) |
|CODE.opSADR: |
reg1 := REG.GetAnyReg(R); |
lea(reg1, stroffs + param2, sDATA) |
|IL.opSADR: |
lea(GetAnyReg(), stroffs + param2, sDATA) |
|CODE.opLOAD8: |
|IL.opLOAD8: |
UnOp(reg1); |
movzx(reg1, reg1, 0, FALSE) |
|CODE.opLOAD16: |
|IL.opLOAD16: |
UnOp(reg1); |
movzx(reg1, reg1, 0, TRUE) |
|CODE.opLOAD32: |
|IL.opLOAD32: |
UnOp(reg1); |
movrm32(reg1, reg1, 0); |
shiftrc(shl, reg1, 32); |
shiftrc(shr, reg1, 32) |
|CODE.opLOAD64: |
|IL.opLOAD64: |
UnOp(reg1); |
movrm(reg1, reg1, 0) |
|CODE.opLLOAD64: |
reg1 := REG.GetAnyReg(R); |
reg2 := REG.GetVarReg(R, param2); |
|IL.opLLOAD64: |
reg1 := GetAnyReg(); |
reg2 := GetVarReg(param2); |
IF reg2 # -1 THEN |
mov(reg1, reg2) |
ELSE |
1190,19 → 1198,19 |
movrm(reg1, rbp, param2 * 8) |
END |
|CODE.opLLOAD8, |
CODE.opLLOAD16: |
reg1 := REG.GetAnyReg(R); |
reg2 := REG.GetVarReg(R, param2); |
|IL.opLLOAD8, |
IL.opLLOAD16: |
reg1 := GetAnyReg(); |
reg2 := GetVarReg(param2); |
IF reg2 # -1 THEN |
mov(reg1, reg2) |
ELSE |
movzx(reg1, rbp, param2 * 8, cmd.opcode = CODE.opLLOAD16) |
movzx(reg1, rbp, param2 * 8, opcode = IL.opLLOAD16) |
END |
|CODE.opLLOAD32: |
reg1 := REG.GetAnyReg(R); |
reg2 := REG.GetVarReg(R, param2); |
|IL.opLLOAD32: |
reg1 := GetAnyReg(); |
reg2 := GetVarReg(param2); |
IF reg2 # -1 THEN |
mov(reg1, reg2) |
ELSE |
1211,73 → 1219,71 |
movrm32(reg1, rbp, n) |
END |
|CODE.opGLOAD64: |
reg1 := REG.GetAnyReg(R); |
|IL.opGLOAD64: |
reg1 := GetAnyReg(); |
lea(reg1, param2, sBSS); |
movrm(reg1, reg1, 0) |
|CODE.opGLOAD8: |
reg1 := REG.GetAnyReg(R); |
|IL.opGLOAD8: |
reg1 := GetAnyReg(); |
lea(reg1, param2, sBSS); |
movzx(reg1, reg1, 0, FALSE) |
|CODE.opGLOAD16: |
reg1 := REG.GetAnyReg(R); |
|IL.opGLOAD16: |
reg1 := GetAnyReg(); |
lea(reg1, param2, sBSS); |
movzx(reg1, reg1, 0, TRUE) |
|CODE.opGLOAD32: |
reg1 := REG.GetAnyReg(R); |
|IL.opGLOAD32: |
reg1 := GetAnyReg(); |
xor(reg1, reg1); |
lea(reg1, param2, sBSS); |
movrm32(reg1, reg1, 0) |
|CODE.opVLOAD64: |
reg1 := REG.GetAnyReg(R); |
|IL.opVLOAD64: |
reg1 := GetAnyReg(); |
movrm(reg1, rbp, param2 * 8); |
movrm(reg1, reg1, 0) |
|CODE.opVLOAD8, |
CODE.opVLOAD16: |
reg1 := REG.GetAnyReg(R); |
|IL.opVLOAD8, |
IL.opVLOAD16: |
reg1 := GetAnyReg(); |
movrm(reg1, rbp, param2 * 8); |
movzx(reg1, reg1, 0, cmd.opcode = CODE.opVLOAD16) |
movzx(reg1, reg1, 0, opcode = IL.opVLOAD16) |
|CODE.opVLOAD32: |
reg1 := REG.GetAnyReg(R); |
reg2 := REG.GetAnyReg(R); |
|IL.opVLOAD32: |
reg1 := GetAnyReg(); |
reg2 := GetAnyReg(); |
xor(reg1, reg1); |
movrm(reg2, rbp, param2 * 8); |
movrm32(reg1, reg2, 0); |
drop |
|CODE.opLADR: |
|IL.opLADR: |
n := param2 * 8; |
next := cmd.next(COMMAND); |
IF next.opcode = CODE.opSAVEF THEN |
IF next.opcode = IL.opSAVEF THEN |
movsdmr(rbp, n, xmm); |
DEC(xmm); |
cmd := next |
ELSIF next.opcode = CODE.opLOADF THEN |
ELSIF next.opcode = IL.opLOADF THEN |
INC(xmm); |
movsdrm(xmm, rbp, n); |
cmd := next |
ELSE |
reg1 := REG.GetAnyReg(R); |
reg1 := GetAnyReg(); |
Rex(0, reg1); |
OutByte2(8DH, 45H + long(n) + (reg1 MOD 8) * 8); // lea reg1, qword[rbp+n] |
OutIntByte(n) |
END |
|CODE.opGADR: |
reg1 := REG.GetAnyReg(R); |
lea(reg1, param2, sBSS) |
|IL.opGADR: |
lea(GetAnyReg(), param2, sBSS) |
|CODE.opVADR: |
reg1 := REG.GetAnyReg(R); |
movrm(reg1, rbp, param2 * 8) |
|IL.opVADR: |
movrm(GetAnyReg(), rbp, param2 * 8) |
|CODE.opSAVE8C: |
|IL.opSAVE8C: |
UnOp(reg1); |
IF reg1 >= 8 THEN |
OutByte(41H) |
1285,7 → 1291,7 |
OutByte3(0C6H, reg1 MOD 8, param2); // mov byte[reg1], param2 |
drop |
|CODE.opSAVE16C: |
|IL.opSAVE16C: |
UnOp(reg1); |
OutByte(66H); |
IF reg1 >= 8 THEN |
1295,10 → 1301,10 |
OutByte2(param2 MOD 256, param2 DIV 256); // mov word[reg1], param2 |
drop |
|CODE.opSAVEC: |
|IL.opSAVEC: |
UnOp(reg1); |
IF isLong(param2) THEN |
reg2 := REG.GetAnyReg(R); |
reg2 := GetAnyReg(); |
movrc(reg2, param2); |
movmr(reg1, 0, reg2); |
drop |
1309,142 → 1315,106 |
END; |
drop |
|CODE.opRSET: |
|IL.opRSET: |
PushAll(2); |
CallRTL(CODE._set); |
CallRTL(IL._set); |
GetRegA |
|CODE.opRSETR: |
|IL.opRSETR: |
PushAll(1); |
pushc(param2); |
CallRTL(CODE._set); |
CallRTL(IL._set); |
GetRegA |
|CODE.opRSETL: |
|IL.opRSETL: |
PushAll(1); |
pushc(param2); |
CallRTL(CODE._set2); |
CallRTL(IL._set2); |
GetRegA |
|CODE.opRSET1: |
|IL.opRSET1: |
UnOp(reg1); |
PushAll(1); |
push(reg1); |
CallRTL(CODE._set); |
CallRTL(IL._set); |
GetRegA |
|CODE.opINCL, CODE.opEXCL: |
|IL.opINCL, IL.opEXCL: |
BinOp(reg1, reg2); |
cmprc(reg1, 64); |
OutByte2(73H, 04H); // jnb L |
Rex(reg2, reg1); |
OutByte3(0FH, 0ABH + 8 * ORD(cmd.opcode = CODE.opEXCL), 8 * (reg1 MOD 8) + reg2 MOD 8); // bts/btr qword[reg2], reg1 |
OutByte3(0FH, 0ABH + 8 * ORD(opcode = IL.opEXCL), 8 * (reg1 MOD 8) + reg2 MOD 8); // bts/btr qword[reg2], reg1 |
// L: |
drop; |
drop |
|CODE.opINCLC, CODE.opEXCLC: |
|IL.opINCLC, IL.opEXCLC: |
UnOp(reg1); |
Rex(reg1, 0); |
OutByte2(0FH, 0BAH); // bts/btr qword[reg1], param2 |
OutByte2(28H + 8 * ORD(cmd.opcode = CODE.opEXCLC) + reg1 MOD 8, param2); |
OutByte2(28H + 8 * ORD(opcode = IL.opEXCLC) + reg1 MOD 8, param2); |
drop |
|CODE.opEQS .. CODE.opGES: |
|IL.opEQS .. IL.opGES: |
PushAll(4); |
pushc(cmd.opcode - CODE.opEQS); |
CallRTL(CODE._strcmp); |
pushc(opcode - IL.opEQS); |
CallRTL(IL._strcmp); |
GetRegA |
|CODE.opEQS2 .. CODE.opGES2: |
|IL.opEQSW .. IL.opGESW: |
PushAll(4); |
pushc(cmd.opcode - CODE.opEQS2); |
CallRTL(CODE._strcmp2); |
pushc(opcode - IL.opEQSW); |
CallRTL(IL._strcmpw); |
GetRegA |
|CODE.opEQSW .. CODE.opGESW: |
PushAll(4); |
pushc(cmd.opcode - CODE.opEQSW); |
CallRTL(CODE._strcmpw); |
GetRegA |
|IL.opCONST: |
movrc(GetAnyReg(), param2) |
|CODE.opEQSW2 .. CODE.opGESW2: |
PushAll(4); |
pushc(cmd.opcode - CODE.opEQSW2); |
CallRTL(CODE._strcmpw2); |
GetRegA |
|IL.opEQ..IL.opGE, |
IL.opEQC..IL.opGEC: |
|CODE.opINC1, CODE.opDEC1: |
UnOp(reg1); |
Rex(reg1, 0); |
OutByte2(0FFH, reg1 MOD 8 + 8 * ORD(cmd.opcode = CODE.opDEC1)); |
drop |
|CODE.opCONST: |
reg1 := REG.GetAnyReg(R); |
movrc(reg1, param2) |
|CODE.opGT, CODE.opGE, CODE.opLT, |
CODE.opLE, CODE.opEQ, CODE.opNE: |
IF (IL.opEQ <= opcode) & (opcode <= IL.opGE) THEN |
BinOp(reg1, reg2); |
cmprr(reg1, reg2); |
drop; |
drop; |
cc := X86.cond(cmd.opcode); |
IF cmd.next(COMMAND).opcode = CODE.opJE THEN |
label := cmd.next(COMMAND).param1; |
jcc(cc, label); |
cmd := cmd.next(COMMAND) |
ELSIF cmd.next(COMMAND).opcode = CODE.opJNE THEN |
label := cmd.next(COMMAND).param1; |
jcc(X86.inv1(cc), label); |
cmd := cmd.next(COMMAND) |
drop |
ELSE |
reg1 := REG.GetAnyReg(R); |
setcc(cc + 16, reg1); |
andrc(reg1, 1) |
END |
|CODE.opGTR, CODE.opLTL, CODE.opGER, CODE.opLEL, |
CODE.opLER, CODE.opGEL, CODE.opLTR, CODE.opGTL, |
CODE.opEQR, CODE.opEQL, CODE.opNER, CODE.opNEL: |
UnOp(reg1); |
IF param2 = 0 THEN |
test(reg1) |
ELSE |
cmprc(reg1, param2) |
END |
END; |
drop; |
cc := X86.cond(cmd.opcode); |
cc := X86.cond(opcode); |
IF cmd.next(COMMAND).opcode = CODE.opJE THEN |
IF cmd.next(COMMAND).opcode = IL.opJE THEN |
label := cmd.next(COMMAND).param1; |
jcc(cc, label); |
cmd := cmd.next(COMMAND) |
ELSIF cmd.next(COMMAND).opcode = CODE.opJNE THEN |
ELSIF cmd.next(COMMAND).opcode = IL.opJNE THEN |
label := cmd.next(COMMAND).param1; |
jcc(X86.inv1(cc), label); |
jcc(X86.inv0(cc), label); |
cmd := cmd.next(COMMAND) |
ELSE |
reg1 := REG.GetAnyReg(R); |
reg1 := GetAnyReg(); |
setcc(cc + 16, reg1); |
andrc(reg1, 1) |
END |
|CODE.opCODE: |
|IL.opCODE: |
OutByte(param2) |
|CODE.opPUSHIP: |
reg1 := REG.GetAnyReg(R); |
|IL.opPUSHIP: |
reg1 := GetAnyReg(); |
lea(reg1, param2, sIMP); |
movrm(reg1, reg1, 0) |
|CODE.opPARAM: |
|IL.opPARAM: |
n := param2; |
IF n = 1 THEN |
UnOp(reg1); |
1455,7 → 1425,7 |
PushAll(n) |
END |
|CODE.opACC: |
|IL.opACC: |
IF (R.top # 0) OR (R.stk[0] # rax) THEN |
PushAll(0); |
GetRegA; |
1463,29 → 1433,29 |
DEC(R.pushed) |
END |
|CODE.opJNZ: |
|IL.opJNZ: |
UnOp(reg1); |
test(reg1); |
jcc(jne, param1) |
|CODE.opJZ: |
|IL.opJZ: |
UnOp(reg1); |
test(reg1); |
jcc(je, param1) |
|CODE.opJE: |
|IL.opJE: |
UnOp(reg1); |
test(reg1); |
jcc(jne, param1); |
drop |
|CODE.opJNE: |
|IL.opJNE: |
UnOp(reg1); |
test(reg1); |
jcc(je, param1); |
drop |
|CODE.opIN: |
|IL.opIN: |
label := NewLabel(); |
L := NewLabel(); |
BinOp(reg1, reg2); |
1501,11 → 1471,11 |
X86.SetLabel(label); |
drop |
|CODE.opINR: |
|IL.opINR: |
label := NewLabel(); |
L := NewLabel(); |
UnOp(reg1); |
reg2 := REG.GetAnyReg(R); |
reg2 := GetAnyReg(); |
cmprc(reg1, 64); |
jcc(jb, L); |
xor(reg1, reg1); |
1519,7 → 1489,7 |
X86.SetLabel(label); |
drop |
|CODE.opINL: |
|IL.opINL: |
UnOp(reg1); |
Rex(reg1, 0); |
OutByte2(0FH, 0BAH); // bt reg1, param2 |
1527,19 → 1497,19 |
setcc(setc, reg1); |
andrc(reg1, 1) |
|CODE.opNOT: |
|IL.opNOT: |
UnOp(reg1); |
test(reg1); |
setcc(sete, reg1); |
andrc(reg1, 1) |
|CODE.opORD: |
|IL.opORD: |
UnOp(reg1); |
test(reg1); |
setcc(setne, reg1); |
andrc(reg1, 1) |
|CODE.opABS: |
|IL.opABS: |
UnOp(reg1); |
test(reg1); |
OutByte2(7DH, 03H); // jge L |
1546,22 → 1516,21 |
neg(reg1) |
// L: |
|CODE.opEQB, CODE.opNEB: |
|IL.opEQB, IL.opNEB: |
BinOp(reg1, reg2); |
drop; |
drop; |
test(reg1); |
OutByte2(74H, 07H); // je L1 |
label := NewLabel(); |
jcc(je, label); |
movrc(reg1, 1); |
// L1: |
X86.SetLabel(label); |
test(reg2); |
OutByte2(74H, 07H); // je L2 |
label := NewLabel(); |
jcc(je, label); |
movrc(reg2, 1); |
// L2: |
X86.SetLabel(label); |
cmprr(reg1, reg2); |
reg1 := REG.GetAnyReg(R); |
IF cmd.opcode = CODE.opEQB THEN |
IF opcode = IL.opEQB THEN |
setcc(sete, reg1) |
ELSE |
setcc(setne, reg1) |
1568,196 → 1537,193 |
END; |
andrc(reg1, 1) |
|CODE.opMULSC: |
|IL.opMULSC: |
UnOp(reg1); |
andrc(reg1, param2) |
|CODE.opDIVSC, CODE.opADDSL, CODE.opADDSR: |
|IL.opDIVSC, IL.opADDSL, IL.opADDSR: |
UnOp(reg1); |
Rex(reg1, 0); |
OutByte2(81H + short(param2), 0C8H + 28H * ORD(cmd.opcode = CODE.opDIVSC) + reg1 MOD 8); // or/xor reg1, param2 |
OutByte2(81H + short(param2), 0C8H + 28H * ORD(opcode = IL.opDIVSC) + reg1 MOD 8); // or/xor reg1, param2 |
OutIntByte(param2) |
|CODE.opSUBSL: |
|IL.opSUBSL: |
UnOp(reg1); |
not(reg1); |
andrc(reg1, param2) |
|CODE.opSUBSR: |
|IL.opSUBSR: |
UnOp(reg1); |
andrc(reg1, ORD(-BITS(param2))) |
|CODE.opMULS: |
|IL.opMULS: |
BinOp(reg1, reg2); |
and(reg1, reg2); |
drop |
|CODE.opDIVS: |
|IL.opDIVS: |
BinOp(reg1, reg2); |
xor(reg1, reg2); |
drop |
|CODE.opUMINS: |
|IL.opUMINS: |
UnOp(reg1); |
not(reg1) |
|CODE.opCOPY: |
|IL.opCOPY: |
PushAll(2); |
pushc(param2); |
CallRTL(CODE._move2) |
CallRTL(IL._move2) |
|CODE.opMOVE: |
|IL.opMOVE: |
PushAll(3); |
CallRTL(CODE._move2) |
CallRTL(IL._move2) |
|CODE.opCOPYA: |
|IL.opCOPYA: |
PushAll(4); |
pushc(param2); |
CallRTL(CODE._arrcpy); |
CallRTL(IL._arrcpy); |
GetRegA |
|CODE.opCOPYS: |
|IL.opCOPYS: |
PushAll(4); |
pushc(param2); |
CallRTL(CODE._strcpy) |
CallRTL(IL._strcpy) |
|CODE.opCOPYS2: |
PushAll(4); |
pushc(param2); |
CallRTL(CODE._strcpy2) |
|CODE.opROT: |
|IL.opROT: |
PushAll(0); |
push(rsp); |
pushc(param2); |
CallRTL(CODE._rot) |
CallRTL(IL._rot) |
|CODE.opNEW: |
|IL.opNEW: |
PushAll(1); |
n := param2 + 16; |
ASSERT(MACHINE.Align(n, 64)); |
ASSERT(UTILS.Align(n, 64)); |
pushc(n); |
pushc(param1); |
CallRTL(CODE._new) |
CallRTL(IL._new) |
|CODE.opDISP: |
|IL.opDISP: |
PushAll(1); |
CallRTL(CODE._dispose) |
CallRTL(IL._dispose) |
|CODE.opPUSHT: |
|IL.opPUSHT: |
UnOp(reg1); |
reg2 := REG.GetAnyReg(R); |
reg2 := GetAnyReg(); |
movrm(reg2, reg1, -8) |
|CODE.opISREC: |
|IL.opISREC: |
PushAll(2); |
pushc(param2); |
CallRTL(CODE._isrec); |
pushc(param2 * tcount); |
CallRTL(IL._isrec); |
GetRegA |
|CODE.opIS: |
|IL.opIS: |
PushAll(1); |
pushc(param2); |
CallRTL(CODE._is); |
pushc(param2 * tcount); |
CallRTL(IL._is); |
GetRegA |
|CODE.opTYPEGR: |
|IL.opTYPEGR: |
PushAll(1); |
pushc(param2); |
CallRTL(CODE._guardrec); |
pushc(param2 * tcount); |
CallRTL(IL._guardrec); |
GetRegA |
|CODE.opTYPEGP: |
|IL.opTYPEGP: |
UnOp(reg1); |
PushAll(0); |
push(reg1); |
pushc(param2); |
CallRTL(CODE._guard); |
pushc(param2 * tcount); |
CallRTL(IL._guard); |
GetRegA |
|CODE.opTYPEGD: |
|IL.opTYPEGD: |
UnOp(reg1); |
PushAll(0); |
pushm(reg1, -8); |
pushc(param2); |
CallRTL(CODE._guardrec); |
pushc(param2 * tcount); |
CallRTL(IL._guardrec); |
GetRegA |
|CODE.opCASET: |
|IL.opCASET: |
push(r10); |
push(r10); |
pushc(param2); |
CallRTL(CODE._guardrec); |
pushc(param2 * tcount); |
CallRTL(IL._guardrec); |
pop(r10); |
test(rax); |
jcc(jne, param1) |
|CODE.opSAVEP: |
|IL.opSAVEP: |
UnOp(reg1); |
reg2 := REG.GetAnyReg(R); |
reg2 := GetAnyReg(); |
lea(reg2, param2, sCODE); |
movmr(reg1, 0, reg2); |
drop; |
drop |
|CODE.opPUSHP: |
reg1 := REG.GetAnyReg(R); |
lea(reg1, param2, sCODE) |
|IL.opPUSHP: |
lea(GetAnyReg(), param2, sCODE) |
|CODE.opINC, CODE.opDEC: |
|IL.opINC, IL.opDEC: |
BinOp(reg1, reg2); |
// add/sub qword[reg2], reg1 |
Rex(reg2, reg1); |
OutByte2(01H + 28H * ORD(cmd.opcode = CODE.opDEC), reg2 MOD 8 + (reg1 MOD 8) * 8); |
OutByte2(01H + 28H * ORD(opcode = IL.opDEC), reg2 MOD 8 + (reg1 MOD 8) * 8); |
drop; |
drop |
|CODE.opINCC, CODE.opDECC: |
|IL.opINCC: |
UnOp(reg1); |
IF isLong(param2) THEN |
reg2 := REG.GetAnyReg(R); |
reg2 := GetAnyReg(); |
movrc(reg2, param2); |
// add/sub qword[reg1], reg2 |
// add qword[reg1], reg2 |
Rex(reg1, reg2); |
OutByte2(01H + 28H * ORD(cmd.opcode = CODE.opDECC), reg1 MOD 8 + (reg2 MOD 8) * 8); |
OutByte2(01H, reg1 MOD 8 + (reg2 MOD 8) * 8); |
drop |
ELSIF ABS(param2) = 1 THEN |
Rex(reg1, 0); |
OutByte2(0FFH, reg1 MOD 8 + 8 * ORD(param2 = -1)) // inc/dec qword[reg1] |
ELSE |
// add/sub qword[reg1], param2 |
// add qword[reg1], param2 |
Rex(reg1, 0); |
OutByte2(81H + short(param2), 28H * ORD(cmd.opcode = CODE.opDECC) + reg1 MOD 8); |
OutByte2(81H + short(param2), reg1 MOD 8); |
OutIntByte(param2) |
END; |
drop |
|CODE.opDROP: |
|IL.opDROP: |
UnOp(reg1); |
drop |
|CODE.opSAVE, CODE.opSAVE64: |
|IL.opSAVE, IL.opSAVE64: |
BinOp(reg2, reg1); |
movmr(reg1, 0, reg2); |
drop; |
drop |
|CODE.opSAVE8: |
|IL.opSAVE8: |
BinOp(reg2, reg1); |
movmr8(reg1, 0, reg2); |
drop; |
drop |
|CODE.opSAVE16: |
|IL.opSAVE16: |
BinOp(reg2, reg1); |
movmr16(reg1, 0, reg2); |
drop; |
drop |
|CODE.opSAVE32: |
|IL.opSAVE32: |
BinOp(reg2, reg1); |
movmr32(reg1, 0, reg2); |
drop; |
drop |
|CODE.opMIN: |
|IL.opMIN: |
BinOp(reg1, reg2); |
cmprr(reg1, reg2); |
OutByte2(7EH, 3); // jle L |
1765,7 → 1731,7 |
// L: |
drop |
|CODE.opMAX: |
|IL.opMAX: |
BinOp(reg1, reg2); |
cmprr(reg1, reg2); |
OutByte2(7DH, 3); // jge L |
1773,7 → 1739,7 |
// L: |
drop |
|CODE.opMINC: |
|IL.opMINC: |
UnOp(reg1); |
cmprc(reg1, param2); |
label := NewLabel(); |
1781,7 → 1747,7 |
movrc(reg1, param2); |
X86.SetLabel(label) |
|CODE.opMAXC: |
|IL.opMAXC: |
UnOp(reg1); |
cmprc(reg1, param2); |
label := NewLabel(); |
1789,41 → 1755,43 |
movrc(reg1, param2); |
X86.SetLabel(label) |
|CODE.opSBOOL: |
|IL.opSBOOL: |
BinOp(reg2, reg1); |
test(reg2); |
setcc(setne, reg2); |
movmr8(reg1, 0, reg2); |
IF reg1 >= 8 THEN |
OutByte(41H) |
END; |
OutByte3(0FH, 95H, reg1 MOD 8); // setne byte[reg1] |
drop; |
drop |
|CODE.opSBOOLC: |
|IL.opSBOOLC: |
UnOp(reg1); |
IF reg1 >= 8 THEN |
OutByte(41H) |
END; |
OutByte3(0C6H, reg1 MOD 8, ORD(param2 # 0)); |
OutByte3(0C6H, reg1 MOD 8, ORD(param2 # 0)); // mov byte[reg1], 0/1 |
drop |
|CODE.opODD: |
|IL.opODD: |
UnOp(reg1); |
andrc(reg1, 1) |
|CODE.opUMINUS: |
|IL.opUMINUS: |
UnOp(reg1); |
neg(reg1) |
|CODE.opADD: |
|IL.opADD: |
BinOp(reg1, reg2); |
add(reg1, reg2); |
drop |
|CODE.opSUB: |
|IL.opSUB: |
BinOp(reg1, reg2); |
sub(reg1, reg2); |
drop |
|CODE.opSUBR, CODE.opSUBL: |
|IL.opSUBR, IL.opSUBL: |
UnOp(reg1); |
n := param2; |
IF n = 1 THEN |
1833,11 → 1801,11 |
ELSIF n # 0 THEN |
subrc(reg1, n) |
END; |
IF cmd.opcode = CODE.opSUBL THEN |
IF opcode = IL.opSUBL THEN |
neg(reg1) |
END |
|CODE.opADDL, CODE.opADDR: |
|IL.opADDL, IL.opADDR: |
IF param2 # 0 THEN |
UnOp(reg1); |
IF param2 = 1 THEN |
1849,17 → 1817,17 |
END |
END |
|CODE.opDIV: |
|IL.opDIV: |
PushAll(2); |
CallRTL(CODE._div); |
CallRTL(IL._div); |
GetRegA |
|CODE.opDIVR: |
|IL.opDIVR: |
a := param2; |
IF a > 1 THEN |
n := X86.log2(a) |
n := UTILS.Log2(a) |
ELSIF a < -1 THEN |
n := X86.log2(-a) |
n := UTILS.Log2(-a) |
ELSE |
n := -1 |
END; |
1874,7 → 1842,7 |
UnOp(reg1); |
IF a < 0 THEN |
reg2 := REG.GetAnyReg(R); |
reg2 := GetAnyReg(); |
mov(reg2, reg1); |
shiftrc(sar, reg1, n); |
sub(reg1, reg2); |
1886,28 → 1854,28 |
ELSE |
PushAll(1); |
pushc(param2); |
CallRTL(CODE._div); |
CallRTL(IL._div); |
GetRegA |
END |
END |
|CODE.opDIVL: |
|IL.opDIVL: |
PushAll(1); |
pushc(param2); |
CallRTL(CODE._div2); |
CallRTL(IL._div2); |
GetRegA |
|CODE.opMOD: |
|IL.opMOD: |
PushAll(2); |
CallRTL(CODE._mod); |
CallRTL(IL._mod); |
GetRegA |
|CODE.opMODR: |
|IL.opMODR: |
a := param2; |
IF a > 1 THEN |
n := X86.log2(a) |
n := UTILS.Log2(a) |
ELSIF a < -1 THEN |
n := X86.log2(-a) |
n := UTILS.Log2(-a) |
ELSE |
n := -1 |
END; |
1931,30 → 1899,30 |
ELSE |
PushAll(1); |
pushc(param2); |
CallRTL(CODE._mod); |
CallRTL(IL._mod); |
GetRegA |
END |
END |
|CODE.opMODL: |
|IL.opMODL: |
PushAll(1); |
pushc(param2); |
CallRTL(CODE._mod2); |
CallRTL(IL._mod2); |
GetRegA |
|CODE.opMUL: |
|IL.opMUL: |
BinOp(reg1, reg2); |
oprr2(0FH, 0AFH, reg2, reg1); // imul reg1, reg2 |
drop |
|CODE.opMULC: |
|IL.opMULC: |
UnOp(reg1); |
a := param2; |
IF a > 1 THEN |
n := X86.log2(a) |
n := UTILS.Log2(a) |
ELSIF a < -1 THEN |
n := X86.log2(-a) |
n := UTILS.Log2(-a) |
ELSE |
n := -1 |
END; |
1979,20 → 1947,20 |
END |
END |
|CODE.opADDS: |
|IL.opADDS: |
BinOp(reg1, reg2); |
or(reg1, reg2); |
drop |
|CODE.opSUBS: |
|IL.opSUBS: |
BinOp(reg1, reg2); |
not(reg2); |
and(reg1, reg2); |
drop |
|CODE.opNOP: |
|IL.opNOP: |
|CODE.opSWITCH: |
|IL.opSWITCH: |
UnOp(reg1); |
IF param2 = 0 THEN |
reg2 := rax |
2006,65 → 1974,71 |
END; |
drop |
|CODE.opENDSW: |
|IL.opENDSW: |
|CODE.opCASEL: |
|IL.opCASEL: |
cmprc(rax, param1); |
jcc(jl, param2) |
|CODE.opCASER: |
|IL.opCASER: |
cmprc(rax, param1); |
jcc(jg, param2) |
|CODE.opCASELR: |
|IL.opCASELR: |
cmprc(rax, param1); |
jcc(jl, param2); |
jcc(jg, cmd.param3) |
|CODE.opASR, CODE.opROR, CODE.opLSL, CODE.opLSR: |
|IL.opASR, IL.opROR, IL.opLSL, IL.opLSR: |
BinOp(reg1, reg2); |
xchg(reg2, rcx); |
Rex(reg1, 0); |
OutByte(0D3H); |
X86.shift(cmd.opcode, reg1 MOD 8); // shift reg1, cl |
X86.shift(opcode, reg1 MOD 8); // shift reg1, cl |
xchg(reg2, rcx); |
drop |
|CODE.opASR1, CODE.opROR1, CODE.opLSL1, CODE.opLSR1: |
reg1 := REG.GetAnyReg(R); |
|IL.opASR1, IL.opROR1, IL.opLSL1, IL.opLSR1: |
reg1 := GetAnyReg(); |
movrc(reg1, param2); |
BinOp(reg1, reg2); |
xchg(reg1, rcx); |
Rex(reg2, 0); |
OutByte(0D3H); |
X86.shift(cmd.opcode, reg2 MOD 8); // shift reg2, cl |
X86.shift(opcode, reg2 MOD 8); // shift reg2, cl |
xchg(reg1, rcx); |
drop; |
drop; |
ASSERT(REG.GetReg(R, reg2)) |
|CODE.opASR2, CODE.opROR2, CODE.opLSL2, CODE.opLSR2: |
|IL.opASR2, IL.opROR2, IL.opLSL2, IL.opLSR2: |
UnOp(reg1); |
shiftrc(cmd.opcode, reg1, ORD(BITS(param2) * {0..5})) |
shiftrc(opcode, reg1, param2 MOD 64) |
|CODE.opGET: |
BinOp(reg1, reg2); |
|IL.opGET, IL.opGETC: |
IF opcode = IL.opGET THEN |
BinOp(reg1, reg2) |
ELSIF opcode = IL.opGETC THEN |
UnOp(reg2); |
reg1 := GetAnyReg(); |
movrc(reg1, param1) |
END; |
drop; |
drop; |
_movrm(reg1, reg1, 0, param2 * 8, FALSE); |
_movrm(reg1, reg2, 0, param2 * 8, TRUE) |
|CODE.opCHKBYTE: |
|IL.opCHKBYTE: |
BinOp(reg1, reg2); |
cmprc(reg1, 256); |
jcc(jb, param1) |
|CODE.opCHKIDX: |
|IL.opCHKIDX: |
UnOp(reg1); |
cmprc(reg1, param2); |
jcc(jb, param1) |
|CODE.opCHKIDX2: |
|IL.opCHKIDX2: |
BinOp(reg1, reg2); |
IF param2 # -1 THEN |
cmprr(reg2, reg1); |
2077,17 → 2051,17 |
R.stk[R.top] := reg2 |
END |
|CODE.opLENGTH: |
|IL.opLENGTH: |
PushAll(2); |
CallRTL(CODE._length); |
CallRTL(IL._length); |
GetRegA |
|CODE.opLENGTHW: |
|IL.opLENGTHW: |
PushAll(2); |
CallRTL(CODE._lengthw); |
CallRTL(IL._lengthw); |
GetRegA |
|CODE.opLEN: |
|IL.opLEN: |
n := param2; |
UnOp(reg1); |
drop; |
2102,23 → 2076,23 |
INCL(R.regs, reg1); |
ASSERT(REG.GetReg(R, reg1)) |
|CODE.opCHR: |
|IL.opCHR: |
UnOp(reg1); |
andrc(reg1, 255) |
|CODE.opWCHR: |
|IL.opWCHR: |
UnOp(reg1); |
andrc(reg1, 65535) |
|CODE.opEQP, CODE.opNEP, CODE.opEQIP, CODE.opNEIP: |
|IL.opEQP, IL.opNEP, IL.opEQIP, IL.opNEIP: |
UnOp(reg1); |
reg2 := REG.GetAnyReg(R); |
reg2 := GetAnyReg(); |
CASE cmd.opcode OF |
|CODE.opEQP, CODE.opNEP: |
CASE opcode OF |
|IL.opEQP, IL.opNEP: |
lea(reg2, param1, sCODE) |
|CODE.opEQIP, CODE.opNEIP: |
|IL.opEQIP, IL.opNEIP: |
lea(reg2, param1, sIMP); |
movrm(reg2, reg2, 0) |
END; |
2126,43 → 2100,35 |
cmprr(reg1, reg2); |
drop; |
drop; |
reg1 := REG.GetAnyReg(R); |
reg1 := GetAnyReg(); |
CASE cmd.opcode OF |
|CODE.opEQP, CODE.opEQIP: setcc(sete, reg1) |
|CODE.opNEP, CODE.opNEIP: setcc(setne, reg1) |
CASE opcode OF |
|IL.opEQP, IL.opEQIP: setcc(sete, reg1) |
|IL.opNEP, IL.opNEIP: setcc(setne, reg1) |
END; |
andrc(reg1, 1) |
|CODE.opINC1B, CODE.opDEC1B: |
|IL.opINCCB, IL.opDECCB: |
UnOp(reg1); |
IF reg1 >= 8 THEN |
OutByte(41H) |
END; |
OutByte2(0FEH, 8 * ORD(cmd.opcode = CODE.opDEC1B) + reg1 MOD 8); // inc/dec byte[reg1] |
OutByte3(80H, 28H * ORD(opcode = IL.opDECCB) + reg1 MOD 8, param2 MOD 256); // add/sub byte[reg1], param2 MOD 256 |
drop |
|CODE.opINCCB, CODE.opDECCB: |
UnOp(reg1); |
IF reg1 >= 8 THEN |
OutByte(41H) |
END; |
OutByte3(80H, 28H * ORD(cmd.opcode = CODE.opDECCB) + reg1 MOD 8, param2 MOD 256); // add/sub byte[reg1], param2 MOD 256 |
drop |
|CODE.opINCB, CODE.opDECB: |
|IL.opINCB, IL.opDECB: |
BinOp(reg1, reg2); |
IF (reg1 >= 8) OR (reg2 >= 8) THEN |
OutByte(40H + reg2 DIV 8 + 4 * (reg1 DIV 8)) |
END; |
OutByte2(28H * ORD(cmd.opcode = CODE.opDECB), reg2 MOD 8 + 8 * (reg1 MOD 8)); // add/sub byte[reg2], reg1_8 |
OutByte2(28H * ORD(opcode = IL.opDECB), reg2 MOD 8 + 8 * (reg1 MOD 8)); // add/sub byte[reg2], reg1_8 |
drop; |
drop |
|CODE.opSAVEIP: |
|IL.opSAVEIP: |
UnOp(reg1); |
reg2 := REG.GetAnyReg(R); |
reg2 := GetAnyReg(); |
lea(reg2, param2, sIMP); |
movrm(reg2, reg2, 0); |
push(reg2); |
2173,82 → 2139,82 |
OutByte2(8FH, reg1 MOD 8); // pop qword[reg1] |
drop |
|CODE.opCLEANUP: |
|IL.opCLEANUP: |
n := param2 * 8; |
IF n # 0 THEN |
addrc(rsp, n) |
END |
|CODE.opPOPSP: |
|IL.opPOPSP: |
pop(rsp) |
|CODE.opLOADF: |
|IL.opLOADF: |
UnOp(reg1); |
INC(xmm); |
movsdrm(xmm, reg1, 0); |
drop |
|CODE.opPUSHF: |
|IL.opPUSHF: |
subrc(rsp, 8); |
movsdmr(rsp, 0, xmm); |
DEC(xmm) |
|CODE.opCONSTF: |
|IL.opCONSTF: |
float := cmd.float; |
INC(xmm); |
reg1 := REG.GetAnyReg(R); |
reg1 := GetAnyReg(); |
lea(reg1, Numbers_Offs + Numbers_Count * 8, sDATA); |
movsdrm(xmm, reg1, 0); |
drop; |
NewNumber(UTILS.splitf(float, a, b)) |
|CODE.opSAVEF: |
|IL.opSAVEF: |
UnOp(reg1); |
movsdmr(reg1, 0, xmm); |
DEC(xmm); |
drop |
|CODE.opADDF, CODE.opADDFI: |
|IL.opADDF, IL.opADDFI: |
opxx(58H, xmm - 1, xmm); |
DEC(xmm) |
|CODE.opSUBF: |
|IL.opSUBF: |
opxx(5CH, xmm - 1, xmm); |
DEC(xmm) |
|CODE.opSUBFI: |
|IL.opSUBFI: |
opxx(5CH, xmm, xmm - 1); |
opxx(10H, xmm - 1, xmm); |
DEC(xmm) |
|CODE.opMULF: |
|IL.opMULF: |
opxx(59H, xmm - 1, xmm); |
DEC(xmm) |
|CODE.opDIVF: |
|IL.opDIVF: |
opxx(5EH, xmm - 1, xmm); |
DEC(xmm) |
|CODE.opDIVFI: |
|IL.opDIVFI: |
opxx(5EH, xmm, xmm - 1); |
opxx(10H, xmm - 1, xmm); |
DEC(xmm) |
|CODE.opUMINF: |
reg1 := REG.GetAnyReg(R); |
|IL.opUMINF: |
reg1 := GetAnyReg(); |
lea(reg1, Numbers_Offs, sDATA); |
OutByte3(66H, 40H + reg1 DIV 8 + (xmm DIV 8) * 4, 0FH); // xorpd xmm, xmmword[reg1] |
OutByte2(57H, reg1 MOD 8 + (xmm MOD 8) * 8); |
drop |
|CODE.opFABS: |
reg1 := REG.GetAnyReg(R); |
|IL.opFABS: |
reg1 := GetAnyReg(); |
lea(reg1, Numbers_Offs + 16, sDATA); |
OutByte3(66H, 40H + reg1 DIV 8 + (xmm DIV 8) * 4, 0FH); // andpd xmm, xmmword[reg1] |
OutByte2(54H, reg1 MOD 8 + (xmm MOD 8) * 8); |
drop |
|CODE.opFLT: |
|IL.opFLT: |
UnOp(reg1); |
INC(xmm); |
OutByte(0F2H); Rex(reg1, xmm); OutByte(0FH); // cvtsi2sd xmm, reg1 |
2255,8 → 2221,8 |
OutByte2(2AH, 0C0H + (xmm MOD 8) * 8 + reg1 MOD 8); |
drop |
|CODE.opFLOOR: |
reg1 := REG.GetAnyReg(R); |
|IL.opFLOOR: |
reg1 := GetAnyReg(); |
subrc(rsp, 8); |
OutByte3(00FH, 0AEH, 05CH); OutByte2(024H, 004H); // stmxcsr dword[rsp+4]; |
OutByte2(00FH, 0AEH); OutByte2(01CH, 024H); // stmxcsr dword[rsp]; |
2269,23 → 2235,23 |
addrc(rsp, 8); |
DEC(xmm) |
|CODE.opEQF .. CODE.opGEFI: |
fcmp(cmd.opcode, xmm); |
|IL.opEQF .. IL.opGEF: |
fcmp(opcode, xmm); |
DEC(xmm, 2) |
|CODE.opINF: |
|IL.opINF: |
INC(xmm); |
reg1 := REG.GetAnyReg(R); |
reg1 := GetAnyReg(); |
lea(reg1, Numbers_Offs + 32, sDATA); |
movsdrm(xmm, reg1, 0); |
drop |
|CODE.opPACK, CODE.opPACKC: |
IF cmd.opcode = CODE.opPACK THEN |
|IL.opPACK, IL.opPACKC: |
IF opcode = IL.opPACK THEN |
BinOp(reg1, reg2) |
ELSE |
UnOp(reg1); |
reg2 := REG.GetAnyReg(R); |
reg2 := GetAnyReg(); |
movrc(reg2, param2) |
END; |
push(reg1); |
2310,15 → 2276,15 |
drop; |
drop |
|CODE.opUNPK, CODE.opLADR_UNPK: |
|IL.opUNPK, IL.opLADR_UNPK: |
IF cmd.opcode = CODE.opLADR_UNPK THEN |
IF opcode = IL.opLADR_UNPK THEN |
n := param2 * 8; |
UnOp(reg1); |
reg2 := REG.GetVarReg(R, param2); |
reg2 := GetVarReg(param2); |
regVar := reg2 # -1; |
IF ~regVar THEN |
reg2 := REG.GetAnyReg(R); |
reg2 := GetAnyReg(); |
Rex(0, reg2); |
OutByte2(8DH, 45H + long(n) + (reg2 MOD 8) * 8); // lea reg2, qword[rbp+n] |
OutIntByte(n) |
2336,7 → 2302,7 |
IF regVar THEN |
mov(reg2, reg1); |
reg2 := REG.GetAnyReg(R) |
reg2 := GetAnyReg() |
ELSE |
movmr(reg2, 0, reg1) |
END; |
2357,19 → 2323,19 |
drop; |
drop |
|CODE.opSADR_PARAM: |
|IL.opSADR_PARAM: |
pushDA(stroffs + param2) |
|CODE.opVADR_PARAM: |
|IL.opVADR_PARAM: |
pushm(rbp, param2 * 8) |
|CODE.opLOAD64_PARAM: |
|IL.opLOAD64_PARAM: |
UnOp(reg1); |
pushm(reg1, 0); |
drop |
|CODE.opLLOAD64_PARAM: |
reg1 := REG.GetVarReg(R, param2); |
|IL.opLLOAD64_PARAM: |
reg1 := GetVarReg(param2); |
IF reg1 # -1 THEN |
push(reg1) |
ELSE |
2376,18 → 2342,18 |
pushm(rbp, param2 * 8) |
END |
|CODE.opGLOAD64_PARAM: |
reg2 := REG.GetAnyReg(R); |
|IL.opGLOAD64_PARAM: |
reg2 := GetAnyReg(); |
lea(reg2, param2, sBSS); |
movrm(reg2, reg2, 0); |
push(reg2); |
drop |
|CODE.opCONST_PARAM: |
|IL.opCONST_PARAM: |
pushc(param2) |
|CODE.opGLOAD32_PARAM: |
reg1 := REG.GetAnyReg(R); |
|IL.opGLOAD32_PARAM: |
reg1 := GetAnyReg(); |
xor(reg1, reg1); |
lea(reg1, param2, sBSS); |
movrm32(reg1, reg1, 0); |
2394,7 → 2360,7 |
push(reg1); |
drop |
|CODE.opLOAD32_PARAM: |
|IL.opLOAD32_PARAM: |
UnOp(reg1); |
movrm32(reg1, reg1, 0); |
shiftrc(shl, reg1, 32); |
2402,10 → 2368,10 |
push(reg1); |
drop |
|CODE.opLLOAD32_PARAM: |
reg1 := REG.GetAnyReg(R); |
|IL.opLLOAD32_PARAM: |
reg1 := GetAnyReg(); |
xor(reg1, reg1); |
reg2 := REG.GetVarReg(R, param2); |
reg2 := GetVarReg(param2); |
IF reg2 # -1 THEN |
mov(reg1, reg2) |
ELSE |
2414,14 → 2380,14 |
push(reg1); |
drop |
|CODE.opLADR_SAVEC: |
|IL.opLADR_SAVEC: |
n := param1 * 8; |
reg1 := REG.GetVarReg(R, param1); |
reg1 := GetVarReg(param1); |
IF reg1 # -1 THEN |
movrc(reg1, param2) |
ELSE |
IF isLong(param2) THEN |
reg2 := REG.GetAnyReg(R); |
reg2 := GetAnyReg(); |
movrc(reg2, param2); |
movmr(rbp, n, reg2); |
drop |
2432,17 → 2398,17 |
END |
END |
|CODE.opGADR_SAVEC: |
|IL.opGADR_SAVEC: |
IF isLong(param2) THEN |
reg1 := REG.GetAnyReg(R); |
reg1 := GetAnyReg(); |
movrc(reg1, param2); |
reg2 := REG.GetAnyReg(R); |
reg2 := GetAnyReg(); |
lea(reg2, param1, sBSS); |
movmr(reg2, 0, reg1); |
drop; |
drop |
ELSE |
reg2 := REG.GetAnyReg(R); |
reg2 := GetAnyReg(); |
lea(reg2, param1, sBSS); |
Rex(reg2, 0); |
OutByte2(0C7H, reg2 MOD 8); // mov qword[reg2], param2 |
2450,9 → 2416,9 |
drop |
END |
|CODE.opLADR_SAVE: |
|IL.opLADR_SAVE: |
UnOp(reg1); |
reg2 := REG.GetVarReg(R, param2); |
reg2 := GetVarReg(param2); |
IF reg2 # -1 THEN |
mov(reg2, reg1) |
ELSE |
2460,79 → 2426,48 |
END; |
drop |
|CODE.opLADR_INC1: |
reg1 := REG.GetVarReg(R, param2); |
IF reg1 # -1 THEN |
incr(reg1) |
ELSE |
n := param2 * 8; |
OutByte3(48H, 0FFH, 45H + long(n)); // inc qword[rbp+n] |
OutIntByte(n) |
END |
|CODE.opLADR_DEC1: |
reg1 := REG.GetVarReg(R, param2); |
IF reg1 # -1 THEN |
decr(reg1) |
ELSE |
n := param2 * 8; |
OutByte3(48H, 0FFH, 4DH + long(n)); // dec qword[rbp+n] |
OutIntByte(n) |
END |
|CODE.opLADR_INCC, CODE.opLADR_DECC: |
reg1 := REG.GetVarReg(R, param1); |
|IL.opLADR_INCC: |
reg1 := GetVarReg(param1); |
IF isLong(param2) THEN |
reg2 := REG.GetAnyReg(R); |
reg2 := GetAnyReg(); |
movrc(reg2, param2); |
IF reg1 # -1 THEN |
IF cmd.opcode = CODE.opLADR_DECC THEN |
sub(reg1, reg2) |
ELSE |
add(reg1, reg2) |
END |
ELSE |
n := param1 * 8; |
Rex(0, reg2); |
OutByte2(01H + 28H * ORD(cmd.opcode = CODE.opLADR_DECC), 45H + long(n) + (reg2 MOD 8) * 8); |
OutIntByte(n) // add/sub qword[rbp+n],reg2 |
OutByte2(01H, 45H + long(n) + (reg2 MOD 8) * 8); |
OutIntByte(n) // add qword[rbp+n],reg2 |
END; |
drop |
ELSE |
ELSIF ABS(param2) = 1 THEN |
IF reg1 # -1 THEN |
IF cmd.opcode = CODE.opLADR_DECC THEN |
subrc(reg1, param2) |
IF param2 = 1 THEN |
incr(reg1) |
ELSE |
addrc(reg1, param2) |
decr(reg1) |
END |
ELSE |
n := param1 * 8; |
OutByte3(48H, 81H + short(param2), 45H + long(n) + 28H * ORD(cmd.opcode = CODE.opLADR_DECC)); |
OutIntByte(n); |
OutIntByte(param2) // add/sub qword[rbp+n],param2 |
OutByte3(48H, 0FFH, 45H + 8 * ORD(param2 = -1) + long(n)); // inc/dec qword[rbp+n] |
OutIntByte(n) |
END |
END |
|CODE.opLADR_INC1B, CODE.opLADR_DEC1B: |
reg1 := REG.GetVarReg(R, param2); |
ELSE |
IF reg1 # -1 THEN |
IF cmd.opcode = CODE.opLADR_DEC1B THEN |
decr(reg1) |
addrc(reg1, param2) |
ELSE |
incr(reg1) |
END; |
andrc(reg1, 255) |
ELSE |
n := param2 * 8; |
OutByte2(0FEH, 45H + long(n) + 8 * ORD(cmd.opcode = CODE.opLADR_DEC1B)); |
OutIntByte(n) // inc/dec byte[rbp+n] |
n := param1 * 8; |
OutByte3(48H, 81H + short(param2), 45H + long(n)); |
OutIntByte(n); |
OutIntByte(param2) // add qword[rbp+n],param2 |
END |
END |
|CODE.opLADR_INCCB, CODE.opLADR_DECCB: |
reg1 := REG.GetVarReg(R, param1); |
|IL.opLADR_INCCB, IL.opLADR_DECCB: |
reg1 := GetVarReg(param1); |
param2 := param2 MOD 256; |
IF reg1 # -1 THEN |
IF cmd.opcode = CODE.opLADR_DECCB THEN |
IF opcode = IL.opLADR_DECCB THEN |
subrc(reg1, param2) |
ELSE |
addrc(reg1, param2) |
2540,16 → 2475,16 |
andrc(reg1, 255) |
ELSE |
n := param1 * 8; |
OutByte2(80H, 45H + long(n) + 28H * ORD(cmd.opcode = CODE.opLADR_DECCB)); |
OutByte2(80H, 45H + long(n) + 28H * ORD(opcode = IL.opLADR_DECCB)); |
OutIntByte(n); |
OutByte(param2) // add/sub byte[rbp+n],param2 |
END |
|CODE.opLADR_INC, CODE.opLADR_DEC: |
|IL.opLADR_INC, IL.opLADR_DEC: |
UnOp(reg1); |
reg2 := REG.GetVarReg(R, param2); |
reg2 := GetVarReg(param2); |
IF reg2 # -1 THEN |
IF cmd.opcode = CODE.opLADR_DEC THEN |
IF opcode = IL.opLADR_DEC THEN |
sub(reg2, reg1) |
ELSE |
add(reg2, reg1) |
2557,16 → 2492,16 |
ELSE |
n := param2 * 8; |
Rex(0, reg1); |
OutByte2(01H + 28H * ORD(cmd.opcode = CODE.opLADR_DEC), 45H + long(n) + (reg1 MOD 8) * 8); |
OutByte2(01H + 28H * ORD(opcode = IL.opLADR_DEC), 45H + long(n) + (reg1 MOD 8) * 8); |
OutIntByte(n) // add/sub qword[rbp+n],reg1 |
END; |
drop |
|CODE.opLADR_INCB, CODE.opLADR_DECB: |
|IL.opLADR_INCB, IL.opLADR_DECB: |
UnOp(reg1); |
reg2 := REG.GetVarReg(R, param2); |
reg2 := GetVarReg(param2); |
IF reg2 # -1 THEN |
IF cmd.opcode = CODE.opLADR_DECB THEN |
IF opcode = IL.opLADR_DECB THEN |
sub(reg2, reg1) |
ELSE |
add(reg2, reg1) |
2577,43 → 2512,43 |
IF reg1 >= 8 THEN |
OutByte(44H) |
END; |
OutByte2(28H * ORD(cmd.opcode = CODE.opLADR_DECB), 45H + long(n) + 8 * (reg1 MOD 8)); |
OutByte2(28H * ORD(opcode = IL.opLADR_DECB), 45H + long(n) + 8 * (reg1 MOD 8)); |
OutIntByte(n) // add/sub byte[rbp+n], reg1_8 |
END; |
drop |
|CODE.opLADR_INCL, CODE.opLADR_EXCL: |
|IL.opLADR_INCL, IL.opLADR_EXCL: |
UnOp(reg1); |
cmprc(reg1, 64); |
reg2 := REG.GetVarReg(R, param2); |
reg2 := GetVarReg(param2); |
IF reg2 # -1 THEN |
OutByte2(73H, 4); // jnb L |
oprr2(0FH, 0ABH + 8 * ORD(cmd.opcode = CODE.opLADR_EXCL), reg2, reg1) // bts/btr reg2, reg1 |
oprr2(0FH, 0ABH + 8 * ORD(opcode = IL.opLADR_EXCL), reg2, reg1) // bts/btr reg2, reg1 |
ELSE |
n := param2 * 8; |
OutByte2(73H, 5 + 3 * ORD(~isByte(n))); // jnb L |
Rex(0, reg1); |
OutByte3(0FH, 0ABH + 8 * ORD(cmd.opcode = CODE.opLADR_EXCL), 45H + long(n) + 8 * (reg1 MOD 8)); |
OutByte3(0FH, 0ABH + 8 * ORD(opcode = IL.opLADR_EXCL), 45H + long(n) + 8 * (reg1 MOD 8)); |
OutIntByte(n) // bts/btr qword[rbp+n], reg1 |
END; |
// L: |
drop |
|CODE.opLADR_INCLC, CODE.opLADR_EXCLC: |
reg1 := REG.GetVarReg(R, param1); |
|IL.opLADR_INCLC, IL.opLADR_EXCLC: |
reg1 := GetVarReg(param1); |
IF reg1 # -1 THEN |
Rex(reg1, 0); |
OutByte3(0FH, 0BAH, 0E8H); // bts/btr reg1, param2 |
OutByte2(reg1 MOD 8 + 8 * ORD(cmd.opcode = CODE.opLADR_EXCLC), param2) |
OutByte2(reg1 MOD 8 + 8 * ORD(opcode = IL.opLADR_EXCLC), param2) |
ELSE |
n := param1 * 8; |
OutByte3(48H, 0FH, 0BAH); // bts/btr qword[rbp+n], param2 |
OutByte(6DH + long(n) + 8 * ORD(cmd.opcode = CODE.opLADR_EXCLC)); |
OutByte(6DH + long(n) + 8 * ORD(opcode = IL.opLADR_EXCLC)); |
OutIntByte(n); |
OutByte(param2) |
END |
|CODE.opLOOP, CODE.opENDLOOP: |
|IL.opLOOP, IL.opENDLOOP: |
END; |
2626,14 → 2561,14 |
END translate; |
PROCEDURE prolog (code: CODE.CODES; modname: ARRAY OF CHAR; target, stack_size: INTEGER); |
PROCEDURE prolog (code: IL.CODES; modname: ARRAY OF CHAR; target, stack_size: INTEGER); |
VAR |
ModName_Offs, entry: INTEGER; |
ModName_Offs, entry, L: INTEGER; |
BEGIN |
ModName_Offs := CHL.Length(code.types) * 8 + CHL.Length(code.data); |
ModName_Offs := tcount * 8 + CHL.Length(code.data); |
Numbers_Offs := ModName_Offs + LENGTH(modname) + 1; |
ASSERT(MACHINE.Align(Numbers_Offs, 16)); |
ASSERT(UTILS.Align(Numbers_Offs, 16)); |
entry := NewLabel(); |
X86.SetLabel(entry); |
2643,44 → 2578,64 |
push(r8); |
push(rdx); |
push(rcx); |
CallRTL(CODE._dllentry); |
CallRTL(IL._dllentry); |
test(rax); |
jcc(je, dllret) |
END; |
push(rsp); |
IF target = mConst.Target_iELF64 THEN |
push(rsp) |
ELSE |
pushc(0) |
END; |
lea(rax, entry, sCODE); |
push(rax); |
pushDA(0); //TYPES |
pushc(CHL.Length(code.types)); |
pushc(tcount); |
pushDA(ModName_Offs); //MODNAME |
CallRTL(CODE._init) |
CallRTL(IL._init); |
IF target IN {mConst.Target_iConsole64, mConst.Target_iGUI64} THEN |
L := NewLabel(); |
pushc(0); |
push(rsp); |
pushc(1024 * 1024 * stack_size); |
pushc(0); |
CallRTL(IL._new); |
pop(rax); |
test(rax); |
jcc(je, L); |
addrc(rax, 1024 * 1024 * stack_size - 8); |
mov(rsp, rax); |
X86.SetLabel(L) |
END |
END prolog; |
PROCEDURE epilog (code: CODE.CODES; modname: ARRAY OF CHAR; target: INTEGER); |
PROCEDURE epilog (code: IL.CODES; modname: ARRAY OF CHAR; target: INTEGER); |
VAR |
i, n: INTEGER; |
number: Number; |
exp: CODE.EXPORT_PROC; |
exp: IL.EXPORT_PROC; |
PROCEDURE import (imp: LISTS.LIST); |
VAR |
lib: CODE.IMPORT_LIB; |
proc: CODE.IMPORT_PROC; |
lib: IL.IMPORT_LIB; |
proc: IL.IMPORT_PROC; |
BEGIN |
lib := imp.first(CODE.IMPORT_LIB); |
lib := imp.first(IL.IMPORT_LIB); |
WHILE lib # NIL DO |
BIN.Import(prog, lib.name, 0); |
proc := lib.procs.first(CODE.IMPORT_PROC); |
proc := lib.procs.first(IL.IMPORT_PROC); |
WHILE proc # NIL DO |
BIN.Import(prog, proc.name, proc.label); |
proc := proc.next(CODE.IMPORT_PROC) |
proc := proc.next(IL.IMPORT_PROC) |
END; |
lib := lib.next(CODE.IMPORT_LIB) |
lib := lib.next(IL.IMPORT_LIB) |
END |
END import; |
2690,15 → 2645,21 |
IF target = mConst.Target_iDLL64 THEN |
X86.SetLabel(dllret); |
OutByte(0C3H) // ret |
ELSIF target = mConst.Target_iELFSO64 THEN |
sofinit := NewLabel(); |
OutByte(0C3H); // ret |
X86.SetLabel(sofinit); |
CallRTL(IL._sofinit); |
OutByte(0C3H) // ret |
ELSE |
pushc(0); |
CallRTL(CODE._exit) |
CallRTL(IL._exit) |
END; |
X86.fixup; |
i := 0; |
WHILE i < CHL.Length(code.types) DO |
WHILE i < tcount DO |
BIN.PutData64LE(prog, CHL.GetInt(code.types, i)); |
INC(i) |
END; |
2712,7 → 2673,7 |
BIN.PutDataStr(prog, modname); |
BIN.PutData(prog, 0); |
n := CHL.Length(prog.data); |
ASSERT(MACHINE.Align(n, 16)); |
ASSERT(UTILS.Align(n, 16)); |
i := n - CHL.Length(prog.data); |
WHILE i > 0 DO |
BIN.PutData(prog, 0); |
2724,10 → 2685,10 |
number := number.next(Number) |
END; |
exp := code.export.first(CODE.EXPORT_PROC); |
exp := code.export.first(IL.EXPORT_PROC); |
WHILE exp # NIL DO |
BIN.Export(prog, exp.name, exp.label); |
exp := exp.next(CODE.EXPORT_PROC) |
exp := exp.next(IL.EXPORT_PROC) |
END; |
import(code.import) |
2758,12 → 2719,13 |
END rsave; |
PROCEDURE CodeGen* (code: CODE.CODES; outname: ARRAY OF CHAR; target, stack, base: INTEGER); |
PROCEDURE CodeGen* (code: IL.CODES; outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS); |
VAR |
path, modname, ext: PATHS.PATH; |
n: INTEGER; |
BEGIN |
tcount := CHL.Length(code.types); |
Win64RegPar[0] := rcx; |
Win64RegPar[1] := rdx; |
Win64RegPar[2] := r8; |
2779,13 → 2741,9 |
PATHS.split(outname, path, modname, ext); |
S.append(modname, ext); |
R := REG.Create(push, pop, mov, xchg, rload, rsave, {rax, r10, r11}, {rcx, rdx, r8, r9}); |
REG.Init(R, push, pop, mov, xchg, rload, rsave, {rax, r10, r11}, {rcx, rdx, r8, r9}); |
n := code.dmin - CHL.Length(code.data); |
IF n > 0 THEN |
INC(code.bss, n) |
END; |
code.bss := MAX(code.bss, 8); |
code.bss := MAX(code.bss, MAX(code.dmin - CHL.Length(code.data), 8)); |
Numbers := LISTS.create(NIL); |
Numbers_Count := 0; |
2798,19 → 2756,19 |
NewNumber(LSR(ASR(ROR(1, 1), 9), 2)); (* {52..61} *) |
prog := BIN.create(code.lcount); |
BIN.SetParams(prog, code.bss, stack, WCHR(1), WCHR(0)); |
BIN.SetParams(prog, code.bss, 1, WCHR(1), WCHR(0)); |
X86.SetProgram(prog); |
prolog(code, modname, target, stack); |
translate(code.commands, CHL.Length(code.types) * 8); |
prolog(code, modname, target, options.stack); |
translate(code.commands, tcount * 8); |
epilog(code, modname, target); |
BIN.fixup(prog); |
IF target IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64} THEN |
PE32.write(prog, outname, base, target = mConst.Target_iConsole64, target = mConst.Target_iDLL64, TRUE) |
ELSIF target = mConst.Target_iELF64 THEN |
ELF.write(prog, outname, TRUE) |
PE32.write(prog, outname, options.base, target = mConst.Target_iConsole64, target = mConst.Target_iDLL64, TRUE) |
ELSIF target IN {mConst.Target_iELF64, mConst.Target_iELFSO64} THEN |
ELF.write(prog, outname, sofinit, target = mConst.Target_iELFSO64, TRUE) |
END |
END CodeGen; |
/programs/develop/oberon07/Source/ARITH.ob07 |
---|
7,7 → 7,7 |
MODULE ARITH; |
IMPORT AVLTREES, STRINGS, MACHINE, UTILS; |
IMPORT AVLTREES, STRINGS, UTILS; |
CONST |
53,10 → 53,7 |
ELSIF v.typ = tWCHAR THEN |
res := v.int |
ELSIF v.typ = tSET THEN |
res := ORD(v.set); |
IF MACHINE._64to32 THEN |
res := MACHINE.Int32To64(res) |
END |
res := UTILS.Long(ORD(v.set)) |
ELSIF v.typ = tBOOLEAN THEN |
res := ORD(v.bool) |
END |
88,13 → 85,13 |
BEGIN |
error := FALSE; |
IF (v.typ = tINTEGER) & ((v.int < MACHINE.target.minInt) OR (v.int > MACHINE.target.maxInt)) THEN |
IF (v.typ = tINTEGER) & ((v.int < UTILS.target.minInt) OR (v.int > UTILS.target.maxInt)) THEN |
error := TRUE |
ELSIF (v.typ = tCHAR) & ((v.int < 0) OR (v.int > 255)) THEN |
error := TRUE |
ELSIF (v.typ = tWCHAR) & ((v.int < 0) OR (v.int > 65535)) THEN |
error := TRUE |
ELSIF (v.typ = tREAL) & ((v.float < -MACHINE.target.maxReal) OR (v.float > MACHINE.target.maxReal)) THEN |
ELSIF (v.typ = tREAL) & ((v.float < -UTILS.target.maxReal) OR (v.float > UTILS.target.maxReal)) THEN |
error := TRUE |
END |
172,7 → 169,7 |
n := i |
END; |
IF (n # -1) & (i - n + 1 > MACHINE.target.maxHex) THEN |
IF (n # -1) & (i - n + 1 > UTILS.target.maxHex) THEN |
error := 2 |
ELSE |
value := value * 16 + d; |
181,9 → 178,7 |
END; |
IF MACHINE._64to32 THEN |
value := MACHINE.Int32To64(value); |
END; |
value := UTILS.Long(value); |
IF (s[i] = "X") & (n # -1) & (i - n > 4) THEN |
error := 3 |
471,58 → 466,53 |
PROCEDURE _ASR (x, n: INTEGER): INTEGER; |
BEGIN |
IF MACHINE._64to32 THEN |
x := MACHINE.Int32To64(x) |
END |
RETURN ASR(x, n) |
RETURN ASR(UTILS.Long(x), n) |
END _ASR; |
PROCEDURE _LSR (x, n: INTEGER): INTEGER; |
BEGIN |
IF MACHINE._64to32 THEN |
x := MACHINE.Int64To32(x); |
x := LSR(x, n); |
x := MACHINE.Int32To64(x) |
ELSE |
x := LSR(x, n) |
END |
RETURN x |
RETURN UTILS.Long(LSR(UTILS.Short(x), n)) |
END _LSR; |
PROCEDURE _LSL (x, n: INTEGER): INTEGER; |
BEGIN |
x := LSL(x, n); |
IF MACHINE._64to32 THEN |
x := MACHINE.Int32To64(x) |
END |
RETURN x |
RETURN UTILS.Long(LSL(x, n)) |
END _LSL; |
PROCEDURE _ROR1_32 (x: INTEGER): INTEGER; |
BEGIN |
x := MACHINE.Int64To32(x); |
x := UTILS.Short(x); |
x := ORD(BITS(LSR(x, 1)) + BITS(LSL(x, 31))) |
RETURN MACHINE.Int32To64(x) |
RETURN UTILS.Long(x) |
END _ROR1_32; |
PROCEDURE _ROR1_16 (x: INTEGER): INTEGER; |
BEGIN |
x := x MOD 65536; |
x := ORD(BITS(LSR(x, 1)) + BITS(LSL(x, 15))) |
RETURN UTILS.Long(x) |
END _ROR1_16; |
PROCEDURE _ROR (x, n: INTEGER): INTEGER; |
BEGIN |
IF MACHINE._64to32 THEN |
CASE UTILS.bit_diff OF |
|0: x := ROR(x, n) |
|16, 48: |
n := n MOD 16; |
WHILE n > 0 DO |
x := _ROR1_16(x); |
DEC(n) |
END |
|32: |
n := n MOD 32; |
WHILE n > 0 DO |
x := _ROR1_32(x); |
DEC(n) |
END |
ELSE |
x := ROR(x, n) |
END |
RETURN x |
587,11 → 577,7 |
CASE v.typ OF |
|tCHAR, tWCHAR: |
|tBOOLEAN: v.int := ORD(v.bool) |
|tSET: |
v.int := ORD(v.set); |
IF MACHINE._64to32 THEN |
v.int := MACHINE.Int32To64(v.int) |
END |
|tSET: v.int := UTILS.Long(ORD(v.set)) |
END; |
v.typ := tINTEGER |
END ord; |
787,7 → 773,7 |
|"I": |
IF (v.typ = tINTEGER) & (v2.typ = tSET) THEN |
IF range(v, 0, MACHINE.target.maxSet) THEN |
IF range(v, 0, UTILS.target.maxSet) THEN |
res := v.int IN v2.set |
ELSE |
error := 2 |
/programs/develop/oberon07/Source/AVLTREES.ob07 |
---|
1,7 → 1,7 |
(* |
BSD 2-Clause License |
Copyright (c) 2018, Anton Krotov |
Copyright (c) 2018, 2019, Anton Krotov |
All rights reserved. |
*) |
/programs/develop/oberon07/Source/BIN.ob07 |
---|
7,7 → 7,7 |
MODULE BIN; |
IMPORT LISTS, MACHINE, CHL := CHUNKLISTS, ARITH, UTILS; |
IMPORT LISTS, CHL := CHUNKLISTS, ARITH, UTILS; |
CONST |
138,7 → 138,10 |
END; |
IF UTILS.bit_depth = 64 THEN |
x := MACHINE.Int32To64(x) |
x := LSL(x, 16); |
x := LSL(x, 16); |
x := ASR(x, 16); |
x := ASR(x, 16) |
END |
RETURN x |
151,7 → 154,7 |
BEGIN |
FOR i := 0 TO 3 DO |
CHL.SetByte(array, idx + i, MACHINE.Byte(x, i)) |
CHL.SetByte(array, idx + i, UTILS.Byte(x, i)) |
END |
END put32le; |
162,7 → 165,7 |
BEGIN |
FOR i := 0 TO 3 DO |
CHL.PushByte(program.data, MACHINE.Byte(x, i)) |
CHL.PushByte(program.data, UTILS.Byte(x, i)) |
END |
END PutData32LE; |
173,7 → 176,7 |
BEGIN |
FOR i := 0 TO 7 DO |
CHL.PushByte(program.data, MACHINE.Byte(x, i)) |
CHL.PushByte(program.data, UTILS.Byte(x, i)) |
END |
END PutData64LE; |
203,7 → 206,7 |
BEGIN |
FOR i := 0 TO 3 DO |
CHL.PushByte(program.code, MACHINE.Byte(x, i)) |
CHL.PushByte(program.code, UTILS.Byte(x, i)) |
END |
END PutCode32LE; |
217,7 → 220,6 |
PROCEDURE Import* (program: PROGRAM; name: ARRAY OF CHAR; label: INTEGER); |
VAR |
imp: IMPRT; |
i: INTEGER; |
BEGIN |
CHL.PushByte(program.import, 0); |
228,16 → 230,9 |
END; |
NEW(imp); |
imp.nameoffs := CHL.Length(program.import); |
imp.nameoffs := CHL.PushStr(program.import, name); |
imp.label := label; |
LISTS.push(program.imp_list, imp); |
i := 0; |
WHILE name[i] # 0X DO |
CHL.PushByte(program.import, ORD(name[i])); |
INC(i) |
END; |
CHL.PushByte(program.import, 0) |
LISTS.push(program.imp_list, imp) |
END Import; |
262,20 → 257,12 |
PROCEDURE Export* (program: PROGRAM; name: ARRAY OF CHAR; label: INTEGER); |
VAR |
exp, cur: EXPRT; |
i: INTEGER; |
BEGIN |
NEW(exp); |
exp.nameoffs := CHL.Length(program.export); |
exp.label := CHL.GetInt(program.labels, label); |
exp.nameoffs := CHL.PushStr(program.export, name); |
i := 0; |
WHILE name[i] # 0X DO |
CHL.PushByte(program.export, ORD(name[i])); |
INC(i) |
END; |
CHL.PushByte(program.export, 0); |
cur := program.exp_list.first(EXPRT); |
WHILE (cur # NIL) & less(program.export, cur, exp) DO |
cur := cur.next(EXPRT) |
389,7 → 376,7 |
array[i + idx] := hexdgt(hex[2 * i]) * 16 + hexdgt(hex[2 * i + 1]) |
END; |
idx := idx + k |
INC(idx, k) |
END InitArray; |
/programs/develop/oberon07/Source/CHUNKLISTS.ob07 |
---|
1,7 → 1,7 |
(* |
BSD 2-Clause License |
Copyright (c) 2018, Anton Krotov |
Copyright (c) 2018, 2019, Anton Krotov |
All rights reserved. |
*) |
118,6 → 118,41 |
END PushByte; |
PROCEDURE PushStr* (list: BYTELIST; str: ARRAY OF CHAR): INTEGER; |
VAR |
i, res: INTEGER; |
BEGIN |
res := list.length; |
i := 0; |
REPEAT |
PushByte(list, ORD(str[i])); |
INC(i) |
UNTIL str[i - 1] = 0X |
RETURN res |
END PushStr; |
PROCEDURE GetStr* (list: BYTELIST; pos: INTEGER; VAR str: ARRAY OF CHAR): BOOLEAN; |
VAR |
i: INTEGER; |
res: BOOLEAN; |
BEGIN |
res := FALSE; |
i := 0; |
WHILE (pos < list.length) & (i < LEN(str)) & ~res DO |
str[i] := CHR(GetByte(list, pos)); |
res := str[i] = 0X; |
INC(pos); |
INC(i) |
END |
RETURN res |
END GetStr; |
PROCEDURE WriteToFile* (file: WR.FILE; list: BYTELIST); |
VAR |
chunk: BYTECHUNK; |
/programs/develop/oberon07/Source/COLLECTIONS.ob07 |
---|
1,7 → 1,7 |
(* |
BSD 2-Clause License |
Copyright (c) 2018, Anton Krotov |
Copyright (c) 2018, 2019, Anton Krotov |
All rights reserved. |
*) |
/programs/develop/oberon07/Source/CONSOLE.ob07 |
---|
1,7 → 1,7 |
(* |
BSD 2-Clause License |
Copyright (c) 2018, Anton Krotov |
Copyright (c) 2018, 2019, Anton Krotov |
All rights reserved. |
*) |
23,22 → 23,32 |
END String; |
PROCEDURE Int* (n: INTEGER); |
PROCEDURE Int* (x: INTEGER); |
VAR |
s: ARRAY 32 OF CHAR; |
s: ARRAY 24 OF CHAR; |
BEGIN |
STRINGS.IntToStr(n, s); |
STRINGS.IntToStr(x, s); |
String(s) |
END Int; |
PROCEDURE Int2* (n: INTEGER); |
PROCEDURE Hex* (x, n: INTEGER); |
VAR |
s: ARRAY 24 OF CHAR; |
BEGIN |
IF n < 10 THEN |
STRINGS.IntToHex(x, s, n); |
String(s) |
END Hex; |
PROCEDURE Int2* (x: INTEGER); |
BEGIN |
IF x < 10 THEN |
String("0") |
END; |
Int(n) |
Int(x) |
END Int2; |
55,16 → 65,16 |
END StringLn; |
PROCEDURE IntLn* (n: INTEGER); |
PROCEDURE IntLn* (x: INTEGER); |
BEGIN |
Int(n); |
Int(x); |
Ln |
END IntLn; |
PROCEDURE Int2Ln* (n: INTEGER); |
PROCEDURE Int2Ln* (x: INTEGER); |
BEGIN |
Int2(n); |
Int2(x); |
Ln |
END Int2Ln; |
/programs/develop/oberon07/Source/CONSTANTS.ob07 |
---|
9,8 → 9,8 |
CONST |
vMajor* = 0; |
vMinor* = 98; |
vMajor* = 1; |
vMinor* = 0; |
FILE_EXT* = ".ob07"; |
RTL_NAME* = "RTL"; |
26,7 → 26,10 |
Target_iGUI64* = 7; |
Target_iDLL64* = 8; |
Target_iELF32* = 9; |
Target_iELF64* = 10; |
Target_iELFSO32* = 10; |
Target_iELF64* = 11; |
Target_iELFSO64* = 12; |
Target_iMSP430* = 13; |
Target_sConsole* = "console"; |
Target_sGUI* = "gui"; |
37,7 → 40,10 |
Target_sGUI64* = "gui64"; |
Target_sDLL64* = "dll64"; |
Target_sELF32* = "elfexe"; |
Target_sELFSO32* = "elfso"; |
Target_sELF64* = "elfexe64"; |
Target_sELFSO64* = "elfso64"; |
Target_sMSP430* = "msp430"; |
END CONSTANTS. |
/programs/develop/oberon07/Source/Compiler.ob07 |
---|
7,7 → 7,7 |
MODULE Compiler; |
IMPORT ST := STATEMENTS, PARS, UTILS, PATHS, C := CONSOLE, ERRORS, STRINGS, mConst := CONSTANTS, WRITER; |
IMPORT ST := STATEMENTS, PARS, UTILS, PATHS, PROG, C := CONSOLE, ERRORS, STRINGS, mConst := CONSTANTS, WRITER, MSP430; |
PROCEDURE Target (s: ARRAY OF CHAR): INTEGER; |
33,8 → 33,14 |
res := mConst.Target_iDLL64 |
ELSIF s = mConst.Target_sELF32 THEN |
res := mConst.Target_iELF32 |
ELSIF s = mConst.Target_sELFSO32 THEN |
res := mConst.Target_iELFSO32 |
ELSIF s = mConst.Target_sELF64 THEN |
res := mConst.Target_iELF64 |
ELSIF s = mConst.Target_sELFSO64 THEN |
res := mConst.Target_iELFSO64 |
ELSIF s = mConst.Target_sMSP430 THEN |
res := mConst.Target_iMSP430 |
ELSE |
res := 0 |
END |
43,7 → 49,7 |
END Target; |
PROCEDURE keys (VAR StackSize, BaseAddress, Version: INTEGER; VAR pic: BOOLEAN; VAR checking: SET); |
PROCEDURE keys (VAR options: PROG.OPTIONS); |
VAR |
param: PARS.PATH; |
i, j: INTEGER; |
51,8 → 57,10 |
value: INTEGER; |
minor, |
major: INTEGER; |
checking: SET; |
BEGIN |
checking := options.checking; |
end := FALSE; |
i := 4; |
REPEAT |
62,7 → 70,7 |
INC(i); |
UTILS.GetArg(i, param); |
IF STRINGS.StrToInt(param, value) & (1 <= value) & (value <= 32) THEN |
StackSize := value |
options.stack := value |
END; |
IF param[0] = "-" THEN |
DEC(i) |
72,12 → 80,32 |
INC(i); |
UTILS.GetArg(i, param); |
IF STRINGS.StrToInt(param, value) THEN |
BaseAddress := ((value DIV 64) * 64) * 1024 |
options.base := ((value DIV 64) * 64) * 1024 |
END; |
IF param[0] = "-" THEN |
DEC(i) |
END |
ELSIF param = "-ram" THEN |
INC(i); |
UTILS.GetArg(i, param); |
IF STRINGS.StrToInt(param, value) THEN |
options.ram := value |
END; |
IF param[0] = "-" THEN |
DEC(i) |
END |
ELSIF param = "-rom" THEN |
INC(i); |
UTILS.GetArg(i, param); |
IF STRINGS.StrToInt(param, value) THEN |
options.rom := value |
END; |
IF param[0] = "-" THEN |
DEC(i) |
END |
ELSIF param = "-nochk" THEN |
INC(i); |
UTILS.GetArg(i, param); |
109,14 → 137,15 |
END; |
INC(j) |
END; |
END |
END |
ELSIF param = "-ver" THEN |
INC(i); |
UTILS.GetArg(i, param); |
IF STRINGS.StrToVer(param, major, minor) THEN |
Version := major * 65536 + minor |
options.version := major * 65536 + minor |
END; |
IF param[0] = "-" THEN |
DEC(i) |
123,18 → 152,19 |
END |
ELSIF param = "-pic" THEN |
pic := TRUE |
options.pic := TRUE |
ELSIF param = "" THEN |
end := TRUE |
ELSE |
ERRORS.error3("bad parameter: ", param, "") |
ERRORS.BadParam(param) |
END; |
INC(i) |
UNTIL end |
UNTIL end; |
options.checking := checking |
END keys; |
149,24 → 179,16 |
outname: PARS.PATH; |
param: PARS.PATH; |
temp: PARS.PATH; |
target: INTEGER; |
bit_depth: INTEGER; |
time: INTEGER; |
options: PROG.OPTIONS; |
StackSize, |
Version, |
BaseAdr: INTEGER; |
pic: BOOLEAN; |
checking: SET; |
bits64: BOOLEAN; |
BEGIN |
StackSize := 2; |
Version := 65536; |
pic := FALSE; |
checking := ST.chkALL; |
options.stack := 2; |
options.version := 65536; |
options.pic := FALSE; |
options.checking := ST.chkALL; |
PATHS.GetCurrentDirectory(app_path); |
lib_path := app_path; |
173,14 → 195,18 |
UTILS.GetArg(1, inname); |
C.Ln; |
C.String("Akron Oberon Compiler v"); C.Int(mConst.vMajor); C.String("."); C.Int2(mConst.vMinor); |
C.String(" ("); C.Int(UTILS.bit_depth); C.StringLn("-bit)"); |
C.StringLn("Copyright (c) 2018-2019, Anton Krotov"); |
IF inname = "" THEN |
C.String("Akron Oberon-07/16 Compiler v"); C.Int(mConst.vMajor); C.String("."); C.Int2(mConst.vMinor); |
C.String(" ("); C.Int(UTILS.bit_depth); C.StringLn("-bit)"); C.Ln; |
C.Ln; |
C.StringLn("Usage: Compiler <main module> <output> <target> [optional settings]"); C.Ln; |
IF UTILS.bit_depth = 64 THEN |
C.StringLn('target = console | gui | dll | console64 | gui64 | dll64 | kos | obj | elfexe | elfexe64'); C.Ln; |
C.StringLn('target = console | gui | dll | console64 | gui64 | dll64 | kos | obj | elfexe | elfso | elfexe64 | elfso64 | msp430'); C.Ln; |
ELSIF UTILS.bit_depth = 32 THEN |
C.StringLn('target = console | gui | dll | kos | obj | elfexe'); C.Ln; |
C.StringLn('target = console | gui | dll | kos | obj | elfexe | elfso | msp430'); C.Ln; |
END; |
C.StringLn("optional settings:"); C.Ln; |
C.StringLn(" -stk <size> set size of stack in megabytes"); C.Ln; |
188,6 → 214,8 |
C.StringLn(' -ver <major.minor> set version of program'); C.Ln; |
C.StringLn(' -nochk <"ptibcwra"> disable runtime checking (pointers, types, indexes,'); |
C.StringLn(' BYTE, CHR, WCHR)'); C.Ln; |
C.StringLn(" -ram <size> set size of RAM in bytes (MSP430)"); C.Ln; |
C.StringLn(" -rom <size> set size of ROM in bytes (MSP430)"); C.Ln; |
UTILS.Exit(0) |
END; |
194,8 → 222,9 |
PATHS.split(inname, path, modname, ext); |
IF ext # mConst.FILE_EXT THEN |
ERRORS.error3('inputfile name extension must be "', mConst.FILE_EXT, '"') |
ERRORS.Error(207) |
END; |
IF PATHS.isRelative(path) THEN |
PATHS.RelPath(app_path, path, temp); |
path := temp |
203,7 → 232,7 |
UTILS.GetArg(2, outname); |
IF outname = "" THEN |
ERRORS.error1("not enough parameters") |
ERRORS.Error(205) |
END; |
IF PATHS.isRelative(outname) THEN |
PATHS.RelPath(app_path, outname, temp); |
212,60 → 241,71 |
UTILS.GetArg(3, param); |
IF param = "" THEN |
ERRORS.error1("not enough parameters") |
ERRORS.Error(205) |
END; |
target := Target(param); |
IF target = 0 THEN |
ERRORS.error1("bad parameter <target>") |
ERRORS.Error(206) |
END; |
bits64 := target IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64, mConst.Target_iELF64}; |
CASE target OF |
|mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64, mConst.Target_iELF64, mConst.Target_iELFSO64: |
bit_depth := 64 |
|mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL, |
mConst.Target_iKolibri, mConst.Target_iObject, mConst.Target_iELF32, mConst.Target_iELFSO32: |
bit_depth := 32 |
|mConst.Target_iMSP430: |
bit_depth := 16; |
options.ram := MSP430.minRAM; |
options.rom := MSP430.minROM |
END; |
IF bits64 THEN |
IF UTILS.bit_depth = 32 THEN |
ERRORS.error1("bad parameter <target>") |
IF UTILS.bit_depth < bit_depth THEN |
ERRORS.Error(206) |
END; |
PARS.init(64, target) |
ELSE |
PARS.init(32, target) |
END; |
PARS.program.dll := target IN {mConst.Target_iDLL, mConst.Target_iObject, mConst.Target_iDLL64}; |
PARS.program.obj := target = mConst.Target_iObject; |
STRINGS.append(lib_path, "lib"); |
STRINGS.append(lib_path, UTILS.slash); |
IF target IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL} THEN |
CASE target OF |
|mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL: |
IF target = mConst.Target_iDLL THEN |
BaseAdr := 10000000H |
options.base := 10000000H |
ELSE |
BaseAdr := 400000H |
options.base := 400000H |
END; |
STRINGS.append(lib_path, "Windows32") |
ELSIF target IN {mConst.Target_iKolibri, mConst.Target_iObject} THEN |
|mConst.Target_iKolibri, mConst.Target_iObject: |
STRINGS.append(lib_path, "KolibriOS") |
ELSIF target = mConst.Target_iELF32 THEN |
|mConst.Target_iELF32, mConst.Target_iELFSO32: |
STRINGS.append(lib_path, "Linux32") |
ELSIF target = mConst.Target_iELF64 THEN |
|mConst.Target_iELF64, mConst.Target_iELFSO64: |
STRINGS.append(lib_path, "Linux64") |
ELSIF target IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64} THEN |
|mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64: |
STRINGS.append(lib_path, "Windows64") |
|mConst.Target_iMSP430: |
STRINGS.append(lib_path, "MSP430") |
END; |
STRINGS.append(lib_path, UTILS.slash); |
keys(StackSize, BaseAdr, Version, pic, checking); |
keys(options); |
ST.compile(path, lib_path, modname, outname, target, Version, StackSize, BaseAdr, pic, checking); |
PARS.init(bit_depth, target, options); |
PARS.program.dll := target IN {mConst.Target_iELFSO32, mConst.Target_iELFSO64, mConst.Target_iDLL, mConst.Target_iDLL64, mConst.Target_iObject}; |
PARS.program.obj := target = mConst.Target_iObject; |
ST.compile(path, lib_path, modname, outname, target, options); |
time := UTILS.GetTickCount() - UTILS.time; |
C.Int(time DIV 100); C.String("."); C.Int2(time MOD 100); C.String(" sec, "); |
/programs/develop/oberon07/Source/ELF.ob07 |
---|
7,7 → 7,7 |
MODULE ELF; |
IMPORT BIN, WR := WRITER, CHL := CHUNKLISTS; |
IMPORT BIN, WR := WRITER, CHL := CHUNKLISTS, LISTS; |
CONST |
68,9 → 68,35 |
END; |
Elf32_Dyn = POINTER TO RECORD (LISTS.ITEM) |
d_tag, d_val: INTEGER |
END; |
Elf32_Sym = POINTER TO RECORD (LISTS.ITEM) |
name, value, size: INTEGER; |
info, other: CHAR; |
shndx: WCHAR |
END; |
FILE = WR.FILE; |
VAR |
dynamic: LISTS.LIST; |
strtab: CHL.BYTELIST; |
symtab: LISTS.LIST; |
hashtab, bucket, chain: CHL.INTLIST; |
PROCEDURE align (n, _align: INTEGER): INTEGER; |
BEGIN |
IF n MOD _align # 0 THEN |
136,7 → 162,75 |
END fixup; |
PROCEDURE write* (program: BIN.PROGRAM; FileName: ARRAY OF CHAR; amd64: BOOLEAN); |
PROCEDURE NewDyn (tag, val: INTEGER); |
VAR |
dyn: Elf32_Dyn; |
BEGIN |
NEW(dyn); |
dyn.d_tag := tag; |
dyn.d_val := val; |
LISTS.push(dynamic, dyn) |
END NewDyn; |
PROCEDURE NewSym (name, value, size: INTEGER; info, other: CHAR; shndx: WCHAR); |
VAR |
sym: Elf32_Sym; |
BEGIN |
NEW(sym); |
sym.name := name; |
sym.value := value; |
sym.size := size; |
sym.info := info; |
sym.other := other; |
sym.shndx := shndx; |
LISTS.push(symtab, sym) |
END NewSym; |
PROCEDURE HashStr (name: ARRAY OF CHAR): INTEGER; |
VAR |
i, h: INTEGER; |
g: SET; |
BEGIN |
h := 0; |
i := 0; |
WHILE name[i] # 0X DO |
h := h * 16 + ORD(name[i]); |
g := BITS(h) * {28..31}; |
h := ORD(BITS(h) / BITS(LSR(ORD(g), 24)) - g); |
INC(i) |
END |
RETURN h |
END HashStr; |
PROCEDURE MakeHash (bucket, chain: CHL.INTLIST; symCount: INTEGER); |
VAR |
symi, hi, k: INTEGER; |
BEGIN |
FOR symi := 0 TO symCount - 1 DO |
CHL.SetInt(chain, symi, 0); |
hi := CHL.GetInt(hashtab, symi) MOD symCount; |
IF CHL.GetInt(bucket, hi) # 0 THEN |
k := symi; |
WHILE CHL.GetInt(chain, k) # 0 DO |
k := CHL.GetInt(chain, k) |
END; |
CHL.SetInt(chain, k, CHL.GetInt(bucket, hi)) |
END; |
CHL.SetInt(bucket, hi, symi) |
END |
END MakeHash; |
PROCEDURE write* (program: BIN.PROGRAM; FileName: ARRAY OF CHAR; fini: INTEGER; so, amd64: BOOLEAN); |
CONST |
interp = 0; |
dyn = 1; |
145,33 → 239,67 |
data = 4; |
bss = 5; |
linuxInterpreter64 = "/lib64/ld-linux-x86-64.so.2"; |
linuxInterpreter32 = "/lib/ld-linux.so.2"; |
exeBaseAddress32 = 8048000H; |
exeBaseAddress64 = 400000H; |
dllBaseAddress = 0; |
DT_NULL = 0; |
DT_NEEDED = 1; |
DT_HASH = 4; |
DT_STRTAB = 5; |
DT_SYMTAB = 6; |
DT_RELA = 7; |
DT_RELASZ = 8; |
DT_RELAENT = 9; |
DT_STRSZ = 10; |
DT_SYMENT = 11; |
DT_INIT = 12; |
DT_FINI = 13; |
DT_SONAME = 14; |
DT_REL = 17; |
DT_RELSZ = 18; |
DT_RELENT = 19; |
VAR |
ehdr: Elf32_Ehdr; |
phdr: ARRAY 16 OF Elf32_Phdr; |
i, LoadAdr, offset, pad, VA: INTEGER; |
i, BaseAdr, offset, pad, VA, symCount: INTEGER; |
SizeOf: RECORD header, code, data, bss: INTEGER END; |
Offset: RECORD symtab, reltab, hash, strtab, dyn: INTEGER END; |
File: FILE; |
str: ARRAY 40 OF CHAR; lstr: INTEGER; |
Dyn: ARRAY 350 OF BYTE; |
Interpreter: ARRAY 40 OF CHAR; lenInterpreter: INTEGER; |
item: LISTS.ITEM; |
Name: ARRAY 2048 OF CHAR; |
BEGIN |
dynamic := LISTS.create(NIL); |
symtab := LISTS.create(NIL); |
strtab := CHL.CreateByteList(); |
IF amd64 THEN |
str := "/lib64/ld-linux-x86-64.so.2" |
BaseAdr := exeBaseAddress64; |
Interpreter := linuxInterpreter64 |
ELSE |
str := "/lib/ld-linux.so.2" |
BaseAdr := exeBaseAddress32; |
Interpreter := linuxInterpreter32 |
END; |
lstr := LENGTH(str); |
IF amd64 THEN |
LoadAdr := 400000H |
ELSE |
LoadAdr := 08048000H |
IF so THEN |
BaseAdr := dllBaseAddress |
END; |
lenInterpreter := LENGTH(Interpreter) + 1; |
SizeOf.code := CHL.Length(program.code); |
SizeOf.data := CHL.Length(program.data); |
SizeOf.bss := program.bss; |
192,7 → 320,12 |
ehdr.e_ident[i] := 0 |
END; |
ehdr.e_type := WCHR(ET_EXEC); |
IF so THEN |
ehdr.e_type := WCHR(ET_DYN) |
ELSE |
ehdr.e_type := WCHR(ET_EXEC) |
END; |
ehdr.e_version := 1; |
ehdr.e_shoff := 0; |
ehdr.e_flags := 0; |
218,24 → 351,92 |
phdr[interp].p_type := 3; |
phdr[interp].p_offset := SizeOf.header; |
phdr[interp].p_vaddr := LoadAdr + phdr[interp].p_offset; |
phdr[interp].p_paddr := LoadAdr + phdr[interp].p_offset; |
phdr[interp].p_filesz := lstr + 1; |
phdr[interp].p_memsz := lstr + 1; |
phdr[interp].p_vaddr := BaseAdr + phdr[interp].p_offset; |
phdr[interp].p_paddr := phdr[interp].p_vaddr; |
phdr[interp].p_filesz := lenInterpreter; |
phdr[interp].p_memsz := lenInterpreter; |
phdr[interp].p_flags := PF_R; |
phdr[interp].p_align := 1; |
phdr[dyn].p_type := 2; |
phdr[dyn].p_offset := phdr[interp].p_offset + phdr[interp].p_filesz; |
phdr[dyn].p_vaddr := LoadAdr + phdr[dyn].p_offset; |
phdr[dyn].p_paddr := LoadAdr + phdr[dyn].p_offset; |
phdr[dyn].p_vaddr := BaseAdr + phdr[dyn].p_offset; |
phdr[dyn].p_paddr := phdr[dyn].p_vaddr; |
hashtab := CHL.CreateIntList(); |
CHL.PushInt(hashtab, HashStr("")); |
NewSym(CHL.PushStr(strtab, ""), 0, 0, 0X, 0X, 0X); |
CHL.PushInt(hashtab, HashStr("dlopen")); |
NewSym(CHL.PushStr(strtab, "dlopen"), 0, 0, 12X, 0X, 0X); |
CHL.PushInt(hashtab, HashStr("dlsym")); |
NewSym(CHL.PushStr(strtab, "dlsym"), 0, 0, 12X, 0X, 0X); |
IF so THEN |
item := program.exp_list.first; |
WHILE item # NIL DO |
ASSERT(CHL.GetStr(program.export, item(BIN.EXPRT).nameoffs, Name)); |
CHL.PushInt(hashtab, HashStr(Name)); |
NewSym(CHL.PushStr(strtab, Name), item(BIN.EXPRT).label, 0, 12X, 0X, 0X); |
item := item.next |
END; |
ASSERT(CHL.GetStr(program.data, program.modname, Name)) |
END; |
symCount := LISTS.count(symtab); |
bucket := CHL.CreateIntList(); |
chain := CHL.CreateIntList(); |
FOR i := 1 TO symCount DO |
CHL.PushInt(bucket, 0); |
CHL.PushInt(chain, 0) |
END; |
MakeHash(bucket, chain, symCount); |
NewDyn(DT_NEEDED, CHL.PushStr(strtab, "libdl.so.2")); |
NewDyn(DT_STRTAB, 0); |
NewDyn(DT_STRSZ, CHL.Length(strtab)); |
NewDyn(DT_SYMTAB, 0); |
IF amd64 THEN |
phdr[dyn].p_filesz := 0A0H; |
phdr[dyn].p_memsz := 0A0H |
NewDyn(DT_SYMENT, 24); |
NewDyn(DT_RELA, 0); |
NewDyn(DT_RELASZ, 48); |
NewDyn(DT_RELAENT, 24) |
ELSE |
phdr[dyn].p_filesz := 50H; |
phdr[dyn].p_memsz := 50H |
NewDyn(DT_SYMENT, 16); |
NewDyn(DT_REL, 0); |
NewDyn(DT_RELSZ, 16); |
NewDyn(DT_RELENT, 8) |
END; |
NewDyn(DT_HASH, 0); |
IF so THEN |
NewDyn(DT_SONAME, CHL.PushStr(strtab, Name)); |
NewDyn(DT_INIT, 0); |
NewDyn(DT_FINI, 0) |
END; |
NewDyn(DT_NULL, 0); |
Offset.symtab := LISTS.count(dynamic) * (8 + 8 * ORD(amd64)); |
Offset.reltab := Offset.symtab + symCount * (16 + 8 * ORD(amd64)); |
Offset.hash := Offset.reltab + (8 + 16 * ORD(amd64)) * 2; |
Offset.strtab := Offset.hash + (symCount * 2 + 2) * 4; |
Offset.dyn := phdr[dyn].p_offset; |
item := LISTS.getidx(dynamic, 1); item(Elf32_Dyn).d_val := Offset.strtab + Offset.dyn + BaseAdr; |
item := LISTS.getidx(dynamic, 3); item(Elf32_Dyn).d_val := Offset.symtab + Offset.dyn + BaseAdr; |
item := LISTS.getidx(dynamic, 5); item(Elf32_Dyn).d_val := Offset.reltab + Offset.dyn + BaseAdr; |
item := LISTS.getidx(dynamic, 8); item(Elf32_Dyn).d_val := Offset.hash + Offset.dyn + BaseAdr; |
phdr[dyn].p_filesz := Offset.strtab + CHL.Length(strtab) + 8 + 8 * ORD(amd64); |
phdr[dyn].p_memsz := phdr[dyn].p_filesz; |
phdr[dyn].p_flags := PF_R; |
phdr[dyn].p_align := 1; |
243,20 → 444,15 |
phdr[header].p_type := 1; |
phdr[header].p_offset := offset; |
phdr[header].p_vaddr := LoadAdr; |
phdr[header].p_paddr := LoadAdr; |
IF amd64 THEN |
phdr[header].p_filesz := 305H; |
phdr[header].p_memsz := 305H |
ELSE |
phdr[header].p_filesz := 1D0H; |
phdr[header].p_memsz := 1D0H |
END; |
phdr[header].p_vaddr := BaseAdr; |
phdr[header].p_paddr := BaseAdr; |
phdr[header].p_filesz := 244 + 156 * ORD(amd64) + lenInterpreter + phdr[dyn].p_filesz; |
phdr[header].p_memsz := phdr[header].p_filesz; |
phdr[header].p_flags := PF_R + PF_W; |
phdr[header].p_align := 1000H; |
offset := offset + phdr[header].p_filesz; |
VA := LoadAdr + offset + 1000H; |
VA := BaseAdr + offset + 1000H; |
phdr[text].p_type := 1; |
phdr[text].p_offset := offset; |
270,7 → 466,7 |
ehdr.e_entry := phdr[text].p_vaddr; |
offset := offset + phdr[text].p_filesz; |
VA := LoadAdr + offset + 2000H; |
VA := BaseAdr + offset + 2000H; |
pad := (16 - VA MOD 16) MOD 16; |
phdr[data].p_type := 1; |
283,7 → 479,7 |
phdr[data].p_align := 1000H; |
offset := offset + phdr[data].p_filesz; |
VA := LoadAdr + offset + 3000H; |
VA := BaseAdr + offset + 3000H; |
phdr[bss].p_type := 1; |
phdr[bss].p_offset := offset; |
294,8 → 490,21 |
phdr[bss].p_flags := PF_R + PF_W; |
phdr[bss].p_align := 1000H; |
fixup(program, phdr[text].p_vaddr, phdr[data].p_vaddr + pad, align(phdr[bss].p_vaddr, 16), amd64); |
fixup(program, ehdr.e_entry, phdr[data].p_vaddr + pad, align(phdr[bss].p_vaddr, 16), amd64); |
item := symtab.first; |
WHILE item # NIL DO |
IF item(Elf32_Sym).value # 0 THEN |
INC(item(Elf32_Sym).value, ehdr.e_entry) |
END; |
item := item.next |
END; |
IF so THEN |
item := LISTS.getidx(dynamic, 10); item(Elf32_Dyn).d_val := ehdr.e_entry; |
item := LISTS.getidx(dynamic, 11); item(Elf32_Dyn).d_val := BIN.GetLabel(program, fini) + ehdr.e_entry |
END; |
File := WR.Create(FileName); |
FOR i := 0 TO EI_NIDENT - 1 DO |
340,35 → 549,95 |
WritePH(File, phdr[bss]) |
END; |
FOR i := 0 TO lstr DO |
WR.WriteByte(File, ORD(str[i])) |
FOR i := 0 TO lenInterpreter - 1 DO |
WR.WriteByte(File, ORD(Interpreter[i])) |
END; |
i := 0; |
IF amd64 THEN |
BIN.InitArray(Dyn, i, "01000000000000000E000000000000000500000000000000DC02400000000000"); |
BIN.InitArray(Dyn, i, "0A00000000000000190000000000000006000000000000004C02400000000000"); |
BIN.InitArray(Dyn, i, "0B00000000000000180000000000000007000000000000009402400000000000"); |
BIN.InitArray(Dyn, i, "0800000000000000300000000000000009000000000000001800000000000000"); |
BIN.InitArray(Dyn, i, "0400000000000000C40240000000000000000000000000000000000000000000"); |
BIN.InitArray(Dyn, i, "0000000000000000000000000000000000000000000000000100000012000000"); |
BIN.InitArray(Dyn, i, "0000000000000000000000000000000008000000120000000000000000000000"); |
BIN.InitArray(Dyn, i, "0000000000000000F50240000000000001000000010000000000000000000000"); |
BIN.InitArray(Dyn, i, "FD02400000000000010000000200000000000000000000000100000003000000"); |
BIN.InitArray(Dyn, i, "0000000001000000020000000000000000646C6F70656E00646C73796D006C69"); |
BIN.InitArray(Dyn, i, "62646C2E736F2E320000000000000000000000000000000000") |
item := dynamic.first; |
WHILE item # NIL DO |
WR.Write64LE(File, item(Elf32_Dyn).d_tag); |
WR.Write64LE(File, item(Elf32_Dyn).d_val); |
item := item.next |
END; |
item := symtab.first; |
WHILE item # NIL DO |
WR.Write32LE(File, item(Elf32_Sym).name); |
WR.WriteByte(File, ORD(item(Elf32_Sym).info)); |
WR.WriteByte(File, ORD(item(Elf32_Sym).other)); |
Write16(File, item(Elf32_Sym).shndx); |
WR.Write64LE(File, item(Elf32_Sym).value); |
WR.Write64LE(File, item(Elf32_Sym).size); |
item := item.next |
END; |
WR.Write64LE(File, phdr[dyn].p_filesz + Offset.dyn + BaseAdr - 16); |
WR.Write32LE(File, 1); |
WR.Write32LE(File, 1); |
WR.Write64LE(File, 0); |
WR.Write64LE(File, phdr[dyn].p_filesz + Offset.dyn + BaseAdr - 8); |
WR.Write32LE(File, 1); |
WR.Write32LE(File, 2); |
WR.Write64LE(File, 0); |
WR.Write32LE(File, symCount); |
WR.Write32LE(File, symCount); |
FOR i := 0 TO symCount - 1 DO |
WR.Write32LE(File, CHL.GetInt(bucket, i)) |
END; |
FOR i := 0 TO symCount - 1 DO |
WR.Write32LE(File, CHL.GetInt(chain, i)) |
END; |
CHL.WriteToFile(File, strtab); |
WR.Write64LE(File, 0); |
WR.Write64LE(File, 0) |
ELSE |
BIN.InitArray(Dyn, i, "010000000E00000005000000AF8104080A000000190000000600000057810408"); |
BIN.InitArray(Dyn, i, "0B00000010000000110000008781040812000000100000001300000008000000"); |
BIN.InitArray(Dyn, i, "0400000097810408000000000000000000000000000000000000000000000000"); |
BIN.InitArray(Dyn, i, "0100000000000000000000001200000008000000000000000000000012000000"); |
BIN.InitArray(Dyn, i, "C881040801010000CC8104080102000001000000030000000000000001000000"); |
BIN.InitArray(Dyn, i, "020000000000000000646C6F70656E00646C73796D006C6962646C2E736F2E32"); |
BIN.InitArray(Dyn, i, "000000000000000000") |
item := dynamic.first; |
WHILE item # NIL DO |
WR.Write32LE(File, item(Elf32_Dyn).d_tag); |
WR.Write32LE(File, item(Elf32_Dyn).d_val); |
item := item.next |
END; |
WR.Write(File, Dyn, i); |
item := symtab.first; |
WHILE item # NIL DO |
WR.Write32LE(File, item(Elf32_Sym).name); |
WR.Write32LE(File, item(Elf32_Sym).value); |
WR.Write32LE(File, item(Elf32_Sym).size); |
WR.WriteByte(File, ORD(item(Elf32_Sym).info)); |
WR.WriteByte(File, ORD(item(Elf32_Sym).other)); |
Write16(File, item(Elf32_Sym).shndx); |
item := item.next |
END; |
WR.Write32LE(File, phdr[dyn].p_filesz + Offset.dyn + BaseAdr - 8); |
WR.Write32LE(File, 00000101H); |
WR.Write32LE(File, phdr[dyn].p_filesz + Offset.dyn + BaseAdr - 4); |
WR.Write32LE(File, 00000201H); |
WR.Write32LE(File, symCount); |
WR.Write32LE(File, symCount); |
FOR i := 0 TO symCount - 1 DO |
WR.Write32LE(File, CHL.GetInt(bucket, i)) |
END; |
FOR i := 0 TO symCount - 1 DO |
WR.Write32LE(File, CHL.GetInt(chain, i)) |
END; |
CHL.WriteToFile(File, strtab); |
WR.Write32LE(File, 0); |
WR.Write32LE(File, 0) |
END; |
CHL.WriteToFile(File, program.code); |
WHILE pad > 0 DO |
WR.WriteByte(File, 0); |
/programs/develop/oberon07/Source/ERRORS.ob07 |
---|
7,25 → 7,35 |
MODULE ERRORS; |
IMPORT C := CONSOLE, UTILS; |
IMPORT C := CONSOLE, UTILS, mConst := CONSTANTS; |
PROCEDURE hintmsg* (name: ARRAY OF CHAR; line, col, hint: INTEGER); |
PROCEDURE HintMsg* (name: ARRAY OF CHAR; line, col, hint: INTEGER); |
BEGIN |
IF hint = 0 THEN |
C.String(" hint ("); C.Int(line); C.String(":"); C.Int(col); C.String(")"); |
C.String(" variable '"); C.String(name); C.StringLn("' never used") |
END |
END hintmsg; |
END HintMsg; |
PROCEDURE errormsg* (fname: ARRAY OF CHAR; line, col, errno: INTEGER); |
PROCEDURE WarningMsg* (line, col, warning: INTEGER); |
BEGIN |
C.String(" warning ("); C.Int(line); C.String(":"); C.Int(col); C.String(") "); |
CASE warning OF |
|0: C.StringLn("passing a string value as a fixed array") |
|1: C.StringLn("endless FOR loop") |
END |
END WarningMsg; |
PROCEDURE ErrorMsg* (fname: ARRAY OF CHAR; line, col, errno: INTEGER); |
VAR |
str: ARRAY 80 OF CHAR; |
BEGIN |
C.Ln; |
C.String(" error ("); C.Int(line); C.String(":"); C.Int(col); C.String(") "); |
C.String(" error ("); C.Int(errno); C.String(") ("); C.Int(line); C.String(":"); C.Int(col); C.String(") "); |
CASE errno OF |
| 1: str := "missing 'H' or 'X'" |
36,6 → 46,7 |
| 6: str := "identifier too long" |
| 7: str := "number too long" |
| 8..12: str := "number too large" |
| 13: str := "real numbers not supported" |
| 21: str := "'MODULE' expected" |
| 22: str := "identifier expected" |
79,7 → 90,7 |
| 60: str := "identifier does not match procedure name" |
| 61: str := "illegally marked identifier" |
| 62: str := "expression should be constant" |
| 63: str := "'stdcall', 'ccall', 'ccall16', 'windows' or 'linux' expected" |
| 63: str := "not enough RAM" |
| 64: str := "'(' expected" |
| 65: str := "',' expected" |
| 66: str := "incompatible parameter" |
126,7 → 137,7 |
|107: str := "too large parameter of CHR" |
|108: str := "a variable or a procedure expected" |
|109: str := "expression should be constant" |
|110: str := "'noalign' expected" |
|111: str := "record [noalign] cannot have a base type" |
|112: str := "record [noalign] cannot be a base type" |
|113: str := "result type of procedure should not be REAL" |
133,39 → 144,74 |
|114: str := "identifiers 'lib_init' and 'version' are reserved" |
|115: str := "recursive constant definition" |
|116: str := "procedure too deep nested" |
|117: str := "'stdcall64', 'win64', 'systemv', 'windows' or 'linux' expected" |
|118: str := "this flag for Windows only" |
|119: str := "this flag for Linux only" |
|120: str := "too many formal parameters" |
|122: str := "negative divisor" |
|123: str := "illegal flag" |
|124: str := "unknown flag" |
|125: str := "flag not supported" |
END; |
C.StringLn(str); |
C.String(" file: "); C.StringLn(fname); |
UTILS.Exit(1) |
END errormsg; |
END ErrorMsg; |
PROCEDURE error1* (s1: ARRAY OF CHAR); |
PROCEDURE Error1 (s1: ARRAY OF CHAR); |
BEGIN |
C.Ln; |
C.StringLn(s1); |
UTILS.Exit(1) |
END error1; |
END Error1; |
PROCEDURE error3* (s1, s2, s3: ARRAY OF CHAR); |
PROCEDURE Error3 (s1, s2, s3: ARRAY OF CHAR); |
BEGIN |
C.Ln; |
C.String(s1); C.String(s2); C.StringLn(s3); |
UTILS.Exit(1) |
END error3; |
END Error3; |
PROCEDURE error5* (s1, s2, s3, s4, s5: ARRAY OF CHAR); |
PROCEDURE Error5 (s1, s2, s3, s4, s5: ARRAY OF CHAR); |
BEGIN |
C.Ln; |
C.String(s1); C.String(s2); C.String(s3); C.String(s4); C.StringLn(s5); |
UTILS.Exit(1) |
END error5; |
END Error5; |
PROCEDURE WrongRTL* (ProcName: ARRAY OF CHAR); |
BEGIN |
Error5("procedure ", mConst.RTL_NAME, ".", ProcName, " not found") |
END WrongRTL; |
PROCEDURE BadParam* (param: ARRAY OF CHAR); |
BEGIN |
Error3("bad parameter: ", param, "") |
END BadParam; |
PROCEDURE FileNotFound* (Path, Name, Ext: ARRAY OF CHAR); |
BEGIN |
Error5("file ", Path, Name, Ext, " not found") |
END FileNotFound; |
PROCEDURE Error* (n: INTEGER); |
BEGIN |
CASE n OF |
|201: Error1("writing file error") |
|202: Error1("too many relocations") |
|203: Error1("size of program is too large") |
|204: Error1("size of global variables is too large") |
|205: Error1("not enough parameters") |
|206: Error1("bad parameter <target>") |
|207: Error3('inputfile name extension must be "', mConst.FILE_EXT, '"') |
END |
END Error; |
END ERRORS. |
/programs/develop/oberon07/Source/FILES.ob07 |
---|
1,7 → 1,7 |
(* |
BSD 2-Clause License |
Copyright (c) 2018, Anton Krotov |
Copyright (c) 2018, 2019, Anton Krotov |
All rights reserved. |
*) |
/programs/develop/oberon07/Source/IL.ob07 |
---|
0,0 → 1,1182 |
(* |
BSD 2-Clause License |
Copyright (c) 2018, 2019, Anton Krotov |
All rights reserved. |
*) |
MODULE IL; |
IMPORT LISTS, SCAN, STRINGS, CHL := CHUNKLISTS, C := COLLECTIONS; |
CONST |
little_endian* = 0; |
big_endian* = 1; |
call_stack* = 0; |
call_win64* = 1; |
call_sysv* = 2; |
opJMP* = 0; opLABEL* = 1; opCOPYS* = 2; opGADR* = 3; opCONST* = 4; opLLOAD32* = 5; |
opCOPYA* = 6; opCASET* = 7; opMULC* = 8; opMUL* = 9; opDIV* = 10; opMOD* = 11; |
opDIVL* = 12; opMODL* = 13; opDIVR* = 14; opMODR* = 15; opUMINUS* = 16; |
opADD* = 17; opSUB* = 18; opADDL* = 19; opSUBL* = 20; opADDR* = 21; opSUBR* = 22; |
opSAVE* = 23; opSAVEC* = 24; opSAVE8* = 25; opSAVE8C* = 26; opCHKBYTE* = 27; opDROP* = 28; |
opNOT* = 29; |
opEQ* = 30; opNE* = opEQ + 1; opLT* = opEQ + 2; opLE* = opEQ + 3; opGT* = opEQ + 4; opGE* = opEQ + 5 (* 35 *); |
opEQC* = 36; opNEC* = opEQC + 1; opLTC* = opEQC + 2; opLEC* = opEQC + 3; opGTC* = opEQC + 4; opGEC* = opEQC + 5; (* 41 *) |
opEQF* = 42; opNEF* = opEQF + 1; opLTF* = opEQF + 2; opLEF* = opEQF + 3; opGTF* = opEQF + 4; opGEF* = opEQF + 5; (* 47 *) |
opEQS* = 48; opNES* = opEQS + 1; opLTS* = opEQS + 2; opLES* = opEQS + 3; opGTS* = opEQS + 4; opGES* = opEQS + 5; (* 53 *) |
opEQSW* = 54; opNESW* = opEQSW + 1; opLTSW* = opEQSW + 2; opLESW* = opEQSW + 3; opGTSW* = opEQSW + 4; opGESW* = opEQSW + 5 (* 59 *); |
opVLOAD32* = 60; opGLOAD32* = 61; |
opJNE* = 62; opJE* = 63; |
opSAVE32* = 64; opLLOAD8* = 65; |
opCONSTF* = 66; opLOADF* = 67; opSAVEF* = 68; opMULF* = 69; opDIVF* = 70; opDIVFI* = 71; |
opUMINF* = 72; opADDFI* = 73; opSUBFI* = 74; opADDF* = 75; opSUBF* = 76; |
opACC* = 77; opJG* = 78; |
opINCCB* = 79; opDECCB* = 80; opINCB* = 81; opDECB* = 82; |
opCASEL* = 83; opCASER* = 84; opCASELR* = 85; |
opPOPSP* = 86; |
opWIN64CALL* = 87; opWIN64CALLI* = 88; opWIN64CALLP* = 89; opLOOP* = 90; opENDLOOP* = 91; |
opLOAD8* = 92; opLOAD16* = 93; opLOAD32* = 94; opPRECALL* = 95; opRES* = 96; opRESF* = 97; |
opPUSHC* = 98; opSWITCH* = 99; |
opSBOOL* = 100; opSBOOLC* = 101; opNOP* = 102; |
opMULS* = 103; opMULSC* = 104; opDIVS* = 105; opDIVSC* = 106; |
opADDS* = 107; opSUBS* = 108; opADDSL* = 109; opSUBSL* = 110; opADDSR* = 111; opSUBSR* = 112; |
opUMINS* = 113; opIN* = 114; opINL* = 115; opINR* = 116; |
opRSET* = 117; opRSETL* = 118; opRSETR* = 119; opRSET1* = 120; opLENGTH* = 121; |
opLEAVEC* = 122; opCODE* = 123; opALIGN16* = 124; |
opINCC* = 125; opINC* = 126; opDEC* = 127; |
opINCL* = 128; opEXCL* = 129; opINCLC* = 130; opEXCLC* = 131; opNEW* = 132; opDISP* = 133; |
opPACK* = 134; opPACKC* = 135; opUNPK* = 136; opCOPY* = 137; opENTER* = 138; opLEAVE* = 139; |
opCALL* = 140; opSAVEP* = 141; opCALLP* = 142; opEQP* = 143; opNEP* = 144; opLEAVER* = 145; |
opGET* = 146; opSAVE16* = 147; opABS* = 148; opFABS* = 149; opFLOOR* = 150; opFLT* = 151; |
opODD* = 152; opORD* = 153; opASR* = 154; opLSL* = 155; opROR* = 156; |
opASR1* = 157; opLSL1* = 158; opROR1* = 159; opASR2* = 160; opLSL2* = 161; opROR2* = 162; |
opPUSHP* = 163; opLADR* = 164; opTYPEGP* = 165; opIS* = 166; opPUSHF* = 167; opVADR* = 168; |
opPUSHT* = 169; opTYPEGR* = 170; opISREC* = 171; opCHKIDX* = 172; opPARAM* = 173; |
opCHKIDX2* = 174; opLEN* = 175; opROT* = 176; opSAVES* = 177; opSADR* = 178; opERR* = 179; |
opCHR* = 180; opENDSW* = 181; opLEAVEF* = 182; opCLEANUP* = 183; opMOVE* = 184; |
opLSR* = 185; opLSR1* = 186; opLSR2* = 187; |
opMIN* = 188; opMINC* = 189; opMAX* = 190; opMAXC* = 191; opJNZ* = 192; |
opEQB* = 193; opNEB* = 194; opINF* = 195; opJZ* = 196; opVLOAD8* = 197; opGLOAD8* = 198; |
opLLOAD16* = 199; opVLOAD16* = 200; opGLOAD16* = 201; |
opLOAD64* = 202; opLLOAD64* = 203; opVLOAD64* = 204; opGLOAD64* = 205; opSAVE64* = 206; |
opTYPEGD* = 207; opCALLI* = 208; opPUSHIP* = 209; opSAVEIP* = 210; opEQIP* = 211; opNEIP* = 212; |
opSAVE16C* = 213; opWCHR* = 214; opGETC* = 215; opLENGTHW* = 216; |
opSYSVCALL* = 217; opSYSVCALLI* = 218; opSYSVCALLP* = 219; opSYSVALIGN16* = 220; opWIN64ALIGN16* = 221; |
opSADR_PARAM* = -1; opLOAD64_PARAM* = -2; opLLOAD64_PARAM* = -3; opGLOAD64_PARAM* = -4; |
opVADR_PARAM* = -5; opCONST_PARAM* = -6; opGLOAD32_PARAM* = -7; opLLOAD32_PARAM* = -8; |
opLOAD32_PARAM* = -9; |
opLADR_SAVEC* = -10; opGADR_SAVEC* = -11; opLADR_SAVE* = -12; |
opLADR_INCC* = -13; opLADR_INCCB* = -14; opLADR_DECCB* = -15; |
opLADR_INC* = -16; opLADR_DEC* = -17; opLADR_INCB* = -18; opLADR_DECB* = -19; |
opLADR_INCL* = -20; opLADR_EXCL* = -21; opLADR_INCLC* = -22; opLADR_EXCLC* = -23; |
opLADR_UNPK* = -24; |
_move *= 0; |
_move2 *= 1; |
_strcmpw *= 2; |
_exit *= 3; |
_set *= 4; |
_set2 *= 5; |
_lengthw *= 6; |
_strcpy *= 7; |
_div *= 8; |
_mod *= 9; |
_div2 *= 10; |
_mod2 *= 11; |
_arrcpy *= 12; |
_rot *= 13; |
_new *= 14; |
_dispose *= 15; |
_strcmp *= 16; |
_error *= 17; |
_is *= 18; |
_isrec *= 19; |
_guard *= 20; |
_guardrec *= 21; |
_length *= 22; |
_init *= 23; |
_dllentry *= 24; |
_sofinit *= 25; |
TYPE |
LOCALVAR* = POINTER TO RECORD (LISTS.ITEM) |
offset*, size*, count*: INTEGER |
END; |
COMMAND* = POINTER TO RECORD (LISTS.ITEM) |
opcode*: INTEGER; |
param1*: INTEGER; |
param2*: INTEGER; |
param3*: INTEGER; |
float*: REAL; |
variables*: LISTS.LIST; |
allocReg*: BOOLEAN |
END; |
CMDSTACK = POINTER TO RECORD |
data: ARRAY 1000 OF COMMAND; |
top: INTEGER |
END; |
EXPORT_PROC* = POINTER TO RECORD (LISTS.ITEM) |
label*: INTEGER; |
name*: SCAN.LEXSTR |
END; |
IMPORT_LIB* = POINTER TO RECORD (LISTS.ITEM) |
name*: SCAN.LEXSTR; |
procs*: LISTS.LIST |
END; |
IMPORT_PROC* = POINTER TO RECORD (LISTS.ITEM) |
label*: INTEGER; |
lib*: IMPORT_LIB; |
name*: SCAN.LEXSTR; |
count: INTEGER |
END; |
CODES* = POINTER TO RECORD |
last: COMMAND; |
begcall: CMDSTACK; |
endcall: CMDSTACK; |
commands*: LISTS.LIST; |
export*: LISTS.LIST; |
import*: LISTS.LIST; |
types*: CHL.INTLIST; |
data*: CHL.BYTELIST; |
dmin*: INTEGER; |
lcount*: INTEGER; |
bss*: INTEGER; |
rtl*: ARRAY 26 OF INTEGER; |
errlabels*: ARRAY 12 OF INTEGER; |
charoffs: ARRAY 256 OF INTEGER; |
wcharoffs: ARRAY 65536 OF INTEGER; |
fregs: INTEGER; |
wstr: ARRAY 4*1024 OF WCHAR |
END; |
VAR |
codes*: CODES; |
endianness: INTEGER; |
numRegsFloat: INTEGER; |
commands, variables: C.COLLECTION; |
PROCEDURE NewCmd (): COMMAND; |
VAR |
cmd: COMMAND; |
citem: C.ITEM; |
BEGIN |
citem := C.pop(commands); |
IF citem = NIL THEN |
NEW(cmd) |
ELSE |
cmd := citem(COMMAND) |
END; |
cmd.allocReg := FALSE |
RETURN cmd |
END NewCmd; |
PROCEDURE NewVar* (): LOCALVAR; |
VAR |
lvar: LOCALVAR; |
citem: C.ITEM; |
BEGIN |
citem := C.pop(variables); |
IF citem = NIL THEN |
NEW(lvar) |
ELSE |
lvar := citem(LOCALVAR) |
END; |
lvar.count := 0 |
RETURN lvar |
END NewVar; |
PROCEDURE setlast* (cmd: COMMAND); |
BEGIN |
codes.last := cmd |
END setlast; |
PROCEDURE getlast* (): COMMAND; |
RETURN codes.last |
END getlast; |
PROCEDURE PutByte (codes: CODES; b: BYTE); |
BEGIN |
CHL.PushByte(codes.data, b) |
END PutByte; |
PROCEDURE putstr* (s: ARRAY OF CHAR): INTEGER; |
VAR |
i, n, res: INTEGER; |
BEGIN |
res := CHL.Length(codes.data); |
i := 0; |
n := LENGTH(s); |
WHILE i < n DO |
PutByte(codes, ORD(s[i])); |
INC(i) |
END; |
PutByte(codes, 0) |
RETURN res |
END putstr; |
PROCEDURE putstr1* (c: INTEGER): INTEGER; |
VAR |
res: INTEGER; |
BEGIN |
IF codes.charoffs[c] = -1 THEN |
res := CHL.Length(codes.data); |
PutByte(codes, c); |
PutByte(codes, 0); |
codes.charoffs[c] := res |
ELSE |
res := codes.charoffs[c] |
END |
RETURN res |
END putstr1; |
PROCEDURE putstrW* (s: ARRAY OF CHAR): INTEGER; |
VAR |
i, n, res: INTEGER; |
BEGIN |
res := CHL.Length(codes.data); |
IF ODD(res) THEN |
PutByte(codes, 0); |
INC(res) |
END; |
n := STRINGS.Utf8To16(s, codes.wstr); |
i := 0; |
WHILE i < n DO |
IF endianness = little_endian THEN |
PutByte(codes, ORD(codes.wstr[i]) MOD 256); |
PutByte(codes, ORD(codes.wstr[i]) DIV 256) |
ELSIF endianness = big_endian THEN |
PutByte(codes, ORD(codes.wstr[i]) DIV 256); |
PutByte(codes, ORD(codes.wstr[i]) MOD 256) |
END; |
INC(i) |
END; |
PutByte(codes, 0); |
PutByte(codes, 0) |
RETURN res |
END putstrW; |
PROCEDURE putstrW1* (c: INTEGER): INTEGER; |
VAR |
res: INTEGER; |
BEGIN |
IF codes.wcharoffs[c] = -1 THEN |
res := CHL.Length(codes.data); |
IF ODD(res) THEN |
PutByte(codes, 0); |
INC(res) |
END; |
IF endianness = little_endian THEN |
PutByte(codes, c MOD 256); |
PutByte(codes, c DIV 256) |
ELSIF endianness = big_endian THEN |
PutByte(codes, c DIV 256); |
PutByte(codes, c MOD 256) |
END; |
PutByte(codes, 0); |
PutByte(codes, 0); |
codes.wcharoffs[c] := res |
ELSE |
res := codes.wcharoffs[c] |
END |
RETURN res |
END putstrW1; |
PROCEDURE push (stk: CMDSTACK; cmd: COMMAND); |
BEGIN |
INC(stk.top); |
stk.data[stk.top] := cmd |
END push; |
PROCEDURE pop (stk: CMDSTACK): COMMAND; |
VAR |
res: COMMAND; |
BEGIN |
res := stk.data[stk.top]; |
DEC(stk.top) |
RETURN res |
END pop; |
PROCEDURE pushBegEnd* (VAR beg, end: COMMAND); |
BEGIN |
push(codes.begcall, beg); |
push(codes.endcall, end); |
beg := codes.last; |
end := beg.next(COMMAND) |
END pushBegEnd; |
PROCEDURE popBegEnd* (VAR beg, end: COMMAND); |
BEGIN |
beg := pop(codes.begcall); |
end := pop(codes.endcall) |
END popBegEnd; |
PROCEDURE AddRec* (base: INTEGER); |
BEGIN |
CHL.PushInt(codes.types, base) |
END AddRec; |
PROCEDURE insert (cur, nov: COMMAND); |
VAR |
old_opcode, param2: INTEGER; |
PROCEDURE set (cur: COMMAND; opcode, param2: INTEGER); |
BEGIN |
cur.opcode := opcode; |
cur.param1 := cur.param2; |
cur.param2 := param2 |
END set; |
BEGIN |
old_opcode := cur.opcode; |
param2 := nov.param2; |
IF (nov.opcode = opPARAM) & (param2 = 1) THEN |
CASE old_opcode OF |
|opGLOAD64: cur.opcode := opGLOAD64_PARAM |
|opLLOAD64: cur.opcode := opLLOAD64_PARAM |
|opLOAD64: cur.opcode := opLOAD64_PARAM |
|opGLOAD32: cur.opcode := opGLOAD32_PARAM |
|opLLOAD32: cur.opcode := opLLOAD32_PARAM |
|opLOAD32: cur.opcode := opLOAD32_PARAM |
|opSADR: cur.opcode := opSADR_PARAM |
|opVADR: cur.opcode := opVADR_PARAM |
|opCONST: cur.opcode := opCONST_PARAM |
ELSE |
old_opcode := -1 |
END |
ELSIF old_opcode = opLADR THEN |
CASE nov.opcode OF |
|opSAVEC: set(cur, opLADR_SAVEC, param2) |
|opSAVE: cur.opcode := opLADR_SAVE |
|opINC: cur.opcode := opLADR_INC |
|opDEC: cur.opcode := opLADR_DEC |
|opINCB: cur.opcode := opLADR_INCB |
|opDECB: cur.opcode := opLADR_DECB |
|opINCL: cur.opcode := opLADR_INCL |
|opEXCL: cur.opcode := opLADR_EXCL |
|opUNPK: cur.opcode := opLADR_UNPK |
|opINCC: set(cur, opLADR_INCC, param2) |
|opINCCB: set(cur, opLADR_INCCB, param2) |
|opDECCB: set(cur, opLADR_DECCB, param2) |
|opINCLC: set(cur, opLADR_INCLC, param2) |
|opEXCLC: set(cur, opLADR_EXCLC, param2) |
ELSE |
old_opcode := -1 |
END |
ELSIF (nov.opcode = opSAVEC) & (old_opcode = opGADR) THEN |
set(cur, opGADR_SAVEC, param2) |
ELSIF (nov.opcode = opMULC) & (old_opcode = opMULC) THEN |
cur.param2 := param2 * cur.param2 |
ELSE |
old_opcode := -1 |
END; |
IF old_opcode = -1 THEN |
LISTS.insert(codes.commands, cur, nov); |
codes.last := nov |
ELSE |
C.push(commands, nov); |
codes.last := cur |
END |
END insert; |
PROCEDURE AddCmd* (opcode: INTEGER; param: INTEGER); |
VAR |
cmd: COMMAND; |
BEGIN |
cmd := NewCmd(); |
cmd.opcode := opcode; |
cmd.param1 := 0; |
cmd.param2 := param; |
insert(codes.last, cmd) |
END AddCmd; |
PROCEDURE AddCmd2* (opcode: INTEGER; param1, param2: INTEGER); |
VAR |
cmd: COMMAND; |
BEGIN |
cmd := NewCmd(); |
cmd.opcode := opcode; |
cmd.param1 := param1; |
cmd.param2 := param2; |
insert(codes.last, cmd) |
END AddCmd2; |
PROCEDURE Const* (val: INTEGER); |
BEGIN |
AddCmd(opCONST, val) |
END Const; |
PROCEDURE StrAdr* (adr: INTEGER); |
BEGIN |
AddCmd(opSADR, adr) |
END StrAdr; |
PROCEDURE Param1*; |
BEGIN |
AddCmd(opPARAM, 1) |
END Param1; |
PROCEDURE NewLabel* (): INTEGER; |
BEGIN |
INC(codes.lcount) |
RETURN codes.lcount - 1 |
END NewLabel; |
PROCEDURE SetLabel* (label: INTEGER); |
BEGIN |
AddCmd2(opLABEL, label, 0) |
END SetLabel; |
PROCEDURE SetErrLabel* (errno: INTEGER); |
BEGIN |
codes.errlabels[errno] := NewLabel(); |
SetLabel(codes.errlabels[errno]) |
END SetErrLabel; |
PROCEDURE AddCmd0* (opcode: INTEGER); |
BEGIN |
AddCmd(opcode, 0) |
END AddCmd0; |
PROCEDURE deleteVarList (list: LISTS.LIST); |
VAR |
last: LISTS.ITEM; |
BEGIN |
WHILE list.last # NIL DO |
last := LISTS.pop(list); |
C.push(variables, last) |
END |
END deleteVarList; |
PROCEDURE delete (cmd: COMMAND); |
BEGIN |
IF cmd.variables # NIL THEN |
deleteVarList(cmd.variables) |
END; |
LISTS.delete(codes.commands, cmd); |
C.push(commands, cmd) |
END delete; |
PROCEDURE delete2* (first, last: LISTS.ITEM); |
VAR |
cur, next: LISTS.ITEM; |
BEGIN |
cur := first; |
IF first # last THEN |
REPEAT |
next := cur.next; |
LISTS.delete(codes.commands, cur); |
C.push(commands, cur); |
cur := next |
UNTIL cur = last |
END; |
LISTS.delete(codes.commands, cur); |
C.push(commands, cur) |
END delete2; |
PROCEDURE AddJmpCmd* (opcode: INTEGER; label: INTEGER); |
VAR |
prev: COMMAND; |
not: BOOLEAN; |
BEGIN |
prev := codes.last; |
not := prev.opcode = opNOT; |
IF not THEN |
IF opcode = opJE THEN |
opcode := opJNE |
ELSIF opcode = opJNE THEN |
opcode := opJE |
ELSE |
not := FALSE |
END |
END; |
AddCmd2(opcode, label, label); |
IF not THEN |
delete(prev) |
END |
END AddJmpCmd; |
PROCEDURE OnError* (line, error: INTEGER); |
BEGIN |
AddCmd(opPUSHC, line); |
AddJmpCmd(opJMP, codes.errlabels[error]) |
END OnError; |
PROCEDURE TypeGuard* (op, t: INTEGER; line, error: INTEGER); |
VAR |
label: INTEGER; |
BEGIN |
AddCmd(op, t); |
label := NewLabel(); |
AddJmpCmd(opJE, label); |
OnError(line, error); |
SetLabel(label) |
END TypeGuard; |
PROCEDURE TypeCheck* (t: INTEGER); |
BEGIN |
AddCmd(opIS, t) |
END TypeCheck; |
PROCEDURE TypeCheckRec* (t: INTEGER); |
BEGIN |
AddCmd(opISREC, t) |
END TypeCheckRec; |
PROCEDURE New* (size, typenum: INTEGER); |
BEGIN |
AddCmd2(opNEW, typenum, size) |
END New; |
PROCEDURE fcmp* (opcode: INTEGER); |
BEGIN |
AddCmd(opcode, 0); |
DEC(codes.fregs, 2); |
ASSERT(codes.fregs >= 0) |
END fcmp; |
PROCEDURE not*; |
VAR |
prev: COMMAND; |
BEGIN |
prev := codes.last; |
IF prev.opcode = opNOT THEN |
codes.last := prev.prev(COMMAND); |
delete(prev) |
ELSE |
AddCmd0(opNOT) |
END |
END not; |
PROCEDURE Enter* (label, params: INTEGER): COMMAND; |
VAR |
cmd: COMMAND; |
BEGIN |
cmd := NewCmd(); |
cmd.opcode := opENTER; |
cmd.param1 := label; |
cmd.param3 := params; |
cmd.allocReg := TRUE; |
insert(codes.last, cmd) |
RETURN codes.last |
END Enter; |
PROCEDURE Leave* (result, float: BOOLEAN; locsize, paramsize: INTEGER): COMMAND; |
BEGIN |
IF result THEN |
IF float THEN |
AddCmd2(opLEAVEF, locsize, paramsize) |
ELSE |
AddCmd2(opLEAVER, locsize, paramsize) |
END |
ELSE |
AddCmd2(opLEAVE, locsize, paramsize) |
END |
RETURN codes.last |
END Leave; |
PROCEDURE EnterC* (label: INTEGER): COMMAND; |
BEGIN |
SetLabel(label) |
RETURN codes.last |
END EnterC; |
PROCEDURE LeaveC* (): COMMAND; |
BEGIN |
AddCmd0(opLEAVEC) |
RETURN codes.last |
END LeaveC; |
PROCEDURE Call* (proc, callconv, fparams: INTEGER); |
BEGIN |
CASE callconv OF |
|call_stack: AddJmpCmd(opCALL, proc) |
|call_win64: AddJmpCmd(opWIN64CALL, proc) |
|call_sysv: AddJmpCmd(opSYSVCALL, proc) |
END; |
codes.last(COMMAND).param2 := fparams |
END Call; |
PROCEDURE CallImp* (proc: LISTS.ITEM; callconv, fparams: INTEGER); |
BEGIN |
CASE callconv OF |
|call_stack: AddJmpCmd(opCALLI, proc(IMPORT_PROC).label) |
|call_win64: AddJmpCmd(opWIN64CALLI, proc(IMPORT_PROC).label) |
|call_sysv: AddJmpCmd(opSYSVCALLI, proc(IMPORT_PROC).label) |
END; |
codes.last(COMMAND).param2 := fparams |
END CallImp; |
PROCEDURE CallP* (callconv, fparams: INTEGER); |
BEGIN |
CASE callconv OF |
|call_stack: AddCmd0(opCALLP) |
|call_win64: AddCmd(opWIN64CALLP, fparams) |
|call_sysv: AddCmd(opSYSVCALLP, fparams) |
END |
END CallP; |
PROCEDURE AssignProc* (proc: INTEGER); |
BEGIN |
AddJmpCmd(opSAVEP, proc) |
END AssignProc; |
PROCEDURE AssignImpProc* (proc: LISTS.ITEM); |
BEGIN |
AddJmpCmd(opSAVEIP, proc(IMPORT_PROC).label) |
END AssignImpProc; |
PROCEDURE PushProc* (proc: INTEGER); |
BEGIN |
AddJmpCmd(opPUSHP, proc) |
END PushProc; |
PROCEDURE PushImpProc* (proc: LISTS.ITEM); |
BEGIN |
AddJmpCmd(opPUSHIP, proc(IMPORT_PROC).label) |
END PushImpProc; |
PROCEDURE ProcCmp* (proc: INTEGER; eq: BOOLEAN); |
BEGIN |
IF eq THEN |
AddJmpCmd(opEQP, proc) |
ELSE |
AddJmpCmd(opNEP, proc) |
END |
END ProcCmp; |
PROCEDURE ProcImpCmp* (proc: LISTS.ITEM; eq: BOOLEAN); |
BEGIN |
IF eq THEN |
AddJmpCmd(opEQIP, proc(IMPORT_PROC).label) |
ELSE |
AddJmpCmd(opNEIP, proc(IMPORT_PROC).label) |
END |
END ProcImpCmp; |
PROCEDURE load* (size: INTEGER); |
VAR |
last: COMMAND; |
BEGIN |
last := codes.last; |
CASE size OF |
|1: |
IF last.opcode = opLADR THEN |
last.opcode := opLLOAD8 |
ELSIF last.opcode = opVADR THEN |
last.opcode := opVLOAD8 |
ELSIF last.opcode = opGADR THEN |
last.opcode := opGLOAD8 |
ELSE |
AddCmd0(opLOAD8) |
END |
|2: |
IF last.opcode = opLADR THEN |
last.opcode := opLLOAD16 |
ELSIF last.opcode = opVADR THEN |
last.opcode := opVLOAD16 |
ELSIF last.opcode = opGADR THEN |
last.opcode := opGLOAD16 |
ELSE |
AddCmd0(opLOAD16) |
END |
|4: |
IF last.opcode = opLADR THEN |
last.opcode := opLLOAD32 |
ELSIF last.opcode = opVADR THEN |
last.opcode := opVLOAD32 |
ELSIF last.opcode = opGADR THEN |
last.opcode := opGLOAD32 |
ELSE |
AddCmd0(opLOAD32) |
END |
|8: |
IF last.opcode = opLADR THEN |
last.opcode := opLLOAD64 |
ELSIF last.opcode = opVADR THEN |
last.opcode := opVLOAD64 |
ELSIF last.opcode = opGADR THEN |
last.opcode := opGLOAD64 |
ELSE |
AddCmd0(opLOAD64) |
END |
END |
END load; |
PROCEDURE SysPut* (size: INTEGER); |
BEGIN |
CASE size OF |
|1: AddCmd0(opSAVE8) |
|2: AddCmd0(opSAVE16) |
|4: AddCmd0(opSAVE32) |
|8: AddCmd0(opSAVE64) |
END |
END SysPut; |
PROCEDURE savef*; |
BEGIN |
AddCmd0(opSAVEF); |
DEC(codes.fregs); |
ASSERT(codes.fregs >= 0) |
END savef; |
PROCEDURE pushf*; |
BEGIN |
AddCmd0(opPUSHF); |
DEC(codes.fregs); |
ASSERT(codes.fregs >= 0) |
END pushf; |
PROCEDURE loadf* (): BOOLEAN; |
BEGIN |
AddCmd0(opLOADF); |
INC(codes.fregs) |
RETURN codes.fregs < numRegsFloat |
END loadf; |
PROCEDURE inf* (): BOOLEAN; |
BEGIN |
AddCmd0(opINF); |
INC(codes.fregs) |
RETURN codes.fregs < numRegsFloat |
END inf; |
PROCEDURE fbinop* (opcode: INTEGER); |
BEGIN |
AddCmd0(opcode); |
DEC(codes.fregs); |
ASSERT(codes.fregs > 0) |
END fbinop; |
PROCEDURE saves* (offset, length: INTEGER); |
BEGIN |
AddCmd2(opSAVES, length, offset) |
END saves; |
PROCEDURE abs* (real: BOOLEAN); |
BEGIN |
IF real THEN |
AddCmd0(opFABS) |
ELSE |
AddCmd0(opABS) |
END |
END abs; |
PROCEDURE floor*; |
BEGIN |
AddCmd0(opFLOOR); |
DEC(codes.fregs); |
ASSERT(codes.fregs >= 0) |
END floor; |
PROCEDURE flt* (): BOOLEAN; |
BEGIN |
AddCmd0(opFLT); |
INC(codes.fregs) |
RETURN codes.fregs < numRegsFloat |
END flt; |
PROCEDURE odd*; |
BEGIN |
AddCmd0(opODD) |
END odd; |
PROCEDURE ord*; |
BEGIN |
AddCmd0(opORD) |
END ord; |
PROCEDURE shift_minmax* (op: CHAR); |
BEGIN |
CASE op OF |
|"A": AddCmd0(opASR) |
|"L": AddCmd0(opLSL) |
|"O": AddCmd0(opROR) |
|"R": AddCmd0(opLSR) |
|"m": AddCmd0(opMIN) |
|"x": AddCmd0(opMAX) |
END |
END shift_minmax; |
PROCEDURE shift_minmax1* (op: CHAR; x: INTEGER); |
BEGIN |
CASE op OF |
|"A": AddCmd(opASR1, x) |
|"L": AddCmd(opLSL1, x) |
|"O": AddCmd(opROR1, x) |
|"R": AddCmd(opLSR1, x) |
|"m": AddCmd(opMINC, x) |
|"x": AddCmd(opMAXC, x) |
END |
END shift_minmax1; |
PROCEDURE shift_minmax2* (op: CHAR; x: INTEGER); |
BEGIN |
CASE op OF |
|"A": AddCmd(opASR2, x) |
|"L": AddCmd(opLSL2, x) |
|"O": AddCmd(opROR2, x) |
|"R": AddCmd(opLSR2, x) |
|"m": AddCmd(opMINC, x) |
|"x": AddCmd(opMAXC, x) |
END |
END shift_minmax2; |
PROCEDURE len* (dim: INTEGER); |
BEGIN |
AddCmd(opLEN, dim) |
END len; |
PROCEDURE Float* (r: REAL); |
VAR |
cmd: COMMAND; |
BEGIN |
cmd := NewCmd(); |
cmd.opcode := opCONSTF; |
cmd.float := r; |
insert(codes.last, cmd); |
INC(codes.fregs); |
ASSERT(codes.fregs <= numRegsFloat) |
END Float; |
PROCEDURE precall* (flt: BOOLEAN): INTEGER; |
VAR |
res: INTEGER; |
BEGIN |
res := codes.fregs; |
AddCmd2(opPRECALL, ORD(flt), res); |
codes.fregs := 0 |
RETURN res |
END precall; |
PROCEDURE resf* (fregs: INTEGER): BOOLEAN; |
BEGIN |
AddCmd(opRESF, fregs); |
codes.fregs := fregs + 1 |
RETURN codes.fregs < numRegsFloat |
END resf; |
PROCEDURE res* (fregs: INTEGER); |
BEGIN |
AddCmd(opRES, fregs); |
codes.fregs := fregs |
END res; |
PROCEDURE retf*; |
BEGIN |
DEC(codes.fregs); |
ASSERT(codes.fregs = 0) |
END retf; |
PROCEDURE drop*; |
BEGIN |
AddCmd0(opDROP) |
END drop; |
PROCEDURE case* (a, b, L, R: INTEGER); |
VAR |
cmd: COMMAND; |
BEGIN |
IF a = b THEN |
cmd := NewCmd(); |
cmd.opcode := opCASELR; |
cmd.param1 := a; |
cmd.param2 := L; |
cmd.param3 := R; |
insert(codes.last, cmd) |
ELSE |
AddCmd2(opCASEL, a, L); |
AddCmd2(opCASER, b, R) |
END |
END case; |
PROCEDURE caset* (a, label: INTEGER); |
BEGIN |
AddCmd2(opCASET, label, a) |
END caset; |
PROCEDURE AddExp* (label: INTEGER; name: SCAN.LEXSTR); |
VAR |
exp: EXPORT_PROC; |
BEGIN |
NEW(exp); |
exp.label := label; |
exp.name := name; |
LISTS.push(codes.export, exp) |
END AddExp; |
PROCEDURE AddImp* (dll, proc: SCAN.LEXSTR): IMPORT_PROC; |
VAR |
lib: IMPORT_LIB; |
p: IMPORT_PROC; |
BEGIN |
lib := codes.import.first(IMPORT_LIB); |
WHILE (lib # NIL) & (lib.name # dll) DO |
lib := lib.next(IMPORT_LIB) |
END; |
IF lib = NIL THEN |
NEW(lib); |
lib.name := dll; |
lib.procs := LISTS.create(NIL); |
LISTS.push(codes.import, lib) |
END; |
p := lib.procs.first(IMPORT_PROC); |
WHILE (p # NIL) & (p.name # proc) DO |
p := p.next(IMPORT_PROC) |
END; |
IF p = NIL THEN |
NEW(p); |
p.name := proc; |
p.label := NewLabel(); |
p.lib := lib; |
p.count := 1; |
LISTS.push(lib.procs, p) |
ELSE |
INC(p.count) |
END |
RETURN p |
END AddImp; |
PROCEDURE DelImport* (imp: LISTS.ITEM); |
VAR |
lib: IMPORT_LIB; |
BEGIN |
DEC(imp(IMPORT_PROC).count); |
IF imp(IMPORT_PROC).count = 0 THEN |
lib := imp(IMPORT_PROC).lib; |
LISTS.delete(lib.procs, imp); |
IF lib.procs.first = NIL THEN |
LISTS.delete(codes.import, lib) |
END |
END |
END DelImport; |
PROCEDURE init* (pNumRegsFloat, pEndianness: INTEGER); |
VAR |
cmd: COMMAND; |
i: INTEGER; |
BEGIN |
commands := C.create(); |
variables := C.create(); |
numRegsFloat := pNumRegsFloat; |
endianness := pEndianness; |
NEW(codes); |
NEW(codes.begcall); |
codes.begcall.top := -1; |
NEW(codes.endcall); |
codes.endcall.top := -1; |
codes.commands := LISTS.create(NIL); |
codes.export := LISTS.create(NIL); |
codes.import := LISTS.create(NIL); |
codes.types := CHL.CreateIntList(); |
codes.data := CHL.CreateByteList(); |
NEW(cmd); cmd.opcode := opNOP; LISTS.push(codes.commands, cmd); |
codes.last := cmd; |
NEW(cmd); cmd.opcode := opNOP; LISTS.push(codes.commands, cmd); |
AddRec(0); |
codes.lcount := 0; |
codes.fregs := 0; |
FOR i := 0 TO LEN(codes.charoffs) - 1 DO |
codes.charoffs[i] := -1 |
END; |
FOR i := 0 TO LEN(codes.wcharoffs) - 1 DO |
codes.wcharoffs[i] := -1 |
END |
END init; |
END IL. |
/programs/develop/oberon07/Source/KOS.ob07 |
---|
1,7 → 1,7 |
(* |
BSD 2-Clause License |
Copyright (c) 2018, Anton Krotov |
Copyright (c) 2018, 2019, Anton Krotov |
All rights reserved. |
*) |
/programs/develop/oberon07/Source/LISTS.ob07 |
---|
1,7 → 1,7 |
(* |
BSD 2-Clause License |
Copyright (c) 2018, Anton Krotov |
Copyright (c) 2018, 2019, Anton Krotov |
All rights reserved. |
*) |
168,6 → 168,24 |
END count; |
PROCEDURE getidx* (list: LIST; idx: INTEGER): ITEM; |
VAR |
item: ITEM; |
BEGIN |
ASSERT(list # NIL); |
ASSERT(idx >= 0); |
item := list.first; |
WHILE (item # NIL) & (idx > 0) DO |
item := item.next; |
DEC(idx) |
END |
RETURN item |
END getidx; |
PROCEDURE create* (list: LIST): LIST; |
BEGIN |
IF list = NIL THEN |
/programs/develop/oberon07/Source/MSCOFF.ob07 |
---|
1,7 → 1,7 |
(* |
BSD 2-Clause License |
Copyright (c) 2018, Anton Krotov |
Copyright (c) 2018, 2019, Anton Krotov |
All rights reserved. |
*) |
136,7 → 136,7 |
PROCEDURE SetNumberOfRelocations (VAR section: SH; NumberOfRelocations: INTEGER); |
BEGIN |
IF NumberOfRelocations >= 65536 THEN |
ERRORS.error1("too many relocations") |
ERRORS.Error(202) |
END; |
section.NumberOfRelocations := WCHR(NumberOfRelocations) |
END SetNumberOfRelocations; |
/programs/develop/oberon07/Source/MSP430.ob07 |
---|
0,0 → 1,1793 |
(* |
BSD 2-Clause License |
Copyright (c) 2019, Anton Krotov |
All rights reserved. |
*) |
MODULE MSP430; |
IMPORT IL, LISTS, REG, CHL := CHUNKLISTS, ERRORS, FILES, WRITER, |
UTILS, C := CONSOLE, PROG, RTL := MSP430RTL; |
CONST |
minRAM* = 128; maxRAM* = 10240; |
minROM* = 2048; maxROM* = 49152; |
minStackSize = 64; |
IntVectorSize* = RTL.IntVectorSize; |
PC = 0; SP = 1; SR = 2; CG = 3; |
R4 = 4; R5 = 5; R6 = 6; R7 = 7; |
IR = 13; HP = 14; BP = 15; |
ACC = R4; |
opRRC = 1000H; opSWPB = 1080H; opRRA = 1100H; opSXT = 1180H; |
opPUSH = 1200H; opCALL = 1280H; opRETI = 1300H; |
opMOV = 04000H; opADD = 05000H; opADDC = 06000H; opSUBC = 07000H; |
opSUB = 08000H; opCMP = 09000H; opDADD = 0A000H; opBIT = 0B000H; |
opBIC = 0C000H; opBIS = 0D000H; opXOR = 0E000H; opAND = 0F000H; |
opJNE = 2000H; opJEQ = 2400H; opJNC = 2800H; opJC = 2C00H; |
opJN = 3000H; opJGE = 3400H; opJL = 3800H; opJMP = 3C00H; |
sREG = 0; sIDX = 16; sINDIR = 32; sINCR = 48; BW = 64; dIDX = 128; |
NOWORD = 10000H; |
RCODE = 0; RDATA = 1; RBSS = 2; |
je = 0; jne = je + 1; |
jge = 2; jl = jge + 1; |
jle = 4; jg = jle + 1; |
jb = 6; |
TYPE |
ANYCODE = POINTER TO RECORD (LISTS.ITEM) |
offset: INTEGER |
END; |
WORD = POINTER TO RECORD (ANYCODE) |
val: INTEGER |
END; |
LABEL = POINTER TO RECORD (ANYCODE) |
num: INTEGER |
END; |
JMP = POINTER TO RECORD (ANYCODE) |
cc, label: INTEGER; |
short: BOOLEAN |
END; |
CALL = POINTER TO RECORD (ANYCODE) |
label: INTEGER |
END; |
COMMAND = IL.COMMAND; |
RELOC = POINTER TO RECORD (LISTS.ITEM) |
section: INTEGER; |
WordPtr: WORD |
END; |
VAR |
R: REG.REGS; |
CodeList: LISTS.LIST; |
RelList: LISTS.LIST; |
mem: ARRAY 65536 OF BYTE; |
Labels: CHL.INTLIST; |
IV: ARRAY RTL.LenIV OF INTEGER; |
IdxWords: RECORD src, dst: INTEGER END; |
PROCEDURE EmitLabel (L: INTEGER); |
VAR |
label: LABEL; |
BEGIN |
NEW(label); |
label.num := L; |
LISTS.push(CodeList, label) |
END EmitLabel; |
PROCEDURE EmitWord (val: INTEGER); |
VAR |
word: WORD; |
BEGIN |
IF val < 0 THEN |
ASSERT(val >= -32768); |
val := val MOD 65536 |
ELSE |
ASSERT(val <= 65535) |
END; |
NEW(word); |
word.val := val; |
LISTS.push(CodeList, word) |
END EmitWord; |
PROCEDURE EmitJmp (cc, label: INTEGER); |
VAR |
jmp: JMP; |
BEGIN |
NEW(jmp); |
jmp.cc := cc; |
jmp.label := label; |
jmp.short := FALSE; |
LISTS.push(CodeList, jmp) |
END EmitJmp; |
PROCEDURE EmitCall (label: INTEGER); |
VAR |
call: CALL; |
BEGIN |
NEW(call); |
call.label := label; |
LISTS.push(CodeList, call) |
END EmitCall; |
PROCEDURE bw (b: BOOLEAN): INTEGER; |
RETURN BW * ORD(b) |
END bw; |
PROCEDURE src_x (x, Rn: INTEGER): INTEGER; |
BEGIN |
IdxWords.src := x |
RETURN Rn * 256 + sIDX |
END src_x; |
PROCEDURE dst_x (x, Rn: INTEGER): INTEGER; |
BEGIN |
IdxWords.dst := x |
RETURN Rn + dIDX |
END dst_x; |
PROCEDURE indir (Rn: INTEGER): INTEGER; |
RETURN Rn * 256 + sINDIR |
END indir; |
PROCEDURE incr (Rn: INTEGER): INTEGER; |
RETURN Rn * 256 + sINCR |
END incr; |
PROCEDURE imm (x: INTEGER): INTEGER; |
VAR |
res: INTEGER; |
BEGIN |
CASE x OF |
| 0: res := CG * 256 |
| 1: res := src_x(0, CG); IdxWords.src := NOWORD |
| 2: res := indir(CG) |
| 4: res := indir(SR) |
| 8: res := incr(SR) |
|-1: res := incr(CG) |
ELSE |
res := incr(PC); |
IdxWords.src := x |
END |
RETURN res |
END imm; |
PROCEDURE Op2 (op, src, dst: INTEGER); |
BEGIN |
ASSERT(BITS(op) + {6, 12..15} = {6, 12..15}); |
ASSERT(BITS(src) + {4, 5, 8..11} = {4, 5, 8..11}); |
ASSERT(BITS(dst) + {0..3, 7} = {0..3, 7}); |
EmitWord(op + src + dst); |
IF IdxWords.src # NOWORD THEN |
EmitWord(IdxWords.src); |
IdxWords.src := NOWORD |
END; |
IF IdxWords.dst # NOWORD THEN |
EmitWord(IdxWords.dst); |
IdxWords.dst := NOWORD |
END |
END Op2; |
PROCEDURE Op1 (op, reg, As: INTEGER); |
BEGIN |
EmitWord(op + reg + As) |
END Op1; |
PROCEDURE MovRR (src, dst: INTEGER); |
BEGIN |
Op2(opMOV, src * 256, dst) |
END MovRR; |
PROCEDURE PushImm (imm: INTEGER); |
BEGIN |
imm := UTILS.Long(imm); |
CASE imm OF |
| 0: Op1(opPUSH, CG, sREG) |
| 1: Op1(opPUSH, CG, sIDX) |
| 2: Op1(opPUSH, CG, sINDIR) |
|-1: Op1(opPUSH, CG, sINCR) |
ELSE |
Op1(opPUSH, PC, sINCR); |
EmitWord(imm) |
END |
END PushImm; |
PROCEDURE PutWord (word: INTEGER; VAR adr: INTEGER); |
BEGIN |
ASSERT(~ODD(adr)); |
ASSERT((0 <= word) & (word <= 65535)); |
mem[adr] := word MOD 256; |
mem[adr + 1] := word DIV 256; |
INC(adr, 2) |
END PutWord; |
PROCEDURE NewLabel (): INTEGER; |
BEGIN |
CHL.PushInt(Labels, 0) |
RETURN IL.NewLabel() |
END NewLabel; |
PROCEDURE LabelOffs (n: INTEGER): INTEGER; |
RETURN CHL.GetInt(Labels, n) |
END LabelOffs; |
PROCEDURE Fixup (CodeAdr, IntVectorSize: INTEGER): INTEGER; |
VAR |
cmd: ANYCODE; |
adr: INTEGER; |
offset: INTEGER; |
diff: INTEGER; |
cc: INTEGER; |
shorted: BOOLEAN; |
BEGIN |
REPEAT |
shorted := FALSE; |
offset := CodeAdr DIV 2; |
cmd := CodeList.first(ANYCODE); |
WHILE cmd # NIL DO |
cmd.offset := offset; |
CASE cmd OF |
|LABEL: CHL.SetInt(Labels, cmd.num, offset) |
|JMP: INC(offset); |
IF ~cmd.short THEN |
INC(offset); |
IF cmd.cc # opJMP THEN |
INC(offset) |
END |
END |
|CALL: INC(offset, 2) |
|WORD: INC(offset) |
END; |
cmd := cmd.next(ANYCODE) |
END; |
cmd := CodeList.first(ANYCODE); |
WHILE cmd # NIL DO |
IF (cmd IS JMP) & ~cmd(JMP).short THEN |
diff := LabelOffs(cmd(JMP).label) - cmd.offset - 1; |
IF ABS(diff) <= 512 THEN |
cmd(JMP).short := TRUE; |
shorted := TRUE |
END |
END; |
cmd := cmd.next(ANYCODE) |
END |
UNTIL ~shorted; |
IF offset * 2 > 10000H - IntVectorSize THEN |
ERRORS.Error(203) |
END; |
adr := CodeAdr; |
cmd := CodeList.first(ANYCODE); |
WHILE cmd # NIL DO |
CASE cmd OF |
|LABEL: |
|JMP: IF ~cmd.short THEN |
CASE cmd.cc OF |
|opJNE: cc := opJEQ |
|opJEQ: cc := opJNE |
|opJNC: cc := opJC |
|opJC: cc := opJNC |
|opJGE: cc := opJL |
|opJL: cc := opJGE |
|opJMP: cc := opJMP |
END; |
IF cc # opJMP THEN |
PutWord(cc + 2, adr) (* jcc L *) |
END; |
PutWord(4030H, adr); (* MOV @PC+, PC *) |
PutWord(LabelOffs(cmd.label) * 2, adr) |
(* L: *) |
ELSE |
diff := LabelOffs(cmd.label) - cmd.offset - 1; |
ASSERT((-512 <= diff) & (diff <= 511)); |
PutWord(cmd.cc + diff MOD 1024, adr) |
END |
|CALL: PutWord(12B0H, adr); (* CALL @PC+ *) |
PutWord(LabelOffs(cmd.label) * 2, adr) |
|WORD: PutWord(cmd.val, adr) |
END; |
cmd := cmd.next(ANYCODE) |
END |
RETURN adr - CodeAdr |
END Fixup; |
PROCEDURE Push (reg: INTEGER); |
BEGIN |
Op1(opPUSH, reg, sREG) |
END Push; |
PROCEDURE Pop (reg: INTEGER); |
BEGIN |
Op2(opMOV, incr(SP), reg) |
END Pop; |
PROCEDURE Test (reg: INTEGER); |
BEGIN |
Op2(opCMP, imm(0), reg) |
END Test; |
PROCEDURE Clear (reg: INTEGER); |
BEGIN |
Op2(opMOV, imm(0), reg) |
END Clear; |
PROCEDURE mov (dst, src: INTEGER); |
BEGIN |
MovRR(src, dst) |
END mov; |
PROCEDURE xchg (reg1, reg2: INTEGER); |
BEGIN |
Push(reg1); |
Push(reg2); |
Pop(reg1); |
Pop(reg2) |
END xchg; |
PROCEDURE Reloc (section: INTEGER); |
VAR |
reloc: RELOC; |
BEGIN |
NEW(reloc); |
reloc.section := section; |
reloc.WordPtr := CodeList.last(WORD); |
LISTS.push(RelList, reloc) |
END Reloc; |
PROCEDURE CallRTL (proc, params: INTEGER); |
BEGIN |
EmitCall(RTL.rtl[proc].label); |
RTL.Used(proc); |
IF params > 0 THEN |
Op2(opADD, imm(params * 2), SP) |
END |
END CallRTL; |
PROCEDURE UnOp (VAR reg: INTEGER); |
BEGIN |
REG.UnOp(R, reg) |
END UnOp; |
PROCEDURE BinOp (VAR reg1, reg2: INTEGER); |
BEGIN |
REG.BinOp(R, reg1, reg2) |
END BinOp; |
PROCEDURE GetRegA; |
BEGIN |
ASSERT(REG.GetReg(R, ACC)) |
END GetRegA; |
PROCEDURE drop; |
BEGIN |
REG.Drop(R) |
END drop; |
PROCEDURE GetAnyReg (): INTEGER; |
RETURN REG.GetAnyReg(R) |
END GetAnyReg; |
PROCEDURE PushAll (NumberOfParameters: INTEGER); |
BEGIN |
REG.PushAll(R); |
DEC(R.pushed, NumberOfParameters) |
END PushAll; |
PROCEDURE PushAll_1; |
BEGIN |
REG.PushAll_1(R) |
END PushAll_1; |
PROCEDURE cond (op: INTEGER): INTEGER; |
VAR |
res: INTEGER; |
BEGIN |
CASE op OF |
|IL.opGT, IL.opGTC: res := jg |
|IL.opGE, IL.opGEC: res := jge |
|IL.opLT, IL.opLTC: res := jl |
|IL.opLE, IL.opLEC: res := jle |
|IL.opEQ, IL.opEQC: res := je |
|IL.opNE, IL.opNEC: res := jne |
END |
RETURN res |
END cond; |
PROCEDURE jcc (cc, label: INTEGER); |
VAR |
L: INTEGER; |
BEGIN |
CASE cc OF |
|jne: |
EmitJmp(opJNE, label) |
|je: |
EmitJmp(opJEQ, label) |
|jge: |
EmitJmp(opJGE, label) |
|jl: |
EmitJmp(opJL, label) |
|jle: |
EmitJmp(opJL, label); |
EmitJmp(opJEQ, label) |
|jg: |
L := NewLabel(); |
EmitJmp(opJEQ, L); |
EmitJmp(opJGE, label); |
EmitLabel(L) |
|jb: |
EmitJmp(opJNC, label) |
END |
END jcc; |
PROCEDURE setcc (cc, reg: INTEGER); |
VAR |
L: INTEGER; |
BEGIN |
L := NewLabel(); |
Op2(opMOV, imm(1), reg); |
jcc(cc, L); |
Clear(reg); |
EmitLabel(L) |
END setcc; |
PROCEDURE Shift2 (op, reg, n: INTEGER); |
VAR |
reg2: INTEGER; |
BEGIN |
IF n >= 8 THEN |
CASE op OF |
|IL.opASR2: Op1(opSWPB, reg, sREG); Op1(opSXT, reg, sREG) |
|IL.opROR2: Op1(opSWPB, reg, sREG) |
|IL.opLSL2: Op1(opSWPB, reg, sREG); Op2(opBIC, imm(255), reg) |
|IL.opLSR2: Op2(opBIC, imm(255), reg); Op1(opSWPB, reg, sREG) |
END; |
DEC(n, 8) |
END; |
IF (op = IL.opROR2) & (n > 0) THEN |
reg2 := GetAnyReg(); |
MovRR(reg, reg2) |
ELSE |
reg2 := -1 |
END; |
WHILE n > 0 DO |
CASE op OF |
|IL.opASR2: Op1(opRRA, reg, sREG) |
|IL.opROR2: Op1(opRRC, reg2, sREG); Op1(opRRC, reg, sREG) |
|IL.opLSL2: Op2(opADD, reg * 256, reg) |
|IL.opLSR2: Op2(opBIC, imm(1), SR); Op1(opRRC, reg, sREG) |
END; |
DEC(n) |
END; |
IF reg2 # -1 THEN |
drop |
END |
END Shift2; |
PROCEDURE Neg (reg: INTEGER); |
BEGIN |
Op2(opXOR, imm(-1), reg); |
Op2(opADD, imm(1), reg) |
END Neg; |
PROCEDURE translate (code: IL.CODES); |
VAR |
cmd, next: COMMAND; |
opcode, param1, param2, label, L, a, n, c1, c2: INTEGER; |
reg1, reg2: INTEGER; |
cc: INTEGER; |
BEGIN |
cmd := code.commands.first(COMMAND); |
WHILE cmd # NIL DO |
param1 := cmd.param1; |
param2 := cmd.param2; |
opcode := cmd.opcode; |
CASE opcode OF |
|IL.opJMP: |
EmitJmp(opJMP, param1) |
|IL.opCALL: |
EmitCall(param1) |
|IL.opCALLP: |
UnOp(reg1); |
Op1(opCALL, reg1, sREG); |
drop; |
ASSERT(R.top = -1) |
|IL.opPRECALL: |
PushAll(0) |
|IL.opLABEL: |
EmitLabel(param1) |
|IL.opSADR_PARAM: |
Op1(opPUSH, PC, sINCR); |
EmitWord(param2); |
Reloc(RDATA) |
|IL.opERR: |
CallRTL(RTL._error, 2) |
|IL.opPUSHC: |
PushImm(param2) |
|IL.opLEAVEC: |
Pop(PC) |
|IL.opENTER: |
ASSERT(R.top = -1); |
EmitLabel(param1); |
Push(BP); |
MovRR(SP, BP); |
IF param2 > 8 THEN |
Op2(opMOV, imm(param2), R4); |
L := NewLabel(); |
EmitLabel(L); |
Push(CG); |
Op2(opSUB, imm(1), R4); |
jcc(jne, L) |
ELSIF param2 > 0 THEN |
WHILE param2 > 0 DO |
Push(CG); |
DEC(param2) |
END |
END |
|IL.opLEAVE, IL.opLEAVER: |
ASSERT(param2 = 0); |
IF opcode = IL.opLEAVER THEN |
UnOp(reg1); |
IF reg1 # ACC THEN |
GetRegA; |
ASSERT(REG.Exchange(R, reg1, ACC)); |
drop |
END; |
drop |
END; |
ASSERT(R.top = -1); |
IF param1 > 0 THEN |
MovRR(BP, SP) |
END; |
Pop(BP); |
Pop(PC) |
|IL.opRES: |
ASSERT(R.top = -1); |
GetRegA |
|IL.opCLEANUP: |
IF param2 # 0 THEN |
Op2(opADD, imm(param2 * 2), SP) |
END |
|IL.opCONST: |
next := cmd.next(COMMAND); |
IF next.opcode = IL.opCONST THEN |
c1 := param2; |
c2 := next.param2; |
next := next.next(COMMAND); |
IF (next.opcode = IL.opSAVE) OR (next.opcode = IL.opSAVE16) OR (next.opcode = IL.opSAVE8) THEN |
Op2(opMOV + bw(next.opcode = IL.opSAVE8), imm(c1), dst_x(c2, SR)); |
cmd := next |
ELSE |
Op2(opMOV, imm(param2), GetAnyReg()) |
END |
ELSIF (next.opcode = IL.opSAVE) OR (next.opcode = IL.opSAVE16) OR (next.opcode = IL.opSAVE8) THEN |
UnOp(reg1); |
Op2(opMOV + bw(next.opcode = IL.opSAVE8), reg1 * 256, dst_x(param2, SR)); |
drop; |
cmd := next |
ELSE |
Op2(opMOV, imm(param2), GetAnyReg()) |
END |
|IL.opSADR: |
Op2(opMOV, incr(PC), GetAnyReg()); |
EmitWord(param2); |
Reloc(RDATA) |
|IL.opGADR: |
Op2(opMOV, incr(PC), GetAnyReg()); |
EmitWord(param2); |
Reloc(RBSS) |
|IL.opLADR: |
reg1 := GetAnyReg(); |
MovRR(BP, reg1); |
Op2(opADD, imm(param2 * 2), reg1) |
|IL.opLLOAD8: |
Op2(opMOV + BW, src_x(param2 * 2, BP), GetAnyReg()) |
|IL.opLLOAD16, IL.opVADR: |
Op2(opMOV, src_x(param2 * 2, BP), GetAnyReg()) |
|IL.opGLOAD8: |
Op2(opMOV + BW, src_x(param2, SR), GetAnyReg()); |
Reloc(RBSS) |
|IL.opGLOAD16: |
Op2(opMOV, src_x(param2, SR), GetAnyReg()); |
Reloc(RBSS) |
|IL.opLOAD8: |
UnOp(reg1); |
Op2(opMOV + BW, indir(reg1), reg1) |
|IL.opLOAD16: |
UnOp(reg1); |
Op2(opMOV, indir(reg1), reg1) |
|IL.opVLOAD8: |
reg1 := GetAnyReg(); |
Op2(opMOV, src_x(param2 * 2, BP), reg1); |
Op2(opMOV + BW, indir(reg1), reg1) |
|IL.opVLOAD16: |
reg1 := GetAnyReg(); |
Op2(opMOV, src_x(param2 * 2, BP), reg1); |
Op2(opMOV, indir(reg1), reg1) |
|IL.opSAVE, IL.opSAVE16: |
BinOp(reg2, reg1); |
Op2(opMOV, reg2 * 256, dst_x(0, reg1)); |
drop; |
drop |
|IL.opSAVE8: |
BinOp(reg2, reg1); |
Op2(opMOV + BW, reg2 * 256, dst_x(0, reg1)); |
drop; |
drop |
|IL.opSAVE8C: |
UnOp(reg1); |
Op2(opMOV + BW, imm(param2), dst_x(0, reg1)); |
drop |
|IL.opSAVE16C, IL.opSAVEC: |
UnOp(reg1); |
Op2(opMOV, imm(param2), dst_x(0, reg1)); |
drop |
|IL.opUMINUS: |
UnOp(reg1); |
Neg(reg1) |
|IL.opADD: |
BinOp(reg1, reg2); |
Op2(opADD, reg2 * 256, reg1); |
drop |
|IL.opADDL, IL.opADDR: |
IF param2 # 0 THEN |
UnOp(reg1); |
Op2(opADD, imm(param2), reg1) |
END |
|IL.opSUB: |
BinOp(reg1, reg2); |
Op2(opSUB, reg2 * 256, reg1); |
drop |
|IL.opSUBR, IL.opSUBL: |
UnOp(reg1); |
IF param2 # 0 THEN |
Op2(opSUB, imm(param2), reg1) |
END; |
IF opcode = IL.opSUBL THEN |
reg2 := GetAnyReg(); |
Clear(reg2); |
Op2(opSUB, reg1 * 256, reg2); |
drop; |
drop; |
ASSERT(REG.GetReg(R, reg2)) |
END |
|IL.opLADR_SAVEC: |
Op2(opMOV, imm(param2), dst_x(param1 * 2, BP)) |
|IL.opLADR_SAVE: |
UnOp(reg1); |
Op2(opMOV, reg1 * 256, dst_x(param2 * 2, BP)); |
drop |
|IL.opGADR_SAVEC: |
Op2(opMOV, imm(param2), dst_x(param1, SR)); |
Reloc(RBSS) |
|IL.opCONST_PARAM: |
PushImm(param2) |
|IL.opPARAM: |
IF param2 = 1 THEN |
UnOp(reg1); |
Push(reg1); |
drop |
ELSE |
ASSERT(R.top + 1 <= param2); |
PushAll(param2) |
END |
|IL.opEQ..IL.opGE, |
IL.opEQC..IL.opGEC: |
IF (IL.opEQ <= opcode) & (opcode <= IL.opGE) THEN |
BinOp(reg1, reg2); |
Op2(opCMP, reg2 * 256, reg1); |
drop |
ELSE |
UnOp(reg1); |
Op2(opCMP, imm(param2), reg1) |
END; |
drop; |
cc := cond(opcode); |
IF cmd.next(COMMAND).opcode = IL.opJE THEN |
label := cmd.next(COMMAND).param1; |
jcc(cc, label); |
cmd := cmd.next(COMMAND) |
ELSIF cmd.next(COMMAND).opcode = IL.opJNE THEN |
label := cmd.next(COMMAND).param1; |
jcc(ORD(BITS(cc) / {0}), label); |
cmd := cmd.next(COMMAND) |
ELSE |
setcc(cc, GetAnyReg()) |
END |
|IL.opNOP: |
|IL.opCODE: |
EmitWord(param2) |
|IL.opACC: |
IF (R.top # 0) OR (R.stk[0] # ACC) THEN |
PushAll(0); |
GetRegA; |
Pop(ACC); |
DEC(R.pushed) |
END |
|IL.opDROP: |
UnOp(reg1); |
drop |
|IL.opJNZ: |
UnOp(reg1); |
Test(reg1); |
jcc(jne, param1) |
|IL.opJZ: |
UnOp(reg1); |
Test(reg1); |
jcc(je, param1) |
|IL.opJG: |
UnOp(reg1); |
Test(reg1); |
jcc(jg, param1) |
|IL.opJE: |
UnOp(reg1); |
Test(reg1); |
jcc(jne, param1); |
drop |
|IL.opJNE: |
UnOp(reg1); |
Test(reg1); |
jcc(je, param1); |
drop |
|IL.opNOT: |
UnOp(reg1); |
Test(reg1); |
setcc(je, reg1) |
|IL.opORD: |
UnOp(reg1); |
Test(reg1); |
setcc(jne, reg1) |
|IL.opLOOP: |
|IL.opENDLOOP: |
|IL.opGET: |
BinOp(reg1, reg2); |
drop; |
drop; |
Op2(opMOV + bw(param2 = 1), indir(reg1), dst_x(0, reg2)) |
|IL.opGETC: |
UnOp(reg2); |
drop; |
Op2(opMOV + bw(param2 = 1), src_x(param1, SR), dst_x(0, reg2)) |
|IL.opCHKIDX: |
UnOp(reg1); |
Op2(opCMP, imm(param2), reg1); |
jcc(jb, param1) |
|IL.opCHKIDX2: |
BinOp(reg1, reg2); |
IF param2 # -1 THEN |
Op2(opCMP, reg1 * 256, reg2); |
MovRR(reg2, reg1); |
drop; |
jcc(jb, param1) |
ELSE |
INCL(R.regs, reg1); |
DEC(R.top); |
R.stk[R.top] := reg2 |
END |
|IL.opINCC, IL.opINCCB: |
UnOp(reg1); |
Op2(opADD + bw(opcode = IL.opINCCB), imm(param2), dst_x(0, reg1)); |
drop |
|IL.opDECCB: |
UnOp(reg1); |
Op2(opSUB + BW, imm(param2), dst_x(0, reg1)); |
drop |
|IL.opINC, IL.opINCB: |
BinOp(reg1, reg2); |
Op2(opADD + bw(opcode = IL.opINCB), reg1 * 256, dst_x(0, reg2)); |
drop; |
drop |
|IL.opDEC, IL.opDECB: |
BinOp(reg1, reg2); |
Op2(opSUB + bw(opcode = IL.opDECB), reg1 * 256, dst_x(0, reg2)); |
drop; |
drop |
|IL.opLADR_INCC, IL.opLADR_INCCB: |
Op2(opADD + bw(opcode = IL.opLADR_INCCB), imm(param2), dst_x(param1 * 2, BP)) |
|IL.opLADR_DECCB: |
Op2(opSUB + BW, imm(param2), dst_x(param1 * 2, BP)) |
|IL.opLADR_INC, IL.opLADR_INCB: |
UnOp(reg1); |
Op2(opADD + bw(opcode = IL.opLADR_INCB), reg1 * 256, dst_x(param2 * 2, BP)); |
drop |
|IL.opLADR_DEC, IL.opLADR_DECB: |
UnOp(reg1); |
Op2(opSUB + bw(opcode = IL.opLADR_DECB), reg1 * 256, dst_x(param2 * 2, BP)); |
drop |
|IL.opPUSHT: |
UnOp(reg1); |
Op2(opMOV, src_x(-2, reg1), GetAnyReg()) |
|IL.opISREC: |
PushAll(2); |
PushImm(param2); |
CallRTL(RTL._guardrec, 3); |
GetRegA |
|IL.opIS: |
PushAll(1); |
PushImm(param2); |
CallRTL(RTL._is, 2); |
GetRegA |
|IL.opTYPEGR: |
PushAll(1); |
PushImm(param2); |
CallRTL(RTL._guardrec, 2); |
GetRegA |
|IL.opTYPEGP: |
UnOp(reg1); |
PushAll(0); |
Push(reg1); |
PushImm(param2); |
CallRTL(RTL._guard, 2); |
GetRegA |
|IL.opTYPEGD: |
UnOp(reg1); |
PushAll(0); |
Op1(opPUSH, reg1, sIDX); |
EmitWord(-2); |
PushImm(param2); |
CallRTL(RTL._guardrec, 2); |
GetRegA |
|IL.opMULS: |
BinOp(reg1, reg2); |
Op2(opAND, reg2 * 256, reg1); |
drop |
|IL.opMULSC: |
UnOp(reg1); |
Op2(opAND, imm(param2), reg1) |
|IL.opDIVS: |
BinOp(reg1, reg2); |
Op2(opXOR, reg2 * 256, reg1); |
drop |
|IL.opDIVSC: |
UnOp(reg1); |
Op2(opXOR, imm(param2), reg1) |
|IL.opADDS: |
BinOp(reg1, reg2); |
Op2(opBIS, reg2 * 256, reg1); |
drop |
|IL.opSUBS: |
BinOp(reg1, reg2); |
Op2(opBIC, reg2 * 256, reg1); |
drop |
|IL.opADDSL, IL.opADDSR: |
UnOp(reg1); |
Op2(opBIS, imm(param2), reg1) |
|IL.opSUBSL: |
UnOp(reg1); |
Op2(opXOR, imm(-1), reg1); |
Op2(opAND, imm(param2), reg1) |
|IL.opSUBSR: |
UnOp(reg1); |
Op2(opBIC, imm(param2), reg1) |
|IL.opUMINS: |
UnOp(reg1); |
Op2(opXOR, imm(-1), reg1) |
|IL.opLENGTH: |
PushAll(2); |
CallRTL(RTL._length, 2); |
GetRegA |
|IL.opMIN: |
BinOp(reg1, reg2); |
Op2(opCMP, reg2 * 256, reg1); |
EmitWord(opJL + 1); (* jl L *) |
MovRR(reg2, reg1); |
(* L: *) |
drop |
|IL.opMAX: |
BinOp(reg1, reg2); |
Op2(opCMP, reg2 * 256, reg1); |
EmitWord(opJGE + 1); (* jge L *) |
MovRR(reg2, reg1); |
(* L: *) |
drop |
|IL.opMINC: |
UnOp(reg1); |
Op2(opCMP, imm(param2), reg1); |
L := NewLabel(); |
jcc(jl, L); |
Op2(opMOV, imm(param2), reg1); |
EmitLabel(L) |
|IL.opMAXC: |
UnOp(reg1); |
Op2(opCMP, imm(param2), reg1); |
L := NewLabel(); |
jcc(jge, L); |
Op2(opMOV, imm(param2), reg1); |
EmitLabel(L) |
|IL.opSWITCH: |
UnOp(reg1); |
IF param2 = 0 THEN |
reg2 := ACC |
ELSE |
reg2 := R5 |
END; |
IF reg1 # reg2 THEN |
ASSERT(REG.GetReg(R, reg2)); |
ASSERT(REG.Exchange(R, reg1, reg2)); |
drop |
END; |
drop |
|IL.opENDSW: |
|IL.opCASEL: |
Op2(opCMP, imm(param1), ACC); |
jcc(jl, param2) |
|IL.opCASER: |
Op2(opCMP, imm(param1), ACC); |
jcc(jg, param2) |
|IL.opCASELR: |
Op2(opCMP, imm(param1), ACC); |
jcc(jl, param2); |
jcc(jg, cmd.param3) |
|IL.opSBOOL: |
BinOp(reg2, reg1); |
Test(reg2); |
setcc(jne, reg2); |
Op2(opMOV + BW, reg2 * 256, dst_x(0, reg1)); |
drop; |
drop |
|IL.opSBOOLC: |
UnOp(reg1); |
Op2(opMOV + BW, imm(param2), dst_x(0, reg1)); |
drop |
|IL.opODD: |
UnOp(reg1); |
Op2(opAND, imm(1), reg1) |
|IL.opEQS .. IL.opGES: |
PushAll(4); |
PushImm((opcode - IL.opEQS) * 12); |
CallRTL(RTL._strcmp, 5); |
GetRegA |
|IL.opLEN: |
UnOp(reg1); |
drop; |
EXCL(R.regs, reg1); |
WHILE param2 > 0 DO |
UnOp(reg2); |
drop; |
DEC(param2) |
END; |
INCL(R.regs, reg1); |
ASSERT(REG.GetReg(R, reg1)) |
|IL.opCHKBYTE: |
BinOp(reg1, reg2); |
Op2(opCMP, imm(256), reg1); |
jcc(jb, param1) |
|IL.opLSL, IL.opASR, IL.opROR, IL.opLSR: |
PushAll(2); |
CASE opcode OF |
|IL.opLSL: CallRTL(RTL._lsl, 2) |
|IL.opASR: CallRTL(RTL._asr, 2) |
|IL.opROR: CallRTL(RTL._ror, 2) |
|IL.opLSR: CallRTL(RTL._lsr, 2) |
END; |
GetRegA |
|IL.opLSL1, IL.opASR1, IL.opROR1, IL.opLSR1: |
UnOp(reg1); |
PushAll_1; |
PushImm(param2); |
Push(reg1); |
drop; |
CASE opcode OF |
|IL.opLSL1: CallRTL(RTL._lsl, 2) |
|IL.opASR1: CallRTL(RTL._asr, 2) |
|IL.opROR1: CallRTL(RTL._ror, 2) |
|IL.opLSR1: CallRTL(RTL._lsr, 2) |
END; |
GetRegA |
|IL.opASR2, IL.opROR2, IL.opLSL2, IL.opLSR2: |
param2 := param2 MOD 16; |
IF param2 # 0 THEN |
UnOp(reg1); |
Shift2(opcode, reg1, param2) |
END |
|IL.opMUL: |
PushAll(2); |
CallRTL(RTL._mul, 2); |
GetRegA |
|IL.opMULC: |
UnOp(reg1); |
a := param2; |
IF a > 1 THEN |
n := UTILS.Log2(a) |
ELSIF a < -1 THEN |
n := UTILS.Log2(-a) |
ELSE |
n := -1 |
END; |
IF a = 1 THEN |
ELSIF a = -1 THEN |
Neg(reg1) |
ELSIF a = 0 THEN |
Clear(reg1) |
ELSE |
IF n > 0 THEN |
IF a < 0 THEN |
Neg(reg1) |
END; |
Shift2(IL.opLSL2, reg1, n) |
ELSE |
PushAll(1); |
PushImm(a); |
CallRTL(RTL._mul, 2); |
GetRegA |
END |
END |
|IL.opDIV: |
PushAll(2); |
CallRTL(RTL._divmod, 2); |
GetRegA |
|IL.opDIVR: |
ASSERT(param2 > 0); |
IF param2 > 1 THEN |
n := UTILS.Log2(param2); |
IF n > 0 THEN |
UnOp(reg1); |
Shift2(IL.opASR2, reg1, n) |
ELSE |
PushAll(1); |
PushImm(param2); |
CallRTL(RTL._divmod, 2); |
GetRegA |
END |
END |
|IL.opDIVL: |
UnOp(reg1); |
PushAll_1; |
PushImm(param2); |
Push(reg1); |
drop; |
CallRTL(RTL._divmod, 2); |
GetRegA |
|IL.opMOD: |
PushAll(2); |
CallRTL(RTL._divmod, 2); |
ASSERT(REG.GetReg(R, R5)) |
|IL.opMODR: |
ASSERT(param2 > 0); |
IF param2 = 1 THEN |
UnOp(reg1); |
Clear(reg1) |
ELSE |
IF UTILS.Log2(param2) > 0 THEN |
UnOp(reg1); |
Op2(opAND, imm(param2 - 1), reg1) |
ELSE |
PushAll(1); |
PushImm(param2); |
CallRTL(RTL._divmod, 2); |
ASSERT(REG.GetReg(R, R5)) |
END |
END |
|IL.opMODL: |
UnOp(reg1); |
PushAll_1; |
PushImm(param2); |
Push(reg1); |
drop; |
CallRTL(RTL._divmod, 2); |
ASSERT(REG.GetReg(R, R5)) |
|IL.opCOPYS: |
ASSERT(R.top = 3); |
Push(R.stk[2]); |
Push(R.stk[0]); |
Op2(opCMP, R.stk[1] * 256, R.stk[3]); |
EmitWord(3801H); (* JL L1 *) |
MovRR(R.stk[1], R.stk[3]); |
(* L1: *) |
Push(R.stk[3]); |
drop; |
drop; |
drop; |
drop; |
CallRTL(RTL._move, 3) |
|IL.opCOPY: |
PushAll(2); |
PushImm(param2); |
CallRTL(RTL._move, 3) |
|IL.opMOVE: |
PushAll(3); |
CallRTL(RTL._move, 3) |
|IL.opCOPYA: |
PushAll(4); |
PushImm(param2); |
CallRTL(RTL._arrcpy, 5); |
GetRegA |
|IL.opROT: |
PushAll(0); |
MovRR(SP, ACC); |
Push(ACC); |
PushImm(param2); |
CallRTL(RTL._rot, 2) |
|IL.opSAVES: |
UnOp(reg1); |
PushAll_1; |
Op1(opPUSH, PC, sINCR); |
EmitWord(param2); |
Reloc(RDATA); |
Push(reg1); |
drop; |
PushImm(param1); |
CallRTL(RTL._move, 3) |
|IL.opCASET: |
Push(R5); |
Push(R5); |
PushImm(param2); |
CallRTL(RTL._guardrec, 2); |
Pop(R5); |
Test(ACC); |
jcc(jne, param1) |
|IL.opCHR: |
UnOp(reg1); |
Op2(opAND, imm(255), reg1) |
|IL.opABS: |
UnOp(reg1); |
Test(reg1); |
L := NewLabel(); |
jcc(jge, L); |
Neg(reg1); |
EmitLabel(L) |
|IL.opEQB, IL.opNEB: |
BinOp(reg1, reg2); |
drop; |
Test(reg1); |
L := NewLabel(); |
jcc(je, L); |
Op2(opMOV, imm(1), reg1); |
EmitLabel(L); |
Test(reg2); |
L := NewLabel(); |
jcc(je, L); |
Op2(opMOV, imm(1), reg2); |
EmitLabel(L); |
Op2(opCMP, reg2 * 256, reg1); |
IF opcode = IL.opEQB THEN |
setcc(je, reg1) |
ELSE |
setcc(jne, reg1) |
END |
|IL.opSAVEP: |
UnOp(reg1); |
Op2(opMOV, incr(PC), reg1 + dIDX); |
EmitWord(param2); |
Reloc(RCODE); |
EmitWord(0); |
drop |
|IL.opPUSHP: |
Op2(opMOV, incr(PC), GetAnyReg()); |
EmitWord(param2); |
Reloc(RCODE) |
|IL.opEQP, IL.opNEP: |
UnOp(reg1); |
Op2(opCMP, incr(PC), reg1); |
EmitWord(param1); |
Reloc(RCODE); |
drop; |
reg1 := GetAnyReg(); |
IF opcode = IL.opEQP THEN |
setcc(je, reg1) |
ELSIF opcode = IL.opNEP THEN |
setcc(jne, reg1) |
END |
|IL.opVADR_PARAM: |
Op1(opPUSH, BP, sIDX); |
EmitWord(param2 * 2) |
|IL.opNEW: |
PushAll(1); |
n := param2 + 2; |
ASSERT(UTILS.Align(n, 2)); |
PushImm(n); |
PushImm(param1); |
CallRTL(RTL._new, 3) |
|IL.opRSET: |
PushAll(2); |
CallRTL(RTL._set, 2); |
GetRegA |
|IL.opRSETR: |
PushAll(1); |
PushImm(param2); |
CallRTL(RTL._set, 2); |
GetRegA |
|IL.opRSETL: |
UnOp(reg1); |
PushAll_1; |
PushImm(param2); |
Push(reg1); |
drop; |
CallRTL(RTL._set, 2); |
GetRegA |
|IL.opRSET1: |
PushAll(1); |
CallRTL(RTL._set1, 1); |
GetRegA |
|IL.opINCLC: |
UnOp(reg1); |
Op2(opBIS, imm(ORD({param2})), dst_x(0, reg1)); |
drop |
|IL.opEXCLC: |
UnOp(reg1); |
Op2(opBIC, imm(ORD({param2})), dst_x(0, reg1)); |
drop |
|IL.opIN: |
PushAll(2); |
CallRTL(RTL._in, 2); |
GetRegA |
|IL.opINR: |
PushAll(1); |
PushImm(param2); |
CallRTL(RTL._in, 2); |
GetRegA |
|IL.opINL: |
PushAll(1); |
PushImm(param2); |
CallRTL(RTL._in2, 2); |
GetRegA |
|IL.opINCL: |
PushAll(2); |
CallRTL(RTL._incl, 2) |
|IL.opEXCL: |
PushAll(2); |
CallRTL(RTL._excl, 2) |
|IL.opLADR_INCL, IL.opLADR_EXCL: |
PushAll(1); |
MovRR(BP, ACC); |
Op2(opADD, imm(param2 * 2), ACC); |
Push(ACC); |
IF opcode = IL.opLADR_INCL THEN |
CallRTL(RTL._incl, 2) |
ELSIF opcode = IL.opLADR_EXCL THEN |
CallRTL(RTL._excl, 2) |
END |
|IL.opLADR_INCLC: |
Op2(opBIS, imm(ORD({param2})), dst_x(param1 * 2, BP)) |
|IL.opLADR_EXCLC: |
Op2(opBIC, imm(ORD({param2})), dst_x(param1 * 2, BP)) |
END; |
cmd := cmd.next(COMMAND) |
END; |
ASSERT(R.pushed = 0); |
ASSERT(R.top = -1) |
END translate; |
PROCEDURE prolog (ramSize: INTEGER); |
VAR |
i: INTEGER; |
BEGIN |
RTL.Init(EmitLabel, EmitWord, EmitCall, ramSize); |
FOR i := 0 TO LEN(RTL.rtl) - 1 DO |
RTL.Set(i, NewLabel()) |
END; |
IV[LEN(IV) - 1] := NewLabel(); |
EmitLabel(IV[LEN(IV) - 1]); |
Op2(opMOV, incr(PC), SP); |
EmitWord(0); |
Op2(opMOV, incr(PC), HP); |
EmitWord(0); |
Op2(opMOV, imm(5A80H), dst_x(0120H, SR)); (* stop WDT *) |
Op2(opMOV, imm(RTL.empty_proc), dst_x(RTL.int, SR)); |
Op2(opMOV, imm(0), dst_x(RTL.trap, SR)) |
END prolog; |
PROCEDURE epilog; |
VAR |
L1, i: INTEGER; |
BEGIN |
Op2(opBIS, imm(10H), SR); (* CPUOFF *) |
L1 := NewLabel(); |
FOR i := 0 TO LEN(IV) - 2 DO |
IV[i] := NewLabel(); |
EmitLabel(IV[i]); |
PushImm(i); |
IF i # LEN(IV) - 2 THEN |
EmitJmp(opJMP, L1) |
END |
END; |
EmitLabel(L1); |
MovRR(SP, IR); |
FOR i := 0 TO 15 DO |
IF i IN R.regs + R.vregs THEN |
Push(i) |
END |
END; |
Push(IR); |
Op1(opPUSH, IR, sINDIR); |
Op1(opCALL, SR, sIDX); |
EmitWord(RTL.int); |
Op2(opADD, imm(4), SP); |
FOR i := 15 TO 0 BY -1 DO |
IF i IN R.regs + R.vregs THEN |
Pop(i) |
END |
END; |
Op2(opADD, imm(2), SP); |
Op1(opRETI, 0, 0); |
RTL.Gen |
END epilog; |
PROCEDURE hexdgt (n: BYTE): BYTE; |
BEGIN |
IF n < 10 THEN |
n := n + ORD("0") |
ELSE |
n := n - 10 + ORD("A") |
END |
RETURN n |
END hexdgt; |
PROCEDURE WriteHexByte (file: FILES.FILE; byte: BYTE); |
BEGIN |
WRITER.WriteByte(file, hexdgt(byte DIV 16)); |
WRITER.WriteByte(file, hexdgt(byte MOD 16)); |
END WriteHexByte; |
PROCEDURE WriteHex (file: FILES.FILE; mem: ARRAY OF BYTE; idx, cnt: INTEGER); |
VAR |
i, len, chksum: INTEGER; |
BEGIN |
WHILE cnt > 0 DO |
len := MIN(cnt, 16); |
chksum := len + idx DIV 256 + idx MOD 256; |
WRITER.WriteByte(file, ORD(":")); |
WriteHexByte(file, len); |
WriteHexByte(file, idx DIV 256); |
WriteHexByte(file, idx MOD 256); |
WriteHexByte(file, 0); |
FOR i := 1 TO len DO |
WriteHexByte(file, mem[idx]); |
INC(chksum, mem[idx]); |
INC(idx) |
END; |
WriteHexByte(file, (-chksum) MOD 256); |
DEC(cnt, len); |
WRITER.WriteByte(file, 0DH); |
WRITER.WriteByte(file, 0AH) |
END |
END WriteHex; |
PROCEDURE CodeGen* (code: IL.CODES; outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS); |
VAR |
i, adr, heap, stack, TextSize, TypesSize, bits, n: INTEGER; |
Code, Data, Bss, Free: RECORD address, size: INTEGER END; |
ram, rom: INTEGER; |
reloc: RELOC; |
file: FILES.FILE; |
BEGIN |
IdxWords.src := NOWORD; |
IdxWords.dst := NOWORD; |
ram := options.ram; |
rom := options.rom; |
IF ODD(ram) THEN DEC(ram) END; |
IF ODD(rom) THEN DEC(rom) END; |
ram := MIN(MAX(ram, minRAM), maxRAM); |
rom := MIN(MAX(rom, minROM), maxROM); |
IF code.bss > ram - minStackSize - RTL.VarSize THEN |
ERRORS.Error(204) |
END; |
Labels := CHL.CreateIntList(); |
FOR i := 1 TO code.lcount DO |
CHL.PushInt(Labels, 0) |
END; |
FOR i := 0 TO LEN(mem) - 1 DO |
mem[i] := 0 |
END; |
TypesSize := CHL.Length(code.types) * 2; |
CodeList := LISTS.create(NIL); |
RelList := LISTS.create(NIL); |
REG.Init(R, Push, Pop, mov, xchg, NIL, NIL, {R4, R5, R6, R7}, {}); |
prolog(ram); |
translate(code); |
epilog; |
Code.address := 10000H - rom; |
Code.size := Fixup(Code.address, IntVectorSize + TypesSize); |
Data.address := Code.address + Code.size; |
Data.size := CHL.Length(code.data); |
Data.size := Data.size + ORD(ODD(Data.size)); |
TextSize := Code.size + Data.size; |
IF Code.address + TextSize + MAX(code.dmin - Data.size, IntVectorSize + TypesSize) > 10000H THEN |
ERRORS.Error(203) |
END; |
Bss.address := RTL.ram + RTL.VarSize; |
Bss.size := code.bss + ORD(ODD(code.bss)); |
heap := Bss.address + Bss.size; |
stack := RTL.ram + ram; |
ASSERT(stack - heap >= minStackSize); |
adr := Code.address + 2; |
PutWord(stack, adr); |
adr := Code.address + 6; |
PutWord(heap, adr); |
reloc := RelList.first(RELOC); |
WHILE reloc # NIL DO |
adr := reloc.WordPtr.offset * 2; |
CASE reloc.section OF |
|RCODE: PutWord(LabelOffs(reloc.WordPtr.val) * 2, adr) |
|RDATA: PutWord(reloc.WordPtr.val + Data.address, adr) |
|RBSS: PutWord(reloc.WordPtr.val + Bss.address, adr) |
END; |
reloc := reloc.next(RELOC) |
END; |
adr := Data.address; |
FOR i := 0 TO CHL.Length(code.data) - 1 DO |
mem[adr] := CHL.GetByte(code.data, i); |
INC(adr) |
END; |
adr := 10000H - IntVectorSize - TypesSize; |
FOR i := TypesSize DIV 2 - 1 TO 0 BY -1 DO |
PutWord(CHL.GetInt(code.types, i), adr) |
END; |
FOR i := 0 TO 15 DO |
PutWord((33 - i) * i, adr); |
END; |
FOR n := 0 TO 15 DO |
bits := ORD({0 .. n}); |
FOR i := 0 TO 15 - n DO |
PutWord(bits, adr); |
bits := LSL(bits, 1) |
END |
END; |
Free.address := Code.address + TextSize; |
Free.size := rom - (IntVectorSize + TypesSize + TextSize); |
PutWord(Free.address, adr); |
PutWord(Free.size, adr); |
PutWord(4130H, adr); (* RET *) |
PutWord(stack, adr); |
FOR i := 0 TO LEN(IV) - 1 DO |
PutWord(LabelOffs(IV[i]) * 2, adr) |
END; |
file := FILES.create(outname); |
WriteHex(file, mem, Code.address, TextSize); |
WriteHex(file, mem, 10000H - IntVectorSize - TypesSize, IntVectorSize + TypesSize); |
WRITER.WriteByte(file, ORD(":")); |
WriteHexByte(file, 0); |
WriteHexByte(file, 0); |
WriteHexByte(file, 0); |
WriteHexByte(file, 1); |
WriteHexByte(file, 255); |
WRITER.WriteByte(file, 0DH); |
WRITER.WriteByte(file, 0AH); |
FILES.close(file); |
INC(TextSize, IntVectorSize + TypesSize); |
INC(Bss.size, minStackSize + RTL.VarSize); |
C.StringLn("--------------------------------------------"); |
C.String( " rom: "); C.Int(TextSize); C.String(" of "); C.Int(rom); C.String(" ("); C.Int(TextSize * 100 DIV rom); C.StringLn("%)"); |
IF Free.size > 0 THEN |
C.String( " "); C.Int(Free.size); C.String(" bytes free (0"); |
C.Hex(Free.address, 4); C.String("H..0"); C.Hex(Free.address + Free.size - 1, 4); C.StringLn("H)") |
END; |
C.Ln; |
C.String( " ram: "); C.Int(Bss.size); C.String(" of "); C.Int(ram); C.String(" ("); C.Int(Bss.size * 100 DIV ram); C.StringLn("%)"); |
C.StringLn("--------------------------------------------") |
END CodeGen; |
END MSP430. |
/programs/develop/oberon07/Source/MSP430RTL.ob07 |
---|
0,0 → 1,677 |
(* |
BSD 2-Clause License |
Copyright (c) 2019, Anton Krotov |
All rights reserved. |
*) |
MODULE MSP430RTL; |
CONST |
_mul* = 0; |
_divmod* = 1; |
_lsl* = 2; |
_asr* = 3; |
_ror* = 4; |
_lsr* = 5; |
_in* = 6; |
_in2* = 7; |
_set1* = 8; |
_incl* = 9; |
_excl* = 10; |
_move* = 11; |
_set* = 12; |
_arrcpy* = 13; |
_rot* = 14; |
_strcmp* = 15; |
_error* = 16; |
_is* = 17; |
_guard* = 18; |
_guardrec* = 19; |
_length* = 20; |
_new* = 21; |
HP = 14; |
LenIV* = 32; |
iv = 10000H - LenIV * 2; |
sp = iv - 2; |
empty_proc* = sp - 2; |
free_size = empty_proc - 2; |
free_adr = free_size - 2; |
bits = free_adr - 272; |
bits_offs = bits - 32; |
DataSize* = iv - bits_offs; |
types = bits_offs - 2; |
IntVectorSize* = LenIV * 2 + DataSize; |
VarSize* = 4; |
TYPE |
EMITPROC = PROCEDURE (n: INTEGER); |
VAR |
ram*, trap*, int*: INTEGER; |
rtl*: ARRAY 22 OF |
RECORD |
label*: INTEGER; |
used: BOOLEAN |
END; |
Label, Word, Call: EMITPROC; |
PROCEDURE Gen*; |
PROCEDURE Word1 (word: INTEGER); |
BEGIN |
Word(word) |
END Word1; |
PROCEDURE Word2 (word1, word2: INTEGER); |
BEGIN |
Word1(word1); |
Word1(word2) |
END Word2; |
PROCEDURE Word3 (word1, word2, word3: INTEGER); |
BEGIN |
Word1(word1); |
Word1(word2); |
Word1(word3) |
END Word3; |
BEGIN |
(* _lsl (n, x: INTEGER): INTEGER *) |
IF rtl[_lsl].used THEN |
Label(rtl[_lsl].label); |
Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- n *) |
Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- x *) |
Word2(0F035H, 15); (* AND #15, R5 *) |
Word1(2400H + 3); (* JZ L1 *) |
(* L2: *) |
Word1(5404H); (* ADD R4, R4 *) |
Word1(8315H); (* SUB #1, R5 *) |
Word1(2000H + 400H - 3); (* JNZ L2 *) |
(* L1: *) |
Word1(4130H) (* RET *) |
END; |
(* _asr (n, x: INTEGER): INTEGER *) |
IF rtl[_asr].used THEN |
Label(rtl[_asr].label); |
Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- n *) |
Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- x *) |
Word2(0F035H, 15); (* AND #15, R5 *) |
Word1(2400H + 3); (* JZ L1 *) |
(* L2: *) |
Word1(1104H); (* RRA R4 *) |
Word1(8315H); (* SUB #1, R5 *) |
Word1(2000H + 400H - 3); (* JNZ L2 *) |
(* L1: *) |
Word1(4130H) (* RET *) |
END; |
(* _ror (n, x: INTEGER): INTEGER *) |
IF rtl[_ror].used THEN |
Label(rtl[_ror].label); |
Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- n *) |
Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- x *) |
Word2(0F035H, 15); (* AND #15, R5 *) |
Word1(2400H + 5); (* JZ L1 *) |
Word1(4406H); (* MOV R4, R6 *) |
(* L2: *) |
Word1(1006H); (* RRC R6 *) |
Word1(1004H); (* RRC R4 *) |
Word1(8315H); (* SUB #1, R5 *) |
Word1(2000H + 400H - 4); (* JNZ L2 *) |
(* L1: *) |
Word1(4130H) (* RET *) |
END; |
(* _lsr (n, x: INTEGER): INTEGER *) |
IF rtl[_lsr].used THEN |
Label(rtl[_lsr].label); |
Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- n *) |
Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- x *) |
Word2(0F035H, 15); (* AND #15, R5 *) |
Word1(2400H + 4); (* JZ L1 *) |
(* L2: *) |
Word1(0C312H); (* BIC #1, SR *) |
Word1(1004H); (* RRC R4 *) |
Word1(8315H); (* SUB #1, R5 *) |
Word1(2000H + 400H - 4); (* JNZ L2 *) |
(* L1: *) |
Word1(4130H) (* RET *) |
END; |
(* _set (b, a: INTEGER): SET *) |
IF rtl[_set].used THEN |
Label(rtl[_set].label); |
Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- b *) |
Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- a *) |
Word1(9504H); (* CMP R5, R4 *) |
Word1(3800H + 24); (* JL L1 *) |
Word2(9035H, 16); (* CMP #16, R5 *) |
Word1(3400H + 21); (* JGE L1 *) |
Word1(9304H); (* CMP #0, R4 *) |
Word1(3800H + 19); (* JL L1 *) |
Word2(9034H, 16); (* CMP #16, R4 *) |
Word1(3800H + 2); (* JL L2 *) |
Word2(4034H, 15); (* MOV #15, R4 *) |
(* L2: *) |
Word1(9305H); (* CMP #0, R5 *) |
Word1(3400H + 1); (* JGE L3 *) |
Word1(4305H); (* MOV #0, R5 *) |
(* L3: *) |
Word1(8504H); (* SUB R5, R4 *) |
Word1(5404H); (* ADD R4, R4 *) |
Word2(5034H, bits_offs); (* ADD bits_offs, R4 *) |
Word1(4424H); (* MOV @R4, R4 *) |
Word1(5505H); (* ADD R5, R5 *) |
Word1(5405H); (* ADD R4, R5 *) |
Word2(5035H, bits); (* ADD bits, R5 *) |
Word1(4524H); (* MOV @R5, R4 *) |
Word1(4130H); (* MOV @SP+, PC *) |
(* L1: *) |
Word1(4304H); (* MOV #0, R4 *) |
Word1(4130H) (* RET *) |
END; |
(* _set1 (a: INTEGER): SET *) |
IF rtl[_set1].used THEN |
Label(rtl[_set1].label); |
Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- a *) |
Word2(0B034H, 0FFF0H); (* BIT #0FFF0H, R4 *) |
Word1(2000H + 5); (* JNZ L1 *) |
Word1(5404H); (* ADD R4, R4 *) |
Word2(5034H, bits); (* ADD bits, R4 *) |
Word1(4424H); (* MOV @R4, R4 *) |
Word1(4130H); (* MOV @SP+, PC *) |
(* L1: *) |
Word1(4304H); (* MOV #0, R4 *) |
Word1(4130H) (* RET *) |
END; |
(* _in2 (i, s: INTEGER): BOOLEAN *) |
IF rtl[_in2].used THEN |
Label(rtl[_in2].label); |
Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- i *) |
Word1(5404H); (* ADD R4, R4 *) |
Word2(5034H, bits); (* ADD bits, R4 *) |
Word1(4424H); (* MOV @R4, R4 *) |
Word2(0F114H, 4); (* AND 4(SP), R4 *) |
Word1(2400H + 1); (* JZ L1 *) |
Word1(4314H); (* MOV #1, R4 *) |
(* L1: *) |
Word1(4130H) (* RET *) |
END; |
(* _in (s, i: INTEGER): BOOLEAN *) |
IF rtl[_in].used THEN |
Label(rtl[_in].label); |
Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- i *) |
Word2(0B034H, 0FFF0H); (* BIT #0FFF0H, R4 *) |
Word1(2000H + 9); (* JNZ L2 *) |
Word1(5404H); (* ADD R4, R4 *) |
Word2(5034H, bits); (* ADD bits, R4 *) |
Word1(4424H); (* MOV @R4, R4 *) |
Word2(0F114H, 2); (* AND 2(SP), R4 *) |
Word1(2400H + 3); (* JZ L1 *) |
Word1(4314H); (* MOV #1, R4 *) |
Word1(4130H); (* MOV @SP+, PC *) |
(* L2: *) |
Word1(4304H); (* MOV #0, R4 *) |
(* L1: *) |
Word1(4130H) (* RET *) |
END; |
(* _incl (VAR s: SET; i: INTEGER) *) |
IF rtl[_incl].used THEN |
Label(rtl[_incl].label); |
Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- i *) |
Word2(0B034H, 0FFF0H); (* BIT #0FFF0H, R4 *) |
Word1(2000H + 8); (* JNZ L1 *) |
Word1(5404H); (* ADD R4, R4 *) |
Word2(5034H, bits); (* ADD bits, R4 *) |
Word1(4424H); (* MOV @R4, R4 *) |
Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- @s *) |
Word2(0D485H, 0); (* BIS R4, 0(R5) *) |
(* L1: *) |
Word1(4130H) (* RET *) |
END; |
(* _excl (VAR s: SET; i: INTEGER) *) |
IF rtl[_excl].used THEN |
Label(rtl[_excl].label); |
Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- i *) |
Word2(0B034H, 0FFF0H); (* BIT #0FFF0H, R4 *) |
Word1(2000H + 8); (* JNZ L1 *) |
Word1(5404H); (* ADD R4, R4 *) |
Word2(5034H, bits); (* ADD bits, R4 *) |
Word1(4424H); (* MOV @R4, R4 *) |
Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- @s *) |
Word2(0C485H, 0); (* BIC R4, 0(R5) *) |
(* L1: *) |
Word1(4130H) (* RET *) |
END; |
(* _rot (len, adr: INTEGER) *) |
IF rtl[_rot].used THEN |
Label(rtl[_rot].label); |
Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- len *) |
Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- adr *) |
Word1(8314H); (* SUB #1, R4 *) |
Word1(5404H); (* ADD R4, R4 *) |
Word1(1225H); (* PUSH @R5 *) |
Word1(4406H); (* MOV R4, R6 *) |
(* L1: *) |
Word3(4595H, 2, 0); (* MOV 2(R5), 0(R5) *) |
Word1(5325H); (* ADD #2, R5 *) |
Word1(8326H); (* SUB #2, R6 *) |
Word1(2000H + 400H - 6); (* JNZ L1 *) |
Word2(41B5H, 0); (* MOV @SP+, 0(R5) *) |
Word1(4130H) (* RET *) |
END; |
(* _divmod (b, a: INTEGER): INTEGER (* res -> R4, mod -> R5 *) *) |
IF rtl[_divmod].used THEN |
Label(rtl[_divmod].label); |
Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- a *) |
Word1(4304H); (* MOV #0, R4 *) |
(* L1: *) |
Word2(4116H, 2); (* MOV 2(SP), R6; R6 <- b *) |
Word1(9605H); (* CMP R6, R5 *) |
Word1(3800H + 17); (* JL L3 *) |
Word1(4327H); (* MOV #2, R7 *) |
Word1(5606H); (* ADD R6, R6 *) |
(* L4: *) |
Word1(9306H); (* CMP #0, R6 *) |
Word1(2400H + 6); (* JZ L2 *) |
Word1(3800H + 5); (* JL L2 *) |
Word1(9605H); (* CMP R6, R5 *) |
Word1(3800H + 3); (* JL L2 *) |
Word1(5606H); (* ADD R6, R6 *) |
Word1(5707H); (* ADD R7, R7 *) |
Word1(3C00H + 400H - 8); (* JMP L4 *) |
(* L2: *) |
Word1(0C312H); (* BIC #1, SR *) |
Word1(1006H); (* RRC R6 *) |
Word1(0C312H); (* BIC #1, SR *) |
Word1(1007H); (* RRC R7 *) |
Word1(8605H); (* SUB R6, R5 *) |
Word1(5704H); (* ADD R7, R4 *) |
Word1(3C00H + 400H - 21); (* JMP L1 *) |
(* L3: *) |
(*----------- (a < 0) --------------*) |
(* L1: *) |
Word1(9305H); (* CMP #0, R5 *) |
Word1(3400H + 23); (* JGE L3 *) |
Word2(4116H, 2); (* MOV 2(SP), R6; R6 <- b *) |
Word1(4327H); (* MOV #2, R7 *) |
Word1(5606H); (* ADD R6, R6 *) |
Word1(0E335H); (* XOR #-1, R5 *) |
Word1(5315H); (* ADD #1, R5 *) |
(* L4: *) |
Word1(9306H); (* CMP #0, R6 *) |
Word1(2400H + 6); (* JZ L2 *) |
Word1(3800H + 5); (* JL L2 *) |
Word1(9605H); (* CMP R6, R5 *) |
Word1(3800H + 3); (* JL L2 *) |
Word1(5606H); (* ADD R6, R6 *) |
Word1(5707H); (* ADD R7, R7 *) |
Word1(3C00H + 400H - 8); (* JMP L4 *) |
(* L2: *) |
Word1(0E335H); (* XOR #-1, R5 *) |
Word1(5315H); (* ADD #1, R5 *) |
Word1(0C312H); (* BIC #1, SR *) |
Word1(1006H); (* RRC R6 *) |
Word1(0C312H); (* BIC #1, SR *) |
Word1(1007H); (* RRC R7 *) |
Word1(5605H); (* ADD R6, R5 *) |
Word1(8704H); (* SUB R7, R4 *) |
Word1(3C00H + 400H - 25); (* JMP L1 *) |
(* L3: *) |
Word1(4130H) (* RET *) |
END; |
(* _mul (a, b: INTEGER): INTEGER *) |
IF rtl[_mul].used THEN |
Label(rtl[_mul].label); |
Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- a *) |
Word2(4116H, 4); (* MOV 4(SP), R6; R6 <- b *) |
Word1(4304H); (* MOV #0, R4; res := 0 *) |
Word1(9306H); (* CMP #0, R6 *) |
Word1(2400H + 7); (* JZ L1 *) |
(* L2: *) |
Word1(0B316H); (* BIT #1, R6 *) |
Word1(2400H + 1); (* JZ L3 *) |
Word1(5504H); (* ADD R5, R4 *) |
(* L3: *) |
Word1(5505H); (* ADD R5, R5 *) |
Word1(0C312H); (* BIC #1, SR *) |
Word1(1006H); (* RRC R6 *) |
Word1(2000H + 400H - 7); (* JNZ L2 *) |
(* L1: *) |
Word1(4130H) (* RET *) |
END; |
(* _error (module, err, line: INTEGER) *) |
IF rtl[_error].used THEN |
Label(rtl[_error].label); |
Word1(0C232H); (* BIC #8, SR; DINT *) |
Word1(4303H); (* MOV R3, R3; NOP *) |
Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- module *) |
Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- err *) |
Word2(4116H, 6); (* MOV 6(SP), R6; R6 <- line *) |
Word2(4211H, sp); (* MOV sp(SR), SP *) |
Word1(1206H); (* PUSH R6 *) |
Word1(1204H); (* PUSH R4 *) |
Word1(1205H); (* PUSH R5 *) |
Word2(4214H, trap); (* MOV trap(SR), R4 *) |
Word1(9304H); (* TST R4 *) |
Word1(2400H + 1); (* JZ L *) |
Word1(1284H); (* CALL R4 *) |
(* L: *) |
Word2(04032H, 0F0H) (* MOV CPUOFF+OSCOFF+SCG0+SCG1, SR *) |
END; |
(* _new (t, size: INTEGER; VAR ptr: INTEGER) *) |
IF rtl[_new].used THEN |
Label(rtl[_new].label); |
Word1(1202H); (* PUSH SR *) |
Word1(4302H); (* MOV #0, SR *) |
Word1(4303H); (* NOP *) |
Word1(4104H); (* MOV SP, R4 *) |
Word2(8034H, 16); (* SUB #16, R4 *) |
Word1(4005H + 100H * HP); (* MOV HP, R5 *) |
Word2(5115H, 6); (* ADD 6(SP), R5 *) |
Word1(9504H); (* CMP R5, R4 *) |
Word2(4114H, 8); (* MOV 8(SP), R4 *) |
Word1(3800H + 12); (* JL L1 *) |
Word3(4190H + HP, 4, 0); (* MOV 4(SP), 0(HP) *) |
Word1(5320H + HP); (* ADD #2, HP *) |
Word2(4084H + 100H * HP, 0); (* MOV HP, 0(R4) *) |
(* L3 *) |
Word2(4380H + HP, 0); (* MOV #0, 0(HP) *) |
Word1(5320H + HP); (* ADD #2, HP *) |
Word1(9500H + HP); (* CMP R5, HP *) |
Word1(3800H + 400H - 5); (* JL L3 *) |
Word1(3C00H + 2); (* JMP L2 *) |
(* L1 *) |
Word2(4384H, 0); (* MOV #0, 0(R4) *) |
(* L2 *) |
Word1(1300H) (* RETI *) |
END; |
(* _guardrec (t0, t1: INTEGER): INTEGER *) |
IF rtl[_guardrec].used THEN |
Label(rtl[_guardrec].label); |
Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- t0 *) |
Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- t1 *) |
Word2(4036H, types); (* MOV #types, R6 *) |
(* L3: *) |
Word1(9305H); (* CMP #0, R5 *) |
Word1(2400H + 8); (* JZ L1 *) |
Word1(9405H); (* CMP R4, R5 *) |
Word1(2400H + 10); (* JZ L2 *) |
Word1(5505H); (* ADD R5, R5 *) |
Word1(0E335H); (* XOR #-1, R5 *) |
Word1(5315H); (* ADD #1, R5 *) |
Word1(5605H); (* ADD R6, R5 *) |
Word1(4525H); (* MOV @R5, R5 *) |
Word1(3C00H + 400H - 10); (* JMP L3 *) |
(* L1: *) |
Word1(9405H); (* CMP R4, R5 *) |
Word1(2400H + 2); (* JZ L2 *) |
Word1(4304H); (* MOV #0, R4 *) |
Word1(4130H); (* MOV @SP+, PC *) |
(* L2: *) |
Word1(4314H); (* MOV #1, R4 *) |
Word1(4130H) (* RET *) |
END; |
(* _is (t, p: INTEGER): INTEGER *) |
IF rtl[_is].used THEN |
Label(rtl[_is].label); |
Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- p *) |
Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- t *) |
Word1(9304H); (* TST R4 *) |
Word1(2400H + 2); (* JZ L *) |
Word2(4414H, -2); (* MOV -2(R4), R4 *) |
(* L: *) |
Word1(1204H); (* PUSH R4 *) |
Word1(1205H); (* PUSH R5 *) |
Call(rtl[_guardrec].label); (* CALL _guardrec *) |
Word1(5221H); (* ADD #4, SP *) |
Word1(4130H) (* RET *) |
END; |
(* _guard (t, p: INTEGER): INTEGER *) |
IF rtl[_guard].used THEN |
Label(rtl[_guard].label); |
Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- p *) |
Word1(4314H); (* MOV #1, R4 *) |
Word1(4525H); (* MOV @R5, R5 *) |
Word1(9305H); (* TST R5 *) |
Word1(2400H + 9); (* JZ L *) |
Word2(4515H, -2); (* MOV -2(R5), R5 *) |
Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- t *) |
Word1(1205H); (* PUSH R5 *) |
Word1(1204H); (* PUSH R4 *) |
Call(rtl[_guardrec].label); (* CALL _guardrec *) |
Word1(5221H); (* ADD #4, SP *) |
(* L: *) |
Word1(4130H) (* RET *) |
END; |
(* _move (bytes, dest, source: INTEGER) *) |
IF rtl[_move].used THEN |
Label(rtl[_move].label); |
Word2(4116H, 2); (* MOV 2(SP), R6; R6 <- bytes *) |
Word2(4117H, 4); (* MOV 4(SP), R7; R7 <- dest *) |
Word2(4115H, 6); (* MOV 6(SP), R5; R5 <- source *) |
Word1(9306H); (* CMP #0, R6 *) |
Word1(3800H + 6); (* JL L1 *) |
Word1(2400H + 5); (* JZ L1 *) |
(* L2: *) |
Word2(45F7H, 0); (* MOV.B @R5+, 0(R7) *) |
Word1(5317H); (* ADD #1, R7 *) |
Word1(8316H); (* SUB #1, R6 *) |
Word1(2000H + 400H - 5); (* JNZ L2 *) |
(* L1: *) |
Word1(4130H) (* RET *) |
END; |
(* _arrcpy (base_size, len_dst, dst, len_src, src: INTEGER) *) |
IF rtl[_arrcpy].used THEN |
Label(rtl[_arrcpy].label); |
Word3(9191H, 8, 4); (* CMP 8(SP), 4(SP) *) |
Word1(3800H + 18); (* JL L1 *) |
Word2(1211H, 12); (* PUSH 12(SP) *) |
Word2(1211H, 10); (* PUSH 10(SP) *) |
Word2(1211H, 14); (* PUSH 14(SP) *) |
Word2(1211H, 10); (* PUSH 10(SP) *) |
Call(rtl[_mul].label); (* CALL _mul *) |
Word1(5221H); (* ADD #4, SP *) |
Word1(1204H); (* PUSH R4 *) |
Call(rtl[_move].label); (* CALL _move *) |
Word2(5031H, 6); (* ADD #6, SP *) |
Word1(4314H); (* MOV #1, R4 *) |
Word1(4130H); (* RET *) |
(* L1 *) |
Word1(4304H); (* MOV #0, R4 *) |
Word1(4130H) (* RET *) |
END; |
(* _length (len, str: INTEGER): INTEGER *) |
IF rtl[_length].used THEN |
Label(rtl[_length].label); |
Word2(4116H, 2); (* MOV 2(SP), R6; R6 <- len *) |
Word2(4117H, 4); (* MOV 4(SP), R7; R7 <- str *) |
Word1(4304H); (* MOV #0, R4; res := 0 *) |
(* L2: *) |
Word1(4775H); (* MOV.B @R7+, R5 *) |
Word1(9305H); (* CMP #0, R5 *) |
Word1(2400H + 3); (* JZ L1 *) |
Word1(5314H); (* ADD #1, R4 *) |
Word1(8316H); (* SUB #1, R6 *) |
Word1(2000H + 400H - 6); (* JNZ L2 *) |
(* L1: *) |
Word1(4130H) (* RET *) |
END; |
(* _strcmp (op, len2, str2, len1, str1: INTEGER): BOOLEAN *) |
IF rtl[_strcmp].used THEN |
Label(rtl[_strcmp].label); |
Word2(4116H, 4); (* MOV 4(SP), R6; R6 <- len2 *) |
Word2(4117H, 8); (* MOV 8(SP), R7; R7 <- len1 *) |
Word1(9607H); (* CMP R6, R7 *) |
Word1(3400H + 1); (* JGE L5 *) |
Word1(4706H); (* MOV R7, R6 *) |
(* L5: *) |
Word1(1206H); (* PUSH R6 *) |
Word2(4116H, 12); (* MOV 12(SP), R6; R6 <- str1 *) |
Word2(4117H, 8); (* MOV 8(SP), R7; R7 <- str2 *) |
(* L3: *) |
Word2(9381H, 0); (* CMP #0, 0(SP) *) |
Word1(2400H + 11); (* JZ L1 *) |
Word1(4674H); (* MOV.B @R6+, R4 *) |
Word1(4775H); (* MOV.B @R7+, R5 *) |
Word2(8391H, 0); (* SUB #1, 0(SP) *) |
Word1(9405H); (* CMP R4, R5 *) |
Word1(2400H + 2); (* JZ L2 *) |
Word1(8504H); (* SUB R5, R4 *) |
Word1(3C00H + 5); (* JMP L4 *) |
(* L2: *) |
Word1(9304H); (* CMP #0, R4 *) |
Word1(2000H + 400H - 13); (* JNZ L3 *) |
Word1(3C00H + 2); (* JMP L4 *) |
(* L1: *) |
Word2(4034H, 8000H); (* MOV #8000H, R4 *) |
(* L4: *) |
Word1(5321H); (* ADD #2, SP *) |
Word2(9034H, 8000H); (* CMP #8000H, R4 *) |
Word1(2000H + 18); (* JNZ L6 *) |
Word2(4116H, 4); (* MOV 4(SP), R6; R6 <- len2 *) |
Word2(4117H, 8); (* MOV 8(SP), R7; R7 <- len1 *) |
Word1(9607H); (* CMP R6, R7 *) |
Word1(2400H + 11); (* JZ L7 *) |
Word1(3800H + 4); (* JL L8 *) |
Word2(5116H, 10); (* ADD 10(SP), R6 *) |
Word1(4664H); (* MOV.B @R6, R4 *) |
Word1(3C00H + 7); (* JMP L6 *) |
(* L8: *) |
Word2(5117H, 6); (* ADD 6(SP), R7 *) |
Word1(4764H); (* MOV.B @R7, R4 *) |
Word1(0E334H); (* XOR #-1, R4 *) |
Word1(5314H); (* ADD #1, R4 *) |
Word1(3C00H + 1); (* JMP L6 *) |
(* L7: *) |
Word1(4304H); (* MOV #0, R4 *) |
(* L6: *) |
Word2(5110H, 2); (* ADD 2(SP), PC; PC <- PC + op *) |
Word1(9304H); (* CMP #0, R4 *) |
Word1(4314H); (* MOV #1, R4 *) |
Word1(2400H + 1); (* JZ L *) |
Word1(4304H); (* MOV #0, R4 *) |
(* L *) |
Word1(4130H); (* RET *) |
Word1(4303H); (* NOP *) |
Word1(9304H); (* CMP #0, R4 *) |
Word1(4314H); (* MOV #1, R4 *) |
Word1(2000H + 1); (* JNZ L *) |
Word1(4304H); (* MOV #0, R4 *) |
(* L *) |
Word1(4130H); (* RET *) |
Word1(4303H); (* NOP *) |
Word1(9304H); (* CMP #0, R4 *) |
Word1(4314H); (* MOV #1, R4 *) |
Word1(3800H + 1); (* JL L *) |
Word1(4304H); (* MOV #0, R4 *) |
(* L *) |
Word1(4130H); (* RET *) |
Word1(4303H); (* NOP *) |
Word1(9304H); (* CMP #0, R4 *) |
Word1(4314H); (* MOV #1, R4 *) |
Word1(3800H + 2); (* JL L *) |
Word1(2400H + 1); (* JZ L *) |
Word1(4304H); (* MOV #0, R4 *) |
(* L *) |
Word1(4130H); (* RET *) |
Word1(9304H); (* CMP #0, R4 *) |
Word1(4304H); (* MOV #0, R4 *) |
Word1(3800H + 2); (* JL L *) |
Word1(2400H + 1); (* JZ L *) |
Word1(4314H); (* MOV #1, R4 *) |
(* L *) |
Word1(4130H); (* RET *) |
Word1(9304H); (* CMP #0, R4 *) |
Word1(4314H); (* MOV #1, R4 *) |
Word1(3400H + 1); (* JGE L *) |
Word1(4304H); (* MOV #0, R4 *) |
(* L *) |
Word1(4130H) (* RET *) |
END |
END Gen; |
PROCEDURE Set* (idx, label: INTEGER); |
BEGIN |
rtl[idx].label := label; |
rtl[idx].used := FALSE |
END Set; |
PROCEDURE Used* (idx: INTEGER); |
BEGIN |
rtl[idx].used := TRUE; |
IF (idx = _guard) OR (idx = _is) THEN |
rtl[_guardrec].used := TRUE |
ELSIF idx = _arrcpy THEN |
rtl[_move].used := TRUE; |
rtl[_mul].used := TRUE |
END |
END Used; |
PROCEDURE Init* (pLabel, pWord, pCall: EMITPROC; ramSize: INTEGER); |
BEGIN |
Label := pLabel; |
Word := pWord; |
Call := pCall; |
IF ramSize > 2048 THEN |
ram := 1100H |
ELSE |
ram := 200H |
END; |
trap := ram; |
int := trap + 2 |
END Init; |
END MSP430RTL. |
/programs/develop/oberon07/Source/PARS.ob07 |
---|
7,7 → 7,7 |
MODULE PARS; |
IMPORT PROG, SCAN, ARITH, STRINGS, ERRORS, LISTS, CODE, CONSOLE, PATHS, MACHINE, C := COLLECTIONS, mConst := CONSTANTS; |
IMPORT PROG, SCAN, ARITH, STRINGS, ERRORS, LISTS, IL, CONSOLE, PATHS, UTILS, C := COLLECTIONS, mConst := CONSTANTS; |
CONST |
24,6 → 24,12 |
PARSER* = POINTER TO rPARSER; |
POSITION* = RECORD (SCAN.POSITION) |
parser*: PARSER |
END; |
EXPR* = RECORD |
obj*: INTEGER; |
37,7 → 43,7 |
STATPROC = PROCEDURE (parser: PARSER); |
EXPRPROC = PROCEDURE (parser: PARSER; VAR e: EXPR); |
RETPROC = PROCEDURE (parser: PARSER; e: EXPR; t: PROG.TYPE_; pos: SCAN.POSITION): BOOLEAN; |
RETPROC = PROCEDURE (parser: PARSER; e: EXPR; t: PROG.TYPE_; pos: POSITION): BOOLEAN; |
rPARSER = RECORD (C.ITEM) |
83,34 → 89,40 |
END destroy; |
PROCEDURE error* (parser: PARSER; pos: SCAN.POSITION; errno: INTEGER); |
PROCEDURE getpos (parser: PARSER; VAR pos: POSITION); |
BEGIN |
ERRORS.errormsg(parser.fname, pos.line, pos.col, errno) |
pos.line := parser.lex.pos.line; |
pos.col := parser.lex.pos.col; |
pos.parser := parser |
END getpos; |
PROCEDURE error* (pos: POSITION; errno: INTEGER); |
BEGIN |
ERRORS.ErrorMsg(pos.parser.fname, pos.line, pos.col, errno) |
END error; |
PROCEDURE check* (condition: BOOLEAN; parser: PARSER; pos: SCAN.POSITION; errno: INTEGER); |
PROCEDURE check* (condition: BOOLEAN; pos: POSITION; errno: INTEGER); |
BEGIN |
IF ~condition THEN |
error(parser, pos, errno) |
error(pos, errno) |
END |
END check; |
PROCEDURE check1* (condition: BOOLEAN; parser: PARSER; errno: INTEGER); |
VAR |
pos: POSITION; |
BEGIN |
IF ~condition THEN |
error(parser, parser.lex.pos, errno) |
getpos(parser, pos); |
error(pos, errno) |
END |
END check1; |
PROCEDURE getpos (parser: PARSER; VAR pos: SCAN.POSITION); |
BEGIN |
pos := parser.lex.pos |
END getpos; |
PROCEDURE Next* (parser: PARSER); |
VAR |
errno: INTEGER; |
118,6 → 130,14 |
BEGIN |
SCAN.Next(parser.scanner, parser.lex); |
errno := parser.lex.error; |
IF (errno = 0) & (program.target.sys = mConst.Target_iMSP430) THEN |
IF parser.lex.sym = SCAN.lxFLOAT THEN |
errno := -SCAN.lxERROR13 |
ELSIF (parser.lex.sym = SCAN.lxCHAR) & (parser.lex.value.typ = ARITH.tWCHAR) THEN |
errno := -SCAN.lxERROR10 |
END |
END; |
IF errno # 0 THEN |
check1(FALSE, parser, errno) |
END; |
125,10 → 145,10 |
END Next; |
PROCEDURE NextPos* (parser: PARSER; VAR pos: SCAN.POSITION); |
PROCEDURE NextPos (parser: PARSER; VAR pos: POSITION); |
BEGIN |
Next(parser); |
pos := parser.lex.pos |
getpos(parser, pos) |
END NextPos; |
180,15 → 200,12 |
VAR |
name: SCAN.IDENT; |
parser2: PARSER; |
pos: SCAN.POSITION; |
pos: POSITION; |
alias: BOOLEAN; |
unit: PROG.UNIT; |
ident: PROG.IDENT; |
units: PROG.UNITS; |
BEGIN |
units := program.units; |
alias := FALSE; |
REPEAT |
199,8 → 216,8 |
getpos(parser, pos); |
IF ~alias THEN |
ident := parser.unit.idents.add(parser.unit, name, PROG.idMODULE); |
check(ident # NIL, parser, pos, 30) |
ident := PROG.addIdent(parser.unit, name, PROG.idMODULE); |
check(ident # NIL, pos, 30) |
END; |
Next(parser); |
207,10 → 224,10 |
IF (parser.sym = SCAN.lxCOMMA) OR (parser.sym = SCAN.lxSEMI) THEN |
alias := FALSE; |
unit := units.get(units, name); |
unit := PROG.getUnit(program, name); |
IF unit # NIL THEN |
check(unit.closed, parser, pos, 31) |
check(unit.closed, pos, 31) |
ELSE |
parser2 := parser.create(parser.path, parser.lib_path, |
parser.StatSeq, parser.expression, parser.designator, parser.chkreturn); |
220,9 → 237,9 |
destroy(parser2); |
parser2 := parser.create(parser.lib_path, parser.lib_path, |
parser.StatSeq, parser.expression, parser.designator, parser.chkreturn); |
check(parser2.open(parser2, name.s), parser, pos, 29) |
check(parser2.open(parser2, name.s), pos, 29) |
ELSE |
check(FALSE, parser, pos, 29) |
error(pos, 29) |
END |
END; |
257,7 → 274,7 |
BEGIN |
ASSERT(parser.sym = SCAN.lxIDENT); |
ident := parser.unit.idents.get(parser.unit, parser.lex.ident, FALSE); |
ident := PROG.getIdent(parser.unit, parser.lex.ident, FALSE); |
IF ~forward THEN |
check1(ident # NIL, parser, 48) |
267,7 → 284,7 |
unit := ident.unit; |
ExpectSym(parser, SCAN.lxPOINT); |
ExpectSym(parser, SCAN.lxIDENT); |
ident := unit.idents.get(unit, parser.lex.ident, FALSE); |
ident := PROG.getIdent(unit, parser.lex.ident, FALSE); |
check1((ident # NIL) & ident.export, parser, 48) |
END |
312,7 → 329,6 |
END; |
ARITH.setbool(v, bool) |
END strcmp; |
319,7 → 335,7 |
PROCEDURE ConstExpression* (parser: PARSER; VAR v: ARITH.VALUE); |
VAR |
e: EXPR; |
pos: SCAN.POSITION; |
pos: POSITION; |
BEGIN |
getpos(parser, pos); |
326,7 → 342,7 |
parser.constexp := TRUE; |
parser.expression(parser, e); |
parser.constexp := FALSE; |
check(e.obj = eCONST, parser, pos, 62); |
check(e.obj = eCONST, pos, 62); |
v := e.value |
END ConstExpression; |
335,7 → 351,7 |
VAR |
name: SCAN.IDENT; |
export: BOOLEAN; |
pos: SCAN.POSITION; |
pos: POSITION; |
BEGIN |
ASSERT(parser.sym = SCAN.lxIDENT); |
355,7 → 371,7 |
Next(parser) |
END; |
check(rec.fields.add(rec, name, export), parser, pos, 30); |
check(PROG.addField(rec, name, export), pos, 30); |
IF parser.sym = SCAN.lxCOMMA THEN |
ExpectSym(parser, SCAN.lxIDENT) |
391,7 → 407,7 |
exit := FALSE; |
WHILE (parser.sym = SCAN.lxIDENT) & ~exit DO |
check1(type.params.add(type, parser.lex.ident, vPar), parser, 30); |
check1(PROG.addParam(type, parser.lex.ident, vPar), parser, 30); |
Next(parser); |
IF parser.sym = SCAN.lxCOMMA THEN |
ExpectSym(parser, SCAN.lxIDENT) |
412,13 → 428,13 |
t1 := t0; |
WHILE dim > 0 DO |
t1 := program.enterType(program, PROG.tARRAY, -1, 0, parser.unit); |
t1 := PROG.enterType(program, PROG.tARRAY, -1, 0, parser.unit); |
t1.base := t0; |
t0 := t1; |
DEC(dim) |
END; |
type.params.set(type, t1); |
PROG.setParams(type, t1); |
Next(parser); |
exit := TRUE |
ELSE |
449,7 → 465,7 |
ExpectSym(parser, SCAN.lxIDENT); |
ident := QIdent(parser, FALSE); |
check1(ident.typ = PROG.idTYPE, parser, 68); |
check1((ident.type.typ # PROG.tRECORD) & (ident.type.typ # PROG.tARRAY), parser, 69); |
check1(~(ident.type.typ IN {PROG.tRECORD, PROG.tARRAY}), parser, 69); |
check1( ~(ODD(type.call) & (ident.type.typ = PROG.tREAL)), parser, 113); |
type.base := ident.type; |
Next(parser) |
461,43 → 477,72 |
END FormalParameters; |
PROCEDURE sysflag (parser: PARSER): INTEGER; |
PROCEDURE sysflag (parser: PARSER; proc: BOOLEAN): INTEGER; |
VAR |
res: INTEGER; |
res, sf: INTEGER; |
BEGIN |
IF parser.lex.s = "stdcall" THEN |
sf := PROG.sf_stdcall |
ELSIF parser.lex.s = "stdcall64" THEN |
sf := PROG.sf_stdcall64 |
ELSIF parser.lex.s = "ccall" THEN |
sf := PROG.sf_ccall |
ELSIF parser.lex.s = "ccall16" THEN |
sf := PROG.sf_ccall16 |
ELSIF parser.lex.s = "win64" THEN |
sf := PROG.sf_win64 |
ELSIF parser.lex.s = "systemv" THEN |
sf := PROG.sf_systemv |
ELSIF parser.lex.s = "windows" THEN |
sf := PROG.sf_windows |
ELSIF parser.lex.s = "linux" THEN |
sf := PROG.sf_linux |
ELSIF parser.lex.s = "code" THEN |
sf := PROG.sf_code |
ELSIF parser.lex.s = "noalign" THEN |
sf := PROG.sf_noalign |
ELSE |
check1(FALSE, parser, 124) |
END; |
check1(sf IN program.target.sysflags, parser, 125); |
IF proc THEN |
check1(sf IN PROG.proc_flags, parser, 123) |
ELSE |
check1(sf IN PROG.rec_flags, parser, 123) |
END; |
CASE sf OF |
|PROG.sf_stdcall: |
res := PROG.stdcall |
ELSIF parser.lex.s = "stdcall64" THEN |
|PROG.sf_stdcall64: |
res := PROG.stdcall64 |
ELSIF parser.lex.s = "ccall" THEN |
|PROG.sf_ccall: |
res := PROG.ccall |
ELSIF parser.lex.s = "ccall16" THEN |
|PROG.sf_ccall16: |
res := PROG.ccall16 |
ELSIF parser.lex.s = "win64" THEN |
|PROG.sf_win64: |
res := PROG.win64 |
ELSIF parser.lex.s = "systemv" THEN |
|PROG.sf_systemv: |
res := PROG.systemv |
ELSIF parser.lex.s = "windows" THEN |
|PROG.sf_code: |
res := PROG.code |
|PROG.sf_windows: |
IF program.target.sys IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL} THEN |
res := PROG.stdcall |
ELSIF program.target.sys IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64} THEN |
res := PROG.win64 |
ELSE |
check1(FALSE, parser, 118) |
END |
ELSIF parser.lex.s = "linux" THEN |
IF program.target.sys = mConst.Target_iELF32 THEN |
|PROG.sf_linux: |
IF program.target.sys IN {mConst.Target_iELF32, mConst.Target_iELFSO32} THEN |
res := PROG.ccall16 |
ELSIF program.target.sys = mConst.Target_iELF64 THEN |
ELSIF program.target.sys IN {mConst.Target_iELF64, mConst.Target_iELFSO64} THEN |
res := PROG.systemv |
ELSE |
check1(FALSE, parser, 119) |
END |
ELSIF parser.lex.s = "noalign" THEN |
|PROG.sf_noalign: |
res := PROG.noalign |
ELSE |
res := 0 |
END |
RETURN res |
504,11 → 549,11 |
END sysflag; |
PROCEDURE procflag (parser: PARSER; VAR import: CODE.IMPORT_PROC; isProc: BOOLEAN): INTEGER; |
PROCEDURE procflag (parser: PARSER; VAR import: IL.IMPORT_PROC; isProc: BOOLEAN): INTEGER; |
VAR |
call: INTEGER; |
dll, proc: SCAN.LEXSTR; |
pos: SCAN.POSITION; |
pos: POSITION; |
BEGIN |
518,12 → 563,7 |
getpos(parser, pos); |
check1(parser.unit.sysimport, parser, 54); |
Next(parser); |
call := sysflag(parser); |
IF program.target.bit_depth = 64 THEN |
check1(call IN PROG.callconv64, parser, 117) |
ELSIF program.target.bit_depth = 32 THEN |
check1(call IN PROG.callconv32, parser, 63) |
END; |
call := sysflag(parser, TRUE); |
Next(parser); |
IF parser.sym = SCAN.lxMINUS THEN |
Next(parser); |
539,20 → 579,21 |
ExpectSym(parser, SCAN.lxSTRING); |
proc := parser.lex.s; |
Next(parser); |
import := CODE.AddImp(dll, proc) |
import := IL.AddImp(dll, proc) |
END; |
checklex(parser, SCAN.lxRSQUARE); |
Next(parser) |
ELSE |
IF program.target.bit_depth = 32 THEN |
call := PROG.default |
ELSIF program.target.bit_depth = 64 THEN |
call := PROG.default64 |
CASE program.target.bit_depth OF |
|16: call := PROG.default16 |
|32: call := PROG.default32 |
|64: call := PROG.default64 |
END |
END; |
IF import # NIL THEN |
check(~(program.target.sys IN {mConst.Target_iELF32, mConst.Target_iELF64}), parser, pos, 70) |
check(~(program.target.sys IN {mConst.Target_iELF32, mConst.Target_iELF64, mConst.Target_iELFSO32, |
mConst.Target_iELFSO64, mConst.Target_iMSP430}), pos, 70) |
END |
RETURN call |
570,12 → 611,12 |
typeSize: ARITH.VALUE; |
ident: PROG.IDENT; |
unit: PROG.UNIT; |
pos, pos2: SCAN.POSITION; |
pos, pos2: POSITION; |
fieldType: PROG.TYPE_; |
baseIdent: SCAN.IDENT; |
a, b: INTEGER; |
RecFlag: INTEGER; |
import: CODE.IMPORT_PROC; |
import: IL.IMPORT_PROC; |
BEGIN |
unit := parser.unit; |
604,11 → 645,11 |
ConstExpression(parser, arrLen); |
check(arrLen.typ = ARITH.tINTEGER, parser, pos, 43); |
check(ARITH.check(arrLen), parser, pos, 39); |
check(ARITH.getInt(arrLen) > 0, parser, pos, 51); |
check(arrLen.typ = ARITH.tINTEGER, pos, 43); |
check(ARITH.check(arrLen), pos, 39); |
check(ARITH.getInt(arrLen) > 0, pos, 51); |
t := program.enterType(program, PROG.tARRAY, -1, ARITH.getInt(arrLen), unit); |
t := PROG.enterType(program, PROG.tARRAY, -1, ARITH.getInt(arrLen), unit); |
IF parser.sym = SCAN.lxCOMMA THEN |
type(parser, t.base, {comma, closed}) |
623,8 → 664,8 |
a := t.length; |
b := t.base.size; |
check(ARITH.mulInt(a, b), parser, pos2, 104); |
check(ARITH.setInt(typeSize, a), parser, pos2, 104); |
check(ARITH.mulInt(a, b), pos2, 104); |
check(ARITH.setInt(typeSize, a), pos2, 104); |
t.size := a; |
t.closed := TRUE |
633,19 → 674,14 |
getpos(parser, pos2); |
Next(parser); |
t := program.enterType(program, PROG.tRECORD, 0, 0, unit); |
t := PROG.enterType(program, PROG.tRECORD, 0, 0, unit); |
t.align := 1; |
IF parser.sym = SCAN.lxLSQUARE THEN |
check1(parser.unit.sysimport, parser, 54); |
Next(parser); |
RecFlag := sysflag(parser); |
IF RecFlag = PROG.noalign THEN |
t.noalign := TRUE |
ELSE |
check1(FALSE, parser, 110) |
END; |
RecFlag := sysflag(parser, FALSE); |
t.noalign := RecFlag = PROG.noalign; |
ExpectSym(parser, SCAN.lxRSQUARE); |
Next(parser) |
END; |
657,14 → 693,14 |
type(parser, t.base, {closed}); |
check(t.base.typ IN {PROG.tRECORD, PROG.tPOINTER}, parser, pos, 52); |
check(t.base.typ IN {PROG.tRECORD, PROG.tPOINTER}, pos, 52); |
IF t.base.typ = PROG.tPOINTER THEN |
t.base := t.base.base; |
check(t.base # NIL, parser, pos, 55) |
check(t.base # NIL, pos, 55) |
END; |
check(~t.base.noalign, parser, pos, 112); |
check(~t.base.noalign, pos, 112); |
checklex(parser, SCAN.lxRROUND); |
Next(parser); |
684,7 → 720,7 |
Next(parser); |
type(parser, fieldType, {closed}); |
check(t.fields.set(t, fieldType), parser, pos2, 104); |
check(PROG.setFields(t, fieldType), pos2, 104); |
IF (fieldType.align > t.align) & ~t.noalign THEN |
t.align := fieldType.align |
699,11 → 735,11 |
t.closed := TRUE; |
CODE.AddRec(t.base.num); |
IL.AddRec(t.base.num); |
IF ~t.noalign THEN |
check(MACHINE.Align(t.size, t.align), parser, pos2, 104); |
check(ARITH.setInt(typeSize, t.size), parser, pos2, 104) |
check(UTILS.Align(t.size, t.align), pos2, 104); |
check(ARITH.setInt(typeSize, t.size), pos2, 104) |
END; |
checklex(parser, SCAN.lxEND); |
713,7 → 749,7 |
ExpectSym(parser, SCAN.lxTO); |
Next(parser); |
t := program.enterType(program, PROG.tPOINTER, program.target.adr, 0, unit); |
t := PROG.enterType(program, PROG.tPOINTER, program.target.adr, 0, unit); |
t.align := program.target.adr; |
getpos(parser, pos); |
725,14 → 761,14 |
type(parser, t.base, {forward}); |
IF t.base # NIL THEN |
check(t.base.typ = PROG.tRECORD, parser, pos, 58) |
check(t.base.typ = PROG.tRECORD, pos, 58) |
ELSE |
unit.pointers.add(unit, t, baseIdent, pos) |
PROG.frwPtr(unit, t, baseIdent, pos) |
END |
ELSIF parser.sym = SCAN.lxPROCEDURE THEN |
NextPos(parser, pos); |
t := program.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit); |
t := PROG.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit); |
t.align := program.target.adr; |
t.call := procflag(parser, import, FALSE); |
FormalParameters(parser, t) |
746,7 → 782,7 |
PROCEDURE IdentDef (parser: PARSER; typ: INTEGER; VAR name: SCAN.IDENT): PROG.IDENT; |
VAR |
ident: PROG.IDENT; |
pos: SCAN.POSITION; |
pos: POSITION; |
BEGIN |
ASSERT(parser.sym = SCAN.lxIDENT); |
753,8 → 789,8 |
name := parser.lex.ident; |
getpos(parser, pos); |
ident := parser.unit.idents.add(parser.unit, name, typ); |
check(ident # NIL, parser, pos, 30); |
ident := PROG.addIdent(parser.unit, name, typ); |
check(ident # NIL, pos, 30); |
ident.pos := pos; |
Next(parser); |
772,7 → 808,7 |
VAR |
ident: PROG.IDENT; |
name: SCAN.IDENT; |
pos: SCAN.POSITION; |
pos: POSITION; |
BEGIN |
IF const THEN |
787,12 → 823,12 |
IF const THEN |
ConstExpression(parser, ident.value); |
IF ident.value.typ = ARITH.tINTEGER THEN |
check(ARITH.check(ident.value), parser, pos, 39) |
check(ARITH.check(ident.value), pos, 39) |
ELSIF ident.value.typ = ARITH.tREAL THEN |
check(ARITH.check(ident.value), parser, pos, 40) |
check(ARITH.check(ident.value), pos, 40) |
END; |
ident.typ := PROG.idCONST; |
ident.type := program.getType(program, ident.value.typ) |
ident.type := PROG.getType(program, ident.value.typ) |
ELSE |
type(parser, ident.type, {}) |
END; |
819,7 → 855,7 |
ELSIF parser.sym = SCAN.lxCOLON THEN |
Next(parser); |
type(parser, t, {}); |
parser.unit.setvars(parser.unit, t); |
PROG.setVarsType(parser.unit, t); |
checklex(parser, SCAN.lxSEMI); |
Next(parser) |
ELSE |
835,6 → 871,7 |
VAR |
ptr: PROG.FRWPTR; |
endmod: BOOLEAN; |
pos: POSITION; |
PROCEDURE ProcDeclaration (parser: PARSER): BOOLEAN; |
842,20 → 879,24 |
proc: PROG.IDENT; |
endname, |
name: SCAN.IDENT; |
param: LISTS.ITEM; |
param: PROG.PARAM; |
unit: PROG.UNIT; |
ident: PROG.IDENT; |
e: EXPR; |
pos: SCAN.POSITION; |
pos, pos1, |
pos2: POSITION; |
label: INTEGER; |
enter: CODE.COMMAND; |
enter: IL.COMMAND; |
call: INTEGER; |
t: PROG.TYPE_; |
import: CODE.IMPORT_PROC; |
import: IL.IMPORT_PROC; |
endmod, b: BOOLEAN; |
fparams: SET; |
variables: LISTS.LIST; |
int, flt: INTEGER; |
comma: BOOLEAN; |
code: ARITH.VALUE; |
codeProc: BOOLEAN; |
BEGIN |
endmod := FALSE; |
865,6 → 906,7 |
call := procflag(parser, import, TRUE); |
getpos(parser, pos); |
pos1 := pos; |
checklex(parser, SCAN.lxIDENT); |
IF import # NIL THEN |
875,9 → 917,9 |
proc := IdentDef(parser, PROG.idPROC, name) |
END; |
check(unit.scope.open(unit, proc.proc), parser, pos, 116); |
check(PROG.openScope(unit, proc.proc), pos, 116); |
proc.type := program.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit); |
proc.type := PROG.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit); |
t := proc.type; |
t.align := program.target.adr; |
t.call := call; |
884,76 → 926,112 |
FormalParameters(parser, t); |
codeProc := call IN {PROG.code, PROG._code}; |
IF call IN {PROG.systemv, PROG._systemv} THEN |
check(t.params.size <= PROG.MAXSYSVPARAM, parser, pos, 120) |
check(t.parSize <= PROG.MAXSYSVPARAM, pos, 120) |
END; |
param := t.params.first; |
param := t.params.first(PROG.PARAM); |
WHILE param # NIL DO |
ident := unit.idents.add(unit, param(PROG.PARAM).name, PROG.idPARAM); |
ident := PROG.addIdent(unit, param.name, PROG.idPARAM); |
ASSERT(ident # NIL); |
ident.type := param(PROG.PARAM).type; |
ident.offset := param(PROG.PARAM).offset; |
IF param(PROG.PARAM).vPar THEN |
ident.type := param.type; |
ident.offset := param.offset; |
IF param.vPar THEN |
ident.typ := PROG.idVPAR |
END; |
param := param.next |
param := param.next(PROG.PARAM) |
END; |
IF import = NIL THEN |
label := IL.NewLabel(); |
proc.proc.label := label |
END; |
IF codeProc THEN |
enter := IL.EnterC(label); |
comma := FALSE; |
WHILE (parser.sym # SCAN.lxSEMI) OR comma DO |
getpos(parser, pos2); |
ConstExpression(parser, code); |
check(code.typ = ARITH.tINTEGER, pos2, 43); |
IF program.target.sys # mConst.Target_iMSP430 THEN |
check(ARITH.range(code, 0, 255), pos2, 42) |
END; |
IL.AddCmd(IL.opCODE, ARITH.getInt(code)); |
comma := parser.sym = SCAN.lxCOMMA; |
IF comma THEN |
Next(parser) |
ELSE |
checklex(parser, SCAN.lxSEMI) |
END |
END |
END; |
checklex(parser, SCAN.lxSEMI); |
Next(parser); |
IF import = NIL THEN |
label := CODE.NewLabel(); |
proc.proc.label := label; |
IF parser.main & proc.export & program.dll THEN |
IF program.obj THEN |
check((proc.name.s # "lib_init") & (proc.name.s # "version"), parser, pos, 114) |
check((proc.name.s # "lib_init") & (proc.name.s # "version"), pos, 114) |
END; |
CODE.AddExp(label, proc.name.s); |
IL.AddExp(label, proc.name.s); |
proc.proc.used := TRUE |
END; |
b := DeclarationSequence(parser); |
IF ~codeProc THEN |
b := DeclarationSequence(parser) |
END; |
program.locsize := 0; |
IF call IN {PROG._win64, PROG.win64} THEN |
fparams := proc.type.params.getfparams(proc.type, 3, int, flt); |
enter := CODE.Enter(label, LSL(ORD(fparams), 5) + MIN(proc.type.params.size, 4)) |
fparams := PROG.getFloatParamsPos(proc.type, 3, int, flt); |
enter := IL.Enter(label, LSL(ORD(fparams), 5) + MIN(proc.type.parSize, 4)) |
ELSIF call IN {PROG._systemv, PROG.systemv} THEN |
fparams := proc.type.params.getfparams(proc.type, PROG.MAXSYSVPARAM - 1, int, flt); |
enter := CODE.Enter(label, -(LSL(ORD(fparams), 5) + proc.type.params.size)) |
fparams := PROG.getFloatParamsPos(proc.type, PROG.MAXSYSVPARAM - 1, int, flt); |
enter := IL.Enter(label, -(LSL(ORD(fparams), 5) + proc.type.parSize)) |
ELSIF codeProc THEN |
ELSE |
enter := CODE.Enter(label, 0) |
enter := IL.Enter(label, 0) |
END; |
proc.proc.enter := enter; |
IF parser.sym = SCAN.lxBEGIN THEN |
IF ~codeProc & (parser.sym = SCAN.lxBEGIN) THEN |
Next(parser); |
parser.StatSeq(parser) |
END; |
IF t.base # NIL THEN |
IF ~codeProc & (t.base # NIL) THEN |
checklex(parser, SCAN.lxRETURN); |
NextPos(parser, pos); |
parser.expression(parser, e); |
check(parser.chkreturn(parser, e, t.base, pos), parser, pos, 87) |
check(parser.chkreturn(parser, e, t.base, pos), pos, 87) |
END; |
proc.proc.leave := CODE.Leave(t.base # NIL, (t.base # NIL) & (t.base.typ = PROG.tREAL), |
t.params.size * ORD((t.call IN PROG.callee_clean_up) OR (t.call IN {PROG.systemv, PROG._systemv}))); |
IF ~codeProc THEN |
proc.proc.leave := IL.Leave(t.base # NIL, (t.base # NIL) & (t.base.typ = PROG.tREAL), program.locsize, |
t.parSize * ORD((t.call IN PROG.callee_clean_up) OR (t.call IN {PROG.systemv, PROG._systemv}))); |
enter.param2 := program.locsize; |
checklex(parser, SCAN.lxEND) |
ELSE |
proc.proc.leave := IL.LeaveC() |
END; |
IF program.target.sys = mConst.Target_iMSP430 THEN |
check((enter.param2 * ORD(~codeProc) + proc.type.parSize) * 2 + 16 < program.target.options.ram, pos1, 63) |
END |
END; |
IF parser.sym = SCAN.lxEND THEN |
ExpectSym(parser, SCAN.lxIDENT); |
getpos(parser, pos); |
endname := parser.lex.ident; |
IF import = NIL THEN |
check(endname = name, parser, pos, 60); |
IF ~codeProc & (import = NIL) THEN |
check(endname = name, pos, 60); |
ExpectSym(parser, SCAN.lxSEMI); |
Next(parser) |
ELSE |
965,20 → 1043,20 |
ExpectSym(parser, SCAN.lxSEMI); |
Next(parser) |
ELSE |
check(FALSE, parser, pos, 60) |
error(pos, 60) |
END |
END |
END; |
IF import = NIL THEN |
IF ~codeProc & (import = NIL) THEN |
variables := LISTS.create(NIL); |
ELSE |
variables := NIL |
END; |
unit.scope.close(unit, variables); |
PROG.closeScope(unit, variables); |
IF import = NIL THEN |
IF ~codeProc & (import = NIL) THEN |
enter.variables := variables |
END |
1001,12 → 1079,15 |
END |
END; |
ptr := parser.unit.pointers.link(parser.unit); |
ptr := PROG.linkPtr(parser.unit); |
IF ptr # NIL THEN |
pos.line := ptr.pos.line; |
pos.col := ptr.pos.col; |
pos.parser := parser; |
IF ptr.notRecord THEN |
error(parser, ptr.pos, 58) |
error(pos, 58) |
ELSE |
error(parser, ptr.pos, 48) |
error(pos, 48) |
END |
END; |
1033,6 → 1114,8 |
label: INTEGER; |
name: INTEGER; |
endmod: BOOLEAN; |
errlabel: INTEGER; |
errno: INTEGER; |
BEGIN |
ASSERT(parser # NIL); |
1045,7 → 1128,7 |
check1(parser.lex.s = parser.modname, parser, 23) |
END; |
unit := program.units.create(program.units, parser.lex.ident); |
unit := PROG.newUnit(program, parser.lex.ident); |
parser.unit := unit; |
1062,19 → 1145,26 |
END; |
CONSOLE.Ln; |
label := CODE.NewLabel(); |
CODE.AddJmpCmd(CODE.opJMP, label); |
label := IL.NewLabel(); |
IL.AddJmpCmd(IL.opJMP, label); |
name := CODE.putstr(unit.name.s); |
name := IL.putstr(unit.name.s); |
CODE.SetErrLabel; |
CODE.AddCmd(CODE.opSADR, name); |
CODE.AddCmd(CODE.opPARAM, 1); |
CODE.AddCmd0(CODE.opERR); |
errlabel := IL.NewLabel(); |
IL.SetLabel(errlabel); |
IL.StrAdr(name); |
IL.Param1; |
IL.AddCmd0(IL.opERR); |
FOR errno := 1 TO LEN(IL.codes.errlabels) - 1 DO |
IL.SetErrLabel(errno); |
IL.AddCmd(IL.opPUSHC, errno); |
IL.AddJmpCmd(IL.opJMP, errlabel) |
END; |
endmod := DeclarationSequence(parser); |
CODE.SetLabel(label); |
IL.SetLabel(label); |
IF ~endmod THEN |
1091,8 → 1181,7 |
END; |
unit.close(unit) |
PROG.closeUnit(unit) |
END parse; |
1156,9 → 1245,9 |
END create; |
PROCEDURE init* (bit_depth, sys: INTEGER); |
PROCEDURE init* (bit_depth, target: INTEGER; options: PROG.OPTIONS); |
BEGIN |
program := PROG.create(bit_depth, sys); |
program := PROG.create(bit_depth, target, options); |
parsers := C.create() |
END init; |
/programs/develop/oberon07/Source/PATHS.ob07 |
---|
1,7 → 1,7 |
(* |
BSD 2-Clause License |
Copyright (c) 2018, Anton Krotov |
Copyright (c) 2018, 2019, Anton Krotov |
All rights reserved. |
*) |
/programs/develop/oberon07/Source/PROG.ob07 |
---|
7,7 → 7,7 |
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; |
CONST |
39,9 → 39,10 |
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; |
sysWSADR* = 39; sysPUT32* = 40; (*sysNOP* = 41; sysEINT* = 42; |
sysDINT* = 43;*) |
default* = 2; |
default32* = 2; |
stdcall* = 4; _stdcall* = stdcall + 1; |
ccall* = 6; _ccall* = ccall + 1; |
ccall16* = 8; _ccall16* = ccall16 + 1; |
49,19 → 50,34 |
stdcall64* = 12; _stdcall64* = stdcall64 + 1; |
default64* = 14; |
systemv* = 16; _systemv* = systemv + 1; |
default16* = 18; |
code* = 20; _code* = code + 1; |
noalign* = 20; |
noalign* = 22; |
callee_clean_up* = {default, stdcall, _stdcall, default64, stdcall64, _stdcall64}; |
caller_clean_up* = {ccall, ccall16, win64, systemv, _ccall, _ccall16, _win64, _systemv}; |
callconv32* = {default, stdcall, ccall, ccall16, _stdcall, _ccall, _ccall16}; |
callconv64* = {default64, win64, stdcall64, systemv, _win64, _stdcall64, _systemv}; |
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; |
sf_noalign* = 9; |
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 |
OPTIONS* = RECORD |
version*, stack*, base*, ram*, rom*: INTEGER; |
pic*: BOOLEAN; |
checking*: SET |
END; |
IDENT* = POINTER TO rIDENT; |
UNIT* = POINTER TO rUNIT; |
81,13 → 97,6 |
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) |
label*: INTEGER; |
110,66 → 119,30 |
program*: PROGRAM; |
name*: SCAN.IDENT; |
idents*: IDENTS; |
idents*: LISTS.LIST; |
frwPointers: LISTS.LIST; |
gscope: IDENT; |
closed*: BOOLEAN; |
scopeLvl*: INTEGER; |
sysimport*: BOOLEAN; |
scopes*: ARRAY MAXSCOPE OF PROC |
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 |
END |
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; |
set*: PROCEDURE (proc: TYPE_; type: TYPE_); |
getfparams*: PROCEDURE (proc: TYPE_; maxparam: INTEGER; VAR int, flt: INTEGER): SET |
END; |
rTYPE_ = RECORD (LISTS.ITEM) |
typ*: INTEGER; |
size*: INTEGER; |
parSize*: INTEGER; |
length*: INTEGER; |
align*: INTEGER; |
base*: TYPE_; |
fields*: FIELDS; |
params*: PARAMS; |
fields*: LISTS.LIST; |
params*: LISTS.LIST; |
unit*: UNIT; |
closed*: BOOLEAN; |
num*: INTEGER; |
215,19 → 188,10 |
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; |
rtl*: UNIT; |
240,8 → 204,8 |
stTypes*: RECORD |
tINTEGER*, tBYTE*, tCHAR*, tWCHAR*, tSET*, tBOOLEAN*, tREAL*, tSTRING*, tNIL*, |
tCARD16*, tCARD32*, tANYREC*: TYPE_ |
tINTEGER*, tBYTE*, tCHAR*, tWCHAR*, tSET*, tBOOLEAN*, tREAL*, |
tSTRING*, tNIL*, tCARD16*, tCARD32*, tANYREC*: TYPE_ |
END; |
250,13 → 214,12 |
bit_depth*: INTEGER; |
word*: INTEGER; |
adr*: INTEGER; |
sys*: INTEGER |
sys*: INTEGER; |
sysflags*: SET; |
options*: OPTIONS |
END; |
END |
enterType*: PROCEDURE (program: PROGRAM; typ, size, length: INTEGER; unit: UNIT): TYPE_; |
getType*: PROCEDURE (program: PROGRAM; typ: INTEGER): TYPE_ |
END; |
DELIMPORT = PROCEDURE (import: LISTS.ITEM); |
292,7 → 255,7 |
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) |
301,7 → 264,7 |
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); |
315,7 → 278,7 |
END getOffset; |
PROCEDURE close (unit: UNIT); |
PROCEDURE closeUnit* (unit: UNIT); |
VAR |
ident, prev: IDENT; |
offset: INTEGER; |
324,7 → 287,7 |
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 |
offset := getOffset(unit.program, ident) |
END |
343,7 → 306,7 |
END; |
unit.closed := TRUE |
END close; |
END closeUnit; |
PROCEDURE unique (unit: UNIT; ident: SCAN.IDENT): BOOLEAN; |
362,7 → 325,7 |
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; |
res: BOOLEAN; |
438,7 → 401,7 |
END UseProc; |
PROCEDURE setvars (unit: UNIT; type: TYPE_); |
PROCEDURE setVarsType* (unit: UNIT; type: TYPE_); |
VAR |
item: IDENT; |
450,10 → 413,10 |
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; |
462,7 → 425,7 |
item := unit.idents.last(IDENT); |
ASSERT(item # NIL); |
IF item # NIL THEN |
IF currentScope THEN |
WHILE (item.name # ident) & (item.typ # idGUARD) DO |
477,11 → 440,13 |
END |
END |
END |
RETURN item |
END getIdent; |
PROCEDURE openScope (unit: UNIT; proc: PROC): BOOLEAN; |
PROCEDURE openScope* (unit: UNIT; proc: PROC): BOOLEAN; |
VAR |
item: IDENT; |
res: BOOLEAN; |
508,11 → 473,11 |
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); |
521,11 → 486,11 |
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(); |
lvar.offset := del.offset; |
lvar.size := del.type.size; |
IF del.typ = idVAR THEN |
548,7 → 513,7 |
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: FRWPTR; |
566,10 → 531,10 |
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; |
580,7 → 545,7 |
item := unit.frwPointers.last(FRWPTR); |
WHILE (item # NIL) & ~item.linked & (res = NIL) DO |
ident := unit.idents.get(unit, item.baseIdent, TRUE); |
ident := getIdent(unit, item.baseIdent, TRUE); |
IF (ident # NIL) THEN |
IF (ident.typ = idTYPE) & (ident.type.typ = tRECORD) THEN |
599,7 → 564,7 |
END |
RETURN res |
END linkptr; |
END linkPtr; |
PROCEDURE isTypeEq* (t1, t2: TYPE_): BOOLEAN; |
617,7 → 582,7 |
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 |
res := (param1(PARAM).vPar = param2(PARAM).vPar) & isTypeEq(param1(PARAM).type, param2(PARAM).type); |
643,18 → 608,21 |
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 |
END; |
WHILE res & (t1 # NIL) & (t1 # t0) DO |
IF res THEN |
WHILE (t1 # NIL) & (t1 # t0) DO |
t1 := t1.base |
END; |
res := t1 # NIL |
END |
RETURN res & (t1 = t0) |
RETURN res |
END isBaseOf; |
663,7 → 631,7 |
END isOpenArray; |
PROCEDURE getunit (units: UNITS; name: SCAN.IDENT): UNIT; |
PROCEDURE getUnit* (program: PROGRAM; name: SCAN.IDENT): UNIT; |
VAR |
item: UNIT; |
670,7 → 638,7 |
BEGIN |
ASSERT(name # NIL); |
item := units.first(UNIT); |
item := program.units.first(UNIT); |
WHILE (item # NIL) & (item.name # name) DO |
item := item.next(UNIT) |
677,48 → 645,41 |
END; |
IF (item = NIL) & (name.s = "SYSTEM") THEN |
item := units.program.sysunit |
item := program.sysunit |
END |
RETURN item |
END getunit; |
END getUnit; |
PROCEDURE enterStTypes (unit: UNIT; program: PROGRAM); |
VAR |
ident: IDENT; |
stName: SCAN.IDENT; |
BEGIN |
stName := SCAN.enterid("INTEGER"); |
ident := addIdent(unit, stName, idTYPE); |
ident := addIdent(unit, SCAN.enterid("INTEGER"), idTYPE); |
ident.type := program.stTypes.tINTEGER; |
stName := SCAN.enterid("BYTE"); |
ident := addIdent(unit, stName, idTYPE); |
ident := addIdent(unit, SCAN.enterid("BYTE"), idTYPE); |
ident.type := program.stTypes.tBYTE; |
stName := SCAN.enterid("CHAR"); |
ident := addIdent(unit, stName, idTYPE); |
ident := addIdent(unit, SCAN.enterid("CHAR"), idTYPE); |
ident.type := program.stTypes.tCHAR; |
stName := SCAN.enterid("WCHAR"); |
ident := addIdent(unit, stName, idTYPE); |
ident.type := program.stTypes.tWCHAR; |
stName := SCAN.enterid("SET"); |
ident := addIdent(unit, stName, idTYPE); |
ident := addIdent(unit, SCAN.enterid("SET"), idTYPE); |
ident.type := program.stTypes.tSET; |
stName := SCAN.enterid("BOOLEAN"); |
ident := addIdent(unit, stName, idTYPE); |
ident := addIdent(unit, SCAN.enterid("BOOLEAN"), idTYPE); |
ident.type := program.stTypes.tBOOLEAN; |
stName := SCAN.enterid("REAL"); |
ident := addIdent(unit, stName, idTYPE); |
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); |
ident.type := program.stTypes.tWCHAR |
END |
END enterStTypes; |
725,86 → 686,86 |
PROCEDURE enterStProcs (unit: UNIT); |
PROCEDURE EnterProc (unit: UNIT; name: SCAN.LEXSTR; idtyp, proc: INTEGER); |
PROCEDURE EnterProc (unit: UNIT; name: SCAN.LEXSTR; proc: INTEGER); |
VAR |
ident: IDENT; |
BEGIN |
ident := addIdent(unit, SCAN.enterid(name), idtyp); |
ident := addIdent(unit, SCAN.enterid(name), idSTPROC); |
ident.stproc := proc |
END EnterProc; |
PROCEDURE EnterFunc (unit: UNIT; name: SCAN.LEXSTR; func: INTEGER); |
VAR |
ident: IDENT; |
BEGIN |
EnterProc(unit, "ASSERT", idSTPROC, stASSERT); |
EnterProc(unit, "DEC", idSTPROC, stDEC); |
EnterProc(unit, "EXCL", idSTPROC, stEXCL); |
EnterProc(unit, "INC", idSTPROC, stINC); |
EnterProc(unit, "INCL", idSTPROC, stINCL); |
EnterProc(unit, "NEW", idSTPROC, stNEW); |
EnterProc(unit, "PACK", idSTPROC, stPACK); |
EnterProc(unit, "UNPK", idSTPROC, stUNPK); |
EnterProc(unit, "DISPOSE", idSTPROC, stDISPOSE); |
EnterProc(unit, "COPY", idSTPROC, stCOPY); |
ident := addIdent(unit, SCAN.enterid(name), idSTFUNC); |
ident.stproc := func |
END EnterFunc; |
EnterProc(unit, "ABS", idSTFUNC, stABS); |
EnterProc(unit, "ASR", idSTFUNC, stASR); |
EnterProc(unit, "CHR", idSTFUNC, stCHR); |
EnterProc(unit, "WCHR", idSTFUNC, stWCHR); |
EnterProc(unit, "FLOOR", idSTFUNC, stFLOOR); |
EnterProc(unit, "FLT", idSTFUNC, stFLT); |
EnterProc(unit, "LEN", idSTFUNC, stLEN); |
EnterProc(unit, "LSL", idSTFUNC, stLSL); |
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); |
BEGIN |
EnterProc(unit, "ASSERT", stASSERT); |
EnterProc(unit, "DEC", stDEC); |
EnterProc(unit, "EXCL", stEXCL); |
EnterProc(unit, "INC", stINC); |
EnterProc(unit, "INCL", stINCL); |
EnterProc(unit, "NEW", stNEW); |
EnterProc(unit, "COPY", stCOPY); |
EnterFunc(unit, "ABS", stABS); |
EnterFunc(unit, "ASR", stASR); |
EnterFunc(unit, "CHR", stCHR); |
EnterFunc(unit, "LEN", stLEN); |
EnterFunc(unit, "LSL", stLSL); |
EnterFunc(unit, "ODD", stODD); |
EnterFunc(unit, "ORD", stORD); |
EnterFunc(unit, "ROR", stROR); |
EnterFunc(unit, "BITS", stBITS); |
EnterFunc(unit, "LSR", stLSR); |
EnterFunc(unit, "LENGTH", stLENGTH); |
EnterFunc(unit, "MIN", stMIN); |
EnterFunc(unit, "MAX", stMAX); |
IF unit.program.target.sys # mConst.Target_iMSP430 THEN |
EnterProc(unit, "PACK", stPACK); |
EnterProc(unit, "UNPK", stUNPK); |
EnterProc(unit, "DISPOSE", stDISPOSE); |
EnterFunc(unit, "WCHR", stWCHR); |
EnterFunc(unit, "FLOOR", stFLOOR); |
EnterFunc(unit, "FLT", stFLT) |
END |
END enterStProcs; |
PROCEDURE newunit (units: UNITS; name: SCAN.IDENT): UNIT; |
PROCEDURE newUnit* (program: PROGRAM; name: SCAN.IDENT): UNIT; |
VAR |
unit: UNIT; |
idents: IDENTS; |
BEGIN |
ASSERT(units # NIL); |
ASSERT(program # NIL); |
ASSERT(name # NIL); |
NEW(unit); |
NEW(idents); |
ASSERT(LISTS.create(idents) = idents); |
idents.add := addIdent; |
idents.get := getIdent; |
unit.program := units.program; |
unit.program := program; |
unit.name := name; |
unit.closed := FALSE; |
unit.idents := idents; |
unit.idents := LISTS.create(NIL); |
unit.frwPointers := LISTS.create(NIL); |
unit.scope.open := openScope; |
unit.scope.close := closeScope; |
unit.close := close; |
unit.setvars := setvars; |
unit.pointers.add := frwptr; |
unit.pointers.link := linkptr; |
ASSERT(openScope(unit, NIL)); |
ASSERT(unit.scope.open(unit, NIL)); |
enterStTypes(unit, units.program); |
enterStTypes(unit, program); |
enterStProcs(unit); |
ASSERT(unit.scope.open(unit, NIL)); |
ASSERT(openScope(unit, NIL)); |
unit.gscope := unit.idents.last(IDENT); |
LISTS.push(units, unit); |
LISTS.push(program.units, unit); |
unit.scopeLvl := 0; |
unit.scopes[0] := NIL; |
812,14 → 773,14 |
unit.sysimport := FALSE; |
IF unit.name.s = mConst.RTL_NAME THEN |
unit.program.rtl := unit |
program.rtl := unit |
END |
RETURN unit |
END newunit; |
END newUnit; |
PROCEDURE getField (self: TYPE_; name: SCAN.IDENT; unit: UNIT): FIELD; |
PROCEDURE getField* (self: TYPE_; name: SCAN.IDENT; unit: UNIT): FIELD; |
VAR |
field: FIELD; |
851,7 → 812,7 |
END getField; |
PROCEDURE addField (self: TYPE_; name: SCAN.IDENT; export: BOOLEAN): BOOLEAN; |
PROCEDURE addField* (self: TYPE_; name: SCAN.IDENT; export: BOOLEAN): BOOLEAN; |
VAR |
field: FIELD; |
res: BOOLEAN; |
876,7 → 837,7 |
END addField; |
PROCEDURE setFields (self: TYPE_; type: TYPE_): BOOLEAN; |
PROCEDURE setFields* (self: TYPE_; type: TYPE_): BOOLEAN; |
VAR |
item: FIELD; |
res: BOOLEAN; |
895,7 → 856,7 |
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; |
911,7 → 872,7 |
END setFields; |
PROCEDURE getParam (self: TYPE_; name: SCAN.IDENT): PARAM; |
PROCEDURE getParam* (self: TYPE_; name: SCAN.IDENT): PARAM; |
VAR |
item: PARAM; |
928,7 → 889,7 |
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; |
res: BOOLEAN; |
936,7 → 897,7 |
BEGIN |
ASSERT(name # NIL); |
res := self.params.get(self, name) = NIL; |
res := getParam(self, name) = NIL; |
IF res THEN |
NEW(param); |
973,7 → 934,7 |
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; |
param: PARAM; |
991,13 → 952,13 |
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; |
1006,7 → 967,7 |
BEGIN |
ASSERT(type # NIL); |
word := MACHINE.target.bit_depth DIV 8; |
word := UTILS.target.bit_depth DIV 8; |
item := self.params.first; |
1025,8 → 986,8 |
ELSE |
size := 1 |
END; |
param.offset := self.params.size + ORD(type.typ = tRECORD) + Dim(type) + STACK_FRAME; |
INC(self.params.size, size) |
param.offset := self.parSize + ORD(type.typ = tRECORD) + Dim(type) + STACK_FRAME; |
INC(self.parSize, size) |
ELSE |
IF type.typ IN {tRECORD, tARRAY} THEN |
IF isOpenArray(type) THEN |
1036,11 → 997,11 |
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; |
INC(self.params.size, size) |
param.offset := self.parSize + Dim(type) + STACK_FRAME; |
INC(self.parSize, size) |
END; |
item := item.next |
1049,48 → 1010,33 |
END setParams; |
PROCEDURE enterType (program: PROGRAM; typ, size, length: INTEGER; unit: UNIT): TYPE_; |
PROCEDURE enterType* (program: PROGRAM; typ, size, length: INTEGER; unit: UNIT): TYPE_; |
VAR |
t: TYPE_; |
fields: FIELDS; |
params: PARAMS; |
BEGIN |
NEW(t); |
NEW(fields); |
ASSERT(LISTS.create(fields) = fields); |
NEW(params); |
ASSERT(LISTS.create(params) = params); |
t.typ := typ; |
t.size := size; |
t.length := length; |
t.align := 0; |
t.base := NIL; |
t.fields := fields; |
t.params := params; |
t.fields := LISTS.create(NIL); |
t.params := LISTS.create(NIL); |
t.unit := unit; |
t.num := 0; |
IF program.target.bit_depth = 32 THEN |
t.call := default |
ELSIF program.target.bit_depth = 64 THEN |
t.call := default64 |
CASE program.target.bit_depth OF |
|16: t.call := default16 |
|32: t.call := default32 |
|64: t.call := default64 |
END; |
t.import := FALSE; |
t.noalign := FALSE; |
t.parSize := 0; |
t.fields.add := addField; |
t.fields.get := getField; |
t.fields.set := setFields; |
t.params.add := addParam; |
t.params.get := getParam; |
t.params.getfparams := getFloatParamsPos; |
t.params.set := setParams; |
t.params.size := 0; |
IF typ IN {tARRAY, tRECORD} THEN |
t.closed := FALSE; |
IF typ = tRECORD THEN |
1107,7 → 1053,7 |
END enterType; |
PROCEDURE getType (program: PROGRAM; typ: INTEGER): TYPE_; |
PROCEDURE getType* (program: PROGRAM; typ: INTEGER): TYPE_; |
VAR |
res: TYPE_; |
1154,22 → 1100,30 |
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, "SADR", idSYSFUNC, sysSADR); |
EnterProc(unit, "WSADR", idSYSFUNC, sysWSADR); |
EnterProc(unit, "TYPEID", idSYSFUNC, sysTYPEID); |
EnterProc(unit, "INF", idSYSFUNC, sysINF); |
EnterProc(unit, "GET", idSYSPROC, sysGET); |
EnterProc(unit, "PUT8", idSYSPROC, sysPUT8); |
EnterProc(unit, "PUT", idSYSPROC, sysPUT); |
EnterProc(unit, "PUT8", idSYSPROC, sysPUT8); |
EnterProc(unit, "PUT16", idSYSPROC, sysPUT16); |
EnterProc(unit, "PUT32", idSYSPROC, sysPUT32); |
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, "WSADR", idSYSFUNC, sysWSADR); |
EnterProc(unit, "INF", idSYSFUNC, sysINF); |
EnterProc(unit, "PUT32", idSYSPROC, sysPUT32); |
EnterProc(unit, "PUT16", idSYSPROC, sysPUT16); |
EnterProc(unit, "COPY", idSYSPROC, sysCOPY); |
ident := addIdent(unit, SCAN.enterid("CARD16"), idTYPE); |
1178,9 → 1132,10 |
ident := addIdent(unit, SCAN.enterid("CARD32"), idTYPE); |
ident.type := program.stTypes.tCARD32; |
ident.export := TRUE; |
ident.export := TRUE |
END; |
unit.close(unit); |
closeUnit(unit); |
program.sysunit := unit |
END createSysUnit; |
1211,7 → 1166,6 |
BEGIN |
REPEAT |
flag := FALSE; |
proc := program.procs.first(PROC); |
1230,7 → 1184,7 |
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 |
1241,46 → 1195,66 |
END DelUnused; |
PROCEDURE create* (bit_depth, sys: INTEGER): PROGRAM; |
PROCEDURE create* (bit_depth, target: INTEGER; options: OPTIONS): PROGRAM; |
VAR |
program: PROGRAM; |
units: UNITS; |
BEGIN |
idents := C.create(); |
MACHINE.SetBitDepth(bit_depth); |
UTILS.SetBitDepth(bit_depth); |
NEW(program); |
NEW(units); |
ASSERT(LISTS.create(units) = units); |
program.target.bit_depth := bit_depth; |
program.target.word := bit_depth DIV 8; |
program.target.adr := bit_depth DIV 8; |
program.target.sys := sys; |
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, |
mConst.Target_iDLL64: program.target.sysflags := {sf_windows, sf_stdcall64, sf_win64, sf_systemv, sf_noalign} |
|mConst.Target_iELF64, |
mConst.Target_iELFSO64: program.target.sysflags := {sf_linux, sf_stdcall64, sf_win64, sf_systemv, sf_noalign} |
|mConst.Target_iMSP430: program.target.sysflags := {sf_code} |
END; |
program.recCount := -1; |
program.bss := 0; |
program.units := units; |
program.units := LISTS.create(NIL); |
program.types := LISTS.create(NIL); |
program.procs := LISTS.create(NIL); |
program.enterType := enterType; |
program.getType := getType; |
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.stTypes.tWCHAR := enterType(program, tWCHAR, 2, 0, NIL); |
program.stTypes.tSET := enterType(program, tSET, program.target.word, 0, NIL); |
program.stTypes.tBOOLEAN := enterType(program, tBOOLEAN, 1, 0, NIL); |
IF target # mConst.Target_iMSP430 THEN |
program.stTypes.tWCHAR := enterType(program, tWCHAR, 2, 0, NIL); |
program.stTypes.tREAL := enterType(program, tREAL, 8, 0, NIL); |
program.stTypes.tCARD16 := enterType(program, tCARD16, 2, 0, NIL); |
program.stTypes.tCARD32 := enterType(program, tCARD32, 4, 0, NIL) |
END; |
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.tCARD32 := enterType(program, tCARD32, 4, 0, NIL); |
program.stTypes.tANYREC := enterType(program, tRECORD, 0, 0, NIL); |
program.stTypes.tANYREC.closed := TRUE; |
1287,18 → 1261,16 |
program.stTypes.tINTEGER.align := program.stTypes.tINTEGER.size; |
program.stTypes.tBYTE.align := 1; |
program.stTypes.tCHAR.align := program.stTypes.tCHAR.size; |
program.stTypes.tWCHAR.align := program.stTypes.tWCHAR.size; |
program.stTypes.tSET.align := program.stTypes.tSET.size; |
program.stTypes.tBOOLEAN.align := program.stTypes.tBOOLEAN.size; |
IF target # mConst.Target_iMSP430 THEN |
program.stTypes.tWCHAR.align := program.stTypes.tWCHAR.size; |
program.stTypes.tREAL.align := program.stTypes.tREAL.size; |
program.stTypes.tCARD16.align := program.stTypes.tCARD16.size; |
program.stTypes.tCARD32.align := program.stTypes.tCARD32.size; |
program.stTypes.tCARD32.align := program.stTypes.tCARD32.size |
END; |
units.program := program; |
units.create := newunit; |
units.get := getunit; |
program.dll := FALSE; |
program.obj := FALSE; |
/programs/develop/oberon07/Source/REG.ob07 |
---|
12,8 → 12,10 |
N = 16; |
R0* = 0; R1* = 1; R2* = 2; |
R0* = 0; R1* = 1; R2* = 2; R3* = 3; |
R4* = 4; R5* = 5; R6* = 6; R7* = 7; |
R8* = 8; R9* = 9; R10* = 10; R11* = 11; |
R12* = 12; R13* = 13; R14* = 14; R15* = 15; |
NVR = 32; |
24,7 → 26,7 |
OP2 = PROCEDURE (arg1, arg2: INTEGER); |
OP3 = PROCEDURE (arg1, arg2, arg3: INTEGER); |
REGS* = POINTER TO RECORD |
REGS* = RECORD |
regs*: SET; |
stk*: ARRAY N OF INTEGER; |
42,7 → 44,7 |
END; |
PROCEDURE push (R: REGS); |
PROCEDURE push (VAR R: REGS); |
VAR |
i, reg: INTEGER; |
58,7 → 60,7 |
END push; |
PROCEDURE pop (R: REGS; reg: INTEGER); |
PROCEDURE pop (VAR R: REGS; reg: INTEGER); |
VAR |
i: INTEGER; |
111,7 → 113,7 |
END GetFreeReg; |
PROCEDURE Put (R: REGS; reg: INTEGER); |
PROCEDURE Put (VAR R: REGS; reg: INTEGER); |
BEGIN |
EXCL(R.regs, reg); |
INC(R.top); |
119,7 → 121,7 |
END Put; |
PROCEDURE PopAnyReg (R: REGS): INTEGER; |
PROCEDURE PopAnyReg (VAR R: REGS): INTEGER; |
VAR |
reg: INTEGER; |
134,7 → 136,7 |
END PopAnyReg; |
PROCEDURE GetAnyReg* (R: REGS): INTEGER; |
PROCEDURE GetAnyReg* (VAR R: REGS): INTEGER; |
VAR |
reg: INTEGER; |
152,13 → 154,13 |
END GetAnyReg; |
PROCEDURE GetReg* (R: REGS; reg: INTEGER): BOOLEAN; |
PROCEDURE GetReg* (VAR R: REGS; reg: INTEGER): BOOLEAN; |
VAR |
free, n: INTEGER; |
res: BOOLEAN; |
PROCEDURE exch (R: REGS; reg1, reg2: INTEGER); |
PROCEDURE exch (VAR R: REGS; reg1, reg2: INTEGER); |
VAR |
n1, n2: INTEGER; |
201,7 → 203,7 |
END GetReg; |
PROCEDURE Exchange* (R: REGS; reg1, reg2: INTEGER): BOOLEAN; |
PROCEDURE Exchange* (VAR R: REGS; reg1, reg2: INTEGER): BOOLEAN; |
VAR |
n1, n2: INTEGER; |
res: BOOLEAN; |
239,7 → 241,7 |
END Exchange; |
PROCEDURE Drop* (R: REGS); |
PROCEDURE Drop* (VAR R: REGS); |
BEGIN |
INCL(R.regs, R.stk[R.top]); |
DEC(R.top) |
246,7 → 248,7 |
END Drop; |
PROCEDURE BinOp* (R: REGS; VAR reg1, reg2: INTEGER); |
PROCEDURE BinOp* (VAR R: REGS; VAR reg1, reg2: INTEGER); |
BEGIN |
IF R.top > 0 THEN |
reg1 := R.stk[R.top - 1]; |
261,7 → 263,7 |
END BinOp; |
PROCEDURE UnOp* (R: REGS; VAR reg: INTEGER); |
PROCEDURE UnOp* (VAR R: REGS; VAR reg: INTEGER); |
BEGIN |
IF R.top >= 0 THEN |
reg := R.stk[R.top] |
271,7 → 273,7 |
END UnOp; |
PROCEDURE PushAll* (R: REGS); |
PROCEDURE PushAll* (VAR R: REGS); |
BEGIN |
WHILE R.top >= 0 DO |
push(R) |
279,8 → 281,16 |
END PushAll; |
PROCEDURE Lock* (R: REGS; reg, offs, size: INTEGER); |
PROCEDURE PushAll_1* (VAR R: REGS); |
BEGIN |
WHILE R.top >= 1 DO |
push(R) |
END |
END PushAll_1; |
PROCEDURE Lock* (VAR R: REGS; reg, offs, size: INTEGER); |
BEGIN |
ASSERT(reg IN R.vregs); |
ASSERT(offs # 0); |
R.offs[reg] := offs; |
291,7 → 301,7 |
END Lock; |
PROCEDURE Release* (R: REGS; reg: INTEGER); |
PROCEDURE Release* (VAR R: REGS; reg: INTEGER); |
BEGIN |
ASSERT(reg IN R.vregs); |
R.offs[reg] := 0 |
350,7 → 360,7 |
END Restore; |
PROCEDURE Reset* (R: REGS); |
PROCEDURE Reset* (VAR R: REGS); |
VAR |
i: INTEGER; |
401,14 → 411,11 |
END GetAnyVarReg; |
PROCEDURE Create* (push, pop: OP1; mov, xch: OP2; load, save: OP3; regs, vregs: SET): REGS; |
PROCEDURE Init* (VAR R: REGS; push, pop: OP1; mov, xch: OP2; load, save: OP3; regs, vregs: SET); |
VAR |
R: REGS; |
i: INTEGER; |
BEGIN |
NEW(R); |
R.regs := regs; |
R.pushed := 0; |
R.top := -1; |
427,8 → 434,7 |
R.size[i] := 0 |
END |
RETURN R |
END Create; |
END Init; |
END REG. |
/programs/develop/oberon07/Source/SCAN.ob07 |
---|
1,13 → 1,13 |
(* |
BSD 2-Clause License |
Copyright (c) 2018, Anton Krotov |
Copyright (c) 2018, 2019, Anton Krotov |
All rights reserved. |
*) |
MODULE SCAN; |
IMPORT TEXTDRV, AVL := AVLTREES, ARITH, S := STRINGS, C := COLLECTIONS; |
IMPORT TXT := TEXTDRV, AVL := AVLTREES, ARITH, S := STRINGS; |
CONST |
18,29 → 18,30 |
lxCHAR* = 4; lxFLOAT* = 5; lxSTRING* = 6; lxCOMMENT* = 7; |
lxEOF* = 8; |
lxKW = 101; |
lxPLUS* = 21; lxMINUS* = 22; lxMUL* = 23; lxSLASH* = 24; |
lxNOT* = 25; lxAND* = 26; lxPOINT* = 27; lxCOMMA* = 28; |
lxSEMI* = 29; lxBAR* = 30; lxLROUND* = 31; lxLSQUARE* = 32; |
lxLCURLY* = 33; lxCARET* = 34; lxEQ* = 35; lxNE* = 36; |
lxLT* = 37; lxGT* = 38; lxCOLON* = 39; lxRROUND* = 40; |
lxRSQUARE* = 41; lxRCURLY* = 42; lxLE* = 43; lxGE* = 44; |
lxASSIGN* = 45; lxRANGE* = 46; |
lxARRAY* = 101; lxBEGIN* = 102; lxBY* = 103; lxCASE* = 104; |
lxCONST* = 105; lxDIV* = 106; lxDO* = 107; lxELSE* = 108; |
lxELSIF* = 109; lxEND* = 110; lxFALSE* = 111; lxFOR* = 112; |
lxIF* = 113; lxIMPORT* = 114; lxIN* = 115; lxIS* = 116; |
lxMOD* = 117; lxMODULE* = 118; lxNIL* = 119; lxOF* = 120; |
lxOR* = 121; lxPOINTER* = 122; lxPROCEDURE* = 123; lxRECORD* = 124; |
lxREPEAT* = 125; lxRETURN* = 126; lxTHEN* = 127; lxTO* = 128; |
lxTRUE* = 129; lxTYPE* = 130; lxUNTIL* = 131; lxVAR* = 132; |
lxWHILE* = 133; |
lxKW = 51; |
lxPLUS* = 201; lxMINUS* = 202; lxMUL* = 203; lxSLASH* = 204; |
lxNOT* = 205; lxAND* = 206; lxPOINT* = 207; lxCOMMA* = 208; |
lxSEMI* = 209; lxBAR* = 210; lxLROUND* = 211; lxLSQUARE* = 212; |
lxLCURLY* = 213; lxCARET* = 214; lxEQ* = 215; lxNE* = 216; |
lxLT* = 217; lxGT* = 218; lxCOLON* = 219; lxRROUND* = 220; |
lxRSQUARE* = 221; lxRCURLY* = 222; lxLE* = 223; lxGE* = 224; |
lxASSIGN* = 225; lxRANGE* = 226; |
lxARRAY* = 51; lxBEGIN* = 52; lxBY* = 53; lxCASE* = 54; |
lxCONST* = 55; lxDIV* = 56; lxDO* = 57; lxELSE* = 58; |
lxELSIF* = 59; lxEND* = 60; lxFALSE* = 61; lxFOR* = 62; |
lxIF* = 63; lxIMPORT* = 64; lxIN* = 65; lxIS* = 66; |
lxMOD* = 67; lxMODULE* = 68; lxNIL* = 69; lxOF* = 70; |
lxOR* = 71; lxPOINTER* = 72; lxPROCEDURE* = 73; lxRECORD* = 74; |
lxREPEAT* = 75; lxRETURN* = 76; lxTHEN* = 77; lxTO* = 78; |
lxTRUE* = 79; lxTYPE* = 80; lxUNTIL* = 81; lxVAR* = 82; |
lxWHILE* = 83; |
lxERROR01 = -1; lxERROR02 = -2; lxERROR03 = -3; lxERROR04 = -4; |
lxERROR05 = -5; lxERROR06 = -6; lxERROR07 = -7; lxERROR08 = -8; |
lxERROR09 = -9; lxERROR10 = -10; lxERROR11 = -11; lxERROR12 = -12; |
lxERROR01* = -1; lxERROR02* = -2; lxERROR03* = -3; lxERROR04* = -4; |
lxERROR05* = -5; lxERROR06* = -6; lxERROR07* = -7; lxERROR08* = -8; |
lxERROR09* = -9; lxERROR10* = -10; lxERROR11* = -11; lxERROR12* = -12; |
lxERROR13* = -13; |
TYPE |
75,13 → 76,8 |
END; |
SCANNER* = POINTER TO RECORD (C.ITEM) |
SCANNER* = TXT.TEXT; |
text: TEXTDRV.TEXT; |
range: BOOLEAN |
END; |
KEYWORD = ARRAY 10 OF CHAR; |
90,15 → 86,13 |
vocabulary: RECORD |
KW: ARRAY 33 OF KEYWORD; |
delimiters: ARRAY 256 OF BOOLEAN; |
idents: AVL.NODE; |
ident: IDENT |
END; |
scanners: C.COLLECTION; |
upto: BOOLEAN; |
PROCEDURE nodecmp (a, b: AVL.DATA): INTEGER; |
109,36 → 103,27 |
PROCEDURE key (VAR lex: LEX); |
VAR |
L, R, M: INTEGER; |
found: BOOLEAN; |
BEGIN |
L := 0; |
R := LEN(vocabulary.KW) - 1; |
found := FALSE; |
REPEAT |
M := (L + R) DIV 2; |
WHILE L # M DO |
IF lex.s # vocabulary.KW[M] THEN |
IF lex.s > vocabulary.KW[M] THEN |
L := M; |
M := (L + R) DIV 2 |
ELSIF lex.s < vocabulary.KW[M] THEN |
R := M; |
M := (L + R) DIV 2 |
L := M + 1 |
ELSE |
lex.sym := lxKW + M; |
L := M; |
R := M |
R := M - 1 |
END |
END; |
IF L # R THEN |
IF lex.s = vocabulary.KW[L] THEN |
lex.sym := lxKW + L |
END; |
IF lex.s = vocabulary.KW[R] THEN |
lex.sym := lxKW + R |
ELSE |
found := TRUE; |
lex.sym := lxKW + M |
END |
END |
UNTIL found OR (L > R) |
END key; |
173,18 → 158,24 |
END putchar; |
PROCEDURE ident (text: TEXTDRV.TEXT; VAR lex: LEX); |
PROCEDURE nextc (text: TXT.TEXT): CHAR; |
BEGIN |
TXT.next(text) |
RETURN text.peak |
END nextc; |
PROCEDURE ident (text: TXT.TEXT; VAR lex: LEX); |
VAR |
c: CHAR; |
BEGIN |
c := text.peak(text); |
c := text.peak; |
ASSERT(S.letter(c)); |
WHILE S.letter(c) OR S.digit(c) DO |
putchar(lex, c); |
text.nextc(text); |
c := text.peak(text) |
c := nextc(text) |
END; |
IF lex.over THEN |
201,7 → 192,7 |
END ident; |
PROCEDURE number (text: TEXTDRV.TEXT; VAR lex: LEX; VAR range: BOOLEAN); |
PROCEDURE number (text: TXT.TEXT; VAR lex: LEX); |
VAR |
c: CHAR; |
hex: BOOLEAN; |
208,37 → 199,33 |
error: INTEGER; |
BEGIN |
c := text.peak(text); |
c := text.peak; |
ASSERT(S.digit(c)); |
error := 0; |
range := FALSE; |
lex.sym := lxINTEGER; |
hex := FALSE; |
WHILE S.digit(c) DO |
putchar(lex, c); |
text.nextc(text); |
c := text.peak(text) |
c := nextc(text) |
END; |
WHILE S.hexdigit(c) DO |
putchar(lex, c); |
text.nextc(text); |
c := text.peak(text); |
c := nextc(text); |
hex := TRUE |
END; |
IF c = "H" THEN |
putchar(lex, c); |
text.nextc(text); |
TXT.next(text); |
lex.sym := lxHEX |
ELSIF c = "X" THEN |
putchar(lex, c); |
text.nextc(text); |
TXT.next(text); |
lex.sym := lxCHAR |
ELSIF c = "." THEN |
247,8 → 234,7 |
lex.sym := lxERROR01 |
ELSE |
text.nextc(text); |
c := text.peak(text); |
c := nextc(text); |
IF c # "." THEN |
putchar(lex, "."); |
255,31 → 241,28 |
lex.sym := lxFLOAT |
ELSE |
lex.sym := lxINTEGER; |
range := TRUE |
text.peak := 7FX; |
upto := TRUE |
END; |
WHILE S.digit(c) DO |
putchar(lex, c); |
text.nextc(text); |
c := text.peak(text) |
c := nextc(text) |
END; |
IF c = "E" THEN |
putchar(lex, c); |
text.nextc(text); |
c := text.peak(text); |
c := nextc(text); |
IF (c = "+") OR (c = "-") THEN |
putchar(lex, c); |
text.nextc(text); |
c := text.peak(text) |
c := nextc(text) |
END; |
IF S.digit(c) THEN |
WHILE S.digit(c) DO |
putchar(lex, c); |
text.nextc(text); |
c := text.peak(text) |
c := nextc(text) |
END |
ELSE |
lex.sym := lxERROR02 |
289,11 → 272,8 |
END |
ELSE |
IF hex THEN |
ELSIF hex THEN |
lex.sym := lxERROR01 |
END |
END; |
321,31 → 301,23 |
END number; |
PROCEDURE string (text: TEXTDRV.TEXT; VAR lex: LEX); |
PROCEDURE string (text: TXT.TEXT; VAR lex: LEX; quot: CHAR); |
VAR |
c, c1: CHAR; |
c: CHAR; |
n: INTEGER; |
quot: CHAR; |
BEGIN |
quot := text.peak(text); |
ASSERT((quot = '"') OR (quot = "'")); |
text.nextc(text); |
c := text.peak(text); |
c1 := c; |
c := nextc(text); |
n := 0; |
WHILE (c # quot) & (c # 0X) & ~text.eol & ~text.eof DO |
putchar(lex, c); |
text.nextc(text); |
c := text.peak(text); |
c := nextc(text); |
INC(n) |
END; |
IF c = quot THEN |
text.nextc(text); |
TXT.next(text); |
IF lex.over THEN |
lex.sym := lxERROR05 |
ELSE |
353,7 → 325,7 |
lex.sym := lxSTRING |
ELSE |
lex.sym := lxCHAR; |
ARITH.setChar(lex.value, ORD(c1)) |
ARITH.setChar(lex.value, ORD(lex.s[0])) |
END |
END |
ELSE |
369,7 → 341,7 |
END string; |
PROCEDURE comment (text: TEXTDRV.TEXT); |
PROCEDURE comment (text: TXT.TEXT); |
VAR |
c: CHAR; |
cond, depth: INTEGER; |
380,8 → 352,8 |
REPEAT |
c := text.peak(text); |
text.nextc(text); |
c := text.peak; |
TXT.next(text); |
IF c = "*" THEN |
IF cond = 1 THEN |
406,21 → 378,12 |
END comment; |
PROCEDURE delimiter (text: TEXTDRV.TEXT; VAR lex: LEX; VAR range: BOOLEAN); |
VAR |
c: CHAR; |
PROCEDURE delimiter (text: TXT.TEXT; VAR lex: LEX; c: CHAR); |
BEGIN |
c := text.peak(text); |
IF range THEN |
ASSERT(c = ".") |
END; |
putchar(lex, c); |
text.nextc(text); |
c := nextc(text); |
CASE c OF |
CASE lex.s[0] OF |
|"+": |
lex.sym := lxPLUS |
433,10 → 396,10 |
|"/": |
lex.sym := lxSLASH; |
IF text.peak(text) = "/" THEN |
IF c = "/" THEN |
lex.sym := lxCOMMENT; |
REPEAT |
text.nextc(text) |
TXT.next(text) |
UNTIL text.eol OR text.eof |
END |
447,26 → 410,14 |
lex.sym := lxAND |
|".": |
IF range THEN |
putchar(lex, "."); |
lex.sym := lxRANGE; |
range := FALSE; |
DEC(lex.pos.col) |
ELSE |
lex.sym := lxPOINT; |
c := text.peak(text); |
IF c = "." THEN |
lex.sym := lxRANGE; |
putchar(lex, c); |
text.nextc(text) |
TXT.next(text) |
END |
END |
|",": |
lex.sym := lxCOMMA |
478,12 → 429,10 |
|"(": |
lex.sym := lxLROUND; |
c := text.peak(text); |
IF c = "*" THEN |
lex.sym := lxCOMMENT; |
putchar(lex, c); |
text.nextc(text); |
TXT.next(text); |
comment(text) |
END |
504,32 → 453,29 |
|"<": |
lex.sym := lxLT; |
c := text.peak(text); |
IF c = "=" THEN |
lex.sym := lxLE; |
putchar(lex, c); |
text.nextc(text) |
TXT.next(text) |
END |
|">": |
lex.sym := lxGT; |
c := text.peak(text); |
IF c = "=" THEN |
lex.sym := lxGE; |
putchar(lex, c); |
text.nextc(text) |
TXT.next(text) |
END |
|":": |
lex.sym := lxCOLON; |
c := text.peak(text); |
IF c = "=" THEN |
lex.sym := lxASSIGN; |
putchar(lex, c); |
text.nextc(text) |
TXT.next(text) |
END |
|")": |
546,26 → 492,21 |
END delimiter; |
PROCEDURE Next* (scanner: SCANNER; VAR lex: LEX); |
PROCEDURE Next* (text: SCANNER; VAR lex: LEX); |
VAR |
c: CHAR; |
text: TEXTDRV.TEXT; |
BEGIN |
text := scanner.text; |
REPEAT |
c := text.peak; |
c := text.peak(text); |
WHILE S.space(c) DO |
text.nextc(text); |
c := text.peak(text) |
c := nextc(text) |
END; |
lex.s[0] := 0X; |
lex.length := 0; |
lex.sym := lxUNDEF; |
lex.pos.line := text.line; |
lex.pos.col := text.col; |
lex.ident := NIL; |
574,19 → 515,26 |
IF S.letter(c) THEN |
ident(text, lex) |
ELSIF S.digit(c) THEN |
number(text, lex, scanner.range) |
number(text, lex) |
ELSIF (c = '"') OR (c = "'") THEN |
string(text, lex) |
string(text, lex, c) |
ELSIF vocabulary.delimiters[ORD(c)] THEN |
delimiter(text, lex, scanner.range) |
delimiter(text, lex, c) |
ELSIF c = 0X THEN |
lex.sym := lxEOF; |
IF text.eof THEN |
INC(lex.pos.col) |
END |
ELSIF (c = 7FX) & upto THEN |
upto := FALSE; |
lex.sym := lxRANGE; |
putchar(lex, "."); |
putchar(lex, "."); |
DEC(lex.pos.col); |
TXT.next(text) |
ELSE |
putchar(lex, c); |
text.nextc(text); |
TXT.next(text); |
lex.sym := lxERROR04 |
END; |
601,53 → 549,14 |
END Next; |
PROCEDURE NewScanner (): SCANNER; |
VAR |
scan: SCANNER; |
citem: C.ITEM; |
BEGIN |
citem := C.pop(scanners); |
IF citem = NIL THEN |
NEW(scan) |
ELSE |
scan := citem(SCANNER) |
END |
RETURN scan |
END NewScanner; |
PROCEDURE open* (name: ARRAY OF CHAR): SCANNER; |
VAR |
scanner: SCANNER; |
text: TEXTDRV.TEXT; |
BEGIN |
text := TEXTDRV.create(); |
IF text.open(text, name) THEN |
scanner := NewScanner(); |
scanner.text := text; |
scanner.range := FALSE |
ELSE |
scanner := NIL; |
TEXTDRV.destroy(text) |
END |
RETURN scanner |
RETURN TXT.open(name) |
END open; |
PROCEDURE close* (VAR scanner: SCANNER); |
BEGIN |
IF scanner # NIL THEN |
IF scanner.text # NIL THEN |
TEXTDRV.destroy(scanner.text) |
END; |
C.push(scanners, scanner); |
scanner := NIL |
END |
TXT.close(scanner) |
END close; |
656,6 → 565,7 |
i: INTEGER; |
delim: ARRAY 23 OF CHAR; |
PROCEDURE enterkw (VAR i: INTEGER; kw: KEYWORD); |
BEGIN |
vocabulary.KW[i] := kw; |
662,8 → 572,9 |
INC(i) |
END enterkw; |
BEGIN |
scanners := C.create(); |
upto := FALSE; |
FOR i := 0 TO 255 DO |
vocabulary.delimiters[i] := FALSE |
/programs/develop/oberon07/Source/STATEMENTS.ob07 |
---|
9,8 → 9,8 |
IMPORT |
PARS, PROG, SCAN, ARITH, STRINGS, LISTS, CODE, X86, AMD64, |
ERRORS, MACHINE, AVL := AVLTREES, CONSOLE, C := COLLECTIONS, mConst := CONSTANTS; |
PARS, PROG, SCAN, ARITH, STRINGS, LISTS, IL, X86, AMD64, MSP430, |
ERRORS, UTILS, AVL := AVLTREES, CONSOLE, C := COLLECTIONS, mConst := CONSTANTS; |
CONST |
29,7 → 29,9 |
chkALL* = {chkIDX, chkGUARD, chkPTR, chkCHR, chkWCHR, chkBYTE}; |
cpuX86 = 1; cpuAMD64 = 2; cpuMSP430 = 3; |
TYPE |
isXXX = PROCEDURE (e: PARS.EXPR): BOOLEAN; |
57,7 → 59,7 |
CASE_VARIANT = POINTER TO RECORD (LISTS.ITEM) |
label: INTEGER; |
cmd: CODE.COMMAND; |
cmd: IL.COMMAND; |
processed: BOOLEAN |
END; |
65,15 → 67,19 |
VAR |
begcall, endcall: CODE.COMMAND; |
Options: PROG.OPTIONS; |
checking: SET; |
begcall, endcall: IL.COMMAND; |
CaseLabels, CaseVar: C.COLLECTION; |
CaseVariants: LISTS.LIST; |
CPU: INTEGER; |
tINTEGER, tBYTE, tCHAR, tWCHAR, tSET, tBOOLEAN, tREAL: PROG.TYPE_; |
PROCEDURE isExpr (e: PARS.EXPR): BOOLEAN; |
RETURN e.obj IN {eCONST, eVAR, eEXPR, eVPAR, ePARAM, eVREC} |
END isExpr; |
85,17 → 91,17 |
PROCEDURE isBoolean (e: PARS.EXPR): BOOLEAN; |
RETURN isExpr(e) & (e.type.typ = PROG.tBOOLEAN) |
RETURN isExpr(e) & (e.type = tBOOLEAN) |
END isBoolean; |
PROCEDURE isInteger (e: PARS.EXPR): BOOLEAN; |
RETURN isExpr(e) & (e.type.typ = PROG.tINTEGER) |
RETURN isExpr(e) & (e.type = tINTEGER) |
END isInteger; |
PROCEDURE isByte (e: PARS.EXPR): BOOLEAN; |
RETURN isExpr(e) & (e.type.typ = PROG.tBYTE) |
RETURN isExpr(e) & (e.type = tBYTE) |
END isByte; |
105,12 → 111,12 |
PROCEDURE isReal (e: PARS.EXPR): BOOLEAN; |
RETURN isExpr(e) & (e.type.typ = PROG.tREAL) |
RETURN isExpr(e) & (e.type = tREAL) |
END isReal; |
PROCEDURE isSet (e: PARS.EXPR): BOOLEAN; |
RETURN isExpr(e) & (e.type.typ = PROG.tSET) |
RETURN isExpr(e) & (e.type = tSET) |
END isSet; |
125,30 → 131,15 |
PROCEDURE isChar (e: PARS.EXPR): BOOLEAN; |
RETURN isExpr(e) & (e.type.typ = PROG.tCHAR) |
RETURN isExpr(e) & (e.type = tCHAR) |
END isChar; |
PROCEDURE isCharArray (e: PARS.EXPR): BOOLEAN; |
RETURN isExpr(e) & (e.type.typ = PROG.tARRAY) & (e.type.base.typ = PROG.tCHAR) |
END isCharArray; |
PROCEDURE isCharW (e: PARS.EXPR): BOOLEAN; |
RETURN isExpr(e) & (e.type.typ = PROG.tWCHAR) |
RETURN isExpr(e) & (e.type = tWCHAR) |
END isCharW; |
PROCEDURE isCharArrayW (e: PARS.EXPR): BOOLEAN; |
RETURN isExpr(e) & (e.type.typ = PROG.tARRAY) & (e.type.base.typ = PROG.tWCHAR) |
END isCharArrayW; |
PROCEDURE isCharArrayX (e: PARS.EXPR): BOOLEAN; |
RETURN isExpr(e) & (e.type.typ = PROG.tARRAY) & (e.type.base.typ IN {PROG.tCHAR, PROG.tWCHAR}) |
END isCharArrayX; |
PROCEDURE isPtr (e: PARS.EXPR): BOOLEAN; |
RETURN isExpr(e) & (e.type.typ = PROG.tPOINTER) |
END isPtr; |
159,6 → 150,11 |
END isRec; |
PROCEDURE isRecPtr (e: PARS.EXPR): BOOLEAN; |
RETURN isRec(e) OR isPtr(e) |
END isRecPtr; |
PROCEDURE isArr (e: PARS.EXPR): BOOLEAN; |
RETURN isExpr(e) & (e.type.typ = PROG.tARRAY) |
END isArr; |
174,15 → 170,33 |
END isNil; |
PROCEDURE getpos (parser: PARS.PARSER; VAR pos: SCAN.POSITION); |
PROCEDURE isCharArray (e: PARS.EXPR): BOOLEAN; |
RETURN isArr(e) & (e.type.base = tCHAR) |
END isCharArray; |
PROCEDURE isCharArrayW (e: PARS.EXPR): BOOLEAN; |
RETURN isArr(e) & (e.type.base = tWCHAR) |
END isCharArrayW; |
PROCEDURE isCharArrayX (e: PARS.EXPR): BOOLEAN; |
RETURN isCharArray(e) OR isCharArrayW(e) |
END isCharArrayX; |
PROCEDURE getpos (parser: PARS.PARSER; VAR pos: PARS.POSITION); |
BEGIN |
pos := parser.lex.pos |
pos.line := parser.lex.pos.line; |
pos.col := parser.lex.pos.col; |
pos.parser := parser |
END getpos; |
PROCEDURE NextPos (parser: PARS.PARSER; VAR pos: SCAN.POSITION); |
PROCEDURE NextPos (parser: PARS.PARSER; VAR pos: PARS.POSITION); |
BEGIN |
PARS.NextPos(parser, pos) |
PARS.Next(parser); |
getpos(parser, pos) |
END NextPos; |
192,7 → 206,7 |
BEGIN |
ASSERT(isString(e)); |
IF e.type.typ = PROG.tCHAR THEN |
IF e.type = tCHAR THEN |
res := 1 |
ELSE |
res := LENGTH(e.value.string(SCAN.IDENT).s) |
266,24 → 280,24 |
IF arrcomp(e.type, t) THEN |
res := TRUE |
ELSIF isInt(e) & (t.typ IN {PROG.tBYTE, PROG.tINTEGER}) THEN |
IF (e.obj = eCONST) & (t.typ = PROG.tBYTE) THEN |
IF (e.obj = eCONST) & (t = tBYTE) THEN |
res := ARITH.range(e.value, 0, 255) |
ELSE |
res := TRUE |
END |
ELSIF isSet(e) & (t.typ = PROG.tSET) THEN |
ELSIF isSet(e) & (t = tSET) THEN |
res := TRUE |
ELSIF isBoolean(e) & (t.typ = PROG.tBOOLEAN) THEN |
ELSIF isBoolean(e) & (t = tBOOLEAN) THEN |
res := TRUE |
ELSIF isReal(e) & (t.typ = PROG.tREAL) THEN |
ELSIF isReal(e) & (t = tREAL) THEN |
res := TRUE |
ELSIF isChar(e) & (t.typ = PROG.tCHAR) THEN |
ELSIF isChar(e) & (t = tCHAR) THEN |
res := TRUE |
ELSIF (e.obj = eCONST) & isChar(e) & (t.typ = PROG.tWCHAR) THEN |
ELSIF (e.obj = eCONST) & isChar(e) & (t = tWCHAR) THEN |
res := TRUE |
ELSIF isStringW1(e) & (t.typ = PROG.tWCHAR) THEN |
ELSIF isStringW1(e) & (t = tWCHAR) THEN |
res := TRUE |
ELSIF isCharW(e) & (t.typ = PROG.tWCHAR) THEN |
ELSIF isCharW(e) & (t = tWCHAR) THEN |
res := TRUE |
ELSIF PROG.isBaseOf(t, e.type) THEN |
res := TRUE |
291,9 → 305,9 |
res := TRUE |
ELSIF isNil(e) & (t.typ IN {PROG.tPOINTER, PROG.tPROCEDURE}) THEN |
res := TRUE |
ELSIF isString(e) & ((t.typ = PROG.tARRAY) & (t.base.typ = PROG.tCHAR) & (t.length > strlen(e))) THEN |
ELSIF isString(e) & ((t.typ = PROG.tARRAY) & (t.base = tCHAR) & (t.length > strlen(e))) THEN |
res := TRUE |
ELSIF isStringW(e) & ((t.typ = PROG.tARRAY) & (t.base.typ = PROG.tWCHAR) & (t.length > utf8strlen(e))) THEN |
ELSIF isStringW(e) & ((t.typ = PROG.tARRAY) & (t.base = tWCHAR) & (t.length > utf8strlen(e))) THEN |
res := TRUE |
ELSE |
res := FALSE |
314,11 → 328,11 |
IF strlen(e) # 1 THEN |
string := e.value.string(SCAN.IDENT); |
IF string.offset = -1 THEN |
string.offset := CODE.putstr(string.s); |
string.offset := IL.putstr(string.s); |
END; |
offset := string.offset |
ELSE |
offset := CODE.putstr1(ARITH.Int(e.value)) |
offset := IL.putstr1(ARITH.Int(e.value)) |
END |
RETURN offset |
334,16 → 348,16 |
IF utf8strlen(e) # 1 THEN |
string := e.value.string(SCAN.IDENT); |
IF string.offsetW = -1 THEN |
string.offsetW := CODE.putstrW(string.s); |
string.offsetW := IL.putstrW(string.s); |
END; |
offset := string.offsetW |
ELSE |
IF e.type.typ IN {PROG.tWCHAR, PROG.tCHAR} THEN |
offset := CODE.putstrW1(ARITH.Int(e.value)) |
offset := IL.putstrW1(ARITH.Int(e.value)) |
ELSE (* e.type.typ = PROG.tSTRING *) |
string := e.value.string(SCAN.IDENT); |
IF string.offsetW = -1 THEN |
string.offsetW := CODE.putstrW(string.s); |
string.offsetW := IL.putstrW(string.s); |
END; |
offset := string.offsetW |
END |
358,10 → 372,10 |
label: INTEGER; |
BEGIN |
label := CODE.NewLabel(); |
CODE.AddCmd2(CODE.opCHKIDX, label, range); |
CODE.OnError(line, errno); |
CODE.SetLabel(label) |
label := IL.NewLabel(); |
IL.AddCmd2(IL.opCHKIDX, label, range); |
IL.OnError(line, errno); |
IL.SetLabel(label) |
END CheckRange; |
384,98 → 398,98 |
IF arrcomp(e.type, VarType) THEN |
IF ~PROG.isOpenArray(VarType) THEN |
CODE.AddCmd(CODE.opCONST, VarType.length) |
IL.Const(VarType.length) |
END; |
CODE.AddCmd(CODE.opCOPYA, VarType.base.size); |
label := CODE.NewLabel(); |
CODE.AddJmpCmd(CODE.opJE, label); |
CODE.OnError(line, errCOPY); |
CODE.SetLabel(label) |
IL.AddCmd(IL.opCOPYA, VarType.base.size); |
label := IL.NewLabel(); |
IL.AddJmpCmd(IL.opJE, label); |
IL.OnError(line, errCOPY); |
IL.SetLabel(label) |
ELSIF isInt(e) & (VarType.typ IN {PROG.tBYTE, PROG.tINTEGER}) THEN |
IF VarType.typ = PROG.tINTEGER THEN |
IF VarType = tINTEGER THEN |
IF e.obj = eCONST THEN |
CODE.AddCmd(CODE.opSAVEC, ARITH.Int(e.value)) |
IL.AddCmd(IL.opSAVEC, ARITH.Int(e.value)) |
ELSE |
CODE.AddCmd0(CODE.opSAVE) |
IL.AddCmd0(IL.opSAVE) |
END |
ELSE |
IF e.obj = eCONST THEN |
res := ARITH.range(e.value, 0, 255); |
IF res THEN |
CODE.AddCmd(CODE.opSAVE8C, ARITH.Int(e.value)) |
IL.AddCmd(IL.opSAVE8C, ARITH.Int(e.value)) |
END |
ELSE |
IF chkBYTE IN checking THEN |
label := CODE.NewLabel(); |
CODE.AddCmd2(CODE.opCHKBYTE, label, 0); |
CODE.OnError(line, errBYTE); |
CODE.SetLabel(label) |
IF chkBYTE IN Options.checking THEN |
label := IL.NewLabel(); |
IL.AddCmd2(IL.opCHKBYTE, label, 0); |
IL.OnError(line, errBYTE); |
IL.SetLabel(label) |
END; |
CODE.AddCmd0(CODE.opSAVE8) |
IL.AddCmd0(IL.opSAVE8) |
END |
END |
ELSIF isSet(e) & (VarType.typ = PROG.tSET) THEN |
ELSIF isSet(e) & (VarType = tSET) THEN |
IF e.obj = eCONST THEN |
CODE.AddCmd(CODE.opSAVEC, ARITH.Int(e.value)) |
IL.AddCmd(IL.opSAVEC, ARITH.Int(e.value)) |
ELSE |
CODE.AddCmd0(CODE.opSAVE) |
IL.AddCmd0(IL.opSAVE) |
END |
ELSIF isBoolean(e) & (VarType.typ = PROG.tBOOLEAN) THEN |
ELSIF isBoolean(e) & (VarType = tBOOLEAN) THEN |
IF e.obj = eCONST THEN |
CODE.AddCmd(CODE.opSBOOLC, ARITH.Int(e.value)) |
IL.AddCmd(IL.opSBOOLC, ARITH.Int(e.value)) |
ELSE |
CODE.AddCmd0(CODE.opSBOOL) |
IL.AddCmd0(IL.opSBOOL) |
END |
ELSIF isReal(e) & (VarType.typ = PROG.tREAL) THEN |
ELSIF isReal(e) & (VarType = tREAL) THEN |
IF e.obj = eCONST THEN |
CODE.Float(ARITH.Float(e.value)) |
IL.Float(ARITH.Float(e.value)) |
END; |
CODE.savef |
ELSIF isChar(e) & (VarType.typ = PROG.tCHAR) THEN |
IL.savef |
ELSIF isChar(e) & (VarType = tCHAR) THEN |
IF e.obj = eCONST THEN |
CODE.AddCmd(CODE.opSAVE8C, ARITH.Int(e.value)) |
IL.AddCmd(IL.opSAVE8C, ARITH.Int(e.value)) |
ELSE |
CODE.AddCmd0(CODE.opSAVE8) |
IL.AddCmd0(IL.opSAVE8) |
END |
ELSIF (e.obj = eCONST) & isChar(e) & (VarType.typ = PROG.tWCHAR) THEN |
CODE.AddCmd(CODE.opSAVE16C, ARITH.Int(e.value)) |
ELSIF isStringW1(e) & (VarType.typ = PROG.tWCHAR) THEN |
CODE.AddCmd(CODE.opSAVE16C, StrToWChar(e.value.string(SCAN.IDENT).s)) |
ELSIF isCharW(e) & (VarType.typ = PROG.tWCHAR) THEN |
ELSIF (e.obj = eCONST) & isChar(e) & (VarType = tWCHAR) THEN |
IL.AddCmd(IL.opSAVE16C, ARITH.Int(e.value)) |
ELSIF isStringW1(e) & (VarType = tWCHAR) THEN |
IL.AddCmd(IL.opSAVE16C, StrToWChar(e.value.string(SCAN.IDENT).s)) |
ELSIF isCharW(e) & (VarType = tWCHAR) THEN |
IF e.obj = eCONST THEN |
CODE.AddCmd(CODE.opSAVE16C, ARITH.Int(e.value)) |
IL.AddCmd(IL.opSAVE16C, ARITH.Int(e.value)) |
ELSE |
CODE.AddCmd0(CODE.opSAVE16) |
IL.AddCmd0(IL.opSAVE16) |
END |
ELSIF PROG.isBaseOf(VarType, e.type) THEN |
IF VarType.typ = PROG.tPOINTER THEN |
CODE.AddCmd0(CODE.opSAVE) |
IL.AddCmd0(IL.opSAVE) |
ELSE |
CODE.AddCmd(CODE.opCOPY, VarType.size) |
IL.AddCmd(IL.opCOPY, VarType.size) |
END |
ELSIF (e.type.typ = PROG.tCARD32) & (VarType.typ = PROG.tCARD32) THEN |
CODE.AddCmd0(CODE.opSAVE32) |
IL.AddCmd0(IL.opSAVE32) |
ELSIF (e.type.typ = PROG.tCARD16) & (VarType.typ = PROG.tCARD16) THEN |
CODE.AddCmd0(CODE.opSAVE16) |
IL.AddCmd0(IL.opSAVE16) |
ELSIF ~PROG.isOpenArray(VarType) & ~PROG.isOpenArray(e.type) & PROG.isTypeEq(VarType, e.type) THEN |
IF e.obj = ePROC THEN |
CODE.AssignProc(e.ident.proc.label) |
IL.AssignProc(e.ident.proc.label) |
ELSIF e.obj = eIMP THEN |
CODE.AssignImpProc(e.ident.import) |
IL.AssignImpProc(e.ident.import) |
ELSE |
IF VarType.typ = PROG.tPROCEDURE THEN |
CODE.AddCmd0(CODE.opSAVE) |
IL.AddCmd0(IL.opSAVE) |
ELSE |
CODE.AddCmd(CODE.opCOPY, VarType.size) |
IL.AddCmd(IL.opCOPY, VarType.size) |
END |
END |
ELSIF isNil(e) & (VarType.typ IN {PROG.tPOINTER, PROG.tPROCEDURE}) THEN |
CODE.AddCmd(CODE.opSAVEC, 0) |
ELSIF isString(e) & ((VarType.typ = PROG.tARRAY) & (VarType.base.typ = PROG.tCHAR) & (VarType.length > strlen(e))) THEN |
CODE.saves(String(e), strlen(e) + 1) |
ELSIF isStringW(e) & ((VarType.typ = PROG.tARRAY) & (VarType.base.typ = PROG.tWCHAR) & (VarType.length > utf8strlen(e))) THEN |
CODE.saves(StringW(e), (utf8strlen(e) + 1) * 2) |
IL.AddCmd(IL.opSAVEC, 0) |
ELSIF isString(e) & ((VarType.typ = PROG.tARRAY) & (VarType.base = tCHAR) & (VarType.length > strlen(e))) THEN |
IL.saves(String(e), strlen(e) + 1) |
ELSIF isStringW(e) & ((VarType.typ = PROG.tARRAY) & (VarType.base = tWCHAR) & (VarType.length > utf8strlen(e))) THEN |
IL.saves(StringW(e), (utf8strlen(e) + 1) * 2) |
ELSE |
res := FALSE |
END |
488,11 → 502,13 |
PROCEDURE LoadConst (e: PARS.EXPR); |
BEGIN |
CODE.AddCmd(CODE.opCONST, ARITH.Int(e.value)) |
IL.Const(ARITH.Int(e.value)) |
END LoadConst; |
PROCEDURE paramcomp (parser: PARS.PARSER; pos: SCAN.POSITION; e: PARS.EXPR; p: PROG.PARAM); |
PROCEDURE paramcomp (parser: PARS.PARSER; pos: PARS.POSITION; e: PARS.EXPR; p: PROG.PARAM); |
VAR |
stroffs: INTEGER; |
PROCEDURE arrcomp (e: PARS.EXPR; p: PROG.PARAM): BOOLEAN; |
VAR |
530,11 → 546,11 |
d1, d2: INTEGER; |
BEGIN |
IF t.length # 0 THEN |
CODE.AddCmd(CODE.opPARAM, 1); |
IL.Param1; |
n := PROG.Dim(t2) - 1; |
WHILE n >= 0 DO |
CODE.AddCmd(CODE.opCONST, ArrLen(t, n)); |
CODE.AddCmd(CODE.opPARAM, 1); |
IL.Const(ArrLen(t, n)); |
IL.Param1; |
DEC(n) |
END |
ELSE |
543,16 → 559,16 |
IF d1 # d2 THEN |
n := d2 - d1; |
WHILE d2 > d1 DO |
CODE.AddCmd(CODE.opCONST, ArrLen(t, d2 - 1)); |
IL.Const(ArrLen(t, d2 - 1)); |
DEC(d2) |
END; |
d2 := PROG.Dim(t2); |
WHILE n > 0 DO |
CODE.AddCmd(CODE.opROT, d2); |
IL.AddCmd(IL.opROT, d2); |
DEC(n) |
END |
END; |
CODE.AddCmd(CODE.opPARAM, PROG.Dim(t2) + 1) |
IL.AddCmd(IL.opPARAM, PROG.Dim(t2) + 1) |
END |
END OpenArray; |
560,87 → 576,92 |
BEGIN |
IF p.vPar THEN |
PARS.check(isVar(e), parser, pos, 93); |
PARS.check(isVar(e), pos, 93); |
IF p.type.typ = PROG.tRECORD THEN |
PARS.check(PROG.isBaseOf(p.type, e.type), parser, pos, 66); |
PARS.check(PROG.isBaseOf(p.type, e.type), pos, 66); |
IF e.obj = eVREC THEN |
IF e.ident # NIL THEN |
CODE.AddCmd(CODE.opVADR, e.ident.offset - 1) |
IL.AddCmd(IL.opVADR, e.ident.offset - 1) |
ELSE |
CODE.AddCmd0(CODE.opPUSHT) |
IL.AddCmd0(IL.opPUSHT) |
END |
ELSE |
CODE.AddCmd(CODE.opCONST, e.type.num) |
IL.Const(e.type.num) |
END; |
CODE.AddCmd(CODE.opPARAM, 2) |
IL.AddCmd(IL.opPARAM, 2) |
ELSIF PROG.isOpenArray(p.type) THEN |
PARS.check(arrcomp(e, p), parser, pos, 66); |
PARS.check(arrcomp(e, p), pos, 66); |
OpenArray(e.type, p.type) |
ELSE |
PARS.check(PROG.isTypeEq(e.type, p.type), parser, pos, 66); |
CODE.AddCmd(CODE.opPARAM, 1) |
PARS.check(PROG.isTypeEq(e.type, p.type), pos, 66); |
IL.Param1 |
END; |
PARS.check(~e.readOnly, parser, pos, 94) |
PARS.check(~e.readOnly, pos, 94) |
ELSE |
PARS.check(isExpr(e) OR isProc(e), parser, pos, 66); |
PARS.check(isExpr(e) OR isProc(e), pos, 66); |
IF PROG.isOpenArray(p.type) THEN |
IF e.type.typ = PROG.tARRAY THEN |
PARS.check(arrcomp(e, p), parser, pos, 66); |
PARS.check(arrcomp(e, p), pos, 66); |
OpenArray(e.type, p.type) |
ELSIF isString(e) & (p.type.typ = PROG.tARRAY) & (p.type.base.typ = PROG.tCHAR) THEN |
CODE.AddCmd(CODE.opSADR, String(e)); |
CODE.AddCmd(CODE.opPARAM, 1); |
CODE.AddCmd(CODE.opCONST, strlen(e) + 1); |
CODE.AddCmd(CODE.opPARAM, 1) |
ELSIF isStringW(e) & (p.type.typ = PROG.tARRAY) & (p.type.base.typ = PROG.tWCHAR) THEN |
CODE.AddCmd(CODE.opSADR, StringW(e)); |
CODE.AddCmd(CODE.opPARAM, 1); |
CODE.AddCmd(CODE.opCONST, utf8strlen(e) + 1); |
CODE.AddCmd(CODE.opPARAM, 1) |
ELSIF isString(e) & (p.type.typ = PROG.tARRAY) & (p.type.base = tCHAR) THEN |
IL.StrAdr(String(e)); |
IL.Param1; |
IL.Const(strlen(e) + 1); |
IL.Param1 |
ELSIF isStringW(e) & (p.type.typ = PROG.tARRAY) & (p.type.base = tWCHAR) THEN |
IL.StrAdr(StringW(e)); |
IL.Param1; |
IL.Const(utf8strlen(e) + 1); |
IL.Param1 |
ELSE |
PARS.error(parser, pos, 66) |
PARS.error(pos, 66) |
END |
ELSE |
PARS.check(~PROG.isOpenArray(e.type), parser, pos, 66); |
PARS.check(assigncomp(e, p.type), parser, pos, 66); |
PARS.check(~PROG.isOpenArray(e.type), pos, 66); |
PARS.check(assigncomp(e, p.type), pos, 66); |
IF e.obj = eCONST THEN |
IF e.type.typ = PROG.tREAL THEN |
CODE.Float(ARITH.Float(e.value)); |
CODE.pushf |
IF e.type = tREAL THEN |
IL.Float(ARITH.Float(e.value)); |
IL.pushf |
ELSIF e.type.typ = PROG.tNIL THEN |
CODE.AddCmd(CODE.opCONST, 0); |
CODE.AddCmd(CODE.opPARAM, 1) |
ELSIF isStringW1(e) & (p.type.typ = PROG.tWCHAR) THEN |
CODE.AddCmd(CODE.opCONST, StrToWChar(e.value.string(SCAN.IDENT).s)); |
CODE.AddCmd(CODE.opPARAM, 1) |
IL.Const(0); |
IL.Param1 |
ELSIF isStringW1(e) & (p.type = tWCHAR) THEN |
IL.Const(StrToWChar(e.value.string(SCAN.IDENT).s)); |
IL.Param1 |
ELSIF (e.type.typ = PROG.tSTRING) OR |
(e.type.typ IN {PROG.tCHAR, PROG.tWCHAR}) & (p.type.typ = PROG.tARRAY) & (p.type.base.typ IN {PROG.tCHAR, PROG.tWCHAR}) THEN |
CODE.SetMinDataSize(p.type.size); |
IF p.type.base.typ = PROG.tCHAR THEN |
CODE.AddCmd(CODE.opSADR, String(e)) |
IF p.type.base = tCHAR THEN |
stroffs := String(e); |
IL.StrAdr(stroffs); |
IF (CPU = cpuMSP430) & (p.type.size - strlen(e) - 1 > MSP430.IntVectorSize) THEN |
ERRORS.WarningMsg(pos.line, pos.col, 0) |
END |
ELSE (* WCHAR *) |
CODE.AddCmd(CODE.opSADR, StringW(e)) |
stroffs := StringW(e); |
IL.StrAdr(stroffs) |
END; |
CODE.AddCmd(CODE.opPARAM, 1) |
IL.codes.dmin := stroffs + p.type.size; |
IL.Param1 |
ELSE |
LoadConst(e); |
CODE.AddCmd(CODE.opPARAM, 1) |
IL.Param1 |
END |
ELSIF e.obj = ePROC THEN |
PARS.check(e.ident.global, parser, pos, 85); |
CODE.PushProc(e.ident.proc.label); |
CODE.AddCmd(CODE.opPARAM, 1) |
PARS.check(e.ident.global, pos, 85); |
IL.PushProc(e.ident.proc.label); |
IL.Param1 |
ELSIF e.obj = eIMP THEN |
CODE.PushImpProc(e.ident.import); |
CODE.AddCmd(CODE.opPARAM, 1) |
ELSIF isExpr(e) & (e.type.typ = PROG.tREAL) THEN |
CODE.pushf |
IL.PushImpProc(e.ident.import); |
IL.Param1 |
ELSIF isExpr(e) & (e.type = tREAL) THEN |
IL.pushf |
ELSE |
IF (p.type.typ = PROG.tBYTE) & (e.type.typ = PROG.tINTEGER) & (chkBYTE IN checking) THEN |
IF (p.type = tBYTE) & (e.type = tINTEGER) & (chkBYTE IN Options.checking) THEN |
CheckRange(256, pos.line, errBYTE) |
END; |
CODE.AddCmd(CODE.opPARAM, 1) |
IL.Param1 |
END |
END |
648,10 → 669,16 |
END paramcomp; |
PROCEDURE PExpression (parser: PARS.PARSER; VAR e: PARS.EXPR); |
BEGIN |
parser.expression(parser, e) |
END PExpression; |
PROCEDURE stProc (parser: PARS.PARSER; VAR e: PARS.EXPR); |
VAR |
e2: PARS.EXPR; |
pos: SCAN.POSITION; |
pos: PARS.POSITION; |
proc: INTEGER; |
label: INTEGER; |
n, i: INTEGER; |
659,16 → 686,17 |
e1: PARS.EXPR; |
wchar: BOOLEAN; |
cmd1, |
cmd2: CODE.COMMAND; |
cmd2: IL.COMMAND; |
comma: BOOLEAN; |
PROCEDURE varparam (parser: PARS.PARSER; pos: SCAN.POSITION; isfunc: isXXX; readOnly: BOOLEAN; VAR e: PARS.EXPR); |
PROCEDURE varparam (parser: PARS.PARSER; pos: PARS.POSITION; isfunc: isXXX; readOnly: BOOLEAN; VAR e: PARS.EXPR); |
BEGIN |
parser.designator(parser, e); |
PARS.check(isVar(e), parser, pos, 93); |
PARS.check(isfunc(e), parser, pos, 66); |
PARS.check(isVar(e), pos, 93); |
PARS.check(isfunc(e), pos, 66); |
IF readOnly THEN |
PARS.check(~e.readOnly, parser, pos, 94) |
PARS.check(~e.readOnly, pos, 94) |
END |
END varparam; |
691,13 → 719,18 |
BEGIN |
ASSERT(e.obj IN {eSTPROC, eSTFUNC, eSYSPROC, eSYSFUNC}); |
proc := e.stproc; |
(* IF (proc # PROG.sysNOP) & (proc # PROG.sysEINT) & (proc # PROG.sysDINT) THEN *) |
PARS.checklex(parser, SCAN.lxLROUND); |
PARS.Next(parser); |
(* END; *) |
getpos(parser, pos); |
proc := e.stproc; |
IF e.obj IN {eSYSPROC, eSYSFUNC} THEN |
IF parser.unit.scopeLvl > 0 THEN |
parser.unit.scopes[parser.unit.scopeLvl].enter(CODE.COMMAND).allocReg := FALSE |
parser.unit.scopes[parser.unit.scopeLvl].enter(IL.COMMAND).allocReg := FALSE |
END |
END; |
705,90 → 738,93 |
CASE proc OF |
|PROG.stASSERT: |
parser.expression(parser, e); |
PARS.check(isBoolean(e), parser, pos, 66); |
PExpression(parser, e); |
PARS.check(isBoolean(e), pos, 66); |
IF e.obj = eCONST THEN |
IF ~ARITH.getBool(e.value) THEN |
CODE.OnError(pos.line, errASSERT) |
IL.OnError(pos.line, errASSERT) |
END |
ELSE |
label := CODE.NewLabel(); |
CODE.AddJmpCmd(CODE.opJE, label); |
CODE.OnError(pos.line, errASSERT); |
CODE.SetLabel(label) |
label := IL.NewLabel(); |
IL.AddJmpCmd(IL.opJE, label); |
IL.OnError(pos.line, errASSERT); |
IL.SetLabel(label) |
END |
|PROG.stINC, PROG.stDEC: |
CODE.pushBegEnd(begcall, endcall); |
IL.pushBegEnd(begcall, endcall); |
varparam(parser, pos, isInt, TRUE, e); |
IF e.type.typ = PROG.tINTEGER THEN |
IF e.type = tINTEGER THEN |
IF parser.sym = SCAN.lxCOMMA THEN |
NextPos(parser, pos); |
CODE.setlast(begcall); |
parser.expression(parser, e2); |
CODE.setlast(endcall.prev(CODE.COMMAND)); |
PARS.check(isInt(e2), parser, pos, 66); |
IL.setlast(begcall); |
PExpression(parser, e2); |
IL.setlast(endcall.prev(IL.COMMAND)); |
PARS.check(isInt(e2), pos, 66); |
IF e2.obj = eCONST THEN |
CODE.AddCmd(CODE.opINCC + ORD(proc = PROG.stDEC), ARITH.Int(e2.value)) |
IL.AddCmd(IL.opINCC, ARITH.Int(e2.value) * (ORD(proc = PROG.stINC) * 2 - 1)) |
ELSE |
CODE.AddCmd0(CODE.opINC + ORD(proc = PROG.stDEC)) |
IL.AddCmd0(IL.opINC + ORD(proc = PROG.stDEC)) |
END |
ELSE |
CODE.AddCmd0(CODE.opINC1 + ORD(proc = PROG.stDEC)) |
IL.AddCmd(IL.opINCC, ORD(proc = PROG.stINC) * 2 - 1) |
END |
ELSE (* e.type.typ = PROG.tBYTE *) |
ELSE (* e.type = tBYTE *) |
IF parser.sym = SCAN.lxCOMMA THEN |
NextPos(parser, pos); |
CODE.setlast(begcall); |
parser.expression(parser, e2); |
CODE.setlast(endcall.prev(CODE.COMMAND)); |
PARS.check(isInt(e2), parser, pos, 66); |
IL.setlast(begcall); |
PExpression(parser, e2); |
IL.setlast(endcall.prev(IL.COMMAND)); |
PARS.check(isInt(e2), pos, 66); |
IF e2.obj = eCONST THEN |
CODE.AddCmd(CODE.opINCCB + ORD(proc = PROG.stDEC), ARITH.Int(e2.value)) |
IL.AddCmd(IL.opINCCB + ORD(proc = PROG.stDEC), ARITH.Int(e2.value)) |
ELSE |
CODE.AddCmd0(CODE.opINCB + ORD(proc = PROG.stDEC)) |
IL.AddCmd0(IL.opINCB + ORD(proc = PROG.stDEC)) |
END |
ELSE |
CODE.AddCmd0(CODE.opINC1B + ORD(proc = PROG.stDEC)) |
IL.AddCmd(IL.opINCCB + ORD(proc = PROG.stDEC), 1) |
END |
END; |
CODE.popBegEnd(begcall, endcall) |
IL.popBegEnd(begcall, endcall) |
|PROG.stINCL, PROG.stEXCL: |
CODE.pushBegEnd(begcall, endcall); |
IL.pushBegEnd(begcall, endcall); |
varparam(parser, pos, isSet, TRUE, e); |
PARS.checklex(parser, SCAN.lxCOMMA); |
NextPos(parser, pos); |
CODE.setlast(begcall); |
parser.expression(parser, e2); |
CODE.setlast(endcall.prev(CODE.COMMAND)); |
PARS.check(isInt(e2), parser, pos, 66); |
IL.setlast(begcall); |
PExpression(parser, e2); |
IL.setlast(endcall.prev(IL.COMMAND)); |
PARS.check(isInt(e2), pos, 66); |
IF e2.obj = eCONST THEN |
PARS.check(ARITH.range(e2.value, 0, MACHINE.target.maxSet), parser, pos, 56); |
CODE.AddCmd(CODE.opINCLC + ORD(proc = PROG.stEXCL), ARITH.Int(e2.value)) |
PARS.check(ARITH.range(e2.value, 0, UTILS.target.maxSet), pos, 56); |
IL.AddCmd(IL.opINCLC + ORD(proc = PROG.stEXCL), ARITH.Int(e2.value)) |
ELSE |
CODE.AddCmd0(CODE.opINCL + ORD(proc = PROG.stEXCL)) |
IL.AddCmd0(IL.opINCL + ORD(proc = PROG.stEXCL)) |
END; |
CODE.popBegEnd(begcall, endcall) |
IL.popBegEnd(begcall, endcall) |
|PROG.stNEW: |
varparam(parser, pos, isPtr, TRUE, e); |
CODE.New(e.type.base.size, e.type.base.num) |
IF CPU = cpuMSP430 THEN |
PARS.check(e.type.base.size + 16 < Options.ram, pos, 63) |
END; |
IL.New(e.type.base.size, e.type.base.num) |
|PROG.stDISPOSE: |
varparam(parser, pos, isPtr, TRUE, e); |
CODE.AddCmd0(CODE.opDISP) |
IL.AddCmd0(IL.opDISP) |
|PROG.stPACK: |
varparam(parser, pos, isReal, TRUE, e); |
PARS.checklex(parser, SCAN.lxCOMMA); |
NextPos(parser, pos); |
parser.expression(parser, e2); |
PARS.check(isInt(e2), parser, pos, 66); |
PExpression(parser, e2); |
PARS.check(isInt(e2), pos, 66); |
IF e2.obj = eCONST THEN |
CODE.AddCmd(CODE.opPACKC, ARITH.Int(e2.value)) |
IL.AddCmd(IL.opPACKC, ARITH.Int(e2.value)) |
ELSE |
CODE.AddCmd0(CODE.opPACK) |
IL.AddCmd0(IL.opPACK) |
END |
|PROG.stUNPK: |
796,24 → 832,26 |
PARS.checklex(parser, SCAN.lxCOMMA); |
NextPos(parser, pos); |
varparam(parser, pos, isInteger, TRUE, e2); |
CODE.AddCmd0(CODE.opUNPK) |
IL.AddCmd0(IL.opUNPK) |
|PROG.stCOPY: |
parser.expression(parser, e); |
IL.pushBegEnd(begcall, endcall); |
PExpression(parser, e); |
IF isString(e) OR isCharArray(e) THEN |
wchar := FALSE |
ELSIF isStringW(e) OR isCharArrayW(e) THEN |
wchar := TRUE |
ELSE |
PARS.check(FALSE, parser, pos, 66) |
PARS.error(pos, 66) |
END; |
IF isCharArrayX(e) & ~PROG.isOpenArray(e.type) THEN |
CODE.AddCmd(CODE.opCONST, e.type.length) |
IL.Const(e.type.length) |
END; |
PARS.checklex(parser, SCAN.lxCOMMA); |
NextPos(parser, pos); |
IL.setlast(begcall); |
IF wchar THEN |
varparam(parser, pos, isCharArrayW, TRUE, e1) |
824,96 → 862,96 |
varparam(parser, pos, isCharArray, TRUE, e1) |
END; |
wchar := e1.type.base.typ = PROG.tWCHAR |
wchar := e1.type.base = tWCHAR |
END; |
IF ~PROG.isOpenArray(e1.type) THEN |
CODE.AddCmd(CODE.opCONST, e1.type.length) |
IL.Const(e1.type.length) |
END; |
IL.setlast(endcall.prev(IL.COMMAND)); |
IF e.obj = eCONST THEN |
IF wchar THEN |
CODE.AddCmd(CODE.opSADR, StringW(e)); |
CODE.AddCmd(CODE.opCONST, utf8strlen(e) + 1) |
IL.StrAdr(StringW(e)); |
IL.Const(utf8strlen(e) + 1) |
ELSE |
CODE.AddCmd(CODE.opSADR, String(e)); |
CODE.AddCmd(CODE.opCONST, strlen(e) + 1) |
IL.StrAdr(String(e)); |
IL.Const(strlen(e) + 1) |
END |
END; |
CODE.AddCmd(CODE.opCOPYS2, e1.type.base.size) |
ELSE |
CODE.AddCmd(CODE.opCOPYS, e1.type.base.size) |
END |
IL.AddCmd(IL.opCOPYS, e1.type.base.size); |
IL.popBegEnd(begcall, endcall) |
|PROG.sysGET: |
parser.expression(parser, e); |
PARS.check(isInt(e), parser, pos, 66); |
IF e.obj = eCONST THEN |
LoadConst(e) |
END; |
PExpression(parser, e); |
PARS.check(isInt(e), pos, 66); |
PARS.checklex(parser, SCAN.lxCOMMA); |
NextPos(parser, pos); |
parser.designator(parser, e2); |
PARS.check(isVar(e2), parser, pos, 93); |
PARS.check((e2.type.typ IN PROG.BASICTYPES) OR (e2.type.typ = PROG.tPOINTER) OR (e2.type.typ = PROG.tPROCEDURE), parser, pos, 66); |
CODE.SysGet(e2.type.size) |
PARS.check(isVar(e2), pos, 93); |
PARS.check(e2.type.typ IN PROG.BASICTYPES + {PROG.tPOINTER, PROG.tPROCEDURE}, pos, 66); |
IF e.obj = eCONST THEN |
IL.AddCmd2(IL.opGETC, ARITH.Int(e.value), e2.type.size) |
ELSE |
IL.AddCmd(IL.opGET, e2.type.size) |
END |
|PROG.sysPUT, PROG.sysPUT8, PROG.sysPUT16, PROG.sysPUT32: |
CODE.pushBegEnd(begcall, endcall); |
parser.expression(parser, e); |
PARS.check(isInt(e), parser, pos, 66); |
IL.pushBegEnd(begcall, endcall); |
PExpression(parser, e); |
PARS.check(isInt(e), pos, 66); |
IF e.obj = eCONST THEN |
LoadConst(e) |
END; |
PARS.checklex(parser, SCAN.lxCOMMA); |
NextPos(parser, pos); |
CODE.setlast(begcall); |
parser.expression(parser, e2); |
PARS.check(isExpr(e2), parser, pos, 66); |
IL.setlast(begcall); |
PExpression(parser, e2); |
PARS.check(isExpr(e2), pos, 66); |
IF proc = PROG.sysPUT THEN |
PARS.check((e2.type.typ IN PROG.BASICTYPES) OR (e2.type.typ = PROG.tPOINTER) OR (e2.type.typ = PROG.tPROCEDURE), parser, pos, 66); |
PARS.check(e2.type.typ IN PROG.BASICTYPES + {PROG.tPOINTER, PROG.tPROCEDURE}, pos, 66); |
IF e2.obj = eCONST THEN |
IF e2.type.typ = PROG.tREAL THEN |
CODE.setlast(endcall.prev(CODE.COMMAND)); |
CODE.Float(ARITH.Float(e2.value)); |
CODE.savef |
IF e2.type = tREAL THEN |
IL.setlast(endcall.prev(IL.COMMAND)); |
IL.Float(ARITH.Float(e2.value)); |
IL.savef |
ELSE |
LoadConst(e2); |
CODE.setlast(endcall.prev(CODE.COMMAND)); |
CODE.SysPut(e2.type.size) |
IL.setlast(endcall.prev(IL.COMMAND)); |
IL.SysPut(e2.type.size) |
END |
ELSE |
CODE.setlast(endcall.prev(CODE.COMMAND)); |
IF e2.type.typ = PROG.tREAL THEN |
CODE.savef |
ELSIF e2.type.typ = PROG.tBYTE THEN |
CODE.SysPut(PARS.program.stTypes.tINTEGER.size) |
IL.setlast(endcall.prev(IL.COMMAND)); |
IF e2.type = tREAL THEN |
IL.savef |
ELSIF e2.type = tBYTE THEN |
IL.SysPut(tINTEGER.size) |
ELSE |
CODE.SysPut(e2.type.size) |
IL.SysPut(e2.type.size) |
END |
END |
ELSIF (proc = PROG.sysPUT8) OR (proc = PROG.sysPUT16) OR (proc = PROG.sysPUT32) THEN |
PARS.check(e2.type.typ IN {PROG.tINTEGER, PROG.tBYTE, PROG.tCHAR, PROG.tWCHAR, PROG.tCARD16, PROG.tCARD32}, parser, pos, 66); |
PARS.check(e2.type.typ IN {PROG.tINTEGER, PROG.tBYTE, PROG.tCHAR, PROG.tSET, PROG.tWCHAR, PROG.tCARD16, PROG.tCARD32}, pos, 66); |
IF e2.obj = eCONST THEN |
LoadConst(e2) |
END; |
CODE.setlast(endcall.prev(CODE.COMMAND)); |
IF proc = PROG.sysPUT8 THEN |
CODE.SysPut(1) |
ELSIF proc = PROG.sysPUT16 THEN |
CODE.SysPut(2) |
ELSIF proc = PROG.sysPUT32 THEN |
CODE.SysPut(4) |
IL.setlast(endcall.prev(IL.COMMAND)); |
CASE proc OF |
|PROG.sysPUT8: IL.SysPut(1) |
|PROG.sysPUT16: IL.SysPut(2) |
|PROG.sysPUT32: IL.SysPut(4) |
END |
END; |
CODE.popBegEnd(begcall, endcall) |
IL.popBegEnd(begcall, endcall) |
|PROG.sysMOVE: |
FOR i := 1 TO 2 DO |
parser.expression(parser, e); |
PARS.check(isInt(e), parser, pos, 66); |
PExpression(parser, e); |
PARS.check(isInt(e), pos, 66); |
IF e.obj = eCONST THEN |
LoadConst(e) |
END; |
921,20 → 959,20 |
NextPos(parser, pos) |
END; |
parser.expression(parser, e); |
PARS.check(isInt(e), parser, pos, 66); |
PExpression(parser, e); |
PARS.check(isInt(e), pos, 66); |
IF e.obj = eCONST THEN |
LoadConst(e) |
END; |
CODE.AddCmd0(CODE.opMOVE) |
IL.AddCmd0(IL.opMOVE) |
|PROG.sysCOPY: |
FOR i := 1 TO 2 DO |
parser.designator(parser, e); |
PARS.check(isVar(e), parser, pos, 93); |
PARS.check(isVar(e), pos, 93); |
n := PROG.Dim(e.type); |
WHILE n > 0 DO |
CODE.drop; |
IL.drop; |
DEC(n) |
END; |
PARS.checklex(parser, SCAN.lxCOMMA); |
941,27 → 979,43 |
NextPos(parser, pos) |
END; |
parser.expression(parser, e); |
PARS.check(isInt(e), parser, pos, 66); |
PExpression(parser, e); |
PARS.check(isInt(e), pos, 66); |
IF e.obj = eCONST THEN |
LoadConst(e) |
END; |
CODE.AddCmd0(CODE.opMOVE) |
IL.AddCmd0(IL.opMOVE) |
|PROG.sysCODE: |
REPEAT |
getpos(parser, pos); |
PARS.ConstExpression(parser, code); |
PARS.check(code.typ = ARITH.tINTEGER, parser, pos, 43); |
PARS.check(ARITH.range(code, 0, 255), parser, pos, 42); |
IF parser.sym = SCAN.lxCOMMA THEN |
PARS.check(code.typ = ARITH.tINTEGER, pos, 43); |
IF CPU # cpuMSP430 THEN |
PARS.check(ARITH.range(code, 0, 255), pos, 42) |
END; |
IL.AddCmd(IL.opCODE, ARITH.getInt(code)); |
comma := parser.sym = SCAN.lxCOMMA; |
IF comma THEN |
PARS.Next(parser) |
ELSE |
PARS.checklex(parser, SCAN.lxRROUND) |
END |
UNTIL (parser.sym = SCAN.lxRROUND) & ~comma |
(* |
|PROG.sysNOP, PROG.sysDINT, PROG.sysEINT: |
IF parser.sym = SCAN.lxLROUND THEN |
PARS.Next(parser); |
PARS.checklex(parser, SCAN.lxRROUND); |
PARS.Next(parser) |
END; |
CODE.AddCmd(CODE.opCODE, ARITH.getInt(code)) |
UNTIL parser.sym = SCAN.lxRROUND |
ASSERT(CPU = cpuMSP430); |
CASE proc OF |
|PROG.sysNOP: IL.AddCmd(IL.opCODE, 4303H) |
|PROG.sysDINT: IL.AddCmd(IL.opCODE, 0C232H); IL.AddCmd(IL.opCODE, 4303H) |
|PROG.sysEINT: IL.AddCmd(IL.opCODE, 0D232H) |
END |
*) |
END; |
e.obj := eEXPR; |
971,129 → 1025,129 |
CASE e.stproc OF |
|PROG.stABS: |
parser.expression(parser, e); |
PARS.check(isInt(e) OR isReal(e), parser, pos, 66); |
PExpression(parser, e); |
PARS.check(isInt(e) OR isReal(e), pos, 66); |
IF e.obj = eCONST THEN |
PARS.check(ARITH.abs(e.value), parser, pos, 39) |
PARS.check(ARITH.abs(e.value), pos, 39) |
ELSE |
CODE.abs(isReal(e)) |
IL.abs(isReal(e)) |
END |
|PROG.stASR, PROG.stLSL, PROG.stROR, PROG.stLSR, PROG.stMIN, PROG.stMAX: |
parser.expression(parser, e); |
PARS.check(isInt(e), parser, pos, 66); |
PExpression(parser, e); |
PARS.check(isInt(e), pos, 66); |
PARS.checklex(parser, SCAN.lxCOMMA); |
NextPos(parser, pos); |
parser.expression(parser, e2); |
PARS.check(isInt(e2), parser, pos, 66); |
e.type := PARS.program.stTypes.tINTEGER; |
PExpression(parser, e2); |
PARS.check(isInt(e2), pos, 66); |
e.type := tINTEGER; |
IF (e.obj = eCONST) & (e2.obj = eCONST) THEN |
ASSERT(ARITH.opInt(e.value, e2.value, shift_minmax(proc))) |
ELSE |
IF e.obj = eCONST THEN |
CODE.shift_minmax1(shift_minmax(proc), ARITH.Int(e.value)) |
IL.shift_minmax1(shift_minmax(proc), ARITH.Int(e.value)) |
ELSIF e2.obj = eCONST THEN |
CODE.shift_minmax2(shift_minmax(proc), ARITH.Int(e2.value)) |
IL.shift_minmax2(shift_minmax(proc), ARITH.Int(e2.value)) |
ELSE |
CODE.shift_minmax(shift_minmax(proc)) |
IL.shift_minmax(shift_minmax(proc)) |
END; |
e.obj := eEXPR |
END |
|PROG.stCHR: |
parser.expression(parser, e); |
PARS.check(isInt(e), parser, pos, 66); |
e.type := PARS.program.stTypes.tCHAR; |
PExpression(parser, e); |
PARS.check(isInt(e), pos, 66); |
e.type := tCHAR; |
IF e.obj = eCONST THEN |
ARITH.setChar(e.value, ARITH.getInt(e.value)); |
PARS.check(ARITH.check(e.value), parser, pos, 107) |
PARS.check(ARITH.check(e.value), pos, 107) |
ELSE |
IF chkCHR IN checking THEN |
IF chkCHR IN Options.checking THEN |
CheckRange(256, pos.line, errCHR) |
ELSE |
CODE.AddCmd0(CODE.opCHR) |
IL.AddCmd0(IL.opCHR) |
END |
END |
|PROG.stWCHR: |
parser.expression(parser, e); |
PARS.check(isInt(e), parser, pos, 66); |
e.type := PARS.program.stTypes.tWCHAR; |
PExpression(parser, e); |
PARS.check(isInt(e), pos, 66); |
e.type := tWCHAR; |
IF e.obj = eCONST THEN |
ARITH.setWChar(e.value, ARITH.getInt(e.value)); |
PARS.check(ARITH.check(e.value), parser, pos, 101) |
PARS.check(ARITH.check(e.value), pos, 101) |
ELSE |
IF chkWCHR IN checking THEN |
IF chkWCHR IN Options.checking THEN |
CheckRange(65536, pos.line, errWCHR) |
ELSE |
CODE.AddCmd0(CODE.opWCHR) |
IL.AddCmd0(IL.opWCHR) |
END |
END |
|PROG.stFLOOR: |
parser.expression(parser, e); |
PARS.check(isReal(e), parser, pos, 66); |
e.type := PARS.program.stTypes.tINTEGER; |
PExpression(parser, e); |
PARS.check(isReal(e), pos, 66); |
e.type := tINTEGER; |
IF e.obj = eCONST THEN |
PARS.check(ARITH.floor(e.value), parser, pos, 39) |
PARS.check(ARITH.floor(e.value), pos, 39) |
ELSE |
CODE.floor |
IL.floor |
END |
|PROG.stFLT: |
parser.expression(parser, e); |
PARS.check(isInt(e), parser, pos, 66); |
e.type := PARS.program.stTypes.tREAL; |
PExpression(parser, e); |
PARS.check(isInt(e), pos, 66); |
e.type := tREAL; |
IF e.obj = eCONST THEN |
ARITH.flt(e.value) |
ELSE |
PARS.check(CODE.flt(), parser, pos, 41) |
PARS.check(IL.flt(), pos, 41) |
END |
|PROG.stLEN: |
cmd1 := CODE.getlast(); |
cmd1 := IL.getlast(); |
varparam(parser, pos, isArr, FALSE, e); |
IF e.type.length > 0 THEN |
cmd2 := CODE.getlast(); |
CODE.delete2(cmd1.next, cmd2); |
CODE.setlast(cmd1); |
cmd2 := IL.getlast(); |
IL.delete2(cmd1.next, cmd2); |
IL.setlast(cmd1); |
ASSERT(ARITH.setInt(e.value, e.type.length)); |
e.obj := eCONST |
ELSE |
CODE.len(PROG.Dim(e.type)) |
IL.len(PROG.Dim(e.type)) |
END; |
e.type := PARS.program.stTypes.tINTEGER |
e.type := tINTEGER |
|PROG.stLENGTH: |
parser.expression(parser, e); |
PExpression(parser, e); |
IF isCharArray(e) THEN |
IF e.type.length > 0 THEN |
CODE.AddCmd(CODE.opCONST, e.type.length) |
IL.Const(e.type.length) |
END; |
CODE.AddCmd0(CODE.opLENGTH) |
IL.AddCmd0(IL.opLENGTH) |
ELSIF isCharArrayW(e) THEN |
IF e.type.length > 0 THEN |
CODE.AddCmd(CODE.opCONST, e.type.length) |
IL.Const(e.type.length) |
END; |
CODE.AddCmd0(CODE.opLENGTHW) |
IL.AddCmd0(IL.opLENGTHW) |
ELSE |
PARS.check(FALSE, parser, pos, 66); |
PARS.error(pos, 66); |
END; |
e.type := PARS.program.stTypes.tINTEGER |
e.type := tINTEGER |
|PROG.stODD: |
parser.expression(parser, e); |
PARS.check(isInt(e), parser, pos, 66); |
e.type := PARS.program.stTypes.tBOOLEAN; |
PExpression(parser, e); |
PARS.check(isInt(e), pos, 66); |
e.type := tBOOLEAN; |
IF e.obj = eCONST THEN |
ARITH.odd(e.value) |
ELSE |
CODE.odd |
IL.odd |
END |
|PROG.stORD: |
parser.expression(parser, e); |
PARS.check(isChar(e) OR isBoolean(e) OR isSet(e) OR isCharW(e) OR isStringW1(e), parser, pos, 66); |
PExpression(parser, e); |
PARS.check(isChar(e) OR isBoolean(e) OR isSet(e) OR isCharW(e) OR isStringW1(e), pos, 66); |
IF e.obj = eCONST THEN |
IF isStringW1(e) THEN |
ASSERT(ARITH.setInt(e.value, StrToWChar(e.value.string(SCAN.IDENT).s))) |
1102,18 → 1156,18 |
END |
ELSE |
IF isBoolean(e) THEN |
CODE.ord |
IL.ord |
END |
END; |
e.type := PARS.program.stTypes.tINTEGER |
e.type := tINTEGER |
|PROG.stBITS: |
parser.expression(parser, e); |
PARS.check(isInt(e), parser, pos, 66); |
PExpression(parser, e); |
PARS.check(isInt(e), pos, 66); |
IF e.obj = eCONST THEN |
ARITH.bits(e.value) |
END; |
e.type := PARS.program.stTypes.tSET |
e.type := tSET |
|PROG.sysADR: |
parser.designator(parser, e); |
1120,63 → 1174,65 |
IF isVar(e) THEN |
n := PROG.Dim(e.type); |
WHILE n > 0 DO |
CODE.drop; |
IL.drop; |
DEC(n) |
END |
ELSIF e.obj = ePROC THEN |
CODE.PushProc(e.ident.proc.label) |
IL.PushProc(e.ident.proc.label) |
ELSIF e.obj = eIMP THEN |
CODE.PushImpProc(e.ident.import) |
IL.PushImpProc(e.ident.import) |
ELSE |
PARS.check(FALSE, parser, pos, 108) |
PARS.error(pos, 108) |
END; |
e.type := PARS.program.stTypes.tINTEGER |
e.type := tINTEGER |
|PROG.sysSADR: |
parser.expression(parser, e); |
PARS.check(isString(e), parser, pos, 66); |
CODE.AddCmd(CODE.opSADR, String(e)); |
e.type := PARS.program.stTypes.tINTEGER; |
PExpression(parser, e); |
PARS.check(isString(e), pos, 66); |
IL.StrAdr(String(e)); |
e.type := tINTEGER; |
e.obj := eEXPR |
|PROG.sysWSADR: |
parser.expression(parser, e); |
PARS.check(isStringW(e), parser, pos, 66); |
CODE.AddCmd(CODE.opSADR, StringW(e)); |
e.type := PARS.program.stTypes.tINTEGER; |
PExpression(parser, e); |
PARS.check(isStringW(e), pos, 66); |
IL.StrAdr(StringW(e)); |
e.type := tINTEGER; |
e.obj := eEXPR |
|PROG.sysTYPEID: |
parser.expression(parser, e); |
PARS.check(e.obj = eTYPE, parser, pos, 68); |
PExpression(parser, e); |
PARS.check(e.obj = eTYPE, pos, 68); |
IF e.type.typ = PROG.tRECORD THEN |
ASSERT(ARITH.setInt(e.value, e.type.num)) |
ELSIF e.type.typ = PROG.tPOINTER THEN |
ASSERT(ARITH.setInt(e.value, e.type.base.num)) |
ELSE |
PARS.check(FALSE, parser, pos, 52) |
PARS.error(pos, 52) |
END; |
e.obj := eCONST; |
e.type := PARS.program.stTypes.tINTEGER |
e.type := tINTEGER |
|PROG.sysINF: |
PARS.check(CODE.inf(), parser, pos, 41); |
PARS.check(IL.inf(), pos, 41); |
e.obj := eEXPR; |
e.type := PARS.program.stTypes.tREAL |
e.type := tREAL |
|PROG.sysSIZE: |
parser.expression(parser, e); |
PARS.check(e.obj = eTYPE, parser, pos, 68); |
PExpression(parser, e); |
PARS.check(e.obj = eTYPE, pos, 68); |
ASSERT(ARITH.setInt(e.value, e.type.size)); |
e.obj := eCONST; |
e.type := PARS.program.stTypes.tINTEGER |
e.type := tINTEGER |
END |
END; |
(* IF (proc # PROG.sysNOP) & (proc # PROG.sysEINT) & (proc # PROG.sysDINT) THEN *) |
PARS.checklex(parser, SCAN.lxRROUND); |
PARS.Next(parser); |
(* END; *) |
IF e.obj # eCONST THEN |
e.obj := eEXPR |
1190,7 → 1246,7 |
proc: PROG.TYPE_; |
param: LISTS.ITEM; |
e1: PARS.EXPR; |
pos: SCAN.POSITION; |
pos: PARS.POSITION; |
BEGIN |
ASSERT(parser.sym = SCAN.lxLROUND); |
1204,12 → 1260,12 |
WHILE param # NIL DO |
getpos(parser, pos); |
CODE.setlast(begcall); |
IL.setlast(begcall); |
IF param(PROG.PARAM).vPar THEN |
parser.designator(parser, e1) |
ELSE |
parser.expression(parser, e1) |
PExpression(parser, e1) |
END; |
paramcomp(parser, pos, e1, param(PROG.PARAM)); |
param := param.next; |
1226,7 → 1282,6 |
e.type := proc.base |
ELSIF e.obj IN {eSTPROC, eSTFUNC, eSYSPROC, eSYSFUNC} THEN |
PARS.Next(parser); |
stProc(parser, e) |
ELSE |
PARS.check1(FALSE, parser, 86) |
1239,18 → 1294,18 |
VAR |
ident: PROG.IDENT; |
import: BOOLEAN; |
pos: SCAN.POSITION; |
pos: PARS.POSITION; |
BEGIN |
PARS.checklex(parser, SCAN.lxIDENT); |
getpos(parser, pos); |
import := FALSE; |
ident := parser.unit.idents.get(parser.unit, parser.lex.ident, FALSE); |
ident := PROG.getIdent(parser.unit, parser.lex.ident, FALSE); |
PARS.check1(ident # NIL, parser, 48); |
IF ident.typ = PROG.idMODULE THEN |
PARS.ExpectSym(parser, SCAN.lxPOINT); |
PARS.ExpectSym(parser, SCAN.lxIDENT); |
ident := ident.unit.idents.get(ident.unit, parser.lex.ident, FALSE); |
ident := PROG.getIdent(ident.unit, parser.lex.ident, FALSE); |
PARS.check1((ident # NIL) & ident.export, parser, 48); |
import := TRUE |
END; |
1298,34 → 1353,34 |
e.obj := eSYSPROC; |
e.stproc := ident.stproc |
|PROG.idSYSFUNC: |
PARS.check(~parser.constexp, parser, pos, 109); |
PARS.check(~parser.constexp, pos, 109); |
e.obj := eSYSFUNC; |
e.stproc := ident.stproc |
|PROG.idNONE: |
PARS.check(FALSE, parser, pos, 115) |
PARS.error(pos, 115) |
END; |
IF isVar(e) THEN |
PARS.check(e.ident.global OR (e.ident.scopeLvl = parser.unit.scopeLvl), parser, pos, 105) |
PARS.check(e.ident.global OR (e.ident.scopeLvl = parser.unit.scopeLvl), pos, 105) |
END |
END qualident; |
PROCEDURE deref (pos: SCAN.POSITION; e: PARS.EXPR; load: BOOLEAN; error: INTEGER); |
PROCEDURE deref (pos: PARS.POSITION; e: PARS.EXPR; load: BOOLEAN; error: INTEGER); |
VAR |
label: INTEGER; |
BEGIN |
IF load THEN |
CODE.load(e.type.size) |
IL.load(e.type.size) |
END; |
IF chkPTR IN checking THEN |
label := CODE.NewLabel(); |
CODE.AddJmpCmd(CODE.opJNZ, label); |
CODE.OnError(pos.line, error); |
CODE.SetLabel(label) |
IF chkPTR IN Options.checking THEN |
label := IL.NewLabel(); |
IL.AddJmpCmd(IL.opJNZ, label); |
IL.OnError(pos.line, error); |
IL.SetLabel(label) |
END |
END deref; |
1333,7 → 1388,7 |
PROCEDURE designator (parser: PARS.PARSER; VAR e: PARS.EXPR); |
VAR |
field: PROG.FIELD; |
pos: SCAN.POSITION; |
pos: PARS.POSITION; |
t, idx: PARS.EXPR; |
1348,7 → 1403,7 |
offset := e.ident.offset; |
n := PROG.Dim(e.type); |
WHILE n >= 0 DO |
CODE.AddCmd(CODE.opVADR, offset); |
IL.AddCmd(IL.opVADR, offset); |
DEC(offset); |
DEC(n) |
END |
1359,29 → 1414,29 |
IF e.obj = eVAR THEN |
offset := PROG.getOffset(PARS.program, e.ident); |
IF e.ident.global THEN |
CODE.AddCmd(CODE.opGADR, offset) |
IL.AddCmd(IL.opGADR, offset) |
ELSE |
CODE.AddCmd(CODE.opLADR, -offset) |
IL.AddCmd(IL.opLADR, -offset) |
END |
ELSIF e.obj = ePARAM THEN |
IF (e.type.typ = PROG.tRECORD) OR ((e.type.typ = PROG.tARRAY) & (e.type.length > 0)) THEN |
CODE.AddCmd(CODE.opVADR, e.ident.offset) |
IL.AddCmd(IL.opVADR, e.ident.offset) |
ELSIF PROG.isOpenArray(e.type) THEN |
OpenArray(e) |
ELSE |
CODE.AddCmd(CODE.opLADR, e.ident.offset) |
IL.AddCmd(IL.opLADR, e.ident.offset) |
END |
ELSIF e.obj IN {eVPAR, eVREC} THEN |
IF PROG.isOpenArray(e.type) THEN |
OpenArray(e) |
ELSE |
CODE.AddCmd(CODE.opVADR, e.ident.offset) |
IL.AddCmd(IL.opVADR, e.ident.offset) |
END |
END |
END LoadAdr; |
PROCEDURE OpenIdx (parser: PARS.PARSER; pos: SCAN.POSITION; e: PARS.EXPR); |
PROCEDURE OpenIdx (parser: PARS.PARSER; pos: PARS.POSITION; e: PARS.EXPR); |
VAR |
label: INTEGER; |
type: PROG.TYPE_; |
1389,30 → 1444,30 |
BEGIN |
IF chkIDX IN checking THEN |
label := CODE.NewLabel(); |
CODE.AddCmd2(CODE.opCHKIDX2, label, 0); |
CODE.OnError(pos.line, errIDX); |
CODE.SetLabel(label) |
IF chkIDX IN Options.checking THEN |
label := IL.NewLabel(); |
IL.AddCmd2(IL.opCHKIDX2, label, 0); |
IL.OnError(pos.line, errIDX); |
IL.SetLabel(label) |
ELSE |
CODE.AddCmd(CODE.opCHKIDX2, -1) |
IL.AddCmd(IL.opCHKIDX2, -1) |
END; |
type := PROG.OpenBase(e.type); |
IF type.size # 1 THEN |
CODE.AddCmd(CODE.opMULC, type.size) |
IL.AddCmd(IL.opMULC, type.size) |
END; |
n := PROG.Dim(e.type) - 1; |
k := n; |
WHILE n > 0 DO |
CODE.AddCmd0(CODE.opMUL); |
IL.AddCmd0(IL.opMUL); |
DEC(n) |
END; |
CODE.AddCmd0(CODE.opADD); |
IL.AddCmd0(IL.opADD); |
offset := e.ident.offset - 1; |
n := k; |
WHILE n > 0 DO |
CODE.AddCmd(CODE.opVADR, offset); |
IL.AddCmd(IL.opVADR, offset); |
DEC(offset); |
DEC(n) |
END |
1441,7 → 1496,7 |
e.type := e.type.base; |
e.readOnly := FALSE |
END; |
field := e.type.fields.get(e.type, parser.lex.ident, parser.unit); |
field := PROG.getField(e.type, parser.lex.ident, parser.unit); |
PARS.check1(field # NIL, parser, 74); |
e.type := field.type; |
IF e.obj = eVREC THEN |
1448,7 → 1503,7 |
e.obj := eVPAR |
END; |
IF field.offset # 0 THEN |
CODE.AddCmd(CODE.opADDR, field.offset) |
IL.AddCmd(IL.opADDR, field.offset) |
END; |
PARS.Next(parser); |
e.ident := NIL |
1459,29 → 1514,29 |
PARS.check1(isArr(e), parser, 75); |
NextPos(parser, pos); |
parser.expression(parser, idx); |
PARS.check(isInt(idx), parser, pos, 76); |
PExpression(parser, idx); |
PARS.check(isInt(idx), pos, 76); |
IF idx.obj = eCONST THEN |
IF e.type.length > 0 THEN |
PARS.check(ARITH.range(idx.value, 0, e.type.length - 1), parser, pos, 83); |
PARS.check(ARITH.range(idx.value, 0, e.type.length - 1), pos, 83); |
IF ARITH.Int(idx.value) > 0 THEN |
CODE.AddCmd(CODE.opADDR, ARITH.Int(idx.value) * e.type.base.size) |
IL.AddCmd(IL.opADDR, ARITH.Int(idx.value) * e.type.base.size) |
END |
ELSE |
PARS.check(ARITH.range(idx.value, 0, MACHINE.target.maxInt), parser, pos, 83); |
PARS.check(ARITH.range(idx.value, 0, UTILS.target.maxInt), pos, 83); |
LoadConst(idx); |
OpenIdx(parser, pos, e) |
END |
ELSE |
IF e.type.length > 0 THEN |
IF chkIDX IN checking THEN |
IF chkIDX IN Options.checking THEN |
CheckRange(e.type.length, pos.line, errIDX) |
END; |
IF e.type.base.size # 1 THEN |
CODE.AddCmd(CODE.opMULC, e.type.base.size) |
IL.AddCmd(IL.opMULC, e.type.base.size) |
END; |
CODE.AddCmd0(CODE.opADD) |
IL.AddCmd0(IL.opADD) |
ELSE |
OpenIdx(parser, pos, e) |
END |
1512,26 → 1567,26 |
END; |
NextPos(parser, pos); |
qualident(parser, t); |
PARS.check(t.obj = eTYPE, parser, pos, 79); |
PARS.check(t.obj = eTYPE, pos, 79); |
IF e.type.typ = PROG.tRECORD THEN |
PARS.check(t.type.typ = PROG.tRECORD, parser, pos, 80); |
IF chkGUARD IN checking THEN |
PARS.check(t.type.typ = PROG.tRECORD, pos, 80); |
IF chkGUARD IN Options.checking THEN |
IF e.ident = NIL THEN |
CODE.TypeGuard(CODE.opTYPEGD, t.type.num, pos.line, errGUARD) |
IL.TypeGuard(IL.opTYPEGD, t.type.num, pos.line, errGUARD) |
ELSE |
CODE.AddCmd(CODE.opVADR, e.ident.offset - 1); |
CODE.TypeGuard(CODE.opTYPEGR, t.type.num, pos.line, errGUARD) |
IL.AddCmd(IL.opVADR, e.ident.offset - 1); |
IL.TypeGuard(IL.opTYPEGR, t.type.num, pos.line, errGUARD) |
END |
END; |
ELSE |
PARS.check(t.type.typ = PROG.tPOINTER, parser, pos, 81); |
IF chkGUARD IN checking THEN |
CODE.TypeGuard(CODE.opTYPEGP, t.type.base.num, pos.line, errGUARD) |
PARS.check(t.type.typ = PROG.tPOINTER, pos, 81); |
IF chkGUARD IN Options.checking THEN |
IL.TypeGuard(IL.opTYPEGP, t.type.base.num, pos.line, errGUARD) |
END |
END; |
PARS.check(PROG.isBaseOf(e.type, t.type), parser, pos, 82); |
PARS.check(PROG.isBaseOf(e.type, t.type), pos, 82); |
e.type := t.type; |
1543,69 → 1598,69 |
END designator; |
PROCEDURE ProcCall (e: PARS.EXPR; procType: PROG.TYPE_; isfloat: BOOLEAN; VAR fregs: INTEGER; parser: PARS.PARSER; pos: SCAN.POSITION; CallStat: BOOLEAN); |
PROCEDURE ProcCall (e: PARS.EXPR; procType: PROG.TYPE_; isfloat: BOOLEAN; VAR fregs: INTEGER; parser: PARS.PARSER; pos: PARS.POSITION; CallStat: BOOLEAN); |
VAR |
cconv: INTEGER; |
params: INTEGER; |
parSize: INTEGER; |
callconv: INTEGER; |
fparams: INTEGER; |
fparSize: INTEGER; |
int, flt: INTEGER; |
stk_par: INTEGER; |
BEGIN |
cconv := procType.call; |
params := procType.params.size; |
parSize := procType.parSize; |
IF cconv IN {PROG._win64, PROG.win64} THEN |
callconv := CODE.call_win64; |
fparams := LSL(ORD(procType.params.getfparams(procType, 3, int, flt)), 5) + MIN(params, 4) |
callconv := IL.call_win64; |
fparSize := LSL(ORD(PROG.getFloatParamsPos(procType, 3, int, flt)), 5) + MIN(parSize, 4) |
ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN |
callconv := CODE.call_sysv; |
fparams := LSL(ORD(procType.params.getfparams(procType, PROG.MAXSYSVPARAM - 1, int, flt)), 5) + params; |
callconv := IL.call_sysv; |
fparSize := LSL(ORD(PROG.getFloatParamsPos(procType, PROG.MAXSYSVPARAM - 1, int, flt)), 5) + parSize; |
stk_par := MAX(0, int - 6) + MAX(0, flt - 8) |
ELSE |
callconv := CODE.call_stack; |
fparams := 0 |
callconv := IL.call_stack; |
fparSize := 0 |
END; |
CODE.setlast(begcall); |
fregs := CODE.precall(isfloat); |
IL.setlast(begcall); |
fregs := IL.precall(isfloat); |
IF cconv IN {PROG._ccall16, PROG.ccall16} THEN |
CODE.AddCmd(CODE.opALIGN16, params) |
IL.AddCmd(IL.opALIGN16, parSize) |
ELSIF cconv IN {PROG._win64, PROG.win64} THEN |
CODE.AddCmd(CODE.opWIN64ALIGN16, params) |
IL.AddCmd(IL.opWIN64ALIGN16, parSize) |
ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN |
CODE.AddCmd(CODE.opSYSVALIGN16, params + stk_par) |
IL.AddCmd(IL.opSYSVALIGN16, parSize + stk_par) |
END; |
CODE.setlast(endcall.prev(CODE.COMMAND)); |
IL.setlast(endcall.prev(IL.COMMAND)); |
IF e.obj = eIMP THEN |
CODE.CallImp(e.ident.import, callconv, fparams) |
IL.CallImp(e.ident.import, callconv, fparSize) |
ELSIF e.obj = ePROC THEN |
CODE.Call(e.ident.proc.label, callconv, fparams) |
IL.Call(e.ident.proc.label, callconv, fparSize) |
ELSIF isExpr(e) THEN |
deref(pos, e, CallStat, errPROC); |
CODE.CallP(callconv, fparams) |
IL.CallP(callconv, fparSize) |
END; |
IF cconv IN {PROG._ccall16, PROG.ccall16} THEN |
CODE.AddCmd(CODE.opCLEANUP, params); |
CODE.AddCmd0(CODE.opPOPSP) |
IL.AddCmd(IL.opCLEANUP, parSize); |
IL.AddCmd0(IL.opPOPSP) |
ELSIF cconv IN {PROG._win64, PROG.win64} THEN |
CODE.AddCmd(CODE.opCLEANUP, MAX(params + params MOD 2, 4) + 1); |
CODE.AddCmd0(CODE.opPOPSP) |
IL.AddCmd(IL.opCLEANUP, MAX(parSize + parSize MOD 2, 4) + 1); |
IL.AddCmd0(IL.opPOPSP) |
ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN |
CODE.AddCmd(CODE.opCLEANUP, params + stk_par); |
CODE.AddCmd0(CODE.opPOPSP) |
ELSIF cconv IN {PROG._ccall, PROG.ccall} THEN |
CODE.AddCmd(CODE.opCLEANUP, params) |
IL.AddCmd(IL.opCLEANUP, parSize + stk_par); |
IL.AddCmd0(IL.opPOPSP) |
ELSIF cconv IN {PROG._ccall, PROG.ccall, PROG.default16, PROG.code, PROG._code} THEN |
IL.AddCmd(IL.opCLEANUP, parSize) |
END; |
IF ~CallStat THEN |
IF isfloat THEN |
PARS.check(CODE.resf(fregs), parser, pos, 41) |
PARS.check(IL.resf(fregs), pos, 41) |
ELSE |
CODE.res(fregs) |
IL.res(fregs) |
END |
END |
END ProcCall; |
1613,7 → 1668,7 |
PROCEDURE expression (parser: PARS.PARSER; VAR e: PARS.EXPR); |
VAR |
pos, pos0, pos1: SCAN.POSITION; |
pos, pos0, pos1: PARS.POSITION; |
op: INTEGER; |
e1: PARS.EXPR; |
1646,7 → 1701,7 |
PROCEDURE element (parser: PARS.PARSER; VAR e: PARS.EXPR); |
VAR |
e1, e2: PARS.EXPR; |
pos: SCAN.POSITION; |
pos: PARS.POSITION; |
range: BOOLEAN; |
BEGIN |
1653,10 → 1708,10 |
range := FALSE; |
getpos(parser, pos); |
expression(parser, e1); |
PARS.check(isInt(e1), parser, pos, 76); |
PARS.check(isInt(e1), pos, 76); |
IF e1.obj = eCONST THEN |
PARS.check(ARITH.range(e1.value, 0, MACHINE.target.maxSet), parser, pos, 44) |
PARS.check(ARITH.range(e1.value, 0, UTILS.target.maxSet), pos, 44) |
END; |
range := parser.sym = SCAN.lxRANGE; |
1664,10 → 1719,10 |
IF range THEN |
NextPos(parser, pos); |
expression(parser, e2); |
PARS.check(isInt(e2), parser, pos, 76); |
PARS.check(isInt(e2), pos, 76); |
IF e2.obj = eCONST THEN |
PARS.check(ARITH.range(e2.value, 0, MACHINE.target.maxSet), parser, pos, 44) |
PARS.check(ARITH.range(e2.value, 0, UTILS.target.maxSet), pos, 44) |
END |
ELSE |
IF e1.obj = eCONST THEN |
1675,7 → 1730,7 |
END |
END; |
e.type := PARS.program.stTypes.tSET; |
e.type := tSET; |
IF (e1.obj = eCONST) & (e2.obj = eCONST) THEN |
ARITH.constrSet(e.value, e1.value, e2.value); |
1683,14 → 1738,14 |
ELSE |
IF range THEN |
IF e1.obj = eCONST THEN |
CODE.AddCmd(CODE.opRSETL, ARITH.Int(e1.value)) |
IL.AddCmd(IL.opRSETL, ARITH.Int(e1.value)) |
ELSIF e2.obj = eCONST THEN |
CODE.AddCmd(CODE.opRSETR, ARITH.Int(e2.value)) |
IL.AddCmd(IL.opRSETR, ARITH.Int(e2.value)) |
ELSE |
CODE.AddCmd0(CODE.opRSET) |
IL.AddCmd0(IL.opRSET) |
END |
ELSE |
CODE.AddCmd0(CODE.opRSET1) |
IL.AddCmd0(IL.opRSET1) |
END; |
e.obj := eEXPR |
END |
1706,7 → 1761,7 |
ASSERT(parser.sym = SCAN.lxLCURLY); |
e.obj := eCONST; |
e.type := PARS.program.stTypes.tSET; |
e.type := tSET; |
ARITH.emptySet(e.value); |
PARS.Next(parser); |
1726,11 → 1781,11 |
ARITH.opSet(e.value, e1.value, "+") |
ELSE |
IF e.obj = eCONST THEN |
CODE.AddCmd(CODE.opADDSL, ARITH.Int(e.value)) |
IL.AddCmd(IL.opADDSL, ARITH.Int(e.value)) |
ELSIF e1.obj = eCONST THEN |
CODE.AddCmd(CODE.opADDSR, ARITH.Int(e1.value)) |
IL.AddCmd(IL.opADDSR, ARITH.Int(e1.value)) |
ELSE |
CODE.AddCmd0(CODE.opADDS) |
IL.AddCmd0(IL.opADDS) |
END; |
e.obj := eEXPR |
END |
1744,19 → 1799,19 |
PROCEDURE factor (parser: PARS.PARSER; VAR e: PARS.EXPR); |
VAR |
sym: INTEGER; |
pos: SCAN.POSITION; |
pos: PARS.POSITION; |
e1: PARS.EXPR; |
isfloat: BOOLEAN; |
fregs: INTEGER; |
PROCEDURE LoadVar (e: PARS.EXPR; parser: PARS.PARSER; pos: SCAN.POSITION); |
PROCEDURE LoadVar (e: PARS.EXPR; parser: PARS.PARSER; pos: PARS.POSITION); |
BEGIN |
IF ~(e.type.typ IN {PROG.tRECORD, PROG.tARRAY}) THEN |
IF e.type.typ = PROG.tREAL THEN |
PARS.check(CODE.loadf(), parser, pos, 41) |
IF e.type = tREAL THEN |
PARS.check(IL.loadf(), pos, 41) |
ELSE |
CODE.load(e.type.size) |
IL.load(e.type.size) |
END |
END |
END LoadVar; |
1768,7 → 1823,7 |
IF (sym = SCAN.lxINTEGER) OR (sym = SCAN.lxHEX) OR (sym = SCAN.lxFLOAT) OR (sym = SCAN.lxCHAR) OR (sym = SCAN.lxSTRING) THEN |
e.obj := eCONST; |
e.value := parser.lex.value; |
e.type := PARS.program.getType(PARS.program, e.value.typ); |
e.type := PROG.getType(PARS.program, e.value.typ); |
PARS.Next(parser) |
ELSIF sym = SCAN.lxNIL THEN |
1779,7 → 1834,7 |
ELSIF (sym = SCAN.lxTRUE) OR (sym = SCAN.lxFALSE) THEN |
e.obj := eCONST; |
ARITH.setbool(e.value, sym = SCAN.lxTRUE); |
e.type := PARS.program.stTypes.tBOOLEAN; |
e.type := tBOOLEAN; |
PARS.Next(parser) |
ELSIF sym = SCAN.lxLCURLY THEN |
1788,7 → 1843,7 |
ELSIF sym = SCAN.lxIDENT THEN |
getpos(parser, pos); |
CODE.pushBegEnd(begcall, endcall); |
IL.pushBegEnd(begcall, endcall); |
designator(parser, e); |
IF isVar(e) THEN |
1797,8 → 1852,8 |
IF parser.sym = SCAN.lxLROUND THEN |
e1 := e; |
ActualParameters(parser, e); |
PARS.check(e.type # NIL, parser, pos, 59); |
isfloat := e.type.typ = PROG.tREAL; |
PARS.check(e.type # NIL, pos, 59); |
isfloat := e.type = tREAL; |
IF e1.obj IN {ePROC, eIMP} THEN |
ProcCall(e1, e1.ident.type, isfloat, fregs, parser, pos, FALSE) |
ELSIF isExpr(e1) THEN |
1805,7 → 1860,7 |
ProcCall(e1, e1.type, isfloat, fregs, parser, pos, FALSE) |
END |
END; |
CODE.popBegEnd(begcall, endcall) |
IL.popBegEnd(begcall, endcall) |
ELSIF sym = SCAN.lxLROUND THEN |
PARS.Next(parser); |
1819,9 → 1874,9 |
ELSIF sym = SCAN.lxNOT THEN |
NextPos(parser, pos); |
factor(parser, e); |
PARS.check(isBoolean(e), parser, pos, 72); |
PARS.check(isBoolean(e), pos, 72); |
IF e.obj # eCONST THEN |
CODE.not; |
IL.not; |
e.obj := eEXPR |
ELSE |
ASSERT(ARITH.neg(e.value)) |
1835,7 → 1890,7 |
PROCEDURE term (parser: PARS.PARSER; VAR e: PARS.EXPR); |
VAR |
pos: SCAN.POSITION; |
pos: PARS.POSITION; |
op: INTEGER; |
e1: PARS.EXPR; |
1855,15 → 1910,15 |
IF ~parser.constexp THEN |
IF label = -1 THEN |
label := CODE.NewLabel() |
label := IL.NewLabel() |
END; |
IF e.obj = eCONST THEN |
CODE.AddCmd(CODE.opCONST, ORD(ARITH.getBool(e.value))) |
IL.Const(ORD(ARITH.getBool(e.value))) |
END; |
CODE.AddCmd0(CODE.opACC); |
CODE.AddJmpCmd(CODE.opJZ, label); |
CODE.drop |
IL.AddCmd0(IL.opACC); |
IL.AddJmpCmd(IL.opJZ, label); |
IL.drop |
END |
END; |
1871,12 → 1926,12 |
CASE op OF |
|SCAN.lxMUL: |
PARS.check(isInt(e) & isInt(e1) OR isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), parser, pos, 37); |
PARS.check(isInt(e) & isInt(e1) OR isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), pos, 37); |
IF (e.obj = eCONST) & (e1.obj = eCONST) THEN |
CASE e.value.typ OF |
|ARITH.tINTEGER: PARS.check(ARITH.opInt(e.value, e1.value, "*"), parser, pos, 39) |
|ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, "*"), parser, pos, 40) |
|ARITH.tINTEGER: PARS.check(ARITH.opInt(e.value, e1.value, "*"), pos, 39) |
|ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, "*"), pos, 40) |
|ARITH.tSET: ARITH.opSet(e.value, e1.value, "*") |
END |
1883,26 → 1938,26 |
ELSE |
IF isInt(e) THEN |
IF e.obj = eCONST THEN |
CODE.AddCmd(CODE.opMULC, ARITH.Int(e.value)) |
IL.AddCmd(IL.opMULC, ARITH.Int(e.value)) |
ELSIF e1.obj = eCONST THEN |
CODE.AddCmd(CODE.opMULC, ARITH.Int(e1.value)) |
IL.AddCmd(IL.opMULC, ARITH.Int(e1.value)) |
ELSE |
CODE.AddCmd0(CODE.opMUL) |
IL.AddCmd0(IL.opMUL) |
END |
ELSIF isReal(e) THEN |
IF e.obj = eCONST THEN |
CODE.Float(ARITH.Float(e.value)) |
IL.Float(ARITH.Float(e.value)) |
ELSIF e1.obj = eCONST THEN |
CODE.Float(ARITH.Float(e1.value)) |
IL.Float(ARITH.Float(e1.value)) |
END; |
CODE.fbinop(CODE.opMULF) |
IL.fbinop(IL.opMULF) |
ELSIF isSet(e) THEN |
IF e.obj = eCONST THEN |
CODE.AddCmd(CODE.opMULSC, ARITH.Int(e.value)) |
IL.AddCmd(IL.opMULSC, ARITH.Int(e.value)) |
ELSIF e1.obj = eCONST THEN |
CODE.AddCmd(CODE.opMULSC, ARITH.Int(e1.value)) |
IL.AddCmd(IL.opMULSC, ARITH.Int(e1.value)) |
ELSE |
CODE.AddCmd0(CODE.opMULS) |
IL.AddCmd0(IL.opMULS) |
END |
END; |
e.obj := eEXPR |
1909,14 → 1964,14 |
END |
|SCAN.lxSLASH: |
PARS.check(isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), parser, pos, 37); |
PARS.check(isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), pos, 37); |
IF (e1.obj = eCONST) & isReal(e1) THEN |
PARS.check(~ARITH.isZero(e1.value), parser, pos, 45) |
PARS.check(~ARITH.isZero(e1.value), pos, 45) |
END; |
IF (e.obj = eCONST) & (e1.obj = eCONST) THEN |
CASE e.value.typ OF |
|ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, "/"), parser, pos, 40) |
|ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, "/"), pos, 40) |
|ARITH.tSET: ARITH.opSet(e.value, e1.value, "/") |
END |
1923,21 → 1978,21 |
ELSE |
IF isReal(e) THEN |
IF e.obj = eCONST THEN |
CODE.Float(ARITH.Float(e.value)); |
CODE.fbinop(CODE.opDIVFI) |
IL.Float(ARITH.Float(e.value)); |
IL.fbinop(IL.opDIVFI) |
ELSIF e1.obj = eCONST THEN |
CODE.Float(ARITH.Float(e1.value)); |
CODE.fbinop(CODE.opDIVF) |
IL.Float(ARITH.Float(e1.value)); |
IL.fbinop(IL.opDIVF) |
ELSE |
CODE.fbinop(CODE.opDIVF) |
IL.fbinop(IL.opDIVF) |
END |
ELSIF isSet(e) THEN |
IF e.obj = eCONST THEN |
CODE.AddCmd(CODE.opDIVSC, ARITH.Int(e.value)) |
IL.AddCmd(IL.opDIVSC, ARITH.Int(e.value)) |
ELSIF e1.obj = eCONST THEN |
CODE.AddCmd(CODE.opDIVSC, ARITH.Int(e1.value)) |
IL.AddCmd(IL.opDIVSC, ARITH.Int(e1.value)) |
ELSE |
CODE.AddCmd0(CODE.opDIVS) |
IL.AddCmd0(IL.opDIVS) |
END |
END; |
e.obj := eEXPR |
1944,14 → 1999,17 |
END |
|SCAN.lxDIV, SCAN.lxMOD: |
PARS.check(isInt(e) & isInt(e1), parser, pos, 37); |
PARS.check(isInt(e) & isInt(e1), pos, 37); |
IF e1.obj = eCONST THEN |
PARS.check(~ARITH.isZero(e1.value), parser, pos, 46) |
PARS.check(~ARITH.isZero(e1.value), pos, 46); |
IF CPU = cpuMSP430 THEN |
PARS.check(ARITH.Int(e1.value) > 0, pos, 122) |
END |
END; |
IF (e.obj = eCONST) & (e1.obj = eCONST) THEN |
IF op = SCAN.lxDIV THEN |
PARS.check(ARITH.opInt(e.value, e1.value, "D"), parser, pos, 39) |
PARS.check(ARITH.opInt(e.value, e1.value, "D"), pos, 39) |
ELSE |
ASSERT(ARITH.opInt(e.value, e1.value, "M")) |
END |
1958,25 → 2016,29 |
ELSE |
IF e1.obj # eCONST THEN |
label1 := CODE.NewLabel(); |
CODE.AddJmpCmd(CODE.opJNZ, label1) |
label1 := IL.NewLabel(); |
IF CPU = cpuMSP430 THEN |
IL.AddJmpCmd(IL.opJG, label1) |
ELSE |
IL.AddJmpCmd(IL.opJNZ, label1) |
END |
END; |
IF e.obj = eCONST THEN |
CODE.OnError(pos.line, errDIV); |
CODE.SetLabel(label1); |
CODE.AddCmd(CODE.opDIVL + ORD(op = SCAN.lxMOD), ARITH.Int(e.value)) |
IL.OnError(pos.line, errDIV); |
IL.SetLabel(label1); |
IL.AddCmd(IL.opDIVL + ORD(op = SCAN.lxMOD), ARITH.Int(e.value)) |
ELSIF e1.obj = eCONST THEN |
CODE.AddCmd(CODE.opDIVR + ORD(op = SCAN.lxMOD), ARITH.Int(e1.value)) |
IL.AddCmd(IL.opDIVR + ORD(op = SCAN.lxMOD), ARITH.Int(e1.value)) |
ELSE |
CODE.OnError(pos.line, errDIV); |
CODE.SetLabel(label1); |
CODE.AddCmd0(CODE.opDIV + ORD(op = SCAN.lxMOD)) |
IL.OnError(pos.line, errDIV); |
IL.SetLabel(label1); |
IL.AddCmd0(IL.opDIV + ORD(op = SCAN.lxMOD)) |
END; |
e.obj := eEXPR |
END |
|SCAN.lxAND: |
PARS.check(isBoolean(e) & isBoolean(e1), parser, pos, 37); |
PARS.check(isBoolean(e) & isBoolean(e1), pos, 37); |
IF (e.obj = eCONST) & (e1.obj = eCONST) THEN |
ARITH.opBoolean(e.value, e1.value, "&") |
1983,9 → 2045,9 |
ELSE |
e.obj := eEXPR; |
IF e1.obj = eCONST THEN |
CODE.AddCmd(CODE.opCONST, ORD(ARITH.getBool(e1.value))) |
IL.Const(ORD(ARITH.getBool(e1.value))) |
END; |
CODE.AddCmd0(CODE.opACC) |
IL.AddCmd0(IL.opACC) |
END |
END |
1992,7 → 2054,7 |
END; |
IF label # -1 THEN |
CODE.SetLabel(label) |
IL.SetLabel(label) |
END |
END term; |
1999,7 → 2061,7 |
PROCEDURE SimpleExpression (parser: PARS.PARSER; VAR e: PARS.EXPR); |
VAR |
pos: SCAN.POSITION; |
pos: PARS.POSITION; |
op: INTEGER; |
e1: PARS.EXPR; |
2019,20 → 2081,20 |
term(parser, e); |
IF plus OR minus THEN |
PARS.check(isInt(e) OR isReal(e) OR isSet(e), parser, pos, 36); |
PARS.check(isInt(e) OR isReal(e) OR isSet(e), pos, 36); |
IF minus & (e.obj = eCONST) THEN |
PARS.check(ARITH.neg(e.value), parser, pos, 39) |
PARS.check(ARITH.neg(e.value), pos, 39) |
END; |
IF e.obj # eCONST THEN |
IF minus THEN |
IF isInt(e) THEN |
CODE.AddCmd0(CODE.opUMINUS) |
IL.AddCmd0(IL.opUMINUS) |
ELSIF isReal(e) THEN |
CODE.AddCmd0(CODE.opUMINF) |
IL.AddCmd0(IL.opUMINF) |
ELSIF isSet(e) THEN |
CODE.AddCmd0(CODE.opUMINS) |
IL.AddCmd0(IL.opUMINS) |
END |
END; |
e.obj := eEXPR |
2052,15 → 2114,15 |
IF ~parser.constexp THEN |
IF label = -1 THEN |
label := CODE.NewLabel() |
label := IL.NewLabel() |
END; |
IF e.obj = eCONST THEN |
CODE.AddCmd(CODE.opCONST, ORD(ARITH.getBool(e.value))) |
IL.Const(ORD(ARITH.getBool(e.value))) |
END; |
CODE.AddCmd0(CODE.opACC); |
CODE.AddJmpCmd(CODE.opJNZ, label); |
CODE.drop |
IL.AddCmd0(IL.opACC); |
IL.AddJmpCmd(IL.opJNZ, label); |
IL.drop |
END |
END; |
2076,12 → 2138,12 |
op := ORD("-") |
END; |
PARS.check(isInt(e) & isInt(e1) OR isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), parser, pos, 37); |
PARS.check(isInt(e) & isInt(e1) OR isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), pos, 37); |
IF (e.obj = eCONST) & (e1.obj = eCONST) THEN |
CASE e.value.typ OF |
|ARITH.tINTEGER: PARS.check(ARITH.opInt(e.value, e1.value, CHR(op)), parser, pos, 39) |
|ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, CHR(op)), parser, pos, 40) |
|ARITH.tINTEGER: PARS.check(ARITH.opInt(e.value, e1.value, CHR(op)), pos, 39) |
|ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, CHR(op)), pos, 40) |
|ARITH.tSET: ARITH.opSet(e.value, e1.value, CHR(op)) |
END |
2088,29 → 2150,29 |
ELSE |
IF isInt(e) THEN |
IF e.obj = eCONST THEN |
CODE.AddCmd(CODE.opADDL + ORD(op = ORD("-")), ARITH.Int(e.value)) |
IL.AddCmd(IL.opADDL + ORD(op = ORD("-")), ARITH.Int(e.value)) |
ELSIF e1.obj = eCONST THEN |
CODE.AddCmd(CODE.opADDR + ORD(op = ORD("-")), ARITH.Int(e1.value)) |
IL.AddCmd(IL.opADDR + ORD(op = ORD("-")), ARITH.Int(e1.value)) |
ELSE |
CODE.AddCmd0(CODE.opADD + ORD(op = ORD("-"))) |
IL.AddCmd0(IL.opADD + ORD(op = ORD("-"))) |
END |
ELSIF isReal(e) THEN |
IF e.obj = eCONST THEN |
CODE.Float(ARITH.Float(e.value)); |
CODE.fbinop(CODE.opADDFI + ORD(op = ORD("-"))) |
IL.Float(ARITH.Float(e.value)); |
IL.fbinop(IL.opADDFI + ORD(op = ORD("-"))) |
ELSIF e1.obj = eCONST THEN |
CODE.Float(ARITH.Float(e1.value)); |
CODE.fbinop(CODE.opADDF + ORD(op = ORD("-"))) |
IL.Float(ARITH.Float(e1.value)); |
IL.fbinop(IL.opADDF + ORD(op = ORD("-"))) |
ELSE |
CODE.fbinop(CODE.opADDF + ORD(op = ORD("-"))) |
IL.fbinop(IL.opADDF + ORD(op = ORD("-"))) |
END |
ELSIF isSet(e) THEN |
IF e.obj = eCONST THEN |
CODE.AddCmd(CODE.opADDSL + ORD(op = ORD("-")), ARITH.Int(e.value)) |
IL.AddCmd(IL.opADDSL + ORD(op = ORD("-")), ARITH.Int(e.value)) |
ELSIF e1.obj = eCONST THEN |
CODE.AddCmd(CODE.opADDSR + ORD(op = ORD("-")), ARITH.Int(e1.value)) |
IL.AddCmd(IL.opADDSR + ORD(op = ORD("-")), ARITH.Int(e1.value)) |
ELSE |
CODE.AddCmd0(CODE.opADDS + ORD(op = ORD("-"))) |
IL.AddCmd0(IL.opADDS + ORD(op = ORD("-"))) |
END |
END; |
e.obj := eEXPR |
2117,7 → 2179,7 |
END |
|SCAN.lxOR: |
PARS.check(isBoolean(e) & isBoolean(e1), parser, pos, 37); |
PARS.check(isBoolean(e) & isBoolean(e1), pos, 37); |
IF (e.obj = eCONST) & (e1.obj = eCONST) THEN |
ARITH.opBoolean(e.value, e1.value, "|") |
2124,9 → 2186,9 |
ELSE |
e.obj := eEXPR; |
IF e1.obj = eCONST THEN |
CODE.AddCmd(CODE.opCONST, ORD(ARITH.getBool(e1.value))) |
IL.Const(ORD(ARITH.getBool(e1.value))) |
END; |
CODE.AddCmd0(CODE.opACC) |
IL.AddCmd0(IL.opACC) |
END |
END |
2133,7 → 2195,7 |
END; |
IF label # -1 THEN |
CODE.SetLabel(label) |
IL.SetLabel(label) |
END |
END SimpleExpression; |
2142,6 → 2204,7 |
PROCEDURE cmpcode (op: INTEGER): INTEGER; |
VAR |
res: INTEGER; |
BEGIN |
CASE op OF |
|SCAN.lxEQ: res := 0 |
2156,12 → 2219,30 |
END cmpcode; |
PROCEDURE invcmpcode (op: INTEGER): INTEGER; |
VAR |
res: INTEGER; |
BEGIN |
CASE op OF |
|SCAN.lxEQ: res := 0 |
|SCAN.lxNE: res := 1 |
|SCAN.lxLT: res := 4 |
|SCAN.lxLE: res := 5 |
|SCAN.lxGT: res := 2 |
|SCAN.lxGE: res := 3 |
END |
RETURN res |
END invcmpcode; |
PROCEDURE BoolCmp (eq, val: BOOLEAN); |
BEGIN |
IF eq = val THEN |
CODE.AddCmd0(CODE.opNER) |
IL.AddCmd0(IL.opNEC) |
ELSE |
CODE.AddCmd0(CODE.opEQR) |
IL.AddCmd0(IL.opEQC) |
END |
END BoolCmp; |
2175,40 → 2256,40 |
res := TRUE; |
IF isString(e) & isCharArray(e1) THEN |
CODE.AddCmd(CODE.opSADR, String(e)); |
CODE.AddCmd(CODE.opCONST, strlen(e) + 1); |
CODE.AddCmd0(CODE.opEQS2 + cmpcode(op)) |
IL.StrAdr(String(e)); |
IL.Const(strlen(e) + 1); |
IL.AddCmd0(IL.opEQS + invcmpcode(op)) |
ELSIF isString(e) & isCharArrayW(e1) THEN |
CODE.AddCmd(CODE.opSADR, StringW(e)); |
CODE.AddCmd(CODE.opCONST, utf8strlen(e) + 1); |
CODE.AddCmd0(CODE.opEQSW2 + cmpcode(op)) |
IL.StrAdr(StringW(e)); |
IL.Const(utf8strlen(e) + 1); |
IL.AddCmd0(IL.opEQSW + invcmpcode(op)) |
ELSIF isStringW(e) & isCharArrayW(e1) THEN |
CODE.AddCmd(CODE.opSADR, StringW(e)); |
CODE.AddCmd(CODE.opCONST, utf8strlen(e) + 1); |
CODE.AddCmd0(CODE.opEQSW2 + cmpcode(op)) |
IL.StrAdr(StringW(e)); |
IL.Const(utf8strlen(e) + 1); |
IL.AddCmd0(IL.opEQSW + invcmpcode(op)) |
ELSIF isCharArray(e) & isString(e1) THEN |
CODE.AddCmd(CODE.opSADR, String(e1)); |
CODE.AddCmd(CODE.opCONST, strlen(e1) + 1); |
CODE.AddCmd0(CODE.opEQS + cmpcode(op)) |
IL.StrAdr(String(e1)); |
IL.Const(strlen(e1) + 1); |
IL.AddCmd0(IL.opEQS + cmpcode(op)) |
ELSIF isCharArrayW(e) & isString(e1) THEN |
CODE.AddCmd(CODE.opSADR, StringW(e1)); |
CODE.AddCmd(CODE.opCONST, utf8strlen(e1) + 1); |
CODE.AddCmd0(CODE.opEQSW + cmpcode(op)) |
IL.StrAdr(StringW(e1)); |
IL.Const(utf8strlen(e1) + 1); |
IL.AddCmd0(IL.opEQSW + cmpcode(op)) |
ELSIF isCharArrayW(e) & isStringW(e1) THEN |
CODE.AddCmd(CODE.opSADR, StringW(e1)); |
CODE.AddCmd(CODE.opCONST, utf8strlen(e1) + 1); |
CODE.AddCmd0(CODE.opEQSW + cmpcode(op)) |
IL.StrAdr(StringW(e1)); |
IL.Const(utf8strlen(e1) + 1); |
IL.AddCmd0(IL.opEQSW + cmpcode(op)) |
ELSIF isCharArrayW(e) & isCharArrayW(e1) THEN |
CODE.AddCmd0(CODE.opEQSW + cmpcode(op)) |
IL.AddCmd0(IL.opEQSW + cmpcode(op)) |
ELSIF isCharArray(e) & isCharArray(e1) THEN |
CODE.AddCmd0(CODE.opEQS + cmpcode(op)) |
IL.AddCmd0(IL.opEQS + cmpcode(op)) |
ELSIF isString(e) & isString(e1) THEN |
PARS.strcmp(e.value, e1.value, op) |
2227,17 → 2308,17 |
SimpleExpression(parser, e); |
IF relation(parser.sym) THEN |
IF (isCharArray(e) OR isCharArrayW(e)) & (e.type.length # 0) THEN |
CODE.AddCmd(CODE.opCONST, e.type.length) |
IL.Const(e.type.length) |
END; |
op := parser.sym; |
getpos(parser, pos); |
PARS.Next(parser); |
pos1 := parser.lex.pos; |
getpos(parser, pos1); |
SimpleExpression(parser, e1); |
IF (isCharArray(e1) OR isCharArrayW(e1)) & (e1.type.length # 0) THEN |
CODE.AddCmd(CODE.opCONST, e1.type.length) |
IL.Const(e1.type.length) |
END; |
constant := (e.obj = eCONST) & (e1.obj = eCONST); |
2267,19 → 2348,19 |
ARITH.relation(e.value, e1.value, operator, error) |
ELSE |
IF e.obj = eCONST THEN |
CODE.AddCmd(CODE.opEQ + cmpcode(op) + 6, ARITH.Int(e.value)) |
IL.AddCmd(IL.opEQC + cmpcode(op), ARITH.Int(e.value)) |
ELSIF e1.obj = eCONST THEN |
CODE.AddCmd(CODE.opEQ + cmpcode(op) + 12, ARITH.Int(e1.value)) |
IL.AddCmd(IL.opEQC + cmpcode(op), ARITH.Int(e1.value)) |
ELSE |
CODE.AddCmd0(CODE.opEQ + cmpcode(op)) |
IL.AddCmd0(IL.opEQ + cmpcode(op)) |
END |
END |
ELSIF isStringW1(e) & isCharW(e1) THEN |
CODE.AddCmd(CODE.opEQ + cmpcode(op) + 6, StrToWChar(e.value.string(SCAN.IDENT).s)) |
IL.AddCmd(IL.opEQC + cmpcode(op), StrToWChar(e.value.string(SCAN.IDENT).s)) |
ELSIF isStringW1(e1) & isCharW(e) THEN |
CODE.AddCmd(CODE.opEQ + cmpcode(op) + 12, StrToWChar(e1.value.string(SCAN.IDENT).s)) |
IL.AddCmd(IL.opEQC + cmpcode(op), StrToWChar(e1.value.string(SCAN.IDENT).s)) |
ELSIF isBoolean(e) & isBoolean(e1) THEN |
IF constant THEN |
2291,9 → 2372,9 |
BoolCmp(op = SCAN.lxEQ, ARITH.Int(e1.value) # 0) |
ELSE |
IF op = SCAN.lxEQ THEN |
CODE.AddCmd0(CODE.opEQB) |
IL.AddCmd0(IL.opEQB) |
ELSE |
CODE.AddCmd0(CODE.opNEB) |
IL.AddCmd0(IL.opNEB) |
END |
END |
END |
2303,50 → 2384,47 |
ARITH.relation(e.value, e1.value, operator, error) |
ELSE |
IF e.obj = eCONST THEN |
CODE.Float(ARITH.Float(e.value)); |
CODE.fcmp(CODE.opEQF + cmpcode(op) + 6) |
IL.Float(ARITH.Float(e.value)) |
ELSIF e1.obj = eCONST THEN |
CODE.Float(ARITH.Float(e1.value)); |
CODE.fcmp(CODE.opEQF + cmpcode(op)) |
ELSE |
CODE.fcmp(CODE.opEQF + cmpcode(op)) |
IL.Float(ARITH.Float(e1.value)) |
END; |
IL.fcmp(IL.opEQF + cmpcode(op)) |
END |
END |
ELSIF (isStringW(e) OR isCharArrayX(e)) & (isStringW(e1) OR isCharArrayX(e1)) THEN |
IF ~strcmp(e, e1, op) THEN |
PARS.error(parser, pos, 37) |
PARS.error(pos, 37) |
END |
ELSIF isPtr(e) & isNil(e1) OR isNil(e) & isPtr(e1) THEN |
CODE.AddCmd0(CODE.opEQ + cmpcode(op) + 6) |
IL.AddCmd0(IL.opEQC + cmpcode(op)) |
ELSIF isProc(e) & isNil(e1) THEN |
IF e.obj IN {ePROC, eIMP} THEN |
PARS.check(e.ident.global, parser, pos0, 85); |
PARS.check(e.ident.global, pos0, 85); |
constant := TRUE; |
e.obj := eCONST; |
ARITH.setbool(e.value, op = SCAN.lxNE) |
ELSE |
CODE.AddCmd0(CODE.opEQ + cmpcode(op) + 6) |
IL.AddCmd0(IL.opEQC + cmpcode(op)) |
END |
ELSIF isNil(e) & isProc(e1) THEN |
IF e1.obj IN {ePROC, eIMP} THEN |
PARS.check(e1.ident.global, parser, pos1, 85); |
PARS.check(e1.ident.global, pos1, 85); |
constant := TRUE; |
e.obj := eCONST; |
ARITH.setbool(e.value, op = SCAN.lxNE) |
ELSE |
CODE.AddCmd0(CODE.opEQ + cmpcode(op) + 6) |
IL.AddCmd0(IL.opEQC + cmpcode(op)) |
END |
ELSIF isProc(e) & isProc(e1) & PROG.isTypeEq(e.type, e1.type) THEN |
IF e.obj = ePROC THEN |
PARS.check(e.ident.global, parser, pos0, 85) |
PARS.check(e.ident.global, pos0, 85) |
END; |
IF e1.obj = ePROC THEN |
PARS.check(e1.ident.global, parser, pos1, 85) |
PARS.check(e1.ident.global, pos1, 85) |
END; |
IF (e.obj IN {ePROC, eIMP}) & (e1.obj IN {ePROC, eIMP}) THEN |
constant := TRUE; |
2357,15 → 2435,15 |
ARITH.setbool(e.value, e.ident # e1.ident) |
END |
ELSIF e.obj = ePROC THEN |
CODE.ProcCmp(e.ident.proc.label, cmpcode(op) = 0) |
IL.ProcCmp(e.ident.proc.label, op = SCAN.lxEQ) |
ELSIF e1.obj = ePROC THEN |
CODE.ProcCmp(e1.ident.proc.label, cmpcode(op) = 0) |
IL.ProcCmp(e1.ident.proc.label, op = SCAN.lxEQ) |
ELSIF e.obj = eIMP THEN |
CODE.ProcImpCmp(e.ident.import, cmpcode(op) = 0) |
IL.ProcImpCmp(e.ident.import, op = SCAN.lxEQ) |
ELSIF e1.obj = eIMP THEN |
CODE.ProcImpCmp(e1.ident.import, cmpcode(op) = 0) |
IL.ProcImpCmp(e1.ident.import, op = SCAN.lxEQ) |
ELSE |
CODE.AddCmd0(CODE.opEQ + cmpcode(op)) |
IL.AddCmd0(IL.opEQ + cmpcode(op)) |
END |
ELSIF isNil(e) & isNil(e1) THEN |
2374,7 → 2452,7 |
ARITH.setbool(e.value, op = SCAN.lxEQ) |
ELSE |
PARS.error(parser, pos, 37) |
PARS.error(pos, 37) |
END |
|SCAN.lxLT, SCAN.lxLE, SCAN.lxGT, SCAN.lxGE: |
2387,19 → 2465,19 |
ARITH.relation(e.value, e1.value, operator, error) |
ELSE |
IF e.obj = eCONST THEN |
CODE.AddCmd(CODE.opEQ + cmpcode(op) + 6, ARITH.Int(e.value)) |
IL.AddCmd(IL.opEQC + invcmpcode(op), ARITH.Int(e.value)) |
ELSIF e1.obj = eCONST THEN |
CODE.AddCmd(CODE.opEQ + cmpcode(op) + 12, ARITH.Int(e1.value)) |
IL.AddCmd(IL.opEQC + cmpcode(op), ARITH.Int(e1.value)) |
ELSE |
CODE.AddCmd0(CODE.opEQ + cmpcode(op)) |
IL.AddCmd0(IL.opEQ + cmpcode(op)) |
END |
END |
ELSIF isStringW1(e) & isCharW(e1) THEN |
CODE.AddCmd(CODE.opEQ + cmpcode(op) + 6, StrToWChar(e.value.string(SCAN.IDENT).s)) |
IL.AddCmd(IL.opEQC + invcmpcode(op), StrToWChar(e.value.string(SCAN.IDENT).s)) |
ELSIF isStringW1(e1) & isCharW(e) THEN |
CODE.AddCmd(CODE.opEQ + cmpcode(op) + 12, StrToWChar(e1.value.string(SCAN.IDENT).s)) |
IL.AddCmd(IL.opEQC + cmpcode(op), StrToWChar(e1.value.string(SCAN.IDENT).s)) |
ELSIF isReal(e) & isReal(e1) THEN |
IF constant THEN |
2406,69 → 2484,67 |
ARITH.relation(e.value, e1.value, operator, error) |
ELSE |
IF e.obj = eCONST THEN |
CODE.Float(ARITH.Float(e.value)); |
CODE.fcmp(CODE.opEQF + cmpcode(op) + 6) |
IL.Float(ARITH.Float(e.value)); |
IL.fcmp(IL.opEQF + invcmpcode(op)) |
ELSIF e1.obj = eCONST THEN |
CODE.Float(ARITH.Float(e1.value)); |
CODE.fcmp(CODE.opEQF + cmpcode(op)) |
IL.Float(ARITH.Float(e1.value)); |
IL.fcmp(IL.opEQF + cmpcode(op)) |
ELSE |
CODE.fcmp(CODE.opEQF + cmpcode(op)) |
IL.fcmp(IL.opEQF + cmpcode(op)) |
END |
END |
ELSIF (isStringW(e) OR isCharArrayX(e)) & (isStringW(e1) OR isCharArrayX(e1)) THEN |
IF ~strcmp(e, e1, op) THEN |
PARS.error(parser, pos, 37) |
PARS.error(pos, 37) |
END |
ELSE |
PARS.error(parser, pos, 37) |
PARS.error(pos, 37) |
END |
|SCAN.lxIN: |
PARS.check(isInt(e) & isSet(e1), parser, pos, 37); |
PARS.check(isInt(e) & isSet(e1), pos, 37); |
IF e.obj = eCONST THEN |
PARS.check(ARITH.range(e.value, 0, MACHINE.target.maxSet), parser, pos0, 56) |
PARS.check(ARITH.range(e.value, 0, UTILS.target.maxSet), pos0, 56) |
END; |
IF constant THEN |
ARITH.relation(e.value, e1.value, operator, error) |
ELSE |
IF e.obj = eCONST THEN |
CODE.AddCmd(CODE.opINL, ARITH.Int(e.value)) |
IL.AddCmd(IL.opINL, ARITH.Int(e.value)) |
ELSIF e1.obj = eCONST THEN |
CODE.AddCmd(CODE.opINR, ARITH.Int(e1.value)) |
IL.AddCmd(IL.opINR, ARITH.Int(e1.value)) |
ELSE |
CODE.AddCmd0(CODE.opIN) |
IL.AddCmd0(IL.opIN) |
END |
END |
|SCAN.lxIS: |
PARS.check(isExpr(e) & (e.type.typ IN {PROG.tRECORD, PROG.tPOINTER}), parser, pos, 73); |
IF e.type.typ = PROG.tRECORD THEN |
PARS.check(e.obj = eVREC, parser, pos0, 78) |
END; |
PARS.check(e1.obj = eTYPE, parser, pos1, 79); |
PARS.check(isRecPtr(e), pos, 73); |
PARS.check(e1.obj = eTYPE, pos1, 79); |
IF e.type.typ = PROG.tRECORD THEN |
PARS.check(e1.type.typ = PROG.tRECORD, parser, pos1, 80); |
IF isRec(e) THEN |
PARS.check(e.obj = eVREC, pos0, 78); |
PARS.check(e1.type.typ = PROG.tRECORD, pos1, 80); |
IF e.ident = NIL THEN |
CODE.TypeCheck(e1.type.num) |
IL.TypeCheck(e1.type.num) |
ELSE |
CODE.AddCmd(CODE.opVADR, e.ident.offset - 1); |
CODE.TypeCheckRec(e1.type.num) |
IL.AddCmd(IL.opVADR, e.ident.offset - 1); |
IL.TypeCheckRec(e1.type.num) |
END |
ELSE |
PARS.check(e1.type.typ = PROG.tPOINTER, parser, pos1, 81); |
CODE.TypeCheck(e1.type.base.num) |
PARS.check(e1.type.typ = PROG.tPOINTER, pos1, 81); |
IL.TypeCheck(e1.type.base.num) |
END; |
PARS.check(PROG.isBaseOf(e.type, e1.type), parser, pos1, 82) |
PARS.check(PROG.isBaseOf(e.type, e1.type), pos1, 82) |
END; |
ASSERT(error = 0); |
e.type := PARS.program.stTypes.tBOOLEAN; |
e.type := tBOOLEAN; |
IF ~constant THEN |
e.obj := eEXPR |
2481,7 → 2557,7 |
PROCEDURE ElementaryStatement (parser: PARS.PARSER); |
VAR |
e, e1: PARS.EXPR; |
pos: SCAN.POSITION; |
pos: PARS.POSITION; |
line: INTEGER; |
call: BOOLEAN; |
fregs: INTEGER; |
2489,25 → 2565,25 |
BEGIN |
getpos(parser, pos); |
CODE.pushBegEnd(begcall, endcall); |
IL.pushBegEnd(begcall, endcall); |
designator(parser, e); |
IF parser.sym = SCAN.lxASSIGN THEN |
line := parser.lex.pos.line; |
PARS.check(isVar(e), parser, pos, 93); |
PARS.check(~e.readOnly, parser, pos, 94); |
PARS.check(isVar(e), pos, 93); |
PARS.check(~e.readOnly, pos, 94); |
CODE.setlast(begcall); |
IL.setlast(begcall); |
NextPos(parser, pos); |
expression(parser, e1); |
CODE.setlast(endcall.prev(CODE.COMMAND)); |
IL.setlast(endcall.prev(IL.COMMAND)); |
PARS.check(assign(e1, e.type, line), parser, pos, 91); |
PARS.check(assign(e1, e.type, line), pos, 91); |
IF e1.obj = ePROC THEN |
PARS.check(e1.ident.global, parser, pos, 85) |
PARS.check(e1.ident.global, pos, 85) |
END; |
call := FALSE |
ELSIF parser.sym = SCAN.lxEQ THEN |
2515,13 → 2591,18 |
ELSIF parser.sym = SCAN.lxLROUND THEN |
e1 := e; |
ActualParameters(parser, e1); |
PARS.check((e1.type = NIL) OR ODD(e.type.call), parser, pos, 92); |
PARS.check((e1.type = NIL) OR ODD(e.type.call), pos, 92); |
call := TRUE |
ELSE |
PARS.check(isProc(e), parser, pos, 86); |
PARS.check((e.type.base = NIL) OR ODD(e.type.call), parser, pos, 92); |
IF e.obj IN {eSYSPROC, eSTPROC} THEN |
stProc(parser, e); |
call := FALSE |
ELSE |
PARS.check(isProc(e), pos, 86); |
PARS.check((e.type.base = NIL) OR ODD(e.type.call), pos, 92); |
PARS.check1(e.type.params.first = NIL, parser, 64); |
call := TRUE |
END |
END; |
IF call THEN |
2532,7 → 2613,7 |
END |
END; |
CODE.popBegEnd(begcall, endcall) |
IL.popBegEnd(begcall, endcall) |
END ElementaryStatement; |
2539,32 → 2620,32 |
PROCEDURE IfStatement (parser: PARS.PARSER; if: BOOLEAN); |
VAR |
e: PARS.EXPR; |
pos: SCAN.POSITION; |
pos: PARS.POSITION; |
label, L: INTEGER; |
BEGIN |
L := CODE.NewLabel(); |
L := IL.NewLabel(); |
IF ~if THEN |
CODE.AddCmd0(CODE.opLOOP); |
CODE.SetLabel(L) |
IL.AddCmd0(IL.opLOOP); |
IL.SetLabel(L) |
END; |
REPEAT |
NextPos(parser, pos); |
label := CODE.NewLabel(); |
label := IL.NewLabel(); |
expression(parser, e); |
PARS.check(isBoolean(e), parser, pos, 72); |
PARS.check(isBoolean(e), pos, 72); |
IF e.obj = eCONST THEN |
IF ~ARITH.getBool(e.value) THEN |
CODE.AddJmpCmd(CODE.opJMP, label) |
IL.AddJmpCmd(IL.opJMP, label) |
END |
ELSE |
CODE.AddJmpCmd(CODE.opJNE, label) |
IL.AddJmpCmd(IL.opJNE, label) |
END; |
IF if THEN |
2576,8 → 2657,8 |
PARS.Next(parser); |
parser.StatSeq(parser); |
CODE.AddJmpCmd(CODE.opJMP, L); |
CODE.SetLabel(label) |
IL.AddJmpCmd(IL.opJMP, L); |
IL.SetLabel(label) |
UNTIL parser.sym # SCAN.lxELSIF; |
2586,13 → 2667,13 |
PARS.Next(parser); |
parser.StatSeq(parser) |
END; |
CODE.SetLabel(L) |
IL.SetLabel(L) |
END; |
PARS.checklex(parser, SCAN.lxEND); |
IF ~if THEN |
CODE.AddCmd0(CODE.opENDLOOP) |
IL.AddCmd0(IL.opENDLOOP) |
END; |
PARS.Next(parser) |
2602,14 → 2683,14 |
PROCEDURE RepeatStatement (parser: PARS.PARSER); |
VAR |
e: PARS.EXPR; |
pos: SCAN.POSITION; |
pos: PARS.POSITION; |
label: INTEGER; |
BEGIN |
CODE.AddCmd0(CODE.opLOOP); |
IL.AddCmd0(IL.opLOOP); |
label := CODE.NewLabel(); |
CODE.SetLabel(label); |
label := IL.NewLabel(); |
IL.SetLabel(label); |
PARS.Next(parser); |
parser.StatSeq(parser); |
2616,17 → 2697,17 |
PARS.checklex(parser, SCAN.lxUNTIL); |
NextPos(parser, pos); |
expression(parser, e); |
PARS.check(isBoolean(e), parser, pos, 72); |
PARS.check(isBoolean(e), pos, 72); |
IF e.obj = eCONST THEN |
IF ~ARITH.getBool(e.value) THEN |
CODE.AddJmpCmd(CODE.opJMP, label) |
IL.AddJmpCmd(IL.opJMP, label) |
END |
ELSE |
CODE.AddJmpCmd(CODE.opJNE, label) |
IL.AddJmpCmd(IL.opJNE, label) |
END; |
CODE.AddCmd0(CODE.opENDLOOP) |
IL.AddCmd0(IL.opENDLOOP) |
END RepeatStatement; |
2656,7 → 2737,7 |
END DestroyLabel; |
PROCEDURE NewVariant (label: INTEGER; cmd: CODE.COMMAND): CASE_VARIANT; |
PROCEDURE NewVariant (label: INTEGER; cmd: IL.COMMAND): CASE_VARIANT; |
VAR |
res: CASE_VARIANT; |
citem: C.ITEM; |
2680,19 → 2761,14 |
PROCEDURE CaseStatement (parser: PARS.PARSER); |
VAR |
e: PARS.EXPR; |
pos: SCAN.POSITION; |
pos: PARS.POSITION; |
PROCEDURE isRecPtr (caseExpr: PARS.EXPR): BOOLEAN; |
RETURN isRec(caseExpr) OR isPtr(caseExpr) |
END isRecPtr; |
PROCEDURE Label (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR type: PROG.TYPE_): INTEGER; |
VAR |
a: INTEGER; |
label: PARS.EXPR; |
pos: SCAN.POSITION; |
pos: PARS.POSITION; |
value: ARITH.VALUE; |
BEGIN |
2701,7 → 2777,7 |
IF isChar(caseExpr) THEN |
PARS.ConstExpression(parser, value); |
PARS.check(value.typ = ARITH.tCHAR, parser, pos, 99); |
PARS.check(value.typ = ARITH.tCHAR, pos, 99); |
a := ARITH.getInt(value) |
ELSIF isCharW(caseExpr) THEN |
PARS.ConstExpression(parser, value); |
2708,17 → 2784,17 |
IF (value.typ = ARITH.tSTRING) & (_length(value.string(SCAN.IDENT).s) = 1) & (LENGTH(value.string(SCAN.IDENT).s) > 1) THEN |
ASSERT(ARITH.setInt(value, StrToWChar(value.string(SCAN.IDENT).s))) |
ELSE |
PARS.check(value.typ IN {ARITH.tWCHAR, ARITH.tCHAR}, parser, pos, 99) |
PARS.check(value.typ IN {ARITH.tWCHAR, ARITH.tCHAR}, pos, 99) |
END; |
a := ARITH.getInt(value) |
ELSIF isInt(caseExpr) THEN |
PARS.ConstExpression(parser, value); |
PARS.check(value.typ = ARITH.tINTEGER, parser, pos, 99); |
PARS.check(value.typ = ARITH.tINTEGER, pos, 99); |
a := ARITH.getInt(value) |
ELSIF isRecPtr(caseExpr) THEN |
qualident(parser, label); |
PARS.check(label.obj = eTYPE, parser, pos, 79); |
PARS.check(PROG.isBaseOf(caseExpr.type, label.type), parser, pos, 99); |
PARS.check(label.obj = eTYPE, pos, 79); |
PARS.check(PROG.isBaseOf(caseExpr.type, label.type), pos, 99); |
IF isRec(caseExpr) THEN |
a := label.type.num |
ELSE |
2731,10 → 2807,10 |
END Label; |
PROCEDURE CheckType (node: AVL.NODE; type: PROG.TYPE_; parser: PARS.PARSER; pos: SCAN.POSITION); |
PROCEDURE CheckType (node: AVL.NODE; type: PROG.TYPE_; parser: PARS.PARSER; pos: PARS.POSITION); |
BEGIN |
IF node # NIL THEN |
PARS.check(~(PROG.isBaseOf(node.data(CASE_LABEL).type, type) OR PROG.isBaseOf(type, node.data(CASE_LABEL).type)), parser, pos, 100); |
PARS.check(~(PROG.isBaseOf(node.data(CASE_LABEL).type, type) OR PROG.isBaseOf(type, node.data(CASE_LABEL).type)), pos, 100); |
CheckType(node.left, type, parser, pos); |
CheckType(node.right, type, parser, pos) |
END |
2745,7 → 2821,7 |
VAR |
label: CASE_LABEL; |
citem: C.ITEM; |
pos, pos1: SCAN.POSITION; |
pos, pos1: PARS.POSITION; |
node: AVL.NODE; |
newnode: BOOLEAN; |
range: RANGE; |
2759,7 → 2835,7 |
END; |
label.variant := variant; |
label.self := CODE.NewLabel(); |
label.self := IL.NewLabel(); |
getpos(parser, pos1); |
range.a := Label(parser, caseExpr, label.type); |
2768,7 → 2844,7 |
PARS.check1(~isRecPtr(caseExpr), parser, 53); |
NextPos(parser, pos); |
range.b := Label(parser, caseExpr, label.type); |
PARS.check(range.a <= range.b, parser, pos, 103) |
PARS.check(range.a <= range.b, pos, 103) |
ELSE |
range.b := range.a |
END; |
2779,7 → 2855,7 |
CheckType(tree, label.type, parser, pos1) |
END; |
tree := AVL.insert(tree, label, LabelCmp, newnode, node); |
PARS.check(newnode, parser, pos1, 100) |
PARS.check(newnode, pos1, 100) |
RETURN node |
2813,12 → 2889,12 |
t: PROG.TYPE_; |
variant: INTEGER; |
node: AVL.NODE; |
last: CODE.COMMAND; |
last: IL.COMMAND; |
BEGIN |
sym := parser.sym; |
IF sym # SCAN.lxBAR THEN |
variant := CODE.NewLabel(); |
variant := IL.NewLabel(); |
node := CaseLabelList(parser, caseExpr, tree, variant); |
PARS.checklex(parser, SCAN.lxCOLON); |
PARS.Next(parser); |
2827,8 → 2903,8 |
caseExpr.ident.type := node.data(CASE_LABEL).type |
END; |
last := CODE.getlast(); |
CODE.SetLabel(variant); |
last := IL.getlast(); |
IL.SetLabel(variant); |
IF ~isRecPtr(caseExpr) THEN |
LISTS.push(CaseVariants, NewVariant(variant, last)) |
2835,7 → 2911,7 |
END; |
parser.StatSeq(parser); |
CODE.AddJmpCmd(CODE.opJMP, end); |
IL.AddJmpCmd(IL.opJMP, end); |
IF isRecPtr(caseExpr) THEN |
caseExpr.ident.type := t |
2849,7 → 2925,7 |
L, R: INTEGER; |
range: RANGE; |
left, right: AVL.NODE; |
last: CODE.COMMAND; |
last: IL.COMMAND; |
v: CASE_VARIANT; |
BEGIN |
2871,7 → 2947,7 |
R := else |
END; |
last := CODE.getlast(); |
last := IL.getlast(); |
v := CaseVariants.last(CASE_VARIANT); |
WHILE (v # NIL) & (v.label # 0) & (v.label # node.data(CASE_LABEL).variant) DO |
2879,16 → 2955,16 |
END; |
ASSERT((v # NIL) & (v.label # 0)); |
CODE.setlast(v.cmd); |
IL.setlast(v.cmd); |
CODE.SetLabel(node.data(CASE_LABEL).self); |
CODE.case(range.a, range.b, L, R); |
IL.SetLabel(node.data(CASE_LABEL).self); |
IL.case(range.a, range.b, L, R); |
IF v.processed THEN |
CODE.AddJmpCmd(CODE.opJMP, node.data(CASE_LABEL).variant) |
IL.AddJmpCmd(IL.opJMP, node.data(CASE_LABEL).variant) |
END; |
v.processed := TRUE; |
CODE.setlast(last); |
IL.setlast(last); |
Table(left, else); |
Table(right, else) |
2899,7 → 2975,7 |
PROCEDURE TableT (node: AVL.NODE); |
BEGIN |
IF node # NIL THEN |
CODE.caset(node.data(CASE_LABEL).range.a, node.data(CASE_LABEL).variant); |
IL.caset(node.data(CASE_LABEL).range.a, node.data(CASE_LABEL).variant); |
TableT(node.left); |
TableT(node.right) |
2907,7 → 2983,7 |
END TableT; |
PROCEDURE ParseCase (parser: PARS.PARSER; e: PARS.EXPR; pos: SCAN.POSITION); |
PROCEDURE ParseCase (parser: PARS.PARSER; e: PARS.EXPR; pos: PARS.POSITION); |
VAR |
table, end, else: INTEGER; |
tree: AVL.NODE; |
2915,11 → 2991,11 |
BEGIN |
LISTS.push(CaseVariants, NewVariant(0, NIL)); |
end := CODE.NewLabel(); |
else := CODE.NewLabel(); |
table := CODE.NewLabel(); |
CODE.AddCmd(CODE.opSWITCH, ORD(isRecPtr(e))); |
CODE.AddJmpCmd(CODE.opJMP, table); |
end := IL.NewLabel(); |
else := IL.NewLabel(); |
table := IL.NewLabel(); |
IL.AddCmd(IL.opSWITCH, ORD(isRecPtr(e))); |
IL.AddJmpCmd(IL.opJMP, table); |
tree := NIL; |
2929,13 → 3005,13 |
case(parser, e, tree, end) |
END; |
CODE.SetLabel(else); |
IL.SetLabel(else); |
IF parser.sym = SCAN.lxELSE THEN |
PARS.Next(parser); |
parser.StatSeq(parser); |
CODE.AddJmpCmd(CODE.opJMP, end) |
IL.AddJmpCmd(IL.opJMP, end) |
ELSE |
CODE.OnError(pos.line, errCASE) |
IL.OnError(pos.line, errCASE) |
END; |
PARS.checklex(parser, SCAN.lxEND); |
2942,9 → 3018,9 |
PARS.Next(parser); |
IF isRecPtr(e) THEN |
CODE.SetLabel(table); |
IL.SetLabel(table); |
TableT(tree); |
CODE.AddJmpCmd(CODE.opJMP, else) |
IL.AddJmpCmd(IL.opJMP, else) |
ELSE |
tree.data(CASE_LABEL).self := table; |
Table(tree, else) |
2951,8 → 3027,8 |
END; |
AVL.destroy(tree, DestroyLabel); |
CODE.SetLabel(end); |
CODE.AddCmd0(CODE.opENDSW); |
IL.SetLabel(end); |
IL.AddCmd0(IL.opENDSW); |
REPEAT |
item := LISTS.pop(CaseVariants); |
2965,25 → 3041,25 |
BEGIN |
NextPos(parser, pos); |
expression(parser, e); |
PARS.check(isInt(e) OR isChar(e) OR isCharW(e) OR isPtr(e) OR isRec(e), parser, pos, 95); |
PARS.check(isInt(e) OR isChar(e) OR isCharW(e) OR isPtr(e) OR isRec(e), pos, 95); |
IF isRecPtr(e) THEN |
PARS.check(isVar(e), parser, pos, 93); |
PARS.check(e.ident # NIL, parser, pos, 106) |
PARS.check(isVar(e), pos, 93); |
PARS.check(e.ident # NIL, pos, 106) |
END; |
IF isRec(e) THEN |
PARS.check(e.obj = eVREC, parser, pos, 78) |
PARS.check(e.obj = eVREC, pos, 78) |
END; |
IF e.obj = eCONST THEN |
LoadConst(e) |
ELSIF isRec(e) THEN |
CODE.drop; |
CODE.AddCmd(CODE.opLADR, e.ident.offset - 1); |
CODE.load(PARS.program.target.word) |
IL.drop; |
IL.AddCmd(IL.opLADR, e.ident.offset - 1); |
IL.load(PARS.program.target.word) |
ELSIF isPtr(e) THEN |
deref(pos, e, FALSE, errPTR); |
CODE.AddCmd(CODE.opSUBR, PARS.program.target.word); |
CODE.load(PARS.program.target.word) |
IL.AddCmd(IL.opSUBR, PARS.program.target.word); |
IL.load(PARS.program.target.word) |
END; |
PARS.checklex(parser, SCAN.lxOF); |
2995,7 → 3071,7 |
PROCEDURE ForStatement (parser: PARS.PARSER); |
VAR |
e: PARS.EXPR; |
pos: SCAN.POSITION; |
pos, pos2: PARS.POSITION; |
step: ARITH.VALUE; |
st: INTEGER; |
ident: PROG.IDENT; |
3003,55 → 3079,55 |
L1, L2: INTEGER; |
BEGIN |
CODE.AddCmd0(CODE.opLOOP); |
IL.AddCmd0(IL.opLOOP); |
L1 := CODE.NewLabel(); |
L2 := CODE.NewLabel(); |
L1 := IL.NewLabel(); |
L2 := IL.NewLabel(); |
PARS.ExpectSym(parser, SCAN.lxIDENT); |
ident := parser.unit.idents.get(parser.unit, parser.lex.ident, TRUE); |
ident := PROG.getIdent(parser.unit, parser.lex.ident, TRUE); |
PARS.check1(ident # NIL, parser, 48); |
PARS.check1(ident.typ = PROG.idVAR, parser, 93); |
PARS.check1(ident.type.typ = PROG.tINTEGER, parser, 97); |
PARS.check1(ident.type = tINTEGER, parser, 97); |
PARS.ExpectSym(parser, SCAN.lxASSIGN); |
NextPos(parser, pos); |
expression(parser, e); |
PARS.check(isInt(e), parser, pos, 76); |
PARS.check(isInt(e), pos, 76); |
offset := PROG.getOffset(PARS.program, ident); |
IF ident.global THEN |
CODE.AddCmd(CODE.opGADR, offset) |
IL.AddCmd(IL.opGADR, offset) |
ELSE |
CODE.AddCmd(CODE.opLADR, -offset) |
IL.AddCmd(IL.opLADR, -offset) |
END; |
IF e.obj = eCONST THEN |
CODE.AddCmd(CODE.opSAVEC, ARITH.Int(e.value)) |
IL.AddCmd(IL.opSAVEC, ARITH.Int(e.value)) |
ELSE |
CODE.AddCmd0(CODE.opSAVE) |
IL.AddCmd0(IL.opSAVE) |
END; |
CODE.SetLabel(L1); |
IL.SetLabel(L1); |
IF ident.global THEN |
CODE.AddCmd(CODE.opGADR, offset) |
IL.AddCmd(IL.opGADR, offset) |
ELSE |
CODE.AddCmd(CODE.opLADR, -offset) |
IL.AddCmd(IL.opLADR, -offset) |
END; |
CODE.load(ident.type.size); |
IL.load(ident.type.size); |
PARS.checklex(parser, SCAN.lxTO); |
NextPos(parser, pos); |
NextPos(parser, pos2); |
expression(parser, e); |
PARS.check(isInt(e), parser, pos, 76); |
PARS.check(isInt(e), pos2, 76); |
IF parser.sym = SCAN.lxBY THEN |
NextPos(parser, pos); |
PARS.ConstExpression(parser, step); |
PARS.check(step.typ = ARITH.tINTEGER, parser, pos, 76); |
PARS.check(step.typ = ARITH.tINTEGER, pos, 76); |
st := ARITH.getInt(step); |
PARS.check(st # 0, parser, pos, 98) |
PARS.check(st # 0, pos, 98) |
ELSE |
st := 1 |
END; |
3058,19 → 3134,25 |
IF e.obj = eCONST THEN |
IF st > 0 THEN |
CODE.AddCmd(CODE.opLER, ARITH.Int(e.value)) |
IL.AddCmd(IL.opLEC, ARITH.Int(e.value)); |
IF ARITH.Int(e.value) = UTILS.target.maxInt THEN |
ERRORS.WarningMsg(pos2.line, pos2.col, 1) |
END |
ELSE |
CODE.AddCmd(CODE.opGER, ARITH.Int(e.value)) |
IL.AddCmd(IL.opGEC, ARITH.Int(e.value)); |
IF ARITH.Int(e.value) = UTILS.target.minInt THEN |
ERRORS.WarningMsg(pos2.line, pos2.col, 1) |
END |
END |
ELSE |
IF st > 0 THEN |
CODE.AddCmd0(CODE.opLE) |
IL.AddCmd0(IL.opLE) |
ELSE |
CODE.AddCmd0(CODE.opGE) |
IL.AddCmd0(IL.opGE) |
END |
END; |
CODE.AddJmpCmd(CODE.opJNE, L2); |
IL.AddJmpCmd(IL.opJNE, L2); |
PARS.checklex(parser, SCAN.lxDO); |
PARS.Next(parser); |
3077,31 → 3159,21 |
parser.StatSeq(parser); |
IF ident.global THEN |
CODE.AddCmd(CODE.opGADR, offset) |
IL.AddCmd(IL.opGADR, offset) |
ELSE |
CODE.AddCmd(CODE.opLADR, -offset) |
IL.AddCmd(IL.opLADR, -offset) |
END; |
IF st = 1 THEN |
CODE.AddCmd0(CODE.opINC1) |
ELSIF st = -1 THEN |
CODE.AddCmd0(CODE.opDEC1) |
ELSE |
IF st > 0 THEN |
CODE.AddCmd(CODE.opINCC, st) |
ELSE |
CODE.AddCmd(CODE.opDECC, -st) |
END |
END; |
IL.AddCmd(IL.opINCC, st); |
CODE.AddJmpCmd(CODE.opJMP, L1); |
IL.AddJmpCmd(IL.opJMP, L1); |
PARS.checklex(parser, SCAN.lxEND); |
PARS.Next(parser); |
CODE.SetLabel(L2); |
IL.SetLabel(L2); |
CODE.AddCmd0(CODE.opENDLOOP) |
IL.AddCmd0(IL.opENDLOOP) |
END ForStatement; |
3139,7 → 3211,7 |
END StatSeq; |
PROCEDURE chkreturn (parser: PARS.PARSER; e: PARS.EXPR; t: PROG.TYPE_; pos: SCAN.POSITION): BOOLEAN; |
PROCEDURE chkreturn (parser: PARS.PARSER; e: PARS.EXPR; t: PROG.TYPE_; pos: PARS.POSITION): BOOLEAN; |
VAR |
res: BOOLEAN; |
3147,24 → 3219,24 |
res := assigncomp(e, t); |
IF res THEN |
IF e.obj = eCONST THEN |
IF e.type.typ = PROG.tREAL THEN |
CODE.Float(ARITH.Float(e.value)) |
IF e.type = tREAL THEN |
IL.Float(ARITH.Float(e.value)) |
ELSIF e.type.typ = PROG.tNIL THEN |
CODE.AddCmd(CODE.opCONST, 0) |
IL.Const(0) |
ELSE |
LoadConst(e) |
END |
ELSIF (e.type.typ = PROG.tINTEGER) & (t.typ = PROG.tBYTE) & (chkBYTE IN checking) THEN |
ELSIF (e.type = tINTEGER) & (t = tBYTE) & (chkBYTE IN Options.checking) THEN |
CheckRange(256, pos.line, errBYTE) |
ELSIF e.obj = ePROC THEN |
PARS.check(e.ident.global, parser, pos, 85); |
CODE.PushProc(e.ident.proc.label) |
PARS.check(e.ident.global, pos, 85); |
IL.PushProc(e.ident.proc.label) |
ELSIF e.obj = eIMP THEN |
CODE.PushImpProc(e.ident.import) |
IL.PushImpProc(e.ident.import) |
END; |
IF e.type.typ = PROG.tREAL THEN |
CODE.retf |
IF e.type = tREAL THEN |
IL.retf |
END |
END |
3182,16 → 3254,16 |
id: PROG.IDENT; |
BEGIN |
id := rtl.idents.get(rtl, SCAN.enterid(name), FALSE); |
id := PROG.getIdent(rtl, SCAN.enterid(name), FALSE); |
IF (id # NIL) & (id.import # NIL) THEN |
CODE.codes.rtl[idx] := -id.import(CODE.IMPORT_PROC).label; |
IL.codes.rtl[idx] := -id.import(IL.IMPORT_PROC).label; |
id.proc.used := TRUE |
ELSIF (id # NIL) & (id.proc # NIL) THEN |
CODE.codes.rtl[idx] := id.proc.label; |
IL.codes.rtl[idx] := id.proc.label; |
id.proc.used := TRUE |
ELSE |
ERRORS.error5("procedure ", mConst.RTL_NAME, ".", name, " not found") |
ERRORS.WrongRTL(name) |
END |
END getproc; |
3200,46 → 3272,65 |
rtl := PARS.program.rtl; |
ASSERT(rtl # NIL); |
getproc(rtl, "_move", CODE._move); |
getproc(rtl, "_move2", CODE._move2); |
getproc(rtl, "_set", CODE._set); |
getproc(rtl, "_set2", CODE._set2); |
getproc(rtl, "_div", CODE._div); |
getproc(rtl, "_mod", CODE._mod); |
getproc(rtl, "_div2", CODE._div2); |
getproc(rtl, "_mod2", CODE._mod2); |
getproc(rtl, "_arrcpy", CODE._arrcpy); |
getproc(rtl, "_rot", CODE._rot); |
getproc(rtl, "_new", CODE._new); |
getproc(rtl, "_dispose", CODE._dispose); |
getproc(rtl, "_strcmp", CODE._strcmp); |
getproc(rtl, "_error", CODE._error); |
getproc(rtl, "_is", CODE._is); |
getproc(rtl, "_isrec", CODE._isrec); |
getproc(rtl, "_guard", CODE._guard); |
getproc(rtl, "_guardrec", CODE._guardrec); |
getproc(rtl, "_length", CODE._length); |
getproc(rtl, "_init", CODE._init); |
getproc(rtl, "_dllentry", CODE._dllentry); |
getproc(rtl, "_strcpy", CODE._strcpy); |
getproc(rtl, "_exit", CODE._exit); |
getproc(rtl, "_strcpy2", CODE._strcpy2); |
getproc(rtl, "_lengthw", CODE._lengthw); |
getproc(rtl, "_strcmp2", CODE._strcmp2); |
getproc(rtl, "_strcmpw", CODE._strcmpw); |
getproc(rtl, "_strcmpw2", CODE._strcmpw2); |
IF CPU IN {cpuX86, cpuAMD64} THEN |
getproc(rtl, "_strcmp", IL._strcmp); |
getproc(rtl, "_length", IL._length); |
getproc(rtl, "_arrcpy", IL._arrcpy); |
getproc(rtl, "_move", IL._move); |
getproc(rtl, "_is", IL._is); |
getproc(rtl, "_guard", IL._guard); |
getproc(rtl, "_guardrec", IL._guardrec); |
getproc(rtl, "_error", IL._error); |
getproc(rtl, "_new", IL._new); |
getproc(rtl, "_rot", IL._rot); |
getproc(rtl, "_strcpy", IL._strcpy); |
getproc(rtl, "_move2", IL._move2); |
getproc(rtl, "_div2", IL._div2); |
getproc(rtl, "_mod2", IL._mod2); |
getproc(rtl, "_div", IL._div); |
getproc(rtl, "_mod", IL._mod); |
getproc(rtl, "_set", IL._set); |
getproc(rtl, "_set2", IL._set2); |
getproc(rtl, "_isrec", IL._isrec); |
getproc(rtl, "_lengthw", IL._lengthw); |
getproc(rtl, "_strcmpw", IL._strcmpw); |
getproc(rtl, "_dllentry", IL._dllentry); |
getproc(rtl, "_dispose", IL._dispose); |
getproc(rtl, "_exit", IL._exit); |
getproc(rtl, "_init", IL._init); |
getproc(rtl, "_sofinit", IL._sofinit) |
END |
END setrtl; |
PROCEDURE compile* (path, lib_path, modname, outname: PARS.PATH; target, version, stack, base: INTEGER; pic: BOOLEAN; chk: SET); |
PROCEDURE compile* (path, lib_path, modname, outname: PARS.PATH; target: INTEGER; options: PROG.OPTIONS); |
VAR |
parser: PARS.PARSER; |
ext: PARS.PATH; |
amd64: BOOLEAN; |
BEGIN |
amd64 := target IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64, mConst.Target_iELF64}; |
tINTEGER := PARS.program.stTypes.tINTEGER; |
tBYTE := PARS.program.stTypes.tBYTE; |
tCHAR := PARS.program.stTypes.tCHAR; |
tSET := PARS.program.stTypes.tSET; |
tBOOLEAN := PARS.program.stTypes.tBOOLEAN; |
tWCHAR := PARS.program.stTypes.tWCHAR; |
tREAL := PARS.program.stTypes.tREAL; |
Options := options; |
CASE target OF |
|mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64, mConst.Target_iELF64, mConst.Target_iELFSO64: |
CPU := cpuAMD64 |
|mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL, |
mConst.Target_iKolibri, mConst.Target_iObject, mConst.Target_iELF32, |
mConst.Target_iELFSO32: |
CPU := cpuX86 |
|mConst.Target_iMSP430: |
CPU := cpuMSP430 |
END; |
ext := mConst.FILE_EXT; |
CaseLabels := C.create(); |
CaseVar := C.create(); |
3247,14 → 3338,13 |
CaseVariants := LISTS.create(NIL); |
LISTS.push(CaseVariants, NewVariant(0, NIL)); |
checking := chk; |
IF amd64 THEN |
CODE.init(6, CODE.little_endian) |
ELSE |
CODE.init(8, CODE.little_endian) |
CASE CPU OF |
|cpuAMD64: IL.init(6, IL.little_endian) |
|cpuX86: IL.init(8, IL.little_endian) |
|cpuMSP430: IL.init(0, IL.little_endian) |
END; |
IF CPU # cpuMSP430 THEN |
parser := PARS.create(path, lib_path, StatSeq, expression, designator, chkreturn); |
IF parser.open(parser, mConst.RTL_NAME) THEN |
parser.parse(parser); |
3266,8 → 3356,9 |
parser.parse(parser); |
PARS.destroy(parser) |
ELSE |
ERRORS.error5("file ", lib_path, mConst.RTL_NAME, mConst.FILE_EXT, " not found") |
ERRORS.FileNotFound(lib_path, mConst.RTL_NAME, mConst.FILE_EXT) |
END |
END |
END; |
parser := PARS.create(path, lib_path, StatSeq, expression, designator, chkreturn); |
3276,25 → 3367,29 |
IF parser.open(parser, modname) THEN |
parser.parse(parser) |
ELSE |
ERRORS.error5("file ", path, modname, mConst.FILE_EXT, " not found") |
ERRORS.FileNotFound(path, modname, mConst.FILE_EXT) |
END; |
PARS.destroy(parser); |
IF PARS.program.bss > mConst.MAX_GLOBAL_SIZE THEN |
ERRORS.error1("size of global variables is too large") |
ERRORS.Error(204) |
END; |
setrtl; |
IF CPU # cpuMSP430 THEN |
setrtl |
END; |
PROG.DelUnused(PARS.program, CODE.DelImport); |
PROG.DelUnused(PARS.program, IL.DelImport); |
CODE.codes.bss := PARS.program.bss; |
IF amd64 THEN |
AMD64.CodeGen(CODE.codes, outname, target, stack, base) |
ELSE |
X86.CodeGen(CODE.codes, outname, target, stack, base, version, pic) |
IL.codes.bss := PARS.program.bss; |
CASE CPU OF |
| cpuAMD64: AMD64.CodeGen(IL.codes, outname, target, options) |
| cpuX86: X86.CodeGen(IL.codes, outname, target, options) |
|cpuMSP430: MSP430.CodeGen(IL.codes, outname, target, options) |
END |
END compile; |
/programs/develop/oberon07/Source/STRINGS.ob07 |
---|
92,6 → 92,29 |
END IntToStr; |
PROCEDURE hexdgt (n: BYTE): BYTE; |
BEGIN |
IF n < 10 THEN |
n := n + ORD("0") |
ELSE |
n := n - 10 + ORD("A") |
END |
RETURN n |
END hexdgt; |
PROCEDURE IntToHex* (x: INTEGER; VAR str: ARRAY OF CHAR; n: INTEGER); |
BEGIN |
str[n] := 0X; |
WHILE n > 0 DO |
str[n - 1] := CHR(hexdgt(x MOD 16)); |
x := x DIV 16; |
DEC(n) |
END |
END IntToHex; |
PROCEDURE copy* (src: ARRAY OF CHAR; VAR dst: ARRAY OF CHAR; spos, dpos, count: INTEGER); |
BEGIN |
WHILE count > 0 DO |
/programs/develop/oberon07/Source/TEXTDRV.ob07 |
---|
1,7 → 1,7 |
(* |
BSD 2-Clause License |
Copyright (c) 2018, Anton Krotov |
Copyright (c) 2018, 2019, Anton Krotov |
All rights reserved. |
*) |
30,11 → 30,8 |
line*, col*: INTEGER; |
eof*: BOOLEAN; |
eol*: BOOLEAN; |
peak*: CHAR |
open*: PROCEDURE (text: TEXT; name: ARRAY OF CHAR): BOOLEAN; |
peak*: PROCEDURE (text: TEXT): CHAR; |
nextc*: PROCEDURE (text: TEXT) |
END; |
43,26 → 40,6 |
texts: C.COLLECTION; |
PROCEDURE reset (text: TEXT); |
BEGIN |
text.chunk[0] := 0; |
text.pos := 0; |
text.size := 0; |
text.file := NIL; |
text.utf8 := FALSE; |
text.CR := FALSE; |
text.line := 1; |
text.col := 1; |
text.eof := FALSE; |
text.eol := FALSE |
END reset; |
PROCEDURE peak (text: TEXT): CHAR; |
RETURN CHR(text.chunk[text.pos]) |
END peak; |
PROCEDURE load (text: TEXT); |
BEGIN |
IF ~text.eof THEN |
71,17 → 48,20 |
IF text.size = 0 THEN |
text.eof := TRUE; |
text.chunk[0] := 0 |
END; |
text.peak := CHR(text.chunk[0]) |
END |
END |
END load; |
PROCEDURE next (text: TEXT); |
PROCEDURE next* (text: TEXT); |
VAR |
c: CHAR; |
BEGIN |
IF text.pos < text.size - 1 THEN |
INC(text.pos) |
INC(text.pos); |
text.peak := CHR(text.chunk[text.pos]) |
ELSE |
load(text) |
END; |
88,7 → 68,7 |
IF ~text.eof THEN |
c := peak(text); |
c := text.peak; |
IF c = CR THEN |
INC(text.line); |
123,7 → 103,6 |
PROCEDURE init (text: TEXT); |
BEGIN |
IF (text.pos = 0) & (text.size >= 3) THEN |
IF (text.chunk[0] = 0EFH) & |
(text.chunk[1] = 0BBH) & |
140,27 → 119,26 |
END; |
text.line := 1; |
text.col := 1 |
text.col := 1; |
text.peak := CHR(text.chunk[text.pos]) |
END init; |
PROCEDURE open (text: TEXT; name: ARRAY OF CHAR): BOOLEAN; |
PROCEDURE close* (VAR text: TEXT); |
BEGIN |
ASSERT(text # NIL); |
IF text # NIL THEN |
IF text.file # NIL THEN |
FILES.close(text.file) |
END; |
reset(text); |
text.file := FILES.open(name); |
IF text.file # NIL THEN |
load(text); |
init(text) |
C.push(texts, text); |
text := NIL |
END |
END close; |
RETURN text.file # NIL |
END open; |
PROCEDURE NewText (): TEXT; |
PROCEDURE open* (name: ARRAY OF CHAR): TEXT; |
VAR |
text: TEXT; |
citem: C.ITEM; |
171,39 → 149,32 |
NEW(text) |
ELSE |
text := citem(TEXT) |
END |
END; |
RETURN text |
END NewText; |
PROCEDURE create* (): TEXT; |
VAR |
text: TEXT; |
BEGIN |
text := NewText(); |
reset(text); |
text.open := open; |
text.peak := peak; |
text.nextc := next |
RETURN text |
END create; |
PROCEDURE destroy* (VAR text: TEXT); |
BEGIN |
IF text # NIL THEN |
text.chunk[0] := 0; |
text.pos := 0; |
text.size := 0; |
text.utf8 := FALSE; |
text.CR := FALSE; |
text.line := 1; |
text.col := 1; |
text.eof := FALSE; |
text.eol := FALSE; |
text.peak := 0X; |
text.file := FILES.open(name); |
IF text.file # NIL THEN |
FILES.close(text.file) |
END; |
C.push(texts, text); |
text := NIL |
load(text); |
init(text) |
ELSE |
close(text) |
END |
END destroy; |
END |
RETURN text |
END open; |
BEGIN |
texts := C.create() |
END TEXTDRV. |
/programs/develop/oberon07/Source/UNIXTIME.ob07 |
---|
1,7 → 1,7 |
(* |
BSD 2-Clause License |
Copyright (c) 2018, Anton Krotov |
Copyright (c) 2018, 2019, Anton Krotov |
All rights reserved. |
*) |
55,12 → 55,7 |
PROCEDURE time* (year, month, day, hour, min, sec: INTEGER): INTEGER; |
VAR |
d, s: INTEGER; |
BEGIN |
d := (year - 1970) * 365 + days[month - 1, day - 1, ORD(year DIV 4 = 0)] + (year - 1969) DIV 4; |
s := d * 86400 + hour * 3600 + min * 60 + sec |
RETURN s |
RETURN ((year - 1970) * 365 + days[month - 1, day - 1, ORD(year DIV 4 = 0)] + (year - 1969) DIV 4) * 86400 + hour * 3600 + min * 60 + sec |
END time; |
/programs/develop/oberon07/Source/UTILS.ob07 |
---|
20,7 → 20,10 |
OS = HOST.OS; |
min32* = -2147483647-1; |
max32* = 2147483647; |
VAR |
time*: INTEGER; |
29,7 → 32,23 |
maxreal*: REAL; |
target*: |
RECORD |
bit_depth*, |
maxInt*, |
minInt*, |
maxSet*, |
maxHex*: INTEGER; |
maxReal*: REAL |
END; |
bit_diff*: INTEGER; |
PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER; |
RETURN HOST.FileRead(F, Buffer, bytes) |
END FileRead; |
112,7 → 131,77 |
END UnixTime; |
PROCEDURE SetBitDepth* (BitDepth: INTEGER); |
BEGIN |
ASSERT((BitDepth = 16) OR (BitDepth = 32) OR (BitDepth = 64)); |
bit_diff := bit_depth - BitDepth; |
ASSERT(bit_diff >= 0); |
target.bit_depth := BitDepth; |
target.maxSet := BitDepth - 1; |
target.maxHex := BitDepth DIV 4; |
target.minInt := ASR(minint, bit_diff); |
target.maxInt := ASR(maxint, bit_diff); |
target.maxReal := 1.9; |
PACK(target.maxReal, 1023); |
END SetBitDepth; |
PROCEDURE Byte* (n: INTEGER; idx: INTEGER): BYTE; |
RETURN ASR(n, 8 * idx) MOD 256 |
END Byte; |
PROCEDURE Align* (VAR bytes: INTEGER; align: INTEGER): BOOLEAN; |
VAR |
res: BOOLEAN; |
BEGIN |
IF bytes MOD align # 0 THEN |
res := maxint - bytes >= align - (bytes MOD align); |
IF res THEN |
bytes := bytes + align - (bytes MOD align) |
END |
ELSE |
res := TRUE |
END |
RETURN res |
END Align; |
PROCEDURE Long* (value: INTEGER): INTEGER; |
RETURN ASR(LSL(value, bit_diff), bit_diff) |
END Long; |
PROCEDURE Short* (value: INTEGER): INTEGER; |
RETURN LSR(LSL(value, bit_diff), bit_diff) |
END Short; |
PROCEDURE Log2* (x: INTEGER): INTEGER; |
VAR |
n: INTEGER; |
BEGIN |
ASSERT(x > 0); |
n := 0; |
WHILE ~ODD(x) DO |
x := x DIV 2; |
INC(n) |
END; |
IF x # 1 THEN |
n := -1 |
END |
RETURN n |
END Log2; |
BEGIN |
time := GetTickCount(); |
COPY(HOST.eol, eol); |
maxreal := 1.9; |
/programs/develop/oberon07/Source/WRITER.ob07 |
---|
1,13 → 1,13 |
(* |
BSD 2-Clause License |
Copyright (c) 2018, Anton Krotov |
Copyright (c) 2018, 2019, Anton Krotov |
All rights reserved. |
*) |
MODULE WRITER; |
IMPORT FILES, ERRORS, MACHINE; |
IMPORT FILES, ERRORS, UTILS; |
TYPE |
35,7 → 35,7 |
IF FILES.WriteByte(file, n) THEN |
INC(counter) |
ELSE |
ERRORS.error1("writing file error") |
ERRORS.Error(201) |
END |
END WriteByte; |
47,7 → 47,7 |
BEGIN |
n := FILES.write(file, chunk, bytes); |
IF n # bytes THEN |
ERRORS.error1("writing file error") |
ERRORS.Error(201) |
END; |
INC(counter, n) |
END Write; |
59,7 → 59,7 |
BEGIN |
FOR i := 0 TO 7 DO |
WriteByte(file, MACHINE.Byte(n, i)) |
WriteByte(file, UTILS.Byte(n, i)) |
END |
END Write64LE; |
70,7 → 70,7 |
BEGIN |
FOR i := 0 TO 3 DO |
WriteByte(file, MACHINE.Byte(n, i)) |
WriteByte(file, UTILS.Byte(n, i)) |
END |
END Write32LE; |
77,8 → 77,8 |
PROCEDURE Write16LE* (file: FILE; n: INTEGER); |
BEGIN |
WriteByte(file, MACHINE.Byte(n, 0)); |
WriteByte(file, MACHINE.Byte(n, 1)) |
WriteByte(file, UTILS.Byte(n, 0)); |
WriteByte(file, UTILS.Byte(n, 1)) |
END Write16LE; |
/programs/develop/oberon07/Source/X86.ob07 |
---|
7,7 → 7,8 |
MODULE X86; |
IMPORT CODE, REG, UTILS, LISTS, BIN, PE32, KOS, MSCOFF, ELF, mConst := CONSTANTS, MACHINE, CHL := CHUNKLISTS, PATHS; |
IMPORT IL, REG, UTILS, LISTS, BIN, PE32, KOS, MSCOFF, ELF, PROG, |
mConst := CONSTANTS, CHL := CHUNKLISTS, PATHS; |
CONST |
31,7 → 32,7 |
TYPE |
COMMAND = CODE.COMMAND; |
COMMAND = IL.COMMAND; |
ANYCODE = POINTER TO RECORD (LISTS.ITEM) |
40,7 → 41,7 |
END; |
TCODE = POINTER TO RECORD (ANYCODE) |
CODE = POINTER TO RECORD (ANYCODE) |
code: ARRAY CODECHUNK OF BYTE; |
length: INTEGER |
89,27 → 90,29 |
CodeList: LISTS.LIST; |
tcount: INTEGER; |
PROCEDURE Byte (n: INTEGER): BYTE; |
RETURN MACHINE.Byte(n, 0) |
RETURN UTILS.Byte(n, 0) |
END Byte; |
PROCEDURE Word (n: INTEGER): INTEGER; |
RETURN MACHINE.Byte(n, 0) + MACHINE.Byte(n, 1) * 256 |
RETURN UTILS.Byte(n, 0) + UTILS.Byte(n, 1) * 256 |
END Word; |
PROCEDURE OutByte* (n: BYTE); |
VAR |
c: TCODE; |
c: CODE; |
last: ANYCODE; |
BEGIN |
last := CodeList.last(ANYCODE); |
IF (last IS TCODE) & (last(TCODE).length < CODECHUNK) THEN |
c := last(TCODE); |
IF (last IS CODE) & (last(CODE).length < CODECHUNK) THEN |
c := last(CODE); |
c.code[c.length] := n; |
INC(c.length) |
ELSE |
124,10 → 127,10 |
PROCEDURE OutInt (n: INTEGER); |
BEGIN |
OutByte(MACHINE.Byte(n, 0)); |
OutByte(MACHINE.Byte(n, 1)); |
OutByte(MACHINE.Byte(n, 2)); |
OutByte(MACHINE.Byte(n, 3)) |
OutByte(UTILS.Byte(n, 0)); |
OutByte(UTILS.Byte(n, 1)); |
OutByte(UTILS.Byte(n, 2)); |
OutByte(UTILS.Byte(n, 3)) |
END OutInt; |
181,10 → 184,10 |
PROCEDURE shift* (op, reg: INTEGER); |
BEGIN |
CASE op OF |
|CODE.opASR, CODE.opASR1, CODE.opASR2: OutByte(0F8H + reg) |
|CODE.opROR, CODE.opROR1, CODE.opROR2: OutByte(0C8H + reg) |
|CODE.opLSL, CODE.opLSL1, CODE.opLSL2: OutByte(0E0H + reg) |
|CODE.opLSR, CODE.opLSR1, CODE.opLSR2: OutByte(0E8H + reg) |
|IL.opASR, IL.opASR1, IL.opASR2: OutByte(0F8H + reg) |
|IL.opROR, IL.opROR1, IL.opROR2: OutByte(0C8H + reg) |
|IL.opLSL, IL.opLSL1, IL.opLSL2: OutByte(0E0H + reg) |
|IL.opLSR, IL.opLSR1, IL.opLSR2: OutByte(0E8H + reg) |
END |
END shift; |
320,27 → 323,11 |
END drop; |
PROCEDURE log2* (x: INTEGER): INTEGER; |
VAR |
n: INTEGER; |
PROCEDURE GetAnyReg (): INTEGER; |
RETURN REG.GetAnyReg(R) |
END GetAnyReg; |
BEGIN |
ASSERT(x > 0); |
n := 0; |
WHILE ~ODD(x) DO |
x := x DIV 2; |
INC(n) |
END; |
IF x # 1 THEN |
n := -1 |
END |
RETURN n |
END log2; |
PROCEDURE cond* (op: INTEGER): INTEGER; |
VAR |
res: INTEGER; |
347,12 → 334,12 |
BEGIN |
CASE op OF |
|CODE.opGT, CODE.opGTR, CODE.opLTL: res := jg |
|CODE.opGE, CODE.opGER, CODE.opLEL: res := jge |
|CODE.opLT, CODE.opLTR, CODE.opGTL: res := jl |
|CODE.opLE, CODE.opLER, CODE.opGEL: res := jle |
|CODE.opEQ, CODE.opEQR, CODE.opEQL: res := je |
|CODE.opNE, CODE.opNER, CODE.opNEL: res := jne |
|IL.opGT, IL.opGTC: res := jg |
|IL.opGE, IL.opGEC: res := jge |
|IL.opLT, IL.opLTC: res := jl |
|IL.opLE, IL.opLEC: res := jle |
|IL.opEQ, IL.opEQC: res := je |
|IL.opNE, IL.opNEC: res := jne |
END |
RETURN res |
359,18 → 346,11 |
END cond; |
PROCEDURE inv1* (op: INTEGER): INTEGER; |
BEGIN |
IF ODD(op) THEN |
DEC(op) |
ELSE |
INC(op) |
END |
PROCEDURE inv0* (op: INTEGER): INTEGER; |
RETURN ORD(BITS(op) / {0}) |
END inv0; |
RETURN op |
END inv1; |
PROCEDURE Reloc* (op, value: INTEGER); |
VAR |
reloc: RELOC; |
436,12 → 416,12 |
reg1: INTEGER; |
BEGIN |
label := CODE.codes.rtl[proc]; |
label := IL.codes.rtl[proc]; |
IF label < 0 THEN |
label := -label; |
IF pic THEN |
reg1 := REG.GetAnyReg(R); |
reg1 := GetAnyReg(); |
Pic(reg1, BIN.PICIMP, label); |
OutByte2(0FFH, 010H + reg1); // call dword[reg1] |
drop |
485,7 → 465,7 |
code.offset := count; |
CASE code OF |
|TCODE: INC(count, code.length) |
|CODE: INC(count, code.length) |
|LABEL: BIN.SetLabel(program, code.label, count) |
|JMP: IF code.short THEN INC(count, 2) ELSE INC(count, 5) END; code.offset := count |
|JCC: IF code.short THEN INC(count, 2) ELSE INC(count, 6) END; code.offset := count |
518,7 → 498,7 |
CASE code OF |
|TCODE: |
|CODE: |
FOR i := 0 TO code.length - 1 DO |
BIN.PutCode(program, code.code[i]) |
END |
576,7 → 556,7 |
PROCEDURE PushAll (NumberOfParameters: INTEGER); |
BEGIN |
REG.PushAll(R); |
R.pushed := R.pushed - NumberOfParameters |
DEC(R.pushed, NumberOfParameters) |
END PushAll; |
583,7 → 563,7 |
PROCEDURE NewLabel (): INTEGER; |
BEGIN |
BIN.NewLabel(program) |
RETURN CODE.NewLabel() |
RETURN IL.NewLabel() |
END NewLabel; |
593,7 → 573,7 |
END GetRegA; |
PROCEDURE translate (code: CODE.CODES; pic: BOOLEAN; stroffs: INTEGER); |
PROCEDURE translate (code: IL.CODES; pic: BOOLEAN; stroffs: INTEGER); |
VAR |
cmd: COMMAND; |
601,7 → 581,7 |
n, a, b, label, cc: INTEGER; |
param1, param2: INTEGER; |
opcode, param1, param2: INTEGER; |
float: REAL; |
613,17 → 593,19 |
param1 := cmd.param1; |
param2 := cmd.param2; |
CASE cmd.opcode OF |
opcode := cmd.opcode; |
|CODE.opJMP: |
CASE opcode OF |
|IL.opJMP: |
jmp(param1) |
|CODE.opCALL: |
|IL.opCALL: |
call(param1) |
|CODE.opCALLI: |
|IL.opCALLI: |
IF pic THEN |
reg1 := REG.GetAnyReg(R); |
reg1 := GetAnyReg(); |
Pic(reg1, BIN.PICIMP, param1); |
OutByte2(0FFH, 010H + reg1); // call dword[reg1] |
drop |
632,13 → 614,13 |
Reloc(BIN.RIMP, param1) |
END |
|CODE.opCALLP: |
|IL.opCALLP: |
UnOp(reg1); |
OutByte2(0FFH, 0D0H + reg1); // call reg1 |
drop; |
ASSERT(R.top = -1) |
|CODE.opPRECALL: |
|IL.opPRECALL: |
n := param2; |
IF (param1 # 0) & (n # 0) THEN |
subrc(esp, 8) |
650,7 → 632,7 |
END; |
PushAll(0) |
|CODE.opALIGN16: |
|IL.opALIGN16: |
ASSERT(eax IN R.regs); |
mov(eax, esp); |
andrc(esp, -16); |
660,7 → 642,7 |
END; |
push(eax) |
|CODE.opRES: |
|IL.opRES: |
ASSERT(R.top = -1); |
GetRegA; |
n := param2; |
670,7 → 652,7 |
DEC(n) |
END |
|CODE.opRESF: |
|IL.opRESF: |
n := param2; |
IF n > 0 THEN |
OutByte3(0DDH, 5CH + long(n * 8), 24H); |
684,7 → 666,7 |
DEC(n) |
END |
|CODE.opENTER: |
|IL.opENTER: |
ASSERT(R.top = -1); |
SetLabel(param1); |
704,8 → 686,8 |
END |
END |
|CODE.opLEAVE, CODE.opLEAVER, CODE.opLEAVEF: |
IF cmd.opcode = CODE.opLEAVER THEN |
|IL.opLEAVE, IL.opLEAVER, IL.opLEAVEF: |
IF opcode = IL.opLEAVER THEN |
UnOp(reg1); |
IF reg1 # eax THEN |
GetRegA; |
717,7 → 699,10 |
ASSERT(R.top = -1); |
mov(esp, ebp); |
IF param1 > 0 THEN |
mov(esp, ebp) |
END; |
pop(ebp); |
n := param2; |
728,10 → 713,10 |
OutByte(0C3H) // ret |
END |
|CODE.opERRC: |
|IL.opPUSHC: |
pushc(param2) |
|CODE.opPARAM: |
|IL.opPARAM: |
n := param2; |
IF n = 1 THEN |
UnOp(reg1); |
742,26 → 727,25 |
PushAll(n) |
END |
|CODE.opCLEANUP: |
|IL.opCLEANUP: |
n := param2 * 4; |
IF n # 0 THEN |
addrc(esp, n) |
END |
|CODE.opPOPSP: |
|IL.opPOPSP: |
pop(esp) |
|CODE.opCONST: |
reg1 := REG.GetAnyReg(R); |
movrc(reg1, param2) |
|IL.opCONST: |
movrc(GetAnyReg(), param2) |
|CODE.opLABEL: |
SetLabel(param2) // L: |
|IL.opLABEL: |
SetLabel(param1) // L: |
|CODE.opNOP: |
|IL.opNOP: |
|CODE.opGADR: |
reg1 := REG.GetAnyReg(R); |
|IL.opGADR: |
reg1 := GetAnyReg(); |
IF pic THEN |
Pic(reg1, BIN.PICBSS, param2) |
ELSE |
769,20 → 753,18 |
Reloc(BIN.RBSS, param2) |
END |
|CODE.opLADR: |
|IL.opLADR: |
n := param2 * 4; |
reg1 := REG.GetAnyReg(R); |
OutByte2(8DH, 45H + reg1 * 8 + long(n)); // lea reg1, dword[ebp + n] |
OutByte2(8DH, 45H + GetAnyReg() * 8 + long(n)); // lea reg1, dword[ebp + n] |
OutIntByte(n) |
|CODE.opVADR: |
|IL.opVADR: |
n := param2 * 4; |
reg1 := REG.GetAnyReg(R); |
OutByte2(8BH, 45H + reg1 * 8 + long(n)); // mov reg1, dword[ebp + n] |
OutByte2(8BH, 45H + GetAnyReg() * 8 + long(n)); // mov reg1, dword[ebp + n] |
OutIntByte(n) |
|CODE.opSADR: |
reg1 := REG.GetAnyReg(R); |
|IL.opSADR: |
reg1 := GetAnyReg(); |
IF pic THEN |
Pic(reg1, BIN.PICDATA, stroffs + param2); |
ELSE |
790,30 → 772,30 |
Reloc(BIN.RDATA, stroffs + param2) |
END |
|CODE.opSAVEC: |
|IL.opSAVEC: |
UnOp(reg1); |
OutByte2(0C7H, reg1); OutInt(param2); // mov dword[reg1], param2 |
drop |
|CODE.opSAVE8C: |
|IL.opSAVE8C: |
UnOp(reg1); |
OutByte3(0C6H, reg1, Byte(param2)); // mov byte[reg1], param2 |
drop |
|CODE.opSAVE16C: |
|IL.opSAVE16C: |
UnOp(reg1); |
OutByte3(66H, 0C7H, reg1); OutWord(Word(param2)); // mov word[reg1], param2 |
drop |
|CODE.opVLOAD32: |
|IL.opVLOAD32: |
n := param2 * 4; |
reg1 := REG.GetAnyReg(R); |
reg1 := GetAnyReg(); |
OutByte2(8BH, 45H + reg1 * 8 + long(n)); // mov reg1, dword[ebp + n] |
OutIntByte(n); |
OutByte2(8BH, reg1 * 9) // mov reg1, dword[reg1] |
|CODE.opGLOAD32: |
reg1 := REG.GetAnyReg(R); |
|IL.opGLOAD32: |
reg1 := GetAnyReg(); |
IF pic THEN |
Pic(reg1, BIN.PICBSS, param2); |
OutByte2(8BH, reg1 * 9) // mov reg1, dword[reg1] |
822,25 → 804,24 |
Reloc(BIN.RBSS, param2) |
END |
|CODE.opLLOAD32: |
|IL.opLLOAD32: |
n := param2 * 4; |
reg1 := REG.GetAnyReg(R); |
OutByte2(8BH, 45H + reg1 * 8 + long(n)); // mov reg1, dword[ebp + n] |
OutByte2(8BH, 45H + GetAnyReg() * 8 + long(n)); // mov reg1, dword[ebp + n] |
OutIntByte(n) |
|CODE.opLOAD32: |
|IL.opLOAD32: |
UnOp(reg1); |
OutByte2(8BH, reg1 * 9) // mov reg1, dword[reg1] |
|CODE.opVLOAD8: |
|IL.opVLOAD8: |
n := param2 * 4; |
reg1 := REG.GetAnyReg(R); |
reg1 := GetAnyReg(); |
OutByte2(8BH, 45H + reg1 * 8 + long(n)); // mov reg1, dword[ebp + n] |
OutIntByte(n); |
OutByte3(0FH, 0B6H, reg1 * 9) // movzx reg1, byte[reg1] |
|CODE.opGLOAD8: |
reg1 := REG.GetAnyReg(R); |
|IL.opGLOAD8: |
reg1 := GetAnyReg(); |
IF pic THEN |
Pic(reg1, BIN.PICBSS, param2); |
OutByte3(0FH, 0B6H, reg1 * 9) // movzx reg1, byte[reg1] |
849,25 → 830,24 |
Reloc(BIN.RBSS, param2) |
END |
|CODE.opLLOAD8: |
|IL.opLLOAD8: |
n := param2 * 4; |
reg1 := REG.GetAnyReg(R); |
OutByte3(0FH, 0B6H, 45H + reg1 * 8 + long(n)); // movzx reg1, byte[ebp + n] |
OutByte3(0FH, 0B6H, 45H + GetAnyReg() * 8 + long(n)); // movzx reg1, byte[ebp + n] |
OutIntByte(n) |
|CODE.opLOAD8: |
|IL.opLOAD8: |
UnOp(reg1); |
OutByte3(0FH, 0B6H, reg1 * 9) // movzx reg1, byte[reg1] |
|CODE.opVLOAD16: |
|IL.opVLOAD16: |
n := param2 * 4; |
reg1 := REG.GetAnyReg(R); |
reg1 := GetAnyReg(); |
OutByte2(8BH, 45H + reg1 * 8 + long(n)); // mov reg1, dword[ebp + n] |
OutIntByte(n); |
OutByte3(0FH, 0B7H, reg1 * 9) // movzx reg1, word[reg1] |
|CODE.opGLOAD16: |
reg1 := REG.GetAnyReg(R); |
|IL.opGLOAD16: |
reg1 := GetAnyReg(); |
IF pic THEN |
Pic(reg1, BIN.PICBSS, param2); |
OutByte3(0FH, 0B7H, reg1 * 9) // movzx reg1, word[reg1] |
876,26 → 856,25 |
Reloc(BIN.RBSS, param2) |
END |
|CODE.opLLOAD16: |
|IL.opLLOAD16: |
n := param2 * 4; |
reg1 := REG.GetAnyReg(R); |
OutByte3(0FH, 0B7H, 45H + reg1 * 8 + long(n)); // movzx reg1, word[ebp + n] |
OutByte3(0FH, 0B7H, 45H + GetAnyReg() * 8 + long(n)); // movzx reg1, word[ebp + n] |
OutIntByte(n) |
|CODE.opLOAD16: |
|IL.opLOAD16: |
UnOp(reg1); |
OutByte3(0FH, 0B7H, reg1 * 9) // movzx reg1, word[reg1] |
|CODE.opUMINUS: |
|IL.opUMINUS: |
UnOp(reg1); |
neg(reg1) |
|CODE.opADD: |
|IL.opADD: |
BinOp(reg1, reg2); |
add(reg1, reg2); |
drop |
|CODE.opADDL, CODE.opADDR: |
|IL.opADDL, IL.opADDR: |
IF param2 # 0 THEN |
UnOp(reg1); |
IF param2 = 1 THEN |
907,12 → 886,12 |
END |
END |
|CODE.opSUB: |
|IL.opSUB: |
BinOp(reg1, reg2); |
OutByte2(29H, 0C0H + reg2 * 8 + reg1); // sub reg1, reg2 |
drop |
|CODE.opSUBR, CODE.opSUBL: |
|IL.opSUBR, IL.opSUBL: |
UnOp(reg1); |
n := param2; |
IF n = 1 THEN |
922,18 → 901,18 |
ELSIF n # 0 THEN |
subrc(reg1, n) |
END; |
IF cmd.opcode = CODE.opSUBL THEN |
IF opcode = IL.opSUBL THEN |
neg(reg1) |
END |
|CODE.opMULC: |
|IL.opMULC: |
UnOp(reg1); |
a := param2; |
IF a > 1 THEN |
n := log2(a) |
n := UTILS.Log2(a) |
ELSIF a < -1 THEN |
n := log2(-a) |
n := UTILS.Log2(-a) |
ELSE |
n := -1 |
END; |
961,33 → 940,33 |
END |
END |
|CODE.opMUL: |
|IL.opMUL: |
BinOp(reg1, reg2); |
OutByte3(0FH, 0AFH, 0C0H + reg1 * 8 + reg2); // imul reg1, reg2 |
drop |
|CODE.opSAVE, CODE.opSAVE32: |
|IL.opSAVE, IL.opSAVE32: |
BinOp(reg2, reg1); |
OutByte2(89H, reg2 * 8 + reg1); // mov dword[reg1], reg2 |
drop; |
drop |
|CODE.opSAVE8: |
|IL.opSAVE8: |
BinOp(reg2, reg1); |
OutByte2(88H, reg2 * 8 + reg1); // mov byte[reg1], reg2 |
drop; |
drop |
|CODE.opSAVE16: |
|IL.opSAVE16: |
BinOp(reg2, reg1); |
OutByte3(66H, 89H, reg2 * 8 + reg1); // mov word[reg1], reg2 |
drop; |
drop |
|CODE.opSAVEP: |
|IL.opSAVEP: |
UnOp(reg1); |
IF pic THEN |
reg2 := REG.GetAnyReg(R); |
reg2 := GetAnyReg(); |
Pic(reg2, BIN.PICCODE, param2); |
OutByte2(089H, reg2 * 8 + reg1); // mov dword[reg1], reg2 |
drop |
997,10 → 976,10 |
END; |
drop |
|CODE.opSAVEIP: |
|IL.opSAVEIP: |
UnOp(reg1); |
IF pic THEN |
reg2 := REG.GetAnyReg(R); |
reg2 := GetAnyReg(); |
Pic(reg2, BIN.PICIMP, param2); |
OutByte2(0FFH, 30H + reg2); // push dword[reg2] |
OutByte2(08FH, reg1); // pop dword[reg1] |
1012,8 → 991,8 |
END; |
drop |
|CODE.opPUSHP: |
reg1 := REG.GetAnyReg(R); |
|IL.opPUSHP: |
reg1 := GetAnyReg(); |
IF pic THEN |
Pic(reg1, BIN.PICCODE, param2) |
ELSE |
1021,8 → 1000,8 |
Reloc(BIN.RCODE, param2) |
END |
|CODE.opPUSHIP: |
reg1 := REG.GetAnyReg(R); |
|IL.opPUSHIP: |
reg1 := GetAnyReg(); |
IF pic THEN |
Pic(reg1, BIN.PICIMP, param2); |
OutByte2(08BH, reg1 * 9) // mov reg1, dword[reg1] |
1031,91 → 1010,72 |
Reloc(BIN.RIMP, param2) |
END |
|CODE.opNOT: |
|IL.opNOT: |
UnOp(reg1); |
test(reg1); |
setcc(sete, reg1); |
andrc(reg1, 1) |
|CODE.opORD: |
|IL.opORD: |
UnOp(reg1); |
test(reg1); |
setcc(setne, reg1); |
andrc(reg1, 1) |
|CODE.opSBOOL: |
|IL.opSBOOL: |
BinOp(reg2, reg1); |
test(reg2); |
setcc(setne, reg2); |
OutByte2(88H, reg2 * 8 + reg1); // mov byte[reg1], reg2 |
OutByte3(0FH, 95H, reg1); // setne byte[reg1] |
drop; |
drop |
|CODE.opSBOOLC: |
|IL.opSBOOLC: |
UnOp(reg1); |
OutByte3(0C6H, reg1, ORD(param2 # 0)); // mov byte[reg1], 0/1 |
drop |
|CODE.opODD: |
|IL.opODD: |
UnOp(reg1); |
andrc(reg1, 1) |
|CODE.opGTR, CODE.opLTL, CODE.opGER, CODE.opLEL, |
CODE.opLER, CODE.opGEL, CODE.opLTR, CODE.opGTL, |
CODE.opEQR, CODE.opEQL, CODE.opNER, CODE.opNEL: |
|IL.opEQ..IL.opGE, |
IL.opEQC..IL.opGEC: |
IF (IL.opEQ <= opcode) & (opcode <= IL.opGE) THEN |
BinOp(reg1, reg2); |
cmprr(reg1, reg2); |
drop |
ELSE |
UnOp(reg1); |
IF param2 = 0 THEN |
test(reg1) |
ELSE |
cmprc(reg1, param2) |
END |
END; |
drop; |
cc := cond(cmd.opcode); |
IF cmd.next(COMMAND).opcode = CODE.opJE THEN |
label := cmd.next(COMMAND).param1; |
jcc(cc, label); |
cmd := cmd.next(COMMAND) |
ELSIF cmd.next(COMMAND).opcode = CODE.opJNE THEN |
label := cmd.next(COMMAND).param1; |
jcc(inv1(cc), label); |
cmd := cmd.next(COMMAND) |
ELSE |
reg1 := REG.GetAnyReg(R); |
setcc(cc + 16, reg1); |
andrc(reg1, 1) |
END |
|CODE.opGT, CODE.opGE, CODE.opLT, |
CODE.opLE, CODE.opEQ, CODE.opNE: |
BinOp(reg1, reg2); |
cmprr(reg1, reg2); |
drop; |
drop; |
cc := cond(cmd.opcode); |
cc := cond(opcode); |
IF cmd.next(COMMAND).opcode = CODE.opJE THEN |
IF cmd.next(COMMAND).opcode = IL.opJE THEN |
label := cmd.next(COMMAND).param1; |
jcc(cc, label); |
cmd := cmd.next(COMMAND) |
ELSIF cmd.next(COMMAND).opcode = CODE.opJNE THEN |
ELSIF cmd.next(COMMAND).opcode = IL.opJNE THEN |
label := cmd.next(COMMAND).param1; |
jcc(inv1(cc), label); |
jcc(inv0(cc), label); |
cmd := cmd.next(COMMAND) |
ELSE |
reg1 := REG.GetAnyReg(R); |
reg1 := GetAnyReg(); |
setcc(cc + 16, reg1); |
andrc(reg1, 1) |
END |
|CODE.opEQB, CODE.opNEB: |
|IL.opEQB, IL.opNEB: |
BinOp(reg1, reg2); |
drop; |
drop; |
test(reg1); |
OutByte2(74H, 5); // je @f |
1127,8 → 1087,7 |
// @@: |
cmprr(reg1, reg2); |
reg1 := REG.GetAnyReg(R); |
IF cmd.opcode = CODE.opEQB THEN |
IF opcode = IL.opEQB THEN |
setcc(sete, reg1) |
ELSE |
setcc(setne, reg1) |
1135,7 → 1094,7 |
END; |
andrc(reg1, 1) |
|CODE.opACC: |
|IL.opACC: |
IF (R.top # 0) OR (R.stk[0] # eax) THEN |
PushAll(0); |
GetRegA; |
1143,33 → 1102,33 |
DEC(R.pushed) |
END |
|CODE.opDROP: |
|IL.opDROP: |
UnOp(reg1); |
drop |
|CODE.opJNZ: |
|IL.opJNZ: |
UnOp(reg1); |
test(reg1); |
jcc(jne, param1) |
|CODE.opJZ: |
|IL.opJZ: |
UnOp(reg1); |
test(reg1); |
jcc(je, param1) |
|CODE.opJE: |
|IL.opJE: |
UnOp(reg1); |
test(reg1); |
jcc(jne, param1); |
drop; |
drop |
|CODE.opJNE: |
|IL.opJNE: |
UnOp(reg1); |
test(reg1); |
jcc(je, param1); |
drop; |
drop |
|CODE.opSWITCH: |
|IL.opSWITCH: |
UnOp(reg1); |
IF param2 = 0 THEN |
reg2 := eax |
1183,26 → 1142,32 |
END; |
drop |
|CODE.opENDSW: |
|IL.opENDSW: |
|CODE.opCASEL: |
|IL.opCASEL: |
cmprc(eax, param1); |
jcc(jl, param2) |
|CODE.opCASER: |
|IL.opCASER: |
cmprc(eax, param1); |
jcc(jg, param2) |
|CODE.opCASELR: |
|IL.opCASELR: |
cmprc(eax, param1); |
jcc(jl, param2); |
jcc(jg, cmd.param3) |
|CODE.opCODE: |
|IL.opCODE: |
OutByte(param2) |
|CODE.opGET: |
BinOp(reg1, reg2); |
|IL.opGET, IL.opGETC: |
IF opcode = IL.opGET THEN |
BinOp(reg1, reg2) |
ELSIF opcode = IL.opGETC THEN |
UnOp(reg2); |
reg1 := GetAnyReg(); |
movrc(reg1, param1) |
END; |
drop; |
drop; |
1224,11 → 1189,11 |
push(reg2); |
push(reg1); |
pushc(8); |
CallRTL(pic, CODE._move) |
CallRTL(pic, IL._move) |
END |
|CODE.opSAVES: |
|IL.opSAVES: |
UnOp(reg1); |
drop; |
PushAll(0); |
1243,19 → 1208,19 |
END; |
pushc(param1); |
CallRTL(pic, CODE._move) |
CallRTL(pic, IL._move) |
|CODE.opCHKBYTE: |
|IL.opCHKBYTE: |
BinOp(reg1, reg2); |
cmprc(reg1, 256); |
jcc(jb, param1) |
|CODE.opCHKIDX: |
|IL.opCHKIDX: |
UnOp(reg1); |
cmprc(reg1, param2); |
jcc(jb, param1) |
|CODE.opCHKIDX2: |
|IL.opCHKIDX2: |
BinOp(reg1, reg2); |
IF param2 # -1 THEN |
cmprr(reg2, reg1); |
1268,7 → 1233,7 |
R.stk[R.top] := reg2 |
END |
|CODE.opLEN: |
|IL.opLEN: |
n := param2; |
UnOp(reg1); |
drop; |
1283,136 → 1248,94 |
INCL(R.regs, reg1); |
ASSERT(REG.GetReg(R, reg1)) |
|CODE.opINC1: |
|IL.opINCC: |
UnOp(reg1); |
OutByte2(0FFH, reg1); // inc dword[reg1] |
OutByte2(81H + short(param2), reg1); OutIntByte(param2); // add dword[reg1], param2 |
drop |
|CODE.opDEC1: |
UnOp(reg1); |
OutByte2(0FFH, 8 + reg1); // dec dword[reg1] |
drop |
|CODE.opINCC: |
UnOp(reg1); |
n := param2; |
OutByte2(81H + short(n), reg1); OutIntByte(n); // add dword[reg1], n |
drop |
|CODE.opDECC: |
UnOp(reg1); |
n := param2; |
OutByte2(81H + short(n), 28H + reg1); OutIntByte(n); // sub dword[reg1], n |
drop |
|CODE.opINC: |
|IL.opINC, IL.opDEC: |
BinOp(reg1, reg2); |
OutByte2(01H, reg1 * 8 + reg2); // add dword[reg2], reg1 |
OutByte2(01H + 28H * ORD(opcode = IL.opDEC), reg1 * 8 + reg2); // add/sub dword[reg2], reg1 |
drop; |
drop |
|CODE.opDEC: |
BinOp(reg1, reg2); |
OutByte2(29H, reg1 * 8 + reg2); // sub dword[reg2], reg1 |
drop; |
drop |
|CODE.opINC1B: |
|IL.opINCCB, IL.opDECCB: |
UnOp(reg1); |
OutByte2(0FEH, reg1); // inc byte[reg1] |
OutByte3(80H, 28H * ORD(opcode = IL.opDECCB) + reg1, Byte(param2)); // add/sub byte[reg1], n |
drop |
|CODE.opDEC1B: |
UnOp(reg1); |
OutByte2(0FEH, 08H + reg1); // dec byte[reg1] |
drop |
|CODE.opINCCB: |
UnOp(reg1); |
OutByte3(80H, reg1, Byte(param2)); // add byte[reg1], n |
drop |
|CODE.opDECCB: |
UnOp(reg1); |
OutByte3(80H, 28H + reg1, Byte(param2)); // sub byte[reg1], n |
drop |
|CODE.opINCB, CODE.opDECB: |
|IL.opINCB, IL.opDECB: |
BinOp(reg1, reg2); |
IF cmd.opcode = CODE.opINCB THEN |
OutByte2(00H, reg1 * 8 + reg2) // add byte[reg2], reg1 |
ELSE |
OutByte2(28H, reg1 * 8 + reg2) // sub byte[reg2], reg1 |
END; |
OutByte2(28H * ORD(opcode = IL.opDECB), reg1 * 8 + reg2); // add/sub byte[reg2], reg1 |
drop; |
drop |
|CODE.opMULS: |
|IL.opMULS: |
BinOp(reg1, reg2); |
OutByte2(21H, 0C0H + reg2 * 8 + reg1); // and reg1, reg2 |
drop |
|CODE.opMULSC: |
|IL.opMULSC: |
UnOp(reg1); |
andrc(reg1, param2) |
|CODE.opDIVS: |
|IL.opDIVS: |
BinOp(reg1, reg2); |
xor(reg1, reg2); |
drop |
|CODE.opDIVSC: |
|IL.opDIVSC: |
UnOp(reg1); |
OutByte2(81H + short(param2), 0F0H + reg1); // xor reg1, n |
OutIntByte(param2) |
|CODE.opADDS: |
|IL.opADDS: |
BinOp(reg1, reg2); |
OutByte2(9H, 0C0H + reg2 * 8 + reg1); // or reg1, reg2 |
drop |
|CODE.opSUBS: |
|IL.opSUBS: |
BinOp(reg1, reg2); |
not(reg2); |
OutByte2(21H, 0C0H + reg2 * 8 + reg1); // and reg1, reg2 |
drop |
|CODE.opADDSL, CODE.opADDSR: |
|IL.opADDSL, IL.opADDSR: |
UnOp(reg1); |
orrc(reg1, param2) |
|CODE.opSUBSL: |
|IL.opSUBSL: |
UnOp(reg1); |
not(reg1); |
andrc(reg1, param2) |
|CODE.opSUBSR: |
|IL.opSUBSR: |
UnOp(reg1); |
andrc(reg1, ORD(-BITS(param2))); |
andrc(reg1, ORD(-BITS(param2))) |
|CODE.opUMINS: |
|IL.opUMINS: |
UnOp(reg1); |
not(reg1) |
|CODE.opLENGTH: |
|IL.opLENGTH: |
PushAll(2); |
CallRTL(pic, CODE._length); |
CallRTL(pic, IL._length); |
GetRegA |
|CODE.opLENGTHW: |
|IL.opLENGTHW: |
PushAll(2); |
CallRTL(pic, CODE._lengthw); |
CallRTL(pic, IL._lengthw); |
GetRegA |
|CODE.opCHR: |
|IL.opCHR: |
UnOp(reg1); |
andrc(reg1, 255) |
|CODE.opWCHR: |
|IL.opWCHR: |
UnOp(reg1); |
andrc(reg1, 65535) |
|CODE.opASR, CODE.opROR, CODE.opLSL, CODE.opLSR: |
|IL.opASR, IL.opROR, IL.opLSL, IL.opLSR: |
UnOp(reg1); |
IF reg1 # ecx THEN |
ASSERT(REG.GetReg(R, ecx)); |
1423,10 → 1346,10 |
BinOp(reg1, reg2); |
ASSERT(reg2 = ecx); |
OutByte(0D3H); |
shift(cmd.opcode, reg1); // shift reg1, cl |
shift(opcode, reg1); // shift reg1, cl |
drop |
|CODE.opASR1, CODE.opROR1, CODE.opLSL1, CODE.opLSR1: |
|IL.opASR1, IL.opROR1, IL.opLSL1, IL.opLSR1: |
UnOp(reg1); |
IF reg1 # ecx THEN |
ASSERT(REG.GetReg(R, ecx)); |
1434,30 → 1357,30 |
drop |
END; |
reg1 := REG.GetAnyReg(R); |
reg1 := GetAnyReg(); |
movrc(reg1, param2); |
BinOp(reg1, reg2); |
ASSERT(reg1 = ecx); |
OutByte(0D3H); |
shift(cmd.opcode, reg2); // shift reg2, cl |
shift(opcode, reg2); // shift reg2, cl |
drop; |
drop; |
ASSERT(REG.GetReg(R, reg2)) |
|CODE.opASR2, CODE.opROR2, CODE.opLSL2, CODE.opLSR2: |
|IL.opASR2, IL.opROR2, IL.opLSL2, IL.opLSR2: |
UnOp(reg1); |
n := ORD(BITS(param2) * {0..4}); |
n := param2 MOD 32; |
IF n # 1 THEN |
OutByte(0C1H) |
ELSE |
OutByte(0D1H) |
END; |
shift(cmd.opcode, reg1); // shift reg1, n |
shift(opcode, reg1); // shift reg1, n |
IF n # 1 THEN |
OutByte(n) |
END |
|CODE.opMIN: |
|IL.opMIN: |
BinOp(reg1, reg2); |
cmprr(reg1, reg2); |
OutByte2(07EH, 002H); // jle @f |
1465,7 → 1388,7 |
// @@: |
drop |
|CODE.opMAX: |
|IL.opMAX: |
BinOp(reg1, reg2); |
cmprr(reg1, reg2); |
OutByte2(07DH, 002H); // jge @f |
1473,21 → 1396,21 |
// @@: |
drop |
|CODE.opMINC: |
|IL.opMINC: |
UnOp(reg1); |
cmprc(reg1, param2); |
OutByte2(07EH, 005H); // jle @f |
movrc(reg1, param2); // mov reg1, param2 |
movrc(reg1, param2) // mov reg1, param2 |
// @@: |
|CODE.opMAXC: |
|IL.opMAXC: |
UnOp(reg1); |
cmprc(reg1, param2); |
OutByte2(07DH, 005H); // jge @f |
movrc(reg1, param2); // mov reg1, param2 |
movrc(reg1, param2) // mov reg1, param2 |
// @@: |
|CODE.opIN: |
|IL.opIN: |
label := NewLabel(); |
BinOp(reg1, reg2); |
cmprc(reg1, 32); |
1501,10 → 1424,10 |
SetLabel(label); |
drop |
|CODE.opINR: |
|IL.opINR: |
label := NewLabel(); |
UnOp(reg1); |
reg2 := REG.GetAnyReg(R); |
reg2 := GetAnyReg(); |
cmprc(reg1, 32); |
OutByte2(72H, 4); // jb L |
xor(reg1, reg1); |
1517,42 → 1440,42 |
SetLabel(label); |
drop |
|CODE.opINL: |
|IL.opINL: |
UnOp(reg1); |
OutByte3(0FH, 0BAH, 0E0H + reg1); OutByte(param2); // bt reg1, param2 |
setcc(setc, reg1); |
andrc(reg1, 1) |
|CODE.opRSET: |
|IL.opRSET: |
PushAll(2); |
CallRTL(pic, CODE._set); |
CallRTL(pic, IL._set); |
GetRegA |
|CODE.opRSETR: |
|IL.opRSETR: |
PushAll(1); |
pushc(param2); |
CallRTL(pic, CODE._set); |
CallRTL(pic, IL._set); |
GetRegA |
|CODE.opRSETL: |
|IL.opRSETL: |
PushAll(1); |
pushc(param2); |
CallRTL(pic, CODE._set2); |
CallRTL(pic, IL._set2); |
GetRegA |
|CODE.opRSET1: |
|IL.opRSET1: |
UnOp(reg1); |
PushAll(1); |
push(reg1); |
CallRTL(pic, CODE._set); |
CallRTL(pic, IL._set); |
GetRegA |
|CODE.opINCL, CODE.opEXCL: |
|IL.opINCL, IL.opEXCL: |
BinOp(reg1, reg2); |
cmprc(reg1, 32); |
OutByte2(73H, 03H); // jnb L |
OutByte(0FH); |
IF cmd.opcode = CODE.opINCL THEN |
IF opcode = IL.opINCL THEN |
OutByte(0ABH) // bts dword[reg2], reg1 |
ELSE |
OutByte(0B3H) // btr dword[reg2], reg1 |
1562,27 → 1485,27 |
drop; |
drop |
|CODE.opINCLC: |
|IL.opINCLC: |
UnOp(reg1); |
OutByte3(0FH, 0BAH, 28H + reg1); OutByte(param2); //bts dword[reg1],param2 |
drop |
|CODE.opEXCLC: |
|IL.opEXCLC: |
UnOp(reg1); |
OutByte3(0FH, 0BAH, 30H + reg1); OutByte(param2); //btr dword[reg1],param2 |
drop |
|CODE.opDIV: |
|IL.opDIV: |
PushAll(2); |
CallRTL(pic, CODE._div); |
CallRTL(pic, IL._div); |
GetRegA |
|CODE.opDIVR: |
|IL.opDIVR: |
a := param2; |
IF a > 1 THEN |
n := log2(a) |
n := UTILS.Log2(a) |
ELSIF a < -1 THEN |
n := log2(-a) |
n := UTILS.Log2(-a) |
ELSE |
n := -1 |
END; |
1597,7 → 1520,7 |
UnOp(reg1); |
IF a < 0 THEN |
reg2 := REG.GetAnyReg(R); |
reg2 := GetAnyReg(); |
mov(reg2, reg1); |
IF n # 1 THEN |
OutByte3(0C1H, 0F8H + reg1, n) // sar reg1, n |
1617,28 → 1540,28 |
ELSE |
PushAll(1); |
pushc(param2); |
CallRTL(pic, CODE._div); |
CallRTL(pic, IL._div); |
GetRegA |
END |
END |
|CODE.opDIVL: |
|IL.opDIVL: |
PushAll(1); |
pushc(param2); |
CallRTL(pic, CODE._div2); |
CallRTL(pic, IL._div2); |
GetRegA |
|CODE.opMOD: |
|IL.opMOD: |
PushAll(2); |
CallRTL(pic, CODE._mod); |
CallRTL(pic, IL._mod); |
GetRegA |
|CODE.opMODR: |
|IL.opMODR: |
a := param2; |
IF a > 1 THEN |
n := log2(a) |
n := UTILS.Log2(a) |
ELSIF a < -1 THEN |
n := log2(-a) |
n := UTILS.Log2(-a) |
ELSE |
n := -1 |
END; |
1666,100 → 1589,83 |
ELSE |
PushAll(1); |
pushc(param2); |
CallRTL(pic, CODE._mod); |
CallRTL(pic, IL._mod); |
GetRegA |
END |
END |
|CODE.opMODL: |
|IL.opMODL: |
PushAll(1); |
pushc(param2); |
CallRTL(pic, CODE._mod2); |
CallRTL(pic, IL._mod2); |
GetRegA |
|CODE.opERR: |
CallRTL(pic, CODE._error) |
|IL.opERR: |
CallRTL(pic, IL._error) |
|CODE.opABS: |
|IL.opABS: |
UnOp(reg1); |
test(reg1); |
OutByte2(07DH, 002H); // jge @f |
neg(reg1); // neg reg1 |
neg(reg1) // neg reg1 |
// @@: |
|CODE.opCOPY: |
|IL.opCOPY: |
PushAll(2); |
pushc(param2); |
CallRTL(pic, CODE._move2) |
CallRTL(pic, IL._move2) |
|CODE.opMOVE: |
|IL.opMOVE: |
PushAll(3); |
CallRTL(pic, CODE._move2) |
CallRTL(pic, IL._move2) |
|CODE.opCOPYA: |
|IL.opCOPYA: |
PushAll(4); |
pushc(param2); |
CallRTL(pic, CODE._arrcpy); |
CallRTL(pic, IL._arrcpy); |
GetRegA |
|CODE.opCOPYS: |
|IL.opCOPYS: |
PushAll(4); |
pushc(param2); |
CallRTL(pic, CODE._strcpy) |
CallRTL(pic, IL._strcpy) |
|CODE.opCOPYS2: |
PushAll(4); |
pushc(param2); |
CallRTL(pic, CODE._strcpy2) |
|CODE.opROT: |
|IL.opROT: |
PushAll(0); |
push(esp); |
pushc(param2); |
CallRTL(pic, CODE._rot) |
CallRTL(pic, IL._rot) |
|CODE.opNEW: |
|IL.opNEW: |
PushAll(1); |
n := param2 + 8; |
ASSERT(MACHINE.Align(n, 32)); |
ASSERT(UTILS.Align(n, 32)); |
pushc(n); |
pushc(param1); |
CallRTL(pic, CODE._new) |
CallRTL(pic, IL._new) |
|CODE.opDISP: |
|IL.opDISP: |
PushAll(1); |
CallRTL(pic, CODE._dispose) |
CallRTL(pic, IL._dispose) |
|CODE.opEQS .. CODE.opGES: |
|IL.opEQS .. IL.opGES: |
PushAll(4); |
pushc(cmd.opcode - CODE.opEQS); |
CallRTL(pic, CODE._strcmp); |
pushc(opcode - IL.opEQS); |
CallRTL(pic, IL._strcmp); |
GetRegA |
|CODE.opEQS2 .. CODE.opGES2: |
|IL.opEQSW .. IL.opGESW: |
PushAll(4); |
pushc(cmd.opcode - CODE.opEQS2); |
CallRTL(pic, CODE._strcmp2); |
pushc(opcode - IL.opEQSW); |
CallRTL(pic, IL._strcmpw); |
GetRegA |
|CODE.opEQSW .. CODE.opGESW: |
PushAll(4); |
pushc(cmd.opcode - CODE.opEQSW); |
CallRTL(pic, CODE._strcmpw); |
GetRegA |
|CODE.opEQSW2 .. CODE.opGESW2: |
PushAll(4); |
pushc(cmd.opcode - CODE.opEQSW2); |
CallRTL(pic, CODE._strcmpw2); |
GetRegA |
|CODE.opEQP, CODE.opNEP, CODE.opEQIP, CODE.opNEIP: |
|IL.opEQP, IL.opNEP, IL.opEQIP, IL.opNEIP: |
UnOp(reg1); |
CASE cmd.opcode OF |
|CODE.opEQP, CODE.opNEP: |
CASE opcode OF |
|IL.opEQP, IL.opNEP: |
IF pic THEN |
reg2 := REG.GetAnyReg(R); |
reg2 := GetAnyReg(); |
Pic(reg2, BIN.PICCODE, param1); |
cmprr(reg1, reg2); |
drop |
1768,9 → 1674,9 |
Reloc(BIN.RCODE, param1) |
END |
|CODE.opEQIP, CODE.opNEIP: |
|IL.opEQIP, IL.opNEIP: |
IF pic THEN |
reg2 := REG.GetAnyReg(R); |
reg2 := GetAnyReg(); |
Pic(reg2, BIN.PICIMP, param1); |
OutByte2(03BH, reg1 * 8 + reg2); //cmp reg1, dword [reg2] |
drop |
1781,64 → 1687,64 |
END; |
drop; |
reg1 := REG.GetAnyReg(R); |
reg1 := GetAnyReg(); |
CASE cmd.opcode OF |
|CODE.opEQP, CODE.opEQIP: setcc(sete, reg1) |
|CODE.opNEP, CODE.opNEIP: setcc(setne, reg1) |
CASE opcode OF |
|IL.opEQP, IL.opEQIP: setcc(sete, reg1) |
|IL.opNEP, IL.opNEIP: setcc(setne, reg1) |
END; |
andrc(reg1, 1) |
|CODE.opPUSHT: |
|IL.opPUSHT: |
UnOp(reg1); |
reg2 := REG.GetAnyReg(R); |
reg2 := GetAnyReg(); |
OutByte3(8BH, 40H + reg2 * 8 + reg1, 0FCH) // mov reg2, dword[reg1 - 4] |
|CODE.opISREC: |
|IL.opISREC: |
PushAll(2); |
pushc(param2); |
CallRTL(pic, CODE._isrec); |
pushc(param2 * tcount); |
CallRTL(pic, IL._isrec); |
GetRegA |
|CODE.opIS: |
|IL.opIS: |
PushAll(1); |
pushc(param2); |
CallRTL(pic, CODE._is); |
pushc(param2 * tcount); |
CallRTL(pic, IL._is); |
GetRegA |
|CODE.opTYPEGR: |
|IL.opTYPEGR: |
PushAll(1); |
pushc(param2); |
CallRTL(pic, CODE._guardrec); |
pushc(param2 * tcount); |
CallRTL(pic, IL._guardrec); |
GetRegA |
|CODE.opTYPEGP: |
|IL.opTYPEGP: |
UnOp(reg1); |
PushAll(0); |
push(reg1); |
pushc(param2); |
CallRTL(pic, CODE._guard); |
pushc(param2 * tcount); |
CallRTL(pic, IL._guard); |
GetRegA |
|CODE.opTYPEGD: |
|IL.opTYPEGD: |
UnOp(reg1); |
PushAll(0); |
OutByte3(0FFH, 070H + reg1, 0FCH); // push dword[reg1 - 4] |
pushc(param2); |
CallRTL(pic, CODE._guardrec); |
pushc(param2 * tcount); |
CallRTL(pic, IL._guardrec); |
GetRegA |
|CODE.opCASET: |
|IL.opCASET: |
push(ecx); |
push(ecx); |
pushc(param2); |
CallRTL(pic, CODE._guardrec); |
pushc(param2 * tcount); |
CallRTL(pic, IL._guardrec); |
pop(ecx); |
test(eax); |
jcc(jne, param1) |
|CODE.opPACK: |
|IL.opPACK: |
BinOp(reg1, reg2); |
push(reg2); |
OutByte3(0DBH, 004H, 024H); // fild dword[esp] |
1850,7 → 1756,7 |
drop; |
drop |
|CODE.opPACKC: |
|IL.opPACKC: |
UnOp(reg1); |
pushc(param2); |
OutByte3(0DBH, 004H, 024H); // fild dword[esp] |
1861,7 → 1767,7 |
pop(reg1); |
drop |
|CODE.opUNPK: |
|IL.opUNPK: |
BinOp(reg1, reg2); |
OutByte2(0DDH, reg1); // fld qword[reg1] |
OutByte2(0D9H, 0F4H); // fxtract |
1870,16 → 1776,16 |
drop; |
drop |
|CODE.opPUSHF: |
|IL.opPUSHF: |
subrc(esp, 8); |
OutByte3(0DDH, 01CH, 024H) // fstp qword[esp] |
|CODE.opLOADF: |
|IL.opLOADF: |
UnOp(reg1); |
OutByte2(0DDH, reg1); // fld qword[reg1] |
drop |
|CODE.opCONSTF: |
|IL.opCONSTF: |
float := cmd.float; |
IF float = 0.0 THEN |
OutByte2(0D9H, 0EEH) // fldz |
1896,36 → 1802,36 |
addrc(esp, 8) |
END |
|CODE.opSAVEF: |
|IL.opSAVEF: |
UnOp(reg1); |
OutByte2(0DDH, 018H + reg1); // fstp qword[reg1] |
drop |
|CODE.opADDF, CODE.opADDFI: |
|IL.opADDF, IL.opADDFI: |
OutByte2(0DEH, 0C1H) // faddp st1, st |
|CODE.opSUBF: |
|IL.opSUBF: |
OutByte2(0DEH, 0E9H) // fsubp st1, st |
|CODE.opSUBFI: |
|IL.opSUBFI: |
OutByte2(0DEH, 0E1H) // fsubrp st1, st |
|CODE.opMULF: |
|IL.opMULF: |
OutByte2(0DEH, 0C9H) // fmulp st1, st |
|CODE.opDIVF: |
|IL.opDIVF: |
OutByte2(0DEH, 0F9H) // fdivp st1, st |
|CODE.opDIVFI: |
|IL.opDIVFI: |
OutByte2(0DEH, 0F1H) // fdivrp st1, st |
|CODE.opUMINF: |
|IL.opUMINF: |
OutByte2(0D9H, 0E0H) // fchs |
|CODE.opFABS: |
|IL.opFABS: |
OutByte2(0D9H, 0E1H) // fabs |
|CODE.opFLT: |
|IL.opFLT: |
UnOp(reg1); |
push(reg1); |
OutByte3(0DBH, 004H, 024H); // fild dword[esp] |
1932,8 → 1838,7 |
pop(reg1); |
drop |
|CODE.opFLOOR: |
reg1 := REG.GetAnyReg(R); |
|IL.opFLOOR: |
subrc(esp, 8); |
OutByte2(09BH, 0D9H); OutByte3(07CH, 024H, 004H); // fstcw word[esp+4] |
OutByte2(09BH, 0D9H); OutByte3(07CH, 024H, 006H); // fstcw word[esp+6] |
1942,11 → 1847,11 |
OutByte2(0D9H, 06CH); OutByte2(024H, 004H); // fldcw word[esp+4] |
OutByte2(0D9H, 0FCH); // frndint |
OutByte3(0DBH, 01CH, 024H); // fistp dword[esp] |
pop(reg1); |
pop(GetAnyReg()); |
OutByte2(0D9H, 06CH); OutByte2(024H, 002H); // fldcw word[esp+2] |
addrc(esp, 4) |
|CODE.opEQF, CODE.opEQFI: |
|IL.opEQF: |
GetRegA; |
OutByte2(0DAH, 0E9H); // fucompp |
OutByte3(09BH, 0DFH, 0E0H); // fstsw ax |
1956,7 → 1861,7 |
setcc(sete, al) |
// L: |
|CODE.opNEF, CODE.opNEFI: |
|IL.opNEF: |
GetRegA; |
OutByte2(0DAH, 0E9H); // fucompp |
OutByte3(09BH, 0DFH, 0E0H); // fstsw ax |
1966,7 → 1871,7 |
setcc(setne, al) |
// L: |
|CODE.opLTF, CODE.opGTFI: |
|IL.opLTF: |
GetRegA; |
OutByte2(0DAH, 0E9H); // fucompp |
OutByte3(09BH, 0DFH, 0E0H); // fstsw ax |
1980,7 → 1885,7 |
andrc(eax, 1) |
// L: |
|CODE.opGTF, CODE.opLTFI: |
|IL.opGTF: |
GetRegA; |
OutByte2(0DAH, 0E9H); // fucompp |
OutByte3(09BH, 0DFH, 0E0H); // fstsw ax |
1994,7 → 1899,7 |
andrc(eax, 1) |
// L: |
|CODE.opLEF, CODE.opGEFI: |
|IL.opLEF: |
GetRegA; |
OutByte2(0DAH, 0E9H); // fucompp |
OutByte3(09BH, 0DFH, 0E0H); // fstsw ax |
2004,7 → 1909,7 |
setcc(setnc, al) |
// L: |
|CODE.opGEF, CODE.opLEFI: |
|IL.opGEF: |
GetRegA; |
OutByte2(0DAH, 0E9H); // fucompp |
OutByte3(09BH, 0DFH, 0E0H); // fstsw ax |
2019,15 → 1924,15 |
andrc(eax, 1) |
// L: |
|CODE.opINF: |
|IL.opINF: |
pushc(7FF00000H); |
pushc(0); |
OutByte3(0DDH, 004H, 024H); // fld qword[esp] |
addrc(esp, 8) |
|CODE.opLADR_UNPK: |
|IL.opLADR_UNPK: |
n := param2 * 4; |
reg1 := REG.GetAnyReg(R); |
reg1 := GetAnyReg(); |
OutByte2(8DH, 45H + reg1 * 8 + long(n)); // lea reg1, dword[ebp + n] |
OutIntByte(n); |
BinOp(reg1, reg2); |
2038,9 → 1943,9 |
drop; |
drop |
|CODE.opSADR_PARAM: |
|IL.opSADR_PARAM: |
IF pic THEN |
reg1 := REG.GetAnyReg(R); |
reg1 := GetAnyReg(); |
Pic(reg1, BIN.PICDATA, stroffs + param2); |
push(reg1); |
drop |
2049,17 → 1954,17 |
Reloc(BIN.RDATA, stroffs + param2) |
END |
|CODE.opVADR_PARAM: |
|IL.opVADR_PARAM: |
n := param2 * 4; |
OutByte2(0FFH, 75H + long(n)); // push dword[ebp + n] |
OutIntByte(n) |
|CODE.opCONST_PARAM: |
|IL.opCONST_PARAM: |
pushc(param2) |
|CODE.opGLOAD32_PARAM: |
|IL.opGLOAD32_PARAM: |
IF pic THEN |
reg1 := REG.GetAnyReg(R); |
reg1 := GetAnyReg(); |
Pic(reg1, BIN.PICBSS, param2); |
OutByte2(0FFH, 30H + reg1); // push dword[reg1] |
drop |
2068,36 → 1973,36 |
Reloc(BIN.RBSS, param2) |
END |
|CODE.opLLOAD32_PARAM: |
|IL.opLLOAD32_PARAM: |
n := param2 * 4; |
OutByte2(0FFH, 75H + long(n)); // push dword[ebp + n] |
OutIntByte(n) |
|CODE.opLOAD32_PARAM: |
|IL.opLOAD32_PARAM: |
UnOp(reg1); |
OutByte2(0FFH, 30H + reg1); // push dword[reg1] |
drop |
|CODE.opGADR_SAVEC: |
|IL.opGADR_SAVEC: |
IF pic THEN |
reg1 := REG.GetAnyReg(R); |
reg1 := GetAnyReg(); |
Pic(reg1, BIN.PICBSS, param1); |
OutByte2(0C7H, reg1); // mov dword[reg1], param2 |
OutInt(param2); |
drop |
ELSE |
OutByte2(0C7H, 05H); // mov dword[_bss + param2], param2 |
OutByte2(0C7H, 05H); // mov dword[_bss + param1], param2 |
Reloc(BIN.RBSS, param1); |
OutInt(param2) |
END |
|CODE.opLADR_SAVEC: |
|IL.opLADR_SAVEC: |
n := param1 * 4; |
OutByte2(0C7H, 45H + long(n)); // mov dword[ebp + n], param2 |
OutIntByte(n); |
OutInt(param2) |
|CODE.opLADR_SAVE: |
|IL.opLADR_SAVE: |
n := param2 * 4; |
UnOp(reg1); |
OutByte2(89H, 45H + reg1 * 8 + long(n)); // mov dword[ebp + n], reg1 |
2104,96 → 2009,60 |
OutIntByte(n); |
drop |
|CODE.opLADR_INC1: |
n := param2 * 4; |
OutByte2(0FFH, 45H + long(n)); // inc dword[ebp + n] |
|IL.opLADR_INCC: |
n := param1 * 4; |
IF ABS(param2) = 1 THEN |
OutByte2(0FFH, 45H + 8 * ORD(param2 = -1) + long(n)); // inc/dec dword[ebp + n] |
OutIntByte(n) |
|CODE.opLADR_DEC1: |
n := param2 * 4; |
OutByte2(0FFH, 4DH + long(n)); // dec dword[ebp + n] |
OutIntByte(n) |
|CODE.opLADR_INCC: |
n := param1 * 4; |
ELSE |
OutByte2(81H + short(param2), 45H + long(n)); // add dword[ebp + n], param2 |
OutIntByte(n); |
OutIntByte(param2) |
END |
|CODE.opLADR_DECC: |
|IL.opLADR_INCCB, IL.opLADR_DECCB: |
n := param1 * 4; |
OutByte2(81H + short(param2), 6DH + long(n)); // sub dword[ebp + n], param2 |
OutIntByte(n); |
OutIntByte(param2) |
|CODE.opLADR_INC1B: |
n := param2 * 4; |
OutByte2(0FEH, 45H + long(n)); // inc byte[ebp + n] |
IF param2 = 1 THEN |
OutByte2(0FEH, 45H + 8 * ORD(opcode = IL.opLADR_DECCB) + long(n)); // inc/dec byte[ebp + n] |
OutIntByte(n) |
|CODE.opLADR_DEC1B: |
n := param2 * 4; |
OutByte2(0FEH, 4DH + long(n)); // dec byte[ebp + n] |
OutIntByte(n) |
|CODE.opLADR_INCCB: |
n := param1 * 4; |
OutByte2(80H, 45H + long(n)); // add byte[ebp + n], param2 |
ELSE |
OutByte2(80H, 45H + 28H * ORD(opcode = IL.opLADR_DECCB) + long(n)); // add/sub byte[ebp + n], param2 |
OutIntByte(n); |
OutByte(param2 MOD 256) |
END |
|CODE.opLADR_DECCB: |
n := param1 * 4; |
OutByte2(80H, 6DH + long(n)); // sub byte[ebp + n], param2 |
OutIntByte(n); |
OutByte(param2 MOD 256) |
|CODE.opLADR_INC: |
|IL.opLADR_INC, IL.opLADR_DEC: |
n := param2 * 4; |
UnOp(reg1); |
OutByte2(01H, 45H + long(n) + reg1 * 8); // add dword[ebp + n], reg1 |
OutByte2(01H + 28H * ORD(opcode = IL.opLADR_DEC), 45H + long(n) + reg1 * 8); // add/sub dword[ebp + n], reg1 |
OutIntByte(n); |
drop |
|CODE.opLADR_DEC: |
|IL.opLADR_INCB, IL.opLADR_DECB: |
n := param2 * 4; |
UnOp(reg1); |
OutByte2(29H, 45H + long(n) + reg1 * 8); // sub dword[ebp + n], reg1 |
OutByte2(28H * ORD(opcode = IL.opLADR_DECB), 45H + long(n) + reg1 * 8); // add/sub byte[ebp + n], reg1 |
OutIntByte(n); |
drop |
|CODE.opLADR_INCB: |
|IL.opLADR_INCL, IL.opLADR_EXCL: |
n := param2 * 4; |
UnOp(reg1); |
OutByte2(00H, 45H + long(n) + reg1 * 8); // add byte[ebp + n], reg1 |
OutIntByte(n); |
drop |
|CODE.opLADR_DECB: |
n := param2 * 4; |
UnOp(reg1); |
OutByte2(28H, 45H + long(n) + reg1 * 8); // sub byte[ebp + n], reg1 |
OutIntByte(n); |
drop |
|CODE.opLADR_INCL, CODE.opLADR_EXCL: |
n := param2 * 4; |
UnOp(reg1); |
cmprc(reg1, 32); |
label := NewLabel(); |
jcc(jnb, label); |
OutByte3(0FH, 0ABH + 8 * ORD(cmd.opcode = CODE.opLADR_EXCL), 45H + long(n) + reg1 * 8); // bts(r) dword[ebp + n], reg1 |
OutByte3(0FH, 0ABH + 8 * ORD(opcode = IL.opLADR_EXCL), 45H + long(n) + reg1 * 8); // bts(r) dword[ebp + n], reg1 |
OutIntByte(n); |
SetLabel(label); |
drop |
|CODE.opLADR_INCLC, CODE.opLADR_EXCLC: |
|IL.opLADR_INCLC, IL.opLADR_EXCLC: |
n := param1 * 4; |
OutByte3(0FH, 0BAH, 6DH + long(n) + 8 * ORD(cmd.opcode = CODE.opLADR_EXCLC)); // bts(r) dword[ebp + n], param2 |
OutByte3(0FH, 0BAH, 6DH + long(n) + 8 * ORD(opcode = IL.opLADR_EXCLC)); // bts(r) dword[ebp + n], param2 |
OutIntByte(n); |
OutByte(param2) |
|CODE.opLOOP, CODE.opENDLOOP: |
|IL.opLOOP, IL.opENDLOOP: |
END; |
2206,9 → 2075,9 |
END translate; |
PROCEDURE prolog (code: CODE.CODES; pic: BOOLEAN; target, stack, dllinit, dllret: INTEGER); |
PROCEDURE prolog (code: IL.CODES; pic: BOOLEAN; target, stack, dllinit, dllret: INTEGER); |
VAR |
reg1, entry, tcount, dcount: INTEGER; |
reg1, entry, dcount: INTEGER; |
BEGIN |
2221,7 → 2090,7 |
OutByte3(0FFH, 75H, 16); // push dword[ebp+16] |
OutByte3(0FFH, 75H, 12); // push dword[ebp+12] |
OutByte3(0FFH, 75H, 8); // push dword[ebp+8] |
CallRTL(pic, CODE._dllentry); |
CallRTL(pic, IL._dllentry); |
test(eax); |
jcc(je, dllret) |
ELSIF target = mConst.Target_iObject THEN |
2229,7 → 2098,7 |
END; |
IF target = mConst.Target_iKolibri THEN |
reg1 := REG.GetAnyReg(R); |
reg1 := GetAnyReg(); |
Pic(reg1, BIN.IMPTAB, 0); |
push(reg1); // push IMPORT |
drop |
2243,7 → 2112,7 |
END; |
IF pic THEN |
reg1 := REG.GetAnyReg(R); |
reg1 := GetAnyReg(); |
Pic(reg1, BIN.PICCODE, entry); |
push(reg1); // push CODE |
drop |
2253,7 → 2122,7 |
END; |
IF pic THEN |
reg1 := REG.GetAnyReg(R); |
reg1 := GetAnyReg(); |
Pic(reg1, BIN.PICDATA, 0); |
push(reg1); // push _data |
drop |
2262,13 → 2131,12 |
Reloc(BIN.RDATA, 0) |
END; |
tcount := CHL.Length(code.types); |
dcount := CHL.Length(code.data); |
pushc(tcount); |
IF pic THEN |
reg1 := REG.GetAnyReg(R); |
reg1 := GetAnyReg(); |
Pic(reg1, BIN.PICDATA, tcount * 4 + dcount); |
push(reg1); // push _data + tcount * 4 + dcount |
drop |
2277,35 → 2145,34 |
Reloc(BIN.RDATA, tcount * 4 + dcount) |
END; |
CallRTL(pic, CODE._init) |
CallRTL(pic, IL._init) |
END prolog; |
PROCEDURE epilog (code: CODE.CODES; pic: BOOLEAN; modname: ARRAY OF CHAR; target, stack, ver, dllinit, dllret: INTEGER); |
PROCEDURE epilog (code: IL.CODES; pic: BOOLEAN; modname: ARRAY OF CHAR; target, stack, ver, dllinit, dllret, sofinit: INTEGER); |
VAR |
i, n: INTEGER; |
exp: CODE.EXPORT_PROC; |
exp: IL.EXPORT_PROC; |
path, name, ext: PATHS.PATH; |
tcount, dcount: INTEGER; |
dcount, i: INTEGER; |
PROCEDURE import (imp: LISTS.LIST); |
VAR |
lib: CODE.IMPORT_LIB; |
proc: CODE.IMPORT_PROC; |
lib: IL.IMPORT_LIB; |
proc: IL.IMPORT_PROC; |
BEGIN |
lib := imp.first(CODE.IMPORT_LIB); |
lib := imp.first(IL.IMPORT_LIB); |
WHILE lib # NIL DO |
BIN.Import(program, lib.name, 0); |
proc := lib.procs.first(CODE.IMPORT_PROC); |
proc := lib.procs.first(IL.IMPORT_PROC); |
WHILE proc # NIL DO |
BIN.Import(program, proc.name, proc.label); |
proc := proc.next(CODE.IMPORT_PROC) |
proc := proc.next(IL.IMPORT_PROC) |
END; |
lib := lib.next(CODE.IMPORT_LIB) |
lib := lib.next(IL.IMPORT_LIB) |
END |
END import; |
2315,7 → 2182,7 |
IF target IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iKolibri, mConst.Target_iELF32} THEN |
pushc(0); |
CallRTL(pic, CODE._exit); |
CallRTL(pic, IL._exit); |
ELSIF target = mConst.Target_iDLL THEN |
SetLabel(dllret); |
movrc(eax, 1); |
2324,11 → 2191,15 |
ELSIF target = mConst.Target_iObject THEN |
movrc(eax, 1); |
OutByte(0C3H) // ret |
ELSIF target = mConst.Target_iELFSO32 THEN |
OutByte(0C3H); // ret |
SetLabel(sofinit); |
CallRTL(pic, IL._sofinit); |
OutByte(0C3H) // ret |
END; |
fixup; |
tcount := CHL.Length(code.types); |
dcount := CHL.Length(code.data); |
FOR i := 0 TO tcount - 1 DO |
2350,30 → 2221,30 |
BIN.Export(program, "lib_init", dllinit); |
END; |
exp := code.export.first(CODE.EXPORT_PROC); |
exp := code.export.first(IL.EXPORT_PROC); |
WHILE exp # NIL DO |
BIN.Export(program, exp.name, exp.label); |
exp := exp.next(CODE.EXPORT_PROC) |
exp := exp.next(IL.EXPORT_PROC) |
END; |
import(code.import); |
n := code.dmin - CHL.Length(code.data); |
IF n > 0 THEN |
INC(code.bss, n) |
END; |
code.bss := MAX(code.bss, MAX(code.dmin - CHL.Length(code.data), 4)); |
BIN.SetParams(program, MAX(code.bss, 4), stack * (1024 * 1024), WCHR(ver DIV 65536), WCHR(ver MOD 65536)); |
BIN.SetParams(program, code.bss, stack * (1024 * 1024), WCHR(ver DIV 65536), WCHR(ver MOD 65536)); |
END epilog; |
PROCEDURE CodeGen* (code: CODE.CODES; outname: ARRAY OF CHAR; target, stack, base, ver: INTEGER; pic: BOOLEAN); |
PROCEDURE CodeGen* (code: IL.CODES; outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS); |
VAR |
dllret, dllinit: INTEGER; |
dllret, dllinit, sofinit: INTEGER; |
opt: PROG.OPTIONS; |
BEGIN |
tcount := CHL.Length(code.types); |
opt := options; |
CodeList := LISTS.create(NIL); |
program := BIN.create(code.lcount); |
2380,31 → 2251,32 |
dllinit := NewLabel(); |
dllret := NewLabel(); |
sofinit := NewLabel(); |
IF target = mConst.Target_iObject THEN |
pic := FALSE |
opt.pic := FALSE |
END; |
IF target IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL, mConst.Target_iELF32} THEN |
pic := TRUE |
IF target IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL, mConst.Target_iELF32, mConst.Target_iELFSO32} THEN |
opt.pic := TRUE |
END; |
R := REG.Create(push, pop, mov, xchg, NIL, NIL, {eax, ecx, edx}, {}); |
REG.Init(R, push, pop, mov, xchg, NIL, NIL, {eax, ecx, edx}, {}); |
prolog(code, pic, target, stack, dllinit, dllret); |
translate(code, pic, CHL.Length(code.types) * 4); |
epilog(code, pic, outname, target, stack, ver, dllinit, dllret); |
prolog(code, opt.pic, target, opt.stack, dllinit, dllret); |
translate(code, opt.pic, tcount * 4); |
epilog(code, opt.pic, outname, target, opt.stack, opt.version, dllinit, dllret, sofinit); |
BIN.fixup(program); |
IF target IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL} THEN |
PE32.write(program, outname, base, target = mConst.Target_iConsole, target = mConst.Target_iDLL, FALSE) |
PE32.write(program, outname, opt.base, target = mConst.Target_iConsole, target = mConst.Target_iDLL, FALSE) |
ELSIF target = mConst.Target_iKolibri THEN |
KOS.write(program, outname) |
ELSIF target = mConst.Target_iObject THEN |
MSCOFF.write(program, outname, ver) |
ELSIF target = mConst.Target_iELF32 THEN |
ELF.write(program, outname, FALSE) |
MSCOFF.write(program, outname, opt.version) |
ELSIF target IN {mConst.Target_iELF32, mConst.Target_iELFSO32} THEN |
ELF.write(program, outname, sofinit, target = mConst.Target_iELFSO32, FALSE) |
END |
END CodeGen; |