Retro1.org codex

          IDENT  REDO,FWA
          ABS
          SST
          ENTRY  REDO
          ENTRY  R
          ENTRY  ARG=
          ENTRY  RFL=
          ENTRY  SDM=
          SYSCOM B1
          TITLE  REDO - REENTER PREVIOUS COMMAND.
*COMMENT  REDO - REENTER PREVIOUS COMMAND.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          SPACE  4,10
***       REDO - REENTER PREVIOUS COMMAND.
*
*         R. R. RAGAN        82/12/01.
          SPACE  4,10
***       *REDO* ALLOWS A PREVIOUSLY ENTERED COMMAND TO BE MODIFIED
*         AND REEXECUTED WITHOUT RETYPING THE ENTIRE COMMAND.
*
*         FOR COMPATIBILITY WITH A PREVIOUS VERSION OF *REDO* RELEASED
*         IN BINARY AT NOS 2.2, *R* IS ALSO AN ENTRY POINT.  ONLY
*         *REDO* IS DOCUMENTED IN THE MANUALS.  *R* MAY THEREFORE
*         BE REMOVED IF IT CONFLICTS WITH LOCAL CODE.
          SPACE  4,10
**        COMMAND FORMAT.
*
*         REDO.
*
*         REDO,STRING.
*
*         CALLING *REDO* WITH NO PARAMETERS WILL CAUSE IT TO DISPLAY
*         THE PREVIOUS COMMAND AND PROVIDE A MODIFICATION LINE WHERE
*         CHANGES TO THE COMMAND CAN BE MADE. WHEN A CARRIAGE RETURN
*         IS ENTERED THE POSSIBLY MODIFIED COMMAND IS EXECUTED.
*
*         FOR EXAMPLE, IF THE LAST COMMAND WAS - MODIFY,Z./*EDIT,CIO
*         AND YOU WANTED TO EDIT LFM INSTEAD -
*
*                REDO
*                OLD:  MODIFY,Z./*EDIT,CIO
*                MOD:                  LFM
*                NEW:  MODIFY,Z./*EDIT,LFM
*
*         THE *OLD* LINE IS OUTPUT BY *REDO* AND YOU ARE PROMPTED
*         WITH THE *MOD* LINE. MODIFICATIONS ARE ENTERED MUCH AS IN
*         THE MODIFY COMMAND OF *XEDIT*. THE *NEW* LINE ECHOS THE
*         COMMAND THAT IS ABOUT TO BE EXECUTED.
*
*         MODIFICATION IS DONE BY VISUAL ALIGNMENT OF THE *OLD* AND
*         THE *MOD* LINES. THE MODIFICATION COMMAND CHARACTERS ARE:
*
*         SPACE - RETAINS THE CHARACTER FROM *OLD*.
*         # (NUM. SIGN) - DELETES THE CHARACTER FROM *OLD*.
*         & (AMPERSAND) - CHANGES THE *OLD* CHARACTER TO A SPACE.
*         ^ (CIRCUMFLEX) - INSERTS FOLLOWING CHARACTERS BEFORE THE
*                 *OLD* CHARACTER ABOVE THE  THE^. INSERTED TEXT IS
*                 TERMINATED BY A # OR BY CARRIAGE RETURN.
*                 IF A CARAT IS ENTERED FOLLOWED BY END OF LINE
*                 THE LINE WILL BE REDISPLAYED AS SO FAR
*                 MODIFIED AND FURTHER MODS WILL BE ALLOWED.
*         ! (EXCLAMATION) - DELETES THE REST OF THE TEXT OF *OLD*.
*         OTHER - REPLACES THE CHARACTER FROM *OLD*.
*
*         IF *REDO* IS CALLED WITH A PARAMETER, A PREVIOUS COMMAND
*         THAT BEGINS WITH THE SAME CHARACTERS AS THE PARAMETER
*         IS FOUND AND BECOMES THE COMMAND TO BE REENTERED.  NOTE THAT
*         COMMAS, PARANTHESES, ETC. ARE CONSIDERED TO BE PART OF THE
*         STRING, BUT THAT LEADING BLANKS ARE NOT.  IF THE PARAMETER
*         BEGINS WITH LEADING ASTERISKS(*) OR BLANKS, THE COMMAND
*         BEING LOCATED MAY HAVE AN ARBITRARY NUMBER OF LEADING
*         BLANKS.  *REDO* DOES NOT PROCESS ANY PARAMETERS ITSELF.
*         THE FIRST 10 CHARACTERS OF THE PARAMETER OR UP TO A BLANK
*         END OF COMMAND INPUT ARE USED FOR THE PARAMETER.
*         THUS COMMANDS SUCH AS THE FOLLOWING WILL WORK -
*
*                REDO,FTN,I=A
*                REDO,GTR,OPL.AB
*                REDO, COPY,TAPE
*                REDO/GO.
*                REDO./GO.
*
*         IF THE *REDO* COMMAND IS SUFFIXED WITH */GO*, THE *OLD*,
*         *MOD* AND *NEW* MESSAGES WILL BE SUPPRESSED. THIS IS USEFUL
*         FOR SLOW BAUD RATE TERMINALS.
*
*         IF THE *REDO* COMMAND IS USED IN A NON-INTERACTIVE JOB, THE
*         */GO* OPTION IS FORCED ON.
          SPACE  4,10
