1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Bull Inc., 1987                *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1984 *
  6         *                                                         *
  7         * Copyright (c) 1972 by Massachusetts Institute of        *
  8         * Technology and Honeywell Information Systems, Inc.      *
  9         *                                                         *
 10         *********************************************************** */
 11 
 12 
 13 /* format: style4 */
 14 fs_move: proc;
 15 
 16 /* Modified by E. Stone 8/73  to convert to version 2 and to check the max length of the TO segment */
 17 /* Modified January 1983 by Keith Loepere so as to truncate target AFTER
 18    all validations */
 19 /* Modified February 1983 by E. N. Kittlitz for 256K segments */
 20 /* Modified November 1984 by Keith Loepere to rename terminate to terminate_ */
 21 
 22 ffile: entry (a_dirname_from, a_ename_from, a_sw, a_dirname_to, a_ename_to, a_code);
 23 
 24 dcl  a_dirname_from char (*);
 25 dcl  a_dirname_to char (*);
 26 dcl  a_ename_from char (*);
 27 dcl  a_ename_to char (*);
 28 dcl  a_sw fixed bin (2);
 29 dcl  a_code fixed bin (35);
 30 
 31 dcl  created_seg bit (1) aligned;
 32 dcl  dirname_from char (168);
 33 dcl  dirname_to char (168);
 34 dcl  ename_from char (32);
 35 dcl  ename_to char (32);
 36 dcl  curlen fixed bin;
 37 dcl  ldirname_from fixed bin;
 38 dcl  ldirname_to fixed bin;
 39 dcl  target_len bit (12);
 40 dcl  entry_point fixed bin;
 41 dcl  options bit (2) unaligned;
 42 dcl  append_sw bit (1) unaligned def (options) pos (1);
 43 dcl  truncate_sw bit (1) unaligned def (options) pos (2);
 44 dcl  max_length fixed bin (19);
 45 dcl  words fixed bin (19);
 46 dcl  tcode fixed bin (35);
 47 dcl  code fixed bin (35);
 48 dcl  ptr_from ptr;
 49 dcl  ptr_to ptr;
 50 dcl  dptr ptr;
 51 
 52 dcl  copy (words) bit (36) aligned based;
 53 
 54 dcl  file fixed bin static init (0) options (constant);
 55 dcl  seg fixed bin static init (1) options (constant);
 56 
 57 dcl  error_table_$noentry fixed bin (35) ext static;
 58 dcl  error_table_$segknown fixed bin (35) ext static;
 59 dcl  error_table_$clnzero fixed bin (35) ext static;
 60 dcl  error_table_$no_s_permission fixed bin (35) ext static;
 61 dcl  error_table_$no_move fixed bin (35) external;
 62 
 63 dcl  append$branch entry (char (*), char (*), fixed bin (5), fixed bin (35));
 64 dcl  fs_get$path_name entry (ptr, char (*), fixed bin, char (*), fixed bin (35));
 65 dcl  status_$get_max_length_ptr entry (ptr, fixed bin (19), fixed bin (35));
 66 dcl  initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35));
 67 dcl  status_$long entry (char (*), char (*), fixed bin (1), ptr, ptr, fixed bin (35));
 68 dcl  terminate_$noname entry (ptr, fixed bin (35));
 69 dcl  truncate$trseg entry (ptr, fixed bin, fixed bin (35));
 70 dcl  quota$check_file entry (char (*), char (*), fixed bin, fixed bin (35));
 71 dcl  set$max_length_path entry (char (*), char (*), fixed bin (19), fixed bin (35));
 72 
 73 dcl  (addr, bit, fixed, null) builtin;
 74 
 75 dcl  1 lbranch aligned,                                     /* structure to return long branch status */
 76        (2 (type bit (2), nnames bit (16), nrp bit (18)),
 77        2 dtm bit (36),
 78        2 dtu bit (36),
 79        2 (mode bit (5), pad1 bit (13), records bit (18)),
 80        2 dtd bit (36),                                      /* date time file and branch dumped */
 81        2 dtem bit (36),                                     /* date time branch modified */
 82        2 acct bit (36),                                     /* account number to which storage is charged */
 83        2 (curlen bit (12), bitcnt bit (24)),                /* highest 1024-word block used, bit count */
 84        2 (did bit (4), mdid bit (4), copysw bit (1), pad3 bit (9), rbs (0:2) bit (6)),
 85        2 uid bit (36)) unaligned;
 86 
 87 %page;
 88           entry_point = file;                               /* indicate that entry was via pathname entry point */
 89           dirname_from = a_dirname_from;                    /* copy arguments */
 90           ename_from = a_ename_from;
 91           dirname_to = a_dirname_to;
 92           ename_to = a_ename_to;
 93           options = bit (a_sw, 2);                          /* get options user has requested */
 94           created_seg = "0"b;                               /* we didn't make output segment */
 95           code, tcode = 0;                                  /* initialize status codes */
 96 
 97           call initiate (dirname_from, ename_from, "", 0, 0, ptr_from, code);
 98                                                             /* get pointer to FROM segment */
 99 
