/*  mkdef_emx.cmd  */

/*
    $Header: /cvsroot/lesstif/lesstif/scripts/OS2/mkdef_emx.cmd,v 1.28 2001/12/15 08:13:41 amai Exp $

    mkdef.cmd is a powerful tool to generate linker definition files
    for building DLLs on OS/2 (using EMX tools).
    Actually it can create a list of exported symbols (using emxexp) and
    check for binary compatibility, i.e. compare the list of exported symbols.
    It will produce a detailled log file.
    See help screen (-help) for more details.

    Requirements are a Classic REXX interpreter (4.0x; I did not check with 
    Object Rexx) and optionally the "emxexp" util from EMX package.


    This program is "Copyrighted Freeware":
    You may use, modify it, etc.
    But always keep my copyright statement in place!

    (c) by Alexander Mai
           st002279@hrzpub.tu-darmstadt.de
           amai@lesstif.org
           amai@users.sf.net
*/


/*
   TODO:
      - FormatFullLine(): either make it decide on its own which keys are
        being used or make it real dumb
      - ParseLine(): shall we set apparently wrong data to "" ?
      - Check for multiply defined symbols (The linker will do so anyway!)
      - Check for broken .def header from reference file?
      - Improve log readability by sorting the various output statements
      - Give some variables less confusing names
      - ...
*/


Program_name =  "mkdef"
Version_nr   =  20011215
Version      =  '"'Version_nr'"'   /* the explicit "stringized" version */

/*
 *  Definitions, Constants, etc.
 */

/* Our boolean values */
TRUE  = 1
FALSE = 0

/* Separator Character used for returning multiple values from subroutines.
   Should be a character which doesn't appear in an export statement! */
SEP = "|"

/* Exit codes of this program */
EXIT_SUCCESS = 0
EXIT_FAILURE = 1

/*
   The MAX_ALLOWED_ORDINAL limit is somewhere hidden in the
   public(!) available OS/2 docs, e.g. in toolsref.inf.
   High values may demand the "NONAME" attribute ?!

   I still don't know whether we are talking about the number of entries
   only or the maximum ordinal itself. So better check for both and
   hope that we are always below this limit!
   References for "NONAME" include emxdev.* and some IBM VAC docs,
   _not_ toolsref.inf :-\
 */
MAX_ALLOWED_ORDINAL = 65535


/*
 *  Default runtime values:
 *  (to be overwritten by commandline arguments)
 */

  /* new *.def itself */
newdeffile = ""

  /* We are going to create <lib_name>.dll */
lib_name = ""

  /* this value might change?! */
lib_version = ""
  /* ".libs/" is taken from the GNU libtool&auto* tools */
lib_objs = ""
lib_objs_fallback = ".libs/*.obj"
  /* use ordinals */
lib_useordinals = ""
lib_useordinals_fallback = TRUE
  /* use NONAME attribute */
lib_noname = ""
lib_noname_fallback = FALSE
  /* use RESIDENT attribute */
lib_residentname = ""
lib_residentname_fallback = FALSE
  /* lowest ordinal value */
lib_minord = -1
lib_minord_fallback = 1
  /* Whether to export _DLL_InitTerm */
lib_exportdllinit = ""
lib_exportdllinit_fallback = FALSE

  /* Command to produce list of available symbols:
     emxexp options include:
          -o<n>  create ordinals beginning with <n>
          -u     also take into account uninitialized variables
   */
list_cmd  = ""
list_cmd_fallback = "emxexp -u %"

  /* as an alternative just read in symbols from file */
list_file = ""

  /* old -def file */
list_reference = ""

  /* ensure binary compatibility */
list_compat = FALSE

  /* use all attributes from a .def reference file */
list_clone = TRUE


/* Say a first "Hello" and get the commandline arguments */
say Program_Name" Version "Version
Parse Arg Params
if Words(Params) = 0 then
   /* number of args isn't correct. Display short help message */
   do
   say 'Incorrect number of parameters'
   say
   call ShortHelpMessage
   exit EXIT_SUCCESS
   end

/*
 *  Process command line parameters.
 *  See help screen for more info.
 */
if (Params="-help") | (Params="-h") | (Params="-h") then
   do
   call HelpMessage
   exit EXIT_SUCCESS
   end
