October 2014 - cmucl-cvs - mailman3.common-lisp.net

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. 20f-60-g1f025ba
by Raymond Toy 30 Oct '14

30 Oct '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via 1f025baf2d31cb22998fffc44125669506a23137 (commit) from aee96f0add55233605cb83bba15d364c7b13fced (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 1f025baf2d31cb22998fffc44125669506a23137 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Wed Oct 29 22:15:35 2014 -0700 Change check for id to be 1 <= id <= 3, and print error message if it's not true. diff --git a/src/lisp/elf.c b/src/lisp/elf.c index 130795e..1e8659e 100644 --- a/src/lisp/elf.c +++ b/src/lisp/elf.c @@ -284,7 +284,7 @@ write_space_object(const char *dir, int id, os_vm_address_t start, os_vm_address ((end - start) % os_vm_page_size)); static char *names[] = { "Dynamic", "Static", "Read-Only" }; - if(id < 1 || id > 3) { + if (!(1 <= id) && (id <= 3)) { fprintf(stderr, "Invalid space id in %s: %d\n", __func__, id); fprintf(stderr, "Executable not built.\n"); ret = -1; ----------------------------------------------------------------------- Summary of changes: src/lisp/elf.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) hooks/post-receive -- CMU Common Lisp

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. 20f-59-gaee96f0
by Raymond Toy 29 Oct '14

29 Oct '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via aee96f0add55233605cb83bba15d364c7b13fced (commit) via 0bb2950b26f392c41da55f01b4a7d52ae0648a3a (commit) via 088e156b8a32786a55269874e19496c2ba104fdf (commit) from 7fa26f32137fb1372406dff479689864f74601ca (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit aee96f0add55233605cb83bba15d364c7b13fced Merge: 7fa26f3 0bb2950 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Wed Oct 29 13:35:46 2014 -0700 Support 64-bit time-t on NetBSD. Fixes from Robert Swindells. ----------------------------------------------------------------------- Summary of changes: src/code/time.lisp | 2 +- src/code/unix.lisp | 101 +++++++++++++++++++++++++++++------------ src/lisp/NetBSD-os.c | 10 ++-- src/lisp/NetBSD-os.h | 1 + src/motif/server/Config.NetBSD | 2 +- src/motif/server/main.c | 1 + 6 files changed, 80 insertions(+), 37 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch rtoy-netbsd-64-bit-time-t updated. 20f-57-g0bb2950
by Raymond Toy 27 Oct '14

27 Oct '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, rtoy-netbsd-64-bit-time-t has been updated via 0bb2950b26f392c41da55f01b4a7d52ae0648a3a (commit) from 088e156b8a32786a55269874e19496c2ba104fdf (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 0bb2950b26f392c41da55f01b4a7d52ae0648a3a Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Mon Oct 27 08:23:38 2014 -0700 Minor tweaks for solaris. diff --git a/src/code/unix.lisp b/src/code/unix.lisp index bc178f2..8e9e137 100644 --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -215,9 +215,9 @@ (def-alien-type caddr-t (* char)) (def-alien-type ino-t - #+(or linux (and bsd (not netbsd))) unsigned-long #+netbsd u-int64-t - #+alpha unsigned-int) + #+alpha unsigned-int + #-(or alpha netbsd) unsigned-long) (def-alien-type swblk-t long) @@ -2363,7 +2363,9 @@ returns NIL and the errno." (with-alien ((tv (struct timeval)) #-(or svr4 netbsd) (tz (struct timezone))) - (syscall* (#+netbsd #-netbsd "gettimeofday" "__gettimeofday50" (* (struct timeval)) #-svr4 (* (struct timezone))) + (syscall* (#-netbsd "gettimeofday" + #+netbsd "__gettimeofday50" + (* (struct timeval)) #-svr4 (* (struct timezone))) (values T (slot tv 'tv-sec) (slot tv 'tv-usec) ----------------------------------------------------------------------- Summary of changes: src/code/unix.lisp | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. 20f-56-g7fa26f3
by Raymond Toy 27 Oct '14

27 Oct '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via 7fa26f32137fb1372406dff479689864f74601ca (commit) from 9829658f5c0ac762e7b939014a012dd2d558e73a (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 7fa26f32137fb1372406dff479689864f74601ca Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sun Oct 26 19:52:17 2014 -0700 Fix issue in sending a boolean created from a pointer in RXmStringEtLtoR. Fix from Richard Kreuter. This makes his clm-young::chooseone demo work reliably. Richard writes: The detail that this patch affects is non-deterministic: RXmStringGetLtoR in xmstring.c calls message_write_boolean on a pointer, message_write_boolean in datatrans.c calls combine_type_and_data with the pointer and the boolean type tag, and combine_type_and_data in datatrans.h IORs the boolean type tag with the bits 25 to 32 from the start of the pointer. This gave a decoding error on the Lisp side in TOOLKIT-READ-VALUE, because the high 8 bits of the 32 bits being decoded indexed past the end of *TYPE-TABLE*. (But other incorrect outcomes are possible, e.g., the result of combine_type_and_data could index a valid, but wrong, type code, etc.) diff --git a/src/motif/server/xmstring.c b/src/motif/server/xmstring.c index 8202826..f983d4f 100644 --- a/src/motif/server/xmstring.c +++ b/src/motif/server/xmstring.c @@ -145,7 +145,7 @@ void RXmStringGetLtoR(message_t message) result = XmStringGetLtoR(xs,charset,&text); message_write_string(reply,text,string_tag); - message_write_boolean(reply,text,boolean_tag); + message_write_boolean(reply,(result==True)?1:0,boolean_tag); message_send(client_socket,reply); message_free(reply); ----------------------------------------------------------------------- Summary of changes: src/motif/server/xmstring.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) hooks/post-receive -- CMU Common Lisp

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch rtoy-netbsd-64-bit-time-t created. 20f-56-g088e156
by Raymond Toy 25 Oct '14

25 Oct '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, rtoy-netbsd-64-bit-time-t has been created at 088e156b8a32786a55269874e19496c2ba104fdf (commit) - Log ----------------------------------------------------------------- commit 088e156b8a32786a55269874e19496c2ba104fdf Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Oct 25 13:39:35 2014 -0700 Support 64-bit time-t on NetBSD. Fixes from Robert Swindells. diff --git a/src/code/time.lisp b/src/code/time.lisp index e6fb0c0..51457f5 100644 --- a/src/code/time.lisp +++ b/src/code/time.lisp @@ -105,7 +105,7 @@ ;;; - T if daylight savings is in effect, NIL if not. ;;; (alien:def-alien-routine get-timezone c-call:void - (when c-call:long :in) + (when unix:time-t :in) (minutes-west c-call:int :out) (daylight-savings-p alien:boolean :out)) diff --git a/src/code/unix.lisp b/src/code/unix.lisp index 2d595d4..bc178f2 100644 --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -215,7 +215,8 @@ (def-alien-type caddr-t (* char)) (def-alien-type ino-t - #-alpha unsigned-long + #+(or linux (and bsd (not netbsd))) unsigned-long + #+netbsd u-int64-t #+alpha unsigned-int) (def-alien-type swblk-t long) @@ -228,14 +229,16 @@ (def-alien-type time-t #-(or bsd linux alpha) unsigned-long #+linux long - #+bsd long + #+(and bsd (not netbsd)) long + #+(and bsd netbsd) int64-t #+alpha unsigned-int) (def-alien-type dev-t #-(or alpha svr4 bsd linux) short #+linux unsigned-short + #+netbsd u-int64-t #+alpha int - #+(and (not linux) (or bsd svr4)) unsigned-long) + #+(and (not linux) (not netbsd) (or bsd svr4)) unsigned-long) #-BSD (progn @@ -286,7 +289,8 @@ #+svr4 unsigned-long) (def-alien-type nlink-t - #-svr4 unsigned-short + #-(or svr4 netbsd) unsigned-short + #+netbsd unsigned-long #+svr4 unsigned-long) (defconstant FD-SETSIZE @@ -335,7 +339,7 @@ (def-alien-type nil (struct timeval (tv-sec #-linux time-t #+linux int) ; seconds - (tv-usec #-linux time-t #+linux int))) ; and microseconds + (tv-usec int))) ; and microseconds (def-alien-type nil (struct timezone @@ -359,7 +363,7 @@ #+(or linux BSD) (def-alien-type nil (struct timespec-t - (ts-sec long) + (ts-sec time-t) (ts-nsec long))) ;;; From ioctl.h @@ -466,7 +470,7 @@ (d-namlen unsigned-short) ; length of string in d-name (d-name (array char 256)))) ; name must be no longer than this -#+bsd +#+(and bsd (not netbsd)) (def-alien-type nil (struct direct (d-fileno unsigned-long) @@ -475,6 +479,15 @@ (d-namlen unsigned-char) ; length of string in d-name (d-name (array char 256)))) ; name must be no longer than this +#+netbsd +(def-alien-type nil + (struct direct + (d-fileno ino-t) + (d-reclen unsigned-short) + (d-namlen unsigned-short) + (d-type unsigned-char) + (d-name (array char 512)))) + ;;; The 64-bit version of struct dirent. #+solaris (def-alien-type nil @@ -509,7 +522,7 @@ (st-blocks #-alpha long #+alpha int) (st-spare4 (array long 2)))) -#+bsd +#+(and bsd (not netbsd)) (def-alien-type nil (struct stat (st-dev dev-t) @@ -530,6 +543,27 @@ (st-lspare long) (st-qspare (array long 4)))) +#+netbsd +(def-alien-type nil + (struct stat + (st-dev dev-t) + (st-mode mode-t) + (st-ino ino-t) + (st-nlink nlink-t) + (st-uid uid-t) + (st-gid gid-t) + (st-rdev dev-t) + (st-atime (struct timespec-t)) + (st-mtime (struct timespec-t)) + (st-ctime (struct timespec-t)) + (st-birthtime (struct timespec-t)) + (st-size off-t) + (st-blocks off-t) + (st-blksize long) + (st-flags unsigned-long) + (st-gen unsigned-long) + (st-spare (array unsigned-long 2)))) + #+(or linux svr4) (def-alien-type nil (struct stat @@ -1597,7 +1631,7 @@ (when timeout-secs (setf (slot tv 'tv-sec) timeout-secs) (setf (slot tv 'tv-usec) ,timeout-usecs)) - (int-syscall ("select" int (* (struct fd-set)) (* (struct fd-set)) + (int-syscall (#-netbsd "select" #+netbsd "__select50" int (* (struct fd-set)) (* (struct fd-set)) (* (struct fd-set)) (* (struct timeval))) ,num-descriptors ,read-fds ,write-fds ,exception-fds (if timeout-secs (alien-sap (addr tv)) (int-sap 0)))))) @@ -1647,7 +1681,7 @@ `(if (zerop ,lispvar) (int-sap 0) (alien-sap (addr ,alienvar))))) - (syscall ("select" int (* (struct fd-set)) (* (struct fd-set)) + (syscall (#-netbsd "select" #+netbsd "__select50" int (* (struct fd-set)) (* (struct fd-set)) (* (struct fd-set)) (* (struct timeval))) (values result (fd-set-to-num nfds rdf) @@ -2137,6 +2171,7 @@ #-(or svr4 BSD) (slot ,buf 'st-ctime) #+svr4 (slot (slot ,buf 'st-ctime) 'tv-sec) #+BSD(slot (slot ,buf 'st-ctime) 'ts-sec) + #+netbsd (slot (slot ,buf 'st-birthtime) 'ts-sec) (slot ,buf 'st-blksize) (slot ,buf 'st-blocks))) @@ -2152,7 +2187,7 @@ (when (string= name "") (setf name ".")) (with-alien ((buf (struct stat))) - (syscall ("stat" c-string (* (struct stat))) + (syscall (#-netbsd "stat" #+netbsd "__stat50" c-string (* (struct stat))) (extract-stat-results buf) (%name->file name) (addr buf)))) @@ -2161,7 +2196,7 @@ file must be a symbolic link." (declare (type unix-pathname name)) (with-alien ((buf (struct stat))) - (syscall ("lstat" c-string (* (struct stat))) + (syscall (#-netbsd "lstat" #+netbsd "__lstat50" c-string (* (struct stat))) (extract-stat-results buf) (%name->file name) (addr buf)))) @@ -2170,7 +2205,7 @@ by the file descriptor fd." (declare (type unix-fd fd)) (with-alien ((buf (struct stat))) - (syscall ("fstat" int (* (struct stat))) + (syscall (#-netbsd "fstat" #+netbsd "__fstat50" int (* (struct stat))) (extract-stat-results buf) fd (addr buf)))) ) @@ -2223,7 +2258,7 @@ (unsigned-byte 31) (mod 1000000) (unsigned-byte 31) (mod 1000000))) (with-alien ((usage (struct rusage))) - (syscall* ("getrusage" int (* (struct rusage))) + (syscall* (#-netbsd "getrusage" #+netbsd "__getrusage50" int (* (struct rusage))) (values t (slot (slot usage 'ru-utime) 'tv-sec) (slot (slot usage 'ru-utime) 'tv-usec) @@ -2238,7 +2273,7 @@ child processes (rusage_children). NIL and an error number is returned if the call fails." (with-alien ((usage (struct rusage))) - (syscall ("getrusage" int (* (struct rusage))) + (syscall (#-netbsd "getrusage" #+netbsd "__getrusage50" int (* (struct rusage))) (values t (+ (* (slot (slot usage 'ru-utime) 'tv-sec) 1000000) (slot (slot usage 'ru-utime) 'tv-usec)) @@ -2327,18 +2362,18 @@ of Greenwich), and a daylight-savings flag. If it doesn't work, it returns NIL and the errno." (with-alien ((tv (struct timeval)) - #-svr4 (tz (struct timezone))) - (syscall* ("gettimeofday" (* (struct timeval)) #-svr4 (* (struct timezone))) + #-(or svr4 netbsd) (tz (struct timezone))) + (syscall* (#+netbsd #-netbsd "gettimeofday" "__gettimeofday50" (* (struct timeval)) #-svr4 (* (struct timezone))) (values T (slot tv 'tv-sec) (slot tv 'tv-usec) - #-svr4 (slot tz 'tz-minuteswest) + #-(or svr4 netbsd) (slot tz 'tz-minuteswest) #+svr4 (unix-get-minutes-west (slot tv 'tv-sec)) - #-svr4 (slot tz 'tz-dsttime) + #-(or svr4 netbsd) (slot tz 'tz-dsttime) #+svr4 (unix-get-timezone (slot tv 'tv-sec)) ) (addr tv) - #-svr4 (addr tz)))) + #-(or svr4 netbsd) (addr tz) #+netbsd nil))) ;;; Unix-utimes changes the accessed and updated times on UNIX ;;; files. The first argument is the filename (a string) and @@ -2359,7 +2394,7 @@ (setf (slot (deref tvp 0) 'tv-usec) atime-usec) (setf (slot (deref tvp 1) 'tv-sec) mtime-sec) (setf (slot (deref tvp 1) 'tv-usec) mtime-usec) - (void-syscall ("utimes" c-string (* (struct timeval))) + (void-syscall (#-netbsd "utimes" #+netbsd "__utimes50" c-string (* (struct timeval))) file (cast tvp (* (struct timeval)))))) @@ -2592,8 +2627,8 @@ (with-alien ((direct (* (struct direct)) daddr)) (let ((nlen (slot direct 'd-namlen)) (fino (slot direct 'd-fileno))) - (declare (type (unsigned-byte 8) nlen) - (type (unsigned-byte 32) fino)) + (declare (type (unsigned-byte #+netbsd 16 #-netbsd 8) nlen) + (type (unsigned-byte #+netbsd 64 #-netbsd 32) fino)) (let ((string (make-string nlen))) #-unicode (kernel:copy-from-system-area @@ -3089,14 +3124,16 @@ T, it-interval-secs, it-interval-usec, it-value-secs, it-value-usec." (declare (type (member :real :virtual :profile) which) (values t - (unsigned-byte 29)(mod 1000000) - (unsigned-byte 29)(mod 1000000))) + #+netbsd (unsigned-byte 63) #-netbsd (unsigned-byte 29) + (mod 1000000) + #+netbsd (unsigned-byte 63) #-netbsd (unsigned-byte 29) + (mod 1000000))) (let ((which (ecase which (:real ITIMER-REAL) (:virtual ITIMER-VIRTUAL) (:profile ITIMER-PROF)))) (with-alien ((itv (struct itimerval))) - (syscall* ("getitimer" int (* (struct itimerval))) + (syscall* (#-netbsd "getitimer" #+netbsd "__getitimer50" int (* (struct itimerval))) (values T (slot (slot itv 'it-interval) 'tv-sec) (slot (slot itv 'it-interval) 'tv-usec) @@ -3117,8 +3154,10 @@ (type (unsigned-byte 29) int-secs val-secs) (type (integer 0 (1000000)) int-usec val-usec) (values t - (unsigned-byte 29)(mod 1000000) - (unsigned-byte 29)(mod 1000000))) + (unsigned-byte 29) + (mod 1000000) + (unsigned-byte 29) + (mod 1000000))) (let ((which (ecase which (:real ITIMER-REAL) (:virtual ITIMER-VIRTUAL) @@ -3129,7 +3168,7 @@ (slot (slot itvn 'it-interval) 'tv-usec) int-usec (slot (slot itvn 'it-value ) 'tv-sec ) val-secs (slot (slot itvn 'it-value ) 'tv-usec) val-usec) - (syscall* ("setitimer" int (* (struct timeval))(* (struct timeval))) + (syscall* (#-netbsd "setitimer" #+netbsd "__setitimer50" int (* (struct timeval))(* (struct timeval))) (values T (slot (slot itvo 'it-interval) 'tv-sec) (slot (slot itvo 'it-interval) 'tv-usec) diff --git a/src/lisp/NetBSD-os.c b/src/lisp/NetBSD-os.c index 7b73529..6957ab1 100644 --- a/src/lisp/NetBSD-os.c +++ b/src/lisp/NetBSD-os.c @@ -21,8 +21,12 @@ #include <stdio.h> #include <stdlib.h> #include <sys/param.h> +#include <sys/types.h> #include <sys/file.h> +#include <sys/proc.h> +#include <sys/sysctl.h> #include <errno.h> + #include "os.h" #include "arch.h" #include "globals.h" @@ -30,12 +34,8 @@ #include "lispregs.h" #include "internals.h" -#include <sys/types.h> #include <signal.h> -/* #include <sys/sysinfo.h> */ -#include <sys/proc.h> #include <dlfcn.h> -#include <sys/sysctl.h> #include "validate.h" size_t os_vm_page_size; @@ -94,7 +94,7 @@ os_sigcontext_fpu_reg(ucontext_t *scp, int index) unsigned char *reg = NULL; DPRINTF(0, (stderr, "fpu reg index = %d\n", index)); - + if (scp->uc_flags & _UC_FPU) { if (scp->uc_flags & _UC_FXSAVE) { /* diff --git a/src/lisp/NetBSD-os.h b/src/lisp/NetBSD-os.h index e2a8fe8..b9d846a 100644 --- a/src/lisp/NetBSD-os.h +++ b/src/lisp/NetBSD-os.h @@ -12,6 +12,7 @@ #include <sys/types.h> #include <sys/mman.h> #include <sys/signal.h> +#include <sys/stat.h> #include <ucontext.h> #include <string.h> #include <unistd.h> diff --git a/src/motif/server/Config.NetBSD b/src/motif/server/Config.NetBSD index 83591ac..a5d3233 100644 --- a/src/motif/server/Config.NetBSD +++ b/src/motif/server/Config.NetBSD @@ -1,6 +1,6 @@ CFLAGS = -O2 -I/usr/pkg/include -I/usr/X11R7/include -I. -I$(VPATH) LDFLAGS = -R/usr/X11R7/lib -L/usr/X11R7/lib -R/usr/pkg/lib -L/usr/pkg/lib -LIBS = -lXm -lXt -lXext -lX11 -lSM -lICE -lXp +LIBS = -lXm -lXt -lXext -lX11 -lSM -lICE # This def assumes you are building in the same or parallel # tree to the CVS souce layout. Sites may need to customize # this path. diff --git a/src/motif/server/main.c b/src/motif/server/main.c index c5e42ba..4a3f2cc 100644 --- a/src/motif/server/main.c +++ b/src/motif/server/main.c @@ -12,6 +12,7 @@ #include <ctype.h> #include <sys/types.h> #include <sys/socket.h> +#include <sys/select.h> #include <sys/un.h> #include <netinet/in.h> #include <netdb.h> ----------------------------------------------------------------------- hooks/post-receive -- CMU Common Lisp

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. 20f-55-g9829658
by Raymond Toy 25 Oct '14

25 Oct '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via 9829658f5c0ac762e7b939014a012dd2d558e73a (commit) via b16eb2050e77c6fba3eb438d7a2317aa64cee778 (commit) via 3c56ee77a02d7379a1de77a8919375debfe856d3 (commit) from 2dd94c9bc749b8cc13914ecc89e1ed1e91893695 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 9829658f5c0ac762e7b939014a012dd2d558e73a Merge: 2dd94c9 b16eb20 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Oct 25 10:50:05 2014 -0700 Fix motifd text callback. Merge fix from Richard Kreuter's clm-text-callback branch. This fixes an issue where text callbacks get nil. The test case is clm-young::numeric from Richard Kreuter. Without this patch, running (clm-young::numeric) and entering digits and characters causes errors[1]. With this patch, digits can be entered, and non-digits are correctly rejected. [1] On linux. For whatever reason, this works on darwin/x86 even without this patch. ----------------------------------------------------------------------- Summary of changes: src/motif/lisp/callbacks.lisp | 2 +- src/motif/server/callbacks.c | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch rtoy-clm-text-callback created. 20f-55-g6c4a967
by Raymond Toy 25 Oct '14

25 Oct '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, rtoy-clm-text-callback has been created at 6c4a96760e4fcd9a03c3a2ae2d4d41369d9caf39 (commit) - Log ----------------------------------------------------------------- commit 6c4a96760e4fcd9a03c3a2ae2d4d41369d9caf39 Merge: 2dd94c9 b16eb20 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Oct 25 10:50:05 2014 -0700 Merge branch 'clm-text-callback' of /Volumes/share2/src/clnet/rkreuter/cmucl into rtoy-clm-text-callback commit b16eb2050e77c6fba3eb438d7a2317aa64cee778 Author: Richard M Kreuter <kreuter(a)progn.net> Date: Wed Sep 17 20:41:06 2014 -0400 Remove some printf debugging in write_text_callback. diff --git a/src/motif/server/callbacks.c b/src/motif/server/callbacks.c index 832b019..d6ded37 100644 --- a/src/motif/server/callbacks.c +++ b/src/motif/server/callbacks.c @@ -207,8 +207,6 @@ void write_text_callback(message_t reply,XmTextVerifyCallbackStruct *info) message_write_int(reply,info->endPos,int_tag); } else if( info->reason == XmCR_MODIFYING_TEXT_VALUE ) { - printf("modifying_text_value: %s ; length=%d\n",info->text->ptr, - info->text->length); message_write_int(reply,info->startPos,int_tag); message_write_int(reply,info->endPos,int_tag); if (info->text->ptr==NULL) @@ -217,9 +215,6 @@ void write_text_callback(message_t reply,XmTextVerifyCallbackStruct *info) really_write_string(reply,info->text->ptr,info->text->length+1); /* ***** Perhaps this should be an enumerated type ***** */ message_write_int(reply,info->text->format,int_tag); - // printf("modifying_text_value: %s ; length=%d\n",info->text->ptr, - // info->text->length); - fflush(stdout); } } } commit 3c56ee77a02d7379a1de77a8919375debfe856d3 Author: Richard M Kreuter <kreuter(a)progn.net> Date: Wed Sep 17 20:36:01 2014 -0400 Fix bugs around XmTextField's callbacks. * On the motifd side, writing callbacks with reason XmCR_MODIFYING_TEXT_VALUE would segfault when the text was NULL (e.g., due to backspacing). * On the Lisp side, decoding of callbacks in READ-CALLBACK-INFO used the :TEXT for the widget-type, when the correct type is :TEXT-FIELD. diff --git a/src/motif/lisp/callbacks.lisp b/src/motif/lisp/callbacks.lisp index fe7c975..688a9c5 100644 --- a/src/motif/lisp/callbacks.lisp +++ b/src/motif/lisp/callbacks.lisp @@ -326,7 +326,7 @@ (setf (list-callback-selection-type info) (toolkit-read-value reply))) info)) - (:text + (:text-field (let ((info (make-text-callback reason event))) (when (member reason '(:cr-losing-focus :cr-modifying-text-value :cr-moving-insert-cursor)) diff --git a/src/motif/server/callbacks.c b/src/motif/server/callbacks.c index d0852c4..832b019 100644 --- a/src/motif/server/callbacks.c +++ b/src/motif/server/callbacks.c @@ -207,13 +207,18 @@ void write_text_callback(message_t reply,XmTextVerifyCallbackStruct *info) message_write_int(reply,info->endPos,int_tag); } else if( info->reason == XmCR_MODIFYING_TEXT_VALUE ) { + printf("modifying_text_value: %s ; length=%d\n",info->text->ptr, + info->text->length); message_write_int(reply,info->startPos,int_tag); message_write_int(reply,info->endPos,int_tag); - really_write_string(reply,info->text->ptr,info->text->length+1); + if (info->text->ptr==NULL) + really_write_string(reply,"",1); + else + really_write_string(reply,info->text->ptr,info->text->length+1); /* ***** Perhaps this should be an enumerated type ***** */ message_write_int(reply,info->text->format,int_tag); - printf("modifying_text_value: %s ; length=%d\n",info->text->ptr, - info->text->length); + // printf("modifying_text_value: %s ; length=%d\n",info->text->ptr, + // info->text->length); fflush(stdout); } } ----------------------------------------------------------------------- hooks/post-receive -- CMU Common Lisp

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. 20f-52-g2dd94c9
by Raymond Toy 25 Oct '14

25 Oct '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via 2dd94c9bc749b8cc13914ecc89e1ed1e91893695 (commit) via c18c16cd61de3f931c954cd735d68b95fde715b5 (commit) via 27a7c149e77fb549bd59c87024d01df65cf37806 (commit) via 93d7f94f9004fbb054a291211391c538a8439c6e (commit) from 1daac74f63836c9eeb98e53e77d69180698eef5e (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 2dd94c9bc749b8cc13914ecc89e1ed1e91893695 Merge: 1daac74 c18c16c Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Wed Oct 22 19:09:38 2014 -0700 Fix #84: motifd is 64-bit app. Merge Richard Kreuter's clm-oids branch to master. This allows motifd to work even if motifd is a 64-bit app. From Richard: ...the server passes out 32-bits of a pointer as external IDs for instances of a handful of types [1]. On a 64-bit machine, the instances' addresses might not fit in a 32-bit address, though. (In fact, on my FreeBSD/amd64 machine, when I run the example from the documentation, the first shell widget always gets created at create the second widget with the shell as parent crashes the server.) Seems like there are two options: A. Change the wire protocol to accomodate 64-bit integers. B. Synthesize 32-bit identifiers for instances of the offending types. Option B seems simpler.... [It] suffices to run the example in the doc and the programs in INTERFACE.... Obvious problems in the current code: 1. It's a doubly linked alist associating pointers with 32-bit integers. 2. It looks like nothing ever gets removed from the alist.... 3. I'm not certain that I've caught all the places where motifd hands out pointers to Lisp. [1] I think the complete list is AcceleratorTable, Atom, FontList, TranslationTable, Widget, and sometimes XmString. ----------------------------------------------------------------------- Summary of changes: src/motif/lisp/conversion.lisp | 10 +++- src/motif/server/Config.Darwin | 2 +- src/motif/server/GNUmakefile | 2 +- src/motif/server/callbacks.c | 3 +- src/motif/server/datatrans.c | 58 +++++++++++++------- src/motif/server/datatrans.h | 4 +- src/motif/server/events.c | 3 +- src/motif/server/oid.c | 117 ++++++++++++++++++++++++++++++++++++++++ src/motif/server/oid.h | 6 +++ src/motif/server/requests.c | 9 ++-- src/motif/server/tables.c | 3 ++ src/motif/server/xmstring.c | 4 +- 12 files changed, 190 insertions(+), 31 deletions(-) create mode 100644 src/motif/server/oid.c create mode 100644 src/motif/server/oid.h hooks/post-receive -- CMU Common Lisp

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch rtoy-clm-oids created. 20f-52-g999def9
by Raymond Toy 25 Oct '14

25 Oct '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, rtoy-clm-oids has been created at 999def9f312bf1fec74d5cc37eb9bf655c7003a1 (commit) - Log ----------------------------------------------------------------- commit 999def9f312bf1fec74d5cc37eb9bf655c7003a1 Merge: 1daac74 c18c16c Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Wed Oct 22 19:09:38 2014 -0700 Merge branch 'clm-oids' of /Volumes/share2/src/clnet/rkreuter/cmucl into clm-oids commit c18c16cd61de3f931c954cd735d68b95fde715b5 Author: Richard M Kreuter <kreuter(a)progn.net> Date: Mon Oct 13 19:37:53 2014 -0400 Rename "oblist.*" to "oid.*" (since the data structure is incidental). diff --git a/src/motif/server/GNUmakefile b/src/motif/server/GNUmakefile index 32915de..7acc58b 100644 --- a/src/motif/server/GNUmakefile +++ b/src/motif/server/GNUmakefile @@ -5,7 +5,7 @@ LDFLAGS = TARGET = motifd OBJS = main.o server.o translations.o packet.o message.o datatrans.o \ requests.o callbacks.o widgets.o resources.o tables.o motif.o \ - text.o xmstring.o list.o events.o oblist.o + text.o xmstring.o list.o events.o oid.o include Config diff --git a/src/motif/server/datatrans.c b/src/motif/server/datatrans.c index 197a71c..e9f960e 100644 --- a/src/motif/server/datatrans.c +++ b/src/motif/server/datatrans.c @@ -21,7 +21,7 @@ #include "types.h" #include "datatrans.h" #include "tables.h" -#include "oblist.h" +#include "oid.h" void message_write_oid(message_t,void *,int); void message_read_oid(message_t,caddr_t*,int,int); diff --git a/src/motif/server/oblist.c b/src/motif/server/oid.c similarity index 99% rename from src/motif/server/oblist.c rename to src/motif/server/oid.c index ddd1f3e..97d1a5b 100644 --- a/src/motif/server/oblist.c +++ b/src/motif/server/oid.c @@ -2,7 +2,7 @@ #include <X11/Intrinsic.h> #include "global.h" -#include "oblist.h" +#include "oid.h" /* OID generation. */ static unsigned int current_oid; diff --git a/src/motif/server/oblist.h b/src/motif/server/oid.h similarity index 100% rename from src/motif/server/oblist.h rename to src/motif/server/oid.h diff --git a/src/motif/server/requests.c b/src/motif/server/requests.c index 2694f02..b6ddd36 100644 --- a/src/motif/server/requests.c +++ b/src/motif/server/requests.c @@ -21,7 +21,7 @@ #include "types.h" #include "functions.h" #include "tables.h" -#include "oblist.h" +#include "oid.h" typedef void (*request_f)(message_t); Boolean must_confirm = False; diff --git a/src/motif/server/tables.c b/src/motif/server/tables.c index 1fa5dc7..2168989 100644 --- a/src/motif/server/tables.c +++ b/src/motif/server/tables.c @@ -20,7 +20,7 @@ #include "global.h" #include "datatrans.h" #include "tables.h" -#include "oblist.h" +#include "oid.h" extern WidgetClass overrideShellWidgetClass,transientShellWidgetClass, topLevelShellWidgetClass,applicationShellWidgetClass; diff --git a/src/motif/server/xmstring.c b/src/motif/server/xmstring.c index 93133fe..8202826 100644 --- a/src/motif/server/xmstring.c +++ b/src/motif/server/xmstring.c @@ -18,7 +18,7 @@ #include "types.h" #include "tables.h" #include "requests.h" -#include "oblist.h" +#include "oid.h" /* Functions for building XmFontLists */ commit 27a7c149e77fb549bd59c87024d01df65cf37806 Author: Richard M Kreuter <kreuter(a)progn.net> Date: Wed Sep 17 20:15:01 2014 -0400 XEvents need to be trafficked as oids, too. * There might only be one place where Lisp needs to indicate an XEvent back to motifd, in XmMenuPosition, but raw pointers won't cut it. diff --git a/src/motif/lisp/conversion.lisp b/src/motif/lisp/conversion.lisp index 144391f..8bfbe49 100644 --- a/src/motif/lisp/conversion.lisp +++ b/src/motif/lisp/conversion.lisp @@ -66,10 +66,16 @@ (message-write-string message value))) (xlib:font (message-write-xid message (xlib:font-id value) :font)) (xlib:cursor (message-write-xid message (xlib:cursor-id value) :cursor)) + ;; Wart: events are written back to motifd through here as integers. ((unsigned-byte 24) - (message-put-dblword message (combine-type-and-data :short value))) + (if (eql type :event) + (progn + (message-put-dblword message (combine-type-and-data :event 0)) + (message-put-dblword message value)) + (message-put-dblword message (combine-type-and-data :short value)))) ((or (signed-byte 32) (unsigned-byte 32)) - (message-put-dblword message (combine-type-and-data :int 0)) + (message-put-dblword + message (combine-type-and-data (if (eql type :event) :event :int) 0)) (message-put-dblword message value)) ((member t nil) (if (eq type t) diff --git a/src/motif/server/callbacks.c b/src/motif/server/callbacks.c index d0852c4..671acf4 100644 --- a/src/motif/server/callbacks.c +++ b/src/motif/server/callbacks.c @@ -51,6 +51,7 @@ #include "datatrans.h" #include "types.h" #include "tables.h" +#include "oid.h" int end_callback_loop = 0; extern message_t prepare_reply(message_t m); @@ -273,7 +274,7 @@ void CallbackHandler(Widget *w, int name_token, XmAnyCallbackStruct *info) /* Now, we write the Reason structure into the message */ message_write_enum(reply,info?info->reason:0,callback_reason_tag); - message_write_int(reply,info?info->event:0,int_tag); + message_write_int(reply,info?intern_object(info->event):0,int_tag); if( class==xmArrowButtonWidgetClass || class==xmArrowButtonGadgetClass || class==xmPushButtonWidgetClass || class==xmPushButtonGadgetClass ) diff --git a/src/motif/server/datatrans.c b/src/motif/server/datatrans.c index 5445aaf..197a71c 100644 --- a/src/motif/server/datatrans.c +++ b/src/motif/server/datatrans.c @@ -253,6 +253,11 @@ void message_write_xm_string_table(message_t m,StringTable *items,int tag) message_write_xm_string(m,(XmString)items->data[i],xm_string_tag); } +void message_write_event(message_t m,XEvent *event,int tag) +{ + message_write_oid(m,event,tag); +} + void message_write_color(message_t m,XColor *color,int tag) { message_put_dblword(m,combine_type_and_data(tag,color->red)); @@ -504,6 +509,12 @@ void message_read_xm_string_table(message_t m,StringTable *items, toolkit_read_value(m,&(items->data[i]),XmRXmString); } +void message_read_event(message_t message,XEvent *event,int tag,int data) +{ + message_read_oid(message,(void*)event,tag,data); +} + + void message_read_color(message_t m,XColor *color,int tag, int red) { color->red = red; diff --git a/src/motif/server/datatrans.h b/src/motif/server/datatrans.h index 5894621..7411a17 100644 --- a/src/motif/server/datatrans.h +++ b/src/motif/server/datatrans.h @@ -35,7 +35,7 @@ extern void message_write_font_list(); extern void message_write_string_table(); extern void message_write_xm_string_table(); extern void message_write_int_list(); -#define message_write_event message_write_int +extern void message_write_event(); extern void message_write_color(); /* GCC complains without the full prototype */ extern void message_write_float(message_t,float,int); @@ -63,7 +63,7 @@ extern void message_read_font_list(); extern void message_read_string_table(); extern void message_read_xm_string_table(); extern void message_read_int_list(); -#define message_read_event message_read_int +extern void message_read_event(); extern void message_read_color(); extern void message_read_float(); diff --git a/src/motif/server/events.c b/src/motif/server/events.c index ea5307a..4e2c459 100644 --- a/src/motif/server/events.c +++ b/src/motif/server/events.c @@ -23,8 +23,7 @@ extern int end_callback_loop; void write_any_event(message_t reply,XEvent *event) { - message_put_dblword(reply,combine_type_and_data(event_tag,0)); - message_put_dblword(reply,(unsigned long)event); + message_write_event(reply,event,event_tag); message_put_dblword(reply,event->xany.type); message_put_dblword(reply,event->xany.serial); message_put_dblword(reply,event->xany.send_event); commit 93d7f94f9004fbb054a291211391c538a8439c6e Author: Richard M Kreuter <kreuter(a)progn.net> Date: Wed Sep 17 19:04:41 2014 -0400 Add an "oid" layer to motifd. * The wire protocol between motifd and Lisp employs 32-bit handles for various types; on 32-bit systems, the pointer address has been used, but that's lossy on 64-bit systems. This changeset introduces a 32-bit handle called an "oid", and keeps a process-global doubly-linked list associating oids with pointers. diff --git a/src/motif/server/Config.Darwin b/src/motif/server/Config.Darwin index e24be15..dcc463c 100644 --- a/src/motif/server/Config.Darwin +++ b/src/motif/server/Config.Darwin @@ -1,6 +1,6 @@ CFLAGS = -g -O2 -I/opt/local/include -I/sw/include -I/usr/local/include -I/usr/X11R6/include -I. -I$(VPATH) LDFLAGS = -L/opt/local/lib -L/usr/X11R6/lib -L/sw/lib -L/usr/local/lib -LIBS = -lXm -lXt -lXext -lX11 -lSM -lICE +LIBS = -lXft -lXm -lXt -lXext -lX11 -lSM -lICE #LIBS = -lXm -lXt -lXext -lX11 -lSM -lICE -llanginfo # This def assumes you are building in the same or parallel # tree to the CVS souce layout. Sites may need to customize diff --git a/src/motif/server/GNUmakefile b/src/motif/server/GNUmakefile index 62eccb1..32915de 100644 --- a/src/motif/server/GNUmakefile +++ b/src/motif/server/GNUmakefile @@ -5,7 +5,7 @@ LDFLAGS = TARGET = motifd OBJS = main.o server.o translations.o packet.o message.o datatrans.o \ requests.o callbacks.o widgets.o resources.o tables.o motif.o \ - text.o xmstring.o list.o events.o + text.o xmstring.o list.o events.o oblist.o include Config diff --git a/src/motif/server/datatrans.c b/src/motif/server/datatrans.c index e36711a..5445aaf 100644 --- a/src/motif/server/datatrans.c +++ b/src/motif/server/datatrans.c @@ -21,6 +21,10 @@ #include "types.h" #include "datatrans.h" #include "tables.h" +#include "oblist.h" + +void message_write_oid(message_t,void *,int); +void message_read_oid(message_t,caddr_t*,int,int); void packet_write_string(packet_t packet,String string,int count) { @@ -93,8 +97,7 @@ void message_write_function(message_t message, int value,int type_tag) void message_write_widget(message_t message,Widget widget,int type_tag) { - message_put_dblword(message,combine_type_and_data(type_tag,0)); - message_put_dblword(message,(long)widget); + message_write_oid(message,widget,type_tag); } void message_write_widget_class(message_t message,WidgetClass class,int tag) @@ -117,10 +120,16 @@ void message_write_xid(message_t message,XID value,int tag) message_put_dblword(message,value); } -void message_write_atom(message_t message,Atom value,int tag) +void message_write_oid(message_t message,void *value,int tag) { + int oid = intern_object(value); message_put_dblword(message,combine_type_and_data(tag,0)); - message_put_dblword(message,value); + message_put_dblword(message,oid); +} + +void message_write_atom(message_t message,Atom value,int tag) +{ + message_write_oid(message,(void*)value,tag); } void message_write_enum(message_t message,int enumval,int tag) @@ -208,26 +217,22 @@ void message_write_resource_names(message_t message,ResourceList *list,int tag) void message_write_xm_string(message_t message,XmString xs,int tag) { - message_put_dblword(message,combine_type_and_data(tag,0)); - message_put_dblword(message,(long)xs); + message_write_oid(message,xs,tag); } void message_write_translation_table(message_t m,XtTranslations t,int tag) { - message_put_dblword(m,combine_type_and_data(tag,0)); - message_put_dblword(m,(unsigned long)t); + message_write_oid(m,t,tag); } void message_write_accelerator_table(message_t m,XtAccelerators a,int tag) { - message_put_dblword(m,combine_type_and_data(tag,0)); - message_put_dblword(m,(unsigned long)a); + message_write_oid(m,a,tag); } void message_write_font_list(message_t m,XmFontList flist,int tag) { - message_put_dblword(m,combine_type_and_data(tag,0)); - message_put_dblword(m,(unsigned long)flist); + message_write_oid(m,flist,tag); } void message_write_string_table(message_t m,StringTable *items,int tag) @@ -265,7 +270,7 @@ void message_write_float(message_t m,float f,int tag) void message_read_widget(message_t message,Widget *w,int tag,int data) { - *w = (Widget)message_get_dblword(message); + message_read_oid(message,(void*)w,tag,data); } void message_read_widget_class(message_t message,WidgetClass *c, @@ -340,7 +345,7 @@ void message_read_xm_string(message_t message,XmString *xs,int tag,int data) register_garbage(xmstring,GarbageXmString); } else - *xs = (XmString)message_get_dblword(message); + message_read_oid(message,(void*)xs,tag,data); } /* used to be int *val here, but many places pass address of Boolean into @@ -371,9 +376,15 @@ void message_read_xid(message_t message,XID *id,int tag,int data) *id = message_get_dblword(message); } +void message_read_oid(message_t message,caddr_t *obj,int tag,int data) +{ + int oid = message_get_dblword(message); + *obj = find_object(oid); +} + void message_read_atom(message_t message,Atom *a,int tag,int data) { - *a = message_get_dblword(message); + message_read_oid(message,(void*)a,tag,data); } void message_read_enum(message_t message,int *enumval,int tag,int data) @@ -456,18 +467,18 @@ void message_read_int_list(message_t message,IntList *list,int tag,int length) void message_read_translation_table(message_t m,XtTranslations *t, int tag,int data) { - *t = (XtTranslations)message_get_dblword(m); + message_read_oid(m,(void*)t,tag,data); } void message_read_accelerator_table(message_t m,XtAccelerators *a, int tag,int data) { - *a = (XtAccelerators)message_get_dblword(m); + message_read_oid(m,(void*)a,tag,data); } void message_read_font_list(message_t m,XmFontList *flist,int tag,int data) { - *flist = (XmFontList)message_get_dblword(m); + message_read_oid(m,(void*)flist,tag,data); } void message_read_string_table(message_t m,StringTable *items,int tag,int len) diff --git a/src/motif/server/oblist.c b/src/motif/server/oblist.c new file mode 100644 index 0000000..ddd1f3e --- /dev/null +++ b/src/motif/server/oblist.c @@ -0,0 +1,117 @@ +#include <stdio.h> +#include <X11/Intrinsic.h> + +#include "global.h" +#include "oblist.h" + +/* OID generation. */ +static unsigned int current_oid; + +static void init_oids() +{ + current_oid = (unsigned int)0; +} + +static unsigned int next_oid() +{ + if (current_oid == 0xffffffff) + fatal_error("next_oid: ran out of oids"); /* This should be smarter.*/ + return (++current_oid); +} + +/* For expediency of implementation, the table of pointer-to-OID + associations will be a doubly-linked list. */ +typedef struct oblist oblist_t; + +struct oblist { + oblist_t *next; + oblist_t *prev; + void *obj; + int oid; +}; + +static oblist_t *oblist = NULL; + +static oblist_t *find_node_if(int(*fn)(oblist_t*,void*), void *datum) +{ + oblist_t *ret = NULL; + oblist_t *node = oblist; + while (node != NULL) { + if (fn(node, datum)==1) { + ret = node; + break; + } + node = node->next; + } + return ret; +} + +static int obj_eql(oblist_t *node, void *obj) { + return (node->obj == obj); +} + +static int id_eql(oblist_t *node, void *oidp) { + return (node->oid == *(int*)oidp); +} + +void *find_object(unsigned int oid) +{ + oblist_t *node = find_node_if(&id_eql, &oid); + if (node != NULL) + return node->obj; + else + return NULL; +} + +unsigned int intern_object(void *obj) +{ + oblist_t *node = find_node_if(&obj_eql, obj); + + if (node != NULL) + return node->oid; + + if (oblist == NULL) + init_oids(); + + if ((node = (void*)XtCalloc(1, sizeof(oblist_t))) == NULL) + fatal_error("intern_object: out of memory"); + + node->next = oblist; + node->prev = NULL; + if (node->next) node->next->prev = node; + node->obj = obj; + node->oid = next_oid(); + oblist = node; + return node->oid; +} + +static int unintern_if(int(*fn)(oblist_t*,void*), void *datum) +{ + oblist_t *node; + + node = find_node_if(fn,datum); + if (node == NULL) + return 0; + + if (node == oblist) oblist = node->next; + if (node->prev) (node->prev)->next = node->next; + if (node->next) (node->next)->prev = node->prev; + + XtFree((char*)node); + return 1; +} + + +void unintern_object(void * obj) +{ + if (unintern_if(&obj_eql, obj)==0) { + if( global_will_trace ) { + printf("unintern_object: couldn't unintern %p\n",obj); + fflush(stdout);} + } +} + +void maybe_unintern_object(void * obj) +{ + unintern_if(&obj_eql, obj); +} diff --git a/src/motif/server/oblist.h b/src/motif/server/oblist.h new file mode 100644 index 0000000..7c6b16e --- /dev/null +++ b/src/motif/server/oblist.h @@ -0,0 +1,6 @@ +extern unsigned int intern_object(void *); +extern void *find_object(unsigned int); +extern void unintern_object(void *); +extern void unintern_object(void *); +extern void maybe_unintern_object(void *); + diff --git a/src/motif/server/requests.c b/src/motif/server/requests.c index f8aa1fa..2694f02 100644 --- a/src/motif/server/requests.c +++ b/src/motif/server/requests.c @@ -21,6 +21,7 @@ #include "types.h" #include "functions.h" #include "tables.h" +#include "oblist.h" typedef void (*request_f)(message_t); Boolean must_confirm = False; @@ -60,11 +61,13 @@ void cleanup_garbage() garbage_list = NULL; while( current ) { - if( current->kind == GarbageXmString ) + if( current->kind == GarbageXmString ) { + maybe_unintern_object(current->junk); XmStringFree( (XmString)current->junk ); - else + } else { + maybe_unintern_object(current->junk); XtFree( current->junk ); - + } doomed = current; current = current->next; XtFree( (char *)doomed ); diff --git a/src/motif/server/tables.c b/src/motif/server/tables.c index 8220ef5..1fa5dc7 100644 --- a/src/motif/server/tables.c +++ b/src/motif/server/tables.c @@ -20,6 +20,7 @@ #include "global.h" #include "datatrans.h" #include "tables.h" +#include "oblist.h" extern WidgetClass overrideShellWidgetClass,transientShellWidgetClass, topLevelShellWidgetClass,applicationShellWidgetClass; @@ -190,7 +191,9 @@ void record_class_resources(WidgetClass class,class_resources *r) r->resource_count = resource_count; r->constraint_count = constraint_count; + maybe_unintern_object(resource_list); XtFree( (char *)resource_list ); + maybe_unintern_object(resource_list); XtFree( (char *)constraint_list ); } diff --git a/src/motif/server/xmstring.c b/src/motif/server/xmstring.c index a0eb697..93133fe 100644 --- a/src/motif/server/xmstring.c +++ b/src/motif/server/xmstring.c @@ -18,7 +18,7 @@ #include "types.h" #include "tables.h" #include "requests.h" - +#include "oblist.h" /* Functions for building XmFontLists */ @@ -61,6 +61,7 @@ void RXmFontListFree(message_t message) XmFontList flist; toolkit_read_value(message,&flist,XmRFontList); + unintern_object(flist); XmFontListFree(flist); } @@ -189,6 +190,7 @@ void RXmStringFree(message_t message) XmString s; toolkit_read_value(message,&s,XmRXmString); + unintern_object(s); XmStringFree(s); } ----------------------------------------------------------------------- hooks/post-receive -- CMU Common Lisp

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. 20f-48-g1daac74
by Raymond Toy 19 Oct '14

19 Oct '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via 1daac74f63836c9eeb98e53e77d69180698eef5e (commit) via 57bf81f9292bccdda0ca1d9821d71a2f4de52518 (commit) via 2307b3f7b59e431ae030f676a766601915205e74 (commit) from b6f5f1f52966abc0677ef7e506c5125cfea066d4 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 1daac74f63836c9eeb98e53e77d69180698eef5e Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sun Oct 19 11:08:06 2014 -0700 Clarify a few things. * Change check for id to be 1 <= id <= 3, and print error message if it's not true. * Add comment that we're "intentionally" writing past the end of segname because we're trying to fill out the rest of the segment_command. * Fix typo in sentence. diff --git a/src/lisp/mach-o.c b/src/lisp/mach-o.c index b7ab848..f649568 100644 --- a/src/lisp/mach-o.c +++ b/src/lisp/mach-o.c @@ -259,7 +259,7 @@ write_space_object(const char *dir, int id, os_vm_address_t start, os_vm_address ((end - start) % os_vm_page_size)); static char *names[] = { "Dynamic", "Static", "Read-Only" }; - if(id < 1 || id > 3) { + if (!(1 <= id) && (id <= 3)) { fprintf(stderr, "Invalid space id in %s: %d\n", __func__, id); fprintf(stderr, "Executable not built.\n"); ret = -1; @@ -425,6 +425,14 @@ map_core_sections(const char *exec_name) fprintf(stderr, "Reading next %ld bytes for SEGMENT\n", sizeof(sc) - sizeof(lc)); #endif + /* + * This will read in the rest of the slots of a + * segment_command, starting from segname. The initial + * slots of the segment_command were read above for the + * load_command. Alternatively, we could read in each slot + * individually, but that's error prone, especially if a + * new slot is ever added. + */ eread(exec_fd, &sc.segname, sizeof(sc) - sizeof(lc), __func__); #ifdef DEBUG_MACH_O @@ -445,7 +453,7 @@ map_core_sections(const char *exec_name) #endif /* * We don't care what address the segment has. We - * will map it where want it to go. + * will map it where it wants to go. */ addr = section_addr[j]; commit 57bf81f9292bccdda0ca1d9821d71a2f4de52518 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sun Oct 19 11:04:23 2014 -0700 Don't leak the string created by strdup. Probably harmless if we do since we exit(0) at the end. diff --git a/src/lisp/save.c b/src/lisp/save.c index 27b03ea..795fac9 100644 --- a/src/lisp/save.c +++ b/src/lisp/save.c @@ -249,7 +249,8 @@ boolean save_executable(char *filename, lispobj init_function) { char *dir_name; - + char *dir_copy; + #if defined WANT_CGC volatile lispobj *func_ptr = &init_function; char sbuf[128]; @@ -271,7 +272,8 @@ save_executable(char *filename, lispobj init_function) if(SymbolValue(X86_CGC_ACTIVE_P) != NIL) SetSymbolValue(ALLOCATION_POINTER, DYNAMIC_0_SPACE_START); #endif - dir_name = dirname(strdup(filename)); + dir_copy = strdup(filename); + dir_name = dirname(dir_copy); printf("[Undoing binding stack... "); fflush(stdout); @@ -357,6 +359,7 @@ save_executable(char *filename, lispobj init_function) fflush(stdout); obj_run_linker(init_function, filename); printf("done.\n"); + free(dir_copy); exit(0); } #endif commit 2307b3f7b59e431ae030f676a766601915205e74 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sun Oct 19 11:03:04 2014 -0700 Close the file descriptor when done. diff --git a/src/lisp/coreparse.c b/src/lisp/coreparse.c index d9b5006..efa53c2 100644 --- a/src/lisp/coreparse.c +++ b/src/lisp/coreparse.c @@ -178,5 +178,7 @@ load_core_file(const char *file, fpu_mode_t* fpu_type) ptr += len - 2; } + close(fd); + return initial_function; } ----------------------------------------------------------------------- Summary of changes: src/lisp/coreparse.c | 2 ++ src/lisp/mach-o.c | 12 ++++++++++-- src/lisp/save.c | 7 +++++-- 3 files changed, 17 insertions(+), 4 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. 20f-45-gb6f5f1f
by Raymond Toy 16 Oct '14

16 Oct '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via b6f5f1f52966abc0677ef7e506c5125cfea066d4 (commit) from c65697e51b4cd61fc0a760273f4c2ecbcc95ff6a (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit b6f5f1f52966abc0677ef7e506c5125cfea066d4 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Wed Oct 15 19:27:08 2014 -0700 Fix compiler warning on ppc about &context->uc_mcontext->__es.__dar and __dsisr. __dar and __dsisr are declared to be type unsigned long, but on a 32-bit system unsigned int and unsigned long are the same. diff --git a/src/lisp/Darwin-os.c b/src/lisp/Darwin-os.c index 49e660c..e1120ab 100644 --- a/src/lisp/Darwin-os.c +++ b/src/lisp/Darwin-os.c @@ -238,9 +238,9 @@ sc_reg(os_context_t * context, int offset) case 35: return &state->__ctr; case 41: - return &context->uc_mcontext->__es.__dar; + return (unsigned int *) &context->uc_mcontext->__es.__dar; case 42: - return &context->uc_mcontext->__es.__dsisr; + return (unsigned int *) &context->uc_mcontext->__es.__dsisr; } return (unsigned int *) 0; ----------------------------------------------------------------------- Summary of changes: src/lisp/Darwin-os.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. 20f-44-gc65697e
by Raymond Toy 16 Oct '14

16 Oct '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via c65697e51b4cd61fc0a760273f4c2ecbcc95ff6a (commit) from bcb27939465ea192186d20aa8801db722dcb1bf4 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit c65697e51b4cd61fc0a760273f4c2ecbcc95ff6a Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Wed Oct 15 19:22:13 2014 -0700 Remove OS_LINK_FLAGS that were creating a CMUCLRO section. They were commented out in 2004/10 so it's way past time to remove them. diff --git a/src/lisp/Config.ppc_darwin b/src/lisp/Config.ppc_darwin index f9d64ef..803970d 100644 --- a/src/lisp/Config.ppc_darwin +++ b/src/lisp/Config.ppc_darwin @@ -47,13 +47,6 @@ OS_SRC += mach-o.c EXEC_FINAL_OBJ = exec-final.o endif -# I (rtoy) am not exactly sure what these values are, but it seems -# that the segaddr for CMUCLRO should be the READ_ONLY_SPACE_START. -# The seg1addr should be somewhere above our spaces. This is where -# the C runtime code goes, I think. -# -# OS_LINK_FLAGS = -g -dynamic -Wl,-sectcreate,CMUCLRO,core,/dev/null -Wl,-segaddr,CMUCLRO,0x01000000 -Wl,-seg1addr,0x1a000000 - # gcc 4.8, (used on zombie) needs -static-libgcc so that the gcc # library is staticly linked into lisp so that the user doesn't need a # matching version of libgcc. ----------------------------------------------------------------------- Summary of changes: src/lisp/Config.ppc_darwin | 7 ------- 1 file changed, 7 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. 20f-43-gbcb2793
by Raymond Toy 16 Oct '14

16 Oct '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via bcb27939465ea192186d20aa8801db722dcb1bf4 (commit) from b0cf84b5e4fa58f9a50c02e5163fea354829d132 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit bcb27939465ea192186d20aa8801db722dcb1bf4 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Wed Oct 15 19:19:37 2014 -0700 Remove darwin-lispadjuster.c and ppc-darwin-dlshim.c Use of ppc-darwin-dlshim.c was removed, but I forgot to remove the file. Use of darwin-lispadjuster.c has been commented out for a while, so I'm getting rid of it. It seems at one point it was needed to resize the CMUCLRO section in the lisp executable, but there is CMUCLRO section anymore. darwin-lispadjuster.c: * Deleted ppc-darwin-dlshim.c: Config.ppc_darwin: * Remove Make rule for adjustlisp and friends. * Remove old commented out version of OS_SRC; we don't use ppc-darwin-dlshim.c anymore. diff --git a/src/lisp/Config.ppc_darwin b/src/lisp/Config.ppc_darwin index dffa756..f9d64ef 100644 --- a/src/lisp/Config.ppc_darwin +++ b/src/lisp/Config.ppc_darwin @@ -39,7 +39,6 @@ ASFLAGS = $(OSX_VERSION) -traditional -g -O3 -DDARWIN -Dppc $(LINKAGE) $(GENCGC) UNDEFSYMPATTERN = -Xlinker -u -Xlinker & ASSEM_SRC = ppc-assem.S linux-stubs.S ARCH_SRC = ppc-arch.c -#OS_SRC = ppc-darwin-dlshim.c os-common.c Darwin-os.c OS_SRC = os-common.c Darwin-os.c @@ -61,11 +60,3 @@ endif OS_LINK_FLAGS = $(OSX_VERSION) -static-libgcc OS_LIBS = -lSystem -lc -lm -#all: adjustlisp -#adjustlisp: lisp darwin-lispadjuster -# ./darwin-lispadjuster lisp -#adjustlisp: lisp darwin-lispadjuster -# true - -#darwin-lispadjuster: darwin-lispadjuster.c - diff --git a/src/lisp/darwin-lispadjuster.c b/src/lisp/darwin-lispadjuster.c deleted file mode 100644 index a18768a..0000000 --- a/src/lisp/darwin-lispadjuster.c +++ /dev/null @@ -1,87 +0,0 @@ -/* Modify the final lisp binary to enlarge the generated CMUCLRO segment */ -#include <stdlib.h> -#include <string.h> -#include <mach-o/loader.h> -#include <sys/types.h> -#include <sys/uio.h> -#include <unistd.h> -#include <fcntl.h> -#include <stdio.h> -#include "validate.h" - -#ifdef DEBUG -#define dprintf printf -#else -#define dprintf(...) -#endif - -int -main(int argc, char **argv) -{ - char *filename; - int fd; - int i, result; - off_t curpos; - struct mach_header theheader; - struct segment_command thesegment; - char segname[17]; - - if (argc != 2) - return 1; - filename = argv[1]; - - fd = open(filename, O_RDWR, 0755); - read(fd, &theheader, sizeof(theheader)); - - if ((theheader.magic != MH_MAGIC) || (theheader.filetype != MH_EXECUTE)) - return 2; - - dprintf("Reading %d commands:\n", theheader.ncmds); - - for (i = 0; i < theheader.ncmds; i++) { - curpos = lseek(fd, 0, SEEK_CUR); - dprintf("Reading command %d (%d bytes):\n", i, - - sizeof(struct load_command)); - read(fd, &thesegment, sizeof(struct load_command)); - - dprintf("Command is %d, length %d\n", thesegment.cmd, - thesegment.cmdsize); - if (thesegment.cmd != LC_SEGMENT) { - dprintf("Skipping remainder of command...\n"); - lseek(fd, thesegment.cmdsize - sizeof(struct load_command), - - SEEK_CUR); - continue; - } - - dprintf("Reading remainder of Segment command (%d bytes)", - sizeof(thesegment) - sizeof(struct load_command)); - read(fd, &thesegment.segname, - - sizeof(thesegment) - sizeof(struct load_command)); - memset(segname, 0, 17); - memcpy(segname, thesegment.segname, 16); - dprintf("Segname: %s\n", segname); - if (0 == strncmp(thesegment.segname, "CMUCLRO", 7)) { - dprintf("Frobbing the segment, setting vmsize from %8X to %8X\n", - thesegment.vmsize, READ_ONLY_SPACE_SIZE); - thesegment.vmsize = READ_ONLY_SPACE_SIZE; - dprintf("Skipping back to %lld.\n", curpos); - lseek(fd, curpos, SEEK_SET); - dprintf("Writing %d bytes.\n", sizeof(thesegment)); - result = write(fd, &thesegment, sizeof(thesegment)); - if (result == -1) - perror("Error:"); - close(fd); - return 0; - } else { - dprintf("Cmdsize = %d, Already read = %d, Now seeking %d\n", - thesegment.cmdsize, sizeof(thesegment), - thesegment.cmdsize - sizeof(thesegment)); - lseek(fd, thesegment.cmdsize - sizeof(thesegment), SEEK_CUR); - } - } - close(fd); - return 3; -} diff --git a/src/lisp/ppc-darwin-dlshim.c b/src/lisp/ppc-darwin-dlshim.c deleted file mode 100644 index e6865cd..0000000 --- a/src/lisp/ppc-darwin-dlshim.c +++ /dev/null @@ -1,236 +0,0 @@ -/* - * These functions emulate a small subset of the dlopen / dlsym - * functionality under Darwin's Mach-O dyld system. - * - * This file was graciously taken from the SBCL OS X/Darwin port, for - * which it was originally written by Brian Mastenbrook: - */ - -/* - * This software is part of the SBCL system. See the README file for - * more information. - * - * This software is derived from the CMU CL system, which was - * written at Carnegie Mellon University and released into the - * public domain. The software is in the public domain and is - * provided with absolutely no warranty. See the COPYING and CREDITS - * files for more information. - */ - - -#include <mach-o/dyld.h> -#include <stdio.h> -#include <stdlib.h> -#include <string.h> - -/* Darwin does not define the standard ELF - * dlopen/dlclose/dlsym/dlerror interface to shared libraries, so this - * is an attempt at a minimal wrapper to allow SBCL to work without - * external dependency on pogma's dlcompat library. - */ - -/* For now, there is no RTLD_GLOBAL emulation either. */ - -static char dl_self; /* I'm going to abuse this */ - -#define RTLD_LAZY 1 -#define RTLD_NOW 2 -#define RTLD_GLOBAL 0x100 - -static int callback_count; -static struct mach_header *last_header; - -void -dlshim_image_callback(struct mach_header *ptr, unsigned long phooey) -{ - callback_count++; - last_header = ptr; -} - -int -lib_path_count(void) -{ - char *libpath; - int i; - int count; - - libpath = getenv("DYLD_LIBRARY_PATH"); - count = 1; - if (libpath) { - for (i = 0; libpath[i] != '\0'; i++) { - if (libpath[i] == ':') - count++; - } - } - return count; -} - -const char * -lib_path_prefixify(int index, const char *filename) -{ - static char *retbuf = NULL; - int fi, li, i, count; - char *libpath; - - if (!retbuf) { - retbuf = (char *) malloc(1024 * sizeof(char)); - } - count = 0; - fi = 0; - li = -1; - libpath = getenv("DYLD_LIBRARY_PATH"); - if (libpath) { - i = 0; - while (count != index && libpath[i] != '\0') { - if (libpath[i] == ':') - count++; - i++; - } - fi = i; - while (libpath[i] != '\0' && libpath[i] != ':') { - i++; - } - li = i - 1; - } - if (li - fi > 0) { - if (li - fi + 1 > 1022 - strlen(filename)) { - retbuf = - (char *) realloc(retbuf, - - (li - fi + 3 + - strlen(filename)) * sizeof(char)); - } - memcpy(retbuf, libpath + fi, (li - fi + 1) * sizeof(char)); - - retbuf[li - fi + 1] = '/'; - memcpy(retbuf + li - fi + 2, filename, strlen(filename) + 1); - return retbuf; - } else { - return filename; - } -} - -void * -dlopen(const char *filename, int flags) -{ - static char has_callback = 0; - - if (!has_callback) { - _dyld_register_func_for_add_image(dlshim_image_callback); - } - if (!filename) { - return &dl_self; - } else { - struct mach_header *img = NULL; - - if (!img) - img = NSAddImage(filename, NSADDIMAGE_OPTION_RETURN_ON_ERROR); - if (!img) - img = - NSAddImage(filename, - NSADDIMAGE_OPTION_RETURN_ON_ERROR | - NSADDIMAGE_OPTION_WITH_SEARCHING); - if (!img) { - NSObjectFileImage fileImage; - - callback_count = 0; - last_header = NULL; - if (NSCreateObjectFileImageFromFile(filename, &fileImage) == - NSObjectFileImageSuccess) { - NSLinkModule(fileImage, filename, - NSLINKMODULE_OPTION_BINDNOW | - ((flags & RTLD_GLOBAL) ? - NSLINKMODULE_OPTION_PRIVATE : 0) | - NSLINKMODULE_OPTION_RETURN_ON_ERROR); - if (callback_count && last_header) - img = last_header; - } - } - if (!img) { - NSObjectFileImage fileImage; - int i, maxi; - char *prefixfilename; - - maxi = lib_path_count(); - for (i = 0; i < maxi && !img; i++) { - prefixfilename = lib_path_prefixify(i, filename); - callback_count = 0; - last_header = NULL; - if (NSCreateObjectFileImageFromFile(prefixfilename, &fileImage) - == NSObjectFileImageSuccess) { - NSLinkModule(fileImage, filename, - NSLINKMODULE_OPTION_BINDNOW | - ((flags & RTLD_GLOBAL) ? - NSLINKMODULE_OPTION_PRIVATE : 0) | - NSLINKMODULE_OPTION_RETURN_ON_ERROR); - if (callback_count && last_header) - img = last_header; - } - } - } - if (img) { - if (flags & RTLD_NOW) { - NSLookupSymbolInImage(img, "", - NSLOOKUPSYMBOLINIMAGE_OPTION_BIND_FULLY | - NSLOOKUPSYMBOLINIMAGE_OPTION_RETURN_ON_ERROR); - } - if (NSIsSymbolNameDefinedInImage(img, "__init")) { - NSSymbol *initsymbol; - void (*initfunc) (void); - - initsymbol = NSLookupSymbolInImage(img, "__init", 0); - initfunc = NSAddressOfSymbol(initsymbol); - initfunc(); - } - } - return img; - } -} - -const char * -dlerror(void) -{ - static char *errbuf = NULL; - NSLinkEditErrors a; - int b; - char *c, *d; - - NSLinkEditError(&a, &b, &c, &d); - if (!errbuf) { - errbuf = (char *) malloc(256 * sizeof(char)); - } - snprintf(errbuf, 255, "%s in %s: %d %d", c, d, a, b); - return errbuf; -} - -void * -dlsym(void *handle, char *symbol) -{ - if (handle == &dl_self) { - if (NSIsSymbolNameDefined(symbol)) { - NSSymbol *retsym; - - retsym = NSLookupAndBindSymbol(symbol); - return NSAddressOfSymbol(retsym); - } else { - return NULL; - } - } else { - if (NSIsSymbolNameDefinedInImage(handle, symbol)) { - NSSymbol *retsym; - - retsym = NSLookupSymbolInImage(handle, symbol, 0); - return NSAddressOfSymbol(retsym); - } else { - return NULL; - } - } -} - -int -dlclose(void *handle) -{ - /* dlclose is not implemented, and never will be for dylibs. - * return -1 to signal an error; it's not used by SBCL anyhow */ - return -1; -} ----------------------------------------------------------------------- Summary of changes: src/lisp/Config.ppc_darwin | 9 -- src/lisp/darwin-lispadjuster.c | 87 --------------- src/lisp/ppc-darwin-dlshim.c | 236 ---------------------------------------- 3 files changed, 332 deletions(-) delete mode 100644 src/lisp/darwin-lispadjuster.c delete mode 100644 src/lisp/ppc-darwin-dlshim.c hooks/post-receive -- CMU Common Lisp

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. 20f-42-gb0cf84b
by Raymond Toy 14 Oct '14

14 Oct '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via b0cf84b5e4fa58f9a50c02e5163fea354829d132 (commit) from 823d6baf4427f342652b014d2416dcdf7be7a21a (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit b0cf84b5e4fa58f9a50c02e5163fea354829d132 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Mon Oct 13 20:24:08 2014 -0700 Remove definition of LD. We don't use it and make has default value. diff --git a/src/lisp/Config.ppc_darwin b/src/lisp/Config.ppc_darwin index 871a261..dffa756 100644 --- a/src/lisp/Config.ppc_darwin +++ b/src/lisp/Config.ppc_darwin @@ -14,7 +14,6 @@ CPPFLAGS = -I. -I$(PATH1) # Build for OSX 10.4 or later. (Is this what we want?) OSX_VERSION=-mmacosx-version-min=10.4 CC = gcc -LD = ld NM = $(PATH1)/darwin-nm CPP = cpp DEPEND_FLAGS = -MM diff --git a/src/lisp/Config.x86_common b/src/lisp/Config.x86_common index f0de2ca..dc896ab 100644 --- a/src/lisp/Config.x86_common +++ b/src/lisp/Config.x86_common @@ -49,8 +49,6 @@ ifdef FEATURE_ELF CPP_DEFINE_OPTIONS += -DFEATURE_ELF endif -LD = ld - ifeq ($(filter 2% 3%, $(shell $(CC) -dumpversion)),) CPP_INCLUDE_OPTIONS := -iquote . -iquote $(PATH1) else ----------------------------------------------------------------------- Summary of changes: src/lisp/Config.ppc_darwin | 1 - src/lisp/Config.x86_common | 2 -- 2 files changed, 3 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. 20f-41-g823d6ba
by Raymond Toy 11 Oct '14

11 Oct '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via 823d6baf4427f342652b014d2416dcdf7be7a21a (commit) via 16023de6bde8a83571fb768fed2d7ef481618e72 (commit) from 7765a6f7f8391e45405298d454b6907d5b90683e (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 823d6baf4427f342652b014d2416dcdf7be7a21a Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Oct 11 15:08:58 2014 -0700 Update from commit logs. diff --git a/src/general-info/release-21a.txt b/src/general-info/release-21a.txt index d62509c..4b1e86c 100644 --- a/src/general-info/release-21a.txt +++ b/src/general-info/release-21a.txt @@ -23,10 +23,14 @@ New in this release: * Changes * Micro-optimize SCALE-FLOAT to do multiplication when possible. + * Update to ASDF 3.1.4. * ANSI compliance fixes: * Bugfixes: + * On ppc machines with clock speeds over 2 GHz or so, + LISP::CYCLES-PER-TICK is no longer negative. This caused the + cycle count from TIME to be negative. * Trac Tickets: commit 16023de6bde8a83571fb768fed2d7ef481618e72 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Oct 11 15:05:28 2014 -0700 Update to asdf 3.1.4. diff --git a/src/contrib/asdf/asdf.lisp b/src/contrib/asdf/asdf.lisp index 750a886..e478d90 100644 --- a/src/contrib/asdf/asdf.lisp +++ b/src/contrib/asdf/asdf.lisp @@ -1,5 +1,5 @@ ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; buffer-read-only: t; -*- -;;; This is ASDF 3.1.3: Another System Definition Facility. +;;; This is ASDF 3.1.4: Another System Definition Facility. ;;; ;;; Feedback, bug reports, and patches are all welcome: ;;; please mail to <asdf-devel(a)common-lisp.net>. @@ -151,7 +151,7 @@ or when loading the package is optional." (defun shadowing-import* (symbol package-designator) (shadowing-import (or symbol (list symbol)) (find-package* package-designator))) (defun shadow* (name package-designator) - (shadow (string name) (find-package* package-designator))) + (shadow (list (string name)) (find-package* package-designator))) (defun make-symbol* (name) (etypecase name (string (make-symbol name)) @@ -1485,7 +1485,7 @@ A symbol otherwise designates a class by name." (or (and found (or (eq super t) (#-cormanlisp subtypep #+cormanlisp cl::subclassp found super)) found) - (call-function error "Can't coerce ~S to a ~@[class~;subclass of ~:*~S]" class super))))) + (call-function error "Can't coerce ~S to a ~:[class~;subclass of ~:*~S~]" class super))))) ;;; Hash-tables @@ -1877,7 +1877,7 @@ suitable for use as a directory name to segregate Lisp FASLs, C dynamic librarie #+ecl (ext:getcwd) #+gcl (let ((*default-pathname-defaults* #p"")) (truename #p"")) #+genera *default-pathname-defaults* ;; on a Lisp OS, it *is* canonical! - #+lispworks (system:current-directory) + #+lispworks (hcl:get-working-directory) #+mkcl (mk-ext:getcwd) #+sbcl (sb-ext:parse-native-namestring (sb-unix:posix-getcwd/)) #+xcl (extensions:current-directory) @@ -1886,19 +1886,21 @@ suitable for use as a directory name to segregate Lisp FASLs, C dynamic librarie (defun chdir (x) "Change current directory, as per POSIX chdir(2), to a given pathname object" (if-let (x (pathname x)) - (or #+abcl (java:jstatic "setProperty" "java.lang.System" "user.dir" (namestring x)) - #+allegro (excl:chdir x) - #+clisp (ext:cd x) - #+clozure (setf (ccl:current-directory) x) - #+(or cmu scl) (unix:unix-chdir (ext:unix-namestring x)) - #+cormanlisp (unless (zerop (win32::_chdir (namestring x))) - (error "Could not set current directory to ~A" x)) - #+ecl (ext:chdir x) - #+genera (setf *default-pathname-defaults* x) - #+lispworks (hcl:change-directory x) - #+mkcl (mk-ext:chdir x) - #+sbcl (progn (require :sb-posix) (symbol-call :sb-posix :chdir (sb-ext:native-namestring x))) - (error "chdir not supported on your implementation"))))) + #+abcl (java:jstatic "setProperty" "java.lang.System" "user.dir" (namestring x)) + #+allegro (excl:chdir x) + #+clisp (ext:cd x) + #+clozure (setf (ccl:current-directory) x) + #+(or cmu scl) (unix:unix-chdir (ext:unix-namestring x)) + #+cormanlisp (unless (zerop (win32::_chdir (namestring x))) + (error "Could not set current directory to ~A" x)) + #+ecl (ext:chdir x) + #+gcl (system:chdir x) + #+genera (setf *default-pathname-defaults* x) + #+lispworks (hcl:change-directory x) + #+mkcl (mk-ext:chdir x) + #+sbcl (progn (require :sb-posix) (symbol-call :sb-posix :chdir (sb-ext:native-namestring x))) + #-(or abcl allegro clisp clozure cmu cormanlisp ecl gcl genera lispworks mkcl sbcl scl) + (error "chdir not supported on your implementation")))) ;;;; ----------------------------------------------------------------- @@ -2340,7 +2342,7 @@ will be treated as part of the directory path. An empty string is thus read as meaning a pathname object with all fields nil. -Note that : characters will NOT be interpreted as host specification. +Note that colon characters #\: will NOT be interpreted as host specification. Absolute pathnames are only appropriate on Unix-style systems. The intention of this function is to support structured component names, @@ -2917,8 +2919,8 @@ This function is used as a helper to DIRECTORY-FILES to avoid invalid entries wh Subdirectories should NOT be returned. PATTERN defaults to a pattern carefully chosen based on the implementation; override the default at your own risk. - DIRECTORY-FILES tries NOT to resolve symlinks if the implementation -permits this." + DIRECTORY-FILES tries NOT to resolve symlinks if the implementation permits this, +but the behavior in presence of symlinks is not portable. Use IOlib to handle such situations." (let ((dir (pathname directory))) (when (logical-pathname-p dir) ;; Because of the filtering we do below, @@ -2944,7 +2946,8 @@ permits this." :version (make-pathname-component-logical (pathname-version f))))))))) (defun subdirectories (directory) - "Given a DIRECTORY pathname designator, return a list of the subdirectories under it." + "Given a DIRECTORY pathname designator, return a list of the subdirectories under it. +The behavior in presence of symlinks is not portable. Use IOlib to handle such situations." (let* ((directory (ensure-directory-pathname directory)) #-(or abcl cormanlisp genera xcl) (wild (merge-pathnames* @@ -2982,14 +2985,17 @@ permits this." :directory (append prefix (make-pathname-component-logical (last dir))))))))))) (defun collect-sub*directories (directory collectp recursep collector) - "Given a DIRECTORY, call-function the COLLECTOR function designator -on the directory if COLLECTP returns true when CALL-FUNCTION'ed with the directory, -and recurse each of its subdirectories on which the RECURSEP returns true when CALL-FUNCTION'ed with them." + "Given a DIRECTORY, when COLLECTP returns true when CALL-FUNCTION'ed with the directory, +call-function the COLLECTOR function designator on the directory, +and recurse each of its subdirectories on which the RECURSEP returns true when CALL-FUNCTION'ed with them. +This function will thus let you traverse a filesystem hierarchy, +superseding the functionality of CL-FAD:WALK-DIRECTORY. +The behavior in presence of symlinks is not portable. Use IOlib to handle such situations." (when (call-function collectp directory) - (call-function collector directory)) - (dolist (subdir (subdirectories directory)) - (when (call-function recursep subdir) - (collect-sub*directories subdir collectp recursep collector))))) + (call-function collector directory) + (dolist (subdir (subdirectories directory)) + (when (call-function recursep subdir) + (collect-sub*directories subdir collectp recursep collector)))))) ;;; Resolving symlinks somewhat (with-upgradability () @@ -3390,7 +3396,7 @@ If you're suicidal or extremely confident, just use :VALIDATE T." #:encoding-external-format #:*encoding-external-format-hook* #:default-encoding-external-format #:*default-encoding* #:*utf-8-external-format* #:with-safe-io-syntax #:call-with-safe-io-syntax #:safe-read-from-string - #:with-output #:output-string #:with-input + #:with-output #:output-string #:with-input #:input-string #:with-input-file #:call-with-input-file #:with-output-file #:call-with-output-file #:null-device-pathname #:call-with-null-input #:with-null-input #:call-with-null-output #:with-null-output @@ -3641,8 +3647,14 @@ Otherwise, signal an error." (defmacro with-input ((input-var &optional (value input-var)) &body body) "Bind INPUT-VAR to an input stream, coercing VALUE (default: previous binding of INPUT-VAR) as per CALL-WITH-INPUT, and evaluate BODY within the scope of this binding." - `(call-with-input ,value #'(lambda (,input-var) ,@body)))) + `(call-with-input ,value #'(lambda (,input-var) ,@body))) + (defun input-string (&optional input) + "If the desired INPUT is a string, return that string; otherwise slurp the INPUT into a string +and return that" + (if (stringp input) + input + (with-input (input) (funcall 'slurp-stream-string input))))) ;;; Null device (with-upgradability () @@ -4293,7 +4305,7 @@ depending on whether *LISP-INTERACTION* is set, enter debugger or die" #+abcl ext:*command-line-argument-list* ; Use 1.0.0 or later! #+allegro (sys:command-line-arguments) ; default: :application t #+clisp (coerce (ext:argv) 'list) - #+clozure (ccl::command-line-arguments) + #+clozure ccl:*command-line-argument-list* #+(or cmu scl) extensions:*command-line-strings* #+ecl (loop :for i :from 0 :below (si:argc) :collect (si:argv i)) #+gcl si:*command-args* @@ -6658,7 +6670,7 @@ previously-loaded version of ASDF." ;; "3.4.5.67" would be a development version in the official branch, on top of 3.4.5. ;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5 ;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67 - (asdf-version "3.1.3") + (asdf-version "3.1.4") (existing-version (asdf-version))) (setf *asdf-version* asdf-version) (when (and existing-version (not (equal asdf-version existing-version))) @@ -9017,7 +9029,7 @@ The :FORCE or :FORCE-NOT argument to OPERATE can be: (etypecase operation (operation (let ((name (type-of operation)) (initargs (operation-original-initargs operation))) - #'(lambda () (make-operation name :original-initargs initargs initargs)))) + #'(lambda () (apply 'make-operation name :original-initargs initargs initargs)))) ((or symbol string) (constantly operation)))) (component-path (typecase component ;; to remake the component after ASDF upgrade (component (component-find-path component)) @@ -9519,7 +9531,7 @@ effectively disabling the output translation facility." #:ensure-source-registry #:*source-registry-parameter* #:*default-source-registry-exclusions* #:*source-registry-exclusions* #:*wild-asd* #:directory-asd-files #:register-asd-directory - #:collect-asds-in-directory #:collect-sub*directories-asd-files + #:*recurse-beyond-asds* #:collect-asds-in-directory #:collect-sub*directories-asd-files #:validate-source-registry-directive #:validate-source-registry-form #:validate-source-registry-file #:validate-source-registry-directory #:parse-source-registry-string #:wrapping-source-registry @@ -9565,15 +9577,33 @@ system names to pathnames of .asd files") (directory-files directory *wild-asd*)) (defun collect-asds-in-directory (directory collect) - (map () collect (directory-asd-files directory))) + (let ((asds (directory-asd-files directory))) + (map () collect asds) + asds)) + + (defvar *recurse-beyond-asds* t + "Should :tree entries of the source-registry recurse in subdirectories +after having found a .asd file? True by default.") + + (defun process-source-registry-cache (directory collect) + (let ((cache (ignore-errors + (safe-read-file-form (subpathname directory ".cl-source-registry.cache"))))) + (when (and (listp cache) (eq :source-registry-cache (first cache))) + (loop :for s :in (rest cache) :do (funcall collect (subpathname directory s))) + t))) (defun collect-sub*directories-asd-files - (directory &key (exclude *default-source-registry-exclusions*) collect) + (directory &key (exclude *default-source-registry-exclusions*) collect + (recurse-beyond-asds *recurse-beyond-asds*) ignore-cache) (collect-sub*directories directory - (constantly t) - #'(lambda (x &aux (l (car (last (pathname-directory x))))) (not (member l exclude :test #'equal))) - #'(lambda (dir) (collect-asds-in-directory dir collect)))) + #'(lambda (dir) + (unless (and (not ignore-cache) (process-source-registry-cache directory collect)) + (let ((asds (collect-asds-in-directory dir collect))) + (or recurse-beyond-asds (not asds))))) + #'(lambda (x) + (not (member (car (last (pathname-directory x))) exclude :test #'equal))) + (constantly nil))) (defun validate-source-registry-directive (directive) (or (member directive '(:default-registry)) @@ -9729,7 +9759,8 @@ system names to pathnames of .asd files") ((:also-exclude) (appendf *source-registry-exclusions* rest)) ((:default-registry) - (inherit-source-registry '(default-source-registry) :register register)) + (inherit-source-registry + '(default-user-source-registry default-system-source-registry) :register register)) ((:inherit-configuration) (inherit-source-registry inherit :register register)) ((:ignore-inherited-configuration) @@ -10187,7 +10218,6 @@ system names contained using COERCE-NAME. Return the result." #:bundle-op #:bundle-type #:program-system #:bundle-system #:bundle-pathname-type #:bundlable-file-p #:direct-dependency-files #:monolithic-op #:monolithic-bundle-op #:operation-monolithic-p - #:fasl-op #:load-fasl-op #:monolithic-fasl-op #:binary-op #:monolithic-binary-op #:basic-compile-bundle-op #:prepare-bundle-op #:compile-bundle-op #:load-bundle-op #:monolithic-compile-bundle-op #:monolithic-load-bundle-op #:lib-op #:monolithic-lib-op @@ -10648,6 +10678,11 @@ itself.")) ;; operation on a system and its dependencies ;;(unless (or #+ecl (use-ecl-byte-compiler-p)) ;; (setf *load-system-operation* 'load-bundle-op)) + (defun uiop-library-pathname () + #+ecl (or (probe-file* (compile-file-pathname "sys:uiop" :type :lib)) ;; new style + (probe-file* (compile-file-pathname "sys:uiop" :type :object))) ;; old style + #+mkcl (make-pathname :type (bundle-pathname-type :lib) :defaults #p"sys:contrib;uiop")) + (defun asdf-library-pathname () #+ecl (or (probe-file* (compile-file-pathname "sys:asdf" :type :lib)) ;; new style (probe-file* (compile-file-pathname "sys:asdf" :type :object))) ;; old style @@ -10669,10 +10704,12 @@ itself.")) ;; operation on a system and its dependencies `(,(make-library-system "cmp" (compiler-library-pathname)))) ,@(unless (or (no-uiop c) (has-it-p "uiop") (has-it-p "asdf")) - `(,(cond - ((system-source-directory :uiop) (find-system :uiop)) - ((system-source-directory :asdf) (find-system :asdf)) - (t (make-library-system "asdf" (asdf-library-pathname)))))) + `(cond + ((system-source-directory :uiop) `(,(find-system :uiop))) + ((system-source-directory :asdf) `(,(find-system :asdf))) + (t `(,@(if-let (uiop (uiop-library-pathname)) + `(,(make-library-system "uiop" uiop))) + ,(make-library-system "asdf" (asdf-library-pathname)))))) ,@deps))))) (defmethod perform ((o link-op) (c system)) @@ -10707,18 +10744,18 @@ Please report to ASDF-DEVEL if this works for you."))) ;;; Backward compatibility with pre-3.1.2 names -(defclass fasl-op (selfward-operation) - ((selfward-operation :initform 'compile-bundle-op :allocation :class))) -(defclass load-fasl-op (selfward-operation) - ((selfward-operation :initform 'load-bundle-op :allocation :class))) -(defclass binary-op (selfward-operation) - ((selfward-operation :initform 'deliver-asd-op :allocation :class))) -(defclass monolithic-fasl-op (selfward-operation) - ((selfward-operation :initform 'monolithic-compile-bundle-op :allocation :class))) -(defclass monolithic-load-fasl-op (selfward-operation) - ((selfward-operation :initform 'monolithic-load-bundle-op :allocation :class))) -(defclass monolithic-binary-op (selfward-operation) - ((selfward-operation :initform 'monolithic-deliver-asd-op :allocation :class))) +;; (defclass fasl-op (selfward-operation) +;; ((selfward-operation :initform 'compile-bundle-op :allocation :class))) +;; (defclass load-fasl-op (selfward-operation) +;; ((selfward-operation :initform 'load-bundle-op :allocation :class))) +;; (defclass binary-op (selfward-operation) +;; ((selfward-operation :initform 'deliver-asd-op :allocation :class))) +;; (defclass monolithic-fasl-op (selfward-operation) +;; ((selfward-operation :initform 'monolithic-compile-bundle-op :allocation :class))) +;; (defclass monolithic-load-fasl-op (selfward-operation) +;; ((selfward-operation :initform 'monolithic-load-bundle-op :allocation :class))) +;; (defclass monolithic-binary-op (selfward-operation) +;; ((selfward-operation :initform 'monolithic-deliver-asd-op :allocation :class))) ;;;; ------------------------------------------------------------------------- ;;;; Concatenate-source @@ -11155,7 +11192,6 @@ otherwise return a default system name computed from PACKAGE-NAME." #:component-load-dependencies #:run-shell-command ; deprecated, do not use #:bundle-op #:monolithic-bundle-op #:precompiled-system #:compiled-file #:bundle-system #:program-system #:make-build - #:fasl-op #:load-fasl-op #:monolithic-fasl-op #:binary-op #:monolithic-binary-op #:basic-compile-bundle-op #:prepare-bundle-op #:compile-bundle-op #:load-bundle-op #:monolithic-compile-bundle-op #:monolithic-load-bundle-op #:lib-op #:dll-op #:deliver-asd-op #:program-op #:image-op @@ -11306,7 +11342,8 @@ otherwise return a default system name computed from PACKAGE-NAME." (uiop/package:define-package :asdf/footer (:recycle :asdf/footer :asdf) - (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/operate :asdf/bundle)) + (:use :uiop/common-lisp :uiop + :asdf/upgrade :asdf/find-system :asdf/operate :asdf/bundle)) (in-package :asdf/footer) ;;;; Hook ASDF into the implementation's REQUIRE and other entry points. @@ -11336,7 +11373,7 @@ otherwise return a default system name computed from PACKAGE-NAME." (if (eq f 'module-provide-asdf) f #'(lambda (name) (let ((l (multiple-value-list (funcall f name)))) - (and (first l) (register-pre-built-system (coerce-name name))) + (and (first l) (register-preloaded-system (coerce-name name))) (values-list l)))))))) #+cmu ;; Hook into the CMUCL herald. @@ -11361,4 +11398,3 @@ otherwise return a default system name computed from PACKAGE-NAME." (when *load-verbose* (asdf-message ";; ASDF, version ~a~%" (asdf-version))) - ----------------------------------------------------------------------- Summary of changes: src/contrib/asdf/asdf.lisp | 158 +++++++++++++++++++++++--------------- src/general-info/release-21a.txt | 4 + 2 files changed, 101 insertions(+), 61 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. 20f-39-g7765a6f
by Raymond Toy 11 Oct '14

11 Oct '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via 7765a6f7f8391e45405298d454b6907d5b90683e (commit) from da20092cfc5da4fd78ef37d2d1d1a06ea9f08f8d (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 7765a6f7f8391e45405298d454b6907d5b90683e Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Fri Oct 10 21:43:09 2014 -0700 Fix compiler warning for skipped_break_addr Change skipped_break_addr to unsigned int* instead of unsigned long* and remove cast from pc to store in skipped_break_addr. diff --git a/src/lisp/ppc-arch.c b/src/lisp/ppc-arch.c index c46b99c..008a458 100644 --- a/src/lisp/ppc-arch.c +++ b/src/lisp/ppc-arch.c @@ -117,7 +117,7 @@ arch_remove_breakpoint(void *pc, unsigned long orig_inst) os_flush_icache((os_vm_address_t) pc, sizeof(unsigned long)); } -static unsigned long *skipped_break_addr, displaced_after_inst; +static unsigned int *skipped_break_addr, displaced_after_inst; static sigset_t orig_sigmask; void @@ -133,7 +133,7 @@ arch_do_displaced_inst(os_context_t * scp, unsigned long orig_inst) *pc = orig_inst; os_flush_icache((os_vm_address_t) pc, sizeof(unsigned int)); - skipped_break_addr = (unsigned long) pc; + skipped_break_addr = pc; /* * Replace the next instruction with a ----------------------------------------------------------------------- Summary of changes: src/lisp/ppc-arch.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. 20f-38-gda20092
by Raymond Toy 11 Oct '14

11 Oct '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via da20092cfc5da4fd78ef37d2d1d1a06ea9f08f8d (commit) via 1addd336c589019861798242732ab6d2c99ffe05 (commit) via bd66559a30189bee02e7357d365f7317670ae0c1 (commit) via 6172c8a71aacbd894dff622a0dd9d593c10a8e48 (commit) via 434078e9e8a7b7b3069c0cf6e6f618807823f41a (commit) via a1946b35f37aef46677676e2696304ab6b405788 (commit) via 571dd4904fc88cad51c9c2dee0b3e6ed6ef9ce12 (commit) from 57711cc2167f4fc4dc5a03f1b7e3b43e5c7e8050 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- ----------------------------------------------------------------------- Summary of changes: src/bootfiles/20f/boot-20f-cross-x86.lisp | 9 ++++++ src/code/ppc-vm.lisp | 2 +- src/code/sparc-svr4-vm.lisp | 1 + src/code/x86-vm.lisp | 3 ++ src/compiler/generic/new-genesis.lisp | 2 +- src/lisp/Config.sparc_common | 16 ++++++---- src/lisp/Config.x86_common | 4 +++ src/lisp/Darwin-os.c | 24 ++++++++------- src/lisp/os-common.c | 34 ++++++++++++++------- src/tools/cross-scripts/cross-ppc-ppc-darwin.lisp | 4 +-- src/tools/cross-scripts/cross-x86-x86.lisp | 3 ++ 11 files changed, 70 insertions(+), 32 deletions(-) create mode 100644 src/bootfiles/20f/boot-20f-cross-x86.lisp hooks/post-receive -- CMU Common Lisp

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch rtoy-extern-alien-name updated. 20f-38-gda20092
by Raymond Toy 11 Oct '14

11 Oct '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, rtoy-extern-alien-name has been updated via da20092cfc5da4fd78ef37d2d1d1a06ea9f08f8d (commit) from 1addd336c589019861798242732ab6d2c99ffe05 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit da20092cfc5da4fd78ef37d2d1d1a06ea9f08f8d Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Fri Oct 10 20:19:05 2014 -0700 Add :elf to *features* for sparc/solaris. diff --git a/src/code/sparc-svr4-vm.lisp b/src/code/sparc-svr4-vm.lisp index 5c92b96..1368fb2 100644 --- a/src/code/sparc-svr4-vm.lisp +++ b/src/code/sparc-svr4-vm.lisp @@ -128,6 +128,7 @@ (pushnew :sparc *features*) (pushnew :sun4 *features*) (pushnew :svr4 *features*) +(sys:register-lisp-feature :elf) ;; There's SVR4 by Sun called Solaris 2, there's the SVR4 reference port by ;; ICL that runs on ICL's own DRS 6000s. #+sunos ----------------------------------------------------------------------- Summary of changes: src/code/sparc-svr4-vm.lisp | 1 + 1 file changed, 1 insertion(+) hooks/post-receive -- CMU Common Lisp

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch rtoy-extern-alien-name updated. 20f-37-g1addd33
by Raymond Toy 11 Oct '14

11 Oct '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, rtoy-extern-alien-name has been updated via 1addd336c589019861798242732ab6d2c99ffe05 (commit) from bd66559a30189bee02e7357d365f7317670ae0c1 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 1addd336c589019861798242732ab6d2c99ffe05 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Fri Oct 10 20:18:25 2014 -0700 Add boot file for the darwin/x86 cross-compile that is used to fix the extern-alien-name issue so darwin/x86 matches darwin/ppc. diff --git a/src/bootfiles/20f/boot-20f-cross-x86.lisp b/src/bootfiles/20f/boot-20f-cross-x86.lisp new file mode 100644 index 0000000..d1f3367 --- /dev/null +++ b/src/bootfiles/20f/boot-20f-cross-x86.lisp @@ -0,0 +1,9 @@ +;;; Cross-compile script to update extern-alien-name for +;;; darwin/x86. This makes extern-alien-name on darwin/x86 match +;;; darwin/ppc, where an underscore is prepended. +;;; +;;; A cross-compile might not truly be necessary, but this is known to +;;; work. + +#+(and darwin x86) +(load "target:tools/cross-scripts/cross-x86-x86.lisp") ----------------------------------------------------------------------- Summary of changes: src/bootfiles/20f/boot-20f-cross-x86.lisp | 9 +++++++++ 1 file changed, 9 insertions(+) create mode 100644 src/bootfiles/20f/boot-20f-cross-x86.lisp hooks/post-receive -- CMU Common Lisp

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch rtoy-extern-alien-name updated. 20f-36-gbd66559
by Raymond Toy 11 Oct '14

11 Oct '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, rtoy-extern-alien-name has been updated via bd66559a30189bee02e7357d365f7317670ae0c1 (commit) from 6172c8a71aacbd894dff622a0dd9d593c10a8e48 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit bd66559a30189bee02e7357d365f7317670ae0c1 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Fri Oct 10 19:42:14 2014 -0700 For sparc, define FEATURE_ELF because Solaris uses elf. This is needed on sparc to define the right EXTERN_ALIEN_NAME. diff --git a/src/lisp/Config.sparc_common b/src/lisp/Config.sparc_common index 2ad8aed..9a7c850 100644 --- a/src/lisp/Config.sparc_common +++ b/src/lisp/Config.sparc_common @@ -15,15 +15,16 @@ vpath %.pot $(CMULOCALE) vpath %.po $(CMULOCALE) vpath %.mo $(CMULOCALE) +CPP_DEFINE_OPTIONS := -DSOLARIS -DSVR4 # Enable support for :linkage-table feature. ifdef FEATURE_LINKAGE_TABLE -LINKAGE = -DLINKAGE_TABLE +CPP_DEFINE_OPTIONS += -DLINKAGE_TABLE endif # Enable support for generational GC ifdef FEATURE_GENCGC -GENCGC = -DGENCGC +CPP_DEFINE_OPTIONS += -DGENCGC GC_SRC = gencgc.c else GC_SRC = gc.c @@ -34,19 +35,22 @@ endif # cases. If neither is set, then we don't want any SSE2 support at # all. ifdef FEATURE_X87 -SSE2 = -DFEATURE_SSE2 +CPP_DEFINE_OPTIONS += -DFEATURE_SSE2 else ifdef FEATURE_SSE2 -SSE2 = -DFEATURE_SSE2 +CPP_DEFINE_OPTIONS += -DFEATURE_SSE2 endif endif # Enable support for Unicode ifdef FEATURE_UNICODE -UNICODE = -DUNICODE +CPP_DEFINE_OPTIONS += -DUNICODE endif -CPPFLAGS += -I. -I$(PATH1) -DSOLARIS -DSVR4 $(CC_V8PLUS) $(LINKAGE) $(GENCGC) $(UNICODE) $(SSE2) +# Sparc is always elf. +CPP_DEFINE_OPTIONS += -DFEATURE_ELF + +CPPFLAGS += -I. -I$(PATH1) $(CC_V8PLUS) $(CPP_DEFINE_OPTIONS) CFLAGS += -g $(CC_V8PLUS) ----------------------------------------------------------------------- Summary of changes: src/lisp/Config.sparc_common | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch rtoy-extern-alien-name updated. 20f-35-g6172c8a
by Raymond Toy 11 Oct '14

11 Oct '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, rtoy-extern-alien-name has been updated via 6172c8a71aacbd894dff622a0dd9d593c10a8e48 (commit) from 434078e9e8a7b7b3069c0cf6e6f618807823f41a (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 6172c8a71aacbd894dff622a0dd9d593c10a8e48 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Fri Oct 10 19:40:37 2014 -0700 For x86, define FEATURE_ELF if needed. And this is definitely needed now on Linux at least to define the right EXTERN_ALIEN_NAME. diff --git a/src/lisp/Config.x86_common b/src/lisp/Config.x86_common index ee06a1a..f0de2ca 100644 --- a/src/lisp/Config.x86_common +++ b/src/lisp/Config.x86_common @@ -45,6 +45,10 @@ ifdef FEATURE_UNICODE CPP_DEFINE_OPTIONS += -DUNICODE endif +ifdef FEATURE_ELF +CPP_DEFINE_OPTIONS += -DFEATURE_ELF +endif + LD = ld ifeq ($(filter 2% 3%, $(shell $(CC) -dumpversion)),) ----------------------------------------------------------------------- Summary of changes: src/lisp/Config.x86_common | 4 ++++ 1 file changed, 4 insertions(+) hooks/post-receive -- CMU Common Lisp

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch rtoy-extern-alien-name updated. 20f-34-g434078e
by Raymond Toy 10 Oct '14

10 Oct '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, rtoy-extern-alien-name has been updated via 434078e9e8a7b7b3069c0cf6e6f618807823f41a (commit) from a1946b35f37aef46677676e2696304ab6b405788 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 434078e9e8a7b7b3069c0cf6e6f618807823f41a Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Thu Oct 9 23:46:14 2014 -0700 On sparc, use EXTERN_ALIEN_NAME too when printing out the error message. diff --git a/src/lisp/os-common.c b/src/lisp/os-common.c index ff9cffb..183d808 100755 --- a/src/lisp/os-common.c +++ b/src/lisp/os-common.c @@ -223,8 +223,9 @@ os_foreign_linkage_init(void) if (i == 0) { #if defined(sparc) if (type != LINKAGE_CODE_TYPE || strcmp(c_symbol_name, EXTERN_ALIEN_NAME("call_into_c"))) { - fprintf(stderr, "linkage_data is %s but expected call_into_c\n", - c_symbol_name); + fprintf(stderr, "linkage_data is %s but expected %s\n", + c_symbol_name, + EXTERN_ALIEN_NAME("call_into_c")); lose("First element of linkage_data is bogus.\n"); } arch_make_linkage_entry(i, (void*) call_into_c, 1); ----------------------------------------------------------------------- Summary of changes: src/lisp/os-common.c | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch rtoy-extern-alien-name updated. 20f-33-ga1946b3
by Raymond Toy 10 Oct '14

10 Oct '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, rtoy-extern-alien-name has been updated via a1946b35f37aef46677676e2696304ab6b405788 (commit) from 571dd4904fc88cad51c9c2dee0b3e6ed6ef9ce12 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit a1946b35f37aef46677676e2696304ab6b405788 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Thu Oct 9 23:44:38 2014 -0700 Prepend underscore in extern-alien-name for darwin/ppc. diff --git a/src/code/ppc-vm.lisp b/src/code/ppc-vm.lisp index fa977fd..522218c 100644 --- a/src/code/ppc-vm.lisp +++ b/src/code/ppc-vm.lisp @@ -297,7 +297,7 @@ ;;; (defun extern-alien-name (name) (declare (type simple-base-string name)) - name) + (concatenate 'simple-base-string "_" name)) #-linkage-table (defun lisp::foreign-symbol-address-aux (name flavor) diff --git a/src/tools/cross-scripts/cross-ppc-ppc-darwin.lisp b/src/tools/cross-scripts/cross-ppc-ppc-darwin.lisp index 02e05ef..55261dc 100644 --- a/src/tools/cross-scripts/cross-ppc-ppc-darwin.lisp +++ b/src/tools/cross-scripts/cross-ppc-ppc-darwin.lisp @@ -31,7 +31,7 @@ (in-package :vm) (defun extern-alien-name (name) (declare (type simple-string name)) - name) + (concatenate 'simple-string "_" name)) ;; When compiling the compiler, vm:fixup-code-object and ;; vm:sanctify-for-execution are undefined. Import these to get rid ;; of that error. @@ -199,7 +199,7 @@ (in-package :vm) (defun extern-alien-name (name) (declare (type simple-string name)) - name) + (concatenate 'simple-string "_" name)) (export 'extern-alien-name) (export 'fixup-code-object) (export 'sanctify-for-execution) ----------------------------------------------------------------------- Summary of changes: src/code/ppc-vm.lisp | 2 +- src/tools/cross-scripts/cross-ppc-ppc-darwin.lisp | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch rtoy-extern-alien-name created. 20f-32-g571dd49
by Raymond Toy 10 Oct '14

10 Oct '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, rtoy-extern-alien-name has been created at 571dd4904fc88cad51c9c2dee0b3e6ed6ef9ce12 (commit) - Log ----------------------------------------------------------------- commit 571dd4904fc88cad51c9c2dee0b3e6ed6ef9ce12 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Thu Oct 9 22:54:49 2014 -0700 Unify extern-alien-name for darwin x86 and ppc. Initial attempt to unify extern-alien-name, primarily for darwin (x86 and ppc). Thus, systems using elf do not prepend an underscore, but other systems are assumed to prepend an underscore. This is currently only for darwin/x86. A cross-compile on darwin x86 is needed. * code/x86-vm.lisp: * For elf systems, don't prepend an underscore. For other systems, do prepend. * compiler/generic/new-genesis.lisp: * Fix long-standing bug where we should call EXTERN-ALIEN-NAME to get the right name for "resolve_linkage_tramp". * lisp/Darwin-os.c: * Update os_dlsym to assume the external name is always preceded by an underscore. The lookup for dlysm is done by stripping off the leading underscore. * lisp/os-common.c: * Add EXTERN_ALIEN_NAME macro to create the correct alien name for elf and non-elf systems. * Use it to generate the correct name to be used for comparison in the sanity checks of the linkage table entries. diff --git a/src/code/x86-vm.lisp b/src/code/x86-vm.lisp index 2171d60..a7e307d 100644 --- a/src/code/x86-vm.lisp +++ b/src/code/x86-vm.lisp @@ -336,6 +336,9 @@ ;;; (defun extern-alien-name (name) (declare (type simple-string name)) + #-elf + (concatenate 'string "_" name) + #+elf name) #+(and (or linux (and freebsd elf)) (not linkage-table)) diff --git a/src/compiler/generic/new-genesis.lisp b/src/compiler/generic/new-genesis.lisp index 953d9ba..bae4df7 100644 --- a/src/compiler/generic/new-genesis.lisp +++ b/src/compiler/generic/new-genesis.lisp @@ -2183,7 +2183,7 @@ ;; This has gotta be the first entry. This has to match what ;; os_foreign_linkage_init does! #+(or x86 amd64) - (cold-register-foreign-linkage "resolve_linkage_tramp" :code) + (cold-register-foreign-linkage (vm::extern-alien-name "resolve_linkage_tramp") :code) #+(or sparc ppc) (progn (cold-register-foreign-linkage (vm::extern-alien-name "call_into_c") :code) diff --git a/src/lisp/Darwin-os.c b/src/lisp/Darwin-os.c index 0efb72f..49e660c 100644 --- a/src/lisp/Darwin-os.c +++ b/src/lisp/Darwin-os.c @@ -532,7 +532,13 @@ os_dlsym(const char *sym_name, lispobj lib_list) { static void *program_handle; void *sym_addr = 0; + int offset = sym_name[0] == '_' ? 1 : 0; +#if 1 + if (offset == 0) { + fprintf(stderr, "sym-name = %s\n", sym_name); + } +#endif if (!program_handle) program_handle = dlopen((void *) 0, RTLD_LAZY | RTLD_GLOBAL); if (lib_list != NIL) { @@ -543,21 +549,17 @@ os_dlsym(const char *sym_name, lispobj lib_list) struct cons *lib_cons = CONS(CONS(lib_list_head)->car); struct sap *dlhandle = (struct sap *) PTR(lib_cons->car); -#if 0 && defined(__ppc__) - sym_addr = dlsym((void *) dlhandle->pointer, (sym_name[0] == '_' ? sym_name + 1 : sym_name)); -#else - sym_addr = dlsym((void *) dlhandle->pointer, sym_name); -#endif + /* + * On Darwin, dlsym assumes the C name, so skip the underscore that + * is prepended by EXTERN-ALIEN-NAME. + */ + sym_addr = dlsym((void *) dlhandle->pointer, sym_name + offset); if (sym_addr) - return sym_addr; + return sym_addr; } } -#if 0 && defined(__ppc__) - sym_addr = dlsym(program_handle, (sym_name[0] == '_' ? sym_name + 1 : sym_name)); -#else - sym_addr = dlsym(program_handle, sym_name); -#endif + sym_addr = dlsym(program_handle, sym_name + offset); return sym_addr; } diff --git a/src/lisp/os-common.c b/src/lisp/os-common.c index b183d06..ff9cffb 100755 --- a/src/lisp/os-common.c +++ b/src/lisp/os-common.c @@ -167,6 +167,16 @@ convert_lisp_string(char* c_string, void* lisp_string, int len) return c_string; } +/* + * C version of lisp's EXTERN-ALIEN-NAME. For systems that use elf, + * do nothing. Otherwise, we prepend an underscore. + */ +#if defined(FEATURE_ELF) +#define EXTERN_ALIEN_NAME(x) x +#else +#define EXTERN_ALIEN_NAME(x) "_" x +#endif + void os_foreign_linkage_init(void) { @@ -212,25 +222,27 @@ os_foreign_linkage_init(void) #endif if (i == 0) { #if defined(sparc) - if (type != LINKAGE_CODE_TYPE || strcmp(c_symbol_name, "call_into_c")) { + if (type != LINKAGE_CODE_TYPE || strcmp(c_symbol_name, EXTERN_ALIEN_NAME("call_into_c"))) { fprintf(stderr, "linkage_data is %s but expected call_into_c\n", - (char *) symbol_name->data); + c_symbol_name); lose("First element of linkage_data is bogus.\n"); } arch_make_linkage_entry(i, (void*) call_into_c, 1); #elif (defined(DARWIN) && defined(__ppc__)) - if (type != 1 || strcmp(c_symbol_name, "call_into_c")) { - fprintf(stderr, "linkage_data is %s but expected call_into_c\n", - (char *) c_symbol_name); + if (type != 1 || strcmp(c_symbol_name, EXTERN_ALIEN_NAME("call_into_c"))) { + fprintf(stderr, "linkage_data is %s but expected %s\n", + c_symbol_name, + EXTERN_ALIEN_NAME("call_into_c")); lose("First element of linkage_data is bogus.\n"); } arch_make_linkage_entry(i, &call_into_c, 1); #else if (type != LINKAGE_CODE_TYPE || strcmp(c_symbol_name, - "resolve_linkage_tramp")) { + EXTERN_ALIEN_NAME("resolve_linkage_tramp"))) { fprintf(stderr, - "linkage_data is %s but expected resolve_linkage_tramp\n", - (char *) c_symbol_name); + "linkage_data is %s but expected %s\n", + c_symbol_name, + EXTERN_ALIEN_NAME("resolve_linkage_tramp")); lose("First element of linkage_data is bogus.\n"); } arch_make_linkage_entry(i, (void *) &resolve_linkage_tramp, 1); @@ -241,7 +253,7 @@ os_foreign_linkage_init(void) void *target_addr = os_dlsym(c_symbol_name, NIL); if (!target_addr) { -#if 1 +#if 0 int k; unsigned short int* wide_string; @@ -262,7 +274,6 @@ os_foreign_linkage_init(void) } else { arch_make_lazy_linkage(i / LINKAGE_DATA_ENTRY_SIZE); } - } #endif /* LINKAGE_TABLE */ } diff --git a/src/tools/cross-scripts/cross-x86-x86.lisp b/src/tools/cross-scripts/cross-x86-x86.lisp index 3f579f3..eacbbe1 100644 --- a/src/tools/cross-scripts/cross-x86-x86.lisp +++ b/src/tools/cross-scripts/cross-x86-x86.lisp @@ -205,6 +205,9 @@ (in-package :vm) (defun extern-alien-name (name) (declare (type simple-string name)) + #-elf + (concatenate 'simple-string "_" name) + #+elf name) (export 'extern-alien-name) (in-package :cl-user) ----------------------------------------------------------------------- hooks/post-receive -- CMU Common Lisp

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. 20f-31-g57711cc
by Raymond Toy 09 Oct '14

09 Oct '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via 57711cc2167f4fc4dc5a03f1b7e3b43e5c7e8050 (commit) from 2c1badeff23fe6c6bd1e5f8911b0afdfb005497c (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 57711cc2167f4fc4dc5a03f1b7e3b43e5c7e8050 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Wed Oct 8 17:44:04 2014 -0700 First cut at removing ppc-darwin-dlshim.c. Not needed anymore because dlsym works on OSX/ppc like on other ports. A cross-compile was used with cross-ppc-ppc-darwin.lisp. I'm not sure a cross-compile is required, though. * code/ppc-vm.lisp: * EXTERN-ALIEN-NAME doesn't need to prepend an underscore anymore. * lisp/Config.ppc_darwin: * Don't compile/link ppc-darwin-dlshim.c. * lisp/os-common.c: * Don't prepend underscore for call_into_lisp. * tools/cross-scripts/cross-ppc-ppc-darwin.lisp: * EXTERN-ALIEN-NAME doesn't need to prepend an underscore anymore. diff --git a/src/code/ppc-vm.lisp b/src/code/ppc-vm.lisp index 6133533..fa977fd 100644 --- a/src/code/ppc-vm.lisp +++ b/src/code/ppc-vm.lisp @@ -297,10 +297,7 @@ ;;; (defun extern-alien-name (name) (declare (type simple-base-string name)) - #+darwin - (concatenate 'string "_" name) - #-darwin - (concatenate 'string "" name)) + name) #-linkage-table (defun lisp::foreign-symbol-address-aux (name flavor) diff --git a/src/lisp/Config.ppc_darwin b/src/lisp/Config.ppc_darwin index 4f06648..871a261 100644 --- a/src/lisp/Config.ppc_darwin +++ b/src/lisp/Config.ppc_darwin @@ -40,7 +40,8 @@ ASFLAGS = $(OSX_VERSION) -traditional -g -O3 -DDARWIN -Dppc $(LINKAGE) $(GENCGC) UNDEFSYMPATTERN = -Xlinker -u -Xlinker & ASSEM_SRC = ppc-assem.S linux-stubs.S ARCH_SRC = ppc-arch.c -OS_SRC = ppc-darwin-dlshim.c os-common.c Darwin-os.c +#OS_SRC = ppc-darwin-dlshim.c os-common.c Darwin-os.c +OS_SRC = os-common.c Darwin-os.c ifdef FEATURE_EXECUTABLE diff --git a/src/lisp/Darwin-os.c b/src/lisp/Darwin-os.c index 1f67b68..0efb72f 100644 --- a/src/lisp/Darwin-os.c +++ b/src/lisp/Darwin-os.c @@ -543,12 +543,21 @@ os_dlsym(const char *sym_name, lispobj lib_list) struct cons *lib_cons = CONS(CONS(lib_list_head)->car); struct sap *dlhandle = (struct sap *) PTR(lib_cons->car); +#if 0 && defined(__ppc__) + sym_addr = dlsym((void *) dlhandle->pointer, (sym_name[0] == '_' ? sym_name + 1 : sym_name)); +#else sym_addr = dlsym((void *) dlhandle->pointer, sym_name); +#endif if (sym_addr) return sym_addr; } } + +#if 0 && defined(__ppc__) + sym_addr = dlsym(program_handle, (sym_name[0] == '_' ? sym_name + 1 : sym_name)); +#else sym_addr = dlsym(program_handle, sym_name); +#endif return sym_addr; } diff --git a/src/lisp/os-common.c b/src/lisp/os-common.c index 90458c9..b183d06 100755 --- a/src/lisp/os-common.c +++ b/src/lisp/os-common.c @@ -219,7 +219,7 @@ os_foreign_linkage_init(void) } arch_make_linkage_entry(i, (void*) call_into_c, 1); #elif (defined(DARWIN) && defined(__ppc__)) - if (type != 1 || strcmp(c_symbol_name, "_call_into_c")) { + if (type != 1 || strcmp(c_symbol_name, "call_into_c")) { fprintf(stderr, "linkage_data is %s but expected call_into_c\n", (char *) c_symbol_name); lose("First element of linkage_data is bogus.\n"); @@ -241,7 +241,7 @@ os_foreign_linkage_init(void) void *target_addr = os_dlsym(c_symbol_name, NIL); if (!target_addr) { -#if 0 +#if 1 int k; unsigned short int* wide_string; diff --git a/src/tools/cross-scripts/cross-ppc-ppc-darwin.lisp b/src/tools/cross-scripts/cross-ppc-ppc-darwin.lisp index 3be7ae6..02e05ef 100644 --- a/src/tools/cross-scripts/cross-ppc-ppc-darwin.lisp +++ b/src/tools/cross-scripts/cross-ppc-ppc-darwin.lisp @@ -31,7 +31,7 @@ (in-package :vm) (defun extern-alien-name (name) (declare (type simple-string name)) - (concatenate 'string "_" name)) + name) ;; When compiling the compiler, vm:fixup-code-object and ;; vm:sanctify-for-execution are undefined. Import these to get rid ;; of that error. @@ -199,7 +199,7 @@ (in-package :vm) (defun extern-alien-name (name) (declare (type simple-string name)) - (concatenate 'string "_" name)) + name) (export 'extern-alien-name) (export 'fixup-code-object) (export 'sanctify-for-execution) ----------------------------------------------------------------------- Summary of changes: src/code/ppc-vm.lisp | 5 +---- src/lisp/Config.ppc_darwin | 3 ++- src/lisp/Darwin-os.c | 9 +++++++++ src/lisp/os-common.c | 4 ++-- src/tools/cross-scripts/cross-ppc-ppc-darwin.lisp | 4 ++-- 5 files changed, 16 insertions(+), 9 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0