40 lines
1.2 KiB
Scheme
40 lines
1.2 KiB
Scheme
(define-module (scmvm vm2)
|
|
#:use-module (ice-9 hash-table)
|
|
#:export (define-instruction-set
|
|
instruction-lookup
|
|
instruction-set-caller
|
|
instruction-name
|
|
instruction-code
|
|
register-set))
|
|
|
|
;;; Instructions
|
|
(define-syntax define-instruction-set
|
|
(syntax-rules (define-instruction)
|
|
[(_ (set-name reg ...) (define-instruction (name opcode) impl ...) ...)
|
|
(define (set-name dispatch)
|
|
(case dispatch
|
|
[(lookup)
|
|
(lambda (lookup)
|
|
(case lookup
|
|
[(name) '(name opcode)] ...
|
|
[else #f]))]
|
|
[(call)
|
|
(lambda (registers)
|
|
(let ([reg (hash-ref registers 'reg)] ...)
|
|
(parameterize ([reg #f] ...)
|
|
(lambda (op)
|
|
(case op
|
|
[(opcode) impl ...] ...)))))]))]))
|
|
|
|
(define (instruction-lookup isa name)
|
|
((isa 'lookup) name))
|
|
|
|
(define (instruction-set-caller instruction-set registers)
|
|
((instruction-set 'call) registers))
|
|
|
|
(define instruction-name car)
|
|
(define instruction-code cadr)
|
|
|
|
(define (register-set names)
|
|
(alist->hash-table (map (lambda (n) (cons n (make-parameter #f))) names)))
|