0.4.0 hacks

This commit is contained in:
bdc 1995-10-31 22:04:59 +00:00
parent b3dc61dae4
commit 9e39aeaae4
5 changed files with 50 additions and 62 deletions

2
configure vendored
View File

@ -773,7 +773,7 @@ EOF
fi fi
if $ac_cv_c_bigendian = no ; then if test $ac_cv_c_bigendian = no ; then
ENDIAN=little ENDIAN=little
else else
ENDIAN=big ENDIAN=big

36
scsh/endian.scm.in Normal file
View File

@ -0,0 +1,36 @@
;;; Endian routines for the Scheme Shell
;;; Copyright (c) 1995 by Brian D. Carlstrom.
;; Big Endian - Motorola, Sparc, HPPA, etc
(define (net-to-host-32-big num32)
(and (<= 0 num32 #xffffffff)
num32))
(define (net-to-host-16-big num16)
(and (<= 0 num16 #xffffffff)
num16))
;; Little Endian - Intel, Vax, Alpha
(define (net-to-host-32-little num32)
(and (<= 0 num32 #xffffffff)
(let* ((num24 (arithmetic-shift num32 -8))
(num16 (arithmetic-shift num24 -8))
(num08 (arithmetic-shift num16 -8))
(byte0 (bitwise-and #b11111111 num08))
(byte1 (bitwise-and #b11111111 num16))
(byte2 (bitwise-and #b11111111 num24))
(byte3 (bitwise-and #b11111111 num32)))
(+ (arithmetic-shift byte3 24)
(define (net-to-host-16-little num16)
(and (<= 0 num16 #xffffffff)
(let* ((num08 (arithmetic-shift num16 -8))
(byte0 (bitwise-and #b11111111 num08))
(byte1 (bitwise-and #b11111111 num16))
(+ (arithmetic-shift byte1 8)
byte0))))
(define net-to-host-32 net-to-host-32-@ENDIAN@)
(define net-to-host-16 net-to-host-16-@ENDIAN@)
(define host-to-net-32 host-to-net-32-@ENDIAN@)
(define host-to-net-16 host-to-net-16-@ENDIAN@)

View File

@ -381,24 +381,6 @@ scheme_value df_scheme_proto_name2proto_info(long nargs, scheme_value *args)
return ret1; return ret1;
} }
scheme_value df_veclen(long nargs, scheme_value *args)
{
extern scheme_value veclen(const long * );
scheme_value ret1;
scheme_value r1;
cig_check_nargs(1, nargs, "veclen");
r1 = veclen((const long * )AlienVal(args[0]));
ret1 = r1;
return ret1;
}
scheme_value df_set_longvec_carriers(long nargs, scheme_value *args)
{
extern void set_longvec_carriers(scheme_value , long const * const * );
cig_check_nargs(2, nargs, "set_longvec_carriers");
set_longvec_carriers(args[1], (long const * const * )AlienVal(args[0]));
return SCHFALSE;
}
Error: end of file inside list -- unbalanced parentheses
#{Input-port}

View File

@ -1,14 +1,5 @@
#!/usr/local/bin/scsh \ #!/usr/local/bin/scsh \
-lm vm/ps-interface.scm -lm /usr/local/lib/scsh/vm/ps-interface.scm -lm /usr/local/lib/scsh/vm/interfaces.scm -lm /usr/local/lib/scsh/vm/package-defs.scm -lm /usr/local/lib/scsh/vm/s48-package-defs.scm -m heap -l /usr/local/lib/scsh/scsh/static-heap.scm -dm -m scsh-static-heap -e scsh-static-linker -s
-lm vm/interfaces.scm
-lm vm/package-defs.scm
-lm vm/s48-package-defs.scm
-m heap
-l scsh/static-heap.scm
-dm
-m scsh-static
-e scsh-static-linker
-s
!# !#
(define-structure heap-extra (export newspace-begin (define-structure heap-extra (export newspace-begin
heap-pointer heap-pointer
@ -17,7 +8,7 @@
stob-type) stob-type)
(open scheme heap)) (open scheme heap))
(define-structure static-heap (export scsh-static-linker) (define-structure scsh-static-heap (export scsh-static-linker)
(open scheme heap memory data stob struct (open scheme heap memory data stob struct
heap-extra heap-extra
vm-architecture vm-architecture
@ -27,4 +18,4 @@
tables tables
defrec-package defrec-package
scsh) scsh)
(files (scsh static1))) (files "/usr/local/lib/scsh/scsh/static1.scm"))

View File

@ -233,27 +233,6 @@
(string-append prefix ".o") (string-append prefix ".o")
l))))))))))) l)))))))))))
;; Big Endian - Motorola, Sparc, HPPA
; (define (ntohl num32)
; (and (<= 0 num32 #xffffffff)
; num32))
;; Little Endian - Intel, Vax, Alpha
(define (ntohl num32)
(and (<= 0 num32 #xffffffff)
(let* ((num24 (arithmetic-shift num32 -8))
(num16 (arithmetic-shift num24 -8))
(num08 (arithmetic-shift num16 -8))
(byte0 (bitwise-and #b11111111 num08))
(byte1 (bitwise-and #b11111111 num16))
(byte2 (bitwise-and #b11111111 num24))
(byte3 (bitwise-and #b11111111 num32)))
(+ (arithmetic-shift byte3 24)
(arithmetic-shift byte2 16)
(arithmetic-shift byte1 8)
byte0))))
(define (scsh-emit-initializer x reloc externs port) (define (scsh-emit-initializer x reloc externs port)
(write-hex port (stob-header x)) (write-hex port (stob-header x))
(cond ((d-vector? x) (cond ((d-vector? x)
@ -287,12 +266,12 @@
((1) ((1)
(write-hex (write-hex
port port
(ntohl (arithmetic-shift (net-to-host-32 (arithmetic-shift
(char->ascii (vm-string-ref x i)) 24)))) (char->ascii (vm-string-ref x i)) 24))))
((2) ((2)
(write-hex (write-hex
port port
(ntohl (net-to-host-32
(bitwise-ior (bitwise-ior
(arithmetic-shift (arithmetic-shift
(char->ascii (vm-string-ref x i)) 24) (char->ascii (vm-string-ref x i)) 24)
@ -301,7 +280,7 @@
((3) ((3)
(write-hex (write-hex
port port
(ntohl (net-to-host-32
(bitwise-ior (bitwise-ior
(bitwise-ior (bitwise-ior
(arithmetic-shift (arithmetic-shift
@ -311,7 +290,7 @@
(arithmetic-shift (arithmetic-shift
(char->ascii (vm-string-ref x (+ i 2))) 8))))))) (char->ascii (vm-string-ref x (+ i 2))) 8)))))))
(write-hex port (write-hex port
(ntohl (bitwise-ior (net-to-host-32 (bitwise-ior
(bitwise-ior (bitwise-ior
(arithmetic-shift (arithmetic-shift
(char->ascii (vm-string-ref x i)) 24) (char->ascii (vm-string-ref x i)) 24)
@ -337,18 +316,18 @@
((1) ((1)
(write-hex (write-hex
port port
(ntohl (arithmetic-shift (b-vector-ref x i) 24)))) (net-to-host-32 (arithmetic-shift (b-vector-ref x i) 24))))
((2) ((2)
(write-hex (write-hex
port port
(ntohl (net-to-host-32
(bitwise-ior (bitwise-ior
(arithmetic-shift (b-vector-ref x i) 24) (arithmetic-shift (b-vector-ref x i) 24)
(arithmetic-shift (b-vector-ref x (+ i 1)) 16))))) (arithmetic-shift (b-vector-ref x (+ i 1)) 16)))))
((3) ((3)
(write-hex (write-hex
port port
(ntohl (net-to-host-32
(bitwise-ior (bitwise-ior
(bitwise-ior (bitwise-ior
(arithmetic-shift (b-vector-ref x i) 24) (arithmetic-shift (b-vector-ref x i) 24)
@ -357,7 +336,7 @@
)))) ))))
(write-hex (write-hex
port port
(ntohl (bitwise-ior (net-to-host-32 (bitwise-ior
(bitwise-ior (bitwise-ior
(arithmetic-shift (b-vector-ref x i) 24) (arithmetic-shift (b-vector-ref x i) 24)
(arithmetic-shift (b-vector-ref x (+ i 1)) 16)) (arithmetic-shift (b-vector-ref x (+ i 1)) 16))