| Author |
Dynamically Determine Numeric PICTURE String
|
|
| Rick Smith 2007-03-24, 3:55 am |
| I question whether there is any real need for this;
but I was thinking about some parts of COBOL
and ... well ... one thing led to another.
This program works only when ANSI truncation
is in effect.
-----
$set ans85 flag"ans85" flagas"s"
identification division.
program-id. find-pic.
data division.
working-storage section.
01 item pic s9(14)v9(4) comp.
01 pic-work-area.
02 counts.
03 minus-sign pic 9(2) value 0.
03 9s-before pic 9(2) value 0.
03 9s-after pic 9(2) value 0.
02 pic-work.
03 int-part pic -9(18).
03 frac-part pic .9(18)-.
02 pic-string pic x(12) value spaces.
02 string-pos pic s9(4) binary value 0.
procedure division.
begin.
initialize pic-work-area
add -999999999999999999 -.999999999999999999
giving item
move item to int-part frac-part
inspect pic-work tallying
minus-sign for all "-"
9s-before for all "9" before "."
9s-after for all "9" after "."
move 1 to string-pos
if 9s-after > 0
string
")" delimited by size
function reverse (9s-after (1:))
delimited by "0"
"(9v" delimited by size
into pic-string
pointer string-pos
end-string
end-if
if 9s-before > 0
string
")" delimited by size
function reverse (9s-before (1:))
delimited by "0"
"(9" delimited by size
into pic-string
pointer string-pos
end-string
end-if
if minus-sign > 0
string "s"
delimited by size
into pic-string
pointer string-pos
end-string
end-if
subtract 1 from string-pos
move function reverse (pic-string (1:string-pos))
to pic-string
display pic-string (1:string-pos)
stop run.
-----
| |
| Rick Smith 2007-03-24, 3:55 am |
|
"Rick Smith" <ricksmith@mfi.net> wrote in message
news:13085kf5ukmp595@corp.supernews.com...
> I question whether there is any real need for this;
> but I was thinking about some parts of COBOL
> and ... well ... one thing led to another.
Well ... another thing led to another when I realized
I had not accounted for "P" in the PICTURE string.
This program works only when ANSI truncation
is in effect.
-----
$set ans85 flag"ans85" flagas"s"
identification division.
program-id. find-pic.
data division.
working-storage section.
01 item comp pic sp(3)9(3).
01 pic-work-area.
02 counts.
03 minus-sign pic 9(2) value 0.
03 9s-before pic 9(2) value 0.
03 0s-before pic 9(2) value 0.
03 0s-after pic 9(2) value 0.
03 9s-after pic 9(2) value 0.
02 pic-work.
03 int-part pic -(17)9.
03 frac-part pic .9(18)-.
02 pic-string pic x(12) value spaces.
02 string-pos pic s9(4) binary value 0.
procedure division.
begin.
initialize pic-work-area
add -999999999999999999 -.999999999999999999
giving item
move item to int-part frac-part
inspect pic-work tallying
minus-sign for all "-"
9s-before for all "9" before "."
0s-before for all "0" after "9" before "."
0s-after for all "0" after "." before "9"
9s-after for all "9" after "."
move 1 to string-pos
if 9s-after > 0
string
")" delimited by size
function reverse (9s-after (1:))
delimited by "0"
"(9" delimited by size
into pic-string
pointer string-pos
end-string
if 0s-after > 0
string
")" delimited by size
function reverse (0s-after (1:))
delimited by "0"
"(p" delimited by size
into pic-string
pointer string-pos
end-string
else
string
"v" delimited by size
into pic-string
pointer string-pos
end-string
end-if
end-if
if 0s-before > 0
string
")" delimited by size
function reverse (0s-before (1:))
delimited by "0"
"(p" delimited by size
into pic-string
pointer string-pos
end-string
end-if
if 9s-before > 0
string
")" delimited by size
function reverse (9s-before (1:))
delimited by "0"
"(9" delimited by size
into pic-string
pointer string-pos
end-string
end-if
if minus-sign > 0
string "s"
delimited by size
into pic-string
pointer string-pos
end-string
end-if
subtract 1 from string-pos
move function reverse (pic-string (1:string-pos))
to pic-string
display pic-string (1:string-pos)
stop run.
-----
| |
| Roger While 2007-03-24, 3:55 am |
| What exactly does this do ?
No input/no ouput ?
Compiled/run with OC.
Roger
"Rick Smith" <ricksmith@mfi.net> schrieb im Newsbeitrag
news:13085kf5ukmp595@corp.supernews.com...
>I question whether there is any real need for this;
> but I was thinking about some parts of COBOL
> and ... well ... one thing led to another.
>
> This program works only when ANSI truncation
> is in effect.
> -----
> $set ans85 flag"ans85" flagas"s"
> identification division.
> program-id. find-pic.
> data division.
> working-storage section.
> 01 item pic s9(14)v9(4) comp.
> 01 pic-work-area.
> 02 counts.
> 03 minus-sign pic 9(2) value 0.
> 03 9s-before pic 9(2) value 0.
> 03 9s-after pic 9(2) value 0.
> 02 pic-work.
> 03 int-part pic -9(18).
> 03 frac-part pic .9(18)-.
> 02 pic-string pic x(12) value spaces.
> 02 string-pos pic s9(4) binary value 0.
> procedure division.
> begin.
> initialize pic-work-area
> add -999999999999999999 -.999999999999999999
> giving item
> move item to int-part frac-part
> inspect pic-work tallying
> minus-sign for all "-"
> 9s-before for all "9" before "."
> 9s-after for all "9" after "."
> move 1 to string-pos
> if 9s-after > 0
> string
> ")" delimited by size
> function reverse (9s-after (1:))
> delimited by "0"
> "(9v" delimited by size
> into pic-string
> pointer string-pos
> end-string
> end-if
> if 9s-before > 0
> string
> ")" delimited by size
> function reverse (9s-before (1:))
> delimited by "0"
> "(9" delimited by size
> into pic-string
> pointer string-pos
> end-string
> end-if
> if minus-sign > 0
> string "s"
> delimited by size
> into pic-string
> pointer string-pos
> end-string
> end-if
> subtract 1 from string-pos
> move function reverse (pic-string (1:string-pos))
> to pic-string
> display pic-string (1:string-pos)
> stop run.
> -----
>
>
>
| |
| Rick Smith 2007-03-24, 3:55 am |
|
"Roger While" <simrw@sim-basis.de> wrote in message
news:eu1867$d27$00$1@news.t-online.com...
> What exactly does this do ?
It provides a series of statements to <insert subject
here>. <g>
It provided, for me, some entertainment while
developing the program.
> No input/no ouput ?
There is a DISPLAY statement (output) after building
the PICTURE string.
> Compiled/run with OC.
Well ... then it might have some use for testing
compilers, though the updated version tests more.
[color=darkred]
> Roger
>
> "Rick Smith" <ricksmith@mfi.net> schrieb im Newsbeitrag
> news:13085kf5ukmp595@corp.supernews.com...
| |
| William M. Klein 2007-03-24, 3:55 am |
| Rick,
I haven't studied your samples, but I was wondering if the '02 Standard
"HIGHEST-/LOWEST-ALGEBRAIC intrinsic functions might not be used for something
like this.
--
Bill Klein
wmklein <at> ix.netcom.com
"Rick Smith" <ricksmith@mfi.net> wrote in message
news:13085kf5ukmp595@corp.supernews.com...
>I question whether there is any real need for this;
> but I was thinking about some parts of COBOL
> and ... well ... one thing led to another.
>
> This program works only when ANSI truncation
> is in effect.
> -----
> $set ans85 flag"ans85" flagas"s"
> identification division.
> program-id. find-pic.
> data division.
> working-storage section.
> 01 item pic s9(14)v9(4) comp.
> 01 pic-work-area.
> 02 counts.
> 03 minus-sign pic 9(2) value 0.
> 03 9s-before pic 9(2) value 0.
> 03 9s-after pic 9(2) value 0.
> 02 pic-work.
> 03 int-part pic -9(18).
> 03 frac-part pic .9(18)-.
> 02 pic-string pic x(12) value spaces.
> 02 string-pos pic s9(4) binary value 0.
> procedure division.
> begin.
> initialize pic-work-area
> add -999999999999999999 -.999999999999999999
> giving item
> move item to int-part frac-part
> inspect pic-work tallying
> minus-sign for all "-"
> 9s-before for all "9" before "."
> 9s-after for all "9" after "."
> move 1 to string-pos
> if 9s-after > 0
> string
> ")" delimited by size
> function reverse (9s-after (1:))
> delimited by "0"
> "(9v" delimited by size
> into pic-string
> pointer string-pos
> end-string
> end-if
> if 9s-before > 0
> string
> ")" delimited by size
> function reverse (9s-before (1:))
> delimited by "0"
> "(9" delimited by size
> into pic-string
> pointer string-pos
> end-string
> end-if
> if minus-sign > 0
> string "s"
> delimited by size
> into pic-string
> pointer string-pos
> end-string
> end-if
> subtract 1 from string-pos
> move function reverse (pic-string (1:string-pos))
> to pic-string
> display pic-string (1:string-pos)
> stop run.
> -----
>
>
>
| |
| Rick Smith 2007-03-24, 3:55 am |
|
"William M. Klein" <wmklein@nospam.netcom.com> wrote in message
news:WmYMh.43132$GU2.17414@fe02.news.easynews.com...
> Rick,
> I haven't studied your samples, but I was wondering if the '02 Standard
> "HIGHEST-/LOWEST-ALGEBRAIC intrinsic functions might not be used for
something
> like this.
>
> --
> Bill Klein
> wmklein <at> ix.netcom.com
I don't see any great advantage to using those functions.
Their use would replace:
add -999999999999999999 -.999999999999999999
giving item
with:
if (lowest-algebraic (item) = 0
compute item = highest-algebraic (item)
else
compute item = lowest-algebraic (item)
end-if
However, it will work for up to 31 digits, without having
62 "9"s in the code.
The HIGHEST-ALEGBRAIC and LOWEST-ALGEBRAIC
functions also work with data that has no PICTURE string;
such as the new BINARY-CHAR, etc.; but that is outside
the scope of this program.
And another thing led to another ... and thanks to the
COBOL 85 de-edit move that I had not considered.
pic z(4),zz9.99bcr
generates
s9(7)v9(2)
So, it appears to be possible to determine the numeric
PICTURE string that holds the same values as a
numeric-edited ittem.
> "Rick Smith" <ricksmith@mfi.net> wrote in message
> news:13085kf5ukmp595@corp.supernews.com...
>
>
| |
| Roger While 2007-03-26, 9:55 pm |
| Top post - Bill does it as well, so do not shout.
Has the advantage that :
a) Does not rely on compiler implemtation of 31 digits
Compilers can implement more/less digits. (OC goes to 36)
b) Does not reley on TRUNC rules.
The problem that I see is what (logically) is one trying
to achieve in moving a maximum/minimum from one format to antother.
(Very strange these 2002/2008 functions)
Roger
"Rick Smith" <ricksmith@mfi.net> schrieb im Newsbeitrag
news:1308reqkl15b346@corp.supernews.com...
>
> "William M. Klein" <wmklein@nospam.netcom.com> wrote in message
> news:WmYMh.43132$GU2.17414@fe02.news.easynews.com...
> something
>
> I don't see any great advantage to using those functions.
>
> Their use would replace:
>
> add -999999999999999999 -.999999999999999999
> giving item
>
> with:
>
> if (lowest-algebraic (item) = 0
> compute item = highest-algebraic (item)
> else
> compute item = lowest-algebraic (item)
> end-if
>
> However, it will work for up to 31 digits, without having
> 62 "9"s in the code.
>
> The HIGHEST-ALEGBRAIC and LOWEST-ALGEBRAIC
> functions also work with data that has no PICTURE string;
> such as the new BINARY-CHAR, etc.; but that is outside
> the scope of this program.
>
> And another thing led to another ... and thanks to the
> COBOL 85 de-edit move that I had not considered.
>
> pic z(4),zz9.99bcr
>
> generates
>
> s9(7)v9(2)
>
> So, it appears to be possible to determine the numeric
> PICTURE string that holds the same values as a
> numeric-edited ittem.
>
>
>
>
|
|
|
|