|
|
|
|
|
|
||
This page contains the following code snippets:
Remark 1:
All samples on this page are no more than examples, and are in no
way
guaranteed to be free of errors or omissions. You may use (parts of)
these
code-samples, but it remains in all aspects your own responsibility
to
test your programs.
Remark 2:
All comments in the code samples are in english. Comments in your
sources
can of course be in any language you choose. We recommend that you
use
the language most commonly used in your firm. The same holds of
course
for all other kinds of documentation as well.
We would like to point out, superfluous though it may be, that standard register assignments are as follows:
| Register | Function |
|---|---|
| Register 0 | Workregister, mainly used as a parameter |
| Register 1 | Workregister, usually used as a pointer to a parameter-list or a result-field |
| Registers 2-11 | Can be assigned freely within each program |
| Register 12 | Base-register for addressing within the program |
| Register 13 | Pointer to a free save-area |
| Register 14 | Workregister, usually used for return addresses |
| Register 15 | Workregister, used for subroutine-address or (upon return) the return- and reason-codes |
Remark 1:
Even though register 0 can be used for storing addresses, it cannot
be used
to actually address data or program routines.
Remark 2:
The content of register 15, when used for return- and reason-codes,
is as
follows: X'00SSSRRR', the first byte always being zero, the next
three nibbles
(SSS) containing the reasoncode, and the last three nibbles (RRR)
containing
the returncode. Alternatively the reasoncode is often returned in
register 0.
Even the most common way of calling a subprogram is being enforced. Yet it is advised to follow long-standing practices. It improves both readability and maintainability of your programs. The usual convention is:
A save-area consists of 18 full-words (4 bytes each) and adheres to these rules:
| Location | Content |
|---|---|
| X'00' | Reserved for PL/I |
| X'04' | Pointer to previous save-area (i.e. register 13) |
| X'08' | Pointer to next save-area |
| X'0C' | Register 14 |
| X'10' | Register 15 |
| X'14' | Register 0 |
| etc. | up to register 12 |
Three code-fragments follow:
*
* Sample of a call to a subprogram.
*
* We assume the parameter list has been set up
LA R1,PLIST Reg.1 points to parameter-list
L R15,=V(SUBPROG) Address of subprogram in reg.15
BALR R14,R15 Fill reg.14 and call subprogram
* Handle the result
LTR R0,R15 Save and test returncode
BNZ ERROR Returncode not zero: error-handling
GOOD EQU *
* ... Other program-code
ERROR N R15,=X'00000FFF' Remove reasoncode
L R15,ERRORS(R15) Get address of error-routine from
table
BR R15 And execute error-routine
*
* Error-routines for handling unexpected results from SUBPROG
* Upon entry reg.0 contains the return- and reason-codes
ERRORS DC AL4(GOOD) Result ok
DC AL4(RETCD4) Returncode 4: warning
DC AL4(RETCD8) Returncode 8: problem
DC AL4(RETCD12) Returncode 12: undefined
DC AL4(RETCD16) Returncode 16: fatal error
*
* Sample of a callable program (non-reusable or reusable)
* This sample is not usable for re-enterable or refreshable programs.
*
SUBPROG CSECT
USING SUBPROG,R15 Register 15 contains address
SUBPROG
B START Skip data
DC C'SUBPROG ' Program-name
DC C'&SYSDATE' Date
DC C'&SYSTIME' Time
DC C'V1R2.05' Version number
DS 0H Re-align on halfword-boundary
*
START STM R14,R12,12(R13) Save registers
DROP R15 No longer needed as base-reg
LR R12,R15 Fill reg.12 with base address
USING SUBPROG,R12 Now use reg.12 as base
LA R14,SAVEAREA Address new save-area
ST R13,4(R14) Point to previous save-area
ST R14,8(R13) Point to next save-area
LR R13,R14 R13 points to a free save-area again
* ... Other program-code
EXIT L R13,4(R13) Get address of previous save-area
LM R14,R12,12(R13) Restore all registers (except 13)
LA R15,... Returncode in reg.15
BR R14 Return to caller
DROP R12 Base no longer needed
*
LTORG All literals
SAVEAREA DS 18F Save-area
*
* Sample of a callable program (refreshable or re-enterable)
* This sample is usable also for reusable or non-reusable programs.
*
SUBPROG CSECT
USING SUBPROG,R15 Register 15 contains address
SUBPROG
B START Skip data
DC C'SUBPROG ' Program-name
DC C'&SYSDATE' Date
DC C'&SYSTIME' Time
DC C'V1R2.05' Version number
DC 0H Re-align on halfword-boundary
*
START STM R14,R12,12(R13) Save all registers
DROP R15 No longer needed as base
LR R12,R15 Fill reg.12 with base address
USING SUBPROG,R12 Use reg.12 as base
LA R1,PRIVATE_LEN Amount of storage required
GETMAIN RU,LV=(R1) Allocate storage for save-area etc.
* Address of allocated storage now in register 1
USING PRIVATE,R13 Make storage addressable
ST R13,4(R1) Point to previous save-area
ST R1,8(R13) Point to next save-area
LR R13,R1 R13 points to a free save-area again
* ... Other program-code
EXIT LR R1,R13 Keep address of our private area
L R13,4(R13) Get address of previous save-area
LA R2,PRIVATE_LEN
FREEMAIN A=(R1),LV=(R2) Free allocated storage
LM R14,R12,12(R13) Restore all registers (except 13)
LA R15,... Returncode in reg.15
BR R14 Return to caller
DROP R12 Base no longer needed
*
LTORG All literals
*
* This dsect describes all variables private to each caller.
PRIVATE DSECT
SAVEAREA DS 18F
* ... Other private variables
PRIVATE_LEN EQU *-PRIVATE
The following example shows the application of conditional
assembly. First
a macro is shown, that tests the contents of the JCL-variable
SYSPARM.
By this means optimization of the program to be generated and
inclusion of
debugging code is triggered.
The macro sets two variables that can be tested throughout the
program
to generate code as desired. Some examples of such logic is given as
well.
Below please find the following four code fragments:
MACRO
CHECKPRM
.*
.* The assembler program (ASMA90) accepts as a JCL-parameter a
.* specification for the variable SYSPARM. The value entered in
.* the JCL will be passed to a global set symbol named &SYSPARM.
.* The value specified in the JCL is passed as a single string.
.* Options are separated from each other with a comma - no spaces.
.* This macro decomposes the string into separate parameters.
.* Then the parameters are checked and handled. 4 different keywords
.* are allowed:
.* - DEBUG : Generate debugging code (Snap routine etc.)
.* - NODEBUG: Do not generate debugging code
.* - OPT : Generate an optimized program
.* - NOOPT : Generate a fully functional program
.*
*
* Macro CHECKPRM tests JCL-variable SYSPARM and sets two global
* variables to reflect the contents of SYSPARM:
* &DBG is set on to include debugging code, off to omit this code
* &OPT is set on to generate optimized code, off for fully
* functional code.
*
GBLB &DBG,&OPT
&DBG SETB 0 Default: no debug code
&OPT SETB 1 Default: full optimization
AIF ('.&SYSPARM' EQ '.').EXIT
*
* First we split the SYSPARM string into substrings
*
LCLC &P(5) Array to contain substrings (parms)
LCLA &I,&N,&X
&I SETA 0 Character index for &SYSPARM
&N SETA 1 Next position to extract
&X SETA 1 Parameter counter (indexes array &P)
*
.LOOP1 ANOP
&I SETA &I+1 Increment character index
AIF (&I GT K'&SYSPARM.LOOP1X End-of-string?
AIF ('&SYSPARM'(&I,1) NE ',').LOOP1 End-of-substring?
.* Put substring into array &P
&P(&X) SETC '&SYSPARM'(&N,&I-&N) Extract substring
&N SETA &I+1 Set ptr to start of next substring
&X SETA &X+1 Increment substring counter
AGO .LOOP1 Go check next character
.*
.LOOP1X ANOP Exit point for loop1
&P(&X) SETC '&SYSPARM'(&N,&I-&N) Extract last substring
.*
.* Check validity of the keywords (now in array &P)
.*
&I SETA 0 Index into array &P
.LOOP2 ANOP
&I SETA &I+1 Increment parameter pointer
AIF (&I GT &X).LOOP2X Done? (&X contains nr of parameters)
AIF ('.&P(&I)' EQ '.').LOOP2 Skip empty parameter
AIF ('.&P(&I)' EQ '.OPT').OPT Enable optimization
AIF ('.&P(&I)' EQ '.NOOPT').NOOPT Disable optimization
AIF ('.&P(&I)' EQ '.DEBUG').DEBUG Include debug logic
AIF ('.&P(&I)' EQ '.NODEBUG').NODEBUG Omit debugging logic
.* Invalid value: issue warning and continue
MNOTE 4,'Invalid SYSPARM operand: &P(&I)'
AGO .LOOP2 Go check next parm
.*
.OPT ANOP
&OPT SETB 1
MNOTE 0,'Optimized coding will be generated'
AGO .LOOP2
.*
.NOOPT ANOP
&OPT SETB 0
MNOTE 0,'Fault tolerant coding will be generated'
AGO .LOOP2
.*
.DEBUG ANOP
&DBG SETB 1
MNOTE 0,'Debugging code will be included'
AGO .LOOP2
.*
.NODEBUG ANOP
&DBG SETB 0
MNOTE 0,'Debugging code will be excluded'
AGO .LOOP2
.*
.LOOP2X ANOP Exit point for loop2
.EXIT ANOP Exit point for empty SYSPARM
MEND
*
* The global &DBG controls debug/nodebug assembling options
* - When &DBG = 1 then debugging is active
* The global &OPT controls optimization
* - When &OPT = 1 then optimization takes place
* - When &OPT = 0 then fault tolerance will be included
*
GBLB &DBG,&OPT
CHECKPRM Check &SYSPARM to set &DBG and &OPT
*
SOMEPROG CSECT
SOMEPROG AMODE 31
SOMEPROG RMODE ANY
*
... Here the coding follows.
* Now set printing options
GBLC &PRT Controls print option
&PRT SETC 'NOGEN' Default to nogen
AIF (NOT &DBG).NOGEN Debugging active?
&PRT SETC 'GEN' Yes: generate full listing
.NOGEN ANOP
PRINT &PRT Activate print option
*
*
* This piece of code moves data, as specified by a move control element
* The data to be moved can be up to 32767 bytes long.
*
* R6 now points to the move-control element.
* R8 will be used as a source pointer, R9 containing the length.
* R10 will be used as the destination pointer.
*
USING MOVECTL,R6 Make move control area addressable
L R8,MCRECPTR Point to start-of-record
AH R8,MCRECOFS Add offset to relevant data
LH R9,MCDATLEN Load length of data
L R10,MCDEST Point to destination area
*
* Now to move the data we would normally code an MVCL-instruction,
* since MCDATLEN can specify any amount of data up to 32767 bytes.
* Since it is known that currently no MOVECTL-element specifies a
* length of more than 256, we can optimize the code by using an MVC
* in stead of an MVCL.
*
AIF (&OPT).OPTMOVE
LR R11,R9 Target-length always eq. Source-len
MVCL R10,R8 Move the data
AGO .MOVEDONE
.*
.OPTMOVE ANOP
BCTR R9,R0 Decrement length by 1 for MVC
EX R9,MOVEDATA Execute MVC-instruction
B MOVEDONE
MOVEDATA MVC 0(0,R10),0(R8) Move the data
MOVEDONE EQU *
*
.MOVEDONE ANOP
DROP R6 MOVECTL no longer needed
This example serves as an illustration only. Normally we would very
strongly
recommend never to implement self-modifying code because it renders
your
programs non-reenterable, and because it makes programs very hard to
read
and maintain.
Two code-fragments follow:
* ... Setup addressability etc.
INIT BC X'00',INITDONE This branch is a branch-never
OI INIT+1,X'F0' Make previous branch a branch-always
* ... Initialization code goes here
INITDONE EQU * End of initialization routine
L R1,LINEPTR Get last-used pointer into LINE
SETPTR SH R1,=H'50' Switch to other column (initial: SH)
XI SETPTR,X'01' Change AH to SH, or vice versa
ST R1,LINEPTR Store updated pointer
MVC 0(40,R1),DATA Move data into print-line
... Other coding for printing the line
LINE DC CL133' '
DS 0F Re-align on fullword boundary
LINEPTR DC AL4(LINE+67) To start printing the data in the
* left column, we pretend the last
* move was to the right-hand column.
To process a VSAM dataset one needs both an ACB and an RPL. In the example below we show how to create an ACB and an RPL in a reentrant program. You may assume that all named storage locations have been allocated dynamically and that these are addressable by use of a DSECT.
*
SUBROUTN STM R14,R12,12(R13) Save all registers
LA R1,SAVEAREA Address new save-area
ST R13,4(R1) Point to previous save-area
ST R1,8(R13) Point to next save-area
LR R13,R1 Reg.13 points to a free save-area
again
*
* First we allocate storage for ACB and RPL
*
GETMAIN RC,LV=IFGACBLV+IFGRPLLV Request storage for ACB + RPL
LTR R15,R15 Getmain was ok?
BNE ERROR16 Error is handled elsewhere
ST R1,ACBPTR Store pointer to ACB
LA R1,IFGACBLV(R1) Point to RPL-part of area
ST R1,RPLPTR Store pointer to RPL
*
* Allocate storage for a workarea
*
GETMAIN RC,LV=4096,BNDRY=PAGE Request storage for workarea
LTR R15,R15 Getmain was ok?
BNE ERROR16 Error is handled elsewhere
ST R1,WORKPTR Store pointer to workarea
*
* Create PLIST for GENCB ACB in getmained area.
* No returncode is provided for this GENCB.
*
SR R6,R6 Wipe register 6
IC R6,SHRPOOL to contain shrpool-number
L R7,WORKPTR Point to workarea for creating PLIST
USING WORKAREA,R7
GENCB BLK=ACB, Generate PLIST for GENCB ACB *
AM=VSAM, Access method *
WAREA=(R7), Location for generated ACB *
LENGTH=IFGACBLV, Max length for generated ACB *
DDNAME=(*,DDNAME), GENCB ACB is to copy DDNAME *
SHRPOOL=(S,0(R6)), Shrpool-nr varies from 0 to 15 *
MACRF=(KEY,DFR,SEQ,SKP,SIS,NSR), Options for this ACB *
BUFND=8, Minimum nr of data buffers *
BUFNI=1, Minimum nr of index buffers *
RMODE31=ALL, Buffer and control blocks above 16M *
MF=(L,WORKAREA,GENACBLV) Generate PLIST in WORKAREA
*
* Now create the ACB, using the PLIST in WORKAREA
*
GENCB BLK=ACB,MF=(E,(R7)) Generate ACB using PLIST in WORKAREA
LTR R15,R15 ACB generated?
BNZ ERROR17 Error is handled elsewhere
DROP R7 WORKAREA no longer needed
*
* Create PLIST for GENCB RPL in getmained area.
* No returncode is provided for this GENCB.
*
SR R6,R6 Clear register
IC R6,KEYLV to contain key length
L R7,ACBPTR Point to ACB
LH R8,RECDLV Specify record length
L R9,RPLPTR And point to location for gen'ed RPL
L R10,WORKPTR Re-address workarea
USING WORKAREA,R10
*
GENCB BLK=RPL, Generate PLIST for GENCB RPL *
AM=VSAM, Access method *
WAREA=(R9), Location for generated RPL *
LENGTH=IFGRPLLV, Max length for generated RPL *
ACB=(R7), Specify ACB-address for RPL *
AREA=(S,RECDPTR), Specify data-area for records *
AREALEN=4, Length of data-area *
ARG=(S,KEYPTR) Specify key location *
KEYLEN=(S,0(R6)), And key length in bytes *
ECB=(S,ECBPTR) Specify ECB-address *
RECLEN=(R8), And record length *
OPTCD=(KEY,SEQ,ASY,NUP,KGE,GEN,LOC), Options for RPL *
MF=(G,WORKAREA,GENRPLLV)
*
* Now create the RPL, using the PLIST in WORKAREA
*
GENCB BLK=RPL,MF=(E,(R10)) Generat RPL using PLIST in WORKAREA
LTR R15,R15 RPL generated?
BNZ ERROR18 Error is handled elsewhere
*
* Now that we have created both ACB and RPL, we can open the dataset
*
L R2,=AL4(VSAMOPEN) Get address of list-form open
MVC WORKAREA(VSAMOPLV),0(R2) Copy to work-area
L R2,ACBPTR Reload ACB-pointer
OPEN ((R2)),MF=(E,(R10)) Open ACB with modifiable PLIST
LTR R15,R15 Dataset opened successfully?
BNZ ERROR19 Error is handled elsewhere
*
* Return from subroutine
*
L R13,4(R13) Get address of previous save-area
LM R14,R12,12(R13) Restore all registers (except 13)
BR R14 Return to mainline
*
* Default list-form of open-macro
*
VSAMOPEN OPEN (0), ACB-address not yet known *
MODE=31, Enable 31-bit addressing *
MF=L Generate only PLIST
Remarks? Questions? More information? Select the topic of your choice or e-mail us with your questions.
Example of a standard subprogram call.
Example of conditional assembly.
Example of self-modifying code.
Example of reentrant dataset processing.
|
This site is a member of WebRing. You are invited to browse the list of mainframe-loving sites. |
|
Dinos are not dead. They are alive and well and living in data centers all around you. They speak in tongues and work strange magics with computers. Beware the dino! And just in case you're waiting for the final demise of these dino's: remember that dinos ruled the world for 155-million years! |
|
Dinos and other anachronisms [ Join Now | Ring Hub | Random | << Prev | Next >> ] |
||