├── a1 ├── makefile ├── compiler-passes1.ss ├── a1-main.ss ├── runtime.c ├── a1-wrapper.ss └── tests1.ss ├── a10 ├── makefile ├── a10-main.ss ├── compiler-passes10.ss └── runtime.c ├── a11 ├── makefile ├── a11-main.ss ├── compiler-passes11.ss └── runtime.c ├── a12 ├── makefile ├── a12-main.ss ├── compiler-passes12.ss └── runtime.c ├── a13 ├── makefile ├── a13-main.ss ├── compiler-passes13.ss └── runtime.c ├── a14 ├── makefile ├── a14-main.ss ├── compiler-passes14.ss └── runtime.c ├── a15 ├── makefile ├── a15-main.ss ├── compiler-passes15.ss └── runtime.c ├── a2 ├── makefile ├── compiler-passes2.ss ├── a2-main.ss ├── a2-wrapper.ss ├── runtime.c └── tests2.ss ├── a3 ├── makefile ├── compiler-passes3.ss ├── a3-main.ss ├── runtime.c └── a3-wrapper.ss ├── a4 ├── makefile ├── compiler-passes4.ss ├── a4-main.ss ├── runtime.c └── a4-wrapper.ss ├── a5 ├── makefile ├── compiler-passes5.ss ├── a5-main.ss ├── runtime.c └── a5-wrapper.ss ├── a6 ├── makefile ├── a6-main.ss ├── compiler-passes6.ss ├── runtime.c └── a6-wrapper.ss ├── a7 ├── makefile ├── a7-main.ss ├── compiler-passes7.ss └── runtime.c ├── a8 ├── makefile ├── a8-main.ss ├── compiler-passes8.ss └── runtime.c ├── a9 ├── makefile ├── a9-main.ss ├── compiler-passes9.ss └── runtime.c ├── doc ├── assign1.pdf ├── assign10.pdf ├── assign11.pdf ├── assign13.pdf ├── assign14.pdf ├── assign15.pdf ├── assign2.pdf ├── assign3.pdf ├── assign4.pdf ├── assign5.pdf ├── assign6.pdf ├── assign7.pdf ├── assign8.pdf └── assign9.pdf ├── fmts.pretty └── README.md /a1/makefile: -------------------------------------------------------------------------------- 1 | clean: 2 | rm t 3 | rm t.* 4 | -------------------------------------------------------------------------------- /a10/makefile: -------------------------------------------------------------------------------- 1 | clean: 2 | rm t 3 | rm t.* 4 | -------------------------------------------------------------------------------- /a11/makefile: -------------------------------------------------------------------------------- 1 | clean: 2 | rm t 3 | rm t.* 4 | -------------------------------------------------------------------------------- /a12/makefile: -------------------------------------------------------------------------------- 1 | clean: 2 | rm t 3 | rm t.* 4 | -------------------------------------------------------------------------------- /a13/makefile: -------------------------------------------------------------------------------- 1 | clean: 2 | rm t 3 | rm t.* 4 | -------------------------------------------------------------------------------- /a14/makefile: -------------------------------------------------------------------------------- 1 | clean: 2 | rm t 3 | rm t.* 4 | -------------------------------------------------------------------------------- /a15/makefile: -------------------------------------------------------------------------------- 1 | clean: 2 | rm t 3 | rm t.* 4 | -------------------------------------------------------------------------------- /a2/makefile: -------------------------------------------------------------------------------- 1 | clean: 2 | rm t 3 | rm t.* 4 | -------------------------------------------------------------------------------- /a3/makefile: -------------------------------------------------------------------------------- 1 | clean: 2 | rm t 3 | rm t.* 4 | -------------------------------------------------------------------------------- /a4/makefile: -------------------------------------------------------------------------------- 1 | clean: 2 | rm t 3 | rm t.* 4 | -------------------------------------------------------------------------------- /a5/makefile: -------------------------------------------------------------------------------- 1 | clean: 2 | rm t 3 | rm t.* 4 | -------------------------------------------------------------------------------- /a6/makefile: -------------------------------------------------------------------------------- 1 | clean: 2 | rm t 3 | rm t.* 4 | -------------------------------------------------------------------------------- /a7/makefile: -------------------------------------------------------------------------------- 1 | clean: 2 | rm t 3 | rm t.* 4 | -------------------------------------------------------------------------------- /a8/makefile: -------------------------------------------------------------------------------- 1 | clean: 2 | rm t 3 | rm t.* 4 | -------------------------------------------------------------------------------- /a9/makefile: -------------------------------------------------------------------------------- 1 | clean: 2 | rm t 3 | rm t.* 4 | -------------------------------------------------------------------------------- /doc/assign1.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/siriusdemon/iub_2009_P523_framework/HEAD/doc/assign1.pdf -------------------------------------------------------------------------------- /doc/assign10.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/siriusdemon/iub_2009_P523_framework/HEAD/doc/assign10.pdf -------------------------------------------------------------------------------- /doc/assign11.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/siriusdemon/iub_2009_P523_framework/HEAD/doc/assign11.pdf -------------------------------------------------------------------------------- /doc/assign13.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/siriusdemon/iub_2009_P523_framework/HEAD/doc/assign13.pdf -------------------------------------------------------------------------------- /doc/assign14.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/siriusdemon/iub_2009_P523_framework/HEAD/doc/assign14.pdf -------------------------------------------------------------------------------- /doc/assign15.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/siriusdemon/iub_2009_P523_framework/HEAD/doc/assign15.pdf -------------------------------------------------------------------------------- /doc/assign2.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/siriusdemon/iub_2009_P523_framework/HEAD/doc/assign2.pdf -------------------------------------------------------------------------------- /doc/assign3.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/siriusdemon/iub_2009_P523_framework/HEAD/doc/assign3.pdf -------------------------------------------------------------------------------- /doc/assign4.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/siriusdemon/iub_2009_P523_framework/HEAD/doc/assign4.pdf -------------------------------------------------------------------------------- /doc/assign5.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/siriusdemon/iub_2009_P523_framework/HEAD/doc/assign5.pdf -------------------------------------------------------------------------------- /doc/assign6.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/siriusdemon/iub_2009_P523_framework/HEAD/doc/assign6.pdf -------------------------------------------------------------------------------- /doc/assign7.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/siriusdemon/iub_2009_P523_framework/HEAD/doc/assign7.pdf -------------------------------------------------------------------------------- /doc/assign8.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/siriusdemon/iub_2009_P523_framework/HEAD/doc/assign8.pdf -------------------------------------------------------------------------------- /doc/assign9.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/siriusdemon/iub_2009_P523_framework/HEAD/doc/assign9.pdf -------------------------------------------------------------------------------- /a1/compiler-passes1.ss: -------------------------------------------------------------------------------- 1 | (compiler-passes 2 | '( 3 | verify-scheme 4 | generate-x86-64 5 | )) -------------------------------------------------------------------------------- /a2/compiler-passes2.ss: -------------------------------------------------------------------------------- 1 | (compiler-passes 2 | '( 3 | verify-scheme 4 | expose-frame-var 5 | flatten-program 6 | generate-x86-64 7 | )) -------------------------------------------------------------------------------- /a3/compiler-passes3.ss: -------------------------------------------------------------------------------- 1 | (compiler-passes 2 | '( 3 | verify-scheme 4 | finalize-locations 5 | expose-frame-var 6 | expose-basic-blocks 7 | flatten-program 8 | generate-x86-64 9 | )) -------------------------------------------------------------------------------- /a4/compiler-passes4.ss: -------------------------------------------------------------------------------- 1 | (compiler-passes 2 | '( 3 | verify-scheme 4 | uncover-register-conflict 5 | assign-registers 6 | discard-call-live 7 | finalize-locations 8 | expose-frame-var 9 | expose-basic-blocks 10 | flatten-program 11 | generate-x86-64 12 | )) -------------------------------------------------------------------------------- /a5/compiler-passes5.ss: -------------------------------------------------------------------------------- 1 | (compiler-passes '( 2 | verify-scheme 3 | uncover-frame-conflict 4 | introduce-allocation-forms 5 | (iterate 6 | select-instructions 7 | uncover-register-conflict 8 | assign-registers 9 | (break when everybody-home?) 10 | assign-frame 11 | finalize-frame-locations) 12 | discard-call-live 13 | finalize-locations 14 | expose-frame-var 15 | expose-basic-blocks 16 | flatten-program 17 | generate-x86-64 18 | )) -------------------------------------------------------------------------------- /a1/a1-main.ss: -------------------------------------------------------------------------------- 1 | (eval-when (compile load eval) 2 | (optimize-level 2) 3 | (case-sensitive #t) 4 | ) 5 | 6 | (load "../match.ss") 7 | (load "../helpers.ss") 8 | (load "../fmts.pretty") ;inform pretty-print about new forms 9 | (load "../driver.ss") 10 | (load "a1-wrapper.ss") 11 | (load "tests1.ss") 12 | (load "compiler-passes1.ss") 13 | 14 | 15 | (load "a1.ss") 16 | #!eof 17 | (tracer #f) 18 | (tracer #t) 19 | 20 | (load "a1-main.ss") 21 | (test-all) 22 | -------------------------------------------------------------------------------- /a2/a2-main.ss: -------------------------------------------------------------------------------- 1 | (eval-when (compile load eval) 2 | (optimize-level 2) 3 | (case-sensitive #t) 4 | ) 5 | 6 | (load "../match.ss") 7 | (load "../helpers.ss") 8 | (load "../fmts.pretty") ;inform pretty-print about new forms 9 | (load "../driver.ss") 10 | (load "a2-wrapper.ss") 11 | (load "tests2.ss") 12 | (load "compiler-passes2.ss") 13 | 14 | 15 | (load "a2.ss") 16 | #!eof 17 | (tracer #f) 18 | (tracer #t) 19 | 20 | (load "a2-main.ss") 21 | (test-all) 22 | -------------------------------------------------------------------------------- /a3/a3-main.ss: -------------------------------------------------------------------------------- 1 | (eval-when (compile load eval) 2 | (optimize-level 2) 3 | (case-sensitive #t) 4 | ) 5 | 6 | (load "../match.ss") 7 | (load "../helpers.ss") 8 | (load "../fmts.pretty") ;inform pretty-print about new forms 9 | (load "../driver.ss") 10 | (load "a3-wrapper.ss") 11 | (load "tests3.ss") 12 | (load "compiler-passes3.ss") 13 | 14 | 15 | (load "a3.ss") 16 | #!eof 17 | (tracer #f) 18 | (tracer #t) 19 | 20 | (load "a3-main.ss") 21 | (test-all) 22 | -------------------------------------------------------------------------------- /a4/a4-main.ss: -------------------------------------------------------------------------------- 1 | (eval-when (compile load eval) 2 | (optimize-level 2) 3 | (case-sensitive #t) 4 | ) 5 | 6 | (load "../match.ss") 7 | (load "../helpers.ss") 8 | (load "../fmts.pretty") ;inform pretty-print about new forms 9 | (load "../driver.ss") 10 | (load "a4-wrapper.ss") 11 | (load "tests4.ss") 12 | (load "compiler-passes4.ss") 13 | 14 | 15 | (load "a4.ss") 16 | #!eof 17 | (tracer #f) 18 | (tracer #t) 19 | 20 | (load "a4-main.ss") 21 | (test-all) 22 | -------------------------------------------------------------------------------- /a5/a5-main.ss: -------------------------------------------------------------------------------- 1 | (eval-when (compile load eval) 2 | (optimize-level 2) 3 | (case-sensitive #t) 4 | ) 5 | 6 | (load "../match.ss") 7 | (load "../helpers.ss") 8 | (load "../fmts.pretty") ;inform pretty-print about new forms 9 | (load "../driver.ss") 10 | (load "a5-wrapper.ss") 11 | (load "tests5.ss") 12 | (load "compiler-passes5.ss") 13 | 14 | 15 | (load "a5.ss") 16 | #!eof 17 | (tracer #f) 18 | (tracer #t) 19 | 20 | (load "a5-main.ss") 21 | (test-all) 22 | -------------------------------------------------------------------------------- /a6/a6-main.ss: -------------------------------------------------------------------------------- 1 | (eval-when (compile load eval) 2 | (optimize-level 2) 3 | (case-sensitive #t) 4 | ) 5 | 6 | (load "../match.ss") 7 | (load "../helpers.ss") 8 | (load "../fmts.pretty") ;inform pretty-print about new forms 9 | (load "../driver.ss") 10 | (load "a6-wrapper.ss") 11 | (load "tests6.ss") 12 | (load "compiler-passes6.ss") 13 | 14 | 15 | (load "a6.ss") 16 | #!eof 17 | (tracer #f) 18 | (tracer #t) 19 | 20 | (load "a6-main.ss") 21 | (test-all) 22 | -------------------------------------------------------------------------------- /a7/a7-main.ss: -------------------------------------------------------------------------------- 1 | (eval-when (compile load eval) 2 | (optimize-level 2) 3 | (case-sensitive #t) 4 | ) 5 | 6 | (load "../match.ss") 7 | (load "../helpers.ss") 8 | (load "../fmts.pretty") ;inform pretty-print about new forms 9 | (load "../driver.ss") 10 | (load "a7-wrapper.ss") 11 | (load "tests7.ss") 12 | (load "compiler-passes7.ss") 13 | 14 | 15 | (load "a7.ss") 16 | #!eof 17 | (tracer #f) 18 | (tracer #t) 19 | 20 | (load "a7-main.ss") 21 | (test-all) 22 | -------------------------------------------------------------------------------- /a8/a8-main.ss: -------------------------------------------------------------------------------- 1 | (eval-when (compile load eval) 2 | (optimize-level 2) 3 | (case-sensitive #t) 4 | ) 5 | 6 | (load "../match.ss") 7 | (load "../helpers.ss") 8 | (load "../fmts.pretty") ;inform pretty-print about new forms 9 | (load "../driver.ss") 10 | (load "a8-wrapper.ss") 11 | (load "tests8.ss") 12 | (load "compiler-passes8.ss") 13 | 14 | 15 | (load "a8.ss") 16 | #!eof 17 | (tracer #f) 18 | (tracer #t) 19 | 20 | (load "a8-main.ss") 21 | (test-all) 22 | -------------------------------------------------------------------------------- /a9/a9-main.ss: -------------------------------------------------------------------------------- 1 | (eval-when (compile load eval) 2 | (optimize-level 2) 3 | (case-sensitive #t) 4 | ) 5 | 6 | (load "../match.ss") 7 | (load "../helpers.ss") 8 | (load "../fmts.pretty") ;inform pretty-print about new forms 9 | (load "../driver.ss") 10 | (load "a9-wrapper.ss") 11 | (load "tests9.ss") 12 | (load "compiler-passes9.ss") 13 | 14 | 15 | (load "a9.ss") 16 | #!eof 17 | (tracer #f) 18 | (tracer #t) 19 | 20 | (load "a9-main.ss") 21 | (test-all) 22 | -------------------------------------------------------------------------------- /a10/a10-main.ss: -------------------------------------------------------------------------------- 1 | (eval-when (compile load eval) 2 | (optimize-level 2) 3 | (case-sensitive #t) 4 | ) 5 | 6 | (load "../match.ss") 7 | (load "../helpers.ss") 8 | (load "../fmts.pretty") ;inform pretty-print about new forms 9 | (load "../driver.ss") 10 | (load "a10-wrapper.ss") 11 | (load "tests10.ss") 12 | (load "compiler-passes10.ss") 13 | 14 | 15 | (load "a10.ss") 16 | #!eof 17 | (tracer #f) 18 | (tracer #t) 19 | 20 | (load "a10-main.ss") 21 | (test-all) 22 | -------------------------------------------------------------------------------- /a11/a11-main.ss: -------------------------------------------------------------------------------- 1 | (eval-when (compile load eval) 2 | (optimize-level 2) 3 | (case-sensitive #t) 4 | ) 5 | 6 | (load "../match.ss") 7 | (load "../helpers.ss") 8 | (load "../fmts.pretty") ;inform pretty-print about new forms 9 | (load "../driver.ss") 10 | (load "a11-wrapper.ss") 11 | (load "tests11.ss") 12 | (load "compiler-passes11.ss") 13 | 14 | 15 | (load "a11.ss") 16 | #!eof 17 | (tracer #f) 18 | (tracer #t) 19 | 20 | (load "a11-main.ss") 21 | (test-all) 22 | -------------------------------------------------------------------------------- /a12/a12-main.ss: -------------------------------------------------------------------------------- 1 | (eval-when (compile load eval) 2 | (optimize-level 2) 3 | (case-sensitive #t) 4 | ) 5 | 6 | (load "../match.ss") 7 | (load "../helpers.ss") 8 | (load "../fmts.pretty") ;inform pretty-print about new forms 9 | (load "../driver.ss") 10 | (load "a12-wrapper.ss") 11 | (load "tests12.ss") 12 | (load "compiler-passes12.ss") 13 | 14 | 15 | (load "a12.ss") 16 | #!eof 17 | (tracer #f) 18 | (tracer #t) 19 | 20 | (load "a12-main.ss") 21 | (test-all) 22 | -------------------------------------------------------------------------------- /a13/a13-main.ss: -------------------------------------------------------------------------------- 1 | (eval-when (compile load eval) 2 | (optimize-level 2) 3 | (case-sensitive #t) 4 | ) 5 | 6 | (load "../match.ss") 7 | (load "../helpers.ss") 8 | (load "../fmts.pretty") ;inform pretty-print about new forms 9 | (load "../driver.ss") 10 | (load "a13-wrapper.ss") 11 | (load "tests13.ss") 12 | (load "compiler-passes13.ss") 13 | 14 | 15 | (load "a13.ss") 16 | #!eof 17 | (tracer #f) 18 | (tracer #t) 19 | 20 | (load "a13-main.ss") 21 | (test-all) 22 | -------------------------------------------------------------------------------- /a14/a14-main.ss: -------------------------------------------------------------------------------- 1 | (eval-when (compile load eval) 2 | (optimize-level 2) 3 | (case-sensitive #t) 4 | ) 5 | 6 | (load "../match.ss") 7 | (load "../helpers.ss") 8 | (load "../fmts.pretty") ;inform pretty-print about new forms 9 | (load "../driver.ss") 10 | (load "a14-wrapper.ss") 11 | (load "tests14.ss") 12 | (load "compiler-passes14.ss") 13 | 14 | 15 | (load "a14.ss") 16 | #!eof 17 | (tracer #f) 18 | (tracer #t) 19 | 20 | (load "a14-main.ss") 21 | (test-all) 22 | -------------------------------------------------------------------------------- /a15/a15-main.ss: -------------------------------------------------------------------------------- 1 | (eval-when (compile load eval) 2 | (optimize-level 2) 3 | (case-sensitive #t) 4 | ) 5 | 6 | (load "../match.ss") 7 | (load "../helpers.ss") 8 | (load "../fmts.pretty") ;inform pretty-print about new forms 9 | (load "../driver.ss") 10 | (load "a15-wrapper.ss") 11 | (load "tests15.ss") 12 | (load "compiler-passes15.ss") 13 | 14 | 15 | (load "a15.ss") 16 | #!eof 17 | (tracer #f) 18 | (tracer #t) 19 | 20 | (load "a15-main.ss") 21 | (test-all) 22 | -------------------------------------------------------------------------------- /a1/runtime.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | #ifdef APPLE /* MacOS */ 5 | #define SCHEME_ENTRY scheme_entry 6 | #else 7 | #define SCHEME_ENTRY _scheme_entry 8 | #endif 9 | 10 | extern long SCHEME_ENTRY(void); 11 | 12 | void print(long x){ 13 | printf("%ld\n", x); 14 | } 15 | 16 | int main(int argc,char **argv){ 17 | /*no arguments at this point */ 18 | if (argc != 1) { 19 | fprintf(stderr, "usage: %s\n",argv[0]); 20 | exit(1); 21 | } 22 | 23 | print(SCHEME_ENTRY()); 24 | return 0; 25 | } 26 | -------------------------------------------------------------------------------- /a6/compiler-passes6.ss: -------------------------------------------------------------------------------- 1 | (compiler-passes '( 2 | verify-scheme 3 | remove-complex-opera* 4 | flatten-set! 5 | impose-calling-conventions 6 | uncover-frame-conflict 7 | introduce-allocation-forms 8 | (iterate 9 | select-instructions 10 | uncover-register-conflict 11 | assign-registers 12 | (break when everybody-home?) 13 | assign-frame 14 | finalize-frame-locations) 15 | discard-call-live 16 | finalize-locations 17 | expose-frame-var 18 | expose-basic-blocks 19 | flatten-program 20 | generate-x86-64 21 | )) -------------------------------------------------------------------------------- /a8/compiler-passes8.ss: -------------------------------------------------------------------------------- 1 | (compiler-passes '( 2 | verify-uil 3 | remove-complex-opera* 4 | flatten-set! 5 | impose-calling-conventions 6 | expose-allocation-pointer 7 | uncover-frame-conflict 8 | pre-assign-frame 9 | assign-new-frame 10 | (iterate 11 | finalize-frame-locations 12 | select-instructions 13 | uncover-register-conflict 14 | assign-registers 15 | (break when everybody-home?) 16 | assign-frame) 17 | discard-call-live 18 | finalize-locations 19 | expose-frame-var 20 | expose-memory-operands 21 | expose-basic-blocks 22 | flatten-program 23 | generate-x86-64 24 | )) -------------------------------------------------------------------------------- /a9/compiler-passes9.ss: -------------------------------------------------------------------------------- 1 | (compiler-passes '( 2 | verify-scheme 3 | uncover-locals 4 | remove-let 5 | verify-uil 6 | remove-complex-opera* 7 | flatten-set! 8 | impose-calling-conventions 9 | expose-allocation-pointer 10 | uncover-frame-conflict 11 | pre-assign-frame 12 | assign-new-frame 13 | (iterate 14 | finalize-frame-locations 15 | select-instructions 16 | uncover-register-conflict 17 | assign-registers 18 | (break when everybody-home?) 19 | assign-frame) 20 | discard-call-live 21 | finalize-locations 22 | expose-frame-var 23 | expose-memory-operands 24 | expose-basic-blocks 25 | flatten-program 26 | generate-x86-64 27 | )) -------------------------------------------------------------------------------- /a7/compiler-passes7.ss: -------------------------------------------------------------------------------- 1 | (compiler-passes '( 2 | verify-scheme 3 | remove-complex-opera* 4 | flatten-set! 5 | impose-calling-conventions 6 | uncover-frame-conflict 7 | pre-assign-frame 8 | assign-new-frame 9 | (iterate 10 | finalize-frame-locations ;;Note. This comes first now since we need to finalize frame locs from 11 | ;; previous assign-new-frame pass. 12 | select-instructions 13 | uncover-register-conflict 14 | assign-registers 15 | (break when everybody-home?) 16 | assign-frame) 17 | discard-call-live 18 | finalize-locations 19 | expose-frame-var 20 | expose-basic-blocks 21 | flatten-program 22 | generate-x86-64 23 | )) -------------------------------------------------------------------------------- /a10/compiler-passes10.ss: -------------------------------------------------------------------------------- 1 | (compiler-passes '( 2 | verify-scheme 3 | specify-representation 4 | uncover-locals 5 | remove-let 6 | verify-uil 7 | remove-complex-opera* 8 | flatten-set! 9 | impose-calling-conventions 10 | expose-allocation-pointer 11 | uncover-frame-conflict 12 | pre-assign-frame 13 | assign-new-frame 14 | (iterate 15 | finalize-frame-locations 16 | select-instructions 17 | uncover-register-conflict 18 | assign-registers 19 | (break when everybody-home?) 20 | assign-frame) 21 | discard-call-live 22 | finalize-locations 23 | expose-frame-var 24 | expose-memory-operands 25 | expose-basic-blocks 26 | flatten-program 27 | generate-x86-64 28 | )) -------------------------------------------------------------------------------- /a11/compiler-passes11.ss: -------------------------------------------------------------------------------- 1 | (compiler-passes '( 2 | verify-scheme 3 | lift-letrec 4 | normalize-context 5 | specify-representation 6 | uncover-locals 7 | remove-let 8 | verify-uil 9 | remove-complex-opera* 10 | flatten-set! 11 | impose-calling-conventions 12 | expose-allocation-pointer 13 | uncover-frame-conflict 14 | pre-assign-frame 15 | assign-new-frame 16 | (iterate 17 | finalize-frame-locations 18 | select-instructions 19 | uncover-register-conflict 20 | assign-registers 21 | (break when everybody-home?) 22 | assign-frame) 23 | discard-call-live 24 | finalize-locations 25 | expose-frame-var 26 | expose-memory-operands 27 | expose-basic-blocks 28 | optimize-jumps 29 | flatten-program 30 | generate-x86-64 31 | )) -------------------------------------------------------------------------------- /a12/compiler-passes12.ss: -------------------------------------------------------------------------------- 1 | (compiler-passes '( 2 | verify-scheme 3 | uncover-free 4 | convert-closures 5 | introduce-procedure-primitives 6 | optimize-source 7 | lift-letrec 8 | normalize-context 9 | specify-representation 10 | uncover-locals 11 | remove-let 12 | verify-uil 13 | remove-complex-opera* 14 | flatten-set! 15 | impose-calling-conventions 16 | expose-allocation-pointer 17 | uncover-frame-conflict 18 | pre-assign-frame 19 | assign-new-frame 20 | (iterate 21 | finalize-frame-locations 22 | select-instructions 23 | uncover-register-conflict 24 | assign-registers 25 | (break when everybody-home?) 26 | assign-frame) 27 | discard-call-live 28 | finalize-locations 29 | expose-frame-var 30 | expose-memory-operands 31 | expose-basic-blocks 32 | optimize-jumps 33 | flatten-program 34 | generate-x86-64 35 | )) -------------------------------------------------------------------------------- /fmts.pretty: -------------------------------------------------------------------------------- 1 | (pretty-format 'define-who '(_ x #f ...)) 2 | (pretty-format 'trace-define-who '(_ x #f ...)) 3 | (pretty-format 'match '(_ x #f [bracket e 0 ...] ...)) 4 | (pretty-format 'code '(_ #f e ...)) 5 | (pretty-format 'locals '(_ (var ...) #f e)) 6 | (pretty-format 'ulocals '(_ (var ...) #f e)) 7 | (pretty-format 'spills '(_ (var ...) #f e)) 8 | (pretty-format 'locate '(_ ([bracket var loc] 0 ...) #f e)) 9 | (pretty-format 'register-conflict '(_ ([bracket fill 0 x ...] 0 ...) #f e)) 10 | (pretty-format 'frame-conflict '(_ ([bracket fill 0 x ...] 0 ...) #f e)) 11 | (pretty-format 'new-frames '(_ ((var ...) 0 ...) #f e)) 12 | (pretty-format 'return-point '(_ rplab #f e)) 13 | (pretty-format 'call-live '(_ (var ...) #f e)) 14 | (pretty-format 'free '(_ x #f e)) 15 | (pretty-format 'closures '(_ ([bracket x ...] 0 ...) #f e ...)) 16 | (pretty-format 'bind-free '(_ x #f e)) 17 | (pretty-format 'well-known '(_ x #f e)) 18 | (pretty-format 'assigned '(_ x #f e)) 19 | -------------------------------------------------------------------------------- /a1/a1-wrapper.ss: -------------------------------------------------------------------------------- 1 | (language-wrapper 2 | (lambda (pass-name x) 3 | (case pass-name 4 | [(source verify-scheme) 5 | `(let () 6 | (import (except scheme set!)) 7 | (define int64-in-range? 8 | (lambda (x) 9 | (<= (- (expt 2 63)) x (- (expt 2 63) 1)))) 10 | (define handle-overflow 11 | (lambda (x) 12 | (cond 13 | [(not (number? x)) x] 14 | [(int64-in-range? x) x] 15 | [(not (= x (logand 18446744073709551615 x))) 16 | (handle-overflow (logand 18446744073709551615 x))] 17 | [(< x 0) (handle-overflow (+ x (expt 2 64)))] 18 | [else (handle-overflow (- x (expt 2 64)))]))) 19 | (define-syntax set! 20 | (let () 21 | (import scheme) 22 | (syntax-rules () 23 | [(_ x expr) (set! x (handle-overflow expr))]))) 24 | ,x 25 | rax)] 26 | [else x]))) 27 | -------------------------------------------------------------------------------- /a13/compiler-passes13.ss: -------------------------------------------------------------------------------- 1 | (compiler-passes '( 2 | verify-scheme 3 | optimize-direct-call 4 | remove-anonymous-lambda 5 | sanitize-binding-forms 6 | uncover-free 7 | convert-closures 8 | optimize-known-call 9 | introduce-procedure-primitives 10 | optimize-source 11 | lift-letrec 12 | normalize-context 13 | specify-representation 14 | uncover-locals 15 | remove-let 16 | verify-uil 17 | remove-complex-opera* 18 | flatten-set! 19 | impose-calling-conventions 20 | expose-allocation-pointer 21 | uncover-frame-conflict 22 | pre-assign-frame 23 | assign-new-frame 24 | (iterate 25 | finalize-frame-locations 26 | select-instructions 27 | uncover-register-conflict 28 | assign-registers 29 | (break when everybody-home?) 30 | assign-frame) 31 | discard-call-live 32 | finalize-locations 33 | expose-frame-var 34 | expose-memory-operands 35 | expose-basic-blocks 36 | optimize-jumps 37 | flatten-program 38 | generate-x86-64 39 | )) -------------------------------------------------------------------------------- /a14/compiler-passes14.ss: -------------------------------------------------------------------------------- 1 | (compiler-passes '( 2 | verify-scheme 3 | convert-complex-datum 4 | uncover-assigned 5 | purify-letrec 6 | convert-assignments 7 | optimize-direct-call 8 | remove-anonymous-lambda 9 | sanitize-binding-forms 10 | uncover-free 11 | convert-closures 12 | optimize-known-call 13 | introduce-procedure-primitives 14 | optimize-source 15 | lift-letrec 16 | normalize-context 17 | specify-representation 18 | uncover-locals 19 | remove-let 20 | verify-uil 21 | remove-complex-opera* 22 | flatten-set! 23 | impose-calling-conventions 24 | expose-allocation-pointer 25 | uncover-frame-conflict 26 | pre-assign-frame 27 | assign-new-frame 28 | (iterate 29 | finalize-frame-locations 30 | select-instructions 31 | uncover-register-conflict 32 | assign-registers 33 | (break when everybody-home?) 34 | assign-frame) 35 | discard-call-live 36 | finalize-locations 37 | expose-frame-var 38 | expose-memory-operands 39 | expose-basic-blocks 40 | optimize-jumps 41 | flatten-program 42 | generate-x86-64 43 | )) -------------------------------------------------------------------------------- /a15/compiler-passes15.ss: -------------------------------------------------------------------------------- 1 | (compiler-passes '( 2 | parse-scheme 3 | convert-complex-datum 4 | uncover-assigned 5 | purify-letrec 6 | convert-assignments 7 | optimize-direct-call 8 | remove-anonymous-lambda 9 | sanitize-binding-forms 10 | uncover-free 11 | convert-closures 12 | analyze-closure-size 13 | optimize-known-call 14 | uncover-well-known 15 | optimize-free 16 | optimize-self-reference 17 | analyze-closure-size 18 | introduce-procedure-primitives 19 | optimize-source 20 | lift-letrec 21 | normalize-context 22 | specify-representation 23 | uncover-locals 24 | remove-let 25 | verify-uil 26 | remove-complex-opera* 27 | flatten-set! 28 | impose-calling-conventions 29 | expose-allocation-pointer 30 | uncover-frame-conflict 31 | pre-assign-frame 32 | assign-new-frame 33 | (iterate 34 | finalize-frame-locations 35 | select-instructions 36 | uncover-register-conflict 37 | assign-registers 38 | (break when everybody-home?) 39 | assign-frame) 40 | discard-call-live 41 | finalize-locations 42 | expose-frame-var 43 | expose-memory-operands 44 | expose-basic-blocks 45 | optimize-jumps 46 | flatten-program 47 | generate-x86-64 48 | )) -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # iub_2009_P523_framework 2 | This is my rearrangement of IUB 2009 P523 uploaded files opensourced on github in different repos. 3 | All copyright belongs to R. Kent/A. Keep and IUB faulty.I'll delete this repo immediately if there was any copyright issue. 4 | Compiler passes and wrappers copied from https://github.com/esaliya/SchemeStack 5 | Helpers copied from https://github.com/tiancaiamao/yscheme 6 | 7 | To use this framework.under every a{i} folder,implement a{i}.ss containing all the functions needed by compiler_passes{i}.ss.Then load the a{i}_main.ss and (test-all) or (test-all-invalid). 8 | Feel free to modify compiler-passes.It's just a helper anyway. 9 | More useful functions and documentation can be found in driver.ss 10 | 11 | I only partially tested this framework I collected under ChezScheme 9.5 12 | 13 | For every assignment done.You will get a working little scheme compiler that compiles a tiny language to assembly code. 14 | Finally,the tiny language will be a subset of scheme in assignment 15. 15 | 16 | 17 | More related resources are 18 | https://github.com/akeep/nanopass-framework 19 | A Nanopass Framework for Compiler Education 20 | A nanopass framework for commercial compiler development 21 | https://github.com/yinwang0/yscheme 22 | https://github.com/keyz/p423-compiler 23 | -------------------------------------------------------------------------------- /a1/tests1.ss: -------------------------------------------------------------------------------- 1 | (define invalid-tests 2 | '(5 3 | (set! rax 5) 4 | (begin 5) 5 | (begin (set! x 5)) 6 | (begin (set! 5 x)) 7 | (begin (set! (set! rax 5) 100)) 8 | (begin (set! rax 9223372036854775808)) 9 | (begin (set! rax -9223372036854775809)) 10 | (begin (set! rax x)) 11 | (begin (set! rax (set! rax 5))) 12 | (begin (set! rax (+ rbx rax))) 13 | (begin (set! rax (+ 5 rax))) 14 | (begin (set! rax (+ r11 100))) 15 | (begin (set! rax (+ rax 2147483648))) 16 | (begin (set! rax (+ rax -2147483649))) 17 | (begin (set! rax (^ rax 2))) 18 | (begin (set! rax (/ rax 2))) 19 | (begin (set! r16 (+ r16 2))) 20 | (begin (set! r7 (+ r7 2))))) 21 | 22 | (define tests 23 | '((begin (set! rax 5)) 24 | (begin (set! r11 5) (set! rax r11)) 25 | (begin (set! r11 10) (set! rax -10) (set! rax (* rax r11))) 26 | (begin (set! r11 10) (set! r11 (* r11 -10)) (set! rax r11)) 27 | (begin (set! rax 5) (set! rax (+ rax 10))) 28 | (begin (set! r8 5) (set! rax 10) (set! rax (+ rax r8))) 29 | (begin (set! rax 7) (set! rax (+ rax 4))) 30 | (begin (set! rax 7) (set! rax (- rax 4))) 31 | (begin (set! rax 7) (set! rax (* rax 4))) 32 | (begin (set! rax 5) (set! rbx -11) (set! rax (+ rax rbx))) 33 | (begin (set! rax 5) (set! rbx -11) (set! rax (- rax rbx))) 34 | (begin (set! rax 5) (set! rbx -11) (set! rax (* rax rbx))) 35 | 36 | ;; some tests dealing with overflow 37 | (begin (set! rax -9223372036854775808) (set! rax (- rax 5))) 38 | (begin (set! rax 9223372036854775807) (set! rax (+ rax 5))) 39 | (begin (set! rax 1000000000000000000) (set! rax (* rax rax))) 40 | (begin (set! rax 1000000000000000000) 41 | (set! rbx -1) 42 | (set! rbx (* rbx rax)) 43 | (set! rax (* rax rbx))) 44 | 45 | ;; Factorial 5 - the long way. 46 | (begin (set! rax 5) 47 | (set! rbx 1) 48 | (set! rbx (* rbx rax)) 49 | (set! rax (- rax 1)) 50 | (set! rbx (* rbx rax)) 51 | (set! rax (- rax 1)) 52 | (set! rbx (* rbx rax)) 53 | (set! rax (- rax 1)) 54 | (set! rbx (* rbx rax)) 55 | (set! rax rbx)))) 56 | 57 | -------------------------------------------------------------------------------- /a2/a2-wrapper.ss: -------------------------------------------------------------------------------- 1 | (language-wrapper 2 | (lambda (pass-name x) 3 | (define rewrite-opnds 4 | (lambda (x) 5 | (match x 6 | [,r (guard (disp-opnd? r)) 7 | `(mref ,(disp-opnd-reg r) ,(disp-opnd-offset r))] 8 | [,r (guard (index-opnd? r)) 9 | `(mref ,(index-opnd-breg r) ,(index-opnd-ireg r))] 10 | [(set! ,r ,[expr]) (guard (disp-opnd? r)) 11 | `(mset! ,(disp-opnd-reg r) ,(disp-opnd-offset r) ,expr)] 12 | [(set! ,r ,[expr]) (guard (index-opnd? r)) 13 | `(mset! ,(index-opnd-breg r) ,(index-opnd-ireg r) ,expr)] 14 | [(,[expr] ...) `(,expr ...)] 15 | [,x x]))) 16 | (case pass-name 17 | [(source verify-scheme) 18 | `(let () 19 | (import (except scheme set!)) 20 | (define int64-in-range? 21 | (lambda (x) 22 | (<= (- (expt 2 63)) x (- (expt 2 63) 1)))) 23 | (define handle-overflow 24 | (lambda (x) 25 | (cond 26 | [(not (number? x)) x] 27 | [(int64-in-range? x) x] 28 | [(not (= x (logand 18446744073709551615 x))) 29 | (handle-overflow (logand 18446744073709551615 x))] 30 | [(< x 0) (handle-overflow (+ x (expt 2 64)))] 31 | [else (handle-overflow (- x (expt 2 64)))]))) 32 | (define-syntax set! 33 | (let () 34 | (import scheme) 35 | (syntax-rules () 36 | [(_ x expr) 37 | (set! x (handle-overflow expr))]))) 38 | (call/cc 39 | (lambda (k) 40 | (set! r15 k) 41 | ,x)) 42 | rax)] 43 | [(expose-frame-var) 44 | `(let () 45 | (import (except scheme set!)) 46 | (define int64-in-range? 47 | (lambda (x) 48 | (<= (- (expt 2 63)) x (- (expt 2 63) 1)))) 49 | (define handle-overflow 50 | (lambda (x) 51 | (cond 52 | [(not (number? x)) x] 53 | [(int64-in-range? x) x] 54 | [(not (= x (logand 18446744073709551615 x))) 55 | (handle-overflow (logand 18446744073709551615 x))] 56 | [(< x 0) (handle-overflow (+ x (expt 2 64)))] 57 | [else (handle-overflow (- x (expt 2 64)))]))) 58 | (define-syntax set! 59 | (let () 60 | (import scheme) 61 | (syntax-rules () 62 | [(_ x expr) 63 | (set! x (handle-overflow expr))]))) 64 | (call/cc 65 | (lambda (k) 66 | (set! r15 k) 67 | ,(rewrite-opnds x))) 68 | rax)] 69 | [(flatten-program) 70 | `(let () 71 | (import (except scheme set!)) 72 | (define int64-in-range? 73 | (lambda (x) 74 | (<= (- (expt 2 63)) x (- (expt 2 63) 1)))) 75 | (define handle-overflow 76 | (lambda (x) 77 | (cond 78 | [(not (number? x)) x] 79 | [(int64-in-range? x) x] 80 | [(not (= x (logand 18446744073709551615 x))) 81 | (handle-overflow (logand 18446744073709551615 x))] 82 | [(< x 0) (handle-overflow (+ x (expt 2 64)))] 83 | [else (handle-overflow (- x (expt 2 64)))]))) 84 | (define-syntax set! 85 | (let () 86 | (import scheme) 87 | (syntax-rules () 88 | [(_ x expr) 89 | (set! x (handle-overflow expr))]))) 90 | (define-syntax code 91 | (lambda (x) 92 | (define build 93 | (lambda (body) 94 | (syntax-case body () 95 | [() #'(())] 96 | [(label expr ...) 97 | (identifier? #'label) 98 | (with-syntax ([((expr ...) defn ...) (build #'(expr ...))]) 99 | #'(((bounce label)) 100 | (define label 101 | (lambda () 102 | (bounce (lambda () expr ...)))) 103 | defn ...))] 104 | [(expr1 expr ...) 105 | (with-syntax ([((expr ...) defn ...) (build #'(expr ...))]) 106 | #'((expr1 expr ...) defn ...))]))) 107 | (syntax-case x () 108 | [(k expr ...) 109 | (with-syntax ([((expr ...) defn ...) (build #'(expr ...))]) 110 | #'((call/cc 111 | (lambda (bounce) 112 | defn ... 113 | expr ...))))]))) 114 | (define-syntax jump 115 | (syntax-rules () 116 | [(_ target) (target)])) 117 | (call/cc 118 | (lambda (k) 119 | (set! r15 k) 120 | ,(rewrite-opnds x))) 121 | rax)] 122 | [else x]))) 123 | -------------------------------------------------------------------------------- /a2/runtime.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | 12 | #define stack_size 100000 13 | #define heap_size 100000 14 | 15 | #ifdef __APPLE__ 16 | #define SCHEME_ENTRY scheme_entry 17 | #endif 18 | #ifdef __linux__ 19 | #define SCHEME_ENTRY _scheme_entry 20 | #endif 21 | 22 | extern long SCHEME_ENTRY(char *, char *); 23 | 24 | /* locally defined functions */ 25 | static char *guarded_area(long n); 26 | #ifdef __APPLE__ 27 | static void segv_handler(int signo, siginfo_t *info, void *ignore); 28 | #endif 29 | #ifdef __linux__ 30 | static void segv_handler(int signo, struct sigcontext sc); 31 | #endif 32 | static void bus_handler(int signo); 33 | static void usage_error(char *who); 34 | static void print(long x); 35 | 36 | /* local stack/heap management variables */ 37 | static long pagesize; 38 | static char *heap; 39 | static char *stack; 40 | static long heapsize; 41 | static long stacksize; 42 | 43 | int main(int argc, char *argv[]) { 44 | struct sigaction action; 45 | sigset_t s_set; 46 | int n; 47 | 48 | pagesize = sysconf(_SC_PAGESIZE); 49 | 50 | stacksize = stack_size * sizeof(void *); 51 | heapsize = heap_size * sizeof(void *); 52 | 53 | for (n = 1; n < argc; n++) 54 | if ((*argv[n] == '-') && (*(argv[n]+2) == 0)) 55 | switch (*(argv[n]+1)) { 56 | case 'h': /* heap size option */ 57 | argv[n] = (char *)NULL; 58 | if (++n == argc) usage_error(argv[0]); 59 | heapsize = atoi(argv[n]); 60 | if (heapsize <= 0) usage_error(argv[0]); 61 | break; 62 | case 's': /* stack size option */ 63 | argv[n] = (char *)NULL; 64 | if (++n == argc) usage_error(argv[0]); 65 | stacksize = atoi(argv[n]); 66 | if (stacksize <= 0) usage_error(argv[0]); 67 | break; 68 | default: 69 | usage_error(argv[0]); 70 | } 71 | else 72 | usage_error(argv[0]); 73 | 74 | /* round stack and heap sizes to even pages */ 75 | stacksize = ((stacksize + pagesize - 1) / pagesize) * pagesize; 76 | heapsize = ((heapsize + pagesize - 1) / pagesize) * pagesize; 77 | 78 | stack = guarded_area(stacksize); 79 | heap = guarded_area(heapsize); 80 | 81 | /* Set up segmentation fault signal handler to catch stack and heap 82 | * overflow and some memory faults */ 83 | sigemptyset(&s_set); 84 | #ifdef __linux__ 85 | action.sa_handler = (void *)segv_handler; 86 | action.sa_flags = SA_RESETHAND; 87 | #else 88 | action.sa_sigaction = segv_handler; 89 | action.sa_flags = SA_SIGINFO | SA_RESETHAND; 90 | #endif 91 | action.sa_mask = s_set; 92 | if (sigaction(SIGSEGV, &action, NULL)) { 93 | fprintf(stderr, "sigaction failed: %s\n", strerror(errno)); 94 | fprintf(stderr, " overflow checking may not work\n"); 95 | } 96 | 97 | /* Set up bus error signal handler to catch remaining memory faults */ 98 | sigemptyset(&s_set); 99 | action.sa_handler = bus_handler; 100 | action.sa_mask = s_set; 101 | action.sa_flags = SA_RESETHAND; 102 | if (sigaction(SIGBUS, &action, NULL)) { 103 | fprintf(stderr, "sigaction failed: %s\n", strerror(errno)); 104 | } 105 | 106 | /* run the Scheme program and print the result */ 107 | print(SCHEME_ENTRY(stack, heap)); 108 | printf("\n"); 109 | 110 | return 0; 111 | } 112 | 113 | /* allocate a chunk of memory with a guard page on either end */ 114 | static char *guarded_area(long n) { /* n must be page aligned */ 115 | char *addr; 116 | 117 | /* allocate, leaving room for guard pages */ 118 | addr = (char *)mmap(NULL, 119 | (size_t)(n + 2 * pagesize), 120 | PROT_READ | PROT_WRITE, 121 | MAP_PRIVATE | MAP_ANON, 122 | -1, 0); 123 | if (addr == (char *)-1) { 124 | fprintf(stderr, "mmap failed: %s\n", strerror(errno)); 125 | exit(2); 126 | } 127 | 128 | /* remove access rights from the guard pages */ 129 | if (mprotect(addr, (size_t)pagesize, PROT_NONE) || 130 | mprotect(addr + pagesize + n, (size_t)pagesize, PROT_NONE)) { 131 | fprintf(stderr, "mprotect failed: %s\n", strerror(errno)); 132 | exit(3); 133 | } 134 | 135 | return addr + pagesize; 136 | } 137 | 138 | /* Signal handler that traps SIGSEGV and checks if the violation 139 | * might have been caused by stack or heap overflow */ 140 | #ifdef __APPLE__ 141 | static void segv_handler(int signo, siginfo_t *info, void *ingore) { 142 | #endif 143 | #ifdef __linux__ 144 | static void segv_handler(int signo, struct sigcontext sc) { 145 | #endif 146 | char *addr; 147 | 148 | #ifdef __APPLE__ 149 | addr = (char *)info->si_addr; 150 | #endif 151 | #ifdef __linux__ 152 | addr = (char *)(sc.cr2); 153 | #endif 154 | 155 | if (heap-pagesize <= addr && addr < heap) { 156 | fprintf(stderr,"invalid access just below the heap\n"); 157 | } else if (heap+heapsize <= addr && addr <= heap+heapsize+pagesize) { 158 | fprintf(stderr,"invalid access just above the heap\n"); 159 | } else if (stack-pagesize <= addr && addr < stack) { 160 | fprintf(stderr,"invalid access just below the stack\n"); 161 | } else if (stack+stacksize <= addr && addr < stack+stacksize+pagesize) { 162 | fprintf(stderr,"invalid access just above the stack\n"); 163 | } else { 164 | fprintf(stderr, "Segmentation violation\n"); 165 | } 166 | 167 | exit(-1); 168 | } 169 | 170 | /* Signal handler for bus errors */ 171 | static void bus_handler(int signo) { 172 | fprintf(stderr, "Bus error\n"); 173 | exit(-1); 174 | } 175 | 176 | static void usage_error(char *who) { 177 | fprintf(stderr, "usage: %s [-h ] [-s ]\n", who); 178 | fprintf(stderr, " specify sizes in pages (base 10)\n"); 179 | fprintf(stderr, " page size is %ld bytes\n",pagesize); 180 | exit(1); 181 | } 182 | 183 | static void print(long x) { 184 | printf("%ld", x); 185 | } 186 | -------------------------------------------------------------------------------- /a3/runtime.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | 12 | #define stack_size 100000 13 | #define heap_size 100000 14 | 15 | #ifdef __APPLE__ 16 | #define SCHEME_ENTRY scheme_entry 17 | #endif 18 | #ifdef __linux__ 19 | #define SCHEME_ENTRY _scheme_entry 20 | #endif 21 | 22 | extern long SCHEME_ENTRY(char *, char *); 23 | 24 | /* locally defined functions */ 25 | static char *guarded_area(long n); 26 | #ifdef __APPLE__ 27 | static void segv_handler(int signo, siginfo_t *info, void *ignore); 28 | #endif 29 | #ifdef __linux__ 30 | static void segv_handler(int signo, struct sigcontext sc); 31 | #endif 32 | static void bus_handler(int signo); 33 | static void usage_error(char *who); 34 | static void print(long x); 35 | 36 | /* local stack/heap management variables */ 37 | static long pagesize; 38 | static char *heap; 39 | static char *stack; 40 | static long heapsize; 41 | static long stacksize; 42 | 43 | int main(int argc, char *argv[]) { 44 | struct sigaction action; 45 | sigset_t s_set; 46 | int n; 47 | 48 | pagesize = sysconf(_SC_PAGESIZE); 49 | 50 | stacksize = stack_size * sizeof(void *); 51 | heapsize = heap_size * sizeof(void *); 52 | 53 | for (n = 1; n < argc; n++) 54 | if ((*argv[n] == '-') && (*(argv[n]+2) == 0)) 55 | switch (*(argv[n]+1)) { 56 | case 'h': /* heap size option */ 57 | argv[n] = (char *)NULL; 58 | if (++n == argc) usage_error(argv[0]); 59 | heapsize = atoi(argv[n]); 60 | if (heapsize <= 0) usage_error(argv[0]); 61 | break; 62 | case 's': /* stack size option */ 63 | argv[n] = (char *)NULL; 64 | if (++n == argc) usage_error(argv[0]); 65 | stacksize = atoi(argv[n]); 66 | if (stacksize <= 0) usage_error(argv[0]); 67 | break; 68 | default: 69 | usage_error(argv[0]); 70 | } 71 | else 72 | usage_error(argv[0]); 73 | 74 | /* round stack and heap sizes to even pages */ 75 | stacksize = ((stacksize + pagesize - 1) / pagesize) * pagesize; 76 | heapsize = ((heapsize + pagesize - 1) / pagesize) * pagesize; 77 | 78 | stack = guarded_area(stacksize); 79 | heap = guarded_area(heapsize); 80 | 81 | /* Set up segmentation fault signal handler to catch stack and heap 82 | * overflow and some memory faults */ 83 | sigemptyset(&s_set); 84 | #ifdef __linux__ 85 | action.sa_handler = (void *)segv_handler; 86 | action.sa_flags = SA_RESETHAND; 87 | #else 88 | action.sa_sigaction = segv_handler; 89 | action.sa_flags = SA_SIGINFO | SA_RESETHAND; 90 | #endif 91 | action.sa_mask = s_set; 92 | if (sigaction(SIGSEGV, &action, NULL)) { 93 | fprintf(stderr, "sigaction failed: %s\n", strerror(errno)); 94 | fprintf(stderr, " overflow checking may not work\n"); 95 | } 96 | 97 | /* Set up bus error signal handler to catch remaining memory faults */ 98 | sigemptyset(&s_set); 99 | action.sa_handler = bus_handler; 100 | action.sa_mask = s_set; 101 | action.sa_flags = SA_RESETHAND; 102 | if (sigaction(SIGBUS, &action, NULL)) { 103 | fprintf(stderr, "sigaction failed: %s\n", strerror(errno)); 104 | } 105 | 106 | /* run the Scheme program and print the result */ 107 | print(SCHEME_ENTRY(stack, heap)); 108 | printf("\n"); 109 | 110 | return 0; 111 | } 112 | 113 | /* allocate a chunk of memory with a guard page on either end */ 114 | static char *guarded_area(long n) { /* n must be page aligned */ 115 | char *addr; 116 | 117 | /* allocate, leaving room for guard pages */ 118 | addr = (char *)mmap(NULL, 119 | (size_t)(n + 2 * pagesize), 120 | PROT_READ | PROT_WRITE, 121 | MAP_PRIVATE | MAP_ANON, 122 | -1, 0); 123 | if (addr == (char *)-1) { 124 | fprintf(stderr, "mmap failed: %s\n", strerror(errno)); 125 | exit(2); 126 | } 127 | 128 | /* remove access rights from the guard pages */ 129 | if (mprotect(addr, (size_t)pagesize, PROT_NONE) || 130 | mprotect(addr + pagesize + n, (size_t)pagesize, PROT_NONE)) { 131 | fprintf(stderr, "mprotect failed: %s\n", strerror(errno)); 132 | exit(3); 133 | } 134 | 135 | return addr + pagesize; 136 | } 137 | 138 | /* Signal handler that traps SIGSEGV and checks if the violation 139 | * might have been caused by stack or heap overflow */ 140 | #ifdef __APPLE__ 141 | static void segv_handler(int signo, siginfo_t *info, void *ingore) { 142 | #endif 143 | #ifdef __linux__ 144 | static void segv_handler(int signo, struct sigcontext sc) { 145 | #endif 146 | char *addr; 147 | 148 | #ifdef __APPLE__ 149 | addr = (char *)info->si_addr; 150 | #endif 151 | #ifdef __linux__ 152 | addr = (char *)(sc.cr2); 153 | #endif 154 | 155 | if (heap-pagesize <= addr && addr < heap) { 156 | fprintf(stderr,"invalid access just below the heap\n"); 157 | } else if (heap+heapsize <= addr && addr <= heap+heapsize+pagesize) { 158 | fprintf(stderr,"invalid access just above the heap\n"); 159 | } else if (stack-pagesize <= addr && addr < stack) { 160 | fprintf(stderr,"invalid access just below the stack\n"); 161 | } else if (stack+stacksize <= addr && addr < stack+stacksize+pagesize) { 162 | fprintf(stderr,"invalid access just above the stack\n"); 163 | } else { 164 | fprintf(stderr, "Segmentation violation\n"); 165 | } 166 | 167 | exit(-1); 168 | } 169 | 170 | /* Signal handler for bus errors */ 171 | static void bus_handler(int signo) { 172 | fprintf(stderr, "Bus error\n"); 173 | exit(-1); 174 | } 175 | 176 | static void usage_error(char *who) { 177 | fprintf(stderr, "usage: %s [-h ] [-s ]\n", who); 178 | fprintf(stderr, " specify sizes in pages (base 10)\n"); 179 | fprintf(stderr, " page size is %ld bytes\n",pagesize); 180 | exit(1); 181 | } 182 | 183 | static void print(long x) { 184 | printf("%ld", x); 185 | } 186 | -------------------------------------------------------------------------------- /a4/runtime.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | 12 | #define stack_size 100000 13 | #define heap_size 100000 14 | 15 | #ifdef __APPLE__ 16 | #define SCHEME_ENTRY scheme_entry 17 | #endif 18 | #ifdef __linux__ 19 | #define SCHEME_ENTRY _scheme_entry 20 | #endif 21 | 22 | extern long SCHEME_ENTRY(char *, char *); 23 | 24 | /* locally defined functions */ 25 | static char *guarded_area(long n); 26 | #ifdef __APPLE__ 27 | static void segv_handler(int signo, siginfo_t *info, void *ignore); 28 | #endif 29 | #ifdef __linux__ 30 | static void segv_handler(int signo, struct sigcontext sc); 31 | #endif 32 | static void bus_handler(int signo); 33 | static void usage_error(char *who); 34 | static void print(long x); 35 | 36 | /* local stack/heap management variables */ 37 | static long pagesize; 38 | static char *heap; 39 | static char *stack; 40 | static long heapsize; 41 | static long stacksize; 42 | 43 | int main(int argc, char *argv[]) { 44 | struct sigaction action; 45 | sigset_t s_set; 46 | int n; 47 | 48 | pagesize = sysconf(_SC_PAGESIZE); 49 | 50 | stacksize = stack_size * sizeof(void *); 51 | heapsize = heap_size * sizeof(void *); 52 | 53 | for (n = 1; n < argc; n++) 54 | if ((*argv[n] == '-') && (*(argv[n]+2) == 0)) 55 | switch (*(argv[n]+1)) { 56 | case 'h': /* heap size option */ 57 | argv[n] = (char *)NULL; 58 | if (++n == argc) usage_error(argv[0]); 59 | heapsize = atoi(argv[n]); 60 | if (heapsize <= 0) usage_error(argv[0]); 61 | break; 62 | case 's': /* stack size option */ 63 | argv[n] = (char *)NULL; 64 | if (++n == argc) usage_error(argv[0]); 65 | stacksize = atoi(argv[n]); 66 | if (stacksize <= 0) usage_error(argv[0]); 67 | break; 68 | default: 69 | usage_error(argv[0]); 70 | } 71 | else 72 | usage_error(argv[0]); 73 | 74 | /* round stack and heap sizes to even pages */ 75 | stacksize = ((stacksize + pagesize - 1) / pagesize) * pagesize; 76 | heapsize = ((heapsize + pagesize - 1) / pagesize) * pagesize; 77 | 78 | stack = guarded_area(stacksize); 79 | heap = guarded_area(heapsize); 80 | 81 | /* Set up segmentation fault signal handler to catch stack and heap 82 | * overflow and some memory faults */ 83 | sigemptyset(&s_set); 84 | #ifdef __linux__ 85 | action.sa_handler = (void *)segv_handler; 86 | action.sa_flags = SA_RESETHAND; 87 | #else 88 | action.sa_sigaction = segv_handler; 89 | action.sa_flags = SA_SIGINFO | SA_RESETHAND; 90 | #endif 91 | action.sa_mask = s_set; 92 | if (sigaction(SIGSEGV, &action, NULL)) { 93 | fprintf(stderr, "sigaction failed: %s\n", strerror(errno)); 94 | fprintf(stderr, " overflow checking may not work\n"); 95 | } 96 | 97 | /* Set up bus error signal handler to catch remaining memory faults */ 98 | sigemptyset(&s_set); 99 | action.sa_handler = bus_handler; 100 | action.sa_mask = s_set; 101 | action.sa_flags = SA_RESETHAND; 102 | if (sigaction(SIGBUS, &action, NULL)) { 103 | fprintf(stderr, "sigaction failed: %s\n", strerror(errno)); 104 | } 105 | 106 | /* run the Scheme program and print the result */ 107 | print(SCHEME_ENTRY(stack, heap)); 108 | printf("\n"); 109 | 110 | return 0; 111 | } 112 | 113 | /* allocate a chunk of memory with a guard page on either end */ 114 | static char *guarded_area(long n) { /* n must be page aligned */ 115 | char *addr; 116 | 117 | /* allocate, leaving room for guard pages */ 118 | addr = (char *)mmap(NULL, 119 | (size_t)(n + 2 * pagesize), 120 | PROT_READ | PROT_WRITE, 121 | MAP_PRIVATE | MAP_ANON, 122 | -1, 0); 123 | if (addr == (char *)-1) { 124 | fprintf(stderr, "mmap failed: %s\n", strerror(errno)); 125 | exit(2); 126 | } 127 | 128 | /* remove access rights from the guard pages */ 129 | if (mprotect(addr, (size_t)pagesize, PROT_NONE) || 130 | mprotect(addr + pagesize + n, (size_t)pagesize, PROT_NONE)) { 131 | fprintf(stderr, "mprotect failed: %s\n", strerror(errno)); 132 | exit(3); 133 | } 134 | 135 | return addr + pagesize; 136 | } 137 | 138 | /* Signal handler that traps SIGSEGV and checks if the violation 139 | * might have been caused by stack or heap overflow */ 140 | #ifdef __APPLE__ 141 | static void segv_handler(int signo, siginfo_t *info, void *ingore) { 142 | #endif 143 | #ifdef __linux__ 144 | static void segv_handler(int signo, struct sigcontext sc) { 145 | #endif 146 | char *addr; 147 | 148 | #ifdef __APPLE__ 149 | addr = (char *)info->si_addr; 150 | #endif 151 | #ifdef __linux__ 152 | addr = (char *)(sc.cr2); 153 | #endif 154 | 155 | if (heap-pagesize <= addr && addr < heap) { 156 | fprintf(stderr,"invalid access just below the heap\n"); 157 | } else if (heap+heapsize <= addr && addr <= heap+heapsize+pagesize) { 158 | fprintf(stderr,"invalid access just above the heap\n"); 159 | } else if (stack-pagesize <= addr && addr < stack) { 160 | fprintf(stderr,"invalid access just below the stack\n"); 161 | } else if (stack+stacksize <= addr && addr < stack+stacksize+pagesize) { 162 | fprintf(stderr,"invalid access just above the stack\n"); 163 | } else { 164 | fprintf(stderr, "Segmentation violation\n"); 165 | } 166 | 167 | exit(-1); 168 | } 169 | 170 | /* Signal handler for bus errors */ 171 | static void bus_handler(int signo) { 172 | fprintf(stderr, "Bus error\n"); 173 | exit(-1); 174 | } 175 | 176 | static void usage_error(char *who) { 177 | fprintf(stderr, "usage: %s [-h ] [-s ]\n", who); 178 | fprintf(stderr, " specify sizes in pages (base 10)\n"); 179 | fprintf(stderr, " page size is %ld bytes\n",pagesize); 180 | exit(1); 181 | } 182 | 183 | static void print(long x) { 184 | printf("%ld", x); 185 | } 186 | -------------------------------------------------------------------------------- /a5/runtime.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | 12 | #define stack_size 100000 13 | #define heap_size 100000 14 | 15 | #ifdef __APPLE__ 16 | #define SCHEME_ENTRY scheme_entry 17 | #endif 18 | #ifdef __linux__ 19 | #define SCHEME_ENTRY _scheme_entry 20 | #endif 21 | 22 | extern long SCHEME_ENTRY(char *, char *); 23 | 24 | /* locally defined functions */ 25 | static char *guarded_area(long n); 26 | #ifdef __APPLE__ 27 | static void segv_handler(int signo, siginfo_t *info, void *ignore); 28 | #endif 29 | #ifdef __linux__ 30 | static void segv_handler(int signo, struct sigcontext sc); 31 | #endif 32 | static void bus_handler(int signo); 33 | static void usage_error(char *who); 34 | static void print(long x); 35 | 36 | /* local stack/heap management variables */ 37 | static long pagesize; 38 | static char *heap; 39 | static char *stack; 40 | static long heapsize; 41 | static long stacksize; 42 | 43 | int main(int argc, char *argv[]) { 44 | struct sigaction action; 45 | sigset_t s_set; 46 | int n; 47 | 48 | pagesize = sysconf(_SC_PAGESIZE); 49 | 50 | stacksize = stack_size * sizeof(void *); 51 | heapsize = heap_size * sizeof(void *); 52 | 53 | for (n = 1; n < argc; n++) 54 | if ((*argv[n] == '-') && (*(argv[n]+2) == 0)) 55 | switch (*(argv[n]+1)) { 56 | case 'h': /* heap size option */ 57 | argv[n] = (char *)NULL; 58 | if (++n == argc) usage_error(argv[0]); 59 | heapsize = atoi(argv[n]); 60 | if (heapsize <= 0) usage_error(argv[0]); 61 | break; 62 | case 's': /* stack size option */ 63 | argv[n] = (char *)NULL; 64 | if (++n == argc) usage_error(argv[0]); 65 | stacksize = atoi(argv[n]); 66 | if (stacksize <= 0) usage_error(argv[0]); 67 | break; 68 | default: 69 | usage_error(argv[0]); 70 | } 71 | else 72 | usage_error(argv[0]); 73 | 74 | /* round stack and heap sizes to even pages */ 75 | stacksize = ((stacksize + pagesize - 1) / pagesize) * pagesize; 76 | heapsize = ((heapsize + pagesize - 1) / pagesize) * pagesize; 77 | 78 | stack = guarded_area(stacksize); 79 | heap = guarded_area(heapsize); 80 | 81 | /* Set up segmentation fault signal handler to catch stack and heap 82 | * overflow and some memory faults */ 83 | sigemptyset(&s_set); 84 | #ifdef __linux__ 85 | action.sa_handler = (void *)segv_handler; 86 | action.sa_flags = SA_RESETHAND; 87 | #else 88 | action.sa_sigaction = segv_handler; 89 | action.sa_flags = SA_SIGINFO | SA_RESETHAND; 90 | #endif 91 | action.sa_mask = s_set; 92 | if (sigaction(SIGSEGV, &action, NULL)) { 93 | fprintf(stderr, "sigaction failed: %s\n", strerror(errno)); 94 | fprintf(stderr, " overflow checking may not work\n"); 95 | } 96 | 97 | /* Set up bus error signal handler to catch remaining memory faults */ 98 | sigemptyset(&s_set); 99 | action.sa_handler = bus_handler; 100 | action.sa_mask = s_set; 101 | action.sa_flags = SA_RESETHAND; 102 | if (sigaction(SIGBUS, &action, NULL)) { 103 | fprintf(stderr, "sigaction failed: %s\n", strerror(errno)); 104 | } 105 | 106 | /* run the Scheme program and print the result */ 107 | print(SCHEME_ENTRY(stack, heap)); 108 | printf("\n"); 109 | 110 | return 0; 111 | } 112 | 113 | /* allocate a chunk of memory with a guard page on either end */ 114 | static char *guarded_area(long n) { /* n must be page aligned */ 115 | char *addr; 116 | 117 | /* allocate, leaving room for guard pages */ 118 | addr = (char *)mmap(NULL, 119 | (size_t)(n + 2 * pagesize), 120 | PROT_READ | PROT_WRITE, 121 | MAP_PRIVATE | MAP_ANON, 122 | -1, 0); 123 | if (addr == (char *)-1) { 124 | fprintf(stderr, "mmap failed: %s\n", strerror(errno)); 125 | exit(2); 126 | } 127 | 128 | /* remove access rights from the guard pages */ 129 | if (mprotect(addr, (size_t)pagesize, PROT_NONE) || 130 | mprotect(addr + pagesize + n, (size_t)pagesize, PROT_NONE)) { 131 | fprintf(stderr, "mprotect failed: %s\n", strerror(errno)); 132 | exit(3); 133 | } 134 | 135 | return addr + pagesize; 136 | } 137 | 138 | /* Signal handler that traps SIGSEGV and checks if the violation 139 | * might have been caused by stack or heap overflow */ 140 | #ifdef __APPLE__ 141 | static void segv_handler(int signo, siginfo_t *info, void *ingore) { 142 | #endif 143 | #ifdef __linux__ 144 | static void segv_handler(int signo, struct sigcontext sc) { 145 | #endif 146 | char *addr; 147 | 148 | #ifdef __APPLE__ 149 | addr = (char *)info->si_addr; 150 | #endif 151 | #ifdef __linux__ 152 | addr = (char *)(sc.cr2); 153 | #endif 154 | 155 | if (heap-pagesize <= addr && addr < heap) { 156 | fprintf(stderr,"invalid access just below the heap\n"); 157 | } else if (heap+heapsize <= addr && addr <= heap+heapsize+pagesize) { 158 | fprintf(stderr,"invalid access just above the heap\n"); 159 | } else if (stack-pagesize <= addr && addr < stack) { 160 | fprintf(stderr,"invalid access just below the stack\n"); 161 | } else if (stack+stacksize <= addr && addr < stack+stacksize+pagesize) { 162 | fprintf(stderr,"invalid access just above the stack\n"); 163 | } else { 164 | fprintf(stderr, "Segmentation violation\n"); 165 | } 166 | 167 | exit(-1); 168 | } 169 | 170 | /* Signal handler for bus errors */ 171 | static void bus_handler(int signo) { 172 | fprintf(stderr, "Bus error\n"); 173 | exit(-1); 174 | } 175 | 176 | static void usage_error(char *who) { 177 | fprintf(stderr, "usage: %s [-h ] [-s ]\n", who); 178 | fprintf(stderr, " specify sizes in pages (base 10)\n"); 179 | fprintf(stderr, " page size is %ld bytes\n",pagesize); 180 | exit(1); 181 | } 182 | 183 | static void print(long x) { 184 | printf("%ld", x); 185 | } 186 | -------------------------------------------------------------------------------- /a6/runtime.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | 12 | #define stack_size 100000 13 | #define heap_size 100000 14 | 15 | #ifdef __APPLE__ 16 | #define SCHEME_ENTRY scheme_entry 17 | #endif 18 | #ifdef __linux__ 19 | #define SCHEME_ENTRY _scheme_entry 20 | #endif 21 | 22 | extern long SCHEME_ENTRY(char *, char *); 23 | 24 | /* locally defined functions */ 25 | static char *guarded_area(long n); 26 | #ifdef __APPLE__ 27 | static void segv_handler(int signo, siginfo_t *info, void *ignore); 28 | #endif 29 | #ifdef __linux__ 30 | static void segv_handler(int signo, struct sigcontext sc); 31 | #endif 32 | static void bus_handler(int signo); 33 | static void usage_error(char *who); 34 | static void print(long x); 35 | 36 | /* local stack/heap management variables */ 37 | static long pagesize; 38 | static char *heap; 39 | static char *stack; 40 | static long heapsize; 41 | static long stacksize; 42 | 43 | int main(int argc, char *argv[]) { 44 | struct sigaction action; 45 | sigset_t s_set; 46 | int n; 47 | 48 | pagesize = sysconf(_SC_PAGESIZE); 49 | 50 | stacksize = stack_size * sizeof(void *); 51 | heapsize = heap_size * sizeof(void *); 52 | 53 | for (n = 1; n < argc; n++) 54 | if ((*argv[n] == '-') && (*(argv[n]+2) == 0)) 55 | switch (*(argv[n]+1)) { 56 | case 'h': /* heap size option */ 57 | argv[n] = (char *)NULL; 58 | if (++n == argc) usage_error(argv[0]); 59 | heapsize = atoi(argv[n]); 60 | if (heapsize <= 0) usage_error(argv[0]); 61 | break; 62 | case 's': /* stack size option */ 63 | argv[n] = (char *)NULL; 64 | if (++n == argc) usage_error(argv[0]); 65 | stacksize = atoi(argv[n]); 66 | if (stacksize <= 0) usage_error(argv[0]); 67 | break; 68 | default: 69 | usage_error(argv[0]); 70 | } 71 | else 72 | usage_error(argv[0]); 73 | 74 | /* round stack and heap sizes to even pages */ 75 | stacksize = ((stacksize + pagesize - 1) / pagesize) * pagesize; 76 | heapsize = ((heapsize + pagesize - 1) / pagesize) * pagesize; 77 | 78 | stack = guarded_area(stacksize); 79 | heap = guarded_area(heapsize); 80 | 81 | /* Set up segmentation fault signal handler to catch stack and heap 82 | * overflow and some memory faults */ 83 | sigemptyset(&s_set); 84 | #ifdef __linux__ 85 | action.sa_handler = (void *)segv_handler; 86 | action.sa_flags = SA_RESETHAND; 87 | #else 88 | action.sa_sigaction = segv_handler; 89 | action.sa_flags = SA_SIGINFO | SA_RESETHAND; 90 | #endif 91 | action.sa_mask = s_set; 92 | if (sigaction(SIGSEGV, &action, NULL)) { 93 | fprintf(stderr, "sigaction failed: %s\n", strerror(errno)); 94 | fprintf(stderr, " overflow checking may not work\n"); 95 | } 96 | 97 | /* Set up bus error signal handler to catch remaining memory faults */ 98 | sigemptyset(&s_set); 99 | action.sa_handler = bus_handler; 100 | action.sa_mask = s_set; 101 | action.sa_flags = SA_RESETHAND; 102 | if (sigaction(SIGBUS, &action, NULL)) { 103 | fprintf(stderr, "sigaction failed: %s\n", strerror(errno)); 104 | } 105 | 106 | /* run the Scheme program and print the result */ 107 | print(SCHEME_ENTRY(stack, heap)); 108 | printf("\n"); 109 | 110 | return 0; 111 | } 112 | 113 | /* allocate a chunk of memory with a guard page on either end */ 114 | static char *guarded_area(long n) { /* n must be page aligned */ 115 | char *addr; 116 | 117 | /* allocate, leaving room for guard pages */ 118 | addr = (char *)mmap(NULL, 119 | (size_t)(n + 2 * pagesize), 120 | PROT_READ | PROT_WRITE, 121 | MAP_PRIVATE | MAP_ANON, 122 | -1, 0); 123 | if (addr == (char *)-1) { 124 | fprintf(stderr, "mmap failed: %s\n", strerror(errno)); 125 | exit(2); 126 | } 127 | 128 | /* remove access rights from the guard pages */ 129 | if (mprotect(addr, (size_t)pagesize, PROT_NONE) || 130 | mprotect(addr + pagesize + n, (size_t)pagesize, PROT_NONE)) { 131 | fprintf(stderr, "mprotect failed: %s\n", strerror(errno)); 132 | exit(3); 133 | } 134 | 135 | return addr + pagesize; 136 | } 137 | 138 | /* Signal handler that traps SIGSEGV and checks if the violation 139 | * might have been caused by stack or heap overflow */ 140 | #ifdef __APPLE__ 141 | static void segv_handler(int signo, siginfo_t *info, void *ingore) { 142 | #endif 143 | #ifdef __linux__ 144 | static void segv_handler(int signo, struct sigcontext sc) { 145 | #endif 146 | char *addr; 147 | 148 | #ifdef __APPLE__ 149 | addr = (char *)info->si_addr; 150 | #endif 151 | #ifdef __linux__ 152 | addr = (char *)(sc.cr2); 153 | #endif 154 | 155 | if (heap-pagesize <= addr && addr < heap) { 156 | fprintf(stderr,"invalid access just below the heap\n"); 157 | } else if (heap+heapsize <= addr && addr <= heap+heapsize+pagesize) { 158 | fprintf(stderr,"invalid access just above the heap\n"); 159 | } else if (stack-pagesize <= addr && addr < stack) { 160 | fprintf(stderr,"invalid access just below the stack\n"); 161 | } else if (stack+stacksize <= addr && addr < stack+stacksize+pagesize) { 162 | fprintf(stderr,"invalid access just above the stack\n"); 163 | } else { 164 | fprintf(stderr, "Segmentation violation\n"); 165 | } 166 | 167 | exit(-1); 168 | } 169 | 170 | /* Signal handler for bus errors */ 171 | static void bus_handler(int signo) { 172 | fprintf(stderr, "Bus error\n"); 173 | exit(-1); 174 | } 175 | 176 | static void usage_error(char *who) { 177 | fprintf(stderr, "usage: %s [-h ] [-s ]\n", who); 178 | fprintf(stderr, " specify sizes in pages (base 10)\n"); 179 | fprintf(stderr, " page size is %ld bytes\n",pagesize); 180 | exit(1); 181 | } 182 | 183 | static void print(long x) { 184 | printf("%ld", x); 185 | } 186 | -------------------------------------------------------------------------------- /a7/runtime.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | 12 | #define stack_size 100000 13 | #define heap_size 100000 14 | 15 | #ifdef __APPLE__ 16 | #define SCHEME_ENTRY scheme_entry 17 | #endif 18 | #ifdef __linux__ 19 | #define SCHEME_ENTRY _scheme_entry 20 | #endif 21 | 22 | extern long SCHEME_ENTRY(char *, char *); 23 | 24 | /* locally defined functions */ 25 | static char *guarded_area(long n); 26 | #ifdef __APPLE__ 27 | static void segv_handler(int signo, siginfo_t *info, void *ignore); 28 | #endif 29 | #ifdef __linux__ 30 | static void segv_handler(int signo, struct sigcontext sc); 31 | #endif 32 | static void bus_handler(int signo); 33 | static void usage_error(char *who); 34 | static void print(long x); 35 | 36 | /* local stack/heap management variables */ 37 | static long pagesize; 38 | static char *heap; 39 | static char *stack; 40 | static long heapsize; 41 | static long stacksize; 42 | 43 | int main(int argc, char *argv[]) { 44 | struct sigaction action; 45 | sigset_t s_set; 46 | int n; 47 | 48 | pagesize = sysconf(_SC_PAGESIZE); 49 | 50 | stacksize = stack_size * sizeof(void *); 51 | heapsize = heap_size * sizeof(void *); 52 | 53 | for (n = 1; n < argc; n++) 54 | if ((*argv[n] == '-') && (*(argv[n]+2) == 0)) 55 | switch (*(argv[n]+1)) { 56 | case 'h': /* heap size option */ 57 | argv[n] = (char *)NULL; 58 | if (++n == argc) usage_error(argv[0]); 59 | heapsize = atoi(argv[n]); 60 | if (heapsize <= 0) usage_error(argv[0]); 61 | break; 62 | case 's': /* stack size option */ 63 | argv[n] = (char *)NULL; 64 | if (++n == argc) usage_error(argv[0]); 65 | stacksize = atoi(argv[n]); 66 | if (stacksize <= 0) usage_error(argv[0]); 67 | break; 68 | default: 69 | usage_error(argv[0]); 70 | } 71 | else 72 | usage_error(argv[0]); 73 | 74 | /* round stack and heap sizes to even pages */ 75 | stacksize = ((stacksize + pagesize - 1) / pagesize) * pagesize; 76 | heapsize = ((heapsize + pagesize - 1) / pagesize) * pagesize; 77 | 78 | stack = guarded_area(stacksize); 79 | heap = guarded_area(heapsize); 80 | 81 | /* Set up segmentation fault signal handler to catch stack and heap 82 | * overflow and some memory faults */ 83 | sigemptyset(&s_set); 84 | #ifdef __linux__ 85 | action.sa_handler = (void *)segv_handler; 86 | action.sa_flags = SA_RESETHAND; 87 | #else 88 | action.sa_sigaction = segv_handler; 89 | action.sa_flags = SA_SIGINFO | SA_RESETHAND; 90 | #endif 91 | action.sa_mask = s_set; 92 | if (sigaction(SIGSEGV, &action, NULL)) { 93 | fprintf(stderr, "sigaction failed: %s\n", strerror(errno)); 94 | fprintf(stderr, " overflow checking may not work\n"); 95 | } 96 | 97 | /* Set up bus error signal handler to catch remaining memory faults */ 98 | sigemptyset(&s_set); 99 | action.sa_handler = bus_handler; 100 | action.sa_mask = s_set; 101 | action.sa_flags = SA_RESETHAND; 102 | if (sigaction(SIGBUS, &action, NULL)) { 103 | fprintf(stderr, "sigaction failed: %s\n", strerror(errno)); 104 | } 105 | 106 | /* run the Scheme program and print the result */ 107 | print(SCHEME_ENTRY(stack, heap)); 108 | printf("\n"); 109 | 110 | return 0; 111 | } 112 | 113 | /* allocate a chunk of memory with a guard page on either end */ 114 | static char *guarded_area(long n) { /* n must be page aligned */ 115 | char *addr; 116 | 117 | /* allocate, leaving room for guard pages */ 118 | addr = (char *)mmap(NULL, 119 | (size_t)(n + 2 * pagesize), 120 | PROT_READ | PROT_WRITE, 121 | MAP_PRIVATE | MAP_ANON, 122 | -1, 0); 123 | if (addr == (char *)-1) { 124 | fprintf(stderr, "mmap failed: %s\n", strerror(errno)); 125 | exit(2); 126 | } 127 | 128 | /* remove access rights from the guard pages */ 129 | if (mprotect(addr, (size_t)pagesize, PROT_NONE) || 130 | mprotect(addr + pagesize + n, (size_t)pagesize, PROT_NONE)) { 131 | fprintf(stderr, "mprotect failed: %s\n", strerror(errno)); 132 | exit(3); 133 | } 134 | 135 | return addr + pagesize; 136 | } 137 | 138 | /* Signal handler that traps SIGSEGV and checks if the violation 139 | * might have been caused by stack or heap overflow */ 140 | #ifdef __APPLE__ 141 | static void segv_handler(int signo, siginfo_t *info, void *ingore) { 142 | #endif 143 | #ifdef __linux__ 144 | static void segv_handler(int signo, struct sigcontext sc) { 145 | #endif 146 | char *addr; 147 | 148 | #ifdef __APPLE__ 149 | addr = (char *)info->si_addr; 150 | #endif 151 | #ifdef __linux__ 152 | addr = (char *)(sc.cr2); 153 | #endif 154 | 155 | if (heap-pagesize <= addr && addr < heap) { 156 | fprintf(stderr,"invalid access just below the heap\n"); 157 | } else if (heap+heapsize <= addr && addr <= heap+heapsize+pagesize) { 158 | fprintf(stderr,"invalid access just above the heap\n"); 159 | } else if (stack-pagesize <= addr && addr < stack) { 160 | fprintf(stderr,"invalid access just below the stack\n"); 161 | } else if (stack+stacksize <= addr && addr < stack+stacksize+pagesize) { 162 | fprintf(stderr,"invalid access just above the stack\n"); 163 | } else { 164 | fprintf(stderr, "Segmentation violation\n"); 165 | } 166 | 167 | exit(-1); 168 | } 169 | 170 | /* Signal handler for bus errors */ 171 | static void bus_handler(int signo) { 172 | fprintf(stderr, "Bus error\n"); 173 | exit(-1); 174 | } 175 | 176 | static void usage_error(char *who) { 177 | fprintf(stderr, "usage: %s [-h ] [-s ]\n", who); 178 | fprintf(stderr, " specify sizes in pages (base 10)\n"); 179 | fprintf(stderr, " page size is %ld bytes\n",pagesize); 180 | exit(1); 181 | } 182 | 183 | static void print(long x) { 184 | printf("%ld", x); 185 | } 186 | -------------------------------------------------------------------------------- /a8/runtime.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | 12 | #define stack_size 100000 13 | #define heap_size 100000 14 | 15 | #ifdef __APPLE__ 16 | #define SCHEME_ENTRY scheme_entry 17 | #endif 18 | #ifdef __linux__ 19 | #define SCHEME_ENTRY _scheme_entry 20 | #endif 21 | 22 | extern long SCHEME_ENTRY(char *, char *); 23 | 24 | /* locally defined functions */ 25 | static char *guarded_area(long n); 26 | #ifdef __APPLE__ 27 | static void segv_handler(int signo, siginfo_t *info, void *ignore); 28 | #endif 29 | #ifdef __linux__ 30 | static void segv_handler(int signo, struct sigcontext sc); 31 | #endif 32 | static void bus_handler(int signo); 33 | static void usage_error(char *who); 34 | static void print(long x); 35 | 36 | /* local stack/heap management variables */ 37 | static long pagesize; 38 | static char *heap; 39 | static char *stack; 40 | static long heapsize; 41 | static long stacksize; 42 | 43 | int main(int argc, char *argv[]) { 44 | struct sigaction action; 45 | sigset_t s_set; 46 | int n; 47 | 48 | pagesize = sysconf(_SC_PAGESIZE); 49 | 50 | stacksize = stack_size * sizeof(void *); 51 | heapsize = heap_size * sizeof(void *); 52 | 53 | for (n = 1; n < argc; n++) 54 | if ((*argv[n] == '-') && (*(argv[n]+2) == 0)) 55 | switch (*(argv[n]+1)) { 56 | case 'h': /* heap size option */ 57 | argv[n] = (char *)NULL; 58 | if (++n == argc) usage_error(argv[0]); 59 | heapsize = atoi(argv[n]); 60 | if (heapsize <= 0) usage_error(argv[0]); 61 | break; 62 | case 's': /* stack size option */ 63 | argv[n] = (char *)NULL; 64 | if (++n == argc) usage_error(argv[0]); 65 | stacksize = atoi(argv[n]); 66 | if (stacksize <= 0) usage_error(argv[0]); 67 | break; 68 | default: 69 | usage_error(argv[0]); 70 | } 71 | else 72 | usage_error(argv[0]); 73 | 74 | /* round stack and heap sizes to even pages */ 75 | stacksize = ((stacksize + pagesize - 1) / pagesize) * pagesize; 76 | heapsize = ((heapsize + pagesize - 1) / pagesize) * pagesize; 77 | 78 | stack = guarded_area(stacksize); 79 | heap = guarded_area(heapsize); 80 | 81 | /* Set up segmentation fault signal handler to catch stack and heap 82 | * overflow and some memory faults */ 83 | sigemptyset(&s_set); 84 | #ifdef __linux__ 85 | action.sa_handler = (void *)segv_handler; 86 | action.sa_flags = SA_RESETHAND; 87 | #else 88 | action.sa_sigaction = segv_handler; 89 | action.sa_flags = SA_SIGINFO | SA_RESETHAND; 90 | #endif 91 | action.sa_mask = s_set; 92 | if (sigaction(SIGSEGV, &action, NULL)) { 93 | fprintf(stderr, "sigaction failed: %s\n", strerror(errno)); 94 | fprintf(stderr, " overflow checking may not work\n"); 95 | } 96 | 97 | /* Set up bus error signal handler to catch remaining memory faults */ 98 | sigemptyset(&s_set); 99 | action.sa_handler = bus_handler; 100 | action.sa_mask = s_set; 101 | action.sa_flags = SA_RESETHAND; 102 | if (sigaction(SIGBUS, &action, NULL)) { 103 | fprintf(stderr, "sigaction failed: %s\n", strerror(errno)); 104 | } 105 | 106 | /* run the Scheme program and print the result */ 107 | print(SCHEME_ENTRY(stack, heap)); 108 | printf("\n"); 109 | 110 | return 0; 111 | } 112 | 113 | /* allocate a chunk of memory with a guard page on either end */ 114 | static char *guarded_area(long n) { /* n must be page aligned */ 115 | char *addr; 116 | 117 | /* allocate, leaving room for guard pages */ 118 | addr = (char *)mmap(NULL, 119 | (size_t)(n + 2 * pagesize), 120 | PROT_READ | PROT_WRITE, 121 | MAP_PRIVATE | MAP_ANON, 122 | -1, 0); 123 | if (addr == (char *)-1) { 124 | fprintf(stderr, "mmap failed: %s\n", strerror(errno)); 125 | exit(2); 126 | } 127 | 128 | /* remove access rights from the guard pages */ 129 | if (mprotect(addr, (size_t)pagesize, PROT_NONE) || 130 | mprotect(addr + pagesize + n, (size_t)pagesize, PROT_NONE)) { 131 | fprintf(stderr, "mprotect failed: %s\n", strerror(errno)); 132 | exit(3); 133 | } 134 | 135 | return addr + pagesize; 136 | } 137 | 138 | /* Signal handler that traps SIGSEGV and checks if the violation 139 | * might have been caused by stack or heap overflow */ 140 | #ifdef __APPLE__ 141 | static void segv_handler(int signo, siginfo_t *info, void *ingore) { 142 | #endif 143 | #ifdef __linux__ 144 | static void segv_handler(int signo, struct sigcontext sc) { 145 | #endif 146 | char *addr; 147 | 148 | #ifdef __APPLE__ 149 | addr = (char *)info->si_addr; 150 | #endif 151 | #ifdef __linux__ 152 | addr = (char *)(sc.cr2); 153 | #endif 154 | 155 | if (heap-pagesize <= addr && addr < heap) { 156 | fprintf(stderr,"invalid access just below the heap\n"); 157 | } else if (heap+heapsize <= addr && addr <= heap+heapsize+pagesize) { 158 | fprintf(stderr,"invalid access just above the heap\n"); 159 | } else if (stack-pagesize <= addr && addr < stack) { 160 | fprintf(stderr,"invalid access just below the stack\n"); 161 | } else if (stack+stacksize <= addr && addr < stack+stacksize+pagesize) { 162 | fprintf(stderr,"invalid access just above the stack\n"); 163 | } else { 164 | fprintf(stderr, "Segmentation violation\n"); 165 | } 166 | 167 | exit(-1); 168 | } 169 | 170 | /* Signal handler for bus errors */ 171 | static void bus_handler(int signo) { 172 | fprintf(stderr, "Bus error\n"); 173 | exit(-1); 174 | } 175 | 176 | static void usage_error(char *who) { 177 | fprintf(stderr, "usage: %s [-h ] [-s ]\n", who); 178 | fprintf(stderr, " specify sizes in pages (base 10)\n"); 179 | fprintf(stderr, " page size is %ld bytes\n",pagesize); 180 | exit(1); 181 | } 182 | 183 | static void print(long x) { 184 | printf("%ld", x); 185 | } 186 | -------------------------------------------------------------------------------- /a9/runtime.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | 12 | #define stack_size 100000 13 | #define heap_size 100000 14 | 15 | #ifdef __APPLE__ 16 | #define SCHEME_ENTRY scheme_entry 17 | #endif 18 | #ifdef __linux__ 19 | #define SCHEME_ENTRY _scheme_entry 20 | #endif 21 | 22 | extern long SCHEME_ENTRY(char *, char *); 23 | 24 | /* locally defined functions */ 25 | static char *guarded_area(long n); 26 | #ifdef __APPLE__ 27 | static void segv_handler(int signo, siginfo_t *info, void *ignore); 28 | #endif 29 | #ifdef __linux__ 30 | static void segv_handler(int signo, struct sigcontext sc); 31 | #endif 32 | static void bus_handler(int signo); 33 | static void usage_error(char *who); 34 | static void print(long x); 35 | 36 | /* local stack/heap management variables */ 37 | static long pagesize; 38 | static char *heap; 39 | static char *stack; 40 | static long heapsize; 41 | static long stacksize; 42 | 43 | int main(int argc, char *argv[]) { 44 | struct sigaction action; 45 | sigset_t s_set; 46 | int n; 47 | 48 | pagesize = sysconf(_SC_PAGESIZE); 49 | 50 | stacksize = stack_size * sizeof(void *); 51 | heapsize = heap_size * sizeof(void *); 52 | 53 | for (n = 1; n < argc; n++) 54 | if ((*argv[n] == '-') && (*(argv[n]+2) == 0)) 55 | switch (*(argv[n]+1)) { 56 | case 'h': /* heap size option */ 57 | argv[n] = (char *)NULL; 58 | if (++n == argc) usage_error(argv[0]); 59 | heapsize = atoi(argv[n]); 60 | if (heapsize <= 0) usage_error(argv[0]); 61 | break; 62 | case 's': /* stack size option */ 63 | argv[n] = (char *)NULL; 64 | if (++n == argc) usage_error(argv[0]); 65 | stacksize = atoi(argv[n]); 66 | if (stacksize <= 0) usage_error(argv[0]); 67 | break; 68 | default: 69 | usage_error(argv[0]); 70 | } 71 | else 72 | usage_error(argv[0]); 73 | 74 | /* round stack and heap sizes to even pages */ 75 | stacksize = ((stacksize + pagesize - 1) / pagesize) * pagesize; 76 | heapsize = ((heapsize + pagesize - 1) / pagesize) * pagesize; 77 | 78 | stack = guarded_area(stacksize); 79 | heap = guarded_area(heapsize); 80 | 81 | /* Set up segmentation fault signal handler to catch stack and heap 82 | * overflow and some memory faults */ 83 | sigemptyset(&s_set); 84 | #ifdef __linux__ 85 | action.sa_handler = (void *)segv_handler; 86 | action.sa_flags = SA_RESETHAND; 87 | #else 88 | action.sa_sigaction = segv_handler; 89 | action.sa_flags = SA_SIGINFO | SA_RESETHAND; 90 | #endif 91 | action.sa_mask = s_set; 92 | if (sigaction(SIGSEGV, &action, NULL)) { 93 | fprintf(stderr, "sigaction failed: %s\n", strerror(errno)); 94 | fprintf(stderr, " overflow checking may not work\n"); 95 | } 96 | 97 | /* Set up bus error signal handler to catch remaining memory faults */ 98 | sigemptyset(&s_set); 99 | action.sa_handler = bus_handler; 100 | action.sa_mask = s_set; 101 | action.sa_flags = SA_RESETHAND; 102 | if (sigaction(SIGBUS, &action, NULL)) { 103 | fprintf(stderr, "sigaction failed: %s\n", strerror(errno)); 104 | } 105 | 106 | /* run the Scheme program and print the result */ 107 | print(SCHEME_ENTRY(stack, heap)); 108 | printf("\n"); 109 | 110 | return 0; 111 | } 112 | 113 | /* allocate a chunk of memory with a guard page on either end */ 114 | static char *guarded_area(long n) { /* n must be page aligned */ 115 | char *addr; 116 | 117 | /* allocate, leaving room for guard pages */ 118 | addr = (char *)mmap(NULL, 119 | (size_t)(n + 2 * pagesize), 120 | PROT_READ | PROT_WRITE, 121 | MAP_PRIVATE | MAP_ANON, 122 | -1, 0); 123 | if (addr == (char *)-1) { 124 | fprintf(stderr, "mmap failed: %s\n", strerror(errno)); 125 | exit(2); 126 | } 127 | 128 | /* remove access rights from the guard pages */ 129 | if (mprotect(addr, (size_t)pagesize, PROT_NONE) || 130 | mprotect(addr + pagesize + n, (size_t)pagesize, PROT_NONE)) { 131 | fprintf(stderr, "mprotect failed: %s\n", strerror(errno)); 132 | exit(3); 133 | } 134 | 135 | return addr + pagesize; 136 | } 137 | 138 | /* Signal handler that traps SIGSEGV and checks if the violation 139 | * might have been caused by stack or heap overflow */ 140 | #ifdef __APPLE__ 141 | static void segv_handler(int signo, siginfo_t *info, void *ingore) { 142 | #endif 143 | #ifdef __linux__ 144 | static void segv_handler(int signo, struct sigcontext sc) { 145 | #endif 146 | char *addr; 147 | 148 | #ifdef __APPLE__ 149 | addr = (char *)info->si_addr; 150 | #endif 151 | #ifdef __linux__ 152 | addr = (char *)(sc.cr2); 153 | #endif 154 | 155 | if (heap-pagesize <= addr && addr < heap) { 156 | fprintf(stderr,"invalid access just below the heap\n"); 157 | } else if (heap+heapsize <= addr && addr <= heap+heapsize+pagesize) { 158 | fprintf(stderr,"invalid access just above the heap\n"); 159 | } else if (stack-pagesize <= addr && addr < stack) { 160 | fprintf(stderr,"invalid access just below the stack\n"); 161 | } else if (stack+stacksize <= addr && addr < stack+stacksize+pagesize) { 162 | fprintf(stderr,"invalid access just above the stack\n"); 163 | } else { 164 | fprintf(stderr, "Segmentation violation\n"); 165 | } 166 | 167 | exit(-1); 168 | } 169 | 170 | /* Signal handler for bus errors */ 171 | static void bus_handler(int signo) { 172 | fprintf(stderr, "Bus error\n"); 173 | exit(-1); 174 | } 175 | 176 | static void usage_error(char *who) { 177 | fprintf(stderr, "usage: %s [-h ] [-s ]\n", who); 178 | fprintf(stderr, " specify sizes in pages (base 10)\n"); 179 | fprintf(stderr, " page size is %ld bytes\n",pagesize); 180 | exit(1); 181 | } 182 | 183 | static void print(long x) { 184 | printf("%ld", x); 185 | } 186 | -------------------------------------------------------------------------------- /a3/a3-wrapper.ss: -------------------------------------------------------------------------------- 1 | (language-wrapper 2 | (lambda (pass-name x) 3 | (define rewrite-opnds 4 | (lambda (x) 5 | (match x 6 | [,r (guard (disp-opnd? r)) 7 | `(mref ,(disp-opnd-reg r) ,(disp-opnd-offset r))] 8 | [,r (guard (index-opnd? r)) 9 | `(mref ,(index-opnd-breg r) ,(index-opnd-ireg r))] 10 | [(set! ,r ,[expr]) (guard (disp-opnd? r)) 11 | `(mset! ,(disp-opnd-reg r) ,(disp-opnd-offset r) ,expr)] 12 | [(set! ,r ,[expr]) (guard (index-opnd? r)) 13 | `(mset! ,(index-opnd-breg r) ,(index-opnd-ireg r) ,expr)] 14 | [(,[expr] ...) `(,expr ...)] 15 | [,x x]))) 16 | (case pass-name 17 | [(source verify-scheme) 18 | `(let () 19 | (import (except scheme set!)) 20 | (define int64-in-range? 21 | (lambda (x) 22 | (<= (- (expt 2 63)) x (- (expt 2 63) 1)))) 23 | (define handle-overflow 24 | (lambda (x) 25 | (cond 26 | [(not (number? x)) x] 27 | [(int64-in-range? x) x] 28 | [(not (= x (logand 18446744073709551615 x))) 29 | (handle-overflow (logand 18446744073709551615 x))] 30 | [(< x 0) (handle-overflow (+ x (expt 2 64)))] 31 | [else (handle-overflow (- x (expt 2 64)))]))) 32 | (define-syntax set! 33 | (let () 34 | (import scheme) 35 | (syntax-rules () 36 | [(_ x expr) 37 | (set! x (handle-overflow expr))]))) 38 | (define-syntax locate 39 | (let () 40 | (import scheme) 41 | (syntax-rules () 42 | [(_ ([x* loc*] ...) body) 43 | (let-syntax ([x* (identifier-syntax 44 | (id loc*) 45 | ((set! id e) 46 | (set! loc* (handle-overflow e))))] ...) 47 | body)]))) 48 | (define (true) #t) 49 | (define (false) #f) 50 | (define (nop) (void)) 51 | (call/cc 52 | (lambda (k) 53 | (set! r15 k) 54 | ,x)) 55 | rax)] 56 | [(finalize-locations) 57 | `(let () 58 | (import (except scheme set!)) 59 | (define int64-in-range? 60 | (lambda (x) 61 | (<= (- (expt 2 63)) x (- (expt 2 63) 1)))) 62 | (define handle-overflow 63 | (lambda (x) 64 | (cond 65 | [(not (number? x)) x] 66 | [(int64-in-range? x) x] 67 | [(not (= x (logand 18446744073709551615 x))) 68 | (handle-overflow (logand 18446744073709551615 x))] 69 | [(< x 0) (handle-overflow (+ x (expt 2 64)))] 70 | [else (handle-overflow (- x (expt 2 64)))]))) 71 | (define-syntax set! 72 | (let () 73 | (import scheme) 74 | (syntax-rules () 75 | [(_ x expr) 76 | (set! x (handle-overflow expr))]))) 77 | (define (true) #t) 78 | (define (false) #f) 79 | (define (nop) (void)) 80 | (call/cc 81 | (lambda (k) 82 | (set! r15 k) 83 | ,x)) 84 | rax)] 85 | [(expose-frame-var) 86 | `(let () 87 | (import (except scheme set!)) 88 | (define int64-in-range? 89 | (lambda (x) 90 | (<= (- (expt 2 63)) x (- (expt 2 63) 1)))) 91 | (define handle-overflow 92 | (lambda (x) 93 | (cond 94 | [(not (number? x)) x] 95 | [(int64-in-range? x) x] 96 | [(not (= x (logand 18446744073709551615 x))) 97 | (handle-overflow (logand 18446744073709551615 x))] 98 | [(< x 0) (handle-overflow (+ x (expt 2 64)))] 99 | [else (handle-overflow (- x (expt 2 64)))]))) 100 | (define-syntax set! 101 | (let () 102 | (import scheme) 103 | (syntax-rules () 104 | [(_ x expr) 105 | (set! x (handle-overflow expr))]))) 106 | (define (true) #t) 107 | (define (false) #f) 108 | (define (nop) (void)) 109 | (call/cc 110 | (lambda (k) 111 | (set! r15 k) 112 | ,(rewrite-opnds x))) 113 | rax)] 114 | [(expose-basic-blocks) 115 | `(let () 116 | (import (except scheme set!)) 117 | (define int64-in-range? 118 | (lambda (x) 119 | (<= (- (expt 2 63)) x (- (expt 2 63) 1)))) 120 | (define handle-overflow 121 | (lambda (x) 122 | (cond 123 | [(not (number? x)) x] 124 | [(int64-in-range? x) x] 125 | [(not (= x (logand 18446744073709551615 x))) 126 | (handle-overflow (logand 18446744073709551615 x))] 127 | [(< x 0) (handle-overflow (+ x (expt 2 64)))] 128 | [else (handle-overflow (- x (expt 2 64)))]))) 129 | (define-syntax set! 130 | (let () 131 | (import scheme) 132 | (syntax-rules () 133 | [(_ x expr) 134 | (set! x (handle-overflow expr))]))) 135 | (call/cc 136 | (lambda (k) 137 | (set! r15 k) 138 | ,(rewrite-opnds x))) 139 | rax)] 140 | [(flatten-program) 141 | `(let () 142 | (import (except scheme set!)) 143 | (define int64-in-range? 144 | (lambda (x) 145 | (<= (- (expt 2 63)) x (- (expt 2 63) 1)))) 146 | (define handle-overflow 147 | (lambda (x) 148 | (cond 149 | [(not (number? x)) x] 150 | [(int64-in-range? x) x] 151 | [(not (= x (logand 18446744073709551615 x))) 152 | (handle-overflow (logand 18446744073709551615 x))] 153 | [(< x 0) (handle-overflow (+ x (expt 2 64)))] 154 | [else (handle-overflow (- x (expt 2 64)))]))) 155 | (define-syntax set! 156 | (let () 157 | (import scheme) 158 | (syntax-rules () 159 | [(_ x expr) 160 | (set! x (handle-overflow expr))]))) 161 | (define-syntax code 162 | (lambda (x) 163 | (define build 164 | (lambda (body) 165 | (syntax-case body () 166 | [() #'(())] 167 | [(label expr ...) 168 | (identifier? #'label) 169 | (with-syntax ([((expr ...) defn ...) (build #'(expr ...))]) 170 | #'(((bounce label)) 171 | (define label 172 | (lambda () 173 | (bounce (lambda () expr ...)))) 174 | defn ...))] 175 | [(expr1 expr ...) 176 | (with-syntax ([((expr ...) defn ...) (build #'(expr ...))]) 177 | #'((expr1 expr ...) defn ...))]))) 178 | (syntax-case x () 179 | [(k expr ...) 180 | (with-syntax ([((expr ...) defn ...) (build #'(expr ...))]) 181 | #'((call/cc 182 | (lambda (bounce) 183 | defn ... 184 | expr ...))))]))) 185 | (define-syntax jump 186 | (syntax-rules () 187 | [(_ target) (target)])) 188 | (call/cc 189 | (lambda (k) 190 | (set! r15 k) 191 | ,(rewrite-opnds x))) 192 | rax)] 193 | [else x]))) 194 | -------------------------------------------------------------------------------- /a10/runtime.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | 12 | #define stack_size 100000 13 | #define heap_size 100000 14 | 15 | #ifdef __APPLE__ 16 | #define SCHEME_ENTRY scheme_entry 17 | #endif 18 | #ifdef __linux__ 19 | #define SCHEME_ENTRY _scheme_entry 20 | #endif 21 | 22 | extern long SCHEME_ENTRY(char *, char *); 23 | 24 | /* locally defined functions */ 25 | static char *guarded_area(long n); 26 | #ifdef __APPLE__ 27 | static void segv_handler(int signo, siginfo_t *info, void *ignore); 28 | #endif 29 | #ifdef __linux__ 30 | static void segv_handler(int signo, struct sigcontext sc); 31 | #endif 32 | static void bus_handler(int signo); 33 | static void usage_error(char *who); 34 | static void print(long x); 35 | 36 | /* local stack/heap management variables */ 37 | static long pagesize; 38 | static char *heap; 39 | static char *stack; 40 | static long heapsize; 41 | static long stacksize; 42 | 43 | int main(int argc, char *argv[]) { 44 | struct sigaction action; 45 | sigset_t s_set; 46 | int n; 47 | 48 | pagesize = sysconf(_SC_PAGESIZE); 49 | 50 | stacksize = stack_size * sizeof(void *); 51 | heapsize = heap_size * sizeof(void *); 52 | 53 | for (n = 1; n < argc; n++) 54 | if ((*argv[n] == '-') && (*(argv[n]+2) == 0)) 55 | switch (*(argv[n]+1)) { 56 | case 'h': /* heap size option */ 57 | argv[n] = (char *)NULL; 58 | if (++n == argc) usage_error(argv[0]); 59 | heapsize = atoi(argv[n]); 60 | if (heapsize <= 0) usage_error(argv[0]); 61 | break; 62 | case 's': /* stack size option */ 63 | argv[n] = (char *)NULL; 64 | if (++n == argc) usage_error(argv[0]); 65 | stacksize = atoi(argv[n]); 66 | if (stacksize <= 0) usage_error(argv[0]); 67 | break; 68 | default: 69 | usage_error(argv[0]); 70 | } 71 | else 72 | usage_error(argv[0]); 73 | 74 | /* round stack and heap sizes to even pages */ 75 | stacksize = ((stacksize + pagesize - 1) / pagesize) * pagesize; 76 | heapsize = ((heapsize + pagesize - 1) / pagesize) * pagesize; 77 | 78 | stack = guarded_area(stacksize); 79 | heap = guarded_area(heapsize); 80 | 81 | /* Set up segmentation fault signal handler to catch stack and heap 82 | * overflow and some memory faults */ 83 | sigemptyset(&s_set); 84 | #ifdef __linux__ 85 | action.sa_handler = (void *)segv_handler; 86 | action.sa_flags = SA_RESETHAND; 87 | #else 88 | action.sa_sigaction = segv_handler; 89 | action.sa_flags = SA_SIGINFO | SA_RESETHAND; 90 | #endif 91 | action.sa_mask = s_set; 92 | if (sigaction(SIGSEGV, &action, NULL)) { 93 | fprintf(stderr, "sigaction failed: %s\n", strerror(errno)); 94 | fprintf(stderr, " overflow checking may not work\n"); 95 | } 96 | 97 | /* Set up bus error signal handler to catch remaining memory faults */ 98 | sigemptyset(&s_set); 99 | action.sa_handler = bus_handler; 100 | action.sa_mask = s_set; 101 | action.sa_flags = SA_RESETHAND; 102 | if (sigaction(SIGBUS, &action, NULL)) { 103 | fprintf(stderr, "sigaction failed: %s\n", strerror(errno)); 104 | } 105 | 106 | /* run the Scheme program and print the result */ 107 | print(SCHEME_ENTRY(stack, heap)); 108 | printf("\n"); 109 | 110 | return 0; 111 | } 112 | 113 | /* allocate a chunk of memory with a guard page on either end */ 114 | static char *guarded_area(long n) { /* n must be page aligned */ 115 | char *addr; 116 | 117 | /* allocate, leaving room for guard pages */ 118 | addr = (char *)mmap(NULL, 119 | (size_t)(n + 2 * pagesize), 120 | PROT_READ | PROT_WRITE, 121 | MAP_PRIVATE | MAP_ANON, 122 | -1, 0); 123 | if (addr == (char *)-1) { 124 | fprintf(stderr, "mmap failed: %s\n", strerror(errno)); 125 | exit(2); 126 | } 127 | 128 | /* remove access rights from the guard pages */ 129 | if (mprotect(addr, (size_t)pagesize, PROT_NONE) || 130 | mprotect(addr + pagesize + n, (size_t)pagesize, PROT_NONE)) { 131 | fprintf(stderr, "mprotect failed: %s\n", strerror(errno)); 132 | exit(3); 133 | } 134 | 135 | return addr + pagesize; 136 | } 137 | 138 | /* Signal handler that traps SIGSEGV and checks if the violation 139 | * might have been caused by stack or heap overflow */ 140 | #ifdef __APPLE__ 141 | static void segv_handler(int signo, siginfo_t *info, void *ingore) { 142 | #endif 143 | #ifdef __linux__ 144 | static void segv_handler(int signo, struct sigcontext sc) { 145 | #endif 146 | char *addr; 147 | 148 | #ifdef __APPLE__ 149 | addr = (char *)info->si_addr; 150 | #endif 151 | #ifdef __linux__ 152 | addr = (char *)(sc.cr2); 153 | #endif 154 | 155 | if (heap-pagesize <= addr && addr < heap) { 156 | fprintf(stderr,"invalid access just below the heap\n"); 157 | } else if (heap+heapsize <= addr && addr <= heap+heapsize+pagesize) { 158 | fprintf(stderr,"invalid access just above the heap\n"); 159 | } else if (stack-pagesize <= addr && addr < stack) { 160 | fprintf(stderr,"invalid access just below the stack\n"); 161 | } else if (stack+stacksize <= addr && addr < stack+stacksize+pagesize) { 162 | fprintf(stderr,"invalid access just above the stack\n"); 163 | } else { 164 | fprintf(stderr, "Segmentation violation\n"); 165 | } 166 | 167 | exit(-1); 168 | } 169 | 170 | /* Signal handler for bus errors */ 171 | static void bus_handler(int signo) { 172 | fprintf(stderr, "Bus error\n"); 173 | exit(-1); 174 | } 175 | 176 | static void usage_error(char *who) { 177 | fprintf(stderr, "usage: %s [-h ] [-s ]\n", who); 178 | fprintf(stderr, " specify sizes in pages (base 10)\n"); 179 | fprintf(stderr, " page size is %ld bytes\n",pagesize); 180 | exit(1); 181 | } 182 | 183 | #define SCHEME_PRINTER 184 | 185 | #ifdef SCHEME_PRINTER 186 | 187 | /* generated from Scheme definitions */ 188 | #define word_size 8 189 | #define object_alignment 8 190 | #define shift_fixnum 3 191 | #define mask_fixnum 7 192 | #define tag_fixnum 0 193 | #define mask_pair 7 194 | #define tag_pair 1 195 | #define size_pair 16 196 | #define disp_car 0 197 | #define disp_cdr 8 198 | #define mask_vector 7 199 | #define tag_vector 3 200 | #define disp_vector_length 0 201 | #define disp_vector_data 8 202 | #define mask_procedure 7 203 | #define tag_procedure 2 204 | #define disp_procedure_code 0 205 | #define disp_procedure_data 8 206 | #define mask_boolean 247 207 | #define tag_boolean 6 208 | #define _false 6 209 | #define _true 14 210 | #define _nil 22 211 | #define _void 30 212 | 213 | typedef long ptr; 214 | 215 | #define UNFIX(x) (x >> shift_fixnum) 216 | #define TAG(x,mask) (x & mask) 217 | #define UNTAG(x,tag) ((x)-tag) 218 | #define CAR(x) (*(ptr *)(UNTAG(x,tag_pair) + disp_car)) 219 | #define CDR(x) (*(ptr *)(UNTAG(x,tag_pair) + disp_cdr)) 220 | #define VECTORLENGTH(x) (*(ptr *)(UNTAG(x,tag_vector) + disp_vector_length)) 221 | #define VECTORDATA(x) ((ptr *)(UNTAG(x,tag_vector) + disp_vector_data)) 222 | 223 | #define MAXDEPTH 100 224 | #define MAXLENGTH 1000 225 | 226 | static void print1(ptr x, int d) { 227 | if (TAG(x, mask_fixnum) == tag_fixnum) { 228 | printf("%ld", (long)UNFIX(x)); 229 | } else if (TAG(x, mask_pair) == tag_pair) { 230 | int len = 0; 231 | ptr y; 232 | 233 | if (d > MAXDEPTH) { 234 | printf("(...)"); 235 | return; 236 | } 237 | printf("("); 238 | print1(CAR(x), d+1); 239 | y = CDR(x); 240 | while (TAG(y, mask_pair) == tag_pair && (len < MAXLENGTH-1)) { 241 | printf(" "); 242 | print1(CAR(y), d+1); 243 | y = CDR(y); 244 | len++; 245 | } 246 | if (y != _nil) 247 | if (len == MAXLENGTH-1) 248 | printf(" ..."); 249 | else { 250 | printf(" . "); 251 | print1(y, d+1); 252 | } 253 | printf(")"); 254 | } else if (TAG(x, mask_vector) == tag_vector) { 255 | long i, n; 256 | ptr *p; 257 | if (d > MAXDEPTH) { 258 | printf("#(...)"); 259 | return; 260 | } 261 | printf("#("); 262 | n = UNFIX(VECTORLENGTH(x)); 263 | p = VECTORDATA(x); 264 | i = n > MAXLENGTH ? MAXLENGTH : n; 265 | if (i != 0) { 266 | print1(*p, d+1); 267 | while (--i) { 268 | printf(" "); 269 | print1(*++p, d+1); 270 | } 271 | } 272 | if (n > MAXLENGTH) printf(" ..."); 273 | printf(")"); 274 | } else if (TAG(x, mask_procedure) == tag_procedure) { 275 | printf("#"); 276 | } else if (x == _false) { 277 | printf("#f"); 278 | } else if (x == _true) { 279 | printf("#t"); 280 | } else if (x == _nil) { 281 | printf("()"); 282 | } else if (x == _void) { 283 | printf("#"); 284 | } 285 | } 286 | 287 | static void print(ptr x) { 288 | print1(x, 0); 289 | } 290 | 291 | #else /* SCHEME_PRINTER */ 292 | 293 | static void print(long x) { 294 | printf("%ld", x); 295 | } 296 | 297 | #endif /* SCHEME_PRINTER */ 298 | -------------------------------------------------------------------------------- /a11/runtime.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | 12 | #define stack_size 100000 13 | #define heap_size 100000 14 | 15 | #ifdef __APPLE__ 16 | #define SCHEME_ENTRY scheme_entry 17 | #endif 18 | #ifdef __linux__ 19 | #define SCHEME_ENTRY _scheme_entry 20 | #endif 21 | 22 | extern long SCHEME_ENTRY(char *, char *); 23 | 24 | /* locally defined functions */ 25 | static char *guarded_area(long n); 26 | #ifdef __APPLE__ 27 | static void segv_handler(int signo, siginfo_t *info, void *ignore); 28 | #endif 29 | #ifdef __linux__ 30 | static void segv_handler(int signo, struct sigcontext sc); 31 | #endif 32 | static void bus_handler(int signo); 33 | static void usage_error(char *who); 34 | static void print(long x); 35 | 36 | /* local stack/heap management variables */ 37 | static long pagesize; 38 | static char *heap; 39 | static char *stack; 40 | static long heapsize; 41 | static long stacksize; 42 | 43 | int main(int argc, char *argv[]) { 44 | struct sigaction action; 45 | sigset_t s_set; 46 | int n; 47 | 48 | pagesize = sysconf(_SC_PAGESIZE); 49 | 50 | stacksize = stack_size * sizeof(void *); 51 | heapsize = heap_size * sizeof(void *); 52 | 53 | for (n = 1; n < argc; n++) 54 | if ((*argv[n] == '-') && (*(argv[n]+2) == 0)) 55 | switch (*(argv[n]+1)) { 56 | case 'h': /* heap size option */ 57 | argv[n] = (char *)NULL; 58 | if (++n == argc) usage_error(argv[0]); 59 | heapsize = atoi(argv[n]); 60 | if (heapsize <= 0) usage_error(argv[0]); 61 | break; 62 | case 's': /* stack size option */ 63 | argv[n] = (char *)NULL; 64 | if (++n == argc) usage_error(argv[0]); 65 | stacksize = atoi(argv[n]); 66 | if (stacksize <= 0) usage_error(argv[0]); 67 | break; 68 | default: 69 | usage_error(argv[0]); 70 | } 71 | else 72 | usage_error(argv[0]); 73 | 74 | /* round stack and heap sizes to even pages */ 75 | stacksize = ((stacksize + pagesize - 1) / pagesize) * pagesize; 76 | heapsize = ((heapsize + pagesize - 1) / pagesize) * pagesize; 77 | 78 | stack = guarded_area(stacksize); 79 | heap = guarded_area(heapsize); 80 | 81 | /* Set up segmentation fault signal handler to catch stack and heap 82 | * overflow and some memory faults */ 83 | sigemptyset(&s_set); 84 | #ifdef __linux__ 85 | action.sa_handler = (void *)segv_handler; 86 | action.sa_flags = SA_RESETHAND; 87 | #else 88 | action.sa_sigaction = segv_handler; 89 | action.sa_flags = SA_SIGINFO | SA_RESETHAND; 90 | #endif 91 | action.sa_mask = s_set; 92 | if (sigaction(SIGSEGV, &action, NULL)) { 93 | fprintf(stderr, "sigaction failed: %s\n", strerror(errno)); 94 | fprintf(stderr, " overflow checking may not work\n"); 95 | } 96 | 97 | /* Set up bus error signal handler to catch remaining memory faults */ 98 | sigemptyset(&s_set); 99 | action.sa_handler = bus_handler; 100 | action.sa_mask = s_set; 101 | action.sa_flags = SA_RESETHAND; 102 | if (sigaction(SIGBUS, &action, NULL)) { 103 | fprintf(stderr, "sigaction failed: %s\n", strerror(errno)); 104 | } 105 | 106 | /* run the Scheme program and print the result */ 107 | print(SCHEME_ENTRY(stack, heap)); 108 | printf("\n"); 109 | 110 | return 0; 111 | } 112 | 113 | /* allocate a chunk of memory with a guard page on either end */ 114 | static char *guarded_area(long n) { /* n must be page aligned */ 115 | char *addr; 116 | 117 | /* allocate, leaving room for guard pages */ 118 | addr = (char *)mmap(NULL, 119 | (size_t)(n + 2 * pagesize), 120 | PROT_READ | PROT_WRITE, 121 | MAP_PRIVATE | MAP_ANON, 122 | -1, 0); 123 | if (addr == (char *)-1) { 124 | fprintf(stderr, "mmap failed: %s\n", strerror(errno)); 125 | exit(2); 126 | } 127 | 128 | /* remove access rights from the guard pages */ 129 | if (mprotect(addr, (size_t)pagesize, PROT_NONE) || 130 | mprotect(addr + pagesize + n, (size_t)pagesize, PROT_NONE)) { 131 | fprintf(stderr, "mprotect failed: %s\n", strerror(errno)); 132 | exit(3); 133 | } 134 | 135 | return addr + pagesize; 136 | } 137 | 138 | /* Signal handler that traps SIGSEGV and checks if the violation 139 | * might have been caused by stack or heap overflow */ 140 | #ifdef __APPLE__ 141 | static void segv_handler(int signo, siginfo_t *info, void *ingore) { 142 | #endif 143 | #ifdef __linux__ 144 | static void segv_handler(int signo, struct sigcontext sc) { 145 | #endif 146 | char *addr; 147 | 148 | #ifdef __APPLE__ 149 | addr = (char *)info->si_addr; 150 | #endif 151 | #ifdef __linux__ 152 | addr = (char *)(sc.cr2); 153 | #endif 154 | 155 | if (heap-pagesize <= addr && addr < heap) { 156 | fprintf(stderr,"invalid access just below the heap\n"); 157 | } else if (heap+heapsize <= addr && addr <= heap+heapsize+pagesize) { 158 | fprintf(stderr,"invalid access just above the heap\n"); 159 | } else if (stack-pagesize <= addr && addr < stack) { 160 | fprintf(stderr,"invalid access just below the stack\n"); 161 | } else if (stack+stacksize <= addr && addr < stack+stacksize+pagesize) { 162 | fprintf(stderr,"invalid access just above the stack\n"); 163 | } else { 164 | fprintf(stderr, "Segmentation violation\n"); 165 | } 166 | 167 | exit(-1); 168 | } 169 | 170 | /* Signal handler for bus errors */ 171 | static void bus_handler(int signo) { 172 | fprintf(stderr, "Bus error\n"); 173 | exit(-1); 174 | } 175 | 176 | static void usage_error(char *who) { 177 | fprintf(stderr, "usage: %s [-h ] [-s ]\n", who); 178 | fprintf(stderr, " specify sizes in pages (base 10)\n"); 179 | fprintf(stderr, " page size is %ld bytes\n",pagesize); 180 | exit(1); 181 | } 182 | 183 | #define SCHEME_PRINTER 184 | 185 | #ifdef SCHEME_PRINTER 186 | 187 | /* generated from Scheme definitions */ 188 | #define word_size 8 189 | #define object_alignment 8 190 | #define shift_fixnum 3 191 | #define mask_fixnum 7 192 | #define tag_fixnum 0 193 | #define mask_pair 7 194 | #define tag_pair 1 195 | #define size_pair 16 196 | #define disp_car 0 197 | #define disp_cdr 8 198 | #define mask_vector 7 199 | #define tag_vector 3 200 | #define disp_vector_length 0 201 | #define disp_vector_data 8 202 | #define mask_procedure 7 203 | #define tag_procedure 2 204 | #define disp_procedure_code 0 205 | #define disp_procedure_data 8 206 | #define mask_boolean 247 207 | #define tag_boolean 6 208 | #define _false 6 209 | #define _true 14 210 | #define _nil 22 211 | #define _void 30 212 | 213 | typedef long ptr; 214 | 215 | #define UNFIX(x) (x >> shift_fixnum) 216 | #define TAG(x,mask) (x & mask) 217 | #define UNTAG(x,tag) ((x)-tag) 218 | #define CAR(x) (*(ptr *)(UNTAG(x,tag_pair) + disp_car)) 219 | #define CDR(x) (*(ptr *)(UNTAG(x,tag_pair) + disp_cdr)) 220 | #define VECTORLENGTH(x) (*(ptr *)(UNTAG(x,tag_vector) + disp_vector_length)) 221 | #define VECTORDATA(x) ((ptr *)(UNTAG(x,tag_vector) + disp_vector_data)) 222 | 223 | #define MAXDEPTH 100 224 | #define MAXLENGTH 1000 225 | 226 | static void print1(ptr x, int d) { 227 | if (TAG(x, mask_fixnum) == tag_fixnum) { 228 | printf("%ld", (long)UNFIX(x)); 229 | } else if (TAG(x, mask_pair) == tag_pair) { 230 | int len = 0; 231 | ptr y; 232 | 233 | if (d > MAXDEPTH) { 234 | printf("(...)"); 235 | return; 236 | } 237 | printf("("); 238 | print1(CAR(x), d+1); 239 | y = CDR(x); 240 | while (TAG(y, mask_pair) == tag_pair && (len < MAXLENGTH-1)) { 241 | printf(" "); 242 | print1(CAR(y), d+1); 243 | y = CDR(y); 244 | len++; 245 | } 246 | if (y != _nil) 247 | if (len == MAXLENGTH-1) 248 | printf(" ..."); 249 | else { 250 | printf(" . "); 251 | print1(y, d+1); 252 | } 253 | printf(")"); 254 | } else if (TAG(x, mask_vector) == tag_vector) { 255 | long i, n; 256 | ptr *p; 257 | if (d > MAXDEPTH) { 258 | printf("#(...)"); 259 | return; 260 | } 261 | printf("#("); 262 | n = UNFIX(VECTORLENGTH(x)); 263 | p = VECTORDATA(x); 264 | i = n > MAXLENGTH ? MAXLENGTH : n; 265 | if (i != 0) { 266 | print1(*p, d+1); 267 | while (--i) { 268 | printf(" "); 269 | print1(*++p, d+1); 270 | } 271 | } 272 | if (n > MAXLENGTH) printf(" ..."); 273 | printf(")"); 274 | } else if (TAG(x, mask_procedure) == tag_procedure) { 275 | printf("#"); 276 | } else if (x == _false) { 277 | printf("#f"); 278 | } else if (x == _true) { 279 | printf("#t"); 280 | } else if (x == _nil) { 281 | printf("()"); 282 | } else if (x == _void) { 283 | printf("#"); 284 | } 285 | } 286 | 287 | static void print(ptr x) { 288 | print1(x, 0); 289 | } 290 | 291 | #else /* SCHEME_PRINTER */ 292 | 293 | static void print(long x) { 294 | printf("%ld", x); 295 | } 296 | 297 | #endif /* SCHEME_PRINTER */ 298 | -------------------------------------------------------------------------------- /a12/runtime.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | 12 | #define stack_size 100000 13 | #define heap_size 100000 14 | 15 | #ifdef __APPLE__ 16 | #define SCHEME_ENTRY scheme_entry 17 | #endif 18 | #ifdef __linux__ 19 | #define SCHEME_ENTRY _scheme_entry 20 | #endif 21 | 22 | extern long SCHEME_ENTRY(char *, char *); 23 | 24 | /* locally defined functions */ 25 | static char *guarded_area(long n); 26 | #ifdef __APPLE__ 27 | static void segv_handler(int signo, siginfo_t *info, void *ignore); 28 | #endif 29 | #ifdef __linux__ 30 | static void segv_handler(int signo, struct sigcontext sc); 31 | #endif 32 | static void bus_handler(int signo); 33 | static void usage_error(char *who); 34 | static void print(long x); 35 | 36 | /* local stack/heap management variables */ 37 | static long pagesize; 38 | static char *heap; 39 | static char *stack; 40 | static long heapsize; 41 | static long stacksize; 42 | 43 | int main(int argc, char *argv[]) { 44 | struct sigaction action; 45 | sigset_t s_set; 46 | int n; 47 | 48 | pagesize = sysconf(_SC_PAGESIZE); 49 | 50 | stacksize = stack_size * sizeof(void *); 51 | heapsize = heap_size * sizeof(void *); 52 | 53 | for (n = 1; n < argc; n++) 54 | if ((*argv[n] == '-') && (*(argv[n]+2) == 0)) 55 | switch (*(argv[n]+1)) { 56 | case 'h': /* heap size option */ 57 | argv[n] = (char *)NULL; 58 | if (++n == argc) usage_error(argv[0]); 59 | heapsize = atoi(argv[n]); 60 | if (heapsize <= 0) usage_error(argv[0]); 61 | break; 62 | case 's': /* stack size option */ 63 | argv[n] = (char *)NULL; 64 | if (++n == argc) usage_error(argv[0]); 65 | stacksize = atoi(argv[n]); 66 | if (stacksize <= 0) usage_error(argv[0]); 67 | break; 68 | default: 69 | usage_error(argv[0]); 70 | } 71 | else 72 | usage_error(argv[0]); 73 | 74 | /* round stack and heap sizes to even pages */ 75 | stacksize = ((stacksize + pagesize - 1) / pagesize) * pagesize; 76 | heapsize = ((heapsize + pagesize - 1) / pagesize) * pagesize; 77 | 78 | stack = guarded_area(stacksize); 79 | heap = guarded_area(heapsize); 80 | 81 | /* Set up segmentation fault signal handler to catch stack and heap 82 | * overflow and some memory faults */ 83 | sigemptyset(&s_set); 84 | #ifdef __linux__ 85 | action.sa_handler = (void *)segv_handler; 86 | action.sa_flags = SA_RESETHAND; 87 | #else 88 | action.sa_sigaction = segv_handler; 89 | action.sa_flags = SA_SIGINFO | SA_RESETHAND; 90 | #endif 91 | action.sa_mask = s_set; 92 | if (sigaction(SIGSEGV, &action, NULL)) { 93 | fprintf(stderr, "sigaction failed: %s\n", strerror(errno)); 94 | fprintf(stderr, " overflow checking may not work\n"); 95 | } 96 | 97 | /* Set up bus error signal handler to catch remaining memory faults */ 98 | sigemptyset(&s_set); 99 | action.sa_handler = bus_handler; 100 | action.sa_mask = s_set; 101 | action.sa_flags = SA_RESETHAND; 102 | if (sigaction(SIGBUS, &action, NULL)) { 103 | fprintf(stderr, "sigaction failed: %s\n", strerror(errno)); 104 | } 105 | 106 | /* run the Scheme program and print the result */ 107 | print(SCHEME_ENTRY(stack, heap)); 108 | printf("\n"); 109 | 110 | return 0; 111 | } 112 | 113 | /* allocate a chunk of memory with a guard page on either end */ 114 | static char *guarded_area(long n) { /* n must be page aligned */ 115 | char *addr; 116 | 117 | /* allocate, leaving room for guard pages */ 118 | addr = (char *)mmap(NULL, 119 | (size_t)(n + 2 * pagesize), 120 | PROT_READ | PROT_WRITE, 121 | MAP_PRIVATE | MAP_ANON, 122 | -1, 0); 123 | if (addr == (char *)-1) { 124 | fprintf(stderr, "mmap failed: %s\n", strerror(errno)); 125 | exit(2); 126 | } 127 | 128 | /* remove access rights from the guard pages */ 129 | if (mprotect(addr, (size_t)pagesize, PROT_NONE) || 130 | mprotect(addr + pagesize + n, (size_t)pagesize, PROT_NONE)) { 131 | fprintf(stderr, "mprotect failed: %s\n", strerror(errno)); 132 | exit(3); 133 | } 134 | 135 | return addr + pagesize; 136 | } 137 | 138 | /* Signal handler that traps SIGSEGV and checks if the violation 139 | * might have been caused by stack or heap overflow */ 140 | #ifdef __APPLE__ 141 | static void segv_handler(int signo, siginfo_t *info, void *ingore) { 142 | #endif 143 | #ifdef __linux__ 144 | static void segv_handler(int signo, struct sigcontext sc) { 145 | #endif 146 | char *addr; 147 | 148 | #ifdef __APPLE__ 149 | addr = (char *)info->si_addr; 150 | #endif 151 | #ifdef __linux__ 152 | addr = (char *)(sc.cr2); 153 | #endif 154 | 155 | if (heap-pagesize <= addr && addr < heap) { 156 | fprintf(stderr,"invalid access just below the heap\n"); 157 | } else if (heap+heapsize <= addr && addr <= heap+heapsize+pagesize) { 158 | fprintf(stderr,"invalid access just above the heap\n"); 159 | } else if (stack-pagesize <= addr && addr < stack) { 160 | fprintf(stderr,"invalid access just below the stack\n"); 161 | } else if (stack+stacksize <= addr && addr < stack+stacksize+pagesize) { 162 | fprintf(stderr,"invalid access just above the stack\n"); 163 | } else { 164 | fprintf(stderr, "Segmentation violation\n"); 165 | } 166 | 167 | exit(-1); 168 | } 169 | 170 | /* Signal handler for bus errors */ 171 | static void bus_handler(int signo) { 172 | fprintf(stderr, "Bus error\n"); 173 | exit(-1); 174 | } 175 | 176 | static void usage_error(char *who) { 177 | fprintf(stderr, "usage: %s [-h ] [-s ]\n", who); 178 | fprintf(stderr, " specify sizes in pages (base 10)\n"); 179 | fprintf(stderr, " page size is %ld bytes\n",pagesize); 180 | exit(1); 181 | } 182 | 183 | #define SCHEME_PRINTER 184 | 185 | #ifdef SCHEME_PRINTER 186 | 187 | /* generated from Scheme definitions */ 188 | #define word_size 8 189 | #define object_alignment 8 190 | #define shift_fixnum 3 191 | #define mask_fixnum 7 192 | #define tag_fixnum 0 193 | #define mask_pair 7 194 | #define tag_pair 1 195 | #define size_pair 16 196 | #define disp_car 0 197 | #define disp_cdr 8 198 | #define mask_vector 7 199 | #define tag_vector 3 200 | #define disp_vector_length 0 201 | #define disp_vector_data 8 202 | #define mask_procedure 7 203 | #define tag_procedure 2 204 | #define disp_procedure_code 0 205 | #define disp_procedure_data 8 206 | #define mask_boolean 247 207 | #define tag_boolean 6 208 | #define _false 6 209 | #define _true 14 210 | #define _nil 22 211 | #define _void 30 212 | 213 | typedef long ptr; 214 | 215 | #define UNFIX(x) (x >> shift_fixnum) 216 | #define TAG(x,mask) (x & mask) 217 | #define UNTAG(x,tag) ((x)-tag) 218 | #define CAR(x) (*(ptr *)(UNTAG(x,tag_pair) + disp_car)) 219 | #define CDR(x) (*(ptr *)(UNTAG(x,tag_pair) + disp_cdr)) 220 | #define VECTORLENGTH(x) (*(ptr *)(UNTAG(x,tag_vector) + disp_vector_length)) 221 | #define VECTORDATA(x) ((ptr *)(UNTAG(x,tag_vector) + disp_vector_data)) 222 | 223 | #define MAXDEPTH 100 224 | #define MAXLENGTH 1000 225 | 226 | static void print1(ptr x, int d) { 227 | if (TAG(x, mask_fixnum) == tag_fixnum) { 228 | printf("%ld", (long)UNFIX(x)); 229 | } else if (TAG(x, mask_pair) == tag_pair) { 230 | int len = 0; 231 | ptr y; 232 | 233 | if (d > MAXDEPTH) { 234 | printf("(...)"); 235 | return; 236 | } 237 | printf("("); 238 | print1(CAR(x), d+1); 239 | y = CDR(x); 240 | while (TAG(y, mask_pair) == tag_pair && (len < MAXLENGTH-1)) { 241 | printf(" "); 242 | print1(CAR(y), d+1); 243 | y = CDR(y); 244 | len++; 245 | } 246 | if (y != _nil) 247 | if (len == MAXLENGTH-1) 248 | printf(" ..."); 249 | else { 250 | printf(" . "); 251 | print1(y, d+1); 252 | } 253 | printf(")"); 254 | } else if (TAG(x, mask_vector) == tag_vector) { 255 | long i, n; 256 | ptr *p; 257 | if (d > MAXDEPTH) { 258 | printf("#(...)"); 259 | return; 260 | } 261 | printf("#("); 262 | n = UNFIX(VECTORLENGTH(x)); 263 | p = VECTORDATA(x); 264 | i = n > MAXLENGTH ? MAXLENGTH : n; 265 | if (i != 0) { 266 | print1(*p, d+1); 267 | while (--i) { 268 | printf(" "); 269 | print1(*++p, d+1); 270 | } 271 | } 272 | if (n > MAXLENGTH) printf(" ..."); 273 | printf(")"); 274 | } else if (TAG(x, mask_procedure) == tag_procedure) { 275 | printf("#"); 276 | } else if (x == _false) { 277 | printf("#f"); 278 | } else if (x == _true) { 279 | printf("#t"); 280 | } else if (x == _nil) { 281 | printf("()"); 282 | } else if (x == _void) { 283 | printf("#"); 284 | } 285 | } 286 | 287 | static void print(ptr x) { 288 | print1(x, 0); 289 | } 290 | 291 | #else /* SCHEME_PRINTER */ 292 | 293 | static void print(long x) { 294 | printf("%ld", x); 295 | } 296 | 297 | #endif /* SCHEME_PRINTER */ 298 | -------------------------------------------------------------------------------- /a13/runtime.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | 12 | #define stack_size 100000 13 | #define heap_size 100000 14 | 15 | #ifdef __APPLE__ 16 | #define SCHEME_ENTRY scheme_entry 17 | #endif 18 | #ifdef __linux__ 19 | #define SCHEME_ENTRY _scheme_entry 20 | #endif 21 | 22 | extern long SCHEME_ENTRY(char *, char *); 23 | 24 | /* locally defined functions */ 25 | static char *guarded_area(long n); 26 | #ifdef __APPLE__ 27 | static void segv_handler(int signo, siginfo_t *info, void *ignore); 28 | #endif 29 | #ifdef __linux__ 30 | static void segv_handler(int signo, struct sigcontext sc); 31 | #endif 32 | static void bus_handler(int signo); 33 | static void usage_error(char *who); 34 | static void print(long x); 35 | 36 | /* local stack/heap management variables */ 37 | static long pagesize; 38 | static char *heap; 39 | static char *stack; 40 | static long heapsize; 41 | static long stacksize; 42 | 43 | int main(int argc, char *argv[]) { 44 | struct sigaction action; 45 | sigset_t s_set; 46 | int n; 47 | 48 | pagesize = sysconf(_SC_PAGESIZE); 49 | 50 | stacksize = stack_size * sizeof(void *); 51 | heapsize = heap_size * sizeof(void *); 52 | 53 | for (n = 1; n < argc; n++) 54 | if ((*argv[n] == '-') && (*(argv[n]+2) == 0)) 55 | switch (*(argv[n]+1)) { 56 | case 'h': /* heap size option */ 57 | argv[n] = (char *)NULL; 58 | if (++n == argc) usage_error(argv[0]); 59 | heapsize = atoi(argv[n]); 60 | if (heapsize <= 0) usage_error(argv[0]); 61 | break; 62 | case 's': /* stack size option */ 63 | argv[n] = (char *)NULL; 64 | if (++n == argc) usage_error(argv[0]); 65 | stacksize = atoi(argv[n]); 66 | if (stacksize <= 0) usage_error(argv[0]); 67 | break; 68 | default: 69 | usage_error(argv[0]); 70 | } 71 | else 72 | usage_error(argv[0]); 73 | 74 | /* round stack and heap sizes to even pages */ 75 | stacksize = ((stacksize + pagesize - 1) / pagesize) * pagesize; 76 | heapsize = ((heapsize + pagesize - 1) / pagesize) * pagesize; 77 | 78 | stack = guarded_area(stacksize); 79 | heap = guarded_area(heapsize); 80 | 81 | /* Set up segmentation fault signal handler to catch stack and heap 82 | * overflow and some memory faults */ 83 | sigemptyset(&s_set); 84 | #ifdef __linux__ 85 | action.sa_handler = (void *)segv_handler; 86 | action.sa_flags = SA_RESETHAND; 87 | #else 88 | action.sa_sigaction = segv_handler; 89 | action.sa_flags = SA_SIGINFO | SA_RESETHAND; 90 | #endif 91 | action.sa_mask = s_set; 92 | if (sigaction(SIGSEGV, &action, NULL)) { 93 | fprintf(stderr, "sigaction failed: %s\n", strerror(errno)); 94 | fprintf(stderr, " overflow checking may not work\n"); 95 | } 96 | 97 | /* Set up bus error signal handler to catch remaining memory faults */ 98 | sigemptyset(&s_set); 99 | action.sa_handler = bus_handler; 100 | action.sa_mask = s_set; 101 | action.sa_flags = SA_RESETHAND; 102 | if (sigaction(SIGBUS, &action, NULL)) { 103 | fprintf(stderr, "sigaction failed: %s\n", strerror(errno)); 104 | } 105 | 106 | /* run the Scheme program and print the result */ 107 | print(SCHEME_ENTRY(stack, heap)); 108 | printf("\n"); 109 | 110 | return 0; 111 | } 112 | 113 | /* allocate a chunk of memory with a guard page on either end */ 114 | static char *guarded_area(long n) { /* n must be page aligned */ 115 | char *addr; 116 | 117 | /* allocate, leaving room for guard pages */ 118 | addr = (char *)mmap(NULL, 119 | (size_t)(n + 2 * pagesize), 120 | PROT_READ | PROT_WRITE, 121 | MAP_PRIVATE | MAP_ANON, 122 | -1, 0); 123 | if (addr == (char *)-1) { 124 | fprintf(stderr, "mmap failed: %s\n", strerror(errno)); 125 | exit(2); 126 | } 127 | 128 | /* remove access rights from the guard pages */ 129 | if (mprotect(addr, (size_t)pagesize, PROT_NONE) || 130 | mprotect(addr + pagesize + n, (size_t)pagesize, PROT_NONE)) { 131 | fprintf(stderr, "mprotect failed: %s\n", strerror(errno)); 132 | exit(3); 133 | } 134 | 135 | return addr + pagesize; 136 | } 137 | 138 | /* Signal handler that traps SIGSEGV and checks if the violation 139 | * might have been caused by stack or heap overflow */ 140 | #ifdef __APPLE__ 141 | static void segv_handler(int signo, siginfo_t *info, void *ingore) { 142 | #endif 143 | #ifdef __linux__ 144 | static void segv_handler(int signo, struct sigcontext sc) { 145 | #endif 146 | char *addr; 147 | 148 | #ifdef __APPLE__ 149 | addr = (char *)info->si_addr; 150 | #endif 151 | #ifdef __linux__ 152 | addr = (char *)(sc.cr2); 153 | #endif 154 | 155 | if (heap-pagesize <= addr && addr < heap) { 156 | fprintf(stderr,"invalid access just below the heap\n"); 157 | } else if (heap+heapsize <= addr && addr <= heap+heapsize+pagesize) { 158 | fprintf(stderr,"invalid access just above the heap\n"); 159 | } else if (stack-pagesize <= addr && addr < stack) { 160 | fprintf(stderr,"invalid access just below the stack\n"); 161 | } else if (stack+stacksize <= addr && addr < stack+stacksize+pagesize) { 162 | fprintf(stderr,"invalid access just above the stack\n"); 163 | } else { 164 | fprintf(stderr, "Segmentation violation\n"); 165 | } 166 | 167 | exit(-1); 168 | } 169 | 170 | /* Signal handler for bus errors */ 171 | static void bus_handler(int signo) { 172 | fprintf(stderr, "Bus error\n"); 173 | exit(-1); 174 | } 175 | 176 | static void usage_error(char *who) { 177 | fprintf(stderr, "usage: %s [-h ] [-s ]\n", who); 178 | fprintf(stderr, " specify sizes in pages (base 10)\n"); 179 | fprintf(stderr, " page size is %ld bytes\n",pagesize); 180 | exit(1); 181 | } 182 | 183 | #define SCHEME_PRINTER 184 | 185 | #ifdef SCHEME_PRINTER 186 | 187 | /* generated from Scheme definitions */ 188 | #define word_size 8 189 | #define object_alignment 8 190 | #define shift_fixnum 3 191 | #define mask_fixnum 7 192 | #define tag_fixnum 0 193 | #define mask_pair 7 194 | #define tag_pair 1 195 | #define size_pair 16 196 | #define disp_car 0 197 | #define disp_cdr 8 198 | #define mask_vector 7 199 | #define tag_vector 3 200 | #define disp_vector_length 0 201 | #define disp_vector_data 8 202 | #define mask_procedure 7 203 | #define tag_procedure 2 204 | #define disp_procedure_code 0 205 | #define disp_procedure_data 8 206 | #define mask_boolean 247 207 | #define tag_boolean 6 208 | #define _false 6 209 | #define _true 14 210 | #define _nil 22 211 | #define _void 30 212 | 213 | typedef long ptr; 214 | 215 | #define UNFIX(x) (x >> shift_fixnum) 216 | #define TAG(x,mask) (x & mask) 217 | #define UNTAG(x,tag) ((x)-tag) 218 | #define CAR(x) (*(ptr *)(UNTAG(x,tag_pair) + disp_car)) 219 | #define CDR(x) (*(ptr *)(UNTAG(x,tag_pair) + disp_cdr)) 220 | #define VECTORLENGTH(x) (*(ptr *)(UNTAG(x,tag_vector) + disp_vector_length)) 221 | #define VECTORDATA(x) ((ptr *)(UNTAG(x,tag_vector) + disp_vector_data)) 222 | 223 | #define MAXDEPTH 100 224 | #define MAXLENGTH 1000 225 | 226 | static void print1(ptr x, int d) { 227 | if (TAG(x, mask_fixnum) == tag_fixnum) { 228 | printf("%ld", (long)UNFIX(x)); 229 | } else if (TAG(x, mask_pair) == tag_pair) { 230 | int len = 0; 231 | ptr y; 232 | 233 | if (d > MAXDEPTH) { 234 | printf("(...)"); 235 | return; 236 | } 237 | printf("("); 238 | print1(CAR(x), d+1); 239 | y = CDR(x); 240 | while (TAG(y, mask_pair) == tag_pair && (len < MAXLENGTH-1)) { 241 | printf(" "); 242 | print1(CAR(y), d+1); 243 | y = CDR(y); 244 | len++; 245 | } 246 | if (y != _nil) 247 | if (len == MAXLENGTH-1) 248 | printf(" ..."); 249 | else { 250 | printf(" . "); 251 | print1(y, d+1); 252 | } 253 | printf(")"); 254 | } else if (TAG(x, mask_vector) == tag_vector) { 255 | long i, n; 256 | ptr *p; 257 | if (d > MAXDEPTH) { 258 | printf("#(...)"); 259 | return; 260 | } 261 | printf("#("); 262 | n = UNFIX(VECTORLENGTH(x)); 263 | p = VECTORDATA(x); 264 | i = n > MAXLENGTH ? MAXLENGTH : n; 265 | if (i != 0) { 266 | print1(*p, d+1); 267 | while (--i) { 268 | printf(" "); 269 | print1(*++p, d+1); 270 | } 271 | } 272 | if (n > MAXLENGTH) printf(" ..."); 273 | printf(")"); 274 | } else if (TAG(x, mask_procedure) == tag_procedure) { 275 | printf("#"); 276 | } else if (x == _false) { 277 | printf("#f"); 278 | } else if (x == _true) { 279 | printf("#t"); 280 | } else if (x == _nil) { 281 | printf("()"); 282 | } else if (x == _void) { 283 | printf("#"); 284 | } 285 | } 286 | 287 | static void print(ptr x) { 288 | print1(x, 0); 289 | } 290 | 291 | #else /* SCHEME_PRINTER */ 292 | 293 | static void print(long x) { 294 | printf("%ld", x); 295 | } 296 | 297 | #endif /* SCHEME_PRINTER */ 298 | -------------------------------------------------------------------------------- /a14/runtime.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | 12 | #define stack_size 100000 13 | #define heap_size 100000 14 | 15 | #ifdef __APPLE__ 16 | #define SCHEME_ENTRY scheme_entry 17 | #endif 18 | #ifdef __linux__ 19 | #define SCHEME_ENTRY _scheme_entry 20 | #endif 21 | 22 | extern long SCHEME_ENTRY(char *, char *); 23 | 24 | /* locally defined functions */ 25 | static char *guarded_area(long n); 26 | #ifdef __APPLE__ 27 | static void segv_handler(int signo, siginfo_t *info, void *ignore); 28 | #endif 29 | #ifdef __linux__ 30 | static void segv_handler(int signo, struct sigcontext sc); 31 | #endif 32 | static void bus_handler(int signo); 33 | static void usage_error(char *who); 34 | static void print(long x); 35 | 36 | /* local stack/heap management variables */ 37 | static long pagesize; 38 | static char *heap; 39 | static char *stack; 40 | static long heapsize; 41 | static long stacksize; 42 | 43 | int main(int argc, char *argv[]) { 44 | struct sigaction action; 45 | sigset_t s_set; 46 | int n; 47 | 48 | pagesize = sysconf(_SC_PAGESIZE); 49 | 50 | stacksize = stack_size * sizeof(void *); 51 | heapsize = heap_size * sizeof(void *); 52 | 53 | for (n = 1; n < argc; n++) 54 | if ((*argv[n] == '-') && (*(argv[n]+2) == 0)) 55 | switch (*(argv[n]+1)) { 56 | case 'h': /* heap size option */ 57 | argv[n] = (char *)NULL; 58 | if (++n == argc) usage_error(argv[0]); 59 | heapsize = atoi(argv[n]); 60 | if (heapsize <= 0) usage_error(argv[0]); 61 | break; 62 | case 's': /* stack size option */ 63 | argv[n] = (char *)NULL; 64 | if (++n == argc) usage_error(argv[0]); 65 | stacksize = atoi(argv[n]); 66 | if (stacksize <= 0) usage_error(argv[0]); 67 | break; 68 | default: 69 | usage_error(argv[0]); 70 | } 71 | else 72 | usage_error(argv[0]); 73 | 74 | /* round stack and heap sizes to even pages */ 75 | stacksize = ((stacksize + pagesize - 1) / pagesize) * pagesize; 76 | heapsize = ((heapsize + pagesize - 1) / pagesize) * pagesize; 77 | 78 | stack = guarded_area(stacksize); 79 | heap = guarded_area(heapsize); 80 | 81 | /* Set up segmentation fault signal handler to catch stack and heap 82 | * overflow and some memory faults */ 83 | sigemptyset(&s_set); 84 | #ifdef __linux__ 85 | action.sa_handler = (void *)segv_handler; 86 | action.sa_flags = SA_RESETHAND; 87 | #else 88 | action.sa_sigaction = segv_handler; 89 | action.sa_flags = SA_SIGINFO | SA_RESETHAND; 90 | #endif 91 | action.sa_mask = s_set; 92 | if (sigaction(SIGSEGV, &action, NULL)) { 93 | fprintf(stderr, "sigaction failed: %s\n", strerror(errno)); 94 | fprintf(stderr, " overflow checking may not work\n"); 95 | } 96 | 97 | /* Set up bus error signal handler to catch remaining memory faults */ 98 | sigemptyset(&s_set); 99 | action.sa_handler = bus_handler; 100 | action.sa_mask = s_set; 101 | action.sa_flags = SA_RESETHAND; 102 | if (sigaction(SIGBUS, &action, NULL)) { 103 | fprintf(stderr, "sigaction failed: %s\n", strerror(errno)); 104 | } 105 | 106 | /* run the Scheme program and print the result */ 107 | print(SCHEME_ENTRY(stack, heap)); 108 | printf("\n"); 109 | 110 | return 0; 111 | } 112 | 113 | /* allocate a chunk of memory with a guard page on either end */ 114 | static char *guarded_area(long n) { /* n must be page aligned */ 115 | char *addr; 116 | 117 | /* allocate, leaving room for guard pages */ 118 | addr = (char *)mmap(NULL, 119 | (size_t)(n + 2 * pagesize), 120 | PROT_READ | PROT_WRITE, 121 | MAP_PRIVATE | MAP_ANON, 122 | -1, 0); 123 | if (addr == (char *)-1) { 124 | fprintf(stderr, "mmap failed: %s\n", strerror(errno)); 125 | exit(2); 126 | } 127 | 128 | /* remove access rights from the guard pages */ 129 | if (mprotect(addr, (size_t)pagesize, PROT_NONE) || 130 | mprotect(addr + pagesize + n, (size_t)pagesize, PROT_NONE)) { 131 | fprintf(stderr, "mprotect failed: %s\n", strerror(errno)); 132 | exit(3); 133 | } 134 | 135 | return addr + pagesize; 136 | } 137 | 138 | /* Signal handler that traps SIGSEGV and checks if the violation 139 | * might have been caused by stack or heap overflow */ 140 | #ifdef __APPLE__ 141 | static void segv_handler(int signo, siginfo_t *info, void *ingore) { 142 | #endif 143 | #ifdef __linux__ 144 | static void segv_handler(int signo, struct sigcontext sc) { 145 | #endif 146 | char *addr; 147 | 148 | #ifdef __APPLE__ 149 | addr = (char *)info->si_addr; 150 | #endif 151 | #ifdef __linux__ 152 | addr = (char *)(sc.cr2); 153 | #endif 154 | 155 | if (heap-pagesize <= addr && addr < heap) { 156 | fprintf(stderr,"invalid access just below the heap\n"); 157 | } else if (heap+heapsize <= addr && addr <= heap+heapsize+pagesize) { 158 | fprintf(stderr,"invalid access just above the heap\n"); 159 | } else if (stack-pagesize <= addr && addr < stack) { 160 | fprintf(stderr,"invalid access just below the stack\n"); 161 | } else if (stack+stacksize <= addr && addr < stack+stacksize+pagesize) { 162 | fprintf(stderr,"invalid access just above the stack\n"); 163 | } else { 164 | fprintf(stderr, "Segmentation violation\n"); 165 | } 166 | 167 | exit(-1); 168 | } 169 | 170 | /* Signal handler for bus errors */ 171 | static void bus_handler(int signo) { 172 | fprintf(stderr, "Bus error\n"); 173 | exit(-1); 174 | } 175 | 176 | static void usage_error(char *who) { 177 | fprintf(stderr, "usage: %s [-h ] [-s ]\n", who); 178 | fprintf(stderr, " specify sizes in pages (base 10)\n"); 179 | fprintf(stderr, " page size is %ld bytes\n",pagesize); 180 | exit(1); 181 | } 182 | 183 | #define SCHEME_PRINTER 184 | 185 | #ifdef SCHEME_PRINTER 186 | 187 | /* generated from Scheme definitions */ 188 | #define word_size 8 189 | #define object_alignment 8 190 | #define shift_fixnum 3 191 | #define mask_fixnum 7 192 | #define tag_fixnum 0 193 | #define mask_pair 7 194 | #define tag_pair 1 195 | #define size_pair 16 196 | #define disp_car 0 197 | #define disp_cdr 8 198 | #define mask_vector 7 199 | #define tag_vector 3 200 | #define disp_vector_length 0 201 | #define disp_vector_data 8 202 | #define mask_procedure 7 203 | #define tag_procedure 2 204 | #define disp_procedure_code 0 205 | #define disp_procedure_data 8 206 | #define mask_boolean 247 207 | #define tag_boolean 6 208 | #define _false 6 209 | #define _true 14 210 | #define _nil 22 211 | #define _void 30 212 | 213 | typedef long ptr; 214 | 215 | #define UNFIX(x) (x >> shift_fixnum) 216 | #define TAG(x,mask) (x & mask) 217 | #define UNTAG(x,tag) ((x)-tag) 218 | #define CAR(x) (*(ptr *)(UNTAG(x,tag_pair) + disp_car)) 219 | #define CDR(x) (*(ptr *)(UNTAG(x,tag_pair) + disp_cdr)) 220 | #define VECTORLENGTH(x) (*(ptr *)(UNTAG(x,tag_vector) + disp_vector_length)) 221 | #define VECTORDATA(x) ((ptr *)(UNTAG(x,tag_vector) + disp_vector_data)) 222 | 223 | #define MAXDEPTH 100 224 | #define MAXLENGTH 1000 225 | 226 | static void print1(ptr x, int d) { 227 | if (TAG(x, mask_fixnum) == tag_fixnum) { 228 | printf("%ld", (long)UNFIX(x)); 229 | } else if (TAG(x, mask_pair) == tag_pair) { 230 | int len = 0; 231 | ptr y; 232 | 233 | if (d > MAXDEPTH) { 234 | printf("(...)"); 235 | return; 236 | } 237 | printf("("); 238 | print1(CAR(x), d+1); 239 | y = CDR(x); 240 | while (TAG(y, mask_pair) == tag_pair && (len < MAXLENGTH-1)) { 241 | printf(" "); 242 | print1(CAR(y), d+1); 243 | y = CDR(y); 244 | len++; 245 | } 246 | if (y != _nil) 247 | if (len == MAXLENGTH-1) 248 | printf(" ..."); 249 | else { 250 | printf(" . "); 251 | print1(y, d+1); 252 | } 253 | printf(")"); 254 | } else if (TAG(x, mask_vector) == tag_vector) { 255 | long i, n; 256 | ptr *p; 257 | if (d > MAXDEPTH) { 258 | printf("#(...)"); 259 | return; 260 | } 261 | printf("#("); 262 | n = UNFIX(VECTORLENGTH(x)); 263 | p = VECTORDATA(x); 264 | i = n > MAXLENGTH ? MAXLENGTH : n; 265 | if (i != 0) { 266 | print1(*p, d+1); 267 | while (--i) { 268 | printf(" "); 269 | print1(*++p, d+1); 270 | } 271 | } 272 | if (n > MAXLENGTH) printf(" ..."); 273 | printf(")"); 274 | } else if (TAG(x, mask_procedure) == tag_procedure) { 275 | printf("#"); 276 | } else if (x == _false) { 277 | printf("#f"); 278 | } else if (x == _true) { 279 | printf("#t"); 280 | } else if (x == _nil) { 281 | printf("()"); 282 | } else if (x == _void) { 283 | printf("#"); 284 | } 285 | } 286 | 287 | static void print(ptr x) { 288 | print1(x, 0); 289 | } 290 | 291 | #else /* SCHEME_PRINTER */ 292 | 293 | static void print(long x) { 294 | printf("%ld", x); 295 | } 296 | 297 | #endif /* SCHEME_PRINTER */ 298 | -------------------------------------------------------------------------------- /a15/runtime.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | 12 | #define stack_size 100000 13 | #define heap_size 100000 14 | 15 | #ifdef __APPLE__ 16 | #define SCHEME_ENTRY scheme_entry 17 | #endif 18 | #ifdef __linux__ 19 | #define SCHEME_ENTRY _scheme_entry 20 | #endif 21 | 22 | extern long SCHEME_ENTRY(char *, char *); 23 | 24 | /* locally defined functions */ 25 | static char *guarded_area(long n); 26 | #ifdef __APPLE__ 27 | static void segv_handler(int signo, siginfo_t *info, void *ignore); 28 | #endif 29 | #ifdef __linux__ 30 | static void segv_handler(int signo, struct sigcontext sc); 31 | #endif 32 | static void bus_handler(int signo); 33 | static void usage_error(char *who); 34 | static void print(long x); 35 | 36 | /* local stack/heap management variables */ 37 | static long pagesize; 38 | static char *heap; 39 | static char *stack; 40 | static long heapsize; 41 | static long stacksize; 42 | 43 | int main(int argc, char *argv[]) { 44 | struct sigaction action; 45 | sigset_t s_set; 46 | int n; 47 | 48 | pagesize = sysconf(_SC_PAGESIZE); 49 | 50 | stacksize = stack_size * sizeof(void *); 51 | heapsize = heap_size * sizeof(void *); 52 | 53 | for (n = 1; n < argc; n++) 54 | if ((*argv[n] == '-') && (*(argv[n]+2) == 0)) 55 | switch (*(argv[n]+1)) { 56 | case 'h': /* heap size option */ 57 | argv[n] = (char *)NULL; 58 | if (++n == argc) usage_error(argv[0]); 59 | heapsize = atoi(argv[n]); 60 | if (heapsize <= 0) usage_error(argv[0]); 61 | break; 62 | case 's': /* stack size option */ 63 | argv[n] = (char *)NULL; 64 | if (++n == argc) usage_error(argv[0]); 65 | stacksize = atoi(argv[n]); 66 | if (stacksize <= 0) usage_error(argv[0]); 67 | break; 68 | default: 69 | usage_error(argv[0]); 70 | } 71 | else 72 | usage_error(argv[0]); 73 | 74 | /* round stack and heap sizes to even pages */ 75 | stacksize = ((stacksize + pagesize - 1) / pagesize) * pagesize; 76 | heapsize = ((heapsize + pagesize - 1) / pagesize) * pagesize; 77 | 78 | stack = guarded_area(stacksize); 79 | heap = guarded_area(heapsize); 80 | 81 | /* Set up segmentation fault signal handler to catch stack and heap 82 | * overflow and some memory faults */ 83 | sigemptyset(&s_set); 84 | #ifdef __linux__ 85 | action.sa_handler = (void *)segv_handler; 86 | action.sa_flags = SA_RESETHAND; 87 | #else 88 | action.sa_sigaction = segv_handler; 89 | action.sa_flags = SA_SIGINFO | SA_RESETHAND; 90 | #endif 91 | action.sa_mask = s_set; 92 | if (sigaction(SIGSEGV, &action, NULL)) { 93 | fprintf(stderr, "sigaction failed: %s\n", strerror(errno)); 94 | fprintf(stderr, " overflow checking may not work\n"); 95 | } 96 | 97 | /* Set up bus error signal handler to catch remaining memory faults */ 98 | sigemptyset(&s_set); 99 | action.sa_handler = bus_handler; 100 | action.sa_mask = s_set; 101 | action.sa_flags = SA_RESETHAND; 102 | if (sigaction(SIGBUS, &action, NULL)) { 103 | fprintf(stderr, "sigaction failed: %s\n", strerror(errno)); 104 | } 105 | 106 | /* run the Scheme program and print the result */ 107 | print(SCHEME_ENTRY(stack, heap)); 108 | printf("\n"); 109 | 110 | return 0; 111 | } 112 | 113 | /* allocate a chunk of memory with a guard page on either end */ 114 | static char *guarded_area(long n) { /* n must be page aligned */ 115 | char *addr; 116 | 117 | /* allocate, leaving room for guard pages */ 118 | addr = (char *)mmap(NULL, 119 | (size_t)(n + 2 * pagesize), 120 | PROT_READ | PROT_WRITE, 121 | MAP_PRIVATE | MAP_ANON, 122 | -1, 0); 123 | if (addr == (char *)-1) { 124 | fprintf(stderr, "mmap failed: %s\n", strerror(errno)); 125 | exit(2); 126 | } 127 | 128 | /* remove access rights from the guard pages */ 129 | if (mprotect(addr, (size_t)pagesize, PROT_NONE) || 130 | mprotect(addr + pagesize + n, (size_t)pagesize, PROT_NONE)) { 131 | fprintf(stderr, "mprotect failed: %s\n", strerror(errno)); 132 | exit(3); 133 | } 134 | 135 | return addr + pagesize; 136 | } 137 | 138 | /* Signal handler that traps SIGSEGV and checks if the violation 139 | * might have been caused by stack or heap overflow */ 140 | #ifdef __APPLE__ 141 | static void segv_handler(int signo, siginfo_t *info, void *ingore) { 142 | #endif 143 | #ifdef __linux__ 144 | static void segv_handler(int signo, struct sigcontext sc) { 145 | #endif 146 | char *addr; 147 | 148 | #ifdef __APPLE__ 149 | addr = (char *)info->si_addr; 150 | #endif 151 | #ifdef __linux__ 152 | addr = (char *)(sc.cr2); 153 | #endif 154 | 155 | if (heap-pagesize <= addr && addr < heap) { 156 | fprintf(stderr,"invalid access just below the heap\n"); 157 | } else if (heap+heapsize <= addr && addr <= heap+heapsize+pagesize) { 158 | fprintf(stderr,"invalid access just above the heap\n"); 159 | } else if (stack-pagesize <= addr && addr < stack) { 160 | fprintf(stderr,"invalid access just below the stack\n"); 161 | } else if (stack+stacksize <= addr && addr < stack+stacksize+pagesize) { 162 | fprintf(stderr,"invalid access just above the stack\n"); 163 | } else { 164 | fprintf(stderr, "Segmentation violation\n"); 165 | } 166 | 167 | exit(-1); 168 | } 169 | 170 | /* Signal handler for bus errors */ 171 | static void bus_handler(int signo) { 172 | fprintf(stderr, "Bus error\n"); 173 | exit(-1); 174 | } 175 | 176 | static void usage_error(char *who) { 177 | fprintf(stderr, "usage: %s [-h ] [-s ]\n", who); 178 | fprintf(stderr, " specify sizes in pages (base 10)\n"); 179 | fprintf(stderr, " page size is %ld bytes\n",pagesize); 180 | exit(1); 181 | } 182 | 183 | #define SCHEME_PRINTER 184 | 185 | #ifdef SCHEME_PRINTER 186 | 187 | /* generated from Scheme definitions */ 188 | #define word_size 8 189 | #define object_alignment 8 190 | #define shift_fixnum 3 191 | #define mask_fixnum 7 192 | #define tag_fixnum 0 193 | #define mask_pair 7 194 | #define tag_pair 1 195 | #define size_pair 16 196 | #define disp_car 0 197 | #define disp_cdr 8 198 | #define mask_vector 7 199 | #define tag_vector 3 200 | #define disp_vector_length 0 201 | #define disp_vector_data 8 202 | #define mask_procedure 7 203 | #define tag_procedure 2 204 | #define disp_procedure_code 0 205 | #define disp_procedure_data 8 206 | #define mask_boolean 247 207 | #define tag_boolean 6 208 | #define _false 6 209 | #define _true 14 210 | #define _nil 22 211 | #define _void 30 212 | 213 | typedef long ptr; 214 | 215 | #define UNFIX(x) (x >> shift_fixnum) 216 | #define TAG(x,mask) (x & mask) 217 | #define UNTAG(x,tag) ((x)-tag) 218 | #define CAR(x) (*(ptr *)(UNTAG(x,tag_pair) + disp_car)) 219 | #define CDR(x) (*(ptr *)(UNTAG(x,tag_pair) + disp_cdr)) 220 | #define VECTORLENGTH(x) (*(ptr *)(UNTAG(x,tag_vector) + disp_vector_length)) 221 | #define VECTORDATA(x) ((ptr *)(UNTAG(x,tag_vector) + disp_vector_data)) 222 | 223 | #define MAXDEPTH 100 224 | #define MAXLENGTH 1000 225 | 226 | static void print1(ptr x, int d) { 227 | if (TAG(x, mask_fixnum) == tag_fixnum) { 228 | printf("%ld", (long)UNFIX(x)); 229 | } else if (TAG(x, mask_pair) == tag_pair) { 230 | int len = 0; 231 | ptr y; 232 | 233 | if (d > MAXDEPTH) { 234 | printf("(...)"); 235 | return; 236 | } 237 | printf("("); 238 | print1(CAR(x), d+1); 239 | y = CDR(x); 240 | while (TAG(y, mask_pair) == tag_pair && (len < MAXLENGTH-1)) { 241 | printf(" "); 242 | print1(CAR(y), d+1); 243 | y = CDR(y); 244 | len++; 245 | } 246 | if (y != _nil) 247 | if (len == MAXLENGTH-1) 248 | printf(" ..."); 249 | else { 250 | printf(" . "); 251 | print1(y, d+1); 252 | } 253 | printf(")"); 254 | } else if (TAG(x, mask_vector) == tag_vector) { 255 | long i, n; 256 | ptr *p; 257 | if (d > MAXDEPTH) { 258 | printf("#(...)"); 259 | return; 260 | } 261 | printf("#("); 262 | n = UNFIX(VECTORLENGTH(x)); 263 | p = VECTORDATA(x); 264 | i = n > MAXLENGTH ? MAXLENGTH : n; 265 | if (i != 0) { 266 | print1(*p, d+1); 267 | while (--i) { 268 | printf(" "); 269 | print1(*++p, d+1); 270 | } 271 | } 272 | if (n > MAXLENGTH) printf(" ..."); 273 | printf(")"); 274 | } else if (TAG(x, mask_procedure) == tag_procedure) { 275 | printf("#"); 276 | } else if (x == _false) { 277 | printf("#f"); 278 | } else if (x == _true) { 279 | printf("#t"); 280 | } else if (x == _nil) { 281 | printf("()"); 282 | } else if (x == _void) { 283 | printf("#"); 284 | } 285 | } 286 | 287 | static void print(ptr x) { 288 | print1(x, 0); 289 | } 290 | 291 | #else /* SCHEME_PRINTER */ 292 | 293 | static void print(long x) { 294 | printf("%ld", x); 295 | } 296 | 297 | #endif /* SCHEME_PRINTER */ 298 | -------------------------------------------------------------------------------- /a4/a4-wrapper.ss: -------------------------------------------------------------------------------- 1 | (language-wrapper 2 | (lambda (pass-name x) 3 | (define rewrite-opnds 4 | (lambda (x) 5 | (match x 6 | [,r (guard (disp-opnd? r)) 7 | `(mref ,(disp-opnd-reg r) ,(disp-opnd-offset r))] 8 | [,r (guard (index-opnd? r)) 9 | `(mref ,(index-opnd-breg r) ,(index-opnd-ireg r))] 10 | [(set! ,r ,[expr]) (guard (disp-opnd? r)) 11 | `(mset! ,(disp-opnd-reg r) ,(disp-opnd-offset r) ,expr)] 12 | [(set! ,r ,[expr]) (guard (index-opnd? r)) 13 | `(mset! ,(index-opnd-breg r) ,(index-opnd-ireg r) ,expr)] 14 | [(,[expr] ...) `(,expr ...)] 15 | [,x x]))) 16 | (case pass-name 17 | [(source verify-scheme) 18 | `(let () 19 | (import (except scheme set! lambda)) 20 | (define int64-in-range? 21 | (let () 22 | (import scheme) 23 | (lambda (x) 24 | (<= (- (expt 2 63)) x (- (expt 2 63) 1))))) 25 | (define handle-overflow 26 | (let () 27 | (import scheme) 28 | (lambda (x) 29 | (cond 30 | [(not (number? x)) x] 31 | [(int64-in-range? x) x] 32 | [(not (= x (logand 18446744073709551615 x))) 33 | (handle-overflow (logand 18446744073709551615 x))] 34 | [(< x 0) (handle-overflow (+ x (expt 2 64)))] 35 | [else (handle-overflow (- x (expt 2 64)))])))) 36 | (define-syntax set! 37 | (let () 38 | (import scheme) 39 | (syntax-rules () 40 | [(_ x expr) 41 | (set! x (handle-overflow expr))]))) 42 | (define-syntax locals 43 | (syntax-rules () 44 | [(_ (x* ...) body) (let ([x* 0] ...) body)])) 45 | (define-syntax lambda 46 | (let () 47 | (import scheme) 48 | (syntax-rules () 49 | [(lambda () body) (lambda arg-list body)] 50 | [(lambda arg-list e e* ...) (lambda arg-list e e* ...)]))) 51 | (define (true) #t) 52 | (define (false) #f) 53 | (define (nop) (void)) 54 | (call/cc 55 | (lambda (k) 56 | (set! r15 k) 57 | ,x)) 58 | rax)] 59 | [(uncover-register-conflict) 60 | `(let () 61 | (import (except scheme set! lambda)) 62 | (define int64-in-range? 63 | (let () 64 | (import scheme) 65 | (lambda (x) 66 | (<= (- (expt 2 63)) x (- (expt 2 63) 1))))) 67 | (define handle-overflow 68 | (let () 69 | (import scheme) 70 | (lambda (x) 71 | (cond 72 | [(not (number? x)) x] 73 | [(int64-in-range? x) x] 74 | [(not (= x (logand 18446744073709551615 x))) 75 | (handle-overflow (logand 18446744073709551615 x))] 76 | [(< x 0) (handle-overflow (+ x (expt 2 64)))] 77 | [else (handle-overflow (- x (expt 2 64)))])))) 78 | (define-syntax set! 79 | (let () 80 | (import scheme) 81 | (syntax-rules () 82 | [(_ x expr) 83 | (set! x (handle-overflow expr))]))) 84 | (define-syntax locals 85 | (syntax-rules () 86 | [(_ (x* ...) body) (let ([x* 0] ...) body)])) 87 | (define-syntax lambda 88 | (let () 89 | (import scheme) 90 | (syntax-rules () 91 | [(lambda () body) (lambda arg-list body)] 92 | [(lambda arg-list e e* ...) (lambda arg-list e e* ...)]))) 93 | (define-syntax register-conflict 94 | (syntax-rules () 95 | [(_ ct body) body])) 96 | (define (true) #t) 97 | (define (false) #f) 98 | (define (nop) (void)) 99 | (call/cc 100 | (lambda (k) 101 | (set! r15 k) 102 | ,x)) 103 | rax)] 104 | [(assign-registers) 105 | `(let () 106 | (import (except scheme set! lambda)) 107 | (define int64-in-range? 108 | (let () 109 | (import scheme) 110 | (lambda (x) 111 | (<= (- (expt 2 63)) x (- (expt 2 63) 1))))) 112 | (define handle-overflow 113 | (let () 114 | (import scheme) 115 | (lambda (x) 116 | (cond 117 | [(not (number? x)) x] 118 | [(int64-in-range? x) x] 119 | [(not (= x (logand 18446744073709551615 x))) 120 | (handle-overflow (logand 18446744073709551615 x))] 121 | [(< x 0) (handle-overflow (+ x (expt 2 64)))] 122 | [else (handle-overflow (- x (expt 2 64)))])))) 123 | (define-syntax set! 124 | (let () 125 | (import scheme) 126 | (syntax-rules () 127 | [(_ x expr) 128 | (set! x (handle-overflow expr))]))) 129 | (define-syntax locate 130 | (let () 131 | (import scheme) 132 | (syntax-rules () 133 | [(_ ([x* loc*] ...) body) 134 | (let-syntax ([x* (identifier-syntax 135 | (id loc*) 136 | ((set! id e) 137 | (set! loc* (handle-overflow e))))] ...) 138 | body)]))) 139 | (define-syntax lambda 140 | (let () 141 | (import scheme) 142 | (syntax-rules () 143 | [(lambda () body) (lambda arg-list body)] 144 | [(lambda arg-list e e* ...) (lambda arg-list e e* ...)]))) 145 | (define (true) #t) 146 | (define (false) #f) 147 | (define (nop) (void)) 148 | (call/cc 149 | (lambda (k) 150 | (set! r15 k) 151 | ,x)) 152 | rax)] 153 | [(discard-call-live) 154 | `(let () 155 | (import (except scheme set!)) 156 | (define int64-in-range? 157 | (let () 158 | (import scheme) 159 | (lambda (x) 160 | (<= (- (expt 2 63)) x (- (expt 2 63) 1))))) 161 | (define handle-overflow 162 | (let () 163 | (import scheme) 164 | (lambda (x) 165 | (cond 166 | [(not (number? x)) x] 167 | [(int64-in-range? x) x] 168 | [(not (= x (logand 18446744073709551615 x))) 169 | (handle-overflow (logand 18446744073709551615 x))] 170 | [(< x 0) (handle-overflow (+ x (expt 2 64)))] 171 | [else (handle-overflow (- x (expt 2 64)))])))) 172 | (define-syntax set! 173 | (let () 174 | (import scheme) 175 | (syntax-rules () 176 | [(_ x expr) 177 | (set! x (handle-overflow expr))]))) 178 | (define-syntax locate 179 | (let () 180 | (import scheme) 181 | (syntax-rules () 182 | [(_ ([x* loc*] ...) body) 183 | (let-syntax ([x* (identifier-syntax 184 | (id loc*) 185 | ((set! id e) 186 | (set! loc* (handle-overflow e))))] ...) 187 | body)]))) 188 | (define (true) #t) 189 | (define (false) #f) 190 | (define (nop) (void)) 191 | (call/cc 192 | (lambda (k) 193 | (set! r15 k) 194 | ,x)) 195 | rax)] 196 | [(finalize-locations) 197 | `(let () 198 | (import (except scheme set!)) 199 | (define int64-in-range? 200 | (lambda (x) 201 | (<= (- (expt 2 63)) x (- (expt 2 63) 1)))) 202 | (define handle-overflow 203 | (lambda (x) 204 | (cond 205 | [(not (number? x)) x] 206 | [(int64-in-range? x) x] 207 | [(not (= x (logand 18446744073709551615 x))) 208 | (handle-overflow (logand 18446744073709551615 x))] 209 | [(< x 0) (handle-overflow (+ x (expt 2 64)))] 210 | [else (handle-overflow (- x (expt 2 64)))]))) 211 | (define-syntax set! 212 | (let () 213 | (import scheme) 214 | (syntax-rules () 215 | [(_ x expr) 216 | (set! x (handle-overflow expr))]))) 217 | (define (true) #t) 218 | (define (false) #f) 219 | (define (nop) (void)) 220 | (call/cc 221 | (lambda (k) 222 | (set! r15 k) 223 | ,x)) 224 | rax)] 225 | [(expose-frame-var) 226 | `(let () 227 | (import (except scheme set!)) 228 | (define int64-in-range? 229 | (lambda (x) 230 | (<= (- (expt 2 63)) x (- (expt 2 63) 1)))) 231 | (define handle-overflow 232 | (lambda (x) 233 | (cond 234 | [(not (number? x)) x] 235 | [(int64-in-range? x) x] 236 | [(not (= x (logand 18446744073709551615 x))) 237 | (handle-overflow (logand 18446744073709551615 x))] 238 | [(< x 0) (handle-overflow (+ x (expt 2 64)))] 239 | [else (handle-overflow (- x (expt 2 64)))]))) 240 | (define-syntax set! 241 | (let () 242 | (import scheme) 243 | (syntax-rules () 244 | [(_ x expr) 245 | (set! x (handle-overflow expr))]))) 246 | (define (true) #t) 247 | (define (false) #f) 248 | (define (nop) (void)) 249 | (call/cc 250 | (lambda (k) 251 | (set! r15 k) 252 | ,(rewrite-opnds x))) 253 | rax)] 254 | [(expose-basic-blocks) 255 | `(let () 256 | (import (except scheme set!)) 257 | (define int64-in-range? 258 | (lambda (x) 259 | (<= (- (expt 2 63)) x (- (expt 2 63) 1)))) 260 | (define handle-overflow 261 | (lambda (x) 262 | (cond 263 | [(not (number? x)) x] 264 | [(int64-in-range? x) x] 265 | [(not (= x (logand 18446744073709551615 x))) 266 | (handle-overflow (logand 18446744073709551615 x))] 267 | [(< x 0) (handle-overflow (+ x (expt 2 64)))] 268 | [else (handle-overflow (- x (expt 2 64)))]))) 269 | (define-syntax set! 270 | (let () 271 | (import scheme) 272 | (syntax-rules () 273 | [(_ x expr) 274 | (set! x (handle-overflow expr))]))) 275 | (call/cc 276 | (lambda (k) 277 | (set! r15 k) 278 | ,(rewrite-opnds x))) 279 | rax)] 280 | [(flatten-program) 281 | `(let () 282 | (import (except scheme set!)) 283 | (define int64-in-range? 284 | (lambda (x) 285 | (<= (- (expt 2 63)) x (- (expt 2 63) 1)))) 286 | (define handle-overflow 287 | (lambda (x) 288 | (cond 289 | [(not (number? x)) x] 290 | [(int64-in-range? x) x] 291 | [(not (= x (logand 18446744073709551615 x))) 292 | (handle-overflow (logand 18446744073709551615 x))] 293 | [(< x 0) (handle-overflow (+ x (expt 2 64)))] 294 | [else (handle-overflow (- x (expt 2 64)))]))) 295 | (define-syntax set! 296 | (let () 297 | (import scheme) 298 | (syntax-rules () 299 | [(_ x expr) 300 | (set! x (handle-overflow expr))]))) 301 | (define-syntax code 302 | (lambda (x) 303 | (define build 304 | (lambda (body) 305 | (syntax-case body () 306 | [() #'(())] 307 | [(label expr ...) 308 | (identifier? #'label) 309 | (with-syntax ([((expr ...) defn ...) (build #'(expr ...))]) 310 | #'(((bounce label)) 311 | (define label 312 | (lambda () 313 | (bounce (lambda () expr ...)))) 314 | defn ...))] 315 | [(expr1 expr ...) 316 | (with-syntax ([((expr ...) defn ...) (build #'(expr ...))]) 317 | #'((expr1 expr ...) defn ...))]))) 318 | (syntax-case x () 319 | [(k expr ...) 320 | (with-syntax ([((expr ...) defn ...) (build #'(expr ...))]) 321 | #'((call/cc 322 | (lambda (bounce) 323 | defn ... 324 | expr ...))))]))) 325 | (define-syntax jump 326 | (syntax-rules () 327 | [(_ target) (target)])) 328 | (call/cc 329 | (lambda (k) 330 | (set! r15 k) 331 | ,(rewrite-opnds x))) 332 | rax)] 333 | [else x]))) 334 | -------------------------------------------------------------------------------- /a2/tests2.ss: -------------------------------------------------------------------------------- 1 | (define invalid-tests 2 | '(3 3 | (begin rax 5) 4 | (letrec () 5 | (set! rax 5)) 6 | (letrec () 7 | (set! rax 5) 8 | (r15)) 9 | (letrec () 10 | (begin 11 | (set! rax 5.5) 12 | (r15))) 13 | (letrec (["hello$55" (lambda () (r15))]) 14 | (begin 15 | (set! rax 5) 16 | (r15))) 17 | (letrec ([double$1 (lambda () 18 | (begin 19 | (set! rax (+ rax rax)) 20 | (r15)))] 21 | [double$1 (lambda () 22 | (begin 23 | (set! rdx (+ rdx rdx)) 24 | (set! rax rdx) 25 | (r15)))]) 26 | (begin 27 | (set! rax 10) 28 | (double$1))) 29 | (letrec ([double$1 (lambda () 30 | (begin 31 | (set! rax (+ rax rax)) 32 | (sqr$1)))] 33 | [sqr$1 (lambda () 34 | (begin 35 | (set! rax (* rax rax)) 36 | (r15)))]) 37 | (begin 38 | (set! rax 2) 39 | (double$1))) 40 | (letrec () 41 | (begin 42 | (set! fv0 5) 43 | (set! fv0 (* fv0 5)) 44 | (set! rax fv0) 45 | (r15))) 46 | (letrec ([f$1 (lambda () 47 | (begin 48 | (set! rax 5) 49 | (r15)))]) 50 | (begin 51 | (set! fv0 f$1) 52 | (fv0))) 53 | (letrec ([foo (lambda () 54 | (begin 55 | (set! rax 5) 56 | (r15)))]) 57 | (foo)) 58 | (letrec ([f$5 (lambda (rax) 59 | (begin 60 | (set! rax (+ rax 20)) 61 | (r15)))]) 62 | (set! rax 10) 63 | (f$5)) 64 | (letrec ([f$6 (lambda () 65 | (begin 66 | (set! rax (* rax 100)) 67 | (r15)))]) 68 | (f$6 5)) 69 | (letrec ([f$7 (lambda (rdi) 70 | (begin 71 | (set! fv0 rdi) 72 | (set! fv0 (+ fv0 10)) 73 | (set! rax fv0) 74 | (r15)))]) 75 | (f$7 6)) 76 | (letrec ([foo$0 (lambda () 77 | (begin 78 | (set! rax 5) 79 | (r15)))]) 80 | (bar$1)) 81 | (letrec ([test-double$1 (lambda () 82 | (begin 83 | (set! rdi 5) 84 | (double$2) 85 | (set! rax rdi) 86 | (r15)))] 87 | [double$2 (lambda () 88 | (begin 89 | (set! rdi (+ rdi rdi)) 90 | (r15)))]) 91 | (test-double$1)) 92 | (letrec () 93 | (begin 94 | (set! x 5) 95 | (r15))) 96 | (letrec () 97 | (begin 98 | (set! rax 9223372036854775808) 99 | (r15))) 100 | (letrec () 101 | (begin 102 | (set! rax -9223372036854775809) 103 | (r15))) 104 | (letrec () 105 | (begin 106 | (set! rax (+ rax 2147483648)) 107 | (r15))) 108 | (letrec () 109 | (begin 110 | (set! rax (+ rax -2147483649)) 111 | (r15))) 112 | (letrec () 113 | (begin 114 | (set! fv0 2147483648) 115 | (r15))) 116 | (letrec () 117 | (begin 118 | (set! fv0 -2147483649) 119 | (r15))) 120 | (letrec () 121 | (begin 122 | (set! fv0 12.5) 123 | (r15))) 124 | (letrec () 125 | (letrec () 126 | (begin 127 | (set! rax 5) 128 | (r15)))) 129 | (letrec () 130 | (begin 131 | (set! x 5) 132 | (r15))) 133 | (letrec () 134 | (begin 135 | (set! rax 5) 136 | (set! rax (sra rax -1)) 137 | (r15))) 138 | (letrec 139 | (begin 140 | (set! rax 5) 141 | (r15))) 142 | (letrec () 143 | (begin 144 | (set! rax (sra rax 64)) 145 | (r15))) 146 | (letrec () 147 | (begin 148 | (set! rax (/ rax 5)) 149 | (r15))) 150 | (letrec () 151 | (begin 152 | (set! rdx (+ fv0 rdx)) 153 | (r15))) 154 | (letrec () 155 | (begin 156 | (set! fv0 1) 157 | (set! fv1 2) 158 | (set! fv0 (+ fv0 fv1)))) 159 | (letrec () 160 | (begin 161 | (set! fv0 1) 162 | (set! fv1 fv0) 163 | (r15))) 164 | (letrec () 165 | (begin 166 | (set! fv0 1) 167 | (set! fv1 rax))))) 168 | 169 | (define tests 170 | '((letrec () 171 | (begin 172 | (set! rax 5) 173 | (r15))) 174 | (letrec () 175 | (begin 176 | (set! rax 5) 177 | (set! rax (+ rax 5)) 178 | (r15))) 179 | (letrec () 180 | (begin 181 | (set! rax 10) 182 | (set! rbx rax) 183 | (set! rax (- rax rbx)) 184 | (r15))) 185 | (letrec () 186 | (begin 187 | (set! r11 5) 188 | (set! rax r11) 189 | (r15))) 190 | (letrec () 191 | (begin 192 | (set! r11 10) 193 | (set! rax -10) 194 | (set! rax (* rax r11)) 195 | (r15))) 196 | (letrec () 197 | (begin 198 | (set! r11 10) 199 | (set! r11 (* r11 -10)) 200 | (set! rax r11) 201 | (r15))) 202 | (letrec () 203 | (begin 204 | (set! rax 5) 205 | (set! rax (+ rax 10)) 206 | (r15))) 207 | (letrec () 208 | (begin 209 | (set! r8 5) 210 | (set! rax 10) 211 | (set! rax (+ rax r8)) 212 | (r15))) 213 | (letrec () 214 | (begin 215 | (set! rax 7) 216 | (set! rax (+ rax 4)) 217 | (r15))) 218 | (letrec () 219 | (begin 220 | (set! rax 7) 221 | (set! rax (- rax 4)) 222 | (r15))) 223 | (letrec () 224 | (begin 225 | (set! rax 7) 226 | (set! rax (* rax 4)) 227 | (r15))) 228 | (letrec () 229 | (begin 230 | (set! rax 5) 231 | (set! rbx -11) 232 | (set! rax (+ rax rbx)) 233 | (r15))) 234 | (letrec () 235 | (begin 236 | (set! rax 5) 237 | (set! rbx -11) 238 | (set! rax (- rax rbx)) 239 | (r15))) 240 | (letrec () 241 | (begin 242 | (set! rax 5) 243 | (set! rbx -11) 244 | (set! rax (* rax rbx)) 245 | (r15))) 246 | 247 | ;; some tests dealing with overflow 248 | (letrec () 249 | (begin 250 | (set! rax -9223372036854775808) 251 | (set! rax (- rax 5)) 252 | (r15))) 253 | (letrec () 254 | (begin 255 | (set! rax 9223372036854775807) 256 | (set! rax (+ rax 5)) 257 | (r15))) 258 | (letrec () 259 | (begin 260 | (set! rax 1000000000000000000) 261 | (set! rax (* rax rax)) 262 | (r15))) 263 | (letrec () 264 | (begin 265 | (set! rax 1000000000000000000) 266 | (set! rbx -1) 267 | (set! rbx (* rbx rax)) 268 | (set! rax (* rax rbx)) 269 | (r15))) 270 | 271 | ;; Factorial 5 - the long way. 272 | (letrec () 273 | (begin 274 | (set! rax 5) 275 | (set! rbx 1) 276 | (set! rbx (* rbx rax)) 277 | (set! rax (- rax 1)) 278 | (set! rbx (* rbx rax)) 279 | (set! rax (- rax 1)) 280 | (set! rbx (* rbx rax)) 281 | (set! rax (- rax 1)) 282 | (set! rbx (* rbx rax)) 283 | (set! rax rbx) 284 | (r15))) 285 | ;; Factorial 5 - the long way, nested begins 286 | (letrec () 287 | (begin 288 | (set! rax 5) 289 | (begin 290 | (set! rbx 1) 291 | (begin 292 | (set! rbx (* rbx rax)) 293 | (begin 294 | (set! rax (- rax 1)) 295 | (begin 296 | (set! rbx (* rbx rax)) 297 | (begin 298 | (set! rax (- rax 1)) 299 | (begin 300 | (set! rbx (* rbx rax)) 301 | (begin 302 | (set! rax (- rax 1)) 303 | (begin 304 | (set! rbx (* rbx rax)) 305 | (begin 306 | (set! rax rbx) 307 | (r15)))))))))))) 308 | (letrec ([double$0 (lambda () 309 | (begin 310 | (set! rax (+ rax rax)) 311 | (r15)))]) 312 | (begin 313 | (set! rax 10) 314 | (double$0))) 315 | (letrec ([double$1 (lambda () 316 | (begin 317 | (set! rax fv0) 318 | (set! rax (* rax 2)) 319 | (set! fv0 rax) 320 | (r15)))]) 321 | (begin 322 | (set! fv0 5) 323 | (double$1))) 324 | (letrec ([div$0 (lambda () 325 | (begin 326 | (set! fv2 (sra fv2 1)) 327 | (div$1)))] 328 | [div$1 (lambda () 329 | (begin 330 | (set! rax fv2) 331 | (fv0)))]) 332 | (begin 333 | (set! fv0 r15) 334 | (set! rax div$0) 335 | (set! fv1 rax) 336 | (set! fv2 64) 337 | (fv1))) 338 | (letrec ([return$1 (lambda () 339 | (begin 340 | (set! rax fv0) 341 | (fv1)))] 342 | [setbit3$0 (lambda () 343 | (begin 344 | (set! fv0 (logor fv0 8)) 345 | (return$1)))]) 346 | (begin 347 | (set! fv0 1) 348 | (set! fv1 r15) 349 | (setbit3$0))) 350 | (letrec ([zero?$0 (lambda () 351 | (begin 352 | (set! rdx 0) 353 | (set! rdx (- rdx rax)) 354 | (set! rdx (sra rdx 63)) 355 | (set! rdx (logand rdx 1)) 356 | (return$1)))] 357 | [return$1 (lambda () 358 | (begin 359 | (set! rax rdx) 360 | (r15)))]) 361 | (begin 362 | (set! rax 5) 363 | (zero?$0))) 364 | (letrec ([sqr-double$0 (lambda () 365 | (begin 366 | (set! rdi (* rdi rdi)) 367 | (set! fv0 rdi) 368 | (double$1)))] 369 | [double$1 (lambda () 370 | (begin 371 | (set! rsi fv0) 372 | (set! rsi (+ rsi fv0)) 373 | (return$3)))] 374 | [return$3 (lambda () 375 | (begin 376 | (set! rax rsi) 377 | (r15)))]) 378 | (begin 379 | (set! rdi 5) 380 | (sqr-double$0))) 381 | (letrec ([main$1 (lambda () 382 | (begin 383 | (set! rax 5) 384 | (r15)))]) 385 | (main$1)) 386 | (letrec ([fact$0 (lambda () 387 | (begin 388 | ; no if, so use a computed goto 389 | ; put address of fact$1 at bfp[0] 390 | (set! rcx fact$1) 391 | (set! fv0 rcx) 392 | ; put address of fact$2 at bfp[8] 393 | (set! rcx fact$2) 394 | (set! fv1 rcx) 395 | ; if x == 0 set rcx to 8, else set rcx to 0 396 | (set! rdx 0) 397 | (set! rdx (- rdx rax)) 398 | (set! rdx (sra rdx 63)) 399 | (set! rdx (logand rdx 8)) 400 | ; point bfp at stored address of fact$1 or fact$2 401 | (set! rbp (+ rbp rdx)) 402 | ; grab whichever and reset bfp 403 | (set! rcx fv0) 404 | (set! rbp (- rbp rdx)) 405 | ; tail call (jump to) fact$1 or fact$2 406 | (rcx)))] 407 | [fact$1 (lambda () 408 | (begin 409 | ; get here if rax is zero, so return 1 410 | (set! rax 1) 411 | (r15)))] 412 | [fact$2 (lambda () 413 | (begin 414 | ; get here if rax is nonzero, so save return 415 | ; address and eax, then call fact$0 recursively 416 | ; with eax - 1, setting fact$3 as return point 417 | (set! fv0 r15) 418 | (set! fv1 rax) 419 | (set! rax (- rax 1)) 420 | (set! r15 fact$3) 421 | ; bump rbp by 16 (two 64-bit words) so that 422 | ; recursive call doesn't wipe out our saved 423 | ; eax and return address 424 | (set! rbp (+ rbp 16)) 425 | (fact$0)))] 426 | [fact$3 (lambda () 427 | (begin 428 | ; restore rbp to original value 429 | (set! rbp (- rbp 16)) 430 | ; eax holds value of recursive call, multiply 431 | ; by saved value at fv1 and return to saved 432 | ; return address at fv0 433 | (set! rax (* rax fv1)) 434 | (fv0)))]) 435 | (begin 436 | (set! rax 10) 437 | (fact$0))) 438 | ;------------------------------------------------------------------------ 439 | ; My test of Fibonacci calculator 440 | ;------------------------------------------------------------------------ 441 | ; Calculates Fib(n), where n is set in rcx in the body of letrec. 442 | ; 443 | ; The original fv0 holds the address referred by label loop$1, 444 | ; fv1 holds the return address given by r15. 445 | ; Controller performs a computed goto based on the value 446 | ; of rcx. The rule is if rcx is positive or zero jump to loop$1. 447 | ; If negative jump to exit (return). The trick here is to 448 | ; shift/reduce rbp based on a computer value of 0 or 8. 449 | ; Controller reduces rcx each time it is called to guarantee 450 | ; the jump to exit. The register rax will hold the final answer. 451 | ;------------------------------------------------------------------------ 452 | (letrec ([loop$1 (lambda () (begin 453 | (set! rax (+ rax rbx)) 454 | (set! rbx r11) 455 | (set! r11 rax) 456 | (controller$2)))] 457 | [controller$2 (lambda () (begin 458 | (set! rdx rcx) 459 | ; shift rdx righ by 63 460 | ; output of this is (in 2's comp.) 461 | ; 0 if rdx is zero or positive 462 | ; else -1. 463 | (set! rdx (sra rdx 63)) 464 | ; this will result either 0 or 8 465 | ; 8 if rdx was negative 466 | (set! rdx (logand rdx 8)) 467 | (set! rbp (+ rbp rdx)) 468 | ; fv0 may either be the original fv0 469 | ; or original fv1 (if rdx was neg.). 470 | ; original fv1 has the exit address. 471 | (set! r15 fv0) 472 | ; reset rbp 473 | (set! rbp (- rbp rdx)) 474 | ; reduce rcx by 1 475 | (set! rcx (- rcx 1)) 476 | (r15)))]) 477 | (begin 478 | ; set initial values 479 | (set! rax 1) 480 | (set! rbx 0) 481 | (set! r11 0) 482 | ; keep the address referred by label loop$1 in fv0 483 | (set! rdx loop$1) 484 | (set! fv0 rdx) 485 | ; keep the return address in fv1 486 | (set! rdx r15) 487 | (set! fv1 rdx) 488 | ; the number we are interested in (e.g.Fib(10)) 489 | (set! rcx 10) 490 | ; jump to the controller 491 | (controller$2))))) 492 | 493 | -------------------------------------------------------------------------------- /a5/a5-wrapper.ss: -------------------------------------------------------------------------------- 1 | (language-wrapper 2 | (lambda (pass-name x) 3 | (define rewrite-opnds 4 | (lambda (x) 5 | (match x 6 | [,r (guard (disp-opnd? r)) 7 | `(mref ,(disp-opnd-reg r) ,(disp-opnd-offset r))] 8 | [,r (guard (index-opnd? r)) 9 | `(mref ,(index-opnd-breg r) ,(index-opnd-ireg r))] 10 | [(set! ,r ,[expr]) (guard (disp-opnd? r)) 11 | `(mset! ,(disp-opnd-reg r) ,(disp-opnd-offset r) ,expr)] 12 | [(set! ,r ,[expr]) (guard (index-opnd? r)) 13 | `(mset! ,(index-opnd-breg r) ,(index-opnd-ireg r) ,expr)] 14 | [(,[expr] ...) `(,expr ...)] 15 | [,x x]))) 16 | (case pass-name 17 | [(source verify-scheme) 18 | `(let () 19 | (import (except scheme set! lambda)) 20 | (define int64-in-range? 21 | (let () 22 | (import scheme) 23 | (lambda (x) 24 | (<= (- (expt 2 63)) x (- (expt 2 63) 1))))) 25 | (define handle-overflow 26 | (let () 27 | (import scheme) 28 | (lambda (x) 29 | (cond 30 | [(not (number? x)) x] 31 | [(int64-in-range? x) x] 32 | [(not (= x (logand 18446744073709551615 x))) 33 | (handle-overflow (logand 18446744073709551615 x))] 34 | [(< x 0) (handle-overflow (+ x (expt 2 64)))] 35 | [else (handle-overflow (- x (expt 2 64)))])))) 36 | (define-syntax set! 37 | (let () 38 | (import scheme) 39 | (syntax-rules () 40 | [(_ x expr) 41 | (set! x (handle-overflow expr))]))) 42 | (define-syntax locals 43 | (syntax-rules () 44 | [(_ (x* ...) body) (let ([x* 0] ...) body)])) 45 | (define-syntax lambda 46 | (let () 47 | (import scheme) 48 | (syntax-rules () 49 | [(lambda () body) (lambda arg-list body)] 50 | [(lambda arg-list e e* ...) (lambda arg-list e e* ...)]))) 51 | (define (true) #t) 52 | (define (false) #f) 53 | (define (nop) (void)) 54 | (call/cc 55 | (lambda (k) 56 | (set! r15 k) 57 | ,x)) 58 | rax)] 59 | [(uncover-frame-conflict) 60 | `(let () 61 | (import (except scheme set! lambda)) 62 | (define int64-in-range? 63 | (let () 64 | (import scheme) 65 | (lambda (x) 66 | (<= (- (expt 2 63)) x (- (expt 2 63) 1))))) 67 | (define handle-overflow 68 | (let () 69 | (import scheme) 70 | (lambda (x) 71 | (cond 72 | [(not (number? x)) x] 73 | [(int64-in-range? x) x] 74 | [(not (= x (logand 18446744073709551615 x))) 75 | (handle-overflow (logand 18446744073709551615 x))] 76 | [(< x 0) (handle-overflow (+ x (expt 2 64)))] 77 | [else (handle-overflow (- x (expt 2 64)))])))) 78 | (define-syntax set! 79 | (let () 80 | (import scheme) 81 | (syntax-rules () 82 | [(_ x expr) 83 | (set! x (handle-overflow expr))]))) 84 | (define-syntax locals 85 | (syntax-rules () 86 | [(_ (x* ...) body) (let ([x* 0] ...) body)])) 87 | (define-syntax lambda 88 | (let () 89 | (import scheme) 90 | (syntax-rules () 91 | [(lambda () body) (lambda arg-list body)] 92 | [(lambda arg-list e e* ...) (lambda arg-list e e* ...)]))) 93 | (define-syntax frame-conflict 94 | (syntax-rules () 95 | [(_ ct body) body])) 96 | (define (true) #t) 97 | (define (false) #f) 98 | (define (nop) (void)) 99 | (call/cc 100 | (lambda (k) 101 | (set! r15 k) 102 | ,x)) 103 | rax)] 104 | [(introduce-allocation-forms finalize-frame-locations 105 | select-instructions assign-frame) 106 | `(let () 107 | (import (except scheme set! lambda)) 108 | (define int64-in-range? 109 | (let () 110 | (import scheme) 111 | (lambda (x) 112 | (<= (- (expt 2 63)) x (- (expt 2 63) 1))))) 113 | (define handle-overflow 114 | (let () 115 | (import scheme) 116 | (lambda (x) 117 | (cond 118 | [(not (number? x)) x] 119 | [(int64-in-range? x) x] 120 | [(not (= x (logand 18446744073709551615 x))) 121 | (handle-overflow (logand 18446744073709551615 x))] 122 | [(< x 0) (handle-overflow (+ x (expt 2 64)))] 123 | [else (handle-overflow (- x (expt 2 64)))])))) 124 | (define-syntax set! 125 | (let () 126 | (import scheme) 127 | (syntax-rules () 128 | [(_ x expr) 129 | (set! x (handle-overflow expr))]))) 130 | (define-syntax locals 131 | (syntax-rules () 132 | [(_ (x* ...) body) (let ([x* 0] ...) body)])) 133 | (define-syntax ulocals 134 | (syntax-rules () 135 | [(_ (x* ...) body) (let ([x* 0] ...) body)])) 136 | (define-syntax locate 137 | (let () 138 | (import scheme) 139 | (syntax-rules () 140 | [(_ ([x* loc*] ...) body) 141 | (let-syntax ([x* (identifier-syntax 142 | (id loc*) 143 | ((set! id e) 144 | (set! loc* (handle-overflow e))))] ...) 145 | body)]))) 146 | (define-syntax lambda 147 | (let () 148 | (import scheme) 149 | (syntax-rules () 150 | [(lambda () body) (lambda arg-list body)] 151 | [(lambda arg-list e e* ...) (lambda arg-list e e* ...)]))) 152 | (define-syntax frame-conflict 153 | (syntax-rules () 154 | [(_ ct body) body])) 155 | (define (true) #t) 156 | (define (false) #f) 157 | (define (nop) (void)) 158 | (call/cc 159 | (lambda (k) 160 | (set! r15 k) 161 | ,x)) 162 | rax)] 163 | [(uncover-register-conflict) 164 | `(let () 165 | (import (except scheme set! lambda)) 166 | (define int64-in-range? 167 | (let () 168 | (import scheme) 169 | (lambda (x) 170 | (<= (- (expt 2 63)) x (- (expt 2 63) 1))))) 171 | (define handle-overflow 172 | (let () 173 | (import scheme) 174 | (lambda (x) 175 | (cond 176 | [(not (number? x)) x] 177 | [(int64-in-range? x) x] 178 | [(not (= x (logand 18446744073709551615 x))) 179 | (handle-overflow (logand 18446744073709551615 x))] 180 | [(< x 0) (handle-overflow (+ x (expt 2 64)))] 181 | [else (handle-overflow (- x (expt 2 64)))])))) 182 | (define-syntax set! 183 | (let () 184 | (import scheme) 185 | (syntax-rules () 186 | [(_ x expr) 187 | (set! x (handle-overflow expr))]))) 188 | (define-syntax locate 189 | (let () 190 | (import scheme) 191 | (syntax-rules () 192 | [(_ ([x* loc*] ...) body) 193 | (let-syntax ([x* (identifier-syntax 194 | (id loc*) 195 | ((set! id e) 196 | (set! loc* (handle-overflow e))))] ...) 197 | body)]))) 198 | (define-syntax locals 199 | (syntax-rules () 200 | [(_ (x* ...) body) (let ([x* 0] ...) body)])) 201 | (define-syntax ulocals 202 | (syntax-rules () 203 | [(_ (x* ...) body) (let ([x* 0] ...) body)])) 204 | (define-syntax lambda 205 | (let () 206 | (import scheme) 207 | (syntax-rules () 208 | [(lambda () body) (lambda arg-list body)] 209 | [(lambda arg-list e e* ...) (lambda arg-list e e* ...)]))) 210 | (define-syntax frame-conflict 211 | (syntax-rules () 212 | [(_ ct body) body])) 213 | (define-syntax register-conflict 214 | (syntax-rules () 215 | [(_ ct body) body])) 216 | (define (true) #t) 217 | (define (false) #f) 218 | (define (nop) (void)) 219 | (call/cc 220 | (lambda (k) 221 | (set! r15 k) 222 | ,x)) 223 | rax)] 224 | [(assign-registers) 225 | `(let () 226 | (import (except scheme set! lambda)) 227 | (define int64-in-range? 228 | (let () 229 | (import scheme) 230 | (lambda (x) 231 | (<= (- (expt 2 63)) x (- (expt 2 63) 1))))) 232 | (define handle-overflow 233 | (let () 234 | (import scheme) 235 | (lambda (x) 236 | (cond 237 | [(not (number? x)) x] 238 | [(int64-in-range? x) x] 239 | [(not (= x (logand 18446744073709551615 x))) 240 | (handle-overflow (logand 18446744073709551615 x))] 241 | [(< x 0) (handle-overflow (+ x (expt 2 64)))] 242 | [else (handle-overflow (- x (expt 2 64)))])))) 243 | (define-syntax set! 244 | (let () 245 | (import scheme) 246 | (syntax-rules () 247 | [(_ x expr) 248 | (set! x (handle-overflow expr))]))) 249 | (define-syntax locate 250 | (let () 251 | (import scheme) 252 | (syntax-rules () 253 | [(_ ([x* loc*] ...) body) 254 | (let-syntax ([x* (identifier-syntax 255 | (id loc*) 256 | ((set! id e) 257 | (set! loc* (handle-overflow e))))] ...) 258 | body)]))) 259 | (define-syntax locals 260 | (syntax-rules () 261 | [(_ (x* ...) body) (let ([x* 0] ...) body)])) 262 | (define-syntax ulocals 263 | (syntax-rules () 264 | [(_ (x* ...) body) (let ([x* 0] ...) body)])) 265 | (define-syntax spills 266 | (syntax-rules () 267 | [(_ (x* ...) body) (let ([x* 0] ...) body)])) 268 | (define-syntax frame-conflict 269 | (syntax-rules () 270 | [(_ ct body) body])) 271 | (define-syntax lambda 272 | (let () 273 | (import scheme) 274 | (syntax-rules () 275 | [(lambda () body) (lambda arg-list body)] 276 | [(lambda arg-list e e* ...) (lambda arg-list e e* ...)]))) 277 | (define (true) #t) 278 | (define (false) #f) 279 | (define (nop) (void)) 280 | (call/cc 281 | (lambda (k) 282 | (set! r15 k) 283 | ,x)) 284 | rax)] 285 | [(discard-call-live) 286 | `(let () 287 | (import (except scheme set!)) 288 | (define int64-in-range? 289 | (let () 290 | (import scheme) 291 | (lambda (x) 292 | (<= (- (expt 2 63)) x (- (expt 2 63) 1))))) 293 | (define handle-overflow 294 | (let () 295 | (import scheme) 296 | (lambda (x) 297 | (cond 298 | [(not (number? x)) x] 299 | [(int64-in-range? x) x] 300 | [(not (= x (logand 18446744073709551615 x))) 301 | (handle-overflow (logand 18446744073709551615 x))] 302 | [(< x 0) (handle-overflow (+ x (expt 2 64)))] 303 | [else (handle-overflow (- x (expt 2 64)))])))) 304 | (define-syntax set! 305 | (let () 306 | (import scheme) 307 | (syntax-rules () 308 | [(_ x expr) 309 | (set! x (handle-overflow expr))]))) 310 | (define-syntax locate 311 | (let () 312 | (import scheme) 313 | (syntax-rules () 314 | [(_ ([x* loc*] ...) body) 315 | (let-syntax ([x* (identifier-syntax 316 | (id loc*) 317 | ((set! id e) 318 | (set! loc* (handle-overflow e))))] ...) 319 | body)]))) 320 | (define (true) #t) 321 | (define (false) #f) 322 | (define (nop) (void)) 323 | (call/cc 324 | (lambda (k) 325 | (set! r15 k) 326 | ,x)) 327 | rax)] 328 | [(finalize-locations) 329 | `(let () 330 | (import (except scheme set!)) 331 | (define int64-in-range? 332 | (lambda (x) 333 | (<= (- (expt 2 63)) x (- (expt 2 63) 1)))) 334 | (define handle-overflow 335 | (lambda (x) 336 | (cond 337 | [(not (number? x)) x] 338 | [(int64-in-range? x) x] 339 | [(not (= x (logand 18446744073709551615 x))) 340 | (handle-overflow (logand 18446744073709551615 x))] 341 | [(< x 0) (handle-overflow (+ x (expt 2 64)))] 342 | [else (handle-overflow (- x (expt 2 64)))]))) 343 | (define-syntax set! 344 | (let () 345 | (import scheme) 346 | (syntax-rules () 347 | [(_ x expr) 348 | (set! x (handle-overflow expr))]))) 349 | (define (true) #t) 350 | (define (false) #f) 351 | (define (nop) (void)) 352 | (call/cc 353 | (lambda (k) 354 | (set! r15 k) 355 | ,x)) 356 | rax)] 357 | [(expose-frame-var) 358 | `(let () 359 | (import (except scheme set!)) 360 | (define int64-in-range? 361 | (lambda (x) 362 | (<= (- (expt 2 63)) x (- (expt 2 63) 1)))) 363 | (define handle-overflow 364 | (lambda (x) 365 | (cond 366 | [(not (number? x)) x] 367 | [(int64-in-range? x) x] 368 | [(not (= x (logand 18446744073709551615 x))) 369 | (handle-overflow (logand 18446744073709551615 x))] 370 | [(< x 0) (handle-overflow (+ x (expt 2 64)))] 371 | [else (handle-overflow (- x (expt 2 64)))]))) 372 | (define-syntax set! 373 | (let () 374 | (import scheme) 375 | (syntax-rules () 376 | [(_ x expr) 377 | (set! x (handle-overflow expr))]))) 378 | (define (true) #t) 379 | (define (false) #f) 380 | (define (nop) (void)) 381 | (call/cc 382 | (lambda (k) 383 | (set! r15 k) 384 | ,(rewrite-opnds x))) 385 | rax)] 386 | [(expose-basic-blocks) 387 | `(let () 388 | (import (except scheme set!)) 389 | (define int64-in-range? 390 | (lambda (x) 391 | (<= (- (expt 2 63)) x (- (expt 2 63) 1)))) 392 | (define handle-overflow 393 | (lambda (x) 394 | (cond 395 | [(not (number? x)) x] 396 | [(int64-in-range? x) x] 397 | [(not (= x (logand 18446744073709551615 x))) 398 | (handle-overflow (logand 18446744073709551615 x))] 399 | [(< x 0) (handle-overflow (+ x (expt 2 64)))] 400 | [else (handle-overflow (- x (expt 2 64)))]))) 401 | (define-syntax set! 402 | (let () 403 | (import scheme) 404 | (syntax-rules () 405 | [(_ x expr) 406 | (set! x (handle-overflow expr))]))) 407 | (call/cc 408 | (lambda (k) 409 | (set! r15 k) 410 | ,(rewrite-opnds x))) 411 | rax)] 412 | [(flatten-program) 413 | `(let () 414 | (import (except scheme set!)) 415 | (define int64-in-range? 416 | (lambda (x) 417 | (<= (- (expt 2 63)) x (- (expt 2 63) 1)))) 418 | (define handle-overflow 419 | (lambda (x) 420 | (cond 421 | [(not (number? x)) x] 422 | [(int64-in-range? x) x] 423 | [(not (= x (logand 18446744073709551615 x))) 424 | (handle-overflow (logand 18446744073709551615 x))] 425 | [(< x 0) (handle-overflow (+ x (expt 2 64)))] 426 | [else (handle-overflow (- x (expt 2 64)))]))) 427 | (define-syntax set! 428 | (let () 429 | (import scheme) 430 | (syntax-rules () 431 | [(_ x expr) 432 | (set! x (handle-overflow expr))]))) 433 | (define-syntax code 434 | (lambda (x) 435 | (define build 436 | (lambda (body) 437 | (syntax-case body () 438 | [() #'(())] 439 | [(label expr ...) 440 | (identifier? #'label) 441 | (with-syntax ([((expr ...) defn ...) (build #'(expr ...))]) 442 | #'(((bounce label)) 443 | (define label 444 | (lambda () 445 | (bounce (lambda () expr ...)))) 446 | defn ...))] 447 | [(expr1 expr ...) 448 | (with-syntax ([((expr ...) defn ...) (build #'(expr ...))]) 449 | #'((expr1 expr ...) defn ...))]))) 450 | (syntax-case x () 451 | [(k expr ...) 452 | (with-syntax ([((expr ...) defn ...) (build #'(expr ...))]) 453 | #'((call/cc 454 | (lambda (bounce) 455 | defn ... 456 | expr ...))))]))) 457 | (define-syntax jump 458 | (syntax-rules () 459 | [(_ target) (target)])) 460 | (call/cc 461 | (lambda (k) 462 | (set! r15 k) 463 | ,(rewrite-opnds x))) 464 | rax)] 465 | [else x]))) 466 | -------------------------------------------------------------------------------- /a6/a6-wrapper.ss: -------------------------------------------------------------------------------- 1 | (language-wrapper 2 | (lambda (pass-name x) 3 | (define rewrite-opnds 4 | (lambda (x) 5 | (match x 6 | [,r (guard (disp-opnd? r)) 7 | `(mref ,(disp-opnd-reg r) ,(disp-opnd-offset r))] 8 | [,r (guard (index-opnd? r)) 9 | `(mref ,(index-opnd-breg r) ,(index-opnd-ireg r))] 10 | [(set! ,r ,[expr]) (guard (disp-opnd? r)) 11 | `(mset! ,(disp-opnd-reg r) ,(disp-opnd-offset r) ,expr)] 12 | [(set! ,r ,[expr]) (guard (index-opnd? r)) 13 | `(mset! ,(index-opnd-breg r) ,(index-opnd-ireg r) ,expr)] 14 | [(,[expr] ...) `(,expr ...)] 15 | [,x x]))) 16 | (case pass-name 17 | [(source verify-scheme remove-complex-opera* flatten-set!) 18 | `(let () 19 | (import (except scheme set!)) 20 | (define int64-in-range? 21 | (let () 22 | (import scheme) 23 | (lambda (x) 24 | (<= (- (expt 2 63)) x (- (expt 2 63) 1))))) 25 | (define handle-overflow 26 | (let () 27 | (import scheme) 28 | (lambda (x) 29 | (cond 30 | [(not (number? x)) x] 31 | [(int64-in-range? x) x] 32 | [(not (= x (logand 18446744073709551615 x))) 33 | (handle-overflow (logand 18446744073709551615 x))] 34 | [(< x 0) (handle-overflow (+ x (expt 2 64)))] 35 | [else (handle-overflow (- x (expt 2 64)))])))) 36 | (define-syntax set! 37 | (let () 38 | (import scheme) 39 | (syntax-rules () 40 | [(_ x expr) 41 | (set! x (handle-overflow expr))]))) 42 | (define-syntax locals 43 | (syntax-rules () 44 | [(_ (x* ...) body) (let ([x* 0] ...) body)])) 45 | (define (true) #t) 46 | (define (false) #f) 47 | (define (nop) (void)) 48 | ,x)] 49 | [(impose-calling-conventions) 50 | `(let () 51 | (import (except scheme set! lambda)) 52 | (define int64-in-range? 53 | (let () 54 | (import scheme) 55 | (lambda (x) 56 | (<= (- (expt 2 63)) x (- (expt 2 63) 1))))) 57 | (define handle-overflow 58 | (let () 59 | (import scheme) 60 | (lambda (x) 61 | (cond 62 | [(not (number? x)) x] 63 | [(int64-in-range? x) x] 64 | [(not (= x (logand 18446744073709551615 x))) 65 | (handle-overflow (logand 18446744073709551615 x))] 66 | [(< x 0) (handle-overflow (+ x (expt 2 64)))] 67 | [else (handle-overflow (- x (expt 2 64)))])))) 68 | (define-syntax set! 69 | (let () 70 | (import scheme) 71 | (syntax-rules () 72 | [(_ x expr) 73 | (set! x (handle-overflow expr))]))) 74 | (define-syntax lambda 75 | (let () 76 | (import scheme) 77 | (syntax-rules () 78 | [(lambda () body) (lambda arg-list body)] 79 | [(lambda arg-list e e* ...) (lambda arg-list e e* ...)]))) 80 | (define-syntax locals 81 | (syntax-rules () 82 | [(_ (x* ...) body) (let ([x* 0] ...) body)])) 83 | (define (true) #t) 84 | (define (false) #f) 85 | (define (nop) (void)) 86 | (call/cc 87 | (lambda (k) 88 | (set! ,return-address-register k) 89 | ,x)) 90 | ,return-value-register)] 91 | [(uncover-frame-conflict) 92 | `(let () 93 | (import (except scheme set! lambda)) 94 | (define int64-in-range? 95 | (let () 96 | (import scheme) 97 | (lambda (x) 98 | (<= (- (expt 2 63)) x (- (expt 2 63) 1))))) 99 | (define handle-overflow 100 | (let () 101 | (import scheme) 102 | (lambda (x) 103 | (cond 104 | [(not (number? x)) x] 105 | [(int64-in-range? x) x] 106 | [(not (= x (logand 18446744073709551615 x))) 107 | (handle-overflow (logand 18446744073709551615 x))] 108 | [(< x 0) (handle-overflow (+ x (expt 2 64)))] 109 | [else (handle-overflow (- x (expt 2 64)))])))) 110 | (define-syntax set! 111 | (let () 112 | (import scheme) 113 | (syntax-rules () 114 | [(_ x expr) 115 | (set! x (handle-overflow expr))]))) 116 | (define-syntax locals 117 | (syntax-rules () 118 | [(_ (x* ...) body) (let ([x* 0] ...) body)])) 119 | (define-syntax lambda 120 | (let () 121 | (import scheme) 122 | (syntax-rules () 123 | [(lambda () body) (lambda arg-list body)] 124 | [(lambda arg-list e e* ...) (lambda arg-list e e* ...)]))) 125 | (define-syntax frame-conflict 126 | (syntax-rules () 127 | [(_ ct body) body])) 128 | (define (true) #t) 129 | (define (false) #f) 130 | (define (nop) (void)) 131 | (call/cc 132 | (lambda (k) 133 | (set! ,return-address-register k) 134 | ,x)) 135 | ,return-value-register)] 136 | [(uncover-call-live-spills) 137 | `(let () 138 | (import (except scheme set! lambda)) 139 | (define int64-in-range? 140 | (let () 141 | (import scheme) 142 | (lambda (x) 143 | (<= (- (expt 2 63)) x (- (expt 2 63) 1))))) 144 | (define handle-overflow 145 | (let () 146 | (import scheme) 147 | (lambda (x) 148 | (cond 149 | [(not (number? x)) x] 150 | [(int64-in-range? x) x] 151 | [(not (= x (logand 18446744073709551615 x))) 152 | (handle-overflow (logand 18446744073709551615 x))] 153 | [(< x 0) (handle-overflow (+ x (expt 2 64)))] 154 | [else (handle-overflow (- x (expt 2 64)))])))) 155 | (define-syntax set! 156 | (let () 157 | (import scheme) 158 | (syntax-rules () 159 | [(_ x expr) 160 | (set! x (handle-overflow expr))]))) 161 | (define-syntax locals 162 | (syntax-rules () 163 | [(_ (x* ...) body) (let ([x* 0] ...) body)])) 164 | (define-syntax spills 165 | (syntax-rules () 166 | [(_ (x* ...) body) (let ([x* 0] ...) body)])) 167 | (define-syntax locate 168 | (let () 169 | (import scheme) 170 | (syntax-rules () 171 | [(_ ([x* loc*] ...) body) 172 | (let-syntax ([x* (identifier-syntax 173 | (id loc*) 174 | ((set! id e) 175 | (set! loc* (handle-overflow e))))] ...) 176 | body)]))) 177 | (define-syntax lambda 178 | (let () 179 | (import scheme) 180 | (syntax-rules () 181 | [(lambda () body) (lambda arg-list body)] 182 | [(lambda arg-list e e* ...) (lambda arg-list e e* ...)]))) 183 | (define-syntax frame-conflict 184 | (syntax-rules () 185 | [(_ ct body) body])) 186 | (define (true) #t) 187 | (define (false) #f) 188 | (define (nop) (void)) 189 | (call/cc 190 | (lambda (k) 191 | (set! ,return-address-register k) 192 | ,x)) 193 | ,return-value-register)] 194 | [(introduce-allocation-forms finalize-frame-locations 195 | select-instructions assign-frame) 196 | `(let () 197 | (import (except scheme set! lambda)) 198 | (define int64-in-range? 199 | (let () 200 | (import scheme) 201 | (lambda (x) 202 | (<= (- (expt 2 63)) x (- (expt 2 63) 1))))) 203 | (define handle-overflow 204 | (let () 205 | (import scheme) 206 | (lambda (x) 207 | (cond 208 | [(not (number? x)) x] 209 | [(int64-in-range? x) x] 210 | [(not (= x (logand 18446744073709551615 x))) 211 | (handle-overflow (logand 18446744073709551615 x))] 212 | [(< x 0) (handle-overflow (+ x (expt 2 64)))] 213 | [else (handle-overflow (- x (expt 2 64)))])))) 214 | (define-syntax set! 215 | (let () 216 | (import scheme) 217 | (syntax-rules () 218 | [(_ x expr) 219 | (set! x (handle-overflow expr))]))) 220 | (define-syntax locals 221 | (syntax-rules () 222 | [(_ (x* ...) body) (let ([x* 0] ...) body)])) 223 | (define-syntax ulocals 224 | (syntax-rules () 225 | [(_ (x* ...) body) (let ([x* 0] ...) body)])) 226 | (define-syntax locate 227 | (let () 228 | (import scheme) 229 | (syntax-rules () 230 | [(_ ([x* loc*] ...) body) 231 | (let-syntax ([x* (identifier-syntax 232 | (id loc*) 233 | ((set! id e) 234 | (set! loc* (handle-overflow e))))] ...) 235 | body)]))) 236 | (define-syntax lambda 237 | (let () 238 | (import scheme) 239 | (syntax-rules () 240 | [(lambda () body) (lambda arg-list body)] 241 | [(lambda arg-list e e* ...) (lambda arg-list e e* ...)]))) 242 | (define-syntax frame-conflict 243 | (syntax-rules () 244 | [(_ ct body) body])) 245 | (define (true) #t) 246 | (define (false) #f) 247 | (define (nop) (void)) 248 | (call/cc 249 | (lambda (k) 250 | (set! ,return-address-register k) 251 | ,x)) 252 | ,return-value-register)] 253 | [(uncover-register-conflict) 254 | `(let () 255 | (import (except scheme set! lambda)) 256 | (define int64-in-range? 257 | (let () 258 | (import scheme) 259 | (lambda (x) 260 | (<= (- (expt 2 63)) x (- (expt 2 63) 1))))) 261 | (define handle-overflow 262 | (let () 263 | (import scheme) 264 | (lambda (x) 265 | (cond 266 | [(not (number? x)) x] 267 | [(int64-in-range? x) x] 268 | [(not (= x (logand 18446744073709551615 x))) 269 | (handle-overflow (logand 18446744073709551615 x))] 270 | [(< x 0) (handle-overflow (+ x (expt 2 64)))] 271 | [else (handle-overflow (- x (expt 2 64)))])))) 272 | (define-syntax set! 273 | (let () 274 | (import scheme) 275 | (syntax-rules () 276 | [(_ x expr) 277 | (set! x (handle-overflow expr))]))) 278 | (define-syntax locate 279 | (let () 280 | (import scheme) 281 | (syntax-rules () 282 | [(_ ([x* loc*] ...) body) 283 | (let-syntax ([x* (identifier-syntax 284 | (id loc*) 285 | ((set! id e) 286 | (set! loc* (handle-overflow e))))] ...) 287 | body)]))) 288 | (define-syntax locals 289 | (syntax-rules () 290 | [(_ (x* ...) body) (let ([x* 0] ...) body)])) 291 | (define-syntax ulocals 292 | (syntax-rules () 293 | [(_ (x* ...) body) (let ([x* 0] ...) body)])) 294 | (define-syntax lambda 295 | (let () 296 | (import scheme) 297 | (syntax-rules () 298 | [(lambda () body) (lambda arg-list body)] 299 | [(lambda arg-list e e* ...) (lambda arg-list e e* ...)]))) 300 | (define-syntax frame-conflict 301 | (syntax-rules () 302 | [(_ ct body) body])) 303 | (define-syntax register-conflict 304 | (syntax-rules () 305 | [(_ ct body) body])) 306 | (define (true) #t) 307 | (define (false) #f) 308 | (define (nop) (void)) 309 | (call/cc 310 | (lambda (k) 311 | (set! ,return-address-register k) 312 | ,x)) 313 | ,return-value-register)] 314 | [(assign-registers) 315 | `(let () 316 | (import (except scheme set! lambda)) 317 | (define int64-in-range? 318 | (let () 319 | (import scheme) 320 | (lambda (x) 321 | (<= (- (expt 2 63)) x (- (expt 2 63) 1))))) 322 | (define handle-overflow 323 | (let () 324 | (import scheme) 325 | (lambda (x) 326 | (cond 327 | [(not (number? x)) x] 328 | [(int64-in-range? x) x] 329 | [(not (= x (logand 18446744073709551615 x))) 330 | (handle-overflow (logand 18446744073709551615 x))] 331 | [(< x 0) (handle-overflow (+ x (expt 2 64)))] 332 | [else (handle-overflow (- x (expt 2 64)))])))) 333 | (define-syntax set! 334 | (let () 335 | (import scheme) 336 | (syntax-rules () 337 | [(_ x expr) 338 | (set! x (handle-overflow expr))]))) 339 | (define-syntax locate 340 | (let () 341 | (import scheme) 342 | (syntax-rules () 343 | [(_ ([x* loc*] ...) body) 344 | (let-syntax ([x* (identifier-syntax 345 | (id loc*) 346 | ((set! id e) 347 | (set! loc* (handle-overflow e))))] ...) 348 | body)]))) 349 | (define-syntax locals 350 | (syntax-rules () 351 | [(_ (x* ...) body) (let ([x* 0] ...) body)])) 352 | (define-syntax ulocals 353 | (syntax-rules () 354 | [(_ (x* ...) body) (let ([x* 0] ...) body)])) 355 | (define-syntax spills 356 | (syntax-rules () 357 | [(_ (x* ...) body) (let ([x* 0] ...) body)])) 358 | (define-syntax frame-conflict 359 | (syntax-rules () 360 | [(_ ct body) body])) 361 | (define-syntax lambda 362 | (let () 363 | (import scheme) 364 | (syntax-rules () 365 | [(lambda () body) (lambda arg-list body)] 366 | [(lambda arg-list e e* ...) (lambda arg-list e e* ...)]))) 367 | (define (true) #t) 368 | (define (false) #f) 369 | (define (nop) (void)) 370 | (call/cc 371 | (lambda (k) 372 | (set! ,return-address-register k) 373 | ,x)) 374 | ,return-value-register)] 375 | [(discard-call-live) 376 | `(let () 377 | (import (except scheme set!)) 378 | (define int64-in-range? 379 | (let () 380 | (import scheme) 381 | (lambda (x) 382 | (<= (- (expt 2 63)) x (- (expt 2 63) 1))))) 383 | (define handle-overflow 384 | (let () 385 | (import scheme) 386 | (lambda (x) 387 | (cond 388 | [(not (number? x)) x] 389 | [(int64-in-range? x) x] 390 | [(not (= x (logand 18446744073709551615 x))) 391 | (handle-overflow (logand 18446744073709551615 x))] 392 | [(< x 0) (handle-overflow (+ x (expt 2 64)))] 393 | [else (handle-overflow (- x (expt 2 64)))])))) 394 | (define-syntax set! 395 | (let () 396 | (import scheme) 397 | (syntax-rules () 398 | [(_ x expr) 399 | (set! x (handle-overflow expr))]))) 400 | (define-syntax locate 401 | (let () 402 | (import scheme) 403 | (syntax-rules () 404 | [(_ ([x* loc*] ...) body) 405 | (let-syntax ([x* (identifier-syntax 406 | (id loc*) 407 | ((set! id e) 408 | (set! loc* (handle-overflow e))))] ...) 409 | body)]))) 410 | (define (true) #t) 411 | (define (false) #f) 412 | (define (nop) (void)) 413 | (call/cc 414 | (lambda (k) 415 | (set! ,return-address-register k) 416 | ,x)) 417 | ,return-value-register)] 418 | [(finalize-locations) 419 | `(let () 420 | (import (except scheme set!)) 421 | (define int64-in-range? 422 | (lambda (x) 423 | (<= (- (expt 2 63)) x (- (expt 2 63) 1)))) 424 | (define handle-overflow 425 | (lambda (x) 426 | (cond 427 | [(not (number? x)) x] 428 | [(int64-in-range? x) x] 429 | [(not (= x (logand 18446744073709551615 x))) 430 | (handle-overflow (logand 18446744073709551615 x))] 431 | [(< x 0) (handle-overflow (+ x (expt 2 64)))] 432 | [else (handle-overflow (- x (expt 2 64)))]))) 433 | (define-syntax set! 434 | (let () 435 | (import scheme) 436 | (syntax-rules () 437 | [(_ x expr) 438 | (set! x (handle-overflow expr))]))) 439 | (define (true) #t) 440 | (define (false) #f) 441 | (define (nop) (void)) 442 | (call/cc 443 | (lambda (k) 444 | (set! ,return-address-register k) 445 | ,x)) 446 | ,return-value-register)] 447 | [(expose-frame-var) 448 | `(let () 449 | (import (except scheme set!)) 450 | (define int64-in-range? 451 | (lambda (x) 452 | (<= (- (expt 2 63)) x (- (expt 2 63) 1)))) 453 | (define handle-overflow 454 | (lambda (x) 455 | (cond 456 | [(not (number? x)) x] 457 | [(int64-in-range? x) x] 458 | [(not (= x (logand 18446744073709551615 x))) 459 | (handle-overflow (logand 18446744073709551615 x))] 460 | [(< x 0) (handle-overflow (+ x (expt 2 64)))] 461 | [else (handle-overflow (- x (expt 2 64)))]))) 462 | (define-syntax set! 463 | (let () 464 | (import scheme) 465 | (syntax-rules () 466 | [(_ x expr) 467 | (set! x (handle-overflow expr))]))) 468 | (define (true) #t) 469 | (define (false) #f) 470 | (define (nop) (void)) 471 | (call/cc 472 | (lambda (k) 473 | (set! ,return-address-register k) 474 | ,(rewrite-opnds x))) 475 | ,return-value-register)] 476 | [(expose-basic-blocks) 477 | `(let () 478 | (import (except scheme set!)) 479 | (define int64-in-range? 480 | (lambda (x) 481 | (<= (- (expt 2 63)) x (- (expt 2 63) 1)))) 482 | (define handle-overflow 483 | (lambda (x) 484 | (cond 485 | [(not (number? x)) x] 486 | [(int64-in-range? x) x] 487 | [(not (= x (logand 18446744073709551615 x))) 488 | (handle-overflow (logand 18446744073709551615 x))] 489 | [(< x 0) (handle-overflow (+ x (expt 2 64)))] 490 | [else (handle-overflow (- x (expt 2 64)))]))) 491 | (define-syntax set! 492 | (let () 493 | (import scheme) 494 | (syntax-rules () 495 | [(_ x expr) 496 | (set! x (handle-overflow expr))]))) 497 | (call/cc 498 | (lambda (k) 499 | (set! ,return-address-register k) 500 | ,(rewrite-opnds x))) 501 | ,return-value-register)] 502 | [(flatten-program) 503 | `(let () 504 | (import (except scheme set!)) 505 | (define int64-in-range? 506 | (lambda (x) 507 | (<= (- (expt 2 63)) x (- (expt 2 63) 1)))) 508 | (define handle-overflow 509 | (lambda (x) 510 | (cond 511 | [(not (number? x)) x] 512 | [(int64-in-range? x) x] 513 | [(not (= x (logand 18446744073709551615 x))) 514 | (handle-overflow (logand 18446744073709551615 x))] 515 | [(< x 0) (handle-overflow (+ x (expt 2 64)))] 516 | [else (handle-overflow (- x (expt 2 64)))]))) 517 | (define-syntax set! 518 | (let () 519 | (import scheme) 520 | (syntax-rules () 521 | [(_ x expr) 522 | (set! x (handle-overflow expr))]))) 523 | (define-syntax code 524 | (lambda (x) 525 | (define build 526 | (lambda (body) 527 | (syntax-case body () 528 | [() #'(())] 529 | [(label expr ...) 530 | (identifier? #'label) 531 | (with-syntax ([((expr ...) defn ...) (build #'(expr ...))]) 532 | #'(((bounce label)) 533 | (define label 534 | (lambda () 535 | (bounce (lambda () expr ...)))) 536 | defn ...))] 537 | [(expr1 expr ...) 538 | (with-syntax ([((expr ...) defn ...) (build #'(expr ...))]) 539 | #'((expr1 expr ...) defn ...))]))) 540 | (syntax-case x () 541 | [(k expr ...) 542 | (with-syntax ([((expr ...) defn ...) (build #'(expr ...))]) 543 | #'((call/cc 544 | (lambda (bounce) 545 | defn ... 546 | expr ...))))]))) 547 | (define-syntax jump 548 | (syntax-rules () 549 | [(_ target) (target)])) 550 | (call/cc 551 | (lambda (k) 552 | (set! ,return-address-register k) 553 | ,(rewrite-opnds x))) 554 | ,return-value-register)] 555 | [else x]))) 556 | --------------------------------------------------------------------------------