amberisvibin/chibi-pc09
Archived
1
0
Fork 1
Code Issues Pull Requests Activity

copy all local files to repo

Browse Source 
cp/m files, sprites, circuit design
This commit is contained in:
Amber
2020-05-15 09:07:45 -04:00
parent 8353edd599
commit 783d32a495
461 changed files with 80153 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

23
emu/yaze/COBOL/CALL.ASM Normal file
View File

@@ -0,0 +1,23 @@
; Program "Call" called by "Testcall"; this is assembler version;
; compare with functionally equivalent COBOL version.
cseg
ldax b ; read first param: A = text length
loop:
dcr a ; count down length
rm ; finished
push psw
ldax d ; next byte from second param = text
inx d
push d
mov e,a
mvi c,6 ; CP/M function code
call 5 ; call CP/M to send character
pop d
pop psw
jmp loop
; End of demonstration program "Call"
end

26
emu/yaze/COBOL/CALL.CBL Normal file
View File

@@ -0,0 +1,26 @@
000000******************************************************************
000000*
000000* Program "Call" called by "Testcall"; this is COBOL version;
000000* compare with functionally equivalent assembler version.
000000*
000000******************************************************************
000000 Working-storage section.
000000 01 temp pic 9(2) comp.
000000 01 text-buffer value space.
000000 02 tbuf-table pic x occurs 80.
000000 Linkage section.
000000 01 mess-text.
000000 02 mtex-table pic x occurs 80.
000000 01 mess-size pic 9(2) comp.
000000 Procedure division using mess-size,mess-text.
000000 l.
000000 move 0 to temp perform move-byte until temp = mess-size.
000000 display text-buffer.
000000 exit program.
000000 move-byte.
000000 add 1 to temp move mtex-table (temp) to tbuf-table (temp).
000000******************************************************************
000000*
000000* End of demonstration program "Call"
000000*
000000******************************************************************

BIN
emu/yaze/COBOL/CALL.INT Normal file
View File

Binary file not shown.

BIN
emu/yaze/COBOL/CALL.PRL Normal file
View File

Binary file not shown.

BIN
emu/yaze/COBOL/CLI Normal file
View File

Binary file not shown.

240
emu/yaze/COBOL/CLI.CBL Normal file
View File

