Pastey make_atom.exw for 4.0
- Posted by mattlewis
(admin)
May 12, 2012
without warning
include std/filesys.e
include std/get.e
--// Begin JuLu
-- Get the 'file number' of a Euphoria identifier in translated C code
-- (successfully tested with the Eu2C translator 2.5)
type whole_number (sequence chars)
for i = 1 to length(chars) do
if chars[i] < '0' or '9' < chars[i] then
return 0
end if
end for
return 1
end type
function identifier_file_no (sequence identifier, sequence c_source)
-- in : identifier: case-sensitive name of concerning Euphoria identifier
-- - with trailing ';' for a variable name
-- - with trailing '(' for a routine name
-- c_source : file produced by the Eu2C translator, that contains the
-- identifier with its prepended 'file number'
-- ("init_.c" for local and global variables)
-- out: 'file number' as string, that the Eu2C translator has prepended to
-- the regarding identifier
object line
sequence ret
integer fn, r, s
fn = open(c_source, "r")
if fn = -1 then
return "" -- error
end if
line = gets(fn)
while sequence(line) do
s = match(identifier, line)
if s then
r = find('_', line)
if 0 < r and r < s then
ret = line[r+1..s-1]
if whole_number(ret) then
close(fn)
return ret -- success
end if
end if
end if
line = gets(fn)
end while
close(fn)
return "" -- error
end function
--// End JuLu
constant
signed = "#define _%dmake_atom(x) if( (unsigned)x > (unsigned)0x3fffffff){ x = NewDouble( (double) x );}\n",
unsigned = "#define _%dmake_atomu(x) if( (unsigned)x > (unsigned)0x3fffffff){ x = NewDouble( (double)(unsigned long) x );}\n"
integer make_atom_file
make_atom_file = 2
procedure write_temp( sequence file )
integer in, out
object line
sequence last, make_atom_string
in = open( file, "rb" )
out = open( "temp_atom" & file, "wb" )
for i = 1 to 4 do
puts( out, gets( in ) )
end for
printf(out, signed, make_atom_file )
printf(out, unsigned, make_atom_file )
line = gets( in )
last = ""
make_atom_string = sprintf( "_%dmake_atom", make_atom_file )
while sequence( line ) do
if not match( make_atom_string, line ) then
puts( out, last )
end if
last = line
line = gets( in )
end while
puts( out, last )
close(in)
close(out)
end procedure
procedure make_atom( sequence files )
integer in, out
object line
sequence last
for file = 1 to length( files ) do
if files[file][D_NAME][1] != '.' then
write_temp( files[file][D_NAME] )
move_file( sprintf("temp_atom%s", {files[file][D_NAME]}), files[file][D_NAME], 1 )
-- system( sprintf("move temp_atom%s %s", {files[file][D_NAME],files[file][D_NAME]}), 0)
end if
end for
end procedure
procedure main()
sequence cmd
--// Begin JuLu
sequence temp
--// End JuLu
cmd = command_line()
temp = identifier_file_no("make_atom(", "make_atom.c")
temp = value(temp)
make_atom_file = temp[2]
--// End JuLu
for eufile = 3 to length(cmd) do
make_atom( dir( current_dir() & SLASH & cmd[eufile] & "*.c" ) )
end for
end procedure
main()