From: <cli...@li...> - 2004-07-30 21:36:06
|
Send clisp-cvs mailing list submissions to cli...@li... To subscribe or unsubscribe via the World Wide Web, visit https://lists.sourceforge.net/lists/listinfo/clisp-cvs or, via email, send a message with subject or body 'help' to cli...@li... You can reach the person managing the list at cli...@li... When replying, please edit your Subject line so it is more specific than "Re: Contents of clisp-cvs digest..." CLISP CVS commits for today Today's Topics: 1. clisp/src clos-package.lisp,1.20,1.21 init.lisp,1.162,1.163 NEWS,1.161,1.162 ChangeLog,1.3356,1.3357 (Bruno Haible) 2. clisp/src ChangeLog,1.3357,1.3358 (Sam Steingold) 3. clisp/utils modprep.lisp,1.11,1.12 (Sam Steingold) 4. clisp/src ChangeLog,1.3358,1.3359 (Sam Steingold) 5. clisp/src ChangeLog,1.3359,1.3360 (Sam Steingold) 6. clisp/modules/syscalls syscalls.xml,1.12,1.13 posix.lisp,1.12,1.13 configure.in,1.14,1.15 calls.c,1.39,1.40 (Sam Steingold) --__--__-- Message: 1 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src clos-package.lisp,1.20,1.21 init.lisp,1.162,1.163 NEWS,1.161,1.162 ChangeLog,1.3356,1.3357 Date: Fri, 30 Jul 2004 11:59:57 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24430/src Modified Files: clos-package.lisp init.lisp NEWS ChangeLog Log Message: Export the MOP defined symbols for methods. Index: NEWS =================================================================== RCS file: /cvsroot/clisp/clisp/src/NEWS,v retrieving revision 1.161 retrieving revision 1.162 diff -u -d -r1.161 -r1.162 --- NEWS 22 Jul 2004 10:30:56 -0000 1.161 +++ NEWS 30 Jul 2004 11:59:54 -0000 1.162 @@ -27,6 +27,10 @@ WRITER-METHOD-CLASS. For notification about subclasses: CLASS-DIRECT-SUBCLASSES, ADD-DIRECT-SUBCLASS, REMOVE-DIRECT-SUBCLASS. + + Methods: + New generic functions + METHOD-FUNCTION, METHOD-GENERIC-FUNCTION, METHOD-LAMBDA-LIST, + METHOD-SPECIALIZERS, ACCESOR-METHOD-SLOT-DEFINITION. + Method-Combinations: New generic function FIND-METHOD-COMBINATION. Index: clos-package.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/clos-package.lisp,v retrieving revision 1.20 retrieving revision 1.21 diff -u -d -r1.20 -r1.21 --- clos-package.lisp 22 Jul 2004 10:30:56 -0000 1.20 +++ clos-package.lisp 30 Jul 2004 11:59:54 -0000 1.21 @@ -135,7 +135,9 @@ specializer-direct-generic-functions specializer-direct-methods eql-specializer-object intern-eql-specializer ;; MOP for methods - accessor-method-slot-definition + method standard-method + method-function method-generic-function method-lambda-list + method-specializers method-qualifiers accessor-method-slot-definition ;; MOP for method combinations find-method-combination ;; MOP for generic functions Index: init.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/init.lisp,v retrieving revision 1.162 retrieving revision 1.163 diff -u -d -r1.162 -r1.163 --- init.lisp 22 Jul 2004 10:30:56 -0000 1.162 +++ init.lisp 30 Jul 2004 11:59:54 -0000 1.163 @@ -466,7 +466,9 @@ specializer-direct-generic-functions specializer-direct-methods eql-specializer-object intern-eql-specializer ;; MOP for methods - accessor-method-slot-definition + method standard-method + method-function method-generic-function method-lambda-list + method-specializers method-qualifiers accessor-method-slot-definition ;; MOP for method combinations find-method-combination ;; MOP for generic functions Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3356 retrieving revision 1.3357 diff -u -d -r1.3356 -r1.3357 --- ChangeLog 30 Jul 2004 11:58:43 -0000 1.3356 +++ ChangeLog 30 Jul 2004 11:59:54 -0000 1.3357 @@ -1,5 +1,12 @@ 2004-06-10 Bruno Haible <br...@cl...> + * init.lisp: Export method, standard-method, method-function, + method-generic-function, method-lambda-list, method-specializers, + method-qualifiers, accessor-method-slot-definition. + * clos-package.lisp: Likewise. + +2004-06-10 Bruno Haible <br...@cl...> + * clos-method1.lisp (standard-method): Renamed function slot to fast-function. Add function slot. (initialize-instance-<standard-method>): Accept either :function or --__--__-- Message: 2 From: Sam Steingold <sd...@us...> To: cli...@li... Subject: clisp/src ChangeLog,1.3357,1.3358 Date: Fri, 30 Jul 2004 13:12:01 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv5926/src Modified Files: ChangeLog Log Message: formatting Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3357 retrieving revision 1.3358 diff -u -d -r1.3357 -r1.3358 --- ChangeLog 30 Jul 2004 11:59:54 -0000 1.3357 +++ ChangeLog 30 Jul 2004 13:11:56 -0000 1.3358 @@ -12,8 +12,8 @@ (initialize-instance-<standard-method>): Accept either :function or fast-function argument. Rename :wants-next-method-p keyword to clos::wants-next-method-p. - * clos-methcomb2.lisp (method-list-to-continuation, - std-method-function-or-substitute): New functions. + * clos-methcomb2.lisp (method-list-to-continuation) + (std-method-function-or-substitute): New functions. (callable-method-form-p, call-method-arg2elements-error): New functions. (effective-method-code-bricks): Use callable-method-form-p. Generate @@ -24,8 +24,8 @@ result in the fast-function. Don't use the initfunction if there is a slow function. * clos-class3.lisp (install-class-direct-accessors): Update. - * clos-class5.lisp (shared-initialize, reinitialize-instance, - initialize-instance, allocate-instance, make-instance): Update. + * clos-class5.lisp (shared-initialize, reinitialize-instance) + (initialize-instance, allocate-instance, make-instance): Update. * clos-method2.lisp (analyze-method-description): Update. * clos-method3.lisp (initialize-instance@standard-method): Update. (method-function): New generic function. --__--__-- Message: 3 From: Sam Steingold <sd...@us...> To: cli...@li... Subject: clisp/utils modprep.lisp,1.11,1.12 Date: Fri, 30 Jul 2004 21:22:45 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/utils In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv30529/utils Modified Files: modprep.lisp Log Message: (print-tables-1): print the definition of "struct c_lisp_pair" outside of WITH-CONDITIONAL Index: modprep.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/utils/modprep.lisp,v retrieving revision 1.11 retrieving revision 1.12 diff -u -d -r1.11 -r1.12 --- modprep.lisp 23 Jul 2004 22:11:05 -0000 1.11 +++ modprep.lisp 30 Jul 2004 21:22:43 -0000 1.12 @@ -915,22 +915,21 @@ (newline out) (format out " return flags;") (newline out) (format out "}") (newline out))) (newline out) - (loop :with table-struct-printed-p = nil :for ch :across *checkers* + (loop :for ch :across *checkers* :for type-tag = (objdef-tag (checker-type-odef ch)) :for c-name = (checker-name ch) :for c-type = (checker-type ch) + :initially + (format out "struct c_lisp_pair {int c_const; gcv_object_t *l_const;};") + (newline out) (newline out) :do (with-conditional (out (checker-cond-stack ch)) - (unless table-struct-printed-p - (setq table-struct-printed-p t) - (format out "struct c_lisp_pair {int c_const; gcv_object_t *l_const;};") - (newline out) (newline out)) (format out "static struct c_lisp_pair ~A_table[] = {" c-name) (newline out) (loop :for name :in (checker-cpp-names ch) :for odef :in (checker-cpp-odefs ch) :do (unless c-type (format out " #ifdef ~A" name) (newline out)) - (format out " { ~A, &(O(~A)) }," name (objdef-tag odef)) - (newline out) - (unless c-type (format out " #endif") (newline out))) + (format out " { ~A, &(O(~A)) }," name (objdef-tag odef)) + (newline out) + (unless c-type (format out " #endif") (newline out))) (format out " { 0, NULL }") (newline out) (format out "};") (newline out) (format out "const uintL ~A_table_size = ((sizeof(~A_table)-1)/sizeof(struct c_lisp_pair));" c-name c-name) (newline out) --__--__-- Message: 4 From: Sam Steingold <sd...@us...> To: cli...@li... Subject: clisp/src ChangeLog,1.3358,1.3359 Date: Fri, 30 Jul 2004 21:22:47 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv30529/src Modified Files: ChangeLog Log Message: (print-tables-1): print the definition of "struct c_lisp_pair" outside of WITH-CONDITIONAL Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3358 retrieving revision 1.3359 diff -u -d -r1.3358 -r1.3359 --- ChangeLog 30 Jul 2004 13:11:56 -0000 1.3358 +++ ChangeLog 30 Jul 2004 21:22:43 -0000 1.3359 @@ -1,3 +1,8 @@ +2004-07-30 Sam Steingold <sd...@gn...> + + * utils/modprep.lisp (print-tables-1): print the definition + of "struct c_lisp_pair" outside of WITH-CONDITIONAL + 2004-06-10 Bruno Haible <br...@cl...> * init.lisp: Export method, standard-method, method-function, --__--__-- Message: 5 From: Sam Steingold <sd...@us...> To: cli...@li... Subject: clisp/src ChangeLog,1.3359,1.3360 Date: Fri, 30 Jul 2004 21:34:21 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv32094/src Modified Files: ChangeLog Log Message: (physical-memory): new function Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3359 retrieving revision 1.3360 diff -u -d -r1.3359 -r1.3360 --- ChangeLog 30 Jul 2004 21:22:43 -0000 1.3359 +++ ChangeLog 30 Jul 2004 21:34:18 -0000 1.3360 @@ -1,5 +1,16 @@ 2004-07-30 Sam Steingold <sd...@gn...> + * modules/syscalls/calls.c (POSIX:SYSCONF, POSIX:CONFSTR) + (POSIX:LIMITS): accept an optional `what' argument + (POSIX:MEMORY-STATUS) [win32]: new function + * modules/syscalls/posix.lisp (physical-memory): new function + (sysconf, confstr, limits) [unix]: removed structures + (memory-status) [win32]: new structure + * modules/syscalls/configure.in: check for GlobalMemoryStatusEx() + and setrlimit() + +2004-07-30 Sam Steingold <sd...@gn...> + * utils/modprep.lisp (print-tables-1): print the definition of "struct c_lisp_pair" outside of WITH-CONDITIONAL --__--__-- Message: 6 From: Sam Steingold <sd...@us...> To: cli...@li... Subject: clisp/modules/syscalls syscalls.xml,1.12,1.13 posix.lisp,1.12,1.13 configure.in,1.14,1.15 calls.c,1.39,1.40 Date: Fri, 30 Jul 2004 21:34:21 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/modules/syscalls In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv32094/modules/syscalls Modified Files: syscalls.xml posix.lisp configure.in calls.c Log Message: (physical-memory): new function Index: calls.c =================================================================== RCS file: /cvsroot/clisp/clisp/modules/syscalls/calls.c,v retrieving revision 1.39 retrieving revision 1.40 diff -u -d -r1.39 -r1.40 --- calls.c 29 Jul 2004 23:06:37 -0000 1.39 +++ calls.c 30 Jul 2004 21:34:19 -0000 1.40 @@ -348,162 +348,112 @@ #endif /* HAVE_UNAME */ #if defined(HAVE_SYSCONF) -DEFUN(POSIX::SYSCONF,) +DEFCHECKER(sysconf_arg, _SC_AIO_LISTIO_MAX _SC_AIO_MAX _SC_AIO_PRIO_DELTA_MAX \ + _SC_ARG_MAX _SC_ATEXIT_MAX _SC_BC_BASE_MAX _SC_BC_DIM_MAX \ + _SC_BC_SCALE_MAX _SC_BC_STRING_MAX _SC_CHILD_MAX _SC_CLK_TCK \ + _SC_COLL_WEIGHTS_MAX _SC_DELAYTIMER_MAX _SC_EXPR_NEST_MAX \ + _SC_HOST_NAME_MAX _SC_IOV_MAX _SC_LINE_MAX _SC_LOGIN_NAME_MAX \ + _SC_NGROUPS_MAX _SC_GETGR_R_SIZE_MAX _SC_GETPW_R_SIZE_MAX \ + _SC_MQ_OPEN_MAX _SC_MQ_PRIO_MAX _SC_OPEN_MAX _SC_ADVISORY_INFO \ + _SC_BARRIERS _SC_ASYNCHRONOUS_IO _SC_CLOCK_SELECTION _SC_CPUTIME \ + _SC_FSYNC _SC_IPV6 _SC_JOB_CONTROL _SC_MAPPED_FILES _SC_MEMLOCK \ + _SC_MEMLOCK_RANGE _SC_MEMORY_PROTECTION _SC_MESSAGE_PASSING \ + _SC_MONOTONIC_CLOCK _SC_PRIORITIZED_IO _SC_PRIORITY_SCHEDULING \ + _SC_RAW_SOCKETS _SC_READER_WRITER_LOCKS _SC_REALTIME_SIGNALS \ + _SC_REGEXP _SC_SAVED_IDS _SC_SEMAPHORES _SC_SHARED_MEMORY_OBJECTS \ + _SC_SHELL _SC_SPAWN _SC_SPIN_LOCKS _SC_SPORADIC_SERVER \ + _SC_SS_REPL_MAX _SC_SYNCHRONIZED_IO _SC_THREAD_ATTR_STACKADDR \ + _SC_THREAD_ATTR_STACKSIZE _SC_THREAD_CPUTIME \ + _SC_THREAD_PRIO_INHERIT _SC_THREAD_PRIO_PROTECT \ + _SC_THREAD_PRIORITY_SCHEDULING _SC_THREAD_PROCESS_SHARED \ + _SC_THREAD_SAFE_FUNCTIONS _SC_THREAD_SPORADIC_SERVER \ + _SC_THREADS _SC_TIMEOUTS _SC_TIMERS _SC_TRACE \ + _SC_TRACE_EVENT_FILTER _SC_TRACE_EVENT_NAME_MAX _SC_TRACE_INHERIT \ + _SC_TRACE_LOG _SC_TRACE_NAME_MAX _SC_TRACE_SYS_MAX \ + _SC_TRACE_USER_EVENT_MAX _SC_TYPED_MEMORY_OBJECTS _SC_VERSION \ + _SC_V6_ILP32_OFF32 _SC_V6_ILP32_OFFBIG _SC_V6_LP64_OFF64 \ + _SC_V6_LPBIG_OFFBIG _SC_2_C_BIND _SC_2_C_DEV _SC_2_CHAR_TERM \ + _SC_2_FORT_DEV _SC_2_FORT_RUN _SC_2_LOCALEDEF _SC_2_PBS \ + _SC_2_PBS_ACCOUNTING _SC_2_PBS_CHECKPOINT _SC_2_PBS_LOCATE \ + _SC_2_PBS_MESSAGE _SC_2_PBS_TRACK _SC_2_SW_DEV _SC_2_UPE \ + _SC_2_VERSION _SC_PAGESIZE _SC_PHYS_PAGES _SC_AVPHYS_PAGES \ + _SC_THREAD_DESTRUCTOR_ITERATIONS _SC_THREAD_KEYS_MAX \ + _SC_THREAD_STACK_MIN _SC_THREAD_THREADS_MAX _SC_RE_DUP_MAX \ + _SC_RTSIG_MAX _SC_SEM_NSEMS_MAX _SC_SEM_VALUE_MAX _SC_SIGQUEUE_MAX \ + _SC_STREAM_MAX _SC_SYMLOOP_MAX _SC_TIMER_MAX _SC_TTY_NAME_MAX \ + _SC_TZNAME_MAX _SC_XBS5_ILP32_OFF32 _SC_XBS5_ILP32_OFFBIG \ + _SC_XBS5_LP64_OFF64 _SC_XBS5_LPBIG_OFFBIG _SC_XOPEN_CRYPT \ + _SC_XOPEN_ENH_I18N _SC_XOPEN_LEGACY _SC_XOPEN_REALTIME \ + _SC_XOPEN_REALTIME_THREADS _SC_XOPEN_SHM _SC_XOPEN_STREAMS \ + _SC_XOPEN_UNIX _SC_XOPEN_VERSION \ + _SC_NPROCESSORS_CONF _SC_NPROCESSORS_ONLN) +DEFUN(POSIX::SYSCONF, &optional what) { /* Lisp interface to sysconf(3c) */ - long res; - -#define SC_S(cmd) \ - begin_system_call(); res = sysconf(cmd); end_system_call(); \ - pushSTACK(res == -1 ? T : L_to_I(res)); - -#if defined(_SC_PAGESIZE) - SC_S(_SC_PAGESIZE); -#else - pushSTACK(NIL); -#endif -#if defined(_SC_PHYS_PAGES) - SC_S(_SC_PHYS_PAGES); -#else - pushSTACK(NIL); -#endif -#if defined(_SC_AVPHYS_PAGES) - SC_S(_SC_AVPHYS_PAGES); -#else - pushSTACK(NIL); -#endif -#if defined(_SC_NPROCESSORS_CONF) - SC_S(_SC_NPROCESSORS_CONF); -#else - pushSTACK(NIL); -#endif -#if defined(_SC_NPROCESSORS_ONLN) - SC_S(_SC_NPROCESSORS_ONLN); -#else - pushSTACK(NIL); -#endif -#if defined(_SC_THREAD_THREADS_MAX) - SC_S(_SC_THREAD_THREADS_MAX); -#else - pushSTACK(NIL); -#endif -#undef SC_S - funcall(`POSIX::MAKE-SYSCONF`,6); + object what = popSTACK(); + if (!missingp(what)) { + int cmd = sysconf_arg(what), res; + begin_system_call(); res = sysconf(cmd); end_system_call(); + VALUES1(L_to_I(res)); + } else { /* all possible values */ + int pos = 0; + for (; pos < sysconf_arg_table_size; pos++) { + int res; + begin_system_call(); + res = sysconf(sysconf_arg_table[pos].c_const); + end_system_call(); + pushSTACK(*sysconf_arg_table[pos].l_const); + pushSTACK(L_to_I(res)); + } + VALUES1(listof(2*sysconf_arg_table_size)); + } } #endif /* HAVE_SYSCONF */ #if defined(HAVE_CONFSTR) -DEFUN(POSIX::CONFSTR,) +DEFCHECKER(confstr_arg,_CS_PATH _CS_POSIX_V6_ILP32_OFF32_CFLAGS \ + _CS_POSIX_V6_ILP32_OFF32_LDFLAGS _CS_POSIX_V6_ILP32_OFF32_LIBS \ + _CS_POSIX_V6_ILP32_OFFBIG_CFLAGS _CS_POSIX_V6_ILP32_OFFBIG_LDFLAGS \ + _CS_POSIX_V6_ILP32_OFFBIG_LIBS _CS_POSIX_V6_LP64_OFF64_CFLAGS \ + _CS_POSIX_V6_LP64_OFF64_LDFLAGS _CS_POSIX_V6_LP64_OFF64_LIBS \ + _CS_POSIX_V6_LPBIG_OFFBIG_CFLAGS _CS_POSIX_V6_LPBIG_OFFBIG_LDFLAGS \ + _CS_POSIX_V6_LPBIG_OFFBIG_LIBS _CS_POSIX_V6_WIDTH_RESTRICTED_ENVS \ + _CS_XBS5_ILP32_OFF32_CFLAGS _CS_XBS5_ILP32_OFF32_LDFLAGS \ + _CS_XBS5_ILP32_OFF32_LIBS _CS_XBS5_ILP32_OFF32_LINTFLAGS \ + _CS_XBS5_ILP32_OFFBIG_CFLAGS _CS_XBS5_ILP32_OFFBIG_LDFLAGS \ + _CS_XBS5_ILP32_OFFBIG_LIBS _CS_XBS5_ILP32_OFFBIG_LINTFLAGS \ + _CS_XBS5_LP64_OFF64_CFLAGS _CS_XBS5_LP64_OFF64_LDFLAGS \ + _CS_XBS5_LP64_OFF64_LIBS _CS_XBS5_LP64_OFF64_LINTFLAGS \ + _CS_XBS5_LPBIG_OFFBIG_CFLAGS _CS_XBS5_LPBIG_OFFBIG_LDFLAGS \ + _CS_XBS5_LPBIG_OFFBIG_LIBS _CS_XBS5_LPBIG_OFFBIG_LINTFLAGS) +DEFUN(POSIX::CONFSTR, &optional what) { /* Lisp interface to confstr(3c) */ - size_t res; - char buf[BUFSIZ]; - #define CS_S(cmd) \ begin_system_call(); res = confstr(cmd,buf,BUFSIZ); end_system_call(); \ if (res == 0) pushSTACK(T); \ - else if (res <= BUFSIZ) pushSTACK(asciz_to_string(buf,GLO(misc_encoding))); \ + else if (res <= BUFSIZ) value1 = asciz_to_string(buf,GLO(misc_encoding)); \ else { \ + char *tmp = alloca(res); \ begin_system_call(); \ - { char *tmp = alloca(res); \ - confstr(cmd,tmp,res); \ - end_system_call(); \ - pushSTACK(asciz_to_string(tmp,GLO(misc_encoding))); \ - }} + confstr(cmd,tmp,res); \ + end_system_call(); \ + value1 = asciz_to_string(tmp,GLO(misc_encoding)); \ + } -#if defined(_CS_PATH) - CS_S(_CS_PATH); -#else - pushSTACK(NIL); -#endif -#if defined(_CS_POSIX_V6_ILP32_OFF32_CFLAGS) - CS_S(_CS_POSIX_V6_ILP32_OFF32_CFLAGS); -#elif defined(_CS_XBS5_ILP32_OFF32_CFLAGS) - CS_S(_CS_XBS5_ILP32_OFF32_CFLAGS); -#else - pushSTACK(NIL); -#endif -#if defined(_CS_POSIX_V6_ILP32_OFF32_LDFLAGS) - CS_S(_CS_POSIX_V6_ILP32_OFF32_LDFLAGS); -#elif defined(_CS_XBS5_ILP32_OFF32_LDFLAGS) - CS_S(_CS_XBS5_ILP32_OFF32_LDFLAGS); -#else - pushSTACK(NIL); -#endif -#if defined(_CS_POSIX_V6_ILP32_OFF32_LIBS) - CS_S(_CS_POSIX_V6_ILP32_OFF32_LIBS); -#elif defined(_CS_XBS5_ILP32_OFF32_LIBS) - CS_S(_CS_XBS5_ILP32_OFF32_LIBS); -#else - pushSTACK(NIL); -#endif -#if defined(_CS_POSIX_V6_ILP32_OFFBIG_CFLAGS) - CS_S(_CS_POSIX_V6_ILP32_OFFBIG_CFLAGS); -#elif defined(_CS_XBS5_ILP32_OFFBIG_CFLAGS) - CS_S(_CS_XBS5_ILP32_OFFBIG_CFLAGS); -#else - pushSTACK(NIL); -#endif -#if defined(_CS_POSIX_V6_ILP32_OFFBIG_LDFLAGS) - CS_S(_CS_POSIX_V6_ILP32_OFFBIG_LDFLAGS); -#elif defined(_CS_XBS5_ILP32_OFFBIG_LDFLAGS) - CS_S(_CS_XBS5_ILP32_OFFBIG_LDFLAGS); -#else - pushSTACK(NIL); -#endif -#if defined(_CS_POSIX_V6_ILP32_OFFBIG_LIBS) - CS_S(_CS_POSIX_V6_ILP32_OFFBIG_LIBS); -#elif defined(_CS_XBS5_ILP32_OFFBIG_LIBS) - CS_S(_CS_XBS5_ILP32_OFFBIG_LIBS); -#else - pushSTACK(NIL); -#endif -#if defined(_CS_POSIX_V6_LP64_OFF64_CFLAGS) - CS_S(_CS_POSIX_V6_LP64_OFF64_CFLAGS); -#elif defined(_CS_XBS5_LP64_OFF64_CFLAGS) - CS_S(_CS_XBS5_LP64_OFF64_CFLAGS); -#else - pushSTACK(NIL); -#endif -#if defined(_CS_POSIX_V6_LP64_OFF64_LDFLAGS) - CS_S(_CS_POSIX_V6_LP64_OFF64_LDFLAGS); -#elif defined(_CS_XBS5_LP64_OFF64_LDFLAGS) - CS_S(_CS_XBS5_LP64_OFF64_LDFLAGS); -#else - pushSTACK(NIL); -#endif -#if defined(_CS_POSIX_V6_LP64_OFF64_LIBS) - CS_S(_CS_POSIX_V6_LP64_OFF64_LIBS); -#elif defined(_CS_XBS5_LP64_OFF64_LIBS) - CS_S(_CS_XBS5_LP64_OFF64_LIBS); -#else - pushSTACK(NIL); -#endif -#if defined(_CS_POSIX_V6_LPBIG_OFFBIG_CFLAGS) - CS_S(_CS_POSIX_V6_LPBIG_OFFBIG_CFLAGS); -#elif defined(_CS_XBS5_LPBIG_OFFBIG_CFLAGS) - CS_S(_CS_XBS5_LPBIG_OFFBIG_CFLAGS); -#else - pushSTACK(NIL); -#endif -#if defined(_CS_POSIX_V6_LPBIG_OFFBIG_LDFLAGS) - CS_S(_CS_POSIX_V6_LPBIG_OFFBIG_LDFLAGS); -#elif defined(_CS_XBS5_LPBIG_OFFBIG_LDFLAGS) - CS_S(_CS_XBS5_LPBIG_OFFBIG_LDFLAGS); -#else - pushSTACK(NIL); -#endif -#if defined(_CS_POSIX_V6_LPBIG_OFFBIG_LIBS) - CS_S(_CS_POSIX_V6_LPBIG_OFFBIG_LIBS); -#elif defined(_CS_XBS5_LPBIG_OFFBIG_LIBS) - CS_S(_CS_XBS5_LPBIG_OFFBIG_LIBS); -#else - pushSTACK(NIL); -#endif -#if defined(_CS_POSIX_V6_WIDTH_RESTRICTED_ENVS) - CS_S(_CS_POSIX_V6_WIDTH_RESTRICTED_ENVS); -#else - pushSTACK(NIL); -#endif - funcall(`POSIX::MAKE-CONFSTR`,14); + size_t res; + char buf[BUFSIZ]; + object what = popSTACK(); + if (!missingp(what)) { + int cmd = confstr_arg(what); + CS_S(cmd); mv_count = 1; + } else { /* all possible values */ + int pos = 0; + for (pos; pos < confstr_arg_table_size; pos++) { + CS_S(confstr_arg_table[pos].c_const); + pushSTACK(*confstr_arg_table[pos].l_const); + pushSTACK(value1); + } + VALUES1(listof(2*confstr_arg_table_size)); + } } #endif /* HAVE_CONFSTR */ @@ -550,79 +500,42 @@ } #endif /* HAVE_GETRUSAGE */ +DEFCHECKER(getrlimit_arg, RLIMIT_CPU RLIMIT_FSIZE RLIMIT_DATA RLIMIT_STACK \ + RLIMIT_CORE RLIMIT_RSS RLIMIT_NOFILE RLIMIT_AS RLIMIT_NPROC \ + RLIMIT_MEMLOCK RLIMIT_LOCKS) #if defined(HAVE_GETRLIMIT) -DEFUN(POSIX::LIMITS,) +DEFUN(POSIX::LIMITS, &optional what) { /* getrlimit(3) */ - #define RLIM(what) \ - begin_system_call(); getrlimit(what,&rl); end_system_call(); \ + begin_system_call(); \ + if (getrlimit(what,&rl)) OS_error(); \ + end_system_call(); \ pushSTACK(rl.rlim_cur == RLIM_INFINITY ? NIL : L_to_I(rl.rlim_cur)); \ - pushSTACK(rl.rlim_max == RLIM_INFINITY ? NIL : L_to_I(rl.rlim_max)); \ - funcall(`POSIX::MAKE-RLIMIT`,2); pushSTACK(value1) + pushSTACK(rl.rlim_max == RLIM_INFINITY ? NIL : L_to_I(rl.rlim_max)) struct rlimit rl; - -# if defined(RLIMIT_CPU) - RLIM(RLIMIT_CPU); -# else - pushSTACK(NIL); -# endif -# if defined(RLIMIT_FSIZE) - RLIM(RLIMIT_FSIZE); -# else - pushSTACK(NIL); -# endif -# if defined(RLIMIT_DATA) - RLIM(RLIMIT_DATA); -# else - pushSTACK(NIL); -# endif -# if defined(RLIMIT_STACK) - RLIM(RLIMIT_STACK); -# else - pushSTACK(NIL); -# endif -# if defined(RLIMIT_CORE) - RLIM(RLIMIT_CORE); -# else - pushSTACK(NIL); -# endif -# if defined(RLIMIT_RSS) - RLIM(RLIMIT_RSS); -# else - pushSTACK(NIL); -# endif -# if defined(RLIMIT_NOFILE) - RLIM(RLIMIT_NOFILE); -# else - pushSTACK(NIL); -# endif -# if defined(RLIMIT_AS) - RLIM(RLIMIT_AS); -# else - pushSTACK(NIL); -# endif -# if defined(RLIMIT_NPROC) - RLIM(RLIMIT_NPROC); -# else - pushSTACK(NIL); -# endif -# if defined(RLIMIT_MEMLOCK) - RLIM(RLIMIT_MEMLOCK); -# else - pushSTACK(NIL); -# endif -# if defined(RLIMIT_LOCKS) - RLIM(RLIMIT_LOCKS); -# else - pushSTACK(NIL); -# endif - -# undef RLIM - - funcall(`POSIX::MAKE-LIMITS`,11); + object what = popSTACK(); + if (!missingp(what)) { + int cmd = getrlimit_arg(what); + RLIM(cmd); + funcall(L(values),2); + } else { + int pos = 0; + for (; pos < getrlimit_arg_table_size; pos++) { + pushSTACK(*getrlimit_arg_table[pos].l_const); + RLIM(getrlimit_arg_table[pos].c_const); + funcall(`POSIX::MAKE-RLIMIT`,2); pushSTACK(value1); + } + VALUES1(listof(2*getrlimit_arg_table_size)); + } } #endif /* HAVE_GETRLIMIT */ +#if defined(HAVE_SETRLIMIT) +DEFUN(POSIX::SET-LIMITS, what cur max) +{ /* setrlimit(3) */ + NOTREACHED; +} +#endif /* HAVE_SETRLIMIT */ /* ==== SOCKETS ===== */ #if defined(HAVE_NETDB_H) @@ -1032,12 +945,15 @@ /* Pointers to functions unavailable on windows 95, 98, ME */ -typedef BOOL (WINAPI * CreateHardLinkFuncType) ( LPCTSTR lpFileName, LPCTSTR lpExistingFileName, +typedef BOOL (WINAPI * CreateHardLinkFuncType) + (LPCTSTR lpFileName, LPCTSTR lpExistingFileName, LPSECURITY_ATTRIBUTES lpSecurityAttributes); static CreateHardLinkFuncType CreateHardLinkFunc = NULL; -typedef BOOL (WINAPI * BackupWriteFuncType) (HANDLE hFile, LPBYTE lpBuffer, DWORD nNumberOfBytesToWrite, - LPDWORD lpNumberOfBytesWritten, BOOL bAbort, BOOL bProcessSecurity, LPVOID *lpContext); +typedef BOOL (WINAPI * BackupWriteFuncType) + (HANDLE hFile, LPBYTE lpBuffer, DWORD nNumberOfBytesToWrite, + LPDWORD lpNumberOfBytesWritten, BOOL bAbort, BOOL bProcessSecurity, + LPVOID *lpContext); static BackupWriteFuncType BackupWriteFunc = NULL; static HMODULE kernel32 = NULL; @@ -1912,4 +1828,32 @@ funcall(`POSIX::MAKE-VERSION`,9); } +DEFUN(POSIX::MEMORY-STATUS,) +{ /* interface to GlobalMemoryStatus() */ +#ifdef HAVE_GLOBALMEMORYSTATUSEX + MEMORYSTATUSEX ms; + ms.dwLength = sizeof(MEMORYSTATUSEX); + begin_system_call(); + if (!GlobalMemoryStatusEx(&ms)) OS_error(); + end_system_call(); + pushSTACK(UQ_to_I(ms.ullTotalPhys)); + pushSTACK(UQ_to_I(ms.ullAvailPhys)); + pushSTACK(UQ_to_I(ms.ullTotalPageFile)); + pushSTACK(UQ_to_I(ms.ullAvailPageFile)); + pushSTACK(UQ_to_I(ms.ullTotalVirtual)); + pushSTACK(UQ_to_I(ms.ullAvailVirtual)); +#else + MEMORYSTATUS ms; + ms.dwLength = sizeof(MEMORYSTATUS); + begin_system_call(); GlobalMemoryStatus(&ms); end_system_call(); + pushSTACK(UL_to_I(ms.dwTotalPhys)); + pushSTACK(UL_to_I(ms.dwAvailPhys)); + pushSTACK(UL_to_I(ms.dwTotalPageFile)); + pushSTACK(UL_to_I(ms.dwAvailPageFile)); + pushSTACK(UL_to_I(ms.dwTotalVirtual)); + pushSTACK(UL_to_I(ms.dwAvailVirtual)); +#endif + funcall(`POSIX::MKMEMSTAT`,6); +} + #endif Index: posix.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/modules/syscalls/posix.lisp,v retrieving revision 1.12 retrieving revision 1.13 diff -u -d -r1.12 -r1.13 --- posix.lisp 29 Jul 2004 23:06:36 -0000 1.12 +++ posix.lisp 30 Jul 2004 21:34:19 -0000 1.13 @@ -8,7 +8,7 @@ "RESOLVE-HOST-IPADDR" "BOGOMIPS" "STREAM-LOCK" "DUPLICATE-HANDLE" "COPY-FILE" "HOSTENT" "HOSTENT-NAME" "HOSTENT-ALIASES" "HOSTENT-ADDR-LIST" - "HOSTENT-ADDRTYPE" + "HOSTENT-ADDRTYPE" "PHYSICAL-MEMORY" "ERF" "ERFC" "J0" "J1" "JN" "Y0" "Y1" "YN" "GAMMA" "LGAMMA")) (setf (package-lock "EXT") nil) @@ -106,9 +106,7 @@ #+unix (progn (export '(uname uname-sysname uname-nodename uname-release uname-version uname-machine - sysconf sysconf-page-size sysconf-physical-pages - sysconf-physical-pages-available sysconf-num-processor-conf - sysconf-num-processor-online sysconf-max-threads-per-process)) + sysconf confstr)) (defstruct (uname (:constructor make-uname (sysname nodename release version machine))) @@ -118,70 +116,11 @@ (release "" :type simple-string :read-only t) (version "" :type simple-string :read-only t) (machine "" :type simple-string :read-only t)) -(defstruct (sysconf (:constructor - make-sysconf (page-size physical-pages - physical-pages-available - num-processor-conf num-processor-online - max-threads-per-process))) - "see sysconf(3c) for details" - (page-size nil :type (or null (eq t) (unsigned-byte 32)) :read-only t) - (physical-pages nil :type (or null (eq t) (unsigned-byte 32)) :read-only t) - (physical-pages-available nil :type (or null (eq t) (unsigned-byte 32)) - :read-only t) - (num-processor-conf nil :type (or null (eq t) (unsigned-byte 32)) - :read-only t) - (num-processor-online nil :type (or null (eq t) (unsigned-byte 32)) - :read-only t) - (max-threads-per-process nil :type (or null (eq t) (unsigned-byte 32)) - :read-only t)) - -(setf (documentation 'sysconf 'function) - "Return an instance of the SYSCONF structure. -NIL - no such key; T - sysconf(3c) returned -1.") - -(export - '(confstr confstr-path confstr-ilp32-off32-cflags confstr-ilp32-off32-ldflags - confstr-ilp32-off32-libs confstr-ilp32-offbig-cflags - confstr-ilp32-offbig-ldflags confstr-ilp32-offbig-libs - confstr-lp64-off64-cflags confstr-lp64-off64-ldflags - confstr-lp64-off64-libs confstr-lpbig-offbig-cflags - confstr-lpbig-offbig-ldflags confstr-lpbig-offbig-libs - confstr-width-restricted-envs)) -(defstruct (confstr (:constructor - make-confstr (path ilp32-off32-cflags ilp32-off32-ldflags - ilp32-off32-libs ilp32-offbig-cflags - ilp32-offbig-ldflags ilp32-offbig-libs - lp64-off64-cflags lp64-off64-ldflags - lp64-off64-libs lpbig-offbig-cflags - lpbig-offbig-ldflags lpbig-offbig-libs - width-restricted-envs))) - "see confstr(3c) for details" - (path nil :type (or boolean string) :read-only t) - (ilp32-off32-cflags nil :type (or boolean string) :read-only t) - (ilp32-off32-ldflags nil :type (or boolean string) :read-only t) - (ilp32-off32-libs nil :type (or boolean string) :read-only t) - (ilp32-offbig-cflags nil :type (or boolean string) :read-only t) - (ilp32-offbig-ldflags nil :type (or boolean string) :read-only t) - (ilp32-offbig-libs nil :type (or boolean string) :read-only t) - (lp64-off64-cflags nil :type (or boolean string) :read-only t) - (lp64-off64-ldflags nil :type (or boolean string) :read-only t) - (lp64-off64-libs nil :type (or boolean string) :read-only t) - (lpbig-offbig-cflags nil :type (or boolean string) :read-only t) - (lpbig-offbig-ldflags nil :type (or boolean string) :read-only t) - (lpbig-offbig-libs nil :type (or boolean string) :read-only t) - (width-restricted-envs nil :type (or boolean string) :read-only t)) - -(setf (documentation 'confstr 'function) - "Return an instance of the CONFSTR structure. -NIL - no such key; T - the parameter is not set.") ) ;;; ============================================================ #+unix (progn (export - '(rlimit rlimit-cur rlimit-max - limits limits-cpu limits-file-size limits-data-size limits-stack limits-core - limits-rss limits-num-files limits-address-space limits-num-proc - limits-memlock limits-locks + '(rlimit rlimit-cur rlimit-max limits usage usage-user-time usage-system-time usage-max-rss usage-shared-memory usage-data-memory usage-stack-memory usage-minor-page-faults usage-major-page-faults usage-num-swaps @@ -194,22 +133,6 @@ (cur nil :type (or null (unsigned-byte 32)) :read-only t) (max nil :type (or null (unsigned-byte 32)) :read-only t)) -(defstruct (limits (:constructor make-limits (cpu file-size data-size stack - core rss num-files address-space - num-proc memlock locks))) - "see getrlimit(2) for details" - (cpu nil :type (or null rlimit) :read-only t) - (file-size nil :type (or null rlimit) :read-only t) - (data-size nil :type (or null rlimit) :read-only t) - (stack nil :type (or null rlimit) :read-only t) - (core nil :type (or null rlimit) :read-only t) - (rss nil :type (or null rlimit) :read-only t) - (num-files nil :type (or null rlimit) :read-only t) - (address-space nil :type (or null rlimit) :read-only t) - (num-proc nil :type (or null rlimit) :read-only t) - (memlock nil :type (or null rlimit) :read-only t) - (locks nil :type (or null rlimit) :read-only t)) - (defstruct (usage (:constructor make-usage (user-time system-time max-rss shared-memory data-memory stack-memory @@ -314,8 +237,33 @@ (suites nil :read-only t) (product-type nil :read-only t)) +(export '(memory-status + memstat-total-physical memstat-avail-physical memstat-total-page + memstat-avail-page memstat-total-virtual memstat-avail-virtual)) + +(defstruct (memory-status + (:conc-name memstat-) + (:constructor mkmemstat + (total-physical avail-physical total-page + avail-page total-virtual avail-virtual))) + (total-physical 0 :type (integer 0) :read-only t) + (avail-physical 0 :type (integer 0) :read-only t) + (total-page 0 :type (integer 0) :read-only t) + (avail-page 0 :type (integer 0) :read-only t) + (total-virtual 0 :type (integer 0) :read-only t) + (avail-virtual 0 :type (integer 0) :read-only t)) + ) +(defun physical-memory () + "Return 2 values: TOTAL and AVAILABLE physical memory." + #+unix (let ((page-size (sysconf :_SC_PAGESIZE))) + (values (* page-size (sysconf :_SC_PHYS_PAGES)) + (* page-size (sysconf :_SC_AVPHYS_PAGES)))) + #+win32 (let ((mem-stat (memory-status))) + (values (memstat-total-physical mem-stat) + (memstat-avail-physical mem-stat)))) + ;;; restore locks (push "POSIX" *system-package-list*) (setf (package-lock *system-package-list*) t) Index: syscalls.xml =================================================================== RCS file: /cvsroot/clisp/clisp/modules/syscalls/syscalls.xml,v retrieving revision 1.12 retrieving revision 1.13 diff -u -d -r1.12 -r1.13 --- syscalls.xml 19 Jul 2004 22:44:04 -0000 1.12 +++ syscalls.xml 30 Jul 2004 21:34:19 -0000 1.13 @@ -169,17 +169,21 @@ role="sexp">(<function>POSIX:UNAME</function>)</literal></term> <listitem><simpara>Return a structure describing the OS, derived from &uname;.</simpara></listitem></varlistentry> - <varlistentry><term><literal - role="sexp">(<function>POSIX:SYSCONF</function>)</literal></term> - <term><literal - role="sexp">(<function>POSIX:CONFSTR</function>)</literal></term> - <listitem><simpara>Return a structure describing the system - configuration, derived from &sysconf; and &confstr; respectively. + <varlistentry> + <term><literal role="sexp">(<function>POSIX:SYSCONF</function> + &optional-amp; &what-r;)</literal></term> + <term><literal role="sexp">(<function>POSIX:CONFSTR</function> + &optional-amp; &what-r;)</literal></term> + <listitem><simpara>Return the specified configuration parameter or a + list of all available parameters (when &what-r; is missing or + &nil;), by calling &sysconf; and &confstr; respectively. + </simpara></listitem></varlistentry> + <varlistentry><term><literal role="sexp">(<function>POSIX:LIMITS</function> + &optional-amp; &what-r;)</literal></term> + <listitem><simpara>Return the current and the maximal limits as two + values when &what-r; is specified or a list of all available limits + when &what-r; is missing or &nil;, by calling &getrlimit;. </simpara></listitem></varlistentry> - <varlistentry><term><literal - role="sexp">(<function>POSIX:LIMITS</function>)</literal></term> - <listitem><simpara>Return a structure describing the resource limits, - derived from &getrlimit;.</simpara></listitem></varlistentry> <varlistentry><term><literal role="sexp">(<function>POSIX:USAGE</function>)</literal></term> <listitem><simpara>Return 2 structures describing the resource usage by @@ -283,6 +287,9 @@ <varlistentry><term><literal role="sexp">(OS:VERSION)</literal></term> <listitem><simpara>Return &win32; version information in a <type>VERSION</type> structure.</simpara></listitem></varlistentry> + <varlistentry><term><literal role="sexp">(OS:MEMORY-STATUS)</literal></term> + <listitem><simpara>Return &win32; memory status information in a + <type>MEMORY-STATUS</type> structure.</simpara></listitem></varlistentry> <varlistentry><term><literal role="sexp">(POSIX:CRYPT &key-r; <replaceable>salt</replaceable>)</literal></term> <listitem><simpara>Call &crypt;, arguments are &string-t;s. @@ -296,6 +303,10 @@ <literal role="type">(&vector; (&unsigned-byte-t; 8) 8)</literal>. <replaceable>decrypt-p</replaceable> is &boolean-t;. </simpara></listitem></varlistentry> + <varlistentry><term><literal role="sexp">(OS:PHYSICAL-MEMORY)</literal></term> + <listitem><simpara>Return 2 values: total and available physical memory. + </simpara><simpara>Works on both &unix; and &win32;. + </simpara></listitem></varlistentry> </variablelist> </section> Index: configure.in =================================================================== RCS file: /cvsroot/clisp/clisp/modules/syscalls/configure.in,v retrieving revision 1.14 retrieving revision 1.15 diff -u -d -r1.14 -r1.15 --- configure.in 7 May 2004 15:33:28 -0000 1.14 +++ configure.in 30 Jul 2004 21:34:19 -0000 1.15 @@ -31,7 +31,8 @@ fi AC_MSG_NOTICE([ * System Calls (Functions)]) -AC_CHECK_FUNCS(clock confstr fcntl gethostent getrusage getrlimit sysconf uname) +AC_CHECK_FUNCS(clock confstr fcntl gethostent getrusage sysconf uname) +AC_CHECK_FUNCS(getrlimit setrlimit) AC_CHECK_FUNCS(getlogin getpwent getpwnam getpwuid getuid) AC_CHECK_FUNCS(fchmod fchown fstat link lstat stat symlink utimes) AC_CHECK_FUNCS(mknod chmod chown umask) @@ -41,6 +42,7 @@ AC_CHECK_DECLS(signgam, , , [#include <math.h>] ) AC_SEARCH_LIBS(crypt, crypt) AC_CHECK_FUNCS(crypt encrypt setkey) +AC_CHECK_FUNCS(GlobalMemoryStatusEx) AC_MSG_NOTICE([ * System Calls (output)]) AC_CONFIG_FILES(Makefile link.sh) --__--__-- _______________________________________________ clisp-cvs mailing list cli...@li... https://lists.sourceforge.net/lists/listinfo/clisp-cvs End of clisp-cvs Digest |