/*M ************************************************************************ PROPERTY OF APPLICON INCORPORATED MODULE HEADER (AGL or PL/1) This computer program is the property of Applicon Incorporated, and its total or partial disclosure to others, reproduction or transfer is prohibited. This licensed material may not be used except in strict compliance with Applicon Incorporated license terms. 1. Module name: FORMAT.PLI 2. Function: REFORMATS PL/1 SOURCE FILES WITH FIXED OR VARYING RECORD ATTRIBUTES AND A MAXIMUM OF 132 CHARACTERS PER RECORD INTO A FULLY EDITABLE AND COMPILABLE PL/1 SOURCE TEXT IN COMPLIANCE WITH RULES BELOW: A) MAXIMUM CHARACTER LENGTH FOR AN INPUT RECORD IS 132 CHARACTERS, LONGER LINES WILL PRODUCE A PL/1 RUNTIME ERROR AND AN INCOMPLETE OUTPUT FILE. B) PROVISION IS MADE FOR ALL INPUT RECORDS WHICH WHEN REFORMATTED WILL NOT FIT IN A SINGLE OUTPUT RECORD. LINES SO CONTINUED, UNLESS COMMENTS OR LITERAL STRINGS, WILL BE INDENTED TO THE CURRENT INDENTATION LEVEL PLUS 5 SPACES. C) INDENTATION OCCURS ON LINES WITHIN DO AND BEGIN BLOCKS. INDENTATION BEGINS IN COLUMN 10 AND IS INCREMENTED 3 SPACES FOR EACH DO OR BEGIN ENCOUNTERED. INDENTATION IN THE INPUT SOURCE IS IGNORED BY THE FORMATTER, UNLESS PART OF A LITERAL STRING OR COMMENT (AS DETAILED BELOW). D) DEINDENTATION OCCURS ON LINES FOLLOWING END STATEMENTS. THE INDENTATION LEVEL IS DECREMENTED 3 SPACES FOR EACH END ENCOUNTERED, BUT WILL NOT DROP BELOW A MINIMUN 10 SPACE COLUMN. E) LITERAL STRINGS ARE OUTPUT EXACTLY AS INPUT TO PRESERVE ANY FORMATTING INTENT DEVISED BY THE ORIGIONAL PROGRAMMER. F) COMMENTS WHICH BEGIN IN COLUMN 1 ARE OUTPUT EXACTLY AS INPUT UNTIL A CLOSE COMMENT IS ENCOUNTERED. THIS INCLUDES SINGLE COMMENT STRINGS WHICH SPAN MULTIPLE INPUT RECORDS, AS DOES THIS MODULE HEADER. G) COMMENTS WHICH DO NOT BEGIN IN COLUMN 1 BUT BEGIN THEIR OWN INPUT RECORD ARE INDENTED TO THE CURRENT INDENTATION LEVEL. H) COMMENTS APPENDED TO THE END OF A SOURCE LINE REMAIN ON THE SAME LINE AS THE SOURCE IF ROOM PERMITS. I) MULTIPLE SOURCE LINES IN THE SAME INPUT RECORD WILL BE SEPARATED ONTO INDIVIDUAL LINES IN THE OUTPUT FILE. J) LABELS WHICH BEGIN AN INPUT RECORD IN ANY COLUMN WILL BE PRINTED IN COLUMN 1 OF THE OUTPUT RECORD. IF OTHER SOURCE IS PRESENT IN THE INPUT RECORD CONTAINING THE LABEL, AND THE LABEL LENGTH PLUS THE LENGTH OF THE COLON AND SPACE APPENDED TO THE LABEL EXCEEDS THE CURRENT INDENTATION LEVEL, THE REMAINING INPUT SOURCE WILL BE MOVED TO THE NEXT OUTPUT RECORD. K) FORMFEEDS CONTAINED IN THE INPUT FILE WILL BE IGNORED BY THE FORMATTER UNLESS FOR SOME REASON THEY ARE IMBEDDED IN A COMMENT OR LITERAL STRING. ALTHOUGH THE OUTPUT FILE IS A PRINT FORMAT FILE AS DEFINED BY THE PROGRAM, IT TOO WILL BE DEVOID OF ANY DEFAULT FORMFEEDS. L) BLANK LINES USED IN THE INPUT FILE ARE RETAINED IN THE OUTPUT FILE. 3. Keywords: NONE 4. Facility Name: 5. Specification 5.1 Calling Sequence: CALLED FROM THE DCL COMMAND PROCEDURE FORMAT.COM 5.2 Input Data: PL/1 SOURCE TEXT (SEE FORMAT.COM HEADER FOR SPECS) 5.3 Output Data: PL/1 SOURCE TEXT (SEE FORMAT.COM HEADER FOR SPECS) 5.4 Side Effects: NONE 5.5 Environment: RUNS STANDALONE IN CONJUNCTION WITH FORMAT.COM 5.6 Error Conditions: PL/1 ERROR CONDITIONS RAISED FOR INPUT RECORDS EXCEEDING 132 CHARACTERS IN LENGTH 6. Module Design: 6.1 Elements and Submodules: FORMAT - CONTROLS PROGRAM EXECUTION INITIALIZE - SETS POINTERS AND FLAGS FOR FORMAT READRECORD - READS INRECORDS FROM INPUT FILE GETTOKEN - PARSES INRECORD FOR VALID TOKENS FIRSTPASS - CONTROLS FLOW FOR FIRST PARSE OF AN INPUT RECORD INDENT - INDENTS THE OUTPUT RECORD AS APPROPRIATE TOKENPROCESSOR - HANDLE PROCESSING OF NONCOMMENT & NONLITERAL TOKENS LABELCHECK - FINDS LABELS IN INPUT RECORDS AND WRITES THEM TO OUTFILE KEYWORD - CHECKS FOR BEGINS, DOS AND ENDS, ALSO END OF SOURCE STATEMENTS AND BEGINNING OF LITERAL STRINGS COMMENTPROCESSOR - HANDLES COMMENT STRINGS WRITELITERAL - HANDLES LITERAL STRINGS NEWLINE - RESETS OUTFILE POINTER TO BEGINNING OF NEXT RECORD CONTINUE - HANDLES SOURCE LINES WHICH DO NOT FIT IN 1 OUTFILE RECORD 6.2 Data Structures: NONE 7. Construction: PLI FORMAT, LINK FORMAT 8. Author and initial date: HOWARD S. CLAYMAN OCTOBER 30, 1980 9. Revision History: COPYRIGHT 1980 BY APPLICON INCORPORATED, ALL RIGHTS RESERVED ************************************************************************ ME*/ FORMAT: PROCEDURE OPTIONS(MAIN); DECLARE (INFILE,OUTFILE) FILE; DECLARE (INRECORD,TOKEN) CHARACTER(133) VARYING; DECLARE (INDENTCNT,INPOSITION,RECORDLENGTH, TOKENLENGTH, LABELLENGTH) FIXED BINARY; DECLARE FREESPACE FIXED BINARY INIT(132); DECLARE NEWINDENTCNT FIXED BINARY INIT(10); %REPLACE TRUE BY '1'B; %REPLACE FALSE BY '0'B; DECLARE NEWRECORD BIT(1) INIT(TRUE); DECLARE (ENDOFRECORD,FORMFEED,LABELFOUND,SPACENEEDED) BIT(1); DECLARE SPACE CHARACTER(1) INIT(BYTE(32)); DECLARE TAB CHARACTER(1) INIT(BYTE(9)); OPEN FILE(INFILE) SEQUENTIAL RECORD INPUT TITLE('FILESPEC'); /* ON CONDITION SIGNALS BRANCH TO BE TAKEN WHEN PROCESSING OF INPUT FILE IS COMPLETED */ ON ENDFILE(INFILE) GOTO FINISH; OPEN FILE(OUTFILE) STREAM PRINT OUTPUT TITLE('OUTFILESPEC'); /* ON CONDITION SUPRESSES RMS INSERTION OF INTO OUTPUT FILE */ ON ENDPAGE(OUTFILE); READ_LOOP: DO WHILE(TRUE); CALL INITIALIZE(); CALL READRECORD(); PROCESS_LOOP: /* CONTINUE UNTIL END OF INPUT RECORD ENCOUNTERED */ DO WHILE(^ENDOFRECORD); /* CALL GETTOKEN TO CHECK FOR ITEMS IN INRECORD */ CALL GETTOKEN(); /* IF PROCESSING THE BEGINNING OF AN INPUT RECORD, BRANCH TO SUBROUTINE */ IF NEWRECORD THEN CALL FIRSTPASS(); /* DO REGARDLESS OF WHETHER PROCESSING IS OCCURING AT BEGINNING OF NEW INPUT RECORD */ IF TOKEN ^= '' THEN CALL TOKENPROCESSOR(); END PROCESS_LOOP; /* RETURN TO BEGINNING OF LOOP & RESUME PROCESSING INRECORD */ /* WHEN FINISHED WITH INRECORD, RESET OUTFILE POINTER TO BEGINNING OF NEXT RECORD */ IF ^FORMFEED THEN CALL NEWLINE(); END READ_LOOP; /* WHEN PROCESSING OF ENTIRE INPUT FILE IS COMPLETED, CLOSE INPUT AND OUTPUT FILES AND END PROGRAM */ FINISH: CLOSE FILE(INFILE); CLOSE FILE(OUTFILE); /***********************************************************************/ INITIALIZE: PROCEDURE; /* THE PURPOSE OF THIS PROCEDURE IS TO RESET VARIOUS FLAGS AND POINTERS */ /* FOR THE MAIN PROGRAM PRIOR TO READING EACH NEW INPUT RECORD */ INDENTCNT = NEWINDENTCNT; /* SET INDENTCOUNT TO LATEST VALUE */ INPOSITION = 1; /* SET INRECORD CHARACTER POINTER TO COLUMN 1 */ TOKENLENGTH = 0; /* SET LENGTH OF CURRENT TOKEN TO ZERO */ /* SET FOUR IMPORTANT CONTROL FLAGS TO FALSE */ ENDOFRECORD = FALSE; LABELFOUND = FALSE; SPACENEEDED = FALSE; FORMFEED = FALSE; RETURN; END INITIALIZE; /***********************************************************************/ READRECORD: PROCEDURE; /* THE PURPOSE OF THIS PROCEDURE IS TO READ IN THE NEXT INPUT RECORD INTO */ /* THE VARIABLE LENGTH BUFFER INRECORD. */ READ FILE(INFILE) INTO(INRECORD); /* APPEND BLANK TO END OF INPUT RECORD TO ASSURE ALL CHARACTERS WILL BE READ */ INRECORD = INRECORD !! ' '; RECORDLENGTH = LENGTH(INRECORD); /* SET VARIABLE LENGTH TOKEN BUFFER TO NULL */ TOKEN = ''; RETURN; END READRECORD; /***********************************************************************/ GETTOKEN: PROCEDURE; /* GETTOKEN IS A MULTIFACETED SUBROUTINE, AND IS THE PRIMARY PARSING INSTRUMENT */ /* FOR THE FORMATTER PROGRAM. GETTOKEN USES FOR INPUT THE GLOBAL VARIABLES */ /* INRECORD, INPOSITION AND RECORDLENTH AND USES THEM TO DETERMINE THE LATEST */ /* STATUS OF THE GLOBAL VARIABLES NEWRECORD, TOKENLENGTH, TOKEN AND ENDOFRECORD */ /* GETTOKEN ALSO CALLS THE SUBROUTINE COMMENTPROCESSOR IF IT PICKS UP THE OPEN */ /* COMMENT SYMBOL WHILE SCANNING INRECORD. */ DECLARE TEST BIT(1); DECLARE CTR FIXED BINARY; DECLARE TESTCHAR CHARACTER(1); DECLARE FF CHARACTER(1) INIT(BYTE(12)); /* THE CHARACTER */ /* SET THE NEWRECORD FLAG */ IF INPOSITION = 1 THEN NEWRECORD = TRUE; ELSE NEWRECORD = FALSE; /* SWALLOW ALL LEADING BLANKS, TABS & 'S IN INRECORD */ TEST = FALSE; DO CTR = INPOSITION TO RECORDLENGTH WHILE(^TEST); TESTCHAR = SUBSTR(INRECORD,CTR,1); IF TESTCHAR ^= SPACE & TESTCHAR ^= TAB & TESTCHAR ^= FF THEN TEST = TRUE; /* SET THE FORMFEED FLAG FOR USE BY MAIN PROGRAM SHOULD LINE PROVE TO BE OTHERWISE EMPTY */ IF TESTCHAR = FF THEN FORMFEED = TRUE; END; /* TEST FOR BLANK LINE OR BLANK END OF LINE */ IF CTR > RECORDLENGTH & TEST = FALSE THEN DO; ENDOFRECORD = TRUE; RETURN; END; /* IF SOMETHING WAS FOUND, SCAN INRECORD TO FIND END OF TOKEN */ INPOSITION = CTR - 1; TEST = FALSE; DO CTR = INPOSITION TO RECORDLENGTH WHILE(^TEST); TESTCHAR = SUBSTR(INRECORD,CTR,1); /* IF A SPACE OR TAB IS ENCOUNTERED, END OF TOKEN HAS BEEN FOUND */ /* SET SPACENEEDED FLAG FOR USE IN MAIN PROGRAM */ IF TESTCHAR = SPACE ! TESTCHAR = TAB THEN DO; TEST = TRUE; SPACENEEDED = TRUE; END; /* IF A SEMICOLON OR APOSTROPHE IS ENCOUNTERED, END OF TOKEN HAS BEEN FOUND */ IF TESTCHAR = ';' ! TESTCHAR = '''' THEN TEST = TRUE; /* IF PARSING INRECORD FOR THE FIRST TIME AND A COLON IS ENCONTERED, END OF TOKEN HAS BEEN FOUND */ IF NEWRECORD & TESTCHAR = ':' THEN TEST = TRUE; /* IF THE BEGINNING OF A COMMENT IS ENCOUNTERED, CALL COMMENTPROCESSOR TO HANDLE */ /* OUTPUT, BUT ONLY IF CTR = INPOSITION. OTHERWISE THE COMMENT IS AN APPENDAGE */ /* TO THE PREVIOUS TOKEN, AND THE END OF THAT TOKEN HAS BEEN FOUND. */ IF TESTCHAR = '/' & SUBSTR(INRECORD,CTR+1,1) = '*' THEN DO; IF CTR = INPOSITION THEN DO; CALL COMMENTPROCESSOR(); RETURN; END; ELSE TEST = TRUE; END; END; /* HAVING REACHED THE END OF A TOKEN, RESET POINTERS AND FLAGS PRIOR TO RETURN */ /* IF THE TOKEN PICKED UP IS A LONE SEMICOLON OR APOSTROPHE, SET TOKENLENGTH TO 1 */ IF (TESTCHAR = ';' ! TESTCHAR = '''' ) & CTR <= INPOSITION + 1 THEN TOKENLENGTH = 1; /* IF BEGINNING OF A COMMENT IMMEDIATELY FOLLOWED END OF SCANNED TOKEN, SET TOKENLENGTH ACCORDING TO FORMULA */ ELSE IF TESTCHAR = '/' & SUBSTR(INRECORD,CTR,1) = '*' THEN TOKENLENGTH = CTR - 2 - INPOSITION; /* IF NEITHER OF THE ABOVE TESTS APPLIES, SET TOKENLENGTH TO CTR - 1 - INPOSITION */ ELSE TOKENLENGTH = CTR - 1 - INPOSITION; /* EXTRACT TOKEN FROM INRECORD */ TOKEN = SUBSTR(INRECORD,INPOSITION,TOKENLENGTH); /* IF END OF INRECORD HAS BEEN REACHED, SET FLAG FOR USE IN MAIN PROGRAM */ IF CTR > RECORDLENGTH THEN ENDOFRECORD = TRUE; RETURN; END GETTOKEN; /***********************************************************************/ FIRSTPASS: PROCEDURE; /* FIRSTPASS IS CALLED BY THE MAIN PROGRAM DURING THE FIRST ATTEMPT TO */ /* PARSE AN INPUT RECORD */ /* IF GETTOKEN FOUND SOMETHING IN INRECORD ENTER THE DO BLOCK */ IF TOKEN ^= '' THEN DO; /* CALL FUNCTION LABELCHECK TO DETERMINE IF A LABEL BEGINS INRECORD */ LABELFOUND = LABELCHECK(); /* CALL SUBROUTINE INDENT TO SET OUTRECORD COLUMN TO CURRENT INDENTATION LEVEL */ CALL INDENT(); END; /* IF NEWRECORD IS TRUE BUT NO TOKEN WAS FOUND THEN A BLANK INPUT LINE WAS READ */ /* IF THE FORMFEED FLAG WAS NOT SET TO TRUE BY GETTOKEN, A BLANK LINE SHOULD BE OUTPUT */ /* PLACING A BLANK IN COLUMN 1 OF AN EMPTY OUTPUT LINE SUPREESES RMS CHARACTER INSERTION */ ELSE IF ^FORMFEED THEN PUT FILE(OUTFILE) EDIT(' ') (A(1)); RETURN; END FIRSTPASS; /***********************************************************************/ INDENT: PROCEDURE; /* PROCEDURE INDENT CAUSES THE INDENTATION OF NEW RECORDS IN OUTFILE */ /* THE PROCEDURE FIRST CHECKS IF A LABEL HAS BEEN WRITTEN AT THE */ /* BEGINNING OF THE RECORD AND FORCES A NEW LINE IN OUTFILE IF */ /* THE LABEL IS LONGER THAN THE INDENTATION LEVEL IS DEEP. */ /* GLOBAL VARIBLES USED AS INPUT INCLUDE LABELFOUND, TOKENLENGTH */ /* AND INDENTCNT. THE ONLY GLOBAL VARIABLE MODIFIED BY INDENT IS */ /* FREESPACE. */ DECLARE (STARTINDENT,CTR) FIXED BINARY; DECLARE MORETOKENS BIT(1) INIT(FALSE); DECLARE NEXTCHAR CHARACTER(1); /* IF A LABEL HAS BEEN WRITTEN INTO THE CURRENT OUTFILE RECORD, */ /* SCAN INRECORD TO DETERMINE IF OTHER TOKENS BESIDES THE LABEL */ /* CAN BE FOUND. */ IF LABELFOUND THEN DO; DO CTR = INPOSITION TO RECORDLENGTH WHILE(^MORETOKENS); NEXTCHAR = SUBSTR(INRECORD,CTR,1); IF NEXTCHAR ^= SPACE & NEXTCHAR ^= TAB THEN MORETOKENS = TRUE; END; /* IF NOTHING ELSE WAS IN INRECORD EXCEPT THE LABEL, */ /* THEN RETURN TO CALLING ROUTINE, THIS WILL PREVENT */ /* A BLANK LINE BEING OUTPUT FOLLOWING A LABEL WHICH */ /* SAT ALONE IN INRECORD AND WAS NOT FOLLOWED BY A */ /* BLANK LINE IN THE INPUT FILE. */ IF ^MORETOKENS THEN RETURN; /* IF THE LENGTH OF THE TOKEN WAS GREATER THAN THE CURRENT INDENTCNT, FORCE A NEW LINE IN OUTFILE */ IF TOKENLENGTH + 2 > INDENTCNT THEN DO; CALL NEWLINE(); STARTINDENT = 1; END; /* OTHERWISE, DECREMENT THE INDENTCNT TO ALLOW FOR SPACE USED BY THE LABEL */ ELSE STARTINDENT = TOKENLENGTH + 3; END; /* IF NO LABEL EXISTS, THEN BEGIN INDENTING FROM COLUMN 1 IN THE OUTFILE RECORD */ ELSE STARTINDENT = 1; DO CTR = STARTINDENT TO INDENTCNT; PUT FILE(OUTFILE) EDIT(SPACE) (A(1)); END; /* DECREMENT FREESPACE COUNTER FOR OUTFILE RECORD */ FREESPACE = FREESPACE - INDENTCNT; RETURN; END INDENT; /***********************************************************************/ TOKENPROCESSOR: PROCEDURE; /* TOKENPROCESSOR IS CALLED BY THE MAIN PROGRAM TO DETERMINE HOW TO OUTPUT */ /* TOKENS PICKED UP BY GETTOKEN WHICH WERE NOT ALREADY OUTPUT AS A COMMENT */ /* OR A LABEL. TOKENPROCESSOR CALLS SUBROUTINE KEYWORD TO DETERMINE IF */ /* TOKEN HOLDS SOME SPECIAL MEANING FOR THE PROGRAM AND WHETHER THERE IS */ /* SUFFICIENT ROOM IN THE CURRENT OUTFILE RECORD TO WRITE THE TOKEN. */ /* AFTER WRITING THE TOKEN TO THE OUTFILE, TOKENPROCESSOR RESETS THE TOKEN */ /* BUFFER TO NULL, DECREMENTS FREESPACE AND RESETS THE SPACENEEDED FLAG. */ /* TOKENPROCESSOR ALSO RESETS THE INPOSITION POINTER TO THE COLUMN OF */ /* INRECORD FOLLOWING THE TOKEN. */ /* CHECK IF TOKEN PICKED UP IS A KEYWORD OR BEGINNING OF A LITERAL STRING */ CALL KEYWORD(); /* IF ON RETURN FROM KEYWORD THERE IS NOT SUFFICIENT ROOM IN OUTPUT RECORD */ /* TO WRITE THE CURRENT TOKEN, CALL SUBROUTINE CONTINUE */ IF TOKENLENGTH > FREESPACE THEN CALL CONTINUE(); /* WRITE THE TOKEN TO THE OUTPUT FILE */ PUT FILE(OUTFILE) EDIT(TOKEN) (A); /* IF THE SPACENEEDED FLAG WAS SET TO TRUE BY GETTOKEN, WRITE A BLANK TO THE OUTPUT FILE */ IF SPACENEEDED THEN DO; PUT FILE(OUTFILE) EDIT(' ') (A(1)); FREESPACE = FREESPACE - 1; /* DECREMENT FREESPACE TO ACCOUNT FOR BLANK */ SPACENEEDED = FALSE; END; /* NULL TOKEN BUFFER */ TOKEN = ''; /* RESET INPOSITION POINTER TO CHARACTER AFTER END OF CURRENT TOKEN IN INRECORD */ INPOSITION = INPOSITION + TOKENLENGTH; /* DECREMENT FREESPACE COUNTER TO SHOW SPACE REMAINING IN OUTPUT RECORD */ FREESPACE = FREESPACE - TOKENLENGTH; RETURN; END TOKENPROCESSOR; /***********************************************************************/ LABELCHECK: PROCEDURE RETURNS(BIT(1)); /* LABELCHECK IS CALLED BY FIRSTPASS TO DETERMINE IF THE FIRST TOKEN OF */ /* INRECORD IS A LABEL, WHICH LABELCHECK WILL THEN WRITE TO COLUMN 1 */ /* OF THE NEW OUTFILE RECORD. */ /* LABELCHECK EMPLOYS THE GLOBAL VARIABLES INPOSITION AND TOKENLENGTH */ /* TO PERFORM ITS FUNCTION AND WILL RESET INPOSITION IF IT FINDS A */ /* LABEL. */ DECLARE NEXTCHAR CHARACTER(1) INIT(SPACE); DECLARE CTR FIXED BINARY; /* FIND NEXT VALID TOKEN IN INRECORD AFTER POSSIBLE LABEL END */ DO CTR = INPOSITION + TOKENLENGTH TO RECORDLENGTH WHILE(NEXTCHAR = SPACE ! NEXTCHAR = TAB); NEXTCHAR = SUBSTR(INRECORD,CTR,1); END; /* IF NOT A COLON, LABEL WAS NOT FOUND */ IF NEXTCHAR ^= ':' THEN RETURN(FALSE); ELSE DO; /* IF LABEL FOUND, OUTPUT IN COLUMN 1 OF OUTFILE RECORD */ PUT FILE(OUTFILE) EDIT(TOKEN,': ') (A,A(2)); INPOSITION = CTR; /* RESET INPOSITION POINTER TO COLUMN AFTER COLON */ TOKEN = ''; /* NULL TOKEN BUFFER TO PREVENT LABEL REPROCESSING */ RETURN(TRUE); END; END LABELCHECK; /***********************************************************************/ KEYWORD: PROCEDURE; /* KEYWORD IS CALLED BY TOKENPROCESSOR TO DETERMINE IF THE CURRENT TOKEN */ /* IS IMPORTANT TO THE FORMATTER, I.E. WHETHER IT SHOULD AFFECT THE */ /* INDENTATION LEVEL, WHETHER IT IS A TERMINUS FOR A PL/1 SOURCE LINE, */ /* OR IF IT IS THE BEGINNING OF A LITERAL STRING, IN WHICH CASE THE */ /* SUBROUTINE WRITELITERAL IS CALLED. */ /* KEYWORD USES TOKEN, INPOSITION AND RECORDLENGTH AS INPUTS, AND, */ /* DEPENDING ON THE BRANCHES TAKEN IN THE SUBROUTINE, COULD MODIFY THE */ /* GLOBAL VARIABLES NEWINDENTCNT, SPACENEEDED, INPOSITION AND TOKEN. */ DECLARE NEXTCHAR CHARACTER(1); DECLARE CTR FIXED BINARY; /* CHECK IF TOKEN IS A RECOGNISED KEYWORD */ IF TOKEN = 'BEGIN' ! TOKEN = 'DO' THEN DO; NEWINDENTCNT = NEWINDENTCNT + 3; /* INCREASE INDENTCNT */ RETURN; END; IF TOKEN = 'END' THEN DO; NEWINDENTCNT = NEWINDENTCNT - 3; /* DECREASE INDENTCNT */ IF NEWINDENTCNT < 10 THEN NEWINDENTCNT = 10; /* IF TOO MANY 'ENDS' ENCOUNTERED */ RETURN; END; /* IF ENTERING A LITERAL OUTPUT STRING, CALL SUBROUTINE TO PROCESS */ IF TOKEN = '''' THEN DO; CALL WRITELITERAL(); RETURN; END; /* IF TOKEN IS A SEMICOLON, CHECK IF COMMENT APPENDED TO LINE */ IF TOKEN = ';' THEN DO; DO CTR = INPOSITION + 1 TO RECORDLENGTH; NEXTCHAR = SUBSTR(INRECORD,CTR,1); /* IF TEST IS TRUE, A COMMENT EXISTS AT END OF LINE. */ /* THEREFORE, RETURN TO CALLING SUBROUTINE SO PROCESSING WILL */ /* CONTINUE IN THE SAME OUTPUT RECORD. */ IF NEXTCHAR = '/' THEN DO; SPACENEEDED = TRUE; RETURN; END; /* OTHERWISE, IF SOMETHING OTHER THAN EMPTY SPACE IS APPENDED TO LINE, */ /* IT MUST BE ANOTHER EXECUTABLE STATEMENT, SO FORCE A NEW LINE IN */ /* OUTFILE AND CONTINUE PROCESSING INRECORD. */ IF NEXTCHAR ^= SPACE & NEXTCHAR ^= TAB THEN DO; PUT FILE(OUTFILE) EDIT(';') (A(1)); /* OUTPUT THE SEMICOLON */ CALL NEWLINE(); CALL INDENT(); INPOSITION = CTR - 1; /* RESET INPOSITION POINTER TO COLUMN AFTER ';' IN INRECORD */ TOKEN = ''; /* NULL TOKEN TO PREVENT ITS REPROCESSING */ RETURN; END; END; END; END KEYWORD; /***********************************************************************/ COMMENTPROCESSOR: PROCEDURE; /* COMMENTPROCESSOR IS CALLED BY SUBROUTINE GETTOKEN WHEN AN OPEN COMMENT */ /* IS FOUND IN AN INRECORD. COMMENTPROCESSOR CONTROLS OUTPUT OF THE */ /* COMMENT STRING TO OUTFILE ACCORDING TO THE RULES OUTLINED IN THE MODULE */ /* HEADER FOR THIS PROGRAM. BASICALLY, COMMENTS ARE HANDLED LIKE LITERAL */ /* STRINGS EXCEPT THAT MINOR REFORMATTING IS DONE TO ACCOMODATE MULTI-LINE */ /* COMMENTS WHICH ARE OPENED IN A PARTICULAR INRECORD AND NOT CLOSED IN */ /* THAT SAME RECORD. FOLLOW THE LOGIC OF THE SUBROUTINE FOR A CLEARER */ /* EXPLANATION. */ /* COMMENTPROCESSOR USES THE GLOBAL VARIABLES INPOSITION, RECORDLENGTH, */ /* FREESPACE AND TOKEN TO PROCESS A COMMENT, AND DURING EXECUTION MAY */ /* MODIFY ANY AND ALL OF THESE VARIABLES. */ DECLARE (CTR,CTR2) FIXED BINARY; DECLARE CUCHAR CHARACTER(1); DECLARE COMMENTINDENT BIT(1) INIT(FALSE); DECLARE TEST BIT(1); /* IF COMMENT BEGINS A LINE, BUT DOES NOT BEGIN IN COLUMN 1, THEN SET LOCAL */ /* FLAG COMMENTINDENT TO TRUE AND INDENT THE OUTRECORD TO INDENTATION LEVEL */ IF NEWRECORD & SUBSTR(INRECORD,1,2) ^= '/*' THEN DO; COMMENTINDENT = TRUE; CALL INDENT(); END; /* THE FOLLOWING LOOP WILL PROCESS ALL TEXT UNTIL END OF COMMENT IS ENCOUNTERED */ DO WHILE(TRUE); /* SCAN INRECORD ON A CHARACTER BY CHARACTER BASIS AS LONG AS ROOM EXISTS IN OUTRECORD */ DO CTR = INPOSITION TO RECORDLENGTH WHILE(FREESPACE >= 2); CUCHAR = (SUBSTR(INRECORD,CTR,1)); /* IF END OF COMMENT IS FOUND, ENTER THE DO LOOP */ IF CUCHAR = '*' & SUBSTR(INRECORD,CTR+1,1) = '/' THEN DO; PUT FILE(OUTFILE) EDIT('*/') (A(2)); /* OUTPUT CLOSE COMMENT MARKER */ TOKEN = ''; /* NULL THE CURRENT TOKEN FOR RETURN TO MAIN PROGRAM */ INPOSITION = CTR + 2; /* RESET INPOSITION POINTER TO CHARACTER AFTER CLOSE COMMENT IN INRECORD */ RETURN; /* RETURN TO GETTOKEN */ END; /* IF END OF COMMENT HAS NOT BEEN FOUND, OUTPUT CURRENT CHARACTER TO OUTFILE */ PUT FILE(OUTFILE) EDIT(CUCHAR) (A); FREESPACE = FREESPACE - 1; /* IF INSUFFICIENT SPACE IN OUTFILE RECORD TO HANDLE FURTHER TEXT, FORCE A NEW LINE */ IF FREESPACE < 2 THEN DO; CALL NEWLINE(); IF COMMENTINDENT THEN CALL INDENT(); END; /* IF AT THE END OF INRECORD BUT NOT AT THE COMMENT CLOSE, READ NEXT INRECORD */ IF CTR = RECORDLENGTH THEN DO; CALL READRECORD(); /* LOOP HERE SWALLOWS ALL LEADING BLANKS AND TABS IN NEW INRECORD TO ALLOW FOR */ /* PROPER INDENTATION OF AN OPEN-ENDED MULTI LINE COMMENT */ IF COMMENTINDENT THEN DO; TEST = FALSE; DO CTR2 = 1 TO RECORDLENGTH WHILE(^TEST); CUCHAR = SUBSTR(INRECORD,CTR2,1); IF CUCHAR ^= SPACE & CUCHAR ^= TAB THEN TEST = TRUE; END; /* INPOSITION IN NEW INRECORD IS SET TO FIRST NON-BLANK, NON-TAB CHARACTER */ INPOSITION = CTR2 - 1; END; /* IF NOT INDENTING COMMENT BLOCK SIMPLY CREATE A NEW OUTFILE RECORD */ /* AND BEGIN TO PROCESS NEXT LINE OF COMMENT BLOCK. */ ELSE DO; CALL NEWLINE(); INPOSITION = 1; END; END; END; END; END COMMENTPROCESSOR; /***********************************************************************/ WRITELITERAL: PROCEDURE; /* WRITELITERAL OUTPUTS LITERAL STRINGS EXACTLY AS INPUT TO PRESERVE ANY */ /* POSSIBLE COLUMN HEADERS OR OUTPUT FORMATTING WHICH THE INPUT FILE CONTAINS */ /* WRITELITERAL USES THE GLOBAL VARIABLES INPOSITION, RECORDLENGTH, FREESPACE */ /* AND SPACENEEDED AND DURING THE COURSE OF EXECUTION MAY MODIFY ALL OF THEM. */ /* THE SUBROUTINE WILL ALSO NULL TOKEN WHEN CLOSE LITERAL IS FOUND. */ DECLARE CTR FIXED BINARY; DECLARE CUCHAR CHARACTER(1); DO WHILE(TRUE); /* SCAN INRECORD ON A CHARACTER BY CHARACTER BASIS WITHIN THE LITERAL STRING */ DO CTR = INPOSITION TO RECORDLENGTH WHILE(FREESPACE > 0); CUCHAR = SUBSTR(INRECORD,CTR,1); /* IF THE FOLLOWING TEST IS TRUE, THE END OF THE LITERAL HAS BEEN FOUND */ IF CUCHAR = '''' & CTR > INPOSITION THEN DO; PUT FILE(OUTFILE) EDIT(CUCHAR) (A); /* WRITE THE APOSTROPHE */ TOKEN = ''; /* NULL THE TOKEN TO PREVENT REPROCESSING */ /* SET THE INPOSITION POINTER THE CHARACTER IMMEDIATELY AFTER CLOSING APOSTROPHE */ /* THIS WILL TAKE CARE OF SITUATIONS WHERE MULTIPLE APOSTROPHES ARE PLACED SIDE */ /* BY SIDE WITHIN THE COMMENT, AS THE PROGRAM WILL ASSUME THE NEXT APOSTROPHE TO */ /* BE THE START OF ANOTHER LITERAL STRING WHICH WILL BE APPENDED TO THE END OF */ /* THE CURRENT STRING IN OUTFILE */ INPOSITION = CTR; IF SUBSTR(INRECORD,CTR+1,1) = SPACE ! SUBSTR(INRECORD,CTR+1,1) = TAB THEN SPACENEEDED = TRUE; ELSE SPACENEEDED = FALSE; RETURN; END; /* IF END OF LITERAL STRING HAS NOT YET BEEN FOUND, OUTPUT CURRENT CHARACTER TO OUTFILE */ PUT FILE(OUTFILE) EDIT(CUCHAR) (A); FREESPACE = FREESPACE - 1; /* IF NO MORE ROOM EXITS IN OUTFILE, FORCE A NEW LINE AND CONTINUE PROCESSING */ IF FREESPACE = 0 THEN CALL NEWLINE(); /* IF END OF INRECORD HAS BEEN REACHED BUT LITERAL HAS NOT BEEN CLOSED, READ NEXT INRECORD */ IF CTR = RECORDLENGTH THEN DO; CALL READRECORD(); INPOSITION = 1; END; END; END; END WRITELITERAL; /***********************************************************************/ NEWLINE: PROCEDURE; /* NEWLINE SETS THE FILE POINTER FOR OUTFILE TO THE BEGINNING OF THE */ /* NEXT RECORD AND RESETS THE GLOBAL VARIABLE FREESPACE TO 132. */ PUT FILE(OUTFILE) SKIP; FREESPACE = 132; RETURN; END; /***********************************************************************/ CONTINUE: PROCEDURE; /* CONTINUE IS CALLED WHEN THERE IS NOT ENOUGH FREESPACE IN THE */ /* OUTPUT RECORD TO ACCOMODATE A TOKEN FROM THE CORRESPONDING */ /* INFILE RECORD. */ /* CONTINUE TEMPORARILY MODIFIES INDENTCNT FOR ITS OWN USE AND */ /* RETURNS A NEW VALUE FOR FREESPACE TO THE CALLING ROUTINE. */ /* FORCE A NEW LINE IN OUTFILE */ CALL NEWLINE(); /* INCREMENT INDENTCNT TEMPORARILY FOR LINE CONTINUATION AND INDENT NEW OUTFILE RECORD */ INDENTCNT = INDENTCNT + 5; CALL INDENT(); FREESPACE = 132 - INDENTCNT; INDENTCNT = INDENTCNT - 5; RETURN; END CONTINUE; /***********************************************************************/ END FORMAT;