Re: Subprocedure scoping?

Nevermind. I didn't look close enough.

Mark Walter
Paragon Consulting Services, Inc.
IBM Certified System i Specialist
717-764-7909 Ext. 26
mwalter@xxxxxxxxxxxxxxx
www.paragon-csi.com



"Kim Spears" <kspears@xxxxxxxxxx>
Sent by: rpg400-l-bounces@xxxxxxxxxxxx
02/05/2008 12:11 PM
Please respond to
RPG programming on the AS400 / iSeries <rpg400-l@xxxxxxxxxxxx>


To
<RPG400-L@xxxxxxxxxxxx>
cc

Subject
Subprocedure scoping?






To fellow ILEers

I'm trying to use a pointer to a data structure to pass data back from a
sub procedure. I had it working at one point but have since made some
changes and now it doesn't work. What's happening is $obcGetType loads
the data structure properly and the pointer is getting passed back to
$obcSelect, however the data in the 'type' data structure in $obSelect
is garbage. It's almost like once $obcGetType goes out of scope the
memory for type_ds gets corrupted. Any suggestions?

D $obcGetType PR *
D obcFile 10 CONST
D obcField 10 CONST
****************************************************************
* $obcSelect - Prompt for valid one-byte codes for a specified
* field in a specific file
*--------------------------------------------------------------*
P $obcSelect B EXPORT
D $obcSelect PI 1
D obcFile 10 CONST
D obcField 10 CONST

D p_type S *
D type DS BASED(p_type) Qualified
D ID 10I 0
D Description 50A
*--------------------------------------------------------------*
C EVAL p_type = $obcGetType(obcFile :
obcField)
.
.
.
C RETURN oneByteCode
*--------------------------------------------------------------*
P $obcSelect E
****************************************************************
* $obcGetType - Given a file and field return the type
*--------------------------------------------------------------*
P $obcGetType B
D $obcGetType PI *
D obcFile 10 CONST
D obcField 10 CONST

D p_type S *
D type S BASED(P_TYPE) LIKE(type_ds)

D type_ds DS Qualified
D ID 10I 0
D Descrptn 50A
*--------------------------------------------------------------*
/FREE

OPEN DOOBCTYP01;
CHAIN (obcFile:obcField) DOOBCTYP01;
IF %FOUND(DOOBCTYP01);
EVAL type_ds.ID = otID;
EVAL type_ds.Descrptn = otDescrptn;
EVAL p_type = %ADDR(type_ds);
ELSE;
EVAL p_type = *NULL;
ENDIF;
CLOSE DOOBCTYP01;
RETURN p_type;

/END-FREE
*--------------------------------------------------------------*
P $obcGetType E