/********************************************************************/
 /*          S A S   S A M P L E   L I B R A R Y                     */
 /*                                                                  */
 /*    NAME: TLKTLOAD                                                */
 /*   TITLE: TLKTDUMP executable module loading program              */
 /* PRODUCT: BASE                                                    */
 /*  SYSTEM: ALL                                                     */
 /*    KEYS:                                                         */
 /*   PROCS: PDSCOPY (MVS only)                                      */
 /*    DATA: NONE                                                    */
 /*                                                                  */
 /* SUPPORT: Richard D. Langston         UPDATE: JUN94               */
 /*     REF: TLKTLOAD/TLKTDUMP User Documentation                    */
 /*    MISC: Companion to the TLKTDUMP program                       */
 /*                                                                  */
 /********************************************************************/
 /* TLKTLOAD is a SAS program that reads in a text file generated by */
 /* the TLKTDUMP program. It validates the file and ensures that the */
 /* file has been tranferred correctly. If all is valid, it creates  */
 /* the executable(s) dumped by the TLKTDUMP program.                */
 /*                                                                  */
 /* First %INCLUDE this TLKTLOAD program, then use the %TLKTLOAD     */
 /* macro to invoke the program:                                     */
 /*                                                                  */
 /*      %TLKTLOAD(INFILE=dumpfile,OUTFILE=executable);              */
 /*                                                                  */
 /* The INFILE= option refers to a fileref or a quoted string giving */
 /* the name of the input dump file. This file is one that has been  */
 /* created by the TLKTDUMP program. The INFILE= option must be      */
 /* given.                                                           */
 /*                                                                  */
 /* The OUTFILE= option refers to a fileref or a quoted string giving*/
 /* the name of the executable module or library. On MVS, this will  */
 /* be a load module library. All restored modules will be added to  */
 /* (or replaced in) the library. On CMS, this will be a LOADLIB.    */
 /* All restored modules will be added to (or replaced in) the       */
 /* library.  On VMS platforms, this will be a specific  .EXE file.  */
 /* It will be replaced. On UNIX platforms, this will be a specific  */
 /* executable file, with no extension. It will be replaced. On PC   */
 /* platforms, this will be a specific  .DLL file.                   */
 /*                                                                  */
 /* The dump file can consist of several pieces that have been       */
 /* downloaded separately and "glued" back together, even if they're */
 /* not in the right order. As long as each section is separated by  */
 /* the part delimiter record, any data                              */
 /* between the delimiter records (such as EMAIL address information)*/
 /* will be ignored. If any text has been altered, or any data       */
 /* modified in any way, or if a section appears more than once or   */
 /* not at all,  the TLKTLOAD program will detect it and alert you   */
 /* in the PRINT file.                                               */
 /*                                                                  */
 /* Note that on CMS, it is required that a writeable A disk         */
 /* be present, since our temporary files are hard-coded to use      */
 /* a filemode of A.                                                 */
 /*------------------------------------------------------------------*/

%MACRO TLKTLOAD(INFILE=,OUTFILE=);
%LET VERSION = 1.02;

 /*==================================================================*/
 /* In this section, we define the temporary files for the REORDER   */
 /* and SASCODE filedefs. These files will be used in creating the   */
 /* intermediate dump file with all parts in the right order and     */
 /* without any fence information. Also at this point we will try    */
 /* to determine what the correct DCB info will be for the executable*/
 /* if possible.                                                     */
 /*==================================================================*/

 /*------------------------------------------------------------------*/
 /* We may need to perform an explicit OS command to delete the      */
 /* REORDER and SASCODE temporary files used during our execution.   */
 /* To ensure we can simply reference the macro variable to invoke   */
 /* the command, we create dummy values for the macro variables that */
 /* are simply comments.                                             */
 /*------------------------------------------------------------------*/

%LET DELREORD= * No deletion of REORDER necessary;
%LET DELSASCD= * No deletion of SASCODE necessary;

 /*------------------------------------------------------------------*/
 /* MVS-type operating systems simply use &&-prefixed data set names */
 /* which will be deleted when the SAS job terminates. We defer      */
 /* setting our file DCB until we determine if the dump represents   */
 /* an IEBCOPY dump file or a PROC PDSCOPY dump file.                */
 /*------------------------------------------------------------------*/

