OpenEuphoria

Re: Converting C to Euphoria

• Posted by ghaberek (admin) 5 days ago
• 186 views

Looks like you can override the primitives by simply re-registering them with your own implementation using a function callback. To test this I wrapped the shared library and rewrote the main() function from nntrac.c. I'm also using strtok() from libc (or msvcrt.dll) to easily reproduce the existing prim_ps() function. If you want to reimplement some of the other primitives, you'll need to use realloc() to resize the memory buffer provided in the res parameter of your callback, so I've added that to the wrapper as well.

Makefile (quick and dirty, bare-minimum, and mostly cross-platform)

$(if $(OS),nntrac.dll,libnntrac.so): nntrac.o; $(CC) -shared -o $@ $^ 
nntrac.o: nntrac.c; $(CC) -std=c99 -Os -s -fPIC -DNNT_EMBED -o $@ -c $< 
clean:; $(if $(OS),del /Q nntrac.dll,$(RM) libnntrac.so) nntrac.o 

nntrac.e (wrapper for shared library)

public include std/dll.e 
public include std/machine.e 
 
public enum type NNT_MARKERS /* various markers: 248 to 255 never occur in UTF-8 */ 
  NNT_AFST=-8, /* active function start */ 
  NNT_NFST,    /* neutral function start */ 
  NNT_EOF,     /* end of function */ 
  NNT_ADEL,    /* argument delimiter */ 
  NNT_SEGGAP   /* segment gap character */ 
end type 
 
public enum type NNT_MODES /* operation modes */ 
  NNT_NORMAL=1, NNT_LEGACY, NNT_SECURE 
end type 
 
public constant NNT_ADEL_S = allocate_string({NNT_ADEL}) 
 
constant nntrac = open_dll({"nntrac.dll","libnntrac.so"}), 
  _nnt_init = define_c_proc(nntrac,"nnt_init",{}), 
  _nnt_assignform = define_c_proc(nntrac,"nnt_assignform",{C_POINTER,C_POINTER,C_UINT,C_INT}), 
  _nnt_regprimitive = define_c_proc(nntrac,"nnt_regprimitive",{C_POINTER,C_POINTER}), 
  _nnt_proc = define_c_proc(nntrac,"nnt_proc",{C_POINTER,C_UINT}), 
  _nnt_finish = define_c_proc(nntrac,"nnt_finish",{}) 
 
/* init the resources and built-in primitives */ 
public procedure nnt_init() 
  c_proc(_nnt_init,{}) 
end procedure 
 
/* assign a value to a form, creating it if doesn't exist */ 
public procedure nnt_assignform(sequence name, sequence value, integer len=length(value), integer ptr=0) 
  atom pvalue = allocate_data(len,1) poke(pvalue,value) 
  c_proc(_nnt_assignform,{allocate_string(name,1),pvalue,len,ptr}) 
end procedure 
 
/* register a primitive function, overwrite if already exists */ 
public procedure nnt_regprimitive(sequence name, sequence func, integer rid=routine_id(func)) 
  c_proc(_nnt_regprimitive,{allocate_string(name,1),call_back(rid)}) 
end procedure 
 
/* main TRAC processing algorithm */ 
public procedure nnt_proc(sequence prog, integer len=length(prog)) 
  atom pprog = allocate_data(len,1) poke(pprog,prog) 
  c_proc(_nnt_proc,{pprog,len}) 
end procedure 
 
/* free the interpreter resources */ 
public procedure nnt_finish() 
  c_proc(_nnt_finish,{}) 
end procedure 
 
export constant libc = open_dll({"msvcrt.dll",""}), 
  _realloc = define_c_func(libc,"realloc",{C_POINTER,C_SIZE_T},C_POINTER), 
  _strtok = define_c_func(libc,"strtok",{C_POINTER,C_POINTER},C_POINTER) 
 
/* reallocate a block of memory */ 
public function realloc(atom ptr, atom size) 
  return c_func(_realloc,{ptr,size}) 
end function 
 
/* find the next token in a string */ 
public function strtok(atom ptr, atom delim) 
  return c_func(_strtok,{ptr,delim}) 
end function 

nntrac.ex (example program from nntrac.c)

include std/io.e 
include nntrac.e 
 
/* ps primitive: print string */ 
function prim_ps(atom arglist, atom res, atom reslen) 
  atom arg = strtok(arglist, NNT_ADEL_S) 
  /* skip the first one (the ps string) */ 
  loop do 
    arg = strtok(NULL, NNT_ADEL_S) 
    if arg then 
      /* print the raw sequence */ 
      ? peek_string(arg) 
    end if 
    until arg = NULL 
  end loop 
  return res 
end function 
 
procedure main(sequence argv=command_line(), integer argc=length(argv)) 
 
  integer fn = STDIN 
  sequence fname = "-" /* stdin by default */ 
  if argc > 2 then argc = fname[3] end if 
 
  if not (fname[1] = '-' and length(fname) = 1) then 
    fn = open(fname, "rb") 
    if fn = -1 then 
      puts(STDERR, "Error\n") 
      abort(1) 
    end if 
  end if 
 
  sequence prog = "" 
  integer proglen = 0 
 
  if fn = STDIN then /* interactive session */ 
    prog = "#(ps,#(rs))" 
    proglen = length(prog) 
    puts(STDERR, "nntrac by Luxferre, 2023, public domain\n") 
  else 
    prog = read_file(fn) 
    proglen = length(prog) 
  end if 
 
  nnt_init() /* init processing resources */ 
 
  /* register our own ps primitive (print string) */ 
  nnt_regprimitive("ps", "prim_ps") 
 
  if argc > 2 then /* populate nnt-argc and nnt-argv forms */ 
 
    sequence buf = sprintf("%d", argc - 2) 
    nnt_assignform("nnt-argc", buf) 
 
    buf = "" /* reuse the buffer for nnt-argv */ 
    sequence segsep = {NNT_SEGGAP, 1, 0} 
 
    for i = 3 to argc do 
      buf &= argv[i] /* append the parameter */ 
      buf &= segsep  /* and the segment separator */ 
    end for 
 
    nnt_assignform("nnt-argv", buf) 
 
  end if 
 
  nnt_proc(prog, proglen) /* start main processor */ 
  nnt_finish() /* finalize processing resources */ 
  close(fn) 
  puts(STDOUT, "\n") /* just print a newline before exiting */ 
 
end procedure 
 
main() 

-Greg