Convert an MI program to RPG -- RPG400-L

Hi everyone. Would it be possible to change the following MI program to use RPG/ILE instead? It is a program that obtains a pointer to a supplied qualified object.

If this is more appropriate to the MI list, feel free to reply there as I am a subscriber there as well.

Bill

------------------------- Begin Source

   ENTRY * (PARM_LIST) EXT ;
   DCL SPCPTR     LibraryName@         PARM;
   DCL SPCPTR     ObjectName@          PARM;
   DCL SPCPTR     ObjectType@          PARM;
   DCL PTR        ObjectSpcPtr@        PARM;
   DCL SPCPTR     ReturnCode@          PARM;
   DCL OL         PARM_LIST(LibraryName@, ObjectName@,
                             ObjectType@, ObjectSpcPtr@,
                             ReturnCode@) PARM EXT ;

/* Variables based on Parameters.                                   */

   DCL DD         LibName#    CHAR(10)   BAS(LibraryName@) ;
   DCL DD         ObjName#    CHAR(10)   BAS(ObjectName@) ;
   DCL DD         ObjType#    CHAR(10)   BAS(ObjectType@) ;
   DCL PTR        RtnSpcPtr#             BAS(ObjectSpcPtr@) ;
   DCL DD         RtnCode#    CHAR(1)    BAS(ReturnCode@) ;

/* Working Variables.                                               */

   DCL SYSPTR     LibSysPtr# ;

   DCL SYSPTR     ObjSysPtr# ;
   DCL DD         RslvObjT#   CHAR(34) ;
   DCL DD         RslvType    CHAR(2)   DEF(RslvObjT#) POS(1) ;
   DCL DD         RslvName    CHAR(30) DEF(RslvObjT#) POS(3) ;
   DCL DD         RslvAuth    CHAR(2)   DEF(RslvObjT#) POS(33)
                               INIT(X'0000') ;

/* Exception monitor                                               */

   DCL EXCM       * EXCID(H'0000') BP(.Exit) ;

/* Default to error condition                                      */

   CPYBLA          RtnCode#, '1' ;

/* First Point to the Library.                                     */

   CPYBLA          RslvType,X'0401' ;
   CPYBLAP         RslvName, LibName#,' ' ;
   RSLVSP          LibSysPtr#, RslvObjT#, *, * ;

/* Now, Point to the Object Within This Library.                   */

   CPYBLA          RslvType, ObjType# ;
   CPYBLAP         RslvName, ObjName#, ' ' ;
   RSLVSP          ObjSysPtr#, RslvObjT#, LibSysPtr#, * ;

/* Point to Beginning of the Associated Space For This Object      */

   SETSPPFP        RtnSpcPtr#, ObjSysPtr# ;

/* Set normal return code                                          */

   CPYBLA          RtnCode#, '0' ;

/* End.                                                            */

.Exit: ;
   RTX * ;
   PEND ;

-------------------------------------- End Source

This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].

Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.