diff --git a/bootstrap/unix-44/OPB.c b/bootstrap/unix-44/OPB.c index 3af88ab8..07797236 100644 --- a/bootstrap/unix-44/OPB.c +++ b/bootstrap/unix-44/OPB.c @@ -1124,7 +1124,7 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ) if ((*x)->class == 7) { if (f == 4) { if (g == 4) { - if (f > g) { + if ((*x)->typ->size > typ->size) { OPB_SetIntType(*x); if ((*x)->typ->size > typ->size) { 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)) { OPB_err(-308); } - t = OPT_NewNode(11); - t->subcl = 29; - t->left = x; - x = t; - x->typ = p->typ; + if ((((x->class == 7 && x->typ->form == 4)) && p->typ->form == 4)) { + OPB_Convert(&x, p->typ); + } else { + t = OPT_NewNode(11); + t->subcl = 29; + t->left = x; + x = t; + x->typ = p->typ; + } p = x; break; case 30: diff --git a/bootstrap/unix-44/SYSTEM.h b/bootstrap/unix-44/SYSTEM.h index b7d405ff..2622657f 100644 --- a/bootstrap/unix-44/SYSTEM.h +++ b/bootstrap/unix-44/SYSTEM.h @@ -40,7 +40,6 @@ typedef signed char int8; typedef unsigned char uint8; #define uintptr size_t -//#define uintptr int64 // The compiler uses 'import' and 'export' which translate to 'extern' and // nothing respectively. diff --git a/bootstrap/unix-48/OPB.c b/bootstrap/unix-48/OPB.c index 3af88ab8..07797236 100644 --- a/bootstrap/unix-48/OPB.c +++ b/bootstrap/unix-48/OPB.c @@ -1124,7 +1124,7 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ) if ((*x)->class == 7) { if (f == 4) { if (g == 4) { - if (f > g) { + if ((*x)->typ->size > typ->size) { OPB_SetIntType(*x); if ((*x)->typ->size > typ->size) { 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)) { OPB_err(-308); } - t = OPT_NewNode(11); - t->subcl = 29; - t->left = x; - x = t; - x->typ = p->typ; + if ((((x->class == 7 && x->typ->form == 4)) && p->typ->form == 4)) { + OPB_Convert(&x, p->typ); + } else { + t = OPT_NewNode(11); + t->subcl = 29; + t->left = x; + x = t; + x->typ = p->typ; + } p = x; break; case 30: diff --git a/bootstrap/unix-48/SYSTEM.h b/bootstrap/unix-48/SYSTEM.h index b7d405ff..2622657f 100644 --- a/bootstrap/unix-48/SYSTEM.h +++ b/bootstrap/unix-48/SYSTEM.h @@ -40,7 +40,6 @@ typedef signed char int8; typedef unsigned char uint8; #define uintptr size_t -//#define uintptr int64 // The compiler uses 'import' and 'export' which translate to 'extern' and // nothing respectively. diff --git a/bootstrap/unix-88/OPB.c b/bootstrap/unix-88/OPB.c index bab019ae..5ede35ed 100644 --- a/bootstrap/unix-88/OPB.c +++ b/bootstrap/unix-88/OPB.c @@ -1125,7 +1125,7 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ) if ((*x)->class == 7) { if (f == 4) { if (g == 4) { - if (f > g) { + if ((*x)->typ->size > typ->size) { OPB_SetIntType(*x); if ((*x)->typ->size > typ->size) { 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)) { OPB_err(-308); } - t = OPT_NewNode(11); - t->subcl = 29; - t->left = x; - x = t; - x->typ = p->typ; + if ((((x->class == 7 && x->typ->form == 4)) && p->typ->form == 4)) { + OPB_Convert(&x, p->typ); + } else { + t = OPT_NewNode(11); + t->subcl = 29; + t->left = x; + x = t; + x->typ = p->typ; + } p = x; break; case 30: diff --git a/bootstrap/unix-88/SYSTEM.h b/bootstrap/unix-88/SYSTEM.h index b7d405ff..2622657f 100644 --- a/bootstrap/unix-88/SYSTEM.h +++ b/bootstrap/unix-88/SYSTEM.h @@ -40,7 +40,6 @@ typedef signed char int8; typedef unsigned char uint8; #define uintptr size_t -//#define uintptr int64 // The compiler uses 'import' and 'export' which translate to 'extern' and // nothing respectively. diff --git a/bootstrap/windows-48/OPB.c b/bootstrap/windows-48/OPB.c index 3af88ab8..07797236 100644 --- a/bootstrap/windows-48/OPB.c +++ b/bootstrap/windows-48/OPB.c @@ -1124,7 +1124,7 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ) if ((*x)->class == 7) { if (f == 4) { if (g == 4) { - if (f > g) { + if ((*x)->typ->size > typ->size) { OPB_SetIntType(*x); if ((*x)->typ->size > typ->size) { 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)) { OPB_err(-308); } - t = OPT_NewNode(11); - t->subcl = 29; - t->left = x; - x = t; - x->typ = p->typ; + if ((((x->class == 7 && x->typ->form == 4)) && p->typ->form == 4)) { + OPB_Convert(&x, p->typ); + } else { + t = OPT_NewNode(11); + t->subcl = 29; + t->left = x; + x = t; + x->typ = p->typ; + } p = x; break; case 30: diff --git a/bootstrap/windows-48/SYSTEM.h b/bootstrap/windows-48/SYSTEM.h index b7d405ff..2622657f 100644 --- a/bootstrap/windows-48/SYSTEM.h +++ b/bootstrap/windows-48/SYSTEM.h @@ -40,7 +40,6 @@ typedef signed char int8; typedef unsigned char uint8; #define uintptr size_t -//#define uintptr int64 // The compiler uses 'import' and 'export' which translate to 'extern' and // nothing respectively. diff --git a/bootstrap/windows-88/OPB.c b/bootstrap/windows-88/OPB.c index bab019ae..5ede35ed 100644 --- a/bootstrap/windows-88/OPB.c +++ b/bootstrap/windows-88/OPB.c @@ -1125,7 +1125,7 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ) if ((*x)->class == 7) { if (f == 4) { if (g == 4) { - if (f > g) { + if ((*x)->typ->size > typ->size) { OPB_SetIntType(*x); if ((*x)->typ->size > typ->size) { 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)) { OPB_err(-308); } - t = OPT_NewNode(11); - t->subcl = 29; - t->left = x; - x = t; - x->typ = p->typ; + if ((((x->class == 7 && x->typ->form == 4)) && p->typ->form == 4)) { + OPB_Convert(&x, p->typ); + } else { + t = OPT_NewNode(11); + t->subcl = 29; + t->left = x; + x = t; + x->typ = p->typ; + } p = x; break; case 30: diff --git a/bootstrap/windows-88/SYSTEM.h b/bootstrap/windows-88/SYSTEM.h index b7d405ff..2622657f 100644 --- a/bootstrap/windows-88/SYSTEM.h +++ b/bootstrap/windows-88/SYSTEM.h @@ -40,7 +40,6 @@ typedef signed char int8; typedef unsigned char uint8; #define uintptr size_t -//#define uintptr int64 // The compiler uses 'import' and 'export' which translate to 'extern' and // nothing respectively. diff --git a/src/compiler/OPB.Mod b/src/compiler/OPB.Mod index 62be133a..73832049 100644 --- a/src/compiler/OPB.Mod +++ b/src/compiler/OPB.Mod @@ -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 *) 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 f = 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 END 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 ; p^.typ := OPT.booltyp |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) OR (x^.class = OPT.Nproc) 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; (* 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; - t := OPT.NewNode(OPT.Nmop); t^.subcl := OPT.val; t^.left := x; x := t; - (* - IF (x^.class >= OPT.Nconst) OR ((f IN OPT.realSet) # (p^.typ^.form IN OPT.realSet)) THEN - t := OPT.NewNode(OPT.Nmop); t^.subcl := val; t^.left := x; x := t - ELSE x^.readonly := FALSE - END ; - *) - x^.typ := p^.typ; p := x + + IF (x.class = OPT.Nconst) & (x.typ.form = OPT.Int) & (p.typ.form = OPT.Int) THEN + Convert(x, p.typ) + ELSE + t := OPT.NewNode(OPT.Nmop); t^.subcl := OPT.val; t^.left := x; x := t; + (* + IF (x^.class >= OPT.Nconst) OR ((f IN OPT.realSet) # (p^.typ^.form IN OPT.realSet)) THEN + 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*) IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126) ELSIF f = OPT.Int THEN diff --git a/src/system/Heap.Mod b/src/system/Heap.Mod index 6b6411a2..11723ec5 100644 --- a/src/system/Heap.Mod +++ b/src/system/Heap.Mod @@ -20,18 +20,17 @@ MODULE Heap; *) (* heap chunks *) - nextChnkOff = LONG(LONG(0)); (* next heap chunk, sorted ascendingly! *) - endOff = LONG(LONG(SZL)); (* end of heap chunk *) - blkOff = LONG(LONG(3*SZL)); (* first block in a chunk *) + nextChnkOff = SYSTEM.VAL(SYSTEM.UINTPTR, 0); (* next heap chunk, sorted ascendingly! *) + endOff = SYSTEM.VAL(SYSTEM.UINTPTR, SZL); (* end of heap chunk *) + blkOff = SYSTEM.VAL(SYSTEM.UINTPTR, 3*SZL); (* first block in a chunk *) (* heap blocks *) - tagOff = LONG(LONG(0)); (* block starts with tag *) - sizeOff = LONG(LONG(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 *) - nextOff = LONG(LONG(3*SZL)); (* next pointer in free block relative to block start *) - NoPtrSntl = LONG(LONG(-SZL)); - (*NoPtrSntl = SYSTEM.VAL(SYSTEM.UINTPTR, -SZL);*) - LongZero = LONG(LONG(0)); + tagOff = SYSTEM.VAL(SYSTEM.UINTPTR, 0); (* block starts with tag *) + sizeOff = SYSTEM.VAL(SYSTEM.UINTPTR, SZL); (* block size 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 = SYSTEM.VAL(SYSTEM.UINTPTR, 3*SZL); (* next pointer in free block relative to block start *) + NoPtrSntl = SYSTEM.VAL(SYSTEM.UINTPTR, -SZL); + AddressZero = SYSTEM.VAL(SYSTEM.UINTPTR, 0); TYPE ModuleName = ARRAY ModNameLen OF CHAR; @@ -296,16 +295,16 @@ MODULE Heap; END ; i := adr + 4*SZL; end := adr + blksz; WHILE i < end DO (*deliberately unrolled*) - SYSTEM.PUT(i, LongZero); - SYSTEM.PUT(i + SZL, LongZero); - SYSTEM.PUT(i + 2*SZL, LongZero); - SYSTEM.PUT(i + 3*SZL, LongZero); + SYSTEM.PUT(i, AddressZero); + SYSTEM.PUT(i + SZL, AddressZero); + SYSTEM.PUT(i + 2*SZL, AddressZero); + SYSTEM.PUT(i + 3*SZL, AddressZero); INC(i, 4*SZL) END ; - SYSTEM.PUT(adr + nextOff, LongZero); + SYSTEM.PUT(adr + nextOff, AddressZero); SYSTEM.PUT(adr, tag); - SYSTEM.PUT(adr + sizeOff, LongZero); - SYSTEM.PUT(adr + sntlOff, LongZero); + SYSTEM.PUT(adr + sizeOff, AddressZero); + SYSTEM.PUT(adr + sntlOff, AddressZero); INC(allocated, blksz); Unlock(); 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*) new := NEWREC(SYSTEM.ADR(blksz)); 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 + SZL, NoPtrSntl); SYSTEM.PUT(SYSTEM.VAL(LONGINT, new) - SZL, tag); @@ -580,7 +579,7 @@ PROCEDURE -HeapModuleInit 'Heap__init()'; BEGIN heap := NewChunk(heapSize0); heapend := FetchAddress(heap + endOff); - SYSTEM.PUT(heap, LongZero); + SYSTEM.PUT(heap, AddressZero); allocated := 0; firstTry := TRUE; freeList[nofLists] := 1; lockdepth := 0; FileCount := 0; modules := NIL; heapsize := 0; bigBlocks := 0; fin := NIL; interrupted := FALSE;