NOTE
          IDENT  NOTE,FET 
          ABS 
          SST 
          SYSCOM B1 
  
          ENTRY  BLOCK
          ENTRY  ENTER
          ENTRY  NOTE 
          ENTRY  RFL= 
  
*COMMENT  NOTE - ENTER DELIMITED LINES INTO FILE. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          TITLE  NOTE - ENTER DELIMITED LINES INTO FILE.
          SPACE  4
***       NOTE - ENTER DELIMITED LINES INTO FILE. 
*         J.C.BOHNHOFF. 75/05/04. 
*         W.F.ANSLEY.   77/02/03. 
*         R.K.MYERS.    84/01/04. 
          SPACE  4
***              NOTE TAKES DELIMITED LINES FROM THE CALL COMMAND 
*         AND WRITES THEM INDIVIDUALLY TO A FILE. THIS FILE MAY BE USED 
*         AS A PROCEDURE. 
 NOTE     SPACE  4,45 
***       THE COMMAND - 
* 
*         BLOCK(LFN,P1,P2)/BLINE 1/BLINE 2/BLINE N
*                OR 
*         ENTER./COMMAND 1/COMMAND 2/COMMAND N
*                OR 
*         NOTE(LFN,NR)/LINE 1/LINE 2/LINE N 
* 
*         ASSUMED PARAMETERS. 
*         LFN = *OUTPUT*. 
*         NR OMITTED = AUTOMATIC REWIND BEFORE AND AFTER (*NOTE*).
*         P1 OMITTED = NO REWIND BEFORE (*BLOCK*).
* 
*         WHERE  ) MAY BE PERIOD OR RIGHT PARENTHESIS.
*                LFN IS A FILE NAME TO RECEIVE THE LINES.  IF ABSENT, 
*                  *OUTPUT* IS ASSUMED. 
*                NR CAN EITHER BE *NR* OR *R*, DENOTING WHETHER THE 
*                  FILE SHOULD BE REWOUND BEFORE AND AFTER PROCESSING.
*                P1 CAN EITHER BE *R* OR *NR*, DENOTING WHETHER 
*                  THE FILE SHOULD BE REWOUND BEFORE PROCESSING.
*                P2 CAN BE ANY USER SPECIFIED CARRIAGE CONTROL
*                  CHARACTER (ONLY THE FIRST CHARACTER IS USED), BUT
*                  NO VALIDITY CHECKING IS PERFORMED.  LITERALS ($-$) 
*                  OR THE WORD *SPACE* WILL ALSO BE ACCEPTED. 
*                / MAY BE ANY CHARACTER TO DELIMIT THE INDIVIDUAL 
*                  COMMANDS.  IT MUST IMMEDIATELY FOLLOW THE PERIOD 
*                  OR RIGHT PARENTHESIS.  A RIGHT BLANK WILL BE 
*                  GENERATED FOR EACH OCCURRENCE OF CONSECUTIVE 
*                  DELIMITERS.
*                COMMAND I IS ANY VALID COMMAND.  A 
*                  PERIOD IS APPENDED TO ANY COMMAND THAT DOES NOT
*                  ALREADY HAVE A TERMINATOR (A *.* OR A *)*).
*                LINE I IS ANY TEXT.  IT IS TREATED THE SAME AS A 
*                  COMMAND EXCEPT THAT A BLANK IS APPENDED TO 
*                  EACH LINE INSTEAD OF A PERIOD. 
*                BLINE I IS ANY TEXT STRING OF UP TO 9
*                  CHARACTERS IN LENGTH, WHICH IS TO BE PRINTED 
*                  IN EXPANDED FORMAT TO FILE LFN.  THERE ARE 
*                  SPECIAL TEXT STRINGS FOR WHICH CURRENT DATA
*                  ABOUT THE JOB WILL BE SUBSTITUTED.  THESE ARE -
* 
*                    STRING       SUBSTITUTED DATA
*                    ------       ----------- ----
*                     DATE         CURRENT DATE 
*                     JSN          JOB SEQUENCE NAME
*                     TIME         CURRENT TIME 
*                     UJN          USER JOB NAME
*                     USER         USER NAME
* 
* 
*         *ENTER* WRITES THE COMMANDS TO AN INTERNAL FILE 
*         *ZZZZZG0* AND THEN EXECUTES A *ZZZZZG0.* COMMAND
*         TO PROCESS THE COMMANDS.
* 
*         FOR EXAMPLE - 
*                ENTER./LDSET(LIB=ULIB)/LOAD(A)/LOAD(LGO)/NOGO. 
*         RESULTS IN -
*                LDSET(LIB=ULIB)
*                LOAD(A)
*                LOAD(LGO)
*                NOGO.
* 
*         *NOTE* WRITES THE LINES TO A FILE.
* 
*         FOR EXAMPLE - 
*                NOTE(MESSAGE)/ CANT GET THE FILE 
*         RESULTS IN FILE MESSAGE CONTAINING -
*                 CANT GET THE FILE 
          SPACE  4