*         COMMON DECKS.
 
*CALL     COMCMAC
*CALL     COMSIOQ
*CALL     COMSSFM
          TITLE  DEFINITIONS.
*         ASSEMBLY CONSTANTS.
 
 BUFL     EQU    401B        DAYFILE BUFFER LENGTH
 IBUFL    EQU    101B        INPUT BUFFER LENGTH
 OBUFL    EQU    101B        OUTPUT BUFFER LENGTH
 USBFL    EQU    81          UNPACKED STRING BUFFER LENGTH
          SPACE  4,10
*         FETS.
 
          ORG    105B
 FWA      BSS    0
 
 I        BSS    0           DAYFILE BUFFER
 ZZZZZDD  FILEB  IBUF,BUFL,FET=7
 
 O        BSS    0           OUTPUT BUFFER
 OUTPUT   FILEB  OBUF,OBUFL,FET=7
 
 T        BSS    0           TERMINAL INPUT BUFFER
 INPUT    FILEB  TBUF,IBUFL,FET=7
          SPACE  4,10
*         BUFFERS AND WORKING STORAGE.
 
 RPVBLK   VFD    36/0,12/25,2/0,9/1,1/0  *REPRIEVE* PARAMETER BLOCK
          VFD    30/0,12/0,18/RED9
          CON    0
          VFD    24/200B,36/0
 DSTR     BSS    USBFL       MODIFICATION COMMANDS
 ELEN     CON    0           *ELEN* MUST PRECEDE *ESTR*
 USBB     BSS    0
 ESTR     BSS    USBFL       UNPACKED STRING BUFFER
 ESCR     BSS    USBFL
 TIME     BSS    1           TIME PART OF DAYFILE LINE
 LINE     BSS    9
 DLINE    BSS    10          DISPLAY VERSION OF LINE
 ULT      CON    77770000000000000000B
          BSS    8
 MLINE    VFD    36/6LMOD:  ,12/0013B,12/0
 ZERO     CON    0
 GOFLAG   CON    0           NONZERO IF */GO* OPTION OR NON-INTERACTIVE
 LBFLAG   CON    0           NONZERO IF LEADING BLANKS OK ON COMMAND
 WDCT     CON    0           WORD COUNT IN CM BUFFER
 TIOPTR   VFD    42/6LOUTPUT,18/O  OUTPUT FET POINTER
 ARGV     CON    0           ARGUMENT VALUE
 ARGM     CON    0           ARGUMENT MASK
          TITLE  MAIN PROGRAM.
          SPACE  4,10
**        REDO - MAIN PROGRAM.
 
 
 R        BSS    0
 REDO     RJ     PRS         PRESET
 
*         GET THE JOB DAYFILE AND POSITION TO EOI FOR BACK SCAN.
 
          CSET   NORMAL
          DAYFILE I,USER
          READW  I,CBUF,BUFL  SAVE LAST PART OF DAYFILE
          SX6    B6
          SA6    WDCT        SAVE IN POINTER FOR CBUF
          REWIND I,R
          READ   I
          MX0    -12
 
*         SEARCH FOR LINE MATCHING THE ARGUMENT.
 
 RED1     READC  I,TIME      READ A DAYFILE LINE
 RED2     NZ     X1,RED10    IF END OF INPUT
          RJ     CCL         CHECK COMMAND LINE
          SA3    LINE
          SA4    ARGV
          SA5    ARGM
          SA2    LBFLAG
          BX6    X3-X4
          BX6    X5*X6
          ZR     B5,RED3     IF NO LEADING BLANKS
          ZR     X5,RED1     IF NO SEARCH ARGUMENT - NOT A COMMAND
          ZR     X2,RED1     IF LEADING BLANKS NOT ACCEPTABLE
 RED3     NZ     X6,RED1     IF NOT DESIRED LINE
 