do while Params <> ""
   Parse Var Params curpar Params
   if curpar="-version" then
      do
      if Params = "" then
         do
         say "-version needs an argument"
         call HelpMessage
         exit EXIT_FAILURE
         end
      Parse Var Params lib_version Params
      end /* -version */
   else if curpar="-listcmd" then
      do
      if list_file <> "" then
         do
         say "You can not specify both -listcmd and -listfile"
         say
         call HelpMessage
         exit EXIT_FAILURE
         end
      if Params = "" then
         do
         say "-listcmd needs an argument"
         say
         call HelpMessage
         exit EXIT_FAILURE
         end
      if Left(Params, 1) = '"' then
         do
         endquote = Pos('"', SubStr(Params, 2))
         if endquote = 0 then
            do
            say "Missing quote in argument list for -listcmd"
            say
            call HelpMessage
            exit EXIT_FAILURE
            end
         else
            do
            list_cmd = SubStr(Params, 2, endquote-1)
            /* fix up remaining argument list string */
            Params = SubStr(Params, endquote+2)
            Params = Strip(Params, 'L')
            end
         end
      else
         /* no "" */
         do
         Parse Var Params list_cmd Params
         end
      end /* -listcmd */
   else if curpar="-listfile" then
      do
      if Params = "" then
         do
         say "-listfile needs an argument"
         call HelpMessage
         exit EXIT_FAILURE
         end
      Parse Var Params list_file Params
      end /* -listfile */
   else if curpar="-lib" then
      do
      if Params = "" then
         do
         say "-lib needs an argument"
         say
         call HelpMessage
         exit EXIT_FAILURE
         end
      Parse Var Params lib_name Params
      end /* -lib */
   else if curpar="-clone" then
      do
      list_clone = TRUE
      end /* -clone */
   else if curpar="-noclone" then
      do
      list_clone = FALSE
      end /* -noclone */
   else if curpar="-compat" then
      do
      list_compat = TRUE
      end /* -compat */
   else if curpar="-nocompat" then
      do
      list_compat = FALSE
      end /* -nocompat */
   else if curpar="-expinit" then
      do
      lib_exportdllinit = TRUE
      end /* -compat */
   else if curpar="-noexpinit" then
      do
      lib_exportdllinit = FALSE
      end /* -nocompat */
   else if curpar="-name" then
      do
      lib_noname = FALSE
      end /* -name */
   else if curpar="-noname" then
      do
      lib_noname = TRUE
      end /* -noname */
   else if curpar="-ord" then
      do
      lib_useordinals = TRUE
      end /* -ord */
   else if curpar="-noord" then
      do
      lib_useordinals = FALSE
      end /* -noord */
   else if curpar="-minord" then
      do
      lib_useordinals = TRUE
      if (Params <> "") then
         do
         Parse Var Params lib_minord Params
         if (DATATYPE(lib_minord, 'W') <> 1) | (lib_minord < 1) then
             do
             say "Invalid parameter "lib_minord" for -minord flag"
             exit EXIT_FAILURE
             end
         end    
      end /* -minord */
   else if curpar="-resident" then
      do
      lib_residentname = TRUE
      end /* -name */
   else if curpar="-noresident" then
      do
      lib_residentname = FALSE
      end /* -noresident */
   else if curpar="-objects" then
      do
      if Params = "" then
         do
         say "-objects needs an argument"
         call HelpMessage
         exit EXIT_FAILURE
         end
      if Left(Params, 1) = '"' then
         do
         endquote = Pos('"', SubStr(Params, 2))
         if endquote = 0 then
            do
            say "Missing quote in argument list for -objects"
            say
            call HelpMessage
            exit EXIT_FAILURE
            end
         else
            do
            lib_objs = SubStr(Params, 2, endquote-1)
            /* fix up remaining argument list string */
            Params = SubStr(Params, endquote+2)
            Params = Strip(Params, 'L')
            end
         end
      else
         /* no "" */
         do
         Parse Var Params lib_objs Params
         end
      end /* -objects */
   else if curpar="-reference" then
      do
      if Params = "" then
         do
         say "-reference needs an argument"
         say
         call HelpMessage
         exit EXIT_FAILURE
         end
      Parse Var Params list_reference Params
      end /* -reference */
    else
       do
       say "Unknown commandline argument: "curpar
       say
       call HelpMessage
       exit EXIT_FAILURE
       end
end /* do while Params <> "" */

/* *.def name fallback */
if newdeffile = "" then
   newdeffile = lib_name".def"

   
/* Output to stdout/stderr may be difficult to capture if being run
   from within a Makefile, so we create a log file */
LogFile     = newdeffile".log"


/* (Delete &) Open LogFile */
if FileExists(LogFile) then
   do
   rc = DeleteFile(LogFile)
   if rc <> 0 then
      do
      say "Can not delete "LogFile"!"
      say "No log will be created."
      LogFile = ""
      end
   end