100           if code ^= 0 then if code ^= error_table_$segknown then go to fin0;
101 
102 try2:     call initiate (dirname_to, ename_to, "", 0, 0, ptr_to, code);
103                                                             /* get pointer to TO segment */
104 
105           if code ^= 0 then if code ^= error_table_$segknown then do;
106                                                             /* if TO segment does not exist */
107                     if created_seg then do;
108                          if code = 0 then code = error_table_$no_move;
109                          go to fin1;
110                     end;
111                     if code = error_table_$noentry then do;
112                          if append_sw then do;              /* if append option given, try to make new TO seg */
113                               created_seg = "1"b;           /* first try to create */
114                               call status_$get_max_length_ptr (ptr_from, max_length, code); /* get max length of FROM segment */
115                               if code ^= 0 then go to fin1;
116                               call append$branch (dirname_to, ename_to, 01011b, code);
117                               if code ^= 0 then go to fin1; /* boo hoo */
118                               call set$max_length_path (dirname_to, ename_to, max_length, code);
119                               if code = 0 then go to try2;
120                          end;
121                     end;
122                     go to fin1;                             /*  unable to initiate TO seg or unable to create it */
123                end;
124           go to common;
125 
126 fseg: entry (a_ptr_from, a_ptr_to, a_sw, a_code);
127 
128 dcl  (a_ptr_from, a_ptr_to) ptr;
129 
130           entry_point = seg;                                /* indicate that entry was via the pointer entry point */
131           ptr_from = a_ptr_from;                            /* copy arguments */
132           ptr_to = a_ptr_to;
133           options = bit (a_sw, 2);                          /* get options user has requested */
134           code, tcode = 0;                                  /* initialize status codes */
135 
136           call fs_get$path_name (ptr_from, dirname_from, ldirname_from, ename_from, code);
137                                                             /* get pathname of FROM segment */
138 
139           if code ^= 0 then go to fin0;
140 
141           call fs_get$path_name (ptr_to, dirname_to, ldirname_to, ename_to, code);
142                                                             /* get pathname of TO sement */
143 
144           if code ^= 0 then go to fin0;
145 
146 common:
147           dptr = addr (lbranch);                            /* get pointer to storage for status_ info */
148 
149           call status_$long (dirname_to, ename_to, 1, dptr, null, code);
150                                                             /* get status info on TO segment */
151 
152           if code ^= 0 then
153                if code = error_table_$no_s_permission then code = 0; /* non fatal error */
154                else go to fin2;                             /* serious error */
155           target_len = lbranch.curlen;                      /* save for later chec */
156 
157           if lbranch.type ^= "01"b then do;                 /* make sure that entry is a segment */
158 badmove:       code = error_table_$no_move;
159                go to fin2;
160           end;
161 
162           if (lbranch.mode & "01010"b) ^= "01010"b then go to badmove; /* need RW on TO segment */
163 
164           call status_$long (dirname_from, ename_from, 1, dptr, null, code);
165                                                             /* get status info on FROM segment */
166 
167           if code ^= 0 then
168                if code = error_table_$no_s_permission then code = 0; /* non fatal error */
169                else go to fin2;                             /* serious error */
170 
171           if lbranch.type ^= "01"b then go to badmove;      /* make sure that entry is a segment */
172 
173           if (lbranch.mode & "01000"b) = "0"b then go to badmove; /* need R on FROM segment */
174 
175           curlen = fixed (lbranch.curlen, 12);              /* save current length in pages of FROM segment */
176           words = curlen * 1024;                            /* get number of words of FROM segment */
177 
178           call status_$get_max_length_ptr (ptr_to, max_length, code); /* get max length of TO segment */
179           if code ^= 0 then go to badmove;
180           if words > max_length then go to badmove;         /* make sure that TO segment has big enough max length */
181 
182           call quota$check_file (dirname_to, ename_to, curlen, code);
183                                                             /* make sure that there is enough quota to perform the copy */
184 
185           if code ^= 0 then go to badmove;                  /* it wont fit */
186 
187           if target_len then                                /* if TO seg has non-zero length */
188                if truncate_sw then do;                      /* and if truncate option given, truncate TO seg */
189                     call truncate$trseg (ptr_to, 0, code);
190                     if code ^= 0 then go to fin2;
191                end;
192                else do;                                     /* and if truncate option not given, return status code */
193                     code = error_table_$clnzero;
194                     go to fin2;
195                end;
196 
197           ptr_to -> copy = ptr_from -> copy;                /* copy FROM segment to TO segment */
198 
199           call truncate$trseg (ptr_from, 0, code);          /* truncate FROM segment */
200 
201 fin2:     if entry_point = seg then go to fin0;             /* if entered via pointer entry, skip terminating segs */
202           call terminate_$noname (ptr_to, tcode);           /* terminate TO seg */
203           if tcode ^= 0 then go to fin0;
204 fin1:     if entry_point = seg then go to fin0;
205           call terminate_$noname (ptr_from, tcode);         /* terminate FROM seg */
206 
207 fin0:     if tcode ^= 0 then a_code = tcode;
208           else a_code = code;
209 
210           return;
211 
212      end;