Index: m3-comm/events/src/EventStubLib.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-comm/events/src/EventStubLib.m3,v retrieving revision 1.2 diff -u -r1.2 EventStubLib.m3 --- m3-comm/events/src/EventStubLib.m3 2 Dec 2001 00:20:37 -0000 1.2 +++ m3-comm/events/src/EventStubLib.m3 16 Jan 2010 13:38:25 -0000 @@ -16,12 +16,17 @@ * Update Count : 137 * * $Source: /usr/cvs/cm3/m3-comm/events/src/EventStubLib.m3,v $ - * $Date: 2001-12-02 00:20:37 $ - * $Author: wagner $ - * $Revision: 1.2 $ + * $Date: 2010-01-16 02:33:01 $ + * $Author: hosking $ + * $Revision: 1.3 $ * * $Log: EventStubLib.m3,v $ - * Revision 1.2 2001-12-02 00:20:37 wagner + * Revision 1.3 2010-01-16 02:33:01 hosking + * Initial support for LONGINT and LONGCARD. + * Still needs vetting for proper conversion of 64-bit and 32-bit LONGINT/LONGCARD + * (the integrated Win32 backend still treats LONGINT as 32 bits). + * + * Revision 1.2 2001/12/02 00:20:37 wagner * add copyright notes, fix overrides for cm3, and make everything compile * * added: events/COPYRIGHT-COLUMBIA Index: m3-comm/sharedobjgen/src/AstToType.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-comm/sharedobjgen/src/AstToType.m3,v retrieving revision 1.2 diff -u -r1.2 AstToType.m3 --- m3-comm/sharedobjgen/src/AstToType.m3 17 Mar 2008 16:36:44 -0000 1.2 +++ m3-comm/sharedobjgen/src/AstToType.m3 16 Jan 2010 13:38:25 -0000 @@ -368,6 +368,7 @@ EVAL astTable.put(M3CStdTypes.WideChar(), Type.widechar); EVAL astTable.put(M3CStdTypes.Text(), Type.text); EVAL astTable.put(M3CStdTypes.Cardinal(), Type.cardinal); + EVAL astTable.put(M3CStdTypes.Longcard(), Type.longcard); EVAL astTable.put(M3CStdTypes.Boolean(), Type.boolean); EVAL astTable.put(M3CStdTypes.Mutex(), Type.mutex); END InitAstTable; Index: m3-comm/sharedobjgen/src/CodeForType.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-comm/sharedobjgen/src/CodeForType.m3,v retrieving revision 1.2 diff -u -r1.2 CodeForType.m3 --- m3-comm/sharedobjgen/src/CodeForType.m3 17 Mar 2008 16:36:44 -0000 1.2 +++ m3-comm/sharedobjgen/src/CodeForType.m3 16 Jan 2010 13:38:25 -0000 @@ -41,7 +41,7 @@ BEGIN IF sub = Type.integer THEN RETURN "INTEGER" END; IF sub = Type.longint THEN RETURN "LONGINT" END; - IF sub.base = Type.longint THEN + IF sub.base = Type.longint OR sub.base = Type.longcard THEN WITH min = NARROW(sub.min, Value.Longint).val, max = NARROW(sub.max, Value.Longint).val DO RETURN "[" & Fmt.LongInt(min) & "L.." & Fmt.LongInt(max) & "L]"; Index: m3-comm/sharedobjgen/src/Type.i3 =================================================================== RCS file: /usr/cvs/cm3/m3-comm/sharedobjgen/src/Type.i3,v retrieving revision 1.2 diff -u -r1.2 Type.i3 --- m3-comm/sharedobjgen/src/Type.i3 17 Mar 2008 16:36:44 -0000 1.2 +++ m3-comm/sharedobjgen/src/Type.i3 16 Jan 2010 13:38:25 -0000 @@ -177,6 +177,7 @@ integer : Subrange; longint : Subrange; cardinal : Subrange; + longcard : Subrange; boolean : UserDefined; char : Char; widechar : WideChar; Index: m3-comm/sharedobjgen/src/Type.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-comm/sharedobjgen/src/Type.m3,v retrieving revision 1.2 diff -u -r1.2 Type.m3 --- m3-comm/sharedobjgen/src/Type.m3 17 Mar 2008 16:36:44 -0000 1.2 +++ m3-comm/sharedobjgen/src/Type.m3 16 Jan 2010 13:38:25 -0000 @@ -279,6 +279,10 @@ item := Atom.FromText("CARDINAL")), base := integer, min := NEW(Value.Integer, val := 0), max := integer.max); + longcard := NEW(Subrange, name := NEW(Qid, intf := nullAtm, + item := Atom.FromText("LONGCARD")), + base := longint, min := NEW(Value.Longint, val := 0L), + max := longint.max); boolean := NEW( UserDefined, name := NEW(Qid, intf := nullAtm, Index: m3-comm/sharedobjgen/src/Value.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-comm/sharedobjgen/src/Value.m3,v retrieving revision 1.2 diff -u -r1.2 Value.m3 --- m3-comm/sharedobjgen/src/Value.m3 17 Mar 2008 16:36:44 -0000 1.2 +++ m3-comm/sharedobjgen/src/Value.m3 16 Jan 2010 13:38:25 -0000 @@ -37,7 +37,7 @@ END; END; | Longint (i) => - IF (type = Type.longint) THEN + IF (type = Type.longint) OR (type = Type.longcard) THEN RETURN Fmt.LongInt(i.val); ELSE TYPECASE type OF | Type.Subrange (sub) => Index: m3-comm/stubgen/src/AstToType.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-comm/stubgen/src/AstToType.m3,v retrieving revision 1.4 diff -u -r1.4 AstToType.m3 --- m3-comm/stubgen/src/AstToType.m3 17 Mar 2008 17:09:02 -0000 1.4 +++ m3-comm/stubgen/src/AstToType.m3 16 Jan 2010 13:38:25 -0000 @@ -153,6 +153,7 @@ EVAL astTable.put(M3CStdTypes.WideChar(), Type.widechar); EVAL astTable.put(M3CStdTypes.Text(), Type.text); EVAL astTable.put(M3CStdTypes.Cardinal(), Type.cardinal); + EVAL astTable.put(M3CStdTypes.Longcard(), Type.longcard); EVAL astTable.put(M3CStdTypes.Boolean(), Type.boolean); EVAL astTable.put(M3CStdTypes.Mutex(), Type.mutex); END InitAstTable; Index: m3-comm/stubgen/src/CodeForType.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-comm/stubgen/src/CodeForType.m3,v retrieving revision 1.4 diff -u -r1.4 CodeForType.m3 --- m3-comm/stubgen/src/CodeForType.m3 17 Mar 2008 17:09:02 -0000 1.4 +++ m3-comm/stubgen/src/CodeForType.m3 16 Jan 2010 13:38:25 -0000 @@ -41,7 +41,7 @@ BEGIN IF sub = Type.integer THEN RETURN "INTEGER" END; IF sub = Type.longint THEN RETURN "LONGINT" END; - IF sub.base = Type.longint THEN + IF sub.base = Type.longint OR sub.base = Type.longcard THEN WITH min = NARROW(sub.min, Value.Longint).val, max = NARROW(sub.max, Value.Longint).val DO RETURN "[" & Fmt.LongInt(min) & "L.." & Fmt.LongInt(max) & "L]"; Index: m3-comm/stubgen/src/Type.i3 =================================================================== RCS file: /usr/cvs/cm3/m3-comm/stubgen/src/Type.i3,v retrieving revision 1.4 diff -u -r1.4 Type.i3 --- m3-comm/stubgen/src/Type.i3 17 Mar 2008 17:09:02 -0000 1.4 +++ m3-comm/stubgen/src/Type.i3 16 Jan 2010 13:38:25 -0000 @@ -177,6 +177,7 @@ integer : Subrange; longint : Subrange; cardinal : Subrange; + longcard : Subrange; boolean : UserDefined; char : Char; widechar : WideChar; Index: m3-comm/stubgen/src/Type.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-comm/stubgen/src/Type.m3,v retrieving revision 1.5 diff -u -r1.5 Type.m3 --- m3-comm/stubgen/src/Type.m3 29 Apr 2009 05:49:40 -0000 1.5 +++ m3-comm/stubgen/src/Type.m3 16 Jan 2010 13:38:25 -0000 @@ -278,6 +278,10 @@ item := Atom.FromText("CARDINAL")), base := integer, min := NEW(Value.Integer, val := 0), max := integer.max); + longcard := NEW(Subrange, name := NEW(Qid, intf := nullAtm, + item := Atom.FromText("LONGCARD")), + base := longint, min := NEW(Value.Longint, val := 0L), + max := longint.max); boolean := NEW( UserDefined, name := NEW(Qid, intf := nullAtm, Index: m3-comm/stubgen/src/Value.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-comm/stubgen/src/Value.m3,v retrieving revision 1.3 diff -u -r1.3 Value.m3 --- m3-comm/stubgen/src/Value.m3 17 Mar 2008 17:09:02 -0000 1.3 +++ m3-comm/stubgen/src/Value.m3 16 Jan 2010 13:38:25 -0000 @@ -36,7 +36,7 @@ END; END; | Longint (i) => - IF (type = Type.longint) THEN + IF (type = Type.longint) OR (type = Type.longcard) THEN RETURN Fmt.LongInt(i.val); ELSE TYPECASE type OF | Type.Subrange (sub) => Index: m3-db/stable/src/StableLog.i3 =================================================================== RCS file: /usr/cvs/cm3/m3-db/stable/src/StableLog.i3,v retrieving revision 1.1.1.1 diff -u -r1.1.1.1 StableLog.i3 --- m3-db/stable/src/StableLog.i3 13 Jan 2001 14:17:33 -0000 1.1.1.1 +++ m3-db/stable/src/StableLog.i3 16 Jan 2010 13:38:26 -0000 @@ -91,11 +91,17 @@ (* Marshal a char array in native format. *) PROCEDURE OutInteger(log: Wr.T; i: INTEGER); -(* Marshal an integer. *) +(* Marshal an INTEGER. *) + +PROCEDURE OutLongint(log: Wr.T; i: LONGINT); +(* Marshal a LONGINT. *) PROCEDURE OutCardinal(log: Wr.T; card: CARDINAL); (* Marshal a cardinal. *) +PROCEDURE OutLongcard(log: Wr.T; card: LONGCARD); +(* Marshal a cardinal. *) + PROCEDURE OutBoolean(log: Wr.T; bool: BOOLEAN); (* Marshal a boolean value. *) @@ -127,13 +133,25 @@ min := FIRST(INTEGER); max := LAST(INTEGER)): INTEGER RAISES {Error}; -(* Unmarshal an integer, checking that its value is in "[min..max]". *) +(* Unmarshal an INTEGER, checking that its value is in "[min..max]". *) + +PROCEDURE InLongint( + log: Rd.T; + min := FIRST(LONGINT); + max := LAST(LONGINT)): LONGINT + RAISES {Error}; +(* Unmarshal a LONGINT, checking that its value is in "[min..max]". *) PROCEDURE InCardinal( log: Rd.T; lim: CARDINAL := LAST(CARDINAL)): CARDINAL RAISES {Error}; (* Unmarshal a cardinal, checking that its value is in "[0..lim]". *) +PROCEDURE InLongcard( + log: Rd.T; lim: LONGCARD := LAST(LONGCARD)): LONGCARD + RAISES {Error}; +(* Unmarshal a cardinal, checking that its value is in "[0..lim]". *) + PROCEDURE InBoolean(log: Rd.T): BOOLEAN RAISES {Error}; (* Unmarshal a boolean value. *) Index: m3-db/stable/src/StableLog.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-db/stable/src/StableLog.m3,v retrieving revision 1.1.1.2 diff -u -r1.1.1.2 StableLog.m3 --- m3-db/stable/src/StableLog.m3 24 Jan 2001 21:42:08 -0000 1.1.1.2 +++ m3-db/stable/src/StableLog.m3 16 Jan 2010 13:38:26 -0000 @@ -135,11 +135,27 @@ END END OutInteger; +PROCEDURE OutLongint (log: Wr.T; i: LONGINT) = + BEGIN + TRY + Wr.PutString(log, LOOPHOLE(i, ARRAY [0..BYTESIZE(LONGINT)-1] OF CHAR)); + EXCEPT + Wr.Failure (err) => + StableError.Halt( + "Cannot write to logfile: " & RdUtils.FailureText(err)) + END + END OutLongint; + PROCEDURE OutCardinal (log: Wr.T; card: CARDINAL) = BEGIN OutInteger(log, card) END OutCardinal; +PROCEDURE OutLongcard (log: Wr.T; card: LONGCARD) = + BEGIN + OutLongint(log, card) + END OutLongcard; + PROCEDURE OutBoolean (log: Wr.T; bool: BOOLEAN) = BEGIN TRY @@ -267,6 +283,31 @@ END (*IF*) END InInteger; +PROCEDURE InLongint (log: Rd.T; + min := FIRST(LONGINT); + max := LAST(LONGINT) ): + LONGINT RAISES {Error} = + VAR + i: LONGINT; + BEGIN + TRY + IF Rd.GetSub(log, LOOPHOLE(i, ARRAY [0..BYTESIZE(LONGINT)-1] OF CHAR)) + # BYTESIZE(LONGINT) THEN + RAISE Error + END; + EXCEPT + | Rd.Failure (err) => + StableError.Halt("InLongint: Can not read log file: " + & RdUtils.FailureText(err)) + END; + + IF min <= i AND i <= max THEN + RETURN i + ELSE + RAISE Error + END (*IF*) + END InLongint; + PROCEDURE InCardinal (log: Rd.T; lim: CARDINAL := LAST(CARDINAL)): CARDINAL RAISES {Error} = @@ -274,6 +315,13 @@ RETURN InInteger(log, 0, lim) END InCardinal; +PROCEDURE InLongcard (log: Rd.T; + lim: LONGCARD := LAST(LONGCARD)): + LONGCARD RAISES {Error} = + BEGIN + RETURN InLongint(log, 0L, lim) + END InLongcard; + PROCEDURE InBoolean (log: Rd.T): BOOLEAN RAISES {Error} = BEGIN TRY Index: m3-db/stablegen/src/AstToType.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-db/stablegen/src/AstToType.m3,v retrieving revision 1.3 diff -u -r1.3 AstToType.m3 --- m3-db/stablegen/src/AstToType.m3 17 Mar 2008 17:09:03 -0000 1.3 +++ m3-db/stablegen/src/AstToType.m3 16 Jan 2010 13:38:26 -0000 @@ -48,6 +48,7 @@ EVAL astTable.put(M3CStdTypes.WideChar(), Type.widechar); EVAL astTable.put(M3CStdTypes.Text(), Type.text); EVAL astTable.put(M3CStdTypes.Cardinal(), Type.cardinal); + EVAL astTable.put(M3CStdTypes.Longcard(), Type.longcard); EVAL astTable.put(M3CStdTypes.Boolean(), Type.boolean); EVAL astTable.put(M3CStdTypes.Mutex(), Type.mutex); END InitAstTable; Index: m3-db/stablegen/src/GenModuleCode.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-db/stablegen/src/GenModuleCode.m3,v retrieving revision 1.3 diff -u -r1.3 GenModuleCode.m3 --- m3-db/stablegen/src/GenModuleCode.m3 19 Mar 2008 17:16:13 -0000 1.3 +++ m3-db/stablegen/src/GenModuleCode.m3 16 Jan 2010 13:38:26 -0000 @@ -521,6 +521,8 @@ StableLogCall(fmtWr, "Longint", varName, d); ELSIF t = Type.cardinal THEN StableLogCall(fmtWr, "Cardinal", varName, d); + ELSIF t = Type.longcard THEN + StableLogCall(fmtWr, "Longcard", varName, d); ELSIF d = Direction.Log THEN (* no value range check when writing *) IF sub.base = Type.longint THEN Index: m3-db/stablegen/src/GenTypeCode.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-db/stablegen/src/GenTypeCode.m3,v retrieving revision 1.3 diff -u -r1.3 GenTypeCode.m3 --- m3-db/stablegen/src/GenTypeCode.m3 17 Mar 2008 17:09:03 -0000 1.3 +++ m3-db/stablegen/src/GenTypeCode.m3 16 Jan 2010 13:38:26 -0000 @@ -46,7 +46,7 @@ BEGIN IF sub = Type.integer THEN RETURN "INTEGER" END; IF sub = Type.longint THEN RETURN "LONGINT" END; - IF sub.base = Type.longint THEN + IF sub.base = Type.longint OR sub.base = Type.longcard THEN WITH min = NARROW(sub.min, Value.Longint).val, max = NARROW(sub.max, Value.Longint).val DO RETURN "[" & Fmt.LongInt(min) & "L.." & Fmt.LongInt(max) & "L]"; Index: m3-db/stablegen/src/Type.i3 =================================================================== RCS file: /usr/cvs/cm3/m3-db/stablegen/src/Type.i3,v retrieving revision 1.4 diff -u -r1.4 Type.i3 --- m3-db/stablegen/src/Type.i3 17 Mar 2008 17:09:03 -0000 1.4 +++ m3-db/stablegen/src/Type.i3 16 Jan 2010 13:38:27 -0000 @@ -177,6 +177,7 @@ integer : Subrange; longint : Subrange; cardinal : Subrange; + longcard : Subrange; boolean : UserDefined; char : Char; widechar : WideChar; Index: m3-db/stablegen/src/Type.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-db/stablegen/src/Type.m3,v retrieving revision 1.3 diff -u -r1.3 Type.m3 --- m3-db/stablegen/src/Type.m3 17 Mar 2008 17:09:03 -0000 1.3 +++ m3-db/stablegen/src/Type.m3 16 Jan 2010 13:38:27 -0000 @@ -276,6 +276,10 @@ item := Atom.FromText("CARDINAL")), base := integer, min := NEW(Value.Integer, val := 0), max := integer.max); + longcard := NEW(Subrange, name := NEW(Qid, intf := nullAtm, + item := Atom.FromText("LONGCARD")), + base := longint, min := NEW(Value.Longint, val := 0L), + max := longint.max); boolean := NEW( UserDefined, name := NEW(Qid, intf := nullAtm, Index: m3-db/stablegen/src/Value.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-db/stablegen/src/Value.m3,v retrieving revision 1.3 diff -u -r1.3 Value.m3 --- m3-db/stablegen/src/Value.m3 17 Mar 2008 17:09:03 -0000 1.3 +++ m3-db/stablegen/src/Value.m3 16 Jan 2010 13:38:27 -0000 @@ -38,7 +38,7 @@ END; END; | Longint (i) => - IF (type = Type.longint) THEN + IF (type = Type.longint) OR (type = Type.longcard) THEN RETURN Fmt.LongInt(i.val); ELSE TYPECASE type OF | Type.Subrange (sub) => Index: m3-libs/libm3/src/pickle/ver2/ConvertPacking.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-libs/libm3/src/pickle/ver2/ConvertPacking.m3,v retrieving revision 1.5.2.3 diff -u -r1.5.2.3 ConvertPacking.m3 --- m3-libs/libm3/src/pickle/ver2/ConvertPacking.m3 30 Jul 2009 10:17:50 -0000 1.5.2.3 +++ m3-libs/libm3/src/pickle/ver2/ConvertPacking.m3 16 Jan 2010 13:38:27 -0000 @@ -161,7 +161,7 @@ END; END ReadData; -TYPE Int32Rec = RECORD v : Swap.Int32 END; +TYPE Int32Rec = BITS 32 FOR RECORD v : Swap.Int32 END; (* We need v to be inside a record. Otherwise, the language would allow a compiler to actually allocate more than the BITS 32 for a value of type Swap.Int32. @@ -1055,7 +1055,7 @@ PROCEDURE GetLongintKind(from: RTPacking.T; to: RTPacking.T): Kind = (* The result is good only for LONGINT. *) BEGIN - IF from.longint_size = to.longint_size THEN + IF from.long_size = to.long_size THEN IF from.little_endian = to.little_endian THEN RETURN Kind.Copy; ELSE @@ -1063,13 +1063,13 @@ END; ELSE IF from.little_endian = to.little_endian THEN - IF from.longint_size = 32 THEN + IF from.long_size = 32 THEN RETURN Kind.Copy32to64; ELSE RETURN Kind.Copy64to32; END; ELSE - IF from.longint_size = 32 THEN + IF from.long_size = 32 THEN RETURN Kind.Swap32to64; ELSE RETURN Kind.Swap64to32; @@ -1217,6 +1217,8 @@ BuildOrdinal(self, fromTipe, toTipe, self.wordKind, signed:=FALSE); | RTTipe.Kind.Integer => BuildOrdinal(self, fromTipe, toTipe, self.wordKind, signed:=TRUE); + | RTTipe.Kind.Longcard => + BuildOrdinal(self, fromTipe, toTipe, self.longKind, signed:=FALSE); | RTTipe.Kind.Longint => BuildOrdinal(self, fromTipe, toTipe, self.longKind, signed:=TRUE); | RTTipe.Kind.Extended, RTTipe.Kind.Longreal => @@ -1470,6 +1472,7 @@ | RTTipe.Kind.Enum => IO.Put( "Enum"); | RTTipe.Kind.Extended => IO.Put( "Extended"); | RTTipe.Kind.Integer => IO.Put( "Integer"); + | RTTipe.Kind.Longcard => IO.Put( "Longcard"); | RTTipe.Kind.Longint => IO.Put( "Longint"); | RTTipe.Kind.Longreal => IO.Put( "Longreal"); | RTTipe.Kind.Null => IO.Put( "Null"); Index: m3-libs/libm3/src/pickle/ver2/PickleStubs.i3 =================================================================== RCS file: /usr/cvs/cm3/m3-libs/libm3/src/pickle/ver2/PickleStubs.i3,v retrieving revision 1.2 diff -u -r1.2 PickleStubs.i3 --- m3-libs/libm3/src/pickle/ver2/PickleStubs.i3 7 Dec 2005 17:57:40 -0000 1.2 +++ m3-libs/libm3/src/pickle/ver2/PickleStubs.i3 16 Jan 2010 13:38:27 -0000 @@ -61,6 +61,10 @@ RAISES {Wr.Failure, Thread.Alerted}; (* Marshal an integer in native format. *) +PROCEDURE OutLongint (writer: Pickle.Writer; i: LONGINT) + RAISES {Wr.Failure, Thread.Alerted}; +(* Marshal an integer in native format. *) + PROCEDURE OutInt32 (writer: Pickle.Writer; i: Int32) RAISES {Wr.Failure, Thread.Alerted}; (* Marshal a 32-bit integer in native format. *) @@ -89,6 +93,10 @@ RAISES {Wr.Failure, Thread.Alerted}; (* Marshal a cardinal in native format. *) +PROCEDURE OutLongcard (writer: Pickle.Writer; card: LONGCARD) + RAISES {Wr.Failure, Thread.Alerted}; +(* Marshal a cardinal in native format. *) + PROCEDURE InChars (reader: Pickle.Reader; VAR chars: ARRAY OF CHAR) RAISES {Pickle.Error, Rd.Failure, Thread.Alerted}; (* Unmarshal a char array of length "NUMBER(chars)". *) @@ -111,6 +119,12 @@ RAISES {Pickle.Error, Rd.Failure, Thread.Alerted}; (* Unmarshal an integer, checking that its value is in "[min..max]". *) +PROCEDURE InLongint (reader: Pickle.Reader; + min := FIRST(LONGINT); + max := LAST(LONGINT) ): LONGINT + RAISES {Pickle.Error, Rd.Failure, Thread.Alerted}; +(* Unmarshal an integer, checking that its value is in "[min..max]". *) + PROCEDURE InInt32 (reader: Pickle.Reader; min := FIRST(Int32); max := LAST(Int32)): Int32 RAISES {Pickle.Error, Rd.Failure, Thread.Alerted}; @@ -140,5 +154,9 @@ CARDINAL RAISES {Pickle.Error, Rd.Failure, Thread.Alerted}; (* Unmarshal a cardinal, checking that its value is in "[0..lim]". *) +PROCEDURE InLongcard (reader: Pickle.Reader; lim: LONGCARD := LAST(LONGCARD)): + LONGCARD RAISES {Pickle.Error, Rd.Failure, Thread.Alerted}; +(* Unmarshal a cardinal, checking that its value is in "[0..lim]". *) + END PickleStubs. Index: m3-libs/libm3/src/pickle/ver2/PickleStubs.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-libs/libm3/src/pickle/ver2/PickleStubs.m3,v retrieving revision 1.3 diff -u -r1.3 PickleStubs.m3 --- m3-libs/libm3/src/pickle/ver2/PickleStubs.m3 1 Apr 2008 00:02:52 -0000 1.3 +++ m3-libs/libm3/src/pickle/ver2/PickleStubs.m3 16 Jan 2010 13:38:27 -0000 @@ -198,6 +198,79 @@ RETURN i; END InInteger; +PROCEDURE InLongint(reader: Pickle.Reader; + min := FIRST(LONGINT); + max := LAST(LONGINT)): LONGINT + RAISES {Pickle.Error, Rd.Failure, Thread.Alerted} = + VAR i: LONGINT; + BEGIN + CASE reader.longConvKind OF + | Kind.Copy, Kind.Swap => + VAR c := LOOPHOLE(ADR(i), + UNTRACED REF ARRAY [1..BYTESIZE(LONGINT)] OF CHAR); + BEGIN + IF reader.rd.getSub(c^) # NUMBER(c^) THEN + RaiseUnmarshalFailure(); + END; + IF reader.longConvKind = Kind.Swap THEN + CASE myPacking.long_size OF + | 32 => i := VAL(Swap.Swap4(VAL(i, INTEGER)), LONGINT); + | 64 => + VAR ii: Int64On64; + BEGIN + ii.v := VAL(i, INTEGER); + ii := LOOPHOLE(Swap.Swap8(LOOPHOLE(ii, Int64On32)), Int64On64); + i := VAL(ii.v, LONGINT); + END; + ELSE + RaiseUnsupportedDataRep(); + END; + END; + END; + + | Kind.Copy32to64, Kind.Swap32to64 => + VAR i32: Int32; + c32 := LOOPHOLE(ADR(i32), UNTRACED REF ARRAY [1..4] OF CHAR); + BEGIN + IF reader.rd.getSub(c32^) # NUMBER(c32^) THEN + RaiseUnmarshalFailure(); + END; + IF reader.longConvKind = Kind.Swap32to64 THEN + i32 := Swap.Swap4(i32); + END; + i := VAL(i32, LONGINT); + END; + + | Kind.Copy64to32, Kind.Swap64to32 => + VAR i64: Int64On32; + c64 := LOOPHOLE(ADR(i64), UNTRACED REF ARRAY [1..8] OF CHAR); + BEGIN + IF reader.rd.getSub(c64^) # NUMBER(c64^) THEN + RaiseUnmarshalFailure(); + END; + IF reader.packing.little_endian THEN + i := VAL(i64.a, LONGINT); + IF i64.b # 0 AND i64.b # -1 THEN + RAISE Pickle.Error("Data value too big."); + END; + ELSE + i := VAL(i64.b, LONGINT); + IF i64.a # 0 AND i64.a # -1 THEN + RAISE Pickle.Error("Data value too big."); + END; + END; + + (* Now, swap it if need be. *) + IF reader.longConvKind = Kind.Swap64to32 THEN + i := VAL(Swap.Swap4(VAL(i, INTEGER)), LONGINT); + END; + END; + END; + + IF i < min OR i > max THEN RaiseUnmarshalFailure(); END; + RETURN i; + END InLongint; + PROCEDURE InInt32(reader: Pickle.Reader; min := FIRST(Int32); max := LAST(Int32)): Int32 @@ -225,6 +298,14 @@ writer.wr.putString(ip^); END OutInteger; +PROCEDURE OutLongint(writer: Pickle.Writer; i: LONGINT) + RAISES {Wr.Failure, Thread.Alerted} = + VAR ip := LOOPHOLE(ADR(i), + UNTRACED REF ARRAY [1..BYTESIZE(LONGINT)] OF CHAR); + BEGIN + writer.wr.putString(ip^); + END OutLongint; + PROCEDURE OutInt32(writer: Pickle.Writer; i: Int32) RAISES {Wr.Failure, Thread.Alerted} = VAR ip := LOOPHOLE(ADR(i), UNTRACED REF ARRAY [1..BYTESIZE(Int32)] OF CHAR); @@ -267,6 +348,19 @@ OutInteger(writer, card); END OutCardinal; +PROCEDURE InLongcard(reader: Pickle.Reader; + lim: LONGCARD := LAST(LONGCARD)): LONGCARD + RAISES {Pickle.Error, Rd.Failure, Thread.Alerted} = + BEGIN + RETURN InLongint(reader, 0L, lim); + END InLongcard; + +PROCEDURE OutLongcard(writer: Pickle.Writer; card: LONGCARD) + RAISES {Wr.Failure, Thread.Alerted} = + BEGIN + OutLongint(writer, card); + END OutLongcard; + PROCEDURE InReal(reader: Pickle.Reader): REAL RAISES {Pickle.Error, Rd.Failure, Thread.Alerted} = VAR i: REAL; Index: m3-libs/m3core/src/runtime/common/RTBuiltin.mx =================================================================== RCS file: /usr/cvs/cm3/m3-libs/m3core/src/runtime/common/RTBuiltin.mx,v retrieving revision 1.3 diff -u -r1.3 RTBuiltin.mx --- m3-libs/m3core/src/runtime/common/RTBuiltin.mx 13 Aug 2007 23:01:38 -0000 1.3 +++ m3-libs/m3core/src/runtime/common/RTBuiltin.mx 16 Jan 2010 13:38:30 -0000 @@ -19,7 +19,7 @@ N1 TEXT N2 MUTEX -I0 1 0 0 0 0 0 0 2 0 0 26 0 +I0 1 0 0 0 0 0 0 2 0 0 27 0 A0 V0 0 1 bbef933ad0c2139d @@ -66,6 +66,9 @@ /* CARDINAL */ T97e237e2 +/* LONGCARD */ +T9ced36e7 + /* REAL */ T48e16572 Index: m3-libs/m3core/src/runtime/common/RTPacking.i3 =================================================================== RCS file: /usr/cvs/cm3/m3-libs/m3core/src/runtime/common/RTPacking.i3,v retrieving revision 1.2 diff -u -r1.2 RTPacking.i3 --- m3-libs/m3core/src/runtime/common/RTPacking.i3 1 Apr 2008 00:02:56 -0000 1.2 +++ m3-libs/m3core/src/runtime/common/RTPacking.i3 16 Jan 2010 13:38:30 -0000 @@ -9,17 +9,17 @@ TYPE T = RECORD word_size : CARDINAL; (* 8, 16, 32, or 64 *) - longint_size : CARDINAL; (* 8, 16, 32, or 64 *) + long_size : CARDINAL; (* 8, 16, 32, or 64 *) (* Compatibility note: If an encoded value was written by an earlier version of this module, (that does not support LONGINT,) and then decoded by the current - version, the encoded value will have no field for longint_size. - This will decode perversely into bit size 8 for longint_size. + version, the encoded value will have no field for long_size. + This will decode perversely into bit size 8 for long_size. Although ugly, it is a safe bet that this is not a reasonable size for LONGINT, so it could be tested for explicitly and interpreted as meaning "LONGINT doesn't exist". As of 2008-1-26, the only uses of this module in the entire cm3 - distribution are in Pickle2, and there, the value of longint_size + distribution are in Pickle2, and there, the value of long_size would not be accessed unless the pickle was written by a program compiled by a cm3 that has LONGINT. *) Index: m3-libs/m3core/src/runtime/common/RTPacking.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-libs/m3core/src/runtime/common/RTPacking.m3,v retrieving revision 1.2 diff -u -r1.2 RTPacking.m3 --- m3-libs/m3core/src/runtime/common/RTPacking.m3 1 Apr 2008 00:02:56 -0000 1.2 +++ m3-libs/m3core/src/runtime/common/RTPacking.m3 16 Jan 2010 13:38:30 -0000 @@ -48,7 +48,7 @@ BEGIN IF NOT init_done THEN local.word_size := SizeOf (ADRSIZE (INTEGER)); - local.longint_size := SizeOf (ADRSIZE (LONGINT)); + local.long_size := SizeOf (ADRSIZE (LONGINT)); local.max_align := SizeOf (ADR (a.x) - ADR (a.ch)); local.struct_align := SizeOf (ADR (b.x) - ADR (b.ch)); local.little_endian := (p^ = VAL (1, CHAR)); @@ -76,7 +76,7 @@ VAR n := 0; BEGIN n := Word.Or (Word.Shift (n, 1), ORD (t.lazy_align)); - n := Word.Or (Word.Shift (n, 2), BitSize (t.longint_size)); + n := Word.Or (Word.Shift (n, 2), BitSize (t.long_size)); n := Word.Or (Word.Shift (n, 2), BitSize (t.word_size)); n := Word.Or (Word.Shift (n, 2), BitSize (t.max_align)); n := Word.Or (Word.Shift (n, 2), BitSize (t.struct_align)); @@ -93,7 +93,7 @@ t.struct_align := Bits[Word.And (i, 3)]; i := Word.Shift (i, -2); t.max_align := Bits[Word.And (i, 3)]; i := Word.Shift (i, -2); t.word_size := Bits[Word.And (i, 3)]; i := Word.Shift (i, -2); - t.longint_size := Bits[Word.And (i, 3)]; i := Word.Shift (i, -2); + t.long_size := Bits[Word.And (i, 3)]; i := Word.Shift (i, -2); t.lazy_align := VAL (Word.And (i, 1), BOOLEAN); i := Word.Shift (i, -1); <*ASSERT i = 0*> RETURN t; Index: m3-libs/m3core/src/runtime/common/RTTipe.i3 =================================================================== RCS file: /usr/cvs/cm3/m3-libs/m3core/src/runtime/common/RTTipe.i3,v retrieving revision 1.3 diff -u -r1.3 RTTipe.i3 --- m3-libs/m3core/src/runtime/common/RTTipe.i3 1 Apr 2008 00:02:56 -0000 1.3 +++ m3-libs/m3core/src/runtime/common/RTTipe.i3 16 Jan 2010 13:38:30 -0000 @@ -14,14 +14,14 @@ TYPE Kind = { Address, Array, Boolean, Cardinal, Char, Enum, Extended, - Integer, Longint, Longreal, Null, Object, OpenArray, Packed, Proc, Real, - Record, Ref, Refany, Set, Subrange, UntracedRef }; + Integer, Longcard, Longint, Longreal, Null, Object, OpenArray, + Packed, Proc, Real, Record, Ref, Refany, Set, Subrange, UntracedRef }; CONST BuiltinKinds = SET OF Kind { Kind.Address, Kind.Boolean, Kind.Cardinal, Kind.Char, Kind.Extended, - Kind.Integer, Kind.Longint, Kind.Longreal, Kind.Null, Kind.Proc, Kind.Real, - Kind.Refany + Kind.Integer, Kind.Longcard, Kind.Longint, Kind.Longreal, Kind.Null, + Kind.Proc, Kind.Real, Kind.Refany }; TYPE Index: m3-libs/m3core/src/runtime/common/RTTipe.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-libs/m3core/src/runtime/common/RTTipe.m3,v retrieving revision 1.3 diff -u -r1.3 RTTipe.m3 --- m3-libs/m3core/src/runtime/common/RTTipe.m3 1 Apr 2008 00:02:56 -0000 1.3 +++ m3-libs/m3core/src/runtime/common/RTTipe.m3 16 Jan 2010 13:38:30 -0000 @@ -20,23 +20,24 @@ Enum, (* 05, #elements: INT *) Extended, (* 06 *) Integer, (* 07 *) - Longint, (* 08 *) - Longreal, (* 09 *) - Null, (* 0a *) - Object, (* 0b, #fields: INT, {fields: TYPE} *) - OpenArray, (* 0c, #dimensions: INT, element: TYPE *) - Packed, (* 0d, bit size: INT, base type: TYPE *) - Proc, (* 0e *) - Real, (* 0f *) - Record, (* 10, #fields: INT, {fields: TYPE} *) - Ref, (* 11, self id: UID *) - Refany, (* 12 *) - Set, (* 13, #elements: INT *) - Subrange, (* 14, min, max: INT *) - UntracedRef, (* 15, self id: UID *) + Longcard, (* 08 *) + Longint, (* 09 *) + Longreal, (* 0a *) + Null, (* 0b *) + Object, (* 0c, #fields: INT, {fields: TYPE} *) + OpenArray, (* 0d, #dimensions: INT, element: TYPE *) + Packed, (* 0e, bit size: INT, base type: TYPE *) + Proc, (* 0f *) + Real, (* 10 *) + Record, (* 11, #fields: INT, {fields: TYPE} *) + Ref, (* 12, self id: UID *) + Refany, (* 13 *) + Set, (* 14, #elements: INT *) + Subrange, (* 15, min, max: INT *) + UntracedRef, (* 16, self id: UID *) (* Widechar is denoted as Enum, with #elements = 2^16. *) - OldN, (* 16, node #: INT *) - Old0 (* 17 *) + OldN, (* 17, node #: INT *) + Old0 (* 18 *) };(* Old1, Old2, ... Old(255-ORD(Old0)) *) TYPE Byte = BITS 8 FOR [0..255]; @@ -59,7 +60,7 @@ struct_align : INTEGER; word_size : INTEGER; word_align : INTEGER; - longint_size : INTEGER; + long_size : INTEGER; lazy_align : BOOLEAN (* FIXME: ^ Use this below. *) END; @@ -87,14 +88,14 @@ p.word_size := packing.word_size; p.word_align := MIN (p.word_size, p.max_align); p.lazy_align := packing.lazy_align; - IF packing.longint_size = 8 - THEN p.longint_size := BITSIZE(LONGINT) + IF packing.long_size = 8 + THEN p.long_size := BITSIZE(LONGINT) (* ^Compatibility: This can can happen if we read an old pickle that was written before RTPacking was updated to support LONGINT. This will preserve the behaviour that existed after addition of LONGINT to the compiler, but before LONGINT support in Pickles. *) - ELSE p.longint_size := packing.longint_size; + ELSE p.long_size := packing.long_size; END; FixSizes (t, p); @@ -114,6 +115,7 @@ | ORD (Op.Char) => t := NEW (Builtin, kind := Kind.Char); | ORD (Op.Extended) => t := NEW (Builtin, kind := Kind.Extended); | ORD (Op.Integer) => t := NEW (Builtin, kind := Kind.Integer); + | ORD (Op.Longcard) => t := NEW (Builtin, kind := Kind.Longcard); | ORD (Op.Longint) => t := NEW (Builtin, kind := Kind.Longint); | ORD (Op.Longreal) => t := NEW (Builtin, kind := Kind.Longreal); | ORD (Op.Null) => t := NEW (Builtin, kind := Kind.Null); @@ -355,8 +357,9 @@ t.size := p.word_size; t.align := p.word_align; - | Kind.Longint => - t.size := p.longint_size; + | Kind.Longint, + Kind.Longcard => + t.size := p.long_size; t.align := MIN (t.size, p.max_align); | Kind.Boolean => @@ -562,6 +565,7 @@ | Kind.Address, Kind.Cardinal, Kind.Integer, + Kind.Longcard, Kind.Longint, Kind.Null, Kind.Proc, Index: m3-sys/m3cggen/src/Main.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-sys/m3cggen/src/Main.m3,v retrieving revision 1.3 diff -u -r1.3 Main.m3 --- m3-sys/m3cggen/src/Main.m3 21 Jan 2008 13:37:33 -0000 1.3 +++ m3-sys/m3cggen/src/Main.m3 16 Jan 2010 13:38:33 -0000 @@ -190,23 +190,16 @@ Desc { "load_static_link", Op.load_static_link }, Desc { "comment", Op.comment }, + Desc { "store_ordered", Op.store_ordered }, + Desc { "load_ordered", Op.load_ordered }, + Desc { "exchange", Op.exchange }, + Desc { "compare_exchange", Op.compare_exchange }, + Desc { "fence", Op.fence }, Desc { "fetch_and_add", Op.fetch_and_add }, Desc { "fetch_and_sub", Op.fetch_and_sub }, Desc { "fetch_and_or", Op.fetch_and_or }, Desc { "fetch_and_and", Op.fetch_and_and }, - Desc { "fetch_and_xor", Op.fetch_and_xor }, - Desc { "fetch_and_nand", Op.fetch_and_nand }, - Desc { "add_and_fetch", Op.add_and_fetch }, - Desc { "sub_and_fetch", Op.sub_and_fetch }, - Desc { "or_and_fetch", Op.or_and_fetch }, - Desc { "and_and_fetch", Op.and_and_fetch }, - Desc { "xor_and_fetch", Op.xor_and_fetch }, - Desc { "nand_and_fetch", Op.nand_and_fetch }, - Desc { "bool_compare_and_swap", Op.bool_compare_and_swap }, - Desc { "val_compare_and_swap", Op.val_compare_and_swap }, - Desc { "synchronize", Op.synchronize }, - Desc { "lock_test_and_set", Op.lock_test_and_set }, - Desc { "lock_release", Op.lock_release } + Desc { "fetch_and_xor", Op.fetch_and_xor } }; PROCEDURE Out (a, b, c, d, e, f, g : TEXT := NIL) = Index: m3-sys/m3front/src/builtinTypes/BuiltinTypes.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-sys/m3front/src/builtinTypes/BuiltinTypes.m3,v retrieving revision 1.2 diff -u -r1.2 BuiltinTypes.m3 --- m3-sys/m3front/src/builtinTypes/BuiltinTypes.m3 8 Aug 2007 03:49:44 -0000 1.2 +++ m3-sys/m3front/src/builtinTypes/BuiltinTypes.m3 16 Jan 2010 13:38:33 -0000 @@ -10,7 +10,7 @@ IMPORT Int, LInt, Card, Bool, Reel, LReel, EReel, Charr, Addr; IMPORT Null, Reff, Textt, Mutex, ErrType, ObjectRef, ObjectAdr; -IMPORT WCharr; +IMPORT WCharr, LCard; PROCEDURE Initialize () = @@ -21,6 +21,7 @@ Int.Initialize (); LInt.Initialize (); Card.Initialize (); + LCard.Initialize (); Bool.Initialize (); Reel.Initialize (); LReel.Initialize (); Index: m3-sys/m3front/src/builtinTypes/m3makefile =================================================================== RCS file: /usr/cvs/cm3/m3-sys/m3front/src/builtinTypes/m3makefile,v retrieving revision 1.2 diff -u -r1.2 m3makefile --- m3-sys/m3front/src/builtinTypes/m3makefile 8 Aug 2007 03:49:45 -0000 1.2 +++ m3-sys/m3front/src/builtinTypes/m3makefile 16 Jan 2010 13:38:33 -0000 @@ -14,6 +14,7 @@ module ("EReel") module ("ErrType") module ("Int") +module ("LCard") module ("LInt") module ("LReel") module ("Mutex") Index: m3-sys/m3front/src/misc/CG.i3 =================================================================== RCS file: /usr/cvs/cm3/m3-sys/m3front/src/misc/CG.i3,v retrieving revision 1.6.2.2 diff -u -r1.6.2.2 CG.i3 --- m3-sys/m3front/src/misc/CG.i3 15 Jan 2010 11:02:15 -0000 1.6.2.2 +++ m3-sys/m3front/src/misc/CG.i3 16 Jan 2010 13:38:33 -0000 @@ -34,6 +34,8 @@ Frequency = M3CG.Frequency; Cmp = M3CG.CompareOp; Cvt = M3CG.ConvertOp; + AtomicOp = M3CG.AtomicOp; + MemoryOrder = M3CG.MemoryOrder; RuntimeError = M3CG.RuntimeError; CallingConvention = M3CG.CallingConvention; @@ -679,4 +681,13 @@ PROCEDURE Comment (offset: INTEGER; is_const: BOOLEAN; a, b, c, d: TEXT := NIL); (* annotate the output with a&b&c&d as a comment *) +(*--------------------------------------------------------------- atomics ---*) + +PROCEDURE Store_ordered (t: MType; order: MemoryOrder); +PROCEDURE Load_ordered (t: MType; order: MemoryOrder); +PROCEDURE Exchange (t: MType; order: MemoryOrder); +PROCEDURE Compare_exchange (t: MType; u: IType; success, failure: MemoryOrder); +PROCEDURE Fence (order: MemoryOrder); +PROCEDURE Fetch_and_op (op: AtomicOp; t: MType; order: MemoryOrder); + END CG. Index: m3-sys/m3front/src/misc/CG.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-sys/m3front/src/misc/CG.m3,v retrieving revision 1.15.2.2 diff -u -r1.15.2.2 CG.m3 --- m3-sys/m3front/src/misc/CG.m3 15 Jan 2010 11:02:15 -0000 1.15.2.2 +++ m3-sys/m3front/src/misc/CG.m3 16 Jan 2010 13:38:33 -0000 @@ -2675,6 +2675,47 @@ cg.comment (x.a, x.b, x.c, x.d); END DumpComment; +(*--------------------------------------------------------------- atomics ---*) + +PROCEDURE Store_ordered (t: MType; order: MemoryOrder) = + BEGIN + cg.store_ordered (StackType[t], t, order); + SPop (2, "Store_ordered"); + END Store_ordered; + +PROCEDURE Load_ordered (t: MType; order: MemoryOrder) = + BEGIN + cg.load_ordered (t, StackType[t], order); + SPop (1, "Load_ordered"); + SPush (StackType[t]); + END Load_ordered; + +PROCEDURE Exchange (t: MType; order: MemoryOrder) = + BEGIN + cg.exchange (t, StackType[t], order); + SPop (2, "Exchange"); + SPush (StackType[t]); + END Exchange; + +PROCEDURE Compare_exchange (t: MType; u: IType; success, failure: MemoryOrder) = + BEGIN + cg.compare_exchange (t, StackType[t], u, success, failure); + SPop (3, "Compare_exchange"); + SPush (u); + END Compare_exchange; + +PROCEDURE Fence (order: MemoryOrder) = + BEGIN + cg.fence (order); + END Fence; + +PROCEDURE Fetch_and_op (op: AtomicOp; t: MType; order: MemoryOrder) = + BEGIN + cg.fetch_and_op (op, t, StackType[t], order); + SPop (2, "Fetch_and_op"); + SPush (StackType[t]); + END Fetch_and_op; + (*-------------------------------------------------------------- internal ---*) PROCEDURE FixAlign (a: Alignment): Alignment = Index: m3-sys/m3front/src/misc/TipeDesc.i3 =================================================================== RCS file: /usr/cvs/cm3/m3-sys/m3front/src/misc/TipeDesc.i3,v retrieving revision 1.3 diff -u -r1.3 TipeDesc.i3 --- m3-sys/m3front/src/misc/TipeDesc.i3 1 Apr 2008 00:02:58 -0000 1.3 +++ m3-sys/m3front/src/misc/TipeDesc.i3 16 Jan 2010 13:38:33 -0000 @@ -46,26 +46,27 @@ Enum, (* 05, #elements: INT *) Extended, (* 06 *) Integer, (* 07 *) - Longint, (* 08 *) - Longreal, (* 09 *) - Null, (* 0a *) - Object, (* 0b, #fields: INT, {fields: TYPE} *) - OpenArray, (* 0c, #dimensions: INT, element: TYPE *) - Packed, (* 0d, bit size: INT, base type: TYPE *) - Proc, (* 0e *) - Real, (* 0f *) - Record, (* 10, #fields: INT, {fields: TYPE} *) - Ref, (* 11, self id: UID *) - Refany, (* 12 *) - Set, (* 13, #elements: INT *) - Subrange, (* 14, min, max: INT *) - UntracedRef, (* 15, self id: UID *) + Longcard, (* 08 *) + Longint, (* 09 *) + Longreal, (* 0a *) + Null, (* 0b *) + Object, (* 0c, #fields: INT, {fields: TYPE} *) + OpenArray, (* 0d, #dimensions: INT, element: TYPE *) + Packed, (* 0e, bit size: INT, base type: TYPE *) + Proc, (* 0f *) + Real, (* 10 *) + Record, (* 11, #fields: INT, {fields: TYPE} *) + Ref, (* 12, self id: UID *) + Refany, (* 13 *) + Set, (* 14, #elements: INT *) + Subrange, (* 15, min, max: INT *) + UntracedRef, (* 16, self id: UID *) (* Widechar is denoted as Enum, with #elements = 2^16. This could be fixed by a coordinated change, here, in Enumtype.m3, and RTTipe.m3, but would invalidate compiled code. *) - OldN, (* 16, node #: INT *) - Old0 (* 17 *) + OldN, (* 17, node #: INT *) + Old0 (* 18 *) };(* Old1, Old2, ... Old(255-ORD(Old0)) *) PROCEDURE Start (); Index: m3-sys/m3front/src/misc/Token.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-sys/m3front/src/misc/Token.m3,v retrieving revision 1.5.2.1 diff -u -r1.5.2.1 Token.m3 --- m3-sys/m3front/src/misc/Token.m3 14 Jan 2010 09:53:55 -0000 1.5.2.1 +++ m3-sys/m3front/src/misc/Token.m3 16 Jan 2010 13:38:33 -0000 @@ -51,7 +51,7 @@ "ABS", "ADDRESS", "ADR", "ADRSIZE", "BITSIZE", "BOOLEAN", "BYTESIZE", "CARDINAL", "CEILING", "CHAR", "DEC", "DISPOSE", "EXTENDED", "FALSE", "FIRST", "FLOAT", "FLOOR", "INC", - "INTEGER", "ISTYPE", "LAST", "LONGINT", "LONGREAL", "LOOPHOLE", + "INTEGER", "ISTYPE", "LAST", "LONGCARD", "LONGINT", "LONGREAL", "LOOPHOLE", "MAX", "MIN", "MUTEX", "NARROW", "NEW", "NIL", "NULL", "NUMBER", "ORD", "REAL", "REFANY", "ROOT", "ROUND", "SUBARRAY", "TEXT", "TRUE", "TRUNC", "TYPECODE", "VAL", "WIDECHAR" Index: m3-sys/m3front/src/types/RecordType.i3 =================================================================== RCS file: /usr/cvs/cm3/m3-sys/m3front/src/types/RecordType.i3,v retrieving revision 1.2 diff -u -r1.2 RecordType.i3 --- m3-sys/m3front/src/types/RecordType.i3 23 Mar 2003 16:53:15 -0000 1.2 +++ m3-sys/m3front/src/types/RecordType.i3 16 Jan 2010 13:38:33 -0000 @@ -13,6 +13,8 @@ PROCEDURE Parse (): Type.T; PROCEDURE ParseFieldList (); +PROCEDURE New (fields: Scope.T): Type.T; + PROCEDURE Split (t: Type.T; VAR fields: Value.T): BOOLEAN; PROCEDURE LookUp (t: Type.T; name: M3ID.T; VAR field: Value.T): BOOLEAN; Index: m3-sys/m3front/src/types/RecordType.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-sys/m3front/src/types/RecordType.m3,v retrieving revision 1.3 diff -u -r1.3 RecordType.m3 --- m3-sys/m3front/src/types/RecordType.m3 23 Mar 2003 16:53:15 -0000 1.3 +++ m3-sys/m3front/src/types/RecordType.m3 16 Jan 2010 13:38:33 -0000 @@ -33,11 +33,8 @@ END; PROCEDURE Parse (): Type.T = - VAR p := NEW (P); + VAR p := Create (Scope.PushNew (FALSE, M3ID.NoID)); BEGIN - TypeRep.Init (p, Type.Class.Record); - - p.fields := Scope.PushNew (FALSE, M3ID.NoID); Match (Token.T.tRECORD); ParseFieldList (); Match (Token.T.tEND); @@ -85,6 +82,12 @@ END; END ParseFieldList; +PROCEDURE New (fields: Scope.T): Type.T = + VAR p := Create (fields); + BEGIN + RETURN p; + END New; + PROCEDURE Reduce (t: Type.T): P = BEGIN IF (t = NIL) THEN RETURN NIL END; @@ -111,6 +114,14 @@ (***********************************************************************) +PROCEDURE Create (fields: Scope.T): P = + VAR p := NEW (P); + BEGIN + TypeRep.Init (p, Type.Class.Record); + p.fields := fields; + RETURN p; + END Create; + PROCEDURE Check (p: P) = VAR o : Value.T; Index: m3-sys/m3front/src/types/SubrangeType.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-sys/m3front/src/types/SubrangeType.m3,v retrieving revision 1.6 diff -u -r1.6 SubrangeType.m3 --- m3-sys/m3front/src/types/SubrangeType.m3 18 Sep 2007 20:26:11 -0000 1.6 +++ m3-sys/m3front/src/types/SubrangeType.m3 16 Jan 2010 13:38:33 -0000 @@ -10,7 +10,7 @@ IMPORT M3, CG, Type, TypeRep, Int, LInt, Expr, Token, Card, M3Buf; IMPORT Error, IntegerExpr, EnumExpr, Word, TipeMap, TipeDesc; -IMPORT Target, TInt, TWord, TargetMap; +IMPORT Target, TInt, TWord, TargetMap, LCard; FROM Scanner IMPORT Match; TYPE @@ -382,6 +382,8 @@ BEGIN IF Type.IsEqual (p, Card.T, NIL) THEN EVAL TipeDesc.AddO (TipeDesc.Op.Cardinal, p); + ELSIF Type.IsEqual (p, LCard.T, NIL) THEN + EVAL TipeDesc.AddO (TipeDesc.Op.Longcard, p); ELSIF TipeDesc.AddO (TipeDesc.Op.Subrange, p) THEN TipeDesc.AddX (p.min); TipeDesc.AddX (p.max); @@ -393,6 +395,9 @@ IF Type.IsEqual (p, Card.T, NIL) THEN x.tag := "$cardinal"; x.n_nodes := 0; + ELSIF Type.IsEqual (p, LCard.T, NIL) THEN + x.tag := "$longcard"; + x.n_nodes := 0; ELSE M3Buf.PutText (x.buf, "SUBRANGE "); M3Buf.PutIntt (x.buf, p.min); Index: m3-sys/m3middle/src/M3CG.i3 =================================================================== RCS file: /usr/cvs/cm3/m3-sys/m3middle/src/M3CG.i3,v retrieving revision 1.3 diff -u -r1.3 M3CG.i3 --- m3-sys/m3middle/src/M3CG.i3 22 Jun 2007 15:02:34 -0000 1.3 +++ m3-sys/m3middle/src/M3CG.i3 16 Jan 2010 13:38:35 -0000 @@ -58,7 +58,10 @@ TYPE CompareOp = { EQ, NE, GT, GE, LT, LE }; ConvertOp = { Round, Trunc, Floor, Ceiling }; - AtomicOp = { Add, Sub, Or, And, Xor, Nand }; + +TYPE + MemoryOrder = { Relaxed, Release, Acquire, AcquireRelease, Sequential }; + AtomicOp = { Add, Sub, Or, And, Xor }; CONST (* A op B === B SwappedCompare[op] A *) SwappedCompare = ARRAY CompareOp OF CompareOp { @@ -146,6 +149,3 @@ of RuntimeError.T used by the runtime system. *) END M3CG. - - - Index: m3-sys/m3middle/src/M3CG.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-sys/m3middle/src/M3CG.m3,v retrieving revision 1.3 diff -u -r1.3 M3CG.m3 --- m3-sys/m3middle/src/M3CG.m3 17 Feb 2009 07:04:03 -0000 1.3 +++ m3-sys/m3middle/src/M3CG.m3 16 Jan 2010 13:38:35 -0000 @@ -147,13 +147,12 @@ load_procedure := load_procedure; load_static_link := load_static_link; comment := comment; + store_ordered := store_ordered; + load_ordered := load_ordered; + exchange := exchange; + compare_exchange := compare_exchange; + fence := fence; fetch_and_op := fetch_and_op; - op_and_fetch := op_and_fetch; - bool_compare_and_swap := bool_compare_and_swap; - val_compare_and_swap := val_compare_and_swap; - synchronize := synchronize; - lock_test_and_set := lock_test_and_set; - lock_release := lock_release; END; (*----------------------------------------------------------- ID counters ---*) @@ -916,40 +915,37 @@ (*--------------------------------------------------------------- atomics ---*) -PROCEDURE fetch_and_op (xx: T; op: AtomicOp; t: MType) = +PROCEDURE store_ordered (xx: T; t: ZType; u: MType; order: MemoryOrder) = BEGIN - xx.child.fetch_and_op (op, t); - END fetch_and_op; - -PROCEDURE op_and_fetch (xx: T; op: AtomicOp; t: MType) = - BEGIN - xx.child.op_and_fetch (op, t); - END op_and_fetch; + xx.child.store_ordered (t, u, order); + END store_ordered; -PROCEDURE bool_compare_and_swap (xx: T; t: MType; u: IType) = +PROCEDURE load_ordered (xx: T; t: MType; u: ZType; order: MemoryOrder) = BEGIN - xx.child.bool_compare_and_swap (t, u); - END bool_compare_and_swap; + xx.child.load_ordered (t, u, order); + END load_ordered; -PROCEDURE val_compare_and_swap (xx: T; t: MType) = +PROCEDURE exchange (xx: T; t: MType; u: ZType; order: MemoryOrder) = BEGIN - xx.child.val_compare_and_swap (t); - END val_compare_and_swap; + xx.child.exchange (t, u, order); + END exchange; -PROCEDURE synchronize (xx: T) = +PROCEDURE compare_exchange (xx: T; s: MType; t: ZType; u: IType; + success, failure: MemoryOrder) = BEGIN - xx.child.synchronize (); - END synchronize; + xx.child.compare_exchange (s, t, u, success, failure); + END compare_exchange; -PROCEDURE lock_test_and_set (xx: T; t: MType) = +PROCEDURE fence (xx: T; order: MemoryOrder) = BEGIN - xx.child.lock_test_and_set (t); - END lock_test_and_set; + xx.child.fence (order); + END fence; -PROCEDURE lock_release (xx: T; t: MType) = +PROCEDURE fetch_and_op (xx: T; op: AtomicOp; t: MType; u: ZType; + order: MemoryOrder) = BEGIN - xx.child.lock_release (t); - END lock_release; + xx.child.fetch_and_op (op, t, u, order); + END fetch_and_op; BEGIN END M3CG. Index: m3-sys/m3middle/src/M3CG_BinRd.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-sys/m3middle/src/M3CG_BinRd.m3,v retrieving revision 1.8 diff -u -r1.8 M3CG_BinRd.m3 --- m3-sys/m3middle/src/M3CG_BinRd.m3 13 Apr 2008 20:27:43 -0000 1.8 +++ m3-sys/m3middle/src/M3CG_BinRd.m3 16 Jan 2010 13:38:35 -0000 @@ -6,7 +6,7 @@ IMPORT Fmt, Rd, Stdio, Text, Thread, Word, Wr; IMPORT M3ID, M3CG, M3CG_Ops, M3CG_Binary; IMPORT Target, TargetMap, TInt, TFloat, TWord; -FROM M3CG IMPORT CompareOp, ConvertOp, AtomicOp, RuntimeError; +FROM M3CG IMPORT CompareOp, ConvertOp, AtomicOp, RuntimeError, MemoryOrder; TYPE Bop = M3CG_Binary.Op; @@ -189,23 +189,16 @@ Cmd {Bop.load_procedure, load_procedure}, Cmd {Bop.load_static_link, load_static_link}, Cmd {Bop.comment, comment}, + Cmd {Bop.store_ordered, store_ordered}, + Cmd {Bop.load_ordered, load_ordered}, + Cmd {Bop.exchange, exchange}, + Cmd {Bop.compare_exchange, compare_exchange}, + Cmd {Bop.fence, fence}, Cmd {Bop.fetch_and_add, fetch_and_add}, Cmd {Bop.fetch_and_sub, fetch_and_sub}, Cmd {Bop.fetch_and_or, fetch_and_or}, Cmd {Bop.fetch_and_and, fetch_and_and}, - Cmd {Bop.fetch_and_xor, fetch_and_xor}, - Cmd {Bop.fetch_and_nand, fetch_and_nand}, - Cmd {Bop.add_and_fetch, add_and_fetch}, - Cmd {Bop.sub_and_fetch, sub_and_fetch}, - Cmd {Bop.or_and_fetch, or_and_fetch}, - Cmd {Bop.and_and_fetch, and_and_fetch}, - Cmd {Bop.xor_and_fetch, xor_and_fetch}, - Cmd {Bop.nand_and_fetch, nand_and_fetch}, - Cmd {Bop.bool_compare_and_swap, bool_compare_and_swap}, - Cmd {Bop.val_compare_and_swap, val_compare_and_swap}, - Cmd {Bop.synchronize, synchronize}, - Cmd {Bop.lock_test_and_set, lock_test_and_set}, - Cmd {Bop.lock_release, lock_release} + Cmd {Bop.fetch_and_xor, fetch_and_xor} }; PROCEDURE Inhale (rd: Rd.T; cg: M3CG.T) = @@ -1642,10 +1635,54 @@ (*--------------------------------------------------------------- atomics ---*) +PROCEDURE store_ordered (VAR s: State) = + VAR src := Scan_type (s); + dest := Scan_type (s); + order := Scan_int (s); + BEGIN + s.cg.store_ordered (src, dest, VAL(order, MemoryOrder)); + END store_ordered; + +PROCEDURE load_ordered (VAR s: State) = + VAR src := Scan_type (s); + dest := Scan_type (s); + order := Scan_int (s); + BEGIN + s.cg.load_ordered (src, dest, VAL(order, MemoryOrder)); + END load_ordered; + +PROCEDURE exchange (VAR s: State) = + VAR src := Scan_type (s); + dest := Scan_type (s); + order := Scan_int (s); + BEGIN + s.cg.exchange (src, dest, VAL(order, MemoryOrder)); + END exchange; + +PROCEDURE compare_exchange (VAR s: State) = + VAR src := Scan_type (s); + dest := Scan_type (s); + res := Scan_type (s); + success := Scan_int (s); + failure := Scan_int (s); + BEGIN + s.cg.compare_exchange (src, dest, res, + VAL(success, MemoryOrder), + VAL(failure, MemoryOrder)); + END compare_exchange; + +PROCEDURE fence (VAR s: State) = + VAR order := Scan_int (s); + BEGIN + s.cg.fence (VAL(order, MemoryOrder)); + END fence; + PROCEDURE fetch_and_op (VAR s: State; op: AtomicOp) = - VAR type := Scan_type (s); + VAR src := Scan_type (s); + dest := Scan_type (s); + order := Scan_int (s); BEGIN - s.cg.fetch_and_op (op, type); + s.cg.fetch_and_op (op, src, dest, VAL(order, MemoryOrder)); END fetch_and_op; PROCEDURE fetch_and_add (VAR s: State) = @@ -1673,77 +1710,6 @@ fetch_and_op (s, AtomicOp.Xor); END fetch_and_xor; -PROCEDURE fetch_and_nand (VAR s: State) = - BEGIN - fetch_and_op (s, AtomicOp.Nand); - END fetch_and_nand; - -PROCEDURE op_and_fetch (VAR s: State; op: AtomicOp) = - VAR type := Scan_type (s); - BEGIN - s.cg.op_and_fetch (op, type); - END op_and_fetch; - -PROCEDURE add_and_fetch (VAR s: State) = - BEGIN - op_and_fetch (s, AtomicOp.Add); - END add_and_fetch; - -PROCEDURE sub_and_fetch (VAR s: State) = - BEGIN - op_and_fetch (s, AtomicOp.Sub); - END sub_and_fetch; - -PROCEDURE or_and_fetch (VAR s: State) = - BEGIN - op_and_fetch (s, AtomicOp.Or); - END or_and_fetch; - -PROCEDURE and_and_fetch (VAR s: State) = - BEGIN - op_and_fetch (s, AtomicOp.And); - END and_and_fetch; - -PROCEDURE xor_and_fetch (VAR s: State) = - BEGIN - op_and_fetch (s, AtomicOp.Xor); - END xor_and_fetch; - -PROCEDURE nand_and_fetch (VAR s: State) = - BEGIN - op_and_fetch (s, AtomicOp.Nand); - END nand_and_fetch; - -PROCEDURE bool_compare_and_swap (VAR s: State) = - VAR src := Scan_type (s); - dest := Scan_type (s); - BEGIN - s.cg.bool_compare_and_swap (src, dest); - END bool_compare_and_swap; - -PROCEDURE val_compare_and_swap (VAR s: State) = - VAR type := Scan_type (s); - BEGIN - s.cg.val_compare_and_swap (type); - END val_compare_and_swap; - -PROCEDURE synchronize (VAR s: State) = - BEGIN - s.cg.synchronize (); - END synchronize; - -PROCEDURE lock_test_and_set (VAR s: State) = - VAR type := Scan_type (s); - BEGIN - s.cg.lock_test_and_set (type); - END lock_test_and_set; - -PROCEDURE lock_release (VAR s: State) = - VAR type := Scan_type (s); - BEGIN - s.cg.lock_release (type); - END lock_release; - BEGIN FOR op := FIRST (CmdMap) TO LAST (CmdMap) DO <*ASSERT CmdMap[op].bop = op *> Index: m3-sys/m3middle/src/M3CG_BinWr.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-sys/m3middle/src/M3CG_BinWr.m3,v retrieving revision 1.9 diff -u -r1.9 M3CG_BinWr.m3 --- m3-sys/m3middle/src/M3CG_BinWr.m3 17 Feb 2009 07:04:03 -0000 1.9 +++ m3-sys/m3middle/src/M3CG_BinWr.m3 16 Jan 2010 13:38:35 -0000 @@ -12,6 +12,7 @@ FROM M3CG IMPORT Var, Proc, Label, Sign, BitOffset; FROM M3CG IMPORT Type, ZType, AType, RType, IType, MType; FROM M3CG IMPORT CompareOp, ConvertOp, AtomicOp, RuntimeError; +FROM M3CG IMPORT MemoryOrder; TYPE Bop = M3CG_Binary.Op; TYPE WrVar = Var OBJECT tag: INTEGER END; @@ -172,13 +173,12 @@ load_procedure := load_procedure; load_static_link := load_static_link; comment := comment; + store_ordered := store_ordered; + load_ordered := load_ordered; + exchange := exchange; + compare_exchange := compare_exchange; + fence := fence; fetch_and_op := fetch_and_op; - op_and_fetch := op_and_fetch; - bool_compare_and_swap := bool_compare_and_swap; - val_compare_and_swap := val_compare_and_swap; - synchronize := synchronize; - lock_test_and_set := lock_test_and_set; - lock_release := lock_release; END; (*------------------------------------------------------------------- I/O ---*) @@ -1609,55 +1609,59 @@ (*--------------------------------------------------------------- atomics ---*) -PROCEDURE fetch_and_op (u: U; op: AtomicOp; t: MType) = - CONST - OpName = ARRAY AtomicOp OF Bop { Bop.fetch_and_add, Bop.fetch_and_sub, - Bop.fetch_and_or, Bop.fetch_and_and, - Bop.fetch_and_xor, Bop.fetch_and_nand }; +PROCEDURE store_ordered (u: U; t: ZType; z: MType; order: MemoryOrder) = BEGIN - Cmd (u, OpName [op]); + Cmd (u, Bop.store_ordered); TName (u, t); - END fetch_and_op; + TName (u, z); + Int (u, ORD(order)); + END store_ordered; -PROCEDURE op_and_fetch (u: U; op: AtomicOp; t: MType) = - CONST - OpName = ARRAY AtomicOp OF Bop { Bop.add_and_fetch, Bop.sub_and_fetch, - Bop.or_and_fetch, Bop.and_and_fetch, - Bop.xor_and_fetch, Bop.nand_and_fetch }; +PROCEDURE load_ordered (u: U; t: MType; z: ZType; order: MemoryOrder) = BEGIN - Cmd (u, OpName [op]); + Cmd (u, Bop.load_ordered); TName (u, t); - END op_and_fetch; + TName (u, z); + Int (u, ORD(order)); + END load_ordered; -PROCEDURE bool_compare_and_swap (u: U; t: MType; z: IType) = +PROCEDURE exchange (u: U; t: MType; z: ZType; order: MemoryOrder) = BEGIN - Cmd (u, Bop.bool_compare_and_swap); + Cmd (u, Bop.exchange); TName (u, t); TName (u, z); - END bool_compare_and_swap; + Int (u, ORD(order)); + END exchange; -PROCEDURE val_compare_and_swap (u: U; t: MType) = +PROCEDURE compare_exchange (u: U; t: MType; z: ZType; r: IType; + success, failure: MemoryOrder) = BEGIN - Cmd (u, Bop.val_compare_and_swap); + Cmd (u, Bop.exchange); TName (u, t); - END val_compare_and_swap; - -PROCEDURE synchronize (u: U) = - BEGIN - Cmd (u, Bop.synchronize); - END synchronize; + TName (u, z); + TName (u, r); + Int (u, ORD(success)); + Int (u, ORD(failure)); + END compare_exchange; + +PROCEDURE fence (u: U; order: MemoryOrder) = + BEGIN + Cmd (u, Bop.fence); + Int (u, ORD(order)); + END fence; -PROCEDURE lock_test_and_set (u: U; t: MType) = - BEGIN - Cmd (u, Bop.lock_test_and_set); - TName (u, t); - END lock_test_and_set; - -PROCEDURE lock_release (u: U; t: MType) = +PROCEDURE fetch_and_op (u: U; op: AtomicOp; t: MType; z: ZType; + order: MemoryOrder) = + CONST + OpName = ARRAY AtomicOp OF Bop { Bop.fetch_and_add, Bop.fetch_and_sub, + Bop.fetch_and_or, Bop.fetch_and_and, + Bop.fetch_and_xor }; BEGIN - Cmd (u, Bop.lock_release); + Cmd (u, OpName [op]); TName (u, t); - END lock_release; + TName (u, z); + Int (u, ORD(order)); + END fetch_and_op; BEGIN END M3CG_BinWr. Index: m3-sys/m3middle/src/M3CG_Binary.i3 =================================================================== RCS file: /usr/cvs/cm3/m3-sys/m3middle/src/M3CG_Binary.i3,v retrieving revision 1.3 diff -u -r1.3 M3CG_Binary.i3 --- m3-sys/m3middle/src/M3CG_Binary.i3 22 Jun 2007 15:02:34 -0000 1.3 +++ m3-sys/m3middle/src/M3CG_Binary.i3 16 Jan 2010 13:38:35 -0000 @@ -37,10 +37,8 @@ start_call_direct, call_direct, start_call_indirect, call_indirect, pop_param, pop_struct, pop_static_link, load_procedure, load_static_link, comment, - fetch_and_add, fetch_and_sub, fetch_and_or, fetch_and_and, fetch_and_xor, fetch_and_nand, - add_and_fetch, sub_and_fetch, or_and_fetch, and_and_fetch, xor_and_fetch, nand_and_fetch, - bool_compare_and_swap, val_compare_and_swap, - synchronize, lock_test_and_set, lock_release + store_ordered, load_ordered, exchange, compare_exchange, fence, + fetch_and_add, fetch_and_sub, fetch_and_or, fetch_and_and, fetch_and_xor }; (* Integers are encoded as sequences of unsigned bytes, [0..255]. Index: m3-sys/m3middle/src/M3CG_Check.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-sys/m3middle/src/M3CG_Check.m3,v retrieving revision 1.5 diff -u -r1.5 M3CG_Check.m3 --- m3-sys/m3middle/src/M3CG_Check.m3 17 Feb 2009 07:04:03 -0000 1.5 +++ m3-sys/m3middle/src/M3CG_Check.m3 16 Jan 2010 13:38:35 -0000 @@ -14,6 +14,7 @@ FROM M3CG IMPORT ByteSize, Alignment, Frequency, RuntimeError; FROM M3CG IMPORT Var, Proc, Label, Sign, CompareOp, ConvertOp, AtomicOp; FROM M3CG IMPORT Type, ZType, AType, RType, IType, MType; +FROM M3CG IMPORT MemoryOrder; TYPE (* stack data types *) ST = { Addr, Int32, Int64, Reel, LReel, XReel, Void, @@ -160,13 +161,12 @@ pop_static_link := pop_static_link; load_procedure := load_procedure; load_static_link := load_static_link; + store_ordered := store_ordered; + load_ordered := load_ordered; + exchange := exchange; + compare_exchange := compare_exchange; + fence := fence; fetch_and_op := fetch_and_op; - op_and_fetch := op_and_fetch; - bool_compare_and_swap := bool_compare_and_swap; - val_compare_and_swap := val_compare_and_swap; - synchronize := synchronize; - lock_test_and_set := lock_test_and_set; - lock_release := lock_release; END; @@ -1320,51 +1320,69 @@ (*--------------------------------------------------------------- atomics ---*) -PROCEDURE fetch_and_op (self: U; op: AtomicOp; t: MType) = +PROCEDURE store_ordered (self: U; z: ZType; t: MType; order: MemoryOrder) = BEGIN - self.s_pop (ST.Addr); - self.s_push (t); - self.child.fetch_and_op (op, t); - END fetch_and_op; - -PROCEDURE op_and_fetch (self: U; op: AtomicOp; t: MType) = - BEGIN - self.s_pop (ST.Addr); - self.s_push (t); - self.child.op_and_fetch (op, t); - END op_and_fetch; - -PROCEDURE bool_compare_and_swap (self: U; t: MType; u: IType) = - BEGIN - self.s_pop (T_to_ST [t], ST.Match, ST.Addr); - self.s_push (u); - self.child.bool_compare_and_swap (t, u); - END bool_compare_and_swap; - -PROCEDURE val_compare_and_swap (self: U; t: MType) = - BEGIN - self.s_pop (T_to_ST [t], ST.Match, ST.Addr); - self.s_push (t); - self.child.val_compare_and_swap (t); - END val_compare_and_swap; - -PROCEDURE synchronize (self: U) = - BEGIN - self.child.synchronize (); - END synchronize; - -PROCEDURE lock_test_and_set (self: U; t: MType) = - BEGIN - self.s_pop (T_to_ST [t], ST.Addr); - self.s_push (t); - self.child.lock_test_and_set (t); - END lock_test_and_set; + IF NOT LegalStore [z, t] THEN PutErr (self, "illegal store conversion"); END; + CASE order OF + | MemoryOrder.Acquire, MemoryOrder.AcquireRelease => + PutErr (self, "illegal store memory order"); + ELSE (* ok *) END; + self.s_pop (T_to_ST [z], ST.Addr); + IF (self.clean_stores) THEN self.s_empty () END; + self.child.store_ordered (z, t, order); + END store_ordered; -PROCEDURE lock_release (self: U; t: MType) = +PROCEDURE load_ordered (self: U; t: MType; z: ZType; + order: MemoryOrder) = BEGIN + IF NOT LegalLoad [t, z] THEN PutErr (self, "illegal load conversion"); END; + CASE order OF + | MemoryOrder.Release, MemoryOrder.AcquireRelease => + PutErr (self, "illegal load memory order"); + ELSE (* ok *) END; self.s_pop (ST.Addr); - self.child.lock_release (t); - END lock_release; + self.s_push (z); + self.child.load_ordered (t, z, order); + END load_ordered; + +PROCEDURE exchange (self: U; m: MType; z: ZType; order: MemoryOrder) = + BEGIN + IF NOT LegalStore [z, m] THEN PutErr (self, "illegal store conversion"); END; + IF NOT LegalLoad [m, z] THEN PutErr (self, "illegal load conversion"); END; + self.s_pop (T_to_ST [z], ST.Addr); + self.s_push (z); + self.child.exchange (m, z, order); + END exchange; + +PROCEDURE compare_exchange (self: U; m: MType; z: ZType; i: IType; + success, failure: MemoryOrder) = + BEGIN + IF NOT LegalStore [z, m] THEN PutErr (self, "illegal store conversion"); END; + IF NOT LegalLoad [m, z] THEN PutErr (self, "illegal load conversion"); END; + CASE failure OF + | MemoryOrder.Release, MemoryOrder.AcquireRelease => + PutErr (self, "illegal load memory order"); + ELSE (* ok *) END; + IF failure > success THEN PutErr (self, "failure stronger than success"); END; + self.s_pop (T_to_ST [z], ST.Addr, ST.Addr); + self.s_push (i); + self.child.compare_exchange (m, z, i, success, failure); + END compare_exchange; + +PROCEDURE fence (self: U; order: MemoryOrder) = + BEGIN + self.child.fence (order); + END fence; + +PROCEDURE fetch_and_op (self: U; op: AtomicOp; m: MType; z: ZType; + order: MemoryOrder) = + BEGIN + IF NOT LegalStore [z, m] THEN PutErr (self, "illegal store conversion"); END; + IF NOT LegalLoad [m, z] THEN PutErr (self, "illegal load conversion"); END; + self.s_pop (T_to_ST[z], ST.Addr); + self.s_push (z); + self.child.fetch_and_op (op, m, z, order); + END fetch_and_op; BEGIN END M3CG_Check. Index: m3-sys/m3middle/src/M3CG_Ops.i3 =================================================================== RCS file: /usr/cvs/cm3/m3-sys/m3middle/src/M3CG_Ops.i3,v retrieving revision 1.4 diff -u -r1.4 M3CG_Ops.i3 --- m3-sys/m3middle/src/M3CG_Ops.i3 17 Feb 2009 07:04:03 -0000 1.4 +++ m3-sys/m3middle/src/M3CG_Ops.i3 16 Jan 2010 13:38:35 -0000 @@ -18,6 +18,7 @@ FROM M3CG IMPORT Name, Var, Proc, Alignment, TypeUID, Label; FROM M3CG IMPORT Frequency, CallingConvention, CompareOp, ConvertOp, AtomicOp; FROM M3CG IMPORT BitSize, ByteSize, BitOffset, ByteOffset, RuntimeError; +FROM M3CG IMPORT MemoryOrder; TYPE ErrorHandler = PROCEDURE (msg: TEXT); @@ -361,7 +362,7 @@ (* s0.u := Mem [s0.A + o].t *) store (v: Var; o: ByteOffset; t: ZType; u: MType); -(* Mem [ ADR(v) + o : s ].u := s0.t; pop *) +(* Mem [ ADR(v) + o ].u := s0.t; pop *) store_indirect (o: ByteOffset; t: ZType; u: MType); (* Mem [s1.A + o].u := s0.t; pop (2) *) @@ -611,72 +612,31 @@ may be NIL. *) (*--------------------------------------------------------------- atomics ---*) -(* The following builtins are intended to be compatible with those described - in the Intel Itanium Processor-specific Application Binary Interface, - section 7.4. - - The definition given in the Intel documentation allows only for the use of - the types int, long, long long, as well as their unsigned counterparts. GCC - will allow any integral scalar or pointer type that is 1, 2, 4 or 8 bytes - in length. - - Not all operations are supported by all target processors. If a particular - operation cannot be implemented on the target processor, a warning will be - generated and a call to an external function will be generated. The - external function will carry the same name as the builtin, with an - additional suffix `_n' where n is the size of the data type. - - In most cases, these builtins are considered a full barrier. That is, no - memory operand will be moved across the operation, either forward or - backward. Further, instructions will be issued as necessary to prevent the - processor from speculating loads across the operation and from queuing - stores after the operation. - - All of the routines are are described in the Intel documentation to take - "an optional list of variables protected by the memory barrier". It's not - clear what is meant by that; it could mean that only the following - variables are protected, or it could mean that these variables should in - addition be protected. At present GCC ignores this list and protects all - variables which are globally accessible. If in the future we make some use - of this list, an empty list will continue to mean all globally accessible - variables. *) - -fetch_and_op (op: AtomicOp; t: MType); -(* tmp := Mem [s1.A].t; Mem [s1.A].t := tmp op s0.t; s1.t := tmp; pop *) -op_and_fetch (op: AtomicOp; t: MType); -(* tmp := Mem [s1.A].t op s0.t; Mem [s1.A].t := tmp; s1.t := tmp; pop *) - -bool_compare_and_swap (t: MType; u: IType); -(* tmp := Mem [s2.A].t; IF tmp = s1.t THEN Mem [s2.A].t := s0.t; END; s2.u := (tmp = s1.t); pop(2) *) -val_compare_and_swap (t: MType); -(* tmp := Mem [s2.A].t; IF tmp = s1.t THEN Mem [s2.A].t := s0.t; END; s2.t := tmp; pop(2) *) - -synchronize (); -(* This builtin issues a full memory barrier *) - -lock_test_and_set (t: MType); -(* tmp := Mem [s1.A].t; Mem [s1.A].t := s0.t; s1.t := tmp; pop *) -(* This builtin, as described by Intel, is not a traditional test-and-set - operation, but rather an atomic exchange operation. It writes value into - *ptr, and returns the previous contents of *ptr. Many targets have only - minimal support for such locks, and do not support a full exchange - operation. In this case, a target may support reduced functionality here by - which the only valid value to store is the immediate constant 1. The exact - value actually stored in *ptr is implementation defined. - - This builtin is not a full barrier, but rather an acquire barrier. This - means that references after the builtin cannot move to (or be speculated - to) before the builtin, but previous memory stores may not be globally - visible yet, and previous memory loads may not yet be satisfied. *) - -lock_release (t: MType); -(* Mem [s0.A].t := 0; pop *) -(* This builtin releases the lock acquired by lock_test_and_set. Normally this - means writing the constant 0 to *ptr. This builtin is not a full barrier, - but rather a release barrier. This means that all previous memory stores - are globally visible, and all previous memory loads have been satisfied, - but following memory reads are not prevented from being speculated to - before the barrier. *) +(* These all operate atomically and affect memory as per "o". *) + +store_ordered (t: ZType; u: MType; order: MemoryOrder); +(* Mem [s1.A].u := s0.t; pop (2) *) + +load_ordered (t: MType; u: ZType; order: MemoryOrder); +(* s0.u := Mem [s0.A].t *) + +exchange (t: MType; u: ZType; order: MemoryOrder); +(* tmp := Mem [s1.A + o].t; Mem [s1.A + o].t := s0.u; s0.u := tmp; pop *) + +compare_exchange (t: MType; u: ZType; r: IType; success, failure: MemoryOrder); +(* t1 := Mem[s1.A].t; t2 := Mem[s2.A].t; + IF (t1.u = t2.u) + THEN Mem [s2.A].t := s0.u; s2.r := 1; pop(2); + ELSE Mem [s1.A].t := t2; s2.r := 0; pop(2); + END; *) + +fence (o: MemoryOrder); +(* Memory is affected as per o *) + +fetch_and_op (op: AtomicOp; t: MType; u: ZType; order: MemoryOrder); +(* tmp := Mem [s1.A].t; + Mem [s1.A].t := tmp op s0.u; + s1.u := tmp; pop *) END; (* TYPE Public *) Index: m3-sys/m3middle/src/M3CG_Rd.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-sys/m3middle/src/M3CG_Rd.m3,v retrieving revision 1.5 diff -u -r1.5 M3CG_Rd.m3 --- m3-sys/m3middle/src/M3CG_Rd.m3 18 Sep 2007 20:26:26 -0000 1.5 +++ m3-sys/m3middle/src/M3CG_Rd.m3 16 Jan 2010 13:38:35 -0000 @@ -10,6 +10,7 @@ IMPORT Text, Rd, IntIntTbl, Thread, Convert, Wr, Stdio, Fmt; IMPORT M3ID, M3CG, M3CG_Ops, Target, TInt, TFloat; FROM M3CG IMPORT CompareOp, ConvertOp, AtomicOp, RuntimeError; +FROM M3CG IMPORT MemoryOrder; CONST EOF = '\000'; @@ -38,7 +39,7 @@ END; CONST - CmdMap = ARRAY [0..168] OF Cmd { + CmdMap = ARRAY [0..161] OF Cmd { Cmd {"begin_unit", begin_unit}, Cmd {"end_unit", end_unit}, Cmd {"import_unit", import_unit}, @@ -191,23 +192,16 @@ Cmd {"load_procedure", load_procedure}, Cmd {"load_static_link", load_static_link}, Cmd {"#", comment}, + Cmd {"store_ordered", store_ordered}, + Cmd {"load_ordered", load_ordered}, + Cmd {"exchange", exchange}, + Cmd {"compare_exchange", compare_exchange}, + Cmd {"fence", fence}, Cmd {"fetch_and_add", fetch_and_add}, Cmd {"fetch_and_sub", fetch_and_sub}, Cmd {"fetch_and_or", fetch_and_or}, Cmd {"fetch_and_and", fetch_and_and}, - Cmd {"fetch_and_xor", fetch_and_xor}, - Cmd {"fetch_and_nand", fetch_and_nand}, - Cmd {"add_and_fetch", add_and_fetch}, - Cmd {"sub_and_fetch", sub_and_fetch}, - Cmd {"or_and_fetch", or_and_fetch}, - Cmd {"and_and_fetch", and_and_fetch}, - Cmd {"xor_and_fetch", xor_and_fetch}, - Cmd {"nand_and_fetch", nand_and_fetch}, - Cmd {"bool_compare_and_swap", bool_compare_and_swap}, - Cmd {"val_compare_and_swap", val_compare_and_swap}, - Cmd {"synchronize", synchronize}, - Cmd {"lock_test_and_set", lock_test_and_set}, - Cmd {"lock_release", lock_release} + Cmd {"fetch_and_xor", fetch_and_xor} }; VAR @@ -1768,10 +1762,53 @@ (*--------------------------------------------------------------- atomics ---*) +PROCEDURE store_ordered (VAR s: State) = + VAR src := Scan_type (s); + dest := Scan_type (s); + order := Scan_int (s); + BEGIN + s.cg.store_ordered (src, dest, VAL(order, MemoryOrder)); + END store_ordered; + +PROCEDURE load_ordered (VAR s: State) = + VAR src := Scan_type (s); + dest := Scan_type (s); + order := Scan_int (s); + BEGIN + s.cg.load_ordered (src, dest, VAL(order, MemoryOrder)); + END load_ordered; + +PROCEDURE exchange (VAR s: State) = + VAR src := Scan_type (s); + dest := Scan_type (s); + order := Scan_int (s); + BEGIN + s.cg.exchange (src, dest, VAL(order, MemoryOrder)); + END exchange; + +PROCEDURE compare_exchange (VAR s: State) = + VAR src := Scan_type (s); + dest := Scan_type (s); + result := Scan_type (s); + success:= Scan_int (s); + failure:= Scan_int (s); + BEGIN + s.cg.compare_exchange (src, dest, result, + VAL(success, MemoryOrder), VAL(failure, MemoryOrder)); + END compare_exchange; + +PROCEDURE fence (VAR s: State) = + VAR order := Scan_int (s); + BEGIN + s.cg.fence (VAL(order, MemoryOrder)); + END fence; + PROCEDURE fetch_and_op (VAR s: State; op: AtomicOp) = - VAR type := Scan_type (s); + VAR src := Scan_type (s); + dest := Scan_type (s); + order := Scan_int (s); BEGIN - s.cg.fetch_and_op (op, type); + s.cg.fetch_and_op (op, src, dest, VAL(order, MemoryOrder)); END fetch_and_op; PROCEDURE fetch_and_add (VAR s: State) = @@ -1799,76 +1836,5 @@ fetch_and_op (s, AtomicOp.Xor); END fetch_and_xor; -PROCEDURE fetch_and_nand (VAR s: State) = - BEGIN - fetch_and_op (s, AtomicOp.Nand); - END fetch_and_nand; - -PROCEDURE op_and_fetch (VAR s: State; op: AtomicOp) = - VAR type := Scan_type (s); - BEGIN - s.cg.op_and_fetch (op, type); - END op_and_fetch; - -PROCEDURE add_and_fetch (VAR s: State) = - BEGIN - op_and_fetch (s, AtomicOp.Add); - END add_and_fetch; - -PROCEDURE sub_and_fetch (VAR s: State) = - BEGIN - op_and_fetch (s, AtomicOp.Sub); - END sub_and_fetch; - -PROCEDURE or_and_fetch (VAR s: State) = - BEGIN - op_and_fetch (s, AtomicOp.Or); - END or_and_fetch; - -PROCEDURE and_and_fetch (VAR s: State) = - BEGIN - op_and_fetch (s, AtomicOp.And); - END and_and_fetch; - -PROCEDURE xor_and_fetch (VAR s: State) = - BEGIN - op_and_fetch (s, AtomicOp.Xor); - END xor_and_fetch; - -PROCEDURE nand_and_fetch (VAR s: State) = - BEGIN - op_and_fetch (s, AtomicOp.Nand); - END nand_and_fetch; - -PROCEDURE bool_compare_and_swap (VAR s: State) = - VAR src := Scan_type (s); - dest := Scan_type (s); - BEGIN - s.cg.bool_compare_and_swap (src, dest); - END bool_compare_and_swap; - -PROCEDURE val_compare_and_swap (VAR s: State) = - VAR type := Scan_type (s); - BEGIN - s.cg.val_compare_and_swap (type); - END val_compare_and_swap; - -PROCEDURE synchronize (VAR s: State) = - BEGIN - s.cg.synchronize (); - END synchronize; - -PROCEDURE lock_test_and_set (VAR s: State) = - VAR type := Scan_type (s); - BEGIN - s.cg.lock_test_and_set (type); - END lock_test_and_set; - -PROCEDURE lock_release (VAR s: State) = - VAR type := Scan_type (s); - BEGIN - s.cg.lock_release (type); - END lock_release; - BEGIN END M3CG_Rd. Index: m3-sys/m3middle/src/M3CG_Wr.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-sys/m3middle/src/M3CG_Wr.m3,v retrieving revision 1.6 diff -u -r1.6 M3CG_Wr.m3 --- m3-sys/m3middle/src/M3CG_Wr.m3 17 Feb 2009 07:04:03 -0000 1.6 +++ m3-sys/m3middle/src/M3CG_Wr.m3 16 Jan 2010 13:38:35 -0000 @@ -15,6 +15,7 @@ FROM M3CG IMPORT Var, Proc, Label, Sign, BitOffset, No_label; FROM M3CG IMPORT Type, ZType, AType, RType, IType, MType; FROM M3CG IMPORT CompareOp, ConvertOp, AtomicOp, RuntimeError; +FROM M3CG IMPORT MemoryOrder; TYPE WrVar = Var OBJECT tag: INTEGER END; TYPE WrProc = Proc OBJECT tag: INTEGER END; @@ -174,13 +175,12 @@ load_procedure := load_procedure; load_static_link := load_static_link; comment := comment; + store_ordered := store_ordered; + load_ordered := load_ordered; + exchange := exchange; + compare_exchange := compare_exchange; + fence := fence; fetch_and_op := fetch_and_op; - op_and_fetch := op_and_fetch; - bool_compare_and_swap := bool_compare_and_swap; - val_compare_and_swap := val_compare_and_swap; - synchronize := synchronize; - lock_test_and_set := lock_test_and_set; - lock_release := lock_release; END; @@ -1755,60 +1755,64 @@ (*--------------------------------------------------------------- atomics ---*) -PROCEDURE fetch_and_op (u: U; op: AtomicOp; t: MType) = - CONST OpName = ARRAY AtomicOp OF TEXT { "fetch_and_add", "fetch_and_sub", - "fetch_and_or", "fetch_and_and", - "fetch_and_xor", "fetch_and_nand" }; +PROCEDURE store_ordered (u: U; t: ZType; z: MType; order: MemoryOrder) = BEGIN - Cmd (u, OpName [op]); + Cmd (u, "store_ordered"); TName (u, t); + TName (u, z); + Int (u, ORD(order)); NL (u); - END fetch_and_op; + END store_ordered; -PROCEDURE op_and_fetch (u: U; op: AtomicOp; t: MType) = - CONST OpName = ARRAY AtomicOp OF TEXT { "add_and_fetch", "sub_and_fetch", - "or_and_fetch", "and_and_fetch", - "xor_and_fetch", "nand_and_fetch" }; +PROCEDURE load_ordered (u: U; t: MType; z: ZType; order: MemoryOrder) = BEGIN - Cmd (u, OpName [op]); + Cmd (u, "load_ordered"); TName (u, t); + TName (u, z); + Int (u, ORD(order)); NL (u); - END op_and_fetch; + END load_ordered; -PROCEDURE bool_compare_and_swap (u: U; t: MType; z: IType) = +PROCEDURE exchange (u: U; t: MType; z: ZType; order: MemoryOrder) = BEGIN - Cmd (u, "compare_and_swap"); + Cmd (u, "exchange"); TName (u, t); TName (u, z); + Int (u, ORD(order)); NL (u); - END bool_compare_and_swap; + END exchange; -PROCEDURE val_compare_and_swap (u: U; t: MType) = +PROCEDURE compare_exchange (u: U; t: MType; z: ZType; r: IType; + success, failure: MemoryOrder) = BEGIN - Cmd (u, "val_compare_and_swap"); + Cmd (u, "exchange"); TName (u, t); + TName (u, z); + TName (u, r); + Int (u, ORD(success)); + Int (u, ORD(failure)); NL (u); - END val_compare_and_swap; + END compare_exchange; -PROCEDURE synchronize (u: U) = +PROCEDURE fence (u: U; order: MemoryOrder) = BEGIN - Cmd (u, "synchronize"); - NL (u); - END synchronize; - -PROCEDURE lock_test_and_set (u: U; t: MType) = - BEGIN - Cmd (u, "lock_test_and_set"); - TName (u, t); + Cmd (u, "fence"); + Int (u, ORD(order)); NL (u); - END lock_test_and_set; - -PROCEDURE lock_release (u: U; t: MType) = + END fence; + +PROCEDURE fetch_and_op (u: U; op: AtomicOp; t: MType; z: ZType; + order: MemoryOrder) = + CONST OpName = ARRAY AtomicOp OF TEXT { "fetch_and_add", "fetch_and_sub", + "fetch_and_or", "fetch_and_and", + "fetch_and_xor" }; BEGIN - Cmd (u, "lock_release"); + Cmd (u, OpName [op]); TName (u, t); + TName (u, z); + Int (u, ORD(order)); NL (u); - END lock_release; + END fetch_and_op; BEGIN END M3CG_Wr. Index: m3-sys/m3quake/src/QCompiler.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-sys/m3quake/src/QCompiler.m3,v retrieving revision 1.1.1.1.10.1 diff -u -r1.1.1.1.10.1 QCompiler.m3 --- m3-sys/m3quake/src/QCompiler.m3 15 Jan 2010 13:43:39 -0000 1.1.1.1.10.1 +++ m3-sys/m3quake/src/QCompiler.m3 16 Jan 2010 13:38:35 -0000 @@ -44,7 +44,7 @@ END; TRY - s.lexer := NEW (QScanner.T).init (path, f, map); + s.lexer := NEW (QScanner.T).init (f, map); s.file := map.txt2id (path); s.code := NEW (QCode.Stream, source_file := s.file); s.map := map; Index: m3-sys/m3quake/src/QScanner.i3 =================================================================== RCS file: /usr/cvs/cm3/m3-sys/m3quake/src/QScanner.i3,v retrieving revision 1.1.1.1.10.2 diff -u -r1.1.1.1.10.2 QScanner.i3 --- m3-sys/m3quake/src/QScanner.i3 15 Jan 2010 14:46:06 -0000 1.1.1.1.10.2 +++ m3-sys/m3quake/src/QScanner.i3 16 Jan 2010 13:38:35 -0000 @@ -21,7 +21,7 @@ string : Quake.ID; (* token = QToken.T.{Name,String} *) cardinal : CARDINAL; (* token = OToken.T.Cardinal *) METHODS - init (path: TEXT; f: File.T; map: Quake.IDMap): T; + init (f: File.T; map: Quake.IDMap): T; initText (txt: TEXT; map: Quake.IDMap): T; next (); (* update the fields above *) END; Index: m3-sys/m3tools/src/M3Const.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-sys/m3tools/src/M3Const.m3,v retrieving revision 1.5 diff -u -r1.5 M3Const.m3 --- m3-sys/m3tools/src/M3Const.m3 18 Sep 2007 20:26:30 -0000 1.5 +++ m3-sys/m3tools/src/M3Const.m3 16 Jan 2010 13:38:37 -0000 @@ -1348,11 +1348,11 @@ (*------------------------------------------- built-in types and procedures ---*) CONST - BuiltinNames = ARRAY [0..41] OF TEXT { + BuiltinNames = ARRAY [0..42] OF TEXT { "ABS", "ADDRESS", "ADR", "ADRSIZE", "BITSIZE", "BOOLEAN", "BYTESIZE", "CARDINAL", "CEILING", "CHAR", "DEC", "DISPOSE", "EXTENDED", "FALSE", "FIRST", "FLOAT", "FLOOR", "INC", - "INTEGER", "ISTYPE", "LAST", "LONGINT", "LONGREAL", "LOOPHOLE", + "INTEGER", "ISTYPE", "LAST", "LONGCARD", "LONGINT", "LONGREAL", "LOOPHOLE", "MAX", "MIN", "MUTEX", "NARROW", "NEW", "NIL", "NULL", "NUMBER", "ORD", "REAL", "REFANY", "ROUND", "SUBARRAY", "TEXT", "TRUE", "TRUNC", "TYPECODE", "VAL" @@ -1482,108 +1482,112 @@ val.info := ORD (M3Builtin.Proc.Last); RETURN TRUE; - | 21 => (* LONGINT *) + | 21 => (* LONGCARD *) + val.class := Class.Type; + val.type := M3Type.Longcard; + + | 22 => (* LONGINT *) val.class := Class.Type; val.type := M3Type.Longint; - | 22 => (* LONGREAL *) + | 23 => (* LONGREAL *) val.class := Class.Type; val.type := M3Type.LongReal; RETURN TRUE; - | 23 => (* LOOPHOLE *) + | 24 => (* LOOPHOLE *) val.class := Class.Builtin; val.info := ORD (M3Builtin.Proc.Loophole); RETURN TRUE; - | 24 => (* MAX *) + | 25 => (* MAX *) val.class := Class.Builtin; val.info := ORD (M3Builtin.Proc.Max); RETURN TRUE; - | 25 => (* MIN *) + | 26 => (* MIN *) val.class := Class.Builtin; val.info := ORD (M3Builtin.Proc.Min); RETURN TRUE; - | 26 => (* MUTEX *) + | 27 => (* MUTEX *) val.class := Class.Type; val.type := M3Type.Mutex; RETURN TRUE; - | 27 => (* NARROW *) + | 28 => (* NARROW *) val.class := Class.Builtin; val.info := ORD (M3Builtin.Proc.Narrow); RETURN TRUE; - | 28 => (* NEW *) + | 29 => (* NEW *) val.class := Class.Builtin; val.info := ORD (M3Builtin.Proc.New); RETURN TRUE; - | 29 => (* NIL *) + | 30 => (* NIL *) val.class := Class.Addr; val.info := 0; val.type := M3Type.Null; RETURN TRUE; - | 30 => (* NULL *) + | 31 => (* NULL *) val.class := Class.Type; val.type := M3Type.Null; RETURN TRUE; - | 31 => (* NUMBER *) + | 32 => (* NUMBER *) val.class := Class.Builtin; val.info := ORD (M3Builtin.Proc.Number); RETURN TRUE; - | 32 => (* ORD *) + | 33 => (* ORD *) val.class := Class.Builtin; val.info := ORD (M3Builtin.Proc.Ord); RETURN TRUE; - | 33 => (* REAL *) + | 34 => (* REAL *) val.class := Class.Type; val.type := M3Type.Real; RETURN TRUE; - | 34 => (* REFANY *) + | 35 => (* REFANY *) val.class := Class.Type; val.type := M3Type.Refany; RETURN TRUE; - | 35 => (* ROUND *) + | 36 => (* ROUND *) val.class := Class.Builtin; val.info := ORD (M3Builtin.Proc.Round); RETURN TRUE; - | 36 => (* SUBARRAY *) + | 37 => (* SUBARRAY *) val.class := Class.Builtin; val.info := ORD (M3Builtin.Proc.Subarray); RETURN TRUE; - | 37 => (* TEXT *) + | 38 => (* TEXT *) val.class := Class.Type; val.type := M3Type.Txt; RETURN TRUE; - | 38 => (* TRUE *) + | 39 => (* TRUE *) val.class := Class.Enum; val.info := ORD (TRUE); val.type := M3Type.Boolean; RETURN TRUE; - | 39 => (* TRUNC *) + | 40 => (* TRUNC *) val.class := Class.Builtin; val.info := ORD (M3Builtin.Proc.Trunc); RETURN TRUE; - | 40 => (* TYPECODE *) + | 41 => (* TYPECODE *) val.class := Class.Builtin; val.info := ORD (M3Builtin.Proc.Typecode); RETURN TRUE; - | 41 => (* VAL *) + | 42 => (* VAL *) val.class := Class.Builtin; val.info := ORD (M3Builtin.Proc.Val); RETURN TRUE; Index: m3-sys/m3tools/src/M3Type.i3 =================================================================== RCS file: /usr/cvs/cm3/m3-sys/m3tools/src/M3Type.i3,v retrieving revision 1.3 diff -u -r1.3 M3Type.i3 --- m3-sys/m3tools/src/M3Type.i3 8 Aug 2007 03:50:06 -0000 1.3 +++ m3-sys/m3tools/src/M3Type.i3 16 Jan 2010 13:38:37 -0000 @@ -82,7 +82,7 @@ END; VAR(*READONLY*) (* builtin types *) - Integer, Longint, Cardinal: T; + Integer, Longint, Cardinal, Longcard: T; Real, LongReal, Extended : T; Root, UntracedRoot : T; Refany, Address, Null : T; Index: m3-sys/m3tools/src/M3Type.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-sys/m3tools/src/M3Type.m3,v retrieving revision 1.5 diff -u -r1.5 M3Type.m3 --- m3-sys/m3tools/src/M3Type.m3 18 Sep 2007 20:26:30 -0000 1.5 +++ m3-sys/m3tools/src/M3Type.m3 16 Jan 2010 13:38:37 -0000 @@ -957,6 +957,10 @@ min := TInt.Zero, max := Target.Integer.max, super := Integer); + Longcard := NEW (Subrange, + min := TInt.Zero, + max := Target.Longint.max, + super := Longint); VAR elts := NEW (REF ARRAY OF M3ID.T, 2); BEGIN elts[0] := M3ID.Add ("FALSE"); Index: m3-tools/m3browser/src/Main.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-tools/m3browser/src/Main.m3,v retrieving revision 1.4 diff -u -r1.4 Main.m3 --- m3-tools/m3browser/src/Main.m3 16 Jul 2009 19:56:45 -0000 1.4 +++ m3-tools/m3browser/src/Main.m3 16 Jan 2010 13:38:37 -0000 @@ -853,6 +853,7 @@ & "?195c2a74 INTEGER\n" & "?05562176 LONGINT\n" & "?97e237e2 CARDINAL\n" + & "?9ced36e7 LONGCARD\n" & "?1e59237d BOOLEAN\n" & "?08402063 ADDRESS\n" & "?56e16863 CHAR\n" Index: m3-tools/m3tk/src/fe/StandardAsText.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-tools/m3tk/src/fe/StandardAsText.m3,v retrieving revision 1.2 diff -u -r1.2 StandardAsText.m3 --- m3-tools/m3tk/src/fe/StandardAsText.m3 23 Feb 2009 01:50:31 -0000 1.2 +++ m3-tools/m3tk/src/fe/StandardAsText.m3 16 Jan 2010 13:38:37 -0000 @@ -22,6 +22,7 @@ standard := standard & "TYPE\n"; standard := standard & " CARDINAL = [0 .. LAST(INTEGER)];\n"; +standard := standard & " LONGCARD = [0L .. LAST(LONGINT)];\n"; standard := standard & " BOOLEAN = {FALSE, TRUE};\n"; standard := standard & " CHAR = {NUL, SOH, STX, ETX, EOT, ENQ, ACK, BEL,\n"; standard := standard & " BS, HT, NL, VT, NP, CR, SO, SI, \n"; Index: m3-tools/m3tk/src/fe/WiredStandard.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-tools/m3tk/src/fe/WiredStandard.m3,v retrieving revision 1.2 diff -u -r1.2 WiredStandard.m3 --- m3-tools/m3tk/src/fe/WiredStandard.m3 23 Feb 2009 01:50:31 -0000 1.2 +++ m3-tools/m3tk/src/fe/WiredStandard.m3 16 Jan 2010 13:38:37 -0000 @@ -14,7 +14,7 @@ IMPORT Date; CONST - Version = Date.T{2009, Date.Month.Feb, 23, 0, 48, 4, 0, "UTC", Date.WeekDay.Mon}; + Version = Date.T{2010, Date.Month.Jan, 15, 0, 48, 4, 0, "UTC", Date.WeekDay.Mon}; (* increase this when StandardAsText changes *) PROCEDURE Set(c: M3Context.T) RAISES {}= Index: m3-tools/m3tk/src/pl/M3LTextToType.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-tools/m3tk/src/pl/M3LTextToType.m3,v retrieving revision 1.2 diff -u -r1.2 M3LTextToType.m3 --- m3-tools/m3tk/src/pl/M3LTextToType.m3 17 Mar 2008 06:48:46 -0000 1.2 +++ m3-tools/m3tk/src/pl/M3LTextToType.m3 16 Jan 2010 13:38:37 -0000 @@ -591,6 +591,7 @@ | M3LTypeToText.CharCh => | M3LTypeToText.CardinalCh => | M3LTypeToText.IntegerCh => + | M3LTypeToText.LongcardCh => | M3LTypeToText.LongintCh => | M3LTypeToText.RealCh => | M3LTypeToText.LongRealCh => @@ -638,6 +639,8 @@ RETURN M3CStdTypes.Cardinal(); | M3LTypeToText.IntegerCh => RETURN M3CStdTypes.Integer(); + | M3LTypeToText.LongcardCh => + RETURN M3CStdTypes.Longcard(); | M3LTypeToText.LongintCh => RETURN M3CStdTypes.Longint(); | M3LTypeToText.RealCh => Index: m3-tools/m3tk/src/pl/M3LTypeEquiv.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-tools/m3tk/src/pl/M3LTypeEquiv.m3,v retrieving revision 1.1.1.1 diff -u -r1.1.1.1 M3LTypeEquiv.m3 --- m3-tools/m3tk/src/pl/M3LTypeEquiv.m3 13 Jan 2001 14:47:00 -0000 1.1.1.1 +++ m3-tools/m3tk/src/pl/M3LTypeEquiv.m3 16 Jan 2010 13:38:37 -0000 @@ -223,6 +223,7 @@ (* Add the basic types *) Add(M3CStdTypes.Null()); Add(M3CStdTypes.Integer()); + Add(M3CStdTypes.Longint()); Add(M3CStdTypes.Real()); Add(M3CStdTypes.LongReal()); Add(M3CStdTypes.Extended()); @@ -234,6 +235,7 @@ Add(M3CStdTypes.Char()); Add(M3CStdTypes.Boolean()); Add(M3CStdTypes.Cardinal()); + Add(M3CStdTypes.Longcard()); (* Add the other standard reference types *) Add(M3CStdTypes.Text()); Add(M3CStdTypes.Mutex()); Index: m3-tools/m3tk/src/pl/M3LTypeToText.i3 =================================================================== RCS file: /usr/cvs/cm3/m3-tools/m3tk/src/pl/M3LTypeToText.i3,v retrieving revision 1.2 diff -u -r1.2 M3LTypeToText.i3 --- m3-tools/m3tk/src/pl/M3LTypeToText.i3 16 Mar 2008 22:44:15 -0000 1.2 +++ m3-tools/m3tk/src/pl/M3LTypeToText.i3 16 Jan 2010 13:38:37 -0000 @@ -25,6 +25,7 @@ IntegerCh = 'I'; LongintCh = 'J'; CardinalCh = 'C'; + LongcardCh = 'D'; CharCh = 'H'; WideCharCh = 'W'; BooleanCh = 'B'; Index: m3-tools/m3tk/src/pl/M3LTypeToText.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-tools/m3tk/src/pl/M3LTypeToText.m3,v retrieving revision 1.2 diff -u -r1.2 M3LTypeToText.m3 --- m3-tools/m3tk/src/pl/M3LTypeToText.m3 16 Mar 2008 22:44:15 -0000 1.2 +++ m3-tools/m3tk/src/pl/M3LTypeToText.m3 16 Jan 2010 13:38:37 -0000 @@ -37,7 +37,7 @@ IMPORT M3CBackEnd_C; (* for representation of brands *) VAR - char_g, widechar_g, boolean_g, cardinal_g, text_g: INTEGER; + char_g, widechar_g, boolean_g, cardinal_g, longcard_g, text_g: INTEGER; PROCEDURE Initialize() RAISES {}= BEGIN @@ -49,6 +49,7 @@ widechar_g := M3CStdTypes.WideChar().tmp_type_code; boolean_g := M3CStdTypes.Boolean().tmp_type_code; cardinal_g := M3CStdTypes.Cardinal().tmp_type_code; + longcard_g := M3CStdTypes.Longcard().tmp_type_code; text_g := M3CStdTypes.Text().tmp_type_code; END Initialize; @@ -224,6 +225,8 @@ BEGIN IF sub.tmp_type_code = cardinal_g THEN Wr.PutChar(s, CardinalCh); + ELSIF sub.tmp_type_code = longcard_g THEN + Wr.PutChar(s, LongcardCh); ELSE Wr.PutChar(s, SubrangeCh); ComponentType(s, sub.sm_base_type_spec); @@ -293,7 +296,7 @@ BEGIN Wr.PutChar(s, SetCh); ComponentType(s, set.as_type); - END Set; + END Set; PROCEDURE Brand(s: Wr.T; b: M3AST_AS.Brand_NULL) RAISES {Wr.Failure, Thread.Alerted}= @@ -467,6 +470,8 @@ Wr.PutChar(s, WideCharCh); ELSIF tc = cardinal_g THEN Wr.PutChar(s, CardinalCh); + ELSIF tc = longcard_g THEN + Wr.PutChar(s, LongcardCh); ELSE TypeIndex(s, tc); END; Index: m3-tools/m3tk/src/sem/M3CMkStd.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-tools/m3tk/src/sem/M3CMkStd.m3,v retrieving revision 1.1.1.1 diff -u -r1.1.1.1 M3CMkStd.m3 --- m3-tools/m3tk/src/sem/M3CMkStd.m3 13 Jan 2001 14:47:01 -0000 1.1.1.1 +++ m3-tools/m3tk/src/sem/M3CMkStd.m3 16 Jan 2010 13:38:37 -0000 @@ -114,6 +114,8 @@ M3CStdTypes.RegisterBoolean(concreteDecl.as_type); ELSIF Text.Equal(t, "CARDINAL") THEN M3CStdTypes.RegisterCardinal(concreteDecl.as_type); + ELSIF Text.Equal(t, "LONGCARD") THEN + M3CStdTypes.RegisterLongcard(concreteDecl.as_type); END; | M3AST_AS.Subtype_decl(subtypeDecl) => t := M3CId.ToText(subtypeDecl.as_id.lx_symrep); Index: m3-tools/m3tk/src/sem/M3CStdTypes.i3 =================================================================== RCS file: /usr/cvs/cm3/m3-tools/m3tk/src/sem/M3CStdTypes.i3,v retrieving revision 1.2 diff -u -r1.2 M3CStdTypes.i3 --- m3-tools/m3tk/src/sem/M3CStdTypes.i3 16 Mar 2008 22:44:15 -0000 1.2 +++ m3-tools/m3tk/src/sem/M3CStdTypes.i3 16 Jan 2010 13:38:37 -0000 @@ -65,12 +65,15 @@ PROCEDURE Cardinal(): M3AST_AS.TYPE_SPEC RAISES {}; +PROCEDURE Longcard(): M3AST_AS.TYPE_SPEC RAISES {}; + PROCEDURE Mutex(): M3AST_AS.TYPE_SPEC RAISES {}; PROCEDURE RegisterChar(t: M3AST_AS.TYPE_SPEC) RAISES {}; PROCEDURE RegisterText(t: M3AST_AS.TYPE_SPEC) RAISES {}; PROCEDURE RegisterBoolean(t: M3AST_AS.TYPE_SPEC) RAISES {}; PROCEDURE RegisterCardinal(t: M3AST_AS.TYPE_SPEC) RAISES {}; +PROCEDURE RegisterLongcard(t: M3AST_AS.TYPE_SPEC) RAISES {}; PROCEDURE RegisterMutex(ts: M3AST_AS.TYPE_SPEC) RAISES {}; END M3CStdTypes. Index: m3-tools/m3tk/src/sem/M3CStdTypes.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-tools/m3tk/src/sem/M3CStdTypes.m3,v retrieving revision 1.2 diff -u -r1.2 M3CStdTypes.m3 --- m3-tools/m3tk/src/sem/M3CStdTypes.m3 16 Mar 2008 22:44:15 -0000 1.2 +++ m3-tools/m3tk/src/sem/M3CStdTypes.m3 16 Jan 2010 13:38:37 -0000 @@ -40,6 +40,7 @@ null: M3AST_AS.Null_type; boolean: M3AST_AS.TYPE_SPEC; cardinal: M3AST_AS.TYPE_SPEC; + longcard: M3AST_AS.TYPE_SPEC; refany: M3AST_AS.RefAny_type; address: M3AST_AS.Address_type; root: M3AST_AS.Root_type; @@ -101,6 +102,11 @@ RETURN cardinal; END Cardinal; +PROCEDURE Longcard(): M3AST_AS.TYPE_SPEC RAISES {}= + BEGIN + RETURN longcard; + END Longcard; + PROCEDURE RefAny(): M3AST_AS.RefAny_type RAISES {}= BEGIN RETURN refany; @@ -166,6 +172,11 @@ cardinal := ts; END RegisterCardinal; +PROCEDURE RegisterLongcard(ts: M3AST_AS.TYPE_SPEC) RAISES {}= + BEGIN + longcard := ts; + END RegisterLongcard; + PROCEDURE RegisterMutex(ts: M3AST_AS.TYPE_SPEC) RAISES {}= BEGIN mutex := ts; Index: m3-tools/m3tk/src/sem/M3CTypeChkUtil.i3 =================================================================== RCS file: /usr/cvs/cm3/m3-tools/m3tk/src/sem/M3CTypeChkUtil.i3,v retrieving revision 1.1.1.1 diff -u -r1.1.1.1 M3CTypeChkUtil.i3 --- m3-tools/m3tk/src/sem/M3CTypeChkUtil.i3 13 Jan 2001 14:47:01 -0000 1.1.1.1 +++ m3-tools/m3tk/src/sem/M3CTypeChkUtil.i3 16 Jan 2010 13:38:37 -0000 @@ -28,6 +28,10 @@ type: M3AST_SM.TYPE_SPEC_UNSET) : BOOLEAN RAISES {}; +PROCEDURE IsSubTypeOfLongint( + type: M3AST_SM.TYPE_SPEC_UNSET) + : BOOLEAN + RAISES {}; PROCEDURE IsSubTypeOfBoolean( type: M3AST_SM.TYPE_SPEC_UNSET) : BOOLEAN @@ -36,6 +40,10 @@ type: M3AST_SM.TYPE_SPEC_UNSET) : BOOLEAN RAISES {}; +PROCEDURE IsSubTypeOfLongcard( + type: M3AST_SM.TYPE_SPEC_UNSET) + : BOOLEAN + RAISES {}; PROCEDURE IsSubTypeOfText(type: M3AST_SM.TYPE_SPEC_UNSET): BOOLEAN RAISES {}; PROCEDURE IsSubTypeOfRefany( type: M3AST_SM.TYPE_SPEC_UNSET) Index: m3-tools/m3tk/src/sem/M3CTypeChkUtil.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-tools/m3tk/src/sem/M3CTypeChkUtil.m3,v retrieving revision 1.1.1.1 diff -u -r1.1.1.1 M3CTypeChkUtil.m3 --- m3-tools/m3tk/src/sem/M3CTypeChkUtil.m3 13 Jan 2001 14:47:01 -0000 1.1.1.1 +++ m3-tools/m3tk/src/sem/M3CTypeChkUtil.m3 16 Jan 2010 13:38:37 -0000 @@ -50,6 +50,15 @@ END IsSubTypeOfInteger; +PROCEDURE IsSubTypeOfLongint( + type: M3AST_SM.TYPE_SPEC_UNSET) + : BOOLEAN + RAISES {}= + BEGIN + RETURN M3CTypeRelation.SubType(type, M3CStdTypes.Longint()); + END IsSubTypeOfLongint; + + PROCEDURE IsSubTypeOfBoolean( type: M3AST_SM.TYPE_SPEC_UNSET) : BOOLEAN @@ -68,6 +77,15 @@ END IsSubTypeOfCardinal; +PROCEDURE IsSubTypeOfLongcard( + type: M3AST_SM.TYPE_SPEC_UNSET) + : BOOLEAN + RAISES {}= + BEGIN + RETURN M3CTypeRelation.SubType(type, M3CStdTypes.Longcard()); + END IsSubTypeOfLongcard; + + PROCEDURE IsSubTypeOfText(type: M3AST_SM.TYPE_SPEC_UNSET): BOOLEAN RAISES {}= BEGIN RETURN M3CTypeRelation.SubType(type, M3CStdTypes.Text()); Index: m3-tools/m3tk/src/syn/M3CLex.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-tools/m3tk/src/syn/M3CLex.m3,v retrieving revision 1.1.1.2 diff -u -r1.1.1.2 M3CLex.m3 --- m3-tools/m3tk/src/syn/M3CLex.m3 24 Jan 2001 21:54:29 -0000 1.1.1.2 +++ m3-tools/m3tk/src/syn/M3CLex.m3 16 Jan 2010 13:38:37 -0000 @@ -432,6 +432,8 @@ ok := ReadHexDigits(t, hashValue, buffer, pos); ELSIF ch = '.' THEN result := ReadRealOrRange(t, hashValue, buffer, pos); + ELSIF ch = 'l' OR ch = 'L' THEN + result := M3CToken.LongintLiteral; ELSE Unget(t, ch); END; Index: m3-tools/m3tk/src/syn/M3CParse.m3 =================================================================== RCS file: /usr/cvs/cm3/m3-tools/m3tk/src/syn/M3CParse.m3,v retrieving revision 1.2 diff -u -r1.2 M3CParse.m3 --- m3-tools/m3tk/src/syn/M3CParse.m3 16 Mar 2008 22:44:15 -0000 1.2 +++ m3-tools/m3tk/src/syn/M3CParse.m3 16 Jan 2010 13:38:37 -0000 @@ -1220,6 +1220,8 @@ CASE token OF <*NOWARN*> | M3CToken.IntegerLiteral => RETURN NEW(M3AST_AS.Integer_literal).init(); + | M3CToken.LongintLiteral => + RETURN NEW(M3AST_AS.Longint_literal).init(); | M3CToken.RealLiteral => RETURN NEW(M3AST_AS.Real_literal).init(); | M3CToken.LongRealLiteral => @@ -1237,7 +1239,8 @@ RAISES {Rd.Failure}= CONST NumericLiterals = TokenSet{ - M3CToken.IntegerLiteral, M3CToken.RealLiteral, M3CToken.LongRealLiteral, + M3CToken.IntegerLiteral, M3CToken.LongintLiteral, + M3CToken.RealLiteral, M3CToken.LongRealLiteral, M3CToken.ExtendedLiteral}; VAR token := t.lexer.current(); @@ -1867,7 +1870,7 @@ IF At(t, M3CToken.Range) THEN rangeExp := Range(exp, Expr(t, caseLabelTerm)); ELSE - rangeExp := RangeExp(exp); + rangeExp := RangeExp(exp); END; SeqM3AST_AS_RANGE_EXP.AddRear(case.as_case_label_s, rangeExp); END; Index: m3-tools/m3tk/src/syn/M3CToken.i3 =================================================================== RCS file: /usr/cvs/cm3/m3-tools/m3tk/src/syn/M3CToken.i3,v retrieving revision 1.2 diff -u -r1.2 M3CToken.i3 --- m3-tools/m3tk/src/syn/M3CToken.i3 16 Mar 2008 22:44:15 -0000 1.2 +++ m3-tools/m3tk/src/syn/M3CToken.i3 16 Jan 2010 13:38:37 -0000 @@ -65,7 +65,8 @@ WHILE_, WIDECHAR_, WITH_, Identifier, CharLiteral, WideCharLiteral, TextLiteral, WideTextLiteral, - IntegerLiteral, RealLiteral, LongRealLiteral, ExtendedLiteral, + IntegerLiteral, LongintLiteral, + RealLiteral, LongRealLiteral, ExtendedLiteral, Plus, Minus, Times, Divide, Equal, NotEqual, LessThan, GreaterThan, LessThanOrEqual, GreaterThanOrEqual, Ampersand, Dereference, Dot, @@ -163,6 +164,7 @@ TextLiteral: T = ORD(E.TextLiteral); WideTextLiteral: T = ORD(E.WideTextLiteral); IntegerLiteral: T = ORD(E.IntegerLiteral); + LongintLiteral: T = ORD(E.LongintLiteral); RealLiteral: T = ORD(E.RealLiteral); LongRealLiteral: T = ORD(E.LongRealLiteral); ExtendedLiteral: T = ORD(E.ExtendedLiteral);