if LogFile <> "" then
   do
   rc = Stream(LogFile, 'C', 'OPEN WRITE')
   if rc <> 'READY:' then
      do
      say "Can not write to "LogFile"!"
      say "No log will be created."
      LogFile = ""
      end
   end
else
   do
   say "Writing log to "LogFile
   end

/* My name is Bond, James Bond ... */
call LineOut LogFile, Program_name" Version "Version

timestamp = Date()", "Time()
call DoOutput timestamp
call DoOutput
call DoOutput 'Creating linker definition file 'newdeffile' for library 'lib_name' Version 'lib_version


/*
 *  Check for consistency and apply fallback values
 */

if Strip(lib_name) = "" then
   do
   call DoOutput "You did not specify a library name!"
   SIGNAL BAILOUT
   end

/* Temporary file to be created which holds all available symbols.
   So far we don't care about write access/disk space and
   just write in the current directory. */
tmplistfile = lib_name"_symbols.tmp"

/* Old reference list. We might re-use the .def header and
   optionally compare exports for binary compatibility. */
if list_reference = "" then
   reflistfile = lib_name".def.dist"
else
   reflistfile = list_reference

if lib_useordinals = "" then
   lib_useordinals = lib_useordinals_fallback
if lib_minord = -1 then
   lib_minord = lib_minord_fallback
else
   do
   if lib_compat = TRUE then
      do
      call DoOutput "You can not specify both -compat and -minord!"
      SIGNAL BAILOUT
      end
   if lib_useordinals = FALSE then
      do
      call DoOutput "-minord requires ordinals to be used!"
      SIGNAL BAILOUT
      end
   end

if lib_noname = "" then
   lib_noname = lib_noname_fallback
if lib_residentname = "" then
   lib_residentname = lib_residentname_fallback
if lib_residentname & lib_noname then
   do
   call DoOutput "You can not specify both -residentname and -noname!"
   SIGNAL BAILOUT
   end
else
   do
   if lib_noname then
      lib_att = "NONAME"
   else if lib_residentname then
      lib_att = "RESIDENTNAME"
   else
      lib_att = ""
   end

if list_file <> "" & list_cmd <> "" then
   do
   call DoOutput 'You may not specify a list_file and a list_cmd!'
   SIGNAL BAILOUT
   end
if list_cmd = "" then
  do
  if lib_useordinals then
     do
     ppos = Pos('%', list_cmd_fallback) 
     tmpcmd = Left(list_cmd_fallback, ppos-1)
     tmpcmd = tmpcmd' -o'lib_minord' 'SubStr(list_cmd_fallback, ppos)
     list_cmd = tmpcmd
     end  
  else
     list_cmd = list_cmd_fallback
  end

if lib_exportdllinit = "" then
   lib_exportdllinit = lib_exportdllinit_fallback
dllinit_found = FALSE

/*
 *  Ok, start the real work now !
 */


/*
 * Look for the reference file
 */
if \FileExists(reflistfile) then
   do
   call DoOutput "Can not find "reflistfile"."
   have_reference = FALSE
   if list_compat=TRUE then
      do
      call DoOutput "Can not proceed here if -compat is specified. Exiting."
      SIGNAL BAILOUT
      end
   else
      call DoOutput "Proceeding without reference list."
   end
else
   do
   have_reference = TRUE
   if list_compat=TRUE then
      do
      if list_clone then
          call DoOutput "Ensure compatibility (ordinals) with "reflistfile
      else
          call DoOutput "Ensure compatibility (same interface) with "reflistfile
      end
   else
      do
      call DoOutput "Re-use .def header from "reflistfile" (no binary compatibility!)"
      end
   end /* if \FileExists(reflistfile) */
call DoOutput

/*
 * Read (old) reference list if available
 */

/* 
   The reflist_*. stem structure:
      reflist_sym: symbol name
      reflist_num: ordinal of entry point
      reflist_mat: Boolean value, whether it is matched by new list.
                   Initialized to FALSE.
      reflist_ext: ordinal
      reflist_att: "RESIDENTNAME"/"NONAME" flags
      reflist_pwo: pwords (see toolsref)

   All(?) structures in this code should feature the 0 element of
   a stem variable as a counter for the number of elements.
 */

maxrefnumber    = 0   /* maximum ordinal used before */
reflines        = 0
reflist_num.0   = 0
commentlines.0  = 0

