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

Microsoft COBOL v2.1

Browse Source
This commit is contained in:
davidly 2024-07-24 06:58:04 -07:00
parent be2316a97c
commit 8fa056fa85
47 changed files with 3522 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

92
Microsoft COBOL v21/ASM.ASM Normal file
View File

@ -0,0 +1,92 @@
TITLE Assembly language interface table and macro (asmnam)
;*********************************************************************
;
; Contains the skeleton structure asmtab and the count of assembler
; routines, asmcnt. Contains the definition for macro asmnam, which
; produces the correct table entries for assembler and other non-COBOL
; routines.
;
INCLUDE pseg.mac
SUBTTL Build assembler subroutine table macros
PAGE
ASM86 equ 0
C equ 1
PASCAL equ 2
FORTRAN equ 3
last equ 0 ;; only asm86 allowed for now
asmnam macro entry,lang
LOCAL A,B,language
;; asmnam builds a table of routine entry point name string
;; lengths, name strings, and long pointers to the entry point
;; The entry points must be defined as PUBLIC FAR PROC's
if1
ifb <entry>
%out '*** error - Entry point not specified'
else
ifb <lang>
%out '*** error - Subroutine language not specified for &entry'
language equ 0ffh ;; Invalid language type
else
ifndef lang
%out '*** error - Invalid language (&lang) specified for &entry'
language equ 0ffh
else
if lang gt last
%out '*** error - Invalid language (&lang) specified for &entry'
language equ 0ffh
else
language equ lang
endif
endif ;; ifndef lang
endif ;; ifb <lang>
endif ;; ifb <entry>
endif ;; if1
ifnb <entry>
EXTRN entry:FAR
START_DSEG
COUNT = COUNT+1
DW B-A ;; length of program name string
A LABEL BYTE
DB '&entry' ;; program name string
B LABEL BYTE
DB language ;; declaration of program language
DD entry ;; declaration of program entry point
END_DSEG
endif
endm
SUBTTL Asmtab and asncnt structures
PAGE
START_DSEG
PUBLIC _asmtab
PUBLIC _asmcnt
COUNT = 0
_asmtab LABEL BYTE
END_DSEG
.lall
; *************************** user routines are entered here *************
include userprog.mac
; *************************** user routines are entered here *************
.sall
START_DSEG
_asmcnt DW COUNT ; set by macro asmnam to be the number of invocations
; of asmnam
END_DSEG
END

226
Microsoft COBOL v21/BUILD.COB Normal file
View File

@ -0,0 +1,226 @@
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.

180
Microsoft COBOL v21/CENTER.COB Normal file
View File

@ -0,0 +1,180 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CENTER.
SECURITY.
THIS PROGRAM CENTERS, LEFT 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.
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 v21/CENTER.INT Normal file
View File

Binary file not shown.

20
Microsoft COBOL v21/CLDEMO.BAT Normal file
View File

@ -0,0 +1,20 @@
ECHO OFF
ECHO This batch file makes drive B: the default drive.
ECHO It also puts drive A: on your search path by issuing
ECHO PATH A:\.
ECHO Any PATH you have previously set up should be restored
ECHO after running this file by re-booting your system
ECHO or issuing your own PATH command.
ECHO You may cancel this file by typing CTRL-C after the PAUSE command.
ECHO ***********************************************
ECHO Put source files on drive B: - include DEMO.CPY
ECHO ON
PAUSE Put COBOL COMPILER in drive A:
B:
PATH A:\
COBOL DEMO/D;
COBOL BUILD/D;
COBOL UPDATE/D;
ECHO OFF
ECHO Be sure to restore any previous PATH now.
ECHO ON

BIN
Microsoft COBOL v21/COBOL.EXE Normal file
View File

Binary file not shown.

BIN
Microsoft COBOL v21/COBOL.OBJ Normal file
View File

Binary file not shown.

BIN
Microsoft COBOL v21/COBOL0.OVR Normal file
View File

Binary file not shown.

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

Binary file not shown.

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

Binary file not shown.

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

Binary file not shown.

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

Binary file not shown.

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

Binary file not shown.

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

Binary file not shown.

412
Microsoft COBOL v21/CRTEST.COB Normal file
View File

