LISP函数的指针

yxpxa

这几天闲的无聊，突然发现所有的 lisp 函数都是有指针的

比如：(princ setq) #<SUBR @000000003364d520 SETQ>

那个 @ 后面跟的就是 16 进制的指针，代表 setq 函数存储在内存里的地址

而且，64 位 CAD 存储了 64 个 2 进制，也就是 16 个 16 进制
32 位 CAD 存储了 32 位 2 进制，也就是 8 个 16 进制

利用这个规律可以判断 CAD 是 64 位还是 32 位，代码如下：

1. ;;CAD 位数判断，如果是 64 位返回 t，否则返回 nil
   
2. (defun isACAD64 ()
   
3.   (= 17
   
4.      (strlen
   
5.        (vl-prin1-to-string
   
6.          (cadr (read (strcat "(" (vl-prin1-to-string +) ")")))
   
7.        )
   
8.      )
   
9.   )
   
10. )
    

;;CAD 位数判断，如果是 64 位返回 t，否则返回 nil<br /> (defun isACAD64 ()<br />   (= 17<br />      (strlen<br />        (vl-prin1-to-string<br />          (cadr (read (strcat "(" (vl-prin1-to-string +) ")")))<br />        )<br />      )<br />   )<br /> )<br />

同样，定义了一个 defun 函数也可以得到该函数的指针，再利用 Windows API 调用这个函数
使用时需要将 16 进制的指针转换为 10 进制，代码如下：

1. ;;查询任意 lisp 函数的指针, 示例： (getPtrs setq)
   
2. (defun getPtrs (cm / hex ss m n sum)
   
3.   (setq hex '(("F" . 15)
   
4.               ("E" . 14)
   
5.               ("D" . 13)
   
6.               ("C" . 12)
   
7.               ("B" . 11)
   
8.               ("A" . 10)
   
9.               ("9" . 9)
   
10.               ("8" . 8)
    
11.               ("7" . 7)
    
12.               ("6" . 6)
    
13.               ("5" . 5)
    
14.               ("4" . 4)
    
15.               ("3" . 3)
    
16.               ("2" . 2)
    
17.               ("1" . 1)
    
18.               ("0" . 0)
    
19.              )
    
20.   )
    
21.   (if (= 'SUBR (type cm))
    
22.     (progn (setq ss  (substr (vl-prin1-to-string cm)
    
23.                              9
    
24.                              (if (isACAD64)
    
25.                                16
    
26.                                8
    
27.                              )
    
28.                      )
    
29.                  ss  (strcase ss)
    
30.                  n   (strlen ss)
    
31.                  m   0
    
32.                  sum 0
    
33.            )
    
34.            (while (> n 0)
    
35.              (setq sum (+ (* (cdr (assoc (substr ss n 1) hex)) (expt 16 m)) sum)
    
36.                    n   (1- n)
    
37.                    m   (1+ m)
    
38.              )
    
39.            )
    
40.            sum
    
41.     )
    
42.   )
    
43. )
    

;;查询任意 lisp 函数的指针, 示例： (getPtrs setq)<br /> (defun getPtrs (cm / hex ss m n sum)<br />   (setq hex '(("F" . 15)<br />               ("E" . 14)<br />               ("D" . 13)<br />               ("C" . 12)<br />               ("B" . 11)<br />               ("A" . 10)<br />               ("9" . 9)<br />               ("8" . 8)<br />               ("7" . 7)<br />               ("6" . 6)<br />               ("5" . 5)<br />               ("4" . 4)<br />               ("3" . 3)<br />               ("2" . 2)<br />               ("1" . 1)<br />               ("0" . 0)<br />              )<br />   )<br />   (if (= 'SUBR (type cm))<br />     (progn (setq ss  (substr (vl-prin1-to-string cm)<br />                              9<br />                              (if (isACAD64)<br />                                16<br />                                8<br />                              )<br />                      )<br />                  ss  (strcase ss)<br />                  n   (strlen ss)<br />                  m   0<br />                  sum 0<br />            )<br />            (while (> n 0)<br />              (setq sum (+ (* (cdr (assoc (substr ss n 1) hex)) (expt 16 m)) sum)<br />                    n   (1- n)<br />                    m   (1+ m)<br />              )<br />            )<br />            sum<br />     )<br />   )<br /> )<br />

