1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Bull Inc., 1987                *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1985 *
  6         *                                                         *
  7         *********************************************************** */
  8 
  9 /****^  HISTORY COMMENTS:
 10   1) change(86-07-17,MAgar), approve(86-12-12,MCR7548),
 11      audit(86-12-12,Gilcrease), install(87-08-07,MR12.1-1075):
 12      Created.
 13   2) change(87-03-25,Flegel), approve(87-03-25,MCR7548),
 14      audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
 15      Corrected mechanism for locating the source to using standard search
 16      rules (hcs_$make_ptr).
 17                                                    END HISTORY COMMENTS */
 18 
 19 /* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
 20 load_mowse:
 21      proc ();
 22 
 23 /* FUNCTION
 24 
 25    This program will read mowse.com, exitmows.com, bft.com, or bft_load.com
 26    wsterm.exe on Multics and convert them to Hex and ship them out over the
 27    communicatons line to the PC.
 28 */
 29 
 30 /* SUBSYSTEM DOCUMENTATION
 31 */
 32 
 33 /* NOTES
 34 */
 35 
 36 
 37 /* INPUT PARAMETERS */
 38 
 39 
 40 /* OUTPUT PARAMETERS */
 41 
 42 
 43 /* SYSTEM CALLS */
 44 dcl hcs_$fs_get_path_name  entry (ptr, char (*), fixed bin, char (*), fixed bin (35));
 45 dcl hcs_$status_mins       entry (ptr, fixed bin (2), fixed bin (24), fixed bin (35));
 46 dcl hcs_$make_ptr          entry (ptr, char (*), char (*), ptr, fixed bin (35));
 47 dcl ioa_$ioa_switch        entry () options (variable);
 48 dcl com_err_               entry options (variable);
 49 dcl iox_$modes             entry (ptr, char (*), char (*), fixed bin (35));
 50 dcl cu_$arg_ptr_rel        entry (fixed bin, ptr, fixed bin, fixed bin (35),
 51                            ptr);
 52 dcl cu_$arg_list_ptr       entry (ptr);
 53 dcl cu_$arg_count_rel      entry (fixed bin, ptr, fixed bin (35));
 54 dcl iox_$detach_iocb       entry (ptr, fixed bin (35));
 55 dcl iox_$destroy_iocb      entry (ptr, fixed bin (35));
 56 dcl iox_$attach_name       entry (char (*), ptr, char (*), ptr,
 57                            fixed bin (35));
 58 dcl iox_$put_chars         entry (ptr, ptr, fixed bin (21), fixed bin (35));
 59 dcl iox_$get_chars         entry (ptr, ptr, fixed bin (21), fixed bin (21),
 60                            fixed bin (35));
 61 dcl iox_$open              entry (ptr, fixed bin, bit (1) aligned,
 62                            fixed bin (35));
 63 dcl iox_$close             entry (ptr, fixed bin (35));
 64 
 65 
 66 /* SYSTEM CALL SUPPORT */
 67 dcl bit_count              fixed bin (24);            /* bits in file */
 68 dcl cont_ptr               ptr;                       /* ptr to continue */
 69 dcl arg_ptr                ptr;                       /* ptr to filename */
 70 dcl arg                    char (arg_len) based (arg_ptr);
 71                                                       /* filename */
 72 dcl arg_len                fixed bin;                 /* length of filename */
 73 dcl arg_count              fixed bin;                 /* number of args */
 74 dcl arg_list_ptr           ptr;                       /* ptr to args list */
 75 dcl iox_$error_output      ptr ext static;            /* Error message IOCB */
 76 dcl error_table_$wrong_no_of_args
 77                            fixed bin (35) ext static;
 78 
 79 /* EXTERNAL CALLS */
 80 
 81 
 82 /* EXTERNAL CALL SUPPORT */
 83 dcl start_ptr              ptr;                       /* ptr to start transmit packet */
 84 dcl start                  char (50);                 /* start packet */
 85 dcl num_left               fixed bin (21);            /* number of chars to EOF */
 86 dcl num_read               fixed bin (21);            /* number of chars read */
 87 dcl iox_$user_io           ptr external;              /* screen ptr */
 88 dcl in_ptr                 ptr;                       /* input file ptr */
 89 dcl code                   fixed bin (35);            /* error code */
 90 
 91 
 92 /* BUILTINS */
 93 dcl rtrim                  builtin;
 94 dcl substr                 builtin;
 95 dcl addr                   builtin;
 96 dcl convert                builtin;
 97 dcl length                 builtin;
 98 dcl mod                    builtin;
 99 dcl null                   builtin;