if have_reference then
   do
   rc = Stream(reflistfile, 'C', 'OPEN READ')
   if rc <> 'READY:' then
      do
      call DoOutput "Failed to read from "reflistfile": "rc
      SIGNAL BAILOUT
      end
   line = ""
   /*
      We expect a complete valid .def file which also includes
      an 'EXPORT' statement.
      More precise:
      We read and store all lines until we find a line which only contains
      the string "EXPORTS" (and optional blanks).
      We should better parse these skipped lines carefully for later usage!?

      Be aware that the following types of entries may show up:

            SampleRead = read2bin @8
            StringIn = str1       @4 NONAME
            StringOut = str2      @9 RESIDENTNAME 42
            CharTest  6
      
      Check out ParseLine() for details on our (limited??) understanding of
      those entries ...
   */
   do while ((line <> "EXPORTS") & (Lines(reflistfile) <> 0))
      in_line = LineIn(reflistfile)
      line = Strip(in_line)
      commentlines.0 = commentlines.0 + 1
      clnr = commentlines.0
      commentlines.clnr = line
      line = Translate(line)
   end
   if Lines(reflistfile) = 0 then
      /* end of file and no export statements found */
      do
      call DoOutput reflistfile" contains no symbols."
      end
   else
      do
      do while Lines(reflistfile) <> 0
         line = Strip(LineIn(reflistfile))
         if ((line <> "") & (Left(line,1) <> ";")) then
            do
            Parse Value ParseLine(line) with symname (SEP) number (SEP) extsymbol (SEP) resident (SEP) pwords
            reflines = reflines + 1
            reflist_sym.reflines = symname
            reflist_num.reflines = number
            reflist_ext.reflines = extsymbol
            reflist_att.reflines = resident
            reflist_pwo.reflines = pwords
            reflist_mat.reflines = FALSE
            if (number <> "") & (number > maxrefnumber) then
               maxrefnumber = number
            end /* if (line <> "") & (Left(line,1) <> ";")  */
      end /* do while Lines() */

      /* properly set .0 values to number of entries */
      reflist_sym.0 = reflines
      reflist_num.0 = reflines
      reflist_mat.0 = reflines

      call DoOutput reflines" entries in reflist"
      end /* symbols found  */
   end /* if have_reference */

call LineOut reflistfile
call DoOutput


/*
 * Now care about the new object file(s)
 */
if list_file <> "" then
   do
   tmplistfile = list_file
   call DoOutput 'Symbol list is read from file: 'list_file
   call DoOutput
   end
else
   /* Sanity checks. Use fallbacks if necessary */
   do
   if lib_objs = "" then
      do
      lib_objs = lib_objs_fallback
      end

   /* Process list_cmd; substitute placeholder for object list if necessary */
   placeholder = Pos('%', list_cmd)
   if placeholder > 0 then
     do
     genlistcmd = Left(list_cmd, placeholder-1)
     genlistcmd = genlistcmd''lib_objs''SubStr(list_cmd, placeholder+1)
     end
   else
     do
     genlistcmd = list_cmd
     end
   /* our private version: redirect output to a temporary file */
   genlistcmd_full = genlistcmd" > "tmplistfile

   call DoOutput 'Symbol list is generated via: "'genlistcmd'"'
   call DoOutput

   /* Delete old temporary file if it exists */
   if FileExists(tmplistfile)  then
     do
     rc = DeleteFile(tmplistfile)
     if rc <> 0 then
       do
       call DoOutput "Can not delete "tmplistfile
       SIGNAL BAILOUT
       end
     end

   /* Generate up-to-date list of all symbols to be exported.
      Exit program if we fail.  */
   rc = ExecCmd(genlistcmd_full)
   if rc <> 0 then
      do
      call DoOutput "Can not create symbol list!"
      call DoBeep
      call DoOutput " rc("genlistcmd_full") = "rc
      call DoOutput
      /* if FileExists(tmplistfile)  then
         do
         rc = DeleteFile(tmplistfile)
         end */
      SIGNAL BAILOUT
      end

   end /* list_file = "" */


/*
 *  Read in the new list from file
 */
rc = Stream(tmplistfile, 'C', 'OPEN READ')
if rc <> 'READY:' then
   do
   call DoOutput "Failed to read from "tmplistfile": "rc
   SIGNAL BAILOUT
   end