@ -0,0 +1,412 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CRTEST.
THIS PROGRAM TESTS THE FUNCTIONS OF THE
CRT DRIVERS USED WITH MS-COBOL.
UPDATED 10.9.83 LN
UPDATED 5.21.84 BZ
AUTHOR. MICROSOFT.
DATE-WRITTEN. 15 FEBRUARY 1983
SECURITY. NONE.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 ACCEPT-FIELDS.
03 IN-FIELD PIC X(6).
03 IN-CHAR PIC X.
03 WAIT-CHAR PIC X.
03 COLOR-CHAR PIC X VALUE 'N'.
88 NO-COLOR VALUE 'N', 'n'.
03 ESC-CODE PIC 99.
SCREEN SECTION.
01 CLEAR-SCREEN.
03 BLANK SCREEN.
01 BLINK-SCREEN.
03 BLANK SCREEN
VALUE "SCREEN ATTRIBUTE TEST.".
03 LINE 3 HIGHLIGHT
VALUE "THIS MESSAGE SHOULD BE HIGHLIGHTED.".
03 LINE 4 BLINK
VALUE "THIS MESSAGE SHOULD BLINK.".
03 LINE 5 REVERSE-VIDEO
VALUE "THIS MESSAGE SHOULD BE IN REVERSE-VIDEO.".
03 LINE 6 UNDERLINE
VALUE "THIS MESSAGE SHOULD BE UNDERLINED.".
03 LINE 7
VALUE "THIS MESSAGE SHOULD BE IN NORMAL VIDEO.".
01 BLANK-LINE-SCREEN.
03 LINE 10 PIC X(80) FROM ALL "X".
03 LINE 11 PIC X(80) FROM ALL "X".
03 LINE 12 PIC X(80) FROM ALL "X".
03 LINE 13 PIC X(80) FROM ALL "X".
03 LINE 14 PIC X(80) FROM ALL "X".
03 LINE 11 COLUMN 20 BLANK LINE
VALUE "B".
03 LINE 12 COLUMN 40 BLANK LINE
VALUE "B".
03 LINE 13 COLUMN 60 BLANK LINE
VALUE "B".
03 LINE 16 BLANK LINE.
01 DEFAULT-SCREEN.
03 BLANK SCREEN FOREGROUND-COLOR 7 BACKGROUND-COLOR 0.
01 REVERSE-SCREEN.
03 BLANK SCREEN FOREGROUND-COLOR 0 BACKGROUND-COLOR 7.
01 NEW-COLOR-SCREEN.
03 BLANK SCREEN FOREGROUND-COLOR 2 BACKGROUND-COLOR 1.
01 COLOR-SCREEN.
03 "COBOL WITH COLOR FROM MICROSOFT".
03 LINE 2 COLUMN 2 "REV-VIDEO" REVERSE-VIDEO.
03 LINE 2 COLUMN 25 "HIGHLIGHT" HIGHLIGHT.
03 LINE 2 COLUMN 55 "BLINKING " BLINK.
03 LINE 3 COLUMN 5 "FOREGD 0" FOREGROUND-COLOR 0.
03 LINE 4 COLUMN 6 "FOREGD 1" FOREGROUND-COLOR 1.
03 LINE 5 COLUMN 7 "FOREGD 2" FOREGROUND-COLOR 2.
03 LINE 6 COLUMN 8 "FOREGD 3" FOREGROUND-COLOR 3.
03 LINE 7 COLUMN 9 "FOREGD 4" FOREGROUND-COLOR 4.
03 LINE 8 COLUMN 10 "FOREGD 5" FOREGROUND-COLOR 5.
03 LINE 9 COLUMN 11 "FOREGD 6" FOREGROUND-COLOR 6.
03 LINE 10 COLUMN 12 "FOREGD 7" FOREGROUND-COLOR 7.
03 LINE 11 COLUMN 13 "FOREGD 8" FOREGROUND-COLOR 8.
03 LINE 12 COLUMN 14 "FOREGD 9" FOREGROUND-COLOR 9.
03 LINE 13 COLUMN 15 "FOREGD 10" FOREGROUND-COLOR 10.
03 LINE 14 COLUMN 16 "FOREGD 11" FOREGROUND-COLOR 11.
03 LINE 15 COLUMN 17 "FOREGD 12" FOREGROUND-COLOR 12.
03 LINE 16 COLUMN 18 "FOREGD 13" FOREGROUND-COLOR 13.
03 LINE 17 COLUMN 19 "FOREGD 14" FOREGROUND-COLOR 14.
03 LINE 18 COLUMN 20 "FOREGD 15" FOREGROUND-COLOR 15.
03 LINE 3 COLUMN 25 "BACKGD 0" BACKGROUND-COLOR 0.
03 LINE 4 COLUMN 26 "BACKGD 1" BACKGROUND-COLOR 1.
03 LINE 5 COLUMN 27 "BACKGD 2" BACKGROUND-COLOR 2.
03 LINE 6 COLUMN 28 "BACKGD 3" BACKGROUND-COLOR 3.
03 LINE 7 COLUMN 29 "BACKGD 4" BACKGROUND-COLOR 4.
03 LINE 8 COLUMN 30 "BACKGD 5" BACKGROUND-COLOR 5.
03 LINE 9 COLUMN 31 "BACKGD 6" BACKGROUND-COLOR 6.
03 LINE 10 COLUMN 32 "BACKGD 7" BACKGROUND-COLOR 7.
03 LINE 11 COLUMN 33 "BACKGD 8" BACKGROUND-COLOR 8.
03 LINE 12 COLUMN 34 "BACKGD 9" BACKGROUND-COLOR 9.
03 LINE 13 COLUMN 35 "BACKGD 10" BACKGROUND-COLOR 10.
03 LINE 14 COLUMN 36 "BACKGD 11" BACKGROUND-COLOR 11.
03 LINE 15 COLUMN 37 "BACKGD 12" BACKGROUND-COLOR 12.
03 LINE 16 COLUMN 38 "BACKGD 13" BACKGROUND-COLOR 13.
03 LINE 17 COLUMN 39 "BACKGD 14" BACKGROUND-COLOR 14.
03 LINE 18 COLUMN 40 "BACKGD 15" BACKGROUND-COLOR 15.
03 LINE 19 COLUMN 3 "FORE 0 BACK 4"
FOREGROUND-COLOR 0 BACKGROUND-COLOR 4.
03 LINE 20 COLUMN 3 "FORE 1 BACK 5"
FOREGROUND-COLOR 1 BACKGROUND-COLOR 5.
03 LINE 21 COLUMN 3 "FORE 2 BACK 6"
FOREGROUND-COLOR 2 BACKGROUND-COLOR 6.
03 LINE 22 COLUMN 3 "FORE 3 BACK 7"
FOREGROUND-COLOR 3 BACKGROUND-COLOR 7.
03 LINE 19 COLUMN 23 "FORE 0 BACK 4 BLINK RV"
BLINK REVERSE-VIDEO
FOREGROUND-COLOR 0 BACKGROUND-COLOR 4.
03 LINE 20 COLUMN 23 "FORE 1 BACK 5 BLINK RV"
BLINK REVERSE-VIDEO
FOREGROUND-COLOR 1 BACKGROUND-COLOR 5.
03 LINE 21 COLUMN 23 "FORE 2 BACK 6 BLINK RV"
BLINK REVERSE-VIDEO
FOREGROUND-COLOR 2 BACKGROUND-COLOR 6.
03 LINE 22 COLUMN 23 "FORE 3 BACK 7 BLINK RV"
BLINK REVERSE-VIDEO
FOREGROUND-COLOR 3 BACKGROUND-COLOR 7.
03 LINE 19 COLUMN 55 "FORE 8 BACK 12 "
FOREGROUND-COLOR 8 BACKGROUND-COLOR 12.
03 LINE 20 COLUMN 55 "FORE 9 BACK 13 "
FOREGROUND-COLOR 9 BACKGROUND-COLOR 13.
03 LINE 21 COLUMN 55 "FORE 10 BACK 14"
FOREGROUND-COLOR 10 BACKGROUND-COLOR 14.
03 LINE 22 COLUMN 55 "FORE 11 BACK 15"
FOREGROUND-COLOR 11 BACKGROUND-COLOR 15.
03 LINE 14 COLUMN 55 "FORE 12 BACK 4"
FOREGROUND-COLOR 12 BACKGROUND-COLOR 4.
03 LINE 15 COLUMN 55 "FORE 13 BACK 5"
FOREGROUND-COLOR 13 BACKGROUND-COLOR 5.
03 LINE 16 COLUMN 55 "FORE 14 BACK 6"
FOREGROUND-COLOR 14 BACKGROUND-COLOR 6.
03 LINE 17 COLUMN 55 "FORE 15 BACK 7"
FOREGROUND-COLOR 15 BACKGROUND-COLOR 7.
03 LINE 19 COLUMN 76 "U.L. " UNDERLINE
FOREGROUND-COLOR 0 BACKGROUND-COLOR 4.
03 LINE 20 COLUMN 76 "R.V. " REVERSE-VIDEO
FOREGROUND-COLOR 1 BACKGROUND-COLOR 5.
03 LINE 21 COLUMN 76 "HIGH " HIGHLIGHT
FOREGROUND-COLOR 2 BACKGROUND-COLOR 6.
03 LINE 22 COLUMN 76 "HI RV"
HIGHLIGHT REVERSE-VIDEO
FOREGROUND-COLOR 3 BACKGROUND-COLOR 7.
PROCEDURE DIVISION.
MAIN.
PERFORM INITIAL-SCREEN.
PERFORM ERASE-TEST.
PERFORM POSITION-TEST.
PERFORM TERMINATOR-TEST.
PERFORM EDIT-TEST.
PERFORM ALARM-TEST.
PERFORM BLINK-TEST.
PERFORM BLANK-LINE-TEST.
PERFORM COLOR-TEST.
DISPLAY (22, 1) "END OF TESTS.".
DISPLAY " ".
STOP RUN.
INITIAL-SCREEN.
DISPLAY (1, 1) ERASE.
DISPLAY "1. THIS PROGRAM TESTS THE CRT DRIVER.".
DISPLAY "2. IF YOUR TERMINAL HAS THE ABILITY TO"
DISPLAY "3. TURN THE CURSOR ON AND OFF, THEN"
DISPLAY "4. YOU SHOULD SEE THE CURSOR STAY ON"
DISPLAY "5. THE SCREEN ONLY WHEN ASKED TO ENTER"
DISPLAY "6. DATA."
DISPLAY "7.".
DISPLAY "8. A 24 BY 80 DISPLAY IS ASSUMED.".
DISPLAY "9.".
ERASE-TEST.
DISPLAY "10. *****************************************".
DISPLAY "11.".
DISPLAY "12. CURSOR POSITION AND ERASE TEST.".
DISPLAY "13. FIRST, LINES 12-24 OF THE".
DISPLAY "14. SCREEN SHOULD BE ERASED. THEN"
DISPLAY "15. THE CURSOR SHOULD HOME (TO THE"
DISPLAY "16. TOP LEFT CORNER) AND THE FULL"
DISPLAY "17. SCREEN SHOULD BE ERASED."
DISPLAY "18.".
DISPLAY "19. TYPE ANY CHARACTER TO CONTINUE.".
ACCEPT (, ) WAIT-CHAR WITH AUTO-SKIP.
MOVE 12 TO LIN.
MOVE 1 TO COL.
DISPLAY (LIN, COL) ERASE.
PERFORM WAIT-FOR-INPUT.
MOVE 1 TO LIN.
DISPLAY (LIN, COL) ERASE.
PERFORM WAIT-FOR-INPUT.
POSITION-TEST.
DISPLAY ( 1, 1) ERASE.
DISPLAY ( 1, 1) "GENERAL CURSOR POSITION TEST.".
DISPLAY ( 2, 1) "THIS TEST DISPLAYS TEXT IN THE"
DISPLAY ( 3, 1) "POSITIONS DESCRIBED BY THE"
DISPLAY ( 4, 1) "TEXT ITSELF."
PERFORM WAIT-FOR-INPUT.
MOVE 1 TO LIN.
DISPLAY (LIN, 1) ERASE.
DISPLAY (LIN, 1) "TOP LEFT CORNER".
DISPLAY (24, 61) "BOTTOM RIGHT CORNER".
DISPLAY ( 1, 65) "TOP RIGHT CORNER".
DISPLAY (24, 1) "BOTTOM LEFT CORNER".
MOVE 28 TO COL.
DISPLAY (12, COL + 2) "CENTER (MORE OR LESS)".
DISPLAY (LIN, 35) "TOP CENTER".
DISPLAY (24, 34) "BOTTOM CENTER".
DISPLAY (12, 1) "LEFT CENTER".
MOVE 10 TO LIN.
MOVE 70 TO COL.
DISPLAY (LIN + 2, COL - 1) "RIGHT CENTER".
PERFORM WAIT-FOR-INPUT.
TERMINATOR-TEST.
DISPLAY (1, 1) ERASE
"TERMINATOR KEY TEST.".
DISPLAY (3, 1) "THIS TESTS WHETHER THE TERMINATOR "
"AND FUNCTION KEYS ARE RECOGNIZED CORRECTLY.".
DISPLAY (5, 1) "EACH TIME THE PROMPT IS GIVEN, ENTER "
"ONE OF THE TERMINATOR OR FUNCTION KEYS".
DISPLAY (6, 5) "SUCH AS RETURN, TAB, ESC, OR BACK TAB,".
DISPLAY (7, 5) "DESCRIBED IN THE MS-COBOL USERS' GUIDE.".
DISPLAY (8, 1) "THIS PROGRAM WILL RESPOND WITH THE "
"ESCAPE CODE FOR THAT KEY.".
DISPLAY (10, 1) "THE TEST WILL TERMINATE WHEN YOU ENTER "
"ANY NON-SPACE KEY BEFORE THE TERMINATOR.".
MOVE SPACE TO IN-CHAR.
PERFORM GET-TERMINATOR
UNTIL IN-CHAR NOT = SPACE.
GET-TERMINATOR.
DISPLAY (13, 1) ERASE.
DISPLAY (12, 1) "ENTER TERMINATOR KEY: ".
ACCEPT (, ) IN-CHAR WITH PROMPT.
ACCEPT ESC-CODE FROM ESCAPE KEY.
DISPLAY (13, 1) "ESCAPE CODE IS " ESC-CODE.
PERFORM WAIT-FOR-INPUT.
EDIT-TEST.
DISPLAY (1, 1) ERASE
"EDIT KEY TEST.".
DISPLAY (3, 1) "THE FOLLOWING ABBREVIATIONS ARE USED "
"TO REPRESENT THE EDITING KEYS:".
DISPLAY (5, 10) "[LD] = LINE (FIELD) DELETE KEY"
(6, 10) "[CD] = CHARACTER DELETE KEY"
(7, 10) "[BS] = BACKSPACE KEY"
(8, 10) "[FS] = FORWARD SPACE KEY".
DISPLAY (10, 1) "THE MS-COBOL USERS' GUIDE DESCRIBES "
"WHICH TERMINAL KEYS PERFORM ".
DISPLAY (11, 1) "THESE EDITING FUNCTIONS.".
MOVE SPACE TO IN-CHAR.
PERFORM GET-EDIT-FIELD
UNTIL IN-CHAR NOT = SPACE.
GET-EDIT-FIELD.
DISPLAY (13, 1) ERASE
"ENTER ABCDE[LD]+-XXX[CD]"
"[BS][BS]W[FS]YZ ".
MOVE SPACES TO IN-FIELD.
ACCEPT (, ) IN-FIELD.
IF IN-FIELD NOT = "+-WXYZ"
DISPLAY (15, 1) "*** RESULT WAS " IN-FIELD
DISPLAY (16, 1) "SHOULD HAVE BEEN +-WXYZ"
ELSE DISPLAY (15, 1) "RESULT WAS CORRECT.".
DISPLAY (18, 1) "THIS TEST WILL TERMINATE WHEN YOU ENTER "
"ANY NON-SPACE KEY HERE.".
ACCEPT (, ) IN-CHAR WITH PROMPT.
IF IN-CHAR NOT = SPACE
PERFORM WAIT-FOR-INPUT.
ALARM-TEST.
DISPLAY (1, 1) ERASE "ALARM ($ALARM) TEST.".
DISPLAY (3, 1) "THE AUDIBLE TONE SHOULD SOUND "
"WHEN THIS MESSAGE IS PRINTED.".
DISPLAY (5, 1) "TYPE ANY CHARACTER TO CONTINUE.".
ACCEPT (, ) WAIT-CHAR WITH AUTO-SKIP BEEP.
BLINK-TEST.
DISPLAY BLINK-SCREEN.
PERFORM WAIT-FOR-INPUT.
BLANK-LINE-TEST.
DISPLAY (1, 1) ERASE "BLANK LINE ($EOL) TEST.".
DISPLAY (3, 1) "LINES 10-14 WILL BE FILLED WITH X.".
DISPLAY (4, 1) "THEN LINES 11-13 SHOULD BE BLANKED "
"FOLLOWING THE 'B' CHARACTER.".
DISPLAY BLANK-LINE-SCREEN.
PERFORM WAIT-FOR-INPUT.
COLOR-TEST.
DISPLAY (1, 1) ERASE "COLOR TEST.".
DISPLAY (3, 1) "THESE TESTS WILL DISPLAY TEXT WITH A".
DISPLAY (4, 1) "VARIETY OF FOREGROUND AND BACKGROUND".
DISPLAY (5, 1) "COLORS. THE INTEGERS USED TO PRODUCE".
DISPLAY (6, 1) "THE COLORS ARE INDICATED BY THE TEXT.".
DISPLAY (8, 1) "IF YOUR TERMINAL IS CONFIGURED WITHOUT".
DISPLAY (9, 1) "COLOR SUPPORT, THE COLOR INFORMATION IS".
DISPLAY (10, 1) "IGNORED, AND TEXT WILL APPEAR IN A".
DISPLAY (11, 1) "SINGLE COLOR.".
DISPLAY (13, 1) "IF YOU DO NOT WISH TO RUN THESE TESTS,".
DISPLAY (14, 1) 'REPLY "N" OR "n" BELOW. ANY OTHER '.
DISPLAY (15, 1) "RESPONSES WILL RUN THE TESTS.".
DISPLAY (17, 1)
"DO YOU WISH TO RUN THE COLOR TESTS? (Y/N): ".
ACCEPT (, ) COLOR-CHAR WITH AUTO-SKIP.
IF NOT NO-COLOR
PERFORM RUN-COLOR-TESTS.
RUN-COLOR-TESTS.
DISPLAY DEFAULT-SCREEN.
DISPLAY " DEFAULT SCREEN COLORS ARE NOW: ".
DISPLAY " FOREGROUND 7 BACKGROUND 0 (NORMAL SCREEN)".
PERFORM WAIT-FOR-INPUT.
DISPLAY DEFAULT-SCREEN.
DISPLAY COLOR-SCREEN.
PERFORM WAIT-FOR-NEXT-SCREEN.
DISPLAY REVERSE-SCREEN.
DISPLAY " DEFAULT SCREEN COLORS ARE NOW: ".
DISPLAY " FOREGROUND 0 BACKGROUND 7 (REVERSE VIDEO)".
PERFORM WAIT-FOR-INPUT.
DISPLAY REVERSE-SCREEN.
DISPLAY COLOR-SCREEN.
PERFORM WAIT-FOR-NEXT-SCREEN.
DISPLAY NEW-COLOR-SCREEN.
DISPLAY " DEFAULT SCREEN COLORS ARE NOW: ".
DISPLAY " FOREGROUND 2 BACKGROUND 1 ".
PERFORM WAIT-FOR-INPUT.
DISPLAY NEW-COLOR-SCREEN.
DISPLAY COLOR-SCREEN.
PERFORM WAIT-FOR-NEXT-SCREEN.
DISPLAY DEFAULT-SCREEN.
WAIT-FOR-INPUT.
DISPLAY " ".
DISPLAY " ".
DISPLAY "TYPE ANY CHARACTER TO CONTINUE.".
ACCEPT (, ) WAIT-CHAR WITH AUTO-SKIP.
WAIT-FOR-NEXT-SCREEN.
DISPLAY (24, 1 ) "TYPE ANY CHARACTER TO CONTINUE.".
ACCEPT (, ) WAIT-CHAR WITH AUTO-SKIP.


