/* This macro will determine the memnames for
    a specified format catalog and invoke the READMEM macro for 
    each member to obtain the stats for the format. */

%macro get_fmt_mem_sizes(fmtcat); 
%global inputstmt;
%do_setup; 
 /*-----obtain the list of all members of the format catalog-----*/
proc catalog c=&fmtcat.; 
     contents out=temp; 
     quit; 

 /*-----construct %READMEM invocations for each member-----*/
filename sascode temp; 
data _null_; set temp; file sascode; 
     put '%readmem(' libname ',' memname ',' name ',' type ');';
     run;

 /*-----run this set of macro invocations-----*/
%include sascode/source2;      
run;
filename sascode clear; 

 /* at this point, work.stats contains the information */
%mend get_fmt_mem_sizes; 
 /* This macro will read the first record of a specified 
    format catalog member and will obtain the nranges, nlabels,
    totlabsize, and totrangsize from the record. The &INPUTSTMT
    macro variable should have already been set to the proper 
    INPUT statement to use for obtaining these fields. The 
    information obtained is appended into the work.stats data 
    set. */

%macro readmem(libname,catname,memname,memtype);
%global inputstmt;  
filename mycat catalog "&libname..&catname..&memname..&memtype."; 
data work.temp; infile mycat obs=1; 
     length memname $32; 
     memname="&memname."; 
     &inputstmt; 
     if "&sysscp." IN('LINUX','DNTHOST','OS') or 
        ("&sysscp."='WIN' and index("&sysscpl.",'64')=0) 
        then ptrsize = 4; 
     else ptrsize = 8; 
     ptr_array_size = nranges*ptrsize; 
     computed_memusage = 200 + ptr_array_size + totrangsize + totlabsize; 
     keep computed_memusage;
     run;
filename mycat clear; 
proc append base=work.stats data=work.temp; run;
%mend readmem; 

 /* This macro will construct the proper INPUT statement to read 
    the nranges, nlabels, totlabsize, and totrangsize fields from
    format header records. */

%macro do_setup;  
%global inputstmt; 

*-----create a single format with nranges=2 nlabels=3 fuzz=1-----*; 
proc format library=work.mycat;
     value abc (fuzz=1) 1='yes' 2='no' other='maybe'; 
     run;

*-----read the member to determine sizeof(long) and endianness-----*;
filename mycat catalog 'work.mycat.abc.format';
data _null_; infile mycat length=l obs=1;

     *-----possible layouts for nranges and nlabels-----*; 
     retain long4bigendian '0000000200000003'x; 
     retain long4ltlendian '0200000003000000'x; 
     retain long8bigendian '00000000000000020000000000000003'x; 
     retain long8ltlendian '02000000000000000300000000000000'x; 

     *-----read the first record-----*; 
     input @1 record $varying200. l;

     *-----find the FUZZ=1 field-----*; 
     fuzzrb = put(1,rb8.); 
     fuzzloc = index(record,fuzzrb);

     *-----determine endianness from first byte of FUZZ-----*; 
     if substr(fuzzrb,1,1)='00'x 
        then endian='L'; 
     else endian='B'; 

     *-----for big endian, see if 4-byte or 8-byte long-----*; 
     if endian='B' then do; 
        l4bi_i = index(record,long4bigendian); 
        l8bi_i = index(record,long8bigendian); 
        if l4bi_i then do; 
           long=4; nrangesloc=l4bi_i; 
           end;
        else do; 
           long=8; nrangesloc=l8bi_i; 
           end;
        end;

     *-----for little endian, see if 4-byte or 8-byte long-----*; 
     else do; 
        l4li_i = index(record,long4ltlendian); 
        l8li_i = index(record,long8ltlendian);
        if l4li_i then do; 
           long=4; nrangesloc=l4li_i; 
           end;
        else do; 
           long=8; nrangesloc=l8li_i; 
           end;
        end; 

     *-----totlabsize/totrangsize are right after otherloc (3)-----*; 
     otherloc = index(substr(record,fuzzloc+8),'03'x) + fuzzloc+7; 
     if endian='B' then sizesloc=otherloc+1; 
     else sizesloc=otherloc+long;

     *-----construct the INPUT statement to use-----*; 
     length infmt $6; 
     infmt='(ib'||put(long,1.)||'.)'; 
     inputstmt =   'input'
                 ||' @'||put(nrangesloc,z3.)
                 ||'(nranges nlabels)'
                 ||infmt
                 ||' @'||put(sizesloc,z3.)
                 ||'(totlabsize totrangsize)'
                 ||infmt
                 ||';';  

     *-----create the macro variable for the INPUT statement-----*; 
     call symput('inputstmt',trim(inputstmt)); 
     run;
filename mycat clear; 
proc datasets dd=work; delete mycat/mt=catalog; quit;
%mend do_setup;


/* create a test format in the WORK library */
/* this test is soley for illustration purposes to test the macro */
proc format lib=work;
value $testfmt 1='apple' 2='ball' c='cat'
;

/*  evaluate the amount of memory for the test format */
/*  pass in the libref and format name of the catalog */

%get_fmt_mem_sizes(work.formats);