         PCC      0
         SYSTEM   SIG7FDP
         SYSTEM   BPM
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
         DEF      FORMESS
         REF      M:DO
         REF      C:ABA
* THERE ARE TWO FORMATS FOR THIS ENTER FORMESS ROUTINE
* THEY ARE TYPE A AND TYPE B (S25267)
*
* AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
* A THIS IS THE 'OLD' FORMAT
* IT SIGNALS TO THE OPERATOR TO CHANGE PRINTER OR PUNCH STOCK
* ALLOWS THE USER TO SPECIFY A CHANGE ON THE SPECIFIED
* OUTPUT DEVICE.
* ANY MESSAGE UP TO 255 BYTES LONG MAY BE INSERTED IN THE OUTPUT
* SYMBIONT STREAM. THE MESSAGE           DIRECTED TO THE COMPUTER,
* IS AUTOMATICALLY DIRECTED TO THE OPERATOR'S CONSOLE, AND THE
* OUTPUT SYMBIONT IS SUSPENDED UPON PERFORMANCE OF THE ACTION
* SPECIFIED IN THE USER PROGRAMMER'S MESSAGE, THE SYMBIONT
* CAN BE RESTARTED AND PRINTING OR PUNCHING RESUMED.
* NOTE THAT ANOTHER MESSAGE IS NECESSARY BEFORE THE ORIGINAL
* FORM CAN BE REPLACED.
*
* USER SYNTAX::::::::::::::::::::::::::::::::::::::::::::::::::
*
* ENTER   FORMESS  FILE-NAME,DATA-NAME-1,DATA-NAME-2
*
*
*          FORMESS: THE ENTRY POINT OF THE SUBROUTINE
*          FILE-NAME:  THE APPROPRIATE OUTPUT FD NAME WHERE THE
* THE MESSAGE IS WRITTEN.
*          DATA-NAME-1:   THE MESSAGE ITSELF TO BE GIVEN TO THE OPERATOR
*    IT MUST START AT A WORD BOUNDARY AND THE FIRST BYTE MUST BE
* A BLANK
*          DATA-NAME-2:   THE LENGTH OF THE MESSAGE IT MUST BE COMPUTATIONAL
*    255 IS THE MAX SIZE
*
* BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
*  THE FOLLOWING IS TYPE B THE 'NEW' FORMAT
*
* FORMESS IS A SUBROUTINE DESIGNED TO BE CALLED BY
* ANY COBOL PROGRAM TO CONNECT A DCB TO A LOGICAL DEVICE.
* I.E., LP -> L2, L3, L4   CP -> P2, P3
* THE ACCEPTABLE SYNTAX IS AS FOLLOWS:
*
*      ENTER FORMESS,STREAM-ID,FORM-NAME
*
* WHERE STREAM-ID AND FORM-NAME ARE DISPLAY DATA NAMES
* AND REPRESENT THE LOGICAL DEVICE ( 2 CHARACTERS ) AND
* FORM NAME ( 4 CHARACTERS ), RESPECTIVELY.
         PAGE
FORMESS  EQU      %
         LCI      0
         STM,R0   REGSAV            SAVE ALL OF COBOLS REGISTERS.
         AWM,14   REGSAV+15         COMPUTE RETURN ADDR 2 OR 3
         CI,14    2                 IF 2 IS THE NEW FORMAT
         BE       FORMESSB          YES
         CI,14    3                 IF 3 THE 'OLD' FORMAT
         BE       FORMESSO          YES
         B        ERROR             USER HAS NOT SET UP CORRECTLY
FORMESSB RES      0                 ENTRY POINT FOR NEW FORMESS
         LI,R2    X'7FFFF'          19 BIT MASK FOR BYTE ADDRESS
         AND,R2   *R15               POINTER TO BA(STREAM-ID)
         LW,R3    LENSTREAM         COUNT AND DESTINATION OF STREAM-ID
         MBS,R2   0                 MOVE INTO LDEV FPT.
         LI,R2    X'7FFFF'          19 BIT MASK FOR BYTE ADDRESS
         AI,R15   1                 POINTER TO BA(FORM-NAME)
         AND,R2   *R15               OF FORM-NAME.
         LW,R3    LENFORM           COUNT AND DESTINATION OF FORM NAME.
         MBS,R2   0                 MOVE IT INTO LDEV FPT.
         LI,R3    0                 SCAN COUNTER FOR STREAM-ID
         LW,R8    LDEV+2            LOAD THE STREAM-ID.
         OR,R8    =X'FFFF0000'      SET FOR COMPARE HALFWORD
