Assembler programs can use standard calling conventions. The following are some examples of calling IDMSIN01 from an Assembler program:
************************************************************************
********************* Assembler work fields **************************
#SQLCA CSECT
SYSPLIST DC 10F'0' Standard PLIST
SQLRPB DC XL36'00' RPB used by IDMSIN01 macro
*
SQLMSGB DS 0F SQL error messages control block
SQLMMAX DC F'6' Max. number of SQL error lines
SQLMSIZE DC F'80' Error line size
SQLMCNT DC F'0' Act. number of messages returned
SQLMLINE DC 6CL80' ' Allow for 6 error messages
*
XTRAPKEY DS CL8 Key value for SETPROF + GETPROF
XTRAPVAL DS CL32 Variable for SETPROF + GETPROF
DATETIME DS XL8 Internal date/time stamp
DATEFLD DS CL26 Edited date/time used by GETDATE
TIMESTMP DS XL8 Internal TIME stamp
TIMESHOW DS CL8 External TIME display
DATESTMP DS XL8 Internal DATE stamp
DATESHOW DS CL10 External DATE display
USERID DS CL32 Current user id returned by USERID
DDSYSCTL DS CL8 DDNAME for SYSCTL
BLANKS DC CL133' ' Blanks for all
RRSCTX DC XL16'00' 16-byte context token
RRSFUNC DS X RRS context function:
RRSFNGET EQU X'01' - Get RRS context
RRSFNSET EQU X'02' - Set RRS context
CONVFUNC DS CL4 STRCONV function:
CONVFE2A EQU 'ETOA' - EBCDIC -> ASCII
CONVFA2E EQU 'ATOE' - ASCII -> EBCDIC
STRING DC C'String to convert' String to convert
STRINGL DC A(L'STRING) String length
SPACE
DS 0F Align on a fullword boundary
EVBLOCK DS XL(EV$DSLEN) Runtime environment return area
COPY #ENVINFO Copy in runtime environment
return area dsect
DBKEYFLD DS F Dbkey to be formatted
DBKEYFMT DS H Associated database-key format
DBKCHAR DS CL12 Output field for formatted dbkey
*********************************************************
* Call IDMSIN01 to deactivate the DML trace or SQL trace
* which was originally activated by the corresponding
* SYSIDMS parm (DMLTRACE=ON or SQLTRACE=ON).
*********************************************************
IDMSIN01 NOTRACE Deactivate the DML or SQL trace
*********************************************************
* Call IDMSIN01 to request a 'GETPROF' to get the user
* profile default DBNAME, which was established by the
* SYSIDMS parm DBNAME=xxxxxxxx when running batch, or
* by the DCUF SET DBNAME xxxxxxxx when running under CV.
*
* PVALUE is the address of the 8 byte GETPROF keyword.
* PRESULT is the address of the 32 byte GETPROF returned value.
*********************************************************
MVC XTRAPKEY,=CL8'DBNAME' Establish GETPROF keyval
IDMSIN01 GETPROF,
PVALUE=XTRAPKEY,
PRESULT=XTRAPVAL,
ERROR=ERROROUT
MVC WORKLINE,BLANKS Clear print work line
MVC WORKLINE+5(6),=C'DBNAME' Move out GETPROF keyval
MVC WORKLINE+11(17),=C' is set to BLANKS'
CLC XTRAPVAL,BLANKS Was variable set to blanks
BE *+4+6 Yes, all set
MVC WORKLINE+22(32),XTRAPVAL Move out variable
$PRNT WORKLINE Print the GETPROF results
*********************************************************
* Call IDMSIN01 to activate Transaction Sharing for this
* task.
*********************************************************
IDMSIN01 TXNSON Activate Transaction Sharing
*********************************************************
* Call IDMSIN01 to deactivate Transaction Sharing for this
* task.
*********************************************************
IDMSIN01 TXNSOFF Deactivate Transaction Sharing
*********************************************************
* Call IDMSIN01 to request a 'RRSCTX' to set a private
* context.
*
* RRSFUNA
* Specifies the address of a 1-byte field that contains
* the function to execute. Valid values are:
* X'01' Get RRS context.
* X'02' Set RRS context.
*
* RRSCTXA
* Specifies the address of a 16-byte field for the RRS
* context token. Depending upon the function, this field is
* input, output, or both.
*********************************************************
MVI RRSFUNC,RRSFNGET Function: get RRS context
IDMSIN01 RRSCTX,
RRSFUNA=RRSFUNC,
RRSCTXA=RRSCTX,
ERROR=ERROROUT
*********************************************************
* Call IDMSIN01 to request a 'STRCONV' to convert a string
* from EBCDIC to ASCII
* CONVFUN - specifies which conversion:
* ETOA - EBCDIC to ASII
* ATOE - ASCII to EBCDIC
*
* BUFFER - SPECIFIES STRING TO CONVERT
* BUFFERL- SPECIFIES LENGTH OF STRING
*********************************************************
MVC CONVFUNC,=A(CONVFE2A) Convert EBCDIC to ASCII
IDMSIN01 STRCONV,
BUFFER=STRING,
BUFFERL=STRINGL,
ERROR=ERROROUT
*********************************************************
* Call IDMSIN01 to convert STRING (now in ASCII) back to EBCDIC
*********************************************************
MVC CONVFUNC,=A(CONVFA2E) Convert ASCII to EBCDIC
IDMSIN01 STRCONV,
BUFFER=STRING,
BUFFERL=STRINGL,
ERROR=ERROROUT
*********************************************************
* Call IDMSIN01 to request a 'SETPROF' to set the user
* profile default SCHEMA to the value 'SYSTEM'.
*
* PVALUE is the address of the 8 byte SETPROF keyword.
* PRESULT is the address of the 32 byte SETPROF value.
*********************************************************
MVC XTRAPKEY,=CL8'SCHEMA' Est. SETPROF keyval
MVC XTRAPVAL,BLANKS Init SETPROF variable
MVC XTRAPVAL(8),=CL8'SYSTEM' Save SETPROF variable
IDMSIN01 SETPROF,
PVALUE=XTRAPKEY,
PRESULT=XTRAPVAL,
ERROR=ERROROUT
*********************************************************
* Call IDMSIN01 to request the current USERID established
* by the executed JCL information when running batch, or
* by the SIGNON USER xxxxxxxx when running under CV.
*
* USERID is the address of the 32 byte USERID returned value.
*********************************************************
IDMSIN01 GETUSER,
USERID=USERID,
ERROR=ERROROUT
MVC WORKLINE,BLANKS Clear print work line
MVC WORKLINE+10(17),=C'Current user --> '
MVC WORKLINE+27(32),USERID Display current user id
$PRNT WORKLINE Print the user id
*********************************************************
* Call IDMSIN01 to establish the SYSCTL DDNAME to be used
* when running a Batch/CV job.
*
* DDNAME is the address of the 8 byte SYSCTL DDNAME passed.
*********************************************************
MVC DDSYSCTL,=C'SYSCTL73' Est. DDNAME for SYSCTL file
IDMSIN01 SYSCTL,
DDNAME=DDSYSCTL,
ERROR=ERROROUT
*********************************************************
* Call IDMSIN01 to have an 8 byte internal DATETIME stamp
* returned as a displayable 26 character DATE/TIME display.
*
* DATEIN is the address of the 8 byte internal DATETIME stamp.
* DATEOUT is the address of the 26 byte DATE/TIME returned.
*********************************************************
IDMSIN01 GETDATE,
DATEIN=DATETIME,
DATEOUT=DATEFLD,
FORMAT=INTERNAL,
ERROR=ERROROUT
MVC WORKLINE,BLANKS Clear print work line
MVC WORKLINE+10(14),=C'DATETIME ---> '
MVC WORKLINE+24(26),DATEFLD Displayable date/time
$PRNT WORKLINE Print the date/time
*********************************************************
* Call IDMSIN01 to have the current DATE and TIME
* returned as a displayable 26 character DATE/TIME display.
*
* DATEOUT is the address of the 26 byte DATE/TIME returned.
*********************************************************
IDMSIN01 GETDATE,
DATEOUT=DATEFLD,
FORMAT=DISPLAY,
ERROR=ERROROUT
MVC WORKLINE,BLANKS Clear print work line
MVC WORKLINE+10(22),=C'Current DATETIME ---> '
MVC WORKLINE+32(26),DATEFLD Displayable date/time
$PRNT WORKLINE Print the current date/time
*********************************************************
* Call IDMSIN01 to have a 26 byte external DATE/TIME display
* returned as an 8 byte DATETIME stamp.
*
* DATEIN is the address of the 26 byte DATE/TIME.
* DATEOUT is the address of the 8 byte DATETIME stamp returned.
*********************************************************
MVC DATEFLD,=C'1994-07-18-12.01.18.458382'
IDMSIN01 GETDATE,
DATEIN=DATEFLD,
DATEOUT=DATETIME,
FORMAT=EXTERNAL,
ERROR=ERROROUT
*********************************************************
* Call IDMSIN01 to have a 8 byte external TIME display
* returned as an 8 byte TIME stamp.
*
* DATEIN is the address of the 8 byte external TIME.
* DATEOUT is the address of the 8 byte TIME stamp returned.
*********************************************************
MVC TIMESHOW,=C'13.58.11'
IDMSIN01 GETDATE,
DATEIN=TIMESHOW,
DATEOUT=TIMESTMP,
FORMAT=TIMEEXT,
ERROR=ERROROUT
*********************************************************
* Call IDMSIN01 to have an 8 byte internal TIME stamp
* returned as a displayable 8 character TIME display.
*
* DATEIN is the address of the 8 byte internal TIME stamp.
* DATEOUT is the address of the 8 byte external TIME returned.
*********************************************************
IDMSIN01 GETDATE,
DATEIN=TIMESTMP,
DATEOUT=TIMESHOW,
FORMAT=TIMEINT,
ERROR=ERROROUT
MVC WORKLINE,BLANKS Clear print work line
MVC WORKLINE+10(10),=C'TIME ---> '
MVC WORKLINE+20(8),TIMESHOW Displayable time
$PRNT WORKLINE Print the time
*********************************************************
* Call IDMSIN01 to have a 10 byte external DATE display
* returned as an 8 byte DATE stamp.
*
* DATEIN is the address of the 10 byte external DATE.
* DATEOUT is the address of the 8 byte DATE stamp returned.
*********************************************************
MVC DATESHOW,=C'2003-03-10'
IDMSIN01 GETDATE,
DATEIN=DATESHOW,
DATEOUT=DATESTMP,
FORMAT=DATEEXT,
ERROR=ERROROUT
*********************************************************
* Call IDMSIN01 to have an 8 byte internal DATE stamp
* returned as a displayable 10 character DATE display.
*
* DATEIN is the address of the 8 byte internal DATE stamp.
* DATEOUT is the address of the 10 byte external DATE returned.
*********************************************************
IDMSIN01 GETDATE,
DATEIN=DATESTMP,
DATEOUT=DATESHOW,
FORMAT=DATEINT,
ERROR=ERROROUT
MVC WORKLINE,BLANKS Clear print work line
MVC WORKLINE+10(10),=C'DATE ---> '
MVC WORKLINE+20(10),DATESHOW Displayable date
$PRNT WORKLINE Print the date
*********************************************************
* Call IDMSIN01 to retrieve SQL error messages into a user
* buffer that will then be displayed back to the user.
* Whats passed is the SQLCA block and a message control
* block consisting of the following fields:
*
* - Maximum number of lines in user buffer.
* - The size (width) of one line in the user buffer.
* - The actual number of lines returned from IDMSIN01.
* - The user buffer where the message lines are returned
*
* A return code of 4 means that there were no SQL error messages.
* A return code of 8 means that there were more SQL error lines
* in the SQLCA than could fit into the user buffer, meaning
* truncation has occurred.
*
* SQLCA is the address of the SQLCA block.
* SQLMSGB is the address of the message control block.
*********************************************************
IDMSIN01 GETMSG,
SQLCA=SQLCA,
SQLMSGB=SQLMSGB
CH R15,=H'4' Were there any SQL errors returned
BE NOMSGS No, well thats okay with me
MVC WORKLINE,BLANKS Clear print work line
MVC WORKLINE+11(27),=C'Buffer returned from XTRA '
$PRNT WORKLINE Print the heading
$PRNT BLANKS Print 1 blank line
L R3,SQLMCNT Get number of message lines returned
LA R5,SQLMLINE Point at first message line
MVC WORKLINE,BLANKS Clear print work line
MSGLOOP MVC WORKLINE+3(80),0(R5) Move SQL error message to print line
$PRNT WORKLINE Print SQL error message
LA R5,80(R5) Bump to next SQL error message
BCT R3,MSGLOOP Print all SQL error messages
*********************************************************
* Call IDMSIN01 to reactivate the DML trace or SQL trace
* which was originally activated by the corresponding
* SYSIDMS parm (DMLTRACE=ON or SQLTRACE=ON), that has
* been previously deactivated earlier on in this job.
*********************************************************
IDMSIN01 TRACE Reactivate the DML or SQL trace
***********************************************************************
* Call IDMSIN01 to request that it return runtime environment
* information. The layout of the information returned is described
* in #ENVINFO dsect.
*
* EVBLOCK is the address of where to return the information. The
* first halfword contains the length of the data you want returned.
***********************************************************************
LA R5,EVBLOCK Get address of return area
USING EV$INFO,R5 ─► EV$INFO
MVC EV$SIZE,=AL2(EV$MAXL) Return all environment information
IDMSIN01 ENVINFO,
EVBLOCK= EV$INFO,
ERROR=ERROROUT
MVC WORKLINE,BLANKS Clear print work line
MVC WORKLINE+5(5),=C'Mode='
MVC WORKLINE+10(1), EV$MODE Show runtime mode
MVC WORKLINE+13(5),=C'Tape='
MVC WORKLINE+18(6), EV$TAPE# Show CA IDMS tape volser
MVC WORKLINE+26(8),=C'Release='
MVC WORKLINE+34(6), EV$REL# Show CA IDMS release number
MVC WORKLINE+42(13),=C'Service Pack='
MVC WORKLINE+55(2), EV$SPACK Show CA IDMS tape service pack number
MVC WORKLINE+59(5),=C'DMCL='
MVC WORKLINE+64(8), EV$DMCL Show DMCL name
MVC WORKLINE+74(5),=C'Node='
MVC WORKLINE+79(8), EV$NODE Show system node name
$PRNT WORKLINE Print the ENVINFO results
*********************************************************
* Call IDMSIN01 to format dbkey
*********************************************************
IDMSIN01 FRMTDBK,
DBKEY=DBKEYFLD,
DBKFMT=DBKEYFMT,
DBKOUT=DBKCHAR
|
Copyright © 2014 CA.
All rights reserved.
|
|