New Builtin functions LSH and ROT. ROT is generic for all integer types.

Fix type checking of IsPrivate for ARRAY return types, in CPascalP.cp
New version number 1.3.16.
Factor rotation code generation out of JavaMaker.PushBinary wish separate code for short and long integers.
Fix a missing type value when a long-value expression is used as an array index.
Fix incorrect stack delta value for opc_lshl.
Fix code generation for rotations of longs in MsilMaker. Undefined behavior for shift amounts beyond 63.
New procedure VectorCat in LitValue.
Type-narrowing method ConvertDn for Msil now has extra argument for doing unchecked narrowings.
References to D-Code version in Target.cp have been removed.

gpcp/Builtin.cp

@@ -24,7 +24,7 @@ MODULE Builtin;
       chrP*  =  5; entP*  =  6; lenP*  =  7; longP* =  8; 
       maxP*  =  9; minP*  = 10; oddP*  = 11; ordP*  = 12; 
       shrtP* = 13; sizeP* = 14; mStrP* = 15; tpOfP* = 16;
-      boxP*  = 17; uBytP* = 18; 
+      boxP*  = 17; uBytP* = 18; lshP*  = 19; rotP*  = 20;
 	(* Builtin Proper Procedures				*)
       asrtP* = 21; decP*  = 22; incP*  = 23; inclP* = 24; 
       exclP* = 25; haltP* = 26; newP*  = 27; throwP*= 28;
@@ -95,6 +95,8 @@ MODULE Builtin;
       adrPd-  : Symbols.Idnt;	(* ident descriptor of ADR      *)
       getPd-  : Symbols.Idnt;	(* ident descriptor of GET      *)
       putPd-  : Symbols.Idnt;	(* ident descriptor of PUT      *)
+	  lshPd-  : Symbols.Idnt;	(* ident descriptor of LSH	*)
+      rotPd-  : Symbols.Idnt;	(* ident descriptor of ROT	*)
 	(* Builtin Proper Procedures				*)
       asrtPd- : Symbols.Idnt;	(* ident descriptor of ASSERT	*)
       decPd-  : Symbols.Idnt;	(* ident descriptor of DEC	*)
@@ -387,6 +389,8 @@ MODULE Builtin;
 
     BindName(absPd,  "ABS");
     BindName(ashPd,  "ASH");
+    BindName(lshPd,  "LSH");
+    BindName(rotPd,  "ROT");
     BindName(bitsPd, "BITS");
     BindName(capPd,  "CAP");
     BindName(chrPd,  "CHR");
@@ -460,6 +464,8 @@ MODULE Builtin;
 
     StdFunc(absP,  absPd);
     StdFunc(ashP,  ashPd);
+    StdFunc(lshP,  lshPd);
+    StdFunc(rotP,  rotPd);
     StdFunc(bitsP, bitsPd);
     StdFunc(capP,  capPd);
     StdFunc(chrP,  chrPd);

gpcp/CPascalErrors.cp

@@ -34,9 +34,9 @@ MODULE CPascalErrors;
 
       Err     = POINTER TO ErrDesc;
       ErrDesc = RECORD
-		  num, lin, col: INTEGER;
-		  msg: Message;
-		END;
+                  num, lin, col: INTEGER;
+                  msg: Message;
+                END;
       ErrBuff = POINTER TO ARRAY OF Err;
 
   VAR

gpcp/CPascalP.cp

@@ -371,7 +371,7 @@ VAR
       IF G.verbose THEN G.Message("contains CPmain entry point") END;
       INCL(modScope.xAttr, Sy.cMain); (* Console Main *)
     ELSIF ident.hash = NameHash.winMain THEN
-      modScope.main := TRUE;      (* the import is "CPmain" *)
+      modScope.main := TRUE;      (* the import is "WinMain" *)
       INCL(modScope.xAttr, Sy.wMain); (* Windows Main *)
       IF G.verbose THEN G.Message("contains WinMain entry point") END;
     ELSIF ident.hash = NameHash.staBkt THEN
@@ -2474,7 +2474,11 @@ END;
    (* --------------------------- *)
     PROCEDURE isPrivate(t : Sy.Type) : BOOLEAN;
     BEGIN
-      RETURN ~(t IS Ty.Base) & (t.idnt.vMod = Sy.prvMode);
+      WITH t : Ty.Array DO
+	    RETURN isPrivate(t.elemTp);
+      ELSE 
+        RETURN ~(t IS Ty.Base) & (t.idnt.vMod = Sy.prvMode);
+      END;
     END isPrivate;
    (* --------------------------- *)
     PROCEDURE CheckRetType(tst : BOOLEAN; tok : S.Token; typ : Sy.Type);

gpcp/CompState.cp

@@ -22,10 +22,10 @@ MODULE CompState;
         CPascalS,
         NameHash,
         FileNames,
-		ClassMaker,
+        ClassMaker,
         CPascalErrors;
 
-  CONST	prefix     = "#gpcp: ";
+  CONST prefix     = "#gpcp: ";
         millis     = "mSec";
 
   CONST netV1_0* = 0;
@@ -33,12 +33,12 @@ MODULE CompState;
         netV2_0* = 2;
 
 (* ==================================================================== *)
-(*		     State Variables of this compilation		*)
+(*                State Variables of this compilation                   *)
 (* ==================================================================== *)
 
   VAR
