6 char *rcs_opcode
="$Id: opcode.c,v 3.50 1995/11/16 20:46:24 roberto Exp $";
22 #define tonumber(o) ((tag(o) != LUA_T_NUMBER) && (lua_tonumber(o) != 0))
23 #define tostring(o) ((tag(o) != LUA_T_STRING) && (lua_tostring(o) != 0))
26 #define STACK_SIZE 128
28 typedef int StkId
; /* index to stack elements */
30 static Object initial_stack
;
32 static Object
*stackLimit
= &initial_stack
+1;
33 static Object
*stack
= &initial_stack
;
34 static Object
*top
= &initial_stack
;
37 /* macros to convert from lua_Object to (Object *) and back */
39 #define Address(lo) ((lo)+stack-1)
40 #define Ref(st) ((st)-stack+1)
43 /* macro to increment stack top. There must be always an empty slot in
46 #define incr_top if (++top >= stackLimit) growstack()
48 static StkId CBase
= 0; /* when Lua calls C or C calls Lua, points to */
49 /* the first slot after the last parameter. */
50 static int CnResults
= 0; /* when Lua calls C, has the number of parameters; */
51 /* when C calls Lua, has the number of results. */
53 static jmp_buf *errorJmp
= NULL
; /* current error recover point */
56 static StkId
lua_execute (Byte
*pc
, StkId base
);
57 static void do_call (StkId base
, int nResults
);
61 Object
*luaI_Address (lua_Object o
)
71 static void lua_initstack (void)
73 Long maxstack
= STACK_SIZE
;
74 stack
= newvector(maxstack
, Object
);
75 stackLimit
= stack
+maxstack
;
77 *(top
++) = initial_stack
;
82 ** Check stack overflow and, if necessary, realloc vector
84 #define lua_checkstack(nt) if ((nt) >= stackLimit) growstack()
86 static void growstack (void)
88 if (stack
== &initial_stack
)
93 Long maxstack
= stackLimit
- stack
;
95 stack
= growvector(stack
, maxstack
, Object
);
96 stackLimit
= stack
+maxstack
;
98 if (maxstack
>= MAX_WORD
/2)
99 lua_error("stack size overflow");
105 ** Concatenate two given strings. Return the new string pointer.
107 static char *lua_strconc (char *l
, char *r
)
109 static char *buffer
= NULL
;
110 static int buffer_size
= 0;
112 int n
= nl
+strlen(r
)+1;
118 buffer
= newvector(buffer_size
, char);
121 strcpy(buffer
+nl
, r
);
127 ** Convert, if possible, to a number object.
128 ** Return 0 if success, not 0 if error.
130 static int lua_tonumber (Object
*obj
)
134 if (tag(obj
) != LUA_T_STRING
)
136 else if (sscanf(svalue(obj
), "%f %c",&t
, &c
) == 1)
139 tag(obj
) = LUA_T_NUMBER
;
148 ** Convert, if possible, to a string tag
149 ** Return 0 in success or not 0 on error.
151 static int lua_tostring (Object
*obj
)
154 if (tag(obj
) != LUA_T_NUMBER
)
156 if ((int) nvalue(obj
) == nvalue(obj
))
157 sprintf (s
, "%d", (int) nvalue(obj
));
159 sprintf (s
, "%g", nvalue(obj
));
160 tsvalue(obj
) = lua_createstring(s
);
161 if (tsvalue(obj
) == NULL
)
163 tag(obj
) = LUA_T_STRING
;
169 ** Adjust stack. Set top to the given value, pushing NILs if needed.
171 static void adjust_top (StkId newtop
)
174 lua_checkstack(stack
+newtop
);
175 nt
= stack
+newtop
; /* warning: previous call may change stack */
176 while (top
< nt
) tag(top
++) = LUA_T_NIL
;
177 top
= nt
; /* top could be bigger than newtop */
180 #define adjustC(nParams) adjust_top(CBase+nParams)
184 ** Open a hole below "nelems" from the top.
186 static void open_stack (int nelems
)
189 for (i
=0; i
<nelems
; i
++)
190 *(top
-i
) = *(top
-i
-1);
196 ** Call a C function. CBase will point to the top of the stack,
197 ** and CnResults is the number of parameters. Returns an index
198 ** to the first result from C.
200 static StkId
callC (lua_CFunction func
, StkId base
)
202 StkId oldBase
= CBase
;
203 int oldCnResults
= CnResults
;
205 CnResults
= (top
-stack
) - base
;
206 /* incorporate parameters on the stack */
207 CBase
= base
+CnResults
;
211 CnResults
= oldCnResults
;
216 ** Call the specified fallback, putting it on the stack below its arguments
218 static void callFB (int fb
)
220 int nParams
= luaI_fallBacks
[fb
].nParams
;
222 *(top
-nParams
-1) = luaI_fallBacks
[fb
].function
;
223 do_call((top
-stack
)-nParams
, luaI_fallBacks
[fb
].nResults
);
228 ** Call a function (C or Lua). The parameters must be on the stack,
229 ** between [stack+base,top). The function to be called is at stack+base-1.
230 ** When returns, the results are on the stack, between [stack+base-1,top).
231 ** The number of results is nResults, unless nResults=MULT_RET.
233 static void do_call (StkId base
, int nResults
)
236 Object
*func
= stack
+base
-1;
238 if (tag(func
) == LUA_T_CFUNCTION
)
240 tag(func
) = LUA_T_CMARK
;
241 firstResult
= callC(fvalue(func
), base
);
243 else if (tag(func
) == LUA_T_FUNCTION
)
245 tag(func
) = LUA_T_MARK
;
246 firstResult
= lua_execute(func
->value
.tf
->code
, base
);
249 { /* func is not a function */
250 /* Call the fallback for invalid functions */
251 open_stack((top
-stack
)-(base
-1));
252 stack
[base
-1] = luaI_fallBacks
[FB_FUNCTION
].function
;
253 do_call(base
, nResults
);
256 /* adjust the number of results */
257 if (nResults
!= MULT_RET
&& top
- (stack
+firstResult
) != nResults
)
258 adjust_top(firstResult
+nResults
);
259 /* move results to base-1 (to erase parameters and function) */
261 nResults
= top
- (stack
+firstResult
); /* actual number of results */
262 for (i
=0; i
<nResults
; i
++)
263 *(stack
+base
+i
) = *(stack
+firstResult
+i
);
264 top
-= firstResult
-base
;
269 ** Function to index a table. Receives the table at top-2 and the index
272 static void pushsubscript (void)
274 if (tag(top
-2) != LUA_T_ARRAY
)
278 Object
*h
= lua_hashget(avalue(top
-2), top
-1);
279 if (h
== NULL
|| tag(h
) == LUA_T_NIL
)
291 ** Function to store indexed based on values at the top
293 static void storesubscript (void)
295 if (tag(top
-3) != LUA_T_ARRAY
)
299 Object
*h
= lua_hashdefine (avalue(top
-3), top
-2);
307 ** Traverse all objects on stack
309 void lua_travstack (int (*fn
)(Object
*))
312 for (o
= top
-1; o
>= stack
; o
--)
318 ** Error messages and debug functions
321 static void lua_message (char *s
)
328 ** Reports an error, and jumps up to the available recover label
330 void lua_error (char *s
)
332 if (s
) lua_message(s
);
334 longjmp(*errorJmp
, 1);
337 fprintf (stderr
, "lua: exit(1). Unable to recover\n");
343 lua_Object
lua_stackedfunction (int level
)
347 if (p
->tag
== LUA_T_MARK
|| p
->tag
== LUA_T_CMARK
)
354 int lua_currentline (lua_Object func
)
356 Object
*f
= Address(func
);
357 return (f
+1 < top
&& (f
+1)->tag
== LUA_T_LINE
) ? (f
+1)->value
.i
: -1;
362 ** Execute a protected call. Assumes that function is at CBase and
363 ** parameters are on top of it. Leave nResults on the stack.
365 static int do_protectedrun (int nResults
)
369 StkId oldCBase
= CBase
;
370 jmp_buf *oldErr
= errorJmp
;
371 errorJmp
= &myErrorJmp
;
372 if (setjmp(myErrorJmp
) == 0)
374 do_call(CBase
+1, nResults
);
375 CnResults
= (top
-stack
) - CBase
; /* number of results */
376 CBase
+= CnResults
; /* incorporate results on the stack */
380 { /* an error occurred: restore CBase and top */
390 static int do_protectedmain (void)
395 jmp_buf *oldErr
= errorJmp
;
396 errorJmp
= &myErrorJmp
;
397 adjustC(1); /* one slot for the pseudo-function */
398 stack
[CBase
].tag
= LUA_T_FUNCTION
;
399 stack
[CBase
].value
.tf
= &tf
;
401 tf
.fileName
= lua_parsedfile
;
403 if (setjmp(myErrorJmp
) == 0)
406 status
= do_protectedrun(0);
411 adjustC(0); /* erase extra slot */
421 ** Execute the given lua function. Return 0 on success or 1 on error.
423 int lua_callfunction (lua_Object function
)
425 if (function
== LUA_NOOBJECT
)
429 open_stack((top
-stack
)-CBase
);
430 stack
[CBase
] = *Address(function
);
431 return do_protectedrun (MULT_RET
);
436 int lua_call (char *funcname
)
438 Word n
= luaI_findsymbolbyname(funcname
);
439 open_stack((top
-stack
)-CBase
);
440 stack
[CBase
] = s_object(n
);
441 return do_protectedrun(MULT_RET
);
446 ** Open file, generate opcode and execute global statement. Return 0 on
447 ** success or 1 on error.
449 int lua_dofile (char *filename
)
452 char *message
= lua_openfile (filename
);
455 lua_message(message
);
458 status
= do_protectedmain();
464 ** Generate opcode stored on string and execute global statement. Return 0 on
465 ** success or 1 on error.
467 int lua_dostring (char *string
)
470 lua_openstring(string
);
471 status
= do_protectedmain();
478 ** API: set a function as a fallback
480 lua_Object
lua_setfallback (char *name
, lua_CFunction fallback
)
482 adjustC(1); /* one slot for the pseudo-function */
483 stack
[CBase
].tag
= LUA_T_CFUNCTION
;
484 stack
[CBase
].value
.f
= luaI_setfallback
;
485 lua_pushstring(name
);
486 lua_pushcfunction(fallback
);
487 if (do_protectedrun(1) == 0)
495 ** API: receives on the stack the table and the index.
496 ** returns the value.
498 lua_Object
lua_getsubscript (void)
502 CBase
++; /* incorporate object in the stack */
507 #define MAX_C_BLOCKS 10
509 static int numCblocks
= 0;
510 static StkId Cblocks
[MAX_C_BLOCKS
];
513 ** API: starts a new block
515 void lua_beginblock (void)
517 if (numCblocks
< MAX_C_BLOCKS
)
518 Cblocks
[numCblocks
] = CBase
;
525 void lua_endblock (void)
528 if (numCblocks
< MAX_C_BLOCKS
)
530 CBase
= Cblocks
[numCblocks
];
536 ** API: receives on the stack the table, the index, and the new value.
538 void lua_storesubscript (void)
545 ** API: creates a new table
547 lua_Object
lua_createtable (void)
550 avalue(top
) = lua_createarray(0);
551 tag(top
) = LUA_T_ARRAY
;
553 CBase
++; /* incorporate object in the stack */
558 ** Get a parameter, returning the object handle or LUA_NOOBJECT on error.
559 ** 'number' must be 1 to get the first parameter.
561 lua_Object
lua_getparam (int number
)
563 if (number
<= 0 || number
> CnResults
) return LUA_NOOBJECT
;
564 /* Ref(stack+(CBase-CnResults+number-1)) ==
565 stack+(CBase-CnResults+number-1)-stack+1 == */
566 return CBase
-CnResults
+number
;
570 ** Given an object handle, return its number value. On error, return 0.0.
572 real
lua_getnumber (lua_Object object
)
574 if (object
== LUA_NOOBJECT
) return 0.0;
575 if (tonumber (Address(object
))) return 0.0;
576 else return (nvalue(Address(object
)));
580 ** Given an object handle, return its string pointer. On error, return NULL.
582 char *lua_getstring (lua_Object object
)
584 if (object
== LUA_NOOBJECT
) return NULL
;
585 if (tostring (Address(object
))) return NULL
;
586 else return (svalue(Address(object
)));
590 ** Given an object handle, return its cfuntion pointer. On error, return NULL.
592 lua_CFunction
lua_getcfunction (lua_Object object
)
594 if (object
== LUA_NOOBJECT
|| tag(Address(object
)) != LUA_T_CFUNCTION
)
596 else return (fvalue(Address(object
)));
600 ** Given an object handle, return its user data. On error, return NULL.
602 void *lua_getuserdata (lua_Object object
)
604 if (object
== LUA_NOOBJECT
|| tag(Address(object
)) < LUA_T_USERDATA
)
606 else return (uvalue(Address(object
)));
610 lua_Object
lua_getlocked (int ref
)
613 *top
= *luaI_getlocked(ref
);
615 CBase
++; /* incorporate object in the stack */
620 void lua_pushlocked (int ref
)
622 *top
= *luaI_getlocked(ref
);
630 return luaI_lock(--top
);
636 ** Get a global object.
638 lua_Object
lua_getglobal (char *name
)
640 Word n
= luaI_findsymbolbyname(name
);
644 CBase
++; /* incorporate object in the stack */
649 ** Store top of the stack at a global variable array field.
651 void lua_storeglobal (char *name
)
653 Word n
= luaI_findsymbolbyname(name
);
655 s_object(n
) = *(--top
);
661 void lua_pushnil (void)
663 tag(top
) = LUA_T_NIL
;
668 ** Push an object (tag=number) to stack.
670 void lua_pushnumber (real n
)
672 tag(top
) = LUA_T_NUMBER
; nvalue(top
) = n
;
677 ** Push an object (tag=string) to stack.
679 void lua_pushstring (char *s
)
681 tsvalue(top
) = lua_createstring(s
);
682 tag(top
) = LUA_T_STRING
;
687 ** Push an object (tag=string) on stack and register it on the constant table.
689 void lua_pushliteral (char *s
)
691 tsvalue(top
) = lua_constant
[luaI_findconstantbyname(s
)];
692 tag(top
) = LUA_T_STRING
;
697 ** Push an object (tag=cfunction) to stack.
699 void lua_pushcfunction (lua_CFunction fn
)
701 tag(top
) = LUA_T_CFUNCTION
; fvalue(top
) = fn
;
706 ** Push an object (tag=userdata) to stack.
708 void lua_pushusertag (void *u
, int tag
)
710 if (tag
< LUA_T_USERDATA
) return;
711 tag(top
) = tag
; uvalue(top
) = u
;
716 ** Push a lua_Object to stack.
718 void lua_pushobject (lua_Object o
)
725 ** Push an object on the stack.
727 void luaI_pushobject (Object
*o
)
733 int lua_type (lua_Object o
)
735 if (o
== LUA_NOOBJECT
)
738 return tag(Address(o
));
742 void luaI_gcFB (Object
*o
)
750 static void call_arith (char *op
)
756 static void comparison (lua_Type tag_less
, lua_Type tag_equal
,
757 lua_Type tag_great
, char *op
)
762 if (tag(l
) == LUA_T_NUMBER
&& tag(r
) == LUA_T_NUMBER
)
763 result
= (nvalue(l
) < nvalue(r
)) ? -1 : (nvalue(l
) == nvalue(r
)) ? 0 : 1;
764 else if (tostring(l
) || tostring(r
))
771 result
= strcmp(svalue(l
), svalue(r
));
774 tag(top
-1) = (result
< 0) ? tag_less
: (result
== 0) ? tag_equal
: tag_great
;
780 ** Execute the given opcode, until a RET. Parameters are between
781 ** [stack+base,top). Returns n such that the the results are between
784 static StkId
lua_execute (Byte
*pc
, StkId base
)
789 switch (opcode
= (OpCode
)*pc
++)
791 case PUSHNIL
: tag(top
) = LUA_T_NIL
; incr_top
; break;
793 case PUSH0
: case PUSH1
: case PUSH2
:
794 tag(top
) = LUA_T_NUMBER
;
795 nvalue(top
) = opcode
-PUSH0
;
800 tag(top
) = LUA_T_NUMBER
; nvalue(top
) = *pc
++; incr_top
; break;
806 tag(top
) = LUA_T_NUMBER
; nvalue(top
) = code
.w
;
815 tag(top
) = LUA_T_NUMBER
; nvalue(top
) = code
.f
;
824 tag(top
) = LUA_T_STRING
; tsvalue(top
) = lua_constant
[code
.w
];
833 luaI_insertfunction(code
.tf
); /* may take part in GC */
834 top
->tag
= LUA_T_FUNCTION
;
835 top
->value
.tf
= code
.tf
;
840 case PUSHLOCAL0
: case PUSHLOCAL1
: case PUSHLOCAL2
:
841 case PUSHLOCAL3
: case PUSHLOCAL4
: case PUSHLOCAL5
:
842 case PUSHLOCAL6
: case PUSHLOCAL7
: case PUSHLOCAL8
:
844 *top
= *((stack
+base
) + (int)(opcode
-PUSHLOCAL0
)); incr_top
; break;
846 case PUSHLOCAL
: *top
= *((stack
+base
) + (*pc
++)); incr_top
; break;
852 *top
= s_object(code
.w
);
863 Object receiver
= *(top
-1);
866 tag(top
) = LUA_T_STRING
; tsvalue(top
) = lua_constant
[code
.w
];
874 case STORELOCAL0
: case STORELOCAL1
: case STORELOCAL2
:
875 case STORELOCAL3
: case STORELOCAL4
: case STORELOCAL5
:
876 case STORELOCAL6
: case STORELOCAL7
: case STORELOCAL8
:
878 *((stack
+base
) + (int)(opcode
-STORELOCAL0
)) = *(--top
);
881 case STORELOCAL
: *((stack
+base
) + (*pc
++)) = *(--top
); break;
887 s_object(code
.w
) = *(--top
);
898 if (tag(top
-3-n
) != LUA_T_ARRAY
)
900 lua_checkstack(top
+2);
903 *(top
-1) = *(top
-3-n
);
909 Object
*h
= lua_hashdefine (avalue(top
-3-n
), top
-2-n
);
921 if (opcode
== STORELIST0
) m
= 0;
922 else m
= *(pc
++) * FIELDS_PER_FLUSH
;
927 tag(top
) = LUA_T_NUMBER
; nvalue(top
) = n
+m
;
928 *(lua_hashdefine (avalue(arr
), top
)) = *(top
-1);
938 Object
*arr
= top
-n
-1;
943 tag(top
) = LUA_T_STRING
; tsvalue(top
) = lua_constant
[code
.w
];
944 *(lua_hashdefine (avalue(arr
), top
)) = *(top
-1);
956 adjust_top(base
+ *(pc
++));
963 avalue(top
) = lua_createarray(size
.w
);
964 tag(top
) = LUA_T_ARRAY
;
971 int res
= lua_equalObj(top
-2, top
-1);
973 tag(top
-1) = res
? LUA_T_NUMBER
: LUA_T_NIL
;
979 comparison(LUA_T_NUMBER
, LUA_T_NIL
, LUA_T_NIL
, "lt");
983 comparison(LUA_T_NUMBER
, LUA_T_NUMBER
, LUA_T_NIL
, "le");
987 comparison(LUA_T_NIL
, LUA_T_NIL
, LUA_T_NUMBER
, "gt");
991 comparison(LUA_T_NIL
, LUA_T_NUMBER
, LUA_T_NUMBER
, "ge");
998 if (tonumber(r
) || tonumber(l
))
1002 nvalue(l
) += nvalue(r
);
1012 if (tonumber(r
) || tonumber(l
))
1016 nvalue(l
) -= nvalue(r
);
1026 if (tonumber(r
) || tonumber(l
))
1030 nvalue(l
) *= nvalue(r
);
1040 if (tonumber(r
) || tonumber(l
))
1044 nvalue(l
) /= nvalue(r
);
1058 if (tostring(r
) || tostring(l
))
1062 tsvalue(l
) = lua_createstring (lua_strconc(svalue(l
),svalue(r
)));
1069 if (tonumber(top
-1))
1071 tag(top
) = LUA_T_NIL
;
1076 nvalue(top
-1) = - nvalue(top
-1);
1080 tag(top
-1) = (tag(top
-1) == LUA_T_NIL
) ? LUA_T_NUMBER
: LUA_T_NIL
;
1088 if (tag(top
-1) != LUA_T_NIL
) pc
+= code
.w
;
1096 if (tag(top
-1) == LUA_T_NIL
) pc
+= code
.w
;
1121 if (tag(top
) == LUA_T_NIL
) pc
+= code
.w
;
1130 if (tag(top
) == LUA_T_NIL
) pc
-= code
.w
;
1134 case POP
: --top
; break;
1138 int nParams
= *(pc
++);
1139 int nResults
= *(pc
++);
1140 StkId newBase
= (top
-stack
)-nParams
;
1141 do_call(newBase
, nResults
);
1155 if ((stack
+base
-1)->tag
!= LUA_T_LINE
)
1157 /* open space for LINE value */
1158 open_stack((top
-stack
)-base
);
1160 (stack
+base
-1)->tag
= LUA_T_LINE
;
1162 (stack
+base
-1)->value
.i
= code
.w
;
1167 lua_error ("internal error - opcode doesn't match");