COMPILATION LISTING OF SEGMENT tape_ansi_lrec_io_ Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/04/82 1707.6 mst Thu 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 /* Modified: 4/82 by J. A. Bush for block sizes > 8192 bytes */ 12 13 tape_ansi_lrec_io_: procedure; 14 /* argument list */ 15 dcl iocbP ptr, /* pointer to IO control block */ 16 ubP ptr, /* pointer to user buffer */ 17 buf_len fixed bin (21), /* number of characters requested for IO */ 18 rec_len fixed bin (21), /* number of characters read */ 19 code fixed bin (35); /* error code */ 20 1 1 /* BEGIN INCLUDE FILE ..... iocb.incl.pl1 ..... 13 Feb 1975, M. Asherman */ 1 2 /* format: style2 */ 1 3 1 4 dcl 1 iocb aligned based, /* I/O control block. */ 1 5 2 version character (4) aligned, 1 6 2 name char (32), /* I/O name of this block. */ 1 7 2 actual_iocb_ptr ptr, /* IOCB ultimately SYNed to. */ 1 8 2 attach_descrip_ptr ptr, /* Ptr to printable attach description. */ 1 9 2 attach_data_ptr ptr, /* Ptr to attach data structure. */ 1 10 2 open_descrip_ptr ptr, /* Ptr to printable open description. */ 1 11 2 open_data_ptr ptr, /* Ptr to open data structure (old SDB). */ 1 12 2 reserved bit (72), /* Reserved for future use. */ 1 13 2 detach_iocb entry (ptr, fixed (35)),/* detach_iocb(p,s) */ 1 14 2 open entry (ptr, fixed, bit (1) aligned, fixed (35)), 1 15 /* open(p,mode,not_used,s) */ 1 16 2 close entry (ptr, fixed (35)),/* close(p,s) */ 1 17 2 get_line entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 1 18 /* get_line(p,bufptr,buflen,actlen,s) */ 1 19 2 get_chars entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 1 20 /* get_chars(p,bufptr,buflen,actlen,s) */ 1 21 2 put_chars entry (ptr, ptr, fixed (21), fixed (35)), 1 22 /* put_chars(p,bufptr,buflen,s) */ 1 23 2 modes entry (ptr, char (*), char (*), fixed (35)), 1 24 /* modes(p,newmode,oldmode,s) */ 1 25 2 position entry (ptr, fixed, fixed (21), fixed (35)), 1 26 /* position(p,u1,u2,s) */ 1 27 2 control entry (ptr, char (*), ptr, fixed (35)), 1 28 /* control(p,order,infptr,s) */ 1 29 2 read_record entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 1 30 /* read_record(p,bufptr,buflen,actlen,s) */ 1 31 2 write_record entry (ptr, ptr, fixed (21), fixed (35)), 1 32 /* write_record(p,bufptr,buflen,s) */ 1 33 2 rewrite_record entry (ptr, ptr, fixed (21), fixed (35)), 1 34 /* rewrite_record(p,bufptr,buflen,s) */ 1 35 2 delete_record entry (ptr, fixed (35)),/* delete_record(p,s) */ 1 36 2 seek_key entry (ptr, char (256) varying, fixed (21), fixed (35)), 1 37 /* seek_key(p,key,len,s) */ 1 38 2 read_key entry (ptr, char (256) varying, fixed (21), fixed (35)), 1 39 /* read_key(p,key,len,s) */ 1 40 2 read_length entry (ptr, fixed (21), fixed (35)); 1 41 /* read_length(p,len,s) */ 1 42 1 43 declare iox_$iocb_version_sentinel 1 44 character (4) aligned external static; 1 45 1 46 /* END INCLUDE FILE ..... iocb.incl.pl1 ..... */ 21 22 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 */ 23 24 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 */ 25 26 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 */ 27 28 29 30 /* based overlays */ 31 dcl buf char (cseg.buf_size) aligned based (cseg.lrec.bufP), /* one physical block */ 32 data char (move) unaligned based, /* overlay for data move */ 33 RCW char (4) unaligned based (dwP); /* D-format rdw */ 34 dcl 1 SCW based (dwP), /* segment control word */ 35 2 code char (1) unaligned,/* control code */ 36 2 length char (4) unaligned;/* length of segment */ 37 dcl ub char (buf_len) unaligned based (ubP); /* user buffer overlay */ 38 39 /* error codes */ 40 dcl (error_table_$eov_on_write, 41 error_table_$file_busy, 42 error_table_$invalid_record_desc, 43 error_table_$long_record, 44 error_table_$tape_error, 45 error_table_$fatal_error, 46 error_table_$eof_record) fixed bin (35) external static; 47 48 49 /* builtin functions */ 50 dcl (addr, binary, decimal, mod, null, substr, verify) builtin; 51 52 /* conditions */ 53 dcl (cleanup, conversion) condition; 54 55 /* automatic storage */ 56 dcl (i, j) fixed bin, /* temporary storage */ 57 csw bit (1) init ("0"b), /* indicates close entry */ 58 total fixed bin (21) initial (0), /* number of characters moved in this request */ 59 move fixed bin initial (0), /* number of characters moved per segment/record */ 60 left fixed bin (21), /* number of characters remaining for this request */ 61 long_record bit (1) initial ("0"b), /* long record switch */ 62 parity_error bit (1) initial ("0"b), /* parity error switch */ 63 req_off fixed bin, /* number of buffer characters processed by this request */ 64 remain fixed bin, /* number of unprocessed characters in buffer */ 65 ecode fixed bin (35) init (0), /* temporary error code */ 66 data_len fixed bin initial (0), /* number of characters in varying length record */ 67 cwl picture "9999", /* control word length for RCW and SCW */ 68 first_span bit (1) initial ("1"b); /* first segment of spanned request switch */ 69 70 /* pointers */ 71 dcl dwP ptr, /* pointer to RCW - SCW */ 72 fromP ptr, /* pointer to buffer for data move */ 73 toP ptr; /* pointer to user buffer for data move */ 74 75 /* static storage */ 76 dcl 1 scw internal static aligned, /* SCW data */ 77 2 complete char (1) initial ("0"), /* complete code - ASCII 0 */ 78 2 initial char (1) initial ("1"), /* initial code - ASCII 1 */ 79 2 medial char (1) initial ("2"), /* medial code - ASCII 2 */ 80 2 final char (1) initial ("3"); /* final code - ASCII 3 */ 81 82 dcl bpad char (20) internal static init ((20)"^"); 83 84 dcl ebcdic init (2) fixed bin internal static; 85 86 /* subroutine calls */ 87 dcl ascii_to_ebcdic_ ext entry (char (*), char (*)), 88 ebcdic_to_ascii_ ext entry (char (*), char (*)), 89 tape_ansi_file_cntl_$data_eof ext entry (ptr, fixed bin (35)), 90 tape_ansi_file_cntl_$data_eot ext entry (ptr, fixed bin (35)), 91 tape_ansi_file_cntl_$position_for_output ext entry (ptr, fixed bin (35)), 92 tape_ansi_tape_io_$close ext entry (ptr, fixed bin (35)), 93 tape_ansi_tape_io_$get_buffer ext entry (ptr, ptr, fixed bin (35)), 94 tape_ansi_tape_io_$read ext entry (ptr, ptr, fixed bin, fixed bin (35)), 95 tape_ansi_tape_io_$release_buffer ext entry (ptr, ptr, fixed bin (35)), 96 tape_ansi_tape_io_$write ext entry (ptr, ptr, fixed bin, fixed bin (35)); 97 98 read_record: entry (iocbP, ubP, buf_len, rec_len, code); /* read_record entry point */ 99 100 cP = iocbP -> iocb.actual_iocb_ptr -> iocb.attach_data_ptr; /* get pointer to cseg */ 101 102 if cseg.file_lock then do; 103 rec_len = 0; 104 code = error_table_$file_busy; 105 return; 106 end; 107 else do; 108 on cleanup begin; 109 cseg.file_lock = "0"b; 110 cseg.code = error_table_$fatal_error; 111 end; 112 cseg.file_lock = "1"b; 113 end; 114 115 if cseg.code ^= 0 then do; /* was there a non-restartable error? */ 116 code = cseg.code; /* set return code */ 117 cseg.file_lock = "0"b; 118 return; 119 end; 120 121 if cseg.rlN ^= -1 then do; /* data record is in read length segment */ 122 if buf_len >= cseg.rlN then do; /* user wants as much as (or more than) we have */ 123 code = 0; 124 move = cseg.rlN; /* give only as much as we have */ 125 end; 126 else do; /* user wants less than we have */ 127 code = error_table_$long_record; 128 move = buf_len; /* give what s(he) wants */ 129 end; 130 ubP -> data = cseg.rlP -> data; /* move to user */ 131 rec_len = move; /* indicate amount moved */ 132 cseg.rlN = -1; /* read length buffer is now empty */ 133 cseg.lrec.reccnt = cseg.lrec.reccnt + 1; 134 cseg.file_lock = "0"b; 135 return; 136 end; 137 138 go to r_format (fd.format); /* transfer to begin processing */ 139 140 r_format (1): call get_record; /* U format - get a logical record */ 141 move = remain; /* user gets all, even pad chars (if any) */ 142 if buf_len < move then do; /* buffer < record */ 143 long_record = "1"b; 144 move = buf_len; /* move as much as can fit */ 145 end; 146 req_off = remain; /* this request processes the entire block */ 147 call move_to_user; /* move data to user's workspace */ 148 call read_release; /* release the record */ 149 go to r_count; /* return to caller */ 150 151 r_format (2): call get_record; /* get 1 record */ 152 if fd.reclen > remain then move = remain; /* don't try to move more than we have */ 153 else move = fd.reclen; /* move only up to 1 record's worth */ 154 if buf_len < move then do; /* buffer < record */ 155 long_record = "1"b; 156 move = buf_len; /* move only what can fit */ 157 end; 158 req_off = fd.reclen; /* process one record */ 159 call move_to_user; /* move data to user's workspace */ 160 call read_release; /* release the record */ 161 go to r_count; /* return to caller */ 162 163 r_format (3): call get_record; /* D format - get a logical record */ 164 if substr (buf, cseg.offset + 1, 1) = "^" then do;/* pad RCW? */ 165 call tape_ansi_tape_io_$release_buffer (cP, cseg.lrec.bufP, 0); /* pad rcw is last in block */ 166 go to r_format (3); /* try again */ 167 end; 168 dwP = addr (substr (buf, cseg.offset + 1)); /* get pointer to rcw */ 169 on conversion go to inv_desc; /* detect invalid descriptor */ 170 data_len = binary (RCW, 17) - 4; /* get length of data */ 171 revert conversion; /* stop handling the condition */ 172 if data_len > remain - 4 then go to inv_desc; /* block bigger than block size? */ 173 move = data_len; /* move up to 1 record */ 174 if buf_len < move then do; /* buffer < record */ 175 long_record = "1"b; 176 move = buf_len; /* move only what can fit */ 177 end; 178 cseg.offset = cseg.offset + 4; /* the rdw has been processed */ 179 req_off = data_len; /* process one logical record */ 180 call move_to_user; /* move data to user's workspace */ 181 call read_release; /* release the record */ 182 go to r_count; /* return to caller */ 183 184 r_format (4): call get_record; /* S format - get a logical record */ 185 left = buf_len; /* save request for decrementing */ 186 r_sw_check: call process_sw; /* process the SCW - get type and data length */ 187 if left >= data_len then move = data_len; /* give user the entire segment..... */ 188 else do; /* user doesn't want all the data */ 189 long_record = "1"b; /* buffer < record */ 190 move = left; /* move only as much as can fit */ 191 end; 192 call move_to_user; /* move the data to the user's workspace */ 193 left = left - move; /* keep track of remainder of request */ 194 if SCW.code = scw.complete | SCW.code = scw.final then do; /* segment is last (or only) of record */ 195 call read_release; /* release it */ 196 go to r_count; /* and we're done */ 197 end; 198 else call read_release; /* release the record and continue */ 199 if left ^= 0 then do; /* user wants more, and more segments are available */ 200 call get_record; /* get the next segment */ 201 go to r_sw_check; /* transfer to process the SCW/SDW, etc. ..... */ 202 end; 203 call skip_segments; /* request satisfied, but more segments remain - skip them */ 204 long_record = "1"b; /* buffer < record */ 205 go to r_count; /* return to caller */ 206 207 inv_desc: ecode = error_table_$invalid_record_desc; /* set error ecode */ 208 go to r_exit; 209 210 r_count: cseg.lrec.reccnt = cseg.lrec.reccnt + 1; 211 212 r_exit: if parity_error then code = error_table_$tape_error; 213 else code = ecode; 214 cseg.code = code; 215 if code = 0 then if long_record then code = error_table_$long_record; 216 rec_len = total; /* return total number of characters moved */ 217 cseg.file_lock = "0"b; 218 return; /* and return to the caller */ 219 220 get_record: procedure; /* internal procedure to get 1 logical record */ 221 if cseg.lrec.bufP = null then do; /* get a block if inactive buffer */ 222 restart: call tape_ansi_tape_io_$read (cP, cseg.lrec.bufP, cseg.nc_buf, ecode); /* get 1 physical block */ 223 if ecode ^= 0 then do; /* was there an error or EOF? */ 224 if ecode = error_table_$eof_record then do; /* EOF detected */ 225 call tape_ansi_file_cntl_$data_eof (iocbP, ecode); /* see if follow-on volume */ 226 if ecode = 0 then go to restart; /* switched to new file section */ 227 else go to r_exit; /* no next volume or error */ 228 end; 229 else do; /* not EOF - some sort of error */ 230 if ecode = error_table_$tape_error then parity_error = "1"b; /* process this block */ 231 else go to r_exit; /* terminate processing */ 232 end; 233 end; 234 cseg.blkcnt = cseg.blkcnt + 1; /* keep track of physical blocks read */ 235 cseg.offset = fd.bo; /* skip ANSI block prefix, if any */ 236 if cseg.nc_buf - cseg.offset < 0 then do; /* fatal error */ 237 ecode = error_table_$fatal_error; 238 go to r_exit; 239 end; 240 if cseg.nc_buf > fd.blklen then cseg.nc_buf = fd.blklen; /* eliminate obvious padding */ 241 if fd.format = 2 then do; /* F/FB - strip pad characters */ 242 i = (cseg.nc_buf - fd.bo) / fd.reclen; /* # of records */ 243 j = mod (cseg.nc_buf - fd.bo, fd.reclen); /* # of extra chars */ 244 if j ^= 0 then do; /* if any, test them */ 245 if verify (substr (buf, cseg.nc_buf - j + 1, j), "^") = 0 246 then cseg.nc_buf = cseg.nc_buf - j; /* all pad - eliminate */ 247 else go to out; /* keep all - treat as short record */ 248 end; 249 do j = i to 1 by -1; /* test records for all "^" */ 250 if verify (substr (buf, fd.bo + ((j - 1) * fd.reclen) + 1, fd.reclen), "^") = 0 251 then cseg.nc_buf = cseg.nc_buf - fd.reclen; 252 else go to out; /* reached end of pad characters */ 253 end; 254 end; 255 end; 256 out: remain = cseg.nc_buf - cseg.offset; /* get number of characters to be processed */ 257 return; /* exit */ 258 end get_record; 259 260 process_sw: procedure; /* internal procedure to process SCW's */ 261 ck_dw: if substr (buf, cseg.offset + 1, 1) = "^" then do;/* pad SCW? */ 262 call tape_ansi_tape_io_$release_buffer (cP, cseg.lrec.bufP, 0); /* all pad chars - release block */ 263 call get_record; /* get another record */ 264 go to ck_dw; /* try again */ 265 end; 266 dwP = addr (substr (buf, cseg.offset + 1)); /* get pointer to SDW/SCW */ 267 on conversion go to inv_desc; /* handle the conversion condition */ 268 data_len = binary (SCW.length, 17) - 5; /* get length of data */ 269 if binary (SCW.code) > 3 then go to inv_desc; /* error if SCW.code > 3 */ 270 if data_len > remain - 5 then go to inv_desc; /* block greater than block size? */ 271 revert conversion; /* disable the condition handler */ 272 cseg.offset = cseg.offset + 5; /* SCW has been processed */ 273 req_off = data_len; /* the entire segment will be processed */ 274 return; /* exit */ 275 end process_sw; 276 277 skip_segments: procedure; /* internal procedure to skip to beginning of spanned record */ 278 s_get: call get_record; /* get a segment */ 279 call process_sw; /* process its SCW/SDW */ 280 if SCW.code = scw.final then do; /* is this the final segment? */ 281 call read_release; /* release it */ 282 return; /* and exit */ 283 end; 284 call read_release; /* release the segment */ 285 go to s_get; /* get the next segment */ 286 end skip_segments; 287 288 move_to_user: procedure; /* internal procedure to move data to user's workspace */ 289 290 if move = 0 then return; 291 fromP = addr (substr (buf, cseg.offset + 1)); /* set pointer to data to be moved */ 292 toP = addr (substr (ub, total + 1)); /* set pointer to user buffer */ 293 if fd.mode ^= ebcdic then toP -> data = fromP -> data; /* ascii/binary */ 294 else call ebcdic_to_ascii_ (fromP -> data, toP -> data); /* ebcdic */ 295 total = total + move; /* sum each move */ 296 return; /* exit */ 297 end move_to_user; 298 299 read_release: procedure; /* internal procedure to release a record and/or block */ 300 cseg.offset = cseg.offset + req_off; /* the request has been processed */ 301 remain = cseg.nc_buf - cseg.offset; /* get number of characters not yet processed */ 302 if fd.format = 4 then if remain < 5 then go to release_it; /* S format and SCW can't fit */ 303 else return; /* S format and SCW can fit */ 304 if remain < 4 then do; /* if so, the block may have been exhausted */ 305 if fd.format = 2 then if fd.reclen <= remain then return; 306 /* save if another record could fit */ 307 release_it: call tape_ansi_tape_io_$release_buffer (cP, cseg.lrec.bufP, 0); /* block exhausted */ 308 end; 309 return; /* exit */ 310 end read_release; 311 312 write_record: entry (iocbP, ubP, buf_len, code); /* write_record entry point */ 313 314 cP = iocbP -> iocb.actual_iocb_ptr -> iocb.attach_data_ptr; /* get pointer to cseg */ 315 316 if cseg.file_lock then do; 317 code = error_table_$file_busy; 318 return; 319 end; 320 else do; 321 on cleanup begin; 322 cseg.file_lock = "0"b; 323 cseg.code = error_table_$fatal_error; 324 end; 325 cseg.file_lock = "1"b; 326 end; 327 328 if cseg.code ^= 0 then do; /* was there a non-restartable error? */ 329 code = cseg.code; /* set return code */ 330 cseg.file_lock = "0"b; 331 return; 332 end; 333 334 if vl (fl.vlX).pos ^= 1 then do; /* not positioned for output */ 335 call tape_ansi_file_cntl_$position_for_output (iocbP, ecode); 336 if ecode ^= 0 then go to w_exit; /* error */ 337 end; 338 339 go to w_format (fd.format); /* transfer to begin processing */ 340 341 342 343 w_format (1): if buf_len > fd.blklen - fd.bo then go to w_long; /* U format - check buf_len */ 344 call get_buf; /* get a buffer */ 345 move = buf_len; /* move the requested amount of data */ 346 req_off = buf_len; /* number of characters to be processed */ 347 call move_to_buf; /* move the data to the write buffer */ 348 call write_buf; /* write one block */ 349 go to w_count; /* return to caller */ 350 351 w_format (2): if buf_len > fd.reclen then go to w_long; /* F format - check buf_len validity */ 352 call get_buf; /* get a buffer */ 353 move = buf_len; /* transfer the request as stated */ 354 remain = fd.reclen - buf_len; /* get difference between buf_len and reclen for padding */ 355 if remain ^= 0 then substr (buf, cseg.offset + buf_len + 1, remain) = " "; /* pad the record */ 356 req_off = fd.reclen; /* process one logical record */ 357 call move_to_buf; /* move the data to the write buffer */ 358 if ^fd.blocked then call write_buf; /* unblocked: write 1 record per block */ 359 else if cseg.offset = fd.blklen then call write_buf; /* blocked: write if block full */ 360 go to w_count; /* return to caller */ 361 362 w_format (3): data_len = buf_len + 4; /* D format - record length = buf_len + rdw length */ 363 if data_len > fd.reclen then go to w_long; /* check data_len validity */ 364 call get_buf; /* get a buffer */ 365 if fd.blocked then if data_len > fd.blklen - cseg.offset then do; /* record won't fit in this block */ 366 call write_buf; /* write the current buffer contents */ 367 call get_buf; /* get another write buffer */ 368 end; /* request validity has been verified, so just continue */ 369 dwP = addr (substr (buf, cseg.offset + 1)); /* locate rdw position */ 370 cwl = decimal (data_len, 4); /* convert length to ASCII characters */ 371 RCW = cwl; /* store in RCW */ 372 cseg.offset = cseg.offset + 4; /* the rdw has been processed */ 373 req_off = buf_len; /* process buf_len characters */ 374 move = buf_len; /* move buf_len characters */ 375 call move_to_buf; /* move the data to the write buffer */ 376 if ^fd.blocked then call write_buf; /* unblocked: write 1 record per block */ 377 else if fd.blklen - cseg.offset < 4 then call write_buf; /* write block if even null record can't fit */ 378 go to w_count; /* return to caller */ 379 380 w_format (4): if buf_len > fd.reclen then go to w_long; /* S format - check buf_len validity */ 381 call get_buf; /* get a buffer */ 382 left = buf_len; /* save request for decrementing */ 383 remain = fd.blklen - cseg.offset; /* get number of characters left in block */ 384 w_fit_check: dwP = addr (substr (buf, cseg.offset + 1)); /* locate SCW position */ 385 if left + 5 <= remain then do; /* will the request fit entirely? */ 386 if first_span then SCW.code = scw.complete; /* if first segment then code is complete */ 387 else SCW.code = scw.final; /* else code is final */ 388 move = left; /* move all the data */ 389 end; 390 else do; /* request will not fit in block */ 391 if first_span then do; /* if first segment then this is initial */ 392 SCW.code = scw.initial; /* set code */ 393 first_span = "0"b; /* set switch to indicate medial/final segments to follow */ 394 end; 395 else SCW.code = scw.medial; /* not first segment, won't fit -- medial segment */ 396 move = remain - 5; /* move as much data as will fit */ 397 end; 398 left = left - move; /* decrement data to be moved count */ 399 data_len = move + 5; /* compute segment length */ 400 cwl = decimal (data_len, 4); /* convert length to ASCII characters */ 401 SCW.length = cwl; /* store in SCW */ 402 cseg.offset = cseg.offset + 5; /* SCW has been processed */ 403 req_off = move; /* process the data move */ 404 call move_to_buf; /* move data to write buffer */ 405 remain = remain - data_len; /* get number of characters left after request */ 406 if ^fd.blocked then go to w_now; /* write each segment if not blocked */ 407 if remain < 6 then do; /* blocked: could another segment fit? */ 408 w_now: call write_buf; /* write the block */ 409 call get_buf; /* get another buffer */ 410 remain = fd.blklen - cseg.offset; /* initialize number of remaining characters */ 411 end; 412 if left ^= 0 then go to w_fit_check; /* if more segments need be written, continue processing */ 413 go to w_count; /* .... or return to caller */ 414 415 416 w_long: code = error_table_$long_record; /* set return code */ 417 go to w_exit1; /* csw can't be "1"b and shouldn't lock file */ 418 419 w_count: cseg.lrec.reccnt = cseg.lrec.reccnt + 1; /* increment record count */ 420 421 w_exit: code = ecode; /* return error code (if any) */ 422 cseg.code = code; /* set logical record I/O lock (if any) */ 423 if csw then go to c_exit; /* if close entry, go to close exit */ 424 w_exit1: cseg.file_lock = "0"b; /* unlock the file */ 425 return; /* return to caller */ 426 427 get_buf: procedure; /* internal procedure to get a write buffer for data transfer */ 428 if cseg.lrec.bufP = null then do; /* get a buffer if necessary */ 429 call tape_ansi_tape_io_$get_buffer (cP, cseg.lrec.bufP, 0); /* get the buffer */ 430 cseg.offset = fd.bo; /* initialize buffer offset */ 431 if cseg.offset ^= 0 then substr (buf, 1, cseg.offset) = ""; /* set to blanks */ 432 end; 433 return; /* exit */ 434 end get_buf; 435 436 437 move_to_buf: procedure; /* internal procedure to move data from user's buffer */ 438 if move = 0 then go to move_nothing; /* return if no data to be moved */ 439 fromP = addr (substr (ub, total + 1)); /* set pointer to data to be moved */ 440 toP = addr (substr (buf, cseg.offset + 1)); /* set pointer to buffer */ 441 if fd.mode ^= ebcdic then toP -> data = fromP -> data; /* ascii/binary */ 442 else call ascii_to_ebcdic_ (fromP -> data, toP -> data); /* ebcdic */ 443 total = total + move; /* sum each move */ 444 move_nothing: cseg.offset = cseg.offset + req_off; /* the request has been processed */ 445 return; /* return to caller */ 446 end move_to_buf; 447 448 write_buf: procedure; /* internal procedure to write one physical block */ 449 if cseg.offset < 20 then do; /* pad to 20 bytes if < 20 bytes */ 450 remain = 20 - cseg.offset; /* get pad requirement */ 451 go to w_pad; /* pad the block */ 452 end; 453 w_mod: remain = 4 - mod (cseg.offset, 4); /* get difference between actual and desired blklen */ 454 if remain = 4 then go to w_put; /* length is correct - do not pad */ 455 w_pad: substr (buf, cseg.offset + 1, remain) = substr (bpad, 1, remain); /* pad with circumflex */ 456 cseg.offset = cseg.offset + remain; /* increment to reflect padding */ 457 w_put: call tape_ansi_tape_io_$write (cP, cseg.lrec.bufP, cseg.offset, ecode); /* write the block */ 458 if ecode = 0 then cseg.blkcnt = cseg.blkcnt + 1; /* OK: up block count */ 459 else if ecode = error_table_$eov_on_write then do;/* EOT detected */ 460 cseg.blkcnt = cseg.blkcnt + 1; /* block was written */ 461 if csw then return; /* ignore EOT if closing */ 462 else do; 463 call tape_ansi_file_cntl_$data_eot (iocbP, ecode); /* switch to next volume */ 464 if ecode ^= 0 then do; /* terminate if switching failed */ 465 if fd.format = 4 & left ^= 0 then go to w_exit; /* S format record only partially written */ 466 else do; /* not S format, or S and completely written */ 467 cseg.code = ecode; /* inhibit further iox_$write_record calls */ 468 code = 0; /* but return no error on this call */ 469 cseg.lrec.reccnt = cseg.lrec.reccnt + 1; /* increment record count */ 470 go to w_exit1; /* return to caller */ 471 end; 472 end; 473 end; 474 end; 475 else do; /* IO error (occurred on a previous block) */ 476 cseg.blkcnt = cseg.blkcnt - cseg.soft_status.nbuf + 1; /* decrement block count */ 477 cseg.lrec.reccnt = -cseg.lrec.reccnt; /* make record count unreliable */ 478 go to w_exit; /* terminate processing */ 479 end; 480 return; /* return to caller */ 481 end write_buf; 482 483 close: entry (acP, code); /* close entry to synchronize and terminate io */ 484 dcl acP ptr; /* pointer to control segment */ 485 486 cP = acP; /* set pointer to control segment */ 487 csw = "1"b; /* indicate close entry in case write error */ 488 if cseg.open_mode = 4 then do; /* opened for input */ 489 if cseg.lrec.bufP ^= null then go to close2; /* release an active buffer */ 490 go to c_exit; /* synchronize and finish up io */ 491 end; 492 else do; /* file was opened for output */ 493 if cseg.lrec.bufP = null then go to c_exit; /* no active buffer - synchronize and close */ 494 if cseg.offset = 0 then go to close2; /* active empty buffer - release, synch., and close */ 495 if cseg.offset = fd.bo then go to close2; /* buffer has only a block prefix */ 496 call write_buf; /* active buffer with data - write the buffer */ 497 go to c_exit; /* synchronize and close io */ 498 end; 499 close2: call tape_ansi_tape_io_$release_buffer (cP, cseg.lrec.bufP, 0); /* release the buffer */ 500 c_exit: call tape_ansi_tape_io_$close (cP, code); /* terminate the tape_ansi_tape_io_ set up */ 501 return; /* exit */ 502 503 end tape_ansi_lrec_io_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/04/82 1606.0 tape_ansi_lrec_io_.pl1 >dumps>old>recomp>tape_ansi_lrec_io_.pl1 21 1 07/28/81 1333.4 iocb.incl.pl1 >ldd>include>iocb.incl.pl1 23 2 06/10/82 1045.3 tape_ansi_cseg.incl.pl1 >ldd>include>tape_ansi_cseg.incl.pl1 25 3 11/20/79 2015.6 tape_ansi_fd.incl.pl1 >ldd>include>tape_ansi_fd.incl.pl1 27 4 11/20/79 2015.6 tape_ansi_fl.incl.pl1 >ldd>include>tape_ansi_fl.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. RCW based char(4) unaligned dcl 31 set ref 170 371* SCW based structure level 1 packed unaligned dcl 34 acP parameter pointer dcl 484 ref 483 486 actual_iocb_ptr 12 based pointer level 2 dcl 1-4 ref 100 314 addr builtin function dcl 50 ref 168 266 291 292 369 384 439 440 ascii_to_ebcdic_ 000026 constant entry external dcl 87 ref 442 attach_data_ptr 16 based pointer level 2 dcl 1-4 ref 100 314 binary builtin function dcl 50 ref 170 268 269 blkcnt 221 based fixed bin(35,0) level 3 dcl 2-14 set ref 234* 234 458* 458 460* 460 476* 476 blklen 46 based fixed bin(17,0) level 3 dcl 3-3 ref 240 240 343 359 365 377 383 410 blocked 62 based bit(1) level 3 dcl 3-3 ref 358 365 376 406 bo 64 based fixed bin(17,0) level 3 dcl 3-3 ref 235 242 243 250 343 430 495 bpad 002244 constant char(20) initial unaligned dcl 82 ref 455 buf based char dcl 31 set ref 164 168 245 250 261 266 291 355* 369 384 431* 440 455* bufP 212 based pointer level 3 dcl 2-14 set ref 164 165* 168 221 222* 245 250 261 262* 266 291 307* 355 369 384 428 429* 431 440 455 457* 489 493 499* buf_len parameter fixed bin(21,0) dcl 15 ref 98 122 128 142 144 154 156 174 176 185 292 312 343 345 346 351 353 354 355 362 373 374 380 382 439 buf_size 310 based fixed bin(17,0) level 2 dcl 2-14 ref 164 168 245 250 261 266 291 334 355 369 384 431 440 455 cP 000100 automatic pointer dcl 2-11 set ref 100* 102 109 110 112 115 116 117 121 122 124 130 132 133 133 134 138 152 153 158 164 164 164 165* 165 168 168 168 178 178 210 210 214 217 221 222* 222 222 234 234 235 235 236 236 240 240 240 240 241 242 242 242 243 243 243 245 245 245 245 245 250 250 250 250 250 250 250 250 256 256 261 261 261 262* 262 266 266 266 272 272 291 291 291 293 300 300 301 301 302 305 305 307* 307 314* 316 322 323 325 328 329 330 334 334 334 339 343 343 351 354 355 355 355 356 358 359 359 363 365 365 365 369 369 369 372 372 376 377 377 380 383 383 384 384 384 402 402 406 410 410 419 419 422 424 428 429* 429 430 430 431 431 431 431 440 440 440 441 444 444 449 450 453 455 455 455 456 456 457* 457 457 458 458 460 460 465 467 469 469 476 476 476 477 477 486* 488 489 493 494 495 495 499* 499 500* cleanup 000102 stack reference condition dcl 53 ref 108 321 code 223 based fixed bin(35,0) level 3 in structure "cseg" dcl 2-14 in procedure "tape_ansi_lrec_io_" set ref 110* 115 116 214* 323* 328 329 422* 467* code parameter fixed bin(35,0) dcl 15 in procedure "tape_ansi_lrec_io_" set ref 98 104* 116* 123* 127* 212* 213* 214 215 215* 312 317* 329* 416* 421* 422 468* 483 500* code based char(1) level 2 in structure "SCW" packed unaligned dcl 34 in procedure "tape_ansi_lrec_io_" set ref 194 194 269 280 386* 387* 392* 395* complete 000000 constant char(1) initial level 2 dcl 76 ref 194 386 conversion 000110 stack reference condition dcl 53 ref 169 171 267 271 cseg based structure level 1 unaligned dcl 2-14 csw 000120 automatic bit(1) initial unaligned dcl 56 set ref 56* 423 461 487* cwl 000132 automatic picture(4) unaligned dcl 56 set ref 370* 371 400* 401 data based char unaligned dcl 31 set ref 130* 130 293* 293 294* 294* 441* 441 442* 442* data_len 000131 automatic fixed bin(17,0) initial dcl 56 set ref 56* 170* 172 173 179 187 187 268* 270 273 362* 363 365 370 399* 400 405 decimal builtin function dcl 50 ref 370 400 dwP 000134 automatic pointer dcl 71 set ref 168* 170 194 194 266* 268 269 280 369* 371 384* 386 387 392 395 401 ebcdic constant fixed bin(17,0) initial dcl 84 ref 293 441 ebcdic_to_ascii_ 000030 constant entry external dcl 87 ref 294 ecode 000130 automatic fixed bin(35,0) initial dcl 56 set ref 56* 207* 213 222* 223 224 225* 226 230 237* 335* 336 421 457* 458 459 463* 464 467 error_table_$eof_record 000024 external static fixed bin(35,0) dcl 40 ref 224 error_table_$eov_on_write 000010 external static fixed bin(35,0) dcl 40 ref 459 error_table_$fatal_error 000022 external static fixed bin(35,0) dcl 40 ref 110 237 323 error_table_$file_busy 000012 external static fixed bin(35,0) dcl 40 ref 104 317 error_table_$invalid_record_desc 000014 external static fixed bin(35,0) dcl 40 ref 207 error_table_$long_record 000016 external static fixed bin(35,0) dcl 40 ref 127 215 416 error_table_$tape_error 000020 external static fixed bin(35,0) dcl 40 ref 212 230 fcP 130 based pointer level 2 dcl 2-14 ref 138 152 153 158 235 240 240 241 242 242 243 243 250 250 250 250 293 302 305 305 339 343 343 351 354 356 358 359 363 365 365 376 377 380 383 406 410 430 441 465 495 fd based structure level 1 dcl 3-3 file_lock 220 based bit(1) level 3 dcl 2-14 set ref 102 109* 112* 117* 134* 217* 316 322* 325* 330* 424* final 3 000000 constant char(1) initial level 2 dcl 76 ref 194 280 387 first_span 000133 automatic bit(1) initial unaligned dcl 56 set ref 56* 386 391 393* fl based structure level 1 dcl 4-3 flP 132 based pointer level 2 dcl 2-14 ref 334 format 45 based fixed bin(17,0) level 3 dcl 3-3 ref 138 241 302 305 339 465 fromP 000136 automatic pointer dcl 71 set ref 291* 293 294 439* 441 442 hdr2 45 based structure level 2 dcl 3-3 i 000116 automatic fixed bin(17,0) dcl 56 set ref 242* 249 initial 1 000000 constant char(1) initial level 2 dcl 76 ref 392 iocb based structure level 1 dcl 1-4 iocbP parameter pointer dcl 15 set ref 98 100 225* 312 314 335* 463* j 000117 automatic fixed bin(17,0) dcl 56 set ref 243* 244 245 245 245 249* 250* left 000123 automatic fixed bin(21,0) dcl 56 set ref 185* 187 190 193* 193 199 382* 385 388 398* 398 412 465 length 0(09) based char(4) level 2 packed unaligned dcl 34 set ref 268 401* long_record 000124 automatic bit(1) initial unaligned dcl 56 set ref 56* 143* 155* 175* 189* 204* 215 lrec 212 based structure level 2 unaligned dcl 2-14 medial 2 000000 constant char(1) initial level 2 dcl 76 ref 395 mod builtin function dcl 50 ref 243 453 mode 63 based fixed bin(17,0) level 3 dcl 3-3 ref 293 441 move 000122 automatic fixed bin(17,0) initial dcl 56 set ref 56* 124* 128* 130 130 131 141* 142 144* 152* 153* 154 156* 173* 174 176* 187* 190* 193 290 293 293 294 294 294 294 295 345* 353* 374* 388* 396* 398 399 403 438 441 441 442 442 442 442 443 nbuf 264 based fixed bin(17,0) level 3 dcl 2-14 ref 476 nc_buf 214 based fixed bin(17,0) level 3 dcl 2-14 set ref 222* 236 240 240* 242 243 245 245* 245 250* 250 256 301 null builtin function dcl 50 ref 221 428 489 493 offset 215 based fixed bin(17,0) level 3 dcl 2-14 set ref 164 168 178* 178 235* 236 256 261 266 272* 272 291 300* 300 301 355 359 365 369 372* 372 377 383 384 402* 402 410 430* 431 431 440 444* 444 449 450 453 455 456* 456 457* 494 495 open_mode 176 based fixed bin(17,0) level 2 dcl 2-14 ref 488 parity_error 000125 automatic bit(1) initial unaligned dcl 56 set ref 56* 212 230* pos based fixed bin(17,0) array level 4 packed unaligned dcl 2-14 ref 334 position based structure array level 3 packed unaligned dcl 2-14 read_length 224 based structure level 2 unaligned dcl 2-14 rec_len parameter fixed bin(21,0) dcl 15 set ref 98 103* 131* 216* reccnt 222 based fixed bin(35,0) level 3 dcl 2-14 set ref 133* 133 210* 210 419* 419 469* 469 477* 477 reclen 47 based fixed bin(21,0) level 3 dcl 3-3 ref 152 153 158 242 243 250 250 250 305 351 354 356 363 380 remain 000127 automatic fixed bin(17,0) dcl 56 set ref 141 146 152 152 172 256* 270 301* 302 304 305 354* 355 355 383* 385 396 405* 405 407 410* 450* 453* 454 455 455 456 req_off 000126 automatic fixed bin(17,0) dcl 56 set ref 146* 158* 179* 273* 300 346* 356* 373* 403* 444 rlN 226 based fixed bin(21,0) level 3 dcl 2-14 set ref 121 122 124 132* rlP 224 based pointer level 3 dcl 2-14 ref 130 scw 000000 constant structure level 1 dcl 76 soft_status 264 based structure level 2 unaligned dcl 2-14 substr builtin function dcl 50 set ref 164 168 245 250 261 266 291 292 355* 369 384 431* 439 440 455* 455 tape_ansi_file_cntl_$data_eof 000032 constant entry external dcl 87 ref 225 tape_ansi_file_cntl_$data_eot 000034 constant entry external dcl 87 ref 463 tape_ansi_file_cntl_$position_for_output 000036 constant entry external dcl 87 ref 335 tape_ansi_tape_io_$close 000040 constant entry external dcl 87 ref 500 tape_ansi_tape_io_$get_buffer 000042 constant entry external dcl 87 ref 429 tape_ansi_tape_io_$read 000044 constant entry external dcl 87 ref 222 tape_ansi_tape_io_$release_buffer 000046 constant entry external dcl 87 ref 165 262 307 499 tape_ansi_tape_io_$write 000050 constant entry external dcl 87 ref 457 toP 000140 automatic pointer dcl 71 set ref 292* 293 294 440* 441 442 total 000121 automatic fixed bin(21,0) initial dcl 56 set ref 56* 216 292 295* 295 439 443* 443 ub based char unaligned dcl 37 set ref 292 439 ubP parameter pointer dcl 15 ref 98 130 292 312 439 verify builtin function dcl 50 ref 245 250 vl based structure array level 2 unaligned dcl 2-14 vlX 5 based fixed bin(17,0) initial level 2 dcl 4-3 ref 334 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. cseg_tseg_version_2 internal static fixed bin(17,0) initial dcl 2-12 iox_$iocb_version_sentinel external static char(4) dcl 1-43 NAMES DECLARED BY EXPLICIT CONTEXT. c_exit 001226 constant label dcl 500 ref 423 490 493 497 ck_dw 001465 constant label dcl 261 ref 264 close 001150 constant entry external dcl 483 close2 001212 constant label dcl 499 ref 489 494 495 get_buf 001770 constant entry internal dcl 427 ref 344 352 364 367 381 409 get_record 001241 constant entry internal dcl 220 ref 140 151 163 184 200 263 278 inv_desc 000444 constant label dcl 207 ref 169 172 267 269 270 move_nothing 002101 constant label dcl 444 ref 438 move_to_buf 002024 constant entry internal dcl 437 ref 347 357 375 404 move_to_user 001643 constant entry internal dcl 288 ref 147 159 180 192 out 001452 constant label dcl 256 ref 245 250 process_sw 001460 constant entry internal dcl 260 ref 186 279 r_count 000450 constant label dcl 210 ref 149 161 182 196 205 r_exit 000455 constant label dcl 212 ref 208 227 230 238 r_format 000004 constant label array(4) dcl 140 ref 138 166 r_sw_check 000375 constant label dcl 186 ref 201 read_record 000060 constant entry external dcl 98 read_release 001722 constant entry internal dcl 299 ref 148 160 181 195 198 281 284 release_it 001753 constant label dcl 307 ref 302 restart 001254 constant label dcl 222 ref 226 s_get 001622 constant label dcl 278 ref 285 skip_segments 001621 constant entry internal dcl 277 ref 203 tape_ansi_lrec_io_ 000044 constant entry external dcl 13 w_count 001126 constant label dcl 419 ref 349 360 378 413 w_exit 001133 constant label dcl 421 ref 336 465 478 w_exit1 001141 constant label dcl 424 ref 417 470 w_fit_check 001011 constant label dcl 384 ref 412 w_format 000010 constant label array(4) dcl 343 ref 339 w_long 001122 constant label dcl 416 ref 343 351 363 380 w_mod 002116 constant label dcl 453 w_now 001110 constant label dcl 408 ref 406 w_pad 002126 constant label dcl 455 ref 451 w_put 002134 constant label dcl 457 ref 454 write_buf 002105 constant entry internal dcl 448 ref 348 358 359 366 376 377 408 496 write_record 000511 constant entry external dcl 312 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2564 2636 2254 2574 Length 3144 2254 52 271 310 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME tape_ansi_lrec_io_ 364 external procedure is an external procedure. on unit on line 108 64 on unit on unit on line 169 64 on unit get_record 75 internal procedure is called by several nonquick procedures. process_sw 242 internal procedure enables or reverts conditions. on unit on line 267 64 on unit skip_segments internal procedure shares stack frame of external procedure tape_ansi_lrec_io_. move_to_user internal procedure shares stack frame of external procedure tape_ansi_lrec_io_. read_release internal procedure shares stack frame of external procedure tape_ansi_lrec_io_. on unit on line 321 64 on unit get_buf internal procedure shares stack frame of external procedure tape_ansi_lrec_io_. move_to_buf internal procedure shares stack frame of external procedure tape_ansi_lrec_io_. write_buf internal procedure shares stack frame of external procedure tape_ansi_lrec_io_. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME tape_ansi_lrec_io_ 000100 cP tape_ansi_lrec_io_ 000116 i tape_ansi_lrec_io_ 000117 j tape_ansi_lrec_io_ 000120 csw tape_ansi_lrec_io_ 000121 total tape_ansi_lrec_io_ 000122 move tape_ansi_lrec_io_ 000123 left tape_ansi_lrec_io_ 000124 long_record tape_ansi_lrec_io_ 000125 parity_error tape_ansi_lrec_io_ 000126 req_off tape_ansi_lrec_io_ 000127 remain tape_ansi_lrec_io_ 000130 ecode tape_ansi_lrec_io_ 000131 data_len tape_ansi_lrec_io_ 000132 cwl tape_ansi_lrec_io_ 000133 first_span tape_ansi_lrec_io_ 000134 dwP tape_ansi_lrec_io_ 000136 fromP tape_ansi_lrec_io_ 000140 toP tape_ansi_lrec_io_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out call_int_this call_int_other return tra_ext mod_fx1 enable ext_entry int_entry trunc_fx2 any_to_any_tr divide_fx1 THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. ascii_to_ebcdic_ ebcdic_to_ascii_ tape_ansi_file_cntl_$data_eof tape_ansi_file_cntl_$data_eot tape_ansi_file_cntl_$position_for_output tape_ansi_tape_io_$close tape_ansi_tape_io_$get_buffer tape_ansi_tape_io_$read tape_ansi_tape_io_$release_buffer tape_ansi_tape_io_$write THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$eof_record error_table_$eov_on_write error_table_$fatal_error error_table_$file_busy error_table_$invalid_record_desc error_table_$long_record error_table_$tape_error LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 56 000030 13 000043 98 000052 100 000071 102 000077 103 000101 104 000102 105 000105 108 000106 109 000122 110 000125 111 000127 112 000130 115 000133 116 000135 117 000136 118 000137 121 000140 122 000143 123 000146 124 000147 125 000150 127 000151 128 000154 130 000156 131 000164 132 000165 133 000167 134 000173 135 000174 138 000175 140 000200 141 000204 142 000206 143 000211 144 000213 146 000215 147 000217 148 000220 149 000221 151 000222 152 000226 153 000236 154 000237 155 000242 156 000244 158 000246 159 000250 160 000251 161 000252 163 000253 164 000257 165 000266 166 000302 168 000303 169 000306 170 000325 171 000340 172 000341 173 000345 174 000347 175 000352 176 000354 178 000356 179 000361 180 000363 181 000364 182 000365 184 000366 185 000372 186 000375 187 000401 189 000407 190 000411 192 000412 193 000413 194 000415 195 000426 196 000427 198 000430 199 000431 200 000433 201 000437 203 000440 204 000441 205 000443 207 000444 208 000447 210 000450 212 000455 213 000463 214 000465 215 000470 216 000477 217 000502 218 000503 312 000504 314 000522 316 000530 317 000532 318 000535 321 000536 322 000552 323 000555 324 000557 325 000560 328 000563 329 000565 330 000566 331 000567 334 000570 335 000611 336 000623 339 000625 343 000631 344 000636 345 000637 346 000642 347 000643 348 000644 349 000645 351 000646 352 000652 353 000653 354 000656 355 000663 356 000673 357 000675 358 000676 359 000704 360 000710 362 000711 363 000715 364 000717 365 000720 366 000730 367 000731 369 000732 370 000737 371 000746 372 000751 373 000753 374 000756 375 000757 376 000760 377 000766 378 000773 380 000774 381 001000 382 001001 383 001004 384 001011 385 001016 386 001022 387 001030 388 001033 389 001035 391 001036 392 001040 393 001043 394 001044 395 001045 396 001050 398 001053 399 001055 400 001060 401 001067 402 001072 403 001074 404 001076 405 001077 406 001101 407 001105 408 001110 409 001111 410 001112 412 001117 413 001121 416 001122 417 001125 419 001126 421 001133 422 001135 423 001137 424 001141 425 001143 483 001144 486 001161 487 001165 488 001167 489 001172 490 001176 493 001177 494 001203 495 001205 496 001210 497 001211 499 001212 500 001226 501 001237 220 001240 221 001246 222 001254 223 001273 224 001276 225 001301 226 001312 227 001315 230 001320 234 001330 235 001335 236 001340 237 001343 238 001346 240 001351 241 001356 242 001361 243 001372 244 001375 245 001376 249 001416 250 001424 253 001447 256 001452 257 001456 260 001457 261 001465 262 001475 263 001511 264 001516 266 001517 267 001522 268 001541 269 001560 270 001601 271 001611 272 001612 273 001616 274 001620 277 001621 278 001622 279 001626 280 001632 281 001637 282 001640 284 001641 285 001642 288 001643 290 001644 291 001647 292 001654 293 001662 294 001674 295 001717 296 001721 299 001722 300 001723 301 001726 302 001731 303 001740 304 001741 305 001744 307 001753 309 001767 427 001770 428 001771 429 001776 430 002012 431 002016 433 002023 437 002024 438 002025 439 002027 440 002035 441 002042 442 002054 443 002077 444 002101 445 002104 448 002105 449 002106 450 002112 451 002115 453 002116 454 002124 455 002126 456 002133 457 002134 458 002151 459 002161 460 002164 461 002171 463 002174 464 002205 465 002207 467 002216 468 002220 469 002221 470 002225 474 002226 476 002227 477 002237 478 002241 480 002242 ----------------------------------------------------------- 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