|
|
|
|
|
|
||
© Copyright B.V. Bixoft 1999-2003. All rights reserved.
This software is free; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the Free
Software Foundation; either
version 2 of the License,
or (at your option) any later version.
More information is available from
the Free Software Foundation or
the Open Source Initiative.
This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
You should have received a copy of the GNU General Public License along with this software; if not, write to either of the following:
|
the Free Software Foundation, Inc. 59 Temple Place, Suite 330 Boston, MA 02111-1307 United States of America |
B.V. Bixoft Rogge 9 7261 JA Ruurlo The Netherlands |
|
email: bixoft@bixoft.nl phone: +31-6-22755401 |
Remark:
This software - and more programs and macros - are available in a format more
suitable for uploading to your mainframe. Please e-mail
B.V. Bixoft with your request
and you will receive a zipped IEBUPDTE job with the program sources.
.* 00000100
.* This macro is free software; you can redistribute it and/or modify 00000200
.* it under the terms of the GNU General Public License as published by 00000300
.* the Free Software Foundation; either version 2 of the License 00000400
.* or (at your option) any later version. 00000500
.* The license text is available at the following internet addresses: 00000600
.* - http://www.bixoft.com/english/gpl.htm 00000700
.* - http://fsf.org 00000800
.* - http://opensource.org 00000900
.* 00001000
.* This macro is distributed in the hope that it will be useful, 00001100
.* but WITHOUT ANY WARRANTY; without even the implied warranty of 00001200
.* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 00001300
.* See the GNU General Public License for more details. 00001400
.* 00001500
.* You should have received a copy of the GNU General Public License 00001600
.* along with this program; if not, write to either of the following: 00001700
.* the Free Software Foundation, Inc. B.V. Bixoft 00001800
.* 59 Temple Place, Suite 330 Rogge 9 00001900
.* Boston, MA 02111-1307 7261 JA Ruurlo 00002000
.* United States of America The Netherlands 00002100
.* 00002200
.* e-mail: bixoft@bixoft.nl 00002300
.* phone : +31-6-22755401 00002400
.* 00002500
.********************************************************************** 00010000
.* 00020000
.* Bixoft eXtended Assembly language 00030000
.* Licensed material - Property of B.V. Bixoft 00040000
.* 00050000
.* This macro can be licensed or used on an as-is basis. 00060000
.* No warranty, neither implicit nor explicit, is given. 00070000
.* It remains your own responsibility to ensure the correct 00080000
.* working of any program using this macro. 00090000
.* 00100000
.* Suggestions for improvement are always welcome at 00110000
.* http://www.bixoft.com or mail to bixoft@bixoft.nl 00120000
.* 00130000
.* (C) Copyright B.V. Bixoft, 1999 00140000
.********************************************************************** 00150000
MACRO 00160000
.* 00170000
.* Create a name/token pair 00180000
.* 00190000
&LABEL NTCR &PAR1, * Parameter 1 *00200000
&PAR2, * Parameter 2 *00210000
&PAR3, * Parameter 3 *00220000
&PAR4, * Parameter 4 *00230000
&PAR5, * Parameter 5 *00240000
&LVL=, * Value for level parameter *00250000
&NAME=, * Value for token name *00260000
&TOKEN=, * Value for token value *00270000
&PERSIST=, * Value for persist option *00280000
&MF= * MF=L or MF=(E,list_addr) *00290000
* or MF=(G,list_addr) 00300000
.* 00310000
.* &PAR1 (reg) or name of a fullword, containing the level 00320000
.* if omitted LVL= must be specified. 00330000
.* &PAR2 (reg) or name of a 16-byte area, containing the token name 00340000
.* if omitted NAME= must be specified. 00350000
.* &PAR3 (reg) or name of a 16-byte area, containing the token value 00360000
.* if omitted TOKEN= must be specified. 00370000
.* &PAR4 (reg) or name of a fullword, containing the persist option 00380000
.* if omitted PERSIST= must be specified. 00390000
.* &PAR5 (reg) or name of a fullword, where the returncode will go 00400000
.* must not be omitted. 00410000
.* 00420000
.* &LVL Literal, constant, or (reg). If specified, will be moved 00430000
.* into the level parameter fullword. 00440000
.* &NAME Literal, constant, or (reg). If specified, will be moved 00450000
.* into the token name parameter 16-byte area. 00460000
.* &TOKEN Literal, constant, or (reg). If specified, will be moved 00470000
.* into the token value parameter 16-byte area. 00480000
.* &PERSIST Literal, constant, or (reg). If specified, will be moved 00490000
.* into the persistence option parameter fullword. 00500000
.* &MF L or (L) for the list-form 00510000
.* (E,list_addr) for the execute form 00520000
.* (G,list_addr) for the generate form 00530000
.* 00540000
.* Declare variables 00550000
GBLC &BXA_AMODE * Current amode 00560000
LCLC &_LABEL * 00570000
LCLC &_MF1 * 1st MF-subparm: L or E 00580000
LCLC &_MF2 * 2nd MF-subparm: plist_address 00590000
LCLB &_MFL * On if MF=L 00600000
LCLB &_MFE * On if MF=E 00610000
LCLB &_MFG * On if MF=G 00620000
LCLB &APPEND * On if fields appended to plist 00630000
LCLA &CTR * Counter for allocating fields 00640000
LCLC &_PAR1 * &PAR1 or default 00650000
LCLC &_PAR2 * &PAR2 or default 00660000
LCLC &_PAR3 * &PAR3 or default 00670000
LCLC &_PAR4 * &PAR4 or default 00680000
LCLC &_PAR5 * &PAR5 or default 00690000
LCLC &_NAME * &NAME as unquoted string 00700000
LCLC &_TOKEN * &TOKEN as unquoted hex string 00710000
LCLA &I * Index into substrings 00720000
LCLC &BREG * Base register for plist 00730000
LCLC &PREG * Pointer register 00740000
LCLC &VREG * Value register 00750000
LCLC &UNAM * USING name 00760000
.* 00770000
.* Check positional parameters 00780000
AIF (N'&SYSLIST LE 5).NOERR1 00790000
MNOTE 4,'Too many positional parameters: ignored' 00800000
.NOERR1 ANOP 00810000
.* 00820000
.* Check the MF parameter 00830000
AIF (K'&MF EQ 0).ERR2A 00840000
&_MF1 SETC '&MF' * Copy MF-value 00850000
AIF ('&MF' EQ 'L').SETMFL * MF=L: ok 00860000
AIF ('&MF'(1,1) NE '(').ERR2B * MF=E must be in sublist 00870000
AIF (N'&MF EQ 0).ERR2B * 00880000
&_MF1 SETC '&MF(1)' * Copy MF-value 00890000
AIF ('&_MF1' EQ 'L' AND N'&MF NE 1).ERR2B 00900000
AIF ('&_MF1' EQ 'L').SETMFL * MF=(L): ok 00910000
AIF (N'&MF NE 2).ERR2B * Must have two sub-operands 00920000
&_MF2 SETC '&MF(2)' * Copy plist_address 00930000
AIF ('&_MF1' EQ 'E').SETMFE 00940000
AIF ('&_MF1' EQ 'G').SETMFG 00950000
AGO .ERR2B 00960000
.SETMFG ANOP 00970000
&_MFG SETB 1 * Signal MF=G 00980000
AGO .NOERR2 00990000
.SETMFE ANOP 01000000
&_MFE SETB 1 * Signal MF=E 01010000
AGO .NOERR2 01020000
.SETMFL ANOP 01030000
&_MFL SETB 1 * Signal MF=E 01040000
AGO .NOERR2 01050000
.ERR2A MNOTE 8,'Required parameter MF omitted' 01060000
AGO .NOERR2 01070000
.ERR2B MNOTE 8,'Parameter MF must be L, (L), (E,plist_addr) or (G,pli*01080000
st_addr)' 01090000
.NOERR2 ANOP 01100000
.* 01110000
.* Check PAR1 (level field) 01120000
AIF (&_MFE).NOERR3 01130000
AIF (&_MFG AND K'&PAR1 NE 0 AND K'&LVL NE 0).NOERR3A 01140000
AIF (K'&PAR1 EQ 0 AND K'&LVL EQ 0).ERR3A 01150000
AIF (K'&PAR1 NE 0 AND K'&LVL NE 0).ERR3A 01160000
AGO .NOERR3A 01170000
.ERR3A MNOTE 8,'Either the first positional parameter or the LVL-para*01180000
meter must be specified' 01190000
.NOERR3A ANOP 01200000
AIF (K'&PAR1 EQ 0).NOERR3B 01210000
AIF (&_MFG).NOERR3B 01220000
AIF ('&PAR1'(1,1) EQ '(').ERR3B 01230000
AGO .NOERR3B 01240000
.ERR3B MNOTE 8,'Positional parameter 1 must not specify (reg) with MF*01250000
=L' 01260000
.NOERR3B ANOP 01270000
.NOERR3 ANOP 01280000
.* 01290000
.* Check PAR2 (name field) 01300000
AIF (&_MFE).NOERR4 01310000
AIF (&_MFG AND K'&PAR2 NE 0 AND K'&NAME NE 0).NOERR4A 01320000
AIF (K'&PAR2 EQ 0 AND K'&NAME EQ 0).ERR4A 01330000
AIF (K'&PAR2 NE 0 AND K'&NAME NE 0).ERR4A 01340000
AGO .NOERR4A 01350000
.ERR4A MNOTE 8,'Either the second positional parameter or the NAME-pa*01360000
rameter must be specified' 01370000
.NOERR4A ANOP 01380000
AIF (K'&PAR2 EQ 0).NOERR4B 01390000
AIF (&_MFG).NOERR4B 01400000
AIF ('&PAR2'(1,1) EQ '(').ERR4B 01410000
AGO .NOERR4B 01420000
.ERR4B MNOTE 8,'Positional parameter 2 must not specify (reg) with MF*01430000
=L' 01440000
.NOERR4B ANOP 01450000
.NOERR4 ANOP 01460000
.* 01470000
.* Check PAR3 (token field) 01480000
AIF (&_MFE).NOERR5 01490000
AIF (&_MFG AND K'&PAR3 NE 0 AND K'&TOKEN NE 0).NOERR5A 01500000
AIF (K'&PAR3 EQ 0 AND K'&TOKEN EQ 0).ERR5A 01510000
AIF (K'&PAR3 NE 0 AND K'&TOKEN NE 0).ERR5A 01520000
AGO .NOERR5A 01530000
.ERR5A MNOTE 8,'Either the third positional parameter or the TOKEN-pa*01540000
rameter must be specified' 01550000
.NOERR5A ANOP 01560000
AIF (K'&PAR3 EQ 0).NOERR5B 01570000
AIF (&_MFG).NOERR5B 01580000
AIF ('&PAR3'(1,1) EQ '(').ERR5B 01590000
AGO .NOERR5B 01600000
.ERR5B MNOTE 8,'Positional parameter 3 must not specify (reg) with MF*01610000
=L' 01620000
.NOERR5B ANOP 01630000
.NOERR5 ANOP 01640000
.* 01650000
.* Check PAR4 (persist field) 01660000
AIF (&_MFE).NOERR6 01670000
AIF (&_MFG AND K'&PAR4 NE 0 AND K'&PERSIST NE 0).NOERR6A 01680000
AIF (K'&PAR4 EQ 0 AND K'&PERSIST EQ 0).ERR6A 01690000
AIF (K'&PAR4 NE 0 AND K'&PERSIST NE 0).ERR6A 01700000
AGO .NOERR6A 01710000
.ERR6A MNOTE 8,'Either the fourth positional parameter or the PERSIST*01720000
-parameter must be specified' 01730000
.NOERR6A ANOP 01740000
AIF (K'&PAR4 EQ 0).NOERR6B 01750000
AIF (&_MFG).NOERR6B 01760000
AIF ('&PAR4'(1,1) EQ '(').ERR6B 01770000
AGO .NOERR6B 01780000
.ERR6B MNOTE 8,'Positional parameter 4 must not specify (reg) with MF*01790000
=L' 01800000
.NOERR6B ANOP 01810000
.NOERR6 ANOP 01820000
.* 01830000
.* Check PAR5 (returncode field) 01840000
AIF (&_MFE).NOERR7 01850000
AIF (K'&PAR5 EQ 0).ERR7A 01860000
AGO .NOERR7A 01870000
.ERR7A MNOTE 8,'The fifth positional parameter must be specified' 01880000
.NOERR7A ANOP 01890000
AIF (K'&PAR5 EQ 0).NOERR7B 01900000
AIF (&_MFG).NOERR7B 01910000
AIF ('&PAR5'(1,1) EQ '(').ERR7B 01920000
AGO .NOERR7B 01930000
.ERR7B MNOTE 8,'Positional parameter 5 must not specify (reg) with MF*01940000
=L' 01950000
.NOERR7B ANOP 01960000
.NOERR7 ANOP 01970000
.* 01980000
.* Check the LVL parameter 01990000
AIF (K'&LVL EQ 0).NOERR8 02000000
AIF (&_MFL AND '&LVL'(1,1) EQ '(').ERR8A 02010000
AGO .NOERR8 02020000
.ERR8A MNOTE 8,'LVL-parameter must not specify (reg) when MF=L' 02030000
.NOERR8 ANOP 02040000
.* 02050000
.* Check the NAME parameter 02060000
AIF (K'&NAME EQ 0).NOERR9 02070000
AIF (&_MFL AND '&NAME'(1,1) EQ '(').ERR9A 02080000
AGO .NOERR9A 02090000
.ERR9A MNOTE 8,'NAME-parameter must not specify (reg) when MF=L' 02100000
.NOERR9A ANOP 02110000
AIF ('&NAME'(1,1) EQ '(').NOERR9 * (reg): no literal check 02120000
&_NAME SETC '&NAME' * Assume name correct 02130000
&I SETA K'&NAME * 02140000
AIF ('&NAME'(&I,1) NE '''').NOERR9 * Unquoted string ok 02150000
AIF ('&NAME'(1,1) NE 'C').NAMNOTC 02160000
&_NAME SETC '&_NAME'(2,&I-1) * Remove leading C 02170000
&I SETA &I-1 * 02180000
.NAMNOTC ANOP 02190000
AIF ('&NAME'(1,1) NE '''').ERR9B 02200000
&_NAME SETC '&_NAME'(2,&I-2) * Remove lead/trail quotes 02210000
AGO .NOERR9 02220000
.ERR9B MNOTE 8,'Name must be specified as (un)quoted string or C-type*02230000
constant without L-modifier' 02240000
.NOERR9 ANOP 02250000
.* 02260000
.* Check the TOKEN parameter 02270000
AIF (K'&TOKEN EQ 0).NOERR10 02280000
AIF (&_MFL AND '&TOKEN'(1,1) EQ '(').ERR10A 02290000
AGO .NOERR10A 02300000
.ERR10A MNOTE 8,'TOKEN-parameter must not specify (reg) when MF=L' 02310000
.NOERR10A ANOP 02320000
AIF ('&TOKEN'(1,1) NE '(').NOERR10 * (reg) no literal check 02330000
&_TOKEN SETC '&TOKEN' * Assume token correct 02340000
&I SETA K'&TOKEN * 02350000
AIF ('&TOKEN'(&I,1) NE '''').NOERR10B * Unquoted string ok 02360000
AIF ('&TOKEN'(1,1) NE 'X').TOKNOTX 02370000
&_TOKEN SETC '&_TOKEN'(2,&I-1) * Remove leading X 02380000
&I SETA &I-1 * 02390000
.TOKNOTX ANOP 02400000
AIF ('&TOKEN'(1,1) NE '''').ERR10B 02410000
&_TOKEN SETC '&_TOKEN'(2,&I-2) * Remove lead/trail quotes 02420000
AGO .NOERR10B 02430000
.ERR10B MNOTE 8,'Name must be specified as (un)quoted string or C-type*02440000
constant without L-modifier' 02450000
.NOERR10B ANOP 02460000
CHKNUM MACRO=NTCR, * Check the resulting string *02470000
NAME=TOKEN, * in parameter TOKEN *02480000
VAL=&_TOKEN * 02490000
.NOERR10 ANOP 02500000
.* 02510000
.* Check the PERSIST parameter 02520000
AIF (K'&PERSIST EQ 0).NOERR11 02530000
AIF (&_MFL AND '&PERSIST'(1,1) EQ '(').ERR11A 02540000
AGO .NOERR11 02550000
.ERR11A MNOTE 8,'PERSIST-parameter must not specify (reg) when MF=L' 02560000
.NOERR11 ANOP 02570000
.* 02580000
.* Check the current amode 02590000
AIF ('&BXA_AMODE' EQ '31').NOERR12 02600000
.ERR12 MNOTE 8,'NTCR-macro cannot be issued when in Amode 24' 02610000
.NOERR12 ANOP 02620000
.* 02630000
.* Include mapping macro for plist 02640000
GENMAPS IEANT * Map unless already mapped 02650000
AIF (&_MFE).MFE 02660000
.********************************************************************** 02670000
.* 02680000
.* Generate code for MF=L 02690000
.* First part also used for MF=G 02700000
.* 02710000
.********************************************************************** 02720000
.* 02730000
.* All fields not specified on the positional parameter by default 02740000
.* will be appended to the Plist proper 02750000
AIF (K'&PAR1 EQ 0 OR K'&PAR2 EQ 0 OR K'&PAR3 EQ 0).APPEND 02760000
AIF (K'&PAR4 EQ 0 OR K'&PAR5 EQ 0).APPEND 02770000
AGO .NOAPPEND 02780000
.APPEND ANOP 02790000
&APPEND SETB 1 02800000
.NOAPPEND ANOP 02810000
.* 02820000
.* For defaulted fields a label is required 02830000
AIF (NOT &_MFG).LABEL * MF=L? normal label processing 02840000
AIF ('&_MF2'(1,1) EQ '(').GLBLREG * MF=(G,(reg)): register! 02850000
&_LABEL SETC 'CRPL.NTCRPL' 02860000
AGO .LABELOK 02870000
.GLBLREG ANOP , * Plist addressed with register 02880000
&_BREG SETC '&MF(2,1)' * Extract pointer register 02890000
&_LABEL SETC '(&_BREG)' * Points to plist 02900000
AGO .LABELOK 02910000
.LABEL ANOP 02920000
&_LABEL SETC '&LABEL' 02930000
AIF (NOT &APPEND).LABELOK 02940000
AIF (K'&LABEL NE 0).LABELOK 02950000
&_LABEL SETC '_NTCR&SYSNDX' 02960000
.LABELOK ANOP 02970000
&CTR SETA 20 * Plist length 02980000
.* 02990000
.* Determine defaulted positions for unspecified fields 03000000
.* PAR1: level field (fullword) 03010000
&_PAR1 SETC '&PAR1' * Copy specified field location 03020000
AIF (K'&PAR1 NE 0).LPAR1OK * If not specified 03030000
&_PAR1 SETC '&_LABEL.+&CTR' * append field to plist 03040000
AIF ('&_LABEL'(1,1) NE '(').LPAR1AD * Unless (reg) 03050000
&_PAR1 SETC '&CTR.&_LABEL' * append field to plist 03060000
.LPAR1AD ANOP 03070000
&CTR SETA &CTR+4 * Advance to next free position 03080000
.LPAR1OK ANOP 03090000
.* 03100000
.* PAR2: name field (16 characters) 03110000
&_PAR2 SETC '&PAR2' * Copy specified field location 03120000
AIF (K'&PAR2 NE 0).LPAR2OK * If not specified 03130000
&_PAR2 SETC '&_LABEL.+&CTR' * append field to plist 03140000
AIF ('&_LABEL'(1,1) NE '(').LPAR2AD * Unless (reg) 03150000
&_PAR2 SETC '&CTR.&_LABEL' * append field to plist 03160000
.LPAR2AD ANOP 03170000
&CTR SETA &CTR+16 * Advance to next free position 03180000
.LPAR2OK ANOP 03190000
.* 03200000
.* PAR3: token field (16 bytes) 03210000
&_PAR3 SETC '&PAR3' * Copy specified field location 03220000
AIF (K'&PAR3 NE 0).LPAR3OK * If not specified 03230000
&_PAR3 SETC '&_LABEL.+&CTR' * append field to plist 03240000
AIF ('&_LABEL'(1,1) NE '(').LPAR3AD * Unless (reg) 03250000
&_PAR3 SETC '&CTR.&_LABEL' * append field to plist 03260000
.LPAR3AD ANOP 03270000
&CTR SETA &CTR+16 * Advance to next free position 03280000
.LPAR3OK ANOP 03290000
.* 03300000
.* PAR4: persist field (fullword) 03310000
&_PAR4 SETC '&PAR4' * Copy specified field location 03320000
AIF (K'&PAR4 NE 0).LPAR4OK * If not specified 03330000
&_PAR4 SETC '&_LABEL.+&CTR' * append field to plist 03340000
AIF ('&_LABEL'(1,1) NE '(').LPAR4AD * Unless (reg) 03350000
&_PAR4 SETC '&CTR.&_LABEL' * append field to plist 03360000
.LPAR4AD ANOP 03370000
&CTR SETA &CTR+4 * Advance to next free position 03380000
.LPAR4OK ANOP 03390000
.* 03400000
.* PAR5: return field (fullword) 03410000
&_PAR5 SETC '&PAR5' * Copy specified field location 03420000
AIF (K'&PAR5 NE 0).LPAR5OK * If not specified 03430000
&_PAR5 SETC '&_LABEL.+&CTR' * append field to plist 03440000
AIF ('&_LABEL'(1,1) NE '(').LPAR5AD * Unless (reg) 03450000
&_PAR5 SETC '&CTR.&_LABEL' * append field to plist 03460000
.LPAR5AD ANOP 03470000
&CTR SETA &CTR+4 * Advance to next free position 03480000
.LPAR5OK ANOP 03490000
.* 03500000
.* Plist generation for MF=G follows rules of MF=E 03510000
.* If there are any defaulted positional parameters: reinvoke NTCR 03520000
AIF (&_MFL).MFL 03530000
AIF (NOT &APPEND).MFE 03540000
&LABEL NTCR &_PAR1,&_PAR2,&_PAR3,&_PAR4,&_PAR5, *03550000
LVL=&LVL, * *03560000
NAME=&NAME, * *03570000
TOKEN=&TOKEN, * *03580000
PERSIST=&PERSIST, * *03590000
MF=(G,&_MF2) * 03600000
AGO .LWARN 03610000
.* 03620000
.MFL ANOP 03630000
.* 03640000
.* Generate code for MF=L 03650000
DS 0F * Align on fullword 03660000
&_LABEL EQU *,&CTR * 03670000
DC AL4(&_PAR1) * Level pointer 03680000
DC AL4(&_PAR2) * Name pointer 03690000
DC AL4(&_PAR3) * Token pointer 03700000
DC AL4(&_PAR4) * Persist option pointer 03710000
DC AL4(&_PAR5) * Returncode pointer 03720000
.* 03730000
.* Generate defaulted level field 03740000
AIF ('&_PAR1' EQ '&PAR1').LNOPAR1 03750000
DC AL4(&LVL) 03760000
.LNOPAR1 ANOP 03770000
.* 03780000
.* Generate defaulted name field 03790000
AIF ('&_PAR2' EQ '&PAR2').LNOPAR2 03800000
DC CL16'&_NAME' 03810000
.LNOPAR2 ANOP 03820000
.* 03830000
.* Generate defaulted token field 03840000
AIF ('&_PAR3' EQ '&PAR3').LNOPAR3 03850000
DC XL16'&_TOKEN' 03860000
.LNOPAR3 ANOP 03870000
.* 03880000
.* Generate defaulted persist option field 03890000
AIF ('&_PAR4' EQ '&PAR4').LNOPAR4 03900000
DC AL4(&PERSIST) 03910000
.LNOPAR4 ANOP 03920000
.* 03930000
.* Generate defaulted return code field (violates reentrancy) 03940000
AIF ('&_PAR5' EQ '&PAR5').LNOPAR5 03950000
DC AL4(0) 03960000
.LNOPAR5 ANOP 03970000
.* 03980000
.* Generate warning with length of plist 03990000
.LWARN ANOP 04000000
AIF (NOT &APPEND).EXIT 04010000
MNOTE *,'Generated Plist and areas for NTCR: &CTR bytes' 04020000
AGO .MEXIT 04030000
.********************************************************************* 04040000
.* 04050000
.* Generate coding for MF=E 04060000
.* 04070000
.********************************************************************* 04080000
.MFE ANOP 04090000
&LABEL LABEL , * 04100000
.* 04110000
.* If no overriding parameters are specified: skip plist modification 04120000
AIF (K'&PAR1 NE 0).EMODPL 04130000
AIF (K'&PAR2 NE 0 OR K'&LVL NE 0).EMODPL 04140000
AIF (K'&PAR3 NE 0 OR K'&NAME NE 0).EMODPL 04150000
AIF (K'&PAR4 NE 0 OR K'&TOKEN NE 0).EMODPL 04160000
AIF (K'&PAR5 NE 0 OR K'&PERSIST NE 0).EMODPL 04170000
AGO .ENOMOD 04180000
.* 04190000
.* Make parmlist addressable 04200000
.EMODPL ANOP , * Modify Plist before call 04210000
AIF ('&_MF2'(1,1) EQ '(').EREG 04220000
CRPL USE NTCRPL,&_MF2 * Set plist addressable 04230000
&UNAM SETC 'CRPL.' 04240000
AGO .EUSEOK 04250000
.EREG ANOP 04260000
&BREG SETC '&MF(2,1)' * Extract register number 04270000
USE NTCRPL,&BREG * And set plist addressable 04280000
.EUSEOK ANOP 04290000
.* 04300000
.* If PAR1 specified insert address of level field into plist 04310000
&PREG SETC 'R15' * Set register to use as pointer 04320000
&VREG SETC 'R0' * Set register to use for value 04330000
AIF (K'&PAR1 EQ 0).ENOPAR1 04340000
AIF ('&PAR1'(1,1) EQ '(').EPAR1R * Register specified? 04350000
LA &PREG,&PAR1 * Point to level field 04360000
AGO .EPAR1OK 04370000
.EPAR1R ANOP , * Specified as (reg) 04380000
&PREG SETC '&PAR1(1)' * Extract level field pointer 04390000
.EPAR1OK ANOP 04400000
ST &PREG,&UNAM.NTCRLVL * Put pointer into plist 04410000
.ENOPAR1 ANOP 04420000
.* 04430000
.* If LVL specified insert value into field 04440000
AIF (K'&LVL EQ 0).ENOLVL 04450000
AIF (K'&PAR1 NE 0).EPTR1OK * Pointer already loaded? 04460000
L &PREG,NTCRLVL * Point to level field 04470000
.EPTR1OK ANOP 04480000
AIF ('&LVL'(1,1) EQ '(').ELVLR * Register specified? 04490000
LA &VREG,&LVL * Load level value 04500000
AGO .ELVLOK 04510000
.ELVLR ANOP , * Specified as (reg) 04520000
&VREG SETC '&LVL(1)' * Extract level value register 04530000
.ELVLOK ANOP 04540000
ST &VREG,0(,&PREG) * And put into level field 04550000
.ENOLVL ANOP 04560000
.* 04570000
.* If PAR2 specified insert address of name field into plist 04580000
&PREG SETC 'R15' * Set register to use as pointer 04590000
&VREG SETC 'R0' * Set register to use for value 04600000
AIF (K'&PAR2 EQ 0).ENOPAR2 04610000
AIF ('&PAR2'(1,1) EQ '(').EPAR2R * Register specified? 04620000
LA &PREG,&PAR2 * Point to name field 04630000
AGO .EPAR2OK 04640000
.EPAR2R ANOP , * Specified as (reg) 04650000
&PREG SETC '&PAR2(1)' * Extract name field pointer 04660000
.EPAR2OK ANOP 04670000
ST &PREG,&UNAM.NTCRNAM * Put pointer into plist 04680000
.ENOPAR2 ANOP 04690000
.* 04700000
.* If NAME specified insert value into field 04710000
AIF (K'&NAME EQ 0).ENONAM 04720000
AIF (K'&PAR2 NE 0).EPTR2OK * Pointer already loaded? 04730000
L &PREG,NTCRNAM * Point to name field 04740000
.EPTR2OK ANOP 04750000
AIF ('&NAME'(1,1) EQ '(').ENAMR * Register specified? 04760000
MVC 0(16,&PREG),=CL16'&_NAME' * Move name into field 04770000
AGO .ENONAM 04780000
.ENAMR ANOP , * Specified as (reg) 04790000
&VREG SETC '&NAME(1)' * Extract name value register 04800000
MVC 0(16,&PREG),0(&VREG) * Move name into field 04810000
.ENONAM ANOP 04820000
.* 04830000
.* If PAR3 specified insert address of token field into plist 04840000
&PREG SETC 'R15' * Set register to use as pointer 04850000
&VREG SETC 'R0' * Set register to use for value 04860000
AIF (K'&PAR3 EQ 0).ENOPAR3 04870000
AIF ('&PAR3'(1,1) EQ '(').EPAR3R * Register specified? 04880000
LA &PREG,&PAR3 * Point to token field 04890000
AGO .EPAR3OK 04900000
.EPAR3R ANOP , * Specified as (reg) 04910000
&PREG SETC '&PAR3(1)' * Extract token field pointer 04920000
.EPAR3OK ANOP 04930000
ST &PREG,&UNAM.NTCRTOK * Put pointer into plist 04940000
.ENOPAR3 ANOP 04950000
.* 04960000
.* If TOKEN specified insert value into field 04970000
AIF (K'&TOKEN EQ 0).ENOTOK 04980000
AIF (K'&PAR3 NE 0).EPTR3OK * Pointer already loaded? 04990000
L &PREG,NTCRTOK * Point to token field 05000000
.EPTR3OK ANOP 05010000
AIF ('&TOKEN'(1,1) EQ '(').ETOKR * Register specified? 05020000
MVC 0(16,&PREG),=XL16'&_TOKEN' * Move token into field 05030000
AGO .ENOTOK 05040000
.ETOKR ANOP , * Specified as (reg) 05050000
&VREG SETC '&TOKEN(1)' * Extract token value register 05060000
MVC 0(16,&PREG),0(&VREG) * Move token into field 05070000
.ENOTOK ANOP 05080000
.* 05090000
.* If PAR4 specified insert address of persist option field into plist 05100000
&PREG SETC 'R15' * Set register to use as pointer 05110000
&VREG SETC 'R0' * Set register to use for value 05120000
AIF (K'&PAR4 EQ 0).ENOPAR4 05130000
AIF ('&PAR4'(1,1) EQ '(').EPAR4R * Register specified? 05140000
LA &PREG,&PAR4 * Point to option field 05150000
AGO .EPAR4OK 05160000
.EPAR4R ANOP , * Specified as (reg) 05170000
&PREG SETC '&PAR4(1)' * Extract option field pointer 05180000
.EPAR4OK ANOP 05190000
ST &PREG,&UNAM.NTCRPOPT * Put pointer into plist 05200000
.ENOPAR4 ANOP 05210000
.* 05220000
.* If PERSIST specified insert value into field 05230000
AIF (K'&PERSIST EQ 0).ENOPER 05240000
AIF (K'&PAR4 NE 0).EPTR4OK * Pointer already loaded? 05250000
L &PREG,NTCRPOPT * Point to option field 05260000
.EPTR4OK ANOP 05270000
AIF ('&PERSIST'(1,1) EQ '(').EPERR * Register specified? 05280000
LA &VREG,&PERSIST * Load persistence option value 05290000
AGO .EPEROK 05300000
.EPERR ANOP , * Specified as (reg) 05310000
&VREG SETC '&PERSIST(1)' * Extract option value register 05320000
.EPEROK ANOP 05330000
ST &VREG,0(,&PREG) * And put into option field 05340000
.ENOPER ANOP 05350000
.* 05360000
.* If PAR5 specified insert address of returncode field into plist 05370000
&PREG SETC 'R15' * Set register to use as pointer 05380000
&VREG SETC 'R0' * Set register to use for value 05390000
AIF (K'&PAR5 EQ 0).ENOPAR5 05400000
AIF ('&PAR5'(1,1) EQ '(').EPAR5R * Register specified? 05410000
LA &PREG,&PAR5 * Point to retcode field 05420000
AGO .EPAR5OK 05430000
.EPAR5R ANOP , * Specified as (reg) 05440000
&PREG SETC '&PAR5(1)' * Extract retcode pointer 05450000
.EPAR5OK ANOP 05460000
ST &PREG,&UNAM.NTCRRCD * Put pointer into plist 05470000
.ENOPAR5 ANOP 05480000
.* 05490000
.* Plist is now complete 05500000
AIF ('&_MF2'(1,1) EQ '(').EDROPR 05510000
DROP CRPL * NTCRPL 05520000
AGO .EDROPOK 05530000
.EDROPR DROP &BREG * NTCRPL 05540000
.EDROPOK ANOP 05550000
.ENOMOD ANOP , * No modifications to plist 05560000
.* 05570000
.* For MF=G we're done 05580000
AIF (&_MFG).MEXIT 05590000
.* 05600000
.* Invoke Name/Token service IEANTCR 05610000
AIF (K'&BREG EQ 0).ELAR1 05620000
LR R1,&BREG * R1 must point to plist 05630000
AGO .ER1OK 05640000
.ELAR1 ANOP 05650000
LA R1,&_MF2 * R1 must point to plist 05660000
.ER1OK ANOP 05670000
.* 05680000
L R15,X'010' * Retrieve 05690000
L R15,X'220'(,R15) * address 05700000
L R15,X'014'(,R15) * of 05710000
L R15,X'004'(,R15) * IEANTCR 05720000
BASR R14,R15 * And call it 05730000
.* 05740000
.MEXIT ANOP 05750000
MEND 05760000
Please e-mail us with your comments. Thanks in advance.
To our homepage.
|
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 >> ] |
||