📄 in6.cbl
字号:
000016 DECLARATIVES. s1 section.000017 USE AFTER ERROR PROCEDURE ON FILE-1. 93.07.07000018 MOVE 100 TO FIELD-A. 93.07.07 s2 section.000019 USE AFTER EXCEPTION PROCEDURE ON I-O. 93.07.07000020 DISPLAY 'GIVE UP' 93.07.07000021 PERFORM EOJ. 93.07.07 s3 section.000019 USE global AFTER standard ERROR PROCEDURE ON f1 f2 f3 giving d1 d2. s4 section.000019 USE AFTER standard ending file label PROCEDURE ON f1 f2 f3. s5 section. use for debugging on a all references of b all procedures.000022 END DECLARATIVES. 94.10.19000023 93.07.07 GO TO X1. P0. CLOSE a d b. S1 SECTION. cancel d f b. P1. ALTER a to b. P2. EXIT. S2 SECTION. * IF m GO TO S2. ALTER a to b ALTER a to b. ALTER a to b EXIT. if a then commit. if a then exit. if a commit exit exhibit named i. if a then commit else exit. if a then commit else exec sql 'm' end-exec. if a then next sentence else next sentence. if a then next sentence if b then exit end-if next sentence else next sentence if b then exit else commit end-if next sentence end-if. S3 SECTION. accept i accept i end-accept accept i on exception commit stop run end-accept add a to b add a to b size error exit not size error exit. chain i call a call a end-call call b not on exception commit end-call call b not on exception commit . compute x = 7 compute x = 7 size error cancel j end-compute compute x = 7 size error continue . delete f delete d invalid continue end-delete display y display z exception move a to b end-display divide a into b divide a by c giving d on size error alter a to b end-divide evaluate a when 1 exit when 2 add a to b when other goback end-evaluate multiply a by b multiply a by c not on size error open input f end-multiply on a move b to c on a move b to c else next sentence . perform m perform m 3 times perform m until c perform m until exit perform m varying i from 1 by 1 until i = 10 perform open input f perform 4 times open input f perform until c open input f perform until exit open input f perform varying i from 1 by 1 until i = 10 open input f . read f read f end purge c . receive m message into i receive m message into i data release r . return a end rollback return a end rollback not end send s from t end-return . rewrite r rewrite r invalid continue end-rewrite . search i when c next sentence search i end commit when c next sentence end-search . start f start f invalid exit end-start . stop run . string i delimited by size into j string i delimited by size into j overflow stop run end-string . subtract i from j subtract i from j size error suppress end-subtract . unstring i into j unstring i into j overflow stop run end-unstring . write r write r eop continue end-write write r eop continue . S4 SECTION. accept nn with auto bell beep add a b c to x y z add a b c to d giving x y z rounded alter a to b c to d e to f call p using a b c by reference d e f by content 6 77 888 by value i j k by value 6 77 988 chain p using a b c by reference d e f address of d e f by content 6 77 888 close f lock g disp h compute a b c rounded = 1 + z delete file f g h display a b c with no advancing display a line 1 col 2 with bell beep blink divide a into x y z divide a into d giving x y z rounded divide a by d giving x y z rounded entry a using i j k by reference d e f by value i j k evaluate i also j also k when 1 also '2' also v3 when 4 also '5' also v6 go to p q r depending on x if x then initialize a b c replacing national data by x numeric data by x alphabetic data by x initiate r s t else inspect i tallying j for characters before k after m all k before k after m j before k after m i for characters before k after m all k before k after m j before k after m inspect i replacing characters by i before k after m leading k by n before k after m j by '2' before k after m inspect i tallying j for characters before k after m all k before k after m j before k after m i for characters before k after m all k before k after m j before k after m replacing characters by j before k after m leading k by n before k after m j by '2' before k after m inspect i converting j to k before k after m end-if when 1 also '2' also v3 merge f ascending key a1 a2 a3 descending key d1 d2 d3 using f1 f2 f3 giving g1 g2 g3 move a to b c d move corr a to b c d when other multiply 1 by x y z multiply 1 by 2 giving x y z rounded end-evaluate open input f1 f2 f3 output f1 f2 f3 i-o f1 f2 f3 extend f1 f2 f3 perform p of q thru s in t varying i from 1 by 2 until t after j from 1 by 2 until t after k from 1 by 2 until t read i at end search x when c1 exit when c2 exit when c3 exit end-search search all y when d1 = 1 and d2 = 2 and d3 = 3 sort f descending key d1 d2 d3 ascending key a1 a2 a3 using f1 f2 f3 giving g1 g2 g3 end-search end-read set a b c to on i j k to off set a b c to true i j k to false set a b c to address of i set a b c to i set a b c to '2' set a b c to NULL set address of a address of b address of c to NULLS set a b c up by j set a b c down by length of j string a b c delimited by i d e f delimited by 'j' g h i delimited by SIZE into x subtract a b 3 from x y z rounded subtract a b 3 from x giving x y z rounded terminate r1 r2 r3 unstring i delimited by all a or b or all c into x delimiter in y count in z i delimiter in j count in k write a from x of b of c (1 y z + 2) move function max (a b - 3 4) to s . end PROGRAM p. IDENTIFICATION DIVISION. PROGRAM-ID. p2 is common program comment_entry IDENTIFICATION DIVISION. PROGRAM-ID. q1 is common program comment_entry ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. PC 47.11. OBJECT-COMPUTER. SIEMENS 4.567. end PROGRAM p. IDENTIFICATION DIVISION. PROGRAM-ID. q2 is common program comment_entry ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. PC. OBJECT-COMPUTER. TR 440. end PROGRAM p. IDENTIFICATION DIVISION. PROGRAM-ID. q3 is common program comment_entry end PROGRAM p. end PROGRAM p. IDENTIFICATION DIVISION. PROGRAM-ID. p3 is common program comment_entry
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -