 /* REXX */
 /*********************************************************************/
 /* Licensed Material - Property of IBM                               */
 /* 5639-B92 , 5648-A25 , 5688-197 , 5639-D65 , 5688-235              */
 /* (C) Copyright IBM Corp., 1997, 1998                               */
 /* All rights reserved.                                              */
 /* US Government Users Restricted Rights - Use, duplication or       */
 /* disclosure restricted by GSA ADP Schedule Contract with IBM Corp. */
 /*********************************************************************/
 trace off;
 signal on novalue;
 parse upper arg type usequal rest;
 alldata = xrange('40'x,'ff'x);
 select;
   when type = 'CREATE' then
     do;
     nextpos = 1;
     do ii = 1 to 12;
       line.ii = substr(alldata,nextpos,16);
       nextpos = nextpos + 16;
       end;
     line.0 = 12;
     junk = outtrap('tsoout.');
     output_name = usequal'.@@TEMP@@.TESTTRAN.FB';
     recfm = 'F B';
     call alloc_output;
     'execio * diskw' output_dd '(STEM line. FINIS';
     execio_rc = rc;
     'FREE FILE(IGYFTRAN)';
     if execio_rc <> 0 then
       call execio_err;
     output_name = usequal'.@@TEMP@@.TESTTRAN.VB';
     recfm = 'V B';
     call alloc_output;
     'execio * diskw' output_dd '(STEM line. FINIS';
     execio_rc = rc;
     'FREE FILE(IGYFTRAN)';
     if execio_rc <> 0 then
       call execio_err;
     junk = outtrap('OFF');
     say 'OK';
     exit 0;
     end;
   when type = 'TEST' then
     do;
     junk = outtrap('tsoout.');
     input_name = usequal'.@@TEMP@@.TESTTRAN.FBO';
     call alloc_input;
     'execio * diskr' input_dd '(STEM line. FINIS';
     execio_rc = rc;
     'FREE FILE(IGYFTRAN)';
     junk = outtrap('OFF');
     if execio_rc <> 0 then
       call execio_err;
     if line.0 <> 12 then
       do;
       say 'ERROR number of lines read was' line.0 ', expected 12';
       exit 16;
       end;
     match = 'yes';
     nextpos = 1;
     do ii = 1 to 12;
       testdata = substr(alldata,nextpos,16);
       testline = substr(line.ii,1,16);
       if testdata == testline then
         nop;
       else
         do;
         match = 'no';
         leave;
         end;
       nextpos = nextpos + 16;
       end;
     if match = 'yes' then
       do;
       say 'OK';
       exit 0;
       end;
     input_name = usequal'.@@TEMP@@.TESTTRAN.FB';
     call callinfo;
     input_name = usequal'.@@TEMP@@.TESTTRAN.VB';
     call callinfo;
     say 'OK';
     exit 0;
     end;
   otherwise
     do;
     say 'ERROR invalid request';
     exit 16;
     end;
 /* */
 callinfo:
 junk = outtrap('tsoout.');
 "IGYFINFO '"input_name"'";
 junk = outtrap('OFF');
 if tsoout.0 < 1 then
   do;
   say 'ERROR unknown output from IGYFINFO';
   exit 16;
   end;
 parse upper var tsoout.1 rcode recfm,
   lrecl dsorg seqnum alias badhex memexist tempdsn rest;
 if badhex = 'NO' then
   do;
   call create_tran;
   say 'BAD';
   exit 0;
   end;
 input_name = strip(badhex,'B',"'");
 junk = outtrap('tsoout.');
 call alloc_input;
 'execio * diskr' input_dd '(STEM line2. FINIS';
 execio_rc = rc;
 'FREE FILE(IGYFTRAN)';
 if execio_rc <> 0 then
   call execio_err;
 'DELETE' badhex;
 junk = outtrap('OFF');
 if line2.0 <> 12 then
   do;
   say 'ERROR number of lines read was' line2.0 ', expected 12';
   exit 16;
   end;
 nextpos = 1;
 do ii = 1 to 12;
   testdata = substr(alldata,nextpos,16);
   testline = substr(line.ii,1,16);
   testline2 = substr(line2.ii,1,16);
   do jj = 1 to 16;
     testdatac = substr(testdata,jj,1);
     testlinec = substr(testline,jj,1);
     testline2c = substr(testline2,jj,1);
     if testdatac == testlinec then
       nop;
     else
       do;
       if testline2c <> '00'x then
         do;
         call create_tran;
         say 'BAD';
         exit 0;
         end;
       end;
     end;
   nextpos = nextpos + 16;
   end;
 return;
 /* */
 alloc_output:
 if sysdsn("'"output_name"'") = 'OK' then
   do;
   "ALLOCATE FILE(IGYFTRAN) OLD REUSE DA('"output_name"')";
   allocate_rc = rc;
   if allocate_rc <> 0 then
     do;
     say 'ERROR Allocate for output file failed , RC ='allocate_rc;
     exit allocate_rc;
     end;
   end;
 else
   do;
   "ALLOCATE FILE(IGYFTRAN) NEW REUSE DA('"output_name"')",
     " TRACKS SPACE(1 1) RECFM("recfm") LRECL(80) BLKSIZE(6160)";
   allocate_rc = rc;
   if allocate_rc <> 0 then
     do;
     say 'ERROR Allocate for output file failed , RC ='allocate_rc;
     exit allocate_rc;
     end;
   end;
 output_dd = 'IGYFTRAN';
 return;
 /* */
 create_tran:
 junk = outtrap('tsoout.');
 output_name = usequal'.@@TEMP@@.IGYFINF.ASM';
 recfm = 'F B';
 call alloc_output;
 drop outline.
 outline.1 = 'BADHEX   DS    0C';
 outline.2 = '         DC    64AL1(1)        00-3F ALL BAD';
 nextpos = 1;
 nextout = 3;
 pad = '        ';
 do ii = 1 to 12;
   testdata = substr(alldata,nextpos,16);
   testline = substr(line.ii,1,16);
   do jj = 1 to 16;
     testdatac = substr(testdata,jj,1);
     testlinec = substr(testline,jj,1);
     charhex = c2x(testdatac);
     if testdatac == testlinec then
       outline.nextout = '         DC    AL1(0)' pad charhex 'OK';
     else
       outline.nextout = '         DC    AL1(1)' pad charhex 'BAD';
     nextout = nextout + 1;
     end;
   nextpos = nextpos + 16;
   end;
 outline.0 = 194;
 'execio * diskw' output_dd '(STEM outline. FINIS';
 execio_rc = rc;
 'FREE FILE(IGYFTRAN)';
 if execio_rc <> 0 then
   call execio_err;
 output_name = usequal'.@@TEMP@@.IGYFINFO.CLIST';
 call alloc_output;
 drop outline.
 hexout = '00000000000000000000000000000000';
 outline.1 = "hextrout = '';";
 outline.2 = "hextrout = hextrout||'"hexout"'X;";
 outline.3 = "hextrout = hextrout||'"hexout"'X;";
 outline.4 = "hextrout = hextrout||'"hexout"'X;";
 outline.5 = "hextrout = hextrout||'"hexout"'X;";
 nextpos = 1;
 nextout = 6;
 do ii = 1 to 12;
   testdata = substr(alldata,nextpos,16);
   testline = substr(line.ii,1,16);
   hexout = '';
   do jj = 1 to 16;
     testdatac = substr(testdata,jj,1);
     testlinec = substr(testline,jj,1);
     charhex = c2x(testdatac);
     if testdatac == testlinec then
       hexout = hexout||charhex;
     else
       hexout = hexout||'00';
     end;
   outline.nextout = "hextrout = hextrout||'"hexout"'X;";
   nextout = nextout + 1;
   nextpos = nextpos + 16;
   end;
 outline.0 = 17;
 'execio * diskw' output_dd '(STEM outline. FINIS';
 execio_rc = rc;
 'FREE FILE(IGYFTRAN)';
 if execio_rc <> 0 then
   call execio_err;
 junk = outtrap('OFF');
 return;
 /* */
 alloc_input:
 "ALLOCATE FILE(IGYFTRAN) SHR REUSE DA('"input_name"')";
 allocate_rc = rc;
 if allocate_rc <> 0 then
   do;
   say 'ERROR Allocate for input file failed , RC ='allocate_rc;
   exit allocate_rc;
   end;
 input_dd = 'IGYFTRAN';
 return;
 /* */
 execio_err:
 junk = outtrap('OFF');
 say 'ERROR EXECIO error, RC =' execio_rc;
 exit execio_rc;
