*DECK DB$ERSF 
USETEXT CDGDFTX 
      PROC DB$ERSF((FC),(FP),(UCPA),(SCPA),(LG)); 
      BEGIN 
 #
* *   DB$ERSF - SPLIT MESSAGES IF TOO LONG       PAGE  1
* *   BOB MCALLESTER                             DATE  11/14/83 
* 
* DC  PURPOSE 
* 
*     THE SF.REGR FUNCTION CAN NOT HANDLE MESSAGES THAT ARE LONGER THAN 
*     38 CHARACTERS.  DB$ERSF SPLITS LONGER MESSAGES. 
* 
* DC  ENTRY CONDITIONS
* 
* D   PARAMETERS
# 
      ITEM FC;               # FUNCTION CODE, ALWAYS SF.REGR.          #
      ITEM FP;               # FUNCTION PARAMETER                      #
      ITEM LG;               # LENGTH OF THE MESSAGE IN CHARACTERS     #
      ITEM SCPA;             # SYSTEM CONTROL POINT ADDRESS OF MESSAGE #
      ITEM UCPA;             # UCPA IS ERROR FLAG FOR SF.REGR FUNCTION #
# 
* D   ASSUMPTIONS 
* 
*     THE FC PARAMETER IS ALWAYS THE REGRETS FUNCTION.
*     THE ONLY REASON IT IS PASSED AS A PARAMETER IS TO KEEP THE
*     PARAMETERS COMPATIBLE WITH THE DB$SFCL CALL.
* 
* DC  EXIT CONDITIONS 
* 
*     THE ERROR MESSAGE HAS BEEN SENT TO THE UCP.  SPLIT IF NECESSARY.
* 
* DC  CALLING ROUTINES
* 
*     DB$ERR                 ERROR MESSAGE HANDLER
* 
* DC  CALLED ROUTINES 
# 
      XREF PROC DB$FLOP;     # FLOW POINT PROCESSOR                    #
      XREF PROC DB$MBA;      # ALLOCATE AN RCB LINKED MEMORY BLOCK     #
      XREF PROC DB$MBF;      # FREE AN RCB LINKED MEMORY BLOCK         #
      XREF PROC DB$POP;      # RESTORE A VARIABLE FROM THE RCB STACK   #
      XREF PROC DB$PUSH;     # SAVE A VARIABLE IN THE RCB STACK        #
      XREF PROC DB$SFCL;     # ISSUE A SUB-SYSTEM FUNCTION (SFCALL)    #
# 
* DC  NON-LOCAL VARIABLES MODIFIED
* 
*     NONE
* 
* DC  DESCRIPTION 
* 
*     THE OS WILL ONLY ACCEPT FOUR WORDS (40 CHARACTERS) FOR AN ERROR 
*     MESSAGE IN THE SF.REGR FUNCTION.
*     THE LAST TWO CHARACTER POSITIONS MUST BE FILLED WITH BINARY ZEROS 
*     AS A MESSAGE TERMINATOR (ON NOS/BE).
*     CDCS OFFSETS ITS MESSAGES BY TWO CHARACTERS SO THAT THE FIRST TWO 
*     CHARACTERS MUST BE BLANKS.
*     THIS LEAVES 36 USABLE CHARACTER POSITIONS IN EACH MESSAGE SEGMENT.
* 
*     WHEN EACH SEGMENT IS BEING FORMED, 37 CHARACTERS ARE MOVED TO THE 
*     SHORT RECORD STAGING AREA.
*     A SCAN IS THEN INITIATED FROM THAT 37TH CHARACTER, SCANNING RIGHT 
*     TO LEFT, LOOKING FOR A BLANK CHARACTER THAT SEPARATES TWO WORDS.
*     PARTIAL WORDS ARE BLANKED OUT OF THE STAGED MESSAGE AND THE 
*     POINTER TO THE NEXT WORD FROM THE LARGE MESSAGE IS SET TO INCLUDE 
*     THAT WORD AS PART OF THE NEXT MESSAGE SEGMENT.
*     TO AVOID ABORTING THE USER UNTIL THE ENTIRE MESSAGE HAS BEEN SENT,
*     THE UCPA PARAMETER IS SET TO ZERO FOR EACH SFCALL EXCEPT THE FINAL
*     ONE.
* 
*     THE ABOVE PROCESS IS REPEATED UNTIL THE ENTIRE MESSAGE HAS BEEN 
*     SENT TO USERS DAYFILE.
* 
* 
*     NOTE -
* 
*     DB$ERSF IS ONLY USED FOR CDCS.
*     IN CDCSBTF DB$ERSF BECOMES DB$SFCL. 
 #
  
