home *** CD-ROM | disk | FTP | other *** search
/ Borland Programmer's Resource / Borland_Programmers_Resource_CD_1995.iso / ntcode / jx4nt125 / utils / syscalls.utf (.txt) < prev    next >
Encoding:
Null Bytes Alternating  |  1995-05-19  |  12.9 KB  |  226 lines
  1. \ syscalls.utf .. calling DLLs from Jax4th
  2. \ Copyright (c)1994 Jack J. Woehr
  3. \ P.O. Box 51, Golden, Colorado 80402-0051
  4. \ jax@well.sf.ca.us 72203.1320@compuserve.com
  5. \ SYSOP RCFB (303) 278-0364 3/12/24/96/14.4 24 hours
  6. \ All Rights Reserved
  7. \ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  8. \ This is free software and can be modified and redistributed under
  9. \ certain conditions described in the file COPYING.TXT. The
  10. \ Disclaimer of Warranty and License for this free software are also
  11. \ contained in the file COPYING.TXT.
  12. \ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  13.  
  14. \ 
  15. \ $Revision: 1.2 $
  16. \ 
  17.  
  18. MARKER syscalls.utf
  19.  
  20. \ ~~~~~~~~~~~~~~~~~~~~
  21. \ Conditional INCLUDED
  22. \ ~~~~~~~~~~~~~~~~~~~~
  23.  
  24. : PROVIDES ( c-addr u "ccc< >" --)
  25.     BL WORD FIND NIP 0=
  26.     IF INCLUDED ELSE 2DROP THEN ;
  27.  
  28. S" UTILS\UTILS.UTF" PROVIDES USEFUL
  29.  
  30. CR .( Loading System Call Examples) CR
  31.  
  32. \ ~~~~~~~~~~~~~~~~~~~~~~~~~~
  33. \ Libraries and System Calls
  34. \ ~~~~~~~~~~~~~~~~~~~~~~~~~~
  35.  
  36. DECIMAL USEFUL
  37. INTERNALS-WORDLIST ALSO-WID DEFINITIONS
  38.  
  39. \ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  40. \ Adds a system call compilation regimen. The user may open
  41. \ all referenced libraries and resolve all referenced system
  42. \ calls at once. Greate for boot words in saved images.
  43. \ Dependecies on NT operating system.
  44. \ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  45.  
  46. \ Backlink pointer for list of libs to open.
  47. VARIABLE LIBRARIES-LINK
  48. : LLINIT ( --) 0 LIBRARIES-LINK ! ; LLINIT
  49.  
  50. \ Backlink pointer for list of syscalls to resolve.
  51. VARIABLE SYSCALLS-LINK
  52. : SLINIT ( --) 0 SYSCALLS-LINK ! ; SLINIT
  53.  
  54. \ Linked list handling for these def-to-def pointers.
  55. : BACKLINK  ( var n  --)
  56.     DP @ SWAP
  57.     CELLS - MAKETOKEN
  58.     OVER @ ,
  59.     SWAP !
  60. ;
  61. \ Link library in to list of libraries
  62. \   n is number of cells to back up to find execution addr.
  63. \   var is the address of the end-of-list pointer.
  64. \   Compile backlink, store new link.
  65.  
  66. USEFUL INTERNALS-WORDLIST ALSO-WID
  67.  
  68. \ Declare a dynamic link library.
  69. \ This works with any NT DLL, not just NT's own
  70. : LIBRARY ( c-addr u --)
  71.     CREATE 0 , LIBRARIES-LINK 2 BACKLINK
  72.     TUCK HERE SWAP CMOVE
  73.     CHARS ALLOT 0 C, ALIGN
  74. ;
  75. \ Data structure of library: /lib-ptr/library-link/string...
  76. \ lib-ptr is the storage slot for the library handle
  77. \ library-link is the backlink to the previous declared lib
  78.  
  79. \ Open a DLL and store its handle
  80. : OPEN-LIB ( a-addr --)
  81.     DUP 2 CELLS + DATATOABS \ find string in body of Library construct
  82.     0 0 ROT LoadLibraryEx   \ call system
  83.     ?DUP 0=                 \ failure?
  84.     ABORT" Couldn't open library."
  85.     SWAP !                  \ done, save handle
  86. ;
  87.  
  88.     
  89. \ We keep libraries in a linked list.
  90. \ Open all declared libraries
  91. : OPEN-ALL ( --)
  92.     LIBRARIES-LINK @    \ Variable holding pointer to last lib
  93.     BEGIN
  94.         ?DUP            \ is it a pointer or null?
  95.     WHILE               \ while it's a pointer
  96.         EXECUTE         \ (actually xt) execute it
  97.         DUP OPEN-LIB
  98.      CELL+              \ then convert xt to data address
  99.      @                  \ and find address of backptr
  100.     REPEAT              \ loop until libs all opened
  101. ;
  102.  
  103. \ And close all, good practice!
  104. \ Walk thru linked list of libraries and close
  105. : CLOSE-ALL ( --)
  106.     LIBRARIES-LINK @
  107.     BEGIN ?DUP
  108.     WHILE EXECUTE DUP FreeLibrary DROP
  109.      CELL+ @
  110.     REPEAT
  111. ;
  112.  
  113. \ Declaring a DLL call, also kept in a linked list.
  114. \ This works with any NT DLL, not just NT's own.
  115. : SYSTEMCALL ( c-addr u a-addr --)
  116.     CREATE 0 , , SYSCALLS-LINK 2 BACKLINK
  117.     DUP C,
  118.     TUCK HERE SWAP CMOVE
  119.     1+ CHARS ALLOT ALIGN
  120.     DOES> ( i*x -- j*x)
  121.     @ SYSCALL
  122. ;
  123. \ The data structure of a system call:
  124. \ /calladdr/lib/backptr string ...
  125. \ calladdr stores the resolved addr after this call resolved
  126. \ lib is the address returned by a LIBRARY construct
  127. \ string is the case-sensitive name of call (e.g., Beep)
  128. \ backptr is analogous to the library back pointer: all calls
  129. \ are linked back so that all can be resolved at once.
  130.  
  131. SYSTEM-WORDLIST SET-CURRENT
  132.  
  133. \ Given the data address of the data structure of a system call,
  134. \ resolve that call. Presumes library open already.
  135. : (RESOLVE-CALL) ( a-addr --)
  136.      DUP CELL+ @ @          \ Library pointer
  137.      OVER 3 CELLS +         \ Call name string)
  138.      COUNT ASCIIZ DATATOABS \ Address of null-terminated ASCII)
  139.      SWAP GetProcAddress
  140.      ?DUP 0= ABORT" Couldn't resolve call."
  141.      SWAP !
  142. ;
  143.  
  144. USEFUL
  145.  
  146. \ Wrapper of above.
  147. : RESOLVE-CALL ( "ccc" --)
  148.     ' >BODY
  149.     STATE @
  150.     IF   POSTPONE LITERAL POSTPONE (RESOLVE-CALL)
  151.     ELSE (RESOLVE-CALL)
  152.     THEN
  153. ; IMMEDIATE
  154.  
  155. INTERNALS-WORDLIST ALSO-WID
  156.  
  157. \ Resolve all currently defined calls. Presumes appropriate
  158. \ libs are open. Harmless to do twice or three times.
  159. : RESOLVE-ALL ( --)
  160.     SYSCALLS-LINK @
  161.     BEGIN
  162.         ?DUP
  163.     WHILE
  164.         >BODY DUP (RESOLVE-CALL)
  165.         2 CELLS + @
  166.     REPEAT
  167. ;
  168.  
  169. USEFUL
  170.  
  171. \ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  172. \ Some Libraries and Calls Declared
  173. \ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  174.  
  175. \ Let's declare a few DLLs, to be resolved.
  176. S" KERNEL32.DLL" LIBRARY KERNEL32
  177. S" GDI32.DLL" LIBRARY GDI32
  178. S" USER32.DLL" LIBRARY USER32
  179.  
  180. \ Let's declare a few calls, to be resolved
  181. S" Beep" KERNEL32 SYSTEMCALL BEEP
  182. S" SetCurrentDirectoryA"  KERNEL32 SYSTEMCALL (CHDIR)
  183. S" GetCurrentDirectoryW"  KERNEL32 SYSTEMCALL (GTDIR)
  184.  
  185. \ Here's a high-level word to illustrate system calls.
  186. : CHDIR ( "<>chars<>" --)
  187.     BL WORD COUNT DUP 0<>           \ did user provide a path
  188.     IF                              \ if so, change path
  189.         ASCIIZ DATATOABS (CHDIR)
  190.     THEN
  191.     2DROP                           \ we don't care about returns here
  192.     CR PAD DATATOABS 128 (GTDIR)    \ get the current parth
  193.     2DROP                           \ we don't care about returns here
  194.     PAD 128 0TYPE                   \ show the current path
  195. ;
  196.  
  197. \ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  198. \ Demo: Mary Had A Little Lamb
  199. \ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  200.  
  201. SYSTEM-WORDLIST NONSTANDARD-WORDLIST FORTH-WORDLIST
  202. 3 SET-ORDER DEFINITIONS
  203.  
  204. DECIMAL
  205.  
  206. : MHALL ( --)
  207.     CR ." Now I'm going to sing! ..."
  208.     CR ." Ma-"   500 657 BEEP ." ry "  500 586 BEEP
  209.        ." had "  500 522 BEEP ." a "   500 586 BEEP
  210.        ." lit-"  500 657 BEEP ." tle " 500 657 BEEP
  211.        ." lamb." 500 657 BEEP
  212.     7 0 DO 2DROP LOOP
  213.     CR
  214. ;
  215.  
  216. OPEN-ALL RESOLVE-ALL
  217. MHALL
  218. CLOSE-ALL
  219.  
  220. USEFUL DECIMAL
  221.  
  222. \ ~~~~~~~~~~~~~~~~~
  223. \ End of syscalls.h
  224. \ ~~~~~~~~~~~~~~~~~
  225.  
  226.