Changeset 15816 in project


Ignore:
Timestamp:
09/09/09 10:09:01 (10 years ago)
Author:
Kon Lovett
Message:

Begin of "module" (actually loaded .so) introspection. Reminder about 'normalize-pathname' problem with absolute pathnames.

Location:
chicken/trunk
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • chicken/trunk/chicken.h

    r15659 r15816  
    14501450C_fctexport C_word C_dbg_hook(C_word x);
    14511451
     1452C_fctexport void C_loaded_modules( C_word c, C_word closure, C_word k ) C_noret;
     1453C_fctexport void C_module_procedures( C_word c, C_word closure, C_word k, C_char *modnam ) C_noret;
     1454
    14521455C_fctimport void C_ccall C_toplevel(C_word c, C_word self, C_word k) C_noret;
    14531456C_fctexport void C_ccall C_stop_timer(C_word c, C_word closure, C_word k) C_noret;
  • chicken/trunk/files.scm

    r15813 r15816  
    362362        (get-environment-variable get-environment-variable)
    363363        (reverse reverse)
    364         (display display))
    365     (lambda (path #!optional (platform (if (memq (build-platform) '(msvc mingw32)) 'windows 'unix)))
     364        (display display)
     365        (bldplt (if (memq (build-platform) '(msvc mingw32)) 'windows 'unix)) )
     366    (define (addpart part parts)
     367      (cond ((string=? "." part)        parts )
     368            ((string=? ".." part)       (if (null? parts) '("..") (cdr parts)) )
     369            (else                       (cons part parts) ) ) )
     370    (lambda (path #!optional (platform bldplt))
    366371      (let ((sep (if (eq? platform 'windows) #\\ #\/)))
    367         (define (addpart part parts)
    368           (cond ((string=? "." part) parts)
    369                 ((string=? ".." part)
    370                  (if (null? parts)
    371                      '("..")
    372                      (cdr parts)))
    373                 (else (cons part parts))))
    374372        (##sys#check-string path 'normalize-pathname)
     373
     374        ;(absolute-pathname-root path)
     375
    375376        (let ((len (##sys#size path))
    376377              (abspath #f)
     
    412413                   (set! drive (##sys#substring path 0 (fx+ i 1)))
    413414                   (loop (fx+ i 1) (fx+ i 1) '()))
    414                   (else (loop (fx+ i 1) prev parts)))))))))
     415                  (else (loop (fx+ i 1) prev parts)) ) ) ) ) ) ) )
    415416
    416417
  • chicken/trunk/library.scm

    r15700 r15816  
    214214(define-foreign-variable main_argv c-pointer "C_main_argv")
    215215(define-foreign-variable strerror c-string "strerror(errno)")
     216
     217(define ##sys#loaded-modules (##core#primitive "C_loaded_modules"))
     218(define ##sys#module-procedures (##core#primitive "C_module_procedures"))
    216219
    217220(define (set-gc-report! flag) (##core#inline "C_set_gc_report" flag))
  • chicken/trunk/runtime.c

    r15742 r15816  
    19131913
    19141914
     1915void C_ccall
     1916C_loaded_modules( C_word c, C_word closure, C_word k )
     1917{
     1918  LF_LIST *np;
     1919  C_word mods = C_SCHEME_END_OF_LIST;
     1920  for( np = lf_list; np; np = np->next ) {
     1921    if( np->module_name ) {
     1922      C_word str = C_string( C_heaptop, strlen( np->module_name ), np->module_name );
     1923      mods = C_pair( C_heaptop, str, mods );
     1924    }
     1925  }
     1926  C_kontinue( k, mods );
     1927}
     1928
     1929
     1930void C_ccall
     1931C_module_procedures( C_word c, C_word closure, C_word k, C_char *modnam )
     1932{
     1933  LF_LIST *mod;
     1934  C_word prcs = C_SCHEME_END_OF_LIST;
     1935#if 0
     1936  for( mod = find_module_handle( XXX( modnam ) ) ; mod; mod = mod->next ) {
     1937    C_PTABLE_ENTRY *pt = mod->ptable;
     1938    if( pt ) {
     1939      for( ; pt->id; ++pt ) {
     1940        C_word str = C_string( C_heaptop, strlen( pt->id ), pt->id );
     1941        prcs = C_pair( C_heaptop, str, prcs );
     1942      }
     1943    }
     1944  }
     1945#endif
     1946  C_kontinue( k, prcs );
     1947}
     1948
     1949
    19151950void C_unregister_lf(void *handle)
    19161951{
Note: See TracChangeset for help on using the changeset viewer.