0.4.0 hacks
This commit is contained in:
parent
b3dc61dae4
commit
9e39aeaae4
|
@ -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
|
||||||
|
|
|
@ -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@)
|
|
@ -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}
|
||||||
|
|
|
@ -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"))
|
||||||
|
|
|
@ -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))
|
||||||
|
|
Loading…
Reference in New Issue