Another update from ingydotnet^djgoku
This commit is contained in:
Ingy döt Net
parent
91df62d461
commit
948b86eafa
7604 changed files with 108452 additions and 22726 deletions
|
|
@ -0,0 +1,67 @@
|
|||
BEGIN
|
||||
MODE PASSWD = STRUCT (STRING name, passwd, INT uid, gid, STRING gecos, dir, shell);
|
||||
PROC getpwnam = (STRING name) PASSWD :
|
||||
BEGIN
|
||||
FILE c source;
|
||||
create (c source, stand out channel);
|
||||
putf (c source, ($gl$,
|
||||
"#include <sys/types.h>",
|
||||
"#include <pwd.h>",
|
||||
"#include <stdio.h>",
|
||||
"main ()",
|
||||
"{",
|
||||
" char name[256];",
|
||||
" scanf (""%s"", name);",
|
||||
" struct passwd *pass = getpwnam (name);",
|
||||
" if (pass == (struct passwd *) NULL) {",
|
||||
" putchar ('\n');",
|
||||
" } else {",
|
||||
" printf (""%s\n"", pass->pw_name);",
|
||||
" printf (""%s\n"", pass->pw_passwd);",
|
||||
" printf (""%d\n"", pass->pw_uid);",
|
||||
" printf (""%d\n"", pass->pw_gid);",
|
||||
" printf (""%s\n"", pass->pw_gecos);",
|
||||
" printf (""%s\n"", pass->pw_dir);",
|
||||
" printf (""%s\n"", pass->pw_shell);",
|
||||
" }",
|
||||
"}"
|
||||
));
|
||||
STRING source name = idf (c source);
|
||||
STRING bin name = source name + ".bin";
|
||||
INT child pid = execve child ("/usr/bin/gcc",
|
||||
("gcc", "-x", "c", source name, "-o", bin name),
|
||||
"");
|
||||
wait pid (child pid);
|
||||
PIPE p = execve child pipe (bin name, "Ding dong, a68g calling", "");
|
||||
put (write OF p, (name, newline));
|
||||
STRING line;
|
||||
PASSWD result;
|
||||
IF get (read OF p, (line, newline)); line = ""
|
||||
THEN
|
||||
result := ("", "", -1, -1, "", "", "")
|
||||
CO
|
||||
Return to sender, address unknown.
|
||||
No such number, no such zone.
|
||||
CO
|
||||
ELSE
|
||||
name OF result := line;
|
||||
get (read OF p, (passwd OF result, newline));
|
||||
get (read OF p, (uid OF result, newline));
|
||||
get (read OF p, (gid OF result, newline));
|
||||
get (read OF p, (gecos OF result, newline));
|
||||
get (read OF p, (dir OF result, newline));
|
||||
get (read OF p, (shell OF result, newline))
|
||||
FI;
|
||||
close (write OF p); CO Sundry cleaning up. CO
|
||||
close (read OF p);
|
||||
execve child ("/bin/rm", ("rm", "-f", source name, bin name), "");
|
||||
result
|
||||
END;
|
||||
PASSWD mr root = getpwnam ("root");
|
||||
IF name OF mr root = ""
|
||||
THEN
|
||||
print (("Oh dear, we seem to be rootless.", newline))
|
||||
ELSE
|
||||
printf (($2(g,":"), 2(g(0),":"), 2(g,":"), gl$, mr root))
|
||||
FI
|
||||
END
|
||||
|
|
@ -0,0 +1 @@
|
|||
(JNIDemo/callStrdup "Hello World!")
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
(require '[net.n01se.clojure-jna :as jna])
|
||||
|
||||
(jna/invoke Integer c/strcmp "apple" "banana" ) ; returns -1
|
||||
|
||||
(jna/invoke Integer c/strcmp "banana" "apple" ) ; returns 1
|
||||
|
||||
(jna/invoke Integer c/strcmp "banana" "banana" ) ; returns 0
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
double add_n(double* a, double* b)
|
||||
{
|
||||
return *a + *b;
|
||||
}
|
||||
|
|
@ -0,0 +1,258 @@
|
|||
!-----------------------------------------------------------------------
|
||||
!module dll_module
|
||||
!-----------------------------------------------------------------------
|
||||
module dll_module
|
||||
use iso_c_binding
|
||||
implicit none
|
||||
private ! all by default
|
||||
public :: os_type, dll_type, load_dll, free_dll, init_os_type, init_dll
|
||||
! general constants:
|
||||
! the number of bits in an address (32-bit or 64-bit).
|
||||
integer, parameter :: bits_in_addr = c_intptr_t*8
|
||||
! global error-level variables:
|
||||
integer, parameter :: errid_none = 0
|
||||
integer, parameter :: errid_info = 1
|
||||
integer, parameter :: errid_warn = 2
|
||||
integer, parameter :: errid_severe = 3
|
||||
integer, parameter :: errid_fatal = 4
|
||||
|
||||
integer :: os_id
|
||||
|
||||
type os_type
|
||||
character(10) :: endian
|
||||
character(len=:), allocatable :: newline
|
||||
character(len=:), allocatable :: os_desc
|
||||
character(1) :: pathsep
|
||||
character(1) :: swchar
|
||||
character(11) :: unfform
|
||||
end type os_type
|
||||
|
||||
type dll_type
|
||||
integer(c_intptr_t) :: fileaddr
|
||||
type(c_ptr) :: fileaddrx
|
||||
type(c_funptr) :: procaddr
|
||||
character(1024) :: filename
|
||||
character(1024) :: procname
|
||||
end type dll_type
|
||||
|
||||
! interface to linux API
|
||||
interface
|
||||
function dlopen(filename,mode) bind(c,name="dlopen")
|
||||
! void *dlopen(const char *filename, int mode);
|
||||
use iso_c_binding
|
||||
implicit none
|
||||
type(c_ptr) :: dlopen
|
||||
character(c_char), intent(in) :: filename(*)
|
||||
integer(c_int), value :: mode
|
||||
end function
|
||||
|
||||
function dlsym(handle,name) bind(c,name="dlsym")
|
||||
! void *dlsym(void *handle, const char *name);
|
||||
use iso_c_binding
|
||||
implicit none
|
||||
type(c_funptr) :: dlsym
|
||||
type(c_ptr), value :: handle
|
||||
character(c_char), intent(in) :: name(*)
|
||||
end function
|
||||
|
||||
function dlclose(handle) bind(c,name="dlclose")
|
||||
! int dlclose(void *handle);
|
||||
use iso_c_binding
|
||||
implicit none
|
||||
integer(c_int) :: dlclose
|
||||
type(c_ptr), value :: handle
|
||||
end function
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
|
||||
!-----------------------------------------------------------------------
|
||||
!Subroutine init_dll
|
||||
!-----------------------------------------------------------------------
|
||||
subroutine init_dll(dll)
|
||||
implicit none
|
||||
type(dll_type), intent(inout) :: dll
|
||||
dll % fileaddr = 0
|
||||
dll % fileaddrx = c_null_ptr
|
||||
dll % procaddr = c_null_funptr
|
||||
dll % filename = " "
|
||||
dll % procname = " "
|
||||
end subroutine init_dll
|
||||
|
||||
!-----------------------------------------------------------------------
|
||||
!Subroutine init_os_type
|
||||
!-----------------------------------------------------------------------
|
||||
subroutine init_os_type(os_id,os)
|
||||
implicit none
|
||||
integer, intent(in) :: os_id
|
||||
type(os_type), intent(inout) :: os
|
||||
|
||||
select case (os_id)
|
||||
case (1) ! Linux
|
||||
|
||||
os % endian = 'big_endian'
|
||||
os % newline = achar(10)
|
||||
os % os_desc = 'Linux'
|
||||
os % pathsep = '/'
|
||||
os % swchar = '-'
|
||||
os % unfform = 'unformatted'
|
||||
|
||||
case (2) ! MacOS
|
||||
|
||||
os % endian = 'big_endian'
|
||||
os % newline = achar(10)
|
||||
os % os_desc = 'MacOS'
|
||||
os % pathsep = '/'
|
||||
os % swchar = '-'
|
||||
os % unfform = 'unformatted'
|
||||
|
||||
case default
|
||||
|
||||
end select
|
||||
|
||||
end subroutine init_os_type
|
||||
|
||||
!-----------------------------------------------------------------------
|
||||
!Subroutine load_dll
|
||||
!-----------------------------------------------------------------------
|
||||
subroutine load_dll (os, dll, errstat, errmsg )
|
||||
! this subroutine is used to dynamically load a dll.
|
||||
|
||||
|
||||
type (os_type), intent(in) :: os
|
||||
type (dll_type), intent(inout) :: dll
|
||||
integer, intent( out) :: errstat
|
||||
character(*), intent( out) :: errmsg
|
||||
|
||||
integer(c_int), parameter :: rtld_lazy=1
|
||||
integer(c_int), parameter :: rtld_now=2
|
||||
integer(c_int), parameter :: rtld_global=256
|
||||
integer(c_int), parameter :: rtld_local=0
|
||||
|
||||
errstat = errid_none
|
||||
errmsg = ''
|
||||
|
||||
select case (os%os_desc)
|
||||
case ("Linux","MacOS")
|
||||
! load the dll and get the file address:
|
||||
dll%fileaddrx = dlopen( trim(dll%filename)//c_null_char, rtld_lazy )
|
||||
if( .not. c_associated(dll%fileaddrx) ) then
|
||||
errstat = errid_fatal
|
||||
write(errmsg,'(i2)') bits_in_addr
|
||||
errmsg = 'the dynamic library '//trim(dll%filename)//' could not be loaded. check that the file '// &
|
||||
'exists in the specified location and that it is compiled for '//trim(errmsg)//'-bit systems.'
|
||||
return
|
||||
end if
|
||||
|
||||
! get the procedure address:
|
||||
dll%procaddr = dlsym( dll%fileaddrx, trim(dll%procname)//c_null_char )
|
||||
if(.not. c_associated(dll%procaddr)) then
|
||||
errstat = errid_fatal
|
||||
errmsg = 'the procedure '//trim(dll%procname)//' in file '//trim(dll%filename)//' could not be loaded.'
|
||||
return
|
||||
end if
|
||||
|
||||
case ("Windows")
|
||||
errstat = errid_fatal
|
||||
errmsg = ' load_dll not implemented for '//trim(os%os_desc)
|
||||
|
||||
case default
|
||||
errstat = errid_fatal
|
||||
errmsg = ' load_dll not implemented for '//trim(os%os_desc)
|
||||
end select
|
||||
return
|
||||
end subroutine load_dll
|
||||
|
||||
!-----------------------------------------------------------------------
|
||||
!Subroutine free_dll
|
||||
!-----------------------------------------------------------------------
|
||||
subroutine free_dll (os, dll, errstat, errmsg )
|
||||
|
||||
! this subroutine is used to free a dynamically loaded dll
|
||||
type (os_type), intent(in) :: os
|
||||
type (dll_type), intent(inout) :: dll
|
||||
integer, intent( out) :: errstat
|
||||
character(*), intent( out) :: errmsg
|
||||
|
||||
integer(c_int) :: success
|
||||
|
||||
errstat = errid_none
|
||||
errmsg = ''
|
||||
|
||||
select case (os%os_desc)
|
||||
case ("Linux","MacOS")
|
||||
|
||||
! close the library:
|
||||
success = dlclose( dll%fileaddrx )
|
||||
if ( success /= 0 ) then
|
||||
errstat = errid_fatal
|
||||
errmsg = 'the dynamic library could not be freed.'
|
||||
return
|
||||
else
|
||||
errstat = errid_none
|
||||
errmsg = ''
|
||||
end if
|
||||
|
||||
case ("Windows")
|
||||
|
||||
errstat = errid_fatal
|
||||
errmsg = ' free_dll not implemented for '//trim(os%os_desc)
|
||||
|
||||
case default
|
||||
errstat = errid_fatal
|
||||
errmsg = ' free_dll not implemented for '//trim(os%os_desc)
|
||||
end select
|
||||
|
||||
return
|
||||
end subroutine free_dll
|
||||
end module dll_module
|
||||
|
||||
|
||||
|
||||
!-----------------------------------------------------------------------
|
||||
!Main program
|
||||
!-----------------------------------------------------------------------
|
||||
program test_load_dll
|
||||
use, intrinsic :: iso_c_binding
|
||||
use dll_module
|
||||
implicit none
|
||||
|
||||
! interface to our shared lib
|
||||
abstract interface
|
||||
function add_n(a,b)
|
||||
use, intrinsic :: iso_c_binding
|
||||
implicit none
|
||||
real(c_double), intent(in) :: a,b
|
||||
real(c_double) :: add_n
|
||||
end function add_n
|
||||
end interface
|
||||
|
||||
type(os_type) :: os
|
||||
type(dll_type) :: dll
|
||||
integer :: errstat
|
||||
character(1024) :: errmsg
|
||||
type(c_funptr) :: cfun
|
||||
procedure(add_n), pointer :: fproc
|
||||
|
||||
call init_os_type(1,os)
|
||||
call init_dll(dll)
|
||||
|
||||
dll%filename="/full_path_to/shared_lib.so"
|
||||
! name of the procedure in shared_lib
|
||||
dll%procname="add_n"
|
||||
|
||||
write(*,*) "address: ", dll%procaddr
|
||||
|
||||
call load_dll(os, dll, errstat, errmsg )
|
||||
write(*,*)"load_dll: errstat=", errstat
|
||||
write(*,*) "address: ", dll%procaddr
|
||||
|
||||
call c_f_procpointer(dll%procaddr,fproc)
|
||||
|
||||
write(*,*) "add_n(2,5)=",fproc(2.d0,5.d0)
|
||||
|
||||
call free_dll (os, dll, errstat, errmsg )
|
||||
write(*,*)"free_dll: errstat=", errstat
|
||||
|
||||
end program test_load_dll
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
; simple FFI interface on Mac OSX
|
||||
(import "libc.dylib" "strdup")
|
||||
(println (get-string (strdup "hello world")))
|
||||
|
||||
; or extended FFI interface on Mac OSX
|
||||
(import "libc.dylib" "strdup" "char*" "char*")
|
||||
(println (strdup "hello world"))
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
/*REXX program calls (invoke) a "foreign" (non-REXX) language routine/program.*/
|
||||
|
||||
cmd = "MODE" /*define the command that is to be used*/
|
||||
opts= 'CON: CP /status' /*define the options to be used for cmd*/
|
||||
|
||||
address 'SYSTEM' cmd opts /*invoke a cmd via the SYSTEM interface*/
|
||||
|
||||
/*stick a fork in it, we're all done. */
|
||||
Loading…
Add table
Add a link
Reference in a new issue