***       DAYFILE MESSAGES ISSUED.
* 
*         * TOO MANY PARAMETERS.* 
*                MORE THAN TWO PARAMETERS  WERE SPECIFIED ON THE CALL 
*                COMMAND. 
* 
*         * NO TERMINATOR IN COMMAND CALL.* 
*                NO TERMINATOR WAS FOUND BEFORE THE LEADING DELIMITER 
*                OF THE CALL COMMAND. 
* 
*         * INCORRECT -NR- PARAMETER.*
*                A PARAMETER OTHER THAN *NR*, *R* OR NULL WAS PASSED
*                TO *NOTE* AS THE SECOND PARAMETER. 
* 
*         * INCORRECT -R/NR- PARAMETER.*
*                A PARAMETER OTHER THAN *R*, *NR* OR NULL WAS PASSED
*                TO *BLOCK* AS THE SECOND PARAMETER.
          TITLE SYMBOLS AND DATA. 
*         COMMON DECKS. 
  
  
*CALL COMCMAC 
*CALL     COMSQAC 
          SPACE  4
*         SYMBOL DEFINITIONS. 
  
  
 PBUFL    EQU    3           *QAC*/*PEEK* BUFFER LENGTH 
 SBUFL    EQU    3001B       SCRATCH/OUTPUT BUFFER LENGTH 
          SPACE  4
*         FET.
  
  
          ORG    110B 
 FET      BSS    0
  
 S        BSS    0           SCRATCH
 ZZZZZG0  FILEB  SBUF,SBUFL 
          SPACE  4
*         DATA LOCATIONS. 
  
  
 BLKF     CON    0           *BLOCK* FLAG 
 CCCH     DATA   1L1         CARRIAGE CONTROL CHARACTER 
 DATE     CON    0           CURRENT DATE 
 JSNM     CON    0           JOB SEQUENCE NAME
 NLIP     CON    0           NUMBER OF LINES IN PAGE
 NR       CON    0           NO REWIND FLAG 
 TIME     CON    0           CURRENT TIME 
 UJNM     CON    0           USER JOB NAME
 USER     CON    0           USER NAME
 QACB     SPACE  4,10 
*         *QAC* PARAMETER BLOCK.
  
 QACB     VFD    50/0,9/PKFC,1/0 REQUEST PREFIX PORTION 
          VFD    36/0,6/11,18/PBUF
          VFD    42/0,18/PBUF 
          VFD    42/0,18/PBUF 
          VFD    42/0,18/PBUF+PBUFL 
 QBSC     VFD    60/0        SELECTION CRITERIA PORTION 
          VFD    60/0 
          VFD    60/100B
          VFD    12/2B,48/0 
          VFD    60/0 
          VFD    60/0 
          VFD    60/0 
 QBPF     VFD    60/-0       PEEK FUNCTION PORTION
          VFD    12/-0,48/0 
          VFD    48/0,12/UJPB+JSPB  JSN AND USER JOBNAME
          VFD    60/0 
  
  
*         *QAC*/*PEEK* BUFFER.
  
 PBUF     BSSZ   PBUFL
          TITLE  COMMAND PROCESSORS.
 BLOCK    SPACE  4,10 