@@ -0,0 +1,240 @@
000000 IDENTIFICATION DIVISION.
000000******************************************************************
000000* *
000000* COPYRIGHT (C) 1982,1982 MICRO FOCUS LTD. *
000000* *
000000* MICRO FOCUS LTD. *
000000* 58, ACACIA ROAD, *
000000* ST. JOHNS WOOD, *
000000* LONDON NW8 6AG. *
000000* *
000000* TEL. 01 722 8843/4/5/6/7 *
000000* TELEX 28536 MICROF G *
000000* *
000000******************************************************************
000000*
000000 PROGRAM-ID. COMMAND LINE INTERPRETOR.
000000 AUTHOR. MICRO FOCUS LTD.
000000 INSTALLATION. MICRO FOCUS - SWINDON.
000000 DATE-WRITTEN. 6TH DECEMBER 1982.
000000 DATE-COMPILED. 6TH DECEMBER 1982.
000000*
000000 ENVIRONMENT DIVISION.
000000 SOURCE-COMPUTER. 8080.
000000 OBJECT-COMPUTER. 8080.
000000 SPECIAL-NAMES. CONSOLE IS CRT.
000000/*****************************************************************
000000* *
000000* DATA USED BY THE CLI TO STORE THE USER'S INSTRUCTIONS. *
000000* *
000000******************************************************************
000000*
000000 DATA DIVISION.
000000 WORKING-STORAGE SECTION.
000000*
000000 01 TEMP PIC 9(2) COMP.
000000 01 SUB1 PIC 9(2) COMP.
000000 01 SUB2 PIC 9(2) COMP.
000000 01 SUB2-SAV PIC 9(2) COMP.
000000 01 TMAX PIC 9(2) COMP.
000000 01 CHOICE PIC X.
000000*
000000 01 RTS-ROUTINES.
000000 02 POKE-CLI PIC X VALUE X"91".
000000 02 CHAIN PIC X VALUE X"84".
000000 02 GET-CHAR PIC X VALUE X"D8".
000000 02 SOUND-ALARM PIC X VALUE X"E5".
000000*
000000* DISPLAY LINES
000000*
000000 01 INIT-LINE.
000000 02 INIT-LINE-1 PIC X(68) VALUE "COBOL: A(nimate) C(ompile) D(
000000- "rive) F(orms2) Q(uit) R(un) S(witches)".
000000 02 FILLER PIC X(4).
000000 02 INIT-CHOICE PIC X.
000000*
000000 01 FILE-QUESTION-LINE.
000000 02 FQL-1 PIC X(22) VALUE "Enter name of file to ".
000000 02 VERB PIC X(8).
000000*
000000* COMMAND-LINE COMPONENTS
000000*
000000 01 SWITCH-AREA.
000000 02 FILLER PIC X VALUE "(".
000000 02 SWITCHES PIC X(40) VALUE SPACE.
000000*
000000 01 FILE-NAME PIC X(16).
000000*
000000 01 CLI-REST PIC X(80).
000000*
000000 01 WORK-AREA.
000000 02 WORK-BYTE PIC 9(2) OCCURS 80 COMP.
000000*
000000 01 OUTPUT-CLI VALUE SPACE.
000000 02 OUT-BYTE PIC 9(2) OCCURS 128 COMP.
000000*
000000 01 PROG-AREA.
000000 02 DRIVE PIC X VALUE SPACE.
000000 02 FILLER PIC X VALUE ":".
000000 02 PROG-NAME PIC X(16).
000000*
000000/*****************************************************************
000000* *
000000* MAIN ENTRY TO CLI PROGRAM. IS USED BY ORDINARY ENTRY TO *
000000* COMMAND LINE INTERPRETOR, AS WELL AS BY PROGRAMS WHICH ARE *
000000* RETURNING CONTROL TO THE CLI FOR CONTINUATION COMMANDS. *
000000* *
000000******************************************************************
000000*
000000 PROCEDURE DIVISION.
000000 MAIN-ENTRY.
000000*
000000* TEST IF SCREEN SHOULD BE CLEARED. IF "X" ON COMMAND LINE, THEN
000000* THIS IS A SECOND OR SUBSEQUENT ENTRY, AND THE SCREEN SHOULD
000000* NOT BE CLEARED.
000000*
000000 ACCEPT WORK-AREA FROM CONSOLE.
000000 IF WORK-AREA NOT = "X"
000000 DISPLAY SPACE.
000000 CALL SOUND-ALARM.
000000*
000000 LOOP.
000000 MOVE SPACE TO INIT-CHOICE.
000000 DISPLAY INIT-LINE.
000000 DISPLAY LOW-VALUE AT 0170.
000000 CALL GET-CHAR USING CHOICE.
000000 DISPLAY SPACE.
000000 MOVE CHOICE TO INIT-CHOICE.
000000 DISPLAY INIT-LINE.
000000*
000000 IF CHOICE = "A" OR "a"
000000 MOVE "ANIMATE:" TO VERB
000000 MOVE "ANIMATE.COM" TO PROG-NAME
000000 GO TO FILE-QUESTION.
000000 IF CHOICE = "C" OR "c"
000000 MOVE "COMPILE:" TO VERB
000000 MOVE "COBOL.COM" TO PROG-NAME
000000 GO TO FILE-QUESTION.
000000 IF CHOICE = "D" OR "d"
000000 GO TO DRIVE-SET.
000000 IF CHOICE = "F" OR "f"
000000 MOVE "FORMS2.COM" TO PROG-NAME
000000 MOVE 0 TO SUB2
000000 GO TO LOADER.
000000 IF CHOICE = "Q" OR "q"
000000 GO TO EXITING.
000000 IF CHOICE = "R" OR "r"
000000 MOVE "RUN:" TO VERB
000000 MOVE "RUN.COM" TO PROG-NAME
000000 GO TO FILE-QUESTION.
000000 IF CHOICE = "S" OR "s"
000000 GO TO SWITCH-SET.
000000 CALL SOUND-ALARM.
000000 GO TO LOOP.
000000*
000000/*****************************************************************
000000* *
000000* CODE TO HANDLE FILENAME OF PROGRAM TO BE COMPILED, ANIMATED *
000000* OR EXECUTED. *
000000* *
000000******************************************************************
000000*
000000 FILE-QUESTION.
000000 MOVE SPACE TO FILE-NAME.
000000 DISPLAY FILE-QUESTION-LINE AT 0201.
000000 ACCEPT FILE-NAME AT 0232.
000000 IF FILE-NAME = SPACES
000000 GO TO LOOP.
000000*
000000 PERFORM CLEAR-LINES.
000000 MOVE SPACE TO CLI-REST.
000000 DISPLAY "Any further command line ?" AT 0201.
000000 ACCEPT CLI-REST AT 0301.
000000*
000000 MOVE 0 TO SUB2.
000000 IF "RUN.COM" = PROG-NAME
000000 IF SPACE NOT = SWITCHES
000000 MOVE SWITCH-AREA TO WORK-AREA
000000 MOVE 41 TO TMAX
000000 MOVE 0 TO SUB1
000000 PERFORM TRANSFER-BUFFER
000000 ADD 1 TO SUB2
000000 MOVE 41 TO OUT-BYTE (SUB2).
000000 MOVE FILE-NAME TO WORK-AREA.
000000 MOVE 0 TO SUB1.
000000 MOVE 16 TO TMAX.
000000 PERFORM TRANSFER-BUFFER.
000000 MOVE CLI-REST TO WORK-AREA.
000000 MOVE 0 TO SUB1.
000000 MOVE 80 TO TMAX.
000000 PERFORM TRANSFER-BUFFER.
000000 IF SUB2 > 80
000000 GO TO CLI-OVF.
000000*
000000* COMMAND LINE NOW CREATED, CHAIN TO THE NEXT PROGRAM. THIS
000000* IS DONE BY SETTING A COMMAND LINE FOR THE RTS TO EXECUTE.
000000*
000000 LOADER.
000000 CALL POKE-CLI USING SUB2, OUTPUT-CLI.
000000 PERFORM CLEAR-LINES.
000000 DISPLAY "Loading ..." at 0201.
000000 DISPLAY LOW-VALUE AT 0301.
000000 IF DRIVE = SPACE
000000 CALL CHAIN USING PROG-NAME
000000 ELSE
000000 CALL CHAIN USING PROG-AREA.
000000*
000000/*****************************************************************
000000* *
000000* SUPPORT CLI ROUTINES, USED TO MANIPULATE THE FIELDS BEFORE *
000000* CONTROL IS TRANSFERRED TO A SUPPORT PROGRAM. *
000000* *
000000******************************************************************
000000*
000000 SWITCH-SET.
000000 MOVE SPACE TO SWITCHES.
000000 DISPLAY "Switches:" AT 0201.
000000 ACCEPT SWITCHES AT 0211.
000000 INSPECT SWITCHES REPLACING
000000 ALL "(" BY SPACE
000000 ALL ")" BY SPACE.
000000 GO TO LOOP.
000000*
000000 DRIVE-SET.
000000 DISPLAY "Enter Drive:" AT 0201.
000000 ACCEPT DRIVE AT 0214.
000000 GO TO LOOP.
000000*
000000 EXITING.
000000 DISPLAY "Returning to CP/M" AT 0201.
000000 DISPLAY LOW-VALUE AT 0301.
000000 STOP RUN.
000000*
000000/*****************************************************************
000000* *
000000* WORK ROUTINES USED TO MANIPULATE THE SCREEN. *
000000* *
000000******************************************************************
000000*
000000 CLI-OVF.
000000 PERFORM CLEAR-LINES.
000000 DISPLAY "Command buffer overflow" AT 0301.
000000 GO TO LOOP.
000000*
000000 CLEAR-LINES.
000000 MOVE SPACE TO WORK-AREA.
000000 DISPLAY WORK-AREA AT 0201.
000000 DISPLAY WORK-AREA AT 0301.
000000*
000000 TRANSFER-BUFFER.
000000 ADD 1 TO SUB1.
000000 ADD 1 TO SUB2.
000000 MOVE WORK-BYTE (SUB1) TO TEMP.
000000 IF TEMP NOT = 32
000000 MOVE SUB2 TO SUB2-SAV
000000 MOVE TEMP TO OUT-BYTE (SUB2).
000000 IF SUB1 < TMAX
000000 GO TO TRANSFER-BUFFER.
000000 MOVE SUB2-SAV TO SUB2.
000000 ADD 1 TO SUB2.
000000*

BIN
emu/yaze/COBOL/CLI.COM Normal file
View File

Binary file not shown.

BIN
emu/yaze/COBOL/COBOL Normal file
View File

Binary file not shown.

BIN
emu/yaze/COBOL/COBOL.COM Normal file
View File

Binary file not shown.

160
emu/yaze/COBOL/COBOL.ERR Normal file
View File

@@ -0,0 +1,160 @@
Compiler error; consult Technical Support
Illegal format : Data-name
Illegal format : Literal, or invalid use of ALL
Illegal format : Character
Data-name not unique
Too many data or procedure names declared
Illegal character in column 7 or continuation error
Nested COPY statement or unknown COPY file specified
'.' missing
Statement starts in wrong area of source line
Compiler error; consult Technical Support
Compiler error; consult Technical Support
Compiler error; consult Technical Support
Compiler error; consult Technical Support
Compiler error; consult Technical Support
Compiler error; consult Technical Support
Compiler error; consult Technical Support
Compiler error; consult Technical Support
Compiler error; consult Technical Support
Compiler error; consult Technical Support
'.' missing
DIVISION missing
SECTION missing
IDENTIFICATION missing
PROGRAM-ID missing
AUTHOR missing
INSTALLATION missing
DATE-WRITTEN missing
SECURITY missing
ENVIRONMENT missing
CONFIGURATION missing
SOURCE-COMPUTER missing
OBJECT-COMPUTER/SPECIAL-NAMES clause error
OBJECT-COMPUTER missing
Compiler error; consult Technical Support
SPECIAL-NAMES missing
SWITCH clause error or system name/mnemonic name error
DECIMAL-POINT clause error
CONSOLE clause error
Illegal currency symbol
'.' missing
DIVISION missing
SECTION missing
INPUT-OUTPUT missing
FILE-CONTROL missing
ASSIGN missing
SEQUENTIAL or RELATIVE or INDEXED missing
ACCESS missing on indexed/relative file
SEQUENTIAL or DYNAMIC missing or > 64 alternate keys
Illegal ORGANIZATION/ACCESS/KEY combination
Unrecognized phrase in SELECT clause
RERUN clause syntax error
SAME AREA clause syntax error
Missing or illegal file-name
DATA DIVISION missing
PROCEDURE DIVISION missing or unknown statement
Program collating sequence not defined
Compiler error; consult Technical Support
Compiler error; consult Technical Support
Compiler error; consult Technical Support
'.' missing
DIVISION missing
SECTION missing
File-name not specified in SELECT stmt or invalid CD name
RECORD SIZE integer missing or line sequential rec > 1024 bytes
Illegal level no (01-49),01 level reqd,or level hierarachy wrong
FD, CD or SD qualification syntax error
WORKING-STORAGE missing
PROCEDURE DIVISION missing or unknown statement
Data description qualifier or '.' missing
Incompatible PICTURE clause and qualifiers
BLANK illegal with non-numeric data-item
PICTURE clause too long
VALUE with non-elementary item,wrong data-type or value truncated
VALUE in error or illegal for PICTURE type
Non-elementary item has FILLER/SYNC/JUST/BLANK clause
Preceding item at this level has > 8192 bytes or 0 bytes
REDEFINES of unequal fields or different levels
Data storage exceeds 64K bytes
Compiler error; consult Technical Support
Data description qualifier inappropriate or repeated
REDEFINES data-name not declared
USAGE must be COMP,DISPLAY or INDEX
SIGN must be LEADING or TRAILING
SYNCHRONIZED must be LEFT or RIGHT
JUSTIFIED must be RIGHT
BLANK must be ZERO
OCCURS must be numeric, non-zero, unsigned or DEPENDING
VALUE must be literal, numeric literal or figurative constant
PICTURE string has illegal precedence or illegal char
INDEXED data-name missing or already declared
Numeric-edited PICTURE string is too large
Compiler error; consult Technical Support
Compiler error; consult Technical Support
Compiler error; consult Technical Support
Compiler error; consult Technical Support
Compiler error; consult Technical Support
Compiler error; consult Technical Support
Compiler error; consult Technical Support
Compiler error; consult Technical Support
Unrecognized verb
IF....ELSE mismatch
Operand has wrong data-type, is not declared or '.' missing
Procedure not unique
Procedure name same as data-name
Name required
Wrong combination of data-types
Conditional statement not allowed in this context
Malformed subscript
ACCEPT/DISPLAY wrong or Communications syntax incorrect
Illegal syntax used with I-O verb
Invalid arithmetic statement
Invalid arithmetic expression
Compiler error; consult Technical Support
Invalid conditional expression
IF stmts nested too deep, or too many AFTERs in PERFORM stmt
Incorrect structure of PROCEDURE DIVISION
Reserved word missing or incorrectly used
Too many subscripts in one statement (internal buffer overflow)
Too many operands in one statement
Compiler error; consult Technical Support
Compiler error; consult Technical Support
Compiler error; consult Technical Support
Compiler error; consult Technical Support
Compiler error; consult Technical Support
Compiler error; consult Technical Support
Compiler error; consult Technical Support
Compiler error; consult Technical Support
Compiler error; consult Technical Support
Compiler error; consult Technical Support
Compiler error; consult Technical Support
Compiler error; consult Technical Support
Compiler error; consult Technical Support
Compiler error; consult Technical Support
Compiler error; consult Technical Support
Compiler error; consult Technical Support
Compiler error; consult Technical Support
Compiler error; consult Technical Support
Compiler error; consult Technical Support
Compiler error; consult Technical Support
Inter-segment procedure name duplication
Unterminated condition at end of source
Operand has wrong data-type or not declared
Procedure name undeclared
INDEX data-name declared twice
Bad cursor control : illegal AT clause
KEY declaration missing or illegal
STATUS declaration missing
Bad STATUS record
Undefined inter-segment reference or error in ALTERed para
PROCEDURE DIVISION in error
USING parameter not declared in LINKAGE SECTION
USING parameter not level 01 or 77
USING parameter used twice in parameter list
FD missing
Compiler error; consult Technical Support
Incorrect structure of PROCEDURE DIVISION
Compiler error; consult Technical Support
Compiler error; consult Technical Support
Too many operands in one statement

BIN
emu/yaze/COBOL/COBOL.I51 Normal file
View File

Binary file not shown.

BIN
emu/yaze/COBOL/COBOL.I52 Normal file
View File

Binary file not shown.

BIN
emu/yaze/COBOL/COBOL.I53 Normal file
View File

Binary file not shown.

BIN
emu/yaze/COBOL/COBOL.I56 Normal file
View File

Binary file not shown.

BIN
emu/yaze/COBOL/COBOL.I59 Normal file
View File

Binary file not shown.

BIN
emu/yaze/COBOL/COBOL.ISR Normal file
View File

Binary file not shown.

BIN
emu/yaze/COBOL/CONFIG Normal file
View File

Binary file not shown.

BIN
emu/yaze/COBOL/IXSIO.INT Normal file
View File

Binary file not shown.

83
emu/yaze/COBOL/PI.CBL Normal file
View File

@@ -0,0 +1,83 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. PI-CALC.
AUTHOR. PF/TR.
*
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
OBJECT-COMPUTER. MDS-800.
SPECIAL-NAMES. CONSOLE IS CRT.
*
DATA DIVISION.
WORKING-STORAGE SECTION.
*
01 SCREEN PIC X(1920).
*
01 DI-1 REDEFINES SCREEN.
02 FILLER PIC X(160).
02 DI-TX1 PIC X(160).
02 DI-TX2 PIC X(13).
02 DI-TERM PIC X(15).
02 FILLER PIC X(136).
02 DI-TX3 PIC X(6).
02 DI-PI PIC X(15).
02 FILLER PIC X(1415).
*
01 DI-2 REDEFINES SCREEN.
02 FILLER PIC X(333).
02 DI-TERM2 PIC X(15).
02 FILLER PIC X(142).
02 DI-PI2 PIC X(15).
02 FILLER PIC X(1415).
*
01 WORK-AREA.
02 PI PIC S9V9(14).
02 TERM PIC S9V9(14).
02 W PIC S9V9(14).
02 N PIC 9999.
02 N1 PIC 9999.
02 N2 PIC 9999.
02 ED PIC -9.9(12).
*
01 CONSTANTS.
02 TX1 PIC X(17) VALUE "CALCULATION OF PI".
02 TX2 PIC X(12) VALUE "NEXT TERM IS".
02 TX3 PIC X(5) VALUE "PI IS".
*
PROCEDURE DIVISION.
LA-START.
DISPLAY SPACE.
MOVE SPACE TO SCREEN.
MOVE TX1 TO DI-TX1.
MOVE TX2 TO DI-TX2.
MOVE TX3 TO DI-TX3.
MOVE 0.5 TO ED.
MOVE ED TO DI-TERM.
MOVE 3 TO ED.
MOVE ED TO DI-PI.
DISPLAY DI-1.
MOVE 0.5 TO PI.
MOVE 0.5 TO TERM.
MOVE 3 TO N.
LOOP.
MOVE N TO N2.
SUBTRACT 2 FROM N2.
MULTIPLY N2 BY N2.
MULTIPLY N2 BY TERM.
MOVE N TO N1.
SUBTRACT 1 FROM N1.
MULTIPLY N BY N1.
MULTIPLY 4 BY N1.
DIVIDE N1 INTO TERM.
IF TERM < 0.0000000000001 THEN GO TO HALT.
ADD TERM TO PI.
MOVE PI TO W.
MULTIPLY 6 BY W.
MOVE W TO ED.
MOVE ED TO DI-PI2.
MOVE TERM TO ED.
MOVE ED TO DI-TERM2.
DISPLAY DI-2.
ADD 2 TO N.
IF N < 100 GO TO LOOP.
HALT.
STOP RUN.

BIN
emu/yaze/COBOL/RUN.COM Normal file
View File

Binary file not shown.

59
emu/yaze/COBOL/STOCK1.CBL Normal file
View File

@@ -0,0 +1,59 @@
000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID. STOCK-FILE-SET-UP.
000030 AUTHOR. MICRO FOCUS LTD.
000040 ENVIRONMENT DIVISION.
000050 CONFIGURATION SECTION.
000060 SOURCE-COMPUTER. MDS-800.
000070 OBJECT-COMPUTER. MDS-800.
000075 SPECIAL-NAMES. CONSOLE IS CRT.
000080 INPUT-OUTPUT SECTION.
000090 FILE-CONTROL.
000100 SELECT STOCK-FILE ASSIGN "STOCK.IT"
000110 ORGANIZATION INDEXED
000120 ACCESS DYNAMIC
000130 RECORD KEY STOCK-CODE.
000140 DATA DIVISION.
000150 FILE SECTION.
000160 FD STOCK-FILE; RECORD 32.
000170 01 STOCK-ITEM.
000180 02 STOCK-CODE PIC X(4).
000190 02 PRODUCT-DESC PIC X(24).
000200 02 UNIT-SIZE PIC 9(4).
000210 WORKING-STORAGE SECTION.
000220 01 SCREEN-HEADINGS.
000230 02 ASK-CODE PIC X(21) VALUE "STOCK CODE < >".
000240 02 FILLER PIC X(59).
000250 02 ASK-DESC PIC X(16) VALUE "DESCRIPTION <".
000260 02 SI-DESC PIC X(25) VALUE " >".
000270 02 FILLER PIC X(39).
000280 02 ASK-SIZE PIC X(21) VALUE "UNIT SIZE < >".
000290 01 ENTER-IT REDEFINES SCREEN-HEADINGS.
000300 02 FILLER PIC X(16).
000310 02 CRT-STOCK-CODE PIC X(4).
000320 02 FILLER PIC X(76).
000330 02 CRT-PROD-DESC PIC X(24).
000340 02 FILLER PIC X(56).
000350 02 CRT-UNIT-SIZE PIC 9(4).
000360 02 FILLER PIC X.
000370 PROCEDURE DIVISION.
000380 SR1.
000390 DISPLAY SPACE.
000400 OPEN I-O STOCK-FILE.
000410 DISPLAY SCREEN-HEADINGS.
000420 NORMAL-INPUT.
000430 MOVE SPACE TO ENTER-IT.
000440 DISPLAY ENTER-IT.
000450 CORRECT-ERROR.
000460 ACCEPT ENTER-IT.
000470 IF CRT-STOCK-CODE = SPACE GO TO END-IT.
000480 IF CRT-UNIT-SIZE NOT NUMERIC GO TO CORRECT-ERROR.
000490 MOVE CRT-PROD-DESC TO PRODUCT-DESC.
000500 MOVE CRT-UNIT-SIZE TO UNIT-SIZE.
000510 MOVE CRT-STOCK-CODE TO STOCK-CODE.
000520 WRITE STOCK-ITEM; INVALID GO TO CORRECT-ERROR.
000530 GO TO NORMAL-INPUT.
000540 END-IT.
000550 CLOSE STOCK-FILE.
000560 DISPLAY SPACE.
000570 DISPLAY "END OF PROGRAM".
000580 STOP RUN.

119
emu/yaze/COBOL/STOCK2.CBL Normal file
View File

@@ -0,0 +1,119 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. GOODS-IN.
AUTHOR. MICRO FOCUS LTD.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. MDS-800.
OBJECT-COMPUTER. MDS-800.
SPECIAL-NAMES. CONSOLE IS CRT.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT STOCK-FILE ASSIGN "STOCK.IT"
ORGANIZATION INDEXED
ACCESS DYNAMIC
RECORD KEY STOCK-CODE.
SELECT TRANS-FILE
ASSIGN "STOCK.TRS"
ORGANIZATION SEQUENTIAL.
/
DATA DIVISION.
FILE SECTION.
FD STOCK-FILE; RECORD 32.
01 STOCK-ITEM.
02 STOCK-CODE PIC X(4).
02 STOCK-DESCRIPT PIC X(24).
02 UNIT-SIZE PIC 9(4).
FD TRANS-FILE; RECORD 30.
01 TRANS-RECORD.
02 TRAN-NO PIC 9(4).
02 TF-STOCK-CODE PIC X(4).
02 TF-QUANTITY PIC 9(8).
02 TF-ORDER-NO PIC X(6).
02 TF-DATE PIC X(8).
WORKING-STORAGE SECTION.
01 STOCK-INWARD-FORM.
02 PRG-TITLE PIC X(20) VALUE " GOODS INWARD".
02 FILLER PIC X(140).
02 CODE-HDNG PIC X(23) VALUE "STOCK CODE < >".
02 FILLER PIC X(57).
02 ORDER-NO-HDNG PIC X(23) VALUE "ORDER NO < >".
02 FILLER PIC X(57).
02 DATE-HDNG PIC X(24) VALUE "DELIVERY DATE MM/DD/YY".
02 FILLER PIC X(56).
02 UNITS-HDNG PIC X(23) VALUE "NO OF UNITS < >".
01 STOCK-RECEIPT REDEFINES STOCK-INWARD-FORM.
02 FILLER PIC X(178).
02 SR-STOCK-CODE PIC X(4).
02 FILLER PIC X(74).
02 SR-ORDER-NO PIC X(6).
02 FILLER PIC X(73).
02 SR-DATE.
04 SR-MM PIC 99.
04 FILLER PIC X.
04 SR-DD PIC 99.
04 FILLER PIC X.
04 SR-YY PIC 99.
02 FILLER PIC X(75).
02 SR-NO-OF-UNITS PIC 9(4).
01 CONFIRM-MSG REDEFINES STOCK-INWARD-FORM.
02 FILLER PIC X(184).
02 CM-STOCK-DESCRIPT PIC X(24).
02 FILLER PIC X(352).
02 UNIT-SIZE-HDNG PIC X(18).
02 CM-UNIT-SIZE PIC 9(4).
02 FILLER PIC X(58).
02 QUANTITY-HDNG PIC X(14).
02 CM-QUANTITY PIC 9(8).
02 FILLER PIC X(58).
02 OK-HDNG PIC X(3).
02 CM-Y-OR-N PIC X.
/
PROCEDURE DIVISION.
START-PROC.
OPEN I-O STOCK-FILE.
OPEN OUTPUT TRANS-FILE.
DISPLAY SPACE.
MOVE 0 TO TRAN-NO.
DISPLAY STOCK-INWARD-FORM.
GET-INPUT.
ACCEPT STOCK-RECEIPT.
IF SR-STOCK-CODE = SPACE GO TO END-IT.
IF SR-NO-OF-UNITS NOT NUMERIC GO TO INVALID-ENTRY.
MOVE SR-STOCK-CODE TO STOCK-CODE.
READ STOCK-FILE; INVALID GO TO INVALID-CODE.
*VALID ENTRY, CALCULATE AND DISPLAY TOTAL QUANTITY IN TO CONFIRM
MOVE STOCK-DESCRIPT TO CM-STOCK-DESCRIPT.
MOVE "UNIT SIZE" TO UNIT-SIZE-HDNG.
MOVE UNIT-SIZE TO CM-UNIT-SIZE.
MOVE "QUANTITY IN" TO QUANTITY-HDNG.
MOVE UNIT-SIZE TO TF-QUANTITY.
MULTIPLY SR-NO-OF-UNITS BY TF-QUANTITY.
MOVE TF-QUANTITY TO CM-QUANTITY.
MOVE "OK?" TO OK-HDNG.
DISPLAY CONFIRM-MSG.
ACCEPT CM-Y-OR-N AT 1004.
IF CM-Y-OR-N = "Y" PERFORM WRITE-TRANS.
*CLEAR INPUT DATA ON SCREEN
MOVE SPACE TO CONFIRM-MSG.
MOVE "MM/DD/YY" TO SR-DATE.
DISPLAY STOCK-RECEIPT.
DISPLAY CONFIRM-MSG.
GO TO GET-INPUT.
WRITE-TRANS.
ADD 1 TO TRAN-NO.
MOVE STOCK-CODE TO TF-STOCK-CODE.
MOVE SR-ORDER-NO TO TF-ORDER-NO.
MOVE GET-INPUT TO TF-DATE.
WRITE TRANS-RECORD.
INVALID-ENTRY.
DISPLAY "NON-NUMERIC NO OF UNITS" AT 0325.
GO TO GET-INPUT.
INVALID-CODE.
DISPLAY "INVALID CODE " AT 0325.
GO TO GET-INPUT.
END-IT.
CLOSE STOCK-FILE.
CLOSE TRANS-FILE.
DISPLAY SPACE.
DISPLAY "END OF PROGRAM".
STOP RUN.

19
emu/yaze/COBOL/TESTCALL.CBL Normal file
View File

@@ -0,0 +1,19 @@
000000******************************************************************
000000*
000000* Program "Testcall" to demonstrate L/II COBOL calling mechanism
000000*
000000******************************************************************
000000 Working-storage section.
000000 01 progname pic x(4).
000000 01 message-size pic 9(2) comp value 60.
000000 01 message-text pic x(60) value
000000 "This message is sent via a called program to the screen.".
000000 Procedure division.
000000 move "call" to progname.
000000 call progname using message-size,message-text
000000 overflow display "call overflowed".
000000******************************************************************
000000*
000000* End of demonstration program "Testcall"
000000*
000000******************************************************************

BIN
emu/yaze/COBOL/TESTCALL.INT Normal file
View File

Binary file not shown.