100 
101 
102 /* CONSTANTS */
103 dcl TRUE                   bit (1) init ("1"b) int static options (constant);
104 dcl FALSE                  bit (1) init ("0"b) int static options (constant);
105 dcl USAGE                  char (31) int static options (constant) init ("^/^5tUsage: load_mowse FILENAME");
106 dcl MY_NAME                char (10) int static options (constant) init ("load_mowse");
107 dcl PACKET_SIZE            fixed bin (21) int static options (constant) init (4);
108 dcl CHECK_SUM_MASK         fixed bin int static options (constant) init (30);
109 dcl ASCII_MASK             bit (5) int static options (constant) init ("00010"b);
110 dcl BYTE_SIZE              fixed bin int static options (constant) init (9);
111 dcl BYTE_ON                bit (9) int static options (constant) init ("111111111"b);
112 
113 /* MISC VARIABLES */
114 dcl temp_string            char (5);
115 dcl path_name              char (168);                /* Full pathname of source */
116 dcl entry_name             char (32);                 /* Segment name */
117 dcl dir_name_len           fixed bin;                 /* Length of dir name */
118 dcl dir_name               char (168);                /* Directory of source */
119 dcl seg_type               fixed bin (2);             /* segment type */
120 dcl seg_ptr                ptr;                       /* segment pointer to source */
121 dcl maxsize                fixed bin (21);            /* maximum file size */
122 dcl temp                   fixed bin (21);            /* temporary storage for check sum */
123 dcl check_out_ptr          ptr;                       /* ptr to check_sum */
124 dcl buf_check              char (1) aligned;          /* aligned address of check_sum */
125 dcl check_out              bit (9) based (check_out_ptr);
126                                                       /* transmitted check sum */
127 dcl check_sum              fixed bin (8);             /* check_sum */
128 dcl ttl_read               fixed bin (21);            /* number of characters read */
129 dcl new_modes              char (256);                /* new terminal modes */
130 dcl old_modes              char (256);                /* original terminal modes */
131 dcl eof                    bit (1);                   /* end of file */
132 dcl continue               char (1);                  /* continuation */
133 dcl line_in_ptr            ptr;                       /* ptr to input */
134 dcl buf_in                 char (1) aligned;          /* aligned address of line in */
135 dcl 01 line_in             based (line_in_ptr),       /* input storage */
136        02 drop1            bit (1),                   /* drop multics first bit */
137        02 top1             bit (4),                   /* save top 4 bits from character */
138        02 bot1             bit (4),                   /* save bottom 4 bits from character */
139        02 drop2            bit (1),                   /* second character */
140        02 top2             bit (4),
141        02 bot2             bit (4),
142        02 drop3            bit (1),                   /* third character */
143        02 top3             bit (4),
144        02 bot3             bit (4),
145        02 drop4            bit (1),                   /* fourth character */
146        02 top4             bit (4),
147        02 bot4             bit (4);
148 dcl line_out_ptr           ptr;                       /* ptr to output */
149 dcl buf_out                char (2) aligned;          /* aligned address of output line */
150 dcl 01 line_out            based (line_out_ptr),      /* output strg */
151        02 ntop1            bit (9),                   /* new top for character 1 */
152        02 nbot1            bit (9),                   /* new bottom for character 1 */
153        02 ntop2            bit (9),                   /* new top for charater 2 */
154        02 nbot2            bit (9),                   /* new bottom for charater 2 */
155        02 ntop3            bit (9),                   /* new top for character 3 */
156        02 nbot3            bit (9),                   /* new bottom for character 3 */
157        02 ntop4            bit (9),                   /* new top for character 4 */
158        02 nbot4            bit (9);                   /* new bottom for character 4 */
159 
160 
161 /*^L*/
162 
163 /* INITIALIZATION */
164           temp_string = "*****";
165           path_name = "";
166           entry_name = "";
167           dir_name_len = 0;
168           dir_name = "";
169 
170           check_sum = 0;                              /* init check sum */
171           code = 0;                                   /* init code */
172           ttl_read = 0;                               /* init total characters read */
173           eof = FALSE;                                /* set end of file to false */
174           start = "                                 strt";
175                                                       /* init start packet(34<sp>strt) */
176           in_ptr = null ();                           /* Infile IOCB pointer */
177           cont_ptr = addr (continue);                 /* set pointer to continue */
178           line_in_ptr = addr (buf_in);                /* set pointer to input line */
179           line_out_ptr = addr (buf_out);              /* set pointer to output line */
180           check_out_ptr = addr (buf_check);           /* set pointer to check sum */
181           start_ptr = addr (start);                   /* set pointer to start packet */
182 
183 
184 /* : get arguments */
185 
186           call cu_$arg_list_ptr (arg_list_ptr);
187           call cu_$arg_count_rel (arg_count, arg_list_ptr, code);
188           if code ^= 0 then do;
189                call com_err_ (code, MY_NAME, "Unable to get argument count.");
190                return;
191           end;
192 
193 
194 /* : if wrong number of arguments given then quit */
195 
196           if arg_count ^= 1 then do;
197                call com_err_ (error_table_$wrong_no_of_args, MY_NAME, USAGE);
198                return;
199           end;
200 
201 
202 /* : connect to file name for input */
203 
204           call cu_$arg_ptr_rel (1, arg_ptr, arg_len, code, arg_list_ptr);
205           if code ^= 0 then do;
206                call com_err_ (code, MY_NAME, "Getting arguments.");
207                return;
208           end;
209 
210           if (arg ^= "bft.com") & (arg ^= "mowse.com") & (arg ^= "wsterm.exe")
211                & (arg ^= "bft_load.com") & (arg ^= "exitmows.com")
212           then do;
213                call com_err_ (0, MY_NAME, "Incorrect file ^a." || USAGE, arg);
214                return;
215           end;
216 
217 /* : Find the absolute path of the argument in the user's paths or initiated
218      segments */
219 
220           call hcs_$make_ptr (null, arg, "", seg_ptr, code);
221           if code ^= 0 then do;
222                call com_err_ (code, MY_NAME, "Finding ^a.", arg);
223                return;
224           end;
225 
226 /* : set maxsize for each file */
227 
228           call hcs_$status_mins (seg_ptr, seg_type, bit_count, code);
229           if code ^= 0 then do;
230                call com_err_ (code, MY_NAME, "Getting size of ^a.", arg);
231                return;
232           end;
233 
234           maxsize = bit_count / BYTE_SIZE;
235 
236 /* : Find the absolute path of the segment */
237 
238           call hcs_$fs_get_path_name (seg_ptr, dir_name, dir_name_len,
239                entry_name, code);
240           if code ^= 0 then do;
241                call com_err_ (code, MY_NAME, "Getting pathname of ^a.",
242                     arg);
243                return;
244           end;
245 
246           path_name
247                = substr (dir_name, 1, dir_name_len)
248                || ">"
249                || rtrim (entry_name);
250 
251 /* : Attach the IOCB for the file to be transferred */
252 
253           call iox_$attach_name ("load_mowse_in", in_ptr,
254                "vfile_ " || rtrim (path_name), null (), code);
255           if code ^= 0 then do;
256                call com_err_ (code, MY_NAME,
257                     "Unable to attach I/O switch.");
258                return;
259           end;
260 
261 /* : make sure file is in a closed state */
262 
263           call iox_$close (in_ptr, (0));
264 
265 /* : open file, quit if not found */
266 
267           call iox_$open (in_ptr, 1, "0"b, code);
268           if code ^= 0 then do;
269                call clean_up;
270                call com_err_ (code, MY_NAME, "Looking for ^a.", arg);
271                return;
272           end;
273 
274 /* : set initial modes */
275 
276           new_modes = "^echoplex";
277           call iox_$modes (iox_$user_io, new_modes, old_modes, code);
278           if code ^= 0 then do;
279                call clean_up;
280                call com_err_ (code, MY_NAME, "Setting modes.");
281                return;
282           end;
283 
284 /* : send start of comm to PC */
285 
286           call iox_$put_chars (iox_$user_io, start_ptr,
287                length (rtrim (start)), code);
288           if code ^= 0 then do;
289                call clean_up;
290                call com_err_ (code, MY_NAME, "Start packet failed.");
291                return;
292           end;
293 
294           call wait;
295           if (continue = "q") then do;
296                call clean_up;
297                call ioa_$ioa_switch (iox_$error_output,
298                     "load_mowse: Start packet failed.");
299                return;
300           end;
301 
302 
303 /* : transfer file name to PC */
304 
305           call iox_$put_chars (iox_$user_io, addr (temp_string), 5, (0));
306           call iox_$put_chars (iox_$user_io, addr (entry_name),
307                length (rtrim (entry_name)), code);
308 
309           call wait;
310           if (continue = "q") then do;
311                call clean_up;
312                call ioa_$ioa_switch (iox_$error_output,
313                     "load_mowse: Name packet failed.");
314                return;
315           end;
316 
317 
318 /* : transfer file to PC */
319 
320           call send;
321 
322 
323 /* : reset modes and close files */
324 
325           call clean_up;
326 
327 
328 /*^L*/
329 /* INTERNAL PROCEDURES */
330 
331 clean_up:
332      proc;
333 
334 /* FUNCTION
335    This procedure will close the open file, detach the pointer and quit */
336 
337 
338 /* : reset terminal modes */
339 
340           call iox_$modes (iox_$user_io, old_modes, new_modes, (0));
341 
342 
343 /* : close and detach and destroy file IOCB */
344 
345           call iox_$close (in_ptr, (0));
346           call iox_$detach_iocb (in_ptr, (0));
347           call iox_$destroy_iocb (in_ptr, (0));       /* wipe in iocb out */
348 
349 
350 /* : end of program */
351 
352           return;
353 
354      end;
355 
356 
357 wait:
358      proc;
359 
360 /* FUNCTION
361    This procedure will wait until it receives a reply from the PC */
362 
363 
364           code = 0;
365           continue = "n";
366           do while ((continue ^= "y") & (continue ^= "q"));
367                call iox_$get_chars (iox_$user_io, cont_ptr, 1, num_read, code);
368           end;
369      end;
370 
371 
372 end_of_send:
373      proc;
374 
375 /* FUNCTION
376    This procedure will send the end of transmission info to the PC */
377 
378 
379 /* : print end of transmission to PC */
380 
381           ntop1 = BYTE_ON;
382           nbot1 = BYTE_ON;
383           ntop2 = BYTE_ON;
384           nbot2 = BYTE_ON;
385           ntop3 = BYTE_ON;
386           nbot3 = BYTE_ON;
387           ntop4 = BYTE_ON;
388           nbot4 = BYTE_ON;
389           call iox_$put_chars (iox_$user_io, line_out_ptr, num_left * 2, code);
390           call clean_up;
391 
392           return;
393      end;
394 
395 
396 /*^L*/
397 send:
398      proc;
399 
400 /* FUNCTION
401    This procedure will send the file to the PC. It will transfer the
402    entire file unless there is a transmission error. On any such error
403    the transmission is stopped. There is no provision for retransmitting
404    a packet or for error correction. */
405 
406 
407           continue = "y";
408           eof = FALSE;
409 
410 
411 /* : read a line from input file */
412 
413           call iox_$get_chars (in_ptr, line_in_ptr, PACKET_SIZE, num_read, code);
414           if code ^= 0 then do;
415                call clean_up;
416                call com_err_ (code, MY_NAME, "Error reading ^a.", arg);
417                return;
418           end;
419           if (num_read = 0) then
420                eof = TRUE;
421           ttl_read = ttl_read + num_read;
422 
423 
424 /* : transmit while there is more to do and no errors have occured */
425 
426           do while ((eof = FALSE) & (continue ^= "q"));
427 
428 
429 /* : initialize output line */
430 
431                ntop1 = ""b;
432                nbot1 = ""b;
433                ntop2 = ""b;
434                nbot2 = ""b;
435                ntop3 = ""b;
436                nbot3 = ""b;
437                ntop4 = ""b;
438                nbot4 = ""b;
439 
440 
441 /* : convert to ascii */
442 
443                ntop1 = ASCII_MASK || top1;
444                nbot1 = ASCII_MASK || bot1;
445                ntop2 = ASCII_MASK || top2;
446                nbot2 = ASCII_MASK || bot2;
447                ntop3 = ASCII_MASK || top3;
448                nbot3 = ASCII_MASK || bot3;
449                ntop4 = ASCII_MASK || top4;
450                nbot4 = ASCII_MASK || bot4;
451 
452 
453 /* : calculate check-sum for error checking */
454 
455                check_sum = 0;
456                temp = convert (check_sum, ntop1);
457                check_sum = check_sum + temp;
458                temp = convert (check_sum, nbot1);
459                check_sum = check_sum + temp;
460                temp = convert (check_sum, ntop2);
461                check_sum = check_sum + temp;
462                temp = convert (check_sum, nbot2);
463                check_sum = check_sum + temp;
464                temp = convert (check_sum, ntop3);
465                check_sum = check_sum + temp;
466                temp = convert (check_sum, nbot3);
467                check_sum = check_sum + temp;
468                temp = convert (check_sum, ntop4);
469                check_sum = check_sum + temp;
470                temp = convert (check_sum, nbot4);
471                check_sum = check_sum + temp;
472                check_sum = mod (check_sum, CHECK_SUM_MASK) + CHECK_SUM_MASK;
473                check_out = convert (check_out, check_sum);
474 
475 
476 /* : transfer chars to PC */
477 
478                call iox_$put_chars (iox_$user_io, line_out_ptr, num_read * 2,
479                     code);
480                if code ^= 0 then do;
481                     call clean_up;
482                     call com_err_ (code, MY_NAME, "Error in transfer of ^a.", arg);
483                     return;
484                end;
485                if (num_read < PACKET_SIZE) then do;
486                     num_left = PACKET_SIZE - num_read;
487                     call end_of_send;
488                     return;
489                end;
490 
491 
492 /* : wait for acknowledgment before continuing */
493 
494                call wait;
495                if (continue = "q") then do;
496                     call clean_up;
497                     call ioa_$ioa_switch (iox_$error_output,
498                          "load_mowse: Error in transfer of ^a.", arg);
499                     return;
500                end;
501 
502 
503 /* : send check_sum to PC */
504 
505                call iox_$put_chars (iox_$user_io, check_out_ptr, 1, code);
506                if code ^= 0 then do;
507                     call clean_up;
508                     call com_err_ (code, MY_NAME, "Transfer error in checksum.");
509                     return;
510                end;
511                call wait;
512                if (continue = "q") then do;
513                     call clean_up;
514                     call ioa_$ioa_switch (iox_$error_output, MY_NAME,
515                          "Received checksum error in ^a.", arg);
516                     return;
517                end;
518 
519 
520 /* : read a line from input file */
521 
522                num_read = 0;
523                call iox_$get_chars (in_ptr, line_in_ptr, PACKET_SIZE, num_read, code);
524                ttl_read = ttl_read + num_read;
525                if (num_read = 0) then do;
526                     num_left = PACKET_SIZE;
527                     call end_of_send;
528                     return;
529                end;
530           end;
531      end;
532 
533 %page;
534 
535 /* INCLUDE FILES */
536 
537      end;