Microsoft COBOL v2.1
This commit is contained in:
davidly
parent
be2316a97c
commit
8fa056fa85
92
Microsoft COBOL v21/ASM.ASM
Normal file
92
Microsoft COBOL v21/ASM.ASM
Normal 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
226
Microsoft COBOL v21/BUILD.COB
Normal 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
180
Microsoft COBOL v21/CENTER.COB
Normal 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
BIN
Microsoft COBOL v21/CENTER.INT
Normal file
Binary file not shown.
20
Microsoft COBOL v21/CLDEMO.BAT
Normal file
20
Microsoft COBOL v21/CLDEMO.BAT
Normal 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
BIN
Microsoft COBOL v21/COBOL.EXE
Normal file
Binary file not shown.
BIN
Microsoft COBOL v21/COBOL.OBJ
Normal file
BIN
Microsoft COBOL v21/COBOL.OBJ
Normal file
Binary file not shown.
BIN
Microsoft COBOL v21/COBOL0.OVR
Normal file
BIN
Microsoft COBOL v21/COBOL0.OVR
Normal file
Binary file not shown.
BIN
Microsoft COBOL v21/COBOL1.LIB
Normal file
BIN
Microsoft COBOL v21/COBOL1.LIB
Normal file
Binary file not shown.
BIN
Microsoft COBOL v21/COBOL1.OVR
Normal file
BIN
Microsoft COBOL v21/COBOL1.OVR
Normal file
Binary file not shown.
BIN
Microsoft COBOL v21/COBOL2.LIB
Normal file
BIN
Microsoft COBOL v21/COBOL2.LIB
Normal file
Binary file not shown.
BIN
Microsoft COBOL v21/COBOL2.OVR
Normal file
BIN
Microsoft COBOL v21/COBOL2.OVR
Normal file
Binary file not shown.
BIN
Microsoft COBOL v21/COBOL3.OVR
Normal file
BIN
Microsoft COBOL v21/COBOL3.OVR
Normal file
Binary file not shown.
BIN
Microsoft COBOL v21/COBOL4.OVR
Normal file
BIN
Microsoft COBOL v21/COBOL4.OVR
Normal file
Binary file not shown.
412
Microsoft COBOL v21/CRTEST.COB
Normal file
412
Microsoft COBOL v21/CRTEST.COB
Normal 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
BIN
Microsoft COBOL v21/DEBUG.LIB
Normal file
Binary file not shown.
BIN
Microsoft COBOL v21/DEBUG.OBJ
Normal file
BIN
Microsoft COBOL v21/DEBUG.OBJ
Normal file
Binary file not shown.
BIN
Microsoft COBOL v21/DEBUGCOB.EXE
Normal file
BIN
Microsoft COBOL v21/DEBUGCOB.EXE
Normal file
Binary file not shown.
665
Microsoft COBOL v21/DEMO.COB
Normal file
665
Microsoft COBOL v21/DEMO.COB
Normal 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
45
Microsoft COBOL v21/DEMO.CPY
Normal 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
61
Microsoft COBOL v21/E.COB
Normal 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
74
Microsoft COBOL v21/FILES.DOC
Normal 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
BIN
Microsoft COBOL v21/INSTALL.COM
Normal file
Binary file not shown.
BIN
Microsoft COBOL v21/INSTALL.DAT
Normal file
BIN
Microsoft COBOL v21/INSTALL.DAT
Normal file
Binary file not shown.
BIN
Microsoft COBOL v21/INSTALL.MSG
Normal file
BIN
Microsoft COBOL v21/INSTALL.MSG
Normal file
Binary file not shown.
BIN
Microsoft COBOL v21/INSTALL.OVL
Normal file
BIN
Microsoft COBOL v21/INSTALL.OVL
Normal file
Binary file not shown.
BIN
Microsoft COBOL v21/INSTALL.SPC
Normal file
BIN
Microsoft COBOL v21/INSTALL.SPC
Normal file
Binary file not shown.
BIN
Microsoft COBOL v21/ISAM.EXE
Normal file
BIN
Microsoft COBOL v21/ISAM.EXE
Normal file
Binary file not shown.
BIN
Microsoft COBOL v21/ISAM.RDR
Normal file
BIN
Microsoft COBOL v21/ISAM.RDR
Normal file
Binary file not shown.
BIN
Microsoft COBOL v21/ISAM.SRV
Normal file
BIN
Microsoft COBOL v21/ISAM.SRV
Normal file
Binary file not shown.
BIN
Microsoft COBOL v21/LINK.EXE
Normal file
BIN
Microsoft COBOL v21/LINK.EXE
Normal file
Binary file not shown.
14
Microsoft COBOL v21/MAKERUN.BAT
Normal file
14
Microsoft COBOL v21/MAKERUN.BAT
Normal 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
17
Microsoft COBOL v21/MAKERUN2.BAT
Normal 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
BIN
Microsoft COBOL v21/NISAM.EXE
Normal file
Binary file not shown.
102
Microsoft COBOL v21/PSEG.MAC
Normal file
102
Microsoft COBOL v21/PSEG.MAC
Normal 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
86
Microsoft COBOL v21/README.DOC
Normal 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
BIN
Microsoft COBOL v21/REBUILD.EXE
Normal file
Binary file not shown.
126
Microsoft COBOL v21/REFMAN.DOC
Normal file
126
Microsoft COBOL v21/REFMAN.DOC
Normal 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
BIN
Microsoft COBOL v21/RUNCOB.EXE
Normal file
Binary file not shown.
53
Microsoft COBOL v21/SIEVE.COB
Normal file
53
Microsoft COBOL v21/SIEVE.COB
Normal 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
171
Microsoft COBOL v21/TTT.COB
Normal 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
298
Microsoft COBOL v21/UGUIDE.DOC
Normal 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
572
Microsoft COBOL v21/UPDATE.COB
Normal 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
223
Microsoft COBOL v21/UPDATE.DOC
Normal 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
23
Microsoft COBOL v21/USERPROG.MAC
Normal 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
53
Microsoft COBOL v21/USERSEG.MAC
Normal 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
9
Microsoft COBOL v21/m.bat
Normal 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:
|
||||||
|
|
||||||
|
|
||||||
Loading…
Reference in New Issue
Block a user