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

* primitive-set! is gone.

This commit is contained in:
Abdulaziz Ghuloum 2007-05-05 23:10:47 -04:00
parent 931be7dda9
commit 7173bcc61b
8 changed files with 6 additions and 62 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.

24
src/ikarus.compiler.ss
View File

@ -136,7 +136,6 @@
[$set-symbol-unique-string! 2 effect]
[$symbol-plist 1 value]
[$set-symbol-plist! 2 effect]
[primitive-set! 2 effect]
[top-level-value 1 value]
;;; ports
[port? 1 pred]
@ -942,7 +941,6 @@
384 cdr
898 cons
747 error
331 primitive-set!
555 void
645 list
|#
@ -1258,7 +1256,7 @@
;X; (giveup))]
;;; unoptimizables
[(error syntax-error $syntax-dispatch $sc-put-cte
primitive-set! apply)
apply)
(giveup)]
))
@ -2064,7 +2062,6 @@
$code-size $code-reloc-vector $code-freevars
$code-ref $code-set!
$make-record $record? $record/rtd? $record-rtd $record-ref $record-set!
primitive-set!
$make-tcbucket $tcbucket-key $tcbucket-val $tcbucket-next
$set-tcbucket-val!
$set-tcbucket-next! $set-tcbucket-tconc!)
@ -4092,7 +4089,7 @@
ac))]
[($set-car! $set-cdr! $vector-set! $string-set! $exit
$set-symbol-value! $set-symbol-plist!
$code-set! primitive-set!
$code-set!
$set-code-object! $set-code-object+offset! $set-code-object+offset/rel!
$record-set!
$set-port-input-index! $set-port-input-size!
@ -4258,17 +4255,6 @@
(addl (pcb-ref 'dirty-vector) eax)
(movl (int dirty-word) (mem 0 eax))
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!)
(list* (movl (Simple (car arg*)) eax)
(movl (Simple (cadr arg*)) ebx)
@ -5268,7 +5254,7 @@
(parameterize ([assembler-output #f])
(expand x))))
(primitive-set! 'compile
(define compile
(lambda (x)
(let ([code
(if (code? x)
@ -5288,7 +5274,6 @@
(f))))
(close-input-port ip)
(close-output-port op))))
(primitive-set! 'compile-file compile-file)
;(include "libaltcogen.ss")
(define alt-cogen
@ -5308,9 +5293,8 @@
(close-output-port op))))
(primitive-set! 'alt-compile-file alt-compile-file)
(primitive-set! 'alt-compile
(define alt-compile
(lambda (x)
(let ([code
(if (code? x)

2
src/ikarus.fasl.ss
View File

@ -449,7 +449,7 @@
[else
(error who "Unexpected ~s as a fasl object header" h)])))
(read))
(primitive-set! '$fasl-read
(define $fasl-read
(lambda (p)
(assert-eq? (read-char p) #\I)
(assert-eq? (read-char p) #\K)

37
src/ikarus.io-ports.ss
View File

@ -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 procedure" handler))))
;;;
;;; XXX (primitive-set! '$port-handler
;;; XXX (lambda (x) ($port-handler x)))
;;;
(define port-handler
(lambda (x)
(if (port? x)
($port-handler 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
(lambda (x)
(if (input-port? x)
($port-input-buffer 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
(lambda (x)
(if (input-port? x)
($port-input-index 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
(lambda (x)
(if (input-port? x)
($port-input-size 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
(lambda (x)
(if (output-port? x)
($port-output-buffer 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
(lambda (x)
(if (output-port? x)
($port-output-index 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
(lambda (x)
(if (output-port? x)
($port-output-size 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!
(lambda (p i)
(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 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!
(lambda (p i)
(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 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!
(lambda (p i)
(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 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!
(lambda (p i)
(if (output-port? p)

1
src/ikarus.io.input-strings.ss
View File

@ -55,5 +55,4 @@
(make-input-string-handler str)
str)])
port)))
(primitive-set! 'open-input-string open-input-string)

1
src/ikarus.library-manager.ss
View File

@ -513,7 +513,6 @@
[$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-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)]
[$arg-list $arg-list-label (core-prim . $arg-list)]
[$interrupted? $interrupted?-label (core-prim . $interrupted?)]

1
src/ikarus.syntax.ss
View File

@ -2145,7 +2145,6 @@
(cons (cons (car ext*) label) subst)
(cons (cons label (cons 'global (binding-value b))) env))]
[else (error #f "cannot export ~s of type ~s" sym type)]))])))
; (primitive-set! 'identifier? id?)
(define generate-temporaries
(lambda (ls)
(unless (list? ls)

2
src/makefile.ss
View File

@ -964,7 +964,6 @@
[$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-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)]
[$arg-list $arg-list-label (core-prim . $arg-list)]
[$interrupted? $interrupted?-label (core-prim . $interrupted?)]
@ -1124,3 +1123,4 @@
(invoke (ikarus makefile))
;;; vim:syntax=scheme