Listing: 1 IMPLEMENTATION MODULE Compact; 2 3 (* A memory handler that allows the heap to be compacted *) 4 (* For the time being will only work with one 64K segment *) 5 (* Note that this is for demonstration purposes and therefore is designed 6 to be visible rather than fast. A rewrite would be in order before using 7 this thing in anger*) 8 9 IMPORT Storage,Lib; 10 11 VAR 12 Head:MemRecP; (* If more that one segment this would be more complex *) ***** ^ undeclared identifier 13 NextHandle:HandleType; ***** ^ undeclared identifier 14 15 PROCEDURE MergeBlanks(); 16 VAR 17 Finger:MemRecP; ***** ^ undeclared identifier 18 BEGIN 19 Finger:=Head; ***** ^ not supported yet ***** ^ not supported yet 20 WHILE (Finger<>NIL) AND (Finger^.Next<>NIL) DO ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 21 IF (Finger^.Handle=NotAHandle) AND (Finger^.Next^.Handle=NotAHandle) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 22 Finger^.Length:=Finger^.Length+Finger^.Next^.Length+SIZE(MemRec); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 23 Finger^.Next:=Finger^.Next^.Next ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 24 ELSE 25 Finger:=Finger^.Next; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 26 END; 27 END 28 END MergeBlanks; ***** ^ not supported yet 29 30 PROCEDURE Deallocate(x:HandleType); ***** ^ undeclared identifier 31 VAR 32 Finger:MemRecP; ***** ^ undeclared identifier 33 BEGIN 34 Finger:=Head; ***** ^ not supported yet ***** ^ not supported yet 35 WHILE (Finger<>NIL) AND (Finger^.Handle<>x) DO ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 36 Finger:=Finger^.Next ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 37 END; 38 IF Finger<>NIL THEN ***** ^ not supported yet 39 Finger^.Handle:=NotAHandle; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 40 MergeBlanks(); ***** ^ not supported yet ***** ^ not supported yet 41 END 42 END Deallocate; ***** ^ not supported yet 43 44 PROCEDURE CompactMemory(); 45 VAR 46 Temp,Finger:MemRecP; ***** ^ undeclared identifier 47 OldSize,ComingSize:CARDINAL; 48 BEGIN 49 Finger:=Head; ***** ^ not supported yet ***** ^ not supported yet 50 WHILE (Finger<>NIL) AND (Finger^.Next<>NIL) DO ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 51 IF Finger^.Handle=NotAHandle THEN (* Two blanks so merge *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 52 ComingSize:=Finger^.Next^.Length+SIZE(MemRec); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 53 IF Finger^.Next^.Handle=NotAHandle THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 54 Finger^.Length:=Finger^.Length+ComingSize; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 55 Finger^.Next:=Finger^.Next^.Next; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 56 ELSE 57 OldSize:=Finger^.Length; ***** ^ not supported yet ***** ^ not supported yet 58 Lib.Move(Finger^.Next,Finger,ComingSize); (* Move data down *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 59 Temp:=Lib.AddAddr(Finger,ComingSize); (* Create the new blank record *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 60 Temp^.Handle:=NotAHandle; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 61 Temp^.Length:=OldSize; ***** ^ not supported yet ***** ^ not supported yet 62 Temp^.Next:=Finger^.Next; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 63 Finger^.Next:=Temp; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 64 END 65 ELSE 66 Finger:=Finger^.Next; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 67 END 68 END; 69 END CompactMemory; ***** ^ not supported yet 70 71 PROCEDURE DerefHandle(x:HandleType):ADDRESS; ***** ^ undeclared identifier ***** ^ undeclared identifier 72 VAR 73 Finger:MemRecP; ***** ^ undeclared identifier 74 BEGIN 75 Finger:=Head; ***** ^ not supported yet ***** ^ not supported yet 76 WHILE (Finger<>NIL) AND (Finger^.Handle<>x) DO ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 77 Finger:=Finger^.Next ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 78 END; 79 IF Finger=NIL THEN ***** ^ not supported yet 80 RETURN ADDRESS(0) ***** ^ undeclared identifier ***** ^ not supported yet 81 ELSE 82 RETURN Lib.AddAddr(Finger,SIZE(MemRec)) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 83 END 84 END DerefHandle; ***** ^ not supported yet 85 86 PROCEDURE Allocate(size:CARDINAL):HandleType; ***** ^ undeclared identifier 87 VAR 88 SecondTry:BOOLEAN; 89 Value:HandleType; ***** ^ undeclared identifier 90 Temp,Finger:MemRecP; ***** ^ undeclared identifier 91 BEGIN 92 SecondTry:=TRUE; 93 IF sizeNIL) AND ( ***** ^ not supported yet 101 (Finger^.Handle<>NotAHandle) OR (Finger^.Lengthsize+SIZE(MemRec) THEN (* Insert new blank record *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 112 Temp:=Lib.AddAddr(Finger,size+SIZE(MemRec)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 113 Temp^.Length:=Finger^.Length-size-SIZE(MemRec); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 114 Temp^.Handle:=NotAHandle; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 115 Temp^.Next:=Finger^.Next; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 116 Finger^.Next:=Temp; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 117 Finger^.Length:=size; ***** ^ not supported yet ***** ^ not supported yet 118 ELSE 119 size:=Finger^.Length; ***** ^ not supported yet ***** ^ not supported yet 120 END; 121 Finger^.Handle:=Value; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 122 END; 123 UNTIL SecondTry OR (Value<>NotAHandle); ***** ^ not supported yet ***** ^ undeclared identifier 124 RETURN Value; ***** ^ not supported yet 125 END Allocate; ***** ^ not supported yet 126 127 BEGIN 128 Storage.ALLOCATE(Head,64*1024); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 129 Head^.Length:=64*1024-SIZE(MemRec); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 130 Head^.Next:=NIL; ***** ^ not supported yet ***** ^ not supported yet 131 Head^.Handle:=MAX(CARDINAL); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 132 NextHandle:=NotAHandle; ***** ^ not supported yet ***** ^ undeclared identifier 133 END Compact. ***** ^ not supported yet 206 errors