/********************************************************************/
 /*                                                                  */
 /*               Copyright (c) 1995, SAS Institute Inc.             */
 /*                 Unpublished - All Rights Reserved                */
 /*                                                                  */
 /*                   S A S / C   S A M P L E                        */
 /*                                                                  */
 /*  This sample demonstrates how to maitain a single C execution    */
 /*  framework in a C and Assembler environment.                     */
 /*                                                                  */
 /*  ALOADM is a two part sample, for detailed information on this   */
 /*  sample see: SAMPLASM MACLIB(ALOADMM)                            */
 /*                                                                  */
 /*                                                                  */
 /*  Note: RMODE(24)/AMODE(24) used in this sample to allow it       */
 /*        to run on either CMS or BIMODAL CMS.                      */
 /*                                                                  */
 /********************************************************************/

 Trace o
 parse upper arg args .

 Parse Source . . myname .

 Address command

 exit_rc = 0

 If args = '?' | args = 'HELP'
   Then
    Do
     Call SHOW_HELP
     Signal EXIT_SAMPLE
    End

/*--------------------------------------------------------------------*/
/* Misc Varialbles and Constants                                      */
/*--------------------------------------------------------------------*/
  myname = myname||': '

  break_line = '------------------------------------------------------'

  asm_command = 'HLASM'

/*--------------------------------------------------------------------*/
/* VM/ESA 2.2 CMS Maclibs                                 <== Verify  */
/*--------------------------------------------------------------------*/
  vm_mac_fn      = 'DMSGPI'
  vm_maclib      = vm_mac_fn||' MACLIB *'

  vm_macos_fn    = 'OSMACRO'            /* For ABEND macro           */
  vm_macoslib    = vm_macos_fn||' MACLIB *'

/*--------------------------------------------------------------------*/
/* SAS/C Maclibs                                          <== Verify  */
/*--------------------------------------------------------------------*/
  sascomp_mac_fn = 'LC370'
  sascomp_maclib = sascomp_mac_fn||' MACLIB *'

  sasasm_mac_fn  = 'LCUSER'
  sasasm_maclib  = sasasm_mac_fn||' MACLIB *'

/*--------------------------------------------------------------------*/
/* SAS/C Resident Libraries                               <== Verify  */
/*--------------------------------------------------------------------*/
  sasbas_txtlib  = 'LC370BAS'
  sasstd_txtlib  = 'LC370STD'

/*--------------------------------------------------------------------*/
/* SAS/C Sample Source Files                              <== Verify  */
/*--------------------------------------------------------------------*/
  aloadma_fn  = 'ALOADMA'
  aloadma_fid = aloadma_fn||' ASSEMBLE *'
  aloadmc_fn  = 'ALOADMC'
  aloadmc_fid = aloadmc_fn||' C *'
  aloadmd_fn  = 'ALOADMD'
  aloadmd_fid = aloadmd_fn||' C *'
  aloadmm_fn  = 'ALOADMM'
  aloadmm_fid = aloadmm_fn||' C *'

/*--------------------------------------------------------------------*/
/* Tell'm we are here.                                                */
/*--------------------------------------------------------------------*/
  Say myname 'SAS/C Compiler Example Running'
  Say myname
  Say myname 'This sample uses the following VM Maclibs:'
  Say myname '  'vm_mac_fn
  Say myname '  'vm_macos_fn
  Say myname

/*--------------------------------------------------------------------*/
/* Verify required maclibs are present, exit if they are not found.   */
/*--------------------------------------------------------------------*/
  'SET CMSTYPE HT'                    /* Lower the curtain            */
  'ESTATE' sascomp_maclib             /* SAS/C Maclib                 */
  macc_rc = rc

  'ESTATE' sasasm_maclib              /* SAS/C Assembler Macros       */
  maca_rc = rc

  'ESTATE' vm_maclib                  /* Look for VM/CMS Maclib       */
   macvm_rc = rc

  'SET CMSTYPE RT'                    /* Raise the curtain            */

/* If any maclibs are missing exit with message.                      */
  If (macc_rc >  0 | macvm_rc >  0)
    Then Do
          If macc_rc  >  0 Then
                   Say myname 'SAS/C  Maclib Not Found: 'sascomp_maclib
          If maca_rc  >  0 Then
                   Say myname 'SAS/C  Maclib Not Found: 'sasasm_maclib
          If macvm_rc >  0 Then
                   Say myname 'VM/CMS Maclib Not Found: 'vm_maclib
          If macosvm_rc >  0 Then
                   Say myname 'VM/CMS Maclib Not Found: 'vm_macoslib
          Say myname'Customize as necessary and re-run!'
          exit_rc = 16
          Signal EXIT_SAMPLE
     End