**        BLOCK - WRITE BLOCK LETTERS TO FILE.
  
  
 BLOCK    BSS    0           ENTRY
          SB1    1
          SX6    B1+
          SA6    BLKF        SET *BLOCK* FLAG 
          RJ     ICP         INITIALIZE COMMAND PARAMETERS
          ZR     B6,BLO0     IF NO PARAMETERS 
          RJ     POP         READ FILE NAME PARAMETER 
          NZ     X6,BLO1     IF PARAMETER PRESENT 
 BLO0     SA1    =0LOUTPUT   SET DEFAULT FILE NAME
          BX6    X1 
 BLO1     SX7    B1          SET STATUS 
          BX6    X7+X6
          SA6    S           SET FILE NAME
          ZR     B6,BLO3     IF NO MORE PARAMETERS
          RJ     POP         READ *R/NR* PARAMETER
          ZR     X6,BLO2     IF NULL PARAMETER
          SX3    2RNR 
          SX2    1RR
          LX3    -12
          LX2    -6 
          BX3    X6-X3
          BX2    X6-X2       CHECK IF *R* 
          ZR     X3,BLO2     IF *NR* SPECIFIED
          NZ     X2,BLO4     IF NOT *R* 
          REWIND S,R
 BLO2     ZR     B6,BLO3     IF NO MORE PARAMETERS
          RJ     POP         READ CARRIAGE CONTROL PARAMETER
          ZR     X6,BLO3     IF NULL PARAMETER SPECIFIED
          MX1    6
          BX6    X6*X1       ISOLATE TO 1 CHARACTER 
          SA6    CCCH        SET USER SPECIFIED CARRIAGE CONTROL
 BLO3     GETPAGE  BLOA      GET PAGE SIZE PARAMETERS 
          SA1    BLOA 
          MX6    -8 
          LX1    -20
          BX6    -X6*X1      NUMBER OF LINES ON PAGE
          SA6    NLIP 
          WRITEW S,CCCH,1    WRITE CARRIAGE CONTROL CHARACTER 
          SX7    1R          SET TERMINATOR 
          RJ     WDL         WRITE DELIMITED LINES
          ENDRUN
  
*         PROCESS INCORRECT PARAMETERS. 
  
 BLO4     MESSAGE (=C* INCORRECT -R/NR- PARAMETER.*),,R 
          ABORT 
  
  
 BLOA     BSS    2           *GETPAGE* PARAMETER BLOCK
 ENTER    SPACE  4,10 
**        ENTER - PLACE COMMANDS FROM CALL COMMAND INTO 
*         FILE *ZZZZZG0*, AND THEN CALL FILE *ZZZZZG0*. 
  
  
 ENTER    BSS    0           ENTRY
          SB1    1
          RJ     ICP         INITIALIZE COMMAND PARAMETERS
          REWIND S,R         REWIND SCRATCH FILE
          WRITEW S,ENTA,ENTAL  WRITE PROCEDURE HEADER 
          SX7    1R.         SET TERMINATOR 
          RJ     WDL         WRITE DELIMITED LINES
          EXCST  (=C*ZZZZZG0.*)  ENTER CALL COMMAND 
  
 ENTA     DATA   C*.PROC,ZZZZZG0.*
          DATA   C*$RETURN,ZZZZZG0.*
 ENTAL    EQU    *-ENTA 
 NOTE     SPACE  4
**        NOTE - PLACE LINES FROM CALL COMMAND INTO SPECIFIED FILE. 
  
  
 NOTE     BSS    0           ENTRY
          SB1    1
          RJ     ICP         INITIALIZE COMMAND PARAMETERS
          ZR     B6,NOT1     IF NO PARAMETERS 
          RJ     POP         READ FILE NAME PARAMETER 
          NZ     X6,NOT2     IF FILE NAME PRESENT 
 NOT1     SA1    =0LOUTPUT   SET DEFAULT FILE NAME
          BX6    X1 
 NOT2     SA2    S           SET NAME 
          MX0    42 
          BX7    -X0*X2      FILE STATUS
          BX6    X6+X7
          SA6    A2 
          ZR     B6,NOT3     IF NO MORE PARAMETERS
          RJ     POP         READ *NR* PARAMETER
          NZ     B6,NOT6     IF TOO MANY PARAMETERS 
          ZR     X6,NOT3     IF NULL PARAMETER
          SX3    1RR
          SX2    2RNR 
          LX3    -6 
          LX2    -12
          BX3    X6-X3       CHECK IF *R* 
          BX2    X6-X2       CHECK IF *NR*
          ZR     X3,NOT3     IF *R* 
          NZ     X2,NOT7     IF NOT *NR*
          SX7    1R          SET TERMINATOR 
          SA7    NR          INDICATE NO REWIND IN EFFECT 
          EQ     NOT4 
