Wednesday, April 16, 2014

Add 1 to A to get B, your code

Last week I discussed how I had created a program to maximize the number of values I could have in a 3 character field. I did this using the values 000 – ZZZ. As we all know it is not possible in RPG to just to add 1 to A to get B. I gave the program of how I did it here, and I asked if anyone had another way to do it so send it me.

Several people did, and I am grateful to them for their submissions. If you would like to send one please sent it via the Contact form as the formatting in the comments section will do strange things to it.



Howard Chen

Use base 10 to base 36 conversion:

d  b36char        s             36    INZ('0123456789ABCDEFGHIJKLMN-
d                                     OPQSTUVUWXYZ')

d i               s             10i 0 inz
d p               s             10i 0 inz

d b36n            s             10i 0 inz
d b36a            s              3    inz('0ZZ')
 /free
  // convert base 36 number to base 10
   for i = 1 to %size(b36a);
      b36n = b36n * 36 + %scan(%subst(b36a:i:1):b36char)-1;
   endfor;

   b36n += 1;

  // convert base 10 to base 36
   for i = %size(b36a) downto 1;
      p = %rem(b36n:36) + 1;
      %subst(b36a:i:1) = %subst(b36char:p:1);
      b36n = %div(b36n:36);
   endfor;

   *inlr = *on;
   return;
 /end-free

In the example Add 1 to '0ZZ' = '100'

Sorry, I am not totally freed yet.



Rich Diedrich

I would just create the base 36 conversion routines, that way we can perform whatever calculations we want:

ctl-opt dftactgrp(*no);

dcl-c CLIST '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
dcl-c XLIST X'000102030405060708090A0B0C0D0E0F1011-
12131415161718191A1B1C1D1E1F20212223';

// Main line
dcl-s cfield char(3);

cfield = '01Z';
cfield = itob36(b36toi(cfield) + 1:%size(cfield));
dsply cfield;
return;

// Convert a base 36 value to an integer
// The C strtoul() function could be used instead of this
// The maximum base 36 length of uns(10) is 7
dcl-proc b36toi;
dcl-pi *n uns(10);
b36val varchar(7) value options(*trim);
end-pi;
// Access each translated character as a 1 byte integer
dcl-ds bval qualified;
nval uns(3) dim(7);
end-ds;
dcl-s i int(10);
dcl-s rval uns(10) inz(0);

bval = %xlate(CLIST:XLIST:b36val);
for i = 1 to %len(b36val);
rval = rval * 36 + bval.nval(i); // Base 36 conversion
endfor;
return rval;
end-proc;

// Convert an integer to a base 36 value
// The result will be trimmed if the length isn't specified
dcl-proc itob36;
dcl-pi *n varchar(7);
ival uns(10) value;
length int(10) value options(*nopass);
end-pi;
dcl-ds bval qualified;
nval uns(3) dim(7);
end-ds;
dcl-s i int(10);
dcl-s rval char(7);

bval = *allx'00';
i = %size(bval);
dow ival <> 0;
bval.nval(i) = %rem(ival:36);
ival = %div(ival:36);
i -= 1;
enddo;
rval = %xlate(XLIST:CLIST:bval);

if %parms > 1;
return %subst(rval:8 - length:length);
else;
return %triml(%subst(rval:1:6):'0') + %subst(rval:7:1);
endif;
end-proc;


Jon Paris

I missed the "right" way to do this with my first attempt but ...

I kept thinking this had to be simpler - and indeed it can be. This version just keeps the sequence number as a binary value allowing simple math to be used for incrementing - it then uses a very simple routine to convert to the character "number". This approach will (I think) easily allow for an 8 character "number" if needed with minimal or no code change.

A reverse routine (char "number" to integer) would be equally simple.

Here's the code:

dcl-s  charNumber char(3);

dcl-s  realNumber uns(10) Inz;

dcl-s  x uns(5);

for x = 1 to 2000;
  realNumber += 1;
  charNumber = NumberAsChar(realNumber);
  if %Rem( x: 360 ) = 0;
    dsply ('At ' + %char(x) + ' number is "' + charNumber + '"');
  EndIf;
EndFor;

*InLR = *On;

dcl-proc NumberAsChar;

dcl-pi   NumberAsChar    char(8);
         inputNumber     like(realNumber) Value;
end-pi;

dcl-s  i          uns(3);
dcl-s  work       uns(20);
dcl-s  charWork   varchar(8) inz;

dcl-ds chars;
  *n        char(36) Inz('0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ');
  character char(1)  pos(1) dim(46);
end-ds;

Dou inputNumber = 0;
  work = %Rem(inputNumber: 36);
  inputNumber /= 36;
  charWork += character( work + 1 );
EndDo;

Return charWork; // All done

end-proc;


Henrik Rutzou

Here is a complete program (actually party written by Hans Boldt)

ltoa terminates with X'00' so if it has to go into a 3 char field any value lower than 3 char will have the terminater in it.

Further more the field base36 must be blanked before ltoa is run.

To solve the problem and in the same time make characters uppercase (strtol is not case sensitive) I suggest this code:

h dftactgrp(*no) actgrp(*new) bnddir('QC2LE')

d strtol          pr            10i 0 extproc('strtol')
d   nptr                          *   value options(*string)
d   endptr                        *   value
d   base                        10i 0 value

d ltoa            PR              *   ExtProc('__ltoa')
d   nuInt                       10I 0 Value
d   szRtnBuffer                   *   Value
d   nRadix                      10I 0 Value

d number          s             10i 0
d base36          s             32a
d i               s             10i 0
 /free
  // sets a in base36
  number = 10;
  base36 = *blanks;
  ltoa(number:%addr(base36):36);
  for i = 1 to %len(%trim(base36));
    %subst(base36:i:1) = %bitor(%subst(base36:i:1):X'40');
  endfor ; 

  // converts a to 10, add 1 and reconvert to b in base36
  number = strtol(%trim(base36):*null:36);
  number +=1;
  base36 = *blanks;                
  ltoa(number:%addr(base36):36);
  for i = 1 to %len(%trim(base36));
    %subst(base36:i:1) = %bitor(%subst(base36:i:1):X'40');
  endfor;

  *inlr = *on;
 /end-free

4 comments:

  1. Thanks to Henrik (and Hans) - I knew these functions existed but could not for the life of me remember the names and obviously used the wrong search terms. But coding it in RPG was fun anyway.

    Interesting that strtoll also exists for larger numbers but not the equivalent which I guess would be __lltoa.

    Must ask Hans if he knows why one has to be coded as a built-in whereas the other is a straight function call.

    For sure the fastest and simplest (once you know what is happening) method. Darned if I can see how you make it produce 'ABC' instead of 'abc'. The docs don't mention why one set is chosen just implies that either upper or lower can be used.

    ReplyDelete
  2. It’s rather funny since there are 4 examples, two with old D-spec and two in the new free format.

    The latter could be a basic for a good discussion on how to code the new free format for readability, since Rich’s example has no indent at all in his code while Jon’s example indent the code into “columns”.

    Another thing is the dilemma in posting general code examples that requires the latest OS release, how many can actual use these examples? Not that it shouldn't be done but we are in a transition phase.

    ReplyDelete
  3. I personally think that some form of columnar approach is essential. Not columns in the old RPG sense, but at least one that appropriately aligns the name and data type/length elements. Still trying to make up my mind whether I want to simply add keyword options following the datatype or if that warrants its own alignment.

    Seems to me that just about everything I've ever read on programming style recommends some form of alignment for such things.

    As to the mix of old and new ... Personally I would rather encourage people to use the new stuff. As an educator I get far more nastygrams when I code in an old style. I think the new style is sufficiently intuitive to not cause any comprehension issues for those still stuck with fixed form D-specs. I'll also point out that I only ever code /Free style C-specs. This despite the sad fact that many people still code in fixed form - and clearly the release level has nothing to do with that since there are very few people who are using V4R5 or earlier who still read RPG discussion!

    ReplyDelete
  4. My code was indented. The comment form must have removed it.

    ReplyDelete

To prevent "comment spam" all comments are moderated.
Learn about this website's comments policy here.

Some people have reported that they cannot post a comment using certain computers and browsers. If this is you feel free to use the Contact Form to send me the comment and I will post it for you, please include the title of the post so I know which one to post the comment to.