*         SAVE THE LINE FOUND AND CONTINUE.
 
          SB5    B0+
 RED4     SA2    LINE+B5
          BX6    X2
          SA6    ULT+B5      MOVE LINE TO ULTIMATE
          BX3    -X0*X2
          SB5    B5+B1
          NZ     X3,RED4     IF NOT END OF LINE
          EQ     RED1        CONTINUE READING TO EOI
 
*         DISPLAY THE ORIGINAL LINE AND GET THE MODS.
 
 RED5     SA3    ULT
          SA0    A3
          MX4    12
          IX3    X3-X4
          ZR     X3,RED8     IF NOT FOUND
          SA2    REDA
          RJ     WOC         WRITE OUT COMMAND
 RED7     SA2    GOFLAG
          NZ     X2,RED7.1   IF *GO* SPECIFIED
          PROMPT OFF
 RED7.1   RJ     RMC         READ MODIFIED COMMAND
 
*         DISPLAY MODIFIED COMMAND AND EXECUTE IT.
 
          SA0    LINE
          SA2    REDB
          RJ     WOC         WRITE OUT COMMAND
          SB6    X0+2
          ZR     B6,RED7.1   IF REMOD SPECIFIED
          SA2    GOFLAG
          NZ     X2,RED7.3   IF *GO* SPECIFIED
          WRITER O
 RED7.3   RETURN I
          CSET   RESTORE
          EXCST  LINE
 
*         COMMAND STRING CANNOT BE FOUND.
 
 RED8     MESSAGE CCDR,3     ISSUE COMMAND AND ERROR MESSAGE TO DAYFILE
          MESSAGE (=C*COMMAND NOT FOUND.*),3
 RED9     RETURN I
          CSET   RESTORE
          ABORT              ABORT
 
*         HANDLE LINE BROKEN ACROSS DISK/MEMORY.
 
 RED10    SA2    I+1         FIRST
          SB4    X2+
          SB5    CBUF
          EQ     B4,B5,RED5  IF REAL EOI
          SX7    B5
          MX5    -18
          BX3    X5*X2
          IX6    X3+X7       SET FIRST TO *CBUF*
          SA6    A2
          SA2    WDCT
          BX6    X2
          SA6    A6+B1       SET IN
          SA7    A6+B1       SET OUT TO *CBUF*
          SA2    A7+B1       LIMIT
          BX3    X5*X2
          SX7    CBUF+BUFL
          IX6    X3+X7
          SA6    A2          SET LIMIT
          READC  I,B6        READ REST OF LINE
          EQ     RED2        CONTINUE ON BROKEN RECORD
 
 REDA     VFD    36/6LOLD:  ,24/0
 REDB     VFD    36/6LNEW:  ,24/0
          TITLE  SUBROUTINES.
 ACT      SPACE  4,15
**        ACT - ADD COMMAND TERMINATOR.
*
*         *ACT* ADDS A PERIOD TO THE END OF THE MODIFIED COMMAND IF
*         THERE IS NO PERIOD OR RIGHT PARENTHESIS ALREADY IN THE
*         COMMAND OUTSIDE OF LITERALS.
*
*         ENTRY  (B6) = STRING BUFFER ADDRESS.
*
*         EXIT   (B6) = STRING BUFFER ADDRESS, LEADING BLANKS REMOVED.
*
*         USES   X - 1, 2, 6, 7.
*                A - 1, 6, 7.
*                B - 6.
 
 
 ACT      SUBR               ENTRY/EXIT
          SX6    B0
          SX7    B0
          SA1    B6+
 ACT1     NG     X1,ACT5     IF END OF COMMAND
          ZR     X7,ACT3     IF CHECKING LEADING BLANKS
          SX2    X1-1R$
          ZR     X2,ACT2     IF A LITERAL DELIMITER
          NZ     X6,ACT4     IF INSIDE A LITERAL
          SX2    X1-1R.
          ZR     X2,ACTX     IF TERMINATOR IN COMMAND
          SX2    X1-1R)
          NZ     X2,ACT4     IF NOT TERMINATOR
          EQ     ACTX        RETURN
 
 ACT2     BX6    X6-X7       TOGGLE LITERAL FLAG
          SA1    A1+B1
          EQ     ACT1        CONTINUE
 
 ACT3     SX2    X1-1R
          ZR     X2,ACT4     IF BLANK
          SB6    A1+
          SX7    B1+
 ACT4     SA1    A1+1
          EQ     ACT1        CONTINUE
 
 ACT5     SX6    1R.
          MX7    2
          SA6    A1
          SA7    A1+1
          EQ     ACTX        RETURN
 CCL      SPACE  4,15
