(*
Copyright 2021-2023 Anton Krotov
This file is part of CEdit.
CEdit is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
CEdit is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with CEdit. If not, see <http://www.gnu.org/licenses/>.
*)
MODULE ChangeLog;
IMPORT List, Lines, API, SYSTEM;
CONST
boolItemSize = 8;
fillMap = {0..boolItemSize-1};
TYPE
tIntItem = POINTER TO RECORD (List.tItem)
cnt: INTEGER;
adr, val: ARRAY 8 OF INTEGER
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)
cnt: INTEGER;
p: ARRAY 64 OF INTEGER
END;
tTypedPtr = POINTER TO RECORD (List.tItem)
cnt: INTEGER;
p: ARRAY 64 OF List.tItem
END;
tGuard* = POINTER TO RECORD (List.tItem)
saved*: BOOLEAN
END;
tLog* = POINTER TO RECORD
Log*, TPointers, UPointers: List.tList;
guard, first: tGuard;
isLast: BOOLEAN
END;
VAR
CL*: tLog;
PROCEDURE isLastGuard* (guard: tGuard): BOOLEAN;
VAR
item: List.tItem;
res: BOOLEAN;
BEGIN
IF guard # NIL THEN
item := CL.Log.last;
WHILE ~(item IS tGuard) DO
item := item.prev
END;
res := guard = item
ELSE
res := TRUE
END
RETURN res
END isLastGuard;
PROCEDURE getFirstGuard (): tGuard;
VAR
item: List.tItem;
BEGIN
item := CL.Log.first;
WHILE ~(item IS tGuard) DO
item := item.next
END
RETURN item(tGuard)
END getFirstGuard;
PROCEDURE isFirstGuard* (guard: tGuard): BOOLEAN;
BEGIN
ASSERT(guard # NIL);
IF CL.first = NIL THEN
CL.first := getFirstGuard()
END
RETURN guard = CL.first
END isFirstGuard;
PROCEDURE setGuard* (_guard: tGuard);
BEGIN
CL.guard := _guard;
CL.isLast := isLastGuard(_guard)
END setGuard;
PROCEDURE redo* (item: List.tItem);
VAR
i: INTEGER;
BEGIN
IF item IS tIntItem THEN
FOR i := 0 TO item(tIntItem).cnt - 1 DO
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)
END
END
END
END redo;
PROCEDURE clear (guard: tGuard);
VAR
item: List.tItem;
BEGIN
CL.isLast := TRUE;
REPEAT
item := List.pop(CL.Log);
IF item # guard THEN
DISPOSE(item)
END
UNTIL item = guard;
List.append(CL.Log, item)
END clear;
PROCEDURE save* (guard: tGuard);
VAR
item: List.tItem;
boolItem: tBoolItem;
cur: List.tItem;
i: INTEGER;
BEGIN
item := CL.Log.first;
WHILE item # NIL DO
IF item IS tGuard THEN
item(tGuard).saved := FALSE
END;
item := item.next
END;
guard.saved := TRUE;
cur := CL.guard.prev;
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
END;
cur := cur.prev;
IF boolItem.map = {} THEN
List.delete(CL.Log, boolItem);
DISPOSE(boolItem)
END
END
END save;
PROCEDURE changeWord (adrV, adrX: INTEGER);
VAR
item: tIntItem;
cur: List.tItem;
BEGIN
IF ~CL.isLast THEN
clear(CL.guard)
END;
cur := CL.Log.last;
WHILE (cur # NIL) & ~(cur IS tGuard) & ~(cur IS tIntItem) DO
cur := cur.prev
END;
IF (cur IS tIntItem) & (cur(tIntItem).cnt < LEN(cur(tIntItem).adr)) THEN
item := cur(tIntItem)
ELSE
NEW(item);
item.cnt := 0;
List.append(CL.Log, item)
END;
item.adr[item.cnt] := adrV;
SYSTEM.GET(adrX, item.val[item.cnt]);
INC(item.cnt)
END changeWord;
PROCEDURE delSaved*;
VAR
boolItem: tBoolItem;
cur: List.tItem;
i: INTEGER;
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
END;
cur := cur.next;
IF boolItem.map = {} THEN
List.delete(CL.Log, boolItem);
DISPOSE(boolItem)
END
END
END delSaved;
PROCEDURE delCurSaved*;
VAR
boolItem: tBoolItem;
cur: List.tItem;
i: INTEGER;
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
END;
cur := cur.prev;
IF boolItem.map = {} THEN
List.delete(CL.Log, boolItem);
DISPOSE(boolItem)
END
END
END delCurSaved;
PROCEDURE _changeBool (fn2: BOOLEAN; 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
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;
PROCEDURE changeInt* (VAR v: INTEGER; x: INTEGER);
BEGIN
changeWord(SYSTEM.ADR(v), SYSTEM.ADR(x))
END changeInt;
PROCEDURE changePtr (VAR v: List.tItem; x: List.tItem);
BEGIN
changeWord(SYSTEM.ADR(v), SYSTEM.ADR(x))
END changePtr;
PROCEDURE typedPtr (p: List.tItem);
VAR
item: tTypedPtr;
BEGIN
item := CL.TPointers.last(tTypedPtr);
IF (item = NIL) OR (item.cnt = LEN(item.p)) THEN
NEW(item);
item.cnt := 0;
List.append(CL.TPointers, item)
END;
item.p[item.cnt] := p;
INC(item.cnt)
END typedPtr;
PROCEDURE untypedPtr (p: INTEGER);
VAR
item: tUntypedPtr;
BEGIN
item := CL.UPointers.last(tUntypedPtr);
IF (item = NIL) OR (item.cnt = LEN(item.p)) THEN
NEW(item);
item.cnt := 0;
List.append(CL.UPointers, item)
END;
item.p[item.cnt] := p;
INC(item.cnt)
END untypedPtr;
PROCEDURE setLog* (_CL: tLog);
BEGIN
CL := _CL
END setLog;
PROCEDURE create* (VAR maxLength: INTEGER): tLog;
VAR
newLog: tLog;
BEGIN
NEW(newLog);
newLog.guard := NIL;
newLog.first := NIL;
newLog.isLast := TRUE;
newLog.Log := List.create(NIL);
newLog.TPointers := List.create(NIL);
newLog.UPointers := List.create(NIL);
CL := newLog;
Lines.setMaxLength(maxLength)
RETURN newLog
END create;
PROCEDURE destroy* (VAR log: tLog);
VAR
item: List.tItem;
res, i: INTEGER;
BEGIN
IF log # NIL THEN
item := List.pop(log.Log);
WHILE item # NIL DO
DISPOSE(item);
item := List.pop(log.Log)
END;
DISPOSE(log.Log);
item := List.pop(log.TPointers);
WHILE item # NIL DO
FOR i := 0 TO item(tTypedPtr).cnt - 1 DO
DISPOSE(item(tTypedPtr).p[i])
END;
DISPOSE(item);
item := List.pop(log.TPointers)
END;
DISPOSE(log.TPointers);
item := List.pop(log.UPointers);
WHILE item # NIL DO
FOR i := 0 TO item(tUntypedPtr).cnt - 1 DO
res := API._DISPOSE(item(tUntypedPtr).p[i])
END;
DISPOSE(item);
item := List.pop(log.UPointers)
END;
DISPOSE(log.UPointers);
DISPOSE(log)
END
END destroy;
BEGIN
List.init(changeInt, changePtr);
Lines.init(changeInt, changePtr, changeBool, changeBool2, typedPtr, untypedPtr)
END ChangeLog.