/* SIMCVT EXEC.  Version of 12 Dec 1989 */
/* Removed references to NODESCR IDX */
/* First line of preamble.  Version of 12 Dec 1989 */
   current_preamble_date = '12 Dec 1989'
   signal on ERROR; signal on NOVALUE; signal on SYNTAX; address COMMAND
/* trace r */
/* end of preamble */
/* SIMCVT3 EXEC.  Version of 21 Nov 1989 */
/* This software is provided free on an as-is basis. Use at your own   */
/* risk.                                                               */
/* Report problems to Peter Jones, UQAM, (514)-987-3542 (voice)        */
/*                                       (514)-987-7098 (FAX)          */
/*                                       MAINT@UQAM     (BITNET)       */
/*                                                                     */
/* Requires ARCUTIL MODULE, available from LISTSERV@RPIECS             */
/*     e.g. TELL LISTSERV AT RPIECS GETND ARCUTIL PACKAGE              */
/*                                                                     */
/* end of preamble */
/* Bombs if SIMIBM.ARC not present, or in wrong format */
/* SIMCVTC EXEC.  Version of 2 Sep 1989 */
/* Start from SIMIBM.ARC */
   'ARCUTIL UNARC SIMIBM ARC (REPLACE EBCDIC MEMBER SIMIBM  IDX'
/* Rewrite of SIMCVT.BAS in REXX */
/* Read the file SIMIBM.IDX (from simtel20), and print a readable form */
/* in  a file called SIMIBM.LST. */
/* On CMS, ths filetype was changed to LISTING, to use carriage control */
/* Check input file exists */
   'ESTATE SIMIBM  IDX *'
   signal off ERROR; 'FINIS  SIMIBM  IDX *'; signal on ERROR
   'EXECIO 1 EMSG (STRING SIMCVT001I SIMIBM LISTING A is being generated.'
   simeof = 0;
   lastfs = ''; lastdir = ''
   call simget
/* Print heading on output file */
   signal off ERROR; 'ERASE SIMIBM LISTING A'; signal on ERROR
   write_output = 'EXECIO 1 DISKW SIMIBM LISTING A'
   write_output '1 V 132 (STRING',
      "1WSMR-SIMTEL20.ARMY.MIL PUBLIC DOMAIN LISTING AS OF" date('O')
   call output "0NOTE: Type B is Binary; Type A is ASCII"
   do while simeof = 0; call simprt; end
   'EXECIO 1 EMSG (STRING SIMCVT002I SIMIBM LISTING A has been generated.'
   'ERASE SIMIBM  IDX'
   exit
/* Supporting I/O routines */
simprt:
   if simfs^=lastfs | simdir^=lastdir then call newfsdir
   if simbits=8 then simbits = 'B'; else simbits = 'A'
   call output ' 'left(simflnm,14)||simbits||right(simlngth,7),
      right(simdt,7) ' 'simdescr
   lastfs = simfs; lastdir = simdir
   if simeof = 0 then call simget
   return
newfsdir:
   call output '0Directory' simfs||simdir
   call output '  Filename   Type Length   Date    Description'
   call output ' =============================================='
   return
output: procedure expose write_output
   parse arg string
   write_output '(STRING' string
   return
/* Routine for input */
simget:
   signal off ERROR
      'EXECIO 1 DISKR' 'SIMIBM  IDX * (VAR SIMREC'
   signal on ERROR
   if rc = 0 then parse var simrec '"'simfs'","'simdir'","'simflnm'",',
      simrev','simlngth','simbits','simdt',"'simdescr'"'
   else simeof = 1
   return
/* first line of postamble */
error: trace 'O'; rcsave = rc
   parse source . . source_fn source_ft source_fm .
   source_id = source_fn source_ft source_fm;
   'EXECIO 1 EMSG(STRING INSRCB001T Unexpected return code' rc,
      'in file named '''source_id''' near line' sigl'.'
   address COMMAND 'DROPBUF'; exit rcsave
/* end of postamble */