1 /****^  ***********************************************************
 2         *                                                         *
 3         * Copyright, (C) Honeywell Bull Inc., 1987                *
 4         *                                                         *
 5         * Copyright, (C) Honeywell Information Systems Inc., 1982 *
 6         *                                                         *
 7         * Copyright (c) 1972 by Massachusetts Institute of        *
 8         * Technology and Honeywell Information Systems, Inc.      *
 9         *                                                         *
10         *********************************************************** */
11 
12 
13 /* The make_seg procedure creates a branch in a
14    specified directory with a specified entry name.  Once
15    the branch is created, the segment is made known to the
16    process by a call to "initiate" and a pointer to the
17    segment is returned to the caller. */
18 
19 make_seg: procedure (adirname, aentry, arefname, amode, asegptr, acode);
20 
21 /* Modified by R. Bratt 04/76 to make "" and " " equivalent arguments for dname/ename */
22 /* Modified by E. Stone 10/73 to remove the $stack entry point */
23 
24 dcl  adirname char (*),                                     /* is the directory in which to create "entry". */
25      aentry char (*),                                       /* is the entry name in question. */
26      arefname char (*),                                     /* is the desired reference name, or "". */
27      amode fixed bin (5),                                   /* specifies the mode for this user. */
28      asegptr ptr,                                           /* is an ITS pointer to the created segment.
29                                                                (Output) */
30      acode fixed bin;                                       /* is a standard File System status code.
31                                                                (Output) */
32 
33 dcl  dirname char (168),                                    /* copy of directory name */
34      entry char (32),                                       /* copy of entry name */
35     (code1, code2) fixed bin (35);                          /* error codes */
36 
37 dcl  pds$process_dir_name char (32) ext,                    /* name of process directory */
38      error_table_$namedup fixed bin (35) ext;               /* error code for name duplication */
39 
40 dcl (null, length) builtin;
41 
42 dcl  unique_chars_ ext entry (bit (*) aligned) returns (char (15)),
43      append$branch entry (char (*), char (*), fixed bin (5), fixed bin (35)),
44      initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35));
45 
46 
47 /* ^L */
48 
49           asegptr = null;                                   /* Initialize pointer. */
50 
51           dirname = adirname;
52           if dirname = ""                                   /* If supplied directory name is null ... */
53           then dirname = pds$process_dir_name;              /* Use process directory name. */
54 
55           entry = aentry;
56           if entry = ""                                     /* If supplied entry name is null ... */
57           then entry = unique_chars_ ("0"b);                /* Use unique name. */
58 
59           call append$branch (dirname, entry, amode, code1); /* Now create segment branch in hierarchy. */
60           if code1 ^= 0 then                                /* If error ... */
61                if code1 ^= error_table_$namedup then        /* If not a name duplication ... */
62                     go to make_rtn;                         /* Return the error code2. */
63 
64           call initiate (dirname, entry, arefname, 0, 0, asegptr, code2);
65                                                             /* Initiate the segment. */
66 
67           if code2 ^= 0 then                                /* If error in initiate ... */
68                acode = code2;                               /* Return error code from initiate. */
69           else                                              /* Otherwise ... */
70 make_rtn:
71           acode = code1;                                    /* Return error code from append. */
72           return;                                           /* Return to caller. */
73 
74 
75 
76 
77      end make_seg;