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

Allow SYSTEM.VAL of constant in CONST and use in Heap.Mod.

Browse source
This commit is contained in:
David Brown 2016-09-03 17:47:55 +01:00
parent a730d6c96b
commit db18774de1
12 changed files with 86 additions and 64 deletions
Download patch file Download diff file Expand all files Collapse all files

16
bootstrap/unix-44/OPB.c
View file

@ -1124,7 +1124,7 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
if ((*x)->class == 7) { if ((*x)->class == 7) {
if (f == 4) { if (f == 4) {
if (g == 4) { if (g == 4) {
if (f > g) { if ((*x)->typ->size > typ->size) {
OPB_SetIntType(*x); OPB_SetIntType(*x);
if ((*x)->typ->size > typ->size) { if ((*x)->typ->size > typ->size) {
OPB_err(203); OPB_err(203);
@ -2199,11 +2199,15 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, int8 fctno)
if ((x->class != 7 && x->typ->size < p->typ->size)) { if ((x->class != 7 && x->typ->size < p->typ->size)) {
OPB_err(-308); OPB_err(-308);
} }
t = OPT_NewNode(11); if ((((x->class == 7 && x->typ->form == 4)) && p->typ->form == 4)) {
t->subcl = 29; OPB_Convert(&x, p->typ);
t->left = x; } else {
x = t; t = OPT_NewNode(11);
x->typ = p->typ; t->subcl = 29;
t->left = x;
x = t;
x->typ = p->typ;
}
p = x; p = x;
break; break;
case 30: case 30:

1
bootstrap/unix-44/SYSTEM.h
View file

@ -40,7 +40,6 @@ typedef signed char int8;
typedef unsigned char uint8; typedef unsigned char uint8;
#define uintptr size_t #define uintptr size_t
//#define uintptr int64
// The compiler uses 'import' and 'export' which translate to 'extern' and // The compiler uses 'import' and 'export' which translate to 'extern' and
// nothing respectively. // nothing respectively.

16
bootstrap/unix-48/OPB.c
View file

@ -1124,7 +1124,7 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
if ((*x)->class == 7) { if ((*x)->class == 7) {
if (f == 4) { if (f == 4) {
if (g == 4) { if (g == 4) {
if (f > g) { if ((*x)->typ->size > typ->size) {
OPB_SetIntType(*x); OPB_SetIntType(*x);
if ((*x)->typ->size > typ->size) { if ((*x)->typ->size > typ->size) {
OPB_err(203); OPB_err(203);
@ -2199,11 +2199,15 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, int8 fctno)
if ((x->class != 7 && x->typ->size < p->typ->size)) { if ((x->class != 7 && x->typ->size < p->typ->size)) {
OPB_err(-308); OPB_err(-308);
} }
t = OPT_NewNode(11); if ((((x->class == 7 && x->typ->form == 4)) && p->typ->form == 4)) {
t->subcl = 29; OPB_Convert(&x, p->typ);
t->left = x; } else {
x = t; t = OPT_NewNode(11);
x->typ = p->typ; t->subcl = 29;
t->left = x;
x = t;
x->typ = p->typ;
}
p = x; p = x;
break; break;
case 30: case 30:

1
bootstrap/unix-48/SYSTEM.h
View file

@ -40,7 +40,6 @@ typedef signed char int8;
typedef unsigned char uint8; typedef unsigned char uint8;
#define uintptr size_t #define uintptr size_t
//#define uintptr int64
// The compiler uses 'import' and 'export' which translate to 'extern' and // The compiler uses 'import' and 'export' which translate to 'extern' and
// nothing respectively. // nothing respectively.

16
bootstrap/unix-88/OPB.c
View file

@ -1125,7 +1125,7 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
if ((*x)->class == 7) { if ((*x)->class == 7) {
if (f == 4) { if (f == 4) {
if (g == 4) { if (g == 4) {
if (f > g) { if ((*x)->typ->size > typ->size) {
OPB_SetIntType(*x); OPB_SetIntType(*x);
if ((*x)->typ->size > typ->size) { if ((*x)->typ->size > typ->size) {
OPB_err(203); OPB_err(203);
@ -2200,11 +2200,15 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, int8 fctno)
if ((x->class != 7 && x->typ->size < p->typ->size)) { if ((x->class != 7 && x->typ->size < p->typ->size)) {
OPB_err(-308); OPB_err(-308);
} }
t = OPT_NewNode(11); if ((((x->class == 7 && x->typ->form == 4)) && p->typ->form == 4)) {
t->subcl = 29; OPB_Convert(&x, p->typ);
t->left = x; } else {
x = t; t = OPT_NewNode(11);
x->typ = p->typ; t->subcl = 29;
t->left = x;
x = t;
x->typ = p->typ;
}
p = x; p = x;
break; break;
case 30: case 30:

1
bootstrap/unix-88/SYSTEM.h
View file

@ -40,7 +40,6 @@ typedef signed char int8;
typedef unsigned char uint8; typedef unsigned char uint8;
#define uintptr size_t #define uintptr size_t
//#define uintptr int64
// The compiler uses 'import' and 'export' which translate to 'extern' and // The compiler uses 'import' and 'export' which translate to 'extern' and
// nothing respectively. // nothing respectively.

16
bootstrap/windows-48/OPB.c
View file

@ -1124,7 +1124,7 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
if ((*x)->class == 7) { if ((*x)->class == 7) {
if (f == 4) { if (f == 4) {
if (g == 4) { if (g == 4) {
if (f > g) { if ((*x)->typ->size > typ->size) {
OPB_SetIntType(*x); OPB_SetIntType(*x);
if ((*x)->typ->size > typ->size) { if ((*x)->typ->size > typ->size) {
OPB_err(203); OPB_err(203);
@ -2199,11 +2199,15 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, int8 fctno)
if ((x->class != 7 && x->typ->size < p->typ->size)) { if ((x->class != 7 && x->typ->size < p->typ->size)) {
OPB_err(-308); OPB_err(-308);
} }
t = OPT_NewNode(11); if ((((x->class == 7 && x->typ->form == 4)) && p->typ->form == 4)) {
t->subcl = 29; OPB_Convert(&x, p->typ);
t->left = x; } else {
x = t; t = OPT_NewNode(11);
x->typ = p->typ; t->subcl = 29;
t->left = x;
x = t;
x->typ = p->typ;
}
p = x; p = x;
break; break;
case 30: case 30:

1
bootstrap/windows-48/SYSTEM.h
View file

@ -40,7 +40,6 @@ typedef signed char int8;
typedef unsigned char uint8; typedef unsigned char uint8;
#define uintptr size_t #define uintptr size_t
//#define uintptr int64
// The compiler uses 'import' and 'export' which translate to 'extern' and // The compiler uses 'import' and 'export' which translate to 'extern' and
// nothing respectively. // nothing respectively.

16
bootstrap/windows-88/OPB.c
View file

@ -1125,7 +1125,7 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
if ((*x)->class == 7) { if ((*x)->class == 7) {
if (f == 4) { if (f == 4) {
if (g == 4) { if (g == 4) {
if (f > g) { if ((*x)->typ->size > typ->size) {
OPB_SetIntType(*x); OPB_SetIntType(*x);
if ((*x)->typ->size > typ->size) { if ((*x)->typ->size > typ->size) {
OPB_err(203); OPB_err(203);
@ -2200,11 +2200,15 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, int8 fctno)
if ((x->class != 7 && x->typ->size < p->typ->size)) { if ((x->class != 7 && x->typ->size < p->typ->size)) {
OPB_err(-308); OPB_err(-308);
} }
t = OPT_NewNode(11); if ((((x->class == 7 && x->typ->form == 4)) && p->typ->form == 4)) {
t->subcl = 29; OPB_Convert(&x, p->typ);
t->left = x; } else {
x = t; t = OPT_NewNode(11);
x->typ = p->typ; t->subcl = 29;
t->left = x;
x = t;
x->typ = p->typ;
}
p = x; p = x;
break; break;
case 30: case 30:

1
bootstrap/windows-88/SYSTEM.h
View file

@ -40,7 +40,6 @@ typedef signed char int8;
typedef unsigned char uint8; typedef unsigned char uint8;
#define uintptr size_t #define uintptr size_t
//#define uintptr int64
// The compiler uses 'import' and 'export' which translate to 'extern' and // The compiler uses 'import' and 'export' which translate to 'extern' and
// nothing respectively. // nothing respectively.

28
src/compiler/OPB.Mod
View file

@ -598,11 +598,11 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
PROCEDURE Convert(VAR x: OPT.Node; typ: OPT.Struct); (* Convert node x to new type typ *) PROCEDURE Convert(VAR x: OPT.Node; typ: OPT.Struct); (* Convert node x to new type typ *)
VAR node: OPT.Node; f, g: INTEGER; k: LONGINT; r: LONGREAL; VAR node: OPT.Node; f, g: INTEGER; k: LONGINT; r: LONGREAL;
BEGIN f := x^.typ^.form; g := typ^.form; BEGIN f := x^.typ^.form; g := typ^.form; (* f: old form, g: new form *)
IF x^.class = OPT.Nconst THEN IF x^.class = OPT.Nconst THEN
IF f = OPT.Int THEN IF f = OPT.Int THEN
IF g = OPT.Int THEN IF g = OPT.Int THEN
IF f > g THEN SetIntType(x); IF x.typ.size > typ.size THEN SetIntType(x);
IF x.typ.size > typ.size THEN err(203); x^.conval^.intval := 1 END IF x.typ.size > typ.size THEN err(203); x^.conval^.intval := 1 END
END END
ELSIF g IN OPT.realSet THEN x^.conval^.realval := x^.conval^.intval; x^.conval^.intval := OPM.ConstNotAlloc ELSIF g IN OPT.realSet THEN x^.conval^.realval := x^.conval^.intval; x^.conval^.intval := OPM.ConstNotAlloc
@ -1201,6 +1201,8 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
END ; END ;
p^.typ := OPT.booltyp p^.typ := OPT.booltyp
|OPT.valfn: (*SYSTEM.VAL*) (* type is changed without considering the byte ordering on the target machine *) |OPT.valfn: (*SYSTEM.VAL*) (* type is changed without considering the byte ordering on the target machine *)
(* p (1st param): desired type *)
(* x (2nd param): constant or value to be converted to p *)
IF (x^.class = OPT.Ntype) IF (x^.class = OPT.Ntype)
OR (x^.class = OPT.Nproc) OR (x^.class = OPT.Nproc)
OR (f IN {OPT.Undef, OPT.String, OPT.NoTyp}) OR (f IN {OPT.Undef, OPT.String, OPT.NoTyp})
@ -1209,14 +1211,20 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
END; END;
(* Warn if the result type includes memory past the end of the source variable *) (* Warn if the result type includes memory past the end of the source variable *)
IF (x.class # OPT.Nconst) & (x.typ.size < p.typ.size) THEN err(-308) END; IF (x.class # OPT.Nconst) & (x.typ.size < p.typ.size) THEN err(-308) END;
t := OPT.NewNode(OPT.Nmop); t^.subcl := OPT.val; t^.left := x; x := t;
(* IF (x.class = OPT.Nconst) & (x.typ.form = OPT.Int) & (p.typ.form = OPT.Int) THEN
IF (x^.class >= OPT.Nconst) OR ((f IN OPT.realSet) # (p^.typ^.form IN OPT.realSet)) THEN Convert(x, p.typ)
t := OPT.NewNode(OPT.Nmop); t^.subcl := val; t^.left := x; x := t ELSE
ELSE x^.readonly := FALSE t := OPT.NewNode(OPT.Nmop); t^.subcl := OPT.val; t^.left := x; x := t;
END ; (*
*) IF (x^.class >= OPT.Nconst) OR ((f IN OPT.realSet) # (p^.typ^.form IN OPT.realSet)) THEN
x^.typ := p^.typ; p := x t := OPT.NewNode(OPT.Nmop); t^.subcl := val; t^.left := x; x := t
ELSE x^.readonly := FALSE
END ;
*)
x^.typ := p^.typ;
END;
p := x
|OPT.sysnewfn: (*SYSTEM.NEW*) |OPT.sysnewfn: (*SYSTEM.NEW*)
IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126) IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126)
ELSIF f = OPT.Int THEN ELSIF f = OPT.Int THEN

37
src/system/Heap.Mod
View file

@ -20,18 +20,17 @@ MODULE Heap;
*) *)
(* heap chunks *) (* heap chunks *)
nextChnkOff = LONG(LONG(0)); (* next heap chunk, sorted ascendingly! *) nextChnkOff = SYSTEM.VAL(SYSTEM.UINTPTR, 0); (* next heap chunk, sorted ascendingly! *)
endOff = LONG(LONG(SZL)); (* end of heap chunk *) endOff = SYSTEM.VAL(SYSTEM.UINTPTR, SZL); (* end of heap chunk *)
blkOff = LONG(LONG(3*SZL)); (* first block in a chunk *) blkOff = SYSTEM.VAL(SYSTEM.UINTPTR, 3*SZL); (* first block in a chunk *)
(* heap blocks *) (* heap blocks *)
tagOff = LONG(LONG(0)); (* block starts with tag *) tagOff = SYSTEM.VAL(SYSTEM.UINTPTR, 0); (* block starts with tag *)
sizeOff = LONG(LONG(SZL)); (* block size in free block relative to block start *) sizeOff = SYSTEM.VAL(SYSTEM.UINTPTR, SZL); (* block size in free block relative to block start *)
sntlOff = LONG(LONG(2*SZL)); (* pointer offset table sentinel in free block relative to block start *) sntlOff = SYSTEM.VAL(SYSTEM.UINTPTR, 2*SZL); (* pointer offset table sentinel in free block relative to block start *)
nextOff = LONG(LONG(3*SZL)); (* next pointer in free block relative to block start *) nextOff = SYSTEM.VAL(SYSTEM.UINTPTR, 3*SZL); (* next pointer in free block relative to block start *)
NoPtrSntl = LONG(LONG(-SZL)); NoPtrSntl = SYSTEM.VAL(SYSTEM.UINTPTR, -SZL);
(*NoPtrSntl = SYSTEM.VAL(SYSTEM.UINTPTR, -SZL);*) AddressZero = SYSTEM.VAL(SYSTEM.UINTPTR, 0);
LongZero = LONG(LONG(0));
TYPE TYPE
ModuleName = ARRAY ModNameLen OF CHAR; ModuleName = ARRAY ModNameLen OF CHAR;
@ -296,16 +295,16 @@ MODULE Heap;
END ; END ;
i := adr + 4*SZL; end := adr + blksz; i := adr + 4*SZL; end := adr + blksz;
WHILE i < end DO (*deliberately unrolled*) WHILE i < end DO (*deliberately unrolled*)
SYSTEM.PUT(i, LongZero); SYSTEM.PUT(i, AddressZero);
SYSTEM.PUT(i + SZL, LongZero); SYSTEM.PUT(i + SZL, AddressZero);
SYSTEM.PUT(i + 2*SZL, LongZero); SYSTEM.PUT(i + 2*SZL, AddressZero);
SYSTEM.PUT(i + 3*SZL, LongZero); SYSTEM.PUT(i + 3*SZL, AddressZero);
INC(i, 4*SZL) INC(i, 4*SZL)
END ; END ;
SYSTEM.PUT(adr + nextOff, LongZero); SYSTEM.PUT(adr + nextOff, AddressZero);
SYSTEM.PUT(adr, tag); SYSTEM.PUT(adr, tag);
SYSTEM.PUT(adr + sizeOff, LongZero); SYSTEM.PUT(adr + sizeOff, AddressZero);
SYSTEM.PUT(adr + sntlOff, LongZero); SYSTEM.PUT(adr + sntlOff, AddressZero);
INC(allocated, blksz); INC(allocated, blksz);
Unlock(); Unlock();
RETURN SYSTEM.VAL(SYSTEM.PTR, adr + SZL) RETURN SYSTEM.VAL(SYSTEM.PTR, adr + SZL)
@ -318,7 +317,7 @@ MODULE Heap;
blksz := (size + (4*SZL + Unit - 1)) DIV Unit * Unit; (*size + tag + meta + blksz + sntnl + UnitAlignment*) blksz := (size + (4*SZL + Unit - 1)) DIV Unit * Unit; (*size + tag + meta + blksz + sntnl + UnitAlignment*)
new := NEWREC(SYSTEM.ADR(blksz)); new := NEWREC(SYSTEM.ADR(blksz));
tag := SYSTEM.VAL(LONGINT, new) + blksz - 3*SZL; tag := SYSTEM.VAL(LONGINT, new) + blksz - 3*SZL;
SYSTEM.PUT(tag - SZL, LongZero); (*reserved for meta info*) SYSTEM.PUT(tag - SZL, AddressZero); (*reserved for meta info*)
SYSTEM.PUT(tag, blksz); SYSTEM.PUT(tag, blksz);
SYSTEM.PUT(tag + SZL, NoPtrSntl); SYSTEM.PUT(tag + SZL, NoPtrSntl);
SYSTEM.PUT(SYSTEM.VAL(LONGINT, new) - SZL, tag); SYSTEM.PUT(SYSTEM.VAL(LONGINT, new) - SZL, tag);
@ -580,7 +579,7 @@ PROCEDURE -HeapModuleInit 'Heap__init()';
BEGIN BEGIN
heap := NewChunk(heapSize0); heap := NewChunk(heapSize0);
heapend := FetchAddress(heap + endOff); heapend := FetchAddress(heap + endOff);
SYSTEM.PUT(heap, LongZero); SYSTEM.PUT(heap, AddressZero);
allocated := 0; firstTry := TRUE; freeList[nofLists] := 1; lockdepth := 0; allocated := 0; firstTry := TRUE; freeList[nofLists] := 1; lockdepth := 0;
FileCount := 0; modules := NIL; heapsize := 0; bigBlocks := 0; fin := NIL; FileCount := 0; modules := NIL; heapsize := 0; bigBlocks := 0; fin := NIL;
interrupted := FALSE; interrupted := FALSE;