%IF "&SYSSCP."="OS" %THEN %DO;
    %LET REORDER= '&&REORDER';
    %LET SASCODE= '&&SASCODE';
    %END;

 /*------------------------------------------------------------------*/
 /* CMS uses real file names, and therefore the DELREORD and DELSASCD*/
 /* macro variables are set to the proper ERASE commands. Note that  */
 /* we also set the DCB of the LOADLIB file.                         */
 /*------------------------------------------------------------------*/

%ELSE %IF "&SYSSCP."="CMS" %THEN %DO;
    %LET DCB=RECFM=V LRECL=32760;
    %LET REORDER= 'TEMP REORDER A';
    %LET SASCODE= 'TEMP SASCODE A';
    %LET DELREORD= X "ERASE TEMP REORDER A";
    %LET DELSASCD= X "ERASE TEMP SASCODE A";
    %END;

 /*------------------------------------------------------------------*/
 /* For VMS, we can place the files in SAS$WORKLIB, which gets       */
 /* cleared when the SAS job terminates. We can also set the DCB     */
 /* at this time.                                                    */
 /*------------------------------------------------------------------*/

%ELSE %IF "&SYSSCP."="VMS" OR "&SYSSCP."="VMS_AXP" %THEN %DO;
    *-----obtain VMS DCB for EXE file-----*;
    %LET DCB=RECFM=F LRECL=512;
    %LET REORDER= 'SAS$WORKLIB:REORDER.DAT';
    %LET SASCODE= 'SAS$WORKLIB:SASCODE.SAS';
    %END;

 /*------------------------------------------------------------------*/
 /* For PC platforms, we use explicit file names and set the         */
 /* DEL commands to delete the files. Note that we use OPTIONS       */
 /* NOXWAIT to ensure that the user doesn't have to terminate the    */
 /* shell session.                                                   */
 /*------------------------------------------------------------------*/

%ELSE %IF "&SYSSCP."="OS2" %OR "&SYSSCP."="WIN" %THEN %DO;
    %LET DCB=RECFM=N;
    OPTIONS NOXWAIT;
    %LET REORDER= 'REORDER.TMP';
    %LET SASCODE= 'SASCODE.TMP';
    %LET DELREORD= X "DEL REORDER.TMP";
    %LET DELSASCD= X "DEL SASCODE.TMP";
    %END;

 /*------------------------------------------------------------------*/
 /* For UNIX platforms, we use explicit file names in /tmp, but      */
 /* we also set up rm commands to ensure that the files are cleaned  */
 /* up.                                                              */
 /*------------------------------------------------------------------*/

%ELSE %DO;
    %LET DCB=RECFM=N;
    %LET REORDER= "/tmp/reorder.tmp.&sysjobid.";
    %LET SASCODE= "/tmp/sascode.tmp.&sysjobid.";
    %LET DELREORD= x "rm /tmp/reorder.tmp.&sysjobid.";
    %LET DELSASCD= x "rm /tmp/sascode.tmp.&sysjobid.";
    %END;

*------print initial information in print file-----------------------*;
DATA _NULL_; FILE PRINT;
     PUT 'TLKTLOAD: A SAS program to create SAS/TOOLKIT(TM)'
         'executables from downloaded TLKTDUMP files';
     PUT "Version &VERSION.";
     PUT "Requested INPUT file: &INFILE";
     PUT "Requested OUTPUT file: &OUTFILE";
     RUN;

 /*------------------------------------------------------------------*/
 /* Since we allow either a fileref or an explicit file name for     */
 /* both INFILE= and OUTFILE=, we must ensure that we have a fileref */
 /* for each, since some code later on may require a fileref and not */
 /* permit an explicit file name. We do this by verifying if the     */
 /* first character of the INFILE and OUTFILE macro variables is a   */
 /* quote (single or double). If either, then we consider the string */
 /* to be an explicit name, in which case a FILENAME statement is    */
 /* generated in a macro variable (FILEST1 or FILEST2). If the name  */
 /* is already a fileref, then FILESTx is a comment statement.       */
 /* We also create the macros INFILEX and OUTFILEX which will always */
 /* contain filerefs, either provided by the user via INFILE= and    */
 /* OUTFILE= or produced via our generated FILENAME statements.      */
 /*------------------------------------------------------------------*/

