Note that this macro requires the external macro SETREG. The SETREG macro can also be downloaded from this website. .*- .* Willow Structured Assembler Macros (WSAM) .* .* This is assembler copybook, use as follows: .* Print off .* Copy VsamMacs .* Print on .*- .* .* The WSAM macro set allows an assembler programmer to do away with .* most labels, and make more readable code. You can use multi-level .* IF and DO constructs with boolean logic. .* .* WSAM is (very) similar, but not identical, to IBM's Structured .* Programming Macros. WSAM was started a long time ago and some .* parts do look their age - but as they still work... .* .* Recent enhancements are using newer instructions like the long .* immediate. If that is a problem then contact me for a solution. .* .* The macro set is supplied as a copy book, thus allowing macro .* names longer than 8 bytes. .* .* General syntax, check the macros for detailed syntax. .* .* DO expr .* ITERATE .* LEAVE .* ENDDO .* .* IF expr .* ELSEIF expr .* ELSEIF expr .* ELSE .* ENDIF .* .* IIF expr,(if-true),(if-false) .* .* SKIP .* .. data block .. .* ENDSKIP .* .* LITERALS junp around LTORG .* .* Check the macro descriptions for details. .* .* Sample .* .* if (ltr,r15,r15,z),or,(clc,rc,eq,zero) .* .. code .. .* elseif (clc,rc,eq,=a(4)) .* .. code .. .* else .* .. code .. .* endif .* .* If the action is a single instruction then the THEN operand can .* be used to shorten the written program - the generated code will .* be the same. .* .* if (cfi,r1,gt,4196),then=(la,r2,48) .* .* WSAM macros are packaged in copy member WSAMMACS (thisaone). .* .* .* History .* 2017-09-13 latest major rewrite .* 2018-10-27 add value to 'over' -> OVER=(r,v) .* 2019-01-30 allow full EX instruction - ex,rx,instr,addr1,addr2,cn .* allow numeric cc testing i.e. IF (2) .* some internal cleanup .* 2020-03-06 Add select..when..when other..endselect .* 2019-06-21 change how to differentiate between i.e. (lt,r1,zero,z) .* and (c,r1,eq,zero). .* 2021-05-28 editorial, update the documentation. .* 2021-06-03 use SETREG external macro for setting regs instead of .* the WSAMLA adaption. .* 2021-11-15 change B something to J something. .* .* Contact .* email willy@harders-jensen.com .* web https://harders-jensen.com (newest version here) .*- MACRO BREAK mnote 12,'*** BREAK is discontinued, use LEAVE insstead' MEND MACRO .*----------< WILLOW STRUCTURED ASSEMBLER MACROS >-------------* .* 'LEAVE' - leave a DO or IF group. * .* Syntax * .* LEAVE leave current group * .* LEAVE label leave labelled group (label on DO stmt) * .* LEAVE ALL leave outermost group * .*--------------------------------------------------------------------* &MLBL LEAVE &PREFIX=ZBR,&SUFFIX= GBLA &WAMBRLV 'LEAVE' LABEL GBLC &WAMBRLB(16) 'LEAVE' LABEL GBLA &WAMIFLV GBLC &WAMIFLB(16) LCLC &L,&C &C SETC Upper('&SYSLIST(1)') AIF ('&C' EQ 'SET').SET AIF ('&C' EQ 'RESET').RSET AIF ('&C' EQ 'LABEL').LBL AIF ('&C' EQ 'ALL').BRA AIF ('&C' EQ 'OUTER').BRA AIF (K'&SYSLIST(1) EQ 0).BRO0100 .*- .* BREAK TO SPECIFIC LABEL .*- J &SYSLIST(1)._END MEXIT .*- .* BREAK OUT FROM CURRENT LEVEL .*- .BRO0100 ANOP AIF (K'&WAMBRLB(&WAMBRLV) GT 0).BRO0200 MNOTE 12,'*** ERROR: NO LEAVE LABEL GEN''D (LV=&WAMBRLV)' MNOTE 12,'*** LEAVE IS MOST LIKELY ATTEMPTED OUTSIDE A DO GRP' MEXIT .BRO0200 ANOP &L SETC '&WAMBRLB(&WAMBRLV)' J &L .BRO0900 ANOP MEXIT .*- .* BREAK OUT TO FIRST LEVEL .*- .BRA ANOP J &WAMBRLB(1) MEXIT .*- .* SETUP BREAK-OUT LABEL .*- .SET ANOP &WAMBRLV SETA &WAMBRLV+1 &WAMBRLB(&WAMBRLV) SETC '&PREFIX.&SYSNDX.&SUFFIX' AIF (N'&SYSLIST LE 1).SET020 &WAMBRLB(&WAMBRLV) SETC '&SYSLIST(2)' .SET020 ANOP MEXIT .* .*- .* GENERATE LABEL .*- .LBL ANOP AIF ('&WAMBRLB(&WAMBRLV)' NE '').LBL0100 MNOTE *,'*** WARNING - LEAVE LABEL MISSING LEVEL &WAMBRLV' MEXIT .LBL0100 ANOP &L SETC '&WAMBRLB(&WAMBRLV)' &L EQU * &WAMBRLV SETA &WAMBRLV-1 MEXIT .LBLE100 ANOP MEXIT .*- .* RESET BREAK-OUT LABEL .*- .RSET ANOP &WAMBRLB(&WAMBRLV) SETC ' ' MEXIT .*- .* END OF MACRO .*- .MEXIT MEND MACRO .*----------< WILLOW STRUCTURED ASSEMBLER MACROS >-------------* .* 'DO ' FUNCTION. * .* Syntax * .* DO , no test, do once * .* DO INF INFINITE EXECUTION ( SUPPORT JSX MACS ) * .* DO FOREVER INFINITE EXECUTION ( SUPPORT JSX MACS ) * .* DO OVER(r) DOWN FROM VALUE IN R - stops when r = 1 * .* DO OVER(r,v) DOWN FROM VALUE V IN R - stops when r = 1 * .* DO OVER=R DOWN FROM VALUE IN R - stops when r = 1 * .* DO FROM=(r) count register down to zero * .* DO FROM=(r,v) load v to reg r, then count down to zero * .* DO FROM=(r,v),TO=v,BY=v by-v may be negative for countdown * .* DO WHILE,COND1,AND/OR,COND2,..,AND/OR,COND15 * .* DO UNTIL,COND1,AND/OR,COND2,..,AND/OR,COND15 * .*--------------------------------------------------------------------* &MLBL DO &FROM=,&TO=,&DOWNTO=,&BY=1,&OVER= LCLC &C,&L,&FROMREG,&TOREG,&BYREG,&OP,&CND,&CFROM LCLC &r1,&r2,&r3,&v1,&v2,&v3 LCLA &N,&M GBLA &WAMDOLV GBLC &WAMDOLA(16) action GBLC &WAMDOLB(16) branch .*- .* DEFINE LABELS .*- AIF (K'&MLBL EQ 0).TOPLB20 &L SETC '&MLBL' AGO .TOPLB99 .TOPLB20 ANOP &L SETC 'DO&SYSNDX' .TOPLB99 ANOP .DEFTOPL ANOP &WAMDOLV SETA &WAMDOLV+1 &WAMDOLA(&WAMDOLV) SETC '' &WAMDOLB(&WAMDOLV) SETC '&L._BGN' LEAVE SET,&L._END .*- .* CONTROL FUNCTION .*- &c setc Upper('&syslist(1)') AIF ('&C&FROM&TO&OVER' eq '').once .* aif (k'&from ne 0 and k'&to ne 0).FTB aif (k'&from ne 0).FTB AIF ('&c' EQ 'INF').INFIN AIF ('&c' EQ 'FOREVER').INFIN AIF ('&c' EQ 'WHILE').WHILE AIF ('&c' EQ 'UNTIL').UNTIL AIF ('&OVER' NE '').OVER1 &c setc Upper('&syslist(1).') AIF ('&c '(1,5) EQ 'OVER(').OVER2 AIF (N'&SYSLIST EQ 0).INFIN mnote 8,'*** error : invalid specification for do macro: &c' MEXIT .*- .* DO ONCE .*- .ONCE ANOP &L._BGN CNOP 0,4 &WAMDOLA(&WAMDOLV) SETC 'ONCE' MEXIT .*- .* DO UNTIL JUDGEMENT DAY .*- .INFIN ANOP &L._BGN CNOP 0,4 do until judgement day .* ALL DONE BY ENDDO FUNCTION MEXIT .*- .* DO 'WHILE' MEANS CONDITION TEST BEFORE PROCESS .*- .WHILE ANOP &L._BGN CNOP 0,4 IF &SYSLIST(2),&SYSLIST(3),&SYSLIST(4), + &SYSLIST(5),&SYSLIST(6),&SYSLIST(7),&SYSLIST(8), + &SYSLIST(9),&SYSLIST(10),&SYSLIST(11),&SYSLIST(12), + &SYSLIST(13),&SYSLIST(14),&SYSLIST(15),&SYSLIST(16) J &L._OK ENDIF J &L._END &L._OK EQU * MEXIT .*- .* DO 'UNTIL' MEANS CONDITION TEST AFTER PROCESS .*- .UNTIL ANOP J &L._OK &L._BGN EQU * IF &SYSLIST(2),&SYSLIST(3),&SYSLIST(4), + &SYSLIST(5),&SYSLIST(6),&SYSLIST(7),&SYSLIST(8), + &SYSLIST(9),&SYSLIST(10),&SYSLIST(11),&SYSLIST(12), + &SYSLIST(13),&SYSLIST(14),&SYSLIST(15),&SYSLIST(16) J &L._END ENDIF &L._OK EQU * MEXIT .* .*- .* 1) DO OVER=(rn,value) 2018-10-27 .* 2) DO OVER(rn) .*- .OVRF ANOP this is really FROM=(reg) mnote *,'Over from' &FROMREG SETC '&FROM'(2,k'&from-2) AGO .over10 .OVER1 ANOP &FROMREG SETC '&OVER(1)' 2018-10-27 aif (n'&over lt 2).over10 2018-10-27 &v1 setc '&over(2)' 2018-10-27 .*? $la &fromreg,&v1 2018-10-27 SETREG &fromreg,&v1 2021-06-03 AGO .over10 2018-10-27 .OVER2 ANOP &N SETA (K'&SYSLIST(1))-6 &FROMREG SETC '&SYSLIST(1)'(6,&N) AGO .over10 .OVER10 ltr &fromreg,&fromreg prevent loop for reg le 0 jnp &l._end AGO .BCT0500 .*--------------------------------------------------------------------* .* DO DOWN FROM VALUE IN REGISTER * .*--------------------------------------------------------------------* .BCT ANOP &FROMREG SETC '&FROM(1)' AIF (N'&FROM EQ 1).BCT0500 LA &FROMREG,&FROM(2) .BCT0500 ANOP J &L._OK &L._BGN BCT &FROMREG,&L._OK J &L._END END OF COUNT &L._OK EQU * MEXIT .*--------------------------------------------------------------------* .* DO 'FROM' 'TO' 'BY' * .* * .* Syntax: FROM=(r1,v1),TO=v2,BY=v3 * .* v1, v2 and v3 can all be actual values, i.e. 2000, or * .* registers in paranthesis, i.e. (r1). * .* Values may be negative. * .*--------------------------------------------------------------------* .FTB ANOP &cnd setc 'h' &op setc 'a' &r1 setc '&from(1)' &v1 setc '&from(2)' &v2 setc '0' to &v3 setc '1' by .* count down from value aif (k'&to ne 0 and k'&by ne 0).ftb2 &cnd setc 'l' &op setc 's' .* setup rest .ftb2 anop aif (k'&to eq 0).ftbzton aif (n'&to eq 2).ftbzto2 &v2 setc '&to' ago .ftbzton .ftbzto2 anop &r2 setc '&to(1)' &v2 setc '&to(2)' SETREG &r2,&v2,(&r2.) 2021-06-03 &v2 setc '(&to(1).)' .ftbzton anop aif (k'&by eq 0).ftbzbyn &v3 setc '&by' .ftbzbyn anop aif ('&v3 '(1,1) ne '-').ftbv3m &cnd setc 'l' &op setc 's' &v3 setc '&v3'(2,k'&v3-1) .ftbv3m anop SETREG &r1,&v1,(&r1.) from 2021-06-03 j &l._tst &l._bgn equ * .* setup add/subtract value aif ('&v3'(1,1) eq '(').ftbbyr by &op.lfi &r1,&v3 ago .ftbbyn .ftbbyr anop &v3 setc '&v3'(2,k'&v3-2) &op.r &r1,&v3 .ftbbyn anop .* test value &l._tst equ * aif ('&v2'(1,1) eq '(').ftbtor by cfi &r1,&v2 ago .ftbton .ftbtor anop &v2 setc '&v2'(2,k'&v2-2) cr &r1,&v2 .ftbton anop j&cnd &l._end .* end &l._ok equ * MEXIT .*------ .MEXIT ANOP MEND MACRO .*----------< WILLOW STRUCTURED ASSEMBLER MACROS >-------------* .* 'ELSE' * .*--------------------------------------------------------------------* &MLBL ELSE GBLA &WAMIFLV GBLC &WAMIFLB(16) .* MNOTE *,' SYSINDEX: &SYSNDX, IF-LVL: &WAMIFLV' .* LCLA &N,&NEWL2 LCLC &L1,&L2 .* &L1 SETC '&WAMIFLB(&WAMIFLV)' CURRENT LABEL PREFIX &L2 SETC 'IF&SYSNDX' NEW LABEL PREFIX &WAMIFLB(&WAMIFLV) SETC '&L2' J &L2._END &L1._END EQU * MEND MACRO .*----------< WILLOW STRUCTURED ASSEMBLER MACROS >-------------* .* 'ELSEIF' * .*--------------------------------------------------------------------* &MLBL ELSEIF &THEN= GBLA &WAMIFLV GBLC &WAMIFLB(16) GBLC &WAMEILB(16) LCLC &L1,&L2 &L1 SETC '&WAMIFLB(&WAMIFLV)' .* AIF (K'&WAMEILB(&WAMIFLV) NE 0).EI0100 &WAMEILB(&WAMIFLV) SETC '&L1' .EI0100 ANOP &L2 SETC '&WAMEILB(&WAMIFLV)' J &L2._EEND PROCESS COMPLETED .* &WAMIFLV SETA &WAMIFLV-1 .* MNOTE *,' SYSINDEX: &SYSNDX, IF-LVL: &WAMIFLV' &L1._END EQU * IF &SYSLIST(1),&SYSLIST(2),&SYSLIST(3),&SYSLIST(4), + &SYSLIST(5),&SYSLIST(6),&SYSLIST(7),&SYSLIST(8), + &SYSLIST(9),&SYSLIST(10),&SYSLIST(11),&SYSLIST(12), + &SYSLIST(13),&SYSLIST(14),&SYSLIST(15),&SYSLIST(16), + THEN=&THEN .MX MEND MACRO .*----------< WILLOW ASSEMBLY MACROS >-------------* .* 'ENDDO' FUNCTION. * .* DESC : TERMINATE THE 'DO' FUNCTON. * .* SYNTAX: ENDDO * .*--------------------------------------------------------------------* ENDDO GBLA &WAMDOLV GBLC &WAMDOLA(16) GBLC &WAMDOLB(16) LCLC &C &c setc '&WAMDOLA(&WAMDOLV)' aif ('&WAMDOLA(&WAMDOLV)' EQ 'ONCE').b J &WAMDOLB(&WAMDOLV) .b anop &WAMDOLV SETA &WAMDOLV-1 LEAVE LABEL MEND MACRO .*----------< WILLOW STRUCTURED ASSEMBLER MACROS >-------------* .* 'ENDIF' * .*--------------------------------------------------------------------* &MLBL ENDIF GBLA &WAMIFLV GBLC &WAMIFLB(16) GBLC &WAMEILB(16) 'ELSEIF' LABELS LCLC &L AIF (K'&MLBL EQ 0).MLB0900 &MLBL EQU * .MLB0900 ANOP .*- .* SET END-OF-EXECUTION LABEL .*- &L SETC '&WAMIFLB(&WAMIFLV)' &L._END EQU * .*- .* SET END OF 'ELSEIF' CONSTRUCT .*- AIF (K'&WAMEILB(&WAMIFLV) EQ 0).EE0999 &L SETC '&WAMEILB(&WAMIFLV)' &WAMEILB(&WAMIFLV) SETC '' RESET LABEL &L._EEND EQU * END OF ELSEIF .EE0999 ANOP .*- .* END OF MACRO .*- .MX ANOP &WAMIFLV SETA &WAMIFLV-1 BACK UP ONE LEVEL MEND MACRO .*----------< WILLOW STRUCTURED ASSEMBLER MACROS >-------------* .* 'IF' FUNCTION. * .* * .* IF expr * .* .. code .. * .* ELSEIF expr * .* .. code .. * .* ELSE * .* .. code .. * .* ENDIF * .* IF expr,THEN=(instruction) * .* * .* 'expr' is one or more tests combined by boolean logic AND or * .* OR. Each test should be enclosed in paranthesis, even if it * .* consist of only a single operand like (NZ). * .* i.e. IF (CLC,FW,EQ,=A(0)),AND,(LTR,R15,R15,Z) * .* 'expr' is case insensitive. * .* * .* IF (cond) test condition listed below * .* i.e. IF (NZ) after a LTR rx,rx * .* IF (cc) test condition code * .* i.e. IF (2) after a CLC arg1,arg2 * .* IF (compare,arg1,cond,arg2) * .* compare One of the compare instructions CLx, CR ... * .* arg1 argument 1 of compare * .* cond condition listed below * .* arg2 argument 2 of compare * .* i.e. IF (CLC,RC,EQ,=A(8)) * .* IF (test,arg1,arg2,cond) * .* test Test instruction, i.e. LTR * .* arg1 argument 1 of test * .* arg2 argument 2 of test * .* cond condition listed below * .* i.e. IF (LTR,R5,R15,NZ) * .* IF (test,arg1,arg2,arg3,cond) * .* instr Test instruction, i.e. LTR and TM * .* arg1 argument 1 of test * .* arg2 argument 2 of test * .* arg3 argument 3 of test * .* cond condition listed below * .* i.e. IF (TM,BYTE1,X'01',O) bit is ONE * .* * .* Some short-cuts * .* IF (arg1,cond,arg2) is short for IF (compare,arg1,cond,arg2) * .* IF (Rx,cond) is short for IF (LTR,Rx,Rx,cond) * .* * .* List of conditions * .* EQ Equal * .* NE Not equal * .* GT Greater then * .* LT Less than * .* LE Less than or equal * .* GE Greater then or equal * .* O One - used with bit-testing, i.e. TM, and LTR * .* Z Zero - used with bit-testing, i.e. TM, and LTR * .* NZ Not zero * .* conditions are case insensitive. * .* * .*--------------------------------------------------------------------* &MLBL IF &THEN=,&LP= AIF (K'&MLBL EQ 0).MLB0900 &MLBL CNOP 0,4 .MLB0900 ANOP LCLA &N,&M,&SLN,&LSUF LCLC &I,&O,&C,&L,&LEX,&LCUR,&LNXT,&LPF,&COND,&S GBLA &WAMIFLV GBLC &WAMIFLB(16) .*- .* preset variables .*- &LPF SETC 'IF&SYSNDX' AIF (K'&LP EQ 0).LP099 &LPF SETC '&LP' .LP099 ANOP &LSUF SETA 0 &WAMIFLV SETA &WAMIFLV+1 FWD IN ARRAY &WAMIFLB(&WAMIFLV) SETC '&LPF' LABEL PREFIX FROM ABOVE .*- .* process parm field(s) .*- &SLN SETA 1 .OP00 ANOP &LSUF SETA &LSUF+1 &LCUR SETC '&LPF.&LSUF' CURRENT .*** don't use label for first test AIF (&SLN NE 1).OP10 &LCUR SETC '' DON'T USE LABEL FOR FIRST TEST .OP10 ANOP &N SETA &LSUF+1 &LNXT SETC '&LPF.&N._BGN' NEXT .*- .* generate instructions incl branch .*- &S SETC '&SYSLIST(&SLN+1)' &COND SETC UPPER('&s') AIF ('&COND' EQ 'OR').BC0200 AIF (N'&SYSLIST EQ 1).BC0400 AIF (&SLN GE N'&SYSLIST OR '&SYSLIST(&SLN+1)' EQ '').BC0300 .*- .* use inverted branch to end-of-proc for 'and' function .*- &LCUR WSAMIFB &SYSLIST(&SLN),&LPF._END,N AGO .BC0900 .*- .* 'or' : setup branch address by look-ahead .*- .BC0200 ANOP &N SETA &SLN+1 -> CURRENT 'OR' WORD .BC0220 ANOP &N SETA &N+2 -> NEXT 'OR' WORD &S SETC '&SYSLIST(&N)' &COND SETC UPPER('&s') AIF (&N LT N'&SYSLIST AND '&COND' EQ 'OR').BC0220 &N SETA (&N/2)+1 <- NEXT NOT 'OR' COMPARE &LNXT SETC '&LPF.&N._BGN' NEXT .*- .* use inverted branch for 'or' comparison .*- &LCUR WSAMIFB &SYSLIST(&SLN),&LPF.&N._BGN AGO .BC0900 .*- .* last check .*- .BC0300 ANOP &LCUR WSAMIFB &SYSLIST(&SLN),&LNXT J &LPF._END &LNXT EQU * AGO .BC0600 .*- .* only one item .*- .BC0400 ANOP WSAMIFB &SYSLIST(&SLN),&LPF._END,N .* .BC0600 ANOP AIF (K'&SYSLIST(2) EQ 0).THN0000 ONLY 1 ITEM AGO .THN0000 .* .BC0900 ANOP .*- .* next syslist .*- &SLN SETA &SLN+2 AGO .OP00 .EX00 ANOP J &LEX NO GO &LNXT EQU * .*- .* 'then' process .*- .THN0000 aif (k'&then eq 0).thn0900 WSAMINSTR &then ENDIF .THN0900 ANOP .*- .* end of macro .*- .MEXIT MEND MACRO .*----------< WILLOW STRUCTURED ASSEMBLER MACROS >-------------* .* 'ITERATE' [label | OUTER] * .* FUNCTION: JUMP TO START OF CURRENT DO GROUP OR TOP * .* SYNTAX: ITERATE [label] * .*--------------------------------------------------------------------* ITERATE &DOLBL LCLA &N,&M GBLA &WAMDOLV GBLC &WAMDOLB(16) LCLC &S .* &S SETC UPPER('&DOLBL') AIF ('&S' EQ 'OUTER').OUTER AIF ('&S' EQ 'TOP').OUTER AIF (K'&DOLBL GT 0).LBL100 &N SETA &WAMDOLV J &WAMDOLB(&N) MEXIT .* .LBL100 ANOP J &DOLBL._BGN MEXIT .* .OUTER ANOP J &WAMDOLB(1) MEXIT .* MEND MACRO .*----------< WILLOW STRUCTURED ASSEMBLER MACROS >-------------* .* 'LEAVEALL' - BREAK OUT OF ALL DO BLOCKS * .*--------------------------------------------------------------------* LEAVEALL LEAVE ALL MEND MACRO .*----------< WILLOW STRUCTURED ASSEMBLER MACROS >-------------* .* 'SKIP' - unconditional jump around a section * .*--------------------------------------------------------------------* &LBL SKIP GBLC &SKIPLBL &SKIPLBL SETC 'SKP&SYSNDX' J &SKIPLBL MEND MACRO .*----------< WILLOW STRUCTURED ASSEMBLER MACROS >-------------* .* 'ENDSKIP' * .*--------------------------------------------------------------------* ENDSKIP GBLC &SKIPLBL &SKIPLBL CNOP 0,4 MEND MACRO .*----------< WILLOW STRUCTURED ASSEMBLER MACROS >-------------* .* SETUP INSTRUCTION OPERANDS AND BRANCH COND * .*--------------------------------------------------------------------* &LBL WSAMIFB &EXPR,&BADDR,&NEG LCLA &N,&M LCLC &C,&L LCLC &CI EXTRACTED INSTRUCTION LCLC &BI GENERATED BRANCH INSTRUCTION LCLC &ADDR1 1ST ADDRESS OF INSTRUCTION LCLC &ADDR2 2ND ADDRESS OF INSTRUCTION LCLC &COND CONDITION .*- .* setup instruction operands .*- &c setc Upper('&expr(1)') AIF (N'&EXPR EQ 0).T0E AIF (N'&EXPR EQ 1).T100 ONLY COND AIF (N'&EXPR EQ 2).T200 LOAD-AND-TEST AIF (N'&EXPR EQ 3).T300 'SHORT' COMPARE AIF (N'&EXPR EQ 4).T400 4-PART OPERAND AIF (N'&EXPR EQ 5).T500 5-PART OPERAND AIF (N'&EXPR EQ 6 and '&c' eq 'EX').exlong MNOTE 8,'** NUMBER OF EXPRESSIONS GT 5 - &EXPR' MEXIT .T0E MNOTE 8,'** MISSING EXPRESSION' MEXIT .* .*------ 1-PART : ONLY COND SPECIFIED - I.E. (Z) .T100 ANOP &COND SETC UPPER('&EXPR(1)') COND AIF (K'&LBL EQ 0).BC00 &LBL EQU * AGO .BC00 .* .*------ 2-PART : SHORT LOAD-AND-TEST - I.E. (R5,Z) .T200 ANOP &LBL LTR &EXPR(1),&EXPR(1) &COND SETC Upper('&EXPR(2)') COND AGO .BC00 .* .*------ 3-PART : SHORT COMPARE - I.E. (SRCE,EQ,TGT) .T300 ANOP &LBL CLC &EXPR(1),&EXPR(3) &COND SETC Upper('&EXPR(2)') COND AGO .BC00 .* .*------ 4-PART :i.e. (clc,srce,eq,tgt) or (lt,r1,zero,z) .T400 ANOP &CI SETC Upper('&EXPR(1)') CONDITIONAL INSTRUCTION &N SETA K'&EXPR(1) LENGTH OF INSTR &C SETC Upper('&EXPR(4)') condition maybe &ADDR1 SETC '&EXPR(2)' 1ST ADDRESS .* if the condition is in p4 then jump aif ('&c' eq 'Z' or '&c' eq 'NZ' c or '&c' eq 'O' or '&c' eq 'M' c or '&c' eq 'EQ' or '&c' eq 'NE' c or '&c' eq 'GE' or '&c' eq 'GT' c or '&c' eq 'LE' or '&c' eq 'LT').T420 .* the condition is supposedly in p3, i.e. (c,r1,eq,fw1) &ADDR2 SETC '&EXPR(4)' 2ND ADDRESS &COND SETC Upper('&EXPR(3)') COND AGO .T490 .* the condition is in p4, i.e. (lt,r1,fw1,z) .T420 ANOP &ADDR2 SETC '&EXPR(3)' 2ND ADDRESS &COND SETC Upper('&EXPR(4)') COND .* PERFORM INSTRUCTION .T490 ANOP &LBL &CI &ADDR1,&ADDR2 AGO .BC00 .* .*------ 5-PART .T500 ANOP &CI SETC Upper('&EXPR(1)') CONDITIONAL INSTRUCTION AIF ('&CI'(1,1) EQ 'C').T520 .*------ 1) I.E. (ICM,R1,7,SOURCE,Z) &COND SETC Upper('&EXPR(5)') COND &CI &EXPR(2),&EXPR(3),&EXPR(4) AGO .BC00 .*------ 2) I.E. (CLM,R1,1,EQ,SOURCE) .T520 ANOP &COND SETC Upper('&EXPR(4)') COND &CI SETC Upper('&EXPR(1)') CONDITIONAL INSTRUCTION &LBL &CI &EXPR(2),&EXPR(3),&EXPR(5) AGO .BC00 .*------ long EXexute including the executed instructions .ExLong ANOP &l setc 'xl&sysndx' &cond setc upper('&expr(6)') cond &ci setc upper('&expr(3)') EX'd instruction &lbl j &l.b &l.t &ci &expr(4),&expr(5) &l.b ex &expr(2),&l.t AGO .BC00 .* .T999 ANOP .*- .* SETUP BRANCH - NORMAL AND INVERTED .*- .BC00 ANOP &COND SETC Upper('&COND') AIF ('&COND' NE 'EQ').BC100 &COND SETC 'E' CHANGE 'EQ' TO 'E' AGO .BC199 .BC100 AIF ('&COND' NE 'GT').BC101 &COND SETC 'H' CHANGE 'GREATER THAN' TO 'HIGH' AGO .BC199 .BC101 AIF ('&COND' NE 'LT').BC102 &COND SETC 'L' CHANGE 'LESS THAN' TO 'LOW' AGO .BC199 .BC102 AIF ('&COND' NE 'LE').BC103 &COND SETC 'NH' LOW-OR-EQUAL => NOT-HIGH AGO .BC199 .BC103 AIF ('&COND' NE 'GE').BC104 &COND SETC 'NL' GT-OR-EQUAL => NOT-LOW AGO .BC199 .BC104 AIF (T'&COND NE 'N').BC105 aif ('&neg' eq 'N').bc104n jc &cond,&baddr by cond-code ago .bc900 .bc104n jc 15-&cond,&baddr by reversed cond-code ago .bc900 .BC105 ANOP .BC199 ANOP .*------- AIF ('&COND '(1,1) NE 'N' AND '&NEG' NE 'N').BC210 AIF ('&COND '(1,1) EQ 'N' AND '&NEG' NE 'N').BC220 AIF ('&COND '(1,1) NE 'N' AND '&NEG' EQ 'N').BC230 AIF ('&COND '(1,1) EQ 'N' AND '&NEG' EQ 'N').BC240 MNOTE 8,'** ERROR - COND &COND AND NEGATION ''&NEG'' MISMATCH' MEXIT .* NOT NEGATED BY CALLER .BC210 ANOP .BC220 ANOP &BI SETC '&COND' LEAVE TO NORMAL AGO .BC800 .* NOT NEGATIVE CONDITION, NEGATED .BC230 ANOP &BI SETC 'N&COND' NEGATE CONDITION AGO .BC800 .* NEGATIVE CONDITION, NOT NEGATED .BC240 ANOP &N SETA (K'&COND)-1 NORMAL IS NEGATIVE &BI SETC '&COND'(2,&N) INVERTED WILL BE POSITIVE .* .BC800 ANOP AIF (K'&BADDR EQ 0).BC900 NO ADDRESS PROVIDED B&BI &BADDR .BC900 ANOP .*- .* END OF MACRO .*- .MEXIT ANOP MEND Macro .*----------< WILLOW STRUCTURED ASSEMBLER MACROS >-------------* .* IIF - short IF/ELSE/ENDIF * .*--------------------------------------------------------------------* IIF &cond,&true,&false IF &cond WSAMINSTR &true ELSE WSAMINSTR &false ENDIF MEND MACRO .*----------< WILLOW STRUCTURED ASSEMBLER MACROS >-------------* .* start of data block (not really part of WSAM) * .*--------------------------------------------------------------------* &name DATABLK gblc &WSAMDBLK &wsamdblk setc 'WSAMDBLK_&sysndx' cnop 0,4 j &wsamdblk._END Mend MACRO .*----------< WILLOW STRUCTURED ASSEMBLER MACROS >-------------* .* end of data block (not really part of WSAM) * .*--------------------------------------------------------------------* DATABLKE gblc &WSAMDBLK &wsamdblk._END ds 0a Mend MACRO .*----------< WILLOW STRUCTURED ASSEMBLER MACROS >-------------* .* Generate LTORG in instruction block (not really part of WSAM) * .*--------------------------------------------------------------------* LITERALS lclc &l &l setc 'ILT&sysndx' j &l LTORG &l ds 0h Mend MACRO .*----------< WILLOW STRUCTURED ASSEMBLER MACROS >-------------* .* Generate instruction (internal support macro) * .* Operands needs to remain separated for macro calls * .*--------------------------------------------------------------------* &ml WSAMINSTR &istr lclc &i,&o lcla &n,&m &i setc '&istr(1)' aif (n'&istr eq 1).gen1 aif (n'&istr eq 2).gen2 aif (n'&istr eq 3).gen3 aif (n'&istr eq 4).gen4 mnote 8,'Too many operands' mexit .gen1 &i mexit .gen2 &i &istr(2) mexit .gen3 &i &istr(2),&istr(3) mexit .gen4 &i &istr(2),&istr(3),&istr(4) mexit Mend .*----------< WILLOW STRUCTURED ASSEMBLER MACROS >-------------* .* * .* Select..when..endselect * .* * .* Syntax: * .* Select * .* When expr1 * .* ..action for expr1.. * .* (Endwhen) * .* When expr2 * .* ..action for expr2.. * .* (Endwhen) * .* When other * .* ..action for anything else.. * .* (Endwhen) * .* Endselect * .* * .* Select..when..endselect is just a wrapper for if..elseif..endif. * .* EndWhen is a null statements and is not really required, but the * .* macro group looks better if endwhen is used. * .* Select..when..endselect can be nested. * .* * .* exprx see the IF statemnt for details (max 20 expression lists). * .* 'when other' is optional. * .* * .* Sample * .* * .* Select * .* When (=c'COPY',eq,parm1),and,(cli,parm2,ne,c' ') * .* Call CopyMbr * .* Endwhen * .* When (=c'COPY',eq,parm1) * .* Call CopyAll * .* Endwhen * .* When other * .* Call ParmErr * .* Endwhen * .* Endselect * .* * .*--------------------------------------------------------------------* Macro &mlbl SELECT gbla &selectinit &selectinit seta 0 Mend Macro &l WHEN &t1,&t2,&t3,&t4,&t5,&t6,&t7,&t8,&t9,&t10, c &t11,&t12,&t13,&t14,&t55,&t16,&t17,&t18,&t19,&t20 gbla &selectinit lclc &s &s setc upper('&t1') aif ('&s' eq 'OTHER').other aif (&selectinit eq 1).elseif &l IF &t1,&t2,&t3,&t4,&t5,&t6,&t7,&t8,&t9,&t10, c &t11,&t12,&t13,&t14,&t55,&t16,&t17,&t18,&t19,&t20 &selectinit seta 1 mexit .elseif anop &l ELSEIF &t1,&t2,&t3,&t4,&t5,&t6,&t7,&t8,&t9,&t10, c &t11,&t12,&t13,&t14,&t55,&t16,&t17,&t18,&t19,&t20 mexit .other anop &l ELSE Mend Macro &l ENDSELECT &l ENDIF mexit mend Macro &l ENDWHEN Mend