OFFSET zwischen POINTERs

[jsranko]

Hi Fuerchau,

ich danke dir für deine Antwort, hat zwar mein Problem nicht gelöst aber hat mir eine Idee gezeigt, wie ich es lösen soll.

Ich habe es in CLLE gemacht, weil in CL mit Pointers besser arbeiten kann:

CALLPRC PRC('strstr') PARM((&strstr_st1 *BYVAL)  +      
                           (&strstr_st2 *BYVAL)) +      
        RTNVAL(&strstr_fnd)                             
IF COND(&strstr_fnd *EQ *NULL) THEN(DO)                 
   CALLSUBR doENDPGM                                    
ENDDO                                                   
                                                        
CHGVAR &strstr_off (%OFS(&strstr_fnd)-%OFS(&strstr_st1))

Nochmals danke.

[Rainer Ross]

Im neuen all-free RPG gehts auch. Es macht Sinn bei Variablen größer als 16MB, wo der %scan nicht mehr funktioniert. Beispielsweise bei Files aus dem IFS.

 dcl-pr strstr         pointer extproc(*dclcase);
          ##string     pointer value options(*string);
          ##pattern    pointer value options(*string);
 end-pr;

 dcl-s   string      varchar(60);             // String
 dcl-s   pattern     varchar(20);             // Pattern
 dcl-s   result_p    pointer;                 // Result-Pointer
 dcl-s   pos         int(10);                 // Position

      string  = 'das ist ein toller text';
      pattern = 'toll';

      result_p = strstr(%addr(string:*data):%addr(pattern:*data));

      if result_p <> *null;                        // Result-Pointer
         pos = result_p - %addr(string:*data) + 1; // Position im String
      endif; 

Herzliche Grüße

Rainer

[Fuerchau]

Variablen >16MB sind im *SNGLVL-Storage nicht möglich. Die Wahrscheinlichkeit dass 2 16MB-Bereiche direkt hintereinander liegen ist nicht gewährleistet.
Du kannst dein Speichermodel auf *TERASPACE umstellen, dann sind Variablen >16MB möglich und der %SCAN sollte eigentlich wieder funktionieren.

[Rainer Ross]

Variablen >16MB sind im *SNGLVL-Storage nicht möglich. Die Wahrscheinlichkeit dass 2 16MB-Bereiche direkt hintereinander liegen ist nicht gewährleistet.
Du kannst dein Speichermodel auf *TERASPACE umstellen, dann sind Variablen >16MB möglich und der %SCAN sollte eigentlich wieder funktionieren.

danke für den Hinweis

  ctl-opt dftactgrp(*no) alloc(*teraspace); 

[dschroeder]

ctl-opt dftactgrp(*no) alloc(*teraspace);

Nur mal so aus Interesse: Reicht es, alloc(*teraspace) einfach so deklarieren? Oder muss das Programm in einer bestimmten Activation Group ausgeführt werden? Bei uns läuft standardmäßig alles in ACTGRP(*CALLER).

Sind besondere Wandlungsoptionen auch noch erforderlich?

Dieter

[Fuerchau]

Nun ja, besser ist das schon.
Ich weiß nicht, was bei ACTGRP(*CALLER) passiert.
Im Zweifel ist ein Aufruf nicht möglich, wenn die ACTGRP bereits für *SNGLVL initialisiert ist.
Da ich keine Lust habe das zu testen, probier es doch einfach mal aus.

Was Pointer-Differenz in COBOL angeht, so kann man den Pointer redefinieren mit einer Struktur Filler x(10) und 9(9) comp-4 (Wichtig kein S!), ggf. geht auch 9(9) comp-5.
Somit kann man die Differenz zweier Pointer zumindest im Speicher berechnen.

[jsranko]

Hi Fuerchau,

genau das ist Antwort auf meine Frage! Super, ich danke dir.

Nur kleine Anpassung: FILLER muss X(12), weil die numerische Variable 9(9) BINARY ist 4Bytes groß und insgesamt muss es 16Bytes sein, weil Pointers 16Bytes allozieren.

       IDENTIFICATION DIVISION.
       PROGRAM-ID. PTRDIFF.


       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.


       DATA DIVISION.
       FILE SECTION.


       WORKING-STORAGE SECTION.
       01  TEST-STRING-1                    PIC X(160)
           VALUE "green eggs and ham".
       01  TEST-STRING-1-PTR                POINTER.
       01  TEST-STRING-2-PTR                POINTER.
       01  TEST-STRING-1-PTRR               REDEFINES TEST-STRING-1-PTR.
           05 FILLER                        PIC X(12).
           05 OFFSET1                       PIC 9(9) BINARY.
       01  TEST-STRING-2-PTRR               REDEFINES TEST-STRING-2-PTR.
           05 FILLER                        PIC X(12).
           05 OFFSET2                       PIC 9(9) BINARY.
       01  OFFSET                           PIC 9(9) BINARY.


       PROCEDURE DIVISION.
       MAIN.


           SET TEST-STRING-1-PTR TO ADDRESS OF TEST-STRING-1.
           SET TEST-STRING-2-PTR TO ADDRESS OF TEST-STRING-1.
           SET TEST-STRING-2-PTR UP BY 2.
           COMPUTE OFFSET = OFFSET2 - OFFSET1.
           DISPLAY OFFSET.




           STOP RUN
           .

[Fuerchau]

Mir dürfen doch auch schon mal Rechenfehler unterlaufen.
Immerhin seid ihr ja auch gefordert.

[jsranko]

Hi Rainer,

ja genau RPG kann es, CL kann es aber COBOL :-( ... Schade.

Danke auch für deinen Tipp.