BIN
Microsoft COBOL v21/DEBUG.LIB Normal file
View File

Binary file not shown.

BIN
Microsoft COBOL v21/DEBUG.OBJ Normal file
View File

Binary file not shown.

BIN
Microsoft COBOL v21/DEBUGCOB.EXE Normal file
View File

Binary file not shown.

665
Microsoft COBOL v21/DEMO.COB Normal file
View File

@ -0,0 +1,665 @@
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
- 'n 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" 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.


45
Microsoft COBOL v21/DEMO.CPY Normal file
View File

@ -0,0 +1,45 @@
* ************* START OF COPIED FILE *************
DISPLAY SPACE.
DISPLAY SPACE.
DISPLAY TEN-SPACES,
" This is program DEMO, the first program in the".
DISPLAY TEN-SPACES,
" MS-COBOL demonstration suite. In this suite".
DISPLAY TEN-SPACES,
" of programs, you will see several information and".
DISPLAY TEN-SPACES,
" menu screens which will guide you through the ".
DISPLAY TEN-SPACES,
" demonstration.".
DISPLAY SPACE.
DISPLAY TEN-SPACES,
' If you see the runtime error message "Must run Install"'.
DISPLAY TEN-SPACES,
" after this screen is displayed, that indicates that".
DISPLAY TEN-SPACES,
" you have not run the INSTALL utility, which adapts".
DISPLAY TEN-SPACES,
" COBOL to your terminal screen.".
DISPLAY SPACE.
DISPLAY TEN-SPACES,
" If this happens, please see the MS-COBOL Users' Guide".
DISPLAY TEN-SPACES,
" for instructions on running the INSTALL utility. ".
DISPLAY SPACE.
DISPLAY TEN-SPACES,
" After running INSTALL, you can successfully run this".
DISPLAY TEN-SPACES,
" demonstration. You can cancel this program now by typing"
DISPLAY TEN-SPACES,
" E (for End) followed by ENTER.".
DISPLAY " ".
DISPLAY TEN-SPACES,
" Please hit ENTER by itself to continue. ".
ACCEPT WS-OPTION.
IF NOT (END-OPTION)
PERFORM P005-PROCESS.
* ************* END OF COPIED FILE *************

