Skip to content

Commit

Permalink
add print-double and print-perm-string primitives for benchmarks
Browse files Browse the repository at this point in the history
  • Loading branch information
@bsaleil
bsaleil committed Jun 15, 2018
1 parent 989a63f commit 9a56d18
Show file tree
Hide file tree
Showing 6 changed files with 135 additions and 34 deletions.
5 changes: 4 additions & 1 deletion ast.scm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -361,7 +361,10 @@
(list (,ATX_PAI) #f ,lco-p-list #f #t ,ATX_PAI #f )
;; These primitives are inlined during expansion but still here to build lambda
(real? (,ATX_NUM) ,dummy-cst-all #f #f #f ,ATX_BOO 1 ,ATX_ALL )
(eqv? #f ,dummy-cst-all #f #f #f ,ATX_BOO 2 ,ATX_ALL ,ATX_ALL ))))
(eqv? #f ,dummy-cst-all #f #f #f ,ATX_BOO 2 ,ATX_ALL ,ATX_ALL )
;;
(##print-double #f #f #f ,codegen-p-print-double #f ,ATX_VOI 1 ,ATX_FLO )
(##print-perm-string #f #f #f ,codegen-p-print-perm-string #f ,ATX_VOI 1 ,ATX_STR ))))

(define (get-prim-lambda ast sym primitive)
(let ((nbargs (primitive-nbargs primitive)))
Expand Down
57 changes: 57 additions & 0 deletions codegen.scm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3503,6 +3503,63 @@
(x86-jmp cgc loop)
(x86-label cgc loop-end)))

(define (codegen-p-print-double cgc gc-desc fs ffs op reg inlined-cond? lval cst?)
(assert (not cst?) "Internal error")
(let ((dest (codegen-reg-to-x86reg reg))
(opnd (codegen-loc-to-x86opnd fs ffs lval))
(label (asm-make-label #f (new-sym 'print_double) (get_print_double-addr))))
(ppush-pop-xmm
cgc
regalloc-fregs
(lambda (cgc)
(ppush-pop-regs
cgc
c-caller-save-regs
(lambda (cgc)
(x86-mov cgc (x86-rax) (x86-rsp))
(x86-and cgc (x86-rsp) (x86-imm-int -16))
(x86-sub cgc (x86-rsp) (x86-imm-int 8))
(if (or opt-float-unboxing opt-nan-boxing)
(if (or (x86-xmm? opnd) (x86-mem? opnd))
(x86-movsd cgc (x86-xmm0) opnd)
(x86-movd/movq cgc (x86-xmm0) opnd))
(begin
(x86-mov cgc (x86-rdi) opnd)
(x86-movsd cgc (x86-xmm0) (x86-mem (- OFFSET_FLONUM TAG_MEMOBJ) (x86-rdi)))))
(x86-ppush cgc (x86-rax))
(x86-pcall cgc label)
(x86-ppop cgc (x86-rsp))))))
(x86-mov cgc dest (x86-imm-int (obj-encoding #!void)))))

(define (codegen-p-print-perm-string cgc gc-desc fs ffs op reg inlined-cond? lval cst?)

(define cfn-addr
(if opt-nan-boxing
(get_print_perm_string_nan-addr)
(get_print_perm_string_tag-addr)))

(let ((dest (codegen-reg-to-x86reg reg))
(opnd (and (not cst?) (codegen-loc-to-x86opnd fs ffs lval)))
(label (asm-make-label #f (new-sym 'print_perm_string) cfn-addr)))
(ppush-pop-xmm
cgc
regalloc-fregs
(lambda (cgc)
(ppush-pop-regs
cgc
c-caller-save-regs
(lambda (cgc)
(x86-mov cgc (x86-rax) (x86-rsp))
(x86-and cgc (x86-rsp) (x86-imm-int -16))
(x86-sub cgc (x86-rsp) (x86-imm-int 8))
(if cst?
(x86-mov cgc (x86-rdi) (x86-imm-int (obj-encoding lval)))
(x86-mov cgc (x86-rdi) opnd))
(x86-ppush cgc (x86-rax))
(x86-pcall cgc label)
(x86-ppop cgc (x86-rsp))))))
(x86-mov cgc dest (x86-imm-int (obj-encoding #!void)))))

;;-----------------------------------------------------------------------------
;; Type checks
;;-----------------------------------------------------------------------------
Expand Down
39 changes: 39 additions & 0 deletions mem.scm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -143,12 +143,51 @@ uint64_t c_xmm_imm_shift(uint64_t i)
uint64_t r = (64 - highest + lowest);
return (i == 0) | l << 16 | r << 32;
}
void lc_print_double(double d)
{
printf(\"%.16f\", d);
}
void lc_print_perm_string_tag(___U64 s)
{
___U64* ptr = (___U64*)(s-1);
___U64 header = ptr[0];
___U64 size = (header >> 10);
___U32* str_ptr = (___U32*)(ptr+1);
for (___U64 i=0; i<size; i++)
printf(\"%c\",(char)str_ptr[i]);
}
void lc_print_perm_string_nan(___U64 s)
{
___U64* ptr = (___U64*)(s&0x0000FFFFFFFFFFFF);
___U64 header = ptr[0];
___U64 size = (header >> 10);
___U32* str_ptr = (___U32*)(ptr+1);
for (___U64 i=0; i<size; i++)
printf(\"%c\",(char)str_ptr[i]);
}
")

;; TODO: remove signal stack when gambit accepts new flag
(define (init-c)
((c-lambda () void "initc")))

(define (get_print_double-addr)
((c-lambda () long "___result = &lc_print_double;")))

(define (get_print_perm_string_tag-addr)
((c-lambda () long "___result = &lc_print_perm_string_tag;")))

(define (get_print_perm_string_nan-addr)
((c-lambda () long "___result = &lc_print_perm_string_nan;")))

(define (get___heap_limit-addr)
((c-lambda () long "get___heap_limit_addr")))

Expand Down
25 changes: 13 additions & 12 deletions tools/benchtimes/prefix/LC.scm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -57,19 +57,20 @@
(def-macro (##lc-time expr)
(let ((sym (gensym)))
`(let ((r (##lc-exec-stats (lambda () ,expr))))
(print "CPU time: ")
(print (+ (cdr (assoc "User time" (cdr r)))
(cdr (assoc "Sys time" (cdr r)))))
(print #\newline)
(print "GC CPU time: ")
(print (+ (cdr (assoc "GC user time" (cdr r)))
(cdr (assoc "GC sys time" (cdr r)))))
(print #\newline)
(##print-perm-string "CPU time: ")
(##print-double (+ (cdr (assoc "User time" (cdr r)))
(cdr (assoc "Sys time" (cdr r)))))
(##print-perm-string "\n")
(##print-perm-string "GC CPU time: ")
(##print-double (+ (cdr (assoc "GC user time" (cdr r)))
(cdr (assoc "GC sys time" (cdr r)))))
(##print-perm-string "\n")

(map (lambda (el)
(print (car el))
(print ": ")
(print (cdr el))
(print #\newline))
(##print-perm-string (car el))
(##print-perm-string ": ")
(##print-double (cdr el))
(##print-perm-string "\n"))
(cdr r))
r)))

Expand Down
25 changes: 13 additions & 12 deletions tools/benchtimes/prefix/LCf64v.scm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -62,19 +62,20 @@
(def-macro (##lc-time expr)
(let ((sym (gensym)))
`(let ((r (##lc-exec-stats (lambda () ,expr))))
(print "CPU time: ")
(print (+ (cdr (assoc "User time" (cdr r)))
(cdr (assoc "Sys time" (cdr r)))))
(print #\newline)
(print "GC CPU time: ")
(print (+ (cdr (assoc "GC user time" (cdr r)))
(cdr (assoc "GC sys time" (cdr r)))))
(print #\newline)
(##print-perm-string "CPU time: ")
(##print-double (+ (cdr (assoc "User time" (cdr r)))
(cdr (assoc "Sys time" (cdr r)))))
(##print-perm-string "\n")
(##print-perm-string "GC CPU time: ")
(##print-double (+ (cdr (assoc "GC user time" (cdr r)))
(cdr (assoc "GC sys time" (cdr r)))))
(##print-perm-string "\n")

(map (lambda (el)
(print (car el))
(print ": ")
(print (cdr el))
(print #\newline))
(##print-perm-string (car el))
(##print-perm-string ": ")
(##print-double (cdr el))
(##print-perm-string "\n"))
(cdr r))
r)))

Expand Down
18 changes: 9 additions & 9 deletions tools/benchtimes/run.py
View file
Original file line number Diff line number Diff line change
Expand Up @@ -257,15 +257,15 @@ def gambit_no_options(name,gcsize):
# systems.append(lc_with_options("LC", []))

# LC
systems.append(lc_with_options("LC", []))
systems.append(lc_with_options("LC-noopt", ["--disable-float-unboxing"]))
systems.append(lc_with_options("LC-nan", ["--nan-boxing"]))
systems.append(lc_with_options("LC-nan-noopt", ["--nan-boxing","--disable-float-unboxing"]))

systems.append(lcf64v_with_options("LCf64v", []))
systems.append(lcf64v_with_options("LCf64v-noopt", ["--disable-float-unboxing"]))
systems.append(lcf64v_with_options("LCf64v-nan", ["--nan-boxing"]))
systems.append(lcf64v_with_options("LCf64v-nan-noopt", ["--nan-boxing","--disable-float-unboxing"]))
# systems.append(lc_with_options("LC", []))
# systems.append(lc_with_options("LC-noopt", ["--disable-float-unboxing"]))
# systems.append(lc_with_options("LC-nan", ["--nan-boxing"]))
# systems.append(lc_with_options("LC-nan-noopt", ["--nan-boxing","--disable-float-unboxing"]))

systems.append(lcf64v_with_options("LCf64v", ["--disable-pair-tag"]))
systems.append(lcf64v_with_options("LCf64v-noopt", ["--disable-pair-tag","--disable-float-unboxing"]))
systems.append(lcf64v_with_options("LCf64v-nan", ["--disable-pair-tag","--nan-boxing"]))
systems.append(lcf64v_with_options("LCf64v-nan-noopt", ["--disable-pair-tag","--nan-boxing","--disable-float-unboxing"]))

# Gambit
# systems.append(gambit_no_options("Gambit", 512000))
Expand Down

0 comments on commit 9a56d18

Please sign in to comment.