conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* moved some prims to (ikarus system $interrupts)

This commit is contained in:
Abdulaziz Ghuloum 2007-05-06 20:15:49 -04:00
parent 6dc380029c
commit a0c81d9ce7
3 changed files with 6 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
src/ikarus.boot
View File

Binary file not shown.

2
src/ikarus.handlers.ss
View File

@ -25,7 +25,7 @@
cdr-error fxadd1-error fxsub1-error cadr-error fx+-type-error cdr-error fxadd1-error fxsub1-error cadr-error fx+-type-error
fx+-types-error fx+-overflow-error $do-event) fx+-types-error fx+-overflow-error $do-event)
(import (except (ikarus) interrupt-handler) (import (except (ikarus) interrupt-handler)
(only (ikarus system $junkyard) $interrupted? $unset-interrupted!)) (only (ikarus system $interrupts) $interrupted? $unset-interrupted!))
(define interrupt-handler (define interrupt-handler
(make-parameter (make-parameter

12
src/makefile.ss
View File

@ -114,6 +114,7 @@
[$arg-list (ikarus system $arg-list)] [$arg-list (ikarus system $arg-list)]
[$stack (ikarus system $stack)] [$stack (ikarus system $stack)]
[$junkyard (ikarus system $junkyard)] [$junkyard (ikarus system $junkyard)]
[$interrupts (ikarus system $interrupts)]
)) ))
(define ikarus-macros-map (define ikarus-macros-map
@ -543,10 +544,11 @@
[$seal-frame-and-call $stack] [$seal-frame-and-call $stack]
[$make-call-with-values-procedure $stack] [$make-call-with-values-procedure $stack]
[$make-values-procedure $stack] [$make-values-procedure $stack]
; (ikarus system $interrupts)
[$interrupted? $interrupts]
[$unset-interrupted! $interrupts]
; (ikarus system $junkyard) ; (ikarus system $junkyard)
[$forward-ptr? $junkyard] [$forward-ptr? $interrupts]
[$interrupted? $junkyard]
[$unset-interrupted! $junkyard]
[$apply-nonprocedure-error-handler $junkyard] [$apply-nonprocedure-error-handler $junkyard]
[$incorrect-args-error-handler $junkyard] [$incorrect-args-error-handler $junkyard]
[$multiple-values-error $junkyard] [$multiple-values-error $junkyard]
@ -676,8 +678,6 @@
[(assq x ',primlocs) => cdr] [(assq x ',primlocs) => cdr]
[else #f]))) [else #f])))
,@(map build-library library-legend))]) ,@(map build-library library-legend))])
;(parameterize ([print-gensym #f])
; (pretty-print code))
(let-values ([(code empty-subst empty-env) (let-values ([(code empty-subst empty-env)
(boot-library-expand code)]) (boot-library-expand code)])
code))) code)))
@ -691,7 +691,6 @@
(printf "expanding ~s\n" file) (printf "expanding ~s\n" file)
(load file (load file
(lambda (x) (lambda (x)
; (pretty-print x)
(let-values ([(code export-subst export-env) (let-values ([(code export-subst export-env)
(boot-library-expand x)]) (boot-library-expand x)])
(set! code* (cons code code*)) (set! code* (cons code code*))
@ -701,7 +700,6 @@
(printf "building system ...\n") (printf "building system ...\n")
(let-values ([(export-subst export-env export-locs) (let-values ([(export-subst export-env export-locs)
(make-system-data subst env)]) (make-system-data subst env)])
;(printf "export-subst=~s\n" export-locs)
(let ([code (build-system-library export-subst export-env export-locs)]) (let ([code (build-system-library export-subst export-env export-locs)])
(values (values
(reverse (list* (car code*) code (cdr code*))) (reverse (list* (car code*) code (cdr code*)))