vishapoberon/compiler
1
0
Fork 0
mirror of https://github.com/vishapoberon/compiler.git synced 2026-04-06 05:12:26 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

More LONGINTS changed to Address. Remove special FetchAddress code in Heap.

Browse source
This commit is contained in:
David Brown 2016-09-14 13:02:00 +01:00
parent f13130bbd3
commit 7efd5a0158
201 changed files with 1227 additions and 1132 deletions
Download patch file Download diff file Expand all files Collapse all files

112
src/system/Heap.Mod
View file

@ -3,10 +3,12 @@ MODULE Heap;
IMPORT SYSTEM; (* Cannot import anything else as heap initialization must complete
before any other modules are initialized. *)
TYPE Address = SYSTEM.ADDRESS;
CONST
ModNameLen = 20;
CmdNameLen = 24;
SZA = SIZE(SYSTEM.ADDRESS); (* Size of address *)
SZA = SIZE(Address); (* Size of address *)
Unit = 4*SZA; (* smallest possible heap block *)
nofLists = 9; (* number of free_lists *)
heapSize0 = 8000*Unit; (* startup heap size *)
@ -20,17 +22,17 @@ MODULE Heap;
*)
(* heap chunks *)
nextChnkOff = SYSTEM.VAL(SYSTEM.ADDRESS, 0); (* next heap chunk, sorted ascendingly! *)
endOff = SYSTEM.VAL(SYSTEM.ADDRESS, SZA); (* end of heap chunk *)
blkOff = SYSTEM.VAL(SYSTEM.ADDRESS, 3*SZA); (* first block in a chunk *)
nextChnkOff = SYSTEM.VAL(Address, 0); (* next heap chunk, sorted ascendingly! *)
endOff = SYSTEM.VAL(Address, SZA); (* end of heap chunk *)
blkOff = SYSTEM.VAL(Address, 3*SZA); (* first block in a chunk *)
(* heap blocks *)
tagOff = SYSTEM.VAL(SYSTEM.ADDRESS, 0); (* block starts with tag *)
sizeOff = SYSTEM.VAL(SYSTEM.ADDRESS, SZA); (* block size in free block relative to block start *)
sntlOff = SYSTEM.VAL(SYSTEM.ADDRESS, 2*SZA); (* pointer offset table sentinel in free block relative to block start *)
nextOff = SYSTEM.VAL(SYSTEM.ADDRESS, 3*SZA); (* next pointer in free block relative to block start *)
NoPtrSntl = SYSTEM.VAL(SYSTEM.ADDRESS, -SZA);
AddressZero = SYSTEM.VAL(SYSTEM.ADDRESS, 0);
tagOff = SYSTEM.VAL(Address, 0); (* block starts with tag *)
sizeOff = SYSTEM.VAL(Address, SZA); (* block size in free block relative to block start *)
sntlOff = SYSTEM.VAL(Address, 2*SZA); (* pointer offset table sentinel in free block relative to block start *)
nextOff = SYSTEM.VAL(Address, 3*SZA); (* next pointer in free block relative to block start *)
NoPtrSntl = SYSTEM.VAL(Address, -SZA);
AddressZero = SYSTEM.VAL(Address, 0);
TYPE
ModuleName = ARRAY ModNameLen OF CHAR;
@ -46,7 +48,7 @@ MODULE Heap;
name: ModuleName;
refcnt: LONGINT;
cmds: Cmd;
types: SYSTEM.ADDRESS;
types: Address;
enumPtrs: EnumProc;
reserved1, reserved2: LONGINT
END ;
@ -64,7 +66,7 @@ MODULE Heap;
FinNode = POINTER TO FinDesc;
FinDesc = RECORD
next: FinNode;
obj: SYSTEM.ADDRESS; (* weak pointer *)
obj: Address; (* weak pointer *)
marked: BOOLEAN;
finalize: Finalizer;
END ;
@ -73,15 +75,15 @@ MODULE Heap;
(* the list of loaded (=initialization started) modules *)
modules*: SYSTEM.PTR;
freeList: ARRAY nofLists + 1 OF SYSTEM.ADDRESS; (* dummy, 16, 32, 48, 64, 80, 96, 112, 128, sentinel *)
bigBlocks: SYSTEM.ADDRESS;
allocated*: SYSTEM.ADDRESS;
freeList: ARRAY nofLists + 1 OF Address; (* dummy, 16, 32, 48, 64, 80, 96, 112, 128, sentinel *)
bigBlocks: Address;
allocated*: Address;
firstTry: BOOLEAN;
(* extensible heap *)
heap: SYSTEM.ADDRESS; (* the sorted list of heap chunks *)
heapend: SYSTEM.ADDRESS; (* max possible pointer value (used for stack collection) *)
heapsize*: SYSTEM.ADDRESS; (* the sum of all heap chunk sizes *)
heap: Address; (* the sorted list of heap chunks *)
heapend: Address; (* max possible pointer value (used for stack collection) *)
heapsize*: Address; (* the sum of all heap chunk sizes *)
(* finalization candidates *)
fin: FinNode;
@ -153,7 +155,7 @@ MODULE Heap;
COPY(name, c.name); c.cmd := cmd; c.next := m.cmds; m.cmds := c
END REGCMD;
PROCEDURE REGTYP*(m: Module; typ: SYSTEM.ADDRESS);
PROCEDURE REGTYP*(m: Module; typ: Address);
BEGIN SYSTEM.PUT(typ, m.types); m.types := typ
END REGTYP;
@ -163,10 +165,10 @@ MODULE Heap;
PROCEDURE -ExternPlatformOSAllocate "extern address Platform_OSAllocate(address size);";
PROCEDURE -OSAllocate(size: SYSTEM.ADDRESS): SYSTEM.ADDRESS "Platform_OSAllocate(size)";
PROCEDURE -OSAllocate(size: Address): Address "Platform_OSAllocate(size)";
PROCEDURE NewChunk(blksz: SYSTEM.ADDRESS): SYSTEM.ADDRESS;
VAR chnk: SYSTEM.ADDRESS;
PROCEDURE NewChunk(blksz: Address): Address;
VAR chnk: Address;
BEGIN
chnk := OSAllocate(blksz + blkOff);
IF chnk # 0 THEN
@ -182,19 +184,13 @@ MODULE Heap;
END NewChunk;
(* FetchAddress fetches a pointer from memory and returns it as a LONGINT. It works
correctly regardless of the size of an address. Specifically on 32 bit address
architectures with 64 bit LONGINT, it loads 32 bits and extends it to LONGINT
rather than loading 64 bits.
NOTE - with uintpr work complete this function should be replaced with SYSTEM.GET
as there will be no need to extend addresses to larger types.
(*
PROCEDURE -FetchAddress(pointer: Address): Address "(address)(*((void**)((address)pointer)))";
*)
PROCEDURE FetchAddress(pointer: Address): Address; VAR r: Address; BEGIN SYSTEM.GET(pointer, r); RETURN r END FetchAddress;
PROCEDURE -FetchAddress(pointer: SYSTEM.ADDRESS): SYSTEM.ADDRESS "(address)(*((void**)((address)pointer)))";
PROCEDURE ExtendHeap(blksz: SYSTEM.ADDRESS);
VAR size, chnk, j, next: SYSTEM.ADDRESS;
PROCEDURE ExtendHeap(blksz: Address);
VAR size, chnk, j, next: Address;
BEGIN
IF blksz > 10000*Unit THEN size := blksz
ELSE size := 10000*Unit (* additional heuristics *)
@ -218,16 +214,16 @@ MODULE Heap;
PROCEDURE ^GC*(markStack: BOOLEAN);
PROCEDURE NEWREC*(tag: SYSTEM.ADDRESS): SYSTEM.PTR;
PROCEDURE NEWREC*(tag: Address): SYSTEM.PTR;
VAR
i, i0, di, blksz, restsize, t, adr, end, next, prev: SYSTEM.ADDRESS;
i, i0, di, blksz, restsize, t, adr, end, next, prev: Address;
new: SYSTEM.PTR;
BEGIN
Lock();
blksz := FetchAddress(tag);
ASSERT((Unit = 16) OR (Unit = 32));
ASSERT(SIZE(SYSTEM.PTR) = SIZE(SYSTEM.ADDRESS));
ASSERT(SIZE(SYSTEM.PTR) = SIZE(Address));
ASSERT(blksz MOD Unit = 0);
i0 := blksz DIV Unit; i := i0;
@ -310,23 +306,23 @@ MODULE Heap;
RETURN SYSTEM.VAL(SYSTEM.PTR, adr + SZA)
END NEWREC;
PROCEDURE NEWBLK*(size: SYSTEM.ADDRESS): SYSTEM.PTR;
VAR blksz, tag: SYSTEM.ADDRESS; new: SYSTEM.PTR;
PROCEDURE NEWBLK*(size: Address): SYSTEM.PTR;
VAR blksz, tag: Address; new: SYSTEM.PTR;
BEGIN
Lock();
blksz := (size + (4*SZA + Unit - 1)) DIV Unit * Unit; (*size + tag + meta + blksz + sntnl + UnitAlignment*)
new := NEWREC(SYSTEM.ADR(blksz));
tag := SYSTEM.VAL(SYSTEM.ADDRESS, new) + blksz - 3*SZA;
tag := SYSTEM.VAL(Address, new) + blksz - 3*SZA;
SYSTEM.PUT(tag - SZA, AddressZero); (*reserved for meta info*)
SYSTEM.PUT(tag, blksz);
SYSTEM.PUT(tag + SZA, NoPtrSntl);
SYSTEM.PUT(SYSTEM.VAL(SYSTEM.ADDRESS, new) - SZA, tag);
SYSTEM.PUT(SYSTEM.VAL(Address, new) - SZA, tag);
Unlock();
RETURN new
END NEWBLK;
PROCEDURE Mark(q: SYSTEM.ADDRESS);
VAR p, tag, offset, fld, n, tagbits: SYSTEM.ADDRESS;
PROCEDURE Mark(q: Address);
VAR p, tag, offset, fld, n, tagbits: Address;
BEGIN
IF q # 0 THEN
tagbits := FetchAddress(q - SZA); (* Load the tag for the record at q *)
@ -365,11 +361,11 @@ MODULE Heap;
PROCEDURE MarkP(p: SYSTEM.PTR); (* for compatibility with EnumPtrs in ANSI mode *)
BEGIN
Mark(SYSTEM.VAL(SYSTEM.ADDRESS, p))
Mark(SYSTEM.VAL(Address, p))
END MarkP;
PROCEDURE Scan;
VAR chnk, adr, end, start, tag, i, size, freesize: SYSTEM.ADDRESS;
VAR chnk, adr, end, start, tag, i, size, freesize: Address;
BEGIN bigBlocks := 0; i := 1;
WHILE i < nofLists DO freeList[i] := 0; INC(i) END ;
freesize := 0; allocated := 0; chnk := heap;
@ -414,8 +410,8 @@ MODULE Heap;
END
END Scan;
PROCEDURE Sift (l, r: SYSTEM.ADDRESS; VAR a: ARRAY OF SYSTEM.ADDRESS);
VAR i, j, x: SYSTEM.ADDRESS;
PROCEDURE Sift (l, r: Address; VAR a: ARRAY OF Address);
VAR i, j, x: Address;
BEGIN j := l; x := a[j];
LOOP i := j; j := 2*j + 1;
IF (j < r) & (a[j] < a[j+1]) THEN INC(j) END;
@ -425,15 +421,15 @@ MODULE Heap;
a[i] := x
END Sift;
PROCEDURE HeapSort (n: SYSTEM.ADDRESS; VAR a: ARRAY OF SYSTEM.ADDRESS);
VAR l, r, x: SYSTEM.ADDRESS;
PROCEDURE HeapSort (n: Address; VAR a: ARRAY OF Address);
VAR l, r, x: Address;
BEGIN l := n DIV 2; r := n - 1;
WHILE l > 0 DO DEC(l); Sift(l, r, a) END;
WHILE r > 0 DO x := a[0]; a[0] := a[r]; a[r] := x; DEC(r); Sift(l, r, a) END
END HeapSort;
PROCEDURE MarkCandidates(n: SYSTEM.ADDRESS; VAR cand: ARRAY OF SYSTEM.ADDRESS);
VAR chnk, adr, tag, next, lim, lim1, i, ptr, size: SYSTEM.ADDRESS;
PROCEDURE MarkCandidates(n: Address; VAR cand: ARRAY OF Address);
VAR chnk, adr, tag, next, lim, lim1, i, ptr, size: Address;
BEGIN
chnk := heap; i := 0; lim := cand[n-1];
WHILE (chnk # 0 ) & (chnk < lim) DO
@ -459,7 +455,7 @@ MODULE Heap;
END MarkCandidates;
PROCEDURE CheckFin;
VAR n: FinNode; tag: SYSTEM.ADDRESS;
VAR n: FinNode; tag: Address;
BEGIN
n := fin;
WHILE n # NIL DO
@ -496,13 +492,13 @@ MODULE Heap;
END FINALL;
PROCEDURE -ExternMainStackFrame "extern address Platform_MainStackFrame;";
PROCEDURE -PlatformMainStackFrame(): SYSTEM.ADDRESS "Platform_MainStackFrame";
PROCEDURE -PlatformMainStackFrame(): Address "Platform_MainStackFrame";
PROCEDURE MarkStack(n: SYSTEM.ADDRESS; VAR cand: ARRAY OF SYSTEM.ADDRESS);
PROCEDURE MarkStack(n: Address; VAR cand: ARRAY OF Address);
VAR
frame: SYSTEM.PTR;
inc, nofcand: SYSTEM.ADDRESS;
sp, p, stack0: SYSTEM.ADDRESS;
inc, nofcand: Address;
sp, p, stack0: Address;
align: RECORD ch: CHAR; p: SYSTEM.PTR END ;
BEGIN
IF n > 0 THEN MarkStack(n-1, cand); (* flush register windows by means of recursive calls *)
@ -529,8 +525,8 @@ MODULE Heap;
PROCEDURE GC*(markStack: BOOLEAN);
VAR
m: Module;
i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23: SYSTEM.ADDRESS;
cand: ARRAY 10000 OF SYSTEM.ADDRESS;
i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23: Address;
cand: ARRAY 10000 OF Address;
BEGIN
IF (lockdepth = 0) OR (lockdepth = 1) & ~markStack THEN
Lock();
@ -565,7 +561,7 @@ MODULE Heap;
PROCEDURE RegisterFinalizer*(obj: SYSTEM.PTR; finalize: Finalizer);
VAR f: FinNode;
BEGIN NEW(f);
f.obj := SYSTEM.VAL(SYSTEM.ADDRESS, obj); f.finalize := finalize; f.marked := TRUE;
f.obj := SYSTEM.VAL(Address, obj); f.finalize := finalize; f.marked := TRUE;
f.next := fin; fin := f;
END RegisterFinalizer;

96
src/system/SYSTEM.c
View file

@ -46,37 +46,6 @@ int64 SYSTEM_MOD(int64 x, int64 y)
else {return -((-x) % (-y));}
}
void SYSTEM_INHERIT(LONGINT *t, LONGINT *t0)
{
t -= __TPROC0OFF;
t0 -= __TPROC0OFF;
while (*t0 != __EOM) {*t = *t0; t--; t0--;}
}
void SYSTEM_ENUMP(void *adr, LONGINT n, void (*P)())
{
while (n > 0) {
P((address)(*((void**)(adr))));
adr = ((void**)adr) + 1;
n--;
}
}
void SYSTEM_ENUMR(void *adr, LONGINT *typ, LONGINT size, LONGINT n, void (*P)())
{
LONGINT *t, off;
typ++;
while (n > 0) {
t = typ;
off = *t;
while (off >= 0) {P(*(address*)((char*)adr+off)); t++; off = *t;}
adr = ((char*)adr) + size;
n--;
}
}
LONGINT SYSTEM_ENTIER(double x)
{
LONGINT y;
@ -88,22 +57,55 @@ LONGINT SYSTEM_ENTIER(double x)
}
}
void SYSTEM_INHERIT(address *t, address *t0)
{
t -= __TPROC0OFF;
t0 -= __TPROC0OFF;
while (*t0 != __EOM) {*t = *t0; t--; t0--;}
}
void SYSTEM_ENUMP(void *adr, address n, void (*P)())
{
while (n > 0) {
P((address)(*((void**)(adr))));
adr = ((void**)adr) + 1;
n--;
}
}
void SYSTEM_ENUMR(void *adr, address *typ, address size, address n, void (*P)())
{
address *t, off;
typ++;
while (n > 0) {
t = typ;
off = *t;
while (off >= 0) {P(*(address*)((char*)adr+off)); t++; off = *t;}
adr = ((char*)adr) + size;
n--;
}
}
extern void Heap_Lock();
extern void Heap_Unlock();
SYSTEM_PTR SYSTEM_NEWARR(LONGINT *typ, LONGINT elemsz, int elemalgn, int nofdim, int nofdyn, ...)
SYSTEM_PTR SYSTEM_NEWARR(address *typ, address elemsz, int elemalgn, int nofdim, int nofdyn, ...)
{
LONGINT nofelems, size, dataoff, n, nptr, *x, *p, nofptrs, i, *ptab, off;
address nofelems, size, dataoff, n, nptr, *x, *p, nofptrs, i, *ptab, off;
va_list ap;
va_start(ap, nofdyn);
nofelems = 1;
while (nofdim > 0) {
nofelems = nofelems * va_arg(ap, LONGINT); nofdim--;
nofelems = nofelems * va_arg(ap, address); nofdim--;
if (nofelems <= 0) __HALT(-20);
}
va_end(ap);
dataoff = nofdyn * sizeof(LONGINT);
if (elemalgn > sizeof(LONGINT)) {
dataoff = nofdyn * sizeof(address);
if (elemalgn > sizeof(address)) {
n = dataoff % elemalgn;
if (n != 0) dataoff += elemalgn - n;
}
@ -113,37 +115,37 @@ SYSTEM_PTR SYSTEM_NEWARR(LONGINT *typ, LONGINT elemsz, int elemalgn, int nofdim,
/* element typ does not contain pointers */
x = Heap_NEWBLK(size);
}
else if (typ == (LONGINT*)POINTER__typ) {
else if (typ == (address*)POINTER__typ) {
/* element type is a pointer */
x = Heap_NEWBLK(size + nofelems * sizeof(LONGINT));
p = (LONGINT*)(address)x[-1];
x = Heap_NEWBLK(size + nofelems * sizeof(address));
p = (address*)(address)x[-1];
p[-nofelems] = *p; /* build new type desc in situ: 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */
p -= nofelems - 1; n = 1; /* n =1 for skipping the size field */
while (n <= nofelems) {*p = n*sizeof(LONGINT); p++; n++;}
*p = - (nofelems + 1) * sizeof(LONGINT); /* sentinel */
x[-1] -= nofelems * sizeof(LONGINT);
while (n <= nofelems) {*p = n*sizeof(address); p++; n++;}
*p = - (nofelems + 1) * sizeof(address); /* sentinel */
x[-1] -= nofelems * sizeof(address);
}
else {
/* element type is a record that contains pointers */
ptab = typ + 1; nofptrs = 0;
while (ptab[nofptrs] >= 0) {nofptrs++;} /* number of pointers per element */
nptr = nofelems * nofptrs; /* total number of pointers */
x = Heap_NEWBLK(size + nptr * sizeof(LONGINT));
p = (LONGINT*)(address)x[- 1];
x = Heap_NEWBLK(size + nptr * sizeof(address));
p = (address*)(address)x[- 1];
p[-nptr] = *p; /* build new type desc in situ; 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */
p -= nptr - 1; n = 0; off = dataoff;
while (n < nofelems) {i = 0;
while (i < nofptrs) {*p = off + ptab[i]; p++; i++;}
off += elemsz; n++;
}
*p = - (nptr + 1) * sizeof(LONGINT); /* sentinel */
x[-1] -= nptr * sizeof(LONGINT);
*p = - (nptr + 1) * sizeof(address); /* sentinel */
x[-1] -= nptr * sizeof(address);
}
if (nofdyn != 0) {
/* setup len vector for index checks */
va_start(ap, nofdyn);
p = x;
while (nofdyn > 0) {*p = va_arg(ap, LONGINT); p++, nofdyn--;}
while (nofdyn > 0) {*p = va_arg(ap, address); p++, nofdyn--;}
va_end(ap);
}
Heap_Unlock();

56
src/system/SYSTEM.h
View file

@ -243,6 +243,10 @@ static inline double SYSTEM_ABSD(double i) {return i >= 0.0 ? i : -i;}
#define __CASECHK __HALT(-4)
#define __WITHCHK __HALT(-7)
#define __IS(tag, typ, level) (*(tag-(__BASEOFF-level))==(LONGINT)(address)typ##__typ)
#define __TYPEOF(p) ((LONGINT*)(address)(*(((LONGINT*)(p))-1)))
#define __ISP(p, typ, level) __IS(__TYPEOF(p),typ,level)
#define __GUARDP(p, typ, level) ((typ*)(__ISP(p,typ,level)?p:(__HALT(-5),p)))
#define __GUARDR(r, typ, level) (*((typ*)(__IS(r##__typ,typ,level)?r:(__HALT(-5),r))))
#define __GUARDA(p, typ, level) ((struct typ*)(__IS(__TYPEOF(p),typ,level)?p:(__HALT(-5),p)))
@ -282,56 +286,52 @@ extern SYSTEM_PTR Heap_NEWBLK (address size);
extern SYSTEM_PTR Heap_NEWREC (address tag);
extern SYSTEM_PTR SYSTEM_NEWARR(LONGINT*, LONGINT, int, int, int, ...);
#define __SYSNEW(p, len) p = Heap_NEWBLK((LONGINT)(len))
#define __NEW(p, t) p = Heap_NEWREC((LONGINT)(address)t##__typ)
#define __SYSNEW(p, len) p = Heap_NEWBLK((address)(len))
#define __NEW(p, t) p = Heap_NEWREC((address)t##__typ)
#define __NEWARR SYSTEM_NEWARR
/* Type handling */
extern void SYSTEM_INHERIT(LONGINT *t, LONGINT *t0);
extern void SYSTEM_ENUMP (void *adr, LONGINT n, void (*P)());
extern void SYSTEM_ENUMR (void *adr, LONGINT *typ, LONGINT size, LONGINT n, void (*P)());
extern void SYSTEM_INHERIT(address *t, address *t0);
extern void SYSTEM_ENUMP (void *adr, address n, void (*P)());
extern void SYSTEM_ENUMR (void *adr, address *typ, address size, address n, void (*P)());
#define __TDESC(t, m, n) \
static struct t##__desc { \
LONGINT tproc[m]; /* Proc for each ptr field */ \
LONGINT tag; \
LONGINT next; /* Module table type list points here */ \
LONGINT level; \
LONGINT module; \
address tproc[m]; /* Proc for each ptr field */ \
address tag; \
address next; /* Module table type list points here */ \
address level; \
address module; \
char name[24]; \
LONGINT basep[__MAXEXT]; /* List of bases this extends */ \
LONGINT reserved; \
LONGINT blksz; /* xxx_typ points here */ \
LONGINT ptr[n+1]; /* Offsets of ptrs up to -ve sentinel */ \
address basep[__MAXEXT]; /* List of bases this extends */ \
address reserved; \
address blksz; /* xxx_typ points here */ \
address ptr[n+1]; /* Offsets of ptrs up to -ve sentinel */ \
} t##__desc
#define __BASEOFF (__MAXEXT+1) // blksz as index to base.
#define __TPROC0OFF (__BASEOFF+24/sizeof(LONGINT)+5) // blksz as index to tproc IFF m=1.
#define __TPROC0OFF (__BASEOFF+24/sizeof(address)+5) // blksz as index to tproc IFF m=1.
#define __EOM 1
#define __TDFLDS(name, size) {__EOM}, 1, 0, 0, 0, name, {0}, 0, size
#define __ENUMP(adr, n, P) SYSTEM_ENUMP(adr, (LONGINT)(n), P)
#define __ENUMR(adr, typ, size, n, P) SYSTEM_ENUMR(adr, typ, (LONGINT)(size), (LONGINT)(n), P)
#define __ENUMP(adr, n, P) SYSTEM_ENUMP(adr, (address)(n), P)
#define __ENUMR(adr, typ, size, n, P) SYSTEM_ENUMR(adr, typ, (address)(size), (address)(n), P)
#define __INITYP(t, t0, level) \
t##__typ = (LONGINT*)&t##__desc.blksz; \
memcpy(t##__desc.basep, t0##__typ - __BASEOFF, level*sizeof(LONGINT)); \
t##__desc.basep[level] = (LONGINT)(address)t##__typ; \
t##__desc.module = (LONGINT)(address)m; \
t##__typ = (address*)&t##__desc.blksz; \
memcpy(t##__desc.basep, t0##__typ - __BASEOFF, level*sizeof(address)); \
t##__desc.basep[level] = (address)t##__typ; \
t##__desc.module = (address)m; \
if(t##__desc.blksz!=sizeof(struct t)) __HALT(-15); \
t##__desc.blksz = (t##__desc.blksz+5*sizeof(LONGINT)-1)/(4*sizeof(LONGINT))*(4*sizeof(LONGINT)); \
Heap_REGTYP(m, (LONGINT)(address)&t##__desc.next); \
t##__desc.blksz = (t##__desc.blksz+5*sizeof(address)-1)/(4*sizeof(address))*(4*sizeof(address)); \
Heap_REGTYP(m, (address)&t##__desc.next); \
SYSTEM_INHERIT(t##__typ, t0##__typ)
#define __IS(tag, typ, level) (*(tag-(__BASEOFF-level))==(LONGINT)(address)typ##__typ)
#define __TYPEOF(p) ((LONGINT*)(address)(*(((LONGINT*)(p))-1)))
#define __ISP(p, typ, level) __IS(__TYPEOF(p),typ,level)
// Oberon-2 type bound procedures support
#define __INITBP(t, proc, num) *(t##__typ-(__TPROC0OFF+num))=(LONGINT)(address)proc
#define __INITBP(t, proc, num) *(t##__typ-(__TPROC0OFF+num))=(address)proc
#define __SEND(typ, num, funtyp, parlist) ((funtyp)((address)*(typ-(__TPROC0OFF+num))))parlist

2
src/test/confidence/planned-binary-change
View file

@ -1 +1 @@
13 Sep 2016 20:12:45
14 Sep 2016 13:00:54