*PROCESS MARGINS(2,132);
  /******************************************************************/
  /* RCOMMON block is addressed by  STATIC EXTERNAL pointers        */

  _Rcommon: proc returns(fixed bin(31) byaddr);
     DCL (reg_area_xptr,rcom_xptr) pointer static external;
     DCL reg_area                  area(*) controlled  external;
     Dcl (addr, null, trim, substr, availablearea) builtin;
     Define alias HANDLE            pointer;
     DCL fname                      char(32),
         dbname                     char(16),
         c64                        char(64),
          reg_area_size             fixed bin(31),
         (rptr,dptr,dbptr,Pvalue)   pointer;
     DCL Rcommptr                         POINTER;
     Dcl     1 RCOMMON                    BASED(Rcommptr),
               2 OP_SYS                   FIXED BIN(15),
               2 REG_FIRST_DCOMMON        POINTER,
               2 MAXUSERS                 FIXED BIN(15) INIT (99),
               2 REG_AREA_PTR             POINTER INIT (NULL),
               2 SERVERID                 CHAR(16) INIT (''),
               2 much_more                char(1024);

     /* the primary procedure should not be called */
     return(16);

  /* create REG_AREA and RCOMMON - single occurrence of each  */
  _initRcommon: ENTRY returns(pointer byaddr); /* address of Rcommon in REG_AREA  */
     /* one instance only please */
     if reg_area_xptr^=null then return(null);
     reg_area_size = 1024 * 1024 * 2;
     ALLOCATE REG_AREA AREA(reg_area_size) ;
     reg_area_xptr = addr(reg_area);
     ALLOCATE RCOMMON IN (reg_area);
     rcom_xptr=addr(rcommon);
     rcom_xptr->rcommon.op_sys = 5;
     rcom_xptr->rcommon.reg_first_dcommon = null;
     return(rcom_xptr);

  /* set routines always return a return code = value validation */
  _setRcommonC: ENTRY(fname,C64) returns(fixed bin(31) byaddr);
     rcommptr = rcom_xptr;
     SELECT(fname);
        when("SERVERID")  do; rcommon.serverid = trim(C64); return(0); end;
        when .... as many other names as defined
        otherwise;
        END;
     return(16);

  _getRcommonC: ENTRY(fname) returns(character byaddr);
     put skip edit("_getRcommonC(",trim(fname),")")(3 a);
     rcommptr = rcom_xptr;
     SELECT(fname);
        when("SERVERID")  return(rcommon.serverid);
        when .... as many other names as defined
        otherwise;
        END;
     return("UNKNOWN");

  _setRcommonP: ENTRY(fname,Pvalue) returns(fixed bin(31) byaddr);
     rcommptr = rcom_xptr;
     SELECT(fname);
        when("REG_FIRST_DCOMMON")  do; rcommon.reg_first_dcommon = Pvalue; return(0); end;
        when .... as many other names as defined
        otherwise;
        END;
     return(16);

  _getRcommonP: ENTRY(fname) returns(pointer byaddr);
     rcommptr = rcom_xptr;
     SELECT(fname);
        when("REG_FIRST_DCOMMON")  return(rcommon.reg_first_dcommon);
        when .... as many other names as defined
        otherwise;
        END;
     return(null);
 end _Rcommon;