/*--------------------------------------------------------------------*/
/* Verify required files for this sample are present, if not exit.    */
/*--------------------------------------------------------------------*/
  'SET CMSTYPE HT'                    /* Lower the curtain            */
  'ESTATE' aloadma_fid                /* Assembler Module             */
  aloadma_rc = rc
  'ESTATE' aloadmc_fid                /* C Function                   */
  aloadmc_rc = rc
  'ESTATE' aloadmd_fid                /* Dynamically Loaded C funciton*/
  aloadmd_rc = rc
  'ESTATE' aloadmm_fid                /* C Main                       */
  aloadmm_rc = rc
  'SET CMSTYPE RT'                    /* Raise the curtain            */

/* If any source files are missing exit with a message                */
  If (  aloadma_rc >  0 | aloadmc_rc >  0,
      | aloadmd_rc >  0 | aloadmm_rc >  0 )
    Then Do
          If aloadma_rc >  0 Then
                     Say myname 'Soruce Missing: 'aloadma_fid
          If aloadmc_rc >  0 Then
                     Say myname 'Soruce Missing: 'aloadmc_fid
          If aloadmd_rc >  0 Then
                     Say myname 'Soruce Missing: 'aloadmd_fid
          If aloadmm_rc >  0 Then
                     Say myname 'Soruce Missing: 'aloadmm_fid
          Say myname
               'Please make source files listed availbale and re-run!'
        exit_rc = 16
        Signal EXIT_SAMPLE
   end

/*--------------------------------------------------------------------*/
/* Assemble the Assembler routine - NONINDEP Version                  */
/*--------------------------------------------------------------------*/
  Say myname||break_line
  Call HLASM_ASM aloadma_fn 'SYSPARM(NOINDEP)'
  parse var result exit_rc .

  If exit_rc >  0 Then signal EXIT_SAMPLE
  aloadma_nonindep = aloadma_fn||'N'

  'SET CMSTYPE HT'
  'ERASE' aloadma_nonindep||' TEXT A'
  'SET CMSTYPE RT'

  'RENAME' aloadma_fn||' TEXT A' aloadma_nonindep||' TEXT A'

/*--------------------------------------------------------------------*/
/* Assemble the Assembler routine - INDEP Version                     */
/*--------------------------------------------------------------------*/
  Say myname||break_line
  Call HLASM_ASM'ALOADMA' 'SYSPARM(INDEP)'
  parse var result exit_rc .

  If exit_rc >  0 Then signal EXIT_SAMPLE
  aloadma_indep = aloadma_fn||'I'

  'SET CMSTYPE HT'
  'ERASE' aloadma_indep||' TEXT A'
  'SET CMSTYPE RT'

  'RENAME' aloadma_fn||' TEXT A' aloadma_indep||' TEXT A'

/*--------------------------------------------------------------------*/
/* COMPILE:  SAS/C Main                                               */
/*--------------------------------------------------------------------*/
  Say myname||break_line
  Call SAS_COMPILE 'ALOADMM' 'RENT '
  parse var result exit_rc .

  If exit_rc >  0 Then signal EXIT_SAMPLE

/*--------------------------------------------------------------------*/
/* COMPILE:  SAS/C function to display CRAB                           */
/*--------------------------------------------------------------------*/
  Say myname||break_line
  Call SAS_COMPILE 'ALOADMC' 'RENT '
  parse var result rc .

  If exit_rc >  0 Then signal EXIT_SAMPLE

/*--------------------------------------------------------------------*/
/* COMPILE:  SAS/C dynamically loaded function                        */
/*--------------------------------------------------------------------*/
  Say myname||break_line
  Call SAS_COMPILE 'ALOADMD' 'RENT '
  parse var result exit_rc .

  If exit_rc >  0 Then signal EXIT_SAMPLE

/*--------------------------------------------------------------------*/
/* Lked dynamically loadable module and place in loadlib.             */
/*--------------------------------------------------------------------*/
  Say myname||break_line
  trace o
  Call LKED_DYNAMIC
  parse var result exit_rc .

  If exit_rc > 0 Then signal EXIT_SAMPLE