**        CCL -  CHECK COMMAND LINE.
*
*         *CCL* CHECKS TO SEE IF THE LINE FOUND SEEMS TO BE A COMMAND.
*         COMMAND CRITERIA - 1)  FIRST NON-BLANK MUST BE ALPHANUMERIC,
*                                $ OR /.
*                            2)  AT LEAST ONE BUT NO MORE THAN SEVEN
*                                ALPHANUMERIC CHARACTERS MUST OCCUR
*                                BEFORE THE FIRST SEPARATOR/TERMINATOR.
*                            3)  A LITERAL DELIMITER ($) MAY NOT OCCUR
*                                BEFORE THE FIRST SEPARATOR/TERMINATOR.
*                            4)  THE LINE MUST HAVE A TERMINATOR WHICH
*                                IS NOT ENCLOSED WITHIN A LITERAL.
*         IF LEADING BLANKS ARE FOUND, THEY ARE REMOVED.
*
*         ENTRY  (X0) = 7777 7777 7777 7777 0000B.
*                (LINE) = LINE TO BE EXAMINED.
*
*         EXIT   (B5) = NUMBER OF LEADING BLANKS.
*                (B5) = -1 IF LINE DOES NOT MEET COMMAND CRITERIA.
*
*         USES   X - 2, 3, 4, 5, 6, 7.
*                A - 2, 6.
*                B - 2, 3, 5, 6, 7.
*
*         CALLS  PSB, USB.
 
 
 CCL11    ZR     B5,CCLX     IF NO LEADING BLANKS
          SB2    LINE
          SB3    B0+         SELECT NORMAL MODE
          SB6    USBFL       LENGTH OF UNPACK BUFFER
          RJ     USB         UNPACK TO STRING BUFFER
          MX6    59
          SA6    B7+B1       ADD END OF LINE TERMINATOR
          SB6    USBB+B5
          SB7    LINE
          RJ     PSB         PACK STRING BUFFER
 
 CCL      SUBR               ENTRY/EXIT
          SA2    LINE
          SB2    B1+
          SB3    B0+
          SB5    B0
          MX7    -6
 
*         SEARCH LINE FOR LEADING BLANKS AND START OF COMMAND.
 
 CCL1     SB6    B0
          SB7    60
          BX5    -X0*X2      EXTRACT END OF LINE FOR TEST
 CCL2     LX2    6
          BX3    -X7*X2
          SX4    X3-1R
          NZ     X4,CCL4     IF NOT A BLANK
          SB5    B5+B2       INCREMENT COUNT OF LEADING BLANKS
 CCL3     SB6    B6+6
          NE     B6,B7,CCL2  IF WORD NOT ALL SCANNED
          ZR     X5,CCLX     IF END OF LINE
          SA2    A2+1        NEXT WORD OF LINE
          EQ     CCL1        CONTINUE
 
 CCL4     SX4    X3-1R9-1
          NG     X4,CCL9     IF ALPHANUMERIC
          ZR     B2,CCL5     IF SEPARATOR AFTER $ OR /
          SB2    B0+
          SX4    X3-1R$
          ZR     X4,CCL3     IF DOLLAR SYMBOL
          SX4    X3-1R/
          ZR     X4,CCL3     IF SLASH
 CCL5     SB5    -1          INDICATE NOT A COMMAND
          EQ     CCLX        RETURN WITH ERROR
 
 CCL6     SB6    B0
          SB7    60
          BX5    -X0*X2      EXTRACT END OF LINE FOR TEST
 CCL7     LX2    6
          BX3    -X7*X2
          SX4    X3-1R$
          NZ     X4,CCL8     IF NOT A LITERAL DELIMITER
          SX4    B3-8
          NG     X4,CCL5     IF LITERAL BEFORE FIRST SEPARATOR
          SB2    B2-1
          ZR     B2,CCL10    IF END OF LITERAL
          SB2    B1+         INDICATE START OF LITERAL
 CCL8     NZ     B2,CCL10    IF WITHIN A LITERAL
          SX4    X3-1R9-1
          NG     X4,CCL9     IF ALPHANUMERIC
          SX4    X3-1R
          ZR     X4,CCL10    IF BLANK (IGNORE)
          SX4    X3-1R.
          ZR     X4,CCL11    IF TERMINATOR FOUND
          SX4    X3-1R)
          ZR     X4,CCL11    IF TERMINATOR FOUND
          SB3    8           INDICATE PAST COMMAND NAME
 CCL9     SB3    B3+1        COUNT COMMAND CHARACTER
          SX3    B3-8
          SB2    B0+         CLEAR LITERAL FLAG
          ZR     X3,CCL5     IF TOO MANY CHARACTERS
 CCL10    SB6    B6+6
          NE     B6,B7,CCL7  IF WORD NOT ALL SCANNED
          ZR     X5,CCL5     IF END OF LINE (NO TERMINATOR)
          SA2    A2+1        NEXT WORD OF LINE
          EQ     CCL6        CONTINUE
 MDY      SPACE  4,15