61
Microsoft COBOL v21/E.COB Normal file
View File

@ -0,0 +1,61 @@
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.
01 NX PIC 9.
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.
MOVE X TO NX.
IF X < 10 DISPLAY NX ELSE DISPLAY NXX.

74
Microsoft COBOL v21/FILES.DOC Normal file
View File

@ -0,0 +1,74 @@
Microsoft COBOL MS-DOS Release 2.1
FILES.DOC
January 2, 1986
The following files are contained on your Microsoft Cobol distribution
diskettes:
Disk 1: Primary MS-COBOL files
COBOL.EXE - The Cobol Compiler
COBOL0.OVR - Cobol Compiler Overlay
COBOL1.OVR - Cobol Compiler Overlay
COBOL2.OVR - Cobol Compiler Overlay
COBOL3.OVR - Cobol Compiler Overlay
COBOL4.OVR - Cobol Compiler Overlay
RUNCOB.EXE - Cobol Runtime Executor
DEBUGCOB.EXE - Cobol Interactive Debug Facility
ISAM.EXE - Indexed file handler
FILES.DOC - This Document
UPDATE.DOC - Information pertinent to this release
REFMAN.DOC - Additions to MS-COBOL Compiler Reference Manual
UGUIDE.DOC - Additions to MS-COBOL Compiler User's Guide
README.DOC - Information pertinent to using ISAM with networks
Disk 2: Utilities and Demonstration Programs
INSTALL.COM - Runtime INSTALL Utilty
INSTALL.DAT - INSTALL support file
INSTALL.MSG - INSTALL support file
INSTALL.OVL - INSTALL support file
INSTALL.SPC - INSTALL support file
LINK.EXE - MS-DOS Linker
REBUILD.EXE - Indexed File Recovery Utility
DEMO.COB - Cobol Demonstration System
DEMO.CPY - Cobol Demonstration System
BUILD.COB - Cobol Demonstration System
UPDATE.COB - Cobol Demonstration System
CLDEMO.BAT - Batch file to compile Demonstration System
CENTER.COB - Demonstration Program
CENTER.INT - Compiler output for CENTER.COB
CRTEST.COB - Screen handlingTest program
Disk 3: Assembly Language Subroutine Support Files and
Isam Network Files
COBOL1.LIB - Custom Runtime Library #1
COBOL2.LIB - Custom Runtime Library #2
COBOL.OBJ - Custom Runtime Object Module
DEBUG.LIB - Custom Debugger Support Library
DEBUG.OBJ - Custom Debugger Object Module
MAKERUN.BAT - Custom Runtime Batch File (Hard Disk)
MAKERUN2.BAT - Custom Runtime Batch File (Floppies)
ASM.ASM - Subroutine name table module
PSEG.MAC - Assembly Language Include File for ASM.ASM
USERPROG.MAC - Program name table file for ASM.ASM
USERSEG.MAC - Assembly Language Segmentation Macro File
NISAM.EXE - Indexed file handler for use with networks
ISAM.SRV - The server component of networked ISAM
ISAM.RDR - The redirector component of networked ISAM

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