* 
 NOT3     REWIND S,R
          SX7    1R 
 NOT4     RJ     WDL         WRITE DELIMITED LINES
          SA1    NR 
          NZ     X1,NOT5     IF NO REWIND SELECTED
          REWIND S
 NOT5     ENDRUN
  
*         PROCESS TOO MANY PARAMETERS.
  
 NOT6     MESSAGE (=C* TOO MANY PARAMETERS.*),,R
          ABORT 
  
*         PROCESS INCORRECT PARAMETERS
  
 NOT7     MESSAGE (=C* INCORRECT -NR- PARAMETER.*),,R 
          ABORT 
          TITLE  SUBROUTINES. 
 CNW      SPACE  4,10 
**        CNW - CENTER NAME IN WORD.
* 
*         ENTRY  (X1) = NAME (LEFT JUSTIFIED, ZERO FILLED). 
* 
*         EXIT   (X6) = CENTERED NAME.
* 
*         USES   X - 1, 7.
*                B - 2. 
* 
*         CALLS  SFN. 
  
  
 CNW      SUBR               ENTRY/EXIT 
          RJ     SFN         SPACE FILL NAME
          ZR     X7,CNWX     IF 10-CHARACTER NAME 
          CX7    X7          NUMBER OF BITS IN NAME 
          SX1    6
          IX7    X7/X1       NUMBER OF CHARACTERS IN NAME 
          SX1    10          NUMBER OF CHARACTERS IN WORD 
          IX7    X1-X7
          AX7    1           NUMBER OF CHARACTERS TO RIGHT SHIFT
          LX7    1
          SB2    X7 
          LX7    1
          SB2    X7+B2       NUMBER OF BITS TO RIGHT SHIFT
          SB2    B2-60
          AX6    B2          CENTER NAME (CIRCULAR LEFT SHIFT)
          EQ     CNWX        RETURN 
 CSP      SPACE  4,15 
**        CSP - CHECK FOR SUBSTITUTIBLE PARAMETERS. 
* 
*         ENTRY  (B6) = FWA OF DELIMITED STRING TO TEST.
*                (B7) = COUNT OF CHARACTERS IN STRING.
* 
*         EXIT   (X4) = PACKED WORD TO BE PRINTED.
* 
*         USES   X - 1, 2, 3, 4, 5, 6.
*                A - 1, 2, 4, 6.
*                B - 2, 3, 4, 5.
* 
*         CALLS  CNW, GJS.
* 
*         MACROS CLOCK, DATE, SYSTEM, USERNUM.
  
  
 CSP      SUBR               ENTRY/EXIT 
          SB4    B6 
          SB5    60 
          BX1    X1-X1
          SB2    10          MAXIMUM CHARACTERS 
          SB3    B7-2 
          LT     B3,B2,CSP1  IF CORRECT NUMBER OF CHARACTERS
          SB3    9           RESET CHARACTER COUNT
 CSP1     SA2    B4          GET NEXT CHARACTER 
          LX1    6
          BX1    X1+X2       PACK CHARACTER 
          SB4    B4+B1
          SB5    B5-6        DECREMENT SHIFT COUNT
          SB3    B3-B1       DECREMENT CHARACTER COUNT
          PL     B3,CSP1     IF MORE CHARACTERS 
          LX1    B5          LEFT JUSTIFY STRING
          SA2    CSPA 
          MX3    42 
 CSP2     BX6    X3*X2       CHECK FOR SUBSTITUTIBLE PARAMETER
          BX6    X1-X6
          ZR     X6,CSP3     IF SUBSTITUTIBLE PARAMETER FOUND 
          SA2    A2+B1
          NZ     X2,CSP2     IF NOT AT END OF MATCH TABLE 
  
*         SPECIFIED STRING NOT FOUND IN TABLE.
  
          RJ     CNW         CENTER STRING ON LINE
          BX4    X6 
          EQ     CSPX        RETURN 
  