SCAN     EQU      %
         CH,R8    VALID,R3          CHECK STREAM-ID WITH VALID LIST.
         BE       IDOK              IF VALID GO DO LDEV
         AI,R3    1                 BUMP LIST POINTER.
         CI,R3    5                 HAVE WE RUN OUT OF ID'S?
         BGE      ERROR             NOT VALID ID'S
         B        SCAN              LOOK FOR MORE...
IDOK     EQU      %
,LDEV    M:LDEV   'BM',(FORM,'MRK3') DUMMY FPT
FORMESSZ RES      0                 ENTRY FOR RETURN BACK TO MAIN-PRG
         LCI      0                 RESTORE ALL
         LM,R0    REGSAV             REGISTERS AND
         B        *15
FORMESSO RES      0                 ENTRY FOR OLD FORMAT
         LI,2     0                 CLEAR OUT
         LI,3     X'7FFFF'          MASK
         LS,2     *15               2 HAS DCB ADDR
         LW,5     *2                GET WORD 0 OF THE DCB
         STS,2    FPTD              STORE DCB ADDR
         STS,2    FPTW              STORE DCB ADDR                      FORMESS
         STS,2    FPTWW             STORE DCB ADDR                      FORMESS
         LS,2     1,2               R2 = 2ND WORD OF DCB                FORMESS
         LW,1     2                   (DEVF B16), (TYPE B18-23)         FORMESS
         LS,2     *15               PICK UP DCB ADDR AGAIN - WIPED OUT  FORMESS
         LS,2     2,2               R2 = ADDR OF USER BUFFER            FORMESS
         STW,2    FPTWW+2           STORE FOR DUMMY WRITE-FORMERLY STS  FORMESS
         AI,15    1                 POINT TO MESSAGE NAME
         LS,2     *15               2 HAS BEGIN OF MESSAGE
         SAS,2    -2                R2 = WORD ADDR                      FORMESS
         STW,2    FPTW+2            INSERT ADDR OF MESSAGE TO BUF       FORMESS
         SAS,2    2                 R2 = BYTE ADDR                      FORMESS
         AI,15    1                 POINT TO LENGTH
         AND,3    *15               3 HAS LENGTH ADDR
         LW,4     *3                4 HAS LENGTH
         CI,4     255               MAX SIZE
         BLE      FORMESSP          OK
         LI,4     255               USE MAX SIZE                        FORMESS
FORMESSP RES      0
         STW,4    FPTW+3            INSERT MESS LGTH TO SIZE            FORMESS
         LI,3     MESS              GET ADDR
         SAS,3    2                 3 HAS BYTE ADDR
         AI,3     1                 TO 2ND BYTE
         STB,4    3                 STUFF IN LENGTH
         STB,4    MESS              BYTE COUNT FOR M:DEVICE
         MBS,2    0                 MOVE MESSAGE TO MESS AREA
         AND,5    =X'F'             SEE DEVICE TYPE
         CI,5     3                 ONLY DEVICE DCBS ALLOWED
         BNE      WRITE             DO M:WRITE                          FORMESS
,FPTD    M:DEVICE 0,(FORM,MESS)     ISSUE MONITOR CALL
         B        FORMESSZ          EXIT OUT DON'T KNOW IF WORKED
WRITE    RES      0                                                     FORMESS
,FPTW    M:WRITE  0,(BUF,ADDR),(SIZE,0),(WAIT)  ISSUE MONITOR CAL       FORMESS
,FPTWW   M:WRITE  0,(BUF,ADDR),(SIZE,0),(WAIT)  DUMMY WRITE RES BUF
         B        FORMESSZ                                              FORMESS
ERROR    RES      0
         LI,2     X'9A'             ERROR FLAG TO USER
         STB,2    10
         B        C:ABA             PRINT ERROR AND TERMINATE
ADDR     RES      1                 DUMMY ADDRESS                       FORMESS
REGSAV   RES      16                COBOL SAVE AREA.
VALID    TEXT     'L2','L3','L4','P2','P3' VALID LOGICAL DEVICES
LENSTREAM GEN,8,24 2,BA(LDEV+2)+2   COUNT AND DEST. ADDRESS OF STREAM
LENFORM  GEN,8,24 4,BA(LDEV+3)      COUNT AND DEST. ADDRESS FOR FORM
MESS     RES       64
         END