Binary file not shown.

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

Binary file not shown.

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

Binary file not shown.

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

Binary file not shown.

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

Binary file not shown.

BIN
Microsoft COBOL v21/ISAM.EXE Normal file
View File

Binary file not shown.

BIN
Microsoft COBOL v21/ISAM.RDR Normal file
View File

Binary file not shown.

BIN
Microsoft COBOL v21/ISAM.SRV Normal file
View File

Binary file not shown.

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

Binary file not shown.

14
Microsoft COBOL v21/MAKERUN.BAT Normal file
View File

@ -0,0 +1,14 @@
masm asm;
IF %2==DEBUG GOTO D1
IF %2==debug GOTO D1
IF %2==VIEW GOTO D2
IF %2==view GOTO D2
link cobol asm %2 %3 %4 %5 %6 %7 %8 %9,%1,,cobol1 cobol2/NOD
GOTO D3
:D1
link cobol asm %2 %3 %4 %5 %6 %7 %8 %9,%1,,debug cobol1 cobol2/NOD
GOTO D3
:D2
link cobol asm %2 %3 %4 %5 %6 %7 %8 %9,%1,,view1 view2/NOD
:D3
dir %1.*

17
Microsoft COBOL v21/MAKERUN2.BAT Normal file
View File

@ -0,0 +1,17 @@
a:
PAUSE insert disk with MASM.EXE in drive b:
b:masm asm;
PAUSE insert disk with LINK.EXE in drive b:
IF %2==DEBUG GOTO D1
IF %2==debug GOTO D1
IF %2==VIEW GOTO D2
IF %2==view GOTO D2
b:link cobol asm %2 %3 %4 %5 %6 %7 %8 %9,%1,,b:cobol1 b:cobol2/NOD
GOTO D3
:D1
b:link cobol asm %3 %4 %5 %6 %7 %8 %9,%1,,b:debug b:cobol1 b:cobol2/NOD
GOTO D3
:D2
b:link cobol asm %3 %4 %5 %6 %7 %8 %9,%1,,b:view1 b:view2/NOD
:D3
dir %1.*

BIN
Microsoft COBOL v21/NISAM.EXE Normal file
View File

Binary file not shown.

102
Microsoft COBOL v21/PSEG.MAC Normal file
View File

@ -0,0 +1,102 @@
IFNDEF EUREKA
EUREKA EQU 1
ENDIF
LPROG EQU 1 ;Large Program model.
LDATA EQU 0 ;Large Data model. (not used)
.SALL
;
; START_PSEG is a macro for defining the Program segment type of each
; routine.
;
XDEF = 0 ;Allows code group def.s only once.
XDDEF = 0 ;Allows data group def.s only once.
START_PSEG MACRO ROUTINE
if LPROG
_TEXT SEGMENT BYTE PUBLIC 'CODE'
ASSUME CS:_TEXT
PUBLIC ROUTINE
ROUTINE PROC FAR
else ;Small program definitions.
_TEXT SEGMENT BYTE PUBLIC 'CODE'
ASSUME CS:_TEXT
PUBLIC ROUTINE
ROUTINE PROC NEAR
endif
ENDM
;
; END_PSEG is a macro for termination the Program segment type of each
; routine.
;
END_PSEG MACRO ROUTINE
ROUTINE ENDP
_TEXT ENDS
ENDM
;
; Standard definiton for near segment definitions.
;
START_CODE MACRO
_TEXT SEGMENT
ENDM
END_CODE MACRO
_TEXT ENDS
ENDM
;
; Standard Data area descriptions.
;
ife XDDEF
DGROUP GROUP CONST,_BSS,_DATA
CONST SEGMENT WORD PUBLIC 'DATA'
CONST ENDS
_BSS SEGMENT WORD PUBLIC 'DATA'
_BSS ENDS
_DATA SEGMENT WORD PUBLIC 'DATA'
ASSUME DS:DGROUP,ES:DGROUP,SS:DGROUP
_DATA ENDS
endif
START_DSEG MACRO
_DATA SEGMENT
ASSUME DS:DGROUP,ES:DGROUP,SS:DGROUP
ENDM
END_DSEG MACRO
_DATA ENDS
ENDM
;
; Structure used to reference parameters off the stack.
;
IF LPROG
DYNS STRUC
DD ? ;Long return address.
ARG1 DW ? ;Parameter number 1.
ARG2 DW ? ;Parameter number 2.
ARG3 DW ? ;Parameter number 3.
ARG4 DW ? ;Parameter number 4.
ARG5 DW ? ;Parameter number 5.
DYNS ENDS
ELSE
DYNS STRUC
DW ? ;Near return address.
ARG1 DW ? ;Parameter number 1.
ARG2 DW ? ;Parameter number 2.
ARG3 DW ? ;Parameter number 3.
ARG4 DW ? ;Parameter number 4.
ARG5 DW ? ;Parameter number 5.
DYNS ENDS
ENDIF

86
Microsoft COBOL v21/README.DOC Normal file
View File

