identification division.
 program-id. myapp.
*> compile & link Techtonics:
*> -----------------------------------------------------------
*>  cobc -x -fstatic-call -ffunctions-all -free myapp.cob -ltcl8.5
*> -----------------------------------------------------------
*> Requires Tcl 8.5 (or higher) to be already installed.
 environment division.
 configuration section.
 source-computer. GNU-Linux.
 object-computer. GNU-Linux.
 data division.
 working-storage section.
 1 getstring-ptr       usage is pointer.
 1 cmd                 pic x(256) value spaces.
 1 end-msg             pic x(80) value spaces.
 1 interp              usage is pointer.
 1 tcl-shell.
    2 tclname          pic x(5) value "tclsh".
    2 tclnull          pic x value x"00".
 1 tcl-result          pic s9(9) comp-5 value 0.
 1 tcl-file            pic x(80) value low-values.
 1 filidx              pic s9(9) comp-5 value 0.
 1 filcnt              pic s9(9) comp-5 value 0.
 1 filptr              pic s9(9) comp-5 value 0.

*> -----------------------------------------------------------
 linkage section.
 1 getstring           pic x(256).

*> -----------------------------------------------------------
 procedure division.
     call "Tcl_FindExecutable" using tcl-shell.
     call "Tcl_CreateInterp" returning interp.
     move 0 to tcl-result.
     call "Tcl_Init" using by value interp returning tcl-result.
     if tcl-result not = 0
        Display "Failed to initialize tcl"
        perform display-tcl-getstringresult
        go to abnormal-end.
     go to normal-end.

*> -----------------------------------------------------------
 display-tcl-getstringresult.
     move low-values to cmd.
     call "Tcl_GetStringResult" using by value interp giving getstring-ptr.
     set address of getstring to getstring-ptr.
     move spaces to cmd.
     string getstring delimited by x"00" into cmd.
     Move trim(cmd) To end-msg.

*> -----------------------------------------------------------
 abnormal-end.
      display "Abnormal end of program".

*> -----------------------------------------------------------
 normal-end.
     Move substitute(end-msg, x"00", " ") to end-msg.
     if (length(trim(end-msg)) > 0)
        display end-msg.

     goback.

*> -----------------------------------------------------------
 end program myapp.