COMPILATION LISTING OF SEGMENT e_pl1_ Compiled by: Multics PL/I Compiler, Release 31a, of October 12, 1988 Compiled at: Honeywell Bull, Phoenix AZ, SysM Compiled on: 10/17/88 1040.0 mst Mon Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1987 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 6* * * 7* * Copyright (c) 1978 by Massachusetts Institute of * 8* * Technology and Honeywell Information Systems, Inc. * 9* * * 10* *********************************************************** */ 11 12 /* format: style4,^inddcls,insnl,delnl */ 13 14 e_pl1_: 15 procedure; 16 return; 17 18 /****^ HISTORY COMMENTS: 19* 1) change(84-07-31,Margolin), approve(), audit(), install(): 20* Pre-hcom comments: 21* BSG 3/4/78 22* Modified: 12/3/79 by BSG for process preservation across hangup. 23* Modified: 7 May 1981 Soley for e_pl1_$check_object 24* Modified: 22 June 1981 RMSoley to make get_real_terminal_type 25* check for the video system. 26* Modified: 2 July 1981 RMSoley to make get_char entries use the 27* video system if present. 28* Modified 6 July 1981 bim for correct video usage 29* Modified: 9 July 1981 RMSoley to check for -login_channel in finding 30* proper I/O switch. 31* Modified: 23 July 1981 RMSoley to use emacs_data_ static 32* Modified: August 1981 RMSoley to move static to invocation structure, 33* get rid of push_pop_table_swap, calls to e_find_invocation_ 34* Modified: November 1981 RMSoley & BIMargulies to add get_emacs_data_ptr, 35* enlarge workstring, add retry bit to window_system calls. 36* Modified: 30 June 1982 B Margolin to convert hcs_$echo_negotiate_get_chars 37* calls to use the new hcs_$tty_read_echoed entrypoint, and 38* to process error_table_$echnego_awaiting_stop_sync instead of 39* error_table_$line_status_pending. 40* Modified: 1 September 1982 B. Margolin to send send_buffered_output order 41* to video system in dump_obuf 42* Modified: 15 September 1982 B. Margolin to call window_$sync instead of 43* sending send_buffered_output order. 44* Modified: 5 January 1983 B. Margolin to remove all references to the 45* NCP (!!!!), as we recently switched to TCP, which use STY terminals 46* Modified 31 July 1984 - K. P. Fleming - to add new messaging primitives, 47* in preparation for a complete emacs-console-messages rewrite to 48* support new message_facility_. 49* 2) change(85-01-16,Margolin), approve(), audit(), install(): 50* Pre-hcom comments: 51* Modified 28 August 1984 - K. P. Fleming - to cover for a 'bug' in the new 52* message facility. we have to be able to set the wakeup and holding states 53* indepedently, and the message facility doesn't allow this yet. so, we just 54* use a structure overlay and set them in there. 55* Modified 22 September 1984 - B. Margolin - to fix up KPF's work, and to 56* make check_for_window_status entrypoint call e_find_invocation_. 57* Modified 9 October 1984 - B. Margolin - to change current_message_info 58* references to last_message_info. 59* Modified 2 November 1984 - B. Margolin - to translate control chars in 60* messages to spaces. 61* Modified 30 November 1984 - B. Margolin - to not use Iint parameter in 62* the wrong entrypoint, and change some vars declared bin to fixed bin. 63* Modified 16 January 1985 - B. Margolin - for compatibility with the 64* change to message_facility_, changed references to last_message_info.last_message_index 65* to =.last_message_id (in mf_$set_seen_switch call) and =.last_message_number 66* (in ioa_$rsnnl call, which it should have been in the first place). 67* 3) change(86-07-08,Coren), approve(86-07-08,MCR7300), 68* audit(86-07-08,Beattie), install(86-07-08,MR12.0-1089): 69* Changed to use v1_echo_neg_data for compatibility. 70* 4) change(86-07-16,Margolin), approve(86-07-16,MCR7452), 71* audit(86-07-29,Coren), install(86-11-03,MR12.0-1205): 72* Changed e_pl1_$init to automatically turn on the video system if a non-MCS 73* terminal is being used. 74* 5) change(86-11-11,LJAdams), approve(86-11-11,MCR7485), 75* audit(86-12-16,Margolin), install(87-01-06,MR12.0-1255): 76* Modified to support MOWSE. 77* 6) change(87-03-13,LJAdams), approve(87-03-13,MCR7642), 78* audit(87-04-24,Gilcrease), install(87-05-14,MR12.1-1030): 79* Added external variable video_data_$terminal_iocb to be able to determine 80* if video has been invoked by another subsytem other than emacs. 81* 7) change(87-12-21,Schroth), approve(88-02-29,MCR7851), 82* audit(88-06-06,RBarstad), install(88-08-01,MR12.2-1071): 83* Added support for 8-bit extended ASCII I/O. 84* Added set_extended_ascii and get_output_conv_table entry points, 85* and grew breaktables to 256. 86* END HISTORY COMMENTS */ 87 88 /* Those editor functions best done in PL/I, but not concerned with 89* getting into or out of the editor environment. 90* This includes the ring 0 TTY dim and NCP interface (removed 1/5/82!), the 91* TELNET and SUPDUP-OUTPUT negotiators, the message-receiving primitives, 92* etcetera. */ 93 94 /* Builtin */ 95 dcl (byte, collate9, fixed, length, null, translate) builtin; 96 97 /* CONSTANTS for TELNET negotiations. */ 98 99 dcl ( 100 IAC init (255), 101 WILL init (251), 102 WONT init (252), 103 DO init (253), 104 DONT init (254), 105 ECHO init (1), 106 SB init (250), /** SE init (240), **/ 107 SUPDUP_OUTPUT init (22) 108 ) fixed bin (8) static options (constant); 109 110 /* Static Variables */ 111 dcl 1 bl aligned static, 112 2 c fixed bin init (1), 113 2 pad bit (36) aligned, 114 2 event fixed bin (71); 115 dcl charsgot_meter fixed bin internal static; 116 dcl charsout_meter fixed bin (21) internal static; 117 dcl dbosw bit (1) static init ("0"b); 118 dcl 1 editing_chars_v1 aligned internal static, 119 2 version fixed bin init (1), 120 2 escape_char character (1) aligned, 121 2 erase_char character (1) aligned, 122 2 kill_char character (1) aligned; 123 dcl 1 editing_chars_v2 aligned internal static, 124 2 version fixed bin init (2), 125 2 special_chars aligned, 126 3 erase_char character (1) unaligned, 127 3 kill_char character (1) unaligned; 128 dcl ignore_lf_sw bit (1) init ("0"b) static; 129 dcl locecho_meter fixed bin internal static; 130 dcl my_pid bit (36) aligned static; 131 dcl r0echo_meter fixed bin internal static; 132 dcl sdostate bit (1) internal static initial ("0"b); 133 dcl 1 supdup_info aligned internal static, 134 2 aobjct fixed bin (17) unaligned, 135 2 pad fixed bin (17) unaligned, 136 2 tctyp fixed bin (35), 137 2 ttyopt bit (36), 138 2 tcmxv fixed bin (35), 139 2 tcmxh fixed bin (35), 140 2 ttyrol fixed bin (35), 141 2 smarts bit (36), 142 2 ispeed fixed bin (35), 143 2 ospeed fixed bin (35); 144 dcl tracing_Rtyo bit (1) aligned internal static initial ("0"b); 145 dcl Rtyo_trace_iocb_ptr pointer internal static initial (null ()); 146 dcl network_type fixed bin (4) unsigned static; 147 148 /* System Entries */ 149 dcl com_err_ entry options (variable); 150 dcl condition_ entry (char (*), entry); 151 dcl cu_$arg_count entry (fixed bin); 152 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35)); 153 dcl cu_$cp entry (ptr, fixed bin (21), fixed bin (35)); 154 dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)); 155 dcl get_line_length_$switch entry (ptr, fixed bin (35)) returns (fixed bin); 156 dcl get_process_id_ entry returns (bit (36) aligned); 157 dcl get_system_free_area_ entry () returns (ptr); 158 dcl hcs_$tty_read entry (fixed bin, ptr, fixed bin (21), fixed bin (21), fixed bin (21), fixed bin, fixed bin (35)); 159 dcl hcs_$tty_state entry (fixed bin, fixed bin, fixed bin (35)); 160 dcl hcs_$tty_write entry (fixed bin, ptr, fixed bin, fixed bin, fixed bin, fixed bin, fixed bin (35)); 161 dcl hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)); 162 dcl ioa_$ioa_switch entry options (variable); 163 dcl ipc_$block entry (ptr, ptr, fixed bin (35)); 164 dcl mode_string_$get_mode entry (char (*), char (*), ptr, fixed bin (35)); 165 dcl object_info_$brief entry (ptr, fixed bin (24), ptr, fixed bin (35)); 166 dcl signal_ entry () options (variable); 167 dcl sub_err_ entry () options (variable); 168 dcl video_utils_$network_login_channel entry (ptr, fixed bin (4) unsigned, fixed bin (35)); 169 dcl video_utils_$turn_on_login_channel entry (fixed bin (35), char (*)); 170 171 /* External static */ 172 dcl error_table_$bad_arg fixed bin (35) external static; 173 dcl error_table_$echnego_awaiting_stop_sync fixed bin (35) external static; 174 dcl error_table_$no_table fixed bin (35) external static; 175 176 dcl video_data_$terminal_iocb pointer external; 177 178 /* Automatic */ 179 dcl 1 bit_bucket aligned automatic like object_info; 180 dcl break_nonvar character (1); 181 dcl ch char (1) aligned; 182 dcl code fixed bin (35); 183 dcl code_to_check fixed bin (35); 184 dcl 1 delay_table aligned like delay_struc; 185 dcl error_message char (128); 186 dcl expdl fixed bin; 187 dcl fch fixed bin (9); 188 dcl gruft (10) fixed bin (71); 189 dcl ignore_control bit (1) aligned; 190 dcl intp pointer; 191 dcl msgp pointer; 192 dcl 1 my_mode_value aligned like mode_value; 193 dcl nargs fixed bin; 194 dcl newbit bit (1); 195 dcl ngo_entry bit (1); 196 dcl nread fixed bin (21); 197 dcl ochl fixed bin (21); 198 dcl ochp pointer; 199 dcl retry bit (1) aligned; 200 dcl save_tty_in_emacs_p bit (1) aligned; 201 dcl screenlinelen fixed bin; 202 dcl sdbct fixed bin; 203 dcl sddata (0:35) bit (6) unaligned; 204 dcl sls_al fixed bin (21); 205 dcl sls_ap pointer; 206 dcl sls_t_ospeed fixed bin; 207 dcl system_free_ptr pointer; 208 dcl tempc fixed bin (9); 209 dcl tty_mode_string character (512); 210 dcl vaccum character (200) varying; 211 dcl way fixed bin; 212 dcl went_opblockedp bit (1); 213 dcl S fixed bin; 214 215 /* Based */ 216 dcl based_area area based (system_free_ptr); 217 dcl 1 based_message_struc aligned based (msgp), 218 2 msglen initial (length (P_msgtext)) fixed bin (21), 219 2 sender character (64) initial (P_sender), 220 2 time character (32) unal initial (P_msgtime), 221 2 next pointer initial (null ()), 222 2 msg character (length (P_msgtext) refer (based_message_struc.msglen)) init (P_msgtext) unal; 223 dcl big_bit_string bit (256) based (addr (emacs_data.breaktable)); 224 dcl bytes (10000) bit (8) unal based (emacs_data.ibufptr); 225 dcl chars (6000) bit (9) unal based (addr (bytes)); 226 dcl 1 charsadded based (P_charsadded_symobj), 227 2 (tinfo, ct) fixed bin (35); 228 dcl 1 echd like echo_neg_data aligned; 229 dcl 1 get_channel_info aligned, 230 2 version fixed bin, 231 2 devx fixed bin, 232 2 channel_name char (32); 233 dcl ibuf (10000) bit (8) unal based (emacs_data.ibufptr); 234 dcl 1 interrupt based (intp), 235 2 number fixed bin, 236 2 msg fixed bin, 237 2 chain pointer; 238 dcl obuf char (4096) unal based (emacs_data.obufptr); 239 dcl och character (ochl) based (ochp); 240 dcl 1 rsblock aligned like tty_read_status_info; 241 dcl sls_arg character (sls_al) based (sls_ap); 242 dcl 1 tinfo like terminal_info aligned; 243 dcl workstring character (262144) varying based (P_workstringobj); 244 245 /* Parameters */ 246 dcl a_mxh fixed bin (35) parameter; 247 dcl a_mxv fixed bin (35) parameter; 248 dcl (a_r1, a_r2, a_r3, a_r4) fixed bin (35) parameter; 249 dcl a_terminal_type character (*) varying parameter; 250 dcl a_ttyopt bit (36) aligned; 251 dcl a_terminal_type1 character (*) parameter; 252 dcl in_ptr pointer parameter; 253 dcl out_ptr pointer parameter; 254 dcl pch character (*) parameter; 255 dcl (P_1, P_2, P_3, P_4, P_5, P_6, P_7, P_8) fixed bin (32) parameter; 256 dcl P_backspace_delay fixed bin parameter; 257 dcl P_bc fixed bin (24) parameter; 258 dcl P_bchx fixed bin parameter; 259 dcl P_charsadded_symobj pointer parameter; 260 dcl P_cline character (*) parameter; 261 dcl 1 P_cv_trans like cv_trans aligned parameter; 262 dcl P_dbosw fixed bin (1) parameter; 263 dcl P_erase_char character (1) parameter; 264 dcl P_escape_char character (1) parameter; 265 dcl P_horz_nl_delay float bin parameter; 266 dcl P_intercode fixed bin parameter; 267 dcl P_interrupt_msg fixed bin parameter; 268 dcl P_interruptno fixed bin parameter; 269 dcl P_intno_char character (*) parameter; 270 dcl P_iocb_name character (*) parameter; 271 dcl P_kill_char character (1) parameter; 272 dcl P_line_speed fixed bin parameter; 273 dcl P_linel fixed bin parameter; 274 dcl P_msgno character (*) parameter; 275 dcl P_msgtext character (*) parameter; 276 dcl P_msgtime character (*) parameter; 277 dcl P_pointer pointer parameter; 278 dcl P_retmsg character (*) varying parameter; 279 dcl P_retsender character (*) varying parameter; 280 dcl P_rettime character (*) varying parameter; 281 dcl P_screenlinelen fixed bin parameter; 282 dcl P_sender character (*) parameter; 283 dcl P_sw fixed bin (1) parameter; 284 dcl P_tab_const_delay fixed bin parameter; 285 dcl P_tab_var_delay float bin parameter; 286 dcl P_tabs_avl bit (1) aligned parameter; 287 dcl P_vert_nl_delay fixed bin parameter; 288 dcl P_video fixed bin (1) parameter; 289 dcl P_way fixed bin parameter; 290 dcl P_workstringobj pointer parameter; 291 292 /* Include Files */ 1 1 /* Begin include file emacs_data.incl.pl1 */ 1 2 /* format: style3 */ 1 3 /**** Created: RMSoley 5 August 1981 ****/ 1 4 /****^ HISTORY COMMENTS: 1 5* 1) change(81-11-19,Soley), approve(), audit(), install(): 1 6* for flags.got_cr 1 7* 2) change(82-04-15,Soley), approve(), audit(), install(): 1 8* for tasking.return_label 1 9* 3) change(82-06-02,Margolin), approve(), audit(), install(): 1 10* to also include level_info dcl 1 11* 4) change(84-09-23,Margolin), approve(), audit(), install(): 1 12* to add emacs_data.arguments.shared_static 1 13* 5) change(84-11-02,Margolin), approve(), audit(), install(): 1 14* to add emacs_data.arguments.force 1 15* 6) change(86-07-16,Margolin), approve(86-07-16,MCR7452), 1 16* audit(86-11-03,Coren), install(86-11-03,MR12.0-1205): 1 17* Added emacs_data.flags.turned_on_video and removed the copyright notice 1 18* (include files aren't supposed to have them). 1 19* 7) change(87-12-21,Schroth), approve(88-02-29,MCR7851), 1 20* audit(88-06-06,RBarstad), install(88-08-01,MR12.2-1071): 1 21* to add extended_ascii flag and extend breaktable for 8bit I/O. 1 22* END HISTORY COMMENTS */ 1 23 1 24 1 25 /* Stuff to manage invocations. */ 1 26 dcl e_find_invocation_ entry () returns (pointer); 1 27 dcl emacs_data_ptr pointer; 1 28 1 29 /* emacs_data information structure. */ 1 30 declare 1 emacs_data aligned based (emacs_data_ptr), 1 31 2 next_invocation pointer initial (null ()), /* invoc list */ 1 32 2 prev_invocation pointer initial (null ()), 1 33 2 frame_ptr pointer initial (null ()), /* cur emx frame */ 1 34 2 myname character (32) initial (""), /* emacs name */ 1 35 2 env_name character (32) initial (""), /* .sv.lisp name */ 1 36 2 log_name character (32) initial (""), /* for write_log */ 1 37 2 info_ptr pointer init (null ()), /* emacs_ ip */ 1 38 2 status_code fixed bin (35) init (0), /* emacs_ code */ 1 39 2 output_iocb pointer init (null ()), /* output IOCBP */ 1 40 2 input_iocb pointer init (null ()), /* input IOCBP */ 1 41 2 arg_list_ptr pointer init (null ()), 1 42 2 flags aligned, 1 43 3 debugging bit (1) unaligned init ("0"b),/* debugging */ 1 44 3 using_video bit (1) unaligned init ("0"b),/* use vidsys */ 1 45 3 in_emacs bit (1) unaligned init ("0"b),/* now inside */ 1 46 3 new_arguments bit (1) unaligned init ("0"b),/* have new args */ 1 47 3 using_r0_echnego 1 48 bit (1) unaligned init ("1"b), 1 49 3 netsw bit (1) unaligned init ("0"b),/* using net */ 1 50 3 messages_were_sent_here 1 51 bit (1) unal init ("0"b), 1 52 3 update_breaktable 1 53 bit (1) unal init ("1"b), /* need to upd */ 1 54 3 got_cr bit (1) unal init ("0"b), /* last char CR */ 1 55 3 turned_on_video 1 56 bit (1) unal init ("0"b), /* automatically turned on video */ 1 57 3 extended_ascii 1 58 bit (1) unal init ("0"b), /* 8-bit chars */ 1 59 3 pad2 bit (25) unaligned initial (""b), 1 60 2 arguments aligned, 1 61 3 ns bit (1) unal, /* -ns */ 1 62 3 query bit (1) unal, /* -query */ 1 63 3 reset bit (1) unal, /* -reset */ 1 64 3 task bit (1) unal, /* -task */ 1 65 3 no_task bit (1) unal, /* -no_task */ 1 66 3 destroy_task bit (1) unal, /* -destroy_task */ 1 67 3 shared_static bit (1) unal, /* -shared_static */ 1 68 3 force bit (1) unal, /* -force */ 1 69 3 ls fixed bin (17) aligned, /* -ls */ 1 70 3 pl fixed bin (17) unal, /* -pl */ 1 71 3 ll fixed bin (17) aligned, /* -ll */ 1 72 3 apply fixed bin (17) unal, /* 1+argno -ap */ 1 73 3 path_count fixed bin (17) aligned, /* # of paths */ 1 74 3 ttp character (168) unaligned, /* -ttp given */ 1 75 3 first_path pointer, /* ptr to chain */ 1 76 2 tasking aligned, 1 77 3 task_flags aligned, 1 78 4 in_task bit (1) unaligned initial ("0"b), 1 79 /* tasking on */ 1 80 4 destroy bit (1) unaligned initial ("0"b), 1 81 /* self destruct */ 1 82 4 pad1 bit (34) unaligned initial (""b), 1 83 3 task_id bit (36) aligned initial (""b), 1 84 /* task ID */ 1 85 3 saved_cl_intermediary 1 86 entry, /* old CLI */ 1 87 3 return_label label, /* for -dtk */ 1 88 2 interrupts aligned, 1 89 3 head pointer init (null ()), /* of intp chain */ 1 90 3 tail pointer init (null ()), /* of intp chain */ 1 91 3 array (0:1) fixed bin init ((2) 0), /* lisp/pl1 com */ 1 92 2 terminal_type character (256) init (""), /* saved ttp */ 1 93 2 tty_modes character (512) init (""), /* orig ttymodes */ 1 94 2 linel fixed bin (17) aligned, /* orig linel */ 1 95 2 ttyx fixed bin (17) aligned, /* tty index */ 1 96 2 netx fixed bin (35), /* net index */ 1 97 2 wnetx fixed bin (35), 1 98 2 chars_in_obuf fixed bin (21) init (0), /* to be dumped */ 1 99 2 echoed fixed bin (21) init (0), /* alrdy echoed */ 1 100 2 cgot fixed bin (21) init (0), /* echnego got */ 1 101 2 ctook fixed bin (21) init (0), /* took from buf */ 1 102 2 edir character (168) init (""), /* emacs dir */ 1 103 2 ledir character (168) init (""), /* e log dir */ 1 104 2 breaktable (0:255) bit (1) unal init ((256) (1)"1"b), 1 105 2 first_msgp pointer init (null ()), 1 106 2 last_msgp pointer init (null ()), 1 107 2 ibufptr pointer init (null ()), 1 108 2 obufptr pointer init (null ()), 1 109 2 ospeed fixed binary init (0), 1 110 2 level_ptr pointer init (null ()); 1 111 1 112 /* Pathname (for arguments.path, arguments.macro) structure. */ 1 113 dcl 1 path aligned based, 1 114 2 next_path pointer, 1 115 2 type fixed bin, 1 116 2 name character (168); 1 117 1 118 /* Types of paths. */ 1 119 dcl MACRO_PATH fixed bin initial (0); 1 120 dcl FIND_PATH fixed bin initial (1); 1 121 1 122 dcl 1 level_info aligned based, /* describes a level of recursion */ 1 123 2 prev_level pointer, 1 124 2 tty_modes character (256) unaligned, 1 125 2 n_used fixed binary, 1 126 2 n_allocated fixed binary, 1 127 2 segment_ptrs (n_to_allocate refer (level_info.n_allocated)) pointer; 1 128 1 129 /* END INCLUDE FILE emacs_data.incl.pl1 */ 293 2 1 /* BEGIN INCLUDE FILE ..... iocb.incl.pl1 ..... 13 Feb 1975, M. Asherman */ 2 2 /* Modified 11/29/82 by S. Krupp to add new entries and to change 2 3* version number to IOX2. */ 2 4 /* format: style2 */ 2 5 2 6 dcl 1 iocb aligned based, /* I/O control block. */ 2 7 2 version character (4) aligned, /* IOX2 */ 2 8 2 name char (32), /* I/O name of this block. */ 2 9 2 actual_iocb_ptr ptr, /* IOCB ultimately SYNed to. */ 2 10 2 attach_descrip_ptr ptr, /* Ptr to printable attach description. */ 2 11 2 attach_data_ptr ptr, /* Ptr to attach data structure. */ 2 12 2 open_descrip_ptr ptr, /* Ptr to printable open description. */ 2 13 2 open_data_ptr ptr, /* Ptr to open data structure (old SDB). */ 2 14 2 reserved bit (72), /* Reserved for future use. */ 2 15 2 detach_iocb entry (ptr, fixed (35)),/* detach_iocb(p,s) */ 2 16 2 open entry (ptr, fixed, bit (1) aligned, fixed (35)), 2 17 /* open(p,mode,not_used,s) */ 2 18 2 close entry (ptr, fixed (35)),/* close(p,s) */ 2 19 2 get_line entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 2 20 /* get_line(p,bufptr,buflen,actlen,s) */ 2 21 2 get_chars entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 2 22 /* get_chars(p,bufptr,buflen,actlen,s) */ 2 23 2 put_chars entry (ptr, ptr, fixed (21), fixed (35)), 2 24 /* put_chars(p,bufptr,buflen,s) */ 2 25 2 modes entry (ptr, char (*), char (*), fixed (35)), 2 26 /* modes(p,newmode,oldmode,s) */ 2 27 2 position entry (ptr, fixed, fixed (21), fixed (35)), 2 28 /* position(p,u1,u2,s) */ 2 29 2 control entry (ptr, char (*), ptr, fixed (35)), 2 30 /* control(p,order,infptr,s) */ 2 31 2 read_record entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 2 32 /* read_record(p,bufptr,buflen,actlen,s) */ 2 33 2 write_record entry (ptr, ptr, fixed (21), fixed (35)), 2 34 /* write_record(p,bufptr,buflen,s) */ 2 35 2 rewrite_record entry (ptr, ptr, fixed (21), fixed (35)), 2 36 /* rewrite_record(p,bufptr,buflen,s) */ 2 37 2 delete_record entry (ptr, fixed (35)),/* delete_record(p,s) */ 2 38 2 seek_key entry (ptr, char (256) varying, fixed (21), fixed (35)), 2 39 /* seek_key(p,key,len,s) */ 2 40 2 read_key entry (ptr, char (256) varying, fixed (21), fixed (35)), 2 41 /* read_key(p,key,len,s) */ 2 42 2 read_length entry (ptr, fixed (21), fixed (35)), 2 43 /* read_length(p,len,s) */ 2 44 2 open_file entry (ptr, fixed bin, char (*), bit (1) aligned, fixed bin (35)), 2 45 /* open_file(p,mode,desc,not_used,s) */ 2 46 2 close_file entry (ptr, char (*), fixed bin (35)), 2 47 /* close_file(p,desc,s) */ 2 48 2 detach entry (ptr, char (*), fixed bin (35)); 2 49 /* detach(p,desc,s) */ 2 50 2 51 declare iox_$iocb_version_sentinel 2 52 character (4) aligned external static; 2 53 2 54 /* END INCLUDE FILE ..... iocb.incl.pl1 ..... */ 294 3 1 /* --------------- BEGIN include file iox_dcls.incl.pl1 --------------- */ 3 2 3 3 /* Written 05/04/78 by C. D. Tavares */ 3 4 /* Fixed declaration of iox_$find_iocb_n 05/07/80 by R. Holmstedt */ 3 5 /* Modified 5/83 by S. Krupp to add declarations for: iox_$open_file, 3 6* iox_$close_file, iox_$detach and iox_$attach_loud entries. */ 3 7 3 8 dcl iox_$attach_name entry (char (*), pointer, char (*), pointer, fixed bin (35)), 3 9 iox_$attach_ptr entry (pointer, char (*), pointer, fixed bin (35)), 3 10 iox_$close entry (pointer, fixed bin (35)), 3 11 iox_$control entry (pointer, char (*), pointer, fixed bin (35)), 3 12 iox_$delete_record entry (pointer, fixed bin (35)), 3 13 iox_$destroy_iocb entry (pointer, fixed bin (35)), 3 14 iox_$detach_iocb entry (pointer, fixed bin (35)), 3 15 iox_$err_not_attached entry options (variable), 3 16 iox_$err_not_closed entry options (variable), 3 17 iox_$err_no_operation entry options (variable), 3 18 iox_$err_not_open entry options (variable), 3 19 iox_$find_iocb entry (char (*), pointer, fixed bin (35)), 3 20 iox_$find_iocb_n entry (fixed bin, ptr, fixed bin(35)), 3 21 iox_$get_chars entry (pointer, pointer, fixed bin (21), fixed bin (21), fixed bin (35)), 3 22 iox_$get_line entry (pointer, pointer, fixed bin (21), fixed bin (21), fixed bin (35)), 3 23 iox_$look_iocb entry (char (*), pointer, fixed bin (35)), 3 24 iox_$modes entry (pointer, char (*), char (*), fixed bin (35)), 3 25 iox_$move_attach entry (pointer, pointer, fixed bin (35)), 3 26 iox_$open entry (pointer, fixed bin, bit (1) aligned, fixed bin (35)), 3 27 iox_$position entry (pointer, fixed bin, fixed bin (21), fixed bin (35)), 3 28 iox_$propagate entry (pointer), 3 29 iox_$put_chars entry (pointer, pointer, fixed bin (21), fixed bin (35)), 3 30 iox_$read_key entry (pointer, char (256) varying, fixed bin (21), fixed bin (35)), 3 31 iox_$read_length entry (pointer, fixed bin (21), fixed bin (35)), 3 32 iox_$read_record entry (pointer, pointer, fixed bin (21), fixed bin (21), fixed bin (35)), 3 33 iox_$rewrite_record entry (pointer, pointer, fixed bin (21), fixed bin (35)), 3 34 iox_$seek_key entry (pointer, char (256) varying, fixed bin (21), fixed bin (35)), 3 35 iox_$write_record entry (pointer, pointer, fixed bin (21), fixed bin (35)), 3 36 iox_$open_file entry(ptr, fixed bin, char(*), bit(1) aligned, fixed bin(35)), 3 37 iox_$close_file entry(ptr, char(*), fixed bin(35)), 3 38 iox_$detach entry(ptr, char(*), fixed bin(35)), 3 39 iox_$attach_loud entry(ptr, char(*), ptr, fixed bin(35)); 3 40 3 41 dcl (iox_$user_output, 3 42 iox_$user_input, 3 43 iox_$user_io, 3 44 iox_$error_output) external static pointer; 3 45 3 46 /* ---------------- END include file iox_dcls.incl.pl1 ---------------- */ 295 4 1 /* BEGIN INCLUDE FILE ... line_types.incl.pl1 */ 4 2 4 3 /* Written November 10 1975 by Paul Green */ 4 4 /* Modified October 1978 by Larry Johnson to include line_type_names */ 4 5 /* Modified 12/19/78 by J. Stern to add POLLED_VIP line type */ 4 6 /* Modified 9/27/79 by J. Stern to add X25LAP line type */ 4 7 /* Modified Spring 1981 by Charles Hornig to add HDLC line type */ 4 8 /* Modified May 1981 by Robert Coren to add COLTS line type */ 4 9 /* Modified September 1984 by Robert Coren to correctly count VIP as a synchronous line type */ 4 10 4 11 4 12 /****^ HISTORY COMMENTS: 4 13* 1) change(86-02-25,Negaret), approve(87-07-13,MCR7679), 4 14* audit(87-07-16,Brunelle), install(87-08-04,MR12.1-1056): 4 15* Add a DSA line type. 4 16* 2) change(87-03-17,Beattie), approve(87-07-13,MCR7656), 4 17* audit(87-07-16,Brunelle), install(87-08-04,MR12.1-1056): 4 18* Add HASP_OPR to identify HASP workstation consoles with login service. 4 19* END HISTORY COMMENTS */ 4 20 4 21 4 22 declare (LINE_MC initial (-2), 4 23 LINE_TELNET initial (-1), 4 24 LINE_UNKNOWN initial (0), 4 25 LINE_ASCII initial (1), 4 26 LINE_1050 initial (2), 4 27 LINE_2741 initial (3), 4 28 LINE_ARDS initial (4), 4 29 LINE_SYNCH initial (5), 4 30 LINE_G115 initial (6), 4 31 LINE_BSC initial (7), 4 32 LINE_ETX initial (8), 4 33 LINE_VIP initial (9), 4 34 LINE_ASYNC1 initial (10), 4 35 LINE_ASYNC2 initial (11), 4 36 LINE_ASYNC3 initial (12), 4 37 LINE_SYNC1 initial (13), 4 38 LINE_SYNC2 initial (14), 4 39 LINE_SYNC3 initial (15), 4 40 LINE_POLLED_VIP initial (16), 4 41 LINE_X25LAP initial (17), 4 42 LINE_HDLC initial (18), 4 43 LINE_COLTS initial (19), 4 44 LINE_DSA initial (20), 4 45 LINE_HASP_OPR initial (21) 4 46 ) fixed bin internal static options (constant); 4 47 4 48 dcl max_line_type fixed bin int static options (constant) init (21); 4 49 4 50 declare n_sync_line_types fixed bin int static options (constant) init (10); 4 51 4 52 declare sync_line_type (10) fixed bin int static options (constant) init (5, 6, 7, 9, 13, 14, 15, 16, 17, 18); 4 53 4 54 dcl line_types (-2:21) char (16) int static options (constant) init ( 4 55 "MC", /* -2 */ 4 56 "TELNET", /* -1 */ 4 57 "none", /* 0 */ 4 58 "ASCII", /* 1 */ 4 59 "1050", /* 2 */ 4 60 "2741", /* 3 */ 4 61 "ARDS", /* 4 */ 4 62 "Sync", /* 5 */ 4 63 "G115", /* 6 */ 4 64 "BSC", /* 7 */ 4 65 "202ETX", /* 8 */ 4 66 "VIP", /* 9 */ 4 67 "ASYNC1", /* 10 */ 4 68 "ASYNC2", /* 11 */ 4 69 "ASYNC3", /* 12 */ 4 70 "SYNC1", /* 13 */ 4 71 "SYNC2", /* 14 */ 4 72 "SYNC3", /* 15 */ 4 73 "POLLED_VIP", /* 16 */ 4 74 "X25LAP", /* 17 */ 4 75 "HDLC", /* 18 */ 4 76 "COLTS", /* 19 */ 4 77 "DSA", /* 20 */ 4 78 "HASP_OPR"); /* 21 */ 4 79 4 80 /* END INCLUDE FILE ... line_types.incl.pl1 */ 296 5 1 /* BEGIN INCLUDE FILE mcs_echo_neg.incl.pl1 Bernard Greenberg 1/20/79 */ 5 2 5 3 5 4 5 5 /****^ HISTORY COMMENTS: 5 6* 1) change(86-04-23,Coren), approve(86-04-23,MCR7300), 5 7* audit(86-05-19,Beattie), install(86-07-08,MR12.0-1089): 5 8* Changed version to 2, increased size of break table, 5 9* included named constant for break table size. 5 10* END HISTORY COMMENTS */ 5 11 5 12 5 13 /* This include file defines the callable entrypoints and argument data 5 14* structures for ring 0 echo negotiation */ 5 15 5 16 /* format: style2,linecom,^indnoniterdo,indcomtxt,^inditerdo,dclind5,idind25 */ 5 17 dcl echo_neg_datap ptr; 5 18 dcl echo_neg_data_version_2 fixed bin static options (constant) init (2); 5 19 dcl ECHO_NEG_BREAK_TABLE_SIZE 5 20 fixed bin internal static options (constant) init (255); 5 21 5 22 dcl 1 echo_neg_data based (echo_neg_datap) aligned, 5 23 /* Echo negotiation data */ 5 24 2 version fixed bin, 5 25 2 break (0:255) bit (1) unaligned, 5 26 /* Break table, 1 = break */ 5 27 2 pad bit (7) unaligned, 5 28 2 rubout_trigger_chars (2) unaligned, /* Characters that cause rubout action */ 5 29 3 char char (1) unaligned, 5 30 2 rubout_sequence_length 5 31 fixed bin (4) unsigned unaligned, 5 32 /* Length of rubout sequence, output */ 5 33 2 rubout_pad_count fixed bin (4) unsigned unaligned, 5 34 /* Count of pads needed */ 5 35 2 buffer_rubouts bit (1) unaligned, /* 1 = put rubouts and rubbed out in buffer */ 5 36 2 rubout_sequence char (12) unaligned; /* Actual rubout sequence */ 5 37 5 38 /*** VERSION 1 STRUCTURE DECLARATION FOR COMPATIBILITY (TO BE REMOVED FOR MR12) ***/ 5 39 5 40 dcl echo_neg_data_version_1 fixed bin static options (constant) init (1); 5 41 5 42 dcl 1 v1_echo_neg_data based (echo_neg_datap) aligned, 5 43 /* Echo negotiation data */ 5 44 2 version fixed bin, 5 45 2 break (0:127) bit (1) unaligned, 5 46 /* Break table, 1 = break */ 5 47 2 pad bit (7) unaligned, 5 48 2 rubout_trigger_chars (2) unaligned, /* Characters that cause rubout action */ 5 49 3 char char (1) unaligned, 5 50 2 rubout_sequence_length 5 51 fixed bin (4) unsigned unaligned, 5 52 /* Length of rubout sequence, output */ 5 53 2 rubout_pad_count fixed bin (4) unsigned unaligned, 5 54 /* Count of pads needed */ 5 55 2 buffer_rubouts bit (1) unaligned, /* 1 = put rubouts and rubbed out in buffer */ 5 56 2 rubout_sequence char (12) unaligned; /* Actual rubout sequence */ 5 57 /*** END VERSION 1 STRUCTURE ****/ 5 58 5 59 dcl ( 5 60 hcs_$tty_read_echoed, 5 61 hcs_$echo_negotiate_get_chars 5 62 ) entry (fixed bin, ptr, fixed bin (21), fixed bin (21), fixed bin (21), fixed bin (21), 5 63 fixed bin, fixed bin, fixed bin (35)); 5 64 /* 5 65* call hcs_$echo_negotiate_get_chars 5 66* (devx, datap, offset, nelem, NRETURNED, NECHOED_RETURNED, screen_left, STATE, CODE); 5 67* */ 5 68 5 69 /* END INCLUDE FILE mcs_echo_neg.incl.pl1 */ 297 6 1 /* BEGIN INCLUDE FILE mode_string_info.incl.pl1 */ 6 2 6 3 /* Structure for parse_mode_string_ JRDavis 20 October 1980 6 4* Last modified 12 January 1981 by J. Spencer Love for version 2, make char_value varying string */ 6 5 6 6 declare mode_value_ptr ptr, 6 7 number_of_modes fixed bin; 6 8 6 9 declare 1 mode_string_info aligned based (mode_string_info_ptr), 6 10 2 version fixed bin, 6 11 2 number fixed bin, 6 12 2 modes (number_of_modes refer (mode_string_info.number)) like mode_value; 6 13 6 14 declare mode_string_info_ptr ptr; 6 15 6 16 declare 1 mode_value aligned based (mode_value_ptr), 6 17 2 version fixed bin, 6 18 2 mode_name char (32) unaligned, 6 19 2 flags, 6 20 3 boolean_valuep bit (1) unaligned, 6 21 3 numeric_valuep bit (1) unaligned, 6 22 3 char_valuep bit (1) unaligned, 6 23 3 boolean_value bit (1) unaligned, 6 24 3 pad1 bit (32) unaligned, 6 25 2 numeric_value fixed bin (35), 6 26 2 char_value char (32) varying, 6 27 2 code fixed bin (35), 6 28 2 pad2 bit (36); 6 29 6 30 declare mode_string_info_version_2 fixed bin static options (constant) initial (2), 6 31 mode_value_version_3 fixed bin static options (constant) initial (3); 6 32 6 33 /* END INCLUDE FILE mode_string_info.incl.pl1 */ 298 7 1 /* BEGIN INCLUDE FILE ... net_event_message.incl.pl1 */ 7 2 7 3 /****^ HISTORY COMMENTS: 7 4* 1) change(86-07-30,Kissel), approve(86-07-30,MCR7475), audit(86-08-04,Coren), 7 5* install(86-10-09,MR12.0-1181): 7 6* This include file was formerly tty_event_message.incl.pl1. It has been 7 7* updated with different fields and new constants, and renamed to 7 8* net_event_message.incl.pl1 7 9* 2) change(87-04-20,GDixon), approve(87-07-13,MCR7694), 7 10* audit(87-06-24,Hartogs), install(87-08-04,MR12.1-1056): 7 11* Add NETWORK_TYPE_VALUES array. 7 12* END HISTORY COMMENTS */ 7 13 7 14 /* describes event message passed with wakeups from the tty DIM */ 7 15 /* Created 5/24/76 by Robert S. Coren */ 7 16 7 17 /* format: style3,linecom,ifthenstmt,indthenelse,^indnoniterdo,indnoniterend,initcol3,dclind5,idind32 */ 7 18 7 19 dcl net_event_message_arg fixed bin (71); /* For calling IPC */ 7 20 dcl NET_EVENT_MESSAGE_VERSION_1 bit (2) internal static options (constant) init ("10"b); 7 21 7 22 dcl 1 net_event_message aligned based (addr (net_event_message_arg)), 7 23 2 version bit (2) unaligned, /* Currently version 1 */ 7 24 2 reason bit (16) unaligned, /* Additional info about the event */ 7 25 2 pad bit (6) unaligned, /* Must be zero */ 7 26 2 network_type fixed bin (4) unsigned unaligned, 7 27 /* See below for constants */ 7 28 2 type fixed bin (8) unsigned unaligned, 7 29 /* Type of interrupt, see below */ 7 30 2 handle fixed bin (35) aligned;/* Caller's handle (devx for MCS, handle for DSA) */ 7 31 7 32 /* Network type constants */ 7 33 7 34 dcl MCS_NETWORK_TYPE fixed bin (4) unsigned internal static options (constant) init (0); 7 35 dcl DSA_NETWORK_TYPE fixed bin (4) unsigned internal static options (constant) init (1); 7 36 dcl MOWSE_NETWORK_TYPE fixed bin (4) unsigned internal static options (constant) init (2); 7 37 7 38 dcl NETWORK_TYPE_VALUES (0:2) char(8) varying int static options(constant) init( 7 39 "MCS", 7 40 "DSA", 7 41 "MOWSE"); 7 42 7 43 7 44 /* MCS event message type constants */ 7 45 7 46 dcl MAX_MCS_EVENT_MSG_TYPE fixed bin internal static options (constant) init (8); 7 47 7 48 dcl MCS_UNSPECIFIED_MSG fixed bin internal static options (constant) init (0); 7 49 /* used for "start" order, etc. */ 7 50 dcl MCS_DIALUP_MSG fixed bin internal static options (constant) init (1); 7 51 /* dialup */ 7 52 dcl MCS_HANGUP_MSG fixed bin internal static options (constant) init (2); 7 53 /* hangup */ 7 54 dcl MCS_DIALOUT_MSG fixed bin internal static options (constant) init (3); 7 55 /* dialout status returned */ 7 56 dcl MCS_QUIT_MSG fixed bin internal static options (constant) init (4); 7 57 /* quit */ 7 58 dcl MCS_READ_MSG fixed bin internal static options (constant) init (5); 7 59 /* input arrived */ 7 60 dcl MCS_WRITE_MSG fixed bin internal static options (constant) init (6); 7 61 /* output completed */ 7 62 dcl MCS_LINE_STATUS_MSG fixed bin internal static options (constant) init (7); 7 63 /* control tables sent status */ 7 64 dcl MCS_MASKED_MSG fixed bin internal static options (constant) init (8); 7 65 /* channel masked by FNP */ 7 66 7 67 dcl MCS_MSG_TYPE_TO_PNAME (0:8) char (20) internal static options (constant) init ("unspecified", 7 68 /* 0 */ 7 69 "dialup", /* 1 */ 7 70 "hangup", /* 2 */ 7 71 "dialout status", /* 3 */ 7 72 "quit", /* 4 */ 7 73 "read", /* 5 */ 7 74 "write", /* 6 */ 7 75 "line status", /* 7 */ 7 76 "masked"); /* 8 */ 7 77 7 78 /* DSA event message type constants */ 7 79 7 80 dcl MAX_DSA_EVENT_MSG_TYPE fixed bin internal static options (constant) init (19); 7 81 7 82 dcl DSA_UNSPECIFIED_MSG fixed bin (8) uns internal static options (constant) init (0); 7 83 dcl DSA_ATTENTION_MSG fixed bin (8) uns internal static options (constant) init (1); 7 84 dcl DSA_DATA_ATTENTION_MSG fixed bin (8) uns internal static options (constant) init (2); 7 85 dcl DSA_DEMAND_RELEASE_SRU_MSG fixed bin (8) uns internal static options (constant) init (3); 7 86 dcl DSA_DEMAND_TURN_MSG fixed bin (8) uns internal static options (constant) init (4); 7 87 dcl DSA_DEMAND_TURN_ACK_MSG fixed bin (8) uns internal static options (constant) init (5); 7 88 dcl DSA_PURGE_MSG fixed bin (8) uns internal static options (constant) init (6); 7 89 dcl DSA_RECOVER_MSG fixed bin (8) uns internal static options (constant) init (7); 7 90 dcl DSA_RECOVER_ACK_MSG fixed bin (8) uns internal static options (constant) init (8); 7 91 dcl DSA_RELEASE_SRU_MSG fixed bin (8) uns internal static options (constant) init (9); 7 92 dcl DSA_RESUME_MSG fixed bin (8) uns internal static options (constant) init (10); 7 93 dcl DSA_RESUME_ACK_MSG fixed bin (8) uns internal static options (constant) init (11); 7 94 dcl DSA_SUSPEND_MSG fixed bin (8) uns internal static options (constant) init (12); 7 95 dcl DSA_SUSPEND_ACK_MSG fixed bin (8) uns internal static options (constant) init (13); 7 96 dcl DSA_TERM_ABNORMAL_MSG fixed bin (8) uns internal static options (constant) init (14); 7 97 dcl DSA_ESTABLISHMENT_MSG fixed bin (8) uns internal static options (constant) init (15); 7 98 dcl DSA_TERMINATED_MSG fixed bin (8) uns internal static options (constant) init (16); 7 99 dcl DSA_USER_UNASSIGN_MSG fixed bin (8) uns internal static options (constant) init (17); 7 100 dcl DSA_DATA_INPUT_MSG fixed bin (8) uns internal static options (constant) init (18); 7 101 dcl DSA_DATA_OUTPUT_MSG fixed bin (8) uns internal static options (constant) init (19); 7 102 7 103 dcl DSA_MSG_TYPE_TO_PNAME (0:19) char (20) internal static options (constant) init ("unspecified", 7 104 /* 0 */ 7 105 "attention", /* 1 */ 7 106 "data_attention", /* 2 */ 7 107 "demand_release_sru", /* 3 */ 7 108 "demand_turn", /* 4 */ 7 109 "demand_turn_ack", /* 5 */ 7 110 "purge", /* 6 */ 7 111 "recover", /* 7 */ 7 112 "recover_ack", /* 8 */ 7 113 "release_sru", /* 9 */ 7 114 "resume", /* 10 */ 7 115 "resume_ack", /* 11 */ 7 116 "suspend", /* 12 */ 7 117 "suspend_ack", /* 13 */ 7 118 "terminate_abnormal", /* 14 */ 7 119 "establishment", /* 15 */ 7 120 "terminated", /* 16 */ 7 121 "user_unassign", /* 17 */ 7 122 "data input", /* 18 */ 7 123 "data output"); /* 19 */ 7 124 7 125 /* END INCLUDE FILE ... net_event_message.incl.pl1 */ 299 8 1 /* BEGIN INCLUDE FILE ... object_info.incl.pl1 8 2*coded February 8, 1972 by Michael J. Spier */ 8 3 /* modified May 26, 1972 by M. Weaver */ 8 4 /* modified 15 April, 1975 by M. Weaver */ 8 5 8 6 declare 1 object_info aligned based, /* structure containing object info based, returned by object_info_ */ 8 7 2 version_number fixed bin, /* version number of current structure format (=2) */ 8 8 2 textp pointer, /* pointer to beginning of text section */ 8 9 2 defp pointer, /* pointer to beginning of definition section */ 8 10 2 linkp pointer, /* pointer to beginning of linkage section */ 8 11 2 statp pointer, /* pointer to beginning of static section */ 8 12 2 symbp pointer, /* pointer to beginning of symbol section */ 8 13 2 bmapp pointer, /* pointer to beginning of break map (may be null) */ 8 14 2 tlng fixed bin, /* length in words of text section */ 8 15 2 dlng fixed bin, /* length in words of definition section */ 8 16 2 llng fixed bin, /* length in words of linkage section */ 8 17 2 ilng fixed bin, /* length in words of static section */ 8 18 2 slng fixed bin, /* length in words of symbol section */ 8 19 2 blng fixed bin, /* length in words of break map */ 8 20 2 format, /* word containing bit flags about object type */ 8 21 3 old_format bit(1) unaligned, /* on if segment isn't in new format, i.e. has old style object map */ 8 22 3 bound bit(1) unaligned, /* on if segment is bound */ 8 23 3 relocatable bit(1) unaligned, /* on if seg has relocation info in its first symbol block */ 8 24 3 procedure bit(1) unaligned, /* on if segment is an executable object program */ 8 25 3 standard bit(1) unaligned, /* on if seg is in standard format (more than just standard map) */ 8 26 3 gate bit(1) unaligned, /* on if segment is a gate */ 8 27 3 separate_static bit(1) unaligned, /* on if static not in linkage */ 8 28 3 links_in_text bit(1) unaligned, /* on if there are threaded links in text */ 8 29 3 perprocess_static bit (1) unaligned, /* on if static is not to be per run unit */ 8 30 3 pad bit(27) unaligned, 8 31 2 entry_bound fixed bin, /* entry bound if segment is a gate */ 8 32 2 textlinkp pointer, /* ptr to first link in text */ 8 33 8 34 /* LIMIT OF BRIEF STRUCTURE */ 8 35 8 36 2 compiler char(8) aligned, /* name of processor which generated segment */ 8 37 2 compile_time fixed bin(71), /* clock reading of date/time object was generated */ 8 38 2 userid char(32) aligned, /* standard Multics id of creator of object segment */ 8 39 2 cvers aligned, /* generator version name in printable char string form */ 8 40 3 offset bit(18) unaligned, /* offset of name in words relative to base of symbol section */ 8 41 3 length bit(18) unaligned, /* length of name in characters */ 8 42 2 comment aligned, /* printable comment concerning generator or generation of segment */ 8 43 3 offset bit(18) unaligned, /* offset of comment in words relative to base of symbol section */ 8 44 3 length bit(18) unaligned, /* length of comment in characters */ 8 45 2 source_map fixed bin, /* offset, relative to base of symbol section, of source map structure */ 8 46 8 47 /* LIMIT OF DISPLAY STRUCTURE */ 8 48 8 49 2 rel_text pointer, /* pointer to text section relocation info */ 8 50 2 rel_def pointer, /* pointer to definition section relocation info */ 8 51 2 rel_link pointer, /* pointer to linkage section relocation info */ 8 52 2 rel_static pointer, /* pointer to static section relocation info */ 8 53 2 rel_symbol pointer, /* pointer to symbol section relocation info */ 8 54 2 text_boundary fixed bin, /* specifies mod of text section base boundary */ 8 55 2 static_boundary fixed bin, /* specifies mod of internal static base boundary */ 8 56 /* currently not used by system */ 8 57 2 default_truncate fixed bin, /* offset rel to symbp for binder to automatically trunc. symb sect. */ 8 58 2 optional_truncate fixed bin; /* offset rel to symbp for binder to optionally trunc. symb sect. */ 8 59 8 60 declare object_info_version_2 fixed bin int static init(2); 8 61 8 62 /* END INCLUDE FILE ... object_info.incl.pl1 */ 300 9 1 /* BEGIN INCLUDE FiLE ... terminal_info.incl.pl1 */ 9 2 9 3 /* Created 5/25/77 by J. Stern */ 9 4 9 5 9 6 dcl 1 terminal_info aligned based (terminal_info_ptr), /* info structure for terminal_info order */ 9 7 2 version fixed bin, /* version number of this sturcture */ 9 8 2 id char (4) unaligned, /* terminal id from answerback */ 9 9 2 term_type char (32) unaligned, /* terminal type name */ 9 10 2 line_type fixed bin, /* line type number */ 9 11 2 baud_rate fixed bin, 9 12 2 reserved (4) fixed bin; /* reserved for future use */ 9 13 9 14 9 15 dcl terminal_info_ptr ptr; 9 16 dcl terminal_info_version fixed bin int static options (constant) init (1); /* current version */ 9 17 9 18 9 19 /* END INCLUDE FILE ... terminal_info.incl.pl1 */ 301 10 1 /* BEGIN INCLUDE FILE ... tty_convert.incl.pl1 */ 10 2 10 3 /* tty_ conversion tables */ 10 4 /* Created 11/3/75 by Robert S. Coren */ 10 5 /* Info structures added 5/19/77 by Robert S. Coren */ 10 6 /* Length of cv_trans changed from 128 to 256 05/03/78 by Robert Coren */ 10 7 /* conversion table mnemonics added JRDavis 21 Aug 80 */ 10 8 /* fix special_chars_struc to have good refers Fri 13 Feb 81 JRDavis */ 10 9 10 10 10 11 /****^ HISTORY COMMENTS: 10 12* 1) change(85-12-01,Negaret), approve(87-07-23,MCR7742), 10 13* audit(87-07-23,GDixon), install(87-08-04,MR12.1-1056): 10 14* Added INPUT_CONVERT_DSA_CR_PROCESSING constant. 10 15* 2) change(88-01-22,Brunelle), approve(88-01-22,MCR7813), 10 16* audit(88-10-05,Blair), install(88-10-17,MR12.2-1171): 10 17* Expand c_chars definition from 3 chars to 15. Change SPECIAL_VERSION 10 18* from 1 to 2. Add version variable to get_special_info_struc and define 10 19* SPECIAL_INFO_STRUCT_VERSION_1. 10 20* END HISTORY COMMENTS */ 10 21 10 22 10 23 /* format: style2,linecom,^indnoniterdo,indcomtxt,^inditerdo,dclind5,idind25 */ 10 24 10 25 10 26 dcl 1 special_chars aligned based, /* table of special character sequences */ 10 27 2 nl_seq aligned like c_chars, /* new-line sequence */ 10 28 2 cr_seq aligned like c_chars, /* carriage-return sequence */ 10 29 2 bs_seq aligned like c_chars, /* backspace sequence */ 10 30 2 tab_seq aligned like c_chars, /* horizontal tab sequence */ 10 31 2 vt_seq aligned like c_chars, /* vertical tab sequence */ 10 32 2 ff_seq aligned like c_chars, /* form-feed sequence */ 10 33 2 printer_on aligned like c_chars, /* printer-on sequence */ 10 34 2 printer_off aligned like c_chars, /* printer_off sequence */ 10 35 2 red_ribbon_shift aligned like c_chars, /* red ribbon shift sequence */ 10 36 2 black_ribbon_shift aligned like c_chars, /* black ribbon shift sequence */ 10 37 2 end_of_page aligned like c_chars, /* end-of-page warning sequence */ 10 38 2 escape_length fixed bin, /* number of escape sequences */ 10 39 2 not_edited_escapes (sc_escape_len refer (special_chars.escape_length)) like c_chars, 10 40 /* use in ^edited mode */ 10 41 2 edited_escapes (sc_escape_len refer (special_chars.escape_length)) like c_chars, 10 42 /* use in edited mode */ 10 43 2 input_escapes aligned, 10 44 3 len fixed bin (8) unaligned, /* length of string */ 10 45 3 str char (sc_input_escape_len refer (special_chars.input_escapes.len)) unaligned, 10 46 /* escape sequence characters */ 10 47 2 input_results aligned, 10 48 3 pad bit (9) unaligned, /* so that strings will look the same */ 10 49 3 str char (sc_input_escape_len refer (special_chars.input_escapes.len)) unaligned; 10 50 /* results of escape sequences */ 10 51 10 52 10 53 dcl c_chars_ptr ptr; 10 54 dcl 1 c_chars based (c_chars_ptr) aligned, 10 55 2 count fixed bin (8) unaligned, 10 56 2 chars (15) char (1) unaligned; 10 57 10 58 dcl sc_escape_len fixed bin; /* count of output escapes to allocate in special_chars */ 10 59 dcl sc_input_escape_len fixed bin; /* count of input escapes to allocate in special_chars */ 10 60 10 61 10 62 dcl 1 cv_trans based aligned, /* conversion/translation table format */ 10 63 2 value (0:255) fixed bin (8) unal; 10 64 10 65 10 66 dcl 1 delay based aligned, /* delay counts for output */ 10 67 2 vert_nl fixed bin, 10 68 2 horz_nl float bin, 10 69 2 const_tab fixed bin, 10 70 2 var_tab float bin, 10 71 2 backspace fixed bin, 10 72 2 vt_ff fixed bin; 10 73 10 74 /* info structures used with orders */ 10 75 10 76 dcl 1 special_chars_struc aligned based, 10 77 2 version fixed bin, 10 78 2 default fixed bin, /* non-zero indicates use default */ 10 79 2 special_chars, /* same as level-1 above */ 10 80 /* has to be spelled out instead of using like */ 10 81 /* because of refer options */ 10 82 3 nl_seq aligned like c_chars, /* new-line sequence */ 10 83 3 cr_seq aligned like c_chars, /* carriage-return sequence */ 10 84 3 bs_seq aligned like c_chars, /* backspace sequence */ 10 85 3 tab_seq aligned like c_chars, /* horizontal tab sequence */ 10 86 3 vt_seq aligned like c_chars, /* vertical tab sequence */ 10 87 3 ff_seq aligned like c_chars, /* form-feed sequence */ 10 88 3 printer_on aligned like c_chars, /* printer-on sequence */ 10 89 3 printer_off aligned like c_chars, /* printer_off sequence */ 10 90 3 red_ribbon_shift aligned like c_chars, /* red ribbon shift sequence */ 10 91 3 black_ribbon_shift aligned like c_chars, /* black ribbon shift sequence */ 10 92 3 end_of_page aligned like c_chars, /* end-of-page warning sequence */ 10 93 3 escape_length fixed bin, /* number of escape sequences */ 10 94 3 not_edited_escapes (sc_escape_len refer (special_chars_struc.escape_length)) like c_chars, 10 95 /* use in ^edited mode */ 10 96 3 edited_escapes (sc_escape_len refer (special_chars_struc.escape_length)) like c_chars, 10 97 /* use in edited mode */ 10 98 3 input_escapes aligned, 10 99 4 len fixed bin (8) unaligned, /* length of string */ 10 100 4 str char (sc_input_escape_len refer (special_chars_struc.input_escapes.len)) unaligned, 10 101 /* escape sequence characters */ 10 102 3 input_results aligned, 10 103 4 pad bit (9) unaligned, /* so that strings will look the same */ 10 104 4 str char (sc_input_escape_len refer (special_chars_struc.input_escapes.len)) unaligned; 10 105 /* results of escape sequences */ 10 106 10 107 dcl 1 cv_trans_struc aligned based, /* all conversion/translation tables */ 10 108 2 version fixed bin, 10 109 2 default fixed bin, /* as above */ 10 110 2 cv_trans like cv_trans; 10 111 10 112 dcl 1 delay_struc aligned based, 10 113 2 version fixed bin, 10 114 2 default fixed bin, /* as above */ 10 115 2 delay like delay; 10 116 10 117 dcl 1 get_special_info_struc based aligned, /* get_special order */ 10 118 2 version char (8), 10 119 2 area_ptr pointer, 10 120 2 table_ptr pointer; 10 121 10 122 dcl SPECIAL_INFO_STRUCT_VERSION_1 10 123 char (8) int static options (constant) init ("sisv1000"); 10 124 dcl SPECIAL_VERSION fixed bin int static options (constant) init (1); 10 125 dcl SPECIAL_VERSION_2 fixed bin int static options (constant) init (2); 10 126 dcl DELAY_VERSION fixed bin int static options (constant) init (1); 10 127 dcl CV_TRANS_VERSION fixed bin int static options (constant) init (2); 10 128 10 129 dcl CV_TRANS_SIZE (2) fixed bin int static options (constant) init (127, 255); 10 130 /* indexed by version number */ 10 131 10 132 10 133 /* values for input and output conversion tables */ 10 134 10 135 dcl ( 10 136 INPUT_CONVERT_ORDINARY init (0), 10 137 INPUT_CONVERT_BREAK init (1), 10 138 INPUT_CONVERT_ESCAPE init (2), 10 139 INPUT_CONVERT_DISCARD init (3), 10 140 INPUT_CONVERT_FORMFEED init (4), 10 141 INPUT_CONVERT_PRECEDENCE_DISCARD 10 142 init (5), 10 143 INPUT_CONVERT_DSA_CR_PROCESSING 10 144 init (6) 10 145 ) fixed bin (8) unaligned internal static options (constant); 10 146 10 147 dcl ( 10 148 OUTPUT_CONVERT_ORDINARY init (0), 10 149 OUTPUT_CONVERT_NEWLINE init (1), 10 150 OUTPUT_CONVERT_CR init (2), 10 151 OUTPUT_CONVERT_HT init (3), 10 152 OUTPUT_CONVERT_BS init (4), 10 153 OUTPUT_CONVERT_VT init (5), 10 154 OUTPUT_CONVERT_FF init (6), 10 155 OUTPUT_CONVERT_OCTAL init (7), 10 156 OUTPUT_CONVERT_RRS init (8), 10 157 OUTPUT_CONVERT_BRS init (9), 10 158 OUTPUT_CONVERT_NO_MOTION init (10), 10 159 OUTPUT_CONVERT_PRECEDENCE_NO_MOTION 10 160 init (11), 10 161 OUTPUT_CONVERT_DONT_SEND init (12), 10 162 OUTPUT_CONVERT_NOT_USED_13 10 163 init (13), 10 164 OUTPUT_CONVERT_NOT_USED_14 10 165 init (14), 10 166 OUTPUT_CONVERT_NOT_USED_15 10 167 init (15), 10 168 OUTPUT_CONVERT_NOT_USED_16 10 169 init (16), 10 170 OUTPUT_CONVERT_FIRST_SPECIAL 10 171 init (17) 10 172 ) fixed bin (8) unaligned internal static options (constant); 10 173 10 174 /* END INCLUDE FILE ... tty_convert.incl.pl1 */ 302 11 1 /* BEGIN INCLUDE FILE ... tty_read_status_info.incl.pl1 11 2* 11 3* control structure for the read_status and write_status orders to tty_ 11 4* 11 5* Modified 2/1/83 by Olin Sibert to add tty_write_status_info structure in 11 6* support of lap_simplex_ MPX. 11 7**/ 11 8 11 9 11 10 /****^ HISTORY COMMENTS: 11 11* 1) change(88-07-07,Beattie), approve(88-06-27,MCR7926), 11 12* audit(88-07-22,Brunelle), install(88-08-08,MR12.2-1082): 11 13* Prepared for installation. 11 14* END HISTORY COMMENTS */ 11 15 11 16 11 17 dcl 1 tty_read_status_info aligned based (tty_read_status_info_ptr), 11 18 2 event_channel fixed bin (71), 11 19 2 input_pending bit (1); 11 20 11 21 dcl tty_read_status_info_ptr ptr; 11 22 11 23 dcl 1 tty_write_status_info aligned based (tty_write_status_info_ptr), 11 24 2 event_channel fixed bin (71), 11 25 2 output_pending bit (1); 11 26 11 27 dcl tty_write_status_info_ptr ptr; 11 28 11 29 /* END INCLUDE FILE ... tty_read_status_info.incl.pl1 */ 303 12 1 /* BEGIN INCLUDE FILE ... window_control_info.incl.pl1 JRD */ 12 2 /* format: style3 */ 12 3 12 4 /* Modified 26 January 1982 by William York to add the set_more_handler 12 5* and reset_more_handler control orders. */ 12 6 /* Modified October 1982 by WMY to add set and get_token_characters, 12 7* set and get_more_prompt. */ 12 8 /* Modified February 1983 by WMY to add the line_editor_key_binding_info 12 9* structure. */ 12 10 /* Modified 30 September 1983 by Jon A. Rochlis to add the origin.column for 12 11* partial screen width windows. */ 12 12 /* Modified 9 October 1983 by JR to add version 1 window_edit_line_info. 12 13* This should be removed when window_info.incl.pl1 is created. */ 12 14 /* Modified 29 February 1984 by Barmar to add version 1 12 15* get_editor_key_bindings_info. */ 12 16 /* Modified 1 March 1984 by Barmar to add version 1 12 17* set_editor_key_bindings_info. */ 12 18 /* Modified 2 March 1984 by Barmar to upgrade to version 3 12 19* line_editor_key_bindings_info, which includes the name, description, and 12 20* info path */ 12 21 12 22 /* structure for the set_window_info and get_window_info 12 23* control orders. */ 12 24 12 25 dcl 1 window_position_info 12 26 based (window_position_info_ptr), 12 27 2 version fixed bin, 12 28 2 origin, 12 29 3 column fixed bin, 12 30 3 line fixed bin, 12 31 2 extent, 12 32 3 width fixed bin, 12 33 3 height fixed bin; 12 34 12 35 dcl (window_position_info_version, window_position_info_version_1) 12 36 fixed bin internal static init (1) options (constant); 12 37 dcl window_position_info_ptr 12 38 pointer; 12 39 12 40 /* structure for the set_window_status and get_window_status 12 41* control orders */ 12 42 12 43 declare window_status_info_ptr 12 44 pointer; 12 45 declare 1 window_status_info 12 46 aligned based (window_status_info_ptr), 12 47 2 version fixed bin, 12 48 2 status_string bit (36) aligned; /* string (window_status) */ 12 49 /* see window_status.incl.pl1 for the contents of this string */ 12 50 12 51 12 52 declare (window_status_version, window_status_version_1) 12 53 fixed bin internal static init (1) options (constant); 12 54 12 55 /* info structure for the set_more_responses and get_more_responses control 12 56* orders */ 12 57 12 58 12 59 dcl 1 more_responses_info 12 60 aligned based (more_responses_info_ptr), 12 61 2 version fixed bin, 12 62 2 n_yeses fixed bin, /* how many valid characters in the strings below */ 12 63 2 n_noes fixed bin, 12 64 2 yeses char (32) unaligned, 12 65 2 noes char (32) unaligned; 12 66 12 67 dcl (more_responses_info_version_1, more_responses_version) 12 68 fixed bin internal static init (1) options (constant); 12 69 dcl more_responses_info_ptr 12 70 pointer; 12 71 12 72 /* structure for the set_break_table and get_break_table 12 73* control orders */ 12 74 12 75 declare break_table_ptr pointer; 12 76 declare 1 break_table_info aligned based (break_table_ptr), 12 77 2 version fixed bin, 12 78 2 breaks (0:127) bit (1) unaligned; 12 79 12 80 declare (break_table_info_version, break_table_info_version_1) 12 81 fixed bin init (1) internal static options (constant); 12 82 12 83 declare 1 more_handler_info aligned based (more_handler_info_ptr), 12 84 2 version fixed bin, 12 85 2 flags unaligned, 12 86 3 old_handler_valid 12 87 bit(1), 12 88 3 pad bit(35), 12 89 2 more_handler entry (pointer, bit(1) aligned), 12 90 2 old_more_handler entry (pointer, bit(1) aligned); 12 91 12 92 declare more_handler_info_ptr pointer; 12 93 12 94 declare (more_handler_info_version, more_handler_info_version_3) 12 95 fixed bin internal static options (constant) init (3); 12 96 12 97 declare 1 token_characters_info aligned based (token_characters_info_ptr), 12 98 2 version char(8), 12 99 2 token_character_count 12 100 fixed bin, 12 101 2 token_characters 12 102 char (128) unaligned; 12 103 12 104 declare token_characters_info_ptr pointer; 12 105 12 106 declare token_characters_info_version_1 char(8) internal static options (constant) init ("wtci0001"); 12 107 12 108 declare 1 more_prompt_info aligned based (more_prompt_info_ptr), 12 109 2 version char(8), 12 110 2 more_prompt char(80); 12 111 12 112 declare more_prompt_info_ptr pointer; 12 113 12 114 declare more_prompt_info_version_1 char(8) static options (constant) init ("wsmp0001"); 12 115 12 116 /* Line editor stuff ... */ 12 117 12 118 dcl line_editor_key_binding_info_ptr 12 119 pointer; 12 120 12 121 dcl line_editor_binding_count 12 122 fixed bin; 12 123 dcl line_editor_longest_sequence 12 124 fixed bin; 12 125 /* For each binding, action defines what to do for that sequence. Constants 12 126* are defined in window_editor_values.incl.pl1. Only if action is set to 12 127* EXTERNAL_ROUTINE does the editor_routine entry variable get examined. */ 12 128 12 129 dcl 1 line_editor_key_binding_info 12 130 aligned based (line_editor_key_binding_info_ptr), 12 131 2 version char(8), 12 132 2 binding_count fixed bin, 12 133 2 longest_sequence fixed bin, 12 134 2 bindings (line_editor_binding_count refer 12 135 (line_editor_key_binding_info.binding_count)), 12 136 3 sequence char(line_editor_longest_sequence refer 12 137 (line_editor_key_binding_info.longest_sequence)) varying, 12 138 3 action fixed bin, 12 139 3 numarg_action fixed binary, 12 140 3 editor_routine entry (pointer, fixed bin(35)), 12 141 3 name char (64) varying unaligned, 12 142 3 description char (256) varying unaligned, 12 143 3 info_path unaligned, 12 144 4 info_dir char (168), 12 145 4 info_entry char (32); 12 146 12 147 12 148 dcl line_editor_key_binding_info_version_3 12 149 char(8) static options (constant) init ("lekbi003"); 12 150 12 151 dcl 1 get_editor_key_bindings_info aligned based (get_editor_key_bindings_info_ptr), 12 152 2 version char (8), 12 153 2 flags, 12 154 3 entire_state bit (1) unaligned, 12 155 3 mbz bit (35) unaligned, 12 156 2 key_binding_info_ptr ptr, 12 157 2 entire_state_ptr ptr; 12 158 12 159 dcl get_editor_key_bindings_info_ptr ptr; 12 160 dcl get_editor_key_bindings_info_version_1 char (8) int static options (constant) init ("gekbi_01"); 12 161 12 162 dcl 1 set_editor_key_bindings_info aligned 12 163 based (set_editor_key_bindings_info_ptr), 12 164 2 version char (8), 12 165 2 flags, 12 166 3 replace bit (1) unaligned, 12 167 3 update bit (1) unaligned, 12 168 3 mbz bit (34) unaligned, 12 169 2 key_binding_info_ptr ptr; 12 170 12 171 dcl set_editor_key_bindings_info_ptr ptr; 12 172 dcl set_editor_key_bindings_info_version_1 char (8) int static options (constant) init ("sekbi_01"); 12 173 12 174 /* This should be moved to window_info.incl.pl1 when that include file is 12 175* created. JR 2/1/84 */ 12 176 12 177 dcl 1 window_edit_line_info 12 178 based (window_edit_line_info_ptr), 12 179 2 version char (8), 12 180 2 line_ptr ptr, 12 181 2 line_length fixed bin (21); /* later we will hack initial cursor position, key bindings, etc. */ 12 182 12 183 dcl window_edit_line_info_version_1 12 184 char (8) static options (constant) init ("wedl0001"); 12 185 12 186 dcl window_edit_line_info_ptr 12 187 ptr; 12 188 12 189 /* END INCLUDE FILE window_control_info.incl.pl1 */ 304 13 1 /* begin include fine window_dcls.incl.pl1 BIM June 1981 */ 13 2 /* Modified 9 October 1983 by Jon A. Rochlis to add window_$edit_line. */ 13 3 13 4 /* format: style3 */ 13 5 13 6 declare window_$bell entry (pointer, fixed binary (35)); 13 7 declare window_$clear_region 13 8 entry (pointer, fixed binary, fixed binary, fixed binary, fixed binary, fixed binary (35)); 13 9 declare window_$clear_to_end_of_line 13 10 entry (pointer, fixed binary (35)); 13 11 declare window_$clear_to_end_of_window 13 12 entry (pointer, fixed binary (35)); 13 13 declare window_$clear_window 13 14 entry (pointer, fixed binary (35)); 13 15 declare window_$delete_chars 13 16 entry (pointer, fixed binary, fixed binary (35)); 13 17 declare window_$get_cursor_position 13 18 entry (pointer, fixed binary, fixed binary, fixed binary (35)); 13 19 13 20 /* Call window_$get_echoed_chars (iocb_ptr, n_to_read, read_buffer, n_read, read_break, code); */ 13 21 13 22 declare window_$get_echoed_chars 13 23 entry (pointer, fixed binary (21), character (*), fixed binary (21), character (1) var, 13 24 fixed binary (35)); 13 25 declare window_$get_unechoed_chars 13 26 entry (pointer, fixed binary (21), character (*), fixed binary (21), character (1) var, 13 27 fixed binary (35)); 13 28 declare window_$insert_text entry (pointer, character (*), fixed binary (35)); 13 29 declare window_$overwrite_text 13 30 entry (pointer, character (*), fixed binary (35)); 13 31 declare window_$position_cursor 13 32 entry (pointer, fixed binary, fixed binary, fixed binary (35)); 13 33 13 34 /* Call window_$position_cursor_rel (iocb_ptr, delta_line, delta_column, code); */ 13 35 13 36 declare window_$position_cursor_rel 13 37 entry (pointer, fixed binary, fixed binary, fixed binary (35)); 13 38 13 39 /* Call window_$scroll_region (iocb_ptr, first_line_of_region, n_lines_of_region, distance_to_scroll_region_negative_is_up, 13 40* code); */ 13 41 13 42 declare window_$scroll_region 13 43 entry (pointer, fixed binary, fixed binary, fixed binary, fixed binary (35)); 13 44 declare window_$sync entry (pointer, fixed binary (35)); 13 45 13 46 /* Call window_$write_raw_text (iocb_ptr, text_string, code); */ 13 47 13 48 declare window_$write_raw_text 13 49 entry (pointer, character (*), fixed binary (35)); 13 50 13 51 /* Call window_$write_sync_read (iocb_ptr, prompt_string, n_to_read, read_buffer, n_read, break_char, code); */ 13 52 13 53 declare window_$write_sync_read 13 54 entry (pointer, character (*), fixed bin (21), character (*), fixed binary (21), 13 55 character (1) var, fixed binary (35)); 13 56 13 57 /* Call window_$change_line (iocb_ptr, new_line, code); */ 13 58 13 59 declare window_$change_line entry (pointer, fixed binary, fixed binary (35)); 13 60 13 61 /* Call window_$change_column (iocb_ptr, new_column, code); */ 13 62 13 63 declare window_$change_column 13 64 entry (pointer, fixed binary, fixed binary (35)); 13 65 13 66 /* Call window_$get_one_unechoed (iocb_ptr, char_or_len_0, block_flag, code); */ 13 67 declare ( 13 68 window_$get_one_unechoed, 13 69 window_$get_one_unechoed_char 13 70 ) entry (pointer, character (1) var, bit (1) aligned, fixed binary (35)); 13 71 13 72 declare window_$create entry (pointer, pointer, pointer, fixed binary (35)); 13 73 13 74 declare window_$destroy entry (pointer, fixed binary (35)); 13 75 13 76 declare window_$edit_line entry (pointer, pointer, pointer, fixed bin(21), fixed bin(21), fixed bin(35)); 13 77 13 78 /* call window_$edit_line (iocb_ptr, window_edit_line_info_ptr, buffer_ptr, 13 79* buffer_len, n_returned, code); */ 13 80 13 81 13 82 /* end include file window_dcls.incl.pl1 */ 305 14 1 /* BEGIN Mailbox Message Include File (mail_format.incl.pl1) */ 14 2 14 3 14 4 /****^ HISTORY COMMENTS: 14 5* 1) change(86-01-09,Herbst), approve(86-03-25,MCR7367), 14 6* audit(86-04-28,Margolin), install(86-05-22,MR12.0-1059): 14 7* Added "seen" switch. 14 8* 2) change(86-06-02,Herbst), approve(86-06-02,MCR7367), audit(86-06-30,Wong), 14 9* install(86-06-30,MR12.0-1080): 14 10* Updated to version 4 for seen switch. 14 11* END HISTORY COMMENTS */ 14 12 14 13 /* Last modified by K. T. Pogran, 3/6/75 */ 14 14 /* Modified by D. M. Wells, August 10, 1977 for v4 message segments. */ 14 15 /* Modified: 3 June 1981 by G. Palter for mail system subroutine interface */ 14 16 14 17 declare mail_format_ptr pointer aligned; 14 18 14 19 declare MAIL_FORMAT_VERSION_4 initial (4) 14 20 fixed bin internal static options (constant); 14 21 14 22 declare text_length fixed bin (21); 14 23 14 24 declare 1 mail_format aligned based (mail_format_ptr), 14 25 2 header, 14 26 3 version fixed bin (17), 14 27 3 sent_from char (32) aligned, 14 28 3 lines fixed bin (17), 14 29 3 text_len fixed bin (21), 14 30 3 switches aligned, 14 31 4 wakeup bit (1) unaligned, 14 32 4 urgent bit (1) unaligned, 14 33 4 notify bit (1) unaligned, 14 34 4 acknowledge bit (1) unaligned, 14 35 4 obsolete bit (1) unaligned, 14 36 4 canonical bit (1) unaligned, 14 37 4 seen bit (1) unaligned, 14 38 4 others bit (65) unaligned, 14 39 2 text char(text_length refer (mail_format.header.text_len)) aligned; 14 40 14 41 /* END Mailbox Message Include File (mail_format.incl.pl1) */ 306 15 1 /* BEGIN send_mail_info include file */ 15 2 15 3 dcl send_mail_info_version_2 fixed bin init(2); 15 4 15 5 dcl 1 send_mail_info aligned, 15 6 2 version fixed bin, /* = 2 */ 15 7 2 sent_from char(32) aligned, 15 8 2 switches, 15 9 3 wakeup bit(1) unal, 15 10 3 mbz1 bit(1) unal, 15 11 3 always_add bit(1) unal, 15 12 3 never_add bit(1) unal, 15 13 3 notify bit(1) unal, 15 14 3 acknowledge bit(1) unal, 15 15 3 mbz bit(30) unal; 15 16 15 17 /* END send_mail_info include file */ 307 16 1 /* BEGIN INCLUDE FILE message_info.incl.pl1 */ 16 2 /* Written 05/15/84 by Jim Lippard */ 16 3 16 4 dcl 1 message_info aligned based (message_info_ptr), 16 5 2 version char (8), 16 6 2 sender char (32), 16 7 2 message_ptr ptr, 16 8 2 authorization bit (72); 16 9 16 10 dcl message_info_ptr ptr; 16 11 16 12 dcl MESSAGE_INFO_VERSION_1 char (8) internal static options (constant) init ("msginfo1"); 16 13 16 14 /* END INCLUDE FILE message_info.incl.pl1 */ 308 17 1 /* BEGIN INCLUDE FILE msg_array.incl.pl1 */ 17 2 /* Written 05/29/84 by Jim Lippard */ 17 3 17 4 dcl 1 msg_array (n_messages) aligned based (msg_array_ptr), 17 5 2 message_id bit (72), 17 6 2 message_number fixed bin, 17 7 2 flags, 17 8 3 printed bit (1) unal, 17 9 3 mbz bit (35) unal; 17 10 17 11 dcl msg_array_ptr ptr; 17 12 17 13 dcl n_messages fixed bin; 17 14 17 15 dcl DELETE_UNHELD bit (3) internal static options (constant) init ("100"b); 17 16 dcl DONT_DELETE_MESSAGES bit (3) internal static options (constant) init ("010"b); 17 17 dcl DONT_DELETE_NOTIFICATIONS bit (3) internal static options (constant) init ("001"b); 17 18 17 19 /* END INCLUDE FILE msg_array.incl.pl1 */ 309 18 1 /* BEGIN INCLUDE FILE msg_wakeup_flags.incl.pl1 */ 18 2 /* Written 08/24/84 by Jim Lippard */ 18 3 18 4 dcl 1 wakeup_flags unaligned based, 18 5 2 hold_messages bit (1), 18 6 2 hold_notifications bit (1), 18 7 2 print_notifications bit (1), 18 8 2 wakeup_state bit (2), 18 9 2 mbz bit (31); 18 10 18 11 dcl ACCEPT_MESSAGES bit (2) internal static options (constant) init ("10"b); 18 12 dcl DEFER_MESSAGES bit (2) internal static options (constant) init ("01"b); 18 13 18 14 /* END INCLUDE FILE msg_wakeup_flags.incl.pl1 */ 310 19 1 /* BEGIN INCLUDE FILE last_message_info.incl.pl1 */ 19 2 /* Written 05/15/84 by Jim Lippard */ 19 3 /* Modified 01/11/85 by Jim Lippard to remove last_message_index. */ 19 4 19 5 dcl 1 last_message_info aligned based (last_message_info_ptr), 19 6 2 version char (8), 19 7 2 last_message_ptr ptr, 19 8 2 last_message_id bit (72) aligned, 19 9 2 last_message_number fixed bin; 19 10 19 11 dcl last_message_info_ptr ptr; 19 12 19 13 dcl LAST_MESSAGE_INFO_VERSION_1 char (8) internal static options (constant) init ("lastmsg1"); 19 14 19 15 /* END INCLUDE FILE last_message_info.incl.pl1 */ 311 312 313 /* This entry reads a character, blocking if necessary */ 314 315 get_char: 316 entry returns (fixed bin); 317 318 emacs_data_ptr = e_find_invocation_ (); 319 320 /* Use video system if we can. */ 321 if emacs_data.flags.using_video 322 then begin; 323 dcl break char (1) varying; 324 325 retry = "1"b; 326 do while (retry); 327 328 call window_$get_one_unechoed_char (emacs_data.input_iocb, break, "1"b, code); 329 call check_window_code ("get_one_unechoed_char", code, retry); 330 end; 331 break_nonvar = break; 332 return (rank (break_nonvar)); 333 end; 334 335 ngo_entry = "0"b; 336 expdl, screenlinelen = 0; /* Need this to avoid fault in getc */ 337 call getc; 338 get_char_returns: 339 if emacs_data.interrupts.array (0) > 0 then do; 340 if emacs_data.flags.using_r0_echnego then do; 341 a1r: 342 call hcs_$tty_read (emacs_data.ttyx, null (), 0, 0, 0, 0, code); 343 if code ^= 0 344 then call revalidate_tty (a1r); 345 end; 346 if emacs_data.cgot > 0 347 then emacs_data.ctook = emacs_data.ctook - 1;/* Must be a real ch that woulda been returned. */ 348 349 /* This kludge turns off ring zero echoing before emacs plays tricks on the 350* display. Echoed_in_buffer had better be zero. Christ almighty, what hair. */ 351 352 /* In truth, this should not be necessary for get_char entry, 353* because nobody could have called regular get_char unless echo get_char 354* broke echo, but this sure can't hurt, and is needed for echo call. */ 355 356 return (-1); 357 end; 358 return (fixed (unspec (ch), 9)); 359 360 /* This entry "prints" a character */ 361 362 tyo: 363 entry (fch); 364 365 emacs_data_ptr = e_find_invocation_ (); 366 367 unspec (ch) = bit (fixed (fch, 9), 9); 368 ochp = addr (ch); 369 ochl = 1; 370 call output_och; 371 return; 372 373 /* This entry "prints" a string */ 374 375 princ: 376 entry (pch); 377 378 emacs_data_ptr = e_find_invocation_ (); 379 380 ochp = addr (pch); 381 ochl = length (pch); 382 call output_och; 383 return; 384 385 output_och: 386 proc; 387 388 dcl och_string character (ochl) based (ochp); 389 390 if tracing_Rtyo then do; /* send it to the trace iocb, as well */ 391 call iox_$put_chars (Rtyo_trace_iocb_ptr, ochp, ochl, (0)); 392 end; 393 394 charsout_meter = charsout_meter + ochl; 395 if (ochl + emacs_data.chars_in_obuf > length (obuf)) 396 then call dump_obuf; 397 if (ochl > length (obuf)) | dbosw then do; 398 retry = "1"b; 399 if emacs_data.flags.using_video 400 then do while (retry); 401 call window_$overwrite_text (emacs_data.output_iocb, och_string, code); 402 call check_window_code ("overwrite_text", code, retry); 403 end; 404 else call iox_$put_chars (emacs_data.output_iocb, ochp, ochl, code); 405 end; 406 else do; 407 substr (obuf, emacs_data.chars_in_obuf + 1, ochl) = och; 408 emacs_data.chars_in_obuf = emacs_data.chars_in_obuf + ochl; 409 end; 410 return; 411 412 end output_och; 413 414 /* Return emacs data pointer-- 19 November 1981 RMSoley */ 415 get_emacs_data_ptr: 416 entry () returns (pointer); 417 418 emacs_data_ptr = e_find_invocation_ (); 419 return (emacs_data_ptr); 420 421 422 /* Modified for DCTL Rtyo and Rprinc output tracing, 06/25/79 WOS */ 423 424 set_io_trace_iocb: 425 entry (P_iocb_name); 426 427 emacs_data_ptr = e_find_invocation_ (); 428 429 call cu_$arg_count (nargs); 430 if nargs ^= 1 then do; 431 call com_err_ (0, "e_pl1_$set_io_trace_iocb", "^/Usage:^-e_pl1_$set_io_trace_iocb iocb_name"); 432 return; 433 end; 434 435 if P_iocb_name = "-off" | P_iocb_name = "off" then do; 436 /* shut it off */ 437 tracing_Rtyo = "0"b; 438 return; 439 end; 440 441 tracing_Rtyo = "0"b; /* turn it off until we're sure we won */ 442 443 call iox_$look_iocb (P_iocb_name, Rtyo_trace_iocb_ptr, code); 444 if code ^= 0 then do; 445 cant_use_trace_iocb: 446 call com_err_ (code, "e_pl1_$set_io_trace_iocb", "Can't use I/O switch ""^a"".", P_iocb_name); 447 return; 448 end; 449 450 if Rtyo_trace_iocb_ptr -> iocb.open_descrip_ptr = null () 451 then goto cant_use_trace_iocb; 452 453 tracing_Rtyo = "1"b; /* assume we won */ 454 return; /* all done with set_io_trace_iocb */ 455 456 /* Lisp/PL1 echo negotiator - BSG 10/28/78 */ 457 /* Ring 0 wired echo BSG 1/21/79 */ 458 459 echo_negotiate_get_char: 460 entry (P_workstringobj, P_charsadded_symobj, P_screenlinelen) returns (fixed bin); 461 462 emacs_data_ptr = e_find_invocation_ (); 463 464 if emacs_data.flags.using_video 465 then begin; 466 dcl buffer char (256); 467 dcl break char (1) varying; 468 dcl broke character (1); /* Fix up break table if it needs it. */ 469 if emacs_data.flags.update_breaktable 470 then begin; 471 dcl 1 bti aligned like break_table_info; 472 bti.version = break_table_info_version; 473 string (bti.breaks) = string (emacs_data.breaktable); 474 call iox_$control (emacs_data.input_iocb, "set_break_table", addr (bti), code); 475 if code ^= 0 476 then call signal_io_error (code, "Could not set video break table."); 477 emacs_data.flags.update_breaktable = "0"b; 478 end; 479 480 nread = 0; 481 retry = "1"b; 482 if P_screenlinelen <= 0 483 then do while (retry); 484 485 call window_$get_one_unechoed_char (emacs_data.input_iocb, break, "1"b /* BLOCK */, code); 486 call check_window_code ("get_one_unechoed", code, retry); 487 end; 488 489 else do while (retry); 490 call window_$get_echoed_chars (emacs_data.input_iocb, (P_screenlinelen), buffer, nread, break, code); 491 call check_window_code ("get_echoed_chars", code, retry); 492 end; 493 494 charsadded.ct = nread; 495 if nread ^= 0 then do; 496 workstring = substr (workstring, 1, length (workstring) - 1); 497 workstring = workstring || substr (buffer, 1, nread) || byte (10 /* NL */); 498 end; 499 broke = break; 500 if length (break) > 0 501 then return (rank (broke)); 502 else return (-1); 503 end; 504 505 ngo_entry = "1"b; /* Call right hcs_ */ 506 ochp = addr (ch); /* Out what we in */ 507 ochl = 1; 508 charsadded.ct = 0; /* In case lisp didn't */ 509 expdl = 0; 510 screenlinelen = P_screenlinelen; 511 vaccum = ""; /* for cleanup */ 512 enegot_loop: 513 call getc; 514 if emacs_data.cgot = 0 515 then go to enegot_closeout; 516 if fixed (unspec (ch), 9) > 127 517 then if ^emacs_data.flags.extended_ascii 518 then go to enegot_closeout; /* Meta frobs and IACs break */ 519 if emacs_data.breaktable (fixed (unspec (ch), 9)) 520 then go to enegot_closeout; 521 if expdl ^< screenlinelen 522 then go to enegot_closeout; 523 expdl = expdl + 1; /* Watch for end */ 524 vaccum = vaccum || ch; 525 locecho_meter = locecho_meter + 1; 526 if emacs_data.flags.using_r0_echnego then do; 527 if emacs_data.echoed <= 0 528 then call output_och; 529 else emacs_data.echoed = emacs_data.echoed - 1; 530 end; 531 else call output_och; 532 go to enegot_loop; 533 enegot_closeout: 534 charsadded.ct = length (vaccum); 535 vaccum = vaccum || byte (10 /* NL */); 536 workstring = substr (workstring, 1, length (workstring) - 1); 537 workstring = workstring || vaccum; 538 if emacs_data.chars_in_obuf > 0 539 then call dump_obuf; 540 go to get_char_returns; /* Check echo break */ 541 542 set_break_char: 543 entry (P_bchx, P_way); 544 545 emacs_data_ptr = e_find_invocation_ (); 546 547 if P_bchx < 32 | P_bchx = 127 548 then way = 1; 549 else way = P_way; /* control chars never print right */ 550 newbit = (way ^= 0); 551 if emacs_data.breaktable (P_bchx) ^= newbit then do; 552 emacs_data.breaktable (P_bchx) = newbit; 553 emacs_data.flags.update_breaktable = "1"b; 554 end; 555 return; 556 557 set_break_sequence: 558 entry (P_1, P_2, P_3, P_4, P_5, P_6, P_7, P_8); 559 560 emacs_data_ptr = e_find_invocation_ (); 561 562 /* This entry sets the break table en masse, i.e., for the entire 563* collating sequence. P_(1 2 3 4) are fb32's filled from the lisp side 564* to simulate a bit(128) bit string. RMSoley 28 June 1981 */ 565 /* Added P_5...P_8 for 8 bit ASCII breaktables. 84-11-23 EDSchroth */ 566 567 big_bit_string = 568 bit (P_1, 32) || bit (P_2, 32) || bit (P_3, 32) || bit (P_4, 32) || bit (P_5, 32) || bit (P_6, 32) 569 || bit (P_7, 32) || bit (P_8, 32); 570 emacs_data.flags.update_breaktable = "1"b; 571 return; 572 573 r0_echnego_on: 574 entry; 575 emacs_data_ptr = e_find_invocation_ (); 576 emacs_data.flags.using_r0_echnego = "1"b; 577 return; 578 r0_echnego_off: 579 entry; 580 emacs_data_ptr = e_find_invocation_ (); 581 emacs_data.flags.using_r0_echnego = "0"b; 582 return; 583 584 return_echo_meters: 585 entry (a_r1, a_r2, a_r3, a_r4); 586 587 emacs_data_ptr = e_find_invocation_ (); 588 589 a_r1 = charsgot_meter; 590 a_r2 = r0echo_meter; 591 a_r3 = locecho_meter; 592 a_r4 = charsout_meter; 593 594 return; 595 596 /* This entry gets the speed of the user's terminal */ 597 598 get_line_speed: 599 entry returns (fixed bin); 600 601 emacs_data_ptr = e_find_invocation_ (); 602 603 if emacs_data.ospeed > 0 604 then return (emacs_data.ospeed); 605 terminal_info_ptr = addr (tinfo); 606 terminal_info.version = terminal_info_version; 607 608 call iox_$control (emacs_data.input_iocb, "terminal_info", addr (terminal_info), code); 609 if code ^= 0 610 then return (30); 611 else return (divide (terminal_info.baud_rate, 10, 17, 0)); 612 613 /* This entry allows rawmode net users to assert their true line speed */ 614 615 set_line_speed: 616 entry; 617 618 emacs_data_ptr = e_find_invocation_ (); 619 620 call cu_$arg_ptr (1, sls_ap, sls_al, code); 621 if code ^= 0 then do; 622 sls_usage: 623 call com_err_ (code, "emacs$set_line_speed", "Usage: emacs$set_line_speed | -reset"); 624 return; 625 end; 626 if sls_arg = "-rs" | sls_arg = "-reset" then do; 627 emacs_data.ospeed = 0; 628 return; 629 end; 630 sls_t_ospeed = cv_dec_check_ (sls_arg, code); 631 if code ^= 0 | sls_t_ospeed ^> 0 then do; 632 code = error_table_$bad_arg; 633 go to sls_usage; 634 end; 635 emacs_data.ospeed = divide (sls_t_ospeed, 10, 17, 0); 636 return; 637 638 set_line_speed_: 639 entry (P_line_speed); 640 641 emacs_data_ptr = e_find_invocation_ (); 642 643 emacs_data.ospeed = P_line_speed; 644 return; 645 646 /* This entry returns various information about the terminal */ 647 648 get_mcs_tty_info: 649 entry (P_tabs_avl, P_horz_nl_delay, P_vert_nl_delay, P_tab_var_delay, P_tab_const_delay, P_backspace_delay, P_linel); 650 651 emacs_data_ptr = e_find_invocation_ (); 652 653 P_linel = emacs_data.linel; 654 655 my_mode_value.version = mode_value_version_3; 656 call mode_string_$get_mode ((emacs_data.tty_modes), "tabs", addr (my_mode_value), code); 657 if code ^= 0 658 then P_tabs_avl = "0"b; 659 else P_tabs_avl = my_mode_value.boolean_value; 660 661 delay_table.version = 1; 662 call iox_$control (emacs_data.input_iocb, "get_delay", addr (delay_table), code); 663 if code ^= 0 then do; 664 unspec (delay_table) = "0"b; /* Dont know can't hurt */ 665 delay_table.horz_nl = 0.1; 666 delay_table.vert_nl = 5; 667 delay_table.var_tab = 0.250; 668 end; 669 else do; 670 P_horz_nl_delay = delay_table.horz_nl; 671 P_vert_nl_delay = delay_table.vert_nl; 672 P_tab_var_delay = delay_table.var_tab; 673 P_tab_const_delay = delay_table.const_tab; 674 P_backspace_delay = delay_table.backspace; 675 end; 676 return; 677 678 679 /* Dump whatever is in the output buffer. */ 680 681 dump_obuf: 682 proc; 683 684 dcl (charsout, charsout_this_time) fixed bin; 685 686 dcl video_obuf char (emacs_data.chars_in_obuf) unaligned based (emacs_data.obufptr); 687 688 went_opblockedp = "0"b; 689 if emacs_data.chars_in_obuf <= 0 /* nothing in our buffer */ 690 then do; 691 retry = "1"b; 692 /*** Dump what's in the video system buffer ***/ 693 if emacs_data.flags.using_video 694 then do while (retry); 695 call window_$sync (emacs_data.output_iocb, code); 696 call check_window_code ("sync", code, retry); 697 end; 698 return; 699 end; 700 /*** dump our buffer now ***/ 701 if emacs_data.flags.using_video then do; 702 retry = "1"b; 703 do while (retry); 704 call window_$overwrite_text (emacs_data.output_iocb, video_obuf, code); 705 call check_window_code ("overwrite_text", code, retry); 706 end; 707 retry = "1"b; 708 do while (retry); 709 call window_$sync (emacs_data.output_iocb, code); 710 call check_window_code ("sync", code, retry); 711 end; 712 end; 713 else do; 714 charsout = 0; 715 do while (emacs_data.chars_in_obuf > charsout); 716 a2r: 717 call hcs_$tty_write (emacs_data.ttyx, addr (obuf), charsout, emacs_data.chars_in_obuf - charsout, 718 charsout_this_time, S, code); 719 if code ^= 0 720 then call revalidate_tty (a2r); 721 if S ^= 5 | code ^= 0 722 then call signal_io_error (code, "hcs_ tty write failed, or reconnect failed."); 723 724 charsout = charsout + charsout_this_time; 725 if emacs_data.chars_in_obuf > charsout then do; 726 call ipc_$block (addr (bl), addr (gruft), code); 727 if code ^= 0 728 then call signal_io_error (code, "Block failed on tty write."); 729 went_opblockedp = "1"b; 730 end; 731 end; 732 end; 733 734 emacs_data.chars_in_obuf = 0; 735 end; 736 737 738 /* Get one unread character, actually reading if necessary. */ 739 740 getc: 741 proc (); /* Fill ch */ 742 743 dcl lleft fixed bin, 744 echnego_sync_flag bit (1); 745 746 747 lleft = screenlinelen - expdl; 748 rt: 749 if emacs_data.ctook >= emacs_data.cgot then do; 750 if emacs_data.chars_in_obuf > 0 751 then call dump_obuf; /* Must dump FIRST, or echnego race loses. */ 752 rread: 753 emacs_data.ctook, emacs_data.echoed = 0; 754 echnego_sync_flag = "0"b; /* Start out in synch */ 755 if emacs_data.flags.using_r0_echnego & ngo_entry then do; 756 if emacs_data.flags.update_breaktable then do; 757 unspec (echd) = ""b; 758 echd.version = echo_neg_data_version_2; 759 string (echd.break) = string (emacs_data.breaktable); 760 call iox_$control (emacs_data.input_iocb, "set_echo_break_table", addr (echd), code); 761 if code ^= 0 762 then call signal_io_error (code, "Could not set echo break table."); 763 764 emacs_data.flags.update_breaktable = "0"b; 765 end; 766 if emacs_data.interrupts.array (0) > 0 767 then lleft = 0; 768 call hcs_$tty_read_echoed (emacs_data.ttyx, addr (chars), 0, dimension (chars, 1), emacs_data.cgot, 769 emacs_data.echoed, lleft, S, code); 770 if emacs_data.echoed > emacs_data.cgot 771 then emacs_data.echoed = emacs_data.cgot; 772 r0echo_meter = r0echo_meter + emacs_data.echoed; 773 if code ^= 0 774 then if code = error_table_$echnego_awaiting_stop_sync then do; 775 /* Echo stop waitout */ 776 code = 0; 777 echnego_sync_flag = "1"b; 778 end; 779 end; 780 else call hcs_$tty_read (emacs_data.ttyx, addr (chars), 0, dimension (chars, 1), emacs_data.cgot, S, code); 781 782 if code ^= 0 then do; 783 if emacs_data.flags.using_r0_echnego then do; 784 emacs_data.flags.update_breaktable = "1"b; 785 /* maybe switched tties? */ 786 if ngo_entry & code = error_table_$no_table 787 then go to rread; /* Switched tties at night */ 788 end; 789 call revalidate_tty (rread); 790 end; 791 if code ^= 0 792 then call signal_io_error (code, "hcs_ tty read failed."); 793 if emacs_data.cgot = 0 then do; 794 if emacs_data.interrupts.array (0) > 0 & ^echnego_sync_flag 795 then return; /* Wait more for echnego_sync_flag */ 796 call ipc_$block (addr (bl), addr (gruft), code); 797 if code ^= 0 798 then call signal_io_error (code, "Block failed for tty read."); 799 go to rread; 800 end; 801 charsgot_meter = charsgot_meter + emacs_data.cgot; 802 end; 803 emacs_data.ctook = emacs_data.ctook + 1; 804 unspec (ch) = chars (emacs_data.ctook); 805 806 if ignore_lf_sw & (unspec (ch) = "012"b3) 807 then go to rt; /* lf kloodgerie */ 808 809 return; 810 end getc; 811 812 813 /* This entry dumps the output buffer */ 814 815 dump_output_buffer: 816 entry (); 817 818 emacs_data_ptr = e_find_invocation_ (); 819 call dump_obuf; 820 return; 821 822 823 /* This entry does a resetwrite on the terminal */ 824 825 resetwrite: 826 entry; 827 emacs_data_ptr = e_find_invocation_ (); 828 if emacs_data.output_iocb = null 829 then emacs_data.output_iocb = iox_$user_output; 830 call iox_$control (emacs_data.output_iocb, "resetwrite", null, (0)); 831 return; 832 833 834 /* This entry returns if any input is available */ 835 836 real_have_chars: 837 entry returns (fixed bin); 838 839 emacs_data_ptr = e_find_invocation_ (); 840 if emacs_data.flags.using_video then do; 841 call iox_$control (emacs_data.input_iocb, "read_status", addr (rsblock), code); 842 if code ^= 0 | ^rsblock.input_pending 843 then return (0); 844 else return (1); 845 end; 846 847 if emacs_data.ctook < emacs_data.cgot - fixed (ignore_lf_sw, 1) - fixed (emacs_data.flags.got_cr, 1) 848 then return (1); 849 else return (0); 850 851 852 /* This entry executes a Multics command line trapping all errors */ 853 854 855 cline_executor: 856 entry (P_cline); 857 858 emacs_data_ptr = e_find_invocation_ (); 859 ignore_control = "0"b; 860 call condition_ ("any_other", cline_any_other_handler); 861 call cu_$cp (addr (P_cline), length (P_cline), (0)); 862 863 cline_returns: 864 return; 865 866 cline_any_other_handler: 867 proc (mcp, cname, cop, inp, cont); 868 869 dcl (mcp, cop, inp) ptr; 870 dcl cname char (*); 871 dcl cont bit (1) aligned; 872 if ignore_control then do; /* Oh my, recursing */ 873 cont = "1"b; 874 return; 875 end; 876 if cname = "quit" | cname = "alrm" | cname = "program_interrupt" | cname = "command_error" | cname = "cput" 877 | cname = "command_question" | cname = "finish" | cname = "trm_" | cname = "sus_" then do; 878 cont = "1"b; 879 return; 880 end; 881 ignore_control = "1"b; /* Let recurse thru */ 882 emacs_data.cgot = 0; 883 save_tty_in_emacs_p = emacs_data.flags.in_emacs; 884 emacs_data.flags.in_emacs = "0"b; 885 call set_multics_tty_modes; 886 call ioa_$ioa_switch (iox_$user_io, 887 "^/emacs: ^a raised while executing Multics command.^/Use the ^[emacs^;program_interrupt (pi)^] command to return to emacs.", 888 cname, emacs_data.in_task); 889 if save_tty_in_emacs_p 890 then begin options (non_quick); /* Probably file-outputting, will never see fault msg unless we output it. */ 891 dcl condition_interpreter_ entry (ptr, ptr, fixed bin, fixed bin, ptr, char (*), ptr, ptr); 892 dcl xarea area (500); 893 dcl msg char (mlen) based (mptr), 894 mlen fixed bin, 895 mptr ptr; 896 897 call condition_interpreter_ (addr (xarea), mptr, mlen, 1, mcp, rtrim (cname), cop, inp); 898 if msg = "" 899 then return; /* quiet_restart and friends */ 900 call ioa_$ioa_switch (iox_$user_io, "^a", msg); 901 end; 902 call signal_ (cname, mcp, inp); 903 if save_tty_in_emacs_p 904 then call set_emacs_tty_modes; 905 emacs_data.flags.in_emacs = save_tty_in_emacs_p; 906 ignore_control = "0"b; 907 return; 908 end cline_any_other_handler; 909 910 911 /* This entry sets flag indicating whether buffering happens */ 912 913 set_dbo_sw: 914 entry (P_dbosw); 915 916 emacs_data_ptr = e_find_invocation_ (); 917 dbosw = bit (fixed (P_dbosw, 1), 1); 918 return; 919 920 921 /* This entry intializes the PL/1 stuff */ 922 923 init: 924 set_single: 925 entry; 926 927 emacs_data_ptr = e_find_invocation_ (); 928 929 my_pid = get_process_id_ (); 930 emacs_data.interrupts.array (*) = 0; 931 emacs_data.flags.in_emacs = "0"b; 932 if ^emacs_data.flags.debugging | (emacs_data.output_iocb = null ()) then do; 933 934 if emacs_data.output_iocb = null () then do; /* Check to see if the video system is on. */ 935 936 emacs_data.flags.using_video = "0"b; 937 system_free_ptr = get_system_free_area_ (); 938 allocate window_position_info in (based_area) set (window_position_info_ptr); 939 window_position_info.version = window_position_info_version; 940 941 call iox_$control (iox_$user_io, "get_window_info", window_position_info_ptr, code); 942 free window_position_info_ptr -> window_position_info; 943 if code = 0 then do; 944 emacs_data.output_iocb = iox_$user_io; 945 emacs_data.flags.using_video = "1"b; 946 end; 947 end; 948 949 950 if emacs_data.output_iocb = null () then do; 951 call video_utils_$network_login_channel (emacs_data.output_iocb, network_type, code); 952 if code ^= 0 953 then call signal_io_error (code, error_message); 954 end; 955 956 /** See if we need to automatically invoke video **/ 957 if ^emacs_data.flags.using_video 958 then if network_type ^= MCS_NETWORK_TYPE & video_data_$terminal_iocb = null then do; 959 call video_utils_$turn_on_login_channel (code, error_message); 960 if code ^= 0 961 then call signal_io_error (code, error_message); 962 emacs_data.flags.using_video = "1"b; 963 emacs_data.flags.turned_on_video = "1"b; 964 end; 965 966 emacs_data.input_iocb = emacs_data.output_iocb; 967 end; 968 969 /* Determine if iocb we got is a video iocb. */ 970 if ^emacs_data.flags.using_video & ^emacs_data.flags.debugging then do; 971 system_free_ptr = get_system_free_area_ (); 972 allocate window_position_info in (based_area) set (window_position_info_ptr); 973 window_position_info.version = window_position_info_version; 974 call iox_$control (emacs_data.output_iocb, "get_window_info", window_position_info_ptr, code); 975 free window_position_info_ptr -> window_position_info; 976 emacs_data.flags.using_video = (code = 0); 977 end; 978 979 call iox_$modes (emacs_data.input_iocb, "", tty_mode_string, (0)); 980 if emacs_data.tty_modes = "" 981 then emacs_data.tty_modes = tty_mode_string; 982 emacs_data.linel = get_line_length_$switch (emacs_data.output_iocb, code); 983 if code ^= 0 984 then emacs_data.linel = 79; 985 call get_tty_channel_info; 986 emacs_data.chars_in_obuf, emacs_data.ctook, emacs_data.cgot, emacs_data.echoed = 0; 987 locecho_meter, charsgot_meter, charsout_meter, r0echo_meter = 0; 988 call iox_$control (emacs_data.input_iocb, "get_event_channel", addr (bl.event), code); 989 if code ^= 0 then do; 990 code = 0; 991 call iox_$control (emacs_data.input_iocb, "read_status", addr (rsblock), code); 992 if code = 0 993 then bl.event = rsblock.event_channel; 994 end; 995 if emacs_data.obufptr = null 996 then allocate obuf; 997 if emacs_data.ibufptr = null 998 then allocate ibuf; 999 return; 1000 1001 /* TTY channel attach/reattach hackery 12/3/79 BSG */ 1002 1003 get_tty_channel_info: 1004 proc (); 1005 1006 dcl gtc_code fixed bin (35); 1007 dcl 1 ttyt aligned based, 1008 2 pad (14) fixed bin, 1009 2 tttyx fixed bin (35); 1010 1011 unspec (get_channel_info) = "0"b; 1012 get_channel_info.version = 1; 1013 call iox_$control (emacs_data.output_iocb, "get_channel_info", addr (get_channel_info), gtc_code); 1014 if gtc_code = 0 1015 then emacs_data.ttyx = get_channel_info.devx; 1016 else emacs_data.ttyx = emacs_data.output_iocb -> iocb.attach_data_ptr -> ttyt.tttyx; 1017 emacs_data.flags.update_breaktable = "1"b; 1018 end get_tty_channel_info; 1019 1020 revalidate_tty: 1021 proc (a_label); 1022 1023 dcl a_label label, 1024 l_code fixed bin (35); 1025 1026 /* This procedure is called when hcs_$tty_* returns an error. If the 1027* current tty devx isn't even valid, as hcs_$tty_state indicates, we 1028* may have been hung up. If this IS the case, reattach as below. If 1029* not, we have a real error, and let it thru. */ 1030 1031 call hcs_$tty_state (emacs_data.ttyx, (0), l_code); 1032 if l_code = 0 1033 then return; /* Some other problem */ 1034 1035 /* At this point, we have definitely hung up the line. Force the 1036* ring 4 TTY dim to call ring 0, and clean up his own act, figuring 1037* out the new devx, and waiting, if necessary, for reattachment. */ 1038 1039 call iox_$control (emacs_data.input_iocb, "read_status", addr (rsblock), l_code); 1040 1041 if l_code ^= 0 1042 then return; /* Probly old dim */ 1043 1044 /* The ring 4 TTY dim now knows the real devx. Try to figure it out. 1045* It must be at LEAST the 8.0 TTY DIM if l_code is 0. */ 1046 1047 call get_tty_channel_info; 1048 1049 /* If we are in this situation, either get_tty_channel_info did its 1050* thing or we punt. */ 1051 1052 if get_channel_info.devx = 0 1053 then return; 1054 go to a_label; /* Return to retry */ 1055 end; 1056 1057 /* This entry is for debugging */ 1058 1059 set_display_iocbs: 1060 entry (in_ptr, out_ptr); 1061 1062 emacs_data_ptr = e_find_invocation_ (); 1063 1064 emacs_data.input_iocb = in_ptr; 1065 emacs_data.output_iocb = out_ptr; 1066 emacs_data.flags.debugging = "1"b; 1067 return; 1068 1069 /* This entry is also for debugging, for setting emacs_data.flags.using_video. */ 1070 1071 set_video_system: 1072 entry (P_video); 1073 1074 emacs_data_ptr = e_find_invocation_ (); 1075 1076 emacs_data.flags.using_video = bit (fixed (P_video, 1), 1); 1077 emacs_data.flags.debugging = "1"b; 1078 return; 1079 1080 /* This entry sets the flag controlling whether LF is ever returned */ 1081 1082 set_ignore_lf: 1083 entry (P_sw); 1084 1085 emacs_data_ptr = e_find_invocation_ (); 1086 ignore_lf_sw = bit (fixed (P_sw, 1), 1); 1087 return; 1088 1089 1090 /* This entry sets the extended ASCII character I/O flag allowing/disallowing 1091* 8 bit input/output. */ 1092 1093 set_extended_ascii: 1094 entry (P_sw); 1095 1096 emacs_data_ptr = e_find_invocation_ (); 1097 emacs_data.flags.extended_ascii = bit (fixed (P_sw, 1), 1); 1098 return; 1099 1100 /* This entry sets the terminal modes for EMACS */ 1101 1102 set_emacs_tty_modes: 1103 entry (); 1104 1105 emacs_data_ptr = e_find_invocation_ (); 1106 1107 if ^emacs_data.flags.using_video then do; 1108 call iox_$modes (emacs_data.input_iocb, "init,force,^prefixnl,rawi,rawo,ctl_char,fulldpx,breakall", (""), 1109 (0)); /* 1/5/83 to move breakall in (it had its own call!) */ 1110 /* 1/31/81 try again */ 1111 /* 11/8/79 to use init mode */ 1112 if emacs_data.flags.extended_ascii 1113 then call iox_$modes (emacs_data.input_iocb, "force,8bit,no_outp", "", (0)); 1114 call iox_$control (emacs_data.input_iocb, "printer_off", null (), (0)); 1115 end; 1116 emacs_data.flags.in_emacs = "1"b; 1117 return; 1118 1119 1120 fix_modes_and_exit: 1121 call multics_tty_modes_setter; 1122 if code ^= 0 1123 then call signal_io_error (code, "Setting Multics tty modes."); 1124 return; 1125 1126 /* This entry resets the modes for Multics use */ 1127 1128 set_multics_tty_modes: 1129 entry (); 1130 emacs_data_ptr = e_find_invocation_ (); 1131 1132 call multics_tty_modes_setter; 1133 return; 1134 1135 multics_tty_modes_setter: 1136 procedure; 1137 1138 if emacs_data.input_iocb ^= null () then do; 1139 tty_mode_string = emacs_data.tty_modes; 1140 call iox_$modes (emacs_data.input_iocb, tty_mode_string, "", (0)); 1141 call iox_$control (emacs_data.input_iocb, "printer_on", null (), (0)); 1142 end; 1143 emacs_data.flags.in_emacs = "0"b; 1144 end multics_tty_modes_setter; 1145 1146 signal_io_error: 1147 procedure (reason, explanation); 1148 declare reason fixed bin (35); 1149 declare explanation character (*); 1150 1151 call sub_err_ (reason, emacs_data.myname, "s", null (), (0), 1152 "Emacs encountered an error. ^a. ^/Give the following command:^/file_output emacs_trace_;trace_stack;revert_output^/and save the results for programming staff.", 1153 explanation); 1154 1155 end signal_io_error; 1156 1157 /* This internal procedure negotiates via TELNET */ 1158 1159 negotiate: 1160 procedure (option, have_it_or_not); 1161 1162 dcl have_it_or_not bit (1) aligned, 1163 option fixed bin (8); 1164 1165 call dump_obuf; 1166 call ncp_send (IAC); 1167 if have_it_or_not 1168 then call ncp_send (WILL); 1169 else call ncp_send (WONT); 1170 call ncp_send (option); 1171 ne_ret: 1172 call dump_obuf; 1173 return; 1174 1175 ncp_send: 1176 proc (byte8); 1177 1178 dcl byte8 fixed bin (8); 1179 1180 1181 emacs_data.chars_in_obuf = emacs_data.chars_in_obuf + 1; 1182 substr (obuf, emacs_data.chars_in_obuf, 1) = byte (byte8); 1183 return; 1184 end ncp_send; 1185 end negotiate; 1186 1187 1188 /* Hacks for those rare people who like messages */ 1189 1190 /* 05/25/78 */ 1191 1192 message_acceptor: 1193 entry (P_intno_char, P_msgno, P_sender, P_msgtime, P_msgtext); 1194 1195 emacs_data_ptr = e_find_invocation_ (); 1196 1197 if ^emacs_data.flags.in_emacs then do; 1198 call ioa_$ioa_switch (iox_$user_io, "From ^a ^a:^/^a", P_sender, P_msgtime, P_msgtext); 1199 end; 1200 call set_emacs_interrupt (binary (P_intno_char, 17, 0), 0, (0)); 1201 allocate based_message_struc set (msgp); 1202 if emacs_data.first_msgp = null 1203 then emacs_data.first_msgp = msgp; 1204 else emacs_data.last_msgp -> based_message_struc.next = msgp; 1205 emacs_data.last_msgp = msgp; 1206 return; 1207 1208 retrieve_message: 1209 entry (P_retsender, P_rettime, P_retmsg); 1210 1211 emacs_data_ptr = e_find_invocation_ (); 1212 1213 if emacs_data.last_msgp = null 1214 then P_retsender, P_rettime, P_retmsg = ""; 1215 else do; 1216 msgp = emacs_data.first_msgp; 1217 P_retsender = rtrim (based_message_struc.sender); 1218 P_rettime = rtrim (based_message_struc.time); 1219 P_retmsg = rtrim (based_message_struc.msg); 1220 emacs_data.first_msgp = based_message_struc.next; 1221 if emacs_data.first_msgp = null 1222 then emacs_data.last_msgp = null; 1223 free based_message_struc; 1224 end; 1225 return; 1226 /**** This code added 31 July 1984 - K. P. Fleming */ 1227 1228 1229 dcl (PDmsgfmbx, PIint) ptr init (null ()); 1230 dcl (P_msgfmbx_ptr, P_PIint) ptr parameter; 1231 dcl P_code fixed bin (35) parameter; 1232 dcl Iint fixed bin (17) parameter; 1233 dcl int_index fixed bin (17); 1234 dcl message_facility_$get_last_message_info entry (ptr, ptr, fixed bin (35)); 1235 dcl 1 local_last_message_info aligned like last_message_info; 1236 dcl date_time fixed bin (71); 1237 dcl date_time_ entry (fixed bin (71), char (*)); 1238 dcl msg_date_time char (24); 1239 dcl message_sender char (120); 1240 dcl ioa_$rsnnl entry () options (variable); 1241 dcl (int_index_char, Imsg_char) char (8); 1242 dcl message_facility_$set_seen_switch entry (ptr, bit (72) aligned, bit (*), fixed bin (35)); 1243 dcl message_facility_$get_msgf_mbx_ptr entry (char (*), char (*), ptr, fixed bin (35)); 1244 dcl message_facility_$set_wakeup_state entry (ptr, bit (*), fixed bin (35)); 1245 dcl message_facility_$get_wakeup_state entry (ptr, bit (*), fixed bin (35)); 1246 dcl message_facility_$set_wakeup_handler entry (ptr, entry, ptr, fixed bin (35)); 1247 dcl message_facility_$send_message entry (char (*), char (*), char (*), ptr, fixed bin (35)); 1248 dcl NLSPHT char (3) aligned int static options (constant) init (" 1249 "); 1250 dcl mbx_path char (*) parm; 1251 dcl expand_pathname_$add_suffix entry (char (*), char (*), char (*), char (*), fixed bin (35)); 1252 dcl mbx_dname char (168); 1253 dcl mbx_ename char (32); 1254 dcl Swakeup_state bit (5); 1255 dcl 1 Dmail aligned like send_mail_info; 1256 dcl message char (*) parm; 1257 dcl user_info_$whoami entry (char (*)); 1258 dcl person_id char (32); 1259 dcl (person, project) char (*) parameter; 1260 dcl message_facility_$default_wakeup_handler entry (ptr, ptr); 1261 dcl user_info_$homedir entry (char (*)); 1262 dcl message_handler entry (ptr, ptr) variable; 1263 dcl 1 Dstates_overlay defined (Swakeup_state) like wakeup_flags; 1264 dcl (binary, bit, dimension, divide, empty, hbound, rank, rtrim, string, wordno, addr, before, setwordno, substr, unspec) 1265 builtin; 1266 1267 set_message_handler: 1268 entry (mbx_path, Iint, P_code); 1269 1270 P_code = 0; 1271 /**** Note: the next line of code contains a "kludge" that saves us a little 1272* bit of time and storage. The message_facility_ wants an info_ptr that it 1273* can pass to the wakeup handler for "static" information. The only thing 1274* we need to save in this manner is the Emacs interrupt number for this 1275* mbx. Thus, instead of allocating an array in emacs_data for the 1276* interrupt numbers to be stored "statically", we just pass a fake pointer 1277* to the message_facility_ that contains the interrupt number as its word 1278* offset, and the rest of it is just null(). 1279* 1280* -Kevin 1281**/ 1282 PIint = setwordno (null (), Iint); 1283 message_handler = message_wakeup_handler; 1284 call expand_pathname_$add_suffix (mbx_path, "mbx", mbx_dname, mbx_ename, P_code); 1285 if P_code ^= 0 1286 then return; 1287 SET_THE_HANDLER: 1288 call message_facility_$get_msgf_mbx_ptr (mbx_dname, mbx_ename, PDmsgfmbx, P_code); 1289 if P_code ^= 0 1290 then return; 1291 call message_facility_$get_wakeup_state (PDmsgfmbx, Swakeup_state, P_code); 1292 if P_code ^= 0 1293 then return; 1294 Dstates_overlay.wakeup_state = ACCEPT_MESSAGES; /* here's our where cover for the message facility */ 1295 call message_facility_$set_wakeup_state (PDmsgfmbx, Swakeup_state, P_code); 1296 if P_code ^= 0 1297 then return; 1298 call message_facility_$set_wakeup_handler (PDmsgfmbx, message_handler, PIint, P_code); 1299 return; 1300 1301 restore_message_handler: 1302 entry (P_code); /* arg is only to get parm var allocated */ 1303 P_code = 0; 1304 PIint = null (); 1305 message_handler = message_facility_$default_wakeup_handler; 1306 call user_info_$homedir (mbx_dname); 1307 call user_info_$whoami (mbx_ename); 1308 mbx_ename = rtrim (mbx_ename) || ".mbx"; 1309 go to SET_THE_HANDLER; 1310 1311 send_message: 1312 entry (person, project, message, P_code); 1313 P_code = 0; 1314 mbx_dname = ">udd>" || rtrim (project) || ">" || person; 1315 mbx_ename = rtrim (person) || ".mbx"; 1316 Dmail.version = send_mail_info_version_2; 1317 call user_info_$whoami (person_id); 1318 Dmail.sent_from = person_id; 1319 string (Dmail.switches) = ""b; 1320 Dmail.wakeup, Dmail.always_add = "1"b; 1321 call message_facility_$send_message (mbx_dname, mbx_ename, message, addr (Dmail), P_code); 1322 return; 1323 1324 message_wakeup_handler: 1325 entry (P_msgfmbx_ptr, P_PIint); 1326 int_index = wordno (P_PIint); 1327 code = 0; 1328 last_message_info_ptr = addr (local_last_message_info); 1329 last_message_info.version = LAST_MESSAGE_INFO_VERSION_1; 1330 call message_facility_$get_last_message_info (P_msgfmbx_ptr, last_message_info_ptr, code); 1331 if code ^= 0 /* Should probably sub_err_ or something, but I'm */ 1332 then return; /* not sure what. */ 1333 message_info_ptr = last_message_info.last_message_ptr; 1334 mail_format_ptr = message_info.message_ptr; 1335 date_time = fixed (substr (last_message_info.last_message_id, 19, 54), 71); 1336 call date_time_ (date_time, msg_date_time); 1337 if mail_format.sent_from = before (message_info.sender, ".") | mail_format.sent_from = "" 1338 | unspec (mail_format.sent_from) = ""b 1339 then message_sender = substr (message_info.sender, 1, length (rtrim (message_info.sender)) - 2); 1340 else message_sender = 1341 substr (message_info.sender, 1, length (rtrim (message_info.sender)) - 2) || " (" 1342 || rtrim (mail_format.sent_from) || ")"; 1343 call ioa_$rsnnl ("^d", int_index_char, (0), int_index); 1344 call ioa_$rsnnl ("^d", Imsg_char, (0), last_message_info.last_message_number); 1345 call message_facility_$set_seen_switch (P_msgfmbx_ptr, last_message_info.last_message_id, DELETE_UNHELD, (0)); 1346 call message_acceptor (int_index_char, Imsg_char, message_sender, msg_date_time, 1347 translate (rtrim (mail_format.text, NLSPHT), "", substr (collate9 (), 1, 32) || substr (collate9 (), 128))) 1348 ; 1349 return; /* End of new code */ 1350 1351 /* 1352* 1353* Interrupt mechanism for Multics EMACS 1354* 1355* Made useful for recursive emaces November 1978 1356* 1357**/ 1358 1359 get_emacs_interrupt_array: 1360 entry returns (ptr); 1361 1362 emacs_data_ptr = e_find_invocation_ (); 1363 1364 return (addr (emacs_data.interrupts.array)); 1365 1366 free_emacs_interrupt_array: 1367 entry; 1368 1369 return; 1370 1371 assign_channel: 1372 entry (P_interruptno) returns (fixed binary); 1373 1374 return (P_interruptno); 1375 1376 /* primitives to set and receive emacs interrupts */ 1377 1378 set_emacs_interrupt: 1379 entry (P_interruptno, P_interrupt_msg, P_intercode); 1380 1381 emacs_data_ptr = e_find_invocation_ (); 1382 1383 if emacs_data.flags.using_r0_echnego & ^emacs_data.flags.using_video then do; 1384 a3r: 1385 call hcs_$tty_read_echoed (emacs_data.ttyx, null (), 0, 0, (0), (0), 0, (0), code); 1386 if code ^= 0 1387 then call revalidate_tty (a3r); 1388 end; 1389 1390 call hcs_$wakeup (my_pid, bl.event, 0, (0)); 1391 P_intercode = 0; 1392 1393 emacs_data.interrupts.array (0) = 1; 1394 1395 allocate interrupt; 1396 interrupt.number = P_interruptno; 1397 interrupt.msg = P_interrupt_msg; 1398 interrupt.chain = null (); 1399 1400 if emacs_data.interrupts.head = null () 1401 then emacs_data.interrupts.head, emacs_data.interrupts.tail = intp; 1402 else do; 1403 emacs_data.interrupts.tail -> interrupt.chain = intp; 1404 emacs_data.interrupts.tail = intp; 1405 end; 1406 1407 return; 1408 1409 get_emacs_interrupt: 1410 entry (P_interruptno, P_interrupt_msg); 1411 1412 emacs_data_ptr = e_find_invocation_ (); 1413 1414 if emacs_data.interrupts.head = null () then do; 1415 P_interruptno = -1; 1416 return; 1417 end; 1418 intp = emacs_data.interrupts.head; 1419 emacs_data.interrupts.head = interrupt.chain; 1420 if emacs_data.interrupts.head = null () 1421 then emacs_data.interrupts.tail = null (); 1422 P_interruptno = interrupt.number; 1423 P_interrupt_msg = interrupt.msg; 1424 free interrupt; 1425 return; 1426 1427 set_message_cleanup: 1428 entry; 1429 1430 emacs_data_ptr = e_find_invocation_ (); 1431 1432 emacs_data.messages_were_sent_here = "1"b; 1433 return; 1434 1435 dump_out_console_messages: 1436 entry; 1437 1438 emacs_data_ptr = e_find_invocation_ (); 1439 1440 call free_emacs_interrupt_array; 1441 if ^emacs_data.messages_were_sent_here 1442 then return; 1443 call restore_message_handler ((0)); 1444 do while (emacs_data.first_msgp ^= null); 1445 msgp = emacs_data.first_msgp; 1446 call ioa_$ioa_switch (iox_$user_io, "From ^a ^a:^/^a", based_message_struc.sender, 1447 based_message_struc.time, based_message_struc.msg); 1448 emacs_data.first_msgp = based_message_struc.next; 1449 if emacs_data.first_msgp = null 1450 then emacs_data.last_msgp = null; 1451 free based_message_struc; 1452 end; 1453 return; 1454 1455 1456 /* Interfaces to determine/remember terminal type and line type. 1457* GMP, 8/27/78 */ 1458 1459 get_terminal_type: 1460 entry (a_terminal_type); /* get static terminl type */ 1461 1462 emacs_data_ptr = e_find_invocation_ (); 1463 1464 a_terminal_type = rtrim (emacs_data.terminal_type); 1465 1466 return; 1467 1468 set_terminal_type: 1469 entry (a_terminal_type1); 1470 1471 emacs_data_ptr = e_find_invocation_ (); 1472 1473 emacs_data.terminal_type = a_terminal_type1; 1474 1475 return; 1476 1477 get_real_terminal_type: 1478 entry (a_terminal_type); 1479 1480 emacs_data_ptr = e_find_invocation_ (); 1481 1482 if emacs_data.input_iocb = null () 1483 then emacs_data.input_iocb = iox_$user_input; 1484 1485 if emacs_data.flags.using_video then do; 1486 a_terminal_type = "video_system"; 1487 return; 1488 end; 1489 1490 /* Not video system; find out what kind of terminal. */ 1491 1492 tinfo.version = terminal_info_version; 1493 1494 call iox_$control (emacs_data.input_iocb, "terminal_info", addr (tinfo), code); 1495 1496 if code = 0 1497 then a_terminal_type = rtrim (tinfo.term_type); 1498 else a_terminal_type = "ASCII"; /* default value */ 1499 1500 return; 1501 1502 get_iocb: 1503 entry () returns (pointer); 1504 1505 emacs_data_ptr = e_find_invocation_ (); 1506 1507 return (emacs_data.input_iocb); 1508 1509 1510 get_editing_chars: 1511 entry (P_escape_char, P_erase_char, P_kill_char); 1512 1513 emacs_data_ptr = e_find_invocation_ (); 1514 1515 call iox_$control (emacs_data.input_iocb, "get_editing_chars", addr (editing_chars_v1), code); 1516 if code ^= 0 then do; 1517 call iox_$control (emacs_data.input_iocb, "get_editing_chars", addr (editing_chars_v2), code); 1518 if code = 0 then do; 1519 P_escape_char = "\"; 1520 P_erase_char = editing_chars_v2.erase_char; 1521 P_kill_char = editing_chars_v2.kill_char; 1522 return; 1523 end; 1524 end; 1525 if code = 0 then do; 1526 P_escape_char = editing_chars_v1.escape_char; 1527 P_erase_char = editing_chars_v1.erase_char; 1528 P_kill_char = editing_chars_v1.kill_char; 1529 return; 1530 end; 1531 P_escape_char = "\"; 1532 P_erase_char = "#"; 1533 P_kill_char = "@"; 1534 return; 1535 1536 get_network_flag: 1537 entry () returns (fixed binary); /* return 1 if a Network connection */ 1538 1539 return (0); /* No more network */ 1540 1541 /* Moby SUPDUP-OUTPUT negotiator (as per RFC 749) BSG 10/1/78 */ 1542 1543 1544 will_supdup_output: 1545 entry returns (fixed bin (1)); 1546 1547 emacs_data_ptr = e_find_invocation_ (); 1548 1549 if sdostate 1550 then return (1); /* OK as is */ 1551 /* Must try to negotiate it */ 1552 call negotiate (SUPDUP_OUTPUT, "1"b); /* Send the cmd */ 1553 do while ("1"b); /* Let's play TELNET! */ 1554 do while (get_char () ^= IAC); 1555 end; 1556 tempc = get_char (); 1557 if tempc = DO then do; 1558 tempc = get_char (); 1559 if tempc = SUPDUP_OUTPUT 1560 then ; 1561 if tempc = ECHO 1562 then ; 1563 end; 1564 if tempc = DONT then do; 1565 tempc = get_char (); 1566 if tempc = SUPDUP_OUTPUT 1567 then return (0); 1568 if tempc = ECHO 1569 then ; 1570 end; 1571 if tempc = WILL | tempc = WONT then do; 1572 tempc = get_char (); 1573 end; 1574 if tempc = SB then do; 1575 tempc = get_char (); 1576 if tempc = SUPDUP_OUTPUT then do; 1577 tempc = get_char (); 1578 if tempc ^= 1 1579 then go to run_out_sb; 1580 string (sddata) = "0"b; 1581 do sdbct = 0 to (hbound (sddata, 1)); 1582 tempc = get_char (); 1583 if tempc = IAC 1584 then go to sdd_gotten; 1585 sddata (sdbct) = bit (fixed (tempc, 6), 6); 1586 end; 1587 do while (get_char () ^= IAC); 1588 end; 1589 sdd_gotten: 1590 tempc = get_char (); 1591 unspec (supdup_info) = string (sddata); 1592 sdostate = "1"b; 1593 return (1); 1594 end; 1595 run_out_sb: 1596 do while (get_char () ^= IAC); 1597 end; 1598 tempc = get_char (); 1599 end; 1600 1601 end; 1602 1603 return_supdup_info: 1604 entry (a_ttyopt, a_mxh, a_mxv); 1605 1606 emacs_data_ptr = e_find_invocation_ (); 1607 1608 a_ttyopt = supdup_info.ttyopt; 1609 a_mxh = supdup_info.tcmxh; 1610 a_mxv = supdup_info.tcmxv; 1611 return; 1612 1613 object_check: 1614 entry (P_bc, P_pointer) returns (fixed bin); 1615 1616 call object_info_$brief (P_pointer, P_bc, addr (bit_bucket), code); 1617 if code = 0 1618 then return (1); 1619 return (0); 1620 1621 check_window_code: 1622 procedure (excuse, code, retry); 1623 1624 declare excuse character (*); 1625 declare code fixed bin (35); 1626 declare retry bit (1) aligned; 1627 1628 declare video_et_$window_status_pending fixed bin (35) ext static; 1629 declare 1 wsi aligned like window_status_info; 1630 1631 if code = video_et_$window_status_pending then do; 1632 wsi.version = window_status_version; 1633 call iox_$control (emacs_data.input_iocb, "get_window_status", addr (wsi), code); 1634 if code ^= 0 1635 then call signal_io_error (code, "Error from get_window_status"); 1636 retry = "1"b; 1637 code = 0; 1638 return; 1639 end; 1640 1641 if code = 0 then do; 1642 retry = "0"b; 1643 return; 1644 end; 1645 1646 call signal_io_error (code, "Error from window_$" || excuse); 1647 return; 1648 end check_window_code; 1649 1650 check_for_window_status: 1651 entry (code_to_check); 1652 1653 emacs_data_ptr = e_find_invocation_ (); 1654 call check_window_code ("<