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