I've been trying to do number 8, but I'm beginning to think the learning curve
for working with floating point is too much. (I'm also learning assembler at the
same time.)

I thought I'd post what I've done so far.  If it has any worth, perhaps someone
else can assist me with the hard parts.  If not, the cat > /dev/null, anyway it
was fun getting this far.

By the way, I'm fairly confident the algorithm works, but I've no idea how it
works or why, or if it is even a good way to go.  I did it in Rexx first (which
I mangled from something a colleague did).

Here is the Rexx I used as a model:

/* Rexx */
size = 1165  /*    1165 gives 1000 digits    */
numeric digits size
n = 0
asubn = 3
sum = 3
last = no
do size
   n = n + 1
   n1 = n * 2
   n1 = n1 * 2
   n2 = n * n
   n2 = n2 * 4
   d1 = n2 - n1 + 1
   d2 = (n2 * 2) + n1
   d2 = d2 * 2
   asubn = asubn * d1 / d2
   sum = sum + asubn
end
   say n 'iterations'
   say 'pi =' sum * 1
   say
exit 0

Note, that to get the correct value of PI you have to (I think) count the number
of leading zeros in ASUBN, and so PI is precise up to there.

And here is my so far lame attempt at translating that to assembler:

MAIN     LA    R2,10              Number of iterations
          XR    R3,R3              N
          XR    R4,R4              N1
          XR    R6,R6              N2 high (not used)
          XR    R7,R7              N2 low
          XR    R8,R8              D1
          XR    R9,R9              D2
          LD    FR0,=D'3'          ASUBN initalized to 3
          LD    FR4,=D'3'          Result initalized to 3
          LD    FR8,=D'0'          Work
LOOP     DS    0H
          LA    R3,1(,R3)          n = n + 1
          LR    R4,R3              n1 = n * 2
          SLA   R4,1(R0)
          SLA   R4,1(R0)           n1 = n1 * 2
          LR    R7,R3              n2 = n * n
          MR    R6,R3
          SLA   R7,2(R0)           n2 = n2 * 4
          LR    R8,R7              d1 = n2 - n1 + 1
          SR    R8,R4
          LA    R8,1(,R8)
          LR    R9,R7              d2 = (n2 * 2) + n1
          SLA   R9,1(R0)
          AR    R9,R4
          SLA   R9,1(R0)           d2 = d2 * 2
          LDGR  FR8,R8             asubn = asubn * d1 / d2
          CEFR  FR8,FR8            convert to float
          MXDR  FR0,FR8            multiply
          LDGR  FR8,R9             asubn = asubn * d1 / d2
          CEFR  FR8,FR8            convert to float
          DXR   FR0,FR8            divide
          AXR   FR4,FR0            sum = sum + asubn
          LTR   R2,R2              Is it zero?
          BZ    CONVERT            Yes, done, convert to decimal
          BCTR  R2,R0              Decrement counter
          B     LOOP               Loop
*
CONVERT  DS    0H                 Convert to decimal
*      Don't know what to do now....  Even IF the above is correct.


Any help or suggestions welcome!

Regards,
Lindy

Hi all,

--- In z390-assembler-contest@yahoogroups.com, "Don Higgins" <don@...>
wrote:
>
> Congratulations to John Erhman for the first solution to problem 7 -
> calculate the repeating fraction 311/99 = 3.14141414... using single
> precision floating point without using any library functions to do the
> conversion from binary to decimal display format:
>

> Additional solutions to problem 7 may also be forthcoming.  I'll be
> interested to hear how these floating point solutions work on
Hercules as
> I've not done any testing in that environment yet.
>

I have tested P7EH1 successfully on HERCULES. I have done three tests,
all of them successful:

1. On MVS 3.8 running on HERCULES.
2. As a stand-alone program on HERCULES emulating a S/370 machine.
3. As a stand-alone program on HERCULES emulating a ESA/390 machine.

For all the tests I have assembled the code using IFOX00, the nice
ancient assembler in MVS 3.8.

The only changes I have had to do for IFOX00 to assemble the code with
no complains are:

