COMPILATION LISTING OF SEGMENT tape_ansi_nl_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 0851.7 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 /* */ 16 /* tape_ansi_nl_file_cntl_ */ 17 /* */ 18 /* Main logic module of tape_ansi_ for unlabeled volumes. See */ 19 /* individual entries for details of use and calling sequence. */ 20 /* */ 21 /* 0) Created: 10/04/74 by Ross E. Klinger */ 22 /* 1) Modified: 10/04/74 by C. D. Tavares for resource management */ 23 /* 2) Modified: 06/29/79 by Rick Riley */ 24 /* (to allow reading/writing unlabeled ibm file sets */ 25 /* 3) Modified: 9/79 by R.J.C. Kissel for new tseg. */ 26 /* 4) Modified: 4/82 by J. A. Bush for block sizes > 8192 bytes */ 27 /* */ 28 /* * * * * * * * * * * * * * * * * * * * * * * */ 29 30 31 /* format: style3,ind3,dclind6,idind32 */ 32 tape_ansi_nl_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: ibm_hdr1.incl.pl1 */ 4 2 /* Modified by J. A. Bush 04/26/83 for use by mtape_ */ 4 3 4 4 /* format: style4 */ 4 5 4 6 dcl ibm_hdr1P ptr; /* pointer on which ibm_hdr1 is based */ 4 7 4 8 dcl 1 ibm_hdr1 unaligned based (ibm_hdr1P), 4 9 2 label_id char (4), /* HDR1/EOF1/EOV1 */ 4 10 2 dataset_id char (17), /* equivalent to ANSI file identifier */ 4 11 2 dataset_serial char (6), /* equivalent to ANSI file set identifier */ 4 12 2 volume_sequence char (4), /* volume sequence number - no ANSI equivalent */ 4 13 2 dataset_sequence char (4), /* equivalent to ANSI file sequence number */ 4 14 2 generation char (4), /* " " if not member of generation data set */ 4 15 2 version char (2), /* " " if not member of generation data set */ 4 16 2 creation char (6), /* " yyddd" - equivalent to ANSI creation date */ 4 17 2 expiration char (6), /* " yyddd" - equivalent to ANSI expiration date */ 4 18 2 security char (1), /* "0" on output :: ignored on input */ 4 19 2 blkcnt char (6), /* equivalent to ANSI block count */ 4 20 2 system char (13), /* system code = "MULTICS IBM2 " for mtape_ */ 4 21 2 reserved char (7); /* " " */ 4 22 4 23 dcl IBM_L1_ID (3) char (4) int static options (constant) init 4 24 ("HDR1", "EOV1", "EOF1"); 4 25 dcl (IBM_HDR1 init (1), 4 26 IBM_EOV1 init (2), 4 27 IBM_EOF1 init (3)) fixed bin int static options (constant); 4 28 dcl IBM_SYS_CODE char (13) int static options (constant) init ("MULTICS IBM2 "); 4 29 4 30 /* END INCLUDE FILE: ibm_hdr1.incl.pl1 */ 47 48 5 1 /* --------------- BEGIN include file rcp_volume_formats.incl.pl1 --------------- */ 5 2 5 3 5 4 5 5 /****^ HISTORY COMMENTS: 5 6* 1) change(86-12-08,GWMay), approve(86-12-08,PBF7552), 5 7* audit(86-12-08,Martinson), install(86-12-17,MR12.0-1250): 5 8* added array entry 0 to the volume format types to indicate that the tape 5 9* volume was not authenticated by rcp. 5 10* END HISTORY COMMENTS */ 5 11 5 12 5 13 /* General volume types */ 5 14 5 15 dcl (Volume_unauthenticated initial (0), 5 16 Volume_blank initial (1), 5 17 Volume_unknown_format initial (6), 5 18 Volume_unreadable initial (7), 5 19 5 20 /* Tape volume types */ 5 21 5 22 Volume_multics_tape initial (2), 5 23 Volume_gcos_tape initial (3), 5 24 Volume_ibm_tape initial (4), 5 25 Volume_ansi_tape initial (5)) fixed bin static options (constant); 5 26 5 27 /* Printable descriptions of volume types */ 5 28 5 29 dcl Tape_volume_types (0:7) char (16) static options (constant) initial 5 30 ("unauthenticated", 5 31 "blank", 5 32 "Multics", 5 33 "GCOS", 5 34 "IBM", 5 35 "ANSI", 5 36 "unrecognizable", 5 37 "unreadable"); 5 38 5 39 /* ---------------- END include file rcp_volume_formats.incl.pl1 ---------------- */ 49 50 6 1 /* Begin include file ... rcp_resource_types.incl.pl1 6 2* * 6 3* * Created 3/79 by Michael R. Jordan for MR7.0R 6 4* * 6 5* * This include file defines the official RCP resource types. 6 6* * The array of names is indexed by the corresponding device type. 6 7* * MOD by RAF for MCA 6 8**/ 6 9 6 10 6 11 6 12 /****^ HISTORY COMMENTS: 6 13* 1) change(85-09-09,Fawcett), approve(85-09-09,MCR6979), 6 14* audit(85-12-09,CLJones), install(86-03-21,MR12.0-1033): 6 15* Support of MCA. 6 16* END HISTORY COMMENTS */ 6 17 6 18 dcl DEVICE_TYPE (8) char (32) 6 19 internal static options (constant) 6 20 init ("tape_drive", "disk_drive", "console", "printer", "punch", "reader", "special", "mca"); 6 21 6 22 dcl NUM_QUALIFIERS (8) fixed bin /* Number of qualifiers for each device type. */ 6 23 internal static init (3, 0, 0, 2, 0, 0, 0, 0); 6 24 6 25 dcl VOLUME_TYPE (8) char (32) 6 26 internal static options (constant) 6 27 init ("tape_vol", "disk_vol", "", "", "", "", "", ""); 6 28 6 29 dcl TAPE_DRIVE_DTYPEX fixed bin static internal options (constant) init (1); 6 30 dcl DISK_DRIVE_DTYPEX fixed bin static internal options (constant) init (2); 6 31 dcl CONSOLE_DTYPEX fixed bin static internal options (constant) init (3); 6 32 dcl PRINTER_DTYPEX fixed bin static internal options (constant) init (4); 6 33 dcl PUNCH_DTYPEX fixed bin static internal options (constant) init (5); 6 34 dcl READER_DTYPEX fixed bin static internal options (constant) init (6); 6 35 dcl SPECIAL_DTYPEX fixed bin static internal options (constant) init (7); 6 36 dcl MCA_DTYPEX fixed bin static internal options (constant) init (8); 6 37 dcl TAPE_VOL_VTYPEX fixed bin static internal options (constant) init (1); 6 38 dcl DISK_VOL_VTYPEX fixed bin static internal options (constant) init (2); 6 39 6 40 6 41 /* End include file ... rcp_resource_types.incl.pl1 */ 51 52 53 54 /* automatic storage */ 55 dcl answer char (128) varying, 56 com_text char (64) varying, 57 vn char (32), 58 cc fixed bin, /* consistency code */ 59 /* 0 - invalidate volume position */ 60 /* 1 - invalidate volume position and current file link */ 61 /* 2 - invalidate position, current file link, write EOV TM */ 62 mask bit (36) aligned, 63 tstring char (32) varying; /* open description temporary */ 64 65 dcl 1 qi aligned, /* query info structure */ 66 2 version fixed bin init (2), 67 2 yes_no bit (1) unaligned, 68 2 suppress_name bit (1) unaligned, 69 2 scode fixed bin (35), 70 2 qcode fixed bin (35) init (0); 71 72 /* internal static */ 73 dcl debug bit (1) internal static initial ("0"b); 74 /* debug switch */ 75 76 77 /* conditions */ 78 dcl (any_other, cleanup) condition; 79 80 /* builtin functions */ 81 dcl (addr, index, length, ltrim, mod, null, substr) 82 builtin; 83 84 /* external procedures */ 85 dcl canon_for_volume_label_ ext entry (char (*), char (*), char (*), fixed bin, fixed bin (35)), 86 command_query_ ext entry options (variable), 87 continue_to_signal_ ext entry (fixed bin (35)), 88 tape_ansi_control_ ext entry (ptr, char (*), ptr, fixed bin (35)), 89 tape_ansi_detach_ ext entry (ptr, fixed bin (35)), 90 tape_ansi_nl_file_cntl_$close ext entry (ptr, fixed bin (35)), 91 tape_ansi_nl_file_cntl_$open ext entry (ptr, fixed bin, bit (1) aligned, fixed bin (35)), 92 hcs_$reset_ips_mask ext entry (bit (36) aligned, bit (36) aligned), 93 hcs_$set_ips_mask ext entry (bit (36) aligned, bit (36) aligned), 94 tape_ansi_ibm_lrec_io_$close ext entry (ptr, fixed bin (35)), 95 tape_ansi_ibm_lrec_io_$read_record 96 ext entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35)), 97 tape_ansi_ibm_lrec_io_$write_record 98 ext entry (ptr, ptr, fixed bin (21), fixed bin (35)), 99 ioa_ ext entry options (variable), 100 iox_$propagate ext entry (ptr), 101 tape_ansi_mount_cntl_$mount ext entry (ptr, fixed bin, fixed bin (35)), 102 tape_ansi_mount_cntl_$remount ext entry (ptr, fixed bin, fixed bin, fixed bin (35)), 103 tape_ansi_position_ ext entry (ptr, fixed bin, fixed bin (21), fixed bin (35)), 104 tape_ansi_read_length_ ext entry (ptr, fixed bin (21), fixed bin (35)), 105 tape_ansi_tape_io_$open ext entry (ptr), 106 tape_ansi_tape_io_$order ext entry (ptr, char (3), fixed bin, fixed bin (35)), 107 terminate_process_ ext entry (char (*), ptr); 108 109 110 /* external static */ 111 dcl ( 112 error_table_$blank_tape, 113 error_table_$device_limit_exceeded, 114 error_table_$end_of_info, 115 error_table_$eov_on_write, 116 error_table_$file_aborted, 117 error_table_$file_busy, 118 error_table_$incompatible_attach, 119 error_table_$incompatible_encoding_mode, 120 error_table_$insufficient_open, 121 error_table_$invalid_block_length, 122 error_table_$invalid_cseg, 123 error_table_$invalid_file_set_format, 124 error_table_$invalid_record_length, 125 error_table_$no_file, 126 error_table_$no_next_volume, 127 error_table_$positioned_on_bot, 128 error_table_$unable_to_do_io, 129 error_table_$uninitialized_volume 130 ) fixed bin (35) ext static; 131 132 dcl sys_info$max_seg_size fixed bin (35) external static; 133 134 open: 135 entry (iocbP, open_mode, extend_bit, code); 136 137 cP = iocbP -> iocb.actual_iocb_ptr -> iocb.attach_data_ptr; 138 /* get pointer to control segment */ 139 140 if cseg.invalid 141 then 142 do; /* is control segment invalid? */ 143 code = error_table_$invalid_cseg; 144 return; 145 end; 146 147 if cseg.file_lock 148 then 149 do; /* is file in use (by previous invocation)? */ 150 code = error_table_$file_busy; 151 return; 152 end; 153 else 154 do; 155 cc = 0; /* minimal consistency requirement */ 156 on cleanup 157 begin; /* insure file chain <--> tape consistency */ 158 call consistent; 159 cseg.file_lock = "0"b; /* unlock the file */ 160 end; 161 cseg.file_lock = "1"b; /* not in use - now it is */ 162 end; 163 164 if extend_bit 165 then 166 do; /* extend at open time not allowed */ 167 bad_open: 168 code = error_table_$incompatible_attach; 169 go to valid_exit; 170 end; 171 172 if open_mode = 4 173 then tstring = "sequential_input"; /* set for sequential input */ 174 else 175 do; /* sequential output or input_output */ 176 if cseg.output_mode = 0 177 then go to bad_open; /* no output mode specified */ 178 if open_mode = 5 179 then tstring = "sequential_output -create"; 180 else go to bad_open; 181 end; 182 183 cseg.open_mode = open_mode; /* save open mode in control segment */ 184 185 /* OLD */ 186 cseg.flP = null; 187 fd.vlX = 1; 188 189 /* OLD */ 190 /* NEW * / 191* cseg.flP = null; /* set the file index pointer no there are none * / 192* if fd.vlX = 0 193* then 194* do; /* if the vol index not set then set it * / 195* fd.vlX = 1; /* set to initial vol and first file * / 196* vl (1).fflX = 1; 197* go to found_it; 198* end; 199* 200* if append_file () 201* then 202* do; /* when writeing a file we need to find the file * / 203* do i = 1 to cseg.vcN; /* search forward for the file * / 204* if vl (i).fflX ^= 0 205* then /* only searching vols that have files * / 206* if (fd.sequence >= vl (i).fflX & (fd.sequence <= vl (i).lflX + 1 | vl (i).lflX = 0)) 207* then 208* do; /* then test for a file fit on the volume * / 209* fd.vlX = i; 210* if vl (i).lflX = 0 | fd.sequence <= vl (i).lflX 211* then go to found_it; /* if a new file keep looking * / 212* else 213* do j = i to cseg.vcN; /* look until you find the volume. 214* New files can only be 1+ the last written * / 215* if vl (j).fflX ^= 0 216* then if (fd.sequence >= vl (j).fflX & (fd.sequence <= vl (j).lflX + 1 | vl (j).lflX = 0)) 217* then fd.vlX = j; 218* end; 219* go to found_it; 220* end; 221* end; 222* code = error_table_$no_file; 223* go to er_exit; 224* end; 225* 226* else 227* do i = 1 to cseg.vcN; /* check for the desired file in the volume index list 228* and first and last of the vols * / 229* if vl (i).fflX = 0 230* then go to no_find; 231* if (fd.sequence >= vl (i).fflX & fd.sequence <= vl (i).lflX) | (fd.sequence >= vl (i).fflX & vl (i).lflX = 0) 232* then 233* do; /* want volume file first appears on * / 234* fd.vlX = i; 235* go to found_it; 236* end; 237* 238* end; 239*no_find: 240* code = error_table_$no_file; 241* go to er_exit; 242* 243*found_it: 244*/* NEW */ 245 if cseg.open_mode = 4 246 then 247 do; /* input */ 248 if fd.format = 0 249 then 250 do; 251 not_enough: 252 code = error_table_$insufficient_open; 253 go to valid_exit; 254 end; 255 if fd.blklen = 0 256 then go to not_enough; 257 if fd.reclen = 0 258 then 259 do; 260 if fd.format = 1 261 then ; 262 else go to not_enough; 263 end; 264 if fd.mode = 0 265 then fd.mode = 2; 266 267 268 call move (fd.vlX, fd.sequence, code); /* move to the file */ 269 if code ^= 0 270 then go to er_exit; 271 call lrec_open; 272 end; 273 274 else 275 do; /* output */ 276 if fd.format = 0 277 then 278 do; 279 fd.format = 3; 280 fd.blocked = "1"b; 281 end; 282 if fd.blklen = 0 283 then fd.blklen = 8192; 284 if fd.reclen = 0 285 then 286 do; 287 if fd.format = 1 288 then ; 289 else if fd.format = 2 290 then fd.reclen = fd.blklen; 291 else if fd.format = 3 292 then fd.reclen = 8188; 293 else fd.reclen = sys_info$max_seg_size * 4; 294 end; 295 if fd.mode = 0 296 then fd.mode = 2; 297 298 call move (fd.vlX, fd.sequence, code); /* move to the file */ 299 if code ^= 0 300 then go to er_exit; /* NEW * / 301* 302* do i = fd.vlX + 1 to cseg.vcN; /* reinit the vol indexes above this last file * / 303* call vl_init (i); 304* end; 305*/* NEW */ 306 call lrec_open; 307 end; 308 309 done: 310 mask = "0"b; /* ips interrupts not masked yet */ 311 cseg.open_description.length = length (tstring); /* prepare open description */ 312 cseg.open_description.string = tstring; 313 revert cleanup; 314 on any_other call handler; /* pick up any condition */ 315 call hcs_$set_ips_mask ("0"b, mask); /* mask all ips interrupts */ 316 iocbP -> iocb.actual_iocb_ptr -> iocb.close = tape_ansi_nl_file_cntl_$close; 317 if cseg.open_mode = 5 318 then iocbP -> iocb.actual_iocb_ptr -> iocb.write_record = tape_ansi_ibm_lrec_io_$write_record; 319 else 320 do; /* sequential input */ 321 iocbP -> iocb.actual_iocb_ptr -> iocb.read_record = tape_ansi_ibm_lrec_io_$read_record; 322 iocbP -> iocb.actual_iocb_ptr -> iocb.read_length = tape_ansi_read_length_; 323 iocbP -> iocb.actual_iocb_ptr -> iocb.position = tape_ansi_position_; 324 end; 325 iocbP -> iocb.actual_iocb_ptr -> iocb.control = tape_ansi_control_; 326 iocbP -> iocb.actual_iocb_ptr -> iocb.open_descrip_ptr = addr (cseg.open_description); 327 call iox_$propagate (iocbP -> iocb.actual_iocb_ptr); 328 call hcs_$reset_ips_mask (mask, mask); /* permit ips interrupts */ 329 cseg.file_lock = "0"b; /* open complete - unlock the file */ 330 return; 331 332 er_exit: 333 call consistent; 334 go to valid_exit; 335 336 337 no_next_volume: 338 code = error_table_$no_next_volume; 339 340 341 valid_exit: 342 cseg.file_lock = "0"b; /* open complete - unlock the file */ 343 return; /* NEW * / 344* 345*append_file: 346* procedure returns (bit (1)); 347* 348* if debug 349* then call debug_print ("append_file"); 350* if cseg.open_mode ^= 5 351* then return ("0"b); 352* if cseg.output_mode ^= 4 353* then return ("0"b); 354* 355* return ("1"b); 356* 357* end append_file; 358* 359*/* NEW */ 360 abort_file: 361 procedure; /* cleanup after defective file */ 362 if debug 363 then call debug_print ("abort_file"); 364 365 vl (fd.vlX).cflX = 0; /* invalidate volume position */ 366 367 /* OLD */ 368 call write_TM (2, code); /* write the TMs */ 369 /* OLD */ 370 /* NEW * / 371* call write_TM (3, code); /* write the TMs * / 372*/* NEW */ 373 if code ^= 0 374 then if code ^= error_table_$eov_on_write 375 then go to abort_fail; 376 377 /* OLD */ 378 call ioa_ ("^a: Unrecoverable error while writing file; double TM written.", cseg.module); 379 /* OLD */ 380 /* NEW * / 381* call ioa_ ("^a: Unrecoverable error while writing file; triple TM written.", cseg.module); 382* /* NEW */ 383 code = error_table_$file_aborted; 384 return; 385 386 abort_fail: 387 call ioa_ ("^a: Unrecoverable error while writing file; unable to write double TM.", cseg.module); 388 code = error_table_$invalid_file_set_format; 389 return; 390 391 end abort_file; 392 393 consistent: 394 procedure; /* insures file chain/tape consistency */ 395 if debug 396 then call debug_print ("consistent"); 397 398 go to recovery (cc); /* perform appropriate consistency processing */ 399 400 recovery (0): 401 return; 402 403 404 recovery (1): 405 if fd.vlX ^= 0 406 then vl (fd.vlX).cflX = 0; /* invalidate volume position */ 407 return; 408 409 recovery (2): 410 if fd.vlX = 0 411 then return; /* nothing can be done - exit */ 412 call abort_file; /* write end of volume TMs */ 413 return; 414 415 end consistent; 416 417 handler: 418 procedure; /* intercept any faults during iocb manipulation */ 419 dcl 1 ti aligned, 420 2 version fixed bin init (0), 421 2 code fixed bin (35); 422 423 if mask ^= "0"b 424 then 425 do; /* IPS interrupts masked */ 426 ti.code = error_table_$unable_to_do_io; /* very bad trouble */ 427 call terminate_process_ ("fatal_error", addr (ti)); 428 /* kill the process */ 429 end; 430 call continue_to_signal_ (0); 431 return; 432 end handler; 433 434 initialize_permitA: 435 procedure (vX) returns (bit (1)); /* query to initialize unexpired volume */ 436 437 dcl vX fixed bin; 438 dcl msg char (120) varying; 439 dcl msg1 char (length (msg)) based (addr (substr (msg, 1))); 440 441 msg = "Volume ^a has a valid VOL1 label.^/Do you want to use this volume for unlabeled output?"; 442 go to ip_com; 443 444 445 initialize_permitB: 446 entry (vX) returns (bit (1)); /* query to initialize an unreadable volume */ 447 448 msg = "Cannot determine if volume ^a has a VOL1 label.^/Do you want to use this volume for unlabeled output?"; 449 450 ip_com: 451 qi.yes_no = "1"b; 452 qi.suppress_name = "0"b; 453 qi.scode = error_table_$uninitialized_volume; 454 455 call command_query_ (addr (qi), answer, cseg.module, msg1, vl (vX).volname); 456 457 if answer = "yes" 458 then return ("1"b); 459 else return ("0"b); 460 461 end initialize_permitA; 462 463 lrec_open: 464 procedure; /* logical record IO initialization and final checks */ 465 if debug 466 then call debug_print ("lrec_open"); 467 468 if cseg.open_mode > 4 469 then if fd.blklen < 18 470 then go to inv_blk; /* can't write < 18 chars */ 471 472 if cseg.open_mode > 4 473 then if mod (fd.blklen, 4) ^= 0 474 then go to inv_blk; /* can only write words */ 475 if fd.mode = 3 476 then cseg.mode = 0; /* binary mode is set */ 477 else cseg.mode = 1; /* ascii, ebcdic encoding 9 mode */ 478 479 go to match (fd.format); /* match the blocking */ 480 match (2): 481 if ^fd.blocked 482 then if fd.blklen ^= fd.reclen 483 then go to inv_rec; /* F unblocked */ 484 else go to ok; 485 else if mod (fd.blklen, fd.reclen) ^= 0 486 then go to inv_rec; /* F blocked */ 487 else go to ok; 488 489 match (3): 490 if ^fd.blocked 491 then if fd.blklen - 4 ^= fd.reclen 492 then go to inv_rec; 493 else go to ok; 494 else if fd.reclen > fd.blklen - 4 495 then go to inv_rec; /* V blocked */ 496 else go to ok; 497 498 match (4): 499 if fd.reclen > sys_info$max_seg_size * 4 500 then go to inv_rec; /* S format */ 501 502 match (1): 503 ok: 504 cseg.rlN = -1; /* invalidate anything in rl segment */ 505 cseg.lrec.bufP = null; /* no active buffer */ 506 cseg.blkcnt = 0; 507 cseg.lrec.reccnt = 0; /* not currently used */ 508 cseg.lrec.code = 0; /* no errors encountered */ 509 call tape_ansi_tape_io_$open (cP); /* initialize call to tape_ansi_tape_io_ */ 510 return; /* exit */ 511 512 inv_rec: 513 code = error_table_$invalid_record_length; 514 go to er_exit; 515 inv_blk: 516 code = error_table_$invalid_block_length; 517 go to er_exit; 518 bad_mode: 519 code = error_table_$incompatible_encoding_mode; 520 go to er_exit; 521 522 end lrec_open; 523 524 move: 525 procedure (vX, fX, ecode); 526 if debug 527 then call debug_print ("move"); 528 dcl vX fixed bin, /* volume link index of desired volume */ 529 fX fixed bin, /* sequence number of desired file */ 530 ecode fixed bin (35); /* error code */ 531 dcl i fixed bin, 532 uninit_msg char (28) varying; 533 cc = 0; 534 if vl (vX).rcp_id = 0 535 then 536 do; /* volume is not mounted */ 537 if cseg.nactive < cseg.ndrives 538 then 539 do; /* more drives available */ 540 call tape_ansi_mount_cntl_$mount (cP, vX, ecode); 541 /* mount the volume */ 542 if ecode ^= 0 543 then 544 do; /* maybe trouble */ 545 if ecode = error_table_$device_limit_exceeded 546 then 547 do; 548 cseg.ndrives = cseg.ndrives - 1; 549 /* decrement maximum device count */ 550 go to switch; 551 end; 552 else go to error; /* true trouble */ 553 end; 554 end; 555 else 556 do; /* no drive available */ 557 switch: 558 do i = 1 to vX - 1; /* search up to desired volume */ 559 if vl (i).rcp_id ^= 0 560 then go to got_one; /* got one active */ 561 end; 562 do i = cseg.vcN to vX + 1 by -1; /* search down to desired volume */ 563 if vl (i).rcp_id ^= 0 564 then go to got_one; /* got one active */ 565 end; 566 ecode = error_table_$invalid_cseg; /* something very wrong if no volume found */ 567 go to error; 568 got_one: 569 call tape_ansi_mount_cntl_$remount (cP, i, vX, ecode); 570 /* remount the volume */ 571 if ecode ^= 0 572 then go to error; /* trouble */ 573 end; 574 end; 575 576 cseg.tseg.drive_name = vl (vX).tape_drive; 577 cseg.tseg.ev_chan = vl (vX).event_chan; 578 fd.vlX = vX; 579 580 if cseg.open_mode = 5 581 then 582 do; /* check for VOL1 only if output */ 583 if vl (vX).write_VOL1 = 1 584 then ; /* tape is blank */ 585 else if vl (vX).write_VOL1 = 3 586 then ; /* no VOL1 label */ 587 else 588 do; /* has VOL1 label, or can't tell */ 589 if fX ^= 1 590 then 591 do; /* can't initialize if not first file on volume */ 592 if vl (vX).write_VOL1 = 2 593 then uninit_msg = "is unreadable"; 594 else uninit_msg = "is not an unlabeled volume"; 595 call ioa_ ("^a: Volume ^a ^a.", cseg.module, vl (vX).volname, uninit_msg); 596 uninit: 597 code = error_table_$uninitialized_volume; 598 go to error; 599 end; 600 go to iq (vl (vX).write_VOL1); 601 iq (6): 602 iq (0): 603 iq (4): 604 iq (5): 605 iq (-1): 606 if initialize_permitA (vX) 607 then go to ok; 608 else go to uninit; 609 iq (2): 610 if ^initialize_permitB (vX) 611 then go to uninit; 612 ok: 613 call tape_ansi_tape_io_$order (cP, "rew", 0, ecode); 614 if ecode ^= 0 615 then go to error; /* OLD */ 616 call write_TM (2, ecode); /* OLD */ 617 /* NEW * / 618* call write_TM (3, ecode); /* write the init end of vol set TMs * / 619*/* NEW */ 620 if ecode ^= 0 621 then if ecode ^= error_table_$eov_on_write 622 then go to error; /* OLD */ 623 vl (vX).cflX = 3; /* OLD */ 624 /* NEW * / 625* vl (vX).cflX = vl (vX).fflX + 3; /* set current to three after the first file * / 626*/* NEW */ 627 vl (vX).write_VOL1 = 3; 628 end; 629 end; 630 631 if vl (vX).cflX = 0 632 then 633 do; /* volume position unknown */ 634 call tape_ansi_tape_io_$order (cP, "rew", 0, ecode); 635 if ecode ^= 0 636 then go to error; /* OLD */ 637 vl (vX).cflX = 1; /* OLD */ 638 /* NEW * / 639* vl (vX).cflX = vl (vX).fflX; /* after rewind set file index to first file on volume * / 640* if fX = vl (vX).cflX 641* then go to ok_exit; /* if we are where we want to be at the beginning go on * / 642*/* NEW */ 643 end; 644 645 if vl (vX).cflX < fX 646 then 647 do; /* volume positioned before desired file */ 648 do i = 1 to fX - vl (vX).cflX; 649 call tape_ansi_tape_io_$order (cP, "fsf", 0, ecode); 650 if ecode ^= 0 651 then 652 do; 653 if ecode = error_table_$blank_tape 654 then ecode = error_table_$no_file; 655 go to error; 656 end; /* OLD */ 657 end; /* OLD */ 658 /* NEW * / 659* 660*/* when searching forward and the volume indexes 661* are not set then need to read a record looking for 662* eov or eov_set * / 663* 664* 665* if vl (fd.vlX).lflX = 0 666* then 667* do; /* check for index not set * / 668* call tape_ansi_tape_io_$sync_read (cP, nchar, ecode); 669* /* read a record * / 670* if ecode ^= 0 671* then 672* do; /* not eof error then error return * / 673* if ecode ^= error_table_$eof_record 674* then go to error; 675* else call tape_ansi_tape_io_$sync_read (cP, nchar, ecode); 676* /* read again hope its a label * / 677* 678* if ecode ^= 0 679* then 680* do; 681* if ecode = error_table_$eof_record 682* then 683* do; /* if a third eof then we know endofvolset * / 684* ecode = error_table_$no_file; 685* /* set the erorror mseg * / 686* vl (fd.vlX).lflX = vl (fd.vlX).cflX + i - 1; 687* /* set the vol index * / 688* vl (fd.vlX).cflX = vl (fd.vlX).lflX + 3; 689* if append_file () 690* then 691* do; /* check if appending to the last file * / 692* if fX ^= vl (fd.vlX).lflX + 1 693* then return; /* its okay for last +1 * / 694* else ecode = 0; 695* go to appending; 696* end; 697* 698* else return; 699* end; 700* 701* else go to error; 702* end; 703* 704* if cseg.standard = 1 705* then cseg.lbl_buf = sync_buf; /* convert ebcdic label * / 706* else call ebcdic_to_ascii_ (sync_buf, cseg.lbl_buf); 707* 708* if substr (lbl_buf, 1, 4) ^= "EOV1" 709* then 710* do; /* is this a label or not * / 711* ecode = error_table_$invalid_file_set_format; 712* /* maybe messed up * / 713* return; 714* end; 715* 716* if debug 717* then call ioa_ ("^80a", lbl_buf); 718* 719*/* mount the next volume * / 720*/* set the volume indexes as you know them * / 721* vl (fd.vlX).lflX = vl (fd.vlX).cflX + i - 1; 722* 723* if ^next_volume () 724* then 725* do; 726* ecode = error_table_$no_next_volume; 727* return; 728* end; 729* 730* fd.vlX = fd.vlX + 1; 731* vl (fd.vlX).cflX = vl (fd.vlX - 1).lflX; 732* vl (fd.vlX).fflX = vl (fd.vlX - 1).lflX; 733* vl (fd.vlX - 1).cflX = 0; 734*appending: 735* call move (fd.vlX, fd.sequence, ecode); 736* /* find the file now * / 737* if ecode ^= 0 738* then go to error; 739* else go to move_done; 740* end; 741* end; 742* 743* end; 744*move_done: 745* call tape_ansi_tape_io_$order (cP, "bsf", 0, ecode); 746* if ecode ^= 0 747* then go to error; 748* call tape_ansi_tape_io_$order (cP, "fsf", 0, ecode); 749* if ecode ^= 0 750* then go to error; 751* 752* 753*/* NEW */ 754 end; 755 756 else if vl (vX).cflX > fX 757 then 758 do; /* volume positioned after desired file */ 759 do i = 1 to vl (vX).cflX - fX; 760 call tape_ansi_tape_io_$order (cP, "bsf", 0, ecode); 761 if ecode ^= 0 762 then go to error; 763 end; 764 call tape_ansi_tape_io_$order (cP, "bsf", 0, ecode); 765 if ecode = 0 766 then 767 do; 768 call tape_ansi_tape_io_$order (cP, "fsf", 0, ecode); 769 if ecode ^= 0 770 then go to error; 771 end; 772 else if ecode = error_table_$positioned_on_bot 773 then ecode = 0; 774 else go to error; 775 end; 776 777 else 778 do; /* volume positioned at desired file */ 779 if fX = 1 780 then 781 do; 782 call tape_ansi_tape_io_$order (cP, "rew", 0, ecode); 783 if ecode ^= 0 784 then go to error; 785 end; 786 else 787 do; 788 call tape_ansi_tape_io_$order (cP, "bsf", 0, ecode); 789 if ecode ^= 0 790 then go to error; 791 call tape_ansi_tape_io_$order (cP, "fsf", 0, ecode); 792 if ecode ^= 0 793 then go to error; 794 end; 795 end; 796 797 ok_exit: 798 vl (vX).cflX = fX; /* new position info */ 799 return; 800 801 error: 802 vl (vX).cflX = 0; /* we don't know where we are */ 803 return; 804 end move; 805 806 next_volume: 807 procedure returns (bit (1)); /* determines if volume switch possible */ 808 809 dcl canon_std (2) fixed bin initial (Volume_ansi_tape, Volume_ibm_tape); 810 dcl ecode fixed bin (35); 811 812 if debug 813 then call debug_print ("next_volume"); 814 815 if fd.vlX < cseg.vcN 816 then return ("1"b); /* if current vlX < vcN then next exists */ 817 818 if fd.vlX = 63 819 then 820 do; /* volume chain full */ 821 call ioa_ ("^a: Implementation limit of 63 volumes has been reached.", cseg.module); 822 return ("0"b); 823 end; 824 825 if another_volume () 826 then vl (cseg.vcN + 1).comment = com_text; /* yes */ 827 else return ("0"b); /* user said terminate */ 828 829 got_reelid: 830 cseg.vcN = cseg.vcN + 1; /* increment volume link count */ 831 call vl_init (cseg.vcN); 832 vl (cseg.vcN).volname = vn; /* set volume name in volume link */ 833 call 834 canon_for_volume_label_ (VOLUME_TYPE (TAPE_VOL_VTYPEX), vn, vl (cseg.vcN).canonical_volname, 835 canon_std (cseg.standard), ecode); 836 if ecode ^= 0 837 then return (""b); 838 839 return ("1"b); 840 841 end next_volume; 842 843 vl_init: 844 procedure (n); /* initialize a volume link */ 845 dcl n fixed bin; /* link index */ 846 vl (n).fflX = 0; 847 vl (n).cflX = 0; 848 vl (n).pos = 0; 849 vl (n).lflX = 0; 850 vl (n).tracks = 0; 851 vl (n).density = 0; 852 vl (n).label_type = 0; 853 vl (n).usage_count = 0; 854 vl (n).read_errors = 0; 855 vl (n).write_errors = 0; 856 vl (n).rcp_id = 0; 857 vl (n).event_chan = 0; 858 vl (n).tape_drive = ""; 859 vl (n).write_VOL1 = 0; 860 vl (n).ioi_index = 0; 861 return; 862 end vl_init; 863 864 another_volume: 865 procedure returns (bit (1)); /* queries user for next volume name */ 866 867 dcl msg char (80) varying; /* message to user */ 868 dcl msg1 char (length (msg)) based (addr (substr (msg, 1))); 869 /* char (*) overlay for command_query_ */ 870 dcl L1 fixed bin; 871 872 qi.yes_no = "1"b; /* want yes or no */ 873 qi.suppress_name = "0"b; /* don't suppress module name */ 874 qi.scode = error_table_$no_next_volume; 875 msg = "Reached end of volume. Do you wish to terminate processing of this volume-set?"; 876 call command_query_ (addr (qi), answer, cseg.module, msg1); 877 878 if answer = "yes" 879 then return ("0"b); /* finito */ 880 881 qi.yes_no = "0"b; /* don't want yes or no */ 882 qi.suppress_name = "1"b; 883 ask: 884 qi.scode = 0; /* no scode when asking for name */ 885 msg = "Enter volume name of next volume (and optional comment).^/"; 886 ask_raw: 887 call command_query_ (addr (qi), answer, cseg.module, msg1); 888 if answer = "" 889 then go to ask; 890 com_text = ""; /* initialize comment message */ 891 L1 = index (answer, " ") - 1; /* scan for a blank */ 892 if L1 < 0 893 then L1 = length (answer); 894 895 call canon_for_volume_label_ (VOLUME_TYPE (TAPE_VOL_VTYPEX), substr (answer, 1, L1), vn, 0, code); 896 if code ^= 0 897 then 898 do; 899 qi.scode = code; 900 msg = substr (answer, 1, L1) || "^/Enter volume name of next volume (and optional comment).^/"; 901 go to ask_raw; 902 end; 903 904 answer = ltrim (substr (answer, L1 + 1)); 905 if substr (answer, 1, 8) = "-comment" 906 then 907 do; 908 answer = ltrim (substr (answer, 10)); 909 go to comment; 910 end; 911 if substr (answer, 1, 4) = "-com" 912 then 913 do; 914 answer = ltrim (substr (answer, 6)); 915 comment: 916 if length (answer) = 0 917 then ; /* no comment */ 918 else com_text = answer; 919 end; 920 else 921 do; /* invalid comment */ 922 call ioa_ ("Comment is invalid."); 923 924 go to ask; 925 end; 926 927 return ("1"b); /* volume name is ok - exit */ 928 929 end another_volume; 930 931 write_TM: 932 procedure (n, ecode); /* writes 1 or 2 TM and adjusts volume link */ 933 dcl n fixed bin, /* number of TM - 1 or 2 */ 934 cnt fixed bin, 935 ecode fixed bin (35); 936 937 if debug 938 then call ioa_ ("write_TM ^d", n); 939 do cnt = 1 to n; /* 1 or 2 */ 940 call tape_ansi_tape_io_$order (cP, "eof", 0, ecode); 941 /* write a TM */ 942 if ecode ^= 0 943 then if ecode ^= error_table_$eov_on_write 944 then return; /* error exit */ 945 vl (fd.vlX).cflX = vl (fd.vlX).cflX + 1; 946 end; 947 948 return; 949 950 end write_TM; 951 952 beginning_of_file: 953 entry (iocbP, code); /* positions to beginning of file */ 954 955 if debug 956 then call debug_print ("bof"); 957 cP = iocbP -> iocb.actual_iocb_ptr -> iocb.attach_data_ptr; 958 /* get pointer to cseg */ 959 960 cc = 0; 961 on cleanup go to bof_fail; 962 963 call tape_ansi_ibm_lrec_io_$close (cP, code); /* close logical record I/O */ 964 if code ^= 0 965 then go to bof_fail; 966 967 /* OLD */ 968 call move (1, fd.sequence, code); /* move the tape */ 969 /* OLD */ 970 /* NEW * / 971* do i = 1 to cseg.vcN; /* determine where the file begins and have that vol mounted * / 972* if fd.sequence >= vl (i).fflX & fd.sequence <= vl (i).lflX 973* then 974* do; 975* fd.vlX = i; 976* go to got_vol; 977* end; 978* end; /* if not found in loop then it is the current volume * / 979* 980*got_vol: /* if no volume found use the current one * / 981* call move (fd.vlX, fd.sequence, code); /* move the tape * / 982*/* NEW */ 983 if code ^= 0 984 then 985 do; 986 bof_fail: 987 call consistent; 988 go to close_exit; 989 end; 990 991 call lrec_open; /* re-initialize to open logical record I/O */ 992 /* note - no error can occur in this call */ 993 994 return; 995 996 end_of_file: 997 entry (iocbP, code); /* positions to end of file */ 998 999 if debug 1000 then call debug_print ("end_of_file"); 1001 cP = iocbP -> iocb.actual_iocb_ptr -> iocb.attach_data_ptr; 1002 /* get pointer to cseg */ 1003 1004 cc = 0; 1005 on cleanup go to eof_fail; 1006 1007 if cseg.lrec.code = error_table_$end_of_info 1008 then 1009 do; /* passed eof */ 1010 call tape_ansi_tape_io_$order (cP, "bsf", 0, code); 1011 if code ^= 0 1012 then go to eof_fail; 1013 else vl (fd.vlX).cflX = vl (fd.vlX).cflX - 1; 1014 return; 1015 end; 1016 1017 cseg.rlN = -1; /* invalidate any record in real_length buffer */ 1018 cseg.blkcnt = -1; /* invalidate the block count */ 1019 1020 call tape_ansi_ibm_lrec_io_$close (cP, code); /* close logical record io */ 1021 if code ^= 0 1022 then 1023 do; 1024 eof_fail: 1025 call consistent; 1026 go to close_exit; 1027 end; 1028 1029 /* OLD */ 1030 if fd.vlX ^= cseg.vcN 1031 then 1032 do; /* not at last volume of file */ 1033 call move (cseg.vcN, 1, code); 1034 if code ^= 0 1035 then go to eof_fail; 1036 end; 1037 1038 call tape_ansi_tape_io_$order (cP, "fsf", 0, code); 1039 if code ^= 0 1040 then go to eof_fail; /* OLD */ 1041 /* NEW * / 1042* do i = 1 to cseg.vcN; /* search forward for the next file * / 1043* if vl (i).fflX ^= 0 1044* then /* only searching vols that have files * / 1045* if (fd.sequence + 1 >= vl (i).fflX & (fd.sequence + 1 <= vl (i).lflX + 1 | vl (i).lflX = 0)) 1046* then 1047* do; /* then test for a file fit on the volume * / 1048* fd.vlX = i; 1049* if vl (i).lflX = 0 | fd.sequence + 1 <= vl (i).lflX 1050* then go to got_tape; /* it may be after the last file in the file set * / 1051* else 1052* do j = i to cseg.vcN; /* look until you find the volume. 1053* New files can only be 1+ the last written * / 1054* if vl (j).fflX ^= 0 1055* then if (fd.sequence + 1 >= vl (j).fflX & (fd.sequence + 1 <= vl (j).lflX + 1 | vl (j).lflX = 0)) 1056* then fd.vlX = j; 1057* end; 1058* go to got_tape; 1059* end; 1060* end; /* if we fall through search on from where we are * / 1061*got_tape: /* move to the next sequential file then back up 1062* to be at end of desired file * / 1063* call move (fd.vlX, fd.sequence + 1, code); 1064* if code ^= 0 1065* then go to eof_fail; 1066* 1067*/* NEW */ 1068 call tape_ansi_tape_io_$order (cP, "bsf", 0, code); 1069 if code ^= 0 1070 then go to eof_fail; /* NEW * / 1071* else vl (fd.vlX).cflX = vl (fd.vlX).cflX - 1; 1072* 1073* 1074* call lrec_open; /* re-initialize to open record io * / 1075* 1076*/* NEW */ 1077 return; /* */ 1078 data_eof: 1079 entry (iocbP, code); /* called by ibm_lrec io when 1080* read returns an eof_record */ 1081 if debug 1082 then call debug_print ("data_eof"); 1083 cP = iocbP -> iocb.actual_iocb_ptr -> iocb.attach_data_ptr; 1084 /* get control segment pointer */ 1085 1086 cc = 0; /* minimal consistency requirement */ 1087 on cleanup go to data_eof_fail; 1088 1089 vl (fd.vlX).cflX = vl (fd.vlX).cflX + 1; /* have moved over a TM - update position info */ 1090 1091 1092 call tape_ansi_ibm_lrec_io_$close (cP, code); 1093 if code ^= 0 1094 then 1095 do; 1096 data_eof_fail: 1097 call consistent; 1098 go to close_exit; 1099 end; 1100 1101 /* OLD */ 1102 if fd.vlX = cseg.vcN 1103 then 1104 do; /* last (or only) section */ 1105 /* OLD */ 1106 /* NEW * / 1107* call tape_ansi_tape_io_$sync_read (cP, nchar, code); 1108* /* read the next 80 chars looking for eov label * / 1109* 1110* if code ^= 0 1111* then 1112* do; 1113* 1114* if code = error_table_$eof_record 1115* then 1116* do; /* if another eof then this maybe end of vol set * / 1117* vl (fd.vlX).cflX = vl (fd.vlX).cflX + 1; 1118* call tape_ansi_tape_io_$sync_read (cP, nchar, code); 1119* /* read again to see if another eof * / 1120* if code = error_table_$eof_record 1121* then 1122* do; /* if another eof then end of vol set emit end_of_info * / 1123* vl (fd.vlX).cflX = vl (fd.vlX).cflX + 1; 1124* /* update volume positions * / 1125* vl (fd.vlX).lflX = vl (fd.vlX).cflX - 3; 1126* code = error_table_$end_of_info; 1127* return; 1128* end; 1129* else if code ^= 0 1130* then go to data_eof_fail; 1131* 1132* if cseg.standard = 1 1133* then cseg.lbl_buf = sync_buf; 1134* else call ebcdic_to_ascii_ (sync_buf, cseg.lbl_buf); 1135* /* convert the ebcdic label buffer * / 1136* 1137* 1138* if substr (lbl_buf, 1, 4) ^= "EOV1" 1139* then 1140* do; /* if not a label then just end of file and go on * / 1141* code = error_table_$end_of_info; 1142* return; 1143* end; 1144* 1145* end; 1146* 1147* else go to data_eof_fail; /* if error then go to error handle * / 1148* end; 1149* 1150* else 1151* do; /* this is simple end of file case go back * / 1152*/* NEW */ 1153 code = error_table_$end_of_info; 1154 return; 1155 end; 1156 1157 /* OLD */ 1158 call move (fd.vlX + 1, 1, code); /* move to next volume */ 1159 /* OLD */ 1160 /* NEW * / 1161* 1162* 1163* if debug 1164* then call ioa_ ("^80a", lbl_buf); 1165* 1166* 1167*/* this is end of volume prepare to mount 1168* the next volume in the set * / 1169* 1170* if ^next_volume () 1171* then 1172* do; 1173* code = error_table_$no_next_volume; 1174* return; 1175* end; 1176* 1177* if vl (fd.vlX).lflX = 0 1178* then vl (fd.vlX).lflX = vl (fd.vlX).cflX - 2; /* check last file index * / 1179* else if vl (fd.vlX).lflX ^= vl (fd.vlX).cflX - 2 1180* then 1181* do; /* if not set set it right if set check it * / 1182* code = error_table_$invalid_file_set_format; 1183* go to data_eof_fail; 1184* end; 1185* 1186* vl (fd.vlX).cflX = 0; /* invalidate this volume position * / 1187* fd.vlX = fd.vlX + 1; /* increment to next volume * / 1188* vl (fd.vlX).cflX = vl (fd.vlX - 1).lflX; /* update volume index info * / 1189* vl (fd.vlX).fflX = vl (fd.vlX - 1).lflX; 1190* call move (fd.vlX, fd.sequence, code); 1191*/* NEW */ 1192 if code ^= 0 1193 then go to data_eof_fail; 1194 1195 return; 1196 1197 data_eot: 1198 entry (iocbP, code); /* called by lrec IO when a write encounters EOT */ 1199 1200 if debug 1201 then call debug_print ("data_eot"); 1202 cP = iocbP -> iocb.actual_iocb_ptr -> iocb.attach_data_ptr; 1203 /* get pointer to control segment */ 1204 1205 if ^next_volume () 1206 then 1207 do; /* no next volume available */ 1208 code = error_table_$no_next_volume; 1209 return; 1210 end; 1211 1212 cc = 2; /* don't leave defective tape file */ 1213 on cleanup go to data_eot_fail; 1214 1215 /* OLD */ 1216 call write_TM (1, code); /* write end-of-data TM */ 1217 /* OLD */ 1218 /* NEW * / 1219* vl (fd.vlX).lflX = vl (fd.vlX).cflX; /* set the last file index counter * / 1220* 1221* call write_EOV1 (code); /* call write_EOV to write end of vol trail... 1222* two tape marks, an eov label, and a tape mark * / 1223*/* NEW */ 1224 if code ^= 0 1225 then if code ^= error_table_$eov_on_write 1226 then 1227 do; /* trouble - ignore EOT) */ 1228 data_eot_fail: 1229 call consistent; 1230 go to close_exit; /* force close */ 1231 end; 1232 cc = 0; 1233 1234 /* OLD */ 1235 call move (fd.vlX + 1, 1, code); /* move to beginning of next volume */ 1236 /* OLD */ 1237 /* NEW * / 1238* /* set up for mounting the next volume * / 1239* vl (fd.vlX).cflX = 0; /* invalidate this volume position * / 1240* fd.vlX = fd.vlX + 1; /* increment to next volume * / 1241* vl (fd.vlX).cflX = vl (fd.vlX - 1).lflX; /* update volume indexes * / 1242* vl (fd.vlX).fflX = vl (fd.vlX - 1).lflX; 1243* call move (fd.vlX, fd.sequence, code); 1244*/* NEW */ 1245 if code ^= 0 1246 then go to data_eot_fail; 1247 1248 return; 1249 1250 /* NEW * / 1251*write_EOV1: 1252* procedure (ecode); 1253* 1254*dcl ecode fixed bin (35); 1255*dcl t4 picture "9999", 1256* t6 picture "999999"; /* write the end_of_volume trail 1257* 2 tape marks an EOV1 label and then another tape mark * / 1258* 1259* call write_TM (2, ecode); 1260* if ecode ^= 0 1261* then if ecode ^= error_table_$eov_on_write 1262* then return; 1263* 1264* fd.dummy_blkcnt = cseg.blkcnt; /* set up the end of volume label * / 1265* fd.eox = 2; /* much of the label is not important * / 1266* /* the header and the volume id are distinctive * / 1267* if debug 1268* then call debug_print ("write_EOV"); 1269* 1270* ibm_hdr1P = addr (lbl_buf); 1271* ibm_hdr1.label_id = "EOV1"; 1272* ibm_hdr1.dataset_id = fd.file_id; 1273* ibm_hdr1.dataset_serial = fd.set_id; 1274* t4 = fd.flX; 1275* ibm_hdr1.volume_sequence = t4; 1276* t4 = fd.sequence; 1277* ibm_hdr1.dataset_sequence = t4; 1278* ibm_hdr1.generation = ""; 1279* ibm_hdr1.version = ""; 1280* ibm_hdr1.creation = " " || fd.creation; 1281* ibm_hdr1.expiration = " " || fd.expiration; 1282* ibm_hdr1.security = fd.access; 1283* t6 = cseg.lrec.blkcnt; 1284* ibm_hdr1.blkcnt = t6; 1285* ibm_hdr1.system = fd.system; 1286* ibm_hdr1.reserved = ""; 1287* 1288* if cseg.standard = 1 1289* then sync_buf = cseg.lbl_buf; /* ascii buffer for label * / 1290* else call ascii_to_ebcdic_ (cseg.lbl_buf, sync_buf); /* ebcidic convert and write * / 1291* 1292* 1293* call tape_ansi_tape_io_$sync_write (cP, 80, ecode); /* write it * / 1294* 1295* if ecode ^= 0 1296* then if ecode ^= error_table_$eov_on_write 1297* then return; 1298* 1299* call write_TM (1, ecode); /* last tape mark written after label * / 1300* 1301* return; /* with error ecode = 0 eot or error * / 1302* 1303* 1304* end write_EOV1; 1305* 1306*/* NEW */ 1307 close: 1308 entry (iocbP, code); /* iox_$close entry */ 1309 1310 cP = iocbP -> iocb.actual_iocb_ptr -> iocb.attach_data_ptr; 1311 /* get control segment pointer */ 1312 1313 if cseg.file_lock 1314 then 1315 do; /* file in use? */ 1316 code = error_table_$file_busy; 1317 return; 1318 end; 1319 else 1320 do; 1321 on cleanup cseg.file_lock = "0"b; 1322 cseg.file_lock = "1"b; 1323 end; 1324 1325 if cseg.invalid 1326 then 1327 do; 1328 code = error_table_$invalid_cseg; 1329 on cleanup go to close_exit1; 1330 go to close_exit1; 1331 end; 1332 1333 if cseg.open_mode = 4 1334 then 1335 do; /* input mode */ 1336 cc = 0; /* minimal consistency requirement */ 1337 on cleanup go to close_fail; 1338 call tape_ansi_ibm_lrec_io_$close (cP, code); 1339 if code ^= 0 1340 then call consistent; 1341 go to close_exit; 1342 end; 1343 1344 else 1345 do; /* output mode */ 1346 cc = 2; /* don't leave defective tape file */ 1347 on cleanup go to close_fail; 1348 call tape_ansi_ibm_lrec_io_$close (cP, code); 1349 if code ^= 0 1350 then 1351 do; /* maybe trouble */ 1352 if code ^= error_table_$eov_on_write 1353 then 1354 do; /* EOT is ok */ 1355 close_fail: 1356 call consistent; 1357 go to close_exit; 1358 end; 1359 end; 1360 1361 /* OLD */ 1362 call write_TM (2, code); /* write trailer and end-of-volume TMs */ 1363 /* OLD */ 1364 /* NEW * / 1365* if cseg.blkcnt = 0 1366* then 1367* do; /* if no blocks written empty file * / 1368* vl (fd.vlX).lflX = vl (fd.vlX).cflX - 1; /* set the last position and issue error * / 1369* code = error_table_$empty_file; 1370* end; 1371* 1372* else vl (fd.vlX).lflX = vl (fd.vlX).cflX; /* update the volume indexes after a write * / 1373* 1374* call write_TM (3, code); /* write trailer and the 2 end-of-volume TMs * / 1375*/* NEW */ 1376 if code ^= 0 1377 then 1378 do; 1379 if code = error_table_$eov_on_write 1380 then code = 0; 1381 else go to close_fail; 1382 end; 1383 cc = 0; 1384 1385 end; 1386 1387 close_exit: 1388 if cseg.close_rewind 1389 then 1390 do; /* rewind volume at close time */ 1391 vl (fd.vlX).cflX = 0; /* invalidate volume position */ 1392 call tape_ansi_tape_io_$order (cP, "rew", 0, 0);/* issue the order */ 1393 cseg.close_rewind = "0"b; /* this is a one time switch */ 1394 end; 1395 close_exit1: 1396 mask = "0"b; 1397 revert cleanup; 1398 on any_other call handler; 1399 call hcs_$set_ips_mask ("0"b, mask); 1400 iocbP -> iocb.actual_iocb_ptr -> iocb.detach_iocb = tape_ansi_detach_; 1401 iocbP -> iocb.actual_iocb_ptr -> iocb.open = tape_ansi_nl_file_cntl_$open; 1402 iocbP -> iocb.actual_iocb_ptr -> iocb.control = tape_ansi_control_; 1403 iocbP -> iocb.actual_iocb_ptr -> iocb.open_descrip_ptr = null; 1404 call iox_$propagate (iocbP -> iocb.actual_iocb_ptr); 1405 call hcs_$reset_ips_mask (mask, mask); 1406 cseg.file_lock = "0"b; 1407 return; 1408 1409 debug_on: 1410 entry; /* turns debug switch on */ 1411 debug = "1"b; 1412 return; 1413 1414 debug_off: 1415 entry; /* truns debug switch off */ 1416 debug = "0"b; 1417 return; 1418 1419 debug_print: 1420 procedure (text); /* prints debug text */ 1421 dcl text char (*); 1422 1423 call ioa_ (text); 1424 return; 1425 1426 end debug_print; 1427 1428 1429 end tape_ansi_nl_file_cntl_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 12/17/86 0829.4 tape_ansi_nl_file_cntl_.pl1 >special_ldd>install>MR12.0-1250>tape_ansi_nl_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 10/06/83 1413.5 ibm_hdr1.incl.pl1 >ldd>include>ibm_hdr1.incl.pl1 49 5 12/17/86 0758.3 rcp_volume_formats.incl.pl1 >special_ldd>install>MR12.0-1250>rcp_volume_formats.incl.pl1 51 6 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. L1 000405 automatic fixed bin(17,0) dcl 870 set ref 891* 892 892* 895 895 900 904 TAPE_VOL_VTYPEX constant fixed bin(17,0) initial dcl 6-37 ref 833 895 VOLUME_TYPE 000017 constant char(32) initial array unaligned dcl 6-25 set ref 833* 895* Volume_ansi_tape constant fixed bin(17,0) initial dcl 5-15 ref 809 Volume_ibm_tape constant fixed bin(17,0) initial dcl 5-15 ref 809 actual_iocb_ptr 12 based pointer level 2 dcl 1-6 set ref 137 316 317 321 322 323 325 326 327* 957 1001 1083 1202 1310 1400 1401 1402 1403 1404* addr builtin function dcl 81 ref 326 427 427 455 455 455 876 876 876 886 886 886 answer 000102 automatic varying char(128) dcl 55 set ref 455* 457 876* 878 886* 888 891 892 895 895 900 904* 904 905 908* 908 911 914* 914 915 918 any_other 000214 stack reference condition dcl 78 ref 314 1398 attach_data_ptr 16 based pointer level 2 dcl 1-6 ref 137 957 1001 1083 1202 1310 blkcnt 221 based fixed bin(35,0) level 3 dcl 2-14 set ref 506* 1018* blklen 46 based fixed bin(17,0) level 3 dcl 3-3 set ref 255 282 282* 289 468 472 480 485 489 494 blocked 62 based bit(1) level 3 dcl 3-3 set ref 280* 480 489 bufP 212 based pointer level 3 dcl 2-14 set ref 505* buf_size 310 based fixed bin(17,0) level 2 dcl 2-14 ref 365 404 455 534 559 563 576 577 583 585 592 595 600 623 627 631 637 645 648 756 759 797 801 825 832 833 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 945 945 1013 1013 1089 1089 1391 cP 000100 automatic pointer dcl 2-11 set ref 137* 140 147 159 161 176 183 186 187 245 248 255 257 260 264 264 268 268 276 279 280 282 282 284 287 289 289 289 291 291 293 295 295 298 298 311 312 317 326 329 341 365 365 365 378 386 404 404 404 404 409 455 455 455 468 468 472 472 475 475 477 479 480 480 480 485 485 489 489 489 494 494 498 502 505 506 507 508 509* 534 534 537 537 540* 548 548 559 559 562 563 563 568* 576 576 576 577 577 577 578 580 583 583 585 585 592 592 595 595 595 600 600 612* 623 623 627 627 631 631 634* 637 637 645 645 648 648 649* 756 756 759 759 760* 764* 768* 782* 788* 791* 797 797 801 801 815 815 818 821 825 825 825 829 829 831 832 832 832 833 833 833 833 846 846 847 847 848 848 849 849 850 850 851 851 852 852 853 853 854 854 855 855 856 856 857 857 858 858 859 859 860 860 876 886 940* 945 945 945 945 945 945 957* 963* 968 1001* 1007 1010* 1013 1013 1013 1013 1013 1013 1017 1018 1020* 1030 1030 1033 1038* 1068* 1083* 1089 1089 1089 1089 1089 1089 1092* 1102 1102 1158 1202* 1235 1310* 1313 1321 1322 1325 1333 1338* 1348* 1387 1391 1391 1391 1392* 1393 1406 canon_for_volume_label_ 000012 constant entry external dcl 85 ref 833 895 canon_std 000340 automatic fixed bin(17,0) initial array dcl 809 set ref 809* 809* 833* canonical_volname based char(6) array level 4 packed unaligned dcl 2-14 set ref 833* cc 000174 automatic fixed bin(17,0) dcl 55 set ref 155* 398 533* 960* 1004* 1086* 1212* 1232* 1336* 1346* 1383* cflX based fixed bin(17,0) array level 4 packed unaligned dcl 2-14 set ref 365* 404* 623* 631 637* 645 648 756 759 797* 801* 847* 945* 945 1013* 1013 1089* 1089 1391* cleanup 000222 stack reference condition dcl 78 ref 156 313 961 1005 1087 1213 1321 1329 1337 1347 1397 close 36 based entry variable level 2 dcl 1-6 set ref 316* close_rewind 177 based bit(1) level 2 dcl 2-14 set ref 1387 1393* cnt 000100 automatic fixed bin(17,0) dcl 933 set ref 939* code 223 based fixed bin(35,0) level 3 in structure "cseg" dcl 2-14 in procedure "tape_ansi_nl_file_cntl_" set ref 508* 1007 code parameter fixed bin(35,0) dcl 36 in procedure "tape_ansi_nl_file_cntl_" set ref 134 143* 150* 167* 251* 268* 269 298* 299 337* 368* 373 373 383* 388* 512* 515* 518* 596* 895* 896 899 952 963* 964 968* 983 996 1010* 1011 1020* 1021 1033* 1034 1038* 1039 1068* 1069 1078 1092* 1093 1153* 1158* 1192 1197 1208* 1216* 1224 1224 1235* 1245 1307 1316* 1328* 1338* 1339 1348* 1349 1352 1362* 1376 1379 1379* code 1 000100 automatic fixed bin(35,0) level 2 in structure "ti" dcl 419 in procedure "handler" set ref 426* com_text 000143 automatic varying char(64) dcl 55 set ref 825 890* 918* command_query_ 000014 constant entry external dcl 85 ref 455 876 886 comment based varying char(64) array level 4 dcl 2-14 set ref 825* continue_to_signal_ 000016 constant entry external dcl 85 ref 430 control 66 based entry variable level 2 dcl 1-6 set ref 325* 1402* cseg based structure level 1 unaligned dcl 2-14 debug 000010 internal static bit(1) initial unaligned dcl 73 set ref 362 395 465 526 812 937 955 999 1081 1200 1411* 1416* density based fixed bin(17,0) array level 4 packed unaligned dcl 2-14 set ref 851* detach_iocb 26 based entry variable level 2 dcl 1-6 set ref 1400* drive_name 324 based char(32) level 3 dcl 2-14 set ref 576* ecode parameter fixed bin(35,0) dcl 528 in procedure "move" set ref 524 540* 542 545 566* 568* 571 612* 614 616* 620 620 634* 635 649* 650 653 653* 760* 761 764* 765 768* 769 772 772* 782* 783 788* 789 791* 792 ecode parameter fixed bin(35,0) dcl 933 in procedure "write_TM" set ref 931 940* 942 942 ecode 000342 automatic fixed bin(35,0) dcl 810 in procedure "next_volume" set ref 833* 836 error_table_$blank_tape 000064 external static fixed bin(35,0) dcl 111 ref 653 error_table_$device_limit_exceeded 000066 external static fixed bin(35,0) dcl 111 ref 545 error_table_$end_of_info 000070 external static fixed bin(35,0) dcl 111 ref 1007 1153 error_table_$eov_on_write 000072 external static fixed bin(35,0) dcl 111 ref 373 620 942 1224 1352 1379 error_table_$file_aborted 000074 external static fixed bin(35,0) dcl 111 ref 383 error_table_$file_busy 000076 external static fixed bin(35,0) dcl 111 ref 150 1316 error_table_$incompatible_attach 000100 external static fixed bin(35,0) dcl 111 ref 167 error_table_$incompatible_encoding_mode 000102 external static fixed bin(35,0) dcl 111 ref 518 error_table_$insufficient_open 000104 external static fixed bin(35,0) dcl 111 ref 251 error_table_$invalid_block_length 000106 external static fixed bin(35,0) dcl 111 ref 515 error_table_$invalid_cseg 000110 external static fixed bin(35,0) dcl 111 ref 143 566 1328 error_table_$invalid_file_set_format 000112 external static fixed bin(35,0) dcl 111 ref 388 error_table_$invalid_record_length 000114 external static fixed bin(35,0) dcl 111 ref 512 error_table_$no_file 000116 external static fixed bin(35,0) dcl 111 ref 653 error_table_$no_next_volume 000120 external static fixed bin(35,0) dcl 111 ref 337 874 1208 error_table_$positioned_on_bot 000122 external static fixed bin(35,0) dcl 111 ref 772 error_table_$unable_to_do_io 000124 external static fixed bin(35,0) dcl 111 ref 426 error_table_$uninitialized_volume 000126 external static fixed bin(35,0) dcl 111 ref 453 596 ev_chan 316 based fixed bin(71,0) level 3 dcl 2-14 set ref 577* event_chan based fixed bin(71,0) array level 4 dcl 2-14 set ref 577 857* extend_bit parameter bit(1) dcl 36 ref 134 164 fX parameter fixed bin(17,0) dcl 528 ref 524 589 645 648 756 759 779 797 fcP 130 based pointer level 2 dcl 2-14 ref 187 248 255 257 260 264 264 268 268 276 279 280 282 282 284 287 289 289 289 291 291 293 295 295 298 298 365 404 404 409 468 472 475 479 480 480 480 485 485 489 489 489 494 494 498 578 815 818 945 945 968 1013 1013 1030 1089 1089 1102 1158 1235 1391 fd based structure level 1 dcl 3-3 fflX based fixed bin(17,0) array level 4 packed unaligned dcl 2-14 set ref 846* file_lock 220 based bit(1) level 3 dcl 2-14 set ref 147 159* 161* 329* 341* 1313 1321* 1322* 1406* flP 132 based pointer level 2 dcl 2-14 set ref 186* format 45 based fixed bin(17,0) level 3 dcl 3-3 set ref 248 260 276 279* 287 289 291 479 hcs_$reset_ips_mask 000030 constant entry external dcl 85 ref 328 1405 hcs_$set_ips_mask 000032 constant entry external dcl 85 ref 315 1399 hdr1 10 based structure level 2 dcl 3-3 hdr2 45 based structure level 2 dcl 3-3 i 000314 automatic fixed bin(17,0) dcl 531 set ref 557* 559* 562* 563* 568* 648* 759* index builtin function dcl 81 ref 891 invalid 1 based bit(1) level 2 dcl 2-14 ref 140 1325 ioa_ 000042 constant entry external dcl 85 ref 378 386 595 821 922 937 1423 iocb based structure level 1 dcl 1-6 iocbP parameter pointer dcl 36 ref 134 137 316 317 321 322 323 325 326 327 952 957 996 1001 1078 1083 1197 1202 1307 1310 1400 1401 1402 1403 1404 ioi_index based fixed bin(17,0) array level 4 dcl 2-14 set ref 860* iox_$propagate 000044 constant entry external dcl 85 ref 327 1404 label_type based fixed bin(17,0) array level 4 packed unaligned dcl 2-14 set ref 852* length 104 based fixed bin(17,0) level 3 in structure "cseg" dcl 2-14 in procedure "tape_ansi_nl_file_cntl_" set ref 311* length builtin function dcl 81 in procedure "tape_ansi_nl_file_cntl_" ref 311 455 455 876 876 886 886 892 915 lflX based fixed bin(17,0) array level 4 packed unaligned dcl 2-14 set ref 849* lrec 212 based structure level 2 unaligned dcl 2-14 ltrim builtin function dcl 81 ref 904 908 914 mask 000175 automatic bit(36) dcl 55 set ref 309* 315* 328* 328* 423 1395* 1399* 1405* 1405* mod builtin function dcl 81 ref 472 485 mode 262 based fixed bin(17,0) level 2 in structure "cseg" dcl 2-14 in procedure "tape_ansi_nl_file_cntl_" set ref 475* 477* mode 63 based fixed bin(17,0) level 3 in structure "fd" dcl 3-3 in procedure "tape_ansi_nl_file_cntl_" set ref 264 264* 295 295* 475 module 115 based varying char(12) level 2 dcl 2-14 set ref 378* 386* 455* 595* 821* 876* 886* msg 000240 automatic varying char(120) dcl 438 in procedure "initialize_permitA" set ref 441* 448* 455 455 455 msg 000360 automatic varying char(80) dcl 867 in procedure "another_volume" set ref 875* 876 876 876 885* 886 886 886 900* msg1 based char unaligned dcl 439 in procedure "initialize_permitA" set ref 455* msg1 based char unaligned dcl 868 in procedure "another_volume" set ref 876* 886* n parameter fixed bin(17,0) dcl 845 in procedure "vl_init" ref 843 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 n parameter fixed bin(17,0) dcl 933 in procedure "write_TM" set ref 931 937* 939 nactive 122 based fixed bin(17,0) level 2 dcl 2-14 ref 537 ndrives 121 based fixed bin(17,0) level 2 dcl 2-14 set ref 537 548* 548 null builtin function dcl 81 ref 186 505 1403 open 32 based entry variable level 2 dcl 1-6 set ref 1401* open_descrip_ptr 20 based pointer level 2 dcl 1-6 set ref 326* 1403* open_description 104 based structure level 2 unaligned dcl 2-14 set ref 326 open_mode parameter fixed bin(17,0) dcl 36 in procedure "tape_ansi_nl_file_cntl_" ref 134 172 178 183 open_mode 176 based fixed bin(17,0) level 2 in structure "cseg" dcl 2-14 in procedure "tape_ansi_nl_file_cntl_" set ref 183* 245 317 468 472 580 1333 output_mode 203 based fixed bin(17,0) level 2 dcl 2-14 ref 176 pos based fixed bin(17,0) array level 4 packed unaligned dcl 2-14 set ref 848* position based structure array level 3 in structure "cseg" packed unaligned dcl 2-14 in procedure "tape_ansi_nl_file_cntl_" position 62 based entry variable level 2 in structure "iocb" dcl 1-6 in procedure "tape_ansi_nl_file_cntl_" set ref 323* qcode 3 000207 automatic fixed bin(35,0) initial level 2 dcl 65 set ref 65* qi 000207 automatic structure level 1 dcl 65 set ref 455 455 876 876 886 886 rcp_id based fixed bin(6,0) array level 4 dcl 2-14 set ref 534 559 563 856* read_errors based fixed bin(17,0) array level 4 packed unaligned dcl 2-14 set ref 854* read_length 122 based entry variable level 2 in structure "iocb" dcl 1-6 in procedure "tape_ansi_nl_file_cntl_" set ref 322* read_length 224 based structure level 2 in structure "cseg" unaligned dcl 2-14 in procedure "tape_ansi_nl_file_cntl_" read_record 72 based entry variable level 2 dcl 1-6 set ref 321* reccnt 222 based fixed bin(35,0) level 3 dcl 2-14 set ref 507* reclen 47 based fixed bin(21,0) level 3 dcl 3-3 set ref 257 284 289* 291* 293* 480 485 489 494 498 reg_data based structure array level 3 packed unaligned dcl 2-14 rlN 226 based fixed bin(21,0) level 3 dcl 2-14 set ref 502* 1017* scode 2 000207 automatic fixed bin(35,0) level 2 dcl 65 set ref 453* 874* 883* 899* sequence 30 based fixed bin(17,0) level 3 dcl 3-3 set ref 268* 298* 968* standard 2 based fixed bin(17,0) level 2 dcl 2-14 ref 833 string 105 based char(32) level 3 packed unaligned dcl 2-14 set ref 312* substr builtin function dcl 81 ref 455 876 886 895 895 900 904 905 908 911 914 suppress_name 1(01) 000207 automatic bit(1) level 2 packed unaligned dcl 65 set ref 452* 873* 882* sys_info$max_seg_size 000130 external static fixed bin(35,0) dcl 132 ref 293 498 tape_ansi_control_ 000020 constant entry external dcl 85 ref 325 1402 tape_ansi_detach_ 000022 constant entry external dcl 85 ref 1400 tape_ansi_ibm_lrec_io_$close 000034 constant entry external dcl 85 ref 963 1020 1092 1338 1348 tape_ansi_ibm_lrec_io_$read_record 000036 constant entry external dcl 85 ref 321 tape_ansi_ibm_lrec_io_$write_record 000040 constant entry external dcl 85 ref 317 tape_ansi_mount_cntl_$mount 000046 constant entry external dcl 85 ref 540 tape_ansi_mount_cntl_$remount 000050 constant entry external dcl 85 ref 568 tape_ansi_nl_file_cntl_$close 000024 constant entry external dcl 85 ref 316 tape_ansi_nl_file_cntl_$open 000026 constant entry external dcl 85 ref 1401 tape_ansi_position_ 000052 constant entry external dcl 85 ref 323 tape_ansi_read_length_ 000054 constant entry external dcl 85 ref 322 tape_ansi_tape_io_$open 000056 constant entry external dcl 85 ref 509 tape_ansi_tape_io_$order 000060 constant entry external dcl 85 ref 612 634 649 760 764 768 782 788 791 940 1010 1038 1068 1392 tape_drive based char(32) array level 4 packed unaligned dcl 2-14 set ref 576 858* terminate_process_ 000062 constant entry external dcl 85 ref 427 text parameter char unaligned dcl 1421 set ref 1419 1423* ti 000100 automatic structure level 1 dcl 419 set ref 427 427 tracks based fixed bin(17,0) array level 4 packed unaligned dcl 2-14 set ref 850* tseg 312 based structure level 2 dcl 2-14 tstring 000176 automatic varying char(32) dcl 55 set ref 172* 178* 311 312 uninit_msg 000315 automatic varying char(28) dcl 531 set ref 592* 594* 595* usage_count based fixed bin(17,0) array level 4 packed unaligned dcl 2-14 set ref 853* vX parameter fixed bin(17,0) dcl 437 in procedure "initialize_permitA" ref 434 445 455 vX parameter fixed bin(17,0) dcl 528 in procedure "move" set ref 524 534 540* 557 562 568* 576 577 578 583 585 592 595 600 601* 609* 623 627 631 637 645 648 756 759 797 801 vcN 126 based fixed bin(17,0) level 2 dcl 2-14 set ref 562 815 825 829* 829 831* 832 833 1030 1033* 1102 version 000207 automatic fixed bin(17,0) initial level 2 in structure "qi" dcl 65 in procedure "tape_ansi_nl_file_cntl_" set ref 65* version 000100 automatic fixed bin(17,0) initial level 2 in structure "ti" dcl 419 in procedure "handler" set ref 419* vl based structure array level 2 unaligned dcl 2-14 vlX 5 based fixed bin(17,0) initial level 2 dcl 3-3 set ref 187* 268* 298* 365 404 404 409 578* 815 818 945 945 1013 1013 1030 1089 1089 1102 1158 1235 1391 vn 000164 automatic char(32) unaligned dcl 55 set ref 832 833* 895* 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 455* 595* 832* write_VOL1 based fixed bin(17,0) array level 4 dcl 2-14 set ref 583 585 592 600 627* 859* write_errors based fixed bin(17,0) array level 4 packed unaligned dcl 2-14 set ref 855* write_record 76 based entry variable level 2 dcl 1-6 set ref 317* yes_no 1 000207 automatic bit(1) level 2 packed unaligned dcl 65 set ref 450* 872* 881* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. CONSOLE_DTYPEX internal static fixed bin(17,0) initial dcl 6-31 DEVICE_TYPE internal static char(32) initial array unaligned dcl 6-18 DISK_DRIVE_DTYPEX internal static fixed bin(17,0) initial dcl 6-30 DISK_VOL_VTYPEX internal static fixed bin(17,0) initial dcl 6-38 IBM_EOF1 internal static fixed bin(17,0) initial dcl 4-25 IBM_EOV1 internal static fixed bin(17,0) initial dcl 4-25 IBM_HDR1 internal static fixed bin(17,0) initial dcl 4-25 IBM_L1_ID internal static char(4) initial array unaligned dcl 4-23 IBM_SYS_CODE internal static char(13) initial unaligned dcl 4-28 MCA_DTYPEX internal static fixed bin(17,0) initial dcl 6-36 NUM_QUALIFIERS internal static fixed bin(17,0) initial array dcl 6-22 PRINTER_DTYPEX internal static fixed bin(17,0) initial dcl 6-32 PUNCH_DTYPEX internal static fixed bin(17,0) initial dcl 6-33 READER_DTYPEX internal static fixed bin(17,0) initial dcl 6-34 SPECIAL_DTYPEX internal static fixed bin(17,0) initial dcl 6-35 TAPE_DRIVE_DTYPEX internal static fixed bin(17,0) initial dcl 6-29 Tape_volume_types internal static char(16) initial array unaligned dcl 5-29 Volume_blank internal static fixed bin(17,0) initial dcl 5-15 Volume_gcos_tape internal static fixed bin(17,0) initial dcl 5-15 Volume_multics_tape internal static fixed bin(17,0) initial dcl 5-15 Volume_unauthenticated internal static fixed bin(17,0) initial dcl 5-15 Volume_unknown_format internal static fixed bin(17,0) initial dcl 5-15 Volume_unreadable internal static fixed bin(17,0) initial dcl 5-15 cseg_tseg_version_2 internal static fixed bin(17,0) initial dcl 2-12 ibm_hdr1 based structure level 1 packed unaligned dcl 4-8 ibm_hdr1P automatic pointer dcl 4-6 iox_$iocb_version_sentinel external static char(4) dcl 1-51 NAMES DECLARED BY EXPLICIT CONTEXT. abort_fail 002636 constant label dcl 386 ref 373 abort_file 002521 constant entry internal dcl 360 ref 412 another_volume 005115 constant entry internal dcl 864 ref 825 ask 005206 constant label dcl 883 set ref 888 924 ask_raw 005214 constant label dcl 886 ref 901 bad_mode 003304 constant label dcl 518 bad_open 000617 constant label dcl 167 set ref 176 178 beginning_of_file 001147 constant entry external dcl 952 bof_fail 001256 constant label dcl 986 ref 961 964 close 002074 constant entry external dcl 1307 close_exit 002321 constant label dcl 1387 ref 988 1026 1098 1230 1341 1357 close_exit1 002371 constant label dcl 1395 ref 1329 1330 close_fail 002273 constant label dcl 1355 ref 1337 1347 1379 comment 005476 constant label dcl 915 ref 909 consistent 002664 constant entry internal dcl 393 ref 158 332 986 1024 1096 1228 1339 1355 data_eof 001546 constant entry external dcl 1078 data_eof_fail 001672 constant label dcl 1096 ref 1087 1192 data_eot 001733 constant entry external dcl 1197 data_eot_fail 002040 constant label dcl 1228 ref 1213 1245 debug_off 002510 constant entry external dcl 1414 debug_on 002475 constant entry external dcl 1409 debug_print 005673 constant entry internal dcl 1419 ref 362 395 465 526 812 955 999 1081 1200 done 000776 constant label dcl 309 end_of_file 001267 constant entry external dcl 996 eof_fail 001447 constant label dcl 1024 ref 1005 1011 1034 1039 1069 er_exit 001130 constant label dcl 332 ref 269 299 514 517 520 error 004440 constant label dcl 801 ref 545 567 571 598 614 620 635 655 761 769 772 783 789 792 got_one 003471 constant label dcl 568 ref 559 563 got_reelid 004623 constant label dcl 829 handler 002750 constant entry internal dcl 417 ref 314 1398 initialize_permitA 003017 constant entry internal dcl 434 ref 601 initialize_permitB 003027 constant entry internal dcl 445 ref 609 inv_blk 003300 constant label dcl 515 ref 468 472 inv_rec 003274 constant label dcl 512 ref 480 485 489 494 498 ip_com 003036 constant label dcl 450 ref 442 iq 000007 constant label array(-1:6) dcl 601 ref 600 lrec_open 003143 constant entry internal dcl 463 ref 271 306 991 match 000003 constant label array(4) dcl 480 ref 479 move 003310 constant entry internal dcl 524 ref 268 298 968 1033 1158 1235 next_volume 004464 constant entry internal dcl 806 ref 1205 no_next_volume 001135 constant label dcl 337 not_enough 000662 constant label dcl 251 ref 255 260 ok 003254 constant label dcl 502 in procedure "lrec_open" ref 484 487 493 496 ok 003711 constant label dcl 612 in procedure "move" ref 601 ok_exit 004407 constant label dcl 797 open 000527 constant entry external dcl 134 recovery 000000 constant label array(0:2) dcl 400 ref 398 switch 003401 constant label dcl 557 ref 550 tape_ansi_nl_file_cntl_ 000513 constant entry external dcl 32 uninit 003653 constant label dcl 596 ref 608 609 valid_exit 001140 constant label dcl 341 ref 169 253 334 vl_init 004730 constant entry internal dcl 843 ref 831 write_TM 005541 constant entry internal dcl 931 ref 368 616 1216 1362 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 6662 7014 5742 6672 Length 7506 5742 132 456 717 2 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME tape_ansi_nl_file_cntl_ 480 external procedure is an external procedure. on unit on line 156 64 on unit on unit on line 314 64 on unit abort_file internal procedure shares stack frame of internal procedure consistent. consistent 138 internal procedure is called by several nonquick procedures. handler 82 internal procedure is called by several nonquick procedures. initialize_permitA internal procedure shares stack frame of external procedure tape_ansi_nl_file_cntl_. lrec_open internal procedure shares stack frame of external procedure tape_ansi_nl_file_cntl_. move internal procedure shares stack frame of external procedure tape_ansi_nl_file_cntl_. next_volume internal procedure shares stack frame of external procedure tape_ansi_nl_file_cntl_. vl_init internal procedure shares stack frame of external procedure tape_ansi_nl_file_cntl_. another_volume internal procedure shares stack frame of external procedure tape_ansi_nl_file_cntl_. write_TM 81 internal procedure is called by several nonquick procedures. on unit on line 961 64 on unit on unit on line 1005 64 on unit on unit on line 1087 64 on unit on unit on line 1213 64 on unit on unit on line 1321 64 on unit on unit on line 1329 64 on unit on unit on line 1337 64 on unit on unit on line 1347 64 on unit on unit on line 1398 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_nl_file_cntl_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME handler 000100 ti handler tape_ansi_nl_file_cntl_ 000100 cP tape_ansi_nl_file_cntl_ 000102 answer tape_ansi_nl_file_cntl_ 000143 com_text tape_ansi_nl_file_cntl_ 000164 vn tape_ansi_nl_file_cntl_ 000174 cc tape_ansi_nl_file_cntl_ 000175 mask tape_ansi_nl_file_cntl_ 000176 tstring tape_ansi_nl_file_cntl_ 000207 qi tape_ansi_nl_file_cntl_ 000240 msg initialize_permitA 000314 i move 000315 uninit_msg move 000340 canon_std next_volume 000342 ecode next_volume 000360 msg another_volume 000405 L1 another_volume write_TM 000100 cnt write_TM THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. 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 enable_op shorten_stack ext_entry int_entry int_entry_desc THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. canon_for_volume_label_ command_query_ continue_to_signal_ hcs_$reset_ips_mask hcs_$set_ips_mask ioa_ iox_$propagate tape_ansi_control_ tape_ansi_detach_ tape_ansi_ibm_lrec_io_$close tape_ansi_ibm_lrec_io_$read_record tape_ansi_ibm_lrec_io_$write_record tape_ansi_mount_cntl_$mount tape_ansi_mount_cntl_$remount tape_ansi_nl_file_cntl_$close tape_ansi_nl_file_cntl_$open tape_ansi_position_ tape_ansi_read_length_ tape_ansi_tape_io_$open tape_ansi_tape_io_$order terminate_process_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$blank_tape error_table_$device_limit_exceeded error_table_$end_of_info error_table_$eov_on_write error_table_$file_aborted error_table_$file_busy error_table_$incompatible_attach error_table_$incompatible_encoding_mode error_table_$insufficient_open error_table_$invalid_block_length error_table_$invalid_cseg error_table_$invalid_file_set_format error_table_$invalid_record_length error_table_$no_file error_table_$no_next_volume error_table_$positioned_on_bot error_table_$unable_to_do_io error_table_$uninitialized_volume sys_info$max_seg_size LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 65 000505 32 000512 134 000521 137 000540 140 000546 143 000550 144 000553 147 000554 150 000556 151 000561 155 000562 156 000563 158 000577 159 000604 160 000607 161 000610 164 000613 167 000617 169 000622 172 000623 176 000634 178 000636 183 000646 186 000650 187 000652 245 000655 248 000660 251 000662 253 000665 255 000666 257 000670 260 000672 264 000675 268 000701 269 000713 271 000715 272 000716 276 000717 279 000721 280 000723 282 000725 284 000731 287 000733 289 000737 291 000744 293 000751 295 000755 298 000761 299 000773 306 000775 309 000776 311 000777 312 001002 313 001006 314 001007 315 001031 316 001044 317 001055 321 001066 322 001072 323 001075 325 001100 326 001103 327 001105 328 001115 329 001125 330 001127 332 001130 334 001134 337 001135 341 001140 343 001142 952 001143 955 001160 957 001175 960 001203 961 001204 963 001223 964 001234 968 001236 983 001254 986 001256 988 001262 991 001263 994 001264 996 001265 999 001300 1001 001317 1004 001325 1005 001326 1007 001345 1010 001352 1011 001371 1013 001373 1014 001430 1017 001431 1018 001433 1020 001435 1021 001445 1024 001447 1026 001453 1030 001454 1033 001461 1034 001475 1038 001477 1039 001517 1068 001521 1069 001541 1077 001543 1078 001544 1081 001557 1083 001574 1086 001602 1087 001603 1089 001622 1092 001657 1093 001670 1096 001672 1098 001676 1102 001677 1153 001704 1154 001707 1158 001710 1192 001726 1195 001730 1197 001731 1200 001744 1202 001761 1205 001767 1208 001774 1209 001777 1212 002000 1213 002002 1216 002021 1224 002033 1228 002040 1230 002044 1232 002045 1235 002046 1245 002067 1248 002071 1307 002072 1310 002105 1313 002113 1316 002115 1317 002120 1321 002121 1322 002141 1325 002144 1328 002146 1329 002151 1330 002170 1333 002171 1336 002174 1337 002175 1338 002214 1339 002225 1341 002233 1346 002234 1347 002236 1348 002255 1349 002266 1352 002270 1355 002273 1357 002277 1362 002300 1376 002312 1379 002314 1383 002320 1387 002321 1391 002324 1392 002346 1393 002367 1395 002371 1397 002372 1398 002373 1399 002415 1400 002430 1401 002441 1402 002444 1403 002447 1404 002451 1405 002461 1406 002471 1407 002473 1409 002474 1411 002503 1412 002506 1414 002507 1416 002516 1417 002520 360 002521 362 002522 365 002543 368 002567 373 002602 378 002610 383 002631 384 002635 386 002636 388 002656 389 002662 393 002663 395 002671 398 002710 400 002713 404 002714 407 002740 409 002741 412 002745 413 002746 417 002747 419 002755 423 002756 426 002761 427 002763 430 003006 431 003016 434 003017 441 003021 442 003026 445 003027 448 003031 450 003036 452 003040 453 003042 455 003045 457 003122 459 003135 463 003143 465 003144 468 003163 472 003173 475 003203 477 003211 479 003213 480 003215 484 003222 485 003223 487 003227 489 003230 493 003236 494 003237 496 003243 498 003244 502 003254 505 003256 506 003260 507 003262 508 003263 509 003264 510 003273 512 003274 514 003277 515 003300 517 003303 518 003304 520 003307 524 003310 526 003312 533 003327 534 003330 537 003350 540 003353 542 003366 545 003371 548 003374 550 003377 554 003400 557 003401 559 003411 561 003427 562 003431 563 003443 565 003461 566 003464 567 003470 568 003471 571 003507 576 003512 577 003536 578 003543 580 003546 583 003551 585 003574 589 003577 592 003602 594 003614 595 003621 596 003653 598 003656 600 003657 601 003662 608 003675 609 003676 612 003711 614 003732 616 003735 620 003747 623 003755 627 004000 631 004011 634 004035 635 004055 637 004060 645 004102 648 004131 649 004141 650 004162 653 004165 655 004172 657 004173 754 004175 756 004176 759 004177 760 004207 761 004230 763 004233 764 004235 765 004256 768 004261 769 004301 771 004304 772 004305 775 004311 779 004312 782 004315 783 004335 785 004340 788 004341 789 004361 791 004364 792 004404 797 004407 799 004437 801 004440 803 004463 806 004464 809 004466 812 004477 815 004517 818 004532 821 004534 822 004554 825 004562 827 004615 829 004623 831 004624 832 004632 833 004654 836 004712 839 004722 843 004730 846 004732 847 004752 848 004766 849 004774 850 005002 851 005010 852 005021 853 005027 854 005035 855 005042 856 005050 857 005056 858 005064 859 005073 860 005077 861 005114 864 005115 872 005117 873 005121 874 005123 875 005126 876 005133 878 005167 881 005202 882 005204 883 005206 885 005207 886 005214 888 005251 890 005256 891 005257 892 005270 895 005273 896 005335 899 005340 900 005341 901 005362 904 005364 905 005416 908 005422 909 005446 911 005447 914 005452 915 005476 918 005501 919 005511 922 005512 924 005531 927 005532 931 005540 937 005546 939 005571 940 005601 942 005623 945 005631 946 005667 948 005671 1419 005672 1423 005706 1424 005717 ----------------------------------------------------------- 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