Subversion Repositories Kolibri OS

Compare Revisions

Regard whitespace Rev 9903 → Rev 9902

/programs/develop/cedit/CEDIT
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
/programs/develop/cedit/SRC/CEdit.ob07
28,10 → 28,10
RW, Ini, EB := EditBox, Tabs, Toolbar, SB := StatusBar;
 
CONST
HEADER = "CEdit (24-feb-2023)";
HEADER = "CEdit (22-feb-2023)";
 
ShellFilter = "";
EditFilter = "sh|inc|txt|asm|ob07|c|cpp|h|pas|pp|lua|ini|json";
EditFilter = "SH|INC|TXT|ASM|OB07|C|CPP|H|PAS|PP|LUA|INI|JSON";
 
fontWidth = K.fontWidth;
fontHeight = K.fontHeight;
745,8 → 745,8
BEGIN
n1 := name1;
n2 := name2;
U.lowcase8(n1);
U.lowcase8(n2)
U.upcase(n1);
U.upcase(n2)
RETURN n1 = n2
END nameEq;
 
/programs/develop/cedit/SRC/ChangeLog.ob07
21,10 → 21,6
 
IMPORT List, Lines, API, SYSTEM;
 
CONST
boolItemSize = 8;
fillMap = {0..boolItemSize-1};
 
TYPE
tIntItem = POINTER TO RECORD (List.tItem)
cnt: INTEGER;
32,13 → 28,9
END;
 
tBoolItem = POINTER TO RECORD (List.tItem)
map: SET;
data: ARRAY boolItemSize OF
RECORD
line: Lines.tLine;
adr: INTEGER;
val, save: BOOLEAN
END
END;
 
