OS_Develop/dos_compilers
OS_Develop/dos_compilers
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Microsoft COBOL v1.12

Browse Source
This commit is contained in:
davidly 2024-07-24 06:45:46 -07:00
parent fd24c24e3f
commit 0faa42d811
35 changed files with 2440 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

227
Microsoft COBOL v112/BUILD.COB Normal file
View File

@ -0,0 +1,227 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. BUILD.
SECURITY.
THIS PROGRAM CREATES AN INDEXED FILE OF NAMES, ADDRESSES,
AND PHONE NUMBERS
*
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT ISAM-FILE
ASSIGN TO DISK
FILE STATUS IS ISAM-STATUS
RECORD KEY IS ISAM-KEY
ACCESS MODE IS RANDOM
ORGANIZATION IS INDEXED.
DATA DIVISION.
FILE SECTION.
FD ISAM-FILE
LABEL RECORDS ARE STANDARD
VALUE OF FILE-ID IS 'ISAM.DAT'.
01 ISAM-RECORD.
05 ISAM-KEY.
10 ISAM-LAST-NAME PIC X(20).
10 ISAM-FIRST-NAME PIC X(20).
05 ISAM-ADDRESS-LINE-1 PIC X(40).
05 ISAM-ADDRESS-LINE-2 PIC X(40).
05 ISAM-PHONE PIC X(12).
WORKING-STORAGE SECTION.
01 WORK-FIELDS.
05 IIX PIC S9(5) VALUE 0 COMP-0.
05 JIX PIC S9(5) VALUE 0 COMP-0.
05 KIX PIC S9(5) VALUE 0 COMP-0.
05 ISAM-STATUS PIC XX VALUE SPACES.
05 WS-MORE PIC X VALUE SPACES.
88 NO-MORE VALUE 'N', 'n'.
05 ANY-CHAR PIC X VALUE SPACE.
01 SWITCHES.
05 ON-VALUE PIC X VALUE 'Y'.
05 OFF-VALUE PIC X VALUE 'N'.
05 BUILD-FINISHED-SW PIC X VALUE 'N'.
88 BUILD-FINISHED VALUE 'Y'.
01 WS-DATA-RECORD.
05 WS-KEY.
10 WS-LAST-NAME PIC X(20) VALUE SPACES.
10 WS-FIRST-NAME PIC X(20) VALUE SPACES.
05 WS-ADDRESS-LINE-1 PIC X(40) VALUE SPACES.
05 WS-ADDRESS-LINE-2 PIC X(40) VALUE SPACES.
05 WS-PHONE PIC X(12) VALUE SPACES.
LINKAGE SECTION.
01 LS-TITLE PIC X(50).
SCREEN SECTION.
01 BLANK-SCREEN.
03 BLANK SCREEN.
01 TUTOR-SCREEN.
03 BLANK SCREEN.
03 LINE 1 COLUMN 17 VALUE
'MS-COBOL INDEXED FILE CREATION DEMONSTRATION'.
03 LINE 2 COLUMN 15 PIC X(50) FROM LS-TITLE HIGHLIGHT.
03 LINE 4 COLUMN 5 VALUE
'This is subprogram BUILD, CALLed from main program DEM
- 'O.'.
03 LINE 5 COLUMN 5 VALUE
'The title above was passed as a parameter from DEMO.'.
03 LINE 7 COLUMN 1 VALUE
'In this program, you will create an indexed (ISAM) fil
- 'e of records containing '.
03 LINE 8 COLUMN 1 VALUE
'names, addresses, and phone numbers. After the data fo
- 'r one person '.
03 LINE 9 COLUMN 1 VALUE
'has been entered, you will be given the opportunity to
- ' review the data.'.
03 LINE 11 COLUMN 1 VALUE
'If the data is ok, it will be written to files ISAM.DA
- 'T and ISAM.KEY.'.
03 LINE 13 COLUMN 1 VALUE
'The full name of the person will be used as a key for
- 'searching the'.
03 LINE 14 COLUMN 1 VALUE
'file in program UPDATE.'.
03 LINE 16 COLUMN 1 VALUE
'To end this program, reply N to the question:'.
03 LINE 17 COLUMN 1 VALUE
' "Do you wish to enter more data?(Y/N)"'.
03 LINE 18 COLUMN 1 VALUE
'when it appears on the screen.'.
03 LINE 20 COLUMN 1 HIGHLIGHT VALUE
'Hit ENTER to continue. '.
03 COLUMN PLUS 1 PIC X TO ANY-CHAR.
01 DATA-SCREEN.
03 BLANK SCREEN.
03 LINE 1 COLUMN 17 VALUE
'MS-COBOL INDEXED FILE CREATION DEMONSTRATION'.
03 LINE 2 COLUMN 15 PIC X(50) FROM LS-TITLE HIGHLIGHT.
03 LINE 4 COLUMN 1 VALUE
'Please enter the data requested below. To end this pro
- 'gram'.
03 LINE 5 COLUMN 1 VALUE
'reply N to the question: "Do you wish to enter more da
- 'ta?(Y/N)"'.
03 LINE 6 COLUMN 1 VALUE
'when it appears on the screen.'.
03 LINE 8 COLUMN 1 VALUE
'Enter FIRST name and initial (1 to 20 characters): '.
03 LINE 9 COLUMN 1 VALUE '[' HIGHLIGHT.
03 LINE 9 COLUMN 2 PIC X(20) USING WS-FIRST-NAME.
03 LINE 9 COLUMN 22 VALUE ']' HIGHLIGHT.
03 LINE 10 COLUMN 1 VALUE
'Enter LAST name (1 to 20 characters): '.
03 LINE 11 COLUMN 1 VALUE '[' HIGHLIGHT.
03 LINE 11 COLUMN 2 PIC X(20) USING WS-LAST-NAME.
03 LINE 11 COLUMN 22 VALUE ']' HIGHLIGHT.
03 LINE 13 COLUMN 1 VALUE
'Enter first address line (1 to 40 characters): '.
03 LINE 14 COLUMN 1 VALUE '[' HIGHLIGHT.
03 LINE 14 COLUMN 2 PIC X(40) USING WS-ADDRESS-LINE-1.
03 LINE 14 COLUMN 42 VALUE ']' HIGHLIGHT.
03 LINE 15 COLUMN 1 VALUE
'Enter second address line (1 to 40 characters): '.
03 LINE 16 COLUMN 1 VALUE '[' HIGHLIGHT.
03 LINE 16 COLUMN 2 PIC X(40) USING WS-ADDRESS-LINE-2.
03 LINE 16 COLUMN 42 VALUE ']' HIGHLIGHT.
03 LINE 18 COLUMN 1 VALUE
'Enter phone number (XXX-XXXX or XXX-XXX-XXXX): '.
03 LINE 19 COLUMN 1 VALUE '[' HIGHLIGHT.
03 LINE 19 COLUMN 2 PIC X(12) USING WS-PHONE.
03 LINE 19 COLUMN 14 VALUE ']' HIGHLIGHT.
03 LINE 21 COLUMN 10 VALUE
'If data is OK, hit ENTER to write to the file. You can
- 'use BACK TAB to '.
03 LINE 22 COLUMN 15 VALUE
'return to previous fields and modify data with cursor pos
- 'itioning'.
03 LINE 23 COLUMN 15 VALUE
'keys.'.
03 LINE 23 COLUMN 21 HIGHLIGHT VALUE
'Hit ENTER by itself to continue: '.
03 COLUMN PLUS 1 PIC X TO ANY-CHAR.
01 WRITE-SCREEN.
03 BLANK SCREEN.
03 LINE 1 COLUMN 20 VALUE
'MS-COBOL INDEXED FILE CREATION DEMONSTRATION'.
03 LINE 2 COLUMN 15 PIC X(50) FROM LS-TITLE HIGHLIGHT.
03 LINE 5 COLUMN 1 VALUE
'Record written to file ISAM.DAT. File status = '.
03 PIC XX FROM ISAM-STATUS HIGHLIGHT.
03 LINE 8 COLUMN 1 VALUE
'File status = 00 means action was successful'.
03 LINE 9 COLUMN 1 VALUE
'File status = 10 means END-OF-FILE encountered'.
03 LINE 10 COLUMN 1 VALUE
'File status = 21 means KEY NOT IN SEQUENCE'.
03 LINE 11 COLUMN 1 VALUE
'File status = 22 means ATTEMPT TO WRITE DUPLICATE KEY'.
03 LINE 12 COLUMN 1 VALUE
'File status = 23 means NO RECORD FOUND'.
03 LINE 13 COLUMN 1 VALUE
'File status = 24 means DISK FULL'.
03 LINE 14 COLUMN 1 VALUE
'File status = 30 means PERMANENT INPUT-OUTPUT ERROR'.
03 LINE 15 COLUMN 1 VALUE
'File status = 91 means FILE STRUCTURE WAS DAMAGED'.
03 LINE 18 COLUMN 1 VALUE
' Do you wish to enter more data?(Y/N)'.
03 LINE 19 COLUMN 10 HIGHLIGHT VALUE
'Type response (Y or N) followed by ENTER: '.
03 COLUMN PLUS 1 PIC X TO WS-MORE.
PROCEDURE DIVISION USING LS-TITLE.
P000-MAIN-LINE.
MOVE OFF-VALUE TO BUILD-FINISHED-SW.
MOVE SPACE TO WS-MORE.
DISPLAY TUTOR-SCREEN.
ACCEPT TUTOR-SCREEN.
OPEN OUTPUT ISAM-FILE.
IF ISAM-STATUS NOT = '00'
DISPLAY ' FILE OPEN FAILURE. JOB CANCELLED'
DISPLAY 'FILE STATUS = ', ISAM-STATUS
DISPLAY 'TYPE ANY CHARACTER TO END JOB'
ACCEPT ANY-CHAR
ELSE
PERFORM P100-GET-DATA
UNTIL BUILD-FINISHED.
CLOSE ISAM-FILE.
DISPLAY BLANK-SCREEN.
EXIT PROGRAM.
P100-GET-DATA.
MOVE SPACES TO WS-DATA-RECORD.
DISPLAY DATA-SCREEN.
ACCEPT DATA-SCREEN.
PERFORM P500-WRITE-DATA.
DISPLAY WRITE-SCREEN.
PERFORM P110-CONTINUE.
P110-CONTINUE.
ACCEPT WRITE-SCREEN.
IF NO-MORE
MOVE ON-VALUE TO BUILD-FINISHED-SW.
P500-WRITE-DATA.
WRITE ISAM-RECORD FROM WS-DATA-RECORD.


183
Microsoft COBOL v112/CENTER.COB Normal file
View File

