Skip to content

Commit

Permalink
rename BOX_INTEGER to TAG_INTEGER.
Browse files Browse the repository at this point in the history 
Issue #33.
  • Loading branch information
@samrushing
samrushing committed Aug 29, 2018
1 parent 3b7db43 commit 4fe0350
Show file tree
Hide file tree
Showing 4 changed files with 108 additions and 108 deletions.
20 changes: 10 additions & 10 deletions include/header1.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -231,7 +231,7 @@ dump_object (object * ob, int depth)
case 2:
fprintf (stdout, "<foreign ");
dump_object (ob[1], depth+1);
fprintf (stdout, " off=%" PRIuPTR ">", UNBOX_INTEGER(ob[2]));
fprintf (stdout, " off=%" PRIuPTR ">", UNTAG_INTEGER(ob[2]));
break;
}
break;
Expand Down Expand Up @@ -718,7 +718,7 @@ get_foreign (object * ob)
// TC_FOREIGN <buffer> <offset>
object * buffer = (object*) ob[1];
uint8_t * base = (uint8_t *) (buffer + 1);
pxll_int offset = UNBOX_INTEGER (ob[2]);
pxll_int offset = UNTAG_INTEGER (ob[2]);
return (void *) (base + offset);
}
}
Expand All @@ -739,7 +739,7 @@ offset_foreign (object * foreign, pxll_int offset)
// TC_FOREIGN <buffer> <offset>
object * r = allocate (TC_FOREIGN, 2);
r[1] = foreign[1];
r[2] = (object*) BOX_INTEGER ((UNBOX_INTEGER (foreign[2]) + offset));
r[2] = (object*) TAG_INTEGER ((UNTAG_INTEGER (foreign[2]) + offset));
return r;
}
}
Expand All @@ -757,7 +757,7 @@ free_foreign (object * foreign)
object *
irk_cref_2_string (object * src, object * len)
{
pxll_int len0 = UNBOX_INTEGER (len);
pxll_int len0 = UNTAG_INTEGER (len);
object * result = make_string (len0);
uint8_t * src0 = (uint8_t * ) get_foreign (src);
void * dst = GET_STRING_POINTER (result);
Expand All @@ -774,13 +774,13 @@ irk_string_2_cref (object * src)
object *
irk_cref_2_int (object * src)
{
return BOX_INTEGER (((pxll_int *) src)[1]);
return TAG_INTEGER (((pxll_int *) src)[1]);
}

object *
irk_int_2_cref (object * src)
{
return make_foreign ((void*)UNBOX_INTEGER(src));
return make_foreign ((void*)UNTAG_INTEGER(src));
}

// XXX this needs more thought
Expand All @@ -791,7 +791,7 @@ irk_int_2_cref (object * src)
object *
irk_get_errno (void)
{
return BOX_INTEGER ((pxll_int) errno);
return TAG_INTEGER ((pxll_int) errno);
}


Expand Down Expand Up @@ -917,7 +917,7 @@ void exit_continuation (object * result)
#endif
prof_dump();
if (is_int (result)) {
exit ((int)(intptr_t)UNBOX_INTEGER(result));
exit ((int)(intptr_t)UNTAG_INTEGER(result));
} else {
exit (0);
}
Expand All @@ -933,7 +933,7 @@ mem2ptr (object * ob)
break;
case TC_USEROBJ + 1:
// pointer
return (object*) UNBOX_INTEGER (*((pxll_int*)(ob+1)));
return (object*) UNTAG_INTEGER (*((pxll_int*)(ob+1)));
break;
default:
fprintf (stderr, "bad cmem object\n");
Expand All @@ -945,7 +945,7 @@ object *
ptr2mem (void * ptr)
{
object * result = allocate (TC_USEROBJ + 1, 1);
result[1] = (object*) BOX_INTEGER ((pxll_int)ptr);
result[1] = (object*) TAG_INTEGER ((pxll_int)ptr);
return result;
}

Expand Down
6 changes: 3 additions & 3 deletions include/irken.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -66,8 +66,8 @@ object * heap1 = NULL;
#define GET_STRING_POINTER(s) (((pxll_string *)(s))->data)

#define IS_INTEGER(p) (((pxll_int)(p)) & 1)
#define BOX_INTEGER(p) ((object)(((p)<<1)|1))
#define UNBOX_INTEGER(p) (((pxll_int)(p))>>1)
#define TAG_INTEGER(p) ((object)(((p)<<1)|1))
#define UNTAG_INTEGER(p) (((pxll_int)(p))>>1)

#define IMMEDIATE(p) (((pxll_int)(p)) & 3)
#define IS_TYPE(t, p) (((pxll_int)(p)&0xff)==t)
Expand Down Expand Up @@ -98,7 +98,7 @@ object * heap1 = NULL;
#define UPTR(n,o) ((pxll_int)(constructed_##n+o))
#define UPTR0(n) ((pxll_int)(&constructed_##n))
#define UOHEAD(l,n) ((l<<8)|UOTAG(n))
#define INTCON(p) ((pxll_int)BOX_INTEGER(p))
#define INTCON(p) ((pxll_int)TAG_INTEGER(p))

// here we want something that looks like a pointer, but is unlikely,
// i.e. ...111111100
Expand Down
24 changes: 12 additions & 12 deletions self/c.scm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,7 @@
(type:tvar id _) -> arg
(type:pred name predargs _)
-> (match name with
'int -> (format "UNBOX_INTEGER(" arg ")")
'int -> (format "UNTAG_INTEGER(" arg ")")
'bool -> (format "IRK_IS_TRUE(" arg ")")
'string -> (format "((pxll_string*)(" arg "))->data")
'cstring -> (format "(char*)" arg)
Expand Down Expand Up @@ -73,7 +73,7 @@

(define (wrap-out type exp)
(match type with
(type:pred 'int _ _) -> (format "BOX_INTEGER((pxll_int)" exp ")")
(type:pred 'int _ _) -> (format "TAG_INTEGER((pxll_int)" exp ")")
(type:pred 'bool _ _) -> (format "IRK_TEST(" exp ")")
(type:pred 'cstring _ _) -> (format "(object*)" exp)
(type:pred 'cref _ _) -> (format "(make_foreign((void*)" exp "))")
Expand Down Expand Up @@ -681,7 +681,7 @@
(o.write (format "// ctype = " ctype))
(o.write (format "O r" (int k.target)
" = offset_foreign (r" (int src)", sizeof(" ctype
") * UNBOX_INTEGER(r" (int index)"));")))
") * UNTAG_INTEGER(r" (int index)"));")))
_ _ -> (primop-error)))

(define prim-c-get-ptr
Expand All @@ -705,7 +705,7 @@
(define (prim-c-sizeof ctexp)
(let ((t0 (parse-type ctexp))
(t1 (irken-type->c-type t0)))
(o.write (format "O r" (int k.target) " = BOX_INTEGER (sizeof (" t1 "));"))))
(o.write (format "O r" (int k.target) " = TAG_INTEGER (sizeof (" t1 "));"))))

;; generic version, hopefully we can make this work.
;; things we can do:
Expand All @@ -724,7 +724,7 @@
(type:pred '* _ _)
-> (o.write (format "O r" (int k.target) " = make_foreign (*(void**)get_foreign (r" (int src) "));"))
int-type
-> (o.write (format "O r" (int k.target) " = BOX_INTEGER((pxll_int)*(("
-> (o.write (format "O r" (int k.target) " = TAG_INTEGER((pxll_int)*(("
(irken-type->c-type int-type) "*)get_foreign(r" (int src) ")));"))
)
_ -> (primop-error))
Expand All @@ -740,7 +740,7 @@
;; XXX here's the trick - getting the C type.
-> (let ((ctype (irken-type->c-type type)))
(printf "prim-c-set ctype = " ctype " type = " (type-repr type) "\n")
(o.write (format "*((" ctype "*)get_foreign(r" (int dst) ")) = (" ctype ") UNBOX_INTEGER(r" (int src) ");"))
(o.write (format "*((" ctype "*)get_foreign(r" (int dst) ")) = (" ctype ") UNTAG_INTEGER(r" (int src) ");"))
(when (> k.target 0)
(o.write (format "O r" (int k.target) " = (object *) TC_UNDEFINED;")))
)
Expand All @@ -750,7 +750,7 @@
(define prim-c-get-int
(src)
-> (o.write
(format "O r" (int k.target) " = BOX_INTEGER((pxll_int)*(("
(format "O r" (int k.target) " = TAG_INTEGER((pxll_int)*(("
(irken-type->c-type type) "*)get_foreign(r" (int src) ")));"))
_ -> (primop-error))

Expand All @@ -760,7 +760,7 @@
-> (let ((ctype (irken-type->c-type type)))
;; XXX check against word size
(printf "c-set-int " ctype "\n")
(o.write (format "*((" ctype "*)get_foreign(r" (int dst) ")) = (" ctype ") UNBOX_INTEGER(r" (int src) ");"))
(o.write (format "*((" ctype "*)get_foreign(r" (int dst) ")) = (" ctype ") UNTAG_INTEGER(r" (int src) ");"))
(when (> k.target 0)
(o.write (format "O r" (int k.target) " = (object *) TC_UNDEFINED;"))))
_ -> (primop-error))
Expand All @@ -784,10 +784,10 @@
(define prim-c-sfromc
(src len)
-> (begin
(o.write (format "O r" (int k.target) " = make_string (UNBOX_INTEGER (r" (int len) "));"))
(o.write (format "O r" (int k.target) " = make_string (UNTAG_INTEGER (r" (int len) "));"))
(o.write (format "memcpy (GET_STRING_POINTER (r"
(int k.target) "), get_foreign (r" (int src)
"), UNBOX_INTEGER (r" (int len) "));")))
"), UNTAG_INTEGER (r" (int len) "));")))
_ -> (primop-error))

(define prim-string->cref
Expand All @@ -800,11 +800,11 @@
_ -> (primop-error))

(define prim-cref->int
(src) -> (o.write (format "O r" (int k.target) " = BOX_INTEGER (((pxll_int) get_foreign (r" (int src) ")));"))
(src) -> (o.write (format "O r" (int k.target) " = TAG_INTEGER (((pxll_int) get_foreign (r" (int src) ")));"))
_ -> (primop-error))

(define prim-int->cref
(addr) -> (o.write (format "O r" (int k.target) " = make_foreign ((void*)UNBOX_INTEGER (r" (int addr) "));"))
(addr) -> (o.write (format "O r" (int k.target) " = make_foreign ((void*)UNTAG_INTEGER (r" (int addr) "));"))
_ -> (primop-error))

(match name with
Expand Down
Loading

0 comments on commit 4fe0350

Please sign in to comment.