*DECK DB$LINE 
      PROC DB$LINE(MESSAGE,LENGTH); 
      BEGIN 
 #
* *   DB$LINE                                    PAGE 1 
* *   C O GIMBER                                 2/5/76 
* 
* DC  PURPOSE 
* 
*     PRINT LINE TO OUTPUT LISTING. 
* 
* DC  ENTRY CONDITIONS
* 
*     PARAMETERS
# 
      ITEM MESSAGE C(130);   #LINE MESSAGE TO BE PRINTED# 
      ITEM LENGTH;           #LENGTH OF MESSAGE TO BE PRINTED#
# 
*     SPECIAL VALUES FOR THE LENGTH PARAMETER --
*        LESS THAN ZERO,  FLUSH THE OUTPUT BUFFER.
*        LESS THAN OR EQUAL TO ZERO,  START A NEW PAGE ON THE NEXT CALL.
* 
* DC  CALLED ROUTINES 
# 
      XREF FUNC CLOCK C(10); #SYSTEM CLOCK ROUTINE# 
      XREF FUNC DATE C(10);  #SYSTEM DATE ROUTINE#
      XREF FUNC DB$CDEB C(10);  # BINARY TO DECIMAL WITH BLANK FILL    #
      XREF PROC DB$WRTR;     # WRITER MACRO                            #
      XREF PROC DB$WRTZ;     # WRITE Z TYPE RECORD                     #
# 
* DC  NON-LOCAL VARIABLES 
# 
      XREF ARRAY DB$OFET;;   # CDCS OUTPUT FILE FET                    #
# 
 #
  
# 
*     LOCAL DECLARATIONS
# 
  
      $BEGIN
      BASED ARRAY LINARY;          # ARRAY FOR ACCESSING MESSAGE LINE  #
        BEGIN 
        ITEM LINBYTE U(00,48,12);  # LINE TERMINATION BYTE             #
        END 
      $END
  
      ITEM INDEX; 
      ITEM LINECOUNT = 150; 
      ITEM PAGE=0;
  
      XDEF ITEM DB$LINH C(130) =
                              "1    ** CDCS LISTING **
       CURRENT DATE YY/MM/DD.      LIST INITIATED YY/MM/DD. HH.MM.DD. 
  PAGE 00000 "; 
  
      DEF DFLINLIM #056#;    # PAGE LENGTH (LESS ONE) ALSO SEE DB$LINB #
  
  
  
#     B E G I N   D B $ L I N E   E X E C U T A B L E   C O D E .      #
  
 #
* 
* DC  DESCRIPTION 
* 
*     IF FIRST CALL THEN
*         PUT DATE AND TIME INTO HEADER.
 #
      IF PAGE EQ 0 THEN 
        BEGIN 
        C<90,10>DB$LINH = DATE(INDEX);
        C<100,10>DB$LINH = CLOCK(INDEX);
        END 
 #
*     IF LENGTH PARAMETER IS EQUAL TO ZERO, SET LINECOUNT TO FORCE A
*     NEW PAGE ON THE NEXT CALL.
*       IF IT IS LESS THAN ZERO, FORCE THE NEW PAGE AND FLUSH THE 
*       OUTPUT BUFFER.  DONT OUTPUT ANY LINE IN EITHER CASE.
 #
      IF LENGTH LQ 0
      THEN
        BEGIN 
        LINECOUNT = 150;
        IF LENGTH LS 0
        THEN
          BEGIN 
          DB$WRTR(DB$OFET); 
          END 
        RETURN; 
  
        END 
 #
*     IF AT END OF PAGE, SKIP TO NEXT PAGE AND OUTPUT HEADER. 
 #
      IF LINECOUNT GR DFLINLIM+1
        OR (C<0>MESSAGE EQ "0"
        AND LINECOUNT GR DFLINLIM-2)
      THEN
        BEGIN 
        LINECOUNT = 0;
        PAGE = PAGE+1;
        C<120,5>DB$LINH = DB$CDEB(PAGE,5);
        C<60,10>DB$LINH = DATE(INDEX);
  
        DB$WRTZ(DB$OFET,DB$LINH,130);        # WRITE PAGE HEADER       #
        DB$WRTZ(DB$OFET,"0",1); 
        END 
  
      $BEGIN
      P<LINARY> = LOC(MESSAGE);              # POSITION TO MESSAGE     #
      FOR INDEX = (LENGTH / 10) - 1 STEP -1  # FOR EACH WHOLE WORD     #
      UNTIL 0                                # UNTIL NONE LEFT         #
      DO
        BEGIN 
        IF LINBYTE[INDEX] EQ O"0000"  # IF AN EARLY ZERO BYTE TRMINATOR#
        THEN
          BEGIN 
          LINBYTE[INDEX] = O"5500";  # THWART THE EARLY TERMINATOR     #
          END 
        END 
      $END
  
 #
*     OUTPUT MESSAGE AND INCREMENT LINE COUNTER.
 #
      DB$WRTZ(DB$OFET,MESSAGE,LENGTH);
      LINECOUNT = LINECOUNT+1;
      IF C<0>MESSAGE EQ "0" THEN
        LINECOUNT = LINECOUNT+1;
      END 
      TERM; 
