1 /* ***********************************************************
  2    *                                                         *
  3    * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  4    *                                                         *
  5    * Copyright (c) 1972 by Massachusetts Institute of        *
  6    * Technology and Honeywell Information Systems, Inc.      *
  7    *                                                         *
  8    *********************************************************** */
  9 
 10 
 11           /* DATMK_ - Data Segment Grower for Multics.
 12                     6/22/68 - Noel I. Morris                          */
 13 /*                  29 May 69 - James D. Mills                        */
 14 /*                  20 Oct 70 - Barry L. Wolman (areas on mod 8 boundary)       */
 15 /*                  16 Oct 1972 - Melanie B. Weaver (broke into 2 pieces; converted t0 v2pl1) */
 16 
 17 
 18           /*
 19 
 20 Calling Sequence:
 21           call datmk_ (arg_list_ptr_ptr, mcptr, fault_ptr);
 22 
 23 Where:
 24           arg_list_ptr_ptr    = pointer to EPL or PL/1 -compiled argument list.
 25           mcptr     = pointer to machine conditions.
 26           fault_ptr           = pointer to linkage fault-pair.
 27 
 28 The EPL-compiled argument list appears as follows:
 29           dec       n         number of words to grow data segment
 30           dec       x         x = 0, 1, or 2
 31           ...
 32 
 33           If "x" = 0, no initialization is to be done.
 34           If "x" = 1, the third location points to the initialization procedure.
 35           If "x" = 2, the third location is the first location of
 36             the initialization procedure.
 37 
 38 
 39 The PL/1-compiled argument list appears as follows:
 40           dec       n         number of words to grow data segment
 41           dec       x         x = 0, 3, or 4
 42           ...
 43 
 44           If "x" = 0, no initialization is to be done.
 45           If "x" = 3, the third location is the first of n words which must
 46                     be copied into the newly-grown space to initialize it.
 47           If "x" = 4, the newly-grown space must be initialized as an area.
 48                     There is no third argument.
 49 
 50                     */
 51 
 52 datmk_:   proc (arg_list_ptr_ptr, mcptr, fault_ptr);
 53 
 54           dcl (arg_list_ptr_ptr,                            /* argument list pointer */
 55                mcptr,                                       /* pointer to machine conditions */
 56                fault_ptr) ptr;                              /* pointer to linkage fault-pair */
 57 
 58           dcl seg_ptr ptr,                                  /* pointer to segment name */
 59                def_ptr ptr,                                 /* pointer to definition section */
 60                seg char (32),                               /* segment name */
 61                rcode fixed bin(35),                         /* error code */
 62                lseg fixed bin (9),                          /* length of segment name */
 63                type_pair_ptr ptr,                           /* pointer to type-pair block */
 64                data_ptr ptr,                                /* pointer to the grown data */
 65                based_ptr ptr based ;                        /* pointer to pointer */
 66 
 67 
 68           dcl (addr, addrel, bin, fixed, null, substr) builtin;
 69 
 70           dcl  hcs_$fs_get_seg_ptr ext entry(char(*), ptr, fixed bin(35));
 71           dcl hcs_$rest_of_datmk_ ext entry(ptr, ptr, fixed bin(35)); /* does actual initialization */
 72           dcl hcs_$make_seg ext entry(char(*), char(*), char(*), fixed bin(5), ptr, fixed bin(35));
 73           dcl hcs_$link_force ext entry(ptr, fixed bin(17), fixed bin(35));
 74 
 75 
 76           dcl 1 datmk_info aligned,                         /* contains info for rest_of_datmk_ */
 77 %include datmk_info;
 78 
 79 /*^L*/
 80 
 81 %include linkdcl;
 82 
 83 /*^L*/
 84 
 85           /* Step 1.
 86                     Assume definition does not exist.  Extract the segment name and
 87                     symbol from the fault pair information.
 88 
 89                               */
 90 
 91           def_ptr = addrel (fault_ptr, fault_ptr -> link.head_ptr) -> header.def_ptr;
 92                                                             /* Get linkage definitions pointer. */
 93           type_pair_ptr = addrel (def_ptr, addrel (def_ptr, fault_ptr -> link.exp_ptr) -> exp_word.type_ptr);
 94                                                             /* Generate pointer to type-pair block. */
 95           if fixed (type_pair_ptr -> type_pair.type, 18) ^= 4 then go to type_error;
 96                                                             /* Must be a type 4 link. */
 97 
 98           seg_ptr = addrel (def_ptr, type_pair_ptr -> type_pair.seg_ptr);
 99                                                             /* Generate pointer to segment name. */
100           lseg = bin(seg_ptr -> name.nchars, 9);            /* Get length of name. */
101           seg = substr (seg_ptr -> name.char_string, 1, lseg);
102                                                             /* Make a copy of the segment name. */
103           sym_ptr = addrel (def_ptr, type_pair_ptr -> type_pair.ext_ptr);
104                                                             /* Generate pointer to symbol name. */
105 
106 
107           /* Step 2.
108                               Get a pointer to the data segment, try to snap the link and return.
109                     If this fails, call hcs_$rest_of_datmk_, which gets a pointer to
110                     the linkage section, determines the value of the new def, and
111                     initializes the new item, if requested.
112                     if the data or linkage segments do not exist, they are created
113                     and initialized.
114 
115                               */
116 
117                                                             /* Extract caller pointer to SCU data. */
118 
119           call hcs_$fs_get_seg_ptr ( seg, text_ptr, rcode);/* Get a pointer to text segment. */
120           if text_ptr = null then do;                       /* If text segment not found ... */
121                call hcs_$make_seg ("", "", seg, 01011b, text_ptr, rcode);
122                                                             /* Create the text segment. */
123                if text_ptr = null then go to text_error;    /* Check for error in creating text segment. */
124           end;
125 
126           else do;                                          /* Check for existing segment */
127                     call hcs_$link_force (fault_ptr, 0, rcode);
128                                                             /* Try to force the link */
129                     if rcode = 0 then return;               /* If successful, the definition exists. Return. */
130           end;
131 
132           /* fill in structure for rest_of_datmk_ */
133 
134           segname = substr(seg_ptr -> name.char_string, 1, lseg);
135           call hcs_$link_force(arg_list_ptr_ptr, 0, rcode);           /* get ptr to argument list */
136           arg_list_ptr = arg_list_ptr_ptr -> based_ptr;
137 
138           call hcs_$rest_of_datmk_(addr(datmk_info), data_ptr, rcode);
139                                                   /* let subroutine grow and initialize segment */
140 
141           if rcode ^= 0 then return;
142 
143           /* now we have everything set up and can snap the link */
144 
145           call hcs_$link_force(fault_ptr, 0, rcode);
146 
147 type_error:
148 text_error:
149           return;
150 
151           /* If original link couldn't be snapped for some reason,
152              we return anyway.  datmk_'s "caller" should check to see if the link was
153              snapped, and if not, print  linkage error message. */
154 
155           end datmk_;