Operating System - OpenVMS
1748265 Members
3655 Online
108760 Solutions
New Discussion

Re: Compiler Options and COMP values on Disk

 
SOLVED
Go to solution
Hein van den Heuvel
Honored Contributor

Re: Compiler Options and COMP values on Disk

Howdie Homer !

 

A while back I had the challenge of a bunch of which could be compiled as IEEE or programs F_FLOAT, yet had to call LIB$WAIT the right way. Unfortunately, Cobol does not really have conditional compiles.

I opted for a dynamic solution.

What we did was to replace all existing calls to LIB$WAIT with LIB_WAIT.

That function figured out how it was compiled by checking the bit pattern for the floating point value.

When it recognized the value, it called LIB$WAIT with the required argument type flag.

I don't think you need this, but it may further the understanding (or the confusion :-).

 

Code below.

Cheers!

Hein

 

IDENTIFICATION DIVISION.
PROGRAM-ID. lib_wait.
AUTHOR. Hein van den Heuvel.
*
* This is a helper wrapper around LIB$WAIT to call it with the
* correct floating point variable type.
* The requirement is that this module is compiled with the same
* floating point option as the calling program
* The LIB$WAIT function itself expects a 4 bytes VAX / F_float
* if no further parameters are provided.
*
DATA DIVISION.
WORKING-STORAGE SECTION.
*
*
01 x_implementation_float       USAGE COMP-1 VALUE 0.001.
01 x_binary REDEFINES x_implementation_float PIC 9(9) USAGE COMP.
01 x_f_floating                 PIC 9(9) USAGE COMP VALUE 309279619.
01 x_IEEE_S_floating            PIC 9(9) USAGE COMP VALUE 981668463.
01 IEEE_S_floating              PIC 9(9) USAGE COMP VALUE 4.
01 return_status                PIC 9(9) USAGE COMP.
01 x_display                  PIC 9(9).

LINKAGE SECTION.
01 delay_time                   PIC 9(9) USAGE COMP.

PROCEDURE DIVISION USING delay_time GIVING return_status.
MY_MAIN SECTION.
MAIN.
*
* Find out what type the calling float is likely to be by
* comparing known binary representation for the float value 0.001
* Wanted to use 1.0 as sample value, but its IEEE_S binary value
* is 1065353216 which does not fit in PIC 9(9) COMP.
* PIC 9(10) gives an 8 byte, BINARY-LONG does not work on VAX.
*
    IF x_binary = x_f_floating
*Debug:
    DISPLAY "LIB_WAIT Compiled as F_float."
        CALL "lib$wait" USING BY REFERENCE delay_time
                        GIVING return_status
    ELSE
       IF x_binary = x_IEEE_S_floating
*Debug:
    DISPLAY "LIB_WAIT Compiled as IEEE_S_float."
           CALL "lib$wait" USING BY REFERENCE delay_time,
                        OMITTED, IEEE_S_floating GIVING return_status
       ELSE
           MOVE x_binary TO x_display
           DISPLAY "Value for 0.001 as COMP-1 in decimal",
                   " was unexepected : ", x_display
           CALL "sys$exit"  USING BY VALUE 16
       END-IF
    END-IF.

    EXIT PROGRAM.
END PROGRAM lib_wait.

 

 

 

 

 

Homer Shoemaker
Frequent Advisor

Re: Compiler Options and COMP values on Disk

Hello Hein!

 

That is pretty cool.  I will remember that approach.  But you are correct, I don't need to do that here.  Even so, I always enjoy looking at an elegant solution.  It's the fun part of programming.

 

Thank you,

 

Homer

John Gillings
Honored Contributor

Re: Compiler Options and COMP values on Disk

Yet another method of feline dermis removal...

 

Since the issue here is really the data type of the unit for specifying the delay time, we can get that out of the picture by writing a routine which uses a more tractable unit. Attached is a MACRO32 routine which accepts an INTEGER delay time expressed in thousanths of a second. The LIB$WAIT FLAG argument is optional.

 

 

        .TITLE WaitThousanths
;
;  Same as LIB$WAIT except the "seconds" argument is an INTEGER units 1/1000th second
;  this avoids issues of floating point incompatibility
;
        .ENTRY DELAY_THOUSANTHS,^M<>
        PUSHL #0                 ; default flags
        CMPL (AP),#2             ; check for flags argument
        BLSS NoFlag
          MOVL @8(AP),(SP)       ; copy flags argument
        NoFlag:
        PUSHL @4(AP)             ; copy delay argument
        CVTLF (SP),(SP)          ; convert to F_FLOAT
        DIVF  #^F1000.0,(SP)     ; convert to seconds
        PUSHAL 4(SP)             ; build argument list
        PUSHAL 4(SP)
        CALLS #2,G^LIB$WAIT      ; pass to LIBRTL
        RET
        .END

 

for a 5 second wait from COBOL

 

CALL "DELAY_THOUSANTHS" USING BY REFERENCE 5000.

 

If you need more precision than thousanths, just change the divisor (but I don't think you'll be able to reduce the granularity to less than 100ns).

 

A crucible of informative mistakes
Homer Shoemaker
Frequent Advisor

Re: Compiler Options and COMP values on Disk

I gotta try that!

 

Thanks

Richard_Maher
Senior Member

Re: Compiler Options and COMP values on Disk

Hi Homer,

 

1) If you're really talking "COMP-3" data then you're talking packed-decimal which will not be affected at all by your choice /FLOAT qualifier.

2) Because you are already using "include file[s]" it would not be unusual to have an architecture-specific COPY-book on the search list.

