String mit Zoned-Repräsentation in packed umwandeln

[dschroeder]

Hallo Rainer,

geht sicherlich auch. Ich bin mir allerdings nicht sicher, ob die Anweisung p#number /= 10 ** ##decimals; so einfach funktioniert. Ich hatte das so ähnlich bei mir zuerst auch drin. In irgendeinem Testfall (den ich aber nicht mehr weiß) hatte ich dann aber einen Rundungsfehler auf der letzten Stelle. Ich glaube, durch die "komplexe" Anweisung geht etwas Genauigkeit verloren. Nachdem ich das in einzelne Rechenschritte zerlegt habe, lief es auch in dem Testfall perfekt.

Dieter

[BenderD]

Ich bin mir allerdings nicht sicher, ob die Anweisung p#number /= 10 ** ##decimals; so einfach funktioniert. Ich hatte das so ähnlich bei mir zuerst auch drin. In irgendeinem Testfall (den ich aber nicht mehr weiß) hatte ich dann aber einen Rundungsfehler auf der letzten Stelle. Ich glaube, durch die "komplexe" Anweisung geht etwas Genauigkeit verloren. Nachdem ich das in einzelne Rechenschritte zerlegt habe, lief es auch in dem Testfall perfekt.

Dieter

... möglicherweise rechnet der das mit float, was diesen Effekt erklären würde. Den Knast in den Variablennamen sollte man sich verkneifen, §$&# und Konsorten gehören zu den Zeichen, die im EBCDIC nicht konsistent übertragen werden, was im internationalen Umfeld zu Problemen führen kann.

D*B

[Fuerchau]

Warum immer so kompliziert?
Die klassische MOVE-Anweisung regelt das automatisch und bei fehlerhaften Ziffern einfach ein Monitor drumrum:

D MYNumber 31p 0
D MyChar 30

// Woherauch immer der Wert kommt
evalr MyChar = WasAuchImmer;
monitor;
C MOVE(P) MyChar MyNumber
on-error *all;
// Fehlerbehandlung
endmon;

Der Move überträgt rechtsbündig in das Zielfeld. Ziffern werden konvertiert und vom rechten Zeichen wird die linke Tetrade (C, D, E, F) als Vorzeichen und die Rechte Tetrade (0-9) als Ziffer.
So haben wir seit gefühlten 100 Jahren konvertiert.
Die Kommaausrichtung kann dann wie gehabt erfolgen.

Und wofür CharToHex?
Ein einfaches %Bitand(Char:'0') ergibt eben x'F0' = '0'.

[dschroeder]

Warum immer so kompliziert?
Die klassische MOVE-Anweisung regelt das automatisch und bei fehlerhaften Ziffern einfach ein Monitor drumrum:
...
Der Move überträgt rechtsbündig in das Zielfeld. Ziffern werden konvertiert und vom rechten Zeichen wird die linke Tetrade (C, D, E, F) als Vorzeichen und die Rechte Tetrade (0-9) als Ziffer.
So haben wir seit gefühlten 100 Jahren konvertiert.
Die Kommaausrichtung kann dann wie gehabt erfolgen.

Der MOVE hat einem wirklich oft aus der Patsche geholfen bei Konvertierung und so. Aber im fully free format sind keine fixed form Anweisungen mehr möglich. Der MOVE scheidet in ganz neuen Programmen deshalb (leider) aus. Bei dem Beispiel von Rainer Ross scheint es sich allerdings nur um "total free" (und nicht "fully free") zu handeln. Da ginge der MOVE tatsächlich noch.

[Rainer Ross]

Ich werfe aufgrund der Anregung von Baldur noch eine Idee für "total" und "fully" free in den Hut

               ctl-opt main(main) dftactgrp(*no) option(*nounref);                                                            
      //------------------------------------------------------------------//                                            
      //                                                                  //                                            
      // Convert Zoned to Packed from String                              //                                            
      //                                                                  //                                            
      //-----------------                                                 //                                            
      // R.Ross 06.2017 *                                                 //                                            
      //------------------------------------------------------------------//                                            
      // Main                                                             //                                            
      //------------------------------------------------------------------//                                            
         dcl-proc Main;                                                                                                 
                                                                                                                        
         dcl-s   LocString   varchar(30);             // String                                                         
         dcl-s   LocNumber   packed(11:2);            // Number                                                         
                                                                                                                        
           LocString = '000005843M';                                                                                    
           LocNumber = cvtZonedToPacked(LocString:2);                                                                   
                                                                                                                        
         end-proc;                                                                                                      
      //------------------------------------------------------------------//                                            
      // Convert Zoned to Packed from String                              //                                            
      //------------------------------------------------------------------//                                            
         dcl-proc cvtZonedToPacked;                                                                                     
         dcl-pi *n           like(LocNumber);                                                                           
                 PiString    varchar(30) const options(*varsize:*trim);                                                 
                 PiDecimals  uns(5)      const options(*nopass);                                                        
         end-pi;                                                                                                        
                                                                                                                        
         dcl-ds  PsString    qualified;                                                                                 
                  String     char(30);                                                                                  
                  Number     zoned(30) pos(01);                                                                         
         end-ds;                                                                                                        
                                                                                                                        
         dcl-s   LocNumber   packed(30:9);            // Number                                                         
                                                                                                                        
           evalr PsString.String = PiString;                                                                            
           LocNumber = PsString.Number;                                                                                 
                                                                                                                        
           if %parms >= %parmnum(PiDecimals);         // Decimals                                                       
              LocNumber /= 10 ** PiDecimals;          // Decimals                                                       
           endif;                                                                                                       
                                                                                                                        
           return LocNumber;                          // Number                                                         
                                                                                                                        
         end-proc;                                                                                                      
      //------------------------------------------------------------------//