-    ntvObj* : Symbols.Type;     (* native Object type          	*)
-    ntvStr* : Symbols.Type;     (* native String type          	*)
+    ntvObj* : Symbols.Type;     (* native Object type           *)
+    ntvStr* : Symbols.Type;     (* native String type           *)
     ntvExc* : Symbols.Type;     (* native Exceptions type       *)
     ntvTyp* : Symbols.Type;     (* native System.Type type      *)
     ntvEvt* : Symbols.Type;     (* native MulticastDelegate     *)
@@ -68,8 +68,8 @@ MODULE CompState;
     srcNam-,                             (* name of the source file     *)
     lstNam-   : FileNames.NameString;    (* name of the listing file    *)
 
-    target-   : ARRAY 4 OF CHAR;
-	emitter-  : ClassMaker.ClassEmitter;
+    target-   : ARRAY 6 OF CHAR;
+    emitter-  : ClassMaker.ClassEmitter;
 
     cpSymX-,                             (* User supplied CPSYM name    *)
     binDir-,                             (* PE-file directory .NET only *)
@@ -123,27 +123,28 @@ MODULE CompState;
   VAR outNam*  : POINTER TO ARRAY OF CHAR;
 
   VAR
-    expectedNet : BOOLEAN;         (* A .NET specific option was parsed *)
-    expectedJvm : BOOLEAN;         (* A JVM specific option was parsed  *)
+    expectedNet : BOOLEAN;         (* A .NET specific option was parsed  *)
+    expectedJvm : BOOLEAN;         (* A JVM specific option was parsed   *)
+    expectedLlvm : BOOLEAN;        (* An LLVM specific option was parsed *)
 
 (* ==================================================================== *)
-(*				Utilities				*)
+(*                             Utilities                                *)
 (* ==================================================================== *)
 
     PROCEDURE SetSysLib*(lib : IdDesc.BlkId);
-	BEGIN
-	  sysLib := lib;
-	END SetSysLib;
+    BEGIN
+      sysLib := lib;
+    END SetSysLib;
 
     PROCEDURE SetEmitter*(maker : ClassMaker.ClassEmitter);
-	BEGIN
-	  emitter := maker;
-	END SetEmitter;
+    BEGIN
+      emitter := maker;
+    END SetEmitter;
 
-	PROCEDURE ImportObjectFeatures*();
-	BEGIN
-	  emitter.ObjectFeatures();
-	END ImportObjectFeatures;
+    PROCEDURE ImportObjectFeatures*();
+    BEGIN
+      emitter.ObjectFeatures();
+    END ImportObjectFeatures;
 
     PROCEDURE SetQuiet*(); 
     BEGIN
@@ -165,6 +166,11 @@ MODULE CompState;
       RETURN target = "jvm";
     END targetIsJVM;
 
+    PROCEDURE targetIsLLVM*() : BOOLEAN;
+    BEGIN
+      RETURN target = "llvm";
+    END targetIsLLVM;
+
     PROCEDURE Message*(IN mss : ARRAY OF CHAR);
     BEGIN
       Console.WriteString(prefix);
@@ -238,7 +244,7 @@ PrintLn("       /quiet       ==> Compile silently if possible");
 PrintLn("       /strict      ==> Disallow non-standard constructs");
 PrintLn("       /special     ==> Compile dummy symbol file");
 PrintLn("       /symdir=XXX  ==> Place symbol files in directory XXX");
-PrintLn("       /target=XXX  ==> Emit (jvm|net|dcf) assembly");
+PrintLn("       /target=XXX  ==> Emit (jvm|net|llvm) assembly");
 PrintLn("       /unsafe      ==> Allow unsafe code generation");
 PrintLn("       /vX.X        ==> (v1.0 | v1.1 | v2.0) CLR target version");
 PrintLn("       /verbose     ==> Emit verbose diagnostics");
@@ -253,9 +259,9 @@ PrintLn(' Unix-style options: "-option" are recognized also');
         IF RTS.defaultTarget = "jvm" THEN
 PrintLn("       $ cprun gpcp [cp-options] file {file}, OR");
 PrintLn("       $ java [java-options] CP.gpcp.gpcp [cp-options] file {file}");
-        ELSIF RTS.defaultTarget = "dcf" THEN
+        ELSIF RTS.defaultTarget = "llvm" THEN
           PrintLn("       $ gpcp [cp-options] file {file}");
-	END;
+        END;
 PrintLn("# CP Options ...");
 PrintLn("       -clsdir=XXX  ==> Set class tree root in directory XXX");
 PrintLn("       -copyright   ==> Display copyright notice");
@@ -275,7 +281,7 @@ PrintLn("       -quiet       ==> Compile silently if possible");
 PrintLn("       -special     ==> Compile dummy symbol file");
 PrintLn("       -strict      ==> Disallow non-standard constructs");
 PrintLn("       -symdir=XXX  ==> Place symbol files in directory XXX");
-PrintLn("       -target=XXX  ==> Emit (jvm|net|dcf) assembly");
+PrintLn("       -target=XXX  ==> Emit (jvm|net|llvm) assembly");
 PrintLn("       -verbose     ==> Emit verbose diagnostics");
 PrintLn("       -version     ==> Write out version number");
 PrintLn("       -warn-       ==> Don't emit warnings");
