midrange.com -- source code scratchpad

midrange.com code scratchpad
Name:
CP1552R - sort compile-time array
Scriptlanguage:
Plain Text
Tabwidth:
Date:
10/03/2018 02:42:25 pm
IP:
Logged
Description:
The purpose of this program is to sort source files. Specifically, to sort compile time arrays (so that
%LookUp will can a binary search). Enter QS over the line number at the start and end of the lines to be
sorted. This program can either be specified in the registry or by user (using option 13 - Change session
defaults). This is an example. In real life, I don't use arrays because RPG won't let me define their length
at run time. For this example I am assuming a compile time array will never be larger than 512. Any number
up to a million will work, and, considering that source files have limits (~32k records) this program really
doesn't need a dynamically defined array.
Code:

          //--------------------------------------------------------------------------------------------------------------//

          //                                                                                                              //

          //                                                                                                              //

          //                           CP1552R - QIBM_QSU_LCMD (SEU user defined) exit program                            //

          //                                                 sort records                                                 //

          //                                                                                                              //

          //                                                                                                              //

          //--------------------------------------------------------------------------------------------------------------//

           Ctl-Opt dftActGrp(*No) actGrp(*Caller)

                   debug(*Yes) option(*SrcStmt:*NoDebugIO:*NoUnRef)

                   Main(cp1552r)                                                   ;

          //--------------------------------------------------------------------------------------------------------------//

          //                                                                                                              //

          //... procedure interfaces ...                                                                                  //

          //                                                                                                              //

          //--------------------------------------------------------------------------------------------------------------//

          //

          // ... services (external) ...

          //

           Dcl-PR memcpy                        ExtProc('memcpy')                  ;

             *n                 Pointer         Value                              ;

             *n                 Pointer         Value                              ;

             *n                 Uns(10)         Value                              ;

           End-PR                                                                  ;

     
           Dcl-PR memcmp        Int(10)         ExtProc('memcmp')                  ;

             *n                 Pointer         Value                              ;

             *n                 Pointer         Value                              ;

             *n                 Uns(10)         Value                              ;

           End-PR                                                                  ;

     
           Dcl-PR qsort                         ExtProc('qsort')                   ;

             *n                 Pointer         Value                              ;

             *n                 Uns(10)         Value                              ;

             *n                 Uns(10)         Value                              ;

             *n                 Pointer(*Proc)  Value                              ;

           End-PR                                                                  ;

          //--------------------------------------------------------------------------------------------------------------//

          //                                                                                                              //

          // ... global variables/constants ...                                                                           //

          //                                                                                                              //

          //--------------------------------------------------------------------------------------------------------------//

           Dcl-DS input         Qualified                       Based(input@)      ;

             recLen             Int(10)                                            ;

             csrRrn             Int(10)                                            ;

             csrPos             Int(10)                                            ;

             ccsid              Int(10)                                            ;

             recCnt             Int(10)                                            ;

             member             Char(10)                                           ;

             file               Char(10)                                           ;

             library            Char(10)                                           ;

             mbrTyp             Char(10)                                           ;

             fkey               Char(1)                                            ;

             mode               Char(1)                                            ;

             spltSession        Char(1)                                            ;

             rsvr01             Char(1)                                            ;

           End-DS                                                                  ;

           Dcl-DS output        Qualified                       Based(output@)     ;

             rtnCode            Char(1)                                            ;

             rsrv01             Char(3)                                            ;

             recCnt             Int(10)                                            ;

             srcSeqA            Char(1)                                            ;

             srcSeq             Char(6)                                            ;

             rsrv002            Char(22)                                           ;

           End-DS                                                                  ;

           Dcl-DS txtDta        Qualified                       Based(txtDet@)     ;

             command            Char(7)                                            ;

             rtnCode            Ind                                                ;

             srcSeq             Char(6)                                            ;

             srcDat             Char(6)                                            ;

             srcDta             Char(1)                                            ;// only need address

           End-DS                                                                  ;

           Dcl-DS srcDta        LikeDS(txtDta)                  Based(srcDta@)     ;

     
           Dcl-S  szSrcDta      Int(5)                                             ;

           Dcl-S  szTxtDta      Int(5)                                             ;

           Dcl-S  $I            Int(5)                                             ;

           Dcl-S  @srcDta       Pointer         Dim(512)                           ;// dimension hard-coded for example

           Dcl-S  txtHdr@       Pointer                                            ;

     
           Dcl-C  #QSORTCOMP    %PAddr('QSORTCOMP')                                ;

           Dcl-C  #POINTERSIZE  %Size(txtHdr@)                                     ;// in case pointerSize ever changes

           Dcl-C  #SRCDTA@      %Addr(@srcDta)                                     ;

           Dcl-C  #QS           'QS     '                                          ;

          //--------------------------------------------------------------------------------------------------------------//

          //                                                                                                              //

          //                                                  Procedures                                                  //

          //                                                                                                              //

          //--------------------------------------------------------------------------------------------------------------//

          //                                                   Mainline                                                   //

          //--------------------------------------------------------------------------------------------------------------//

           Dcl-Proc cp1552r                                                        ;

           Dcl-PI *n                                            ExtPgm             ;

             pm1@               Pointer                                            ;// sure would be nice to have

             pm2@               Pointer                                            ;// a GLOBAL keyword, and force

             pm3@               Pointer                                            ;// global scope on our arguments

           End-PI                                                                  ;

           input@  = pm1@                                                          ;

           output@ = pm2@                                                          ;

           txtHdr@ = pm3@                                                          ;

           init()                                                                  ;

           load()                                                                  ;

           prcssFncKey()                                                           ;

           prcssCommand()                                                          ;

           unload()                                                                ;

           eoj()                                                                   ;

           Return                                                                  ;

           End-Proc                                                                ;

          //--------------------------------------------------------------------------------------------------------------//

           Dcl-Proc load                                                           ;

           txtDet@ = txtHdr@                                                       ;

           For $I = 1 to input.recCnt                                              ;

              @srcDta($I)    = %Alloc(szSrcDta)                                    ;

              srcDta@        = @srcDta($I)                                         ;

              srcDta.command = txtDta.command                                      ;

              srcDta.srcSeq  = txtDta.srcSeq                                       ;

              srcDta.srcDat  = txtDta.srcDat                                       ;

              srcDta.rtnCode = *Off                                                ;

              memcpy( %Addr(srcDta.srcDta)

                    : %Addr(txtDta.srcDta)

                    : input.reclen

                    )                                                              ;

              txtDet@ += szTxtDta                                                  ;

           EndFor                                                                  ;

           Return                                                                  ;

           End-Proc                                                                ;

          //--------------------------------------------------------------------------------------------------------------//

           Dcl-Proc prcssFncKey                                                    ;

           End-Proc                                                                ;

          //--------------------------------------------------------------------------------------------------------------//

           Dcl-Proc prcssCommand                                                   ;

     
           Dcl-S tstCmd1        Like(txtDta.command)                               ;

           Dcl-S tstCmd2        Like(txtDta.command)                               ;

     
           // right now, we are only interested in processing user defined

           // command QS - if it doesn't contain a QS in the first record and

           // the next to last, we are going to return an error

     
           srcDta@ = @srcDta(1)                                                    ;

           tstCmd1 = srcDta.command                                                ;

           srcDta@ = @srcDta(input.recCnt-1)                                       ;

           tstCmd2 = srcDta.command                                                ;

           If ( tstCmd1 = #QS And tstCmd2 = #QS And input.recCnt > 2 )             ;

     
             qsort( #SRCDTA@                                                          // I like sorting arrays of pointers

                  : input.recCnt - 1

                  : #POINTERSIZE

                  : #QSORTCOMP

                  )                                                                ;

     
             txtDet@ = txtHdr@                                                     ;

             For $I = 1 to input.recCnt - 1                                        ;

                srcDta@        = @srcDta($I)                                       ;

                txtDta.srcSeq  = srcDta.srcSeq                                     ;

                txtDta.srcSeq  = srcDta.srcSeq                                     ;

                txtDta.srcDat  = srcDta.srcDat                                     ;

                txtDta.rtnCode = *Off                                              ;

                txtDta.command = *Blanks                                           ;

                memcpy( %Addr(txtDta.srcDta)

                      : %Addr(srcDta.srcDta)

                      : input.reclen

                      )                                                            ;

                txtDet@  += szTxtDta                                               ;

             EndFor                                                                ;

             output.rtnCode = '0'                                                  ;

             output.recCnt  = input.recCnt - 1                                     ;

             output.srcSeq  = '000000'                                             ;

             output.srcSeqA = '0'                                                  ;

           Else                                                                    ;// error

             output.rtnCode = '1'                                                  ;

             output.recCnt  = 0                                                    ;

             output.srcSeq  = '000000'                                             ;

             output.srcSeqA = *Blank                                               ;

           EndIf                                                                   ;

           Return                                                                  ;

           End-Proc                                                                ;

          //--------------------------------------------------------------------------------------------------------------//

           Dcl-Proc unload                                                         ;

     
           txtDet@ = txtHdr@                                                       ;

           For $I = 1 to input.recCnt                                              ;

              DeAlloc @srcDta($I)                                                  ;

              txtDet@ += szTxtDta                                                  ;

           EndFor                                                                  ;

     
           Return                                                                  ;

           End-Proc                                                                ;

          //--------------------------------------------------------------------------------------------------------------//

           Dcl-Proc qsortComp                                                      ;

           Dcl-PI *n            Int(10)                                            ;// We're not supposed to have favorites,

             ds1@@              Pointer         Value                              ;// but I think this is my favorite

             ds2@@              Pointer         Value                              ;// subroutine - getting an awful lot

           End-PI                                                                  ;// done with very little code

           Dcl-S  ds1@          Pointer                         Based(ds1@@)       ;

           Dcl-S  ds2@          Pointer                         Based(ds2@@)       ;

           Dcl-DS ds1           LikeDS(srcDta)                  Based(ds1@)        ;

           Dcl-DS ds2           LikeDS(srcDta)                  Based(ds2@)        ;

     
           Return memcmp( %Addr(ds1.srcDta)

                        : %Addr(ds2.srcDta)

                        : szSrcDta

                        )                                                          ;

     
           End-Proc                                                                ;

          //--------------------------------------------------------------------------------------------------------------//

           Dcl-Proc init                                                           ;

           szSrcDta = %Len(srcDta) + input.recLen - 1                              ;

           szTxtDta = %Len(txtDta) + input.reclen - 1                              ;

           Return                                                                  ;

           End-Proc                                                                ;

          //--------------------------------------------------------------------------------------------------------------//

           Dcl-Proc eoj                                                            ;

           Return                                                                  ;

           End-Proc                                                                ;

          //--------------------------------------------------------------------------------------------------------------//
generated in 0.009s
valid xhtml & css