Idris2/support/refc/runtime.c
György Kurucz 7a5f63eab0 [ fix ] Add missing cases for BITS types in extractInt
e79e4277 ("[ fix ] Make Bits types use int switch statement in RefC")
made the RefC backend generate code calling `extractInt` with Bits
types, bit did not add the extra cases to `extractInt`. This commit adds
the missing cases.

Fixes #2452
2022-05-04 10:18:58 +01:00

117 lines
3.5 KiB
C

#include "runtime.h"
#include "refc_util.h"
void missing_ffi() {
fprintf(stderr, "Foreign function declared, but not defined.\n"
"Cannot call missing FFI - aborting.\n");
exit(1);
}
void push_Arglist(Value_Arglist *arglist, Value *arg) {
IDRIS2_REFC_VERIFY(arglist->filled < arglist->total,
"unable to add more arguments to arglist");
arglist->args[arglist->filled] = newReference(arg);
arglist->filled++;
}
Value *apply_closure(Value *_clos, Value *arg) {
// create a new arg list
Value_Arglist *oldArgs = ((Value_Closure *)_clos)->arglist;
Value_Arglist *newArgs = newArglist(0, oldArgs->total);
newArgs->filled = oldArgs->filled + 1;
// add argument to new arglist
for (int i = 0; i < oldArgs->filled; i++) {
newArgs->args[i] = newReference(oldArgs->args[i]);
}
newArgs->args[oldArgs->filled] = newReference(arg);
Value_Closure *clos = (Value_Closure *)_clos;
// check if enough arguments exist
if (newArgs->filled >= newArgs->total) {
fun_ptr_t f = clos->f;
while (1) {
Value *retVal = f(newArgs);
removeReference((Value *)newArgs);
if (!retVal || retVal->header.tag != COMPLETE_CLOSURE_TAG) {
return retVal;
}
f = ((Value_Closure *)retVal)->f;
newArgs = ((Value_Closure *)retVal)->arglist;
newArgs = (Value_Arglist *)newReference((Value *)newArgs);
removeReference(retVal);
}
}
return (Value *)makeClosureFromArglist(clos->f, newArgs);
}
Value *tailcall_apply_closure(Value *_clos, Value *arg) {
// create a new arg list
Value_Arglist *oldArgs = ((Value_Closure *)_clos)->arglist;
Value_Arglist *newArgs = newArglist(0, oldArgs->total);
newArgs->filled = oldArgs->filled + 1;
// add argument to new arglist
for (int i = 0; i < oldArgs->filled; i++) {
newArgs->args[i] = newReference(oldArgs->args[i]);
}
newArgs->args[oldArgs->filled] = newReference(arg);
Value_Closure *clos = (Value_Closure *)_clos;
// check if enough arguments exist
if (newArgs->filled >= newArgs->total)
return (Value *)makeClosureFromArglist(clos->f, newArgs);
return (Value *)makeClosureFromArglist(clos->f, newArgs);
}
int extractInt(Value *v) {
switch (v->header.tag) {
case BITS8_TAG:
return (int)((Value_Bits8 *)v)->ui8;
case BITS16_TAG:
return (int)((Value_Bits16 *)v)->ui16;
case BITS32_TAG:
return (int)((Value_Bits32 *)v)->ui32;
case BITS64_TAG:
return (int)((Value_Bits64 *)v)->ui64;
case INT8_TAG:
return (int)((Value_Int8 *)v)->i8;
case INT16_TAG:
return (int)((Value_Int16 *)v)->i16;
case INT32_TAG:
return (int)((Value_Int32 *)v)->i32;
case INT64_TAG:
return (int)((Value_Int64 *)v)->i64;
case INTEGER_TAG:
return (int)mpz_get_si(((Value_Integer *)v)->i);
case DOUBLE_TAG:
return (int)((Value_Double *)v)->d;
case CHAR_TAG:
return (int)((Value_Char *)v)->c;
default:
return -1;
}
}
Value *trampoline(Value *closure) {
fun_ptr_t f = ((Value_Closure *)closure)->f;
Value_Arglist *_arglist = ((Value_Closure *)closure)->arglist;
Value_Arglist *arglist = (Value_Arglist *)newReference((Value *)_arglist);
removeReference(closure);
while (1) {
Value *retVal = f(arglist);
removeReference((Value *)arglist);
if (!retVal || retVal->header.tag != COMPLETE_CLOSURE_TAG) {
return retVal;
}
f = ((Value_Closure *)retVal)->f;
arglist = ((Value_Closure *)retVal)->arglist;
arglist = (Value_Arglist *)newReference((Value *)arglist);
removeReference(retVal);
}
return NULL;
}