From: raveendra.maddila on

Hi All,

Here is a sample code...

A PIC X(04) VALUE IS 'KLMN'.
B REDEFINES A PIC S9(04).
ADD 1000 TO B.
DISPLAY B.

This gives 134E as answer.

Could anyone please let me know how the data is actually stored and how
this operation is performed.

Thanks and Regards,

Raveendra.

From: Michael Mattias on
> Here is a sample code...
>
> A PIC X(04) VALUE IS 'KLMN'.
> B REDEFINES A PIC S9(04).
> ADD 1000 TO B.
> DISPLAY B.
>
> This gives 134E as answer.
>
> Could anyone please let me know how the data is actually stored and how
> this operation is performed.

Text and graphics tutorial on COBOL data types:
http://www.flexus.com/ftp/cobdata.zip

NOTE: the software is old MS-DOS software. Well, actually, the text is old
too, but still every bit correct as when I wrote it (1999).

(My imagination, or have I really been threatening to update that for at
least five years? Tempus sure fugits when you're having fun).

--
Michael Mattias
Tal Systems, Inc.
Racine WI
mmattias(a)talsystems.com



From: SkippyPB on
On Sat, 07 Jan 2006 14:14:16 GMT, "Michael Mattias"
<michael.mattias(a)gte.net> enlightened us:

>> Here is a sample code...
>>
>> A PIC X(04) VALUE IS 'KLMN'.
>> B REDEFINES A PIC S9(04).
>> ADD 1000 TO B.
>> DISPLAY B.
>>
>> This gives 134E as answer.
>>
>> Could anyone please let me know how the data is actually stored and how
>> this operation is performed.
>
>Text and graphics tutorial on COBOL data types:
>http://www.flexus.com/ftp/cobdata.zip
>
>NOTE: the software is old MS-DOS software. Well, actually, the text is old
>too, but still every bit correct as when I wrote it (1999).
>
>(My imagination, or have I really been threatening to update that for at
>least five years? Tempus sure fugits when you're having fun).

I don't know what compiler the OP was using but it seems to me that if
you ADD 1000 TO B, you should abend, not get some hex value.

Regards,
////
(o o)
-oOO--(_)--OOo-


"Liberals feel unworthy of their possessions. Conservatives
feel they deserve everything they've stolen."
--Mort Sahl
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Remove nospam to email me.

Steve
From: charles hottel on
Here is how I think it would work on an IBM mainframe which is an EBCDIC
machine. However the result you gave is different from what I would expect
so you may be using a different machine.

The EBCDIC expression of 'KLMN' in hexadecimal is 'D2D3D4D5'. This must
first be converted to packed decimal before arithmetic can be performed. The
packed decimal equivalent of 'D2D3D4D5' is '02345D' which represents a minus
2345 in three bytes. The 'D' is treated as a minus sign here which is
"lucky" because if there were an invalid sign you would receive a data
exception on the addition. A positive 1000 in packed decimal is '01000C'
where the 'C' is a plus sign. I would expect the addition to produce
'01345D' or a minus 1345. This will then be unpacked and the result placed
into field B will be 'C1C3C4D5' which would display as '134N' not '134E'.
The sign is preserved because field B is defined as containing a sign. If
field B did not contain a sign the compiler would assume the result of the
addition to be positive and would fix up the sign to give '01345C' which
would display as your result of '134E'.

If you do not have an EBCDIC chart then see:
http://www.legacyj.com/cobol/ebcdic.html
Top post no more below.

"raveendra_ibm" <raveendra_ibm.219p90(a)no-mx.forums.yourdomain.com.au> wrote
in message news:raveendra_ibm.219p90(a)no-mx.forums.yourdomain.com.au...
>
> Hi all,
>
> Here is a sample code...
>
> A PIC X(04) VALUE IS 'KLMN'.
> B REDEFINES A PIC S9(04).
> ADD 1000 TO B.
> DISPLAY B.
>
> This gives 134E as answer.
>
> Could anyone please let me know how the data is actually stored and how
> this operation is actually performed.
>
> Thanks and Regards,
> Raveendra.
>
>
> --
> raveendra_ibm
> Message posted via http://www.exforsys.com for all your training needs.
>


From: HeyBub on
raveendra_ibm wrote:
> Hi all,
>
> Here is a sample code...
>
> A PIC X(04) VALUE IS 'KLMN'.
> B REDEFINES A PIC S9(04).
> ADD 1000 TO B.
> DISPLAY B.
>
> This gives 134E as answer.
>
> Could anyone please let me know how the data is actually stored and
> how this operation is actually performed.

Don't have a green (yellow) card, eh?



 |  Next  |  Last
Pages: 1 2 3 4 5 6 7
Prev: Tandem
Next: free implementation? factorial?