tmplines = 0
do while Lines(tmplistfile) <> 0
   line = Strip(LineIn(tmplistfile))
   if ((line <> "") & (Left(line,1) <> ";")) then
      do
      Parse Value ParseLine(line) with symname (SEP) number (SEP) extsymbol (SEP) resident (SEP) pwords
      if symname = '_DLL_InitTerm' then
         do
         dllinit_found=TRUE
         if lib_exportdllinit then
            do
            tmplines = tmplines + 1
            tmplist_sym.tmplines = symname
            tmplist_num.tmplines = number
            tmplist_ext.tmplines = extsymbol
            tmplist_att.tmplines = resident
            tmplist_pwo.tmplines = pwords            
            end
         end
      else
         do
         tmplines = tmplines + 1
         tmplist_sym.tmplines = symname
         tmplist_num.tmplines = number
         tmplist_ext.tmplines = extsymbol
         tmplist_att.tmplines = resident
         tmplist_pwo.tmplines = pwords
         end
      end /* if (line <> "") & (Left(line,1) <> ";") */
end /* do while Lines(tmplistfile) */
call LineOut tmplistfile
if list_file = "" then
   do
   /* only delete tmplistfile if we created it. rc doesn't matter here. */
   rc = DeleteFile(tmplistfile)
   end

tmplist_sym.0 = tmplines
tmplist_num.0 = tmplines
call DoOutput tmplines" entries in tmplist"

/*
   To keep things rather simple we should keep separate loops for
   the various jobs to be done on the symbol list.
   At least we have a specific one which does only the comparison
   to the reference list.
*/

/*
 *  We parse the new symbols and look for matching entries within
 *  the reference list.
 *  Note that this may take a substantial amount of time!
 *  e.g. for the LessTif Xm libraries we process about 2000 symbols here.
 *  Anyway I don't feel strong pressure to supply faster code here. 
 *  (My proposals would include sorting the list or creating a 
 *  better searchable data structure: trees, etc.)
 */

/* 'newsymbols' are the those not found in the reference list */
newlines   = 0
newsymbols = 0

if (reflist_num.0 > 0) & list_compat then
   do
   do i=1 to tmplines
      match = FALSE
      /* Search given symbol */
      j = 0
      do while ( (j<reflines) & \match )
         j = j + 1
         if tmplist_sym.i = reflist_sym.j then
            match = TRUE
      end /* do while */

      if (match) then
         /* Previously known symbol */
         do
         newlines = newlines + 1
         reflist_mat.j = TRUE   /* mark the previously known symbol as matched */
         newlist_sym.newlines = reflist_sym.j
         newlist_num.newlines = reflist_num.j
         if list_clone then
            do
            newlist_ext.newlines = reflist_ext.j
            newlist_att.newlines = reflist_att.j
            newlist_pwo.newlines = reflist_pwo.j
            end
         else
            do
            newlist_ext.newlines = tmplist_ext.j
            if lib_att <> "" then
               newlist_att.newlines = lib_att
            else
               newlist_att.newlines = tmplist_att.j
            newlist_pwo.newlines = tmplist_pwo.j
            end
         end /* if (match) */
      else
         /* New symbol found */
         do
         newsymbols = newsymbols + 1
         newsymbols_sym.newsymbols = tmplist_sym.i
         newsymbols_num.newsymbols = newsymbols    /* a temporary ordinal only */
         newsymbols_ext.newsymbols = tmplist_ext.i
         if lib_att <> "" then
            newsymbols_att.newsymbols = lib_att
         else
            newsymbols_att.newsymbols = tmplist_att.i
         newsymbols_pwo.newsymbols = tmplist_pwo.i
         end
      end /* do i=1 to tmplines */
   end
else
   /* i.e. no reference list or we just don't care about */
   do
   do i=1 to tmplines
      newsymbols_sym.i = tmplist_sym.i
      newsymbols_num.i = i
      newsymbols_ext.i = tmplist_ext.i
      if lib_att <> "" then
            newsymbols_att.i = lib_att
      else
            newsymbols_att.i = tmplist_att.i
      newsymbols_pwo.i = tmplist_pwo.i
   end /* do i=1 to tmplines */
   newsymbols = tmplines
   /* i.e. specifying -nocompat will trigger ordinals to start at lib_minord again! */
   maxrefnumber = lib_minord - 1 /* later we increment first */
   end /* if reflist_num.0 > 0 */

/* Internal check */
if (tmplines <> (newlines+newsymbols)) then
    do
    call DoOutput "Sorry, an internal error has occured!"
    call DoOutput "Program continues, but please check the results very carefully!"
    call DoBeep
    end
call DoOutput

/*
 *  Output some info about new and missing symbols
 *  (will also mention suppressed one like '_DLL_InitTerm' which is important
 *   for completeness!) 
 */
