home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 254b.lha / AMXLISP_v2.0 / lsp / defamiga.lsp < prev    next >
Lisp/Scheme  |  1989-05-09  |  2KB  |  79 lines
  1. ;the initialization of 'exec library'
  2. ;must be hand-coded
  3. ;in fact, there is no problem, since we have its base in absolute adress 4
  4. (setq exec (list (cons 'base (memory-long 4))))
  5.  
  6. ;(openlibrary 'intuition)
  7. (defun openlibrary (lib)
  8.    (if (boundp lib)
  9.        (cassoc 'base (Eval lib))
  10.        (set lib (list (cons 'base
  11.                             (callamiga 'OpenLibrary exec
  12.                                        (strcat (string-downcase (symbol-name lib))
  13.                                                ".library")
  14.                                        0))))))
  15.  
  16.  
  17. ;(callamiga "OpenWindow" intuition <window>)
  18. ;(callasm offset base lreg larg)
  19. ; Error code = 1163022930 from callasm !
  20. (defun callamiga (fname lib &rest larg)
  21.    (let ((finfo (cassoc fname lib)))
  22.       (unless finfo (error "Unknown function" fname))
  23.    (let ((result
  24.    (callasm (car finfo)
  25.             (cassoc 'base lib)
  26.             (cdr finfo)
  27.             (mapcar (lambda (arg)
  28.                         (cond ((objectp arg) (send arg :ptr))
  29.                               (t arg)))
  30.                     larg))))
  31.       (if (equal result 1163022930)
  32.           (error "Bad parameter list in Callasm")
  33.           result))))
  34.  
  35.  
  36.  
  37.  
  38. (setq fd-path "fd:")
  39. (setq fd-suffix ".fd")
  40.  
  41. ;(defamiga 'OpenLibrary 'exec)
  42. (defun defamiga (fname lib)
  43.    (let ((handle (open (strcat fd-path (symbol-name lib) fd-suffix))))
  44.         (when (null handle)
  45.               (error "Unknown library:" (Symbol-name lib)))
  46.         (do ((l (read handle) (read handle)))  ; (<sym> <init> <step>)
  47.             ((or (eq (car l) fname)
  48.                  (null l))                     ; <texpr>
  49.              (if (null l)
  50.                  (progn (close handle)
  51.                         (error "Function not found" fname))
  52.                  (progn (if (not (boundp lib))
  53.                             (openlibrary lib))
  54.                         (unless (cassoc fname (eval lib))
  55.                         (set lib (cons l (eval lib))))))  ;fin du if
  56.                   ))))
  57.  
  58.  
  59.  
  60. (defamiga 'openlibrary 'exec)
  61. (defamiga 'closelibrary 'exec)
  62.  
  63. (defun explode-string (s)
  64.    (let ((l ()))
  65.         (dotimes (i (length s))
  66.                  (setq l (cons (char s i) l)))
  67.         (reverse l)))
  68. (defun implode-string (l)
  69.    (let ((s ""))
  70.         (mapc (lambda (ch)
  71.                  (setq s (strcat s (String ch))))
  72.              l)
  73.         s))
  74.  
  75. ;XLISP 1.7    : we now use string-downcase
  76. ;(defun lowascii (s)
  77. ;   (implode-string (mapcar (lambda (x) (+ x 32)) (explode-string s))))
  78.  
  79.