You are invited to browse the list of mainframe-loving sites.
[ Join Now | Ring Hub | Random | << Prev | Next >> ]
© Copyright B.V. Bixoft 1999-2003. All rights reserved.
This program makes use of various macros from Bixoft's eXtended Assembly language. For your convenience the non-trivial macros are described here. For a complete overview, please refer to the Macro overview page on this site.
| Macro | Short description |
|---|---|
| PGM | Program entry logic, including DSECT mappings |
| EQUREG | Assigns the number of an available register |
| USE | Replaces USING, informs EQUREG which registers are in use, even when they're not used for addressing |
| IF | Specifies a condition |
| INC | INCrement a register by one or the amount specified |
| DEC | DECrement a register by one or the amount specified |
| CPY | Copies a field or register to another field or register |
| EXTRT | EXecutes a TRT instruction of variable length |
| EXCLC | EXecutes a CLC instruction of variable length |
| GOTO | Branches to specified label. Additional parameters are used as a condition |
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 program 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 program 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
*PROCESS FLAG(SUBSTR) 00010000
*PROCESS RENT 00020000
*********************************************************************** 00030000
* 00040000
* BIXXAMS - Bixoft Cross Access Method Services 00050000
* Licensed material - Property of B.V. Bixoft 00060000
* 00070000
* This program can be licensed or used on an as-is basis. 00080000
* No warranty, neither implicit nor explicit, is given. 00090000
* It remains your own responsibility to ensure the correct 00100000
* working of this program in your installation. 00110000
* 00120000
* Suggestions for improvement are always welcome at 00130000
* http://www.bixoft.com or mail to bixoft@bixoft.nl 00140000
* 00150000
* (C) Copyright B.V. Bixoft, 1999-2000 00160000
*********************************************************************** 00170000
* 00180000
* This program tests a condition string, which is passed as a 00190000
* parameter on the exec statement. Syntax: 00200000
* PARM='parm1 oper parm2' 00210000
* where parm1 and parm2 are the comparands and 00220000
* oper is either EQ or NE 00230000
* The delimiters are single spaces 00240000
* 00250000
*********************************************************************** 00260000
PGM VERSION=V00R00M00, * Version number *00270000
HDRTXT='Bixxams condition tester', *00280000
WORKAREA=BXASAVE, * Dynamic area *00290000
SAVES=0, * Internal save-areas *00300000
ABND=4090 * Abend code for BXATEST 00310000
* 00320000
* Assign some global registers 00330000
R_RCD EQUREG , * Assign retcode register 00340000
USE R_RCD,SCOPE=CALLED * Set register in use 00350000
R_TMP EQU R_RCD * retcode reg also temp reg 00360000
R_PTR1 EQUREG , * Ptr to first operand 00370000
USE R_PTR1 * Set register in use 00380000
R_PTR2 EQUREG , * Ptr to second operand 00390000
USE R_PTR2 * Set register in use 00400000
R_PTROP EQUREG , * Ptr to operator 00410000
USE R_PTROP * Set register in use 00420000
R_LEN1 EQUREG , * Length of first operand 00430000
USE R_LEN1 * Set register in use 00440000
R_LEN2 EQUREG , * Length of second operand 00450000
USE R_LEN2 * Set register in use 00460000
R_LENOP EQUREG , * Length of operator 00470000
USE R_LENOP * Set register in use 00480000
* 00490000
* Retrieve JCL parameter - if specified - and save in R_PTR1 00500000
IF R1,Z * Pointer to parmlist valid? 00510000
ABND , * No: issue error 00520000
ENDIF , * 00530000
L R_PTR1,0(,R1) * Retrieve ptr to JCL parm 00540000
CLEAR (R_PTR1,*ADDR) * Wipe hi-order bit 00550000
IF R_PTR1,Z * If it is invalid 00560000
ABND , * issue error 00570000
ENDIF , * 00580000
LH R_LEN1,0(R_PTR1) * First halfword is length 00590000
INC R_PTR1,2 * Point start of text of parm 00600000
IF R_LEN1,GT,256 * If it is too long 00610000
ABND , * Issue error 00620000
ENDIF , * 00630000
IF R_LEN1,Z * If no parm was specified 00640000
ABND , * Issue error 00650000
ENDIF , * 00660000
* 00670000
* Find first space in input string 00680000
L R_TMP,=A(TRTAB1) * Point table to be used 00690000
EXTRT 0(R_LEN1,R_PTR1),0(R_TMP) * Search first space 00700000
ABND Z * Abend if no space found 00710000
* 00720000
* Set pointer to opcode 00730000
LA R_PTROP,1(,R1) * Point first byte of opcode 00740000
CPY R_PTR2,R_PTROP * Start of remainder of string 00750000
* 00760000
* Determine length of operand 1 and remainder of string 00770000
CPY R_LEN2,R_LEN1 * Copy string length 00780000
CPY R_TMP,R1 * Delimiter location 00790000
SR R_TMP,R_PTR1 * Nr of chars in first operand 00800000
ABND Z * Empty operand is error 00810000
CPY R_LEN1,R_TMP * Set length of operand 1 00820000
SR R_LEN2,R_LEN1 * Remaining string length 00830000
DEC R_LEN2 * after delimiter 00840000
IF R_LEN2,LE,0 * Something left? 00850000
ABND , * No: error 00860000
ENDIF , * 00870000
* 00880000
* Determine length of opcode and remainder of string 00890000
L R_TMP,=A(TRTAB1) * Point table to be used 00900000
EXTRT 0(R_LEN2,R_PTR2),0(R_TMP) * Search next space 00910000
ABND Z * Abend if no space found 00920000
CPY R_LENOP,R1 * Point to delimiter 00930000
SR R_LENOP,R_PTROP * Nr of chars in operator 00940000
ABND Z * No operator: error 00950000
LA R_PTR2,1(,R1) * Point after delimiter 00960000
SR R_LEN2,R_LENOP * Remove operator from length 00970000
DEC R_LEN2 * and delimiter as well 00980000
IF R_LEN2,LE,0 * Something left? 00990000
ABND , * No: error 01000000
ENDIF , * 01010000
* 01020000
* Determine length of operand 2 01030000
L R_TMP,=A(TRTAB1) * Point table to be used 01040000
EXTRT 0(R_LEN2,R_PTR2),0(R_TMP) * Search next space 01050000
IF NZ * Delimiter found 01060000
CPY R_LEN2,R1 * Set to delimiter location 01070000
SR R_LEN2,R_PTR2 * Nr of chars in operand 2 01080000
ABND Z * Missing operand: error 01090000
ENDIF , * 01100000
* 01110000
* Test for equal comparison? 01120000
IF E,EXCLC,0(R_LENOP,R_PTROP),=CL2'EQ' * EQ comparison? 01130000
IF R_LEN1,NE,R_LEN2 * Lengths should be equal 01140000
GOTO RETCD4 * Return mismatch 01150000
ENDIF , * 01160000
EXCLC 0(R_LEN1,R_PTR1),0(R_PTR2) * Operands equal? 01170000
GOTO RETCD0,E * Yes: return ok 01180000
GOTO RETCD4 * No: return mismatch 01190000
ENDIF , 01200000
* 01210000
* Test for unequal comparison? 01220000
IF E,EXCLC,0(R_LENOP,R_PTROP),=CL2'NE' * NE comparison? 01230000
IF R_LEN1,NE,R_LEN2 * Lengths should be unequal 01240000
GOTO RETCD0 * Return mismatch 01250000
ENDIF , * 01260000
EXCLC 0(R_LEN1,R_PTR1),0(R_PTR2) * Operands unequal? 01270000
GOTO RETCD0,NE * Yes: return ok 01280000
GOTO RETCD4 * No: return mismatch 01290000
ENDIF , 01300000
* 01310000
* Invalid operator 01320000
ABND , * 01330000
* 01340000
* Return 4 when specified condition is not met 01350000
RETCD4 LABEL , * 01360000
LA R15,4 * Set retcode 01370000
GOTO EXIT * 01380000
* 01390000
* Return 0 when specified condition is met 01400000
RETCD0 LABEL , * 01410000
CLEAR R15 * Set retcode 01420000
* 01430000
EXIT LABEL , * Exit point 01440000
* 01450000
* Release registers 01460000
DROP R_PTR1 * 01470000
DROP R_PTR2 * 01480000
DROP R_PTROP * 01490000
DROP R_LEN1 * 01500000
DROP R_LEN2 * 01510000
DROP R_RCD * 01520000
* 01530000
* And exit 01540000
RETRN RC=* * Quit this program 01550000
*********************************************************************** 01560000
* 01570000
* Constants etc. 01580000
* 01590000
*********************************************************************** 01600000
LTORG , * 01610000
*********************************************************************** 01620000
* 01630000
* Indirectly addressable Plists and constants 01640000
* 01650000
*********************************************************************** 01660000
TRTAB1 TRTAB , * Select no characters *01670000
CHARS=(C' ') * Except space 01680000
* 01690000
END 01700000
|
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 >> ] |
||
Below you find the logo of our sponsor and logos of the web-standards that this page adheres to.
|
|
|
|
||