call DoOutput "New symbols:"
if newsymbols = 0 then
   do
   call DoOutput "None."
   end
else
   do
   do i=1 to newsymbols
      newnumber = maxrefnumber + i
      line = FormatShortLine(newsymbols_sym.i, newnumber)
      call DoOutput line
   end /* do i=1 to newsymbols */
   end
call DoOutput

/*  
 *  If available simply go through the reference list and check for
 *  non-matched entries
 */
missing_count = 0
if have_reference then
   do
   call DoOutput "Missing symbols:"
   do j=1 to reflines
      if reflist_mat.j = FALSE then
         do
         missing_count = missing_count + 1
         line = FormatShortLine(reflist_sym.j, reflist_num.j)
         call DoOutput line
         end
   end /* do */
   if missing_count = 0 then
      do
      call DoOutput "None."
      call DoOutput
      end
    else
      /* Old symbols are missing! All we can do is to issue a warning!? */
      do
      call DoOutput
      call DoBeep
      call DoOutput "*** This library is not binary compatible to the prior one ! ***"
      call DoOutput
      call DoBeep
      say
      end
   end

/*
 * Some sanity checks
 */
if newsymbols > MAX_ALLOWED_ORDINAL then
   do
   call DoBeep
   call DoOutput "Error: more than "MAX_ALLOWED_ORDINAL" exported symbols!"
   call DoOutput "Writing .def file anyway ..."
   end

if newsymbols > 0 then
   maxused = maxrefnumber + newsymbols
else
   maxused = maxrefnumber

/* 
 * It might happen that we do not have more than MAX_ALLOWED_ORDINAL
 * symbols, but just one (or more) featuring a too high ordinal.
 * We only issue one warning here, no complete list. 
 */
if maxused > MAX_ALLOWED_ORDINAL then
   do
   call DoBeep
   call DoOutput "Error: biggest ordinal ("maxused") is higher than "MAX_ALLOWED_ORDINAL"!"
   call DoOutput "Writing .def file anyway ..."
   end

/*
 * Finally write the new *.def file
 */

/* Prepare to write new .def file, i.e. delete an existing one */
if FileExists(newdeffile) then
   do
   rc = DeleteFile(newdeffile)
   if rc <> 0 then
      do
      call DoOutput "Can not delete "newdeffile
      SIGNAL BAILOUT
      end
   end

rc = Stream(newdeffile, 'C', 'OPEN WRITE')
if rc <> 'READY:' then
   do
   call DoOutput "Failed to write to "newdeffile": "rc
   SIGNAL BAILOUT
   end

/*
 *  Use the template from an _emx.def.dist file
 *  We need e.g.
 *    - LIBRARY
 *    - DESCRIPTION
 *    - CODE
 *    - DATA
 *  sections for a complete .def header describing a DLL.
 *  Note that LIBRARY and DESCRIPTION are automatically adjusted to reflect
 *  the library name and current version number.
*/

/* anchor is just another expression for a kind of copyright notice ... */
anchor_string = "; File created by "Program_name
anchor_len = Length(anchor_string)
new_anchor = anchor_string" "version" on "timestamp
anchor_set = FALSE
outline    = ''

/* Try to build a 'reasonable' header out of the old, existing one or
   supply a fallback at least */
if have_reference then
   do
   do clnr=1 to commentlines.0
      line = commentlines.clnr
      section = Translate(Word(line, 1))
      select
         when section = "LIBRARY" then
            /* replace the name by lib_name, but keep the attributes from the
               template */
            do
            outline = "LIBRARY "lib_name" "Subword(line, 3)
            call LineOut newdeffile, outline
            end
         when section = "DESCRIPTION" then
            /* if version was given, construct our own DESCRIPTION statement,
               else take it from the template */
            do
            if lib_version="" then
               call LineOut newdeffile, line
            else
               do
               outline = 'DESCRIPTION "'lib_name'.dll Version='lib_version'"'
               call LineOut newdeffile, outline
               end
            end
         when section = "EXPORTS" then
            /* we do this later */
            do
            end
         otherwise
            /* unknown statement or comment */
            do
            if Left(line, anchor_len) = anchor_string then
               /* its our own anchor string */
               do
               outline = new_anchor
               anchor_set = TRUE
               end
            else
               do
               outline = line
               end
            call LineOut newdeffile, outline
            end  /* otherwise */
      end /* select */
   end /* do clnr */
   end /* have_reference */
