(*
Copyright 2021 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;
TYPE
tIntItem = POINTER TO RECORD (List.tItem)
adr, val: INTEGER
END;
tBoolItem = POINTER TO RECORD (List.tItem)
line: Lines.tLine;
adr: INTEGER;
val, save: BOOLEAN
END;
tUntypedPtr = POINTER TO RECORD (List.tItem)
p: INTEGER
END;
tTypedPtr = POINTER TO RECORD (List.tItem)
p: List.tItem
END;
tGuard* = POINTER TO RECORD (List.tItem)
saved*: BOOLEAN
END;
tLog* = POINTER TO RECORD
Log*, Pointers*: List.tList;
guard: 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 isFirstGuard* (guard: tGuard): BOOLEAN;
VAR
item: List.tItem;
BEGIN
ASSERT(guard # NIL);
item := CL.Log.first;
WHILE ~(item IS tGuard) DO
item := item.next
END
RETURN guard = item
END isFirstGuard;
PROCEDURE setGuard* (_guard: tGuard);
BEGIN
CL.guard := _guard;
CL.isLast := isLastGuard(_guard)
END setGuard;
PROCEDURE redo* (item: List.tItem);
BEGIN
IF item IS tIntItem THEN
SYSTEM.PUT(item(tIntItem).adr, item(tIntItem).val)
ELSIF item IS tBoolItem THEN
SYSTEM.PUT(item(tBoolItem).adr, item(tBoolItem).val)
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;
del: BOOLEAN;
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);
del := boolItem.save & boolItem.line.modified
ELSE
del := FALSE
END;
cur := cur.prev;
IF del THEN
List.delete(CL.Log, boolItem);
DISPOSE(boolItem)
END
END
END save;
PROCEDURE changeWord (adrV, adrX: INTEGER);
VAR
item: tIntItem;
BEGIN
NEW(item);
item.adr := adrV;
SYSTEM.GET(adrX, item.val);
IF ~CL.isLast THEN
clear(CL.guard)
END;
List.append(CL.Log, item)
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;
del: BOOLEAN;
BEGIN
cur := CL.guard.next;
WHILE cur # NIL DO
IF cur IS tBoolItem THEN
boolItem := cur(tBoolItem);
del := boolItem.save
ELSE
del := FALSE
END;
cur := cur.next;
IF del THEN
List.delete(CL.Log, boolItem);
DISPOSE(boolItem)
END
END
END delSaved;
PROCEDURE delCurSaved*;
VAR
boolItem: tBoolItem;
cur: List.tItem;
del: BOOLEAN;
BEGIN
cur := CL.guard.prev;
WHILE (cur # NIL) & ~(cur IS tGuard) DO
IF cur IS tBoolItem THEN
boolItem := cur(tBoolItem);
del := boolItem.save
ELSE
del := FALSE
END;
cur := cur.prev;
IF del THEN
SYSTEM.PUT(boolItem.adr, ~boolItem.val);
List.delete(CL.Log, boolItem);
DISPOSE(boolItem)
END
END
END delCurSaved;
PROCEDURE changeBool2 (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 := TRUE;
List.insert(CL.Log, CL.guard.prev, item)
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
NEW(item);
item.p := p;
List.append(CL.Pointers, item)
END typedPtr;
PROCEDURE untypedPtr (p: INTEGER);
VAR
item: tUntypedPtr;
BEGIN
NEW(item);
item.p := p;
List.append(CL.Pointers, item)
END untypedPtr;
PROCEDURE set* (_CL: tLog);
BEGIN
CL := _CL
END set;
PROCEDURE create* (VAR maxLength: INTEGER): tLog;
VAR
newLog: tLog;
BEGIN
NEW(newLog);
newLog.guard := NIL;
newLog.isLast := TRUE;
newLog.Log := List.create(NIL);
newLog.Pointers := List.create(NIL);
CL := newLog;
Lines.setMaxLength(maxLength)
RETURN newLog
END create;
PROCEDURE destroy* (VAR log: tLog);
VAR
item: List.tItem;
res: 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.Pointers);
WHILE item # NIL DO
IF item IS tUntypedPtr THEN
res := API._DISPOSE(item(tUntypedPtr).p)
ELSIF item IS tTypedPtr THEN
DISPOSE(item(tTypedPtr).p)
END;
DISPOSE(item);
item := List.pop(log.Pointers)
END;
DISPOSE(log.Pointers);
DISPOSE(log)
END
END destroy;
BEGIN
List.init(changeInt, changePtr);
Lines.init(changeInt, changePtr, changeBool, changeBool2, typedPtr, untypedPtr)
END ChangeLog.