PNOTICE_ws_tty_.alm 08/10/87 0927.7rew 08/07/87 1454.7 4815 " " HISTORY COMMENTS: " 1) change(86-12-12,RBarstad), approve(86-12-12,MCR7585), " audit(86-12-12,Gilcrease), install(87-08-07,MR12.1-1075): " mowse video interface " END HISTORY COMMENTS " dec 1 "version 1 structure dec 1 "no. of pnotices dec 3 "no. of STIs dec 56 "lgth of all pnotices + no. of pnotices acc "Copyright, (C) Honeywell Information Systems Inc., 1986" aci "C1xxxxxx0000" aci "C2xxxxxx0000" aci "C3xxxxxx0000" end  ws_trace_.pl1 08/10/87 0936.3rew 08/10/87 0936.3 90927 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1986 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(86-12-05,RBarstad), approve(86-12-11,MCR7585), audit(87-06-05,Gilcrease), install(87-08-07,MR12.1-1075): Created. END HISTORY COMMENTS */ /* format: style3,ifthenstmt,indthenelse,^indnoniterdo,^indprocbody,initcol3,dclind5,idind32 */ ws_trace_: proc () options (variable); /* ------------------------ DESCRIPTION ---------------------------------- */ /****^ VERSION 1.10 Trace and debug routine for mowse video support. Allows output normally written to the terminal to be saved to a trace file. Also has entries to set and get the trace and debug settings. */ %page; /* ------------------------ PARAMETERS ----------------------------------- */ /* ------------------------ AUTOMATIC ------------------------------------ */ dcl arg_list_ptr ptr; dcl message char (512) unal; dcl raw_message_length fixed bin (21); dcl message_length fixed bin (21); dcl adj_bit_count fixed bin (35); dcl bit_count fixed bin (24); dcl code fixed bin (35); /* local version of code */ dcl created bit (1) aligned; dcl date_time_ entry (fixed bin (71), char (*)); dcl dir_name char (168); dcl i fixed bin (21); dcl last_char fixed bin (21); dcl lock_chars char (12) aligned; dcl now char (24); dcl process_id fixed bin based (addr (ws_seg.lock)); dcl retval fixed bin (35); dcl ws_io_ptr ptr; dcl 01 ws_seg aligned based (ws_io_ptr), 02 lock bit (36), 02 next_byte fixed bin (21), 02 string char (MAX_CHARS); /* ------------------------ ENTRIES -------------------------------------- */ dcl cu_$arg_list_ptr entry (ptr); dcl ioa_$general_rs entry (ptr, fixed bin, fixed bin, char (*), fixed bin (21), bit (1) aligned, bit (1) aligned); dcl adjust_bit_count_ entry (char (168), char (32), bit (1) aligned, fixed bin (35), fixed bin (35)); dcl cv_bin_$oct entry (fixed bin, char (12) aligned); dcl get_wdir_ entry () returns (char (168)); dcl hcs_$set_bc_seg entry (ptr, fixed bin (24), fixed bin (35)); dcl initiate_file_$create entry (char (*), char (*), bit (*), ptr, bit (1) aligned, fixed bin (24), fixed bin (35)); dcl set_lock_$lock entry (bit (36) aligned, fixed bin, fixed bin (35)); dcl set_lock_$unlock entry (bit (36) aligned, fixed bin (35)); dcl sub_err_ entry () options (variable); dcl terminate_file_ entry (ptr, fixed bin (24), bit (*), fixed bin (35)); /* ------------------------ EXTERNALS ------------------------------------ */ dcl ( error_table_$invalid_lock_reset, error_table_$lock_not_locked, error_table_$locked_by_this_process ) fixed bin (35) ext static; /* ------------------------ CONSTANTS ------------------------------------ */ dcl ( SEG_NAME char (32) init ("ws_tty_.trace"), MAX_CHARS fixed bin (21) init (1044472), /* 255*1024*4-2*4 */ FUDGE fixed bin init (40), /* 12+1+24+1+2: size of process id+date&time+NL+spaces */ BLANK char (1) init (" "), NL char (1) init (" "), /* new line (line feed) */ WAIT_TIME fixed bin init (10), DATE_LEN fixed bin init (16) ) internal static options (constant); /* ------------------------ BUILTINS and CONDITIONS ---------------------- */ dcl (addr, clock, divide, length, rtrim, substr) builtin; %page; /* ------------------------ MAIN ENTRY ----------------------------------- */ /****^ algorithm set the lock control word write the date and time write the caller name and message write a new line update the seg byte count update the seg bit count unlock the lock */ /* get and convert the callers ioa string */ message = " "; call cu_$arg_list_ptr (arg_list_ptr); call ioa_$general_rs (arg_list_ptr, 1, 2, message, raw_message_length, "1"b, "0"b); raw_message_length = length (rtrim (message)); message = esc_canon (message, raw_message_length, message_length); /* initialize and get the seg */ dir_name = get_wdir_ (); call initiate_file_$create (dir_name, SEG_NAME, "101"b, ws_io_ptr, created, bit_count, code); if code ^= 0 then goto err_exit; if bit_count = 0 then do; /* virgin seg */ bit_count = 72; next_byte = 2; substr (string, 1, 1) = NL; call hcs_$set_bc_seg (ws_io_ptr, bit_count, code); if code ^= 0 then goto err_exit; end; /* lock */ call set_lock_$lock (ws_seg.lock, WAIT_TIME, code); if code ^= 0 then if code ^= error_table_$invalid_lock_reset then if code ^= error_table_$locked_by_this_process then goto err_exit; /* write the stuff to it */ if (next_byte + FUDGE + message_length) > MAX_CHARS then do; next_byte = 2; substr (string, 1, 1) = NL; end; /* convert and write lock id */ call cv_bin_$oct (process_id, lock_chars); substr (string, next_byte, 12) = lock_chars; next_byte = next_byte + 12; substr (string, next_byte, 1) = BLANK; next_byte = next_byte + 1; /* write date and time */ call date_time_ (clock (), now); substr (string, next_byte, DATE_LEN) = substr (now, 1, DATE_LEN); next_byte = next_byte + DATE_LEN; substr (string, next_byte, 1) = BLANK; next_byte = next_byte + 1; /* write caller's message */ substr (string, next_byte, message_length) = substr (message, 1, message_length); next_byte = next_byte + message_length; substr (string, next_byte, 1) = NL; next_byte = next_byte + 1; /* set bit count blank to next NL (or end) */ call adjust_bit_count_ (dir_name, SEG_NAME, "1"b, adj_bit_count, code); if code ^= 0 then goto unlock_exit; last_char = divide (adj_bit_count - 72, 9, 7); do i = next_byte to last_char while (substr (string, i, 1) ^= NL); substr (string, i, 1) = "$"; end; /* unlock and terminate seg */ call set_lock_$unlock (ws_seg.lock, code); if code ^= 0 then if code ^= error_table_$lock_not_locked then goto err_exit; call terminate_file_ (ws_io_ptr, (adj_bit_count), TERM_FILE_TERM, code); if code ^= 0 then goto err_exit; goto exit; unlock_exit: ; call set_lock_$unlock (ws_seg.lock, code); goto exit; /* code doesn't matter */ err_exit: ; call sub_err_ (code, "ws_trace_", ACTION_CAN_RESTART, sub_error_info_ptr, retval, "While attempting to access trace dump file ^a>^a", dir_name, SEG_NAME); exit: ; return; /* ------------------------ END MAIN ------------------------------------- */ %page; esc_canon: proc (in_string, I_length, O_length) returns (char (512)); dcl in_string char (*) parm; dcl I_length fixed bin (21) parm; dcl O_length fixed bin (21) parm; dcl in_char char (1); dcl out_string char (512); dcl i fixed bin; dcl FIRST_CHAR char (1) int static options (constant) init (" "); dcl LAST_CHAR char (1) int static options (constant) init ("~"); dcl ESC_CHAR char (1) int static options (constant) init ("\"); dcl in_length, out_length fixed bin (21); dcl cv_bin_$oct entry (fixed bin, char (12) aligned); dcl ascii_chars char (12) aligned; dcl rank builtin; dcl MAX_LEN fixed bin int static options (constant) init (512); in_length = I_length; out_length = 0; out_string = " "; do i = 1 to in_length; in_char = substr (in_string, i, 1); if ((in_char < FIRST_CHAR) | (in_char > LAST_CHAR)) & (i < in_length) then do; /* control char */ if out_length + 4 >= MAX_LEN then goto esc_done; out_length = out_length + 1; substr (out_string, out_length, 1) = ESC_CHAR; out_length = out_length + 1; call cv_bin_$oct (rank (in_char), ascii_chars); substr (out_string, out_length, 3) = substr (ascii_chars, 10, 3); if (substr (out_string, out_length, 1) = " ") then substr (out_string, out_length, 1) = "0"; if (substr (out_string, out_length + 1, 1) = " ") then substr (out_string, out_length + 1, 1) = "0"; out_length = out_length + 2; end; else do; /* normal char */ if out_length + 1 >= MAX_LEN then goto esc_done; out_length = out_length + 1; substr (out_string, out_length, 1) = in_char; end; end; esc_done: O_length = out_length; return (out_string); end esc_canon; %page; /* ------------------------ ENTRIES ------------------------------------- */ set_debug: entry (debug_switch); dcl debug_switch bit (1) parm; /* 1=on, 0=off */ ws_tty_data$Flags.Debug = debug_switch; return; get_debug: entry (debug_switch); debug_switch = ws_tty_data$Flags.Debug; return; set_trace: entry (trace_switch); dcl trace_switch bit (1) parm; /* 1=on, 0=off */ ws_tty_data$Flags.Trace = trace_switch; return; get_trace: entry (trace_switch); trace_switch = ws_tty_data$Flags.Trace; return; /* ------------------------ END PROGRAM ---------------------------------- */ %page; /* ------------------------ INCLUDES ------------------------------------- */ %include terminate_file; %include sub_error_info; %include condition_info_header; %include sub_err_flags; %include ws_tty_data; end ws_trace_;  ws_tty_.alm 08/07/87 1543.7rew 08/07/87 1455.1 12753 " *********************************************************** " * * " * Copyright, (C) Honeywell Bull Inc., 1987 * " * * " * Copyright, (C) Honeywell Information Systems Inc., 1986 * " * * " *********************************************************** " HISTORY COMMENTS: " 1) change(86-11-05,RBarstad), approve(86-12-11,MCR7585), " audit(86-12-12,Gilcrease), install(87-08-07,MR12.1-1075): " Created. " END HISTORY COMMENTS " " ws_tty_: transfer vector to ws_tty_ functions. " name ws_tty_ macro dispatch segdef &1 &1: getlp tra &2$&3 &end dispatch abort,ws_tty_main_,abort dispatch attach,ws_tty_main_,attach dispatch detach,ws_tty_main_,detach dispatch event,ws_tty_main_,event dispatch index,ws_tty_main_,index dispatch order,ws_tty_main_,order dispatch read,ws_tty_read_,read dispatch read_echoed,ws_tty_read_,read_echoed dispatch read_with_mark,ws_tty_read_,read_with_mark dispatch write,ws_tty_write_,write dispatch write_whole_string,ws_tty_write_,write_whole_string dispatch set_trace,ws_trace_,set_trace dispatch get_trace,ws_trace_,get_trace dispatch set_debug,ws_trace_,set_debug dispatch get_debug,ws_trace_,get_debug end  ws_tty_data.cds 08/07/87 1544.1rew 08/07/87 1510.8 27027 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1986 * * * *********************************************************** */ /* HISTORY COMMENTS: 1) change(86-11-17,RBarstad), approve(86-12-11,MCR7585), audit(86-12-12,Gilcrease): Written. External data seg for ws_tty_. END HISTORY COMMENTS */ ws_tty_data:proc; /* Version 1.0 */ /** Initialize cds_args **/ cds_args_ptr=addr(space_for_cds_args); unspec(space_for_cds_args)="0"b; /** Reference structure input to cds to assure it is in runtime table. **/ if addr(ws_tty_data)=null() then ; /** No text section **/ cds_args_ptr -> cds_args.sections (1).p = null (); cds_args_ptr -> cds_args.sections (1).len = 0; cds_args_ptr -> cds_args.sections (1).struct_name = "NO_TEXT"; /** Static section **/ cds_args_ptr -> cds_args.sections (2).p = addr (ws_tty_data); /* Caller's data. */ cds_args_ptr -> cds_args.sections (2).len = size (ws_tty_data); /* No. words in data structure. */ cds_args_ptr -> cds_args.sections (2).struct_name = "ws_tty_data"; cds_args_ptr -> cds_args.seg_name = "ws_tty_data"; /* Entryname of object segment. */ cds_args_ptr -> cds_args.num_exclude_names = 0; /* All level 2 names are entry points. */ cds_args_ptr -> cds_args.exclude_array_ptr = null (); cds_args_ptr -> cds_args.switches.defs_in_link = "0"b; /* Definitions contiguous to text section. */ cds_args_ptr -> cds_args.switches.separate_static = "0"b; /* Static in linkage section (to bind). */ cds_args_ptr -> cds_args.switches.have_text = "0"b; /* No text section. */ cds_args_ptr -> cds_args.switches.have_static = "1"b; /* There is a static section. */ cds_args_ptr -> cds_args.switches.pad = "0"b; /* Must be zeroes (see create_data_segment_). */ call create_data_segment_ (cds_args_ptr, code); if code ^= 0 then call com_err_ (code, "cds_ws_tty_data"); else call com_err_( 0,"ws_tty_data","Object for ws_tty_data created [^i words].",size(ws_tty_data)); return; %page; /** Data for cds **/ dcl addr builtin; dcl cds_args_ptr ptr init(null()); dcl code fixed bin(35); dcl com_err_ entry options(variable); dcl create_data_segment_ entry(ptr,fixed bin(35)); dcl null builtin; dcl size builtin; dcl unspec builtin; dcl 1 space_for_cds_args aligned like cds_args; %page; /** This data structure must exactly match that of ws_tty_data.incl.pl1 **/ dcl 1 ws_tty_data aligned, 2 Flags aligned, 3 Debug bit (1) unaligned init ("0"b), 3 Trace bit (1) unaligned init ("0"b), 3 Pad bit (34) unaligned init ((34)"0"b); %page; %include ws_tty_data; %page; %include cds_args; end;  ws_tty_main_.pl1 01/24/89 0855.8r w 01/24/89 0847.4 208791 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1986 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(86-12-05,RBarstad), approve(86-12-11,MCR7585), audit(87-07-23,Gilcrease), install(87-08-07,MR12.1-1075): Created. END HISTORY COMMENTS */ /* format: style3,^ifthenstmt,indthenelse,^indnoniterdo,^indprocbody,initcol3,dclind5,idind32 */ ws_tty_main_: proc (); return; /* ------------------------ DESCRIPTION ---------------------------------- */ /****^ VERSION 1.35 ws_tty_ entries to support video mode in MOWSE work station. All calls here to iox_ are actually to mowse_io_ ws_tty_$abort ws_tty_$attach ws_tty_$detach ws_tty_$event ws_tty_$index ws_tty_$order */ %page; /* ------------------------ PARAMETERS ----------------------------------- */ dcl I_argptr ptr parm; /* pointer to order data */ dcl I_dflag fixed bin parm; /* disposition flag */ dcl I_event fixed bin (71) parm; /* event channel name */ dcl I_name char (*) parm; /* tty name such as tty192 */ dcl I_order char (*) parm; /* order name */ dcl I_resetsw fixed bin parm; /* abort code, 1 reset read, 2 reset write, 3 reset both */ dcl I_iocb_ptr ptr parm; /* ptr for iox */ dcl O_code fixed bin (35) parm; /* error code */ dcl O_tty_state fixed bin parm; /* tty state, 1 ignored, 2 listening, 5 dialed */ /* ------------------------ AUTOMATIC ------------------------------------ */ dcl argptr ptr; /* pointer to order data */ dcl break_table_ptr ptr; dcl break_table_size fixed bin; dcl code fixed bin (35); /* error code */ dcl dflag fixed bin; /* disposition flag */ dcl event fixed bin (71); /* event channel name */ dcl event_code fixed bin (35); dcl get_msg_id char (3); /* message id returned from ws */ dcl iocb_ptr ptr; /* iocb pointer for iox */ dcl name char (32); dcl num_exit_tries fixed bin; /* count of reads for "SMX" */ dcl order char (32); dcl resetsw fixed bin; /* abort code, 1 reset read, 2 reset write, 3 reset both */ dcl rw_switch bit (2) aligned; /* bit-string version of reset read/write switch */ dcl tty_state fixed bin; /* tty state, 1 ignored, 2 listening, 5 dialed */ dcl saved_mask bit (36) aligned; /* saved ips mask */ dcl unmask_count fixed bin; dcl count fixed bin; dcl 1 saved_mask_bit aligned based (addr (saved_mask)), 2 interrupts bit (35) unaligned, 2 control bit (1) unaligned; dcl string_size fixed bin (21); dcl string_ptr ptr; dcl string char (MAX_SEND_MSG_SIZE); dcl 1 video_mode_info like mowse_io_set_video_mode_info; /* ------------------------ BASED ---------------------------------------- */ dcl 1 modes_info aligned based (argptr), 2 mode_length fixed bin, 2 mode_string char (512); dcl new_modes char (512); /* ------------------------ CONSTANTS ------------------------------------ */ dcl ( ME char (12) init ("ws_tty_main_"), V1_ECHO_NEG_BREAK_TABLE_SIZE fixed bin init (126), FALSE bit (1) init ("0"b), TRUE bit (1) init ("1"b), MAX_SEND_MSG_SIZE fixed bin (21) init (255), ZERO_IPS_MASK bit (36) init ((36)"0"b), EXIT_THRESHOLD fixed bin init (5) ) internal static options (constant); /* ------------------------ EXTERNALS ------------------------------------ */ dcl ( error_table_$action_not_performed, error_table_$undefined_order_request, error_table_$unimplemented_version ) fixed bin (35) external static; /* ------------------------ ENTRIES -------------------------------------- */ dcl hcs_$set_ips_mask entry (bit (36) aligned, bit (36) aligned); dcl hcs_$reset_ips_mask entry (bit (36) aligned, bit (36) aligned); dcl ipc_$mask_ev_calls entry (fixed bin(35)); dcl ipc_$unmask_ev_calls entry (fixed bin(35)); dcl iox_$control entry (ptr, char (*), ptr, fixed bin (35)); dcl iox_$modes entry (ptr, char (*), char (*), fixed bin (35)); dcl ws_tty_mgr_$have_wsterm entry (ptr, fixed bin, fixed bin (35)) returns (bit (1)); dcl ws_tty_mgr_$ok_iocb entry (ptr, ptr, ptr, fixed bin (35)) returns (bit (1)); dcl ws_tty_mgr_$send_message entry (ptr, char (3), bit (9), ptr, fixed bin (21)); dcl ws_tty_mgr_$get_message entry (ptr, ptr, fixed bin (21), fixed bin (21), char (3)); dcl ws_trace_ entry () options (variable); /* ------------------------ BUILTINS and CONDITIONS ---------------------- */ dcl (addr, bit, byte, fixed, hbound, length, null, rtrim, substr) builtin; dcl (any_other, cleanup) condition; %page; /* ------------------------ PROGRAM -------------------------------------- */ abort: entry (I_iocb_ptr, I_resetsw, O_tty_state, O_code); /* to reset read or write buffers */ code = 0; tty_state = 0; resetsw = I_resetsw; if ws_tty_data$Flags.Trace then call ws_trace_ ("^a$abort entry: iocb_ptr= ^p, resetws= ^i.", ME, I_iocb_ptr, resetsw); if ^ws_tty_mgr_$ok_iocb (I_iocb_ptr, iocb_ptr, mowse_io_data_ptr, code) then goto abort_exit; call init_ips_mask; rw_switch = bit (fixed (resetsw, 2)); if substr (rw_switch, 2, 1) then mowse_io_data.ws.flags.more_input = FALSE; call iox_$control (iocb_ptr, "abort", addr (rw_switch), code); if code ^= 0 then goto abort_exit; call ws_tty_mgr_$send_message (iocb_ptr, WS_ABORT, WS_FLAG_NONE, null, 0); abort_exit: if ws_tty_data$Flags.Trace then call ws_trace_ ("^a$abort exit: tty_state= ^i, code= ^i.^/", ME, tty_state, code); O_tty_state = tty_state; O_code = code; return; %page; attach: entry (I_iocb_ptr, I_name, I_event, O_tty_state, O_code); /* notify wsterm to go to sync mode */ /* notify mowse_io_ that sync mode in effect */ /* initialize */ code = 0; tty_state = 0; /* get params */ name = I_name; event = I_event; if ws_tty_data$Flags.Trace then call ws_trace_ ("^a$attach entry: name= ^a, event= ^i, iocb_ptr= ^p.", ME, name, event, I_iocb_ptr); /* get iocb_ptr and check it */ if ^ws_tty_mgr_$ok_iocb (I_iocb_ptr, iocb_ptr, mowse_io_data_ptr, code) then goto attach_exit; /* set up ips mask */ call init_ips_mask; /* see if wsterm still around */ if ^ws_tty_mgr_$have_wsterm (iocb_ptr, tty_state, code) then goto attach_exit; /* tell ws to enter sync mode */ call ws_tty_mgr_$send_message (iocb_ptr, WS_ENTER_SYNC_MODE, WS_FLAG_NONE, null, 0); /* get ws's response */ string = " "; string_ptr = addr (string); get_msg_id = " "; call ws_tty_mgr_$get_message (iocb_ptr, string_ptr, MAX_SEND_MSG_SIZE, string_size, get_msg_id); if ws_tty_data$Flags.Trace then call ws_trace_ ("^a$attach: enter sync mode reply= ^a.", ME, get_msg_id); if get_msg_id ^= WS_SYNC_MODE_ENTERED then do; code = error_table_$action_not_performed; goto attach_exit; end; /* tell mowse too */ video_mode_info.version = mowse_io_info_version_1; video_mode_info.mode = TRUE; video_mode_info.mbz = "0"b; mowse_io_set_video_mode_info_ptr = addr (video_mode_info); call iox_$control (iocb_ptr, "set_video_mode", mowse_io_set_video_mode_info_ptr, code); if code ^= 0 then goto attach_exit; call iox_$modes (iocb_ptr, "force,^crecho,^lfecho", "", code); attach_exit: if ws_tty_data$Flags.Trace then call ws_trace_ ("^a$attach exit: tty_state= ^i, code= ^i.^/", ME, tty_state, code); O_tty_state = tty_state; O_code = code; return; %page; detach: entry (I_iocb_ptr, I_dflag, O_tty_state, O_code); /* notify wsterm to return to async mode */ /* notify mowse_io_ of return to async mode (TBD) */ /* dflag is ignored */ /* initialize */ code = 0; tty_state = 0; num_exit_tries = 0; /* get params */ dflag = I_dflag; if ws_tty_data$Flags.Trace then call ws_trace_ ("^a$detach entry: iocb_ptr= ^p, dflag= ^i.", ME, I_iocb_ptr, dflag); /* get iocb_ptr and check it */ if ^ws_tty_mgr_$ok_iocb (I_iocb_ptr, iocb_ptr, mowse_io_data_ptr, code) then goto detach_exit; /* see if wsterm still around */ if ^ws_tty_mgr_$have_wsterm (iocb_ptr, tty_state, code) then goto detach_exit; /* flush input */ call iox_$control (iocb_ptr, "resetread", null (), code); if code ^= 0 then goto detach_exit; /* tell ws to exit sync mode */ call ws_tty_mgr_$send_message (iocb_ptr, WS_EXIT_SYNC_MODE, WS_FLAG_NONE, null, 0); /* get ws's response */ string = " "; string_ptr = addr (string); get_msg_id = " "; do while ((get_msg_id ^= WS_SYNC_MODE_EXITED) & (num_exit_tries < EXIT_THRESHOLD)); call ws_tty_mgr_$get_message (iocb_ptr, string_ptr, 256, string_size, get_msg_id); num_exit_tries = num_exit_tries + 1; end; if ws_tty_data$Flags.Trace then call ws_trace_ ("^a$detach: sync mode reply= ^a.", ME, get_msg_id); if get_msg_id ^= WS_SYNC_MODE_EXITED then do; code = error_table_$action_not_performed; goto detach_exit; end; /* tell mowse too */ video_mode_info.version = mowse_io_info_version_1; video_mode_info.mode = FALSE; video_mode_info.mbz = "0"b; mowse_io_set_video_mode_info_ptr = addr (video_mode_info); call iox_$control (iocb_ptr, "set_video_mode", mowse_io_set_video_mode_info_ptr, code); detach_exit: if ws_tty_data$Flags.Trace then call ws_trace_ ("^a$detach exit: tty_state= ^i, code= ^i.^/", ME, tty_state, code); O_tty_state = tty_state; O_code = code; return; %page; event: entry (I_iocb_ptr, I_event, O_tty_state, O_code); /* to change tty events signaled */ code = 0; tty_state = 0; event = I_event; if ws_tty_data$Flags.Trace then call ws_trace_ ("^a$event entry: iocb_ptr= ^p, event= ^i.", ME, I_iocb_ptr, event); if ^ws_tty_mgr_$ok_iocb (I_iocb_ptr, iocb_ptr, mowse_io_data_ptr, code) then goto event_exit; event_exit: if ws_tty_data$Flags.Trace then call ws_trace_ ("^a$event exit: tty_state= ^i, code= ^i.^/", ME, O_tty_state, code); O_tty_state = tty_state; O_code = code; return; %page; index: entry (I_iocb_ptr, I_name, O_tty_state, O_code); /* go get index from name, and sign onto tty */ code = 0; tty_state = 0; name = I_name; if ws_tty_data$Flags.Trace then call ws_trace_ ("^a$index entry: name= ^a, iocb_ptr= ^p.", ME, name, I_iocb_ptr); if ^ws_tty_mgr_$ok_iocb (I_iocb_ptr, iocb_ptr, mowse_io_data_ptr, code) then goto index_exit; if iocb_ptr -> iocb.version ^= iox_$iocb_version_sentinel /* only here to make visable to probe */ then do; code = error_table_$unimplemented_version; goto attach_exit; end; index_exit: if ws_tty_data$Flags.Trace then call ws_trace_ ("^a$index exit: tty_state= ^i, code= ^i.^/", ME, O_tty_state, code); O_tty_state = tty_state; O_code = code; return; %page; order: entry (I_iocb_ptr, I_order, I_argptr, O_tty_state, O_code); /* to give tty orders */ /* the order may be done here, passed to WSTERM, or passed to mowse_io_ */ /* via iox_ or any combination of these */ code = 0; tty_state = 0; order = I_order; argptr = I_argptr; if ws_tty_data$Flags.Trace then call ws_trace_ ("^a$order entry: iocb_ptr= ^p, order= '^a', argptr= ^p.", ME, I_iocb_ptr, order, argptr); if ^ws_tty_mgr_$ok_iocb (I_iocb_ptr, iocb_ptr, mowse_io_data_ptr, code) then goto order_exit; call init_ips_mask; /* ------------------------ Start of control orders ---------------------- */ if order = "abort" /* tty_ */ then goto order_iox; else if order = "debug_on" /* mowse_io_ */ then do; mowse_io_debug_info_ptr = argptr; call iox_$control (iocb_ptr, order, mowse_io_debug_info_ptr, code); end; else if order = "debug_off" /* mowse_io_ */ then do; mowse_io_debug_info_ptr = argptr; call iox_$control (iocb_ptr, order, mowse_io_debug_info_ptr, code); end; else if order = "flush_subchannel" /* mowse */ then call unmask_alarms_and_pass_on_to_mowse; else if order = "get_editing_chars" /* tty_ */ then goto order_iox; else if order = "get_event_channel" /* tty_ */ then goto order_iox; else if order = "get_foreign_terminal_data" /* none */ then do; foreign_terminal_data_ptr = argptr; if foreign_terminal_data.version ^= FOREIGN_TERMINAL_DATA_VERSION_1 then goto wrong_version; call iox_$control (iocb_ptr, order, foreign_terminal_data_ptr, code); end; else if order = "get_input_conversion" /* no */ then do; goto order_not_defined; end; else if order = "get_input_translation" /* no */ then do; goto order_not_defined; end; else if order = "get_mowse_info" /* mowse_io_ */ then goto order_iox; else if order = "get_output_conversion" /* tty */ then goto order_iox; else if order = "get_output_translation" /* no */ then do; goto order_not_defined; end; else if order = "get_special" /* none */ then goto order_iox; else if order = "get_terminal_emulator_state" /* mowse_io_ */ then do; mowse_io_terminal_state_ptr = argptr; if mowse_io_terminal_state.version ^= mowse_io_info_version_1 then goto wrong_version; call iox_$control (iocb_ptr, order, mowse_io_terminal_state_ptr, code); end; else if order = "line_length" /* mowse */ then goto order_iox; else if order = "modes" /* WSTERM via mowse */ then do; new_modes = "force," || rtrim (modes_info.mode_string); call iox_$modes (iocb_ptr, new_modes, "" /*old_modes*/, code); end; else if order = "printer_off" /* ws_tty_ */ then do; call ws_tty_mgr_$send_message (iocb_ptr, WS_PRINTER_OFF, WS_FLAG_NONE, null, 0); end; else if order = "printer_on" /* ws_tty_ */ then do; call ws_tty_mgr_$send_message (iocb_ptr, WS_PRINTER_ON, WS_FLAG_NONE, null, 0); end; else if order = "put_to_sleep" /* mowse_io_ */ then goto order_iox; else if order = "quit_disable" /* mowse */ then goto order_iox; else if order = "quit_enable" /* mowse */ then goto order_iox; else if order = "read_status" /* tty_ */ then goto order_iox; else if order = "resetread" /* tty_ */ then do; mowse_io_data.ws.flags.more_input = FALSE; goto order_iox; end; else if order = "resetwrite" /* tty_ */ then goto order_iox; else if order = "send_local_message" /* mowse_io_ */ then goto order_iox; else if order = "send_message" /* mowse_io_ */ then goto order_iox; else if order = "set_echo_break_table" /* tty */ then do; echo_neg_datap = argptr; if echo_neg_data.version = echo_neg_data_version_2 then do; break_table_ptr = addr (echo_neg_data.break); break_table_size = ECHO_NEG_BREAK_TABLE_SIZE; end; else if echo_neg_data.version = echo_neg_data_version_1 then do; break_table_ptr = addr (v1_echo_neg_data.break); break_table_size = V1_ECHO_NEG_BREAK_TABLE_SIZE; end; else goto wrong_version; call convert_break_table (break_table_ptr, break_table_size, string, string_size); string_ptr = addr (string); call ws_tty_mgr_$send_message (iocb_ptr, WS_SET_BREAK_TABLE, WS_FLAG_NONE, string_ptr, string_size); call iox_$control (iocb_ptr, order, argptr, code); end; else if order = "set_editing_chars" /* tty_ */ then goto order_iox; else if order = "set_input_conversion" /* no */ then do; goto order_not_defined; end; else if order = "set_input_translation" /* none */ then do; goto order_not_defined; end; else if order = "set_output_conversion" /* tty */ then do; if argptr -> cv_trans_struc.version > CV_TRANS_VERSION then goto wrong_version; call iox_$control (iocb_ptr, order, argptr, code); end; else if order = "set_output_translation" /* none */ then do; goto order_not_defined; end; else if order = "set_special" /* tty_ */ then goto order_iox; else if order = "set_terminal_data" /* tty_ */ then do; /* set ll and pl */ ttdp = argptr; if terminal_type_data.version ^= ttd_version_3 then goto wrong_version; call iox_$control (iocb_ptr, order, argptr, code); end; else if order = "set_term_type" /* tty_ */ then goto order_iox; else if order = "start" /* tty_ */ then goto order_iox; else if order = "store_id" /* tty_ */ then goto order_iox; else if order = "store_mowse_info" /* mowse_io_ */ then goto order_iox; else if order = "terminal_info" /* tty_ */ then do; terminal_info_ptr = argptr; if terminal_info.version ^= terminal_info_version then goto wrong_version; call iox_$control (iocb_ptr, order, terminal_info_ptr, code); end; else if order = "trace_on" /* mowse_io_ */ then do; mowse_io_debug_info_ptr = argptr; call iox_$control (iocb_ptr, order, mowse_io_debug_info_ptr, code); end; else if order = "trace_off" /* mowse_io_ */ then do; mowse_io_debug_info_ptr = argptr; call iox_$control (iocb_ptr, order, mowse_io_debug_info_ptr, code); end; else if order = "write_status" /* tty_ */ then goto order_iox; /* ------------------------ End of control orders ------------------------ */ /**** none of the above, try something else */ else if ws_tty_data$Flags.Trace then call ws_trace_ ("^a$order: Unknown control order, '^a'.", ME, order); /**** send it on to iox_$control AS IS */ order_iox: call iox_$control (iocb_ptr, order, argptr, code); goto order_exit; /**** send it on to wsterm */ order_wsterm: string_ptr = addr (order); string_size = length (order); call ws_tty_mgr_$send_message (iocb_ptr, WS_ORDER, WS_FLAG_NONE, string_ptr, string_size); goto order_exit; /**** exits */ order_not_defined: code = error_table_$undefined_order_request; goto order_exit; wrong_version: code = error_table_$unimplemented_version; goto order_exit; order_not_performed: code = error_table_$action_not_performed; order_exit: if ws_tty_data$Flags.Trace then call ws_trace_ ("^a$order exit: tty_state= ^i, code= ^i.^/", ME, tty_state, code); O_tty_state = tty_state; O_code = code; return; /* ------------------------ END PROGRAM ---------------------------------- */ %page; /* ------------------------ INTERNAL PROCEDURES -------------------------- */ convert_break_table: proc (table_ptr, table_size, output_string, string_count); dcl table_ptr ptr parm; dcl table_size fixed bin parm; dcl output_string char (*) parm; dcl string_count fixed bin (21) parm; dcl table (0:ECHO_NEG_BREAK_TABLE_SIZE) bit (1) unaligned based (table_ptr); dcl index fixed bin; dcl FIRST_PRINT_CHAR_INDEX fixed bin int static options (constant) init (32); output_string = ""; string_count = 0; do index = FIRST_PRINT_CHAR_INDEX to table_size; /* ignore control chars */ if table (index) then do; string_count = string_count + 1; substr (output_string, string_count, 1) = byte (index); end; end; return; end convert_break_table; %page; /* ------------------------------------------------------------------------- */ init_ips_mask: proc (); dcl create_ips_mask_ entry (ptr, fixed bin, bit (36) aligned); dcl IPS_ARRAY (1) char (32) aligned int static options (constant) init ("-all"); dcl mask bit (36) aligned; if mowse_io_data.ws.ips_mask = ZERO_IPS_MASK /* if mask is zero then... */ then do; /**** call returns mask that DISABLES (=0) interrupts listed in IPS_ARRAY ... */ call create_ips_mask_ (addr (IPS_ARRAY), hbound (IPS_ARRAY, 1), mask); /**** ... save the inverse to ENABLE (=1) the listed interrupts. */ mowse_io_data.ws.ips_mask = ^mask; end; return; end init_ips_mask; %page; /* ------------------------------------------------------------------------- */ unmask_alarms_and_pass_on_to_mowse: proc (); /**** START CRITICAL SECTION ****/ event_code = 0; unmask_count = 0; saved_mask = ZERO_IPS_MASK; on cleanup call cleanup_handler; on any_other call any_other_handler; call hcs_$set_ips_mask (mowse_io_data.ws.ips_mask, saved_mask); do while (event_code = 0); call ipc_$unmask_ev_calls (event_code); unmask_count = unmask_count +1; end; call iox_$control (iocb_ptr, order, argptr, code); if saved_mask_bit.control then call hcs_$reset_ips_mask (saved_mask, saved_mask); do count = 2 to unmask_count; call ipc_$mask_ev_calls (0); end; revert any_other, cleanup; /**** END CRITICAL SECTION ****/ return; end unmask_alarms_and_pass_on_to_mowse; %page; /* ------------------------------------------------------------------------- */ any_other_handler: proc; dcl continue_to_signal_ entry (fixed bin (35)); if ws_tty_data$Flags.Trace then call ws_trace_ (" ^a$any_other_handler :saved_mask=^o.", ME, saved_mask); if saved_mask_bit.control then call hcs_$reset_ips_mask (saved_mask, saved_mask); do count = 2 to unmask_count; call ipc_$mask_ev_calls (0); end; call continue_to_signal_ ((0)); return; end any_other_handler; %page; /* ------------------------------------------------------------------------- */ cleanup_handler: proc; if ws_tty_data$Flags.Trace then call ws_trace_ (" ^a$cleanup_handler :saved_mask=^o.", ME, saved_mask); if saved_mask_bit.control then call hcs_$reset_ips_mask (saved_mask, saved_mask); do count = 2 to unmask_count; call ipc_$mask_ev_calls (0); end; return; end cleanup_handler; %page; /* ------------------------ INCLUDES ------------------------------------- */ %include ws_control_ids; %page; %include ws_tty_data; %page; %include mowse_io_control_info; %page; %include terminal_info; %page; %include terminal_type_data; %page; %include foreign_terminal_data; %page; %include mcs_echo_neg; %page; %include iocb; %page; %include mowse_io_data; %page; %include tty_convert; end ws_tty_main_;  ws_tty_mgr_.pl1 01/24/89 0855.8r w 01/24/89 0849.4 158157 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1986 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(86-12-05,RBarstad), approve(86-12-11,MCR7585), audit(87-08-05,Gilcrease), install(87-08-07,MR12.1-1075): Created. END HISTORY COMMENTS */ /* format: style3,^ifthenstmt,indthenelse,^indnoniterdo,^indprocbody,initcol3,dclind5,idind32 */ ws_tty_mgr_: proc (); return; /* ------------------------ DESCRIPTION ---------------------------------- */ /****^ VERSION 1.36 management entries for ws_tty_ */ %page; /* ------------------------ PARAMETERS ----------------------------------- */ dcl I_iocb_ptr parm ptr; /* iocb ptr input */ dcl O_iocb_ptr parm ptr; /* iocb ptr output */ dcl I_flags parm bit (9); /* control msg flags */ dcl I_msg_id parm char (3); dcl I_msg_data_ptr parm ptr; dcl I_msg_data_size parm fixed bin (21); dcl O_msg_id parm char (3); /* actual id returned from WSTERM */ dcl O_msg_data_size parm fixed bin (21); /* actual data size read from WSTERM */ dcl O_code fixed bin (35) parm; /* ------------------------ AUTOMATIC ------------------------------------ */ dcl n_chars_actually_read fixed bin (21); dcl iocb_ptr ptr; /* local copy */ dcl flags bit (9); /* local copy */ dcl event_code fixed bin (35); dcl code fixed bin (35); /* error code */ dcl offset_msg_data_ptr pointer; dcl retval fixed bin (35); dcl saved_mask bit (36) aligned; /* saved ips mask */ dcl total_chars_read fixed bin (21); dcl unmask_count fixed bin; dcl count fixed bin; dcl 1 saved_mask_bit aligned based (addr (saved_mask)), 2 interrupts bit (35) unaligned, 2 control bit (1) unaligned; dcl 1 ws_send_msg aligned, /* sent by "send message" control */ 2 type fixed bin (8) unaligned, /* foreground or background */ 2 id char (3) unaligned, /* one of ws_control_ids */ 2 flags bit (9) unaligned, 2 data_size fixed bin (8) unaligned, 2 message_data char (MAX_SEND_MSG_SIZE) unaligned; /* longest message */ dcl 1 ws_control_msg aligned, /* for iox put&get chars */ 2 id char (3) unaligned, /* one of ws_control_ids */ 2 data_size_hi fixed bin (8) unaligned, 2 data_size_lo fixed bin (8) unaligned; dcl ws_message_ptr ptr; dcl ws_message_length fixed bin (21); dcl 1 mio_message like mowse_io_message; /* ------------------------ BASED ---------------------------------------- */ dcl msg_data_ptr ptr; /* local copy of I_msg_data_ptr */ dcl msg_data_size fixed bin (21); /* local copy of I_msg_data_size */ dcl msg_data char (msg_data_size) based (msg_data_ptr); /* caller's string */ dcl based_chars (0:total_chars_read) char (1) based unaligned; /* to bump read ptr */ /* ------------------------ CONSTANTS ------------------------------------ */ dcl ( ME char (11) init ("ws_tty_mgr_"), BYTE_SIZE fixed bin init (256), DIALED_UP fixed bin init (5), /* tty_state */ IGNORE fixed bin init (1), /* tty_state */ FALSE bit (1) init ("0"b), TRUE bit (1) init ("1"b), MAX_SEND_MSG_SIZE fixed bin (21) init (255), ZERO_IPS_MASK bit (36) init ((36)"0"b), SEND_MSG_OVERHEAD fixed bin init (6), /* 8K - longest string size */ CONTROL_MSG_OVERHEAD fixed bin (21) init (5)/* 8K - longest string size */ ) internal static options (constant); /* ------------------------ EXTERNALS ------------------------------------ */ dcl ( error_table_$no_iocb, error_table_$no_operation, error_table_$io_no_permission, error_table_$unable_to_do_io ) fixed bin (35) external static; /* ------------------------ ENTRIES -------------------------------------- */ dcl hcs_$set_ips_mask entry (bit (36) aligned, bit (36) aligned); dcl hcs_$reset_ips_mask entry (bit (36) aligned, bit (36) aligned); dcl ipc_$mask_ev_calls entry (fixed bin(35)); dcl ipc_$unmask_ev_calls entry (fixed bin(35)); dcl iox_$control entry (ptr, char (*), ptr, fixed bin (35)); dcl iox_$get_chars entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35)); dcl iox_$put_chars entry (ptr, ptr, fixed bin (21), fixed bin (35)); dcl sub_err_ entry () options (variable); dcl ws_trace_ entry () options (variable); /* ------------------------ BUILTINS and CONDITIONS ---------------------- */ dcl (addr, max, min, null, substr) builtin; dcl (any_other, cleanup) condition; %page; /* ------------------------ PROGRAM -------------------------------------- */ send_message: entry (I_iocb_ptr, I_msg_id, I_flags, I_msg_data_ptr, I_msg_data_size); iocb_ptr = I_iocb_ptr; ws_send_msg.id = I_msg_id; flags = I_flags; msg_data_ptr = I_msg_data_ptr; msg_data_size = I_msg_data_size; mowse_io_data_ptr = iocb_ptr -> iocb.attach_data_ptr; ws_send_msg.type = FG_CONTROL_MESSAGE; if msg_data_ptr = null then do; /* no data */ msg_data_size = 0; ws_send_msg.data_size = 0; ws_send_msg.flags = WS_FLAG_NONE; ws_send_msg.message_data = ""; if ws_tty_data$Flags.Trace then call ws_trace_ (" ^a$send_message: ID= ^a, no data.", ME, ws_send_msg.id); end; else do; if ws_tty_data$Flags.Trace then call ws_trace_ (" ^a$send_message: ID= ^a, size= ^i, '^a'.", ME, ws_send_msg.id, msg_data_size, msg_data); if msg_data_size > MAX_SEND_MSG_SIZE then call sub_err_ (code, "ws_tty_mgr_$send_message", ACTION_CANT_RESTART, sub_error_info_ptr, retval, "String size of ^i too large for internal buffers.", msg_data_size); ws_send_msg.data_size = msg_data_size; ws_send_msg.flags = flags; ws_send_msg.message_data = msg_data; end; mio_message.version = mowse_io_info_version_1; mio_message.channel = FG; mio_message.io_message_ptr = addr (ws_send_msg); mio_message.io_message_len = msg_data_size + SEND_MSG_OVERHEAD; mowse_io_message_ptr = addr (mio_message); /**** BEGIN IO SECTION ****/ event_code = 0; unmask_count = 0; saved_mask = ZERO_IPS_MASK; on cleanup call cleanup_handler; on any_other call any_other_handler; call hcs_$set_ips_mask (mowse_io_data.ws.ips_mask, saved_mask); do while (event_code = 0); call ipc_$unmask_ev_calls (event_code); unmask_count = unmask_count +1; end; call iox_$control (iocb_ptr, "send_message", mowse_io_message_ptr, code); if saved_mask_bit.control then call hcs_$reset_ips_mask (saved_mask, saved_mask); do count = 2 to unmask_count; call ipc_$mask_ev_calls (0); end; revert any_other, cleanup; /**** END IO SECTION ****/ if code ^= 0 then call sub_err_ (code, "ws_tty_mgr_$send_message", ACTION_CANT_RESTART, sub_error_info_ptr, retval, "Attempting to write to iocb ^p via iox_$put_chars.", iocb_ptr); return; %page; /* ------------------------------------------------------------------------- */ send_text: entry (I_iocb_ptr, I_msg_data_ptr, I_msg_data_size); iocb_ptr = I_iocb_ptr; msg_data_ptr = I_msg_data_ptr; msg_data_size = I_msg_data_size; mowse_io_data_ptr = iocb_ptr -> iocb.attach_data_ptr; if msg_data_ptr = null then do; /* no data */ msg_data_size = 0; if ws_tty_data$Flags.Trace then call ws_trace_ (" ^a$send_text: no data.", ME); end; else do; if ws_tty_data$Flags.Trace then call ws_trace_ (" ^a$send_text: size= ^i, '^a'.", ME, msg_data_size, msg_data); end; /**** BEGIN IO SECTION ****/ event_code = 0; unmask_count = 0; saved_mask = ZERO_IPS_MASK; on cleanup call cleanup_handler; on any_other call any_other_handler; call hcs_$set_ips_mask (mowse_io_data.ws.ips_mask, saved_mask); do while (event_code = 0); call ipc_$unmask_ev_calls (event_code); unmask_count = unmask_count +1; end; call iox_$put_chars (iocb_ptr, msg_data_ptr, msg_data_size, code); if saved_mask_bit.control then call hcs_$reset_ips_mask (saved_mask, saved_mask); do count = 2 to unmask_count; call ipc_$mask_ev_calls (0); end; revert any_other, cleanup; /**** END IO SECTION ****/ if code ^= 0 then call sub_err_ (code, "ws_tty_mgr_$send_text", ACTION_CANT_RESTART, sub_error_info_ptr, retval, "Attempting to write to iocb ^p via iox_$put_chars.", iocb_ptr); return; %page; /* ------------------------------------------------------------------------- */ get_message: entry (I_iocb_ptr, I_msg_data_ptr, I_msg_data_size, O_msg_data_size, O_msg_id); iocb_ptr = I_iocb_ptr; msg_data_size = I_msg_data_size; msg_data_ptr = I_msg_data_ptr; mowse_io_data_ptr = iocb_ptr -> iocb.attach_data_ptr; if ws_tty_data$Flags.Trace then call ws_trace_ (" ^a$get_message: iocb ptr= ^p, size= ^i, data ptr= ^p.", ME, iocb_ptr, msg_data_size, msg_data_ptr); ws_message_ptr = addr (ws_control_msg); /* init */ n_chars_actually_read = 0; ws_control_msg.id = " "; ws_control_msg.data_size_lo = 0; ws_control_msg.data_size_hi = 0; total_chars_read = 0; /* read the control id and count */ call get_ws_chars (ws_message_ptr, CONTROL_MSG_OVERHEAD, n_chars_actually_read); if ws_tty_data$Flags.Trace then call ws_trace_ (" ^a$get_message: ID received= ^a, size= ^i, hi&lo= ^i, ^i.", ME, ws_control_msg.id, n_chars_actually_read, ws_control_msg.data_size_hi, ws_control_msg.data_size_lo); ws_message_length = ws_control_msg.data_size_lo + ws_control_msg.data_size_hi * BYTE_SIZE; /* read the actual input chars */ if ws_message_length = 0 then O_msg_data_size = 0; else do; call get_ws_chars (msg_data_ptr, min (ws_message_length, msg_data_size), n_chars_actually_read); if ws_tty_data$Flags.Trace then call ws_trace_ (" ^a$get_message: #chars received= ^i, chars= '^a'.", ME, n_chars_actually_read, substr (msg_data, 1, max (1, n_chars_actually_read))); if ws_message_length > msg_data_size then do; if ws_tty_data$Flags.Trace then do; call ws_trace_ (" ^a$get_message sub_err_: ws_message_length(^i) > msg_data_size(^i)", ME, ws_message_length, msg_data_size); call ws_trace_ (" ^a$get_message sub_err_: ID=^a, hi&lo=^i&^i.", ME, ws_control_msg.id, ws_control_msg.data_size_hi, ws_control_msg.data_size_lo); call ws_trace_ (" ^a$get_message sub_err_: #chars read=^i, chars='^a'.", ME, n_chars_actually_read, substr (msg_data, 1, max (1, n_chars_actually_read))); end /* Trace */; call sub_err_ (error_table_$no_operation, "ws_tty_mgr_$get_message", ACTION_CANT_RESTART, sub_error_info_ptr, retval, "Input truncated to fit caller's buffer."); end; total_chars_read = n_chars_actually_read; do while (total_chars_read < ws_message_length); /* message got split up into packets */ offset_msg_data_ptr = addr (msg_data_ptr -> based_chars (total_chars_read)); call get_ws_chars (offset_msg_data_ptr, (ws_message_length-total_chars_read), n_chars_actually_read); total_chars_read = total_chars_read + n_chars_actually_read; end; O_msg_data_size = total_chars_read; end; O_msg_id = ws_control_msg.id; return; %page; /* ------------------------------------------------------------------------- */ have_wsterm: entry (I_iocb_ptr, O_tty_state, O_code) returns (bit (1)); /* checks to see if WSTERM is connected */ /* if it is, returns TRUE and sets tty_state to DIALED_UP */ /* if it is not, returns FALSE, sets tty_state to IGNORE, and sets code to error_table_$io_no_permission */ dcl O_tty_state fixed bin parm; dcl internal_ws_state_ptr ptr; dcl 1 internal_ws_state aligned like mowse_io_terminal_state; O_code = 0; iocb_ptr = I_iocb_ptr; internal_ws_state.version = mowse_io_info_version_1; internal_ws_state_ptr = addr (internal_ws_state); call iox_$control (iocb_ptr, "get_terminal_emulator_state", internal_ws_state_ptr, code); if ws_tty_data$Flags.Trace then call ws_trace_ (" ^a$have_wsterm: terminal_emulator_state = ^b, code= ^i.", ME, internal_ws_state.state, code); if code ^= 0 then do; O_tty_state = 0; O_code = code; return (FALSE); end; if internal_ws_state.state = FALSE then do; O_tty_state = IGNORE; O_code = error_table_$io_no_permission; end; else /* state = TRUE */ O_tty_state = DIALED_UP; return (internal_ws_state.state); %page; /* ------------------------------------------------------------------------- */ ok_iocb: entry (I_iocb_ptr, O_iocb_ptr, O_attach_data_ptr, O_code) returns (bit (1)); /* checks the iocb_ptr and returns the actual ptr and the attach_data_ptr */ /* returns TRUE if all ok */ dcl O_attach_data_ptr ptr parm; O_iocb_ptr, O_attach_data_ptr = null; if I_iocb_ptr = null then goto no_iocb; O_iocb_ptr = I_iocb_ptr -> iocb.actual_iocb_ptr; if O_iocb_ptr = null then goto no_iocb; O_attach_data_ptr = O_iocb_ptr -> iocb.attach_data_ptr; if ws_tty_data$Flags.Trace then do; call ws_trace_ ( " ^a$ok_iocb(TRUE): I_iocb_ptr=^p, O_iocb_ptr=^p, O_attach_data_ptr=^p, iocb.name=^a, open_descrip=^a.", ME, I_iocb_ptr, O_iocb_ptr, O_attach_data_ptr, O_iocb_ptr -> iocb.name, O_attach_data_ptr -> mowse_io_data.open_descrip); end; O_code = 0; return (TRUE); no_iocb: if ws_tty_data$Flags.Trace then call ws_trace_ (" ^a$ok_iocb(FALSE):I_iocb_ptr=^p, O_iocb_ptr=^p.", ME, I_iocb_ptr, O_iocb_ptr); O_code = error_table_$no_iocb; return (FALSE); /* ------------------------ END PROGRAM ---------------------------------- */ %page; /* ------------------------ INTERNAL PROCEDURES -------------------------- */ get_ws_chars: proc (buffer_ptr, n_chars_to_read, n_chars_returned); dcl buffer_ptr ptr parm; dcl n_chars_to_read fixed bin (21) parm; dcl n_chars_returned fixed bin (21) parm; /**** BEGIN IO SECTION ****/ event_code = 0; unmask_count = 0; saved_mask = ZERO_IPS_MASK; on cleanup call cleanup_handler; on any_other call any_other_handler; call hcs_$set_ips_mask (mowse_io_data.ws.ips_mask, saved_mask); do while (event_code = 0); call ipc_$unmask_ev_calls (event_code); unmask_count = unmask_count +1; end; call iox_$get_chars (iocb_ptr, buffer_ptr, n_chars_to_read, n_chars_returned, code); if saved_mask_bit.control then call hcs_$reset_ips_mask (saved_mask, saved_mask); do count = 2 to unmask_count; call ipc_$mask_ev_calls (0); end; revert any_other, cleanup; /**** END IO SECTION ****/ if code ^= 0 then call sub_err_ (code, "ws_tty_mgr_$get_message", ACTION_CANT_RESTART, sub_error_info_ptr, retval, "Attempting to read from iocb ^p via iox_$get_chars.", iocb_ptr); return; end get_ws_chars; %page; /* ------------------------------------------------------------------------- */ cleanup_handler: proc; if ws_tty_data$Flags.Trace then call ws_trace_ (" ^a$cleanup_handler :saved_mask=^o.", ME, saved_mask); if saved_mask_bit.control then call hcs_$reset_ips_mask (saved_mask, saved_mask); do count = 2 to unmask_count; call ipc_$mask_ev_calls (0); end; return; end cleanup_handler; %page; /* ------------------------------------------------------------------------- */ any_other_handler: proc; dcl 1 ci aligned like condition_info; dcl find_condition_info_ entry (ptr, ptr, fixed bin (35)); dcl continue_to_signal_ entry (fixed bin (35)); if ws_tty_data$Flags.Trace then call ws_trace_ (" ^a$any_other_handler :saved_mask=^o.", ME, saved_mask); if saved_mask_bit.control then call hcs_$reset_ips_mask (saved_mask, saved_mask); do count = 2 to unmask_count; call ipc_$mask_ev_calls (0); end; ci.version = 1; call find_condition_info_ (null (), addr (ci), (0)); if ws_tty_data$Flags.Trace then call ws_trace_ (" ^a$any_other_handler: condition_name=^a.", ME, ci.condition_name); call continue_to_signal_ ((0)); return; end any_other_handler; %page; /* ------------------------ INCLUDES ------------------------------------- */ %include ws_control_ids; %page; %include ws_tty_data; %page; %include mowse_io_control_info; %page; %include mowse; %page; %include mowse_messages; %page; %include sub_err_flags; %page; %include sub_error_info; %page; %include condition_info_header; %page; %include condition_info; %page; %include iocb; %page; %include mowse_io_data; end ws_tty_mgr_;  ws_tty_read_.pl1 01/24/89 0855.8r w 01/24/89 0849.2 136899 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1986 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(86-12-05,RBarstad), approve(86-12-11,MCR7585), audit(87-08-05,Gilcrease), install(87-08-07,MR12.1-1075): Created. END HISTORY COMMENTS */ /* format: style3,^ifthenstmt,indthenelse,^indnoniterdo,^indprocbody,initcol3,dclind5,idind32 */ ws_tty_read_: proc (); return; /* ------------------------ DESCRIPTION ---------------------------------- */ /****^ VERSION 1.72 ws_tty_ entries to support video mode in MOWSE work station ws_tty_$read_echoed ws_tty_$read ws_tty_$read_with_mark */ %page; /* ------------------------ PARAMETERS ----------------------------------- */ dcl I_n_chars_to_read fixed bin (21) parm; /* maximum number of chars to return */ dcl I_offset fixed bin (21) parm; /* offset in buffer to start at */ dcl I_buffer char (*) parm; /* caller's buffer used by read_with_mark */ dcl I_buffer_ptr ptr parm; /* pointer to caller's buffer */ dcl I_screen_left fixed bin parm; /* Space left on line, negotiate entry */ dcl I_iocb_ptr ptr parm; /* io ptr for iox */ dcl I_never_block bit (1) aligned parm; dcl O_code fixed bin (35) parm; /* error code */ dcl O_echoed fixed bin (21) parm; /* Chars echoed by interrupt side */ dcl O_mark_index fixed bin (21) parm; /* index in returned string of "mark" */ dcl O_n_chars_read fixed bin (21) parm; /* actual number of characters returned */ dcl O_state fixed bin parm; /* tty state, 1 ignored, 2 listening, 5 dialed */ /* ------------------------ AUTOMATIC ------------------------------------ */ dcl code fixed bin (35); /* error code */ dcl echoed fixed bin (21); /* Chars echoed by interrupt side */ dcl iocb_ptr ptr; /* iocb pointer for iox */ dcl mark_index fixed bin (21); /* local copy */ dcl get_msg_id char (3); /* message id actually returned from WSTERM */ dcl n_chars_to_read fixed bin (21); /* maximum number of chars to return */ dcl n_chars_read fixed bin (21); /* actual number of characters returned */ dcl never_block bit (1) aligned; dcl offset fixed bin (21); /* offset in buffer to start at */ dcl buffer_ptr ptr; /* pointer to caller's buffer */ dcl read_ptr ptr; /* actuall ptr to read buffer */ dcl read_data char (2); /* read count */ dcl read_data_len fixed bin (21); /* size of read data */ dcl read_data_ptr ptr; dcl screen_left fixed bin; /* Space left on line, negotiate entry */ dcl state fixed bin; /* tty state, 1 ignored, 2 listening, 5 dialed */ dcl total_chars_read fixed bin; dcl read_flags bit (9); /* ------------------------ BASED ---------------------------------------- */ dcl based_chars (0:offset) char (1) based unal; /* to bump write ptr */ /* ------------------------ CONSTANTS ------------------------------------ */ dcl ( ME char (12) init ("ws_tty_read_"), BYTE_SIZE fixed bin init (256), FALSE bit (1) init ("0"b), TRUE bit (1) init ("1"b) ) internal static options (constant); /* ------------------------ EXTERNALS ------------------------------------ */ dcl ( error_table_$bad_arg, error_table_$improper_data_format ) fixed bin (35) external static; /* ------------------------ ENTRIES -------------------------------------- */ dcl ws_tty_mgr_$ok_iocb entry (ptr, ptr, ptr, fixed bin (35)) returns (bit (1)); dcl ws_tty_mgr_$send_message entry (ptr, char (3), bit (9), ptr, fixed bin (21)); dcl ws_tty_mgr_$get_message entry (ptr, ptr, fixed bin (21), fixed bin (21), char (3)); dcl ws_trace_ entry () options (variable); /* ------------------------ BUILTINS and CONDITIONS ---------------------- */ dcl (addr, divide, length, max, min) builtin; dcl cleanup condition; %page; /* ------------------------ PROGRAM -------------------------------------- */ read: entry (I_iocb_ptr, I_buffer_ptr, I_offset, I_n_chars_to_read, O_n_chars_read, O_state, O_code); /**** get params */ buffer_ptr = I_buffer_ptr; offset = I_offset; n_chars_to_read = I_n_chars_to_read; /**** init */ code = 0; state = 0; n_chars_read = 0; on cleanup call clean_up; if ws_tty_data$Flags.Trace = TRUE then call ws_trace_ ("^a$read entry: iocb_ptr=^p, buffer_ptr=^p, offset=^i, chars=^i.", ME, I_iocb_ptr, buffer_ptr, offset, n_chars_to_read); /**** check environment */ if ^ws_tty_mgr_$ok_iocb (I_iocb_ptr, iocb_ptr, mowse_io_data_ptr, code) then goto read_exit; /**** get buffer ptrs and sizes */ if n_chars_to_read < 0 then do; code = error_table_$bad_arg; goto read_exit; end; read_ptr = addr (buffer_ptr -> based_chars (offset)); read_data = convert_read_count (n_chars_to_read); read_data_ptr = addr (read_data); read_data_len = length (read_data); if ws_tty_data$Flags.Trace = TRUE then call ws_trace_ ("^a$read: read_count=^i.", ME, mowse_io_data.ws.read_count); /**** read it */ if (mowse_io_data.ws.read_count = 0) | (n_chars_to_read = 0) then do; call ws_tty_mgr_$send_message (iocb_ptr, WS_READ_WITH_NO_ECHO, WS_FLAG_NONE, read_data_ptr, read_data_len); mowse_io_data.ws.read_count = mowse_io_data.ws.read_count + 1; end; call ws_tty_mgr_$get_message (iocb_ptr, read_ptr, n_chars_to_read, n_chars_read, get_msg_id); /**** check what was read */ if get_msg_id = WS_END_NON_ECHOED_INPUT then mowse_io_data.ws.read_count = mowse_io_data.ws.read_count - 1; else if get_msg_id ^= WS_UNECHOED_INPUT_CHARS then code = error_table_$improper_data_format; read_done: O_n_chars_read = n_chars_read; read_exit: if ws_tty_data$Flags.Trace = TRUE then call ws_trace_ ("^a$read exit: n_chars_read=^i, state=^i, code=^i.^/", ME, n_chars_read, state, code); O_state = state; O_code = code; return; %page; read_echoed: entry (I_iocb_ptr, I_buffer_ptr, I_offset, I_n_chars_to_read, O_n_chars_read, O_echoed, I_screen_left, O_state, O_code); /**** get params */ buffer_ptr = I_buffer_ptr; offset = I_offset; n_chars_to_read = I_n_chars_to_read; screen_left = I_screen_left; /**** init */ code = 0; state = 0; n_chars_read = 0; echoed = 0; get_msg_id = " "; total_chars_read = 0; on cleanup call clean_up; if ws_tty_data$Flags.Trace then call ws_trace_ ( "^a$read_echoed entry: iocb_ptr=^p, buffer_ptr=^p, offset=^i, chars=^i, screen=^i, O_echoed=^i.", ME, I_iocb_ptr, buffer_ptr, offset, n_chars_to_read, screen_left, O_echoed); /**** check environment */ if ^ws_tty_mgr_$ok_iocb (I_iocb_ptr, iocb_ptr, mowse_io_data_ptr, code) then goto read_echoed_exit; /**** get buffer ptrs and sizes */ if n_chars_to_read = 0 then goto read_echoed_done; if n_chars_to_read < 0 then do; code = error_table_$bad_arg; goto read_echoed_exit; end; read_ptr = addr (buffer_ptr -> based_chars (offset)); if ws_tty_data$Flags.Trace = TRUE then call ws_trace_ ("^a$read_echoed: read_count=^i.", ME, mowse_io_data.ws.read_count); %page; /**** read it */ if screen_left ^= 0 /* turn echo ON, OR return any previously entered non-echoed input */ then do; n_chars_to_read = min (n_chars_to_read, screen_left); read_data = convert_read_count (n_chars_to_read); read_data_ptr = addr (read_data); read_data_len = length (read_data); if (mowse_io_data.ws.read_count > 0) /* non-echoed input to clean up */ then do; call ws_tty_mgr_$send_message (iocb_ptr, WS_READ_WITH_NO_ECHO, WS_FLAG_NO_BLOCK, read_data_ptr, read_data_len); mowse_io_data.ws.read_count = mowse_io_data.ws.read_count + 1; do while (mowse_io_data.ws.read_count > 0); call ws_tty_mgr_$get_message (iocb_ptr, read_ptr, n_chars_to_read, n_chars_read, get_msg_id); total_chars_read = total_chars_read + n_chars_read; if get_msg_id = WS_END_NON_ECHOED_INPUT then mowse_io_data.ws.read_count = mowse_io_data.ws.read_count - 1; else if (get_msg_id = WS_UNECHOED_INPUT_CHARS) then do; /* not end, prepare to read again */ offset = offset + n_chars_read; n_chars_to_read = n_chars_to_read - n_chars_read; read_ptr = addr (buffer_ptr -> based_chars (offset)); read_data = convert_read_count (n_chars_to_read); end; else if (get_msg_id = " ") & (n_chars_read = 0) /* special case from start control order */ then /* ignore */; else code = error_table_$improper_data_format; end /* do while */; end /* if mowse_io_data.ws.read_count > 0 */; /* now finally, we can read echoed input, but only if there was no unechoed input*/ if total_chars_read = 0 then call ws_tty_mgr_$send_message (iocb_ptr, WS_READ_WITH_ECHO, WS_FLAG_NONE, read_data_ptr, read_data_len); end /* screen_left ^= 0 */; else /* screen_left = 0, turn echo OFF */ do while ((get_msg_id ^= WS_END_ECHOED_INPUT) & (n_chars_to_read > 0) & (code = 0)); call ws_tty_mgr_$get_message (iocb_ptr, read_ptr, n_chars_to_read, n_chars_read, get_msg_id); total_chars_read = total_chars_read + n_chars_read; if get_msg_id = WS_END_ECHOED_INPUT /* the end */ then do; echoed = echoed + n_chars_read; mowse_io_data.ws.read_count = 0; /* just in case */ end; else do /* not WS_END_ECHOED_INPUT, prepare to read again */; offset = offset + n_chars_read; n_chars_to_read = n_chars_to_read - n_chars_read; read_ptr = addr (buffer_ptr -> based_chars (offset)); read_data = convert_read_count (n_chars_to_read); if get_msg_id = WS_ECHOED_INPUT_CHARS then echoed = echoed + n_chars_read; else if (get_msg_id = " ") & (n_chars_read = 0) /* special case from start control order */ then do; n_chars_to_read = 0 /* force stop and exit */; end; else code = error_table_$improper_data_format; end /* else not WS_END_ECHOED_INPUT */; end /* do while */; read_echoed_done: O_n_chars_read = total_chars_read; O_echoed = echoed; read_echoed_exit: if ws_tty_data$Flags.Trace then call ws_trace_ ("^a$read_echoed exit: total_chars_read=^i, echoed=^i, state=^i, code=^i.^/", ME, total_chars_read, echoed, state, code); O_state = state; O_code = code; return; %page; read_with_mark: entry (I_iocb_ptr, I_buffer, I_never_block, O_n_chars_read, O_mark_index, O_state, O_code); /**** get params */ never_block = I_never_block; /**** init */ code = 0; state = 0; mark_index = 0; n_chars_read = 0; total_chars_read = 0; offset = 0; on cleanup call clean_up; if ws_tty_data$Flags.Trace then call ws_trace_ ("^a$read_with_mark entry: iocb_ptr=^p, never-block=^i.", ME, I_iocb_ptr, never_block); /**** check environment */ if ^ws_tty_mgr_$ok_iocb (I_iocb_ptr, iocb_ptr, mowse_io_data_ptr, code) then goto read_with_mark_exit; /**** get buffer ptrs and sizes */ buffer_ptr = addr (I_buffer); n_chars_to_read = length (I_buffer); if n_chars_to_read < 0 then do; code = error_table_$bad_arg; goto read_with_mark_exit; end; read_ptr = buffer_ptr; read_data = convert_read_count (n_chars_to_read); read_data_ptr = addr (read_data); read_data_len = length (read_data); if never_block then read_flags = WS_FLAG_NO_BLOCK; else read_flags = WS_FLAG_NONE; /**** read it */ if ws_tty_data$Flags.Trace = TRUE then call ws_trace_ ("^a$read_with_mark: read_count=^i.", ME, mowse_io_data.ws.read_count); if (mowse_io_data.ws.read_count = 0) | (n_chars_to_read = 0) | (never_block) then do; call ws_tty_mgr_$send_message (iocb_ptr, WS_READ_WITH_NO_ECHO, read_flags, read_data_ptr, read_data_len); mowse_io_data.ws.read_count = mowse_io_data.ws.read_count + 1; end; unechoed_get_message: /* come here to complete last unecho read request */ call ws_tty_mgr_$get_message (iocb_ptr, read_ptr, n_chars_to_read, n_chars_read, get_msg_id); /**** check what was read */ if get_msg_id = WS_END_NON_ECHOED_INPUT then mowse_io_data.ws.read_count = mowse_io_data.ws.read_count - 1; else if get_msg_id ^= WS_UNECHOED_INPUT_CHARS then if (get_msg_id = " ") & (n_chars_read = 0) /* special case from start control order */ then /* ignore */; else code = error_table_$improper_data_format; total_chars_read = total_chars_read + n_chars_read; if never_block & (mowse_io_data.ws.read_count > 0) then do; offset = offset + n_chars_read; read_ptr = addr (buffer_ptr -> based_chars (offset)); n_chars_to_read = max (0, n_chars_to_read - n_chars_read); read_data = convert_read_count (n_chars_to_read); goto unechoed_get_message; end; if (total_chars_read > 0) & (code = 0) then if mowse_io_data.ws.flags.mark_set then do; mark_index = 1; mowse_io_data.ws.flags.mark_set = FALSE; end; read_with_mark_exit: if ws_tty_data$Flags.Trace then call ws_trace_ ("^a$read_with_mark exit: total_chars_read=^i, mark_index=^i, state=^i, code=^i.^/", ME, total_chars_read, mark_index, state, code); O_n_chars_read = total_chars_read; O_mark_index = mark_index; O_state = state; O_code = code; return; /* ------------------------ END PROGRAM ---------------------------------- */ %page; /* ------------------------ INTERNAL PROCEDURES -------------------------- */ clean_up: proc; n_chars_read, O_n_chars_read = 0; state = 0; return; end clean_up; %page; /* ------------------------------------------------------------------------- */ convert_read_count: proc (count) returns (char (2)); dcl count fixed bin (21) parm; dcl count_chars char (2); dcl 1 count_bytes unaligned based (addr (count_chars)), 2 hi fixed bin (8), 2 lo fixed bin (8); if count < BYTE_SIZE then do; count_bytes.hi = 0; count_bytes.lo = count; end; else do; count_bytes.hi = divide (count, BYTE_SIZE, 3); count_bytes.lo = count - (BYTE_SIZE * count_bytes.hi); end; return (count_chars); end convert_read_count; %page; /* ------------------------ INCLUDES ------------------------------------- */ %include ws_control_ids; %page; %include ws_tty_data; %page; %include iocb; %page; %include mowse_io_data; end ws_tty_read_;  ws_tty_write_.pl1 01/24/89 0855.8r w 01/24/89 0849.0 61047 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1986 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(86-12-05,RBarstad), approve(86-12-11,MCR7585), audit(87-06-05,Gilcrease), install(87-08-07,MR12.1-1075): Created. END HISTORY COMMENTS */ /* format: style3,^ifthenstmt,indthenelse,^indnoniterdo,^indprocbody,initcol3,dclind5,idind32 */ ws_tty_write_: proc (); return; /* ------------------------ DESCRIPTION ---------------------------------- */ /****^ VERSION 1.10 ws_tty_write_ entries to support video mode in MOWSE ws_tty_write_$write ws_tty_write_$write_whole_string */ %page; /* ------------------------ PARAMETERS ----------------------------------- */ dcl I_mark_flag bit (1) parm; /* whether to set a mark on write_whole_string entry */ dcl I_n_chars_to_write fixed bin (21) parm; /* maximum number of chars to return */ dcl I_offset fixed bin (21) parm; /* offset in buffer to start at */ dcl I_buffer_ptr ptr parm; /* pointer to caller's buffer */ dcl I_string char (*) parm; dcl I_iocb_ptr ptr parm; /* tty index (actually also device index ) */ dcl O_code fixed bin (35) parm; /* error code */ dcl O_n_chars_written fixed bin (21) parm; /* actual number of characters returned */ dcl O_state fixed bin parm; /* tty state, 1 ignored, 2 listening, 5 dialed */ /* ------------------------ AUTOMATIC ------------------------------------ */ dcl code fixed bin (35); /* error code */ dcl iocb_ptr ptr; /* iocb pointer for iox */ dcl mark_flag bit (1); /* whether to set a mark on write_whole_string entry */ dcl n_chars_to_write fixed bin (21); /* maximum number of chars to return */ dcl n_chars_written fixed bin (21); /* actual number of characters returned */ dcl offset fixed bin (21); /* offset in buffer to start at */ dcl buffer_ptr ptr; /* pointer to caller's buffer */ dcl state fixed bin; /* tty state, 1 ignored, 2 listening, 5 dialed */ dcl write_ptr ptr; /* the right ptr to the data to write */ /* ------------------------ BASED ---------------------------------------- */ dcl based_chars (0:offset) char (1) based unal; /* to bump write ptr */ /* ------------------------ CONSTANTS ------------------------------------ */ dcl ( ME char (13) init ("ws_tty_write_"), FALSE bit (1) init ("0"b), TRUE bit (1) init ("1"b) ) internal static options (constant); /* ------------------------ EXTERNALS ------------------------------------ */ dcl (error_table_$bad_arg) fixed bin (35) external static; /* ------------------------ ENTRIES -------------------------------------- */ dcl ws_tty_mgr_$ok_iocb entry (ptr, ptr, ptr, fixed bin (35)) returns (bit (1)); dcl ws_tty_mgr_$send_text entry (ptr, ptr, fixed bin (21)); dcl ws_trace_ entry () options (variable); /* ------------------------ BUILTINS and CONDITIONS ---------------------- */ dcl (addr, length) builtin; /* dcl cleanup condition; */ %page; /* ------------------------ PROGRAM -------------------------------------- */ write: entry (I_iocb_ptr, I_buffer_ptr, I_offset, I_n_chars_to_write, O_n_chars_written, O_state, O_code); /**** get parameters */ buffer_ptr = I_buffer_ptr; offset = I_offset; n_chars_to_write = I_n_chars_to_write; /**** init */ code = 0; state = 0; n_chars_written = 0; if ws_tty_data$Flags.Trace = TRUE then call ws_trace_ ("^a$write entry: iocb_ptr=^p, buffer=^p, offset=^i, chars=^i.", ME, I_iocb_ptr, buffer_ptr, offset, n_chars_to_write); /**** check environment */ if ^ws_tty_mgr_$ok_iocb (I_iocb_ptr, iocb_ptr, mowse_io_data_ptr, code) then goto write_exit; mowse_io_data.ws.flags.mark_set = FALSE; /**** check size of write */ if n_chars_to_write < 0 then do; code = error_table_$bad_arg; goto write_exit; end; if n_chars_to_write = 0 then goto write_done; /**** find the portion of the caller's buffer to write */ write_ptr = addr (buffer_ptr -> based_chars (offset)); n_chars_written = n_chars_to_write; /**** write it */ call ws_tty_mgr_$send_text (iocb_ptr, write_ptr, n_chars_written); write_done: O_n_chars_written = n_chars_written; write_exit: if ws_tty_data$Flags.Trace = TRUE then call ws_trace_ ("^a$write exit: n_chars_written=^i, state=^i, code=^i.^/", ME, n_chars_written, state, code); O_state = state; O_code = code; return; %page; write_whole_string: entry (I_iocb_ptr, I_string, I_mark_flag, O_n_chars_written, O_state, O_code); /**** get parameters */ mark_flag = I_mark_flag; /**** init */ code = 0; state = 0; n_chars_written = 0; offset = 0; if ws_tty_data$Flags.Trace then call ws_trace_ ("^a$write_whole_string entry: iocb_ptr=^p, string='^a', mark=^i.", ME, I_iocb_ptr, I_string, mark_flag); /**** check environment */ if ^ws_tty_mgr_$ok_iocb (I_iocb_ptr, iocb_ptr, mowse_io_data_ptr, code) then goto write_whole_string_exit; mowse_io_data.ws.flags.mark_set = mark_flag; /* for the benefit of read_with_mark */ /**** get pointers and string sizes */ write_ptr = addr (I_string); n_chars_to_write = length (I_string); if n_chars_to_write = 0 then goto write_whole_done; /**** write it */ call ws_tty_mgr_$send_text (iocb_ptr, write_ptr, n_chars_to_write); n_chars_written = n_chars_to_write; write_whole_done: O_n_chars_written = n_chars_written; write_whole_string_exit: if ws_tty_data$Flags.Trace = TRUE then call ws_trace_ ("^a$write_whole_string exit: n_chars_written=^i, state=^i, code=^i.^/", ME, n_chars_written, state, code); O_state = state; O_code = code; return; /* ------------------------ END PROGRAM ---------------------------------- */ /* ------------------------ INTERNAL PROCEDURES -------------------------- */ %page; /* ------------------------ INCLUDES ------------------------------------- */ %include ws_control_ids; %page; %include ws_tty_data; %page; %include iocb; %page; %include mowse_io_data; end ws_tty_write_; bull_copyright_notice.txt 08/30/05 1008.4r 08/30/05 1007.3 00020025 ----------------------------------------------------------- Historical Background This edition of the Multics software materials and documentation is provided and donated to Massachusetts Institute of Technology by Group Bull including Bull HN Information Systems Inc. as a contribution to computer science knowledge. This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology, Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell Bull Inc., Groupe Bull and Bull HN Information Systems Inc. to the development of this operating system. Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970), renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership of Professor Fernando Jose Corbato.Users consider that Multics provided the best software architecture for managing computer hardware properly and for executing programs. Many subsequent operating systems incorporated Multics principles. Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. . ----------------------------------------------------------- Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without fee is hereby granted,provided that the below copyright notice and historical background appear in all copies and that both the copyright notice and historical background and this permission notice appear in supporting documentation, and that the names of MIT, HIS, Bull or Bull HN not be used in advertising or publicity pertaining to distribution of the programs without specific prior written permission. Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc. Copyright 2006 by Bull HN Information Systems Inc. Copyright 2006 by Bull SAS All Rights Reserved