1 2 3 /* 4 5 The procedure cobol_write_gen.pl1 generates the code which realizes the 6 COBOL write statement. 7 8 Format 1 WRITE rn [id] [id] eos 9 10 FORMAT 2 WRITE rn [id] eos 11 12 FORMAT 3 WRITE fn id eos 13 14 eos a=000 format 1 write advancing 15 001 format 2 16 010 format 3 write report file 17 18 b=0 no EOP 19 1 EOP 20 21 c=0 no FROM 22 1 FROM 23 24 d=00 neither 25 01 BEFORE 26 10 AFTER 27 28 f=00 no NOT 29 01 NOT 30 31 mp.n 3 - 5 32 mp.ptr(1) type-1("WRITE") 33 mp.ptr(2) type-9(record-name) or type-12(file-name) 34 mp.ptr(3) type-9(from id) 35 mp.ptr(4) type-9(data-name,advancing id) 36 type-1("PAGE") 37 type-2(advancing literal) 38 type-17(mnemonic-name) 39 mp.ptr(n) eos 40 41 Flow Chart 42 43 TAG(ioerror.retry_tag): 44 45 OP39(init_write,good_tag);GEN_IOERROR 46 47 TAG(good_tag): 48 49 alt_sw = file_table.organization = 3 ind 50 & 51 file_table.alternate_keys ^= 0 52 53 if file_table.organization = 4 stream 54 | 55 file_table.device = 1 printer 56 | 57 file_table.device = 3 punch 58 59 then do; if file_table.linage 60 then OP68(write_stream_linage,stream_tag) 61 else OP40(write_stream,stream_tag) 62 63 GEN_IOERROR 64 end; 65 else do; if file_table.access < 2 seq 66 | 67 file_table.open_io 68 69 then do; INCR_NTAG 70 IO_UTIL$BYPASS_MODE_ERROR 71 TAG(ntag): 72 end; 73 74 if alt_sw 75 then do; IO_UTIL$FILE_DESC 76 OP91(alt_write_seek_key,alt_seek_tag) 77 GEN_IOERROR 78 TAG(alt_seek_tag): 79 SET_FSBPTR 80 end; 81 82 if file_table.organization ^= 1 not seq 83 then do; move key to FSB 84 if alt_sw then call EMIT_OP_91; 85 OP41(seek_key,seek_tag) 86 GEN_IOERROR 87 TAG(seek_tag): 88 end; 89 else if alt_sw then call EMIT_OP_91; 90 91 OP42(write_record,write_tag);GEN_IOERROR 92 93 TAG(write_tag): 94 95 if alt_sw then IO_UTIL$FILE_DESC;OP90(alt_add_write_keys,stream_tag);GEN_IOERROR 96 97 end; 98 99 TAG(stream_tag): 100 101 if alt_sw then SET_FSBPTR 102 103 if file_table.linage then do; INCR_NTAG(skip_tag) 104 105 TAG(skip_tag): 106 end; 107 108 EMIT_OP_91: proc; 109 110 IO_UTIL$FILE_DESC 111 COBOL_SET_PR 112 OP91(alt_write_seek_key,alt_seek_tag) 113 GEN_IOERROR 114 TAG(alt_seek_tag): 115 SET_FSBPTR 116 end; 117 118 */ 119 120 %include cobol_opr_write; 121