![(please configure the [header_logo] section in trac.ini)](/share/chrome/site/your_project_logo.png){kind=logo}
Changeset 31457 for lang/scheme
- Timestamp:
- 03/23/09 09:39:12 (4 years ago)
- Location:
- lang/scheme/backend-to-frontend
- Files:
-
- 3 added
- 7 modified
Legend:
- Unmodified
- Added
- Removed
-
lang/scheme/backend-to-frontend/1.1.scm
r31383 r31457 5 5 (unless (integer? x) (error ---)) 6 6 (emit " .text") 7 #| 7 8 (emit " .global _scheme_entry") 8 9 (emit " .def _scheme_entry; .scl 2; .type 32; .endef") 9 10 (emit "_scheme_entry:") 11 |# 12 (emit ".globl scheme_entry") 13 (emit " .type scheme_entry, @function") 14 (emit "scheme_entry:") 15 10 16 (emit " movl $~s, %eax" x) 11 17 (emit " ret")) -
lang/scheme/backend-to-frontend/1.2.scm
r31384 r31457 36 36 (unless (immediate? x) (error ---)) 37 37 (emit " .text") 38 #| 38 39 (emit " .global _scheme_entry") 39 40 (emit " .def _scheme_entry; .scl 2; .type 32; .endef") 40 41 (emit "_scheme_entry:") 42 |# 43 (emit ".globl scheme_entry") 44 (emit " .type scheme_entry, @function") 45 (emit "scheme_entry:") 46 41 47 (emit " movl $~s, %eax" (immediate-rep x)) 42 48 (emit " ret")) -
lang/scheme/backend-to-frontend/1.3.scm
r31386 r31457 1 1 (load "./tests-driver.scm") 2 2 (load "./tests-1.3-req.scm") 3 (load "./tests-1.2-req.scm") 4 (load "./tests-1.1-req.scm") 3 5 4 6 (define fxshift 2) … … 82 84 (emit " .text") 83 85 (emit (string-append " .global " funcname)) 84 (emit " .def _scheme_entry; .scl 2; .type 32; .endef") 86 ; (emit " .def _scheme_entry; .scl 2; .type 32; .endef") 87 (emit (string-append " .type " funcname ", @function")) 88 85 89 (emit (string-append funcname ":"))) 86 90 87 91 88 92 (define (emit-program expr) 89 (emit-function-header " _scheme_entry")93 (emit-function-header "scheme_entry") 90 94 (emit-expr expr) 91 95 (emit " ret")) … … 93 97 94 98 (define-primitive ($fxadd1 arg) 95 96 99 (emit-expr arg) 100 (emit " addl $~s, %eax" (immediate-rep 1))) 97 101 98 102 (define-primitive ($fxsub1 arg) 99 100 103 (emit-expr arg) 104 (emit " subl $~s, %eax" (immediate-rep 1))) 101 105 102 106 (define-primitive ($fixnum->char arg) 103 104 105 107 (emit-expr arg) 108 (emit " shll $~s, %eax" (- charshift fxshift)) 109 (emit " orl $~s, %eax" chartag)) 106 110 107 111 (define-primitive ($char->fixnum arg) 108 109 112 (emit-expr arg) 113 (emit " shrl $~s, %eax" (- charshift fxshift))) 110 114 111 115 (define (emit-to-boolean) … … 116 120 117 121 (define-primitive (fixnum? arg) 118 119 120 121 122 (emit-expr arg) 123 (emit " and $~s, %al" fxmask) 124 (emit " cmp $~s, %al" fxtag) 125 (emit-to-boolean)) 122 126 123 127 (define-primitive ($fxzero? arg) 124 125 (emit " cmp $0, %al")126 128 (emit-expr arg) 129 (emit " testl %eax, %eax") 130 (emit-to-boolean)) 127 131 128 132 (define-primitive (null? arg) 129 130 131 133 (emit-expr arg) 134 (emit " cmp $~s, %al" nullval) 135 (emit-to-boolean)) 132 136 133 137 (define-primitive (boolean? arg) 134 135 136 137 138 (emit-expr arg) 139 (emit " and $~s, %al" bool_mask) 140 (emit " cmp $~s, %al" bool_tag) 141 (emit-to-boolean)) 138 142 139 143 (define-primitive (char? arg) 140 141 142 143 144 (emit-expr arg) 145 (emit " and $~s, %al" charmask) 146 (emit " cmp $~s, %al" chartag) 147 (emit-to-boolean)) 144 148 145 149 (define-primitive (not arg) 146 147 148 150 (emit-expr arg) 151 (emit " cmp $~s, %al" bool_f) 152 (emit-to-boolean)) 149 153 150 (define-primitive ($fxlognot arg) 151 ; assert(fixnum?) 152 (emit-expr arg) 153 (emit " notl %eax") 154 (emit " and $~s, %eax" (lognot fxmask))) 154 (define-primitive (fxlognot arg) 155 (emit-expr arg) 156 (emit " notl %eax") 157 (emit " and $~s, %eax" (lognot fxmask))) 155 158 156 159 ;;;; -
lang/scheme/backend-to-frontend/1.4.scm
r31423 r31457 1 1 (load "./tests-driver.scm") 2 2 (load "./tests-1.4-req.scm") 3 (load "./tests-1.3-req.scm") 4 (load "./tests-1.2-req.scm") 5 (load "./tests-1.1-req.scm") 3 6 4 7 (define fxshift 2) … … 25 28 26 29 (define (emit-program expr) 27 (emit-function-header " _scheme_entry")30 (emit-function-header "scheme_entry") 28 31 (emit-expr expr) 29 32 (emit " ret")) … … 32 35 (emit " .text") 33 36 (emit (string-append " .global " funcname)) 34 (emit (string-append " .def " funcname "; .scl 2; .type 32; .endef")) 37 ; (emit (string-append " .def " funcname "; .scl 2; .type 32; .endef")) 38 (emit (string-append " .type " funcname ", @function")) 39 35 40 (emit (string-append funcname ":"))) 36 41 … … 226 231 227 232 (define-primitive ($fxadd1 arg) 228 229 233 (emit-expr arg) 234 (emit " addl $~s, %eax" (immediate-rep 1))) 230 235 231 236 (define-primitive ($fxsub1 arg) 232 233 237 (emit-expr arg) 238 (emit " subl $~s, %eax" (immediate-rep 1))) 234 239 235 240 (define-primitive ($fixnum->char arg) 236 237 238 241 (emit-expr arg) 242 (emit " shll $~s, %eax" (- charshift fxshift)) 243 (emit " orl $~s, %eax" chartag)) 239 244 240 245 (define-primitive ($char->fixnum arg) 241 242 246 (emit-expr arg) 247 (emit " shrl $~s, %eax" (- charshift fxshift))) 243 248 244 249 (define (emit-to-boolean) … … 249 254 250 255 (define-predicate (fixnum? arg) 251 252 253 256 (emit-expr arg) 257 (emit " and $~s, %al" fxmask) 258 (emit " cmp $~s, %al" fxtag)) 254 259 255 260 (define-predicate ($fxzero? arg) 256 257 (emit " cmp $0, %al"))261 (emit-expr arg) 262 (emit " testl %eax, %eax")) 258 263 259 264 (define-predicate (null? arg) 260 261 265 (emit-expr arg) 266 (emit " cmp $~s, %al" nullval)) 262 267 263 268 (define-predicate (boolean? arg) 264 265 266 269 (emit-expr arg) 270 (emit " and $~s, %al" bool_mask) 271 (emit " cmp $~s, %al" bool_tag)) 267 272 268 273 (define-predicate (char? arg) 269 270 271 274 (emit-expr arg) 275 (emit " and $~s, %al" charmask) 276 (emit " cmp $~s, %al" chartag)) 272 277 273 278 (define-predicate (not arg) 274 (emit-expr arg) 275 (emit " cmp $~s, %al" bool_f)) 276 277 (define-primitive ($fxlognot arg) 278 ; assert(fixnum?) 279 (emit-expr arg) 280 (emit " notl %eax") 281 (emit " and $~s, %eax" (lognot fxmask))) 279 (emit-expr arg) 280 (emit " cmp $~s, %al" bool_f)) 281 282 (define-primitive (fxlognot arg) 283 (emit-expr arg) 284 (emit " notl %eax") 285 (emit " and $~s, %eax" (lognot fxmask))) 282 286 283 287 ;;;; -
lang/scheme/backend-to-frontend/1.5.runtime.c
r31423 r31457 1 1 #include <stdio.h> 2 #include <stdlib.h> // for exit 2 3 #include <sys/mman.h> 3 4 … … 64 65 65 66 int main(int argc, char** argv) { 66 int stack_size = (1 6 * 4096); /* holds 16K cells */67 int stack_size = (128 * 4096); /* holds 128K cells */ 67 68 char* stack_top = allocate_protected_space(stack_size); 68 69 char* stack_base = stack_top + stack_size; -
lang/scheme/backend-to-frontend/1.5.scm
r31423 r31457 1 1 (load "./tests-driver.scm") 2 2 (load "./tests-1.5-req.scm") 3 (load "./tests-1.4-req.scm") 4 (load "./tests-1.3-req.scm") 5 (load "./tests-1.2-req.scm") 6 (load "./tests-1.1-req.scm") 3 7 4 8 (define fxshift 2) … … 25 29 26 30 (define (emit-program expr) 27 (emit-function-header " _scheme_entry")31 (emit-function-header "scheme_entry") 28 32 (emit " movl %esp, %ecx") 29 33 (emit " movl 4(%esp), %esp") … … 33 37 34 38 (emit-label "L_scheme_entry") 35 (emit-expr 0expr)39 (emit-expr (- wordsize) expr) 36 40 (emit " ret")) 37 41 … … 39 43 (emit " .text") 40 44 (emit (string-append " .global " funcname)) 41 (emit (string-append " .def " funcname "; .scl 2; .type 32; .endef")) 45 ; (emit (string-append " .def " funcname "; .scl 2; .type 32; .endef")) 46 (emit (string-append " .type " funcname ", @function")) 47 42 48 (emit (string-append funcname ":"))) 43 49 … … 61 67 62 68 (define (emit-predicate-val si expr) 63 (emit-predicate-test si expr) 64 (let ((prim (car expr)) (args (cdr expr))) 65 (emit-to-boolean))) 69 (let ((c (emit-predicate-test si expr)) 70 (prim (car expr)) 71 (args (cdr expr))) 72 (emit-to-boolean c))) 66 73 67 74 (define (emit-predicate-test si expr) … … 75 82 (define (emit-test si expr) 76 83 (if (predicate-call? expr) 77 (begin 78 (emit-predicate-test si expr) 79 #t) 84 (emit-predicate-test si expr) 80 85 (begin 81 86 (emit-expr si expr) 82 87 (emit " cmp $~s, %al" bool_f) 83 #f))) 88 'NEQ))) 89 90 (define (emit-jump-if-not pred label) 91 (let ((c (case pred 92 ((EQ) "jne") 93 ((NEQ) "je") 94 ((LT) "jge") 95 ((GT) "jle") 96 ((LE) "jg") 97 ((GE) "Jl") 98 (else (error "illegal condition"))))) 99 (emit " ~a ~a" c label))) 84 100 85 101 (define (emit-if si expr) 86 102 (let ((alt-label (unique-label)) 87 103 (end-label (unique-label))) 88 (if (emit-test si (if-test expr)) 89 (emit " jne ~a" alt-label) 90 (emit " je ~a" alt-label)) 104 (emit-jump-if-not (emit-test si (if-test expr)) 105 alt-label) 91 106 (emit-expr si (if-conseq expr)) 92 107 (emit " jmp ~a" end-label) … … 233 248 234 249 (define-primitive ($fxadd1 si arg) 235 236 250 (emit-expr si arg) 251 (emit " addl $~s, %eax" (immediate-rep 1))) 237 252 238 253 (define-primitive ($fxsub1 si arg) 239 240 254 (emit-expr si arg) 255 (emit " subl $~s, %eax" (immediate-rep 1))) 241 256 242 257 (define-primitive ($fixnum->char si arg) 243 244 245 258 (emit-expr si arg) 259 (emit " shll $~s, %eax" (- charshift fxshift)) 260 (emit " orl $~s, %eax" chartag)) 246 261 247 262 (define-primitive ($char->fixnum si arg) 248 (emit-expr si arg) 249 (emit " shrl $~s, %eax" (- charshift fxshift))) 250 251 (define (emit-to-boolean) 252 (emit " sete %al") 253 (emit " movzbl %al, %eax") 254 (emit " sal $~s, %al" bool_bit) 255 (emit " or $~s, %al" bool_f)) 263 (emit-expr si arg) 264 (emit " shrl $~s, %eax" (- charshift fxshift))) 265 266 (define (emit-to-boolean c) 267 (let ((op (case c 268 ((EQ) "sete") 269 ((NEQ) "setne") 270 ((LT) "setl") 271 ((GT) "setg") 272 ((LE) "setle") 273 ((GE) "setge") 274 (else (error "illegal condition"))))) 275 (emit " ~a %al" op) 276 (emit " movzbl %al, %eax") 277 (emit " sal $~s, %al" bool_bit) 278 (emit " or $~s, %al" bool_f))) 256 279 257 280 (define-predicate (fixnum? si arg) 258 (emit-expr si arg) 259 (emit " and $~s, %al" fxmask) 260 (emit " cmp $~s, %al" fxtag)) 281 (emit-expr si arg) 282 (emit " and $~s, %al" fxmask) 283 (emit " cmp $~s, %al" fxtag) 284 'EQ) 261 285 262 286 (define-predicate ($fxzero? si arg) 263 (emit-expr si arg) 264 (emit " cmp $0, %al")) 287 (emit-expr si arg) 288 (emit " testl %eax, %eax") 289 'EQ) 265 290 266 291 (define-predicate (null? si arg) 267 (emit-expr si arg) 268 (emit " cmp $~s, %al" nullval)) 292 (emit-expr si arg) 293 (emit " cmp $~s, %al" nullval) 294 'EQ) 269 295 270 296 (define-predicate (boolean? si arg) 271 (emit-expr si arg) 272 (emit " and $~s, %al" bool_mask) 273 (emit " cmp $~s, %al" bool_tag)) 297 (emit-expr si arg) 298 (emit " and $~s, %al" bool_mask) 299 (emit " cmp $~s, %al" bool_tag) 300 'EQ) 274 301 275 302 (define-predicate (char? si arg) 276 (emit-expr si arg) 277 (emit " and $~s, %al" charmask) 278 (emit " cmp $~s, %al" chartag)) 303 (emit-expr si arg) 304 (emit " and $~s, %al" charmask) 305 (emit " cmp $~s, %al" chartag) 306 'EQ) 279 307 280 308 (define-predicate (not si arg) 281 (emit-expr si arg) 282 (emit " cmp $~s, %al" bool_f)) 309 (emit-expr si arg) 310 (emit " cmp $~s, %al" bool_f) 311 'EQ) 283 312 284 313 (define-primitive (fxlognot si arg) 285 ; assert(fixnum?) 286 (emit-expr si arg) 287 (emit " notl %eax") 288 (emit " and $~s, %eax" (lognot fxmask))) 314 (emit-expr si arg) 315 (emit " notl %eax") 316 (emit " and $~s, %eax" (lognot fxmask))) 289 317 290 318 291 319 (define-primitive (fx+ si arg1 arg2) 292 (emit-expr (- si wordsize) arg1) 293 (emit " movl %eax, ~s(%esp)" (- si wordsize)) 294 (emit-expr (- si (* 2 wordsize)) arg2) 295 (emit " addl ~s(%esp), %eax" (- si wordsize))) 320 (define (out2) 321 (emit-expr si arg1) 322 (emit " movl %eax, ~s(%esp)" si) 323 (emit-expr (- si wordsize) arg2) 324 (emit " addl ~s(%esp), %eax" si)) 325 (define (out1 expr const) 326 (emit-expr si expr) 327 (emit " addl $~s, %eax" (immediate-rep const))) 328 ;; �Q�Ƃ����̏ꍇ�͂��Ə��ŏ����������̂ŁA�����ł͏������Ȃ� 329 (cond ((fixnum? arg2) (out1 arg1 arg2)) 330 ((fixnum? arg1) (out1 arg2 arg1)) 331 (else (out2)))) 296 332 297 333 (define-primitive (fx- si arg1 arg2) 298 (emit-expr (- si (* 2 wordsize)) arg2) 299 (emit " movl %eax, ~s(%esp)" (- si wordsize)) 300 (emit-expr (- si wordsize) arg1) 301 (emit " subl ~s(%esp), %eax" (- si wordsize))) 334 (define (out2) 335 (emit-expr si arg2) 336 (emit " movl %eax, ~s(%esp)" si) 337 (emit-expr (- si wordsize) arg1) 338 (emit " subl ~s(%esp), %eax" si)) 339 (define (out1 expr const) 340 (emit-expr si expr) 341 (emit " subl $~s, %eax" (immediate-rep const))) 342 (cond ((fixnum? arg2) (out1 arg1 arg2)) 343 (else (out2)))) 302 344 303 345 (define-primitive (fx* si arg1 arg2) 304 (emit-expr (- si wordsize) arg1) 305 (emit " sarl $2, %eax") ; �E�V�t�g 306 (emit " movl %eax, ~s(%esp)" (- si wordsize)) 307 (emit-expr (- si (* 2 wordsize)) arg2) 308 (emit " imull ~s(%esp), %eax" (- si wordsize))) 346 (define (out2) 347 (emit-expr si arg1) 348 (emit " sarl $2, %eax") ; �E�V�t�g 349 (emit " movl %eax, ~s(%esp)" si) 350 (emit-expr (- si wordsize) arg2) 351 (emit " imull ~s(%esp), %eax" si)) 352 (define (out1 expr const) 353 (emit-expr si expr) 354 (emit " imull $~s, %eax" const)) ; �V�t�g�K�v�Ȃ� 355 (cond ((fixnum? arg2) (out1 arg1 arg2)) 356 ((fixnum? arg1) (out1 arg2 arg1)) 357 (else (out2)))) 309 358 310 359 (define-primitive (fxlogor si arg1 arg2) 311 (emit-expr (- si wordsize)arg1)312 (emit " movl %eax, ~s(%esp)" (- si wordsize))313 (emit-expr (- si (* 2 wordsize)) arg2)314 (emit " orl ~s(%esp), %eax" (- si wordsize)))360 (emit-expr si arg1) 361 (emit " movl %eax, ~s(%esp)" si) 362 (emit-expr (- si wordsize) arg2) 363 (emit " orl ~s(%esp), %eax" si)) 315 364 316 365 (define-primitive (fxlogand si arg1 arg2) 317 (emit-expr (- si wordsize)arg1)318 (emit " movl %eax, ~s(%esp)" (- si wordsize))319 (emit-expr (- si (* 2 wordsize)) arg2)320 (emit " andl ~s(%esp), %eax" (- si wordsize)))366 (emit-expr si arg1) 367 (emit " movl %eax, ~s(%esp)" si) 368 (emit-expr (- si wordsize) arg2) 369 (emit " andl ~s(%esp), %eax" si)) 321 370 322 371 (define-predicate (fx= si arg1 arg2) 323 (emit-expr (- si wordsize) arg1) 324 (emit " movl %eax, ~s(%esp)" (- si wordsize)) 325 (emit-expr (- si (* 2 wordsize)) arg2) 326 (emit " cmpl ~s(%esp), %eax" (- si wordsize))) 372 (emit-expr si arg1) 373 (emit " movl %eax, ~s(%esp)" si) 374 (emit-expr (- si wordsize) arg2) 375 (emit " cmpl ~s(%esp), %eax" si) 376 'EQ) 377 378 (define-predicate (fx< si arg1 arg2) 379 (emit-expr si arg2) 380 (emit " movl %eax, ~s(%esp)" si) 381 (emit-expr (- si wordsize) arg1) 382 (emit " cmpl ~s(%esp), %eax" si) 383 'LT) 384 385 (define-predicate (fx<= si arg1 arg2) 386 (emit-expr si arg2) 387 (emit " movl %eax, ~s(%esp)" si) 388 (emit-expr (- si wordsize) arg1) 389 (emit " cmpl ~s(%esp), %eax" si) 390 'LE) 391 392 (define-predicate (fx> si arg1 arg2) 393 (emit-expr si arg2) 394 (emit " movl %eax, ~s(%esp)" si) 395 (emit-expr (- si wordsize) arg1) 396 (emit " cmpl ~s(%esp), %eax" si) 397 'GT) 398 399 (define-predicate (fx>= si arg1 arg2) 400 (emit-expr si arg2) 401 (emit " movl %eax, ~s(%esp)" si) 402 (emit-expr (- si wordsize) arg1) 403 (emit " cmpl ~s(%esp), %eax" si) 404 'GE) 327 405 328 406 ;;;; -
lang/scheme/backend-to-frontend/tests-driver.scm
r31388 r31457 94 94 95 95 (define (execute) 96 (unless (fxzero? (system " stst.exe > stst.out"))96 (unless (fxzero? (system "./stst.exe > stst.out")) 97 97 (error 'execute "produced program exited abnormally"))) 98 98
