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