@ -0,0 +1,183 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CENTER.
SECURITY.
THIS PROGRAM CENTERS, RIGHT ALIGNS, OR RIGHT ALIGNS
A HEADING WITHIN AN 80 CHARACTER FIELD. IT CAN BE MADE
INTO A GENERAL-PURPOSE SUBROUTINE BY MOVING THE BLOCK OF
STORAGE CALLED PARAMETER-AREA INTO THE LINKAGE SECTION,
ADDING THE CLAUSE, "USING PARAMETER-AREA" TO THE PROCEDURE
DIVISION HEADER, REPLACING "STOP RUN" WITH "EXIT PROGRAM",
AND DELETING THE DISPLAY AND ACCEPT STATEMENTS. THE
PARAMETER-AREA VARIABLES WOULD THEN BE SET UP IN THE
CALLING PROGRAM.
*
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WORK-FIELDS.
05 IIX PIC S9(5) VALUE 0 COMP-0.
05 WS-IN-START PIC S9(5) VALUE 0 COMP-0.
05 WS-IN-END PIC S9(5) VALUE 0 COMP-0.
05 WS-IN-LEN PIC S9(5) VALUE 0 COMP-0.
05 WS-OUT-INDEX PIC S9(5) VALUE 0 COMP-0.
05 TEN-SPACES PIC X(10) VALUE SPACES.
01 SWITCHES.
05 ON-VALUE PIC X VALUE 'Y'.
05 OFF-VALUE PIC X VALUE 'N'.
05 FINISHED-SW PIC X VALUE 'N'.
88 FINISHED VALUE 'Y'.
01 WS-RULERS.
05 WS-RULER-1.
10 FILLER PIC X(40) VALUE
" 1 2 3 4".
10 FILLER PIC X(40) VALUE
" 5 6 7 8".
05 WS-RULER-2.
10 FILLER PIC X(40) VALUE
"1234567890123456789012345678901234567890".
10 FILLER PIC X(40) VALUE
"1234567890123456789012345678901234567890".
01 PARAMETER-AREA.
05 PA-OPTION PIC X VALUE SPACE.
88 CENTER-OPTION VALUE 'C', 'c'.
88 LEFT-ALIGN-OPTION VALUE 'L', 'l'.
88 RIGHT-ALIGN-OPTION VALUE 'R', 'r'.
88 VALID-OPTION VALUE 'C', 'c', 'L', 'l',
'R', 'r'.
88 END-OPTION VALUE 'E', 'e'.
05 PA-BUFFER-LEN PIC S9(5) VALUE 80 COMP-0.
05 PA-IN-TITLE PIC X(80) VALUE SPACES.
05 FILLER REDEFINES PA-IN-TITLE.
10 PA-IN-TITLE-CHAR OCCURS 80 TIMES PIC X.
05 PA-OUT-TITLE PIC X(80) VALUE SPACES.
05 FILLER REDEFINES PA-OUT-TITLE.
10 PA-OUT-TITLE-CHAR OCCURS 80 TIMES PIC X.
PROCEDURE DIVISION.
P000-MAIN-LINE.
DISPLAY SPACE.
DISPLAY SPACE.
DISPLAY TEN-SPACES,
" This is program CENTER, one of the MS-COBOL demonstration".
DISPLAY TEN-SPACES,
" programs. It will center, left align, or right align".
DISPLAY TEN-SPACES,
" a line of text up to 80 characters long. You will be ".
DISPLAY TEN-SPACES,
" asked whether you want to center or align your text, ".
DISPLAY TEN-SPACES,
" then asked to enter your text, which will be displayed".
DISPLAY TEN-SPACES,
" as requested.".
DISPLAY SPACE.
DISPLAY TEN-SPACES,
" This action will be repeated until you enter".
DISPLAY TEN-SPACES,
" option E to end the program.".
DISPLAY SPACE.
DISPLAY TEN-SPACES,
" This is a simple program, but it may be made into a".
DISPLAY TEN-SPACES,
" subroutine that can be called to center or align report".
DISPLAY TEN-SPACES,
" or screen headings.".
DISPLAY SPACE.
DISPLAY SPACE.
DISPLAY SPACE.
DISPLAY SPACE.
PERFORM P010-GET-OPTION
UNTIL FINISHED.
STOP RUN.
P010-GET-OPTION.
DISPLAY
" Please type first letter of option desired, then hit",
" RETURN:".
DISPLAY
" Option C: Center text on screen".
DISPLAY
" Option L: Left align text on screen".
DISPLAY
" Option R: Right align text on screen".
DISPLAY
" Option E: End this program".
DISPLAY SPACE.
ACCEPT PA-OPTION.
IF END-OPTION
MOVE ON-VALUE TO FINISHED-SW
ELSE IF VALID-OPTION
PERFORM P020-GET-TITLE.
P020-GET-TITLE.
DISPLAY
" Please enter text (1 to 80 characters) below:".
DISPLAY SPACE.
MOVE SPACES TO PA-OUT-TITLE.
ACCEPT PA-IN-TITLE.
IF PA-IN-TITLE NOT = SPACES
PERFORM P030-ADJUST.
DISPLAY
"Centered/aligned text:".
DISPLAY WS-RULER-1.
DISPLAY WS-RULER-2.
DISPLAY PA-OUT-TITLE.
P030-ADJUST.
PERFORM P035-NOTHING VARYING WS-IN-START
FROM 1 BY 1
UNTIL PA-IN-TITLE-CHAR (WS-IN-START) NOT = SPACE
OR WS-IN-START > PA-BUFFER-LEN.
PERFORM P035-NOTHING VARYING WS-IN-END
FROM PA-BUFFER-LEN BY -1
UNTIL PA-IN-TITLE-CHAR (WS-IN-END) NOT = SPACE
OR WS-IN-END NOT > 1.
IF LEFT-ALIGN-OPTION
MOVE 1 TO WS-OUT-INDEX
ELSE
COMPUTE WS-IN-LEN =
WS-IN-END - WS-IN-START + 1
IF RIGHT-ALIGN-OPTION
COMPUTE WS-OUT-INDEX =
1 + (PA-BUFFER-LEN - WS-IN-LEN)
ELSE
* *** MUST BE CENTER OPTION ******
COMPUTE WS-OUT-INDEX =
1 + ((PA-BUFFER-LEN - WS-IN-LEN) / 2).
PERFORM P040-MOVE-TITLE VARYING IIX FROM WS-IN-START
BY 1 UNTIL IIX > WS-IN-END.
P035-NOTHING.
EXIT.
P040-MOVE-TITLE.
MOVE PA-IN-TITLE-CHAR (IIX)
TO PA-OUT-TITLE-CHAR (WS-OUT-INDEX).
ADD 1 TO WS-OUT-INDEX.


BIN
Microsoft COBOL v112/CLDEMO.BAT Normal file
View File

Binary file not shown.

BIN
Microsoft COBOL v112/COBDBG.EXE Normal file
View File

Binary file not shown.

BIN
Microsoft COBOL v112/COBDBG.OBJ Normal file
View File

Binary file not shown.

BIN
Microsoft COBOL v112/COBOL.COM Normal file
View File

Binary file not shown.

BIN
Microsoft COBOL v112/COBOL1.LIB Normal file
View File

Binary file not shown.

BIN
Microsoft COBOL v112/COBOL1.OVR Normal file
View File

Binary file not shown.

BIN
Microsoft COBOL v112/COBOL2.LIB Normal file
View File

Binary file not shown.

BIN
Microsoft COBOL v112/COBOL2.OVR Normal file
View File

Binary file not shown.

BIN
Microsoft COBOL v112/COBOL3.OVR Normal file
View File

Binary file not shown.

BIN
Microsoft COBOL v112/COBOL4.OVR Normal file
View File

Binary file not shown.

BIN
Microsoft COBOL v112/COBRUN.EXE Normal file
View File

Binary file not shown.

BIN
Microsoft COBOL v112/CRTEST.COB Normal file
View File

Binary file not shown.

BIN
Microsoft COBOL v112/CRTEST.EXE Normal file
View File

Binary file not shown.

663
Microsoft COBOL v112/DEMO.COB Normal file
View File

