(* 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 . *) 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 adr1, adr2: INTEGER; val1, val2, 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].adr1, item(tBoolItem).data[i].val1); SYSTEM.PUT(item(tBoolItem).data[i].adr2, item(tBoolItem).data[i].val2) 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; line_modified: 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); FOR i := 0 TO boolItemSize - 1 DO IF (i IN boolItem.map) & boolItem.data[i].save THEN SYSTEM.GET(boolItem.data[i].adr1, line_modified); IF line_modified THEN EXCL(boolItem.map, i) END 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].adr1, ~boolItem.data[i].val1); SYSTEM.PUT(boolItem.data[i].adr2, ~boolItem.data[i].val2); 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 (save: BOOLEAN; VAR v1: BOOLEAN; x1: BOOLEAN; VAR v2: BOOLEAN; x2: BOOLEAN); VAR item: tBoolItem; cur: List.tItem; i: INTEGER; BEGIN IF save 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 save 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].adr1 := SYSTEM.ADR(v1); item.data[i].val1 := x1; item.data[i].adr2 := SYSTEM.ADR(v2); item.data[i].val2 := x2; item.data[i].save := save; INCL(item.map, i); i := boolItemSize END; INC(i) END END changeBool; 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, typedPtr, untypedPtr) END ChangeLog.