1. Change all the labels to upper case ones.
2. Replace the 'LHI R1,1' instruction with 'LA R1,1', as IFOX00 has no
notice of the LOAD HALFWORD IMMEDIATE instruction.

I have upload the output of the assembly-and-execution job to file
#7/P7EH1-exec.txt in the Files area.

Regards,

Rafa.

From: Binyamin Dissen [mailto:bdissen@...]
Sent: Saturday, December 15, 2007 2:31 PM
To: don@...
Cc: mdixon@...
Subject: ZMFACC Solution for z390 Mainframe Assembler Coding Contest problem

Solution #9 can be improved.

1. EDMK sets a condition code. No need to check for negative.
2. ')' can be placed at the end of the pattern. If the number is positive,
it
is replaced with the fill character. If the number is negative, it is left
unchanged.

          LA    R1,OUT1+5          PRESET CURRENCY SYMBOL IF ZERO
          MVC   OUT1(10),MASK      SET EDIT MASK
          EDMK  OUT1(10),TEST1     EDIT
          BCTR  R1,0               BACK OFF 1 FOR CURRENCY SYMBOL
          MVI   0(R1),C'$'         SET CURRENCY SYMBOL
          BNM   NEXT1              EXIT IF positive number
          BCTR  R1,0               BACK OFF FROM CURRENCY SYMBOL
          MVI   0(R1),C'('         SET BEG PAREN

MASK     DC    X'4020206B2021204B20205D'

OUT1     DC    CL12' '

--
Binyamin Dissen <bdissen@...>
http://www.dissensoftware.com

Director, Dissen Software, Bar & Grill - Israel


Should you use the mailblocks package and expect a response from me,
you should preauthorize the dissensoftware.com domain.

I very rarely bother responding to challenge/response systems,
especially those from irresponsible companies.

A minor variation on a previous solution to problem #1.

Instead of three 20-byte MVCs, I use two, one 20-byte and one 40-byte.
It requires A,B and TEMP to occupy contiguous storage locations.

The code:

* Problem - Swap two 20 byte fields optimized for speed
* Date    - 12/15/07
* Author  - Rafa Pereira
* Ref.    - z390 Mainframe Assembler Coding Contest on www.z390.org
*
* Using just two MVC instructions. A,B and TEMP must be consecutive.
P1MVC2   ZMFACC  CODE,START,NAME='RAFA'
*
          OPEN    (SNAPDCB,(OUTPUT))
*
          MVC     TEMP,A
          MVC     A(L'A+L'B),B
          ZMFACC  CODE,END
          ZMFACC  INPUT,START
          ZMFACC  OUTPUT,START
A        DC      CL20'FIELD A'
B        DC      CL20'FIELD B'
          ZMFACC  INPUT,END
          ZMFACC  OUTPUT,END
TEMP     DS      CL20
*
SNAPDCB  DCB   DSORG=PS,MACRF=W,RECFM=VBA,BLKSIZE=1632,LRECL=125,      X
                DDNAME=SNAPDUMP
*
          END


Cheers,

Rafa.

From: Mark Dixon [mailto:MarkDixon@...]
Sent: Friday, December 14, 2007 7:31 PM
To: Don Higgins
Subject: ZMFACC Solution for z390 Mainframe Assembler Coding Contest problem


Hi Don,

Here is a proposed solution to problem 6, Print a binary byte.

Cheers, Mark Dixon
(University of Western Australia)

* z390  Mainframe Assembler Coding Contest
* Problem 6: Convert a byte of binary to printable zeros and ones
* Solution submitted by Mark Dixon (recently of University of Western Australia)
BinPrt ZMFACC  START

	 LA R7,8 	 Loop Counter
	 LA R4,OutByte  End of output area
	 ICM R3,B'1000',InByte R3 gets the input in top byte
Loop XR R2,R2 	 Clear R2
	 SLDL R2,1 	 Shift top bit of R3 into R2
	 STC R2,0(R4)  Store that bit in a byte
	 LA R4,1(R4)  Increment output address counter
	 BCT R7,Loop 	 Loop till done.
	 TR OutByte,ZeroOne  Translate b'0', b'1' -> c'0', c'1'

	 ZMFACC END