**        MDY - PROCESS MODIFY DIRECTIVES.
*
*         ENTRY  (ESTR) = ORIGINAL LINE (UNPACKED).
*                (DSTR) = DIRECTIVES LINE (UNPACKED).
*
*         EXIT   (X0) = -1, IF TRUNCATION ENCOUNTERED.
*                (X0) = -2, IF REMODIFICATION SPECIFIED
*                (ESTR) = NEW TEXT LINE.
*
*         USES   X, 0, 1, 2, 6, 7.
*                A - 1, 2, 6.
*                B - 2, 3, 4, 5, 6.
*
*         CALLS  TSL.
 
 
 MDY5     SX6    1R          SET BLANK CHARACTER
 MDY6     GT     B3,B4,MDY1  IF AT END OF BUFFER
          SA6    B3
          SB3    B3+B1       SET TO NEXT PLACE TO SAVE
 MDY7     SA2    A2+B2       GET NEXT *ESTR* CHARACTER
          PL     X2,MDY8     IF NOT AT END OF LINE
          SX6    1R
          SB2    B0          SET TO NOT ESCAPE END OF LINE
          BX2    X2+X6       GET END LINE (WITH BLANK)
 MDY8     SA1    A1+B1       GET NEXT DIRECTIVES CHARACTER
          SX6    X2          MOVE CURRENT TEXT CHARACTER
          SX7    X1-1R
          ZR     X7,MDY11    IF SPACE DIRECTIVE
          NG     X1,MDY17    IF END OF DIRECTIVE LINE
          SX7    X1-1R#
          ZR     X7,MDY7     IF SHARP (DELETE TEXT CHARACTER)
          SX7    X1-1R!
          ZR     X7,MDY10    IF ! (TRUNCATE TEXT CHARACTER)
          SX7    X1-1R&
          ZR     X7,MDY5     IF AMPERSAND (SET TEXT TO BLANK)
          BX6    X1
          SB6    X1+B5       B5 = -UP ARROW
          NZ     B6,MDY6     IF CHARACTER (REPLACE TEXT)
 MDY9     SA1    A1+B1       GET NEXT DIRECTIVES
          SX3    X1-1R#
          BX6    X1
          SX7    B6+B1       SET NUMBER OF CHARACTERS SCANNED
          NG     X1,MDY12    IF END OF DIRECTIVES
          SB6    B6+B1       INCREMENT COUNT OF CHARACTERS SCANNED
          ZR     X3,MDY13    IF SHARP
          GT     B3,B4,MDY2  IF PAST 80 CHARACTERS
          SA6    B3
          SB3    B3+B1
          EQ     MDY9        LOOP
 
 MDY10    SX2    -B1         FLAG EARLY END OF *ESTR*
          EQ     MDY17       COPY REST OF TEXT
 
 MDY11    PL     X2,MDY6     IF MORE IN *ESTR*
          SX6    1R          PRETEND A SPACE IN *ESTR*
          EQ     MDY6        CHECK IF END OF BUFFER
 
 MDY12    NZ     B6,MDY16    IF SOMETHING WAS AFTER THE UPARROW
          SB2    -2          SET REMODIFICATION FLAG
          EQ     MDY17       COPY REST OF TEXT
 
 MDY13    SX7    B6+B1
          NE     B6,B1,MDY16 IF NOT (UP ARROW)(SHARP)
          SX7    B1          RESET COPY COUNTER
 MDY14    GT     B3,B4,MDY4  IF POSSIBLE TRUNCATION
          SA6    B3
          SB3    B3+B1
 MDY15    SA2    A2+B2       GET NEXT *ESTR* CHARACTER
          PL     X2,MDY16    IF NOT END OF LINE
          SB2    B0
          SX6    1R
          MX2    2           SET END OF LINE
          BX2    X2+X6
 MDY16    SX6    X2+
          SX7    X7-1
          PL     X7,MDY14    IF MORE TO MOVE
          PL     X1,MDY8     IF MORE DIRECTIVES
 
