├── .gitignore ├── README.md ├── Sources ├── ExtendedOberon │ ├── Memory.Mod │ ├── MemoryTest.Mod │ └── TestNew.Mod └── FPGAOberon2013 │ ├── Memory.Mod │ └── MemoryTest.Mod ├── dos2oberon └── oberon2dos /.gitignore: -------------------------------------------------------------------------------- 1 | # Temporary files 2 | *~ 3 | \#*# 4 | 5 | # MacOS X Finder metadata 6 | .DS_Store 7 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Oberon-generic-heap-allocation 2 | Generic heap allocation procedure *Memory.New(p, size)* for the Project Oberon 2013 operating system, which allocates a new dynamic variable of the specified *size* in the dynamic space (heap). 3 | 4 | Note: In this repository, the term "Project Oberon 2013" refers to a re-implementation of the original "Project Oberon" on an FPGA development board around 2013, as published at www.projectoberon.com. 5 | 6 | The plain vanilla Project Oberon 2013 operating system does *not* support allocating dynamic arrays. 7 | 8 | There are several possible ways to allocate arrays in the heap anyway, including: 9 | 10 | 1. Place the array inside a record and allocate the record using NEW (see the appendix for variations of this method). 11 | 12 | 2. Continue to use the Project Oberon 2013 system, but use the generic heap allocation procedure *Memory.New(p, size)* of *this* repository (which however is *not* type-safe, as explained below). 13 | 14 | 3. Upgrade the Project Oberon 2013 system to use the *enhanced Oberon runtime system and Oberon-07 compiler* available at http://github.com/andreaspirklbauer/Oberon-enhanced-Oberon07-compiler, which implements a dynamic heap allocation procedure for fixed-length and open arrays. 15 | 16 | 4. Upgrade the Project Oberon 2013 system to *Extended Oberon* available at http://github.com/andreaspirklbauer/Oberon-extended, which also implements a dynamic heap allocation procedure for fixed-length and open arrays. 17 | 18 | ------------------------------------------------------ 19 | 20 | **PREREQUISITES**: A current version of Project Oberon 2013 (see http://www.projectoberon.com). 21 | 22 | ------------------------------------------------------ 23 | **Description of procedure Memory.New(p, size)** 24 | 25 | If *p* is a variable of type *Memory.Pointer*, then a call of the procedure 26 | 27 | Memory.New(p, size) 28 | 29 | allocates a dynamic variable of the specified *size* in bytes in the dynamic space (heap), and a pointer to it is assigned to *p*. 30 | 31 | In addition, a "hidden" type descriptor containing the specified *size* is dynamically created on the fly. Multiple objects of the same size share the same descriptor. Note that no *pointer offsets* (for the garbage collector) or *procedure variable offsets* (for safe module unloading in Extended Oberon) are configured in the descriptor, i.e the object referenced by *p* is treated as an ARRAY OF BYTE with no descendant pointers or procedure variable fields (see "Restrictions" below). 32 | 33 | Heap objects allocated by *Memory.New* are collected by the Oberon garbage collector in the normal way, i.e. if the object is reachable from a named global pointer variable (such as the variable *ptr* in the test program below), it is not collected. 34 | 35 | The hidden type descriptors created by *Memory.New* are however not collected by the regular Oberon garbage collector (implementing this would require rebuilding the runtime system). But a command to collect them is provided: 36 | 37 | Memory.Collect 38 | 39 | This command can be manually activated at any time or be called from within client modules (recommended). It could also be added or removed as an Oberon background task, using the commands 40 | 41 | Memory.Start 42 | Memory.Stop 43 | 44 | **Warning** 45 | 46 | The solution presented in this repository is **not** type-safe in the following sense: It is the responsibility of the programmer to ensure that any reference to the data referenced by *p* actually lies *within* the allocated memory area, and the programmer must be aware that this represents a potential security risk! For example, in the test program below, the compiler only performs array bound checks on *maxsize* (the size of the array as statically declared in the program's source text), but not on *size* (the size of the array as dynamically allocated using *Memory.New*). 47 | 48 | ------------------------------------------------------ 49 | **Test program** 50 | 51 | MODULE MemoryTest; (*Test of Memory.New(ptr, size)*) 52 | IMPORT SYSTEM, Texts, Oberon, Memory; 53 | CONST size = 56; (*ideally 8 less than 32, 64, 128 or n*256 bytes*) 54 | maxsize = 65536; 55 | 56 | TYPE Pointer = POINTER TO Record; 57 | Record = RECORD x: ARRAY maxsize OF BYTE END ; 58 | 59 | VAR ptr: Pointer; (*named global pointer variable*) 60 | W: Texts.Writer; 61 | 62 | PROCEDURE New(VAR ptr: Pointer; size: LONGINT); 63 | VAR p: Memory.Pointer; 64 | BEGIN Memory.New(p, size); ptr := SYSTEM.VAL(Pointer, p) 65 | END New; 66 | 67 | PROCEDURE Free(VAR ptr: Pointer); 68 | BEGIN ptr := NIL 69 | END Free; 70 | 71 | PROCEDURE NewPtr*; 72 | BEGIN New(ptr, size) (*assigning the result to ptr prevents the object from being collected by the Oberon garbage collector*) 73 | END NewPtr; 74 | 75 | PROCEDURE FreePtr*; 76 | BEGIN Free(ptr) 77 | END FreePtr; 78 | 79 | PROCEDURE InitPtr*; 80 | BEGIN ptr.x[2] := 22; (*compiles and valid*) 81 | (*ptr.x[100] := 33;*) (*would compile, but write to a random memory location*) 82 | (*ptr.x[100000] := 44*) (*would lead to a *bad index" compile-time error*) 83 | END InitPtr; 84 | 85 | PROCEDURE ShowPtr*; 86 | BEGIN Texts.WriteInt(W, ptr.x[2], 4); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) 87 | END ShowPtr; 88 | 89 | PROCEDURE Collect*; 90 | BEGIN Memory.Collect 91 | END Collect; 92 | 93 | BEGIN Texts.OpenWriter(W); ptr := NIL 94 | END MemoryTest. 95 | 96 | ORP.Compile Memory.Mod MemoryTest.Mod ~ 97 | 98 | MemoryTest.NewPtr 99 | MemoryTest.InitPtr 100 | MemoryTest.ShowPtr 101 | MemoryTest.FreePtr 102 | MemoryTest.Collect # call Memory.Collect in client module 103 | 104 | Memory.Collect # call Memory.Collect manually 105 | Memory.Start # start Memory.Collect as a background task 106 | Memory.Stop # stop Memory.Collect as a background task 107 | 108 | ------------------------------------------------------ 109 | **Restrictions** 110 | 111 | **1.** If a variable *p* of type *Memory.Pointer* is converted ("type cast") to a variable of type *MyPointer = POINTER TO MyRecord*, then the type *MyRecord* must *not* contain descendant pointers or procedure variable fields, as in: 112 | 113 | CONST maxsize = 65536; (*any large number*) 114 | TYPE MyPointer = POINTER TO MyRecord; 115 | SubRecord = RECORD 116 | ptr: MyPointer; (*descendant pointer field -> NOT ALLOWED*) 117 | pvr: PROCEDURE (i: INTEGER) (*procedure variable field -> NOT ALLOWED*) 118 | END ; 119 | MyRecord = RECORD x: ARRAY maxsize OF SubRecord END ; 120 | 121 | This avoids the need to traverse the heap structure of objects allocated by *Memory.New* during **garbage collection** (where descendant *pointers* are traversed) or **safe module unloading** in *Extended Oberon* (where pointer *and* procedure variable fields are traversed). 122 | 123 | **2.** (Extended Oberon only) If a variable *p* of type *Memory.Pointer* is converted ("type cast") to a variable of type *MyPointer = POINTER TO MyArray*, then the type *MyArray* must *not* be an open array, as in: 124 | 125 | TYPE MyPointer = POINTER TO MyArray; 126 | MyRecord = RECORD x: INTEGER END ; 127 | MyArray = ARRAY OF MyRecord; (*open array -> NOT ALLOWED*) 128 | 129 | VAR p: MyPointer; 130 | 131 | Such a declaration would (intentionally) lead to an "array index out of bound" trap - not when *Memory.New(p, size)* is called, but when accessing *p* afterwards. In *Extended Oberon*, dynamic arrays should always be allocated using the predefined procedure *NEW(p, len)* and not using *Memory.New*. 132 | 133 | ------------------------------------------------------ 134 | *Lifting these restrictions* 135 | 136 | A *complete* implementation without these restrictions requires a modified version of module *Kernel* that can also handle *array* blocks (in addition to *record* blocks) and a compiler that implements a predefined procedure *NEW(p, size)* such that: 137 | 138 | * If *p* is of type POINTER TO T, the type T can be a named record *or* array type 139 | * Pointer and procedure variable fields are *allowed* in the definition of type T 140 | * Bounds checks on *fixed-length* arrays are performed at *compile* time 141 | * Bounds checks on *open* arrays are performed at *run* time 142 | 143 | If you use Extended Oberon, this is already implemented. For Project Oberon 2013, a possible implementation is provided at: http://github.com/andreaspirklbauer/Oberon-enhanced-Oberon07-compiler. 144 | 145 | ------------------------------------------------------ 146 | **Alternatives considered** 147 | 148 | An alternative to creating *hidden* type descriptors to hold the *size* of the allocated heap block would be to place the *size* of the heap block in the block's prefix itself (in place of the *tag*). Such a solution would then need to distinguish between two kinds of heap blocks, i.e. whether a) the *type tag* or b) the *size* of the record is stored in the block's prefix, and it must do so *each time* a pointer in the record is accessed. 149 | 150 | This approach was used in *Ceres-Oberon* to implement a special low-level procedure *SYSTEM.NEW(p, n)* - an alternative to the predefined procedure NEW - that allocated a heap block *without* a fixed type identified by a type descriptor, i.e. effectively an ARRAY OF BYTE. In Ceres-Oberon, bit 0 in the block's prefix indicated whether bits 0-23 of the prefix represent a *tag* or a *size*. This implied that the garbage collector *also* needed to distinguish between these two kinds of heap blocks and traverse their structure accordingly. To avoid the latter, an *additional* implementation restriction was initially in effect: heap blocks created by *SYSTEM.NEW(p, n)* were *not* allowed to contain descendant pointers, while the Oberon compiler disallowed such constructs (this implementation restriction was lifted in later versions of Ceres-Oberon - at the expense of increasing the complexity of the garbage collector). 151 | 152 | We have refrained from implementing this alternative. Instead, we recommend to use either: 153 | 154 | 1. The modified runtime system and compiler at http://github.com/andreaspirklbauer/Oberon-enhanced-Oberon07-compiler, which implements dynamic heap allocation procedure for fixed-length and open arrays, or: 155 | 156 | 2. Extended Oberon at http://github.com/andreaspirklbauer/Oberon-extended, which also implements it. 157 | 158 | In both cases, SYSTEM.NEW(p, n) is equivalent to NEW(p, n), where p is a POINTER TO ARRAY OF BYTE. 159 | 160 | ------------------------------------------------------ 161 | **APPENDIX: Other possible ways to allocate arrays in the heap:** 162 | 163 | Method 1: Use *records* to allocate *fixed-length* arrays: 164 | 165 | TYPE Rec = RECORD a: ARRAY 1000 OF INTEGER END; (*fixed-length*) 166 | Ptr = POINTER TO Rec; 167 | 168 | VAR p: Ptr; 169 | 170 | NEW(p); p.a[10] := 1 171 | 172 | Method 2: Use record *extensions* to allocate *dynamic-length* arrays: 173 | 174 | MODULE M; 175 | IMPORT Texts, Oberon; 176 | 177 | TYPE (*size of arrays ideally 8 less than 32, 64, 128 or n*256 bytes*) 178 | Rec = RECORD a: ARRAY 1022 OF INTEGER END; (*size = 1022*4 = 4096-8 bytes*) 179 | Rec1 = RECORD (Rec) a1: ARRAY 1024 OF INTEGER END; 180 | Rec2 = RECORD (Rec1) a2: ARRAY 1024 OF INTEGER END; 181 | Ptr = POINTER TO Rec; 182 | Ptr1 = POINTER TO Rec1; 183 | Ptr2 = POINTER TO Rec2; 184 | 185 | VAR p: Ptr; p1: Ptr1; p2: Ptr2; W: Texts.Writer; 186 | 187 | PROCEDURE New(VAR ptr: Ptr; len: INTEGER); 188 | VAR p: Ptr; p1: Ptr1; p2: Ptr2; 189 | BEGIN 190 | IF len <= 1016 THEN NEW(p); ptr := p 191 | ELSIF len <= 2040 THEN NEW(p1); ptr := p1 192 | ELSIF len <= 3064 THEN NEW(p2); ptr := p2 193 | ELSE ptr := NIL 194 | END 195 | END New; 196 | 197 | PROCEDURE P(ptr: Ptr); (*can pass p, p1, p2 as parameter, since all are assignment compatible with Ptr*) 198 | BEGIN 199 | CASE ptr OF 200 | Ptr2: Texts.WriteString(W, "ptr IS Ptr2") 201 | | Ptr1: Texts.WriteString(W, "ptr IS Ptr1") 202 | | Ptr: Texts.WriteString(W, "ptr IS Ptr") 203 | END ; 204 | Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) 205 | END P; 206 | 207 | PROCEDURE Go*; 208 | VAR p: Ptr; p1: Ptr1; p2: Ptr2; 209 | S: Texts.Scanner; 210 | BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); 211 | IF S.class = Texts.Int THEN New(p, S.i); 212 | CASE p OF 213 | Ptr2: p2 := p(Ptr2); P(p2) 214 | | Ptr1: p1 := p(Ptr1); P(p1) 215 | | Ptr: P(p) 216 | END 217 | END 218 | END Go; 219 | 220 | BEGIN Texts.OpenWriter(W) 221 | END M. 222 | 223 | ORP.Compile M.Mod/s ~ 224 | M.Go 1000 ~ 225 | M.Go 2000 ~ 226 | M.Go 3000 ~ 227 | 228 | **Example:** Module *Fonts* in the Project Oberon 2013 system: 229 | 230 | TYPE Font* = POINTER TO FontDesc; 231 | FontDesc* = RECORD 232 | name*: ARRAY 32 OF CHAR; 233 | height*, minX*, maxX*, minY*, maxY*: INTEGER; 234 | next*: Font; 235 | T: ARRAY 128 OF INTEGER; 236 | raster: ARRAY 2360 OF BYTE 237 | END ; 238 | 239 | LargeFontDesc = RECORD (FontDesc) ext: ARRAY 2560 OF BYTE END ; 240 | LargeFont = POINTER TO LargeFontDesc; 241 | 242 | PROCEDURE Load*(name: ARRAY OF CHAR); 243 | .. 244 | IF NofBytes < 2300 THEN NEW(F) ELSE NEW(LF); F := LF END ; 245 | 246 | Method 3: Use *arrays of pointers* to allow for even more granularity: 247 | 248 | TYPE 249 | DataBlock = RECORD data: ARRAY 256 OF INTEGER END; 250 | Data = POINTER TO DataBlock; 251 | 252 | Rec = RECORD a: ARRAY 16 OF Data END; (*allocate data block a[i] "on demand" using NEW*) 253 | Ptr = POINTER TO Rec; 254 | 255 | VAR p: Ptr; 256 | 257 | NEW(p); NEW(p.a[0]); p.a[0].data[10] := 1 258 | -------------------------------------------------------------------------------- /Sources/ExtendedOberon/Memory.Mod: -------------------------------------------------------------------------------- 1 | MODULE Memory; (*Generic heap allocation procedure New(ptr, size) / AP 7.2.20 Extended Oberon*) 2 | IMPORT SYSTEM, Kernel, Modules, Oberon; 3 | 4 | TYPE Pointer* = POINTER TO Record; 5 | Record* = RECORD END ; 6 | Tag = POINTER TO TypeDesc; 7 | TypeDesc = RECORD 8 | size: LONGINT; (*size, in bytes, of the heap record including hidden prefix fields tag and mk*) 9 | ext: ARRAY 3 OF LONGINT; (*extension table of tags (pointers to the descriptors) of the base types*) 10 | off: ARRAY 8 OF LONGINT; (*pointer offsets followed by procedure variable offsets*) 11 | mark: LONGINT; (*used to collect no longer referenced hidden type descriptors*) 12 | next: Tag 13 | END ; 14 | 15 | VAR root: Tag; (*list of hidden type descriptors created by New(ptr, size)*) 16 | T: Oberon.Task; (*background task that automatically collects hidden type descriptors*) 17 | 18 | PROCEDURE New*(VAR ptr: Pointer; size: LONGINT); 19 | VAR t: Tag; 20 | BEGIN (*convert size for heap allocation*) 21 | IF size <= 24 THEN size := 32 ELSIF size <= 56 THEN size := 64 ELSIF size <= 120 THEN size := 128 22 | ELSE size := (size+263) DIV 256 * 256 23 | END ; 24 | t := root; 25 | WHILE (t # NIL) & (t.size # size) DO t := t.next END ; 26 | IF t = NIL THEN NEW(t); (*allocate hidden type descriptor*) 27 | IF t # NIL THEN t.next := root; root := t; t.size := size; t.mark := 0; 28 | t.ext[0] := -1; t.ext[1] := -1; t.ext[2] := -1; t.off[0] := -1; (*ptr*) t.off[1] := -1 (*pvr*) 29 | END 30 | END ; 31 | IF t = NIL THEN ptr := NIL ELSE Kernel.New(SYSTEM.VAL(LONGINT, ptr), SYSTEM.ADR(t^), -1, 0) END 32 | END New; 33 | 34 | PROCEDURE Collect*; (*no longer referenced hidden type descriptors*) 35 | VAR mod: Modules.Module; 36 | t, prev: Tag; 37 | p, mark, tag, size, blktyp: LONGINT; 38 | BEGIN 39 | IF root # NIL THEN mod := Modules.root; 40 | WHILE mod # NIL DO 41 | IF mod.name[0] # 0X THEN Kernel.Mark(mod.ptr) END ; 42 | mod := mod.next 43 | END ; 44 | p := Kernel.heapOrg; 45 | REPEAT SYSTEM.GET(p+4, mark); 46 | IF mark < 0 THEN (*free*) SYSTEM.GET(p, size) 47 | ELSE (*allocated*) SYSTEM.GET(p, tag); blktyp := tag MOD 4; 48 | IF blktyp = 0 THEN (*record*) SYSTEM.GET(tag, size) ELSE (*array*) SYSTEM.GET(p+16, size) END ; 49 | IF mark > 0 THEN (*marked*) SYSTEM.PUT(p+4, 0); 50 | IF blktyp = 0 THEN (*record*) t := root; 51 | WHILE t # NIL DO (*mark referenced hidden type descriptors*) 52 | IF SYSTEM.VAL(LONGINT, t) = tag THEN INC(t.mark); t := NIL ELSE t := t.next END 53 | END 54 | END 55 | END 56 | END ; 57 | INC(p, size) 58 | UNTIL p >= Kernel.heapLim; 59 | t := root; 60 | WHILE t # NIL DO (*remove no longer referenced descriptors from list for later collection by GC*) 61 | IF t.mark > 0 THEN t.mark := 0; prev := t 62 | ELSIF t = root THEN root := root.next 63 | ELSE prev.next := t.next 64 | END ; 65 | t := t.next 66 | END 67 | END 68 | END Collect; 69 | 70 | PROCEDURE Start*; 71 | BEGIN IF T = NIL THEN T := Oberon.NewTask(Collect, 1000); Oberon.Install(T) END 72 | END Start; 73 | 74 | PROCEDURE Stop*; 75 | BEGIN IF T # NIL THEN Oberon.Remove(T); T := NIL END 76 | END Stop; 77 | 78 | BEGIN root := NIL; T := NIL 79 | END Memory. 80 | -------------------------------------------------------------------------------- /Sources/ExtendedOberon/MemoryTest.Mod: -------------------------------------------------------------------------------- 1 | MODULE MemoryTest; 2 | IMPORT SYSTEM, Texts, Oberon, Memory; 3 | CONST size = 56; (*ideally 8 less than 32, 64, 128 or n*256*) 4 | maxsize = 65536; 5 | 6 | TYPE Pointer = POINTER TO Record; 7 | Record = RECORD x: ARRAY maxsize OF BYTE END ; 8 | 9 | VAR ptr: Pointer; 10 | W: Texts.Writer; 11 | 12 | PROCEDURE New(VAR ptr: Pointer; size: LONGINT); 13 | VAR p: Memory.Pointer; 14 | BEGIN Memory.New(p, size); ptr := SYSTEM.VAL(Pointer, p) 15 | END New; 16 | 17 | PROCEDURE Free(VAR ptr: Pointer); 18 | BEGIN ptr := NIL 19 | END Free; 20 | 21 | PROCEDURE NewPtr*; 22 | BEGIN New(ptr, size) 23 | END NewPtr; 24 | 25 | PROCEDURE FreePtr*; 26 | BEGIN Free(ptr) 27 | END FreePtr; 28 | 29 | PROCEDURE InitPtr*; 30 | BEGIN ptr.x[2] := 22; (*compiles and valid*) 31 | (*ptr.x[100] := 33;*) (*would compile, but write to a random memory location*) 32 | (*ptr.x[100000] := 44*) (*would lead to a *bad index" compile-time error*) 33 | END InitPtr; 34 | 35 | PROCEDURE ShowPtr*; 36 | BEGIN Texts.WriteInt(W, ptr.x[2], 4); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) 37 | END ShowPtr; 38 | 39 | PROCEDURE Collect*; 40 | BEGIN Memory.Collect 41 | END Collect; 42 | 43 | BEGIN Texts.OpenWriter(W); ptr := NIL 44 | END MemoryTest. 45 | 46 | ORP.Compile Memory.Mod MemoryTest.Mod ~ 47 | 48 | MemoryTest.NewPtr 49 | MemoryTest.InitPtr 50 | MemoryTest.ShowPtr 51 | MemoryTest.FreePtr 52 | MemoryTest.Collect # call Memory.Collect in client module 53 | 54 | Memory.Collect # call Memory.Collect manually 55 | Memory.Start # start Memory.Collect as a background task 56 | Memory.Stop # stop Memory.Collect as a background task 57 | -------------------------------------------------------------------------------- /Sources/ExtendedOberon/TestNew.Mod: -------------------------------------------------------------------------------- 1 | MODULE TestNew; 2 | IMPORT SYSTEM, Out; 3 | 4 | TYPE PtrArr = POINTER TO Arr; 5 | Arr = ARRAY OF BYTE; 6 | 7 | PtrRec = POINTER TO Rec; 8 | Rec = RECORD i, j, k: INTEGER; 9 | ptrarr: PtrArr 10 | END ; 11 | 12 | VAR ptrrec: PtrRec; i: INTEGER; 13 | 14 | PROCEDURE P*; 15 | BEGIN i := 33; 16 | NEW(ptrrec); NEW(ptrrec.ptrarr, 100); ptrrec.ptrarr[i] := 111 17 | END P; 18 | 19 | PROCEDURE Q*; 20 | BEGIN Out.Int(ptrrec.ptrarr[i], 6); Out.Ln 21 | END Q; 22 | 23 | PROCEDURE R*; (*if R is called before S, then S will (intentionally) generate to a trap*) 24 | BEGIN ptrrec := NIL 25 | END R; 26 | 27 | PROCEDURE S*; (*this intentionally generates a trap if R has been called before*) 28 | VAR a0: INTEGER; b: BYTE; 29 | BEGIN a0 := SYSTEM.ADR(ptrrec.ptrarr^[i]); SYSTEM.GET(a0, b); Out.Int(b, 6); Out.Ln 30 | END S; 31 | 32 | PROCEDURE T*; 33 | VAR a0: INTEGER; b: BYTE; ptrrec: PtrRec; i: INTEGER; 34 | BEGIN i := 99; 35 | NEW(ptrrec); NEW(ptrrec.ptrarr, 100); ptrrec.ptrarr[i] := 222; 36 | a0 := SYSTEM.ADR(ptrrec.ptrarr^[i]); SYSTEM.GET(a0, b); Out.Int(b, 6); Out.Ln 37 | END T; 38 | 39 | END TestNew. 40 | 41 | ORP.Compile TestNew.Mod/s ~ 42 | System.Free TestNew ~ 43 | TestNew.P 44 | TestNew.Q 45 | TestNew.R # attention: if R is called before S, then S will (intentionally) generate to a trap 46 | TestNew.S 47 | TestNew.T 48 | 49 | 50 | 51 | -------------------------------------------------------------------------------- /Sources/FPGAOberon2013/Memory.Mod: -------------------------------------------------------------------------------- 1 | MODULE Memory; (*Generic heap allocation procedure New(ptr, size) / AP 7.2.20*) 2 | IMPORT SYSTEM, Kernel, Modules, Oberon; 3 | 4 | TYPE Pointer* = POINTER TO Record; 5 | Record* = RECORD END ; 6 | Tag = POINTER TO TypeDesc; 7 | TypeDesc = RECORD 8 | size: LONGINT; (*size, in bytes, of the heap record including hidden prefix fields tag and mk*) 9 | ext: ARRAY 3 OF LONGINT; (*extension table of tags (pointers to the descriptors) of the base types*) 10 | off: ARRAY 8 OF LONGINT; (*pointer offsets of the descendant pointers in the described type*) 11 | mark: LONGINT; (*used to collect no longer referenced hidden type descriptors*) 12 | next: Tag 13 | END ; 14 | 15 | VAR root: Tag; (*list of hidden type descriptors created by New(ptr, size)*) 16 | T: Oberon.Task; (*background task that automatically collects hidden type descriptors*) 17 | 18 | PROCEDURE New*(VAR ptr: Pointer; size: LONGINT); 19 | VAR t: Tag; 20 | BEGIN (*convert size for heap allocation*) 21 | IF size <= 24 THEN size := 32 ELSIF size <= 56 THEN size := 64 ELSIF size <= 120 THEN size := 128 22 | ELSE size := (size+263) DIV 256 * 256 23 | END ; 24 | t := root; 25 | WHILE (t # NIL) & (t.size # size) DO t := t.next END ; 26 | IF t = NIL THEN NEW(t); (*allocate hidden type descriptor*) 27 | IF t # NIL THEN t.next := root; root := t; t.size := size; t.mark := 0; 28 | t.ext[0] := -1; t.ext[1] := -1; t.ext[2] := -1; t.off[0] := -1 (*ptr*) 29 | END 30 | END ; 31 | IF t = NIL THEN ptr := NIL ELSE Kernel.New(SYSTEM.VAL(LONGINT, ptr), SYSTEM.ADR(t^)) END 32 | END New; 33 | 34 | PROCEDURE Collect*; (*no longer referenced hidden type descriptors*) 35 | VAR mod: Modules.Module; 36 | t, prev: Tag; 37 | p, mark, tag, size: LONGINT; 38 | BEGIN 39 | IF root # NIL THEN mod := Modules.root; 40 | WHILE mod # NIL DO 41 | IF mod.name[0] # 0X THEN Kernel.Mark(mod.ptr) END ; 42 | mod := mod.next 43 | END ; 44 | p := Kernel.heapOrg; 45 | REPEAT SYSTEM.GET(p+4, mark); 46 | IF mark < 0 THEN (*free*) SYSTEM.GET(p, size) 47 | ELSE (*allocated*) SYSTEM.GET(p, tag); SYSTEM.GET(tag, size); 48 | IF mark > 0 THEN (*marked*) SYSTEM.PUT(p+4, 0); t := root; 49 | WHILE t # NIL DO (*mark referenced hidden type descriptors*) 50 | IF SYSTEM.VAL(LONGINT, t) = tag THEN INC(t.mark); t := NIL ELSE t := t.next END 51 | END 52 | END 53 | END ; 54 | INC(p, size) 55 | UNTIL p >= Kernel.heapLim; 56 | t := root; 57 | WHILE t # NIL DO (*remove no longer referenced descriptors from list for later collection by GC*) 58 | IF t.mark > 0 THEN t.mark := 0; prev := t 59 | ELSIF t = root THEN root := root.next 60 | ELSE prev.next := t.next 61 | END ; 62 | t := t.next 63 | END 64 | END 65 | END Collect; 66 | 67 | PROCEDURE Start*; 68 | BEGIN IF T = NIL THEN T := Oberon.NewTask(Collect, 1000); Oberon.Install(T) END 69 | END Start; 70 | 71 | PROCEDURE Stop*; 72 | BEGIN IF T # NIL THEN Oberon.Remove(T); T := NIL END 73 | END Stop; 74 | 75 | BEGIN root := NIL; T := NIL 76 | END Memory. 77 | -------------------------------------------------------------------------------- /Sources/FPGAOberon2013/MemoryTest.Mod: -------------------------------------------------------------------------------- 1 | MODULE MemoryTest; 2 | IMPORT SYSTEM, Texts, Oberon, Memory; 3 | CONST size = 56; (*ideally 8 less than 32, 64, 128 or n*256*) 4 | maxsize = 65536; 5 | 6 | TYPE Pointer = POINTER TO Record; 7 | Record = RECORD x: ARRAY maxsize OF BYTE END ; 8 | 9 | VAR ptr: Pointer; 10 | W: Texts.Writer; 11 | 12 | PROCEDURE New(VAR ptr: Pointer; size: LONGINT); 13 | VAR p: Memory.Pointer; 14 | BEGIN Memory.New(p, size); ptr := SYSTEM.VAL(Pointer, p) 15 | END New; 16 | 17 | PROCEDURE Free(VAR ptr: Pointer); 18 | BEGIN ptr := NIL 19 | END Free; 20 | 21 | PROCEDURE NewPtr*; 22 | BEGIN New(ptr, size) 23 | END NewPtr; 24 | 25 | PROCEDURE FreePtr*; 26 | BEGIN Free(ptr) 27 | END FreePtr; 28 | 29 | PROCEDURE InitPtr*; 30 | BEGIN ptr.x[2] := 22; (*compiles and valid*) 31 | (*ptr.x[100] := 33;*) (*would compile, but write to a random memory location*) 32 | (*ptr.x[100000] := 44*) (*would lead to a *bad index" compile-time error*) 33 | END InitPtr; 34 | 35 | PROCEDURE ShowPtr*; 36 | BEGIN Texts.WriteInt(W, ptr.x[2], 4); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) 37 | END ShowPtr; 38 | 39 | PROCEDURE Collect*; 40 | BEGIN Memory.Collect 41 | END Collect; 42 | 43 | BEGIN Texts.OpenWriter(W); ptr := NIL 44 | END MemoryTest. 45 | 46 | ORP.Compile Memory.Mod MemoryTest.Mod ~ 47 | 48 | MemoryTest.NewPtr 49 | MemoryTest.InitPtr 50 | MemoryTest.ShowPtr 51 | MemoryTest.FreePtr 52 | MemoryTest.Collect # call Memory.Collect in client module 53 | 54 | Memory.Collect # call Memory.Collect manually 55 | Memory.Start # start Memory.Collect as a background task 56 | Memory.Stop # stop Memory.Collect as a background task 57 | -------------------------------------------------------------------------------- /dos2oberon: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | # 3 | # dos2oberon -- convert a DOS file (CR + LF as line ending) to an Oberon file (only CR as line endings) 4 | # -- we also allow files which have only LF as line ending and convert them to an Oberon file (only CR) 5 | # 6 | # Sample workflow: 7 | # 1) ./dos2oberon File.Mod File.Mod (convert file to Oberon-style) 8 | # 2) ./pcreceive.sh File.Mod (import this file into Oberon) 9 | # 10 | # Converting a file from DOS-style (uses CRLF as line endings) to Oberon-style (uses only CR as line 11 | # endings) also make the following conversions: 12 | # - two spaces at the beginning of a line are converted to a TAB 13 | # - two spaces in front of Oberon comments enclosed by (* and *) are converted to a TAB. 14 | # which make them look nice in the Oberon system. 15 | # 16 | # See also: 17 | # oberon2dos (converts an Oberon file to DOS format) 18 | # 19 | # Notes: 20 | # CR = 13 (decimal) = 0D (hex) = 15C (octal) = \r (Perl) 21 | # LF = 10 (decimal) = 0A (hex) = 12C (octal) = \n (Perl) 22 | # TAB = 09 (decimal) = 09 (hex) = 11C (octal) = \t (Perl) 23 | # SUB = 26 (decimal) = 1A (hex) = 32C (octal) = ? (Perl) 24 | # 25 | # We use Perl, because on some host systems (e.g., MacOS), the corresponding sed command does not work 26 | # 27 | # Author: Andreas Pirklbauer 28 | # 29 | 30 | # quit unless we have the correct number of command line arguments 31 | $num_args = $#ARGV + 1; 32 | if ($num_args != 2) { 33 | print "Usage: dos2oberon inputfile outputfile\n"; 34 | exit; 35 | } 36 | 37 | # get the two command line arguments 38 | $inputfile=$ARGV[0]; 39 | $outputfile=$ARGV[1]; 40 | 41 | open(FILE, "$inputfile") || die "inputfile not found"; 42 | my @lines = ; 43 | close(FILE); 44 | 45 | my $x = " " ; # 2 spaces 46 | my $y = "\t" ; # 1 TAB 47 | 48 | my @newlines; 49 | foreach(@lines) { 50 | # convert all CRLF (\r\n) to CR (\r) only, so we no longer have any CRLF in the file afterwards 51 | $_ =~ s/\r\n/\r/g; 52 | # convert all LF (\n) to CR (\r) only, so we no longer have any LF in the file afterwards 53 | $_ =~ s/\n/\r/g; 54 | # replace two spaces with one TAB (\t), but only at the beginning of a ($_ =~ s/ /\t/g could cause trouble inside strings!) 55 | while ($_ =~ s/^($y*)$x/$1$y/) {} 56 | # replace 2 spaces before a comment by a TAB 57 | $_ =~ s/$x(\(\*.*\**\))/$y$1/g; 58 | # push output line 59 | push(@newlines,$_); 60 | } 61 | 62 | open(FILE, ">$outputfile") || die "File not found"; 63 | print FILE @newlines; 64 | close(FILE); 65 | 66 | -------------------------------------------------------------------------------- /oberon2dos: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | # 3 | # oberon2dos -- convert an Oberon file (only CR as line ending) to a DOS file (CR + LF as line endings) 4 | # -- we also allow files which have only LF as line ending and convert them to a DOS file (CR + LF) 5 | # 6 | # Sample workflow: 7 | # 1) ./pcsend.sh File.Mod (export file from Oberon to DOS or MacOS) 8 | # 2) ./oberon2dos File.Mod Sources/File.Mod (convert file to DOS-style) 9 | # 10 | # Converting a file from Oberon-style (uses only CR as line endings) to DOS-style (uses CRLF as line 11 | # endings) ensures that the file can be properly displayed on web sites such as www.github.com. 12 | # 13 | # See also: 14 | # dos2oberon (converts a DOS file to Oberon format) 15 | # 16 | # Notes: 17 | # CR = 13 (decimal) = 0D (hex) = 15C (octal) = \r (Perl) 18 | # LF = 10 (decimal) = 0A (hex) = 12C (octal) = \n (Perl) 19 | # TAB = 09 (decimal) = 09 (hex) = 11C (octal) = \t (Perl) 20 | # SUB = 26 (decimal) = 1A (hex) = 32C (octal) = ? (Perl) 21 | # 22 | # We use Perl, because on some host systems (e.g., MacOS), the corresponding sed command does not work 23 | # 24 | # Author: Andreas Pirklbauer 25 | # 26 | 27 | # quit unless we have the correct number of command line arguments 28 | $num_args = $#ARGV + 1; 29 | if ($num_args != 2) { 30 | print "Usage: oberon2dos inputfile outputfile\n"; 31 | exit; 32 | } 33 | 34 | # get the two command line arguments 35 | $inputfile=$ARGV[0]; 36 | $outputfile=$ARGV[1]; 37 | 38 | open(FILE, "$inputfile") || die "inputfile not found"; 39 | my @lines = ; 40 | close(FILE); 41 | 42 | my @newlines; 43 | foreach(@lines) { 44 | # convert all CRLF (\r\n) to CR (\r) only, so we no longer have any CRLF in the file afterwards 45 | $_ =~ s/\r\n/\r/g; 46 | # convert all LF (\n) to CR (\r) only, so we no longer have any LF in the file afterwards 47 | $_ =~ s/\n/\r/g; 48 | # convert all CR (\r) to CRLF (\r\n), so we ONLY have CRLF in the file afterwards 49 | $_ =~ s/\r/\r\n/g; 50 | # replace a TAB (\t) with two spaces (\s\s) 51 | $_ =~ s/\t/ /g; 52 | # push output line 53 | push(@newlines,$_); 54 | } 55 | 56 | open(FILE, ">$outputfile") || die "File not found"; 57 | print FILE @newlines; 58 | close(FILE); 59 | 60 | --------------------------------------------------------------------------------