例如，API 定时器
Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
第一个参数 hWnd 代表当前父窗口的句柄，默认为 0
第二个参数 nIDEvent 是定时器的编号，可以从 1 开始
第三个参数是定期激发的时间间隔，单位毫秒
第四个参数是回调函数的指针。
这样，调用 SetTimer API 函数可以完美实现 lisp 的多线程和定时器效果。
试验一下 dwx 调用 API ？

LISP+DWX 之二：结构类型与传址参数


问题
lisp 基本数据类型有整型、实型、字符型、表等，其中表是最主要的数据类型，lisp也因此而得名。
而在 API 函数中有大量的结构类型（这是来自 C、C++ 的叫法），那么结构体如何与 lisp 交换数据？

解决方法
lisp 函数调用时，我们通常都是用传值的方式（ByVal），调用后并不影响参数本来的值。
例如 (setq a 2)(sqrt a) 将 a 值传给运算函数 sqrt，得到 1.414 的返回值，不用担心参数 a 值改变。
在 lisp+dwx 中，可以先分配一块内存，并将地址传给 API 函数，我们称这种方式为传址（ByRef），
然后通过分析返回值在内存里的数据结构，得到我们想要的东西。

示例
API函数： 获取鼠标指针的当前位置，在 VB 中声明语法如下
Declare Function GetCursorPos Lib "user32" Alias "GetCursorPos" (lpPoint As POINTAPI) As Long
这个函数用 lpPoint 来接收当前鼠标位置的信息，lpPoint 是一个结构变量，记录了鼠标在屏幕上的坐标，
在 VB 中可以轻松的定义一个 POINTAPI 类型
        Private Type POINTAPI
                X As Long
                Y As Long
        End type
需要 x，y 值的时候，用 POINTAPI.x， POINTAPI.y 即可表示，这是面向对象的数据结构

但是 lisp 中没有 Type 型数据，用 dwx 解决如下:

;;创建 dwx 对象
(setq dwx (vlax-create-object "DynamicWrapperX"))