*         END OF DIRECTIVES, COPY REST OF TEXT.
 
 MDY17    NG     X2,MDY20    IF END OF TEXT
          GT     B3,B4,MDY3  IF END OF BUFFER
          SX6    X2+
          SA6    B3+
 MDY18    SA2    A2+B1       GET NEXT TEXT
          SB3    B3+B1
          EQ     MDY17       CONTINUE COPY
 
*         SET TRUNCATION FLAG AND CLEANUP.
 
 MDY19    SB2    -1
 
*         SET END OF LINE AND COPY BACK TO *ESTR*.
 
 MDY20    MX6    2
          SA6    B3+
          SB6    ESTR
          SA1    ESCR
 MDY21    BX6    X1
          SB6    B6+B1
          SA1    A1+B1
          SA6    B6-B1
          PL     X6,MDY21    IF NOT FINISHED
          SB6    ESTR-1      SET LINE WIDTH CELL
          SX0    B2+         MOVE TRUNCATION FLAG
          RJ     TSL         TRIM ANY TRAILING SPACES
 
 MDY      SUBR               ENTRY/EXIT
          SB5    -1R^
          SB2    B1+         SET NOT AT END OF TEXT LINE
          SB3    ESCR        SET NEXT SAVE CHARACTER ADDRESS
          SB4    ESCR+80     SET LWA
          SA1    DSTR-1
          SA2    ESTR-1
          EQ     MDY7        BEGIN LOOP
 
*         HANDLE SPECIAL CASES OF FULL BUFFER, ADDING CHARACTERS.
 
 MDY1     SX7    X6-1R
          ZR     X7,MDY7     IF SPACE (NO TRUNCATION)
          EQ     MDY19       TRUNCATE
 
 MDY2     SX7    X6-1R
          ZR     X7,MDY9     IF SPACE (NO TRUNCATION)
          EQ     MDY19       TRUNCATE
 
 MDY3     SX7    X6-1R
          ZR     X7,MDY17    IF SPACE (NO TRUNCATION)
          EQ     MDY19       TRUNCATE
 
 MDY4     SX7    X6-1R
          ZR     X7,MDY15    IF SPACE (NO TRUNCATION)
          EQ     MDY19       TRUNCATE
 PSB      SPACE  4,10
**        PSB - PACK STRING BUFFER.
*
*         ENTRY  (B6) = INCOMING STRING ADDRESS.
*                (B7) = OUTGOING STRING ADDRESS.
*
*         EXIT   STRING IS CONVERTED.
*
*         USES   X - 1, 2, 6, 7.
*                A - 1, 6.
*                B - 4, 6, 7.
 
 
 PSB      SUBR               ENTRY/EXIT
          SB4    6           SHIFT VALUE
          BX6    X6-X6       CLEAR ASSEMBLY
          MX7    1           POSITION INDICATOR
          SX1    B0+         INITIALIZE FOR POSSIBLE BLANK LINE
          EQ     PSB2        BEGIN CONVERSION
 
 PSB1     LX7    6           SHIFT POSITION
          BX6    X6+X1       MERGE CHARACTERS
          PL     X7,PSB2     IF NOT FULL WORD
          SA6    B7
          SB7    B7+B1
          BX6    X6-X6       CLEAR ASSEMBLY
 PSB2     BX2    X1
          SA1    B6          GET NEXT CHARACTER
          NG     X1,PSB4     IF END OF BUFFER REACHED
 PSB3     LX6    6
          SB6    B6+B1
          EQ     PSB1        CONTINUE
 
 PSB4     SB6    B6-B1       RESET CHARACTER POINTER
          SA1    =40004000400040004000B
          SA6    B7
          BX2    X1*X7
          NZ     X2,PSB5     IF ON BYTE BOUNDRY
          SX1    1R
          EQ     PSB3        BLANK FILL TO BYTE BOUNDARY
 
 PSB5     NG     X7,PSBX     IF WORD IS FULL, RETURN
 PSB6     LX7    12
          LX6    12
          PL     X7,PSB6     IF NOT LEFT JUSTIFIED
          SA6    B7
          ZR     X6,PSBX     IF ASSURE A ZERO WORD, RETURN
          BX6    X6-X6
          SA6    A6+B1
          EQ     PSBX        RETURN
 RMC      SPACE  4,15
**        RMC - READ MODIFIED COMMAND.
*
*         ENTRY  (A0) = COMMAND LINE TO BE REENTERED.
*
*         EXIT   (LINE) = MODIFIED COMMAND.
*
*         USES   X - 2.
*                A - 0, 2.
*                B - 2, 6, 7.
*
*         CALLS - ACT, MDY, PSB, USB.
*
*         MACROS READ, READS, WRITEC.
 
 
 RMC      SUBR               ENTRY/EXIT
          SB6    DSTR
          SA2    GOFLAG
          NZ     X2,RMC1     IF */GO* SPECIFIED
          WRITEC O,MLINE     *MOD:  *
          READ   T
          READS  T,DSTR,80
 RMC1     MX6    2
          SA6    B6          SET END OF LINE
 
