fixed bug in ($make-vector 0)

This commit is contained in:
Abdulaziz Ghuloum 2008-04-07 12:32:55 -04:00
parent 42e3d53d00
commit 6bdb38ca16
5 changed files with 39 additions and 18 deletions

View File

@ -2864,7 +2864,6 @@
(parameterize ([exceptions-conc ac])
(T body ac))))
(map Clambda code*))]))
;;;
;;; (print-code x)
(Program x))

View File

@ -1 +1 @@
1435
1438

View File

@ -45,10 +45,11 @@
(prm 'mref x (K (- disp tag)))))
(define (dirty-vector-set address)
(define shift-bits 2)
(prm 'mset
(prm 'int+
(prm 'mref pcr (K pcb-dirty-vector))
(prm 'sll (prm 'srl address (K pageshift)) (K wordshift)))
(prm 'sll (prm 'srl address (K pageshift)) (K shift-bits)))
(K 0)
(K dirty-word)))
@ -391,7 +392,7 @@
(K vector-tag))])
(prm 'mset v
(K (- disp-vector-length vector-tag))
(K (make-constant (* i fx-scale))))
(K (* i fx-scale)))
v)]
[else
(with-tmp ([alen (align-code (T len) disp-vector-data)])

View File

@ -70,6 +70,7 @@
[fx- $fx-]
[fx* $fx*]
[fxadd1 $fxadd1]
[fxsub1 $fxsub1]
[fxlogor $fxlogor]
[fxlogand $fxlogand]
[fxlognot $fxlognot]
@ -82,6 +83,22 @@
[cons cons]
[car $car]
[cdr $cdr]
[set-car! $set-car!]
[set-cdr! $set-cdr!]
[eq? eq?]
[make-vector $make-vector]
[vector? vector?]
[vector-length $vector-length]
[vector-set! $vector-set!]
[vector-ref $vector-ref]
[string? string?]
[make-string $make-string]
[string-set! $string-set!]
[string-ref $string-ref]
[string-length $string-length]
[char= $char=]
[fixnum->char $fixnum->char]
[char->fixnum $char->fixnum]
))
@ -102,12 +119,17 @@
`((primitive ,(cadr (assq prim prims-alist))) ,args ...)]
[(if ,[e0] ,[e1] ,[e2])
`(if ,e0 ,e1 ,e2)]
[(let ([,lhs* ,[rhs*]] ...) ,body)
[(let ([,lhs* ,[rhs*]] ...) ,body ,body* ...)
(let ([nlhs* (map gensym lhs*)])
(let ([env (append (map cons lhs* nlhs*) env)])
`((case-lambda
[,nlhs* ,(Expr body env)])
[,nlhs*
(begin ,(Expr body env)
,(map (lambda (x) (Expr x env)) body*)
...)])
,rhs* ...)))]
[(begin ,[e] ,[e*] ...)
`(begin ,e ,e* ...)]
[,_ (error 'fixup "invalid expression" _)]))
(Expr x '()))
@ -119,14 +141,15 @@
(append all-tests
'([test string] ...)))])))
(include "tests/tests-1.1-req.scm")
(include "tests/tests-1.2-req.scm")
(include "tests/tests-1.3-req.scm")
(include "tests/tests-1.4-req.scm")
(include "tests/tests-1.5-req.scm")
(include "tests/tests-1.6-req.scm")
(include "tests/tests-1.7-req.scm")
(include "tests/tests-1.8-req.scm")
; (include "tests/tests-1.1-req.scm")
; (include "tests/tests-1.2-req.scm")
; (include "tests/tests-1.3-req.scm")
; (include "tests/tests-1.4-req.scm")
; (include "tests/tests-1.5-req.scm")
; (include "tests/tests-1.6-req.scm")
; (include "tests/tests-1.7-req.scm")
; (include "tests/tests-1.8-req.scm")
(include "tests/tests-1.9-req.scm")
(current-primitive-locations

View File

@ -129,13 +129,11 @@ print(FILE* fh, ikptr x){
else if(tagof(x) == string_tag){
ikptr fxlen = ref(x, off_string_length);
int len = unfix(fxlen);
fprintf(stderr, "bug: printer busted!\n");
exit(-1);
char* data = 0; //string_data(x);
long int * data = (long int*)(x + off_string_data);
fprintf(fh, "\"");
int i;
for(i=0; i<len; i++){
char c = data[i];
char c = (data[i]) >> char_shift;
if((c == '\\') || (c == '"')){
fprintf(fh, "\\");
}