ZeroOne DC C'01'  Translate table for binary to character
IN_START DS 0D  Align for ease of dump interpretation
OUT_START EQU *
InByte DC B'01010011' Sample input
OutByte DS CL8  Output space
IN_END EQU *
OUT_END EQU *

	 END ,

----- Original Message -----

From: Mark Dixon

To: z390-assembler-contest@yahoogroups.com

Sent: Thursday, December 13, 2007 2:02 AM

Subject: [z390-assembler-contest] Decimal Exercise

Does z390 support the decimal data types P and Z and the decimal
instructions such as CVD? If so, an old chestnut of a coding problem
is the representation of a packed decimal number in printable format
with the floating currency sign (eg. $) the decimal place, commas to
separate thousands, millions, etc. and parenthesis to indicate a
negative value.

eg. convert DC PL8'-1234567.90" to DC C" ($1,234,567.90)'

----- Original Message -----

From: Mark Dixon

To: z390-assembler-contest@yahoogroups.com

Sent: Thursday, December 13, 2007 3:02 AM

Subject: [z390-assembler-contest] Decimal Exercise

Does z390 support the decimal data types P and Z and the decimal
instructions such as CVD? If so, an old chestnut of a coding problem
is the representation of a packed decimal number in printable format
with the floating currency sign (eg. $) the decimal place, commas to
separate thousands, millions, etc. and parenthesis to indicate a
negative value.

eg. convert DC PL8'-1234567.90" to DC C" ($1,234,567.90)'

Here is my attempt (just the code without all the other stuff). It
shifts the bits from one register to another, positions them
correctly, saves it, and then converts to Printable.


LA R5,8 COUNT
ICM R3,8,BYTE INSERT BYTE AT BITS 32-39 of 64 bit register
XR R2,R2 (Clear R2)
BITLOOP EQU *
SLL R2,3  (Moves bits 3 positions left - does nothing useful on 1st Pass)
SLDL R2,1 (Moves bit to position 63 of R2 and shifts contents of R2
one bit left)
BCT R5,BITLOOP LOOP
* R2 is now 000x000x000x000x000x000x000x000x
ST R2,FW (Store the bits)
UNPK QW(9),FW(5) (Unpack inserts the needed Fx for each bit)
*
FW  DS F
BYTE DS X (Padding for UNPK from - Also Source of BYTE to be Displayed)
QW  DS XL9 (8 bytes for number + 1 byte padding for UNPK)
--


Robert A. Rosenberg
RAR Programming Systems Ltd.
(646)-349-4025 - Fax
(646)-479-1984 - Cell Phone

--- In z390-assembler-contest@yahoogroups.com, "Peter J Farley III"
<pjfarley3@...> wrote:
>
> Could not resist, the DispBits solition was quite nice, but the TR
> at the end is unnecessarily slow -- a simple NC with 8X'F0' is
> sufficient to make the stored bits displayable.  And faster, unless
> I am sorely mistaken.

And of course, Don's correction of my NC to OC shows once again that
you cannot program without TESTING FIRST (Doh!).  I knew that, I
really did, I swear I did...

Thank you Don for correcting my error.

Peter

Does z390 support the decimal data types P and Z and the decimal
instructions such as CVD?  If so, an old chestnut of a coding problem
is the representation of a packed decimal number in printable format
with the floating currency sign (eg. $) the decimal place, commas to
separate thousands, millions, etc. and parenthesis to indicate a
negative value.

eg. convert DC PL8'-1234567.90" to DC C"  ($1,234,567.90)'

Anyone got it lower than 2mS ?

The last one added for interest, 30 years since I did that.

Sorry Don, I broke your 100 line rule, take the comments out !!

SAMPLE   SUBENTRY
*
* METHOD 1    57.2 mS
* USES SLDL
*
          SR    R2,R2              CLEAR R2
          SR    R3,R3              CLEAR R3
          LA    R4,BITS1           OUTPUT AREA
          LA    R5,8               COUNT
          ICM   R3,8,BYTE          INSERT BYTE AT TOP