@ -0,0 +1,86 @@
README.DOC
December 13, 1985
This diskette contains two versions of ISAM.
One version, ISAM.EXE, is version 2.30, and should be
used if you have a stand-alone, or non-IBM PC environment.
If it is used in a network environment, locking affects the
entire file instead of a single record. It will allow ISAM
files OPENed for INPUT to be read simultaneously by
different processes, however. There are also some speed im-
provements over ISAM.EXE version 2.26. This version of ISAM
will support MS-NET compatible networks as well as the
IBM PC-NET.
The second version of ISAM is designed to be used in an IBM
PC-NET network environment and requires PC-DOS v 3.1 or
greater. It consists of three files: NISAM.EXE, ISAM.SRV,
and ISAM.RDR.
NISAM.EXE is the front end ISAM command processor, version
3.0. The commands it accepts are:
NISAM START SRV | RDR {/S:NNNNN} --start network ISAM
(/S: specifies buffer size)
NISAM STOP --stop ISAM & free memory
NISAM SHARE --show share list, as with
server
NISAM SHARE shortname=d:\path --share a directory with
the specified shortname
NISAM SHARE d:\path --share the specified
directory
NISAM SHARE shortname|d:\path /D --stop sharing the short-
name or directory
NISAM FILE --show the currently OPEN
ISAM files
NISAM CLOSE name --close the specified open
file
ISAM.SRV is the server version of ISAM which can service
ISAM requests. It is activated by the NISAM START SRV
command. This command should be given on a network
server machine when requests for ISAM files located on that
machine will be made either locally or across the network.
ISAM.RDR is the redirector version of ISAM, and is activated
by the NISAM START RDR command. This command should be
given on network machines that run programs that access ISAM
files located only on other, server machines.
Thus, ISAM files must be located on a server, and the ISAM
on that machine must be activated with the NISAM START SRV
command.
Note: It is possible, in the same network, to have some
machines running ISAM.EXE and others running NISAM.EXE.
We do not recommend it, however. It is NOT possible to
have the same machine running both ISAM.EXE and NISAM.EXE
at the same time.
Like the network server, network directory paths must be
shared using the NISAM SHARE command. The command syntax
has been modeled after the NET SHARE command. You MUST
NISAM SHARE the same directories that you NET SHARE, using
the SAME syntax used in the NET SHARE command.
For example, on a server named ZEKE you would type:
NET SHARE PAYABLE=C:\LEDGER\PAYABLE
NISAM SHARE PAYABLE=C:\LEDGER\PAYABLE
Then, the user on another machine who wants to use an ISAM
file in the C:\LEDGER\PAYABLE directory on the server named
ZEKE would type:
NET USE E: \\ZEKE\PAYABLE
and then run the application which OPENs the ISAM file on
drive E:.
The application can be passed the name of the machine\short-
name to do an explicit OPEN using the "VALUE OF FILE-ID"
clause. For example:
VALUE OF FILE-ID "\\ZEKE\PAYABLE\MASTER.DAT".

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

Binary file not shown.

126
Microsoft COBOL v21/REFMAN.DOC Normal file
View File

@ -0,0 +1,126 @@
Microsoft COBOL MS-DOS Release 2.1
REFMAN.DOC
Additions to the Microsoft COBOL Compiler
Reference Manual
September 3, 1985
The following information was not available when the
Microsoft COBOL Compiler Reference Manual was printed,
but will appear in future versions of that document.
CONTENTS
CHAPTER 6 DATA DIVISION
6.2 Record Description Entry
6.2.5 Numeric Items
3. Binary Item
CHAPTER 7 PROCEDURE DIVISION
7.2 Arithmetic Statements
7.2.1 SIZE ERROR Option
7.6 PROCEDURE DIVISION Statements
7.6.1 ACCEPT Statement
7.6.1.1 Format 1 ACCEPT Statement
CHAPTER 6 DATA DIVISION
6.2 Record Description Entry
6.2.5 Numeric Items
3. Binary Item
Warning: Regardless of the number of digits
specified in the PICTURE clause for
a COMP-0 or COMP-4 item, truncation
and the SIZE ERROR condition occur
only when a value moved to such an
item exceeds the range (described
above) for a 2-byte (COMP-0) or 4-
byte (COMP-4) SIGNED binary integer.
A COMP-0 item has an implicit PICTURE
S9(5), and a COMP-4 item has an
implicit PICTURE S9(10).
Binary items are always considered
to be signed, even if the PICTURE
omits the sign character S.
CHAPTER 7 PROCEDURE DIVISION
7.2 Arithmetic Statements
7.2.1 SIZE ERROR Option
Warning: For binary items, defined with
USAGE COMP-0 or COMP-4, truncation
and the SIZE ERROR condition occur
only when a value moved to such an
item exceeds the range for a 2-byte
(COMP-0) or 4-byte (COMP-4) SIGNED
binary integer. A COMP-0 item has
an implicit PICTURE S9(5), and a
COMP-4 item has an implicit PICTURE
S9(10), regardless of the number of
digits specified in the PICTURE
clause.
7.6 PROCEDURE DIVISION Statements
7.6.1 ACCEPT Statement
The Format 1 ACCEPT obtains date or time
information from the operating system. It
places the amount of data specified into
identifier, regardless of the size of
identifier. (For example, DATE will move
6 digits of information even if identifier
is PIC XX). Be sure identifier is large enough
to hold the output of ACCEPT.
7.6.1.1 Format 1 ACCEPT Statement
LINE NUMBER
a two-digit value. The ACCEPT ... FROM LINE
NUMBER is provided for compatibility with
other COBOL's, but in Microsoft COBOL the
value of LINE NUMBER is always "00".

BIN
Microsoft COBOL v21/RUNCOB.EXE Normal file
View File

Binary file not shown.

53
Microsoft COBOL v21/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 v21/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.

298
Microsoft COBOL v21/UGUIDE.DOC Normal file
View File

