1 /* BEGIN INCLUDE FILE gtss_hstar.incl.pl1 */
  2 /*
  3   Created: (Kepner Multics)  10/12/78 1500.3 mst Thu
  4 */
  5 /* This include file contains data structures, variables,
  6 and routines used in common between gtss_drl_drlsav_ and
  7 gtss_drl_restor_ for reading and writing H* files. */
  8 dcl 1 catalog_block aligned based (buffer_ptr),
  9     2 blk_num fixed bin (17) unal,
 10     2 continue_catalog bit (18) unal,
 11     2 fill2 bit (36),
 12     2 cat (15),
 13       3 bcd_name bit (36),
 14       3 element_size bit (18) unal,                         /* Size in 64 word blocks */
 15       3 initial_block bit (18) unal,
 16       3 fill3 bit (72),
 17     2 fill4 bit (36),
 18     2 checksum bit (36);
 19 
 20 dcl 1 available_space_block aligned based (buffer_ptr),
 21     2 fill1 bit (36),
 22     2 blocks_used bit (18) unal,
 23     2 blocks_remaining bit (18)unal,
 24     2 fill2 (61) bit (36),
 25     2 checksum bit (36);
 26 
 27 dcl 1 data_control_block aligned based (buffer_ptr),
 28     2 data_checksum bit (36),
 29     2 fill1 bit (36),
 30     2 control_block_checksum bit (36),
 31     2 bcd_name bit (36),
 32     2 entry_address bit (18) unal,
 33     2 load_origin bit (18) unal,
 34     2 fill2 bit (18) unal,
 35     2 number_of_data_blocks bit (18) unal,
 36     2 dcws (58),
 37       3 memory_loc bit (18)unal,
 38       3 zeros_3 bit (03)unal,
 39       3 action_code bit (03)unal,
 40       3 word_count bit (12) unal;
 41 
 42 dcl  buffer_ptr ptr init(null());
 43 dcl  element_name bit (36);
 44 dcl  file_size_in_blocks fixed bin (18);
 45 dcl  i fixed bin (24);
 46 dcl  max_for_18_bits fixed bin (18) static int options (constant) init (256*1024-1);
 47 dcl  memory_loc fixed bin (18);
 48 dcl  temp fixed bin (24);
 49 dcl  words_in_element fixed bin (18);
 50 dcl  words_remaining fixed bin (18);
 51 ^L
 52 write_data: proc (sector,memory_location);
 53 dcl  memory_location fixed bin(18) parm;
 54 dcl  sector fixed bin (18) parm;
 55                OP2.Device_Command = write_cmd;
 56 go to data_dcws;
 57 
 58 read_data: entry(sector,memory_location);
 59                OP2.Device_Command = read_cmd;
 60 
 61 
 62 data_dcws:;
 63                memory_loc = memory_location;
 64                words_remaining = words_in_element;
 65                do i = 1 to hbound (DCW, 1);
 66                     if words_remaining < 4097 then go to last_dcw;
 67                     DCW (i).memory_loc = bit (memory_loc, 18);
 68                     DCW (i).action_code = "001"b;           /* IOTP */
 69                     DCW (i).word_count = "0000"b3;          /* 10000 octal = 4096 words indicated by all zeros in dcw count */
 70                     memory_loc = memory_loc + 4096;
 71                     words_remaining = words_remaining - 4096;
 72                end;
 73 
 74 last_dcw:      ;
 75                DCW (i).memory_loc = bit (memory_loc, 18);
 76                DCW (i).action_code = "000"b;                /* IOTD */
 77                DCW (i).word_count = bit (fixed (words_remaining, 12), 12);
 78                go to common;
 79 
 80 write_buffer:  entry (sector,memory_location);
 81                OP2.Device_Command = write_cmd;
 82                go to buffer_dcw;
 83 
 84 read_buffer:   entry (sector,memory_location);
 85                OP2.Device_Command = read_cmd;
 86 
 87 buffer_dcw:    ;
 88                DCW (1).memory_loc = bit(memory_location,18);
 89                DCW (1).action_code = "000"b;                /* IOTD */
 90                DCW (1).word_count = "0100"b3;               /* 100 octal = 64 = block_size */
 91 
 92 common:        ;
 93                Seek_Address = sector;
 94                call gtss_ios_io_ (
 95                     fn,
 96                     addr (select_sequence),
 97                     gseg,
 98                     fixed (gtss_ust.lsize.limit, 18),
 99                     status,
100                     code);
101                if status ^= 0 then do;
102                     call gtss_abort_subsystem_(
103                          mcp,
104                          me,
105                          4, /* Bad derail argument */
106                          "At (^6o) Unable to write program to file ""^a"". gtss_ios_ status = ^i",
107                          fixed (scu.ilc, 18),
108                          to_from,
109                          ascii_file_name);
110                     go to ret;
111                end;
112           end write_data;
113 /*   END INCLUDE FILE gtss_hstar.incl.pl1 */