* primitive-set! is gone.
This commit is contained in:
parent
931be7dda9
commit
7173bcc61b
BIN
src/ikarus.boot
BIN
src/ikarus.boot
Binary file not shown.
|
@ -136,7 +136,6 @@
|
||||||
[$set-symbol-unique-string! 2 effect]
|
[$set-symbol-unique-string! 2 effect]
|
||||||
[$symbol-plist 1 value]
|
[$symbol-plist 1 value]
|
||||||
[$set-symbol-plist! 2 effect]
|
[$set-symbol-plist! 2 effect]
|
||||||
[primitive-set! 2 effect]
|
|
||||||
[top-level-value 1 value]
|
[top-level-value 1 value]
|
||||||
;;; ports
|
;;; ports
|
||||||
[port? 1 pred]
|
[port? 1 pred]
|
||||||
|
@ -942,7 +941,6 @@
|
||||||
384 cdr
|
384 cdr
|
||||||
898 cons
|
898 cons
|
||||||
747 error
|
747 error
|
||||||
331 primitive-set!
|
|
||||||
555 void
|
555 void
|
||||||
645 list
|
645 list
|
||||||
|#
|
|#
|
||||||
|
@ -1258,7 +1256,7 @@
|
||||||
;X; (giveup))]
|
;X; (giveup))]
|
||||||
;;; unoptimizables
|
;;; unoptimizables
|
||||||
[(error syntax-error $syntax-dispatch $sc-put-cte
|
[(error syntax-error $syntax-dispatch $sc-put-cte
|
||||||
primitive-set! apply)
|
apply)
|
||||||
(giveup)]
|
(giveup)]
|
||||||
))
|
))
|
||||||
|
|
||||||
|
@ -2064,7 +2062,6 @@
|
||||||
$code-size $code-reloc-vector $code-freevars
|
$code-size $code-reloc-vector $code-freevars
|
||||||
$code-ref $code-set!
|
$code-ref $code-set!
|
||||||
$make-record $record? $record/rtd? $record-rtd $record-ref $record-set!
|
$make-record $record? $record/rtd? $record-rtd $record-ref $record-set!
|
||||||
primitive-set!
|
|
||||||
$make-tcbucket $tcbucket-key $tcbucket-val $tcbucket-next
|
$make-tcbucket $tcbucket-key $tcbucket-val $tcbucket-next
|
||||||
$set-tcbucket-val!
|
$set-tcbucket-val!
|
||||||
$set-tcbucket-next! $set-tcbucket-tconc!)
|
$set-tcbucket-next! $set-tcbucket-tconc!)
|
||||||
|
@ -4092,7 +4089,7 @@
|
||||||
ac))]
|
ac))]
|
||||||
[($set-car! $set-cdr! $vector-set! $string-set! $exit
|
[($set-car! $set-cdr! $vector-set! $string-set! $exit
|
||||||
$set-symbol-value! $set-symbol-plist!
|
$set-symbol-value! $set-symbol-plist!
|
||||||
$code-set! primitive-set!
|
$code-set!
|
||||||
$set-code-object! $set-code-object+offset! $set-code-object+offset/rel!
|
$set-code-object! $set-code-object+offset! $set-code-object+offset/rel!
|
||||||
$record-set!
|
$record-set!
|
||||||
$set-port-input-index! $set-port-input-size!
|
$set-port-input-index! $set-port-input-size!
|
||||||
|
@ -4258,17 +4255,6 @@
|
||||||
(addl (pcb-ref 'dirty-vector) eax)
|
(addl (pcb-ref 'dirty-vector) eax)
|
||||||
(movl (int dirty-word) (mem 0 eax))
|
(movl (int dirty-word) (mem 0 eax))
|
||||||
ac)]
|
ac)]
|
||||||
[(primitive-set!)
|
|
||||||
(list* (movl (Simple (car arg*)) eax)
|
|
||||||
(movl (Simple (cadr arg*)) ebx)
|
|
||||||
(movl ebx (mem (fx- disp-symbol-system-value symbol-tag) eax))
|
|
||||||
;;; record side effect
|
|
||||||
(addl (int (fx- disp-symbol-system-value symbol-tag)) eax)
|
|
||||||
(shrl (int pageshift) eax)
|
|
||||||
(sall (int wordshift) eax)
|
|
||||||
(addl (pcb-ref 'dirty-vector) eax)
|
|
||||||
(movl (int dirty-word) (mem 0 eax))
|
|
||||||
ac)]
|
|
||||||
[($set-symbol-plist!)
|
[($set-symbol-plist!)
|
||||||
(list* (movl (Simple (car arg*)) eax)
|
(list* (movl (Simple (car arg*)) eax)
|
||||||
(movl (Simple (cadr arg*)) ebx)
|
(movl (Simple (cadr arg*)) ebx)
|
||||||
|
@ -5268,7 +5254,7 @@
|
||||||
(parameterize ([assembler-output #f])
|
(parameterize ([assembler-output #f])
|
||||||
(expand x))))
|
(expand x))))
|
||||||
|
|
||||||
(primitive-set! 'compile
|
(define compile
|
||||||
(lambda (x)
|
(lambda (x)
|
||||||
(let ([code
|
(let ([code
|
||||||
(if (code? x)
|
(if (code? x)
|
||||||
|
@ -5288,7 +5274,6 @@
|
||||||
(f))))
|
(f))))
|
||||||
(close-input-port ip)
|
(close-input-port ip)
|
||||||
(close-output-port op))))
|
(close-output-port op))))
|
||||||
(primitive-set! 'compile-file compile-file)
|
|
||||||
|
|
||||||
;(include "libaltcogen.ss")
|
;(include "libaltcogen.ss")
|
||||||
(define alt-cogen
|
(define alt-cogen
|
||||||
|
@ -5308,9 +5293,8 @@
|
||||||
(close-output-port op))))
|
(close-output-port op))))
|
||||||
|
|
||||||
|
|
||||||
(primitive-set! 'alt-compile-file alt-compile-file)
|
|
||||||
|
|
||||||
(primitive-set! 'alt-compile
|
(define alt-compile
|
||||||
(lambda (x)
|
(lambda (x)
|
||||||
(let ([code
|
(let ([code
|
||||||
(if (code? x)
|
(if (code? x)
|
||||||
|
|
|
@ -449,7 +449,7 @@
|
||||||
[else
|
[else
|
||||||
(error who "Unexpected ~s as a fasl object header" h)])))
|
(error who "Unexpected ~s as a fasl object header" h)])))
|
||||||
(read))
|
(read))
|
||||||
(primitive-set! '$fasl-read
|
(define $fasl-read
|
||||||
(lambda (p)
|
(lambda (p)
|
||||||
(assert-eq? (read-char p) #\I)
|
(assert-eq? (read-char p) #\I)
|
||||||
(assert-eq? (read-char p) #\K)
|
(assert-eq? (read-char p) #\K)
|
||||||
|
|
|
@ -97,72 +97,48 @@
|
||||||
(error 'make-input/output-port "~s is not a string" input-buffer))
|
(error 'make-input/output-port "~s is not a string" input-buffer))
|
||||||
(error 'make-input/output-port "~s is not a procedure" handler))))
|
(error 'make-input/output-port "~s is not a procedure" handler))))
|
||||||
;;;
|
;;;
|
||||||
;;; XXX (primitive-set! '$port-handler
|
|
||||||
;;; XXX (lambda (x) ($port-handler x)))
|
|
||||||
;;;
|
|
||||||
(define port-handler
|
(define port-handler
|
||||||
(lambda (x)
|
(lambda (x)
|
||||||
(if (port? x)
|
(if (port? x)
|
||||||
($port-handler x)
|
($port-handler x)
|
||||||
(error 'port-handler "~s is not a port" x))))
|
(error 'port-handler "~s is not a port" x))))
|
||||||
;;;
|
;;;
|
||||||
;;; XXX (define $port-input-buffer
|
|
||||||
;;; XXX (lambda (x) ($port-input-buffer x)))
|
|
||||||
;;;
|
|
||||||
(define port-input-buffer
|
(define port-input-buffer
|
||||||
(lambda (x)
|
(lambda (x)
|
||||||
(if (input-port? x)
|
(if (input-port? x)
|
||||||
($port-input-buffer x)
|
($port-input-buffer x)
|
||||||
(error 'port-input-buffer "~s is not an input-port" x))))
|
(error 'port-input-buffer "~s is not an input-port" x))))
|
||||||
;;;
|
;;;
|
||||||
;;; XXX (primitive-set! '$port-input-index
|
|
||||||
;;; XXX (lambda (x) ($port-input-index x)))
|
|
||||||
;;;
|
|
||||||
(define port-input-index
|
(define port-input-index
|
||||||
(lambda (x)
|
(lambda (x)
|
||||||
(if (input-port? x)
|
(if (input-port? x)
|
||||||
($port-input-index x)
|
($port-input-index x)
|
||||||
(error 'port-input-index "~s is not an input-port" x))))
|
(error 'port-input-index "~s is not an input-port" x))))
|
||||||
;;;
|
;;;
|
||||||
;;; XXX (primitive-set! '$port-input-size
|
|
||||||
;;; XXX (lambda (x) ($port-input-size x)))
|
|
||||||
;;;
|
|
||||||
(define port-input-size
|
(define port-input-size
|
||||||
(lambda (x)
|
(lambda (x)
|
||||||
(if (input-port? x)
|
(if (input-port? x)
|
||||||
($port-input-size x)
|
($port-input-size x)
|
||||||
(error 'port-input-size "~s is not an input-port" x))))
|
(error 'port-input-size "~s is not an input-port" x))))
|
||||||
;;;
|
;;;
|
||||||
;;; XXX (define '$port-output-buffer
|
|
||||||
;;; XXX (lambda (x) ($port-output-buffer x)))
|
|
||||||
;;;
|
|
||||||
(define port-output-buffer
|
(define port-output-buffer
|
||||||
(lambda (x)
|
(lambda (x)
|
||||||
(if (output-port? x)
|
(if (output-port? x)
|
||||||
($port-output-buffer x)
|
($port-output-buffer x)
|
||||||
(error 'port-output-buffer "~s is not an output-port" x))))
|
(error 'port-output-buffer "~s is not an output-port" x))))
|
||||||
;;;
|
;;;
|
||||||
;;; XXX (primitive-set! '$port-output-index
|
|
||||||
;;; XXX (lambda (x) ($port-output-index x)))
|
|
||||||
;;;
|
|
||||||
(define port-output-index
|
(define port-output-index
|
||||||
(lambda (x)
|
(lambda (x)
|
||||||
(if (output-port? x)
|
(if (output-port? x)
|
||||||
($port-output-index x)
|
($port-output-index x)
|
||||||
(error 'port-output-index "~s is not an output-port" x))))
|
(error 'port-output-index "~s is not an output-port" x))))
|
||||||
;;;
|
;;;
|
||||||
;;; XXX (primitive-set! '$port-output-size
|
|
||||||
;;; XXX (lambda (x) ($port-output-size x)))
|
|
||||||
;;;
|
|
||||||
(define port-output-size
|
(define port-output-size
|
||||||
(lambda (x)
|
(lambda (x)
|
||||||
(if (output-port? x)
|
(if (output-port? x)
|
||||||
($port-output-size x)
|
($port-output-size x)
|
||||||
(error 'port-output-size "~s is not an output-port" x))))
|
(error 'port-output-size "~s is not an output-port" x))))
|
||||||
;;;
|
;;;
|
||||||
;;; XXX (define '$set-port-input-index!
|
|
||||||
;;; XXX (lambda (p i) ($set-port-input-index! p i)))
|
|
||||||
;;;
|
|
||||||
(define set-port-input-index!
|
(define set-port-input-index!
|
||||||
(lambda (p i)
|
(lambda (p i)
|
||||||
(if (input-port? p)
|
(if (input-port? p)
|
||||||
|
@ -175,11 +151,6 @@
|
||||||
(error 'set-port-input-index! "~s is not a valid index" i))
|
(error 'set-port-input-index! "~s is not a valid index" i))
|
||||||
(error 'set-port-input-index! "~s is not an input-port" p))))
|
(error 'set-port-input-index! "~s is not an input-port" p))))
|
||||||
;;;
|
;;;
|
||||||
;;; XXX (primitive-set! '$set-port-input-size!
|
|
||||||
;;; XXX (lambda (p i)
|
|
||||||
;;; XXX ($set-port-input-index! p 0)
|
|
||||||
;;; XXX ($set-port-input-size! p i)))
|
|
||||||
;;;
|
|
||||||
(define set-port-input-size!
|
(define set-port-input-size!
|
||||||
(lambda (p i)
|
(lambda (p i)
|
||||||
(if (input-port? p)
|
(if (input-port? p)
|
||||||
|
@ -194,9 +165,6 @@
|
||||||
(error 'set-port-input-size! "~s is not a valid size" i))
|
(error 'set-port-input-size! "~s is not a valid size" i))
|
||||||
(error 'set-port-input-size! "~s is not an input-port" p))))
|
(error 'set-port-input-size! "~s is not an input-port" p))))
|
||||||
;;;
|
;;;
|
||||||
;;; XXX (primitive-set! '$set-port-output-index!
|
|
||||||
;;; XXX (lambda (p i) ($set-port-output-index! p i)))
|
|
||||||
;;;
|
|
||||||
(define set-port-output-index!
|
(define set-port-output-index!
|
||||||
(lambda (p i)
|
(lambda (p i)
|
||||||
(if (output-port? p)
|
(if (output-port? p)
|
||||||
|
@ -209,11 +177,6 @@
|
||||||
(error 'set-port-output-index! "~s is not a valid index" i))
|
(error 'set-port-output-index! "~s is not a valid index" i))
|
||||||
(error 'set-port-output-index! "~s is not an output-port" p))))
|
(error 'set-port-output-index! "~s is not an output-port" p))))
|
||||||
;;;
|
;;;
|
||||||
;;; XXX (primitive-set! '$set-port-output-size!
|
|
||||||
;;; XXX (lambda (p i)
|
|
||||||
;;; XXX ($set-port-output-index! p 0)
|
|
||||||
;;; XXX ($set-port-output-size! p i)))
|
|
||||||
;;;
|
|
||||||
(define set-port-output-size!
|
(define set-port-output-size!
|
||||||
(lambda (p i)
|
(lambda (p i)
|
||||||
(if (output-port? p)
|
(if (output-port? p)
|
||||||
|
|
|
@ -55,5 +55,4 @@
|
||||||
(make-input-string-handler str)
|
(make-input-string-handler str)
|
||||||
str)])
|
str)])
|
||||||
port)))
|
port)))
|
||||||
(primitive-set! 'open-input-string open-input-string)
|
|
||||||
|
|
||||||
|
|
|
@ -513,7 +513,6 @@
|
||||||
[$unbound-object? $unbound-object?-label (core-prim . $unbound-object?)]
|
[$unbound-object? $unbound-object?-label (core-prim . $unbound-object?)]
|
||||||
[$make-call-with-values-procedure $make-cwv-procedure (core-prim . $make-call-with-values-procedure)]
|
[$make-call-with-values-procedure $make-cwv-procedure (core-prim . $make-call-with-values-procedure)]
|
||||||
[$make-values-procedure $make-values-procedure (core-prim . $make-values-procedure)]
|
[$make-values-procedure $make-values-procedure (core-prim . $make-values-procedure)]
|
||||||
[primitive-set! primitive-set!-label (core-prim . primitive-set!)]
|
|
||||||
[$$apply $$apply-label (core-prim . $$apply)]
|
[$$apply $$apply-label (core-prim . $$apply)]
|
||||||
[$arg-list $arg-list-label (core-prim . $arg-list)]
|
[$arg-list $arg-list-label (core-prim . $arg-list)]
|
||||||
[$interrupted? $interrupted?-label (core-prim . $interrupted?)]
|
[$interrupted? $interrupted?-label (core-prim . $interrupted?)]
|
||||||
|
|
|
@ -2145,7 +2145,6 @@
|
||||||
(cons (cons (car ext*) label) subst)
|
(cons (cons (car ext*) label) subst)
|
||||||
(cons (cons label (cons 'global (binding-value b))) env))]
|
(cons (cons label (cons 'global (binding-value b))) env))]
|
||||||
[else (error #f "cannot export ~s of type ~s" sym type)]))])))
|
[else (error #f "cannot export ~s of type ~s" sym type)]))])))
|
||||||
; (primitive-set! 'identifier? id?)
|
|
||||||
(define generate-temporaries
|
(define generate-temporaries
|
||||||
(lambda (ls)
|
(lambda (ls)
|
||||||
(unless (list? ls)
|
(unless (list? ls)
|
||||||
|
|
|
@ -964,7 +964,6 @@
|
||||||
[$unbound-object? $unbound-object?-label (core-prim . $unbound-object?)]
|
[$unbound-object? $unbound-object?-label (core-prim . $unbound-object?)]
|
||||||
[$make-call-with-values-procedure $make-cwv-procedure (core-prim . $make-call-with-values-procedure)]
|
[$make-call-with-values-procedure $make-cwv-procedure (core-prim . $make-call-with-values-procedure)]
|
||||||
[$make-values-procedure $make-values-procedure (core-prim . $make-values-procedure)]
|
[$make-values-procedure $make-values-procedure (core-prim . $make-values-procedure)]
|
||||||
[primitive-set! primitive-set!-label (core-prim . primitive-set!)]
|
|
||||||
[$$apply $$apply-label (core-prim . $$apply)]
|
[$$apply $$apply-label (core-prim . $$apply)]
|
||||||
[$arg-list $arg-list-label (core-prim . $arg-list)]
|
[$arg-list $arg-list-label (core-prim . $arg-list)]
|
||||||
[$interrupted? $interrupted?-label (core-prim . $interrupted?)]
|
[$interrupted? $interrupted?-label (core-prim . $interrupted?)]
|
||||||
|
@ -1124,3 +1123,4 @@
|
||||||
|
|
||||||
(invoke (ikarus makefile))
|
(invoke (ikarus makefile))
|
||||||
|
|
||||||
|
;;; vim:syntax=scheme
|
||||||
|
|
Loading…
Reference in New Issue