home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / lisp / interpre / xlispos2 / crtlib.lsp < prev    next >
Encoding:
Text File  |  1992-06-26  |  2.6 KB  |  72 lines
  1. ; crtlib.lsp -- run-time dynamic linking to C 5.1 CRTLIB.DLL
  2. ; for OS2XLISP
  3. ; Andrew Schulman 1-May-1988
  4.  
  5. (if (define crtlib (loadmodule "crtlib"))
  6.     (princ "Run-time dynamic linking to CRTLIB.DLL\n")
  7.     (error "This program requires CRTLIB.DLL (from C 5.1)"))
  8.         
  9. (define crtlib.malloc (getprocaddr crtlib "_malloc"))
  10. (define crtlib.free (getprocaddr crtlib "_free"))
  11. (define crtlib.memcpy (getprocaddr crtlib "_memcpy"))
  12. (define crtlib.memset (getprocaddr crtlib "_memset"))
  13. (define crtlib.strlen (getprocaddr crtlib "_strlen"))
  14. (define crtlib.strcpy (getprocaddr crtlib "_strcpy"))
  15. (define crtlib.strstr (getprocaddr crtlib "_strstr"))
  16. (define crtlib.ultoa (getprocaddr crtlib "_ultoa"))
  17. (define crtlib.tolower (getprocaddr crtlib "_tolower"))
  18. (define crtlib.getcwd (getprocaddr crtlib "_getcwd"))
  19. (define crtlib.remove (getprocaddr crtlib "_remove"))
  20.  
  21. (define (malloc i) (c-call crtlib.malloc i 'ptr))
  22. (define (free p) (c-call crtlib.free p))
  23. (define (memcpy s t i) (c-call crtlib.memcpy s t i 'ptr))
  24. (define (memset s t i) (c-call crtlib.memset s t i 'ptr))
  25. (define (strcpy s t) (c-call crtlib.strcpy s t 'str))
  26. (define (strstr s t) (c-call crtlib.strstr s t 'ptr))
  27. (define (ultoa v s r) (c-call crtlib.ultoa v s r 'str))
  28. (define (tolower c) (c-call crtlib.tolower c))
  29. (define (strlen s) (c-call crtlib.strlen s))
  30. (define (pwd buf) (c-call crtlib.getcwd buf (length buf) 'str))
  31. (define (remove f) (c-call crtlib.remove f))
  32.  
  33. ;;; NOTE THAT ALL C CALLS BELOW ARE "TRANSPARENT"
  34.         
  35. (define ptr (malloc 50))
  36. (define msg "this is a test of memcpy")
  37. (memcpy ptr msg (1+ (strlen msg)))    ; copy the zero as well
  38. (format stdout "After memcpy: ptr is \"~A\"\n" (peek ptr 0))
  39.  
  40. (define ptr2 (malloc 50))
  41. (strcpy ptr2 "this is a test of strcpy")
  42. (format stdout "After strcpy: ptr2 is \"~A\"\n" (peek ptr2 0))
  43.  
  44. (define cmp (strstr ptr2 "test"))
  45. (format stdout "strstr returns \"~A\": index ~A\n"
  46.     (peek cmp 0) (- cmp ptr2))
  47.         
  48. (define ptr3 (malloc 30))
  49. (memset ptr3 (word 32) (word 29))
  50. (poke (+ ptr3 29) 0)        ; make ASCIIZ string 
  51. (format stdout "After memset: ptr3 is \"~A\"\n" (peek ptr3 0))
  52.  
  53. (ultoa #xfefe ptr3 (word 10))
  54. (format stdout "After ultoa: #xfefe is ~A " (peek ptr3 0))
  55. (ultoa #xfefe ptr3 (word 2))
  56. (format stdout "(binary ~A)\n" (peek ptr3 0))
  57.  
  58. (format stdout "strlen(\"~A\") is ~A\n" "hello" (strlen "hello"))
  59.  
  60. (define *word-format* nil)
  61.  
  62. (format stdout "tolower(~A) is ~A\n" (int-char 65) (int-char (tolower 65)))
  63.  
  64. (define buf (make-string (int-char 32) 128))
  65. (format stdout "PWD: ~A\n" (pwd buf))
  66.  
  67. (free ptr)
  68. (free ptr2)
  69. (free ptr3)
  70.  
  71. (freemodule crtlib)
  72.