/*--------------------------------------------------------------------*/
/* Create SAS/C Main Module                                           */
/*--------------------------------------------------------------------*/
  Say myname||break_line
  Say myname 'Building Sample: C-Main->Assembler>Dynamic C'
  Trace o

  'EXEC CLINK' aloadmm_fn aloadma_nonindep aloadmc_fn
  exit_rc = rc

  If exit_rc >  0
    Then Do
      Say myname 'CLINK failed with rc: ' exit_rc
      Signal EXIT_SAMPLE
     End

  'LOAD CLINK370 (RLD RESET MAIN RMODE 24 AMODE 24'
  exit_rc = rc

  If exit_rc >  0
    Then Do
      Say myname 'LOAD failed see LOAD MAP for details.'
      signal EXIT_SAMPLE
     End
    Else Do
      'ERASE LOAD MAP A'
      'ERASE CLINK370 TEXT A'
     End

  'GENMOD ALOADM1 (FROM @MAIN'

  exit_rc = rc
  If exit_rc >  0
    Then Do
      Say myname 'GENMOD failed, fix errors and restart.'
      signal EXIT_SAMPLE
     End

  Say myname 'Building Sample           : End , RC: ' exit_rc

/*--------------------------------------------------------------------*/
/* Create SAS/C Main Module                                           */
/*--------------------------------------------------------------------*/
  Say myname||break_line
  Say myname 'Building Sample: Assembler->Dynamic C'

  'EXEC CLINK'  aloadma_indep aloadmc_fn
  exit_rc = rc

  If exit_rc >  0
    Then Do
      Say myname 'CLINK failed with rc: ' exit_rc
      Signal EXIT_SAMPLE
     End

  'LOAD CLINK370 ( RLD RESET CASM RMODE 24 AMODE 24'
  exit_rc = rc

  If exit_rc >  0
    Then Do
      Say myname 'LOAD failed see LOAD MAP for details.'
      signal EXIT_SAMPLE
     End
    Else Do
      'ERASE LOAD MAP A'
      'ERASE CLINK370 TEXT A'
     End

  'GENMOD ALOADM2 ( FROM CASM@'
  exit_rc = rc

  If exit_rc >  0
    Then Do
      Say myname 'GENMOD failed, fix errors and restart.'
      signal EXIT_SAMPLE
     End

  Say myname 'Building Sample           : End , RC: ' exit_rc

/*--------------------------------------------------------------------*/
/* Tell'm we have finished and the command names.                     */
/*--------------------------------------------------------------------*/
  Say myname||break_line
  Say myname' ALOADM Sample modules have been succefully built, '
  Say myname' to execute issue the following:'
  Say myname' '
  Say myname'    Command   Description'
  Say myname'    ALOADM1 - C main calling statically linked, non-INDEP'
  Say myname'              assembler which in turn dynamically loads'
  Say myname'              and executes a non-INDEP C function.'
  Say myname' '
  Say myname'    ALOADM2 - INDEP Assembler dynamically loads and'
  Say myname'              executes a  non-INDEP C function.'
  Say myname' '

EXIT_SAMPLE:

  Say myname||break_line

  If args = 'DEBUG' /* If debug not passed cleanup after myself.     */
    Then Nop
    Else Do
     'SET CMSTYPE RT'                /* Lower the curtain            */
     'ERASE' aloadma_indep||' TEXT A'
     'ERASE' aloadma_nonindep||' TEXT A'
     'ERASE' aloadma_fn||' LISTING A'
     'ERASE' aloadmc_fn||' TEXT A'
     'ERASE' aloadmc_fn||' LISTING A'
     'ERASE' aloadmd_fn||' TEXT A'
     'ERASE' aloadmd_fn||' LISTING A'
     'ERASE' aloadmm_fn||' TEXT A'
     'ERASE' aloadmm_fn||' LISTING A'
     'SET CMSTYPE RT'                /* Raise the curtain            */
   End

exit exit_rc

/*--------------------------------------------------------------------*/
/*                                                                    */
/* Internal Rexx Functions Follow                                     */
/*                                                                    */
/*--------------------------------------------------------------------*/