@ -0,0 +1,298 @@
Microsoft COBOL MS-DOS Release 2.1
UGUIDE.DOC
Additions to the Microsoft COBOL Compiler
User's Guide
September 3, 1985
The following information was not available when the
Microsoft COBOL Compiler User's Guide was printed,
but will appear in future versions of that document.
CONTENTS
CHAPTER 3 Compiling
3.1 Invoking the Compiler
3.1.3 Using Compiler Switches
CHAPTER 7 Data Input and Output
7.3 Using MS-DOS and Nondisk FIles
CHAPTER 10 Interprogram Communication
10.5 Calling MS-COBOL Extension Subroutines
APPENDIX F Error Messages
F.1 Compile Time Error Messages
F.1.2 Program Syntax Errors
F.2 Runtime Error Messages
APPENDIX G Loading the Indexed File Handler
CHAPTER 3 Compiling
3.1 Invoking the Compiler
3.1.3 Using Compiler Switches
An additional compile time switch has been added to
MS-COBOL.
Switches
/G
This switch causes any program statements with a "D"
in column 7 to be compiled, rather than being treated
as comments. Specifying this switch has the same effect
as specifying WITH DEBUGGING MODE in the SOURCE-COMPUTER
paragraph in the ENVIRONMENT DIVISION.
CHAPTER 7 Data Input and Output
7.3 Using MS-DOS and Nondisk FIles
To send an output file to the printer, use the SELECT
file-name ASSIGN TO PRINTER clause. Then, in an associated
FD, specify the clause LABEL RECORD IS OMITTED. DO not
specify the VALUE OF FILE-ID clause.
The FILE-STATUS data-item for a PRINTER file will not be
updated; You may receive MS-DOS messages if a printer is
not attached or is not on-line, but the FILE-STATUS item
will not change from its initial value. Be sure to check
your printer before writing to it.
CHAPTER 10 Interprogram Communication
10.5 Calling MS-COBOL Extension Subroutines
Two additional Extension Subroutines, KBDAVAIL and
CURPOS, are now available. KBDAVAIL allows a COBOL
program to check whether keyboard data has been
entered, without having to wait for such entry,
or having to read the data. CURPOS allows a COBOL
program to examine the current line and column
value of the screen cursor.
Note that to call these or any other extension
subroutines, the routine name must be entered
in UPPER-CASE in the CALL statement.
Name and function:
KBDAVAIL Indicates whether data is available
at the keyboard, without actually
reading the data.
CURPOS Returns the line and column location
of the screen cursor at the time of
the call.
Calling conventions:
CALL "KBDAVAIL" USING status.
CALL "CURPOS" USING line-val, column-val.
Arguments:
status A alphanumeric two-character
data-item (PIC XX). Returned
status values are described below.
line-val A numeric data-name with USAGE
COMP-0. The current cursor line
will be returned here.
column-val A numeric data-name with USAGE
COMP-0. The current cursor column
will be returned here.
Returned status values:
Status Code: "00"
For KBDAVAIL, "00" indicates
keyboard data has been entered.
Status Code: "30"
For KBDAVAIL, "30" indicates
keyboard data has not been entered.
Programming notes:
KBDAVAIL can be used to check whether data
has been entered at the keyboard, without
having to ACCEPT the data.
One use of this routine is to place it in
a timing loop before ACCEPTing keyboard data.
This allows a "timeout" ACCEPT - if data is
entered before the loop times out, an ACCEPT
can be done to process the data; otherwise
some default action may take place. Normally,
an ACCEPT will wait until data is entered or
the process is terminated. The timing loop may
be based on a fixed number of iterations of
the call, which is machine dependent, or based
on a period of time derived from ACCEPT ... FROM
TIME. For example, the following procedure may
be used:
PERFORM P900-CHECK-KEYBOARD
UNTIL KEYBOARD-CHECK-DONE = "YES".
IF KEYBOARD-STATUS = "00"
ACCEPT KEYBOARD-LINE
ELSE
MOVE DEFAULT-DATA TO KEYBOARD-LINE.
where P900-CHECK-KEYBOARD would call KBDAVAIL
and do some timing checks, which can be used
to set KEYBOARD-CHECK-DONE to "YES".
CURPOS will return the current line (x) and
column (y) values of the screen cursor. This
may be useful for determining the last field
entered during a screen ACCEPT, for example.
In general, after an ACCEPT or DISPLAY, the
cursor is placed in the column immediately
following the last field involved in the
operation.
Following is a list of special circumstances
involving the cursor. (x, y) is assumed to
be the previous cursor position if a position
is not specified. Blank-screen is a screen
containing only BLANK SCREEN.
Operation Cursor placement after operation
Program startup (1, 1)
DISPLAY (x, y) ERASE (x, y)
DISPLAY (x, y) data-name (x, (y + data-name size + 1))
ACCEPT (x, y) data-name (x, (y + data-name size + 1))
DISPLAY blank-screen (1, 1)
DISPLAY screen-name 1 column past the end of the
last screen line
ACCEPT screen-name 1 column past the end of the
field the cursor was in
when the ACCEPT was
terminated
DISPLAY data-name (x + 1, 1)
ACCEPT data-name (x + 1, 1)
APPENDIX F Error Messages
F.1 Compile Time Error Messages
F.1.2 Program Syntax Errors
INSPECT REPLACING operands have incorrect length
The operands used in the REPLACING form of the
INSPECT statement must be the same length. If
CHARACTERS is used, the replacing operand must
have a length of 1. If the replaced operand is
a figurative constant, the replacing operand
must have a length of 1.
Illegal structure: Item beyond scope of
OCCURS/DEPENDING.
A variable sized data item, defined as one
containing the OCCURS DEPENDING ON clause,
had more data defined following the variable
length section of the record. A variable
sized data item may only be followed, within
the current 01 level data item, by data
description entries which are subordinate to it.
END DECLARATIVES required.
A DECLARATIVES header was declared with no
matching END DECLARATIVES.
F.2 Runtime Error Messages
Subroutine must be CALLed.
A program with a USING list in its PROCEDURE
DIVISION header has been invoked directly,
rather than being CALLed from a COBOL program.
Since the LINKAGE SECTION variables are undefined,
this is not allowed.
CALL parameters mismatched.
The number of elements in the USING list in a
CALLed program's PROCEDURE DIVISION header does
not match the number of elements in the USING
list of the CALL statement that CALLed the
subroutine.
Must run Install.
Screen DISPLAYs or ACCEPTs were attempted which
used Microsoft extensions supported by the INSTALL
utility, but INSTALL had not been run. See this
manual for instructions on running INSTALL.
APPENDIX G Loading the Indexed File Handler
G.3 Error Handling
Opening a large number of Indexed files or using
files with very large records may cause ISAM to
run out of buffer memory space. If this happens,
and a FILE-STATUS item has been defined, the
file operation that caused the memory overflow
will return status "96". If no FILE-STATUS item
was defined, the runtime error message "Need
more memory" will be displayed and the job will
be cancelled.
The /S switch may be used to increase the buffer
space available to ISAM. Note that this switch
must be entered exactly as described, with
a colon (:) after the S and no spaces in the
command line. E.g.,
ISAM/S:20000
is a valid invocation of ISAM with the /S switch.

572
Microsoft COBOL v21/UPDATE.COB Normal file
View File

@ -0,0 +1,572 @@
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.

223
Microsoft COBOL v21/UPDATE.DOC Normal file
View File

