       IDENTIFICATION DIVISION.
       PROGRAM-ID.   RMCSYS.
      *                  Ver. 2.0B
      *              For CP/M-86 OpSys Environments
      *              Date Revised  10 July 1984
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       SOURCE-COMPUTER.  RMCOBOL.
       OBJECT-COMPUTER.  RMCOBOL.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01  PATCH-REC.
           03  PATCH-BYTE       PIC X      OCCURS 128 TIMES.
       77  PATCH-NAME           PIC X(74).
       77  LNGTH                PIC 999.
       77  ADDR                 PIC 9(10).
       77  PATCH-RTN            PIC 9.
       77  INX-EXT              PIC XXXX   VALUE ".INX".
       77  DAT-EXT              PIC XXXX   VALUE SPACES.
       77  MAX-FUNC             PIC 99     VALUE 6.
       77  START-ADDR           PIC 9(5)   COMP.
       01  RUN-STRUCT.
           03  S-1              PIC X(292).
           03  TIME-ADDR        PIC XX.
           03  FILLER           PIC X(4).
           03  S-2.
               05  LNK-ADDR     PIC XX.
               05  S-3          PIC X(32).
               05  FKEY-ADDR    PIC XX.
       01  RUN-128.
           03  RUN-1            PIC X(128).
           03  RUN-2            PIC X(128).
           03  RUN-3            PIC X(36).
       01  COMP1                PIC 9(5)   COMP-1.
       01  COMP1-BYTES REDEFINES COMP1.
           03  C1               PIC X.
           03  C2               PIC X.
       77  COMP2                PIC 9(5)   COMP-1.
       77  COMP2-BYTES REDEFINES COMP2 PIC XX.
       77  WORK1                PIC S9(5)  COMP.
       LINKAGE SECTION.
       77  FILE-NAME            PIC X(74).
       77  DATA-BUF             PIC X(512).
       77  FUNC                 PIC 99.
       77  RTN                  PIC 99.
      *
       PROCEDURE DIVISION USING FILE-NAME DATA-BUF FUNC RTN.
       INIT-PARA.
           IF RTN = 0 MOVE 2 TO RTN PERFORM EXIT-PARA
             ELSE IF RTN NOT = 2 PERFORM ERROR-EXIT.
           IF FUNC NOT NUMERIC OR FUNC = 0
               OR FUNC > MAX-FUNC PERFORM ERROR-EXIT.
           GO TO PARA-1 PARA-2 PARA-3 PARA-4 PARA-5 PARA-6
               DEPENDING ON FUNC.
      /
      *    This paragraph gets the start address of the
      *        configuration table
       GET-START-ADDR.
           MOVE FILE-NAME TO PATCH-NAME.
           MOVE 0 TO ADDR   MOVE 0 TO LNGTH   PERFORM CALL-PARA.
           MOVE PATCH-BYTE (1) TO C2   MOVE LOW-VALUE TO C1.
           IF COMP1 NOT = 1 PERFORM ERROR-EXIT.
           MOVE PATCH-BYTE (3) TO C1   MOVE PATCH-BYTE (2) TO C2.
           MOVE COMP1 TO WORK1   IF WORK1 < 0 ADD 65536 TO WORK1.
           COMPUTE START-ADDR = (WORK1 * 16) + 384.
           MOVE START-ADDR TO ADDR.
       PARA-1.
           PERFORM GET-START-ADDR   MOVE ADDR TO DATA-BUF.
           PERFORM EXIT-PARA.
      *    This paragraph prcesses system-dependent runtime
      *        information used by RMCNFG (Configuration Utility)
       PARA-2.
           PERFORM GET-START-ADDR.
           MOVE DATA-BUF TO RUN-STRUCT MOVE S-1 TO RUN-128.
           MOVE 128 TO LNGTH   MOVE RUN-1 TO PATCH-REC.
           PERFORM CALL-PARA-SEQ   MOVE RUN-2 TO PATCH-REC.
           PERFORM CALL-PARA-SEQ   MOVE RUN-3 TO PATCH-REC.
           MOVE 36 TO LNGTH   PERFORM CALL-PARA   ADD 36 TO ADDR.
           MOVE TIME-ADDR TO COMP1-BYTES.
           IF COMP1 NOT = 256   MOVE TIME-ADDR TO PATCH-REC
               MOVE 2 TO LNGTH   PERFORM CALL-PARA.
           ADD 6 TO ADDR   MOVE LNK-ADDR TO COMP1-BYTES.
           MOVE FKEY-ADDR TO COMP2-BYTES.
           IF COMP1 NOT = 256 AND COMP2 NOT = 256 MOVE 36 TO LNGTH
               MOVE S-2 TO PATCH-REC PERFORM CALL-PARA
             ELSE ADD 2 TO ADDR MOVE 32 TO LNGTH
                 MOVE S-3 TO PATCH-REC PERFORM CALL-PARA
                 IF COMP1 NOT = 256 SUBTRACT 2 FROM ADDR
                     MOVE 2 TO LNGTH MOVE LNK-ADDR TO PATCH-REC
                     PERFORM CALL-PARA
                   ELSE IF COMP2 NOT = 256 ADD 32 TO ADDR
                       MOVE 2 TO LNGTH MOVE FKEY-ADDR TO PATCH-REC
                       PERFORM CALL-PARA.
           PERFORM EXIT-PARA.
      *
      *    This paragraph returns the default indexed extension
       PARA-3.
           MOVE INX-EXT TO DATA-BUF   PERFORM EXIT-PARA.
      *
      *    This paragraph returns the default data file extension
       PARA-4.
           MOVE DAT-EXT TO DATA-BUF   PERFORM EXIT-PARA.
      *
      *    This paragraph returns the system block size (i.e. 512,
      *        256 or 128 bytes)
       PARA-5.
           MOVE 128 TO DATA-BUF   PERFORM EXIT-PARA.
      *
      *    This paragraph returns LOW-VALUES for reverse-byte CPU's
      *        and SPACES for normal CPU's
       PARA-6.
           MOVE LOW-VALUES TO DATA-BUF   PERFORM EXIT-PARA.
      *
      *
       CALL-PARA-SEQ.
           PERFORM CALL-PARA   ADD 128 TO ADDR.
       CALL-PARA.
           MOVE 0 TO PATCH-RTN   CALL "RMPSUB.COB"
               USING PATCH-NAME PATCH-REC LNGTH ADDR PATCH-RTN.
           IF PATCH-RTN = 0 MOVE SPACES TO DATA-BUF PERFORM ERROR-EXIT.
       ERROR-EXIT.
           MOVE 0 TO RTN   PERFORM EXIT-PARA.
       EXIT-PARA.
           EXIT PROGRAM.
       END PROGRAM.