BITLOOP1 EQU   *
          SLDL  R2,1               SHIFT NEXT BIT INTO R2
          LTR   R2,R2              IS IT 1 ?
          BZ    INCR               EXIT IF NOT
          MVI   0(R4),C'1'         MARK IT
          SR    R2,R2              CLEAR R2
INCR     EQU   *
          AHI   R4,1               BUMP OUTPUT POINTER
          BCT   R5,BITLOOP1        LOOP
*
* METHOD 2   2.4mS
* USES 2K TABLE
          SR    R2,R2              CLEAR R2
          IC    R2,BYTE            INSERT BYTE TO CONVERT
          SLL   R2,3               * 8
          LA    R3,BITABLE1(R2)    INDEX
          MVC   BITS2(8),0(R3)     MOVE TO OUTPUT
*
* METHOD 3   5mS
* USES 64-BYTE TABLE
          SR    R2,R2              CLEAR R2
          SR    R3,R3              CLEAR R3
          ICM   R3,8,BYTE          INSERT BYTE AT TOP
          SLDL  R2,4               SHIFT 1ST NIBBLE
          SLL   R2,2               * 4
          LA    R2,BITABLE2(R2)    INDEX
          MVC   BITS3(4),0(R2)     MOVE TO OUTPUT
          SR    R2,R2              CLEAR R2
          SLDL  R2,4               SHIFT 2ND NIBBLE
          SLL   R2,2               * 4
          LA    R2,BITABLE2(R2)    INDEX
          MVC   BITS3+4(4),0(R2)   MOVE TO OUTPUT
*
* METHOD 4  49mS  WITHOUT FLAG CONVERSION...44.3mS
* USES ROTATE, WITH ADDED FLAG CONVERSION
          SR    R2,R2              CLEAR R2
          SR    R3,R3              CLEAR R3
          LA    R4,WORK            OUTPUT AREA
          LA    R5,8               COUNT
          ICM   R3,8,BYTE          INSERT BYTE AT TOP
          LR    R2,R3              COPY TO R2
BITLOOP4 EQU   *
          LTR   R2,R2              TEST IT
          BNM   INCR4              EXIT IF -VE
          MVI   0(R4),X'FF'        MARK IT
INCR4    EQU   *
          AHI   R4,1               BUMP OUTPUT POINTER
          RLL   R2,R3,1            ROTATE LEFT INTO R2
          LR    R3,R2              COPY BACK
          BCT   R5,BITLOOP4        LOOP
* CONVERT TO INDICATOR FLAGS
          XC    BITS4(8),WORK      INVERT IT
          OC    WORK,ZEROS         MARK THE ZEROS
          OC    BITS4(8),ONES      MARK THE ONES
          NC    BITS4(8),WORK      COMBINE
          SNAP  STORAGE=(BYTE,BITS4+8),ID=0
*
          SUBEXIT
*
BYTE     DC    X'AB'              A NICE BYTE
*
BITS1    DC    8C'0'
BITS2    DC    8C'0'
BITS3    DC    8C'0'
BITS4    DC    8X'FF'
*
BITABLE1 EQU   *                  2K TABLE
          DC    C'00000000'
          DC    (X'AB'-X'01')CL8' ' I'M NOT DOING IT
          DC    C'10101011'
          DC    (X'FF'-X'AC')CL8' ' I'M NOT DOING IT
          DC    C'11111111'
*
BITABLE2 EQU   *                  64-BYTE TABLE
          DC    C'0000'
          DC    C'0001'
          DC    C'0010'
          DC    C'0011'
          DC    C'0100'
          DC    C'0101'
          DC    C'0110'
          DC    C'0111'
          DC    C'1000'
          DC    C'1001'
          DC    C'1010'
          DC    C'1011'
          DC    C'1100'
          DC    C'1101'
          DC    C'1110'
          DC    C'1111'
*
ZEROS    DC    8C'.'
ONES     DC    C'12345678'
WORK     DS    XL8
*
          LTORG
*
          EQUREGS REGS=GPR
          END