@ -0,0 +1,223 @@
Microsoft COBOL MS-DOS Release 2.1
UPDATE.DOC
December 13, 1985
Significant changes in this release:
1) Any programs compiled under earlier versions of MS-COBOL
should be recompiled before running; an error message
indicating incompatible systems will appear otherwise.
2) There are numerous differences between MS-COBOL 2.1 and
MS-COBOL 1.0. These are explained in detail in Appendix
A of the Microsoft COBOL Compiler User's Guide.
In particular you should be aware that:
- Microsoft COBOL 2.1 is validated at LOW-INTERMEDIATE
level; however, more standard COBOL features,
including multiple-key Indexed files and dynamically
called subroutines, are available for program use
- MS-COBOL 2.1 will run only under version 2.0 or later of
MS-DOS.
- MS-COBOL 2.1 does not use a link step. Programs may be compiled
then run. Programs are run by entering RUNCOB <filename>.
- If file I/O is to be done, you should have a CONFIG.SYS file
in your root directory with the FILES command set to at
least 20 (FILES=20). This allocates buffer space in MS-DOS
for files.
If no CONFIG.SYS file is present, the default is FILES=8,
which is too small. See your MS-DOS manual for details.
- Indexed (ISAM) files use Microsoft ISAM, which must be loaded
before running programs that use Indexed files. (See Appendix
G in the Microsoft COBOL User's Guide). The MS-DOS ASSIGN
command must not be used while ISAM is active.
- See the README.DOC file for information concerning the use of
ISAM files in an IBM PC-NET environment.
- The non-network version of ISAM.EXE shipped with Cobol 2.1,
version 2.30, is not compatible with earlier versions of Cobol,
and previous versions of Cobol are not compatible with
ISAM.EXE version 2.30. THEREFORE, ENSURE YOUR APPLICATIONS
COMPILED WITH COBOL 2.1 INCLUDE ISAM VERSION 2.30 WHEN DISTRIBUTED.
- Indexed file formats are different from those in MS-COBOL
Version 1.0; the REBUILD utility will convert files from one
format to the other.
- Sequential and Line Sequential files have the same format as
those in MS-COBOL 1.0, except that the end of file is indicated
without terminating CONTROL-Z characters. Files created under
COBOL 1.0 may be used except when the OPEN EXTEND option is used.
In that case, files should be generated by or copied using an
MS-COBOL 2.1 program to produce the correct end of file.
- Cobol 2.1 does not truncate trailing blanks in a Line Sequential
file. However, if an attempt is made to REWRITE a record longer
than what was originally written, only the number of bytes orig-
inally written will be rewritten. See discussion of /C switch
below under 5) Enhancements and corrections....
- Assembly language subroutines must be linked with the runtime
executor (RUNCOB.EXE) instead of with your COBOL program. This
is explained in Chapter 10 of the User's Guide.
- There are several built-in subroutines which may be called to
perform tasks such as deleting and renaming files, converting
to upper or lower case, and getting the current cursor position.
These are described in Chapter 10 of the User's Guide. Additional
routines are described in the file UGUIDE.DOC.
- Default tab stops are now set at every 8 characters. A compiler
switch (/O) is available for programs that have tabs set for
the default MS-COBOL 1.0 settings.
- Both RUNCOB.EXE and DEBUGCOB.EXE should be configured using the
INSTALL utility before any programs using screen I/O are run.
DEBUGCOB.EXE should be configured even if your program does no
screen I/O. INSTALL accepts a file name to be configured, but
will not accept paths. Files configured must be in the same
directory as the INSTALL files, or in a directory on a different
disk drive or device.
3) Additional documentation which appeared too late to be included
in the Microsoft COBOL Compiler Reference Manual and User's
Guide is available in the files REFMAN.DOC, for Reference Manual
information, and UGUIDE.DOC for User's Guide information.
Included in these files is information concerning COMP-0 and
COMP-4 variables, some error messages, some new extension
subroutines, an undocumented compiler switch, and an undocumented
file status.
4) File and record locking syntax are accepted by the MS-COBOL compiler
under MS-DOS 2.x, but are IGNORED at runtime. This means that files
used in a multi-user environment under MS-DOS 2.x are UNPROTECTED
by MS-COBOL.
5) Enhancements and corrections from version 2.0
Both compiler and runtime speed have been significantly increased
compared to version 2.0. Compile speed is roughly three times
faster than version 1.12 and twice as fast as version 2.0. Runtime
speed is generally comparable to version 1.12, and ISAM processing
is faster than in 1.12.
A runtime switch, /C, has been added. The product no longer
defaults to truncation of trailing blanks when writing records to
a Line Sequential file. However, if the /C (for Compress)
switch is specified, trailing blanks will be truncated.
Corrections
- An error in which low level I/O failure, such as no space on a
disk file, would cause the runtime to crash has been corrected.
- If INSTALL has not been run, and MS-COBOL screen extensions are
requested, the job will be canceled instead of producing a long
list of messages.
- Subprograms with USING lists in their PROCEDURE DIVISION headers
can no longer be invoked except through a CALL. Also, an error
is reported if the number of parameters in a calling program
does not match the number in the called program.
- Non-COBOL subprograms whose names are the same length and
differ only in the last character are now correctly
differentiated.
- COMP-3 variables may now be used as subprogram arguments.
- An error is detected if DECLARATIVES is declared without a matching
END DECLARATIVES.
- A problem with DIVIDE with REMAINDER using very large operands
and a signed quotient which caused the runtime to crash has
been corrected.
- Variables with subordinate LEVEL 88 items were treated as
group items for MOVE. This has been corrected.
- A bug was fixed in which a paragraph containing exact multiples
of 512 characters of literals would pick up the wrong text
for the literals.
- Several problems involving COMP-4 variables have been corrected,
including improper initialization and erroneous moving of a
sign character into the data following an unsigned DISPLAY
format receiving field of a MOVE.
- ACCEPT from LINE NUMBER now returns the two digit field "00"
instead of a five-digit program line number. This change was
done for compatibility with version 1.x.
- A problem where the compiler did not reject illegal characters
inside the parentheses of a PICTURE clause has been corrected.
- The version number now appears correctly in the listing file.
- Problems compiling programs with more than 32K of generated object
code have been fixed.
- Previously, if no object file was produced, and a program had overlay
segments, strange characters were written to the screen during a
compile. This has been fixed.
- Alternate collating sequences of more than 128 characters should now
work. HIGH-VALUES is now hexadecimal 'FF' instead of '7F'.
- START with WAIT or LOCK previously generated invalid object code.
This has been corrected.
- FULL and REQUIRED for group items no longer generates a compiler
error.
- Several problems regarding printing have been corrected.
- CHAIN and CALL in certain circumstances could cause memory
management problems. These have been corrected.
- A bug was fixed where more than 7 identifiers in and UNSTRING
would cause an error in phase 3.
- INSTALL option 1, (install your own terminal) now works properly.
NOTE: When using the "Define your own terminal" option of INSTALL:
If the terminal you wish to Install, and are using, is con-
nected to the COM port, some characters may be lost when
defining single keys (such as Function keys, cursor keys, or
keys on the numeric keypad) which generate multiple character
sequences. An approach which will work in all cases is to
explicitly type in the character sequence that defines
the key.
- A correction has been made such that the ON OVERFLOW clause in the
CALL statement now works properly.
- A bug in handling relative files has been corrected.
- A syntax error involving BLANK now generates a syntax error rather
than a compiler error in phase 3.
- REWRITEing a record in a LINE SEQUENTIAL file no longer clobbers
the first byte in the following record.
- The cursor is no longer hidden after certain runtime errors.
- An arithmetic expression in a PERFORM statement now computes
properly in all cases.
- The compiler will now give an error if there is no period following
a required paragraph name.
- The compiler now works properly when REDEFINES clauses are sub-
ordinate to data items containing an OCCURS clause.

23
Microsoft COBOL v21/USERPROG.MAC Normal file
View File

@ -0,0 +1,23 @@
; ********** Assembly language interface table include file
;*********************************************************************
;
; User non-COBOL subroutines must be specified in this file using
; the macro asmnam to generate table entries to go into asm.asm,
; which must then be assembled and linked. This file may not
; be assembled by itself.
; Enter new routines by specifying :
; asmnam <program entry point>,<program language>
; <program entry point> should be entered using the same case as used in
; the CALL statement in the COBOL program, so the names will match,
; <program language> - only asm86 is acceped (must be provided)
; Below are some example statements (commented out) specifying some
; user routines.
; asmnam leon,asm86
; asmnam BOBZ,asm86
; asmnam lylek,asm86
; ********* enter routine specifications here *************************

53
Microsoft COBOL v21/USERSEG.MAC Normal file
View File

@ -0,0 +1,53 @@
.SALL
;
; START_CSEG is a macro for defining the Code (Program) segment type of each
; routine.
;
START_CSEG MACRO ROUTINE
_USER SEGMENT BYTE
ASSUME CS:_USER
PUBLIC ROUTINE
ROUTINE PROC FAR
ENDM
;
; END_CSEG is a macro for termination the Code (Program) segment type of each
; routine.
;
END_CSEG MACRO ROUTINE
ROUTINE ENDP
_USER ENDS
ENDM
;
; START_DSEG and END_DSEG are macros for initalization and termination
; of the DATA segment type of each routine.
;
;
; DMACCNT is used to assure that the DGROUP command is generated only if
; needed, and then only once.
;
DMACCNT = 0
START_DSEG MACRO
IFE DMACCNT
DGROUP GROUP _DATA
DMACCNT = 1
ENDIF
_DATA SEGMENT WORD PUBLIC 'DATA'
ASSUME DS:DGROUP,ES:DGROUP,SS:DGROUP
ENDM
END_DSEG MACRO
_DATA ENDS
ENDM
;

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

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