suzanne.soy/whalesong
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

adding kernel primitive as opargs.

Browse Source
This commit is contained in:
Danny Yoo 2011-05-09 18:17:15 -04:00
parent 4be57c1e37
commit 39935eaee3
10 changed files with 158 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
assemble-helpers.rkt
View File

@ -51,7 +51,9 @@
[(CompiledProcedureEntry? v)
(assemble-compiled-procedure-entry v)]
[(CompiledProcedureClosureReference? v)
(assemble-compiled-procedure-closure-reference v)]))
(assemble-compiled-procedure-closure-reference v)]
[(PrimitiveKernelValue? v)
(assemble-primitive-kernel-value v)]))
@ -260,3 +262,6 @@
(assemble-label a-location)]))
(: assemble-primitive-kernel-value (PrimitiveKernelValue -> String))
(define (assemble-primitive-kernel-value a-prim)
(format "MACHINE.primitives[~s]" (symbol->string (PrimitiveKernelValue-id a-prim))))

7
collect-jump-targets.rkt
View File

@ -1,5 +1,6 @@
#lang typed/racket/base
(require "il-structs.rkt"
(require "expression-structs.rkt"
"il-structs.rkt"
"lexical-structs.rkt"
"helpers.rkt"
racket/list)
@ -88,7 +89,9 @@
[(CompiledProcedureEntry? an-input)
(collect-input (CompiledProcedureEntry-proc an-input))]
[(CompiledProcedureClosureReference? an-input)
(collect-input (CompiledProcedureClosureReference-proc an-input))]))
(collect-input (CompiledProcedureClosureReference-proc an-input))]
[(PrimitiveKernelValue? an-input)
empty]))
(: collect-location ((U Reg Label) -> (Listof Symbol)))

31
compiler.rkt
View File