/*--------------------------------------------------------------------*/
/* Compile a SAS/C input file                                         */
/*--------------------------------------------------------------------*/
  SAS_COMPILE: procedure expose myname sascomp_mac_fn

   parse upper arg sasc_file sasc_options

  Trace o

  'GLOBAL MACLIB' sascomp_mac_fn

  Say myname 'Compile : Start module: ' sasc_file

  'SET CMSTYPE HT'                            /* Lower Curtain        */
  'EXEC LC370' sasc_file   '(' sasc_options ')'
  compile_rc = rc

  'SET CMSTYPE RT'                            /* Raise Curtain        */

  If compile_rc ^= 0
    Then Do
      Say myname 'SAS/C Failed    : 'sasc_file
      Say myname 'Return Code was: ' compile_rc
      Say myname 'Make corrections as needed and re-run'
      Exit 16
     End

  Say myname 'Compile : End   -  Return Code: ' compile_rc

  Trace o
  return compile_rc

/*--------------------------------------------------------------------*/
/* Assemble an assembler program.                                     */
/*--------------------------------------------------------------------*/
HLASM_ASM: procedure expose myname,
              sasasm_mac_fn vm_mac_fn vm_macos_fn asm_command
  Trace o

  parse upper arg assemble_fn options

  Say myname 'Assemble: Start module: ' assemble_fn

  'GLOBAL MACLIB' sasasm_mac_fn vm_mac_fn vm_macos_fn
  exit_rc = rc
  If exit_rc  > 0
    Then Do
      Say myname 'Global Maclib Failed'
      Say myname 'Return Code was: ' exit_rc
      Say myname 'Make corrections as needed and re-run'
      signal  EXIT_ASSEMBLE
     End

  'MAKEBUF'
  'QUERY MACLIB ( STACK'
  parse upper pull maclist
  'DROPBUF'

  Say myname  maclist

  asm_command assemble_fn '(' options ')'
  exit_rc = rc

  If exit_rc ^= 0
    Then Do
      Say myname 'Assembler failed: 'assemble_fn
      Say myname 'Return Code was: ' exit_rc
      Say myname 'Make corrections as needed and re-run'
     End

  Say myname 'Assemble: End   -  Return Code: ' exit_rc

  EXIT_ASSEMBLE:
  Trace o
  return exit_rc

/*--------------------------------------------------------------------*/
/* Display information about this sample.                             */
/*--------------------------------------------------------------------*/
SHOW_HELP: procedure expose myname

  Say myname||break_line
  Say myname' ALOADM is a SAS/C sample to demonstrate how to maintain'
  Say myname' a single C execution framework.  For detailed information'
  Say myname' see : SAMPLASM MACLIB (ALOADMM)'
  Say myname' '
  Say myname' This exec produces the following two commands:'
  Say myname'    Command   Description'
  Say myname'    ALOADM1 - C main calling statically linked, non-INDEP'
  Say myname'              assembler which in turn dynamically loads'
  Say myname'              and executes a non-INDEP C function.'
  Say myname' '
  Say myname'    ALOADM2 - INDEP Assembler dynamically loads and'
  Say myname'              executes a  non-INDEP C function.'
  Say myname' '
  Return 0

/*--------------------------------------------------------------------*/
/* Lked dynamically loadable module and place in loadlib.             */
/*--------------------------------------------------------------------*/
LKED_DYNAMIC: procedure expose myname aloadmd_fn aloadmc_fn,
              sasbas_txtlib sasstd_txtlib

  Trace o

  Say myname 'Building Dynamically Loaded Module: Start'

  'SET CMSTYPE HT'                    /* Lower the curtain            */
  'ERASE DYNAMC LOADLIB A'
  'ERASE CLINK370 TEXT  A'
  'SET CMSTYPE RT'                    /* Raise the curtain            */

  'GLOBAL TXTLIB' sasbas_txtlib sasstd_txtlib

  text1 = " INCLUDE ALOADMD"
  text2 = " INCLUDE ALOADMC"
  text3 = " NAME CDYNLD"

  'EXECIO 1 DISKW CDYNLD TEXT A 1 F 80 (        VAR TEXT1'
  'EXECIO 1 DISKW CDYNLD TEXT A 2 F 80 (        VAR TEXT2'
  'EXECIO 1 DISKW CDYNLD TEXT A 3 F 80 ( FINIS  VAR TEXT3'

  'EXEC CLINK  CDYNLD ( LKED LIBE DYNAMC '
  exit_rc = rc

  If exit_rc >  0
    Then Do
     Say myname 'CLINK failed, rc: ' exit_rc
     signal EXIT_SAMPLE
    End
   Else
    Do
    'ERASE CLINK370 TEXT A'
    'ERASE CLINK370 LKEDIT A'
    End

  EXIT_LKED:
  Say myname 'Building Dynamically Loaded Module: End , RC: ' exit_rc
  Trace o
  return exit_rc