Implement new PICO-8 0.2.0d operators <<> <<>= >>< and >><=.

Author: samhocevar

lcode.c

@@ -815,7 +815,7 @@ void luaK_infix (FuncState *fs, BinOpr op, expdesc *v) {
     case OPR_ADD: case OPR_SUB: case OPR_MUL: case OPR_DIV:
     case OPR_MOD: case OPR_POW: case OPR_IDIV: case OPR_BAND:
     case OPR_BOR: case OPR_BXOR: case OPR_SHL: case OPR_SHR:
-    case OPR_LSHR: {
+    case OPR_LSHR: case OPR_ROTL: case OPR_ROTR: {
       if (!isnumeral(v)) luaK_exp2RK(fs, v);
       break;
     }
@@ -861,7 +861,7 @@ void luaK_posfix (FuncState *fs, BinOpr op,
     case OPR_ADD: case OPR_SUB: case OPR_MUL: case OPR_DIV:
     case OPR_MOD: case OPR_POW: case OPR_IDIV: case OPR_BAND:
     case OPR_BOR: case OPR_BXOR: case OPR_SHL: case OPR_SHR:
-    case OPR_LSHR: {
+    case OPR_LSHR: case OPR_ROTL: case OPR_ROTR: {
       codearith(fs, cast(OpCode, op - OPR_ADD + OP_ADD), e1, e2, line);
       break;
     }

lcode.h

@@ -24,8 +24,9 @@
 ** grep "ORDER OPR" if you change these enums  (ORDER OP)
 */
 typedef enum BinOpr {
-  OPR_ADD, OPR_SUB, OPR_MUL, OPR_DIV, OPR_MOD, OPR_POW, OPR_IDIV,
-  OPR_BAND, OPR_BOR, OPR_BXOR, OPR_SHL, OPR_SHR, OPR_LSHR,
+  OPR_ADD, OPR_SUB, OPR_MUL, OPR_DIV, OPR_MOD, OPR_POW,
+  OPR_IDIV, OPR_BAND, OPR_BOR, OPR_BXOR, OPR_SHL, OPR_SHR,
+  OPR_LSHR, OPR_ROTL, OPR_ROTR,
   OPR_CONCAT,
   OPR_EQ, OPR_LT, OPR_LE,
   OPR_NE, OPR_GT, OPR_GE,

ldebug.c

@@ -492,6 +492,8 @@ static const char *getfuncname (lua_State *L, CallInfo *ci, const char **name) {
     case OP_SHL: tm = TM_SHL; break;
     case OP_SHR: tm = TM_SHR; break;
     case OP_LSHR: tm = TM_LSHR; break;
+    case OP_ROTL: tm = TM_ROTL; break;
+    case OP_ROTR: tm = TM_ROTR; break;
     case OP_UNM: tm = TM_UNM; break;
     case OP_BNOT: tm = TM_BNOT; break;
     case OP_LEN: tm = TM_LEN; break;

llex.c

@@ -40,9 +40,9 @@ static const char *const luaX_tokens [] = {
     "return", "then", "true", "until", "while",
     "..", "...", "==", ">=", "<=", "~=", "!=", "::",
     "<eof>", "<number>", "<name>", "<string>", "?",
-    "<eol>", "@@", "^^", "<<", ">>", ">>>",
-    "+=", "-=", "*=", "/=", "%=", "^=", "\\=",
-    "&=", "|=", "^^=", "<<=", ">>=", ">>>=", "..=",
+    "<eol>", "@@", "^^", "<<", ">>", ">>>", "<<>", ">><",
+    "+=", "-=", "*=", "/=", "%=", "^=", "\\=", "&=", "|=",
+    "^^=", "<<=", ">>=", ">>>=", "<<>=", ">><=", "..=",
 };
 
 
@@ -495,13 +495,16 @@ static int llex (LexState *ls, SemInfo *seminfo) {
         if (ls->current != '=') return '=';
         else { next(ls); return TK_EQ; }
       }
-      case '<': {  /* '<=' or '<' or '<<=' or '<<' */
+      case '<': {  /* '<=' or '<' or '<<=' or '<<' or '<<>=' or '<<>' */
         next(ls);
         if (ls->current == '=') { next(ls); return TK_LE; }
         else if (ls->current != '<') return '<';
         next(ls);
         if (ls->current == '=') { next(ls); return TK_SHLE; }
-        else return TK_SHL;
+        else if (ls->current != '>') return TK_SHL;
+        next(ls);
+        if (ls->current == '=') { next(ls); return TK_ROTLE; }
+        else return TK_ROTL;
       }
       case '^': {  /* '^=' or '^' or '^^' or '^^=' */
         next(ls);
@@ -511,12 +514,17 @@ static int llex (LexState *ls, SemInfo *seminfo) {
         if (ls->current == '=') { next(ls); return TK_BXORE; }
         else return TK_BXOR;
       }
-      case '>': {  /* '>=' or '>' or '>>=' or '>>' or '>>>=' or '>>>' */
+      case '>': {  /* '>=', '>', '>>=', '>><=', >><', '>>', '>>>=', or '>>>' */
         next(ls);
         if (ls->current == '=') { next(ls); return TK_GE; }
         else if (ls->current != '>') return '>';
         next(ls);
         if (ls->current == '=') { next(ls); return TK_SHRE; }
+        else if (ls->current == '<') {
+          next(ls);
+          if (ls->current == '=') { next(ls); return TK_ROTRE; }
+          else return TK_ROTR;
+        }
         else if (ls->current != '>') return TK_SHR;
         next(ls);
         if (ls->current == '=') { next(ls); return TK_LSHRE; }

llex.h

@@ -28,10 +28,11 @@ enum RESERVED {
   /* other terminal symbols */
   TK_CONCAT, TK_DOTS, TK_EQ, TK_GE, TK_LE, TK_NE, TK_NE2, TK_DBCOLON,
   TK_EOS, TK_NUMBER, TK_NAME, TK_STRING, TK_PRINT, TK_EOL, TK_DBAT,
-  TK_BXOR, TK_SHL, TK_SHR, TK_LSHR,
+  TK_BXOR, TK_SHL, TK_SHR, TK_LSHR, TK_ROTL, TK_ROTR,
   /* these must be last and match "ORDER OPR" */
   TK_ADDE, TK_SUBE, TK_MULE, TK_DIVE, TK_MODE, TK_POWE, TK_IDIVE,
-  TK_BANDE, TK_BORE, TK_BXORE, TK_SHLE, TK_SHRE, TK_LSHRE, TK_CONCATE,
+  TK_BANDE, TK_BORE, TK_BXORE, TK_SHLE, TK_SHRE, TK_LSHRE, TK_ROTLE,
+  TK_ROTRE, TK_CONCATE,
 };
 
 /* number of reserved words */

lobject.c

@@ -85,6 +85,8 @@ lua_Number luaO_arith (int op, lua_Number v1, lua_Number v2) {
     case LUA_OPSHL:  return luai_numshl(NULL, v1, v2);
     case LUA_OPSHR:  return luai_numshr(NULL, v1, v2);
     case LUA_OPLSHR: return luai_numlshr(NULL, v1, v2);
+    case LUA_OPROTL: return luai_numrotl(NULL, v1, v2);
+    case LUA_OPROTR: return luai_numrotr(NULL, v1, v2);
     case LUA_OPUNM:  return luai_numunm(NULL, v1);
     case LUA_OPBNOT: return luai_numbnot(NULL, v1);
     default: lua_assert(0); return 0;

lopcodes.c

@@ -41,6 +41,8 @@ LUAI_DDEF const char *const luaP_opnames[NUM_OPCODES+1] = {
   "SHL",
   "SHR",
   "LSHR",
+  "ROTL",
+  "ROTR",
   "UNM",
   "BNOT",
   "NOT",
@@ -100,6 +102,8 @@ LUAI_DDEF const lu_byte luaP_opmodes[NUM_OPCODES] = {
  ,opmode(0, 1, OpArgK, OpArgK, iABC)		/* OP_SHL */
  ,opmode(0, 1, OpArgK, OpArgK, iABC)		/* OP_SHR */
  ,opmode(0, 1, OpArgK, OpArgK, iABC)		/* OP_LSHR */
+ ,opmode(0, 1, OpArgK, OpArgK, iABC)		/* OP_ROTL */
+ ,opmode(0, 1, OpArgK, OpArgK, iABC)		/* OP_ROTR */
  ,opmode(0, 1, OpArgR, OpArgN, iABC)		/* OP_UNM */
  ,opmode(0, 1, OpArgR, OpArgN, iABC)		/* OP_BNOT */
  ,opmode(0, 1, OpArgR, OpArgN, iABC)		/* OP_NOT */

lopcodes.h

@@ -197,6 +197,8 @@ OP_BXOR,/*	A B C	R(A) := RK(B) ^^ RK(C)				*/
 OP_SHL,/*	A B C	R(A) := RK(B) << RK(C)				*/
 OP_SHR,/*	A B C	R(A) := RK(B) >> RK(C)				*/
 OP_LSHR,/*	A B C	R(A) := RK(B) >>> RK(C)				*/
+OP_ROTL,/*	A B C	R(A) := RK(B) <<> RK(C)				*/
+OP_ROTR,/*	A B C	R(A) := RK(B) >>< RK(C)				*/
 
 OP_UNM,/*	A B	R(A) := -R(B)					*/
 OP_BNOT,/*	A B	R(A) := ~R(B)					*/

lparser.c

@@ -1014,6 +1014,8 @@ static BinOpr getbinopr (int op) {
     case TK_SHL: return OPR_SHL;
     case TK_SHR: return OPR_SHR;
     case TK_LSHR: return OPR_LSHR;
+    case TK_ROTL: return OPR_ROTL;
+    case TK_ROTR: return OPR_ROTR;
     case TK_CONCAT: return OPR_CONCAT;
     case TK_NE: case TK_NE2: return OPR_NE;
     case TK_EQ: return OPR_EQ;
@@ -1033,7 +1035,8 @@ static const struct {
   lu_byte right; /* right priority */
 } priority[] = {  /* ORDER OPR */
    {7, 7}, {7, 7}, {8, 8}, {8, 8}, {8, 8}, {8, 8},  /* `+' `-' `*' `/' `%' `\' */
-   {6, 6}, {6, 6}, {6, 6}, {6, 6}, {6, 6}, {6, 6},  /* `&' `|' `^^' `<<' `>>' `>>>' */
+   {6, 6}, {6, 6}, {6, 6}, {6, 6},  /* `&' `|' `^^' `<<' */
+   {6, 6}, {6, 6}, {6, 6}, {6, 6},  /*`>>' `>>>' `<<>' `>><' */
    {10, 9}, {5, 4},                 /* ^, .. (right associative) */
    {3, 3}, {3, 3}, {3, 3},          /* ==, <, <= */
    {3, 3}, {3, 3}, {3, 3},          /* ~=, >, >= */

ltm.c

@@ -35,8 +35,8 @@ void luaT_init (lua_State *L) {
     "__gc", "__mode", "__len", "__eq",
     "__add", "__sub", "__mul", "__div", "__mod",
     "__pow", "_idiv", "__and", "__or", "__xor",
-    "__shl", "__shr", "__lshr", "__unm", "__not",
-    "__peek", "__peek2", "__peek4",
+    "__shl", "__shr", "__lshr", "__rotl", "rotr",
+    "__unm", "__not", "__peek", "__peek2", "__peek4",
     "__lt", "__le", "__concat", "__call"
   };
   int i;

ltm.h

@@ -35,6 +35,8 @@ typedef enum {
   TM_SHL,
   TM_SHR,
   TM_LSHR,
+  TM_ROTL,
+  TM_ROTR,
   TM_UNM,
   TM_BNOT,
   TM_PEEK,

lua.c

@@ -484,6 +484,9 @@ int main (int argc, char **argv) {
     l_message(argv[0], "cannot create state: not enough memory");
     return EXIT_FAILURE;
   }
+unsigned char ram[65536];
+for (int i = 0; i < 65536; ++i) ram[i] = i %256;
+lua_setpico8memory(L, ram);
   /* call 'pmain' in protected mode */
   lua_pushcfunction(L, &pmain);
   lua_pushinteger(L, argc);  /* 1st argument */

lua.h

@@ -194,8 +194,10 @@ LUA_API const void     *(lua_topointer) (lua_State *L, int idx);
 #define LUA_OPSHL	10
 #define LUA_OPSHR	11
 #define LUA_OPLSHR	12
-#define LUA_OPUNM	13
-#define LUA_OPBNOT	14
+#define LUA_OPROTL	13
+#define LUA_OPROTR	14
+#define LUA_OPUNM	15
+#define LUA_OPBNOT	16
 
 LUA_API void  (lua_arith) (lua_State *L, int op);
 

luaconf.h

@@ -582,6 +582,8 @@
 #define luai_numshl(L,a,b)	((a)<<int((b)))
 #define luai_numshr(L,a,b)	((a)>>int((b)))
 #define luai_numlshr(L,a,b)	(l_mathop(lshr)((a),(b)))
+#define luai_numrotl(L,a,b)	(l_mathop(rotl)((a),(b)))
+#define luai_numrotr(L,a,b)	(l_mathop(rotr)((a),(b)))
 #define luai_numbnot(L,a)	(~(a))
 #define luai_numpeek(L,a)	(lua_peek(L,a,1))
 #define luai_numpeek2(L,a)	(lua_peek(L,a,2))

lvm.c

@@ -451,7 +451,8 @@ void luaV_finishOp (lua_State *L) {
     case OP_ADD: case OP_SUB: case OP_MUL: case OP_DIV:
     case OP_MOD: case OP_POW: case OP_IDIV: case OP_BAND:
     case OP_BOR: case OP_BXOR: case OP_SHL: case OP_SHR:
-    case OP_LSHR: case OP_UNM: case OP_BNOT: case OP_LEN:
+    case OP_LSHR: case OP_ROTL: case OP_ROTR:
+    case OP_UNM: case OP_BNOT: case OP_LEN:
     case OP_GETTABUP: case OP_GETTABLE: case OP_SELF: {
       setobjs2s(L, base + GETARG_A(inst), --L->top);
       break;
@@ -684,6 +685,12 @@ void luaV_execute (lua_State *L) {
       vmcase(OP_LSHR,
         arith_op(luai_numlshr, TM_LSHR);
       )
+      vmcase(OP_ROTL,
+        arith_op(luai_numrotl, TM_ROTL);
+      )
+      vmcase(OP_ROTR,
+        arith_op(luai_numrotr, TM_ROTR);
+      )
       vmcase(OP_UNM,
         unary_op(luai_numunm, TM_UNM);
       )