home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / viscobv9.zip / vac22os2 / ibmcobol / bin / iwzvgdef.cmd < prev    next >
OS/2 REXX Batch file  |  1996-05-13  |  4KB  |  118 lines
  1. /*** IWZVGDEF.CMD                                                                     */
  2. /**************************************************************************************/
  3. /***  Licensed Material - Property of IBM                                             */
  4. /***  5622-793 (C) Copyright IBM Corp., 1996                                          */
  5. /***  All rights reserved                                                             */
  6. /***  US Government Users Restricted Rights - Use, duplication or disclosure          */
  7. /***  restricted by GSA ADP Schedule Contract with IBM Corp.                          */
  8. /**************************************************************************************/
  9. '@ECHO OFF'
  10. trace 0
  11.  
  12. parse arg objfiles
  13.  
  14. /* set variables to be used if link is requested */
  15.  
  16. deflocation = ""
  17. maxgoodrc = 4
  18. returncode = 0
  19.  
  20. environ  = 'OS2ENVIRONMENT'
  21.  
  22. defTemplate = 'iwzvmod.def'
  23.  
  24. if stream( defTemplate, 'c', 'query exists')  <> '' then
  25.    do
  26.       say defTemplate 'is in current directory'
  27.       deflocation = "CurrentDir"
  28.    end
  29. else     /* check for .def template in COBOL bin directory  */
  30.    do
  31.       defaultdefFile = value('ICOBFDIR', , environ) || '\bin\' || defTemplate
  32.       if stream(defaultdefFile, 'c', 'query exists')  <> '' then
  33.          do
  34.             say 'iwzvmod.def is in COBOL BIN directory'
  35.             deflocation = "COBOLBIN"
  36.          end
  37.    end
  38.  
  39. objfiles = strip(objfiles)
  40. do  while objfiles <> ""
  41.    if pos('"',objfiles) <> 1 then                        /* no quotes  */
  42.       parse var objfiles objfile objfiles
  43.    else /* hpfs file in quotes */
  44.       do
  45.          endpos = pos('"',objfiles,2) /* look for closing quote */
  46.          if endpos = 0 then
  47.             do
  48.                say 'Error: No closing quote found'
  49.                exit maxgoodrc+4
  50.             end
  51.          objfile = substr(objfiles,2,endpos-2)
  52.          objfiles = strip(substr(objfiles,endpos+1))
  53.       end
  54.  
  55.    parse value filespec('name',objfile) with objname '.' objext
  56.  
  57.    /* check if file.def exists in current directory  */
  58.    deffile = objname || '.def'
  59.    if stream(deffile, 'c', 'query exists')  <> '' then     /* deffile exists  */
  60.          say "Module definition file:" deffile "exists and will not be overwritten."
  61.  
  62.    else          /* Check if template exists   */
  63.       select
  64.          when deflocation = "CurrentDir"
  65.             then call createdeffile deffile objname translate(objname) defTemplate
  66.          when deflocation = "COBOLBIN"
  67.             then call createdeffile deffile objname translate(objname) defaultdefFile
  68.          otherwise
  69.             call writedeffile deffile objname translate(objname)
  70.       end  /* select */
  71.  
  72. exit returncode
  73.  
  74.  
  75. createdeffile: procedure
  76.    Arg deffile filename exportname defTemplate
  77.  
  78.    defLineIn = linein(defTemplate,1,0)
  79.    Do While lines(defTemplate) > 0
  80.       defLineIn = linein(defTemplate)
  81.       defLineOut = ''
  82.       do while defLineIn <> ''
  83.          parse var defLineIn parmIn defLineIn
  84.          select
  85.             when parmIn == 'filename' then
  86.                defLineOut = defLineOut filename
  87.  
  88.             when parmIn == 'exportname' then
  89.                defLineOut = defLineOut exportname
  90.  
  91.             otherwise
  92.                defLineOut = defLineOut parmIn
  93.  
  94.          end   /* select */
  95.       end /* do */
  96.       call lineout deffile, substr(defLineOut,2)
  97.    end   /* while */
  98.    call lineout deffile
  99. Return makedefrc
  100.  
  101. /* This procedure only gets called if the module definition template */
  102. /* (iwzvmod.def) doesn't exist in the current or default directories */
  103. writedeffile: procedure
  104.    Arg deffile filename exportname
  105.    /* only create file if it doesn't exist  */
  106.    if stream(fn, 'C', 'QUERY EXISTS') == '' then
  107.       do
  108.          call lineout deffile, ''
  109.          call lineout deffile, 'LIBRARY' filename 'INITINSTANCE TERMINSTANCE'
  110.          call lineout deffile, 'PROTMODE'
  111.          call lineout deffile, 'DATA MULTIPLE NONSHARED READWRITE LOADONCALL'
  112.          call lineout deffile, 'CODE LOADONCALL'
  113.          call lineout deffile, 'EXPORTS'
  114.          call lineout deffile, exportname
  115.          call lineout deffile
  116.       end
  117. Return makedefrc
  118.