1 2 /* 3 4 Th procedure cobol_delete_gen.pl1 generates the code which 5 realizes the COBOL delete statement. 6 7 DELETE fn eos 8 9 eos b=0 no INVALID 10 1 INVALID 11 12 f=00 no NOT 13 01 NOT 14 15 mp.n 3 16 mp.ptr(1) type-1("OPEN") 17 mp.ptr(2) type-12(file-name) 18 mp.ptr(3) eos 19 20 Flow Chart 21 22 TAG(ioerror.retry_tag): 23 24 OP56(init_delete,unopen_gen_tag);GEN_IOERROR 25 26 TAG(unopen_gen_tag) 27 28 alt_sw = file_organization = 3 ind 29 & 30 file_table.alternate_keys ^= 0 31 32 if file_table.access < 2 seq 33 then do; INCR_NTAG 34 OP54(delete_error,ntag);GEN_IOERROR 35 36 TAG(ntag): 37 38 CALL DEL_OP; 39 40 end; 41 else do; if file_table.organization = 2 ind 42 then; 43 else 44 if file_table.access = 3 dyn 45 & 46 ( file_table.external 47 | 48 file_table.open_out 49 ) 50 then do; INCR_NTAG 51 OP54(delete_error,ntag);GEN_IOERROR 52 53 TAG(ntag): 54 55 end; 56 57 58 if ^alt_sw 59 & 60 file_table.access = 3 dyn 61 & 62 file_table.read_next 63 64 then do; INCR_NTAG 65 66 OP55(read_key,ntag);GEN_IOERROR 67 68 69 TAG(ntag): 70 71 INCR_NTAG 72 73 OP57(special_delete,ntag);GEN_IOERROR 74 75 TAG(ntag): 76 77 end; 78 else do; INCR_NTAG 79 80 if alt_sw then IO_UTIL$FILE_DESC;OP85(alt_special_delete,0);SET_FSBPTR 81 OP41(seek_key,ntag);GEN_IOERROR 82 83 CALL DEL_OP; 84 end; 85 end; 86 87 return; 88 89 DEL_OP: 90 91 if alt_sw 92 then do; INCR_NTAG 93 OP87(alt_rew_del,ntag);GEN_IOERROR 94 TAG(ntag): 95 SET_FSBPTR 96 end; 97 98 INCR_NTAG 99 OP53(delete,delete_tag);GEN_IOERROR 100 101 TAG(delete_tag): 102 103 if alt_sw then OP86(alt_delete,0) 104 105 end; 106 107 */ 108 109 %include cobol_opr_delete; 110