@ -0,0 +1,663 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. DEMO.
SECURITY.
THIS PROGRAM TESTS SCREEN DISPLAY AND ACCEPT. A SERIES OF
SCREENS ARE DISPLAYED, AND ACCEPTED. THE USER SHOULD ENTER
VALUES INTO THE FIELDS TO TEST THE FEATURES INDICATED
IN THE HEADINGS.
*
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 SCREEN-ACCEPT-FIELDS.
05 ANY-CHAR-1 PIC X(13) VALUE SPACES.
05 INTEGER-1 PIC S9(6) VALUE ZERO.
05 TWO-PLACE-NUM-1 PIC S9(4)V99 VALUE ZERO.
05 FIVE-PLACE-NUM-1 PIC SV9(5) VALUE ZERO.
05 ANY-CHAR-2 PIC X(13) VALUE "ABCDEFGHIJKLM".
05 INTEGER-2 PIC S9(6) VALUE 1234.
05 TWO-PLACE-NUM-2 PIC S9(4)V99 VALUE 1234.56.
05 FIVE-PLACE-NUM-2 PIC SV9(5) VALUE .12345.
05 ANY-CHAR-3 PIC X(13) VALUE "ABCDEFGHIJKLM".
05 INTEGER-3 PIC S9(6) VALUE 1234.
05 TWO-PLACE-NUM-3 PIC S9(4)V99 VALUE 1234.56.
05 FIVE-PLACE-NUM-3 PIC SV9(5) VALUE .12345.
05 ANY-CHAR-4 PIC X(13) VALUE "ABCDEFGHIJKLM".
05 INTEGER-4 PIC S9(6) VALUE 1234.
05 TWO-PLACE-NUM-4 PIC S9(4)V99 VALUE 1234.56.
05 FIVE-PLACE-NUM-4 PIC SV9(5) VALUE .12345.
05 ANY-CHAR-5 PIC X(13) VALUE "ABCDEFGHIJKLM".
05 INTEGER-5 PIC S9(6) VALUE 1234.
05 TWO-PLACE-NUM-5 PIC S9(4)V99 VALUE 1234.56.
05 FIVE-PLACE-NUM-5 PIC SV9(5) VALUE .12345.
05 ANY-CHAR-6 PIC X(13) VALUE "ABCDEFGHIJKLM".
05 INTEGER-6 PIC S9(6) VALUE 1234.
05 TWO-PLACE-NUM-6 PIC S9(4)V99 VALUE 1234.56.
05 FIVE-PLACE-NUM-6 PIC SV9(5) VALUE .12345.
05 ANY-CHAR-7 PIC X(13) VALUE "ABCDEFGHIJKLM".
05 INTEGER-7 PIC S9(6) VALUE 1234.
05 TWO-PLACE-NUM-7 PIC S9(4)V99 VALUE 1234.56.
05 FIVE-PLACE-NUM-7 PIC SV9(5) VALUE .12345.
01 WORK-FIELDS.
05 IIX PIC S9(5) VALUE 0 COMP-0.
05 JIX PIC S9(5) VALUE 0 COMP-0.
05 KIX PIC S9(5) VALUE 0 COMP-0.
05 WS-TITLE-LEN PIC S9(5) VALUE 0 COMP-0.
05 WS-START PIC S9(5) VALUE 0 COMP-0.
05 WS-END PIC S9(5) VALUE 0 COMP-0.
05 TEN-SPACES PIC X(10) VALUE SPACES.
05 ANY-CHAR PIC X VALUE SPACE.
05 WS-OPTION PIC X VALUE SPACE.
88 SCREEN-OPTION VALUE 'S', 's'.
88 CREATE-OPTION VALUE 'C', 'c'.
88 UPDATE-OPTION VALUE 'U', 'u'.
88 END-OPTION VALUE 'E', 'e'.
01 WS-WK-TITLE PIC X(50) VALUE ALL 'X'.
01 FILLER REDEFINES WS-WK-TITLE.
05 WS-WK-TITLE-CHAR OCCURS 50 TIMES PIC X.
01 WS-TITLE PIC X(50) VALUE SPACES.
01 FILLER REDEFINES WS-TITLE.
05 WS-TITLE-CHAR OCCURS 50 TIMES PIC X.
01 SWITCHES.
05 ON-VALUE PIC X VALUE 'Y'.
05 OFF-VALUE PIC X VALUE 'N'.
05 DEMO-FINISHED-SW PIC X VALUE 'N'.
88 DEMO-FINISHED VALUE 'Y'.
SCREEN SECTION.
01 BLANK-SCREEN.
03 BLANK SCREEN.
01 TUTOR-SCREEN.
03 BLANK SCREEN.
03 LINE 1 COLUMN 10 VALUE
' DEMO - MICROSOFT MS-COBOL DEMONSTRATION SYSTEM'.
03 LINE 3 COLUMN 1 VALUE
'In this program, you will be given the options to see
- 'how Microsoft MS-COBOL '.
03 LINE 4 COLUMN 1 VALUE
'uses its Screen Section to create fill-in forms on you
- 'r terminal screen'.
03 LINE 5 COLUMN 1 VALUE
'or to create, list, and update a simple indexed file d
- 'ata base.'.
03 LINE 8 COLUMN 1 BLANK LINE.
03 LINE 9 COLUMN 1 VALUE
'You will first be asked to type in a title, made up of
- ' any characters'.
03 LINE 10 COLUMN 1 VALUE
'you like, that will be used in later screens. The prog
- 'ram will center'.
03 LINE 11 COLUMN 1 VALUE
'the title for you. Next you will be asked to hit ENTER
- ' to get the'.
03 LINE 12 COLUMN 1 VALUE
'next screen. The title you entered will appear, along w
- 'ith a list'.
03 LINE 13 COLUMN 1 VALUE
'of options, and you will be given further instructions
- '. '.
03 LINE 15 COLUMN 1 VALUE
'Ready?'.
03 LINE 17 COLUMN 1 VALUE
'Please type a title from 1 to 50 characters below, then
- ' hit ENTER:'.
03 LINE 19 COLUMN 1 HIGHLIGHT VALUE 'Title: '.
03 PIC X(50) TO WS-WK-TITLE.
03 LINE 21 COLUMN 1 HIGHLIGHT VALUE
'Please hit ENTER to continue. '.
03 COLUMN PLUS 1 PIC X TO ANY-CHAR.
01 OPTION-SCREEN.
03 BLANK SCREEN.
03 LINE 1 COLUMN 19 VALUE
' OPTIONS FOR MS-COBOL DEMONSTATION PROGRAM'.
03 LINE 3 COLUMN 15 PIC X(50) FROM WS-TITLE HIGHLIGHT.
03 LINE 5 COLUMN 1 VALUE
'You may now run programs that demonstrate features of
- 'MS-COBOL. Among'.
03 LINE 6 COLUMN 1 VALUE
'these features are:'.
03 LINE 7 COLUMN 15 VALUE
'Screen Section for generating screens'.
03 LINE 8 COLUMN 15 VALUE
'Automatic generation of program overlays'.
03 LINE 9 COLUMN 15 VALUE
"CALLing of subroutines".
03 LINE 10 COLUMN 15 VALUE
"CHAINing to another program without returning".
03 LINE 11 COLUMN 15 VALUE
'Creation of an indexed (ISAM) data file.'.
03 LINE 12 COLUMN 15 VALUE
'Display, addition, deletion and modification of record
- 's in the'.
03 LINE 13 COLUMN 20 VALUE
'ISAM file.'.
03 LINE 14 COLUMN 1 VALUE
'Please select one of the following options by entering
- ' the first letter '.
03 LINE 15 COLUMN 1 VALUE
'of the option in the space below. Choose option E to e
- 'nd this demonstration '.
03 LINE 17 COLUMN 5 VALUE
'Option S: Screen section demonstration'.
03 LINE 18 COLUMN 5 VALUE
'Option C: Create an indexed-file data base'.
03 LINE 19 COLUMN 5 VALUE
'Option U: Update or display indexed-file data base.'.
03 LINE 20 COLUMN 5 VALUE
'Option E: End the demonstration.'.
03 LINE 22 COLUMN 10 HIGHLIGHT VALUE
'Enter option here followed by ENTER: '.
03 COLUMN PLUS 1 PIC X TO WS-OPTION.
01 SCREEN-SCREEN.
03 BLANK SCREEN.
03 LINE 1 COLUMN 17 VALUE
'MS-COBOL INTERACTIVE DISPLAY/ACCEPT DEMONSTRATION'.
03 LINE 3 COLUMN 15 PIC X(50) FROM WS-TITLE HIGHLIGHT.
03 LINE 5 COLUMN 1 VALUE
'In this program, several screens are displayed, then a
- 'ccepted. As a screen '.
03 LINE 6 COLUMN 1 VALUE
'is displayed, enter new values into its fields, and se
- 'e how screens '.
03 LINE 7 COLUMN 1 VALUE
'function under different options, such as:'.
03 LINE 9 COLUMN 10 VALUE
'UPDATE (with the USING, TO, and FROM options)'.
03 LINE 10 COLUMN 10 VALUE
'AUTO-SKIP'.
03 LINE 11 COLUMN 10 VALUE
'SECURE'.
03 LINE 16 COLUMN 1 HIGHLIGHT VALUE
'Hit ENTER to continue. '.
03 COLUMN PLUS 1 PIC X TO ANY-CHAR.
01 SCREEN-SCREEN-2.
03 BLANK SCREEN.
03 LINE 1 COLUMN 17 VALUE
'MS-COBOL INTERACTIVE DISPLAY/ACCEPT DEMONSTRATION'.
03 LINE 2 COLUMN 15 PIC X(50) FROM WS-TITLE HIGHLIGHT.
03 LINE 4 COLUMN 1 VALUE
'Note that when fields are defined as numeric, i.e, whe
- 'en the PIC clause '.
03 LINE 5 COLUMN 1 VALUE
'contains "9"s, the cursor starts at the right end of t
- 'he field, and '.
03 LINE 6 COLUMN 1 VALUE
'when a digit is typed, any previous value is cleared.
- ' '.
03 LINE 8 COLUMN 1 VALUE
'If a numeric field contains a decimal point, you may h
- 'ave to type a'.
03 LINE 9 COLUMN 1 VALUE
'period (".") to get to the right of the decimal point.
- ''.
03 LINE 10 COLUMN 1 BLANK LINE.
03 LINE 11 COLUMN 1 VALUE
'When a field is defined as alpha-numeric, i.e., when t
- 'he PIC clause'.
03 LINE 12 COLUMN 1 VALUE
'contains "X"s, the cursor starts on the left and chara
- 'cters in the field'.
03 LINE 13 COLUMN 1 VALUE
'may be edited with cursor positioning keys.'.
03 LINE 14 COLUMN 1 BLANK LINE.
03 LINE 15 COLUMN 1 VALUE
'The following screens will include information on how'.
03 LINE 16 COLUMN 1 VALUE
'to ACCEPT a field or an entire screen, how to back up
- 'to earlier'.
03 LINE 17 COLUMN 1 VALUE
'fields in a screen, and how to modify values entered i
- 'nto a field.'.
03 LINE 22 COLUMN 1 HIGHLIGHT VALUE
'Please hit ENTER to continue. '.
03 COLUMN PLUS 1 PIC X TO ANY-CHAR.
01 HINT-SCREEN.
03 LINE 19 COLUMN 1 VALUE
'Helpful hints: '.
03 LINE 20 COLUMN 1 VALUE
' ENTER or TAB will accept a field and go to next fi
- 'eld.'.
03 LINE 21 COLUMN 1 VALUE
' <ESCAPE> accepts all fields on a screen.'.
03 LINE 22 COLUMN 1 VALUE
' <BACK TAB> returns to a previous field.'.
03 LINE 23 COLUMN 1 VALUE
' Edit alpha-numeric fields with the cursor position
- ' keys.'.
03 LINE 24 COLUMN 1 VALUE
' Alarm will sound when what you type is not what is
- ' expected.'.
01 NORMAL-SCREEN.
03 BLANK SCREEN.
03 LINE 1 COLUMN 20 VALUE
"ACCEPT SCREEN WITHOUT AUTO SKIP OR SECURE".
03 LINE 3 COLUMN 10 VALUE
"* Enter values into the fields below. Note that you mu
- "st hit TAB or".
03 LINE 4 COLUMN 14 VALUE
"RETURN to go from one field to the next.".
03 LINE 5 COLUMN 10 VALUE
"* You must type a period to get past the decimal point
- " in the third".
03 LINE 6 COLUMN 14 VALUE
"field in each line. Hit BACK TAB to return to the prev
- "ious field.".
03 LINE 7 COLUMN 10 VALUE
'* Fields described as "NUMBER" can only contain digits
- ', signs, '.
03 LINE 8 COLUMN 14 VALUE
'and a decimal point.'.
03 NS-LINE-10.
05 LINE 10.
05 COLUMN 1 VALUE
"FEATURE DEMONSTRATED".
05 COLUMN 23 VALUE
"ANY CHARACTER".
05 COLUMN 39 VALUE
"NUMBER".
05 COLUMN 49 VALUE
"NUMBER".
05 COLUMN 58 VALUE
"NUMBER".
03 NS-LINE-12.
05 LINE 12.
05 COLUMN 1 VALUE
"NO ORIGINAL VALUE".
05 COLUMN 23 PIC X(13) TO ANY-CHAR-1.
05 COLUMN 39 PIC S9(6) TO INTEGER-1.
05 COLUMN 49 PIC S9(4)V99 TO TWO-PLACE-NUM-1.
05 COLUMN 58 PIC SV9(5) TO FIVE-PLACE-NUM-1.
03 NS-LINE-13.
05 LINE 13.
05 COLUMN 1 VALUE
"UPDATE VALUES".
05 COLUMN 23 PIC X(13) USING ANY-CHAR-2.
05 COLUMN 39 PIC S9(6) USING INTEGER-2.
05 COLUMN 49 PIC S9(4)V99 USING TWO-PLACE-NUM-2.
05 COLUMN 58 PIC SV9(5) USING FIVE-PLACE-NUM-2.
03 NS-LINE-14.
05 LINE 14.
05 COLUMN 1 VALUE
"HIGHLIGHT,REV-VIDEO".
05 COLUMN 23 PIC X(13) USING ANY-CHAR-3 HIGHLIGHT.
05 COLUMN 39 PIC S9(6) USING INTEGER-3 HIGHLIGHT.
05 COLUMN 49 PIC S9(4)V99 USING TWO-PLACE-NUM-3
REVERSE-VIDEO.
05 COLUMN 58 PIC SV9(5) USING FIVE-PLACE-NUM-3
REVERSE-VIDEO.
03 NS-LINE-15.
05 LINE 15.
05 COLUMN 1 VALUE
"UNDERLINE-BLINK".
05 COLUMN 23 PIC X(13) USING ANY-CHAR-4
UNDERLINE.
05 COLUMN 39 PIC S9(6) USING INTEGER-4
UNDERLINE.
05 COLUMN 49 PIC S9(4)V99 USING TWO-PLACE-NUM-4
BLINK.
05 COLUMN 58 PIC SV9(5) USING FIVE-PLACE-NUM-4
BLINK.
03 NS-LINE-16.
05 LINE 16.
05 COLUMN 1 VALUE
"AUTO-SECURE".
05 COLUMN 23 PIC X(13) USING ANY-CHAR-5
AUTO.
05 COLUMN 39 PIC S9(6) USING INTEGER-5
AUTO.
05 COLUMN 49 PIC S9(4)V99 USING TWO-PLACE-NUM-5
SECURE.
05 COLUMN 58 PIC SV9(5) USING FIVE-PLACE-NUM-5
SECURE.
03 NS-LINE-17.
05 LINE 17.
05 COLUMN 1 VALUE
"BELL + OTHERS".
05 COLUMN 23 PIC X(13) USING ANY-CHAR-6
HIGHLIGHT BELL.
05 COLUMN 39 PIC S9(6) USING INTEGER-6
REVERSE-VIDEO BELL.
05 COLUMN 49 PIC S9(4)V99 USING TWO-PLACE-NUM-6
UNDERLINE BELL.
05 COLUMN 58 PIC SV9(5) USING FIVE-PLACE-NUM-6
BLINK BELL.
01 AUTO-SKIP-SCREEN AUTO.
03 BLANK SCREEN.
03 LINE 1 COLUMN 28 VALUE
"ACCEPT SCREEN WITH AUTO-SKIP".
03 LINE 3 COLUMN 10 VALUE
"* Enter values into the fields below. Note that when a
- " field is filled,".
03 LINE 4 COLUMN 14 VALUE
"the cursor will go to the next field without having
- "to hit RETURN.".
03 LINE 5 COLUMN 10 VALUE
"* You may still use RETURN and TAB to advance to the n
- "ext field,".
03 LINE 6 COLUMN 14 VALUE
"and use BACK TAB to return to a previous field.".
03 LINE 7 COLUMN 10 VALUE
'* Fields described as "NUMBER" can only contain digits
- ', signs, '.
03 LINE 8 COLUMN 14 VALUE
'and a decimal point.'.
03 AS-LINE-10.
05 LINE 10.
05 COLUMN 1 VALUE
"FEATURE DEMONSTRATED".
05 COLUMN 23 VALUE
"ANY CHARACTER".
05 COLUMN 39 VALUE
"NUMBER".
05 COLUMN 49 VALUE
"NUMBER".
05 COLUMN 58 VALUE
"NUMBER".
03 AS-LINE-12.
05 LINE 12.
05 COLUMN 1 VALUE
"NO ORIGINAL VALUE".
05 COLUMN 23 PIC X(13) TO ANY-CHAR-1.
05 COLUMN 39 PIC S9(6) TO INTEGER-1.
05 COLUMN 49 PIC S9(4)V99 TO TWO-PLACE-NUM-1.
05 COLUMN 58 PIC SV9(5) TO FIVE-PLACE-NUM-1.
03 AS-LINE-13.
05 LINE 13.
05 COLUMN 1 VALUE
"UPDATE VALUES".
05 COLUMN 23 PIC X(13) USING ANY-CHAR-2.
05 COLUMN 39 PIC S9(6) USING INTEGER-2.
05 COLUMN 49 PIC S9(4)V99 USING TWO-PLACE-NUM-2.
05 COLUMN 58 PIC SV9(5) USING FIVE-PLACE-NUM-2.
03 AS-LINE-14.
05 LINE 14.
05 COLUMN 1 VALUE
"HIGHLIGHT,REV-VIDEO".
05 COLUMN 23 PIC X(13) USING ANY-CHAR-3 HIGHLIGHT.
05 COLUMN 39 PIC S9(6) USING INTEGER-3 HIGHLIGHT.
05 COLUMN 49 PIC S9(4)V99 USING TWO-PLACE-NUM-3
REVERSE-VIDEO.
05 COLUMN 58 PIC SV9(5) USING FIVE-PLACE-NUM-3
REVERSE-VIDEO.
03 AS-LINE-15.
05 LINE 15.
05 COLUMN 1 VALUE
"UNDERLINE-BLINK".
05 COLUMN 23 PIC X(13) USING ANY-CHAR-4
UNDERLINE.
05 COLUMN 39 PIC S9(6) USING INTEGER-4
UNDERLINE.
05 COLUMN 49 PIC S9(4)V99 USING TWO-PLACE-NUM-4
BLINK.
05 COLUMN 58 PIC SV9(5) USING FIVE-PLACE-NUM-4
BLINK.
03 AS-LINE-16.
05 LINE 16.
05 COLUMN 1 VALUE
"SECURE".
05 COLUMN 23 PIC X(13) USING ANY-CHAR-5
SECURE.
05 COLUMN 39 PIC S9(6) USING INTEGER-5
SECURE.
05 COLUMN 49 PIC S9(4)V99 USING TWO-PLACE-NUM-5
SECURE.
05 COLUMN 58 PIC SV9(5) USING FIVE-PLACE-NUM-5
SECURE.
03 AS-LINE-17.
05 LINE 17.
05 COLUMN 1 VALUE
"BELL + OTHERS".
05 COLUMN 23 PIC X(13) USING ANY-CHAR-6
HIGHLIGHT BELL.
05 COLUMN 39 PIC S9(6) USING INTEGER-6
REVERSE-VIDEO BELL.
05 COLUMN 49 PIC S9(4)V99 USING TWO-PLACE-NUM-6
UNDERLINE BELL.
05 COLUMN 58 PIC SV9(5) USING FIVE-PLACE-NUM-6
BLINK BELL.
01 SECURE-SCREEN SECURE.
03 BLANK SCREEN.
03 LINE 1 COLUMN 28 VALUE
"ACCEPT SCREEN WITH SECURE".
03 LINE 3 COLUMN 10 VALUE
"* Enter values into the fields below. Note that when a
- " field is typed,".
03 LINE 4 COLUMN 14 VALUE
"it is turned into asterisks, which will hide the val
- "ue entered.".
03 LINE 5 COLUMN 10 VALUE
"* You may still use RETURN and TAB to advance to the n
- "ext field,".
03 LINE 6 COLUMN 14 VALUE
"and use BACK TAB to return to a previous field.".
03 LINE 7 COLUMN 10 VALUE
'* Fields described as "NUMBER" can only contain digits
- ', signs, '.
03 LINE 8 COLUMN 14 VALUE
'and a decimal point.'.
03 SS-LINE-10.
05 LINE 10.
05 COLUMN 1 VALUE
"FEATURE DEMONSTRATED".
05 COLUMN 23 VALUE
"ANY CHARACTER".
05 COLUMN 39 VALUE
"NUMBER".
05 COLUMN 49 VALUE
"NUMBER".
05 COLUMN 58 VALUE
"NUMBER".
03 SS-LINE-12.
05 LINE 12.
05 COLUMN 1 VALUE
"NO ORIGINAL VALUE".
05 COLUMN 23 PIC X(13) TO ANY-CHAR-1.
05 COLUMN 39 PIC S9(6) TO INTEGER-1.
05 COLUMN 49 PIC S9(4)V99 TO TWO-PLACE-NUM-1.
05 COLUMN 58 PIC SV9(5) TO FIVE-PLACE-NUM-1.
03 SS-LINE-13.
05 LINE 13.
05 COLUMN 1 VALUE
"UPDATE VALUES".
05 COLUMN 23 PIC X(13) USING ANY-CHAR-2.
05 COLUMN 39 PIC S9(6) USING INTEGER-2.
05 COLUMN 49 PIC S9(4)V99 USING TWO-PLACE-NUM-2.
05 COLUMN 58 PIC SV9(5) USING FIVE-PLACE-NUM-2.
03 SS-LINE-14.
05 LINE 14.
05 COLUMN 1 VALUE
"HIGHLIGHT,REV-VIDEO".
05 COLUMN 23 PIC X(13) USING ANY-CHAR-3 HIGHLIGHT.
05 COLUMN 39 PIC S9(6) USING INTEGER-3 HIGHLIGHT.
05 COLUMN 49 PIC S9(4)V99 USING TWO-PLACE-NUM-3
REVERSE-VIDEO.
05 COLUMN 58 PIC SV9(5) USING FIVE-PLACE-NUM-3
REVERSE-VIDEO.
03 SS-LINE-15.
05 LINE 15.
05 COLUMN 1 VALUE
"UNDERLINE-BLINK".
05 COLUMN 23 PIC X(13) USING ANY-CHAR-4
UNDERLINE.
05 COLUMN 39 PIC S9(6) USING INTEGER-4
UNDERLINE.
05 COLUMN 49 PIC S9(4)V99 USING TWO-PLACE-NUM-4
BLINK.
05 COLUMN 58 PIC SV9(5) USING FIVE-PLACE-NUM-4
BLINK.
03 SS-LINE-16.
05 LINE 16.
05 COLUMN 1 VALUE
"AUTO-SKIP".
05 COLUMN 23 PIC X(13) USING ANY-CHAR-5
AUTO.
05 COLUMN 39 PIC S9(6) USING INTEGER-5
AUTO.
05 COLUMN 49 PIC S9(4)V99 USING TWO-PLACE-NUM-5
AUTO.
05 COLUMN 58 PIC SV9(5) USING FIVE-PLACE-NUM-5
AUTO.
03 SS-LINE-17.
05 LINE 17.
05 COLUMN 1 VALUE
"BELL + OTHERS".
05 COLUMN 23 PIC X(13) USING ANY-CHAR-6
HIGHLIGHT BELL.
05 COLUMN 39 PIC S9(6) USING INTEGER-6
REVERSE-VIDEO BELL.
05 COLUMN 49 PIC S9(4)V99 USING TWO-PLACE-NUM-6
UNDERLINE BELL.
05 COLUMN 58 PIC SV9(5) USING FIVE-PLACE-NUM-6
BLINK BELL.
01 FINAL-SCREEN.
03 BLANK SCREEN.
03 LINE 1 COLUMN 21 VALUE
' END OF MICROSOFT MS-COBOL DEMONSTRATION'.
03 LINE 3 COLUMN 15 PIC X(50) FROM WS-TITLE.
03 LINE 5 COLUMN 1 VALUE
'Thank you for taking part in this demonstration of '.
03 LINE 6 COLUMN 1 VALUE
'the features of Microsoft MS-COBOL.'.
03 LINE 8 COLUMN 1 HIGHLIGHT VALUE
'Please hit ENTER to end this program. '.
03 COLUMN PLUS 1 PIC X TO ANY-CHAR.
PROCEDURE DIVISION.
P000-MAIN-LINE.
*
* *** DEMO.CPY IS A COPY FILE OF PRE-PROCESSING WARNINGS ***
* *** IT MUST ALWAYS END WITH:
* PERFORM P005-PROCESS.
*
COPY DEMO.CPY.
STOP RUN.
P005-PROCESS.
DISPLAY TUTOR-SCREEN.
ACCEPT TUTOR-SCREEN.
PERFORM P010-CENTER-TITLE.
PERFORM P100-GET-OPTIONS
UNTIL DEMO-FINISHED.
DISPLAY FINAL-SCREEN.
ACCEPT FINAL-SCREEN.
DISPLAY BLANK-SCREEN.
P010-CENTER-TITLE.
IF WS-WK-TITLE = SPACES
MOVE SPACES TO WS-TITLE
ELSE
PERFORM P020-CENTER.
P020-CENTER.
PERFORM P025-NOTHING VARYING IIX FROM 1 BY 1
UNTIL WS-WK-TITLE-CHAR (IIX) NOT = SPACE
OR IIX > 50.
PERFORM P025-NOTHING VARYING JIX FROM 50 BY -1
UNTIL WS-WK-TITLE-CHAR (JIX) NOT = SPACE
OR JIX NOT > 1.
COMPUTE WS-TITLE-LEN = JIX - IIX + 1.
COMPUTE WS-START = 1 + ((50 - WS-TITLE-LEN) / 2).
COMPUTE WS-END = WS-TITLE-LEN + WS-START - 1.
PERFORM P030-MOVE-TITLE VARYING KIX FROM WS-START
BY 1 UNTIL KIX > WS-END.
P025-NOTHING.
EXIT.
P030-MOVE-TITLE.
MOVE WS-WK-TITLE-CHAR (IIX) TO WS-TITLE-CHAR (KIX).
ADD 1 TO IIX.
P100-GET-OPTIONS.
MOVE ZERO TO WS-OPTION.
DISPLAY OPTION-SCREEN.
ACCEPT OPTION-SCREEN.
IF SCREEN-OPTION
PERFORM P500-SCREEN-DEMO
ELSE IF CREATE-OPTION
PERFORM P200-CREATE-DATA-FILE
ELSE IF UPDATE-OPTION
PERFORM P300-UPDATE-DATA-FILE
ELSE IF END-OPTION
MOVE ON-VALUE TO DEMO-FINISHED-SW.
P200-CREATE-DATA-FILE.
CALL "BUILD" USING WS-TITLE.
P300-UPDATE-DATA-FILE.
CHAIN "UPDATE.EXE" USING WS-TITLE.
P500-SCREEN-DEMO-SECTION SECTION 50.
P500-SCREEN-DEMO.
DISPLAY SCREEN-SCREEN.
ACCEPT SCREEN-SCREEN.
DISPLAY SCREEN-SCREEN-2.
ACCEPT SCREEN-SCREEN-2.
DISPLAY NORMAL-SCREEN.
DISPLAY HINT-SCREEN.
ACCEPT NORMAL-SCREEN.
DISPLAY AUTO-SKIP-SCREEN.
DISPLAY HINT-SCREEN.
ACCEPT AUTO-SKIP-SCREEN.
DISPLAY SECURE-SCREEN.
DISPLAY HINT-SCREEN.
ACCEPT SECURE-SCREEN.


