Mark Landin ([log in to unmask]) wrote:
: Is there an example of how to do mapped file access in COBOL
: floating around on the net somewhere? I'd like to play around with
: it.
: --
: Mark Landin "If you choose not to decide,
: Systems Manager you still have made a choice"
: Superstar Satellite Entertainment -Neil Peart, RUSH
WARNING: this post is quite lengthy due to the coding examples. Please
accept my applogy instead of e-mailing me with complaints....
Mark:
Here are some examples I built for a customer several years ago. You
will need to call either C or Pascal to perform the pointer manipulation.
Also remember that if you add data past the current EOF of the file you
will need to perform an FPOINT and FCONTROL. Feel free to contact me
if you have any questions. Good Luck.
<<START COBOL CODE>>
001000$CONTROL BOUNDS
001100 IDENTIFICATION DIVISION.
001200*------------------------
001300 PROGRAM-ID. COBMAP.
001400 AUTHOR. BARRY LEMROW, HEWLETT-PACKARD.
001500
001600 ENVIRONMENT DIVISION.
001700*---------------------
001800 CONFIGURATION SECTION.
001900 SOURCE-COMPUTER. HEWLETT-PACKARD.
002000 OBJECT-COMPUTER. HEWLETT-PACKARD.
002100
002200 SPECIAL-NAMES. CONDITION-CODE IS INTRINSIC-STATUS.
002300
002400 DATA DIVISION.
002500*--------------
002600 WORKING-STORAGE SECTION.
002700 01 CONTROL-FILE-BUFFER.
002800 05 CONTROL-FILE-FLAG PIC X(01).
002900
003000 01 CONTROL-FILE-NUMBER PIC S9(08) COMP VALUE 0.
003100 01 CONTROL-FILE-POINTER PIC S9(18) COMP VALUE 0.
003200
003300 01 DUMMY-PARAM PIC S9(04) COMP VALUE 0.
003400
003500 01 RECORD-NUMBER PIC S9(08) COMP VALUE 1.
003600
003700 01 USER-INPUT PIC X(01).
003800
003900***
004000*** HPFOPEN PARAMETER VALUES.
004100***
004200 01 HOP-FILE-ACCESS PIC S9(08) COMP VALUE 11.
004300 01 HOP-FILE-DOMAIN PIC S9(08) COMP VALUE 3.
004400 01 HOP-FILE-NAME PIC S9(08) COMP VALUE 2.
004500 01 HOP-FILE-SIZE PIC S9(08) COMP VALUE 35.
004600 01 HOP-LONG-MAPPED PIC S9(08) COMP VALUE 21.
004700 01 HOP-OPTION-ACCESS PIC S9(08) COMP VALUE 4.
004800 01 HOP-OPTION-DOMAIN PIC S9(08) COMP VALUE 3.
004900 01 HOP-OPTION-FILENAME PIC X(40).
005000 01 HOP-OPTION-FILESIZE PIC S9(08) COMP VALUE 1.
005100 01 HOP-STATUS.
005200 05 HOP-STATUS-INFO PIC S9(04) COMP VALUE 0.
005300 88 HOP-STATUS-OK VALUE 0.
005400 88 HOP-FILE-DOES-NOT-EXIST VALUE -247.
005500 05 HOP-STATUS-SUBSYS PIC S9(04) COMP VALUE 0.
005600
005700 PROCEDURE DIVISION.
005800*-------------------
005900 MAIN-LINE.
006000*----------
006100 PERFORM 1000-OPEN-CONTROL-FILE.
006200
006300 IF (HOP-STATUS-OK)
006400 PERFORM 2000-PROCESS
006500 PERFORM 3000-CLOSE-CONTROL-FILE
006600 END-IF.
006700
006800 STOP RUN.
006900
007000 1000-OPEN-CONTROL-FILE.
007100*-----------------------
007110**
007120** Open the file MAPTEST for mapped access with a long pointer.
007130**
007200 MOVE "%MAPTEST%" TO HOP-OPTION-FILENAME.
007300 CALL INTRINSIC "HPFOPEN" USING CONTROL-FILE-NUMBER
007400 HOP-STATUS
007500 HOP-FILE-NAME
007600 HOP-OPTION-FILENAME
007700 HOP-FILE-DOMAIN
007800 HOP-OPTION-DOMAIN
007900 HOP-LONG-MAPPED
008000 CONTROL-FILE-POINTER
008100 HOP-FILE-ACCESS
008200 HOP-OPTION-ACCESS.
008300
008400 IF (NOT HOP-STATUS-OK)
008500 DISPLAY "------UNABLE TO OPEN FILE " HOP-OPTION-FILENAME;
008600 DISPLAY "STATUS: SUBSYS# " HOP-STATUS-SUBSYS
008700 " INFO# " HOP-STATUS-INFO;
008800 CALL INTRINSIC "HPERRMSG" USING 2
008900 0
009000 0
009100 HOP-STATUS;
009200 END-IF.
009300
009400 2000-PROCESS.
009500*-------------
009600 PERFORM WITH TEST AFTER UNTIL USER-INPUT = "E"
009700
009800 MOVE SPACE TO USER-INPUT;
009900 DISPLAY "ENTER R(ead), W(rite), OR E(xit):"
010000 NO ADVANCING;
010100 ACCEPT USER-INPUT;
010200
010300 EVALUATE USER-INPUT
010400 WHEN "R" PERFORM 2100-READ-FROM-MAPPED-FILE;
010500 WHEN "W" PERFORM 2200-WRITE-TO-MAPPED-FILE;
010600 WHEN "E" CONTINUE;
010700 WHEN OTHER
010800 DISPLAY "INVALID COMMAND '" USER-INPUT "'";
010900 END-EVALUATE;
011000 END-PERFORM.
011100
011200 2100-READ-FROM-MAPPED-FILE.
011300*---------------------------
011400 MOVE SPACES TO CONTROL-FILE-BUFFER.
011500 CALL "GETFLAG" USING \CONTROL-FILE-POINTER\
011600 CONTROL-FILE-BUFFER.
011700 DISPLAY " >>> CURRENT FLAG SETTING IS "
011800 CONTROL-FILE-BUFFER.
011900
012000 2200-WRITE-TO-MAPPED-FILE.
012100*--------------------------
012200 DISPLAY "ENTER NEW FLAG SETTING:" WITH NO ADVANCING.
012300 MOVE SPACES TO CONTROL-FILE-BUFFER.
012400 ACCEPT CONTROL-FILE-BUFFER.
012500
012600 DISPLAY " <<< WRITING TO THE MAPPED FILE:".
012700 CALL "PUTFLAG" USING \CONTROL-FILE-POINTER\
012800 CONTROL-FILE-BUFFER.
012900
013000 3000-CLOSE-CONTROL-FILE.
013100*------------------------
013200***
013300*** IF YOU UPDATE A MAPPED FILE PAST THE INITAL EOF POINT,
013400*** YOU MUST THEN UPDATE AND POST THE EOF USING CODE SIMILAR
013500*** TO THE FOLLOWING (SINCE OUR EXAMPLE IS JUST DEALING WITH
013600*** THE FIRST BYTE OF THE FIRST RECORD WE DON'T NEED THIS!):
013700***
013800* CALL INTRINSIC "FPOINT" USING CONTROL-FILE-NUMBER
013900* RECORD-NUMBER.
014000*
014100* IF INTRINSIC-STATUS > 0
014200* DISPLAY "FPOINT (CCG): RECORD POINTER UNCHANGED"
014300* ELSE
014400* IF INTRINSIC-STATUS < 0
014500* DISPLAY "FPOINT (CCL)".
014600*
014700* CALL INTRINSIC "FCONTROL" USING CONTROL-FILE-NUMBER
014800* 6
014900* DUMMY-PARAM.
015000*
015100* IF INTRINSIC-STATUS > 0
015200* DISPLAY "FCONTROL (CCG)"
015300* ELSE
015400* IF INTRINSIC-STATUS < 0
015500* DISPLAY "FCONTROL (CCL)".
015600
015700 CALL INTRINSIC "FCLOSE" USING CONTROL-FILE-NUMBER
015800 1
015900 0.
016000
016100 IF INTRINSIC-STATUS > 0
016200 DISPLAY "FCLOSE (CCG)"
016300 ELSE
016400 IF INTRINSIC-STATUS < 0
016500 DISPLAY "FCLOSE (CCL)".
<<END OF COBOL>>
<<START OF PASCAL>>
$standard_level 'os_features'$
$subprogram$
$check_formal_parm 0$
$check_actual_parm 0$
{**************************************************************************
* Program: PASMAP Created by: B. Lemrow THU, AUG 5, 1993, 10:12 AM *
* *
* Here are examples, written in Pascal, that will update the open mapped*
* file. Compile: PASXL PASMAP,OSUBMAP,$NULL *
* *
**************************************************************************}
program pmap_outerblock;
type
byte_pointer = ^$extnaddr$ char;
{*********************************************************************
* *
* *
*********************************************************************}
procedure getflag ( bptr : byte_pointer;
var byte : char );
begin
byte := bptr^;
end;
{*********************************************************************
* *
* *
*********************************************************************}
procedure putflag ( bptr : byte_pointer;
var byte : char );
begin
bptr^ := byte;
end;
{*********************************************************************
* *
* *
*********************************************************************}
begin
end.
<<END OF PASCAL>>
<<STAR OF C>>
/***************************************************************************
* Program: CMAP Created by: B. Lemrow THU, AUG 5, 1993, 10:12 AM *
* *
* Here are examples, written in C, that will update the open mapped file.*
* compile as follows: CCXL CMAP,,$NULL;INFO='+e -Aa' *
* +e allows 64-bit pointers, and various other MPE/iX goodies.... *
* -Aa allows ANSI-C *
* *
***************************************************************************/
#pragma COPYRIGHT "Hewlett-Packard, Co."
#pragma COPYRIGHT_DATE "1993"
#pragma VERSIONID "A.01.0"
typedef struct
{
char flag;
} flag_type;
/**************************************************************************
* *
* *
**************************************************************************/
void getflag
( flag_type ^map_pointer,
flag_type *buffer )
{
*buffer = *map_pointer;
}
/**************************************************************************
* *
* *
**************************************************************************/
void putflag
( flag_type ^map_pointer,
flag_type *buffer )
{
*map_pointer = *buffer;
}
<<END OF C>>
<<START OF COMMAND FILE>>
option list
if FINFO('ocobmap', 'exists') then
purge ocobmap
endif
cob85xl cobmap, ocobmap, $null
if FINFO('ccomxl.pub.sys', 'exists') then
ccxl cmap, osubmap, $null; info = '+e -Aa'
elseif FINFO('pascalxl.pub.sys', 'exists') then
pasxl pasmap,osubmap,$null
else
echo Neither Pascal or C exist on this system. Unable to continue.
return
endif
link from = ocobmap, osubmap; to = xcobmap
<<END OF COMMAND FILE>>
--
+----------------------------+------------------------------------------+
| Barry Lemrow | Disclaimer: |
| Technical Consultant | "Opinions expressed are mine and not |
| SAP National Practice | necessarily those of my employer, |
| Hewlett-Packard | family, or friends!" |
| [log in to unmask] |
+----------------------------+------------------------------------------+
| You can't have something for nothing. You can't get freedom for free.|
| You won't get wise with the sleep still in your eyes, no matter what |
| your dream might be! -- N. Peart, "Something for Nothing" |
+----------------------------+------------------------------------------+
|