DATA _NULL_;
     LENGTH WHICH $8;
     WHICH = 'INFILE'; NUMBER=1; LINK DOIT;
     WHICH = 'OUTFILE'; NUMBER=2; LINK DOIT;
     RETURN;
DOIT:;
     XFILE=LEFT(SYMGET(WHICH));
     IF SUBSTR(XFILE,1,1)='"' OR SUBSTR(XFILE,1,1)="'" THEN DO;
        FILENAME='RDL'!!PUT(NUMBER,Z5.);
        STMT='FILENAME '!!TRIM(FILENAME)!!' '!!XFILE;
        END;
     ELSE DO;
        FILENAME=XFILE;
        STMT='* No FILENAME statement necessary for '!!WHICH;
        END;
     CALL SYMPUT(TRIM(WHICH)!!'X',TRIM(FILENAME));
     CALL SYMPUT('FILEST'!!PUT(NUMBER,1.),STMT);
     RETURN;
     RUN;

*-----invoke the possible FILENAME statements------------------------*;
&FILEST1;
&FILEST2;

 /*==================================================================*/
 /* In this section, we read through the dump file and determine     */
 /* the start and end locations for each part of the dump. This is   */
 /* necessary because the parts may not be in the right order, and   */
 /* also because we permit extraneous records (such as mail headers) */
 /* to appear between the parts. With this first pass of the dump    */
 /* file, the only error checking done is to ensure that each IDENT  */
 /* indicator is the same and that we encounter and EOF record       */
 /* somewhere in the dump.                                           */
 /* Note that each part is delineated by a header and trailer record */
 /* that starts with ****PART in column 1. The part number follows,  */
 /* followed then by some identifier string. That string can be      */
 /* supplied by the dump creator, but the string always has the      */
 /* creation datetime appended to it.                                */
 /*==================================================================*/

DATA PARTS; INFILE &INFILEX LENGTH=L END=EOF;
     RETAIN MAXPARTN FOUNDEOF 0 SEQUENCE START IDENT_S;
     LENGTH IDENT $80;

     *-----read a record of the dump---------------------------------*;
     INPUT @; INPUT @1 RECORD $VARYING80. L;

     *-----if the record is a part header, obtain more info----------*;
     IF RECORD=:'****PART ' THEN DO;

        *-----get the IDENT info from the record---------------------*;
        I=INDEX(RECORD,'IDENT = ');
        IF I THEN DO;
           I+8;
           I+(SUBSTR(RECORD,I,1)=':');
           RRECORD=REVERSE(RECORD);
           J=81-VERIFY(RRECORD,'* ');
           IDENT=SUBSTR(RECORD,I,J-I+1);
           END;

        *-----get the part number from the record--------------------*;
        WHICH=SCAN(SUBSTR(RECORD,13),1,': ');
        NUM=SCAN(RECORD,2,' ');
        IF VERIFY(NUM,'0123456789 ')=0 THEN DO;
           SEQUENCE=INPUT(NUM,BEST12.);
           MAXPARTN=MAX(MAXPARTN,SEQUENCE);
           END;

        *-----part number XXX means we found the last section--------*;
        ELSE IF NUM='XXX'
           THEN FOUNDEOF=1;

        *-----record the record number of start of data--------------*;
        IF WHICH='START' THEN DO;
           START=_N_+1;
           IDENT_S=IDENT;
           END;

        *-----record the record number of end of data----------------*;
        ELSE DO;
           END=_N_-1;

           *-----ensure IDENT values match between start and end-----*;
           IF IDENT_S NE IDENT THEN DO;
              FILE PRINT;
              PUT 'ERROR: IDENT labels for start and end do not '
                  'match for part ' sequence;
              ABORT;
              END;
           OUTPUT;
           END;
        END;

     *-----if at end of file, ensure we found an EOF record----------*;
     IF EOF THEN DO;
        IF NOT FOUNDEOF THEN DO;
           PUT 'ERROR: An EOF was not found in the dump file, '
               'indicating at least the last section was omitted.';
           ABORT;
           END;

        *-----save part count for later use--------------------------*;
        CALL SYMPUT('MAXPARTN',PUT(MAXPARTN,10.));
        END;
     KEEP SEQUENCE START END IDENT;
     RUN;

 /*------------------------------------------------------------------*/
 /* Verify that all the IDENT values are the same for all parts. If  */
 /* not, we have an error condition.                                 */
 /*------------------------------------------------------------------*/

