1 /* Copyright (c) 1992, 1999, 2001, 2002 John E. Davis
2 * This file is part of the S-Lang library.
3 *
4 * You may distribute under the terms of either the GNU General Public
5 * License or the Perl Artistic License.
6 */
7 #include "slinclud.h"
8
9 #include <ssdef.h>
10 #include <rmsdef.h>
11 #include <dvidef.h>
12 #include <jpidef.h>
13 #include <descrip.h>
14 #include <iodef.h>
15 #include <ttdef.h>
16 #include <tt2def.h>
17 #include <rms.h>
18 #include <errno.h>
19
20 #ifdef __DECC
21 #include <starlet.h>
22 #include <lib$routines>
23 #endif
24
25 #include "slang.h"
26 #include "_slang.h"
27
28 /* If this function returns -1, ^Y will be added to input buffer. */
29 int (*SLtty_VMS_Ctrl_Y_Hook) (void);
30
31 typedef struct { /* I/O status block */
32 short i_cond; /* Condition value */
33 short i_xfer; /* Transfer count */
34 long i_info; /* Device information */
35 } Iosb_Type;
36
37 typedef struct { /* Terminal characteristics */
38 char t_class; /* Terminal class */
39 char t_type; /* Terminal type */
40 short t_width; /* Terminal width in characters */
41 long t_mandl; /* Terminal's mode and length */
42 long t_extend; /* Extended terminal characteristics */
43 } TermChar_Type;
44
45 static TermChar_Type Old_Term_Char, New_Term_Char;
46
47 /* This serves to identify the channel we are reading input from. */
48 static short This_Term;
49
50 typedef struct
51 {
52 short buflen;
53 short item_code;
54 int *buf_addr;
55 int *len_addr;
56 } item_list_3;
57
58 static int TTY_Inited;
59
60 /*
61 * Exit Handler Control Block
62 */
63 static struct argument_block
64 {
65 int forward_link;
66 int (*exit_routine)();
67 int arg_count;
68 int *status_address;
69 int exit_status;
70 }
71 exit_block =
72 {
73 0,
74 NULL,
75 1,
76 &exit_block.exit_status,
77 0
78 };
79
vms_cancel_exithandler()80 static void vms_cancel_exithandler()
81 {
82 sys$canexh(exit_block);
83 }
84
vms_exit_handler()85 static int vms_exit_handler ()
86 {
87 if (TTY_Inited == 0) return 0;
88 SLang_reset_tty ();
89 return 0;
90 }
91
92 static int vms_input_buffer;
93
94 static struct vms_ast_iosb
95 {
96 short status;
97 short offset;
98 short termlen;
99 short term;
100 } vms_ast_iosb;
101
102 static void vms_que_key_ast();
103 static int Ast_Fired_Event_Flag;
104 static int Timer_Event_Flag;
105 static int Event_Flag_Mask;
106 static int Ast_Stop_Input;
107 static int Waiting_For_Ast;
108
getkey_ast(int not_used)109 static int getkey_ast(int not_used)
110 {
111 unsigned int c = 1000;
112
113 if (vms_ast_iosb.offset)
114 {
115 c = (unsigned int) vms_input_buffer;
116 }
117
118 if (c <= 255)
119 {
120 if (c == SLang_Abort_Char)
121 {
122 if (SLang_Ignore_User_Abort == 0) SLang_Error = SL_USER_BREAK;
123 SLKeyBoard_Quit = 1;
124 }
125
126 if ((c != 0x19) /* ^Y */
127 || (SLtty_VMS_Ctrl_Y_Hook == NULL)
128 || (-1 == (*SLtty_VMS_Ctrl_Y_Hook) ()))
129 {
130 if (SLang_Input_Buffer_Len < SL_MAX_INPUT_BUFFER_LEN - 3)
131 SLang_Input_Buffer[SLang_Input_Buffer_Len++] = c;
132 }
133 }
134
135 if (Waiting_For_Ast) sys$setef (Ast_Fired_Event_Flag);
136 Waiting_For_Ast = 0;
137 vms_que_key_ast();
138 return (1);
139 }
140
vms_que_key_ast()141 static void vms_que_key_ast()
142 {
143 static int trmmsk [2] = { 0, 0 };
144 int status;
145
146 if (Ast_Stop_Input) return;
147 status = sys$qio (0, This_Term,
148 IO$_READVBLK | IO$M_NOECHO | IO$_TTYREADALL,
149 &vms_ast_iosb, getkey_ast, 1,
150 &vms_input_buffer, 1, 0, trmmsk, 0, 0);
151 }
152
153 static char TTY_Name[8];
154 static int This_Process_Pid;
155
156 /* FIXME: priority=medium
157 * The keypad state may have been tampered with by the application. So, I
158 * need to get the keypad status at initialization time and then reset it
159 * in the call to SLang_reset_tty. Unfortunately, this will most likely
160 * involve interaction with the sldisply interface.
161 */
SLang_init_tty(int a,int flow,int out)162 int SLang_init_tty (int a, int flow, int out)
163 {
164 Iosb_Type iostatus;
165 int tmp, name_len, status, lastppid, ppid;
166 item_list_3 itmlst[3];
167 $DESCRIPTOR ( term, TTY_Name);
168
169 itmlst[0].buflen = sizeof(int);
170 itmlst[0].item_code = JPI$_PID;
171 itmlst[0].buf_addr = &This_Process_Pid;
172 itmlst[0].len_addr = &tmp;
173
174 itmlst[1].buflen = 7;
175 itmlst[1].item_code = JPI$_TERMINAL;
176 itmlst[1].buf_addr = (int *) TTY_Name;
177 itmlst[1].len_addr = &name_len;
178
179 itmlst[2].buflen = 0;
180 itmlst[2].item_code = 0;
181 itmlst[2].buf_addr = 0;
182 itmlst[2].len_addr = 0;
183
184 if (a == -1) a = 3; /* ^C */
185 SLang_Abort_Char = a;
186 TTY_Inited = 1;
187 ppid = 0, lastppid = -1;
188
189 /* Here I get this process pid then I get the master process pid
190 and use the controlling terminal of that process. */
191 while (1)
192 {
193 status = sys$getjpiw(0, /* event flag */
194 &ppid, /* pid address */
195 0, /* proc name address */
196 itmlst,
197 0, 0, 0);
198
199 if (status != SS$_NORMAL)
200 {
201 fprintf(stderr, "PID: %X, status: %X\n", This_Process_Pid, status);
202 exit(1);
203 }
204
205 if (lastppid == ppid) break;
206 lastppid = ppid;
207
208 itmlst[0].item_code = JPI$_MASTER_PID;
209 itmlst[0].buf_addr = &ppid;
210 }
211
212 term.dsc$w_length = name_len;
213 status = sys$assign ( &term, &This_Term, 0, 0 );
214 if (status != SS$_NORMAL)
215 {
216 fprintf(stderr,"Unable to assign input channel\n");
217 fprintf(stderr,"PID: %X, DEV %s, status: %d\n", This_Process_Pid, TTY_Name, status);
218 exit(0);
219 }
220
221 if (NULL == exit_block.exit_routine)
222 {
223 exit_block.exit_routine = (int (*)()) vms_exit_handler;
224 sys$dclexh(&exit_block);
225 }
226
227 /* allocate an event flag and clear it--- used by ast routines. Since
228 * I am only using a few local event flags, there is really no need to
229 * worry about freeing these.
230 *
231 * The event flags are used to avoid timing problems with the getkey AST
232 * as well as for a form of time out.
233 */
234 if (!Ast_Fired_Event_Flag) lib$get_ef (&Ast_Fired_Event_Flag);
235 sys$clref (Ast_Fired_Event_Flag);
236
237 if (!Timer_Event_Flag) lib$get_ef (&Timer_Event_Flag);
238 sys$clref (Timer_Event_Flag);
239
240 /* The working assumption here is that the event flags are in the same
241 * cluster. They need not be but it is very likely that they are.
242 */
243 Event_Flag_Mask = ((unsigned) 1 << (Ast_Fired_Event_Flag % 32));
244 Event_Flag_Mask |= ((unsigned) 1 << (Timer_Event_Flag % 32));
245
246 Waiting_For_Ast = 0;
247 Ast_Stop_Input = 0;
248
249 /* Get the startup terminal characteristics */
250 status = sys$qiow(0, /* Wait on event flag zero */
251 This_Term, /* Channel to input terminal */
252 IO$_SENSEMODE, /* Get current characteristic */
253 &iostatus, /* Status after operation */
254 0, 0, /* No AST service */
255 &Old_Term_Char, /* Terminal characteristics buf */
256 sizeof(Old_Term_Char),/* Size of the buffer */
257 0, 0, 0, 0);
258
259 New_Term_Char = Old_Term_Char;
260 New_Term_Char.t_mandl |= TT$M_EIGHTBIT | TT$M_NOECHO;
261 New_Term_Char.t_extend |= TT2$M_PASTHRU | TT2$M_XON;
262
263 status = sys$qiow(0, /* Wait on event flag zero */
264 This_Term, /* Channel to input terminal */
265 IO$_SETMODE, /* Set current characteristic */
266 &iostatus, /* Status after operation */
267 0, 0, /* No AST service */
268 &New_Term_Char, /* Terminal characteristics buf */
269 sizeof(New_Term_Char),/* Size of the buffer */
270 0, 0, 0, 0);
271
272 vms_que_key_ast(); /* set up the key ast */
273 return 0;
274 }
275
cancel_ast(void)276 static void cancel_ast (void)
277 {
278 if (TTY_Inited == 0) return;
279
280 /* stop the keyboard ast */
281 sys$setast (0); /* disable AST delivery */
282 sys$clref (Ast_Fired_Event_Flag);
283 Waiting_For_Ast = 1;
284 Ast_Stop_Input = 1;
285
286 /* cancel all i/o on this channel. This canels pending, as well as those
287 * already in progress and queued. In particular, according to the
288 * manuals, cancelling I/O on the channel will cause the getkey AST
289 * to fire even though the sys$qio call was aborted. This is crucial
290 * because below we wait for the AST to set the event flag.
291 */
292 sys$cancel (This_Term);
293 sys$setast (1); /* enable ASTs again */
294 sys$waitfr (Ast_Fired_Event_Flag); /* sleep until it fires */
295 Waiting_For_Ast = 0;
296 }
297
SLang_reset_tty(void)298 void SLang_reset_tty (void)
299 {
300 Iosb_Type iostatus;
301
302 if (!TTY_Inited) return;
303
304 cancel_ast ();
305 TTY_Inited = 0;
306
307 /* reset the terminal characteristics */
308
309 sys$qiow(0, /* event flag 0 */
310 This_Term, /* Channel to input terminal */
311 IO$_SETMODE, /* Set current characteristic */
312 &iostatus, /* Status after operation */
313 0, 0, /* No AST service */
314 &Old_Term_Char, /* Terminal characteristics buf */
315 sizeof(Old_Term_Char), /* Size of the buffer */
316 0, 0, 0, 0); /* unused */
317
318 }
319
_SLsys_getkey()320 unsigned int _SLsys_getkey()
321 {
322 unsigned int c;
323
324 if (SLKeyBoard_Quit) return((unsigned int) SLang_Abort_Char);
325
326 /* On VMS, the keyboard ast routine should be stuffing the buffer, so
327 do nothing except sleep */
328
329 /* clear the flag which ast will set */
330 Waiting_For_Ast = 0;
331
332 if (SLang_Input_Buffer_Len) return(SLang_getkey());
333 while (!_SLsys_input_pending(450));
334 c = SLang_getkey();
335 return(c);
336 }
337
338 /* waits *secs tenth of seconds for input */
_SLsys_input_pending(int tsecs)339 int _SLsys_input_pending(int tsecs)
340 {
341 unsigned long daytim[2];
342
343 if (SLang_Input_Buffer_Len) return(SLang_Input_Buffer_Len);
344
345 if (tsecs < 0)
346 tsecs = -tsecs/100; /* tsecs is ms, convert to 1/10 sec */
347
348 if (tsecs)
349 {
350 /* takes a quad word time. If negative, use a relative time. */
351 daytim[1] = 0xFFFFFFFF;
352 daytim[0] = -(tsecs * 1000 * 1000);
353 /* 1000 * 1000 is a tenth of a sec */
354
355 sys$clref (Ast_Fired_Event_Flag);
356 /* sys$clref (Timer_Event_Flag); sys$setimr call clears this */
357
358 /* set up a flag for the ast so it knows to set the event flag */
359 Waiting_For_Ast = 1;
360
361 sys$setimr(Timer_Event_Flag, daytim, 0, 1);
362
363 /* this will return when ast does its job or timer expires.
364 * The first argument simply serves to identify the cluster for
365 * the event flag and that is all. The second argument serves
366 * to identify the event flags to wait for.
367 */
368 sys$wflor (Ast_Fired_Event_Flag, Event_Flag_Mask);
369
370 Waiting_For_Ast = 0;
371
372 /* cancel the timer */
373 sys$cantim(1, 3); /* 3 is user mode */
374 }
375 return (SLang_Input_Buffer_Len);
376 }
377
SLang_set_abort_signal(void (* f)(int))378 int SLang_set_abort_signal (void (*f)(int))
379 {
380 return 0;
381 }
382
383