Deze pagina bevat de volgende code fragmenten:
Opmerking 1:
Alle voorbeelden op deze pagina zijn slechts voorbeelden, en onder
voorbehoud
van fouten en/of omissies. U mag (delen van) deze code gebruiken maar
u doet
dat volledig voor eigen risico. Het blijft natuurlijk altijd zaak uw
programma's grondig te testen.
Opmerking 2:
Alle voorbeelden op deze pagina zijn volledig in het engels. Dit is
gedaan
om de volgende redenen:
Overigens wijzen wij er op, dat u voor alle commentaar in uw sources het best de taal kunt kiezen die in uw bedrijf het meest gangbaar is. Dit geldt natuurlijk ook voor alle overige vormen van documentatie.
Wellicht ten overvloede wijzen wij er op, dat de standaard register toewijzingen als volgt zijn ingedeeld:
Register | Functie |
---|---|
Register 0 | Werkregister, veelal gebruikt als parameter |
Register 1 | Werkregister, meestal pointer naar parameter-lijst of resultaat-veld |
Registers 2-11 | Vrij toe te wijzen binnen elk programma |
Register 12 | Basis-register voor adressering binnen het programma |
Register 13 | Pointer naar een vrije save-area |
Register 14 | Werkregister, gebruikt voor return-adres |
Register 15 | Werkregister, gebruikt voor subroutine-adres resp. return- en reasoncode |
Opmerking 1:
Register 0 kan wel gebruikt worden om een adres in op te slaan,
maar kan niet gebruikt worden om gegevens of routines te adresseren.
Opmerking 2:
De indeling van register 15, wanneer die een return- en reasoncode
bevat is als volgt: X'00SSSRRR' waarin de eerste byte dus nul is, de
volgende
drie nibbles (SSS) bevatten de reasoncode, en de laatste drie nibbles
(RRR)
bevatten de returncode. Als alternatief wordt ook veelvuldig de
reasoncode
teruggegeven in register 0.
De gangbare wijze van aanroepen is niet dwingend voorgeschreven. Toch verdient het aanbeveling hieraan vast te houden. Het verhoogt de leesbaarheid en onderhoudbaarheid van de programmatuur. De conventie luidt als volgt:
Een save-area beslaat 18 full-words (van 4 bytes elk) en is als volgt ingedeeld:
Locatie | Inhoud |
---|---|
X'00' | Gereserveerd voor PL/I |
X'04' | Pointer naar vorige save-area (is dus register 13) |
X'08' | Pointer naar volgende save-area |
X'0C' | Register 14 |
X'10' | Register 15 |
X'14' | Register 0 |
etc. | t/m register 12 |
Hieronder volgen drie code-fragmenten:
* * 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
Als voorbeeld voor de toepassing van conditional assembly volgt
hieronder
een macro die de inhoud van de JCL-variabele SYSPARM aftest. Hiermee
wordt
gestuurd of het programma al dan niet geoptimaliseerd moet worden en
of er
al dan niet debugging code moet worden mee-gegenereerd.
De macro vult twee variabelen, die in de rest van de code kunnen
worden
afgetest om toepasselijke code te genereren. Ook hiervan volgen enige
voorbeelden. Hieronder volgen vier code-fragmenten:
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
Dit voorbeeld dient alleen als illustratie. In het algemeen raden
wij ten
zeerste af om self-modifying code toe te passen, omdat het uw
programma's
non-reentrant maakt en moeilijker te lezen en te onderhouden.
Hieronder volgen twee code-fragmenten:
* ... 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.
Om een VSAM dataset te kunnen verwerken heb je een ACB en een RPL nodig. In het eerste en enige voorbeeld laten we zien hoe je in een reentrant programma een ACB en een RPL kunt creëren. Voor dit voorbeeld mag u aannemen dat alle benoemde geheugen-lokaties dynamisch gealloceerd zijn en dat zij adresseerbaar zijn via een 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
Opmerkingen? Vragen? Meer informatie? Klik het onderwerp van uw keuze aan, of e-mail ons met uw vragen.
Voorbeeld standaard subprogramma aanroep.
Voorbeeld conditional assembly.
Voorbeeld self-modifying code.
Voorbeeld reentrant dataset verwerking.
Deze site is aangesloten bij WebRing. Bekijkt u gerust de lijst van mainframe-gerelateerde sites. |
Dino's zijn niet dood. Ze zijn gezond en wel en leven in computer-centra overal om ons heen. Zij spreken in tongen en doen wonderbare magie met computers. Pas op voor de dino! En voor het geval u zit te wachten op het definitieve einde van deze dino's: onthoud dat dino's de wereld 155 miljoen jaren hebben geregeerd! | |
[ Aanmelden | Ring Overzicht | Willekeurig | | ] |