# 
*     LOCAL VARIABLES 
# 
      ITEM CP;               # CHARACTER POINTER                       #
      ITEM XA;               # INDUCTION VARIABLE                      #
      ITEM XB;               # INDUCTION VARIABLE                      #
  
      BASED ARRAY LMA;       # LONG MESSAGE ARRAY                      #
        BEGIN 
        ITEM LMSG C(00,00,120);  # LONG MESSAGE                        #
        END 
  
      DEF DFLSPA #09#;       # LENGTH OF SAVED PARAMETERS ARRAY        #
  
      BASED ARRAY SPA;       # SAVED PARAMETERS ARRAY                  #
        BEGIN 
        ITEM SFP   I(00,00,60);  # SAVE FUNCTION PARAMETER             #
        ITEM SLG   I(01,00,60);  # SAVE LENGTH OF LONG MESSAGE         #
        ITEM SSCPA I(02,00,60);  # SAVE SYSTEM CONTROL POINT ADDRESS   #
        ITEM SUCPA I(03,00,60);  # SAVE USER CONTROL POINT ADDRESS     #
        ITEM SMLB  I(04,00,12);  # SHORT MESSAGE LEADING BLANKS        #
        ITEM SMSG  C(04,00,40);  # SHORT MESSAGE                       #
        ITEM SMTZ  I(07,48,12);  # SHORT MESSAGE TRAILING ZEROES       #
        ITEM NEXT  I(08,00,60);  # NEXT CHARACTER IN LONG MESSAGE ARRAY#
        END 
  
  
  
#     B E G I N   D B $ E R S F   E X E C U T A B L E   C O D E .      #
  
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("ERSF");           # GENERATE A FLOW POINT             #
      CONTROL ENDIF;
  
      DB$PUSH(DB$ERSF); 
# 
*     ALLOCATE A BUFFER FOR THE SHORT MESSAGE STAGING AREA. 
*     IT IS ALSO USED TO SAVE THE PARAMETERS. 
# 
      DB$MBA(DFLSPA,P<SPA>);
# 
*     SAVE PARAMETERS FOR RETENTION ACROSS THE INTERRUPTIBLE CALLS
*     TO DB$SFCL. 
# 
      SFP[0] = FP;
      SLG[0] = LG;
      SSCPA[0] = SCPA;
      SUCPA[0] = UCPA;
      NEXT[0] = 2;
  
      FOR XA = XA WHILE NEXT[0] LS LG 
      DO
        BEGIN 
        P<LMA> = SSCPA[0];         # SET LONG MESSAGE ARRAY POINTER    #
# 
*       FORMAT A SHORT MESSAGE TO BE SENT.
* 
*         IF (LG - NEXT) IS LESS THAN 37, BLANKS WILL BE PROVIDED TO
*         FILL OUT THE 37 CHARACTERS. 
* 
*         IF (LG - NEXT) IS GREATER THAN 37, ONLY 37 CHARACTERS ARE 
*         MOVED.
*         THE REMAINING CHARACTERS WILL BE LEFT FOR THE NEXT MESSAGE
*         SEGMENT.
# 
        C<2,37>SMSG[0] = C<NEXT[0],LG-NEXT[0]>LMSG[0];
  
        SMLB[0] = O"5555";         # INSERT LEADING BLANKS             #
# 
*       SCAN FOR A BLANK CHARACTER WHERE THE MESSAGE CAN BE SPLIT.
# 
        FOR XB = 38 STEP -1 UNTIL 0 
        DO
          BEGIN 
          IF C<XB,1>SMSG EQ " " 
          THEN
            BEGIN 
            CP = XB -1; 
            XB = 0; 
            END 
          C<XB,1>SMSG = " ";       # BLANK OUT PARTIAL WORDS AT END    #
          END 
        SMTZ[0] = 0;               # INSERT TRAILING ZEROES            #
        NEXT[0] = NEXT[0] + CP;    # POINT TO NEXT MESSAGE SEGMENT.    #
# 
*       USE ZERO FOR UCPA ON ALL BUT THE LAST SFCALL. 
*       THIS AVOIDS ABORTING THE UCP UNTIL THE WHOLE MESSAGE HAS BEEN 
*       SENT. 
# 
        IF NEXT[0] LS LG
        THEN
          BEGIN 
          UCPA = 0; 
  
          CONTROL IFGR DFFLOP,0;
            DB$FLOP("ERSF-LM");    # FLOW POINT FOR A LONG MESSAGE     #
          CONTROL ENDIF;
  
          END 
# 
*       ISSUE THE SF.REGR FUNCTION. 
# 
        DB$SFCL(FC,FP,UCPA,LOC(SMSG[0])); 
# 
*       RESTORE THE PARAMETER VALUES. 
# 
        FP = SFP[0];
        LG = SLG[0];
        UCPA = SUCPA[0];
        END 
  
      DB$MBF(P<SPA>); 
      DB$POP(DB$ERSF);
  
      RETURN; 
      END 
      TERM