DATA _NULL_; SET PARTS END=EOF; BY IDENT NOTSORTED;
     NDIFF+FIRST.IDENT;
     IF EOF AND NDIFF NE 1;
     FILE PRINT;
     PUT 'ERROR: Identifying string is not the same for all parts '
         'of the dump';
     ABORT;
     RUN;

 /*------------------------------------------------------------------*/
 /* Sort the section indicators into the correct sequence. We also   */
 /* create a set of observations to merge together to ensure that    */
 /* there is one and only one section per sequence number.           */
 /*------------------------------------------------------------------*/

PROC SORT DATA=PARTS(DROP=IDENT); BY SEQUENCE;
DATA MATCHUP;
     DO SEQUENCE=0 TO &MAXPARTN;
        OUTPUT;
        END;
     RUN;

 /*------------------------------------------------------------------*/
 /* Now merge the two together and ensure that 1) all sections are   */
 /* present and 2) no section is repeated.                           */
 /*------------------------------------------------------------------*/

DATA _NULL_; MERGE PARTS(IN=HAVE) MATCHUP END=EOF; BY SEQUENCE;
     FILE PRINT;
     RETAIN ERROR 0;
     IF NOT HAVE THEN DO;
        PUT 'ERROR: Part ' sequence ' of the dump file is not '
            'present. Processing cannot continue.';
        ERROR = 1;
        END;
     ELSE IF NOT (FIRST.SEQUENCE AND LAST.SEQUENCE) THEN DO;
        PUT 'ERROR: Part ' sequence ' of the dump file appears '
            'multiple times. Processing cannot continue.';
        ERROR = 1;
        END;
     IF EOF AND ERROR
        THEN ABORT;
     RUN;

 /*------------------------------------------------------------------*/
 /* At this point, we know that the dump contains all the sections   */
 /* we need, and we know the locations of each section. We generate  */
 /* a SAS program into the SASCODE file that will be of the form     */
 /*                                                                  */
 /*        DATA _NULL_; INFILE &INFILEX                              */
 /*                            LENGTH=L FIRSTOBS=x OBS=y;            */
 /*                     FILE REORDER <MOD>;                          */
 /*             INPUT @; INPUT @1 LINE $VARYING200. L;               */
 /*             IF LINE NE ' ' THEN PUT _INFILE_;                    */
 /*             RUN;                                                 */
 /*                                                                  */
 /* This code will write into the REORDER file only the dump records */
 /* we want, eliminating headers/trailers and any other superfluous  */
 /* text, including blank lines. Note that the MOD option is not     */
 /* used for the first DATA step. Also, blank lines are preserved    */
 /* for the first part of the dump, which is textual in nature.      */
 /*------------------------------------------------------------------*/

*-----ensure we have FILEREFs for REORDER and SASCODe----------------*;
FILENAME REORDER &REORDER;
FILENAME SASCODE &SASCODE;

*-----Generate the SAS code described above--------------------------*;
DATA _NULL_; SET PARTS(RENAME=(START=FIRSTOBS END=OBS)); FILE SASCODE;
     LENGTH MOD $3;
     RETAIN OBS MOD;
     IF SEQUENCE=0
        THEN CALL SYMPUT('STARTREC',PUT(OBS-FIRSTOBS+2,BEST12.));
     PUT "DATA _NULL_; INFILE &INFILEX LENGTH=L " FIRSTOBS= OBS=
         '; FILE REORDER ' MOD ';';
     PUT 'INPUT @; INPUT @1 LINE $VARYING200. L; ';
     IF SEQUENCE NE 0 THEN PUT "IF LINE NE ' ' THEN ";
     PUT "PUT _INFILE_;";
     PUT 'RUN;';
     MOD='MOD';
     RUN;

*-----Invoke the SAS code that has just been generated---------------*;
%INC SASCODE; RUN;