BIN
Microsoft COBOL v112/DEMO.CPY Normal file
View File

Binary file not shown.

BIN
Microsoft COBOL v112/DEMO__01.OVL Normal file
View File

Binary file not shown.

59
Microsoft COBOL v112/E.COB Normal file
View File

@ -0,0 +1,59 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. E.
* REMARKS. generate digits of e
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 ARRAYS.
02 A PIC 9(04) COMP OCCURS 200 TIMES.
01 X PIC 9(04) COMP VALUE 0.
01 TMOD PIC 9(04) COMP VALUE 0.
01 TM PIC 9(04) COMP VALUE 0.
01 TD PIC 9(04) COMP VALUE 0.
01 N PIC 9(04) COMP VALUE 0.
01 HV PIC 9(04) COMP VALUE 0.
01 NXX PIC 99.
PROCEDURE DIVISION.
MAIN.
DISPLAY 'computing e'.
PERFORM INITA-ROUTINE.
PERFORM INITA-ROUTINE-B.
PERFORM INITA-ROUTINE-C.
PERFORM OUTER-LOOP.
DISPLAY 'done'.
STOP RUN.
INITA-ROUTINE.
MOVE 200 TO HV.
MOVE 0 TO X.
MOVE 199 TO N.
INITA-ROUTINE-B.
MOVE 1 TO A( N + 1 ).
SUBTRACT 1 FROM N.
IF N > 0 GO TO INITA-ROUTINE-B.
INITA-ROUTINE-C.
MOVE 2 TO A( 2 ).
MOVE 0 TO A( 1 ).
OUTER-LOOP.
SUBTRACT 1 FROM HV.
MOVE HV TO N.
PERFORM INNER-LOOP.
IF HV > 9 GO TO OUTER-LOOP.
INNER-LOOP.
DIVIDE X BY N GIVING TD.
COMPUTE TMOD = ( X - ( TD * N ) )
IF 0 = X MOVE 0 TO TMOD.
MOVE TMOD TO A( N + 1 ).
MULTIPLY 10 BY A( N ) GIVING TM.
COMPUTE X = TM + TD.
SUBTRACT 1 FROM N.
IF N > 0 GO TO INNER-LOOP.
MOVE X TO NXX.
DISPLAY NXX.

