$set ans85 noosvs comp mf ************************************************************ * * * (C) Micro Focus Ltd. 1989 * * * * CASE.CBL * * * * This program converts the case of COBOL source code * * files in several ways, producing, for example, uppercase * * reserved words and lower case data names. * * * * Instructions for use are presented when it is first * * executed. * * * * This source file actually contains two separate * * programs, one called from the other. This type of source * * file is known as a multi-program source. Compiling this * * source file will result in the creation of two separate * * OBJs, as if two separate programs had been compiled, one * * after the other. The two OBJs will be called CASE and * * CASECONV, CASECONV taking its name from the PROGRAM-ID * * line in the second program. * * * * Compile the program and link the two OBJs created in the * * usual way. * * * ************************************************************ identification division. program-id. case. environment division. file-control. select input-file assign input-file-name organization is line sequential file status is file-status. select output-file assign output-file-name organization is line sequential file status is file-status. data division. file section. fd input-file. 01 input-record pic x(80). fd output-file. 01 output-record pic x(80). working-storage section. 01 temp-00 . 03 temp-00-0101 pic x(0078) value "Instructions for using - " the CASE utility for altering the case of COBOL source:". 03 filler pic x(0082). 03 temp-00-0301 pic x(0077) value "CASE - " ". 03 filler pic x(0086). 03 temp-00-0504 pic x(0062) value "src-file-spec: full pa - "thname and file name for the source file". 03 filler pic x(0015). 03 temp-00-0601 pic x(0065) value "target-file-spec: full - " pathname and file name for the target file". 03 filler pic x(0021). 03 temp-00-0707 pic x(0060) value "resvd-word: U means co - "nvert all reserved words to UPPER case". 03 filler pic x(0032). 03 temp-00-0819 pic x(0029) value "L means convert to LOW - "ER case". 03 filler pic x(0051). 03 temp-00-0919 pic x(0062) value "F means convert first - "character to UPPER, all others to LOWER ". 03 temp-00-1001 pic x(0062) value " data-name: U me - "ans convert all data names to UPPER case". 03 filler pic x(0036). 03 temp-00-1119 pic x(0029) value "L means convert to LOW - "ER case". 03 filler pic x(0051). 03 temp-00-1219 pic x(0062) value "F means convert first - "character to UPPER, all others to LOWER ". 03 temp-00-1301 pic x(0079) value " procedure: U me - "ans convert all procedure and section names to UPPER case". 03 filler pic x(0019). 03 temp-00-1419 pic x(0029) value "L means convert to LOW - "ER case". 03 filler pic x(0051). 03 temp-00-1519 pic x(0061) value "F means convert first - "character to UPPER, all others to LOWER". 03 filler pic x(0081). 03 temp-00-1701 pic x(0054) value "eg. CASE C:\WORK\MYPRO - "G.CBL D:\MYDIR\NEWPROG.CBL U F L". 03 filler pic x(0106). 03 temp-00-1901 pic x(0080) value "The other use of this - "utility is to convert a COBOL source file to ""SENTENCE"". - "". 03 temp-00-2001 pic x(0080) value "ie. the first characte - "r found after a period is UPPER case, all others are LOWER". 03 filler pic x(0080). 03 temp-00-2201 pic x(0050) value "eg. CASE C:\WORK\MYPRO - "G.CBL D:\MYDIR\NEWPROG.CBL S". 03 filler pic x(0030). 77 prog-line-no pic 9(6) comp. 77 prog-line-no-disp pic z(6). 77 start-ind pic 99 comp. 77 char-ind pic 99 comp. 77 buffer-char-ind pic 99 comp. 77 file-flag pic x. 88 end-of-file value "Y". 77 error-flag pic x. 88 error-found value "Y". 77 file-status pic xx. 77 input-file-name pic x(80). 77 output-file-name pic x(80). 77 q-answer pic x. 77 no-list pic x(6). 88 no-list-true value "Nolist" "NOLIST" "nolist" "NoList". 77 syntax-error pic x(80) value "Syntax error in parameters - Program Terminated". 01 out-err. 03 oe1 pic x(20) value "Target file exists:". 03 oe2 pic x(15) value "Are you sure?". 01 in-err. 03 ie1 pic x(27) value "Source file not found for:". 03 in-err-fname pic x(53). 01 dup-err. 03 de1 pic x(37) value "Source and target file are the same:". 03 dup-err-fname pic x(43). 78 upper-case value "UPPER-CASE". 78 lower-case value "lower-case". 78 first-char value "First-Character-Upper". 78 sentence-case value "Sentence-type-case". 01 final-message-1. 03 fm1 pic x(31) value " About to convert:". 03 disp-inp pic x(49). 03 fm2 pic x(31) value " to:". 03 disp-out pic x(49). 01 final-message-2-1. 03 fm3 pic x(31) value " Converting Reserved words to:". 03 res-inp pic x(49). 03 fm4 pic x(31) value " Data names to:". 03 dat-inp pic x(49). 03 fm5 pic x(31) value " Procedure names to:". 03 pro-inp pic x(49). 01 final-message-2-2. 03 fm6 pic x(31) value " Converting entire file to:". 03 fm7 pic x(49) value "Sentence case". 01 final-message-3. 03 fm8 pic x(31) value "--- No screen listing ---". 01 final-message-4. 03 fm9 pic x(31) value " Do you wish to continue ? ". 01 command-tail. 03 command-tail-char pic x occurs 81. 01 buffer-string. 03 buffer-char pic x occurs 80. 01 case-linkage. 03 case-flags. 05 lnk-reserved-case pic x. 88 lnk-reserved-case-ok value "u" "l" "f" "U" "L" "F" "S" "s". * note that the resreved case flag is also used to determine if * the conversion is to be a "sentence" type conversion. 05 lnk-data-name-case pic x. 88 lnk-data-name-case-ok value "u" "l" "f" "U" "L" "F". 05 lnk-proc-case pic x. 88 lnk-proc-case-ok value "u" "l" "f" "U" "L" "F". 03 record-area pic x(80). procedure division. runstart section. display spaces upon crt perform get-command-line if not error-found perform test-case-flags if error-found perform command-line-error else perform open-input-file if error-found perform input-file-error else display spaces upon crt perform check-output-file if not error-found open output output-file perform convert-file close input-file close output-file end-if end-if end-if end-if exit program stop run. get-command-line section. accept command-tail from command-line if command-tail = spaces perform command-line-prompt display "Enter Parameters" accept command-tail if command-tail = spaces set error-found to true display syntax-error end-if end-if if not error-found perform split-off-names if input-file-name = spaces or output-file-name = spaces or lnk-reserved-case = spaces or lnk-data-name-case = spaces or lnk-proc-case = spaces perform command-line-error else if input-file-name = output-file-name perform duplicate-file-name-error end-if end-if end-if. open-input-file section. open input input-file if file-status not = "00" set error-found to true close input-file end-if. check-output-file section. open input output-file if file-status = "00" close output-file perform check-for-overwrite end-if. convert-file section. move input-file-name to disp-inp move output-file-name to disp-out evaluate lnk-reserved-case when "U" when "u" move upper-case to res-inp when "L" when "l" move lower-case to res-inp when "F" when "f" move first-char to res-inp when "S" when "s" move sentence-case to res-inp end-evaluate evaluate lnk-data-name-case when "U" when "u" move upper-case to dat-inp when "L" when "l" move lower-case to dat-inp when "F" when "f" move first-char to dat-inp end-evaluate evaluate lnk-proc-case when "U" when "u" move upper-case to pro-inp when "L" when "l" move lower-case to pro-inp when "F" when "f" move first-char to pro-inp end-evaluate display final-message-1 at 0301 if lnk-reserved-case = "S" or "s" display final-message-2-2 at 0601 else display final-message-2-1 at 0601 end-if if no-list-true display final-message-3 at 1001 end-if display final-message-4 at 1201 move "Y" to q-answer accept q-answer at 1233 if q-answer = "y" or "Y" display "Converting - Please Wait" at 1401 perform read-input-file move 1 to prog-line-no perform until end-of-file move prog-line-no to prog-line-no-disp move input-record to record-area call "CASECONV" using case-linkage move record-area to output-record write output-record if not no-list-true move prog-line-no-disp to output-record(1:6) display output-record else display prog-line-no-disp at 1425 end-if add 1 to prog-line-no perform read-input-file end-perform display " " display " " display "Conversion complete" else set error-found to true end-if. split-off-names section. move 1 to start-ind perform find-leading-spaces perform get-input-file-name perform find-leading-spaces perform get-output-file-name perform find-leading-spaces perform get-reserved-flag if lnk-reserved-case = "S" or "s" move "S" to lnk-data-name-case move "S" to lnk-proc-case else perform find-leading-spaces perform get-data-name-flag perform find-leading-spaces perform get-proc-name-flag end-if perform find-leading-spaces perform get-nolist-flag. find-leading-spaces section. perform varying char-ind from start-ind by 1 until (char-ind > 80) or not (command-tail-char(char-ind) = (spaces or ",")) end-perform move char-ind to start-ind. get-input-file-name section. move spaces to buffer-string move 1 to buffer-char-ind perform varying char-ind from start-ind by 1 until char-ind > 80 or command-tail-char(char-ind) = spaces move command-tail-char(char-ind) to buffer-char(buffer-char-ind) add 1 to buffer-char-ind end-perform move buffer-string to input-file-name move char-ind to start-ind. get-output-file-name section. move spaces to buffer-string move 1 to buffer-char-ind perform varying char-ind from start-ind by 1 until char-ind > 80 or command-tail-char(char-ind) = spaces move command-tail-char(char-ind) to buffer-char(buffer-char-ind) add 1 to buffer-char-ind end-perform move buffer-string to output-file-name move char-ind to start-ind. get-reserved-flag section. if start-ind < 80 move command-tail-char(start-ind) to lnk-reserved-case add 1 to start-ind end-if. get-data-name-flag section. if start-ind < 80 move command-tail-char(start-ind) to lnk-data-name-case add 1 to start-ind end-if. get-proc-name-flag section. if start-ind < 80 move command-tail-char(start-ind) to lnk-proc-case add 1 to start-ind end-if. get-nolist-flag section. move spaces to buffer-string move 1 to buffer-char-ind perform varying char-ind from start-ind by 1 until char-ind > 80 or command-tail-char(char-ind) = spaces move command-tail-char(char-ind) to buffer-char(buffer-char-ind) add 1 to buffer-char-ind end-perform move buffer-string to no-list. check-for-overwrite section. display out-err at 0101 move "Y" to q-answer accept q-answer at 0137 if q-answer = "y" or "Y" next sentence else set error-found to true end-if. input-file-error section. set error-found to true move input-file-name to in-err-fname display in-err. command-line-error section. perform command-line-prompt display syntax-error set error-found to true. command-line-prompt section. display temp-00. duplicate-file-name-error section. move input-file-name to dup-err-fname set error-found to true display dup-err. read-input-file section. read input-file at end set end-of-file to true end-read. test-case-flags section. if lnk-reserved-case = "S" or "s" next sentence else if lnk-reserved-case-ok and lnk-data-name-case-ok and lnk-proc-case-ok next sentence else set error-found to true end-if end-if. end program case. identification division. program-id. caseconv. *************************************************************** * This program accepts one 80 character line of COBOL code in its * linkage section. This line of code is returned to the calling * program with the line of code changed according to the * following rules: * * There are 3 parameters passed in linkage section: * * lnk-reserved-case can have values U, L and F * lnk-data-name-case can have values U, L and F * lnk-proc-case can have values U, L and F * * the first parameter controls the case of reserved words * the second parameter controls the case of data names * the third parameter controls the procedure and section names * * All the above can be independantly changed so that they are * in: * * UPPER-CASE * lower-case or * First-Character-Upper-Case * * according to the respective value of the parameter * * One additional function of this program is controlled by * passing the value "S" in lnk-reserved-case. In this case, the * other parameters are ignored and the entire line is converted * so that the case is made "Sentence like". ie. the first * alphabetic character found after a period is capitalised. *************************************************************** working-storage section. 01 temp-char pic x. 01 temp-char-9 redefines temp-char pic 99 comp. * This next variable, and its associated 88 is used to determine * whether to capitalize the next character in the case of "F" * type conversion. The setting in the 88 is to capitalize after * a space, a hyphen etc. This can be changed to suit your * requirements. 01 prev-char pic x. 88 prev-char-separator value "(" ":" "-" space "0" thru "9". 77 ind-1 pic 9(4) comp. 77 ind-2 pic 9(4) comp. 78 editfun value x"bb". 78 spacebreak value x"c5". 78 yes value 1. 78 nay value 0. 01 literal pic 99 comp value zero. 01 reserved pic 99 comp value zero. 01 new-sentence-expected pic 99 comp value 1. 01 start-of-sentence pic 99 comp value 1. 01 perf-name-expected pic 99 comp value zero. 01 alt1-name-expected pic 99 comp value zero. 01 alt2-name-expected pic 99 comp value zero. 01 go-name-expected pic 99 comp value zero. 01 pic-name-expected pic 99 comp value zero. 01 sub pic 99 comp value zero. 01 start-sub pic 99 comp value zero. 01 end-sub pic 99 comp value zero. 01 res-sub pic 99 comp value zero. 01 res-len pic 99 comp value zero. 01 res-word-buffer. 02 res-word-buffer-char pic x occurs 65. 01 filler redefines res-word-buffer. 02 res19. 03 res18. 04 res17. 05 res16. 06 res15. 07 res14. 08 res13. 09 res12. 10 res11. 11 res10. 12 res09. 13 res08. 14 res07. 15 res06. 16 res05. 17 res04. 18 res03. 19 res02 pic xx. 19 filler pic x. 18 filler pic x. 17 filler pic x. 16 filler pic x. 15 filler pic x. 14 filler pic x. 13 filler pic x. 12 filler pic x. 11 filler pic x. 10 filler pic x. 09 filler pic x. 08 filler pic x. 07 filler pic x. 06 filler pic x. 05 filler pic x. 04 filler pic x. 03 filler pic x. 02 filler pic x(46). 01 char-to-bin. 02 char pic x. 01 char9 redefines char-to-bin pic 99 comp. 01 ulcase pic 99 comp value 0. 01 locase pic 99 comp value 1. 01 editstart pic 9(4) comp value zero. 01 templen pic 9(4) comp value zero. 01 editlen pic 9(4) comp value zero. 01 editfunction pic 9(4) comp value 0. *list of no of reserved words for ANS85 78 res-word-count-2 value 24. 78 res-word-count-3 value 24. 78 res-word-count-4 value 51. 78 res-word-count-5 value 43. 78 res-word-count-6 value 48. 78 res-word-count-7 value 41. 78 res-word-count-8 value 40. 78 res-word-count-9 value 23. 78 res-word-count-10 value 23. 78 res-word-count-11 value 17. 78 res-word-count-12 value 15. 78 res-word-count-13 value 9. 78 res-word-count-14 value 6. 78 res-word-count-15 value 4. 78 res-word-count-16 value 2. 78 res-word-count-19 value 1. 01 r2tab pic x(48) value "ATBYCDFDGOIDIFINISNOOFONORRDSDTOUPCF -"CHDEPFPHRFRH". 01 filler redefines r2tab. 02 r2entry pic xx occurs res-word-count-2. 01 r3tab pic x(72) value "ADDALLANDARECRTDAYEGIEMIENDEOPESIFOR -"KEYNOTOFFPICRUNSETTABTOPUSEI-OSUMANY". 01 filler redefines r3tab. 02 r3entry pic xxx occurs res-word-count-3. 01 r4tab. 02 filler pic x(128) value "ALSOAREACALLCOMPCOPYCORRDATADATEDOWN -"ELSEEXITFILEFROMINTOJUSTKEPTLEFTLESSLINEMODEMOVENEXTOPENPAGEREAD -"REELSAMESENDSIGNSIZESORTSTOP". 02 filler pic x(76) value -"TAPETEXTTHANTHENTHRUTIMETYPEUNITUPONWHENWITHZEROSYNCCODELASTPLUS -"TESTTHENTRUE". 01 filler redefines r4tab. 02 r4entry pic x(4) occurs res-word-count-4. 01 r5tab. 02 filler pic x(128) value "AFTERALTERAREASBLANKBLOCKCLOSECOBOLC -"OMMACOUNTEQUALERROREVERYFIRSTINDEXINPUTLABELLIMITLINESMERGEQUEUE -"QUOTERERUNSPACESTARTSYSINTAB". 02 filler pic x(87) value -"LETIMESUNTILUSAGEUSINGVALUEWORDSWRITEZEROSENTERRIGHTFINALGROUPRE -"SETCLASSORDEROTHERPURGE". 01 filler redefines r5tab. 02 r5entry pic x(5) occurs res-word-count-5. 01 r6tab. 02 filler pic x(128) value "ACCEPTACCESSASSIGNAUTHORBEFOREBOTTOM -"CANCELCOMMITCOMP-3CURSORDELETEDIVIDEENABLEEXTENDFILLERGIVINGLENG -"THLIMITSLINAGEMANUALMEMORYNA". 02 filler pic x(124) value -"TIVEOCCURSOUTPUTQUOTESRANDOMRECORDRETURNREWINDSEARCHSELECTSOURCE -"SPACESSTATUSSTRINGSWITCHSYSOUTUNLOCKVALUESZEROESCOMP-3COLUMN". 02 filler pic x(42) value -"DETAILREPORTNUMBERBINARYCOMMONEND-IFGLOBAL". 01 filler redefines r6tab. 02 r6entry pic x(6) occurs res-word-count-6. 01 r7tab. 02 filler pic x(128) value "COMPUTECONSOLEDISABLEDISPLAYDYNAMICF -"OOTINGGREATERINDEXEDINSPECTINVALIDLEADINGLINKAGEMESSAGEMODULESNU -"MERICOMITTEDPERFORMPICTUREPO". 02 filler pic x(124) value -"INTERPROCEEDPROGRAMRECEIVERECORDSRELEASEREMOVALRENAMESRESERVEREW -"RITEROUNDEDSECTIONSEGMENTTHROUGHVARYINGINITIALCONTROLHEADING". 02 filler pic x(35) value -"REPORTSCONTENTEND-ADDPADDINGREPLACE". 01 filler redefines r7tab. 02 r7entry pic x(7) occurs res-word-count-7. 01 r8tab. 02 filler pic x(128) value "CODE-SETCONTAINSCURRENCYDIVISIONEXCE -"SS-3FORMFEEDJAPANESEMULTIPLEMULTIPLYNEGATIVEOPTIONALOVERFLOWPOSI -"TIONPOSITIVEREVERSEDROLLBACK". 02 filler pic x(128) value -"SENTENCESEPARATESEQUENCESTANDARDSUBTRACTSYMBOLICTALLYINGTERMINAL -"TRAILINGUNSTRINGCONTROLSGENERATEINDICATEINITIATEPRINTINGSUPPRESS -"". 02 filler pic x(64) value -"RELATIVESECURITYALPHABETCONTINUEEND-READEVALUATEEXTERNALEND-CALL -"". 01 filler redefines r8tab. 02 r8entry pic x(8) occurs res-word-count-8. 01 r9tab. 02 filler pic x(126) value "ADVANCINGAUTOMATICCHARACTERCRT-UNDER -"DEBUGGINGDELIMITEDDELIMITERDEPENDINGEXCEPTIONEXCLUSIVEJUSTIFIEDP -"ROCEDUREREDEFINESREMAINDER". 02 filler pic x(81) value -"REPLACINGREPORTINGTERMINATEASCENDINGALTERNATECOLLATINGEND-STARTE -"ND-WRITEREFERENCE". 01 filler redefines r9tab. 02 r9entry pic x(9) occurs res-word-count-9. 01 r10tab. 02 filler pic x(090) value "ALPHABETICAREA-VALUECHARACTERSDUPLIC -"ATESPROCEDURESREFERENCESSEQUENTIALSORT-MERGESTANDARD-1". 02 filler pic x(060) value "DEBUG-ITEMDEBUG-LINEDEBUG-NAMEHIGH-V -"ALUEPROGRAM-IDDESCENDING". 02 filler pic x(080) value "CONVERTINGEND-DELETEEND-RETURNEND-SE -"ARCHEND-STRINGINITIALIZESTANDARD-2END-DIVIDE". 01 filler redefines r10tab. 02 r10entry pic x(10) occurs res-word-count-10. 01 r11tab. 02 filler pic x(088) value "CLOCK-UNITSDEBUG-SUB-1DEBUG-SUB-2DEB -"UG-SUB-3DESTINATIONEND-OF-PAGEENVIRONMENTHIGH-VALUES". 02 filler pic x(033) value "SUB-QUEUE-1SUB-QUEUE-2SUB-QUEUE-3". 02 filler pic x(011) value "I-O-CONTROL". 02 filler pic x(055) value "DAY-OF-WEEKEND-COMPUTEEND-PERFORMEND-RECEIVEEND-REWRITE". 01 filler redefines r11tab. 02 r11entry pic x(11) occurs res-word-count-11. 01 r12tab. 02 filler pic x(084) value "COMMAND-LINEDATE-WRITTENDECLARATIVES -"FILE-CONTROLINPUT-OUTPUTINSTALLATIONORGANIZATION". 02 filler pic x(096) value "SYNCHRONIZEDLINE-COUNTERPAGE-COUNTER -"ALPHANUMERICEND-EVALUATEEND-MULTIPLYEND-SUBTRACTEND-UNSTRING". 01 filler redefines r12tab. 02 r12entry pic x(12) occurs res-word-count-12. 01 r13tab. 02 filler pic x(078) value "COMMUNICATIONCOMPUTATIONALCONFIGURAT -"IONCORRESPONDINGDATE-COMPILEDDECIMAL-POINT". 02 filler pic x(039) value "LOCKLOW-VALUESEGMENT-LIMITSPECIAL-NA -"MES". 01 filler redefines r13tab. 02 r13entry pic x(13) occurs res-word-count-13. 01 r14tab. 02 filler pic x(084) value "DEBUG-CONTENTSIDENTIFICATIONLINAGE-C -"OUNTERLOCKLOW-VALUESNUMERIC-EDITEDPACKED-DECIMAL". 01 filler redefines r14tab. 02 r14entry pic x(14) occurs res-word-count-14. 01 r15tab. 02 filler pic x(060) value "COMPUTATIONAL-3OBJECT-COMPUTERSOURCE -"-COMPUTERWORKING-STORAGE". 01 filler redefines r15tab. 02 r15entry pic x(15) occurs res-word-count-15. 01 r16tab. 02 filler pic x(032) value "ALPHABETIC-LOWERALPHABETIC-UPPER". 01 filler redefines r16tab. 02 r16entry pic x(16) occurs res-word-count-16. 01 r19tab. 02 filler pic x(019) value "ALPHANUMERIC-EDITED". 01 filler redefines r19tab. 02 r19entry pic x(19) occurs res-word-count-19. 01 ws-case-linkage. 03 ws-case-flags. 05 def-reserved-case pic x. 05 def-sentence-case redefines def-reserved-case pic x. 05 def-data-name-case pic x. 05 def-proc-case pic x. 03 so-rec. 05 so-rec-chr pic x occurs 80. linkage section. 01 case-linkage. 03 case-flags. 05 lnk-reserved-case pic x. 05 lnk-data-name-case pic x. 05 lnk-proc-case pic x. 03 record-area pic x(80). procedure division using case-linkage. main-prog section. move case-linkage to ws-case-linkage. if ws-case-flags = spaces or so-rec = spaces next sentence else perform case move ws-case-linkage to case-linkage. exit program. stop run. case section. move nay to perf-name-expected. move nay to alt1-name-expected. move nay to alt2-name-expected. move nay to go-name-expected. move nay to pic-name-expected. move nay to literal. case1. move 8 to start-sub. if so-rec-chr(7) = "*" go to case-end. case2. if new-sentence-expected = 1 move 1 to start-of-sentence else move 0 to start-of-sentence. perform next-word. if start-sub > 72 go to case-end. if literal = yes move end-sub to start-sub go to case2. move start-sub to sub. if reserved = yes if def-reserved-case = "N" move end-sub to start-sub go to case2. if pic-name-expected = yes go to case3. if reserved = nay go to case4. case3. move res-len to editlen. move sub to editstart. if def-sentence-case = "S" or "s" perform convert-to-sentence else if def-reserved-case = "F" or "f" perform convert-to-first else if def-reserved-case = "U" or "u" perform convert-to-upper else if def-reserved-case = "L" or "l" perform convert-to-lower. move end-sub to start-sub. go to case2. case4. if start-sub = 8 go to case6. if perf-name-expected = yes go to case6. if alt1-name-expected = yes go to case6. if alt2-name-expected = yes go to case6. if go-name-expected = yes go to case6. if def-data-name-case= "N" move end-sub to start-sub go to case2. case5. move res-len to editlen. move sub to editstart. if def-sentence-case = "S" or "s" perform convert-to-sentence else if def-data-name-case = "F" or "f" perform convert-to-first else if def-data-name-case= "U" or "u" perform convert-to-upper else if def-data-name-case = "L" or "l" perform convert-to-lower. move end-sub to start-sub. go to case2. case6. move nay to perf-name-expected. move alt1-name-expected to alt2-name-expected. move nay to alt1-name-expected. if def-proc-case = "N" move end-sub to start-sub go to case2. case7. move res-len to editlen. move sub to editstart. if def-sentence-case = "S" or "s" perform convert-to-sentence else if def-proc-case = "F" or "f" perform convert-to-first else if def-proc-case = "U" or "u" perform convert-to-upper else if def-proc-case = "L" or "l" perform convert-to-lower. move end-sub to start-sub. go to case2. case-end. exit. next-word section. next-w1. perform find-char. if start-sub > 72 go to next-wend. if char = quote if literal = yes move nay to literal add 1 to start-sub go to next-w1 else move yes to literal add 1 to start-sub go to next-w1. if char = "." move 1 to new-sentence-expected if literal = nay move nay to perf-name-expected alt1-name-expected alt2-name-expected go-name-expected pic-name-expected add 1 to start-sub go to next-w1 else add 1 to start-sub go to next-w1. if literal = yes add 1 to start-sub go to next-w1. move start-sub to end-sub. move 1 to res-sub. move spaces to res-word-buffer. next-w2. move char to res-word-buffer-char(res-sub). add 1 to end-sub. add 1 to res-sub. if end-sub > 72 go to next-w3. move so-rec-chr(end-sub) to char. if char = space go to next-w3 else if char = "." move 1 to new-sentence-expected go to next-w3. go to next-w2. next-w3. perform reserved-or-not. next-wend. exit. reserved-or-not section. reserv1. move 65 to editlen. move 1 to editstart. perform convert-resv-to-upper. move nay to reserved. move res-sub to res-len. subtract 1 from res-len. if res-sub < 3 or res-sub > 20 go to r20. subtract 2 from res-sub. go to r2 r3 r4 r5 r6 r7 r8 r9 r10 r11 r12 r13 r14 r15 r16 r20 r20 r19 depending on res-sub. r2. move 0 to res-sub. r2a. add 1 to res-sub. if res-sub > res-word-count-2 go to r20. if res02 = r2entry(res-sub) move yes to reserved go to r20. go to r2a. r3. move 0 to res-sub. r3a. add 1 to res-sub. if res-sub > res-word-count-3 go to r20. if res03 = r3entry(res-sub) move yes to reserved go to r20. go to r3a. r4. move 0 to res-sub. r4a. add 1 to res-sub. if res-sub > res-word-count-4 go to r20. if res04 = r4entry(res-sub) move yes to reserved go to r20. go to r4a. r5. move 0 to res-sub. r5a. add 1 to res-sub. if res-sub > res-word-count-5 go to r20. if res05 = r5entry(res-sub) move yes to reserved go to r20. go to r5a. r6. move 0 to res-sub. r6a. add 1 to res-sub. if res-sub > res-word-count-6 go to r20. if res06 = r6entry(res-sub) move yes to reserved go to r20. go to r6a. r7. move 0 to res-sub. r7a. add 1 to res-sub. if res-sub > res-word-count-7 go to r20. if res07 = r7entry(res-sub) move yes to reserved go to r20. go to r7a. r8. move 0 to res-sub. r8a. add 1 to res-sub. if res-sub > res-word-count-8 go to r20. if res08 = r8entry(res-sub) move yes to reserved go to r20. go to r8a. r9. move 0 to res-sub. r9a. add 1 to res-sub. if res-sub > res-word-count-9 go to r20. if res09 = r9entry(res-sub) move yes to reserved go to r20. go to r9a. r10. move 0 to res-sub. r10a. add 1 to res-sub. if res-sub > res-word-count-10 go to r20. if res10 = r10entry(res-sub) move yes to reserved go to r20. go to r10a. r11. move 0 to res-sub. r11a. add 1 to res-sub. if res-sub > res-word-count-11 go to r20. if res11 = r11entry(res-sub) move yes to reserved go to r20. go to r11a. r12. move 0 to res-sub. r12a. add 1 to res-sub. if res-sub > res-word-count-12 go to r20. if res12 = r12entry(res-sub) move yes to reserved go to r20. go to r12a. r13. move 0 to res-sub. r13a. add 1 to res-sub. if res-sub > res-word-count-13 go to r20. if res13 = r13entry(res-sub) move yes to reserved go to r20. go to r13a. r14. move 0 to res-sub. r14a. add 1 to res-sub. if res-sub > res-word-count-14 go to r20. if res14 = r14entry(res-sub) move yes to reserved go to r20. go to r14a. r15. move 0 to res-sub. r15a. add 1 to res-sub. if res-sub > res-word-count-15 go to r20. if res15 = r15entry(res-sub) move yes to reserved go to r20. go to r15a. r16. move 0 to res-sub. r16a. add 1 to res-sub. if res-sub > res-word-count-16 go to r20. if res16 = r16entry(res-sub) move yes to reserved go to r20. go to r16a. r19. move 0 to res-sub. r19a. add 1 to res-sub. if res-sub > res-word-count-19 go to r20. if res19 = r19entry(res-sub) move yes to reserved go to r20. go to r19a. r20. if reserved = nay go to reserv-end. if res-word-buffer not = "TO" move nay to go-name-expected. if res-word-buffer = "PIC" or "PICTURE" or "VALUE" move yes to pic-name-expected go to reserv-end else move nay to pic-name-expected. if res-word-buffer = "PERFORM" or "THRU" or "THROUGH" move yes to perf-name-expected go to reserv-end. if res-word-buffer = "ALTER" move yes to alt1-name-expected go to reserv-end. if res-word-buffer = "GO" move yes to go-name-expected go to reserv-end. reserv-end. exit. convert-to-upper section. move editstart to ind-1. move 1 to ind-2. convert-to-upper-loop. move so-rec-chr(ind-1) to temp-char if temp-char-9 < 123 and temp-char-9 > 96 subtract 32 from temp-char-9 move temp-char to so-rec-chr(ind-1). add 1 to ind-1 add 1 to ind-2. if ind-2 not > editlen go to convert-to-upper-loop. convert-to-sentence section. move editstart to ind-1. move 1 to ind-2. convert-to-sentence-loop. move so-rec-chr(ind-1) to temp-char. if start-of-sentence = 1 if temp-char-9 < 123 and temp-char-9 > 96 subtract 32 from temp-char-9 move temp-char to so-rec-chr(ind-1) move 0 to new-sentence-expected move 0 to start-of-sentence else if temp-char-9 < 91 and temp-char-9 > 64 move 0 to new-sentence-expected move 0 to start-of-sentence else next sentence else if temp-char-9 < 91 and temp-char-9 > 64 add 32 to temp-char-9 move temp-char to so-rec-chr(ind-1). add 1 to ind-1 add 1 to ind-2. if ind-2 not > editlen go to convert-to-sentence-loop. convert-to-first section. move editstart to ind-1. move 1 to ind-2. convert-to-first-loop. move so-rec-chr(ind-1) to temp-char. move so-rec-chr(ind-1 - 1) to prev-char if prev-char-separator if temp-char-9 < 123 and temp-char-9 > 96 subtract 32 from temp-char-9 move temp-char to so-rec-chr(ind-1) else next sentence else if temp-char-9 < 91 and temp-char-9 > 64 add 32 to temp-char-9 move temp-char to so-rec-chr(ind-1). add 1 to ind-1 add 1 to ind-2. if ind-2 not > editlen go to convert-to-first-loop. convert-to-lower section. move editstart to ind-1. move 1 to ind-2. convert-to-lower-loop. move so-rec-chr(ind-1) to temp-char if temp-char-9 < 91 and temp-char-9 > 64 add 32 to temp-char-9 move temp-char to so-rec-chr(ind-1). add 1 to ind-1 add 1 to ind-2. if ind-2 not > editlen go to convert-to-lower-loop. convert-resv-to-upper section. move editstart to ind-1. move 1 to ind-2. convert-resv-to-upper-loop. move res-word-buffer-char(ind-1) to temp-char if temp-char-9 < 123 and temp-char-9 > 96 subtract 32 from temp-char-9 move temp-char to res-word-buffer-char(ind-1). add 1 to ind-1 add 1 to ind-2. if ind-2 not > editlen go to convert-resv-to-upper-loop. find-char section. if start-sub < 73 if so-rec-chr(start-sub) = space add 1 to start-sub go to find-char else move so-rec-chr(start-sub) to char else move space to char. end program caseconv.