*         CALL SUBSTITUTION PROCESSOR.
  
 CSP3     SB2    X2          GET PROCESSOR ADDRESS
          JP     B2          PROCESS SUBSTITUTION 
  
*         GET CURRENT DATE. 
  
 CSP4     SA4    DATE 
          NZ     X4,CSPX     IF DATE ALREADY AVAILABLE
          DATE   DATE 
          SA1    DATE 
          SX6    1R &1R.     CHANGE LAST CHARACTER TO SPACE 
          BX6    X1-X6
          SA6    A1 
          EQ     CSP4        RETURN DATE
  
*         GET CURRENT TIME. 
  
 CSP5     SA4    TIME 
          NZ     X4,CSPX     IF TIME ALREADY AVAILABLE
          CLOCK  TIME 
          SA1    TIME 
          SX6    1R &1R.     CHANGE LAST CHARACTER TO SPACE 
          BX6    X1-X6
          SA6    A1 
          EQ     CSP5        RETURN TIME
  
*         GET USER NAME.
  
 CSP6     SA4    USER 
          NZ     X4,CSPX     IF USER NAME ALREADY AVAILABLE 
          USERNUM  USER 
          SA1    USER 
          RJ     CNW         CENTER USER NAME IN WORD 
          SA6    A1 
          EQ     CSP6        RETURN USER NAME 
  
*         GET JSN.
  
 CSP7     SA4    JSNM 
          NZ     X4,CSPX     IF JSN ALREADY AVAILABLE 
          RJ     GJS         GET JSN
          EQ     CSP7        RETURN JSN 
  
*         GET UJN.
  
 CSP9     SA4    UJNM 
          NZ     X4,CSPX     IF UJN ALREADY AVAILABLE 
          SA1    JSNM 
          NZ     X1,CSP10    IF JSN ALREADY AVAILABLE 
          RJ     GJS         GET JSN FOR *QAC* CALL 
 CSP10    SYSTEM QAC,R,QACB  CALL *QAC* FOR UJN 
          SA1    PBUF+1 
          MX3    42 
          BX1    X3*X1       ISOLATE UJN
          RJ     CNW         CENTER UJN IN WORD 
          SA6    UJNM 
          EQ     CSP9        RETURN UJN 
  
  
 CSPA     BSS    0           TABLE OF SUBSTITUTION PROCESSORS 
          VFD    42/0LDATE,18/CSP4
          VFD    42/0LTIME,18/CSP5
          VFD    42/0LUSER,18/CSP6
          VFD    42/0LJSN,18/CSP7 
          VFD    42/0LUJN,18/CSP9 
          CON    0
 EXP      SPACE  4,20 
**        EXP - EXPAND CHARACTERS.
* 
*         EXPAND EACH CHARACTER OF A TEN CHARACTER STRING INTO A
*         PATTERN OF CHARACTERS IN A 10X10 MATRIX, AND WRITE THE
*         EXPANSION ONTO FILE *S*.  CERTAIN SPECIAL STRINGS WILL
*         HAVE VALUES SUBSTITUTED BEFORE EXPANSION (SEE *CSP*). 
*         A PAGE EJECT WILL BE WRITTEN IF THE PAGE IS FULL. 
* 
*         ENTRY  (B6) = FWA OF DELIMITED STRING TO EXPAND.
*                (B7) = COUNT OF CHARACTERS IN STRING.
* 
*         EXIT   EXPANDED BLOCK LETTERS WRITTEN TO FILE.
* 
*         USES   X - 1, 2, 3, 4, 5, 6.
*                A - 1, 2, 6. 
* 
*         CALLS  BAN, CSP.
* 
*         MACROS WRITEW.
  
  
 EXP      SUBR               ENTRY/EXIT 
          RJ     CSP         CHECK FOR SUBSTITUTIBLE PARAMETERS 
          SA2    LBUF        EXPAND LINE TO *LBUF*
          RJ     BAN
          SX5    A2-LBUF     LENGTH OF BUFFER 
          SA1    EXPA        UPDATE LINE COUNT
          SX6    X1+/COMCBAN/LNCH+2 
          SA2    NLIP 
          SA6    A1 
          ZR     X1,EXP2     IF TOP OF FIRST PAGE 
          IX2    X2-X6
          PL     X2,EXP1     IF ROOM ON CURRENT PAGE
          SX6    /COMCBAN/LNCH+2  RESET LINE COUNT FOR NEW PAGE 
          SA6    A1 
          WRITEW S,(=2L1 ),1 ISSUE PAGE EJECT 
          EQ     EXP2        WRITE EXPANDED LINE TO FILE
  
 EXP1     WRITEW S,(=2L0 ),1 ISSUE DOUBLE SPACE 
 EXP2     WRITEW S,LBUF,X5   WRITE EXPANDED LINE TO FILE
          EQ     EXPX        RETURN 
  
  
 EXPA     CON    0           NUMBER OF LINES ALREADY ON CURRENT PAGE
 ICP      SPACE  4,15 
