|
|
|
|
|
|
||
© 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