File: EDIT40.PA of Tape: OS8/OS8-V40/v40-3
(Source file text)
/OS/8 SYMBOLIC EDITOR, V40A
/
/
/
/
/
/
/
/
/
/
/
/
/COPYRIGHT (C) 1977 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
/ AND 1979 BY DATAPLAN GMBH
/
/
/
/
/
/
/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER
/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
/AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
/
/
/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
/EQUIPMRNT COROPATION.
/
/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
/
/
/
/
/
/
/5 JULY 1972 EF
/COPYRIGHT 1971,1972 DIGITAL EQUIPMENT CORPORATION
/ MAYNARD, MASSACHUSSETTS 01754
/THE SYMBOLIC EDITOR IS A LINE-ORIENTED
/TEXT EDITOR WITH CHARACTER AND STRING
/SEARCH CAPABILITIES. IT IS DESIGNED
/TO BE COMPATIBLE WITH THE OS/8 SYSTEM.
/THE DESIGN OF THE EDITOR IS SIMILAR
/TO THAT OF THE PAPER TAPE SYMBOLIC
/EDITOR AND THE DISK MONITOR SYSTEM
/EDITOR.
/ OS/8 V3 CHANGES S.R.
/1. ?5 ERROR REMOVED
/2. ALLOW CHAINING TO EDIT
/3. ADDED VERSION # COMMAND (#)
/4. COMBINED ^C ROUTINES, TAKING OUT BRANCH THRU 17667
/5. ALLOWED PARITY CHARACTERS EVERYWHERE
/
/
/ FIX FOR V10 J.K. 1975
/
/ THE CLOSE ERROR MESAGE 2? WAS BEING
/ GIVEN INSTEAD OF FILE FULL MESSAGE
/ WHEN THE INPUT FILE FIT INTO THE EDIT BUFFER
/ BUT WAS TOO LARGE FOR THE AVAILIBLE SPACE ON THE
/ OUTPUT DEVICE.
/ V11 CHANGES 25-MAY-77 DAVID SPECTOR
/1. ESCAPE KEY NO LONGER ECHOED
/2. SCOPE MODE SUPPORTED
/3. ONCE-ONLY CODE MOVED TO INPUT HANDLER
/ AREA IN ORDER TO FREE LOCS 3000-3177
/ V12 CHANGES 27-JUN-77 EDWARD P. STEINBERGER
/
/ALLOWED ESCAPE(233) TO BE AN INPUT CHARACTER IN TEXT MODE.
/ECHOS AS "$" ON TERMINAL OR LINEPRINTER (IF V), OUTPUT
/TO FILE AS ESCAPE
/ V 40 CHANGES 1-JUL-79 W.V.D.MARK
/
/1. DEC PATCH FOR TAB
/2. MULTI8 ADAPTED
/3. SETS ADAPTED
/4. LOWER CASE COMMANDS
/5. SYMBIONT
/6. # COMMAND IMMEDIATE
/7. UPARROW CNTRL'S
/8. XON/XOF FOR VT100
/9. TEXT ERROR MESSAGES
/10. BACKSPACE KEEPS TABS CORRECT
/11. ALL THIS IN SAME SPACE
GERMAN=1
/THE LOADING AND SAVING PROCEDURE FROM PAPER TAPE IS:
/ .R ABSLDR
/ *PTR:/9/P$
/ .SAVE SYS EDIT
/
/THE STARTING ADDRESS IS 00200.
/COMMAND DECODER RULES:
/*OUTPUT FILE<UP TO 9 INPUT FILES/OPTIONS
/OPTIONS:
/A RETURN CONTROL TO EDITOR AFTER FILE CLOSE
/ (CALLS COMMAND DECODER FOR NEW FILES)
/ (DEFAULT IS RETURN TO MONITOR)
/B CONVERT 2 OR MORE SPACES TO TAB ON INPUT
/D DELETE OLD COPY OF OUTPUT FILE BEFORE
/ STORING NEW FILE
/ERROR CODES:
/ 0 FAILURE IN INPUT DEVICE HANDLER
/ 1 FAILURE IN OUTPUT DEVICE HANDER
/ 2 COULD NOT CLOSE FILE
/ 3 COULD NOT OPEN FILE
/ 4 DEVICE HANDLER COULD NOT BE LOADED
DECIMAL
VERSION=40
PATCH="A /PATCH LEVEL A
OCTAL
/COMMANDS:
/A APPEND TEXT TO BUFFER
/I INSERT TEXT INTO BUFFER
/C CHANGE TEXT IN BUFFER
/L LIST TEXT IN BUFFER
/D DELETE TEXT IN BUFFER
/K KILL BUFFER
/M MOVE TEXT WITHIN BUFFER
/G GET AND LIST TAGGED LINE IN BUFFER
/B LIST # OF CORE LOCATIONS LEFT IN BUFFER
/S CHARACTER SEARCH
/J INTER-BUFFER STRING SEARCH
/F AFTER J, SEARCH FOR NEXT OCCURRANCE
/ OF SAME STRING
/$ INTRA-BUFFER STRING SEARCH
/R READ TEXT INTO BUFFER FROM INPUT DEVICE
/N WRITE BUFFER, KILL, AND READ NEXT PAGE
/Y INPUT TEXT PAGE, NO OUTPUT
/P WRITE TEXT BUFFER TO OUTPUT DEVICE
/T PUNCH TRAILER TAPE
/E OUTPUT BUFFER, TRANSFER REST OF
/ INPUT FILE TO OUTPUT FILE
/ CLOSE OUTPUT FILE
/Q IMMEDIATE END OF FILE
/V PRINT ON LP08
/# TYPE VERSION NUMBER
/ABBREVIATIONS
/.LT. LESS THAN
/.LE. LESS THAN OR EQUAL TO
/.GT. GREATER THAN
/.GE. GREATER THAN OR EQUAL TO
/ R RIGHT
/ L LEFT
/SPECIAL COMMENTS
/SINCE THE EDITOR IS CODED ACROSS PAGE BOUNDARIES, IT IS
/NECESSARY TO BE AWARE OF THE EFFECTS OF THE INSERTION
/OR DELETION OF CODE. FOR THIS REASON, THE LIMITS
/OF PERMISSABLE PAGE BOUNDARY WANDERING
/ARE INDICATED WITH THE FOLLOWING CONSTRUCTION:
/-----------------------------------------------------------------------
/SOMEWHERE BETWEEN LINES, THE PAGE BOUNDARY MUST OCCUR
/-----------------------------------------------------------------------
*0
LPT /*WM* FOR SETS
CIF 30
JMP 1 /SYMBIONT
SIGN, "# /V40
ZBLOCK 3 /FOR ODT
C77, 77
NONE, /V40
M41, NOP-CIA /=-41
C100, 100
C277, 277 /QUESTION MARK
/AUTO-INDEX REGISTERS
AXOUT, 0 /OUTPUT INDEX
AXCOMB, 0 /COMBINE POINTER
AXTEM, 0 /TEMPORARY INDEX
AXIN, 0 /STORAGE INDEX
/CONSTANTS
M4, -4 /LETTER COUNT
P177, 177
MCR, -215
M240, -240
P40, 40
C200, 200 /(START & RESTART)
BUFEND, 6100 /WARNING FOR END OF BUFFER
P7700, 7700 /MONITOR CALL LOCATION
M77, -77
/LISTS
/TAG SEARCH LIST-
LIST7=.
C240, 240 /SPACE
257 /COMMENT DELIMITER (/)
/OUTPUT LIST
LIST4=.
ESC, 233 /ESC-V12
CTAB, 211 /TAB
C215, 215 /CARRIAGE RETURN
212 /LINE FEED
214 /FORM FEED
377 /RUBOUT
207 / ^G BELL
210 / ^H BACKSPACE
M27, -27 /LIST DELIMITER
/SPECIAL CHARACTER LIST FOR
/INPUT IN TEXT MODE
LIST5=. /USED AT AONE
240 /SPACE
LIST6=. /USED AT SFOUND
CTU, 225 / ^U
C214, 214 /FORM FEED
BELL, 207 / ^G (BELL)
C212, 212 /LINE FEED
CRO, 377 /RUBOUT
LIST3=.
215 /LIST BRANCHER
000 /(SEARCH CHARACTER)
RST3I, RESET3 /RESET AND SAVE BUFFER
MCHIN1, -CHIN-1 /LIST DELIMITER
/CONSTANTS AND POINTERS
CCR=C215 /CARRIAGE RETURN
CLF=C212 /LINE FEED
MTABS, -10 /TAB COUNTER
DELT, DELP
CHI1, CHIN
IGNORE, CHIN+1
END, 200
KEYBD, I33
CCON, JMP I AXCOMB
COM1-1
UTR1, UTRA
FIN1, FIND
LIS1, LIST
LIS, LISTER
NINE, 12
NUMB, -272
OUT1, OUT
OUTL1=.
LOW, OUTL
CZ, NOP /CONTENTS OF START
ONUM, GTOP
SORTJ, SORTB
PACK1, PACBUF
SXS1, TAD CHAR /CONTENTS OF L3
SXS2, SLOOK&177+5200 /JMP SLOOK
L3I, L3 /PATCH POINTER
L2I, L2 /CONTINUE SEARCH - LETTERS
ENDLNI, ENDLN
SPCNO, MOR+4 /PACK
SPCGO, MOR+1 /SORT
/CHAR IS ALWAYS SET BY OUT, SOMETIMES BY SORTB;
/IT IS ALWAYS USED BY PACK AND SORTB.
CHAR, 0
MOV1=.
COUNTP, 0 /NUMBER OF PAGES
CNT=. /PRINT COUNTER
XCT, 0 /UNPACK SWITCH
XCTIN, 0 /PACK SWITCH
ECHOSW, 1 /NON-ZERO TO PRINT
SAVE, 0
TABIND, 0 /TABS OR SPACES SWITCH
TEMP, 0 /V3
THIS, 0 /LINE POINTER.
OUTDEV, OUTL /POINTER TO OUTPUT SUBROUTINE
GRBAGE, GARBAG /GARBAGE COLLECTOR
MARK, 0 /OBJECT LINE IN G.C.
XSAV, 0 /HOLD INPUT POINTER.
BUFR, 200
CFRS, FRST
KILL1, KILL+3
CHKARG, CHKARX
ERSW, ERROR /ERROR ROUTINE
L1I, L1
EKILLL, 0 /E CMD SWITCH 1 IF E NOT ALLOWED
/I-O RELATED POINTERS AND WORDS
P232, 232 /V3
BUFRDI, BUFRD /OR CHIN...IN DEVICE POINTER
BUFWTI, BUFWT /WRITE OUTPUT TO DEVICE
CLFLI, FLCLOS /SET TO CLOSE FILE
P37, 37 /V3
JMPCH, PUNCH&177+5200 /DESTROYED BY YANK
/ERROR ROUTINE POINTERS
PRERR, DEVERR
GTEM=. /NEXT 6-BITS OF UNPACK
DTEM=. /NEXT POINTER IN DELETE CHAIN
/ERROR ROUTINE
/REJECTS ILLEGAL COMMAND
/AND TYPES ?
ERROR=JMS .
0 /ALSO TEMP
ELIM, 7600 /GRP2-CLA
TAD C277
JMS I OUTL1 /PRINT "?"
CZONE, TAD CZ /RESET PATCHES
DCA I TE1
JMPTE1, JMP I TE1 /*RETURN TO COMMAND MODE*
MONITOR, MONIT /MONITOR EXIT ROUTINE
STRIND, 0
STRFIN, SFIND1
TE1, START
/VARIABLES
THSN, 0 /CURRENT LINE NUMBER
LSTN, 0 /LAST LINE NUMBER
TCNT, 0 /TAB COUNT
ADD, 0
ARG0, 0
ARG1, 0240
ARG2, -1
POTYPE, OTYPE
COMM5, COM5
K7600, 7600
TEMPO, 0
K1210, 1210
X203, -203
K1320, 1320
FRST, 0 /FIRST LINE ADDRESS
MOV2=TEMPO
LSTCHK, 0 /DIGIT ACCEPTED FLAG
*177
INIT /INITIALIZATION CODE
/EITHER 3000 OR VALUE OF RESET
*200
STA /V3 NORMAL START OR RESTART ADDR
DCA TEMP /V3 CHAIN START ADDR
JMP I 177 /START AT 3000 OR RESET
/HANDLER FOR ^U (IF IN COMMAND MODE)
START, NOP /V3 MAY BE MODIFIED
TAD LOW /ENTER COMMAND MODE
DCA OUTDEV /INITIALIZE KEYBOARD
DCA TABIND /CLEAR TAB INDICATOR
ISZ ECHOSW /SET UP FOR ECHO
DCA LIST3+1
TAD SXS1
DCA I L3I
TAD ERSW /RESET ERROR SWITCH AT L1
DCA I L1I
TAD CZONE
DCA I COMM5
DCA LSTCHK /CLEAR DIGIT ACCEPTED
TAD CCR /OUTPUT CARRIAGE RETURN
JMS I OUT1
/HANDLER FOR CARRIAGE RETURN (COMMAND MODE)
TAD SIGN /OUTPUT #
JMS I OUT1
GTOP, DCA ARG0 /CLEAR ARGUMENTS
DCA ARG2
/HANDLER FOR SPACE OR +
GEXP, TAD NONE
/HANDLER FOR -
GMIN, TAD CMPT
DCA G2 /SET SIGN TO + OR -
DBCV2, DCA TEMP
CMCHK, JMS I CHI1 /INPUT ONE CHARACTER
TAD NUMB
CLL
TAD NINE
SZL /WAS IT A DIGIT?
JMP COUNT /YES - CONTINUE ACCEPTING NUMBERS
GLOM, CLA /NO
TAD TEMP /GET ACCUMULATED NUMBER
G2, HLT /(NOP) OR (CIA) TO HANDLE SIGN
TAD ARG2
DCA ARG2 /STORE NEW ARGUMENT
JMS SORTB /WAS LAST CHARACTER SPECIAL?
LIST1-1 /YES - COMPARE TO LIST
OPS1-LIST1 /AND BRANCH TO HANDLER
TAD CHAR /NO - SAVE COMMAND CHARACTER
AND P337 /ACCEPT LOWER CASE IN 'SAVE'
DCA SAVE
JMS I CHI1 /INPUT ONE CHARACTER
JMS SORTB /IS IT CARRIAGE RETURN, ^C, OR ^U?
LIST1A-1 /YES - EXIT TO HANDLER
OPS1A-LIST1A
ERROR /NO - TRY AGAIN
P337, 337
/CHECK LEGALITY OF ARGUMENTS
/ARG0 CONTAINS FIRST ARGUMENT
/ARG2 CONTAINS SECOND ARGUMENT
RETRN, TAD ARG0
SNA /IS ARG0=0?
TAD ARG2 /YES - ARG0=ARG2
DCA ARG0 /NO
TAD ARG2
CMA
TAD ARG0
SMA /IS ARG0 .LE. ARG2?
ERROR /NO
DCA ARG1 /YES - ARG1=ARG0-ARG2-1
TAD ARG0
SPA CLA /IS ARG0 .GE. 0?
ERROR /NO
TAD SAVE /YES - GET COMMAND CHARACTER
JMS SORTB /IS IT A LEGAL COMMAND?
LIST2-1 /YES - MATCH TO LIST
OPS2-LIST2 /AND BRANCH TO ITS HANDLER
ERROR /NO - TRY AGAIN
/COMMAND IDENTIFICATION LIST
LIST2=. /COMMAND LETTERS
305 /E
301 /A
311 /I
303 /C
313 /K
304 /D
314 /L
316 /N
320 /P
322 /R
312 /J
306 /F
324 /T
315 /M
307 /G
323 /S
331 /Y
321 /Q
302 /B
326 /V
/DECIMAL ADDITION ROUTINE
/FOR NUMERIC ARGUMENTS OF COMMANDS
/ENTER WITH INPUT DIGIT IN SORTB
/EXIT WITH ACCUMULATED NUMBER IN AC
COUNT, DCA SORTB
ISZ LSTCHK /GOT A DIGIT NOW
TAD TEMP
RTL CLL /V40 ** IS END OF LIST2
TAD TEMP
RAL
TAD SORTB
JMP DBCV2 /RETURN TO MAIN SEQUENCE
/SORT AND BRANCH ROUTINE
/LOOKS FOR MATCH BETWEEN CHAR
/AND ELEMENTS OF TABLE 1 SPECIFIED
/CALLING SEQUENCE:
/ JMS I (SORTB
/ TABLE1-1
/ TABLE2-TABLE1
/ RETURN IF NO MATCH
/DISPATCHES TO CORRESPONDING ADDRESS IN TABLE 2
SORTB, 0
SZA /IS CHARACTER STORED YET?
DCA CHAR /NO - STORE IT
TAD I SORTB /YES
ISZ SORTB
DCA AXTEM /STORE TABLE 1 ADDRESS
TAD I AXTEM /GET TABLE ENTRY
SPA /DONE YET?
JMP SEX /YES - EXIT
CMPT, CIA /NO
TAD CHAR /GET CHARACTER
SZA CLA /DO THEY MATCH?
JMP .-6 /NO - KEEP TRYING
TAD AXTEM /YES - THEY MATCH
TAD I SORTB /GET DISPATCH TABLE ADDRESS
DCA SORTB
TAD I SORTB
DCA SORTB /SET RETURN ADDRESS
JMP I SORTB /--RETURN--VIA DISPATCH TABLE
SEX, ISZ SORTB /MATCH NOT FOUND
CLA
JMP I SORTB /--
/-----------------------------------------------------------------
/DISPATCH LIST FOR COMMAND HANDLERS
OPS2, ENDFIL /E
APP /A
XNS /I
CNGE /C
KILL /K
DELE /D
LIST /L
COMBO /N
PUNCH /P
TELE /R
JERK /J
BARROW /F
PUNCT /T
MOVEM /M
GETTAG /G
XCRET /S
YANK /Y
Q /Q
CORSPC /B
VIEW /V
/END OF INPUT TEXT LINE ROUTINE
EOL, JMS I ENDLNI /RESET LINK CELLS
ISZ LSTN /INCREMENT LINE POINTERS
ISZ THSN
TAD BUFEND
CLL CIA
TAD AXIN
SNL CLA /IS THE BUFFER FULL?
/------------------------------------------------------------
JMP MOR /NO - KEEP FILLING
TAD BELL /YES - RING WARNING BELL
JMS I OUTL1
JMP I TE1 /*RETURN TO COMMAND MODE*
/CONTINUATION OF HANDLERS FOR A, C, AND I COMMANDS
APP1, TAD LSTN /APPEND
DCA ARG0 /RESET ARG0 TO END OF TEXT
JMP INS
CNGE1, JMS I DELT /CHANGE - DELETE LINES AND
XNS1, TAD ARG0 /INSERT
SNA CLA /ANY ARGUMENTS?
INS, ISZ ARG0 /NO - INSERT AT BEGINNING OF TEXT
TAD ARG0
JMS I FIN1 /FIND THE POINTER
DCA THIS
ISZ TABIND /SET TAB INDICATOR
CDF 10
TAD I THIS /GET LINK TO BUFFER
CDF 0
DCA XSAV
CMA
TAD ARG0
DCA THSN /SET LINE POINTER
AONE, TAD BUFR /BEGIN LINE
DCA AXIN
DCA XCTIN
MOR, JMS I BUFRDI /GET A CHARACTER
JMS I SORTJ /IS IT SPECIAL? (SEE LIST)
LIST5-1
INLIST-LIST5 /YES - GO TO ITS HANDLER
JMS PACBUF /NO - PACK IT
JMP MOR /FETCH ANOTHER
/CHARACTER PACKING ROUTINE
/CONVERTS CHARACTER IN CHAR TO INTERNAL CODE
/AND CALLS PCK1 TO PACK IT INTO BUFFER
/ENTER AND EXIT WITH AC CLEAR
PACBUF, 0
CLL
TAD AXIN /DON'T ADD CHARACTERS
TAD K1210 /IF AXIN ABOVE 6570
SZL CLA /IS THERE ROOM FOR THIS ONE?
ERROR /NO
TAD CHAR /YES
TAD M240
SPA /IS IT 200-237?
JMP ESCA /YES - ATTACH 77
TAD M77
SMA SZA /IS IT 337 OR LESS?
JMP ESCA /NO - ATTACH 77
TAD P40 /YES - IS IT 277?
SNA CLA
JMP ESCA /YES - ATTACH 77
TR1, TAD CHAR /240-337 EXCEPT 277
AND C77 /MASK OUT LEFT 6 BITS
JMS PCK1 /PACK IT
JMP I PACBUF /--RETURN--
ESCA, CLA /200-237, 277,340-377
TAD C77 /PACK A 77
JMS PCK1
JMP TR1 /PACK THE CHARACTER
/PACK CHARACTERS INTO TEXT BUFFER
/ENTER WITH 6-BIT CODE IN AC
PCK1, 0
ISZ XCTIN /LEFT HALF OR RIGHT HALF?
JMP ROT /LEFT HALF
DCA UTRA /RIGHT HALF - STORE CHARACTER
TAD UTRA /GET CHARACTER
TAD ADD /GET PREVIOUS CHARACTER
CDF 10
DCA I AXIN /STORE IN FIELD 1 BUFFER
CDF 0
DCA ADD
JMP I PCK1 /--RETURN--
ROT, CLL RTL /LEFT HALF
RTL
RTL /ROTATE 6 LEFT
DCA ADD /RETAIN UNTIL NEXT CHARACTER
CMA /IS READY
DCA XCTIN /RESET L OR R SWITCH
JMP I PCK1 /--RETURN--
UTEST=PACBUF /TEMPORARY
/CHARACTER UNPACKING ROUTINE
/CONVERTS ONE CHARACTER FROM
/BUFFER FORMAT TO 8-BIT ASCII
/EXIT WITH CHARACTER IN AC
UTRA, 0
CLA CMA /INITIALIZE TO -1
DCA UTEST
EXTR, ISZ XCT /LEFT HALF OR RIGHT HALF?
JMP GET3 /RIGHT HALF
CDF 10 /LEFT HALF
TAD I AXOUT /GET BUFFER WORD
CDF 0
DCA GTEM
TAD GTEM
RTR /ROTATE 6 RIGHT
RTR
RTR
JMP GET4 /SKIP TO GETA
GET3, CLA CMA /RESET L - R SWITCH
DCA XCT
TAD GTEM
GET4, AND C77 /MASK OUT LEFT 6 BITS
TAD M77
CLL
SNA /WAS IT 77?
ISZ UTEST /YES - WAS IT LEFT HALF?
JMP GET5 /NO - CONTINUE
JMP EXTR /YES - GET OTHER HALF
GET5, TAD P37
ISZ UTEST /RESTORE THE CHARACTER
CML
SNL
TAD C100
TAD C240
TAD X203 /IS IT A ^C?
SNA
JMP UTRA+1 /YES - IGNORE IT
TAD M27 /NO - IS IT A ^Z?
SNA
JMP UTRA+1 /YES - IGNORE IT
TAD P232 /NO - RESTORE CHARACTER
JMP I UTRA /--RETURN--
/-------------------------------------------------------------
/INPUT LIST FOR SPECIAL CHARACTERS IN TEXT MODE
INLIST=.
SPACES /SPCS
CTRLU /^U
FULL /FORM
FULL /BELL
RUB4+1 /LINE FEED
RUB1 /RUBOUT
EOL /CARRIAGE RETURN
/HANDLER FOR FORM FEED OR ^G
FULL, TAD IGNORE /
TAD MCHIN1 /
SNA CLA /IN APPEND MODE?
JMP I TE1 /YES*RETURN TO COMMAND MODE*
TAD LSTN /NO - IS BUFFER EMPTY?
SNA CLA /
/--------------------------------------------------------------
JMP I MORI /YES - IGNORE FORM FEED
JMP I TE1 /NO*RETURN TO COMMAND MODE*
MORI, MOR
/SET UP TO READ FROM INPUT DEVICE
/USED BY C AND R COMMANDS
/CALLED WITH SEQUENCE
/ JMS I PSETUP
/ INPUT ROUTINE
/ CONTINUATION OF HANDLER
/EXITS TO CONTINUATION OF HANDLER
SETUP, 0
TAD I SETUP /GET READ AREA FROM ARGS
DCA BUFRDI
TAD I SETUP /LOCATION FOR IGNORED CHARACTERS
IAC CLL /V12
DCA IGNORE
ISZ SETUP /SETUP PROPER RETURN POINT
TAD I SETUP
DCA SETUP
TAD BUFR
TAD K1320
SZL CLA /IS BUFFER FULL?
ERROR /YES - DON'T READ
JMP I SETUP /--RETURN--
/SUPERVISOR FOR DELETION OF TEXT LINES
DELP, 0
JMS I CHKARG /CHECK ARGUMENT VALIDITY
TAD ARG0
DCA THSN /SET CURRENT LINE #
TAD ARG1 /SAVE # DELETED
DCA LISTER
TAD ARG0 /GET POINTER TO LINE
JMS I FIN1 /TO BE DELETED
DCA THIS /STORE IT
DELP1, CDF 10
TAD I THIS
DCA MARK /CORE ADDRESS OF OBJECT LINE
TAD I MARK
DCA I THIS /CHAIN NEW POINTERS TO DELETE LINE
TAD MARK
CDF 0
JMS I GRBAGE /PHYSICALLY DELETE THE LINE
ISZ ARG1 /ALL SPECIFIED LINES DELETED?
JMP DELP1 /NO - CONTINUE
TAD LSTN /IF 1,/D..MAKE CURRENT=0
SNA CLA
DCA THSN
TAD LISTER /BUMP TOTAL DOWN
TAD LSTN
DCA LSTN
JMP I DELP /YES--RETURN--
/HANDLER FOR <
EXLAS, CLA CLL CMA RAL /PRINT LAST LINE - AC=7776=-2
/HANDLER FOR > OR LINE FEED
EXNEX, TAD THSN /PRINT NEXT LINE
IAC
SNA /IS IT AN EXISTING LINE?
ERROR /NO
DCA ARG0 /YES SAVE EFFECTIVE ARGUMENTS
CMA
DCA ARG1
/HANDLER FOR L COMMAND
LIST, TAD LOW /SET KEYBOARD AS OUTPUT
DCA OUTDEV
ISZ TABIND /SET TAB INDICATOR
JMS LISTER /OUTPUT LINE(S)
JMP I TE1 /*RETURN TO COMMAND MODE*
/LISTING OUTPUT ROUTINE
/OUTPUTS LINES INDICATED BY ARG0,ARG1
LISTER, 0
TAD ARG0
SZA CLA /ANY ARGUMENTS?
JMP L0 /YES - SET THEM UP
TAD LSTCHK /ALLOW 0L?
SZA CLA
ERROR /NOPE
TAD LSTN /NO - SET TO LIST BUFFER
CIA
DCA ARG1
ISZ ARG0 /SET TO LINE 1
L0, TAD ARG0
CIA
TAD LSTN
SPA CLA /ARGUMENTS IN RIGHT RANGE?
L1, ERROR /NO -( OR JMP I TE1)
TAD ARG0
JMS I FIN1 /GET POINTERS
DCA THIS /SAVE POINTER
CMA
CDF 10
TAD I THIS /GET START
DCA AXOUT
TAD I AXOUT /SAVE POINTER FOR SEARCH
DCA XSAV
TAD AXOUT /SAVE OBJECT LINE FOR GARBAGE COLLECT
DCA MARK
CDF 0
CMA
DCA XCT
TAD ARG0 /SET POINTER
DCA THSN
ISZ ARG0 /SET FOR NEXT LINE
/(HANDLER FOR FORM FEED DURING CHARACTER SEARCH)
L2, JMS I UTR1 /UNPACK A CHARACTER
JMS I OUT1 /PRINT A CHARACTER
L3, TAD CHAR /OR (JMP SLOOK) **
TAD MCR
SZA CLA /WAS IT END OF LINE?
JMP L2 /NO - KEEP UNPACKING
ISZ ARG1 /YES - DONE YET?
JMP L0 /NO - GET NEXT LINE
JMP I LISTER /YES --RETURN--
/SEARCH ROUTINES
/HANDLER FOR CARRIAGE RETURN
SRETN, JMS I ENDLNI /TERMINATE THIS LINE
TAD MARK /AND NOW GARBAGE COLLECT
JMS I GRBAGE
ISZ ARG1 /DONE YET?
JMP I LIS1 /NO - GET NEXT LINE
JMP I TE1 /YES*RETURN TO COMMAND MODE*
IFNZRO SLOOK&1000 <PGERR,XXX>
SLOOK, JMS I SORTJ /SEARCH DONE?
/------------------------------------------------------------
LIST3-1 /(CARRIAGE RETURN OR SEARCH CHARACTER)
LISTGO-LIST3 /YES - GO TO ITS HANDLER
JMS I PACK1 /NO-PACK SEARCHED CHARACTERS
JMP I L2I /CONTINUE SEARCH
/HANDLER FOR ^G DURING CHARACTER SEARCH
/CHANGE SEARCH CHARACTER
SCONT, JMS I KEYBD /FETCH NEW SEARCH CHARACTER
DCA LIST3+1 /STORE IT IN LIST
JMP I L2I /CONTINUE SEARCH
/HANDLER FOR LINE FEED DURING SEARCH
SLINE, TAD CCR
DCA CHAR
JMS I ENDLNI
ISZ ARG0 /MOVE POINT
ISZ THSN /BUMP CURRENT LINE COUNT
ISZ LSTN /ADD A LINE.
/HANDLER FOR _ DURING SEARCH
SBAR, TAD CCR /CTRL-U
JMS I OUT1 /OUTPUT CARRIAGE RETURN
TAD BUFR /RESTART PACK BUFFER
DCA AXIN
DCA XCTIN
/-------------------------------------------------------------------
SFOUND, JMS I CHI1 /GET A CHARACTER
JMS I SORTJ /SPECIAL SEARCH COMMAND?
LIST6-1
SRNLST-LIST6 /YES - GO TO HANDLER
/HANDLER FOR SEARCH CHARACTER FOUND
SGOT, JMS I PACK1 /NO-PACK INSERTS
JMP SFOUND /CONTINUE INPUT
/SEARCH TEXT BUFFER FOR LINE
/WHOSE NUMBER IS ONE LESS THAN
/THE CONTENTS OF THE AC
/EXIT WITH ADDRESS OF LINK CELL IN AC
FIND, 0 /LOCATE LINE BUFFER
CIA
SMA /IS LINE NUMBER TOO SMALL?
ERROR /YES
DCA TEMP /NO - STORE NEGATIVE OF LINE #
TAD TEMP
IAC
TAD LSTN
SPA CLA /IS LINE NUMBER TOO LARGE?
ERROR /YES
TAD CFRS /NO
JMP FIND1
FIND2, CDF 10
TAD I SAVE /CHAIN THROUGH LIST
CDF 0
SZA /FAILSAFE
FIND1, DCA SAVE
ISZ TEMP /DONE YET?
JMP FIND2 /NO - KEEP CHAINING
TAD SAVE /YES - GET LINE NUMBER
JMP I FIND /--RETURN--
/HANDLER FOR B COMMAND
CORSPC, TAD BUFR /SET UP NUMBER OF LOCATIONS
STL CIA /IN ARG2
TAD BUFEND
TAD K360
SZL /IS ANY CORE LEFT?
CLA CLL /NO - WRITE 0
DCA ARG2 /FALL INTO 'PRNT'
BOX=COUNTP
VAL=ARG0
/HANDLER FOR : OR =
/PRINTS REQUESTED LINE NUMBER
/WHICH IS FOUND IN ARG2 ON ENTRY
PRNT, TAD ARG2
DCA VAL /SET NUMBER TO BE PRINTED
TAD M4
DCA CNT /SET CHARACTER COUNT
TAD ADDR
DCA FIND /SET ADDRESS OF PWRS OF TEN
FLOOZ, STA /SET TO -1
DCA BOX
ADDXYZ, CLL
ISZ BOX /FIRST TIME: BOX=0 AND SKIP
DCA VAL
TAD VAL
TAD I FIND /TAD I (ADDR) +() SOME DISPLACEMENT
SZL
JMP ADDXYZ /KEEP ADDING THE SAME CONSTANT
CLA
TAD BOX /BOX HAS THE NUMBER COUNT
TAD C260 /MAKE ASCII DIGIT
JMS I OUTL1 /OUTPUT THE DIGIT
ISZ FIND /ADD IN NEXT CONVERSION CONSTANT LATER
ISZ CNT /DONE ALL FOUR?
JMP FLOOZ /NO - KEEP CONVERTING
JMP I TE1 /YES*RETURN TO COMMAND MODE*
C260, 260
ADDR, CON
K360, 360
/HANDLER FOR RUBOUT IN TEXT OR SEARCH
RUB1, TAD AXIN
CIA
TAD BUFR
TAD XCTIN
SZA CLA /IS THERE ANYTHING ON THIS LINE?
TAD ECHOSW /OR ECHO INHIBITED?
SNA CLA
JMP I IGNORE /YES-IGNORE RUBOUT
CDF 10 /LOOK AT "SCOPE" BIT IN
TAD I P7726 /RESIDENT MONITOR
CDF 00
AND C200
SZA CLA
JMP RP1
TAD SPLAT /NO SCOPE, PRINT BACKSLASH
JMP RP2
RP1, TAD P210 /SCOPE, PRINT BACK SPACE
JMS I OUT1
TAD C240 /THEN A SPACE
JMS I OUT1
TAD P210 /THEN ANOTHER BACK SPACE
RP2, JMS I OUT1
/DELETE CHAR FROM BUFFER
TAD AXIN /GET LAST WORD OF INPUT
DCA MOV1
CDF 10
DCA I BUFR /PREVENTS INFINITE RUBOUTS
TAD I MOV1
ISZ XCTIN /WHICH HALF OF WORD?
JMP RUB2
AND C77
TAD M77
SZA CLA /TEST EXTENSION
JMP RUB4
RUB3, CMA
DCA XCTIN
CMA
TAD AXIN
DCA AXIN
TAD I MOV1
AND P7700
RUB4, DCA ADD
CDF 0
JMP I IGNORE /CHIN+1
RUB2, AND P7700
TAD C100
SZA CLA
JMP RUB3
DCA I MOV1
JMP RUB3+1
SPLAT, 334 /ACKNOWLEDGE RUBOUT
P210, 210
P7726, 7726
/-----------------------------------------------------------------------
CON, 6030 /CONVERSION CONSTANTS
7634
7766
7777
/I-O SUBROUTINES
/HANDLER FOR S COMMAND
XCRET, JMS I KEYBD /GET THE SEARCH CHARACTER
DCA LIST3+1 /SAVE IT IN LIST
TAD SXS2
DCA I L3I /MAKE LISTER JUMP TO SLOOK
TAD BUFR
DCA AXIN /BUILD NEW TEXT IMAGE HERE
DCA XCTIN
TAD CHI1 /READ POINT IS CHIN
IAC
DCA IGNORE
JMP I LIS1
/LIST OF SPECIAL CHARACTERS FOR G COMMAND
TAGLIST=.
GTAG2 /SPACE
GTAG2 //
GTAG2 /ESC
GTAG2 /TAB
GTAG2 /CARRIAGE RETURN
/HANDLER FOR $ (PART OF M COMMAND)
MOVE, TAD ARG0 /ARG2 .GE. ARG0
CIA
TAD ARG2
SPA CLA /ARE LINES TO BE MOVED LEGITIMATE
ERROR /NO
TAD ARG0 /YES-
DCA MOV1 /SET POINTER TO FIRST LINE
TAD ARG2
DCA MOV2 /SET POINTER TO LAST LINE
JMP I ONUM /CONTINUE COMMAND INPUT
/-----------------------------------------------------------------------
/SET UP APPEND, CHANGE, INSERT TO WORK
/EACH READS KEYBOARD, NOT DEVICE
CNGEL, CNGE1-XNS1
XNSL, XNS1-APP1
/HANDLER FOR C COMMAND
CNGE, TAD CNGEL
/HANDLER FOR I COMMAND
XNS, TAD XNSL
/HANDLER FOR A COMMAND
APP, TAD APPL
DCA DEST /RETURN POINT
ISZ ECHOSW
JMS I PSETUP
CHIN /KEYBOARD INPUT
DEST, APP1
/SPECIAL OUTPUT LIST
OUTLIS=.
ESCOUT /233 - ESC - V12
OUTTAB /211 - TAB
OUTCRL /215 - CARRIAGE RETURN
OUTX+1 /212 - LINE FEED
OUTX+1 /214 - FORM FEED
OUTX+1 /377 - RUBOUT
OUTX-1 /207 - CNTRL G - BELL
BCKSPC /210 - CNTRL H - BACKSPACE
/HANDLER FOR P COMMAND
PUNCHQ, DCA TABIND /ORIGINAL DEC PATCH
PUNCH, ISZ ECHOSW
TAD BUFWTI /SETUP TO WRITE INTO OUTPUT BUFFER
DCA OUTDEV
PUNC, JMS I LIS /WRITE THE EDITOR BUFFER
TAD C214 /OUTPUT FORM FEED
JMS I OUTDEV
/HANDLER FOR T COMMAND
PUNCT, CDF 10
TAD I K7600
CDF 0
SNA CLA /IS THERE AN OUTPUT DEVICE?
JMP I TE1 /NO*RETURN TO COMMAND MODE*
TAD BUFWTI /YES - SET UP TO WRITE INTO
DCA OUTDEV /OUTPUT BUFFER
TAD M41 /V40
DCA TEMPO /SET TRAILER COUNTER
CIF 10
JMS I POTYPE /
SMA CLA /DIRECTORY DEVICE FOR OUTPUT?
JMS I OUTDEV /NO - OUTPUT LEADER TRAILER
ISZ TEMPO /DONE YET?
JMP .-5 /NO - CONTINUE
TSF /YES - RESET FLAG
JMP .-1
JMP I TE1 /*RETURN TO COMMAND MODE*
/HANDLER FOR R COMMAND
TELE=.
TELEN, TSF
JMP .-1
DCA ECHOSW /INHIBIT ECHO
JMS I PSETUP /SETUP TO READ FROM
BUFRD /INPUT DEVICE
APPL, APP1 /APPEND TEXT TO BUFFER
/HANDLER FOR Y COMMAND
YANK, TAD COM1 /YANK KILLS 'P' PART OF N
JMP COMBOA
/HANDLER FOR N COMMAND
COMBO, TAD JMPCH /YANK WIPES COM1-1
COMBOA, DCA I CCON+1
TAD ARG0
SNA /ANY ARGUMENTS
IAC /NO - ASSUME 1
CIA
DCA COUNTP /SET NUMBER OF PAGES TO YANK
TAD CCON /(JMP I AXCOMB)
DCA I TE1 /SET TE1 TO ALLOW LOOPING
COMB, TAD CCON+1 /THROUGH PUNCH, KILL, READ
DCA AXCOMB /CYCLE
DCA ARG0 /CLEAR ARGUMENTS
DCA ARG2
DCA LSTCHK /DON'T INHIBIT LISTER!
DCA TABIND /CLEAR IN CASE OF MULTIPLE N
JMP PUNC /OUTPUT BUFFER
COM1, JMP I KILL1 /KILL BUFFER
JMP TELEN /READ NEW BUFFER FULL
ISZ COUNTP /DONE YET?
JMP COMB /NO - CONTINUE
CLA CLL CML RAL /YES-AC=1 - RESET CURRENT LINE NUMBER
DCA THSN /.=1 ON RETURN
COM5, TAD CZ /RESTORE TE1
DCA I TE1
JMP I TE1 /*RETURN TO COMMAND MODE*
/IT IS VITAL TO KEEP DUMB1 AND COM5 ON THE SAME PAGE
DUMB1, JERK1
PSETUP, SETUP /V3
/-----------------------------------------------------------------------
LIST1=.
212 /LINE FEED
240 /SPACE
253 /PLUS (+)
254 /COMMA (,)
255 /MINUS (-)
256 /PERIOD (.)
257 /SLASH (/)
274 /<
275 /=
276 />
000 /DUMMY FOR . AND /
"# /FOR VERSION V40
375 /ALTMODE ASR-33
376 /ALTMODE ASR-35
233 /ESCAPE KEY
242 /DOUBLE QUOTE (")
244 /DOLLAR SIGN ($)
377 /RUBOUT
272 /COLON (:)
LIST1A, 215 /CARRIAGE RETURN
225 /^U
203 /^C
/HANDLER FOR G COMMAND
GETTAG, ISZ THSN
TAD ARG0
SNA /ANY ARGUMENTS
TAD THSN /NO - BEGIN WITH NEXT LINE (.+1)
DCA ARG0 /YES - SET ARGUMENTS
SKP
GTAG2, ISZ ARG0
IAC
TAD ARG0
JMS I FIN1 /GET NEXT LINE
DCA AXOUT
CMA
DCA XCT
JMS I UTR1 /UNPACK FIRST CHARACTER
JMS I SORTJ /DOES IT BEGIN A TAG?
LIST7-1 /NO - TAGLIST EXITS
TAGLIST-LIST7 /TO GTAG2
JMP I LIS1 /YES - PRINT LINE
MP1=ARG1
MP2=ARG0
MP3=ARG2
/HANDLER FOR M COMMAND
/ENTER WITH FIRST LINE TO MOVE IN MOV1
/LAST LINE TO MOVE IN MOV2
/MOV2 .GT. MOV1
/DESTINATION LINE IN ARG2
MOVEM, TAD MOV1
CIA /ARG2 MAY NOT BE BETWEEN
TAD ARG2 /MOV1 AND MOV2
SPA CLA /IS MOV1 .GT. ARG2?
/-----------------------------------------------------------------------
JMP .+6 /YES - O.K.
TAD MOV2
CMA
TAD ARG2
SPA SNA CLA /IS MOV2 .LT. ARG2?
ERROR /NO-FAULTY LOGIC IN COMMAND
TAD MOV1 /YES
JMS I FIN1
DCA MP1 /STORE FIRST LINE POINTER
IAC
TAD MOV2
JMS I FIN1
DCA MP2 /STORE LAST LINE POINTER
TAD ARG2
JMS I FIN1
DCA MP3 /STORE DESTINATION LINE POINTER
CDF 10 /ALL FOUND
TAD I MP1 /SWAP POINTERS-
DCA TEMP /RESET THE LINK COORDS
TAD I MP2
DCA I MP1
TAD I MP3
DCA I MP2
TAD TEMP
DCA I MP3
CDF 0
JMP I TE1 /*RETURN TO COMMAND MODE*
SRNLST=.
SBAR /BACK ARROW (_)
L2 /FORM FEED
SCONT /BELL
SLINE /LINE FEED
RUB1 /RUB OUT
LISTGO=.
SRETN /CARRIAGE RETURN
SGOT /SEARCH CHARACTER FOUND
/HANDLER FOR E COMMAND
ENDFIL, TAD EKILLL /IS E COMMAND ALLOWED?
SZA CLA
ERROR /NO-NO INPUT SPECIFIED
CLA CMA /YES-RESET ARGUMENTS
DCA ARG0
TAD JMPTE1 /SKIP LISTER IF EMPTY BUFFER
DCA I L1I
TAD FLCLSI /CLOSE FILE SETUP
DCA ELIM /CLOSES FILE ON READ FAILURE
JMP I COMBOP
COMBOP, COMBO
FLCLSI, JMP I CLFLI
AONEI, AONE
/HANDLER FOR ^U IN TEXT MODE
CTRLU, TAD CCR /AND A CR/LF
JMS I OUT1
JMP I AONEI /AND CONTINUE
/CHECK VALIDITY OF ARGUMENTS
/FOR D COMMAND
CHKARX, 0
TAD ARG0
CIA
IAC
TAD ARG1
TAD LSTN
SPA CLA /DO LINES EXIST?
ERROR /NO
JMP I CHKARX /YES--RETURN--
/HANDLER FOR .
PERI, TAD THSN
SKP
/HANDLER FOR /
SLAS, TAD LSTN
DCA TEMP /SAVE LINE NUMBER
DCA CHAR
ISZ LSTCHK /GOT EITHE . OR / IN ARGS
JMP I .+1 /FETCH REST OF ARGUMENT
GLOM
/HANDLER FOR SPACE IN TEXT MODE
SPACES, TAD ECHOSW
CLA /OR SZA CLA IF B OPTION
JMP I SPCNO /PACK IT - (MOR+4)
CMA /SET COUNTER
SP2, DCA CNT
JMS I BUFRDI /GET LAST CHARACTER
TAD M240
SNA CLA /WAS IT SPACE?
JMP SP2 /YES-IGNORE EXTRA SPACES
/-----------------------------------------------------------------------
TAD CHAR /NO
DCA SAVE /SAVE NON-SPACE
ISZ CNT /WAS THERE MORE THAN 1 SPACE?
TAD M27 /YES- STORE TAB
TAD C240 /NO-STORE SPACES
DCA CHAR
JMS I PACK1
TAD SAVE
JMP I SPCGO /SORT - (MOR+1)
/HANDLER FOR K COMMAND
KILL, TAD ARG0 /IN CASE HE TYPED N,MK
SZA CLA /INSTEAD OF N,ML. SAVE HIM!!
ERROR
TAD END /RESET BUFFER POINTERS
DCA BUFR /TO REFLECT EMPTY BUFFER
DCA LSTN
DCA THSN
CDF 10 /ZERO FIELD 1 POINTER
DCA I CFRS
CDF 0
JMP I TE1 /*RETURN TO COMMAND MODE*
OPS1, EXNEX /LINE FEED
GEXP /SPACE
GEXP /PLUS
FIRS /COMMA
GMIN /MINUS
PERI /POINT(.)
SLAS /SLASH
EXLAS /BACKUP(<)
PRNT /=
EXNEX /ALT(>)
DBCV2 /DUMMY FOR . AND /
VERSN /# VERSION
AMODE /ALTMODE ASR-33
AMODE /ALTMODE ASR-35
AMODE /ESCAPE KEY
DBLQUO /"
MOVE /DOLLAR SIGN
ELIM /COMMAND RUBOUT
PRNT /:
GTOP-2 /CARRIAGE RETURN
START /^U
MONIT /^C (MONITOR RESTART)
OPS1A, RETRN /RETURN
/-----------------------------------------------------------------------
OLDTE1, START /^U
MONIT /^C
/END OF A NEW TEXT LINE
/PACK CARRIAGE RETURN INTO BUFFER
/SET LINK CELLS AROUND NEW LINE
/ENTER WITH:
/ CHAR CONTAINS CARRIAGE RETURN
/ THIS CONTAINS ADDRESS OF LINK
/ CELL OF PRECEDING TEXT LINE
/ XSAV CONTAINS ADDRESS OF LINK
/ CELL OF FOLLOWING TEXT LINE
/ BUFR CONTAINS ADDRESS OF LINK
/ CELL OF NEW TEXT LINE
ENDLN, 0
JMS I PACK1 /PACK CARRIAGE RETURN
CDF 10
TAD ADD
SZA
DCA I AXIN
TAD BUFR /RESET LINK CELL
DCA I THIS /OF PREVIOUS LINE
TAD XSAV
DCA I BUFR /RESET LINK CELL OF NEW LINE
TAD BUFR
DCA THIS /RESET POINTER TO LINK CELL
ISZ AXIN
TAD AXIN
DCA BUFR /RESET FOR NEXT LINE
DCA XCTIN /CR CHARACTER SWITCH
CDF 0
JMP I ENDLN /--RETURN--
/CHECK FOR CONTROL C
CTCK, 0
TAD C200
KRS
TAD X203
SNA
JMP I MONITOR
JMP I CTCK
/LOW SPEED INPUT ROUTINE
/CHECKS FOR ^C
/EXIT WITH CHARACTER IN AC
I33, 0
KSF
JMP .-1
JMS CTCK
KRB
AND P177
TAD C200
JMP I I33 /NO--RETURN--
/LOW SPEED OUTPUT ROUTINE
/ENTER WITH CHARACTER IN AC
OUTL, 0
TLS
TSF
JMP .-1
JMS COPSQ /CHECK ^COPSQ
JMP I OUTL /NO, --RETURN--
COPSQ, 0
CLA
KSF /IS KEYBOARD ACTIVE?
JMP I COPSQ /NO
CHKAGA, JMS CTCK /GET CHAR, CHECK ^C
TAD (-20+3 /WAS IT ^P?
SZA
IAC /NO, WAS IT ^O?
SNA
JMP CLRCOP /CLEAR EITHER ^O OR ^P
TAD (-23+17 /FINALLY, WAS IT ^S?
SNA
JMP CTRLS /YES, HANG UP
IAC
IAC
SNA CLA /OR WAS IT ^Q?
KCC /YES, THROW AWAY
JMP I COPSQ /NOW GO ON
CTRLS, KCC /CLEAR ^S
KSF
JMP .-1 /WAIT FOR ^Q HOPEFULLY
JMP CHKAGA /INVESTIGATE NEW CHAR
CLRCOP, KCC
JMP I TE1 /*RETURN TO COMMAND MODE*
/RESET POINTERS AND SAVE BUFFERS
RESET3, JMS FXSTWD
CIFTEN, CIF 10 /CLEAR BIT 11 OF JSW
JMS I P7700 /CALL USER SERVICE ROUTINES
10 /*LOCK USR IN CORE*
TAD CIFTEN /RESET POINTERS
DCA I BUFRD1
DCA EKILLL
TAD OLDTE1
DCA TE1
TAD CZ
DCA I TE1
TAD K7600
DCA ELIM
TAD K7600
DCA I SPCP1A
TAD LOW
DCA OUTDEV
ISZ ECHOSW
TAD JMPCH
DCA I CCON+1
ISZ FXSTWD /WASTE TIME FOR TTY FLAG
JMP .-3
CIF CDF 10
JMP I .+1 /GO CALL COMMAND DECODER
START1
SPCP1A, SPACES+1
BUFRD1, BUFRD+1
DELE, JMS I DELT /DELETE THE LINES
TSF
JMP .-1
JMP I TE1
/CLEAR BIT 11 OF JOB STATUS WORD
FXSTWD, 0
CIF 10
JMS I JSWSET /IF NONZERO TEXT,SAVE BUFFER
JMP I FXSTWD /--RETURN--
JSWSET, INSET
/HANDLER FOR ^C
/AND OTHER EXITS TO MONITOR
MONIT, JMS FXSTWD /SET JOB STATUS TO SAVE CORE
TSF /MAKE SURE TTY FLAG IS SET
JMP .-1
JMP I K7600 /****EXIT TO MONITOR****
IFNDEF GERMAN <
REDMES, "I; "n; "p; "u; "t; 0
DEVMES, "D; "e; "v; "i; "c; "e; 0
>
IFDEF GERMAN <
REDMES, "L; "e; "s; "e; 0
DEVMES, "G; "e; "r; "a; "e; "t; 0
>
PAGE
/-----------------------------------------------------------------------
/-----------------------------------------------------------------------
/READ,WRITE,AND RELATED ROUTINES
OURECS=4 /SIZE OF OUTPUT BUFFER
/HANDLER FOR Q COMMAND
Q, JMS I FXSWDI /CLEAR BIT 11 OF JSW
CDF 10
TAD I K7600
CDF 0
SNA CLA /WAS AN OUTPUT DEVICE SPECIFIED?
ERROR /NO-
FLCLOS, TAD LSTN
SNA CLA /IS BUFFER EMPTY?
JMP FLCLS1 /YES-CLOSE FILE
TAD FLCLI /NO-
DCA TE1 /SET UP RETURN FROM P COMMAND
JMP I .+1
PUNCHQ
/CLOSE FILE ON E OR Q COMMAND
FLCLS1, CIF 10
JMS I OCLSI /CLOSE FILE
JMP CLERR /WAS ERROR
CLA CMA /TELL SYSTEM I/O MONITOR IS IN CORE
CDF 10
DCA I P7700
CDF 0
JMP I K7600 /****EXIT TO MONITOR***
CLERR, SPA CLA
JMS I PRERR /**FILE CLOSE FAILED**2*
2
JMP ERWT+2 /RAN OUT OF SPACE WHILE CLOSING
/INPUT ROUTINE FROM DEVICE
/VIA INPUT DEVICE HANDLER
BUFRD, 0
CIF 10
JMS I ICHARI /FETCH A CHARACTER
JMP ERRD /ERROR IN READING FROM BUFFER
DCA CHAR /INTERFACE LOCATION
TAD CHAR
AND P177
SNA /IS IT L/T?
JMP BUFRD+1 /YES-GET NEXT CHARACTER
TAD C200 /NO RESTORE CHARACTER
JMP I BUFRD /--RETURN--
ERRD, SPA CLA /FATAL OR EOF?
JMS I PRERR /FATAL-OUTPUT ERROR MESSAGE
0 /*FAILED IN READIN DEVICE*0*
TAD ERSW /DISABLE FURTHER READS
DCA BUFRD+1
TAD I COMM5 /IF THIS IS NEGATIVE, DO ONE
SMA CLA /MORE SEARCH (POSSIBLY) IN THE CASE
JMP BUFRD+1 /THAT NO FINAL FORM FEED EXISTS
CLA IAC /SET CURRENT LINE TO 1 AND SEARCH
DCA THSN /ONCE MORE
JMP I .+1
SFIND2
ICHARI, ICHAR /CHARACTER ROUTINES
FLCLI, FLCLS1
/OUTPUT ROUTINE TO DEVICE
/VIA OUTPUT DEVICE HANDLER
BUFWT, 0
CIF 10
JMS I OCHARI /OUTPUT A CHARACTER
JMP ERWT /OUTPUT FAILED
BUFRTN, TAD BUFWTI /RESET OUTPUT DEVICE HANDLER POINTER
DCA OUTDEV
JMP I BUFWT /--RETURN--
ERWT, SPA CLA /FATAL, OR NO MORE ROOM?
JMS I PRERR /FATAL-OUTPUT ERROR MESSAGE
1 /*FATAL WRITE ERROR*1*
JMS I FXSWDI /FIX JOB STATUS WORD-NO MORE ROOM
TAD I TE1 /STORE POINTERS
DCA PTE1
TAD ELIM
DCA PELIM
TAD TE1
DCA PPTE1
CDF 10
ISZ I PANICI /SET PANIC DUMP
TAD MORECS /PREPARE TO CLOSE PRESENT OUT FILE
TAD I OCNTI /THIS GIVES OPTIMUM CLOSE LENGTH
SPA
JMP OVRFLW
DCA I OCNTI
TAD I OREC /WRITE A ^Z
DCA CLSREC /DIRECTLY TO THE DEVICE
TAD I OHNDL /HANDLER ENTRY POINT
DCA TEMPO
CDF 0
JMS I TEMPO /CALL OUTPUT DEVICE HANDLER
4110 /THE BUFFER IS A PAGE OF THE EDITOR
7000 /WITH A 232 IN THE FIRST LOCATION
CLSREC, 0 /RECORD NUMBER HERE
JMS I PRERR /**WRITE FAILURE** 1*
1
CDF CIF 10
JMS I OCLSI /CLOSE THE FILE IN PANIC MODE
JMS I PRERR /**FILE CLOSE FAILED**2*
2
CIF 10
JMS I C200 /CALL USER SERVICE ROUTINES
11 /*DISMISS USR FROM CORE*
OVRFLW, CDF 0
CLA
JMS I POINT /PRINT 'FULL'
FULMES
JMP I RST3I /-RESET & CALL COMMAND DECODER
FXSWDI, FXSTWD
OCNTI, OUCCNT
PANICI, PANIC
OCHARI, OCHAR
MORECS, -OURECS+1 /THIS ALLOWS US TO 'MANUALLY' WRITE
/A FORM FEED AND A ^Z.
POINT, PRINT
OREC, OUREC
OHNDL, OUHNDL
/RESET POINTERS STORED PREVIOUSLY
BUFRET, TAD PPTE1
DCA TE1
TAD PTE1
DCA I TE1
TAD PELIM
DCA ELIM
JMP BUFRTN
PPTE1, 0
PELIM, 0
PTE1, 0
OCLSI, OCLOSE /V3 FILE CLOSE ROUTINE
/-----------------------------------------------------------------------
IFNDEF GERMAN <
FULMES, "F; "u; "l; "l; 240; "!; "!; 215; 212; 0
>
IFDEF GERMAN <
FULMES, "V; "o; "l; "l; 240; "!; "!; 215; 212; 0
>
SRCBUF, ZBLOCK 24 /SEARCH BUFFER
/SPECIAL CHARACTER LIST FOR STRING SEARCH
SLST=.
247 /"
242 /'
377 /RUBOUT
203 /^C
225 /^U
/-----------------------------------------------------------------------
NEXBUF, DUMB1&177+5600 /JMP I DUMB1
/DISPATCH LIST FOR STRING SEARCH
OSLST, QUO1 /"
QUO2 /'
FORGET /RUBOUT
MONIT /^C
START /^U IN STRING SEARCH
/HANDLER FOR ALTMODE
AMODE, DCA STRIND /NEED SETUP
JMS I STRFIN /SEARCH FOR STRING
ERROR
TAD THSN /RESULT IS LINE NUMBER
JMP I .+1 /LINK TO COMMAND STRUCTURE
GTOP+1
/HANDLER FOR J COMMAND
JERK, DCA STRIND /SETUP FOR SEARCH
JERK1, JMS I STRFIN /SEARCH FOR STRING
JMP GMOR /GET NEXT BUFFER
TSF
JMP .-1 /JUST TO BE SURE
TAD CZ /RESTORE MONITOR EXIT
DCA I TE1
JMP I TE1 /*POSSIBLE RETURN TO COMMAND MODE*
/GET NEXT BUFFER FOR S SEARCH
GMOR, TAD I CNTRI
SNA CLA /IS BUFFER EMPTY?
ERROR /NO
ISZ STRIND /YES-BYPASS SETUP
TAD NEXBUF
DCA I COMM5 /SET UP READ OF ONE BUFFER
IAC
DCA ARG0
TAD EKILLL
SZA CLA /IS THERE AN OUTPUT DEVICE?
JMP I .+2 /NO
JMP I .+2 /YES
YANK /NO OUTPUT
COMBO /THERE IS OUTPUT
/HANDLER FOR F COMMAND
BARROW, ISZ STRIND /CONTINUES LOOKING FOR EXISTING STRING
ISZ THSN /INCREMENT FOR NEXT LINE
JMP JERK1
CNTRI, CNTR
/HANDLER FOR "
DBLQUO, ISZ THSN /USES STRING NOW IN BUFFER
ISZ STRIND /NO SETUP REQUIRED
JMP AMODE+1
/ROUTINE TO REASSIGN INPUT HANDLER
/AFTER A PANIC DUMP AND RESTART
PIASGN, CDF CIF 10
TAD I PINEOF
SZA CLA /IS THERE A HANDLER TO RESTORE?
JMP I PIRETN /NO - BACK TO FIELD 1
TAD I IHPAGE /YES -
DCA PIHND /GET HANDLER PAGE
TAD I IDVNO
CDF 0 /I/O MONITOR IS IN CORE AT THIS POINT
JMS I C200 /CALL USER SERVICE ROUTINES
1 /*FETCH HANDLER*
PIHND, 0
JMS I PRERR /**DEVICE HANDLER ERROR**4**
4
TAD PIHND
CDF CIF 10
DCA I PIHNDL /PUT NEW HANDLER ADDRESS BACK
JMP I PIRETN /AND RETURN
PIRETN, PANOPN /GO OPEN OUTPUT FILES
PIHNDL, INHNDL
IHPAGE, I1 /I1 CONTAINS "INDEVH+1"
IDVNO, INDEV
PINEOF, INEOF
/HANDLER FOR # COMMAND
VERSN, JMS PRINT
VERMES
JMP I TE1 /PRINT VERSION MESSAGE AND RESTART
PRINT, 0
TAD I PRINT /GET ADD OF MESS
ISZ PRINT
DCA TEMPO
SKP
JMS I OUTL1 /ON TTY:
TAD I TEMPO /FETCH CHARACTER
ISZ TEMPO
SZA /DONE YET?
JMP .-4
JMP I PRINT /YES
VV1=VERSION%12
VV2=VV1^12
VERMES, "V; "0+VV1; "0+VERSION-VV2; PATCH; 0
IFNDEF GERMAN <
WRTMES, "O; "u; "t; "p; "u; "t; 0
OPNMES, "E; "n; "t; "e; "r; 0
>
IFDEF GERMAN <
WRTMES, "S; "c; "h; "r; "e; "i; "b; 0
OPNMES, "E; "i; "n; "t; "r; "a; "g; "u; "n; "g; "s; 0
>
PAGE
/-----------------------------------------------------------------------
/-----------------------------------------------------------------------
/STRING SEARCH ROUTINE
/CALLED BY $(ALTMODE) AND J COMMAND HANDLERS
SFIND1, 0
ISZ ECHOSW
TAD STRIND /IS SETUP NECESSARY
SZA CLA
JMP SFIND2 /NO.
TAD MSCNT
DCA BUFCNT /SET COUNTER
TAD SBUF
DCA AXIN /BEGIN SEARCH BUFFER
TAD ATSIGN
JMS I OUTL1 /OUTPUT $
ISZ TABIND
RLOOP, JMS I CHI1 /FETCH CHARACTER FROM TTY
JMS I SORTJ /IS IT SPECIAL FOR SEARCH STRING?
SLST-1 /YES-HANDLE IT
OSLST-SLST
ISZ BUFCNT /NO-SEARCH BUFFER FULL?
JMP STORE /NO-STORE THIS CHARACTER
CLA CMA
DCA BUFCNT /YES-DON'T ALLOW ANY MORE
JMP RLOOP-1 /BUT KEEP ECHOING HIS
STORE, TAD CHAR /STORE CHARACTER IN SEARCH BUFFER
DCA I AXIN
JMP RLOOP
/HANDLER FOR "
QUO2, TAD THSN /START AT .+1
/HANDLER FOR '
QUO1, IAC /START AT .=1
DCA THSN
TAD AXIN
CIA /MAKE UP COUNT OF NO. CHARS NOW IN
TAD SBUF /SEARCH BUFFER
DCA CNTR
DCA I AXIN /END STRING WITH A 0
SFIND2, TAD CNTR
SNA CLA /IS BUFFER EMPTY?
JMP ER1 /YES-PREPARE TO EXIT
JMS NUCHAR /NO GET FIRST STRING CHARACTER
TAD THSN
JMS I FIN1 /GET APPROPRIATE POINTER
DCA THIS /THE TRICK IS TO GET THE NEXT
DCA CHFND
CDF 10 /POINTER SO THAT WE NEVER HAVE TO GO
TAD I THIS /BACK TO THE FIND ROUTINE
COMBAK, DCA TMP2
TAD I TMP2
DCA NEXTPT
CDF 0
TAD THSN
CIA
TAD LSTN
SPA CLA /LAST LINE?
JMP ER1 /YES-FINISHED WITH BUFFER
TAD TMP2 /NO
DCA AXOUT /SET TO UNPACK CHARACTERS
CMA
DCA XCT
UPK1, JMS I UTR1 /UNPACK A CHARACTER
DCA TMP2
TAD TMP2
TAD MCR
SZA CLA /END OF LINE?
JMP NOCR /NO
ISZ THSN /YES-INCREMENT LINE COUNTER
JMS NUCHAR /FORGET PREVIOUS MATCHES ON NEW LINE
DCA CHFND
CDF 10
TAD NEXTPT /AND GET NEXT LINE
JMP COMBAK
NOCR, TAD TMP2 /CHARACTER OTHER THAN CARRIAGE RETURN
TAD TMP1 /GET A CHARACTER FROM SEARCH BUFFER
SZA CLA /DO THEY MATCH
JMP UPK /NO
ISZ CHFND /YES-BUMP A RANDOM POINTER
CLA CMA
DCA FMATCH /SIGNIFY FIRST MATCH
JMS NUCHA /GET NEXT SEARCH CHARACTERR
JMP UPK1 /AND ANOTHER BUFFER CHARACTER
UPK, ISZ FMATCH /WAS THIS FIRST MATCH?
JMP NOTSO /NO-NO PROBLEM
TAD XCT /YES-DON'T LET THE POINTERS BE
SPA CLA /BE CHANGED
JMP WREK
CMA
TAD AXOUT
DCA AXOUT
CMA
WREK, DCA XCT
NOTSO, JMS NUCHAR /GET FIRST CHARACTER OF SEARCH STRING
DCA CHFND
JMP UPK1 /TRY AGAIN
STFIN, TAD CHFND /END OF STRING-DO COUNTS MATCH?
TAD CNTR
SNA CLA
JMP GOOD /YES-SEARCH SUCCESSFUL
ER1, TAD LSTN /IF BUFFER EMPTY, SET .=0
SZA CLA
IAC
DCA THSN
SKP /CAUSE ERROR RETURN (?)
GOOD, ISZ SFIND1 /INCREMENT RETURN
JMP I SFIND1 /--RETURN--
/GET NEXT SEARCH CHARACTER
NUCHA, 0
TAD .-1 /SET TO RETURN FROM NUCHAR
DCA NUCHAR
JMP NEXX
/GET FIRST CHARACTER OF SEARCH STRING
NUCHAR, 0
TAD SBUF
DCA AXIN
NEXX, TAD I AXIN
SNA /END OF STRING?
JMP STFIN /YES
CIA /NO - NEGATE SEARCH CHARACTER
DCA TMP1 /AND STORE IT
JMP I NUCHAR /--RETURN--
ENDA=SRCBUF-1
ATSIGN, 244
TMP1, 0
TMP2, 0
CNTR, 0
FMATCH, 0
BUFCNT, 0
NEXTPT, 0
CHFND, 1 /MUST BE NONZERO INITIALLY
SBUF, ENDA
MSCNT, -24
/HANDLER FOR RUBOUT IN SEARCH STRING
FORGET, TAD CCR
JMS I OUT1 /OUTPUT CARRIAGE RETURN
JMP SFIND1+1
PAGE
/-----------------------------------------------------------------------
/-----------------------------------------------------------------------
THISX=COUNTP
THISX2=DTEM
/GARBAGE COLLECTION ROUTINE
/ENTER WITH NUMBER OF LINE TO BE DELETED
/IN AC
GARBAG, 0
DCA LINPTR /SAVE OBJECT LINE ADDRESS
TAD LINPTR
DCA AXCOMB /SCAN LINE LOOKING FOR 7715 OR 1500 (CR)
IAC /CNT HOLDS
DCA CNT /TOTAL # LOCS IN THIS LINE
CDF 10
COLECT, ISZ CNT
TAD I AXCOMB /GET A WORD
TAD K63
SNA /IS IT 7715?
JMP FINONE /YES-END OF LINE
TAD K6215
SZA CLA /NO-IS IT 1500?
JMP COLECT /NO-TRY NEXT WORD
FINONE, TAD CNT /YES MINUS CNT GIVES AMOUNT
CIA /TO REDUCE CERTAIN POINTERS
DCA RELCNT
CDF 0
IAC /GO THROUGH LIST OF POINTERS
JMS I FIN1 /& OFFSET POINTERS WHICH WILL BE MOVED
CDF 10 /MOVED ALONG WITH TEXT
GBG2, DCA THISX /SAVE POINTER
TAD I THISX /GET ADDRESS OF THIS LINE
SNA /DONE WITH STRING?
JMP GBGEND /YES
JMS CGEPTR /DECREASE POINTER IF NECESSARY
DCA I THISX /STORE NEW POINTER
TAD THISX2
JMP GBG2 /DO NEXT LINE
GBGEND, CDF 0 /ALL POINTERS ARE REDUCED. NOW,
CLL CML
TAD BUFR /PHYSICALLY MOVE CORE TO
CIA /CORRESPOND WITH POINTERS
TAD AXCOMB /AXCOMB POINTS TO FIRST LOC. TO GO
SMA SNL /POINTERS O.K.?
ERROR /NO
DCA XCT /YES-SET UP OTHER POINTERS
CDF 10
CMA
TAD LINPTR
DCA AXOUT
TAD I AXCOMB /MOVE TEXT
DCA I AXOUT
ISZ XCT /ALL TEXT MOVED?
JMP .-3 /NO-CONTINUE MOVING
CDF 0 /YES
TAD AXOUT
DCA BUFR /RESET TOP OF BUFFER
TAD BUFR /REDUCE AXIN FOR CHARACTER SEARCH
DCA AXIN
TAD THIS /NOW DECREASE THIS IF IT IS NECESSARY
JMS CGEPTR
DCA THIS
JMP I GARBAG /--RETURN--
LINPTR, 0
K63, 63
CGEPTR, 0 /THIS ROUTINE DETERMINES IF THE
DCA THISX2 /OF THE AC MUST BE DECREASED BY RELCNT.
CLL /IF THISX2 IS GREATER THAN LINPTR
TAD THISX2 /DECREASE THISX2 BY RELCNT.
CIA
TAD LINPTR /THIS EFFECTIVELY DECREASE ALL POINTERS
SNL CLA /WHICH HAVE TO BE RELOCATED
TAD RELCNT
TAD THISX2
JMP I CGEPTR
/HANDLER FOR V COMMAND
VIEW, TAD (LPT /SET UP LISTER TO EXIT TO LPT
DCA OUTDEV
ISZ TABIND
JMS I LIS /LIST BUFFER
6254 /SKIP ON MULTI8
TAD XFFCTZ /NORMAL IS FF
TAD P232 /MULTI8 EOF, FF FROM MULTI8
JMS I OUTDEV
JMP I TE1 /*RETURN TO COMMAND MODE*
XFFCTZ, 214-232
RELCNT, 0
/HANDLER FOR ,
FIRS, TAD ARG2
JMP I ONUM
K6215, 6215
/THE FOLLOWING GIVES ERROR MESSAGES FOR I/O RELATED ERRORS
/EACH IS A FATAL ERROR AND WILL ALWAYS EXIT THROUGH
/7600, SAVING THE TEXT BUFFER.
/N IS THE ERROR IDENTIFICATION CODE
/N=0=> FAILED IN READING DEVICE
/N=1=> FATAL WRITE ERROR
/N=2=> FILE CLOSE ERROR
/N=3=> FILE OPEN ERROR
/N=4=> DEVICE HANDLER ERROR
DEVERR, 0
TAD I DEVERR
CDF 0
TAD (ERRLIS
DCA ERRARG
TAD I ERRARG
DCA ERRARG
TLS
TSF
JMP .-1
JMS I (PRINT /SEND ERROR CODE
ERRARG, 0 /GETS ADDRESS OF MESSAGE
JMS I (PRINT
ERRERR /PRINT "error"
JMP I MONITO /****EXIT TO MONITOR****
ERRLIS, REDMES /0
WRTMES /1
CLSMES /2
OPNMES /3
DEVMES /4
IFNDEF GERMAN <
ERRERR, 240; "E; "r; "r; "o; "r; 240; "^; "C; 0
CLSMES, "C; "l; "o; "s; "e; 0
>
IFDEF GERMAN <
ERRERR, "-; "F; "e; "h; "l; "e; "r; 240; "^; "C; 0
CLSMES, "A; "b; "s; "c; "h; "l; "u; "s; "s; 0
>
PAGE
/-----------------------------------------------------------------------
/-----------------------------------------------------------------------
/THE CODE AT 3000 IS ONCE ONLY CODE. IT TAKES THE FIELD 1
/PART OF THE CODE WHICH IS INITIALLY IN FIELD 0 AND MOVES
/IT UP TO THE PROPER LOCATIONS IN FIELD 1.
XYZTUV=(LPT /IDENTIFIER FOR SET
INIT, TAD (3177 /COLD LOAD STARTS AT 3200
DCA AXIN
TAD (6577 /CODE SHOULD BE IN 6600 OF FIELD 1
DCA AXOUT
TAD (7000 /MOVE 1000 LOCATIONS UP
DCA COUNTA
LOOP, CDF 0
TAD I AXIN /MOVE CODE
CDF 10
DCA I AXOUT
ISZ COUNTA /DONE YET?
JMP LOOP /NO
DCA AXIN /YES-RESET COUNTERS
DCA AXOUT
CDF 0 /PUT A NOP INTO LOC. 203
TAD (NOP
DCA I (START
TAD RST3I /CHANGE START ADDRESS TO SAVE BUFFER
DCA 177
CIF CDF 10
JMP I K6600 /STARTING ADDRESS IS 16600
K6600, 6600 /FIELD 1 STARTING ADDRESS
COUNTA, 0
/CHARACTER OUTPUT ROUTINE
OUT, 0
DCA CHAR
TAD ECHOSW /IS ECHO SUPPRESSED?
SNA CLA
JMP I OUT /YES--RETURN--
JMS I SORTJ /NO - IS IT A FORMAT CHARACTER?
LIST4-1 /YES - EXIT TO ITS HANDLER
OUTLIS-LIST4
TAD CHAR /SOME OTHER CONTROL CHAR?
TAD (-240
SPA CLA
JMS TERLIN /IS OUTPUT TO OS/8?
SKP
JMP UPARO /YES OUTPUT ^X FORM IF NOT OS/8
ISZ TCNT /NO - COUNT ONE LETTER
TAD CHAR
OUTX, JMS I OUTDEV /OUTPUT THE CHARACTER
JMP I OUT /--RETURN--
UPARO, ISZ TCNT
TAD (336 /PRINT ^
JMS I OUTDEV
TAD C100 /PRINT X
JMP OUTX-2
/ROUTINE TO HANDLE ESCAPE OUTPUT
ESCOUT, TAD I CHI1 /V12 - TAD CHIN
TAD (-CMCHK-1
SNA CLA /COMMAND MODE?
JMP I OUT /YES, DON'T OUTPUT IT NOW
JMS TERLIN /TO TERMINAL OR LPT?
TAD (233-"$ /NO, OUTPUT ESC
TAD ("$ /YES, OUTPUT "$"
JMP OUTX /DO IT
TERLIN, 0 /TEST IF OUTPUT TO FILE
TAD OUTDEV
TAD (-BUFWT
SZA CLA /OUTPUT TO OS/8 DEVICE?
ISZ TERLIN /NO, TO TERMINAL OR LPT
JMP I TERLIN /YES, TO OS8
/BACKSPACE DECREMENTS TAB COUNTER
BCKSPC, STA
TAD TCNT
DCA TCNT
JMP OUTX-1
/CARRIAGE RETURN HANDLER
OUTCRL, TAD CCR
JMS I OUTDEV /OUTPUT CARRIAGE RETURN
DCA TCNT /CLEAR TAB COUNTER
TAD CLF /OUTPUT LINE FEED
JMP OUTX
/TAB HANDLER - TAB/RUBOUT
OUTRT, TAD CTAB
JMS I OUTDEV /OUTPUT TAB
CIF 10
JMS I POTYPE /TEST TYPE OF OUTPUT
SPA CLA /IS IT DIRECTORY DEVICE?
JMP I OUT /YES--RETURN--
TAD CRO /NO - OUTPUT RUBOUT
JMP OUTX
/TAB HANDLER - SPACES
OUTTAB, TAD TABIND
SNA CLA /OUTPUT TAB/RUBOUT INSTEAD?
JMP OUTRT /YES - GO TO OTHER TAB HANDLER
TAD TCNT /NO -
TAD MTABS /REDUCE SPACE COUNT TO 8 OR LESS
SMA
JMP .-2
DCA TCNT
TAD C240 /OUTPUT SPACES
JMS I OUTDEV
ISZ TCNT /DONE YET?
JMP .-3 /NO - CONTINUE
JMP I OUT /YES--RETURN--
/TELETYPE CHARACTER FETCH ROUTINE
/ENTER WITH AC CLEAR
/EXIT WITH CHARACTER IN CHAR AND AC
/FORCE CHANNEL 8
/BLANK TAPE & LEADER TRAILER IGNORED
CHIN, 0
DCA CHAR /CLEAR CHARACTER
JMS I KEYBD
AND P177 /MASK PARITY
SNA /IGNORE BLANK AND L/T
JMP CHIN+1
TAD C200 /RESTORE CHARACTER
JMS I OUT1 /ECHO INPUT
TAD CHAR
JMP I CHIN /--RETURN--
/LPT MUST! BE ON THIS PAGE FOR SET(ADDRESS OF LPT IN 3177)
LPT, 0 /*WM* NEW LPT ROUTINE FOR SETS
CMA /NOP OR CMA
6574 /OR OTHER PRINTING IOT
6577 /STROBE FOR PRINTRONIX
CLA
6570 /OR OTHER SKIP IOT
JMP .-1
JMS I (COPSQ /CHECK KEYBOARD
JMP I LPT
/MORE STUFF MAY BE INSERTED HERE
/LITERALS
PAGE
*3200
/********************************************************************
/CODE MOVED TO 16600-16762
NOPUNC
*6600
ENPUNC
/OURECS=4
/SETUP FOR USING GENERAL INPUT, OUTPUT ROUTINES
INBUF=4200 /INPUT BUFFER AT 04200
INCTL=0600 /INPUT CONTROL - 6 PAGES
INRECS=3 /3 RECORDS INTO FIELD 0
INDEVH=3200 /INPUT HANDLER AT 03200
OUBUF=5600 /OUTPUT BUFFER AT 05600
OUCTL=5000 /OUTPUT CONTROL - 8 PAGES
OUDEVH=3600 /OUTPUT HANDLER AT 03600
MPARAM=7643 /OPTION SWITCHES
JMS I L7700 /CALL USER SERVICE ROUTINES
10 /*LOCK USR IN CORE*
CDF 0 /V3
ISZ I PTEMP /V3 WERE WE CHAINED TO?
JMP CHN /V3 YES
CDF 10 /V3 NO
START1, JMS I L200 /CALL USER SERVICE ROUTINES
5 /*COMMAND DECODER*
0
CHN, CDF 10
TAD K7620 /RESET OUTDMP
DCA I THOLE
TAD I P7600A /OUTPUT LIST
AND C17
SZCL, SZA CLA /IS THERE AN OUTPUT DEVICE?
JMP NXTOP /YES
CDF 0 /NO-DISALLOW E COMMAND
ISZ I EKILSW
CDF 10
NXTOP, TAD I PARAM
RAL /B BIT TO BIT 0
DCA DVHAND /SAVE PARAM. SWITCH
TAD DVHAND
SMA CLA /WAS /B OPTION SPECIFIED?
JMP NEWOP /NO
P7600A, 7600 /YES-
TAD SZCL /SET UP TO CONVERT SPACES TO TABS
CDF 0
DCA I SPCP1
CDF 10
NEWOP, TAD DVHAND
RTL
SMA CLA /WAS /D OPTION SPECIFIED?
JMP FILOP /NO
TAD I OHANDL /YES-HANDLER BROUGHT IN FOR D OPTION
DCA DVHAND
TAD I P7600A /DEVICE NUMBER
JMS I L200 /CALL USER SERVICE ROUTINES
1 /*ASSIGN*
DVHAND, 0
JMS HGHERR /**DEVICE HANDLER ERROR**4**
4
TAD I P7600A /GET DEVICE NUMBER
JMS I L200 /CALL USER SERVICE ROUTINES
4 /*CLOSE*
7601
0
JLSTN, LSTN /PAGE ZERO. 'AND' SOME ADDRESS
FILOP, TAD PANIC /PANIC CASE?
SNA
JMS I IOPENI /SET BUFFER POINTERS OR RESTORE HANDLER
SZA CLA /YES-
JMP GINDVH /RESTORE INPUT DEVICE HANDLER IN PANIC MODE
PANOPN, JMS I OOPENI /OPEN OUTPUT FILES
SMA CLA /ERROR RETURN
SKP /NORMAL RETURN
JMS HGHERR /**FILE OPEN ERROR**3**
3
TAD PANIC /PANIC CASE?
SNA CLA
JMP NOPAN /NO
TAD I P7600A /YES IF NO OUTPUT,DON'T ALLOW HIM
SNA CLA /TO DESTROY HIS TEXT
JMP START1
TAD K5000 /SET TO WRITE BUFFER
JMS I ODMP /DUMP IT
JMS HGHERR /**FATAL WRITE ERROR**1**
1
CLA IAC
NOPAN, DCA DVHAND
DCA PANIC /CLEAR PANIC SWITCH
JMS I L200 /CALL USER SERVICE ROUTINES
11 /*DISMISS USR FROM CORE*
JMS I OUSTPI /RE-INITIALIZE OUTPUT POINTERS
CLA IAC
JMS I SETJSI
CDF 0 /IF LSTN#0, CLEAR FRST
TAD I JLSTN /BUT IN FIELD 1
SNA CLA
DCA FRST
CIF CDF 0
TAD DVHAND
SNA CLA /PANIC MODE?
JMP I STRTUP /NO-START THE EDITOR
TLS
JMP I .+1 /YES - RESUME OUTPUT
BUFRET
GINDVH, CDF CIF 0
JMP I .+1
PIASGN
HGHERR, 0
TAD I HGHERR
DCA HGHARG
JMS I L200 /CALL USER SERVICE ROUTINES
11 /*DISMISS USR FROM CORE*
CIF 0
JMS I LOWERR /CALL FIELD 0 ERROR ROUTINE
HGHARG, 0
LOWERR, DEVERR
SETJSI, SETJSB
L200, 200
STRTUP, START
PANIC, 0
SPCP1, SPACES+1
IOPENI, IOPEN
OOPENI, OOPEN
EKILSW, EKILLL
ODMP, OUTDMP
OHANDL, O1
C17, 17
PARAM, MPARAM
L7700, 7700
K5000, 5000 /OUTPUT BUFF CONTROL WORD
OUSTPI, OUSETP
THOLE, TSTHOL
K7620, 7620
PTEMP, TEMP
/***********************************************************************
*3400
/***********************************************************************
/CODE MOVED TO 17000-17173
NOPUNC
*7000
ENPUNC
232 /THIS PAGE IS ^Z BUFFER
/SET UP ROUTINE FOR OUTPUT
/INITIALIZES CHARACTERS POINTERS
OUSETP, 0
TAD I PANICJ /IS IT PANIC DUMP TIME?
SZA CLA /IF YES, DONT RESET POINTERS
JMP I OUSETP /--RETURN--
TAD C1 /GET SIZE OF BUFFER IN DOUBLEWORDS
CIA /NEGATE IT
DCA OUDWCT
TAD C2
DCA OUPTR /INITIALIZE WORD POINTER
TAD OUJMPE
DCA OUJMP /INITIALIZE THREE-WAY CHARACTER SWITCH
JMP I OUSETP /--RETURN--
/OUTPUT A CHARACTER
/ENTER WITH CHARACTER IN 8-BIT ASCII
/IN AC
OCHAR, 0
AND C377 /MASK OUT EXTRA BITS
DCA OUTEMP
TAD PAR200 /MASK PARITY
KRS
TAD M203
SNA CLA
KSF
JMP .+3
CIF CDF 0
JMP I C7600
RDF /NO-
TAD CDIF0
DCA OUCRET
TAD OUTINH /IS OUTPUT INHIBITED?
SZA CLA
JMP PSTOP /NO
CDF OUFLD /YES-SET DATA FIELD TO BUFFER'S FIELD
ISZ OUJMP /BUMP THE CHARACTER SWITCH
OUJMP, HLT /3 WAY CHARACTER SWITCH
JMP OCHAR1
JMP OCHAR2
OCHAR3, TAD OUTEMP
CLL RTL
RTL
AND K7400
TAD I OUPOLD
DCA I OUPOLD /UPDATE FIRST WORD OF TWO WITH HIGH
/ORDER 4 BITS OF 3RD CHAR
TAD OUTEMP
CLL RTR
RTR
RAR
AND K7400
TAD I OUPTR
DCA I OUPTR /UPDATE SECOND WORD FROM LOW ORDER 4 BITS
TAD OUJMPE
DCA OUJMP /RESET SWITCH
ISZ OUPTR
ISZ OUDWCT /BUMP DOUBLEWORD COUNTER EVERY 3 CHARS
JMP OUCOMN
TAD OUCT /LOAD CONTROL WORD FOR A FULL WRITE
JMS I DMPO /DUMP THE BUFFER
JMP OUCRET /OUTPUT ERROR - GIVE ERROR RETURN
JMS OUSETP /RE-INITIALIZE THE POINTERS
JMP OUCOMN
OCHAR2, TAD OUPTR
DCA OUPOLD /SAVE POINTER TO FIRST WORD OF TWO
ISZ OUPTR /BUMP WORD POINTER TO SECOND WORD
OCHAR1, TAD OUTEMP
DCA I OUPTR
OUCOMN, ISZ OCHAR
OUCRET, HLT /RESTORE CALLING FIELDS
JMP I OCHAR /--RETURN--
OUTEMP, 0
OUPOLD, 0
OUPTR, 0
OUJMPE, JMP OUJMP
OUDWCT, 0
OUTINH, 0
/FETCH OUTPUT DEVICE CONTROL WORD
OTYPE, 0
RDF
TAD CDIF0
DCA OTRTN
CDF 10
TAD I C7600 /FETCH OUTPUT DEVICE NUMBER
AND P17
TAD DCBM1 /+DCB-1
DCA OUTEMP /FETCH DEVICE CONTROL WORD
TAD I OUTEMP
OTRTN, HLT /RESTORE CALLING FIELDS
JMP I OTYPE /--RETURN--
PSTOP, CIF 0 /PRINTS ? WHEN NO OUTPUT DEV
ERROR
INSET, 0
DCA OTYPE /SAVE AC
RDF
TAD CDIF0
DCA INSTRT /SET RETURN FIELDS
CDF 0
TAD I PLASTN
CDF 10
SNA CLA /IS THERE ANYTHING IN BUFFER?
IAC /NO-NO NEED TO SAVE USR AREA
JMS SETJSB /YES-
TAD OTYPE /RESTORE AC
INSTRT, CIF CDF 0 /RESTORE CALLING FIELDS
JMP I INSET /--RETURN--
/SET JOB STATUS BIT 11 TO SAVE OR NOT SAVE
/ENTER WITH AC=0 OR 1, DEPENDING ON BUFFER
SETJSB, 0
DCA JSBTM /SAVE AC
CDF 0
CLA CLL CMA RAL
AND I PJSBTS /CLEAR BIT 11 OF JSW
TAD JSBTM /SET ACCORDING TO AC
DCA I PJSBTS
CDF 10
JMP I SETJSB /--RETURN--
JSBTM, 0
PJSBTS, 7746
PLASTN, LSTN
DCB=7760
C1, OUCTL&3700
C2, OUBUF
C377, 377
PAR200, 200
M203, -203
CDIF0, CDF CIF 0
K7400, 7400
OUCT, OUCTL
C7600, 7600
P17, 17
DCBM1, DCB-1
DMPO, OUTDMP
PANICJ, PANIC
/***********************************************************************
*3600
/***********************************************************************
/CODE MOVED TO 17200-17376
NOPUNC
*7200
ENPUNC
/OPEN OUTPUT FILE
O17, 17
OOPEN, 0
OU7600, 7600
TAD OU7601
DCA OUBLK
TAD O1
DCA OUHNDL /SET OUTPUT HANDLER ENTRY
CDF 10
TAD I OU7600 /GET DEVICE NUMBER WORD OF OUTPUT FILE ENTRY
SNA /IS THERE AN OUTPUT DEVICE?
JMP ONOFIL /NO - INHIBIT OUTPUT
JMS I O200 /CALL USER SERVICE ROUTINES
1 /*ASSIGN,FETCH HANDLER*
OUHNDL, 2600 /OUTPUT DEVICE HANDLER ENTRY
JMS I SERRA /**DEVICE HANDLER ERROR**4**
4
OUENTR, TAD I OU7600
JMS I O200 /CALL USER SERVICE ROUTINES
3 /*ENTER OUTPUT FILE*
OUBLK, 7601 /REPLACED WITH STARTING BLOCK
OUELEN, 0 /REPLACED WITH LENGTH OF HOLE
JMP OEFAIL /FAILED - MAYBE WE ASKED TOO MUCH
DCA OUCCNT
DCA I O2 /ZERO OUTPUT INHIBIT FLAG
TAD OUBLK
DCA OUREC /INITIALIZE OUTPUT RECORD NUMBER
JMS I O3
ISZ OOPEN
OORETN, JMP I OOPEN
OEFAIL, TAD I OU7600
AND O7760 /GET REQUESTED LENGTH
SNA CLA /WAS IT AN INDEFINITE REQUEST
JMP ONTERR /YES - CANNOT ENTER THE FILE
TAD I OU7600
O200, AND O17 /MAKE THE REQUESTED LENGTH ZERO
DCA I OU7600
JMP OUENTR /TRY, TRY AGAIN
ONTERR, CLA CLL CML RAR /AC=2
JMP OORETN /TAKE THE ERROR RETURN WITH AC<0
ONOFIL, ISZ I O2
JMP OORETN /TAKE THE ERROR RETURN WITH AC=0
OUTDMP, 0
DCA OUCTLW /STORE THE CONTROL WORD
JMS OUNREC /COMPUTE NO. OF RECORDS
TAD OUCCNT
DCA OUCCNT
TAD OUCCNT
CLL CML
TAD OUELEN
TSTHOL, SNL CLA /IF ZERO OR POSITIVE,GIVE ERROR
JMP OUERR
CDF CIF 0
CDF 10
JMS I OUHNDL /CALL OUTPUT DEVICE HANDLER
OUCTLW, 0 /CONTROL WORD
OUBUF /BUFFER ADDRESS
OUREC, 0 /RECORD NUMBER
JMP OUERR /THERE ARE NO SOFT OUTPUT HANDLER ERRORS
JMS OUNREC
TAD OUREC
DCA OUREC /UPDATE OUTPUT RECORD NUMBER
ISZ OUTDMP /BUMP OUTDMP TO NORMAL RETURN
OUERR, JMP I OUTDMP /--RETURN--
/CLOSE OUTPUT FILE
OCLOSE, 0
TAD K7660 /SET UP SNL SZA CLA FOR CLOSE
DCA TSTHOL
CDF 10
TAD I PANICC
SZA CLA
JMP NODUMP
TAD I O2
SZA CLA /IS OUTPUT INHIBITED?
JMP OCISZ /YES - CLOSE IS A NOP
TAD O232 /OUTPUT A ^Z
JMS I O4
JMP OCRET /AND SOME 0'S
JMS I O4
JMP OCRET
FILLLP, JMS I O4
JMP OCRET
JMS I O5 /GET TYPE OF OUTPUT DEVICE
SPA CLA
TAD O100 /IF ITS A DIRECTORY DEVICE FORCE A RECORD
TAD O77 /BOUNDARY-OTHERWISE HALF RECORD
AND I O6
SZA CLA /UP TO THE BOUNDARY YET?
JMP FILLLP /NO - FILL WITH ZEROS
TAD I O6 /GET DOUBLEWORD COUNT LEFT
TAD O7
SNA /A FULL WRITE LEFT?
JMP NODUMP /YES - DON'T DO IT - ^Z IS ALREADY OUT
TAD O8 /PUT IN FIELD BITS AND WRITE BIT
JMS OUTDMP
JMP OCRET /ERROR OCCURRED WHILE DUMPING THE BUFFER
NODUMP, JMS I O7700 /CALL USER SERVICE ROUTINES
10 /*LOCK USR IN CORE*
TAD I OU7600 /DEVICE NUMBER
JMS I O200 /CALL USER SERVICE ROUTINES
4 /*CLOSE OUTPUT FILE*
OU7601, 7601 /POINTER TO THE OUTPUT FILE NAME
OUCCNT, 0
SKP /ERROR WHILE CLOSING THE FILE
OCISZ, ISZ OCLOSE
OCRET, CIF CDF 0 /RESTORE CALLING FIELDS
JMP I OCLOSE /--RETURN--
PANICC, PANIC
/CONVERT OUTPUT CONTROL WORD
/TO NUMBER OF RECORDS
OUNREC, 0
TAD OUCTLW
CLL RTL
RTL
RTL
AND O17
JMP I OUNREC /--RETURN--
K7660, SNL SZA CLA
O1, OUDEVH+1
O7700, 7700
O2, OUTINH
O3, OUSETP
O7760, 7760
O232, 232
O4, OCHAR
O5, OTYPE
O100, 100
O77, 77
O6, OUDWCT
O7, OUCTL&3700
O8, 4000+OUFLD
SERRA, HGHERR
/***********************************************************************
INFLD=INCTL&70 /FIELD OF INPUT BUFFER
OUFLD=OUCTL&70 /FIELD OF OUTPUT BUFFER
/***********************************************************************
/CODE MOVED TO 17400 -17574
*4000
NOPUNC
*7400
ENPUNC
/PREPARE TO OPEN NEW INPUT FILE
IN7400, 7400
IOPEN, 0
CLA CMA
DCA INCHCT /SET INCHCT TO FORCE A READ
ISZ INEOF /SET END-OF-FILE FLAG TO FORCE A NEW FILE
TAD I7617
DCA INFPTR /RESET FILE POINTER
JMP I IOPEN /--RETURN--
INPTR, 0
INDEV, 0
/INPUT A CHARACTER
ICHAR, 0
IN7600, 7600
INCHAR, CDF INFLD
ISZ INJMP /BUMP THREE-WAY UNPACK SWITCH
ISZ INCHCT
INJMPP, JMP INJMP
TAD INEOF
SNA CLA /DID LAST READ YIELD END-OF-FILE?
JMP INGBUF /NO-DO ANOTHER
INNEWF, CDF 10
TAD I1
DCA INHNDL /INITIALIZE HANDLER ADDRESS
TAD I INFPTR /GET NEXT CD INPUT FILE ENTRY
DCA INDEV /SAVE IT FOR PANIC
TAD INDEV
SNA /ANY MORE?
JMP EOFERR /NO - OUT OF INPUT
JMS I PINSET /YES-SAVE BUFFER IF NECESSARY
JMS I I7700 /CALL USER SERVICE ROUTINE
1 /*ASSIGN, FETCH HANDLER*
INHNDL, 0
JMS I SERRB /**DEVICE HANDLER ERROR**+**
4
TAD I INFPTR
AND I7760 /GET LENGTH PART OF WORD
SZA /LENGTH OF 0 MEANS LENGTH >=256
TAD I17 /ADD HIGH ORDER BITS
CLL CML RTR
RTR
DCA INCTR /STORE LENGTH OF FILE
ISZ INFPTR
TAD I INFPTR
DCA INREC /STORE STARTING RECORD NUMBER OF FILE
ISZ INFPTR
DCA INEOF /ZERO END-OF-FILE FLAG
INGBUF, TAD INCTR
CLL
TAD I2
SNL
DCA INCTR /RESTORE INCTR IF IT HASN'T OVERFLOWED
SZL /IS THIS THE LAST READ?
ISZ INEOF /YES - SET END-OF-FILE FLAG
CLL CML CMA RTR /CONSTRUCT A CONTROL WORD FOR THE READ
RTR /FROM THE AMOUNT OF THE OVERFLOW
RTR /(IF ANY) AND THE STANDARD CONTROL WORD
TAD I3
DCA INCTLW
CDF CIF 0
CDF 10
JMS I INHNDL /CALL INPUT DEVICE HANDLER
INCTLW, 0 /CONTROL WORD
INBUFP, INBUF /INPUT BUFFER
INREC, 0 /NUMBER OF RECORDS
JMP INERRX /SOME KIND OF HANDLER ERROR
INBREC, TAD INREC
TAD I2
DCA INREC /UPDATE THE RECORD NUMBER
TAD INCTLW
AND IN7600
CLL RAL
TAD INCTLW
AND IN7600
CMA
DCA INCHCT /COMPUTE THE NEW CHARACTER COUNT
TAD INJMPP
DCA INJMP /RESET THE CHARACTER SWITCH
TAD INBUFP
DCA INPTR /AND THE WORD POINTER
JMP INCHAR /GO BACK AND MAKE BELIEVE THIS NEVER HAPPENED
INERRX, ISZ INEOF /EITHER AN END-OF-FILE OR A ERROR
SMA CLA /WHICH TYPE WAS IT?
JMP INBREC /END OF FILE - RESUME PROCESSING
INERR, CLA CLL CML RAR /BAD - GIVE ERROR RETURN WITH NEGATIVE AC
EOFERR, JMP INRTRN
INJMP, HLT /3 WAY CHARACTER SWITCH
JMP ICHAR1
JMP ICHAR2
ICHAR3, TAD INJMPP
DCA INJMP
TAD I INPTR
AND IN7400
CLL RTR
RTR /COMBINE THE HIGH-ORDER FOUR BITS OF
TAD INCTLW
RTR /THE TWO WORD TO FORM THE THIRD CHARACTER
RTR
ISZ INPTR
JMP INCOMN
ICHAR2, TAD I INPTR
AND IN7400
DCA INCTLW /SAVE THE HIGH-ORDER BITS FOR THE THIRD CHAR
ISZ INPTR /BUMP THE WORD POINTER
ICHAR1, TAD I INPTR
INCOMN, AND I377
TAD IM232
SNA /IS THE CHARACTER A ^Z?
JMP INNEWF /YES - GET A NEW FILE
TAD I232 /RESTORE THE CHARACTER
ISZ ICHAR /BUMP RETURN TO NORMAL RETURN
INRTRN, CDF CIF 0 /RESTORE CALLING FIELDS
JMP I ICHAR /--RETURN--
INCHCT, -1
INFPTR, 7617
INEOF, 1
INCTR=IOPEN
PINSET, INSET
I7617, 7617
I1, INDEVH+1
I7760, 7760
I17, 17
I2, INRECS
I3, INCTL+1
I377, 377
IM232, -232
I232, 232
I7700, 7700
SERRB, HGHERR
$
/***********************************************************************