* 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

Binary file not shown.

View File

@ -171,6 +171,7 @@
[$fp-at-base 0 pred]
[$current-frame 0 value]
[$arg-list 0 value]
[base-rtd 0 value]
[$seal-frame-and-call 1 tail]
[$frame->continuation 1 value]
[$interrupted? 0 pred]
@ -2017,7 +2018,7 @@
(case op
[(fixnum? flonum? bignum? immediate? boolean? char? vector? string? procedure?
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
port? input-port? output-port?
$make-port/input $make-port/output $make-port/both
@ -3188,6 +3189,7 @@
[(arg-list) (mem 32 pcr)]
[(engine-counter) (mem 36 pcr)]
[(interrupted) (mem 40 pcr)]
[(base-rtd) (mem 44 pcr)]
[else (error 'pcb-ref "invalid arg ~s" x)])))
(define do-warn
@ -4041,6 +4043,8 @@
(f (cdr arg*) (fxadd1 idx)))])]))]
[($current-frame)
(list* (movl (pcb-ref 'next-continuation) eax) ac)]
[(base-rtd)
(list* (movl (pcb-ref 'base-rtd) eax) ac)]
[($arg-list)
(list* (movl (pcb-ref 'arg-list) eax) ac)]
[($seal-frame-and-call)

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)))

View File

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