diff --git a/Compiler b/Compiler index 8bf7570..1454f26 100644 Binary files a/Compiler and b/Compiler differ diff --git a/Compiler.exe b/Compiler.exe index c672110..0aed5db 100644 Binary files a/Compiler.exe and b/Compiler.exe differ diff --git a/doc/MSP430.txt b/doc/MSP430.txt index 248fe6f..cf95cb3 100644 --- a/doc/MSP430.txt +++ b/doc/MSP430.txt @@ -16,6 +16,8 @@ UTF-8 с BOM-сигнатурой. -ram размер ОЗУ в байтах (128 - 2048) по умолчанию 128 -rom размер ПЗУ в байтах (2048 - 24576) по умолчанию 2048 -nochk <"ptibcwra"> отключить проверки при выполнении + -lower разрешить ключевые слова и встроенные идентификаторы в + нижнем регистре параметр -nochk задается в виде строки из символов: "p" - указатели diff --git a/doc/STM32.txt b/doc/STM32.txt index 41bed2e..ad4baf5 100644 --- a/doc/STM32.txt +++ b/doc/STM32.txt @@ -16,6 +16,8 @@ UTF-8 с BOM-сигнатурой. -ram размер ОЗУ в килобайтах (4 - 65536) по умолчанию 4 -rom размер ПЗУ в килобайтах (16 - 65536) по умолчанию 16 -nochk <"ptibcwra"> отключить проверки при выполнении + -lower разрешить ключевые слова и встроенные идентификаторы в + нижнем регистре параметр -nochk задается в виде строки из символов: "p" - указатели diff --git a/doc/x86.txt b/doc/x86.txt index f584b8b..640a053 100644 --- a/doc/x86.txt +++ b/doc/x86.txt @@ -25,6 +25,8 @@ UTF-8 с BOM-сигнатурой. -stk размер стэка в мегабайтах (по умолчанию 2 Мб, допустимо от 1 до 32 Мб) -nochk <"ptibcwra"> отключить проверки при выполнении (см. ниже) + -lower разрешить ключевые слова и встроенные идентификаторы в + нижнем регистре -ver версия программы (только для kosdll) параметр -nochk задается в виде строки из символов: diff --git a/doc/x86_64.txt b/doc/x86_64.txt index c6a87aa..143bd0b 100644 --- a/doc/x86_64.txt +++ b/doc/x86_64.txt @@ -23,6 +23,8 @@ UTF-8 с BOM-сигнатурой. -stk размер стэка в мегабайтах (по умолчанию 2 Мб, допустимо от 1 до 32 Мб) -nochk <"ptibcwra"> отключить проверки при выполнении + -lower разрешить ключевые слова и встроенные идентификаторы в + нижнем регистре параметр -nochk задается в виде строки из символов: "p" - указатели diff --git a/lib/KolibriOS/API.ob07 b/lib/KolibriOS/API.ob07 index 00b0019..3e1619a 100644 --- a/lib/KolibriOS/API.ob07 +++ b/lib/KolibriOS/API.ob07 @@ -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; diff --git a/lib/KolibriOS/ColorDlg.ob07 b/lib/KolibriOS/ColorDlg.ob07 index e993d37..584b15b 100644 --- a/lib/KolibriOS/ColorDlg.ob07 +++ b/lib/KolibriOS/ColorDlg.ob07 @@ -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]); diff --git a/lib/KolibriOS/HOST.ob07 b/lib/KolibriOS/HOST.ob07 index 7876b7a..a3280b4 100644 --- a/lib/KolibriOS/HOST.ob07 +++ b/lib/KolibriOS/HOST.ob07 @@ -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; diff --git a/lib/KolibriOS/OpenDlg.ob07 b/lib/KolibriOS/OpenDlg.ob07 index 9bffd20..82d6bfb 100644 --- a/lib/KolibriOS/OpenDlg.ob07 +++ b/lib/KolibriOS/OpenDlg.ob07 @@ -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); diff --git a/lib/KolibriOS/RTL.ob07 b/lib/KolibriOS/RTL.ob07 index dd2fe9d..5f9e168 100644 --- a/lib/KolibriOS/RTL.ob07 +++ b/lib/KolibriOS/RTL.ob07 @@ -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); diff --git a/lib/KolibriOS/libimg.ob07 b/lib/KolibriOS/libimg.ob07 index 425f740..35e9f5d 100644 --- a/lib/KolibriOS/libimg.ob07 +++ b/lib/KolibriOS/libimg.ob07 @@ -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 ;; diff --git a/lib/Linux32/RTL.ob07 b/lib/Linux32/RTL.ob07 index dd2fe9d..5f9e168 100644 --- a/lib/Linux32/RTL.ob07 +++ b/lib/Linux32/RTL.ob07 @@ -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); diff --git a/lib/Linux64/RTL.ob07 b/lib/Linux64/RTL.ob07 index a8027ca..7b6bbfb 100644 --- a/lib/Linux64/RTL.ob07 +++ b/lib/Linux64/RTL.ob07 @@ -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); diff --git a/lib/RVM32I/FPU.ob07 b/lib/RVM32I/FPU.ob07 index 2e3391a..da30e4e 100644 --- a/lib/RVM32I/FPU.ob07 +++ b/lib/RVM32I/FPU.ob07 @@ -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; diff --git a/lib/RVM32I/Out.ob07 b/lib/RVM32I/Out.ob07 index b5264da..aad7567 100644 --- a/lib/RVM32I/Out.ob07 +++ b/lib/RVM32I/Out.ob07 @@ -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 + WHILE x < 1.0 DO + x := x * 10.0; + DEC(n) END; - width := width - 4; + + a := 10.0; + b := 1.0; + + WHILE a <= x DO + b := a; + a := a * 10.0; + INC(n) + END; + 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 x < 0.0 THEN - x := -x; - minus := TRUE + Char("-"); + x := -x ELSE - minus := FALSE + Char(20X) END; - WHILE x >= 10.0 DO - x := x / 10.0; - INC(e) + + 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; - WHILE (x < 1.0) & (x # 0.0) DO - x := x * 10.0; - DEC(e) - END; - IF x > 9.0 + d THEN - x := 1.0; - INC(e) - END; - FOR i := 1 TO n DO - Char(" ") - END; - IF minus THEN - x := -x - END; - Realp := Real; - _FixReal(x, width, width - 3); + Char("E"); - IF e >= 0 THEN - Char("+") + IF n >= 0 THEN + Char("+") ELSE - Char("-"); - e := ABS(e) + Char("-") END; - IF e < 10 THEN - Char("0") - END; - Int(e, 0) - END + 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; + 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; - _FixReal(x, width, p) + 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. \ No newline at end of file diff --git a/lib/RVM32I/RTL.ob07 b/lib/RVM32I/RTL.ob07 index 7fcb656..8e12fed 100644 --- a/lib/RVM32I/RTL.ob07 +++ b/lib/RVM32I/RTL.ob07 @@ -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; diff --git a/lib/RVM32I/Trap.ob07 b/lib/RVM32I/Trap.ob07 index fcb76d1..55bff41 100644 --- a/lib/RVM32I/Trap.ob07 +++ b/lib/RVM32I/Trap.ob07 @@ -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 *) diff --git a/lib/STM32CM3/FPU.ob07 b/lib/STM32CM3/FPU.ob07 index 2e3391a..da30e4e 100644 --- a/lib/STM32CM3/FPU.ob07 +++ b/lib/STM32CM3/FPU.ob07 @@ -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; diff --git a/lib/STM32CM3/RTL.ob07 b/lib/STM32CM3/RTL.ob07 index d434b47..255f812 100644 --- a/lib/STM32CM3/RTL.ob07 +++ b/lib/STM32CM3/RTL.ob07 @@ -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; diff --git a/lib/Windows32/RTL.ob07 b/lib/Windows32/RTL.ob07 index dd2fe9d..5f9e168 100644 --- a/lib/Windows32/RTL.ob07 +++ b/lib/Windows32/RTL.ob07 @@ -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); diff --git a/lib/Windows64/RTL.ob07 b/lib/Windows64/RTL.ob07 index a8027ca..7b6bbfb 100644 --- a/lib/Windows64/RTL.ob07 +++ b/lib/Windows64/RTL.ob07 @@ -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); diff --git a/samples/Linux/X11/animation/gr.ob07 b/samples/Linux/X11/animation/gr.ob07 index 09acf23..c22e75e 100644 --- a/samples/Linux/X11/animation/gr.ob07 +++ b/samples/Linux/X11/animation/gr.ob07 @@ -22,7 +22,7 @@ CONST EventButtonPressed* = 84; (* button, x, y, state *) EventButtonReleased* = 85; (* button, x, y, state *) (* mouse button 1-5 = Left, Middle, Right, Scroll wheel up, Scroll wheel down *) - + bit64 = ORD(unix.BIT_DEPTH = 64); TYPE EventPars* = ARRAY 5 OF INTEGER; @@ -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 : @@ -181,19 +181,19 @@ xkey / xbutton / xmotion: 24 any 4 sub_window 4 time_ms 4 x, y, x_root, IF (w # winWidth) & (h # winHeight) THEN ASSERT ((w >= 0) & (h >= 0)); IF w > ScreenWidth THEN w := ScreenWidth END; - IF h > ScreenHeight THEN h := ScreenHeight END; + IF h > ScreenHeight THEN h := ScreenHeight END; winWidth := w; winHeight := h; 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; diff --git a/samples/Linux/X11/filler/gr.ob07 b/samples/Linux/X11/filler/gr.ob07 index 09acf23..c22e75e 100644 --- a/samples/Linux/X11/filler/gr.ob07 +++ b/samples/Linux/X11/filler/gr.ob07 @@ -22,7 +22,7 @@ CONST EventButtonPressed* = 84; (* button, x, y, state *) EventButtonReleased* = 85; (* button, x, y, state *) (* mouse button 1-5 = Left, Middle, Right, Scroll wheel up, Scroll wheel down *) - + bit64 = ORD(unix.BIT_DEPTH = 64); TYPE EventPars* = ARRAY 5 OF INTEGER; @@ -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 : @@ -181,19 +181,19 @@ xkey / xbutton / xmotion: 24 any 4 sub_window 4 time_ms 4 x, y, x_root, IF (w # winWidth) & (h # winHeight) THEN ASSERT ((w >= 0) & (h >= 0)); IF w > ScreenWidth THEN w := ScreenWidth END; - IF h > ScreenHeight THEN h := ScreenHeight END; + IF h > ScreenHeight THEN h := ScreenHeight END; winWidth := w; winHeight := h; 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; diff --git a/samples/Windows/Console/hailst.ob07 b/samples/Windows/Console/hailst.ob07 index f18dbfd..ebe93f3 100644 --- a/samples/Windows/Console/hailst.ob07 +++ b/samples/Windows/Console/hailst.ob07 @@ -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; diff --git a/source/AMD64.ob07 b/source/AMD64.ob07 index dfaa67b..b28b316 100644 --- a/source/AMD64.ob07 +++ b/source/AMD64.ob07 @@ -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; diff --git a/source/BIN.ob07 b/source/BIN.ob07 index 14c94bc..d7fe333 100644 --- a/source/BIN.ob07 +++ b/source/BIN.ob07 @@ -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; @@ -84,10 +84,10 @@ BEGIN program.imp_list := LISTS.create(NIL); program.exp_list := LISTS.create(NIL); - program.data := CHL.CreateByteList(); - program.code := CHL.CreateByteList(); - program.import := CHL.CreateByteList(); - program.export := CHL.CreateByteList() + program.data := CHL.CreateByteList(); + program.code := CHL.CreateByteList(); + program._import := CHL.CreateByteList(); + program.export := CHL.CreateByteList() RETURN program END create; @@ -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) diff --git a/source/Compiler.ob07 b/source/Compiler.ob07 index 32b1aeb..c497603 100644 --- a/source/Compiler.ob07 +++ b/source/Compiler.ob07 @@ -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 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 set version of program (KolibriOS DLL)"); C.Ln; C.StringLn(" -ram set size of RAM in bytes (MSP430) or Kbytes (STM32)"); C.Ln; C.StringLn(" -rom set size of ROM in bytes (MSP430) or Kbytes (STM32)"); C.Ln; diff --git a/source/IL.ob07 b/source/IL.ob07 index 170b2b8..489c48e 100644 --- a/source/IL.ob07 +++ b/source/IL.ob07 @@ -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(); diff --git a/source/KOS.ob07 b/source/KOS.ob07 index 881f063..979a8cf 100644 --- a/source/KOS.ob07 +++ b/source/KOS.ob07 @@ -29,17 +29,17 @@ TYPE PROCEDURE Import* (program: BIN.PROGRAM; idata: INTEGER; VAR ImportTable: CHL.INTLIST; VAR len, libcount, size: INTEGER); VAR - i: INTEGER; - import: BIN.IMPRT; + i: INTEGER; + 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; diff --git a/source/MSCOFF.ob07 b/source/MSCOFF.ob07 index 0174aee..f732820 100644 --- a/source/MSCOFF.ob07 +++ b/source/MSCOFF.ob07 @@ -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); diff --git a/source/PARS.ob07 b/source/PARS.ob07 index f579571..a3f2078 100644 --- a/source/PARS.ob07 +++ b/source/PARS.ob07 @@ -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,33 +1076,39 @@ 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); - getpos(parser, pos); - endname := parser.lex.ident; - IF ~codeProc & (import = NIL) THEN - check(endname = name, pos, 60); - ExpectSym(parser, SCAN.lxSEMI); - Next(parser) - ELSE - IF endname = parser.unit.name THEN - ExpectSym(parser, SCAN.lxPOINT); - Next(parser); - endmod := TRUE - ELSIF endname = name THEN + Next(parser); + IF parser.sym = SCAN.lxIDENT THEN + getpos(parser, pos); + endname := parser.lex.ident; + IF ~codeProc & (_import = NIL) THEN + check(endname = name, pos, 60); ExpectSym(parser, SCAN.lxSEMI); Next(parser) ELSE - error(pos, 60) + IF endname = parser.unit.name THEN + ExpectSym(parser, SCAN.lxPOINT); + Next(parser); + endmod := TRUE + ELSIF endname = name THEN + ExpectSym(parser, SCAN.lxSEMI); + Next(parser) + ELSE + 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 diff --git a/source/PE32.ob07 b/source/PE32.ob07 index 26b5516..0ccedea 100644 --- a/source/PE32.ob07 +++ b/source/PE32.ob07 @@ -179,15 +179,15 @@ END Export; PROCEDURE GetProcCount (lib: BIN.IMPRT): INTEGER; VAR - import: BIN.IMPRT; - res: INTEGER; + 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 diff --git a/source/PROG.ob07 b/source/PROG.ob07 index 367819b..87cde88 100644 --- a/source/PROG.ob07 +++ b/source/PROG.ob07 @@ -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) @@ -330,12 +331,12 @@ BEGIN IF res THEN item := NewIdent(); - item.name := ident; - item.typ := typ; - item.unit := NIL; - item.export := FALSE; - item.import := NIL; - item.type := NIL; + item.name := ident; + item.typ := typ; + item.unit := NIL; + item.export := FALSE; + 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 - ident := addIdent(unit, SCAN.enterid(name), idTYPE); - ident.type := type + IF LowerCase THEN + ident := addIdent(unit, SCAN.enterid(name), idTYPE); + 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 - ident := addIdent(unit, SCAN.enterid(name), idSTPROC); - ident.stproc := proc + IF LowerCase THEN + ident := addIdent(unit, SCAN.enterid(name), idSTPROC); + 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 - ident := addIdent(unit, SCAN.enterid(name), idSTFUNC); - ident.stproc := func + IF LowerCase THEN + ident := addIdent(unit, SCAN.enterid(name), idSTFUNC); + 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; @@ -898,9 +926,9 @@ BEGIN IF res THEN NEW(param); - param.name := name; - param.type := NIL; - param.vPar := vPar; + param.name := name; + param._type := NIL; + param.vPar := vPar; LISTS.push(self.params, param) END @@ -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 - ident := addIdent(sys, SCAN.enterid(name), idtyp); + 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,42 +1127,47 @@ 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); + 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 + 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; diff --git a/source/SCAN.ob07 b/source/SCAN.ob07 index dcd8366..49527bb 100644 --- a/source/SCAN.ob07 +++ b/source/SCAN.ob07 @@ -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 - id := enterid(kw); + 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. \ No newline at end of file diff --git a/source/STATEMENTS.ob07 b/source/STATEMENTS.ob07 index 3529384..46d0269 100644 --- a/source/STATEMENTS.ob07 +++ b/source/STATEMENTS.ob07 @@ -48,7 +48,7 @@ TYPE variant, self: INTEGER; - type: PROG.TYPE_; + _type: PROG._TYPE; prev: CASE_LABEL @@ -75,7 +75,7 @@ VAR CPU: INTEGER; - tINTEGER, tBYTE, tCHAR, tWCHAR, tSET, tBOOLEAN, tREAL: PROG.TYPE_; + tINTEGER, tBYTE, tCHAR, tWCHAR, tSET, tBOOLEAN, tREAL: PROG._TYPE; PROCEDURE isExpr (e: PARS.EXPR): BOOLEAN; @@ -89,17 +89,17 @@ END isVar; PROCEDURE isBoolean (e: PARS.EXPR): BOOLEAN; - RETURN isExpr(e) & (e.type = tBOOLEAN) + RETURN isExpr(e) & (e._type = tBOOLEAN) END isBoolean; PROCEDURE isInteger (e: PARS.EXPR): BOOLEAN; - RETURN isExpr(e) & (e.type = tINTEGER) + RETURN isExpr(e) & (e._type = tINTEGER) END isInteger; PROCEDURE isByte (e: PARS.EXPR): BOOLEAN; - RETURN isExpr(e) & (e.type = tBYTE) + RETURN isExpr(e) & (e._type = tBYTE) END isByte; @@ -109,42 +109,42 @@ END isInt; PROCEDURE isReal (e: PARS.EXPR): BOOLEAN; - RETURN isExpr(e) & (e.type = tREAL) + RETURN isExpr(e) & (e._type = tREAL) END isReal; PROCEDURE isSet (e: PARS.EXPR): BOOLEAN; - RETURN isExpr(e) & (e.type = tSET) + RETURN isExpr(e) & (e._type = tSET) END isSet; PROCEDURE isString (e: PARS.EXPR): BOOLEAN; - RETURN (e.obj = eCONST) & (e.type.typ IN {PROG.tSTRING, PROG.tCHAR}) + RETURN (e.obj = eCONST) & (e._type.typ IN {PROG.tSTRING, PROG.tCHAR}) END isString; PROCEDURE isStringW (e: PARS.EXPR): BOOLEAN; - RETURN (e.obj = eCONST) & (e.type.typ IN {PROG.tSTRING, PROG.tCHAR, PROG.tWCHAR}) + RETURN (e.obj = eCONST) & (e._type.typ IN {PROG.tSTRING, PROG.tCHAR, PROG.tWCHAR}) END isStringW; PROCEDURE isChar (e: PARS.EXPR): BOOLEAN; - RETURN isExpr(e) & (e.type = tCHAR) + RETURN isExpr(e) & (e._type = tCHAR) END isChar; PROCEDURE isCharW (e: PARS.EXPR): BOOLEAN; - RETURN isExpr(e) & (e.type = tWCHAR) + RETURN isExpr(e) & (e._type = tWCHAR) END isCharW; PROCEDURE isPtr (e: PARS.EXPR): BOOLEAN; - RETURN isExpr(e) & (e.type.typ = PROG.tPOINTER) + RETURN isExpr(e) & (e._type.typ = PROG.tPOINTER) END isPtr; PROCEDURE isRec (e: PARS.EXPR): BOOLEAN; - RETURN isExpr(e) & (e.type.typ = PROG.tRECORD) + RETURN isExpr(e) & (e._type.typ = PROG.tRECORD) END isRec; @@ -154,27 +154,27 @@ END isRecPtr; PROCEDURE isArr (e: PARS.EXPR): BOOLEAN; - RETURN isExpr(e) & (e.type.typ = PROG.tARRAY) + RETURN isExpr(e) & (e._type.typ = PROG.tARRAY) END isArr; PROCEDURE isProc (e: PARS.EXPR): BOOLEAN; - RETURN isExpr(e) & (e.type.typ = PROG.tPROCEDURE) OR (e.obj IN {ePROC, eIMP}) + RETURN isExpr(e) & (e._type.typ = PROG.tPROCEDURE) OR (e.obj IN {ePROC, eIMP}) END isProc; PROCEDURE isNil (e: PARS.EXPR): BOOLEAN; - RETURN e.type.typ = PROG.tNIL + RETURN e._type.typ = PROG.tNIL END isNil; PROCEDURE isCharArray (e: PARS.EXPR): BOOLEAN; - RETURN isArr(e) & (e.type.base = tCHAR) + RETURN isArr(e) & (e._type.base = tCHAR) END isCharArray; PROCEDURE isCharArrayW (e: PARS.EXPR): BOOLEAN; - RETURN isArr(e) & (e.type.base = tWCHAR) + RETURN isArr(e) & (e._type.base = tWCHAR) END isCharArrayW; @@ -204,7 +204,7 @@ VAR BEGIN ASSERT(isString(e)); - IF e.type = tCHAR THEN + IF e._type = tCHAR THEN res := 1 ELSE res := LENGTH(e.value.string(SCAN.IDENT).s) @@ -237,7 +237,7 @@ VAR BEGIN ASSERT(isStringW(e)); - IF e.type.typ IN {PROG.tCHAR, PROG.tWCHAR} THEN + IF e._type.typ IN {PROG.tCHAR, PROG.tWCHAR} THEN res := 1 ELSE res := _length(e.value.string(SCAN.IDENT).s) @@ -261,14 +261,14 @@ PROCEDURE isStringW1 (e: PARS.EXPR): BOOLEAN; END isStringW1; -PROCEDURE assigncomp (e: PARS.EXPR; t: PROG.TYPE_): BOOLEAN; +PROCEDURE assigncomp (e: PARS.EXPR; t: PROG._TYPE): BOOLEAN; VAR res: BOOLEAN; BEGIN IF isExpr(e) OR (e.obj IN {ePROC, eIMP}) THEN - IF t = e.type THEN + IF t = e._type THEN res := TRUE ELSIF isInt(e) & (t.typ IN {PROG.tBYTE, PROG.tINTEGER}) THEN IF (e.obj = eCONST) & (t = tBYTE) THEN @@ -279,10 +279,10 @@ BEGIN ELSIF (e.obj = eCONST) & isChar(e) & (t = tWCHAR) OR isStringW1(e) & (t = tWCHAR) - OR PROG.isBaseOf(t, e.type) - OR ~PROG.isOpenArray(t) & ~PROG.isOpenArray(e.type) & PROG.isTypeEq(t, e.type) + OR PROG.isBaseOf(t, e._type) + OR ~PROG.isOpenArray(t) & ~PROG.isOpenArray(e._type) & PROG.isTypeEq(t, e._type) OR isNil(e) & (t.typ IN {PROG.tPOINTER, PROG.tPROCEDURE}) - OR PROG.arrcomp(e.type, t) + OR PROG.arrcomp(e._type, t) OR isString(e) & (t.typ = PROG.tARRAY) & (t.base = tCHAR) & (t.length > strlen(e)) OR isStringW(e) & (t.typ = PROG.tARRAY) & (t.base = tWCHAR) & (t.length > utf8strlen(e)) THEN @@ -331,9 +331,9 @@ BEGIN END; offset := string.offsetW ELSE - IF e.type.typ IN {PROG.tWCHAR, PROG.tCHAR} THEN + IF e._type.typ IN {PROG.tWCHAR, PROG.tCHAR} THEN offset := IL.putstrW1(ARITH.Int(e.value)) - ELSE (* e.type.typ = PROG.tSTRING *) + ELSE (* e._type.typ = PROG.tSTRING *) string := e.value.string(SCAN.IDENT); IF string.offsetW = -1 THEN string.offsetW := IL.putstrW(string.s); @@ -368,7 +368,7 @@ BEGIN END Float; -PROCEDURE assign (parser: PARS.PARSER; e: PARS.EXPR; VarType: PROG.TYPE_; line: INTEGER): BOOLEAN; +PROCEDURE assign (parser: PARS.PARSER; e: PARS.EXPR; VarType: PROG._TYPE; line: INTEGER): BOOLEAN; VAR res: BOOLEAN; label: INTEGER; @@ -376,7 +376,7 @@ VAR BEGIN IF isExpr(e) OR (e.obj IN {ePROC, eIMP}) THEN res := TRUE; - IF PROG.arrcomp(e.type, VarType) THEN + IF PROG.arrcomp(e._type, VarType) THEN IF ~PROG.isOpenArray(VarType) THEN IL.Const(VarType.length) @@ -443,19 +443,19 @@ BEGIN ELSE IL.AddCmd0(IL.opSAVE16) END - ELSIF PROG.isBaseOf(VarType, e.type) THEN + ELSIF PROG.isBaseOf(VarType, e._type) THEN IF VarType.typ = PROG.tPOINTER THEN IL.AddCmd0(IL.opSAVE) ELSE IL.AddCmd(IL.opCOPY, VarType.size) END - ELSIF (e.type.typ = PROG.tCARD32) & (VarType.typ = PROG.tCARD32) THEN + ELSIF (e._type.typ = PROG.tCARD32) & (VarType.typ = PROG.tCARD32) THEN IL.AddCmd0(IL.opSAVE32) - ELSIF ~PROG.isOpenArray(VarType) & ~PROG.isOpenArray(e.type) & PROG.isTypeEq(VarType, e.type) THEN + ELSIF ~PROG.isOpenArray(VarType) & ~PROG.isOpenArray(e._type) & PROG.isTypeEq(VarType, e._type) THEN IF e.obj = ePROC THEN IL.AssignProc(e.ident.proc.label) ELSIF e.obj = eIMP THEN - IL.AssignImpProc(e.ident.import) + IL.AssignImpProc(e.ident._import) ELSE IF VarType.typ = PROG.tPROCEDURE THEN IL.AddCmd0(IL.opSAVE) @@ -491,11 +491,11 @@ VAR PROCEDURE arrcomp (e: PARS.EXPR; p: PROG.PARAM): BOOLEAN; VAR - t1, t2: PROG.TYPE_; + t1, t2: PROG._TYPE; BEGIN - t1 := p.type; - t2 := e.type; + t1 := p._type; + t2 := e._type; WHILE (t2.typ = PROG.tARRAY) & PROG.isOpenArray(t1) DO t1 := t1.base; t2 := t2.base @@ -505,7 +505,7 @@ VAR END arrcomp; - PROCEDURE ArrLen (t: PROG.TYPE_; n: INTEGER): INTEGER; + PROCEDURE ArrLen (t: PROG._TYPE; n: INTEGER): INTEGER; VAR res: INTEGER; @@ -520,7 +520,7 @@ VAR END ArrLen; - PROCEDURE OpenArray (t, t2: PROG.TYPE_); + PROCEDURE OpenArray (t, t2: PROG._TYPE); VAR n, d1, d2: INTEGER; @@ -557,8 +557,8 @@ BEGIN IF p.vPar THEN PARS.check(isVar(e), pos, 93); - IF p.type.typ = PROG.tRECORD THEN - PARS.check(PROG.isBaseOf(p.type, e.type), pos, 66); + IF p._type.typ = PROG.tRECORD THEN + PARS.check(PROG.isBaseOf(p._type, e._type), pos, 66); IF e.obj = eVREC THEN IF e.ident # NIL THEN IL.AddCmd(IL.opVADR, e.ident.offset - 1) @@ -566,30 +566,30 @@ BEGIN IL.AddCmd0(IL.opPUSHT) END ELSE - IL.Const(e.type.num) + IL.Const(e._type.num) END; IL.AddCmd(IL.opPARAM, 2) - ELSIF PROG.isOpenArray(p.type) THEN + ELSIF PROG.isOpenArray(p._type) THEN PARS.check(arrcomp(e, p), pos, 66); - OpenArray(e.type, p.type) + OpenArray(e._type, p._type) ELSE - PARS.check(PROG.isTypeEq(e.type, p.type), pos, 66); + PARS.check(PROG.isTypeEq(e._type, p._type), pos, 66); IL.Param1 END; PARS.check(~e.readOnly, pos, 94) ELSE PARS.check(isExpr(e) OR isProc(e), pos, 66); - IF PROG.isOpenArray(p.type) THEN - IF e.type.typ = PROG.tARRAY THEN + IF PROG.isOpenArray(p._type) THEN + IF e._type.typ = PROG.tARRAY THEN PARS.check(arrcomp(e, p), pos, 66); - OpenArray(e.type, p.type) - ELSIF isString(e) & (p.type.typ = PROG.tARRAY) & (p.type.base = tCHAR) THEN + OpenArray(e._type, p._type) + 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 + ELSIF isStringW(e) & (p._type.typ = PROG.tARRAY) & (p._type.base = tWCHAR) THEN IL.StrAdr(StringW(e)); IL.Param1; IL.Const(utf8strlen(e) + 1); @@ -598,31 +598,31 @@ BEGIN PARS.error(pos, 66) END ELSE - PARS.check(~PROG.isOpenArray(e.type), pos, 66); - PARS.check(assigncomp(e, p.type), 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 = tREAL THEN + IF e._type = tREAL THEN Float(parser, e); IL.AddCmd0(IL.opPUSHF) - ELSIF e.type.typ = PROG.tNIL THEN + ELSIF e._type.typ = PROG.tNIL THEN IL.Const(0); IL.Param1 - ELSIF isStringW1(e) & (p.type = tWCHAR) THEN + 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 - IF p.type.base = tCHAR THEN + 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 + IF p._type.base = tCHAR THEN stroffs := String(e); IL.StrAdr(stroffs); - IF (CPU = TARGETS.cpuMSP430) & (p.type.size - strlen(e) - 1 > MSP430.IntVectorSize) THEN + IF (CPU = TARGETS.cpuMSP430) & (p._type.size - strlen(e) - 1 > MSP430.IntVectorSize) THEN ERRORS.WarningMsg(pos.line, pos.col, 0) END ELSE (* WCHAR *) stroffs := StringW(e); IL.StrAdr(stroffs) END; - IL.set_dmin(stroffs + p.type.size); + IL.set_dmin(stroffs + p._type.size); IL.Param1 ELSE LoadConst(e); @@ -633,12 +633,12 @@ BEGIN IL.PushProc(e.ident.proc.label); IL.Param1 ELSIF e.obj = eIMP THEN - IL.PushImpProc(e.ident.import); + IL.PushImpProc(e.ident._import); IL.Param1 - ELSIF isExpr(e) & (e.type = tREAL) THEN + ELSIF isExpr(e) & (e._type = tREAL) THEN IL.AddCmd0(IL.opPUSHF) ELSE - IF (p.type = tBYTE) & (e.type = tINTEGER) & (chkBYTE IN Options.checking) THEN + IF (p._type = tBYTE) & (e._type = tINTEGER) & (chkBYTE IN Options.checking) THEN CheckRange(256, pos.line, errBYTE) END; IL.Param1 @@ -735,7 +735,7 @@ BEGIN |PROG.stINC, PROG.stDEC: IL.pushBegEnd(begcall, endcall); varparam(parser, pos, isInt, TRUE, e); - IF e.type = tINTEGER THEN + IF e._type = tINTEGER THEN IF parser.sym = SCAN.lxCOMMA THEN NextPos(parser, pos); IL.setlast(begcall); @@ -750,7 +750,7 @@ BEGIN ELSE IL.AddCmd(IL.opINCC, ORD(proc = PROG.stINC) * 2 - 1) END - ELSE (* e.type = tBYTE *) + ELSE (* e._type = tBYTE *) IF parser.sym = SCAN.lxCOMMA THEN NextPos(parser, pos); IL.setlast(begcall); @@ -788,9 +788,9 @@ BEGIN |PROG.stNEW: varparam(parser, pos, isPtr, TRUE, e); IF CPU = TARGETS.cpuMSP430 THEN - PARS.check(e.type.base.size + 16 < Options.ram, pos, 63) + PARS.check(e._type.base.size + 16 < Options.ram, pos, 63) END; - IL.New(e.type.base.size, e.type.base.num) + IL.New(e._type.base.size, e._type.base.num) |PROG.stDISPOSE: varparam(parser, pos, isPtr, TRUE, e); @@ -826,8 +826,8 @@ BEGIN PARS.error(pos, 66) END; - IF isCharArrayX(e) & ~PROG.isOpenArray(e.type) THEN - IL.Const(e.type.length) + IF isCharArrayX(e) & ~PROG.isOpenArray(e._type) THEN + IL.Const(e._type.length) END; PARS.checklex(parser, SCAN.lxCOMMA); @@ -843,11 +843,11 @@ BEGIN varparam(parser, pos, isCharArray, TRUE, e1) END; - wchar := e1.type.base = tWCHAR + wchar := e1._type.base = tWCHAR END; - IF ~PROG.isOpenArray(e1.type) THEN - IL.Const(e1.type.length) + IF ~PROG.isOpenArray(e1._type) THEN + IL.Const(e1._type.length) END; IL.setlast(endcall.prev(IL.COMMAND)); @@ -861,7 +861,7 @@ BEGIN IL.Const(strlen(e) + 1) END END; - IL.AddCmd(IL.opCOPYS, e1.type.base.size); + IL.AddCmd(IL.opCOPYS, e1._type.base.size); IL.popBegEnd(begcall, endcall) |PROG.sysGET, PROG.sysGET8, PROG.sysGET16, PROG.sysGET32: @@ -872,19 +872,19 @@ BEGIN parser.designator(parser, e2); PARS.check(isVar(e2), pos, 93); IF proc = PROG.sysGET THEN - PARS.check(e2.type.typ IN PROG.BASICTYPES + {PROG.tPOINTER, PROG.tPROCEDURE}, pos, 66) + PARS.check(e2._type.typ IN PROG.BASICTYPES + {PROG.tPOINTER, PROG.tPROCEDURE}, pos, 66) ELSE - PARS.check(e2.type.typ IN {PROG.tINTEGER, PROG.tBYTE, PROG.tCHAR, PROG.tSET, PROG.tWCHAR, PROG.tCARD32}, pos, 66) + PARS.check(e2._type.typ IN {PROG.tINTEGER, PROG.tBYTE, PROG.tCHAR, PROG.tSET, PROG.tWCHAR, PROG.tCARD32}, pos, 66) END; CASE proc OF - |PROG.sysGET: size := e2.type.size + |PROG.sysGET: size := e2._type.size |PROG.sysGET8: size := 1 |PROG.sysGET16: size := 2 |PROG.sysGET32: size := 4 END; - PARS.check(size <= e2.type.size, pos, 66); + PARS.check(size <= e2._type.size, pos, 66); IF e.obj = eCONST THEN IL.AddCmd2(IL.opGETC, ARITH.Int(e.value), size) @@ -906,30 +906,30 @@ BEGIN PARS.check(isExpr(e2), pos, 66); IF proc = PROG.sysPUT THEN - PARS.check(e2.type.typ IN PROG.BASICTYPES + {PROG.tPOINTER, PROG.tPROCEDURE}, pos, 66); + PARS.check(e2._type.typ IN PROG.BASICTYPES + {PROG.tPOINTER, PROG.tPROCEDURE}, pos, 66); IF e2.obj = eCONST THEN - IF e2.type = tREAL THEN + IF e2._type = tREAL THEN Float(parser, e2); IL.setlast(endcall.prev(IL.COMMAND)); IL.savef(FALSE) ELSE LoadConst(e2); IL.setlast(endcall.prev(IL.COMMAND)); - IL.SysPut(e2.type.size) + IL.SysPut(e2._type.size) END ELSE IL.setlast(endcall.prev(IL.COMMAND)); - IF e2.type = tREAL THEN + IF e2._type = tREAL THEN IL.savef(FALSE) - ELSIF e2.type = tBYTE THEN + ELSIF e2._type = tBYTE THEN IL.SysPut(tINTEGER.size) ELSE - IL.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.tSET, PROG.tWCHAR, PROG.tCARD32}, pos, 66); + PARS.check(e2._type.typ IN {PROG.tINTEGER, PROG.tBYTE, PROG.tCHAR, PROG.tSET, PROG.tWCHAR, PROG.tCARD32}, pos, 66); IF e2.obj = eCONST THEN LoadConst(e2) END; @@ -966,7 +966,7 @@ BEGIN FOR i := 1 TO 2 DO parser.designator(parser, e); PARS.check(isVar(e), pos, 93); - n := PROG.Dim(e.type); + n := PROG.Dim(e._type); WHILE n > 0 DO IL.drop; DEC(n) @@ -1018,7 +1018,7 @@ BEGIN END; e.obj := eEXPR; - e.type := NIL + e._type := NIL ELSIF e.obj IN {eSTFUNC, eSYSFUNC} THEN @@ -1039,7 +1039,7 @@ BEGIN NextPos(parser, pos); PExpression(parser, e2); PARS.check(isInt(e2), pos, 66); - e.type := tINTEGER; + e._type := tINTEGER; IF (e.obj = eCONST) & (e2.obj = eCONST) THEN ASSERT(ARITH.opInt(e.value, e2.value, shift_minmax(proc))) ELSE @@ -1056,7 +1056,7 @@ BEGIN |PROG.stCHR: PExpression(parser, e); PARS.check(isInt(e), pos, 66); - e.type := tCHAR; + e._type := tCHAR; IF e.obj = eCONST THEN ARITH.setChar(e.value, ARITH.getInt(e.value)); PARS.check(ARITH.check(e.value), pos, 107) @@ -1071,7 +1071,7 @@ BEGIN |PROG.stWCHR: PExpression(parser, e); PARS.check(isInt(e), pos, 66); - e.type := tWCHAR; + e._type := tWCHAR; IF e.obj = eCONST THEN ARITH.setWChar(e.value, ARITH.getInt(e.value)); PARS.check(ARITH.check(e.value), pos, 101) @@ -1086,7 +1086,7 @@ BEGIN |PROG.stFLOOR: PExpression(parser, e); PARS.check(isReal(e), pos, 66); - e.type := tINTEGER; + e._type := tINTEGER; IF e.obj = eCONST THEN PARS.check(ARITH.floor(e.value), pos, 39) ELSE @@ -1096,7 +1096,7 @@ BEGIN |PROG.stFLT: PExpression(parser, e); PARS.check(isInt(e), pos, 66); - e.type := tREAL; + e._type := tREAL; IF e.obj = eCONST THEN ARITH.flt(e.value) ELSE @@ -1106,38 +1106,38 @@ BEGIN |PROG.stLEN: cmd1 := IL.getlast(); varparam(parser, pos, isArr, FALSE, e); - IF e.type.length > 0 THEN + IF e._type.length > 0 THEN cmd2 := IL.getlast(); IL.delete2(cmd1.next, cmd2); IL.setlast(cmd1); - ASSERT(ARITH.setInt(e.value, e.type.length)); + ASSERT(ARITH.setInt(e.value, e._type.length)); e.obj := eCONST ELSE - IL.len(PROG.Dim(e.type)) + IL.len(PROG.Dim(e._type)) END; - e.type := tINTEGER + e._type := tINTEGER |PROG.stLENGTH: PExpression(parser, e); IF isCharArray(e) THEN - IF e.type.length > 0 THEN - IL.Const(e.type.length) + IF e._type.length > 0 THEN + IL.Const(e._type.length) END; IL.AddCmd0(IL.opLENGTH) ELSIF isCharArrayW(e) THEN - IF e.type.length > 0 THEN - IL.Const(e.type.length) + IF e._type.length > 0 THEN + IL.Const(e._type.length) END; IL.AddCmd0(IL.opLENGTHW) ELSE PARS.error(pos, 66); END; - e.type := tINTEGER + e._type := tINTEGER |PROG.stODD: PExpression(parser, e); PARS.check(isInt(e), pos, 66); - e.type := tBOOLEAN; + e._type := tBOOLEAN; IF e.obj = eCONST THEN ARITH.odd(e.value) ELSE @@ -1158,7 +1158,7 @@ BEGIN IL.AddCmd0(IL.opORD) END END; - e.type := tINTEGER + e._type := tINTEGER |PROG.stBITS: PExpression(parser, e); @@ -1166,12 +1166,12 @@ BEGIN IF e.obj = eCONST THEN ARITH.bits(e.value) END; - e.type := tSET + e._type := tSET |PROG.sysADR: parser.designator(parser, e); IF isVar(e) THEN - n := PROG.Dim(e.type); + n := PROG.Dim(e._type); WHILE n > 0 DO IL.drop; DEC(n) @@ -1179,50 +1179,50 @@ BEGIN ELSIF e.obj = ePROC THEN IL.PushProc(e.ident.proc.label) ELSIF e.obj = eIMP THEN - IL.PushImpProc(e.ident.import) + IL.PushImpProc(e.ident._import) ELSE PARS.error(pos, 108) END; - e.type := tINTEGER + e._type := tINTEGER |PROG.sysSADR: PExpression(parser, e); PARS.check(isString(e), pos, 66); IL.StrAdr(String(e)); - e.type := tINTEGER; + e._type := tINTEGER; e.obj := eEXPR |PROG.sysWSADR: PExpression(parser, e); PARS.check(isStringW(e), pos, 66); IL.StrAdr(StringW(e)); - e.type := tINTEGER; + e._type := tINTEGER; e.obj := eEXPR |PROG.sysTYPEID: 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)) + 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.error(pos, 52) END; e.obj := eCONST; - e.type := tINTEGER + e._type := tINTEGER |PROG.sysINF: IL.AddCmd2(IL.opINF, pos.line, pos.col); e.obj := eEXPR; - e.type := tREAL + e._type := tREAL |PROG.sysSIZE: PExpression(parser, e); PARS.check(e.obj = eTYPE, pos, 68); - ASSERT(ARITH.setInt(e.value, e.type.size)); + ASSERT(ARITH.setInt(e.value, e._type.size)); e.obj := eCONST; - e.type := tINTEGER + e._type := tINTEGER END @@ -1242,7 +1242,7 @@ END stProc; PROCEDURE ActualParameters (parser: PARS.PARSER; VAR e: PARS.EXPR); VAR - proc: PROG.TYPE_; + proc: PROG._TYPE; param: LISTS.ITEM; e1: PARS.EXPR; pos: PARS.POSITION; @@ -1251,7 +1251,7 @@ BEGIN ASSERT(parser.sym = SCAN.lxLROUND); IF (e.obj IN {ePROC, eIMP}) OR isExpr(e) THEN - proc := e.type; + proc := e._type; PARS.check1(proc.typ = PROG.tPROCEDURE, parser, 86); PARS.Next(parser); @@ -1278,7 +1278,7 @@ BEGIN PARS.Next(parser); e.obj := eEXPR; - e.type := proc.base + e._type := proc.base ELSIF e.obj IN {eSTPROC, eSTFUNC, eSYSPROC, eSYSFUNC} THEN stProc(parser, e) @@ -1291,14 +1291,14 @@ END ActualParameters; PROCEDURE qualident (parser: PARS.PARSER; VAR e: PARS.EXPR); VAR - ident: PROG.IDENT; - import: BOOLEAN; - pos: PARS.POSITION; + ident: PROG.IDENT; + imp: BOOLEAN; + pos: PARS.POSITION; BEGIN PARS.checklex(parser, SCAN.lxIDENT); getpos(parser, pos); - import := FALSE; + imp := FALSE; ident := PROG.getIdent(parser.unit, parser.lex.ident, FALSE); PARS.check1(ident # NIL, parser, 48); IF ident.typ = PROG.idMODULE THEN @@ -1306,7 +1306,7 @@ BEGIN PARS.ExpectSym(parser, SCAN.lxIDENT); ident := PROG.getIdent(ident.unit, parser.lex.ident, FALSE); PARS.check1((ident # NIL) & ident.export, parser, 48); - import := TRUE + imp := TRUE END; PARS.Next(parser); @@ -1316,44 +1316,48 @@ BEGIN CASE ident.typ OF |PROG.idCONST: e.obj := eCONST; - e.type := ident.type; + e._type := ident._type; e.value := ident.value |PROG.idTYPE: - e.obj := eTYPE; - e.type := ident.type + e.obj := eTYPE; + e._type := ident._type |PROG.idVAR: - e.obj := eVAR; - e.type := ident.type; - e.readOnly := import + e.obj := eVAR; + e._type := ident._type; + e.readOnly := imp |PROG.idPROC: e.obj := ePROC; - e.type := ident.type + e._type := ident._type |PROG.idIMP: e.obj := eIMP; - e.type := ident.type + e._type := ident._type |PROG.idVPAR: - e.type := ident.type; - IF e.type.typ = PROG.tRECORD THEN + e._type := ident._type; + IF e._type.typ = PROG.tRECORD THEN e.obj := eVREC ELSE e.obj := eVPAR END |PROG.idPARAM: - e.obj := ePARAM; - e.type := ident.type; - e.readOnly := (e.type.typ IN {PROG.tRECORD, PROG.tARRAY}) + e.obj := ePARAM; + e._type := ident._type; + e.readOnly := (e._type.typ IN {PROG.tRECORD, PROG.tARRAY}) |PROG.idSTPROC: e.obj := eSTPROC; + e._type := ident._type; e.stproc := ident.stproc |PROG.idSTFUNC: e.obj := eSTFUNC; + e._type := ident._type; e.stproc := ident.stproc |PROG.idSYSPROC: e.obj := eSYSPROC; + e._type := ident._type; e.stproc := ident.stproc |PROG.idSYSFUNC: PARS.check(~parser.constexp, pos, 109); e.obj := eSYSFUNC; + e._type := ident._type; e.stproc := ident.stproc |PROG.idNONE: PARS.error(pos, 115) @@ -1372,7 +1376,7 @@ VAR BEGIN IF load THEN - IL.load(e.type.size) + IL.load(e._type.size) END; IF chkPTR IN Options.checking THEN @@ -1400,7 +1404,7 @@ VAR offset, n: INTEGER; BEGIN offset := e.ident.offset; - n := PROG.Dim(e.type); + n := PROG.Dim(e._type); WHILE n >= 0 DO IL.AddCmd(IL.opVADR, offset); DEC(offset); @@ -1418,15 +1422,15 @@ VAR 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 + IF (e._type.typ = PROG.tRECORD) OR ((e._type.typ = PROG.tARRAY) & (e._type.length > 0)) THEN IL.AddCmd(IL.opVADR, e.ident.offset) - ELSIF PROG.isOpenArray(e.type) THEN + ELSIF PROG.isOpenArray(e._type) THEN OpenArray(e) ELSE IL.AddCmd(IL.opLADR, e.ident.offset) END ELSIF e.obj IN {eVPAR, eVREC} THEN - IF PROG.isOpenArray(e.type) THEN + IF PROG.isOpenArray(e._type) THEN OpenArray(e) ELSE IL.AddCmd(IL.opVADR, e.ident.offset) @@ -1438,7 +1442,7 @@ VAR PROCEDURE OpenIdx (parser: PARS.PARSER; pos: PARS.POSITION; e: PARS.EXPR); VAR label, offset, n, k: INTEGER; - type: PROG.TYPE_; + _type: PROG._TYPE; BEGIN @@ -1451,11 +1455,11 @@ VAR IL.AddCmd(IL.opCHKIDX2, -1) END; - type := PROG.OpenBase(e.type); - IF type.size # 1 THEN - IL.AddCmd(IL.opMULC, type.size) + _type := PROG.OpenBase(e._type); + IF _type.size # 1 THEN + IL.AddCmd(IL.opMULC, _type.size) END; - n := PROG.Dim(e.type) - 1; + n := PROG.Dim(e._type) - 1; k := n; WHILE n > 0 DO IL.AddCmd0(IL.opMUL); @@ -1485,18 +1489,18 @@ BEGIN WHILE parser.sym = SCAN.lxPOINT DO getpos(parser, pos); - PARS.check1(isExpr(e) & (e.type.typ IN {PROG.tRECORD, PROG.tPOINTER}), parser, 73); - IF e.type.typ = PROG.tPOINTER THEN + PARS.check1(isExpr(e) & (e._type.typ IN {PROG.tRECORD, PROG.tPOINTER}), parser, 73); + IF e._type.typ = PROG.tPOINTER THEN deref(pos, e, TRUE, errPTR) END; PARS.ExpectSym(parser, SCAN.lxIDENT); - IF e.type.typ = PROG.tPOINTER THEN - e.type := e.type.base; + IF e._type.typ = PROG.tPOINTER THEN + e._type := e._type.base; e.readOnly := FALSE END; - field := PROG.getField(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; + e._type := field._type; IF e.obj = eVREC THEN e.obj := eVPAR END; @@ -1516,10 +1520,10 @@ BEGIN 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), pos, 83); + IF e._type.length > 0 THEN + PARS.check(ARITH.range(idx.value, 0, e._type.length - 1), pos, 83); IF ARITH.Int(idx.value) > 0 THEN - IL.AddCmd(IL.opADDC, ARITH.Int(idx.value) * e.type.base.size) + IL.AddCmd(IL.opADDC, ARITH.Int(idx.value) * e._type.base.size) END ELSE PARS.check(ARITH.range(idx.value, 0, UTILS.target.maxInt), pos, 83); @@ -1527,12 +1531,12 @@ BEGIN OpenIdx(parser, pos, e) END ELSE - IF e.type.length > 0 THEN + IF e._type.length > 0 THEN IF chkIDX IN Options.checking THEN - CheckRange(e.type.length, pos.line, errIDX) + CheckRange(e._type.length, pos.line, errIDX) END; - IF e.type.base.size # 1 THEN - IL.AddCmd(IL.opMULC, e.type.base.size) + IF e._type.base.size # 1 THEN + IL.AddCmd(IL.opMULC, e._type.base.size) END; IL.AddCmd0(IL.opADD) ELSE @@ -1540,7 +1544,7 @@ BEGIN END END; - e.type := e.type.base + e._type := e._type.base UNTIL parser.sym # SCAN.lxCOMMA; @@ -1552,41 +1556,41 @@ BEGIN getpos(parser, pos); PARS.check1(isPtr(e), parser, 77); deref(pos, e, TRUE, errPTR); - e.type := e.type.base; + e._type := e._type.base; e.readOnly := FALSE; PARS.Next(parser); e.ident := NIL; e.obj := eVREC - ELSIF (parser.sym = SCAN.lxLROUND) & isExpr(e) & (e.type.typ IN {PROG.tRECORD, PROG.tPOINTER}) DO + ELSIF (parser.sym = SCAN.lxLROUND) & isExpr(e) & (e._type.typ IN {PROG.tRECORD, PROG.tPOINTER}) DO - IF e.type.typ = PROG.tRECORD THEN + IF e._type.typ = PROG.tRECORD THEN PARS.check1(e.obj = eVREC, parser, 78) END; NextPos(parser, pos); qualident(parser, t); PARS.check(t.obj = eTYPE, pos, 79); - IF e.type.typ = PROG.tRECORD THEN - PARS.check(t.type.typ = PROG.tRECORD, pos, 80); + IF e._type.typ = PROG.tRECORD THEN + PARS.check(t._type.typ = PROG.tRECORD, pos, 80); IF chkGUARD IN Options.checking THEN IF e.ident = NIL THEN - IL.TypeGuard(IL.opTYPEGD, t.type.num, pos.line, errGUARD) + IL.TypeGuard(IL.opTYPEGD, t._type.num, pos.line, errGUARD) ELSE IL.AddCmd(IL.opVADR, e.ident.offset - 1); - IL.TypeGuard(IL.opTYPEGR, t.type.num, pos.line, errGUARD) + IL.TypeGuard(IL.opTYPEGR, t._type.num, pos.line, errGUARD) END END; ELSE - PARS.check(t.type.typ = PROG.tPOINTER, pos, 81); + 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) + IL.TypeGuard(IL.opTYPEGP, t._type.base.num, pos.line, errGUARD) END END; - PARS.check(PROG.isBaseOf(e.type, t.type), pos, 82); + PARS.check(PROG.isBaseOf(e._type, t._type), pos, 82); - e.type := t.type; + e._type := t._type; PARS.checklex(parser, SCAN.lxRROUND); PARS.Next(parser) @@ -1596,7 +1600,7 @@ BEGIN END designator; -PROCEDURE ProcCall (e: PARS.EXPR; procType: PROG.TYPE_; isfloat: BOOLEAN; parser: PARS.PARSER; pos: PARS.POSITION; CallStat: BOOLEAN); +PROCEDURE ProcCall (e: PARS.EXPR; procType: PROG._TYPE; isfloat: BOOLEAN; parser: PARS.PARSER; pos: PARS.POSITION; CallStat: BOOLEAN); VAR cconv, parSize, @@ -1633,7 +1637,7 @@ BEGIN IL.setlast(endcall.prev(IL.COMMAND)); IF e.obj = eIMP THEN - IL.CallImp(e.ident.import, callconv, fparSize) + IL.CallImp(e.ident._import, callconv, fparSize) ELSIF e.obj = ePROC THEN IL.Call(e.ident.proc.label, callconv, fparSize) ELSIF isExpr(e) THEN @@ -1728,7 +1732,7 @@ VAR END END; - e.type := tSET; + e._type := tSET; IF (e1.obj = eCONST) & (e2.obj = eCONST) THEN ARITH.constrSet(e.value, e1.value, e2.value); @@ -1759,7 +1763,7 @@ VAR ASSERT(parser.sym = SCAN.lxLCURLY); e.obj := eCONST; - e.type := tSET; + e._type := tSET; ARITH.emptySet(e.value); PARS.Next(parser); @@ -1804,11 +1808,11 @@ VAR 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 = tREAL THEN + IF ~(e._type.typ IN {PROG.tRECORD, PROG.tARRAY}) THEN + IF e._type = tREAL THEN IL.AddCmd2(IL.opLOADF, pos.line, pos.col) ELSE - IL.load(e.type.size) + IL.load(e._type.size) END END END LoadVar; @@ -1820,18 +1824,18 @@ VAR 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 := PROG.getType(e.value.typ); + e._type := PROG.getType(e.value.typ); PARS.Next(parser) ELSIF sym = SCAN.lxNIL THEN e.obj := eCONST; - e.type := PROG.program.stTypes.tNIL; + e._type := PROG.program.stTypes.tNIL; PARS.Next(parser) ELSIF (sym = SCAN.lxTRUE) OR (sym = SCAN.lxFALSE) THEN e.obj := eCONST; ARITH.setbool(e.value, sym = SCAN.lxTRUE); - e.type := tBOOLEAN; + e._type := tBOOLEAN; PARS.Next(parser) ELSIF sym = SCAN.lxLCURLY THEN @@ -1849,12 +1853,12 @@ VAR IF parser.sym = SCAN.lxLROUND THEN e1 := e; ActualParameters(parser, e); - PARS.check(e.type # NIL, pos, 59); - isfloat := e.type = 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, parser, pos, FALSE) + ProcCall(e1, e1.ident._type, isfloat, parser, pos, FALSE) ELSIF isExpr(e1) THEN - ProcCall(e1, e1.type, isfloat, parser, pos, FALSE) + ProcCall(e1, e1._type, isfloat, parser, pos, FALSE) END END; IL.popBegEnd(begcall, endcall) @@ -2154,7 +2158,7 @@ VAR PARS.check(ARITH.concat(s, s1), pos, 5); e.value.string := SCAN.enterid(s); e.value.typ := ARITH.tSTRING; - e.type := PROG.program.stTypes.tSTRING + e._type := PROG.program.stTypes.tSTRING END ELSE @@ -2312,8 +2316,8 @@ BEGIN getpos(parser, pos0); SimpleExpression(parser, e); IF relation(parser.sym) THEN - IF (isCharArray(e) OR isCharArrayW(e)) & (e.type.length # 0) THEN - IL.Const(e.type.length) + IF (isCharArray(e) OR isCharArrayW(e)) & (e._type.length # 0) THEN + IL.Const(e._type.length) END; op := parser.sym; getpos(parser, pos); @@ -2322,8 +2326,8 @@ BEGIN getpos(parser, pos1); SimpleExpression(parser, e1); - IF (isCharArray(e1) OR isCharArrayW(e1)) & (e1.type.length # 0) THEN - IL.Const(e1.type.length) + IF (isCharArray(e1) OR isCharArrayW(e1)) & (e1._type.length # 0) THEN + IL.Const(e1._type.length) END; constant := (e.obj = eCONST) & (e1.obj = eCONST); @@ -2337,7 +2341,7 @@ BEGIN isCharW(e) & isChar(e1) & (e1.obj = eCONST) OR isCharW(e1) & isChar(e) & (e.obj = eCONST) OR isCharW(e1) & (e1.obj = eCONST) & isChar(e) & (e.obj = eCONST) OR isCharW(e) & (e.obj = eCONST) & isChar(e1) & (e1.obj = eCONST) OR - isPtr(e) & isPtr(e1) & (PROG.isBaseOf(e.type, e1.type) OR PROG.isBaseOf(e1.type, e.type)) THEN + isPtr(e) & isPtr(e1) & (PROG.isBaseOf(e._type, e1._type) OR PROG.isBaseOf(e1._type, e._type)) THEN IF constant THEN ARITH.relation(e.value, e1.value, cmp, error) ELSE @@ -2413,7 +2417,7 @@ BEGIN IL.AddCmd0(IL.opEQC + cmp) END - ELSIF isProc(e) & isProc(e1) & PROG.isTypeEq(e.type, e1.type) THEN + ELSIF isProc(e) & isProc(e1) & PROG.isTypeEq(e._type, e1._type) THEN IF e.obj = ePROC THEN PARS.check(e.ident.global, pos0, 85) END; @@ -2433,9 +2437,9 @@ BEGIN ELSIF e1.obj = ePROC THEN IL.ProcCmp(e1.ident.proc.label, eq) ELSIF e.obj = eIMP THEN - IL.ProcImpCmp(e.ident.import, eq) + IL.ProcImpCmp(e.ident._import, eq) ELSIF e1.obj = eIMP THEN - IL.ProcImpCmp(e1.ident.import, eq) + IL.ProcImpCmp(e1.ident._import, eq) ELSE IL.AddCmd0(IL.opEQ + cmp) END @@ -2520,25 +2524,25 @@ BEGIN IF isRec(e) THEN PARS.check(e.obj = eVREC, pos0, 78); - PARS.check(e1.type.typ = PROG.tRECORD, pos1, 80); + PARS.check(e1._type.typ = PROG.tRECORD, pos1, 80); IF e.ident = NIL THEN - IL.TypeCheck(e1.type.num) + IL.TypeCheck(e1._type.num) ELSE IL.AddCmd(IL.opVADR, e.ident.offset - 1); - IL.TypeCheckRec(e1.type.num) + IL.TypeCheckRec(e1._type.num) END ELSE - PARS.check(e1.type.typ = PROG.tPOINTER, pos1, 81); - IL.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), pos1, 82) + PARS.check(PROG.isBaseOf(e._type, e1._type), pos1, 82) END; ASSERT(error = 0); - e.type := tBOOLEAN; + e._type := tBOOLEAN; IF ~constant THEN e.obj := eEXPR @@ -2574,7 +2578,7 @@ BEGIN IL.setlast(endcall.prev(IL.COMMAND)); - PARS.check(assign(parser, e1, e.type, line), pos, 91); + PARS.check(assign(parser, e1, e._type, line), pos, 91); IF e1.obj = ePROC THEN PARS.check(e1.ident.global, pos, 85) END; @@ -2584,7 +2588,7 @@ BEGIN ELSIF parser.sym = SCAN.lxLROUND THEN e1 := e; ActualParameters(parser, e1); - PARS.check((e1.type = NIL) OR ODD(e.type.call), pos, 92); + PARS.check((e1._type = NIL) OR ODD(e._type.call), pos, 92); call := TRUE ELSE IF e.obj IN {eSYSPROC, eSTPROC} THEN @@ -2592,17 +2596,17 @@ BEGIN 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); + 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 IF e.obj IN {ePROC, eIMP} THEN - ProcCall(e, e.ident.type, FALSE, parser, pos, TRUE) + ProcCall(e, e.ident._type, FALSE, parser, pos, TRUE) ELSIF isExpr(e) THEN - ProcCall(e, e.type, FALSE, parser, pos, TRUE) + ProcCall(e, e._type, FALSE, parser, pos, TRUE) END END; @@ -2610,7 +2614,7 @@ BEGIN END ElementaryStatement; -PROCEDURE IfStatement (parser: PARS.PARSER; if: BOOLEAN); +PROCEDURE IfStatement (parser: PARS.PARSER; _if: BOOLEAN); VAR e: PARS.EXPR; pos: PARS.POSITION; @@ -2620,7 +2624,7 @@ VAR BEGIN L := IL.NewLabel(); - IF ~if THEN + IF ~_if THEN IL.AddCmd0(IL.opLOOP); IL.SetLabel(L) END; @@ -2641,7 +2645,7 @@ BEGIN IL.AddJmpCmd(IL.opJNE, label) END; - IF if THEN + IF _if THEN PARS.checklex(parser, SCAN.lxTHEN) ELSE PARS.checklex(parser, SCAN.lxDO) @@ -2650,14 +2654,14 @@ BEGIN PARS.Next(parser); parser.StatSeq(parser); - IF ~if OR (parser.sym # SCAN.lxEND) THEN + IF ~_if OR (parser.sym # SCAN.lxEND) THEN IL.AddJmpCmd(IL.opJMP, L) END; IL.SetLabel(label) UNTIL parser.sym # SCAN.lxELSIF; - IF if THEN + IF _if THEN IF parser.sym = SCAN.lxELSE THEN PARS.Next(parser); parser.StatSeq(parser) @@ -2667,7 +2671,7 @@ BEGIN PARS.checklex(parser, SCAN.lxEND); - IF ~if THEN + IF ~_if THEN IL.AddCmd0(IL.opENDLOOP) END; @@ -2759,7 +2763,7 @@ VAR pos: PARS.POSITION; - PROCEDURE Label (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR type: PROG.TYPE_): INTEGER; + PROCEDURE Label (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR _type: PROG._TYPE): INTEGER; VAR a: INTEGER; label: PARS.EXPR; @@ -2768,7 +2772,7 @@ VAR BEGIN getpos(parser, pos); - type := NIL; + _type := NIL; IF isChar(caseExpr) THEN PARS.ConstExpression(parser, value); @@ -2789,25 +2793,25 @@ VAR ELSIF isRecPtr(caseExpr) THEN qualident(parser, label); PARS.check(label.obj = eTYPE, pos, 79); - PARS.check(PROG.isBaseOf(caseExpr.type, label.type), pos, 99); + PARS.check(PROG.isBaseOf(caseExpr._type, label._type), pos, 99); IF isRec(caseExpr) THEN - a := label.type.num + a := label._type.num ELSE - a := label.type.base.num + a := label._type.base.num END; - type := label.type + _type := label._type END RETURN a END Label; - PROCEDURE CheckType (node: AVL.NODE; type: PROG.TYPE_; parser: PARS.PARSER; pos: PARS.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)), pos, 100); - CheckType(node.left, type, parser, pos); - CheckType(node.right, type, parser, pos) + 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 END CheckType; @@ -2833,12 +2837,12 @@ VAR label.self := IL.NewLabel(); getpos(parser, pos1); - range.a := Label(parser, caseExpr, label.type); + range.a := Label(parser, caseExpr, label._type); IF parser.sym = SCAN.lxRANGE THEN PARS.check1(~isRecPtr(caseExpr), parser, 53); NextPos(parser, pos); - range.b := Label(parser, caseExpr, label.type); + range.b := Label(parser, caseExpr, label._type); PARS.check(range.a <= range.b, pos, 103) ELSE range.b := range.a @@ -2847,7 +2851,7 @@ VAR label.range := range; IF isRecPtr(caseExpr) THEN - CheckType(tree, label.type, parser, pos1) + CheckType(tree, label._type, parser, pos1) END; tree := AVL.insert(tree, label, LabelCmp, newnode, node); PARS.check(newnode, pos1, 100) @@ -2878,10 +2882,10 @@ VAR END CaseLabelList; - PROCEDURE case (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR tree: AVL.NODE; end: INTEGER); + PROCEDURE _case (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR tree: AVL.NODE; _end: INTEGER); VAR sym: INTEGER; - t: PROG.TYPE_; + t: PROG._TYPE; variant: INTEGER; node: AVL.NODE; last: IL.COMMAND; @@ -2894,8 +2898,8 @@ VAR PARS.checklex(parser, SCAN.lxCOLON); PARS.Next(parser); IF isRecPtr(caseExpr) THEN - t := caseExpr.type; - caseExpr.ident.type := node.data(CASE_LABEL).type + t := caseExpr._type; + caseExpr.ident._type := node.data(CASE_LABEL)._type END; last := IL.getlast(); @@ -2906,16 +2910,16 @@ VAR END; parser.StatSeq(parser); - IL.AddJmpCmd(IL.opJMP, end); + IL.AddJmpCmd(IL.opJMP, _end); IF isRecPtr(caseExpr) THEN - caseExpr.ident.type := t + caseExpr.ident._type := t END END - END case; + END _case; - PROCEDURE Table (node: AVL.NODE; else: INTEGER); + PROCEDURE Table (node: AVL.NODE; _else: INTEGER); VAR L, R: INTEGER; range: RANGE; @@ -2932,14 +2936,14 @@ VAR IF left # NIL THEN L := left.data(CASE_LABEL).self ELSE - L := else + L := _else END; right := node.right; IF right # NIL THEN R := right.data(CASE_LABEL).self ELSE - R := else + R := _else END; last := IL.getlast(); @@ -2953,7 +2957,7 @@ VAR IL.setlast(v.cmd); IL.SetLabel(node.data(CASE_LABEL).self); - IL.case(range.a, range.b, L, R); + IL._case(range.a, range.b, L, R); IF v.processed THEN IL.AddJmpCmd(IL.opJMP, node.data(CASE_LABEL).variant) END; @@ -2961,8 +2965,8 @@ VAR IL.setlast(last); - Table(left, else); - Table(right, else) + Table(left, _else); + Table(right, _else) END END Table; @@ -2979,31 +2983,31 @@ VAR PROCEDURE ParseCase (parser: PARS.PARSER; e: PARS.EXPR; pos: PARS.POSITION); VAR - table, end, else: INTEGER; + table, _end, _else: INTEGER; tree: AVL.NODE; item: LISTS.ITEM; BEGIN LISTS.push(CaseVariants, NewVariant(0, NIL)); - end := IL.NewLabel(); - else := IL.NewLabel(); + _end := IL.NewLabel(); + _else := IL.NewLabel(); table := IL.NewLabel(); IL.AddCmd(IL.opSWITCH, ORD(isRecPtr(e))); IL.AddJmpCmd(IL.opJMP, table); tree := NIL; - case(parser, e, tree, end); + _case(parser, e, tree, _end); WHILE parser.sym = SCAN.lxBAR DO PARS.Next(parser); - case(parser, e, tree, end) + _case(parser, e, tree, _end) END; - IL.SetLabel(else); + IL.SetLabel(_else); IF parser.sym = SCAN.lxELSE THEN PARS.Next(parser); parser.StatSeq(parser); - IL.AddJmpCmd(IL.opJMP, end) + IL.AddJmpCmd(IL.opJMP, _end) ELSE IL.OnError(pos.line, errCASE) END; @@ -3014,14 +3018,14 @@ VAR IF isRecPtr(e) THEN IL.SetLabel(table); TableT(tree); - IL.AddJmpCmd(IL.opJMP, else) + IL.AddJmpCmd(IL.opJMP, _else) ELSE tree.data(CASE_LABEL).self := table; - Table(tree, else) + Table(tree, _else) END; AVL.destroy(tree, DestroyLabel); - IL.SetLabel(end); + IL.SetLabel(_end); IL.AddCmd0(IL.opENDSW); REPEAT @@ -3082,7 +3086,7 @@ BEGIN 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 = tINTEGER, parser, 97); + PARS.check1(ident._type = tINTEGER, parser, 97); PARS.ExpectSym(parser, SCAN.lxASSIGN); NextPos(parser, pos); expression(parser, e); @@ -3109,7 +3113,7 @@ BEGIN ELSE IL.AddCmd(IL.opLADR, -offset) END; - IL.load(ident.type.size); + IL.load(ident._type.size); PARS.checklex(parser, SCAN.lxTO); NextPos(parser, pos2); @@ -3205,7 +3209,7 @@ BEGIN END StatSeq; -PROCEDURE chkreturn (parser: PARS.PARSER; e: PARS.EXPR; t: PROG.TYPE_; pos: PARS.POSITION): BOOLEAN; +PROCEDURE chkreturn (parser: PARS.PARSER; e: PARS.EXPR; t: PROG._TYPE; pos: PARS.POSITION): BOOLEAN; VAR res: BOOLEAN; @@ -3213,20 +3217,20 @@ BEGIN res := assigncomp(e, t); IF res THEN IF e.obj = eCONST THEN - IF e.type = tREAL THEN + IF e._type = tREAL THEN Float(parser, e) - ELSIF e.type.typ = PROG.tNIL THEN + ELSIF e._type.typ = PROG.tNIL THEN IL.Const(0) ELSE LoadConst(e) END - ELSIF (e.type = tINTEGER) & (t = tBYTE) & (chkBYTE IN Options.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, pos, 85); IL.PushProc(e.ident.proc.label) ELSIF e.obj = eIMP THEN - IL.PushImpProc(e.ident.import) + IL.PushImpProc(e.ident._import) END END @@ -3246,8 +3250,8 @@ VAR BEGIN id := PROG.getIdent(rtl, SCAN.enterid(name), FALSE); - IF (id # NIL) & (id.import # NIL) THEN - IL.set_rtl(idx, -id.import(IL.IMPORT_PROC).label); + IF (id # NIL) & (id._import # NIL) THEN + IL.set_rtl(idx, -id._import(IL.IMPORT_PROC).label); id.proc.used := TRUE ELSIF (id # NIL) & (id.proc # NIL) THEN IL.set_rtl(idx, id.proc.label); diff --git a/source/UTILS.ob07 b/source/UTILS.ob07 index 101846b..3737c98 100644 --- a/source/UTILS.ob07 +++ b/source/UTILS.ob07 @@ -23,7 +23,7 @@ CONST max32* = 2147483647; vMajor* = 1; - vMinor* = 40; + vMinor* = 41; FILE_EXT* = ".ob07"; RTL_NAME* = "RTL"; diff --git a/source/X86.ob07 b/source/X86.ob07 index 559fe0d..ed325f7 100644 --- a/source/X86.ob07 +++ b/source/X86.ob07 @@ -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)));