       IDENTIFICATION DIVISION.
       PROGRAM-ID.   RMCLNK.
      *                  Ver. 2.0
      *              For CP/M-86 OpSys Environments only
      *              Date Revised   19 Apr 1984
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       SOURCE-COMPUTER.  RMCOBOL.
       OBJECT-COMPUTER.  RMCOBOL.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
       SELECT NEW-FILE ASSIGN TO RANDOM NEW-NAME
           ORGANIZATION IS RELATIVE
           ACCESS MODE IS RANDOM
           RELATIVE KEY IS NEW-KEY
           FILE STATUS IS NEW-STATUS.
       SELECT OLD-FILE ASSIGN TO RANDOM OLD-NAME
           ORGANIZATION IS RELATIVE
           ACCESS MODE IS RANDOM
           RELATIVE KEY IS OLD-KEY
           FILE STATUS IS OLD-STATUS.
       SELECT ASM-FILE ASSIGN TO RANDOM ASM-NAME
           ORGANIZATION IS RELATIVE
           ACCESS MODE IS RANDOM
           RELATIVE KEY IS ASM-KEY
           FILE STATUS IS ASM-STATUS.
       DATA DIVISION.
       FILE SECTION.
       FD  NEW-FILE.
       01  NEW-REC                  PIC X(16).
       FD  OLD-FILE.
       01  OLD-REC                  PIC X(16).
       FD  ASM-FILE.
       01  ASM-REC                  PIC X(16).
      /
       WORKING-STORAGE SECTION.
       01  FILE-NAMES.
           03  FILE-NAME            PIC X(14)    OCCURS 3 TIMES.
       01  ENTER-LITERALS.
           03  ENTER-LIT            PIC X(33)    OCCURS 3 TIMES.
       01  ERROR-LITERALS.
           03  ERROR-LIT            PIC X(24)    OCCURS 5 TIMES.
       01  HEADERS.
           03  HEADER OCCURS 2 TIMES.
               05  BYTE-1           PIC X.
               05  CODE-LNGTH       PIC 9(5)     USAGE COMP-1.
               05  FILLER           PIC XX.
               05  CODE-1           PIC 9(5)     USAGE COMP-1.
               05  CODE-2           PIC 9(5)     USAGE COMP-1.
               05  FILLER           PIC X.
               05  DATA-LNGTH       PIC 9(5)     USAGE COMP-1.
               05  FILLER           PIC XX.
               05  DATA-1           PIC 9(5)     USAGE COMP-1.
       01  BASE-PAGE.
           03  FILLER               PIC X(10).
           03  DATA-END             PIC 9(5)     USAGE COMP-1.
           03  PROCTBL              PIC 9(5)     USAGE COMP-1.
           03  PROCTBL-M80          PIC 9(5)     USAGE COMP-1.
       77  M80-IND                  PIC 9.
       77  NEW-KEY                  PIC 9(4).
       77  OLD-KEY                  PIC 9(4).
       77  ASM-KEY                  PIC 9(4).
       77  SAVE-KEY                 PIC 9(4).
       77  NEW-STATUS               PIC XX.
       77  OLD-STATUS               PIC XX.
       77  ASM-STATUS               PIC XX.
       77  NEW-NAME                 PIC X(14).
       77  OLD-NAME                 PIC X(14).
       77  ASM-NAME                 PIC X(14).
       01  CODE-PARA-NUMS.
           03  CODE-PARA            PIC 9(5)     OCCURS 2 TIMES.
       01  DATA-PARA-NUMS.
           05  DATA-PARA            PIC 9(5)     OCCURS 2 TIMES.
       01  COMP-WORD                PIC 9(5)     USAGE COMP-1.
       01  COMP-BYTES REDEFINES COMP-WORD.
           03  C1                   PIC X.
           03  C2                   PIC X.
       77  C3                       PIC X.
       77  WORK-WORD                PIC S9(5).
       77  A                        PIC 9.
       77  B                        PIC 9.
       77  E                        PIC 9.
       77  L                        PIC 99.
       77  I                        PIC 9.
      /
       PROCEDURE DIVISION.
       DECLARATIVES.
       OLD-FILE SECTION.
           USE AFTER STANDARD ERROR PROCEDURE ON OLD-FILE.
       OLD-PARA.
           IF OLD-STATUS = "23" MOVE LOW-VALUES TO NEW-REC
             ELSE MOVE 1 TO E.
       ASM-FILE SECTION.
           USE AFTER STANDARD ERROR PROCEDURE ON ASM-FILE.
       ASM-PARA.
           IF ASM-STATUS = "23" MOVE LOW-VALUES TO NEW-REC
             ELSE MOVE 1 TO E.
       NEW-FILE SECTION.
           USE AFTER STANDARD ERROR PROCEDURE ON NEW-FILE.
       NEW-PARA.
           MOVE 1 TO E.
       END DECLARATIVES.
      *
       MAIN SECTION.
       INIT-PARA.
           MOVE "1. Enter Old Runtime File Name" TO ENTER-LIT (1).
           MOVE "2. Enter Assembly Subprogram Name" TO ENTER-LIT (2).
           MOVE "3. Enter New Runtime File Name" TO ENTER-LIT (3).
           MOVE "Entry left blank" TO ERROR-LIT (1).
           MOVE "Names can`t be identical" TO ERROR-LIT (2).
           MOVE "Hit any key to try again" TO ERROR-LIT (3).
           MOVE "File not found" TO ERROR-LIT (4).
           MOVE "Incorrect file type" TO ERROR-LIT (5).
           MOVE 1 TO A MOVE 2 TO B MOVE 1 TO I MOVE 5 TO L.
           MOVE 1 TO OLD-KEY   MOVE 0 TO NEW-KEY   MOVE 1 TO ASM-KEY.
           MOVE 0 TO M80-IND.
           DISPLAY "RM/COBOL Link Utility (Ver. 2.0) " LINE 1 ERASE
               "for CP/M-86 OpSys Environments" POSITION 0.
       PARA-1.
           PERFORM NAME-PARA   MOVE FILE-NAME (I) TO OLD-NAME.
           PERFORM RESET-E   OPEN INPUT OLD-FILE WITH LOCK.
           PERFORM NOT-FOUND   PERFORM READ-OLD-FILE.
           PERFORM CMD-CHECK   PERFORM INC-PARA.
       PARA-2.
           PERFORM NAME-PARA   PERFORM COMPARE-PARA.
           MOVE FILE-NAME (I) TO ASM-NAME.
           PERFORM RESET-E   OPEN INPUT ASM-FILE WITH LOCK.
           PERFORM NOT-FOUND   PERFORM READ-ASM-FILE.
           PERFORM CMD-CHECK   PERFORM INC-PARA.
       PARA-3.
           PERFORM NAME-PARA   MOVE 3 TO B   PERFORM COMPARE-PARA.
           MOVE 2 TO A   PERFORM COMPARE-PARA.
           MOVE FILE-NAME (I) TO NEW-NAME   PERFORM RESET-E.
           OPEN OUTPUT NEW-FILE   PERFORM IO-ERROR-CHECK.
           CLOSE NEW-FILE   PERFORM IO-ERROR-CHECK.
      /
       BUILD-LINKED-RUNTIME.
           DISPLAY "Linking New Runtime" LINE 23 POSITION 40 BLINK.
           OPEN I-O NEW-FILE WITH LOCK   PERFORM IO-ERROR-CHECK.
           SUBTRACT 1 FROM OLD-KEY   PERFORM RUN-CODE-MOVE.
           MOVE 1 TO I  PERFORM GET-CODE-LNGTH.
           PERFORM RUN-CODE-MOVE 7 TIMES.
           PERFORM RUN-CODE-MOVE CODE-PARA (1) TIMES.
           MOVE 2 TO I   PERFORM GET-CODE-LNGTH   ADD 7 TO ASM-KEY.
           SUBTRACT 1 FROM CODE-PARA (2)   PERFORM ASM-CODE-MOVE.
           IF NEW-REC = LOW-VALUES MOVE 1 TO M80-IND.
           PERFORM ASM-CODE-MOVE CODE-PARA (2) TIMES.
           ADD 1 TO CODE-PARA (2).
           MOVE DATA-LNGTH (2) TO COMP-WORD   PERFORM FLIP-BYTES.
           MOVE COMP-WORD TO DATA-PARA (2).
           PERFORM RUN-CODE-MOVE 41 TIMES   MOVE OLD-REC TO BASE-PAGE.
           MOVE CODE-LNGTH (1) TO COMP-WORD   PERFORM COMPUTE-PARA.
           MOVE COMP-WORD TO PROCTBL.
           MOVE DATA-END TO COMP-WORD   PERFORM FLIP-BYTES.
           MOVE COMP-WORD TO WORK-WORD.
           IF WORK-WORD < 0 ADD 65536 TO WORK-WORD.
           COMPUTE DATA-PARA (1) ROUNDED = (WORK-WORD + 7) / 16 .
           MOVE NEW-KEY TO SAVE-KEY   PERFORM REWRITE-HEADER.
           MOVE SAVE-KEY TO NEW-KEY.
           MOVE DATA-LNGTH (1) TO COMP-WORD   PERFORM COMPUTE-PARA.
           MOVE COMP-WORD TO DATA-END.
           IF M80-IND = 1 ADD 256 TO PROCTBL-M80.
           MOVE BASE-PAGE TO NEW-REC   PERFORM REWRITE-PARA.
           SUBTRACT 41 FROM DATA-PARA (1) GIVING WORK-WORD.
           PERFORM RUN-CODE-MOVE WORK-WORD TIMES.
           PERFORM ASM-CODE-MOVE DATA-PARA (2) TIMES.
           DISPLAY "Linkage Successful  " LINE 23 POSITION 40.
       STOP-PARA.
           CLOSE NEW-FILE   CLOSE OLD-FILE   CLOSE ASM-FILE.
           STOP RUN.
      *
       READ-OLD-FILE.
           PERFORM RESET-E   READ OLD-FILE RECORD INTO NEW-REC.
           MOVE 1 TO I   PERFORM IO-ERROR-CHECK.
       READ-ASM-FILE.
           PERFORM RESET-E   READ ASM-FILE RECORD INTO NEW-REC.
           MOVE 2 TO I   PERFORM IO-ERROR-CHECK.
       WRITE-PARA.
           PERFORM RESET-E   WRITE NEW-REC.
           MOVE 3 TO I   PERFORM IO-ERROR-CHECK.
       REWRITE-PARA.
           PERFORM RESET-E   REWRITE NEW-REC.
           MOVE 3 TO I   PERFORM IO-ERROR-CHECK.
       RUN-CODE-MOVE.
           ADD 1 TO OLD-KEY  PERFORM READ-OLD-FILE  PERFORM WRITE-SEQ.
       ASM-CODE-MOVE.
           ADD 1 TO ASM-KEY  PERFORM READ-ASM-FILE  PERFORM WRITE-SEQ.
       WRITE-SEQ.
           ADD 1 TO NEW-KEY   PERFORM WRITE-PARA.
      /
       GET-CODE-LNGTH.
           MOVE CODE-LNGTH (I) TO COMP-WORD   PERFORM FLIP-BYTES.
           MOVE COMP-WORD TO CODE-PARA (I).
       FLIP-BYTES.
           MOVE C2 TO C3 MOVE C1 TO C2 MOVE C3 TO C1.
       COMPUTE-PARA.
           PERFORM FLIP-BYTES.
           MULTIPLY 16 BY COMP-WORD GIVING WORK-WORD.
           IF WORK-WORD > 32767 SUBTRACT 65536 FROM WORK-WORD.
           MOVE WORK-WORD TO COMP-WORD   PERFORM FLIP-BYTES.
       REWRITE-HEADER.
           ADD CODE-PARA (2) CODE-PARA (1) GIVING COMP-WORD.
           PERFORM FLIP-BYTES   MOVE COMP-WORD TO CODE-LNGTH (1).
           MOVE CODE-LNGTH (1) TO CODE-1 (1).
           MOVE CODE-1 (1) TO CODE-2 (1).
           ADD DATA-PARA (2) DATA-PARA (1) GIVING COMP-WORD.
           PERFORM FLIP-BYTES   MOVE COMP-WORD TO DATA-LNGTH (1).
           ADD 1 DATA-LNGTH (1) GIVING DATA-1 (1).
           MOVE HEADER (1) TO NEW-REC.
           MOVE 1 TO NEW-KEY   PERFORM REWRITE-PARA.
       RESET-E.
           MOVE 0 TO E.
       IO-ERROR-CHECK.
           IF E = 1 DISPLAY "I/O Error on " LINE 23 POSITION 40
               FILE-NAME (I) POSITION 0   PERFORM STOP-PARA.
       NOT-FOUND.
           IF E = 1 MOVE 4 TO E PERFORM ERROR-PARA.
       CMD-CHECK.
           MOVE 0 TO COMP-WORD.
           MOVE NEW-REC TO HEADER (I)   MOVE BYTE-1 (I) TO C2.
           IF COMP-WORD NOT = 1 PERFORM CMD-ERROR.
       CMD-ERROR.
           IF I = 1 CLOSE OLD-FILE ELSE CLOSE ASM-FILE.
           MOVE 5 TO E   PERFORM ERROR-PARA.
       NAME-PARA.
           DISPLAY ENTER-LIT (I) LINE L POSITION 5.
           ACCEPT FILE-NAME (I) LINE L POSITION 45 TAB.
           IF FILE-NAME (I) = SPACES MOVE 1 TO E PERFORM ERROR-PARA.
       COMPARE-PARA.
           IF FILE-NAME (A) = FILE-NAME (B)
               MOVE 2 TO E PERFORM ERROR-PARA.
       ERROR-PARA.
           DISPLAY ERROR-LIT (E) LINE 23 POSITION 40
               ERROR-LIT (3) POSITION 40.
           ACCEPT E POSITION 0.
           DISPLAY SPACES SIZE 14 LINE L POSITION 45
               " " LINE 23 POSITION 40 ERASE EOS.
           GO TO PARA-1 PARA-2 PARA-3 DEPENDING ON I.
       INC-PARA.
           ADD 1 TO I   ADD 2 TO L.
      *
       END PROGRAM.