;;将 API 函数绑定（注册）为 dwx 的方法
;;说明： i=p 表示输入一个参数， p 为指针类型； 这里我们准备用内存块的地址来响应，因此是 p 类型
;;r=l 表示返回一个参数， l 是长整型；根据 API 说明，返回 1 代表成功，0 代表失败
(vlax-invoke dwx 'Register "user32" "GetCursorPos" "i=p" "r=l")

;;分配一块内存充当结构体，用内存块的指针作为结构体的参数
;;说明： MemAlloc 方法分配 20 个字节够存储坐标，实际上 8 个字节就够了，但我的电脑有 16GB 的内存。
;;参数 1 表示将新开辟的内存块全部归零，返回值 nP 是新分配内存地址，称为内存指针存入 nP 变量
(setq nP (vlax-invoke dwx 'MemAlloc 20 1))

;;API 函数调用后，np 指向的内存值就会发生变化
(vlax-invoke dwx 'GetCursorPos nP)

但是我们并不知道像素坐标 x，y 值在内存块里是怎么存储的，可以假设是这么存储的
0000xxxx00000yyyy00000000

验证测试，先读两个字节，n 为短整型，占 2 字节
(vlax-invoke dwx 'NumGet nP 0 "n")
返回值 765 ，看来我们已经得到了 x 的像素；跳过 2 字节，继续读内存，返回 0
(vlax-invoke dwx 'NumGet nP 2 "n")

继续跳过 2 字节，得到 y 坐标 978
(vlax-invoke dwx 'NumGet nP 4 "n")

这说明了像素坐标 x，y 的结构体在内存里占 4 个字节是 "l" 类型，而且是数字倒着存储的，
细思极妙，这样能更有效的读入数据，不至于一开始先读入一堆 0

765 占 2 字节 00000010 11111101
978 占 2 字节 11010010 00000011

按我们的猜想将 x y 按字节颠倒一下，可以得出鼠标位置在内存存储为：
11111101 00000010 00000000 00000000 11010010 00000011 00000000 00000000

继续验证，读入该块内存块的前 10 个字节，返回 16 进制的字符串（hex值）
(vlax-invoke dwx 'MemRead nP 10)
得到 "FD020000D20300000000"  将 16 进制转换为二进制，发现两者完全相同。

1. ;;获取当前鼠标在 Windows 系统里的坐标位置
   
2. (defun c:GetCurPos (/ dwx)
   
3.   (setq dwx (vlax-create-object "DynamicWrapperX"))
   
4.   (vlax-invoke
   
5.     dwx 'Register "user32" "GetCursorPos" "i=p" "r=l"
   
6.    )
   
7.   (setq nP (vlax-invoke dwx 'MemAlloc 8 1))
   
8.   (vlax-invoke dwx 'GetCursorPos nP)
   
9.   (princ "\n当前鼠标位置（左上角为0,0）左距:")
   
10.   (princ (vlax-invoke dwx 'NumGet nP 0 "l"))
    
11.   (princ ",上距:")
    
12.   (princ (vlax-invoke dwx 'NumGet nP 4 "l"))
    
13.   (vlax-release-object dwx)
    
14.   (princ)
    
15. )
    

;;获取当前鼠标在 Windows 系统里的坐标位置<br /> (defun c:GetCurPos (/ dwx)<br />   (setq dwx (vlax-create-object "DynamicWrapperX"))<br />   (vlax-invoke<br />     dwx 'Register "user32" "GetCursorPos" "i=p" "r=l"<br />    )<br />   (setq nP (vlax-invoke dwx 'MemAlloc 8 1))<br />   (vlax-invoke dwx 'GetCursorPos nP)<br />   (princ "\n当前鼠标位置（左上角为0,0）左距:")<br />   (princ (vlax-invoke dwx 'NumGet nP 0 "l"))<br />   (princ ",上距:")<br />   (princ (vlax-invoke dwx 'NumGet nP 4 "l"))<br />   (vlax-release-object dwx)<br />   (princ)<br /> )<br />

附件
1. dwx 函数语法详见：http://dynwrapx.script-coding.com/dwx/pages/dynwrapx.php?lang=en
2. dwx 数据类型，包括输入参数 i （input）和返回值参数 r （return）的类型

m — 双长整型，默认是有符号的，占 8 字节 64 位，整数，包括 LONGLONG 等
q — 无符号双长整型（无负整数），占 8 字节 64 位 64 位，整数，有 ULONGLONG 等
l — 长整型，占 4 字节 32 位，整数，有 LONG, INT, BOOL 等
u — 无符号长整型，占 4 字节 32 位，整数，有 ULONG, UINT, DWORD 等
h — 句柄，整数，32 位系统占 32 个位， 64 位系统占 64 位，包括 HANDLE, HWND, HMODULE, HINSTANCE, HICON,
p — 指针，整数，对于数字，它与 u（x86）或 q（x64）相同，也可以用于传递对象或字符串
n — 短整型，占 2 字节 16 位，整数，包括 SHORT 类型
t — 无符号短整型，占 2 字节 16 位，整数，包括 USHORT, WORD, WCHAR, OLECHAR 类型
c — 字符型，1 字节，整数，包括 CHAR
b — 无符号字符型，1 字节，整数，包括 UCHAR, BYTE
f — 单精度，占 4 字节 32 位，浮点数，包括 FLOAT
d — 双精度，占 8 字节 64 位，浮点数，包括 DOUBLE
w — Unicode 字符串，包括：BSTR, LPWSTR, LPOLESTR, OLECHAR *, WCHAR * 等
s — ANSI 字符串 (默认 codepage)，LPSTR, LPCSTR, CHAR *, ...
z — OEM/DOS 字符串 (默认 codepage) — LPSTR, LPCSTR, CHAR *, ...
v — 指向变体结构的一个指针类型

3. dwx 插件下载帖子中的 imaut_vlx.rar 文件，在 CAD 中加载后点击注册   详见：  http://bbs.mjtd.com/thread-176996-1-1.html


dynwrapx64位注册.rar

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:dynwrapx64位注册.rar 
下载次数:5  文件大小:11.42 KB 
下载权限: 不限 以上  [免费赚D豆]

Dynwrapx2.1.1.1.zip

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:Dynwrapx2.1.1.1.zip 
下载次数:2  文件大小:47.2 KB 
下载权限: 不限 以上  [免费赚D豆]

7325pink

谢谢分享！拜读了！

liuyj

有意思，还不知道可以这么用

小陶

太深奥了！看不懂

sh_h

楼主好厉害，谢谢分享！