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

* defined a (base-rtd) procedure that returns the base rtd. 

* added:
   src/ikarus.singular-objects.ss
This commit is contained in:
Abdulaziz Ghuloum 2007-05-05 22:54:53 -04:00
parent 48e062dfc4
commit f06a1f302a
4 changed files with 15 additions and 2 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.

6
src/ikarus.compiler.ss
View File

@ -171,6 +171,7 @@
[$fp-at-base 0 pred] [$fp-at-base 0 pred]
[$current-frame 0 value] [$current-frame 0 value]
[$arg-list 0 value] [$arg-list 0 value]
[base-rtd 0 value]
[$seal-frame-and-call 1 tail] [$seal-frame-and-call 1 tail]
[$frame->continuation 1 value] [$frame->continuation 1 value]
[$interrupted? 0 pred] [$interrupted? 0 pred]
@ -2017,7 +2018,7 @@
(case op (case op
[(fixnum? flonum? bignum? immediate? boolean? char? vector? string? procedure? [(fixnum? flonum? bignum? immediate? boolean? char? vector? string? procedure?
null? pair? not cons eq? vector symbol? error eof-object eof-object? null? pair? not cons eq? vector symbol? error eof-object eof-object?
void $unbound-object? $code? $forward-ptr? bwp-object? void base-rtd $unbound-object? $code? $forward-ptr? bwp-object?
pointer-value top-level-value car cdr list* list $record pointer-value top-level-value car cdr list* list $record
port? input-port? output-port? port? input-port? output-port?
$make-port/input $make-port/output $make-port/both $make-port/input $make-port/output $make-port/both
@ -3188,6 +3189,7 @@
[(arg-list) (mem 32 pcr)] [(arg-list) (mem 32 pcr)]
[(engine-counter) (mem 36 pcr)] [(engine-counter) (mem 36 pcr)]
[(interrupted) (mem 40 pcr)] [(interrupted) (mem 40 pcr)]
[(base-rtd) (mem 44 pcr)]
[else (error 'pcb-ref "invalid arg ~s" x)]))) [else (error 'pcb-ref "invalid arg ~s" x)])))
(define do-warn (define do-warn
@ -4041,6 +4043,8 @@
(f (cdr arg*) (fxadd1 idx)))])]))] (f (cdr arg*) (fxadd1 idx)))])]))]
[($current-frame) [($current-frame)
(list* (movl (pcb-ref 'next-continuation) eax) ac)] (list* (movl (pcb-ref 'next-continuation) eax) ac)]
[(base-rtd)
(list* (movl (pcb-ref 'base-rtd) eax) ac)]
[($arg-list) [($arg-list)
(list* (movl (pcb-ref 'arg-list) eax) ac)] (list* (movl (pcb-ref 'arg-list) eax) ac)]
[($seal-frame-and-call) [($seal-frame-and-call)

7
src/ikarus.singular-objects.ss Normal file
View File

@ -0,0 +1,7 @@
(library (ikarus singular-objects)
(export base-rtd)
(import
(rename (ikarus) (base-rtd sys:base-rtd)))
(define (base-rtd) (sys:base-rtd)))

4
src/makefile.ss
View File

@ -21,7 +21,8 @@
;;; an error (which may lead to the infamous Error: Error: ;;; an error (which may lead to the infamous Error: Error:
;;; Error: Error: Error: Error: Error: Error: Error: ...). ;;; Error: Error: Error: Error: Error: Error: Error: ...).
;;; ;;;
'("ikarus.handlers.ss" '("ikarus.singular-objects.ss"
"ikarus.handlers.ss"
"ikarus.multiple-values.ss" "ikarus.multiple-values.ss"
"ikarus.control.ss" "ikarus.control.ss"
"ikarus.collect.ss" "ikarus.collect.ss"
@ -536,6 +537,7 @@
[collect s] [collect s]
[do-stack-overflow s] [do-stack-overflow s]
[syntax-dispatch s] [syntax-dispatch s]
[base-rtd s i]
)) ))