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 /* format: style4,indattr,ifthenstmt,ifthen,idind35,^indcomtxt */
 13 
 14 user_wire: user_wire_seg: proc (a_segptr, a_wiring, a_fp, a_np, a_code);
 15 
 16 /* Greenberg 2/10/77 */
 17 /* Modified 7/3/84 by Keith Loepere to use the new dc_find. */
 18 
 19 /* Parameters */
 20 
 21 dcl  a_code                             fixed bin (35) parameter;
 22 dcl  a_dn                               char (*) parameter;
 23 dcl  a_en                               char (*) parameter;
 24 dcl  a_fp                               fixed bin parameter;
 25 dcl  a_np                               fixed bin parameter;
 26 dcl  a_segptr                           ptr parameter;
 27 dcl  a_wiring                           bit (1) aligned parameter;
 28 
 29 /* Variables */
 30 
 31 dcl  code                               fixed bin (35);
 32 dcl  dn                                 char (168);
 33 dcl  en                                 char (32);
 34 dcl  fp                                 fixed bin;
 35 dcl  np                                 fixed bin;
 36 dcl  pathentry                          bit (1);
 37 dcl  segptr                             ptr;
 38 dcl  wiring                             bit (1) aligned;
 39 
 40 /* External */
 41 
 42 dcl  error_table_$argerr                fixed bin (35) ext;
 43 dcl  error_table_$bad_ring_brackets     fixed bin (35) ext;
 44 dcl  error_table_$invalidsegno          fixed bin (35) ext;
 45 
 46 /* Entries */
 47 
 48 dcl  activate                           entry (ptr, fixed bin (35)) returns (ptr);
 49 dcl  level$get                          entry returns (fixed bin (3));
 50 dcl  lock$dir_unlock                    entry (ptr);
 51 dcl  lock$unlock_ast                    entry;
 52 dcl  pc_wired$unwire                    entry (ptr, fixed bin, fixed bin);
 53 dcl  pc_wired$wire_wait                 entry (ptr, fixed bin, fixed bin);
 54 
 55 /* Misc */
 56 
 57 dcl  (fixed, ptr)                       builtin;
 58 %page;
 59           segptr = a_segptr;
 60           pathentry = "0"b;
 61           go to join;
 62 
 63 user_wire_file: entry (a_dn, a_en, a_wiring, a_fp, a_np, a_code);
 64 
 65           dn = a_dn;
 66           en = a_en;
 67           pathentry = "1"b;
 68 join:
 69           wiring = a_wiring;
 70 
 71           if wiring then do;
 72                fp = a_fp;
 73                np = a_np;
 74           end;
 75           else do;
 76                fp = 0;
 77                np = -1;
 78           end;
 79 
 80           if pathentry then call dc_find$obj_status_read_priv (dn, en, DC_FIND_CHASE, ep, code);
 81           else call dc_find$obj_status_read_priv_ptr (segptr, ep, code);
 82           if code = 0 then do;
 83                if level$get () > fixed (entry.ring_brackets (1), 3) then code = error_table_$bad_ring_brackets;
 84                else astep = activate (ep, code);
 85                if code = 0 then do;
 86                     if aste.hc_sdw then code = error_table_$invalidsegno;
 87                     else if fp >= fixed (aste.csl, 9)
 88                               | (np ^= -1 & fp + np > fixed (aste.csl, 9))
 89                               | (np < 1 & np ^= -1)
 90                     then code = error_table_$argerr;
 91                     else do;
 92                          aste.ehs = wiring;
 93                          if wiring then call pc_wired$wire_wait (astep, fp, np);
 94                          else call pc_wired$unwire (astep, fp, np);
 95                     end;
 96                     call lock$unlock_ast;
 97                end;
 98                call lock$dir_unlock (ptr (ep, 0));
 99                if pathentry then call dc_find$finished (ep, "0"b);
100           end;
101 
102           a_code = code;
103           return;
104 %page;
105 %page; %include aste;
106 %page; %include dc_find_dcls;
107 %page; %include dir_entry;
108      end;