KolibriOS/oberon-07-compiler
16
0 Fork 0
mirror of https://github.com/AntKrotov/oberon-07-compiler.git synced 2026-10-05 09:45:47 +00:00
Code Issues Packages Projects Releases Wiki Activity

v1.41

Browse Source 
По предложению от Stefano Antoniazzi:
- ключ "-lower" разрешает использовать нижний регистр для ключевых слов и встроенных идентификаторов
- имя процедуры после END необязательно
This commit is contained in:
AntKrotov committed 2020-09-14 11:36:04 +03:00
1 parent 8a49dad5f9
commit 2faac397c0
38 files changed
+895 -817
Download Patch File Download Diff File Expand all files Collapse all files

No files matched your search

Compiler
BIN
View File
Binary file not shown.
Compiler.exe
BIN
View File
Binary file not shown.
doc/MSP430.txt
+2
View File
@@ -16,6 +16,8 @@ UTF-8 с BOM-сигнатурой.
-ram <size> размер ОЗУ в байтах (128 - 2048) по умолчанию 128
-rom <size> размер ПЗУ в байтах (2048 - 24576) по умолчанию 2048
-nochk <"ptibcwra"> отключить проверки при выполнении
-lower разрешить ключевые слова и встроенные идентификаторы в
нижнем регистре
параметр -nochk задается в виде строки из символов:
"p" - указатели
doc/STM32.txt
+2
View File
@@ -16,6 +16,8 @@ UTF-8 с BOM-сигнатурой.
-ram <size> размер ОЗУ в килобайтах (4 - 65536) по умолчанию 4
-rom <size> размер ПЗУ в килобайтах (16 - 65536) по умолчанию 16
-nochk <"ptibcwra"> отключить проверки при выполнении
-lower разрешить ключевые слова и встроенные идентификаторы в
нижнем регистре
параметр -nochk задается в виде строки из символов:
"p" - указатели
doc/x86.txt
+2
View File
@@ -25,6 +25,8 @@ UTF-8 с BOM-сигнатурой.
-stk <size> размер стэка в мегабайтах (по умолчанию 2 Мб,
допустимо от 1 до 32 Мб)
-nochk <"ptibcwra"> отключить проверки при выполнении (см. ниже)
-lower разрешить ключевые слова и встроенные идентификаторы в
нижнем регистре
-ver <major.minor> версия программы (только для kosdll)
параметр -nochk задается в виде строки из символов:
doc/x86_64.txt
+2
View File
@@ -23,6 +23,8 @@ UTF-8 с BOM-сигнатурой.
-stk <size> размер стэка в мегабайтах (по умолчанию 2 Мб,
допустимо от 1 до 32 Мб)
-nochk <"ptibcwra"> отключить проверки при выполнении
-lower разрешить ключевые слова и встроенные идентификаторы в
нижнем регистре
параметр -nochk задается в виде строки из символов:
"p" - указатели
lib/KolibriOS/API.ob07
+4 -4
View File
@@ -35,7 +35,7 @@ VAR
CriticalSection: CRITICAL_SECTION;
import*, multi: BOOLEAN;
_import*, multi: BOOLEAN;
base*: INTEGER;
@@ -294,15 +294,15 @@ BEGIN
END imp_error;
PROCEDURE init* (_import, code: INTEGER);
PROCEDURE init* (import_, code: INTEGER);
BEGIN
multi := FALSE;
base := code - SizeOfHeader;
K.sysfunc2(68, 11);
InitializeCriticalSection(CriticalSection);
K._init;
import := (K.dll_Load(_import) = 0) & (K.imp_error.error = 0);
IF ~import THEN
_import := (K.dll_Load(import_) = 0) & (K.imp_error.error = 0);
IF ~_import THEN
imp_error
END
END init;
lib/KolibriOS/ColorDlg.ob07
+3 -3
View File
@@ -1,5 +1,5 @@
(*
Copyright 2016, 2018 Anton Krotov
Copyright 2016, 2018, 2020 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
@@ -24,7 +24,7 @@ TYPE
DRAW_WINDOW = PROCEDURE;
TDialog = RECORD
type,
_type,
procinfo,
com_area_name,
com_area,
@@ -61,7 +61,7 @@ BEGIN
IF res # NIL THEN
res.s_com_area_name := "FFFFFFFF_color_dlg";
res.com_area := 0;
res.type := 0;
res._type := 0;
res.color_type := 0;
res.procinfo := sys.ADR(res.procinf[0]);
res.com_area_name := sys.ADR(res.s_com_area_name[0]);
lib/KolibriOS/HOST.ob07
+1 -1
View File
@@ -542,7 +542,7 @@ BEGIN
maxreal := 1.9;
PACK(maxreal, 1023);
Console := API.import;
Console := API._import;
IF Console THEN
con_init(-1, -1, -1, -1, SYSTEM.SADR("Oberon-07 for KolibriOS"))
END;
lib/KolibriOS/OpenDlg.ob07
+4 -4
View File
@@ -1,5 +1,5 @@
(*
Copyright 2016, 2018 Anton Krotov
Copyright 2016, 2018, 2020 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
@@ -24,7 +24,7 @@ TYPE
DRAW_WINDOW = PROCEDURE;
TDialog = RECORD
type,
_type,
procinfo,
com_area_name,
com_area,
@@ -66,7 +66,7 @@ BEGIN
END
END Show;
PROCEDURE Create*(draw_window: DRAW_WINDOW; type: INTEGER; def_path, filter: ARRAY OF CHAR): Dialog;
PROCEDURE Create*(draw_window: DRAW_WINDOW; _type: INTEGER; def_path, filter: ARRAY OF CHAR): Dialog;
VAR res: Dialog; n, i: INTEGER;
PROCEDURE replace(VAR str: ARRAY OF CHAR; c1, c2: CHAR);
@@ -88,7 +88,7 @@ BEGIN
IF res.filter_area # NIL THEN
res.s_com_area_name := "FFFFFFFF_open_dialog";
res.com_area := 0;
res.type := type;
res._type := _type;
res.draw_window := draw_window;
COPY(def_path, res.s_dir_default_path);
COPY(filter, res.filter_area.filter);
lib/KolibriOS/RTL.ob07
+2 -2
View File
@@ -407,7 +407,7 @@ BEGIN
END append;
PROCEDURE [stdcall] _error* (modnum, module, err, line: INTEGER);
PROCEDURE [stdcall] _error* (modnum, _module, err, line: INTEGER);
VAR
s, temp: ARRAY 1024 OF CHAR;
@@ -426,7 +426,7 @@ BEGIN
|11: s := "BYTE out of range"
END;
append(s, API.eol + "module: "); PCharToStr(module, temp); append(s, temp);
append(s, API.eol + "module: "); PCharToStr(_module, temp); append(s, temp);
append(s, API.eol + "line: "); IntToStr(line, temp); append(s, temp);
API.DebugMsg(SYSTEM.ADR(s[0]), name);
lib/KolibriOS/libimg.ob07
+2 -2
View File
@@ -1,5 +1,5 @@
(*
Copyright 2016, 2018 KolibriOS team
Copyright 2016, 2018, 2020 KolibriOS team
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
@@ -203,7 +203,7 @@ VAR
img_create *: PROCEDURE (width, height, type: INTEGER): INTEGER;
img_create *: PROCEDURE (width, height, _type: INTEGER): INTEGER;
(*
;;------------------------------------------------------------------------------------------------;;
;? creates an Image structure and initializes some its fields ;;
lib/Linux32/RTL.ob07
+2 -2
View File
@@ -407,7 +407,7 @@ BEGIN
END append;
PROCEDURE [stdcall] _error* (modnum, module, err, line: INTEGER);
PROCEDURE [stdcall] _error* (modnum, _module, err, line: INTEGER);
VAR
s, temp: ARRAY 1024 OF CHAR;
@@ -426,7 +426,7 @@ BEGIN
|11: s := "BYTE out of range"
END;
append(s, API.eol + "module: "); PCharToStr(module, temp); append(s, temp);
append(s, API.eol + "module: "); PCharToStr(_module, temp); append(s, temp);
append(s, API.eol + "line: "); IntToStr(line, temp); append(s, temp);
API.DebugMsg(SYSTEM.ADR(s[0]), name);
lib/Linux64/RTL.ob07
+2 -2
View File
@@ -385,7 +385,7 @@ BEGIN
END append;
PROCEDURE [stdcall64] _error* (modnum, module, err, line: INTEGER);
PROCEDURE [stdcall64] _error* (modnum, _module, err, line: INTEGER);
VAR
s, temp: ARRAY 1024 OF CHAR;
@@ -404,7 +404,7 @@ BEGIN
|11: s := "BYTE out of range"
END;
append(s, API.eol + "module: "); PCharToStr(module, temp); append(s, temp);
append(s, API.eol + "module: "); PCharToStr(_module, temp); append(s, temp);
append(s, API.eol + "line: "); IntToStr(line, temp); append(s, temp);
API.DebugMsg(SYSTEM.ADR(s[0]), name);
lib/RVM32I/FPU.ob07
+2 -2
View File
@@ -329,7 +329,7 @@ BEGIN
END mul;
PROCEDURE div* (b, a: INTEGER): INTEGER;
PROCEDURE _div* (b, a: INTEGER): INTEGER;
VAR
r: INTEGER;
@@ -361,7 +361,7 @@ BEGIN
END
RETURN r
END div;
END _div;
PROCEDURE cmp* (op, b, a: INTEGER): BOOLEAN;
lib/RVM32I/Out.ob07
+148 -144
View File
@@ -10,16 +10,6 @@ MODULE Out;
IMPORT HOST, SYSTEM;
CONST
d = 1.0 - 5.0E-12;
VAR
Realp: PROCEDURE (x: REAL; width: INTEGER);
PROCEDURE Char* (c: CHAR);
BEGIN
HOST.OutChar(c)
@@ -80,17 +70,7 @@ BEGIN
END Int;
PROCEDURE IsNan (x: REAL): BOOLEAN;
RETURN x # x
END IsNan;
PROCEDURE IsInf (x: REAL): BOOLEAN;
RETURN ABS(x) = SYSTEM.INF()
END IsInf;
PROCEDURE OutInf (x: REAL; width: INTEGER);
PROCEDURE Inf (x: REAL; width: INTEGER);
VAR
s: ARRAY 5 OF CHAR;
@@ -110,7 +90,7 @@ BEGIN
END;
String(s)
END OutInf;
END Inf;
PROCEDURE Ln*;
@@ -120,150 +100,174 @@ BEGIN
END Ln;
PROCEDURE _FixReal(x: REAL; width, p: INTEGER);
VAR e, len, i: INTEGER; y: REAL; minus: BOOLEAN;
BEGIN
IF IsNan(x) OR IsInf(x) THEN
OutInf(x, width)
ELSIF p < 0 THEN
Realp(x, width)
ELSE
len := 0;
minus := FALSE;
IF x < 0.0 THEN
minus := TRUE;
INC(len);
x := ABS(x)
END;
e := 0;
WHILE x >= 10.0 DO
x := x / 10.0;
INC(e)
END;
IF e >= 0 THEN
len := len + e + p + 1;
IF x > 9.0 + d THEN
INC(len)
END;
IF p > 0 THEN
INC(len)
END
ELSE
len := len + p + 2
END;
FOR i := 1 TO width - len DO
Char(" ")
END;
IF minus THEN
Char("-")
END;
y := x;
WHILE (y < 1.0) & (y # 0.0) DO
y := y * 10.0;
DEC(e)
END;
IF e < 0 THEN
IF x - FLT(FLOOR(x)) > d THEN
Char("1");
x := 0.0
ELSE
Char("0");
x := x * 10.0
END
ELSE
WHILE e >= 0 DO
IF x - FLT(FLOOR(x)) > d THEN
IF x > 9.0 THEN
String("10")
ELSE
Char(CHR(FLOOR(x) + ORD("0") + 1))
END;
x := 0.0
ELSE
Char(CHR(FLOOR(x) + ORD("0")));
x := (x - FLT(FLOOR(x))) * 10.0
END;
DEC(e)
END
END;
IF p > 0 THEN
Char(".")
END;
WHILE p > 0 DO
IF x - FLT(FLOOR(x)) > d THEN
Char(CHR(FLOOR(x) + ORD("0") + 1));
x := 0.0
ELSE
Char(CHR(FLOOR(x) + ORD("0")));
x := (x - FLT(FLOOR(x))) * 10.0
END;
DEC(p)
END
END
END _FixReal;
PROCEDURE unpk10 (VAR x: REAL; VAR n: INTEGER);
VAR
a, b: REAL;
PROCEDURE Real*(x: REAL; width: INTEGER);
VAR e, n, i: INTEGER; minus: BOOLEAN;
BEGIN
IF IsNan(x) OR IsInf(x) THEN
OutInf(x, width)
ELSE
e := 0;
ASSERT(x > 0.0);
n := 0;
IF width > 22 THEN
n := width - 22;
width := 22
ELSIF width < 8 THEN
width := 8
END;
width := width - 4;
IF x < 0.0 THEN
x := -x;
minus := TRUE
ELSE
minus := FALSE
END;
WHILE x >= 10.0 DO
x := x / 10.0;
INC(e)
END;
WHILE (x < 1.0) & (x # 0.0) DO
WHILE x < 1.0 DO
x := x * 10.0;
DEC(e)
DEC(n)
END;
IF x > 9.0 + d THEN
x := 1.0;
INC(e)
a := 10.0;
b := 1.0;
WHILE a <= x DO
b := a;
a := a * 10.0;
INC(n)
END;
FOR i := 1 TO n DO
Char(" ")
x := x / b
END unpk10;
PROCEDURE _Real (x: REAL; width: INTEGER);
VAR
n, k, p: INTEGER;
BEGIN
p := MIN(MAX(width - 7, 1), 10);
width := width - p - 7;
WHILE width > 0 DO
Char(20X);
DEC(width)
END;
IF minus THEN
IF x < 0.0 THEN
Char("-");
x := -x
ELSE
Char(20X)
END;
Realp := Real;
_FixReal(x, width, width - 3);
unpk10(x, n);
k := FLOOR(x);
Char(CHR(k + 30H));
Char(".");
WHILE p > 0 DO
x := (x - FLT(k)) * 10.0;
k := FLOOR(x);
Char(CHR(k + 30H));
DEC(p)
END;
Char("E");
IF e >= 0 THEN
IF n >= 0 THEN
Char("+")
ELSE
Char("-");
e := ABS(e)
Char("-")
END;
IF e < 10 THEN
Char("0")
n := ABS(n);
Char(CHR(n DIV 10 + 30H));
Char(CHR(n MOD 10 + 30H))
END _Real;
PROCEDURE Real* (x: REAL; width: INTEGER);
BEGIN
IF (x # x) OR (ABS(x) = SYSTEM.INF()) THEN
Inf(x, width)
ELSIF x = 0.0 THEN
WHILE width > 17 DO
Char(20X);
DEC(width)
END;
Int(e, 0)
DEC(width, 8);
String(" 0.0");
WHILE width > 0 DO
Char("0");
DEC(width)
END;
String("E+00")
ELSE
_Real(x, width)
END
END Real;
PROCEDURE FixReal*(x: REAL; width, p: INTEGER);
PROCEDURE _FixReal (x: REAL; width, p: INTEGER);
VAR
n, k: INTEGER;
minus: BOOLEAN;
BEGIN
Realp := Real;
minus := x < 0.0;
IF minus THEN
x := -x
END;
unpk10(x, n);
DEC(width, 3 + MAX(p, 0) + MAX(n, 0));
WHILE width > 0 DO
Char(20X);
DEC(width)
END;
IF minus THEN
Char("-")
ELSE
Char(20X)
END;
IF n < 0 THEN
INC(n);
Char("0");
Char(".");
WHILE (n < 0) & (p > 0) DO
Char("0");
INC(n);
DEC(p)
END
ELSE
WHILE n >= 0 DO
k := FLOOR(x);
Char(CHR(k + 30H));
x := (x - FLT(k)) * 10.0;
DEC(n)
END;
Char(".")
END;
WHILE p > 0 DO
k := FLOOR(x);
Char(CHR(k + 30H));
x := (x - FLT(k)) * 10.0;
DEC(p)
END
END _FixReal;
PROCEDURE FixReal* (x: REAL; width, p: INTEGER);
BEGIN
IF (x # x) OR (ABS(x) = SYSTEM.INF()) THEN
Inf(x, width)
ELSIF x = 0.0 THEN
DEC(width, 3 + MAX(p, 0));
WHILE width > 0 DO
Char(20X);
DEC(width)
END;
String(" 0.");
WHILE p > 0 DO
Char("0");
DEC(p)
END
ELSE
_FixReal(x, width, p)
END
END FixReal;
PROCEDURE Open*;
END Open;
END Out.
lib/RVM32I/RTL.ob07
+17 -21
View File
@@ -25,13 +25,9 @@ VAR
Heap, Types, TypesCount: INTEGER;
PROCEDURE [code] sp (): INTEGER
22, 0, 4; (* MOV R0, SP *)
PROCEDURE _error* (modnum, module, err, line: INTEGER);
PROCEDURE _error* (modnum, _module, err, line: INTEGER);
BEGIN
Trap.trap(modnum, module, err, line)
Trap.trap(modnum, _module, err, line)
END _error;
@@ -41,12 +37,12 @@ END _fmul;
PROCEDURE _fdiv* (b, a: INTEGER): INTEGER;
RETURN F.div(b, a)
RETURN F._div(b, a)
END _fdiv;
PROCEDURE _fdivi* (b, a: INTEGER): INTEGER;
RETURN F.div(a, b)
RETURN F._div(a, b)
END _fdivi;
@@ -323,7 +319,7 @@ END _strcpy;
PROCEDURE _new* (t, size: INTEGER; VAR p: INTEGER);
BEGIN
IF Heap + size < sp() - 64 THEN
IF Heap + size < Trap.sp() - 64 THEN
p := Heap + WORD;
REPEAT
SYSTEM.PUT(Heap, t);
@@ -339,37 +335,37 @@ END _new;
PROCEDURE _guard* (t, p: INTEGER): BOOLEAN;
VAR
type: INTEGER;
_type: INTEGER;
BEGIN
SYSTEM.GET(p, p);
IF p # 0 THEN
SYSTEM.GET(p - WORD, type);
WHILE (type # t) & (type # 0) DO
SYSTEM.GET(Types + type * WORD, type)
SYSTEM.GET(p - WORD, _type);
WHILE (_type # t) & (_type # 0) DO
SYSTEM.GET(Types + _type * WORD, _type)
END
ELSE
type := t
_type := t
END
RETURN type = t
RETURN _type = t
END _guard;
PROCEDURE _is* (t, p: INTEGER): BOOLEAN;
VAR
type: INTEGER;
_type: INTEGER;
BEGIN
type := 0;
_type := 0;
IF p # 0 THEN
SYSTEM.GET(p - WORD, type);
WHILE (type # t) & (type # 0) DO
SYSTEM.GET(Types + type * WORD, type)
SYSTEM.GET(p - WORD, _type);
WHILE (_type # t) & (_type # 0) DO
SYSTEM.GET(Types + _type * WORD, _type)
END
END
RETURN type = t
RETURN _type = t
END _is;
lib/RVM32I/Trap.ob07
+6 -2
View File
@@ -10,6 +10,10 @@ MODULE Trap;
IMPORT SYSTEM;
PROCEDURE [code] sp* (): INTEGER
22, 0, 4; (* MOV R0, SP *)
PROCEDURE [code] syscall* (ptr: INTEGER)
22, 0, 4, (* MOV R0, SP *)
27, 0, 4, (* ADD R0, 4 *)
@@ -93,7 +97,7 @@ BEGIN
END Int;
PROCEDURE trap* (modnum, module, err, line: INTEGER);
PROCEDURE trap* (modnum, _module, err, line: INTEGER);
VAR
s: ARRAY 32 OF CHAR;
@@ -114,7 +118,7 @@ BEGIN
Ln;
String("error ("); Int(err); String("): "); String(s); Ln;
String("module: "); PString(module); Ln;
String("module: "); PString(_module); Ln;
String("line: "); Int(line); Ln;
SYSTEM.CODE(0, 0, 0) (* STOP *)
lib/STM32CM3/FPU.ob07
+2 -2
View File
@@ -329,7 +329,7 @@ BEGIN
END mul;
PROCEDURE div* (b, a: INTEGER): INTEGER;
PROCEDURE _div* (b, a: INTEGER): INTEGER;
VAR
r: INTEGER;
@@ -361,7 +361,7 @@ BEGIN
END
RETURN r
END div;
END _div;
PROCEDURE cmp* (op, b, a: INTEGER): BOOLEAN;
lib/STM32CM3/RTL.ob07
+14 -14
View File
@@ -35,12 +35,12 @@ END _fmul;
PROCEDURE _fdiv* (b, a: INTEGER): INTEGER;
RETURN F.div(b, a)
RETURN F._div(b, a)
END _fdiv;
PROCEDURE _fdivi* (b, a: INTEGER): INTEGER;
RETURN F.div(a, b)
RETURN F._div(a, b)
END _fdivi;
@@ -333,37 +333,37 @@ END _new;
PROCEDURE _guard* (t, p: INTEGER): BOOLEAN;
VAR
type: INTEGER;
_type: INTEGER;
BEGIN
SYSTEM.GET(p, p);
IF p # 0 THEN
SYSTEM.GET(p - WORD, type);
WHILE (type # t) & (type # 0) DO
SYSTEM.GET(Types + type * WORD, type)
SYSTEM.GET(p - WORD, _type);
WHILE (_type # t) & (_type # 0) DO
SYSTEM.GET(Types + _type * WORD, _type)
END
ELSE
type := t
_type := t
END
RETURN type = t
RETURN _type = t
END _guard;
PROCEDURE _is* (t, p: INTEGER): BOOLEAN;
VAR
type: INTEGER;
_type: INTEGER;
BEGIN
type := 0;
_type := 0;
IF p # 0 THEN
SYSTEM.GET(p - WORD, type);
WHILE (type # t) & (type # 0) DO
SYSTEM.GET(Types + type * WORD, type)
SYSTEM.GET(p - WORD, _type);
WHILE (_type # t) & (_type # 0) DO
SYSTEM.GET(Types + _type * WORD, _type)
END
END
RETURN type = t
RETURN _type = t
END _is;
lib/Windows32/RTL.ob07
+2 -2
View File
@@ -407,7 +407,7 @@ BEGIN
END append;
PROCEDURE [stdcall] _error* (modnum, module, err, line: INTEGER);
PROCEDURE [stdcall] _error* (modnum, _module, err, line: INTEGER);
VAR
s, temp: ARRAY 1024 OF CHAR;
@@ -426,7 +426,7 @@ BEGIN
|11: s := "BYTE out of range"
END;
append(s, API.eol + "module: "); PCharToStr(module, temp); append(s, temp);
append(s, API.eol + "module: "); PCharToStr(_module, temp); append(s, temp);
append(s, API.eol + "line: "); IntToStr(line, temp); append(s, temp);
API.DebugMsg(SYSTEM.ADR(s[0]), name);
lib/Windows64/RTL.ob07
+2 -2
View File
@@ -385,7 +385,7 @@ BEGIN
END append;
PROCEDURE [stdcall64] _error* (modnum, module, err, line: INTEGER);
PROCEDURE [stdcall64] _error* (modnum, _module, err, line: INTEGER);
VAR
s, temp: ARRAY 1024 OF CHAR;
@@ -404,7 +404,7 @@ BEGIN
|11: s := "BYTE out of range"
END;
append(s, API.eol + "module: "); PCharToStr(module, temp); append(s, temp);
append(s, API.eol + "module: "); PCharToStr(_module, temp); append(s, temp);
append(s, API.eol + "line: "); IntToStr(line, temp); append(s, temp);
API.DebugMsg(SYSTEM.ADR(s[0]), name);
samples/Linux/X11/animation/gr.ob07
+8 -8
View File
@@ -145,7 +145,7 @@ END readInt;
PROCEDURE nextEvent* (msTimeOut :INTEGER; VAR ev :EventPars);
VAR type, n, ri :INTEGER;
VAR _type, n, ri :INTEGER;
event :XEvent;
x, y, w, h :INTEGER;
timeout :unix.timespec;
@@ -162,14 +162,14 @@ expose: 20 any 4 x, y, w, h, count
xconfigure: 24 any 4 x, y, w, h
xkey / xbutton / xmotion: 24 any 4 sub_window 4 time_ms 4 x, y, x_root, y_root 4 state 4 keycode/button
*)
type := 0;
WHILE type = 0 DO
_type := 0;
WHILE _type = 0 DO
IF (msTimeOut > 0) & (XPending(display) = 0) THEN
timeout.tv_sec := msTimeOut DIV 1000; timeout.tv_usec := (msTimeOut MOD 1000) * 1000;
ri := unix.select (connectionNr + 1, readX11, NIL, NIL, timeout); ASSERT (ri # -1);
IF ri = 0 THEN type := EventTimeOut; ev[1] := 0; ev[2] := 0; ev[3] := 0; ev[4] := 0 END;
IF ri = 0 THEN _type := EventTimeOut; ev[1] := 0; ev[2] := 0; ev[3] := 0; ev[4] := 0 END;
END;
IF type = 0 THEN
IF _type = 0 THEN
XNextEvent (display, SYSTEM.ADR(event));
CASE readInt (event, 0) OF
Expose :
@@ -186,14 +186,14 @@ xkey / xbutton / xmotion: 24 any 4 sub_window 4 time_ms 4 x, y, x_root,
ev[0] := EventResize; ev[1] := 0; ev[2] := w; ev[3] := h; ev[4] := 0;
END;
| KeyPress :
type := EventKeyPressed;
_type := EventKeyPressed;
x := XLookupString (SYSTEM.ADR(event), 0, 0, SYSTEM.ADR(n), 0); (* KeySym *)
IF (n = 8) OR (n = 10) OR (n >= 32) & (n <= 126) THEN ev[1] := 1 ELSE ev[1] := 0; n := 0 END; (* isprint *)
ev[2] := readInt (event, 13 + 8 * bit64); (* keycode *)
ev[3] := readInt (event, 12 + 8 * bit64); (* state *)
ev[4] := n; (* KeySym *)
| ButtonPress :
type := EventButtonPressed;
_type := EventButtonPressed;
ev[1] := readInt (event, 13 + 8 * bit64); (* button *)
ev[2] := readInt (event, 8 + 8 * bit64); (* x *)
ev[3] := readInt (event, 9 + 8 * bit64); (* y *)
@@ -202,7 +202,7 @@ xkey / xbutton / xmotion: 24 any 4 sub_window 4 time_ms 4 x, y, x_root,
END
END
END;
ev[0] := type
ev[0] := _type
END nextEvent;
samples/Linux/X11/filler/gr.ob07
+8 -8
View File
@@ -145,7 +145,7 @@ END readInt;
PROCEDURE nextEvent* (msTimeOut :INTEGER; VAR ev :EventPars);
VAR type, n, ri :INTEGER;
VAR _type, n, ri :INTEGER;
event :XEvent;
x, y, w, h :INTEGER;
timeout :unix.timespec;
@@ -162,14 +162,14 @@ expose: 20 any 4 x, y, w, h, count
xconfigure: 24 any 4 x, y, w, h
xkey / xbutton / xmotion: 24 any 4 sub_window 4 time_ms 4 x, y, x_root, y_root 4 state 4 keycode/button
*)
type := 0;
WHILE type = 0 DO
_type := 0;
WHILE _type = 0 DO
IF (msTimeOut > 0) & (XPending(display) = 0) THEN
timeout.tv_sec := msTimeOut DIV 1000; timeout.tv_usec := (msTimeOut MOD 1000) * 1000;
ri := unix.select (connectionNr + 1, readX11, NIL, NIL, timeout); ASSERT (ri # -1);
IF ri = 0 THEN type := EventTimeOut; ev[1] := 0; ev[2] := 0; ev[3] := 0; ev[4] := 0 END;
IF ri = 0 THEN _type := EventTimeOut; ev[1] := 0; ev[2] := 0; ev[3] := 0; ev[4] := 0 END;
END;
IF type = 0 THEN
IF _type = 0 THEN
XNextEvent (display, SYSTEM.ADR(event));
CASE readInt (event, 0) OF
Expose :
@@ -186,14 +186,14 @@ xkey / xbutton / xmotion: 24 any 4 sub_window 4 time_ms 4 x, y, x_root,
ev[0] := EventResize; ev[1] := 0; ev[2] := w; ev[3] := h; ev[4] := 0;
END;
| KeyPress :
type := EventKeyPressed;
_type := EventKeyPressed;
x := XLookupString (SYSTEM.ADR(event), 0, 0, SYSTEM.ADR(n), 0); (* KeySym *)
IF (n = 8) OR (n = 10) OR (n >= 32) & (n <= 126) THEN ev[1] := 1 ELSE ev[1] := 0; n := 0 END; (* isprint *)
ev[2] := readInt (event, 13 + 8 * bit64); (* keycode *)
ev[3] := readInt (event, 12 + 8 * bit64); (* state *)
ev[4] := n; (* KeySym *)
| ButtonPress :
type := EventButtonPressed;
_type := EventButtonPressed;
ev[1] := readInt (event, 13 + 8 * bit64); (* button *)
ev[2] := readInt (event, 8 + 8 * bit64); (* x *)
ev[3] := readInt (event, 9 + 8 * bit64); (* y *)
@@ -202,7 +202,7 @@ xkey / xbutton / xmotion: 24 any 4 sub_window 4 time_ms 4 x, y, x_root,
END
END
END;
ev[0] := type
ev[0] := _type
END nextEvent;
samples/Windows/Console/hailst.ob07
+3 -3
View File
@@ -33,7 +33,7 @@ BEGIN
END HALT;
PROCEDURE HailStone(start, type: INTEGER): INTEGER;
PROCEDURE HailStone(start, _type: INTEGER): INTEGER;
VAR
n, max, count, res: INTEGER;
exit: BOOLEAN;
@@ -44,7 +44,7 @@ BEGIN
max := n;
exit := FALSE;
WHILE exit # TRUE DO
IF type = List THEN
IF _type = List THEN
Out.Int (n, 12);
IF count MOD 6 = 0 THEN Out.Ln END
END;
@@ -72,7 +72,7 @@ BEGIN
exit := TRUE
END
END;
IF type = Max THEN res := max ELSE res := count END
IF _type = Max THEN res := max ELSE res := count END
RETURN res
END HailStone;
source/AMD64.ob07
+9 -9
View File
@@ -194,10 +194,10 @@ BEGIN
END and;
PROCEDURE or (reg1, reg2: INTEGER); (* or reg1, reg2 *)
PROCEDURE _or (reg1, reg2: INTEGER); (* or reg1, reg2 *)
BEGIN
oprr(09H, reg1, reg2)
END or;
END _or;
PROCEDURE add (reg1, reg2: INTEGER); (* add reg1, reg2 *)
@@ -418,7 +418,7 @@ END andrc;
PROCEDURE orrc (reg, n: INTEGER); (* or reg, n *)
BEGIN
oprc(0C8H, reg, n, or)
oprc(0C8H, reg, n, _or)
END orrc;
@@ -1845,7 +1845,7 @@ BEGIN
|IL.opADDS:
BinOp(reg1, reg2);
or(reg1, reg2);
_or(reg1, reg2);
drop
|IL.opSUBS:
@@ -2191,7 +2191,7 @@ BEGIN
and(reg2, reg1);
pop(reg1);
or(reg2, reg1);
_or(reg2, reg1);
pop(reg1);
movmr(reg1, 0, reg2);
drop;
@@ -2234,7 +2234,7 @@ BEGIN
push(reg2);
lea(reg2, Numbers_Offs + 48, sDATA); (* {52..61} *)
movrm(reg2, reg2, 0);
or(reg1, reg2);
_or(reg1, reg2);
pop(reg2);
Rex(reg1, 0);
@@ -2538,7 +2538,7 @@ VAR
exp: IL.EXPORT_PROC;
PROCEDURE import (imp: LISTS.LIST);
PROCEDURE _import (imp: LISTS.LIST);
VAR
lib: IL.IMPORT_LIB;
proc: IL.IMPORT_PROC;
@@ -2556,7 +2556,7 @@ VAR
lib := lib.next(IL.IMPORT_LIB)
END
END import;
END _import;
BEGIN
@@ -2609,7 +2609,7 @@ BEGIN
exp := exp.next(IL.EXPORT_PROC)
END;
import(IL.codes.import)
_import(IL.codes._import)
END epilog;
source/BIN.ob07
+20 -21
View File
@@ -1,7 +1,7 @@
(*
BSD 2-Clause License
Copyright (c) 2018-2019, Anton Krotov
Copyright (c) 2018-2020, Anton Krotov
All rights reserved.
*)
@@ -56,7 +56,7 @@ TYPE
vmajor*,
vminor*: WCHAR;
modname*: INTEGER;
import*: CHL.BYTELIST;
_import*: CHL.BYTELIST;
export*: CHL.BYTELIST;
rel_list*: LISTS.LIST;
imp_list*: LISTS.LIST;
@@ -86,7 +86,7 @@ BEGIN
program.data := CHL.CreateByteList();
program.code := CHL.CreateByteList();
program.import := CHL.CreateByteList();
program._import := CHL.CreateByteList();
program.export := CHL.CreateByteList()
RETURN program
@@ -120,7 +120,7 @@ BEGIN
END PutData;
PROCEDURE get32le* (array: CHL.BYTELIST; idx: INTEGER): INTEGER;
PROCEDURE get32le* (_array: CHL.BYTELIST; idx: INTEGER): INTEGER;
VAR
i: INTEGER;
x: INTEGER;
@@ -129,7 +129,7 @@ BEGIN
x := 0;
FOR i := 3 TO 0 BY -1 DO
x := LSL(x, 8) + CHL.GetByte(array, idx + i)
x := LSL(x, 8) + CHL.GetByte(_array, idx + i)
END;
IF UTILS.bit_depth = 64 THEN
@@ -143,13 +143,13 @@ BEGIN
END get32le;
PROCEDURE put32le* (array: CHL.BYTELIST; idx: INTEGER; x: INTEGER);
PROCEDURE put32le* (_array: CHL.BYTELIST; idx: INTEGER; x: INTEGER);
VAR
i: INTEGER;
BEGIN
FOR i := 0 TO 3 DO
CHL.SetByte(array, idx + i, UTILS.Byte(x, i))
CHL.SetByte(_array, idx + i, UTILS.Byte(x, i))
END
END put32le;
@@ -224,15 +224,15 @@ VAR
imp: IMPRT;
BEGIN
CHL.PushByte(program.import, 0);
CHL.PushByte(program.import, 0);
CHL.PushByte(program._import, 0);
CHL.PushByte(program._import, 0);
IF ODD(CHL.Length(program.import)) THEN
CHL.PushByte(program.import, 0)
IF ODD(CHL.Length(program._import)) THEN
CHL.PushByte(program._import, 0)
END;
NEW(imp);
imp.nameoffs := CHL.PushStr(program.import, name);
imp.nameoffs := CHL.PushStr(program._import, name);
imp.label := label;
LISTS.push(program.imp_list, imp)
END Import;
@@ -285,19 +285,18 @@ END Export;
PROCEDURE GetIProc* (program: PROGRAM; n: INTEGER): IMPRT;
VAR
import: IMPRT;
res: IMPRT;
_import, res: IMPRT;
BEGIN
import := program.imp_list.first(IMPRT);
_import := program.imp_list.first(IMPRT);
res := NIL;
WHILE (import # NIL) & (n >= 0) DO
IF import.label # 0 THEN
res := import;
WHILE (_import # NIL) & (n >= 0) DO
IF _import.label # 0 THEN
res := _import;
DEC(n)
END;
import := import.next(IMPRT)
_import := _import.next(IMPRT)
END;
ASSERT(n = -1)
@@ -349,7 +348,7 @@ BEGIN
END fixup;
PROCEDURE InitArray* (VAR array: ARRAY OF BYTE; VAR idx: INTEGER; hex: ARRAY OF CHAR);
PROCEDURE InitArray* (VAR _array: ARRAY OF BYTE; VAR idx: INTEGER; hex: ARRAY OF CHAR);
VAR
i, k: INTEGER;
@@ -375,7 +374,7 @@ BEGIN
k := k DIV 2;
FOR i := 0 TO k - 1 DO
array[i + idx] := hexdgt(hex[2 * i]) * 16 + hexdgt(hex[2 * i + 1])
_array[i + idx] := hexdgt(hex[2 * i]) * 16 + hexdgt(hex[2 * i + 1])
END;
INC(idx, k)
source/Compiler.ob07
+9 -4
View File
@@ -15,7 +15,7 @@ PROCEDURE keys (VAR options: PROG.OPTIONS; VAR out: PARS.PATH);
VAR
param: PARS.PATH;
i, j: INTEGER;
end: BOOLEAN;
_end: BOOLEAN;
value: INTEGER;
minor,
major: INTEGER;
@@ -24,7 +24,7 @@ VAR
BEGIN
out := "";
checking := options.checking;
end := FALSE;
_end := FALSE;
i := 3;
REPEAT
UTILS.GetArg(i, param);
@@ -113,18 +113,21 @@ BEGIN
DEC(i)
END
ELSIF param = "-lower" THEN
options.lower := TRUE
ELSIF param = "-pic" THEN
options.pic := TRUE
ELSIF param = "" THEN
end := TRUE
_end := TRUE
ELSE
ERRORS.BadParam(param)
END;
INC(i)
UNTIL end;
UNTIL _end;
options.checking := checking
END keys;
@@ -165,6 +168,7 @@ BEGIN
options.stack := 2;
options.version := 65536;
options.pic := FALSE;
options.lower := FALSE;
options.checking := ST.chkALL;
PATHS.GetCurrentDirectory(app_path);
@@ -203,6 +207,7 @@ BEGIN
C.StringLn(" -stk <size> set size of stack in Mbytes (Windows, Linux, KolibriOS)"); C.Ln;
C.StringLn(" -nochk <'ptibcwra'> disable runtime checking (pointers, types, indexes,");
C.StringLn(" BYTE, CHR, WCHR)"); C.Ln;
C.StringLn(" -lower allow lower case for keywords"); C.Ln;
C.StringLn(" -ver <major.minor> set version of program (KolibriOS DLL)"); C.Ln;
C.StringLn(" -ram <size> set size of RAM in bytes (MSP430) or Kbytes (STM32)"); C.Ln;
C.StringLn(" -rom <size> set size of ROM in bytes (MSP430) or Kbytes (STM32)"); C.Ln;
source/IL.ob07
+12 -12
View File
@@ -194,7 +194,7 @@ TYPE
endcall: CMDSTACK;
commands*: LISTS.LIST;
export*: LISTS.LIST;
import*: LISTS.LIST;
_import*: LISTS.LIST;
types*: CHL.INTLIST;
data*: CHL.BYTELIST;
dmin*: INTEGER;
@@ -411,19 +411,19 @@ BEGIN
END pop;
PROCEDURE pushBegEnd* (VAR beg, end: COMMAND);
PROCEDURE pushBegEnd* (VAR beg, _end: COMMAND);
BEGIN
push(codes.begcall, beg);
push(codes.endcall, end);
push(codes.endcall, _end);
beg := codes.last;
end := beg.next(COMMAND)
_end := beg.next(COMMAND)
END pushBegEnd;
PROCEDURE popBegEnd* (VAR beg, end: COMMAND);
PROCEDURE popBegEnd* (VAR beg, _end: COMMAND);
BEGIN
beg := pop(codes.begcall);
end := pop(codes.endcall)
_end := pop(codes.endcall)
END popBegEnd;
@@ -981,7 +981,7 @@ BEGIN
END drop;
PROCEDURE case* (a, b, L, R: INTEGER);
PROCEDURE _case* (a, b, L, R: INTEGER);
VAR
cmd: COMMAND;
@@ -997,7 +997,7 @@ BEGIN
AddCmd2(opCASEL, a, L);
AddCmd2(opCASER, b, R)
END
END case;
END _case;
PROCEDURE fname* (name: PATHS.PATH);
@@ -1030,7 +1030,7 @@ VAR
p: IMPORT_PROC;
BEGIN
lib := codes.import.first(IMPORT_LIB);
lib := codes._import.first(IMPORT_LIB);
WHILE (lib # NIL) & (lib.name # dll) DO
lib := lib.next(IMPORT_LIB)
END;
@@ -1039,7 +1039,7 @@ BEGIN
NEW(lib);
lib.name := dll;
lib.procs := LISTS.create(NIL);
LISTS.push(codes.import, lib)
LISTS.push(codes._import, lib)
END;
p := lib.procs.first(IMPORT_PROC);
@@ -1072,7 +1072,7 @@ BEGIN
lib := imp(IMPORT_PROC).lib;
LISTS.delete(lib.procs, imp);
IF lib.procs.first = NIL THEN
LISTS.delete(codes.import, lib)
LISTS.delete(codes._import, lib)
END
END
END DelImport;
@@ -1095,7 +1095,7 @@ BEGIN
codes.endcall.top := -1;
codes.commands := LISTS.create(NIL);
codes.export := LISTS.create(NIL);
codes.import := LISTS.create(NIL);
codes._import := LISTS.create(NIL);
codes.types := CHL.CreateIntList();
codes.data := CHL.CreateByteList();
source/KOS.ob07
+15 -15
View File
@@ -30,16 +30,16 @@ TYPE
PROCEDURE Import* (program: BIN.PROGRAM; idata: INTEGER; VAR ImportTable: CHL.INTLIST; VAR len, libcount, size: INTEGER);
VAR
i: INTEGER;
import: BIN.IMPRT;
imp: BIN.IMPRT;
BEGIN
libcount := 0;
import := program.imp_list.first(BIN.IMPRT);
WHILE import # NIL DO
IF import.label = 0 THEN
imp := program.imp_list.first(BIN.IMPRT);
WHILE imp # NIL DO
IF imp.label = 0 THEN
INC(libcount)
END;
import := import.next(BIN.IMPRT)
imp := imp.next(BIN.IMPRT)
END;
len := libcount * 2 + 2;
@@ -51,29 +51,29 @@ BEGIN
END;
i := 0;
import := program.imp_list.first(BIN.IMPRT);
WHILE import # NIL DO
imp := program.imp_list.first(BIN.IMPRT);
WHILE imp # NIL DO
IF import.label = 0 THEN
IF imp.label = 0 THEN
CHL.SetInt(ImportTable, len, 0);
INC(len);
CHL.SetInt(ImportTable, i, idata + len * SIZE_OF_DWORD);
INC(i);
CHL.SetInt(ImportTable, i, import.nameoffs + size + idata);
CHL.SetInt(ImportTable, i, imp.nameoffs + size + idata);
INC(i)
ELSE
CHL.SetInt(ImportTable, len, import.nameoffs + size + idata);
import.label := len * SIZE_OF_DWORD;
CHL.SetInt(ImportTable, len, imp.nameoffs + size + idata);
imp.label := len * SIZE_OF_DWORD;
INC(len)
END;
import := import.next(BIN.IMPRT)
imp := imp.next(BIN.IMPRT)
END;
CHL.SetInt(ImportTable, len, 0);
CHL.SetInt(ImportTable, i, 0);
CHL.SetInt(ImportTable, i + 1, 0);
INC(len);
INC(size, CHL.Length(program.import))
INC(size, CHL.Length(program._import))
END Import;
@@ -107,7 +107,7 @@ VAR
BEGIN
base := 0;
icount := CHL.Length(program.import);
icount := CHL.Length(program._import);
dcount := CHL.Length(program.data);
ccount := CHL.Length(program.code);
@@ -197,7 +197,7 @@ BEGIN
WR.Write32LE(CHL.GetInt(ImportTable, i))
END;
CHL.WriteToFile(program.import);
CHL.WriteToFile(program._import);
WR.Close
END write;
source/MSCOFF.ob07
+2 -2
View File
@@ -148,7 +148,7 @@ BEGIN
KOS.Import(program, 0, ImportTable, ILen, LibCount, isize);
ExpCount := LISTS.count(program.exp_list);
icount := CHL.Length(program.import);
icount := CHL.Length(program._import);
dcount := CHL.Length(program.data);
ccount := CHL.Length(program.code);
ecount := CHL.Length(program.export);
@@ -254,7 +254,7 @@ BEGIN
WR.Write32LE(CHL.GetInt(ImportTable, i))
END;
CHL.WriteToFile(program.import);
CHL.WriteToFile(program._import);
Reloc(program);
source/PARS.ob07
+65 -59
View File
@@ -34,7 +34,7 @@ TYPE
EXPR* = RECORD
obj*: INTEGER;
type*: PROG.TYPE_;
_type*: PROG._TYPE;
value*: ARITH.VALUE;
stproc*: INTEGER;
readOnly*: BOOLEAN;
@@ -44,7 +44,7 @@ TYPE
STATPROC = PROCEDURE (parser: PARSER);
EXPRPROC = PROCEDURE (parser: PARSER; VAR e: EXPR);
RETPROC = PROCEDURE (parser: PARSER; e: EXPR; t: PROG.TYPE_; pos: POSITION): BOOLEAN;
RETPROC = PROCEDURE (parser: PARSER; e: EXPR; t: PROG._TYPE; pos: POSITION): BOOLEAN;
rPARSER = RECORD (C.ITEM)
@@ -347,7 +347,7 @@ BEGIN
END ConstExpression;
PROCEDURE FieldList (parser: PARSER; rec: PROG.TYPE_);
PROCEDURE FieldList (parser: PARSER; rec: PROG._TYPE);
VAR
name: SCAN.IDENT;
export: BOOLEAN;
@@ -384,18 +384,18 @@ BEGIN
END FieldList;
PROCEDURE FormalParameters (parser: PARSER; type: PROG.TYPE_);
PROCEDURE FormalParameters (parser: PARSER; _type: PROG._TYPE);
VAR
ident: PROG.IDENT;
PROCEDURE FPSection (parser: PARSER; type: PROG.TYPE_);
PROCEDURE FPSection (parser: PARSER; _type: PROG._TYPE);
VAR
ident: PROG.IDENT;
exit: BOOLEAN;
vPar: BOOLEAN;
dim: INTEGER;
t0, t1: PROG.TYPE_;
t0, t1: PROG._TYPE;
BEGIN
vPar := parser.sym = SCAN.lxVAR;
@@ -407,7 +407,7 @@ VAR
exit := FALSE;
WHILE (parser.sym = SCAN.lxIDENT) & ~exit DO
check1(PROG.addParam(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)
@@ -424,7 +424,7 @@ VAR
ident := QIdent(parser, FALSE);
check1(ident.typ = PROG.idTYPE, parser, 68);
t0 := ident.type;
t0 := ident._type;
t1 := t0;
WHILE dim > 0 DO
@@ -434,7 +434,7 @@ VAR
DEC(dim)
END;
PROG.setParams(type, t1);
PROG.setParams(_type, t1);
Next(parser);
exit := TRUE
ELSE
@@ -451,10 +451,10 @@ BEGIN
Next(parser);
IF (parser.sym = SCAN.lxVAR) OR (parser.sym = SCAN.lxIDENT) THEN
FPSection(parser, type);
FPSection(parser, _type);
WHILE parser.sym = SCAN.lxSEMI DO
Next(parser);
FPSection(parser, type)
FPSection(parser, _type)
END
END;
@@ -465,12 +465,12 @@ BEGIN
ExpectSym(parser, SCAN.lxIDENT);
ident := QIdent(parser, FALSE);
check1(ident.typ = PROG.idTYPE, parser, 68);
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;
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)
ELSE
type.base := NIL
_type.base := NIL
END
END
@@ -557,7 +557,7 @@ BEGIN
END sysflag;
PROCEDURE procflag (parser: PARSER; VAR import: IL.IMPORT_PROC; isProc: BOOLEAN): INTEGER;
PROCEDURE procflag (parser: PARSER; VAR _import: IL.IMPORT_PROC; isProc: BOOLEAN): INTEGER;
VAR
call: INTEGER;
dll, proc: SCAN.LEXSTR;
@@ -583,7 +583,7 @@ VAR
BEGIN
import := NIL;
_import := NIL;
IF parser.sym = SCAN.lxLSQUARE THEN
getpos(parser, pos);
@@ -603,7 +603,7 @@ BEGIN
checklex(parser, SCAN.lxCOMMA);
Next(parser);
getStr(parser, proc);
import := IL.AddImp(dll, proc)
_import := IL.AddImp(dll, proc)
END;
checklex(parser, SCAN.lxRSQUARE);
@@ -620,7 +620,7 @@ BEGIN
END
END;
IF import # NIL THEN
IF _import # NIL THEN
check(TARGETS.Import, pos, 70)
END
@@ -628,7 +628,7 @@ BEGIN
END procflag;
PROCEDURE type (parser: PARSER; VAR t: PROG.TYPE_; flags: SET);
PROCEDURE _type (parser: PARSER; VAR t: PROG._TYPE; flags: SET);
CONST
comma = 0;
closed = 1;
@@ -640,11 +640,11 @@ VAR
ident: PROG.IDENT;
unit: PROG.UNIT;
pos, pos2: POSITION;
fieldType: PROG.TYPE_;
fieldType: PROG._TYPE;
baseIdent: SCAN.IDENT;
a, b: INTEGER;
RecFlag: INTEGER;
import: IL.IMPORT_PROC;
_import: IL.IMPORT_PROC;
BEGIN
unit := parser.unit;
@@ -655,7 +655,7 @@ BEGIN
IF ident # NIL THEN
check1(ident.typ = PROG.idTYPE, parser, 49);
t := ident.type;
t := ident._type;
check1(t # NIL, parser, 50);
IF closed IN flags THEN
check1(t.closed, parser, 50)
@@ -680,10 +680,10 @@ BEGIN
t := PROG.enterType(PROG.tARRAY, -1, ARITH.getInt(arrLen), unit);
IF parser.sym = SCAN.lxCOMMA THEN
type(parser, t.base, {comma, closed})
_type(parser, t.base, {comma, closed})
ELSIF parser.sym = SCAN.lxOF THEN
Next(parser);
type(parser, t.base, {closed})
_type(parser, t.base, {closed})
ELSE
check1(FALSE, parser, 47)
END;
@@ -719,7 +719,7 @@ BEGIN
ExpectSym(parser, SCAN.lxIDENT);
getpos(parser, pos);
type(parser, t.base, {closed});
_type(parser, t.base, {closed});
check(t.base.typ IN {PROG.tRECORD, PROG.tPOINTER}, pos, 52);
@@ -747,7 +747,7 @@ BEGIN
ASSERT(parser.sym = SCAN.lxCOLON);
Next(parser);
type(parser, fieldType, {closed});
_type(parser, fieldType, {closed});
check(PROG.setFields(t, fieldType), pos2, 104);
IF (fieldType.align > t.align) & ~t.noalign THEN
@@ -786,7 +786,7 @@ BEGIN
baseIdent := parser.lex.ident
END;
type(parser, t.base, {forward});
_type(parser, t.base, {forward});
IF t.base # NIL THEN
check(t.base.typ = PROG.tRECORD, pos, 58)
@@ -798,13 +798,13 @@ BEGIN
NextPos(parser, pos);
t := PROG.enterType(PROG.tPROCEDURE, TARGETS.AdrSize, 0, unit);
t.align := TARGETS.AdrSize;
t.call := procflag(parser, import, FALSE);
t.call := procflag(parser, _import, FALSE);
FormalParameters(parser, t)
ELSE
check1(FALSE, parser, 49)
END
END type;
END _type;
PROCEDURE IdentDef (parser: PARSER; typ: INTEGER; VAR name: SCAN.IDENT): PROG.IDENT;
@@ -832,14 +832,14 @@ BEGIN
END IdentDef;
PROCEDURE ConstTypeDeclaration (parser: PARSER; const: BOOLEAN);
PROCEDURE ConstTypeDeclaration (parser: PARSER; _const: BOOLEAN);
VAR
ident: PROG.IDENT;
name: SCAN.IDENT;
pos: POSITION;
BEGIN
IF const THEN
IF _const THEN
ident := IdentDef(parser, PROG.idNONE, name)
ELSE
ident := IdentDef(parser, PROG.idTYPE, name)
@@ -848,7 +848,7 @@ BEGIN
checklex(parser, SCAN.lxEQ);
NextPos(parser, pos);
IF const THEN
IF _const THEN
ConstExpression(parser, ident.value);
IF ident.value.typ = ARITH.tINTEGER THEN
check(ARITH.check(ident.value), pos, 39)
@@ -856,9 +856,9 @@ BEGIN
check(ARITH.check(ident.value), pos, 40)
END;
ident.typ := PROG.idCONST;
ident.type := PROG.getType(ident.value.typ)
ident._type := PROG.getType(ident.value.typ)
ELSE
type(parser, ident.type, {})
_type(parser, ident._type, {})
END;
checklex(parser, SCAN.lxSEMI);
@@ -871,7 +871,7 @@ PROCEDURE VarDeclaration (parser: PARSER);
VAR
ident: PROG.IDENT;
name: SCAN.IDENT;
t: PROG.TYPE_;
t: PROG._TYPE;
BEGIN
@@ -882,7 +882,7 @@ BEGIN
ExpectSym(parser, SCAN.lxIDENT)
ELSIF parser.sym = SCAN.lxCOLON THEN
Next(parser);
type(parser, t, {});
_type(parser, t, {});
PROG.setVarsType(parser.unit, t);
checklex(parser, SCAN.lxSEMI);
Next(parser)
@@ -916,8 +916,8 @@ VAR
label: INTEGER;
enter: IL.COMMAND;
call: INTEGER;
t: PROG.TYPE_;
import: IL.IMPORT_PROC;
t: PROG._TYPE;
_import: IL.IMPORT_PROC;
endmod, b: BOOLEAN;
fparams: SET;
variables: LISTS.LIST;
@@ -933,27 +933,27 @@ VAR
unit := parser.unit;
call := procflag(parser, import, TRUE);
call := procflag(parser, _import, TRUE);
getpos(parser, pos);
pos1 := pos;
checklex(parser, SCAN.lxIDENT);
IF import # NIL THEN
IF _import # NIL THEN
proc := IdentDef(parser, PROG.idIMP, name);
proc.import := import;
IF import.name = "" THEN
import.name := name.s
proc._import := _import;
IF _import.name = "" THEN
_import.name := name.s
END;
PROG.program.procs.last(PROG.PROC).import := import
PROG.program.procs.last(PROG.PROC)._import := _import
ELSE
proc := IdentDef(parser, PROG.idPROC, name)
END;
check(PROG.openScope(unit, proc.proc), pos, 116);
proc.type := PROG.enterType(PROG.tPROCEDURE, TARGETS.AdrSize, 0, unit);
t := proc.type;
proc._type := PROG.enterType(PROG.tPROCEDURE, TARGETS.AdrSize, 0, unit);
t := proc._type;
t.align := TARGETS.AdrSize;
t.call := call;
@@ -983,7 +983,7 @@ VAR
WHILE param # NIL DO
ident := PROG.addIdent(unit, param.name, PROG.idPARAM);
ASSERT(ident # NIL);
ident.type := param.type;
ident._type := param._type;
ident.offset := param.offset;
IF param.vPar THEN
ident.typ := PROG.idVPAR
@@ -991,7 +991,7 @@ VAR
param := param.next(PROG.PARAM)
END;
IF import = NIL THEN
IF _import = NIL THEN
label := IL.NewLabel();
proc.proc.label := label;
proc.proc.used := handler;
@@ -1026,7 +1026,7 @@ VAR
checklex(parser, SCAN.lxSEMI);
Next(parser);
IF import = NIL THEN
IF _import = NIL THEN
IF parser.main & proc.export & TARGETS.Dll THEN
IF TARGETS.target = TARGETS.KolibriOSDLL THEN
@@ -1042,11 +1042,11 @@ VAR
PROG.ResetLocSize;
IF call IN {PROG._win64, PROG.win64} THEN
fparams := PROG.getFloatParamsPos(proc.type, 3, int, flt);
enter := IL.Enter(label, LSL(ORD(fparams), 5) + MIN(proc.type.parSize, 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 := PROG.getFloatParamsPos(proc.type, PROG.MAXSYSVPARAM - 1, int, flt);
enter := IL.Enter(label, -(LSL(ORD(fparams), 5) + proc.type.parSize))
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
@@ -1076,15 +1076,16 @@ VAR
END;
IF TARGETS.CPU = TARGETS.cpuMSP430 THEN
check((enter.param2 * ORD(~codeProc) + proc.type.parSize) * 2 + 16 < PROG.program.options.ram, pos1, 63)
check((enter.param2 * ORD(~codeProc) + proc._type.parSize) * 2 + 16 < PROG.program.options.ram, pos1, 63)
END
END;
IF parser.sym = SCAN.lxEND THEN
ExpectSym(parser, SCAN.lxIDENT);
Next(parser);
IF parser.sym = SCAN.lxIDENT THEN
getpos(parser, pos);
endname := parser.lex.ident;
IF ~codeProc & (import = NIL) THEN
IF ~codeProc & (_import = NIL) THEN
check(endname = name, pos, 60);
ExpectSym(parser, SCAN.lxSEMI);
Next(parser)
@@ -1100,9 +1101,14 @@ VAR
error(pos, 60)
END
END
ELSIF parser.sym = SCAN.lxSEMI THEN
Next(parser)
ELSE
checklex(parser, SCAN.lxIDENT)
END
END;
IF ~codeProc & (import = NIL) THEN
IF ~codeProc & (_import = NIL) THEN
variables := LISTS.create(NIL);
ELSE
variables := NIL
@@ -1110,7 +1116,7 @@ VAR
PROG.closeScope(unit, variables);
IF ~codeProc & (import = NIL) THEN
IF ~codeProc & (_import = NIL) THEN
enter.variables := variables
END
source/PE32.ob07
+37 -37
View File
@@ -179,15 +179,15 @@ END Export;
PROCEDURE GetProcCount (lib: BIN.IMPRT): INTEGER;
VAR
import: BIN.IMPRT;
imp: BIN.IMPRT;
res: INTEGER;
BEGIN
res := 0;
import := lib.next(BIN.IMPRT);
WHILE (import # NIL) & (import.label # 0) DO
imp := lib.next(BIN.IMPRT);
WHILE (imp # NIL) & (imp.label # 0) DO
INC(res);
import := import.next(BIN.IMPRT)
imp := imp.next(BIN.IMPRT)
END
RETURN res
@@ -196,7 +196,7 @@ END GetProcCount;
PROCEDURE GetImportSize (imp_list: LISTS.LIST): INTEGER;
VAR
import: BIN.IMPRT;
imp: BIN.IMPRT;
proccnt: INTEGER;
procoffs: INTEGER;
OriginalCurrentThunk,
@@ -205,33 +205,33 @@ VAR
BEGIN
libcnt := 0;
proccnt := 0;
import := imp_list.first(BIN.IMPRT);
WHILE import # NIL DO
IF import.label = 0 THEN
imp := imp_list.first(BIN.IMPRT);
WHILE imp # NIL DO
IF imp.label = 0 THEN
INC(libcnt)
ELSE
INC(proccnt)
END;
import := import.next(BIN.IMPRT)
imp := imp.next(BIN.IMPRT)
END;
procoffs := 0;
import := imp_list.first(BIN.IMPRT);
WHILE import # NIL DO
IF import.label = 0 THEN
import.OriginalFirstThunk := procoffs;
import.FirstThunk := procoffs + (GetProcCount(import) + 1);
OriginalCurrentThunk := import.OriginalFirstThunk;
CurrentThunk := import.FirstThunk;
procoffs := procoffs + (GetProcCount(import) + 1) * 2
imp := imp_list.first(BIN.IMPRT);
WHILE imp # NIL DO
IF imp.label = 0 THEN
imp.OriginalFirstThunk := procoffs;
imp.FirstThunk := procoffs + (GetProcCount(imp) + 1);
OriginalCurrentThunk := imp.OriginalFirstThunk;
CurrentThunk := imp.FirstThunk;
INC(procoffs, (GetProcCount(imp) + 1) * 2)
ELSE
import.OriginalFirstThunk := OriginalCurrentThunk;
import.FirstThunk := CurrentThunk;
imp.OriginalFirstThunk := OriginalCurrentThunk;
imp.FirstThunk := CurrentThunk;
INC(OriginalCurrentThunk);
INC(CurrentThunk)
END;
import := import.next(BIN.IMPRT)
imp := imp.next(BIN.IMPRT)
END
RETURN (libcnt + 1) * 5 * SIZE_OF_DWORD + (proccnt + libcnt) * 2 * SizeOfWord
@@ -363,7 +363,7 @@ VAR
Address: VIRTUAL_ADDR;
import: BIN.IMPRT;
_import: BIN.IMPRT;
ImportTable: CHL.INTLIST;
ExportDir: IMAGE_EXPORT_DIRECTORY;
@@ -548,7 +548,7 @@ BEGIN
Size.Import := GetImportSize(program.imp_list);
InitSection(SectionHeaders[3], ".idata", SHC_data);
SectionHeaders[3].VirtualSize := Size.Import + CHL.Length(program.import);
SectionHeaders[3].VirtualSize := Size.Import + CHL.Length(program._import);
SectionHeaders[3].VirtualAddress := WR.align(SectionHeaders[2].VirtualAddress + SectionHeaders[2].VirtualSize, SectionAlignment);
SectionHeaders[3].SizeOfRawData := WR.align(SectionHeaders[3].VirtualSize, FileAlignment);
SectionHeaders[3].PointerToRawData := SectionHeaders[2].PointerToRawData + SectionHeaders[2].SizeOfRawData;
@@ -630,17 +630,17 @@ BEGIN
END;
i := 0;
import := program.imp_list.first(BIN.IMPRT);
WHILE import # NIL DO
IF import.label = 0 THEN
CHL.SetInt(ImportTable, i + 0, import.OriginalFirstThunk * SizeOfWord + SectionHeaders[3].VirtualAddress + n * SIZE_OF_DWORD);
_import := program.imp_list.first(BIN.IMPRT);
WHILE _import # NIL DO
IF _import.label = 0 THEN
CHL.SetInt(ImportTable, i + 0, _import.OriginalFirstThunk * SizeOfWord + SectionHeaders[3].VirtualAddress + n * SIZE_OF_DWORD);
CHL.SetInt(ImportTable, i + 1, 0);
CHL.SetInt(ImportTable, i + 2, 0);
CHL.SetInt(ImportTable, i + 3, import.nameoffs + Size.Import + SectionHeaders[3].VirtualAddress);
CHL.SetInt(ImportTable, i + 4, import.FirstThunk * SizeOfWord + SectionHeaders[3].VirtualAddress + n * SIZE_OF_DWORD);
CHL.SetInt(ImportTable, i + 3, _import.nameoffs + Size.Import + SectionHeaders[3].VirtualAddress);
CHL.SetInt(ImportTable, i + 4, _import.FirstThunk * SizeOfWord + SectionHeaders[3].VirtualAddress + n * SIZE_OF_DWORD);
i := i + 5
END;
import := import.next(BIN.IMPRT)
_import := _import.next(BIN.IMPRT)
END;
CHL.SetInt(ImportTable, i + 0, 0);
@@ -649,14 +649,14 @@ BEGIN
CHL.SetInt(ImportTable, i + 3, 0);
CHL.SetInt(ImportTable, i + 4, 0);
import := program.imp_list.first(BIN.IMPRT);
WHILE import # NIL DO
IF import.label # 0 THEN
temp := import.nameoffs + Size.Import + SectionHeaders[3].VirtualAddress - 2;
CHL.SetInt(ImportTable, import.OriginalFirstThunk + n, temp);
CHL.SetInt(ImportTable, import.FirstThunk + n, temp)
_import := program.imp_list.first(BIN.IMPRT);
WHILE _import # NIL DO
IF _import.label # 0 THEN
temp := _import.nameoffs + Size.Import + SectionHeaders[3].VirtualAddress - 2;
CHL.SetInt(ImportTable, _import.OriginalFirstThunk + n, temp);
CHL.SetInt(ImportTable, _import.FirstThunk + n, temp)
END;
import := import.next(BIN.IMPRT)
_import := _import.next(BIN.IMPRT)
END;
FOR i := 0 TO n - 1 DO
@@ -671,7 +671,7 @@ BEGIN
END
END;
CHL.WriteToFile(program.import);
CHL.WriteToFile(program._import);
WR.Padding(FileAlignment);
IF dll THEN
source/PROG.ob07
+182 -136
View File
@@ -7,7 +7,7 @@
MODULE PROG;
IMPORT SCAN, LISTS, ARITH, ERRORS, C := COLLECTIONS, IL, UTILS, TARGETS;
IMPORT SCAN, LISTS, ARITH, ERRORS, C := COLLECTIONS, IL, UTILS, TARGETS, STRINGS;
CONST
@@ -24,7 +24,7 @@ CONST
tINTEGER* = 1; tBYTE* = 2; tCHAR* = 3; tSET* = 4;
tBOOLEAN* = 5; tREAL* = 6; tARRAY* = 7; tRECORD* = 8;
tPOINTER* = 9; tPROCEDURE* = 10; tSTRING* = 11; tNIL* = 12;
tCARD32* = 13; tANYREC* = 14; tWCHAR* = 15;
tCARD32* = 13; tANYREC* = 14; tWCHAR* = 15; tNONE* = 16;
BASICTYPES* = {tINTEGER, tBYTE, tCHAR, tSET, tBOOLEAN, tREAL, tCARD32, tWCHAR};
@@ -73,7 +73,7 @@ TYPE
OPTIONS* = RECORD
version*, stack*, ram*, rom*: INTEGER;
pic*: BOOLEAN;
pic*, lower*: BOOLEAN;
checking*: SET
END;
@@ -82,11 +82,11 @@ TYPE
UNIT* = POINTER TO rUNIT;
TYPE_* = POINTER TO rTYPE_;
_TYPE* = POINTER TO rTYPE;
FRWPTR* = POINTER TO RECORD (LISTS.ITEM)
type: TYPE_;
_type: _TYPE;
baseIdent: SCAN.IDENT;
linked: BOOLEAN;
@@ -100,7 +100,7 @@ TYPE
label*: INTEGER;
used*: BOOLEAN;
processed*: BOOLEAN;
import*: LISTS.ITEM;
_import*: LISTS.ITEM;
using*: LISTS.LIST;
enter*,
leave*: LISTS.ITEM
@@ -130,28 +130,28 @@ TYPE
PARAM* = POINTER TO rPARAM;
rTYPE_ = RECORD (LISTS.ITEM)
rTYPE = RECORD (LISTS.ITEM)
typ*: INTEGER;
size*: INTEGER;
parSize*: INTEGER;
length*: INTEGER;
align*: INTEGER;
base*: TYPE_;
base*: _TYPE;
fields*: LISTS.LIST;
params*: LISTS.LIST;
unit*: UNIT;
closed*: BOOLEAN;
num*: INTEGER;
call*: INTEGER;
import*: BOOLEAN;
_import*: BOOLEAN;
noalign*: BOOLEAN
END;
rFIELD = RECORD (LISTS.ITEM)
type*: TYPE_;
_type*: _TYPE;
name*: SCAN.IDENT;
export*: BOOLEAN;
offset*: INTEGER
@@ -161,7 +161,7 @@ TYPE
rPARAM = RECORD (LISTS.ITEM)
name*: SCAN.IDENT;
type*: TYPE_;
_type*: _TYPE;
vPar*: BOOLEAN;
offset*: INTEGER
@@ -172,10 +172,10 @@ TYPE
name*: SCAN.IDENT;
typ*: INTEGER;
export*: BOOLEAN;
import*: LISTS.ITEM;
_import*: LISTS.ITEM;
unit*: UNIT;
value*: ARITH.VALUE;
type*: TYPE_;
_type*: _TYPE;
stproc*: INTEGER;
global*: BOOLEAN;
scopeLvl*: INTEGER;
@@ -203,17 +203,18 @@ TYPE
stTypes*: RECORD
tINTEGER*, tBYTE*, tCHAR*, tWCHAR*, tSET*, tBOOLEAN*, tREAL*,
tSTRING*, tNIL*, tCARD32*, tANYREC*: TYPE_
tSTRING*, tNIL*, tCARD32*, tANYREC*, tNONE*: _TYPE
END
END;
DELIMPORT = PROCEDURE (import: LISTS.ITEM);
DELIMPORT = PROCEDURE (_import: LISTS.ITEM);
VAR
LowerCase: BOOLEAN;
idents: C.COLLECTION;
program*: PROGRAM;
@@ -241,9 +242,9 @@ VAR
BEGIN
IF varIdent.offset = -1 THEN
size := varIdent.type.size;
size := varIdent._type.size;
IF varIdent.global THEN
IF UTILS.Align(program.bss, varIdent.type.align) THEN
IF UTILS.Align(program.bss, varIdent._type.align) THEN
IF UTILS.maxint - program.bss >= size THEN
varIdent.offset := program.bss;
INC(program.bss, size)
@@ -334,8 +335,8 @@ BEGIN
item.typ := typ;
item.unit := NIL;
item.export := FALSE;
item.import := NIL;
item.type := NIL;
item._import := NIL;
item._type := NIL;
item.value.typ := 0;
item.stproc := 0;
@@ -345,7 +346,7 @@ BEGIN
IF item.typ IN {idPROC, idIMP} THEN
NEW(proc);
proc.import := NIL;
proc._import := NIL;
proc.label := 0;
proc.used := FALSE;
proc.processed := FALSE;
@@ -389,16 +390,16 @@ BEGIN
END UseProc;
PROCEDURE setVarsType* (unit: UNIT; type: TYPE_);
PROCEDURE setVarsType* (unit: UNIT; _type: _TYPE);
VAR
item: IDENT;
BEGIN
ASSERT(type # NIL);
ASSERT(_type # NIL);
item := unit.idents.last(IDENT);
WHILE (item # NIL) & (item.typ = idVAR) & (item.type = NIL) DO
item.type := type;
WHILE (item # NIL) & (item.typ = idVAR) & (item._type = NIL) DO
item._type := _type;
item := item.prev(IDENT)
END
END setVarsType;
@@ -477,10 +478,10 @@ BEGIN
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
IF del._type.typ IN BASICTYPES - {tREAL} + {tPOINTER, tPROCEDURE} THEN
lvar := IL.NewVar();
lvar.offset := del.offset;
lvar.size := del.type.size;
lvar.size := del._type.size;
IF del.typ = idVAR THEN
lvar.offset := -lvar.offset
END;
@@ -500,18 +501,18 @@ BEGIN
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;
BEGIN
ASSERT(unit # NIL);
ASSERT(type # NIL);
ASSERT(_type # NIL);
ASSERT(baseIdent # NIL);
NEW(newptr);
newptr.type := type;
newptr._type := _type;
newptr.baseIdent := baseIdent;
newptr.pos := pos;
newptr.linked := FALSE;
@@ -535,8 +536,8 @@ BEGIN
ident := getIdent(unit, item.baseIdent, TRUE);
IF (ident # NIL) THEN
IF (ident.typ = idTYPE) & (ident.type.typ = tRECORD) THEN
item.type.base := ident.type;
IF (ident.typ = idTYPE) & (ident._type.typ = tRECORD) THEN
item._type.base := ident._type;
item.linked := TRUE
ELSE
item.notRecord := TRUE;
@@ -554,7 +555,7 @@ BEGIN
END linkPtr;
PROCEDURE isTypeEq* (t1, t2: TYPE_): BOOLEAN;
PROCEDURE isTypeEq* (t1, t2: _TYPE): BOOLEAN;
VAR
res: BOOLEAN;
param1, param2: LISTS.ITEM;
@@ -572,7 +573,7 @@ BEGIN
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);
res := (param1(PARAM).vPar = param2(PARAM).vPar) & isTypeEq(param1(PARAM)._type, param2(PARAM)._type);
param1 := param1.next;
param2 := param2.next;
res := res & ((param1 # NIL) = (param2 # NIL))
@@ -590,7 +591,7 @@ BEGIN
END isTypeEq;
PROCEDURE isBaseOf* (t0, t1: TYPE_): BOOLEAN;
PROCEDURE isBaseOf* (t0, t1: _TYPE): BOOLEAN;
VAR
res: BOOLEAN;
@@ -613,12 +614,12 @@ BEGIN
END isBaseOf;
PROCEDURE isOpenArray* (t: TYPE_): BOOLEAN;
PROCEDURE isOpenArray* (t: _TYPE): BOOLEAN;
RETURN (t.typ = tARRAY) & (t.length = 0)
END isOpenArray;
PROCEDURE arrcomp* (src, dst: TYPE_): BOOLEAN;
PROCEDURE arrcomp* (src, dst: _TYPE): BOOLEAN;
RETURN (dst.typ = tARRAY) & isOpenArray(src) &
~isOpenArray(src.base) & ~isOpenArray(dst.base) &
isTypeEq(src.base, dst.base)
@@ -638,7 +639,7 @@ BEGIN
item := item.next(UNIT)
END;
IF (item = NIL) & (name.s = "SYSTEM") THEN
IF (item = NIL) & ((name.s = "SYSTEM") OR LowerCase & (name.s = "system")) THEN
item := program.sysunit
END
@@ -649,29 +650,36 @@ END getUnit;
PROCEDURE enterStTypes (unit: UNIT);
PROCEDURE enter (unit: UNIT; name: SCAN.LEXSTR; type: TYPE_);
PROCEDURE enter (unit: UNIT; name: SCAN.LEXSTR; _type: _TYPE);
VAR
ident: IDENT;
upper: SCAN.LEXSTR;
BEGIN
IF LowerCase THEN
ident := addIdent(unit, SCAN.enterid(name), idTYPE);
ident.type := type
ident._type := _type
END;
upper := name;
STRINGS.UpCase(upper);
ident := addIdent(unit, SCAN.enterid(upper), idTYPE);
ident._type := _type
END enter;
BEGIN
enter(unit, "INTEGER", program.stTypes.tINTEGER);
enter(unit, "BYTE", program.stTypes.tBYTE);
enter(unit, "CHAR", program.stTypes.tCHAR);
enter(unit, "SET", program.stTypes.tSET);
enter(unit, "BOOLEAN", program.stTypes.tBOOLEAN);
enter(unit, "integer", program.stTypes.tINTEGER);
enter(unit, "byte", program.stTypes.tBYTE);
enter(unit, "char", program.stTypes.tCHAR);
enter(unit, "set", program.stTypes.tSET);
enter(unit, "boolean", program.stTypes.tBOOLEAN);
IF TARGETS.RealSize # 0 THEN
enter(unit, "REAL", program.stTypes.tREAL)
enter(unit, "real", program.stTypes.tREAL)
END;
IF TARGETS.BitDepth >= 32 THEN
enter(unit, "WCHAR", program.stTypes.tWCHAR)
enter(unit, "wchar", program.stTypes.tWCHAR)
END
END enterStTypes;
@@ -682,57 +690,77 @@ PROCEDURE enterStProcs (unit: UNIT);
PROCEDURE EnterProc (unit: UNIT; name: SCAN.LEXSTR; proc: INTEGER);
VAR
ident: IDENT;
upper: SCAN.LEXSTR;
BEGIN
IF LowerCase THEN
ident := addIdent(unit, SCAN.enterid(name), idSTPROC);
ident.stproc := proc
ident.stproc := proc;
ident._type := program.stTypes.tNONE
END;
upper := name;
STRINGS.UpCase(upper);
ident := addIdent(unit, SCAN.enterid(upper), idSTPROC);
ident.stproc := proc;
ident._type := program.stTypes.tNONE
END EnterProc;
PROCEDURE EnterFunc (unit: UNIT; name: SCAN.LEXSTR; func: INTEGER);
VAR
ident: IDENT;
upper: SCAN.LEXSTR;
BEGIN
IF LowerCase THEN
ident := addIdent(unit, SCAN.enterid(name), idSTFUNC);
ident.stproc := func
ident.stproc := func;
ident._type := program.stTypes.tNONE
END;
upper := name;
STRINGS.UpCase(upper);
ident := addIdent(unit, SCAN.enterid(upper), idSTFUNC);
ident.stproc := func;
ident._type := program.stTypes.tNONE
END EnterFunc;
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);
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);
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 TARGETS.RealSize # 0 THEN
EnterProc(unit, "PACK", stPACK);
EnterProc(unit, "UNPK", stUNPK);
EnterFunc(unit, "FLOOR", stFLOOR);
EnterFunc(unit, "FLT", stFLT)
EnterProc(unit, "pack", stPACK);
EnterProc(unit, "unpk", stUNPK);
EnterFunc(unit, "floor", stFLOOR);
EnterFunc(unit, "flt", stFLT)
END;
IF TARGETS.BitDepth >= 32 THEN
EnterFunc(unit, "WCHR", stWCHR)
EnterFunc(unit, "wchr", stWCHR)
END;
IF TARGETS.Dispose THEN
EnterProc(unit, "DISPOSE", stDISPOSE)
EnterProc(unit, "dispose", stDISPOSE)
END
END enterStProcs;
@@ -776,7 +804,7 @@ BEGIN
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;
@@ -808,7 +836,7 @@ BEGIN
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;
@@ -823,7 +851,7 @@ BEGIN
field.name := name;
field.export := export;
field.type := NIL;
field._type := NIL;
field.offset := self.size;
LISTS.push(self.fields, field)
@@ -833,33 +861,33 @@ BEGIN
END addField;
PROCEDURE setFields* (self: TYPE_; type: TYPE_): BOOLEAN;
PROCEDURE setFields* (self: _TYPE; _type: _TYPE): BOOLEAN;
VAR
item: FIELD;
res: BOOLEAN;
BEGIN
ASSERT(type # NIL);
ASSERT(_type # NIL);
item := self.fields.first(FIELD);
WHILE (item # NIL) & (item.type # NIL) DO
WHILE (item # NIL) & (item._type # NIL) DO
item := item.next(FIELD)
END;
res := TRUE;
WHILE res & (item # NIL) & (item.type = NIL) DO
item.type := type;
WHILE res & (item # NIL) & (item._type = NIL) DO
item._type := _type;
IF ~self.noalign THEN
res := UTILS.Align(self.size, type.align)
res := UTILS.Align(self.size, _type.align)
ELSE
res := TRUE
END;
item.offset := self.size;
res := res & (UTILS.maxint - self.size >= type.size);
res := res & (UTILS.maxint - self.size >= _type.size);
IF res THEN
INC(self.size, type.size)
INC(self.size, _type.size)
END;
item := item.next(FIELD)
END
@@ -868,7 +896,7 @@ BEGIN
END setFields;
PROCEDURE getParam* (self: TYPE_; name: SCAN.IDENT): PARAM;
PROCEDURE getParam* (self: _TYPE; name: SCAN.IDENT): PARAM;
VAR
item: PARAM;
@@ -885,7 +913,7 @@ BEGIN
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;
@@ -899,7 +927,7 @@ BEGIN
NEW(param);
param.name := name;
param.type := NIL;
param._type := NIL;
param.vPar := vPar;
LISTS.push(self.params, param)
@@ -909,7 +937,7 @@ BEGIN
END addParam;
PROCEDURE Dim* (t: TYPE_): INTEGER;
PROCEDURE Dim* (t: _TYPE): INTEGER;
VAR
res: INTEGER;
@@ -923,14 +951,14 @@ BEGIN
END Dim;
PROCEDURE OpenBase* (t: TYPE_): TYPE_;
PROCEDURE OpenBase* (t: _TYPE): _TYPE;
BEGIN
WHILE isOpenArray(t) DO t := t.base END
RETURN t
END OpenBase;
PROCEDURE getFloatParamsPos* (self: TYPE_; maxoffs: INTEGER; VAR int, flt: INTEGER): SET;
PROCEDURE getFloatParamsPos* (self: _TYPE; maxoffs: INTEGER; VAR int, flt: INTEGER): SET;
VAR
res: SET;
param: PARAM;
@@ -941,7 +969,7 @@ BEGIN
flt := 0;
param := self.params.first(PARAM);
WHILE (param # NIL) & (param.offset <= maxoffs + STACK_FRAME) DO
IF ~param.vPar & (param.type.typ = tREAL) THEN
IF ~param.vPar & (param._type.typ = tREAL) THEN
INCL(res, param.offset - STACK_FRAME);
INC(flt)
END;
@@ -954,49 +982,49 @@ BEGIN
END getFloatParamsPos;
PROCEDURE setParams* (self: TYPE_; type: TYPE_);
PROCEDURE setParams* (self: _TYPE; _type: _TYPE);
VAR
item: LISTS.ITEM;
param: PARAM;
word, size: INTEGER;
BEGIN
ASSERT(type # NIL);
ASSERT(_type # NIL);
word := UTILS.target.bit_depth DIV 8;
item := self.params.first;
WHILE (item # NIL) & (item(PARAM).type # NIL) DO
WHILE (item # NIL) & (item(PARAM)._type # NIL) DO
item := item.next
END;
WHILE (item # NIL) & (item(PARAM).type = NIL) DO
WHILE (item # NIL) & (item(PARAM)._type = NIL) DO
param := item(PARAM);
param.type := type;
param._type := _type;
IF param.vPar THEN
IF type.typ = tRECORD THEN
IF _type.typ = tRECORD THEN
size := 2
ELSIF isOpenArray(type) THEN
size := Dim(type) + 1
ELSIF isOpenArray(_type) THEN
size := Dim(_type) + 1
ELSE
size := 1
END;
param.offset := self.parSize + ORD(type.typ = tRECORD) + Dim(type) + STACK_FRAME;
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
size := Dim(type) + 1
IF _type.typ IN {tRECORD, tARRAY} THEN
IF isOpenArray(_type) THEN
size := Dim(_type) + 1
ELSE
size := 1
END
ELSE
size := type.size;
size := _type.size;
ASSERT(UTILS.Align(size, word));
size := size DIV word
END;
param.offset := self.parSize + Dim(type) + STACK_FRAME;
param.offset := self.parSize + Dim(_type) + STACK_FRAME;
INC(self.parSize, size)
END;
@@ -1006,9 +1034,9 @@ BEGIN
END setParams;
PROCEDURE enterType* (typ, size, length: INTEGER; unit: UNIT): TYPE_;
PROCEDURE enterType* (typ, size, length: INTEGER; unit: UNIT): _TYPE;
VAR
t: TYPE_;
t: _TYPE;
BEGIN
NEW(t);
@@ -1029,7 +1057,7 @@ BEGIN
|64: t.call := default64
END;
t.import := FALSE;
t._import := FALSE;
t.noalign := FALSE;
t.parSize := 0;
@@ -1049,9 +1077,9 @@ BEGIN
END enterType;
PROCEDURE getType* (typ: INTEGER): TYPE_;
PROCEDURE getType* (typ: INTEGER): _TYPE;
VAR
res: TYPE_;
res: _TYPE;
BEGIN
@@ -1078,9 +1106,20 @@ VAR
PROCEDURE EnterProc (sys: UNIT; name: SCAN.LEXSTR; idtyp, proc: INTEGER);
VAR
ident: IDENT;
upper: SCAN.LEXSTR;
BEGIN
IF LowerCase THEN
ident := addIdent(sys, SCAN.enterid(name), idtyp);
ident.stproc := proc;
ident._type := program.stTypes.tNONE;
ident.export := TRUE
END;
upper := name;
STRINGS.UpCase(upper);
ident := addIdent(sys, SCAN.enterid(upper), idtyp);
ident.stproc := proc;
ident._type := program.stTypes.tNONE;
ident.export := TRUE
END EnterProc;
@@ -1088,43 +1127,48 @@ VAR
BEGIN
unit := newUnit(SCAN.enterid("$SYSTEM"));
EnterProc(unit, "ADR", idSYSFUNC, sysADR);
EnterProc(unit, "SIZE", idSYSFUNC, sysSIZE);
EnterProc(unit, "SADR", idSYSFUNC, sysSADR);
EnterProc(unit, "TYPEID", idSYSFUNC, sysTYPEID);
EnterProc(unit, "adr", idSYSFUNC, sysADR);
EnterProc(unit, "size", idSYSFUNC, sysSIZE);
EnterProc(unit, "sadr", idSYSFUNC, sysSADR);
EnterProc(unit, "typeid", idSYSFUNC, sysTYPEID);
EnterProc(unit, "GET", idSYSPROC, sysGET);
EnterProc(unit, "GET8", idSYSPROC, sysGET8);
EnterProc(unit, "PUT", idSYSPROC, sysPUT);
EnterProc(unit, "PUT8", idSYSPROC, sysPUT8);
EnterProc(unit, "CODE", idSYSPROC, sysCODE);
EnterProc(unit, "MOVE", idSYSPROC, sysMOVE);
EnterProc(unit, "get", idSYSPROC, sysGET);
EnterProc(unit, "get8", idSYSPROC, sysGET8);
EnterProc(unit, "put", idSYSPROC, sysPUT);
EnterProc(unit, "put8", idSYSPROC, sysPUT8);
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)
EnterProc(unit, "nop", idSYSPROC, sysNOP);
EnterProc(unit, "eint", idSYSPROC, sysEINT);
EnterProc(unit, "dint", idSYSPROC, sysDINT)
END;
*)
IF TARGETS.RealSize # 0 THEN
EnterProc(unit, "INF", idSYSFUNC, sysINF);
EnterProc(unit, "inf", idSYSFUNC, sysINF);
END;
IF TARGETS.CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64} THEN
EnterProc(unit, "COPY", idSYSPROC, sysCOPY)
EnterProc(unit, "copy", idSYSPROC, sysCOPY)
END;
IF TARGETS.BitDepth >= 32 THEN
EnterProc(unit, "WSADR", idSYSFUNC, sysWSADR);
EnterProc(unit, "PUT16", idSYSPROC, sysPUT16);
EnterProc(unit, "PUT32", idSYSPROC, sysPUT32);
EnterProc(unit, "GET16", idSYSPROC, sysGET16);
EnterProc(unit, "GET32", idSYSPROC, sysGET32);
EnterProc(unit, "wsadr", idSYSFUNC, sysWSADR);
EnterProc(unit, "put16", idSYSPROC, sysPUT16);
EnterProc(unit, "put32", idSYSPROC, sysPUT32);
EnterProc(unit, "get16", idSYSPROC, sysGET16);
EnterProc(unit, "get32", idSYSPROC, sysGET32);
ident := addIdent(unit, SCAN.enterid("CARD32"), idTYPE);
ident.type := program.stTypes.tCARD32;
IF LowerCase THEN
ident := addIdent(unit, SCAN.enterid("card32"), idTYPE);
ident._type := program.stTypes.tCARD32;
ident.export := TRUE
END;
ident := addIdent(unit, SCAN.enterid("CARD32"), idTYPE);
ident._type := program.stTypes.tCARD32;
ident.export := TRUE;
END;
closeUnit(unit);
@@ -1174,10 +1218,10 @@ BEGIN
WHILE proc # NIL DO
IF ~proc.used THEN
IF proc.import = NIL THEN
IF proc._import = NIL THEN
IL.delete2(proc.enter, proc.leave)
ELSE
DelImport(proc.import)
DelImport(proc._import)
END
END;
proc := proc.next(PROC)
@@ -1194,6 +1238,8 @@ END ResetLocSize;
PROCEDURE create* (options: OPTIONS);
BEGIN
LowerCase := options.lower;
SCAN.init(options.lower);
idents := C.create();
UTILS.SetBitDepth(TARGETS.BitDepth, TARGETS.RealSize = 8);
@@ -1242,7 +1288,7 @@ BEGIN
program.stTypes.tSTRING := enterType(tSTRING, TARGETS.WordSize, 0, NIL);
program.stTypes.tNIL := enterType(tNIL, TARGETS.WordSize, 0, NIL);
program.stTypes.tNONE := enterType(tNONE, 0, 0, NIL);
program.stTypes.tANYREC := enterType(tRECORD, 0, 0, NIL);
program.stTypes.tANYREC.closed := TRUE;
source/SCAN.ob07
+43 -37
View File
@@ -88,7 +88,7 @@ VAR
NewIdent: IDENT;
upto: BOOLEAN;
upto, LowerCase: BOOLEAN;
PROCEDURE nodecmp (a, b: AVL.DATA): INTEGER;
@@ -536,7 +536,7 @@ BEGIN
END close;
PROCEDURE init;
PROCEDURE init* (lower: BOOLEAN);
VAR
i: INTEGER;
delim: ARRAY 23 OF CHAR;
@@ -545,15 +545,23 @@ VAR
PROCEDURE enterkw (key: INTEGER; kw: LEXSTR);
VAR
id: IDENT;
upper: LEXSTR;
BEGIN
IF LowerCase THEN
id := enterid(kw);
id.key := key
END;
upper := kw;
S.UpCase(upper);
id := enterid(upper);
id.key := key
END enterkw;
BEGIN
upto := FALSE;
LowerCase := lower;
FOR i := 0 TO 255 DO
delimiters[i] := FALSE
@@ -573,43 +581,41 @@ BEGIN
idents := NIL;
enterkw(lxARRAY, "ARRAY");
enterkw(lxBEGIN, "BEGIN");
enterkw(lxBY, "BY");
enterkw(lxCASE, "CASE");
enterkw(lxCONST, "CONST");
enterkw(lxDIV, "DIV");
enterkw(lxDO, "DO");
enterkw(lxELSE, "ELSE");
enterkw(lxELSIF, "ELSIF");
enterkw(lxEND, "END");
enterkw(lxFALSE, "FALSE");
enterkw(lxFOR, "FOR");
enterkw(lxIF, "IF");
enterkw(lxIMPORT, "IMPORT");
enterkw(lxIN, "IN");
enterkw(lxIS, "IS");
enterkw(lxMOD, "MOD");
enterkw(lxMODULE, "MODULE");
enterkw(lxNIL, "NIL");
enterkw(lxOF, "OF");
enterkw(lxOR, "OR");
enterkw(lxPOINTER, "POINTER");
enterkw(lxPROCEDURE, "PROCEDURE");
enterkw(lxRECORD, "RECORD");
enterkw(lxREPEAT, "REPEAT");
enterkw(lxRETURN, "RETURN");
enterkw(lxTHEN, "THEN");
enterkw(lxTO, "TO");
enterkw(lxTRUE, "TRUE");
enterkw(lxTYPE, "TYPE");
enterkw(lxUNTIL, "UNTIL");
enterkw(lxVAR, "VAR");
enterkw(lxWHILE, "WHILE")
enterkw(lxARRAY, "array");
enterkw(lxBEGIN, "begin");
enterkw(lxBY, "by");
enterkw(lxCASE, "case");
enterkw(lxCONST, "const");
enterkw(lxDIV, "div");
enterkw(lxDO, "do");
enterkw(lxELSE, "else");
enterkw(lxELSIF, "elsif");
enterkw(lxEND, "end");
enterkw(lxFALSE, "false");
enterkw(lxFOR, "for");
enterkw(lxIF, "if");
enterkw(lxIMPORT, "import");
enterkw(lxIN, "in");
enterkw(lxIS, "is");
enterkw(lxMOD, "mod");
enterkw(lxMODULE, "module");
enterkw(lxNIL, "nil");
enterkw(lxOF, "of");
enterkw(lxOR, "or");
enterkw(lxPOINTER, "pointer");
enterkw(lxPROCEDURE, "procedure");
enterkw(lxRECORD, "record");
enterkw(lxREPEAT, "repeat");
enterkw(lxRETURN, "return");
enterkw(lxTHEN, "then");
enterkw(lxTO, "to");
enterkw(lxTRUE, "true");
enterkw(lxTYPE, "type");
enterkw(lxUNTIL, "until");
enterkw(lxVAR, "var");
enterkw(lxWHILE, "while")
END init;
BEGIN
init
END SCAN.
source/STATEMENTS.ob07
+257 -253
View File
File diff suppressed because it is too large. Load diff
source/UTILS.ob07
+1 -1
View File
@@ -23,7 +23,7 @@ CONST
max32* = 2147483647;
vMajor* = 1;
vMinor* = 40;
vMinor* = 41;
FILE_EXT* = ".ob07";
RTL_NAME* = "RTL";
source/X86.ob07
+3 -3
View File
@@ -2283,7 +2283,7 @@ VAR
dcount, i: INTEGER;
PROCEDURE import (imp: LISTS.LIST);
PROCEDURE _import (imp: LISTS.LIST);
VAR
lib: IL.IMPORT_LIB;
proc: IL.IMPORT_PROC;
@@ -2301,7 +2301,7 @@ VAR
lib := lib.next(IL.IMPORT_LIB)
END
END import;
END _import;
BEGIN
@@ -2353,7 +2353,7 @@ BEGIN
exp := exp.next(IL.EXPORT_PROC)
END;
import(IL.codes.import);
_import(IL.codes._import);
IL.set_bss(MAX(IL.codes.bss, MAX(IL.codes.dmin - CHL.Length(IL.codes.data), 4)));