|
|
|
|
|
|
||
© 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
.* Copy a field - register or storage 00180000
.* 00190000
.* For oversized packed fields unpacking may be done by processing 00200000
.* left to right in clusters of several bytes at a time. 00210000
.* For oversized zoned fields packing may be done by processing 00220000
.* right to left in a loop. 00230000
.* For every EQUREG a check must be made whether the source and/or 00240000
.* destination registers are in USE. Change EQUREG with a 00250000
.* NO=(...) keyword. 00260000
.* 00270000
&LABEL CPY &TO, * Destination field *00280000
&FROM, * Source field *00290000
&WARN * NOWARN or nothing 00300000
.* 00310000
.* &TO specifies the field or register to be filled, 00320000
.* or (field,length) to override the length of the field 00330000
.* or (reg,end_reg_name) to copy to a set of registers 00340000
.* or (reg,nr_of_regs) to copy to a set of registers 00350000
.* or (gpr_name,ar_name) to copy to 1 or more GPR/AR pairs 00360000
.* or ((gpr),len) to copy to a register-designated area 00370000
.* or ((gpr),(gpr)) to copy to a register-designated area 00380000
.* &FROM specifies the field or register to be copied, 00390000
.* or (field,length) to override the length of the field 00400000
.* or (reg,nr_of_regs) to copy from a set of registers 00410000
.* or (reg,end_reg_name) to copy from a set of registers 00420000
.* or (gpr_name,ar_name) to copy from 1 or more GPR/AR pairs 00430000
.* or ((gpr),len) to copy from a register-designated area 00440000
.* or ((gpr),(gpr)) to copy from a register-designated area 00450000
.* or *STACK to retrieve registers from the stack 00460000
.* &WARN specifies whether or not a warning is to be issued if 00470000
.* &TO and &FROM designate the same field/register 00480000
.* 00490000
.* Declare variables 00500000
GBLC &SYSASCE * Current ASC mode: P or AR 00510000
GBLA &BXA_RC * Returncode from CHKREG 00520000
GBLA &BXA_NUMVAL * Register nr from CHKREG 00530000
LCLC &_LABEL * LABEL parameter 00540000
LCLC &_TO1 * TO field designation 00550000
LCLC &_TO2 * TO length 00560000
LCLC &TO_TP * Type of TO location 00570000
LCLA &TO_LEN * Length of TO location 00580000
LCLA &TO_REG * TO register number 00590000
LCLB &TO_EREG * TO end register specified? 00600000
LCLC &_FROM1 * FROM field designation 00610000
LCLC &_FROM2 * FROM length 00620000
LCLC &FROM_TP * Type of FROM location 00630000
LCLA &FROM_LEN * Length of FROM location 00640000
LCLA &FROM_REG * FROM register number 00650000
LCLB &FROM_EREG * FROM end register specified? 00660000
LCLA &FROM_VAL * Value of FROM literal 00670000
LCLC &SIGN * Sign of FROM literal value 00680000
LCLB &EQULIT * Source is an equated literal 00690000
LCLA &I,&J * 00700000
LCLA &LEN * Length value 00710000
LCLC &LENC * Length value (character) 00720000
LCLA &PAD_LEN * Length of pad area 00730000
LCLC &PAD_ADR * Length of pad area 00740000
LCLB &PAD0 * On for pad with zeros *00750000
* Off for pad with blanks 00760000
LCLC &MASK * Byte mask 00770000
LCLC ® * A register name 00780000
LCLC &ODDREG * Associated odd reg name 00790000
LCLA ®_CT * Count of registers 00800000
LCLC ®_SRCP * Source ptr reg for MVCL 00810000
LCLC ®_SRCL * Source length reg for MVCL 00820000
LCLC ®_DSTP * Destination ptr reg for MVCL 00830000
LCLC ®_DSTL * Destination leng reg for MVCL 00840000
.* 00850000
.* Copy the LABEL parameter 00860000
&_LABEL SETC '&LABEL' * 00870000
.* 00880000
.* Check TO parameter 00890000
AIF (K'&TO EQ 0).ERR1A * 00900000
&_TO1 SETC '&TO' * Copy destination field 00910000
AIF ('&TO'(1,1) NE '(').NOERR1 * No length specified 00920000
AIF (N'&TO EQ 0).ERR1B * Must have 00930000
AIF (N'&TO EQ 1).ERR1C * exactly two 00940000
AIF (N'&TO GT 2).ERR1D * sub-operands 00950000
.NOERR1D ANOP , * 00960000
&_TO1 SETC '&TO(1)' * Extract field designation 00970000
&_TO2 SETC '&TO(2)' * and field length 00980000
AIF (K'&_TO1 EQ 0).ERR1B * 00990000
AIF (K'&_TO2 EQ 0).ERR1C * 01000000
AGO .NOERR1 * 01010000
.ERR1A MNOTE 8,'Missing first operand - destination of copy' 01020000
MEXIT , * 01030000
.ERR1B MNOTE 8,'Destination in parentheses: missing field name' 01040000
MEXIT , * 01050000
.ERR1C MNOTE 8,'Destination in parentheses: missing length' 01060000
MEXIT , * 01070000
.ERR1D MNOTE 4,'Destination in parentheses: too many subparameters' 01080000
AGO .NOERR1D * 01090000
.NOERR1 ANOP , * 01100000
.* 01110000
.* Check FROM parameter 01120000
AIF (K'&FROM EQ 0).ERR2A * 01130000
&_FROM1 SETC '&FROM' * Copy source field 01140000
AIF ('&FROM' EQ '*STACK').NOERR2 01150000
AIF ('&FROM'(1,1) NE '(').NOERR2 * No length specified 01160000
AIF (N'&FROM EQ 0).ERR2B * Must have 01170000
AIF (N'&FROM EQ 1).ERR2C * exactly two 01180000
AIF (N'&FROM GT 2).ERR2D * sub-operands 01190000
.NOERR2D ANOP , * 01200000
&_FROM1 SETC '&FROM(1)' * Extract field designation 01210000
&_FROM2 SETC '&FROM(2)' * and field length 01220000
AIF (K'&_FROM1 EQ 0).ERR2B * 01230000
AIF (K'&_FROM2 EQ 0).ERR2C * 01240000
AGO .NOERR2 * 01250000
.ERR2A MNOTE 8,'Missing second operand - source of copy' 01260000
MEXIT , * 01270000
.ERR2B MNOTE 8,'Source in parentheses: missing field name' 01280000
MEXIT , * 01290000
.ERR2C MNOTE 8,'Source in parentheses: missing length' 01300000
MEXIT , * 01310000
.ERR2D MNOTE 4,'Source in parentheses: too many subparameters' 01320000
AGO .NOERR2D * 01330000
.NOERR2 ANOP , * 01340000
.* 01350000
.* Check the WARN parameter 01360000
AIF (K'&WARN EQ 0).NOERR3 * 01370000
AIF ('&WARN' EQ 'NOWARN').NOERR3 01380000
.ERR3A MNOTE 4,'If specified, third parameter must be ''NOWARN''' 01390000
.NOERR3 ANOP , * 01400000
.* 01410000
.* Check nr of parameters 01420000
AIF (N'&SYSLIST LE 3).NOERR4 01430000
.ERR4A MNOTE 4,'More than 3 parameters: remainder ignored' 01440000
.NOERR4 ANOP , * 01450000
.* 01460000
.* Determine type of the TO field 01470000
AIF ('&_TO1'(1,1) EQ '(').TO_PTR * Destination is pointered? 01480000
CHKLIT &_TO1,ALT=YES * A literal nr was specified? 01490000
AIF (&BXA_RC LT 8).ERR5A * Valid literal: won't do! 01500000
&I SETA ('&_TO1' FIND '+-*/(=),''') * Check for invalid chars 01510000
AIF (&I NE 0).ERR5B * Invalid field name 01520000
&TO_TP SETC T'&_TO1 * Extract field type 01530000
&I SETA ('&TO_TP' FIND 'ABCDEFGHKLPQRSVXYZ') 01540000
AIF (&I EQ 1).NOERR5 * Valid field type 01550000
CHKREG &_TO1 * Valid register type? 01560000
AIF (&BXA_RC NE 0).ERR5C * Invalid field type 01570000
&TO_REG SETA &BXA_NUMVAL * Save register number 01580000
AGO .NOERR5 * 01590000
.TO_PTR ANOP , * 01600000
&TO_TP SETC 'p' * Field type is pointer 01610000
&_TO1 SETC '&TO(1,1)' * Extract register designation 01620000
CHKREG &_TO1,g * Must be a gpr! 01630000
AIF (&BXA_RC GT 4).ERR5D * Not a valid pointer register 01640000
AGO .NOERR5 * 01650000
.ERR5A MNOTE 8,'Literal number cannot serve as destination' 01660000
MEXIT , * 01670000
.ERR5B MNOTE 8,'Destination field not a valid field name' 01680000
MEXIT , * 01690000
.ERR5C MNOTE 8,'&TO_TP is an invalid destination field type' 01700000
MEXIT , * 01710000
.ERR5D MNOTE 8,'&_TO1 is an invalid destination pointer register' 01720000
MEXIT , * 01730000
.NOERR5 ANOP , * 01740000
.* 01750000
.* Determine type of the FROM field 01760000
AIF ('&_FROM1'(1,1) EQ '(').FROM_PTR * Source is pointered? 01770000
AIF ('&FROM' EQ '*STACK').NOERR6 01780000
CHKLIT &_FROM1,ALT=YES * A literal nr was specified? 01790000
AIF (&BXA_RC LT 8).ERR6A * Valid literal nr: ok 01800000
AIF ('&_FROM1'(1,1) EQ '=').FROMLIT * A literal was spec'd 01810000
&I SETA ('&_FROM1' FIND '+-*/(=),''') * Check for invalid chars 01820000
AIF (&I EQ 0).FROMFLD * Valid field name 01830000
AIF (K'&_FROM1 LT 3).FROMTP0 * Cannot be a length reference 01840000
AIF ('&_FROM1'(1,2) NE 'L''').FROMTP0 * Is not a length ref. 01850000
&LENC SETC '&_FROM1'(3,*) * Length of what? 01860000
&BXA_NUMVAL SETA L'&LENC * Retrieve length 01870000
AIF (&BXA_NUMVAL NE 0).ERR6A * Ok: treat as literal number 01880000
AGO .ERR6B * Cannot evaluate 01890000
.FROMTP0 ANOP , * Source should evaluate to a nr 01900000
&BXA_NUMVAL SETA &_FROM1 * A valid literal number? 01910000
AIF (&I NE 0).ERR6A * Ok: treat as a literal number 01920000
AGO .ERR6B * Error: cannot evaluate 01930000
.FROMFLD ANOP , * Source is a valid field name 01940000
&FROM_TP SETC T'&_FROM1 * Extract field type 01950000
&I SETA ('&FROM_TP' FIND 'ABCDEFGHKLPQRSVXYZ') 01960000
AIF (&I EQ 1).NOERR6 * Valid field type 01970000
AIF ('&FROM_TP' NE '0').FROMREG * This an equated literal? 01980000
&EQULIT SETB 1 * Yes: indicate equated literal 01990000
&FROM_VAL SETA L'&_FROM1 * Determine value of literal 02000000
AGO .NOERR6 * 02010000
.FROMREG ANOP , * Must be a valid register 02020000
CHKREG &_FROM1 * Valid register type? 02030000
AIF (&BXA_RC NE 0).ERR6C * Invalid field type 02040000
&FROM_REG SETA &BXA_NUMVAL * Save register number 02050000
AGO .NOERR6 * 02060000
.FROMLIT ANOP , * A literal was specified as src 02070000
AIF (K'&_FROM1 LT 5).ERR6D * Not a decent literal 02080000
&I SETA 2 * First position to check 02090000
&J SETA ('(0123456789' FIND '&_FROM1'(&I,1)) * Check dup.factor 02100000
AIF (&J EQ 0).FRLIT4 * No dup factor! 02110000
AIF (&J EQ 1).FRLIT1 * Dup factor in parentheses! 02120000
.FRLIT0 ANOP , * Loop to find end of dup.nr 02130000
&I SETA &I+1 * Point next char in &_FROM1 02140000
AIF (&I GT K'&_FROM1).ERR6D * No type designation found 02150000
&J SETA ('&_FROM1'(&I,1) FIND '0123456789') 02160000
AIF (&J EQ 0).FRLIT4 * &I now points past dup.factor 02170000
AGO .FRLIT0 * 02180000
.FRLIT1 ANOP , * &J contains nr of ( to match 02190000
&I SETA &I+1 * Point next char in &_FROM1 02200000
AIF (&I GT K'&_FROM1).ERR6D * No type designation found 02210000
AIF ('&_FROM1'(&I,1) EQ '(').FRLIT2 02220000
AIF ('&_FROM1'(&I,1) EQ ')').FRLIT3 02230000
AGO .FRLIT1 * 02240000
.FRLIT2 ANOP , * Another ( found 02250000
&J SETA &J+1 * Count unmatched parenthesis 02260000
AGO .FRLIT1 * and continue search for ) 02270000
.FRLIT3 ANOP , * An ending parenthesis found 02280000
&J SETA &J-1 * Reduce count of unmatched ( 02290000
AIF (&J GT 0).FRLIT1 * Search for more ) characters 02300000
&I SETA &I+1 * Point past dup-factor 02310000
.FRLIT4 ANOP , * &I now points past dup.factor 02320000
AIF (&I GT K'&_FROM1).ERR6D * No type designation found 02330000
&FROM_TP SETC '&_FROM1'(&I,1) * Extract type of literal 02340000
AIF (&I+3 GT K'&_FROM1).ERR6D * No valid value! 02350000
&I SETA &I+1 * Point next char 02360000
AIF ('&_FROM1'(&I,1) NE 'L').FRLIT10 * No length modifier 02370000
&LEN SETA &I+1 * Point to start of length value 02380000
AIF ('&_FROM1'(&I,1) EQ '''').FRLIT10 * No length modifier 02390000
AIF ('&_FROM1'(&I,1) EQ '.').ERR6E * Length is in bits 02400000
AIF ('&_FROM1'(&I,1) EQ '(').FRLIT6 * Length in () 02410000
.FRLIT5 ANOP , * Loop to find end of length 02420000
&I SETA &I+1 * Point next char in &_FROM1 02430000
AIF (&I GT K'&_FROM1).ERR6D * No type designation found 02440000
&J SETA ('&_FROM1'(&I,1) FIND '0123456789') 02450000
AIF (&J EQ 0).FRLIT9 * &I now points past length 02460000
AGO .FRLIT5 * 02470000
.FRLIT6 ANOP , * Lenth in parentheses 02480000
&J SETA 0 * &J contains nr of ( to match 02490000
&I SETA &I+1 * Point next char in &_FROM1 02500000
AIF (&I GT K'&_FROM1).ERR6D * No type designation found 02510000
AIF ('&_FROM1'(&I,1) EQ '(').FRLIT7 02520000
AIF ('&_FROM1'(&I,1) EQ ')').FRLIT8 02530000
AGO .FRLIT6 * 02540000
.FRLIT7 ANOP , * Another ( found 02550000
&J SETA &J+1 * Count unmatched parenthesis 02560000
AGO .FRLIT6 * and continue search for ) 02570000
.FRLIT8 ANOP , * An ending parenthesis found 02580000
&J SETA &J-1 * Reduce count of unmatched ( 02590000
AIF (&J GT 0).FRLIT6 * Search for more ) characters 02600000
&I SETA &I+1 * Point past length value 02610000
.FRLIT9 ANOP , * &I now points past length mod. 02620000
&J SETA &I-&LEN * Nr of chars in length value 02630000
&LENC SETC '&_FROM1'(&LEN,&J) * Extract length value string 02640000
&LEN SETA &LENC * Determine length value 02650000
AIF (&LEN EQ 0).ERR6F * Cannot evaluate length 02660000
&FROM_LEN SETA &LEN * 02670000
.FRLIT10 ANOP , * 02680000
AIF ('&FROM_TP' EQ 'A').FRLITA 02690000
AIF ('&FROM_TP' EQ 'B').NOERR6 02700000
AIF ('&FROM_TP' EQ 'C').FRLITC 02710000
AIF ('&FROM_TP' EQ 'D').FRLITD 02720000
AIF ('&FROM_TP' EQ 'E').FRLITE 02730000
AIF ('&FROM_TP' EQ 'F').FRLITF 02740000
AIF ('&FROM_TP' EQ 'H').FRLITH 02750000
AIF ('&FROM_TP' EQ 'L').FRLITL 02760000
AIF ('&FROM_TP' EQ 'P').NOERR6 02770000
AIF ('&FROM_TP' EQ 'Q').FRLITA 02780000
AIF ('&FROM_TP' EQ 'S').FRLITY 02790000
AIF ('&FROM_TP' EQ 'V').FRLITA 02800000
AIF ('&FROM_TP' EQ 'X').NOERR6 02810000
AIF ('&FROM_TP' EQ 'Y').FRLITY 02820000
AIF ('&FROM_TP' EQ 'Z').NOERR6 02830000
AGO .ERR6E * Unsupported type designation 02840000
.FRLITA ANOP , * A-type literal specified 02850000
AIF (K'&LENC NE 0).FRLITA0 * Length was specified? 02860000
&FROM_LEN SETA 4 * No: use default 02870000
.FRLITA0 ANOP , * Length of literal now known 02880000
&I SETA &FROM_LEN/4 * Nr of whole words 02890000
&I SETA &FROM_LEN-(&I*4) * Nr of additional bytes 02900000
AIF (&I EQ 0).NOERR6 * Ok: aligned 02910000
&FROM_TP SETC 'R' * Indicate unaligned address 02920000
AGO .NOERR6 * 02930000
.FRLITC ANOP , * C-type literal specified 02940000
AIF (K'&LENC NE 0).NOERR6 * Length was specified! 02950000
&LENC SETC '&_FROM1'(&I,*) * I still points past length mod 02960000
AIF (K'&LENC LT 3).ERR6D * Not a valid text literal 02970000
AIF ('&LENC'(1,1) NE '''').ERR6D * Must start with a quote.. 02980000
AIF ('&LENC'(K'&LENC,1) NE '''').ERR6D * And end with one! 02990000
&LENC SETC '&LENC'(2,K'&LENC-2) * Extract string value 03000000
.FRLITC0 ANOP , * Loop to remove double quotes 03010000
&I SETA ('&LENC' INDEX '''''') * Search for double quote 03020000
AIF (&I EQ 0).FRLITC3 * Not found: quit loop 03030000
AIF (&I EQ 1).FRLITC1 * Remove leading quotes 03040000
AIF (&I EQ K'&LENC-2).FRLITC2 * Remove trailing quotes 03050000
&LENC SETC '&LENC'(1,&I-1).'"'.'&LENC'(&I+2,*) 03060000
AGO .FRLITC0 * Check for more quotes 03070000
.FRLITC1 ANOP , * Remove leading double quotes 03080000
&LENC SETC '"'.'&LENC'(3,*) * 03090000
AGO .FRLITC0 * Check for more quotes 03100000
.FRLITC2 ANOP , * Remove leading double quotes 03110000
&LENC SETC '&LENC'(1,&I-1).'"' * 03120000
AGO .FRLITC0 * Check for more quotes 03130000
.FRLITC3 ANOP , * All double quotes replaced 03140000
&FROM_LEN SETA K'&LENC * Nr of characters in string 03150000
AGO .NOERR6 * 03160000
.FRLITD ANOP , * Floating point literal 03170000
AIF (K'&LENC NE 0).FRLITD0 * Length was specified? 03180000
&FROM_LEN SETA 8 * No: use default 03190000
.FRLITD0 ANOP , * Length of literal now known 03200000
&I SETA &FROM_LEN/8 * Nr of double words 03210000
&I SETA &FROM_LEN-(&I*8) * Nr of additional bytes 03220000
AIF (&I EQ 0).NOERR6 * Ok: aligned 03230000
&FROM_TP SETC 'K' * Indicate unaligned float 03240000
AGO .NOERR6 * 03250000
.FRLITE ANOP , * Floating point literal 03260000
AIF (K'&LENC NE 0).FRLITE0 * Length was specified? 03270000
&FROM_LEN SETA 4 * No: use default 03280000
.FRLITE0 ANOP , * Length of literal now known 03290000
&I SETA &FROM_LEN/4 * Nr of whole words 03300000
&I SETA &FROM_LEN-(&I*4) * Nr of additional bytes 03310000
AIF (&I EQ 0).NOERR6 * Ok: aligned 03320000
&FROM_TP SETC 'K' * Indicate unaligned float 03330000
AGO .NOERR6 * 03340000
.FRLITF ANOP , * Fixed point literal 03350000
AIF (K'&LENC NE 0).FRLITF0 * Length was specified? 03360000
&FROM_LEN SETA 4 * No: use default 03370000
.FRLITF0 ANOP , * Length of literal now known 03380000
&I SETA &FROM_LEN/4 * Nr of whole words 03390000
&I SETA &FROM_LEN-(&I*4) * Nr of additional bytes 03400000
AIF (&I EQ 0).NOERR6 * Ok: aligned 03410000
&FROM_TP SETC 'G' * Indicate unaligned fixed 03420000
AGO .NOERR6 * 03430000
.FRLITH ANOP , * Fixed point literal 03440000
AIF (K'&LENC NE 0).FRLITH0 * Length was specified? 03450000
&FROM_LEN SETA 2 * No: use default 03460000
.FRLITH0 ANOP , * Length of literal now known 03470000
&I SETA &FROM_LEN/2 * Nr of half words 03480000
&I SETA &FROM_LEN-(&I*2) * Nr of additional bytes 03490000
AIF (&I EQ 0).NOERR6 * Ok: aligned 03500000
&FROM_TP SETC 'G' * Indicate unaligned fixed 03510000
AGO .NOERR6 * 03520000
.FRLITL ANOP , * Floating point literal 03530000
AIF (K'&LENC NE 0).FRLITL0 * Length was specified? 03540000
&FROM_LEN SETA 8 * No: use default 03550000
.FRLITL0 ANOP , * Length of literal now known 03560000
&I SETA &FROM_LEN/8 * Nr of double words 03570000
&I SETA &FROM_LEN-(&I*8) * Nr of additional bytes 03580000
AIF (&I EQ 0).NOERR6 * Ok: aligned 03590000
&FROM_TP SETC 'K' * Indicate unaligned float 03600000
AGO .NOERR6 * 03610000
.FRLITY ANOP , * Address literal 03620000
AIF (K'&LENC NE 0).FRLITY0 * Length was specified? 03630000
&FROM_LEN SETA 2 * No: use default 03640000
.FRLITY0 ANOP , * Length of literal now known 03650000
&I SETA &FROM_LEN/2 * Nr of half words 03660000
&I SETA &FROM_LEN-(&I*2) * Nr of additional bytes 03670000
AIF (&I EQ 0).NOERR6 * Ok: aligned 03680000
&FROM_TP SETC 'R' * Indicate unaligned address 03690000
AGO .NOERR6 * 03700000
.FROM_PTR ANOP , * 03710000
&FROM_TP SETC 'p' * Field type is pointer 03720000
&_FROM1 SETC '&FROM(1,1)' * Extract register designation 03730000
CHKREG &_FROM1,g * Must be a gpr! 03740000
AIF (&BXA_RC GT 4).ERR6G * Not a valid pointer register 03750000
AGO .NOERR6 * 03760000
.ERR6A ANOP , * Source is a literal 03770000
&FROM_TP SETC '0' * Set source type 03780000
&FROM_VAL SETA &BXA_NUMVAL * Save value to be copied 03790000
AIF (&FROM_VAL GE 0).ERR6A_ * Negative number? 03800000
&SIGN SETC '-' * Indicate sign 03810000
.ERR6A_ ANOP , * 03820000
AIF (K'&_FROM2 EQ 0).NOERR6 * Explicit length specified? 03830000
MNOTE 4,'Explicit length not allowed for literal value: ignore*03840000
d' * 03850000
&_FROM2 SETC '' * Wipe length indication 03860000
AGO .NOERR6 * 03870000
.ERR6B MNOTE 8,'Source field not a valid field name' 03880000
MEXIT , * 03890000
.ERR6C ANOP , * 03900000
CHKLIT &_FROM1,ALT=YES,MSG=YES * Just to issue a message 03910000
MNOTE 8,'&FROM_TP is an invalid source field type' 03920000
MEXIT , * 03930000
.ERR6D MNOTE 8,'Source field is not a valid literal' 03940000
MEXIT , * 03950000
.ERR6E MNOTE 8,'Source field is an unsupported literal' 03960000
MEXIT , * 03970000
.ERR6F ANOP , * 03980000
&LENC SETC (DOUBLE '&LENC') * 03990000
MNOTE 8,'Cannot evaluate length modifier: &LENC' 04000000
MEXIT , * 04010000
.ERR6G MNOTE 8,'&_FROM1 is an invalid source pointer register' 04020000
MEXIT , * 04030000
.NOERR6 ANOP , * 04040000
.* 04050000
.* Determine length of TO field 04060000
&I SETA ('acfg' FIND '&TO_TP') * Register type? 04070000
AIF (&I NE 0).TOLENR * Yes: it is some register type 04080000
AIF (K'&_TO2 NE 0).TOLENX * Should be a valid expression 04090000
&LEN SETA L'&_TO1 * No reg & not spec'd: extract 04100000
AGO .TOLENOK * Length has now been set 04110000
.TOLENR ANOP , * Handle register types 04120000
&LENC SETC '4484'(&I,1) * Determine size of 1 register 04130000
&LEN SETA &LENC * and make it numeric 04140000
&LENC SETC '16160416'(2*&I-1,2) * Determine nr of registers 04150000
®_CT SETA &LENC * and make it numeric 04160000
AIF (K'&_TO2 EQ 0).TOLENOK * Reg & not spec'd: ok 04170000
CHKREG &_TO2 * Check: register or number? 04180000
AIF (&BXA_RC NE 0).TOLENRL * Must be a literal number 04190000
&TO_EREG SETB 1 * Indicate end register spec'd 04200000
AIF ('&TO_TP' NE T'&_TO2).TOLENR0 04210000
AIF ('&TO_TP' EQ 'f').TOLENF * Go handle ending FP-register 04220000
AGO .TOLENR1 * Go calculate total length 04230000
.TOLENR0 ANOP , * Different register types 04240000
AIF ('&TO_TP' NE 'g').ERR7A4 * Only allowed combination is 04250000
AIF (T'&_TO2 NE 'a').ERR7A4 * gpr with ar 04260000
&TO_TP SETC 'ga' * Indicate combined type 04270000
.TOLENR1 ANOP , * End-register is valid 04280000
&BXA_NUMVAL SETA 1+&BXA_NUMVAL-&TO_REG * Determine nr of registers 04290000
AIF (&BXA_NUMVAL GT 0).TOLENR2 * Wrap around? 04300000
&BXA_NUMVAL SETA ®_CT+&BXA_NUMVAL * Adjust for wrap 04310000
.TOLENR2 ANOP , * BXA_NUMVAL now nr of registers 04320000
&LEN SETA &LEN*&BXA_NUMVAL * Length for all registers 04330000
AGO .TOLENOK * 04340000
.TOLENF ANOP , * Determine lenth from end-FPR 04350000
&BXA_NUMVAL SETA 2+&BXA_NUMVAL-&TO_REG * Determine nr of HALF registers 04360000
AIF (&BXA_NUMVAL GT 0).TOLENF1 * Wrap around? 04370000
&BXA_NUMVAL SETA 2*®_CT+&BXA_NUMVAL * Adjust for wrap 04380000
.TOLENF1 ANOP , * 04390000
&LEN SETA &LEN*&BXA_NUMVAL/2 * Length for all registers 04400000
AGO .TOLENOK * 04410000
.TOLENRL ANOP , * &_TO2 is the nr of regs 04420000
&I SETA &_TO2 * Make nr of regs numeric 04430000
AIF (&I GT 16).ERR7A1 * Too many registers 04440000
AIF ('&TO_TP' EQ 'f' AND &I GT 4).ERR7A1 * Too many regs 04450000
&LEN SETA (&I*&LEN) * Determine total length 04460000
AGO .TOLENOK * Length has now been set 04470000
.TOLENX ANOP , * Check length expression 04480000
AIF ('&_TO2'(1,1) EQ '(').TOLENPT * To length is a (reg)? 04490000
&LEN SETA &_TO2 * Determine numeric value 04500000
AGO .TOLENOK * Length has now been set 04510000
.TOLENPT ANOP , * Check length as a (ptr) 04520000
AIF ('&TO_TP' NE 'p').ERR7A5 * TO1 must be a pointered field 04530000
&_TO2 SETC '&TO(2,1)' * Extract register designation 04540000
CHKREG &_TO2,g * Must be a valid gpr 04550000
AIF (&BXA_RC GT 4).ERR7A6 * Error! 04560000
&LEN SETA 0 * Indicate register used 04570000
&TO_LEN SETA 0 * Indicate register used 04580000
AGO .TOLENOQ * 04590000
.TOLENOK ANOP , * 04600000
AIF (&LEN LE 0).ERR7A2 * Invalid length 04610000
&TO_LEN SETA &LEN * Copy determined length 04620000
.TOLENOQ ANOP , * 04630000
.* 04640000
.* Determine length of FROM field 04650000
AIF (&FROM_LEN NE 0).GO * Length of literal is known 04660000
AIF ('&FROM' EQ '*STACK').GO * Length not relevant 04670000
AIF ('&FROM_TP' EQ '0').FRLEN0 * Literal value? 04680000
&I SETA ('acfg' FIND '&FROM_TP') * Register type? 04690000
AIF (&I NE 0).FRLENR * Yes: it is some register type 04700000
AIF (K'&_FROM2 NE 0).FRLENX * Field & len spec'd: ok 04710000
&LEN SETA L'&_FROM1 * Field & not spec'd: extract 04720000
AGO .FRLENOK * Length has now been set 04730000
.FRLENR ANOP , * Handle register types 04740000
&LENC SETC '4484'(&I,1) * Determine size of 1 register 04750000
&LEN SETA &LENC * and make it numeric 04760000
&LENC SETC '16160416'(2*&I-1,2) * Determine nr of registers 04770000
®_CT SETA &LENC * and make it numeric 04780000
AIF (K'&_FROM2 EQ 0).FRLENOK * Reg & not spec'd: ok 04790000
CHKREG &_FROM2 * Check: register or number? 04800000
AIF (&BXA_RC NE 0).FRLENRL * Must be a literal number 04810000
&FROM_EREG SETB 1 * Indicate end reg specified 04820000
AIF ('&FROM_TP' NE T'&_FROM2).FRLENR0 04830000
AIF ('&FROM_TP' EQ 'f').FRLENF * Go handle end FP-register 04840000
AGO .FRLENR1 * Go calculate total length 04850000
.FRLENR0 ANOP , * Different register types 04860000
AIF ('&FROM_TP' NE 'g').ERR7A4 * Only allowed combination is 04870000
AIF (T'&_FROM2 NE 'a').ERR7A4 * gpr with ar 04880000
&FROM_TP SETC 'ga' * Indicate combined type 04890000
.FRLENR1 ANOP , * End-register is valid 04900000
&BXA_NUMVAL SETA 1+&BXA_NUMVAL-&FROM_REG * Determine nr of registers 04910000
AIF (&BXA_NUMVAL GT 0).FRLENR2 * Wrap around? 04920000
&BXA_NUMVAL SETA ®_CT+&BXA_NUMVAL * Adjust for wrap 04930000
.FRLENR2 ANOP , * BXA_NUMVAL now nr of registers 04940000
&LEN SETA &LEN*&BXA_NUMVAL * Length for all registers 04950000
AGO .FRLENOK * 04960000
.FRLENF ANOP , * Determine lenth from end-FPR 04970000
&BXA_NUMVAL SETA 2+&BXA_NUMVAL-&FROM_REG * Determine nr of HALF regs 04980000
AIF (&BXA_NUMVAL GT 0).FRLENF1 * Wrap around? 04990000
&BXA_NUMVAL SETA 2*®_CT+&BXA_NUMVAL * Adjust for wrap 05000000
.FRLENF1 ANOP , * BXA_NUMVAL now nr of half regs 05010000
&LEN SETA &LEN*&BXA_NUMVAL/2 * Length for all registers 05020000
AGO .FRLENOK * 05030000
.FRLENRL ANOP , * &_FROM2 is the nr of regs 05040000
&I SETA &_FROM2 * Make nr of regs numeric 05050000
AIF (&I GT 16).ERR7A1 * Too many registers 05060000
AIF ('&FROM_TP' EQ 'f' AND &I GT 4).ERR7A1 * Too many regs 05070000
&LEN SETA (&I*&LEN) * Determine total length 05080000
AGO .FRLENOK * Length has now been set 05090000
.FRLEN0 ANOP , * Determine literal length 05100000
AIF ('&TO_TP' EQ 'B' OR '&TO_TP' EQ 'X').FRLEN0U * Unsigned? 05110000
AIF (&FROM_VAL LT 0).FRLEN0N * Handle negative numbers 05120000
&LEN SETA 1 * Assume 1 byte 05130000
AIF (&FROM_VAL LT 128).FRLENOK * Will fit in 1 byte 05140000
&LEN SETA 2 * Assume 2 bytes 05150000
AIF (&FROM_VAL LT 32768).FRLENOK * Will fit in 2 bytes 05160000
&LEN SETA 3 * Assume 3 bytes 05170000
AIF (&FROM_VAL LT 8388608).FRLENOK * Will fit in 3 bytes 05180000
&LEN SETA 4 * Must fit in 4 bytes 05190000
AGO .FRLENOK * 05200000
.FRLEN0N ANOP , * Determine len of negative nr 05210000
&LEN SETA 1 * Assume 1 byte 05220000
AIF (&FROM_VAL GE -128).FRLENOK * Will fit in 1 byte 05230000
&LEN SETA 2 * Assume 2 bytes 05240000
AIF (&FROM_VAL GE -32768).FRLENOK * Will fit in 2 bytes 05250000
&LEN SETA 3 * Assume 3 bytes 05260000
AIF (&FROM_VAL GE -8388608).FRLENOK * Will fit in 3 bytes 05270000
&LEN SETA 4 * Must fit in 4 bytes 05280000
AGO .FRLENOK * 05290000
.FRLEN0U ANOP , * Determine len of unsigned nr 05300000
&LEN SETA 1 * Assume 1 byte 05310000
AIF (&FROM_VAL LT 256).FRLENOK * Will fit in 1 byte 05320000
&LEN SETA 2 * Assume 2 bytes 05330000
AIF (&FROM_VAL LT 65536).FRLENOK * Will fit in 2 bytes 05340000
&LEN SETA 3 * Assume 3 bytes 05350000
AIF (&FROM_VAL LT 16777216).FRLENOK * Will fit in 3 bytes 05360000
&LEN SETA 4 * Must fit in 4 bytes 05370000
AGO .FRLENOK * 05380000
.FRLENX ANOP , * Evaluate length expression 05390000
AIF ('&_FROM2'(1,1) EQ '(').FRLENPT * To length is a (reg)? 05400000
&LEN SETA &_FROM2 * Determine numeric value 05410000
AGO .FRLENOK * 05420000
.FRLENPT ANOP , * Check length as a (ptr) 05430000
AIF ('&FROM_TP' NE 'p').ERR7A7 * FROM1 must be pointered 05440000
&_FROM2 SETC '&FROM(2,1)' * Extract register designation 05450000
CHKREG &_FROM2,g * Must be a valid gpr 05460000
AIF (&BXA_RC GT 4).ERR7A8 * Error! 05470000
&LEN SETA 0 * Indicate register used 05480000
&FROM_LEN SETA 0 * Indicate register used 05490000
AGO .FRLENOQ * 05500000
.FRLENOK ANOP , * 05510000
AIF (&LEN LE 0).ERR7A3 * Invalid length 05520000
&FROM_LEN SETA &LEN * Copy determined length 05530000
.FRLENOQ ANOP , * 05540000
.* 05550000
.* Copy to self not useful 05560000
AIF ('&_TO1' EQ '&_FROM1').ERR7 * Operands equal? 05570000
&I SETA ('acfg' FIND '&TO_TP') * Register type? 05580000
AIF (&I EQ 0).GO * Not a register: ok 05590000
AIF ('&FROM_TP' NE '&TO_TP').GO * Different types: ok 05600000
AIF (&FROM_REG NE &TO_REG).GO * Not same register nr: ok 05610000
.ERR7 ANOP , * Copy to self detected 05620000
AIF ('&WARN' EQ 'NOWARN').NOERR7 * Suppress message 05630000
MNOTE 4,'Copy to self not useful: ignored' 05640000
.NOERR7 ANOP , * 05650000
&_LABEL LABEL , * 05660000
MEXIT , * 05670000
.* 05680000
.* Select code generation logic by from type field 05690000
.GO ANOP , 05700000
AIF ('&FROM_TP' EQ 'A').GENA 05710000
AIF ('&FROM_TP' EQ 'B').GENB 05720000
AIF ('&FROM_TP' EQ 'C').GENC 05730000
AIF ('&FROM_TP' EQ 'D').GEND 05740000
AIF ('&FROM_TP' EQ 'E').GENE 05750000
AIF ('&FROM_TP' EQ 'F').GENF 05760000
AIF ('&FROM_TP' EQ 'G').GENG 05770000
AIF ('&FROM_TP' EQ 'H').GENH 05780000
AIF ('&FROM_TP' EQ 'K').GENK 05790000
AIF ('&FROM_TP' EQ 'L').GENL 05800000
AIF ('&FROM_TP' EQ 'P').GENP 05810000
AIF ('&FROM_TP' EQ 'Q').GENQ 05820000
AIF ('&FROM_TP' EQ 'R').GENR 05830000
AIF ('&FROM_TP' EQ 'S').GENS 05840000
AIF ('&FROM_TP' EQ 'V').GENV 05850000
AIF ('&FROM_TP' EQ 'X').GENX 05860000
AIF ('&FROM_TP' EQ 'Y').GENY 05870000
AIF ('&FROM_TP' EQ 'Z').GENZ 05880000
AIF ('&FROM_TP' EQ '0').GEN0 05890000
AIF ('&FROM_TP' EQ 'a').GEN_A 05900000
AIF ('&FROM_TP' EQ 'c').GEN_C 05910000
AIF ('&FROM_TP' EQ 'f').GEN_F 05920000
AIF ('&FROM_TP' EQ 'g').GEN_G 05930000
AIF ('&FROM_TP' EQ 'ga').GEN_GA_ 05940000
AIF ('&FROM' EQ '*STACK').GENSTACK 05950000
AIF ('&FROM_TP' EQ 'p').GEN_P 05960000
MNOTE 12,'Internal error: FROM type &FROM_TP not supported' 05970000
MEXIT , * 05980000
.* 05990000
.* Error messages for generation sections below 06000000
.ERR7A1 MNOTE 8,'Number of registers specified exceeds whole set' 06010000
MEXIT , * 06020000
.ERR7A2 MNOTE 8,'Invalid destination length specified: 0 or negative' 06030000
MEXIT , * 06040000
.ERR7A3 MNOTE 8,'Invalid source length specified: 0 or negative' 06050000
MEXIT , * 06060000
.ERR7A4 MNOTE 8,'Start and end registers have different types' 06070000
MEXIT , * 06080000
.ERR7A5 MNOTE 8,'Destination length in register valid only if destinat*06090000
ion is in register too' 06100000
MEXIT , * 06110000
.ERR7A6 MNOTE 8,'&_TO2 is not a valid length register' 06120000
MEXIT , * 06130000
.ERR7A7 MNOTE 8,'Source length in register valid only if source is in *06140000
register too' 06150000
MEXIT , * 06160000
.ERR7A8 MNOTE 8,'&_FROM2 is not a valid length register' 06170000
MEXIT , * 06180000
.ERR7B MNOTE 8,'Cannot copy from ''&FROM_TP'' to ''&TO_TP'' type of f*06190000
ields' * 06200000
MEXIT , * 06210000
.ERR7C MNOTE 8,'Lengths - implied or specified - do not match' 06220000
MEXIT , * 06230000
.ERR7D MNOTE 8,'Length of destination field exceeds 256' 06240000
MEXIT , * 06250000
.ERR7E MNOTE 8,'Length of source field exceeds 256' 06260000
MEXIT , * 06270000
.ERR7F MNOTE 8,'No register pair available for long move' 06280000
MEXIT , * 06290000
.ERR7G MNOTE 8,'Field is too large to pack' 06300000
MEXIT , * 06310000
.ERR7H MNOTE 8,'No register available to extend sign' 06320000
MEXIT , * 06330000
.ERR7I MNOTE 8,'Destination field is too short' 06340000
MEXIT , * 06350000
.ERR7J MNOTE 8,'Cannot load more than 1 FP register from unaligned fi*06360000
eld' * 06370000
MEXIT , * 06380000
.ERR7K MNOTE 8,'Cannot load an FP register from field with length &FR*06390000
OM_LEN' * 06400000
MEXIT , * 06410000
.ERR7L MNOTE 8,'Cannot copy extended floating point field of less tha*06420000
n 6 bytes' * 06430000
MEXIT , * 06440000
.ERR7M MNOTE 8,'Register &_TO1 does not designate a pair of FP regist*06450000
ers' * 06460000
MEXIT , * 06470000
.ERR7N MNOTE 8,'Packed field is too large to unpack' 06480000
MEXIT , * 06490000
.ERR7O MNOTE 8,'Too many digits in result: cannot unpack' 06500000
MEXIT , * 06510000
.ERR7P MNOTE 8,'&_FROM1 must be 8 bytes long to copy to &_TO1' 06520000
MEXIT , * 06530000
.ERR7Q MNOTE 8,'Cannot load more than 1 register at a time from an S-*06540000
type constant' 06550000
MEXIT , * 06560000
.ERR7R MNOTE 8,'S-type constant must be two bytes long to load a regi*06570000
ster with it' * 06580000
MEXIT , * 06590000
.ERR7S MNOTE 8,'No work register available' 06600000
MEXIT , * 06610000
.ERR7T MNOTE 8,'Cannot load an access register with a literal other t*06620000
han 0, 1, or 2' * 06630000
MEXIT , * 06640000
.ERR7U MNOTE 8,'Cannot copy a negative value into an unsigned field' 06650000
MEXIT , * 06660000
.ERR7V MNOTE 8,'Register &_FROM1 does not designate a pair of FP regi*06670000
sters' * 06680000
MEXIT , * 06690000
.ERR7W MNOTE 8,'Cannot copy more than 1 value to an explicit-length f*06700000
loating point field' * 06710000
MEXIT , * 06720000
.ERR7X MNOTE 8,'Cannot extend negative literal to &TO_LEN bytes' 06730000
MEXIT , * 06740000
.* 06750000
.* From type A: 4-byte address field 06760000
.GENA ANOP , * 06770000
AIF ('&TO_TP' EQ 'A').GENMVC0 * CPY address to address 06780000
AIF ('&TO_TP' EQ 'R').GENMVC0 * CPY address to address 06790000
AIF ('&TO_TP' EQ 'V').GENMVC0 * CPY address to address 06800000
AIF ('&TO_TP' EQ 'Y').GENMVC0 * CPY address to address 06810000
AIF ('&TO_TP' EQ 'g').GENA_G * CPY address to gpr 06820000
AGO .ERR7B * Unsupported combination 06830000
.* 06840000
.* Copy fullword address field to general purpose register(s) 06850000
.GENA_G ANOP , * 06860000
AIF (&TO_LEN EQ 4).GENA_G0 * 1 register to load 06870000
AIF (&TO_LEN NE &FROM_LEN).ERR7C * Lengths equal? 06880000
AGO .DO_LM * Go generate multiple ICMs 06890000
.GENA_G0 ANOP , * 06900000
AIF (&FROM_LEN EQ 4).DO_L * Generate 1 L 06910000
AIF (&FROM_LEN LT 4).GENA_G1 * Clear, then ICM 06920000
&PAD_LEN SETA &FROM_LEN-4 * Nr of excess bytes 06930000
&_FROM1 SETC '&_FROM1'.'+&PAD_LEN' * Adjust source pointer 06940000
&FROM_LEN SETA 4 * Set usable source length 06950000
&I SETA &PAD_LEN/4 * Nr of words padded 06960000
&J SETA &PAD_LEN-(4*&I) * Nr of additional bytes padded 06970000
AIF (&J EQ 0).DO_L * If none: still aligned 06980000
&MASK SETC 'YYYY' * Load 4 unaligned bytes 06990000
AGO .DO_ICM * And go copy to register 07000000
.GENA_G1 ANOP , * Load from short field 07010000
&_LABEL CLEAR &_TO1 * Wipe register before use 07020000
&_LABEL SETC '' * Wipe label after use 07030000
&MASK SETC 'NNNY' * Mask for 1-byte source field 07040000
AIF (&FROM_LEN EQ 1).DO_ICM * Ok: go load register 07050000
&MASK SETC 'NNYY' * Mask for 2-byte source field 07060000
AIF (&FROM_LEN EQ 2).DO_ICM * Ok: go load register 07070000
&MASK SETC 'NYYY' * Mask for 3-byte source field 07080000
AGO .DO_ICM * Source must be 3 bytes long 07090000
.* 07100000
.* From type B: Binary data field (unsigned) 07110000
.GENB ANOP , * 07120000
AIF ('&TO_TP' EQ 'B').GENMVC0 * CPY unsigned to unsigned 07130000
AIF ('&TO_TP' EQ 'X').GENMVC0 * CPY unsigned to unsigned 07140000
AIF ('&TO_TP' EQ 'a').GENB_A * CPY unsigned to ARnn 07150000
AIF ('&TO_TP' EQ 'c').GENB_C * CPY unsigned to CRnn 07160000
AIF ('&TO_TP' EQ 'g').GENB_G * CPY unsigned to Rnn 07170000
AGO .ERR7B * Unsupported combination 07180000
.* 07190000
.* Copy unsigned binary data to access register(s) 07200000
.GENB_A ANOP , * 07210000
AIF (&TO_LEN NE &FROM_LEN).ERR7C * Lengths equal? 07220000
AGO .DO_LAM * Go generate LAM instruction 07230000
.* 07240000
.* Copy unsigned binary data to control register(s) 07250000
.GENB_C ANOP , * 07260000
AIF (&TO_LEN NE &FROM_LEN).ERR7C * Lengths equal? 07270000
AGO .DO_LCTL * Go generate LAM instruction 07280000
.* 07290000
.* Copy unsigned binary data to general purpose register(s) 07300000
.GENB_G ANOP , * 07310000
AIF (&TO_LEN EQ 4).GENB_G0 * 1 register to load 07320000
AIF (&TO_LEN NE &FROM_LEN).ERR7C * Lengths equal? 07330000
AGO .GENICMM * Go generate multiple ICMs 07340000
.GENB_G0 ANOP , * 07350000
&MASK SETC 'YYYY' * 07360000
AIF (&FROM_LEN EQ 4).DO_ICM * Generate 1 ICM 07370000
AIF (&FROM_LEN LT 4).GENB_G1 * Clear, then ICM 07380000
&PAD_LEN SETA &FROM_LEN-4 * Nr of excess bytes 07390000
&_FROM1 SETC '&_FROM1'.'+&PAD_LEN' * Adjust source pointer 07400000
&FROM_LEN SETA 4 * Set usable source length 07410000
AGO .DO_ICM * And go copy to register 07420000
.GENB_G1 ANOP , * Load from short field 07430000
&_LABEL CLEAR &_TO1 * Wipe register before use 07440000
&_LABEL SETC '' * Wipe label after use 07450000
&MASK SETC 'NNNY' * Mask for 1-byte source field 07460000
AIF (&FROM_LEN EQ 1).DO_ICM * Ok: go load register 07470000
&MASK SETC 'NNYY' * Mask for 2-byte source field 07480000
AIF (&FROM_LEN EQ 2).DO_ICM * Ok: go load register 07490000
&MASK SETC 'NYYY' * Mask for 3-byte source field 07500000
AGO .DO_ICM * Source must be 3 bytes long 07510000
.* 07520000
.* From type C: Character data field 07530000
.GENC ANOP , * 07540000
AIF ('&TO_TP' EQ 'C').GENMVCC * CPY char to char 07550000
AGO .ERR7B * Unsupported combination 07560000
.* 07570000
.* From type D: Long floating point field 07580000
.GEND ANOP , * 07590000
AIF ('&TO_TP' EQ 'D').GENKK * CPY float to float 07600000
AIF ('&TO_TP' EQ 'E').GENKK * CPY float to float 07610000
AIF ('&TO_TP' EQ 'K').GENKK * CPY float to float 07620000
AIF ('&TO_TP' EQ 'f').GEND_F * CPY float to FP register 07630000
AGO .ERR7B * Unsupported combination 07640000
.* 07650000
.* Copy a long floating point number to a register 07660000
.GEND_F ANOP , * 07670000
AIF (&TO_LEN NE &FROM_LEN).ERR7C * Lengths equal? 07680000
AIF (&TO_LEN EQ 8).DO_LD * Generate 1 LD 07690000
AGO .GENLDM * Generate several LDs 07700000
.* 07710000
.* From type E: Short floating point field 07720000
.GENE ANOP , * 07730000
AIF ('&TO_TP' EQ 'D').GENKK * CPY float to float 07740000
AIF ('&TO_TP' EQ 'E').GENKK * CPY float to float 07750000
AIF ('&TO_TP' EQ 'K').GENKK * CPY float to float 07760000
AIF ('&TO_TP' EQ 'f').GENE_F * CPY float to FP register 07770000
AGO .ERR7B * Unsupported combination 07780000
.* 07790000
.* Copy a short floating point number to a register 07800000
.GENE_F ANOP , * 07810000
AIF (&TO_LEN NE 2*&FROM_LEN).ERR7C * Lengths equal? 07820000
AIF (&TO_LEN EQ 8).DO_LE * Generate 1 LE 07830000
AGO .GENLEM * Generate several LEs 07840000
.* 07850000
.* From type F: Signed fullword 07860000
.GENF ANOP , * 07870000
AIF ('&TO_TP' EQ 'F').GENGG * CPY signed to signed 07880000
AIF ('&TO_TP' EQ 'G').GENGG * CPY signed to signed 07890000
AIF ('&TO_TP' EQ 'H').GENGG * CPY signed to signed 07900000
AIF ('&TO_TP' EQ 'g').GENF_G * CPY signed to register 07910000
AGO .ERR7B * Unsupported combination 07920000
.* 07930000
.* Copy a signed fullword to a register 07940000
.GENF_G ANOP , * 07950000
AIF (&TO_LEN LE 4).GENICM * Generate 1 ICM/L/LH 07960000
AIF (&TO_LEN NE &FROM_LEN).ERR7C * Lengths equal? 07970000
AGO .DO_LM * Generate 1 LM 07980000
.* 07990000
.* From type G: Unaligned signed 08000000
.GENG ANOP , * 08010000
AIF ('&TO_TP' EQ 'F').GENGG * CPY signed to signed 08020000
AIF ('&TO_TP' EQ 'G').GENGG * CPY signed to signed 08030000
AIF ('&TO_TP' EQ 'H').GENGG * CPY signed to signed 08040000
AIF ('&TO_TP' EQ 'g').GENG_G * CPY signed to register 08050000
AGO .ERR7B * Unsupported combination 08060000
.* 08070000
.* Copy an unaligned signed number 08080000
.GENGG ANOP , * 08090000
AIF (&TO_LEN GT 256).ERR7D * 08100000
AIF (&FROM_LEN GT 256).ERR7E * 08110000
AIF (&TO_LEN LE &FROM_LEN).GENMVC0 * Copy or truncate 08120000
AIF (&TO_LEN GT 8).GENGG20 * Cannot use registers to extend 08130000
AIF (&TO_LEN GT 4).GENGG6 * Must use pair of regs 08140000
.* Source and extended dest.value both fit in a single register 08150000
EQUREG R0=YES,TEMP=YES * Assign a register 08160000
AIF (&BXA_RC GT 0).ERR7H * No reg available! 08170000
® SETC 'R'.'&BXA_NUMVAL' * Create register name 08180000
&MASK SETC 'YNNN' * Mask for 1-byte value 08190000
&I SETA 24 * Nr of bits to shift 08200000
AIF (&FROM_LEN EQ 1).GENGG0 * Go load value 08210000
&MASK SETC 'YYNN' * Mask for 2-byte value 08220000
&I SETA 16 * Nr of bits to shift 08230000
AIF (&FROM_LEN EQ 2 AND '&FROM_TP' NE 'G').GENGG1 08240000
AIF (&FROM_LEN EQ 2).GENGG0 * Go load value 08250000
&MASK SETC 'YYYN' * Length MUST be 3 bytes! 08260000
&I SETA 8 * Nr of bits to shift 08270000
.GENGG0 ANOP , * Use ICM to load value 08280000
&_LABEL ICM ®,&MASK,&_FROM1 * Load source value 08290000
&_LABEL SETC '' * Wipe used label 08300000
SRA ®,&I * Create fullword value 08310000
AGO .GENGG2 * Go save value in dest field 08320000
.GENGG1 ANOP , * Happens to be aligned! 08330000
&_LABEL LH ®,&_FROM1 * Load source value 08340000
&_LABEL SETC '' * Wipe used label 08350000
.GENGG2 ANOP , * Value now in ® 08360000
&MASK SETC 'NNYY' * Min.dest.size is 2 bytes! 08370000
AIF (&TO_LEN EQ 2 AND '&TO_TP' NE 'G').GENGG4 08380000
AIF (&TO_LEN EQ 2).GENGG3 * Go save value 08390000
&MASK SETC 'NYYY' * Mask for 3-byte value 08400000
AIF (&TO_LEN EQ 3).GENGG3 * Go save value 08410000
&MASK SETC 'YYYY' * MUST be 4 bytes long! 08420000
AIF ('&TO_TP' EQ 'F').GENGG5 * Go save value 08430000
.GENGG3 ANOP , * Save value using STCM 08440000
STCM ®,&MASK,&_TO1 * Save extended value 08450000
MEXIT , * 08460000
.GENGG4 ANOP , * Go save value using STH 08470000
STH ®,&_TO1 * Save extended value 08480000
MEXIT , * 08490000
.GENGG5 ANOP , * Go save value using ST 08500000
ST ®,&_TO1 * Save extended value 08510000
MEXIT , * 08520000
.* Extend up to 8 bytes using a pair of registers 08530000
.GENGG6 ANOP , * 08540000
EQUREG R0=YES,TEMP=YES,PAIR=YES,WARN=NO * Assign pair of regs 08550000
AIF (&BXA_RC GT 0).GENGG20 * No pair available! 08560000
® SETC 'R'.'&BXA_NUMVAL' * Create register name 08570000
&I SETA &BXA_NUMVAL+1 * Nr of odd register 08580000
&ODDREG SETC 'R'.'&I' * Odd register name 08590000
&MASK SETC 'YNNN' * Mask for a 1-byte value 08600000
&I SETA 56 * Nr of bits to shift 08610000
AIF (&FROM_LEN EQ 1).GENGG7 * Go load 1-byte value 08620000
&MASK SETC 'YYNN' * Mask for a 1-byte value 08630000
&I SETA 48 * Nr of bits to shift 08640000
AIF (&FROM_LEN EQ 2 AND '&FROM_TP' NE 'G').GENGG8 * 08650000
AIF (&FROM_LEN EQ 2).GENGG7 * Go load 2-byte value 08660000
&MASK SETC 'YYYN' * Mask for a 3-byte value 08670000
&I SETA 40 * Nr of bits to shift 08680000
AIF (&FROM_LEN EQ 3).GENGG7 * Go load 3-byte value 08690000
&MASK SETC 'YYYY' * Mask for a 4-byte value 08700000
&I SETA 32 * Nr of bits to shift 08710000
AIF (&FROM_LEN EQ 4 AND '&FROM_TP' EQ 'F').GENGG9 * 08720000
AIF (&FROM_LEN EQ 4).GENGG7 * Go load 4-byte value 08730000
AGO .GENGG10 * Go load larger values 08740000
.GENGG7 ANOP , * ICM value up to 4 bytes with 08750000
&_LABEL ICM ®,&MASK,&_FROM1 * Load value 08760000
&_LABEL SETC '' * Remove used label 08770000
SRDA ®,&I * Create 8-byte value 08780000
AGO .GENGG14 * Go save created value 08790000
.GENGG8 ANOP , * LH value of 2 bytes 08800000
&_LABEL LH ®,&_FROM1 * Load value 08810000
&_LABEL SETC '' * Remove used label 08820000
SRDA ®,32 * Create 8-byte value 08830000
AGO .GENGG14 * Go save created value 08840000
.GENGG9 ANOP , * Load 4-byte value 08850000
&_LABEL L ®,&_FROM1 * Load value 08860000
&_LABEL SETC '' * Remove used label 08870000
SRDA ®,32 * Create 8-byte value 08880000
AGO .GENGG14 * Go save created value 08890000
.* Source for move is 5 to 7 bytes long 08900000
.GENGG10 ANOP , * 08910000
&MASK SETC 'YNNN' * Mask for a 5-byte value 08920000
&I SETA 24 * Nr of bits to shift 08930000
AIF (&FROM_LEN EQ 5).GENGG11 * Go load 5-byte value 08940000
&MASK SETC 'YYNN' * Mask for a 6-byte value 08950000
&I SETA 16 * Nr of bits to shift 08960000
AIF (&FROM_LEN EQ 6 AND '&FROM_TP' NE 'G').GENGG12 08970000
AIF (&FROM_LEN EQ 6).GENGG11 * Go load 6-byte value 08980000
&MASK SETC 'YYYN' * Mask for a 7-byte value 08990000
&I SETA 8 * Nr of bits to shift 09000000
.GENGG11 ANOP , * 09010000
&_LABEL ICM ®,&MASK,&_FROM1 * Load source data 09020000
&_LABEL SETC '' * Remove used label 09030000
SRA ®,&I * Create first fullword of value 09040000
AGO .GENGG13 * Go load second register 09050000
.GENGG12 ANOP , * Source aligned: use LH 09060000
&_LABEL LH ®,&_FROM1 * Load source data 09070000
&_LABEL SETC '' * Remove used label 09080000
.GENGG13 ANOP , * First register now ok 09090000
&I SETA &I/8 * Set I to nr of bytes shifted 09100000
&I SETA 4-&I * Set I to nr of bytes loaded 09110000
ICM &ODDREG,YYYY,&_FROM1+&I * Load second register 09120000
.GENGG14 ANOP , * Value in reg.pair can be saved 09130000
&MASK SETC 'NNNY' * 5 bytes is shortest possible 09140000
&I SETA 1 * Offset for 2nd register 09150000
AIF (&TO_LEN EQ 5).GENGG15 * Save 5-byte value 09160000
&MASK SETC 'NNYY' * Mask for 6-byte value 09170000
&I SETA 2 * Offset for 2nd register 09180000
AIF (&TO_LEN EQ 6 AND '&TO_TP' NE 'G').GENGG16 * 09190000
AIF (&TO_LEN EQ 6).GENGG15 * Save 6-byte value 09200000
&MASK SETC 'NYYY' * Mask for 7-byte value 09210000
&I SETA 3 * Offset for 2nd register 09220000
AIF (&TO_LEN EQ 7).GENGG15 * Save 7-byte value 09230000
&MASK SETC 'YYYY' * Mask for 8-byte value 09240000
&I SETA 4 * Offset for 2nd register 09250000
AIF ('&TO_TP' NE 'F').GENGG15 * Save 8-byte value 09260000
STM ®,&ODDREG,&_TO1 * Aligned! Use STM 09270000
MEXIT , * 09280000
.GENGG15 ANOP , * Save value with STCM 09290000
STCM ®,&MASK,&_TO1 * Save first part of result 09300000
STCM &ODDREG,YYYY,&_TO1+&I * Save second register 09310000
MEXIT , * 09320000
.GENGG16 ANOP , * Save value with STH/STCM 09330000
STH ®,&_TO1 * Save first part of result 09340000
STCM &ODDREG,YYYY,&_TO1+&I * Save second register 09350000
MEXIT , * 09360000
.* Logic for extending in storage 09370000
.GENGG20 ANOP , * &TO_LEN greater than 4 09380000
&PAD_LEN SETA &TO_LEN-&FROM_LEN * Nr of sign bytes to add 09390000
EQUREG R0=YES,TEMP=YES * Assign a register 09400000
AIF (&BXA_RC NE 0).ERR7H * Error 09410000
® SETC 'R'.'&BXA_NUMVAL' * Create register name 09420000
&_LABEL ICM ®,YNNN,&_FROM1 * Load first byte of source 09430000
&_LABEL SETC '' * Wipe used-up label 09440000
SRA ®,31 * Create 4 sign bytes 09450000
&MASK SETC 'YNNN' * Mask for 1 sign byte 09460000
AIF (&PAD_LEN EQ 1).GENGG21 * Go fill pad-area 09470000
&MASK SETC 'YYNN' * Mask for 2 sign bytes 09480000
AIF (&PAD_LEN EQ 2 AND '&TO_TP' NE 'G').GENGG22 * 09490000
AIF (&PAD_LEN EQ 2).GENGG21 * Go fill pad-area 09500000
&MASK SETC 'YYYN' * Mask for 3 sign bytes 09510000
AIF (&PAD_LEN EQ 3).GENGG21 * Go fill pad-area 09520000
&MASK SETC 'YYYY' * Mask for 4 sign bytes 09530000
AIF (&PAD_LEN EQ 4 AND '&TO_TP' EQ 'F').GENGG23 * 09540000
AIF (&PAD_LEN EQ 4).GENGG21 * Go fill pad-area 09550000
&MASK SETC 'YNNN' * Mask for 1 sign byte 09560000
.GENGG21 ANOP , * Set up sign with STCM 09570000
STCM ®,&MASK,&_TO1 * Save sign byte(s) 09580000
AIF (&PAD_LEN LE 4).GENGG24 * Go copy value bytes 09590000
MVC &_TO1+1(&PAD_LEN-1),&_TO1 * Propagate byte, extend sign 09600000
AGO .GENGG24 * Go extend sign (if needed) 09610000
.GENGG22 ANOP , * Set up sign with STH 09620000
STH ®,&_TO1 * Save sign bytes 09630000
AGO .GENGG24 * Go copy value bytes 09640000
.GENGG23 ANOP , * Set up sign with STH 09650000
ST ®,&_TO1 * Save sign bytes 09660000
.GENGG24 ANOP , * Copy value bytes 09670000
MVC &_TO1+&PAD_LEN.(&FROM_LEN),&_FROM1 * Copy value 09680000
MEXIT , * 09690000
.* 09700000
.* Copy an unaligned signed number to a register 09710000
.GENG_G ANOP , * 09720000
AIF (&TO_LEN LE 4).GENICM * Generate 1 ICM/L/LH 09730000
AIF (&TO_LEN NE &FROM_LEN).ERR7C * Lengths equal? 09740000
AGO .GENICMM * Generate several ICMs 09750000
.* 09760000
.* From type H: Signed halfword 09770000
.GENH ANOP , * 09780000
AIF ('&TO_TP' EQ 'F').GENGG * CPY signed to signed 09790000
AIF ('&TO_TP' EQ 'G').GENGG * CPY signed to signed 09800000
AIF ('&TO_TP' EQ 'H').GENGG * CPY signed to signed 09810000
AIF ('&TO_TP' EQ 'g').GENH_G * CPY signed to register 09820000
AGO .ERR7B * Unsupported combination 09830000
.* 09840000
.* Copy a signed halfword to a register 09850000
.GENH_G ANOP , * 09860000
AIF (&TO_LEN LE 4).GENICM * Generate 1 ICM/L/LH 09870000
AIF (&TO_LEN NE 2*&FROM_LEN).ERR7C * Lengths equal? 09880000
AGO .GENLHM * Generate several LHs 09890000
.* 09900000
.* From type K: Unaligned floating point field 09910000
.GENK ANOP , * 09920000
AIF ('&TO_TP' EQ 'D').GENKK * CPY float to float 09930000
AIF ('&TO_TP' EQ 'E').GENKK * CPY float to float 09940000
AIF ('&TO_TP' EQ 'K').GENKK * CPY float to float 09950000
AIF ('&TO_TP' EQ 'f').GENK_F * CPY float to FP register 09960000
AGO .ERR7B * Unsupported combination 09970000
.* 09980000
.* Copy a floating point number 09990000
.GENKK ANOP , * 10000000
AIF (&TO_LEN GT 256).ERR7D * 10010000
AIF (&FROM_LEN GT 256).ERR7E * 10020000
AIF (&TO_LEN EQ &FROM_LEN).DO_MVC * Lengths equal? 10030000
&PAD0 SETB 1 * Use zeros for padding 10040000
&PAD_LEN SETA 0 * Nr of padding bytes needed 10050000
&LEN SETA &TO_LEN * Determine length of move 10060000
AIF (&TO_LEN LE &FROM_LEN).GENKK1 10070000
&LEN SETA &FROM_LEN * FROM-length is shorter 10080000
&PAD_LEN SETA &TO_LEN-&LEN * Nr of padding bytes needed 10090000
&TO_LEN SETA &LEN * Truncate destination field 10100000
.GENKK1 ANOP , * &LEN now effective length 10110000
AIF (&PAD_LEN LT 1).DO_MVC * No padding required: use MVC 10120000
&_LABEL CLEAR (&_TO1+&LEN,&PAD_LEN),,XC * Wipe padding area 10130000
&_LABEL SETC '' * Label no longer needed 10140000
AGO .DO_MVC * 10150000
.* 10160000
.* Copy an unaligned floating point number to a register 10170000
.GENK_F ANOP , * 10180000
AIF (&TO_LEN NE 8).ERR7J * 1 register only? 10190000
AIF (&FROM_LEN EQ 4).DO_LE * Generate 1 LE 10200000
AIF (&FROM_LEN EQ 8).DO_LD * Generate 1 LD 10210000
AGO .ERR7K * Error 10220000
.* 10230000
.* From type L: Extended floating point field 10240000
.GENL ANOP , * 10250000
AIF ('&TO_TP' EQ 'L').GENLL * CPY float to float 10260000
AIF ('&TO_TP' EQ 'f').GENL_F * CPY float to FP register pair 10270000
AGO .ERR7B * Unsupported combination 10280000
.* 10290000
.* Copy an extended floating point number 10300000
.GENLL ANOP , * 10310000
AIF (&TO_LEN GT 256).ERR7D * 10320000
AIF (&FROM_LEN GT 256).ERR7E * 10330000
AIF (&TO_LEN EQ &FROM_LEN).DO_MVC * Lengths equal? 10340000
AIF (&FROM_LEN LT 6).ERR7L * Source too short 10350000
AIF (&TO_LEN LT 6).ERR7L * Destination too short 10360000
AGO .GENKK * Otherwise: copy float field 10370000
.* 10380000
.* Copy an extended floating point number to a register 10390000
.GENL_F ANOP , * 10400000
AIF (K'&_TO2 EQ 0).GENL_F1 * Just a register spec'd? 10410000
AIF (NOT &TO_EREG).GENL_F2 * End register specified? 10420000
.GENL_F1 ANOP , * 10430000
&TO_LEN SETA &TO_LEN+8 * Yes: add length of odd reg 10440000
.GENL_F2 ANOP , * &TO_LEN is now correct 10450000
AIF (&TO_LEN NE &FROM_LEN).ERR7C * Lengths equal? 10460000
AGO .GENLXM * Generate several LDs 10470000
.* 10480000
.* From type P: Packed decimal field 10490000
.GENP ANOP , * 10500000
AIF ('&TO_TP' EQ 'P').GENPP * CPY packed to packed 10510000
AIF ('&TO_TP' EQ 'Z').GENPZ * CPY packed to zoned 10520000
AIF ('&TO_TP' EQ 'g').GENP_G * CPY packed to register 10530000
AGO .ERR7B * Unsupported combination 10540000
.* 10550000
.* Copy a packed field 10560000
.GENPP ANOP , * 10570000
AIF (&TO_LEN GT 256).ERR7D * 10580000
AIF (&FROM_LEN GT 256).ERR7E * 10590000
AIF (&FROM_LEN EQ &TO_LEN).DO_MVC 10600000
AIF (&FROM_LEN LE 16 AND &TO_LEN LE 16).DO_ZAP 10610000
AIF (&FROM_LEN GT &TO_LEN).GENPP0 10620000
&PAD_LEN SETA &TO_LEN-&FROM_LEN * Nr of prefix zeros to add 10630000
&_LABEL CLEAR (&_TO1,&PAD_LEN),X'00' * Wipe area 10640000
&_LABEL SETC '' * Wipe used label 10650000
MVC &_TO1+&PAD_LEN.(&FROM_LEN),&_FROM1 * Copy decimal data 10660000
MEXIT , * 10670000
.GENPP0 ANOP , * Source is larger 10680000
&PAD_LEN SETA &FROM_LEN-&TO_LEN * Nr of excess source bytes 10690000
&_FROM1 SETC '&_FROM1'.'+&PAD_LEN' * Skip excess bytes 10700000
AGO .DO_MVC * 10710000
.* 10720000
.* Copy a packed field to a zoned field 10730000
.GENPZ ANOP , * 10740000
AIF (&TO_LEN GT 256).ERR7D * 10750000
AIF (&FROM_LEN GT 256).ERR7E * 10760000
&I SETA 2*&FROM_LEN-1 * Nr of digits 10770000
&PAD_LEN SETA &TO_LEN-&I * Nr of zeroes to append 10780000
AIF (&PAD_LEN LT 1).GENPZ0 * No leading zeroes required 10790000
&_LABEL CLEAR (&_TO1,&PAD_LEN),C'0' * Initialize with leading zeros 10800000
&_LABEL SETC '' * Remove used label 10810000
&_TO1 SETC '&_TO1'.'+&PAD_LEN' * Modify destination field 10820000
&TO_LEN SETA &I * and reduce its length 10830000
.GENPZ0 ANOP , * 10840000
AIF (&FROM_LEN GT 16).ERR7N * Source too large 10850000
AIF (&TO_LEN GT 16).ERR7O * Destination too large 10860000
AGO .DO_UNPK * 10870000
.* 10880000
.* Copy a packed number to a register 10890000
.GENP_G ANOP , * 10900000
AIF (&TO_LEN NE 4).GENP_G0 * 1 register only? 10910000
AIF (&FROM_LEN EQ 8).DO_CVB * 10920000
AIF (&FROM_LEN LT 8).ERR7P * Source too short 10930000
&I SETA &FROM_LEN-8 * Excess digits 10940000
&_FROM1 SETC '&_FROM1'.'+&I' * Skip excess digits 10950000
&_FROM_LEN SETA 8 * Adjust length 10960000
AGO .DO_CVB * And go load register 10970000
.GENP_G0 ANOP , * 10980000
AIF (2*&TO_LEN NE &FROM_LEN).ERR7C * Lengths equal? 10990000
AGO .GENCVBM * Generate several CVBs 11000000
.* 11010000
.* From type Q: 4-byte offset address field 11020000
.GENQ ANOP , * 11030000
AIF ('&TO_TP' EQ 'Q').GENMVC0 * CPY address to address 11040000
AIF ('&TO_TP' EQ 'R').GENMVC0 * CPY address to address 11050000
AIF ('&TO_TP' EQ 'g').GENA_G * CPY address to gpr 11060000
AGO .ERR7B * Unsupported combination 11070000
.* 11080000
.* From type R: unaligned address field 11090000
.GENR ANOP , * 11100000
AIF ('&TO_TP' EQ 'A').GENMVC0 * CPY address to address 11110000
AIF ('&TO_TP' EQ 'Q').GENMVC0 * CPY address to address 11120000
AIF ('&TO_TP' EQ 'R').GENMVC0 * CPY address to address 11130000
AIF ('&TO_TP' EQ 'S').GENRS * CPY address to address 11140000
AIF ('&TO_TP' EQ 'V').GENMVC0 * CPY address to address 11150000
AIF ('&TO_TP' EQ 'Y').GENMVC0 * CPY address to address 11160000
AIF ('&TO_TP' EQ 'g').GENA_G * CPY address to gpr 11170000
AGO .ERR7B * Unsupported combination 11180000
.* 11190000
.* Copy an unaligned address field to an S-type address field 11200000
.GENRS ANOP , * 11210000
AIF (&TO_LEN GT 256).ERR7D * 11220000
AIF (&FROM_LEN GT 256).ERR7E * 11230000
AIF (&TO_LEN NE &FROM_LEN).ERR7C * Lengths equal? 11240000
AGO .DO_MVC * 11250000
.* 11260000
.* From type S: 2-byte address field - base-displacement 11270000
.GENS ANOP , * 11280000
AIF ('&TO_TP' EQ 'R').GENSS * CPY address to address 11290000
AIF ('&TO_TP' EQ 'S').GENSS * CPY address to address 11300000
AIF ('&TO_TP' EQ 'g').GENS_G * CPY address to gpr 11310000
AGO .ERR7B * Unsupported combination 11320000
.* 11330000
.* Copy an S-type address field to a field 11340000
.GENSS ANOP , * 11350000
AIF (&TO_LEN GT 256).ERR7D * 11360000
AIF (&FROM_LEN GT 256).ERR7E * 11370000
AIF (&TO_LEN NE &FROM_LEN).ERR7C * Lengths equal? 11380000
AGO .DO_MVC * 11390000
.* 11400000
.* Copy an S-type address field to a register 11410000
.GENS_G ANOP , * 11420000
AIF (&TO_LEN NE 4).ERR7Q * Only 1 register! 11430000
AIF (&FROM_LEN NE 2).ERR7R * Must be two bytes long! 11440000
EQUREG TEMP=YES * Assign work register 11450000
AIF (&BXA_RC NE 0).ERR7S * 11460000
AIF (&BXA_NUMVAL NE &TO_REG).GENS_G0 11470000
USE &_TO1 * Set register in use 11480000
EQUREG TEMP=YES * Assign work register 11490000
&I SETA &BXA_RC * Save returncode 11500000
&J SETA &BXA_NUMVAL * and return value 11510000
DROP &_TO1 * End of forced register use 11520000
AIF (&BXA_RC NE 0).ERR7S * No work register available 11530000
.GENS_G0 ANOP , * Register allocated correctly 11540000
® SETC 'R'.'&BXA_NUMVAL' * Create register name 11550000
&_LABEL LH ®,&_FROM1 * Load whole S-constant 11560000
&_LABEL SETC '' * Wipe used label 11570000
SRL ®,12 * Base register nr in low-order 11580000
LA &_TO1,16*&_TO1 * Load register with its number 11590000
OR ®,&_TO1 * ® now contains &to,&base 11600000
EX ®,_CPY&SYSNDX * Copy base to destination reg 11610000
B _CPY_&SYSNDX * Skip executable instruction 11620000
_CPY&SYSNDX LABEL , * 11630000
DC X'1800' * LR instruction 11640000
_CPY_&SYSNDX LABEL , * 11650000
LH ®,&_FROM1 * Reload S-constant 11660000
SLL ®,20 * Remove register number 11670000
SRL ®,20 * Keep offset in low-order bits 11680000
AR &_TO1,® * Create result value 11690000
MEXIT , * 11700000
.* 11710000
.* From type V: 4-byte address field 11720000
.GENV ANOP , * 11730000
AIF ('&TO_TP' EQ 'A').GENMVC0 * CPY address to address 11740000
AIF ('&TO_TP' EQ 'R').GENMVC0 * CPY address to address 11750000
AIF ('&TO_TP' EQ 'V').GENMVC0 * CPY address to address 11760000
AIF ('&TO_TP' EQ 'Y').GENMVC0 * CPY address to address 11770000
AIF ('&TO_TP' EQ 'g').GENA_G * CPY address to gpr 11780000
AGO .ERR7B * Unsupported combination 11790000
.* 11800000
.* From type X: Hexadecimal data field (unsigned) 11810000
.GENX ANOP , * 11820000
AIF ('&TO_TP' EQ 'B').GENMVC0 * CPY unsigned to unsigned 11830000
AIF ('&TO_TP' EQ 'X').GENMVC0 * CPY unsigned to unsigned 11840000
AIF ('&TO_TP' EQ 'a').GENB_A * CPY unsigned to ARnn 11850000
AIF ('&TO_TP' EQ 'c').GENB_C * CPY unsigned to CRnn 11860000
AIF ('&TO_TP' EQ 'g').GENB_G * CPY unsigned to Rnn 11870000
AGO .ERR7B * Unsupported combination 11880000
.* 11890000
.* From type Y: 2-byte address field 11900000
.GENY ANOP , * 11910000
AIF ('&TO_TP' EQ 'A').GENMVC0 * CPY address to address 11920000
AIF ('&TO_TP' EQ 'R').GENMVC0 * CPY address to address 11930000
AIF ('&TO_TP' EQ 'V').GENMVC0 * CPY address to address 11940000
AIF ('&TO_TP' EQ 'Y').GENMVC0 * CPY address to address 11950000
AIF ('&TO_TP' EQ 'g').GENY_G * CPY address to gpr 11960000
AGO .ERR7B * Unsupported combination 11970000
.* 11980000
.* Copy halfword address field to general purpose register(s) 11990000
.GENY_G ANOP , * 12000000
AIF (&TO_LEN NE 2*&FROM_LEN).ERR7C * Lengths equal? 12010000
&I SETA &TO_REG * Save first register number 12020000
&J SETA 0 * Offset in source field 12030000
.GENY_G0 ANOP , * Loop 12040000
&_LABEL LTHU &_TO1,&_FROM1+&J * 12050000
&_LABEL SETC '' * Remove label after use 12060000
&TO_LEN SETA &TO_LEN-4 * Reduce length 12070000
AIF (&TO_LEN LT 4).MEXIT * No registers left to fill 12080000
&J SETA &J+2 * Point next halfword 12090000
&I SETA &I+1 * Next register number 12100000
AIF (&I LT 16).GENY_G1 * Valid register nr 12110000
&I SETA 0 * Wrap-around to R0 12120000
.GENY_G1 ANOP , * I now next register nr 12130000
&_TO1 SETC 'R'.'&I' * Create next register name 12140000
AGO .GENY_G0 * 12150000
.* 12160000
.* From type Z: Zoned decimal field 12170000
.GENZ ANOP , * 12180000
AIF ('&TO_TP' EQ 'P').GENZP * CPY zoned to packed 12190000
AIF ('&TO_TP' EQ 'Z').GENZZ * CPY zoned to zoned 12200000
AGO .ERR7B * Unsupported combination 12210000
.* 12220000
.* Copy a zoned field to a packed field 12230000
.GENZP ANOP , * 12240000
AIF (&TO_LEN GT 256).ERR7D * 12250000
AIF (&FROM_LEN GT 256).ERR7E * 12260000
&I SETA (&FROM_LEN/2)+1 * Nr of result bytes 12270000
&PAD_LEN SETA &TO_LEN-&I * Nr of zeroes to append 12280000
AIF (&PAD_LEN LT 1).GENZP0 * No leading zeroes required 12290000
&_LABEL CLEAR (&_TO1,&PAD_LEN),,XC * Initialize with leading zeros 12300000
&_LABEL SETC '' * Remove used label 12310000
&_TO1 SETC '&_TO1'.'+&PAD_LEN' * Modify destination field 12320000
&TO_LEN SETA &I * and reduce its length 12330000
.GENZP0 ANOP , * 12340000
AIF (&FROM_LEN GT 16).ERR7G * Source too large 12350000
AGO .DO_PACK * 12360000
.* 12370000
.* Copy a zoned decimal field 12380000
.GENZZ ANOP , * 12390000
AIF (&TO_LEN GT 256).ERR7D * 12400000
AIF (&FROM_LEN GT 256).ERR7E * 12410000
AIF (&TO_LEN EQ &FROM_LEN).DO_MVC 12420000
&PAD_LEN SETA &TO_LEN-&FROM_LEN * Nr of leading zeros 12430000
AIF (&PAD_LEN LT 1).GENZZ0 * No leading zeros required 12440000
&_LABEL CLEAR (&_TO1,&PAD_LEN),C'0' * 12450000
&_LABEL SETC '' * Wipe used label 12460000
&_TO1 SETC '&_TO1'.'+&PAD_LEN' * Advance destination address 12470000
&TO_LEN SETA &FROM_LEN * 12480000
AGO .DO_MVC * And go copy data portion 12490000
.GENZZ0 ANOP , * Trucation required 12500000
&PAD_LEN SETA &FROM_LEN-&TO_LEN * Nr of bytes to skip 12510000
&_FROM1 SETC '&_FROM1'.'+&PAD_LEN' * Advannce source address 12520000
&FROM_LEN SETA &TO_LEN * 12530000
AGO .DO_MVC * And go copy data portion 12540000
.* 12550000
.* From type 0: Literal number 12560000
.GEN0 ANOP , * 12570000
AIF ('&TO_TP' EQ 'B').GEN0B * CPY number to unsigned 12580000
AIF ('&TO_TP' EQ 'D').GEN0K * CPY number to long float 12590000
AIF ('&TO_TP' EQ 'E').GEN0K * CPY number to short float 12600000
AIF ('&TO_TP' EQ 'F').GEN0G * CPY number to fixed 12610000
AIF ('&TO_TP' EQ 'G').GEN0G * CPY number to fixed 12620000
AIF ('&TO_TP' EQ 'H').GEN0G * CPY number to fixed 12630000
AIF ('&TO_TP' EQ 'K').GEN0K * CPY number to float 12640000
AIF ('&TO_TP' EQ 'L').GEN0L * CPY number to extended float 12650000
AIF ('&TO_TP' EQ 'P').GEN0P * CPY number to packed 12660000
AIF ('&TO_TP' EQ 'X').GEN0B * CPY number to unsigned 12670000
AIF ('&TO_TP' EQ 'Z').GEN0Z * CPY number to zoned 12680000
AIF ('&TO_TP' EQ 'a').GEN0_A * CPY number to access register 12690000
AIF ('&TO_TP' EQ 'f').GEN0_F * CPY number to float register 12700000
AIF ('&TO_TP' EQ 'g').GEN0_G * CPY number to register 12710000
AGO .ERR7B * Unsupported combination 12720000
.* 12730000
.* Copy a literal number to an unsigned field 12740000
.GEN0B ANOP , * 12750000
AIF (&TO_LEN GT 256).ERR7D * 12760000
AIF (&TO_LEN LT &FROM_LEN).ERR7I * FROM_LEN <= 4 for literal 12770000
AIF (&FROM_VAL LT 0).ERR7U * FROM_LEN <= 4 for literal 12780000
AIF (&TO_LEN LE 4).GEN0B0 * Just an MVC please 12790000
&PAD_LEN SETA &TO_LEN-&FROM_LEN * Nr of leading zeros needed 12800000
AIF (&PAD_LEN LT 1).GEN0B0 * No padding needed 12810000
&_LABEL CLEAR (&_TO1,&PAD_LEN),,XC * Wipe prefix area 12820000
&_LABEL SETC '' * Remove used label 12830000
&_TO1 SETC '&_TO1'.'+&PAD_LEN' * Adjust destination for move 12840000
&TO_LEN SETA &FROM_LEN * and length too 12850000
.GEN0B0 ANOP , * 12860000
AIF (&TO_LEN EQ 1).GEN0_MVI * Use MVI for 1-byte fields 12870000
&_FROM1 SETC '=AL&TO_LEN'.'(&_FROM1)' * Create literal to copy 12880000
AGO .GEN0_MVC * Go generate MVC to copy 12890000
.* 12900000
.* Copy a literal number to a signed field 12910000
.GEN0G ANOP , * 12920000
AIF (&TO_LEN GT 256).ERR7D * 12930000
AIF (&FROM_VAL EQ 0).GEN0G0 * Zero value requested? 12940000
AIF (&TO_LEN LT &FROM_LEN).ERR7I * FROM_LEN <= 4 for literal 12950000
AIF (&TO_LEN LE 4).GEN0G1 * Just an MVC please 12960000
&PAD_LEN SETA &TO_LEN-&FROM_LEN * Nr of leading zeros needed 12970000
AIF (&PAD_LEN LT 1).GEN0G1 * No padding needed 12980000
AIF ('&SIGN' EQ '-').ERR7X * 12990000
&_LABEL CLEAR (&_TO1,&PAD_LEN),,XC * Wipe prefix area 13000000
&_LABEL SETC '' * Remove used label 13010000
&_TO1 SETC '&_TO1'.'+&PAD_LEN' * Adjust destination for move 13020000
&TO_LEN SETA &FROM_LEN * and length too 13030000
AGO .GEN0G1 * 13040000
.GEN0G0 ANOP , * 13050000
&_LABEL CLEAR (&_TO1,&TO_LEN),,XC * Insert zero value 13060000
MEXIT , * 13070000
.GEN0G1 ANOP , * 13080000
AIF (&TO_LEN EQ 1).GEN0_MVI * Use MVI for 1-byte fields 13090000
AIF (&EQULIT).GEN0G2 * 13100000
&_FROM1 SETC '=FL&TO_LEN'.'''&_FROM1''' * Create literal 13110000
AGO .GEN0_MVC * Go generate MVC to copy 13120000
.GEN0G2 ANOP , * 13130000
&_FROM1 SETC '=FL&TO_LEN'.'''&FROM_VAL''' * Create literal 13140000
AGO .GEN0_MVC * Go generate MVC to copy 13150000
.* 13160000
.* Copy a literal number to a floating point field 13170000
.GEN0K ANOP , * 13180000
AIF (&TO_LEN GT 256).ERR7D * 13190000
&FROM_LEN SETA &FROM_LEN+1 * Add room for exponent byte 13200000
AIF (&TO_LEN LT &FROM_LEN).ERR7I * FROM_LEN <= 5 for literal 13210000
AIF (&FROM_LEN GE 5).GEN0K0 * May be useful to expand 13220000
AIF (&FROM_LEN EQ &TO_LEN).GEN0K2 * literal length 13230000
AIF (&TO_LEN GE 5).GEN0K0 * to accomodate value 13240000
&FROM_LEN SETA &TO_LEN * 13250000
AGO .GEN0K2 * No padding required! 13260000
.GEN0K0 ANOP , * 13270000
&PAD_LEN SETA &TO_LEN-&FROM_LEN * Nr of padding zeros needed 13280000
AIF (&PAD_LEN LT 1).GEN0K2 * No padding needed 13290000
AIF ('&SIGN' EQ '-').ERR7X * 13300000
&_LABEL CLEAR (&_TO1+&FROM_LEN,&PAD_LEN),,XC * Wipe prefix area 13310000
&_LABEL SETC '' * Remove used label 13320000
&TO_LEN SETA &FROM_LEN * Adjust length of dest.field 13330000
.GEN0K2 ANOP , * 13340000
AIF (&TO_LEN EQ 1).GEN0_MVI * Use MVI for 1-byte fields 13350000
AIF (&EQULIT).GEN0K3 * 13360000
&_FROM1 SETC '=DL&TO_LEN'.'''&_FROM1''' * Create literal to copy 13370000
AGO .GEN0_MVC * Go generate MVC to copy 13380000
.GEN0K3 ANOP , * 13390000
&_FROM1 SETC '=DL&TO_LEN'.'''&FROM_VAL''' * Create literal to copy 13400000
AGO .GEN0_MVC * Go generate MVC to copy 13410000
.* 13420000
.* Copy a literal number to an extended floating point field 13430000
.GEN0L ANOP , * 13440000
AIF (&TO_LEN GT 256).ERR7D * 13450000
&FROM_LEN SETA &FROM_LEN+1 * Add room for exponent byte 13460000
AIF (&FROM_LEN GE 6).GEN0L0 * Check minimum size for 13470000
&FROM_LEN SETA 6 * L-type literal: 6 bytes min. 13480000
.GEN0L0 ANOP , * 13490000
AIF (&TO_LEN LT &FROM_LEN).ERR7I * FROM_LEN <= 5 for literal 13500000
AIF (&FROM_LEN GE 8).GEN0L1 * May be useful to expand 13510000
AIF (&FROM_LEN EQ &TO_LEN).GEN0L2 * literal length 13520000
AIF (&TO_LEN GE 8).GEN0L1 * to accomodate value 13530000
&FROM_LEN SETA &TO_LEN * 13540000
AGO .GEN0L2 * No padding required! 13550000
.GEN0L1 ANOP , * 13560000
&PAD_LEN SETA &TO_LEN-&FROM_LEN * Nr of additional zeros needed 13570000
AIF (&PAD_LEN LT 1).GEN0L2 * No padding needed 13580000
AIF ('&SIGN' EQ '-').ERR7X * 13590000
&_LABEL CLEAR (&_TO1+&FROM_LEN,&PAD_LEN),,XC * Wipe extension area 13600000
&_LABEL SETC '' * Remove used label 13610000
&TO_LEN SETA &FROM_LEN * And reduce destination length 13620000
.GEN0L2 ANOP , * 13630000
AIF (&TO_LEN EQ 1).GEN0_MVI * Use MVI for 1-byte fields 13640000
AIF (&EQULIT).GEN0L3 * 13650000
&_FROM1 SETC '=LL&TO_LEN'.'''&_FROM1''' * Create literal to copy 13660000
AGO .GEN0_MVC * Go generate MVC to copy 13670000
.GEN0L3 ANOP , * 13680000
&_FROM1 SETC '=LL&TO_LEN'.'''&FROM_VAL''' * Create literal to copy 13690000
AGO .GEN0_MVC * Go generate MVC to copy 13700000
.* 13710000
.* Copy a literal number to a packed decimal field 13720000
.GEN0P ANOP , * 13730000
AIF (&TO_LEN GT 256).ERR7D * 13740000
&LEN SETA K'&FROM_VAL * Nr of digits in literal 13750000
&LEN SETA (&LEN/2)+1 * Nr of positions required 13760000
AIF (&TO_LEN LT &LEN).ERR7I * Won't fit! 13770000
&PAD_LEN SETA &TO_LEN-&LEN * Nr of leading zeros needed 13780000
AIF (&PAD_LEN LT 1).GEN0P0 * No padding needed 13790000
AIF ('&SIGN' EQ '-').ERR7X * 13800000
&_LABEL CLEAR (&_TO1,&PAD_LEN),,XC * Wipe prefix area 13810000
&_LABEL SETC '' * Remove used label 13820000
&_TO1 SETC '&_TO1'.'+&PAD_LEN' * Adjust destination for move 13830000
&TO_LEN SETA &LEN * and length too 13840000
.GEN0P0 ANOP , * 13850000
AIF (&TO_LEN EQ 1).GEN0_MVI * Use MVI for 1-byte fields 13860000
AIF (&EQULIT).GEN0P1 * 13870000
&_FROM1 SETC '=PL&TO_LEN'.'''&_FROM1''' * Create literal to copy 13880000
AGO .GEN0_MVC * Go generate MVC to copy 13890000
.GEN0P1 ANOP , * 13900000
&_FROM1 SETC '=PL&TO_LEN'.'''&FROM_VAL''' * Create literal to copy 13910000
AGO .GEN0_MVC * Go generate MVC to copy 13920000
.* 13930000
.* Copy a literal number to a zoned decimal field 13940000
.GEN0Z ANOP , * 13950000
AIF (&TO_LEN GT 256).ERR7D * 13960000
&LEN SETA K'&FROM_VAL * Nr of digits in literal 13970000
AIF (&TO_LEN LT &LEN).ERR7I * Won't fit! 13980000
&PAD_LEN SETA &TO_LEN-&LEN * Nr of leading zeros needed 13990000
AIF (&PAD_LEN LT 1).GEN0Z0 * No padding needed 14000000
AIF ('&SIGN' EQ '-').ERR7X * 14010000
&_LABEL CLEAR (&_TO1,&PAD_LEN),C'0' * Wipe prefix area 14020000
&_LABEL SETC '' * Remove used label 14030000
&_TO1 SETC '&_TO1'.'+&PAD_LEN' * Adjust destination for move 14040000
&TO_LEN SETA &LEN * and length too 14050000
.GEN0Z0 ANOP , * 14060000
AIF (&TO_LEN EQ 1).GEN0_MVI * Use MVI for 1-byte fields 14070000
AIF (&EQULIT).GEN0Z1 * 14080000
&_FROM1 SETC '=ZL&TO_LEN'.'''&_FROM1''' * Create literal to copy 14090000
AGO .GEN0_MVC * Go generate MVC to copy 14100000
.GEN0Z1 ANOP , * 14110000
&_FROM1 SETC '=ZL&TO_LEN'.'''&FROM_VAL''' * Create literal to copy 14120000
AGO .GEN0_MVC * Go generate MVC to copy 14130000
.* 14140000
.* Copy a literal number to an access register 14150000
.GEN0_A ANOP , * 14160000
AIF (&FROM_VAL EQ 0).GEN0_A0 * Only literal values 0, 14170000
AIF (&FROM_VAL EQ 1).GEN0_A1 * 1, and 2 are allowed for 14180000
AIF (&FROM_VAL EQ 2).GEN0_A1 * use with access registers 14190000
AGO .ERR7T * Illegal literal for AR 14200000
.GEN0_A0 ANOP , * Load with value of 0 14210000
&_LABEL CLEAR &_TO1 * Wipe register to create 0 14220000
&_LABEL SETC '' * Wipe used label 14230000
AIF (&TO_LEN EQ 4).MEXIT * 1 register: done 14240000
AGO .GEN0_A2 * 14250000
.GEN0_A1 ANOP , * Load with value of 1 or 2 14260000
EQUREG TEMP=YES,R0=YES * Find a free register 14270000
AIF (&BXA_RC NE 0).ERR7S * None available! 14280000
® SETC 'R'.'&BXA_NUMVAL' * Create name of register 14290000
&_LABEL LA ®,&_FROM1 * Load ALET value 14300000
&_LABEL SETC '' * Wipe used label 14310000
SAR &_TO1,® * Copy ALET to access register 14320000
AIF (&TO_LEN EQ 4).MEXIT * 1 register: done 14330000
.GEN0_A2 ANOP , * Copy ALET to other ARs 14340000
&I SETA &TO_REG * Save first register number 14350000
.GEN0_A3 ANOP , * Loop to fill ARs 14360000
&TO_LEN SETA &TO_LEN-4 * Reduce length 14370000
AIF (&TO_LEN LT 4).MEXIT * No registers left to fill 14380000
&I SETA &I+1 * Next register number 14390000
AIF (&I LT 16).GEN0_A4 * Valid register nr 14400000
&I SETA 0 * Wrap-around to AR0 14410000
.GEN0_A4 ANOP , * I now next register nr 14420000
® SETC 'AR'.'&I' * Create next register name 14430000
CPYA ®,&_TO1 * Copy ALET 14440000
AGO .GEN0_A3 * 14450000
.* 14460000
.* Copy a literal number to a floating point register 14470000
.* For a value of zero an SDR might be used, but this might generate 14480000
.* a significance interruption. 14490000
.GEN0_F ANOP , * 14500000
&_FROM1 SETC '=D'.'''&_FROM1''' * Create literal to copy 14510000
AIF (NOT &EQULIT).GEN0_F1 * 14520000
&_FROM1 SETC '=D'.'''&FROM_VAL''' * Create literal to copy 14530000
.GEN0_F1 ANOP , * 14540000
&_LABEL LD &_TO1,&_FROM1 * Load value to register 14550000
&_LABEL SETC '' * Wipe used label 14560000
AIF (&TO_LEN EQ 8).MEXIT * 1 register: done 14570000
&I SETA &TO_REG * Save first register number 14580000
.GEN0_F3 ANOP , * Loop to fill FPRs 14590000
&TO_LEN SETA &TO_LEN-8 * Reduce length 14600000
AIF (&TO_LEN LT 8).MEXIT * No registers left to fill 14610000
&I SETA &I+2 * Next register number 14620000
AIF (&I LT 8).GEN0_F4 * Valid register nr 14630000
&I SETA 0 * Wrap-around to FPR0 14640000
.GEN0_F4 ANOP , * I now next register nr 14650000
® SETC 'FPR'.'&I' * Create next register name 14660000
LDR ®,&_TO1 * Copy value 14670000
AGO .GEN0_F3 * 14680000
.* 14690000
.* Copy a literal number to a general purpose register 14700000
.GEN0_G ANOP , * 14710000
AIF (&FROM_VAL EQ 0).GEN0_G0 * 0? use Clear 14720000
AIF (&FROM_VAL LT 4096).GEN0_G1 * Use LA if possible 14730000
AIF (&FROM_VAL GT 32767).GEN0_G2 * Too large for LH 14740000
AIF (&FROM_VAL LT -32768).GEN0_G2 * Too large for LH 14750000
&_FROM1 SETC '=H'.'''&_FROM1''' * Create literal to copy 14760000
AIF (NOT &EQULIT).GEN0_GA * 14770000
&_FROM1 SETC '=H'.'''&FROM_VAL''' * Create literal to copy 14780000
.GEN0_GA ANOP , * 14790000
&_LABEL LH &_TO1,&_FROM1 * Load value to register 14800000
&_LABEL SETC '' * Remove used label 14810000
AIF (&TO_LEN EQ 4).MEXIT * 1 register: done 14820000
AGO .GEN0_G3 * 14830000
.GEN0_G0 ANOP , * Load with value of 0 14840000
&_LABEL CLEAR &_TO1 * Wipe register to create 0 14850000
&_LABEL SETC '' * Wipe used label 14860000
AIF (&TO_LEN EQ 4).MEXIT * 1 register: done 14870000
AGO .GEN0_G3 * 14880000
.GEN0_G1 ANOP , * Load with value up to 4095 14890000
&_LABEL LA &_TO1,&_FROM1 * Load value 14900000
&_LABEL SETC '' * Wipe used label 14910000
AIF (&TO_LEN EQ 4).MEXIT * 1 register: done 14920000
AGO .GEN0_G3 * 14930000
.GEN0_G2 ANOP , * 14940000
&_FROM1 SETC '=F'.'''&_FROM1''' * Create literal to copy 14950000
AIF (NOT &EQULIT).GEN0_GB * 14960000
&_FROM1 SETC '=F'.'''&FROM_VAL''' * Create literal to copy 14970000
.GEN0_GB ANOP , * 14980000
&_LABEL L &_TO1,&_FROM1 * Load value to register 14990000
&_LABEL SETC '' * Remove used label 15000000
AIF (&TO_LEN EQ 4).MEXIT * 1 register: done 15010000
AGO .GEN0_G3 * 15020000
.GEN0_G3 ANOP , * Copy value to other regs 15030000
&I SETA &TO_REG * Save first register number 15040000
.GEN0_G4 ANOP , * Loop to fill regs 15050000
&TO_LEN SETA &TO_LEN-4 * Reduce length 15060000
AIF (&TO_LEN LT 4).MEXIT * No registers left to fill 15070000
&I SETA &I+1 * Next register number 15080000
AIF (&I LT 16).GEN0_G5 * Valid register nr 15090000
&I SETA 0 * Wrap-around to R0 15100000
.GEN0_G5 ANOP , * I now next register nr 15110000
® SETC 'R'.'&I' * Create next register name 15120000
LR ®,&_TO1 * Copy value 15130000
AGO .GEN0_G4 * 15140000
.* 15150000
.* Logic to generate a move of a literal after truncation or expansion 15160000
.* has been dealt with. 15170000
.GEN0_MVC ANOP , * All GEN0-routines enter here 15180000
AIF (K'&_TO2 NE 0).GEN0_MVC1 * Use explicit length 15190000
AIF (&TO_LEN NE L'&_TO1).GEN0_MVC1 * Use explicit length 15200000
&_LABEL MVC &_TO1,&_FROM1 * 15210000
MEXIT , * 15220000
.GEN0_MVC1 ANOP , * MVC with explicit length 15230000
&_LABEL MVC &_TO1.(&TO_LEN),&_FROM1 * 15240000
MEXIT , * 15250000
.* 15260000
.* Logic to generate a move of a literal to a 1-byte field 15270000
.GEN0_MVI ANOP , * All GEN0-routines enter here 15280000
AIF ('&_FROM1'(1,1) NE '=').GEN0_MVI0 15290000
&_FROM1 SETC '&_FROM1'(2,*) * Remove leading = sign 15300000
.GEN0_MVI0 ANOP , * 15310000
&_LABEL MVI &_TO1,&_FROM1 * 15320000
MEXIT , * 15330000
.* 15340000
.* From type a: Access Register 15350000
.GEN_A ANOP , * 15360000
AIF ('&TO_TP' EQ 'B').GEN_AB * CPY AR to binary 15370000
AIF ('&TO_TP' EQ 'X').GEN_AB * CPY AR to binary 15380000
AIF ('&TO_TP' EQ 'a').GEN_A_A * CPY AR to AR 15390000
AIF ('&TO_TP' EQ 'g').GEN_A_G * CPY AR to GPR 15400000
AGO .ERR7B * Unsupported combination 15410000
.* 15420000
.* Copy access register(s) to an unsigned binary field 15430000
.GEN_AB ANOP , * 15440000
AIF (&TO_LEN NE &FROM_LEN).ERR7C * Lengths equal? 15450000
AGO .DO_STAM * Go generate STAM instruction 15460000
.* 15470000
.* Copy access register(s) to access register(s) 15480000
.GEN_A_A ANOP , * 15490000
AIF (&TO_LEN NE &FROM_LEN).ERR7C * Lengths equal? 15500000
&_LABEL CPYA &_TO1,&_FROM1 * Copy ALET 15510000
&_LABEL SETC '' * Remove used label 15520000
AIF (&TO_LEN EQ 4).MEXIT * 1 register only to copy? 15530000
.GEN_A_A0 ANOP , * Loop to copy ARs 15540000
&TO_LEN SETA &TO_LEN-4 * Reduce length 15550000
AIF (&TO_LEN LT 4).MEXIT * No registers left to copy 15560000
&TO_REG SETA &TO_REG+1 * Next dest reg nr 15570000
AIF (&TO_REG LT 16).GEN_A_A1 * Valid register nr 15580000
&TO_REG SETA 0 * Wrap-around to AR0 15590000
.GEN_A_A1 ANOP , * TO_REG now next register nr 15600000
&FROM_REG SETA &FROM_REG+1 * Next src reg nr 15610000
AIF (&FROM_REG LT 16).GEN_A_A2 * Valid register nr 15620000
&FROM_REG SETA 0 * Wrap-around to AR0 15630000
.GEN_A_A2 ANOP , * FROM_REG now next register nr 15640000
® SETC 'AR'.'&TO_REG' * Create next dest.reg name 15650000
&ODDREG SETC 'AR'.'&FROM_REG' * Create next src.reg name 15660000
CPYA ®,&ODDREG * Copy ALET 15670000
AGO .GEN_A_A0 * 15680000
.* 15690000
.* Copy access register(s) to GP register(s) 15700000
.GEN_A_G ANOP , * 15710000
AIF (&TO_LEN NE &FROM_LEN).ERR7C * Lengths equal? 15720000
&_LABEL EAR &_TO1,&_FROM1 * Copy ALET 15730000
&_LABEL SETC '' * Remove used label 15740000
AIF (&TO_LEN EQ 4).MEXIT * 1 register only to copy? 15750000
.GEN_A_G0 ANOP , * Loop to copy ARs 15760000
&TO_LEN SETA &TO_LEN-4 * Reduce length 15770000
AIF (&TO_LEN LT 4).MEXIT * No registers left to copy 15780000
&TO_REG SETA &TO_REG+1 * Next dest reg nr 15790000
AIF (&TO_REG LT 16).GEN_A_G1 * Valid register nr 15800000
&TO_REG SETA 0 * Wrap-around to R0 15810000
.GEN_A_G1 ANOP , * TO_REG now next register nr 15820000
&FROM_REG SETA &FROM_REG+1 * Next src reg nr 15830000
AIF (&FROM_REG LT 16).GEN_A_G2 * Valid register nr 15840000
&FROM_REG SETA 0 * Wrap-around to AR0 15850000
.GEN_A_G2 ANOP , * FROM_REG now next register nr 15860000
® SETC 'R'.'&TO_REG' * Create next dest.reg name 15870000
&ODDREG SETC 'AR'.'&FROM_REG' * Create next src.reg name 15880000
EAR ®,&ODDREG * Copy ALET 15890000
AGO .GEN_A_G0 * 15900000
.* 15910000
.* From type c: Control Register 15920000
.GEN_C ANOP , * 15930000
AIF ('&TO_TP' EQ 'B').GEN_CB * CPY CR to binary 15940000
AIF ('&TO_TP' EQ 'X').GEN_CB * CPY CR to binary 15950000
AGO .ERR7B * Unsupported combination 15960000
.* 15970000
.* Copy control register(s) to an unsigned binary field 15980000
.GEN_CB ANOP , * 15990000
AIF (&TO_LEN NE &FROM_LEN).ERR7C * Lengths equal? 16000000
AGO .DO_STCTL * Go generate STCTL instruction 16010000
.* 16020000
.* From type f: Floating Point Register 16030000
.GEN_F ANOP , * 16040000
AIF ('&TO_TP' EQ 'D').GEN_FD * CPY FPR to long 16050000
AIF ('&TO_TP' EQ 'E').GEN_FE * CPY FPR to short 16060000
AIF ('&TO_TP' EQ 'K').GEN_FK * CPY FRP to float field 16070000
AIF ('&TO_TP' EQ 'L').GEN_FL * CPY FPR to extended 16080000
AIF ('&TO_TP' EQ 'f').GEN_F_F * CPY FPR to FPR 16090000
AGO .ERR7B * Unsupported combination 16100000
.* 16110000
.* Copy floating point register(s) to long field(s) 16120000
.GEN_FD ANOP , * 16130000
AIF (&TO_LEN NE &FROM_LEN).ERR7C * Lengths equal? 16140000
AIF (&TO_LEN EQ 8).DO_STD * Generate 1 STD 16150000
AGO .GENSTDM * Generate several STDs 16160000
.* 16170000
.* Copy floating point register(s) to short field(s) 16180000
.GEN_FE ANOP , * 16190000
AIF (2*&TO_LEN NE &FROM_LEN).ERR7C * Lengths equal? 16200000
AIF (&TO_LEN EQ 4).DO_STE * Generate 1 STE 16210000
AGO .GENSTEM * Generate several STEs 16220000
.* 16230000
.* Copy floating point register to floating field (any length) 16240000
.GEN_FK ANOP , * 16250000
AIF (&FROM_LEN GT 16).ERR7W * Cannot save more than 2 regs 16260000
AIF (&FROM_LEN EQ 16).GEN_FK1 * Store extended operand! 16270000
.* Handle 1 register 16280000
AIF (&TO_LEN LT 4).ERR7I * Dest.field too short 16290000
AIF (&TO_LEN GE 8).GEN_FK0 * Go save long operand 16300000
.* Handle short operand 16310000
&PAD_LEN SETA &TO_LEN-4 * Nr of trailing zeroes required 16320000
AIF (&PAD_LEN EQ 0).GEN_FE * No padding: store short 16330000
&_LABEL CLEAR (&_TO1+4,&PAD_LEN),,XC * Wipe trailer area 16340000
&_LABEL SETC '' * Remove generated label 16350000
&TO_LEN SETA 4 * Length of area to fill 16360000
AGO .GEN_FE * Go store 1 short operand 16370000
.GEN_FK0 ANOP , * Must store a long operand 16380000
&PAD_LEN SETA &TO_LEN-8 * Nr of trailing zeroes required 16390000
AIF (&PAD_LEN EQ 0).GEN_FD * No padding: store long 16400000
&_LABEL CLEAR (&_TO1+8,&PAD_LEN),,XC * Wipe trailer area 16410000
&_LABEL SETC '' * Remove generated label 16420000
&TO_LEN SETA 8 * Length of area to fill 16430000
AGO .GEN_FD * Go store 1 long operand 16440000
.GEN_FK1 ANOP , * Must store an extended operand 16450000
AIF (&TO_LEN LT 16).ERR7I * Dest.field too short 16460000
&PAD_LEN SETA &TO_LEN-16 * Nr of trailing zeroes required 16470000
AIF (&PAD_LEN EQ 0).GEN_FK2 *=GEN_FL2 16480000
&_LABEL CLEAR (&_TO1+16,&PAD_LEN),,XC * Wipe trailer area 16490000
&_LABEL SETC '' * Remove generated label 16500000
&TO_LEN SETA 16 * Length of area to fill 16510000
AGO .GEN_FK2 *=GEN_FL2 16520000
.* 16530000
.* Copy floating point register(s) to extended field(s) 16540000
.GEN_FL ANOP , * 16550000
AIF (K'&_FROM2 EQ 0).GEN_FL1 * Just a register spec'd? 16560000
AIF (NOT &FROM_EREG).GEN_FL2 * End register specified? 16570000
.GEN_FL1 ANOP , * 16580000
&FROM_LEN SETA &FROM_LEN+8 * Yes: add length of odd reg 16590000
.GEN_FK2 ANOP , * Must store an extended operand 16600000
.GEN_FL2 ANOP , * &FROM_LEN is now correct 16610000
AIF (&TO_LEN NE &FROM_LEN).ERR7C * Lengths equal? 16620000
AGO .GENSTXM * Generate several STDs 16630000
.* 16640000
.* Copy floating point register(s) to FP register(s) 16650000
.GEN_F_F ANOP , * 16660000
AIF (&TO_LEN NE &FROM_LEN).ERR7C * Lengths equal? 16670000
&_LABEL LDR &_TO1,&_FROM1 * Copy 16680000
&_LABEL SETC '' * Remove used label 16690000
AIF (&TO_LEN EQ 8).MEXIT * 1 register only to copy? 16700000
.GEN_F_F0 ANOP , * Loop to copy FPRs 16710000
&TO_LEN SETA &TO_LEN-8 * Reduce length 16720000
AIF (&TO_LEN LT 8).MEXIT * No registers left to copy 16730000
&TO_REG SETA &TO_REG+2 * Next dest reg nr 16740000
AIF (&TO_REG LT 8).GEN_F_F1 * Valid register nr 16750000
&TO_REG SETA 0 * Wrap-around to FPR0 16760000
.GEN_F_F1 ANOP , * TO_REG now next register nr 16770000
&FROM_REG SETA &FROM_REG+2 * Next src reg nr 16780000
AIF (&FROM_REG LT 8).GEN_F_F2 * Valid register nr 16790000
&FROM_REG SETA 0 * Wrap-around to FPR0 16800000
.GEN_F_F2 ANOP , * FROM_REG now next register nr 16810000
® SETC 'FPR'.'&TO_REG' * Create next dest.reg name 16820000
&ODDREG SETC 'FPR'.'&FROM_REG' * Create next src.reg name 16830000
LDR ®,&ODDREG * Copy 16840000
AGO .GEN_F_F0 * 16850000
.* 16860000
.* From type g: General Purpose Register 16870000
.GEN_G ANOP , * 16880000
AIF ('&TO_TP' EQ 'A').GEN_GA * CPY reg to address 16890000
AIF ('&TO_TP' EQ 'B').GEN_GB * CPY reg to unsigned 16900000
AIF ('&TO_TP' EQ 'F').GEN_GF * CPY reg to signed 16910000
AIF ('&TO_TP' EQ 'G').GEN_GG * CPY reg to signed 16920000
AIF ('&TO_TP' EQ 'H').GEN_GH * CPY reg to signed 16930000
AIF ('&TO_TP' EQ 'P').GEN_GP * CPY reg to packed decimal 16940000
AIF ('&TO_TP' EQ 'Q').GEN_GA * CPY reg to address 16950000
AIF ('&TO_TP' EQ 'R').GEN_GR * CPY reg to address 16960000
AIF ('&TO_TP' EQ 'V').GEN_GA * CPY reg to address 16970000
AIF ('&TO_TP' EQ 'X').GEN_GB * CPY reg to unsigned 16980000
AIF ('&TO_TP' EQ 'Y').GEN_GY * CPY reg to address 16990000
AIF ('&TO_TP' EQ 'a').GEN_G_A * CPY reg to access register 17000000
AIF ('&TO_TP' EQ 'g').GEN_G_G * CPY reg to reg 17010000
AGO .ERR7B * Unsupported combination 17020000
.* 17030000
.* Copy from register(s) to address field(s) 17040000
.GEN_GA ANOP , * 17050000
AIF (&FROM_LEN EQ 4).GEN_GA1 * Just 1 register? 17060000
AIF (&TO_LEN NE &FROM_LEN).ERR7C * Lengths equal? 17070000
AGO .DO_STM * Generate 1 STM 17080000
.GEN_GA1 ANOP , * Only 1 register to save 17090000
AIF (&TO_LEN EQ 4).DO_ST * Generate 1 ST 17100000
AIF (&TO_LEN LT 4).GEN_GA2 * Use STCM to save 17110000
&PAD_LEN SETA &TO_LEN-4 * Nr of leading zeros needed 17120000
&_LABEL CLEAR (&_TO1,&PAD_LEN),,XC * Insert leading zeros 17130000
&_LABEL SETC '' * Remove used label 17140000
&_TO1 SETC '&_TO1'.'+&PAD_LEN' * Advance destination field 17150000
&TO_LEN SETA 4 * 4 bytes remain unfilled 17160000
&I SETA &PAD_LEN/4 * Nr of words padded 17170000
&J SETA &PAD_LEN-(4*&I) * Nr of extra bytes padded 17180000
AIF (&J EQ 0).DO_ST * Go generate a ST 17190000
.GEN_GA2 ANOP , * STCM required 17200000
.GEN_GR2 ANOP , * Entry from reg-to-unaligned 17210000
.GEN_GY2 ANOP , * Entry from reg-to-halfword 17220000
&MASK SETC 'NNNY' * Mask for a 1-byte field 17230000
AIF (&TO_LEN EQ 1).DO_STCM * Go save byte 17240000
&MASK SETC 'NNYY' * Mask for a 2-byte field 17250000
AIF (&TO_LEN EQ 2).DO_STCM * Go save bytes 17260000
&MASK SETC 'NYYY' * Mask for a 3-byte field 17270000
AIF (&TO_LEN EQ 3).DO_STCM * Go save bytes 17280000
&MASK SETC 'YYYY' * Mask for a 4-byte field 17290000
AGO .DO_STCM * Go save bytes 17300000
.* 17310000
.* Copy from register(s) to unsigned binary field(s) 17320000
.GEN_GB ANOP , * 17330000
AIF (&FROM_LEN EQ 4).GEN_GB1 * Just 1 register? 17340000
AIF (&TO_LEN NE &FROM_LEN).ERR7C * Lengths equal? 17350000
AGO .GENSTCMM * Generate multiple STCMs 17360000
.GEN_GB1 ANOP , * Only 1 register to save 17370000
&MASK SETC 'YYYY' * 17380000
AIF (&TO_LEN EQ 4).DO_STCM * Generate 1 ST 17390000
AIF (&TO_LEN LT 4).GEN_GB2 * Use STCM to save 17400000
&PAD_LEN SETA &TO_LEN-4 * Nr of leading zeros needed 17410000
&_LABEL CLEAR (&_TO1,&PAD_LEN),,XC * Insert leading zeros 17420000
&_LABEL SETC '' * Remove used label 17430000
&_TO1 SETC '&_TO1'.'+&PAD_LEN' * Advance destination field 17440000
AGO .DO_STCM * Go generate a STCM 17450000
.GEN_GB2 ANOP , * STCM required 17460000
.GEN_GF2 ANOP , * Entry from reg-to-fullword 17470000
.GEN_GG2 ANOP , * Entry from reg-to-signed 17480000
.GEN_GH2 ANOP , * Entry from reg-to-halfword 17490000
&MASK SETC 'NNNY' * Mask for a 1-byte field 17500000
AIF (&TO_LEN EQ 1).DO_STCM * Go save byte 17510000
&MASK SETC 'NNYY' * Mask for a 2-byte field 17520000
AIF (&TO_LEN EQ 2).DO_STCM * Go save bytes 17530000
&MASK SETC 'NYYY' * Mask for a 3-byte field 17540000
AIF (&TO_LEN EQ 3).DO_STCM * Go save bytes 17550000
&MASK SETC 'YYYY' * Mask for a 4-byte field 17560000
AGO .DO_STCM * Go save bytes 17570000
.* 17580000
.* Copy from register(s) to signed binary fullword(s) 17590000
.GEN_GF ANOP , * 17600000
AIF (&FROM_LEN EQ 4).GEN_GF1 * Just 1 register? 17610000
AIF (&TO_LEN NE &FROM_LEN).ERR7C * Lengths equal? 17620000
AGO .DO_STM * Generate 1 STM 17630000
.GEN_GF1 ANOP , * Only 1 register to save 17640000
AIF (&TO_LEN EQ 4).DO_ST * Generate 1 ST 17650000
AIF (&TO_LEN EQ 2).DO_STH * Generate 1 STH 17660000
AIF (&TO_LEN LE 4).GEN_GF2 *=GEN_GB2 17670000
&PAD_LEN SETA &TO_LEN-4 * Nr of leading zeros needed 17680000
EQUREG TEMP=YES,R0=YES * Find available register 17690000
AIF (&BXA_RC NE 0).ERR7H * None found! 17700000
® SETC 'R'.'&BXA_NUMVAL' * Create workreg name 17710000
&_LABEL LR ®,&_FROM1 * Copy value to save 17720000
&_LABEL SETC '' * Remove used label 17730000
&MASK SETC 'YYYY' * Mask to save register 17740000
&PAD_ADR SETC '&_TO1' * Save destination 17750000
&_TO1 SETC '&_TO1'.'+&PAD_LEN' * Create destination for data 17760000
SRA ®,31 * Create all sign bits 17770000
AIF (&PAD_LEN GT 8).GEN_GF6 * 17780000
AIF (&PAD_LEN EQ 1).GEN_GF3 * 17790000
AIF (&PAD_LEN EQ 2).GEN_GF4 * 17800000
AIF (&PAD_LEN EQ 3).GEN_GF5 * 17810000
ST ®,&PAD_ADR * First set of lead sign bytes 17820000
&PAD_ADR SETC '&PAD_ADR'.'+4' * Adjust pad-area pointer 17830000
AIF (&PAD_LEN EQ 4).DO_ST * Ok: save register 17840000
AIF (&PAD_LEN EQ 5).GEN_GF3 * 17850000
AIF (&PAD_LEN EQ 6).GEN_GF4 * 17860000
AIF (&PAD_LEN EQ 7).GEN_GF5 * 17870000
ST ®,&PAD_ADR * Fill up to 8 lead sign bytes 17880000
AGO .DO_ST * Go save register 17890000
.GEN_GF3 ANOP , * 1 leading sign byte 17900000
STC ®,&PAD_ADR * 17910000
AGO .DO_STCM * Go save register 17920000
.GEN_GF4 ANOP , * 2 leading sign bytes 17930000
STH ®,&PAD_ADR * 17940000
AGO .DO_STCM * Go save register 17950000
.GEN_GF5 ANOP , * 3 leading sign bytes 17960000
STCM ®,YYYN,&PAD_ADR * 17970000
AGO .DO_STCM * Go save register 17980000
.GEN_GF6 ANOP , * More than 8 leading sign bytes 17990000
ST ®,&PAD_ADR * Insert leading sign bytes 18000000
MVC &PAD_ADR+4(&PAD_LEN-4),&PAD_ADR * Propagate sign 18010000
&I SETA &PAD_LEN/4 * Nr of words padded 18020000
&I SETA &PAD_LEN-(4*&I) * Nr of extra bytes padded 18030000
AIF (&I EQ 0).DO_ST * Still aligned: use ST 18040000
AGO .DO_STCM * Go save register 18050000
.* 18060000
.* Copy from register(s) to signed binary field(s) 18070000
.GEN_GG ANOP , * 18080000
AIF (&FROM_LEN EQ 4).GEN_GG1 * Just 1 register? 18090000
AIF (&TO_LEN NE &FROM_LEN).ERR7C * Lengths equal? 18100000
AGO .GENSTCMM * Generate multiple STCMs 18110000
.GEN_GG1 ANOP , * Only 1 register to save 18120000
AIF (&TO_LEN LE 4).GEN_GG2 *=GEN_GB2 18130000
&PAD_LEN SETA &TO_LEN-4 * Nr of leading zeros needed 18140000
EQUREG TEMP=YES,R0=YES * Find available register 18150000
AIF (&BXA_RC NE 0).ERR7H * None found! 18160000
® SETC 'R'.'&BXA_NUMVAL' * Create workreg name 18170000
&_LABEL LR ®,&_FROM1 * Copy value to save 18180000
&_LABEL SETC '' * Remove used label 18190000
&MASK SETC 'YYYY' * Mask to save register 18200000
&PAD_ADR SETC '&_TO1' * Save destination 18210000
&_TO1 SETC '&_TO1'.'+&PAD_LEN' * Create destination for data 18220000
SRA ®,31 * Create all sign bits 18230000
AIF (&PAD_LEN GT 8).GEN_GG6 * 18240000
AIF (&PAD_LEN EQ 1).GEN_GG3 * 18250000
AIF (&PAD_LEN EQ 2).GEN_GG4 * 18260000
AIF (&PAD_LEN EQ 3).GEN_GG5 * 18270000
STCM ®,YYYY,&PAD_ADR * First set of lead sign bytes 18280000
&PAD_ADR SETC '&PAD_ADR'.'+4' * Adjust pad-area pointer 18290000
AIF (&PAD_LEN EQ 4).DO_STCM * Ok: save register 18300000
AIF (&PAD_LEN EQ 5).GEN_GG3 * 18310000
AIF (&PAD_LEN EQ 6).GEN_GG4 * 18320000
AIF (&PAD_LEN EQ 7).GEN_GG5 * 18330000
STCM ®,YYYY,&PAD_ADR * Fill up to 8 lead sign bytes 18340000
AGO .DO_STCM * Go save register 18350000
.GEN_GG3 ANOP , * 1 leading sign byte 18360000
STC ®,&PAD_ADR * 18370000
AGO .DO_STCM * Go save register 18380000
.GEN_GG4 ANOP , * 2 leading sign bytes 18390000
STCM ®,YYNN,&PAD_ADR * 18400000
AGO .DO_STCM * Go save register 18410000
.GEN_GG5 ANOP , * 3 leading sign bytes 18420000
STCM ®,YYYN,&PAD_ADR * 18430000
AGO .DO_STCM * Go save register 18440000
.GEN_GG6 ANOP , * More than 8 leading sign bytes 18450000
STCM ®,YYYY,&PAD_ADR * 18460000
MVC &PAD_ADR+4(&PAD_LEN-4),&PAD_ADR * Propagate sign 18470000
AGO .DO_STCM * Go save register 18480000
.* 18490000
.* Copy from register(s) to signed binary halfword(s) 18500000
.GEN_GH ANOP , * 18510000
AIF (&FROM_LEN EQ 4).GEN_GH1 * Just 1 register? 18520000
AIF (2*&TO_LEN NE &FROM_LEN).ERR7C * Lengths equal? 18530000
AGO .GENSTHM * Generate multiple STHs 18540000
.GEN_GH1 ANOP , * Only 1 register to save 18550000
AIF (&TO_LEN EQ 2).DO_STH * Generate 1 STH 18560000
AIF (&TO_LEN LE 4).GEN_GH2 *=GEN_GB2 18570000
&PAD_LEN SETA &TO_LEN-4 * Nr of leading zeros needed 18580000
EQUREG TEMP=YES,R0=YES * Find available register 18590000
AIF (&BXA_RC NE 0).ERR7H * None found! 18600000
® SETC 'R'.'&BXA_NUMVAL' * Create workreg name 18610000
&_LABEL LR ®,&_FROM1 * Copy value to save 18620000
&_LABEL SETC '' * Remove used label 18630000
&MASK SETC 'YYYY' * Mask to save register 18640000
&PAD_ADR SETC '&_TO1' * Save destination 18650000
&_TO1 SETC '&_TO1'.'+&PAD_LEN' * Create destination for data 18660000
SRA ®,31 * Create all sign bits 18670000
AIF (&PAD_LEN GT 8).GEN_GH6 * 18680000
AIF (&PAD_LEN EQ 1).GEN_GH3 * 18690000
AIF (&PAD_LEN EQ 2).GEN_GH4 * 18700000
AIF (&PAD_LEN EQ 3).GEN_GH5 * 18710000
STCM ®,YYYY,&PAD_ADR * First set of lead sign bytes 18720000
&PAD_ADR SETC '&PAD_ADR'.'+4' * Adjust pad-area pointer 18730000
AIF (&PAD_LEN EQ 4).DO_STCM * Ok: save register 18740000
AIF (&PAD_LEN EQ 5).GEN_GH3 * 18750000
AIF (&PAD_LEN EQ 6).GEN_GH4 * 18760000
AIF (&PAD_LEN EQ 7).GEN_GH5 * 18770000
STCM ®,YYYY,&PAD_ADR * Fill up to 8 lead sign bytes 18780000
AGO .DO_STCM * Go save register 18790000
.GEN_GH3 ANOP , * 1 leading sign byte 18800000
STC ®,&PAD_ADR * 18810000
AGO .DO_STCM * Go save register 18820000
.GEN_GH4 ANOP , * 2 leading sign bytes 18830000
STH ®,&PAD_ADR * 18840000
AGO .DO_STCM * Go save register 18850000
.GEN_GH5 ANOP , * 3 leading sign bytes 18860000
STCM ®,YYYN,&PAD_ADR * 18870000
AGO .DO_STCM * Go save register 18880000
.GEN_GH6 ANOP , * More than 8 leading sign bytes 18890000
STH ®,&PAD_ADR * Insert leading sign bytes 18900000
MVC &PAD_ADR+2(&PAD_LEN-2),&PAD_ADR * Propagate sign 18910000
AGO .DO_STCM * Go save register 18920000
.* 18930000
.* Copy from register(s) to packed decimal number(s) 18940000
.GEN_GP ANOP , * 18950000
AIF (&FROM_LEN EQ 4).GEN_GP1 * Just 1 register? 18960000
AIF (&TO_LEN NE 2*&FROM_LEN).ERR7C * Lengths equal? 18970000
AGO .GENCVDM * Generate multiple CVDs 18980000
.GEN_GP1 ANOP , * Only 1 register to save 18990000
AIF (&TO_LEN LT 8).ERR7I * 19000000
&PAD_LEN SETA &TO_LEN-8 * Nr of leading zeros needed 19010000
AIF (&PAD_LEN LT 1).GEN_GP2 * None needed 19020000
&_LABEL CLEAR (&_TO1,&PAD_LEN),,XC * Create leading zeros 19030000
&_LABEL SETC '' * Remove used-up label 19040000
&_TO1 SETC '&_TO1'.'+&PAD_LEN' * Advance destination pointer 19050000
.GEN_GP2 ANOP , * 19060000
&_LABEL CVD &_FROM1,&_TO1 * 19070000
MEXIT , * 19080000
.* 19090000
.* Copy from register(s) to unaligned address field(s) 19100000
.GEN_GR ANOP , * 19110000
AIF (&FROM_LEN EQ 4).GEN_GR1 * Just 1 register? 19120000
AIF (&TO_LEN NE &FROM_LEN).ERR7C * Lengths equal? 19130000
AGO .GENSTCMM * Generate multiple STCMs 19140000
.GEN_GR1 ANOP , * Only 1 register to save 19150000
&MASK SETC 'YYYY' * Set default mask for STCM 19160000
AIF (&TO_LEN EQ 4).DO_STCM * Generate 1 ST 19170000
AIF (&TO_LEN LT 4).GEN_GR2 *=GEN_GA2 19180000
&PAD_LEN SETA &TO_LEN-4 * Nr of leading zeros needed 19190000
&_LABEL CLEAR (&_TO1,&PAD_LEN),,XC * Insert leading zeros 19200000
&_LABEL SETC '' * Remove used label 19210000
&_TO1 SETC '&_TO1'.'+&PAD_LEN' * Advance destination field 19220000
AGO .DO_STCM * Go generate a STCM 19230000
.* 19240000
.* Copy from register(s) to halfword address field(s) 19250000
.GEN_GY ANOP , * 19260000
AIF (&FROM_LEN EQ 4).GEN_GY1 * Just 1 register? 19270000
AIF (2*&TO_LEN NE &FROM_LEN).ERR7C * Lengths equal? 19280000
AGO .GENSTHM * Generate multiple STHs 19290000
.GEN_GY1 ANOP , * Only 1 register to save 19300000
AIF (&TO_LEN EQ 2).DO_STH * Generate 1 STH 19310000
AIF (&TO_LEN LT 4).GEN_GY2 *=.GEN_GA2 19320000
&PAD_LEN SETA &TO_LEN-4 * Nr of leading zeros needed 19330000
&MASK SETC 'YYYY' * Default mask for STCM 19340000
AIF (&PAD_LEN LT 1).DO_STCM * 19350000
&_LABEL CLEAR (&_TO1,&PAD_LEN),,XC * Insert leading zeros 19360000
&_LABEL SETC '' * Remove used label 19370000
&_TO1 SETC '&_TO1'.'+&PAD_LEN' * Advance destination field 19380000
&TO_LEN SETA 4 * 4 bytes remain unfilled 19390000
AGO .GEN_GY2 *=.GEN_GA2 19400000
.* 19410000
.* Copy register(s) to access register(s) 19420000
.GEN_G_A ANOP , * 19430000
AIF (&TO_LEN NE &FROM_LEN).ERR7C * Lengths equal? 19440000
&_LABEL SAR &_TO1,&_FROM1 * Copy ALET 19450000
&_LABEL SETC '' * Remove used label 19460000
AIF (&TO_LEN EQ 4).MEXIT * 1 register only to copy? 19470000
.GEN_G_A0 ANOP , * Loop to copy ARs 19480000
&TO_LEN SETA &TO_LEN-4 * Reduce length 19490000
AIF (&TO_LEN LT 4).MEXIT * No registers left to copy 19500000
&TO_REG SETA &TO_REG+1 * Next dest reg nr 19510000
AIF (&TO_REG LT 16).GEN_G_A1 * Valid register nr 19520000
&TO_REG SETA 0 * Wrap-around to R0 19530000
.GEN_G_A1 ANOP , * TO_REG now next register nr 19540000
&FROM_REG SETA &FROM_REG+1 * Next src reg nr 19550000
AIF (&FROM_REG LT 16).GEN_G_A2 * Valid register nr 19560000
&FROM_REG SETA 0 * Wrap-around to AR0 19570000
.GEN_G_A2 ANOP , * FROM_REG now next register nr 19580000
® SETC 'R'.'&FROM_REG' * Create next src.reg name 19590000
&ODDREG SETC 'AR'.'&TO_REG' * Create next dest.reg name 19600000
SAR &ODDREG,® * Copy ALET 19610000
AGO .GEN_G_A0 * 19620000
.* 19630000
.* Copy register(s) to register(s) 19640000
.GEN_G_G ANOP , * 19650000
AIF (&TO_LEN NE &FROM_LEN).ERR7C * Lengths equal? 19660000
&_LABEL LR &_TO1,&_FROM1 * Copy register 19670000
&_LABEL SETC '' * Remove used label 19680000
AIF (&TO_LEN EQ 4).MEXIT * 1 register only to copy? 19690000
.GEN_G_G0 ANOP , * Loop to copy regs 19700000
&TO_LEN SETA &TO_LEN-4 * Reduce length 19710000
AIF (&TO_LEN LT 4).MEXIT * No registers left to copy 19720000
&TO_REG SETA &TO_REG+1 * Next dest reg nr 19730000
AIF (&TO_REG LT 16).GEN_G_G1 * Valid register nr 19740000
&TO_REG SETA 0 * Wrap-around to R0 19750000
.GEN_G_G1 ANOP , * TO_REG now next register nr 19760000
&FROM_REG SETA &FROM_REG+1 * Next src reg nr 19770000
AIF (&FROM_REG LT 16).GEN_G_G2 * Valid register nr 19780000
&FROM_REG SETA 0 * Wrap-around to AR0 19790000
.GEN_G_G2 ANOP , * FROM_REG now next register nr 19800000
® SETC 'R'.'&FROM_REG' * Create next src.reg name 19810000
&ODDREG SETC 'R'.'&TO_REG' * Create next dest.reg name 19820000
LR &ODDREG,® * Copy register 19830000
AGO .GEN_G_G0 * 19840000
.* 19850000
.* From type ga: Combined general purpose and access registers 19860000
.GEN_GA_ ANOP , * 19870000
AIF ('&TO_TP' EQ 'ga').GEN_GA_GA * CPY regs to regs 19880000
AGO .ERR7B * Unsupported combination 19890000
.* 19900000
.* Copy combined GPR-AR pairs 19910000
.GEN_GA_GA ANOP , * 19920000
AIF (&TO_LEN NE &FROM_LEN).ERR7C * Lengths equal? 19930000
AGO .GENLAEM * 19940000
.* 19950000
.* From type p: pointered data field 19960000
.GEN_P ANOP , * 19970000
AIF ('&TO_TP' EQ 'p').DO_MVCL * CPY pointered to pointered 19980000
AGO .ERR7B * Unsupported combination 19990000
.* 20000000
.* From type *STACK: Stacked registers 20010000
.GENSTACK ANOP , * 20020000
&FROM_TP SETC '*STACK' * 20030000
AIF ('&TO_TP' EQ 'ga').DO_EREG * CPY stack to registers 20040000
AGO .ERR7B * Unsupported combination 20050000
.* 20060000
.* Load several registers with packed data 20070000
.GENCVBM ANOP , * 20080000
&I SETA &TO_REG * Save first register number 20090000
&J SETA 0 * Offset in source field 20100000
.GENCVBM0 ANOP , * Loop 20110000
&_LABEL CVB &_TO1,&_FROM1+&J * 20120000
&_LABEL SETC '' * Remove label after use 20130000
&TO_LEN SETA &TO_LEN-4 * Reduce length 20140000
AIF (&TO_LEN LT 4).MEXIT * No registers left to fill 20150000
&J SETA &J+8 * Point next short field 20160000
&I SETA &I+1 * Next register number 20170000
AIF (&I LT 16).GENCVBM1 * Valid register nr 20180000
&I SETA 0 * Wrap-around to R0 20190000
.GENCVBM1 ANOP , * I now next register nr 20200000
&_TO1 SETC 'R'.'&I' * Create next register name 20210000
AGO .GENCVBM0 * 20220000
.* 20230000
.* Store several registers as packed data 20240000
.GENCVDM ANOP , * 20250000
&I SETA &FROM_REG * Save first register number 20260000
&J SETA 0 * Offset in source field 20270000
.GENCVDM0 ANOP , * Loop 20280000
&_LABEL CVD &_FROM1,&_TO1+&J * 20290000
&_LABEL SETC '' * Remove label after use 20300000
&TO_LEN SETA &TO_LEN-8 * Reduce length 20310000
AIF (&TO_LEN LT 8).MEXIT * No storage left to fill 20320000
&J SETA &J+8 * Point next short field 20330000
&I SETA &I+1 * Next register number 20340000
AIF (&I LT 16).GENCVDM1 * Valid register nr 20350000
&I SETA 0 * Wrap-around to R0 20360000
.GENCVDM1 ANOP , * I now next register nr 20370000
&_FROM1 SETC 'R'.'&I' * Create next register name 20380000
AGO .GENCVDM0 * 20390000
.* 20400000
.* Load a register with an unaligned signed integer 20410000
.GENICM ANOP , * 20420000
&MASK SETC 'YNNN' * Mask for a 1-byte value 20430000
&I SETA 24 * Nr of bytes to shift 20440000
AIF (&FROM_LEN EQ 1).GENICM0 * Go load value 20450000
&MASK SETC 'YYNN' * Mask for a 2-byte value 20460000
&I SETA 16 * Nr of bytes to shift 20470000
AIF (&FROM_LEN EQ 2 AND '&FROM_TP' NE 'G').GENICM1 20480000
AIF (&FROM_LEN EQ 2).GENICM0 * Go load value 20490000
&MASK SETC 'YYYN' * Mask for a 3-byte value 20500000
&I SETA 8 * Nr of bytes to shift 20510000
AIF (&FROM_LEN EQ 3).GENICM0 * Go load value 20520000
&MASK SETC 'YYYY' * MUST be a four-byte value 20530000
AIF (&FROM_LEN EQ 4 AND '&FROM_TP' NE 'F').GENICM0 20540000
AIF (&FROM_LEN EQ 4).GENICM2 * Load aligned fullword 20550000
AIF ('&FROM_TP' EQ 'F').GENICM3 * Oversized, aligned 20560000
AGO .GENICM4 * Oversized, unaligned 20570000
.GENICM0 ANOP , * Use ICM to load value 20580000
&_LABEL ICM &_TO1,&MASK,&_FROM1 * Copy value to register 20590000
&_LABEL SETC '' * Remove used label 20600000
AIF ('&MASK' EQ 'YYYY').MEXIT 20610000
SRA &_TO1,&I * Shift value in register 20620000
MEXIT , * 20630000
.GENICM1 ANOP , * Load aligned halfword 20640000
&_LABEL LH &_TO1,&_FROM1 * Copy value to register 20650000
MEXIT , * 20660000
.GENICM2 ANOP , * Load aligned fullword 20670000
&_LABEL L &_TO1,&_FROM1 * Copy value to register 20680000
MEXIT , * 20690000
.GENICM3 ANOP , * Load/truncate from Fullword 20700000
&I SETA &FROM_LEN-4 * Offset in source field 20710000
&J SETA &I/4 * Nr of words in offset 20720000
&J SETA &I-(4*&J) * Nr of excess bytes 20730000
AIF (&J NE 0).GENICM4 * Go load unaligned 'word' 20740000
&_LABEL L &_TO1,&_FROM1+&I * Copy value to register 20750000
MEXIT , * 20760000
.GENICM4 ANOP , * Load/truncate unaligned 20770000
&I SETA &FROM_LEN-4 * Offset in source field 20780000
&_LABEL ICM &_TO1,YYYY,&_FROM1+&I * Copy value to register 20790000
MEXIT , * 20800000
.* 20810000
.* Load several registers with unaligned data 20820000
.GENICMM ANOP , * 20830000
&I SETA &TO_REG * Save first register number 20840000
&J SETA 0 * Offset in source field 20850000
.GENICMM0 ANOP , * Loop 20860000
&_LABEL ICM &_TO1,YYYY,&_FROM1+&J * 20870000
&_LABEL SETC '' * Remove label after use 20880000
&TO_LEN SETA &TO_LEN-4 * Reduce length 20890000
AIF (&TO_LEN LT 4).MEXIT * No registers left to fill 20900000
&J SETA &J+4 * Point next long field 20910000
&I SETA &I+1 * Next register number 20920000
AIF (&I LT 16).GENICMM1 * Valid register nr 20930000
&I SETA 0 * Wrap-around to R0 20940000
.GENICMM1 ANOP , * I now next register nr 20950000
&_TO1 SETC 'R'.'&I' * Create next register name 20960000
AGO .GENICMM0 * 20970000
.* 20980000
.* Copy alet-qualified addresses register to register 20990000
.GENLAEM ANOP , * 21000000
AIF ('&SYSASCE' EQ 'P').GENLAEMP * Primary mode! 21010000
&_LABEL LAE &_TO1,0(0,&_FROM1) * Copy ALET and address 21020000
&_LABEL SETC '' * Remove used label 21030000
AIF (&TO_LEN EQ 4).MEXIT * 1 register only to copy? 21040000
AGO .GENLAEM0 * 21050000
.GENLAEMP ANOP , * 21060000
&_LABEL LR &_TO1,&_FROM1 * Copy address 21070000
CPYA &_TO2,&_FROM2 * and ALET 21080000
&_LABEL SETC '' * Remove used label 21090000
AIF (&TO_LEN EQ 4).MEXIT * 1 register only to copy? 21100000
.GENLAEM0 ANOP , * Loop to copy register pairs 21110000
&TO_LEN SETA &TO_LEN-4 * Reduce length 21120000
AIF (&TO_LEN LT 4).MEXIT * No registers left to copy 21130000
&TO_REG SETA &TO_REG+1 * Next dest reg nr 21140000
AIF (&TO_REG LT 16).GENLAEM1 * Valid register nr 21150000
&TO_REG SETA 0 * Wrap-around to R0 21160000
.GENLAEM1 ANOP , * TO_REG now next register nr 21170000
&FROM_REG SETA &FROM_REG+1 * Next src reg nr 21180000
AIF (&FROM_REG LT 16).GENLAEM2 * Valid register nr 21190000
&FROM_REG SETA 0 * Wrap-around to R0 21200000
.GENLAEM2 ANOP , * FROM_REG now next register nr 21210000
&_TO1 SETC 'R'.'&TO_REG' * Create next dest.reg name 21220000
&_FROM1 SETC 'R'.'&FROM_REG' * Create next src.reg name 21230000
AIF ('&SYSASCE' EQ 'P').GENLAEM3 * Primary mode! 21240000
LAE &_TO1,0(0,&_FROM1) * Copy ALET and address 21250000
AGO .GENLAEM0 * 21260000
.GENLAEM3 ANOP , * Copy addr+ALET in primary mode 21270000
&_TO2 SETC 'AR'.'&TO_REG' * Create next dest.reg name 21280000
&_FROM2 SETC 'AR'.'&FROM_REG' * Create next src.reg name 21290000
LR &_TO1,&_FROM1 * Copy address 21300000
CPYA &_TO2,&_FROM2 * and ALET 21310000
AGO .GENLAEM0 * 21320000
.* 21330000
.* Load several floating point registers with long operands 21340000
.GENLDM ANOP , * 21350000
&I SETA &TO_REG * Save first register number 21360000
&J SETA 0 * Offset in source field 21370000
.GENLDM0 ANOP , * Loop 21380000
&_LABEL LD &_TO1,&_FROM1+&J * 21390000
&_LABEL SETC '' * Remove label after use 21400000
&TO_LEN SETA &TO_LEN-8 * Reduce length 21410000
AIF (&TO_LEN LT 8).MEXIT * No registers left to fill 21420000
&J SETA &J+8 * Point next long field 21430000
&I SETA &I+2 * Next register number 21440000
AIF (&I LT 8).GENLDM1 * Valid register nr 21450000
&I SETA 0 * Wrap-around to FPR0 21460000
.GENLDM1 ANOP , * I now next register nr 21470000
&_TO1 SETC 'FPR'.'&I' * Create next register name 21480000
AGO .GENLDM0 * 21490000
.* 21500000
.* Load several floating point registers with short operands 21510000
.GENLEM ANOP , * 21520000
&I SETA &TO_REG * Save first register number 21530000
&J SETA 0 * Offset in source field 21540000
.GENLEM0 ANOP , * Loop 21550000
&_LABEL LE &_TO1,&_FROM1+&J * 21560000
&_LABEL SETC '' * Remove label after use 21570000
&TO_LEN SETA &TO_LEN-8 * Reduce length 21580000
AIF (&TO_LEN LT 8).MEXIT * No registers left to fill 21590000
&J SETA &J+4 * Point next short field 21600000
&I SETA &I+2 * Next register number 21610000
AIF (&I LT 8).GENLEM1 * Valid register nr 21620000
&I SETA 0 * Wrap-around to FPR0 21630000
.GENLEM1 ANOP , * I now next register nr 21640000
&_TO1 SETC 'FPR'.'&I' * Create next register name 21650000
AGO .GENLEM0 * 21660000
.* 21670000
.* Load several halfwords into registers 21680000
.GENLHM ANOP , * 21690000
&I SETA &TO_REG * Save first register number 21700000
&J SETA 0 * Offset in source field 21710000
.GENLHM0 ANOP , * Loop 21720000
&_LABEL LH &_TO1,&_FROM1+&J * 21730000
&_LABEL SETC '' * Remove label after use 21740000
&TO_LEN SETA &TO_LEN-4 * Reduce length 21750000
AIF (&TO_LEN LT 4).MEXIT * No registers left to fill 21760000
&J SETA &J+2 * Point next short field 21770000
&I SETA &I+1 * Next register number 21780000
AIF (&I LT 16).GENLHM1 * Valid register nr 21790000
&I SETA 0 * Wrap-around to R0 21800000
.GENLHM1 ANOP , * I now next register nr 21810000
&_TO1 SETC 'R'.'&I' * Create next register name 21820000
AGO .GENLHM0 * 21830000
.* 21840000
.* Load several floating point registers with extended operands 21850000
.GENLXM ANOP , * 21860000
&I SETA &TO_REG * Save first register number 21870000
AIF (&I NE 0 AND &I NE 4).ERR7M * Not a valid pair! 21880000
&I SETA &I+2 * Nr of next register 21890000
&ODDREG SETC 'FPR'.'&I' * Name of second register 21900000
&J SETA 0 * Offset in source field 21910000
.GENLXM0 ANOP , * Loop 21920000
&_LABEL LD &_TO1,&_FROM1+&J * Load low-order register 21930000
&_LABEL SETC '' * Remove label after use 21940000
&J SETA &J+8 * Point next long field 21950000
LD &ODDREG,&_FROM1+&J * Load high-order register 21960000
&TO_LEN SETA &TO_LEN-16 * Reduce length 21970000
AIF (&TO_LEN LT 16).MEXIT * No registers left to fill 21980000
&J SETA &J+8 * Point next long field 21990000
&I SETA &I+2 * Next register number 22000000
AIF (&I LT 8).GENLXM1 * Valid register nr 22010000
&I SETA 0 * Wrap-around to FPR0 22020000
.GENLXM1 ANOP , * I now next register nr 22030000
&_TO1 SETC 'FPR'.'&I' * Create next register name 22040000
&I SETA &I+2 * Nr of next register 22050000
&ODDREG SETC 'FPR'.'&I' * Name of second register 22060000
AGO .GENLXM0 * 22070000
.* 22080000
.* Copy two character fields 22090000
.GENMVCC ANOP , * 22100000
&PAD0 SETB 0 * Use spaces for padding 22110000
&PAD_LEN SETA 0 * Nr of padding bytes needed 22120000
&LEN SETA &TO_LEN * Determine length of move 22130000
AIF (&TO_LEN LE &FROM_LEN).GENMVCC1 22140000
&LEN SETA &FROM_LEN * FROM-length is shorter 22150000
&PAD_LEN SETA &TO_LEN-&FROM_LEN * Nr of padding bytes needed 22160000
.GENMVCC1 ANOP , * &LEN now effective length 22170000
AIF (&LEN GT 256).GENMVCL * 22180000
AIF (&PAD_LEN GT 256).GENMVCL * 22190000
&TO_LEN SETA &LEN * Truncate destination field 22200000
AIF (&PAD_LEN LT 1).DO_MVC * No padding required: use MVC 22210000
&_LABEL CLEAR (&_TO1+&LEN,&PAD_LEN),C' ' * Wipe padding area 22220000
&_LABEL SETC '' * Label no longer needed 22230000
&TO_LEN SETA &LEN * Set source and destination 22240000
&FROM_LEN SETA &LEN * lengths for data move 22250000
AGO .DO_MVC * 22260000
.* 22270000
.* Set up for a long move 22280000
.GENMVCL ANOP , * 22290000
&LEN SETA &FROM_LEN * Determine effective length 22300000
AIF (&TO_LEN GT &FROM_LEN).GENMVCL0 * Which is shorter 22310000
&LEN SETA &TO_LEN * TO_LEN is shorter 22320000
&FROM_LEN SETA &LEN * Make source length shorter 22330000
.GENMVCL0 ANOP , * Len now contains effective len 22340000
&PAD_LEN SETA &TO_LEN-&LEN * Size of pad-area 22350000
.* If possible: generate MVCL instruction 22360000
AIF (&LEN LT 1024 AND &PAD_LEN LT 1).GENMVCL6 * Multiple MVC 22370000
EQUREG PAIR=YES,TEMP=YES,R0=YES,WARN=NO * Alloc src reg pair 22380000
AIF (&BXA_RC NE 0).GENMVCL2 * Allocation failed 22390000
®_SRCP SETC 'R'.'&BXA_NUMVAL' * Create source ptr reg name 22400000
&BXA_NUMVAL SETA &BXA_NUMVAL+1 * Nr of odd reg in pair 22410000
®_SRCL SETC 'R'.'&BXA_NUMVAL' * Create source len reg name 22420000
USE ®_SRCP * Set registers in use to 22430000
USE ®_SRCL * prevent re-allocation 22440000
EQUREG PAIR=YES,TEMP=YES,R0=YES,WARN=NO * Alloc dest reg pair 22450000
AIF (&BXA_RC NE 0).GENMVCL1 * Allocation failed 22460000
DROP ®_SRCL * Source register pair 22470000
DROP ®_SRCP * no longer needed 22480000
AGO .DO_MVCL * Two pairs of regs available! 22490000
.GENMVCL1 ANOP , * Second pair not available 22500000
DROP ®_SRCL * Source register pair 22510000
DROP ®_SRCP * no longer needed 22520000
.GENMVCL2 ANOP , * 22530000
.* Cannot use MVCL: try to generate a loop 22540000
&PAD_LEN SETA &TO_LEN-&LEN * Determine pad length 22550000
&I SETA &LEN/256 * Nr of loops to perform 22560000
AIF (&I LE 4).GENMVCL6 * Repeat is shorter than loop? 22570000
EQUREG TEMP=YES,WARN=NO * Allocate src pointer 22580000
AIF (&BXA_RC NE 0).GENMVCL6 * Not enough regs 22590000
®_SRCP SETC 'R'.'&BXA_NUMVAL' * Create source ptr reg name 22600000
USE ®_SRCP * Set reg in use 22610000
EQUREG TEMP=YES,WARN=NO * Allocate dest pointer 22620000
AIF (&BXA_RC NE 0).GENMVCL5 * Not enough regs 22630000
®_DSTP SETC 'R'.'&BXA_NUMVAL' * Create dest ptr reg name 22640000
USE ®_DSTP * Set reg in use 22650000
EQUREG TEMP=YES,WARN=NO * A DO loop register available? 22660000
AIF (&BXA_RC NE 0).GENMVCL4 * No reg available for loop 22670000
MNOTE 0,'No two register pairs available: generating a loop' 22680000
® SETC 'R'.'&BXA_NUMVAL' * Create loop register name 22690000
USE ® * Set loop counter in use 22700000
&_LABEL LA ®_SRCP,&_FROM1 * Init source ptr 22710000
&_LABEL SETC '' * Label no longer needed 22720000
LA ®_DSTP,&_TO1 * Init dest ptr 22730000
CPY ®,&I * Init loop counter 22740000
_CPY&SYSNDX LABEL , * Loop point 22750000
MVC 0(256,®_DSTP),0(®_SRCP) * Move 1 section of data 22760000
INC ®_SRCP,256 * Advance src and dest ptrs 22770000
INC ®_DSTP,256 * to next section of data 22780000
BCT ®,_CPY&SYSNDX * Loop to repeat n times 22790000
DROP ® * Loop counter no longer needed 22800000
&J SETA &LEN-(256*&I) * Calculate remaining length 22810000
AIF (&J LT 1).GENMVCL3 * Any data remains? 22820000
MVC 0(&J,®_DSTP),0(®_SRCP) * Move remaining data 22830000
.GENMVCL3 ANOP , * Data portion has been moved 22840000
DROP ®_DSTP * Free dest ptr 22850000
DROP ®_SRCP * Free src ptr 22860000
.* Now we must set up another loop to pad 22870000
AIF (&PAD_LEN LT 1).MEXIT * No padding: we're done 22880000
&I SETA (&PAD_LEN-1)/256 * Nr of 256-byte sections 22890000
AIF (&I LE 3).GENMVCL9 * List of MVCs shorter than loop 22900000
MVI 0(®_DSTP),C' ' * Insert first pad byte 22910000
LA ®,&I * Nr of sections 22920000
_CPY_&SYSNDX LABEL , * Loop point 22930000
MVC 1(256,®_DSTP),0(®_DSTP) * Pad 1 section 22940000
INC ®_DSTP,256 * Point to next section 22950000
BCT ®,_CPY_&SYSNDX * Loop to repeat n times 22960000
&J SETA (&PAD_LEN-1)-(256*&I) * Remaining pad length 22970000
AIF (&J LT 1).MEXIT * All padding completed? 22980000
MVC 1(&J,®_DSTP),0(®_DSTP) * Wipe remainder 22990000
MEXIT , * 23000000
.GENMVCL4 ANOP , * No loop register available 23010000
DROP ®_DSTP * Free up allocated register 23020000
.GENMVCL5 ANOP , * No loop register available 23030000
DROP ®_SRCP * Free up allocated register 23040000
.GENMVCL6 ANOP , 23050000
.* Last option: generate a lot of MVCs 23060000
MNOTE 0,'Insufficient registers available: generating MVCs' 23070000
&I SETA &LEN/256 * Nr of MVCs to generate 23080000
&J SETA 0 * Loop counter 23090000
.GENMVCL7 ANOP , * Loop to gen MVCs 23100000
AIF (&J GE &I).GENMVCL8 * End of loop 23110000
&_LABEL MVC &_TO1+256*&J.(256),&_FROM1+256*&J 23120000
&_LABEL SETC '' * Wipe used label 23130000
&J SETA &J+1 * 23140000
AGO .GENMVCL7 * 23150000
.GENMVCL8 ANOP , * Gen remaining MVC 23160000
&J SETA &LEN-(256*&I) * Remaining data 23170000
AIF (&J LT 1).GENMVCL9 * No data remains 23180000
&_LABEL MVC &_TO1+256*&I.(&J),&_FROM1+256*&I 23190000
&_LABEL SETC '' * Wipe used label 23200000
.GENMVCL9 ANOP , * All data has been moved 23210000
AIF (&PAD_LEN LT 1).MEXIT * No padding: we're done 23220000
&_TO1 SETC '&_TO1'.'+'.'&LEN' * Set destination area to pad 23230000
&TO_LEN SETA &TO_LEN-&LEN * Set length of padding area 23240000
.* If possible: generate MVCL instruction to fill pad-area 23250000
AIF (&PAD_LEN LE 769).GENMVCL13 * Use set of MVCs: shorter 23260000
EQUREG PAIR=YES,TEMP=YES,R0=YES,WARN=NO * Alloc src reg pair 23270000
AIF (&BXA_RC NE 0).GENMVCL12 * Allocation failed 23280000
®_SRCP SETC 'R'.'&BXA_NUMVAL' * Create source ptr reg name 23290000
&BXA_NUMVAL SETA &BXA_NUMVAL+1 * Nr of odd reg in pair 23300000
®_SRCL SETC 'R'.'&BXA_NUMVAL' * Create source len reg name 23310000
USE ®_SRCP * Set registers in use to 23320000
USE ®_SRCL * prevent re-allocation 23330000
EQUREG PAIR=YES,TEMP=YES,R0=YES,WARN=NO * Alloc dest reg pair 23340000
AIF (&BXA_RC NE 0).GENMVCL10 * Allocation failed 23350000
DROP ®_SRCL * Source register pair 23360000
DROP ®_SRCP * no longer needed 23370000
&FROM_LEN SETA 0 * Set source length to 0 23380000
&_FROM1 SETC '0' * Set source ptr to null 23390000
AGO .DO_MVCL * Two pairs of regs available! 23400000
.GENMVCL10 ANOP , * Second pair not available 23410000
DROP ®_SRCL * Source register pair 23420000
DROP ®_SRCP * no longer needed 23430000
.* Cannot use MVCL: try to generate a loop 23440000
&I SETA (&PAD_LEN-1)/256 * Nr of 256-byte sections 23450000
AIF (&I LE 3).GENMVCL13 * Repeat is shorter than loop? 23460000
EQUREG TEMP=YES,WARN=NO * Allocate dest pointer 23470000
AIF (&BXA_RC NE 0).GENMVCL13 * Not enough regs 23480000
®_DSTP SETC 'R'.'&BXA_NUMVAL' * Create dest ptr reg name 23490000
USE ®_DSTP * Set reg in use 23500000
EQUREG TEMP=YES,WARN=NO * A DO loop register available? 23510000
AIF (&BXA_RC NE 0).GENMVCL12 * No reg available for loop 23520000
® SETC 'R'.'&BXA_NUMVAL' * Create loop register name 23530000
USE ® * Set loop counter in use 23540000
LA ®_DSTP,&_TO1 * Point to pad-area 23550000
MVI 0(®_DSTP),C' ' * Insert first pad byte 23560000
LA ®,&I * Nr of sections 23570000
_CPY_&SYSNDX LABEL , * Loop point 23580000
MVC 1(256,®_DSTP),0(®_DSTP) * Pad 1 section 23590000
INC ®_DSTP,256 * Point to next section 23600000
BCT ®,_CPY_&SYSNDX * Loop to repeat n times 23610000
DROP ® * Loop counter no longer needed 23620000
DROP ®_DSTP * 23630000
&J SETA (&PAD_LEN-1)-(256*&I) * Remaining pad length 23640000
AIF (&J LT 1).MEXIT * All padding completed? 23650000
MVC 1(&J,®_DSTP),0(®_DSTP) * Wipe remainder 23660000
MEXIT , * 23670000
.GENMVCL12 ANOP , * 23680000
DROP ®_DSTP * 23690000
.GENMVCL13 ANOP , * 23700000
&I SETA (&PAD_LEN-1)/256 * Nr of 256-byte sections 23710000
MVI &_TO1,C' ' * Insert first pad byte 23720000
&J SETA 0 * Loop counter 23730000
.GENMVCL15 ANOP , * 23740000
AIF (&J GE &I).GENMVCL16 * End of loop 23750000
MVC &_TO1+1+256*&J.(256),&_TO1+256*&J 23760000
&J SETA &J+1 * 23770000
AGO .GENMVCL15 * 23780000
.GENMVCL16 ANOP , * 23790000
&J SETA (&PAD_LEN-1)-(256*&I) * Remaining pad-length 23800000
AIF (&J LT 1).MEXIT * No more padding: we're done 23810000
MVC &_TO1+1+256*&I.(&J),&_TO1+256*&I 23820000
MEXIT , * 23830000
.* 23840000
.* Copy two unsigned fields of unequal length, under 256 23850000
.GENMVC0 ANOP , * 23860000
AIF (&TO_LEN GT 255).ERR7D * Length within limit? 23870000
AIF (&FROM_LEN GT 255).ERR7E * Length within limit? 23880000
AIF (&TO_LEN EQ &FROM_LEN).DO_MVC * Lengths equal? 23890000
AIF (&TO_LEN LT &FROM_LEN).GENMVC0A * Adjust source 23900000
.* Destination field is larger 23910000
&I SETA &TO_LEN-&FROM_LEN * Data offset in TO-field 23920000
AIF (&I GT 1).GENMVC0XC * Length to clear > 1: use XC 23930000
&_LABEL MVI &_TO1.,X'00' * Wipe destination area 23940000
AGO .GENMVC0B * 23950000
.GENMVC0XC ANOP , * 23960000
&_LABEL XC &_TO1.(&I),&_TO1 * Wipe destination area 23970000
.GENMVC0B ANOP , * Destination field now cleared 23980000
&_LABEL SETC '' * Remove label 23990000
&_TO1 SETC '&_TO1'.'+&I' * Add offset to TO field 24000000
&TO_LEN SETA &FROM_LEN * Reduce length of TO field 24010000
AGO .DO_MVC * Go generate MVC instruction 24020000
.* Source field is larger 24030000
.GENMVC0A ANOP , * 24040000
&I SETA &FROM_LEN-&TO_LEN * Data offset in FROM-field 24050000
&_FROM1 SETC '&_FROM1'.'+&I' * Add offset to FROM field 24060000
&FROM_LEN SETA &TO_LEN * Reduce length of FROM field 24070000
AGO .DO_MVC * Go generate MVC instruction 24080000
.* 24090000
.* Store several registers into unaligned field 24100000
.GENSTCMM ANOP , * 24110000
&I SETA &FROM_REG * Save first register number 24120000
&J SETA 0 * Offset in source field 24130000
.GENSTCMM0 ANOP , * Loop 24140000
&_LABEL STCM &_FROM1,YYYY,&_TO1+&J * 24150000
&_LABEL SETC '' * Remove label after use 24160000
&TO_LEN SETA &TO_LEN-4 * Reduce length 24170000
AIF (&TO_LEN LT 4).MEXIT * No registers left to fill 24180000
&J SETA &J+4 * Point next dest field 24190000
&I SETA &I+1 * Next register number 24200000
AIF (&I LT 16).GENSTCMM1 * Valid register nr 24210000
&I SETA 0 * Wrap-around to R0 24220000
.GENSTCMM1 ANOP , * I now next register nr 24230000
&_FROM1 SETC 'R'.'&I' * Create next register name 24240000
AGO .GENSTCMM0 * 24250000
.* 24260000
.* Store several floating point registers into long operands 24270000
.GENSTDM ANOP , * 24280000
&I SETA &FROM_REG * Save first register number 24290000
&J SETA 0 * Offset in dest. field 24300000
.GENSTDM0 ANOP , * Loop 24310000
&_LABEL STD &_FROM1,&_TO1+&J * 24320000
&_LABEL SETC '' * Remove label after use 24330000
&TO_LEN SETA &TO_LEN-8 * Reduce length 24340000
AIF (&TO_LEN LT 8).MEXIT * No registers left to save 24350000
&J SETA &J+8 * Point next long field 24360000
&I SETA &I+2 * Next register number 24370000
AIF (&I LT 8).GENSTDM1 * Valid register nr 24380000
&I SETA 0 * Wrap-around to FPR0 24390000
.GENSTDM1 ANOP , * I now next register nr 24400000
&_FROM1 SETC 'FPR'.'&I' * Create next register name 24410000
AGO .GENSTDM0 * 24420000
.* 24430000
.* Store several floating point registers into short operands 24440000
.GENSTEM ANOP , * 24450000
&I SETA &FROM_REG * Save first register number 24460000
&J SETA 0 * Offset in dest. field 24470000
.GENSTEM0 ANOP , * Loop 24480000
&_LABEL STE &_FROM1,&_TO1+&J * 24490000
&_LABEL SETC '' * Remove label after use 24500000
&TO_LEN SETA &TO_LEN-4 * Reduce length 24510000
AIF (&TO_LEN LT 4).MEXIT * No registers left to save 24520000
&J SETA &J+4 * Point next long field 24530000
&I SETA &I+2 * Next register number 24540000
AIF (&I LT 8).GENSTEM1 * Valid register nr 24550000
&I SETA 0 * Wrap-around to FPR0 24560000
.GENSTEM1 ANOP , * I now next register nr 24570000
&_FROM1 SETC 'FPR'.'&I' * Create next register name 24580000
AGO .GENSTEM0 * 24590000
.* 24600000
.* Store several registers into halfwords 24610000
.GENSTHM ANOP , * 24620000
&I SETA &FROM_REG * Save first register number 24630000
&J SETA 0 * Offset in dest. field 24640000
.GENSTHM0 ANOP , * Loop 24650000
&_LABEL STH &_FROM1,&_TO1+&J * 24660000
&_LABEL SETC '' * Remove label after use 24670000
&TO_LEN SETA &TO_LEN-2 * Reduce length 24680000
AIF (&TO_LEN LT 2).MEXIT * No registers left to save 24690000
&J SETA &J+2 * Point next halfword 24700000
&I SETA &I+1 * Next register number 24710000
AIF (&I LT 16).GENSTHM1 * Valid register nr 24720000
&I SETA 0 * Wrap-around to R0 24730000
.GENSTHM1 ANOP , * I now next register nr 24740000
&_FROM1 SETC 'R'.'&I' * Create next register name 24750000
AGO .GENSTHM0 * 24760000
.* 24770000
.* Save several floating point registers into extended operands 24780000
.GENSTXM ANOP , * 24790000
&I SETA &FROM_REG * Save first register number 24800000
AIF (&I NE 0 AND &I NE 4).ERR7V * Not a valid pair! 24810000
&I SETA &I+2 * Nr of next register 24820000
&ODDREG SETC 'FPR'.'&I' * Name of second register 24830000
&J SETA 0 * Offset in source field 24840000
.GENSTXM0 ANOP , * Loop 24850000
&_LABEL STD &_FROM1,&_TO1+&J * Save low-order register 24860000
&_LABEL SETC '' * Remove label after use 24870000
&J SETA &J+8 * Point next long field 24880000
STD &ODDREG,&_TO1+&J * Save high-order register 24890000
&TO_LEN SETA &TO_LEN-16 * Reduce length 24900000
AIF (&TO_LEN LT 16).MEXIT * No registers left to fill 24910000
&J SETA &J+8 * Point next long field 24920000
&I SETA &I+2 * Next register number 24930000
AIF (&I LT 8).GENSTXM1 * Valid register nr 24940000
&I SETA 0 * Wrap-around to FPR0 24950000
.GENSTXM1 ANOP , * I now next register nr 24960000
&_FROM1 SETC 'FPR'.'&I' * Create next register name 24970000
&I SETA &I+2 * Nr of next register 24980000
&ODDREG SETC 'FPR'.'&I' * Name of second register 24990000
AGO .GENSTXM0 * 25000000
.* 25010000
.* Generate an Extract stacked REGisters 25020000
.DO_EREG ANOP , * 25030000
&I SETA &TO_LEN/4 * Get number of registers 25040000
&I SETA &TO_REG+&I-1 * Get ending register number 25050000
AIF (&I LE 15).DO_EREG1 * End-reg is ok 25060000
&I SETA &I-16 * Perform wrap-around 25070000
.DO_EREG1 ANOP , * End-register determined 25080000
® SETC 'R'.'&I' * Create register name 25090000
&_LABEL EREG &_TO1,® * 25100000
MEXIT , * 25110000
.* 25120000
.* Generate an Insert Characters under Mask 25130000
.DO_ICM ANOP , * 25140000
&_LABEL ICM &_TO1,&MASK,&_FROM1 * 25150000
MEXIT , * 25160000
.* 25170000
.* Generate a Load instruction to fill a register 25180000
.DO_L ANOP , * 25190000
&_LABEL L &_TO1,&_FROM1 * 25200000
MEXIT , * 25210000
.* 25220000
.* Generate a CVB instruction to fill a register 25230000
.DO_CVB ANOP , * 25240000
&_LABEL CVB &_TO1,&_FROM1 * 25250000
MEXIT , * 25260000
.* 25270000
.* Generate a Load Access Multiple instruction to fill some ARs 25280000
.DO_LAM ANOP , * 25290000
® SETC '&_TO1' * Default end register name 25300000
AIF (&TO_LEN EQ 4).DO_LAM1 * Ok: load 1 access register 25310000
&I SETA &TO_LEN/4 * Get number of registers 25320000
&I SETA &TO_REG+&I-1 * Get ending register number 25330000
® SETC 'AR'.'&I' * Create register name 25340000
AIF (&I LE 15).DO_LAM1 * End-reg is ok 25350000
&I SETA &I-16 * Perform wrap-around 25360000
® SETC 'AR'.'&I' * Create register name 25370000
.DO_LAM1 ANOP , * End-register determined 25380000
&_LABEL LAM &_TO1,®,&_FROM1 * 25390000
MEXIT , * 25400000
.* 25410000
.* Generate a Load Control instruction to fill some control registers 25420000
.DO_LCTL ANOP , * 25430000
® SETC '&_TO1' * Default end register name 25440000
AIF (&TO_LEN EQ 4).DO_LCTL1 * Ok: load 1 control register 25450000
&I SETA &TO_LEN/4 * Get number of registers 25460000
&I SETA &TO_REG+&I-1 * Get ending register number 25470000
® SETC 'CR'.'&I' * Create register name 25480000
AIF (&I LE 15).DO_LCTL1 * End-reg is ok 25490000
&I SETA &I-16 * Perform wrap-around 25500000
® SETC 'CR'.'&I' * Create register name 25510000
.DO_LCTL1 ANOP , * End-register determined 25520000
&_LABEL LCTL &_TO1,®,&_FROM1 * 25530000
MEXIT , * 25540000
.* 25550000
.* Generate a Load floating point (long) 25560000
.DO_LD ANOP , * 25570000
&_LABEL LD &_TO1,&_FROM1 * 25580000
MEXIT , * 25590000
.* 25600000
.* Generate a Load floating point (short) 25610000
.DO_LE ANOP , * 25620000
&_LABEL LE &_TO1,&_FROM1 * 25630000
MEXIT , * 25640000
.* 25650000
.* Generate a Load Multiple instruction to fill some registers 25660000
.DO_LM ANOP , * 25670000
AIF (&TO_LEN EQ 4).DO_L * Load only 1 register 25680000
&I SETA &TO_LEN/4 * Get number of registers 25690000
&I SETA &TO_REG+&I-1 * Get ending register number 25700000
AIF (&I LE 15).DO_LM1 * End-reg is ok 25710000
&I SETA &I-16 * Perform wrap-around 25720000
.DO_LM1 ANOP , * End-register determined 25730000
® SETC 'R'.'&I' * Create register name 25740000
&_LABEL LM &_TO1,®,&_FROM1 * 25750000
MEXIT , * 25760000
.* 25770000
.* Copy two fields of equal length, under 256 25780000
.* Generate explict length when specified or needed 25790000
.DO_MVC ANOP , * 25800000
AIF (K'&_TO2 NE 0).DO_MVC1 * Use explicit length specified 25810000
AIF (&TO_LEN NE L'&_TO1).DO_MVC1 * Use deviating length 25820000
&_LABEL MVC &_TO1,&_FROM1 * Use implicit length 25830000
MEXIT , * 25840000
.DO_MVC1 ANOP , * 25850000
&_LABEL MVC &_TO1.(&TO_LEN),&_FROM1 * 25860000
MEXIT , * 25870000
.* 25880000
.* Copy data, using MVCL 25890000
.DO_MVCL ANOP , * 25900000
EQUREG PAIR=YES,TEMP=YES,R0=YES * Allocate src reg pair 25910000
AIF (&BXA_RC NE 0).ERR7F * Allocation failed 25920000
®_SRCP SETC 'R'.'&BXA_NUMVAL' * Create source ptr reg name 25930000
&BXA_NUMVAL SETA &BXA_NUMVAL+1 * Nr of odd reg in pair 25940000
®_SRCL SETC 'R'.'&BXA_NUMVAL' * Create source len reg name 25950000
USE ®_SRCP * Set registers 25960000
USE ®_SRCL * in use 25970000
EQUREG PAIR=YES,TEMP=YES,R0=YES * Allocate dest reg pair 25980000
AIF (&BXA_RC NE 0).ERR7F * Allocation failed 25990000
®_DSTP SETC 'R'.'&BXA_NUMVAL' * Create dest ptr reg name 26000000
&BXA_NUMVAL SETA &BXA_NUMVAL+1 * Nr of odd reg in pair 26010000
®_DSTL SETC 'R'.'&BXA_NUMVAL' * Create dest len reg name 26020000
USE ®_DSTP * Set registers 26030000
USE ®_DSTL * in use 26040000
.* Set source length 26050000
AIF (&FROM_LEN EQ 0).DO_MVCLA * Length is in a register? 26060000
&_LABEL CPY ®_SRCL,&FROM_LEN * Set length of source data 26070000
AGO .GENMVCLB * 26080000
.DO_MVCLA ANOP , * 26090000
&_LABEL LR ®_SRCL,&_FROM2 * Set length of source data 26100000
.DO_MVCLB ANOP , * 26110000
&_LABEL SETC '' * Label no longer needed 26120000
.* Set source address 26130000
AIF ('&_FROM1' EQ '0').DO_MVCL0 26140000
AIF ('&FROM_TP' EQ 'p').DO_MVCLC * Pointered source field? 26150000
AGO .DO_MVCLE * No: normal field 26160000
.DO_MVCLC ANOP , * 26170000
AIF ('&SYSASCE' EQ 'P').DO_MVCLD * Primary mode? 26180000
LAE ®_SRCP,0(,&_FROM1) * Point to source data 26190000
AGO .DO_MVCL1 * 26200000
.DO_MVCLD ANOP , * 26210000
LR ®_SRCP,&_FROM1 * Point to source data 26220000
AGO .DO_MVCL1 * 26230000
.DO_MVCLE ANOP , * 26240000
AIF ('&SYSASCE' EQ 'P').DO_MVCLF * Primary mode? 26250000
LAE ®_SRCP,&_FROM1 * Point to source data 26260000
AGO .DO_MVCL1 * 26270000
.DO_MVCLF ANOP , * 26280000
LA ®_SRCP,&_FROM1 * Point to source data 26290000
AGO .DO_MVCL1 * 26300000
.DO_MVCL0 ANOP , * 26310000
CLEAR ®_SRCP * Clear source data pointer 26320000
.DO_MVCL1 ANOP , * 26330000
.* Set destination length 26340000
AIF (&TO_LEN NE 0).DO_MVCLG 26350000
LR ®_DSTL,&_TO2 * Set length of dest field 26360000
AGO .DO_MVCL3 * 26370000
.DO_MVCLG ANOP , * 26380000
AIF (&TO_LEN NE &FROM_LEN).DO_MVCL2 26390000
LR ®_DSTL,®_SRCL * Copy data length 26400000
AGO .DO_MVCL3 * 26410000
.DO_MVCL2 ANOP , * 26420000
CPY ®_DSTL,&TO_LEN * Set length of dest field 26430000
.DO_MVCL3 ANOP , * 26440000
.* Set destination address 26450000
AIF ('&TO_TP' EQ 'p').DO_MVCLH * Pointered dest field? 26460000
AGO .DO_MVCLJ * No: normal field 26470000
.DO_MVCLH ANOP , * 26480000
AIF ('&SYSASCE' EQ 'P').DO_MVCLI * Primary mode? 26490000
LAE ®_DSTP,0(,&_TO1) * Point to destination field 26500000
AGO .DO_MVCL4 * 26510000
.DO_MVCLI ANOP , * 26520000
LR ®_DSTP,&_TO1 * Point to destination field 26530000
AGO .DO_MVCL4 * 26540000
.DO_MVCLJ ANOP , * 26550000
AIF ('&SYSASCE' EQ 'P').DO_MVCLK * Primary mode? 26560000
LAE ®_DSTP,&_TO1 * Point to destination field 26570000
AGO .DO_MVCL4 * 26580000
.DO_MVCLK ANOP , * 26590000
LA ®_DSTP,&_TO1 * Point to destination field 26600000
.DO_MVCL4 ANOP , * 26610000
.* Insert padding into source length register 26620000
AIF (&FROM_LEN EQ 0).DO_MVCL5 * Pad with zeros if needed 26630000
AIF (&TO_LEN EQ 0).DO_MVCL5 * Pad with zeros if needed 26640000
AIF (&FROM_LEN GE &TO_LEN).DO_MVCL5 * No padding needed 26650000
AIF (&PAD0).DO_MVCL5 * Pad=X'00' --> No pad needed 26660000
ICM ®_SRCL,YNNN,=C' ' * Set padding to spaces 26670000
.DO_MVCL5 ANOP , * 26680000
.* 26690000
MVCL ®_DSTP,®_SRCP * 26700000
DROP ®_DSTL * Destination register pair 26710000
DROP ®_DSTP * no longer needed 26720000
DROP ®_SRCL * Source register pair 26730000
DROP ®_SRCP * no longer available 26740000
MEXIT , * 26750000
.* 26760000
.* Generate a PACK to copy zoned decimal data to a packed field 26770000
.DO_PACK ANOP , * 26780000
AIF (K'&_TO2 NE 0).DO_PACK0 * 26790000
AIF (&TO_LEN NE L'&_TO1).DO_PACK0 * 26800000
AGO .DO_PACK1 * 26810000
.DO_PACK0 ANOP , * Add explicit dest.length 26820000
&_TO1 SETC '&_TO1'.'(&TO_LEN)' * Add length to destination 26830000
.DO_PACK1 ANOP , * Length now in destination fld 26840000
AIF (K'&_FROM2 NE 0).DO_PACK2 * 26850000
AIF (&FROM_LEN NE L'&_FROM1).DO_PACK2 * 26860000
AGO .DO_PACK3 * 26870000
.DO_PACK2 ANOP , * Add explicit src.length 26880000
&_FROM1 SETC '&_FROM1'.'(&FROM_LEN)' * Add length to source 26890000
.DO_PACK3 ANOP , * Length now in source fld 26900000
&_LABEL PACK &_TO1,&_FROM1 * 26910000
MEXIT , * 26920000
.* 26930000
.* Generate a Store register 26940000
.DO_ST ANOP , * 26950000
&_LABEL ST &_FROM1,&_TO1 * 26960000
MEXIT , * 26970000
.* 26980000
.* Generate a Store Access Multiple instruction to save some ARs 26990000
.DO_STAM ANOP , * 27000000
&I SETA &FROM_LEN/4 * Get number of registers 27010000
&I SETA &FROM_REG+&I-1 * Get ending register number 27020000
® SETC 'AR'.'&I' * Create register name 27030000
AIF (&I LE 15).DO_STAM1 * End-reg is ok 27040000
&I SETA &I-16 * Perform wrap-around 27050000
® SETC 'AR'.'&I' * Create register name 27060000
.DO_STAM1 ANOP , * End-register determined 27070000
&_LABEL STAM &_FROM1,®,&_TO1 * 27080000
MEXIT , * 27090000
.* 27100000
.* Generate a Store characters under mask 27110000
.DO_STCM ANOP , * 27120000
&_LABEL STCM &_FROM1,&MASK,&_TO1 * 27130000
MEXIT , * 27140000
.* 27150000
.* Generate a Store Control instruction to fill some control registers 27160000
.DO_STCTL ANOP , * 27170000
&I SETA &FROM_LEN/4 * Get number of registers 27180000
&I SETA &FROM_REG+&I-1 * Get ending register number 27190000
® SETC 'CR'.'&I' * Create register name 27200000
AIF (&I LE 15).DO_STCTL1 * End-reg is ok 27210000
&I SETA &I-16 * Perform wrap-around 27220000
® SETC 'CR'.'&I' * Create register name 27230000
.DO_STCTL1 ANOP , * End-register determined 27240000
&_LABEL STCTL &_FROM1,®,&_TO1 * 27250000
MEXIT , * 27260000
.* 27270000
.* Generate a Store floating point (long) 27280000
.DO_STD ANOP , * 27290000
&_LABEL STD &_FROM1,&_TO1 * 27300000
MEXIT , * 27310000
.* 27320000
.* Generate a Store floating point (short) 27330000
.DO_STE ANOP , * 27340000
&_LABEL STE &_FROM1,&_TO1 * 27350000
MEXIT , * 27360000
.* 27370000
.* Generate a Store Halfword 27380000
.DO_STH ANOP , * 27390000
&_LABEL STH &_FROM1,&_TO1 * 27400000
MEXIT , * 27410000
.* 27420000
.* Generate a Store Multiple instruction to save some registers 27430000
.DO_STM ANOP , * 27440000
&I SETA &FROM_LEN/4 * Get number of registers 27450000
&I SETA &FROM_REG+&I-1 * Get ending register number 27460000
AIF (&I LE 15).DO_STM1 * End-reg is ok 27470000
&I SETA &I-16 * Perform wrap-around 27480000
.DO_STM1 ANOP , * End-register determined 27490000
® SETC 'R'.'&I' * Create register name 27500000
&_LABEL STM &_FROM1,®,&_TO1 * 27510000
MEXIT , * 27520000
.* 27530000
.* Generate an UNPK to copy packed decimal data to a zoned field 27540000
.DO_UNPK ANOP , * 27550000
AIF (K'&_TO2 NE 0).DO_UNPK0 * 27560000
AIF (&TO_LEN NE L'&_TO1).DO_UNPK0 * 27570000
AGO .DO_UNPK1 * 27580000
.DO_UNPK0 ANOP , * Add explicit dest.length 27590000
&_TO1 SETC '&_TO1'.'(&TO_LEN)' * Add length to destination 27600000
.DO_UNPK1 ANOP , * Length now in destination fld 27610000
AIF (K'&_FROM2 NE 0).DO_UNPK2 * 27620000
AIF (&FROM_LEN NE L'&_FROM1).DO_UNPK2 * 27630000
AGO .DO_UNPK3 * 27640000
.DO_UNPK2 ANOP , * Add explicit src.length 27650000
&_FROM1 SETC '&_FROM1'.'(&FROM_LEN)' * Add length to source 27660000
.DO_UNPK3 ANOP , * Length now in source fld 27670000
&_LABEL UNPK &_TO1,&_FROM1 * 27680000
MEXIT , * 27690000
.* 27700000
.* Generate a ZAP to copy packed decimal data 27710000
.DO_ZAP ANOP , * 27720000
AIF (K'&_TO2 NE 0).DO_ZAP0 * 27730000
AIF (&TO_LEN NE L'&_TO1).DO_ZAP0 * 27740000
AGO .DO_ZAP1 * 27750000
.DO_ZAP0 ANOP , * Add explicit dest.length 27760000
&_TO1 SETC '&_TO1'.'(&TO_LEN)' * Add length to destination 27770000
.DO_ZAP1 ANOP , * Length now in destination fld 27780000
AIF (K'&_FROM2 NE 0).DO_ZAP2 * 27790000
AIF (&FROM_LEN NE L'&_FROM1).DO_ZAP2 * 27800000
AGO .DO_ZAP3 * 27810000
.DO_ZAP2 ANOP , * Add explicit src.length 27820000
&_FROM1 SETC '&_FROM1'.'(&FROM_LEN)' * Add length to source 27830000
.DO_ZAP3 ANOP , * Length now in source fld 27840000
&_LABEL ZAP &_TO1,&_FROM1 * 27850000
MEXIT , * 27860000
.* 27870000
.MEXIT ANOP , * 27880000
MEND 27890000
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 >> ] |
||