?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Fix for BCPL string handling.
[AROS-Contrib.git] / regina / vmsfuncs.c
blobaa69e58262a55ad81419bb8e07b40a6cc1132ea0
1 /*
2 * The Regina Rexx Interpreter
3 * Copyright (C) 1992 Anders Christensen <anders@pvv.unit.no>
4 *
5 * This library is free software; you can redistribute it and/or
6 * modify it under the terms of the GNU Library General Public
7 * License as published by the Free Software Foundation; either
8 * version 2 of the License, or (at your option) any later version.
9 *
10 * This library is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 * Library General Public License for more details.
14 *
15 * You should have received a copy of the GNU Library General Public
16 * License along with this library; if not, write to the Free
17 * Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
18 */
19 /* huups, have to add one to length in everyting given to Str_ncatstr */
20
21 #include "rexx.h"
22 #include "strings.h"
23
24 #include <assert.h>
25 #include <stdio.h>
26
27 #include <descrip.h>
28 #include <rmsdef.h>
29 #include <ssdef.h>
30 #include <dvidef.h>
31 #include <jpidef.h>
32 #include <quidef.h>
33 #include <syidef.h>
34 #include <uicdef.h>
35 #include <libdtdef.h>
36 #include <jbcmsgdef.h>
37 #include <lnmdef.h>
38 #include <psldef.h>
39 #include <libdef.h>
40 #include <libdtdef.h>
41
42 #include <fab.h>
43 #include <nam.h>
44 #include <xab.h>
45
46 #define MAX_PATH_LEN 64
47
48 #define HEX_DIGIT(a) (((a)<10)?((a)+'0'):((a)-10+'A'))
49 #define ADD_CHAR(a,b) (a)->value[(a)->len++] = (b)
50 #define MAX(a,b) (((a)>(b))?(a):(b))
51 #define MIN(a,b) (((a)<(b))?(a):(b))
52
53
54 typedef struct cli_block {
55 short length ;
56 char type ;
57 char subtype ;
58 short flags ;
59 short TRO_cnt ;
60 } cli_block ;
61
62 typedef struct com_block {
63 unsigned char handler ;
64 unsigned char sizes ;
65 unsigned char verbtype ;
66 unsigned char pad ;
67 short name ;
68 short image ;
69 short outputs ;
70 short prefix ;
71 } com_block ;
72
73 struct fabptr {
74 struct fabptr *next ;
75 int num ;
76 streng *name ;
77 struct FAB *box ;
78 } ;
79
80 /* f$cvsi() */
81 /* f$cvtime() */
82 /* f$cvui() */
83
84 /*
85 * Values to be returned by the ACPTYPE item of sys$getdvi ... return
86 * value is an index into this list of strings. Yes ... I know, this
87 * is not the way to do it, but I don't know of any structure in the
88 * library that hold this information. Whenever porting Regina to a new
89 * version of VMS, make sure that this info is correct (check macros in
90 * the file dvidef.h).
91 */
92
93 #define NUM_ACP_CODES ((sizeof(acp_codes)/sizeof(char*))-1)
94 static const char *acp_codes[] = {
95 "ILLEGAL", "F11CV1", "F11V2", "MTA", "NET", "REM"
96 } ;
97
98 #define NUM_JPI_MODES ((sizeof(jpi_modes)/sizeof(char*))-1)
99 static const char *jpi_modes[] = {
100 "OTHER", "NETWORK", "BATCH", "INTERACTIVE"
101 } ;
102
103
104 #define NUM_SCH_TYPES ((sizeof(sch_types)/sizeof(char*))-1)
105 static const char *sch_types[] = {
106 "UNKNOWN", "CEF", "COM", "COMO", "CUR", "COLPG", "FPG", "HIB", "HIBO",
107 "LEF", "LEFO", "MWAIT", "PFW", "SUSP", "SUSPO"
108 } ;
109
110 typedef struct { /* vms_tsf: static variables of this module (thread-safe) */
111 char * error_buffer;
112 struct dsc$descriptor_s error_descr;
113 int pid;
114 struct fabptr * fabptrs[16];
115 } vmf_tsd_t; /* thread-specific but only needed by this module. see
116 * init_vmf
117 */
118
119
120 /* init_vmf initializes the module.
121 * Currently, we set up the thread specific data.
122 * The function returns 1 on success, 0 if memory is short.
123 */
124 int init_vmf( tsd_t *TSD )
125 {
126 vmf_tsd_t *vt;
127
128 if (TSD->vmf_tsd != NULL)
129 return(1);
130
131 if ((vt = TSD->vmf_tsd = MallocTSD(sizeof(vmf_tsd_t))) == NULL)
132 return(0);
133 memset(vt,0,sizeof(vmf_tsd_t)); /* correct for all values */
134 return(1);
135 }
136
137 static char *select_code( const int code, const char *values[], const int max )
138 {
139 return (char *)values[((code<1)||(code>max)) ? 0 : code] ;
140 }
141
142 static const char *all_privs[] = {
143 "CMKRNL", "CMEXEC", "SYSNAM", "GRPNAM", "ALLSPOOL", "DETACH",
144 "DIAGNOSE", "LOG_IO", "GROUP", "ACNT", "PRMCEB", "PRMMBX",
145 "PSWAPM", "SETPRI", "SETPRV", "TMPMBX", "WORLD", "MOUNT",
146 "OPER", "EXQUOTA", "NETMBX", "VOLPRO", "PHY_IO", "BUGCHK",
147 "PRMGBL", "SYSGBL", "PFNMAP", "SHMEM", "SYSPRV", "BYPASS",
148 "SYSLCK", "SHARE", "UPGRADE", "DOWNGRADE", "GRPPRV", "READALL",
149 "", "", "SECURITY", ""
150 } ;
151
152 #define NUM_PRIVS ((sizeof(all_privs)/sizeof(char*)))
153
154
155 static void vms_error( const tsd_t *TSD, const int err )
156 {
157 unsigned short length ;
158 unsigned int rc ;
159 vmf_tsd_t *vt;
160
161 vt = TSD->vmf_tsd;
162 if (!vt->error_buffer)
163 {
164 vt->error_descr.dsc$a_pointer = vt->error_buffer = MallocTSD( 256+1 ) ;
165 vt->error_descr.dsc$w_length = 256 ;
166 vt->error_descr.dsc$b_dtype = DSC$K_DTYPE_T ;
167 vt->error_descr.dsc$b_class = DSC$K_CLASS_S ;
168 }
169
170 rc=sys$getmsg( err, &length, &vt->error_descr, NULL, NULL ) ;
171 if (rc != SS$_NORMAL)
172 exiterror( ERR_SYSTEM_FAILURE , 0 ) ;
173
174 vt->error_buffer[length] = 0x00 ;
175 printf( "\n" ) ;
176 fprintf( stderr, "%s\n", vt->error_buffer ) ;
177 }
178
179
180 static streng *internal_id( const tsd_t *TSD, const short *id )
181 {
182 streng *result ;
183
184 result = Str_makeTSD( 20 ) ;
185 sprintf( result->value, "(%d,%d,%d)", id[0], id[1], id[2] ) ;
186 result->len = strlen( result->value ) ;
187 return( result ) ;
188 }
189
190 static int name_to_num( const tsd_t *TSD, const streng *name )
191 {
192 int id, rc ;
193 $DESCRIPTOR( descr, "" ) ;
194
195 descr.dsc$w_length = name->len ;
196 descr.dsc$a_pointer = (char *)name->value ;
197 rc = sys$asctoid( &descr, &id, NULL ) ;
198 if (rc == SS$_NOSUCHID || rc == SS$_IVIDENT)
199 return 0 ;
200 if (rc != SS$_NORMAL)
201 vms_error( TSD, rc ) ;
202
203 return (id) ;
204 }
205
206
207 static streng *num_to_name( const tsd_t *TSD, const int num )
208 {
209 char user[256], group[256] ;
210 $DESCRIPTOR( udescr, user ) ;
211 $DESCRIPTOR( gdescr, group ) ;
212 streng *result ;
213 short length, glength ;
214 int rc, xnum, context, theid ;
215
216 if (num == 0)
217 return NULL ;
218
219 if (!(num & 0x80000000))
220 {
221 xnum = num | 0x0000ffff ;
222 rc = sys$idtoasc( xnum, &glength, &gdescr, NULL, NULL, NULL) ;
223 if (rc == SS$_NOSUCHID)
224 glength = -1 ;
225 else if (rc != SS$_NORMAL)
226 {
227 vms_error( TSD, rc ) ;
228 glength = -1 ;
229 }
230 }
231 else
232 glength = -1 ;
233
234 rc = sys$idtoasc( num, &length, &udescr, NULL, NULL, NULL ) ;
235
236 if (rc == SS$_NOSUCHID)
237 return NULL ;
238 if (rc != SS$_NORMAL)
239 {
240 vms_error( TSD, rc ) ;
241 length = 0 ;
242 }
243
244 if (glength > -1)
245 {
246 result = Str_makeTSD( glength + 1 + length ) ;
247 Str_ncatstrTSD( result, group, glength ) ;
248 result->value[result->len++] = ',' ;
249 }
250 else
251 result = Str_makeTSD( length ) ;
252
253 Str_ncatstrTSD( result, user, length ) ;
254 return result ;
255 }
256
257
258 static streng *get_prot( const tsd_t *TSD, int prot )
259 {
260 char *names[] = { "SYSTEM", "OWNER", "GROUP", "WORLD" } ;
261 int i ;
262 streng *result ;
263
264 result = Str_makeTSD( 50 ) ;
265 for (i=0; i<4; i++)
266 {
267 Str_catstrTSD( result, names[i] ) ;
268 if ((prot & 0x0f) != 0x0f)
269 {
270 /* DCL-bug: says RWED, should say RWLP */
271 ADD_CHAR(result, '=') ;
272 if (!(prot & 0x01)) ADD_CHAR(result, 'R') ;
273 if (!(prot & 0x02)) ADD_CHAR(result, 'W') ;
274 if (!(prot & 0x04)) ADD_CHAR(result, 'E') ; /* actually L */
275 if (!(prot & 0x08)) ADD_CHAR(result, 'D') ; /* actually P */
276 }
277 ADD_CHAR( result, ',' ) ;
278 ADD_CHAR( result, ' ' ) ;
279 prot = prot >> 4 ;
280 }
281 result->len -= 2 ;
282 return result ;
283 }
284
285 static streng *get_uic( const tsd_t *TSD, const union uicdef *uic )
286 {
287 streng *name ;
288 streng *result ;
289
290 result = Str_makeTSD( 14 ) ;
291 name = num_to_name( TSD, uic->uic$l_uic ) ;
292 if (name)
293 {
294 ADD_CHAR( result, '[' ) ;
295 Str_catTSD( result, name ) ;
296 ADD_CHAR( result, ']' ) ;
297 }
298 else
299 {
300 sprintf(result->value,"[%o,%o]", uic->uic$v_group, uic->uic$v_member) ;
301 result->len = strlen( result->value ) ;
302 }
303 return result ;
304 }
305
306
307 struct dvi_items_type {
308 int type ; /* Datatype returned from item, see DVI_ macros above */
309 char *name ; /* Parameter that identifies a particular vitem */
310 int addr ; /* Item identifyer to give to sys$getdvi */
311 } ;
312
313
314 struct item_list {
315 union {
316 struct {
317 short code ;
318 short length ;
319 } norm ;
320 int terminator ; } frst ;
321 char *buffer ;
322 int *length ;
323 } ;
324
325 /*
326 * Here comes the code to implement the SYS$GETDVI() system service,
327 * which is largely the same as the F$GETDVI() lexical function. There
328 * are some minor differences, though.
329 */
330
331 #define TYP_HEX 1 /* 4 byte unsigned hex integer */
332 #define TYP_ACP 2 /* ACP type code, or 'ILLEGAL' */
333 #define TYP_BOOL 3 /* 4 byte boolean integer */
334 #define TYP_LSTR 4 /* 64 byte character string */
335 #define TYP_4STR 5 /* 4 byte character string */
336 #define TYP_VEC 6 /* 4 byte unsigned integer */
337 #define TYP_INT 7 /* 4 byte signed integer */
338 #define TYP_UIC 8 /* 4 byte user identification code */
339 #define TYP_SSTR 9 /* 12 byte character string */
340 #define TYP_PROT 10 /* 4 byte protection mask */
341 #define TYP_LHEX 11 /* 64 byte binary string, interpreted as hex */
342 #define TYP_PRIV 12
343 #define TYP_TIME 13
344 #define TYP_MODE 14
345 #define TYP_SCHT 15
346 #define TYP_DTIM 16
347 #define TYP_MSTR 17
348 #define TYP_FLAG 18
349 #define TYP_TRNM 19
350 #define TYP_BSTR 20 /* Binary string, don't strip away ASCII zeros */
351
352 #define TYP_EXST 1 + 128 /* DVI$_EXISTS */
353 #define TYP_SPLD 2 + 128 /* force primary characteristics DVI$_DEVNAM */
354
355 #define TYP_SPECIFICS 1024
356 #define TYP_FLF 1024
357 #define TYP_FLS 1 + 1024
358 #define TYP_FMF 2 + 1024
359 #define TYP_JBF 3 + 1024
360 #define TYP_JBS 4 + 1024
361 #define TYP_PJR 5 + 1024
362 #define TYP_QUF 6 + 1024
363 #define TYP_QUS 7 + 1024
364
365 static streng *format_result( const tsd_t *TSD, const int type, const char *buffer, int length )
366 {
367 streng *result ;
368 int *iptr = (int *)&(buffer[0]) ;
369 int i ;
370
371 switch (type)
372 {
373 case TYP_INT:
374 case TYP_VEC:
375 result = Str_makeTSD( 12 ) ;
376 /* sprintf( result->value, ((type==TYP_INT) ? "%d" : "%u"), *iptr ) ; */
377 sprintf( result->value, "%d", *iptr ) ; /* DCL-bug */
378 result->len = strlen( result->value ) ;
379 assert( result->len < result->max ) ;
380 break ;
381
382 case TYP_LHEX:
383 {
384 int i ;
385
386 result = Str_makeTSD( length * 2 ) ;
387 for (i=0; i<length; i++)
388 {
389 result->value[i*2] = HEX_DIGIT((buffer[length-i-1] >> 4) & 0x0f);
390 result->value[i*2+1] = HEX_DIGIT(buffer[length-i-1] & 0x0f) ;
391 }
392 result->len = length * 2 ;
393 break ;
394 }
395
396 case TYP_DTIM:
397 {
398 int timer = *((int*)buffer) ;
399 int days, hour, min, sec, hund ;
400 result = Str_makeTSD( 17 ) ;
401
402 hund = timer % 100 ; timer /= 100 ;
403 sec = timer % 60 ; timer /= 60 ;
404 min = timer % 60 ; timer /= 60 ;
405 hour = timer % 24 ;
406 days = timer / 24 ;
407
408 result->len = 16 ;
409 sprintf( result->value, "%4d %02d:%02d:%02d.%02d",
410 days, hour, min, sec, hund ) ;
411
412 break ;
413 }
414
415 case TYP_TIME:
416 {
417 int length, rc ;
418 $DESCRIPTOR( desc, "" ) ;
419 result = Str_makeTSD( 50 ) ;
420 desc.dsc$a_pointer = result->value ;
421 desc.dsc$w_length = 50 ;
422
423 rc = lib$format_date_time( &desc, buffer, NULL, &length, NULL ) ;
424 if (rc != SS$_NORMAL)
425 vms_error( TSD, rc ) ;
426
427 result->len = length ;
428 break ;
429 }
430
431 case TYP_HEX:
432 if (*iptr)
433 {
434 result = Str_makeTSD( 9 ) ;
435 sprintf( result->value, "%08X", *iptr ) ;
436 result->len = strlen( result->value ) ;
437 }
438 else
439 result = nullstringptr() ;
440
441 assert( result->len < result->max ) ;
442 break ;
443
444 case TYP_ACP:
445 result = Str_creTSD(select_code( *iptr, acp_codes, NUM_ACP_CODES )) ;
446 break ;
447
448 case TYP_SCHT:
449 result = Str_creTSD(select_code( *iptr, sch_types, NUM_SCH_TYPES )) ;
450 break ;
451
452 case TYP_MODE:
453 result = Str_creTSD(select_code( *iptr, jpi_modes, NUM_JPI_MODES )) ;
454 break ;
455
456 case TYP_PRIV:
457 {
458 result = Str_makeTSD(256) ;
459 for (i=0; i<NUM_PRIVS; i++)
460 if (buffer[i/8] & (1<<(i%8)))
461 {
462 Str_catstrTSD( result, all_privs[i] ) ;
463 ADD_CHAR( result, ',' ) ;
464 }
465 if (result->len)
466 result->len-- ;
467 break ;
468 }
469
470 case TYP_BOOL:
471 result = Str_creTSD( (*iptr) ? "TRUE" : "FALSE" ) ;
472 break ;
473
474 case TYP_LSTR:
475 case TYP_SSTR:
476 case TYP_4STR:
477 case TYP_MSTR:
478 for (;length && buffer[length-1]==0x00; length--) ;
479 case TYP_BSTR:
480 {
481 result = Str_ncreTSD( buffer, length ) ;
482 break ;
483 }
484
485 case TYP_UIC:
486 {
487 result = get_uic( TSD, ( union uicdef *)buffer ) ;
488 break ;
489 }
490
491 case TYP_PROT:
492 {
493 result = get_prot( TSD, *iptr ) ;
494 break ;
495 }
496
497 default:
498 exiterror( ERR_INTERPRETER_FAILURE, 1, __FILE__, __LINE__, "" ) ;
499
500 }
501 return result ;
502 }
503
504
505
506 #define DVI_XXX 1 /* Must be treated as a special case */
507 #define DVI_INT 2 /* 4 byte integer */
508 #define DVI_BOOL 3 /* 4 byte boolean */
509 #define DVI_LSTR 4 /* 64 byte ASCII string */
510 #define DVI_SSTR 5 /* 12 byte ASCII string */
511 #define DVI_4STR 6 /* 4 byte ASCII string */
512 #define DVI_HEX 7 /* 4 byte hexadecimal number */
513 #define DVI_ACP 8 /* 4 byte integer index into list */
514 #define DVI_UIC 9 /* 4 byte VMS UIC */
515 #define DVI_VEC 10 /* 4 byte vector of bitvalues */
516 #define DVI_PROT 11 /* 4 byte protection mask */
517 #define DVI_PRIV 12 /* 64 bit privilege mask */
518 #define DVI_MODE 13 /* index into list of jpi_mode_list */
519 #define DVI_TIME 14 /* 64 bit absolute time */
520 #define DVI_STR 15
521 #define DVI_PID 16
522 #define DVI_HTYP 17
523
524 #define DVI_BIN DVI_HTYP /* More or less the same */
525
526 #define DVI_XXX_EXISTS 1
527
528
529 static streng *strip_nulls( streng *input )
530 {
531 int i ;
532
533 for (i=input->len-1; (i>=0) && isspace(input->value[i]); i--) ;
534 input->len = i+1 ;
535 return input ;
536 }
537
538
539 #define HEXDIG(x) ((isdigit(x))?((x)-'0'):(toupper(x)-'A'+10))
540
541 static unsigned int read_pid( const streng *hexpid )
542 {
543 int i ;
544 unsigned int sum=0 ;
545
546 for (i=0; i<hexpid->len; i++)
547 if (isxdigit(hexpid->value[i]))
548 sum = sum*16 + HEXDIG( hexpid->value[i] ) ;
549
550 return sum ;
551 }
552
553
554 streng *vms_f_directory( tsd_t *TSD, cparamboxptr parms )
555 {
556 char buffer[ MAX_PATH_LEN ] ;
557 short length ;
558 int rc ;
559 streng *result ;
560 $DESCRIPTOR( dir, buffer ) ;
561
562 checkparam( parms, 0, 0, "VMS_F_DIRECTORY" ) ;
563
564 rc = sys$setddir( NULL, &length, &dir ) ;
565 if (rc != RMS$_NORMAL)
566 vms_error( TSD, rc ) ;
567
568 if (length > MAX_PATH_LEN)
569 exiterror( ERR_SYSTEM_FAILURE , 0 ) ;
570
571 result = Str_makeTSD( length ) ;
572 result = Str_ncatstrTSD( result, buffer, length ) ;
573 return (result) ;
574 }
575
576
577 /* f$edit() */
578 /* f$element() */
579 /* f$environment() --- not sure how to handle this */
580 /* f$extract() */
581 /* f$fao() */
582
583 /*
584 streng *vms_f_file_attributes( tsd_t *TSD, cparamboxptr parms )
585 {
586 checkparam( parms, 2, 2, "VMS_F_FILE_ATTRIBUTES" ) ;
587 }
588 */
589
590 struct dvi_items_type dvi_items[] =
591 {
592 { TYP_HEX, "ACPPID", DVI$_ACPPID },
593 { TYP_ACP, "ACPTYPE", DVI$_ACPTYPE },
594 { TYP_BOOL, "ALL", DVI$_ALL },
595 { TYP_LSTR, "ALLDEVNAM", DVI$_ALLDEVNAM },
596 { TYP_INT, "ALLOCLASS", DVI$_ALLOCLASS },
597 { TYP_BOOL, "ALT_HOST_AVAIL", DVI$_ALT_HOST_AVAIL },
598 { TYP_LSTR, "ALT_HOST_NAME", DVI$_ALT_HOST_NAME },
599 { TYP_4STR, "ALT_HOST_TYPE", DVI$_ALT_HOST_TYPE },
600 { TYP_BOOL, "AVL", DVI$_AVL },
601 { TYP_BOOL, "CCL", DVI$_CCL },
602 { TYP_INT, "CLUSTER", DVI$_CLUSTER },
603 { TYP_BOOL, "CONCEALED", DVI$_CONCEALED }, /* undoc'ed */
604 { TYP_INT, "CYLINDERS", DVI$_CYLINDERS },
605 { TYP_INT, "DEVBUFSIZ", DVI$_DEVBUFSIZ },
606 { TYP_VEC, "DEVCHAR", DVI$_DEVCHAR },
607 { TYP_VEC, "DEVCHAR2", DVI$_DEVCHAR2 },
608 { TYP_INT, "DEVCLASS", DVI$_DEVCLASS },
609 { TYP_VEC, "DEVDEPEND", DVI$_DEVDEPEND },
610 { TYP_VEC, "DEVDEPEND2", DVI$_DEVDEPEND2 },
611 { TYP_LHEX, "DEVLOCKNAM", DVI$_DEVLOCKNAM },
612 { TYP_LSTR, "DEVNAM", DVI$_DEVNAM },
613 { TYP_VEC, "DEVSTS", DVI$_DEVSTS },
614 { TYP_INT, "DEVTYPE", DVI$_DEVTYPE },
615 { TYP_BOOL, "DIR", DVI$_DIR },
616 /* DVI$_DISPLAY_DEVNAM refered to in SS, not in LexFuncs */
617 { TYP_BOOL, "DMT", DVI$_DMT },
618 { TYP_BOOL, "DUA", DVI$_DUA },
619 { TYP_BOOL, "ELG", DVI$_ELG },
620 { TYP_INT, "ERRCNT", DVI$_ERRCNT },
621 { TYP_EXST, "EXISTS", DVI$_DIR },
622 { TYP_BOOL, "FOD", DVI$_FOD },
623 { TYP_BOOL, "FOR", DVI$_FOR },
624 { TYP_INT, "FREEBLOCKS", DVI$_FREEBLOCKS },
625 { TYP_LSTR, "FULLDEVNAM", DVI$_FULLDEVNAM },
626 { TYP_BOOL, "GEN", DVI$_GEN },
627 { TYP_BOOL, "HOST_AVAIL", DVI$_HOST_AVAIL },
628 { TYP_INT, "HOST_COUNT", DVI$_HOST_COUNT },
629 { TYP_LSTR, "HOST_NAME", DVI$_HOST_NAME },
630 { TYP_4STR, "HOST_TYPE", DVI$_HOST_TYPE },
631 { TYP_BOOL, "IDV", DVI$_IDV },
632 { TYP_HEX, "LOCKID", DVI$_LOCKID },
633 { TYP_LSTR, "LOGVOLNAM", DVI$_LOGVOLNAM },
634 { TYP_INT, "MAXBLOCK", DVI$_MAXBLOCK },
635 { TYP_INT, "MAXFILES", DVI$_MAXFILES },
636 { TYP_BOOL, "MBX", DVI$_MBX },
637 { TYP_VEC, "MEDIA_ID", DVI$_MEDIA_ID },
638 { TYP_LSTR , "MEDIA_NAME", DVI$_MEDIA_NAME },
639 { TYP_LSTR , "MEDIA_TYPE", DVI$_MEDIA_TYPE },
640 { TYP_BOOL, "MNT", DVI$_MNT },
641 { TYP_INT, "MOUNTCNT", DVI$_MOUNTCNT },
642 /* DVI$_MSCP_UNIT_NUMBER refered to in SS, not in LexFuncs */
643 { TYP_BOOL, "NET", DVI$_NET },
644 { TYP_LSTR , "NEXTDEVNAM", DVI$_NEXTDEVNAM },
645 { TYP_BOOL, "ODV", DVI$_ODV },
646 { TYP_INT, "OPCNT", DVI$_OPCNT },
647 { TYP_BOOL, "OPR", DVI$_OPR },
648 { TYP_UIC, "OWNUIC", DVI$_OWNUIC },
649 { TYP_HEX, "PID", DVI$_PID },
650 { TYP_BOOL, "RCK", DVI$_RCK },
651 { TYP_BOOL, "RCT", DVI$_RCT },
652 { TYP_BOOL, "REC", DVI$_REC },
653 { TYP_INT, "RECSIZ", DVI$_RECSIZ },
654 { TYP_INT, "REFCNT", DVI$_REFCNT },
655 { TYP_BOOL, "REMOTE_DEVICE", DVI$_REMOTE_DEVICE },
656 { TYP_BOOL, "RND", DVI$_RND },
657 { TYP_LSTR, "ROOTDEVNAM", DVI$_ROOTDEVNAM },
658 { TYP_BOOL, "RTM", DVI$_RTM },
659 { TYP_BOOL, "SDI", DVI$_SDI },
660 { TYP_INT, "SECTORS", DVI$_SECTORS },
661 { TYP_VEC, "SERIALNUM", DVI$_SERIALNUM },
662 { TYP_BOOL, "SERVED_DEVICE", DVI$_SERVED_DEVICE },
663 { TYP_BOOL, "SHR", DVI$_SHR },
664 { TYP_BOOL, "SPL", DVI$_SPL },
665 { TYP_SPLD, "SPLDEVNAM", DVI$_DEVNAM },
666 { TYP_BOOL, "SQD", DVI$_SQD },
667 { TYP_VEC, "STS", DVI$_STS },
668 { TYP_BOOL, "SWL", DVI$_SWL },
669 { TYP_INT, "TRACKS", DVI$_TRACKS },
670 { TYP_INT, "TRANSCNT", DVI$_TRANSCNT },
671 { TYP_BOOL, "TRM", DVI$_TRM },
672 { TYP_LSTR, "TT_ACCPORNAM", DVI$_TT_ACCPORNAM },
673 { TYP_BOOL, "TT_ALTYPEAHD", DVI$_TT_ALTYPEAHD },
674 { TYP_BOOL, "TT_ANSICRT", DVI$_TT_ANSICRT },
675 { TYP_BOOL, "TT_APP_KEYPAD", DVI$_TT_APP_KEYPAD },
676 { TYP_BOOL, "TT_AUTOBAUD", DVI$_TT_AUTOBAUD },
677 { TYP_BOOL, "TT_AVO", DVI$_TT_AVO },
678 { TYP_BOOL, "TT_BLOCK", DVI$_TT_BLOCK },
679 { TYP_BOOL, "TT_BRDCSTMBX", DVI$_TT_BRDCSTMBX },
680 { TYP_BOOL, "TT_CRFILL", DVI$_TT_CRFILL },
681 { TYP_BOOL, "TT_DECCRT", DVI$_TT_DECCRT },
682 { TYP_BOOL, "TT_DECCRT2", DVI$_TT_DECCRT2 },
683 { TYP_BOOL, "TT_DIALUP", DVI$_TT_DIALUP },
684 { TYP_BOOL, "TT_DISCONNECT", DVI$_TT_DISCONNECT },
685 { TYP_BOOL, "TT_DMA", DVI$_TT_DMA },
686 { TYP_BOOL, "TT_DRCS", DVI$_TT_DRCS },
687 { TYP_BOOL, "TT_EDIT", DVI$_TT_EDIT },
688 { TYP_BOOL, "TT_EDITING", DVI$_TT_EDITING },
689 { TYP_BOOL, "TT_EIGHTBIT", DVI$_TT_EIGHTBIT },
690 { TYP_BOOL, "TT_ESCAPE", DVI$_TT_ESCAPE },
691 { TYP_BOOL, "TT_FALLBACK", DVI$_TT_FALLBACK },
692 { TYP_BOOL, "TT_HALFDUP", DVI$_TT_HALFDUP },
693 { TYP_BOOL, "TT_HANGUP", DVI$_TT_HANGUP },
694 { TYP_BOOL, "TT_HOSTSYNC", DVI$_TT_HOSTSYNC },
695 { TYP_BOOL, "TT_INSERT", DVI$_TT_INSERT },
696 { TYP_BOOL, "TT_LFFILL", DVI$_TT_LFFILL },
697 { TYP_BOOL, "TT_LOCALECHO", DVI$_TT_LOCALECHO },
698 { TYP_BOOL, "TT_LOWER", DVI$_TT_LOWER },
699 { TYP_BOOL, "TT_MBXDSABL", DVI$_TT_MBXDSABL },
700 { TYP_BOOL, "TT_MECHFORM", DVI$_TT_MECHFORM },
701 { TYP_BOOL, "TT_MECHTAB", DVI$_TT_MECHTAB },
702 { TYP_BOOL, "TT_MODEM", DVI$_TT_MODEM },
703 { TYP_BOOL, "TT_MODHANGUP", DVI$_TT_MODHANGUP },
704 { TYP_BOOL, "TT_NOBRDCST", DVI$_TT_NOBRDCST },
705 { TYP_BOOL, "TT_NOECHO", DVI$_TT_NOECHO },
706 { TYP_BOOL, "TT_NOTYPEAHD", DVI$_TT_NOTYPEAHD },
707 { TYP_BOOL, "TT_OPER", DVI$_TT_OPER },
708 { TYP_INT, "TT_PAGE", DVI$_TT_PAGE },
709 { TYP_BOOL, "TT_PASTHRU", DVI$_TT_PASTHRU },
710 { TYP_LSTR, "TT_PHYDEVNAM", DVI$_TT_PHYDEVNAM },
711 { TYP_BOOL, "TT_PRINTER", DVI$_TT_PRINTER },
712 { TYP_BOOL, "TT_READSYNC", DVI$_TT_READSYNC },
713 { TYP_BOOL, "TT_REGIS", DVI$_TT_REGIS },
714 { TYP_BOOL, "TT_REMOTE", DVI$_TT_REMOTE },
715 { TYP_BOOL, "TT_SCOPE", DVI$_TT_SCOPE },
716 { TYP_BOOL, "TT_SECURE", DVI$_TT_SECURE },
717 { TYP_BOOL, "TT_SETSPEED", DVI$_TT_SETSPEED },
718 { TYP_BOOL, "TT_SIXEL", DVI$_TT_SIXEL },
719 { TYP_BOOL, "TT_SYSPWD", DVI$_TT_SYSPWD },
720 { TYP_BOOL, "TT_TTSYNC", DVI$_TT_TTSYNC },
721 { TYP_BOOL, "TT_WRAP", DVI$_TT_WRAP },
722 { TYP_INT, "UNIT", DVI$_UNIT },
723 { TYP_INT, "VOLCOUNT", DVI$_VOLCOUNT },
724 { TYP_SSTR, "VOLNAM", DVI$_VOLNAM },
725 { TYP_INT, "VOLNUMBER", DVI$_VOLNUMBER },
726 { TYP_BOOL, "VOLSETMEM", DVI$_VOLSETMEM },
727 { TYP_PROT, "VPROT", DVI$_VPROT },
728 { TYP_BOOL, "WCK", DVI$_WCK },
729 } ;
730
731
732
733 static struct dvi_items_type *item_info(
734 const streng *name, const struct dvi_items_type *xlist, int size )
735 {
736 int top, bot, mid, tmp ;
737 const char *poss, *cptr ;
738
739 top = size / sizeof( struct dvi_items_type ) - 1 ;
740 bot = 0 ;
741
742 for ( ; bot<=top; )
743 {
744 mid = (top+bot)/2 ;
745
746 cptr = name->value ;
747 poss = (const char *) xlist[mid].name ;
748 for (tmp=name->len; tmp--; )
749 if (toupper(*(cptr++))!=(*(poss++))) break ;
750
751 if (tmp==(-1))
752 tmp = - *poss ;
753 else
754 tmp = toupper(*(cptr-1)) - *(poss-1) ;
755
756 if (tmp<0)
757 top = mid - 1 ;
758 else if (tmp)
759 bot = mid + 1 ;
760 else
761 return (struct dvi_items_type *)&(xlist[mid]) ;
762 }
763 return NULL ;
764 }
765
766
767 /*
768 * Why do I use sys$getdviw() instead of lib$getdvi ... because Digital
769 * fucked up the implementation of lib$getdvi(). Problem: When secondary
770 * characteristics are chosen (1 is added to item-code, ... or item-code
771 * is or'ed with DVI$C_SECONDARY), lib$getdvi interprets the result as
772 * numeric in all cases, and never do any dataconversion, except from
773 * converting everything to decimal integer. Ergo, lib$getdvi is utterly
774 * useless for obtaining non-numeric info about secondary devices.
775 * When (if!) they fix it, undefining the LIB$GETDVI_BUG should make the
776 * code far simpler, and also much more compatible.
777 */
778
779
780 streng *vms_f_getdvi( tsd_t *TSD, cparamboxptr parms )
781 {
782 char *buffer="", buffer1[64], buffer2[64] ;
783 int spooled, slength=4, rc, itemcode, length ;
784 short length1, length2 ;
785 struct dvi_items_type *ptr ;
786 int item[12], type ;
787 struct dsc$descriptor_s name ;
788 struct dsc$descriptor_s dir = {
789 sizeof(buffer)-1, DSC$K_DTYPE_T, DSC$K_CLASS_S, buffer } ;
790
791 checkparam( parms, 2, 2, "VMS_F_GETDVI" ) ;
792
793 ptr = item_info( parms->next->value, dvi_items, sizeof( dvi_items)) ;
794 if (!ptr)
795 exiterror( ERR_INCORRECT_CALL , 0 ) ;
796
797 name.dsc$w_length = Str_len( parms->value ) ;
798 name.dsc$b_dtype = DSC$K_DTYPE_T ;
799 name.dsc$b_class = DSC$K_CLASS_S ;
800 name.dsc$a_pointer = parms->value->value ;
801
802 item[0] = 64 + ((ptr->addr) << 16) ;
803 item[1] = (int)buffer1 ;
804 item[2] = (int)&length1 ;
805 item[3] = 64 + ((ptr->addr | DVI$C_SECONDARY) << 16) ;
806 item[4] = (int)buffer2 ;
807 item[5] = (int)&length2 ;
808 item[6] = 4 + ((DVI$_SPL | DVI$C_SECONDARY) << 16) ;
809 item[7] = (int)&spooled ;
810 item[8] = (int)&slength ;
811 item[9] = item[10] = item[11] = 0 ;
812
813
814 rc = sys$getdviw( NULL, NULL, &name, &item, NULL, NULL, NULL, NULL ) ;
815
816 if (ptr->type == TYP_SPLD)
817 {
818 spooled = 0 ;
819 type = TYP_LSTR ;
820 }
821 else
822 type = ptr->type ;
823
824 buffer = (spooled) ? buffer2 : buffer1 ;
825 length = (spooled) ? length2 : length1 ;
826
827 if (type == TYP_EXST)
828 {
829 if (rc == SS$_NOSUCHDEV) return Str_creTSD( "FALSE" ) ;
830 if (rc == SS$_NORMAL) return Str_creTSD( "TRUE" ) ;
831 }
832
833 if (rc != SS$_NORMAL)
834 {
835 vms_error( TSD, rc ) ;
836 return Str_creTSD("") ;
837 }
838
839 return format_result( TSD, type, buffer, length ) ;
840 }
841
842
843 static const struct dvi_items_type jpi_items[] =
844 {
845 { TYP_LSTR, "ACCOUNT", JPI$_ACCOUNT },
846 { TYP_INT, "APTCNT", JPI$_APTCNT },
847 { TYP_INT, "ASTACT", JPI$_ASTACT },
848 { TYP_INT, "ASTCNT", JPI$_ASTCNT },
849 { TYP_INT, "ASTEN", JPI$_ASTEN },
850 { TYP_INT, "ASTLM", JPI$_ASTLM },
851 { TYP_INT, "AUTHPRI", JPI$_AUTHPRI },
852 { TYP_PRIV, "AUTHPRIV", JPI$_AUTHPRIV },
853 { TYP_INT, "BIOCNT", JPI$_BIOCNT },
854 { TYP_INT, "BIOLM", JPI$_BIOLM },
855 { TYP_INT, "BUFIO", JPI$_BUFIO },
856 { TYP_INT, "BYTCNT", JPI$_BYTCNT },
857 { TYP_INT, "BYTLM", JPI$_BYTLM },
858 { TYP_LSTR, "CLINAME", JPI$_CLINAME },
859 { TYP_INT, "CPULIM", JPI$_CPULIM },
860 { TYP_INT, "CPUTIM", JPI$_CPUTIM },
861 { TYP_PRIV, "CURPRIV", JPI$_CURPRIV },
862 { TYP_INT, "DFPFC", JPI$_DFPFC },
863 { TYP_INT, "DFWSCNT", JPI$_DFWSCNT },
864 { TYP_INT, "DIOCNT", JPI$_DIOCNT },
865 { TYP_INT, "DIOLM", JPI$_DIOLM },
866 { TYP_INT, "DIRIO", JPI$_DIRIO },
867 { TYP_INT, "EFCS", JPI$_EFCS },
868 { TYP_INT, "EFCU", JPI$_EFCU },
869 { TYP_INT, "EFWM", JPI$_EFWM },
870 { TYP_INT, "ENQCNT", JPI$_ENQCNT },
871 { TYP_INT, "ENQLM", JPI$_ENQLM },
872 { TYP_HEX, "EXCVEC", JPI$_EXCVEC },
873 { TYP_INT, "FILCNT", JPI$_FILCNT },
874 { TYP_INT, "FILLM", JPI$_FILLM },
875 { TYP_HEX, "FINALEXC", JPI$_FINALEXC },
876 { TYP_HEX, "FREP0VA", JPI$_FREP0VA },
877 { TYP_HEX, "FREP1VA", JPI$_FREP1VA },
878 { TYP_INT, "FREPTECNT", JPI$_FREPTECNT },
879 { TYP_INT, "GPGCNT", JPI$_GPGCNT },
880 { TYP_INT, "GRP", JPI$_GRP },
881 { TYP_INT, "IMAGECOUNT", JPI$_IMAGECOUNT },
882 { TYP_LSTR, "IMAGNAME", JPI$_IMAGNAME },
883 { TYP_PRIV, "IMAGPRIV", JPI$_IMAGPRIV },
884 { TYP_INT, "JOBPRCCNT", JPI$_JOBPRCCNT },
885 { TYP_TIME, "LOGINTIM", JPI$_LOGINTIM },
886 { TYP_HEX, "MASTER_PID", JPI$_MASTER_PID },
887 { TYP_INT, "MEM", JPI$_MEM },
888 { TYP_MODE, "MODE", JPI$_MODE },
889 { TYP_INT, "MSGMASK", JPI$_MSGMASK },
890 { TYP_HEX, "OWNER", JPI$_OWNER },
891 { TYP_INT, "PAGEFLTS", JPI$_PAGEFLTS },
892 { TYP_INT, "PAGFILCNT", JPI$_PAGFILCNT },
893 { TYP_HEX, "PAGFILLOC", JPI$_PAGFILLOC },
894 { TYP_INT, "PGFLQUOTA", JPI$_PGFLQUOTA },
895 { TYP_VEC, "PHDFLAGS", JPI$_PHDFLAGS },
896 { TYP_HEX, "PID", JPI$_PID },
897 { TYP_INT, "PPGCNT", JPI$_PPGCNT },
898 { TYP_INT, "PRCCNT", JPI$_PRCCNT },
899 { TYP_INT, "PRCLM", JPI$_PRCLM },
900 { TYP_LSTR, "PRCNAM", JPI$_PRCNAM },
901 { TYP_INT, "PRIB", JPI$_PRIB },
902 { TYP_PRIV, "PROCPRIV", JPI$_PROCPRIV },
903 { TYP_INT, "SITESPEC", JPI$_SITESPEC },
904 { TYP_SCHT, "STATE", JPI$_STATE },
905 { TYP_INT, "STS", JPI$_STS },
906 { TYP_HEX, "SWPFILLOC", JPI$_SWPFILLOC },
907 { TYP_SSTR, "TERMINAL", JPI$_TERMINAL },
908 { TYP_INT, "TMBU", JPI$_TMBU },
909 { TYP_INT, "TQCNT", JPI$_TQCNT },
910 { TYP_INT, "TQLM", JPI$_TQLM },
911 { TYP_UIC, "UIC", JPI$_UIC },
912 { TYP_SSTR, "USERNAME", JPI$_USERNAME },
913 { TYP_INT, "VIRTPEAK", JPI$_VIRTPEAK },
914 { TYP_INT, "VOLUMES", JPI$_VOLUMES },
915 { TYP_INT, "WSAUTH", JPI$_WSAUTH },
916 { TYP_INT, "WSAUTHEXT", JPI$_WSAUTHEXT },
917 { TYP_INT, "WSEXTENT", JPI$_WSEXTENT },
918 { TYP_INT, "WSPEAK", JPI$_WSPEAK },
919 { TYP_INT, "WSQUOTA", JPI$_WSQUOTA },
920 { TYP_INT, "WSSIZE", JPI$_WSSIZE },
921 } ;
922
923
924 streng *vms_f_getjpi( tsd_t *TSD, cparamboxptr parms )
925 {
926 char buffer[64] ;
927 int item[6] ;
928 short length=0 ;
929 int rc, pid, *pidaddr ;
930 struct dvi_items_type *ptr ;
931 struct dsc$descriptor_s dir = {
932 sizeof(buffer)-1, DSC$K_DTYPE_T, DSC$K_CLASS_S, buffer } ;
933
934 checkparam( parms, 2, 2, "VMS_F_GETJPI" ) ;
935
936 ptr = item_info( parms->next->value, jpi_items, sizeof(jpi_items)) ;
937 if (!ptr)
938 exiterror( ERR_INCORRECT_CALL , 0 ) ;
939
940 if ((!parms->value) || (!parms->value->len))
941 pidaddr = NULL ;
942 else
943 {
944 pid = read_pid( parms->value ) ;
945 pidaddr = &pid ;
946 }
947
948 item[0] = 64 + ( ptr->addr << 16 ) ;
949 item[1] = (int)buffer ;
950 item[2] = (int)&length ;
951 item[3] = item[4] = item[5] = 0 ;
952
953 rc = sys$getjpiw( NULL, pidaddr, NULL, &item, NULL, NULL, NULL ) ;
954
955 if (rc != SS$_NORMAL)
956 {
957 vms_error( TSD, rc ) ;
958 return Str_creTSD("") ;
959 }
960
961 return format_result( TSD, ptr->type, buffer, length ) ;
962 }
963
964 /*
965 * Warning, the sequence of these records *must* match the macros
966 * given below (CARAC, ENTRY, ENTRY), which is used in initializing
967 * the array leg_items
968 */
969 static const struct dvi_items_type qui_funcs[] = {
970 { 0x70, "CANCEL_OPERATION", QUI$_CANCEL_OPERATION },
971 { 0x02, "DISPLAY_CHARACTERISTIC", QUI$_DISPLAY_CHARACTERISTIC },
972 { 0x00, "DISPLAY_ENTRY", QUI$_DISPLAY_ENTRY },
973 { 0x20, "DISPLAY_FILE", QUI$_DISPLAY_FILE },
974 { 0x02, "DISPLAY_FORM", QUI$_DISPLAY_FORM },
975 { 0x20, "DISPLAY_JOB", QUI$_DISPLAY_JOB },
976 { 0x02, "DISPLAY_QUEUE", QUI$_DISPLAY_QUEUE },
977 { 0x42, "TRANSLATE_QUEUE", QUI$_TRANSLATE_QUEUE },
978 } ;
979
980 /*
981 static const char char qui_chars[] = {
982 0x70, 0x02, 0x00, 0x20, 0x02, 0x20, 0x02, 0x42
983 } ;
984
985 static const int qui_func_codes[] = {
986 QUI$_CANCEL_OPERATION, QUI$_DISPLAY_CHARACTERISTIC, QUI$_DISPLAY_ENTRY,
987 QUI$_DISPLAY_FILE, QUI$_DISPLAY_FORM, QUI$_DISPLAY_JOB,
988 QUI$_DISPLAY_QUEUE, QUI$_TRANSLATE_QUEUE
989 } ;
990 */
991
992 static const int qui_spec_values[] = {
993 QUI$_FILE_FLAGS, QUI$_FILE_STATUS, QUI$_FORM_FLAGS, QUI$_JOB_FLAGS,
994 QUI$_JOB_STATUS, QUI$_PENDING_JOB_REASON, QUI$_QUEUE_FLAGS,
995 QUI$_QUEUE_STATUS
996 } ;
997
998 #define CHARAC 0x02 /* display_characteristics */
999 #define ENTRY 0x04 /* diskplay_entry */
1000 #define FILE 0x08 /* display_file */
1001 #define FORM 0x10 /* display_form */
1002 #define JOB 0x20 /* display_job */
1003 #define QUEUE 0x40 /* display_queue */
1004 #define TRANS 0x80 /* translate_queue */
1005
1006 static const char leg_items[] = {
1007 ENTRY + JOB, /* ACCOUNT_NAME */
1008 ENTRY + JOB, /* AFTER_TIME */
1009 QUEUE, /* ASSIGNED_QUEUE_NAME */
1010 QUEUE, /* BASE_PRIORITY */
1011 ENTRY + JOB + QUEUE, /* CHARACTERISTICS */
1012 CHARAC, /* CHARACTERISTIC_NAME */
1013 CHARAC, /* CHARACTERISTIC_NUMBER */
1014 ENTRY + JOB, /* CHECKPOINT_DATA */
1015 ENTRY + JOB, /* CLI */
1016 ENTRY + JOB, /* COMPLETE_BLOCKS */
1017 ENTRY + JOB, /* CONDITION_VECTOR */
1018 QUEUE, /* CPU_DEFAULT */
1019 ENTRY + JOB + QUEUE, /* CPU_LIMIT */
1020 QUEUE, /* DEFAULT_FORM_NAME */
1021 QUEUE, /* DEFAULT_FORM_STOCK */
1022 QUEUE, /* DEVICE_NAME */
1023 ENTRY + JOB, /* ENTRY_NUMBER */
1024 QUEUE, /* EXECUTING_JOB_COUNT */
1025 FILE, /* FILE_BURST */
1026 FILE, /* FILE_CHECKPOINTED */
1027 FILE, /* FILE_COPIES */
1028 FILE, /* FILE_COPIES_DONE */
1029 FILE, /* FILE_DELETE */
1030 FILE, /* FILE_DOUBLE_SPACE */
1031 FILE, /* FILE_EXECUTING */
1032 FILE, /* FILE_FLAG */
1033 FILE, /* FILE_FLAGS */
1034 FILE, /* FILE_IDENTIFICATION */
1035 FILE, /* FILE_PAGE_HEADER */
1036 FILE, /* FILE_PAGINATE */
1037 FILE, /* FILE_PASSALL */
1038 FILE, /* FILE_SETUP_MODULES */
1039 FILE, /* FILE_SPECIFICATION */
1040 FILE, /* FILE_STATUS */
1041 FILE, /* FILE_TRAILER */
1042 FILE, /* FIRST_PAGE */
1043 FORM, /* FORM_DESCRIPTION */
1044 FORM, /* FORM_FLAGS */
1045 FORM, /* FORM_LENGTH */
1046 FORM, /* FORM_MARGIN_BOTTOM */
1047 FORM, /* FORM_MARGIN_LEFT */
1048 FORM, /* FORM_MARGIN_RIGHT */
1049 FORM, /* FORM_MARGIN_TOP */
1050 FORM + ENTRY + JOB + QUEUE, /* FORM_NAME */
1051 FORM, /* FORM_NUMBER */
1052 FORM, /* FORM_SETUP_MODULES */
1053 FORM, /* FORM_SHEET_FEED */
1054 FORM + ENTRY + JOB + QUEUE, /* FORM_STOCK */
1055 FORM, /* FORM_TRUNCATE */
1056 FORM, /* FORM_WIDTH */
1057 FORM, /* FORM_WRAP */
1058 QUEUE, /* GENERIC_TARGET */
1059 QUEUE, /* HOLDING_JOB_COUNT */
1060 ENTRY + JOB, /* INTERVENING_BLOCKS */
1061 /* see comment in vms.rexx about intervening jobs */
1062 /* ENTRY + */ JOB, /* INTERVENING_JOBS */
1063 ENTRY + JOB, /* JOB_ABORTING */
1064 ENTRY + JOB, /* JOB_COPIES */
1065 ENTRY + JOB, /* JOB_COPIES_DONE */
1066 ENTRY + JOB, /* JOB_CPU_LIMIT */
1067 ENTRY + JOB, /* JOB_EXECUTING */
1068 ENTRY + JOB, /* JOB_FILE_BURST */
1069 ENTRY + JOB, /* JOB_FILE_BURST_ONE */
1070 ENTRY + JOB, /* JOB_FILE_FLAG */
1071 ENTRY + JOB, /* JOB_FILE_FLAG_ONE */
1072 ENTRY + JOB, /* JOB_FILE_PAGINATE */
1073 ENTRY + JOB, /* JOB_FILE_TRAILER */
1074 ENTRY + JOB, /* JOB_FILE_TRAILER_ONE */
1075 ENTRY + JOB, /* JOB_FLAGS */
1076 ENTRY + JOB, /* JOB_HOLDING */
1077 ENTRY + JOB, /* JOB_INACCESSIBLE */
1078 QUEUE, /* JOB_LIMIT */
1079 ENTRY + JOB, /* JOB_LOG_DELETE */
1080 ENTRY + JOB, /* JOB_LOG_NULL */
1081 ENTRY + JOB, /* JOB_LOG_SPOOL */
1082 ENTRY + JOB, /* JOB_LOWERCASE */
1083 ENTRY + JOB, /* JOB_NAME */
1084 ENTRY + JOB, /* JOB_NOTIFY */
1085 ENTRY + JOB, /* JOB_PENDING */
1086 ENTRY + JOB, /* JOB_PID */
1087 ENTRY + JOB, /* JOB_REFUSED */
1088 QUEUE, /* JOB_RESET_MODULES */
1089 ENTRY + JOB, /* JOB_RESTART */
1090 ENTRY + JOB, /* JOB_RETAINED */
1091 ENTRY + JOB, /* JOB_SIZE */
1092 QUEUE, /* JOB_SIZE_MAXIMUM */
1093 QUEUE, /* JOB_SIZE_MINIMUM */
1094 ENTRY + JOB, /* JOB_STARTING */
1095 ENTRY + JOB, /* JOB_STATUS */
1096 ENTRY + JOB, /* JOB_SUSPENDED */
1097 ENTRY + JOB, /* JOB_TIMED_RELEASE */
1098 ENTRY + JOB, /* JOB_WSDEFAULT */
1099 ENTRY + JOB, /* JOB_WSEXTENT */
1100 ENTRY + JOB, /* JOB_WSQUOTA */
1101 FILE, /* LAST_PAGE */
1102 QUEUE, /* LIBRARY_SPECIFICATION */
1103 ENTRY + JOB, /* LOG_QUEUE */
1104 ENTRY + JOB, /* LOG_SPECIFICATION */
1105 ENTRY + JOB, /* NOTE */
1106 ENTRY + JOB, /* OPERATOR_REQUEST */
1107 QUEUE, /* OWNER_UIC */
1108 FORM, /* PAGE_SETUP_MODULES */
1109 ENTRY + JOB, /* PARAMETER_1 */
1110 ENTRY + JOB, /* PARAMETER_2 */
1111 ENTRY + JOB, /* PARAMETER_3 */
1112 ENTRY + JOB, /* PARAMETER_4 */
1113 ENTRY + JOB, /* PARAMETER_5 */
1114 ENTRY + JOB, /* PARAMETER_6 */
1115 ENTRY + JOB, /* PARAMETER_7 */
1116 ENTRY + JOB, /* PARAMETER_8 */
1117 QUEUE, /* PENDING_JOB_BLOCK_COUNT */
1118 QUEUE, /* PENDING_JOB_COUNT */
1119 ENTRY + JOB, /* PENDING_JOB_REASON */
1120 ENTRY + JOB, /* PEND_CHAR_MISMATCH */
1121 ENTRY + JOB, /* PEND_JOB_SIZE_MAX */
1122 ENTRY + JOB, /* PEND_JOB_SIZE_MIN */
1123 ENTRY + JOB, /* PEND_LOWERCASE_MISMATCH */
1124 ENTRY + JOB, /* PEND_NO_ACCESS */
1125 ENTRY + JOB, /* PEND_QUEUE_BUSY */
1126 ENTRY + JOB, /* PEND_QUEUE_STATE */
1127 ENTRY + JOB, /* PEND_STOCK_MISMATCH */
1128 ENTRY + JOB, /* PRIORITY */
1129 QUEUE, /* PROCESSOR */
1130 QUEUE, /* PROTECTION */
1131 QUEUE, /* QUEUE_DESCRIPTION */
1132 QUEUE, /* QUEUE_ACL_SPECIFIED */
1133 QUEUE, /* QUEUE_ALIGNING */
1134 QUEUE, /* QUEUE_BATCH */
1135 QUEUE, /* QUEUE_CLOSED */
1136 QUEUE, /* QUEUE_CPU_DEFAULT */
1137 QUEUE, /* QUEUE_CPU_LIMIT */
1138 QUEUE, /* QUEUE_FILE_BURST */
1139 QUEUE, /* QUEUE_FILE_BURST_ONE */
1140 QUEUE, /* QUEUE_FILE_FLAG */
1141 QUEUE, /* QUEUE_FILE_FLAG_ONE */
1142 QUEUE, /* QUEUE_FILE_PAGINATE */
1143 QUEUE, /* QUEUE_FILE_TRAILER */
1144 QUEUE, /* QUEUE_FILE_TRAILER_ONE */
1145 QUEUE, /* QUEUE_FLAGS */
1146 QUEUE, /* QUEUE_GENERIC */
1147 QUEUE, /* QUEUE_GENERIC_SELECTION */
1148 QUEUE, /* QUEUE_IDLE */
1149 QUEUE, /* QUEUE_JOB_BURST */
1150 QUEUE, /* QUEUE_JOB_FLAG */
1151 QUEUE, /* QUEUE_JOB_SIZE_SCHED */
1152 QUEUE, /* QUEUE_JOB_TRAILER */
1153 QUEUE, /* QUEUE_LOWERCASE */
1154 TRANS + ENTRY + JOB + QUEUE, /* QUEUE_NAME */
1155 QUEUE, /* QUEUE_PAUSED */
1156 QUEUE, /* QUEUE_PAUSING */
1157 QUEUE, /* QUEUE_PRINTER */
1158 QUEUE, /* QUEUE_RECORD_BLOCKING */
1159 QUEUE, /* QUEUE_REMOTE */
1160 QUEUE, /* QUEUE_RESETTING */
1161 QUEUE, /* QUEUE_RESUMING */
1162 QUEUE, /* QUEUE_RETAIN_ALL */
1163 QUEUE, /* QUEUE_RETAIN_ERROR */
1164 QUEUE, /* QUEUE_SERVER */
1165 QUEUE, /* QUEUE_STALLED */
1166 QUEUE, /* QUEUE_STARTING */
1167 QUEUE, /* QUEUE_STATUS */
1168 QUEUE, /* QUEUE_STOPPED */
1169 QUEUE, /* QUEUE_STOPPING */
1170 QUEUE, /* QUEUE_SWAP */
1171 QUEUE, /* QUEUE_TERMINAL */
1172 QUEUE, /* QUEUE_UNAVAILABLE */
1173 QUEUE, /* QUEUE_WSDEFAULT */
1174 QUEUE, /* QUEUE_WSEXTENT */
1175 QUEUE, /* QUEUE_WSQUOTA */
1176 ENTRY + JOB, /* REQUEUE_QUEUE_NAME */
1177 JOB, /* RESTART_QUEUE_NAME */
1178 QUEUE, /* RETAINED_JOB_COUNT */
1179 QUEUE, /* SCSNODE_NAME */
1180 ENTRY + JOB, /* SUBMISSION_TIME */
1181 QUEUE, /* TIMED_RELEASE_JOB_COUNT */
1182 ENTRY + JOB, /* UIC */
1183 ENTRY + JOB, /* USERNAME */
1184 ENTRY + JOB + QUEUE, /* WSDEFAULT */
1185 ENTRY + JOB + QUEUE, /* WSEXTENT */
1186 ENTRY + JOB + QUEUE, /* WSQUOTA */
1187 } ;
1188
1189
1190 static const struct dvi_items_type qui_items[] = {
1191 { TYP_LSTR, "ACCOUNT_NAME", QUI$_ACCOUNT_NAME },
1192 { TYP_TIME, "AFTER_TIME", QUI$_AFTER_TIME },
1193 { TYP_LSTR, "ASSIGNED_QUEUE_NAME", QUI$_ASSIGNED_QUEUE_NAME },
1194 { TYP_INT, "BASE_PRIORITY", QUI$_BASE_PRIORITY },
1195 { TYP_LSTR, "CHARACTERISTICS", QUI$_CHARACTERISTICS },
1196 { TYP_LSTR, "CHARACTERISTIC_NAME", QUI$_CHARACTERISTIC_NAME },
1197 { TYP_INT, "CHARACTERISTIC_NUMBER", QUI$_CHARACTERISTIC_NUMBER },
1198 { TYP_LSTR, "CHECKPOINT_DATA", QUI$_CHECKPOINT_DATA },
1199 { TYP_LSTR, "CLI", QUI$_CLI },
1200 { TYP_INT, "COMPLETED_BLOCKS", QUI$_COMPLETED_BLOCKS },
1201 { TYP_HEX, "CONDITION_VECTOR", QUI$_CONDITION_VECTOR },
1202 { TYP_DTIM, "CPU_DEFAULT", QUI$_CPU_DEFAULT },
1203 { TYP_DTIM, "CPU_LIMIT", QUI$_CPU_LIMIT },
1204 { TYP_LSTR, "DEFAULT_FORM_NAME", QUI$_DEFAULT_FORM_NAME },
1205 { TYP_LSTR, "DEFAULT_FORM_STOCK", QUI$_DEFAULT_FORM_STOCK },
1206 { TYP_LSTR, "DEVICE_NAME", QUI$_DEVICE_NAME },
1207 { TYP_INT, "ENTRY_NUMBER", QUI$_ENTRY_NUMBER },
1208 { TYP_INT, "EXECUTING_JOB_COUNT", QUI$_EXECUTING_JOB_COUNT },
1209 { TYP_FLF, "FILE_BURST", QUI$M_FILE_BURST },
1210 { TYP_FLS, "FILE_CHECKPOINTED", QUI$M_FILE_CHECKPOINTED },
1211 { TYP_INT, "FILE_COPIES", QUI$_FILE_COPIES },
1212 { TYP_INT, "FILE_COPIES_DONE", QUI$_FILE_COPIES_DONE },
1213 { TYP_FLF, "FILE_DELETE", QUI$M_FILE_DELETE },
1214 { TYP_FLF, "FILE_DOUBLE_SPACE", QUI$M_FILE_DOUBLE_SPACE },
1215 { TYP_FLS, "FILE_EXECUTING", QUI$M_FILE_EXECUTING },
1216 { TYP_FLF, "FILE_FLAG", QUI$M_FILE_FLAG },
1217 { TYP_INT, "FILE_FLAGS", QUI$_FILE_FLAGS },
1218 { TYP_LSTR, "FILE_IDENTIFICATION", QUI$_FILE_IDENTIFICATION },
1219 { TYP_FLF, "FILE_PAGE_HEADER", QUI$M_FILE_PAGE_HEADER },
1220 { TYP_FLF, "FILE_PAGINATE", QUI$M_FILE_PAGINATE },
1221 { TYP_FLF, "FILE_PASSALL", QUI$M_FILE_PASSALL },
1222 { TYP_LSTR, "FILE_SETUP_MODULES", QUI$_FILE_SETUP_MODULES },
1223 { TYP_LSTR, "FILE_SPECIFICATION", QUI$_FILE_SPECIFICATION },
1224 { TYP_INT, "FILE_STATUS", QUI$_FILE_STATUS },
1225 { TYP_FLF, "FILE_TRAILER", QUI$M_FILE_TRAILER },
1226 { TYP_INT, "FIRST_PAGE", QUI$_FIRST_PAGE },
1227 { TYP_LSTR, "FORM_DESCRIPTION", QUI$_FORM_DESCRIPTION },
1228 { TYP_INT, "FORM_FLAGS", QUI$_FORM_FLAGS },
1229 { TYP_INT, "FORM_LENGTH", QUI$_FORM_LENGTH },
1230 { TYP_INT, "FORM_MARGIN_BOTTOM", QUI$_FORM_MARGIN_BOTTOM },
1231 { TYP_INT, "FORM_MARGIN_LEFT", QUI$_FORM_MARGIN_LEFT },
1232 { TYP_INT, "FORM_MARGIN_RIGHT", QUI$_FORM_MARGIN_RIGHT },
1233 { TYP_INT, "FORM_MARGIN_TOP", QUI$_FORM_MARGIN_TOP },
1234 { TYP_LSTR, "FORM_NAME", QUI$_FORM_NAME },
1235 { TYP_INT, "FORM_NUMBER", QUI$_FORM_NUMBER },
1236 { TYP_LSTR, "FORM_SETUP_MODULES", QUI$_FORM_SETUP_MODULES },
1237 { TYP_FMF, "FORM_SHEET_FEED", QUI$M_FORM_SHEET_FEED },
1238 { TYP_LSTR, "FORM_STOCK", QUI$_FORM_STOCK },
1239 { TYP_FMF, "FORM_TRUNCATE", QUI$M_FORM_TRUNCATE },
1240 { TYP_INT, "FORM_WIDTH", QUI$_FORM_WIDTH },
1241 { TYP_FMF, "FORM_WRAP", QUI$M_FORM_WRAP },
1242 { TYP_LSTR, "GENERIC_TARGET", QUI$_GENERIC_TARGET },
1243 { TYP_INT, "HOLDING_JOB_COUNT", QUI$_HOLDING_JOB_COUNT },
1244 { TYP_INT, "INTERVENING_BLOCKS", QUI$_INTERVENING_BLOCKS },
1245 { TYP_INT, "INTERVENING_JOBS", QUI$_INTERVENING_JOBS },
1246 { TYP_JBS, "JOB_ABORTING", QUI$M_JOB_ABORTING },
1247 { TYP_INT, "JOB_COPIES", QUI$_JOB_COPIES },
1248 { TYP_INT, "JOB_COPIES_DONE", QUI$_JOB_COPIES_DONE },
1249 { TYP_JBF, "JOB_CPU_LIMIT", QUI$M_JOB_CPU_LIMIT },
1250 { TYP_JBS, "JOB_EXECUTING", QUI$M_JOB_EXECUTING },
1251 { TYP_JBF, "JOB_FILE_BURST", QUI$M_JOB_FILE_BURST },
1252 { TYP_JBF, "JOB_FILE_BURST_ONE", QUI$M_JOB_FILE_BURST_ONE },
1253 { TYP_JBF, "JOB_FILE_FLAG", QUI$M_JOB_FILE_FLAG },
1254 { TYP_JBF, "JOB_FILE_FLAG_ONE", QUI$M_JOB_FILE_FLAG_ONE },
1255 { TYP_JBF, "JOB_FILE_PAGINATE", QUI$M_JOB_FILE_PAGINATE },
1256 { TYP_JBF, "JOB_FILE_TRAILER", QUI$M_JOB_FILE_TRAILER },
1257 { TYP_JBF, "JOB_FILE_TRAILER_ONE", QUI$M_JOB_FILE_TRAILER_ONE },
1258 { TYP_INT, "JOB_FLAGS", QUI$_JOB_FLAGS },
1259 { TYP_JBS, "JOB_HOLDING", QUI$M_JOB_HOLDING },
1260 { TYP_JBS, "JOB_INACCESSIBLE", QUI$M_JOB_INACCESSIBLE },
1261 { TYP_INT, "JOB_LIMIT", QUI$_JOB_LIMIT },
1262 { TYP_JBF, "JOB_LOG_DELETE", QUI$M_JOB_LOG_DELETE },
1263 { TYP_JBF, "JOB_LOG_NULL", QUI$M_JOB_LOG_NULL },
1264 { TYP_JBF, "JOB_LOG_SPOOL", QUI$M_JOB_LOG_SPOOL },
1265 { TYP_JBF, "JOB_LOWERCASE", QUI$M_JOB_LOWERCASE },
1266 { TYP_LSTR, "JOB_NAME", QUI$_JOB_NAME },
1267 { TYP_JBF, "JOB_NOTIFY", QUI$M_JOB_NOTIFY },
1268 { TYP_JBS, "JOB_PENDING", QUI$M_JOB_PENDING },
1269 { TYP_HEX, "JOB_PID", QUI$_JOB_PID },
1270 { TYP_JBS, "JOB_REFUSED", QUI$M_JOB_REFUSED },
1271 { TYP_LSTR, "JOB_RESET_MODULES", QUI$_JOB_RESET_MODULES },
1272 { TYP_JBF, "JOB_RESTART", QUI$M_JOB_RESTART },
1273 { TYP_JBS, "JOB_RETAINED", QUI$M_JOB_RETAINED },
1274 { TYP_INT, "JOB_SIZE", QUI$_JOB_SIZE },
1275 { TYP_INT, "JOB_SIZE_MAXIMUM", QUI$_JOB_SIZE_MAXIMUM },
1276 { TYP_INT, "JOB_SIZE_MINIMUM", QUI$_JOB_SIZE_MINIMUM },
1277 { TYP_JBS, "JOB_STARTING", QUI$M_JOB_STARTING },
1278 { TYP_INT, "JOB_STATUS", QUI$_JOB_STATUS },
1279 { TYP_JBS, "JOB_SUSPENDED", QUI$M_JOB_SUSPENDED },
1280 { TYP_JBS, "JOB_TIMED_RELEASE", QUI$M_JOB_TIMED_RELEASE },
1281 { TYP_JBF, "JOB_WSDEFAULT", QUI$M_JOB_WSDEFAULT },
1282 { TYP_JBF, "JOB_WSEXTENT", QUI$M_JOB_WSEXTENT },
1283 { TYP_JBF, "JOB_WSQUOTA", QUI$M_JOB_WSQUOTA },
1284 { TYP_INT, "LAST_PAGE", QUI$_LAST_PAGE },
1285 { TYP_LSTR, "LIBRARY_SPECIFICATION", QUI$_LIBRARY_SPECIFICATION },
1286 { TYP_LSTR, "LOG_QUEUE", QUI$_LOG_QUEUE },
1287 { TYP_LSTR, "LOG_SPECIFICATION", QUI$_LOG_SPECIFICATION },
1288 { TYP_LSTR, "NOTE", QUI$_NOTE },
1289 { TYP_LSTR, "OPERATOR_REQUEST", QUI$_OPERATOR_REQUEST },
1290 { TYP_UIC, "OWNER_UIC", QUI$_OWNER_UIC },
1291 { TYP_LSTR, "PAGE_SETUP_MODULES", QUI$_PAGE_SETUP_MODULES },
1292 { TYP_LSTR, "PARAMETER_1", QUI$_PARAMETER_1 },
1293 { TYP_LSTR, "PARAMETER_2", QUI$_PARAMETER_2 },
1294 { TYP_LSTR, "PARAMETER_3", QUI$_PARAMETER_3 },
1295 { TYP_LSTR, "PARAMETER_4", QUI$_PARAMETER_4 },
1296 { TYP_LSTR, "PARAMETER_5", QUI$_PARAMETER_5 },
1297 { TYP_LSTR, "PARAMETER_6", QUI$_PARAMETER_6 },
1298 { TYP_LSTR, "PARAMETER_7", QUI$_PARAMETER_7 },
1299 { TYP_LSTR, "PARAMETER_8", QUI$_PARAMETER_8 },
1300 { TYP_INT, "PENDING_JOB_BLOCK_COUNT",QUI$_PENDING_JOB_BLOCK_COUNT },
1301 { TYP_INT, "PENDING_JOB_COUNT", QUI$_PENDING_JOB_COUNT },
1302 { TYP_INT, "PENDING_JOB_REASON", QUI$_PENDING_JOB_REASON },
1303 { TYP_PJR, "PEND_CHAR_MISMATCH", QUI$M_PEND_CHAR_MISMATCH },
1304 { TYP_PJR, "PEND_JOB_SIZE_MAX", QUI$M_PEND_JOB_SIZE_MAX },
1305 { TYP_PJR, "PEND_JOB_SIZE_MIN", QUI$M_PEND_JOB_SIZE_MIN },
1306 { TYP_PJR, "PEND_LOWERCASE_MISMATCH",QUI$M_PEND_LOWERCASE_MISMATCH },
1307 { TYP_PJR, "PEND_NO_ACCESS", QUI$M_PEND_NO_ACCESS },
1308 { TYP_PJR, "PEND_QUEUE_BUSY", QUI$M_PEND_QUEUE_BUSY },
1309 { TYP_PJR, "PEND_QUEUE_STATE", QUI$M_PEND_QUEUE_STATE },
1310 { TYP_PJR, "PEND_STOCK_MISMATCH", QUI$M_PEND_STOCK_MISMATCH },
1311 { TYP_INT, "PRIORITY", QUI$_PRIORITY },
1312 { TYP_LSTR, "PROCESSOR", QUI$_PROCESSOR },
1313 { TYP_PROT, "PROTECTION", QUI$_PROTECTION },
1314 { TYP_QUF, "QUEUE_ACL_SPECIFIED", QUI$M_QUEUE_ACL_SPECIFIED },
1315 { TYP_QUS, "QUEUE_ALIGNING", QUI$M_QUEUE_ALIGNING },
1316 { TYP_QUF, "QUEUE_BATCH", QUI$M_QUEUE_BATCH },
1317 { TYP_QUS, "QUEUE_CLOSED", QUI$M_QUEUE_CLOSED },
1318 { TYP_QUF, "QUEUE_CPU_DEFAULT", QUI$M_QUEUE_CPU_DEFAULT },
1319 { TYP_QUF, "QUEUE_CPU_LIMIT", QUI$M_QUEUE_CPU_LIMIT },
1320 { TYP_MSTR, "QUEUE_DESCRIPTION", QUI$_QUEUE_DESCRIPTION },
1321 { TYP_QUF, "QUEUE_FILE_BURST", QUI$M_QUEUE_FILE_BURST },
1322 { TYP_QUF, "QUEUE_FILE_BURST_ONE", QUI$M_QUEUE_FILE_BURST_ONE },
1323 { TYP_QUF, "QUEUE_FILE_FLAG", QUI$M_QUEUE_FILE_FLAG },
1324 { TYP_QUF, "QUEUE_FILE_FLAG_ONE", QUI$M_QUEUE_FILE_FLAG_ONE },
1325 { TYP_QUF, "QUEUE_FILE_PAGINATE", QUI$M_QUEUE_FILE_PAGINATE },
1326 { TYP_QUF, "QUEUE_FILE_TRAILER", QUI$M_QUEUE_FILE_TRAILER },
1327 { TYP_QUF, "QUEUE_FILE_TRAILER_ONE",QUI$M_QUEUE_FILE_TRAILER_ONE },
1328 { TYP_INT, "QUEUE_FLAGS", QUI$_QUEUE_FLAGS },
1329 { TYP_QUF, "QUEUE_GENERIC", QUI$M_QUEUE_GENERIC },
1330 { TYP_QUF, "QUEUE_GENERIC_SELECTION",QUI$M_QUEUE_GENERIC_SELECTION },
1331 { TYP_QUS, "QUEUE_IDLE", QUI$M_QUEUE_IDLE },
1332 { TYP_QUF, "QUEUE_JOB_BURST", QUI$M_QUEUE_JOB_BURST },
1333 { TYP_QUF, "QUEUE_JOB_FLAG", QUI$M_QUEUE_JOB_FLAG },
1334 { TYP_QUF, "QUEUE_JOB_SIZE_SCHED", QUI$M_QUEUE_JOB_SIZE_SCHED },
1335 { TYP_QUF, "QUEUE_JOB_TRAILER", QUI$M_QUEUE_JOB_TRAILER },
1336 { TYP_QUS, "QUEUE_LOWERCASE", QUI$M_QUEUE_LOWERCASE },
1337 { TYP_LSTR, "QUEUE_NAME", QUI$_QUEUE_NAME },
1338 { TYP_QUS, "QUEUE_PAUSED", QUI$M_QUEUE_PAUSED },
1339 { TYP_QUS, "QUEUE_PAUSING", QUI$M_QUEUE_PAUSING },
1340 { TYP_QUF, "QUEUE_PRINTER", QUI$M_QUEUE_PRINTER },
1341 { TYP_QUF, "QUEUE_RECORD_BLOCKING", QUI$M_QUEUE_RECORD_BLOCKING },
1342 { TYP_QUS, "QUEUE_REMOTE", QUI$M_QUEUE_REMOTE },
1343 { TYP_QUS, "QUEUE_RESETTING", QUI$M_QUEUE_RESETTING },
1344 { TYP_QUS, "QUEUE_RESUMING", QUI$M_QUEUE_RESUMING },
1345 { TYP_QUF, "QUEUE_RETAIN_ALL", QUI$M_QUEUE_RETAIN_ALL },
1346 { TYP_QUF, "QUEUE_RETAIN_ERROR", QUI$M_QUEUE_RETAIN_ERROR },
1347 { TYP_QUS, "QUEUE_SERVER", QUI$M_QUEUE_SERVER },
1348 { TYP_QUS, "QUEUE_STALLED", QUI$M_QUEUE_STALLED },
1349 { TYP_QUS, "QUEUE_STARTING", QUI$M_QUEUE_STARTING },
1350 { TYP_INT, "QUEUE_STATUS", QUI$_QUEUE_STATUS },
1351 { TYP_QUS, "QUEUE_STOPPED", QUI$M_QUEUE_STOPPED },
1352 { TYP_QUS, "QUEUE_STOPPING", QUI$M_QUEUE_STOPPING },
1353 { TYP_QUF, "QUEUE_SWAP", QUI$M_QUEUE_SWAP },
1354 { TYP_QUF, "QUEUE_TERMINAL", QUI$M_QUEUE_TERMINAL },
1355 { TYP_QUS, "QUEUE_UNAVAILABLE", QUI$M_QUEUE_UNAVAILABLE },
1356 { TYP_QUF, "QUEUE_WSDEFAULT", QUI$M_QUEUE_WSDEFAULT },
1357 { TYP_QUF, "QUEUE_WSEXTENT", QUI$M_QUEUE_WSEXTENT },
1358 { TYP_QUF, "QUEUE_WSQUOTA", QUI$M_QUEUE_WSQUOTA },
1359 { TYP_LSTR, "REQUEUE_QUEUE_NAME", QUI$_REQUEUE_QUEUE_NAME },
1360 { TYP_LSTR, "RESTART_QUEUE_NAME", QUI$_RESTART_QUEUE_NAME },
1361 { TYP_INT, "RETAINED_JOB_COUNT", QUI$_RETAINED_JOB_COUNT },
1362 { TYP_LSTR, "SCSNODE_NAME", QUI$_SCSNODE_NAME },
1363 { TYP_TIME, "SUBMISSION_TIME", QUI$_SUBMISSION_TIME },
1364 { TYP_INT, "TIMED_RELEASE_JOB_COUNT",QUI$_TIMED_RELEASE_JOB_COUNT },
1365 { TYP_LSTR, "UIC", QUI$_UIC },
1366 { TYP_LSTR, "USERNAME", QUI$_USERNAME },
1367 { TYP_INT, "WSDEFAULT", QUI$_WSDEFAULT },
1368 { TYP_INT, "WSEXTENT", QUI$_WSEXTENT },
1369 { TYP_INT, "WSQUOTA", QUI$_WSQUOTA },
1370 } ;
1371
1372 static const struct dvi_items_type qui_flags[] = {
1373 { TYP_INT, "ALL_JOBS", QUI$M_SEARCH_ALL_JOBS },
1374 { TYP_INT, "BATCH", QUI$M_SEARCH_BATCH },
1375 { TYP_INT, "EXECUTING_JOBS", QUI$M_SEARCH_EXECUTING_JOBS },
1376 { TYP_INT, "FREEZE_CONTEXT", QUI$M_SEARCH_FREEZE_CONTEXT },
1377 { TYP_INT, "GENERIC", QUI$M_SEARCH_GENERIC },
1378 { TYP_INT, "HOLDING_JOBS", QUI$M_SEARCH_HOLDING_JOBS },
1379 { TYP_INT, "PENDING_JOBS", QUI$M_SEARCH_PENDING_JOBS },
1380 { TYP_INT, "PRINTER", QUI$M_SEARCH_PRINTER },
1381 { TYP_INT, "RETAINED_JOBS", QUI$M_SEARCH_RETAINED_JOBS },
1382 { TYP_INT, "SERVER", QUI$M_SEARCH_SERVER },
1383 { TYP_INT, "SYMBIONT", QUI$M_SEARCH_SYMBIONT },
1384 { TYP_INT, "TERMINAL", QUI$M_SEARCH_TERMINAL },
1385 { TYP_INT, "THIS_JOB", QUI$M_SEARCH_THIS_JOB },
1386 { TYP_INT, "TIMED_RELEASE_JOBS", QUI$M_SEARCH_TIMED_RELEASE_JOBS },
1387 { TYP_INT, "WILDCARD", QUI$M_SEARCH_WILDCARD },
1388 } ;
1389
1390 static const int qui_stats[] = {
1391 QUI$_FILE_FLAGS, QUI$_FILE_STATUS,
1392 QUI$_FORM_FLAGS, QUI$_JOB_FLAGS,
1393 QUI$_JOB_STATUS, QUI$_PENDING_JOB_REASON,
1394 QUI$_QUEUE_FLAGS, QUI$_QUEUE_STATUS,
1395 } ;
1396
1397
1398 streng *vms_f_getqui( tsd_t *TSD, cparamboxptr parms )
1399 {
1400 short length, func ;
1401 int flags, i, item_value, objnum, rc, usenum, item_mask ;
1402 char buffer[256] ;
1403 int items[21], cnt=0, *vector ;
1404 int search_flags=0, search_length=4, search_number[10], search_nlength ;
1405 cparamboxptr tmp ;
1406 int ioblk[2] ;
1407 streng *item, *objid ;
1408 struct dvi_items_type *ptr, *item_ptr ;
1409 $DESCRIPTOR( objdescr, "" ) ;
1410 $DESCRIPTOR( resdescr, buffer ) ;
1411
1412 if (!parms->value)
1413 exiterror( ERR_INCORRECT_CALL , 0 ) ;
1414
1415 /*
1416 * First, find the function we are to perform, that is the first parameter
1417 * in the call to f$getqui().
1418 */
1419 if (!(ptr=item_info( parms->value, qui_funcs, sizeof(qui_funcs))))
1420 exiterror( ERR_INCORRECT_CALL , 0 ) ;
1421
1422 /*
1423 * Depending on the function chosen, check that the parameters are legal
1424 * for than function. I.e. all parameters that must be specified exists,
1425 * and no illegal parameters are specified.
1426 */
1427 tmp = parms->next ;
1428 for (i=0; i<3; i++)
1429 {
1430 if (((ptr->type >> i) & 0x01) && ((!tmp) || (!tmp->value)))
1431 exiterror( ERR_INCORRECT_CALL , 0 ) ;
1432
1433 if (((ptr->type >> i) & 0x10) && ((tmp) && (tmp->value)))
1434 exiterror( ERR_INCORRECT_CALL , 0 ) ;
1435
1436 if (tmp) tmp = tmp->next ;
1437 }
1438
1439 tmp = parms->next ;
1440 if (objid = (tmp && tmp->next) ? ((tmp=tmp->next)->value) : NULL )
1441 {
1442 if (usenum=myisnumber(TSD, objid))
1443 {
1444 items[cnt++] = 4 + ( QUI$_SEARCH_NUMBER << 16 ) ;
1445 items[cnt++] = (int)&(search_number[0]) ;
1446 items[cnt++] = (int)NULL /* &search_nlength */ ;
1447 search_number[0] = atozpos(TSD, objid, "VMS_F_GETQUI", 0 ) ;
1448 search_nlength = 0 ;
1449 length = 0 ;
1450 }
1451 else
1452 {
1453 items[cnt++] = objid->len + ( QUI$_SEARCH_NAME << 16 ) ;
1454 items[cnt++] = (int)&(objid->value[0]) ;
1455 items[cnt++] = (int)&search_nlength ;
1456 search_nlength = objid->len ;
1457 }
1458 }
1459
1460 /*
1461 * Now, find the item for which we are to retrieve information. If the
1462 * type-specified indicates that this is part of a vector which must
1463 * be split up, then save som vital information.
1464 */
1465 item = (tmp=parms->next) ? (tmp->value) : NULL ;
1466 if (item)
1467 {
1468 item_ptr = item_info( item, qui_items, sizeof( qui_items )) ;
1469 if (!item_ptr)
1470 exiterror( ERR_INCORRECT_CALL , 0 ) ;
1471
1472 if (item_ptr->type >= TYP_SPECIFICS)
1473 {
1474 item_value = qui_stats[ item_ptr->type - TYP_SPECIFICS ] ;
1475 item_mask = item_ptr->addr ;
1476 }
1477 else
1478 item_value = item_ptr->addr ;
1479
1480 items[cnt++] = 256 + ( item_value << 16 ) ;
1481 items[cnt++] = (int)buffer ;
1482 items[cnt++] = (int)&length ;
1483 vector = (int *)buffer ;
1484
1485 if (!(leg_items[item_ptr - qui_items] & (1 << (ptr-qui_funcs))))
1486 exiterror( ERR_INCORRECT_CALL , 0 ) ;
1487 }
1488 else
1489 item_ptr = NULL ;
1490
1491 items[cnt++] = 0 ;
1492 items[cnt++] = 0 ;
1493 items[cnt++] = 0 ;
1494
1495 func = ptr->addr ;
1496 ioblk[0] = ioblk[1] = 0 ;
1497
1498 rc = sys$getquiw( NULL, func, NULL, &items, ioblk, NULL, NULL ) ;
1499
1500 if ((rc==SS$_NORMAL) && ((ioblk[0]==JBC$_NOSUCHJOB) ||
1501 (ioblk[0]==JBC$_NOMOREQUE) || (ioblk[0]==JBC$_NOQUECTX)))
1502 return nullstringptr() ;
1503
1504 if (rc != SS$_NORMAL)
1505 {
1506 vms_error( TSD, rc ) ;
1507 return nullstringptr() ;
1508 }
1509
1510 if (!item_ptr)
1511 return nullstringptr() ;
1512
1513 if (ioblk[0] != JBC$_NORMAL)
1514 {
1515 vms_error( TSD, ioblk[0] ) ;
1516 return nullstringptr() ;
1517 }
1518
1519 if ( item_ptr->type >= TYP_SPECIFICS)
1520 return Str_creTSD( (*vector & item_ptr->addr) ? "TRUE" : "FALSE" ) ;
1521
1522 return format_result( TSD, item_ptr->type, buffer, length ) ;
1523 }
1524
1525
1526
1527 static const struct dvi_items_type syi_items[] = {
1528 { TYP_INT, "ACTIVECPU_CNT", SYI$_ACTIVECPU_CNT },
1529 { TYP_INT, "ARCHFLAG", SYI$_ARCHFLAG },
1530 { TYP_INT, "AVAILCPU_CNT", SYI$_AVAILCPU_CNT },
1531 { TYP_TIME, "BOOTTIME", SYI$_BOOTTIME },
1532 { TYP_BOOL, "CHARACTER_EMULATED", SYI$_CHARACTER_EMULATED },
1533 /* { TYP_INT, "CLUSTER_EVOTES", SYI$_CLUSTER_EVOTES }, */
1534 { TYP_LHEX, "CLUSTER_FSYSID", SYI$_CLUSTER_FSYSID },
1535 { TYP_TIME, "CLUSTER_FTIME", SYI$_CLUSTER_FTIME },
1536 { TYP_BOOL, "CLUSTER_MEMBER", SYI$_CLUSTER_MEMBER },
1537 { TYP_INT, "CLUSTER_NODES", SYI$_CLUSTER_NODES },
1538 { TYP_INT, "CLUSTER_QUORUM", SYI$_CLUSTER_QUORUM },
1539 { TYP_INT, "CLUSTER_VOTES", SYI$_CLUSTER_VOTES },
1540 { TYP_INT, "CONTIG_GBLPAGES", SYI$_CONTIG_GBLPAGES },
1541 { TYP_INT, "CPU", SYI$_CPU },
1542 { TYP_BOOL, "DECIMAL_EMULATED", SYI$_DECIMAL_EMULATED },
1543 { TYP_BOOL, "D_FLOAT_EMULATED", SYI$_D_FLOAT_EMULATED },
1544 { TYP_INT, "ERRORLOGBUFFERS", SYI$_ERRORLOGBUFFERS },
1545 { TYP_INT, "FREE_GBLPAGES", SYI$_FREE_GBLPAGES },
1546 { TYP_INT, "FREE_GBLSECTS", SYI$_FREE_GBLSECTS },
1547 { TYP_BOOL, "F_FLOAT_EMULATED", SYI$_F_FLOAT_EMULATED },
1548 { TYP_BOOL, "G_FLOAT_EMULATED", SYI$_G_FLOAT_EMULATED },
1549 { TYP_INT, "HW_MODEL", SYI$_HW_MODEL },
1550 { TYP_LSTR, "HW_NAME", SYI$_HW_NAME },
1551 { TYP_BOOL, "H_FLOAT_EMULATED", SYI$_H_FLOAT_EMULATED },
1552 { TYP_LSTR, "NODENAME", SYI$_NODENAME },
1553 { TYP_INT, "NODE_AREA", SYI$_NODE_AREA },
1554 { TYP_LHEX, "NODE_CSID", SYI$_NODE_CSID },
1555 { TYP_INT, "NODE_EVOTES", SYI$_NODE_EVOTES },
1556 { TYP_LSTR, "NODE_HWTYPE", SYI$_NODE_HWTYPE },
1557 { TYP_LHEX, "NODE_HWVERS", SYI$_NODE_HWVERS },
1558 { TYP_INT, "NODE_NUMBER", SYI$_NODE_NUMBER },
1559 { TYP_INT, "NODE_QUORUM", SYI$_NODE_QUORUM },
1560 { TYP_LHEX, "NODE_SWINCARN", SYI$_NODE_SWINCARN },
1561 { TYP_LSTR, "NODE_SWTYPE", SYI$_NODE_SWTYPE },
1562 { TYP_LSTR, "NODE_SWVERS", SYI$_NODE_SWVERS },
1563 { TYP_LHEX, "NODE_SYSTEMID", SYI$_NODE_SYSTEMID },
1564 { TYP_INT, "NODE_VOTES", SYI$_NODE_VOTES },
1565 { TYP_INT, "PAGEFILE_FREE", SYI$_PAGEFILE_FREE },
1566 { TYP_INT, "PAGEFILE_PAGE", SYI$_PAGEFILE_PAGE },
1567 { TYP_BOOL, "SCS_EXISTS", SYI$_SCS_EXISTS },
1568 { TYP_INT, "SID", SYI$_SID },
1569 { TYP_INT, "SWAPFILE_FREE", SYI$_SWAPFILE_FREE },
1570 { TYP_INT, "SWAPFILE_PAGE", SYI$_SWAPFILE_PAGE },
1571 { TYP_LSTR, "VERSION", SYI$_VERSION },
1572 { TYP_INT, "XCPU", SYI$_XCPU },
1573 { TYP_INT, "XSID", SYI$_XSID },
1574 } ;
1575
1576 streng *vms_f_getsyi( tsd_t *TSD, cparamboxptr parms )
1577 {
1578 char buffer[64] ;
1579 int length=0, rc, item[6] ;
1580 struct dvi_items_type *ptr ;
1581 struct dsc$descriptor_s name, *namep=NULL ;
1582 struct dsc$descriptor_s dir = {
1583 sizeof(buffer)-1, DSC$K_DTYPE_T, DSC$K_CLASS_S, buffer } ;
1584
1585 checkparam( parms, 1, 2, "VMS_F_GETSYI" ) ;
1586
1587 ptr = item_info( parms->value, syi_items, sizeof( syi_items)) ;
1588 if (!ptr)
1589 exiterror( ERR_INCORRECT_CALL , 0 ) ;
1590
1591 item[0] = 64 + (ptr->addr << 16) ;
1592 item[1] = (int)buffer ;
1593 item[2] = (int)&length ;
1594 item[3] = item[4] = item[5] = 0 ;
1595
1596 if (parms->next && parms->next->value)
1597 {
1598 namep = &name ;
1599 name.dsc$w_length = Str_len( parms->value ) ;
1600 name.dsc$b_dtype = DSC$K_DTYPE_T ;
1601 name.dsc$b_class = DSC$K_CLASS_S ;
1602 name.dsc$a_pointer = parms->value->value ;
1603 }
1604
1605 rc = sys$getsyiw( NULL, NULL, namep, &item[0], NULL, NULL, NULL ) ;
1606
1607 if (rc != SS$_NORMAL)
1608 {
1609 vms_error( TSD, rc ) ;
1610 return Str_creTSD("") ;
1611 }
1612
1613 return format_result( TSD, ptr->type, buffer, length ) ;
1614 }
1615
1616
1617
1618 streng *vms_f_identifier( tsd_t *TSD, cparamboxptr parms )
1619 {
1620 streng *in, *type, *result ;
1621 int id=0 ;
1622
1623 checkparam( parms, 2, 2, "VMS_F_IDENTIFIER" ) ;
1624
1625 type = parms->next->value ;
1626
1627 if (type->len != 14)
1628 exiterror( ERR_INCORRECT_CALL , 0 ) ;
1629
1630 if (!strncmp(type->value, "NAME_TO_NUMBER", 14))
1631 result = int_to_streng( TSD, name_to_num( TSD, parms->value )) ;
1632 else if (!strncmp(type->value, "NUMBER_TO_NAME", 14))
1633 {
1634 result = num_to_name( TSD, atozpos( TSD, parms->value, "VMS_F_IDENTIFIER", 1 )) ;
1635 if (!result)
1636 result = nullstringptr() ;
1637 }
1638 else
1639 exiterror( ERR_INCORRECT_CALL , 0 ) ;
1640
1641 return result ;
1642 }
1643
1644
1645
1646 streng *vms_f_message( tsd_t *TSD, cparamboxptr parms )
1647 {
1648 char buffer[256] ;
1649 $DESCRIPTOR( name, buffer ) ;
1650 int length, rc, errmsg ;
1651
1652 checkparam( parms, 1, 1, "VMS_F_MESSAGE" ) ;
1653 errmsg = atopos( TSD, parms->value, "VMS_F_MESSAGE", 1 ) ;
1654
1655 rc = sys$getmsg( errmsg, &length, &name, NULL, NULL ) ;
1656
1657 if ((rc != SS$_NORMAL) && (rc != SS$_MSGNOTFND))
1658 vms_error( TSD, rc ) ;
1659
1660 return Str_ncatstrTSD( Str_makeTSD(length), buffer, length ) ;
1661 }
1662
1663
1664 streng *vms_f_mode( tsd_t *TSD, cparamboxptr parms )
1665 {
1666 char buffer[256] ;
1667 $DESCRIPTOR( descr, buffer ) ;
1668 int item = JPI$_MODE, length, rc ;
1669
1670 rc = lib$getjpi( &item, NULL, NULL, NULL, &descr, &length ) ;
1671
1672 if (rc != SS$_NORMAL)
1673 vms_error( TSD, rc ) ;
1674
1675 return Str_ncatstrTSD( Str_makeTSD(length), buffer, length ) ;
1676 }
1677
1678
1679 streng *vms_f_pid( tsd_t *TSD, cparamboxptr parms )
1680 {
1681 short length ;
1682 int *pidp=NULL, rc, buffer ;
1683 int pid;
1684 unsigned int items[6] ;
1685 const streng *Pid ;
1686 vmf_tsd_t *vt;
1687 char *str;
1688 streng *val = NULL ;
1689
1690 vt = TSD->vmf_tsd;
1691 checkparam( parms, 1, 1, "VMS_F_PID" ) ;
1692
1693 items[0] = ( JPI$_PID << 16 ) + 4 ;
1694 items[1] = (unsigned int)&buffer ;
1695 items[2] = (unsigned int)&length ;
1696 items[3] = 0 ;
1697 items[4] = 0 ;
1698 items[5] = 0 ;
1699
1700 Pid = getvalue( TSD, parms->value, -1 ) ;
1701
1702 if (Pid->len)
1703 {
1704 str = str_of( TSD, val ) ;
1705 sscanf( str, "%x", &pid ) ;
1706 FreeTSD( str ) ;
1707 }
1708 else
1709 pid = -1 ;
1710
1711 do {
1712 rc = sys$getjpiw( NULL, &pid, NULL, &items, NULL, NULL, NULL ) ;
1713 }
1714 while (rc == SS$_NOPRIV) ;
1715
1716 if ((rc != SS$_NORMAL) && (rc != SS$_NOMOREPROC))
1717 vms_error( TSD, rc ) ;
1718
1719 sprintf( (val=Str_makeTSD(10))->value, "%08x", pid ) ;
1720 val->len = 8 ;
1721 setvalue( TSD, parms->value, val, -1 ) ;
1722
1723 if (rc == SS$_NOMOREPROC)
1724 return nullstringptr() ;
1725
1726 assert( length==4 ) ;
1727 sprintf( (val=Str_makeTSD(10))->value, "%08x", buffer ) ;
1728 val->len = 8 ;
1729
1730 return val ;
1731 }
1732
1733
1734 #define MAX_PRIVS (sizeof(all_privs)/sizeof(char*))
1735
1736 static streng *map_privs( const tsd_t *TSD, const int *vector )
1737 {
1738 int i ;
1739 char *ptr, buffer[512] ;
1740
1741 *(ptr=buffer) = 0x00 ;
1742 for (i=0; i<MAX_PRIVS; i++)
1743 if ((vector[i/32] >> (i%32)) & 0x01)
1744 {
1745 strcat( ptr, all_privs[i] ) ;
1746 ptr += strlen(all_privs[i]) ;
1747 strcat( ptr++, "," ) ;
1748 }
1749
1750 if (ptr>buffer)
1751 *(--ptr) = 0x00 ;
1752
1753 return Str_ncatstrTSD( Str_makeTSD(ptr-buffer), buffer, (ptr-buffer)) ;
1754 }
1755
1756 static int extract_privs( int *vector, const streng *privs )
1757 {
1758 int max_priv, negate, i ;
1759 const char *ptr, *eptr, *tptr, *lptr ;
1760
1761 max_priv = MAX_PRIVS ;
1762
1763 eptr = Str_end( privs ) ;
1764 for (ptr=privs->value; ptr<eptr; ptr=(++lptr) )
1765 {
1766 for (; isspace(*ptr) && ptr<eptr; ptr++ ) ;
1767 for (lptr=ptr; (lptr<eptr) && (*lptr!=','); lptr++) ;
1768 for (tptr=lptr; isspace(*(tptr-1)) && tptr>=ptr; tptr-- ) ;
1769 if (tptr-ptr<3)
1770 return 1 ;
1771
1772 negate = ((*ptr=='N') && (*(ptr+1)=='O')) * 2 ;
1773 for (i=0; i<max_priv; i++)
1774 if ((!strncmp(ptr+negate,all_privs[i],tptr-ptr-negate)) &&
1775 (all_privs[i][tptr-ptr-negate] == 0x00))
1776 {
1777 if (negate)
1778 vector[2+i/32] |= (1 << (i%32)) ;
1779 else
1780 vector[i/32] |= (1 << (i%32)) ;
1781 break ;
1782 }
1783
1784 if (i==max_priv)
1785 return 1 ;
1786 }
1787 return 0 ;
1788 }
1789
1790
1791 streng *vms_f_privilege( tsd_t *TSD, cparamboxptr parms )
1792 {
1793 int privbits[4], privs[2] ;
1794 int rc ;
1795 char *ptr, *eptr, *tptr ;
1796
1797 checkparam( parms, 1, 1, "VMS_F_PRIVILEGE" ) ;
1798 extract_privs( privbits, parms->value ) ;
1799
1800 rc = lib$getjpi( &JPI$_PROCPRIV, NULL, NULL, &privs, NULL, NULL ) ;
1801 if (rc != SS$_NORMAL)
1802 vms_error( TSD, rc ) ;
1803
1804 return Str_creTSD(
1805 (((privbits[0] & ~privs[0]) | ( privbits[2] & privs[0] )) ||
1806 ((privbits[1] & ~privs[1]) | ( privbits[3] & privs[1] ))) ?
1807 "FALSE" : "TRUE" ) ;
1808 }
1809
1810
1811
1812 streng *vms_f_process( tsd_t *TSD, cparamboxptr parms )
1813 {
1814 int rc, length ;
1815 char buffer[64] ;
1816 $DESCRIPTOR( descr, buffer ) ;
1817
1818 checkparam( parms, 0, 0, "VMS_F_PROCESS" ) ;
1819 rc = lib$getjpi( &JPI$_PRCNAM, NULL, NULL, NULL, &descr, &length ) ;
1820
1821 if ( rc != SS$_NORMAL)
1822 vms_error( TSD, rc ) ;
1823
1824 return Str_ncatstrTSD( Str_makeTSD(length), buffer, length ) ;
1825 }
1826
1827
1828 streng *vms_f_string( tsd_t *TSD, cparamboxptr parms )
1829 {
1830 checkparam( parms, 1, 1, "VMS_F_STRING" ) ;
1831
1832 /* return str_norm( TSD, parms->value ) ; / * if it existed */
1833 return Str_dupTSD(parms->value) ;
1834 }
1835
1836
1837
1838 #define DAT_TIME_LEN 23
1839
1840 streng *vms_f_time( tsd_t *TSD, cparamboxptr parms )
1841 {
1842 int rc ;
1843 char buffer[32] ;
1844 $DESCRIPTOR( descr, buffer ) ;
1845
1846 checkparam( parms, 0, 0, "VMS_F_TIME" ) ;
1847
1848 rc = lib$date_time( &descr ) ;
1849 if (rc != SS$_NORMAL)
1850 vms_error( TSD, rc ) ;
1851
1852 return Str_ncatstrTSD( Str_makeTSD(DAT_TIME_LEN+1), buffer, DAT_TIME_LEN) ;
1853 }
1854
1855
1856 streng *vms_f_setprv( tsd_t *TSD, cparamboxptr parms )
1857 {
1858 int privbits[4], old[2] ;
1859 int rc ;
1860
1861 checkparam( parms, 1, 1, "VMS_F_SETPRV" ) ;
1862
1863 extract_privs( privbits, parms->value ) ;
1864 rc = sys$setprv( 0, &privbits[0], 0, &old ) ;
1865 if (rc != SS$_NORMAL)
1866 vms_error( TSD, rc ) ;
1867
1868 rc = sys$setprv( 1, &privbits[2], 0, NULL ) ;
1869 if (rc != SS$_NORMAL)
1870 vms_error( TSD, rc ) ;
1871
1872 return map_privs( TSD, old ) ;
1873 }
1874
1875
1876 streng *vms_f_user( tsd_t *TSD, cparamboxptr parms )
1877 {
1878 int item[6], rc ;
1879 short length ;
1880 union uicdef uic ;
1881
1882 checkparam( parms, 0, 0, "VMS_F_USER" ) ;
1883
1884 item[0] = 4 + ( JPI$_UIC << 16 ) ;
1885 item[1] = (int)&uic ;
1886 item[2] = (int)&length ;
1887 item[3] = item[4] = item[5] = 0 ;
1888
1889 rc = sys$getjpi( NULL, NULL, NULL, item, NULL, NULL, NULL ) ;
1890
1891 if ((rc != SS$_NORMAL) || (length != 4))
1892 {
1893 vms_error( TSD, rc ) ;
1894 return nullstringptr() ;
1895 }
1896
1897 return get_uic( TSD, &uic ) ;
1898 }
1899
1900
1901 streng *vms_f_locate( tsd_t *TSD, cparamboxptr parms )
1902 {
1903 int res ;
1904
1905 checkparam( parms, 2, 2, "VMS_F_LOCATE" ) ;
1906 res = bmstrstr( parms->next->value, 0, parms->value, 0 ) ;
1907 if (res==(-1))
1908 res = parms->next->value->len + 1 ;
1909
1910 return int_to_streng( TSD, res ) ;
1911 }
1912
1913
1914 streng *vms_f_length( tsd_t *TSD, cparamboxptr parms )
1915 {
1916 checkparam( parms, 1, 1, "VMS_F_LENGTH" ) ;
1917 return int_to_streng( TSD, parms->value->len ) ;
1918 }
1919
1920
1921 streng *vms_f_integer( tsd_t *TSD, cparamboxptr parms )
1922 {
1923 checkparam( parms, 1, 1, "VMS_F_INTEGER" ) ;
1924 return int_to_streng( TSD, myatol( TSD, parms->value )) ;
1925 }
1926
1927
1928 static const struct dvi_items_type trnlnm_cases[] = {
1929 { 1, "CASE_BLIND", LNM$M_CASE_BLIND },
1930 { 0, "CASE_SENSITIVE", LNM$M_CASE_BLIND },
1931 } ;
1932
1933 static const struct dvi_items_type trnlnm_modes[] = {
1934 { 0, "EXECUTIVE", PSL$C_EXEC },
1935 { 0, "KERNEL", PSL$C_KERNEL },
1936 { 0, "SUPERVISOR", PSL$C_SUPER },
1937 { 0, "USER", PSL$C_USER },
1938 } ;
1939
1940 static const struct dvi_items_type trnlnm_list[] = {
1941 { TYP_TRNM, "ACCESS_MODE", LNM$_ACMODE },
1942 { TYP_FLAG, "CONCEALED", LNM$M_CONCEALED },
1943 { TYP_FLAG, "CONFINE", LNM$M_CONFINE },
1944 { TYP_FLAG, "CRELOG", LNM$M_CRELOG },
1945 { TYP_INT, "LENGTH", LNM$_LENGTH },
1946 { TYP_INT, "MAX_INDEX", LNM$_MAX_INDEX },
1947 { TYP_FLAG, "NO_ALIAS", LNM$M_NO_ALIAS },
1948 { TYP_FLAG, "TABLE", LNM$M_TABLE },
1949 { TYP_LSTR, "TABLE_NAME", LNM$_TABLE },
1950 { TYP_FLAG, "TERMINAL", LNM$M_TERMINAL },
1951 { TYP_BSTR, "VALUE", LNM$_STRING },
1952 } ;
1953
1954 streng *vms_f_trnlnm( tsd_t *TSD, cparamboxptr parms )
1955 {
1956 char buffer[256] ;
1957 $DESCRIPTOR( lognam, "" ) ;
1958 $DESCRIPTOR( tabnam, "LNM$DCL_LOGICAL" ) ;
1959 short length ;
1960 int attr=0, item=LNM$_STRING, rc, cnt=0, index ;
1961 unsigned char mode ;
1962 int attribs, lattribs ;
1963 struct dvi_items_type *item_ptr ;
1964 cparamboxptr ptr ;
1965 int items[20] ;
1966
1967 checkparam( parms, 1, 6, "VMS_F_TRNLNM" ) ;
1968
1969 ptr = parms ;
1970 lognam.dsc$a_pointer = ptr->value->value ;
1971 lognam.dsc$w_length = ptr->value->len ;
1972
1973 if (ptr) ptr=ptr->next ;
1974 if (ptr && ptr->value)
1975 {
1976 tabnam.dsc$a_pointer = ptr->value->value ;
1977 tabnam.dsc$w_length = ptr->value->len ;
1978 }
1979
1980 if (ptr) ptr=ptr->next ;
1981 if (ptr && ptr->value)
1982 {
1983 index = atozpos( TSD, ptr->value, "VMS_F_TRNLNM", 0 ) ;
1984 if (index<0 || index>127)
1985 exiterror( ERR_INCORRECT_CALL , 0 ) ;
1986
1987 items[cnt++] = 4 + ( LNM$_INDEX << 16 ) ;
1988 items[cnt++] = (int)&index ;
1989 items[cnt++] = 0 ;
1990 }
1991
1992 if (ptr) ptr=ptr->next ;
1993 if (ptr && ptr->value)
1994 {
1995 item_ptr = item_info( ptr->value, trnlnm_modes, sizeof( trnlnm_modes)) ;
1996 if (!item_ptr)
1997 exiterror( ERR_INCORRECT_CALL , 0 ) ;
1998
1999 mode = item_ptr->addr ;
2000 }
2001 else
2002 mode = PSL$C_USER ;
2003
2004 if (ptr) ptr=ptr->next ;
2005 if (ptr && ptr->value)
2006 {
2007 item_ptr = item_info( ptr->value, trnlnm_cases, sizeof( trnlnm_cases)) ;
2008 if (!item_ptr)
2009 exiterror( ERR_INCORRECT_CALL , 0 ) ;
2010 /*
2011 * Digital says that bit zero is used, and LNM$M_CASE_BLIND points to
2012 * that bit, but LNM$M_CASE_BLIND is (1<<25). My guess is that there
2013 * is (yet another) f*ckup in DEC's documentation, so I hardcode the
2014 * value.
2015 */
2016 /* attr = ( item_ptr->type << item_ptr->addr ) ; */ /* don't work */
2017 attr = ( item_ptr->type << 0 ) ;
2018 }
2019
2020 if (ptr) ptr=ptr->next ;
2021 if (ptr && ptr->value)
2022 {
2023 item_ptr = item_info( ptr->value, trnlnm_list, sizeof(trnlnm_list)) ;
2024 if (!item_ptr)
2025 exiterror( ERR_INCORRECT_CALL , 0 ) ;
2026
2027 if (item_ptr->type == TYP_FLAG)
2028 item = (LNM$_ATTRIBUTES) ;
2029 else
2030 item = item_ptr->addr ;
2031 }
2032 else
2033 item_ptr = 0 ;
2034
2035 items[cnt++] = 256 + ( item << 16 ) ;
2036 items[cnt++] = (int)buffer ;
2037 items[cnt++] = (int)&length ;
2038
2039 items[cnt++] = 0 ;
2040 items[cnt++] = 0 ;
2041 items[cnt++] = 0 ;
2042
2043 rc = sys$trnlnm( &attr, &tabnam, &lognam, &mode, items ) ;
2044
2045 if (rc== SS$_NOLOGNAM)
2046 return nullstringptr() ;
2047
2048 if (rc != SS$_NORMAL)
2049 {
2050 vms_error( TSD, rc ) ;
2051 return nullstringptr() ;
2052 }
2053
2054 if (buffer[0]==0x1b && buffer[1]==0x00 &&
2055 ((item_ptr && item_ptr->addr==LNM$_STRING) || (!item_ptr)))
2056 return format_result( TSD, TYP_LSTR, &buffer[4], length-4) ;
2057
2058 if (item_ptr && item_ptr->type == TYP_TRNM)
2059 {
2060 for (cnt=0; cnt<sizeof(trnlnm_modes)/sizeof(struct dvi_items_type);cnt++)
2061 if (trnlnm_modes[cnt].addr == (*((unsigned char*)buffer)))
2062 return Str_creTSD( trnlnm_modes[cnt].name ) ;
2063 exiterror( ERR_SYSTEM_FAILURE , 0 ) ;
2064 }
2065
2066 if (item_ptr && item_ptr->type == TYP_FLAG)
2067 return Str_creTSD( (*((int*)buffer) & item_ptr->addr) ? "TRUE" : "FALSE" ) ;
2068
2069 if (item_ptr)
2070 return format_result( TSD, item_ptr->type, buffer, length ) ;
2071 else
2072 return format_result( TSD, TYP_BSTR, buffer, length ) ;
2073 }
2074
2075
2076
2077 streng *vms_f_logical( tsd_t *TSD, cparamboxptr parms )
2078 {
2079 checkparam( parms, 1, 1, "VMS_F_LOGICAL" ) ;
2080 return vms_f_trnlnm( TSD, parms ) ;
2081 }
2082
2083
2084
2085 static const struct dvi_items_type parse_types[] = {
2086 { 0, "NO_CONCEAL", NAM$M_NOCONCEAL },
2087 { 0, "SYNTAX_ONLY", NAM$M_SYNCHK },
2088 } ;
2089
2090
2091 #define PARSE_EVERYTHING 0x00
2092 #define PARSE_DEVICE 0x01
2093 #define PARSE_DIRECTORY 0x02
2094 #define PARSE_NAME 0x04
2095 #define PARSE_NODE 0x08
2096 #define PARSE_TYPE 0x10
2097 #define PARSE_VERSION 0x20
2098
2099 static const struct dvi_items_type parse_fields[] = {
2100 { 0, "DEVICE", PARSE_DEVICE },
2101 { 0, "DIRECTORY", PARSE_DIRECTORY },
2102 { 0, "NAME", PARSE_NAME },
2103 { 0, "NODE", PARSE_NODE },
2104 { 0, "TYPE", PARSE_TYPE },
2105 { 0, "VERSION", PARSE_VERSION },
2106 } ;
2107
2108
2109
2110 streng *vms_f_parse( tsd_t *TSD, cparamboxptr parms )
2111 {
2112 char relb[256], expb[256], relb2[256], expb2[256] ;
2113 int clen, rc, fields ;
2114 char *cptr ;
2115 struct dvi_items_type *item ;
2116 cparamboxptr ptr ;
2117 streng *result ;
2118 struct FAB fab, relfab ;
2119 struct NAM nam, relnam ;
2120
2121 checkparam( parms, 1, 5, "VMS_F_PARSE" ) ;
2122 ptr = parms ;
2123
2124 memcpy( &fab, &cc$rms_fab, sizeof(struct FAB)) ;
2125 memcpy( &nam, &cc$rms_nam, sizeof(struct NAM)) ;
2126
2127 fab.fab$l_fna = ptr->value->value ;
2128 fab.fab$b_fns = ptr->value->len ;
2129
2130 /*
2131 nam.nam$l_rsa = buffer ;
2132 nam.nam$b_rss = sizeof(buffer)-1 ;
2133 */
2134 nam.nam$l_esa = expb ;
2135 nam.nam$b_ess = sizeof(expb)-1 ;
2136
2137 fab.fab$w_ifi = 0 ;
2138 fab.fab$l_fop &= ~(FAB$M_OFP) ;
2139 fab.fab$l_nam = &nam ;
2140
2141 ptr=ptr->next ;
2142 if (ptr && ptr->value)
2143 {
2144 fab.fab$l_dna = ptr->value->value ;
2145 fab.fab$b_dns = ptr->value->len ;
2146 }
2147
2148 if (ptr) ptr=ptr->next ;
2149 if (ptr && ptr->value)
2150 {
2151 memcpy( &relfab, &cc$rms_fab, sizeof(struct FAB)) ;
2152 memcpy( &relnam, &cc$rms_nam, sizeof(struct NAM)) ;
2153 relnam.nam$l_rsa = ptr->value->value ;
2154 relnam.nam$b_rsl = ptr->value->len ;
2155 relnam.nam$b_rss = ptr->value->len ;
2156
2157 nam.nam$l_rlf = &relnam ;
2158 }
2159
2160 if (ptr) ptr=ptr->next ;
2161 if (ptr && ptr->value)
2162 {
2163 item = item_info( ptr->value, parse_fields, sizeof(parse_fields)) ;
2164 if (!item)
2165 exiterror( ERR_INCORRECT_CALL , 0 ) ;
2166 fields = item->addr ;
2167 }
2168 else
2169 fields = PARSE_EVERYTHING ;
2170
2171 if (ptr) ptr=ptr->next ;
2172 if (ptr && ptr->value)
2173 {
2174 item = item_info( ptr->value, parse_types, sizeof(parse_types)) ;
2175 if (!item)
2176 exiterror( ERR_INCORRECT_CALL , 0 ) ;
2177 nam.nam$b_nop |= item->addr ;
2178 }
2179
2180 rc = sys$parse( &fab, NULL, NULL ) ;
2181
2182 if ((rc==RMS$_SYN) || (rc==RMS$_DEV) || (rc==RMS$_DNF) || (rc==RMS$_DIR) ||
2183 (rc==RMS$_NOD))
2184 return nullstringptr() ;
2185
2186 if (rc != RMS$_NORMAL)
2187 {
2188 vms_error( TSD, rc ) ;
2189 return nullstringptr() ;
2190 }
2191
2192 switch( fields )
2193 {
2194 case PARSE_EVERYTHING:
2195 cptr = nam.nam$l_esa ; clen = nam.nam$b_esl ; break ;
2196
2197 case PARSE_DEVICE:
2198 cptr = nam.nam$l_dev ; clen = nam.nam$b_dev ; break ;
2199
2200 case PARSE_DIRECTORY:
2201 cptr = nam.nam$l_dir ; clen = nam.nam$b_dir ; break ;
2202
2203 case PARSE_NAME:
2204 cptr = nam.nam$l_name ; clen = nam.nam$b_name ; break ;
2205
2206 case PARSE_NODE:
2207 cptr = nam.nam$l_node ; clen = nam.nam$b_node ; break ;
2208
2209 case PARSE_TYPE:
2210 cptr = nam.nam$l_type ; clen = nam.nam$b_type ; break ;
2211
2212 case PARSE_VERSION:
2213 cptr = nam.nam$l_ver ; clen = nam.nam$b_ver ; break ;
2214
2215 default:
2216 exiterror( ERR_INTERPRETER_FAILURE, 1, __FILE__, __LINE__, "" ) ;
2217 }
2218
2219 result = Str_makeTSD( clen ) ;
2220 memcpy( result->value, cptr, result->len=clen ) ;
2221
2222 return result ;
2223 }
2224
2225
2226
2227 streng *vms_f_search( tsd_t *TSD, cparamboxptr parms )
2228 {
2229 streng *name, *result ;
2230 int context, rc, search ;
2231 struct fabptr *fptr ;
2232 vmf_tsd_t *vt;
2233
2234 vt = TSD->vmf_tsd;
2235 checkparam( parms, 1, 2, "VMS_F_SEARCH" ) ;
2236
2237 name = parms->value ;
2238 context = (parms->next && parms->next->value) ?
2239 atopos(TSD, parms->next->value, "VMS_F_SEARCH", 2 ) : 0 ;
2240
2241 search = (context/16) ;
2242 for (fptr=vt->fabptrs[search]; fptr && fptr->num!=context; fptr=fptr->next) ;
2243 if (!fptr)
2244 {
2245
2246 fptr = MallocTSD( sizeof(struct fabptr)) ;
2247 fptr->num = context ;
2248 fptr->next = vt->fabptrs[search] ;
2249 vt->fabptrs[search] = fptr ;
2250 fptr->box = MallocTSD( sizeof(struct FAB)) ;
2251 memcpy( fptr->box, &cc$rms_fab, sizeof(struct FAB)) ;
2252 fptr->box->fab$l_nam = MallocTSD( sizeof(struct NAM)) ;
2253 memcpy( fptr->box->fab$l_nam, &cc$rms_nam, sizeof(struct NAM)) ;
2254 fptr->box->fab$l_nam->nam$l_esa = MallocTSD( 256 ) ;
2255 fptr->box->fab$l_nam->nam$b_ess = 255 ;
2256 fptr->box->fab$l_nam->nam$l_rsa = MallocTSD( 256 ) ;
2257 fptr->box->fab$l_nam->nam$b_rss = 255 ;
2258 fptr->box->fab$l_nam->nam$b_rsl = 0 ;
2259 fptr->box->fab$l_fna = NULL ;
2260 fptr->box->fab$b_fns = 0 ;
2261 }
2262
2263 if (context==0 && ((name->len!=fptr->box->fab$b_fns) ||
2264 memcmp(name->value, fptr->box->fab$l_fna, name->len )))
2265 fptr->box->fab$l_nam->nam$b_rsl = 0 ;
2266
2267 if (fptr->box->fab$l_nam->nam$b_rsl == 0)
2268 {
2269 /* fptr->box->fab$l_dna = NULL ;
2270 fptr->box->fab$b_dns = 0 ; */
2271 fptr->name = Str_dupTSD( name ) ;
2272 fptr->box->fab$l_fna = fptr->name->value ;
2273 fptr->box->fab$b_fns = fptr->name->len ;
2274 /* fptr->box->fab$l_fop |= FAB$M_OFP ; */
2275 fptr->box->fab$w_ifi = 0 ;
2276 /* fptr->box->fab$l_nam->nam$b_nop = NAM$M_PWD ;
2277 fptr->box->fab$l_nam->nam$l_rlf = NULL ; */
2278
2279 rc = sys$parse( fptr->box, NULL, NULL ) ;
2280
2281 if (rc != RMS$_NORMAL)
2282 {
2283 vms_error( TSD, rc ) ;
2284 return nullstringptr() ;
2285 }
2286 }
2287
2288 rc = sys$search( fptr->box, NULL, NULL ) ;
2289 if (rc == RMS$_NMF)
2290 return nullstringptr() ;
2291
2292 if (rc != RMS$_NORMAL)
2293 {
2294 vms_error( TSD, rc ) ;
2295 return nullstringptr() ;
2296 }
2297
2298 result = Str_makeTSD( fptr->box->fab$l_nam->nam$b_rsl ) ;
2299 result->len = fptr->box->fab$l_nam->nam$b_rsl ;
2300 memcpy( result->value, fptr->box->fab$l_nam->nam$l_rsa, result->len ) ;
2301
2302 return result ;
2303 }
2304
2305
2306
2307 streng *vms_f_type( tsd_t *TSD, cparamboxptr parms )
2308 {
2309 checkparam( parms, 1, 1, "VMS_F_TYPE" ) ;
2310 return Str_creTSD(myisinteger( parms->value ) ? "INTEGER" : "STRING" ) ;
2311 }
2312
2313
2314 static streng *boolean( const tsd_t *TSD, const int param )
2315 {
2316 return Str_creTSD( param ? "TRUE" : "FALSE" ) ;
2317 }
2318
2319 #define FIL_ALQ 1
2320 #define FIL_BDT 2
2321 #define FIL_BKS 3
2322 #define FIL_BLS 4
2323 #define FIL_CBT 5
2324 #define FIL_CDT 6
2325 #define FIL_CTG 7
2326 #define FIL_DEQ 8
2327 #define FIL_DID 9
2328 #define FIL_DVI 10
2329 #define FIL_EDT 11
2330 #define FIL_EOF 12
2331 #define FIL_FID 13
2332 #define FIL_FSZ 14
2333 #define FIL_GRP 15
2334 #define FIL_KNOWN 16
2335 #define FIL_MBM 17
2336 #define FIL_MRN 101
2337 #define FIL_MRS 18
2338 #define FIL_NOA 19
2339 #define FIL_NOK 20
2340 #define FIL_ORG 21
2341 #define FIL_PRO 22
2342 #define FIL_PVN 23
2343 #define FIL_RAT 24
2344 #define FIL_RCK 25
2345 #define FIL_RDT 26
2346 #define FIL_RFM 27
2347 #define FIL_RVN 28
2348 #define FIL_UIC 29
2349 #define FIL_WCK 30
2350
2351
2352 static const struct dvi_items_type file_attribs[] = {
2353 { TYP_INT, "ALQ", FIL_ALQ },
2354 { TYP_INT, "BDT", FIL_BDT },
2355 { TYP_INT, "BKS", FIL_BKS },
2356 { TYP_INT, "BLS", FIL_BLS },
2357 { TYP_INT, "CBT", FIL_CBT },
2358 { TYP_INT, "CDT", FIL_CDT },
2359 { TYP_INT, "CTG", FIL_CTG },
2360 { TYP_INT, "DEQ", FIL_DEQ },
2361 { TYP_INT, "DID", FIL_DID },
2362 { TYP_INT, "DVI", FIL_DVI },
2363 { TYP_INT, "EDT", FIL_EDT },
2364 { TYP_INT, "EOF", FIL_EOF },
2365 { TYP_INT, "FID", FIL_FID },
2366 { TYP_INT, "FSZ", FIL_FSZ },
2367 { TYP_INT, "GRP", FIL_GRP },
2368 { TYP_INT, "KNOWN", FIL_KNOWN },
2369 { TYP_INT, "MBM", FIL_MBM },
2370 { TYP_INT, "MRN", FIL_MRN },
2371 { TYP_INT, "MRS", FIL_MRS },
2372 { TYP_INT, "NOA", FIL_NOA },
2373 { TYP_INT, "NOK", FIL_NOK },
2374 { TYP_INT, "ORG", FIL_ORG },
2375 { TYP_INT, "PRO", FIL_PRO },
2376 { TYP_INT, "PVN", FIL_PVN },
2377 { TYP_INT, "RAT", FIL_RAT },
2378 { TYP_INT, "RCK", FIL_RCK },
2379 { TYP_INT, "RDT", FIL_RDT },
2380 { TYP_INT, "RFM", FIL_RFM },
2381 { TYP_INT, "RVN", FIL_RVN },
2382 { TYP_INT, "UIC", FIL_UIC },
2383 { TYP_INT, "WCK", FIL_WCK },
2384 } ;
2385
2386 streng *vms_f_file_attributes( tsd_t *TSD, cparamboxptr parms )
2387 {
2388 struct dvi_items_type *item ;
2389 int rc, rc2, tmp ;
2390 char temp_space[256] ;
2391 streng *res ;
2392 struct FAB fab ;
2393 struct NAM nam ;
2394 struct XABALL xaball ;
2395 struct XABDAT xabdat ;
2396 struct XABPRO xabpro ;
2397 struct XABSUM xabsum ;
2398 struct XABFHC xabfhc ;
2399
2400 checkparam( parms, 2, 2, "VMS_F_FILE_ATTRIBUTES" ) ;
2401 item = item_info( parms->next->value, file_attribs, sizeof(file_attribs)) ;
2402
2403 memcpy( &fab, &cc$rms_fab, sizeof( struct FAB )) ;
2404 memcpy( &nam, &cc$rms_nam, sizeof( struct NAM )) ;
2405 memcpy( &xaball, &cc$rms_xaball, sizeof( struct XABALL )) ;
2406 memcpy( &xabdat, &cc$rms_xabdat, sizeof( struct XABDAT )) ;
2407 memcpy( &xabpro, &cc$rms_xabpro, sizeof( struct XABPRO )) ;
2408 memcpy( &xabsum, &cc$rms_xabsum, sizeof( struct XABSUM )) ;
2409 memcpy( &xabfhc, &cc$rms_xabfhc ,sizeof( struct XABFHC )) ;
2410
2411 fab.fab$l_fna = parms->value->value ;
2412 fab.fab$b_fns = parms->value->len ;
2413 fab.fab$l_nam = &nam ;
2414
2415 fab.fab$l_xab = &xabdat ;
2416 xabdat.xab$l_nxt = &xabpro ;
2417 xabpro.xab$l_nxt = &xabsum ;
2418 xabsum.xab$l_nxt = &xabfhc ;
2419 /* xaball.xab$l_next = &xabdat ; */
2420
2421 if (item->addr==FIL_KNOWN)
2422 {
2423 /* This field is undocumented in 'The Grey Wall', I spent quite
2424 * some time trying to find this ... sigh. Also note that the
2425 * return code RMS$_KFF is an Digital internal code.
2426 */
2427 fab.fab$l_fop |= FAB$M_KFO ;
2428 fab.fab$l_ctx = 0 ;
2429
2430 nam.nam$b_nop |= NAM$M_NOCONCEAL ;
2431 nam.nam$l_esa = temp_space ;
2432 nam.nam$b_ess = 255 ;
2433 }
2434
2435 rc = sys$open( &fab, NULL, NULL ) ;
2436
2437 if (item->addr==FIL_KNOWN)
2438 {
2439 if (rc==RMS$_NORMAL || rc==RMS$_KFF)
2440 {
2441 /* OK, we ought to check the rc from sys$close() ... */
2442 sys$close( &fab, NULL, NULL ) ;
2443 return Str_creTSD( (fab.fab$l_ctx) ? "TRUE" : "FALSE" ) ;
2444 }
2445 }
2446 if (rc != RMS$_FNF)
2447 {
2448 if (rc != RMS$_NORMAL)
2449 {
2450 vms_error( TSD, rc ) ;
2451 return nullstringptr() ;
2452 }
2453 }
2454 else
2455 return nullstringptr() ;
2456
2457 #define fr(a,b,c) format_result(TSD,a,b,c)
2458 switch (item->addr)
2459 {
2460 case FIL_ALQ: res = int_to_streng( TSD, fab.fab$l_alq ); break ;
2461 case FIL_BDT: res = fr( TYP_TIME, (const char *)xabdat.xab$q_bdt, 8 ); break ;
2462 case FIL_BKS: res = int_to_streng( TSD, fab.fab$b_bks ); break ;
2463 case FIL_BLS: res = int_to_streng( TSD, fab.fab$w_bls ); break ;
2464 case FIL_CBT: res = boolean( TSD, fab.fab$l_fop & FAB$M_CBT ); break ;
2465 case FIL_CDT: res = fr( TYP_TIME, (const char *)xabdat.xab$q_cdt, 8 ); break ;
2466 case FIL_CTG: res = boolean( TSD, fab.fab$l_fop & FAB$M_CTG ); break ;
2467 case FIL_DEQ: res = int_to_streng( TSD, fab.fab$w_deq ); break ;
2468 case FIL_DID: res = internal_id( TSD, (const short *)nam.nam$w_did ); break ;
2469 case FIL_DVI:
2470 res = Str_makeTSD( nam.nam$t_dvi[0] ) ;
2471 memcpy( res->value, &(nam.nam$t_dvi[1]), res->len=nam.nam$t_dvi[0] ) ;
2472 break ;
2473 case FIL_EDT: res = fr( TYP_TIME, (const char *)xabdat.xab$q_edt, 8 ); break ;
2474 case FIL_EOF:
2475 res = int_to_streng( TSD, xabfhc.xab$l_ebk - (xabfhc.xab$w_ffb==0));
2476 break ;
2477 case FIL_FID: res = internal_id( TSD, (const short *)nam.nam$w_fid ); break ;
2478 case FIL_FSZ: res = int_to_streng( TSD, fab.fab$b_fsz ); break ;
2479 case FIL_KNOWN: res = nullstringptr() ; /* must be nonexistent */
2480 break ;
2481 case FIL_GRP: res = int_to_streng( TSD, xabpro.xab$w_grp ); break ;
2482 case FIL_MBM: res = int_to_streng( TSD, xabpro.xab$w_mbm ); break ;
2483 case FIL_MRN: res = int_to_streng( TSD, fab.fab$l_mrn ); break ;
2484 case FIL_MRS: res = int_to_streng( TSD, fab.fab$w_mrs ); break ;
2485 case FIL_NOA: res = int_to_streng( TSD, xabsum.xab$b_noa ); break ;
2486 case FIL_NOK: res = int_to_streng( TSD, xabsum.xab$b_nok ); break ;
2487 case FIL_ORG:
2488 switch (xabfhc.xab$b_rfo & 48 ) /* magic number! */
2489 {
2490 case FAB$C_IDX: res = Str_creTSD( "IDX" ) ; break ;
2491 case FAB$C_REL: res = Str_creTSD( "REL" ) ; break ;
2492 case FAB$C_SEQ: res = Str_creTSD( "SEQ" ) ; break ;
2493 default: exiterror( ERR_INTERPRETER_FAILURE, 1, __FILE__, __LINE__, "" ) ;
2494 }
2495 break ;
2496 case FIL_PRO: res = get_prot( TSD, tmp=xabpro.xab$w_pro ); break ;
2497 case FIL_PVN: res = int_to_streng( TSD, xabsum.xab$w_pvn ); break ;
2498 case FIL_RAT:
2499 if (fab.fab$b_rat & FAB$M_BLK)
2500 res = Str_creTSD( "" ) ;
2501 else if (fab.fab$b_rat & FAB$M_CR)
2502 res = Str_creTSD( "CR" ) ;
2503 else if (fab.fab$b_rat & FAB$M_FTN)
2504 res = Str_creTSD( "FTN" ) ;
2505 else if (fab.fab$b_rat & FAB$M_PRN)
2506 res = Str_creTSD( "PRN" ) ;
2507 else
2508 res = nullstringptr() ;
2509 break ;
2510 case FIL_RCK: res = boolean( TSD, fab.fab$l_fop & FAB$M_RCK ); break ;
2511 case FIL_RDT: res = fr( TYP_TIME, (const char *)xabdat.xab$q_rdt, 8 ); break ;
2512 /* case FIL_RDT: res = fr( TYP_TIME, &(xabdat.xab$q_rdt), 8 ); break ; */
2513 case FIL_RFM:
2514 switch (xabfhc.xab$b_rfo & 15 ) /* magic number! */
2515 {
2516 case FAB$C_VAR: res = Str_creTSD( "VAR" ) ; break ;
2517 case FAB$C_FIX: res = Str_creTSD( "FIX" ) ; break ;
2518 case FAB$C_VFC: res = Str_creTSD( "VFC" ) ; break ;
2519 case FAB$C_UDF: res = Str_creTSD( "UDF" ) ; break ;
2520 case FAB$C_STM: res = Str_creTSD( "STM" ) ; break ;
2521 case FAB$C_STMLF: res = Str_creTSD( "STMLF" ) ; break ;
2522 case FAB$C_STMCR: res = Str_creTSD( "STMCR" ) ; break ;
2523 default: exiterror( ERR_INTERPRETER_FAILURE, 1, __FILE__, __LINE__, "" ) ;
2524 }
2525 break ;
2526 case FIL_RVN: res = int_to_streng( TSD, xabdat.xab$w_rvn ); break ;
2527 case FIL_UIC: res = get_uic( TSD, ( union uicdef *)&(xabpro.xab$l_uic) ); break ;
2528 case FIL_WCK: res = boolean( TSD, fab.fab$l_fop & FAB$M_WCK ); break ;
2529 default:
2530 exiterror( ERR_INTERPRETER_FAILURE, 1, __FILE__, __LINE__, "" ) ;
2531 }
2532
2533 if (rc == RMS$_NORMAL)
2534 {
2535 rc = sys$close( &fab, NULL, NULL ) ;
2536 if (rc != RMS$_NORMAL )
2537 {
2538 vms_error( TSD, rc ) ;
2539 return nullstringptr() ;
2540 }
2541 }
2542 return res ;
2543 }
2544
2545
2546 streng *vms_f_extract( tsd_t *TSD, cparamboxptr parms )
2547 {
2548 int start, length ;
2549 streng *result, *string ;
2550
2551 checkparam( parms, 3, 3, "VMS_F_EXTRACT" ) ;
2552 start = atozpos( TSD, parms->value, "VMS_F_EXTRACT", 1 ) ;
2553 length = atozpos( TSD, (parms=parms->next)->value, "VMS_F_EXTRACT", 2 ) ;
2554 string = parms->next->value ;
2555
2556 if (start>string->len)
2557 start = string->len ;
2558
2559 if (length > string->len - start)
2560 length = (string->len - start) ;
2561
2562 result = Str_makeTSD( length ) ;
2563 memcpy( result->value, string->value+start, length ) ;
2564 result->len = length ;
2565
2566 return result ;
2567 }
2568
2569 streng *vms_f_element( tsd_t *TSD, cparamboxptr parms )
2570 {
2571 int number, count ;
2572 streng *string, *result ;
2573 char delim, *cptr, *cend, *cmax ;
2574
2575 checkparam( parms, 3, 3, "VMS_F_ELEMENT" ) ;
2576
2577 number = atozpos( TSD, parms->value, "VMS_F_ELEMENT", 1 ) ;
2578 delim = getonechar( TSD, (parms=parms->next)->value, "VMS_F_ELEMENT", 2) ;
2579 string = parms->next->value ;
2580
2581 cptr = string->value ;
2582 cend = cptr + string->len ;
2583 for (count=0;count<number && cptr<cend;)
2584 if (*(cptr++)==delim) count++ ;
2585
2586 if (count<number)
2587 {
2588 result = Str_makeTSD( 1 ) ;
2589 result->len = 1 ;
2590 result->value[0] = delim ;
2591 }
2592 else
2593 {
2594 for (cmax=cptr; *cmax!=delim && cmax<cend; cmax++) ;
2595 result = Str_makeTSD( cmax - cptr ) ;
2596 result->len = cmax - cptr ;
2597 memcpy( result->value, cptr, cmax-cptr ) ;
2598 }
2599
2600 return result ;
2601 }
2602
2603
2604 static streng *convert_bin( tsd_t *TSD, cparamboxptr parms, const int issigned, const char *bif )
2605 {
2606 int start, length, obyte, obit, count, bit=0 ;
2607 streng *string, *result, *temp ;
2608
2609 checkparam( parms, 3, 3, bif ) ;
2610
2611 start = atozpos( TSD, parms->value, bif, 1 ) ;
2612 length = atozpos( TSD, parms->next->value, bif, 2 ) ;
2613 string = parms->next->next->value ;
2614
2615 if (issigned)
2616 {
2617 start++ ;
2618 length-- ;
2619 }
2620
2621 if ((start+length > string->len*8) || length<0)
2622 exiterror( ERR_INCORRECT_CALL , 0 ) ;
2623
2624 temp = Str_makeTSD((start+length)/8 + 2) ;
2625 obyte = (start+length)/8 + 1 ;
2626 temp->len = obyte + 1 ;
2627 obit = 7 ;
2628 for (count=0; count<=obyte; temp->value[count++] = 0x00) ;
2629
2630 for (count=start+length-1; count>=start; count--)
2631 {
2632 bit = (string->value[count/8] >> (7-(count%8))) & 1 ;
2633 temp->value[obyte] |= bit << (7-obit--) ;
2634 if (obit<0)
2635 {
2636 obit = 7 ;
2637 obyte-- ;
2638 }
2639 }
2640
2641 if (issigned)
2642 bit = (string->value[count/8] >> (7-(count%8))) & 1 ;
2643
2644 if (issigned && bit)
2645 for (;obyte>=0;)
2646 {
2647 temp->value[obyte] |= 1 << (7-obit--) ;
2648 if (obit<0)
2649 {
2650 obit = 7 ;
2651 obyte-- ;
2652 }
2653 }
2654
2655 result = str_digitize( TSD, temp, 0, 1 ) ;
2656 FreeTSD( temp ) ;
2657 return result ;
2658 }
2659
2660
2661
2662 streng *vms_f_cvui( tsd_t *TSD, cparamboxptr parms )
2663 {
2664 return convert_bin( TSD, parms, 0, "VMS_F_CVUI" ) ;
2665 }
2666
2667 streng *vms_f_cvsi( tsd_t *TSD, cparamboxptr parms )
2668 {
2669 return convert_bin( TSD, parms, 1, "VMS_F_CVSI" ) ;
2670 }
2671
2672
2673 static const char *vms_weekdays[] = { "Monday", "Tuesday", "Wednesday",
2674 "Thursday", "Friday", "Saturday",
2675 "Sunday" } ;
2676 static const char *vms_months[] = { "", "JAN", "FEB", "MAR", "APR", "MAY",
2677 "JUN", "JUL", "AUG", "SEP", "OCT",
2678 "NOV", "DEC" } ;
2679
2680 enum outs { absolute, comparison, delta } ;
2681 enum funcs { year, month, day, hour, minute, second, hundredth,
2682 weekday, time_part, date_part, datetime } ;
2683
2684
2685 static char *read_abs_time( char *ptr, char *end, short *times )
2686 {
2687 int cnt, increment, rc ;
2688 char *tmp ;
2689
2690 rc = sys$numtim( times, NULL ) ;
2691
2692 if (ptr>=end) exiterror( ERR_INCORRECT_CALL, 0 ) ;
2693 if (*ptr=='-')
2694 {
2695 ptr++ ;
2696 goto abs_hours ;
2697 }
2698
2699 if (*ptr=='+')
2700 return ptr ;
2701
2702 if (isspace(*ptr))
2703 return ptr ;
2704
2705 if (*ptr==':')
2706 {
2707 ptr++ ;
2708 goto abs_minutes ;
2709 }
2710
2711 if (!isdigit(*ptr))
2712 {
2713 if (ptr+3>=end ) exiterror( ERR_INCORRECT_CALL, 0 ) ;
2714 for (cnt=1; cnt<=12; cnt++)
2715 if (!memcmp(ptr,vms_months[cnt],3))
2716 {
2717 ptr += 3 ;
2718 times[month] = cnt ;
2719 if (ptr>=end)
2720 return ptr ;
2721 else if (*ptr==':')
2722 {
2723 ptr++ ;
2724 goto abs_hours ;
2725 }
2726 else if (*ptr=='-')
2727 {
2728 ptr++ ;
2729 goto abs_years ;
2730 }
2731 else
2732 return ptr ;
2733 }
2734 exiterror( ERR_INCORRECT_CALL , 0 ) ;
2735 }
2736 else
2737 {
2738 for (cnt=0; ptr<end && isdigit(*ptr); ptr++)
2739 cnt = cnt*10 + *ptr-'0' ;
2740
2741 if (ptr>=end || isspace(*ptr) || *ptr==':')
2742 {
2743 if (ptr<end && *ptr==':') ptr++ ;
2744 if (cnt>23) exiterror( ERR_INCORRECT_CALL, 0 ) ;
2745 times[hour] = cnt ;
2746 goto abs_minutes ;
2747 }
2748 else if (*ptr=='-')
2749 {
2750 ptr++ ;
2751 times[day] = cnt ;
2752 goto abs_months ;
2753 }
2754 else
2755 return ptr ;
2756 }
2757
2758
2759 abs_months:
2760 if (ptr<end && isalpha(*ptr))
2761 {
2762 if (ptr+3>=end) exiterror( ERR_INCORRECT_CALL, 0 ) ;
2763 for (cnt=1; cnt<=12; cnt++)
2764 if (!memcmp(ptr,vms_months[cnt],3))
2765 {
2766 ptr += 3 ;
2767 times[month] = cnt ;
2768
2769 if (ptr>=end)
2770 return ptr ;
2771 else if (*ptr==':')
2772 {
2773 ptr++ ;
2774 goto abs_hours ;
2775 }
2776 else if (*ptr=='-')
2777 {
2778 ptr++ ;
2779 goto abs_years ;
2780 }
2781 else
2782 return ptr ;
2783 }
2784 exiterror( ERR_INCORRECT_CALL , 0 ) ;
2785 }
2786 else if (ptr>=end || isspace(*ptr))
2787 return ptr ;
2788 else if (*ptr=='-')
2789 {
2790 ptr++ ;
2791 goto abs_years ;
2792 }
2793 else if (*ptr==':')
2794 {
2795 ptr++ ;
2796 goto abs_hours ;
2797 }
2798 else
2799 exiterror( ERR_INCORRECT_CALL , 0 ) ;
2800
2801
2802 abs_years:
2803 if (ptr<end && isdigit(*ptr))
2804 {
2805 for (cnt=0; ptr<end && isdigit(*ptr); ptr++)
2806 cnt = cnt*10 + *ptr-'0' ;
2807
2808 if (cnt>9999) exiterror( ERR_INCORRECT_CALL, 0 ) ;
2809 times[year] = cnt ;
2810 if (ptr<end && *ptr==':')
2811 {
2812 ptr++ ;
2813 goto abs_hours ;
2814 }
2815 else
2816 return ptr ;
2817 }
2818 else if (ptr<end && *ptr==':')
2819 {
2820 ptr++ ;
2821 goto abs_hours ;
2822 }
2823 else
2824 return ptr ;
2825
2826
2827 abs_hours:
2828 if (ptr<end && isdigit(*ptr))
2829 {
2830 for (cnt=0; ptr<end && isdigit(*ptr); ptr++)
2831 cnt = cnt*10 + *ptr-'0' ;
2832
2833 if (cnt>23) exiterror( ERR_INCORRECT_CALL, 0 ) ;
2834 times[hour] = cnt ;
2835 if (ptr<end && *ptr==':')
2836 {
2837 ptr++ ;
2838 goto abs_minutes ;
2839 }
2840 else
2841 return ptr ;
2842 }
2843 else if (ptr<end && *ptr==':')
2844 {
2845 ptr++ ;
2846 goto abs_minutes ;
2847 }
2848 else
2849 return ptr ;
2850
2851
2852 abs_minutes:
2853 if (ptr<end && isdigit(*ptr))
2854 {
2855 for (cnt=0; ptr<end && isdigit(*ptr); ptr++)
2856 cnt = cnt*10 + *ptr-'0' ;
2857
2858 if (cnt>59) exiterror( ERR_INCORRECT_CALL, 0 ) ;
2859 times[minute] = cnt ;
2860 if (ptr<end && *ptr==':')
2861 {
2862 ptr++ ;
2863 goto abs_seconds ;
2864 }
2865 else
2866 return ptr ;
2867 }
2868 else if (ptr<end && *ptr==':')
2869 {
2870 ptr++ ;
2871 goto abs_seconds ;
2872 }
2873 else
2874 return ptr ;
2875
2876
2877 abs_seconds:
2878 if (ptr<end && isdigit(*ptr))
2879 {
2880 for (cnt=0; ptr<end && isdigit(*ptr); ptr++)
2881 cnt = cnt*10 + *ptr-'0' ;
2882
2883 if (cnt>59) exiterror( ERR_INCORRECT_CALL, 0 ) ;
2884 times[second] = cnt ;
2885 if (ptr<end && *ptr=='.')
2886 {
2887 ptr++ ;
2888 goto abs_hundredths ;
2889 }
2890 else
2891 return ptr ;
2892 }
2893 else if (ptr<end && *ptr=='.')
2894 {
2895 ptr++ ;
2896 goto abs_hundredths ;
2897 }
2898 else
2899 return ptr ;
2900
2901
2902 abs_hundredths:
2903 if (ptr<end && isdigit(*ptr))
2904 {
2905 tmp = ptr ;
2906 for (cnt=0; ptr<end && ptr<tmp+2 && isdigit(*ptr); ptr++)
2907 cnt = cnt*10 + *ptr-'0' ;
2908
2909 increment = (ptr<end && isdigit(*ptr) && (*ptr-'0'>=5)) ;
2910 for (;ptr<end && isdigit(*ptr); ptr++) ;
2911 times[hundredth] = cnt + increment ;
2912 return ptr ;
2913 }
2914 else
2915 return ptr ;
2916 }
2917
2918
2919 static char *read_delta_time( char *ptr, char *end, short *times )
2920 {
2921 int cnt, increment ;
2922 char *tmp ;
2923
2924 for (cnt=0; cnt<7; times[cnt++]=0) ;
2925
2926 if (ptr>=end) exiterror( ERR_INCORRECT_CALL, 0 ) ;
2927 if (*ptr=='-')
2928 {
2929 ptr++ ;
2930 goto delta_hours ;
2931 }
2932
2933 if (*ptr==':')
2934 {
2935 ptr++ ;
2936 goto delta_minutes ;
2937 }
2938
2939 if (!isdigit( *ptr )) exiterror( ERR_INCORRECT_CALL, 0 ) ;
2940 for (cnt=0; ptr<end && isdigit(*ptr); ptr++)
2941 cnt = cnt*10 + *ptr-'0' ;
2942
2943 if (ptr>=end || isspace(*ptr) || *ptr==':')
2944 {
2945 if (ptr<end && *ptr==':') ptr++ ;
2946 if (cnt>23) exiterror( ERR_INCORRECT_CALL, 0 ) ;
2947 times[hour] = cnt ;
2948 goto delta_minutes ;
2949 }
2950 else
2951 {
2952 if (*ptr!='-') exiterror( ERR_INCORRECT_CALL, 0 ) ;
2953 ptr++ ;
2954 if (cnt>9999) exiterror( ERR_INCORRECT_CALL, 0 ) ;
2955 times[day] = cnt ;
2956 goto delta_hours ;
2957 }
2958
2959 delta_hours:
2960 if (ptr<end && isdigit(*ptr))
2961 {
2962 for (cnt=0; ptr<end && isdigit(*ptr); ptr++)
2963 cnt = cnt*10 + *ptr-'0' ;
2964
2965 if (cnt>23) exiterror( ERR_INCORRECT_CALL, 0 ) ;
2966 times[hour] = cnt ;
2967 if (ptr<end && *ptr==':')
2968 {
2969 ptr++ ;
2970 goto delta_minutes ;
2971 }
2972 else
2973 return ptr ;
2974 }
2975 else if (ptr<end && *ptr==':')
2976 {
2977 ptr++ ;
2978 goto delta_minutes ;
2979 }
2980 else
2981 return ptr ;
2982
2983
2984 delta_minutes:
2985 if (ptr<end && isdigit(*ptr))
2986 {
2987 for (cnt=0; ptr<end && isdigit(*ptr); ptr++)
2988 cnt = cnt*10 + *ptr-'0' ;
2989
2990 if (cnt>59) exiterror( ERR_INCORRECT_CALL, 0 ) ;
2991 times[minute] = cnt ;
2992 if (ptr<end && *ptr==':')
2993 {
2994 ptr++ ;
2995 goto delta_seconds ;
2996 }
2997 else
2998 return ptr ;
2999 }
3000 else if (ptr<end && *ptr==':')
3001 {
3002 ptr++ ;
3003 goto delta_seconds ;
3004 }
3005 else
3006 return ptr ;
3007
3008
3009 delta_seconds:
3010 if (ptr<end && isdigit(*ptr))
3011 {
3012 for (cnt=0; ptr<end && isdigit(*ptr); ptr++)
3013 cnt = cnt*10 + *ptr-'0' ;
3014
3015 if (cnt>59) exiterror( ERR_INCORRECT_CALL, 0 ) ;
3016 times[second] = cnt ;
3017 if (ptr<end && *ptr=='.')
3018 {
3019 ptr++ ;
3020 goto delta_hundredths ;
3021 }
3022 else
3023 return ptr ;
3024 }
3025 else if (ptr<end && *ptr=='.')
3026 {
3027 ptr++ ;
3028 goto delta_hundredths ;
3029 }
3030 else
3031 return ptr ;
3032
3033
3034 delta_hundredths:
3035 if (ptr<end && isdigit(*ptr))
3036 {
3037 tmp = ptr ;
3038 for (cnt=0; ptr<end && ptr<tmp+2 && isdigit(*ptr); ptr++)
3039 cnt = cnt*10 + *ptr-'0' ;
3040
3041 increment = (ptr<end && isdigit(*ptr) && (*ptr-'0'>=5)) ;
3042 for (;ptr<end && isdigit(*ptr); ptr++) ;
3043 times[hundredth] = cnt + increment ;
3044 return ptr ;
3045 }
3046 else
3047 return ptr ;
3048 }
3049
3050
3051 streng *vms_f_cvtime( tsd_t *TSD, cparamboxptr parms )
3052 {
3053 streng *item=NULL, *input=NULL, *output=NULL, *result ;
3054 int rc, res, cnt, abs=0 ;
3055 short times[7], timearray[7], btime[4] ;
3056 char *cptr, *cend, *ctmp, *cptr2 ;
3057 $DESCRIPTOR( timbuf, "" ) ;
3058 enum funcs func ;
3059 enum outs out ;
3060
3061 checkparam( parms, 0, 3, "VMS_F_CVTIME" ) ;
3062 func = datetime ;
3063 out = comparison ;
3064
3065 input = parms->value ;
3066 if (parms->next)
3067 {
3068 output = parms->next->value ;
3069 if (parms->next->next)
3070 item = parms->next->next->value ;
3071 }
3072
3073 if (item)
3074 {
3075 for (cnt=0; cnt<item->len; cnt++)
3076 item->value[cnt] = toupper(item->value[cnt]) ;
3077
3078 if (item->len==4 && !memcmp(item->value, "YEAR", 4))
3079 func = year ;
3080 else if (item->len==5 && !memcmp(item->value, "MONTH", 5))
3081 func = month ;
3082 else if (item->len==8 && !memcmp(item->value, "DATETIME", 8))
3083 func = datetime ;
3084 else if (item->len==3 && !memcmp(item->value, "DAY", 3))
3085 func = day ;
3086 else if (item->len==4 && !memcmp(item->value, "DATE", 4))
3087 func = date_part ;
3088 else if (item->len==4 && !memcmp(item->value, "TIME", 4))
3089 func = time_part ;
3090 else if (item->len==4 && !memcmp(item->value, "HOUR", 4))
3091 func = hour ;
3092 else if (item->len==6 && !memcmp(item->value, "SECOND", 6))
3093 func = second ;
3094 else if (item->len==6 && !memcmp(item->value, "MINUTE", 6))
3095 func = minute ;
3096 else if (item->len==9 && !memcmp(item->value, "HUNDREDTH", 9))
3097 func = hundredth ;
3098 else if (item->len==7 && !memcmp(item->value, "WEEKDAY", 7))
3099 func = weekday ;
3100 else
3101 exiterror( ERR_INCORRECT_CALL , 0 ) ;
3102 }
3103
3104 if (output)
3105 {
3106 for (cnt=0; cnt<output->len; cnt++)
3107 output->value[cnt] = toupper(output->value[cnt]) ;
3108
3109 if (output->len==5 && !memcmp(output->value, "DELTA", 5))
3110 out = delta ;
3111 else if (output->len==10 && !memcmp(output->value, "COMPARISON", 10))
3112 abs = 0 ;
3113 else if (output->len==8 && !memcmp(output->value, "ABSOLUTE", 8))
3114 abs = 1 ;
3115 else
3116 exiterror( ERR_INCORRECT_CALL , 0 ) ;
3117 }
3118
3119 if (out==delta)
3120 if (func==year || func==month || func==weekday)
3121 exiterror( ERR_INCORRECT_CALL , 0 ) ;
3122
3123 if (input)
3124 {
3125 short atime[4], dtime[4], xtime[4], ttimes[7] = {0,0,0,0,0,0,1} ;
3126 int rc2, increment ;
3127
3128 lib$cvt_vectim( ttimes, xtime ) ;
3129 cptr = input->value ;
3130 cend = cptr + input->len ;
3131
3132 for (ctmp=cptr;ctmp<cend;ctmp++)
3133 *ctmp = toupper(*ctmp) ;
3134
3135 for (;isspace(*cptr);cptr++) ; /* strip leading spaces */
3136 if (out!=delta)
3137 {
3138 if (cptr<cend && *cptr!='-')
3139 {
3140 cptr = read_abs_time( cptr, cend, times ) ;
3141 if ((increment=(times[hundredth]==100)))
3142 times[hundredth] -= 1 ; ;
3143
3144 rc = lib$cvt_vectim( times, btime ) ;
3145 if (increment)
3146 {
3147 lib$add_times( xtime, btime, dtime ) ;
3148 btime[0] = dtime[0] ;
3149 btime[1] = dtime[1] ;
3150 btime[2] = dtime[2] ;
3151 btime[3] = dtime[3] ;
3152 }
3153 }
3154 else
3155 {
3156 rc = sys$gettim( btime ) ;
3157 }
3158
3159 if (cptr<cend && (*cptr=='-' || *cptr=='+'))
3160 {
3161 char oper = *cptr ;
3162 cptr2 = read_delta_time( ++cptr, cend, times ) ;
3163 if ((increment=(times[6]==100)))
3164 times[6] -= 1 ;
3165
3166 rc2 = lib$cvt_vectim( times, dtime ) ;
3167 if (increment)
3168 {
3169 lib$add_times( dtime, xtime, atime ) ;
3170 dtime[0] = atime[0] ;
3171 dtime[1] = atime[1] ;
3172 dtime[2] = atime[2] ;
3173 dtime[3] = atime[3] ;
3174 }
3175
3176 if (oper=='+')
3177 rc = lib$add_times( btime, dtime, atime ) ;
3178 else
3179 rc = lib$sub_times( btime, dtime, atime ) ;
3180
3181 btime[0] = atime[0] ;
3182 btime[1] = atime[1] ;
3183 btime[2] = atime[2] ;
3184 btime[3] = atime[3] ;
3185 }
3186 }
3187 else
3188 {
3189 cptr = read_delta_time( cptr, cend, times ) ;
3190 if ((increment=(times[6]==100)))
3191 times[6] -= 1 ;
3192
3193 rc = lib$cvt_vectim( times, &btime ) ;
3194 if (increment)
3195 {
3196 lib$add_times( xtime, btime, atime ) ;
3197 btime[0] = atime[0] ;
3198 btime[1] = atime[1] ;
3199 btime[2] = atime[2] ;
3200 btime[3] = atime[3] ;
3201 }
3202 }
3203 }
3204 else
3205 rc = sys$gettim( &btime ) ;
3206
3207 if (rc!=SS$_NORMAL && rc!=LIB$_NORMAL)
3208 {
3209 vms_error( TSD, rc ) ;
3210 return nullstringptr() ;
3211 }
3212
3213 rc = sys$numtim( timearray, &btime ) ;
3214 if (rc!=SS$_NORMAL)
3215 {
3216 vms_error( TSD, rc ) ;
3217 return nullstringptr() ;
3218 }
3219
3220 switch (func)
3221 {
3222 case year:
3223 result = Str_makeTSD( 5 ) ;
3224 sprintf( result->value, ((abs) ? "%04d" : "%d"), timearray[func]);
3225 result->len = strlen( result->value ) ;
3226 break ;
3227
3228 case hour:
3229 case minute:
3230 case second:
3231 case hundredth:
3232 abs = 0 ;
3233 case day:
3234 result = Str_makeTSD( 3 ) ;
3235 sprintf( result->value, ((abs) ? "%d" : "%02d"), timearray[func]);
3236 result->len = strlen( result->value ) ;
3237 break ;
3238
3239 case month:
3240 if (abs)
3241 result = Str_creTSD( vms_months[ func ]) ;
3242 else
3243 {
3244 result = Str_makeTSD( 3 ) ;
3245 sprintf( result->value, "%02d", timearray[month]) ;
3246 result->len = 2 ;
3247 }
3248 break ;
3249
3250 case time_part:
3251 result = Str_makeTSD( 12 ) ;
3252 sprintf(result->value, "%02d:%02d:%02d.%02d", timearray[hour],
3253 timearray[minute], timearray[second], timearray[hundredth]) ;
3254 result->len = 11 ;
3255 break ;
3256
3257 case date_part:
3258 result = Str_makeTSD( 12 ) ;
3259 if (out==delta)
3260 sprintf( result->value, "%d", timearray[day] ) ;
3261 else if (abs)
3262 sprintf( result->value, "%d-%s-%d", timearray[day],
3263 vms_months[timearray[month]], timearray[year] ) ;
3264 else
3265 sprintf( result->value, "%04d-%02d-%02d", timearray[year],
3266 timearray[month], timearray[day] ) ;
3267
3268 result->len = strlen( result->value ) ;
3269 break ;
3270
3271 case datetime:
3272 result = Str_makeTSD( 24 ) ;
3273 if (out==delta)
3274 sprintf( result->value, "%d %02d:%02d:%02d.%02d",
3275 timearray[day], timearray[hour], timearray[minute],
3276 timearray[second], timearray[hundredth] ) ;
3277 else if (abs)
3278 sprintf( result->value, "%d-%s-%d %02d:%02d:%02d.%02d",
3279 timearray[day], vms_months[timearray[month]],
3280 timearray[year], timearray[hour], timearray[minute],
3281 timearray[second], timearray[hundredth] ) ;
3282 else
3283 sprintf( result->value, "%04d-%02d-%02d %02d:%02d:%02d.%02d",
3284 timearray[year], timearray[month], timearray[day],
3285 timearray[hour], timearray[minute], timearray[second],
3286 timearray[hundredth] ) ;
3287 result->len = strlen( result->value ) ;
3288 break ;
3289
3290 case weekday:
3291 {
3292 int op=LIB$K_DAY_OF_WEEK, res ;
3293 rc = lib$cvt_from_internal_time( &op, &res, &btime ) ;
3294 if (rc!=LIB$_NORMAL)
3295 {
3296 vms_error( TSD, rc ) ;
3297 return nullstringptr() ;
3298 }
3299 result = Str_creTSD( vms_weekdays[res-1] ) ;
3300 break ;
3301 }
3302
3303 default: exiterror( ERR_INTERPRETER_FAILURE, 1, __FILE__, __LINE__, "" ) ;
3304 }
3305
3306 return result ;
3307 }
3308
3309
3310 streng *vms_f_fao( tsd_t *TSD, cparamboxptr parms )
3311 {
3312 void *prmlst[30] = {NULL} ;
3313 int i, cnt, paran, rc, pcnt=0, icnt=0 ;
3314 int int_list[30], dcnt=0, xper ;
3315 struct dsc$descriptor_s dscs[15] ;
3316 cparamboxptr p ;
3317 char buffer[512], *cstart, *cptr, *cend ;
3318 streng *result ;
3319 $DESCRIPTOR( ctrl, "" ) ;
3320 $DESCRIPTOR( outbuf, buffer ) ;
3321 short outlen ;
3322
3323 if (parms->value==NULL)
3324 exiterror( ERR_INCORRECT_CALL , 0 ) ;
3325
3326 ctrl.dsc$a_pointer = parms->value->value ;
3327 ctrl.dsc$w_length = parms->value->len ;
3328
3329 cptr = cstart = parms->value->value ;
3330 cend = cptr + parms->value->len ;
3331
3332 p = parms->next ;
3333
3334 for (cptr=cstart; cptr<cend; cptr++)
3335 {
3336 if (*cptr!='!') continue ;
3337
3338 if (*(++cptr)=='#')
3339 {
3340 cptr++ ;
3341 if (!p || !p->value)
3342 exiterror( ERR_INCORRECT_CALL , 0 ) ;
3343
3344 cnt = atopos( TSD, p->value, "VMS_F_FAO", pcnt ) ;
3345 prmlst[pcnt++] = int_list + icnt ;
3346 int_list[icnt++] = cnt ;
3347 p = p->next ;
3348 }
3349 else if (!isdigit(*cptr))
3350 cnt = 1 ;
3351 else
3352 for (cnt=0;cptr<cend && isdigit(*cptr); cptr++)
3353 cnt = cnt*10 + *cptr-'0' ;
3354
3355 paran = 0 ;
3356 if (cptr<cend && *cptr=='(')
3357 {
3358 paran = 1 ;
3359 cptr++ ;
3360 if (*cptr=='#')
3361 {
3362 if (!p || !p->value)
3363 exiterror( ERR_INCORRECT_CALL , 0 ) ;
3364
3365 prmlst[pcnt++] = int_list + icnt ;
3366 int_list[icnt++] = atopos( TSD, p->value, "VMS_F_FAO", 0 ) ;
3367 p = p->next ;
3368 }
3369 else
3370 for (;cptr<cend && isdigit(*cptr); cptr++ ) ;
3371 }
3372
3373 if (cptr<cend)
3374 {
3375 xper = toupper(*cptr) ;
3376 if (xper=='O' || xper=='X' || xper=='Z' || xper=='U' || xper=='S')
3377 {
3378 cptr++ ;
3379 xper = toupper(*cptr) ;
3380 if (xper!='B' && xper!='W' && xper!='L')
3381 exiterror( ERR_INCORRECT_CALL , 0 ) ;
3382
3383 for (i=0; i<cnt; i++)
3384 {
3385 if (!p || !p->value)
3386 exiterror( ERR_INCORRECT_CALL , 0 ) ;
3387
3388 prmlst[pcnt++] = (void *)myatol( TSD, p->value ) ;
3389 p = p->next ;
3390 }
3391 }
3392 else if (toupper(*cptr)=='A')
3393 {
3394 cptr++ ;
3395 if (cptr<cend && toupper(*cptr)!='S')
3396 exiterror( ERR_INCORRECT_CALL , 0 ) ;
3397
3398 for (i=0; i<cnt; i++ )
3399 {
3400 if (!p || !p->value)
3401 exiterror( ERR_INCORRECT_CALL , 0 ) ;
3402
3403 dscs[dcnt].dsc$b_class = DSC$K_CLASS_S ;
3404 dscs[dcnt].dsc$b_dtype = DSC$K_DTYPE_T ;
3405 dscs[dcnt].dsc$a_pointer = p->value->value ;
3406 dscs[dcnt].dsc$w_length = p->value->len ;
3407 prmlst[pcnt++] = &(dscs[dcnt++]) ;
3408 p = p->next ;
3409 }
3410 }
3411 }
3412 else
3413 exiterror( ERR_INCORRECT_CALL , 0 ) ;
3414
3415 if (paran)
3416 if (cptr<cend-1 && *(++cptr)!=')')
3417 exiterror( ERR_INCORRECT_CALL , 0 ) ;
3418 }
3419
3420 rc = sys$faol( &ctrl, &outlen, &outbuf, prmlst ) ;
3421 if (rc!=SS$_NORMAL)
3422 {
3423 vms_error( TSD, rc ) ;
3424 /* return nullstringptr() ; */
3425 }
3426
3427 result = Str_makeTSD( outlen ) ;
3428 result->len = outlen ;
3429 memcpy( result->value, buffer, outlen ) ;
3430
3431 return result ;
3432 }
Mirror of AROS' Contrib svn.