COMPILATION LISTING OF SEGMENT tape_ansi_file_cntl_ Compiled by: Multics PL/I Compiler, Release 29, of July 28, 1986 Compiled at: Honeywell Multics Op. - System M Compiled on: 12/17/86 0850.5 mst Wed Options: optimize map 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 12 13 /* * * * * * * * * * * * * * * * * * * * * * * */ 14 /* */ 15 /* tape_ansi_file_cntl_ */ 16 /* */ 17 /* Main logic module of tape_ansi_. See individual entries */ 18 /* for details of use and calling sequence. */ 19 /* */ 20 /* 0) Created: 10/04/74 by Ross E. Klinger */ 21 /* 1) Modified: 11/04/76 by Janice B. Phillipps */ 22 /* 2) Modified: 04/11/79 by C. D. Tavares for authentication and */ 23 /* resource management */ 24 /* 3) Modified: 9/79 by R.J.C. Kissel for new tseg */ 25 /* 4) Modified: 4/82 by J. A. Bush for block sizes > 8192 bytes */ 26 /* and to remove tape_ibm_ HDR2 density check */ 27 /* */ 28 /* * * * * * * * * * * * * * * * * * * * * * * */ 29 30 31 /* format: style3,ind3,dclind6,idind32 */ 32 tape_ansi_file_cntl_: 33 procedure; /* This entry not used */ 34 35 /* arguments */ 36 dcl iocbP ptr, /* pointer to iocb */ 37 open_mode fixed bin, /* opening mode */ 38 extend_bit bit (1) aligned, /* extend at open time */ 39 code fixed bin (35); /* error code */ 40 1 1 /* BEGIN INCLUDE FILE ..... iocb.incl.pl1 ..... 13 Feb 1975, M. Asherman */ 1 2 /* Modified 11/29/82 by S. Krupp to add new entries and to change 1 3* version number to IOX2. */ 1 4 /* format: style2 */ 1 5 1 6 dcl 1 iocb aligned based, /* I/O control block. */ 1 7 2 version character (4) aligned, /* IOX2 */ 1 8 2 name char (32), /* I/O name of this block. */ 1 9 2 actual_iocb_ptr ptr, /* IOCB ultimately SYNed to. */ 1 10 2 attach_descrip_ptr ptr, /* Ptr to printable attach description. */ 1 11 2 attach_data_ptr ptr, /* Ptr to attach data structure. */ 1 12 2 open_descrip_ptr ptr, /* Ptr to printable open description. */ 1 13 2 open_data_ptr ptr, /* Ptr to open data structure (old SDB). */ 1 14 2 reserved bit (72), /* Reserved for future use. */ 1 15 2 detach_iocb entry (ptr, fixed (35)),/* detach_iocb(p,s) */ 1 16 2 open entry (ptr, fixed, bit (1) aligned, fixed (35)), 1 17 /* open(p,mode,not_used,s) */ 1 18 2 close entry (ptr, fixed (35)),/* close(p,s) */ 1 19 2 get_line entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 1 20 /* get_line(p,bufptr,buflen,actlen,s) */ 1 21 2 get_chars entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 1 22 /* get_chars(p,bufptr,buflen,actlen,s) */ 1 23 2 put_chars entry (ptr, ptr, fixed (21), fixed (35)), 1 24 /* put_chars(p,bufptr,buflen,s) */ 1 25 2 modes entry (ptr, char (*), char (*), fixed (35)), 1 26 /* modes(p,newmode,oldmode,s) */ 1 27 2 position entry (ptr, fixed, fixed (21), fixed (35)), 1 28 /* position(p,u1,u2,s) */ 1 29 2 control entry (ptr, char (*), ptr, fixed (35)), 1 30 /* control(p,order,infptr,s) */ 1 31 2 read_record entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 1 32 /* read_record(p,bufptr,buflen,actlen,s) */ 1 33 2 write_record entry (ptr, ptr, fixed (21), fixed (35)), 1 34 /* write_record(p,bufptr,buflen,s) */ 1 35 2 rewrite_record entry (ptr, ptr, fixed (21), fixed (35)), 1 36 /* rewrite_record(p,bufptr,buflen,s) */ 1 37 2 delete_record entry (ptr, fixed (35)),/* delete_record(p,s) */ 1 38 2 seek_key entry (ptr, char (256) varying, fixed (21), fixed (35)), 1 39 /* seek_key(p,key,len,s) */ 1 40 2 read_key entry (ptr, char (256) varying, fixed (21), fixed (35)), 1 41 /* read_key(p,key,len,s) */ 1 42 2 read_length entry (ptr, fixed (21), fixed (35)), 1 43 /* read_length(p,len,s) */ 1 44 2 open_file entry (ptr, fixed bin, char (*), bit (1) aligned, fixed bin (35)), 1 45 /* open_file(p,mode,desc,not_used,s) */ 1 46 2 close_file entry (ptr, char (*), fixed bin (35)), 1 47 /* close_file(p,desc,s) */ 1 48 2 detach entry (ptr, char (*), fixed bin (35)); 1 49 /* detach(p,desc,s) */ 1 50 1 51 declare iox_$iocb_version_sentinel 1 52 character (4) aligned external static; 1 53 1 54 /* END INCLUDE FILE ..... iocb.incl.pl1 ..... */ 41 42 2 1 /* BEGIN INCLUDE FILE: tape_ansi_cseg.incl.pl1 */ 2 2 /* */ 2 3 /* 1) Modified: 12/01/75 by Ross E. Klinger -- to allow */ 2 4 /* for allocation of the attach and open descriptions */ 2 5 /* within the cseg structure. */ 2 6 /* 2) Modified for resource management. */ 2 7 /* 3) Modified 9/79 by R.J.C. Kissel to handle the new tseg. */ 2 8 /* 4) Modified 4/82 by J.A. Bush for block sizes > 8192 bytes */ 2 9 2 10 /* format: style4,delnl,insnl,indattr,ifthen,dclind9 */ 2 11 dcl cP ptr; /* pointer on which cseg structure is based */ 2 12 dcl cseg_tseg_version_2 fixed bin internal static options (constant) init (2); 2 13 2 14 dcl 1 cseg based (cP), /* control structure */ 2 15 2 file_set_lock bit (1) aligned, /* "1"b if file set in use */ 2 16 2 invalid bit (1) aligned, /* invalid cseg - delete at detach time bit */ 2 17 2 standard fixed bin, /* label standard */ 2 18 /* 1 - ANSI standard */ 2 19 /* 2 - IBM/OS-VS */ 2 20 /* 3 - IBM/DOS-VM */ 2 21 2 attach_description, /* iox_ attach description */ 2 22 3 length fixed bin (17), /* actual length of string */ 2 23 3 string char (256), /* maximum is 256 characters */ 2 24 2 open_description, /* iox_ open description */ 2 25 3 length fixed bin (17), /* actual length of string */ 2 26 3 string char (32), /* maximum is 32 */ 2 27 2 module char (12) varying, /* IO module name */ 2 28 2 ndrives fixed bin, /* maximum number of drives to be used */ 2 29 2 nactive fixed bin, /* number of drives actually in use */ 2 30 2 write_ring bit (1) aligned, /* volumes mounted with write rings */ 2 31 2 protect bit (1) aligned, /* volumes have rings, but are hardware protected */ 2 32 2 density fixed bin, /* file set recording density */ 2 33 /* 2 - 800 bpi NRZI */ 2 34 /* 3 - 1600 bpi PE */ 2 35 2 vcN fixed bin, /* number of links in volume chain */ 2 36 2 fcP ptr, /* file chain pointer */ 2 37 2 flP ptr, /* pointer to file link of current file */ 2 38 2 hdw_status, /* hardware status structure */ 2 39 3 bits bit (72) aligned, /* IOM status */ 2 40 3 no_minor fixed bin, /* number of minor status codes */ 2 41 3 major fixed bin (35), /* major status */ 2 42 3 minor (10) fixed bin (35), /* minor status */ 2 43 2 lbl_buf char (80), /* label I/O buffer */ 2 44 2 open_mode fixed bin, /* opening mode */ 2 45 /* 4 - sequential_input */ 2 46 /* 5 - sequential_output */ 2 47 2 close_rewind bit (1) aligned, /* rewind volume at next close */ 2 48 2 force bit (1) aligned, /* force file overwrite switch */ 2 49 2 user_labels bit (1) aligned, /* process user labels switch */ 2 50 2 no_labels bit (1) aligned, /* "1"b if volume has no labels */ 2 51 2 output_mode fixed bin, /* 0 - input */ 2 52 /* 1 - extend */ 2 53 /* 2 - modify */ 2 54 /* 3 - write */ 2 55 /* 4 - create */ 2 56 2 replace_id char (17), /* replace file identifier */ 2 57 2 retain fixed bin, /* 0 - default to rcp_ defaults */ 2 58 /* 1 - unassign drives and volumes */ 2 59 /* 2 - retain drives, unassign volumes */ 2 60 /* 3 - unassign drives, retain volumes */ 2 61 /* 4 - retain drives and volumes */ 2 62 2 lrec, /* logical record IO control data */ 2 63 3 bufP ptr, /* pointer to current processing buffer */ 2 64 3 nc_buf fixed bin, /* number of characters in buffer */ 2 65 3 offset fixed bin, /* current processing offset within buffer */ 2 66 3 saveP ptr, /* pointer to current D/V format RCW/RDW */ 2 67 3 file_lock bit (1) aligned, /* "1"b if file in use */ 2 68 3 blkcnt fixed bin (35), /* physical block count */ 2 69 3 reccnt fixed bin (35), /* logical record count (not presently used) */ 2 70 3 code fixed bin (35), /* lrec_io_ non-restartable error code */ 2 71 2 read_length, /* read_length control data */ 2 72 3 rlP ptr, /* pointer to read_length segment */ 2 73 3 rlN fixed bin (21), /* number of characters in segment */ 2 74 2 user_label_routine (6) variable entry (char (80), bit (1)), 2 75 /* 1 - read UHL */ 2 76 /* 2 - write UHL */ 2 77 /* 3 - read UTL */ 2 78 /* 4 - write UTL */ 2 79 /* 5 - read UVL */ 2 80 /* 6 - write UVL */ 2 81 /* THE FOLLOWING IS NEEDED ONLY WHILE TAPEIO_ / TDCM IS THE IO PROCEDURE */ 2 82 2 syncP ptr, /* pointer to synchronous IO buffer */ 2 83 2 mode fixed bin, /* 0 = binary -- 1 = 9 mode */ 2 84 2 soft_status, /* software status structure */ 2 85 3 nbuf fixed bin, /* number of suspended buffers */ 2 86 3 buf (2), 2 87 4 bufP ptr, /* pointer to buffer */ 2 88 4 count fixed bin, /* buffer character count */ 2 89 2 ( 2 90 free_list, 2 91 busy_list, 2 92 chain (3), 2 93 bufct (3) 2 94 ) fixed bin, /* buffer management variables */ 2 95 2 wait_switch (1:63) bit (1) unaligned, /* per-drive event wait switches */ 2 96 2 buf_size fixed bin, /* size of each tseg buffer in chars (bytes) */ 2 97 2 tseg aligned, 2 98 3 version_num fixed bin, 2 99 3 areap ptr, /* pointer to DSM area */ 2 100 3 ev_chan fixed bin (71), /* event channel number */ 2 101 3 write_sw fixed bin (1), /* 0 = read, 1 = write */ 2 102 3 sync fixed bin (1), /* non-zero for synchronous i/o */ 2 103 3 get_size fixed bin (1), /* ON for record sizes to be returned */ 2 104 3 ws_segno bit (18), /* rcp_ kluge */ 2 105 3 drive_name char (32), 2 106 3 tracks fixed bin, 2 107 3 density bit (36), 2 108 3 speed bit (36), /* bits are 75, 125, 200 ips respectively */ 2 109 3 pad99 bit (36), /* see tseg.incl.pl1 */ 2 110 3 buffer_offset fixed bin (12), /* offset of first buffer to be processed */ 2 111 3 buffer_count fixed bin (12), /* number of buffers to be processed */ 2 112 3 completion_status 2 113 fixed bin (2), /* 0 = no pending i/o or no status */ 2 114 /* 1 = normal termination of i/o */ 2 115 /* 2 = non-zero major status from previous i/o */ 2 116 3 hardware_status bit (36) aligned, /* major and sub-status */ 2 117 3 error_buffer fixed bin (12), /* buffer in which i/o error occurred */ 2 118 3 command_count fixed bin (12), /* number of non-data commands to execute */ 2 119 3 command_queue (10) fixed bin (6) aligned, /* non-data-transfer commands */ 2 120 3 bufferptr (12) fixed bin (18) aligned,/* relative ptrs to buffers */ 2 121 3 buffer_size (12) fixed bin (18) aligned,/* size of buffer */ 2 122 3 mode (12) fixed bin (2) aligned, /* 0 = bin, 1 = bcd, 2 = 9 track */ 2 123 3 buffer (4) char (cseg.buf_size) aligned, 2 124 /* data buffers */ 2 125 /* END OF TAPEIO_ / TDCM DATA */ 2 126 2 vl (63), /* volume chain link */ 2 127 3 position, /* volume position */ 2 128 4 fflX fixed bin unal, /* index of first file link on volume */ 2 129 4 cflX fixed bin unal, /* index of current file link */ 2 130 4 pos fixed bin unal, /* intra-file position code */ 2 131 /* 0 = in HDR group */ 2 132 /* 1 - in data / passed HDR TM */ 2 133 /* 2 = in EOx group / passed data TM */ 2 134 4 lflX fixed bin unal, /* index of last file link on volume */ 2 135 3 vol_data, 2 136 4 volname char (32), /* volume name */ 2 137 4 canonical_volname 2 138 char (6), /* volume name as appears on label */ 2 139 4 comment char (64) varying, /* mount comment */ 2 140 4 auth_code char (3) aligned, /* authentication code for this volume */ 2 141 4 rcp_id fixed bin (6), /* TDCM DUMMY - CHANGE TO BIT (36) ALIGNED */ 2 142 4 event_chan fixed bin (71), /* rcp_ attach event channel */ 2 143 4 tape_drive char (32), /* name of tape drive */ 2 144 4 ws_segno bit (18), /* segno of IOI workspace (per drive) */ 2 145 4 write_VOL1 fixed bin, /* 0 - correct VOL1 label */ 2 146 /* 1 - blank tape */ 2 147 /* 2 - can't read 1st block */ 2 148 /* 3 - 1st block not VOL1 label */ 2 149 /* 4 - valid VOL1 label but wrong volume ID (Obsolete) */ 2 150 /* 5 - correct VOL1 label, but wrong density */ 2 151 /* 6 - invalid file-set format (Obsolete) */ 2 152 /* -1 - correct VOL1 label of an earlier format */ 2 153 /* (no authentication code) */ 2 154 4 ioi_index fixed bin, /* ioi_ index for IO */ 2 155 3 reg_data, /* registration data */ 2 156 4 tracks fixed bin unal, /* number of tracks */ 2 157 4 density fixed bin unal, /* density code */ 2 158 4 label_type fixed bin unal, /* volume format */ 2 159 4 usage_count fixed bin unal, /* number of attachment to this volume */ 2 160 4 read_errors fixed bin unal, /* number of read errors */ 2 161 4 write_errors fixed bin unal, /* number of write errors */ 2 162 2 chain_area area; /* file chain allocation area */ 2 163 2 164 /* END INCLUDE FILE: tape_ansi_cseg.incl.pl1 */ 43 44 3 1 /* BEGIN INCLUDE FILE: tape_ansi_fd.incl.pl1 */ 3 2 3 3 dcl 1 fd aligned based (cseg.fcP), /* first file chain link */ 3 4 2 backP ptr init (null), /* no previous links (ever) */ 3 5 2 nextP ptr init (null), /* pointer to next link; null if only */ 3 6 2 flX fixed bin init (0), /* link index is 0 */ 3 7 2 vlX fixed bin init (0), /* start file chain on 1st volume */ 3 8 /* in conjunction with eov, below, which */ 3 9 2 dummy_HDR2 bit (1), /* "1"b if file has dummy_HDR2 label */ 3 10 2 eox fixed bin init (2), /* 2 forces volume switch on first real file link */ 3 11 3 12 2 hdr1, /* HDR1 data */ 3 13 3 file_id char (17), /* file identifier */ 3 14 3 set_id char (32), /* reel id of 1st volume of multi-volume set */ 3 15 3 canonical_set_id char (6), /* in canonical format */ 3 16 3 dummy_section fixed bin, 3 17 3 sequence fixed bin, /* file sequence number (inter-file) */ 3 18 3 dummy_generation fixed bin, 3 19 3 dummy_version fixed bin, 3 20 3 creation char (5), /* holds today's date in Julian form */ 3 21 3 expiration char (5), /* Julian expiration date */ 3 22 3 access char (1), 3 23 3 dummy_blkcnt fixed bin (35), 3 24 3 system char (13), /* holds system code for labels */ 3 25 3 26 2 hdr2, /* HDR2 data */ 3 27 3 format fixed bin, /* logical record format code */ 3 28 /* 1 - U format */ 3 29 /* 2 - F format */ 3 30 /* 3 - D format (ANSI) / V format (IBM) */ 3 31 /* 4 - S format (ANSI) / V spanned (IBM) */ 3 32 3 blklen fixed bin, /* actual/maximum physical block length */ 3 33 3 reclen fixed bin (21), /* actual/maximum logical record length */ 3 34 3 dummy_next_volname char (32), 3 35 3 canonical_dummy_next_volname char (6), 3 36 3 blocked bit (1), /* "0"b - unblocked / "1"b - blocked */ 3 37 3 mode fixed bin, /* file data recording mode */ 3 38 /* 1 - ASCII, 9 mode */ 3 39 /* 2 - EBCDIC, 9mode */ 3 40 /* 3 - binary */ 3 41 3 bo fixed bin, /* ANSI buffer offset: # of chars preceding each block */ 3 42 3 cc char (1); /* IBM HDR2 control characters code */ 3 43 3 44 /* END INCLUDE FILE: tape_ansi_fd.incl.pl1 */ 45 46 4 1 /* BEGIN INCLUDE FILE: tape_ansi_fl.incl.pl1 */ 4 2 4 3 dcl 1 fl aligned based (cseg.flP), /* file chain link */ 4 4 2 backP ptr init (null), /* pointer to previous link in chain, or null if 1st */ 4 5 2 nextP ptr init (null), /* pointer to next link in chain, or null if last */ 4 6 2 flX fixed bin init (0), /* index of this link within file chain */ 4 7 2 vlX fixed bin init (0), /* volume link index */ 4 8 4 9 2 HDR2 bit (1) init ("0"b), /* "1"b if file has HDR2 label */ 4 10 2 eox fixed bin init (0), /* 0 - trailer labels not yet processed */ 4 11 /* 1 - trailer labels are EOF */ 4 12 /* 2 - trailer labels are EOV */ 4 13 4 14 2 hdr1, /* HDR1 data */ 4 15 3 file_id char (17), /* file identifier */ 4 16 3 set_id char (32), /* reel id of 1st volume of multi-volume set */ 4 17 3 canonical_set_id char (6) unaligned, /* reel id in canonical format */ 4 18 3 section fixed bin, /* file section number (intra-file) */ 4 19 3 sequence fixed bin, /* file sequence number (inter-file) */ 4 20 3 generation fixed bin, /* file generation number */ 4 21 3 version fixed bin, /* generation version number */ 4 22 3 creation char (5), /* Julian creation date "yyddd" */ 4 23 3 expiration char (5), /* Julian expiration date */ 4 24 3 access char (1), /* file accessability code */ 4 25 3 blkcnt fixed bin (35), /* number of data blocks - in EOx1 */ 4 26 3 system char (13), /* system/IO module code */ 4 27 4 28 2 hdr2, /* HDR2 data */ 4 29 3 format fixed bin init (0), /* logical record format code */ 4 30 /* 1 - U format */ 4 31 /* 2 - F format */ 4 32 /* 3 - D format (ANSI) / V format (IBM) */ 4 33 /* 4 - S format (ANSI) / V spanned (IBM) */ 4 34 3 blklen fixed bin init (0), /* actual/maximum physical block length */ 4 35 3 reclen fixed bin (21) init (0), /* actual/maximum logical record length */ 4 36 3 next_volname char (32) init ("") unaligned, /* volume name of next volume */ 4 37 3 canonical_next_volname char (6) init ("") unal, /* in canonical format */ 4 38 3 blocked bit (1) init ("0"b), /* "0"b - unblocked / "1"b - blocked */ 4 39 3 mode fixed bin init (0), /* file data recording mode */ 4 40 /* 1 - ASCII, 9 mode */ 4 41 /* 2 - EBCDIC, 9mode */ 4 42 /* 3 - binary */ 4 43 3 bo fixed bin init (0), /* ANSI buffer offset: # of chars preceding each block */ 4 44 3 cc char (1) init (" "); /* IBM HDR2 control characters code */ 4 45 4 46 /* END INCLUDE FILE: tape_ansi_fl.incl.pl1 */ 47 48 5 1 /* BEGIN INCLUDE FILE: ansi_vol1.incl.pl1 */ 5 2 /* Modified by J. A. Bush 11/06/82 for use by mtape_ */ 5 3 /* format: style4 */ 5 4 5 5 dcl ansi_vol1P ptr; /* pointer on which ansi_vol1 is based */ 5 6 5 7 dcl 1 ansi_vol1 unaligned based (ansi_vol1P), /* ANSI VOL1 label */ 5 8 2 label_id char (4), /* "VOL1" */ 5 9 2 volume_id char (6), /* volume identifier */ 5 10 2 access char (1), /* " " if unlimited */ 5 11 2 reserved1 char (26), /* blanks */ 5 12 2 owner_id, /* Owner Identifier field (14 characters) */ 5 13 3 auth_code char (3), /* Multics stores authenication code here */ 5 14 3 mult_id char (7), /* inited with MULTICS_ANSI_VERSION */ 5 15 3 owner_id_pad char (4), /* blanks */ 5 16 2 reserved2 char (28), /* blanks */ 5 17 2 label_version char (1); /* label standard version */ 5 18 5 19 dcl ANSI_VOL1 char (4) int static options (constant) init ("VOL1"); 5 20 dcl LABEL_STANDARD_VERSION char (1) int static options (constant) /* Label standard supported */ 5 21 init ("3"); /* (currently to ANSI x3.27-1978) */ 5 22 dcl MULTICS_ANSI_VERSION char (7) int static options (constant) /* current mtape_/ANSI version */ 5 23 init ("MULT001"); /* goes in the owner_id2 field */ 5 24 5 25 /* END INCLUDE FILE: ansi_vol1.incl.pl1 */ 49 50 6 1 /* BEGIN INCLUDE FILE: ibm_vol1.incl.pl1 */ 6 2 /* Modified by J. A. Bush 11/06/82 for use by mtape_ */ 6 3 /* format: style4 */ 6 4 6 5 dcl ibm_vol1P ptr; /* pointer on which ibm_vol1 is based */ 6 6 6 7 dcl 1 ibm_vol1 unaligned based (ibm_vol1P), 6 8 2 label_id char (4), /* VOL1 */ 6 9 2 volume_serial char (6), /* volume serial number (can be alphameric) */ 6 10 2 reserved1 char (1), /* "0" */ 6 11 2 VTOC_pointer char (10), /* " " */ 6 12 2 reserved2 char (20), /* " " */ 6 13 2 owner_id, /* Owner identifier field (10 characters) */ 6 14 3 auth_code char (3), /* Multics stores authentication code here */ 6 15 3 mult_id char (7), /* Inited with MULTICS_IBM_VERSION */ 6 16 2 reserved3 char (29); /* " " */ 6 17 6 18 dcl IBM_VOL1 char (4) int static options (constant) init ("VOL1"); 6 19 dcl MULTICS_IBM_VERSION char (7) int static options (constant) /* current mtape_/IBM version */ 6 20 init ("MULT001"); /* goes in the owner_id2 field */ 6 21 6 22 /* END INCLUDE FILE: ibm_vol1.incl.pl1 */ 51 52 7 1 /* BEGIN INCLUDE FILE: ansi_hdr1.incl.pl1 */ 7 2 /* Modified by J. A. Bush 11/07/82 for use by mtape_ */ 7 3 7 4 /* format: style4 */ 7 5 7 6 dcl ansi_hdr1P ptr; /* pointer on which ansi_hdr1 structure is based */ 7 7 7 8 dcl 1 ansi_hdr1 unaligned based (ansi_hdr1P), 7 9 2 label_id char (4), /* HDR1/EOF1/EOV1 */ 7 10 2 file_id char (17), /* file identifier */ 7 11 2 set_id char (6), /* file-set identifier */ 7 12 2 section char (4), /* file section number */ 7 13 2 sequence char (4), /* file sequence number (within file set) */ 7 14 2 generation char (4), /* file generation number */ 7 15 2 version char (2), /* generation version number */ 7 16 2 creation char (6), /* file creation date - Julian form (" yyddd") */ 7 17 2 expiration char (6), /* file expiration date - Julian form */ 7 18 2 access char (1), /* file accessibility code */ 7 19 2 blkcnt char (6), /* used by EOF1/EOV1, must be "000000" for HDR1 */ 7 20 2 system char (13), /* system code = "MULTICS ANSI2" for mtape_ */ 7 21 2 reserved char (7); /* must be spaces */ 7 22 7 23 7 24 dcl ANSI_L1_ID (3) char (4) int static options (constant) init 7 25 ("HDR1", "EOV1", "EOF1"); 7 26 dcl (ANSI_HDR1 init (1), 7 27 ANSI_EOV1 init (2), 7 28 ANSI_EOF1 init (3)) fixed bin int static options (constant); 7 29 dcl ANSI_SYS_CODE char (13) int static options (constant) init ("MULTICS ANSI2"); 7 30 7 31 /* END INCLUDE FILE: ansi_hdr1.incl.pl1 */ 53 54 8 1 /* BEGIN INCLUDE FILE: ansi_hdr2.incl.pl1 */ 8 2 /* Modified by J. A. Bush 11/07/82 for use by mtape_ */ 8 3 8 4 /* format: style4 */ 8 5 8 6 dcl ansi_hdr2P ptr; /* pointer on which ansi_hdr2 structure is based */ 8 7 8 8 dcl 1 ansi_hdr2 unaligned based (ansi_hdr2P), 8 9 2 label_id char (4), /* HDR2/EOF2/EOV2 */ 8 10 2 format char (1), /* U, F, D, or S */ 8 11 2 blklen char (5), /* maximum number of characters per block */ 8 12 2 reclen char (5), /* maximum or actual record length - meaning varies with format */ 8 13 2 system_use, /* 35 characters reserved for system-specific use */ 8 14 3 next_volname char (32), /* next volume name - for trailer label */ 8 15 3 blocked char (1), /* blocking attribute: 0 - no / 1 - yes */ 8 16 3 mode char (1), /* data encoding mode */ 8 17 /* 1 - ASCII, 9 mode */ 8 18 /* 2 - EBCDIC, 9 mode */ 8 19 /* 3 - binary */ 8 20 3 system_reserved char (1), /* reserved for future use */ 8 21 2 buffer_offset char (2), /* meaningful only if HDR1 system code ^= "" */ 8 22 2 reserved char (28); /* spaces */ 8 23 8 24 /* Old HDR2 system use field, pre-secure-authentication */ 8 25 8 26 dcl 1 old_ansi_hdr2_system_use based (addr (ansi_hdr2.system_use)), 8 27 2 canonical_next_volname char (6), /* next volume name - for trailer label */ 8 28 2 blocked char (1), /* blocking attribute: 0 - no / 1 - yes */ 8 29 2 mode char (1), /* data encoding mode (same as above) */ 8 30 2 system_reserved char (27); /* blanks */ 8 31 8 32 dcl ANSI_L2_ID (3) char (4) int static options (constant) init 8 33 ("HDR2", "EOV2", "EOF2"); 8 34 dcl (ANSI_HDR2 init (1), 8 35 ANSI_EOV2 init (2), 8 36 ANSI_EOF2 init (3)) fixed bin int static options (constant); 8 37 8 38 /* END INCLUDE FILE: ansi_hdr2.incl.pl1 */ 55 56 9 1 /* BEGIN INCLUDE FILE: ibm_hdr1.incl.pl1 */ 9 2 /* Modified by J. A. Bush 04/26/83 for use by mtape_ */ 9 3 9 4 /* format: style4 */ 9 5 9 6 dcl ibm_hdr1P ptr; /* pointer on which ibm_hdr1 is based */ 9 7 9 8 dcl 1 ibm_hdr1 unaligned based (ibm_hdr1P), 9 9 2 label_id char (4), /* HDR1/EOF1/EOV1 */ 9 10 2 dataset_id char (17), /* equivalent to ANSI file identifier */ 9 11 2 dataset_serial char (6), /* equivalent to ANSI file set identifier */ 9 12 2 volume_sequence char (4), /* volume sequence number - no ANSI equivalent */ 9 13 2 dataset_sequence char (4), /* equivalent to ANSI file sequence number */ 9 14 2 generation char (4), /* " " if not member of generation data set */ 9 15 2 version char (2), /* " " if not member of generation data set */ 9 16 2 creation char (6), /* " yyddd" - equivalent to ANSI creation date */ 9 17 2 expiration char (6), /* " yyddd" - equivalent to ANSI expiration date */ 9 18 2 security char (1), /* "0" on output :: ignored on input */ 9 19 2 blkcnt char (6), /* equivalent to ANSI block count */ 9 20 2 system char (13), /* system code = "MULTICS IBM2 " for mtape_ */ 9 21 2 reserved char (7); /* " " */ 9 22 9 23 dcl IBM_L1_ID (3) char (4) int static options (constant) init 9 24 ("HDR1", "EOV1", "EOF1"); 9 25 dcl (IBM_HDR1 init (1), 9 26 IBM_EOV1 init (2), 9 27 IBM_EOF1 init (3)) fixed bin int static options (constant); 9 28 dcl IBM_SYS_CODE char (13) int static options (constant) init ("MULTICS IBM2 "); 9 29 9 30 /* END INCLUDE FILE: ibm_hdr1.incl.pl1 */ 57 58 10 1 /* BEGIN INCLUDE FILE: ibm_hdr2.incl.pl1 */ 10 2 /* Modified by J. A. Bush 04/26/83 for use by mtape_ */ 10 3 10 4 /* format: style4 */ 10 5 10 6 dcl ibm_hdr2P ptr; /* pointer on which ibm_hdr2 is based */ 10 7 10 8 dcl 1 ibm_hdr2 unaligned based (ibm_hdr2P), 10 9 2 label_id char (4), /* HDR2/EOF2/EOV2 */ 10 10 2 format char (1), /* U/F/V */ 10 11 2 blksize char (5), /* equivalent to ANSI block length - 32760 maximum */ 10 12 2 lrecl char (5), /* equivalent to ANSI record length - 32760 maximum */ 10 13 /* for VS and VBS, 0 means lrecl > 32756 */ 10 14 2 density char (1), /* no ANSI equivalent */ 10 15 /* 2 = 800 bpi; 3 = 1600 cpi; 4 = 6250 cpi */ 10 16 2 dataset_position char (1), /* no ANSI equivalent */ 10 17 /* 0 = no volume switch has occurred */ 10 18 /* 1 = volume switch has occurred */ 10 19 2 jobstep_id char (17), /* no ANSI equivalent */ 10 20 2 recording_technique char (2), /* no ANSI equivalent - " " = 9 track */ 10 21 2 control_characters char (1), /* no ANSI equivalent */ 10 22 2 reserved1 char (1), /* " " */ 10 23 2 block_attribute char (1), /* no ANSI equivalent */ 10 24 /* "B" - records are blocked */ 10 25 /* "S" - records are spanned */ 10 26 /* "R" - records are blocked and spanned */ 10 27 /* " " - records are neither blocked nor spanned */ 10 28 2 reserved2 char (41); /* " " */ 10 29 10 30 dcl 1 ibm_system_use unaligned based (addr (ibm_hdr2.reserved2)), /* mtape IBM overlay */ 10 31 2 mode char (1), /* 1 - ASCII, 9 mode; 2 - EBCDIC, 9 mode; 3 - binary */ 10 32 2 next_volname char (6); /* Next volume id in EOV2 label */ 10 33 10 34 dcl IBM_L2_ID (3) char (4) int static options (constant) init 10 35 ("HDR2", "EOV2", "EOF2"); 10 36 dcl (IBM_HDR2 init (1), 10 37 IBM_EOV2 init (2), 10 38 IBM_EOF2 init (3)) fixed bin int static options (constant); 10 39 10 40 /* END INCLUDE FILE: ibm_hdr2.incl.pl1 */ 59 60 11 1 /* --------------- BEGIN include file rcp_volume_formats.incl.pl1 --------------- */ 11 2 11 3 11 4 11 5 /****^ HISTORY COMMENTS: 11 6* 1) change(86-12-08,GWMay), approve(86-12-08,PBF7552), 11 7* audit(86-12-08,Martinson), install(86-12-17,MR12.0-1250): 11 8* added array entry 0 to the volume format types to indicate that the tape 11 9* volume was not authenticated by rcp. 11 10* END HISTORY COMMENTS */ 11 11 11 12 11 13 /* General volume types */ 11 14 11 15 dcl (Volume_unauthenticated initial (0), 11 16 Volume_blank initial (1), 11 17 Volume_unknown_format initial (6), 11 18 Volume_unreadable initial (7), 11 19 11 20 /* Tape volume types */ 11 21 11 22 Volume_multics_tape initial (2), 11 23 Volume_gcos_tape initial (3), 11 24 Volume_ibm_tape initial (4), 11 25 Volume_ansi_tape initial (5)) fixed bin static options (constant); 11 26 11 27 /* Printable descriptions of volume types */ 11 28 11 29 dcl Tape_volume_types (0:7) char (16) static options (constant) initial 11 30 ("unauthenticated", 11 31 "blank", 11 32 "Multics", 11 33 "GCOS", 11 34 "IBM", 11 35 "ANSI", 11 36 "unrecognizable", 11 37 "unreadable"); 11 38 11 39 /* ---------------- END include file rcp_volume_formats.incl.pl1 ---------------- */ 61 62 12 1 /* Begin include file ... rcp_resource_types.incl.pl1 12 2* * 12 3* * Created 3/79 by Michael R. Jordan for MR7.0R 12 4* * 12 5* * This include file defines the official RCP resource types. 12 6* * The array of names is indexed by the corresponding device type. 12 7* * MOD by RAF for MCA 12 8**/ 12 9 12 10 12 11 12 12 /****^ HISTORY COMMENTS: 12 13* 1) change(85-09-09,Fawcett), approve(85-09-09,MCR6979), 12 14* audit(85-12-09,CLJones), install(86-03-21,MR12.0-1033): 12 15* Support of MCA. 12 16* END HISTORY COMMENTS */ 12 17 12 18 dcl DEVICE_TYPE (8) char (32) 12 19 internal static options (constant) 12 20 init ("tape_drive", "disk_drive", "console", "printer", "punch", "reader", "special", "mca"); 12 21 12 22 dcl NUM_QUALIFIERS (8) fixed bin /* Number of qualifiers for each device type. */ 12 23 internal static init (3, 0, 0, 2, 0, 0, 0, 0); 12 24 12 25 dcl VOLUME_TYPE (8) char (32) 12 26 internal static options (constant) 12 27 init ("tape_vol", "disk_vol", "", "", "", "", "", ""); 12 28 12 29 dcl TAPE_DRIVE_DTYPEX fixed bin static internal options (constant) init (1); 12 30 dcl DISK_DRIVE_DTYPEX fixed bin static internal options (constant) init (2); 12 31 dcl CONSOLE_DTYPEX fixed bin static internal options (constant) init (3); 12 32 dcl PRINTER_DTYPEX fixed bin static internal options (constant) init (4); 12 33 dcl PUNCH_DTYPEX fixed bin static internal options (constant) init (5); 12 34 dcl READER_DTYPEX fixed bin static internal options (constant) init (6); 12 35 dcl SPECIAL_DTYPEX fixed bin static internal options (constant) init (7); 12 36 dcl MCA_DTYPEX fixed bin static internal options (constant) init (8); 12 37 dcl TAPE_VOL_VTYPEX fixed bin static internal options (constant) init (1); 12 38 dcl DISK_VOL_VTYPEX fixed bin static internal options (constant) init (2); 12 39 12 40 12 41 /* End include file ... rcp_resource_types.incl.pl1 */ 63 64 65 66 /* automatic storage */ 67 dcl answer char (128) varying, 68 cc fixed bin, /* consistency code */ 69 /* 0 - invalidate volume position */ 70 /* 1 - invalidate volume position and current file link */ 71 /* 2 - invalidate position, current file link, write EOV TM */ 72 com_text char (64) varying, 73 (eofs, close_eot, format_override, new_link) 74 bit (1), 75 mask bit (36) aligned, 76 testP ptr, 77 search_id char (17), /* search file chain/tape for this file id */ 78 t fixed bin, 79 t1 picture "9", 80 t2 picture "99", 81 t4 picture "9999", 82 t5 picture "99999", 83 t6 picture "999999", 84 tstring char (32) varying, /* open description temporary */ 85 vn char (32); /* volume name */ 86 87 dcl 1 qi aligned, /* query info structure */ 88 2 version fixed bin init (2), 89 2 yes_no bit (1) unaligned, 90 2 suppress_name bit (1) unaligned, 91 2 scode fixed bin (35), 92 2 qcode fixed bin (35) init (0); 93 94 /* internal static */ 95 dcl ansi_format_chars char (4) internal static init ("UFDS"), 96 ibm_format_chars char (4) internal static init ("UFVV"), 97 ibm_block_codes char (4) internal static init (" BSR"), 98 l1id (3) char (4) internal static init ("HDR1", "EOF1", "EOV1"), 99 l2id (3) char (4) internal static init ("HDR2", "EOF2", "EOV2"), 100 tag (4) char (12) varying internal static 101 init (" -extend", " -modify", " -generate", " -create"); 102 103 dcl dummy_label (2) char (76) internal static 104 init ( 105 "0000000000000000000000000000000000000000000000000000000000000000000000000000", 106 /* IBM dummy HDR1 label */ 107 "!!DUMMY FILE ID!!******00010001000100 00000 00000 000000MULTICS ANSI "); 108 /* ANSI dummy HDR1/EOF1 label */ 109 110 dcl max_reclen (3) fixed bin internal static init (99999, 32756, 32763); 111 /* ANSI - OS/VS - DOS/VM */ 112 113 dcl UL (2) char (3) internal static init ("UHL", "UTL"); 114 /* user label id's */ 115 116 dcl debug bit (1) internal static initial ("0"b); 117 /* debug switch */ 118 119 /* based storage */ 120 dcl label_type char (3) based (addr (cseg.lbl_buf)); 121 122 dcl sync_buf char (80) based (cseg.syncP); 123 /* 80 character overlay on synchronous IO buffer */ 124 125 126 /* conditions */ 127 dcl (any_other, area, cleanup, conversion) 128 condition; 129 130 /* builtin functions */ 131 dcl (addr, bit, char, fixed, index, length, ltrim, max, mod, null, prec, substr, verify) 132 builtin; 133 134 /* external procedures */ 135 dcl tape_ansi_lrec_io_$close ext entry (ptr, fixed bin (35)), 136 tape_ansi_lrec_io_$read_record ext entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35)), 137 tape_ansi_lrec_io_$write_record ext entry (ptr, ptr, fixed bin (21), fixed bin (35)), 138 ascii_to_ebcdic_ ext entry (char (*), char (*)), 139 command_query_ ext entry options (variable), 140 continue_to_signal_ ext entry (fixed bin (35)), 141 tape_ansi_control_ ext entry (ptr, char (*), ptr, fixed bin (35)), 142 tape_ansi_detach_ ext entry (ptr, fixed bin (35)), 143 ebcdic_to_ascii_ ext entry (char (*), char (*)), 144 tape_ansi_file_cntl_$close ext entry (ptr, fixed bin (35)), 145 tape_ansi_file_cntl_$open ext entry (ptr, fixed bin, bit (1) aligned, fixed bin (35)), 146 hcs_$reset_ips_mask ext entry (bit (36) aligned, bit (36) aligned), 147 hcs_$set_ips_mask ext entry (bit (36) aligned, bit (36) aligned), 148 tape_ansi_ibm_lrec_io_$close ext entry (ptr, fixed bin (35)), 149 tape_ansi_ibm_lrec_io_$read_record 150 ext entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35)), 151 tape_ansi_ibm_lrec_io_$write_record 152 ext entry (ptr, ptr, fixed bin (21), fixed bin (35)), 153 ioa_ ext entry options (variable), 154 iox_$propagate ext entry (ptr), 155 tape_ansi_mount_cntl_$mount ext entry (ptr, fixed bin, fixed bin (35)), 156 tape_ansi_mount_cntl_$remount ext entry (ptr, fixed bin, fixed bin, fixed bin (35)), 157 tape_ansi_position_ ext entry (ptr, fixed bin, fixed bin (21), fixed bin (35)), 158 tape_ansi_read_length_ ext entry (ptr, fixed bin (21), fixed bin (35)), 159 tape_ansi_tape_io_$get_buffer ext entry (ptr, ptr, fixed bin (35)), 160 tape_ansi_tape_io_$open ext entry (ptr), 161 tape_ansi_tape_io_$order ext entry (ptr, char (3), fixed bin, fixed bin (35)), 162 tape_ansi_tape_io_$sync_read ext entry (ptr, fixed bin, fixed bin (35)), 163 tape_ansi_tape_io_$sync_write ext entry (ptr, fixed bin, fixed bin (35)), 164 terminate_process_ ext entry (char (*), ptr), 165 canon_for_volume_label_ ext entry (char (*), char (*), char (*), fixed bin, fixed bin (35)), 166 authenticate_ ext entry (char (*)) returns (char (3) aligned); 167 168 169 /* external static */ 170 dcl ( 171 error_table_$device_limit_exceeded, 172 error_table_$discrepant_block_count, 173 error_table_$duplicate_file_id, 174 error_table_$eof_record, 175 error_table_$end_of_info, 176 error_table_$eov_on_write, 177 error_table_$file_aborted, 178 error_table_$file_busy, 179 error_table_$incompatible_attach, 180 error_table_$incompatible_encoding_mode, 181 error_table_$incompatible_file_attribute, 182 error_table_$insufficient_open, 183 error_table_$invalid_block_length, 184 error_table_$invalid_cseg, 185 error_table_$invalid_expiration, 186 error_table_$invalid_file_set_format, 187 error_table_$invalid_label_format, 188 error_table_$invalid_record_length, 189 error_table_$invalid_volume_sequence, 190 error_table_$noalloc, 191 error_table_$no_file, 192 error_table_$no_next_volume, 193 error_table_$positioned_on_bot, 194 error_table_$unable_to_do_io, 195 error_table_$unexpired_file, 196 error_table_$unexpired_volume, 197 error_table_$uninitialized_volume 198 ) fixed bin (35) ext static; 199 200 dcl sys_info$max_seg_size fixed bin (35) external static; 201 202 open: 203 entry (iocbP, open_mode, extend_bit, code); 204 205 cP = iocbP -> iocb.actual_iocb_ptr -> iocb.attach_data_ptr; 206 /* get pointer to control segment */ 207 208 if cseg.invalid 209 then 210 do; /* is control segment invalid? */ 211 code = error_table_$invalid_cseg; 212 return; 213 end; 214 215 if cseg.file_lock 216 then 217 do; /* is file in use (by previous invocation)? */ 218 code = error_table_$file_busy; 219 return; 220 end; 221 else 222 do; 223 cc = 0; /* minimal consistency requirement */ 224 on cleanup 225 begin; /* insure file chain <--> tape consistency */ 226 call consistent; 227 cseg.file_lock = "0"b; /* unlock the file */ 228 end; 229 cseg.file_lock = "1"b; /* not in use - now it is */ 230 end; 231 232 if extend_bit 233 then 234 do; /* extend at open time not allowed */ 235 bad_open: 236 code = error_table_$incompatible_attach; 237 go to valid_exit; 238 end; 239 240 if open_mode = 4 241 then 242 do; /* sequential input */ 243 tstring = "sequential_input"; /* set for open description */ 244 search_id = fd.file_id; /* set search identifier */ 245 end; 246 247 else 248 do; /* sequential output */ 249 if cseg.output_mode = 0 250 then go to bad_open; /* no output mode specified */ 251 if open_mode = 5 252 then tstring = "sequential_output"; 253 else go to bad_open; 254 tstring = tstring || tag (output_mode); /* append output mode keyword */ 255 if cseg.replace_id ^= "" 256 then search_id = cseg.replace_id; /* search for the replace name */ 257 else search_id = fd.file_id; /* otherwise, search for -name file_id */ 258 end; 259 260 cseg.open_mode = open_mode; /* save open mode in control segment */ 261 262 on area 263 begin; /* handle full control segment */ 264 code = error_table_$noalloc; 265 go to er_exit; 266 end; 267 268 new_link = "0"b; /* initialize for searching */ 269 cseg.flP = cseg.fcP; /* start at beginning of chain */ 270 do testP = fl.nextP repeat fl.nextP; /* loop through file chain */ 271 272 if testP ^= null 273 then cseg.flP = testP; /* link exists - use it */ 274 else 275 do; /* link does not exist - build it */ 276 new_link = "1"b; /* this is a new link */ 277 cc = 1; /* don't leave defective links */ 278 call build1 (code); /* make the link */ 279 if code ^= 0 280 then go to er_exit; 281 end; 282 283 if fl.flX = -1 284 then 285 do; /* the link is an end-of-file-set link */ 286 if append_file () 287 then go to create_file; /* appending file to eofs */ 288 else 289 do; /* not appending, therefore file not found */ 290 code = error_table_$no_file; 291 go to valid_exit; 292 end; 293 end; 294 295 if desired_file () 296 then 297 do; /* found our file */ 298 if cseg.open_mode = 4 299 then 300 do; /* opened for sequential_input */ 301 if ^new_link 302 then call desired_check; /* check chain-tape consistency */ 303 go to input; 304 end; 305 else 306 do; /* opened for sequential_output */ 307 if cseg.output_mode = 1 308 then go to extend_chain; /* -extend - get to last section */ 309 else 310 do; /* -modify, -generate, or -create */ 311 if ^new_link 312 then call desired_check; /* check chain-tape consistency at 1st section */ 313 if cseg.output_mode = 2 314 then go to extend_chain; /* need version # from last section */ 315 else 316 do; /* -generate or -create */ 317 if fd.expiration > fl.backP -> fl.expiration 318 then 319 do; /* check expiration */ 320 code = error_table_$invalid_expiration; 321 go to valid_exit; 322 end; 323 go to output; 324 end; 325 end; 326 end; 327 end; 328 329 if new_link 330 then 331 do; /* new link - only partially built */ 332 call build2 (code); 333 if code ^= 0 334 then go to er_exit; 335 end; 336 337 end; 338 339 extend_chain: /* extend file chain to last section */ 340 if debug 341 then call debug_print ("extend_chain"); 342 if new_link 343 then 344 do; /* complete link if just built */ 345 call build2 (code); 346 if code ^= 0 347 then go to er_exit; 348 end; 349 350 testP = cseg.flP; /* save pointer to first section's link */ 351 do while (fl.eox = 2); /* get to last section */ 352 if fl.nextP = null 353 then 354 do; /* next link doesn't exist */ 355 new_link = "1"b; /* indicate new links in chain */ 356 cc = 1; /* don't leave defective links */ 357 call build1 (code); /* build it */ 358 if code ^= 0 359 then go to er_exit; 360 if fl.flX = -1 361 then 362 do; /* trouble - need more sections, but eofs */ 363 code = error_table_$invalid_file_set_format; 364 go to valid_exit; /* an error, but all is consistent */ 365 end; 366 call build2 (code); 367 if code ^= 0 368 then go to er_exit; 369 end; 370 else cseg.flP = fl.nextP; /* link exists */ 371 end; 372 373 if cseg.output_mode = 1 374 then 375 do; /* extending chain for -extend */ 376 if ^new_link 377 then call desired_check; /* check chain-tape consistency */ 378 go to output; 379 end; 380 else 381 do; /* extended chain for -modify */ 382 cseg.flP = testP; /* restore pointer to first section's link */ 383 go to output; 384 end; 385 386 input: /* file is to be read */ 387 if debug 388 then call debug_print ("input"); 389 cc = 0; /* minimal consistency requirement */ 390 call setup_for_read; /* complete file data from file link */ 391 call lrec_open; /* perform final checks and initialization */ 392 393 /* INSERT USER LABEL PROCESSING HERE */ 394 395 call move_tape_ (fl.vlX, fl.flX, 1, code); /* move to 1st data block */ 396 if code ^= 0 397 then go to er_exit; 398 go to done; /* set up iocb and exit */ 399 400 output: 401 if debug 402 then call debug_print ("output"); /* extend, modify, generate, or create file */ 403 cc = 0; /* minimal consistency requirement */ 404 405 if ^cseg.force 406 then 407 do; /* check if file is expired */ 408 if fl.expiration > fd.creation 409 then 410 do; /* file is not expired */ 411 if ^write_permit () 412 then 413 do; /* user said don't overwrite */ 414 code = error_table_$unexpired_file; 415 go to valid_exit; 416 end; 417 end; 418 end; 419 420 call truncate_chains; /* truncate file and volume chains */ 421 call build_eofsl; /* append an eofs link */ 422 go to action_type (cseg.output_mode); /* process the file */ 423 424 extend_file: 425 modify_file: 426 action_type (1): 427 action_type (2): 428 if debug 429 then call debug_print ("extend/modify"); 430 431 /* INSERT USER LABEL PROCESSING TO READ LABELS BEFORE WRITING DATA */ 432 433 if cseg.output_mode = 1 434 then call move_to_EOD; /* position to end of data to extend */ 435 else 436 do; /* modify */ 437 call move_tape_ (fl.vlX, fl.flX, 1, code); /* move to 1st data block */ 438 if code ^= 0 439 then go to er_exit; 440 end; 441 cc = 1; /* don't leave defective file links */ 442 call setup_for_extend_modify; /* load file data from file link */ 443 call lrec_open; /* perform final checks and initialization */ 444 if cseg.output_mode = 1 445 then call extend_check; /* should last block be re-written? */ 446 go to done; 447 448 generate_file: 449 action_type (3): 450 if debug 451 then call debug_print ("generate_file"); 452 cc = 1; /* don't leave defective file links */ 453 call setup_for_generate; 454 go to common; 455 456 create_file: 457 action_type (4): 458 if debug 459 then call debug_print ("create"); 460 cc = 1; /* don't leave defective file links */ 461 call setup_for_create; /* load file link from file data */ 462 463 common: 464 call lrec_open; /* perform final checks and initialization */ 465 call move_tape_ (fl.vlX, fl.flX, 0, code); /* position to write header labels */ 466 if code ^= 0 467 then go to er_exit; 468 cc = 2; /* don't leave defective tape file */ 469 call write_HDRs (code); /* write header labels */ 470 if code ^= 0 471 then go to er_exit; /* trouble */ 472 call write_TM (1, code); /* write header TM */ 473 if code ^= 0 474 then if code ^= error_table_$eov_on_write 475 then go to er_exit; /* trouble - (ignore EOT) */ 476 call back_TM (1, code); /* back into headers */ 477 if code ^= 0 478 then go to er_exit; /* trouble */ 479 go to done; /* fill iocb and exit */ 480 481 done: 482 mask = "0"b; /* ips interrupts not masked yet */ 483 cseg.open_description.length = length (tstring); /* prepare open description */ 484 cseg.open_description.string = tstring; 485 revert cleanup; 486 on any_other call handler; /* pick up any condition */ 487 call hcs_$set_ips_mask ("0"b, mask); /* mask all ips interrupts */ 488 iocbP -> iocb.actual_iocb_ptr -> iocb.close = tape_ansi_file_cntl_$close; 489 if cseg.open_mode = 5 490 then 491 do; /* sequential output */ 492 if cseg.standard = 1 493 then iocbP -> iocb.actual_iocb_ptr -> iocb.write_record = tape_ansi_lrec_io_$write_record; 494 else iocbP -> iocb.actual_iocb_ptr -> iocb.write_record = tape_ansi_ibm_lrec_io_$write_record; 495 end; 496 else 497 do; /* sequential input */ 498 if cseg.standard = 1 499 then iocbP -> iocb.actual_iocb_ptr -> iocb.read_record = tape_ansi_lrec_io_$read_record; 500 else iocbP -> iocb.actual_iocb_ptr -> iocb.read_record = tape_ansi_ibm_lrec_io_$read_record; 501 iocbP -> iocb.actual_iocb_ptr -> iocb.read_length = tape_ansi_read_length_; 502 iocbP -> iocb.actual_iocb_ptr -> iocb.position = tape_ansi_position_; 503 end; 504 iocbP -> iocb.actual_iocb_ptr -> iocb.control = tape_ansi_control_; 505 iocbP -> iocb.actual_iocb_ptr -> iocb.open_descrip_ptr = addr (cseg.open_description); 506 call iox_$propagate (iocbP -> iocb.actual_iocb_ptr); 507 call hcs_$reset_ips_mask (mask, mask); /* permit ips interrupts */ 508 cseg.file_lock = "0"b; /* open complete - unlock the file */ 509 return; 510 511 er_exit: 512 call consistent; 513 514 valid_exit: 515 cseg.file_lock = "0"b; /* open complete - unlock the file */ 516 return; 517 518 abort_file: 519 procedure; /* cleanup after defective file */ 520 if debug 521 then call debug_print ("abort_file"); 522 523 vl (fl.vlX).cflX = 0; /* invalidate volume position */ 524 525 qi.yes_no = "1"b; /* want yes or no answer */ 526 qi.suppress_name = "0"b; /* print module name */ 527 qi.scode = error_table_$file_aborted; 528 qi.qcode = 0; 529 call command_query_ (addr (qi), answer, cseg.module, /* query user */ 530 "Error while writing labels of file ""^a"", section ^d. 531 The defective section invalidates the structure of the entire file set. 532 Do you want to delete the defective section?", fl.file_id, fl.section); 533 534 if answer = "no" 535 then 536 do; /* volume format will be invalid */ 537 call write_TM (2, 0); /* try to write 2 TM anyway */ 538 go to abort_fail1; 539 end; 540 541 cseg.flP = fl.backP; /* back up to previous section or file */ 542 call truncate_chains; /* truncate file and volume chains */ 543 call build_eofsl; /* add an end of file set link */ 544 545 if fl.flX = 0 546 then 547 do; /* bad section was first of file set */ 548 call initialize_volume (1, code); /* initialize the volume */ 549 if code ^= 0 550 then go to abort_fail; 551 end; 552 else 553 do; /* bad section wasn't first of file set */ 554 if fl.eox = 1 555 then 556 do; /* bad section was first section of file */ 557 call move_tape_ (fl.vlX, fl.flX + 1, 0, code); 558 /* position to write TM after EOF's */ 559 if code ^= 0 560 then go to abort_fail; 561 end; 562 else 563 do; /* bad section wasn't first section of file */ 564 call move_tape_ (fl.vlX, fl.flX, 2, code);/* position to re-write trailers */ 565 if code ^= 0 566 then go to abort_fail; 567 cseg.blkcnt = fl.blkcnt; /* set block count to be recorded */ 568 call write_EOFs (code); /* change EOV to EOF */ 569 if code ^= 0 570 then go to abort_fail; 571 end; 572 end; 573 574 call write_TM (2, code); /* write the TMs */ 575 if code ^= 0 576 then if code ^= error_table_$eov_on_write 577 then go to abort_fail; 578 579 code = error_table_$file_aborted; 580 return; 581 582 abort_fail: 583 call ioa_ ("^a: Deletion failed: unable to restore valid file set format.", cseg.module); 584 abort_fail1: 585 vl (fl.vlX).cflX = 0; /* invalidate volume position */ 586 cseg.flP = cseg.fcP; /* set pointer to eliminate file and volume chains */ 587 call truncate_chains; /* wipe the slate clean */ 588 code = error_table_$invalid_file_set_format; 589 return; 590 591 end abort_file; 592 593 another_volume: 594 procedure returns (bit (1)); /* queries user for next volume name */ 595 596 dcl msg char (80) varying; /* message to user */ 597 dcl msg1 char (length (msg)) based (addr (substr (msg, 1))); 598 /* char (*) overlay for command_query_ */ 599 dcl L1 fixed bin; 600 601 qi.yes_no = "1"b; /* want yes or no */ 602 qi.suppress_name = "0"b; /* don't suppress module name */ 603 qi.scode = error_table_$no_next_volume; 604 qi.qcode = 0; 605 msg = "Reached end of volume. Do you wish to terminate processing of this volume-set?"; 606 call command_query_ (addr (qi), answer, cseg.module, msg1); 607 if answer = "yes" 608 then return ("0"b); /* finito */ 609 610 qi.yes_no = "0"b; /* don't want yes or no */ 611 qi.suppress_name = "1"b; 612 ask: 613 qi.scode = 0; /* no scode when asking for name */ 614 msg = "Enter volume name of next volume (and optional comment).^/"; 615 ask_raw: 616 call command_query_ (addr (qi), answer, cseg.module, msg1); 617 if answer = "" 618 then go to ask; 619 com_text = ""; /* initialize comment message */ 620 L1 = index (answer, " ") - 1; /* scan for a blank */ 621 if L1 < 0 622 then L1 = length (answer); 623 624 call canon_for_volume_label_ (VOLUME_TYPE (TAPE_VOL_VTYPEX), substr (answer, 1, L1), vn, 0, code); 625 if code ^= 0 626 then 627 do; 628 qi.scode = code; 629 msg = substr (answer, 1, L1) || "^/Enter volume name of next volume (and optional comment).^/"; 630 go to ask_raw; 631 end; 632 633 answer = ltrim (substr (answer, L1 + 1)); 634 635 if substr (answer, 1, 8) = "-comment" 636 then 637 do; 638 answer = ltrim (substr (answer, 10)); 639 go to comment; 640 end; 641 if substr (answer, 1, 4) = "-com" 642 then 643 do; 644 answer = ltrim (substr (answer, 6)); 645 comment: 646 if length (answer) = 0 647 then ; /* no comment */ 648 else com_text = answer; 649 end; 650 else if answer = "" 651 then ; 652 else 653 do; /* invalid comment */ 654 call ioa_ ("Comment is invalid."); 655 go to ask; 656 end; 657 return ("1"b); /* volume name is ok - exit */ 658 659 write_permit: 660 entry returns (bit (1)); /* queries user for write permission */ 661 662 qi.yes_no = "1"b; /* user must answer yes or no */ 663 qi.suppress_name = "0"b; 664 qi.scode = error_table_$unexpired_file; 665 qi.qcode = 0; 666 call command_query_ (addr (qi), answer, cseg.module, /* ask the user */ 667 "Do you want to overwrite the unexpired file ""^a""?", fl.file_id); 668 if answer = "yes" 669 then return ("1"b); 670 else return ("0"b); 671 672 end another_volume; 673 674 append_file: 675 procedure returns (bit (1)); /* determines if a file is an append file */ 676 if debug 677 then call debug_print ("append_file"); 678 679 /* If the file is an append file, set its sequence number in file */ 680 /* data, and build an eofs link. */ 681 /* */ 682 /* A file is an append file if: */ 683 /* */ 684 /* 1) cseg.open_mode = 5 and cseg.output_mode = 4 */ 685 /* AND */ 686 /* 2) fd.sequence = 0 (-number not specified) or */ 687 /* last sequence number of file set + 1. */ 688 /* AND */ 689 /* 3) -replace not specified */ 690 691 if cseg.open_mode = 4 692 then return ("0"b); /* open mode is input */ 693 if cseg.output_mode ^= 4 694 then return ("0"b); /* output mode is not create */ 695 if cseg.replace_id ^= "" 696 then return ("0"b); /* -replace specified therefore cannot append */ 697 698 if fd.sequence = 0 699 then 700 do; /* -number not specified */ 701 if cseg.flP = fd.nextP 702 then fd.sequence = 1; /* file is 1st of new file set */ 703 else fd.sequence = fl.backP -> fl.sequence + 1; /* file is 2, 3, ..... */ 704 end; 705 706 else 707 do; /* -number specified */ 708 if cseg.flP = fd.nextP 709 then 710 do; /* file must be 1st of new file set */ 711 if fd.sequence = 1 712 then go to yes; /* and it is */ 713 else return ("0"b); /* isn't - error */ 714 end; 715 716 else 717 do; /* file need not be first, but last + 1 */ 718 if fd.sequence = fl.backP -> fl.sequence + 1 719 then go to yes; /* and it is */ 720 else return ("0"b); /* isn't - error */ 721 end; 722 end; 723 724 yes: 725 if debug 726 then call debug_print ("yes"); 727 if fd.expiration > fl.backP -> fl.expiration 728 then 729 do; /* requested expiration > file set expiration */ 730 code = error_table_$invalid_expiration; 731 go to valid_exit; 732 end; 733 cc = 1; /* insure chain consistency */ 734 call make_eofsl_real; /* make the eofs link a real link */ 735 call build_eofsl; /* add a new eofs link */ 736 return ("1"b); /* done! */ 737 738 end append_file; 739 740 back_TM: 741 procedure (n, ecode); /* backs over 1 or 2 TM adjusting volume link */ 742 if debug 743 then call ioa_ ("back_TM ^d", n); 744 dcl n fixed bin, 745 cnt fixed bin, 746 ecode fixed bin (35); 747 748 do cnt = 1 to n; /* 1 or 2 */ 749 call tape_ansi_tape_io_$order (cP, "bsf", 0, ecode); 750 /* backup over a TM */ 751 if ecode ^= 0 752 then return; 753 754 vl (fl.vlX).pos = vl (fl.vlX).pos - 1; 755 if vl (fl.vlX).pos < 0 756 then 757 do; /* adjust for mod3 */ 758 vl (fl.vlX).pos = vl (fl.vlX).pos + 3; 759 vl (fl.vlX).cflX = vl (fl.vlX).cflX - 1; 760 end; 761 end; 762 763 return; 764 765 end back_TM; 766 767 build1: 768 procedure (ecode); /* build a file link and initialize */ 769 dcl ecode fixed bin (35); 770 if debug 771 then call debug_print ("build1"); 772 773 call build_fl; /* build a file link */ 774 call move_tape_ (fl.vlX, fl.flX, 0, ecode); /* position to read HDR1 */ 775 if ecode ^= 0 776 then return; 777 call read_HDR1 (eofs, ecode); /* read the header 1 label */ 778 if ecode ^= 0 779 then return; 780 if eofs 781 then 782 do; /* reached end of file set */ 783 fl.flX = -1; /* make the link an eofs link */ 784 vl (fl.vlX).lflX = vl (fl.vlX).lflX - 1; /* remove eofs link from volume link */ 785 return; 786 end; 787 call fill_fl_from_HDR1 (ecode); /* validate and store HDR1 data */ 788 if ecode ^= 0 789 then return; 790 call read_HDR2 (ecode); /* try to read HDR2 label */ 791 if ecode ^= 0 792 then return; 793 if fl.HDR2 794 then 795 do; /* if HDR2, validate and store its data */ 796 call fill_fl_from_HDR2 (ecode); 797 if ecode ^= 0 798 then return; 799 end; 800 return; 801 802 end build1; 803 804 805 build2: 806 procedure (ecode); /* 2nd part of link building */ 807 dcl ecode fixed bin (35); 808 809 if debug 810 then call debug_print ("build2"); 811 call move_tape_ (fl.vlX, fl.flX, 2, ecode); /* position to trailer labels */ 812 if ecode ^= 0 813 then return; 814 call process_EOX (ecode); /* process the trailer labels */ 815 return; 816 817 end build2; 818 819 820 build_eofsl: 821 procedure; /* builds an end-of-file-set link */ 822 if debug 823 then call debug_print ("eofsl"); 824 825 allocate fl in (chain_area) set (fl.nextP); /* build an eofs link */ 826 fl.nextP -> fl.backP = cseg.flP; 827 fl.nextP -> fl.flX = -1; 828 return; 829 830 end build_eofsl; 831 832 build_fl: 833 procedure; /* build a file link on end of file chain */ 834 if debug 835 then call debug_print ("build_fl"); 836 837 allocate fl in (chain_area) set (fl.nextP); /* allocate the link */ 838 fl.nextP -> fl.backP = cseg.flP; /* set new link's back ptr to current link */ 839 cseg.flP = fl.nextP; /* make the new link current */ 840 go to build_fl1; 841 842 make_eofsl_real: 843 entry; /* makes an eofs link a real link */ 844 if debug 845 then call debug_print ("make_eofsl_real"); 846 847 build_fl1: 848 fl.flX = fl.backP -> fl.flX + 1; /* set the link index */ 849 850 if fl.backP -> fl.eox = 2 851 then 852 do; /* this link will be 1st on new volume */ 853 fl.vlX = fl.backP -> fl.vlX + 1; /* up volume link index for this file link */ 854 vl (fl.vlX).fflX = fl.flX; /* first file link on new volume is this file link */ 855 vl (fl.vlX).lflX = fl.flX; /* last file link on new volume is this file link */ 856 end; 857 else 858 do; /* this link is not on a new volume */ 859 fl.vlX = fl.backP -> fl.vlX; /* use same volume index as previous link */ 860 vl (fl.vlX).lflX = vl (fl.vlX).lflX + 1; /* one more file link on volume */ 861 end; 862 863 return; 864 865 end build_fl; 866 867 consistent: 868 procedure; /* insures file chain/tape consistency */ 869 if debug 870 then call debug_print ("consistent"); 871 872 go to recovery (cc); /* perform appropriate consistency processing */ 873 874 recovery (0): 875 if cseg.flP ^= null 876 then vl (fl.vlX).cflX = 0; /* invalidate volume position */ 877 return; 878 879 recovery (1): 880 if cseg.flP = null 881 then return; /* nothing can be done - exit */ 882 vl (fl.vlX).cflX = 0; /* invalidate volume position */ 883 cseg.flP = fl.backP; /* set pointer to previous link */ 884 call truncate_chains; /* truncate file and volume chains */ 885 return; 886 887 recovery (2): 888 if cseg.flP = null 889 then return; /* nothing can be done - exit */ 890 call abort_file; /* truncate file and volume chains, write TM */ 891 return; 892 893 end consistent; 894 895 creating_first: 896 procedure returns (bit (1)); /* determines if creating 1st file of new file set */ 897 898 if debug 899 then call debug_print ("creating_first?"); 900 if cseg.open_mode = 4 901 then return ("0"b); 902 if cseg.output_mode ^= 4 903 then return ("0"b); 904 if fd.sequence ^= 1 905 then return ("0"b); 906 if cseg.replace_id ^= "" 907 then return ("0"b); 908 909 return ("1"b); 910 911 end creating_first; 912 913 desired_check: 914 procedure; /* insures that tape and file chain are consistent */ 915 dcl can_retry bit (1) initial ("1"b); 916 /* permits 1 retry after re-positioning */ 917 918 if debug 919 then call debug_print ("desired_check"); 920 921 last_chance: 922 call move_tape_ (fl.vlX, fl.flX, 0, code); /* position to HDR labels */ 923 if code ^= 0 924 then go to er_exit; 925 926 call read_HDR1 (eofs, code); /* read HDR1 label */ 927 if code ^= 0 928 then go to er_exit; 929 930 if eofs 931 then 932 do; /* end of file set - shouldn't happen */ 933 chain_tape_error: 934 if debug 935 then call debug_print ("chain_tape_error"); 936 if can_retry 937 then 938 do; /* re-position and try again */ 939 can_retry = "0"b; /* can only re-try once */ 940 vl (fl.vlX).cflX = 0; /* force rewind and re-position */ 941 go to last_chance; /* try again */ 942 end; 943 code = error_table_$invalid_cseg; /* re-try failed - disaster */ 944 cseg.invalid = "1"b; /* note for eventual deletion of cseg */ 945 go to er_exit; 946 end; 947 948 if cseg.standard = 1 949 then 950 do; /* ANSI */ 951 if ansi_hdr1.file_id ^= fl.file_id 952 then go to chain_tape_error; /* file id's must be identical */ 953 on conversion go to chain_tape_error; 954 if fixed (ansi_hdr1.section) ^= fl.section 955 then go to chain_tape_error; /* and section */ 956 revert conversion; 957 end; 958 else if ibm_hdr1.dataset_id ^= fl.file_id 959 then go to chain_tape_error; /* IBM */ 960 961 return; 962 963 end desired_check; 964 965 desired_file: 966 procedure returns (bit (1)); /* determines if file wanted is current link */ 967 if debug 968 then call debug_print ("desired_file?"); 969 970 if fl.section ^= 1 971 then 972 do; /* don't investigate non-initial sections */ 973 if debug 974 then call debug_print ("sec ne 1"); 975 return ("0"b); 976 end; 977 978 if fd.sequence ^= 0 979 then 980 do; /* -number specified */ 981 if search_id = "" 982 then 983 do; /* -name (or -replace) not specified */ 984 if fd.sequence = fl.sequence 985 then go to match; /* sequences match */ 986 else go to no; /* sequences don't match */ 987 end; 988 else 989 do; /* -name/replace specified */ 990 if fd.sequence = fl.sequence 991 then 992 do; /* -number matches */ 993 if cseg.replace_id ^= "" 994 then 995 do; /* -replace specified? */ 996 if cseg.replace_id = fl.file_id 997 then go to match; /* found it */ 998 code = error_table_$no_file; /* file doesn't exist */ 999 go to valid_exit; 1000 end; 1001 if fd.file_id = fl.file_id 1002 then go to match; /* -name specified */ 1003 if cseg.open_mode = 5 & cseg.output_mode = 4 1004 then go to match; /* creation */ 1005 code = error_table_$no_file; /* file doesn't exist */ 1006 go to valid_exit; 1007 end; 1008 else go to no; /* -number doesn't match */ 1009 end; 1010 end; 1011 else 1012 do; /* -number not specified */ 1013 if search_id = fl.file_id 1014 then 1015 do; /* names match */ 1016 fd.sequence = fl.sequence; /* set sequence in case not specified */ 1017 match: 1018 if debug 1019 then call debug_print ("yes"); 1020 return ("1"b); 1021 end; 1022 no: 1023 if debug 1024 then call debug_print ("no"); 1025 if cseg.output_mode = 4 1026 then 1027 do; /* if -create specified */ 1028 if cseg.open_mode = 5 1029 then 1030 do; /* and actually opened for output */ 1031 if fd.file_id = fl.file_id 1032 then 1033 do; /* then names cannot be the same */ 1034 code = error_table_$duplicate_file_id; 1035 /* if not desired file */ 1036 go to valid_exit; 1037 end; 1038 end; 1039 end; 1040 return ("0"b); 1041 end; 1042 1043 1044 1045 end desired_file; 1046 1047 extend_check: 1048 procedure; /* checks if necessary to re-write last block */ 1049 dcl buf char (8192) based aligned; 1050 /* IO buffer overlay */ 1051 dcl (i, j) fixed bin; /* temporaries */ 1052 1053 if debug 1054 then call debug_print ("extend_check"); 1055 1056 if cseg.blkcnt = 0 1057 then return; /* no last blockto re-write */ 1058 if fd.format ^= 2 1059 then return; /* only FB format might need re-writing */ 1060 if ^fd.blocked 1061 then return; 1062 1063 call tape_ansi_tape_io_$order (cP, "bsr", 0, code); /* position to read last block */ 1064 if code ^= 0 1065 then go to er_exit; 1066 call tape_ansi_tape_io_$sync_read (cP, cseg.offset, code); 1067 if code ^= 0 1068 then go to er_exit; 1069 1070 if cseg.standard = 2 1071 then 1072 do; /* IBM labeled tape */ 1073 if mod (cseg.offset, fd.reclen) ^= 0 1074 then return; /* ^integral # of records */ 1075 if cseg.offset >= fd.blklen 1076 then return; /* block is full */ 1077 else go to rewrite; /* more records can fit in block */ 1078 end; 1079 1080 if cseg.offset > fd.blklen 1081 then cseg.offset = fd.blklen; /* ANSI - eliminate obvious padding */ 1082 i = mod ((cseg.offset - fd.bo), fd.reclen); /* # of chars not in complete record */ 1083 if i ^= 0 1084 then 1085 do; /* if any, see if all padding */ 1086 if verify (substr (cseg.syncP -> buf, cseg.offset - i + 1, i), "^") ^= 0 1087 then return; /* not all padding, irregularity */ 1088 else cseg.offset = cseg.offset - i; /* all padding, must continue checking */ 1089 end; 1090 1091 i = (cseg.offset - fd.bo) / fd.reclen; /* get # of complete records */ 1092 do j = i to 1 by -1; /* test each record for all "^" */ 1093 if verify (substr (cseg.syncP -> buf, fd.bo + ((j - 1) * fd.reclen) + 1, fd.reclen), "^") = 0 1094 then cseg.offset = cseg.offset - fd.reclen; /* drop padding */ 1095 else go to rewrite_test; /* not padding - test if block full */ 1096 end; 1097 1098 rewrite_test: 1099 if cseg.offset >= fd.blklen 1100 then return; /* block is full */ 1101 rewrite: 1102 call tape_ansi_tape_io_$order (cP, "bsr", 0, code); /* position to rewrite */ 1103 if code ^= 0 1104 then go to er_exit; 1105 call tape_ansi_tape_io_$get_buffer (cP, cseg.lrec.bufP, code); 1106 /* getting an IO buffer causes */ 1107 if code ^= 0 1108 then go to er_exit; /* iox_$close to call xxx_lrec_io_$close */ 1109 cseg.blkcnt = cseg.blkcnt - 1; /* so block count must now reflect tape position */ 1110 substr (cseg.lrec.bufP -> buf, 1, cseg.offset) = substr (cseg.syncP -> buf, 1, cseg.offset); 1111 return; 1112 1113 end extend_check; 1114 1115 fill_XXX1: 1116 procedure (x); /* formats labels for output */ 1117 dcl x fixed bin; /* 1 - HDR | 2 - EOF | 3 - EOV */ 1118 1119 if debug 1120 then call debug_print ("fill_XXX1"); 1121 1122 ansi_hdr1P, ibm_hdr1P = addr (lbl_buf); /* ANSI:IBM common - set pointer to label IO buffer */ 1123 ansi_hdr1.label_id = l1id (x); /* set label identifier */ 1124 ansi_hdr1.file_id = fl.file_id; /* IBM - dataset_id */ 1125 ansi_hdr1.set_id = fl.canonical_set_id; /* IBM - dataset_serial */ 1126 1127 if cseg.standard = 1 1128 then 1129 do; /* ANSI */ 1130 t4 = fl.section; 1131 ansi_hdr1.section = t4; 1132 end; 1133 else 1134 do; 1135 t4 = fl.vlX; 1136 ibm_hdr1.volume_sequence = t4; 1137 end; 1138 if fl.generation = 0 & cseg.standard ^= 1 1139 then 1140 do; /* consider ANSI 0000 (=10000) case */ 1141 ibm_hdr1.generation = ""; 1142 ibm_hdr1.version = ""; 1143 end; 1144 else 1145 do; 1146 t4 = fl.generation; 1147 ansi_hdr1.generation = t4; 1148 t2 = fl.version; 1149 ansi_hdr1.version = t2; 1150 end; 1151 t4 = fl.sequence; 1152 ansi_hdr1.sequence = t4; 1153 ansi_hdr1.creation = " " || fl.creation; 1154 ansi_hdr1.expiration = " " || fl.expiration; 1155 ansi_hdr1.access = fl.access; 1156 if x = 1 1157 then ansi_hdr1.blkcnt = "000000"; 1158 else 1159 do; 1160 t6 = cseg.lrec.blkcnt; 1161 ansi_hdr1.blkcnt = t6; 1162 end; 1163 ansi_hdr1.system = fl.system; 1164 ansi_hdr1.reserved = ""; 1165 return; 1166 1167 end fill_XXX1; 1168 1169 fill_XXX2: 1170 procedure (x); /* formats 2nd header/trailer label for writing */ 1171 dcl x fixed bin; 1172 1173 if debug 1174 then call debug_print ("fill_XXX2"); 1175 if cseg.standard ^= 1 1176 then go to IBM_fill_XXX2; 1177 1178 ansi_hdr2P = addr (lbl_buf); /* set pointer to label IO buffer */ 1179 ansi_hdr2.label_id = l2id (x); 1180 ansi_hdr2.format = substr (ansi_format_chars, fl.format, 1); 1181 t5 = fl.blklen; 1182 ansi_hdr2.blklen = t5; 1183 t5 = fl.reclen; 1184 ansi_hdr2.reclen = t5; 1185 if fl.system = fd.system 1186 then 1187 do; /* fill these fields only on parochial file */ 1188 if x = 1 1189 then ansi_hdr2.next_volname = ""; 1190 else ansi_hdr2.next_volname = fl.next_volname; 1191 ansi_hdr2.blocked = char (fl.blocked); 1192 t1 = fl.mode; 1193 ansi_hdr2.mode = t1; 1194 end; 1195 else 1196 do; 1197 ansi_hdr2.next_volname = ""; 1198 ansi_hdr2.blocked = ""; 1199 ansi_hdr2.mode = ""; 1200 end; 1201 ansi_hdr2.system_reserved = ""; 1202 t2 = fl.bo; 1203 ansi_hdr2.buffer_offset = t2; 1204 ansi_hdr2.reserved = ""; 1205 return; 1206 1207 IBM_fill_XXX2: 1208 ibm_hdr2P = addr (cseg.lbl_buf); 1209 ibm_hdr2.label_id = l2id (x); 1210 ibm_hdr2.format = substr (ibm_format_chars, fl.format, 1); 1211 t5 = fl.blklen; 1212 ibm_hdr2.blksize = t5; 1213 t5 = fl.reclen; 1214 ibm_hdr2.lrecl = t5; 1215 t1 = cseg.density; 1216 ibm_hdr2.density = t1; 1217 if fl.section > 1 1218 then ibm_hdr2.dataset_position = "1"; 1219 else ibm_hdr2.dataset_position = "0"; 1220 ibm_hdr2.jobstep_id = "MULTICS /" || fd.creation; 1221 ibm_hdr2.recording_technique = ""; 1222 ibm_hdr2.control_characters = fl.cc; 1223 ibm_hdr2.reserved1 = ""; 1224 if ^fl.blocked 1225 then t = 1; /* records not blocked */ 1226 else t = 2; /* records blocked */ 1227 if fl.format = 4 1228 then t = t + 2; /* spanned records */ 1229 ibm_hdr2.block_attribute = substr (ibm_block_codes, t, 1); 1230 /* pick out block code */ 1231 ibm_hdr2.reserved2 = ""; 1232 return; 1233 1234 end fill_XXX2; 1235 1236 fill_fl_from_HDR1: 1237 procedure (ecode); /* fills file link from HDR1 data */ 1238 dcl ecode fixed bin (35); 1239 dcl nv fixed bin; 1240 1241 if debug 1242 then call debug_print ("fill_fl_from_HDR1"); 1243 on conversion go to bad_hdr1; 1244 go to re_fill (cseg.standard); /* processing for ANSI or IBM */ 1245 1246 re_fill (1): 1247 fl.file_id = ansi_hdr1.file_id; 1248 fl.set_id = cseg.vl (fl.vlX).volname; 1249 fl.canonical_set_id = ansi_hdr1.set_id; 1250 fl.section = fixed (ansi_hdr1.section, 17); 1251 if fl.section = 0 1252 then go to bad_hdr1; 1253 fl.sequence = fixed (ansi_hdr1.sequence, 17); 1254 if fl.sequence = 0 1255 then go to bad_hdr1; 1256 1257 if fl.section = 1 1258 then 1259 do; /* check volume sequence validity */ 1260 if fl.sequence = 1 1261 then 1262 do; /* file 1, section 1 */ 1263 if fl.flX ^= 1 1264 then 1265 do; /* must be first link in file chain */ 1266 bad_seq: 1267 ecode = error_table_$invalid_volume_sequence; 1268 return; 1269 end; 1270 end; 1271 else 1272 do; /* file n > 1, section 1 */ 1273 if fl.flX = 1 1274 then 1275 do; /* cannot be first link in file chain */ 1276 new_file_set: 1277 if ^creating_first () 1278 then go to bad_seq; /* unless creating 1st file */ 1279 if substr (ansi_hdr1.expiration, 2, 5) <= fd.creation 1280 then go to re_init; 1281 if initialize_permitA (fl.vlX) 1282 then 1283 do; /* not expired - query user for permission */ 1284 re_init: 1285 call initialize_volume (fl.vlX, ecode); 1286 /* said ok (or expired) - do it */ 1287 if ecode ^= 0 1288 then return; 1289 call move_tape_ (fl.vlX, fl.flX, 0, ecode); 1290 /* re-position to HDR1 */ 1291 if ecode ^= 0 1292 then return; 1293 call read_HDR1 (eofs, ecode); /* read HDR1 - eof can't happen */ 1294 if ecode ^= 0 1295 then return; 1296 go to re_fill (cseg.standard);/* processing for ANSI or IBM */ 1297 end; 1298 ecode = error_table_$unexpired_volume; 1299 /* user said no */ 1300 return; 1301 end; 1302 else if fl.backP -> fl.eox = 2 1303 then go to bad_seq; /* previous file section must be last */ 1304 end; 1305 end; 1306 else 1307 do; /* file n >_ 1, section n > 1 */ 1308 if fl.flX = 1 1309 then go to new_file_set; /* cannot be first link in file chain */ 1310 if fl.section ^= fl.backP -> fl.section + 1 1311 then go to bad_seq; /* section must be 1 more than previous */ 1312 end; 1313 1314 finish_up: 1315 fl.generation = fixed (ansi_hdr1.generation, 17); 1316 fl.version = fixed (ansi_hdr1.version, 17); 1317 fl.creation = substr (ansi_hdr1.creation, 2, 5); 1318 fl.expiration = substr (ansi_hdr1.expiration, 2, 5); 1319 fl.access = ansi_hdr1.access; 1320 fl.blkcnt = fixed (ansi_hdr1.blkcnt, 35); 1321 fl.system = ansi_hdr1.system; 1322 return; 1323 1324 1325 re_fill (2): 1326 re_fill (3): 1327 fl.file_id = ibm_hdr1.dataset_id; 1328 fl.set_id = cseg.vl (fl.vlX).volname; 1329 fl.canonical_set_id = ibm_hdr1.dataset_serial; 1330 nv = fixed (ibm_hdr1.volume_sequence, 17); 1331 if nv = 0 1332 then 1333 do; /* volume sequence is 0 */ 1334 if substr (lbl_buf, 5, 76) = dummy_label (1) 1335 then 1336 do; /* HDR1 is a dummy */ 1337 if fl.flX = 1 1338 then if ^creating_first () 1339 then 1340 do; /* if so, only creating 1st file */ 1341 ecode = error_table_$no_file; /* ...of new file set has meaning */ 1342 return; 1343 end; 1344 fl.section = 1; /* force meaningful values */ 1345 fl.sequence = 1; 1346 go to finish_up; 1347 end; 1348 else go to bad_hdr1; /* not dummy HDR1, an error */ 1349 end; 1350 if fl.flX = 1 1351 then fl.section = 1; /* dummy up section number */ 1352 else 1353 do; /* tests can be made */ 1354 if fl.backP -> fl.file_id = fl.file_id 1355 then fl.section = fl.backP -> fl.section + 1; 1356 else fl.section = 1; 1357 end; 1358 fl.sequence = fixed (ibm_hdr1.dataset_sequence, 17); 1359 if fl.sequence = 0 1360 then go to bad_hdr1; 1361 1362 if nv = 1 1363 then 1364 do; /* label says 1st volume */ 1365 if fl.vlX = 1 1366 then ; /* and so it is */ 1367 else go to bad_seq; /* definite error */ 1368 end; 1369 else if fl.vlX ^= nv 1370 then go to new_file_set; /* volume isn't _nth - see why */ 1371 if fl.sequence = 1 1372 then 1373 do; /* check file and volume sequences */ 1374 if nv = 1 1375 then 1376 do; /* file 1 on volume 1 */ 1377 if fl.flX ^= 1 1378 then go to bad_seq; /* must be 1st file link */ 1379 else ; /* it is, fine */ 1380 end; 1381 else 1382 do; /* file 1 on volume nv > 1 */ 1383 if nv = fl.backP -> fl.vlX + 1 1384 then ; /* fine, volumes in sequence */ 1385 else go to bad_seq; 1386 end; 1387 end; 1388 else if fl.flX = 1 1389 then go to new_file_set; /* perhaps error - find out */ 1390 go to finish_up; 1391 1392 1393 bad_hdr1: 1394 ecode = error_table_$invalid_label_format; 1395 return; 1396 1397 1398 end fill_fl_from_HDR1; 1399 1400 fill_fl_from_HDR2: 1401 procedure (ecode); /* fills file link from HDR2 data */ 1402 dcl ecode fixed bin (35); 1403 1404 dcl canon_std (2) fixed bin initial (Volume_ansi_tape, Volume_ibm_tape); 1405 1406 if debug 1407 then call debug_print ("fill_fl_from_HDR2"); 1408 on conversion go to bad_hdr2; 1409 if cseg.standard ^= 1 1410 then go to IBM_fill_fl_from_HDR2; 1411 1412 fl.format = index (ansi_format_chars, ansi_hdr2.format); 1413 if fl.format = 0 1414 then go to bad_hdr2; 1415 fl.blklen = fixed (ansi_hdr2.blklen, 17); 1416 if fl.blklen = 0 1417 then go to bad_hdr2; 1418 if fl.blklen > cseg.buf_size 1419 then 1420 do; /* we don't have enough room to read it */ 1421 fl.blklen = fl.blklen + mod (fl.blklen, 4); /* make it mod 4 */ 1422 call 1423 ioa_ ("^a^/Reattach with a ""-block ^d"" specification.", 1424 "Block size in HDR2 label > block size allowed for this attachment.", fl.blklen); 1425 go to bad_hdr2; 1426 end; 1427 if fl.format ^= 1 1428 then fl.reclen = fixed (ansi_hdr2.reclen, 17); /* reclen only for F, D, and S */ 1429 if fl.system ^= "" 1430 then 1431 do; /* fields may be valid */ 1432 fl.bo = fixed (ansi_hdr2.buffer_offset, 17); 1433 if fl.system = fd.system 1434 then 1435 do; /* following is system specific */ 1436 if old_ansi_hdr2_system_use.system_reserved = "" 1437 then 1438 do; /* old-format hdr2 label */ 1439 fl.blocked = bit (old_ansi_hdr2_system_use.blocked); 1440 fl.mode = fixed (old_ansi_hdr2_system_use.mode, 17); 1441 fl.canonical_next_volname = old_ansi_hdr2_system_use.canonical_next_volname; 1442 fl.next_volname = ""; 1443 end; 1444 else 1445 do; 1446 fl.blocked = bit (ansi_hdr2.system_use.blocked); 1447 fl.mode = fixed (ansi_hdr2.system_use.mode, 17); 1448 fl.next_volname = ansi_hdr2.system_use.next_volname; 1449 if fl.next_volname ^= "" 1450 then 1451 do; 1452 call 1453 canon_for_volume_label_ (VOLUME_TYPE (TAPE_VOL_VTYPEX), fl.next_volname, 1454 fl.canonical_next_volname, canon_std (cseg.standard), ecode); 1455 if ecode ^= 0 1456 then goto bad_hdr2; 1457 end; 1458 else fl.canonical_next_volname = ""; 1459 end; 1460 end; 1461 end; 1462 return; 1463 1464 IBM_fill_fl_from_HDR2: 1465 fl.format = index (ibm_format_chars, ibm_hdr2.format); 1466 if fl.format = 0 1467 then go to bad_hdr2; 1468 fl.blklen = fixed (ibm_hdr2.blksize, 17); 1469 if fl.blklen = 0 1470 then go to bad_hdr2; 1471 if fl.format ^= 1 1472 then fl.reclen = fixed (ibm_hdr2.lrecl, 17); /* reclen only for F and V */ 1473 1474 /* t = fixed (ibm_hdr2.density, 17); This is stupid. Since we are already */ 1475 /* if cseg.density ^= t reading the tape at the right density, who cares */ 1476 /* then go to bad_hdr2; what the HDR2 label says the density is. */ 1477 if ibm_hdr2.dataset_position = "1" 1478 then 1479 do; /* should not be 1st volume */ 1480 if fl.vlX = 1 1481 then go to bad_hdr2; /* cant be 1st vol */ 1482 if fl.backP -> fl.eox ^= 2 1483 then go to bad_hdr2; /* previous must have EOV labels */ 1484 end; 1485 if ibm_hdr2.recording_technique ^= "" 1486 then go to bad_hdr2; 1487 t = index (ibm_block_codes, ibm_hdr2.block_attribute); 1488 if t = 0 1489 then go to bad_hdr2; 1490 if t > 2 1491 then 1492 do; /* indicated spanned blocks */ 1493 t = t - 2; 1494 if fl.format = 3 1495 then /* set it to V spanned only if hdr2.format is "V" */ 1496 fl.format = 4; 1497 end; 1498 if t = 1 1499 then fl.blocked = "0"b; 1500 else fl.blocked = "1"b; 1501 fl.cc = ibm_hdr2.control_characters; 1502 return; 1503 1504 bad_hdr2: 1505 ecode = error_table_$invalid_label_format; 1506 return; 1507 1508 end fill_fl_from_HDR2; 1509 1510 fill_fdhdr2_from_fl: 1511 procedure; /* fills fd hdr2 data from fl if section has HDR2 */ 1512 if debug 1513 then call debug_print ("fill_fdhdr2_from_fl"); 1514 1515 if fl.HDR2 1516 then 1517 do; /* fill only if HDR2 exists */ 1518 if fd.format ^= 0 1519 then 1520 do; /* -format in attach description */ 1521 if fd.format ^= fl.format 1522 then 1523 do; /* incompatible file attribute specification */ 1524 mis_match: 1525 code = error_table_$incompatible_file_attribute; 1526 go to er_exit; 1527 end; 1528 else format_override = "1"b; /* -format's blocking attribute to be used */ 1529 end; 1530 else 1531 do; /* -format not specified */ 1532 fd.format = fl.format; /* use value from HDR2 */ 1533 format_override = "0"b; /* blocking attribute not specified */ 1534 end; 1535 1536 if fd.blklen ^= 0 1537 then 1538 do; 1539 if fd.blklen ^= fl.blklen 1540 then go to mis_match; 1541 else ; 1542 end; 1543 else fd.blklen = fl.blklen; 1544 1545 if fd.format ^= 1 1546 then 1547 do; /* record length undefined for U format */ 1548 if fd.reclen ^= 0 1549 then 1550 do; /* only test if specified */ 1551 if fd.reclen <= max_reclen (cseg.standard) 1552 then 1553 do; /* fits in HDR2 reclen field */ 1554 if fd.reclen ^= fl.reclen 1555 then go to mis_match; /* must match */ 1556 else ; /* ok */ 1557 end; 1558 else if fl.reclen ^= 0 1559 then go to mis_match; /* doesn't fit - 0 */ 1560 end; 1561 fd.reclen = fl.reclen; 1562 end; 1563 1564 if cseg.standard = 1 1565 then 1566 do; /* ANSI */ 1567 if fl.system ^= "" 1568 then 1569 do; /* certain HDR2 fields are valid */ 1570 fd.bo = fl.bo; /* CANNOT BE USER-SPECIFIED */ 1571 if fl.system = fd.system 1572 then 1573 do; /* system-defined data is valid */ 1574 if format_override 1575 then 1576 do; /* blocking attributes must match */ 1577 if fd.blocked ^= fl.blocked 1578 then go to mis_match; 1579 else ; 1580 end; 1581 else fd.blocked = fl.blocked; 1582 if fd.mode ^= 0 1583 then 1584 do; 1585 if fd.mode ^= fl.mode 1586 then go to mis_match; 1587 else ; 1588 end; 1589 else fd.mode = fl.mode; 1590 end; 1591 end; 1592 else fd.bo = 0; /* must be 0 if fl.system = "" */ 1593 end; 1594 else 1595 do; /* IBM */ 1596 if format_override 1597 then 1598 do; 1599 if fd.blocked ^= fl.blocked 1600 then go to mis_match; 1601 else ; 1602 end; 1603 else fd.blocked = fl.blocked; 1604 fd.cc = fl.cc; /* CANNOT BE USER-SPECIFIED */ 1605 end; 1606 end; 1607 return; 1608 1609 end fill_fdhdr2_from_fl; 1610 1611 fill_flhdr2_from_fd: 1612 procedure; /* fill fl hdr2 data from fd and defaults */ 1613 if debug 1614 then call debug_print ("fill_flhdr2_from_fd"); 1615 1616 if fd.format = 0 1617 then 1618 do; /* apply defaults */ 1619 if cseg.output_mode ^= 4 1620 then 1621 do; /* defaults permitted only for create */ 1622 no_defaults: 1623 code = error_table_$insufficient_open; 1624 go to er_exit; 1625 end; 1626 fd.format = 3; /* D or V format */ 1627 fd.blocked = "1"b; /* blocked */ 1628 end; 1629 fl.format = fd.format; 1630 fl.blocked = fd.blocked; 1631 1632 if fd.blklen = 0 1633 then 1634 do; /* apply defaults */ 1635 if cseg.output_mode ^= 4 1636 then go to no_defaults; 1637 if cseg.standard = 1 1638 then fd.blklen = 2048; /* ANSI */ 1639 else fd.blklen = 8192; /* IBM */ 1640 end; 1641 fl.blklen = fd.blklen; 1642 1643 if fd.reclen = 0 1644 then 1645 do; /* apply defaults */ 1646 1647 if cseg.output_mode ^= 4 1648 then go to no_defaults; 1649 go to default_reclen (fd.format); /* perform appropriate reclen default action */ 1650 1651 default_reclen (2): 1652 fd.reclen = fd.blklen; /* F format */ 1653 go to set_fl_reclen; 1654 1655 default_reclen (3): 1656 if cseg.standard = 1 1657 then fd.reclen = fd.blklen; /* D format */ 1658 else fd.reclen = fd.blklen - 4; /* V format */ 1659 go to set_fl_reclen; 1660 1661 default_reclen (4): 1662 fd.reclen = prec (sys_info$max_seg_size * 4, 21); 1663 /* S or VS format */ 1664 1665 end; 1666 1667 default_reclen (1): /* U format - 0 is correct */ 1668 set_fl_reclen: 1669 if fd.reclen > max_reclen (cseg.standard) 1670 then fl.reclen = 0; 1671 else fl.reclen = fd.reclen; 1672 1673 if fd.mode = 0 1674 then 1675 do; /* apply defaults */ 1676 if cseg.standard = 1 1677 then fd.mode = 1; /* ANSI - ASCII */ 1678 else fd.mode = 2; /* IBM - EBCDIC */ 1679 end; 1680 fl.mode = fd.mode; 1681 1682 fl.cc = fd.cc; 1683 fl.bo = 0; 1684 fl.next_volname, fl.canonical_next_volname = ""; 1685 return; 1686 1687 end fill_flhdr2_from_fd; 1688 1689 fill_new_section_fl: 1690 procedure; /* initializes new file section link */ 1691 if debug 1692 then call debug_print ("fill_new_section_fl"); 1693 1694 fl.file_id = fl.backP -> fl.file_id; /* copy from previous link */ 1695 fl.set_id = fl.backP -> fl.set_id; 1696 fl.canonical_set_id = fl.backP -> fl.canonical_set_id; 1697 fl.section = fl.backP -> fl.section + 1; /* increment section number */ 1698 fl.sequence = fl.backP -> fl.sequence; 1699 fl.generation = fl.backP -> fl.generation; 1700 fl.version = fl.backP -> fl.version; 1701 fl.creation = fl.backP -> fl.creation; 1702 fl.expiration = fl.backP -> fl.expiration; 1703 fl.access = fl.backP -> fl.access; 1704 fl.blkcnt = 0; 1705 fl.system = fd.system; 1706 1707 fl.hdr2 = fl.backP -> fl.hdr2; 1708 fl.next_volname, fl.canonical_next_volname = ""; /* initialize */ 1709 1710 return; 1711 1712 end fill_new_section_fl; 1713 1714 1715 handler: 1716 procedure; /* intercept any faults during iocb manipulation */ 1717 dcl 1 ti aligned, 1718 2 version fixed bin init (0), 1719 2 code fixed bin (35); 1720 1721 if mask ^= "0"b 1722 then 1723 do; /* IPS interrupts masked */ 1724 ti.code = error_table_$unable_to_do_io; /* very bad trouble */ 1725 call terminate_process_ ("fatal_error", addr (ti)); 1726 /* kill the process */ 1727 end; 1728 call continue_to_signal_ (0); 1729 return; 1730 end handler; 1731 1732 initialize_permit: 1733 procedure (vX) returns (bit (1)); /* query for permission to write VOL1 label */ 1734 dcl vX fixed bin; 1735 dcl msg char (120) varying; 1736 dcl (extra1, extra2) char (12) varying initial (""); 1737 1738 qi.scode = error_table_$uninitialized_volume; /* set status code */ 1739 go to query (vl (vX).write_VOL1); /* issue appropriate query */ 1740 1741 1742 initialize_permitA: 1743 entry (vX) returns (bit (1)); /* query to initialize an unexpired volume */ 1744 qi.qcode = 0; 1745 qi.scode = error_table_$unexpired_volume; 1746 msg = "Volume ^a requires initialization, but contains an unexpired file.^/Do you want to initialize it?"; 1747 go to ip_com; 1748 1749 1750 query (2): 1751 qi.qcode = 1; /* unreadable 1st block */ 1752 msg = "Volume ^a requires initialization: first block is unreadable.^/Do you want to initialize it?"; 1753 go to ip_com; 1754 1755 1756 query (3): 1757 qi.qcode = 2; /* first block isn't VOL1 label */ 1758 msg = "Volume ^a requires initialization: first block is not VOL1 label.^/Do you want to initialize it?"; 1759 go to ip_com; 1760 1761 1762 query (4): 1763 qi.qcode = 3; /* VOL1 label has wrong volid */ 1764 extra1 = substr (cseg.lbl_buf, 5, 6); /* volid encountered */ 1765 extra2 = vl (vX).canonical_volname; /* volid expected */ 1766 msg = "Warning: Label for volume ^a contains identifier ^a instead of ^a.^/"; 1767 if cseg.open_mode = 4 1768 then /* Volume is read-only */ 1769 msg = msg || "Do you really want to continue processing?"; 1770 else msg = msg || "Do you want to reinitialize it as the desired volume?"; 1771 /* can write to the tape */ 1772 go to ip_com; 1773 1774 1775 query (5): 1776 qi.qcode = 4; /* VOL1 label correct, but wrong density */ 1777 msg = "Volume ^a requires initialization: recorded at incorrect density.^/Do you want to re-initialize it?"; 1778 go to ip_com; 1779 1780 query (6): 1781 qi.qcode = 5; /* VOL1 label correct, but invalid file-set format */ 1782 msg = 1783 "Volume ^a requires initialization: recorded in an invalid file-set format.^/Do you want to re-initialize it?"; 1784 1785 1786 ip_com: 1787 qi.yes_no = "1"b; 1788 qi.suppress_name = "0"b; 1789 1790 call command_query_ (addr (qi), answer, cseg.module, (msg), vl (vX).volname, extra1, extra2); 1791 1792 if answer = "yes" 1793 then return ("1"b); 1794 else return ("0"b); 1795 1796 end initialize_permit; 1797 1798 initialize_volume: 1799 procedure (vX, ecode); /* initializes a volume with VOL1 label and 1 dummy file */ 1800 dcl vX fixed bin, /* volume link index */ 1801 ecode fixed bin (35); /* error code */ 1802 dcl (i, j, k) fixed bin; /* temporary indices */ 1803 1804 if debug 1805 then call debug_print ("initialize_volume"); 1806 1807 vl (vX).auth_code = authenticate_ (vl (vX).volname); 1808 1809 vl (vX).cflX = 0; 1810 call tape_ansi_tape_io_$order (cP, "rew", 0, ecode); /* get to beginning of tape */ 1811 if ecode ^= 0 1812 then return; 1813 1814 ansi_vol1P, ibm_vol1P = addr (cseg.lbl_buf); /* get pointer to label buffer */ 1815 ansi_vol1.label_id = "VOL1"; /* initialize VOL1 label */ 1816 ansi_vol1.volume_id = vl (vX).canonical_volname; 1817 1818 if cseg.standard = 1 1819 then 1820 do; /* ANSI */ 1821 ansi_vol1.access = " "; 1822 ansi_vol1.reserved1 = " "; 1823 ansi_vol1.owner_id = vl (vX).auth_code; 1824 ansi_vol1.reserved2 = " "; 1825 ansi_vol1.label_version = "3"; 1826 k = 2; /* set HDR loop limit */ 1827 end; 1828 else 1829 do; /* IBM */ 1830 ibm_vol1.reserved1 = "0"; 1831 ibm_vol1.VTOC_pointer = " "; 1832 ibm_vol1.reserved2 = " "; 1833 ibm_vol1.owner_id = vl (vX).auth_code; 1834 ibm_vol1.reserved3 = " "; 1835 k = 1; /* set HDR loop limit */ 1836 end; 1837 1838 call write_label (ecode); /* write VOL1 label */ 1839 if ecode ^= 0 1840 then return; 1841 1842 do i = 1 to k; 1843 cseg.lbl_buf = l1id (i) || dummy_label (k); 1844 call write_label (ecode); /* write HDR1 / EOF1 label */ 1845 if ecode ^= 0 1846 then return; 1847 do j = 1 to 2; 1848 call tape_ansi_tape_io_$order (cP, "eof", 0, ecode); 1849 /* write 2 TM */ 1850 if ecode ^= 0 1851 then return; 1852 end; 1853 end; 1854 1855 return; 1856 1857 end initialize_volume; 1858 1859 lrec_open: 1860 procedure; /* logical record IO initialization and final checks */ 1861 if debug 1862 then call debug_print ("lrec_open"); 1863 dcl i fixed bin; 1864 1865 if cseg.open_mode > 4 1866 then if fd.blklen < 18 1867 then go to inv_blk; /* can't write < 18 chars */ 1868 if fd.mode = 3 1869 then cseg.mode = 0; /* binary encoding */ 1870 else cseg.mode = 1; /* ascii, ebcdic 9 mode hardware */ 1871 if cseg.standard > 1 1872 then go to ibm_open; 1873 1874 i = fd.blklen - fd.bo; /* get usable portion of block */ 1875 go to test (fd.format); /* test the blocking */ 1876 test (2): 1877 if ^fd.blocked 1878 then if i ^= fd.reclen 1879 then go to inv_rec; /* F unblocked */ 1880 else go to ok; 1881 else if mod (i, fd.reclen) ^= 0 1882 then go to inv_rec; /* F blocked */ 1883 else go to ok; 1884 test (3): 1885 if ^fd.blocked 1886 then if i ^= fd.reclen 1887 then go to inv_rec; /* D unblocked */ 1888 else go to ok; 1889 else if fd.reclen > i 1890 then go to inv_rec; /* D blocked */ 1891 else go to ok; 1892 test (4): 1893 match (4): 1894 if fd.reclen > sys_info$max_seg_size * 4 1895 then go to inv_rec; /* S format */ 1896 1897 test (1): 1898 match (1): 1899 ok: 1900 cseg.rlN = -1; /* invalidate anything in rl segment */ 1901 cseg.lrec.bufP = null; /* no active buffer */ 1902 if cseg.open_mode = 4 1903 then cseg.lrec.blkcnt = 0; /* input - no blocks processed */ 1904 else cseg.lrec.blkcnt = fl.blkcnt; /* output - set to 0 or EOX blkcnt for extend */ 1905 cseg.lrec.reccnt = 0; /* not currently used */ 1906 cseg.lrec.code = 0; /* no errors encountered */ 1907 call tape_ansi_tape_io_$open (cP); /* initialize call to tape_ansi_tape_io_ */ 1908 return; /* exit */ 1909 1910 inv_rec: 1911 code = error_table_$invalid_record_length; 1912 go to er_exit; 1913 inv_blk: 1914 code = error_table_$invalid_block_length; /* set error code */ 1915 go to er_exit; 1916 1917 ibm_open: 1918 if cseg.open_mode > 4 1919 then if mod (fd.blklen, 4) ^= 0 1920 then go to inv_blk; /* can only write words */ 1921 1922 1923 go to match (fd.format); /* match the blocking */ 1924 match (2): 1925 if ^fd.blocked 1926 then if fd.blklen ^= fd.reclen 1927 then go to inv_rec; /* F unblocked */ 1928 else go to ok; 1929 else if mod (fd.blklen, fd.reclen) ^= 0 1930 then go to inv_rec; /* F blocked */ 1931 else go to ok; 1932 match (3): 1933 if ^fd.blocked 1934 then if fd.blklen - 4 ^= fd.reclen 1935 then go to inv_rec; 1936 else go to ok; 1937 else if fd.reclen > fd.blklen - 4 1938 then go to inv_rec; /* V blocked */ 1939 else go to ok; 1940 1941 end lrec_open; 1942 1943 move_to_EOD: 1944 procedure; /* position after last data block of last section */ 1945 1946 if debug 1947 then call debug_print ("move_to_EOD"); 1948 do cseg.flP = cseg.flP repeat fl.nextP while (fl.eox = 2); 1949 /* set link pointer to last section */ 1950 end; 1951 1952 call move_tape_ (fl.vlX, fl.flX, 2, code); /* move to trailers */ 1953 if code ^= 0 1954 then go to er_exit; 1955 1956 call back_TM (1, code); /* move back into data */ 1957 if code ^= 0 1958 then go to er_exit; 1959 1960 return; 1961 1962 end move_to_EOD; 1963 1964 move_tape_: 1965 procedure (vX, fX, posit, ecode); /* positions to file section and intra-section position */ 1966 dcl vX fixed bin, /* volume link index of desired volume */ 1967 fX fixed bin, /* file link index of desired file */ 1968 posit fixed bin, /* position within file section */ 1969 ecode fixed bin (35); /* error code */ 1970 dcl (i, j) fixed bin, 1971 can_retry bit (1) init ("0"b); 1972 dcl uninit_msg (6) char (40) 1973 init ("is blank", "is unreadable", "is not formatted according to standard", 1974 "has volume identifier of", "is recorded at incorrect density", 1975 "is recorded in invalid file-set format"); 1976 1977 if debug 1978 then call debug_print ("move_tape_"); 1979 if vl (vX).rcp_id = 0 1980 then 1981 do; /* volume is not mounted */ 1982 if cseg.nactive < cseg.ndrives 1983 then 1984 do; /* more drives available */ 1985 call tape_ansi_mount_cntl_$mount (cP, vX, ecode); 1986 /* mount the volume */ 1987 if ecode ^= 0 1988 then 1989 do; /* maybe trouble */ 1990 if ecode = error_table_$device_limit_exceeded 1991 then 1992 do; 1993 cseg.ndrives = cseg.ndrives - 1; 1994 /* decrement maximum device count */ 1995 go to switch; 1996 end; 1997 else go to error; /* true trouble */ 1998 end; 1999 end; 2000 else 2001 do; /* no drive available */ 2002 switch: 2003 call find_candidate; /* get index (i) of volume to dismount */ 2004 call tape_ansi_mount_cntl_$remount (cP, i, vX, ecode); 2005 /* remount the volume */ 2006 if ecode ^= 0 2007 then go to error; /* trouble */ 2008 end; 2009 end; 2010 2011 cseg.tseg.drive_name = vl (vX).tape_drive; 2012 cseg.tseg.ev_chan = vl (vX).event_chan; 2013 2014 if cseg.open_mode = 4 2015 then /* open for read only */ 2016 vl (vX).write_VOL1 = max (vl (vX).write_VOL1, 0);/* bide time; don't try to update label now */ 2017 2018 if vl (vX).write_VOL1 ^= 0 2019 then 2020 do; /* VOL1 label missing or bad */ 2021 if (cseg.open_mode = 4) /* mounted read-only */ & (vl (vX).write_VOL1 ^= 4) 2022 /* and not just mismatched volid */ 2023 then 2024 do; /* volume needs relabeling and can't */ 2025 uninit_error: 2026 call ioa_ ("^a: Volume ^a ^a.", cseg.module, vl (vX).volname, uninit_msg (vl (vX).write_VOL1)); 2027 ecode = error_table_$uninitialized_volume; 2028 go to error; 2029 end; 2030 2031 if vX = 1 & ^creating_first () 2032 then if vl (vX).write_VOL1 < 0 2033 then vl (vX).write_VOL1 = 0; /* bide time, etc. */ 2034 else go to uninit_error; /* don't init 1st vol if not creating 1st file */ 2035 2036 if vl (vX).write_VOL1 > 1 2037 then if ^initialize_permit (vX) 2038 then 2039 do; /* tape isn't blank - no permission */ 2040 ecode = error_table_$uninitialized_volume; 2041 go to error; 2042 end; 2043 2044 if vl (vX).write_VOL1 ^= 0 2045 then /* needs better VOL1 label */ 2046 if cseg.open_mode ^= 4 2047 then 2048 do; /* don't do if read only-- if we're here, */ 2049 /* problem is insignificant anyway */ 2050 call initialize_volume (vX, ecode); 2051 if ecode ^= 0 2052 then go to error; 2053 end; 2054 2055 vl (vX).write_VOL1 = 0; /* VOL1 written - cflX = 0 */ 2056 end; 2057 2058 can_retry = "1"b; /* one retry permitted */ 2059 if vl (vX).cflX = 0 2060 then 2061 do; /* volume position unknown or in VOL/UVL set */ 2062 retry: 2063 call move_to_first_HDR; /* position tape to 1st_HDR HDR group */ 2064 vl (vX).cflX = vl (vX).fflX; /* volume positioned to 1st file section */ 2065 vl (vX).pos = 0; 2066 end; 2067 2068 if vl (vX).cflX < fX 2069 then 2070 do; /* volume positioned before desired file */ 2071 j = (fX - vl (vX).cflX) * 3; /* move over TM's */ 2072 j = j - vl (vX).pos + posit; /* adjust for intra-file offsets */ 2073 call move_forward; /* move j TM */ 2074 end; 2075 2076 else if vl (vX).cflX > fX 2077 then 2078 do; /* volume positioned after desired file */ 2079 j = ((vl (vX).cflX - fX) * 3) + 1; /* move over TM's */ 2080 j = j + vl (vX).pos - posit; /* adjust for intra-file offsets */ 2081 call move_backward; /* move j TM */ 2082 end; 2083 2084 else 2085 do; /* volume positioned at desired file */ 2086 if vl (vX).pos = posit 2087 then 2088 do; /* and at desired offset */ 2089 j = 1; /* really positions to 1st block after this TM */ 2090 call move_backward; /* really positions to beginning of TM group */ 2091 end; 2092 else if vl (vX).pos < posit 2093 then 2094 do; /* before desired offset */ 2095 j = posit - vl (vX).pos; 2096 call move_forward; /* move j TM */ 2097 end; 2098 else 2099 do; /* after desired section */ 2100 j = vl (vX).pos - posit + 1; /* move over TM's */ 2101 call move_backward; /* move j TM */ 2102 end; 2103 end; 2104 2105 ok_exit: 2106 vl (vX).cflX = fX; /* new position info */ 2107 vl (vX).pos = posit; 2108 return; 2109 2110 error: 2111 vl (vX).cflX = 0; /* we don't know where we are */ 2112 if can_retry 2113 then 2114 do; /* can we retry the move? */ 2115 can_retry = "0"b; /* yes - but only once */ 2116 go to retry; 2117 end; 2118 return; 2119 2120 find_candidate: 2121 procedure; /* find a volume to dismount */ 2122 if debug 2123 then call debug_print ("find_candidate"); 2124 2125 do i = 1 to vX - 1; /* search up to desired volume */ 2126 if vl (i).rcp_id ^= 0 2127 then return; /* got one active */ 2128 end; /* none preceding current link */ 2129 do i = cseg.vcN to vX + 1 by -1; /* search down to desired volume */ 2130 if vl (i).rcp_id ^= 0 2131 then return; /* got one active */ 2132 end; 2133 ecode = error_table_$invalid_cseg; /* something very wrong if no volume found */ 2134 go to error; 2135 2136 end find_candidate; 2137 2138 move_to_first_HDR: 2139 procedure; /* positions volume to 1st HDR label */ 2140 if debug 2141 then call debug_print ("move_to_first_HDR"); 2142 2143 call tape_ansi_tape_io_$order (cP, "rew", 0, ecode); /* rewind the volume */ 2144 if ecode ^= 0 2145 then go to error; 2146 HDR_search: 2147 call read_label (ecode); /* read a label */ 2148 if ecode ^= 0 2149 then 2150 do; /* trouble */ 2151 if ecode = error_table_$eof_record 2152 then ecode = error_table_$invalid_file_set_format; 2153 go to error; 2154 end; 2155 if label_type ^= "HDR" 2156 then go to HDR_search; /* read until 1st HDR */ 2157 call tape_ansi_tape_io_$order (cP, "bsr", 0, ecode); /* get back to beginning of HDR */ 2158 if ecode ^= 0 2159 then go to error; 2160 return; 2161 2162 move_forward: 2163 entry; /* position j TM sections forward */ 2164 do i = 1 to j; 2165 call tape_ansi_tape_io_$order (cP, "fsf", 0, ecode); 2166 /* move forward 1 TM */ 2167 if ecode ^= 0 2168 then go to error; 2169 end; 2170 return; 2171 2172 move_backward: 2173 entry; /* position j TM sections backward */ 2174 do i = 1 to j - 1; /* do all but last */ 2175 call tape_ansi_tape_io_$order (cP, "bsf", 0, ecode); 2176 /* backspace 1 TM */ 2177 if ecode ^= 0 2178 then go to error; 2179 end; 2180 2181 call tape_ansi_tape_io_$order (cP, "bsf", 0, ecode); /* do last */ 2182 if ecode = error_table_$positioned_on_bot 2183 then go to HDR_search; 2184 else if ecode ^= 0 2185 then go to error; 2186 call tape_ansi_tape_io_$order (cP, "fsf", 0, ecode); /* position to record after TM */ 2187 if ecode ^= 0 2188 then go to error; 2189 return; 2190 2191 move_to_first_UHL: 2192 entry; /* position to 1st UHL */ 2193 i = 1; 2194 go to UL_search; 2195 move_to_first_UTL: 2196 entry; /* position to 1st UTL */ 2197 i = 2; 2198 UL_search: 2199 call read_label (ecode); /* read a label */ 2200 if ecode = error_table_$eof_record 2201 then call tape_ansi_tape_io_$order (cP, "bsf", 0, ecode); 2202 /* EOF */ 2203 else if ecode ^= 0 2204 then go to error; 2205 else if label_type ^= UL (i) 2206 then go to UL_search; /* not a user label */ 2207 else call tape_ansi_tape_io_$order (cP, "bsr", 0, ecode); 2208 /* got it */ 2209 if ecode ^= 0 2210 then go to error; 2211 return; 2212 2213 end move_to_first_HDR; 2214 2215 end move_tape_; 2216 2217 next_volume: 2218 procedure returns (bit (1)); /* determines if volume switch possible */ 2219 2220 dcl canon_std (2) fixed bin initial (Volume_ansi_tape, Volume_ibm_tape); 2221 2222 if debug 2223 then call debug_print ("next_volume"); 2224 2225 if fl.vlX < cseg.vcN 2226 then return ("1"b); /* if current vlX < vcN then next exists */ 2227 2228 if fl.vlX = 63 2229 then 2230 do; /* volume chain full */ 2231 call ioa_ ("^a: Implementation limit of 63 volumes exceeded.", cseg.module); 2232 return ("0"b); 2233 end; 2234 2235 if fl.system = fd.system 2236 then 2237 do; /* trailers could have next reel id */ 2238 if fl.next_volname ^= "" 2239 then 2240 do; /* they do */ 2241 vn = fl.next_volname; /* copy it */ 2242 go to got_volname; /* use it */ 2243 end; 2244 end; 2245 2246 if another_volume () 2247 then vl (cseg.vcN + 1).comment = com_text; /* yes */ 2248 else return ("0"b); /* no */ 2249 2250 got_volname: 2251 cseg.vcN = cseg.vcN + 1; /* increment volume link count */ 2252 call vl_init (cseg.vcN); 2253 vl (cseg.vcN).volname = vn; /* set reel id in volume link */ 2254 call 2255 canon_for_volume_label_ (VOLUME_TYPE (TAPE_VOL_VTYPEX), vl (cseg.vcN).volname, vl (cseg.vcN).canonical_volname, 2256 canon_std (cseg.standard), code); 2257 if code ^= 0 2258 then return ("0"b); 2259 2260 return ("1"b); 2261 2262 end next_volume; 2263 2264 process_EOX: 2265 procedure (ecode); /* processes trailer labels for file chain */ 2266 dcl ecode fixed bin (35); 2267 2268 dcl canon_std (2) fixed bin initial (Volume_ansi_tape, Volume_ibm_tape); 2269 2270 if debug 2271 then call debug_print ("process_EOX"); 2272 on conversion go to bad_EOX; 2273 fl.eox = 0; /* trailers not yet processed */ 2274 ansi_hdr1P, ansi_hdr2P = addr (lbl_buf); /* set pointers to label IO buffer */ 2275 2276 call read_label (ecode); /* read EOX1 label */ 2277 2278 if ecode ^= 0 2279 then 2280 do; /* trouble */ 2281 if ecode = error_table_$eof_record 2282 then /* label missing */ 2283 bad: 2284 ecode = error_table_$invalid_file_set_format; 2285 return; 2286 end; 2287 2288 if ansi_hdr1.label_id = "EOV1" 2289 then fl.eox = 2; /* indicate volume switch */ 2290 else if ansi_hdr1.label_id = "EOF1" 2291 then fl.eox = 1; /* no volume switch */ 2292 else go to bad; /* error if not EOF or EOV */ 2293 2294 fl.creation = substr (ansi_hdr1.creation, 2, 5); /* update creation date to latest */ 2295 2296 fl.version = fixed (ansi_hdr1.version, 17); /* update version to latest */ 2297 2298 fl.blkcnt = fixed (ansi_hdr1.blkcnt, 35); /* save block count */ 2299 2300 call read_label (ecode); /* read next label (EOX2 or otherwise) */ 2301 2302 if ecode ^= 0 2303 then 2304 do; /* investigate */ 2305 if ecode = error_table_$eof_record 2306 then 2307 do; /* no EOX2 label */ 2308 call tape_ansi_tape_io_$order (cP, "bsf", 0, ecode); 2309 /* backspace into trailer set */ 2310 if ecode ^= 0 2311 then return; 2312 no_EOX2: 2313 if fl.eox = 2 2314 then 2315 do; /* EOV label */ 2316 if next_volume () 2317 then fl.next_volname = vl (fl.vlX + 1).volname; 2318 /* have volume */ 2319 else ecode = error_table_$no_next_volume; 2320 end; 2321 end; 2322 return; 2323 end; 2324 2325 if label_type = "UTL" 2326 then go to no_EOX2; /* user label - no EOX2 */ 2327 if ansi_hdr2.label_id ^= l2id (fl.eox + 1) 2328 then go to bad; /* label not EOF2 or EOV2 */ 2329 2330 if fl.eox = 2 2331 then 2332 do; /* EOV labels */ 2333 if cseg.standard = 1 2334 then if fl.system = fd.system 2335 then if old_ansi_hdr2_system_use.system_reserved ^= "" 2336 then 2337 do; 2338 fl.next_volname = ansi_hdr2.next_volname; 2339 call 2340 canon_for_volume_label_ (VOLUME_TYPE (TAPE_VOL_VTYPEX), fl.next_volname, 2341 fl.canonical_next_volname, canon_std (cseg.standard), ecode); 2342 if ecode ^= 0 2343 then goto bad_EOX; 2344 end; 2345 2346 if next_volume () 2347 then 2348 do; /* allow for -volume override */ 2349 fl.next_volname = vl (fl.vlX + 1).volname; 2350 fl.canonical_next_volname = vl (fl.vlX + 1).canonical_volname; 2351 end; 2352 else ecode = error_table_$no_next_volume; 2353 end; 2354 2355 return; 2356 2357 bad_EOX: 2358 ecode = error_table_$invalid_label_format; 2359 return; 2360 2361 end process_EOX; 2362 2363 read_HDR1: 2364 procedure (eofsw, ecode); /* read HDR1 label (if any) */ 2365 dcl eofsw bit (1); /* end-of-file-set bit */ 2366 dcl ecode fixed bin (35); 2367 2368 if debug 2369 then call debug_print ("read_HDR1"); 2370 eofsw = "0"b; /* initialize */ 2371 ansi_hdr1P, ibm_hdr1P = addr (cseg.lbl_buf); /* set pointer to label */ 2372 2373 call read_label (ecode); /* read it */ 2374 2375 if ecode = 0 2376 then 2377 do; /* read something ok */ 2378 if ansi_hdr1.label_id ^= "HDR1" 2379 then 2380 do; /* the something wasn't what we wanted */ 2381 ecode = error_table_$invalid_file_set_format; 2382 return; 2383 end; 2384 end; 2385 2386 else if ecode = error_table_$eof_record 2387 then 2388 do; /* read a TM */ 2389 vl (fl.vlX).pos = vl (fl.vlX).pos + 1; /* increment position count */ 2390 call back_TM (1, ecode); /* backup over it */ 2391 if ecode = 0 2392 then eofsw = "1"b; /* set the eofs bit */ 2393 end; 2394 2395 return; 2396 2397 end read_HDR1; 2398 2399 2400 read_HDR2: 2401 procedure (ecode); /* read HDR2 label (if any) */ 2402 dcl ecode fixed bin (35); 2403 2404 if debug 2405 then call debug_print ("read_HDR2"); 2406 fl.HDR2 = "0"b; /* HDR2 not yet processed */ 2407 ansi_hdr2P, ibm_hdr2P = addr (cseg.lbl_buf); /* get pointer to label */ 2408 2409 call read_label (ecode); /* read it */ 2410 2411 if ecode = 0 2412 then 2413 do; /* read something ok */ 2414 if ansi_hdr2.label_id = "HDR2" 2415 then fl.HDR2 = "1"b; /* something was HDR2 */ 2416 else ; /* something wasn't */ 2417 end; 2418 2419 else if ecode = error_table_$eof_record 2420 then 2421 do; /* went over TM */ 2422 vl (fl.vlX).pos = vl (fl.vlX).pos + 1; /* increment position count */ 2423 call back_TM (1, ecode); /* backup over it */ 2424 end; 2425 2426 return; 2427 2428 end read_HDR2; 2429 2430 read_label: 2431 procedure (ecode); /* reads an 80 character label synchronously */ 2432 dcl ecode fixed bin (35), 2433 nchar fixed bin; 2434 2435 call tape_ansi_tape_io_$sync_read (cP, nchar, ecode); /* read a block */ 2436 2437 if ecode = 0 2438 then 2439 do; /* read was uneventful */ 2440 if nchar < 80 2441 then 2442 do; /* definitely not a label */ 2443 ecode = error_table_$invalid_label_format; 2444 return; 2445 end; 2446 else 2447 do; /* probably a label */ 2448 if cseg.standard = 1 2449 then cseg.lbl_buf = sync_buf; /* move into label buffer */ 2450 else call ebcdic_to_ascii_ (sync_buf, cseg.lbl_buf); 2451 /* convert to ascii and move */ 2452 end; 2453 end; 2454 2455 if debug 2456 then 2457 do; 2458 if ecode = 0 2459 then call ioa_ ("^80a", lbl_buf); 2460 else call ioa_ ("^d", ecode); 2461 end; 2462 return; /* with ecode = 0, EOF, or error */ 2463 2464 2465 write_label: 2466 entry (ecode); 2467 2468 if cseg.standard = 1 2469 then sync_buf = cseg.lbl_buf; /* ascii - move it */ 2470 else call ascii_to_ebcdic_ (cseg.lbl_buf, sync_buf); /* ebcdic - convert and move */ 2471 2472 call tape_ansi_tape_io_$sync_write (cP, 80, ecode); /* write it */ 2473 2474 if debug 2475 then call ioa_ ("^d^-^80a", ecode, lbl_buf); 2476 return; /* with ecode = 0, EOT, or error */ 2477 2478 end read_label; 2479 2480 setup_for_create: 2481 procedure; /* fills file link from file data (mostly) */ 2482 if debug 2483 then call debug_print ("setup_for_create"); 2484 2485 fl.file_id = fd.file_id; /* use creation name */ 2486 fl.set_id = fl.backP -> fl.set_id; 2487 fl.canonical_set_id = fl.backP -> fl.canonical_set_id; 2488 fl.section = 1; 2489 fl.sequence = fd.sequence; 2490 if cseg.standard = 1 2491 then fl.generation = 1; 2492 else fl.generation = 0; 2493 fl.version = 0; 2494 fl.creation = fd.creation; 2495 fl.expiration = fd.expiration; 2496 fl.access = fd.access; 2497 fl.blkcnt = 0; 2498 fl.system = fd.system; 2499 2500 call fill_flhdr2_from_fd; /* fill fl HDR2 from fd and defaults */ 2501 2502 return; 2503 2504 end setup_for_create; 2505 2506 2507 setup_for_extend_modify: 2508 procedure; /* fills file data from file link */ 2509 if debug 2510 then call ioa_ ("setup_for_extend_modify"); 2511 2512 fd.file_id = fl.file_id; /* copy HDR1 data */ 2513 fd.sequence = fl.sequence; 2514 if cseg.standard = 1 2515 then fl.version = mod (fl.version + 1, 100); /* if ANSI, up version */ 2516 fl.creation = fd.creation; 2517 if cseg.output_mode = 2 2518 then fl.blkcnt = 0; /* zero block count for modify */ 2519 else ; /* maintain block count for extend */ 2520 2521 call fill_fdhdr2_from_fl; /* put hdr2 data from fl, if any, into fd */ 2522 call fill_flhdr2_from_fd; /* put fd hdr2 data into fl, _n_o defaults */ 2523 2524 return; 2525 2526 end setup_for_extend_modify; 2527 2528 setup_for_read: 2529 procedure; /* tries to complete file data from file link on input */ 2530 if debug 2531 then call debug_print ("setup_for_read"); 2532 2533 fd.file_id = fl.file_id; /* copy HDR1 data */ 2534 fd.sequence = fl.sequence; 2535 2536 if fd.format = 0 2537 then 2538 do; /* no explicit format */ 2539 fd.format = fl.format; 2540 if fd.format = 0 2541 then 2542 do; 2543 not_enough: 2544 code = error_table_$insufficient_open; 2545 go to er_exit; 2546 end; 2547 format_override = "0"b; /* file data does not override link data */ 2548 end; 2549 else format_override = "1"b; /* explicit format */ 2550 2551 if fd.blklen = 0 2552 then fd.blklen = fl.blklen; 2553 if fd.blklen = 0 2554 then go to not_enough; 2555 2556 if fd.reclen = 0 2557 then fd.reclen = fl.reclen; 2558 if fd.reclen = 0 2559 then 2560 do; /* this may be valid */ 2561 if fd.format = 4 2562 then fd.reclen = sys_info$max_seg_size * 4; /* S or V(B)S */ 2563 else if fd.format = 1 2564 then ; /* U format - reclen undefined */ 2565 else go to not_enough; 2566 end; 2567 2568 if cseg.standard = 1 2569 then 2570 do; /* ANSI */ 2571 if fl.system ^= "" 2572 then fd.bo = fl.bo; /* set buffer offset if HDR1 has it */ 2573 if fl.system = fd.system 2574 then 2575 do; /* file written by this system? */ 2576 if ^format_override 2577 then fd.blocked = fl.blocked; /* set blocked attribute from labels */ 2578 if fd.mode = 0 2579 then fd.mode = fl.mode; /* set encoding mode from labels */ 2580 end; 2581 else 2582 do; /* system-defined fields are invalid - apply defaults */ 2583 if ^format_override 2584 then fd.blocked = "1"b; /* blocked */ 2585 if fd.mode = 0 2586 then fd.mode = 1; /* ascii */ 2587 end; 2588 end; 2589 else 2590 do; /* IBM */ 2591 if ^format_override 2592 then fd.blocked = fl.blocked; 2593 if fd.mode = 0 2594 then fd.mode = 2; /* EBCDIC */ 2595 end; 2596 2597 return; 2598 2599 end setup_for_read; 2600 2601 setup_for_generate: 2602 procedure; /* updates file link and fills file data */ 2603 if debug 2604 then call debug_print ("setup_for_generate"); 2605 2606 fd.file_id = fl.file_id; 2607 fd.sequence = fl.sequence; 2608 2609 fl.generation = mod (fl.generation + 1, 10000); /* increment generation number */ 2610 fl.version = 0; 2611 fl.creation = fd.creation; /* use today's date */ 2612 fl.expiration = fd.expiration; /* use specified expiration date */ 2613 fl.access = fd.access; 2614 fl.blkcnt = 0; 2615 2616 call fill_fdhdr2_from_fl; /* put fl hdr2 data, if any, into fd */ 2617 call fill_flhdr2_from_fd; /* put fd hdr2 data into fl, _n_o defaults */ 2618 2619 fl.system = fd.system; /* set now to use system-defined HDR2 fields */ 2620 2621 return; 2622 2623 end setup_for_generate; 2624 2625 truncate_chains: 2626 procedure; /* eliminate chain references to overwritten files */ 2627 if debug 2628 then call debug_print ("truncate_chains"); 2629 2630 dcl i fixed bin, /* temporary index into volume chain */ 2631 saveP ptr, /* holds pointer to desired file link */ 2632 zaP ptr; /* file chain truncation pointer */ 2633 2634 if fl.nextP = null 2635 then return; /* nothing to truncate */ 2636 2637 on cleanup 2638 begin; /* don't leave chains inconsistent */ 2639 cseg.fcP -> fl.nextP = null; /* truncate file chain entirely (leave dummy) */ 2640 do i = 1 to cseg.vcN; /* wipe the volume chain clean of file link references */ 2641 vl (i).fflX = 0; 2642 vl (i).cflX = 0; 2643 vl (i).lflX = 0; 2644 end; 2645 end; 2646 2647 saveP = cseg.flP; /* save pointer to desired file link */ 2648 cseg.flP = fl.nextP; /* begin truncation after current link */ 2649 fl.backP -> fl.nextP = null; /* step 1 - file chain logically truncated */ 2650 if fl.flX = -1 2651 then go to free; /* only truncate an eofsl */ 2652 2653 if vl (fl.vlX).fflX = fl.flX 2654 then 2655 do; /* truncated files start a volume */ 2656 vl (fl.vlX).fflX = 0; /* wipe that volume clean */ 2657 vl (fl.vlX).cflX = 0; 2658 vl (fl.vlX).lflX = 0; 2659 end; 2660 else vl (fl.vlX).lflX = fl.flX - 1; /* or, last valid reference is before truncation point */ 2661 2662 do i = fl.vlX + 1 to cseg.vcN; /* all subsequent volumes must be emptied */ 2663 vl (i).fflX = 0; 2664 vl (i).cflX = 0; 2665 vl (i).lflX = 0; 2666 end; /* step 2 - volume chain adjusted */ 2667 2668 revert cleanup; /* drastic measures no longer needed */ 2669 2670 free: 2671 zaP = cseg.flP; /* set pointer to truncation point */ 2672 do cseg.flP = cseg.flP repeat zaP while (zaP ^= null);/* step 3 - free file chain storage */ 2673 zaP = fl.nextP; /* set pointer to next truncation point */ 2674 free fl in (chain_area); /* free link at current truncation point */ 2675 end; 2676 2677 exit: 2678 cseg.flP = saveP; /* restore pointer to last valid link */ 2679 2680 return; 2681 2682 end truncate_chains; 2683 2684 vl_init: 2685 procedure (n); /* initialize a volume link */ 2686 dcl n fixed bin; /* link index */ 2687 vl (n).fflX = 0; 2688 vl (n).cflX = 0; 2689 vl (n).pos = 0; 2690 vl (n).lflX = 0; 2691 vl (n).tracks = 0; 2692 vl (n).density = 0; 2693 vl (n).label_type = 0; 2694 vl (n).usage_count = 0; 2695 vl (n).read_errors = 0; 2696 vl (n).write_errors = 0; 2697 vl (n).rcp_id = 0; 2698 vl (n).event_chan = 0; 2699 vl (n).tape_drive = ""; 2700 vl (n).write_VOL1 = 0; 2701 vl (n).ioi_index = 0; 2702 return; 2703 end vl_init; 2704 2705 write_HDRs: 2706 procedure (ecode); /* formats and writes HDR1 and HDR2 */ 2707 if debug 2708 then call debug_print ("write_HDRs"); 2709 2710 dcl ecode fixed bin (35); /* error code */ 2711 dcl x fixed bin; /* entry index */ 2712 2713 fl.eox = 0; /* trailers not yet written */ 2714 x = 1; 2715 go to write_labels; 2716 2717 write_EOFs: 2718 entry (ecode); /* formats and writes EOF1 and EOF2 */ 2719 if debug 2720 then call debug_print ("write_EOFs"); 2721 fl.blkcnt = cseg.blkcnt; /* update block count */ 2722 fl.eox = 1; /* no volume switch */ 2723 x = 2; 2724 go to write_labels; 2725 2726 write_EOVs: 2727 entry (ecode); /* formats and writes EOV1 and EOV2 */ 2728 if debug 2729 then call debug_print ("write_EOVs"); 2730 fl.blkcnt = cseg.blkcnt; /* update block count */ 2731 fl.eox = 2; /* volume switch */ 2732 x = 3; 2733 2734 write_labels: 2735 call fill_XXX1 (x); /* format label as HDR1, EOF1, or EOV1 */ 2736 call write_label (ecode); /* write it */ 2737 if ecode ^= 0 2738 then if ecode ^= error_table_$eov_on_write 2739 then return; /* check error code */ 2740 2741 if x = 1 2742 then fl.HDR2 = "1"b; /* request is for headers, so HDR2 exists */ 2743 else 2744 do; /* request is for trailers */ 2745 if ^fl.HDR2 2746 then 2747 do; /* no HDR2 label */ 2748 ecode = 0; /* therefore, no EOX2 label */ 2749 return; 2750 end; 2751 end; 2752 2753 call fill_XXX2 (x); /* format label as HDR2, EOF2, or EOV2 */ 2754 call write_label (ecode); /* write it */ 2755 if ecode = error_table_$eov_on_write 2756 then ecode = 0; /* ignore EOT */ 2757 2758 return; /* with ecode = 0 or an error code */ 2759 2760 end write_HDRs; 2761 2762 write_TM: 2763 procedure (n, ecode); /* writes 1 or 2 TM and adjusts volume link */ 2764 dcl n fixed bin, /* number of TM - 1 or 2 */ 2765 cnt fixed bin, 2766 ecode fixed bin (35); 2767 2768 if debug 2769 then call ioa_ ("write_TM ^d", n); 2770 do cnt = 1 to n; /* 1 or 2 */ 2771 call tape_ansi_tape_io_$order (cP, "eof", 0, ecode); 2772 /* write a TM */ 2773 if ecode ^= 0 2774 then if ecode ^= error_table_$eov_on_write 2775 then return; /* error exit */ 2776 2777 vl (fl.vlX).pos = vl (fl.vlX).pos + 1; /* increment for each TM */ 2778 if vl (fl.vlX).pos > 2 2779 then 2780 do; /* adjust mod3 */ 2781 vl (fl.vlX).pos = vl (fl.vlX).pos - 3; 2782 vl (fl.vlX).cflX = vl (fl.vlX).cflX + 1; 2783 end; 2784 end; 2785 2786 return; 2787 2788 end write_TM; 2789 2790 write_new_section: 2791 procedure (ecode); /* writes new section headers */ 2792 dcl ecode fixed bin (35); 2793 2794 if debug 2795 then call debug_print ("write_new_section"); 2796 cseg.flP = fl.nextP; /* set pointer to next (eofs) link */ 2797 call make_eofsl_real; /* make it a real link */ 2798 2799 call build_eofsl; /* add a new end-of-file-set link */ 2800 2801 call move_tape_ (fl.vlX, fl.flX, 0, ecode); /* position to write headers */ 2802 if ecode ^= 0 2803 then return; /* trouble */ 2804 2805 ansi_hdr1P = addr (cseg.lbl_buf); /* set pointer to label buffer - move_tape_ read HDR1 */ 2806 if substr (ansi_hdr1.expiration, 2, 5) > fd.creation 2807 then 2808 do; /* volume has unexpired data */ 2809 if initialize_permitA (fl.vlX) 2810 then 2811 do; /* user said can re-initialize */ 2812 call initialize_volume (fl.vlX, ecode); /* do it */ 2813 if ecode ^= 0 2814 then return; 2815 call move_tape_ (fl.vlX, fl.flX, 0, ecode); 2816 /* re-position to HDR1 */ 2817 if ecode ^= 0 2818 then return; 2819 end; 2820 else 2821 do; /* user said can't */ 2822 ecode = error_table_$unexpired_volume; 2823 return; 2824 end; 2825 end; 2826 2827 call fill_new_section_fl; /* initialize the link */ 2828 2829 call write_HDRs (ecode); /* write HDR labels */ 2830 if ecode ^= 0 2831 then return; 2832 2833 /* if cseg.user_labels then call write_UHL; */ 2834 2835 call write_TM (1, ecode); /* write header set TM */ 2836 2837 return; 2838 2839 end write_new_section; 2840 2841 data_eof: 2842 entry (iocbP, code); /* called by lrec IO when encounters EOF */ 2843 2844 if debug 2845 then call debug_print ("data_eof"); 2846 cP = iocbP -> iocb.actual_iocb_ptr -> iocb.attach_data_ptr; 2847 /* get control segment pointer */ 2848 2849 cc = 0; /* minimal consistency requirement */ 2850 on cleanup go to data_eof_fail; 2851 on area 2852 begin; /* handle the condition */ 2853 code = error_table_$noalloc; 2854 go to data_eof_fail; 2855 end; 2856 2857 vl (fl.vlX).pos = vl (fl.vlX).pos + 1; /* have moved over a TM - update position info */ 2858 2859 if cseg.standard = 1 2860 then call tape_ansi_lrec_io_$close (cP, code); /* close logical record IO */ 2861 else call tape_ansi_ibm_lrec_io_$close (cP, code); 2862 if code ^= 0 2863 then 2864 do; 2865 data_eof_fail: 2866 call consistent; 2867 go to close_exit; 2868 end; 2869 2870 if fl.eox = 0 2871 then 2872 do; /* trailer labels have not been processed */ 2873 call process_EOX (code); /* process them */ 2874 if code ^= 0 2875 then go to data_eof_fail; 2876 end; 2877 2878 if cseg.blkcnt ^= -1 2879 then 2880 do; /* block count is valid */ 2881 if cseg.blkcnt ^= fl.blkcnt 2882 then 2883 do; /* read and recorded don't agree */ 2884 code = error_table_$discrepant_block_count; 2885 return; 2886 end; 2887 end; 2888 2889 /* if cseg.user_labels then call read_UTL */ 2890 2891 if fl.eox = 1 2892 then 2893 do; /* last (or only) section */ 2894 code = error_table_$end_of_info; 2895 return; 2896 end; 2897 2898 if fl.nextP ^= null 2899 then cseg.flP = fl.nextP; /* next link exists - use it */ 2900 else 2901 do; /* link doesn't exist - make it */ 2902 cc = 1; /* insure chain consistency */ 2903 call build1 (code); /* process HDR labels */ 2904 if code ^= 0 2905 then go to data_eof_fail; 2906 cc = 0; /* minimal consistency requirement */ 2907 end; 2908 2909 if fl.flX = -1 2910 then 2911 do; /* link is eofsl */ 2912 code = error_table_$invalid_file_set_format; 2913 cseg.flP = fl.backP; /* get back to last valid link */ 2914 go to data_eof_fail; 2915 end; 2916 2917 if fl.file_id ^= fl.backP -> fl.file_id | /* file id's must be identical */ fl.section ^= fl.backP -> fl.section + 1 2918 then 2919 do; /* section must be 1 > than previous */ 2920 code = error_table_$invalid_volume_sequence; 2921 cseg.flP = fl.backP; 2922 go to data_eof_fail; 2923 end; 2924 2925 /* if cseg.user_labels then call read_UHL */ 2926 2927 call move_tape_ (fl.vlX, fl.flX, 1, code); /* move to data of new section */ 2928 if code ^= 0 2929 then go to data_eof_fail; 2930 2931 cseg.blkcnt = 0; /* re-initialize block count for new section */ 2932 2933 return; 2934 2935 data_eot: 2936 entry (iocbP, code); /* called by lrec IO when encounters EOT */ 2937 2938 if debug 2939 then call debug_print ("data_eot"); 2940 cP = iocbP -> iocb.actual_iocb_ptr -> iocb.attach_data_ptr; 2941 /* get pointer to control segment */ 2942 2943 cc = 2; /* don't leave defective tape file */ 2944 on cleanup go to write_data_fail; 2945 2946 eot_not_while_closing: 2947 close_eot = "0"b; /* eot doing data or positioning for output */ 2948 go to any_eot; 2949 eot_while_closing: 2950 close_eot = "1"b; /* eot writing HDR TM for null file */ 2951 2952 any_eot: 2953 on area 2954 begin; /* common code - EOT doing data or HDR TM */ 2955 code = error_table_$noalloc; 2956 go to write_data_fail; 2957 end; 2958 2959 if ^next_volume () 2960 then 2961 do; /* no next volume available */ 2962 code = error_table_$no_next_volume; 2963 if ^close_eot 2964 then return; /* exit gracefully */ 2965 else go to write_data_fail; /* abort the file fragment */ 2966 end; 2967 else 2968 do; /* volume available - set reel id in trailers */ 2969 fl.next_volname = vl (fl.vlX + 1).volname; 2970 fl.canonical_next_volname = vl (fl.vlX + 1).canonical_volname; 2971 end; 2972 2973 /* finish current volume, switch to new file section on new volume */ 2974 2975 call write_TM (1, code); /* write end-of-data TM */ 2976 if code ^= 0 2977 then if code ^= error_table_$eov_on_write 2978 then 2979 do; 2980 write_data_fail: 2981 call consistent; 2982 go to close_exit; /* force close */ 2983 end; 2984 2985 call write_EOVs (code); /* write EOV labels */ 2986 if code ^= 0 2987 then go to write_data_fail; 2988 2989 /* if cseg.user_labels then call write_UTL; */ 2990 2991 call write_TM (2, code); /* write trailer and end of volume TMs */ 2992 if code ^= 0 2993 then if code ^= error_table_$eov_on_write 2994 then go to write_data_fail; 2995 2996 call write_new_section (code); /* begin new file section */ 2997 if code ^= 0 2998 then go to write_data_fail; 2999 3000 cseg.lrec.blkcnt = 0; /* initialize block count for new section */ 3001 3002 if close_eot 3003 then go to continue_close; /* finish the close operation */ 3004 else return; 3005 3006 position_for_output: 3007 entry (iocbP, code); /* called by 1st write_record to write HDR TM */ 3008 3009 cP = iocbP -> iocb.actual_iocb_ptr -> iocb.attach_data_ptr; 3010 /* get pointer to control segment */ 3011 if debug 3012 then call debug_print ("position_for_output"); 3013 3014 cc = 2; /* don't leave defective tape file */ 3015 on cleanup go to write_data_fail; 3016 3017 /* if cseg.user_labels then call write_UHL; */ 3018 3019 call write_TM (1, code); /* write HDR TM */ 3020 3021 if code = 0 3022 then return; /* fine - not even end-of-tape */ 3023 if code = error_table_$eov_on_write 3024 then go to eot_not_while_closing; /* end-of-tape */ 3025 go to write_data_fail; /* trouble */ 3026 3027 3028 3029 beginning_of_file: 3030 entry (iocbP, code); /* positions to beginning of file */ 3031 3032 cP = iocbP -> iocb.actual_iocb_ptr -> iocb.attach_data_ptr; 3033 /* get pointer to control segment */ 3034 3035 cc = 0; /* minimal consistency requirement */ 3036 on cleanup go to bof_fail; 3037 3038 if cseg.standard = 1 3039 then call tape_ansi_lrec_io_$close (cP, code); /* close logical record I/O */ 3040 else call tape_ansi_ibm_lrec_io_$close (cP, code); 3041 if code ^= 0 3042 then go to bof_fail; 3043 3044 do cseg.flP = cseg.flP repeat fl.backP while (fl.section ^= 1); 3045 /* get back to first file section */ 3046 end; 3047 3048 call move_tape_ (fl.vlX, fl.flX, 1, code); /* position to 1st data record */ 3049 if code ^= 0 3050 then 3051 do; /* trouble - maintain consistency */ 3052 bof_fail: 3053 call consistent; 3054 go to close_exit; 3055 end; 3056 3057 call lrec_open; /* open logical record I/O */ 3058 /* note: no error can occur */ 3059 3060 return; 3061 3062 end_of_file: 3063 entry (iocbP, code); /* positions to end of file */ 3064 3065 cP = iocbP -> iocb.actual_iocb_ptr -> iocb.attach_data_ptr; 3066 /* get control segment pointer */ 3067 3068 cc = 0; /* minimal consistency requirement */ 3069 on cleanup go to eof_fail; 3070 on area go to eof_fail; 3071 3072 if cseg.standard = 1 3073 then call tape_ansi_lrec_io_$close (cP, code); /* close logical record IO */ 3074 else call tape_ansi_ibm_lrec_io_$close (cP, code); 3075 if code ^= 0 3076 then 3077 do; 3078 eof_fail: 3079 call consistent; 3080 go to close_exit; 3081 end; 3082 3083 cseg.rlN = -1; /* invalidate read_length buffer */ 3084 cseg.blkcnt = -1; /* invalidate block count */ 3085 3086 eof_loop: 3087 if fl.eox = 0 3088 then 3089 do; /* trailer labels have not been processed */ 3090 call build2 (code); /* process them */ 3091 if code ^= 0 3092 then go to eof_fail; 3093 end; 3094 3095 if fl.eox = 1 3096 then 3097 do; /* last (or only) section */ 3098 call move_tape_ (fl.vlX, fl.flX, 2, code); /* position to trailers */ 3099 if code ^= 0 3100 then go to eof_fail; 3101 call back_TM (1, code); /* get back into data */ 3102 if code ^= 0 3103 then go to eof_fail; 3104 return; 3105 end; 3106 3107 if fl.nextP ^= null 3108 then cseg.flP = fl.nextP; /* next link exists - use it */ 3109 else 3110 do; /* link doesn't exist - make it */ 3111 cc = 1; /* insure chain consistency */ 3112 call build1 (code); /* process HDR labels */ 3113 if code ^= 0 3114 then go to eof_fail; 3115 cc = 0; /* minimal consistency requirement */ 3116 end; 3117 3118 if fl.flX = -1 3119 then 3120 do; /* link is eofsl */ 3121 code = error_table_$invalid_file_set_format; 3122 cseg.flP = fl.backP; /* get back to last valid link */ 3123 go to eof_fail; 3124 end; 3125 3126 if fl.file_id ^= fl.backP -> fl.file_id | /* file id's must be identical */ fl.section ^= fl.backP -> fl.section + 1 3127 then 3128 do; /* section must be 1 > previous */ 3129 code = error_table_$invalid_volume_sequence; 3130 cseg.flP = fl.backP; 3131 go to eof_fail; 3132 end; 3133 go to eof_loop; 3134 3135 close: 3136 entry (iocbP, code); /* iox_$close entry */ 3137 3138 cP = iocbP -> iocb.actual_iocb_ptr -> iocb.attach_data_ptr; 3139 /* get control segment pointer */ 3140 3141 if cseg.file_lock 3142 then 3143 do; /* file in use? */ 3144 code = error_table_$file_busy; 3145 return; 3146 end; 3147 else 3148 do; 3149 on cleanup cseg.file_lock = "0"b; 3150 cseg.file_lock = "1"b; 3151 end; 3152 3153 if cseg.invalid 3154 then 3155 do; 3156 code = error_table_$invalid_cseg; 3157 on cleanup go to close_exit1; 3158 go to close_exit1; 3159 end; 3160 3161 if cseg.open_mode = 4 3162 then 3163 do; /* input mode */ 3164 cc = 0; /* minimal consistency requirement */ 3165 on cleanup go to close_fail; 3166 if cseg.standard = 1 3167 then call tape_ansi_lrec_io_$close (cP, code); /* close logical record IO */ 3168 else call tape_ansi_ibm_lrec_io_$close (cP, code); 3169 if code ^= 0 3170 then call consistent; 3171 go to close_exit; 3172 end; 3173 else 3174 do; /* output mode */ 3175 cc = 2; /* don't leave defective tape file */ 3176 on cleanup go to close_fail; 3177 if vl (fl.vlX).pos = 0 3178 then 3179 do; /* still in HDRs, never wrote data */ 3180 call write_TM (1, code); /* re-write HDR TM (should be after last HDR label) */ 3181 if code ^= 0 3182 then 3183 do; /* maybe trouble */ 3184 if code = error_table_$eov_on_write 3185 then go to eot_while_closing; /* return to continue_close */ 3186 else go to close_fail; /* real error, abort the file */ 3187 end; 3188 end; 3189 continue_close: 3190 if cseg.standard = 1 3191 then call tape_ansi_lrec_io_$close (cP, code); /* close logical IO */ 3192 else call tape_ansi_ibm_lrec_io_$close (cP, code); 3193 if code ^= 0 3194 then 3195 do; /* maybe trouble */ 3196 if code ^= error_table_$eov_on_write 3197 then 3198 do; /* EOT is ok */ 3199 close_fail: 3200 call consistent; /* delete the file */ 3201 go to close_exit; 3202 end; 3203 end; 3204 3205 call write_TM (1, code); /* write the end-of-data TM */ 3206 if code ^= 0 3207 then if code ^= error_table_$eov_on_write 3208 then go to close_fail; /* bad - ignore EOT */ 3209 call write_EOFs (code); /* write trailer labels */ 3210 if code ^= 0 3211 then go to close_fail; /* trouble */ 3212 3213 /* if cseg.user_labels then call write_UTL; */ 3214 3215 call write_TM (2, code); /* write trailer and end-of-volume TMs */ 3216 if code ^= 0 3217 then 3218 do; 3219 if code = error_table_$eov_on_write 3220 then code = 0; 3221 else go to close_fail; 3222 end; 3223 end; 3224 3225 close_exit: 3226 if cseg.close_rewind 3227 then 3228 do; /* rewind volume at close time */ 3229 vl (fl.vlX).cflX = 0; /* invalidate volume position */ 3230 call tape_ansi_tape_io_$order (cP, "rew", 0, 0);/* issue the order */ 3231 cseg.close_rewind = "0"b; /* this is a one time switch */ 3232 end; 3233 close_exit1: 3234 mask = "0"b; 3235 revert cleanup; 3236 on any_other call handler; 3237 call hcs_$set_ips_mask ("0"b, mask); 3238 iocbP -> iocb.actual_iocb_ptr -> iocb.detach_iocb = tape_ansi_detach_; 3239 iocbP -> iocb.actual_iocb_ptr -> iocb.open = tape_ansi_file_cntl_$open; 3240 iocbP -> iocb.actual_iocb_ptr -> iocb.control = tape_ansi_control_; 3241 iocbP -> iocb.actual_iocb_ptr -> iocb.open_descrip_ptr = null; 3242 call iox_$propagate (iocbP -> iocb.actual_iocb_ptr); 3243 call hcs_$reset_ips_mask (mask, mask); 3244 cseg.file_lock = "0"b; 3245 return; 3246 3247 debug_on: 3248 entry; /* turns debug switch on */ 3249 debug = "1"b; 3250 return; 3251 3252 debug_off: 3253 entry; /* truns debug switch off */ 3254 debug = "0"b; 3255 return; 3256 3257 debug_print: 3258 procedure (text); /* prints debug text */ 3259 dcl text char (*); 3260 3261 call ioa_ (text); 3262 return; 3263 3264 end debug_print; 3265 3266 3267 end tape_ansi_file_cntl_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 12/17/86 0829.4 tape_ansi_file_cntl_.pl1 >special_ldd>install>MR12.0-1250>tape_ansi_file_cntl_.pl1 41 1 05/20/83 1846.4 iocb.incl.pl1 >ldd>include>iocb.incl.pl1 43 2 06/10/82 1045.3 tape_ansi_cseg.incl.pl1 >ldd>include>tape_ansi_cseg.incl.pl1 45 3 11/20/79 2015.6 tape_ansi_fd.incl.pl1 >ldd>include>tape_ansi_fd.incl.pl1 47 4 11/20/79 2015.6 tape_ansi_fl.incl.pl1 >ldd>include>tape_ansi_fl.incl.pl1 49 5 10/06/83 1413.4 ansi_vol1.incl.pl1 >ldd>include>ansi_vol1.incl.pl1 51 6 10/06/83 1413.5 ibm_vol1.incl.pl1 >ldd>include>ibm_vol1.incl.pl1 53 7 10/06/83 1413.4 ansi_hdr1.incl.pl1 >ldd>include>ansi_hdr1.incl.pl1 55 8 10/06/83 1413.4 ansi_hdr2.incl.pl1 >ldd>include>ansi_hdr2.incl.pl1 57 9 10/06/83 1413.5 ibm_hdr1.incl.pl1 >ldd>include>ibm_hdr1.incl.pl1 59 10 10/06/83 1413.5 ibm_hdr2.incl.pl1 >ldd>include>ibm_hdr2.incl.pl1 61 11 12/17/86 0758.3 rcp_volume_formats.incl.pl1 >special_ldd>install>MR12.0-1250>rcp_volume_formats.incl.pl1 63 12 03/27/86 1120.0 rcp_resource_types.incl.pl1 >ldd>include>rcp_resource_types.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. HDR2 6 based bit(1) initial level 2 dcl 4-3 set ref 793 825* 837* 1515 2406* 2414* 2741* 2745 L1 000125 automatic fixed bin(17,0) dcl 599 set ref 620* 621 621* 624 624 629 633 TAPE_VOL_VTYPEX constant fixed bin(17,0) initial dcl 12-37 ref 624 1452 2254 2339 UL 000034 constant char(3) initial array unaligned dcl 113 ref 2205 VOLUME_TYPE 000140 constant char(32) initial array unaligned dcl 12-25 set ref 624* 1452* 2254* 2339* VTOC_pointer 2(27) based char(10) level 2 packed unaligned dcl 6-7 set ref 1831* Volume_ansi_tape constant fixed bin(17,0) initial dcl 11-15 ref 1404 2220 2268 Volume_ibm_tape constant fixed bin(17,0) initial dcl 11-15 ref 1404 2220 2268 access 15(09) based char(1) level 2 in structure "ansi_hdr1" packed unaligned dcl 7-8 in procedure "tape_ansi_file_cntl_" set ref 1155* 1319 access 37 based char(1) level 3 in structure "fd" dcl 3-3 in procedure "tape_ansi_file_cntl_" ref 2496 2613 access 37 based char(1) level 3 in structure "fl" dcl 4-3 in procedure "tape_ansi_file_cntl_" set ref 1155 1319* 1703* 1703 2496* 2613* access 2(18) based char(1) level 2 in structure "ansi_vol1" packed unaligned dcl 5-7 in procedure "tape_ansi_file_cntl_" set ref 1821* actual_iocb_ptr 12 based pointer level 2 dcl 1-6 set ref 205 488 492 494 498 500 501 502 504 505 506* 2846 2940 3009 3032 3065 3138 3238 3239 3240 3241 3242* addr builtin function dcl 131 ref 505 529 529 606 606 606 615 615 615 666 666 1122 1178 1207 1436 1439 1440 1441 1725 1725 1790 1790 1814 2155 2205 2274 2325 2333 2371 2407 2805 ansi_format_chars 000137 constant char(4) initial unaligned dcl 95 ref 1180 1412 ansi_hdr1 based structure level 1 packed unaligned dcl 7-8 ansi_hdr1P 000106 automatic pointer dcl 7-6 set ref 951 954 1122* 1123 1124 1125 1131 1147 1149 1152 1153 1154 1155 1156 1161 1163 1164 1246 1249 1250 1253 1279 1314 1316 1317 1318 1319 1320 1321 2274* 2288 2290 2294 2296 2298 2371* 2378 2805* 2806 ansi_hdr2 based structure level 1 packed unaligned dcl 8-8 ansi_hdr2P 000110 automatic pointer dcl 8-6 set ref 1178* 1179 1180 1182 1184 1188 1190 1191 1193 1197 1198 1199 1201 1203 1204 1412 1415 1427 1432 1436 1439 1440 1441 1446 1447 1448 2274* 2327 2333 2338 2407* 2414 ansi_vol1 based structure level 1 packed unaligned dcl 5-7 ansi_vol1P 000102 automatic pointer dcl 5-5 set ref 1814* 1815 1816 1821 1822 1823 1824 1825 answer 000116 automatic varying char(128) dcl 67 set ref 529* 534 606* 607 615* 617 620 621 624 624 629 633* 633 635 638* 638 641 644* 644 645 648 650 666* 668 1790* 1792 any_other 000254 stack reference condition dcl 127 ref 486 3236 area 000262 stack reference condition dcl 127 ref 262 2851 2952 3070 ascii_to_ebcdic_ 000020 constant entry external dcl 135 ref 2470 attach_data_ptr 16 based pointer level 2 dcl 1-6 ref 205 2846 2940 3009 3032 3065 3138 auth_code based char(3) array level 4 dcl 2-14 set ref 1807* 1823 1833 authenticate_ 000104 constant entry external dcl 135 ref 1807 backP based pointer initial level 2 dcl 4-3 set ref 317 541 703 718 727 825* 826* 837* 838* 847 850 853 859 883 1302 1310 1354 1354 1383 1482 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1707 2486 2487 2649 2913 2917 2917 2921 3046 3122 3126 3126 3130 bit builtin function dcl 131 ref 1439 1446 blkcnt 15(18) based char(6) level 2 in structure "ansi_hdr1" packed unaligned dcl 7-8 in procedure "tape_ansi_file_cntl_" set ref 1156* 1161* 1320 2298 blkcnt 40 based fixed bin(35,0) level 3 in structure "fl" dcl 4-3 in procedure "tape_ansi_file_cntl_" set ref 567 1320* 1704* 1904 2298* 2497* 2517* 2614* 2721* 2730* 2881 blkcnt 221 based fixed bin(35,0) level 3 in structure "cseg" dcl 2-14 in procedure "tape_ansi_file_cntl_" set ref 567* 1056 1109* 1109 1160 1902* 1904* 2721 2730 2878 2881 2931* 3000* 3084* blklen 46 based fixed bin(17,0) level 3 in structure "fd" dcl 3-3 in procedure "tape_ansi_file_cntl_" set ref 1075 1080 1080 1098 1536 1539 1543* 1632 1637* 1639* 1641 1651 1655 1658 1865 1874 1917 1924 1929 1932 1937 2551 2551* 2553 blklen 1(09) based char(5) level 2 in structure "ansi_hdr2" packed unaligned dcl 8-8 in procedure "tape_ansi_file_cntl_" set ref 1182* 1415 blklen 46 based fixed bin(17,0) initial level 3 in structure "fl" dcl 4-3 in procedure "tape_ansi_file_cntl_" set ref 825* 837* 1181 1211 1415* 1416 1418 1421* 1421 1421 1422* 1468* 1469 1539 1543 1641* 2551 blksize 1(09) based char(5) level 2 packed unaligned dcl 10-8 set ref 1212* 1468 block_attribute 11(18) based char(1) level 2 packed unaligned dcl 10-8 set ref 1229* 1487 blocked 62 based bit(1) level 3 in structure "fd" dcl 3-3 in procedure "tape_ansi_file_cntl_" set ref 1060 1577 1581* 1599 1603* 1627* 1630 1876 1884 1924 1932 2576* 2583* 2591* blocked 1(18) based char(1) level 2 in structure "old_ansi_hdr2_system_use" packed unaligned dcl 8-26 in procedure "tape_ansi_file_cntl_" ref 1439 blocked 62 based bit(1) initial level 3 in structure "fl" dcl 4-3 in procedure "tape_ansi_file_cntl_" set ref 825* 837* 1191 1224 1439* 1446* 1498* 1500* 1577 1581 1599 1603 1630* 2576 2591 blocked 13(27) based char(1) level 3 in structure "ansi_hdr2" packed unaligned dcl 8-8 in procedure "tape_ansi_file_cntl_" set ref 1191* 1198* 1446 bo 64 based fixed bin(17,0) level 3 in structure "fd" dcl 3-3 in procedure "tape_ansi_file_cntl_" set ref 1082 1091 1093 1570* 1592* 1874 2571* bo 64 based fixed bin(17,0) initial level 3 in structure "fl" dcl 4-3 in procedure "tape_ansi_file_cntl_" set ref 825* 837* 1202 1432* 1570 1683* 2571 buf based char(8192) dcl 1049 set ref 1086 1093 1110* 1110 bufP 212 based pointer level 3 dcl 2-14 set ref 1105* 1110 1901* buf_size 310 based fixed bin(17,0) level 2 dcl 2-14 ref 523 584 754 754 755 758 758 759 759 784 784 825 837 854 855 860 860 874 882 940 1248 1328 1418 1739 1765 1790 1807 1807 1809 1816 1823 1833 1979 2011 2012 2014 2014 2018 2021 2025 2025 2031 2031 2036 2044 2055 2059 2064 2064 2065 2068 2071 2072 2076 2079 2080 2086 2092 2095 2100 2105 2107 2110 2126 2130 2246 2253 2254 2254 2316 2349 2350 2389 2389 2422 2422 2641 2642 2643 2653 2656 2657 2658 2660 2663 2664 2665 2674 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2777 2777 2778 2781 2781 2782 2782 2857 2857 2969 2970 3177 3229 buffer_offset 14(18) based char(2) level 2 packed unaligned dcl 8-8 set ref 1203* 1432 cP 000100 automatic pointer dcl 2-11 set ref (more) 227 272 283 298 307 313 317 317 350 351 352 360 370 370 373 382 395 395 405 408 408 422 433 437 437 444 465 465 483 484 489 492 498 505 508 514 523 523 523 529 529 529 541 541 545 554 557 557 564 564 567 567 582 584 584 584 586 586 606 615 666 666 691 693 695 698 701 701 701 703 703 708 708 711 718 718 727 727 749* 754 754 754 754 754 754 755 755 755 758 758 758 758 758 758 759 759 759 759 759 759 774 774 783 784 784 784 784 784 784 793 811 811 825 825 825 826 826 827 837 837 837 838 838 839 839 847 847 850 853 853 854 854 854 854 855 855 855 855 859 859 860 860 860 860 860 860 874 874 874 874 879 882 882 882 883 883 887 900 902 904 906 921 921 940 940 940 944 948 951 954 958 970 978 984 984 990 990 993 996 996 1001 1001 1003 1003 1013 1016 1016 1025 1028 1031 1031 1056 1058 1060 1063* 1066* 1066 1070 1073 1073 1075 1075 1080 1080 1080 1080 1082 1082 1082 1086 1086 1088 1088 1091 1091 1091 1093 1093 1093 1093 1093 1093 1093 1098 1098 1101* 1105* 1105 1109 1109 1110 1110 1110 1110 1122 1124 1125 1127 1130 1135 1138 1138 1146 1148 1151 1153 1154 1155 1160 1163 1175 1178 1180 1181 1183 1185 1185 1190 1191 1192 1202 1207 1210 1211 1213 1215 1217 1220 1222 1224 1227 1244 1246 1248 1248 1248 1248 1249 1250 1251 1253 1254 1257 1260 1263 1273 1279 1281 1284 1289 1289 1296 1302 1308 1310 1310 1314 1316 1317 1318 1319 1320 1321 1325 1328 1328 1328 1328 1329 1334 1337 1344 1345 1350 1350 1354 1354 1354 1354 1356 1358 1359 1365 1369 1371 1377 1383 1388 1409 1412 1413 1415 1416 1418 1418 1421 1421 1421 1422 1427 1427 1429 1432 1433 1433 1439 1440 1441 1442 1446 1447 1448 1449 1452 1452 1452 1458 1464 1466 1468 1469 1471 1471 1480 1482 1494 1494 1498 1500 1501 1515 1518 1521 1521 1532 1532 1536 1539 1539 1543 1543 1545 1548 1551 1551 1554 1554 1558 1561 1561 1564 1567 1570 1570 1571 1571 1577 1577 1581 1581 1582 1585 1585 1589 1589 1592 1599 1599 1603 1603 1604 1604 1616 1619 1626 1627 1629 1629 1630 1630 1632 1635 1637 1637 1639 1641 1641 1643 1647 1649 1651 1651 1655 1655 1655 1658 1658 1661 1667 1667 1667 1671 1671 1673 1676 1676 1678 1680 1680 1682 1682 1683 1684 1684 1694 1694 1695 1695 1696 1696 1697 1697 1698 1698 1699 1699 1700 1700 1701 1701 1702 1702 1703 1703 1704 1705 1705 1707 1707 1708 1708 1739 1739 1764 1765 1765 1767 1790 1790 1790 1807 1807 1807 1807 1809 1809 1810* 1814 1816 1816 1818 1823 1823 1833 1833 1843 1848* 1865 1865 1868 1868 1870 1871 1874 1874 1875 1876 1876 1881 1884 1884 1889 1892 1897 1901 1902 1902 1904 1904 1905 1906 1907* 1917 1917 1923 1924 1924 1924 1929 1929 1932 1932 1932 1937 1937 1948 1948 1948 1950 1952 1952 1979 1979 1982 1982 1985* 1993 1993 2004* 2011 2011 2011 2012 2012 2012 2014 2014 2014 2014 2014 2018 2018 2021 2021 2021 2025 2025 2025 2025 2025 2031 2031 2031 2031 2036 2036 2044 2044 2044 2055 2055 2059 2059 2064 2064 2064 2064 2065 2065 2068 2068 2071 2071 2072 2072 2076 2076 2079 2079 2080 2080 2086 2086 2092 2092 2095 2095 2100 2100 2105 2105 2107 2107 2110 2110 2126 2126 2129 2130 2130 2143* 2155 2157* 2165* 2175* 2181* 2186* 2200* 2205 2207* 2225 2225 2228 2231 2235 2235 2238 2241 2246 2246 2246 2250 2250 2252 2253 2253 2253 2254 2254 2254 2254 2254 2254 2254 2273 2274 2288 2290 2294 2296 2298 2308* 2312 2316 2316 2316 2316 2325 2327 2330 2333 2333 2333 2338 2339 2339 2339 2349 2349 2349 2349 2350 2350 2350 2350 2371 2389 2389 2389 2389 2389 2389 2406 2407 2414 2422 2422 2422 2422 2422 2422 2435* 2448 2448 2448 2450 2450 2458 2468 2468 2468 2470 2470 2472* 2474 2485 2485 2486 2486 2487 2487 2488 2489 2489 2490 2490 2492 2493 2494 2494 2495 2495 2496 2496 2497 2498 2498 2512 2512 2513 2513 2514 2514 2514 2516 2516 2517 2517 2533 2533 2534 2534 2536 2539 2539 2540 2551 2551 2551 2553 2556 2556 2556 2558 2561 2561 2563 2568 2571 2571 2571 2573 2573 2576 2576 2578 2578 2578 2583 2585 2585 2591 2591 2593 2593 2606 2606 2607 2607 2609 2609 2610 2611 2611 2612 2612 2613 2613 2614 2619 2619 2634 2639 2640 2641 2641 2642 2642 2643 2643 2647 2648 2648 2649 2650 2653 2653 2653 2653 2656 2656 2656 2657 2657 2657 2658 2658 2658 2660 2660 2660 2660 2662 2662 2663 2663 2664 2664 2665 2665 2670 2672 2672 2673 2674 2674 2674 2677 2687 2687 2688 2688 2689 2689 2690 2690 2691 2691 2692 2692 2693 2693 2694 2694 2695 2695 2696 2696 2697 2697 2698 2698 2699 2699 2700 2700 2701 2701 2713 2721 2721 2722 2730 2730 2731 2741 2745 2771* 2777 2777 2777 2777 2777 2777 2778 2778 2778 2781 2781 2781 2781 2781 2781 2782 2782 2782 2782 2782 2782 2796 2796 2801 2801 2805 2806 2809 2812 2815 2815 2846* 2857 2857 2857 2857 2857 2857 2859 2859* 2861* 2870 2878 2881 2881 2891 2898 2898 2898 2909 2913 2913 2917 2917 2917 2917 2921 2921 2927 2927 2931 2940* 2969 2969 2969 2969 2970 2970 2970 2970 3000 3009* 3032* 3038 3038* 3040* 3044 3044 3044 3046 3048 3048 3065* 3072 3072* 3074* 3083 3084 3086 3095 3098 3098 3107 3107 3107 3118 3122 3122 3126 3126 3126 3126 3130 3130 3138* 3141 3149 3150 3153 3161 3166 3166* 3168* 3177 3177 3177 3189 3189* 3192* 3225 3229 3229 3229 3230* 3231 3244 can_retry 000102 automatic bit(1) initial unaligned dcl 1970 in procedure "move_tape_" set ref 1970* 2058* 2112 2115* can_retry 000100 automatic bit(1) initial unaligned dcl 915 in procedure "desired_check" set ref 915* 936 939* canon_for_volume_label_ 000102 constant entry external dcl 135 ref 624 1452 2254 2339 canon_std 000100 automatic fixed bin(17,0) initial array dcl 1404 in procedure "fill_fl_from_HDR2" set ref 1404* 1404* 1452* canon_std 000100 automatic fixed bin(17,0) initial array dcl 2220 in procedure "next_volume" set ref 2220* 2220* 2254* canon_std 000100 automatic fixed bin(17,0) initial array dcl 2268 in procedure "process_EOX" set ref 2268* 2268* 2339* canonical_next_volname based char(6) level 2 in structure "old_ansi_hdr2_system_use" packed unaligned dcl 8-26 in procedure "tape_ansi_file_cntl_" ref 1441 canonical_next_volname 60 based char(6) initial level 3 in structure "fl" packed unaligned dcl 4-3 in procedure "tape_ansi_file_cntl_" set ref 825* 837* 1441* 1452* 1458* 1684* 1708* 2339* 2350* 2970* canonical_set_id 25 based char(6) level 3 packed unaligned dcl 4-3 set ref 1125 1249* 1329* 1696* 1696 2487* 2487 canonical_volname based char(6) array level 4 packed unaligned dcl 2-14 set ref 1765 1816 2254* 2350 2970 cc 65 based char(1) level 3 in structure "fd" dcl 3-3 in procedure "tape_ansi_file_cntl_" set ref 1604* 1682 cc 000157 automatic fixed bin(17,0) dcl 67 in procedure "tape_ansi_file_cntl_" set ref 223* 277* 356* 389* 403* 441* 452* 460* 468* 733* 872 2849* 2902* 2906* 2943* 3014* 3035* 3068* 3111* 3115* 3164* 3175* cc 65 based char(1) initial level 3 in structure "fl" dcl 4-3 in procedure "tape_ansi_file_cntl_" set ref 825* 837* 1222 1501* 1604 1682* cflX based fixed bin(17,0) array level 4 packed unaligned dcl 2-14 set ref 523* 584* 759* 759 874* 882* 940* 1809* 2059 2064* 2068 2071 2076 2079 2105* 2110* 2642* 2657* 2664* 2688* 2782* 2782 3229* chain_area based area(1024) level 2 dcl 2-14 ref 825 837 2674 char builtin function dcl 131 ref 1191 cleanup 000270 stack reference condition dcl 127 ref 224 485 2637 2668 2850 2944 3015 3036 3069 3149 3157 3165 3176 3235 close 36 based entry variable level 2 dcl 1-6 set ref 488* close_eot 000202 automatic bit(1) unaligned dcl 67 set ref 2946* 2949* 2963 3002 close_rewind 177 based bit(1) level 2 dcl 2-14 set ref 3225 3231* cnt 000100 automatic fixed bin(17,0) dcl 744 in procedure "back_TM" set ref 748* cnt 000100 automatic fixed bin(17,0) dcl 2764 in procedure "write_TM" set ref 2770* code parameter fixed bin(35,0) dcl 36 in procedure "tape_ansi_file_cntl_" set ref 202 211* 218* 235* 264* 278* 279 290* 320* 332* 333 345* 346 357* 358 363* 366* 367 395* 396 414* 437* 438 465* 466 469* 470 472* 473 473 476* 477 548* 549 557* 559 564* 565 568* 569 574* 575 575 579* 588* 624* 625 628 730* 921* 923 926* 927 943* 998* 1005* 1034* 1063* 1064 1066* 1067 1101* 1103 1105* 1107 1524* 1622* 1910* 1913* 1952* 1953 1956* 1957 2254* 2257 2543* 2841 2853* 2859* 2861* 2862 2873* 2874 2884* 2894* 2903* 2904 2912* 2920* 2927* 2928 2935 2955* 2962* 2975* 2976 2976 2985* 2986 2991* 2992 2992 2996* 2997 3006 3019* 3021 3023 3029 3038* 3040* 3041 3048* 3049 3062 3072* 3074* 3075 3090* 3091 3098* 3099 3101* 3102 3112* 3113 3121* 3129* 3135 3144* 3156* 3166* 3168* 3169 3180* 3181 3184 3189* 3192* 3193 3196 3205* 3206 3206 3209* 3210 3215* 3216 3219 3219* code 223 based fixed bin(35,0) level 3 in structure "cseg" dcl 2-14 in procedure "tape_ansi_file_cntl_" set ref 1906* code 1 000100 automatic fixed bin(35,0) level 2 in structure "ti" dcl 1717 in procedure "handler" set ref 1724* com_text 000160 automatic varying char(64) dcl 67 set ref 619* 648* 2246 command_query_ 000022 constant entry external dcl 135 ref 529 606 615 666 1790 comment based varying char(64) array level 4 dcl 2-14 set ref 2246* continue_to_signal_ 000024 constant entry external dcl 135 ref 1728 control 66 based entry variable level 2 dcl 1-6 set ref 504* 3240* control_characters 11 based char(1) level 2 packed unaligned dcl 10-8 set ref 1222* 1501 conversion 000000 stack reference condition dcl 127 ref 953 956 1243 1408 2272 creation 33 based char(5) level 3 in structure "fd" dcl 3-3 in procedure "tape_ansi_file_cntl_" ref 408 1220 1279 2494 2516 2611 2806 creation 12(09) based char(6) level 2 in structure "ansi_hdr1" packed unaligned dcl 7-8 in procedure "tape_ansi_file_cntl_" set ref 1153* 1317 2294 creation 33 based char(5) level 3 in structure "fl" dcl 4-3 in procedure "tape_ansi_file_cntl_" set ref 1153 1317* 1701* 1701 2294* 2494* 2516* 2611* cseg based structure level 1 unaligned dcl 2-14 dataset_id 1 based char(17) level 2 packed unaligned dcl 9-8 ref 958 1325 dataset_position 4 based char(1) level 2 packed unaligned dcl 10-8 set ref 1217* 1219* 1477 dataset_sequence 7(27) based char(4) level 2 packed unaligned dcl 9-8 ref 1358 dataset_serial 5(09) based char(6) level 2 packed unaligned dcl 9-8 ref 1329 debug 000010 internal static bit(1) initial unaligned dcl 116 set ref 339 386 400 424 448 456 520 676 724 742 770 809 822 834 844 869 898 918 933 967 973 1017 1022 1053 1119 1173 1241 1406 1512 1613 1691 1804 1861 1946 1977 2122 2140 2222 2270 2368 2404 2455 2474 2482 2509 2530 2603 2627 2707 2719 2728 2768 2794 2844 2938 3011 3249* 3254* density 125 based fixed bin(17,0) level 2 in structure "cseg" dcl 2-14 in procedure "tape_ansi_file_cntl_" ref 1215 density based fixed bin(17,0) array level 4 in structure "cseg" packed unaligned dcl 2-14 in procedure "tape_ansi_file_cntl_" set ref 2692* density 3(27) based char(1) level 2 in structure "ibm_hdr2" packed unaligned dcl 10-8 in procedure "tape_ansi_file_cntl_" set ref 1216* detach_iocb 26 based entry variable level 2 dcl 1-6 set ref 3238* drive_name 324 based char(32) level 3 dcl 2-14 set ref 2011* dummy_label 000041 constant char(76) initial array unaligned dcl 103 ref 1334 1843 ebcdic_to_ascii_ 000032 constant entry external dcl 135 ref 2450 ecode parameter fixed bin(35,0) dcl 1966 in procedure "move_tape_" set ref 1964 1985* 1987 1990 2004* 2006 2027* 2040* 2050* 2051 2133* 2143* 2144 2146* 2148 2151 2151* 2157* 2158 2165* 2167 2175* 2177 2181* 2182 2184 2186* 2187 2198* 2200 2200* 2203 2207* 2209 ecode parameter fixed bin(35,0) dcl 2764 in procedure "write_TM" set ref 2762 2771* 2773 2773 ecode parameter fixed bin(35,0) dcl 2792 in procedure "write_new_section" set ref 2790 2801* 2802 2812* 2813 2815* 2817 2822* 2829* 2830 2835* ecode parameter fixed bin(35,0) dcl 2710 in procedure "write_HDRs" set ref 2705 2717 2726 2736* 2737 2737 2748* 2754* 2755 2755* ecode parameter fixed bin(35,0) dcl 1402 in procedure "fill_fl_from_HDR2" set ref 1400 1452* 1455 1504* ecode parameter fixed bin(35,0) dcl 1238 in procedure "fill_fl_from_HDR1" set ref 1236 1266* 1284* 1287 1289* 1291 1293* 1294 1298* 1341* 1393* ecode parameter fixed bin(35,0) dcl 2402 in procedure "read_HDR2" set ref 2400 2409* 2411 2419 2423* ecode parameter fixed bin(35,0) dcl 769 in procedure "build1" set ref 767 774* 775 777* 778 787* 788 790* 791 796* 797 ecode parameter fixed bin(35,0) dcl 744 in procedure "back_TM" set ref 740 749* 751 ecode parameter fixed bin(35,0) dcl 2266 in procedure "process_EOX" set ref 2264 2276* 2278 2281 2281* 2300* 2302 2305 2308* 2310 2319* 2339* 2342 2352* 2357* ecode parameter fixed bin(35,0) dcl 807 in procedure "build2" set ref 805 811* 812 814* ecode parameter fixed bin(35,0) dcl 2432 in procedure "read_label" set ref 2430 2435* 2437 2443* 2458 2460* 2465 2472* 2474* ecode parameter fixed bin(35,0) dcl 2366 in procedure "read_HDR1" set ref 2363 2373* 2375 2381* 2386 2390* 2391 ecode parameter fixed bin(35,0) dcl 1800 in procedure "initialize_volume" set ref 1798 1810* 1811 1838* 1839 1844* 1845 1848* 1850 eofs 000201 automatic bit(1) unaligned dcl 67 set ref 777* 780 926* 930 1293* eofsw parameter bit(1) unaligned dcl 2365 set ref 2363 2370* 2391* eox 7 based fixed bin(17,0) initial level 2 dcl 4-3 set ref 351 554 825* 837* 850 1302 1482 1948 2273* 2288* 2290* 2312 2327 2330 2713* 2722* 2731* 2870 2891 3086 3095 error_table_$device_limit_exceeded 000106 external static fixed bin(35,0) dcl 170 ref 1990 error_table_$discrepant_block_count 000110 external static fixed bin(35,0) dcl 170 ref 2884 error_table_$duplicate_file_id 000112 external static fixed bin(35,0) dcl 170 ref 1034 error_table_$end_of_info 000116 external static fixed bin(35,0) dcl 170 ref 2894 error_table_$eof_record 000114 external static fixed bin(35,0) dcl 170 ref 2151 2200 2281 2305 2386 2419 error_table_$eov_on_write 000120 external static fixed bin(35,0) dcl 170 ref 473 575 2737 2755 2773 2976 2992 3023 3184 3196 3206 3219 error_table_$file_aborted 000122 external static fixed bin(35,0) dcl 170 ref 527 579 error_table_$file_busy 000124 external static fixed bin(35,0) dcl 170 ref 218 3144 error_table_$incompatible_attach 000126 external static fixed bin(35,0) dcl 170 ref 235 error_table_$incompatible_file_attribute 000130 external static fixed bin(35,0) dcl 170 ref 1524 error_table_$insufficient_open 000132 external static fixed bin(35,0) dcl 170 ref 1622 2543 error_table_$invalid_block_length 000134 external static fixed bin(35,0) dcl 170 ref 1913 error_table_$invalid_cseg 000136 external static fixed bin(35,0) dcl 170 ref 211 943 2133 3156 error_table_$invalid_expiration 000140 external static fixed bin(35,0) dcl 170 ref 320 730 error_table_$invalid_file_set_format 000142 external static fixed bin(35,0) dcl 170 ref 363 588 2151 2281 2381 2912 3121 error_table_$invalid_label_format 000144 external static fixed bin(35,0) dcl 170 ref 1393 1504 2357 2443 error_table_$invalid_record_length 000146 external static fixed bin(35,0) dcl 170 ref 1910 error_table_$invalid_volume_sequence 000150 external static fixed bin(35,0) dcl 170 ref 1266 2920 3129 error_table_$no_file 000154 external static fixed bin(35,0) dcl 170 ref 290 998 1005 1341 error_table_$no_next_volume 000156 external static fixed bin(35,0) dcl 170 ref 603 2319 2352 2962 error_table_$noalloc 000152 external static fixed bin(35,0) dcl 170 ref 264 2853 2955 error_table_$positioned_on_bot 000160 external static fixed bin(35,0) dcl 170 ref 2182 error_table_$unable_to_do_io 000162 external static fixed bin(35,0) dcl 170 ref 1724 error_table_$unexpired_file 000164 external static fixed bin(35,0) dcl 170 ref 414 664 error_table_$unexpired_volume 000166 external static fixed bin(35,0) dcl 170 ref 1298 1745 2822 error_table_$uninitialized_volume 000170 external static fixed bin(35,0) dcl 170 ref 1738 2027 2040 ev_chan 316 based fixed bin(71,0) level 3 dcl 2-14 set ref 2012* event_chan based fixed bin(71,0) array level 4 dcl 2-14 set ref 2012 2698* expiration 13(27) based char(6) level 2 in structure "ansi_hdr1" packed unaligned dcl 7-8 in procedure "tape_ansi_file_cntl_" set ref 1154* 1279 1318 2806 expiration 35 based char(5) level 3 in structure "fl" dcl 4-3 in procedure "tape_ansi_file_cntl_" set ref 317 408 727 1154 1318* 1702* 1702 2495* 2612* expiration 35 based char(5) level 3 in structure "fd" dcl 3-3 in procedure "tape_ansi_file_cntl_" ref 317 727 2495 2612 extend_bit parameter bit(1) dcl 36 ref 202 232 extra1 000137 automatic varying char(12) initial dcl 1736 set ref 1736* 1764* 1790* extra2 000143 automatic varying char(12) initial dcl 1736 set ref 1736* 1765* 1790* fX parameter fixed bin(17,0) dcl 1966 ref 1964 2068 2071 2076 2079 2105 fcP 130 based pointer level 2 dcl 2-14 ref 244 257 269 317 408 586 698 701 701 703 708 711 718 727 904 978 984 990 1001 1016 1031 1058 1060 1073 1075 1080 1080 1082 1082 1091 1091 1093 1093 1093 1093 1098 1185 1220 1279 1433 1518 1521 1532 1536 1539 1543 1545 1548 1551 1554 1561 1570 1571 1577 1581 1582 1585 1589 1592 1599 1603 1604 1616 1626 1627 1629 1630 1632 1637 1639 1641 1643 1649 1651 1651 1655 1655 1658 1658 1661 1667 1671 1673 1676 1678 1680 1682 1705 1865 1868 1874 1874 1875 1876 1876 1881 1884 1884 1889 1892 1917 1923 1924 1924 1924 1929 1929 1932 1932 1932 1937 1937 2235 2333 2485 2489 2494 2495 2496 2498 2512 2513 2516 2533 2534 2536 2539 2540 2551 2551 2553 2556 2556 2558 2561 2561 2563 2571 2573 2576 2578 2578 2583 2585 2585 2591 2593 2593 2606 2607 2611 2612 2613 2619 2639 2806 fd based structure level 1 dcl 3-3 fflX based fixed bin(17,0) array level 4 packed unaligned dcl 2-14 set ref 854* 2064 2641* 2653 2656* 2663* 2687* file_id 1 based char(17) level 2 in structure "ansi_hdr1" packed unaligned dcl 7-8 in procedure "tape_ansi_file_cntl_" set ref 951 1124* 1246 file_id 10 based char(17) level 3 in structure "fl" dcl 4-3 in procedure "tape_ansi_file_cntl_" set ref 529* 666* 951 958 996 1001 1013 1031 1124 1246* 1325* 1354 1354 1694* 1694 2485* 2512 2533 2606 2917 2917 3126 3126 file_id 10 based char(17) level 3 in structure "fd" dcl 3-3 in procedure "tape_ansi_file_cntl_" set ref 244 257 1001 1031 2485 2512* 2533* 2606* file_lock 220 based bit(1) level 3 dcl 2-14 set ref 215 227* 229* 508* 514* 3141 3149* 3150* 3244* fixed builtin function dcl 131 ref 954 1250 1253 1314 1316 1320 1330 1358 1415 1427 1432 1440 1447 1468 1471 2296 2298 fl based structure level 1 dcl 4-3 set ref 825 837 2674 flP 132 based pointer level 2 dcl 2-14 set ref 269* 270 272* 283 317 337 350 351 352 360 370* 370 382* 395 395 408 437 437 465 465 523 529 529 541* 541 545 554 557 557 564 564 567 584 586* 666 701 703 708 718 727 754 754 755 758 758 759 759 774 774 783 784 784 793 811 811 825 826 826 827 837 838 838 839* 839 847 847 850 853 853 854 854 855 855 859 859 860 860 874 874 879 882 883* 883 887 921 921 940 951 954 958 970 984 990 996 1001 1013 1016 1031 1124 1125 1130 1135 1138 1146 1148 1151 1153 1154 1155 1163 1180 1181 1183 1185 1190 1191 1192 1202 1210 1211 1213 1217 1222 1224 1227 1246 1248 1248 1249 1250 1251 1253 1254 1257 1260 1263 1273 1281 1284 1289 1289 1302 1308 1310 1310 1314 1316 1317 1318 1319 1320 1321 1325 1328 1328 1329 1337 1344 1345 1350 1350 1354 1354 1354 1354 1356 1358 1359 1365 1369 1371 1377 1383 1388 1412 1413 1415 1416 1418 1421 1421 1421 1422 1427 1427 1429 1432 1433 1439 1440 1441 1442 1446 1447 1448 1449 1452 1452 1458 1464 1466 1468 1469 1471 1471 1480 1482 1494 1494 1498 1500 1501 1515 1521 1532 1539 1543 1554 1558 1561 1567 1570 1571 1577 1581 1585 1589 1599 1603 1604 1629 1630 1641 1667 1671 1680 1682 1683 1684 1684 1694 1694 1695 1695 1696 1696 1697 1697 1698 1698 1699 1699 1700 1700 1701 1701 1702 1702 1703 1703 1704 1705 1707 1707 1708 1708 1904 1948* 1948 1948* 1950 1952 1952 2225 2228 2235 2238 2241 2273 2288 2290 2294 2296 2298 2312 2316 2316 2327 2330 2333 2338 2339 2339 2349 2349 2350 2350 2389 2389 2406 2414 2422 2422 2485 2486 2486 2487 2487 2488 2489 2490 2492 2493 2494 2495 2496 2497 2498 2512 2513 2514 2514 2516 2517 2533 2534 2539 2551 2556 2571 2571 2573 2576 2578 2591 2606 2607 2609 2609 2610 2611 2612 2613 2614 2619 2634 2647 2648* 2648 2649 2650 2653 2653 2656 2657 2658 2660 2660 2662 2670 2672* 2672* 2673 2674* 2677* 2713 2721 2722 2730 2731 2741 2745 2777 2777 2778 2781 2781 2782 2782 2796* 2796 2801 2801 2809 2812 2815 2815 2857 2857 2870 2881 2891 2898 2898* 2898 2909 2913* 2913 2917 2917 2917 2917 2921* 2921 2927 2927 2969 2969 2970 2970 3044* 3044 3044* 3046 3048 3048 3086 3095 3098 3098 3107 3107* 3107 3118 3122* 3122 3126 3126 3126 3126 3130* 3130 3177 3229 flX 4 based fixed bin(17,0) initial level 2 dcl 4-3 set ref 283 360 395* 437* 465* 545 557 564* 774* 783* 811* 825* 827* 837* 847* 847 854 855 921* 1263 1273 1289* 1308 1337 1350 1377 1388 1952* 2650 2653 2660 2801* 2815* 2909 2927* 3048* 3098* 3118 force 200 based bit(1) level 2 dcl 2-14 ref 405 format 1 based char(1) level 2 in structure "ibm_hdr2" packed unaligned dcl 10-8 in procedure "tape_ansi_file_cntl_" set ref 1210* 1464 format 1 based char(1) level 2 in structure "ansi_hdr2" packed unaligned dcl 8-8 in procedure "tape_ansi_file_cntl_" set ref 1180* 1412 format 45 based fixed bin(17,0) level 3 in structure "fd" dcl 3-3 in procedure "tape_ansi_file_cntl_" set ref 1058 1518 1521 1532* 1545 1616 1626* 1629 1649 1875 1923 2536 2539* 2540 2561 2563 format 45 based fixed bin(17,0) initial level 3 in structure "fl" dcl 4-3 in procedure "tape_ansi_file_cntl_" set ref 825* 837* 1180 1210 1227 1412* 1413 1427 1464* 1466 1471 1494 1494* 1521 1532 1629* 2539 format_override 000203 automatic bit(1) unaligned dcl 67 set ref 1528* 1533* 1574 1596 2547* 2549* 2576 2583 2591 generation 10(27) based char(4) level 2 in structure "ibm_hdr1" packed unaligned dcl 9-8 in procedure "tape_ansi_file_cntl_" set ref 1141* generation 10(27) based char(4) level 2 in structure "ansi_hdr1" packed unaligned dcl 7-8 in procedure "tape_ansi_file_cntl_" set ref 1147* 1314 generation 31 based fixed bin(17,0) level 3 in structure "fl" dcl 4-3 in procedure "tape_ansi_file_cntl_" set ref 1138 1146 1314* 1699* 1699 2490* 2492* 2609* 2609 hcs_$reset_ips_mask 000040 constant entry external dcl 135 ref 507 3243 hcs_$set_ips_mask 000042 constant entry external dcl 135 ref 487 3237 hdr1 10 based structure level 2 in structure "fl" dcl 4-3 in procedure "tape_ansi_file_cntl_" hdr1 10 based structure level 2 in structure "fd" dcl 3-3 in procedure "tape_ansi_file_cntl_" hdr2 45 based structure level 2 in structure "fl" dcl 4-3 in procedure "tape_ansi_file_cntl_" set ref 1707* 1707 hdr2 45 based structure level 2 in structure "fd" dcl 3-3 in procedure "tape_ansi_file_cntl_" i 000100 automatic fixed bin(17,0) dcl 1970 in procedure "move_tape_" set ref 2004* 2125* 2126* 2129* 2130* 2164* 2174* 2193* 2197* 2205 i 000100 automatic fixed bin(17,0) dcl 1802 in procedure "initialize_volume" set ref 1842* 1843* i 000346 automatic fixed bin(17,0) dcl 1051 in procedure "extend_check" set ref 1082* 1083 1086 1086 1088 1091* 1092 i 000400 automatic fixed bin(17,0) dcl 1863 in procedure "lrec_open" set ref 1874* 1876 1881 1884 1889 i 000100 automatic fixed bin(17,0) dcl 2630 in procedure "truncate_chains" set ref 2640* 2641 2642 2643* 2662* 2663 2664 2665* ibm_block_codes 000135 constant char(4) initial unaligned dcl 95 ref 1229 1487 ibm_format_chars 000136 constant char(4) initial unaligned dcl 95 ref 1210 1464 ibm_hdr1 based structure level 1 packed unaligned dcl 9-8 ibm_hdr1P 000112 automatic pointer dcl 9-6 set ref 958 1122* 1136 1141 1142 1325 1329 1330 1358 2371* ibm_hdr2 based structure level 1 packed unaligned dcl 10-8 ibm_hdr2P 000114 automatic pointer dcl 10-6 set ref 1207* 1209 1210 1212 1214 1216 1217 1219 1220 1221 1222 1223 1229 1231 1464 1468 1471 1477 1485 1487 1501 2407* ibm_vol1 based structure level 1 packed unaligned dcl 6-7 ibm_vol1P 000104 automatic pointer dcl 6-5 set ref 1814* 1830 1831 1832 1833 1834 index builtin function dcl 131 ref 620 1412 1464 1487 invalid 1 based bit(1) level 2 dcl 2-14 set ref 208 944* 3153 ioa_ 000052 constant entry external dcl 135 ref 582 654 742 1422 2025 2231 2458 2460 2474 2509 2768 3261 iocb based structure level 1 dcl 1-6 iocbP parameter pointer dcl 36 ref 202 205 488 492 494 498 500 501 502 504 505 506 2841 2846 2935 2940 3006 3009 3029 3032 3062 3065 3135 3138 3238 3239 3240 3241 3242 ioi_index based fixed bin(17,0) array level 4 dcl 2-14 set ref 2701* iox_$propagate 000054 constant entry external dcl 135 ref 506 3242 j 000347 automatic fixed bin(17,0) dcl 1051 in procedure "extend_check" set ref 1092* 1093* j 000101 automatic fixed bin(17,0) dcl 1802 in procedure "initialize_volume" set ref 1847* j 000101 automatic fixed bin(17,0) dcl 1970 in procedure "move_tape_" set ref 2071* 2072* 2072 2079* 2080* 2080 2089* 2095* 2100* 2164 2174 jobstep_id 4(09) based char(17) level 2 packed unaligned dcl 10-8 set ref 1220* k 000102 automatic fixed bin(17,0) dcl 1802 set ref 1826* 1835* 1842 1843 l1id 000132 constant char(4) initial array unaligned dcl 95 ref 1123 1843 l2id 000127 constant char(4) initial array unaligned dcl 95 ref 1179 1209 2327 label_id based char(4) level 2 in structure "ansi_hdr1" packed unaligned dcl 7-8 in procedure "tape_ansi_file_cntl_" set ref 1123* 2288 2290 2378 label_id based char(4) level 2 in structure "ibm_hdr2" packed unaligned dcl 10-8 in procedure "tape_ansi_file_cntl_" set ref 1209* label_id based char(4) level 2 in structure "ansi_hdr2" packed unaligned dcl 8-8 in procedure "tape_ansi_file_cntl_" set ref 1179* 2327 2414 label_id based char(4) level 2 in structure "ansi_vol1" packed unaligned dcl 5-7 in procedure "tape_ansi_file_cntl_" set ref 1815* label_type based char(3) unaligned dcl 120 in procedure "tape_ansi_file_cntl_" ref 2155 2205 2325 label_type based fixed bin(17,0) array level 4 in structure "cseg" packed unaligned dcl 2-14 in procedure "tape_ansi_file_cntl_" set ref 2693* label_version 23(27) based char(1) level 2 packed unaligned dcl 5-7 set ref 1825* lbl_buf 152 based char(80) level 2 packed unaligned dcl 2-14 set ref 1122 1178 1207 1334 1764 1814 1843* 2155 2205 2274 2325 2371 2407 2448* 2450* 2458* 2468 2470* 2474* 2805 length 104 based fixed bin(17,0) level 3 in structure "cseg" dcl 2-14 in procedure "tape_ansi_file_cntl_" set ref 483* length builtin function dcl 131 in procedure "tape_ansi_file_cntl_" ref 483 606 606 615 615 621 645 lflX based fixed bin(17,0) array level 4 packed unaligned dcl 2-14 set ref 784* 784 855* 860* 860 2643* 2658* 2660* 2665* 2690* lrec 212 based structure level 2 unaligned dcl 2-14 lrecl 2(18) based char(5) level 2 packed unaligned dcl 10-8 set ref 1214* 1471 ltrim builtin function dcl 131 ref 633 638 644 mask 000205 automatic bit(36) dcl 67 set ref 481* 487* 507* 507* 1721 3233* 3237* 3243* 3243* max builtin function dcl 131 ref 2014 max_reclen 000036 constant fixed bin(17,0) initial array dcl 110 ref 1551 1667 mod builtin function dcl 131 ref 1073 1082 1421 1881 1917 1929 2514 2609 mode 14 based char(1) level 3 in structure "ansi_hdr2" packed unaligned dcl 8-8 in procedure "tape_ansi_file_cntl_" set ref 1193* 1199* 1447 mode 63 based fixed bin(17,0) initial level 3 in structure "fl" dcl 4-3 in procedure "tape_ansi_file_cntl_" set ref 825* 837* 1192 1440* 1447* 1585 1589 1680* 2578 mode 63 based fixed bin(17,0) level 3 in structure "fd" dcl 3-3 in procedure "tape_ansi_file_cntl_" set ref 1582 1585 1589* 1673 1676* 1678* 1680 1868 2578 2578* 2585 2585* 2593 2593* mode 1(27) based char(1) level 2 in structure "old_ansi_hdr2_system_use" packed unaligned dcl 8-26 in procedure "tape_ansi_file_cntl_" ref 1440 mode 262 based fixed bin(17,0) level 2 in structure "cseg" dcl 2-14 in procedure "tape_ansi_file_cntl_" set ref 1868* 1870* module 115 based varying char(12) level 2 dcl 2-14 set ref 529* 582* 606* 615* 666* 1790* 2025* 2231* msg 000100 automatic varying char(120) dcl 1735 in procedure "initialize_permit" set ref 1746* 1752* 1758* 1766* 1767* 1767 1770* 1770 1777* 1782* 1790 msg 000100 automatic varying char(80) dcl 596 in procedure "another_volume" set ref 605* 606 606 606 614* 615 615 615 629* msg1 based char unaligned dcl 597 set ref 606* 615* n parameter fixed bin(17,0) dcl 744 in procedure "back_TM" set ref 740 742* 748 n parameter fixed bin(17,0) dcl 2686 in procedure "vl_init" ref 2684 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 n parameter fixed bin(17,0) dcl 2764 in procedure "write_TM" set ref 2762 2768* 2770 nactive 122 based fixed bin(17,0) level 2 dcl 2-14 ref 1982 nchar 000100 automatic fixed bin(17,0) dcl 2432 set ref 2435* 2440 ndrives 121 based fixed bin(17,0) level 2 dcl 2-14 set ref 1982 1993* 1993 new_link 000204 automatic bit(1) unaligned dcl 67 set ref 268* 276* 301 311 329 342 355* 376 nextP 2 based pointer initial level 2 in structure "fd" dcl 3-3 in procedure "tape_ansi_file_cntl_" ref 701 708 nextP 2 based pointer initial level 2 in structure "fl" dcl 4-3 in procedure "tape_ansi_file_cntl_" set ref 270 337 352 370 825* 825* 826 827 837* 837* 838 839 1950 2634 2639* 2648 2649* 2673 2796 2898 2898 3107 3107 next_volname 3(27) based char(32) level 3 in structure "ansi_hdr2" packed unaligned dcl 8-8 in procedure "tape_ansi_file_cntl_" set ref 1188* 1190* 1197* 1448 2338 next_volname 50 based char(32) initial level 3 in structure "fl" packed unaligned dcl 4-3 in procedure "tape_ansi_file_cntl_" set ref 825* 837* 1190 1442* 1448* 1449 1452* 1684* 1708* 2238 2241 2316* 2338* 2339* 2349* 2969* null builtin function dcl 131 ref 272 352 825 825 837 837 874 879 887 1901 2634 2639 2649 2672 2898 3107 3241 nv 000100 automatic fixed bin(17,0) dcl 1239 set ref 1330* 1331 1362 1369 1374 1383 offset 215 based fixed bin(17,0) level 3 dcl 2-14 set ref 1066* 1073 1075 1080 1080* 1082 1086 1088* 1088 1091 1093* 1093 1098 1110 1110 old_ansi_hdr2_system_use based structure level 1 packed unaligned dcl 8-26 open 32 based entry variable level 2 dcl 1-6 set ref 3239* open_descrip_ptr 20 based pointer level 2 dcl 1-6 set ref 505* 3241* open_description 104 based structure level 2 unaligned dcl 2-14 set ref 505 open_mode 176 based fixed bin(17,0) level 2 in structure "cseg" dcl 2-14 in procedure "tape_ansi_file_cntl_" set ref 260* 298 489 691 900 1003 1028 1767 1865 1902 1917 2014 2021 2044 3161 open_mode parameter fixed bin(17,0) dcl 36 in procedure "tape_ansi_file_cntl_" ref 202 240 251 260 output_mode 203 based fixed bin(17,0) level 2 dcl 2-14 ref 249 254 307 313 373 422 433 444 693 902 1003 1025 1619 1635 1647 2517 owner_id 11(09) based structure level 2 in structure "ansi_vol1" packed unaligned dcl 5-7 in procedure "tape_ansi_file_cntl_" set ref 1823* owner_id 12(09) based structure level 2 in structure "ibm_vol1" packed unaligned dcl 6-7 in procedure "tape_ansi_file_cntl_" set ref 1833* pos based fixed bin(17,0) array level 4 packed unaligned dcl 2-14 set ref 754* 754 755 758* 758 2065* 2072 2080 2086 2092 2095 2100 2107* 2389* 2389 2422* 2422 2689* 2777* 2777 2778 2781* 2781 2857* 2857 3177 posit parameter fixed bin(17,0) dcl 1966 ref 1964 2072 2080 2086 2092 2095 2100 2107 position 62 based entry variable level 2 in structure "iocb" dcl 1-6 in procedure "tape_ansi_file_cntl_" set ref 502* position based structure array level 3 in structure "cseg" packed unaligned dcl 2-14 in procedure "tape_ansi_file_cntl_" prec builtin function dcl 131 ref 1661 qcode 3 000247 automatic fixed bin(35,0) initial level 2 dcl 87 set ref 87* 528* 604* 665* 1744* 1750* 1756* 1762* 1775* 1780* qi 000247 automatic structure level 1 dcl 87 set ref 529 529 606 606 615 615 666 666 1790 1790 rcp_id based fixed bin(6,0) array level 4 dcl 2-14 set ref 1979 2126 2130 2697* read_errors based fixed bin(17,0) array level 4 packed unaligned dcl 2-14 set ref 2695* read_length 224 based structure level 2 in structure "cseg" unaligned dcl 2-14 in procedure "tape_ansi_file_cntl_" read_length 122 based entry variable level 2 in structure "iocb" dcl 1-6 in procedure "tape_ansi_file_cntl_" set ref 501* read_record 72 based entry variable level 2 dcl 1-6 set ref 498* 500* reccnt 222 based fixed bin(35,0) level 3 dcl 2-14 set ref 1905* reclen 47 based fixed bin(21,0) level 3 in structure "fd" dcl 3-3 in procedure "tape_ansi_file_cntl_" set ref 1073 1082 1091 1093 1093 1093 1548 1551 1554 1561* 1643 1651* 1655* 1658* 1661* 1667 1671 1876 1881 1884 1889 1892 1924 1929 1932 1937 2556 2556* 2558 2561* reclen 2(18) based char(5) level 2 in structure "ansi_hdr2" packed unaligned dcl 8-8 in procedure "tape_ansi_file_cntl_" set ref 1184* 1427 reclen 47 based fixed bin(21,0) initial level 3 in structure "fl" dcl 4-3 in procedure "tape_ansi_file_cntl_" set ref 825* 837* 1183 1213 1427* 1471* 1554 1558 1561 1667* 1671* 2556 recording_technique 10(18) based char(2) level 2 packed unaligned dcl 10-8 set ref 1221* 1485 reg_data based structure array level 3 packed unaligned dcl 2-14 replace_id 204 based char(17) level 2 packed unaligned dcl 2-14 ref 255 255 695 906 993 996 reserved 15 based char(28) level 2 in structure "ansi_hdr2" packed unaligned dcl 8-8 in procedure "tape_ansi_file_cntl_" set ref 1204* reserved 22(09) based char(7) level 2 in structure "ansi_hdr1" packed unaligned dcl 7-8 in procedure "tape_ansi_file_cntl_" set ref 1164* reserved1 11(09) based char(1) level 2 in structure "ibm_hdr2" packed unaligned dcl 10-8 in procedure "tape_ansi_file_cntl_" set ref 1223* reserved1 2(18) based char(1) level 2 in structure "ibm_vol1" packed unaligned dcl 6-7 in procedure "tape_ansi_file_cntl_" set ref 1830* reserved1 2(27) based char(26) level 2 in structure "ansi_vol1" packed unaligned dcl 5-7 in procedure "tape_ansi_file_cntl_" set ref 1822* reserved2 14(27) based char(28) level 2 in structure "ansi_vol1" packed unaligned dcl 5-7 in procedure "tape_ansi_file_cntl_" set ref 1824* reserved2 5(09) based char(20) level 2 in structure "ibm_vol1" packed unaligned dcl 6-7 in procedure "tape_ansi_file_cntl_" set ref 1832* reserved2 11(27) based char(41) level 2 in structure "ibm_hdr2" packed unaligned dcl 10-8 in procedure "tape_ansi_file_cntl_" set ref 1231* reserved3 14(27) based char(29) level 2 packed unaligned dcl 6-7 set ref 1834* rlN 226 based fixed bin(21,0) level 3 dcl 2-14 set ref 1897* 3083* saveP 000102 automatic pointer dcl 2630 set ref 2647* 2677 scode 2 000247 automatic fixed bin(35,0) level 2 dcl 87 set ref 527* 603* 612* 628* 664* 1738* 1745* search_id 000210 automatic char(17) unaligned dcl 67 set ref 244* 255* 257* 981 1013 section 6(27) based char(4) level 2 in structure "ansi_hdr1" packed unaligned dcl 7-8 in procedure "tape_ansi_file_cntl_" set ref 954 1131* 1250 section 27 based fixed bin(17,0) level 3 in structure "fl" dcl 4-3 in procedure "tape_ansi_file_cntl_" set ref 529* 954 970 1130 1217 1250* 1251 1257 1310 1310 1344* 1350* 1354* 1354 1356* 1697* 1697 2488* 2917 2917 3044 3126 3126 sequence 30 based fixed bin(17,0) level 3 in structure "fd" dcl 3-3 in procedure "tape_ansi_file_cntl_" set ref 698 701* 703* 711 718 904 978 984 990 1016* 2489 2513* 2534* 2607* sequence 7(27) based char(4) level 2 in structure "ansi_hdr1" packed unaligned dcl 7-8 in procedure "tape_ansi_file_cntl_" set ref 1152* 1253 sequence 30 based fixed bin(17,0) level 3 in structure "fl" dcl 4-3 in procedure "tape_ansi_file_cntl_" set ref 703 718 984 990 1016 1151 1253* 1254 1260 1345* 1358* 1359 1371 1698* 1698 2489* 2513 2534 2607 set_id 5(09) based char(6) level 2 in structure "ansi_hdr1" packed unaligned dcl 7-8 in procedure "tape_ansi_file_cntl_" set ref 1125* 1249 set_id 15 based char(32) level 3 in structure "fl" dcl 4-3 in procedure "tape_ansi_file_cntl_" set ref 1248* 1328* 1695* 1695 2486* 2486 standard 2 based fixed bin(17,0) level 2 dcl 2-14 ref 492 498 948 1070 1127 1138 1175 1244 1296 1409 1452 1551 1564 1637 1655 1667 1676 1818 1871 2254 2333 2339 2448 2468 2490 2514 2568 2859 3038 3072 3166 3189 string 105 based char(32) level 3 packed unaligned dcl 2-14 set ref 484* substr builtin function dcl 131 set ref 606 615 624 624 629 633 635 638 641 644 1086 1093 1110* 1110 1180 1210 1229 1279 1317 1318 1334 1764 2294 2806 suppress_name 1(01) 000247 automatic bit(1) level 2 packed unaligned dcl 87 set ref 526* 602* 611* 663* 1788* syncP 260 based pointer level 2 dcl 2-14 ref 1086 1093 1110 2448 2450 2468 2470 sync_buf based char(80) unaligned dcl 122 set ref 2448 2450* 2468* 2470* sys_info$max_seg_size 000172 external static fixed bin(35,0) dcl 200 ref 1661 1892 2561 system 41 based char(13) level 3 in structure "fd" dcl 3-3 in procedure "tape_ansi_file_cntl_" ref 1185 1433 1571 1705 2235 2333 2498 2573 2619 system 41 based char(13) level 3 in structure "fl" dcl 4-3 in procedure "tape_ansi_file_cntl_" set ref 1163 1185 1321* 1429 1433 1567 1571 1705* 2235 2333 2498* 2571 2573 2619* system 17 based char(13) level 2 in structure "ansi_hdr1" packed unaligned dcl 7-8 in procedure "tape_ansi_file_cntl_" set ref 1163* 1321 system_reserved 2 based char(27) level 2 in structure "old_ansi_hdr2_system_use" packed unaligned dcl 8-26 in procedure "tape_ansi_file_cntl_" ref 1436 2333 system_reserved 14(09) based char(1) level 3 in structure "ansi_hdr2" packed unaligned dcl 8-8 in procedure "tape_ansi_file_cntl_" set ref 1201* system_use 3(27) based structure level 2 packed unaligned dcl 8-8 set ref 1436 1439 1440 1441 2333 t 000215 automatic fixed bin(17,0) dcl 67 set ref 1224* 1226* 1227* 1227 1229 1487* 1488 1490 1493* 1493 1498 t1 000216 automatic picture(1) unaligned dcl 67 set ref 1192* 1193 1215* 1216 t2 000217 automatic picture(2) unaligned dcl 67 set ref 1148* 1149 1202* 1203 t4 000220 automatic picture(4) unaligned dcl 67 set ref 1130* 1131 1135* 1136 1146* 1147 1151* 1152 t5 000222 automatic picture(5) unaligned dcl 67 set ref 1181* 1182 1183* 1184 1211* 1212 1213* 1214 t6 000224 automatic picture(6) unaligned dcl 67 set ref 1160* 1161 tag 000107 constant varying char(12) initial array dcl 95 ref 254 tape_ansi_control_ 000026 constant entry external dcl 135 ref 504 3240 tape_ansi_detach_ 000030 constant entry external dcl 135 ref 3238 tape_ansi_file_cntl_$close 000034 constant entry external dcl 135 ref 488 tape_ansi_file_cntl_$open 000036 constant entry external dcl 135 ref 3239 tape_ansi_ibm_lrec_io_$close 000044 constant entry external dcl 135 ref 2861 3040 3074 3168 3192 tape_ansi_ibm_lrec_io_$read_record 000046 constant entry external dcl 135 ref 500 tape_ansi_ibm_lrec_io_$write_record 000050 constant entry external dcl 135 ref 494 tape_ansi_lrec_io_$close 000012 constant entry external dcl 135 ref 2859 3038 3072 3166 3189 tape_ansi_lrec_io_$read_record 000014 constant entry external dcl 135 ref 498 tape_ansi_lrec_io_$write_record 000016 constant entry external dcl 135 ref 492 tape_ansi_mount_cntl_$mount 000056 constant entry external dcl 135 ref 1985 tape_ansi_mount_cntl_$remount 000060 constant entry external dcl 135 ref 2004 tape_ansi_position_ 000062 constant entry external dcl 135 ref 502 tape_ansi_read_length_ 000064 constant entry external dcl 135 ref 501 tape_ansi_tape_io_$get_buffer 000066 constant entry external dcl 135 ref 1105 tape_ansi_tape_io_$open 000070 constant entry external dcl 135 ref 1907 tape_ansi_tape_io_$order 000072 constant entry external dcl 135 ref 749 1063 1101 1810 1848 2143 2157 2165 2175 2181 2186 2200 2207 2308 2771 3230 tape_ansi_tape_io_$sync_read 000074 constant entry external dcl 135 ref 1066 2435 tape_ansi_tape_io_$sync_write 000076 constant entry external dcl 135 ref 2472 tape_drive based char(32) array level 4 packed unaligned dcl 2-14 set ref 2011 2699* terminate_process_ 000100 constant entry external dcl 135 ref 1725 testP 000206 automatic pointer dcl 67 set ref 270* 272 272* 350* 382 text parameter char unaligned dcl 3259 set ref 3257 3261* ti 000100 automatic structure level 1 dcl 1717 set ref 1725 1725 tracks based fixed bin(17,0) array level 4 packed unaligned dcl 2-14 set ref 2691* tseg 312 based structure level 2 dcl 2-14 tstring 000226 automatic varying char(32) dcl 67 set ref 243* 251* 254* 254 483 484 uninit_msg 000103 automatic char(40) initial array unaligned dcl 1972 set ref 1972* 1972* 1972* 1972* 1972* 1972* 2025* usage_count based fixed bin(17,0) array level 4 packed unaligned dcl 2-14 set ref 2694* vX parameter fixed bin(17,0) dcl 1800 in procedure "initialize_volume" ref 1798 1807 1807 1809 1816 1823 1833 vX parameter fixed bin(17,0) dcl 1734 in procedure "initialize_permit" ref 1732 1739 1742 1765 1790 vX parameter fixed bin(17,0) dcl 1966 in procedure "move_tape_" set ref 1964 1979 1985* 2004* 2011 2012 2014 2014 2018 2021 2025 2025 2031 2031 2031 2036 2036* 2044 2050* 2055 2059 2064 2064 2065 2068 2071 2072 2076 2079 2080 2086 2092 2095 2100 2105 2107 2110 2125 2129 vcN 126 based fixed bin(17,0) level 2 dcl 2-14 set ref 2129 2225 2246 2250* 2250 2252* 2253 2254 2254 2640 2662 verify builtin function dcl 131 ref 1086 1093 version 11(27) based char(2) level 2 in structure "ansi_hdr1" packed unaligned dcl 7-8 in procedure "tape_ansi_file_cntl_" set ref 1149* 1316 2296 version 000247 automatic fixed bin(17,0) initial level 2 in structure "qi" dcl 87 in procedure "tape_ansi_file_cntl_" set ref 87* version 32 based fixed bin(17,0) level 3 in structure "fl" dcl 4-3 in procedure "tape_ansi_file_cntl_" set ref 1148 1316* 1700* 1700 2296* 2493* 2514* 2514 2610* version 000100 automatic fixed bin(17,0) initial level 2 in structure "ti" dcl 1717 in procedure "handler" set ref 1717* version 11(27) based char(2) level 2 in structure "ibm_hdr1" packed unaligned dcl 9-8 in procedure "tape_ansi_file_cntl_" set ref 1142* vl based structure array level 2 unaligned dcl 2-14 vlX 5 based fixed bin(17,0) initial level 2 dcl 4-3 set ref 395* 437* 465* 523 557* 564* 584 754 754 755 758 758 759 759 774* 784 784 811* 825* 837* 853* 853 854 855 859* 859 860 860 874 882 921* 940 1135 1248 1281* 1284* 1289* 1328 1365 1369 1383 1480 1952* 2225 2228 2316 2349 2350 2389 2389 2422 2422 2653 2656 2657 2658 2660 2662 2777 2777 2778 2781 2781 2782 2782 2801* 2809* 2812* 2815* 2857 2857 2927* 2969 2970 3048* 3098* 3177 3229 vn 000237 automatic char(32) unaligned dcl 67 set ref 624* 2241* 2253 vol_data based structure array level 3 unaligned dcl 2-14 volname based char(32) array level 4 packed unaligned dcl 2-14 set ref 1248 1328 1790* 1807* 2025* 2253* 2254* 2316 2349 2969 volume_id 1 based char(6) level 2 packed unaligned dcl 5-7 set ref 1816* volume_sequence 6(27) based char(4) level 2 packed unaligned dcl 9-8 set ref 1136* 1330 write_VOL1 based fixed bin(17,0) array level 4 dcl 2-14 set ref 1739 2014* 2014 2018 2021 2025 2031 2031* 2036 2044 2055* 2700* write_errors based fixed bin(17,0) array level 4 packed unaligned dcl 2-14 set ref 2696* write_record 76 based entry variable level 2 dcl 1-6 set ref 492* 494* x parameter fixed bin(17,0) dcl 1171 in procedure "fill_XXX2" ref 1169 1179 1188 1209 x parameter fixed bin(17,0) dcl 1117 in procedure "fill_XXX1" ref 1115 1123 1156 x 000114 automatic fixed bin(17,0) dcl 2711 in procedure "write_HDRs" set ref 2714* 2723* 2732* 2734* 2741 2753* yes_no 1 000247 automatic bit(1) level 2 packed unaligned dcl 87 set ref 525* 601* 610* 662* 1786* zaP 000104 automatic pointer dcl 2630 set ref 2670* 2672 2673* 2675 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. ANSI_EOF1 internal static fixed bin(17,0) initial dcl 7-26 ANSI_EOF2 internal static fixed bin(17,0) initial dcl 8-34 ANSI_EOV1 internal static fixed bin(17,0) initial dcl 7-26 ANSI_EOV2 internal static fixed bin(17,0) initial dcl 8-34 ANSI_HDR1 internal static fixed bin(17,0) initial dcl 7-26 ANSI_HDR2 internal static fixed bin(17,0) initial dcl 8-34 ANSI_L1_ID internal static char(4) initial array unaligned dcl 7-24 ANSI_L2_ID internal static char(4) initial array unaligned dcl 8-32 ANSI_SYS_CODE internal static char(13) initial unaligned dcl 7-29 ANSI_VOL1 internal static char(4) initial unaligned dcl 5-19 CONSOLE_DTYPEX internal static fixed bin(17,0) initial dcl 12-31 DEVICE_TYPE internal static char(32) initial array unaligned dcl 12-18 DISK_DRIVE_DTYPEX internal static fixed bin(17,0) initial dcl 12-30 DISK_VOL_VTYPEX internal static fixed bin(17,0) initial dcl 12-38 IBM_EOF1 internal static fixed bin(17,0) initial dcl 9-25 IBM_EOF2 internal static fixed bin(17,0) initial dcl 10-36 IBM_EOV1 internal static fixed bin(17,0) initial dcl 9-25 IBM_EOV2 internal static fixed bin(17,0) initial dcl 10-36 IBM_HDR1 internal static fixed bin(17,0) initial dcl 9-25 IBM_HDR2 internal static fixed bin(17,0) initial dcl 10-36 IBM_L1_ID internal static char(4) initial array unaligned dcl 9-23 IBM_L2_ID internal static char(4) initial array unaligned dcl 10-34 IBM_SYS_CODE internal static char(13) initial unaligned dcl 9-28 IBM_VOL1 internal static char(4) initial unaligned dcl 6-18 LABEL_STANDARD_VERSION internal static char(1) initial unaligned dcl 5-20 MCA_DTYPEX internal static fixed bin(17,0) initial dcl 12-36 MULTICS_ANSI_VERSION internal static char(7) initial unaligned dcl 5-22 MULTICS_IBM_VERSION internal static char(7) initial unaligned dcl 6-19 NUM_QUALIFIERS internal static fixed bin(17,0) initial array dcl 12-22 PRINTER_DTYPEX internal static fixed bin(17,0) initial dcl 12-32 PUNCH_DTYPEX internal static fixed bin(17,0) initial dcl 12-33 READER_DTYPEX internal static fixed bin(17,0) initial dcl 12-34 SPECIAL_DTYPEX internal static fixed bin(17,0) initial dcl 12-35 TAPE_DRIVE_DTYPEX internal static fixed bin(17,0) initial dcl 12-29 Tape_volume_types internal static char(16) initial array unaligned dcl 11-29 Volume_blank internal static fixed bin(17,0) initial dcl 11-15 Volume_gcos_tape internal static fixed bin(17,0) initial dcl 11-15 Volume_multics_tape internal static fixed bin(17,0) initial dcl 11-15 Volume_unauthenticated internal static fixed bin(17,0) initial dcl 11-15 Volume_unknown_format internal static fixed bin(17,0) initial dcl 11-15 Volume_unreadable internal static fixed bin(17,0) initial dcl 11-15 cseg_tseg_version_2 internal static fixed bin(17,0) initial dcl 2-12 error_table_$incompatible_encoding_mode external static fixed bin(35,0) dcl 170 ibm_system_use based structure level 1 packed unaligned dcl 10-30 iox_$iocb_version_sentinel external static char(4) dcl 1-51 NAMES DECLARED BY EXPLICIT CONTEXT. HDR_search 016232 constant label dcl 2146 ref 2155 2182 IBM_fill_XXX2 011224 constant label dcl 1207 ref 1175 IBM_fill_fl_from_HDR2 012710 constant label dcl 1464 ref 1409 UL_search 016472 constant label dcl 2198 ref 2194 2205 abort_fail 005323 constant label dcl 582 set ref 549 559 565 569 575 abort_fail1 005344 constant label dcl 584 ref 538 abort_file 005001 constant entry internal dcl 518 ref 890 action_type 000000 constant label array(4) dcl 424 ref 422 another_volume 005405 constant entry internal dcl 593 ref 2246 any_eot 003322 constant label dcl 2952 ref 2948 append_file 006144 constant entry internal dcl 674 ref 286 ask 005503 constant label dcl 612 set ref 617 655 ask_raw 005512 constant label dcl 615 ref 630 back_TM 006345 constant entry internal dcl 740 ref 476 1956 2390 2423 3101 bad 017170 constant label dcl 2281 ref 2290 2327 bad_EOX 017567 constant label dcl 2357 ref 2272 2342 bad_hdr1 012260 constant label dcl 1393 ref 1243 1251 1254 1334 1359 bad_hdr2 013051 constant label dcl 1504 ref 1408 1413 1416 1425 1455 1466 1469 1480 1482 1485 1488 bad_open 001570 constant label dcl 235 set ref 249 251 bad_seq 011554 constant label dcl 1266 ref 1276 1302 1310 1365 1377 1383 beginning_of_file 003614 constant entry external dcl 3029 bof_fail 003743 constant label dcl 3052 ref 3036 3041 build1 006525 constant entry internal dcl 767 ref 278 357 2903 3112 build2 006713 constant entry internal dcl 805 ref 332 345 366 3090 build_eofsl 006767 constant entry internal dcl 820 ref 421 543 735 2799 build_fl 007072 constant entry internal dcl 832 ref 773 build_fl1 007211 constant label dcl 847 ref 840 chain_tape_error 007663 constant label dcl 933 ref 951 953 954 958 close 004231 constant entry external dcl 3135 close_exit 004601 constant label dcl 3225 ref 2867 2982 3054 3080 3171 3201 close_exit1 004651 constant label dcl 3233 ref 3157 3158 close_fail 004525 constant label dcl 3199 ref 3165 3176 3186 3206 3210 3219 comment 005777 constant label dcl 645 ref 639 common 002445 constant label dcl 463 ref 454 consistent 007325 constant entry internal dcl 867 ref 226 511 2865 2980 3052 3078 3169 3199 continue_close 004471 constant label dcl 3189 ref 3002 create_file 002425 constant label dcl 456 ref 286 creating_first 007453 constant entry internal dcl 895 ref 1276 1337 2031 data_eof 002722 constant entry external dcl 2841 data_eof_fail 003075 constant label dcl 2865 ref 2850 2854 2874 2904 2914 2922 2928 data_eot 003241 constant entry external dcl 2935 debug_off 004770 constant entry external dcl 3252 debug_on 004755 constant entry external dcl 3247 debug_print 022301 constant entry internal dcl 3257 ref 339 386 400 424 448 456 520 676 724 770 809 822 834 844 869 898 918 933 967 973 1017 1022 1053 1119 1173 1241 1406 1512 1613 1691 1804 1861 1946 1977 2122 2140 2222 2270 2368 2404 2482 2530 2603 2627 2707 2719 2728 2794 2844 2938 3011 default_reclen 000012 constant label array(4) dcl 1651 ref 1649 desired_check 007560 constant entry internal dcl 913 ref 301 311 376 desired_file 010041 constant entry internal dcl 965 ref 295 done 002535 constant label dcl 481 ref 398 446 479 end_of_file 003754 constant entry external dcl 3062 eof_fail 004063 constant label dcl 3078 ref 3069 3070 3091 3099 3102 3113 3123 3131 eof_loop 004075 constant label dcl 3086 ref 3133 eot_not_while_closing 003316 constant label dcl 2946 ref 3023 eot_while_closing 003320 constant label dcl 2949 ref 3184 er_exit 002707 constant label dcl 511 ref 265 279 333 346 358 367 396 438 466 470 473 477 923 927 945 1064 1067 1103 1107 1526 1624 1912 1915 1953 1957 2545 error 016011 constant label dcl 2110 ref 1990 2006 2028 2041 2051 2134 2144 2153 2158 2167 2177 2184 2187 2203 2209 exit 021301 constant label dcl 2677 extend_chain 002045 constant label dcl 339 ref 307 313 extend_check 010263 constant entry internal dcl 1047 ref 444 extend_file 002316 constant label dcl 424 fill_XXX1 010561 constant entry internal dcl 1115 ref 2734 fill_XXX2 011017 constant entry internal dcl 1169 ref 2753 fill_fdhdr2_from_fl 013056 constant entry internal dcl 1510 ref 2521 2616 fill_fl_from_HDR1 011371 constant entry internal dcl 1236 ref 787 fill_fl_from_HDR2 012266 constant entry internal dcl 1400 ref 796 fill_flhdr2_from_fd 013223 constant entry internal dcl 1611 ref 2500 2522 2617 fill_new_section_fl 013372 constant entry internal dcl 1689 ref 2827 find_candidate 016042 constant entry internal dcl 2120 ref 2002 finish_up 011734 constant label dcl 1314 ref 1346 1390 free 021240 constant label dcl 2670 ref 2650 generate_file 002400 constant label dcl 448 got_volname 016754 constant label dcl 2250 ref 2242 handler 013474 constant entry internal dcl 1715 ref 486 3236 ibm_open 014622 constant label dcl 1917 ref 1871 initialize_permit 013551 constant entry internal dcl 1732 ref 2036 initialize_permitA 013606 constant entry internal dcl 1742 ref 1281 2809 initialize_volume 014063 constant entry internal dcl 1798 ref 548 1284 2050 2812 input 002171 constant label dcl 386 ref 303 inv_blk 014616 constant label dcl 1913 ref 1865 1917 inv_rec 014612 constant label dcl 1910 ref 1876 1881 1884 1889 1892 1924 1929 1932 1937 ip_com 013745 constant label dcl 1786 ref 1747 1753 1759 1772 1778 last_chance 007610 constant label dcl 921 ref 941 lrec_open 014457 constant entry internal dcl 1859 ref 391 443 463 3057 make_eofsl_real 007167 constant entry internal dcl 842 ref 734 2797 match 010170 constant label dcl 1017 in procedure "desired_file" ref 984 996 1001 1003 match 000027 constant label array(4) dcl 1892 in procedure "lrec_open" ref 1923 mis_match 013111 constant label dcl 1524 ref 1539 1554 1558 1577 1585 1599 modify_file 002316 constant label dcl 424 move_backward 016345 constant entry internal dcl 2172 ref 2081 2090 2101 move_forward 016305 constant entry internal dcl 2162 ref 2073 2096 move_tape_ 014757 constant entry internal dcl 1964 ref 395 437 465 557 564 774 811 921 1289 1952 2801 2815 2927 3048 3098 move_to_EOD 014662 constant entry internal dcl 1943 ref 433 move_to_first_HDR 016165 constant entry internal dcl 2138 ref 2062 move_to_first_UHL 016463 constant entry internal dcl 2191 move_to_first_UTL 016467 constant entry internal dcl 2195 new_file_set 011565 constant label dcl 1276 ref 1308 1369 1388 next_volume 016566 constant entry internal dcl 2217 ref 2316 2346 2959 no 010213 constant label dcl 1022 ref 986 990 no_EOX2 017330 constant label dcl 2312 ref 2325 no_defaults 013251 constant label dcl 1622 ref 1635 1647 not_enough 020522 constant label dcl 2543 ref 2553 2563 ok 014562 constant label dcl 1897 ref 1880 1883 1888 1891 1928 1931 1936 1939 ok_exit 015743 constant label dcl 2105 open 001500 constant entry external dcl 202 output 002234 constant label dcl 400 ref 323 378 383 position_for_output 003511 constant entry external dcl 3006 process_EOX 017066 constant entry internal dcl 2264 ref 814 2873 query 000016 constant label array(2:6) dcl 1750 set ref 1739 re_fill 000007 constant label array(3) dcl 1246 ref 1244 1296 re_init 011625 constant label dcl 1284 ref 1279 read_HDR1 017575 constant entry internal dcl 2363 ref 777 926 1293 read_HDR2 017737 constant entry internal dcl 2400 ref 790 read_label 020057 constant entry internal dcl 2430 ref 2146 2198 2276 2300 2373 2409 recovery 000004 constant label array(0:2) dcl 874 ref 872 retry 015551 constant label dcl 2062 ref 2116 rewrite 010503 constant label dcl 1101 ref 1075 rewrite_test 010475 constant label dcl 1098 ref 1093 set_fl_reclen 013335 constant label dcl 1667 ref 1653 1659 setup_for_create 020312 constant entry internal dcl 2480 ref 461 setup_for_extend_modify 020406 constant entry internal dcl 2507 ref 442 setup_for_generate 020630 constant entry internal dcl 2601 ref 453 setup_for_read 020463 constant entry internal dcl 2528 ref 390 switch 015132 constant label dcl 2002 ref 1995 tape_ansi_file_cntl_ 001464 constant entry external dcl 32 test 000023 constant label array(4) dcl 1876 ref 1875 truncate_chains 020715 constant entry internal dcl 2625 ref 420 542 587 884 uninit_error 015251 constant label dcl 2025 ref 2031 valid_exit 002713 constant label dcl 514 ref 237 291 321 364 415 731 999 1006 1036 vl_init 021306 constant entry internal dcl 2684 ref 2252 write_EOFs 021532 constant entry internal dcl 2717 ref 568 3209 write_EOVs 021572 constant entry internal dcl 2726 ref 2985 write_HDRs 021475 constant entry internal dcl 2705 ref 469 2829 write_TM 021713 constant entry internal dcl 2762 ref 472 537 574 2835 2975 2991 3019 3180 3205 3215 write_data_fail 003436 constant label dcl 2980 ref 2944 2956 2963 2986 2992 2997 3015 3025 write_label 020207 constant entry internal dcl 2465 ref 1838 1844 2736 2754 write_labels 021631 constant label dcl 2734 ref 2715 2724 write_new_section 022075 constant entry internal dcl 2790 ref 2996 write_permit 006045 constant entry internal dcl 659 ref 411 yes 006273 constant label dcl 724 ref 711 718 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 24004 24200 22357 24014 Length 25212 22357 174 775 1425 2 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME tape_ansi_file_cntl_ 622 external procedure is an external procedure. on unit on line 224 64 on unit on unit on line 262 64 on unit on unit on line 486 64 on unit abort_file internal procedure shares stack frame of internal procedure consistent. another_volume 134 internal procedure is called by several nonquick procedures. append_file internal procedure shares stack frame of external procedure tape_ansi_file_cntl_. back_TM 81 internal procedure is called by several nonquick procedures. build1 internal procedure shares stack frame of external procedure tape_ansi_file_cntl_. build2 internal procedure shares stack frame of external procedure tape_ansi_file_cntl_. build_eofsl 75 internal procedure is called by several nonquick procedures. build_fl internal procedure shares stack frame of external procedure tape_ansi_file_cntl_. consistent 166 internal procedure is called by several nonquick procedures. creating_first 76 internal procedure is called by several nonquick procedures. desired_check 276 internal procedure enables or reverts conditions. on unit on line 953 64 on unit desired_file internal procedure shares stack frame of external procedure tape_ansi_file_cntl_. extend_check internal procedure shares stack frame of external procedure tape_ansi_file_cntl_. fill_XXX1 internal procedure shares stack frame of internal procedure write_HDRs. fill_XXX2 internal procedure shares stack frame of internal procedure write_HDRs. fill_fl_from_HDR1 402 internal procedure enables or reverts conditions. on unit on line 1243 64 on unit fill_fl_from_HDR2 280 internal procedure enables or reverts conditions. on unit on line 1408 64 on unit fill_fdhdr2_from_fl internal procedure shares stack frame of external procedure tape_ansi_file_cntl_. fill_flhdr2_from_fd internal procedure shares stack frame of external procedure tape_ansi_file_cntl_. fill_new_section_fl internal procedure shares stack frame of external procedure tape_ansi_file_cntl_. handler 82 internal procedure is called by several nonquick procedures. initialize_permit 140 internal procedure is called by several nonquick procedures. initialize_volume 98 internal procedure is called by several nonquick procedures. lrec_open internal procedure shares stack frame of external procedure tape_ansi_file_cntl_. move_to_EOD internal procedure shares stack frame of external procedure tape_ansi_file_cntl_. move_tape_ 224 internal procedure is called by several nonquick procedures. find_candidate internal procedure shares stack frame of internal procedure move_tape_. move_to_first_HDR internal procedure shares stack frame of internal procedure move_tape_. next_volume 139 internal procedure is called by several nonquick procedures. process_EOX 404 internal procedure enables or reverts conditions. on unit on line 2272 64 on unit read_HDR1 78 internal procedure is called by several nonquick procedures. read_HDR2 internal procedure shares stack frame of external procedure tape_ansi_file_cntl_. read_label 100 internal procedure is called by several nonquick procedures. setup_for_create internal procedure shares stack frame of external procedure tape_ansi_file_cntl_. setup_for_extend_modify internal procedure shares stack frame of external procedure tape_ansi_file_cntl_. setup_for_read internal procedure shares stack frame of external procedure tape_ansi_file_cntl_. setup_for_generate internal procedure shares stack frame of external procedure tape_ansi_file_cntl_. truncate_chains 95 internal procedure enables or reverts conditions. on unit on line 2637 67 on unit vl_init internal procedure shares stack frame of internal procedure next_volume. write_HDRs 276 internal procedure is called by several nonquick procedures. write_TM 81 internal procedure is called by several nonquick procedures. write_new_section internal procedure shares stack frame of external procedure tape_ansi_file_cntl_. on unit on line 2850 64 on unit on unit on line 2851 64 on unit on unit on line 2944 64 on unit on unit on line 2952 64 on unit on unit on line 3015 64 on unit on unit on line 3036 64 on unit on unit on line 3069 64 on unit on unit on line 3070 64 on unit on unit on line 3149 64 on unit on unit on line 3157 64 on unit on unit on line 3165 64 on unit on unit on line 3176 64 on unit on unit on line 3236 64 on unit debug_print 72 internal procedure is called by several nonquick procedures. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 debug tape_ansi_file_cntl_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME another_volume 000100 msg another_volume 000125 L1 another_volume back_TM 000100 cnt back_TM desired_check 000100 can_retry desired_check fill_fl_from_HDR1 000100 nv fill_fl_from_HDR1 fill_fl_from_HDR2 000100 canon_std fill_fl_from_HDR2 handler 000100 ti handler initialize_permit 000100 msg initialize_permit 000137 extra1 initialize_permit 000143 extra2 initialize_permit initialize_volume 000100 i initialize_volume 000101 j initialize_volume 000102 k initialize_volume move_tape_ 000100 i move_tape_ 000101 j move_tape_ 000102 can_retry move_tape_ 000103 uninit_msg move_tape_ next_volume 000100 canon_std next_volume process_EOX 000100 canon_std process_EOX read_label 000100 nchar read_label tape_ansi_file_cntl_ 000100 cP tape_ansi_file_cntl_ 000102 ansi_vol1P tape_ansi_file_cntl_ 000104 ibm_vol1P tape_ansi_file_cntl_ 000106 ansi_hdr1P tape_ansi_file_cntl_ 000110 ansi_hdr2P tape_ansi_file_cntl_ 000112 ibm_hdr1P tape_ansi_file_cntl_ 000114 ibm_hdr2P tape_ansi_file_cntl_ 000116 answer tape_ansi_file_cntl_ 000157 cc tape_ansi_file_cntl_ 000160 com_text tape_ansi_file_cntl_ 000201 eofs tape_ansi_file_cntl_ 000202 close_eot tape_ansi_file_cntl_ 000203 format_override tape_ansi_file_cntl_ 000204 new_link tape_ansi_file_cntl_ 000205 mask tape_ansi_file_cntl_ 000206 testP tape_ansi_file_cntl_ 000210 search_id tape_ansi_file_cntl_ 000215 t tape_ansi_file_cntl_ 000216 t1 tape_ansi_file_cntl_ 000217 t2 tape_ansi_file_cntl_ 000220 t4 tape_ansi_file_cntl_ 000222 t5 tape_ansi_file_cntl_ 000224 t6 tape_ansi_file_cntl_ 000226 tstring tape_ansi_file_cntl_ 000237 vn tape_ansi_file_cntl_ 000247 qi tape_ansi_file_cntl_ 000346 i extend_check 000347 j extend_check 000400 i lrec_open truncate_chains 000100 i truncate_chains 000102 saveP truncate_chains 000104 zaP truncate_chains write_HDRs 000114 x write_HDRs write_TM 000100 cnt write_TM THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as alloc_char_temp call_ext_out_desc call_ext_out call_int_this_desc call_int_this call_int_other_desc call_int_other return_mac tra_ext_1 mdfx1 signal_op enable_op shorten_stack ext_entry int_entry int_entry_desc trunc_fx2 any_to_any_truncate_divide_fx1 op_alloc_ op_freen_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. ascii_to_ebcdic_ authenticate_ canon_for_volume_label_ command_query_ continue_to_signal_ ebcdic_to_ascii_ hcs_$reset_ips_mask hcs_$set_ips_mask ioa_ iox_$propagate tape_ansi_control_ tape_ansi_detach_ tape_ansi_file_cntl_$close tape_ansi_file_cntl_$open tape_ansi_ibm_lrec_io_$close tape_ansi_ibm_lrec_io_$read_record tape_ansi_ibm_lrec_io_$write_record tape_ansi_lrec_io_$close tape_ansi_lrec_io_$read_record tape_ansi_lrec_io_$write_record tape_ansi_mount_cntl_$mount tape_ansi_mount_cntl_$remount tape_ansi_position_ tape_ansi_read_length_ tape_ansi_tape_io_$get_buffer tape_ansi_tape_io_$open tape_ansi_tape_io_$order tape_ansi_tape_io_$sync_read tape_ansi_tape_io_$sync_write terminate_process_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$device_limit_exceeded error_table_$discrepant_block_count error_table_$duplicate_file_id error_table_$end_of_info error_table_$eof_record error_table_$eov_on_write error_table_$file_aborted error_table_$file_busy error_table_$incompatible_attach error_table_$incompatible_file_attribute error_table_$insufficient_open error_table_$invalid_block_length error_table_$invalid_cseg error_table_$invalid_expiration error_table_$invalid_file_set_format error_table_$invalid_label_format error_table_$invalid_record_length error_table_$invalid_volume_sequence error_table_$no_file error_table_$no_next_volume error_table_$noalloc error_table_$positioned_on_bot error_table_$unable_to_do_io error_table_$unexpired_file error_table_$unexpired_volume error_table_$uninitialized_volume sys_info$max_seg_size LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 87 001456 32 001463 202 001472 205 001511 208 001517 211 001521 212 001524 215 001525 218 001527 219 001532 223 001533 224 001534 226 001550 227 001555 228 001560 229 001561 232 001564 235 001570 237 001573 240 001574 243 001577 244 001604 245 001610 249 001611 251 001613 254 001623 255 001641 257 001651 260 001655 262 001657 264 001673 265 001676 268 001701 269 001702 270 001706 272 001710 276 001720 277 001722 278 001724 279 001732 283 001734 286 001741 290 001746 291 001751 295 001752 298 001757 301 001763 303 001771 307 001772 311 001775 313 002003 317 002007 320 002021 321 002024 323 002025 329 002026 332 002030 333 002036 337 002040 339 002045 342 002064 345 002066 346 002074 350 002076 351 002101 352 002107 355 002113 356 002115 357 002117 358 002125 360 002127 363 002134 364 002137 366 002140 367 002146 369 002150 370 002151 371 002153 373 002154 376 002157 378 002165 382 002166 383 002170 386 002171 389 002206 390 002207 391 002210 395 002211 396 002231 398 002233 400 002234 403 002251 405 002252 408 002255 411 002266 414 002277 415 002302 420 002303 421 002307 422 002313 424 002316 433 002337 437 002345 438 002364 441 002366 442 002370 443 002371 444 002372 446 002377 448 002400 452 002421 453 002423 454 002424 456 002425 460 002442 461 002444 463 002445 465 002446 466 002465 468 002467 469 002471 470 002477 472 002501 473 002513 476 002520 477 002532 479 002534 481 002535 483 002536 484 002541 485 002545 486 002546 487 002570 488 002603 489 002614 492 002620 494 002630 495 002634 498 002635 500 002645 501 002651 502 002654 504 002657 505 002662 506 002664 507 002674 508 002704 509 002706 511 002707 514 002713 516 002715 2841 002716 2844 002733 2846 002750 2849 002756 2850 002757 2851 002776 2853 003012 2854 003015 2857 003020 2859 003045 2861 003062 2862 003073 2865 003075 2867 003101 2870 003102 2873 003106 2874 003114 2878 003116 2881 003122 2884 003125 2885 003130 2891 003131 2894 003135 2895 003140 2898 003141 2902 003150 2903 003152 2904 003160 2906 003162 2909 003163 2912 003170 2913 003173 2914 003175 2917 003176 2920 003207 2921 003212 2922 003213 2927 003214 2928 003232 2931 003234 2933 003236 2935 003237 2938 003252 2940 003267 2943 003275 2944 003277 2946 003316 2948 003317 2949 003320 2952 003322 2955 003336 2956 003341 2959 003344 2962 003355 2963 003360 2969 003363 2970 003407 2975 003417 2976 003431 2980 003436 2982 003442 2985 003443 2986 003451 2991 003453 2992 003465 2996 003472 2997 003500 3000 003502 3002 003504 3004 003506 3006 003507 3009 003522 3011 003530 3014 003551 3015 003553 3019 003572 3021 003604 3023 003606 3025 003611 3029 003612 3032 003625 3035 003633 3036 003634 3038 003653 3040 003671 3041 003702 3044 003704 3046 003717 3048 003723 3049 003741 3052 003743 3054 003747 3057 003750 3060 003751 3062 003752 3065 003765 3068 003773 3069 003774 3070 004013 3072 004032 3074 004050 3075 004061 3078 004063 3080 004067 3083 004070 3084 004073 3086 004075 3090 004101 3091 004107 3095 004111 3098 004116 3099 004134 3101 004136 3102 004150 3104 004152 3107 004153 3111 004162 3112 004164 3113 004172 3115 004174 3118 004175 3121 004202 3122 004205 3123 004207 3126 004210 3129 004221 3130 004224 3131 004225 3133 004226 3135 004227 3138 004242 3141 004250 3144 004252 3145 004255 3149 004256 3150 004276 3153 004301 3156 004303 3157 004306 3158 004325 3161 004326 3164 004331 3165 004332 3166 004351 3168 004367 3169 004400 3171 004406 3175 004407 3176 004411 3177 004430 3180 004451 3181 004463 3184 004465 3186 004470 3189 004471 3192 004507 3193 004520 3196 004522 3199 004525 3201 004531 3205 004532 3206 004544 3209 004551 3210 004557 3215 004561 3216 004573 3219 004575 3225 004601 3229 004604 3230 004626 3231 004647 3233 004651 3235 004652 3236 004653 3237 004675 3238 004710 3239 004721 3240 004724 3241 004727 3242 004731 3243 004741 3244 004751 3245 004753 3247 004754 3249 004763 3250 004766 3252 004767 3254 004776 3255 005000 518 005001 520 005002 523 005023 525 005047 526 005051 527 005053 528 005056 529 005057 534 005120 537 005126 538 005142 541 005143 542 005150 543 005155 545 005162 548 005167 549 005202 551 005205 554 005206 557 005211 559 005232 561 005235 564 005236 565 005255 567 005260 568 005264 569 005273 574 005276 575 005311 579 005317 580 005322 582 005323 584 005344 586 005370 587 005372 588 005377 589 005403 593 005404 601 005412 602 005415 603 005417 604 005421 605 005422 606 005427 607 005463 610 005477 611 005501 612 005503 614 005505 615 005512 617 005551 619 005557 620 005560 621 005571 624 005574 625 005635 628 005641 629 005642 630 005663 633 005665 635 005717 638 005723 639 005747 641 005750 644 005753 645 005777 648 006002 649 006012 650 006013 654 006021 655 006035 657 006036 659 006044 662 006052 663 006055 664 006057 665 006062 666 006063 668 006122 670 006136 674 006144 676 006146 691 006165 693 006177 695 006210 698 006222 701 006225 703 006234 704 006241 708 006242 711 006246 713 006251 718 006257 720 006265 724 006273 727 006310 730 006323 731 006326 733 006327 734 006331 735 006332 736 006336 740 006344 742 006352 748 006376 749 006407 751 006431 754 006434 755 006463 758 006467 759 006474 761 006522 763 006524 767 006525 770 006527 773 006544 774 006545 775 006565 777 006571 778 006601 780 006605 783 006610 784 006614 785 006647 787 006650 788 006656 790 006662 791 006670 793 006674 796 006700 797 006706 800 006712 805 006713 809 006715 811 006732 812 006753 814 006757 815 006765 820 006766 822 006774 825 007011 826 007063 827 007064 828 007071 832 007072 834 007073 837 007110 838 007160 839 007161 840 007166 842 007167 844 007170 847 007211 850 007220 853 007223 854 007226 855 007246 856 007266 859 007267 860 007271 863 007323 867 007324 869 007332 872 007351 874 007354 877 007403 879 007404 882 007411 883 007433 884 007435 885 007442 887 007443 890 007450 891 007451 895 007452 898 007460 900 007501 902 007514 904 007525 906 007537 909 007551 913 007557 915 007565 918 007567 921 007610 923 007631 926 007637 927 007651 930 007657 933 007663 936 007705 939 007707 940 007710 941 007734 943 007735 944 007741 945 007744 948 007747 951 007753 953 007761 954 010000 956 010030 957 010031 958 010032 961 010040 965 010041 967 010043 970 010064 973 010071 975 010106 978 010114 981 010117 984 010123 986 010125 990 010126 993 010130 996 010134 998 010140 999 010143 1001 010144 1003 010150 1005 010156 1006 010161 1013 010162 1016 010166 1017 010170 1020 010205 1022 010213 1025 010230 1028 010234 1031 010237 1034 010245 1036 010250 1040 010251 1045 010257 1047 010263 1053 010264 1056 010304 1058 010310 1060 010315 1063 010320 1064 010340 1066 010342 1067 010356 1070 010360 1073 010364 1075 010372 1080 010376 1082 010404 1083 010411 1086 010412 1088 010431 1091 010433 1092 010442 1093 010447 1096 010472 1098 010475 1101 010503 1103 010523 1105 010525 1107 010541 1109 010543 1110 010552 1111 010560 1115 010561 1119 010563 1122 010603 1123 010612 1124 010621 1125 010626 1127 010631 1130 010634 1131 010643 1132 010646 1135 010647 1136 010656 1138 010662 1141 010667 1142 010673 1143 010676 1146 010677 1147 010706 1148 010712 1149 010722 1151 010725 1152 010734 1153 010740 1154 010750 1155 010760 1156 010763 1160 010773 1161 011004 1163 011010 1164 011013 1165 011016 1169 011017 1173 011021 1175 011042 1178 011047 1179 011051 1180 011057 1181 011064 1182 011074 1183 011077 1184 011107 1185 011112 1188 011117 1190 011130 1191 011134 1192 011146 1193 011161 1194 011165 1197 011166 1198 011172 1199 011175 1201 011200 1202 011204 1203 011215 1204 011220 1205 011223 1207 011224 1209 011226 1210 011234 1211 011241 1212 011251 1213 011254 1214 011264 1215 011267 1216 011277 1217 011302 1219 011311 1220 011314 1221 011331 1222 011335 1223 011341 1224 011344 1226 011351 1227 011353 1229 011360 1231 011364 1232 011367 1236 011370 1241 011376 1243 011417 1244 011436 1246 011442 1248 011451 1249 011471 1250 011476 1251 011516 1253 011520 1254 011541 1257 011543 1260 011546 1263 011551 1266 011554 1268 011560 1270 011561 1273 011562 1276 011565 1279 011577 1281 011610 1284 011625 1287 011642 1289 011645 1291 011666 1293 011671 1294 011703 1296 011706 1298 011712 1300 011716 1302 011717 1305 011723 1308 011724 1310 011727 1314 011734 1316 011756 1317 011777 1318 012004 1319 012010 1320 012014 1321 012034 1322 012040 1325 012041 1328 012050 1329 012070 1330 012075 1331 012112 1334 012114 1337 012122 1341 012140 1342 012144 1344 012145 1345 012152 1346 012153 1350 012154 1354 012165 1356 012176 1358 012200 1359 012221 1362 012223 1365 012226 1368 012231 1369 012232 1371 012234 1374 012237 1377 012242 1380 012245 1383 012246 1387 012253 1388 012254 1390 012257 1393 012260 1395 012264 1400 012265 1404 012273 1406 012304 1408 012322 1409 012341 1412 012346 1413 012361 1415 012362 1416 012402 1418 012404 1421 012406 1422 012411 1425 012440 1427 012441 1429 012465 1432 012471 1433 012512 1436 012517 1439 012530 1440 012545 1441 012567 1442 012574 1443 012577 1446 012600 1447 012614 1448 012634 1449 012640 1452 012644 1455 012700 1457 012703 1458 012704 1462 012707 1464 012710 1466 012723 1468 012724 1469 012744 1471 012746 1477 012772 1480 012777 1482 013002 1485 013006 1487 013012 1488 013023 1490 013024 1493 013026 1494 013030 1498 013035 1500 013042 1501 013044 1502 013050 1504 013051 1506 013055 1510 013056 1512 013057 1515 013100 1518 013104 1521 013107 1524 013111 1526 013114 1528 013115 1529 013117 1532 013120 1533 013122 1536 013123 1539 013125 1542 013127 1543 013130 1545 013132 1548 013135 1551 013137 1554 013142 1557 013144 1558 013145 1561 013147 1564 013151 1567 013154 1570 013160 1571 013162 1574 013166 1577 013170 1580 013173 1581 013174 1582 013176 1585 013200 1588 013202 1589 013203 1591 013205 1592 013206 1593 013207 1596 013210 1599 013212 1602 013215 1603 013216 1604 013220 1607 013222 1611 013223 1613 013224 1616 013242 1619 013246 1622 013251 1624 013254 1626 013255 1627 013257 1629 013261 1630 013264 1632 013266 1635 013270 1637 013273 1639 013301 1641 013303 1643 013305 1647 013307 1649 013312 1651 013314 1653 013316 1655 013317 1658 013325 1659 013330 1661 013331 1667 013335 1671 013343 1673 013344 1676 013346 1678 013354 1680 013356 1682 013360 1683 013362 1684 013363 1685 013371 1689 013372 1691 013373 1694 013414 1695 013422 1696 013425 1697 013431 1698 013434 1699 013436 1700 013440 1701 013442 1702 013446 1703 013452 1704 013454 1705 013455 1707 013461 1708 013464 1710 013472 1715 013473 1717 013501 1721 013502 1724 013505 1725 013507 1728 013532 1729 013542 1736 013544 1732 013550 1738 013557 1739 013563 1742 013605 1744 013614 1745 013616 1746 013621 1747 013626 1750 013627 1752 013631 1753 013636 1756 013637 1758 013641 1759 013646 1762 013647 1764 013651 1765 013657 1766 013670 1767 013675 1770 013713 1772 013725 1775 013726 1777 013730 1778 013735 1780 013736 1782 013740 1786 013745 1788 013747 1790 013751 1792 014037 1794 014054 1798 014062 1804 014070 1807 014106 1809 014150 1810 014166 1811 014206 1814 014211 1815 014220 1816 014224 1818 014250 1821 014254 1822 014257 1823 014262 1824 014301 1825 014304 1826 014307 1827 014311 1830 014312 1831 014316 1832 014321 1833 014324 1834 014340 1835 014343 1838 014345 1839 014354 1842 014357 1843 014367 1844 014404 1845 014414 1847 014417 1848 014425 1850 014447 1852 014452 1853 014454 1855 014456 1859 014457 1861 014460 1865 014477 1868 014507 1870 014515 1871 014517 1874 014522 1875 014525 1876 014527 1880 014533 1881 014534 1883 014537 1884 014540 1888 014544 1889 014545 1891 014547 1892 014550 1897 014562 1901 014565 1902 014567 1904 014575 1905 014600 1906 014601 1907 014602 1908 014611 1910 014612 1912 014615 1913 014616 1915 014621 1917 014622 1923 014631 1924 014633 1928 014640 1929 014641 1931 014645 1932 014646 1936 014654 1937 014655 1939 014661 1943 014662 1946 014663 1948 014703 1950 014715 1952 014721 1953 014737 1956 014741 1957 014753 1960 014755 1964 014756 1970 014764 1972 014765 1977 015040 1979 015057 1982 015100 1985 015103 1987 015116 1990 015121 1993 015124 1995 015130 1999 015131 2002 015132 2004 015133 2006 015152 2011 015155 2012 015202 2014 015207 2018 015223 2021 015242 2025 015251 2027 015332 2028 015336 2031 015337 2036 015402 2040 015437 2041 015443 2044 015444 2050 015470 2051 015501 2055 015504 2058 015523 2059 015525 2062 015551 2064 015552 2065 015606 2068 015614 2071 015644 2072 015650 2073 015665 2074 015666 2076 015667 2079 015670 2080 015674 2081 015707 2082 015710 2086 015711 2089 015725 2090 015727 2091 015730 2092 015731 2095 015732 2096 015735 2097 015736 2100 015737 2101 015742 2105 015743 2107 015775 2108 016010 2110 016011 2112 016035 2115 016037 2116 016040 2118 016041 2120 016042 2122 016043 2125 016065 2126 016077 2128 016117 2129 016121 2130 016135 2132 016155 2133 016160 2134 016164 2138 016165 2140 016166 2143 016205 2144 016227 2146 016232 2148 016242 2151 016245 2153 016252 2155 016253 2157 016261 2158 016301 2160 016304 2162 016305 2164 016306 2165 016315 2167 016337 2169 016342 2170 016344 2172 016345 2174 016346 2175 016357 2177 016401 2179 016404 2181 016406 2182 016430 2184 016435 2186 016437 2187 016457 2189 016462 2191 016463 2193 016464 2194 016466 2195 016467 2197 016470 2198 016472 2200 016502 2203 016530 2205 016532 2207 016542 2209 016561 2211 016564 2217 016565 2220 016573 2222 016604 2225 016624 2228 016640 2231 016642 2232 016662 2235 016670 2238 016675 2241 016701 2242 016704 2246 016705 2248 016746 2250 016754 2252 016755 2253 016763 2254 017006 2257 017046 2260 017057 2264 017065 2268 017073 2270 017104 2272 017123 2273 017142 2274 017146 2276 017152 2278 017162 2281 017165 2285 017174 2288 017175 2290 017212 2294 017220 2296 017226 2298 017246 2300 017267 2302 017277 2305 017302 2308 017305 2310 017325 2312 017330 2316 017336 2319 017375 2322 017401 2325 017402 2327 017410 2330 017420 2333 017425 2338 017445 2339 017451 2342 017507 2346 017512 2349 017524 2350 017551 2351 017561 2352 017562 2355 017566 2357 017567 2359 017573 2363 017574 2368 017602 2370 017622 2371 017627 2373 017636 2375 017645 2378 017650 2381 017656 2382 017661 2384 017662 2386 017663 2389 017666 2390 017714 2391 017727 2395 017736 2400 017737 2404 017741 2406 017760 2407 017763 2409 017767 2411 017776 2414 020001 2417 020012 2419 020013 2422 020016 2423 020043 2426 020055 2430 020056 2435 020064 2437 020100 2440 020103 2443 020106 2444 020111 2448 020112 2450 020124 2455 020140 2458 020143 2460 020167 2462 020205 2465 020206 2468 020214 2470 020226 2472 020242 2474 020261 2476 020311 2480 020312 2482 020313 2485 020334 2486 020342 2487 020346 2488 020352 2489 020354 2490 020356 2492 020364 2493 020365 2494 020366 2495 020372 2496 020376 2497 020400 2498 020401 2500 020404 2502 020405 2507 020406 2509 020407 2512 020430 2513 020436 2514 020440 2516 020450 2517 020454 2521 020460 2522 020461 2524 020462 2528 020463 2530 020464 2533 020505 2534 020513 2536 020515 2539 020517 2540 020521 2543 020522 2545 020525 2547 020526 2548 020527 2549 020530 2551 020532 2553 020536 2556 020540 2558 020544 2561 020546 2563 020556 2568 020560 2571 020563 2573 020571 2576 020575 2578 020601 2580 020605 2583 020606 2585 020612 2588 020616 2591 020617 2593 020623 2597 020627 2601 020630 2603 020631 2606 020652 2607 020660 2609 020662 2610 020667 2611 020670 2612 020674 2613 020700 2614 020702 2616 020703 2617 020704 2619 020705 2621 020713 2625 020714 2627 020722 2634 020743 2637 020752 2639 020766 2640 020774 2641 021006 2642 021026 2643 021042 2644 021050 2645 021052 2647 021053 2648 021057 2649 021061 2650 021064 2653 021072 2656 021113 2657 021117 2658 021133 2659 021141 2660 021142 2662 021163 2663 021173 2664 021213 2665 021227 2666 021235 2668 021237 2670 021240 2672 021244 2673 021254 2674 021261 2675 021275 2677 021301 2680 021305 2684 021306 2687 021310 2688 021331 2689 021345 2690 021353 2691 021361 2692 021367 2693 021400 2694 021406 2695 021414 2696 021421 2697 021427 2698 021435 2699 021443 2700 021452 2701 021456 2702 021473 2705 021474 2707 021502 2713 021522 2714 021526 2715 021530 2717 021531 2719 021537 2721 021557 2722 021564 2723 021566 2724 021570 2726 021571 2728 021577 2730 021620 2731 021625 2732 021627 2734 021631 2736 021633 2737 021643 2741 021651 2745 021662 2748 021667 2749 021670 2753 021671 2754 021673 2755 021703 2758 021711 2762 021712 2768 021720 2770 021743 2771 021753 2773 021775 2777 022003 2778 022032 2781 022037 2782 022044 2784 022072 2786 022074 2790 022075 2794 022077 2796 022115 2797 022122 2799 022123 2801 022127 2802 022147 2805 022153 2806 022156 2809 022165 2812 022201 2813 022214 2815 022220 2817 022237 2819 022243 2822 022244 2823 022250 2827 022251 2829 022252 2830 022261 2835 022265 2837 022277 3257 022300 3261 022314 3262 022325 ----------------------------------------------------------- Historical Background This edition of the Multics software materials and documentation is provided and donated to Massachusetts Institute of Technology by Group BULL including BULL HN Information Systems Inc. as a contribution to computer science knowledge. This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology, Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell BULL Inc., Groupe BULL and BULL HN Information Systems Inc. to the development of this operating system. Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970), renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership of Professor Fernando Jose Corbato. Users consider that Multics provided the best software architecture for managing computer hardware properly and for executing programs. Many subsequent operating systems incorporated Multics principles. Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. . ----------------------------------------------------------- Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without fee is hereby granted,provided that the below copyright notice and historical background appear in all copies and that both the copyright notice and historical background and this permission notice appear in supporting documentation, and that the names of MIT, HIS, BULL or BULL HN not be used in advertising or publicity pertaining to distribution of the programs without specific prior written permission. Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc. Copyright 2006 by BULL HN Information Systems Inc. Copyright 2006 by Bull SAS All Rights Reserved