Data update
This commit is contained in:
Ingy döt Net
parent
5150844a7d
commit
4bb20c9b71
7735 changed files with 38060 additions and 199180 deletions
|
|
@ -1,45 +0,0 @@
|
|||
with Ada.Text_IO; use Ada.Text_IO;
|
||||
with Interfaces; use Interfaces;
|
||||
with Interfaces.C; use Interfaces.C;
|
||||
with System; use System;
|
||||
|
||||
with Ada.Unchecked_Conversion;
|
||||
|
||||
procedure Shared_Library_Call is
|
||||
--
|
||||
-- Interface to kernel32.dll which is responsible for loading DLLs under Windows.
|
||||
-- There are ready to use Win32 bindings. We don't want to use them here.
|
||||
--
|
||||
type HANDLE is new Unsigned_32; -- on x64 system, replace by Unsigned_64 to make it work
|
||||
function LoadLibrary (lpFileName : char_array) return HANDLE;
|
||||
pragma Import (stdcall, LoadLibrary, "LoadLibrary", "_LoadLibraryA"); -- Ada95 does not have the @n suffix.
|
||||
|
||||
function GetProcAddress (hModule : HANDLE; lpProcName : char_array)
|
||||
return Address;
|
||||
pragma Import (stdcall, GetProcAddress, "GetProcAddress", "_GetProcAddress"); --
|
||||
--
|
||||
-- The interface of the function we want to call. It is a pointer (access type)
|
||||
-- because we will link it dynamically. The function is from User32.dll
|
||||
--
|
||||
type MessageBox is access function
|
||||
( hWnd : Address := Null_Address;
|
||||
lpText : char_array;
|
||||
lpCaption : char_array := To_C ("Greeting");
|
||||
uType : Unsigned_16 := 0
|
||||
) return Integer_16;
|
||||
pragma Convention (Stdcall, MessageBox);
|
||||
function To_MessageBox is new Ada.Unchecked_Conversion (Address, MessageBox);
|
||||
|
||||
Library : HANDLE := LoadLibrary (To_C ("user32.dll"));
|
||||
Pointer : Address := GetProcAddress (Library, To_C ("MessageBoxA"));
|
||||
begin
|
||||
if Pointer /= Null_Address then
|
||||
declare
|
||||
Result : Integer_16;
|
||||
begin
|
||||
Result := To_MessageBox (Pointer) (lpText => To_C ("Hello!"));
|
||||
end;
|
||||
else
|
||||
Put_Line ("Unable to load the library " & HANDLE'Image (Library));
|
||||
end if;
|
||||
end Shared_Library_Call;
|
||||
|
|
@ -1,49 +0,0 @@
|
|||
with Ada.Environment_Variables; use Ada.Environment_Variables;
|
||||
with Ada.Text_IO; use Ada.Text_IO;
|
||||
with Interfaces; use Interfaces;
|
||||
with Interfaces.C; use Interfaces.C;
|
||||
with System; use System;
|
||||
|
||||
with Ada.Unchecked_Conversion;
|
||||
|
||||
procedure Shared_Library_Call is
|
||||
--
|
||||
-- Interface to libdl to load dynamically linked libraries
|
||||
--
|
||||
function dlopen (FileName : char_array; Flag : int) return Address;
|
||||
pragma Import (C, dlopen);
|
||||
|
||||
function dlsym (Handle : address; Symbol : char_array) return Address;
|
||||
pragma Import (C, dlsym);
|
||||
--
|
||||
-- The interfaces of the functions we want to call. These are pointers
|
||||
-- (access type) because we will link it dynamically. The functions
|
||||
-- come from libX11.so.
|
||||
--
|
||||
type XOpenDisplay is access function (Display_Name : char_array) return Address;
|
||||
pragma Convention (C, XOpenDisplay);
|
||||
function To_Ptr is new Ada.Unchecked_Conversion (Address, XOpenDisplay);
|
||||
|
||||
type XDisplayWidth is access function (Display : Address; Screen : int) return int;
|
||||
pragma Convention (C, XDisplayWidth);
|
||||
function To_Ptr is new Ada.Unchecked_Conversion (Address, XDisplayWidth);
|
||||
|
||||
Library : Address := dlopen (To_C ("libX11.so"), 1);
|
||||
OpenDisplay : XOpenDisplay := To_Ptr (dlsym (Library, To_C ("XOpenDisplay")));
|
||||
DisplayWidth : XDisplayWidth := To_Ptr (dlsym (Library, To_C ("XDisplayWidth")));
|
||||
begin
|
||||
if OpenDisplay /= null and then DisplayWidth /= null then
|
||||
declare
|
||||
Display : Address;
|
||||
begin
|
||||
Display := OpenDisplay (To_C (Value ("DISPLAY")));
|
||||
if Display = Null_Address then
|
||||
Put_Line ("Unable to open display " & Value ("DISPLAY"));
|
||||
else
|
||||
Put_Line (Value ("DISPLAY") & " width is" & int'image (DisplayWidth (Display, 0)));
|
||||
end if;
|
||||
end;
|
||||
else
|
||||
Put_Line ("Unable to load the library");
|
||||
end if;
|
||||
end Shared_Library_Call;
|
||||
|
|
@ -1,8 +1,7 @@
|
|||
getCurlVersion: function [][
|
||||
try? [
|
||||
if throws? [
|
||||
call.external:'curl "curl_version" .expect: :string []
|
||||
]
|
||||
else [
|
||||
][
|
||||
"library not found"
|
||||
]
|
||||
]
|
||||
|
|
|
|||
|
|
@ -1,37 +0,0 @@
|
|||
identification division.
|
||||
program-id. callsym.
|
||||
|
||||
data division.
|
||||
working-storage section.
|
||||
01 handle usage pointer.
|
||||
01 addr usage program-pointer.
|
||||
|
||||
procedure division.
|
||||
call "dlopen" using
|
||||
by reference null
|
||||
by value 1
|
||||
returning handle
|
||||
on exception
|
||||
display function exception-statement upon syserr
|
||||
goback
|
||||
end-call
|
||||
if handle equal null then
|
||||
display function module-id ": error getting dlopen handle"
|
||||
upon syserr
|
||||
goback
|
||||
end-if
|
||||
|
||||
call "dlsym" using
|
||||
by value handle
|
||||
by content z"perror"
|
||||
returning addr
|
||||
end-call
|
||||
if addr equal null then
|
||||
display function module-id ": error getting perror symbol"
|
||||
upon syserr
|
||||
else
|
||||
call addr returning omitted
|
||||
end-if
|
||||
|
||||
goback.
|
||||
end program callsym.
|
||||
|
|
@ -1,13 +1,19 @@
|
|||
(import (otus ffi))
|
||||
|
||||
(define self (load-dynamic-library #f))
|
||||
|
||||
(define strdup
|
||||
(let ((strdup (self type-vptr "strdup" type-string))
|
||||
(free (self fft-void "free" type-vptr)))
|
||||
(lambda (str)
|
||||
(let*((dupped (strdup str))
|
||||
(result (vptr->string dupped)))
|
||||
(free dupped)
|
||||
result))))
|
||||
(free (self fft-void "free" type-vptr)))
|
||||
(if (and strdup free)
|
||||
; we have both native functions
|
||||
(lambda (str)
|
||||
(let*((dupped (strdup str))
|
||||
(result (vptr->string dupped)))
|
||||
(free dupped)
|
||||
result))
|
||||
; windows doesn't have strdup and free, so...
|
||||
(lambda (str)
|
||||
(list->string (string->list str))))))
|
||||
|
||||
(print (strdup "Hello World!"))
|
||||
|
|
|
|||
|
|
@ -1,11 +1,9 @@
|
|||
(notonline)-->
|
||||
<span style="color: #008080;">without</span> <span style="color: #008080;">js</span> <span style="color: #000080;font-style:italic;">-- not from a browser, mate!</span>
|
||||
<span style="color: #004080;">string</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">libname</span><span style="color: #0000FF;">,</span><span style="color: #000000;">funcname</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">platform</span><span style="color: #0000FF;">()=</span><span style="color: #004600;">WINDOWS</span><span style="color: #0000FF;">?{</span><span style="color: #008000;">"user32"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"CharLowerA"</span><span style="color: #0000FF;">}:{</span><span style="color: #008000;">"libc"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"tolower"</span><span style="color: #0000FF;">})</span>
|
||||
<span style="color: #004080;">atom</span> <span style="color: #000000;">lib</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">open_dll</span><span style="color: #0000FF;">(</span><span style="color: #000000;">libname</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #004080;">integer</span> <span style="color: #000000;">func</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">define_c_func</span><span style="color: #0000FF;">(</span><span style="color: #000000;">lib</span><span style="color: #0000FF;">,</span><span style="color: #000000;">funcname</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">C_INT</span><span style="color: #0000FF;">},</span><span style="color: #000000;">C_INT</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">if</span> <span style="color: #000000;">func</span><span style="color: #0000FF;">=-</span><span style="color: #000000;">1</span> <span style="color: #008080;">then</span>
|
||||
<span style="color: #0000FF;">?{{</span><span style="color: #7060A8;">lower</span><span style="color: #0000FF;">(</span><span style="color: #008000;">'A'</span><span style="color: #0000FF;">)}}</span> <span style="color: #000080;font-style:italic;">-- (you don't //have// to crash!)</span>
|
||||
<span style="color: #008080;">else</span>
|
||||
<span style="color: #0000FF;">?</span><span style="color: #7060A8;">c_func</span><span style="color: #0000FF;">(</span><span style="color: #000000;">func</span><span style="color: #0000FF;">,{</span><span style="color: #008000;">'A'</span><span style="color: #0000FF;">})</span> <span style="color: #000080;font-style:italic;">-- ('A'==65)</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
|
||||
<!--
|
||||
without js -- not from a browser, mate!
|
||||
string {libname,funcname} = iff(platform()=WINDOWS?{"user32","CharLowerA"}:{"libc","tolower"})
|
||||
atom lib = open_dll(libname)
|
||||
integer func = define_c_func(lib,funcname,{C_INT},C_INT,false)
|
||||
if func=-1 then
|
||||
?{{lower('A')}} -- (you don't //have// to crash! ^^^^^)
|
||||
else
|
||||
?c_func(func,{'A'}) -- ('A'==65)
|
||||
end if
|
||||
|
|
|
|||
|
|
@ -1,28 +1,17 @@
|
|||
/*REXX program calls a function (sysTextScreenSize) in a shared library (regUtil). */
|
||||
-- 12 Sep 2025
|
||||
include Setting
|
||||
|
||||
/*Note: the REGUTIL.DLL (REGina UTILity Dynamic Link Library */
|
||||
/* should be in the PATH or the current directory. */
|
||||
say 'CALL A FUNCTION IN A SHARED LIBRARY'
|
||||
say version
|
||||
say 'Dump the variable pool'
|
||||
say
|
||||
if Pos('Regina',version) > 0 | Pos('ooRexx',version) > 0 then do
|
||||
call RxFuncAdd 'sysloadfuncs','rexxutil','sysloadfuncs'
|
||||
call SysLoadFuncs
|
||||
call SysDumpVariables
|
||||
end
|
||||
else
|
||||
say 'Sorry! Not supported for your interpreter.'
|
||||
exit
|
||||
|
||||
rca= rxFuncAdd('sysLoadFuncs', "regUtil", 'sysLoadFuncs') /*add a function library. */
|
||||
if rca\==0 then do /*examine the return code.*/
|
||||
say 'return code' rca "from rxFuncAdd" /*tell about bad " " */
|
||||
exit rca /*exit this program with RC. */
|
||||
end
|
||||
|
||||
rcl= sysLoadFuncs() /*we can load the functions. */
|
||||
if rcl\==0 then do /*examine the return code.*/
|
||||
say 'return code' rcl "from sysLoadFuncs" /*tell about bad " " */
|
||||
exit rcl /*exit this program with RC. */
|
||||
end
|
||||
/* [↓] call a function. */
|
||||
$= sysTextScreenSize() /*$ has 2 words: rows cols */
|
||||
parse var $ rows cols . /*get two numeric words in $.*/
|
||||
say ' rows=' rows /*show number of screen rows.*/
|
||||
say ' cols=' cols /* " " " " cols.*/
|
||||
|
||||
rcd= SysDropFuncs() /*make functions inaccessible*/
|
||||
if rcd\==0 then do /*examine the return code.*/
|
||||
say 'return code' rcd "from sysDropFuncs" /*tell about bad " " */
|
||||
exit rcd /*exit this program with RC. */
|
||||
end
|
||||
exit 0 /*stick a fork in it, we're all done. */
|
||||
include Math
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue