add samples

This commit is contained in:
vel 2024-10-24 11:37:05 -07:00
parent 4f517e95b9
commit f01cb2ce5b
Signed by: velvox
GPG Key ID: 59D9762F674151DF
5 changed files with 95 additions and 13 deletions

View File

@ -1,6 +1,5 @@
typedef enum {
TOKEN_EOF = 0,
// Identification Keywords
TOKEN_IDENTIFICATION,
TOKEN_KEYWORD_DIVISION,
TOKEN_KEYWORD_DATA,
@ -8,8 +7,6 @@ typedef enum {
TOKEN_PROGRAM_ID,
TOKEN_WORKING_STORAGE,
TOKEN_PROCEDURE,
// Program Keywords
TOKEN_DISPLAY,
TOKEN_STOP,
TOKEN_RUN,
@ -28,11 +25,7 @@ typedef enum {
TOKEN_KEYWORD_VALUE,
TOKEN_KEYWORD_COMPUTE,
TOKEN_KEYWORD_FUNCTION,
// Identifiers
TOKEN_IDENT,
// Data types
TOKEN_STRING,
TOKEN_INTEGER,
TOKEN_PICTURE,
@ -40,19 +33,14 @@ typedef enum {
TOKEN_NUMERIC,
TOKEN_SIGNED_NUMERIC,
TOKEN_IMPLIED_DECIMAL,
// https://ibmmainframes.com/about393.html
TOKEN_COMPUTATION_LEVEL_0,
TOKEN_COMPUTATION_LEVEL_1,
TOKEN_COMPUTATION_LEVEL_2,
TOKEN_COMPUTATION_LEVEL_3,
// Grammar
TOKEN_LEFT_PARENTHESIS,
TOKEN_RIGHT_PARENTHESIS,
TOKEN_DOT,
TOKEN_COMMENT,
// Operators
TOKEN_ADD,
TOKEN_SUB,
TOKEN_MULTIPLY,

View File

@ -0,0 +1,5 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. HELLO-WORLD.
PROCEDURE DIVISION.
DISPLAY 'Hello World!'
STOP RUN.

View File

@ -1 +0,0 @@
2020+4;

View File

@ -0,0 +1,35 @@
*> Code altered from https://www.quora.com/What-is-a-COBOL-program-that-will-solve-a-quadratic-equation
*> Program finds the roots to a simple quadratic equation
IDENTIFICATION DIVISION.
PROGRAM-ID. QuadraticSolver.
DATA DIVISION.
WORKING-STORAGE SECTION.
77 a PIC S9(5)V9(5) COMP-3 VALUE 1.
77 b PIC S9(5)V9(5) COMP-3 VALUE 5.
77 c PIC S9(5)V9(5) COMP-3 VALUE 6.
77 discriminant PIC S9(5)V9(5) COMP-3.
77 root1 PIC S9(5)V9(5) COMP-3.
77 root2 PIC S9(5)V9(5) COMP-3.
77 square-root-discriminant PIC S9(5)V9(5) COMP-3.
PROCEDURE DIVISION. *> program begins here
DISPLAY "EQUATION: (1x^2) + 5x + 6 = 0"
COMPUTE discriminant = (b ** 2) - (4 * a * c)
IF discriminant > 0
COMPUTE square-root-discriminant = FUNCTION SQRT(discriminant)
COMPUTE root1 = (-b + square-root-discriminant) / (2 * a)
COMPUTE root2 = (-b - square-root-discriminant) / (2 * a)
DISPLAY "The equation has two distinct real roots: "
DISPLAY "Root 1: " root1
DISPLAY "Root 2: " root2
ELSE IF discriminant = 0
COMPUTE root1 = -b / (2 * a)
DISPLAY "The equation has one real root: "
DISPLAY "Root: " root1
ELSE
DISPLAY "The equation has no real roots."
STOP RUN.

View File

@ -0,0 +1,55 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. sorting.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-SORT-AREA.
05 WS-SORT-TABLE.
10 WS-SORT-ROW PIC X(10) OCCURS 100.
05 WS-TEMP-ROW PIC X(10).
05 WS-ROW-MAX PIC S9(4) COMP VALUE 100.
05 WS-SORT-MAX PIC S9(4) COMP.
05 WS-I PIC S9(4) COMP.
05 WS-J PIC S9(4) COMP.
05 WS-INDEX PIC S9(4) COMP.
PROCEDURE DIVISION.
*> Initialize test data
MOVE "30" TO WS-SORT-ROW(1)
MOVE "10" TO WS-SORT-ROW(2)
MOVE "50" TO WS-SORT-ROW(3)
MOVE "20" TO WS-SORT-ROW(4)
MOVE "40" TO WS-SORT-ROW(5)
MOVE 5 TO WS-SORT-MAX
*> * Display original array
DISPLAY "Original Array Contents:"
DISPLAY "---------------------"
PERFORM VARYING WS-INDEX FROM 1 BY 1
UNTIL WS-INDEX > WS-SORT-MAX
DISPLAY "Element " WS-INDEX ": " WS-SORT-ROW(WS-INDEX)
END-PERFORM
DISPLAY SPACE
*> * Simplified bubble sort
PERFORM VARYING WS-I FROM 1 BY 1
UNTIL WS-I > WS-SORT-MAX - 1
PERFORM VARYING WS-J FROM 1 BY 1
UNTIL WS-J > WS-SORT-MAX - WS-I
IF WS-SORT-ROW(WS-J) > WS-SORT-ROW(WS-J + 1)
MOVE WS-SORT-ROW(WS-J) TO WS-TEMP-ROW
MOVE WS-SORT-ROW(WS-J + 1) TO WS-SORT-ROW(WS-J)
MOVE WS-TEMP-ROW TO WS-SORT-ROW(WS-J + 1)
END-IF
END-PERFORM
END-PERFORM
*> * Display sorted array
DISPLAY "Sorted Array Contents:"
DISPLAY "--------------------"
PERFORM VARYING WS-INDEX FROM 1 BY 1
UNTIL WS-INDEX > WS-SORT-MAX
DISPLAY "Element " WS-INDEX ": " WS-SORT-ROW(WS-INDEX)
END-PERFORM.
STOP RUN.