|
406 | 406 | tys (range (length tys))))] |
407 | 407 | [else (super display-by-type ty val)])) |
408 | 408 |
|
409 | | - ;; Andre, please write a paragraph or so explaining this |
410 | | - ;; design for representing the heap. -Jeremy |
411 | | - |
412 | 409 | ;; The simulated global state of the program |
413 | 410 | ;; define produces private fields |
414 | 411 | (define memory (box '())) |
|
561 | 558 | (error 'interp-C "invalid argument to collect in ~a" ast)) |
562 | 559 | (void)] |
563 | 560 | [`(program (type ,ty) ,e) |
| 561 | + ((initialize!) runtime-config:rootstack-size |
| 562 | + runtime-config:heap-size) |
564 | 563 | ((interp-scheme '()) e)] |
565 | | - [`(initialize ,stack-size ,heap-size) |
566 | | - ((initialize!) stack-size heap-size) |
567 | | - (void)] |
| 564 | + ;; [`(initialize ,stack-size ,heap-size) |
| 565 | + ;; ((initialize!) stack-size heap-size) |
| 566 | + ;; (void)] |
568 | 567 | [else ((super interp-scheme env) ast)] |
569 | 568 | ))) |
570 | 569 |
|
|
600 | 599 | [`(global-value fromspace_end) |
601 | 600 | (unbox fromspace_end)] |
602 | 601 | ;; I should do better than make these noops - andre |
603 | | - [`(initialize ,s ,h) |
604 | | - (unless (and (exact-nonnegative-integer? s) |
605 | | - (exact-nonnegative-integer? h)) |
606 | | - (error "intialize must be called with literals")) |
607 | | - ((initialize!) s h) |
608 | | - env] |
| 602 | + ;; [`(initialize ,s ,h) |
| 603 | + ;; (unless (and (exact-nonnegative-integer? s) |
| 604 | + ;; (exact-nonnegative-integer? h)) |
| 605 | + ;; (error "intialize must be called with literals")) |
| 606 | + ;; ((initialize!) s h) |
| 607 | + ;; env] |
609 | 608 | ;; Determine if a collection is needed. |
610 | 609 | ;; Which it isn't because vectors stored in the environment |
611 | 610 | ;; is the representation of the heap in the C language, |
|
680 | 679 | (when (pair? ast) |
681 | 680 | (vomit "R2/interp-x86" (car ast))) |
682 | 681 | (match ast |
683 | | - ;; cmpq performs a subq operation and examimines the state |
684 | | - ;; of the result, this is done without overwriting the second |
685 | | - ;; register. -andre |
686 | | - ;; Notice that the syntax is very confusing |
687 | | - ;; (cmpq ,s2 ,s1) (jl then) (jmp else) ... |
688 | | - ;; (if (< s1 s2) then else) |
689 | | - #;[`((cmpq ,s2 ,s1) . ,ss) |
690 | | - (let* ([v1 ((interp-x86-exp env) s1)] |
691 | | - [v2 ((interp-x86-exp env) s2)] |
692 | | - [v3 (- v2 v1)] |
693 | | - [zero (arithmetic-shift (b2i (eq? v3 0)) 6)] |
694 | | - [sign (arithmetic-shift (b2i (< v3 0)) 7)] |
695 | | - ;; Our numbers do not overflow so this bit is always 0 |
696 | | - [overflow (arithmetic-shift 0 11)] |
697 | | - [eflags (bitwise-ior overflow sign zero)]) |
698 | | - ((interp-x86 (cons (cons '__flag eflags) env)) ss))] |
699 | | - ;; Initialize the state of the "runtime" |
700 | | - [`((callq initialize) . ,ss) |
701 | | - (define stack-size ((interp-x86-exp env) '(reg rdi))) |
702 | | - (define heap-size ((interp-x86-exp env) '(reg rsi))) |
703 | | - ((initialize!) stack-size heap-size) |
704 | | - ((interp-x86 env) ss)] |
705 | 682 | [`((callq malloc) . ,ss) |
706 | 683 | (define num-bytes ((interp-x86-exp env) '(reg rdi))) |
707 | 684 | ((interp-x86 `((rax . ,(allocate-page! 'malloc num-bytes)) . ,env)) |
|
730 | 707 | (define op (interp-x86-op unary-op)) |
731 | 708 | (define new-env ((interp-x86-store env) d (op dst))) |
732 | 709 | ((interp-x86 new-env) ss)] |
| 710 | + [`(program (,stack-space ,root-space) (type ,ty) ,ss ...) |
| 711 | + #:when (and (integer? stack-space) (integer? root-space)) |
| 712 | + (define env (cons (cons 'r15 (+ root-space (unbox rootstack_begin))) |
| 713 | + '())) |
| 714 | + (parameterize ([program ss]) |
| 715 | + (let ([env^ ((interp-x86 env) ss)]) |
| 716 | + (display-by-type ty (lookup 'rax env^))))] |
| 717 | + [`(program ,xs (type ,ty) ,ss ...) |
| 718 | + (define env (cons (cons 'r15 (unbox rootstack_begin)) '())) |
| 719 | + (parameterize ([program ss]) |
| 720 | + (let ([env^ ((interp-x86 env) ss)]) |
| 721 | + (display-by-type ty (lookup 'rax env^))))] |
733 | 722 | [else ((super interp-x86 env) ast)]))) |
734 | 723 |
|
735 | 724 | ));; interp-R2 |
|
741 | 730 | (define interp-R3 |
742 | 731 | (class interp-R2 |
743 | 732 | (super-new) |
744 | | - (inherit primitives seq-C display-by-type interp-op) |
| 733 | + (inherit primitives seq-C display-by-type interp-op initialize!) |
745 | 734 | (inherit-field result) |
746 | 735 |
|
747 | 736 | (define/public (non-apply-ast) |
|
755 | 744 | [`(define (,f [,xs : ,ps] ...) : ,rt ,body) |
756 | 745 | (cons f `(lambda ,xs ,body))] |
757 | 746 | [`(program (type ,ty) ,ds ... ,body) |
| 747 | + ((initialize!) runtime-config:rootstack-size |
| 748 | + runtime-config:heap-size) |
758 | 749 | ((interp-scheme env) `(program ,@ds ,body))] |
759 | | - [`(program ,ds ... ,body) |
760 | | - (let ([top-level (map (interp-scheme '()) ds)]) |
761 | | - ((interp-scheme top-level) body))] |
762 | 750 | [`(,fun ,args ...) #:when (not (set-member? (non-apply-ast) fun)) |
763 | 751 | (define new-args (map (interp-scheme env) args)) |
764 | 752 | (define fun-val ((interp-scheme env) fun)) |
|
841 | 829 | (lookup result result-env)] |
842 | 830 | [else (error "interp-C, expected a funnction, not" f-val)])] |
843 | 831 | [`(program ,locals (type ,ty) (defines ,ds ...) ,ss ...) |
| 832 | + ((initialize!) runtime-config:rootstack-size |
| 833 | + runtime-config:heap-size) |
844 | 834 | ((interp-C env) `(program ,locals (defines ,@ds) ,@ss))] |
845 | | - [`(program ,locals (defines ,ds ...) ,ss ...) |
846 | | - (define new-env (map (interp-C '()) ds)) |
847 | | - (define result-env ((seq-C new-env) ss)) |
848 | | - (lookup result result-env)] |
849 | 835 | [else ((super interp-C env) ast)]))) |
850 | 836 |
|
851 | 837 | (define (stack-arg-name n) |
|
911 | 897 | [`((callq ,f) . ,ss) #:when (not (set-member? (builtin-funs) f)) |
912 | 898 | (call-function (lookup f env) ss env)] |
913 | 899 | [`(program ,extra (type ,ty) (defines ,ds ...) ,ss ...) |
| 900 | + ((initialize!) runtime-config:rootstack-size |
| 901 | + runtime-config:heap-size) |
914 | 902 | (display-by-type ty ((interp-x86 env) |
915 | 903 | `(program ,extra (defines ,@ds) ,@ss)))] |
916 | | - [`(program ,extra (defines ,ds ...) ,ss ...) |
917 | | - (parameterize ([program ss]) |
918 | | - (define env (map (interp-x86 '()) ds)) |
919 | | - (define result-env ((interp-x86 env) ss)) |
920 | | - (lookup 'rax result-env))] |
921 | 904 | [else ((super interp-x86 env) ast)]))) |
922 | 905 |
|
923 | 906 | )) ;; end interp-R3 |
|
928 | 911 | (define interp-R4 |
929 | 912 | (class interp-R3 |
930 | 913 | (super-new) |
931 | | - (inherit non-apply-ast) |
| 914 | + (inherit non-apply-ast initialize!) |
932 | 915 | (inherit-field result) |
933 | 916 |
|
934 | 917 | (define/override (interp-scheme env) |
|
940 | 923 | [`(define (,f [,xs : ,ps] ...) : ,rt ,body) |
941 | 924 | (mcons f `(lambda ,xs ,body))] |
942 | 925 | [`(program (type ,ty) ,ds ... ,body) |
| 926 | + ((initialize!) runtime-config:rootstack-size |
| 927 | + runtime-config:heap-size) |
943 | 928 | ((interp-scheme env) `(program ,@ds ,body))] |
944 | 929 | [`(program ,ds ... ,body) |
| 930 | + ((initialize!) runtime-config:rootstack-size |
| 931 | + runtime-config:heap-size) |
945 | 932 | (let ([top-level (map (interp-scheme '()) ds)]) |
946 | 933 | ;; Use set-cdr! on define lambda's for mutual recursion |
947 | 934 | (for/list ([b top-level]) |
|
0 commit comments