**        ICP - INITIALIZE COMMAND PARAMETERS.
* 
*         ICP INITIALIZES THE COMMAND STRING BUFFER FOR SUBSEQUENT
*         EXTRACTION OF PARAMETERS VIA *POP*. 
* 
*         EXIT   (B6) .EQ. 0 IF TERMINATOR ENCOUNTERED. 
*                     .NE. 0 = INDEX TO NEXT CHARACTER IN BUFFER. 
*                (USCB) = EXPANDED COMMAND, 1 CHARACTER PER WORD. 
* 
*         USES   X - 1. 
*                A - 1. 
*                B - 2, 6.
* 
*         CALLS  POP, USB.
  
  
 ICP2     RJ     POP         SKIP PAST COMMAND NAME 
  
 ICP      SUBR               ENTRY/EXIT 
          SB2    CCDR        COMMAND
          RJ     USB         UNPACK DATA BLOCK TO STRING BUFFER 
 ICP1     SA1    B6+         SKIP PREFIX $, /, SPACE
          SX1    X1-1R9-1 
          NG     X1,ICP2     IF ALPHANUMERIC CHARACTER
          SB6    B6+1 
          EQ     ICP1        CHECK NEXT CHARACTER 
 GJS      SPACE  4,15 
**        GJS - GET JOB SEQUENCE NAME.
* 
*         EXIT   (QBSC+2) SET WITH JSN FOR *QAC* CALL.
*                (JSNM) = CENTERED JSN. 
* 
*         USES   X - 1, 6.
*                A - 1, 6.
* 
*         CALLS  CNW. 
* 
*         MACROS GETJN. 
  
  
 GJS      SUBR               ENTRY/EXIT 
          GETJN  QBSC+2      GET JSN
          SA1    QBSC+2      SET JSN FOR POSSIBLE *QAC* CALL
          SX6    100B        SET JSN FLAG 
          BX6    X1+X6
          SA6    A1 
          RJ     CNW         CENTER JSN 
          SA6    JSNM        SET CENTERED JSN 
          EQ     GJSX        RETURN 
 WDL      SPACE  4,20 
**        WDL - WRITE DELIMITED LINES.
* 
*         ENTRY  (X7) = TERMINATOR TO BE APPENDED TO EACH LINE. 
*                (S) SET WITH PROPER FILE NAME. 
* 
*         EXIT   FILE WRITTEN WITH EOR. 
* 
*         USES   X - ALL. 
*                A - 0, 1, 2, 5, 6, 7.
*                B - 2, 5, 6, 7.
* 
*         CALLS  EXP. 
* 
*         MACROS ABORT, MESSAGE, WRITER, WRITES, WRITEW.
  
  
 WDL      SUBR               ENTRY/EXIT 
          SA7    WDLA        SAVE TERMINATOR
          SA2    USBC        LWA OF COMMAND IN STRING BUFFER
          MX6    -1          ASSURE STRING TERMINATION
          SA0    B0          CLEAR LINE COUNT 
  
*         REMOVE TRAILING BLANKS FROM COMMAND.
  
 WDL0.1   SA1    X2+
          SX2    X2-1 
          SX1    X1-1R
          ZR     X1,WDL0.1   IF BLANK CHARACTER 
  
