(* 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 . *) 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, 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); 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.first := 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.