*-----Clear out the SASCODE file since it is no longer needed--------*;
FILENAME SASCODE CLEAR;
&DELSASCD;

*------get information from the header portion-----------------------*;
DATA _NULL_; INFILE REORDER LENGTH=L END=EOF;

     *-----get ident, length, version, host-----*;
     LENGTH LRECL $8 TLKTDMPV $4 HOST IEBCOPY $8 RECFM $8 BLKSIZE $8;
     INPUT LRECL= HOST= & TLKTDMPV= IEBCOPY= ;
     FILELREC=LRECL;

     *-----get IEBCOPY information if necessary-----*;
     if IEBCOPY='YES' THEN DO;
        INPUT @19 RECFM= LRECL= BLKSIZE=;
        CALL SYMPUT('RECFM',TRIM(RECFM));
        CALL SYMPUT('IEBLRECL',TRIM(LRECL));
        CALL SYMPUT('BLKSIZE',TRIM(BLKSIZE));
        END;
     ELSE IEBCOPY='NO';

     *-----make macros out of ident and lrecl for later use-----*;
     CALL SYMPUT('LRECL',TRIM(FILELREC));
     CALL SYMPUT('IEBCOPY',TRIM(IEBCOPY));

     *-----verify we are on the right host-----*;
     IF HOST NE "&SYSSCP." THEN DO;
        FILE PRINT;
        PUT 'ERROR: The TLKTDUMP file is meant for the ' HOST
            ' operating system but this SAS program is being '
            "run on the &SYSSCP. operating system.";
        ABORT;
        END;

     *-----warn if the version number does not match-----*;
     IF TLKTDMPV NE "&VERSION" THEN DO;
        FILE PRINT;
        PUT 'WARNING: The TLKTDUMP file was generated with TLKTDUMP'
            ' Version ' TLKTDMPV ' but this TLKTLOAD is '
            " Version &VERSION.. Beware of incompatibilities...";
        END;
     STOP;
     RUN;

 /*------------------------------------------------------------------*/
 /* Here we have to do some host-specific things. For MVS, we must   */
 /* now deal with IEBCOPY information. The IEBCOPY utility is very   */
 /* sensitive about correct DCB information for its unload file.     */
 /* Therefore, when TLKTDUMP creates a dump file, it records the DCB */
 /* of the unload file so that we will be able to recreate the       */
 /* file with correct DCBs. If instead we're using the PDSCOPY       */
 /* unload file, we can always use DCB=(RECFM=VB,LRECL=32756,        */
 /* BLKSIZE=32760). And note that if we are not recreating an        */
 /* IEBCOPY unload file, we're recreating a PDSCOPY unload file,     */
 /* which must be a temporary. Therefore, we redefine the output     */
 /* file to be SEQFILE. Note that we used OUTFILEX earlier to hold   */
 /* the output fileref. We can redefine OUTFILEX to SEQFILE for      */
 /* PDSCOPY unload files. For CMS, we have to deal with the          */
 /* peculiarity that the DATA step does not permit you to use a      */
 /* LOADLIB file as an output file. This is because it expects you   */
 /* to treat the LOADLIB file as a library, not as a sequential      */
 /* file. To overcome this, we use a temporary file TEMP DATA A and  */
 /* have the fileref RDL00003 refer to it. We reset OUTFILEX         */
 /* accordingly. Once we populate TEMP DATA A, we'll copy it to the  */
 /* desired LOADLIB file.                                            */
 /*------------------------------------------------------------------*/

%IF "&SYSSCP."="OS" %THEN %DO;
    %IF "&IEBCOPY." NE "YES" %THEN %DO;
        %LET DCB=RECFM=VB LRECL=32756 BLKSIZE=32760;
        FILENAME SEQFILE '&&OUT';
        %LET OUTFILEX=SEQFILE;
        %END;
     %ELSE %LET DCB=RECFM=&RECFM LRECL=&IEBLRECL BLKSIZE=&BLKSIZE;
     %END;

%IF "&SYSSCP."="CMS" %THEN %DO;
     FILENAME RDL00003 'TEMP DATA A';
     %LET OUTFILEX=RDL00003;
     %END;

 /*------------------------------------------------------------------*/
 /* Finally, we are at the point where we can read through the dump  */
 /* file and create our local binary file from the dump.             */
 /*------------------------------------------------------------------*/

