├── .gitignore ├── LICENSE ├── README.md ├── bin ├── LISP.exe ├── TOKENIZER.exe ├── cisp-error.dll ├── cisp.bat ├── cisp.exe ├── libasprintf-0.dll ├── libatomic-1.dll ├── libcharset-1.dll ├── libcob-4.dll ├── libdb-6.2.dll ├── libexpat-1.dll ├── libgcc_s_dw2-1.dll ├── libgettextlib-0-18-3.dll ├── libgettextpo-0.dll ├── libgettextsrc-0-18-3.dll ├── libgmp-10.dll ├── libgmpxx-4.dll ├── libgomp-1.dll ├── libiconv-2.dll ├── libintl-8.dll ├── libmpc-3.dll ├── libmpfr-4.dll ├── libquadmath-0.dll ├── libssp-0.dll ├── libstdc++-6.dll ├── lisp.dll ├── logger.dll ├── mingwm10.dll ├── pdcurses.dll ├── pthreadGC-3.dll ├── recursion.dll ├── tokenizer.dll └── zlib1.dll ├── cisp-error.cbl ├── cisp.cbl ├── lisp.cbl ├── logger.cbl ├── logs └── log.data ├── recursion.cbl ├── test ├── addition │ ├── addition-2-numbers.lisp │ ├── addition-3-numbers.lisp │ └── nested.lisp ├── comments │ └── single-alpha-num.lisp ├── demo │ └── presentation-demo.lisp └── print │ ├── single-num-twice.lisp │ ├── single-num.lisp │ └── str-no-spaces.lisp └── tokenizer.cbl /.gitignore: -------------------------------------------------------------------------------- 1 | # Generated C files 2 | *.c 3 | *.c.* 4 | *.i 5 | # Byte-compiled / optimized / DLL files 6 | __pycache__/ 7 | *.py[cod] 8 | *$py.class 9 | 10 | # C extensions 11 | *.so 12 | 13 | # Distribution / packaging 14 | .Python 15 | env/ 16 | build/ 17 | develop-eggs/ 18 | dist/ 19 | downloads/ 20 | eggs/ 21 | .eggs/ 22 | lib/ 23 | lib64/ 24 | parts/ 25 | sdist/ 26 | var/ 27 | *.egg-info/ 28 | .installed.cfg 29 | *.egg 30 | 31 | # PyInstaller 32 | # Usually these files are written by a python script from a template 33 | # before PyInstaller builds the exe, so as to inject date/other infos into it. 34 | *.manifest 35 | *.spec 36 | 37 | # Installer logs 38 | pip-log.txt 39 | pip-delete-this-directory.txt 40 | 41 | # Unit test / coverage reports 42 | htmlcov/ 43 | .tox/ 44 | .coverage 45 | .coverage.* 46 | .cache 47 | nosetests.xml 48 | coverage.xml 49 | *,cover 50 | .hypothesis/ 51 | 52 | # Translations 53 | *.mo 54 | *.pot 55 | 56 | # Django stuff: 57 | *.log 58 | local_settings.py 59 | 60 | # Flask stuff: 61 | instance/ 62 | .webassets-cache 63 | 64 | # Scrapy stuff: 65 | .scrapy 66 | 67 | # Sphinx documentation 68 | docs/_build/ 69 | 70 | # PyBuilder 71 | target/ 72 | 73 | # IPython Notebook 74 | .ipynb_checkpoints 75 | 76 | # pyenv 77 | .python-version 78 | 79 | # celery beat schedule file 80 | celerybeat-schedule 81 | 82 | # dotenv 83 | .env 84 | 85 | # virtualenv 86 | venv/ 87 | ENV/ 88 | 89 | # Spyder project settings 90 | .spyderproject 91 | 92 | # Rope project settings 93 | .ropeproject 94 | 95 | # swap 96 | [._]*.s[a-v][a-z] 97 | [._]*.sw[a-p] 98 | [._]s[a-v][a-z] 99 | [._]sw[a-p] 100 | # session 101 | Session.vim 102 | # temporary 103 | .netrwhist 104 | *~ 105 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2017 Lauryn Brown 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Cisp 2 | A Common Lisp Interpreter Built in COBOL. 3 | 4 | ## Overview 5 | ### Purpose 6 | This is a small project built by a student at the Recurse Center to express a love for COBOL and better understand it. 7 | 8 | Due to COBOL's lack of functions and recursion, the recursion required for Lisp is built from the ground up using file processing. Also, due to the lack of a widely supported debugger, a system logger was also implemented. 9 | 10 | ### Compatibility 11 | Please note that Cisp is currently only actively developed for Windows. \*Nix users may experience issues. 12 | 13 | ### Functionality 14 | All features are currently in development. This is a list of what is to come. 15 | - Representation of Symbols and Numbers ![Ongoing Development](https://img.shields.io/badge/Development-Ongoing-green.svg?style=flat-square) 16 | - Basic Arithmetic ![Ongoing Development](https://img.shields.io/badge/Development-Ongoing-green.svg?style=flat-square) 17 | - Flow-Control Statements ![Not Currently in Development](https://img.shields.io/badge/Development-No-green.svg?style=flat-square) 18 | - Lists ![Not Currently in Development](https://img.shields.io/badge/Development-No-green.svg?style=flat-square) 19 | ### Notes 20 | The README much like the entire project is in current development. 21 | 22 | ## Running Cisp 23 | ### Hello World 24 | 1. Make a subdirectory for your lisp file. 25 | ```cmd 26 | mkdir test\helloworld 27 | ``` 28 | 2. Create a new file `helloworld.lisp` in your subdirectory containing the following: 29 | ```lisp 30 | (print "HelloWorld!") 31 | ``` 32 | 3. To run Cisp cd into the bin (Note that you must cd in) 33 | 34 | ```cmd 35 | cd bin 36 | ``` 37 | 4. Run Cisp 38 | 39 | ```cmd 40 | cisp.exe ..\test\helloworld\helloworld.lisp 41 | ``` 42 | 43 | ### Project Structure 44 | Currently the COBOL source files are located in the root directory. 45 | #### Directories 46 | * bin - Contains all necessary \*.dll's (windows users) for those who want to play with CISP without changing the code. This is due to the fact that so few people have COBOL compilers. 47 | * logs - Contains the log file generated by the system. 48 | * test - Contains all test files organized by subject. 49 | #### COBOL Files 50 | * cisp.cbl - The main COBOL program. 51 | * cisp-error.cbl - The Error System in the program. It will "throw" errors when called. 52 | * lisp.cbl - Responsible for executing the lisp program. 53 | * logger.cbl - The Logging System in the program. It will log events in the system when called. 54 | * recursion.cbl - Handles recursion as requested from lisp.cbl. 55 | * tokenizer.cbl - Responsible for tokenizing the lisp file given to execute. 56 | 57 | ### Compiling 58 | The easiest way I have found to compile COBOL is [GNU's COBOL compilier](https://sourceforge.net/projects/open-cobol/). For those who prefer IDE's I have found [Open COBOL IDE](http://opencobolide.readthedocs.io/en/latest/download.html) to be very helpful. 59 | ### Running Tests 60 | #### Windows 61 | To run all tests in the project, double click `bin\cisp.bat` 62 | 63 | To run a single test: 64 | `cd bin` 65 | 66 | `cisp.exe ..\test\test_subdirectory\test_name.lisp` 67 | 68 | #### Create your own Lisp Files for Testing 69 | 1. Create a directory in `test\` to create another test category. 70 | 2. In your subdirectory create a lisp file. 71 | 3. `cd bin` 72 | 4. `cisp.exe ..\test\test_subdirectory\test_name.lisp` 73 | #### Linux 74 | Instructions yet to come. The author is a window's user, and \*nix systems are not currently supported. 75 | 76 | A high level overview is to compile the project and run the executable in the bin folder. 77 | ## Developing Cisp 78 | ### How Cisp Works 79 | ### Log to Log File 80 | Coming soon. 81 | ### Throw an Error 82 | Coming soon. 83 | -------------------------------------------------------------------------------- /bin/LISP.exe: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lauryndbrown/Cisp/9364c7392ff903bbb3f2f7d72e188e0126afd89b/bin/LISP.exe -------------------------------------------------------------------------------- /bin/TOKENIZER.exe: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lauryndbrown/Cisp/9364c7392ff903bbb3f2f7d72e188e0126afd89b/bin/TOKENIZER.exe -------------------------------------------------------------------------------- /bin/cisp-error.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lauryndbrown/Cisp/9364c7392ff903bbb3f2f7d72e188e0126afd89b/bin/cisp-error.dll -------------------------------------------------------------------------------- /bin/cisp.bat: -------------------------------------------------------------------------------- 1 | cls 2 | @ECHO OFF 3 | SET test_dir=..\test\ 4 | ECHO %test_dir% 5 | for /f "delims=" %%d in ('dir /b %test_dir%') do ( 6 | ECHO -------------------------- 7 | ECHO Test Directory: %%d 8 | for /f "delims=" %%f in ('dir /b "%test_dir%%%d"') do ( 9 | ECHO File:%test_dir%%%d\%%f 10 | TYPE %test_dir%%%d\%%f 11 | CALL cisp.exe %test_dir%%%d\%%f 12 | ) 13 | ) 14 | PAUSE 15 | EXIT 16 | -------------------------------------------------------------------------------- /bin/cisp.exe: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lauryndbrown/Cisp/9364c7392ff903bbb3f2f7d72e188e0126afd89b/bin/cisp.exe -------------------------------------------------------------------------------- /bin/libasprintf-0.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lauryndbrown/Cisp/9364c7392ff903bbb3f2f7d72e188e0126afd89b/bin/libasprintf-0.dll -------------------------------------------------------------------------------- /bin/libatomic-1.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lauryndbrown/Cisp/9364c7392ff903bbb3f2f7d72e188e0126afd89b/bin/libatomic-1.dll -------------------------------------------------------------------------------- /bin/libcharset-1.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lauryndbrown/Cisp/9364c7392ff903bbb3f2f7d72e188e0126afd89b/bin/libcharset-1.dll -------------------------------------------------------------------------------- /bin/libcob-4.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lauryndbrown/Cisp/9364c7392ff903bbb3f2f7d72e188e0126afd89b/bin/libcob-4.dll -------------------------------------------------------------------------------- /bin/libdb-6.2.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lauryndbrown/Cisp/9364c7392ff903bbb3f2f7d72e188e0126afd89b/bin/libdb-6.2.dll -------------------------------------------------------------------------------- /bin/libexpat-1.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lauryndbrown/Cisp/9364c7392ff903bbb3f2f7d72e188e0126afd89b/bin/libexpat-1.dll -------------------------------------------------------------------------------- /bin/libgcc_s_dw2-1.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lauryndbrown/Cisp/9364c7392ff903bbb3f2f7d72e188e0126afd89b/bin/libgcc_s_dw2-1.dll -------------------------------------------------------------------------------- /bin/libgettextlib-0-18-3.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lauryndbrown/Cisp/9364c7392ff903bbb3f2f7d72e188e0126afd89b/bin/libgettextlib-0-18-3.dll -------------------------------------------------------------------------------- /bin/libgettextpo-0.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lauryndbrown/Cisp/9364c7392ff903bbb3f2f7d72e188e0126afd89b/bin/libgettextpo-0.dll -------------------------------------------------------------------------------- /bin/libgettextsrc-0-18-3.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lauryndbrown/Cisp/9364c7392ff903bbb3f2f7d72e188e0126afd89b/bin/libgettextsrc-0-18-3.dll -------------------------------------------------------------------------------- /bin/libgmp-10.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lauryndbrown/Cisp/9364c7392ff903bbb3f2f7d72e188e0126afd89b/bin/libgmp-10.dll -------------------------------------------------------------------------------- /bin/libgmpxx-4.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lauryndbrown/Cisp/9364c7392ff903bbb3f2f7d72e188e0126afd89b/bin/libgmpxx-4.dll -------------------------------------------------------------------------------- /bin/libgomp-1.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lauryndbrown/Cisp/9364c7392ff903bbb3f2f7d72e188e0126afd89b/bin/libgomp-1.dll -------------------------------------------------------------------------------- /bin/libiconv-2.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lauryndbrown/Cisp/9364c7392ff903bbb3f2f7d72e188e0126afd89b/bin/libiconv-2.dll -------------------------------------------------------------------------------- /bin/libintl-8.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lauryndbrown/Cisp/9364c7392ff903bbb3f2f7d72e188e0126afd89b/bin/libintl-8.dll -------------------------------------------------------------------------------- /bin/libmpc-3.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lauryndbrown/Cisp/9364c7392ff903bbb3f2f7d72e188e0126afd89b/bin/libmpc-3.dll -------------------------------------------------------------------------------- /bin/libmpfr-4.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lauryndbrown/Cisp/9364c7392ff903bbb3f2f7d72e188e0126afd89b/bin/libmpfr-4.dll -------------------------------------------------------------------------------- /bin/libquadmath-0.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lauryndbrown/Cisp/9364c7392ff903bbb3f2f7d72e188e0126afd89b/bin/libquadmath-0.dll -------------------------------------------------------------------------------- /bin/libssp-0.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lauryndbrown/Cisp/9364c7392ff903bbb3f2f7d72e188e0126afd89b/bin/libssp-0.dll -------------------------------------------------------------------------------- /bin/libstdc++-6.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lauryndbrown/Cisp/9364c7392ff903bbb3f2f7d72e188e0126afd89b/bin/libstdc++-6.dll -------------------------------------------------------------------------------- /bin/lisp.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lauryndbrown/Cisp/9364c7392ff903bbb3f2f7d72e188e0126afd89b/bin/lisp.dll -------------------------------------------------------------------------------- /bin/logger.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lauryndbrown/Cisp/9364c7392ff903bbb3f2f7d72e188e0126afd89b/bin/logger.dll -------------------------------------------------------------------------------- /bin/mingwm10.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lauryndbrown/Cisp/9364c7392ff903bbb3f2f7d72e188e0126afd89b/bin/mingwm10.dll -------------------------------------------------------------------------------- /bin/pdcurses.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lauryndbrown/Cisp/9364c7392ff903bbb3f2f7d72e188e0126afd89b/bin/pdcurses.dll -------------------------------------------------------------------------------- /bin/pthreadGC-3.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lauryndbrown/Cisp/9364c7392ff903bbb3f2f7d72e188e0126afd89b/bin/pthreadGC-3.dll -------------------------------------------------------------------------------- /bin/recursion.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lauryndbrown/Cisp/9364c7392ff903bbb3f2f7d72e188e0126afd89b/bin/recursion.dll -------------------------------------------------------------------------------- /bin/tokenizer.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lauryndbrown/Cisp/9364c7392ff903bbb3f2f7d72e188e0126afd89b/bin/tokenizer.dll -------------------------------------------------------------------------------- /bin/zlib1.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lauryndbrown/Cisp/9364c7392ff903bbb3f2f7d72e188e0126afd89b/bin/zlib1.dll -------------------------------------------------------------------------------- /cisp-error.cbl: -------------------------------------------------------------------------------- 1 | ****************************************************************** 2 | * Author: 3 | * Date: 4 | * Purpose: 5 | * Tectonics: cobc 6 | ****************************************************************** 7 | IDENTIFICATION DIVISION. 8 | PROGRAM-ID. CISP-ERROR. 9 | DATA DIVISION. 10 | FILE SECTION. 11 | WORKING-STORAGE SECTION. 12 | ***************************************** 13 | * WS Shared with LOGGER SubRoutine 14 | ***************************************** 15 | 01 WS-LOG-OPERATION-FLAG PIC X(5). 16 | 01 WS-LOG-RECORD. 17 | 02 WS-LOG-RECORD-FUNCTION-NAME PIC X(40). 18 | 02 WS-LOG-RECORD-MESSAGE PIC X(100). 19 | ***************************************** 20 | * WS Shared with RECUSRION SubRoutine 21 | ***************************************** 22 | 01 WS-RECURSION-FLAG PIC X(30). 23 | LINKAGE SECTION. 24 | 01 LS-CISP-ERROR-FLAG PIC X(30). 25 | 01 LS-ERROR. 26 | 02 LS-ERROR-NAME PIC X(40). 27 | 02 LS-ERROR-FATAL PIC X. 28 | 88 LS-ERROR-FATAL-YES VALUE 'Y', FALSE 'N'. 29 | 02 LS-ERROR-MESSAGE PIC X(100). 30 | PROCEDURE DIVISION USING LS-CISP-ERROR-FLAG, LS-ERROR. 31 | MAIN-PROCEDURE. 32 | EVALUATE LS-CISP-ERROR-FLAG 33 | WHEN "THROW-ERROR" 34 | PERFORM THROW-ERROR-PROCEDURE. 35 | THROW-ERROR-PROCEDURE. 36 | DISPLAY LS-ERROR-NAME. 37 | DISPLAY LS-ERROR-MESSAGE. 38 | IF LS-ERROR-FATAL-YES THEN 39 | PERFORM END-CISP-PROCEDURE 40 | END-IF. 41 | END-CISP-PROCEDURE. 42 | PERFORM LOG-ERROR-PROCEDURE. 43 | PERFORM CLOSE-OPEN-FILES-PROCEDURE. 44 | STOP RUN. 45 | LOG-ERROR-PROCEDURE. 46 | ******log error 47 | MOVE "ADD" TO WS-LOG-OPERATION-FLAG. 48 | MOVE "CISP-ERROR" TO 49 | WS-LOG-RECORD-FUNCTION-NAME. 50 | STRING LS-ERROR-NAME DELIMITED BY SIZE 51 | ":" DELIMITED BY SIZE 52 | LS-ERROR-MESSAGE DELIMITED BY SIZE 53 | "Fatal:" DELIMITED BY SIZE 54 | LS-ERROR-FATAL DELIMITED BY SIZE 55 | INTO WS-LOG-RECORD-MESSAGE. 56 | CALL 'LOGGER' USING WS-LOG-OPERATION-FLAG, WS-LOG-RECORD. 57 | CLOSE-OPEN-FILES-PROCEDURE. 58 | MOVE "STACK-FILE-STATUS" TO WS-RECURSION-FLAG. 59 | CALL "RECURSION" USING WS-RECURSION-FLAG. 60 | DISPLAY "RECURSION:" WS-RECURSION-FLAG. 61 | IF WS-RECURSION-FLAG = "Y" THEN 62 | MOVE "CLOSE" TO WS-RECURSION-FLAG 63 | CALL "RECURSION" USING WS-RECURSION-FLAG 64 | END-IF. 65 | MOVE "CLOSE" TO WS-LOG-OPERATION-FLAG. 66 | CALL 'LOGGER' USING WS-LOG-OPERATION-FLAG, WS-LOG-RECORD. 67 | END PROGRAM CISP-ERROR. 68 | -------------------------------------------------------------------------------- /cisp.cbl: -------------------------------------------------------------------------------- 1 | ****************************************************************** 2 | * Author: Lauryn Brown 3 | * Date: 2017 4 | * Purpose: COBOL Common Lisp Interpreter 5 | * Tectonics: cobc 6 | ****************************************************************** 7 | IDENTIFICATION DIVISION. 8 | PROGRAM-ID. CISP. 9 | ENVIRONMENT DIVISION. 10 | INPUT-OUTPUT SECTION. 11 | FILE-CONTROL. 12 | SELECT TESTS-FILE ASSIGN TO "..\test\tests-lists.txt" 13 | ORGANIZATION IS LINE SEQUENTIAL. 14 | DATA DIVISION. 15 | FILE SECTION. 16 | FD TESTS-FILE. 17 | 01 LISP-TEST-FILE-NAME PIC X(100). 18 | WORKING-STORAGE SECTION. 19 | 01 WS-CMD-LINE. 20 | 02 WS-CMD-LINE-VAL PIC X(100). 21 | 02 WS-CMD-LINE-NUM-AGRS PIC 9(4). 22 | ***************************************** 23 | * WS Shared with LOGGER SubRoutine 24 | ***************************************** 25 | 01 WS-LOG-OPERATION-FLAG PIC X(5). 26 | 01 WS-LOG-RECORD. 27 | 02 WS-LOG-RECORD-FUNCTION-NAME PIC X(40). 28 | 02 WS-LOG-RECORD-MESSAGE PIC X(100). 29 | ***************************************** 30 | * WS Shared with TOKENIZER, LISP SubRoutine 31 | ***************************************** 32 | *****IF WS-SYMBOL-LENGTH CHANGED HERE PLEASE CHANGE IN TOKENIZER, LISP 33 | 01 WS-LISP-FILE-NAME PIC X(100). 34 | 78 WS-SYMBOL-LENGTH VALUE 100. 35 | 01 WS-LISP-SYMBOLS. 36 | 02 WS-SYMBOL-TABLE-SIZE PIC 9(4). 37 | 02 WS-SYMBOL PIC X(50) OCCURS WS-SYMBOL-LENGTH TIMES. 38 | 02 WS-SYMBOL-LEN PIC 9(2) OCCURS WS-SYMBOL-LENGTH TIMES. 39 | PROCEDURE DIVISION. 40 | MAIN-PROCEDURE. 41 | PERFORM INIT-LOGGER-PROCEDURE. 42 | PERFORM READ-CMD-LINE-PROCEDURE. 43 | PERFORM TOKENIZE-LISP-PROCEDURE. 44 | PERFORM EVALUTE-LISP-PROCEDURE. 45 | PERFORM CLOSE-LOGGER-PROCEDURE. 46 | GOBACK. 47 | READ-CMD-LINE-PROCEDURE. 48 | ********* Read the lisp file name and save to working storage 49 | ACCEPT WS-CMD-LINE-NUM-AGRS FROM ARGUMENT-NUMBER. 50 | ACCEPT WS-CMD-LINE-VAL FROM ARGUMENT-VALUE. 51 | MOVE WS-CMD-LINE-VAL TO WS-LISP-FILE-NAME. 52 | MOVE "ADD" TO WS-LOG-OPERATION-FLAG. 53 | MOVE "CISP:READ-CMD-LINE-PROCEDURE" 54 | TO WS-LOG-RECORD-FUNCTION-NAME. 55 | MOVE "Reading commandline argument" TO WS-LOG-RECORD-MESSAGE. 56 | CALL 'LOGGER' USING WS-LOG-OPERATION-FLAG, WS-LOG-RECORD. 57 | TOKENIZE-LISP-PROCEDURE. 58 | ********* Tokenize the Lisp string 59 | MOVE "ADD" TO WS-LOG-OPERATION-FLAG. 60 | MOVE "TOKENIZER" TO WS-LOG-RECORD-FUNCTION-NAME. 61 | MOVE "Starting Tokenizer" TO WS-LOG-RECORD-MESSAGE. 62 | CALL 'LOGGER' USING WS-LOG-OPERATION-FLAG, WS-LOG-RECORD. 63 | CALL "TOKENIZER" USING WS-LISP-FILE-NAME, 64 | WS-SYMBOL-LENGTH, WS-LISP-SYMBOLS. 65 | EVALUTE-LISP-PROCEDURE. 66 | ********* Evalute lisp 67 | MOVE "ADD" TO WS-LOG-OPERATION-FLAG. 68 | MOVE "LISP" TO WS-LOG-RECORD-FUNCTION-NAME. 69 | MOVE "Starting Lisp Evalutation" TO WS-LOG-RECORD-MESSAGE. 70 | CALL 'LOGGER' USING WS-LOG-OPERATION-FLAG, WS-LOG-RECORD. 71 | CALL "LISP" USING WS-LISP-SYMBOLS. 72 | INIT-LOGGER-PROCEDURE. 73 | MOVE "OPEN" TO WS-LOG-OPERATION-FLAG. 74 | CALL 'LOGGER' USING WS-LOG-OPERATION-FLAG, WS-LOG-RECORD. 75 | CLOSE-LOGGER-PROCEDURE. 76 | MOVE "CLOSE" TO WS-LOG-OPERATION-FLAG. 77 | CALL 'LOGGER' USING WS-LOG-OPERATION-FLAG, WS-LOG-RECORD. 78 | END PROGRAM CISP. 79 | -------------------------------------------------------------------------------- /lisp.cbl: -------------------------------------------------------------------------------- 1 | ****************************************************************** 2 | * Author: Lauryn Brown 3 | * Date: 4 | * Purpose: Evalute tokenized lisp 5 | * Tectonics: cobc 6 | ****************************************************************** 7 | IDENTIFICATION DIVISION. 8 | PROGRAM-ID. LISP. 9 | DATA DIVISION. 10 | FILE SECTION. 11 | WORKING-STORAGE SECTION. 12 | 01 WS-SYMBOL-TABLE-INDEX PIC 9(4). 13 | 01 WS-CURR-COMMAND PIC X(20). 14 | 01 WS-CURRENT-VALUE PIC X(20). 15 | 01 WS-CURRENT-VALUE-NUMERIC 16 | REDEFINES WS-CURRENT-VALUE PIC 9(20). 17 | 01 WS-INIT-COMMAND PIC X. 18 | 88 WS-INIT-COMMAND-YES VALUE "Y", FALSE 'N'. 19 | ***************************************** 20 | * WS Shared with CISP-ERROR SubRoutine 21 | ***************************************** 22 | 01 WS-CISP-ERROR-FLAG PIC X(30). 23 | 01 WS-ERROR. 24 | 02 WS-ERROR-NAME PIC X(40). 25 | 02 WS-ERROR-FATAL PIC X. 26 | 88 WS-ERROR-FATAL-YES VALUE 'Y', FALSE 'N'. 27 | 02 WS-ERROR-MESSAGE PIC X(100). 28 | ***************************************** 29 | * WS Shared with LOGGER SubRoutine 30 | ***************************************** 31 | 01 WS-LOG-OPERATION-FLAG PIC X(5). 32 | 01 WS-LOG-RECORD. 33 | 02 WS-LOG-RECORD-FUNCTION-NAME PIC X(40). 34 | 02 WS-LOG-RECORD-MESSAGE PIC X(100). 35 | ***************************************** 36 | * WS Shared with RECUSRION SubRoutine 37 | ***************************************** 38 | 01 WS-RECURSION-FLAG PIC X(30). 39 | 01 WS-RECURSION-OBJECT. 40 | 02 WS-COMMAND-NAME PIC X(20). 41 | 02 WS-COMMAND-RESULT PIC X(20). 42 | 02 WS-COMMAND-RESULT-NUMERIC 43 | REDEFINES WS-COMMAND-RESULT PIC 9(20). 44 | 02 WS-COMMAND-RETURNS-RESULT PIC X. 45 | 88 WS-COMMAND-RETURNS-RESULT-YES VALUE 'Y', FALSE 'N'. 46 | LINKAGE SECTION. 47 | 01 LS-LISP-SYMBOLS. 48 | 02 LS-SYMBOL-TABLE-SIZE PIC 9(4). 49 | 02 LS-SYMBOL PIC X(50) OCCURS 100 TIMES. 50 | 02 LS-SYMBOL-LEN PIC 9(2) OCCURS 100 TIMES. 51 | PROCEDURE DIVISION USING LS-LISP-SYMBOLS. 52 | MAIN-PROCEDURE. 53 | PERFORM INIT-CALL-STACK-PROCEDURE. 54 | ********* EVALUTE LISP 55 | PERFORM VARYING WS-SYMBOL-TABLE-INDEX FROM 1 BY 1 UNTIL 56 | WS-SYMBOL-TABLE-INDEX > LS-SYMBOL-TABLE-SIZE 57 | EVALUATE LS-SYMBOL(WS-SYMBOL-TABLE-INDEX) 58 | WHEN "(" 59 | SET WS-INIT-COMMAND-YES TO TRUE 60 | WHEN ")" 61 | PERFORM LOG-COMMAND-EVALUTATION 62 | PERFORM RETURN-PROCEDURE 63 | WHEN OTHER 64 | MOVE LS-SYMBOL(WS-SYMBOL-TABLE-INDEX) 65 | TO WS-CURR-COMMAND 66 | PERFORM LOG-CURRENT-COMMAND-PROCEDURE 67 | D PERFORM DEBUG-LISP 68 | IF WS-INIT-COMMAND-YES THEN 69 | PERFORM INIT-RECURSION-OBJECT-PROCEDURE 70 | ELSE 71 | PERFORM EVALUATE-CURRENT-COMMAND 72 | END-IF 73 | END-EVALUATE 74 | END-PERFORM. 75 | PERFORM CLOSE-CALL-STACK-PROCEDURE. 76 | GOBACK. 77 | INIT-CALL-STACK-PROCEDURE. 78 | *********Initialize Call stack for Recursion 79 | MOVE "INIT" TO WS-RECURSION-FLAG. 80 | CALL "RECURSION" USING WS-RECURSION-FLAG. 81 | INIT-RECURSION-OBJECT-PROCEDURE. 82 | 83 | IF WS-COMMAND-NAME = SPACES THEN 84 | MOVE WS-CURR-COMMAND TO WS-COMMAND-NAME 85 | ELSE 86 | *****Recursion detected saving current state to the stack 87 | MOVE "ADD-TO-CALL-STACK" TO WS-RECURSION-FLAG 88 | CALL "RECURSION" USING WS-RECURSION-FLAG, 89 | WS-RECURSION-OBJECT 90 | D DISPLAY "INIT-CALL-STACK-PROCEDURE: " WS-RECURSION-OBJECT 91 | ******Add the next command to the recursion OBJECT 92 | MOVE WS-CURR-COMMAND TO WS-COMMAND-NAME 93 | MOVE SPACES TO WS-COMMAND-RESULT 94 | D DISPLAY "New saved temp OBJECT:" WS-COMMAND-NAME 95 | D Display " " 96 | END-IF. 97 | SET WS-INIT-COMMAND-YES TO FALSE. 98 | RETURN-PROCEDURE. 99 | MOVE "IS-EMPTY" TO WS-RECURSION-FLAG. 100 | CALL "RECURSION" USING WS-RECURSION-FLAG. 101 | D DISPLAY "RETURN-PROCEDURE: " WS-RECURSION-FLAG. 102 | IF NOT WS-RECURSION-FLAG = "STACK-EMPTY" THEN 103 | MOVE WS-COMMAND-RESULT TO WS-CURRENT-VALUE 104 | D display WS-RECURSION-OBJECT 105 | PERFORM POP-CALL-STACK 106 | D DISPLAY "After POP-CALL-STACK:" WS-RECURSION-OBJECT 107 | MOVE WS-COMMAND-NAME TO WS-CURR-COMMAND 108 | PERFORM EVALUATE-CURRENT-COMMAND 109 | ELSE 110 | MOVE SPACES TO WS-COMMAND-NAME 111 | END-IF. 112 | D display " ". 113 | PRINT-CALL-STACK. 114 | MOVE "PRINT-CALL-STACK" TO WS-RECURSION-FLAG. 115 | CALL "RECURSION" USING WS-RECURSION-FLAG. 116 | DEBUG-LISP. 117 | DISPLAY "WS-CURR-COMMAND:" WS-CURR-COMMAND. 118 | DISPLAY " WS-CURRENT-VALUE:" WS-CURRENT-VALUE. 119 | DISPLAY " WS-COMMAND-NAME:" WS-COMMAND-NAME. 120 | DISPLAY " WS-COMMAND-RESULT:" WS-COMMAND-RESULT. 121 | DISPLAY " ". 122 | POP-CALL-STACK. 123 | D DISPLAY "POP-CALL-STACK:" WS-RECURSION-OBJECT. 124 | MOVE "POP-CALL-STACK" TO WS-RECURSION-FLAG. 125 | CALL "RECURSION" USING WS-RECURSION-FLAG, 126 | WS-RECURSION-OBJECT. 127 | CLOSE-CALL-STACK-PROCEDURE. 128 | MOVE "CLOSE" TO WS-RECURSION-FLAG. 129 | CALL "RECURSION" USING WS-RECURSION-FLAG. 130 | LOG-CURRENT-COMMAND-PROCEDURE. 131 | ******log Current Command To be Executed 132 | MOVE "ADD" TO WS-LOG-OPERATION-FLAG. 133 | MOVE "LISP" TO 134 | WS-LOG-RECORD-FUNCTION-NAME. 135 | STRING 'Command:' DELIMITED BY SIZE 136 | WS-CURR-COMMAND DELIMITED BY SIZE 137 | INTO WS-LOG-RECORD-MESSAGE 138 | CALL 'LOGGER' USING WS-LOG-OPERATION-FLAG, WS-LOG-RECORD. 139 | EVALUATE-CURRENT-COMMAND. 140 | EVALUATE WS-CURR-COMMAND 141 | WHEN "print" 142 | D DISPLAY "print" 143 | PERFORM LISP-PRINT-PROCEDURE 144 | WHEN "+" 145 | D DISPLAY "add" 146 | PERFORM LISP-ADD-PROCEDURE 147 | WHEN OTHER 148 | PERFORM EVALUATE-CURRENT-VALUES. 149 | EVALUATE-CURRENT-VALUES. 150 | ************ Evalute values 151 | IF WS-CURR-COMMAND(1:LS-SYMBOL-LEN(WS-SYMBOL-TABLE-INDEX)) 152 | IS NUMERIC THEN 153 | MOVE WS-CURR-COMMAND TO WS-CURRENT-VALUE-NUMERIC 154 | ELSE IF WS-CURR-COMMAND(1:1) = '"' 155 | AND WS-CURR-COMMAND(LS-SYMBOL-LEN(WS-SYMBOL-TABLE-INDEX):1) 156 | EQUALS '"' THEN 157 | MOVE WS-CURR-COMMAND TO WS-CURRENT-VALUE 158 | ELSE 159 | *****Command or value not interpreted. 160 | *****Throw an error and stop run 161 | MOVE "THROW-ERROR" TO WS-CISP-ERROR-FLAG 162 | MOVE "LISP FORMAT ERROR:" TO WS-ERROR-NAME 163 | STRING WS-CURR-COMMAND DELIMITED BY SPACE 164 | " COULD NOT BE INTERPRETED." DELIMITED BY SIZE 165 | INTO WS-ERROR-MESSAGE 166 | SET WS-ERROR-FATAL-YES TO TRUE 167 | CALL "CISP-ERROR" USING WS-CISP-ERROR-FLAG, WS-ERROR 168 | END-IF. 169 | PERFORM APPLY-VALUE-TO-EXPRESSION. 170 | APPLY-VALUE-TO-EXPRESSION. 171 | MOVE WS-COMMAND-NAME TO WS-CURR-COMMAND. 172 | PERFORM EVALUATE-CURRENT-COMMAND. 173 | D DISPLAY "APPLY-VALUE-TO-EXPRESSION". 174 | LISP-PRINT-PROCEDURE. 175 | D DISPLAY "LISP-PRINT-PROCEDURE" 176 | MOVE WS-CURRENT-VALUE TO WS-COMMAND-RESULT. 177 | DISPLAY WS-COMMAND-RESULT. 178 | LISP-ADD-PROCEDURE. 179 | IF WS-COMMAND-RESULT-NUMERIC EQUALS SPACES THEN 180 | MOVE 0 TO WS-COMMAND-RESULT-NUMERIC 181 | END-IF. 182 | ADD WS-CURRENT-VALUE-NUMERIC TO WS-COMMAND-RESULT-NUMERIC. 183 | LOG-COMMAND-EVALUTATION. 184 | MOVE "ADD" TO WS-LOG-OPERATION-FLAG. 185 | STRING "LISP:" DELIMITED BY SIZE 186 | WS-CURR-COMMAND INTO 187 | WS-LOG-RECORD-FUNCTION-NAME. 188 | STRING 'Result:' DELIMITED BY SIZE 189 | WS-COMMAND-RESULT DELIMITED BY SIZE 190 | INTO WS-LOG-RECORD-MESSAGE 191 | CALL 'LOGGER' USING WS-LOG-OPERATION-FLAG, WS-LOG-RECORD. 192 | END PROGRAM LISP. 193 | -------------------------------------------------------------------------------- /logger.cbl: -------------------------------------------------------------------------------- 1 | ****************************************************************** 2 | * Author: Lauryn Brown 3 | * Date: 4 | * Purpose: log activity done by other programs 5 | * Tectonics: cobc 6 | ****************************************************************** 7 | IDENTIFICATION DIVISION. 8 | PROGRAM-ID. LOGGER. 9 | ENVIRONMENT DIVISION. 10 | INPUT-OUTPUT SECTION. 11 | FILE-CONTROL. 12 | SELECT OPTIONAL LOG-FILE ASSIGN TO DYNAMIC WS-LOG-FILE-NAME 13 | ORGANISATION IS LINE SEQUENTIAL. 14 | DATA DIVISION. 15 | FILE SECTION. 16 | FD LOG-FILE. 17 | 01 LOG-RECORD. 18 | 02 LOG-RECORD-ID PIC 9(10). 19 | 02 LOG-RECORD-FUNCTION-NAME PIC X(40). 20 | 02 LOG-RECORD-MESSAGE PIC X(100). 21 | WORKING-STORAGE SECTION. 22 | 01 WS-LOG-FILE-NAME PIC X(20). 23 | LINKAGE SECTION. 24 | 01 LS-LOG-OPERATION-FLAG PIC X(5). 25 | 01 LS-LOG-RECORD. 26 | 02 LS-LOG-RECORD-FUNCTION-NAME PIC X(40). 27 | 02 LS-LOG-RECORD-MESSAGE PIC X(100). 28 | PROCEDURE DIVISION USING LS-LOG-OPERATION-FLAG, LS-LOG-RECORD. 29 | MAIN-PROCEDURE. 30 | EVALUATE LS-LOG-OPERATION-FLAG 31 | WHEN "OPEN" 32 | PERFORM LOG-INIT-PROCEDURE 33 | WHEN "CLOSE" 34 | PERFORM LOG-CLOSE-PROCEDURE 35 | WHEN "ADD" 36 | PERFORM LOG-WRITE-TO-PROCEDURE 37 | WHEN OTHER 38 | PERFORM LOG-FLAG-ERROR-PROCEDURE. 39 | GOBACK. 40 | LOG-INIT-PROCEDURE. 41 | MOVE '..\logs\log.data' TO WS-LOG-FILE-NAME. 42 | OPEN OUTPUT LOG-FILE. 43 | MOVE 1 TO LOG-RECORD-ID. 44 | MOVE "LOG-INIT-PROCEDURE" TO LOG-RECORD-FUNCTION-NAME. 45 | MOVE "Starting Program!" TO LOG-RECORD-MESSAGE. 46 | WRITE LOG-RECORD. 47 | LOG-WRITE-TO-PROCEDURE. 48 | ADD 1 TO LOG-RECORD-ID. 49 | MOVE LS-LOG-RECORD-FUNCTION-NAME TO LOG-RECORD-FUNCTION-NAME. 50 | MOVE LS-LOG-RECORD-MESSAGE TO LOG-RECORD-MESSAGE. 51 | WRITE LOG-RECORD. 52 | LOG-FLAG-ERROR-PROCEDURE. 53 | DISPLAY "READ FLAG ERROR". 54 | LOG-CLOSE-PROCEDURE. 55 | ADD 1 TO LOG-RECORD-ID. 56 | MOVE "LOGGER:LOG-CLOSE-PROCEDURE" 57 | TO LOG-RECORD-FUNCTION-NAME. 58 | MOVE "Closed logging file" TO LOG-RECORD-MESSAGE. 59 | WRITE LOG-RECORD. 60 | CLOSE LOG-FILE. 61 | END PROGRAM LOGGER. 62 | -------------------------------------------------------------------------------- /logs/log.data: -------------------------------------------------------------------------------- 1 | 0000000001LOG-INIT-PROCEDURE Starting Program! 2 | 0000000002CISP:READ-CMD-LINE-PROCEDURE Reading commandline argument 3 | 0000000003TOKENIZER Starting Tokenizer 4 | 0000000004TOKENIZER:FILE-HANDLING-PROCEDURE COMPLETED reading LISP-FILE 5 | 0000000005TOKENIZER:FORMAT-LISP-PROCEDURE COMPLETED formatting lisp string for parsing 6 | 0000000006TOKENIZER:TOKENIZE-LISP-PROCEDURE COMPLETED tokenizing lisp 7 | 0000000007LISP Starting Lisp Evalutation 8 | 0000000008RECURSION:INIT Initialized Call Stack 9 | 0000000009LISP Command:print 10 | 0000000010LISP Command:"hello" 11 | 0000000011LISP:print Result:"hello" 12 | 0000000012RECURSION:IS-EMPTY-CALL-STACK Y 13 | 0000000013RECURSION:CLOSE-CALL-STACK Closed call-stack file 14 | 0000000014LOGGER:LOG-CLOSE-PROCEDURE Closed logging file 15 | -------------------------------------------------------------------------------- /recursion.cbl: -------------------------------------------------------------------------------- 1 | ****************************************************************** 2 | * Author: 3 | * Date: 4 | * Purpose: 5 | * Tectonics: cobc 6 | ****************************************************************** 7 | IDENTIFICATION DIVISION. 8 | PROGRAM-ID. RECURSION. 9 | ENVIRONMENT DIVISION. 10 | INPUT-OUTPUT SECTION. 11 | FILE-CONTROL. 12 | SELECT OPTIONAL CALL-STACK ASSIGN TO "stack.dat" 13 | ORGANIZATION IS INDEXED 14 | ACCESS IS RANDOM 15 | RECORD KEY IS COMMAND-ID. 16 | DATA DIVISION. 17 | FILE SECTION. 18 | FD CALL-STACK. 19 | 01 CALL-STACK-FILE. 20 | 02 COMMAND-ID PIC 9(5). 21 | 02 COMMAND-NAME PIC X(20). 22 | 02 COMMAND-RESULT PIC X(20). 23 | 02 COMMAND-RESULT-NUMERIC 24 | REDEFINES COMMAND-RESULT PIC 9(20). 25 | 02 COMMAND-RETURN-ID PIC 9(5). 26 | 02 COMMAND-RETURNS-RESULT PIC X. 27 | 88 COMMAND-RETURNS-RESULT-YES VALUE 'Y', FALSE 'N'. 28 | WORKING-STORAGE SECTION. 29 | 01 WS-CALL-STACK-FILE-STATUS PIC X. 30 | 88 WS-CALL-STACK-FILE-STATUS-OPEN VALUE 'Y', FALSE 'N'. 31 | 01 WS-CALL-STACK. 32 | 02 WS-COMMAND-ID PIC 9(5). 33 | 02 WS-COMMAND-NAME PIC X(20). 34 | 02 WS-COMMAND-RESULT PIC X(20). 35 | 02 WS-COMMAND-RESULT-NUMERIC 36 | REDEFINES WS-COMMAND-RESULT PIC 9(20). 37 | 02 WS-COMMAND-RETURN-ID PIC 9(5). 38 | 02 WS-COMMAND-RETURN-VALUE PIC X(20). 39 | 02 WS-COMMAND-RETURNS-RESULT PIC X. 40 | 88 WS-COMMAND-RETURNS-RESULT-YES VALUE 'Y', FALSE 'N'. 41 | 01 WS-CALL-STACK-EOF PIC A(1). 42 | 01 WS-CALL-STACK-NEXT-ID PIC 9(5). 43 | 01 WS-IS-LAST-EXPRESSION PIC X. 44 | 88 WS-IS-LAST-EXPRESSION-YES VALUE 'Y', FALSE 'N'. 45 | 01 WS-RETURN. 46 | 02 WS-RETURN-VALUE PIC X(20). 47 | 02 WS-RETURN-VALUE-NUMERIC PIC 9(20). 48 | 01 WS-STACK-STATUS. 49 | 02 WS-LAST-ID PIC 9(5). 50 | 02 WS-OLDEST-ID PIC 9(5). 51 | 02 WS-STACK-IS-EMPTY PIC X. 52 | 88 WS-STACK-IS-EMPTY-YES VALUE 'Y', FALSE 'N'. 53 | ***************************************** 54 | * WS Shared with LOGGER SubRoutine 55 | ***************************************** 56 | 01 WS-LOG-OPERATION-FLAG PIC X(5). 57 | 01 WS-LOG-RECORD. 58 | 02 WS-LOG-RECORD-FUNCTION-NAME PIC X(40). 59 | 02 WS-LOG-RECORD-MESSAGE PIC X(100). 60 | LINKAGE SECTION. 61 | 01 LS-RECURSION-FLAG PIC X(30). 62 | 01 LS-RECURSION-OBJECT. 63 | 02 LS-COMMAND-NAME PIC X(20). 64 | 02 LS-COMMAND-RESULT PIC X(20). 65 | 02 LS-COMMAND-RESULT-NUMERIC 66 | REDEFINES LS-COMMAND-RESULT PIC 9(20). 67 | 02 LS-COMMAND-RETURNS-RESULT PIC X. 68 | 88 LS-COMMAND-RETURNS-RESULT-YES VALUE 'Y', FALSE 'N'. 69 | PROCEDURE DIVISION USING LS-RECURSION-FLAG, LS-RECURSION-OBJECT. 70 | MAIN-PROCEDURE. 71 | EVALUATE LS-RECURSION-FLAG 72 | WHEN "INIT" 73 | PERFORM INIT-CALL-STACK-PROCEDURE 74 | PERFORM LOG-INIT-CALL-STACK 75 | WHEN "ADD-TO-CALL-STACK" 76 | PERFORM CALL-STACK-ADD-PROCEDURE 77 | PERFORM LOG-ADD-TO-CALL-STACK 78 | WHEN "PEEK" 79 | PERFORM CALL-STACK-GET-TOP-PROCEDURE 80 | PERFORM LOG-PEEK-CALL-STACK 81 | WHEN "POP-CALL-STACK" 82 | PERFORM LOG-POP-FROM-CALL-STACK 83 | PERFORM POP-CALL-STACK-PROCEDURE 84 | WHEN "IS-EMPTY" 85 | PERFORM IS-STACK-EMPTY-PROCEDURE 86 | PERFORM LOG-IS-EMPTY-CALL-STACK 87 | WHEN "PRINT-CALL-STACK" 88 | PERFORM PRINT-CALL-STACK-PROCEDURE 89 | WHEN "CLOSE" 90 | PERFORM CLOSE-CALL-STACK-PROCEDURE 91 | PERFORM LOG-CLOSE-CALL-STACK 92 | WHEN "STACK-FILE-STATUS" 93 | PERFORM CHECK-FILE-STATUS-PROCEDURE. 94 | GOBACK. 95 | LOG-INIT-CALL-STACK. 96 | MOVE "ADD" TO WS-LOG-OPERATION-FLAG. 97 | MOVE "RECURSION:INIT" TO WS-LOG-RECORD-FUNCTION-NAME. 98 | MOVE "Initialized Call Stack" TO WS-LOG-RECORD-MESSAGE. 99 | CALL 'LOGGER' USING WS-LOG-OPERATION-FLAG, WS-LOG-RECORD. 100 | LOG-ADD-TO-CALL-STACK. 101 | *******logging Adding to CALL-STACK 102 | MOVE 'RECURSION:ADD-TO-CALL-STACK' 103 | TO WS-LOG-RECORD-FUNCTION-NAME. 104 | STRING COMMAND-ID DELIMITED BY SIZE 105 | COMMAND-NAME DELIMITED BY SIZE 106 | COMMAND-RETURN-ID DELIMITED BY SIZE 107 | INTO WS-LOG-RECORD-MESSAGE. 108 | MOVE "ADD" TO WS-LOG-OPERATION-FLAG. 109 | CALL 'LOGGER' USING WS-LOG-OPERATION-FLAG, WS-LOG-RECORD. 110 | LOG-PEEK-CALL-STACK. 111 | *******logging Adding to CALL-STACK 112 | MOVE 'RECURSION:GET-TOP-CALL-STACK' 113 | TO WS-LOG-RECORD-FUNCTION-NAME. 114 | STRING COMMAND-ID DELIMITED BY SIZE 115 | COMMAND-NAME DELIMITED BY SIZE 116 | COMMAND-RETURN-ID DELIMITED BY SIZE 117 | INTO WS-LOG-RECORD-MESSAGE. 118 | MOVE "ADD" TO WS-LOG-OPERATION-FLAG. 119 | CALL 'LOGGER' USING WS-LOG-OPERATION-FLAG, WS-LOG-RECORD. 120 | LOG-POP-FROM-CALL-STACK. 121 | MOVE 'RECURSION:POP-CALL-STACK' 122 | TO WS-LOG-RECORD-FUNCTION-NAME. 123 | STRING COMMAND-ID DELIMITED BY SIZE 124 | COMMAND-NAME DELIMITED BY SIZE 125 | COMMAND-RETURN-ID DELIMITED BY SIZE 126 | INTO WS-LOG-RECORD-MESSAGE. 127 | MOVE "ADD" TO WS-LOG-OPERATION-FLAG. 128 | CALL 'LOGGER' USING WS-LOG-OPERATION-FLAG, WS-LOG-RECORD. 129 | LOG-IS-EMPTY-CALL-STACK. 130 | MOVE 'RECURSION:IS-EMPTY-CALL-STACK' 131 | TO WS-LOG-RECORD-FUNCTION-NAME. 132 | MOVE WS-STACK-IS-EMPTY TO WS-LOG-RECORD-MESSAGE. 133 | MOVE "ADD" TO WS-LOG-OPERATION-FLAG. 134 | CALL 'LOGGER' USING WS-LOG-OPERATION-FLAG, WS-LOG-RECORD. 135 | LOG-CLOSE-CALL-STACK. 136 | *******logging Adding to CALL-STACK 137 | MOVE 'RECURSION:CLOSE-CALL-STACK' 138 | TO WS-LOG-RECORD-FUNCTION-NAME. 139 | MOVE "Closed call-stack file" TO WS-LOG-RECORD-MESSAGE. 140 | MOVE "ADD" TO WS-LOG-OPERATION-FLAG. 141 | CALL 'LOGGER' USING WS-LOG-OPERATION-FLAG, WS-LOG-RECORD. 142 | LOG-DELETE-FROM-CALL-STACK. 143 | *******logging Deleting from CALL-STACK 144 | MOVE 'RECURSION:DELETE-FROM-CALL-STACK' 145 | TO WS-LOG-RECORD-FUNCTION-NAME. 146 | STRING COMMAND-ID DELIMITED BY SIZE 147 | COMMAND-NAME DELIMITED BY SIZE 148 | COMMAND-RETURN-ID DELIMITED BY SIZE 149 | INTO WS-LOG-RECORD-MESSAGE. 150 | MOVE "ADD" TO WS-LOG-OPERATION-FLAG. 151 | CALL 'LOGGER' USING WS-LOG-OPERATION-FLAG, WS-LOG-RECORD. 152 | INIT-CALL-STACK-PROCEDURE. 153 | * Preventing the error of something already being in the 154 | * stack file after a system crash 155 | OPEN OUTPUT CALL-STACK. 156 | CLOSE CALL-STACK. 157 | 158 | * Actually opening the call-stack for writing. 159 | OPEN I-O CALL-STACK. 160 | MOVE 1 TO WS-CALL-STACK-NEXT-ID. 161 | MOVE 1 TO WS-OLDEST-ID. 162 | MOVE 1 TO WS-LAST-ID. 163 | SET WS-STACK-IS-EMPTY-YES TO TRUE. 164 | SET WS-CALL-STACK-FILE-STATUS-OPEN TO TRUE. 165 | CLOSE-CALL-STACK-PROCEDURE. 166 | CLOSE CALL-STACK. 167 | DELETE FILE CALL-STACK. 168 | SET WS-CALL-STACK-FILE-STATUS-OPEN TO FALSE. 169 | CALL-STACK-ADD-PROCEDURE. 170 | MOVE WS-CALL-STACK-NEXT-ID TO COMMAND-ID. 171 | MOVE LS-COMMAND-NAME TO COMMAND-NAME. 172 | MOVE LS-COMMAND-RESULT TO COMMAND-RESULT. 173 | MOVE LS-COMMAND-RETURNS-RESULT TO COMMAND-RETURNS-RESULT. 174 | MOVE WS-LAST-ID TO COMMAND-RETURN-ID. 175 | WRITE CALL-STACK-FILE. 176 | IF WS-STACK-IS-EMPTY-YES THEN 177 | MOVE WS-CALL-STACK-NEXT-ID TO WS-OLDEST-ID 178 | SET WS-STACK-IS-EMPTY-YES TO FALSE 179 | END-IF. 180 | MOVE WS-CALL-STACK-NEXT-ID TO WS-LAST-ID. 181 | ADD 1 TO WS-CALL-STACK-NEXT-ID. 182 | PRINT-CALL-STACK-PROCEDURE. 183 | DISPLAY "PRINT-CALL-STACK-PROCEDURE". 184 | DISPLAY "ID " 185 | "NAME " 186 | "RESULT " "RESULT (NUMERIC) " 187 | " RETURN ID ". 188 | PERFORM VARYING COMMAND-ID FROM 1 BY 1 189 | UNTIL COMMAND-ID = WS-CALL-STACK-NEXT-ID 190 | READ CALL-STACK RECORD INTO WS-CALL-STACK 191 | KEY IS COMMAND-ID 192 | INVALID KEY DISPLAY "DELETED" 193 | END-READ 194 | DISPLAY WS-COMMAND-ID " " WS-COMMAND-NAME 195 | " " WS-COMMAND-RESULT " " WS-COMMAND-RESULT-NUMERIC " " 196 | WS-COMMAND-RETURN-ID " " WS-COMMAND-RETURN-VALUE " " 197 | WS-COMMAND-RETURNS-RESULT 198 | END-PERFORM. 199 | CALL-STACK-GET-TOP-PROCEDURE. 200 | MOVE WS-LAST-ID TO COMMAND-ID. 201 | READ CALL-STACK RECORD 202 | KEY IS COMMAND-ID 203 | END-READ. 204 | MOVE COMMAND-NAME TO LS-COMMAND-NAME. 205 | MOVE COMMAND-RESULT TO LS-COMMAND-RESULT. 206 | POP-CALL-STACK-PROCEDURE. 207 | MOVE WS-LAST-ID TO COMMAND-ID. 208 | D DISPLAY "FROM POP-CALL-STACK-PROCEDURE:" COMMAND-ID. 209 | 210 | READ CALL-STACK RECORD. 211 | MOVE COMMAND-NAME TO LS-COMMAND-NAME. 212 | MOVE COMMAND-RESULT TO LS-COMMAND-RESULT. 213 | MOVE COMMAND-RETURN-ID TO WS-LAST-ID. 214 | DELETE CALL-STACK RECORD. 215 | IF COMMAND-ID = WS-OLDEST-ID THEN 216 | SET WS-STACK-IS-EMPTY-YES TO TRUE 217 | END-IF. 218 | D DISPLAY "DELETED:" COMMAND-ID " GOTO:" WS-LAST-ID. 219 | DISPLAY " ". 220 | IS-STACK-EMPTY-PROCEDURE. 221 | IF WS-STACK-IS-EMPTY-YES THEN 222 | MOVE "STACK-EMPTY" TO LS-RECURSION-FLAG 223 | ELSE 224 | MOVE "NOT-EMPTY" TO LS-RECURSION-FLAG 225 | END-IF. 226 | CHECK-FILE-STATUS-PROCEDURE. 227 | MOVE WS-CALL-STACK-FILE-STATUS TO LS-RECURSION-FLAG. 228 | END PROGRAM RECURSION. 229 | -------------------------------------------------------------------------------- /test/addition/addition-2-numbers.lisp: -------------------------------------------------------------------------------- 1 | (print (+ 7 9)) 2 | -------------------------------------------------------------------------------- /test/addition/addition-3-numbers.lisp: -------------------------------------------------------------------------------- 1 | (print (+ 7 9 10)) 2 | -------------------------------------------------------------------------------- /test/addition/nested.lisp: -------------------------------------------------------------------------------- 1 | (print (+ 1 (+ 2 3 4))) 2 | -------------------------------------------------------------------------------- /test/comments/single-alpha-num.lisp: -------------------------------------------------------------------------------- 1 | ;;; Comment 2 | ;;; dsfjsdkfkhsd 3 | ;;; sdkfjdsljfsd 4 | (print "hello") 5 | -------------------------------------------------------------------------------- /test/demo/presentation-demo.lisp: -------------------------------------------------------------------------------- 1 | ;;; Cisp demo for presentation! 2 | ;;; Comemnts Work! Yay! 3 | (print "Hello!") 4 | (print "Numers:") (print 42) 5 | (print "Addition:") 6 | (print (+ 1 2 (+ 3 5 10 (+ 20 1)))) 7 | (print "Yay!") 8 | -------------------------------------------------------------------------------- /test/print/single-num-twice.lisp: -------------------------------------------------------------------------------- 1 | (print 25) (print 34) 2 | -------------------------------------------------------------------------------- /test/print/single-num.lisp: -------------------------------------------------------------------------------- 1 | (print 25) 2 | -------------------------------------------------------------------------------- /test/print/str-no-spaces.lisp: -------------------------------------------------------------------------------- 1 | (print "hello") 2 | -------------------------------------------------------------------------------- /tokenizer.cbl: -------------------------------------------------------------------------------- 1 | ****************************************************************** 2 | * Author: lauryn brown 3 | * Date: 4 | * Purpose: tokenize lisp input file 5 | * Tectonics: cobc 6 | ****************************************************************** 7 | IDENTIFICATION DIVISION. 8 | PROGRAM-ID. TOKENIZER. 9 | ENVIRONMENT DIVISION. 10 | INPUT-OUTPUT SECTION. 11 | FILE-CONTROL. 12 | SELECT LISP-FILE ASSIGN TO DYNAMIC WS-LISP-NAME 13 | ORGANISATION IS LINE SEQUENTIAL. 14 | DATA DIVISION. 15 | FILE SECTION. 16 | FD LISP-FILE. 17 | 01 IN-LISP-RECORD PIC X(200). 18 | WORKING-STORAGE SECTION. 19 | 01 WS-LISP-NAME PIC X(100). 20 | 01 WS-IN-LISP-RECORD PIC X(200). 21 | 01 WS-LISP-EOF PIC X. 22 | 78 WS-MAX-LISP-LENGTH VALUE 200. 23 | 01 WS-LISP-LENGTH PIC 9(10). 24 | 01 WS-CALC-LENGTH-STR PIC X(200). 25 | 01 WS-IS-COMMENT PIC X. 26 | 88 WS-IS-COMMENT-YES VALUE "Y", FALSE 'N'. 27 | 01 WS-FORMAT-LISP. 28 | 02 WS-NUM-LENGTH-ADD PIC 9(10). 29 | 02 WS-PAREN-RIGHT PIC X. 30 | 88 WS-PAREN-RIGHT-YES VALUE "Y", FALSE "N". 31 | 02 WS-PAREN-LEFT PIC X. 32 | 88 WS-PAREN-LEFT-YES VALUE "Y", FALSE "N". 33 | 02 WS-PAREN-TEMP-STR PIC X(2000). 34 | 02 WS-PAREN-TEMP-NUM PIC 9(10). 35 | 02 WS-WHICH-PAREN PIC X. 36 | 01 WS-FORMAT-STR-INDEX PIC 9(10). 37 | 01 WS-COUNT PIC 9(10). 38 | 01 STRING-PTR PIC 9(10). 39 | 01 WS-TEMP-NUM PIC 9(10). 40 | 01 WS-FLAG PIC A(1). 41 | 88 WS-FLAG-YES VALUE 'Y', FALSE 'N'. 42 | 01 WS-SYMBOL-FLAGS. 43 | 02 WS-OPEN-PAREN PIC X. 44 | 88 WS-OPEN-PAREN-YES VALUE 'Y', FALSE 'N'. 45 | 02 WS-CLOSE-PAREN PIC X. 46 | 88 WS-CLOSE-PAREN-YES VALUE 'Y', FALSE 'N'. 47 | 01 WS-PARSE-STR. 48 | 02 WS-PARSE-STR-INDEX PIC 9(5). 49 | 02 WS-PARSE-STR-END PIC X. 50 | 88 WS-PARSE-HAS-ENDED VALUE 'Y', FALSE 'N'. 51 | 02 WS-PARSE-STR-CHAR PIC X. 52 | 02 WS-PARSE-EXPRESSION-START PIC 9(5). 53 | 02 WS-PARSE-EXPRESSION-END PIC 9(5). 54 | 02 WS-PARSE-EXPRESSION-LEN PIC 9(5). 55 | ***************************************** 56 | * WS Shared with LOGGER SubRoutine 57 | ***************************************** 58 | 01 WS-LOG-OPERATION-FLAG PIC X(5). 59 | 01 WS-LOG-RECORD. 60 | 02 WS-LOG-RECORD-FUNCTION-NAME PIC X(40). 61 | 02 WS-LOG-RECORD-MESSAGE PIC X(100). 62 | LINKAGE SECTION. 63 | ********* Size of table must equal size specified in CISP 64 | 01 LS-LISP-FILE-NAME PIC X(100). 65 | 01 LS-SYMBOL-LENGTH PIC 9(4). 66 | 01 LS-LISP-SYMBOLS. 67 | 02 LS-SYMBOL-TABLE-SIZE PIC 9(4). 68 | 02 LS-SYMBOL PIC X(50) OCCURS 100 TIMES. 69 | 02 LS-SYMBOL-LEN PIC 9(2) OCCURS 100 TIMES. 70 | PROCEDURE DIVISION USING LS-LISP-FILE-NAME, 71 | LS-SYMBOL-LENGTH, LS-LISP-SYMBOLS. 72 | MAIN-PROCEDURE. 73 | 74 | ******** Open and read in the lisp file 75 | PERFORM FILE-HANDLING-PROCEDURE. 76 | D DISPLAY "AFTER FILE-HANDLING-PROCEDURE:" WS-IN-LISP-RECORD. 77 | ******* tokenize lisp and store in symbol table 78 | PERFORM TOKENIZE-LISP-PROCEDURE. 79 | PERFORM CAL-LENGTH-ALL-SYMBOLS. 80 | D PERFORM PRINT-SYMBOL-TABLE. 81 | GOBACK. 82 | CAL-LENGTH-ALL-SYMBOLS. 83 | PERFORM VARYING WS-COUNT FROM 1 BY 1 UNTIL WS-COUNT = 100 84 | PERFORM CALC-LENGTH-SYMBOL 85 | MOVE WS-PARSE-EXPRESSION-LEN TO LS-SYMBOL-LEN(WS-COUNT) 86 | END-PERFORM. 87 | CALC-LENGTH-SYMBOL. 88 | SET WS-PARSE-HAS-ENDED TO FALSE. 89 | MOVE 0 TO WS-PARSE-EXPRESSION-LEN. 90 | PERFORM VARYING WS-PARSE-STR-INDEX FROM 1 BY 1 UNTIL 91 | WS-PARSE-HAS-ENDED OR WS-PARSE-STR-INDEX > 100 92 | IF LS-SYMBOL(WS-COUNT)(WS-PARSE-STR-INDEX:1) = " " THEN 93 | SET WS-PARSE-HAS-ENDED TO TRUE 94 | ELSE 95 | ADD 1 TO WS-PARSE-EXPRESSION-LEN 96 | END-IF 97 | END-PERFORM. 98 | APPEND-LISP-PROCEDURE. 99 | D DISPLAY IN-LISP-RECORD. 100 | **********CALC IN-LISP-RECORD LENGTH 101 | MOVE IN-LISP-RECORD TO WS-CALC-LENGTH-STR 102 | PERFORM CALC-LISP-LENGTH 103 | IF NOT WS-IS-COMMENT-YES THEN 104 | IF WS-TEMP-NUM = 0 THEN 105 | MOVE IN-LISP-RECORD TO WS-IN-LISP-RECORD 106 | ELSE 107 | ADD 1 TO WS-TEMP-NUM 108 | STRING WS-IN-LISP-RECORD(1:WS-TEMP-NUM) 109 | DELIMITED BY SIZE 110 | IN-LISP-RECORD(1:WS-LISP-LENGTH) DELIMITED BY SIZE 111 | INTO WS-IN-LISP-RECORD 112 | SUBTRACT 1 FROM WS-TEMP-NUM 113 | END-IF 114 | ADD WS-LISP-LENGTH TO WS-TEMP-NUM 115 | END-IF. 116 | FILE-HANDLING-PROCEDURE. 117 | ***** Opens LISP-FILE for reading **************************** 118 | MOVE LS-LISP-FILE-NAME TO WS-LISP-NAME 119 | OPEN INPUT LISP-FILE. 120 | READ LISP-FILE 121 | AT END MOVE "Y" TO WS-LISP-EOF 122 | NOT AT END 123 | MOVE IN-LISP-RECORD TO WS-CALC-LENGTH-STR 124 | PERFORM CALC-LISP-LENGTH 125 | IF NOT WS-IS-COMMENT-YES THEN 126 | MOVE IN-LISP-RECORD TO WS-IN-LISP-RECORD 127 | MOVE WS-LISP-LENGTH TO WS-TEMP-NUM 128 | END-IF 129 | END-READ. 130 | PERFORM UNTIL WS-LISP-EOF="Y" 131 | READ LISP-FILE 132 | AT END MOVE "Y" TO WS-LISP-EOF 133 | NOT AT END PERFORM APPEND-LISP-PROCEDURE 134 | END-READ 135 | END-PERFORM. 136 | CLOSE LISP-FILE. 137 | ******LOG File Handling 138 | MOVE "ADD" TO WS-LOG-OPERATION-FLAG. 139 | MOVE "TOKENIZER:FILE-HANDLING-PROCEDURE" TO 140 | WS-LOG-RECORD-FUNCTION-NAME. 141 | MOVE "COMPLETED reading LISP-FILE" TO WS-LOG-RECORD-MESSAGE. 142 | CALL 'LOGGER' USING WS-LOG-OPERATION-FLAG, WS-LOG-RECORD. 143 | TOKENIZE-LISP-PROCEDURE. 144 | ******** Tokenizes the lisp file and stores it in the WS-SYMBOL Table 145 | PERFORM FORMAT-LISP-PROCEDURE. 146 | D DISPLAY "After FORMAT-LISP-PROCEDURE". 147 | D DISPLAY "TOKENIZE-LISP-PROCEDURE:" WS-IN-LISP-RECORD. 148 | MOVE 1 TO STRING-PTR. 149 | MOVE 0 TO LS-SYMBOL-TABLE-SIZE. 150 | SET WS-FLAG-YES TO FALSE. 151 | PERFORM VARYING WS-COUNT FROM 1 BY 1 UNTIL 152 | WS-COUNT = 100 OR WS-FLAG 153 | UNSTRING WS-IN-LISP-RECORD DELIMITED BY ALL ' ' INTO 154 | LS-SYMBOL(WS-COUNT) WITH POINTER STRING-PTR 155 | IF LS-SYMBOL(WS-COUNT) = SPACES THEN 156 | SET WS-FLAG-YES TO TRUE 157 | ELSE 158 | ADD 1 TO LS-SYMBOL-TABLE-SIZE 159 | END-IF 160 | END-PERFORM. 161 | *****LOG File Handling 162 | MOVE "ADD" TO WS-LOG-OPERATION-FLAG. 163 | MOVE "TOKENIZER:TOKENIZE-LISP-PROCEDURE" TO 164 | WS-LOG-RECORD-FUNCTION-NAME. 165 | MOVE "COMPLETED tokenizing lisp" TO WS-LOG-RECORD-MESSAGE. 166 | CALL 'LOGGER' USING WS-LOG-OPERATION-FLAG, WS-LOG-RECORD. 167 | PRINT-SYMBOL-TABLE. 168 | ******* Prints Tokenized lisp stored in WS-SYMBOL Table 169 | MOVE 1 TO WS-COUNT. 170 | PERFORM VARYING WS-COUNT FROM 1 BY 1 UNTIL 171 | WS-COUNT GREATER THAN LS-SYMBOL-TABLE-SIZE 172 | DISPLAY WS-COUNT 173 | DISPLAY LS-SYMBOL(WS-COUNT) 174 | DISPLAY LS-SYMBOL-LEN(WS-COUNT) 175 | END-PERFORM. 176 | FORMAT-LISP-PROCEDURE. 177 | ***** Calculates the length of the lisp program. 178 | ***** Adding additional spaces between parenthesis 179 | ***** for easier parsing. 180 | D DISPLAY "FORMAT-LISP-PROCEDURE:" WS-IN-LISP-RECORD. 181 | MOVE WS-IN-LISP-RECORD TO WS-CALC-LENGTH-STR. 182 | PERFORM CALC-LISP-LENGTH. 183 | MOVE 1 TO WS-FORMAT-STR-INDEX. 184 | IF WS-IN-LISP-RECORD(1:1)="(" 185 | AND NOT WS-IN-LISP-RECORD(2:1) EQUAL " " THEN 186 | MOVE WS-IN-LISP-RECORD TO WS-PAREN-TEMP-STR 187 | STRING "( " DELIMITED BY SIZE 188 | WS-PAREN-TEMP-STR(2:WS-LISP-LENGTH) DELIMITED BY 189 | SIZE INTO WS-IN-LISP-RECORD 190 | ADD 3 TO WS-FORMAT-STR-INDEX 191 | ADD 1 TO WS-LISP-LENGTH 192 | END-IF. 193 | PERFORM VARYING WS-FORMAT-STR-INDEX FROM WS-FORMAT-STR-INDEX 194 | BY 1 UNTIL WS-FORMAT-STR-INDEX > WS-LISP-LENGTH 195 | SET WS-PAREN-LEFT-YES TO FALSE 196 | SET WS-PAREN-RIGHT-YES TO FALSE 197 | MOVE WS-IN-LISP-RECORD TO WS-PAREN-TEMP-STR 198 | EVALUATE WS-IN-LISP-RECORD(WS-FORMAT-STR-INDEX:1) 199 | WHEN "(" 200 | PERFORM FORMAT-PAREN-SPACE-PROCEDURE 201 | WHEN ")" 202 | PERFORM FORMAT-PAREN-SPACE-PROCEDURE 203 | * WHEN ";" 204 | 205 | END-EVALUATE 206 | D DISPLAY WS-IN-LISP-RECORD(WS-FORMAT-STR-INDEX:1) 207 | D " left:" WS-PAREN-RIGHT " right:" WS-PAREN-LEFT 208 | END-PERFORM. 209 | ****** Log FORMAT-LISP-PROCEDURE Complete 210 | MOVE "ADD" TO WS-LOG-OPERATION-FLAG. 211 | MOVE "TOKENIZER:FORMAT-LISP-PROCEDURE" TO 212 | WS-LOG-RECORD-FUNCTION-NAME. 213 | MOVE "COMPLETED formatting lisp string for parsing" TO 214 | WS-LOG-RECORD-MESSAGE. 215 | CALL 'LOGGER' USING WS-LOG-OPERATION-FLAG, WS-LOG-RECORD. 216 | CALC-LISP-LENGTH. 217 | *****Calculate the acutal length of the lisp 218 | MOVE 0 TO WS-LISP-LENGTH. 219 | MOVE 0 TO WS-NUM-LENGTH-ADD. 220 | SET WS-IS-COMMENT-YES TO FALSE. 221 | PERFORM VARYING WS-FORMAT-STR-INDEX FROM 1 BY 1 UNTIL 222 | WS-FORMAT-STR-INDEX = WS-MAX-LISP-LENGTH 223 | IF WS-CALC-LENGTH-STR(WS-FORMAT-STR-INDEX:1) 224 | EQUAL ";" THEN 225 | SET WS-IS-COMMENT-YES TO TRUE 226 | ELSE IF NOT WS-CALC-LENGTH-STR(WS-FORMAT-STR-INDEX:1) 227 | EQUALS " " THEN 228 | ADD 1 TO WS-LISP-LENGTH 229 | ADD WS-NUM-LENGTH-ADD TO WS-LISP-LENGTH 230 | MOVE 0 TO WS-NUM-LENGTH-ADD 231 | ELSE 232 | ADD 1 TO WS-NUM-LENGTH-ADD 233 | END-IF 234 | END-PERFORM. 235 | RESET-PARSE-FLAGS-PROCEDURE. 236 | SET WS-OPEN-PAREN-YES TO FALSE. 237 | SET WS-CLOSE-PAREN-YES TO FALSE. 238 | MOVE 0 TO WS-PARSE-EXPRESSION-START. 239 | MOVE 0 TO WS-PARSE-EXPRESSION-END. 240 | MOVE 0 TO WS-PARSE-EXPRESSION-LEN. 241 | PRINT-PARSE-FLAGS-PROCEDURE. 242 | DISPLAY 'Open Paren:' WS-OPEN-PAREN. 243 | DISPLAY 'Close Paren:' WS-CLOSE-PAREN. 244 | DISPLAY 'Expression Start:' WS-PARSE-EXPRESSION-START. 245 | DISPLAY 'Expression END:' WS-PARSE-EXPRESSION-END. 246 | DISPLAY 'Expression Length:' WS-PARSE-EXPRESSION-LEN. 247 | FORMAT-CHECK-PAREN-PROCEDURE. 248 | * ----Check left side of paren 249 | SUBTRACT 1 FROM WS-FORMAT-STR-INDEX. 250 | IF NOT WS-IN-LISP-RECORD(WS-FORMAT-STR-INDEX:1)EQUAL " " THEN 251 | SET WS-PAREN-LEFT-YES TO TRUE 252 | END-IF. 253 | * ----Check right side of paren 254 | ADD 2 TO WS-FORMAT-STR-INDEX. 255 | IF NOT WS-IN-LISP-RECORD(WS-FORMAT-STR-INDEX:1)EQUAL " " THEN 256 | SET WS-PAREN-RIGHT-YES TO TRUE 257 | END-IF. 258 | * ----Reset the Index to it's original position 259 | SUBTRACT 1 FROM WS-FORMAT-STR-INDEX. 260 | 261 | FORMAT-ADD-LEFT-SPACE. 262 | MOVE WS-FORMAT-STR-INDEX TO WS-PAREN-TEMP-NUM. 263 | SUBTRACT 1 FROM WS-PAREN-TEMP-NUM. 264 | STRING WS-PAREN-TEMP-STR(1:WS-PAREN-TEMP-NUM) 265 | DELIMITED BY SIZE 266 | " " DELIMITED BY SIZE 267 | WS-PAREN-TEMP-STR(WS-FORMAT-STR-INDEX:WS-LISP-LENGTH) 268 | DELIMITED BY SIZE INTO WS-IN-LISP-RECORD. 269 | ADD 1 TO WS-FORMAT-STR-INDEX. 270 | ADD 1 TO WS-LISP-LENGTH. 271 | FORMAT-ADD-RIGHT-SPACE. 272 | MOVE WS-FORMAT-STR-INDEX TO WS-PAREN-TEMP-NUM. 273 | ADD 1 TO WS-PAREN-TEMP-NUM. 274 | STRING WS-PAREN-TEMP-STR(1:WS-FORMAT-STR-INDEX) 275 | DELIMITED BY SIZE 276 | " " DELIMITED BY SIZE 277 | WS-PAREN-TEMP-STR(WS-PAREN-TEMP-NUM:WS-LISP-LENGTH) 278 | DELIMITED BY SIZE INTO WS-IN-LISP-RECORD. 279 | ADD 1 TO WS-FORMAT-STR-INDEX. 280 | ADD 1 TO WS-LISP-LENGTH. 281 | FORMAT-ADD-BOTH-SPACES. 282 | MOVE WS-FORMAT-STR-INDEX TO WS-PAREN-TEMP-NUM. 283 | SUBTRACT 1 FROM WS-PAREN-TEMP-NUM. 284 | MOVE WS-PAREN-TEMP-STR(WS-FORMAT-STR-INDEX:1) 285 | TO WS-WHICH-PAREN. 286 | ADD 1 TO WS-FORMAT-STR-INDEX. 287 | STRING WS-PAREN-TEMP-STR(1:WS-PAREN-TEMP-NUM) 288 | DELIMITED BY SIZE 289 | " " DELIMITED BY SIZE 290 | WS-WHICH-PAREN DELIMITED BY SIZE 291 | " " DELIMITED BY SIZE 292 | WS-PAREN-TEMP-STR(WS-FORMAT-STR-INDEX:WS-LISP-LENGTH) 293 | INTO WS-IN-LISP-RECORD. 294 | ADD 1 TO WS-FORMAT-STR-INDEX. 295 | ADD 2 TO WS-LISP-LENGTH. 296 | FORMAT-PAREN-SPACE-PROCEDURE. 297 | PERFORM FORMAT-CHECK-PAREN-PROCEDURE. 298 | IF WS-PAREN-RIGHT-YES AND WS-PAREN-LEFT-YES THEN 299 | PERFORM FORMAT-ADD-BOTH-SPACES 300 | ELSE IF WS-PAREN-RIGHT-YES THEN 301 | PERFORM FORMAT-ADD-RIGHT-SPACE 302 | ELSE IF WS-PAREN-LEFT-YES THEN 303 | PERFORM FORMAT-ADD-LEFT-SPACE 304 | END-IF. 305 | END PROGRAM TOKENIZER. 306 | --------------------------------------------------------------------------------