*         UNPACK THE ORIGINAL LINE.
 
          SB2    A0
          SB3    B0          SELECT NORMAL MODE
          SB6    USBFL       LENGTH OF UNPACK BUFFER
          RJ     USB         UNPACK TO STRING BUFFER
          MX6    59
          SA6    B7+B1       ADD END OF LINE TERMINATOR
          RJ     MDY         MODIFY ORIGINAL DATA
          SB6    USBB
          RJ     ACT         ADD COMMAND TERMINATOR
          SB7    LINE
          RJ     PSB         PACK STRING BUFFER
          EQ     RMCX        RETURN
 TSL      SPACE  4,15
**        TSL - TRIM SPACES OFF LINE (STRING BUFFER).
*
*         ENTRY  (A6) = FWA OF END OF LINE CHARACTER.
*                (X6) = MASK OF 2.
*
*         EXIT   LINE TRIMMED.
*                (ESTR-1) = NEW LINE LENGTH.
*
*         USES   X - 1, 6.
*                A - 1, 6.
*                B - 2.
 
 
 TSL      SUBR               ENTRY/EXIT
          SB2    A6
 TSL1     SB2    B2-B1       POSITION BACK TO NEXT CHARACTER
          LE     B2,B6,TSL2  IF AT START OF LINE - 1
          SA1    B2
          SX1    X1-1R
          ZR     X1,TSL1     IF CHARACTER WAS A BLANK
 TSL2     SA6    B2+B1       PUT NEW END CHARACTER
          SX6    B2-B6       GET NEW LENGTH
          SA6    B6+         SET NEW LENGTH
          EQ     TSLX        RETURN
 WOC      SPACE  4,10
**        WOC - WRITE OUT COMMAND.
*
*         ENTRY  (A0) = COMMAND WITH ZERO BYTE ON END.
*                (X2) = 6LXXXXXX PREFIX MESSAGE.
*
*         USES   X - 1, 2, 3, 4, 5, 6, 7.
*                A - 1, 3, 6.
*                B - 6.
*
*         MACROS  WRITEC.
 
 
 WOC      SUBR               ENTRY/EXIT
          SA1    GOFLAG
          NZ     X1,WOCX     IF */GO* SPECIFIED DO N0T DISPLAY
          SB6    B0
          SA3    A0
          MX7    36
 WOC1     MX4    -12
          BX5    -X4*X3      EXTRACT END OF LINE INDICATOR
          LX3    24
          BX4    -X7*X3
          BX6    X4+X2
          SA6    DLINE+B6
          SB6    B6+B1
          BX2    X7*X3
          SA3    A3+B1       NEXT WORD FROM LINE
          NZ     X5,WOC1     IF NOT END OF LINE
          BX6    X2
          SA6    DLINE+B6
          WRITEC O,DLINE     OUTPUT COMMAND LINE
          EQ     WOCX        RETURN
          SPACE  4,10
*         COMMON DECKS.
 
*CALL     COMCCIO
*CALL     COMCRDC
*CALL     COMCRDS
*CALL     COMCRDW
*CALL     COMCSFM
*CALL     COMCSYS
 USBL$    EQU    1           SELECT EXTERNAL UNPACK BUFFER
*CALL     COMCUSB
*CALL     COMCWTC
*CALL     COMCWTW
          SPACE  4,10
*         BUFFERS.
 
          USE    BUFFERS     FLUSH LITERALS
 TBUF     EQU    *           TERMINAL INPUT BUFER
 IBUF     EQU    TBUF+IBUFL  DAYFILE BUFFER
 OBUF     EQU    IBUF+BUFL   OUTPUT BUFFER
 CBUF     EQU    OBUF+OBUFL  SAVED TAIL OF DAYFILE
          TITLE  PRESET.