3) Hein is not entirely correct when he says " Unfortunately, Cobol does not really have conditional compiles" as can be seen in the attached example that works both on VAX and IA64.

 

Hope everyone had a great Christmas and all the best for the coming year!

 

Cheers Richard Maher

 

PS. On my Alpha and IA64 code I seem to be compiling with /FLOAT=D_FLOAT (where lib$wait is involved) for some reason but can't remember why?

Dennis Handly
Acclaimed Contributor

Re: Compiler Options and COMP values on Disk

>3) Hein is not entirely correct when he says "Unfortunately, COBOL does not really have conditional compiles"

 

Right, the COBOL Standard only supported the DEBUG module.  But various vendors have added their own extensions, including COBOL II on MPE.

Hoff
Honored Contributor

Re: Compiler Options and COMP values on Disk

Hein and Dennis are technically correct within the COBOL language (and outside of Richard's DEBUG pieces), but all of these fine folks are incorrect in common programming practice.

 

COBOL has had conditional compilation available for many, many years, and conditional compilation is part of the available language specifications.  Hein and Dennis are simply looking at the wrong language specifications. :-)

 

C.  I'ts not just the first letter of COBOL, it's an entirely functional preprocessor for COBOL.

 

Specifically, the command for conditional processing within COBOL is:

 

  C /PREPROCESS_ONLY=whatever-out.COB /DEFINE=whatever-define whatever-in.COB

 

This also works for Fortran, and for various other languages.

 

(For completeness: Fortran 95 does have its own syntax for conditional compilation, and it's probably feasible to port the coco preprocessing tool over to VMS.  gfortran uses the c preprocessor.  The OpenVMS Fortran compiler appears to lack this (optional) part of the standard, given the diagnostics showing for the syntax, and the OpenVMS Fortran compiler doesn't follow gfortran's lead of invoking cpp (C /PREPROCESS_ONLY) as part of its compilation.  The OpenVMS Fortran SPD also lacks any specific references to the conditional compilation support.  But I digress.)

 

Using C /PREPROCESS_ONLY is easier than rolling your own macro preprocessor for COBOL, but that works nicely, too, particularly if you're using Python, Lua or other text-savvy languages, and there are toolkits around.

 

It'd also be nice if the C preprocessor were callable and added into COBOL and Fortran compilations, but I'd hope that getting all of these languages forward to the current language standards (all three are woefully down-revision) should be a higher priority.

Richard J Maher
Trusted Contributor

Re: Compiler Options and COMP values on Disk

> Hein and Dennis are technically correct within the COBOL language

> (and outside of Richard's DEBUG pieces), but all of these fine folks

> are incorrect in common programming practice.

 

Sorry "DEBUG pieces"? Which bit of the following are you struggling with: -

 

COBOL

  /CONDITIONALS

   /CONDITIONALS[=(character,...)]
   /NOCONDITIONALS                  (D)

   Controls whether the conditional compilation lines in a source
   program are compiled or treated as comments.  Specifying
   /CONDITIONALS results in all conditional compilation lines
   being compiled.

   Specifying /CONDITIONALS=(selector,...), where a selector is
   a list of one or more characters from A to Z, results in the
   selected conditional compilation lines being compiled.  If
   you specify more than one selector, separate them with commas
   and enclose the list in parentheses.

   The default, /NOCONDITIONALS, results in all conditional
   compilation lines being treated as comments during
   compilation.

 

Try compiling my demo_wait.cob with[out] /CONDITIONALS or /CONDITIONALS=F and compare the results. Leave out any debug qualifiers and sorry for having confused you by leaving the P1="Y" for debug code in a command file I copied.

 

I'm not saying it's as powerful as other languages (certainly not MACROs) but conditional compilation it has.

 

Having said that, I still maintain that options 1 and 2 from my previous post are the more common solutions to this "problem".

 

Regards Richard Maher

Hoff
Honored Contributor

Re: Compiler Options and COMP values on Disk

Struggle?  Nah.  Here's what the COBOL SPD says about the conditionals feature I referred to as "DEBUG":   "Conditional compilation serves to make debugging easier."  Debugging.  Can it be used for more than that?  Sure.  That's why I wrote "outside of..." there.  But this extension is still very limited.

 

 

The following is composed in the input box...

 

#if WHAT_YOU_HAVE_WORKS_FOR_YOU

#pragma message ("then by all means use it")

#else

#if __VAX

VAX condional COBOL code here

#elif __ALPHA

Alpha-specific COBOL code here

#elif __IA64

Itanium-specific COBOL code here

#else

#pragma message ("who or what am I?")

#endif

#define SOMESPEC ddcu:[dir]file.ext

#define SOMEMACRO FOO(X) SOME-COBOL-STATEMENT x

#endif

 

As weak as C macros and the C preprocessor are for this sort of stuff, the DEC COBOL /CONDITIONAL extension pieces are yet weaker.

 

It's also possible to use this C preprocessor sequence for non-VMS (portable, conditional) COBOL, too, within the limits of common preprocessor statements.  (The C #pragma stuff  isn't necessarily portable, but that's typical of C and not specific to the use of the C preprocessor itself.)

 

As for "newer" COBOL 2002, that looks to be fairly fairly reasonable.  (Though I haven't looked to see if there are conditional compilaion capabilities available in 2002; I'd hope so; the DEC COBOL /CONDITIONAL stuff is an extension.)

jreagan
Advisor

Re: Compiler Options and COMP values on Disk

Using the C preprocessor on COBOL code makes for odd debugging situations.  I'm not sure what the compiler will do for any #file or #line directives left in the output.  Using the language feature (while not the most flexable) gives the best debugging results.