REDO
          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 