*         FIND BEGINNING OF LINES TO BE WRITTEN.
  
          SA5    USBB        FIND DELIMITER 
          SA6    X2+2 
          SA6    X2+3 
 WDL1     NG     X5,WDL11    IF NO TERMINATION
          SX6    X5-1R. 
          SX7    X5-1R) 
          SA5    A5+1 
          ZR     X6,WDL2     IF TERMINATOR
          NZ     X7,WDL1     IF NOT TERMINATOR
 WDL2     BX0    X5          DELIMITER
          SA5    A5+B1       FIRST CHARACTER OF FIRST LINE
          BX6    X0 
          SB6    A5          SET FWA OF LINE
          SA6    WDLB        SAVE DELIMITER 
          SB5    B0          INITIALIZE LINE TERMINATOR FLAG
  
*         WRITE DELIMITED LINES.
  
 WDL3     NG     X5,WDL8     IF END OF STRING 
          BX6    X5-X0       CHECK DELIMITER
          SX4    X5-1R. 
          SX3    X5-1R) 
          ZR     X4,WDL4     IF TERMINATOR
          NZ     X3,WDL5     IF NOT TERMINATOR
 WDL4     SB5    1           INDICATE TERMINATOR IN THIS LINE 
 WDL5     SA5    A5+1 
          NZ     X6,WDL3     IF NOT DELIMITER 
          SA1    WDLA        TERMINATE LINE 
          SB7    A5          WRITE LINE 
          BX7    X1 
          SB7    B7-B6       LENGTH OF LINE 
          SA7    A5-B1
          SA1    BLKF 
          NZ     X1,WDL7     IF *BLOCK* CALL
          ZR     B5,WDL6     IF LINE TERMINATOR NOT FOUND 
          SB7    B7-1        DO NOT ADD TERMINATOR
 WDL6     WRITES S,B6,B7
          SB6    A5          SET FWA OF LINE
          SB5    B0          INITIALIZE LINE TERMINATOR FLAG
          EQ     WDL3        LOOP TO STRING TERMINATOR
  
 WDL7     RJ     EXP         EXPAND CHARACTERS
          SA5    A5          RESTORE (X5) 
          SA2    WDLB        RESTORE DELIMITER
          SB6    A5          SET FWA OF LINE
          BX0    X2 
          EQ     WDL3        LOOP TO STRING TERMINATOR
  
*         WRITE LAST LINE.
  
 WDL8     SB7    A5+B1       WRITE LAST LINE
          SA1    WDLA        TERMINATE LINE 
          SB7    B7-B6       LENGTH OF LINE 
          BX7    X1 
          SA7    A5 
          SA1    BLKF 
          NZ     X1,WDL10    IF *BLOCK* CALL
          ZR     B5,WDL9     IF LINE TERMINATOR NOT FOUND 
          SB7    B7-1        DO NOT ADD LINE TERMINATOR 
 WDL9     WRITES S,B6,B7
          WRITER S,R         END FILE 
          EQ     WDLX        RETURN 
  
 WDL10    RJ     EXP         EXPAND CHARACTERS
          WRITEW S,(=2L0 ),1 ISSUE DOUBLE SPACE 
          WRITER S,R         END FILE 
          EQ     WDLX        RETURN 
  
 WDL11    MESSAGE (=C* NO TERMINATOR IN COMMAND CALL.*) 
          ABORT 
  
 WDLA     CON    0           HOLDS LINE TERMINATOR
 WDLB     CON    0           STRING DELIMITER 
          SPACE  4
*         COMMON DECKS. 
  
  
          LIST   X
 SMCH$    EQU    1           ENCODE SMALL CHARACTERS
*CALL     COMCBAN 
          LIST   *
*CALL COMCCIO 
*CALL     COMCCPM 
*CALL     COMCSFN 
*CALL COMCSYS 
*CALL COMCUSB 
 LIT      EQ     1           ALLOW LITERAL PARAMETERS 
*CALL COMCPOP 
*CALL COMCWTS 
*CALL COMCWTW 
          LIST   X
*CALL     COMTBAN 
          LIST   *
          SPACE  4
          USE    BUFFER 
          SPACE  4
*         BUFFER. 
  
  
 SBUF     EQU    *           SCRATCH BUFFER 
 LBUF     EQU    SBUF+SBUFL  LINE BUFFER
 RFL=     EQU    LBUF+134D
  
  
          END 