--- In z390-assembler-contest@yahoogroups.com, "mickpoil"
<mickpoil@...> wrote:
>
> --- In z390-assembler-contest@yahoogroups.com, "the_hursley_horror"
> <zarf77777@> wrote:
> >
> > --- In z390-assembler-contest@yahoogroups.com, "Mark Dixon"
> > <mdixon@> wrote:
> > >
> > > MELVYN MALTZ provided sample code to translate hexadecimal to
> > > printable hex.  The code included the comment: "THE REVERSE
OPERATION
> > > IS ALSO POSSIBLE USING TRTO, BUT THIS REQUIRES A 14K TABLE AND
NOT
> > > CONSIDERED WORTHWHILE"
> > >
> > > Perhaps this is the next problem.  I'm pretty sure that
converting
> > > printable-hex to hexadecimal can be done with much less effort
than a
> > > 14K table and might be worthwhile for programs that need to
receive
> > > user input in typed hexadecimal that needs to be stored in
hexadecimal
> > > for processing.
> > >
> >
> > Mark is exactly right.
> > The new instructions TROT and TRTO provide the facility to do
this
> > translation either way in one go, rather than a loop. Up to 2GB
streams
> > may be done, which saves a lot of CPU time.
> >
> > Below you will find both way conversions using what I've
> > termed 'archaic' methods.
> > I have coded examples of looped conversions for long strings, but
> > haven't time to re-invent them now, hope the stuff below will
suffice.
> >
> > When Z390/CICS V4 is published look at Z390CEBR which has many
> > conversions, including typed hex streams.
> >
> > SAMPLE   SUBENTRY
> > *
> > * SAMPLE CODE TO TRANSLATE TRUE HEX TO PRINTABLE HEX
> > * AND BACK TO HEX USING ARCHAIC METHODS
> > *
> > * IT IS COMPLEX TO DO LONG STREAMS WITH THIS METHOD
> > *
> >          UNPK  MYCHAR,MYHEX(7)    UNPACK HEX STREAM
> >          TR    MYCHAR,TABLE-240   TRANSLATE TO CHAR FORM
> > *
> >          MVC   WORK,MYCHAR        SAVE FOR RECONVERT
> >          TR    WORK(12),TRANHXCH-X'C1' TRANSLATE TO UNPACKED HEX
> >          PACK  MYHEX2,WORK        PACK BACK TO HEX
> >          SNAP  ID=0
> > *
> >          SUBEXIT
> > *
> > MYHEX    DC    X'FFA193BC120A'    HEX DATA
> >          DC    X'00'              DUMMY BYTE
> > MYCHAR   DS    XL13               CHAR DATA
> > WORK     DS    XL13               CHAR DATA
> > MYHEX2   DS    XL7                BACK TO HEX
> > *
> > *                  C1C2C3C4C5C6
> > TRANHXCH DC      X'0A0B0C0D0E0F000000000000000000'  C1-CF
> >          DC    32X'00'                              D0-EF
> > *                F0F1F2F3F4F5F6F7F8F9
> >          DC    X'00010203040506070809000000000000'  F0-FF
> > *
> > TABLE    DC    C'0123456789ABCDEF'
> > *
> >          LTORG
> > *
> >          EQUREGS REGS=GPR
> >          END
> >
> I am not sure that Melvyn's TROT example is 100% correct.
>
> From my understanding, TROT is one of the new breed of instructions
> that need to be re-driven when CC=3 is encountered (CPU has
> interrupted it before completion), therefore I think the code should
> look like this to work in all circumstances:
>
> TROT   TROT R6,R8,1
>        BC   1,TROT
>

Thankyou for your contribution.

You are academically correct. All interruptible instructions must
allow for re-drive when executed on a mainframe.

I have been in prior discussion with Don on this subject and I am
assured that Z390 on a PC does not interrupt those instructions.

LCDSECT  DSECT
INBUF    DS    CL32
OUTBUF   DS    CL32
OSTRING  DS    CL32
LCSIZE   EQU   256
          YREGS
***********************************************************************
**       EZSAMPLE start;                                             **
***********************************************************************
EZSAMPLE AMODE 31
EZSAMPLE RMODE ANY
EZSAMPLE CSECT
          USING EZSAMPLE,R12
          BAKR  R14,0
          LR    R12,R15
