Loading...
Select Version
The following Assembler program contains the functions listed below:
Open a subroutine access (INIT)
Incorporate a file as a member (ADD)
Search for a member in a directory (TOCPRIM)
Open a member (OPENGET)
Read the first record (GET)
Close the member (CLOSE)
Terminate the subroutine access (END)
To make the example easier to understand, it includes comments in the form of messages
***********************************************************************
* *
* EXAMPLE OF LMS AS A SUBROUTINE *
* *
***********************************************************************
*
LMSUP CSECT
R1 EQU 1 ADDRESS OF THE PARAMETER LIST
R2 EQU 2 TEMPORARY WORK REGISTER
R3 EQU 3 TEMPORARY WORK REGISTER
R4 EQU 4 TEMPORARY WORK REGISTER
R5 EQU 5 TEMPORARY WORK REGISTER
R10 EQU 10 BASE REGISTER
R11 EQU 11 BASE REGISTER
R13 EQU 13 ADDRESS OF SAVE AREA
R14 EQU 14 RETURN ADDRESS
R15 EQU 15 ENTRY ADDRESS
LMSASSEQ
*
BALR R10,0
USING *,R10,R11
BASIS LA R11,BASIS+4095 2. BASE REGISTER
LA R11,1(R11)
LA R13,SAVEAREA
***********************************************************************
* *
* CALLING INIT *
* *
***********************************************************************
*
* ADDRESS LMSASSCB TO FIRST WORD OF PARAMETER LIST
*
LA R1,SBCB
ST R1,PARAM1
*
* PREPARE CB FOR INIT CALL
*
MVC SBCB(CBPLNG),DEFCB
*
* INIT FUNCTION AND SUBCODE UNUSED SET IMPLICITLY
*
LA R1,PARAM
L R15,=V(LMSUP1)
BALR R14,R15
*
* EVALUATE RETURN CODE
*
INITCL CLI CBRTC,OK
BNE RCPROC
*
***********************************************************************
* *
* CALLING ADD *
* *
***********************************************************************
*
* PREPARE CB FOR ADD CALL
*
MVI CBFUNC,ADD FUNCTION CODE
MVI CBSUBC,UNUSE SUBCODE UNUSED (DEFAULT)
MVI CBOV,YES OVERWRITE=YES
*
* ALL OTHER FIELDS SAME AS FOR INIT
*
* PREPARE FD FOR ADD CALL
*
MVC SBFD(FDPLNG),DEFFD DEFINE FD AREA
MVC FDLINK,FILELINK LINK NAME TO FD
*
* PREPARE LD FOR ADD CALL
*
MVC SBLD(LDPLNG),DEFLD DEFINE LD AREA
MVC LDLINK,LIBLINK LINK NAME TO LD
*
* PREPARE ED FOR ADD CALL
*
MVC SBED(EDPLNG),DEFED DEFINE ED AREA
MVI EDTYPE,'S' STORAGE TYPE S
MVC EDNAME(9),ELNAME MEMBER NAME
MVC EDVERS(1),ELVERS MEMBER VERSION
*
* SUPPLY PARAMETER LIST; PARAM1 CONTAINS A(CB)
*
LA R1,SBFD A(FD)
ST R1,PARAM2
LA R1,SBLD A(LD)
ST R1,PARAM3
LA R1,SBED A(ED)
ST R1,PARAM4
*
LA R1,PARAM
L R15,=V(LMSUP1)
BALR R14,R15
*
* EVALUATE RETURN CODE
*
ADDCL CLI CBRTC,OK
BNE RCPROC
*
***********************************************************************
* *
* CALLING TOC *
* *
***********************************************************************
* PREPARE CB FOR TOCPRIM CALL
*
MVI CBFUNC,TOCP FUNCTION CODE
MVI CBSUBC,LONG EXTENDED MEMBER INFO
*
* LD FIELDS AS PREDEFINED
*
* PREPARE EM FOR TOCPRIM CALL
*
LA R2,SBEM TARGET ADDRESS
LA R3,EMPLNG LENGTH OF TRANSFER
LA R4,DEFEM SOURCE ADDRESS
LR R5,R3
MVCL R2,R4
*
MVI EMTYPE,'S'
MVC EMNAME(9),ELNAME
*
* SUPPLY PARAMETER LIST; PARAM1 CONTAINS A(CB)
*
LA R1,SBTID A(TID)
ST R1,PARAM2
LA R1,SBEI A(EI)
ST R1,PARAM3
LA R1,SBLD A(LD)
ST R1,PARAM4
LA R1,SBEM A(EM)
ST R1,PARAM5
*
LA R1,PARAM
L R15,=V(LMSUP1)
BALR R14,R15
*
* EVALUATE RETURN CODE
*
TOCCL CLI CBRTC,OK
BNE RCPROC
*
* OUTPUT RESULTING INFO
*
MVC OTYPF,EITYPE
WROUT OTYP,TERM
*
MVC ONAMEF,EINAME
WROUT ONAME,TERM
*
MVC OVERSF,EIVERS
WROUT OVERS,TERM
*
MVC ODATEF,EIUDAT
WROUT ODATE,TERM
*
***********************************************************************
* *
* CALLING OPENGET *
* *
***********************************************************************
* PREPARE CB FOR OPENGET CALL
*
MVI CBFUNC,OPENG FUNCTION CODE
MVI CBSUBC,UNUSE SUBCODE UNUSED (DEFAULT)
*
* LD FIELDS AS PREDEFINED
*
* ED FIELDS AS PREDEFINED
*
* PREPARE RD FOR OPENGET CALL
*
MVC SBRD(RDPLNG),DEFRD DEFINE RD AREA
*
* SUPPLY PARAMETER LIST; PARAM1 CONTAINS A(CB)
*
LA R1,SBRD A(RD)
ST R1,PARAM2
LA R1,SBLD A(LD)
ST R1,PARAM3
LA R1,SBED A(ED)
ST R1,PARAM4
*
LA R1,PARAM
L R15,=V(LMSUP1)
BALR R14,R15
*
* EVALUATE RETURN CODE
*
OPENGCL CLI CBRTC,OK
BNE RCPROC
*
[***********************************************************************
* *
* CALLING GET, READING RECORDS IN LOOP *
* *
***********************************************************************
* PREPARING CB FOR GET CALL
*
GETLOOP MVI CBFUNC,GET FUNCTION CODE
MVI CBSUBC,SEQ SEQUENTIAL READING
*
* PREPARE RD FOR GET CALL
*
MVC RDBLEN,PLENGTH BUFFER LENGTH OF INPUT AREA
*
* SUPPLY PARAMETER LIST; PARAM1 CONTAINS A(CB)
*
* A(RD) WAS ALREADY SUPPLIED WITH OPENGET
*
LA R1,SBER A(ER)
ST R1,PARAM3
*
LA R1,PARAM
L R15,=V(LMSUP1)
BALR R14,R15
*
* EVALUATE RETURN CODE / OUTPUT RECORD
*
GETCL CLI CBRTC,OK
BNE GETEND
*
* RECORD OUTPUT WITHOUT COLUMN 1 (CONTROL CHARACTER)
*
WROUT SBER,TERM
B GETLOOP
*
* EVALUATE END OF ELEMENT
*
GETEND CLI CBRTC,EOF
BNE RCPROC
*
***********************************************************************
* *
* CALLING CLOSE *
* *
***********************************************************************
* PREPARE CB FOR CLOSE CALL
*
MVI CBFUNC,CLOSE FUNCTION CODE
MVI CBSUBC,UNUSE SUBCODE UNUSED (DEFAULT)
*
* RD FIELDS AS PREDEFINED
*
* SUPPLY PARAMER LIST; PARAM1 CONTAINS A(CB)
*
* A(RD) WAS ALREADY SUPPLIED WITH OPENGET
*
LA R1,PARAM
L R15,=V(LMSUP1)
BALR R14,R15
*
* EVALUATE RETURN CODE
*
CLOSECL CLI CBRTC,OK
BNE RCPROC
***********************************************************************
* *
* CALLING END *
* *
***********************************************************************
* PREPARE CB FOR END CALL
*
MVI CBFUNC,END FUNCTION CODE
MVI CBSUBC,UNUSE SUBCODE UNUSED (DEFAULT)
*
LA R1,PARAM
L R15,=V(LMSUP1)
BALR R14,R15
*
* EVALUATE RETURN CODE
*
ENDCL CLI CBRTC,OK
BNE RCPROC
TERM
*
***********************************************************************
* *
* ERROR HANDLING *
* *
***********************************************************************
RCPROC EQU *
WROUT MESSAGE,ERROR
*
FEHLER EQU *
TERM TERM
***********************************************************************
* *
* DEFINING CONSTANTS *
* *
***********************************************************************
DEFCB LMSASSCB MF=L CONSTANTS FOR CB
*
DEFFD LMSASSFD MF=L CONSTANTS FOR FD
*
DEFLD LMSASSLD MF=L CONSTANTS FOR LD
*
DEFED LMSASSED MF=L CONSTANTS FOR ED
*
DEFEI LMSASSEI MF=L CONSTANTS FOR EI
*
DEFEM LMSASSEM MF=L CONSTANTS FOR EM
*
DEFRD LMSASSRD MF=L CONSTANTS FOR RD
*
FILELINK DC 'FILELINK'
LIBLINK DC 'LIBLINK '
PLENGTH DC A(L'SBER)
ELNAME DC 'PROBEELEM'
ELVERS DC '1'
*
MESSAGE DC Y(MESSAGEE-MESSAGE)
DS CL2
DC X'40'
DC 'FUNCTION ERRONEOUS'
MESSAGEE EQU *
*
***********************************************************************
* *
* STORAGE AREAS *
* *
***********************************************************************
SBCB LMSASSCB MF=C STORAGE AREA FOR CB
*
SBFD LMSASSFD MF=C STORAGE AREA FOR FD
*
SBLD LMSASSLD MF=C STORAGE AREA FOR LD
*
SBED LMSASSED MF=C STORAGE AREA FOR ED
*
SBEI LMSASSEI MF=C STORAGE AREA FOR EI
*
SBEM LMSASSEM MF=C STORAGE AREA FOR EM
*
SBRD LMSASSRD MF=C STORAGE AREA FOR RD
*
SBER DS CL256 RECORD BUFFER
SBTID DC F'1' TOC IDENTIFICATION
*
OTYP DC Y(OTYPE-OTYP) FOR TYPE OUTPUT
DS CL2
DC X'40'
DC 'TYPE '
OTYPF DC CL(L'EITYPE)' '
OTYPE EQU *
*
ONAME DC Y(ONAMEE-ONAME) FOR NAME OUTPUT
DS CL2
DC X'40'
DC 'NAME '
ONAMEF DC CL(L'EINAME)' '
ONAMEE EQU *
*
OVERS DC Y(OVERSE-OVERS) FOR VERSION OUTPUT
DS CL2
DC X'40'
DC 'VERSION '
OVERSF DC CL(L'EIVERS)' '
OVERSE EQU *
*
ODATE DC Y(ODATEE-ODATE) FOR DATE OUTPUT
DS CL2
DC X'40'
DC 'USER-DATE '
ODATEF DC CL(L'EIUDAT)' '
ODATEE EQU *
***********************************************************************
* *
* PARAMETER LIST *
* *
***********************************************************************
PARAM DS 0F
PARAM1 DS F A(LMSASSCB)
PARAM2 DS F
PARAM3 DS F
PARAM4 DS F
PARAM5 DS F
PARAM6 DS F
***********************************************************************
* *
* SAVE AREA *
* *
***********************************************************************
SAVEAREA DS 18F
***********************************************************************
END