comparison src/vmsfns.c @ 82:6a378aca36af r20-0b91

Import from CVS: tag r20-0b91
author cvs
date Mon, 13 Aug 2007 09:07:36 +0200
parents 131b0175ea99
children
comparison
equal deleted inserted replaced
81:ebca3d831cea 82:6a378aca36af
366 CHECK_INT (name); 366 CHECK_INT (name);
367 CHECK_STRING (command); 367 CHECK_STRING (command);
368 for (ptr = process_list; ptr; ptr = ptr->next) 368 for (ptr = process_list; ptr; ptr = ptr->next)
369 if (XINT (name) == ptr->name) 369 if (XINT (name) == ptr->name)
370 { 370 {
371 write_to_mbx (ptr, string_data (XSTRING (command)), 371 write_to_mbx (ptr, XSTRING_DATA (command), XSTRING_LENGTH (command));
372 string_length (XSTRING (command)));
373 return Qt; 372 return Qt;
374 } 373 }
375 return Qnil; 374 return Qnil;
376 } 375 }
377 376
581 int found, i; 580 int found, i;
582 struct privilege_list * ptr; 581 struct privilege_list * ptr;
583 582
584 CHECK_STRING (priv); 583 CHECK_STRING (priv);
585 priv = Fupcase (priv, Fcurrent_buffer ()); 584 priv = Fupcase (priv, Fcurrent_buffer ());
586 prvname = string_data (XSTRING (priv)); 585 prvname = XSTRING_DATA (priv);
587 prvlen = string_length (XSTRING (priv)); 586 prvlen = XSTRING_LENGTH (priv);
588 found = 0; 587 found = 0;
589 prvmask[0] = 0; 588 prvmask[0] = 0;
590 prvmask[1] = 0; 589 prvmask[1] = 0;
591 for (i = 0; i < sizeof (priv_list) / sizeof (priv_list[0]); i++) 590 for (i = 0; i < sizeof (priv_list) / sizeof (priv_list[0]); i++)
592 { 591 {
601 found = 1; 600 found = 1;
602 break; 601 break;
603 } 602 }
604 } 603 }
605 if (! found) 604 if (! found)
606 error ("Unknown privilege name %s", string_data (XSTRING (priv))); 605 error ("Unknown privilege name %s", XSTRING_DATA (priv));
607 if (NILP (getprv)) 606 if (NILP (getprv))
608 { 607 {
609 if (sys$setprv (NILP (value) ? 0 : 1, prvmask, 0, 0) == SS$_NORMAL) 608 if (sys$setprv (NILP (value) ? 0 : 1, prvmask, 0, 0) == SS$_NORMAL)
610 return Qt; 609 return Qt;
611 return Qnil; 610 return Qnil;
652 char * typename; 651 char * typename;
653 struct vms_objlist * ptr; 652 struct vms_objlist * ptr;
654 653
655 CHECK_STRING (type); 654 CHECK_STRING (type);
656 type = Fupcase (type, Fcurrent_buffer ()); 655 type = Fupcase (type, Fcurrent_buffer ());
657 typename = string_data (XSTRING (type)); 656 typename = XSTRING_DATA (type);
658 typelen = string_length (XSTRING (type)); 657 typelen = XSTRING_LENGTH (type);
659 for (i = 0; i < sizeof (vms_object) / sizeof (vms_object[0]); i++) 658 for (i = 0; i < sizeof (vms_object) / sizeof (vms_object[0]); i++)
660 { 659 {
661 ptr = &vms_object[i]; 660 ptr = &vms_object[i];
662 if (typelen == strlen (ptr->name) 661 if (typelen == strlen (ptr->name)
663 && memcpy (typename, ptr->name, typelen) == 0) 662 && memcpy (typename, ptr->name, typelen) == 0)
676 int status, code, id, i, numeric, size; 675 int status, code, id, i, numeric, size;
677 Bufbyte *p; 676 Bufbyte *p;
678 int prcnam[2]; 677 int prcnam[2];
679 678
680 if (NILP (pid) 679 if (NILP (pid)
681 || STRINGP (pid) && string_length (XSTRING (pid)) == 0 680 || STRINGP (pid) && XSTRING_LENGTH (pid) == 0
682 || ZEROP (pid)) 681 || ZEROP (pid))
683 { 682 {
684 code = owner ? JPI$_OWNER : JPI$_PID; 683 code = owner ? JPI$_OWNER : JPI$_PID;
685 status = lib$getjpi (&code, 0, 0, &id); 684 status = lib$getjpi (&code, 0, 0, &id);
686 if (! (status & 1)) 685 if (! (status & 1))
691 } 690 }
692 if (INTP (pid)) 691 if (INTP (pid))
693 return (XINT (pid)); 692 return (XINT (pid));
694 CHECK_STRING (pid); 693 CHECK_STRING (pid);
695 pid = Fupcase (pid, Fcurrent_buffer ()); 694 pid = Fupcase (pid, Fcurrent_buffer ());
696 size = string_length (XSTRING (pid)); 695 size = XSTRING_LENGTH (pid);
697 p = string_data (XSTRING (pid)); 696 p = XSTRING_DATA (pid);
698 numeric = 1; 697 numeric = 1;
699 id = 0; 698 id = 0;
700 for (i = 0; i < size; i++, p++) 699 for (i = 0; i < size; i++, p++)
701 if (isxdigit (*p)) 700 if (isxdigit (*p))
702 { 701 {
711 numeric = 0; 710 numeric = 0;
712 break; 711 break;
713 } 712 }
714 if (numeric) 713 if (numeric)
715 return (id); 714 return (id);
716 prcnam[0] = string_length (XSTRING (pid)); 715 prcnam[0] = XSTRING_LENGTH (pid);
717 prcnam[1] = string_data (XSTRING (pid)); 716 prcnam[1] = XSTRING_DATA (pid);
718 status = lib$getjpi (&JPI$_PID, 0, prcnam, &id); 717 status = lib$getjpi (&JPI$_PID, 0, prcnam, &id);
719 if (! (status & 1)) 718 if (! (status & 1))
720 error ("Cannot find process id: %s", 719 error ("Cannot find process id: %s",
721 vmserrstr (status)); 720 vmserrstr (status));
722 return (id); 721 return (id);
852 int status, symdsc[2]; 851 int status, symdsc[2];
853 int strdsc[2] = { sizeof (str), str }; 852 int strdsc[2] = { sizeof (str), str };
854 short length, level; 853 short length, level;
855 854
856 CHECK_STRING (arg1); 855 CHECK_STRING (arg1);
857 symdsc[0] = string_length (XSTRING (arg1)); 856 symdsc[0] = XSTRING_LENGTH (arg1);
858 symdsc[1] = string_data (XSTRING (arg1)); 857 symdsc[1] = XSTRING_DATA (arg1);
859 status = lib$sys_trnlog (symdsc, &length, strdsc); 858 status = lib$sys_trnlog (symdsc, &length, strdsc);
860 if (! (status & 1)) 859 if (! (status & 1))
861 error ("Unable to translate logical name: %s", vmserrstr (status)); 860 error ("Unable to translate logical name: %s", vmserrstr (status));
862 if (status == SS$_NOTRAN) 861 if (status == SS$_NOTRAN)
863 return (Qnil); 862 return (Qnil);
872 int status, symdsc[2]; 871 int status, symdsc[2];
873 int strdsc[2] = { sizeof (str), str }; 872 int strdsc[2] = { sizeof (str), str };
874 short length, level; 873 short length, level;
875 874
876 CHECK_STRING (arg1); 875 CHECK_STRING (arg1);
877 symdsc[0] = string_length (XSTRING (arg1)); 876 symdsc[0] = XSTRING_LENGTH (arg1);
878 symdsc[1] = string_data (XSTRING (arg1)); 877 symdsc[1] = XSTRING_DATA (arg1);
879 status = lib$get_symbol (symdsc, strdsc, &length, &level); 878 status = lib$get_symbol (symdsc, strdsc, &length, &level);
880 if (! (status & 1)) { 879 if (! (status & 1)) {
881 if (status == LIB$_NOSUCHSYM) 880 if (status == LIB$_NOSUCHSYM)
882 return (Qnil); 881 return (Qnil);
883 else 882 else