@ -137,7 +137,9 @@
(append (loop (ApplyValues-proc exp) cenv)
(loop (ApplyValues-args-expr exp) cenv))]
[(DefValues? exp)
(append (loop (DefValues-rhs exp) cenv))])))
(append (loop (DefValues-rhs exp) cenv))]
[(PrimitiveKernelValue? exp)
'()])))
@ -205,7 +207,9 @@
[(ApplyValues? exp)
(compile-apply-values exp cenv target linkage)]
[(DefValues? exp)
(compile-def-values exp cenv target linkage)]))
(compile-def-values exp cenv target linkage)]
[(PrimitiveKernelValue? exp)
(compile-primitive-kernel-value exp cenv target linkage)]))
@ -1764,6 +1768,24 @@
(: compile-primitive-kernel-value (PrimitiveKernelValue CompileTimeEnvironment Target Linkage -> InstructionSequence))
(define (compile-primitive-kernel-value exp cenv target linkage)
(let ([id (PrimitiveKernelValue-id exp)])
(cond
[(KernelPrimitiveName? id)
(let ([singular-context-check (emit-singular-context linkage)])
;; Compiles constant values.
(end-with-linkage linkage
cenv
(append-instruction-sequences
(make-instruction-sequence
`(,(make-AssignImmediateStatement target exp)
singular-context-check)))))]
[else
(error 'unimplemented-kernel-primitive
"Primitive Kernel Value ~s has not been implemented"
id)])))
@ -1974,4 +1996,7 @@
(ensure-toplevelref
(adjust-expression-depth id n skip)))
(DefValues-ids exp))
(adjust-expression-depth (DefValues-rhs exp) n skip))]))
(adjust-expression-depth (DefValues-rhs exp) n skip))]
[(PrimitiveKernelValue? exp)
exp]))

8
expression-structs.rkt
View File

@ -25,7 +25,8 @@
BoxEnv
WithContMark
ApplyValues
DefValues))
DefValues
PrimitiveKernelValue))
;; A ModuleName is an identifier for a Module.
(define-struct: ModuleName ([name : Symbol])
@ -135,6 +136,11 @@
(define-struct: PrimitiveKernelValue ([id : Symbol]) #:transparent)
(: last-exp? ((Listof Expression) -> Boolean))
(define (last-exp? seq)
(null? (cdr seq)))

3
il-structs.rkt
View File

@ -32,7 +32,8 @@
ControlStackLabel/MultipleValueReturn
ControlFrameTemporary
CompiledProcedureEntry
CompiledProcedureClosureReference))
CompiledProcedureClosureReference
PrimitiveKernelValue))
;; Targets: these are the allowable lhs's for a targetted assignment.

22
kernel-primitives.rkt
View File

@ -34,6 +34,28 @@
(define-predicate KernelPrimitiveName? KernelPrimitiveName)
;; These are the primitives that we know how to inline.
(define-type KernelPrimitiveName/Inline (U '+
'-
'*
'/
'add1
'sub1
'<
'<=
'=
'>
'>=
'cons
'car
'cdr
'list
'null?
'not
'eq?))
(: kernel-primitive-expected-operand-types (KernelPrimitiveName Natural -> (Listof OperandDomain)))
;; Given a primitive and the number of arguments, produces the list of expected domains.

7
optimize-il.rkt
View File

@ -1,5 +1,6 @@
#lang typed/racket/base
(require "il-structs.rkt"
(require "expression-structs.rkt"
"il-structs.rkt"
"lexical-structs.rkt"
racket/list)
@ -132,7 +133,9 @@
[(CompiledProcedureClosureReference? oparg)
(make-CompiledProcedureClosureReference
(adjust-oparg-depth (CompiledProcedureClosureReference-proc oparg) n)
(CompiledProcedureClosureReference-n oparg))]))
(CompiledProcedureClosureReference-n oparg))]
[(PrimitiveKernelValue? oparg)
oparg]))
(define-predicate natural? Natural)

43
parse-bytecode-5.1.1.rkt
View File

@ -38,6 +38,43 @@
;; Code is copied-and-pasted from compiler/decompile. Maps the primval ids to their respective
;; symbolic names.
(define primitive-table
;; Figure out number-to-id mapping for kernel functions in `primitive'
(let ([bindings
(let ([ns (make-base-empty-namespace)])
(parameterize ([current-namespace ns])
(namespace-require ''#%kernel)
(namespace-require ''#%unsafe)
(namespace-require ''#%flfxnum)
(for/list ([l (namespace-mapped-symbols)])
(cons l (with-handlers ([exn:fail? (lambda (x)
#f)])
(compile l))))))]
[table (make-hash)])
(for ([b (in-list bindings)])
(let ([v (and (cdr b)
(zo-parse (let ([out (open-output-bytes)])
(write (cdr b) out)
(close-output-port out)
(open-input-bytes (get-output-bytes out)))))])
(let ([n (match v
[(struct compilation-top (_ prefix (struct primval (n)))) n]
[else #f])])
(hash-set! table n (car b)))))
table))
;; parse-bytecode: Input-Port -> Expression
(define (parse-bytecode in)
(parameterize ([seen-closures (make-hasheq)])
@ -430,5 +467,9 @@
(define (parse-apply-values expr)
(error 'fixme))
(define (parse-primval expr)
(error 'fixme))
(match expr
[(struct primval (id))
(let ([name (hash-ref primitive-table id)])
(make-PrimitiveKernelValue name))]))

8
simulator.rkt
View File

@ -5,7 +5,8 @@
;; For example, I'll need to be able to count the number of statements executed by an evaluation.
;; I also need to do things like count pushes and pops. Basically, low-level benchmarking.
(require "il-structs.rkt"
(require "expression-structs.rkt"
"il-structs.rkt"
"lexical-structs.rkt"
"simulator-structs.rkt"
"bootstrapped-primitives.rkt"
@ -766,7 +767,10 @@
[(CompiledProcedureClosureReference? an-oparg)
(let ([proc (ensure-closure (evaluate-oparg m (CompiledProcedureClosureReference-proc an-oparg)))])
(list-ref (closure-vals proc) (CompiledProcedureClosureReference-n an-oparg)))]))
(list-ref (closure-vals proc) (CompiledProcedureClosureReference-n an-oparg)))]
[(PrimitiveKernelValue? an-oparg)
(lookup-primitive (PrimitiveKernelValue-id an-oparg))]))

39
test-parse-bytecode-5.1.1.rkt
View File

@ -23,6 +23,9 @@
(parse-bytecode (open-input-bytes (get-output-bytes op))))))
(check-equal? (run-my-parse #''hello)
(make-Top (make-Prefix '())
(make-Constant 'hello)))
(check-equal? (run-my-parse #'"hello world")
(make-Top (make-Prefix (list))
@ -85,6 +88,7 @@
;; let1's
(check-equal? (run-my-parse #'(let ([y (f)])
'ok))
(make-Top (make-Prefix (list (make-GlobalBucket 'f)))
@ -123,6 +127,9 @@
(make-LocalRef 0 #f)))))
;; branches
(check-equal? (run-my-parse #'(if (f) (g) (h)))
(make-Top (make-Prefix (list (make-GlobalBucket 'f)
(make-GlobalBucket 'g)
@ -140,6 +147,31 @@
(check-equal? (run-my-parse #'(if x (if y z 1) #t))
(make-Top (make-Prefix (list (make-GlobalBucket 'x)
(make-GlobalBucket 'y)
(make-GlobalBucket 'z)))
(make-Branch (make-ToplevelRef 0 0)
(make-Branch (make-ToplevelRef 0 1)
(make-ToplevelRef 0 2)
(make-Constant 1))
(make-Constant #t))))
(check-equal? (run-my-parse #'(cond [x y]))
(make-Top (make-Prefix (list (make-GlobalBucket 'x)
(make-GlobalBucket 'y)))
(make-Branch (make-ToplevelRef 0 0)
(make-ToplevelRef 0 1)
(make-Constant (void)))))
(check-equal? (run-my-parse #'+)
(make-Top (make-Prefix (list))
(make-PrimitiveKernelValue '+)))
;; make sure we don't see an infinite loop
@ -147,13 +179,12 @@
(g)))
(void (run-my-parse #'(letrec ([g (lambda () (g))])
(g))))
;; todo: add tests to make sure we're parsing this as expected.
;; todo: add tests to make sure we're parsing this as expected. We expect to see an EmptyClosureReference here.
#;(run-zo-parse #'(letrec ([g (lambda () (h))]
[h (lambda () (g))])
(g)))
[h (lambda () (g))])
(g)))
;; FIXME: we need to handle closure cycles here.