ca.portal.admin

Re:Get storage

Discussion created by ca.portal.admin on Jul 22, 2009
Thanks to Tommy's and Peter's suggestion, I am now getting a clean compile.
But I don't seem to be getting a valid pointer back at run time. Can anyone
provide a way to convert the pointer to a displayable format? Or better
yet, some sample code that uses the pointer parameter for ""get scratch""?

I wish the storage interface had separate ""get"" and ""put"" commands, like the
scratch and queue interfaces do. I am having some difficulty determining
which parameters apply to which situation.
"
IDMS Public Discussion Forum
IDMS-L@LISTSERV.IUASSN.COM
SMTP
IDMS-L@LISTSERV.IUASSN.COM
IDMS-L@LISTSERV.IUASSN.COM
SMTP








Normal

Normal
Re: Get storage
"Kay,

The following paragraph is from the description of GET STORAGE in the
COBOL DML manual:

Note: Advantage CA-IDMS does not support the use of an OCCURS
DEPENDING ON clause within 01-level-storage-data-location.

It appears that Charles' example will always get the same amount of
storage, which, if I understand correctly, is not what you want to do.

I have included below an example of how your assembler sub-routine might
look. If you decide to use it, please contact me for the code needed to
free the area.

GETSTG CSECT =20
GETSTG AMODE ANY =20
GETSTG RMODE ANY =20
YREGS =20
@PARM EQU R11 BASE REGISTER FOR PARAMETERS =20
@BASE EQU R12 BASE REGISTER FOR PROGRAM =20
* =20
WKAREA DSECT =20
SAVE DS 18F SAVE AREA =20
VL_REC DS XL32767 KAY'S RECORD AREA =20
WKAREAL EQU *-WKAREA          LENGTH OF DSECT                =20
* =20
PARM DSECT =20
VL_REC_L DS F LENGTH OF GET STORAGE AREA =20
VL_REC_P DS F POINTER TO GET STORAGE AREA =20
* =20
GETSTG CSECT =20
SAVE (14,12),,* SAVE REGISTERS =20
LR @BASE,R15 =20
USING GETSTG,@BASE =20
LR R10,R13 SAVE HIGH SAVE AREA ADDRESS =20
* =20
LR @PARM,R1 PARAMETER POINTER OUT OF HARMS WAY =20
USING PARM,@PARM MAKE PARMS USABLE =20
* =20
L R0,VL_REC_L LENGTH FOR GETMAIN =20
GETMAIN RU,LV=3D(R0),LOC=3D31 =

LR R13,R1 ADDRESS OF ACQUIRED AREA TO R13 =20
USING WKAREA,R13 MAKE IT USABLE =20
* =20
ST R13,8(R10) SAVE FORWARD POINTER =20
ST R10,4(R13) SAVE BACKWARD POINTER =20
* -------------------------------------------------------------------
LA R3,VL_REC GET ADDRESS OF COBOL'S STORAGE =20
ST R3,VL_REC_P MAKE THE RESULT AVAILABLE TO CALLER
RETURN DS 0H =20
L R13,SAVE+4 RESTORE OLD SAVE AREA =20
RETURN (14,12),RC=3D0 =20
END GETSTG =20

Gary Bryson
EDS/Delta Dental: Denti-Cal Systems Group
gbryson@delta.org





The information contained in this e-mail message and any attachments is =
confidential and intended only for the addressee(s). If you are not an =
addressee, you may not copy or disclose the information, or act upon it, =
and you should delete it entirely from your e-mail system. Please notify =
the sender that you received this e-mail in error.
-----Original Message-----
From: IDMS Public Discussion Forum [mailTo:IDMS-L@LISTSERV.IUASSN.COM]
On Behalf Of Charles Hardee
Sent: Thursday, July 23, 2009 10:45 AM
To: IDMS-L@LISTSERV.IUASSN.COM
Subject: Re: Get storage

Kay,

The following program will allocate a variable length of storage, move a
literal into it and then issue a task snap. You can then use OLP and
view
the task snap and find the piece of allocated storage.

You can compile it as is using COBOL=3D2 and link it just like any other
COBOL/LE program.

For what you need to do, if I have understood correctly, you would issue
the
GET STORAGE, build the XML buffer as you want it and then issue a PUT
SCRATCH pointing at the constructed storage.

If your task is going to terminate immediately, then you can allow task
management to free the allocated storage. If your task is going to
continue
executing, then you may want to code a FREE STORAGE after the PUT
SCRATCH
returns to you. Of course, all this would be based upon successful
completion return codes from the IDMS interface.

Good Luck,
Chuck

*RETRIEVAL

*DMLIST

IDENTIFICATION DIVISION.
PROGRAM-ID. TCBLGSTG.
ENVIRONMENT DIVISION.
IDMS-CONTROL SECTION.
PROTOCOL.
MODE IDMS-DC DEBUG.
DATA DIVISION.
WORKING-STORAGE SECTION.
77 FILLER PIC X(16) VALUE 'WORKING STORAGE'.
01 PROGRAM-WORK-FIELDS.
05 WS-COMMAND-LENGTH PIC S9(08) COMP VALUE ZERO.
05 WS-SQL-BUFFER-POINTER USAGE POINTER.
05 WS-EDITED-NUMBER PIC 9(08) USAGE DISPLAY.
01 COPY IDMS SUBSCHEMA-CTRL.
LINKAGE SECTION.
01 SQL-COMMAND.
05 SQL-BUFFER-LENGTH PIC S9(04) COMP.
05 SQL-COMMAND-STRING.
10 SQL-COMMAND-CHAR PIC X(01)
OCCURS 0 TO 10000 TIMES
DEPENDING ON WS-COMMAND-LENGTH.
PROCEDURE DIVISION USING
SQL-COMMAND.
MAIN-PROGRAM-ENTRY SECTION.
MAIN-ENTRY.
MOVE 50000 TO WS-COMMAND-LENGTH.
GET STORAGE FOR SQL-COMMAND
VALUE LOW-VALUE
LOCATION ANY.
MOVE WS-COMMAND-LENGTH TO SQL-BUFFER-LENGTH,
WS-EDITED-NUMBER.
MOVE SPACES TO SQL-COMMAND-STRING.
STRING 'THIS IS THE SQL COMMAND BUFFER' DELIMITED BY SIZE,
' AND IT IS ' DELIMITED BY SIZE,
WS-EDITED-NUMBER DELIMITED BY SIZE,
' BYTES LONG' DELIMITED BY SIZE
INTO SQL-COMMAND-STRING.
SNAP TASK.
DC RETURN.
GOBACK.
MAIN-EXIT. EXIT.
COPY IDMS IDMS-STATUS.
IDMS-ABORT SECTION.
IDMS-ABORT-EXIT. EXIT.

Outcomes