DATA _NULL_; INFILE REORDER FIRSTOBS=&STARTREC END=EOF LENGTH=INRECL;
     LENGTH STG $160 SRECLEN $20;
     RETAIN PRECNUM RECNUM PARTNUM 0;

     *-----not getting hex data (getting length value)-----*;
     HEX=0;

     *-----get length of next restore record-----*;
     LINK GETLEN;
     IF LENGTH=0 /* EOF */
        THEN STOP;

     *-----read the hex data, computing checksum and making binary---*;
     CHECKSUM=0;
     I=1;
     HEX=1;
     DO WHILE(I<=LENGTH);

        *-----extract a piece-----*;
        LINK GETCOMP;

        *-----accumulate checksum-----*;
        DO K=1 TO L;
           CHECKSUM=MOD(CHECKSUM+INPUT(SUBSTR(STG,K,1),PIB1.)+1,32768);
           END;

        *-----write out the piece-----*;
        LINK PUTDATA;
        I+L;
        END;

     *-----not in hex mode (getting checksum)-----*;
     HEX=0;

     *-----flush the binary record-----*;
     L=0; LINK PUTDATA;

     *-----absorb comma-----*;
     L=1; LINK GETDATA;

     *-----get the checksum and validate against computed one-----*;
     LINK GETLEN;
     IF LENGTH NE CHECKSUM THEN DO;
        FILE PRINT;
        PUT 'ERROR: For restore file record number ' RECNUM
            '(input file record ' NRECS ')'
            ' the provided checksum and the computed checksum '
            ' did not match. there is a data integrity problem.';
        ABORT;
        END;

     *-----on to next restore file record-----*;
     RETURN;

*-----routine to get recnum and length from input file-----*;
GETLEN:;
     J=1;

     *-----read string of format xxxx:yyyy,-----*;
     DO UNTIL(STG=',');

        *-----get a single byte-----*;
        L=1;
        LINK GETDATA;

        *-----concatenate in-----*;
        SUBSTR(SRECLEN,J,1)=STG;
        J+1;
        END;

     *-----read recnum before colon, length after-----*;
     RECNUM=INPUT(SCAN(SRECLEN,1,':,'),5.);
     LENGTH=INPUT(SCAN(SRECLEN,2,':,'),5.);
     RETURN;

*-----routine to generate a stream of uncompressed data-----*;
GETCOMP:;

     *-----read the indicator byte first-----*;
     L=1;
     LINK GETDATA;
     COMPBYTE=INPUT(SUBSTR(STG,1,1),PIB1.);

     *-----if over 127, this indicates compression-----*;
     IF COMPBYTE>127 THEN DO;

        *-----get rid of high-order bit to get length-----*;
        COMPBYTE=COMPBYTE-128;

        *-----read the repeating byte-----*;
        L=1;
        LINK GETDATA;

        *-----generate the complete string-----*;
        STG=REPEAT(SUBSTR(STG,1,1),COMPBYTE-1);
        L=COMPBYTE;
        END;

     *-----otherwise we get the specified number of bytes-----*;
     ELSE DO;
        L=COMPBYTE;
        LINK GETDATA;
        END;
     RETURN;

*-----read L bytes of binary data from the hex dump-----*;
GETDATA:;
     RETAIN INCOL 1;
     LENGTH PART $&LRECL;

     *-----determine actual bytes to read, depending on hex mode-----*;
     LL=L*(1+HEX);
     II=1; STG=' ';

     *-----read that many bytes-----*;
     DO WHILE(II<=LL);

        *-----read remaining bytes, or all we need-----*;
        LLL=MIN(LL-II+1,&LRECL-INCOL+1);
        INPUT @INCOL PART $VARYING&LRECL.. LLL @@;

        *-----concatenate that into STG-----*;
        SUBSTR(STG,II,LLL)=PART;
        INCOL+LLL;

        *-----if at end of record, see if next record is a fence-----*;
        IF INCOL>&LRECL THEN DO;
           INPUT;
           NRECS+1;
           INCOL=1;
           END;

        *-----increment data-read count and continue-----*;
        II+LLL;
        END;

     *-----if the data are supposed to be in hex...-----*;
     IF HEX THEN DO;

        *-----verify only hex characters used-----*;
        IF VERIFY(SUBSTR(STG,1,LL),'0123456789ABCDEF') THEN DO;
           FILE PRINT;
           PUT 'ERROR: invalid hex characters in string at about '
               'input record ' NRECS ':' STG;
           ABORT;
           END;

        *-----informat the string using $HEX-----*;
        STG=INPUT(SUBSTR(STG,1,LL),$HEX160.);
        END;
     RETURN;