**        PRS - GET PARAMETER VALUE.
*
*         ENTRY  (CCDR)-(CCDR+7) = *REDO* COMMAND.
*
*         EXIT   (ARGV) = ARGUMENT VALUE.
*                (ARGM) = ARGUMENT MASK.
 
 
 PRS      SUBR               ENTRY/EXIT
          SB1    1
          SB2    CCDR        AREA TO UNPACK
          SB6    USBFL       LENGTH OF UNPACK BUFFER
          SB3    0           SELECT *NORMAL* CHARACTER SET
          RJ     USB         UNPACK TO STRING BUFFER
          MX6    59
          SA6    B7+B1       MARK END OF TEXT
          SA2    B7+
          SX1    X2-1R.
          NZ     X1,PRS1     IF NOT A TERMINATOR
          SA2    A2-B1       BACK UP ONE
 PRS1     SA1    A2-B1
          LX1    6
          IX2    X1+X2
          SX2    X2-2RGO
          NZ     X2,PRS2     IF CANNOT BE */GO*
          SA1    A1-B1
          SX2    X1-1R/
          NZ     X2,PRS2     IF NOT */GO*
          SA6    A1+         CHOP OFF */GO*
          SA6    GOFLAG      MARK *GO* SELECTED
 PRS2     SB6    USBB
          BX6    X6-X6
          MX7    0
          SB5    B0+
          SB3    54
          SB2    6
 PRS3     SA1    B6
          NG     X1,PRS8     IF NO PARAMETERS
          SX2    X1-1R.
          ZR     X2,PRS8     IF NO PARAMETERS
          SX2    X1-1R,
          ZR     X2,PRS4     IF START OF PARAMETER
          SX2    X1-1R(
          ZR     X2,PRS4     IF START OF PARAMETER
          SB6    B6+B1
          EQ     PRS3        CONTINUE
 
 PRS4     SB6    B6+B1
          SA1    B6
          NG     X1,PRS7     IF REAL END OF COMMAND
          SX2    X1-1R.
          ZR     X2,PRS6     IF POSSIBLE TERMINATOR
          SX2    X1-1R
          ZR     X2,PRS4.1   IF A BLANK
          SX2    X1-1R*
          NZ     X2,PRS5     IF NOT AN ASTERISK
 PRS4.1   NZ     B5,PRS5     IF NOT LEADING
          SX7    1           MARK LEADING BLANKS ACCEPTABLE
          SA7    LBFLAG
          EQ     PRS4        CONTINUE, IGNORING ASTERISK OR BLANK
 
 PRS5     LX1    X1,B3
          BX6    X6+X1       COLLECT NEXT CHARACTER OF PARAMETER
          SB5    B5+B2
          SB3    B3-B2       DECREMENT SHIFT POSITION BY 6
          NG     B3,PRS7     IF TEN CHARACTERS COLLECTED
          EQ     PRS4        CONTIINUE
 
 PRS6     SA3    B6+B1
          NG     X3,PRS7     IF REAL TERMINATOR
          ZR     X3,PRS7     IF REAL TERMINATOR
          SX3    X3-1R
          NZ     X3,PRS5     IF FOLLOWED BY NON-BLANK, GO ON
 
*         GET ARGUMENT AND BUILD ARGUMENT MASK.
 
 PRS7     SB4    B5-1
          MX7    1
          AX7    X7,B4
 PRS8     SA7    ARGM        SET UP ARGUMENT MASK
          SA6    ARGV        SAVE ARGUMENT VALUE
          SA2    TIOPTR
          BX6    X2
          MX7    0
          SA6    ARGR        SET UP RA+2 FILES LIST
          SA7    A6+1
          SYSTEM RPV,R,RPVBLK,1
 
*         REPLACE *MLINE*, *OLD*, AND *NEW*.
 
          SX2    00B
          SA1    CSMR
          NG     X1,PRS9     IF 64 CHARACTER SET
          SX2    63B
          LX2    36
 PRS9     MX7    -6
          LX7    36
          SA1    MLINE       CLEAR *MLINE*
          BX6    X7*X1
          BX6    X6+X2
          SA6    A1
          SA1    REDA        CLEAR *OLD*
          BX6    X7*X1
          BX6    X6+X2
          SA6    A1
          SA1    REDB        CEAR *NEW*
          BX6    X7*X1
          BX6    X6+X2
          SA6    A1
          SA2    JOPR        CHECK ORGIN TYPE
          MX0    -12
          LX2    -24
          BX3    -X0*X2
          SX6    X3-IAOT
          ZR     X6,PRSX     IF INTERACTIVE JOB
          SA6    GOFLAG      FORCE *GO* OPTION
          EQ     PRSX        RETURN
          SPACE  4,10
 LWA      EQU    *
 ARG=     EQU    *           DEFINE ARG= ENTRY POINT
 SDM=     EQU    *
 RFL=     EQU    CBUF+BUFL
          ERRNG  RFL=-LWA    PRESET EXCEEDS BUFFERS
          SPACE  4,10
          END