Retro1.org codex

          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