Macro
.*-
.* SETREG - build Lx instruction (inner macro)
.*
.* Returns length in a global variable, length either defined by the
.* 2rd operand, or computed from the 2nd operand.
.* Syntax:
.*   SETREG r1,label    -> laey  r1,label
.*   SETREG r1,,label   -> laey  r1,label
.*   SETREG r1,number   -> iilf  r1,nnn
.*   SETREG r1,4(,r3)   -> la    r1,4(,r3)                 -> length=0
.*   SETREG r1,(r2)     -> lr    r1,r2                     -> length=0
.*   SETREG r1,'kilroy' -> la    r1,=c'kilroy'
.*   SETREG r1,0        -> slr   r1,r1                     -> length=0
.*   SETREG r1,x.label  -> lx    r1,label  (x: B,C,F or H) -> length=0
.* The length is returned in global variables &$SETREGL (numeric) and
.* &$SETREGLC (character). Be careful as i.e. equated number will set
.* length=1.
.* The type LBL, TXT etc is returned in global variable &$SETREGT.
.* Note that label B.xx  expands into a LLC instruction which loads
.* the entre byte, whereas the LB instruction uses bit 0 as a sign.
.*
.* Author
.*     Willy Jensen
.*     mail: willy@harders-jensen.com
.*     web : http://harders-jensen.com/wjtech
.*
.* History
.* 2017-14-03  numeric value now different from label.
.* 2018-06-16  2rd operand is now alternate src, not global length.
.* 2019-01-11  change global $SETREGLC.
.* 2020-11-11  add global $SETREGT.
.* 2020-12-01  change 'la label' to laey label', sr+ic to llc.
.* 2021-06-03  update set of &$SETREGL and &$SETREGLC.
.*             fix handling of source like 1(,r1) - new type REGO.
.* 2021-07-21  change t'&src eq 'U' to t'&src ne 'C'
.* 2021-08-22  new type *.address, macro determines field len
.* 2021-08-23  change LH to LLH
.*-
&mlbl    SETREG &reg,&psrc,&pasrc,&pasrc2,&glen=,&src2=
         lcla  &n,&l
         lclc  &s,&c,&r,&srct,&srcl,&src,&li(4)
         gbla  &$SETREGL
         gblc  &$SETREGLC
         gblc  &$SETREGT
&$SETREGL  seta 0
&$SETREGLC setc ''
.* select source
         aif   (k'&psrc   gt 0).setsrc1
         aif   (k'&pasrc  gt 0).setsrc2
         aif   (k'&pasrc2 gt 0).setsrc3
         aif   (k'&src2   gt 0).setsrc4
         mnote  8,'** SETREG mising source'
.setsrc1 anop
&src     setc  '&psrc'
         ago   .setsrcn
.setsrc2 anop
&src     setc  '&pasrc'
         ago   .setsrcn
.setsrc3 anop
&src     setc  '&pasrc2'
         ago   .setsrcn
.setsrc4 anop
&src     setc  '&src2'
.setsrcn anop
.*
&s       setc  Upper('&src')
         aif   ('&s   '(1,3) eq 'L''''').litlen
&srct    setc  t'&src
&srcl    setc  Lower('&src')
.* mnote *,'type &srct'
.*-
.* what kind of 1st operand do we have?
.*-
         aif   (k'&src gt 0).cp1
         mnote 8,'src operand missing'
         mexit
.cp1     anop
&n       seta  k'&src
         aif   ('&src '(2,1) eq '.').load
         aif   ('&src' eq '0').clr          clear register
         aif   ('&src'(1,1) eq '(').reg     register
         aif   ('&src'(1,1) eq '''').txt    text
         aif   ('&srct' eq 'N').num         number
         aif   ('&src'(&n,1) eq ')').rego   register + number '4(r13)'
         ago   .lbl                         assume label
.*- src is 0, means clear reg
.clr     anop  ,
&$SETREGT setc 'CLR'
&mlbl    slr   &reg,&reg
         mexit
.*- src is a number
.num     anop  ,
&$SETREGT setc 'NUM'
&mlbl    iilf  &reg,&src
&$SETREGL seta &src
         mexit
.*- src is a label or address or n(reg)
.lbl     anop  ,                           label
&$SETREGT setc 'LBL'
&mlbl    laey  &reg,&src
&s       setc  t'&src
.* mnote *,'LBL t=&s'
&s       setc  Upper('&src')
         aif   ('&s'(1,2) eq 'L''').lbll
         aif   (t'&src ne 'C').lblu        was eq c'U'  2021-07-21
&$SETREGL  seta l'&src
&$SETREGLC setc '&$SETREGL'
         mexit
.lblu    anop
&$SETREGLC setc 'l''&src'
         mexit
.lbll    anop
&$SETREGLC setc '&src'
         mexit
.*- src is a register
.reg     anop  ,                           register
&$SETREGT setc 'REG'
&n       seta  (k'&src)-2
&s       setc  '&src'(2,&n)
&mlbl    lr    &reg,&s
         mexit
.*- src is a register + number , i.e. 4(,r13)
.rego    anop  ,                           register
&$SETREGT  setc 'REGO'
&mlbl    la    &reg,&s
         mexit
.*- src is text
.txt     anop  ,
&$SETREGT setc 'TXT'
&s       setc  '=c&src'
&mlbl    laey  &reg,&s
&n       seta  (k'&src)-2
&$SETREGL seta &n
&$SETREGLC setc '&n'
         mexit
.*- load from storage
.load    anop  ,
.* mnote *,'load'
&c       setc  Upper('&srcl'(1,1))
&n       seta  (k'&src)-2
&s       setc  '&src'(3,&n)
&$SETREGT setc 'LFS'
         aif   ('&c' eq 'F' or '&c' eq 'A').loadf
         aif   ('&c' eq 'B' or '&c' eq 'C').loadb
         aif   ('&c' eq 'H').loadh
         aif   ('&c' eq '*').loadQ
         mnote 8,*** invalid load parm &c'
         mexit
.loadf   anop  ,
&mlbl    l     &reg,&s                     load from fullword
         mexit
.loadh   anop  ,
&mlbl    llh   &reg,&s                     load from halfword
         mexit
.loadb   anop  ,
&mlbl    llc   &reg,&s                     load from byte
         mexit
.loadq   anop  ,
&li(1)   setc  'llc'
&li(2)   setc  'llh'
&li(3)   setc  '???'
&li(4)   setc  'l'
&l       seta  l'&s
&c       setc  '&li(&l)'
&mlbl    &c    &reg,&s
         mexit
*-
.litlen  anop
&n       seta  (k'&src)-4
&$SETREGL  seta &n
&$SETREGLC setc '&$SETREGL'
         la    &reg,&n                     length of literal
         mexit
*-
.x       Mend