else
   do
   /* Some fallback header */
   call LineOut newdeffile, '; W*A*R*N*I*N*G: This is just a default header for linker definition files:'
   call LineOut newdeffile, ';                Please check it very CAREFULLY!'
   call LineOut newdeffile, 'LIBRARY 'lib_name' INITINSTANCE TERMINSTANCE'
   call LineOut newdeffile, 'DESCRIPTION "'lib_name'.dll Version='lib_version'"'
   call LineOut newdeffile, 'CODE PRELOAD'
   call LineOut newdeffile, 'DATA PRELOAD'
   call LineOut newdeffile, ''
   end

/* cosmetics */
if anchor_set = FALSE then
    do
    outline = new_anchor
    call LineOut newdeffile, outline
    anchor_set = TRUE
    end
if outline <> '' then
   do
   call LineOut newdeffile, ''
   end
call LineOut newdeffile, 'EXPORTS'

/* First write all previously known symbols */
if reflist_num.0 > 0 then
   do
   do i=1 to newlines
      line = FormatFullLine(newlist_sym.i, newlist_num.i, newlist_ext.i, newlist_att.i, newlist_pwo.i)
         call LineOut newdeffile, line
   end /* do i=1 to newlines */
   end

/* Always write all new symbols with numbers > maxrefnumber!
   (see above for a comment on the maximum ordinal to be used) */
do i=1 to newsymbols
   newnumber = maxrefnumber + i
   line = FormatFullLine(newsymbols_sym.i, newnumber, newsymbols_ext.i, newsymbols_att.i, newsymbols_pwo.i)
   call LineOut newdeffile, line
end /* do i=1 to newsymbols */

/* Just report this: */
if (dllinit_found & \lib_exportdllinit) then
   do
   call DoBeep
   call DoOutput "Won't export _DLL_InitTerm()!"
   call LineOut newdeffile, '; _DLL_InitTerm'
   end

/* Print some statistics */
call DoOutput
call DoOutput Program_name" statistics:"
call DoOutput "*****************"
call DoOutput "Total number of symbols: " tmplines
call DoOutput "New symbols:             " newsymbols
call DoOutput "Missing symbols:         " missing_count
call DoOutput


/* "Clean up", close .def file, etc. */
call LineOut newdeffile

/*
 *  ALL branches of this script should end here!
 */

FIN:

/*
 * "Clean up", close file, etc.
 *  Hmm, we don't check whether they are actually open?!
 */

call LineOut LogFile

exit EXIT_SUCCESS


/*
  ########################## Some SIGNAL targets ##############################
 */


/* 
 * Exit program, but clean up first a bit. 
 *  See 'FIN' label (SIGNAL target)
 */
BAILOUT:
call LineOut LogFile
/* What else shoud we do here? */

exit EXIT_FAILURE


/*
  #################### Additional procedures/functions ########################
 */


ExecCmd: Procedure
/* Execute a command and return it's return value */

Parse Arg cmdstring
Address CMD "@ "cmdstring
return rc
/* End ExecCmd() */


DeleteFile: Procedure
/* Delete a given file. Returns 0 if successful, 1 else */

Parse Arg fname
if \FileExists(fname) then
   do
   return 1
   end
rc = ExecCmd("del "fname)
if rc <> 0 then
   return 1
else
   return 0
/* End DeleteFile() */


RenameFile: Procedure
/* rename orig to dest. Returns <> 0 on failure, 0 on success */

Parse Arg orig dest
if FileExists(orig) then
   do
   rc = ExecCmd("ren "orig" "dest)
   if rc <> 0 then
      return 1
   else
      return 0
   end
else
   return 1
/* End RenameFile() */


FileExists: Procedure
/* returns 1 if a given File exists, 0 else */

Parse Arg is_file
rs = Stream(is_file, 'C', 'QUERY EXISTS')
if rs == "" then
   return 0
else
   return 1
/* End FileExists() */


DoOutput: Procedure expose LogFile
/* Write logging output to both stdout and a logfile */

Parse Arg outp
call LineOut , outp
if LogFile <> "" then
   call LineOut LogFile, outp
return
/* End DoOutput() */


DoBeep: Procedure
/* Say >BEEP< */

call CharOut , D2C(7)
return
/* End DoBeep */


FormatShortLine: Procedure expose lib_useordinals
/* Format a short line for an export statement */

Parse Arg sym_name, sym_num
if lib_useordinals & (sym_num <> "") then
  line = PFS("  "sym_name, 65, " @"sym_num)
else
  line = "  "sym_name
return line
/* End FormatShortLine() */


