From: progers@Starbase.NeoSoft.COM (Pat Rogers)
Subject: [semi-long] GNATmake for emx GNAT 2.03
Date: 10 Mar 1995 00:00:26 -0600
Date: 1995-03-10T00:00:26-06:00 [thread overview]
Message-ID: <3joptq$k0b@Starbase.NeoSoft.COM> (raw)
Here is the first emx version of the REXX gnatmake for OS/2.
--------------cut here ----------------------------------------------------
/**********************************************************************
Description : Uses GNAT to bring source files up to date
GNAT version : at least 2.03, the first emx version of GNAT
Author : Pat Rogers (progers@acm.org)
Created On : 3 March 1995
Version : 1.1 (Use with caution!!!)
Acknowledgeemnts : Based on a Perl script by Rolf Ebert
Limitations : Doesn't do the bind yet
Copyright (C) 1995 by Patrick Rogers
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
***********************************************************************/
if ARG() = 0 then do
call usage;
exit;
end;
verbose = 0;
action = 1;
continue = 0;
main = "";
gcc_options = " ";
parse arg params; /* don't convert to upper for sake of gcc_options */
do while params <> "";
parse var params param params
if substr(param,1,1) = '-' then
select
when substr(param,2,1) = 'v' then
verbose = 1;
when substr(param,2,1) = 'n' then
action = 0;
when substr(param,2,1) = 'k' then
continue = 1;
otherwise
gcc_options = param;
end /* select */
else do
main = param;
leave;
end /* if */
end; /* while */
if main = "" then do
call usage;
exit;
end /* if */
call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
call SysLoadFuncs
call SysFileTree main".adb", 'result', 'T'
if result.0 = 0 then do
say "Unit" main".adb" "not found";
exit;
end;
updated_list = " ";
call check( main );
exit; /* GNATMake */
check: procedure expose verbose action continue updated_list gcc_options
arg main
if updated( main ) then
nop;
/* say "Avoiding branch for" main */
else do
if verbose then
say "Analyzing" main
ali_time = "";
body_time = "";
decl_time = "";
call SysFileTree main".obj", 'result', 'T'
if result.0 <> 0 then do
parse var result.1 ali_time result.1
end
call SysFileTree main".adb", 'result', 'T'
if result.0 <> 0 then do
parse var result.1 body_time result.1
end
call SysFileTree main".ads", 'result', 'T'
if result.0 <> 0 then do
parse var result.1 decl_time result.1
end
recompile = 1;
if (ali_time < body_time ) | (ali_time < decl_time) then do
if body_time = "" then /* no body */
call compile( main".ads" );
else
call compile( main".adb" );
recompile = 0;
end /* ali is newer */
dependencies = "";
do while lines(main".ali");
line = translate( linein(main".ali"), ' ', '09'x ); /* convert tabs to blanks */
parse var line flag file time;
if flag = 'D' then do
if gnatlibfile(file) then
nop;
else
dependencies = file dependencies
end /* if */
end /* do */
call stream main".ali", 'c', "close"
save_dependencies = dependencies;
if recompile then do
recompile = 0;
parse upper var dependencies file dependencies;
do while file <> "";
call SysFileTree file, 'result', 'T'
parse var result.1 file_time result.1
if file_time > ali_time then do
recompile = 1;
if verbose then do
say "";
say "GNATMake:" main "must be recompiled because" file "has been modified";
end; /*verbose */
end /* file modified */
parse upper var dependencies file dependencies;
end /* do */
end /* recompile */
if recompile then do
if body_time = "" then /* no body */
call compile( main".ads" );
else
call compile( main".adb" );
end; /* if */
call update( main );
dependencies = save_dependencies;
parse upper var dependencies file dependencies;
do while file <> "";
dot = pos( '.', file );
file = substr( file, 1, dot-1 ); /* strip off extension */
call check( file );
parse upper var dependencies file dependencies;
end /* do */
end /* if */
return; /* check */
update: procedure expose updated_list
arg updated_file
updated_list = updated_file updated_list
return;
updated: procedure expose updated_list
arg test_file
found = 0;
temp = updated_list;
do until next_file = "";
parse var temp next_file temp
if next_file = test_file then do
found = 1;
leave;
end; /* if */
end; /* do */
return found;
compile: procedure expose action continue gcc_options
arg file
file = translate( file, 'abcdefghijklmnopqrstuvwxyz', 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' );
command = "gcc -c -I\emx\include" gcc_options file
if action then do
command; /* issues command to OS/2 */
if (rc <> 0) & (\continue) then /* problem and we aren't supposed to go on */
exit "compilation of" file "failed";
end /* if */
return;
usage:
say "";
say "gnatmake [-v] [-n] [-k] [gcc-opts] main";
say " -v : verbose";
say " -n : no action";
say " -k : continue on error";
say " gcc-opts : other options passed to gcc";
say " main : name of the main subprogram, without extension";
say "";
return;
gnatlibfile: procedure
arg file
if ( substr(file,1,1) = 'S' ) & ( substr(file,2,1) = '-' ) then
return 1;
if ( substr(file,1,1) = 'A' ) & ( substr(file,2,1) = '-' ) then
return 1;
if ( substr(file,1,1) = 'I' ) & ( substr(file,2,1) = '-' ) then
return 1;
if ( substr(file,1,1) = 'G' ) & ( substr(file,2,1) = '-' ) then
return 1;
/* failing that, look in the list of gnat lib file names */
found = pos( file, "ADA.ADS SYSTEM.ADS SYSTEM.ADB UNCHDEAL.ADS UNCHDEAL.ADB" );
if found <> 0 then
return 1;
found = pos( file, "UNCHCONV.ADS INTERFAC.ADS TEXT_IO.ADS SEQUENIO.ADS GNAT.ADS" );
if found <> 0 then
return 1;
found = pos( file, "IOEXCEPT.ADS CALENDAR.ADS DIRECTIO.ADS" );
if found <> 0 then
return 1;
return 0;
\x1a
reply other threads:[~1995-03-10 6:00 UTC|newest]
Thread overview: [no followups] expand[flat|nested] mbox.gz Atom feed
replies disabled
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox