* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * "If it's squinky, then you know it's BrilligWare!" * * * * * * * * Source available at www.brilligware.com * * * * Brillig Enterprises (aka Chris Pando) (c)2007 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * This work is licensed under a * * * * Creative Commons Attribution-NonCommercial-ShareAlike * * * * license: * * * * * * * * http://creativecommons.org/licenses/by-nc-sa/3.0/legalcode * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * The author disclaims all warranties with regard to this * * * * software, including all implied warranties of merchantability * * * * and fitness. In no event shall the author be liable for any * * * * special, indirect or consequential damages or any damages * * * * whatsoever resulting from loss of use, data or profits, * * * * whether in an action of contract, negligence or other * * * * tortious action, arising out of or in connection with the use * * * * or performance of this software. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * This software remains the property of Brillig Enterprises * * * * (aka Chris Pando) and can be used or copied only in * * * * accordance with the terms of the agreement. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Print the IFS v3.14 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * CRTBNDRPG PGM(CPANDO/CP1240R) SRCFILE(CPANDO/SRC) * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * h dftActGrp(*No) actGrp(*new) bnddir('QC2LE') * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ... files ... * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * fqsysprt o f 132 Printer OflInd(*InOF) UsrOpn * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ... procedure interfaces ... * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ... entry interfaces ... * * * d entryParms pr ExtPgm('CP1240R') d pmPath 80a d pmSortMask 3u 0 d entryParms pi d pmPath 80a d pmSortMask 3u 0 * * internal procedures * d compQSort1 pr 10i 0 d * Value d * Value d compQSort2 pr 10i 0 d * Value d * Value d compQSort3 pr 10i 0 d * Value d * Value d compQSort4 pr 10i 0 d * Value d * Value d compQSort5 pr 10i 0 d * Value d * Value d compQSort6 pr 10i 0 d * Value d * Value d heapMe pr d init pr d load pr d print pr * * external procedures (from the C run-time library) * d ctime pr * ExtProc('ctime') d * Value d memcmp pr 10i 0 ExtProc('memcmp') d * Value d * Value d 10i 0 Value d memcpy pr ExtProc('memcpy') d * Value d * Value d 10i 0 Value d memset pr ExtProc('memset') d * Value d 10i 0 Value d 10i 0 Value d qsort pr ExtProc('qsort') d * Value d 10i 0 Value d 10i 0 Value d * Value ProcPtr d strcmp pr 10i 0 ExtProc('strcmp') d * Value d * Value d tera_malloc pr * ExtProc('_C_TS_malloc') d 10i 0 Value * * external procedures (from the UNIX-like APIs) * d closeDir pr ExtProc('closedir') d * Value d lstat pr 10i 0 ExtProc('stat') d * Value d * Value d openDir pr * ExtProc('opendir') d * Value d readDir pr * ExtProc('readdir') d * Value * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ... data structures ... * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * used for records in heap storage * d recordDS ds Based(ds@) d objSiz 10i 0 d objDat 10i 0 d objLen 10i 0 d pthLen 10i 0 d pth@ * d obj@ * d objTyp 10a d hmDS ds LikeDS(recordDS) Based(hm@) * * directory entry information * d ds Based(dirEnt@) d szObj 53 56b 0 d obj 57 696a * * sort comparison routines * d ds d * ProcPtr Inz(*NULL) d * ProcPtr Inz(%PAddr(compQSort1)) d * ProcPtr Inz(%PAddr(compQSort2)) d * ProcPtr Inz(%PAddr(compQSort3)) d * ProcPtr Inz(%PAddr(compQSort4)) d * ProcPtr Inz(%PAddr(compQSort5)) d * ProcPtr Inz(%PAddr(compQSort6)) d @compQSort@ 1 112* ProcPtr Dim(7) * * file status information * d fStat ds 128 d fStatDat 29 32i 0 d fStatSiz 45 48i 0 d fStatTyp 49 58a * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ... standalone variables ... * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * d start@ s * d ds@ s * Based(ds@@) d hm@ s * Based(hm@@) d dir@ s * d fStat@ s * Inz(%Addr(fStat)) d stkPtrL s 10i 0 d stkPtrR s 10i 0 d recordDSSize s 10i 0 Inz(%Size(recordDS) ) d pointerSize s 10i 0 Inz(%Size(ds@)) d $I s 10i 0 d $J s 10i 0 d time_string s 24a Based(time_string@) d text s 97a d path s 1024a d qsysdotlib s 10a Inz('QSYS.LIB ') d sortMask s Like(pmSortMask) * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ... Constants ... * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * d DIRECTORY c '*DIR ' d LIBRARY c '*LIB ' d SLASH c x'61' '/' d SORTMASKDFT c x'52' 0101 0010 d STKPTRMAX c 1000000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Mainline * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * /free *InLR = *On; init(); load(); print(); Return; BegSR *InzSR; If ( %PARMS >= 2 ); sortMask = pmSortMask; Else; sortMask = SORTMASKDFT; EndIf; EndSR; /end-free * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ... "O" specs ... * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * oqsysprt e detail 0 1 o text 97 o time_string 121 o objSiz z 132 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Procedures * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * load arrays * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * p load b d pi /free DoU ( stkPtrL > stkPtrR Or stkPtrR > STKPTRMAX ); If ( objTyp = DIRECTORY Or objTyp = LIBRARY ); dir@ = openDir( pth@ ); path = *Blanks; memcpy( %Addr(path) : pth@ : pthLen ); If ( dir@ <> *NULL ); dirEnt@ = readDir(dir@); // . dirEnt@ = readDir(dir@); // .. dirEnt@ = readDir(dir@); DoW ( dirEnt@ <> *NULL ); heapMe(); dirEnt@ = readDir(dir@); EndDo; EndIf; closeDir(dir@); EndIf; stkPtrL = stkPtrL + 1; ds@@ = ds@@ + pointerSize; EndDo; Return; /end-free p load e * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * print * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * p print b d pi d len s Like(objLen) /free // // It takes a lot longer to build the heap than it does to sort it, // so it makes sense to enable multiple sorts/prints on a single run. // // print requests are contained within a one byte mask: // // bit sort order // --- ---------------- // 8 - n/a // 7 - size, descending // 6 - size, ascending // 5 - date, descending // 4 - date, ascending // 3 - file order // 2 - path order // 1 - no order // // for path order, date(descending) and size(descending): // 0101 0010 = x'52' = 82 // For $I = 1 to %Elem(@compQSort@); If ( 1 = %Rem(sortMask:2) ); Open qsysprt; // // sort // If ( *NULL <> @compQSort@($I) ); qsort( start@ : stkPtrR : pointerSize : @compQSort@($I) ); EndIf; // // print // ds@@ = start@; For $J = 1 to stkPtrR; If ( pthLen > 97 ); len = 97; Else; len = pthLen; EndIf; text = *Blanks; memcpy( %Addr(text) : pth@ : len ); time_string@ = ctime(%Addr(objDat)); Except detail; ds@@ = ds@@ + pointerSize; EndFor; Close qsysprt; EndIf; sortMask = sortMask/2; EndFor; Return; /end-free p print e * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Create a heap entry * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * p heapMe b d pi d newPath s Like(path) d newPathLen s 10i 0 /free If ( szObj <> 8 Or 0 <> memcmp( %Addr(obj) // not interested in : %Addr(qsysdotlib) // QSYS.LIB : 8 ) ); stkPtrR = stkPtrR + 1; hm@@ = hm@@ + pointerSize; hm@ = %Alloc(recordDSSize); memcpy( %Addr(newPath) : %Addr(path) : pthLen ); memcpy( %Addr(newPath) + pthLen : %Addr(obj) : szObj ); memset( %Addr(newPath) + pthLen + szObj : x'00' : 1 ); newpathlen = pthLen + szObj + 1; lstat( %Addr(newPath) : fStat@ ); If ( fStatTyp = DIRECTORY Or fStatTyp = LIBRARY ); memset( %Addr(newPath) + pthLen + szObj : SLASH : 1 ); memset( %Addr(newPath) + pthLen + szObj + 1 : x'00' : 1 ); newPathLen = newPathLen + 1; hmDS.obj@ = *Null; hmDS.objLen = 0; Else; hmDS.obj@ = %Alloc(szObj); hmDS.objLen = szObj; memcpy( hmDS.obj@ : %Addr(obj) : szObj ); EndIf; hmDS.pthLen = newPathLen - 1; // don't include x'00' hmDS.pth@ = %Alloc(newPathLen); memcpy( hmDS.pth@ : %Addr(newPath) : newPathLen ); hmDS.objTyp = fStatTyp; hmDS.objDat = fStatDat; hmDS.objSiz = fStatSiz; EndIf; Return; /end-free p heapMe e * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ... qsort compares ... * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Path Order * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * p compQSort1 b d pi 10i 0 d ds1@@ * Value d ds2@@ * Value d ds1 ds LikeDS(recordDS) Based(ds1@) d ds2 ds LikeDS(recordDS) Based(ds2@) d ds1@ s * Based(ds1@@) d ds2@ s * Based(ds2@@) /free Return strcmp( ds1.pth@ : ds2.pth@ ); /end-free p compQSort1 e * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * File Order (Optimized - Warning! - Magic Code) * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * p compQSort2 b d pi 10i 0 d ds1@@ * Value d ds2@@ * Value d ds1 ds LikeDS(recordDS) Based(ds1@) d ds2 ds LikeDS(recordDS) Based(ds2@) d ds1@ s * Based(ds1@@) d ds2@ s * Based(ds2@@) d memcmpval s 10i 0 d compLen s 10i 0 /free Select; When ( ds1.objLen <> 0 and ds2.objLen <> 0 ); If (ds1.objLen < ds2.objLen); compLen = ds1.objLen; Else; compLen = ds2.objLen; EndIf; memcmpval = memcmp( ds1.obj@ : ds2.obj@ : compLen ); Select; When ( memcmpval <> 0 ); Return memcmpval; When ( ds1.ObjLen < ds2.objLen ); Return -1; When ( ds1.ObjLen > ds2.objLen ); Return 1; Other; Return strcmp( ds1.pth@ // if objects are equal : ds2.pth@ ); // sort on path name EndSl; When ( ds2.objLen <> 0 ); // ds1.objLen = 0 Return -1; When ( ds1.objLen <> 0 ); // ds2.objLen = 0 Return 1; Other; // ds1.objLen = ds2.objLen = 0 Return strcmp( ds1.pth@ : ds2.pth@ ); EndSl; /end-free p compQSort2 e * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Date - Ascending * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * p compQSort3 b d pi 10i 0 d ds1@@ * Value d ds2@@ * Value d ds1 ds LikeDS(recordDS) Based(ds1@) d ds2 ds LikeDS(recordDS) Based(ds2@) d ds1@ s * Based(ds1@@) d ds2@ s * Based(ds2@@) /free Select; When ( ds1.objDat < ds2.objDat ); Return -1; When ( ds1.objDat > ds2.objDat ); Return 1; Other; Return strcmp( ds1.pth@ : ds2.pth@ ); EndSl; /end-free p compQSort3 e * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Date - Descending * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * p compQSort4 b d pi 10i 0 d ds1@@ * Value d ds2@@ * Value d ds1 ds LikeDS(recordDS) Based(ds1@) d ds2 ds LikeDS(recordDS) Based(ds2@) d ds1@ s * Based(ds1@@) d ds2@ s * Based(ds2@@) /free Select; When ( ds1.objDat < ds2.objDat ); Return 1; When ( ds1.objDat > ds2.objDat ); Return -1; Other; Return strcmp( ds1.pth@ : ds2.pth@ ); EndSl; /end-free p compQSort4 e * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Size - Ascending * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * p compQSort5 b d pi 10i 0 d ds1@@ * Value d ds2@@ * Value d ds1 ds LikeDS(recordDS) Based(ds1@) d ds2 ds LikeDS(recordDS) Based(ds2@) d ds1@ s * Based(ds1@@) d ds2@ s * Based(ds2@@) /free Select; When ( ds1.objSiz < ds2.objSiz ); Return -1; When ( ds1.objSiz > ds2.objSiz ); Return 1; Other; Return strcmp( ds1.pth@ : ds2.pth@ ); EndSl; /end-free p compQSort5 e * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Size - Descending * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * p compQSort6 b d pi 10i 0 d ds1@@ * Value d ds2@@ * Value d ds1 ds LikeDS(recordDS) Based(ds1@) d ds2 ds LikeDS(recordDS) Based(ds2@) d ds1@ s * Based(ds1@@) d ds2@ s * Based(ds2@@) /free Select; When ( ds1.objSiz < ds2.objSiz ); Return 1; When ( ds1.objSiz > ds2.objSiz ); Return -1; Other; Return strcmp( ds1.pth@ : ds2.pth@ ); EndSl; /end-free p compQSort6 e * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Initialisation logic * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * p init b d pi d heapAlloc s 10i 0 /free // // initial allocation of heap space for heap pointers // heapAlloc = STKPTRMAX * pointerSize; start@ = tera_malloc(heapAlloc); // // going to handload the root entry // stkPtrL = 1; stkPtrR = 1; hm@@ = start@; ds@@ = start@; ds@ = %Alloc(recordDSSize); pthLen = %Len(%TrimR(pmPath)); pth@ = %Alloc(pthLen + 1); obj@ = *Null; pmPath = %TrimR(pmPath) + x'00'; memcpy( pth@ : %Addr(pmPath) : pthLen + 1 ); lstat( %Addr(pmpath) : fStat@ ); objTyp = fStatTyp; objDat = fStatDat; objSiz = fStatSiz; Return; /end-free p init e