/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. |