@@ -296,7 +302,9 @@ PrintLn("       -DCPSYM=$CPSYM    pass value of CPSYM environment variable to JR
 (* ==================================================================== *)
 
     PROCEDURE ParseOption*(IN opt : ARRAY OF CHAR);
+	  CONST MaxTargetLength = 4;
       VAR copy : ARRAY 16 OF CHAR;
+	      trgt : ARRAY MaxTargetLength + 1 OF CHAR;
           indx : INTEGER;
      (* ----------------------------------------- *)
       PROCEDURE Unknown(IN str : ARRAY OF CHAR);
@@ -341,6 +349,23 @@ PrintLn("       -DCPSYM=$CPSYM    pass value of CPSYM environment variable to JR
           INC(idx); chr := opt[idx];
         END;
       END GetSuffix;
+     (* ----------------------------------------- *)
+	  PROCEDURE RaiseSuffix(preLen : INTEGER;
+	                        outLen : INTEGER;
+	                        IN opt : ARRAY OF CHAR;
+							OUT dir : ARRAY OF CHAR);
+        VAR idx : INTEGER;
+            chr : CHAR;
+      BEGIN
+        idx := 0;
+		REPEAT
+          chr := opt[idx + preLen];
+		  dir[idx] := CAP(chr);
+		  INC(idx);
+		UNTIL (chr = 0X) OR (idx >= outLen) OR ((idx + preLen) > LEN(opt));
+		dir[idx] := 0X;
+      END RaiseSuffix;
+
      (* ----------------------------------------- *)
       PROCEDURE StartsWith(str : ARRAY OF CHAR; IN pat : ARRAY OF CHAR) : BOOLEAN;
       BEGIN
@@ -481,22 +506,24 @@ PrintLn("       -DCPSYM=$CPSYM    pass value of CPSYM environment variable to JR
             Unknown(opt);
           END;
       | "t" :
-          IF (copy = "target=jvm") OR
-             (copy = "target=JVM") THEN
-            IF RTS.defaultTarget = "jvm" THEN
-              Message("JVM is default target for this build");
-            END;
-            target := "jvm";
-          ELSIF (copy = "target=vos") OR
-                (copy = "target=net") OR
-                (copy = "target=NET") THEN
-            IF RTS.defaultTarget = "net" THEN
-              Message("NET is default target for this build");
-            END;
-            target := "net";
-          ELSIF copy = "target=dcf" THEN
-            Message('DCode emitter not yet available, using "target=' +
+          IF StartsWith(copy, "target=") THEN
+            RaiseSuffix(LEN("/target="), MaxTargetLength, opt, trgt);
+            IF trgt = "JVM" THEN
+              IF RTS.defaultTarget = "jvm" THEN
+                Message("JVM is default target for this build");
+              END;
+              target := "jvm";
+            ELSIF (trgt = "NET") OR (trgt = "CLR") THEN
+              IF RTS.defaultTarget = "net" THEN
+                Message("NET is default target for this build");
+              END;
+              target := "net";
+            ELSIF trgt = "LLVM" THEN
+              target := "llvm";
+            ELSE
+              Message('Unknown target, using "target=' +
                                                     RTS.defaultTarget + '"');
+            END;
           ELSE 
             Unknown(opt);
           END;
@@ -566,11 +593,28 @@ PrintLn("       -DCPSYM=$CPSYM    pass value of CPSYM environment variable to JR
           ("WARNING - a JVM-specific option was specified for .NET target");
           expectedJvm := FALSE;
         END;
+        IF expectedLlvm THEN Message
+          ("WARNING - an LLVM-specific option was specified for .NET target");
+          expectedLlvm := FALSE;
+        END;
       ELSIF target = "jvm" THEN
         IF expectedNet THEN Message
           ("WARNING - a .NET-specific option was specified for JVM target");
           expectedNet := FALSE;
         END;
+        IF expectedLlvm THEN Message
+          ("WARNING - an LLVM-specific option was specified for JVM target");
+          expectedLlvm := FALSE;
+        END;
+      ELSIF target = "llvm" THEN
+        IF expectedJvm THEN Message
+          ("WARNING - a JVM-specific option was specified for LLVM target");
+          expectedJvm := FALSE;
+        END;
+        IF expectedNet THEN Message
+          ("WARNING - a .NET-specific option was specified for LLVM target");
+          expectedNet := FALSE;
+        END;
       END;
      (* 
       *  If debug is set, for this version, ILASM is used unless /perwapi is explicit
@@ -663,6 +707,7 @@ PrintLn("       -DCPSYM=$CPSYM    pass value of CPSYM environment variable to JR
     hashSize    := 5000;        (* gets default hash size *)
     expectedNet := FALSE;
     expectedJvm := FALSE;
+    expectedLlvm := FALSE;
     cpSymX      := "CPSYM";
   END InitOptions;
 

gpcp/ExprDesc.cp

@@ -45,7 +45,7 @@ MODULE ExprDesc;
     lessEq* = 45; lessT*  = 46; equal*  = 47; isOp*   = 48; inOp*   = 49;
     mult*   = 50; slash*  = 51; modOp*  = 52; divOp*  = 53; blNot*  = 54;
     blOr*   = 55; blAnd*  = 56; strCat* = 57; ashInt* = 58; rem0op* = 59;
-    div0op* = 60;
+    div0op* = 60; lshInt* = 61; rotInt* = 62;
 
   (* more unaries *)
     adrOf*  = 70; 
@@ -933,6 +933,8 @@ MODULE ExprDesc;
               arg0.ExprError(38);
             END;
           END;
+      (* ---------------------------- *)
+	  (* QUESTION: should this be extended to LONGINT? *)
       (* ---------------------------- *)
       | Builtin.ashP :
           IF    act.tide < 2 THEN prc.ExprError(22);
@@ -955,6 +957,36 @@ MODULE ExprDesc;
             rslt.type := Builtin.intTp;
           END;
       (* ---------------------------- *)
+      | Builtin.lshP :
+          IF    act.tide < 2 THEN prc.ExprError(22);
+          ELSIF act.tide > 2 THEN prc.ExprError(23);
+          ELSE
+            IF ~arg0.isIntExpr() THEN arg0.ExprError(37) END;
+            IF ~arg1.isIntExpr() THEN arg1.ExprError(37) END;
+            IF arg0.type # Builtin.intTp THEN
+              arg0 := convert(arg0, Builtin.intTp);
+            END;
+            IF arg1.type # Builtin.intTp THEN
+              arg1 := convert(arg1, Builtin.intTp);
+            END;
+            rslt := newBinaryX(lshInt, arg0, arg1);
+            rslt.type := Builtin.intTp;
+          END;
+      (* ---------------------------- *)
+      | Builtin.rotP :
+          IF    act.tide < 2 THEN prc.ExprError(22);
+          ELSIF act.tide > 2 THEN prc.ExprError(23);
+          ELSE
+            IF ~arg0.isIntExpr() THEN arg0.ExprError(37) END;
+            IF ~arg1.isIntExpr() THEN arg1.ExprError(37) END;
+			(* Do not convert arg0 to intTp *)
+            IF arg1.type # Builtin.intTp THEN
+              arg1 := convert(arg1, Builtin.intTp);
+            END;
+            rslt := newBinaryX(rotInt, arg0, arg1);
+            rslt.type := arg0.type;
+          END;
+      (* ---------------------------- *)
       | Builtin.bitsP :
           IF    act.tide < 1 THEN prc.ExprError(22);
           ELSIF act.tide > 1 THEN prc.ExprError(23);
@@ -1951,6 +1983,7 @@ MODULE ExprDesc;
     *  perhaps as a result of a call of checkCall()
     *)
     IF (kind = index) OR (kind = ashInt) OR
+       (kind = lshInt) OR (kind = rotInt) OR 
        (kind = lenOf) OR (kind = minOf) OR (kind = maxOf) THEN RETURN i END;
    (*
     *  First, attribute the subtrees.
@@ -3093,6 +3126,8 @@ MODULE ExprDesc;
     | blAnd  : Console.WriteString("'&'    ");
     | strCat : Console.WriteString("strCat ");
     | ashInt : Console.WriteString("ASH    ");
+    | lshInt : Console.WriteString("LSH    ");
+    | rotInt : Console.WriteString("ROT    ");
     END;
     PType(s.type);
     Console.WriteLn;

gpcp/GPCPcopyright.cp

@@ -46,13 +46,20 @@ MODULE GPCPcopyright;
      (* VERSION    = "1.3.12 of 17 November 2011"; *)
      (* VERSION    = "1.3.13 of 24 July 2012"; *)
      (* VERSION    = "1.3.14 of 05 September 2012"; *)
-        VERSION    = "1.3.15 of 04 October 2012"; 
+     (* VERSION    = "1.3.15 of 04 October 2012"; *)
+        VERSION    = "1.3.16 of 01 January 2013"; 
 	verStr*    = " version " + VERSION;
 
   CONST	prefix     = "#gpcp: ";
 	millis     = "mSec";
 
 (* ==================================================================== *)
+
+  PROCEDURE V*() : POINTER TO ARRAY OF CHAR;
+  BEGIN 
+    RETURN BOX(VERSION) 
+  END V; 
+
   PROCEDURE W(IN s : ARRAY OF CHAR);
   BEGIN Console.WriteString(s); Console.WriteLn END W;
 
@@ -61,8 +68,8 @@ MODULE GPCPcopyright;
     W("GARDENS POINT COMPONENT PASCAL");
     W("The files which import this module constitute a compiler");
     W("for the programming language Component Pascal.");
-    W("Copyright (c) 1998 -- 2012 K John Gough.");
-    W("Copyright (c) 2000 -- 2012 Queensland University of Technology.");
+    W("Copyright (c) 1998 -- 2013 K John Gough.");
+    W("Copyright (c) 2000 -- 2013 Queensland University of Technology.");
     Console.WriteLn;
 
     W("This program is free software; you can redistribute it and/or modify");

gpcp/JVMcodes.cp

@@ -645,7 +645,7 @@ BEGIN
 	dl[opc_fneg]		:= 0;
 	dl[opc_dneg]		:= 0;
 	dl[opc_ishl]		:= -1;
-	dl[opc_lshl]		:= -2;
+	dl[opc_lshl]		:= -1;
 	dl[opc_ishr]		:= -1;
 	dl[opc_lshr]		:= -1;
 	dl[opc_iushr]		:= -1;

gpcp/JavaMaker.cp

@@ -1162,12 +1162,12 @@ MODULE JavaMaker;
     e.PushValue(lOp, eTp);              (* vRef ...                *)
     out.Code(Jvm.opc_dup);              (* vRef, vRef ...          *)
     out.GetVecLen();                    (* tide, vRef ...          *)
-    out.StoreLocal(tde, Bi.intTp);       (* vRef ...                *)
+    out.StoreLocal(tde, Bi.intTp);      (* vRef ...                *)
 
     e.outF.GetVecArr(eTp);              (* arr ...                 *)
-    e.PushValue(rOp, Bi.intTp);          (* idx, arr ...            *)
+    e.PushValue(rOp, Bi.intTp);         (* idx, arr ...            *)
     out.Code(Jvm.opc_dup);              (* idx, idx, arr ...       *)
-    out.LoadLocal(tde, Bi.intTp);        (* tide, idx, idx, arr ... *)
+    out.LoadLocal(tde, Bi.intTp);       (* tide, idx, idx, arr ... *)
 
     out.CodeLb(Jvm.opc_if_icmplt, xLb);
     out.Trap("Vector index out of bounds");
@@ -1176,14 +1176,125 @@ MODULE JavaMaker;
     out.ReleaseLocal(tde);
   END PushVecElemHandle;
 
+(* ============================================================ *)
+
+  (* Assert: lOp is already pushed. *)
+  PROCEDURE RotateInt(e : JavaEmitter; lOp : Sy.Expr; rOp : Sy.Expr);
+    VAR
+      temp, ixSv : INTEGER; (* local vars    *)
+	  indx : INTEGER;       (* literal index *)
+	  rtSz : INTEGER;
+	  out  : Ju.JavaFile;
+  BEGIN
+    out := e.outF;
+    IF lOp.type = Bi.sIntTp THEN 
+      rtSz := 16;
+	  out.ConvertDn(Bi.intTp, Bi.charTp);
+	ELSIF (lOp.type = Bi.byteTp) OR (lOp.type = Bi.uBytTp) THEN
+	  rtSz := 8;
+	  out.ConvertDn(Bi.intTp, Bi.uBytTp);
+	ELSE
+	  rtSz := 32;
+	END;
+	temp := out.newLocal();          
+    IF rOp.kind = Xp.numLt THEN
+          indx := intValue(rOp) MOD rtSz;
+      IF indx = 0 THEN  (* skip *)
+	  ELSE (* 
+	    *  Rotation is achieved by means of the identity
+	    *  Forall 0 <= n < rtSz: 
+	    *    ROT(a, n) = LSH(a,n) bitwiseOR LSH(a,n-rtSz);
+	    *)
+	    out.Code(Jvm.opc_dup);
+		out.StoreLocal(temp, Bi.intTp);
+		out.PushInt(indx);
+		out.Code(Jvm.opc_ishl);
+		out.LoadLocal(temp, Bi.intTp);
+		out.PushInt(rtSz - indx);
+		out.Code(Jvm.opc_iushr);
+		out.Code(Jvm.opc_ior);
+		out.ConvertDn(Bi.intTp, lOp.type);
+      END;
+    ELSE
+	  ixSv := out.newLocal();          
+	  out.Code(Jvm.opc_dup);          (* TOS: lOp, lOp, ...             *)
+	  out.StoreLocal(temp, Bi.intTp); (* TOS: lOp, ...                  *)
+      e.PushValue(rOp, rOp.type);     (* TOS: rOp, lOp, ...             *)
+	  out.PushInt(rtSz-1);            (* TOS: 31, rOp, lOp, ...         *)
+	  out.Code(Jvm.opc_iand);         (* TOS: rOp', lOp, ...            *)
+	  out.Code(Jvm.opc_dup);          (* TOS: rOp', rOp', lOp, ...      *)
+	  out.StoreLocal(ixSv, Bi.intTp); (* TOS: rOp', lOp, ...            *)
+	  out.Code(Jvm.opc_ishl);         (* TOS: lRz, ...                  *)
+	  out.LoadLocal(temp, Bi.intTp);  (* TOS: lOp, lRz, ...             *)
+	  out.PushInt(rtSz);              (* TOS: 32, lOp, lRz, ...         *)
+	  out.LoadLocal(ixSv, Bi.intTp);  (* TOS: rOp',32, lOp, lRz, ...    *)
+	  out.Code(Jvm.opc_isub);         (* TOS: rOp'', lOp, lRz, ...      *)
+	  out.Code(Jvm.opc_iushr);        (* TOS: rRz, lRz, ...             *)
+	  out.Code(Jvm.opc_ior);          (* TOS: ROT(lOp, rOp), ...        *)
+	  out.ReleaseLocal(ixSv);
+	  out.ConvertDn(Bi.intTp, lOp.type);
+	END;
+	out.ReleaseLocal(temp);
+  END RotateInt;
+
+(* ============================================================ *)
+
+  (* Assert: lOp is already pushed. *)
+  PROCEDURE RotateLong(e : JavaEmitter; lOp : Sy.Expr; rOp : Sy.Expr);
+    VAR
+	  tmp1,tmp2, ixSv : INTEGER; (* local vars    *)
+	  indx : INTEGER;            (* literal index *)
+	  out  : Ju.JavaFile;
+  BEGIN
+    out := e.outF;
+	tmp1 := out.newLocal();      (* Pair of locals *)     
+	tmp2 := out.newLocal();          
+    IF rOp.kind = Xp.numLt THEN
+      indx := intValue(rOp) MOD 64;
+      IF indx = 0 THEN  (* skip *)
+	  ELSE (* 
+		*  Rotation is achieved by means of the identity
+		*  Forall 0 <= n < rtSz: 
+		*    ROT(a, n) = LSH(a,n) bitwiseOR LSH(a,n-rtSz);
+		*)
+		out.Code(Jvm.opc_dup2);
+		out.StoreLocal(tmp1, Bi.lIntTp);
+		out.PushInt(indx);
+		out.Code(Jvm.opc_lshl);
+		out.LoadLocal(tmp1, Bi.lIntTp);
+		out.PushInt(64 - indx);
+		out.Code(Jvm.opc_lushr);
+		out.Code(Jvm.opc_lor);
+      END;
+    ELSE
+	  ixSv := out.newLocal();          
+	  out.Code(Jvm.opc_dup2);            (* TOS: lOp, lOp, ...             *)
+	  out.StoreLocal(tmp1, Bi.lIntTp);   (* TOS: lOp, ...                  *)
+      e.PushValue(rOp, rOp.type);        (* TOS: rOp, lOp, ...             *)
+	  out.PushInt(63);                   (* TOS: 31, rOp, lOp, ...         *)
+	  out.Code(Jvm.opc_iand);            (* TOS: rOp', lOp, ...            *)
+	  out.Code(Jvm.opc_dup);             (* TOS: rOp', rOp', lOp, ...      *)
+	  out.StoreLocal(ixSv, Bi.intTp);    (* TOS: rOp', lOp, ...            *)
+	  out.Code(Jvm.opc_lshl);            (* TOS: lRz, ...                  *)
+	  out.LoadLocal(tmp1, Bi.lIntTp);    (* TOS: lOp, lRz, ...             *)
+	  out.PushInt(64);                   (* TOS: 32, lOp, lRz, ...         *)
+	  out.LoadLocal(ixSv, Bi.intTp);     (* TOS: rOp',32, lOp, lRz, ...    *)
+	  out.Code(Jvm.opc_isub);            (* TOS: rOp'', lOp, lRz, ...      *)
+	  out.Code(Jvm.opc_lushr);           (* TOS: rRz, lRz, ...             *)
+	  out.Code(Jvm.opc_lor);             (* TOS: ROT(lOp, rOp), ...        *)
+	  out.ReleaseLocal(ixSv);
+	END;
+	out.ReleaseLocal(tmp2);
+	out.ReleaseLocal(tmp1);
+  END RotateLong;
+
 (* ============================================================ *)
 
   PROCEDURE (e : JavaEmitter)PushBinary(exp : Xp.BinaryX; dst : Sy.Type),NEW;
     VAR out  : Ju.JavaFile;
         lOp  : Sy.Expr;
         rOp  : Sy.Expr;
-        eTp  : Sy.Type;
-
+ 
         dNum : INTEGER;
         sNum : INTEGER;
         code : INTEGER;
@@ -1241,6 +1352,7 @@ MODULE JavaMaker;
  *        out.GetVecElement(vTp.elemTp);          (* load the element   *)
  *)
         ELSE
+		  IF rOp.type = NIL THEN rOp.type := Bi.intTp END;
           e.PushValue(lOp, lOp.type);             (* push arr. desig.   *)
           e.PushValue(rOp, rOp.type);             (* push index value   *)
 (*
@@ -1531,7 +1643,16 @@ MODULE JavaMaker;
         e.PushValue(lOp, lOp.type);
         out.CodeT(Jvm.opc_instanceof, rOp(Xp.IdLeaf).ident.type);
     (* -------------------------------- *)
-    | Xp.ashInt :
+    | Xp.rotInt :
+        e.PushValue(lOp, lOp.type);
+		IF lOp.type = Bi.lIntTp THEN
+		  RotateLong(e, lOp, rOp);
+		ELSE
+		  RotateInt(e, lOp, rOp);
+		END;
+    (* -------------------------------- *)
+    | Xp.ashInt, Xp.lshInt :
+(* FIXME: What about long types (here but not for .NET???) *)
         e.PushValue(lOp, lOp.type);
         IF rOp.kind = Xp.numLt THEN
           indx := intValue(rOp);
@@ -1542,8 +1663,12 @@ MODULE JavaMaker;
             *  A literal, negative ASH might be
             *  a long operation from a folded DIV.
             *)
-            IF dst.isLongType() THEN out.Code(Jvm.opc_lshr);
-            ELSE out.Code(Jvm.opc_ishr);
+            IF dst.isLongType() THEN 
+			  out.Code(Jvm.opc_lshr);
+            ELSIF exp.kind = Xp.ashInt THEN
+			  out.Code(Jvm.opc_ishr);
+            ELSE
+			  out.Code(Jvm.opc_iushr);
             END;
           ELSE
             out.PushInt(indx);
@@ -1569,7 +1694,11 @@ MODULE JavaMaker;
           *)
           out.DefLab(tpLb);
           out.Code(Jvm.opc_ineg);
-          out.Code(Jvm.opc_ishr);
+		  IF exp.kind = Xp.ashInt THEN
+            out.Code(Jvm.opc_ishr);
+		  ELSE
+            out.Code(Jvm.opc_iushr);
+		  END;
           out.DefLab(exLb);
         END;
     (* -------------------------------- *)

gpcp/LitValue.cp

@@ -217,7 +217,9 @@ MODULE LitValue;
 (* -------------------------------------------- *)
 
   PROCEDURE ResetCharOpenSeq*(VAR seq : CharOpenSeq);
+    VAR index : INTEGER;
   BEGIN
+    FOR index := 0 TO seq.tide - 1 DO seq.a[index] := NIL END;
     seq.tide := 0;
   END ResetCharOpenSeq;
 
@@ -366,6 +368,32 @@ MODULE LitValue;
     RETURN ret;
   END arrayCat;
 
+(* -------------------------------------------- *)
+
+  PROCEDURE vectorCat*(vec : VECTOR OF CharOpen) : CharOpen;
+    VAR i,j,k : INTEGER;
+	len : INTEGER;
+	chO : CharOpen;
+	ret : CharOpen;
+	chr : CHAR;
+  BEGIN
+    len := 1;
+    FOR i := 0 TO LEN(vec) - 1 DO INC(len, LEN(vec[i]) - 1) END;
+    NEW(ret, len);
+    k := 0;
+    FOR i := 0 TO LEN(vec) - 1 DO 
+      chO := vec[i];
+      j := 0;
+      WHILE (j < LEN(chO)-1) & (chO[j] # 0X) DO 
+        ret[k] := chO[j]; INC(k); INC(j);
+      END;
+    END;
+    ret[k] := 0X;
+    RETURN ret;
+  END vectorCat;
+
+
+
 (* ============================================================ *)
 (* 		     Safe Operations on Values			*)
 (* ============================================================ *)

gpcp/MsilMaker.cp

@@ -1430,6 +1430,9 @@ MODULE MsilMaker;
         tpLb : Mu.Label;
         rpTp : Sy.Type;
         elTp : Sy.Type;
+		rtSz : INTEGER;
+		ixSv : INTEGER;
+		hstT : Sy.Type;
   BEGIN
     out := e.outF;
     lOp := exp.lKid;
@@ -1454,7 +1457,7 @@ MODULE MsilMaker;
           ELSIF rpTp = Bi.anyPtr THEN
             out.CodeT(Asm.opc_castclass, dst);
           ELSE
-            out.ConvertDn(rpTp, dst);
+            out.ConvertDn(rpTp, dst, out.proc.prId.ovfChk);
           END;
         END;
        (*
@@ -1717,18 +1720,21 @@ MODULE MsilMaker;
         out.Code(Asm.opc_ldnull);
         out.Code(Asm.opc_cgt_un);
     (* -------------------------------- *)
-    | Xp.ashInt :
+    | Xp.ashInt, Xp.lshInt:
         e.PushValue(lOp, lOp.type);
         IF rOp.kind = Xp.numLt THEN
           indx := intValue(rOp);
           IF indx = 0 THEN (* skip *)
-          ELSIF indx < 0 THEN
-            out.PushInt(-indx);
-            out.Code(Asm.opc_shr);
-          ELSE
+		  ELSIF indx > 0 THEN
             out.PushInt(indx);
             out.Code(Asm.opc_shl);
-          END;
+          ELSIF exp.kind = Xp.ashInt THEN
+            out.PushInt(-indx);
+            out.Code(Asm.opc_shr);
+		  ELSE (* ==> exp.kind = lshInt *)
+            out.PushInt(-indx);
+            out.Code(Asm.opc_shr_un);
+		  END;
         ELSE
           tpLb := out.newLabel();
           exLb := out.newLabel();
@@ -1750,10 +1756,86 @@ MODULE MsilMaker;
           *)
           out.DefLab(tpLb);
           out.Code(Asm.opc_neg);
-          out.Code(Asm.opc_shr);
+		  IF exp.kind = Xp.ashInt THEN
+            out.Code(Asm.opc_shr);
+		  ELSE (* ==> exp.kind = lshInt *)
+            out.Code(Asm.opc_shr_un);
+		  END;
           out.DefLab(exLb);
         END;
     (* -------------------------------- *)
+    | Xp.rotInt:
+        e.PushValue(lOp, lOp.type);
+	   (* Convert TOS value to unsigned *)
+	    hstT := Bi.intTp;
+		IF (lOp.type = Bi.sIntTp) THEN 
+		  rtSz := 16;
+		  out.Code(Asm.opc_conv_u2);
+		ELSIF (lOp.type = Bi.byteTp) OR (lOp.type = Bi.uBytTp) THEN
+		  rtSz := 8;
+		  out.Code(Asm.opc_conv_u1);
+		ELSIF lOp.type = Bi.lIntTp THEN
+		  rtSz := 64;
+		  hstT := Bi.lIntTp;
+		ELSE
+		  rtSz := 32;
+		  (* out.Code(Asm.opc_conv_u4); *)
+		END;
+		
+        IF rOp.kind = Xp.numLt THEN
+		  indx := intValue(rOp) MOD rtSz;
+          IF indx = 0 THEN  (* skip *)
+		  ELSE (* 
+		    *  Rotation is achieved by means of the identity
+			*  Forall 0 <= n < rtSz: 
+			*    ROT(a, n) = LSH(a,n) bitwiseOR LSH(a,n-rtSz);
+			*)
+			temp := out.proc.newLocal(hstT);
+			out.Code(Asm.opc_dup);
+			out.PushInt(indx);
+			out.Code(Asm.opc_shl);
+			out.StoreLocal(temp);
+			out.PushInt(rtSz - indx);
+			out.Code(Asm.opc_shr_un);
+			out.PushLocal(temp);
+			out.Code(Asm.opc_or);
+			out.proc.ReleaseLocal(temp);
+          END;
+		  out.ConvertDn(hstT, lOp.type, FALSE);
+		ELSE
+         (*
+          *  This is a variable rotate.
+		  *
+		  *  Note that in the case of a short left operand the value
+		  *  on the stack has been converted to unsigned.  The value is
+		  *  saved as a int (rather than a shorter type) so that the 
+		  *  value does not get sign extended on each new load, 
+		  *  necessitating a new conversion each time.
+          *)
+		  temp := out.proc.newLocal(hstT);
+		  ixSv := out.proc.newLocal(Bi.intTp);
+		  out.Code(Asm.opc_dup);         (* TOS: lOp, lOp, ...               *)
+		  out.StoreLocal(temp);          (* TOS: lOp, ...                    *)
+          e.PushValue(rOp, rOp.type);    (* TOS: rOp, lOp, ...               *)
+		  out.PushInt(rtSz-1);           (* TOS: 31, rOp, lOp, ...           *)
+          out.Code(Asm.opc_and);         (* TOS: rOp', lOp, ...              *)
+		  out.Code(Asm.opc_dup);         (* TOS: rOp', rOp', lOp, ...        *)
+		  out.StoreLocal(ixSv);          (* TOS: rOp', lOp, ...              *)
+		  out.Code(Asm.opc_shl);         (* TOS: lRz, ...    (left fragment) *)
+		  out.PushLocal(temp);           (* TOS: lOp, lRz, ...               *)
+		  out.PushInt(rtSz);             (* TOS: 32, lOp, lRz, ...           *)
+		  out.PushLocal(ixSv);           (* TOS: rOp', 32, lOp, lRz, ...     *)
+		  out.Code(Asm.opc_sub);         (* TOS: rOp'', lOp, lRz, ...        *)
+	     (* mask the shift amount in case idx = 0 *)
+		  out.PushInt(rtSz-1);           (* TOS: 31, rOp, lOp, ...           *)
+          out.Code(Asm.opc_and);         (* TOS: rOp', lOp, ...              *)
+		  out.Code(Asm.opc_shr_un);      (* TOS: rRz, lRz, ...               *)
+		  out.Code(Asm.opc_or);          (* TOS: ROT(lOp,rOp), ...           *)
+		  out.proc.ReleaseLocal(ixSv);
+		  out.proc.ReleaseLocal(temp);
+		  out.ConvertDn(hstT, lOp.type, FALSE);
+        END;
+    (* -------------------------------- *)
     | Xp.strCat :
         e.PushValue(lOp, lOp.type);
         e.PushValue(rOp, rOp.type);
@@ -1881,7 +1963,7 @@ MODULE MsilMaker;
           IF exp.kind = Xp.cvrtUp THEN
             out.ConvertUp(exp.kid.type, typ);
           ELSIF exp.kind = Xp.cvrtDn THEN
-            out.ConvertDn(exp.kid.type, typ);
+            out.ConvertDn(exp.kid.type, typ, out.proc.prId.ovfChk);
           END;
         END;
     | exp : Xp.UnaryX DO

gpcp/MsilUtil.cp

@@ -2362,7 +2362,7 @@ MODULE MsilUtil;
 
 (* ------------------------------------------------------------ *)
 
-  PROCEDURE (os : MsilFile)ConvertDn*(inT, outT : Sy.Type),NEW;
+  PROCEDURE (os : MsilFile)ConvertDn*(inT, outT : Sy.Type; check : BOOLEAN),NEW;
    (* Conversion "down" often needs a runtime check. *)
     VAR inB, outB, code : INTEGER;
   BEGIN
@@ -2370,7 +2370,8 @@ MODULE MsilUtil;
     outB := outT(Ty.Base).tpOrd;
     IF inB = Ty.setN THEN inB := Ty.intN END;
     IF inB = outB THEN RETURN END;                     (* PREMATURE RETURN! *)
-    IF os.proc.prId.ovfChk THEN
+    (* IF os.proc.prId.ovfChk THEN *)
+	IF check THEN
       CASE outB OF
       | Ty.realN : RETURN;                             (* PREMATURE RETURN! *)
       | Ty.sReaN : code := Asm.opc_conv_r4; (* No check possible *)

gpcp/Target.cp

@@ -12,7 +12,7 @@ MODULE Target;
 	ClassMaker,
 	JavaMaker,
 (*
- *	DCodeMaker,
+ *	LlvmMaker,
  *)
 	MsilMaker,
 	IdDesc;
@@ -37,15 +37,17 @@ MODULE Target;
       assmb := MsilMaker.newMsilAsm();
       Symbols.SetTargetIsNET(TRUE);
 (*
- *  ELSIF str = "dcf" THEN
- *    maker := DCodeMaker.newDCodeEmitter(mod);		(* write DCode	*)
- *    assmb := DCodeMaker.newDCodeAsm();		(* call dgen	*)
+ *   (* LLVM backend coming in 2013? *)
+ *  ELSIF str = "llvm" THEN 
+ *    maker := LlvmMaker.newBitCodeEmitter(mod);
+ *    assmb := LlvmMaker.newBitCodeAssembler();
+ *    Symbols.SetTargetIsNET(FALSE);
  *  ELSIF ...
  *)
     ELSE
       CompState.Message("Unknown emitter name <" + str + ">");
     END;
-	CompState.SetEmitter(maker);
+    CompState.SetEmitter(maker);
   END Select;
 
 (* ============================================================ *)