FormatFullLine: Procedure expose lib_useordinals
/* Format a full line for an export statement */

Parse Arg sym_name, sym_num, sym_ext, sym_att, sym_pwo
if sym_ext <> "" then
   line = sym_name" = "sym_ext
else
   line = sym_name
if lib_useordinals & (sym_num <> "") then
   line = PFS("  "sym_name, 65, " @"sym_num)
else
   line = "  "sym_name
line = line" "sym_att" "sym_pwo
line = Strip(line, 'T')
return line
/* End FormatFullLine() */


PFS: PROCEDURE
/* PFS( string, length, tail )
   Returns a string.
   First the string is filled up with blanks if necessary to get
   a total of <length> chars and then add the string <tail> */

Parse Arg pfs_stringa, pfs_length, pfs_stringb
pfs_l = Length(pfs_stringa)
if pfs_l < pfs_length then
   return pfs_stringa''Copies(' ', pfs_length-pfs_l)''pfs_stringb
else
   return pfs_stringa''pfs_stringb
/* End PFS() */


ParseLine: PROCEDURE expose SEP
/* Parse a line from an export list 
 * (see main program for more comments
 *  on this topic)
 *  Keys without a proper value are _usually_ set to ""
 *  _usually_ means this routine is still a bit <work in progress> ... */
Parse Arg line

resident = ""
if Pos('=', line) > 0 then
   do
   Parse Var line symname "=" extsymbol rest
   extsymbol = Strip(extsymbol, 'B', '"')
   end
else
   do
   Parse Var line symname rest
   extsymbol = ""
   end
/* if we have an ordinal we may also have a "RESIDENTNAME"/"NONAME" flag.
   Otherwise just look for pwords */
symname = Strip(symname, 'B', '"')
if Pos('@', rest) > 0 then
   /* there's an ordinal */
   do
   Parse var rest "@" number rest
   if DataType(number, "W") = 0 then
      do
      say "ParseLine(): Invalid ordinal:"number
      number = ""
      end
   word = Translate(SubWord(rest,1,1))
   if word="RESIDENTNAME" then
      do
      resident = "RESIDENTNAME"
      rest = SubWord(rest, 2)
      end
   else
      do
      if word="NONAME" then
         do
         resident = "NONAME"
         rest = SubWord(rest, 2)
         end
      end
   end
else
  /* no ordinal */
   do
   number = ""
   end
/* Only a "pwords" parameter may come here: a plain positive whole number */
if rest = "" then
   do
   pwords = ""
   end
else
   do
   if DataType(rest, "W") = 1 then
      do
      /* ok */
      pwords=rest
      end
   else
      do
      say "ParseLine(): illegal pwords:*"rest"*"
      pwords=""
      end
   end

  /* Use a separator character to return multiple values to caller: */
return symname || SEP || number || SEP || extsymbol || SEP || resident || SEP || pwords
/* End ParseLine() */


ShortHelpMessage: Procedure expose Program_name
/* Tell about help screen */
say 'Run "'Program_name' -help" for more information'
return
/* End HelpMessage */


HelpMessage: Procedure expose Program_name lib_objs_fallback list_cmd_fallback
/* Print help screen and program syntax */

say 'Syntax:'
say Program_name' -lib <name> {-version <version>} {-reference <oldfile>} {-objects <objs>}'
say '      {-listcmd <cmd>}|{-listfile <file>} {-minord <min>} {<options>}'
say '  Values in [] pairs indicate default values.'
say '  <name>        <lib_name>.dll will be created'
say '  <version>     Version string [""]'
say '  <objs>        List of object files ["'lib_objs_fallback'"]'
say '  <cmd>         Command to create the list of exported symbols'
say '                "%" gets substituted by <lib_objs> ["'list_cmd_fallback'"]'
say '  <file>        File which contains list of symbols to be exported'
say '  <oldfile>     Old .def file which includes the .def header and optionally'
say '                an export list [<lib_name>.def.dist]'
say '  <min>         Ordinal to start with. Does not work with -compat [1]'
say
say '  Valid <options> are:'
say '         -(no)compat     (Do not)  Ensure binary compatibility with <oldfile>'
say '         -(no)ord        (Do not)  Use ordinals'
say '         -(no)clone      (Do not)  Use attributes from reference file'
say '         -(no)name       (Do not)  Export symbols by name'
say '         -(no)resident   [Do not]  Keep symbols resident in memory'
say '         -(no)expinit    [Do not]  Export _DLL_InitTerm (if available)'
return
/* End HelpMessage */