*
*        **************************************************************
*        *   Allocate terminal I/O Amode 24 buffers;                  *
*        **************************************************************
          STORAGE OBTAIN,LENGTH=LCSIZE,LOC=(BELOW,ANY),COND=NO
*
          USING LCDSECT,R10
          LR    R10,R1
          XC    0(LCSIZE,R10),0(R10)
*
CTOBIN20 EQU   *
          MVC   OSTRING(32),=CL32'Enter char or "?" to end'
          TPUT  OSTRING,32
*
          TGET  INBUF,1                Get a byte via TGET
*
          CLI   INBUF,C'?'             Want to end session?
          JE    CTOBINX                Then end
*
          MVC   OUTBUF(8),TABTR1T8
          TR    OUTBUF(8),INBUF
          NC    OUTBUF(8),TABNC1T8
          TR    OUTBUF(8),TABXTBIN
*
          TPUT  OUTBUF,8               Display the result
*
          J     CTOBIN20               Try next I/char
*
CTOBINX  EQU   *
          SR    R15,R15
          PR
*
***********************************************************************
**       Tranlation tables;                                          **
***********************************************************************
TABTR1T8 DC    256AL1((*-TABTR1T8)/8)
*
TABNC1T8 DC    32X'8040201008040201'
*
TABXTBIN DC    C'0',255C'1'
*
*        **************************************************************
*        *   EZSAMPLE end;                                            *
*        **************************************************************
          LTORG
          END   EZSAMPLE

Could not resist, the DispBits solition was quite nice, but the TR at
the end is unnecessarily slow -- a simple NC with 8X'F0' is sufficient
to make the stored bits displayable.  And faster, unless I am sorely
mistaken.

What fun this is!

Regards,

Peter

LCDSECT  DSECT
INBUF    DS    CL32
OUTBUF   DS    CL32
OSTRING  DS    CL32
LCSIZE   EQU   256
          YREGS
***********************************************************************
**       EZSAMPLE start;                                             **
***********************************************************************
EZSAMPLE AMODE 31
EZSAMPLE RMODE ANY
EZSAMPLE CSECT
          USING EZSAMPLE,R12
          BAKR  R14,0
          LR    R12,R15
*
*        **************************************************************
*        *   Allocate terminal I/O Amode 24 buffers;                  *
*        **************************************************************
          STORAGE OBTAIN,LENGTH=LCSIZE,LOC=(BELOW,ANY),COND=NO
*
          USING LCDSECT,R10
          LR    R10,R1
          XC    0(LCSIZE,R10),0(R10)
*
CTOBIN20 EQU   *
          MVC   OSTRING(32),=CL32'Enter char or "?" to end'
          TPUT  OSTRING,32
*
          TGET  INBUF,1                Get a byte via TGET
*
          CLI   INBUF,C'?'             Want to end session?
          JE    CTOBINX                Then end
*
          MVC   OUTBUF(8),TABTR1T8
          TR    OUTBUF(8),INBUF
          NC    OUTBUF(8),TABNC1T8
          TR    OUTBUF(8),TABXTBIN
*
          TPUT  OUTBUF,8               Display the result
*
          J     CTOBIN20               Try next I/char
*
CTOBINX  EQU   *
          SR    R15,R15
          PR
*
***********************************************************************
**       Tranlation tables;                                          **
***********************************************************************
TABTR1T8 DC    256AL1((*-TABTR1T8)/8)
*
TABNC1T8 DC    32X'8040201008040201'
*
TABXTBIN DC    C'0',255C'1'
*
*        **************************************************************
*        *   EZSAMPLE end;                                            *
*        **************************************************************
          LTORG
          END   EZSAMPLE

Hi Mr. Higgins,

I don't have z390 installed...I'm using a real T-Rex machine.
Anyway I want to thank you for all your great work with z390.

PS.: By the way...my name is wrong in the Contest Web site. :-)

Best regards,

Philippe Leite
z/OS System Programmer
Portugal






--- In z390-assembler-contest@yahoogroups.com, "Don Higgins"
<don@...> wrote:
>
> Philippe
>
>
>
> Thanks for contributing solution all the way from Portugal.  I've
added your
> contribution to the contest web site.  Would you like to add alma
mater
> link?
>