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