This page contains the following code snippets:
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.
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 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|
Even though register 0 can be used for storing addresses, it cannot be used to actually address data or program routines.
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:
|X'00'||Reserved for PL/I|
|X'04'||Pointer to previous save-area (i.e. register 13)|
|X'08'||Pointer to next save-area|
|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
a macro is shown, that tests the contents of the JCL-variable
By this means optimization of the program to be generated and
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
recommend never to implement self-modifying code because it renders
programs non-reenterable, and because it makes programs very hard to
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.
|Symposium: extending the life cycle of legacy applications|
|Bixoft Homepage||What's new?|
|Introduction / Sitemap||Why assembler|
|Courses||Sample code snippets|
|Maintenance||Public License Proposal|
|Pre-compilers||Books & sites|
|Profile A.F. Kornelis|
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!|
[ Join Now | Ring Hub | Random | | ]