BIN
Microsoft COBOL v112/INSTALL.COM Normal file
View File

Binary file not shown.

BIN
Microsoft COBOL v112/INSTALL.DAT Normal file
View File

Binary file not shown.

BIN
Microsoft COBOL v112/INSTALL.MSG Normal file
View File

Binary file not shown.

0
Microsoft COBOL v112/INSTALL.OVD Normal file
View File

BIN
Microsoft COBOL v112/INSTALL.OVL Normal file
View File

Binary file not shown.

BIN
Microsoft COBOL v112/INSTALL.SPC Normal file
View File

Binary file not shown.

BIN
Microsoft COBOL v112/LINK.EXE Normal file
View File

Binary file not shown.

BIN
Microsoft COBOL v112/Microsoft_COBOL_Compiler.pdf Normal file
View File

Binary file not shown.

BIN
Microsoft COBOL v112/Microsoft_COBOL_Reference_Manual.pdf Normal file
View File

Binary file not shown.

502
Microsoft COBOL v112/README.DOC Normal file
View File

@ -0,0 +1,502 @@
Microsoft MS-COBOL Compiler
Release 1.12 Update Notice
March 8, 1984
The MS-COBOL compiler for the 8086/8088 micropro-
cessor under MS-DOS release 1.12 contains several
enhancements and corrections to previous releases.
*********************************************************
** **
** Important Notice **
** **
*********************************************************
*1* All ISAM files (ORGANIZATION IS INDEXED), created
or modified by versions of Cobol prior to 1.10
<<MUST>> be run through version 1.21 of the
REBUILD program prior to being used by version
1.12 of Cobol. We strongly suggest REBUILDing and
subsequently using only version 1.12 for ISAM file
handling. See the corrections listed below.
*2* When converting to version 1.12 from previous ver-
sions, ALL PROGRAMS MUST BE RECOMPILED. Programs
compiled with previous versions, and linked with
the version 1.12 libraries may not work properly.
Enhancements
** The REBUILD utility now accepts valid MS-DOS 2.0
path names for its files, and allows the creation
of a key file from an indexed data file without
duplicating the data file. REBUILD also allows
its paramaters to be entered using the command
line bypassing its normal interactive method. See
the added information on REBUILD below.
NOTE: REBUILD must be used on ISAM files created
by previous versions of Cobol due to possible
errors in the key file structure.
** DOS 2.0 pathnames can now be used within Cobol
programs. When the VALUE OF FILE-ID is a literal,
the length is still limited to 16 characters. When
VALUE OF FILE-ID is an identifier, the length of
the specified filename, including path, may be up
to 64 characters. Note that pathnames cannot be
used with compiler itself for source, object and
list filenames.
** A limitation which existed on the size of an item
subordinate to an item sontaining an OCCURS clause
(2048 byte maximum size) has been removed.
** The INSTALL terminal interface now supports color
for the IBM and Compaq Personal Computers and the
Texas Instruments Professional Computer. The
reserved words FOREGROUND-COLOR and BACKGROUND-
COLOR may be used to add color to SCREEN SECTION
displays. They have no effect when used on
machines for which color is not supported by
INSTALL. See the color addendum at the end of
this file.
** The DEC Rainbow computer has been added to the
list of installable machines. See the DEC Rainbow
addendum at the end of this file.
** Compiler switches /T and /C now allow drives A
through Z to be specified. Previous limit was A
through D.
Corrections
** When a numeric or alphanumeric editted field was
entered in a screen, and if had an attribute, such
as highlight or underline set, when it was
redisplayed in it's editted form, the attribute
would be lost.
** A bug was introduced in 1.10 such that if a number
fo records were deleted from an ISAM file, occas-
sionally a subsequent START would fail.
** When a Subprogram containing an overlay is
invoked, after which another subprogram containing
an overlay is invoked, the return will attempt to
reload an overlay in the calling program, regard-
less of whether or not there was one.
** When SORT was invoked, if memory needed to be
reallocated, the program could crash.
** Corrected the detection of bad PICTUREs for
numeric items.
** The handling of quoted literals, continued quoted
literals and continued quoted literals which were
continued at an embedded quote character has been
corrected.
** A problem in the ISAM handler resulted when a cer-
tain set of conditions were met when inserting a
record. The key for the record would be inserted
into the index improperly. In most cases this was
transparent, but in some cases could result in the
record being available only under sequential
access, and not being found in random mode.
Version 1.10 of Cobol corrects this problem, how-
ever ISAM files created or modified by previous
versions of Cobol must be run through REBUILD
prior to their use. These files may have an
erroneous index structure that may render some
records unfindable in random mode. Insure that the
version of REBUILD used is 1.21 or greater, and
the version of Cobol used thereafter is version
1.10 or greater.
** A bug has been corrected in the ISAM file handler
that would not mark a deleted record as being
deleted in the data file if it was the only record
in the file. REBUILD would then restore the record
that had been deleted.
** The compiler now requires that ACCESS MODE be
SEQUENTIAL when the file organization is sequen-
tial.
** The compiler now requires that numeric items be no
longer than 18 digits.
** The compiler will now trap attempts to write the
object or the list file onto the source file, as
well as onto each other.
** The message "No errors or warnings" is now sent to
the list file.
** The compiler now traps attempts to use a VALUE
clause when the when an OCCURS clause is also
used.
** A bug has been corrected where at any time follow-
ing a CALL to another program, if an I/O error
occurred (such as opening a non-existent file for
I-O), the program would occassionaly get lost and
produce unexpected results.
** A bug has been corrected where a PERFORM in a
CALLed subroutine would occasionally be errone-
ously trapped with a "PERFORM OVERLAP".
** A bug has been corrected where if, in a statement
generating a Numeric Edit, the source field has to
be converted, such as from COMP-3, and an overflow
occurs in the edit, then all further leading zero
suppression in numeric editing is disabled until a
similar operation occurs that does not generate
such an overflow.
** A bug has been corrected which would not allow a
value to be displayed PIC ??? FROM <literal> in a
screen section.
** A bug has been corrected in the UNSTRING state-
ment. If a POINTER is used, and is initially out
of range, it is now handled properly.
** A bug has been corrected in which literals in the
VALUE OF FILE-ID clause of exactly 17 characters
were truncated to 16 characters without warning.
Now any literals longer than 16 characters will
produce an error message.
** A bug has been corrected which would not allow a
group item to be given a VALUE of ZERO.
** A bug has been corrected that affected relative
files with certain record lengths and cause them
to return disk full status when a record was writ-
ten at a 64k boundary in the file.
** A bug has been corrected that prevented sub-
scripted variables from being passed to a called
program correctly. This bug also occasionally
affected program branches by sending them to
erroneous targets, and then flagging a Run-Time
error.
** Filenames CON and PRN now work properly with
line-sequential files under MS-DOS and PC-DOS.
Previously, the data could occassionally be
displayed or printed in improper order.
** A compiler crash when a quoted literal was improp-
erly continued in area A has been corrected.
** A program with a large number of CALLs (usually
over 120), now no longer generates an invalid
object module. The exact number of calls required
to generate the invalid code was a function of the
additional features, such as numeric edit,
alphanumeric edit, ISAM, etc. that were required
by the program.
** A bug has been corrected whereby the compiler
would crash if a very large variable were
declared. For example: A OCCURS 1023 PIC X(120).
** A bug has been corrected in which very large pro-
grams, or programs with a large number of jump,
branch and perform targets, would compile
incorrectly.
** Line numbers in error messages pertaining to pro-
cedure header lines are now printed correctly.
** COMP-0 variables now properly handle the value
-32768.
** CTRL-BREAK is now checked at every procedure
header under MS-DOS.
** A bug in the ACCEPT handler which lost screen out-
put if an item was ACCEPTed whose length exceeded
the amount of room left on the screen has been
corrected.
** Certain improper REDEFINES constructs are now
flaged as errors by the compiler.
** The INSTALL terminal interface utility has been
corrected so that the "Define your own terminal"
option now allows COBOL function keys to be
defined.
** A bug has been fixed which disallowed multiple
screen attributes (HIGHLIGHT, REVERSE-VIDEO,
UNDERLINE, BLINK) in a single screen item.
** A bug has been corrected where if a file was
defined, used in a SAME RECORD AREA clause, but
never otherwise referenced, improper object code
would be generated.
Enhancements to REBUILD Version 1.21
REBUILD, the Indexed File Recovery Utility, has been
enhanced in version 1.21 to allow a new Indexed key file to
be created without producing a new Indexed data file. The
resulting key and data file may be used in exactly the same
way as any other Indexed file. REBUILD has also been given
the ability to accept its input from a command line, making
its use in batch files simpler.
Any previously existing Indexed key files to be used
with programs running under MS-COBOL versions 1.10 and later
must be rebuilt with REBUILD, version 1.21 or later. Version
1.21 of REBUILD allows the key file to be recreated while
still using the original data file. Indexed files processed
with version 1.21 of REBUILD may be used with all MS-COBOL
programs from version 1.0 and later.
See Appendix E - REBUILD: INDEXED FILE RECOVERY UTILITY
in the Microsoft COBOL Compiler User's Guide for more detail
on REBUILD. Note that this appendix does not currently con-
tain information on these enhancements.
INTERACTIVE MODE
To create only a new key file in interactive mode type
REBUILD followed by <RETURN> in response to the operating
system prompt. REBUILD will issue four prompts for informa-
tion on the file to be rebuilt. The data required are key
length, position of key in data record ,source file name and
target file name. The key length, key position, and source
file name prompts should be answered as in previous versions
of REBUILD. (See Appendix E of the Microsoft COBOL Compiler
User's Guide for examples).
The target file name prompt appears as:
Input the file name of the target data file
(should not have the extension of .KEY)
or <RETURN> to return to the Key Length prompt.
If the target file name is the same as
the source file name, a key file with
the source file name and extension ".KEY"
will be produced without producing a
new data file. ----->
If the file name entered is the same as the source file
name, a key file with the name <source file>.KEY will be
created, but the source data file will be used unchanged.
Example 1. Interactive mode - creating key file only
Input Key Length: 52
Input Key Position: 13
Input Source File-name: IXFILE.DAT
Input Target File-name: IXFILE.DAT
File IXFILE.KEY will be created, overwriting any
existing IXFILE.KEY, and may be used with IXFILE.DAT in
any MS-COBOL programs.
Example 2. Interactive mode - creating key and data
files
Input Key Length: 52
Input Key Position: 13
Input Source File-name: IXFILE.DAT
Input Target File-name: NEWIX.DAT
Files NEWIX.DAT and NEWIX.KEY will be created, and
may be used in any MS-COBOL programs. IXFILE.KEY, if
present, is unchanged.
COMMAND LINE MODE
REBUILD may also be invoked with data contained in the
command line. You may enter REBUILD <command line> followed
by <RETURN>, where <command line> is of the form:
<source file name>,<target file name>,<key description>
with no spaces allowed in the command line. <key descrip-
tion> is of the form:
<key position>:<key length>
Any command line argument entered after <source file
name> may be defaulted by placing a semicolon (;) after the
last argument desired. If <target file name> is defaulted,
but <key description> is desired, type two commas between
<source file name> and <key description>. (See example 3
below). The defaults used are:
<target file> Default is <source file name>, causing a key
file with the source file name and extension
".KEY" to be created; no new data file will
be created.
<key description>Default is 1:1
REBUILD will prompt for any information not provided on
the command line.
Example 3. Command Line mode - creating key file only
(Same results as Example 1 above)
REBUILD IXFILE.DAT,,13:52
File IXFILE.KEY will be created, overwriting any
existing IXFILE.KEY, and may be used with IXFILE.DAT in
any MS-COBOL programs.
Example 4. Command Line mode - creating key and data
files
(Same results as Example 2 above)
REBUILD IXFILE.DAT,NEWIX.DAT,13:52
Files NEWIX.DAT and NEWIX.KEY will be created, and
may be used in any MS-COBOL programs. IXFILE.KEY, if
present, is unchanged.
Color in the MS-COBOL SCREEN SECTION
For release 1.10 of MS-COBOL, the IBM PC and Compaq
Personal Computers and the Texas Instruments Professional
Computer are the only machines with color support.
The clauses: <FOREGROUND-COLOR integer> and
<BACKGROUND-COLOR integer> may be included in the descrip-
tion of an elementary screen item. (See the Microsoft COBOL
Reference Manual, section 5.3.4, for a description of ele-
mentary screen items).
The value of "integer" can range from 0 through 15, and
is used to select the desired color. The actual colors used
vary by machine. If black and white monitors are used, or
color is not supported by INSTALL, use of FOREGROUND-COLOR
and BACKGROUND-COLOR will either have no effect or cause
screen displays to use different shades of gray.
If FOREGROUND-COLOR or BACKGROUND-COLOR is used in the
same elementary screen item as the BLANK SCREEN clause, the
colors chosen become the default colors for all following
screen items that do not explicitly define colors. If the
BLANK SCREEN clause is not present in an elementary screen
item, colors chosen are in effect only for the current ele-
mentary screen item, and later items will use the default
colors, which are normally white on black. If REVERSE-VIDEO
is used in an elementary screen item, the values of the
foreground and background colors are switched.
Values of "integer" in FOREGROUND-COLOR and
BACKGROUND-COLOR clauses:
** IBM and Compaq Personal Computers **
FOREGROUND-COLOR BACKGROUND-COLOR
Integer Color Integer Color
0 black 0 black
1 blue 1 blue
2 green 2 green
3 cyan 3 cyan
4 red 4 red
5 magenta 5 magenta
6 brown 6 brown
7 white 7 white
8 gray 8 blinking black
9 light blue 9 blinking blue
10 light green 10 blinking green
11 light cyan 11 blinking cyan
12 light red 12 blinking red
13 light magenta 13 blinking magenta
14 yellow 14 blinking brown
15 high intensity white 15 blinking white
** Texas Instruments Professional Computer **
FOREGROUND-COLOR BACKGROUND-COLOR
Integer Color Integer Color
0 black not supported (no effect if
1 blue BACKGROUND-COLOR clause is used)
2 green
3 cyan
4 red
5 magenta
6 brown
7 white
(colors 8 - 15 are the same as 0 - 7)
DEC Rainbow 100 Addendum
INSTALL Information
EDITING KEYS
Delete Line CTRL-U,CTRL-X
Delete Character DEL key
Forward Space CTRL-F or right arrow key
Back Space CTRL-H or left arrow key
Plus Sign +
Minus Sign -
TERMINATOR KEYS
Escape ESC (F11)
Back Tab CTRL-B or up arrow key
Tab CTRL-I or TAB or down arrow key
Carriage Return CTRL-M or Return
Line Feed CTRL-J or Line Feed (F13)
FUNCTION KEYS
Function 1 CTRL-E 1 or PF1
Function 2 CTRL-E 2 or PF2
Function 3 CTRL-E 3 or PF3
Function 4 CTRL-E 4 or PF4
Function 5 CTRL-E 5
Function 6 CTRL-E 6
Function 7 CTRL-E 7
Function 8 CTRL-E 8
Function 9 CTRL-E 9
Function 10 CTRL-E 0
Notes
The Rainbow function keys (F1 through F20) are not used
by MS-COBOL. Keys PF1 through PF4, on the numeric
keypad, may be used as function keys 1 through 4.
A blinking cursor will remain on in the upper right
hand corner of the screen while any MS-COBOL program is
running.

BIN
Microsoft COBOL v112/REBUILD.EXE Normal file
View File

Binary file not shown.

53
Microsoft COBOL v112/SIEVE.COB Normal file
View File

@ -0,0 +1,53 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. SIEVE.
* REMARKS. BYTE magazine benchmark.
* REMARKS. MS Cobol limits array sizes to 4095.
* REMARKS. Expected prime count: 1026.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 MISC.
03 I PIC 9(4) COMP.
03 PRIME PIC 9(4) COMP.
03 K PIC 9(4) COMP.
03 TOTAL-PRIME-COUNT PIC 9(4) COMP.
02 SIEVETABLE.
04 FLAGS PIC 9 COMP OCCURS 4095 TIMES.
01 NUM-DISP PIC 9999.
PROCEDURE DIVISION.
MAIN.
PERFORM ITER-ROUTINE 10 TIMES.
MOVE TOTAL-PRIME-COUNT TO NUM-DISP.
DISPLAY NUM-DISP ' primes'.
STOP RUN.
ITER-ROUTINE.
MOVE ZEROES TO TOTAL-PRIME-COUNT.
PERFORM TFR VARYING I FROM 1 BY 1 UNTIL I = 4095.
PERFORM DCP THRU DCE VARYING I FROM 0 BY 1 UNTIL I = 4094.
TFR.
MOVE 1 TO FLAGS(I).
DCP.
IF FLAGS( I + 1 ) = 0
GO TO DCE.
COMPUTE PRIME = I + I + 3.
COMPUTE K = I + PRIME.
FIRST1.
IF K > 4095 GO TO NEXT1.
MOVE 0 TO FLAGS( K + 1 ).
COMPUTE K = PRIME + K.
GO TO FIRST1.
NEXT1.
ADD 1 TO TOTAL-PRIME-COUNT.
* MOVE PRIME TO NUM-DISP.
* DISPLAY 'FOUND PRIME = ' NUM-DISP.
DCE.
EXIT.

171
Microsoft COBOL v112/TTT.COB Normal file
View File

@ -0,0 +1,171 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. TTT.
* REMARKS. prove tic-tac-toe is not winnable against a good foe.
* REMARKS. DOES NOT RUN WITH MS COBOL v1 or v2 due to recursive PERFORM
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 BOARD.
05 B PIC 9(04) COMP OCCURS 9 TIMES.
05 VALST PIC 9(04) COMP OCCURS 10 TIMES.
05 ALPHAST PIC 9(04) COMP OCCURS 10 TIMES.
05 BETAST PIC 9(04) COMP OCCURS 10 TIMES.
05 XST PIC 9(04) COMP OCCURS 10 TIMES.
05 PMST PIC 9(04) COMP OCCURS 10 TIMES.
01 MOVECOUNT PIC 9(04) COMP VALUE 0.
01 DEPTH PIC 9(04) COMP VALUE 0.
01 NUM-DISP PIC 9999.
01 ITER PIC 9(04) COMP VALUE 0.
01 WI PIC 9(04) COMP VALUE 0.
01 VAL PIC 9(04) COMP VALUE 0.
01 T PIC 9(04) COMP VALUE 0.
01 D PIC 9(04) COMP VALUE 0.
01 M PIC 9(04) COMP VALUE 0.
01 X PIC 9(04) COMP VALUE 0.
01 PM PIC 9(04) COMP VALUE 0.
01 SC PIC 9(04) COMP VALUE 0.
01 Z PIC 9(04) COMP VALUE 0.
01 ALPHA PIC 9(04) COMP VALUE 0.
01 BETA PIC 9(04) COMP VALUE 0.
01 FIRSTMOVE PIC 9(04) COMP VALUE 0.
PROCEDURE DIVISION.
MAIN.
DISPLAY 'hello from cobol'.
MOVE 1 TO ITER.
INITBOARD.
MOVE 0 TO B( ITER ).
ADD 1 TO ITER.
IF ITER < 10 GO TO INITBOARD.
MOVE 0 TO ITER.
NEXTITER.
MOVE 0 TO MOVECOUNT.
MOVE 1 TO FIRSTMOVE.
PERFORM RUNMM.
MOVE 2 TO FIRSTMOVE.
PERFORM RUNMM.
MOVE 5 TO FIRSTMOVE.
PERFORM RUNMM.
ADD 1 TO ITER.
IF ITER < 1 GO TO NEXTITER.
DISPLAY 'final move count and winner: '.
MOVE MOVECOUNT TO NUM-DISP.
DISPLAY NUM-DISP.
MOVE SC TO NUM-DISP.
DISPLAY NUM-DISP.
STOP RUN.
RUNMM.
MOVE 1 TO B( FIRSTMOVE ).
MOVE FIRSTMOVE TO X
MOVE 2 TO ALPHA
MOVE 9 TO BETA
PERFORM MINMAX.
MOVE 0 TO B( FIRSTMOVE ).
WINNER.
MOVE 0 TO WI.
MOVE B( 1 ) TO T.
IF 0 NOT = T AND T=B(2) AND T=B(3) MOVE T TO WI
ELSE IF 0 NOT= T AND T=B(4) AND T=B(7) MOVE T TO WI.
IF 0 = WI
MOVE B(2) TO T
IF 0 NOT= T AND T=B(5) AND T=B(8) MOVE T TO WI
ELSE
MOVE B(3) TO T
IF 0 NOT= T AND T=B(6) AND T=B(9) MOVE T TO WI
ELSE
MOVE B(4) TO T
IF 0 NOT= T AND T=B(5) AND T=B(6) MOVE T TO WI
ELSE
MOVE B(7) TO T
IF 0 NOT= T AND T=B(8) AND T=B(9) MOVE T TO WI
ELSE
MOVE B(5) TO T
IF 0 NOT= T AND T=B(1) AND T=B(9) MOVE T TO WI
ELSE
IF 0 NOT= T AND T=B(3) AND T=B(7) MOVE T TO WI.
SHOWPOS.
MOVE B(Z) TO NUM-DISP.
DISPLAY NUM-DISP.
SHOWBOARD.
DISPLAY 'board: '.
PERFORM SHOWPOS VARYING Z FROM 1 BY 1 UNTIL Z>9.
INITVALPM.
DIVIDE DEPTH BY 2 GIVING D.
MULTIPLY D BY 2 GIVING M.
IF DEPTH NOT = M
MOVE 2 TO VAL
MOVE 1 TO PM
ELSE
MOVE 9 TO VAL
MOVE 2 TO PM.
MINMAX.
DISPLAY 'minmax'
ADD 1 TO MOVECOUNT.
MOVE 0 TO VAL.
IF DEPTH > 3
PERFORM WINNER
IF WI NOT = 0
IF WI = 1 MOVE 6 TO VAL ELSE MOVE 4 TO VAL
ELSE IF DEPTH = 8 MOVE 5 TO VAL.
IF 0 = VAL
PERFORM INITVALPM
ADD 1 TO DEPTH
PERFORM MAKEMOVE VARYING X FROM 1 BY 1 UNTIL (X>9)
SUBTRACT 1 FROM DEPTH.
MOVE VAL TO SC.
UPDATEODD.
IF SC = 6 MOVE 10 TO X.
IF SC > VAL MOVE SC TO VAL.
IF VAL NOT < BETA MOVE 10 TO X.
IF VAL > ALPHA MOVE VAL TO ALPHA.
UPDATEEVEN.
IF SC = 4 MOVE 10 TO X.
IF SC < VAL MOVE SC TO VAL.
IF VAL NOT > ALPHA MOVE 10 TO X.
IF VAL < BETA MOVE VAL TO BETA.
UPDATESTATE.
IF PM = 1 PERFORM UPDATEODD
ELSE PERFORM UPDATEEVEN.
MAKEMOVE.
IF B( X ) = 0
MOVE PM TO B( X )
MOVE VAL TO VALST( DEPTH )
MOVE X TO XST( DEPTH )
MOVE PM TO PMST( DEPTH )
MOVE ALPHA TO ALPHAST( DEPTH )
MOVE BETA TO BETAST( DEPTH )
DISPLAY 'recursing to minmax'
PERFORM MINMAX
MOVE BETAST( DEPTH ) TO BETA
MOVE ALPHAST( DEPTH ) TO ALPHA
MOVE PMST( DEPTH ) TO PM
MOVE XST( DEPTH ) TO X
MOVE VALST( DEPTH ) TO VAL
MOVE 0 TO B( X )
PERFORM UPDATESTATE.

573
Microsoft COBOL v112/UPDATE.COB Normal file
View File

@ -0,0 +1,573 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. UPDATE.
SECURITY.
THIS PROGRAM MODIFIES AND LISTS AN INDEXED FILE OF
NAMES, ADDRESSES, AND PHONE NUMBERS
*
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT ISAM-FILE
ASSIGN TO DISK
FILE STATUS IS ISAM-STATUS
RECORD KEY IS ISAM-KEY
ACCESS MODE IS DYNAMIC
ORGANIZATION IS INDEXED.
SELECT MAIL-LIST-FILE
ASSIGN TO DISK
FILE STATUS IS MAIL-LIST-STATUS
ORGANIZATION IS LINE SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD ISAM-FILE
LABEL RECORDS ARE STANDARD
VALUE OF FILE-ID IS 'ISAM.DAT'.
01 ISAM-RECORD.
05 ISAM-KEY.
10 ISAM-LAST-NAME PIC X(20).
10 ISAM-FIRST-NAME PIC X(20).
05 ISAM-ADDRESS-LINE-1 PIC X(40).
05 ISAM-ADDRESS-LINE-2 PIC X(40).
05 ISAM-PHONE PIC X(12).
FD MAIL-LIST-FILE
LABEL RECORDS ARE STANDARD
VALUE OF FILE-ID IS 'MAIL.DAT'.
01 MAIL-LIST-RECORD PIC X(41).
WORKING-STORAGE SECTION.
01 WORK-FIELDS.
05 IIX PIC S9(5) VALUE 0 COMP-0.
05 JIX PIC S9(5) VALUE 0 COMP-0.
05 KIX PIC S9(5) VALUE 0 COMP-0.
05 WS-START PIC S9(5) VALUE 0 COMP-0.
05 WS-END PIC S9(5) VALUE 0 COMP-0.
05 ISAM-STATUS PIC XX VALUE SPACES.
05 MAIL-LIST-STATUS PIC XX VALUE SPACES.
05 WS-ACTION PIC X(20) VALUE SPACES.
05 WS-OPTION PIC X VALUE SPACE.
88 ADD-OPTION VALUE 'A', 'a'.
88 LIST-OPTION VALUE 'L', 'l'.
88 DELETE-OPTION VALUE 'D', 'd'.
88 MODIFY-OPTION VALUE 'M', 'm'.
88 EXIT-OPTION VALUE 'E', 'e'.
05 WS-TERMINATE PIC X VALUE SPACES.
88 TERMINATED VALUE 'T', 't', 'N', 'n',
'S', 's'.
05 ANY-CHAR PIC X VALUE SPACE.
01 SWITCHES.
05 ON-VALUE PIC X VALUE 'Y'.
05 OFF-VALUE PIC X VALUE 'N'.
05 UPDT-FINISHED-SW PIC X VALUE 'N'.
88 UPDT-FINISHED VALUE 'Y'.
01 WS-DATA-RECORD.
05 WS-KEY.
10 WS-LAST-NAME.
15 WS-LAST-NAME-CHAR OCCURS 20 TIMES PIC X.
10 WS-FIRST-NAME PIC X(20).
05 WS-ADDRESS-LINE-1 PIC X(40) VALUE SPACES.
05 WS-ADDRESS-LINE-2 PIC X(40) VALUE SPACES.
05 WS-PHONE PIC X(12) VALUE SPACES.
01 WS-MAIL-LIST-RECORD.
05 WS-ML-NAME.
10 WS-ML-NAME-CHAR PIC X OCCURS 41 TIMES.
05 WS-ML-ADDRESS-LINE-1 PIC X(40) VALUE SPACES.
05 WS-ML-ADDRESS-LINE-2 PIC X(40) VALUE SPACES.
01 WS-TITLE PIC X(50).
SCREEN SECTION.
01 BLANK-SCREEN.
03 BLANK SCREEN.
01 TUTOR-SCREEN.
03 BLANK SCREEN.
03 LINE 1 COLUMN 17 VALUE
'MS-COBOL INDEXED FILE UPDATE DEMONSTRATION'.
03 LINE 2 COLUMN 15 PIC X(50) FROM WS-TITLE HIGHLIGHT.
03 LINE 4 COLUMN 5 VALUE
'This is main program UPDATE, CHAINed to from main prog
- 'ram DEMO.'.
03 LINE 5 COLUMN 5 VALUE
'Since UPDATE was CHAINed to and not CALLed, control wi
- 'll not return'.
03 LINE 6 COLUMN 5 VALUE
'to DEMO.'.
03 LINE 8 COLUMN 1 VALUE
'In this program, you may list, add, delete, or modify
- 'records in file ISAM.DAT'.
03 LINE 9 COLUMN 1 VALUE
'which was created in subprogram BUILD. If you did not
- 'try the CREATE option'.
03 LINE 10 COLUMN 1 VALUE
'yet, please terminate this program by responding T bel
- 'ow, then execute'.
03 LINE 11 COLUMN 1 VALUE
'DEMO again, this time selecting option C to create the
- ' file which is'.
03 LINE 12 COLUMN 1 VALUE
'updated in this program. OK?.'.
03 LINE 14 COLUMN 1 VALUE
'To terminate this program type T, then hit ENTER.'.
03 LINE 15 COLUMN 1 HIGHLIGHT VALUE
'Hit ENTER by itself to continue:'.
03 COLUMN PLUS 1 PIC X TO WS-TERMINATE.
01 TUTOR-SCREEN-2.
03 BLANK SCREEN.
03 LINE 1 COLUMN 17 VALUE
'MS-COBOL INDEXED FILE UPDATE DEMONSTRATION'.
03 LINE 2 COLUMN 15 PIC X(50) FROM WS-TITLE HIGHLIGHT.
03 LINE 4 COLUMN 1 VALUE
'Ok. Since you have created file ISAM.DAT, you may now
- 'modify or'.
03 LINE 5 COLUMN 1 VALUE
'display its contents. One advantage of the MS-COBOL in
- 'dexed file'.
03 LINE 6 COLUMN 1 VALUE
'structure is that it automatically returns records sor
- 'ted by key when'.
03 LINE 7 COLUMN 1 VALUE
'the file is read sequentially.'.
03 LINE 9 COLUMN 1 VALUE
'You will now see a menu screen which will let you:'.
03 LINE 10 COLUMN 5 VALUE
'List the file, creating a file of mailing labels sorte
- 'd by last name,'.
03 LINE 11 COLUMN 10 VALUE
'then first name;'.
03 LINE 12 COLUMN 5 VALUE
'Add records to the file;'.
03 LINE 13 COLUMN 5 VALUE
'Delete records from the file;'.
03 LINE 14 COLUMN 5 VALUE
'Modify records on the file.'.
03 LINE 17 COLUMN 1 VALUE
'You will return to the options menu after you have com
- 'pleted'.
03 LINE 18 COLUMN 1 VALUE
'any set of actions, so that you may modify, then list
- 'the'.
03 LINE 19 COLUMN 1 VALUE
'file, as many times as you like.'.
03 LINE 21 COLUMN 1 HIGHLIGHT VALUE
'Please hit ENTER to continue.'.
03 COLUMN PLUS 1 PIC X TO ANY-CHAR.
01 OPTION-SCREEN.
03 BLANK SCREEN.
03 LINE 1 COLUMN 17 VALUE
'MS-COBOL INDEXED FILE UPDATE DEMONSTRATION'.
03 LINE 2 COLUMN 15 PIC X(50) FROM WS-TITLE HIGHLIGHT.
03 LINE 6 COLUMN 1 VALUE
'Please select one of the following options by typing t
- 'he first letter'.
03 LINE 7 COLUMN 1 VALUE
'of the option in the space below, then hitting ENTER.
- 'Option E'.
03 LINE 8 COLUMN 1 VALUE
'followed by ENTER will end this demonstration.'.
03 LINE 10 COLUMN 5 VALUE
'Option L: List records in indexed file sorted by last nam
- 'e, then first name'.
03 LINE 11 COLUMN 15 VALUE
'and create a mailing label file in the same order'.
03 LINE 12 COLUMN 5 VALUE
'Option A: Add a record to the indexed file'.
03 LINE 13 COLUMN 5 VALUE
'Option D: Delete a specified record in the indexed file'.
03 LINE 14 COLUMN 5 VALUE
'Option M: Modify a specified record in the indexed file'.
03 LINE 16 COLUMN 5 VALUE
'Option E: End this program'.
03 LINE 23 COLUMN 10 HIGHLIGHT VALUE
'Enter option here followed by ENTER: '.
03 COLUMN PLUS 1 PIC X TO WS-OPTION.
01 AFTERMATH-SCREEN.
03 BLANK SCREEN.
03 LINE 1 COLUMN 20 VALUE
'MS-COBOL INDEXED FILE UPDATE DEMONSTRATION'.
03 LINE 2 COLUMN 15 PIC X(50) FROM WS-TITLE HIGHLIGHT.
03 LINE 4 COLUMN 1 VALUE
'Action requested = '.
03 PIC X(20) FROM WS-ACTION HIGHLIGHT.
03 LINE 5 COLUMN 1 VALUE
'File status = '.
03 PIC XX FROM ISAM-STATUS HIGHLIGHT.
03 LINE 8 COLUMN 1 VALUE
'File status = 00 means action was successful'.
03 LINE 9 COLUMN 1 VALUE
'File status = 10 means END-OF-FILE encountered'.
03 LINE 10 COLUMN 1 VALUE
'File status = 21 means KEY NOT IN SEQUENCE'.
03 LINE 11 COLUMN 1 VALUE
'File status = 22 means ATTEMPT TO WRITE DUPLICATE KEY'.
03 LINE 12 COLUMN 1 VALUE
'File status = 23 means NO RECORD FOUND'.
03 LINE 13 COLUMN 1 VALUE
'File status = 24 means DISK FULL'.
03 LINE 14 COLUMN 1 VALUE
'File status = 30 means PERMANENT INPUT-OUTPUT ERROR'.
03 LINE 15 COLUMN 1 VALUE
'File status = 91 means FILE STRUCTURE WAS DAMAGED'.
03 LINE 18 COLUMN 1 VALUE
' Do you wish to '.
03 PIC X(6) FROM WS-ACTION HIGHLIGHT.
03 VALUE ' any more records (Y/N)?'.
03 LINE 20 COLUMN 10 HIGHLIGHT VALUE
'Reply (followed by ENTER) = '.
03 COLUMN PLUS 1 PIC X TO WS-TERMINATE.
01 LIST-SCREEN.
03 BLANK SCREEN.
03 LINE 1 COLUMN 17 VALUE
'MS-COBOL INDEXED FILE UPDATE DEMONSTRATION'.
03 LINE 2 COLUMN 15 PIC X(50) FROM WS-TITLE HIGHLIGHT.
03 LINE 4 COLUMN 1 VALUE
'The following record was written by you to file ISAM.D
- 'AT, and is now '.
03 LINE 5 COLUMN 1 VALUE
'sorted in ascending order by LAST NAME followed by FIR
- 'ST name.'.
03 LINE 7 COLUMN 1 PIC X(20) FROM WS-FIRST-NAME
HIGHLIGHT.
03 LINE 8 COLUMN 1 PIC X(20) FROM WS-LAST-NAME
HIGHLIGHT.
03 LINE 9 COLUMN 1 PIC X(40) FROM WS-ADDRESS-LINE-1
HIGHLIGHT.
03 LINE 10 COLUMN 1 PIC X(40) FROM WS-ADDRESS-LINE-2
HIGHLIGHT.
03 LINE 11 COLUMN 1 PIC X(12) FROM WS-PHONE AUTO
HIGHLIGHT.
03 LINE 13 COLUMN 1 VALUE
'The following records were written to file MAIL.DAT to
- 'be used for mailing'.
03 LINE 14 COLUMN 1 VALUE
'labels. File status of last write = '.
03 PIC XX FROM MAIL-LIST-STATUS HIGHLIGHT.
03 LINE 15 COLUMN 9 VALUE
'File status = 00 means action was successful'.
03 LINE 17 COLUMN 1 PIC X(41) FROM WS-ML-NAME
HIGHLIGHT.
03 LINE 18 COLUMN 1 PIC X(40) FROM WS-ML-ADDRESS-LINE-1
HIGHLIGHT.
03 LINE 19 COLUMN 1 PIC X(40) FROM WS-ML-ADDRESS-LINE-2
HIGHLIGHT.
03 LINE 21 COLUMN 9 VALUE
'Do you wish to read the next record?'.
03 LINE 22 COLUMN 12 VALUE
'Reply ENTER by itself to continue reading the file. Type
- 'S followed '.
03 LINE 23 COLUMN 12 VALUE
'by ENTER to stop reading the file.'.
03 LINE 23 COLUMN 50 HIGHLIGHT VALUE
'Reply = '.
03 COLUMN PLUS 1 PIC X TO WS-TERMINATE.
01 NAME-ADDRESS-SCREEN.
03 NAME-SCREEN.
05 BLANK SCREEN.
05 LINE 1 COLUMN 17 VALUE
'MS-COBOL INDEXED FILE UPDATE DEMONSTRATION'.
05 LINE 2 COLUMN 15 PIC X(50) FROM WS-TITLE HIGHLIGHT.
05 LINE 4 COLUMN 1 VALUE
'Please enter the data requested below. To exit from th
- 'is program'.
05 LINE 5 COLUMN 1 VALUE
'reply N to the question: "Do you wish to enter more da
- 'ta?(Y/N)"'.
05 LINE 6 COLUMN 1 VALUE
'when it appears on the screen.'.
05 LINE 8 COLUMN 1 VALUE
'Enter FIRST name and initial (1 to 20 characters): '.
05 LINE 9 COLUMN 1 VALUE '[' HIGHLIGHT.
05 LINE 9 COLUMN 2 PIC X(20) FROM WS-FIRST-NAME
TO WS-FIRST-NAME.
05 LINE 9 COLUMN 22 VALUE ']' HIGHLIGHT.
05 LINE 10 COLUMN 1 VALUE
'Enter LAST name (1 to 20 characters): '.
05 LINE 11 COLUMN 1 VALUE '[' HIGHLIGHT.
05 LINE 11 COLUMN 2 PIC X(20) FROM WS-LAST-NAME
TO WS-LAST-NAME.
05 LINE 11 COLUMN 22 VALUE ']' HIGHLIGHT.
03 ADDRESS-SCREEN.
05 LINE 13 COLUMN 1 VALUE
'Enter first address line (1 to 40 characters): '.
05 LINE 14 COLUMN 1 VALUE '[' HIGHLIGHT.
05 LINE 14 COLUMN 2 PIC X(40) FROM WS-ADDRESS-LINE-1
TO WS-ADDRESS-LINE-1.
05 LINE 14 COLUMN 42 VALUE ']' HIGHLIGHT.
05 LINE 15 COLUMN 1 VALUE
'Enter second address line (1 to 40 characters): '.
05 LINE 16 COLUMN 1 VALUE '[' HIGHLIGHT.
05 LINE 16 COLUMN 2 PIC X(40) TO WS-ADDRESS-LINE-2
FROM WS-ADDRESS-LINE-2.
05 LINE 16 COLUMN 42 VALUE ']' HIGHLIGHT.
05 LINE 18 COLUMN 1 VALUE
'Enter phone number (XXX-XXXX or XXX-XXX-XXXX): '.
05 LINE 19 COLUMN 1 VALUE '[' HIGHLIGHT.
05 LINE 19 COLUMN 2 PIC X(12) FROM WS-PHONE
TO WS-PHONE.
05 LINE 19 COLUMN 14 VALUE ']' HIGHLIGHT.
05 LINE 21 COLUMN 10 VALUE
'If data is OK, hit ENTER to write to the file. You can
- 'use BACK TAB to '.
05 LINE 22 COLUMN 15 VALUE
'return to previous fields and modify data with cursor pos
- 'itioning.'.
05 LINE 23 COLUMN 15 VALUE
'keys. '.
05 LINE 23 COLUMN 21 HIGHLIGHT VALUE
'Hit ENTER here to continue: '.
05 COLUMN PLUS 1 PIC X TO ANY-CHAR.
01 EOF-SCREEN.
03 BLANK SCREEN.
03 LINE 1 COLUMN 17 VALUE
'MS-COBOL INDEXED FILE UPDATE DEMONSTRATION'.
03 LINE 3 COLUMN 15 PIC X(50) FROM WS-TITLE HIGHLIGHT.
03 LINE 6 COLUMN 1 VALUE
'You have reached the end of the file ISAM.DAT.'.
03 LINE 8 COLUMN 1 VALUE
'You have also built the line sequential file MAIL.DAT, a
- 'sorted file'.
03 LINE 9 COLUMN 1 VALUE
'of mailing labels. You will now return to the options scr
- 'een, where '.
03 LINE 10 COLUMN 1 VALUE
'you can again modify or list ISAM.DAT. When you choose op
- 'tion E to end'.
03 LINE 11 COLUMN 1 VALUE
'this demonstration and return to the operating system, yo
- 'u may use the'.
03 LINE 12 COLUMN 1 VALUE
'system TYPE command to list file MAIL.DAT.'.
03 LINE 18 COLUMN 1 HIGHLIGHT VALUE
'Please hit ENTER to return to the options menu: '.
03 COLUMN PLUS 1 PIC X TO ANY-CHAR.
01 FINAL-SCREEN.
03 BLANK SCREEN.
03 LINE 1 COLUMN 21 VALUE
' END OF MICROSOFT MS-COBOL DEMONSTRATION'.
03 LINE 3 COLUMN 15 PIC X(50) FROM WS-TITLE HIGHLIGHT.
03 LINE 5 COLUMN 1 VALUE
'Thank you for taking part in this demonstration of '.
03 LINE 6 COLUMN 1 VALUE
'the features of Microsoft MS-COBOL.'.
03 LINE 8 COLUMN 1 VALUE
'After hitting ENTER to end this program, you can use the
- 'system TYPE '.
03 LINE 9 COLUMN 5 VALUE
'command to list file MAIL.DAT and see the mailing list
- ' you have built. '.
03 LINE 16 COLUMN 1 HIGHLIGHT VALUE
'Please hit ENTER to end this program.'.
03 COLUMN PLUS 1 PIC X TO ANY-CHAR.
PROCEDURE DIVISION CHAINING WS-TITLE.
P000-MAIN-LINE.
DISPLAY TUTOR-SCREEN.
ACCEPT TUTOR-SCREEN.
IF TERMINATED
STOP RUN.
OPEN I-O ISAM-FILE.
IF ISAM-STATUS NOT = '00'
DISPLAY ' FILE OPEN FAILURE. JOB CANCELLED'
DISPLAY 'FILE STATUS = ', ISAM-STATUS
DISPLAY 'TYPE ANY CHARACTER TO END JOB'
ACCEPT ANY-CHAR
ELSE
DISPLAY TUTOR-SCREEN-2
ACCEPT TUTOR-SCREEN-2
PERFORM P100-GET-DATA
UNTIL UPDT-FINISHED.
CLOSE ISAM-FILE.
DISPLAY BLANK-SCREEN.
STOP RUN.
P100-GET-DATA.
MOVE SPACE TO WS-TERMINATE.
MOVE SPACE TO WS-OPTION.
MOVE SPACES TO WS-DATA-RECORD.
DISPLAY OPTION-SCREEN.
ACCEPT OPTION-SCREEN.
IF LIST-OPTION
MOVE 'MAIL LIST' TO WS-ACTION
PERFORM P110-START-FILE
OPEN OUTPUT MAIL-LIST-FILE
PERFORM P200-MAIL-LIST
UNTIL TERMINATED
CLOSE MAIL-LIST-FILE
ELSE IF ADD-OPTION
MOVE 'ADD' TO WS-ACTION
PERFORM P300-ADD
UNTIL TERMINATED
ELSE IF DELETE-OPTION
MOVE 'DELETE' TO WS-ACTION
PERFORM P400-DELETE
UNTIL TERMINATED
ELSE IF MODIFY-OPTION
MOVE 'MODIFY' TO WS-ACTION
PERFORM P500-MODIFY
UNTIL TERMINATED
ELSE IF EXIT-OPTION
DISPLAY FINAL-SCREEN
ACCEPT FINAL-SCREEN
MOVE ON-VALUE TO UPDT-FINISHED-SW
ELSE
NEXT SENTENCE.
P110-START-FILE.
MOVE SPACES TO ISAM-KEY.
START ISAM-FILE
KEY IS GREATER THAN ISAM-KEY
INVALID KEY PERFORM P900-START-ERROR.
P200-MAIL-LIST.
PERFORM P800-READ-ISAM.
IF NOT TERMINATED
PERFORM P210-BUILD-MAIL
DISPLAY LIST-SCREEN
ACCEPT LIST-SCREEN.
P210-BUILD-MAIL.
* PREPARE MAIL LIST RECORD. PLACE FIRST NAME AND
* INITIAL ON LINE, SEARCH FOR END, THEN MOVE LAST
* NAME TO LINE AND WRITE TO FILE MAIL.DAT.
MOVE WS-ADDRESS-LINE-1 TO WS-ML-ADDRESS-LINE-1.
MOVE WS-ADDRESS-LINE-2 TO WS-ML-ADDRESS-LINE-2.
MOVE WS-FIRST-NAME TO WS-ML-NAME.
IF WS-FIRST-NAME = SPACES
MOVE 1 TO IIX
ELSE
PERFORM P220-NOTHING VARYING IIX FROM 20 BY -1
UNTIL (WS-ML-NAME-CHAR (IIX) NOT = SPACE)
OR (IIX < 1)
ADD 2 TO IIX.
* ** IIX IS LOCATION FOR START OF LAST NAME
* *** FIND FIRST NON-BLANK IN LAST NAME
IF WS-LAST-NAME = SPACES
MOVE 1 TO WS-START, WS-END
ELSE
PERFORM P220-NOTHING VARYING JIX FROM 1 BY 1
UNTIL (WS-LAST-NAME-CHAR (JIX) NOT = SPACE)
OR (JIX > 20)
MOVE JIX TO WS-START
PERFORM P220-NOTHING VARYING JIX FROM 20 BY -1
UNTIL (WS-LAST-NAME-CHAR (JIX) NOT = SPACE)
OR (JIX < 1)
MOVE JIX TO WS-END.
* **** MOVE LAST NAME TO LINE
PERFORM P230-MOVE-NAME VARYING KIX FROM WS-START BY 1
UNTIL KIX > WS-END.
PERFORM P240-WRITE-MAIL-LIST.
P220-NOTHING.
EXIT.
P230-MOVE-NAME.
MOVE WS-LAST-NAME-CHAR (KIX) TO WS-ML-NAME-CHAR (IIX).
ADD 1 TO IIX.
P240-WRITE-MAIL-LIST.
WRITE MAIL-LIST-RECORD FROM WS-ML-NAME.
WRITE MAIL-LIST-RECORD FROM WS-ML-ADDRESS-LINE-1.
WRITE MAIL-LIST-RECORD FROM WS-ML-ADDRESS-LINE-2.
MOVE SPACES TO MAIL-LIST-RECORD.
WRITE MAIL-LIST-RECORD.
P300-ADD.
MOVE SPACES TO WS-DATA-RECORD.
DISPLAY NAME-ADDRESS-SCREEN.
ACCEPT NAME-ADDRESS-SCREEN.
PERFORM P700-WRITE-ISAM.
DISPLAY AFTERMATH-SCREEN.
ACCEPT AFTERMATH-SCREEN.
P400-DELETE.
MOVE SPACES TO WS-DATA-RECORD.
DISPLAY NAME-SCREEN.
ACCEPT NAME-SCREEN.
PERFORM P820-DELETE-ISAM.
DISPLAY AFTERMATH-SCREEN.
ACCEPT AFTERMATH-SCREEN.
P500-MODIFY.
MOVE SPACES TO WS-DATA-RECORD.
DISPLAY NAME-SCREEN.
ACCEPT NAME-SCREEN.
PERFORM P810-RANDOM-READ-ISAM.
IF ISAM-STATUS = '00'
DISPLAY NAME-SCREEN
DISPLAY ADDRESS-SCREEN
ACCEPT ADDRESS-SCREEN
PERFORM P710-REWRITE-ISAM.
DISPLAY AFTERMATH-SCREEN.
ACCEPT AFTERMATH-SCREEN.
P700-WRITE-ISAM.
WRITE ISAM-RECORD FROM WS-DATA-RECORD.
P710-REWRITE-ISAM.
REWRITE ISAM-RECORD FROM WS-DATA-RECORD.
P800-READ-ISAM.
READ ISAM-FILE NEXT INTO WS-DATA-RECORD
AT END
MOVE 'T' TO WS-TERMINATE
DISPLAY EOF-SCREEN
ACCEPT EOF-SCREEN.
P810-RANDOM-READ-ISAM.
MOVE WS-DATA-RECORD TO ISAM-RECORD.
READ ISAM-FILE INTO WS-DATA-RECORD.
P820-DELETE-ISAM.
MOVE WS-DATA-RECORD TO ISAM-RECORD.
DELETE ISAM-FILE RECORD.
P900-START-ERROR.
MOVE 'T' TO WS-TERMINATE.
DISPLAY EOF-SCREEN.
ACCEPT EOF-SCREEN.


BIN
Microsoft COBOL v112/UPDATE.EXE Normal file
View File

Binary file not shown.

9
Microsoft COBOL v112/m.bat Normal file
View File

@ -0,0 +1,9 @@
del %1.obj 2>nul
del %1.exe 2>nul
ntvdm -r:. -h -c -d cobol %1,%1,%1/D;
ntvdm -h -c -r:. link %1,%1,%1,C:;
ntvdm -c -m %1