*-----write out the resulting string to the output file-----*;
PUTDATA:;
     FILE &OUTFILEX &DCB;
     IF L=0 THEN PUT;
     ELSE PUT STG $VARYING80. L @@;
     FILE LOG;
     RETURN;

RUN;

*-----we are done with the dump file and can clear it now------------*;
FILENAME REORDER CLEAR;
&DELREORD;

 /*------------------------------------------------------------------*/
 /* We have to do some final things on a host-specific basis.        */
 /* For MVS, if we are dealing with a PDSCOPY unload file, we need   */
 /* to run PROC PDSCOPY to convert the unload file into a real       */
 /* load module PDS. For CMS, we must rename the TEMP DATA A file    */
 /* to the desired LOADLIB file name. This is somewhat tricky on     */
 /* CMS because if we don't have the fileid, we have to obtain it    */
 /* by redirecting the SAS log of a DATA step that accesses the      */
 /* fileref, since the DATA step reports the fileid.                 */
 /* To deal with all this mess, we create a fileref of RDL00004 to   */
 /* refer to a temporary file RDL00004 RDLLOG A. We run PROC PRINTTO */
 /* to redirect the SAS log to that file, then run a DATA step that  */
 /* references the output file. We then run PROC PRINTTO to stop the */
 /* redirection, then read RDL00004 RDLLOG A to get the fileid as    */
 /* specified by the DATA step. We then can issue a COPY command to  */
 /* copy TEMP DATA A to the proper fileid, then we ERASE TEMP DATA   */
 /* A. Note that we can't issue a RENAME because the final LOADLIB   */
 /* file may reside on a different disk.                             */
 /*------------------------------------------------------------------*/

%IF "&SYSSCP."="OS" & "&IEBCOPY." NE "YES" %THEN %DO;
*-----for MVS, convert to a load module library via PDSCOPY----------*;
    PROC PDSCOPY IN=SEQFILE OUT=&OUTFILE INTAPE; RUN;
    FILENAME SEQFILE CLEAR;
    %END;

%IF "&SYSSCP."="CMS" %THEN %DO;
*-----for CMS, get fileid and issue COPY and ERASE-------------------*;
    FILENAME RDL00004 'RDL00004 RDLLOG A';
    PROC PRINTTO LOG=RDL00004 NEW; RUN;
    DATA _NULL_; INFILE &OUTFILE; STOP; RUN;
    PROC PRINTTO; RUN;
    DATA _NULL_; INFILE RDL00004 LENGTH=L;
         INPUT @; INPUT @1 LINE $VARYING133. L;
         LINE=UPCASE(LINE);
         IF INDEX(LINE,'FILENAME=');
         FILENAME=SCAN(LINE,2,'=,');
         RC = CMS('COPY TEMP DATA A '!!FILENAME!!'(REPLACE');
         RC = CMS('ERASE TEMP DATA A');
         STOP;
         RUN;
    FILENAME RDL00003 CLEAR;
    FILENAME RDL00004 CLEAR;
    X 'ERASE RDL00004 RDLLOG A';
    %END;

*------put trailer with support information-----*;
DATA _NULL_; FILE PRINT;
     PUT 'End of TLKTLOAD processing';
     PUT //;
     PUT 'For questions/comments about this SAS program,';
     PUT 'contact:';
     PUT // 'Rick Langston';
     PUT    'Product Manager, SAS/TOOLKIT Software';
     PUT    'SAS Institute Inc.';
     PUT    'SAS Campus Drive';
     PUT    'Cary, NC 27513';
     PUT    '919/677-8000 X7613';
     PUT    'EMAIL: sasrdl@unx.sas.com';
%MEND TLKTLOAD;