tUntypedPtr = POINTER TO RECORD (List.tItem)
122,12 → 114,8
SYSTEM.PUT(item(tIntItem).adr[i], item(tIntItem).val[i])
END
ELSIF item IS tBoolItem THEN
FOR i := 0 TO boolItemSize - 1 DO
IF i IN item(tBoolItem).map THEN
SYSTEM.PUT(item(tBoolItem).data[i].adr, item(tBoolItem).data[i].val)
SYSTEM.PUT(item(tBoolItem).adr, item(tBoolItem).val)
END
END
END
END redo;
 
 
151,7 → 139,7
item: List.tItem;
boolItem: tBoolItem;
cur: List.tItem;
i: INTEGER;
del: BOOLEAN;
BEGIN
item := CL.Log.first;
WHILE item # NIL DO
166,15 → 154,12
WHILE cur # NIL DO
IF cur IS tBoolItem THEN
boolItem := cur(tBoolItem);
FOR i := 0 TO boolItemSize - 1 DO
IF (i IN boolItem.map) & boolItem.data[i].save &
boolItem.data[i].line.modified THEN
EXCL(boolItem.map, i)
END
END
del := boolItem.save & boolItem.line.modified
ELSE
del := FALSE
END;
cur := cur.prev;
IF boolItem.map = {} THEN
IF del THEN
List.delete(CL.Log, boolItem);
DISPOSE(boolItem)
END
207,24 → 192,38
END changeWord;
 
 
PROCEDURE changeBool (line: Lines.tLine; VAR v: BOOLEAN; x: BOOLEAN);
VAR
item: tBoolItem;
BEGIN
NEW(item);
item.line := line;
item.adr := SYSTEM.ADR(v);
item.val := x;
item.save := FALSE;
IF ~CL.isLast THEN
clear(CL.guard)
END;
List.append(CL.Log, item)
END changeBool;
 
 
PROCEDURE delSaved*;
VAR
boolItem: tBoolItem;
cur: List.tItem;
i: INTEGER;
del: BOOLEAN;
BEGIN
cur := CL.guard.next;
WHILE cur # NIL DO
IF cur IS tBoolItem THEN
boolItem := cur(tBoolItem);
FOR i := 0 TO boolItemSize - 1 DO
IF (i IN boolItem.map) & boolItem.data[i].save THEN
EXCL(boolItem.map, i)
END
END
del := boolItem.save
ELSE
del := FALSE
END;
cur := cur.next;
IF boolItem.map = {} THEN
IF del THEN
List.delete(CL.Log, boolItem);
DISPOSE(boolItem)
END
236,21 → 235,19
VAR
boolItem: tBoolItem;
cur: List.tItem;
i: INTEGER;
del: BOOLEAN;
BEGIN
cur := CL.guard.prev;
WHILE (cur # NIL) & ~(cur IS tGuard) DO
IF cur IS tBoolItem THEN
boolItem := cur(tBoolItem);
FOR i := 0 TO boolItemSize - 1 DO
IF (i IN boolItem.map) & boolItem.data[i].save THEN
SYSTEM.PUT(boolItem.data[i].adr, ~boolItem.data[i].val);
EXCL(boolItem.map, i)
END
END
del := boolItem.save
ELSE
del := FALSE
END;
cur := cur.prev;
IF boolItem.map = {} THEN
IF del THEN
SYSTEM.PUT(boolItem.adr, ~boolItem.val);
List.delete(CL.Log, boolItem);
DISPOSE(boolItem)
END
258,61 → 255,16
END delCurSaved;
 
 
PROCEDURE _changeBool (fn2: BOOLEAN; line: Lines.tLine; VAR v: BOOLEAN; x: BOOLEAN);
PROCEDURE changeBool2 (line: Lines.tLine; VAR v: BOOLEAN; x: BOOLEAN);
VAR
item: tBoolItem;
cur: List.tItem;
i: INTEGER;
BEGIN
IF fn2 THEN
cur := CL.guard.prev
ELSE
IF ~CL.isLast THEN
clear(CL.guard)
END;
cur := CL.Log.last
END;
 
WHILE (cur # NIL) & ~(cur IS tGuard) &
(~(cur IS tBoolItem) OR (cur(tBoolItem).map = fillMap)) DO
cur := cur.prev
END;
IF (cur IS tBoolItem) & (cur(tBoolItem).map # fillMap) THEN
item := cur(tBoolItem)
ELSE
NEW(item);
item.map := {};
IF fn2 THEN
item.line := line;
item.adr := SYSTEM.ADR(v);
item.val := x;
item.save := TRUE;
List.insert(CL.Log, CL.guard.prev, item)
ELSE
List.append(CL.Log, item)
END
END;
 
i := 0;
WHILE i < boolItemSize DO
IF ~(i IN item.map) THEN
item.data[i].line := line;
item.data[i].adr := SYSTEM.ADR(v);
item.data[i].val := x;
item.data[i].save := fn2;
INCL(item.map, i);
i := boolItemSize
END;
INC(i)
END
END _changeBool;
 
 
PROCEDURE changeBool (line: Lines.tLine; VAR v: BOOLEAN; x: BOOLEAN);
BEGIN
_changeBool(FALSE, line, v, x)
END changeBool;
 
 
PROCEDURE changeBool2 (line: Lines.tLine; VAR v: BOOLEAN; x: BOOLEAN);
BEGIN
_changeBool(TRUE, line, v, x)
END changeBool2;
 
 
/programs/develop/cedit/SRC/Languages.ob07
141,7 → 141,7
REPEAT
INC(pos);
c := Lines.getChar(line, pos);
IF Utils.upper(c) THEN END;
IF Utils.cap(c) THEN END;
IF Utils.isHex(c) THEN
INC(k)
ELSE
166,7 → 166,7
REPEAT
INC(pos);
c := Lines.getChar(line, pos);
IF Utils.upper(c) THEN END;
IF Utils.cap(c) THEN END;
IF Utils.isHex(c) THEN
INC(k)
ELSE
457,7 → 457,7
key[2] := CHR(ORD("1") + i);
getStr(lang_name, key, s);
IF ~(lang IN csLang) THEN
Utils.lowcase8(s)
Utils.upcase(s)
END;
IF lang = langOberon THEN
k := LENGTH(s);
465,7 → 465,7
FOR j := 0 TO k - 1 DO
s[j + k + 1] := s[j];
w := WCHR(ORD(s[j]));
IF Utils.lower(w) THEN
IF Utils.low(w) THEN
s[j + k + 1] := CHR(ORD(w) MOD 256)
END
END;
508,7 → 508,8
WHILE fileExt[i].lang # lang DO
INC(i)
END;
COPY(fileExt[i].ext, ext)
COPY(fileExt[i].ext, ext);
Utils.lowcase(ext)
END getExt;
 
 
524,17 → 525,17
loadKW(langFasm, KW[langFasm], Delim[langFasm], getStr, "lang_Fasm");
loadKW(langJSON, KW[langJSON], Delim[langJSON], getStr, "lang_JSON");
 
fileExt[ 0].ext := "ob07"; fileExt[ 0].lang := langOberon;
fileExt[ 1].ext := "c"; fileExt[ 1].lang := langC;
fileExt[ 2].ext := "h"; fileExt[ 2].lang := langC;
fileExt[ 3].ext := "cpp"; fileExt[ 3].lang := langC;
fileExt[ 4].ext := "pas"; fileExt[ 4].lang := langPascal;
fileExt[ 5].ext := "pp"; fileExt[ 5].lang := langPascal;
fileExt[ 6].ext := "asm"; fileExt[ 6].lang := langFasm;
fileExt[ 7].ext := "lua"; fileExt[ 7].lang := langLua;
fileExt[ 8].ext := "ini"; fileExt[ 8].lang := langIni;
fileExt[ 9].ext := "json"; fileExt[ 9].lang := langJSON;
fileExt[10].ext := "txt"; fileExt[10].lang := langText;
fileExt[ 0].ext := "OB07"; fileExt[ 0].lang := langOberon;
fileExt[ 1].ext := "C"; fileExt[ 1].lang := langC;
fileExt[ 2].ext := "H"; fileExt[ 2].lang := langC;
fileExt[ 3].ext := "CPP"; fileExt[ 3].lang := langC;
fileExt[ 4].ext := "PAS"; fileExt[ 4].lang := langPascal;
fileExt[ 5].ext := "PP"; fileExt[ 5].lang := langPascal;
fileExt[ 6].ext := "ASM"; fileExt[ 6].lang := langFasm;
fileExt[ 7].ext := "LUA"; fileExt[ 7].lang := langLua;
fileExt[ 8].ext := "INI"; fileExt[ 8].lang := langIni;
fileExt[ 9].ext := "JSON"; fileExt[ 9].lang := langJSON;
fileExt[10].ext := "TXT"; fileExt[10].lang := langText;
END init;
 
 
/programs/develop/cedit/SRC/Search.ob07
22,8 → 22,6
IMPORT
CB := Clipboard, List, Utils, SYSTEM;
 
CONST
itemSize = 64;
 
TYPE
tBuffer* = CB.tBuffer;
31,8 → 29,7
tIdxTable = ARRAY 65536, 2 OF INTEGER;
 
tPos* = POINTER TO RECORD (List.tItem)
cnt*: INTEGER;
pos*: ARRAY itemSize OF INTEGER
pos*: INTEGER
END;
 
VAR
55,7 → 52,7
i := cnt;
WHILE i > 0 DO
SYSTEM.GET(pChar, c);
IF ~cs & Utils.lower(c) THEN
IF ~cs & Utils.cap(c) THEN
SYSTEM.PUT(pChar, c)
END;
INC(table[ORD(c), 1]);
97,24 → 94,6
END index;
 
 
PROCEDURE next* (VAR item: tPos; VAR i: INTEGER): INTEGER;
VAR
res: INTEGER;
BEGIN
IF (item # NIL) & (i >= item.cnt) THEN
item := item.next(tPos);
i := 0;
END;
IF (item # NIL ) & (i < item.cnt) THEN
res := item.pos[i];
INC(i)
ELSE
res := -1
END
RETURN res
END next;
 
 
PROCEDURE find* (text: tBuffer; s: ARRAY OF WCHAR; whole: BOOLEAN; list: List.tList);
VAR
k, pos, n, x, prev_item_pos: INTEGER;
143,14 → 122,9
END;
IF ~flag & (x >= prev_item_pos) THEN
prev_item_pos := x + n;
item := list.last(tPos);
IF (item = NIL) OR (item.cnt = itemSize) THEN
NEW(item);
item.cnt := 0;
item.pos := x;
List.append(list, item)
END;
item.pos[item.cnt] := x;
INC(item.cnt)
END
END;
INC(pos, SYSTEM.SIZE(INTEGER));
/programs/develop/cedit/SRC/Text.ob07
119,7 → 119,7
BEGIN
text.fileName := name;
U.getFileName(name, ext, ".");
U.lowcase8(ext);
U.upcase(ext);
setLang(text, Lang.getLang(ext))
END setName;
 
352,20 → 352,20
END PrintComment;
 
 
PROCEDURE upper (c: WCHAR): WCHAR;
PROCEDURE cap (c: WCHAR): WCHAR;
BEGIN
IF U.upper(c) THEN END
IF U.cap(c) THEN END
RETURN c
END upper;
END cap;
 
 
PROCEDURE UL (c: WCHAR): BOOLEAN;
RETURN (upper(c) = "U") OR (upper(c) = "L")
RETURN (cap(c) = "U") OR (cap(c) = "L")
END UL;
 
 
PROCEDURE FL (c: WCHAR): BOOLEAN;
RETURN (upper(c) = "F") OR (upper(c) = "L")
RETURN (cap(c) = "F") OR (cap(c) = "L")
END FL;
 
 
384,7 → 384,7
DEC(i);
lexLen := getString(line, first, i - first + 1, s);
IF ~cs THEN
U.lowcase(s)
U.upcase16(s)
END;
IF Lang.isKey(s, text.lang, 1) THEN
color := colors.key1
451,16 → 451,16
k := i;
INC(i);
c := Lines.getChar(line, i);
IF (upper(c) = "X") & (Lines.getChar(line, i - 1) = "0") THEN
IF (cap(c) = "X") & (Lines.getChar(line, i - 1) = "0") THEN
INC(i);
hex := TRUE
END;
 
WHILE U.isHex(upper(Lines.getChar(line, i))) DO
WHILE U.isHex(cap(Lines.getChar(line, i))) DO
INC(i)
END;
 
IF (upper(Lines.getChar(line, i)) = "H") & ~hex THEN
IF (cap(Lines.getChar(line, i)) = "H") & ~hex THEN
INC(i)
END;
 
508,11 → 508,11
DEC(i);
c := Lines.getChar(line, i)
END;
IF (upper(c) = "X") & (Lines.getChar(line, i - 1) = "0") THEN
IF (cap(c) = "X") & (Lines.getChar(line, i - 1) = "0") THEN
REPEAT
INC(i);
c := Lines.getChar(line, i)
UNTIL ~U.isHex(upper(c));
UNTIL ~U.isHex(cap(c));
IF UL(c) THEN
INC(i)
END
531,7 → 531,7
INC(i)
END;
c := Lines.getChar(line, i);
IF upper(c) = "E" THEN
IF cap(c) = "E" THEN
INC(i);
c := Lines.getChar(line, i);
IF (c = "+") OR (c = "-") THEN
672,7 → 672,7
cond := 0
ELSIF U.isDigit(c) THEN
k := i;
IF (c = "0") & (upper(Lines.getChar(line, i + 1)) = "X") THEN
IF (c = "0") & (cap(Lines.getChar(line, i + 1)) = "X") THEN
isDgt := U.isHex;
hex := TRUE;
INC(i, 2)
680,7 → 680,7
isDgt := U.isDigit;
hex := FALSE
END;
WHILE isDgt(upper(Lines.getChar(line, i))) DO
WHILE isDgt(cap(Lines.getChar(line, i))) DO
INC(i)
END;
IF Lines.getChar(line, i) = "." THEN
688,16 → 688,16
IF Lines.getChar(line, i) = "." THEN
DEC(i)
END;
WHILE isDgt(upper(Lines.getChar(line, i))) DO
WHILE isDgt(cap(Lines.getChar(line, i))) DO
INC(i)
END
END;
IF (upper(Lines.getChar(line, i)) = "E") OR hex & (upper(Lines.getChar(line, i)) = "P") THEN
IF (cap(Lines.getChar(line, i)) = "E") OR hex & (cap(Lines.getChar(line, i)) = "P") THEN
INC(i);
IF (Lines.getChar(line, i) = "-") OR (Lines.getChar(line, i) = "+") THEN
INC(i)
END;
WHILE isDgt(upper(Lines.getChar(line, i))) DO
WHILE isDgt(cap(Lines.getChar(line, i))) DO
INC(i)
END
END;
771,7 → 771,7
END;
k := i;
INC(i);
WHILE U.isHex(upper(Lines.getChar(line, i))) DO
WHILE U.isHex(cap(Lines.getChar(line, i))) DO
INC(i)
END;
DEC(i);
790,7 → 790,7
WHILE U.isDigit(Lines.getChar(line, i)) DO
INC(i)
END;
IF upper(Lines.getChar(line, i)) = "E" THEN
IF cap(Lines.getChar(line, i)) = "E" THEN
INC(i);
IF (Lines.getChar(line, i) = "-") OR (Lines.getChar(line, i) = "+") THEN
INC(i)
906,7 → 906,7
text.cs := cs;
text.searchText := s;
IF ~cs THEN
U.lowcase(text.searchText)
U.upcase16(text.searchText)
END;
IF text.searchText # "" THEN
plainText := plain(text);
1787,9 → 1787,9
END;
 
IF upper THEN
func := U.upper
func := U.cap
ELSE
func := U.lower
func := U.low
END;
 
IF Lines.convert(line, i + 1, text.cursor.X - 1, func) THEN
1815,9 → 1815,9
cnt := selEnd.Y - selBeg.Y;
 
IF upper THEN
func := U.upper
func := U.cap
ELSE
func := U.lower
func := U.low
END;
 
IF cnt = 0 THEN
2293,13 → 2293,13
 
PROCEDURE draw* (text: tText);
VAR
y, n, cnt, i, x, pos: INTEGER;
y, n, cnt, i, x: INTEGER;
line, firstLine, lastLine: tLine;
selBeg, selEnd: tPoint;
s: ARRAY 12 OF WCHAR;
backColor, numWidth, xNum, wNum: INTEGER;
p: Search.tPos;
guard: tGuard;
p: Search.tPos;
BEGIN
IF text.comments THEN
Comments(text)
2413,26 → 2413,23
ELSE
lastLine := getLine2(text, MIN(text.scroll.Y + textsize.Y + 1, text.count) - 1)
END;
 
i := 0;
p := text.foundList.first(Search.tPos);
pos := Search.next(p, i);
WHILE pos # -1 DO
WHILE p # NIL DO
y := padding.top + inter DIV 2;
IF text.smallMove THEN
y := y + charHeight*(text.cursor.Y - text.scroll.Y)
END;
IF (firstLine.pos <= pos) & (pos <= lastLine.pos + lastLine.length) THEN
IF (firstLine.pos <= p.pos) & (p.pos <= lastLine.pos + lastLine.length) THEN
line := firstLine;
WHILE (line.pos <= pos) & (line # lastLine) DO
WHILE (line.pos <= p.pos) & (line # lastLine) DO
NextLine(line);
INC(y, charHeight)
END;
IF (line # lastLine) & (line # firstLine) OR (line = lastLine) & (line.pos > pos) THEN
IF (line # lastLine) & (line # firstLine) OR (line = lastLine) & (line.pos > p.pos) THEN
PrevLine(line);
DEC(y, charHeight)
END;
x := (pos - line.pos - text.scroll.X)*charWidth + padding.left;
x := (p.pos - line.pos - text.scroll.X)*charWidth + padding.left;
n := LENGTH(text.searchText)*charWidth;
WHILE n > 0 DO
IF x >= padding.left THEN
2442,7 → 2439,7
DEC(n)
END
END;
pos := Search.next(p, i)
p := p.next(Search.tPos)
END
END;
 
2612,41 → 2609,40
PROCEDURE findNext* (text: tText; prev: BOOLEAN): BOOLEAN;
VAR
cursorPos, x, y, X, Y, Len: INTEGER;
p: Search.tPos;
line: tLine;
res: BOOLEAN;
pos, i, pos0: INTEGER;
p: Search.tPos;
BEGIN
X := text.cursor.X;
Y := text.cursor.Y;
text.cursor.X := MIN(text.cursor.X, text.curLine.length);
cursorPos := text.curLine.pos + text.cursor.X - ORD(prev) - ORD(~prev & (text.foundSel = 0));
pos0 := -1;
i := 0;
p := text.foundList.first(Search.tPos);
pos := Search.next(p, i);
WHILE (pos # -1) & (pos <= cursorPos) DO
pos0 := pos;
pos := Search.next(p, i)
WHILE (p # NIL) & (p.pos <= cursorPos) DO
p := p.next(Search.tPos)
END;
IF prev THEN
pos := pos0
IF p = NIL THEN
p := text.foundList.last(Search.tPos)
ELSE
p := p.prev(Search.tPos)
END
END;
res := pos # -1;
res := p # NIL;
IF res THEN
y := 0;
line := text.first(tLine);
WHILE (line.pos <= pos) & (line.next # NIL) DO
WHILE (line.pos <= p.pos) & (line.next # NIL) DO
NextLine(line);
INC(y)
END;
IF (line.next # NIL) OR (line.pos > pos) THEN
IF (line.next # NIL) OR (line.pos > p.pos) THEN
PrevLine(line);
DEC(y)
END;
resetSelect(text);
searchScroll(text, y);
x := pos - line.pos;
x := p.pos - line.pos;
Len := LENGTH(text.searchText);
IF x + Len > text.scroll.X + textsize.X THEN
text.scroll.X := MAX(x + Len - textsize.X + 3, 0)
2692,9 → 2688,9
 
PROCEDURE replaceAll* (text: tText; s: ARRAY OF WCHAR; n: INTEGER): INTEGER;
VAR
p: Search.tPos;
line: tLine;
y, k, d, pos, y0, i, c: INTEGER;
p: Search.tPos;
y, k, d, pos, y0: INTEGER;
BEGIN
resetSelect(text);
SetPos(text, 0, 0);
2703,11 → 2699,9
y0 := -1;
k := 0;
d := LENGTH(s) - n;
c := 0;
i := 0;
p := text.foundList.first(Search.tPos);
pos := Search.next(p, i);
WHILE pos # -1 DO
WHILE p # NIL DO
pos := p.pos;
WHILE (line.pos <= pos) & (line.next # NIL) DO
NextLine(line);
INC(y)
2725,10 → 2719,9
SetPos(text, pos - line.pos + k, y);
text.foundSel := n;
replace(text, s, n);
INC(c);
pos := Search.next(p, i)
p := p.next(Search.tPos)
END
RETURN c
RETURN text.foundList.count
END replaceAll;
 
 
/programs/develop/cedit/SRC/Tabs.ob07
1,5 → 1,5
(*
Copyright 2021-2023 Anton Krotov
Copyright 2021, 2022 Anton Krotov
 
This file is part of CEdit.
 
31,14 → 31,12
curTabHeight = 26;
scrWidth = 15;
btnCloseColor* = 0EF999FH;
modifColor = 0FF0000H;
strLen = 30;
 
TYPE
 
tItem = POINTER TO RECORD (List.tItem)
 
val: ARRAY strLen + 1 OF CHAR;
val: RW.tFileName;
modified: BOOLEAN
 
END;
93,7 → 91,7
 
K.DrawText866bk(x + K.fontWidth + K.fontWidth DIV 2, y + (height - K.fontHeight) DIV 2, textColor, color, s);
IF modified THEN
K.DrawText866bk(x + K.fontWidth DIV 2, y + (height - K.fontHeight) DIV 2, modifColor, color, "*")
K.DrawText866bk(x + K.fontWidth DIV 2, y + (height - K.fontHeight) DIV 2, textColor, color, "*")
END;
K.CreateButton(id + ORD({30}) + btnID, x + 1, y - 1, width - 1, height - 1, 0, "");
left := x + width - btnCloseSize - 5;
186,30 → 184,14
END draw;
 
 
PROCEDURE setText (item: tItem; s: ARRAY OF CHAR);
VAR
i: INTEGER;
BEGIN
IF LENGTH(s) > strLen THEN
FOR i := 0 TO strLen - 4 DO
item.val[i] := s[i]
END;
item.val[strLen - 3] := 0X;
U.append8(item.val, "...")
ELSE
COPY(s, item.val)
END
END setText;
 
 
PROCEDURE add* (t: tTabs; s: ARRAY OF CHAR);
VAR
item: tItem;
BEGIN
NEW(item);
setText(item, s);
item.val := s;
item.modified := FALSE;
List.append(t.strings, item)
List.append(t.strings, item);
END add;
 
 
230,7 → 212,7
item: List.tItem;
BEGIN
item := List.getItem(t.strings, n);
setText(item(tItem), s)
item(tItem).val := s
END rename;
 
 
/programs/develop/cedit/SRC/Utils.ob07
1,5 → 1,5
(*
Copyright 2021-2023 Anton Krotov
Copyright 2021, 2022 Anton Krotov
 
This file is part of CEdit.
 
152,22 → 152,21
 
 
PROCEDURE isLetter* (ch: WCHAR): BOOLEAN;
RETURN ("a" <= ch) & (ch <= "z") OR ("A" <= ch) & (ch <= "Z") OR
(* cyrillic *)
(430X <= ch) & (ch <= 44FX) OR (410X <= ch) & (ch <= 42FX) OR
(ch = 491X) OR (ch = 490X) OR (450X <= ch) & (ch <= 45FX) OR
(400X <= ch) & (ch <= 40FX)
RETURN ("a" <= ch) & (ch <= "z") OR ("A" <= ch) & (ch <= "Z")
END isLetter;
 
 
PROCEDURE upper* (VAR ch: WCHAR): BOOLEAN;
PROCEDURE cap* (VAR ch: WCHAR): BOOLEAN;
VAR
res: BOOLEAN;
BEGIN
IF ("a" <= ch) & (ch <= "z") OR (430X <= ch) & (ch <= 44FX) THEN
IF ("a" <= ch) & (ch <= "z") THEN
ch := WCHR(ORD(ch) - (ORD("z") - ORD("Z")));
res := TRUE
ELSIF (430H <= ORD(ch)) & (ORD(ch) <= 44FH) THEN
ch := WCHR(ORD(ch) - 20H);
res := TRUE
ELSIF (450X <= ch) & (ch <= 45FX) THEN
ELSIF (450H <= ORD(ch)) & (ORD(ch) <= 45FH) THEN
ch := WCHR(ORD(ch) - 50H);
res := TRUE
ELSIF ch = 491X THEN
177,54 → 176,84
res := FALSE
END
RETURN res
END upper;
END cap;
 
 
PROCEDURE lower* (VAR ch: WCHAR): BOOLEAN;
PROCEDURE cap8 (VAR ch: CHAR): BOOLEAN;
VAR
res: BOOLEAN;
BEGIN
IF ("A" <= ch) & (ch <= "Z") OR (410X <= ch) & (ch <= 42FX) THEN
ch := WCHR(ORD(ch) + 20H);
IF ("a" <= ch) & (ch <= "z") THEN
ch := CHR(ORD(ch) - (ORD("z") - ORD("Z")));
res := TRUE
ELSIF (400X <= ch) & (ch <= 40FX) THEN
ch := WCHR(ORD(ch) + 50H);
res := TRUE
ELSIF ch = 490X THEN
ch := 491X;
res := TRUE
ELSE
res := FALSE
END
RETURN res
END lower;
END cap8;
 
 
PROCEDURE lowcase* (VAR s: ARRAY OF WCHAR);
PROCEDURE upcase* (VAR s: ARRAY OF CHAR);
VAR
i: INTEGER;
BEGIN
i := LENGTH(s) - 1;
WHILE i >= 0 DO
IF lower(s[i]) THEN
IF cap8(s[i]) THEN
END;
DEC(i)
END
END lowcase;
END upcase;
 
 
PROCEDURE lowcase8* (VAR s: ARRAY OF CHAR);
PROCEDURE upcase16* (VAR s: ARRAY OF WCHAR);
VAR
i: INTEGER;
BEGIN
i := LENGTH(s) - 1;
WHILE i >= 0 DO
IF cap(s[i]) THEN
END;
DEC(i)
END
END upcase16;
 
 
PROCEDURE low* (VAR ch: WCHAR): BOOLEAN;
VAR
res: BOOLEAN;
BEGIN
IF ("A" <= ch) & (ch <= "Z") THEN
ch := WCHR(ORD(ch) + (ORD("z") - ORD("Z")));
res := TRUE
ELSIF (410H <= ORD(ch)) & (ORD(ch) <= 42FH) THEN
ch := WCHR(ORD(ch) + 20H);
res := TRUE
ELSIF (400H <= ORD(ch)) & (ORD(ch) <= 40FH) THEN
ch := WCHR(ORD(ch) + 50H);
res := TRUE
ELSIF ch = 490X THEN
ch := 491X;
res := TRUE
ELSE
res := FALSE
END
RETURN res
END low;
 
 
PROCEDURE lowcase* (VAR s: ARRAY OF CHAR);
VAR
i: INTEGER;
BEGIN
i := LENGTH(s) - 1;
WHILE i >= 0 DO
IF ("A" <= s[i]) & (s[i] <= "Z") THEN
s[i] := CHR(ORD(s[i]) + 20H)
s[i] := CHR(ORD(s[i]) + 32)
END;
DEC(i)
END
END lowcase8;
END lowcase;
 
 
PROCEDURE str2int* (s: ARRAY OF WCHAR; VAR val: INTEGER): BOOLEAN;
307,6 → 336,19
END lg10;
 
 
PROCEDURE sgn* (x: INTEGER): INTEGER;
BEGIN
IF x > 0 THEN
x := 1
ELSIF x < 0 THEN
x := -1
ELSE
x := 0
END
RETURN x
END sgn;
 
 
PROCEDURE between* (a, b, c: INTEGER): BOOLEAN;
RETURN (a <= b) & (b <= c)
END between;
/programs/develop/cedit/SRC/API.ob07
0,0 → 1,290
(*
BSD 2-Clause License
 
Copyright (c) 2018, 2020-2022, Anton Krotov
All rights reserved.
*)
 
MODULE API;
 
IMPORT SYSTEM, K := KOSAPI;
 
 
CONST
 
eol* = 0DX + 0AX;
BIT_DEPTH* = 32;
 
MAX_SIZE = 16 * 400H;
HEAP_SIZE = 1 * 100000H;
 
_new = 1;
_dispose = 2;
 
SizeOfHeader = 36;
 
 
TYPE
 
CRITICAL_SECTION = ARRAY 2 OF INTEGER;
 
 
VAR
 
heap, endheap: INTEGER;
pockets: ARRAY MAX_SIZE DIV 32 + 1 OF INTEGER;
 
CriticalSection: CRITICAL_SECTION;
 
multi: BOOLEAN;
 
base*: INTEGER;
 
 
PROCEDURE [stdcall] zeromem* (dwords: INTEGER; adr: INTEGER);
BEGIN
SYSTEM.CODE(
0FCH, (* cld *)
031H, 0C0H, (* xor eax, eax *)
057H, (* push edi *)
08BH, 07DH, 00CH, (* mov edi, dword [ebp + 12] *)
08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *)
0F3H, 0ABH, (* rep stosd *)
05FH (* pop edi *)
)
END zeromem;
 
 
PROCEDURE mem_commit* (adr, size: INTEGER);
VAR
tmp: INTEGER;
BEGIN
FOR tmp := adr TO adr + size - 1 BY 4096 DO
SYSTEM.PUT(tmp, 0)
END
END mem_commit;
 
 
PROCEDURE switch_task;
BEGIN
K.sysfunc2(68, 1)
END switch_task;
 
 
PROCEDURE futex_create (ptr: INTEGER): INTEGER;
RETURN K.sysfunc3(77, 0, ptr)
END futex_create;
 
 
PROCEDURE futex_wait (futex, value, timeout: INTEGER);
BEGIN
K.sysfunc5(77, 2, futex, value, timeout)
END futex_wait;
 
 
PROCEDURE futex_wake (futex, number: INTEGER);
BEGIN
K.sysfunc4(77, 3, futex, number)
END futex_wake;
 
 
PROCEDURE EnterCriticalSection* (VAR CriticalSection: CRITICAL_SECTION);
BEGIN
switch_task;
futex_wait(CriticalSection[0], 1, 10000);
CriticalSection[1] := 1
END EnterCriticalSection;
 
 
PROCEDURE LeaveCriticalSection* (VAR CriticalSection: CRITICAL_SECTION);
BEGIN
CriticalSection[1] := 0;
futex_wake(CriticalSection[0], 1)
END LeaveCriticalSection;
 
 
PROCEDURE InitializeCriticalSection* (VAR CriticalSection: CRITICAL_SECTION);
BEGIN
CriticalSection[0] := futex_create(SYSTEM.ADR(CriticalSection[1]));
CriticalSection[1] := 0
END InitializeCriticalSection;
 
 
PROCEDURE __NEW (size: INTEGER): INTEGER;
VAR
res, idx, temp: INTEGER;
BEGIN
IF size <= MAX_SIZE THEN
idx := ASR(size, 5);
res := pockets[idx];
IF res # 0 THEN
SYSTEM.GET(res, pockets[idx]);
SYSTEM.PUT(res, size);
INC(res, 4)
ELSE
temp := 0;
IF heap + size >= endheap THEN
IF K.sysfunc2(18, 16) > ASR(HEAP_SIZE, 10) THEN
temp := K.sysfunc3(68, 12, HEAP_SIZE)
ELSE
temp := 0
END;
IF temp # 0 THEN
mem_commit(temp, HEAP_SIZE);
heap := temp;
endheap := heap + HEAP_SIZE
ELSE
temp := -1
END
END;
IF (heap # 0) & (temp # -1) THEN
SYSTEM.PUT(heap, size);
res := heap + 4;
heap := heap + size
ELSE
res := 0
END
END
ELSE
IF K.sysfunc2(18, 16) > ASR(size, 10) THEN
res := K.sysfunc3(68, 12, size);
IF res # 0 THEN
mem_commit(res, size);
SYSTEM.PUT(res, size);
INC(res, 4)
END
ELSE
res := 0
END
END;
IF (res # 0) & (size <= MAX_SIZE) THEN
zeromem(ASR(size, 2) - 1, res)
END
RETURN res
END __NEW;
 
 
PROCEDURE __DISPOSE (ptr: INTEGER): INTEGER;
VAR
size, idx: INTEGER;
BEGIN
DEC(ptr, 4);
SYSTEM.GET(ptr, size);
IF size <= MAX_SIZE THEN
idx := ASR(size, 5);
SYSTEM.PUT(ptr, pockets[idx]);
pockets[idx] := ptr
ELSE
size := K.sysfunc3(68, 13, ptr)
END
RETURN 0
END __DISPOSE;
 
 
PROCEDURE NEW_DISPOSE (func, arg: INTEGER): INTEGER;
VAR
res: INTEGER;
 
BEGIN
IF multi THEN
EnterCriticalSection(CriticalSection)
END;
 
IF func = _new THEN
res := __NEW(arg)
ELSIF func = _dispose THEN
res := __DISPOSE(arg)
END;
 
IF multi THEN
LeaveCriticalSection(CriticalSection)
END
 
RETURN res
END NEW_DISPOSE;
 
 
PROCEDURE _NEW* (size: INTEGER): INTEGER;
RETURN NEW_DISPOSE(_new, size)
END _NEW;
 
 
PROCEDURE _DISPOSE* (ptr: INTEGER): INTEGER;
RETURN NEW_DISPOSE(_dispose, ptr)
END _DISPOSE;
 
 
PROCEDURE exit* (p1: INTEGER);
BEGIN
K.sysfunc1(-1)
END exit;
 
 
PROCEDURE exit_thread* (p1: INTEGER);
BEGIN
K.sysfunc1(-1)
END exit_thread;
 
 
PROCEDURE OutStr (pchar: INTEGER);
VAR
c: CHAR;
BEGIN
IF pchar # 0 THEN
REPEAT
SYSTEM.GET(pchar, c);
IF c # 0X THEN
K.OutChar(c)
END;
INC(pchar)
UNTIL c = 0X
END
END OutStr;
 
 
PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER);
BEGIN
IF lpCaption # 0 THEN
K.OutLn;
OutStr(lpCaption);
K.OutChar(":");
K.OutLn
END;
OutStr(lpText);
IF lpCaption # 0 THEN
K.OutLn
END
END DebugMsg;
 
 
PROCEDURE init* (import_, code: INTEGER);
BEGIN
multi := FALSE;
base := code - SizeOfHeader;
K.sysfunc2(68, 11);
InitializeCriticalSection(CriticalSection);
K._init(import_)
END init;
 
 
PROCEDURE SetMultiThr* (value: BOOLEAN);
BEGIN
multi := value
END SetMultiThr;
 
 
PROCEDURE GetTickCount* (): INTEGER;
RETURN K.sysfunc2(26, 9) * 10
END GetTickCount;
 
 
PROCEDURE dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER;
RETURN 0
END dllentry;
 
 
PROCEDURE sofinit*;
END sofinit;
 
 
END API.
/programs/develop/cedit/SRC/RTL.ob07
0,0 → 1,543
(*
BSD 2-Clause License
 
Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
 
MODULE RTL;
 
IMPORT SYSTEM, API;
 
 
CONST
 
minint = ROR(1, 1);
 
WORD = API.BIT_DEPTH DIV 8;
 
 
VAR
 
name: INTEGER;
types: INTEGER;
 
 
PROCEDURE [stdcall] _move* (bytes, dest, source: INTEGER);
BEGIN
SYSTEM.CODE(
08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *)
085H, 0C0H, (* test eax, eax *)
07EH, 019H, (* jle L *)
0FCH, (* cld *)
057H, (* push edi *)
056H, (* push esi *)
08BH, 075H, 010H, (* mov esi, dword [ebp + 16] *)
08BH, 07DH, 00CH, (* mov edi, dword [ebp + 12] *)
089H, 0C1H, (* mov ecx, eax *)
0C1H, 0E9H, 002H, (* shr ecx, 2 *)
0F3H, 0A5H, (* rep movsd *)
089H, 0C1H, (* mov ecx, eax *)
083H, 0E1H, 003H, (* and ecx, 3 *)
0F3H, 0A4H, (* rep movsb *)
05EH, (* pop esi *)
05FH (* pop edi *)
(* L: *)
)
END _move;
 
 
PROCEDURE [stdcall] _arrcpy* (base_size, len_dst, dst, len_src, src: INTEGER): BOOLEAN;
VAR
res: BOOLEAN;
 
BEGIN
IF len_src > len_dst THEN
res := FALSE
ELSE
_move(len_src * base_size, dst, src);
res := TRUE
END
 
RETURN res
END _arrcpy;
 
 
PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
BEGIN
_move(MIN(len_dst, len_src) * chr_size, dst, src)
END _strcpy;
 
 
PROCEDURE [stdcall] _rot* (Len, Ptr: INTEGER);
BEGIN
SYSTEM.CODE(
08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *) (* ecx <- Len *)
08BH, 045H, 00CH, (* mov eax, dword [ebp + 12] *) (* eax <- Ptr *)
049H, (* dec ecx *)
053H, (* push ebx *)
08BH, 018H, (* mov ebx, dword [eax] *)
(* L: *)
08BH, 050H, 004H, (* mov edx, dword [eax + 4] *)
089H, 010H, (* mov dword [eax], edx *)
083H, 0C0H, 004H, (* add eax, 4 *)
049H, (* dec ecx *)
075H, 0F5H, (* jnz L *)
089H, 018H, (* mov dword [eax], ebx *)
05BH, (* pop ebx *)
05DH, (* pop ebp *)
0C2H, 008H, 000H (* ret 8 *)
)
END _rot;
 
 
PROCEDURE [stdcall] _set* (b, a: INTEGER); (* {a..b} -> eax *)
BEGIN
SYSTEM.CODE(
08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *) (* ecx <- b *)
08BH, 045H, 00CH, (* mov eax, dword [ebp + 12] *) (* eax <- a *)
039H, 0C8H, (* cmp eax, ecx *)
07FH, 033H, (* jg L1 *)
083H, 0F8H, 01FH, (* cmp eax, 31 *)
07FH, 02EH, (* jg L1 *)
085H, 0C9H, (* test ecx, ecx *)
07CH, 02AH, (* jl L1 *)
083H, 0F9H, 01FH, (* cmp ecx, 31 *)
07EH, 005H, (* jle L3 *)
0B9H, 01FH, 000H, 000H, 000H, (* mov ecx, 31 *)
(* L3: *)
085H, 0C0H, (* test eax, eax *)
07DH, 002H, (* jge L2 *)
031H, 0C0H, (* xor eax, eax *)
(* L2: *)
089H, 0CAH, (* mov edx, ecx *)
029H, 0C2H, (* sub edx, eax *)
0B8H, 000H, 000H, 000H, 080H, (* mov eax, 0x80000000 *)
087H, 0CAH, (* xchg edx, ecx *)
0D3H, 0F8H, (* sar eax, cl *)
087H, 0CAH, (* xchg edx, ecx *)
083H, 0E9H, 01FH, (* sub ecx, 31 *)
0F7H, 0D9H, (* neg ecx *)
0D3H, 0E8H, (* shr eax, cl *)
05DH, (* pop ebp *)
0C2H, 008H, 000H, (* ret 8 *)
(* L1: *)
031H, 0C0H, (* xor eax, eax *)
05DH, (* pop ebp *)
0C2H, 008H, 000H (* ret 8 *)
)
END _set;
 
 
PROCEDURE [stdcall] _set1* (a: INTEGER); (* {a} -> eax *)
BEGIN
SYSTEM.CODE(
031H, 0C0H, (* xor eax, eax *)
08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *) (* ecx <- a *)
083H, 0F9H, 01FH, (* cmp ecx, 31 *)
077H, 003H, (* ja L *)
00FH, 0ABH, 0C8H (* bts eax, ecx *)
(* L: *)
)
END _set1;
 
 
PROCEDURE [stdcall] _divmod* (y, x: INTEGER); (* (x div y) -> eax; (x mod y) -> edx *)
BEGIN
SYSTEM.CODE(
053H, (* push ebx *)
08BH, 045H, 00CH, (* mov eax, dword [ebp + 12] *) (* eax <- x *)
031H, 0D2H, (* xor edx, edx *)
085H, 0C0H, (* test eax, eax *)
074H, 018H, (* je L2 *)
07FH, 002H, (* jg L1 *)
0F7H, 0D2H, (* not edx *)
(* L1: *)
089H, 0C3H, (* mov ebx, eax *)
08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *) (* ecx <- y *)
0F7H, 0F9H, (* idiv ecx *)
085H, 0D2H, (* test edx, edx *)
074H, 009H, (* je L2 *)
031H, 0CBH, (* xor ebx, ecx *)
085H, 0DBH, (* test ebx, ebx *)
07DH, 003H, (* jge L2 *)
048H, (* dec eax *)
001H, 0CAH, (* add edx, ecx *)
(* L2: *)
05BH (* pop ebx *)
)
END _divmod;
 
 
PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER);
BEGIN
ptr := API._NEW(size);
IF ptr # 0 THEN
SYSTEM.PUT(ptr, t);
INC(ptr, WORD)
END
END _new;
 
 
PROCEDURE [stdcall] _dispose* (VAR ptr: INTEGER);
BEGIN
IF ptr # 0 THEN
ptr := API._DISPOSE(ptr - WORD)
END
END _dispose;
 
 
PROCEDURE [stdcall] _length* (len, str: INTEGER);
BEGIN
SYSTEM.CODE(
08BH, 045H, 00CH, (* mov eax, dword [ebp + 0Ch] *)
08BH, 04DH, 008H, (* mov ecx, dword [ebp + 08h] *)
048H, (* dec eax *)
(* L1: *)
040H, (* inc eax *)
080H, 038H, 000H, (* cmp byte [eax], 0 *)
074H, 003H, (* jz L2 *)
0E2H, 0F8H, (* loop L1 *)
040H, (* inc eax *)
(* L2: *)
02BH, 045H, 00CH (* sub eax, dword [ebp + 0Ch] *)
)
END _length;
 
 
PROCEDURE [stdcall] _lengthw* (len, str: INTEGER);
BEGIN
SYSTEM.CODE(
08BH, 045H, 00CH, (* mov eax, dword [ebp + 0Ch] *)
08BH, 04DH, 008H, (* mov ecx, dword [ebp + 08h] *)
048H, (* dec eax *)
048H, (* dec eax *)
(* L1: *)
040H, (* inc eax *)
040H, (* inc eax *)
066H, 083H, 038H, 000H, (* cmp word [eax], 0 *)
074H, 004H, (* jz L2 *)
0E2H, 0F6H, (* loop L1 *)
040H, (* inc eax *)
040H, (* inc eax *)
(* L2: *)
02BH, 045H, 00CH, (* sub eax, dword [ebp + 0Ch] *)
0D1H, 0E8H (* shr eax, 1 *)
)
END _lengthw;
 
 
PROCEDURE [stdcall] strncmp (a, b, n: INTEGER): INTEGER;
BEGIN
SYSTEM.CODE(
056H, (* push esi *)
057H, (* push edi *)
053H, (* push ebx *)
08BH, 075H, 008H, (* mov esi, dword[ebp + 8]; esi <- a *)
08BH, 07DH, 00CH, (* mov edi, dword[ebp + 12]; edi <- b *)
08BH, 05DH, 010H, (* mov ebx, dword[ebp + 16]; ebx <- n *)
031H, 0C9H, (* xor ecx, ecx *)
031H, 0D2H, (* xor edx, edx *)
0B8H,
000H, 000H, 000H, 080H, (* mov eax, minint *)
(* L1: *)
085H, 0DBH, (* test ebx, ebx *)
07EH, 017H, (* jle L3 *)
08AH, 00EH, (* mov cl, byte[esi] *)
08AH, 017H, (* mov dl, byte[edi] *)
046H, (* inc esi *)
047H, (* inc edi *)
04BH, (* dec ebx *)
039H, 0D1H, (* cmp ecx, edx *)
074H, 006H, (* je L2 *)
089H, 0C8H, (* mov eax, ecx *)
029H, 0D0H, (* sub eax, edx *)
0EBH, 006H, (* jmp L3 *)
(* L2: *)
085H, 0C9H, (* test ecx, ecx *)
075H, 0E7H, (* jne L1 *)
031H, 0C0H, (* xor eax, eax *)
(* L3: *)
05BH, (* pop ebx *)
05FH, (* pop edi *)
05EH, (* pop esi *)
05DH, (* pop ebp *)
0C2H, 00CH, 000H (* ret 12 *)
)
RETURN 0
END strncmp;
 
 
PROCEDURE [stdcall] strncmpw (a, b, n: INTEGER): INTEGER;
BEGIN
SYSTEM.CODE(
056H, (* push esi *)
057H, (* push edi *)
053H, (* push ebx *)
08BH, 075H, 008H, (* mov esi, dword[ebp + 8]; esi <- a *)
08BH, 07DH, 00CH, (* mov edi, dword[ebp + 12]; edi <- b *)
08BH, 05DH, 010H, (* mov ebx, dword[ebp + 16]; ebx <- n *)
031H, 0C9H, (* xor ecx, ecx *)
031H, 0D2H, (* xor edx, edx *)
0B8H,
000H, 000H, 000H, 080H, (* mov eax, minint *)
(* L1: *)
085H, 0DBH, (* test ebx, ebx *)
07EH, 01BH, (* jle L3 *)
066H, 08BH, 00EH, (* mov cx, word[esi] *)
066H, 08BH, 017H, (* mov dx, word[edi] *)
046H, (* inc esi *)
046H, (* inc esi *)
047H, (* inc edi *)
047H, (* inc edi *)
04BH, (* dec ebx *)
039H, 0D1H, (* cmp ecx, edx *)
074H, 006H, (* je L2 *)
089H, 0C8H, (* mov eax, ecx *)
029H, 0D0H, (* sub eax, edx *)
0EBH, 006H, (* jmp L3 *)
(* L2: *)
085H, 0C9H, (* test ecx, ecx *)
075H, 0E3H, (* jne L1 *)
031H, 0C0H, (* xor eax, eax *)
(* L3: *)
05BH, (* pop ebx *)
05FH, (* pop edi *)
05EH, (* pop esi *)
05DH, (* pop ebp *)
0C2H, 00CH, 000H (* ret 12 *)
)
RETURN 0
END strncmpw;
 
 
PROCEDURE [stdcall] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
VAR
res: INTEGER;
bRes: BOOLEAN;
c: CHAR;
 
BEGIN
res := strncmp(str1, str2, MIN(len1, len2));
IF res = minint THEN
IF len1 > len2 THEN
SYSTEM.GET(str1 + len2, c);
res := ORD(c)
ELSIF len1 < len2 THEN
SYSTEM.GET(str2 + len1, c);
res := -ORD(c)
ELSE
res := 0
END
END;
 
CASE op OF
|0: bRes := res = 0
|1: bRes := res # 0
|2: bRes := res < 0
|3: bRes := res <= 0
|4: bRes := res > 0
|5: bRes := res >= 0
END
 
RETURN bRes
END _strcmp;
 
 
PROCEDURE [stdcall] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
VAR
res: INTEGER;
bRes: BOOLEAN;
c: WCHAR;
 
BEGIN
res := strncmpw(str1, str2, MIN(len1, len2));
IF res = minint THEN
IF len1 > len2 THEN
SYSTEM.GET(str1 + len2 * 2, c);
res := ORD(c)
ELSIF len1 < len2 THEN
SYSTEM.GET(str2 + len1 * 2, c);
res := -ORD(c)
ELSE
res := 0
END
END;
 
CASE op OF
|0: bRes := res = 0
|1: bRes := res # 0
|2: bRes := res < 0
|3: bRes := res <= 0
|4: bRes := res > 0
|5: bRes := res >= 0
END
 
RETURN bRes
END _strcmpw;
 
 
PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR);
VAR
c: CHAR;
i: INTEGER;
 
BEGIN
i := 0;
REPEAT
SYSTEM.GET(pchar, c);
s[i] := c;
INC(pchar);
INC(i)
UNTIL c = 0X
END PCharToStr;
 
 
PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR);
VAR
i, a: INTEGER;
 
BEGIN
i := 0;
a := x;
REPEAT
INC(i);
a := a DIV 10
UNTIL a = 0;
 
str[i] := 0X;
 
REPEAT
DEC(i);
str[i] := CHR(x MOD 10 + ORD("0"));
x := x DIV 10
UNTIL x = 0
END IntToStr;
 
 
PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR);
VAR
n1, n2: INTEGER;
 
BEGIN
n1 := LENGTH(s1);
n2 := LENGTH(s2);
 
ASSERT(n1 + n2 < LEN(s1));
 
SYSTEM.MOVE(SYSTEM.ADR(s2[0]), SYSTEM.ADR(s1[n1]), n2);
s1[n1 + n2] := 0X
END append;
 
 
PROCEDURE [stdcall] _error* (modnum, _module, err, line: INTEGER);
VAR
s, temp: ARRAY 1024 OF CHAR;
 
BEGIN
CASE err OF
| 1: s := "assertion failure"
| 2: s := "NIL dereference"
| 3: s := "bad divisor"
| 4: s := "NIL procedure call"
| 5: s := "type guard error"
| 6: s := "index out of range"
| 7: s := "invalid CASE"
| 8: s := "array assignment error"
| 9: s := "CHR out of range"
|10: s := "WCHR out of range"
|11: s := "BYTE out of range"
END;
 
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);
 
API.exit_thread(0)
END _error;
 
 
PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): INTEGER;
BEGIN
SYSTEM.GET(t0 + t1 + types, t0)
RETURN t0 MOD 2
END _isrec;
 
 
PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER;
BEGIN
IF p # 0 THEN
SYSTEM.GET(p - WORD, p);
SYSTEM.GET(t0 + p + types, p)
END
 
RETURN p MOD 2
END _is;
 
 
PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): INTEGER;
BEGIN
SYSTEM.GET(t0 + t1 + types, t0)
RETURN t0 MOD 2
END _guardrec;
 
 
PROCEDURE [stdcall] _guard* (t0, p: INTEGER): INTEGER;
BEGIN
SYSTEM.GET(p, p);
IF p # 0 THEN
SYSTEM.GET(p - WORD, p);
SYSTEM.GET(t0 + p + types, p)
ELSE
p := 1
END
 
RETURN p MOD 2
END _guard;
 
 
PROCEDURE [stdcall] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER;
RETURN API.dllentry(hinstDLL, fdwReason, lpvReserved)
END _dllentry;
 
 
PROCEDURE [stdcall] _sofinit*;
BEGIN
API.sofinit
END _sofinit;
 
 
PROCEDURE [stdcall] _exit* (code: INTEGER);
BEGIN
API.exit(code)
END _exit;
 
 
PROCEDURE [stdcall] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER);
VAR
t0, t1, i, j: INTEGER;
 
BEGIN
SYSTEM.CODE(09BH, 0DBH, 0E3H); (* finit *)
API.init(param, code);
 
types := API._NEW(tcount * tcount + SYSTEM.SIZE(INTEGER));
ASSERT(types # 0);
FOR i := 0 TO tcount - 1 DO
FOR j := 0 TO tcount - 1 DO
t0 := i; t1 := j;
 
WHILE (t1 # 0) & (t1 # t0) DO
SYSTEM.GET(_types + t1 * WORD, t1)
END;
 
SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1))
END
END;
 
name := modname
END _init;
 
 
END RTL.