[dschroeder]

Ich werfe aufgrund der Anregung von Baldur noch eine Idee für "total" und "fully" free in den Hut

               ctl-opt main(main) dftactgrp(*no) option(*nounref);                                                            
      //------------------------------------------------------------------//                                            
      //                                                                  //                                            
      // Convert Zoned to Packed from String                              //                                            
      //                                                                  //                                            
      //-----------------                                                 //                                            
      // R.Ross 06.2017 *                                                 //                                            
      //------------------------------------------------------------------//                                            
      // Main                                                             //                                            
      //------------------------------------------------------------------//                                            
         dcl-proc Main;                                                                                                 
                                                                                                                        
         dcl-s   LocString   varchar(30);             // String                                                         
         dcl-s   LocNumber   packed(11:2);            // Number                                                         
                                                                                                                        
           LocString = '000005843M';                                                                                    
           LocNumber = cvtZonedToPacked(LocString:2);                                                                   
                                                                                                                        
         end-proc;                                                                                                      
      //------------------------------------------------------------------//                                            
      // Convert Zoned to Packed from String                              //                                            
      //------------------------------------------------------------------//                                            
         dcl-proc cvtZonedToPacked;                                                                                     
         dcl-pi *n           like(LocNumber);                                                                           
                 PiString    varchar(30) const options(*varsize:*trim);                                                 
                 PiDecimals  uns(5)      const options(*nopass);                                                        
         end-pi;                                                                                                        
                                                                                                                        
         dcl-ds  PsString    qualified;                                                                                 
                  String     char(30);                                                                                  
                  Number     zoned(30) pos(01);                                                                         
         end-ds;                                                                                                        
                                                                                                                        
         dcl-s   LocNumber   packed(30:9);            // Number                                                         
                                                                                                                        
           evalr PsString.String = PiString;                                                                            
           LocNumber = PsString.Number;                                                                                 
                                                                                                                        
           if %parms >= %parmnum(PiDecimals);         // Decimals                                                       
              LocNumber /= 10 ** PiDecimals;          // Decimals                                                       
           endif;                                                                                                       
                                                                                                                        
           return LocNumber;                          // Number                                                         
                                                                                                                        
         end-proc;                                                                                                      
      //------------------------------------------------------------------//

Bist du sicher, dass das geht? Wenn dein varying - Input-Parameter kürzer als 30 Zeichen ist, würden in der Datenstruktur doch zunächst Leerzeichen und am Ende deine gezonte Ziffernfolge stehen, oder? Wird das dann zu einer 30 Stelligen-Zahl? Der evalr würde doch das Feld zunächst mit Blanks initialisieren und dann rechtsbündig deinen (ggf. kürzeren) String reinpacken. Müssen da keine Vornullen rein?

[Rainer Ross]

Hallo Dieter,
ich habe es getestet, es funktioniert.

Rainer

[Pikachu]

Beim MOVEL steht genaueres (bei Feldern gleicher Länge):

If factor 2 is character and the result field is numeric, a minus zone is moved into the rightmost position of the result field if the zone from the rightmost position of factor 2 is a hexadecimal D (minus zone). However, if the zone from the rightmost position of factor 2 is not a hexadecimal D, a positive zone is moved into the rightmost position of the result field. Digit portions are converted to their corresponding numeric characters. If the digit portions are not valid digits, a data exception error occurs.

Und hier der Zeichensatz EBCDIC 273 (deutsch).

[dschroeder]

Den Knast in den Variablennamen sollte man sich verkneifen, §$&# und Konsorten gehören zu den Zeichen, die im EBCDIC nicht konsistent übertragen werden, was im internationalen Umfeld zu Problemen führen kann.
D*B

Da hast du sicher recht. Allerdings ist das bei uns aus den Sourcen nicht mehr rauszukriegen. Ich schätze, dass es hunderttausende Programmstellen gibt, in denen ein # vorkommt. Da kann uns wohl nur ein Roboter weiterhelfen.