/* rexx */                                                                      
/*-------------------------------------------------------------------*/         
/*                                                                   */         
/*                       REXX Exec : VALIDVOL                        */         
/*                                                                   */         
/*  Description : Validate a passed volume serial number             */         
/*                                                                   */         
/*  Created on : 14 Feb 2021                                         */         
/*  Created by : KEVIN FERGUSON                                      */         
/*             : Userid(MIT001)                                      */         
/*             : using ABBYDALE.DEVL.REXX(VALIDVOL)                  */         
/*                                                                   */         
/*  Called by : XMT                                                  */         
/*                                                                   */         
/*  Calls : LISTDSI                                                  */         
/*                                                                   */         
/*  Change Activity :                                                */         
/*                                                                   */         
/*                ©Copyright of Abbydale Systems LLC.                */         
/*                                                                   */         
/*-------------------------------------------------------------------*/         
pee = ''                                                                        
signal on novalue                /* un-initialized vars */                      
signal on halt                   /* attention key       */                      
valid = 8                        /* Set default return code */                  
parse upper arg volser                                                          
if volser = "" then do                                                          
   do while volser = ""                                                         
   Say 'Enter volser to validate. (use <QUIT> to terminate)'                    
   parse upper pull volser                                                      
   if volser = '<QUIT>' then exit                                               
   if LENGTH(volser) <> 6 then do                                               
      volser = ""                                                               
      say 'Invalid volume serial number length. Re-enter'                       
   end                                                                          
   end                                                                          
end                                                                             
if volser = "?" then do                                                         
   call disp_help                                                               
   exit(4)                                                                      
end                                                                             
if LENGTH(volser) <> 6 then do                                                  
   say 'Invalid volume serial number length'                                    
   exit(valid)                                                                  
end                                                                             
MyDsn=finddsn()                                                                 
If pos('(',MyDsn)>0 then Do                                                     
   MyDsn = SubStr(MyDsn,2,pos('(',MyDsn)-2)                                     
end                                                                             
TrapON=OutTrap('ON')                                                            
"ALLOC F(ASLTEMP) DATASET('"userid()".ASLTEMP')" ,                              
       "NEW VOL("volser") UNIT(SYSALLDA)",                                      
       "LIKE('"mydsn"') SPACE(1)"                                               
valid = rc                                                                      
if valid = 0 then do                                                            
   "FREE F(ASLTEMP)"                                                            
   "DEL '"userid()".ASLTEMP'"                                                   
end                                                                             
TrapON=OutTrap('OFF')                                                           
exit(valid)                                                                     
finddsn:                                                                        
Procedure                                                                       
answer='* UNKNOWN *'                   /* assume disaster            */         
Parse Source . . name dd ds .          /* get known info             */         
Call listdsi(dd 'FILE')                /* get 1st ddname from file   */         
Numeric digits 10                      /* allow up to 7FFFFFFF       */         
If name = '?' Then                     /* if sequential exec         */         
  answer=''''ds''''                    /* use info from parse source */         
