Re: another day, another patch ...

Hi JF,

Please spend a little time to test what you're talking about or at least
stop baiting me with talk of COBOL. You, and most others here, really have
no idea.

However, if my program has only loaded 27 items into the array, the
compiler won't know this and will not prevent my program from accessing
item 28.
identification division.
program-id. xxxx.
data division.
working-storage section.
01 my_index pic 9(9) comp value 5.
01 my_table.
03 my_elem pic x(10) occurs 1 to 100 depending on my_index.
procedure division.
00.
move "hello" to my_elem(6).
stop run.
*
end program xxxx.
$ cob x/check=bounds
$ link x
$ run x
%COB-F-SUBSCRIPT, Subscript out of bounds

And in a dynamically allocated array that may grow dynamically
(realloc), you also need to have code to detect when your array is full
so that you can add another chunk of memory to progressively grow it.
(consider receiving an HTML page whose size is unknown, it should be
short, or it could be very very long).

C makes this easy. COBOL isn't very good for that.

Stop talking shit!!!

Below is a complete working example of a VMS predictive text client program
that retrieves matching Employee Surnames from the database and allows the
user to select one from the SMG$ drop-dwon list if they so desire. Look for
lib$vm_realloc. I've included all 800 lines as it is a complete "working"
example. Why don't you go ahead and do it in C and show me how "easy" it is?
(I'll even let you use the Socket API rather than $QIOs) But that would be
tantamount to "establishing facts" and a path to enlightenment wouldn't it?
Then you would no longer be able to run around ranting bigotry such as
"COBOL's crap" and "JavaScript is the Devil".

I've also got two working versions of the Auxillary Server (INETd) program
to go with it; one for RMS (data file included) and the other for Rdb (Uses
mf_personnel.employees).

If you want to see a properly formatted version of the underneath, and its
accompanying server program, just let me know.

Now leave me and COBOL alone so I can get back to my predictive text
JavaScript/HTTML client for VMS Queue lookup. (If you want to do something
really useful, and educational, sign-up for testing that! It's what you'll
all be doing by next year anyway.)

Regards Richard Maher

identification division.
program-id. emp_client.
author. Richard Maher.
data division.
working-storage section.
01 get_names pointer value external
get_names.
01 io$_setmode pic 9(9) comp value external
io$_setmode.
01 io$_writevblk pic 9(9) comp value external
io$_writevblk.
01 io$_readvblk pic 9(9) comp value external
io$_readvblk.
01 io$_access pic 9(9) comp value external
io$_access.
01 smg$_eof pic 9(9) comp value external
smg$_eof.
01 smg$_notpasted pic 9(9) comp value external
smg$_notpasted.
01 smg$m_return_immed pic 9(9) comp value external
smg$m_return_immed.
01 smg$m_bold pic 9(9) comp value external
smg$m_bold.
01 smg$m_reverse pic 9(9) comp value external
smg$m_reverse.
01 smg$m_border pic 9(9) comp value external
smg$m_border.
01 smg$m_cursor_on pic 9(9) comp value external
smg$m_cursor_on.
01 smg$m_cursor_off pic 9(9) comp value external
smg$m_cursor_off.
01 smg$k_trm_ctrlr pic 9(9) comp value external
smg$k_trm_ctrlr.
01 smg$k_trm_ctrlw pic 9(9) comp value external
smg$k_trm_ctrlw.
01 smg$k_trm_ctrlz pic 9(9) comp value external
smg$k_trm_ctrlz.
01 smg$k_trm_space pic 9(9) comp value external
smg$k_trm_space.
01 smg$k_trm_delete pic 9(9) comp value external
smg$k_trm_delete.
01 smg$k_trm_left pic 9(9) comp value external
smg$k_trm_left.
01 smg$k_trm_right pic 9(9) comp value external
smg$k_trm_right.
01 smg$k_trm_bs pic 9(9) comp value external
smg$k_trm_bs.
01 smg$k_trm_uppercase_a pic 9(9) comp value external
smg$k_trm_uppercase_a.
01 smg$k_trm_uppercase_z pic 9(9) comp value external
smg$k_trm_uppercase_z.
01 smg$k_trm_lowercase_a pic 9(9) comp value external
smg$k_trm_lowercase_a.
01 smg$k_trm_lowercase_z pic 9(9) comp value external
smg$k_trm_lowercase_z.
01 smg$k_trm_zero pic 9(9) comp value external
smg$k_trm_zero.
01 smg$k_trm_nine pic 9(9) comp value external
smg$k_trm_nine.
01 smg$k_trm_percent_sign pic 9(9) comp value external
smg$k_trm_percent_sign.
01 smg$k_trm_underline pic 9(9) comp value external
smg$k_trm_underline.
01 smg$k_trm_minus pic 9(9) comp value external
smg$k_trm_minus.
01 smg$k_trm_enter pic 9(9) comp value external
smg$k_trm_enter.
01 smg$k_trm_cr pic 9(9) comp value external
smg$k_trm_cr.
01 smg$k_trm_select pic 9(9) comp value external
smg$k_trm_select.
01 ss$_abort pic 9(9) comp value external
ss$_abort.
01 ss$_reject pic 9(9) comp value external
ss$_reject.
01 ss$_nopriv pic 9(9) comp value external
ss$_nopriv.
01 ss$_wasset pic 9(9) comp value external
ss$_wasset.
01 ss$_wasclr pic 9(9) comp value external
ss$_wasclr.
01 ss$_normal pic 9(9) comp value external
ss$_normal.
01 sys_status pic 9(9) comp.
*
01 ast_ctx.
03 pasteboard_id pic 9(9) comp.
03 menu_display pic 9(9) comp.
03 running_len pic 9(9) comp.
03 net_chan pic 9(4) comp.
03 pic 9(4) comp.
03 argus_sleeping pic 9(9) comp.
03 ast_iosb.
05 ast_cond_val pic 9(4) comp.
05 ast_byte_count pic 9(4) comp.
05 pic 9(9) comp.
03 running_name pic x(20).
03 reply_buffer pic x(512).
*
01 iosb.
03 cond_val pic 9(4) comp.
03 byte_count pic 9(4) comp.
03 pic 9(9) comp.
*
01 create_socket.
03 pic s9(4) comp value external
ucx$c_tcp.
03 pic s9(4) comp value external
inet_protyp$c_stream.
*
01 local_sock_desc.
03 pic s9(9) comp value 16.
03 pointer value
reference local_addr.
01 local_addr.
03 pic s9(4) comp value external
ucx$c_af_inet.
03 local_port_number.
05 low_byte pic x value
low-values.
05 high_byte pic x value
low-values.
03 pic s9(9) comp value external
ucx$c_inaddr_any.
03 pic x(8).
*
01 rem_sock_desc.
03 pic s9(9) comp value 16.
03 pointer value
reference rem_addr.
*+
* In this example the JAVA_EMP server is listening on port 3333 at node
address 1.2.3.6
* NB: The port number is specified in network byte order.
*-
01 rem_addr.
03 pic s9(4) comp value external
ucx$c_af_inet.
03 rem_port_number.
05 low_byte pic x value x"0D".
05 high_byte pic x value x"05".
03 rem_node_addr.
05 pic x value x"01".
05 pic x value x"02".
05 pic x value x"03".
05 pic x value x"06".
03 pic x(8).
*
01 sock_opt_desc.
03 sock_opt_len pic s9(4) comp value 24.
03 pic s9(4) comp value external
ucx$c_sockopt.
03 pointer value
reference sock_opt.
01 sock_opt.
03 pic s9(4) comp value 4.
03 pic s9(4) comp value external
ucx$c_reuseaddr.
03 pointer value
reference opt_on.
03 pic s9(4) comp value 4.
03 pic s9(4) comp value external
ucx$c_full_duplex_close.
03 pointer value
reference opt_on.
03 pic s9(4) comp value 4.
03 pic s9(4) comp value external
ucx$c_keepalive.
03 pointer value
reference opt_on.
*
01 tcp_opt_desc.
03 pic s9(4) comp value 8.
03 pic s9(4) comp value external
ucx$c_tcpopt.
03 pointer value
reference tcp_opt.
01 tcp_opt.
03 pic s9(4) comp value 4.
03 pic s9(4) comp value external
ucx$c_tcp_probe_idle.
03 pointer value
reference connect_timeout.
*
01 opt_on pic s9(9) comp value 1.
01 opt_off pic s9(9) comp value 0.
01 connect_timeout pic s9(9) comp value 10.
*
01 user_exit pic x value "N".
*
01 menu_desc external.
03 cell_size pic 9(4) comp.
03 dtype pic x(1).
03 dclass pic x(1).
03 base_addr pointer.
03 pic 9(4) comp.
03 flags pic x(1).
03 dimct pic x(1).
03 bytes_allocated pic 9(9) comp.
03 element_zero pic 9(9) comp.
03 stride pic 9(9) comp.
03 lwr_b pic 9(9) comp.
03 line_count pic 9(9) comp.
*
01 out_len pic 9(4) comp.
01 keyboard_id pic 9(9) comp.
01 screen_display pic 9(9) comp.
01 row_cnt pic 9(9) comp.
01 col_cnt pic 9(9) comp.
01 menu_rows pic 9(9) comp.
01 menu_cols pic 9(9) comp.
01 option pic 9(4) comp.
01 option_string pic x(20).
01 terminator pic 9(4) comp.
01 in_byte redefines
terminator pic x(1).
*
01 eof_msg.
03 pic x(2) value "99".
03 pic x(2) value x"0d0a".
*
procedure division.
kick_off section.
00.
perform socket_and_connect.
if sys_status not = ss$_normal go to fini.

perform screen_setup.
if sys_status not = ss$_normal go to fini.

perform get_input until user_exit not = "N" or sys_status not =
ss$_normal.
if sys_status not = ss$_normal go to fini.

if user_exit = "S" perform employee_lookup.
if sys_status not = ss$_normal go to fini.

perform socket_close.
*
fini.
call "smg$set_cursor_mode" using pasteboard_id, smg$m_cursor_on.

if argus_sleeping not = zeros
call "sys$waitfr" using by value argus_sleeping.

call "smg$unpaste_virtual_display" using menu_display, pasteboard_id.
call "sys$exit" using by value sys_status.
*
get_input section.
00.
call "smg$read_keystroke" using keyboard_id, terminator giving
sys_status.
if sys_status = smg$_eof
move ss$_normal to sys_status
move "Y" to user_exit
go to fini
else
if sys_status not = ss$_normal
call "lib$stop" using by value sys_status.

evaluate terminator
when smg$k_trm_ctrlz move "Y" to user_exit
go to fini
when smg$k_trm_delete
when smg$k_trm_left
when smg$k_trm_bs perform delete_char
when smg$k_trm_right move smg$k_trm_space to terminator
perform insert_char
when smg$k_trm_uppercase_a thru
smg$k_trm_uppercase_z perform insert_char
when smg$k_trm_lowercase_a thru
smg$k_trm_lowercase_z perform insert_char
when smg$k_trm_percent_sign
when smg$k_trm_underline
when smg$k_trm_space
when smg$k_trm_minus perform insert_char
when smg$k_trm_zero thru
smg$k_trm_nine perform insert_char
when smg$k_trm_enter
when smg$k_trm_cr move "S" to user_exit
go to fini
when smg$k_trm_select perform menu_choice
when smg$k_trm_ctrlr
when smg$k_trm_ctrlw call "smg$repaint_screen" using
pasteboard_id
when other call "smg$ring_bell" using
screen_display
end-evaluate

go to fini.
*
delete_char.
if running_len = zeros
call "smg$ring_bell" using screen_display
else
move space to running_name(running_len:1)
subtract 1 from running_len
perform repaint_name.
*
insert_char.
if running_len = 20
call "smg$ring_bell" using screen_display
else
add 1 to running_len
move in_byte to running_name(running_len:1)
perform repaint_name.
*
repaint_name.
move 1 to row_cnt.
move 38 to col_cnt.
call "smg$put_chars"
using by reference screen_display
by descriptor running_name
by reference row_cnt, col_cnt, omitted, smg$m_reverse
giving sys_status.
if sys_status not = ss$_normal call "lib$stop" using by value
sys_status.

call "sys$dclast"
using by value get_names
by reference ast_ctx
by value 0
giving sys_status.
if sys_status not = ss$_normal call "lib$stop" using by value
sys_status.
*
fini.
*
menu_choice section.
00.
*+
* Wait for array quiet-point
*-
call "sys$waitfr" using by value argus_sleeping giving sys_status.
if sys_status not = ss$_normal call "lib$stop" using by value
sys_status.

if line_count = zeros
call "smg$ring_bell" using screen_display
go to fini.

move spaces to option_string.
call "smg$select_from_menu"
using by reference keyboard_id, menu_display, option,
by value 0
by reference smg$m_return_immed
by value 0, 0
by reference terminator
by descriptor option_string
by reference smg$m_reverse, smg$m_bold
giving sys_status
if sys_status not = ss$_normal and smg$_eof
call "lib$stop" using by value sys_status.

if sys_status = smg$_eof move "Y" to user_exit.

call "smg$unpaste_virtual_display" using menu_display, pasteboard_id
giving sys_status.
if sys_status not = ss$_normal call "lib$stop" using by value
sys_status.

if user_exit = "Y" go to fini.

call "str$trim"
using by descriptor running_name, option_string
by reference running_len
giving sys_status.
if sys_status not = ss$_normal call "lib$stop" using by value
sys_status.

move 1 to row_cnt.
move 38 to col_cnt.
call "smg$put_chars"
using by reference screen_display
by descriptor running_name
by reference row_cnt, col_cnt, omitted, smg$m_reverse
giving sys_status.
if sys_status not = ss$_normal call "lib$stop" using by value
sys_status.
*
fini.
*
socket_and_connect section.
00.
call "sys$assign"
using by descriptor "_BG:"
by reference net_chan
by value 0, 0, 0
giving sys_status.
if sys_status not = ss$_normal call "lib$stop" using by value
sys_status.
*
call "sys$qiow"
using by value 0, net_chan, io$_setmode
by reference iosb
by value 0, 0
by reference create_socket, omitted, local_sock_desc
by value 0
by reference sock_opt_desc
by value 0
giving sys_status.
if sys_status = ss$_normal move cond_val to sys_status.
if sys_status not = ss$_normal call "lib$stop" using by value
sys_status.
*+
* Set the connect timeout to 10 secs. TCPWARE requires privilege to do this.
*-
call "sys$qiow"
using by value 0, net_chan, io$_setmode
by reference iosb
by value 0, 0, 0, 0, 0, 0
by reference tcp_opt_desc
by value 0
giving sys_status.
if sys_status = ss$_normal move cond_val to sys_status.
if sys_status not = ss$_normal and ss$_nopriv
call "lib$stop" using by value sys_status.
*+
* Request a logical link connection to the Java_Emp server.
*-
call "sys$qiow"
using by value 0, net_chan, io$_access
by reference iosb
by value 0, 0, 0, 0
by reference rem_sock_desc
by value 0, 0, 0
giving sys_status.
if sys_status = ss$_normal move cond_val to sys_status.
if sys_status = ss$_reject
display "Java_Emp is not running on remote node."
else
if sys_status not = ss$_normal
call "lib$stop" using by value sys_status.
*
fini.
*
socket_close section.
00.
if argus_sleeping not = zeros
call "sys$waitfr" using by value argus_sleeping.

move function length (eof_msg) to out_len.
call "sys$qiow"
using by value 0, net_chan, io$_writevblk
by reference iosb
by value 0, 0
by reference eof_msg
by value out_len, 0, 0, 0, 0
giving sys_status.
if sys_status = ss$_normal move cond_val to sys_status.
if sys_status not = ss$_normal call "lib$stop" using by value
sys_status.

call "sys$dassgn" using by value net_chan giving sys_status.
*
screen_setup section.
00.
call "smg$create_pasteboard"
using pasteboard_id, omitted, row_cnt, col_cnt
giving sys_status.
if sys_status not = ss$_normal call "lib$stop" using by value
sys_status.

call "smg$create_virtual_keyboard" using keyboard_id giving sys_status.
if sys_status not = ss$_normal call "lib$stop" using by value
sys_status.

call "lib$get_ef" using argus_sleeping giving sys_status.
if sys_status not = ss$_normal call "lib$stop" using by value
sys_status.

call "sys$setef" using by value argus_sleeping giving sys_status.
if sys_status not = ss$_wasset and ss$_wasclr
call "lib$stop" using by value sys_status.

call "smg$set_cursor_mode" using pasteboard_id, smg$m_cursor_off giving
sys_status.
if sys_status not = ss$_normal call "lib$stop" using by value
sys_status.

call "smg$create_virtual_display"
using row_cnt, col_cnt, screen_display
giving sys_status.
if sys_status not = ss$_normal call "lib$stop" using by value
sys_status.

call "smg$put_chars"
using by reference screen_display
by descriptor "Enter Employee Name (ctrl/z = exit): "
giving sys_status.
if sys_status not = ss$_normal call "lib$stop" using by value
sys_status.

move 1 to row_cnt.
move 38 to col_cnt.
call "smg$put_chars"
using by reference screen_display
by descriptor running_name
by reference row_cnt, col_cnt, omitted, smg$m_reverse
giving sys_status.
if sys_status not = ss$_normal call "lib$stop" using by value
sys_status.

move 1 to row_cnt, col_cnt.
call "smg$paste_virtual_display"
using screen_display, pasteboard_id,
row_cnt, col_cnt
giving sys_status.
if sys_status not = ss$_normal call "lib$stop" using by value
sys_status.

move 20 to menu_cols.
move 5 to menu_rows.
call "smg$create_virtual_display"
using menu_rows, menu_cols,
menu_display, smg$m_border
giving sys_status.
if sys_status not = ss$_normal call "lib$stop" using by value
sys_status.
*
fini.
*
employee_lookup section.
00.
call "smg$unpaste_virtual_display"
using menu_display, pasteboard_id
giving sys_status
if sys_status not = ss$_normal and smg$_notpasted
call "lib$stop" using by value sys_status.

call "smg$erase_display" using screen_display giving sys_status.
if sys_status not = ss$_normal call "lib$stop" using by value
sys_status.

display "Imagine looking up complete employee details here. . .".
*
fini.
*
end program emp_client.
identification division.
program-id. get_names.

environment division.
configuration section.
special-names.
symbolic characters
carriage_return is 14
line_feed is 11.

data division.
working-storage section.
01 load_entry pointer value external
load_entry.
01 io$_writevblk pic 9(9) comp value external
io$_writevblk.
01 smg$_notpasted pic 9(9) comp value external
smg$_notpasted.
01 ss$_abort pic 9(9) comp value external
ss$_abort.
01 ss$_wasset pic 9(9) comp value external
ss$_wasset.
01 ss$_wasclr pic 9(9) comp value external
ss$_wasclr.
01 ss$_normal pic 9(9) comp value external
ss$_normal.
01 sys_status pic 9(9) comp.
*
01 all_flags pic 9(9) comp.
01 out_len pic 9(4) comp.
01 last_search pic x(20).
*
01 get_names_buffer.
03 pic xx value "20".
03 in_name pic x(22).
*
01 crlf.
03 pic x(1) value
carriage_return.
03 pic x(1) value
line_feed.
*
01 menu_desc external.
03 cell_size pic 9(4) comp.
03 dtype pic x(1).
03 dclass pic x(1).
03 base_addr pointer.
03 pic 9(4) comp.
03 flags pic x(1).
03 dimct pic x(1).
03 bytes_allocated pic 9(9) comp.
03 element_zero pic 9(9) comp.
03 stride pic 9(9) comp.
03 lwr_b pic 9(9) comp.
03 line_count pic 9(9) comp.
*
linkage section.
01 ast_ctx.
03 pasteboard_id pic 9(9) comp.
03 menu_display pic 9(9) comp.
03 running_len pic 9(9) comp.
03 net_chan pic 9(4) comp.
03 pic 9(4) comp.
03 argus_sleeping pic 9(9) comp.
03 ast_iosb.
05 ast_cond_val pic 9(4) comp.
05 ast_byte_count pic 9(4) comp.
05 pic 9(9) comp.
03 running_name pic x(20).
03 reply_buffer pic x(512).
*
procedure division using ast_ctx.
kick_off section.
00.
*+
* Are we already running?
*-
call "sys$readef"
using by value argus_sleeping
by reference all_flags
giving sys_status.
if sys_status = ss$_wasclr go to fini.
if sys_status not = ss$_wasset call "lib$stop" using by value
sys_status.
*+
* Same old same old?
*-
if running_len = zeros
call "smg$unpaste_virtual_display"
using menu_display, pasteboard_id
giving sys_status
if sys_status not = ss$_normal and smg$_notpasted
call "lib$stop" using by value sys_status
end-if
go to fini.

if running_name = last_search go to fini.
*+
* Clock on, and tell everyone we're awake
*-
call "sys$clref" using by value argus_sleeping giving sys_status.
if sys_status not = ss$_wasset call "lib$stop" using by value
sys_status.
*+
* Enlist the server
*-
string running_name(1:running_len),
crlf
delimited by size
into in_name.
add 4 to running_len giving out_len.

call "sys$qiow"
using by value 0, net_chan, io$_writevblk
by reference ast_iosb
by value 0, 0
by reference get_names_buffer
by value out_len, 0, 0, 0, 0
giving sys_status.
if sys_status = ss$_normal move ast_cond_val to sys_status.
if sys_status not = ss$_normal call "lib$stop" using by value
sys_status.

move zeros to line_count.
move running_name(1:running_len) to last_search.

call "sys$dclast"
using by value load_entry
by reference ast_ctx
by value 0
giving sys_status.
if sys_status not = ss$_normal call "lib$stop" using by value
sys_status.
*
fini.
exit program.
*
end program get_names.
identification division.
program-id. load_entry.
data division.
working-storage section.
01 msg_handler pointer value external
msg_handler.
01 ucx$c_msg_peek pic 9(9) comp value external
ucx$c_msg_peek.
01 io$_readvblk pic 9(9) comp value external
io$_readvblk.
01 ss$_normal pic 9(9) comp value external
ss$_normal.
01 sys_status pic 9(9) comp.
*
01 max_msg_size pic 9(4) comp value 512.
*
linkage section.
01 ast_ctx.
03 pasteboard_id pic 9(9) comp.
03 menu_display pic 9(9) comp.
03 running_len pic 9(9) comp.
03 net_chan pic 9(4) comp.
03 pic 9(4) comp.
03 argus_sleeping pic 9(9) comp.
03 ast_iosb.
05 ast_cond_val pic 9(4) comp.
05 ast_byte_count pic 9(4) comp.
05 pic 9(9) comp.
03 running_name pic x(20).
03 reply_buffer pic x(512).
*
procedure division using ast_ctx.
kick_off section.
00.
call "sys$qio"
using by value 0, net_chan, io$_readvblk
by reference ast_iosb
by value msg_handler
by reference ast_ctx, reply_buffer
by value max_msg_size, 0, ucx$c_msg_peek, 0, 0
giving sys_status.
if sys_status not = ss$_normal call "lib$stop" using by value
sys_status.
*
exit program.
*
end program load_entry.
identification division.
program-id. msg_handler.

environment division.
configuration section.
special-names.
symbolic characters
carriage_return is 14
line_feed is 11.

data division.
working-storage section.
01 get_names pointer value external
get_names.
01 io_readnowait pic 9(9) comp value external
io_readnowait.
01 smg$_eof pic 9(9) comp value external
smg$_eof.
01 smg$_notpasted pic 9(9) comp value external
smg$_notpasted.
01 smg$_invdis_id pic 9(9) comp value external
smg$_invdis_id.
01 smg$m_remove_item pic 9(9) comp value external
smg$m_remove_item.
01 smg$m_bold pic 9(9) comp value external
smg$m_bold.
01 smg$m_reverse pic 9(9) comp value external
smg$m_reverse.
01 smg$m_fixed_format pic 9(9) comp value external
smg$m_fixed_format.
01 smg$k_vertical pic 9(9) comp value external
smg$k_vertical.
01 ss$_abort pic 9(9) comp value external
ss$_abort.
01 ss$_normal pic 9(9) comp value external
ss$_normal.
01 sys_status pic 9(9) comp.
*
01 menu_rows pic 9(9) comp value 3.
01 menu_cols pic 9(9) comp value 38.
*
01 local_buffer.
03 msg_type pic x(2).
88 valid_reply values "21",
"99".
88 emp_data value "21".
88 end_of_file value "99".
03 reply_body pic x(510).
*
01 emp_name_buffer redefines
local_buffer.
03 pic xx.
03 out_name pic x(20).
*
01 cr pic x(1) value
carriage_return.
01 lf pic x(1) value
line_feed.
*
01 rec_size pic 9(9) comp.
01 menu_flags pic 9(9) comp.
*
01 menu_desc external.
03 cell_size pic 9(4) comp.
03 dtype pic x(1).
03 dclass pic x(1).
03 base_addr pointer.
03 pic 9(4) comp.
03 flags pic x(1).
03 dimct pic x(1).
03 bytes_allocated pic 9(9) comp.
03 element_zero pic 9(9) comp.
03 stride pic 9(9) comp.
03 lwr_b pic 9(9) comp.
03 line_count pic 9(9) comp.
*
01 bytes_needed pic 9(9) comp.
*
01 target_desc.
03 pic 9(9) comp value external
cell_size.
03 target_cell_addr pointer.
*
linkage section.
01 ast_ctx.
03 pasteboard_id pic 9(9) comp.
03 menu_display pic 9(9) comp.
03 running_len pic 9(9) comp.
03 net_chan pic 9(4) comp.
03 pic 9(4) comp.
03 argus_sleeping pic 9(9) comp.
03 ast_iosb.
05 ast_cond_val pic 9(4) comp.
05 ast_byte_count pic 9(4) comp.
05 pic 9(9) comp.
03 running_name pic x(20).
03 reply_buffer pic x(512).
*
procedure division using ast_ctx.
kick_off section.
00.
if ast_cond_val not = ss$_normal call "lib$stop" using by value
ast_cond_val.

move reply_buffer to local_buffer.
move zeros to rec_size.
inspect local_buffer(1:ast_byte_count) tallying rec_size for characters
before initial lf.
if rec_size = ast_byte_count or < 3
display "Badly formed message (", local_buffer(1:ast_byte_count),
")"
call "lib$stop" using by value ss$_abort.

add 1 to rec_size.
move spaces to local_buffer.
call "sys$qiow"
using by value 0, net_chan, io_readnowait
by reference ast_iosb
by value 0, 0
by reference local_buffer
by value rec_size, 0, 0, 0, 0
giving sys_status.
if sys_status = ss$_normal move ast_cond_val to sys_status.
if sys_status not = ss$_normal call "lib$stop" using by value
sys_status.

if ast_byte_count < rec_size
display "READ less than PEEKed"
call "lib$stop" using by value ss$_abort.

if local_buffer((ast_byte_count - 1):1) = cr
subtract 2 from ast_byte_count
else
subtract 1 from ast_byte_count.

if end_of_file
perform clock_off
else
perform load_cell
call "load_entry" using ast_ctx.
*
fini.
exit program.
*
clock_off section.
00.
call "smg$delete_menu" using menu_display giving sys_status.
if sys_status not = ss$_normal and smg$_invdis_id
call "lib$stop" using by value sys_status.

if line_count = zeros
call "smg$unpaste_virtual_display"
using menu_display, pasteboard_id
giving sys_status
if sys_status not = ss$_normal and smg$_notpasted
call "lib$stop" using by value sys_status
end-if
go to fini.

move line_count to stride.
call "smg$create_menu"
using menu_display, menu_desc, smg$k_vertical, smg$m_fixed_format
giving sys_status.
if sys_status not = ss$_normal call "lib$stop" using by value
sys_status.

call "smg$get_pasting_info" using menu_display, pasteboard_id,
menu_flags giving sys_status.
if sys_status not = ss$_normal call "lib$stop" using by value
sys_status.

if menu_flags = zeros
call "smg$paste_virtual_display"
using menu_display, pasteboard_id,
menu_rows, menu_cols
giving sys_status
if sys_status not = ss$_normal call "lib$stop" using by value
sys_status.
*
fini.
*
call "sys$setef" using by value argus_sleeping giving sys_status.
if sys_status not = ss$_normal call "lib$stop" using by value
sys_status.
*+
* Check if anything's changed
*-
call "sys$dclast"
using by value get_names
by reference ast_ctx
by value 0
giving sys_status.
if sys_status not = ss$_normal call "lib$stop" using by value
sys_status.
*
load_cell section.
00.
if not valid_reply
display "Unknow reply (", msg_type, ")"
call "lib$stop" using by value ss$_abort.

if line_count = 32767 go to fini.

add 1 to line_count.
multiply line_count by cell_size giving bytes_needed.
if bytes_needed > bytes_allocated
call "lib$vm_realloc"
using by value base_addr, bytes_needed
giving base_addr
if base_addr = zeros
display "Out of memory"
call "lib$stop" using by value ss$_abort
end-if
move bytes_needed to bytes_allocated
subtract cell_size from base_addr giving element_zero.

compute target_cell_addr = cell_size * line_count + element_zero.
call "lib$scopy_dxdx"
using by descriptor out_name(1:(ast_byte_count - 2))
by reference target_desc
giving sys_status.
if sys_status not = ss$_normal call "lib$stop" using by value
ss$_abort.
*
fini.
*
end program msg_handler.

"JF Mezei" <jfmezei.spamnot@xxxxxxxxxxxxx> wrote in message
news:9f69d$461bda1a$cef8887a$15172@xxxxxxxxxxxxxxx
re: bounds checking.

In a static array definition, I would define an array of say 100 items
which would be the maximum I would ever expect to get.

So a "fancy" compiler would check array bounds within the first 100 items.

However, if my program has only loaded 27 items into the array, the
compiler won't know this and will not prevent my program from accessing
item 28.

So I still need logic in my program to ensure I don't access
uninitialised areas or an array.

And in a dynamically allocated array that may grow dynamically
(realloc), you also need to have code to detect when your array is full
so that you can add another chunk of memory to progressively grow it.
(consider receiving an HTML page whose size is unknown, it should be
short, or it could be very very long).

C makes this easy. COBOL isn't very good for that.


.

Relevant Pages