Else                                   /* now test for members       */         
  If sysdsn(''''sysdsname'('name')''')='OK' Then /* if in 1st ds     */         
    answer=''''sysdsname'('name')'''   /* go no further              */         
  Else                                 /* hooboy! Lets have some fun!*/         
    Do                                 /* scan tiot for the ddname   */         
      tiotptr=24+ptr(12+ptr(ptr(ptr(16)))) /* get ddname array       */         
      tioelngh=c2d(stg(tiotptr,1))     /* length of 1st entry        */         
      Do Until tioelngh=0 | tioeddnm = dd /* scan until dd found     */         
        tioeddnm=strip(stg(tiotptr+4,8)) /* get ddname from tiot     */         
        If tioeddnm <> dd Then         /* if not a match             */         
          tiotptr=tiotptr+tioelngh     /* advance to next entry      */         
        tioelngh=c2d(stg(tiotptr,1))   /* length of next entry       */         
      End                                                                       
      If dd=tioeddnm Then              /* if we found it, loop through          
                                          the data sets doing an swareq         
                                          for each one to get the               
                                          dsname                     */         
        Do Until tioelngh=0 | stg(4+tiotptr,1)<> " "                            
          tioejfcb=stg(tiotptr+12,3)                                            
          jfcb=swareq(tioejfcb)        /* convert SVA to 31-bit addr */         
          dsn=strip(stg(jfcb,44))      /* dsname JFCBDSNM            */         
          vol=storage(d2x(jfcb+118),6) /* volser JFCBVOLS (not used) */         
          If sysdsn(''''dsn'('name')''')='OK' Then /* found it?      */         
            Leave                      /* we is some happy campers!  */         
          tiotptr=tiotptr+tioelngh     /* get next entry             */         
          tioelngh=c2d(stg(tiotptr,1)) /* get entry length           */         
        End                                                                     
      answer=''''dsn'('name')'''       /* assume we found it         */         
    End                                                                         
Return answer                                                                   
                                                                                
ptr:  Return c2d(storage(d2x(Arg(1)),4))                                        
stg:  Return storage(d2x(Arg(1)),Arg(2))                                        
                                                                                
swareq:                                                                         
Procedure                                                                       
If right(c2x(Arg(1)),1) \= 'F' Then    /* SWA=BELOW ?                */         
  Return c2d(Arg(1))+16                /* yes, return sva+16         */         
svaexit2d(Arg(1))                      /* convert to decimal         */         
tcb = c2d(storage(21c,4))              /* TCB PSATOLD                */         
tcb = ptr(540)                         /* TCB PSATOLD                */         
jscb = ptr(tcb+180)                    /* JSCB TCBJSCB               */         
qmpl = ptr(jscb+244)                   /* QMPL JSCBQMPI              */         
qmat = ptr(qmpl+24)                    /* QMAT QMADD                 */         
Do While sva>65536                                                              
  qmat = ptr(qmat+12)                  /* next QMAT QMAT+12          */         
  sva=sva-65536                        /* 010006F -> 000006F         */         
End                                                                             
Return ptr(qmat+sva+1)+16                                                       
/*-------------------------------------------------------------------*/         
/*                      disp_help procedure                          */         
/*-------------------------------------------------------------------*/         
disp_help: procedure                                                            
pgm_name=sysvar("sysicmd")                                                      
if pgm_name="" then pgm_name="VALIDVOL"                                         
say left(pgm_name,8) "- a REXX exec that will validate a volume serial."        
say ""                                                                          
say "Usage: VALIDVOL volser | ? "                                               
say ""                                                                          
say "     volser - Name of the volume serial number to be tested."              
say "     ?      - generates this information."                                 
say ""                                                                          
say "    Return Codes : 0 - valid volume serial number"                         
say "                   4 - Help displyed"                                      
say "                  12 - Invalid volume serial number"                       
Say "                  16 - Critical error"                                     
return                                                                          
/*-------------------------------------------------------------------*/         
/*                      trap NOVALUE condition                       */         
/*-------------------------------------------------------------------*/         
novalue:                                                                        
say 'NOVALUE entered from line' sigl                                            
say condition("D")                                                              
say 'The instruction is suppressed'                                             
address "TSO"                                                                   
"delstack"                                                                      
exit(16)                                                                        
/*-------------------------------------------------------------------*/         
/*                        trap HALT condition                        */         
/*-------------------------------------------------------------------*/         
halt:                                                                           
say 'HALT acknowledged in line' sigl                                            
say 'Cleanup processing in progress'                                            
address "TSO"                                                                   
"delstack"                                                                      
exit(16)                                                                        
/*-------------------------------------------------------------------*/         
/*                          End of VALIDVOL                          */         
/*-------------------------------------------------------------------*/