Trailing-Edge
-
PDP-10 Archives
-
mit_emacs_170_teco_1220
-
emacs/teco.mid
There is 1 other file named teco.mid in the archive. Click here to see a list.
; -*-MIDAS-*-
;[TOED.XKL.COM]DXX:<EMACS>XKLTECO.1212.11, 25-Mar-96 15:40:14, Edit by ALDERSON
; Work begun on *this* version of TECO 14 March 1996
; I'm going to call it 1220--it has some major clean-ups and local fixes.
;
; The following documentation has been added while updating the code to contain
; the Stanford and SIMTEL20 changes to an earlier version of TECO (c. 1180).
; The basis of the update was Bill Westfield's addition of his changes to 1209,
; brought up to 1212. Additional changes from Kirk Lougheed and Greg Satz have
; at Stanford, and Frank Wancho at SIMTEL20, been added as necessary, and some
; of the commentary for same added to this version.
;
; The Stanford EMACS prior to 165 was 162, based on TECO 1180 (as far as I can
; tell).
;
; From TECO.MID.118037:
;<EMACS162>TECO.MID.118037, 7-Jan-85 16:01:56, Edit by SATZ
;<EMACS162>TECO.MID.118035, 18-Dec-84 14:35:29, Edit by SATZ
;<EMACS162>TECO.MID.118032, 28-Nov-84 18:24:08, Edit by SATZ
;<EMACS162>TECO.MID.118031, 28-Nov-84 18:07:25, Edit by SATZ
;<EMACS162>TECO.MID.118030, 25-May-84 17:29:17, Edit by LOUGHEED
;<EMACS162>TECO.MID.118029, 23-May-84 00:11:46, Edit by LOUGHEED
;<EMACS162>TECO.MID.118028, 21-May-84 03:19:50, Edit by LOUGHEED
;<EMACS162>TECO.MID.118027, 21-May-84 02:37:33, Edit by LOUGHEED
;<EMACS162>TECO.MID.118025, 29-Sep-83 23:43:05, Edit by LOUGHEED
;<EMACS162>TECO.MID.118024, 29-Sep-83 18:31:28, Edit by LOUGHEED
;<EMACS162>TECO.MID.118023, 29-Sep-83 18:00:29, Edit by LOUGHEED
;<EMACS162>TECO.MID.118020, 28-Sep-83 13:41:27, Edit by LOUGHEED
;<EMACS162>TECO.MID.118019, 27-Sep-83 23:10:54, Edit by LOUGHEED
; How about we start an edit history for changes at Stanford?
; - added Freedom-100/200 support
; - merged in changes from GSB for Hazeltine Esprit support
; - made H19 character insert pad differently so that the H29 will work
; - use GTHST to get host name instead of hardwired of CVHST
; - fix assembly error in INIDLM from previous edits
; - add ANSI, AVT, AVTX support
; - Make sure the terminal gets reset after continuing from the HALTF%
; (Same change made to MIT sources between 1208 and 1209)
;
; The "standard Stanford EMACS" was version 165 for the last decade. This was
; Bill Westfield's version, which used TEXTI% for input. It diverged from the
; other Stanford stream after edit 118030; only comments after that are
; retained here.
;
; From XTECO.MID.121705 28-Mar-85 09:56:37 (equivalent to TECO.MID.16502):
;
;[SU-SCORE.ARPA]PS:<EMACS165>XTECO.MID.5, 4-Mar-85 01:17:58, Edit by BILLW
; call XTXTI1 on ctrl-C to remove waiting line of text from tty input buf.
;[SU-SCORE.ARPA]PS:<EMACS165>XTECO.MID.2, 19-Feb-85 15:11:55, Edit by BILLW
; change name from STECO to XTECO. Look into not recalculating break mask
; every time we decide that we want to do a TEXTI.
;[SU-SCORE]PS:<EMACS165>STECO.MID.35, 16-Feb-85 19:27:07, Edit by BILLW
; do the code for using INSERT mode more effectively.
;[SU-SCORE]PS:<EMACS165>STECO.MID.33, 16-Feb-85 17:59:40, Edit by BILLW
; "fix" XTXTI1 - if we interupt out of a TEXTI, simulate the completion of the
; system call by doing a SIN, reseting terminal modes, etc. The new code
; prevents redoing (and redisplaying) the entire string read so far.
;[SU-SCORE]PS:<EMACS165>STECO.MID.25, 14-Feb-85 12:19:31, Edit by BILLW
; add TEXTI support. re-Add AVT and SUN terminal types
;<EMACS165>STECO.MID.3, 10-Feb-85 00:06:48, Edit by BILLW
; efficiency improvements (I hope). Have DDPYTB flush characters (using
; %TFLSH) that are buffered in the individual terminal routines.
;
; Enhancements to this were numbered as if TECO and EMACS were one and the same
; (so TECO.MID.16504 and .16507). The version used at cisco Systems was .16504
; and at SIMTEL20 was .16507:
;
;[SIMTEL20.ARPA]PS:<EMACS165>TECO.MID.16507, 6-May-86 22:59:55, Edit by WANCHO
; Added VT102 (same as ANSI, which also uses the VT132 dispatch table.
;[SIMTEL20.ARPA]PS:<EMACS165>TECO.MID.16506, 2-Mar-86 14:18:01, Edit by WANCHO
; Add (fs)TTYNBR, the tty's .CTTRM number for setting terminal type
; for fixed local terminals which may not be known to the EXEC.
;
;[SU-SCORE.ARPA]PS:<EMACS165>TECO.MID.16504, 21-Sep-85 00:44:33, Edit by BILLW
; Add AJ510 terminal type (original code from SRI-AI).
;[SU-SCORE.ARPA]PS:<EMACS165>TECO.MID.16503, 15-Jul-85 18:25:04, Edit by BILLW
; make conversion of user number to directory number more general
;
; There *was* an edit 16505 at Stanford, which I document here for completeness
; only, but it was much later than the undocumented 16505 lost between Stanford
; and SIMTEL20.
;
;[MACBETH.STANFORD.EDU]3072:<EMACS165>TECO.MID.16505, 22-Feb-91 09:57:35, Edit by A.ALDERSON
; Add X66, X43, and X55 terminal types: XTERM windows 80x66, 80x43, and 80x55
; respectively.
;
;------------------------------------------------------------------------------
;
; The MIT changes between 1210 and 1211, and between 1211 and 1212, were not
; documented in the headers. All such changes must have taken place before
; I, Rich Alderson, got the sources via FTP on 10-Nov-87 at 11:38:44 (Pacific
; Standard Time).
;
; 1211 => 1212:
; Change error-handling at WINIT3
;
; 1210 => 1211:
; Add TM%SCR to RTMOD call in SETTTM
; Make no arg to F6 branch to FSIXR instead of FCTLK0
;
;[MIT-OZ]OZ:<EMACS>TECO.MID.1210, 2-Aug-85 13:15:37, Edit by GZ
;Increase symtab, merge AJ510 term type from UDC. Make the long filename
;code for ITS work.
;;;The following comment, inserted in historical order, was the content of the
;;;file TECO.CHANGES:
;[WASHINGTON]PS:<EMACS>TECO.CHANGES.2, 11-Nov-83 16:22:48, Edit by FHSU
;This file documents very recent changes to MIT TECO.1209
;
;new FS flags:
; :i*UserName$FS USRNUM ==> user number for 'UserName' (TNX)
; FS X USRNUM ==> self's user number (TNX)
; <usrnum>FS U MAIL FILE ==> 0 if user doesn't have local mailbox (TNX)
; FS TTYNBR ==> number of current .CTTRM (TNX)
; <n>FS SCRINV ==> see MODE2.EMACS for usage
; FS IF REAP -- made to work for TNX also...
; FS OF FDB -- like FS IF FDB...
;
;Changed:
; :EZ -- ":" means get deleted files also (VD,<CRLF>DEL<CRLF><CRLF>)
; @EZ -- "@" means get invisible files also, with ;OFFLINE attribute
; (These will be useful for DIRED...)
; Analogous for EL, EM, EY, ...
; <m>,<n>EI -- <m> = deleted ok, <n> = OPENF% bits in AC2
; Analogous for EW...
;
;Files:
; TNX/20X users need 3 files: TECO.MID, CONFIG.MID, and TECTRM.MID
; TECO was split into TECO and TECTRM so that the terminal routines
; may have their own edit versions, added to, etc. without having to
; get a new TECO.MID each time - just distribute the TECTRM. also,
; it gives us a little breathing room for editing TECO...
;[WASHINGTON]PS:<EMACS>TECO.MID.1209, 10-Nov-83 19:02:30, Edit by FHSU
; NOTE: A CONFIG.MID file is used to customize TECO to a site.
; A TECTRM.MID file is used to customize TECO to terminal types.
;-----------------------------------------------------------------------------
;ITS TECO was built by RMS on the work of others
;at the MIT Artificial Intelligence Lab
;(not to be confused with the Laboratory for Computer Science).
;It was converted to run on Twenex by MMCM at SRI.
;
;TECO is available to those who like the way it is,
;on a basis of communal co-operation:
;you are welcome to make improvements, but only if you consult
;with the other user sites, and send your changes
;to MIT to be merged in and distributed to everyone.
.SYMTAB 13997. ;SHOULD BE PLENTY
TITLE TECO
; RESET THE SYSTEM CONDITIONALS NOT SPECIFIED BY /T AT ASSEMBLY TIME.
IFNDEF ITS, ITS==0
IFNDEF 10X, 10X==0
IFNDEF FNX, FNX==0
IFNDEF 20X, 20X==0
IFG ITS+10X+FNX+20X-1, .FATAL TWO OPERATING SYSTEMS SPECIFIED
; IF NO SYSTEM SPECIFIED THEN DEFAULT TO THE ONE WE'RE ASSEMBLING ON.
IFE ITS\10X\FNX\20X,[
IFE .OSMIDAS-SIXBIT/ITS/, ITS==1
IFE .OSMIDAS-SIXBIT/TENEX/, 10X==1
IFE .OSMIDAS-SIXBIT/TWENEX/,20X==1
]
IFE ITS\10X\FNX\20X, .FATAL NO OPERATING SYSTEM SPECIFIED
TNX==:10X\FNX\20X ;TNX MEANS EITHER TENEX OR TWENEX
;FOR NOW, FNX JUST TURNS ON SOME CROCKS
;HOPEFULLY, LATER IT WILL MEAN COMND JSYS,
;VTS, ETC.
IFN TNX,[
IFNDEF EMCSDV,EMCSDV==0 ;NONZERO CAUSES TRANSLATION OF <EMACS> TO
;EMACS: FOR 20X.
IFNDEF INFODV,INFODV==0 ;SAME FOR INFO: AND <INFO>
IFNDEF ETDEF,ETDEF==37 ;FS:ETMODE$ DEFAULT VALUE
IFNDEF EXITCL,EXITCL==0 ;CLEAR THE SCREEN WHEN EXITING OR RUNNING AN
;INFERIOR
IFNDEF COMNDF,COMNDF==20X ;USE COMND JSYS FOR :ET, WORKS ON TWENEX REL
; >= 3
IFNDEF SUMTTF,SUMTTF==0 ;SUMEX TTY CODE FOR TENEX
IFN SUMTTF,STCHA=JSYS 633 ;SET HOLD CHARACTER
IFNDEF LINSAV,LINSAV==0 ;ASSUME TWENEX DOESN'T HAVE SUPDUP CAPABILITY
IFNDEF DREA,DREA==0 ;DON'T INSTALL DREA CHANGES (MOSTLY FOR
;CONCEPTS) YET
IFNDEF STANSW, STANSW==0 ;STANFORD MODIFICATIONS
IFNDEF TEXTIF, TEXTIF==0 ;[wew] SPECIAL FLAG FOR SMART TEXTI FOR TOPS-20
.DECSAV
IF1 [IFN 20X [
.INSRT SYS:TNXDFS
.TNXDF
.INSRT SYS:TWXBTS
]];IFN 20X, IF1
];IFN TNX
IFN ITS,[
.SBLK
LINSAV==1
IFNDEF MAXLBL,MAXLBL==400 ;HIGHEST LABEL NUMBER WE CAN HANDLE, FOR LINE SAVING.
COMNDF==0
IFN .OSMIDAS-SIXBIT/ITS/,[
IF1 [
.INSRT SYS:ITSDFS
.ITSDF
.INSRT SYS:ITSBTS
]]
]
GLITCH==177
ALTMOD==33
IFN ITS,EOFCHR==3 ;PADDING CHARACTER FOR FILES.
IFN TNX,EOFCHR==0
IFN ITS,PAGSIZ==2000 ;PAGE SIZE, IN WORDS.
IFN TNX,PAGSIZ==1000
IFN TNX,.INSRT CONFIG ;READ SITE-SPECIFIC DEFINITIONS.
IRPS AC,,FF A B C D E J BP T TT TT1 IN OUT CH Q P
AC=.IRPCNT
TERMIN
A0==TT ;ACS FOR .I PSEUDO.
A1==TT1
.XCREF FF,P,A,B,C,IN,OUT,CH,T
IFN 0,[ ;I HOPE THAT EVERYTHING THAT DEPENDS ON ORDER OF ACS
MUL: MULI: DIV: DIVI: IDIV: IDIVI: ;WILL X-REF TO ONE OF THESE.
ROTC: ASHC: LSHC: CIRC:
BLT: JFFO:
.OPEN: .RDATIM:
]
IFN ITS,[
CHTTYI==1
CHFILI==3
CHFILO==4
CHRAND==6 ;FOR READING FILE DIRECTORIES
CHDPYO==7 ;BLOCK MODE DISPLAY OUTPUT FOR ASSEMBLED-IN ^P-CODE STRINGS.
CHERRI==11
CHECHO==12 ;ECHO-MODE OUTPUT FOR RUBOUT.
CHSIO==14 ;SUPER IMAGE OUTPUT.
CHTTYO==15 ;NORMAL TYPEOUT.
CHJRNI==16 ;JOURNAL FILE INPUT.
CHJRNO==17 ;JOURNAL FILE OUTPUT.
TYPIN==1_<CHTTYI>
TSMSK==%PJATY\%PJWRO\%PJRLT,,%PIPDL+%PIMPV
TSMSK1==TYPIN
%TSNEA==1000 ;BIT 4.1 IN TTYSTS: ECHO IN MP AREA EVEN IF AN ECHO AREA EXISTS.
;FOR THE SAKE OF THE ECHOIN SYSTEM CALL AND RRECIN.
OPNLBP==220600 ;B.P. TO OPEN LOSS CODE IN CHANNEL STATUS.
];IFN ITS
;LOCAL EDITING IN THE TERMINAL
%TRLED==100000 ;BIT IN TTYSMT, WHICH SAYS TERMINAL CAN DO LOCAL EDITING.
%TRLSV==034000 ;THESE BITS GIVE MAX LABEL FOR LINE SAVING, AS LOG BASE 4.
%TDSYN==240 ;%TDSYN code charcount IS A REPLY TO A RESYNCH FROM THE TERMINAL.
%TDECO==241 ;REQUESTS USE OF REMOTE (IN-TERMINAL) ECHOING FEATURE.
;THIS JUST ASKS THE TERMINAL TO SEND US A RESYNCH IF IT CAN.
%TDEDF==242 ;SPECIFIES FUNCTIONS OF CONTROL CHARS.
;FOLLOWED BY 2 CHARS, WHICH MAKE UP 14 BITS,
;WHICH THEN DIVIDE INTO THE BOTTOM 9 BITS (CHARACTER CODE)
;AND THE TOP 5 BITS, WHICH SAY WHAT THAT CHARACTER DOES.
;THE FUNCTION CODES ARE DEFINED IN LMWIN;SUPDUP.
;TECO DOES NOT KNOW WHAT MOST OF THE CODES MEAN; TECO PROGRAMS DO.
;HOWEVER, CODE 31 MEANS RESET WORD SYNTAX OF CHAR (CTL BIT MEANS
;PART OF WORD),
;CODE 32 MEANS SELECT INSERT OR REPLACE MODE
; (LOW BIT OF CHAR = 1 FOR INSERT MODE),
;CODE 33 MEANS REINITIALIZE
; (CHARS 40 THRU 176 SELF-INSERT, OTHERS UNDEFINED;
; ONLY LETTERS ARE PART OF WORDS; INSERT MODE).
%TDNLE==243 ;SENT BY ITS, WHENEVER TTY SWITCHES JOBS,
;TO TELL TERMINAL TO STOP DOING LOCAL EDITING.
%TDTSP==244 ;JUST LIKE A SPACE, BUT SIGNIFIES THAT THE SPACE
;IS PART OF THE DISPLAY OF A TAB CHARACTER.
%TDCTB==245 ;THIS LINE BEGINS WITH A CONTINUATION.
%TDCTE==246 ;THIS LINE ENDS WITH A CONTINUATION.
%TDMLT==247 ;%TDMLT <N> <CH> SAYS NEXT <N> SCREEN POSITIONS REPRESENT ONE TEXT CHAR <CH>.
%TDSVL==250 ;%TDSVL <N> <L1> <L2> SAVE N LINES STARTING AT CURSOR
;UNDER LABELS STARTING WITH <L2>*7+<L1>
%TDRSL==251 ;INVERSE OPERATION: RESTORE <N> LINES.
%TDSSR==252 ;SET RANGE OF COLUMNS TO SAVE AND RESTORE. WE DON'T NEED THIS.
%TDSLL==253 ;SET LABEL FOR TERMINAL TO SAVE LINES UNDER. WE DON'T SUPPORT THIS.
SUBTTL FLAGS IN FF
;RIGHT HALF FLAGS
FR==525252 ;BIT TYPEOUT PREFIX.
FRARG==1 ;THIS COMMAND HAS A POSTCOMMA ARG
FRARG2==2 ;THIS COMMAND HAS A PRECOMMA ARG
FRCLN==4 ;THIS COMMAND WAS GIVEN THE COLON MODIFIER
FRUPRW==10 ;THIS COMMAND WAS GIVEN THE ATSIGN OR UPARROW MODIFIER.
FRALT==20 ;RANDOM FLAG USED BY SEVERAL COMMANDS
FROP==40 ;SET WHEN ARITH OP NEEDS A RIGHT ARG.
FRSYL==200 ;A SYLLABLE IS AVAIL TO USE AS RIGHT OPERAND OF ARITH OP.
FRFIND==2000 ;FA AND FILENAME READER USE THIS.
FRQMRK==4000 ;LAST COMMAND STRING HAD ERROR; "?" IN COMMAND READER PRINTS LAST FEW CHARS.
FRNOT==10000 ;RANDOM FLAG USED BY SEVERAL COMMANDS
FRTRACE==20000 ;TRACE IN PROGRESS: PRINT TECO COMMANDS AS EXECUTED.
FRBACK==40000 ;SEARCH IN REVERSE (ARGUMENT NEGATIVE)
FRQPRN==100000 ;IN ('S SAVED FLAGS, 1 => THIS ( WAS A Q-REG NAME, SO
;CLOSE SHOULD RETURN TO QREGXR.
FRSPAC==200000 ;IN FA, PREVIOUS CHAR WAS A SPACE.
;LEFT HALF FLAGS
FL==1,,525252 ;BIT TYPEOUT PREFIX
FLNEG==1 ;DPT-ING A NEGATIVE NUMBER
FLDIRDPY==2 ;SET => LAST COMMAND WAS FILE COMMAND, SO DISPLAY DIR INSTEAD OF BUFFER
FLIN==200 ;INPUT FILE OPEN.
FLOUT==400 ;OUTPUT FILE OPEN
FLNOIN==400000 ;INSIDE ^R, 1 => THIS IS A ^ V, AND SHOULD READ NO INPUT.
SUBTTL OPCODES AND BITS
TYPR4=37000,,
NUUOS==1
CALL=PUSHJ P,
SAVE=PUSH P,
REST=POP P,
RET=POPJ P,
IF1 EXPUNGE EDIT ;STUPID WORTHLESS EXTENDED INSTRUCTION GETS IN THE WAY.
EXPUNGE DMOVE,DMOVEM ;TWENEX PEOPLE ARE TEMPTED TO USE THESE AND SCREW TENEX.
.XCREF CALL,REST,SAVE,RET
BP7==440700
;BITS IN 12-BIT AND 9-BIT CHARACTERS
CONTRL==200
META==400
SHIFT==1000
SHIFTL==2000
TOP==4000
SUBTTL DOUBLE-DOT Q-REGS
IFNDEF NQSETS,NQSETS==3
NQREG==<"Z-"A+1+"9-"0+1>*NQSETS
.QCRSR==10. ;..A HOLDS CURSOR.
.QBFDS==.QCRSR+1 ;..B HOLDS MACRO EXECUTED AT END OF CMD STRING IF BUFFER DISPLAY WANTED (FLDIRDPY IS OFF)
.QCPRT==.QBFDS+1 ;..C IS UNUSED
.QDLIM==.QCPRT+1 ;..D HOLDS DISPATCH FOR FW, "B, "C, ^B IN SEARCHES.
.QBASE==.QDLIM+1 ;..E HOLDS OUTPUT RADIX FOR = AND \. (INITIALY 10.)
.QCRMC==.QBASE+1 ;..F HOLDS ^R MODE SECRETARY MACRO.
.QFDDS==.QCRMC+1 ;..G HOLDS MACRO EXECUTED AFTER COMMAND STRING TO DISPLAY FILE DIRECTORY.
.QVWFL==.QFDDS+1 ;..H IS NONZERO IF THERE HAS BEEN TYPEOUT BY PRGM (SUPPRESS BUFFER DISPLAY)
.QPT1==.QVWFL+1 ;..I HOLDS WHAT . HAD AT START OF CMD STRING.
.QMODE==.QPT1+1 ;..J HOLDS "MODE" STRING, DISPLAYED ON THE --MORE-- LINE.
.QRRBF==.QMODE+1 ;..K HAS WHAT WAS KILLED IN ^R MODE.
.QRSTR==.QRRBF+1 ;..L HOLDS MACRO EXECUTED WHEN TECO IS $G'D.
.QLOCL==.QRSTR+1 ;..M IS UNUSED
.QUNWN==.QLOCL+1 ;..N HOLDS STRING MACROED BEFORE QREG UNWOUND.
.QBUFR==.QUNWN+1 ;..O HOLDS CURRENT BUFFER.
.QERRH==.QBUFR+1 ;..P HOLDS ERROR-HANDLER MACRO.
.QSYMT==.QERRH+1 ;..Q HOLDS SYMBOL TABLE SCANNED FOR Q<NAME> CONTRUCT.
.Q..Z==10.+"Z-"A ;..Z HOLDS SAME AS ..O, INITIALLY.
.QKS==0 ;..0, ..1, ..2 USED BY ^P SORT.
.QKE==1
.QDL==2
.Q..0==0 ;OTHER NAMES FOR ..0, ..1, ..2
.Q..1==.Q..0+1
.Q..2==.Q..1+1
.Q..3==.Q..2+1
IF2 [
$QCRSR==QTAB+36.*2+.QCRSR
$QCRMC==QTAB+36.*2+.QCRMC
$QMODE==QTAB+36.*2+.QMODE
$QUNWN==QTAB+36.*2+.QUNWN
$QBUFR==QTAB+36.*2+.QBUFR
$Q..0==QTAB+36.*2+.Q..0
$QMODE==QTAB+36.*2+.QMODE
$QERRH==QTAB+36.*2+.QERRH
]
IFNDEF LIOPDL,LIOPDL==8 ;IO PDL SIZE (MUST BE < ITS'S)
IFNDEF FDRBFL,FDRBFL==100. ;SIZE OF FILE DIR READING BUFFER.
IFNDEF LPDL,LPDL==200 ;SIZE OF REGULAR PDL.
IFNDEF MFNUM,MFNUM==25. ;[ ;INITIAL # OF FRAMES FOR MACRO OR ^] CALLS, OR ITERATIONS.
IFNDEF MFMAX,MFMAX==105. ;MAXIMUM NUMBER OF FRAMES.
IFNDEF MFINCR,MFINCR==20. ;NUMBER OF NEW FRAMES TO ALLOCATE AT ONCE.
IFNDEF SLPQWR,SLPQWR==20000 ;# WDS TO EXPAND IMPURE STRING SPACE BY.
IFNDEF SLPWRD,SLPWRD==400 ;# WDS TO EXPAND BUFFER GAP BY.
IFNDEF GCOFTN,GCOFTN==5*2000*10. ;# CHARS OF IMPURE STRINGS WRITTEN TO CAUSE A GC.
IFNDEF LPF,LPF==400 ;QREG PDL # WDS (2 WDS/ENTRY)
IFNDEF STBLSZ,STBLSZ==300 ;SEARCH TABLE SIZE.
IFNDEF CBUFSZ,CBUFSZ==10. ;INITIAL # WDS IN CMD BUFFER.
IFNDEF MACPSZ,MACPSZ==<2*MFMAX+8>/9 ;# WDS IN MACRO PDL (4-BIT BYTES)
IFNDEF FSPSPL,FSPSPL==20 ;LENGTH OF RING BUFFER OF POINT.
IFNDEF UTBSZ,UTBSZ==40 ;LENGTH OF I-O BUFFERS.
IFNDEF LHIMAX,LHIMAX==400 ;NUMBER OF 1ST PAGE NOT AVAIL FOR :EJ
IFNDEF TYIBSZ,TYIBSZ==20. ;RECORD LAST 60 CHARACTERS TYPED.
IFNDEF CTRLT,CTRLT==0 ;WE DO NOT WANT THE OLD ^T COMMAND.
IFNDEF FNMLEN,FNMLEN==40 ;LENGTH IN WORDS ALLOCATED FOR FILENAME STRING.
IFNDEF FNBLEN,FNBLEN==2*14 ;14 ELEMENTS ALLOWED IN FILENAME BLOCKS.
SPD==60.*60.*24. ;NUMBER OF SECONDS IN A DAY (FITS IN A HALFWORD)
SUBTTL MACROS
DEFINE DBP7 A
ADD A,[70000,,]
SKIPGE A
SUB A,[430000,,1]
TERMIN
DEFINE INSIRP A,B
IRPS ZZZ,,[B]
A,ZZZ
TERMIN TERMIN
DEFINE CONC CONC1,CONC2
CONC1!CONC2!TERMIN
;ERROR MACRO: TYPRE [ERRCODE]
DEFINE TYPRE A
TYPR4 ER$!A
TERMIN
IF2 ISKER1==TYPRE [ISK] ;"INVALID SORT KEY" ERROR, IF WITHIN A ^P COMMAND.
DEFINE ISKERR
SKIPE PSSAVP
TYPRE [ISK]
TERMIN
;GIVEN MACPTR OR CTXPTR, SKIP IF THAT STACK IS NOT EMPTY.
DEFINE SKNTOP X
SKIPN A,X
TERMIN
;SAY HOW ASSEMBLY IS PROGRESSING, AND HOW MUCH CORE IT TAKES SO FAR.
DEFINE INFORM A,B
IF1,[PRINTX \A = B
\]TERMIN
;SUPPY AN ARITH OP WITHOUT A RIGHT ARG WITH 1 AS AN ARG.
;OPTIONALLY (IF FOO IS Z, O OR N) DEFAULT NO ARG TO AN ARG OF 1,
;PERHAPS SETTING OR CLEARING THE ARGUMENT FLAG (IF FOO IS O OR Z)
DEFINE ARGDFL FOO ;FOO SHOULD BE "O", "Z", "N" OR NULL.
IFNB FOO,TR!FOO!E FF,FRARG
TRZE FF,FROP
CALL ARGDF0
TERMIN
SUBTTL SYSTEM-DEPENDENT MACROS TO REDUCE CONDITIONALS ELSEWHERE
IFN ITS,[
DEFINE SIXBNM A
SIXBIT/A/TERMIN
DEFINE TSOPEN A,B
.OPEN A,B
.LOSE %LSFIL
TERMIN
DEFINE SYSCAL A,B
.CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))]
TERMIN
;MAKE NEXT TTY INPUT NOT WAIT FOR AN ACTIVATION CHARACATER.
DEFINE TTYACT
CALL TTYAC1
TERMIN
;WAIT FOR OUTPUT TO FINISH; RETURN # CHARS OF AVAILABLE INPUT IN AC "X".
DEFINE LISTEN X
.LISTEN X,
TERMIN
DEFINE CIS
.SUSET [.SPICL,,[-1]]
TERMIN
DEFINE CLOSEF X
.CLOSE X,
TERMIN
DEFINE DISSTR *STRING* ;GENERATE AN ARG FOR DISIOT.
MOVE Q,[-<<.LENGTH /STRING/+4>/5>,,[ASCIC /STRING/]]
TERMIN
]
IFN TNX,[
DEFINE .VALUE
JSR ERRRET
TERMIN
DEFINE TTYACT
TERMIN
DEFINE STRCNC STR1,STR2
ASCIZ \STR1!STR2\
TERMIN
DEFINE LISTEN X
IFN X-1,SAVE 1
IFN X-2,SAVE 2
MOVEI 1,.CTTRM
SKIPE DWAIT
DOBE
SIBE
SKIPA X,2
SETZ X,
IFN X-2,REST 2
IFN X-1,REST 1
TERMIN
DEFINE CLOSEF X
MOVE 1,X
CLOSF
JFCL
SETZM X
TERMIN
DEFINE DISSTR *STRING* ;GENERATE AN ARG FOR DISIOT
HRROI Q,[ASCIZ /STRING/]
TERMIN
IFNDEF .FNAM3,.FNAM3==.FVERS
IF1 EXPUNG BOOT,OPEN,CLOSE
]
SUBTTL DISPLAY VARIABLES
LOC 41
JSR UUOH
IFN ITS,JSR TSINT
IFN ITS,LOC 100
IFN TNX,LOC 140 ;DONT GET SMASHED BY LINK VARIABLES
RGETTY: 0 ;TCTYP VARIABLE OF TTY.
TTYOPT: 0 ;TTYOPT VARIABLE OF TERMINAL.
TTYSMT: 0 ;TTYSMT VARIABLE OF TERMINAL.
OSPEED: 0 ;OUTPUT LINE SPEED IN BAUD, OR 0 IF UNKNOWN.
TABWID: 10 ;WIDTH OF TAB - DISTANCE BETWEEN TAB STOPS. FS TABWID.
NVLNS: 0 ;# VERTICAL LINES ON CONSOLE
NHLNS: 0 ;# HORIZONTAL POSITIONS ON CONSOLE
USZ: 0 ;# VERTICAL LINES USABLE FOR DISPLAY. MUST FOLLOW NHLNS.
IFN USZ-NHLNS-1,.ERR
NELNS: 0 ;# ECHO LINES (NVLNS-USZ). USUALLY 3, SET BY FS ECHO $
MXNVLS==70.
MXNHLS==160.
TOPLIN: 0 ;# OF 1ST LINE OF SCREEN TO USE FOR BUFFER DISPLAY.
NLINES: 0 ;# LINES OF BUFFER TO DISPLAY, 0 => DEFAULT
; (2 ON TTYS, AS MANY AS WILL FIT ON DISPLAYS)
VSIZE: 0 ;# OF LINES FOR VBD TO USE (SAME AS NLINES, OR THE DEFAULT # OF LINES).
BOTLIN: 0 ;# OF 1ST LINE BELOW WINDOW.
RRTOPM: 0 ;BOTTOM OF "TOP MARGIN" WHERE CURSOR SHOULDNT GO (SET BY %TOP)
RRBOTM: 0 ;TOP OF "BOTTOM MARGIN" WHERE CURSOR SHOULDNT GO (SET BY %BOTTOM)
DISTRN: 0 ;-1 => TRUNCATE LINES, ELSE CONTINUE THEM.
DISPCR: 0 ;-1 => STRAY CR REALLY DOES A CR.
;IF NOT OUTPUT AS CR, IT IS OUTPUT AS UPARROW-M.
;ALSO SIMILARLY CONTROLS WHETHER STRAY LF'S ARE OUTPUT AS LF OR ^-J.
DISPBS: 0 ;-1 => ^H OUTPUT AS BS. OTHERWISE IT IS OUTPUT AS UPARROW-H.
DISSAI: 0 ;ASSUME CTL CHARS ARE 1-POSITION GRAPHICS INSTEAD OF PRINTING AS ^-MUMBLE.
LID: 0 ;NONZERO => TRY TO USE INSERT/DELETE LINE TO MOVE TEXT AROUND.
CID: 0 ;NONZERO => USE CHAR I/D FOR SIMPLE ^R INSERT/DELETE COMMANDS
NOCEOL: 0 ;NONZERO => TERMINAL DOESN'T HAVE CLEAR TO END OF LINE.
EOLFLG: 0 ;KLUDGE FLAG FOR TERMINALS WITH NO CLEOL
IFN ITS,[
.BYTE 8 ;STRINGS TO OUTPUT IN SUPERIMAGE OUTPUT MODE:
EXPUNG DISCPV DISC1V DISCPH MORMCV
DISCMV=,. ;SET CURSOR AND CLEAR LINE.
%TDMV0 ? DISCPV: 0 ? 0 ? %TDEOL
DISCM1=,. ;SET CURSOR, DON'T CLEAR LINE.
%TDNOP ? %TDMV0 ? DISC1V: 0 ? DISCPH: 0
.BYTE
IFN 700000&(DISCPH),[ ;IF MIDAS DEFINED ALL THE TAGS 1 BYTE TO SMALL, FIX THEM UP.
IRPS XX,,DISCPV DISCPH DISC1V
.AOP IBP,1,XX
EXPUNGE XX
XX=IFN .AVAL1-1,[.AVAL1] .ELSE [.AVAL2] ; KLUDGE FOR KL'S
TERMIN
]] ;IFN ITS
DISVP: -1 ;VERT POS. OF LAST LINE GIVEN TO DISLIN, REGARDLESS OF
;WHETHER THE LINE ACTUALLY HAD TO BE IOTTED.
;(-1 ==> JUST WENT TO TOP OF SCREEN)
;IF DISLIN SEES IT IS HACKING SAME LINE AS PREVIOUS
;CALL TO DISLIN, IT DOESN'T CLEAR THE LINE.
DISVP1: 0 ;VERT. POS. OF MAIN PRGM AREA TTY CURSOR.
;TO MOVE TO LINE <C(DISVP1)+1>, DO AN LF INSTEAD OF
;THE USUAL ^PV.
DISFLF: 0 ;-1 ==> FORCE DISLIN TO SET CURSOR POS.
CHCTBP: 0 ;BP. FOR CHCT TO STUFF CHARS.
;1 => DISCARD CHARS BUT COMPUTE HASH. 0 => DON'T HASH EITHER.
;TYOFLG MUST BE -1 IF CHCTBP IS 0 OR 1.
CHCTVS: 0 ;LAST +1 LINE FOR CHCT TO USE (= BOTLIN EXCEPT DURING TYPEOUT ON PRINTING TTY)
CHCTHP: 0 ;POSITION IN TYPED LINE (FOR CONTINUATION AND TABS)
CHCTCF: 0 ;-1 ==> LAST CHAR GIVEN TO CHCT WAS ^M.
CHCIGN: 0 ;-1 => OUTPUTTING TRUNCATED PORTION OF LINE.
CHCTAD: 0 ;CHCT PUSHJ'S @. WITH EACH LINE.
CHCTVP: 0 ;VERT. POS. OF THAT LINE.
CHCTHC: 0 ;HASH CODE OF THAT LINE.
CHCTBL: 0 ;WHEN @CHCTAD CALLED, THIS HOLDS CHAR ADDR 1ST CHAR
;IN THE LINE BEING DISPLAYED. (ASSUMING THAT
;DISAD WAS CALLED WITH IN HOLDING ADDR
;OF THE CHAR AFTER THE ONE BEING OUTPUT.)
CHCTNL: 0 ;WHEN @CHCTAD CALLED, THIS WD >0 => CHAR ADDR
;1ST CHAR TO APPEAR ON NEXT SCREEN LINE (IF ANY)
;-1 => NEXT CALL TO @CHCTAD WILL BE ON SAME SCREEN LINE.
CHCRHP: 0 ;WHEN @CHCTAD CALLED, THIS IS HPOS AT WHICH TTY CURSOR WILL BE LEFT (FOR SCPOS)
CHCOVP: 0 ;WHEN @CHCTAD CALLED, INDICATES A STRAY ^M OR ^H WAS JUST IOTTED.
ORESET: 0 ;OUTPUT STOPPED BY QUIT NOW IN PROGRESS
MORFLF: 0 ;USER HAS FLUSHED TYPEOUT (1 => WITH RUBOUT, -1 => WITH OTHER CHAR)
OLDFLF: 0 ;GETS VALUE OF MORFLF WHEN TYPEOUT IS UN-FLUSHED AGAIN (RETURN TO ^R, ETC).
MORNXT: 0 ;NONZERO => NEXT CHAR OUTPUT SHOULD TRIGGER A --MORE--.
MORESW: 0 ;0 => NO --MORE-- OR ANYTHING. 1 => --BOT--. 2 => --TOP--. ETC.
MS%UP==1 ;VALUES 0, 1, 2 AND 3 ARE MADE OF THESE 2 BITS.
MS%DWN==2 ;MS%UP MEAN'S THERE'S TEXT ABOVE THE SCREEN; MS%DWN, THAT THERE'S TEXT BELOW.
;IF IT'S 3 THEN THE LH IS THE PERCENTAGE OF THE FILE ABOVE SCREEN.
MS%MOR==4 ;4 MEANS THAT --MORE-- IS BEING DISPLAYED.
MS%FLS==5 ;5 MEANS THAT --MORE--FLUSHED IS BEING DISPLAYED.
;ADDITIONAL BITS IN MORESW. THESE NEVER ACCOMPANY MS%MOR OR MS%FLS.
MS%MOD==10 ;10-BIT MEANS THERE IS A STAR IN THE MODE LINE, MEANING THE BUFFER IS MODIFIED.
MS%LOS==20 ;SET => MODE LINE DOESN'T MATCH MORESW, AND MUST BE UPDATED.
MS%PCT==40 ;SET => RECALCULATE PERCENTAGE FOR --NN%--, AND REDISPLAY IT IF CHANGED.
MOREHP: 0 ;HPOS AT WHICH THE --TOP-- (OR WHATEVER) STARTS IN THE MODE LINE.
DISOMD: -1 ;WHAT $QMODE HAD WHEN LAST DISPLAYED.
;IF $QMODE NE DISOMD, MUST REDISPLAY THE MODE.
MODCHG: 0 ;POSITIVE => ..J NEEDS TO BE RECOMPUTED, SO RUN MODMAC.
;NEGATIVE => IT IS -2* A FS QP PTR$. IF POP PAST THERE, MUST RUN MODMAC.
MODMAC: 0 ;NON-0 => IT IS MACRO TO RECOMPUTE ..J WHEN IT IS ABOUT TO BE DISPLAYED.
TYOFLG: -1 ;>= 0 ==> TYPEOUT INITTED.
ECHACT: 0 ;-1 => SOMETHING WAS PRINTED IN THE ECHO AREA, SO ^R SHOULD CLEAR IT. FS ECHO ACTIVE$
;1 => CLEAR AFTER NEXT COMMAND BUT NOT AFTER THIS COMMAND.
ECHFLS: 0 ;NONZERO TO ENABLE THE ECHACT FEATURE. FS ECHO FLUSH$.
ECHONL: 0 ;-1 => NEXT ECHO AREA OUTPUT SHOULD GO TO FRESH LINE AND CLEAR IT.
ECHCHR: 0 ;-1 => LAST COMMAND HAS TYPED OUT, SO ^R SHOULDN'T ECHO IT.
;OTHERWISE, IT IS CHARACTER OR STRING TO ECHO.
;(PRINTING TERMINALS ONLY).
RUBENC: 0 ;NONZERO => IS CHAR OR STRING TO TYPE BEFORE TYPING ANYTHING ELSE
;(EG, \, AFTER A RUBOUT IN ^R IN SCANNING MODE). FS XPROMPT$.
BSNOLF: 0 ;-1 => BACKWARD MOTION AND RUBBING OUT SHOULDN'T DO LF'S (PRINTING TTY ONLY).
DISADP: 0 ;WHEN DISAD IS CALLED, THIS SHOULD HOLD C(PT)+1.
;USED BY DISAD TO DECIDE WHEN TO OUTPUT CURSOR.
TTYMAC: 0 ;MACRO FOR FS TTY INIT$ TO CALL TO RESET TTY PARAMETERS FOR USER OPTIONS.
INVMOD: 0 ; NONZERO MEANS SET THE MODE LINE INVERSE VIDEO
SCINV: 0 ; NONZERO MEANS CHARACTERS BEING OUTPUT IN STANDOUT MODE
IFNDEF DISBFL,DISBFL==MXNHLS/4+1 ;LENGTH OF TTY IOT BUFFER.
IFN TNX,[
TTYNBR: -1 ;.CTTRM NUMBER FOR T(W)ENEX.
SGTTYP: 0 ;EXPLICIT TYPE OR -1,,SYSTEM TERMINAL TYPE
PADCHR: 177 ;CHARACTER FOR PADDING, -1 => USE DELAY INSTEAD OF PADDING.
BBNPAD: 0 ;PAD CALCULATION FOR BITGRAPHS
TIMPDS: .BYTE 7 ;ASCIZ STRING OF RUBOUTS OR WHATEVER
REPEAT 100.,177
.BYTE
TIMPDE::
IFN STANSW,[ ; THIS IS SPACE FOR BUFFERING TERMINAL CURSOR CONTROL COMMANDS.
; SEE TECTRM.MID FOR DETAILS OF HOW THIS WORKS.
TBFSIZ==80. ;NUMBER OF CHARACTERS TO BUFFER
TBFCNT: 0 ;NUMBER OF CHARS IN BUFFER
TBFPTR: 440700,,TBUFFER ;BUFFER POINTER
TBUFFER: BLOCK <<TBFSIZ+30>/5>+1 ;BUFFER ITSELF
];IFN STANSW
;[wew] THE FOLLOWING ARE FOR SPECIAL OPTIMIZATIONS DONE ON TERMINALS
;[wew] THAT HAVE INSERT MODE, RATHER THAN INSERT CHARACTER OPERATIONS.
INSCNT: 0 ;[wew] NUMBER OF CHARACTERS LEFT TO BE INSERTED
INSFLG: 0 ;[wew] WHETHER TERMINAL *INSERT MODE* IS ON
AALSCL:: ;USED BY AMBASSADOR SUPPORT FOR LAST-SCREEN CLEAR TIME
C1PADF:: ;USED BY C100 FOR HOLDING PAD MULTIPLIER
VT1BUF:: ;USED ALSO BY VT100 FOR SCROLLING COMMANDS
BBNBUF:: ;USED BY BITGRAPH FOR SCROLLING COMMANDS
HPBUF: BLOCK 4 ;BUFFER FOR HP CURSOR MOTION COMMANDS
DISBF1: BLOCK 6 ;HOLDS STUFF TO SET CURSOR POS FOR THE LINE IN DISBUF.
];IFN TNX
IFN ITS,[ ;DISBF1 AND DISBUF IOTTED AT ONCE.
DISBF1: BLOCK 2 ;IF NO CURSOR MOTION NEEDED, THIS HOLDS %TDNOP (0 ON TENEX).
]
DISBUF: BLOCK DISBFL ;BUFFER FOR TEXT TO BE IOTTED TO TTY.
DISBFC: 0 ;# CHARS SPACE LEFT IN DISBUF.
DISPRR: 0 ;NON0 => PDL LEVEL AT RRDISP.
;CAUSES CRSR POS AT PT TO BY REMEMBERED, ETC.
GEA: 0 ;-1, OR OLD ADDR (REL TO BEG) OF 1ST CHAR OF BUFFER DISPLAYED.
%TOP: 10. ;PERCENT OF SCREEN CURSOR SHOULDN'T ENTER AT TOP.
%BOTTO: 10. ;SIMILAR, FOR BOTTOM.
%CENTE: 40. ;PERCENT FROM TOP CURSOR SHOULD GO WHEN WINDOW CHANGES.
%END: 30. ;WHEN WINDOW MOVED, CURSOR MUST BE >= THIS MUCH FROM BOTTOM.
CLRMOD: -1 ;-1 => CLEAR SCREEN IN DISTOP IF TTY
;HAD BEEN TAKEN AWAY AND RETURNED BY TECO'S SUPERIOR.
;0 => DON'T DO THAT.
;1 => DISABLE ALL SCREEN-CLEARING, EWVEN BY ^L AND F+
PJATY: -1 ;-1 => WE JUST GOT A %PJATY INT, SO SHOULD REDISPLAY WHOLE SCREEN SOON.
REFRSH: 0 ;NONZERO => MACRO IT WHEN WANT TO CLEAR SCREEN DUE TO PJATY
;(INSTEAD OF MACROING FS ^R DISPLAY$).
VREMEM: 0 ;NON0 WHEN DISPLAYING STUFF THAT'S IN BUFFER.
RRINHI: 0 ;NON-0 INHIBITS ALL DISPLAY UPDATING (FS ^R INHIBIT$)
RRECBP: 0 ;NONZERO INDICATES WE RESTARTED TECO OUT OF RRECIN, SO CALL RRECI5.
RRECSD: 0 ;IF SPACE'S DEFINITION EQUALS THIS, SPACE CAN BE ECHOED. USE FOR AUTO-FILL.
TTMODE: 0 ;NON-0 => DISPLAY BUFFER AFTER CMD STRINGS EVEN IF PRINTING TTY.
HCDS: BLOCK MXNVLS ;HASH CODES OF LINES ON SCREEN
HCDSE: 0
LINBEG: BLOCK MXNVLS ;1 WD / LINE ON SCREEN, SET BY VBD AS FOLLOWS:
;BITS 3.9 - 1.1 -- CHAR ADDR OF 1ST CHAR ON THE LINE
;BITS 4.9 - 4.1 -- HPOS THAT CHARACTER STARTED IN.
LINEND: BLOCK MXNVLS ;FOR EACH LINE, THE HPOS OF THE END OF THE LINE:
;THE HPOS THAT THE NEXT CHARACTER ON IT WOULD HAVE HAD.
DWAIT: 0 ;WAIT FOR OUTPUT TO FINISH BETWEEN LINES, TO AVOID BUFFERING UP LOTS OF STUFF.
DFORCE: 0 ;FORCE DISPLAY TO FINISH DESPITE PENDING INPUT. DON'T UPDATE MODELINE.
SHOMOD: 0 ;ON PRINTING TTY, FR TYPES OUT ..J IF THIS IS NONZERO.
;JOURNAL FILE DATA.
JRNOCT: 0 ;NUMBER OF COMMAND CHARS BEFORE OUTPUT JOURNAL IS FORCED OUT.
JRNOIVL:50. ;NUMBER OF COMMAND CHARS BETWEEN FORCINGS OUT.
JRNOUT: 0 ;NONZERO => OUTPUT JOURNAL FILE IS OPEN.
JRNIN: 0 ;NONZERO => INPUT JOURNAL FILE BEING RE-EXECUTED.
JRNINH: 0 ;NONZERO => TEMPORARILY INHIBIT USE OF JOURNAL FILE FOR INPUT.
JRNMAC: 0 ;MACRO TO BE CALLED WHEN "::" IS SEEN IN A JOURNAL FILE.
DBGBUF: BLOCK 40 ;DEBUG INFO BUFFER.
DBGBFE::
DBGBFX: DBGBUF ;POINTER FOR STORING IN DEBUG INFO BUFFER.
FDRBUF: BLOCK FDRBFL ;BUFFER FOR READING FROM CHRAND.
FDRBFE: <EOFCHR>_29.
FDRP: 0 ;BYTE POINTER TO FDRBUF
SUBTTL ITS FILE AND INTERRUPT VARIABLES
IFN ITS,[
TIME: 0 ;TIME IN SIXBIT
DATE: 0 ;DATE IN SIXBIT
PDTIME: 0 ;# SECONDS SINCE BEGINNING OF YEAR
LPDTIM: 0 ;LOCALIZED "
YEAR: 0 ;YEAR AND FLAGS
CDATE: SIXBIT/ 00,19/
CTIME: SIXBIT / : : /
0
SEQPGE: 4 ;PAGE AHEAD DISTANCE. 0 => DON'T USE SEQUENTIAL PAGING.
SEQPGF: 0 ;NONZERO => SEQ PGNG REQUESTED; ON IF WE THINK IT'S WORTH IT.
SEQPGN: 0 ;NONZERO => .PAGAHD IS NONZERO; SEQPGX MUST ACTUALLY CLEAR IT.
SEQPGC: -1 ;-1 + NUMBER OF NESTED SEQUENTIAL PAGING REQUESTS NOW.
INTJPC: 0 ;PLACE THAT JUMPED TO WHERE YOU WERE INTERRUPTED FROM
UUOJPC: 0 ;PLACE THAT JUMPED TO WHERE YOU UUO'D FROM, IF IT WAS ILLEGAL MUUO.
TSINT: 0
0
.SUSET [.RJPC,,INTJPC]
JRST TSINTP
INTACS: BLOCK 20
TTYST1: 322020,,202020 ;ACTIVATE ON ^C (AND OTHER RANDOM CTL CHARS)
;OUTPUT CTL CHARS IN IMAGE MODE.
TTYST2: 332033,,300220 ;ACT. ON ^G (^S), RUB, ALT; INT. ON ^G (^S) ,ALTMODE; OUTPUT CR IN IMAGE.
TTYSTS: 0 ;3RD ARG FOR TTYSET.
DEFFIL: BLOCK FNMLEN ;DEFAULT FILENAME (ASCIZ STRING).
INFILE: BLOCK FNMLEN ;CURRENT OR MOST RECENT INPUT FILE'S TRUE NAME.
OUTFIL: BLOCK FNMLEN ;NAME OF LAST OUTPUT FILE EXPLICITLY CLOSED.
TMPFIL: BLOCK FNMLEN ;TEMPORARY FILE NAME FOR MERGING, FOR OPENING OUTPUT
;FILES, ETC.
TMPF1: BLOCK FNMLEN
IFN 0,[
DEFDEV: 0 ;DEFAULT FILENAMES. DEFAULT DEVICE INITTED TO MACHINE NAME.
DEFFN1: SIXBIT /@/
DEFFN2: SIXBIT />/
DEFFN3==DEFFN2 ;GENERATION NUMBER IS THE SAME AS SECOND FILENAME
DEFDIR: 0 ;CURRENT SNAME.
ERDEV: 0 ;LIKE EIDEV BUT FOR DEV BEING READ.
RUTF1: 0 ;REAL FILE NAMES
RUTF2: 0 ;ON READ
ERSNM: 0 ;AND SNAME BEING READ.
ROUDEV: 0 ;REAL FILE NAMES OF LAST OUTPUT FILE EXPLICITLY CLOSED. DEVICE NAME.
ROUFN1: 0 ;FN1 OF IT.
ROUFN2: 0 ;FN2 OF IT.
ROUSNM: 0 ;SNAME OF IT.
]
MNAME:
MACHIN: 0 ;SIXBIT NAME OF MACHINE.
CHPOPX: TRNE\TRNN T,1 ;SEE IF THIS PUSHED IOCHNL IS THE RIGHT DIRECTION
GCHN2: CAIN E,. ;DON'T USE CHNL AS TEMP
;IF ITS THE ONE WE WANT TO POP INTO.
IOP: -LIOPDL,,IOPDL-1 ;POINTER TO LOCAL IO PDL
IOPDL: BLOCK LIOPDL ;LOCAL IO PDL
];IFN ITS
SUBTTL TWENEX FILE AND INTERRUPT VARIABLES
IFN TNX,[
NFKS==10 ;NUMBER OF SUBFORKS THERE CAN BE AT ONE TIME (NOT COUNTING EXECFK).
EXECFK: -1 ;FORK HANDLE FOR EXEC (FZ$ := PUSH)
RUNFRK: 0 ;FORK HANDLE OF CURRENTLY RUNNING PROCESS (WITHIN FZ).
FRKTAB: BLOCK NFKS ;TABLE OF FORK HANDLES, INDEXED BY FZ ARGUMENT NUMBER
FRKTTY: BLOCK <<NFKS+1>*3> ;TABLE OF TERM STATUS INDEXED BY FZ ARGUMENT NO.
FZNAM: 0 ;JOBNAME TO RESTORE ON RETURN FROM SUB FORK
FRKJFN: 0 ;JFN of current process (within fz)
FRKNUM: 0 ;USEFUL STORAGE FOR FZ COMMAND
FRKLST: SIXBIT /EXEC / ;AN OFFSET OF ZERO IS ALWAYS THE EXEC
BLOCK NFKS ;POINTERS TO JOB NAMES INDEXED BY FZ ARGUMENT NUMBER.
FRKJCL: 0 ;STRING OF JCL FOR THE FORK
FZSTR: BLOCK 2 ;POINTERS TO RESCAN STUFF FOR USE WITH FZ
FRKNAM: BLOCK 20 ;FILE NAME LONGER THAN 100 CHARS LOOSES.
INTACS: BLOCK 20 ;SAVE ACS ON INTERRUPTS
INTPC: 0 ;INTERRUPT SAVED PCS FOR THE THREE LEVELS.
INTPC1: 0
INTPC2: 0
BOOTP: 0 ;P SAVED HERE TO BE DUMPED IN EJ FILES (SINCE
;SSAVE DOESN'T SAVE ACS).
DISCPH: 0 ;STARTING HPOS FOR THIS LINE
FCITYI: 0 ;HIGH ORDER BITS ARENT PARITY (CROCK NEEDED FOR
;DM1520)
IFN 20X,[ ;<
PAGMOD: 0 ;NON-ZERO => LEAVE TERMINAL IN PAGE MODE (FOR
;^S/^Q)
IFN TEXTIF,[
ORGWID: 0 ;[wew] ORIGINAL WIDTH OF TERMINAL
RD%EMC==1,,0
TXTIBK: 7 ;[wew] BLOCK FOR SMART TEXTI JSYS
<RD%RND+RD%JFN+RD%SUI+RD%EMC> ;[wew] RANDOM FLAGS
.PRIIN,,.PRIOU ;[wew] .RDIOJ: WHERE TO GET INPUT
0 ;[wew] DESTINATION BYTE PTR. FILLED IN LATER.
0 ;[wew] DEST. BYTE COUNT. FILLED IN LATER.
0 ;[wew] EDIT LIMIT (NONE)
0 ;[wew] PROMPTING TEXT. (NONE)
0 ;[wew] BREAK MASK ADDRESS (FILLED IN LATER)
BRKVLD: 0 ;[wew] NON-ZERO IMPLIES THAT BREAK TABLE NEED
BRKTAB: BLOCK 4 ;[wew] NOT BE RECALCULATED.
];IFN TEXTIF
];20X
IFN TNX,[
JCLNAM: BLOCK 2 ;PROGRAM NAME FROM JCL
]
ITTYMD: BLOCK 3 ;PLACE TO SAVE INITIAL TTY MODES TO RESTORE BEFORE CALLING SUBFORK.
FTTYMD: 0 ;INFERIOR FORK STPAR
ECHOP: -1 ;ARE WE IN ECHO AREA?
ECHOF2: 0 ;MUST TECO EXPLICITLY ECHO INPUT?
ECHOL0: 0 ;VPOS OF FIRST LINE OF ECHO AREA
ECHOPS: 0 ;CURRENT POSITION IN ECHO AREA: VPOS,,HPOS
ECODPF: 0 ;FS ECHO DISPLAY: -1 AFTER ^P, -2 AFTER ^PH, -3 AFTER ^PV.
ECODPS: 0 ;SAVED POSITION FOR ^PS IN ECHO AREA
SAVMOD: 0 ;SFMOD TO BE RESTORED ON ^G INTERRUPT (FOR :ET), ELSE 0
BLOCK 2 ;CCOC WORDS ARE SAVED HERE WHEN CALLING AN INFERIOR FORK
TTLPOS: 0 ;REAL SCREEN POSITION (INTERNAL RFPOS/SFPOS EQUIVALENT)
IFN SUMTTF,[
HLDCHR: 0 ;HOLD CHARACTER SAVED HERE
];IFN SUMTTF
OPNJFN: 0 ;JFN BEFORE OPENF
CHFILI: 0 ;INPUT FILE JFN
CHFILO: 0 ;OUTPUT FILE JFN
GJBITS: 0 ;GJ%XTN BITS FOR INVISIBLE FILES
DEFDEV: ASCII /DSK/ ;DEFAULT DEVICE
0
DEFDIR: BLOCK 20 ;DIRECTORY NAME
DEFFN1: ASCII /FILE/ ;DEFAULT TO SOMETHING RANDOM
BLOCK 17 ;NAME
DEFFN2: BLOCK 20 ;EXTENSION
DEFFN3: 0 ;GENERATION NUMBER
ERDEV: BLOCK 63 ;SAME FORMAT - LAST READ FILE'S NAME
ROUDEV: BLOCK 63 ;DITTO - REAL OUTPUT FILENAMES
ETMODE: ETDEF ;BITMASK OF FIELDS TO DEFAULT FOR :ET COMMAND
CCLJFN: 0 ;JFN IN 1 IF STARTED AT NORMAL ENTRY+2
INIOP: -LIOPDL,,INIPDL-1 ;INPUT I/O PDL POINTER
INIPDL: BLOCK LIOPDL ;INPUT I/O PDL
OUTIOP: -LIOPDL,,OUIPDL-1 ;OUTPUT I/O PDL POINTER
OUIPDL: BLOCK LIOPDL ;OUTPUT I/O PDL
SAVABC: 0 ;JSR HERE TO SAVE AC'S A, B, AND C ON THE STACK
SAVE A
SAVE B
SAVE C
JRST @SAVABC
ERRRET: 0
MOVEM 17,77 ;SAVE ALL ACS IN CASE WANT TO DO A DUMP
MOVEI 17,60
BLT 17,76
HRROI A,[ASCIZ /Internal error at /]
ESOUT
MOVEI A,.PRIOU
HRRZ B,ERRRET
MOVEI C,10
NOUT
JFCL
ERRRST: MOVSI 17,60 ;RESTORE ACS FOR IMMEDIATE DEBUGGING (ERRRSTG FROM DUMP ALSO)
BLT 17,17
HALTF
JRST @ERRRET
%TOERS==40000 ;CAN SELECTIVELY ERASE
%TOHDX==20000 ;HALF DUPLEX (BOUND TO LOSE SOMEWHERE)
%TOMVB==10000 ;CAN BS
%TOSAI==4000 ;SAIL CHAR SET
%TOSA1==2000 ;USE SAIL CHAR SET
%TOOVR==1000 ;CAN OVERWRITE
%TOMVU==400 ;CAN MOVE THE CURSOR UP
%TOMOR==200 ;MORE PROCESSING
%TOROL==100 ;ROLL
%TOLWR==20 ;HAS LOWERCASE KEYBOARD
%TOFCI==10 ;HAS 12 BIT INPUT CAPABILITY
%TOLID==2 ;HAS LINE I/D
%TOCID==1 ;HAS CHAR I/D
%TPRSC==4 ;(IN RIGHT HALF) TTY HAS ABILITY TO SCROLL A REGION OF THE SCREEN.
%TPMTA==400 ;(IN RIGHT HALF) HAS A META KEY
;MAYBE LOAD VTS DEFINITIONS
IF1,IFNDEF RTCHR,.INSRT VTSDEF
];IFN TNX
SUBTTL RCH, CHARACTER SYNTAX TABLES, ^]
UUOQ: 0
UUOH: 0
MOVEM Q,UUOQ
LDB Q,[331100,,40]
CAIN Q,TYPR4_-33
JRST ETYP2A
IFN ITS,.SUSET [.RJPC,,UUOJPC]
MOVE Q,UUOQ
.VALUE
TYPRE [DSI]
SKRCH: SKIPG COMCNT
TYPRE [UEC]
RCH: SOSGE COMCNT
JRST RCH2 ;NOTE RCH2 LOOKS AT OUR RETURN ADDRESS.
ILDB CH,CPTR
XCT RCHDTB(CH) ;DO SPECIAL STUFF OR JFCL..
TRACS: POPJ P,TYOS ;OR JRST TYOS IN TRACE MODE.
SKIPN MACPTR ;RCHDTB ENTRY SKIPS IF SHOULD CHANGE CHAR'S CASE.
XORI CH,40 ;BUT NEVER CHANGE CASE OF CHARS IN MACROS.
JRST TRACS
;[[[[
RCHDTB: REPEAT 33,JFCL
RCHALT: JFCL ENDARG ;OR JRST IF SHOULD END A ^]^X
REPEAT ^]-34,JFCL
RCHBRC: JRST CTLBRC ;^]
REPEAT "?-^],JFCL
SKIPL RCHSFF ;@
REPEAT 26.,SKIPL CASE ;UPPER CASE LETTERS
REPEAT 5,SKIPL RCHSFF ;[\]^_
JFCL ;`
REPEAT 26.,SKIPG CASE ;LOWER CASE LETTERS.
REPEAT 5,JFCL ;{|}~<RUBOUT>
IFN .-200-RCHDTB, .ERR RCHDTB WRONG SIZE.
SQUOTP: 0 ;;SIGN => READING SUPER-QUOTED MACRO.
;4.8 => READING DELIMITER-PROTECTED MACRO.
DLMF2: 0 ;INTERNAL FLAG FOR CTLBRC INDICATES THAT 4.8 OF SQUOTP SHOULD BE SET
SQUOF2: 0 ; " " " " " " SIGN OF SQUOTP " " "
BRC1CF: 0 ;INTERNAL FLAG FOR CTLBRC INDICATES THAT ONLY ONE CHARACTER SHOULD BE GOBBLED
BRCUAV: 0 ;INTERNAL FLAG FOR CTLBRC INDICATES THE Q-REGISTER
;SHOULD BE USED AS A NUMERIC VALUE (IE. ASCII VALUE)
BRC1: 0 ;[ ZERO => HANDLE ^] NORMALLY
;[[[[[; -1 => DO-NOT EXPAND MACROS, BUT HANDLE ^]^],^]$,^]^V<Q-REG>,AND ^]^Q NORMALLY
BRCFLG: 0 ;[ ;SET TO -1 BY ^]'S THAT INSERT UNPREDICTABLE STUFF.
;[ ;SET IT TO 0 AND TEST IT LATER TO SEE IF ANY ^]'S HAVE HAPPENED.
;[ ;ALSO, ^]^V LEAVES THE CHARACTER HERE ON RETURN, AS IT WAS
;BEFORE BEING TRUNCATED TO 7 BITS.
CASE: 0 ;DESIRED INPUT CASE.
;0 => LEAVE CASE OF CHARS ALONE,
;<0 => WANT CHARS IN LOWER CASE,
;>0 => WANT CHARS IN UPPER CASE.
;NEGATED BY CASE-SHIFT AND CASE-LOCK CHARS.
CASNRM: 0 ;NORMAL CASE - REINIT. CASE AT START OF CMD STRING.
;THIS IS WHAT FSCASE SETS.
CASDIS: 0 ;NONZERO => PUT CASESHIFTS IN OUTPUT.
CASSFT: -1 ;CASE-SHIFT CHAR, OR -1 IF NONE.
CASLOK: -1 ;CASE-LOCK CHAR, OR -1 IF NONE.
RCHSFD: 0 ;SAVED NORMAL CONTENTS OF RCHDTB ENTRY FOR
;CASE-:SHIFT CHAR (RCHDTB ENTRY NOW IS <CALL RCHSFT>)
RCHLOD: 0 ;SAVED NORMAL RCHDTB ENTRY FOR CASE-LOCK CHAR.
RCHSFF: 0 ;-1 => LAST CHAR WAS A CASE-SHIFT.
;USED TO CAUSE A CASE SHIFT TO QUOTE ITSELF.
SUBTTL ADDRESS SPACE ORGANIZATION
;;; THE 1ST 2 PAGES ARE THE "LOW IMPURE", CONTAINING SPECIAL-PURPOSE VARIABLES.
;;; THEN COMES THE PURE CODE, FROM "INIT" TO "HUSED".
;;; THEN COMES THE HIGH IMPURE, STARTING WITH A FEW SPECIAL-PURPOSE VARIABLES,
;;; FOLLOWED BY THE ^R COMMAND DISPATCH TABLE.
;;; THEN COME THE DYNAMICALY ALLOCATED AREAS:
; THE COMMAND BUFFER IS USED FOR OLD-FASHIONED (NON-^R) TECO TOP-LEVEL COMMAND READIN.
CBUFLO: 10740,,CBUF ;SET TO BP -> BOTTOM OF COMMAND BUFFER.
CBUFH: CBUF+CBUFSZ-1 ;-> LAST WD OF COMMAND BUFFER
; IMPURE STRING SPACE CONTAINS STRINGS AND BUFFERS' POINTER-STRINGS.
; BOTH START WITH A FLAG CHARACTER (QRSTR OR QRBFR, RESPECTIVELY), FOLLOWED
; BY 3 CHARACTERS HOLDING A NUMBER. IN A STRING, THAT NUMBER IS THE LENGTH,
; INCLUDING THE FOUR HEADER CHARACTERS, AND THE DATA FOLLOWS THE NUMBER.
; IN A BUFFER POINTER-STRING, THE NUMBER IS THE ADDRESS OF THE BUFFER'S FRAME.
; EITHER KIND OF OBJECT IS REPRESENTED IN QREGS, AS VALUES, ETC. BY A NUMBER
; WHICH IS THE CHARACTER ADDRESS RELATIVE TO THE START OF THE SPACE, PLUS SETZ.
QRBUF: INIQRB ;CHAR ADDR START OF IMPURE STRING SPACE
QRWRT: INIQRW ;CHAR ADDR 1ST CHAR ABOVE IMPURE STRING SPACE.
QRSTR==177 ;PREFIX CHAR FOR STRING (FOLLOWED BY 3 CHARS HOLDING
;21-BIT SIZE OF STRING INCLUDING 4 HEADER BYTES, FOLLOWED BY TEXT).
QRBFR==176 ;PREFIX CHAR FOR BUFFER POINTER (FOLLOWED BY 3 CHARS
;HOLDING ADDR OF POINTER-BLOCK (IN MACRO-FRAME SPACE)).
; THEN COMES A GAP, CONTAINING NON-EXISTENT MEMORY, FOLLOWED BY BUFFER SPACE.
; EVERY BUFFER'S DATA AREA IS A SUBSET OF BUFFER SPACE, AND BUFFER SPACE
; IS USED FOR NO OTHER PURPOSE.
; BUFFER SPACE STARTS AND ENDS ON WORD BOUNDARIES, BUT BUFFERS NEED NOT START ON THEM.
; EACH BUFFER ENDS ON A WORD BOUNDARY, AND IS FOLLOWED BY ONE UNUSED WORD,
; WHICH IS INCLUDED IN BUFFER SPACE. ASIDE FORM THOSE UNUSED WORDS, EVERY WORD
; IN BUFFER SPACE CONTAINS PART OF AT LEAST ONE BUFFER.
; BUFFER DATA IS POINTED TO BY BUFFER FRAMES (SEE MFBFR),
.SEE BEG ; OR, FOR THE CURRENT BUFFER, BY BEG, ETC.
BFRBOT: INIBUF ;CHAR ADDR BOTTOM OF BUFFER SPACE (= BEG OF LOWERMOST BUFFER)
BFRTOP: INITOP ;CHAR ADDR TOP OF BUFFER SPACE (> Z OF UPPERMOST BUFFER)
; THE MEMORY ABOVE BUFFER SPACE CAN CONTAIN ^P-SORT TABLES. IT CAN
; ALSO CONTAIN RANDOM DATA USED ENTIRELY WITHIN A SINGLE COMMAND.
MEMT: <1777+INITOP/5>_-10. ;NUMBER OF 1ST PAGE OF NXM ABOVE BUFFER SPACE.
; ABOVE THE RANDM DATA THERE IS A GAP, RUNNING TO THE TOP OF MEMORY OR TO THE
; BEGINNING OF PURE STRING SPACE, WHICH STRETCHES DOWN FROM THE TOP OF MEMORY.
; OBJECTS IN PURE STRING SPACE LOOK LIKE OBJECTS IN IMPURE STRING SPACE, AND
; ARE POINTED TO BY NUMBERS WHICH ARE SETZ PLUS THE ABSOLUTE CHARACTER ADDRESS.
LHIPAG: LHIMAX ;LOWEST PAGE IN USE BY PURE STRING SPACE.
INSINP: 0 ;WHILE INSERTING, PDL LEVEL AT INSLUP, ELSE 0.
INSLEN: 0 ;LENGTH OF THE LAST STRING INSERTED OR SEARCHED FOR.
TOTALC: 0 ;# CHARS AT END OF GAP NOT YET USED BY INSERT.
INSRCH: 0 ;INSN FOR INSERT TO XCT TO GET A CHAR.
INSDLM: 0 ;THE DELIMITER FOR THIS INSERT
INSBP: -1 ;NORMALLY -1 => NO ACTION.
;INSERT AND FCECMD SET IT TO 0, SIGNALLING RCH
;THAT BP SHOULD BE SAVED IN INSBP IF THERE IS A CHANCE
;THAT A GC WILL OCCUR (EG IF PUSMAC IS CALLED).
;BFRRLC WILL THEN RELOCATE INSBP AS A BYTE POINTER
;EVENTUALLY RCH WILL COPY INSBP BACK TO BP AND ZERO INSBP.
;VARIABLES DESCRIBING THE CURRENTLY SELECTED BUFFER.
BFRSTR: SETZ INI..O-INIQRB ;INTERNAL VERSION OF $QBUFR;
;-> POINTER-STRING OF CURRENT BUFFER.
BFRPTR: MFBUF1 ;-> BUFFER FRAME FOR CURRENT BUFFER (IN MACRO-FRAME SPACE).
BEG: INIBEG ;CHARACTER ADDRESS OF BEGINNING OF BUFFER
BEGV: INIBEG ;CHAR ADDR BEGINNING OF AREA BEING EDITED.
PT: INIBEG ;CHARACTER ADDRESS OF "POINTER"
GPT: INIBEG ;CHARACTER ADDRESS OF THE BEGINNING OF THE GAP
ZV: INIBEG ;CHAR ADDR 1ST CHAR AFTER AREA BEING EDITED.
Z: INIBEG ;CHARACTER ADDRESS OF FIRST CHARACTER AFTER BUFFER
EXTRAC: 0 ;SIZE OF GAP (# CHARS)
JRST SUPCMD ;START TECO HERE TO REQUEST SPACE IN BUFFER, ETC.
SUPARG: 0 ;HOW MUCH SPACE IS WANTED. RETURNS WITH .BREAK 16,100000
MODIFF: 0 ;NONZERO IFF THIS BUFFER HAS BEEN WRITTEN IN RECENTLY.
;SET BY WRITING; CAN BE SET OR CLEARED BY USER.
READON: 0 ;NON-0 DISALLOWS MODIFYING THIS BUFFER; CAN BE SET OR CLEARED BY USER
MODIFM: 0 ;ALTERNATE VERSION OF MODIFF, NOT DISPLAYED IN THE MODE LINE.
;YOU CAN CLEAR EITHER ONE BY ITSELF.
;VARS ASSOCIATED WITH COMPUTATION OF NUMERIC ARGUMENTS.
LEV: 0 ;DEPTH IN PARENTHESES.
NUM: 0
SARG: 0 ;ARG BEFORE COMMA FOUND HERE IF FRARG2 FLAG SET.
DLIM: ADD C,SYL ;THIS INSN SET BY ARITH OPS.
SYL: 0
OSYL: 0
IBASE: 10. ;INPUT RADIX FOR NUMBERS NOT FOLLOWED BY "."
I.BASE: 8 ;INPUT RADIX FOR NUMBERS FOLLOWED BY ".".
;VARS USED BY TYPE-IN, AND LIS.
TYIBUF: BLOCK TYIBSZ ;BUFFER WHICH HOLDS LAST TYIBSZ*3 INPUT CHARACTERS.
TYIBFP: 441400,,TYIBUF ;POINTER FOR STORING IN TYIBUF.
TYIBFQ: 441400,,TYIBUF ;PTR FOR READING. COPIED FROM TYIBFP AFTER EACH CHAR STORED.
TYISNK: 0 ;MACRO TO BE CALLED WITH EACH TYPED-IN CHARACTER (BUT NOT REREAD ONES)
;IN ADDITION TO PROCESSING THE CHARACTER NORMALLY. FOR DEFINING MACROS.
TYISRC: 0 ;NONZERO => MACRO TO SUPPLY "TYPE-IN" CHARACTERS. FOR EXECUTING MACROS.
ECHOFL: 0 ;NONZERO => SYSTEM ECHOING IS TURNED ON.
LTYICH: 0 ;LAST CHAR READ FROM TTY, FOR DETECTING $$.
UNRCHC: -1 ;-1, OR CHARACTER TO BE RE-READ.
INCHCT: 0 ;NUMBER OF CHARACTERS READ FROM TTY SO FAR.
INCHRR: 0 ;VALUE OF INCHCT AT LAST TIME THROUGH RRLP1.
;INCHCT-INCHRR IS LENGTH OF THIS ^R COMMAND IN INPUT CHARS.
INCHEC: -1 ;FUTURE VALUE OF INCHCT AT WHICH NEXT NON-REMOTELY-ECHOED CHAR
;WILL APPEAR. AS LONG AS INCHCT <= INCHEC, WE ARE PROCESSING
;PRE-ECHOED INPUT, AND WE SHOULD PRETEND TO DISPLAY BUT OUTPUT NOTHING.
LEABLE: 0 ;1 => TERMINAL HAS ABILITY TO DO LOCAL EDITING.
LEINIT: 0 ;-1 => MUST TOTALLY REINIT LOCAL EDITING MODES.
LEDEFS: 0 ;TABLE MATCHING COMMAND DEFINITIONS TO %TDEDF FUNCTION CODES.
;IF THIS IS A QVECTOR, IT SHOULD CONTAIN ALTERNATING
;COMMAND DEFINITIONS AND FUNCTION CODES.
;TECO SEARCHES THE TABLE FOR THE CURRENT DEFINITION OF A COMMAND
;AND USES THE FUNCTION CODE THAT MATCHES (OR 0, IF NO MATCH).
;IF THIS IS A STRING, TECO EXECUTES IT, AND THEN EXPECTS
;LEDEFS TO HAVE BEEN SET TO A QVECTOR OR ELSE 0.
INCHSY: 0 ;VALUE OF INCHCT WHEN LAST INPUT RESYNCH WAS RECEIVED FROM
;REMOTE SMART TERMINAL.
INCHRQ: 0 ;DON'T SEND ANOTHER %TDECO UNTIL INCHCT IS BIGGER THAT INCHRQ.
INSYNC: 0 ;UNIQUE ID FROM LAST INPUT RESYNCH RECEIVED.
RDFMSK: REPEAT 20,-20
;1 BIT FOR EACH 9-BIT CHAR (32 PER WORD); SET IF CHAR HAS BEEN REDEFINED
;AND LOCAL EDITING TERMINAL HAS NOT BEEN INFORMED.
WRDMSK: REPEAT 4,0 ;RECORDS WORD SYNTAX AS LAST DESCRIBED TO TERMINAL.
;1 BIT MEANS CHAR IS PART OF A WORD.
;32 BITS PER WORD, STARTING WITH SIGN BIT.
INSMOD: 1 ;1 => TERMINAL IN INSERT MODE. 2 => REPLACE MODE.
;0 =. SELF-INSERTING CHARS TURNED OFF IN TERMINAL.
TBOTMAR:0 ;# LINES AT SCREEN BOTTOM NOT BEING USED FOR EDITING,
;AS LAST TOLD TO THE TERMINAL.
HELPMA: 0 ;FS HELP MAC$: NONZERO => MACRO TO RUN WHEN "HELP" KEY IS TYPED.
HELPCH: TOP+"H ;FS HELP CHAR$: CHARACTER TO INVOKE HELP MACRO
PROMCH: "& ;THE PROMPT-CHARACTER; FS PROMPT $. 0 => NO PROMPTING.
CMFLFL: 0 ;-1 READ COMMAND OR INIT FILE
;[[
CTLBRF: 0 ;-1 IF READING CHARACTER AFTER A ^] OR ^]^Q (IN TECO CMD STRING).
CBMAX: 0 ;LENGTH OF WHAT IS NOW IN CBUF.
SAVCMX: 1 ;CBMAX OF LAST CBUF STRING THAT WAS LONGER THAN 3 WORDS.
SAVCW1: 0 ;AND 1ST 3 WDS OF THAT CMD STRING.
SAVCW2: 0 ;THESE VARS COPIED BACK INTO CBMAX, CMD BUFFER,
SAVCW3: 0 ;AND CPTR BY LISCY (^Y AS FIRST CHAR TYPED)
SAVCPT: 0 ;(SAVED CPTR) SO IT CAN RESTORE LAST LONG COMMAND.
FSPSPB: BLOCK FSPSPL ;RING BUFFER OF PT.
FSPSPP: 4400,,FSPSPB-1 ;RING BUFFER POINTER, -> LAST USED ENTRY.
LISTF5: CALL . ;XCT THIS TO OUTPUT A CHARACTER.
DPT5: MOVEI CH,40 ;RH HAS CHARTO PAD A PRINTED NUMBER WITH.
SUBTTL MACRO CALL FRAMES
;MACRO AND ITERATION HANDLING LIST STRUCTURE:
;EACH CELL HAS MFBLEN WORDS.
;LISTS ARE LINKED THRU THE LAST WORD.
;THE FIRST 2 WORDS ARE RELOCATED BY GC.
;POINTERS TO NON-FREE BLOCKS ACTUALLY POINT TO THE
;LAST WORD OF THE BLOCK.
MFBLEN==7 ;# WORDS PER CELL.
;[ ;MACRO OR ^]<Q-REG> INVOKATION LIST...
;(POINTED TO BY MACPTR)
MFCCNT==0 ;COMCNT
MFCPTR==1 ;CPTR
MFCSTR==2 ;CSTR
MFARG1==3 ;MARG1
MFARG2==4 ;MARG2
MFPF==5 ;MACSPF
MFLINK==6 ;MACPTR <POINTER TO PREVIOUS MACRO CELL.>
;LH HAS SAVED LH(MACBTS).
;[[[ ;^]^X READ CELL. ^]^X IS A SPECIAL KLUDGE TO ALLOW STRING ARGUMENTS
;TO BE READ FROM THE PREVIOUS COMMAND STRING LEVEL. IT TRIES TO BE
;CLEVER ABOUT WHAT IT DOES WHEN OTHER ^] STRINGS ARE ENCOUNTERED WHILE
;SCANNING FOR THE END OF THE ARGUMENT, DEFINED BY THE FIRST <ALTMODE>
;ENCOUNTERED THAT ISN'T PROTECTED AGAINST TRIPPING THE CATCH (IE., BY QUOTING IT)>
;THESE CELLS FORM A LIST POINTED TO BY CTXPTR.
;COMCNT
;CPTR
;CSTR
;MARG1
;MARG2
;UNUSED.
;[ ;CTXPTR <POINTER TO THE PREVIOUS ^]^X CELL IN FS: SPACE>
;ITERATION OR ERRSET (:< -- >)CELL
;THESE FORM A LIST POINTED TO BY ITRPTR.
;COMCNT
;CPTR
;CSTR
MFICNT==3 ;ITERCT <NUMBER OF ITERATIONS LEFT ON THE PREVIOUS ITERATION LEVEL>
MFMACP==4 ;MACPDP <FOR POPPING ON ERROR IN ERRSET>
MFERS1==40 ;THE 40 BIT IN THE LH (THE EXTRA BIT OF THE BYTE POINTER WHICH IS MACPDP)
;IS USED TO INDICATE THAT THIS IS AN @:< TYPE OF ERRSET.
MFPF==5 ;LH OF THIS WORD HAS RH OF P, RH HAS RH OF PF.
;AS THEY WERE WHEN THE < WAS EXECUTED.
;ITRPTR <PREV. ERRSET CELL,,PREV ITER CELL.>
;BUFFER FRAME - DISTINGUISHED BY NEGATIVE 1ST WORD OF BLOCK.
MFBBTS==770000 ;THESE ARE ALL THE BITS IN MFBEG WORDS.
MFBFR==400000 ;1 => THIS IS A BUFFER FRAME.
MFMARK==200000 ;GC MARK BIT FOR BUFFER FRAME.
MFQVEC==100000 ;BIT INDICATING MARK THRU THE WORDS OF THIS BUFFER
MFMODIF==040000 ;1 => THIS BUFFER HAS BEEN WRITTEN IN RECENTLY (MODIFF).
MFREADO==020000 ;1 => DONT ALLOW MODIFICATION OF THIS BUFFER
MFMODM==010000 ;1 => THIS BUFFER HAS BEEN WRITTEN IN RECENTLY (MODIFM).
MFBEG==0 ;HOLDS WHAT WOULD BE IN BEG IF THIS BUFFER WERE SELECTED.
;AS WELL AS MFBFR AND MFMARK IN THE LH.
MFBEGV==1 ;SIMILAR, BUT FOR BEGV, AND NO MFBFR OR MFMARK.
MFPT==2 ;SIMILAR, FOR PT.
MFGPT==3 ;SIMILAR, FOR GPT.
MFZV==4 ;SIMILAR, FOR ZV.
MFZ==5 ;SIMILAR, FOR Z.
MFEXTR==6 ;SIMILAR, FOR EXTRAC.
;THE FREE STORAGE LIST OF CELLS IS POINTED TO BY MFFREE,
;AND LINKED THROUGH THE LAST (MFLINK) WORD OF THE CELL,
;AND TERMINATED WITH A 0.
;THE MFCPTR OF A FREE CELL CONTAINS 0.
;POINTERS TO FREE CELLS ACTUALLY POINT TO THE WORD
;BEFORE THE FIRST WORD OF THE CELL.
;IF THE 1ST WORD OF A CELL IS NEGATIVE (MFBFR IS SET) THE CELL IS A BUFFER FRAME.
MFFREE: MFSTRT-1 ;MACRO FRAME FREE LIST POINTER.
MFEND: MFEND1 ;END OF SPACE ALLOCATED TO MACRO FRAMES.
COMCNT: 0 ;NUMBER OF CHARACTERS LEFT IN CURRENT LEVEL OF COMMAND STRING
CPTR: 0 ;BYTE POINTER TO COMMAND STRING (CURRENT LEVEL)
CSTR: 0 ;THE TECO STRING OBJECT WE ARE NOW EXECUTING PART OF.
;IF EXECUTING SOMETHING NOT IN A TECO STRING, THIS IS BP TO ILDB 1ST CHAR.
MARG1: 0 ;FIRST NUMERIC MACRO ARGUMENT (GOTTEN BY ^X INSIDE MACRO)
MARG2: 0 ;SECOND NUMERIC MACRO ARGUMENT (FETCHED BY ^Y)
MACSPF: 0 ;PF COPIED INTO THIS WORD WHEN MACRO IS CALLED.
MACPTR: 0 ;POINTER TO THE LAST CELL IN THE MACRO INVOKATION AND
;[ ;^]<Q-REGISTER> INVOKATION LIST
MACDEP: 0 ;NUMBER OF FRAMES IN MACPTR STACK (INCLUDING THOSE VIA MACXP).
CTXPTR: 0 ;[ ;POINTER TO LAST CELL IN THE ^]^X INVOKATION LIST
MACBTS: 0 ;BITS IN LH SAYING HOW MANY ARGS GIVEN TO CURRENT MACRO.
MFBA1==400000 ;1 => 2 ARGS WERE GIVEN.
MFBA2==200000 ;1 => AN ARG WAS GIVEN.
MFBATSN==100000 ;1 => @ WAS SPECIFIED IN THE CALL TO THIS MACRO.
ITRPTR: 0 ;RH PTR TO INNERMOST ITERATION OR ERRSET CELL
;LH PTR TO INNERMOST ERRSET CELL (OR 0)
ITERCT: 0 ;# PASSES LEFT IN INNERMOST ITERATION.
;[[[[[ ;THE MACRO PDL CONSISTS OF 4-BIT BYTES, ONE PER MACRO CALL
;OR ^]-CALL (INCLUDING ^]^X).
;MACRO PDL OVERFLOW IS IMPOSSIBLE BECAUSE THE RATIO OF MACRO-PDL
;TO MACRO CELL SPACE INSURES THAT THE LATTER WILL RUN OUT FIRST.
;ONE ENTRY PUSHED FOR EACH ^] CALL (INCLUDING ^]^X) OR M COMMAND.
;0 => MACRO CALL THAT DIDN'T SUPERQUOTE OR DELIMITER-PROTECT.
;1 - 7 => MACRO CALL. 4 BIT => HAD BEEN LOOKING FOR $ AT RCHALT.
; 1 AND 2 BITS: SUBTRACT 1, THEN GET OLD 4.8, 4.9 OF SQUOTP.
;10 => NULL ENTRY, IGNORE WHEN POPPING.
;11 THRU 17 => ^]^X CALL, LOW 3 BUTS SAME AS FOR 1 - 7.
MACPDP: 400,,MACPDL-1 ;MACRO PDL PTR, -> HIGHEST USED BYTE.
MACPDL: BLOCK MACPSZ
MACXP: 0 ;P IN LAST CALL TO MACXCT OR MACXQ.
SUBTTL SORT AND SEARCH VARIABLES
;^P SORT VARIABLES:
PSMEM: 0 ;WD ADDR 1ST WD OF ^P SORT TABLE
;(WHICH LIVES ABOVE THE BUFFER)
PSMEMT: 0 ;WD ADDR 1ST WD OF LAST ENTRY OF TABLE
;ENTRIES ARE ADDED AT THE END, AND ARE 4 WDS LONG.
PSSAVP: 0 ;P SAVED INSIDE ^P, OR 0. USED TO TELL WHETHER A SORT IS IN PROGRESS.
;ALSO USED TO DETECT UNWINDING OUT OF A SORT.
PSZF: 0 ;SET TO -1 TO INDICATE LAST RECORD HAS BEEN FOUND.
PSCASE: 0 ;NONZERO => ^P-SEARCH IGNORES CASE. (FS ^PCASE)
LPSDBK==4 ;SORT TABLE ENTRIES ARE 4 WDS LONG:
;0TH WD CHAR ADDR START OF KEY, RELATIVE TO BEG.
;LATER REPLACED BY BP TO ILDB KEY.
;1ST WD -<# CHARS IN RECORD>,,-<# CHARS IN KEY>
;2ND WD CHAR ADDR START OF RECORD, RELATIVE TO BEG.
;3RD WD POINTER (RELATIVE TO PSMEM) TO NEXT ENTRY,
;OR -1 FOR LAST ENTRY. TABLE IS SORTED
;BY CHANGING THESE POINTERS.
;SEARCH VARIABLES:
PNCHFG: 0 ;0 => S OR FB OR REVERSE SEARCH, 1 => _, -1 => N
SEARG: 0 ;# TIMES TO SEARCH. 1 FOR FB;
;= ABS VAL. OF NUMERIC ARG FOR S, _, N.
SRCBEG: 0 ;CHARACTER NUMBER (REL TO BEG) OF START OF SEARCH RANGE.
SRCEND: 0 ;CHARACTER NUMBER (REL TO BEG) OF END OF SEARCH RANGE.
SRCERR: 0 ;-1 => FAILING SEARCHES SHOULD BE ERRORS EVEN INSIDE ITERATIONS.
BBP: 0 ;BP. TO 1ST CHAR IN RANGE TO BE SEARCHED.
ZBP: 0 ;BP TO CHAR AFTER LAST CHAR IN RANGE TO BE SEARCHED.
BBP1: 0 ;NOT USED IN FORWARD SEARCH.
;FOR BACKWARD SEARCH, IT IS THE SAME AS BBP
;UNLESS THE GAP IS BETWEEN BBP AND WHERE WE ARE SEARCHING,
;IN WHICH CASE BBP1 POINTS TO THE FIRST CHARACTER AFTER THE GAP.
ZBP1: 0 ;IF GAP IS WITHIN RANGE OF SEARCH,
;BP TO 1ST CHAR POS WITHIN THE GAP; OTHERWISE, SAME AS ZBP.
;WHEN FWD SEARCH CROSSES THE GAP, ZBP1 SET FROM ZBP
SLP4N: 0 ;WHEN E MOVES TEMPORARILY FORWARD OVER THE GAP, WHILE TESTING ONE ALTERNATIVE,
SLP4N1: 0 ;SLP4 AND SLP4-1 ARE SAVED IN THESE TWO WORDS.
;WHEN E IS RESET FROM C, THEY ARE RESTORED FROM THESE WORDS.
SLP1P: JRA B,. ;SLP1D\SLP1I INSTRUCTION EXECUTED WHEN TIME TO READ ANOTHER CHARACTER
TEM1: 0 ;0, OR BP TO START OF LAST INSTANCE FOUND.
TEM2: 0 ;0, OR BP TO END OF LAST INSTANCE FOUND.
SFINDF: 0 ;VALUE OF THE LAST SEARCH (WHETHER :-SEARCH OR NOT)
SBFRS: SETZ INISRS-INIQRB ;STRING-POINTER THAT PRESERVES SEARCH-BUFFER.
SBFRP: MFSBUF ;-> SEARCH BUFFER HEADER.
STBLP: INISRB/5 ;ADDRESS OF SEARCH BUFFER BODY.
STBLPX: INISRB/5,,SLP1P ;ALWAYS THE SAME FUNCTION OF STBLP.
SFXOR: 0 ;ASCII /QQQQQ/, IF 1ST CHAR OF SEARCH STRING IS Q, INSIDE SFAST.
SFASAD: SFAFN0,SFAFC0 ;ADDRESS TO ENTER APPROPRIATE MAIN LOOP OF SFAST.
;DEPENDS ON WHETHER CASE BEING IGNORED FOR 1ST CHAR OF STRING.
SUBTTL MORE VARIABLES
GCPTR: 0 ;POINTER USED BY GC FOR STORING RELOCATION INFO.
;ALSO, NONZERO MEANS GC IS IN PROGRESS.
GCNRLC: 0 ;-1 => GC SHOULDN'T RELOCATE STRINGS, JUST FLUSH UNNEEDED BUFFERS.
QRGCMX: INIQRB+GCOFTN ;GC IMPURE STRINGS WHEN QRWRT GETS THIS LARGE.
STOPF: 0 ;FS QUIT$. NEGATIVE == QUIT DESIRED (FS QUIT)
;^G AT INT LVL SETS STOPF; SETTING STOPF CAUSES
;QUITTING ACTION UNDER CONTROL OF NOQUIT.
NOQUIT: 0 ;(FS NOQUIT) 0 => ^G QUITS TO TECO'S TOP LEVEL.
;POSITIVE => ^G JUST SETS STOPF FOR PROGRAM TO TEST.
;NEGATIVE => ^G CAUSES "QIT" ERROR (ERRSETABLE).
CLKFLG: 0 ;-1 => IT IS TIME TO RUN THE REAL-TIME CLOCK ROUTINE.
CLKINT: 0 ;SETTING OF FS CLK INT$.
CLKMAC: 0 ;POINTER TO REAL-TIME CLOCK ROUTINE.
RUNFLG: 0 ;-1 ==> TECO HAS BEEN RUN. Q..Q, ETC. HAVE BEEN INITTED.
VARMAC: 0 ;NONZERO => ENABLE FEATURE OF CALLING MACRO WHEN A NAMED VARIABLE IS SET.
LASTER: 0 ;MOST RECENT ERROR MESSAGE (A STRING POINTER).
ERRFLG: 0 ;-1 WHILE PROCESSING AN ERROR.
ERRFL1: 0 ;FS ERRFLG$ - NEGATIVE (-<N>) =. PROTECT 1ST <N> LINES OF SCREEN
;FROM REDISPLAY (ASSUMING THEY CONTAIN ERROR MESSAGE). SET BY FG.
VERBOS: -1 ;IF NON-ZERO, DISPLAY WHOLE ERROR MESSAGE STRING IMMEDITAELY
ERR1: 0
ERR2: 0
ERRECH: 0 ;-1 => TYPE ERR MSGS IN ECHO AREA.
PTLFCD: 0 ;PTLAB FILE CREATION DATE
STABP: ;THIS IS THE CACHE FOR JUMPS ("O" COMMAND)
SYMS: BLOCK 20 ;THESE HOLD THE CPTRS AT SOME JUMPS;
VALS: BLOCK 20 ;THESE, THE CPTRS OF TAGS JUMPED TO;
CNTS: BLOCK 20 ;THESE, THE COMCNTS AT THOSE TAGS.
SYMEND: ;ENTRIES ARE IN PAIRS. EACH JUMP CPTR SELECTS A PAIR
;THE ENTRIES IN A PAIR ARE USED FIFO BY NEW JUMPS.
PF: -LPF-1,,PFL-1 ;Q REGISTER PDL POINTER
PFL: BLOCK LPF
;QREG PDL ENTRIES ARE 2 WORDS EACH.
;THE FIRST WORD CONTAINS THE DATA PUSHED.
;THE SECOND CONTAINS INFO ON WHERE PUSHED FROM:
; EITHER THE CORE LOCATION PUSHED FROM,
; THE QREG NAME (FOR Q$FOO$ Q-REGS),
; OR THE INDEX IN FLAGD OF THE FS FALG THAT WAS PUSHED.
; THESE ARE DISTINGUISHED BY WHETHER THE NUMBER IS < FLAGSL.
PDL: BLOCK LPDL
BAKTAB: ;TEMPORARY BUFFER FOR USE WITHIN A COMMAND.
;MAY BE CLOBBERED WHENEVER OUTPUT OR INPUT IS DONE.
IFN COMNDF,LTABS==120.
.ELSE LTABS==100.
IFNDEF F10LEN,F10LEN==FNMLEN*5/4 ;# WDS NEEDED FOR FILENAME IF STORED AS 8-BIT BYTES.
IFL LTABS-F10LEN-3*FNBLEN,LTABS==F10LEN+3*FNBLEN ;# WDS FFRRDD WANTS.
BLOCK LTABS
;HOLDS STRING ARG DURING MANY COMMANDS (O, FO, F^B, F^G ...)
;JCL READ INTO IT. USED AS BUFFER BY E_. USED BY ALINK
;TO HOLD SOME TEMPS.
QRB: QTAB ;POINTER TO BLOCK OF QREGS WITH NO "."'S IN NAME.
QRB.: QTAB+36. ;POINTER TO BLOCK OF ONE-"." QREGS.
QRB..: QTAB+36.*2 ;POINTER TO BLOCK OF ".." QREGS.
QTAB: BLOCK NQREG
CTLCF: 0 ;SET BY ^C, SAYS EXIT AFTER COMMAND DONE.
UTIBUF: BLOCK UTBSZ ;BUFFER FOR READING FROM CHFILI
UTIBE: 0 ;WORD TO HOLD A ^C STUCK ON TO DETECT EOB
UTRLDT: 350700,, ;B.P. TO THE ^C TERMINATING FILLED PART OF UTIBUF
UTYIP: 010700,,0 ;B.P. FOR UNLOADING UTIBUF
UTOBUF: BLOCK UTBSZ ;BUFFER FOR WRITING TO CHFILO
UTOBE:
UTYOP: 010700,,0 ;B.P. FOR STUFFING UTOBUF
UTYOCT: 0
IMQUIT: 0 ;-1 SAYS ^G SHOULD QUIT IMMEDIATELY.
;SET EG. DURING SEARCHES, WHICH DON'T NEED TO CLEAN UP.
;1 => GOX1 SHOULD JUST OMIT PUSHING STUFF.
;SET TO 1 ONLY AT TECO STARTUP AND WITHIN LIS.
GOXFLS: 0 ;ZEROED BY GO. -1 => GO SHOULD POP ALL THE WAY TO THE TOP LEVEL.
;1 => GOX1 SHOULD JUST OMIT PUSHING STUFF.
TSINAL: 0 ;-1 => LAST INT. CHAR. WAS ALTMODE. (FOR FINDING $$ AT INT LVL)
TSALTC: 0 ;# OF $$'S ITYIC'D BUT NOT IOT'D.
PAGENU: 0 ;PAGE # IN INPUT FILE.
LASTPA: -1 ;0 IF HAVE YANKED LAST PAGE OF INPUT FILE.
IFN ITS,MSNAME: 0 ;WORKING DIRECTORY.
HSNAME: 0 ;HOME DIRECTORY (SIXBIT IN ITS, DIR # IN TWENEX).
OUTFLG: 0 ;-1 => OUTPUT TO EW'D FILE DISABLED.
FILEPA: EOFCHR ;CHAR TO PAD LAST WORD OF OUTPUT FILES WITH.
RDMNMS: 3.14 ;USED BY RANDOM # GENERATOR. VALUE OF FS RANDOM
DOWNF: 0 ;-1 => DOING AN FLD
SEXPFL: 0 ;-1 => FL IS LOOKING FOR S-EXP, NOT LIST.
;S-EXP MEANS EITHER WORD OR LIST, WHICHEVER STARTS FIRST.
FFRRCT: 0 ;IN FILENAME READER = <# OF FILENAMES> -1
FNAMSY: 0 ;0 => IF ONLY 1 FILENAME IN STRING, IT IS FN2.
;NOT 0 => IT IS FN1 (LIKE ALL OTHER PROGRAMS). (FS FNAMSYNTAX)
ADLINE: 60. ;SIXTY CHARACTERS PER LINE OF ADJUSTED TEXT (FA)
NOOPAL: -1 ;IGNORE ALTMODES IF NEGATIVE.
;STRAY ALTMODES ARE ERRORS IF THIS IS 0. THEY ARE LIKE ^_ IF >0.
NLAROW: 0 ;0 => "_" LEGAL. 1 => ILLEGAL. -1 => "_" TREATED AS "-".
YDISAB: 0 ;0 => Y IS LEGAL. 1 => ILLEGAL. -1 => Y TREATED AS ^ Y.
TABMOD: 0 ;0 => TAB INSERTS, 1 => TAB ILLEGAL, -1 => TAB IGNORED.
FFMODE: 0 ;NON0 => ^L'S READ FROM FILE GO IN BFR.
;0 => ^L AT END OF PAGE Y'D OR FILE ^Y'D
;IS THROWN AWAY, AND PW GENERATES A ^L.
UNWINF: 0 ;0 => UNWIND QREG PDL AFTER EACH COMMAND STRING.
BKRTLV: 0 ;INSIDE FS BACK RET, IS MACRO FRAME TO RETURN TO.
BOTHCA: 0 ;NONZERO => SEARCH DOESN'T DISTINGUISH UPPER AND LOWER CASE.
SKNBPT: 0 ;B.P. TO LDB 1ST CHAR OF THE STRING IN .QDLIM.
;HAS A IN INDEX FIELD.
KILMOD: -1 ;0 => FS BKILL SHOULDN'T REALLY KILL.
SLPNCR: 0 ;-1 => SLPN00 SHOULDN'T CLEAR LOW BITS.
TRCOUT: 0 ;NONZERO WHILE OUTPUTTING TRACE OUTPUT.
;USED TO PREVENT TRACE OUTPUT FROM CLOBBERING TOP LINE OF SCREEN.
PUREFL: 0 ;-1 => TECO HAS BEEN PURIFIED.
INITF1: 0 ;SET TO -1 BY STARTUP CODE SO THAT ..L WILL BE MACROED
;NEXT TIME THROUGH THE LOOP AT GO.
INITFL: 0 ;TECO WAS STARTED AT INIT+2, SAYING IT IS UNDER A LISP.
STEPFL: 0 ;-1 => TECO MACRO LINE-STEPPING FEATURE ENABLED:
;CR AS A COMMAND DOES ^VW AND THEN QUITS IF CHAR IS ^G,
;ENTERS ^R IF CHAR IS ^R, SETS STEPFL TO 0 IF CHAR IS ^P.
;ELSE, CAN BE A MACRO TO CALL TO DO THE STEPPING.
STEPDE: -1 ;MAXIMUM MACRO PDL DEPTH (FS BACKDEPTH) AT WHICH TO ALLOW STEPPING, OR -1.
SETPP: 0 ;OLD CONTENTS OF P BEFORE MOST RECENT CALL TO SETPP. DEBUGGING ONLY.
SUPHND: 0 ;FS SUPERIOR$ - MACRO TO HANDLE REQUESTS FROM SUPERIOR.
TOPBUF: 0 ;FS TOPBUF$ - EXTRA POINTER TO BUFFER SELECTED BY ^R TOP LEVEL.
CNGBUF: 0 ;FS CNGBUF$ - LIST OF CHANGES TO TOPBUF.
OLDZ: 0 ;FS OLDZ$ - Z as of last GAPSLP.
SUBTTL BOOTSTRAP FOR EJ FILES
IF2 PURP1==INIT/2000 ;# OF 1ST PURE CODE PAGE
IF2 PURPL==<HUSED+1777>/2000 ;# OF 1ST PAGE ABOVE PURE CODE.
BOOT: JRST BOOT1 ;THIS IS THE START ADDRESS WRITTEN INTO EJ FILES.
IFN ITS,.VALUE
.ELSE JRST BOOT1 ;REENTER SAME AS START
SETOM INITFL ;START AT START + 2 => SET FS LISPT.
IFN TNX,MOVEM 1,CCLJFN ;TWENEX - SAVE THE JFN WE WERE GIVEN FOR FS CCL FNA$
BOOT1: SKIPE LIMPUR ;WERE WE JUST LOADED, OR WERE WE RESTARTED?
JRST INIT ;RESTARTED => PURE CODE ALREADY PRESENT, SO DO NORMAL RESTART.
IFN ITS,[
SYSCAL OPEN,[[.UII,,CHFILI] ? ['DSK,,] ? ['TECPUR]
RADIX 10.
[SIXBNM \.FVERS]
RADIX 8
['.TECO.]]
.LOSE %LSFIL ;TECO PURE FILE NOT FOUND.
.IOT CHFILI,A
SKIPE A
.LOSE ;NOT A PDUMP FILE??
.ACCESS CHFILI,[INIT+2000] ;GOBBLE TECO'S PURE PAGES OUT OF THE PDUMP FILE.
MOVE A,[PURP1-PURPL,,PURP1]
SYSCAL CORBLK,[%CLIMM,,%CBNDR ? %CLIMM,,%JSELF ? A ? %CLIMM,,CHFILI]
.LOSE %LSFIL
.CLOSE CHFILI,
]
IFN TNX,[
MOVE P,BOOTP
MOVSI 1,(GJ%OLD\GJ%SHT)
RADIX 10.
IFN 20X,[ IFN EMCSDV, HRROI 2,[STRCNC [EMACS:TECPUR.EXE.]\.FNAM3 ]
.ELSE HRROI 2,[STRCNC [PS:<EMACS>TECPUR.EXE.]\.FNAM3 ]
]
.ELSE HRROI 2,[STRCNC [<EMACS>TECPUR.SAV;]\.FNAM3 ]
RADIX 8
GTJFN
.VALUE
IFN 20X,[IOR 1,[.FHSLF,,GT%ADR]
MOVE 2,[PURP1*2,,PURPL*2]
]
.ELSE HRLI 1,.FHSLF
GET
];IFN TNX
SETOM PJATY ;SCREEN NEEDS COMPLETE REDISPLAY SINCE WE HAVEN'T INITTED IT.
MOVEI TT,LHIMAX ;WE HAVE NO LIBRARIES LOADED IN YET.
MOVEM TT,LHIPAG
;PUT A BREAKPOINT HERE TO STOP EMACS WHEN TECPUR IS MAPPED IN.
HAVPUR: JRST INIT
CONSTA ;WITHOUT THIS, OUR LITERALS WOULD BE IN THE PURE CODE.
RRVARX:: IF2 IFNDEF RRVARB, RRVARB:: BLOCK RRVARL
IF2 VPAT: VPATCH:
INFORM [END OF LOW IMPURE]\.-1
LOC .\1777 ;MOVE TO LAST WORD OF PAGE
LIMPUR:: -1 ;0 => THIS IS AN EJ FILE JUST LOADED; IT MUST GET TECO'S PURE PAGES.
SUBTTL ^R MODE VARIABLES
;^R REAL TIME EDIT MODE VARIABLES. ON PASS 2 WE PUT THEM IN LOW IMPURE IF THEY FIT,
;OTHERWISE IN HIGH IMPURE.
RRVARL==54. ;NUMBER OF WORDS OF ^R VARIABLES.
IF2 [ ;BY THE TIME WE GET HERE ON PASS 2, RRVARB WILL
;HAVE THE DESIRED LOCATION OF THE ^R VARIABLES BLOCK.
RRTMPV==. ? LOC RRVARB
RRHPOS: 0 ;CURRENT CURSOR HPOS & VPOS: REFLECT
RRVPOS: 0 ;CURRENT VALUE OF PT, EVEN IF SCREEN HASN'T CAUGHT UP.
RROHPO: -1 ;WHAT RRHPOS HELD LAST TIME CURSOR ACTUALLY WAS MOVED.
RROVPO: -1 ;IF THESE DIFFER FROM CURRENT POS, MUST MOVE CURSOR.
RRCMMT: -1 ;0 IF IN COMMENT MODE.
RRCCOL: 0 ;COLUMN IN WHICH THE COMMENTS SHOULD START.
RRMNVP: 0 ;THE VPOS OF UPPERMOST LINE THAT NEEDS REDISPLAY,
;OR 377777,,-1 MEANING NO LINES NEED REDISPLAY,
;OR -1 MEANING DON'T TRUST LINBEG AT ALL; DO FULL REDISPLAY.
;IF RRMNVP IS POSITIVE AND FINITE, ALL LINBEGS FROM TOPLIN
;DOWN THRU THE RRMNVP'TH LINE (INCLUSIVE) MUST BE ACCURATE OR YOU WILL LOSE!
RRMNHP: 0 ;LEFTMOST COLUMN ON THAT LINE THAT NEEDS REDISPLAY.
RRMAXP: 0 ;NON0 => LARGEST VALUE OF PT AT WHICH BUFFER WAS CHANGED.
RRMSNG: -1 ;EITHER -1, OR VPOS OF A LINE; SAYS THAT LINE AND FOLLOWING LINES
;NEED REDISPLAY EVEN THOUGH NOT CHANGED.
;A VALUE LESS THAN THE VALUE OF RRMNVP, IS TREATED AS IF
;IT WERE REPLACED BY A COPY OF THE VALUE OF RRMNVP.
;FOR THIS TO BE > -1 IS IN MANY WAYS LIKE HAVING RRMAXP VERY VERY LARGE,
;BUT SOME THINGS LIKE RRLCHG CAN MAKE A DISTINCTION.
RRRPCT: 0 ;NUMERIC ARG SPEC'D WITH ^V OR CTL-DIGITS.
RRARGP: 0 ;NONZERO => RRRPCT HAS BEEN SET (ELSE IT DEFAULTS TO 1).
RR4TCT: 0 ;# OF OCCURRENCES OF ^U. THE NUMERIC ARG TO A COMMAND IS RRRPCT*(4 ^ RR4TCT)
RUBCRL: 0 ;-1 => ^D AND RUBOUT DELETE A WHOLE CRLF AT ONE BLOW.
RRLAST: 0 ;MOST RECENT ^R-MODE CHAR THAT WASN'T AN ARGUMENT-SETTING COMMAND
RRPRVC: 0 ;WHAT WAS IN RRLAST BEFORE ITS CURRENT CONTENTS.
RRRPLC: 0 ;-1 => NORMAL CHARS REPLACE (X = DIX$)
;1 => THAT, AND META-CHARS INSERT (LIKE ETV)
RRMCCT: 0 ;FS CRMDLY -- # CHARS TO HANDLE BETWEEN
;INVOCATIONS OF SECRETARY MACRO.
RRMCC1: 0 ;THIS IS USED TO COUNT THAT MANY CHARS.
RRNCCR: 0 ;SET TO -1 DURING REDISPLAY IF THE PTR
;COMES AFTER A CR. THAT MEANS RRHPOS IS WRONG
;AND SHOULD BE COMPUTED BY CALLING RRBTCR.
RRCCHP: 0 ;TEMP. IN CHCT; SAVES HPOS AT START OF EACH CHAR.
RRERFL: 0 ;TEMP. THAT SAVES ERRFL1 OVER CALL TO VBD.
RROLZV: 0 ;VALUE OF ZV, AT TIME OF LAST REDISPLAY EITHER FINISHED OR PRE-EMPTED.
RRIDVP: 0 .SEE RRLID ;VPOS AT WHICH WE SHOULD INSERT/DELETE LINES.
RRIDLB: 0 ;OLD LINBEG OF THAT LINE.
RRIDBK: 0 ;# OF NEWLY MADE BLANK LINES BEFORE THAT LINE.
RRCIDP: 0 ; POS => THIS INSERT OR DELETE IS RIGHT BEFORE A TAB.
; NEG => THIS INSERT OR DELETE IS USING I/D CHAR (SPECIAL CASE, NOT RRLCHG).
RRUNQT: 0 ;-1 => TEMPORARILY REENABLE BUILTIN COMMANDS.
RRALQT: -1 ;NONNEG => DISABLE BUILTIN COMMANDS, BUT
;THIS WD'S CONTENTS ARE CHAR THAT REENABLES THEM TEMPORARILY.
RRCMQT: 0 ;-1 => ALL CONTROL-META-LETTERS,ETC. ARE SELF-INSERTING (FOR EDITING MACROS).
RREZ: INIBEG ;WHEN ^R MODE IS EXITED, Z, BEG AND PT
RREBEG: INIBEG ;ARE SAVED IN THESE 3 VARS. IF ^R IS REENTERED
RREPT: INIBEG ;WITH ARGS, THEY ARE COMPARED WITH THESE VALUES.
;RREBEG IS 0 WHILE ^R IS ACTUALLY IN CONTROL.
;NOT 0 DURING NORMAL COMMAND EXECUTION, INCLUDING MACROS CALLED FROM ^R.
;0 PREVENTS ^G FROM QUITTING AT INT LVL.
RREVPS: 0 ;REMEMBER RRVPOS AND RRHPOS AT EXIT, IN CASE WE REENTER
RREHPS: 0 ;WITH ONE ARGUMENT.
RREBUF: 0 ;REMEMBER BUFFER THAT ^R WAS PREVIOUSLY DISPLAYING (AS STRING PTR).
RRMKPT: -1 ;THE MARK USED BY ^T, ^X, ^W.
RRSCAN: 0 ;NONZERO => VARIOUS COMMANDS PRINT WHAT THEY STEP OVER/INSERT/DELETE.
RRTTMX: 50. ;FS ^RMAX$. MAX # CHARS OF INSERT TO BE WILLING TO SCAN ON PRINTING TTY.
RRTTM1: 0 ;FS ^RTTM1$. MACRO TO CALL TO HANDLE LARGE CURSOR MOTION ON PRINTING TTY.
RRECHO: 0 ;-1 => ECHO THE ^R COMMANDS EXECUTED. 0 => ECHO ONLY ON PRINTING TTY
RRMORF: 0 ;POSITIVE => USE --MORE-- INSTEAD OF --TOP--, ETC., EVEN THOUGH IN ^R.
;NEGATIVE => DON'T USE EITHER --MORE-- OR --TOP--, ETC. WHEN IN ^R.
RRSTAR: 1 ;NONZERO => DISPLAY A STAR IN MODE LINE IF BUFFER MODIFIED.
RRXINV: 0 ;THIS IS THE REAL DEFINITION OF "SELF-INSERTING CHARS", 0 => SELF-INSERT
RRPARN: 0 ;THIS GETS RUN BY ANY "SELF-INSERTING CHAR" WHOSE LISP SYNTAX IN ..D IS ")".
RRENTM: 0 ;FS ^R ENTER$, NONZERO => MACRO IT WHEN ENTER ^R.
RRLEVM: 0 ;FS ^R LEAVE$, NONZERO => MACRO IT WHEN LEAVE ^R.
RRDISM: 0 ;FS ^R DISPLAY$, NONZERO => MACRO WHEN ABOUT TO DO NONTRIVIAL REDISPLAY.
RUBMAC: 0 ;FS RUB MACRO$, NONZERO => MACRO TO DO DELETE WITH NUMERIC ARG.
;DEBUGGING VARIABLES:
RRDHPS: 0 ;REMEMBERS RRHPOS BEFORE LAST REDISPLAY.
RRDVPS: 0 ;SAME FOR RRVPOS
RRDMHP: 0 ;SAME FOR RRMNHP
RRDMVP: 0 ;SAME FOR RRMNVP
RRDPT: 0 ;REMEMBER 1ST CHAR DISPLAYED IN LAST REDISPLAY.
IFN .-RRVARB-RRVARL, .ERR RRVARL ISN'T SET RIGHT.
LOC RRTMPV
] ;END IF2
SUBTTL INITIALIZATION
INIT: SKIPE RUNFLG ;RESTARTING => DON'T CLOBBER BUFFER, Q-REGS.
JRST GOZ
SETZ FF,
MOVE P,[-LPDL,,PDL-1]
GOZ:
IFN TEXTIF,SETZM ORGWID ;[wew] ALLOW USER TO RESET WIDTH AND CONTINUE
SETZM SQUOTP ;NONZERO SQUOTP CAN INTERFERE WITH INSASC.
SETOM PJATY ;SCREEN CONTENTS HAVE BEEN RANDOMLY CLOBBERED.
SETZM STOPF
MOVE CH,LIMPUR ;CH GETS 0 IF THIS IS EITHER TECO JUST LOADED
; OR AN EJ FILE JUST LOADED
AND CH,RUNFLG
IFN ITS,[
SETZM JRNIN
.CLOSE CHJRNI, ;STOP RE-EXECUTING A JOURNAL WHEN RESTARTED.
MOVE E,[-9,,[.SMASK,,[TSMSK] ? .SMSK2,,[TSMSK1] ;SET MASKS,
.SPICL,,[-1] ? .SWHO1,,[0]
.RSNAME,,MSNAME ? .RHSNAME,,HSNAME
.RIOS+CHJRNO,,B
.RIOS+CHFILI,,A ? .RIOS+CHFILO,,C]]
.SUSET E
SKIPN B ;IF OUTPUT JOURNAL FILE NO LONGER OPEN, DON'T THINK THAT IT IS.
SETZM JRNOUT
JUMPN CH,GOZ4B ;IF TS TECO OR SOME EJ FILE HAS JUST BEEN LOADED,
SAVE C
SAVE A
SYSCAL SSTATU,[REPEAT 6,[ ? %CLOUT,,MACHIN ]]
.LOSE %LSSYS
MOVE D,[440700,,DEFFIL] ;REINITIALIZE OUR DEFAULT FILENAME.
MOVE A,MACHIN
PUSHJ P,STRGE1
MOVEI B,":
IDPB B,D
MOVEI B,40
IDPB B,D
MOVE A,MSNAME
PUSHJ P,STRGE1
MOVEI B,";
IDPB B,D
MOVEI B,40
IDPB B,D
MOVE A,[SIXBIT/FOO/]
PUSHJ P,STRGE1
MOVEI B,40
IDPB B,D
MOVEI B,">
IDPB B,D
SETZ B,
IDPB B,D
REST A
REST C
GOZ4B: SKIPN A ;ALSO SEE IF DISK CHNLS REALLY STILL OPEN, IN CASE THIS IS A RESTART.
CALL UICLS ;IF THEY AREN'T, TECO SHOULDN'T THINK THEY ARE.
SKIPN C
TLZ FF,FLOUT
];IFN ITS
IFN TNX,[
CLOSEF JRNIN
CIS ;FORGET ANY INTERRUPTS IN PROGRESS
MOVEI A,.FHSLF
MOVE B,[LEVTAB,,CHNTAB]
SIR
EIR
IFN 20X,MOVE 2,[740400,,020000] ; CHANNELS 0-3, 9 AND 22
.ELSE MOVE 2,[700410,,020000] ; CHANNELS 0-2, 9, 14 AND 22
AIC
RPCAP
TRZ 2,-1 ;ONLY ENABLE LH CAPS
IOR 3,2
EPCAP
JUMPGE 3,GOZ4A ; NO ^C CAPABILITY?
MOVE A,[.TICCC,,2]
ATI ; ^C ON CHANNEL 2
GOZ4A: SETZM ECODPF ;WE ARE NOT FOLLOWING A ^P ON TERMINAL OUTPUT.
MOVEI A,.CTTRM
RFCOC
MOVEM B,ITTYMD+1
MOVEM C,ITTYMD+2
RFMOD
MOVEM B,ITTYMD ;SAVE TTY MODES
MOVEM B,FTTYMD
IFN 20X,[
LDB C,[.BP TT%PGM,B]
MOVEM C,PAGMOD ; SAVE INITIAL TERMINAL PAGE MODE SETTING
];20X
JUMPN CH,GOZ4B
GJINF
IFN 20X,[
MOVEM D,TTYNBR ; SAVE .CTTRM NUMBER
IFE STANSW,[
TLNE A,-1
TLO A,040000 ; MAKE SURE THIS LOOKS LIKE A DIRECTORY
];IFE STANSW
.ELSE [ ; HANDLE MORE GENERAL CASE
MOVE B,A ; GET USER NUMBER
SETZ A, ; NO FLAGS
RCDIR ; GET LOGIN DIRECTORY NUMBER
MOVE A,C ; PUT IT WHERE EXPECTED
];ELSE
MOVEM A,HSNAME ; HSNAME IS DIRECTORY CORRESPONDING TO USER
MOVSI A,(GJ%OFG\GJ%SHT) ; PARSE ONLY
HRROI B,DEFFN1
GTJFN
JRST GOZ4B
CALL FFSET3 ; SET DEFAULTS FROM IT
RLJFN
JFCL
]
.ELSE [
MOVEM A,HSNAME ; HSNAME IS JUST USER
HRROI A,DEFDIR ; CANNOT JUST DO GTJFN, CAUSE LOSING TENEX FILESYSTEM WILL FAIL
DIRST ; ON SECOND ATTEMPT
JFCL
]
GOZ4B: SKIPN 1,CHFILI
JRST GOZ4
GTSTS
TLNN 1,(GS%OPN) ; FILE STILL OPEN?
CALL UICLS ; NO
GOZ4: SKIPN 1,CHFILO
JRST GOZ4C
GTSTS
TLNN 1,(GS%OPN)
TLZ FF,FLOUT
GOZ4C: SKIPN 1,JRNOUT
JRST GOZ5
GTSTS
TLNN 1,(GS%OPN)
SETZM JRNOUT
];IFN TNX
GOZ5: SETOM LIMPUR ;MAKE SURE A SECOND $G WON'T MAKE BOOT REBOOT.
CALL INITTY ;INITIALIZE TTY AND FLAGS ABOUT WHAT KIND AND HOW TO TREAT IT.
MOVEI A,[ASCIZ *-!-*] ;USE -!- FOR CURSOR ON PRINTING TTYS.
SKIPE C,RGETTY
MOVEI A,[ASCIZ */\*] ;USE /\ ON DISPLAYS.
IFN ITS,[
CAIN C,%TNIML
MOVEI A,[ASCIZ //] ;BUT USE "I-BEAM" ON IMLACS.
]
IFN TNX,[
CAIN C,DM25I
MOVEI A,[ASCIZ /_/] ;WHAT PEOPLE ARE USED TO ON DATAMEDIAS
]
HRLI A,BP7
MOVE CH,QRB..
ADDI CH,.QCRSR
CALL INSASC ;INSERT ASCII STRING IN Q-REG ..A.
SETOM INITF1 ;CAUSE ..L TO BE RUN.
GOZ3: SETZM CPTR ;CPTR MIGHT POINT INTO PURE STRING SPACE WHICH IS NOW NXM.
SKIPE C,CLKINT ;IF WE HAD CLOCK INTERRUPTS, TURN THEM BACK ON.
CALL FSCLK0
JFCL
IFN ITS,[
SKIPE RRECBP
CALL RRECI5
]
SKIPE RUNFLG
JRST CTLW
;STUFF TO DO WHEN STARTED UP THE 1ST TIME ONLY.
MOVE CH,QRB..
MOVEI A,10.
MOVEM A,.QBASE(CH) ;INIT. OUTPUT RADIX.
MOVE A,[SETZ 1+INIDLM*5-INIQRB]
MOVEM A,.QDLIM(CH)
HRRI A,INI..O-INIQRB
MOVEM A,.QBUFR(CH)
MOVEM A,.Q..Z(CH)
MOVE IN,BEG ;MAKE SURE THE BOTTOM PAGE OF BUFFER EXISTS
CALL GETCHR ;TO PREVENT CONFUSING THE CODE AT FLSCOR
SETOM RUNFLG ;SAY TECO HAS BEEN RUN.
MOVEI A,[ASCIZ/ 5FSQVECTOU..Q 2U:..Q(0)/]
CALL MACXCW ;PUT AN EMPTY SYMBOL TABLE IN ..Q.
MOVEI A,TYOA
HRRM A,LISTF5 ;CAUSE OUTPUT ROUTINES TO TYPE ON TTY.
MOVEI A,[ASCIZ/IMPURE /]
SKIPN PUREFL
CALL ASCIND
MOVE A,[.FNAM1]
MOVEI C,".
CALL SIXINT
IFN STANSW,[
MOVE A,[.FNAM2]
CAMN A,[SIXBIT/MID /]
JRST .+3
MOVEI C,".
CALL SIXINT
];IFN STANSW
MOVEI C,.FVERS
CALL DPT
IFN ITS,[
.SUSET [.RXUNAME,,C]
.CALL GOZO1 ; OPEN <HSNAME>;<XUNAME> TECO
CAIA
JRST GOZ7
MOVSI C,(SIXBIT/*/)
.CALL GOZO1 ; OPEN <HSNAME>;* TECO
CAIA
JRST GOZ7
.CALL GOZO2 ; LAST RESORT IS .TECO.;* TECO
CAIA
GOZ7: SETOM CMFLFL ;BUT IF INIT FILE EXISTS, USE IT,
GOZ6: JRST CTLW ;DROP INTO MAIN LOOP AS IF AFTER ^G.
GOZO1: SETZ ? SIXBIT/OPEN/ ? [.BAI,,CHFILI]
[SIXBIT/DSK/] ? C ? [SIXBIT /TECO/] ? SETZ HSNAME
GOZO2: SETZ ? SIXBIT /OPEN/ ? [.BAI,,CHFILI]
[SIXBIT/DSK/] ? [SIXBIT/*/] ? [SIXBIT/TECO/] ? SETZ [SIXBIT/.TECO./]
]
IFN TNX,[
MOVSI 1,(GJ%OLD\GJ%SHT)
HRROI 2,[ASCIZ /TECO.INIT/]
GTJFN
JRST GOZ6
MOVE 2,[36._30.+OF%RD]
OPENF
JRST GOZ6
MOVEM 1,CHFILI
SETOM CMFLFL
GOZ6: JRST CTLW ;DROP INTO MAIN LOOP AS IF AFTER ^G.
]
;OPEN THE TTY CHANNELS AND SET VARIOUS VARS ACCORDING TO TYPE OF TTY.
;ON T(W)ENEX A NUMERIC ARGUMENT SPECIFIES THE TERMINAL TYPE CODE,
;OVERRIDING WHAT THE SYSTEM SAYS.
FSTTYI:
IFN ITS,[
INITTY: TSOPEN CHTTYI,[[%TIFUL+40,,'TTY]] ;INITIALIZE TTY.
TSOPEN CHDPYO,[[%TJCTN+%TJDIS+.BAO,,'TTY]] ;BLOCK OUTPUT FOR DISIOT.
TSOPEN CHECHO,[[%TJECH+%TJPP2+.UAO,,'TTY]] ;ECHO MODE OUTPUT.
TSOPEN CHSIO,[[%TJSIO+%TJCTN+.UAO,,'TTY]] ;SUPER-IMAGE OUTPUT.
TSOPEN CHTTYO,[[%TJCTN+.UAO,,'TTY]] ;NORMAL TYPE OUT.
PUSHJ P,SETTTM ;SET UP RGETTY, STTYS.
MOVEM CH,RGETTY
SYSCAL TTYVAR,[%CLIMM,,CHTTYO ? ['OSPEED] ? %CLOUT,,OSPEED]
SETZM OSPEED
SYSCAL TTYVAR,[%CLIMM,,CHTTYO ? ['SMARTS] ? %CLOUT,,TTYSMT]
SETZM TTYSMT
SETZM INCHRQ
SETZM LEABLE
MOVE A,TTYSMT
TRNE A,%TRLED
SETOM LEABLE
.CALL RSSB ;SET NVLNS, NHLNS, TTYOPT.
.VALUE
MOVE A,NHLNS
]
IFN TNX,[
MOVE CH,C
TRNN FF,FRARG
JRST INITT1
CAIGE CH,MAXTTY
SKIPGE CH
TYPRE [AOR]
HRLM CH,SGTTYP ;SAVE EXPLICIT TERMINAL TYPE
INITT1: TRZN FF,FRARG ;READ TTY TYPE FROM SYSTEM UNLESS
;ARGUMENT IS SPECIFIED.
INITTY: CALL RTTYTP ;IF CALLED INTERNALLY, DON'T LOOK AT ARGUMENT
MOVEM CH,RGETTY
IFE TEXTIF,CALL SETTTM
IFN 20X\FNX\SUMTTF,[
MOVEI A,.CTTRM
RFMOD
LDB C,[.BP TT%LEN,B] ;TERMINAL LENGTH
MOVEM C,NVLNS
LDB C,[.BP TT%WID,B] ;TERMINAL WIDTH
IFE SUMTTF,[
MOVEI B,.MORLW ;WORKS FOR ALL TTY WIDTHS
MTOPR
ERJMP .+1
];IFE SUMTTF
IFN TEXTIF,[
SKIPN ORGWID ;[wew] SAVE ORIGINAL (EXEC-SPECIFIED) TERMINAL
MOVEM C,ORGWID ;[wew] WIDTH
MOVE C,ORGWID
];TEXTIF
MOVEM C,NHLNS
IFN TEXTIF,CALL SETTTM
IFE SUMTTF,[
MOVEI B,.MORSP ;READ TTY'S SPEED
MTOPR
ERJMP .+3
MOVEI C,(C) ;GET OUTPUT SPEED
CAILE C,9600. ;DONT GET CONFUSED BY NVT'S OR PTY'S
SETZ C,
MOVEM C,OSPEED ;SAVE IT
];IFE SUMTTF
];IFN 20X\FNX\SUMTTF
IFN 10X,SETZM OSPEED
MOVE C,TTYTBS(CH) ;GET DISPATCH VECTOR FOR TERMINAL
IFN 20X\FNX\SUMTTF,SKIPG A,NVLNS ;USE CURRENT SETTING IF REASONABLE
HLRZ A,0(C) ;ENTRY 0 IS PAGE SIZE
ANDI A,777
MOVEM A,NVLNS ;NUMBER OF VERTICAL LINES
MOVE A,1(C) ;ENTRY 1 IS TTY OPTION BITS
IFN 20X,[
CAIE CH,VTSI ;IF VTS TERMINAL, CALCULATE TTYOPT
JRST INITTV
MOVEI A,.PRIOU
RTCHR
MOVSI A,%TOLWR ;SHOULD CHECK RFMOD WORD FOR THIS
TLNE B,(TC%MOV)
TLO A,%TOMVU
TLNE B,(TC%BS\TC%MOV)
TLO A,%TOMVB
TLNE B,(TC%SCL)
TLO A,%TOERS
TLNE B,(TC%LID)
TRO A,%TPRSC
TLNE B,(TC%CID)
TLO A,%TOCID
TLNE B,(TC%FCI)
TLO A,%TOFCI
TLNE B,(TC%MET)
TRO A,%TPMTA
TLNE B,(TC%OVR)
TLO A,%TOOVR
] ;20X
INITTV: MOVEM A,TTYOPT
IFN 20X\FNX\SUMTTF,SOSG A,NHLNS ;CURRENT WIDTH, LESS ONE FOR !
HRRZ A,0(C) ;NUMBER OF HORIZONTAL LINES
]
CAILE A,MXNHLS ;MUST BE IN RANGE
MOVEI A,MXNHLS
MOVEM A,NHLNS
IFN LINSAV,[
SETZM LBLLIM ;BY DEFAULT, TURN OFF LINE SAVING.
LDB A,[.BP %TRLSV,TTYSMT]
JUMPE A,INITLS
MOVEI B,1
LSH B,(A)
LSH B,(A) ;COMPUTE MAXIMUM LINE LABEL TERMINAL WILL ACCEPT (+1).
CAIL B,MAXLBL
MOVEI B,MAXLBL ;COMPUTE MAXIMUM WE WILL USE.
SKIPE A,OSPEED ;USE LINE-SAVING ONLY ON SLOW TERMINALS
CAILE A,1200. ;BECAUSE THINKING ABOUT IT IS SLOW.
JRST INITLS
MOVEM B,LBLLIM
SETZM LBLBEG ;CLEAR OUT DATA ON LABELS.
MOVE A,[LBLBEG,,LBLBEG+1]
BLT A,LBLEND-1
INITLS: ];LINSAV
SETCM A,TTYOPT ;GET OPTION BITS FOR THIS TERMINAL
TLNE A,%TOOVR ;TTY CAN'T OVERPRINT =>
SETZM DISPCR ;DON'T LET STRAY CR'S TRY TO DO SO.
TLNE A,%TOOVR+%TOMVB ;DON'T LET BS OVERPRINT IF TTY CAN'T BS.
SETZM DISPBS
MOVE A,TTYOPT
SETZM DISSAI
TLNE A,%TOSA1 ;:TCTYP SAIL => WE SHOULD USE SAIL CHAR SET.
SETOM DISSAI
TLNN A,%TOERS ;IF TTY CAN'T ERASE SELECTIVELY,
TLNN A,%TOOVR ;AND SPACE WON'T ERASE EITHER, WE LOSE.
TLNN A,%TOMVU ;IF CAN'T MOVE CURSOR UP, WE LOSE.
JRST [
MOVSI C,377777 ;WE SHOULD NEVER DO --MORE--,
MOVEM C,NVLNS
SETZM TOPLIN ;WE CAN'T START DISPLAY IN MIDDLE OF SCREEN.
IFN ITS,[ MOVSI C,%TSMOR ;SYSTEM SHOULD DO **MORE** PROCESSING.
ANDCAM C,TTYSTS
]
SETZB C,RGETTY ;ALSO PRETEND TO BE PRINTING TTY.
CALL FSECL1 ;AND NO ECHO LINES.
SETZM BSNOLF
TLNN A,%TOOVR
SETOM BSNOLF ;ON GLASS TTY, PULL VARIOUS OVERPRINT-ERASE HACKS.
SKIPE A,TTYMAC ;RUN FS TTY MAC$ TO RESET PARAMETERS.
JRST MACXQ
RET]
SETZM NOCEOL
TLNN A,%TOERS ;IF TTY HASN'T GOT BUILT-IN CLEAR TO EOL, SET FLAG
SETOM NOCEOL ;SO WE WILL CLEAR SCREEN AT TIMES FOR EFFICIENCY.
SETZM CHCTVP
SETZM CHCTCF
SETOM DWAIT
SKIPE C,OSPEED ;SET DWAIT IF TTY'S SPEED IS KNOWN TO BE 600 BAUD OR LESS.
CAILE C,600.
SETZM DWAIT
LDB C,[.BP (%TOLID),A]
MOVEM C,LID ;IF TTY CAN INSERT/DELETE LINES, DEFAULT IS TO USE THEM.
TRNE A,%TPRSC ;IF TTY HAS REGION SCROLLING, USE IT INSTEAD OF INSERT AND DELETE.
SETOM LID
LDB C,[.BP (%TOCID),A]
MOVEM C,CID ;LIKEWISE CHAR I/D
IFN TNX,[
SETZ C, ;ASSUME 200 BIT IS PARITY
TRNE A,%TPMTA ;UNLESS THIS TERMINAL TYPE CAN HAVE META KEY
MOVEI C,1
TLNE A,%TOFCI ;OR FULL INPUT CHAR SET EVEN
SETO C,
MOVEM C,FCITYI
JUMPGE C,.+3
MOVEI CH,TOP+"H
MOVEM CH,HELPCH ;MAKE FS HELP CHAR BE TOP-H ON FCI TERMINALS
MOVE CH,RGETTY
MOVE C,OSPEED
CAIN CH,OWLI ;INSERT/DELETE LINE LOSES ON OWLS AT ABOVE 1200 BAUD.
CAIG C,1200.
CAIA
SETZM LID
]
MOVE C,NVLNS
CAIL C,MXNVLS
MOVEI C,MXNVLS
MOVEM C,NVLNS
CAMG C,TOPLIN
SETZM TOPLIN
IDIVI C,6 ;COMPUTE # ECHO LINES.
CAIGE C,3
MOVEI C,3
CALL FSECL1 ;AND SET THAT MANY.
SETOM ECHONL ;SAY FIRST ECHO AREA OUTPUT SHOULD GO TO FRESH LINE.
SKIPE A,TTYMAC ;RUN FS TTY MAC$ TO RESET PARAMETERS.
JRST MACXQ
RET
SUBTTL SET/READ SCROLL BITS
FSSCRO: TRNN FF,FRARG
JRST [ MOVEI A,0 ;SAY "NOT USING SCROLLING"
MOVE CH,TTYOPT ;GET TTYOPT VAR.
TRNE CH,%TPRSC ;SCROLLING?
MOVEI A,1 ;YES. SAY "USING SCROLLING"
JRST CPOPJ1 ] ;RETURN THE VALUE
MOVE CH,TTYOPT ;GET TTYOPT VARIABLE
TRO CH,%TPRSC ;SET SCROLLING ON
SKIPG C, ;ARG > 1?
TRZ CH,%TPRSC ;NO. TURN SCROLLING OFF.
MOVEM CH,TTYOPT ;RESAVE IT.
RET
SUBTTL MORE 20X ROUTINES FOR FS FLAGS(?)
IFN 20X,[
;GET OUR USER NUMBER
FSXUSR: HRRZ A,HSNAME
JRST CPOPJ1
; GET USER NUMBER FOR NUMARG, OR LAST ONE SET
FSUSRN: TRNN FF,FRARG ;ARG?
JRST FSXUSR ;RETURN OUR OWN USR NUM
MOVE A,C
MOVE C,[440700,,BAKTAB]
CALL STRASC
MOVSI A,(RC%PAR)
HRROI B,BAKTAB
SETZ C,
; TRNN FF,FRARG2
; RCDIR
; TRNE FF,FRARG2
RCUSR
; TRZ FF,FRARG2 ;CLEAR THIS FOR NEXT COMMAND
TLNE A,(RC%NOM\RC%AMB) ;NO MATCH OR AMBIGUOUS?
JRST [ HRRI B,STRX08 ;NO SUCH USER
HRLI B,.FHSLF ;OURSELF
TRO FF,FRNOT ;NO FILENAME
JRST OPNER6 ] ;ERROR...
MOVEI A,(C)
TRNE FF,FRARG
SETZM NUM
JRST CPOPJ1
; CHECK FOR EXISTENCE OF USER MAIL FILE ON 20X FOR USR #
FSUML: TRNN FF,FRARG ;NUMARG?
MOVE C,HSNAME
; JRST FSUML0
; MOVE A,[440700,,BAKTAB]
; HRROI B,[ASCIZ/PS:</] ;MUST BE ON PS: DIRECTORY
; SETZ C,
; SOUT
; MOVE C,A ;CONVERT NUMARG TO ASCIZ STRING
; MOVE C,[440700,,BAKTAB]
; MOVE A,NUM
; CALL STRASC
; MOVE A,C
TLNN C,-1
TLO C,540000
HRROI A,BAKTAB
MOVE B,C
SETZ C,
DIRST
ERJMP FSUML1
FSUML2: HRROI B,[ASCIZ/MAIL.TXT.1/] ;FINISH OFF FILESPEC
SETZ C,
SOUT
MOVSI A,(GJ%SHT\GJ%OLD\GJ%DEL)
HRROI B,BAKTAB ;FILESPEC
GTJFN ;IS IT THERE?
ERJMP FSUML1 ;NOPE.
MOVEI A,(A) ;YUP.
RLJFN ;RELEASE THE JFN
JFCL
SETO A, ;SUCCESS - MAILBOX?
TRNE FF,FRARG
SETZM NUM
JRST CPOPJ1
FSUML1: SETZ A, ;FAILED - NO MAILBOX?
TRNE FF,FRARG
SETZM NUM
JRST CPOPJ1
;FSUML0: HRROI A,BAKTAB
; MOVE B,HSNAME ;OURSELF
; SETZ C,
; DIRST
; ERJMP FSUML1
; JRST FSUML2
; SET/RESET DONT REAP BIT
FSREAP: TLNN FF,FLIN
TYPRE [NFI]
TRNN FF,FRARG ;ARG?
MOVEI C,.ARSET ;DEFAULT IS TO RESIST
SKIPE C, ;ZERO? (.ARCLR)
MOVEI C,.ARSET ;RESIST!
MOVEI B,.ARNAR ;FUNCTION CODE
MOVE A,CHFILI ;JFN
ARCF
JFCL
RET
]; 20X
SUBTTL SET INVERSE MODE ON/OFF ;[fHsu] Get access to screen mode routines
FSCRIV: MOVE CH,C ;GET ARGUMENT
TRNN FF,FRARG ;DID WE GET AN ARGUMENT?
JRST FSRNLY ;RETURN CURRENT SETTING
SKIPN CH ;NONZERO: USER WANTS TO SET INVERSE MODE?
JRST FSCRI0 ;NO. SO GO TURN IT OFF.
IFN TNX,CALL DPYIVI+1
.ELSE CALL DPYIVI+2 ;INVERT, BUT DON'T CHECK INVMOD FLAG
MOVEI CH,1
MOVEM CH,SCINV ;SET POSITIVE MEANS DONE OK.
IFN TNX,[
MOVE CH,RGETTY ;INTERNAL TERMINAL TYPE
MOVE CH,TTYTBS(CH) ;DISPATCH VECTOR
MOVE CH,22(CH) ;INVERT MODE ROUTINE
CAMN CH,[JFCL] ;DOES TERMINAL HAVE CAPABILITY?
SETOM SCINV ;NO. NEGATIVE MEANS SET, BUT NOT DONE.
]
RET
FSCRI0:
IFN TNX,CALL DPYIVC+2 ;RESET, BUT DON'T CHECK INVMOD FLAG
.ELSE CALL DPYIVC+1
SETZM SCINV
RET
SUBTTL ECHOING CONTROL
IFN ITS,[
;REINITIALIZE TTYSTS, TTYST1, TTYST2;
;TURN ON ECHOING, AND SET ECHOFL TO INDICATE THAT WAS DONE.
SETTTM: .CALL RTTYS1
.VALUE
MOVE TT,TTYST1
MOVE TT1,TTYST2
ANDCM TT,[202020,,202020] ;HAVE ECHOING ON IFF
ANDCM TT1,[202020,,202020] ;FS ECHOLINES $ IS >=0.
SKIPL NELNS
IOR TT,[202020,,202020]
SKIPL NELNS
IOR TT1,[202020,,200020]
TLO Q,%TSCLE+%TSACT+%TSMOR
SKIPN RGETTY
TLZ Q,%TSMOR
TLZ Q,%TSNEA\%TSINT\%TSSAI
.CALL STTYS1
.VALUE
SETOM ECHOFL
MOVEM Q,TTYSTS
RET
TTYAC2: HRROS (P) ;INTERRUPT ON NEXT INPUT CHARACTER.
CAIA
TTYAC1: HRRZS (P) ;ACTIVATE ON NEXT INPUT CHARACTER.
TTYAC4: SAVE Q
SAVE TT
SAVE TT1
SAVE CH
.CALL RTTYS1
.LOSE %LSFIL
TLZ Q,%TSINT
TLO Q,%TSACT
SKIPGE -4(P)
TLO Q,%TSINT
.CALL STTYS1
.LOSE %LSFIL
REST CH
REST TT1
REST TT
JRST POPQJ
RSSB: SETZ
SIXBIT /CNSGET/
%CLIMM,,CHDPYO
%CLOUT,,NVLNS
%CLOUT,,NHLNS
%CLOUT,,TT ;TCTYP
%CLOUT,,TT ;TTYCOM
400000+%CLOUT,,TTYOPT
RTTYS1: SETZ
SIXBIT \TTYGET\
%CLIMM,,CHTTYI
%CLOUT,,TT
%CLOUT,,TT1
%CLOUT,,Q
%CLOUT,,CH
400000+%CLOUT,,CH ;TCTYP VARIABLE
STTYS1: SETZ
SIXBIT \TTYSET\
%CLIMM,,CHTTYI
TT
TT1
SETZ Q
]
IFN TNX,[
;RETURN TECO INTERNAL TTY TYPE IN CH.
RTTYTP: MOVEI A,.CTTRM
GTTYP ; GET TERMINAL TYPE
CAMN B,[SIXBIT /4023/] ; BBN'S WAY OF DOING TTY TYPES
MOVEI B,TK4023
CAME B,[SIXBIT /4024/] ; SAME THING AS 4025
CAMN B,[SIXBIT /4025/]
MOVEI B,TK4025
CAMN B,[SIXBIT /HP/]
MOVEI B,HP2645
CAMN B,[SIXBIT /C100/ ]
MOVEI B,C100
CAMN B,[SIXBIT /BITGRF/]
MOVEI B,BITGRA
CAMN B,[SIXBIT /ID100/]
MOVEI B,VT100 ;ID100's are ANSI-VT100's with graphics
CAMN B,[SIXBIT /T1061/]
MOVEI B,TL1061
HRRZ CH,SGTTYP ; GET TYPE FROM LAST TIME
CAME CH,B ; IF SYSTEM TERMINAL TYPE IS THE SAME
JRST RTTYT1
HLRE CH,SGTTYP ; AND USER SPECIFIED WHAT THAT MEANS
JUMPGE CH,CPOPJ ; USE THAT INSTEAD OF DEFAULT
RTTYT1: HRROM B,SGTTYP ; ELSE SAVE SYSTEM TYPE
CAIL B,NTTYPE
MOVEI B,NTTYPE-1 ; STAY IN RANGE
MOVE CH,TTYTYP(B) ; AND GET TERMINAL TYPE DISPATCH
RET
; DO INITIAL SETUP
SETTTM: SAVE C
MOVSI A,.TICCG ; ^G ON CHANNEL 0
SKIPG NOQUIT ; IF QUITTING IS ALWAYS DISABLED, DO NOT ARM
ATI ; ^G, SO THAT IT WILL ARRIVE AS A COMMAND AT
; THE CORRECT TIME (THIS IS FOR RMODE).
CALL DOSTIW ; SETUP TERMINAL INT MASK
MOVEI A,.CTTRM
RFMOD ; GET TTY MODE WORD
IFN TEXTIF,[ ; IF WE SWITCH FROM A PRINTING TERMINAL TO A
TRO B,TT%ECO ; DISPLAY, THIS BIT COULD BE LEFT OFF, WHICH
];IFN TEXTIF ; CAUSES TEXTI TO NOT ECHO CHARS - BAD STUFF.
SKIPE CH,RGETTY ; PRINTING?
TRZA B,TT%DAM ; NO, BINARY MODE THEN
TRO B,1_6\TT%ECO ; YES, MAKE SURE DATA MODE NORMAL
IFN 20X,[
CAIN CH,VTSI ; IF RUNNING UNDER VTS
TRO B,1_7 ; TURN ON OUTPUT TRANSLATION
]
SFMOD
IFN 20X,[
IFN TEXTIF,[
SKIPL PAGMOD ;[wew] WANT PAGE MODE LEFT ON?
TRZ B,TT%PGM ;[wew] NO, TURN IT OFF.
TLZ B,(TT%WID) ;[wew] SET WIDTH TO 0, SO THAT LINE WRAP
STPAR ;[wew] WILL NOT OCCUR
]; IFN TEXTIF
.ELSE [
SKIPGE PAGMOD ; WANT PAGE MODE LEFT ON?
JRST .+4 ; YES, DONT MESS WITH IT
TRZE B,TT%PGM ; TURN OFF PAGE MODE ON DISPLAY
STPAR
];.ELSE
JUMPE CH,SETTM1
RTMOD ; INTERPRET ^P CODES
ERJMP .+3 ; WILL NOT LOSE ON NON-VTS SYSTEM
TLO 2,(TM%SCR\TM%DPY)
STMOD
SETOB 2,3 ; FIX UP CCOC WORDS FOR VTS
CAIN CH,VTSI
SFCOC
]
IFN SUMTTF,[ ;TURN OFF HOLD CHAR
PUSH P,A
SETZ A, ;ZERO MEANS OFF
STCHA
SKIPE A ;DON'T SAVE IF ALREADY OFF
MOVEM A,HLDCHR
POP P,A
];IFN SUMTTF
CALL DPYINI ; INIT THOSE TERMINALS THAT NEED IT.
SETTM1: SETOM ECHOF2 ; ASSUME ECHO
SKIPE RGETTY ; PRINTING TTY'S ECHO FOR THEMSELVES
SKIPGE NELNS ; FS ECHOLINES >= 0 ?
SETZM ECHOF2 ; NO, ECHO OFF
SETOM ECHOFL ; SAY WE DID SOMETHING
JUMPN CH,POPCJ ; DONE UNLESS PRINTING
MOVE B,[.BYTE 2 ? 1 ? 1 ? 1 ? 0 ? 1 ? 1 ? 1 ? 2 ? 2 ? 3 ? 2 ? 1 ? 1 ? 2 ? 1 ? 1 ? 1 ? 1]
IFN 20X,MOVE C,[.BYTE 2 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 3 ? 1 ? 1 ? 1 ? 1]
.ELSE MOVE C,[.BYTE 2 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 3 ? 1 ? 1 ? 1 ? 3]
SFCOC
JRST POPCJ ; AND RETURN
] ;TNX
;TURN OFF ECHOING. CLOBBERS A AND B.
NOECHO: SETZM ECHOFL
IFN ITS,[
MOVE A,TTYSTS ;ECHO IN M.P. AREA, NOT ECHO AREA
TLO A,%TSNEA ;(ECHOING HAPPENS ONLY IN AN ECHOIN SYSTEM CALL).
SYSCAL TTYSET,[%CLIMM,,CHTTYI
[020202,,020202] ;NOTHING ECHOES, EVERYTHING ACTIVATES,
[030202,,120202] ;^G INTERRUPTS, CR OUTPUT IN IMAGE MODE.
A]
.LOSE %LSFIL
]
IFN TNX,[
SETZM ECHOF2 ;SAY DONT ECHO THINGS FOR DISPLAY TERMINAL
SKIPE RGETTY
RET
MOVEI A,.CTTRM
RFMOD
TRZ B,TT%ECO ;TURN OFF ECHOS ON PRINTING TERMINAL
SFMOD
]
RET
SUBTTL TERMINAL INPUT
;READ A CHARACTER FROM THE TTY.
TYI: CALL TYINH
TYIH: CAIN CH,TOP+"H ;IS THIS THE "HELP" KEY?
TYIURH: SKIPN HELPMAC ;YES, IS THERE A HELP MACRO?
RET ;JUST RETURN THE CHARACTER
CALL [ CALL SAVACS ;PRESERVE ACS AND CURRENT TECO VALUES.
MOVE A,HELPMAC
CALL MACXCP
JRST RSTACS]
SKIPN RREBEG ;IF FS HELPMAC$ RUN INSIDE ^R, RETURN FROM TYI SO THAT
RET ;RRLP1 CAN GO TO RRLP AND MAKE SPACE REDISPLAY THE SCREEN.
JRST TYI ;AFTER RUNNING FS HELP$, TRY AGAIN TO READ A CHARACTER.
IFN TEXTIF,[
TYIWTX: SKIPN TYISRC
SKIPGE CH,UNRCHC ;[wew] SPECIAL CALL FOR TEXTI SUPPORT
JRST TYIW0 ;[wew] (NO BREAK CHARACTER)
TLZN CH,-1 ;[wew] TEXTI BREAK CHAR, OR UNREAD 9BIT?
JRST TYIW0 ;[wew] PUT THERE BY TECO, PROCESS NORMALLY.
SETOM UNRCHC ;[wew] GOBBLE BREAK CHAR AND PROCESS.
CALL TYI5A
JRST TYIH
];IFN TEXTIF
TYIW0: CALL TYIWN0 ;DONT CHECK STOPF, BUT DO UNREAD AND HELP CHAR
JRST TYIH
;READ CHARACTER, CHECK FOR AND STANDARDIZE HELP CHARACTER, BUT DONT RUN HELP MACRO
TYINH: SKIPGE STOPF
CALL QUIT1
TYIWN0: MOVE CH,UNRCHC ;GOBBLE ANY UNREAD CHARACTER.
SETOM UNRCHC
JUMPGE CH,CPOPJ
SKIPE TYISRC ;IF THERE IS A "TYI SOURCE", CALL IT.
JRST [ PUSH P,[TYIWN0]
CALL SAVACS
MOVE A,TYISRC ;SINCE IT CAN'T RETURN A VALUE UNCLOBBERED,
CALL MACXCP ;IT SHOULD SET FS REREAD$ TO THE CHARACTER.
JRST RSTACS] ;AND WE RETURN TO TYIWN0 TO GOBBLE IT.
SKIPE JRNIN ;IF WE ARE REDOING A JOURNAL FILE,
JRST [ SKIPN JRNINH ;AND ARE NOT INHIBITED TEMP. FROM READING IT,
CALL JRNICH ;READ NEXT CHARACTER FROM IT,
JRST .+1 ;IF REACH EOF, TRY THE TTY AGAIN.
JRST TYIJRN
JRST TYIWN0] ;DOUBLE SKIP MEANS TRY UNRCHC AGAIN.
SKIPGE CLKFLG
CALL RLTCLK
IFN ITS,[
TYIIOT: .IOT CHTTYI,CH
CAIN CH,TOP+"S ;IS THIS AN INPUT RESYNCHRONIZATION FOR REMOTE ECHO?
JRST [ .IOT CHTTYI,INSYNC ;IF SO, RECORD IT.
MOVE CH,INCHCT
MOVEM CH,INCHSY
JRST TYIIOT]
CAIN CH,TOP+"E ;IS THIS A DECLARATION THAT FOLLOWING INPUT IS PRE-ECHOED?
JRST [ .IOT CHTTYI,CH ;YES, HOW MANY CHARS?
ADD CH,INCHCT
MOVEM CH,INCHEC ;RECORD CHAR NUMBER OF 1ST FOLLOWING UNECHOED INPUT CHAR.
JRST TYIIOT]
];IFN ITS
IFN TNX,[
IFN 20X\FNX,[
SKIPGE FCITYI ;CAN THIS TERMINAL DO FULL INPUT?
JRST VTSTYI
];IFN 20X\FNX
EXCH A,CH
PBIN
TYIIOT:
IFN 10X\FNX,CAIN A,37
.ELSE [
CAIE A,^M
JRST TYI5
IFN STANSW,[
SKIPN A,RGETTY ;ON PRINTING TERMINAL
PBIN ;ALSO READ THE LF
CAIE A,VTSI
JRST TYIVCR
];IFN STANSW
SAVE B
MOVEI A,.PRIIN
RFMOD
SAVE B
TRO B,100
SFMOD ;GO INTO ASCII MODE AND
BIN ;FLUSH LF AFTER CR IN CASE OF GTJFN LATER
REST B
SFMOD
REST B
IFN STANSW,TYIVCR:
];20X
MOVEI A,^M
TYI5: EXCH A,CH
SKIPN FCITYI ;ARE HIGH ORDER BITS PARITY BITS?
ANDI CH,177 ;YES, MASK THEM OFF (SOME TERMINALS GENERATE PARITY)
TRZE CH,200 ;CONVERT EDIT TO META AT LOWEST LEVEL
TRO CH,META
TYI5A: SKIPE ECHOF2
CALL ECHOCH ;ECHO IT IF REQUESTED, AND SYSTEM DIDN'T ECHO IT.
]
TYIJRN: ANDI CH,777+TOP
SKIPE JRNOUT ;WRITE CHARACTER TO JOURNAL FILE IF THERE IS ONE.
CALL JRNOCH
CAME CH,HELPCH ;TURN OUR HELP CHARACTER INTO TOP-H.
JRST TYI6
CALL TYI4
MOVEI CH,TOP+"H
RET
TYI6: SKIPE DISPRR ;WHEN OUTSIDE OF ^R,
JRST TYI7
CAIN CH,33 ;DETECT ALTMODE-ALTMODE.
CAME CH,LTYICH
JRST TYI2
SOSGE TSALTC ;FOUND ONE! DECREMENT COUNT OF PAIRS REMAINING TO BE READ.
AOS TSALTC
TYI7: HRLI CH,-1 ;MAKE SURE 2ND ALTMODE OF PAIR CAN'T COUNT AS FIRST OF ANOTHER.
TYI2: MOVEM CH,LTYICH
ANDI CH,#META#CONTRL ;TURN ASCII CTL CHARS INTO 9-BIT ONES,
CAIE CH,^M
CAIG CH,^J ;EXCEPT FOR ^H, ^I, ^J, ^M AND ALTMODE.
CAIGE CH,^H
CAIN CH,33
JRST TYI3
TRNN CH,TOP+140 ;ALSO, DON'T ALTER THINGS WHICH HAVE THE "TOP" BIT.
IORI CH,CONTRL+100
TYI3: IOR CH,LTYICH ;NOW RESTORE THE CONTROL AND META BITS, AND FLUSH TOP.
ANDI CH,CONTRL+META+177
TYI4: IDPB CH,TYIBFP ;RECORD THE INPUT CHARACTER IN THE RING BUFFER FOR SUCH.
CALL TYI1
SKIPN TYISNK ;INVOKE FS TYISINK$ IF THERE IS ONE
RET
CALL SAVACS
MOVE C,CH ;WITH THE CHARACTER AS ARGUMENT.
MOVE A,TYISNK
CALL MACXCP
JRST RSTACS
IFN 20X\FNX,[
VTSTYI: PUSH P,A
PUSH P,B
EXCH C,CH
MOVEI A,.CTTRM
MOVEI B,.MOFCI
MTOPR ;READ 12-BIT CHARACTER
VTSIOT: EXCH C,CH
IFN 20X,[
CAIE CH,^M
JRST VTSIO1
RFMOD
SAVE B
TRO B,100
SFMOD ;GO INTO ASCII MODE AND
BIN ;FLUSH LF AFTER CR IN CASE OF GTJFN LATER
REST B
SFMOD
VTSIO1: ];IFN 20X
POP P,B
POP P,A
JRST TYI5A
];IFN 20X\FNX
FSTBBK: MOVE A,TYIBFQ ;FS .TYIBACK$: BACK UP TYIBFP ONE CHARACTER.
CAMN A,[001400,,TYIBUF-1]
ADDI A,TYIBSZ ;IF BACK BEFORE START OF BUFFER, WRAP TO END.
MOVEM A,TYIBFQ
IBP TYIBFQ ;TO BACK UP THE POINTER,
IBP TYIBFQ ;ADVANCE IT TWICE, THEN BACK UP A WORD.
SOS TYIBFQ
RET
FSTBNXT:ILDB A,TYIBFQ ;FS .TYINXT$: GET NEXT OLD TYI CHARACTER.
AOS (P)
MOVE CH,TYIBFQ
CAMN CH,[001400,,TYIBUF+TYIBSZ-1]
SUBI CH,TYIBSZ
MOVEM CH,TYIBFQ
RET
TYI1: AOS INCHCT ;BUMP COUNT OF INPUT CHARACTERS READ SO FAR.
EXCH CH,TYIBFP ;PUSH THE CHARACTER ONTO THE RING BUFFER OF INPUT.
CAMN CH,[001400,,TYIBUF+TYIBSZ-1]
SUBI CH,TYIBSZ
MOVEM CH,TYIBFQ
EXCH CH,TYIBFP
RET
;CONVERT CHAR. IN CH FROM TV CHAR SET TO ASCII.
TYINRM: TRZ CH,META ;CONTROL-^-MUMBLE JUST BECOMES ^-MUMBLE.
TRZN CH,CONTRL
RET
CAIN CH,177
RET ;CONTROL-RUBOUT SHOULD BE RUBOUT, NOT "?".
CAIE CH,40 ;CONTROL-SPACE IS ^@.
TRZE CH,100 ;NOTE TV CHAR SET HAS CONTROL-LOWERCASE LETTERS!
ANDCMI CH,40 ;THEY SHOULD CONVERT JUST LIKE CONTROL-UPPERCASE LETTERS.
RET
;STORE INFO IN DEBUG BUFFER
;WHEN INPUT STOPS DISPLAY
DBGBFI: SAVE A
MOVEI A,DBGBFI
CALL DBGBFP
MOVE A,CHCTVP
CALL DBGBFP
MOVE A,INCHCT
CALL DBGBFP
MOVE A,RRMAXP
CALL DBGBFP
MOVE A,RRMSNG
CALL DBGBFP
JRST POPAJ
;PUSH ONE WORD ONTO THE DEBUG BUFFER.
DBGBFP: SAVE B
MOVE B,DBGBFX
CAIN B,DBGBFE
MOVEI B,DBGBUF
MOVEM A,(B)
AOS B
MOVEM B,DBGBFX
REST B
RET
SUBTTL JOURNAL FILES
;FORMAT OF DATA IN JOURNAL FILES:
;MOST THINGS ARE REPRESENTED BY PAIRS OF CHARACTERS.
;CRLF REPRESENTS A CR COMMAND.
;"??" REPRESENTS THE HELP CHARACTER.
;SPACE AND A CHAR REPRESENT THAT CHAR.
;^ AND A CHAR REPRESENT THAT 7-BIT CHAR PLUS THE CONTROL BIT.
;+ IS LIKE ^, FOR META. * IS LIKE ^, FOR CONTROL AND META TOGETHER.
;THINGS OTHER THAN PAIRS OF CHARACTERS INCLUDE:
; SEMICOLON, WHICH STARTS A COMMENT TERMINATED BY A CRLF;
; :, WHICH CAUSES FS JRN MAC TO BE RUN AND IS FOLLOWED BY ARGUMENTS FOR THAT MACRO;
; ^G (007), WHICH CAUSES FS JRN MAC TO BE RUN BUT IS NOT FOLLOWED BY ARGUMENTS.
; THE COLON OR ^G IS PASSED TO FS JRN MAC AS AN ARGUMENT.
;START WRITING A JOURNAL FILE. USE THE DEFAULT FILENAMES.
;COLON FLAG MEANS CLOSE THE FILE.
FSJRNO: MOVE A,JRNOIVL
MOVEM A,JRNOCT
MOVEI E,JRNOUT
IFN TNX,[
MOVSI A,(GJ%FOU)
MOVE B,[7_30.+OF%WR]
];TNX
.ELSE MOVE A,[.UAO,,CHJRNO]
JRST FSJRN
;START RE-EXECUTING A JOURNAL FILE. USE THE DEFAULT FILENAMES.
;COLON FLAG MEANS STOP.
FSJRNX: MOVEI E,JRNIN
IFN TNX,[
MOVSI A,(GJ%OLD)
MOVE B,[7_30.+OF%RD]
];TNX
.ELSE MOVEI A,CHJRNI
FSJRN: TRZN FF,FRCLN ;IF COLON FLAG, CLOSE CHANNEL AND LEAVE IT THAT WAY.
JRST FSJRNN
FSJRNC:
IFN ITS,[
SYSCAL CLOSE,[A]
.LOSE %LSFIL
];ITS
IFN TNX,[
MOVE A,(E)
CLOSF
JFCL
];TNX
SETZM (E)
RET
FSJRNN: SETZM (E) ;SAY NONE IS OPEN IN CASE OPEN FAILS (OR WE QUIT).
CALL IMMQIT ;ALLOW QUITTING OUT OF THE OPEN.
IFN ITS,[
.CALL RREDB
JRST OPNER1
SETOM (E) ;SUCCESS, SAY ONE IS OPEN.
];ITS
IFN TNX,[
SAVE B ;SAVE OPENF FLAGS
CALL FF5 ;GET JFN FROM DEFAULTS
JRST OPNER1
REST B
OPENF
JRST OPNER1
MOVEM A,(E)
IFN 20X,[ ;ON TOPS-20, MAKE SURE FILE EXISTS SO IT SURVIVES
TRNN B,OF%WR
JRST DELQIT
HRLI A,(CO%NRJ)
CLOSF ;BY CLOSING
JRST OPNER1
HRRZS A
HRRI B,OF%APP
OPENF ;AND OPENING AGAIN FOR APPEND
JRST OPNER1
];20X
];TNX
JRST DELQIT
;READ A CHARACTER INTO A FROM THE INPUT JOURNAL FILE. FS JRN READ.
FSJRNR:
IFN ITS,[
SKIPE A,JRNIN
.IOT CHJRNI,A
];ITS
IFN TNX,[
SKIPN A,JRNIN
JRST POPJ1
BIN
MOVE A,B
];TNX
JRST POPJ1
;WRITE A CHARACTER INTO THE OUTPUT JOURNAL FILE FROM C. FS JRN WRITE.
;DON'T WRITE IN THE NEW JOURNAL WHILE WE ARE READING AN OLD ONE.
FSJRNW: SKIPN JRNIN
SKIPN JRNOUT
RET
SKIPGE CH,C ;HANDLE EITHER STRING OR CHARACTER
JSP CH,FSMPD1
IFN ITS,.IOT CHJRNO,CH
IFN TNX,[
EXCH A,JRNOUT
EXCH B,CH
BOUT
EXCH B,CH
EXCH A,JRNOUT
];TNX
RET
;READ A COMMAND CHARACTER INTO CH FROM AN INPUT JOURNAL FILE.
JRNICH: CALL JRNIC0
IFN ITS,[
JUMPL CH,JRNEOF
CAIN CH,^C
JRST JRNEOF ;EOF => RETURN NON-SKIP.
];ITS
IFN TNX,JUMPE CH,JRNEOF
CAIN CH,";
JRST JRNICM ;SEMICOLON IN JOURNAL MEANS A COMMENT.
CAIN CH,"? ;HELP CHARACTER IS REPRESENTED BY "??"
JRST JRNIHP
CAIE CH,^G ;^G MEANS WE QUIT. BETTER LET USER LOOK AROUND.
CAIN CH,": ;: MEANS EXECUTE A COMMAND.
JRST JRNCMD
CAIN CH,^M ;CRLF STANDS FOR JUST CR TYPED IN.
JRST JRNICR
SAVE A
SETO A, ;ELSE READ 1ST CHAR OF PAIR,
CAIN CH,40 ;WHICH SHOULD SPECIFY THE CONTROL AND META BITS.
SETZ A,
CAIN CH,"^
MOVEI A,200
CAIN CH,"+
MOVEI A,400
CAIN CH,"*
MOVEI A,600
SKIPGE A ;NOT SPACE, ^, + OR * => JOURNAL FILE IS NO GOOD.
TYPRE [UJC]
CALL JRNIC0 ;MERGE IN BASIC ASCII CHAR AND RETURN IT.
ADD CH,A
AOS -1(P)
JRST POPAJ
JRNIC0:
IFN ITS,.IOT CHJRNI,CH
IFN TNX,[
EXCH A,JRNIN ;READ A SINGLE CHARACTER FROM THE FILE
EXCH B,CH
BIN
EXCH B,CH
EXCH A,JRNIN
] ;TNX
RET
JRNEOF:
IFN ITS,[
.CLOSE CHJRNI,
SETZM JRNIN
RET
];ITS
IFN TNX,[
SAVE A
CLOSEF JRNIN
JRST POPAJ
];TNX
JRNICM: CALL JRNIC0 ;COMMENT - SKIP PAST LINEFEED, THEN TRY AGAIN TO READ CHAR.
CAIE CH,^J
JRST JRNICM
JRST JRNICH
JRNICR: CALL JRNIC0
CAIE CH,^J
TYPRE [UJC]
MOVEI CH,^M
JRST POPJ1
JRNIHP: CALL JRNIC0 ;GOT ONE "?" => CHECK FOR TWO, AND RETURN HELP CHAR.
CAIE CH,"?
TYPRE [UJC]
MOVE CH,HELPCH
JRST POPJ1
;^G OR COLON READ FROM JOURNAL FILE. CALL FS JRN MACRO.
JRNCMD: AOS (P) ;RETURN SKIPPING TWICE, TO CHECK UNRCHC AGAIN.
AOS (P) ;IF NOTHING THERE, IT WILL COME BACK TO JRNICH AGAIN.
CALL SAVACS
MOVE C,CH ;PASS CHARACTER AS ARGUMENT.
MOVE A,JRNMAC
CALL MACXCP
JRST RSTACS
;WRITE COMMAND CHARACTER IN CH TO JOURNAL OUTPUT FILE. CLOBBERS NOTHING.
;EACH COMMAND CHARACTER IS REPRESENTED BY TWO CHARACTERS IN THE JOURNAL FILE.
;THE CHARACTER CR IS REPRESENTED BY A CRLF.
;THE HELP CHARACTER IS REPRESENTED BY "??".
;OTHER CHARACTERS HAVE FIRST SPACE, ^, + OR * FOR NONE, CTL, META AND CTL-META,
;FOLLOWED BY THE ASCII BASIC CHARACTER.
JRNOCH: SKIPE JRNIN
RET
CAIN CH,^M ;CR IS OUTPUT AS A CRLF.
JRST JRNOCR
CAMN CH,HELPCH
JRST JRNOHP
HRLM CH,(P)
LSH CH,-7
IFN ITS,[
.IOT CHJRNO,JRNOTB(CH) ;OUTPUT SOMETHING TO REPRESENT THE META BITS
HLRZ CH,(P)
.IOT CHJRNO,CH ;THEN OUTPUT THE BASIC CHARACTER.
];ITS
IFN TNX,[
EXCH A,JRNOUT
EXCH B,CH
MOVE B,JRNOTB(B)
BOUT
HLRZ B,(P)
BOUT
EXCH B,CH
EXCH A,JRNOUT
];TNX
JRST JRNFRC
JRNOTB: 40 ? "^ ? "+ ? "*
JRNOHP:
IFN ITS,[
.IOT CHJRNO,["?]
.IOT CHJRNO,["?]
JRST JRNFRC
];ITS
IFN TNX,[
EXCH A,JRNOUT
SAVE B
MOVEI B,"?
BOUT
JRST JRNOC1
];TNX
JRNOCR:
IFN ITS,[
.IOT CHJRNO,[^M]
.IOT CHJRNO,[^J]
];ITS
IFN TNX,[
EXCH A,JRNOUT
SAVE B
MOVEI B,^M
BOUT
MOVEI B,^J
JRNOC1: BOUT
REST B
EXCH A,JRNOUT
];TNX
JRNFRC: SOSLE JRNOCT ;EVERY SO OFTEN, MAKE SURE THE SYSTEM BUFFER IS WRITTEN OUT.
RET
IFN ITS,[
SYSCAL FORCE,[%CLIMM,,CHJRNO]
.LOSE %LSFIL
];ITS
IFN 20X,[
SAVE B
SAVE A
HRRZ A,JRNOUT
RFPTR
SETZ B,
ADDI B,4777
SAVE C
IDIVI B,5000 ;GET NUMBER OF PAGES IN FILE
REST C
HRLZ A,JRNOUT
UFPGS ;FORCE THEM OUT TO DISK
JFCL
REST A
REST B
];20X
PUSH P,JRNOIVL
POP P,JRNOCT
RET
SUBTTL CHANGE RECORD UPDATE.
;See documentation on self-updating marks at end of TECORD.INFO
;Trashes register A. Saves the rest.
NEWCNG: MOVE A, Z ;Get virtual Z in A
SUB A, BEG
CAMN A, OLDZ ;Exit if old Z equal to current Z (no change)
RET
SUB A, OLDZ ;A becomes amount of change.
ADDM A, OLDZ ;Remember current Z as old Z
CALL SAVACS
MOVE BP, CNGBUF ;Get pointer to change buffer in B
CALL QBGET2
MOVE C, MFPT(B) ;Get address of words at pt in C
IDIVI C, 5
MOVEM A, (C) ;Store amount of change in word at point.
MOVE BP, GPT ;Store pos. of change in next word:
SUB BP, BEG
SKIPL A ;If insert,
SUB BP, A ; move pos. of change to start of insertion.
MOVEM BP, 1(C)
IMULI C, 5 ;Get back character value of pt. in CngBuf
ADDI C, 10. ;Update pt of CngBuf to next two words.
CAMN C, MFZ(B)
MOVE C, MFBEG(B) ;wrapping around to the start.
TLZ C,MFBBTS ;(Zero out higher bits from MFBEG)
MOVEM C, MFPT(B)
JRST RSTACS
SUBTTL PURIFY
IFN ITS,[
;DUMPIT$G TO DO $Y<CR> THEN PURIFY, WITH THE BONUS THAT IT REFUSES
;TO WORK ON A TECO THAT HAS BEEN RUN.
DUMPIT: SKIPE RUNFLG
.VALUE
.VALUE [ASCIZ /Y
P/]
;PURIFY$G TO MAKE PURE THE PAGES THAT ARE SUPPOSED TO BE PURE.
PURIFY: SKIPE RUNFLG
.VALUE
.VALUE [ASCIZ /B P/]
MOVEI P,PDL
MOVE A,[PURP1-PURPL,,PURP1]
SYSCAL CORBLK,[%CLIMM,,%CBRED ? %CLIMM,,%JSELF ? A]
.LOSE %LSFIL
SETOM PUREFL
RADIX 10.
.VALUE [.ASCII \
:Purified
:PDUMP .TECO.;TECPUR !.FVERS \]
RADIX 8
JRST INIT
]
IFN TNX,[
PURIFY: SKIPE RUNFLG
.VALUE
SETOM PUREFL
MOVSI 1,(GJ%SHT) ;FIRST WRITE OUT SYMBOL TABLE
RADIX 10.
IFN 20X,HRROI 2,[STRCNC [TECO.SYMBOLS.]\.FNAM3 ]
.ELSE HRROI 2,[STRCNC [TECO.SYMBOLS;]\.FNAM3 ]
RADIX 8
GTJFN
JRST PFYERR
MOVE 2,[36._30.+OF%WR]
OPENF
JRST PFYERR
MOVE 2,116 ;AOBJN POINTER
SUBI 2,1 ;INTO IOWD
BOUT
HLRE 3,2 ;LENGTH
HRLI 2,004400
SOUT
CLOSF
JRST PFYERR
HLRE 2,116 ;BLT OUT THE SYMBOL TABLE
AOS 1,116 ;FIRST ADDRESS OF SYMBOLS+1
HRLI 1,-1(1)
SETZM -1(1) ;ZERO IT OUT
SUBI 2,(1) ;GET LAST WORD OF THEM
MOVM 2,2
BLT 1,(2) ;AND ZERO THE REST OF THEM
SETZM 116 ;ZERO POINTER TOO FOR DDT
MOVEI 1,.FHSLF
MOVE 2,[3,,BOOT]
SEVEC ;SET UP OUR ENTRY VECTOR
MOVSI 1,(GJ%SHT)
RADIX 10.
IFN 20X,HRROI 2,[STRCNC [TECO.EXE.]\.FNAM3 ]
.ELSE HRROI 2,[STRCNC [TECO.SAV;]\.FNAM3 ]
RADIX 8
GTJFN
JRST PFYERR
HRLI 1,.FHSLF
MOVE 2,[SS%CPY+SS%RD+SS%EXE+<-600,,0>]
SETZ 3,
SSAVE
ERJMP PFYERR
RADIX 10.
MOVSI 1,(GJ%SHT)
IFN 20X,HRROI 2,[STRCNC [TECPUR.EXE.]\.FNAM3 ]
.ELSE HRROI 2,[STRCNC [TECPUR.SAV;]\.FNAM3 ]
RADIX 8
GTJFN
JRST PFYERR
HRLI 1,.FHSLF
MOVE 2,[SS%RD+SS%EXE+<PURP1*2-PURPL*2,,PURP1*2>]
SSAVE
ERJMP PFYERR
JRST INIT
PFYERR: MOVEI 1,.PRIOU ;ERROR WHILE PURIFYING, GIVE THE PERSON A HINT WHAT HAPPENED
HRLOI 2,.FHSLF ;LAST ERROR THIS PROCESS
SETZ 3,
ERSTR
JFCL
JFCL
.VALUE
] ;IFN TNX
SUBTTL SUBROUTINES FOR COMMAND STREAM CHARACTER READER RCH
;COME HERE ON TRYING TO READ PAST THE END OF A COMMAND STRING LEVEL.
RCH2: SAVE A ;POP OFF MACRO FRAME
SETZM COMCNT ;DON'T LET COMCNT BE -1 -- WOULD SCREW IF ERROR HANDLER DOES BACKTRACE.
SKIPN A,MACPTR ;0 MEANS TRIED TO POP OUT OF TOP-LEVEL
JRST INSCHK
RCH2A: CALL ERSTST ;REFUSE TO POP OUT OF MACRO CONTAINING UNTERMINATED "<" OR ":<".
LDB CH,MACPDP ;TRY TO POP MACPDL ENTRY FOR THE MACRO-CALL.
TRNE CH,10
JRST RCH2B ;TOP OF MACPDL ISN'T A MACRO-CALL ENTRY!
HRRE A,(A)
JUMPGE A,RCH2D ;ARE WE POPPING OUT OF A MACXQ (MIDAS TO TECO CALL)?
HRRZ A,-1(P) ;YES, ONLY ALLOWED FROM COMMAND LOOP.
CAIE A,CDRCH
JRST INSCHK ;INSIDE A COMMAND => ERROR.
RCH2D: MOVE A,MACPTR
CALL DECDCH ;IT IS ONE, RESTORE RCHALT AND SQUOTP AS IT SAYS.
CALL POPMAC ;POP THE MACRO-STRING-FRAME.
CALL POPMP ;ACTUALLY DEECREMENT MACPDP.
RCH2C: REST A
SKIPL MACPTR ;ARE WE POPPING OUT OF A MACXQ?
JRST RCH ;NO, TRY AGAIN, READ FROM WHAT WE POPPED INTO.
MOVE CH,MACXP ;YES, RESTORE PDL LEVEL TO THAT AT
POP CH,MACXP ;CALL TO MACXQ, AND PREPARE TO RETURN.
POP CH,MACPTR
EXCH C,NUM ;FINISH PROCESSING A NUMBER OR "." AT END OF MACRO
TRZE FF,FRSYL
XCT DLIM ;BY COMBINING IT WITH PREVIOUS ARITH OP.
EXCH C,NUM ;AND MAKE IT THE NEW VALUE
JRST SETP ;SET P FROM CH AND ADJUST LEV.
RCH2B: CAIN CH,10 ;A NULL ENTRY? FLUSH IT AND TRY AGAIN.
JRST [CALL POPMP ? JRST RCH2A]
MOVEI CH,4 ;[ ;CAN'T POP SINCE ^]^X'D INTO,
MOVEM CH,COMCNT ;[ ;INSTEAD ^]^X UP ANOTHER LEVEL.
MOVE CH,[BP7,,[ASCIZ/ /]]
MOVEM CH,CPTR
MOVEM CH,CSTR
SKIPGE MACPTR ;I THINK TECO LOSES IF IT USES UP
.VALUE ;[ ;ALL OF A MACXQ'D STRING WITH A ^]^X.
JRST RCH2C
;THE RCHDTB ENTRY FOR THE CASE SHIFT CHAR IS <CALL RCHSFT>
RCHSFT: SKIPN MACPTR ;IN MACRO, CASE SHIFT ISN'T SPECIAL.
RCHSF1: SKIPE RCHSFF ;IF PREV. CHAR WAS SHIFT, THIS ONE IS QUOTED.
POPJ P, ;PRETEND NOT TO BE A CASE-SHIFT.
MOVNS CASE ;ELSE ASK TO READ NEXT CHAR IN THE OTHER CASE,
MOVE CH,-1(P) ;GET RET. ADDR OF READ RTN,
SETOM RCHSFF ;QUOTE NEXT CHAR IF CASE-SHIFT OR LOCK.
XCT -1(CH) ;RE-CALL THE READ RTN. (TRACES IF NEC)
MOVNS CASE ;RESTORE CASE TO WHAT IT HAD BEEN.
SETZM RCHSFF
POP1J: SUB P,[1,,1] ;RETURN FROM THE CALL TO RCH
POPJ P, ;SINCE CHAR WAS ALREADY TRACED.
RCHLOK: SKIPN MACPTR ;RCHDTB ENTRY FOR CASE-LOCK CALLS HERE..
SKIPE RCHSFF ;IF IN MACRO OR QUOTED BY A CASESHIFT,
POPJ P, ;DO NOTHING SPECIAL.
MOVNS CASE ;ELSE SWITCH THE CASE WE WANT CHARS IN,
RCHTRY: SUB P,[1,,1]
REST CH
JRST -1(CH) ;AND GO READ THE NEXT CHAR.
;OUTPUT CHARACTER IN CH WHOSE EXECUTION IS TRACED.
.SEE TRACS ;TRACS CONTAINS JRST TYOS WHEN TRACING IS ON.
;CLOBBERS NO ACS.
TYOS: SKIPE BRC1
RET
SAVE Q
SAVE CH
SETOM TRCOUT
PUSHJ P,TYO
MOVE CH,(P)
CAIE CH,^M ;DON'T MAKE CR COME OUT AS ^M.
PUSHJ P,DISFLS
SETZM TRCOUT
REST CH
POPQJ: REST Q
RET
;COME HERE IF POP OUT OF MACXQ'D OR TOP-LEVEL STRING IN THE MIDDLE OF A COMMAND.
INSCHK: SKIPN INSINP ;IF WITHIN AN INSERT, WE COULD JUST ERR OUT
TYPRE [CNM]
MOVE P,INSINP ;BUT THAT WOULD LOSE THE STUFF INSERTED SO FAR.
SETZM INSINP ;SO TELL INSDUN TO DO THE CNM ERROR
JRST INSDUN ;AND CAUSE INSERT TO FINISH UP.
SUBTTL MACRO FRAME ALLOCATION
;FREE UP A CELL OF MACRO CALL SPACE.
;A -> 1ST WD OF CELL, MINUS 1.
FLSFRM: ANDI A,-1 ;MAKE SURE NO GARBAGE BLOCK IS PUT ON THE FRAME FREELIST.
CAMGE A,MFEND
CAIGE A,MFSTRT-1
.VALUE
SETZM MFCPTR+1(A)
SETZM MFBEG+1(A)
EXCH CH,MFFREE
MOVEM CH,MFLINK+1(A)
MOVE CH,MFFREE
HRRZM A,MFFREE
POPJ P,
;OBTAIN A FREE CELL OF MACRO CALL CELL SPACE.
;RETURN POINTER TO WD BEFORE 1ST WD OF CELL, IN A.
GETFRM: SKIPG A,MFFREE
JRST GETFR1
ANDI A,-1
CAMGE A,MFEND
CAIGE A,MFSTRT-1
.VALUE
MOVE A,MFLINK+1(A)
EXCH A,MFFREE
POPJ P,
GETFR1: CALL GCNRL ;GC, PERHAPS FREEING FRAMES USED BY BUFFERS.
SKIPE MFFREE
JRST GETFRM ;ONE WAS FREED.
CALL GETFR2
JRST GETFRM
GETFR2: CALL SAVACS ;MAKE MFINCR MORE MACRO FRAMES,
SAVE TOTALC
MOVE A,MFEND ;UNLESS WE ALREADY HAVE THE MOST WE ARE ALLOWED TO HAVE.
CAILE A,MFSTRT+<MFMAX-MFINCR>*MFBLEN
TYPRE [TMN]
MOVEI C,MFINCR*MFBLEN*5 ;NUMBER OF CHARS WORTH OF SPACE WE WILL ALLOCATE.
CALL SLPQGT ;MAKE SURE IMPURE STRING SPACE HAS ROOM TO MOVE UP THAT FAR.
HRRZ BP,CBUFLO
IMULI BP,5
MOVE TT,QRWRT ;GET START AND END OF RANGE OF CORE TO MOVE UP, IN CHARS.
HRRZ CH,INSBP ;NOTE THAT IF A STRING IS NOW BEING WRITTEN JUST PAST QRWRT,
ADDI CH,1 ;IT MUST BE INCLUDED IN RANGE TO MOVE.
IMULI CH,5
CAML CH,BFRBOT
JRST GETFR7
CAMGE TT,CH
MOVE TT,CH
GETFR7: MOVEI C,MFINCR*MFBLEN ;GET NUMBER OF WORDS TO MOVE UP BY.
CALL SLPN0Q
SAVE E
MOVE A,MACPTR
CALL GETFR5 ;RELOCATE ALL BYTE POINTERS IN MACRO, CTX AND ITERATION FRAMES.
MOVE A,CTXPTR
CALL GETFR5
MOVE A,ITRPTR
CALL GETFR5
CAML D,CSTR ;IF CPTR IS A B.P. TO A STRING, RELOCATE IT.
ADDM C,CPTR
REST E
ADDM E,QRBUF ;ADD # CHARS MOVED BY (SET BY SLPN0Q) TO
ADDM E,QRWRT ;BOUNDS OF IMPURE STRING SPACE.
MOVE D,BFRBOT
IDIVI D,5
HRRZ E,INSBP
CAIL E,@CBUFLO ;IF INSBP IS IN THE COMMAND BUFFER OR IMPURE STRING SPACE,
CAMLE E,D ;RELOCATE IT.
JRST GETFR4 ;(THESE TESTS EXCLUDE THE SPECIAL VALUES, 0 AND -1).
ADDM C,INSBP
GETFR4: ADDM C,CBUFLO
ADDM C,CBUFH ;UPDATE BOUNDS OF COMMAND BUFFER.
MOVE A,MFEND
ADDB C,MFEND ;MARK ADDITIONAL SPACE AS IN USE BY MACRO FRAMES.
SOS A
GETFR3: CALL FLSFRM ;NOW "FREE" ALL THE NEWLY ALLOCATED FRAMES SO THEY CAN BE USED.
ADDI A,MFBLEN ;NOTE THAT THE ARG TO FLSFRM MUST BE THE FRAME ADDR MINUS 1.
CAIE A,-1(C)
JRST GETFR3
REST TOTALC
JRST RSTACS
;IF A POINTS TO THE START OF A LIST OF MACRO FRAMES,
;RELOCATE THOSE MFCPTR'S OF FRAMES IN THE LIST WHICH POINT AT STRINGS.
;C IS THE AMOUNT TO RELOCATE BY.
GETFR5: MOVE D,QRWRT
TLO D,400000 ;D GETS THE LARGEST NUMBER WHICH IS A STRING POINTER.
MOVE E,MACXP ;IF THIS LIST IS MACPTR, IT MAY HAVE POINTERS THRU THE STACK.
GETFR6: JUMPE A,CPOPJ ;EXIT ON REACHING END OF LIST.
CAML D,MFCSTR-MFLINK(A) ;RELOCATE THE CPTR IF THE CSTR INDICATES THAT THE CPTR
ADDM C,MFCPTR-MFLINK(A) ;POINTS INTO AN IMPURE STRING.
HRRE A,MFLINK-MFLINK(A) ;NOTE THAT A POINTS AT THE MFLINK WORD, NOT THE START OF THE FRAME.
JUMPGE A,GETFR6 ;NOW ADVANCE TO THE NEXT FRAME IN THE LIST.
MOVE A,-1(E) ;BUT MAYBE ADVANCE DOWN A LINK MADE BY A MACXQ CALL.
MOVE E,(E)
JRST GETFR6
;[
SUBTTL ^]
;[ ;THE RCHDTB ENTRY FOR ^] IS <CALL CTLBRC>
;NOTE THIS CAN RETURN TO THE CALLING PUSHJ, TO RETRY IT.
CTLBRC: JUMPL CH,TRACS
SKIPGE SQUOTP
JRST TRACS
CALL TRACS
SETZM BRC1CF
SETZM BRCUAV
SETOM DLMF2
SETZM SQUOF2
BRCREC: PUSHJ P,[ ;[ ;^]@ OF A STRING RETURNS HERE TO READ 1ST CHAR OF STRING.
SKIPG COMCNT
TYPRE [UEC]
SOS COMCNT
ILDB CH,CPTR
POPJ P,]
;[ ;^]@ OF A NUMBER RETURNS HERE WITH NUMBER IN CH.
CALL TRACS
BRCRC2: INSIRP PUSH P,A B TT TT1 BP ;BP MUST BE LAST - SEE EXPMAC.
SETZ A,
PUSHJ P,QNMGE2
JRST QLET
SKIPE BRC1
JRST BRCRT5
CALL QLGET
JRST BRCNVL
JRST EXPMAC
QLET: SKIPE A
TYPRE [IQN]
INSIRP POP P,BP TT1 TT B A ;[
CAIE CH,^]
CAIN CH,ALTMOD
JRST BRCPRT
CAIN CH,"" ;[ ;ALLOW ^] TO QUOTE A ".
JRST BRCPRT
CAIN CH,"$
JRST RET33
CAIN CH,^Q
JRST BRCCTQ
CAIN CH,^T
JRST BRCCTT
CAIN CH,^S
JRST BRCCTS
CAIN CH,^A
JRST BRC1CH
CAIN CH,^V
JRST BRCCTV
SKIPE BRC1
JRST BRCRC3
CAIN CH,"@
JRST BRCIND
CAIN CH,^X
JRST BRCCTX
CAIN CH,^Y
JRST BRCCTY
TYPRE [ICB]
BRCRC3: CAIN CH,"@
JRST BRCREC
CAIE CH,^X
CAIN CH,^Y
JRST BRCRT
TYPRE [ICB]
BRCCTS: SETOM SQUOF2
SETOM DLMF2
JRST BRCREC
BRCCTT: SETZM DLMF2
JRST BRCREC
BRC1CH: SETOM BRC1CF
JRST BRCREC
BRCIND: SAVE [BRCREC+1]
JRST BRCREC ;CALL BRCREC, THEN GO TO BRCRC2.
BRCCTV: SETOM BRCUAV
JRST BRCREC
BRCNVL: SKIPN BRCUAV
TYPRE [QNS]
SETOM BRCFLG
INSIRP POP P,BP TT1 TT B
MOVE CH,A
HRROM A,BRCUAV ;LEAVE UNTRUNCATED VALUE FOR QNMGET.
ANDI CH,177
CALL TRACS
SKIPE SQUOF2
HRLI CH,-1
JRST POPAJ
BRCCTQ: CALL SKRCH
BRCPRT: HRLI CH,-1 ;RETURN THE CHARACTER SUPERQUOTED.
POPJ P,
;SET SQUOTP ACC TO SQUOF2, DLMF2 AND TURN OFF RCHALT.
;ALSO SAVE OLD STATE OF THOSE VARS AS BITS IN CH FOR PUSHING ON MACPDP
FLGENC: SETZ CH,
SKIPE DLMF2 ;SET SQUOTP ACC. TO SQUOF2, DLMF2
TLO CH,2^5
SKIPE SQUOF2
TLO CH,4^5 ;AND SET CH ACC TO PREVIOUS SQUOTP AND RCHALT
EXCH CH,SQUOTP
IORM CH,SQUOTP
ROT CH,2 .SEE MACPDP ;SET UP CH AS A MACPDL ENTRY
ADDI CH,1
HLRZ A,RCHALT
CAIN A,(CALL)
ADDI CH,4
MOVEI A,(JFCL) ;ALSO TURN OFF RCHALT.
HRLM A,RCHALT
POPJ P,
DECDCH: TRNN CH,3
POPJ P, ;THIS ENTRY DIDN'T PUSH SQUOTP, RCHALT.
SUBI CH,1
DPB CH,[420200,,SQUOTP]
TRNN CH,4
SKIPA CH,[(JFCL)]
MOVEI CH,(CALL)
HRLM CH,RCHALT
POPJ P,
;A HAS STRING OBJECT, B HAS LENGTH, BP HAS POINTER TO IT.
;PUSH A CALL TO THAT OBJECT ONTO THE RCH INPUT STREAM.
;NOTE TOP OF PDL HAS VALUE THAT WAS IN BP WHEN RCH WAS CALLED.
EXPMAC: SETOM BRCFLG
MOVE BP,(P) ;SAVE BP, AND GET OUR CALLER'S BP.
CALL PUSMA0 ;PUSH MACRO PDL, RELOCATING BP IF BUFFERS MOVE.
MOVEM BP,(P) ;GIVE CALLER'S BP BACK TO HIM, RELOCATED IF NEC.
CALL QLGET0 ;REDECODE ADDR OF STRING (MAYBE PUSMA0 MADE FRAMES AND CHANGED IT).
SKIPE BRC1CF
MOVEI TT,1
MOVEM A,CSTR
MOVEM BP,CPTR
SKIPE BRC1CF ;IF WANT WHOLE STRING,
CAMLE TT,B ;OR IF WANT MORE CHARS THAN STRING HAS,
MOVE TT,B ;USE STRING LENGTH RATHER THAN DESIRED # CHARS.
MOVEM TT,COMCNT
MOVE B,PF
MOVEM B,MACSPF
SETZM MACBTS ;[ ;THERE ARE NO ARGS IN A ^] CALL.
SETZ CH, ;IF NOT SETTING ANY FLAGS, PUSH 0 ON MACPDL.
SKIPN SQUOF2
SKIPE DLMF2
CALL FLGENC ;ELSE COMPUTE WHAT TO PUSH.
IDPB CH,MACPDP
BRCRT5: INSIRP POP P,BP TT1 TT B
BRCRT4: REST A
BRCRT: REST CH
JRST -1(CH) ;RETRY THE RCH.
RET33: MOVEI CH,ALTMOD
POPJ P,
;[ ;PERFORM A PUSH INTO A ^]^X.
BRCCTX: SKIPE BRC1CF
JRST BRCCTY
SETOM BRCFLG
PUSH P,A
HRRZ A,-2(P)
CAIE A,BCYRCH+1 ;[[ ;IF THE ^]^X WAS IN THE CHARACTER THAT A ^]^Y WAS TRYING TO READ,
JRST BRCCX2
PUSH P,RCHALT
HRLZI A,(JFCL) ;[ ;PERFORM A RECURSIVE ^]^Y,
HLLM A,RCHALT
PUSHJ P,BRCCTY
POP P,RCHALT ;[ ; WE HAVE ADVANCED PAST THE ^]^X IN THIS MACRO LEVEL.
CAIN CH,ALTMOD ;IF WHAT WE JUST GOT IS AN ALTMODE, THAT'S OK; RETURN IT.
JRST BRCRT4
MOVE A,CPTR ;[ ;BUT OTHERWISE, THIS ^]^X HAS LONGER TO RUN,
PUSH P,CH ;SO WE MUST BACK UP OVER IT.
BRCCX1: DBP7 A
AOS COMCNT
LDB CH,A ;[
CAIE CH,^] ;[ ;SO BACK UP UNTIL WE GET TO THE ^].
JRST BRCCX1
DBP7 A ;AND BACK UP ONE CHAR FURTHER.
AOS COMCNT
MOVEM A,CPTR
POP P,CH ;[ ;THEN RETURN THE THING WE GOT FROM THE RECURSIVE ^]^Y.
JRST POPAJ
BRCCX2: CALL BRCCX0
JRST BRCRT4
;[ ;PUSH INTO A ^]^X, AS A SUBROUTINE, NOT CALLED BY RCH. RETURNS WITH A NORMAL POPJ.
BRCCX0: PUSHJ P,PUSCX0
SKNTOP MACPTR
TYPRE [NIM]
PUSHJ P,POPMAC
CALL FLGENC ;SET SQUOTP, GET OLD STATE IN CH.
ADDI CH,10 ;[ ;INDICATE PUSHED BY ^]^X, NOT MACRO CALL.
IDPB CH,MACPDP
MOVEI A,(CALL)
HRLM A,RCHALT ;[ ;START LOOKING FOR AN $ TO END ^]^X.
SKIPGE MACPTR ;[ ;TRYING TO ^]^X OUT OF A MACXQ => PHONY UP NULL ARG.
CALL ENDAR2
RET
ENDARG: MOVEM A,(P)
CALL ENDAR2
JRST BRCRT4
ENDAR2: CALL ERSTST
LDB CH,MACPDP
TRNN CH,10
JRST ENDAR1 ;[ ;POPPING ^]^X BUT MACPDP SAYS MACRO CALL.
CAIN CH,10 ;NULL ENTRY ON MACPDP? FLUSH IT.
JRST [CALL POPMP ? JRST ENDAR2]
ENDAR5: CALL DECDCH ;[ ;A ^]^X ENTRY, UNBIND SQUOTP AND RCHALT.
CALL POPMP ;AND REMOVE THE ENTRY FROM THE STACK.
JRST ENDAR4
ENDAR1: SAVE MACPDP
ENDAR3: CALL POPMP
CALL ERSTST
LDB CH,MACPDP ;[ ;LOOK DOWN MACPDP FOR A ^]^X ENTRY.
CAIG CH,10
JRST ENDAR3 ;THE ENTRIES ABOVE MUST BE 0 OR 10 .
CALL DECDCH ;FOUND THE ENTRY, RESTORE SQUOTP.
MOVEI CH,10 ;REPLACE THE ENTRY WITH A NULL.
DPB CH,MACPDP
REST MACPDP
ENDAR4: CALL PUSMA0
JRST POPCTX
BRCCTY: SETOM BRCFLG
PUSH P,A ;HANDLE ^Y OR ^F^X.
PUSHJ P,PUSCX0
SKNTOP MACPTR
TYPRE [NIM]
PUSHJ P,POPMAC
CALL FLGENC
ADDI CH,10
IDPB CH,MACPDP
SKIPGE MACPTR ;IF OUR CALLER WAS MACHINE-LANGUAGE TECO,
SKIPA CH,[ALTMOD] ;DON'T TRY TO POP INTO IT; PHONY UP AN ALTMODE.
BCYRCH: PUSHJ P,RCH
SKIPGE SQUOTP
HRLI CH,-1
SAVE CH
CALL ENDAR2
REST CH
REST A
RET
;F^K COMMAND FOR READING STRING ARGUMENTS:
;DO <ARGS>F^K<PROMPT>$. IF YOU WERE CALLED BY A MACRO, IT WILL ACT LIKE ;[
; :I*^]^X$, GOBBLING A STRING ARG FROM THAT MACRO.
;OTHERWISE, IT ACTS LIKE <ARGS>M$*F^K HOOK*$<PROMPT>$,
; WHICH SHOULD READ AN ARGUMENT FROM THE TERMINAL, PROMPTING.
; IF THE USER RUBS OUT PAST THE START OF THE ARGUMENT,
; M$*F^K HOOK*$ SHOULD EXIT FROM THE F^K'ING MACRO WITH -2FS BACK RETURN$.
;:F^K RETURNS A NEGATIVE VALUE IF THE CURRENT MACRO'S CALLER WAS TECO INTERNAL CODE.
;IT RETURNS A NONNEGATIVE NUMBER IF THE CALLER WAS ANOTHER MACRO.
;CALLING A MACRO WITH @M MAKES F^K WITHIN THAT MACRO BELIEVE THAT THE
;MACRO WAS CALLED FROM TECO INTERNAL CODE.
FCTLK: SKIPN A,MACPTR
TYPRE [CNM] ;BARF IF NO CALLER AT ALL
HRRE A,(A)
MOVE T,MACBTS ;@M IS TREATED LIKE A CALL FROM INSIDE TECO.
TLNE T,MFBATSN
SETO A,
TRZE FF,FRCLN ;FOR :F^K, RETURN NEGATIVE IF CALLER IS TECO CODE.
JRST POPJ1
JUMPL A,FCTLK1 ;NO COLON. JUMP IF CALLER IS ^R OR OTHER TECO CODE.
CALL FNOOP ;CALLER IS A MACRO. FLUSH <PROMPT>.
MOVE A,CPTR ;BACK UP OVER THE ALTMODE, SO THAT IT WILL TERMINATE THE
DBP7 A ;ARG WHICH THE :I* WILL READ.
MOVEM A,CPTR
AOS COMCNT
SETZM SQUOF2
SETOM DLMF2
CALL BRCCX0 ;[ ;SIMULATE GOBBLING A ^]^X. DELIMITER PROTECT, BUT NO SUPERQUOTING.
FCTLK0: TRZ FF,FRARG\FRARG2\FRCLN\FRUPRW
MOVEI CH,A
MOVE OUT,[CALL RCH]
MOVEM OUT,INSRCH
AOS (P)
JRST PSI ;THEN SIMULATE A :I* AND RETURN ITS VALUE.
FCTLK1: MOVEI A,[ASCIZ /FM*F HOOK*/]
HRLI A,440700
MOVE BP,A
MOVEI B,14. ;THIS IS THE NUMBER OF CHARACTERS IN THAT ASCIZ STRING!!
REST T ;DISCARD RETURN ADDRESS, SINCE MAC2 WILL JUMP TO MAIN LOOP.
CAIN T,CDRET
.VALUE
JRST MAC2 ;[ ;WE CAN'T USE MACXQ, SINCE WE NEED TO HAVE ^]^X WORK THROUGH THIS.
PUSMA0: SKIPE INSBP ;SHOULD BP BE RELOCATED?
JRST PUSMAC
EXCH BP,INSBP ;YES; PUT IT WHERE GC LOOKS.
CALL PUSMAC
EXCH BP,INSBP
RET
PUSMAC: SAVE A
PUSHJ P,GETFRM
IRP ...,,[COMCNT,CPTR,CSTR,MARG1,MARG2,MACSPF,MACPTR]
PUSH A,...
TERMIN MOVEM A,MACPTR
AOS MACDEP
HLL A,MACBTS
HLLM A,(A)
JRST POPAJ
POPMAC: SKNTOP MACPTR
TYPRE [CNM]
POPMA1:IRP ...,,[MACPTR,MACSPF,MARG2,MARG1,CSTR,CPTR,COMCNT]
POP A,...
TERMIN
CALL FLSFRM
MOVE A,MACPTR
HRLS MACPTR
HLLZM A,MACBTS
SOS MACDEP
RET
PUSCX0: SKIPE INSBP ;SHOULD BP BE RELOCATED?
JRST PUSCTX
EXCH BP,INSBP ;YES; PUT IT WHERE GC LOOKS.
CALL PUSCTX
EXCH BP,INSBP
RET
PUSCTX: PUSHJ P,GETFRM
IRP ...,,[COMCNT,CPTR,CSTR,MARG1,MARG2,MACSPF,CTXPTR]
PUSH A,...
TERMIN MOVEM A,CTXPTR
HLL A,MACBTS
HLLM A,(A)
POPJ P,
POPCTX: SKNTOP CTXPTR
JRST [.VALUE ? JRST GO]
IRP ...,,[CTXPTR,MACSPF,MARG2,MARG1,CSTR,CPTR,COMCNT]
POP A,...
TERMIN
CALL FLSFRM
MOVE A,CTXPTR
HRLS CTXPTR
HLLZM A,MACBTS
RET
;DECREMENT MACPDP.
POPMP: MOVE CH,MACPDP
ADD CH,[40000,,]
JUMPGE CH,POPMP1
CAML CH,[440000,,]
SUB CH,[440000,,1]
POPMP1: MOVEM CH,MACPDP
POPJ P,
;IF ABOUT TO POP MACPDP, MAKE SURE NOT POPPING
;OUT OF A LEVEL CONTAINING AN UNTERMINATED ERRSET OR ITERATION.
ERSTST: HRRZ CH,ITRPTR ;ADDR OF BLOCK FOR INNERMOST ERRSET OR ITERATION.
JUMPE CH,CPOPJ ;THERE IS NONE IN PROGRESS.
MOVE CH,MFMACP-MFBLEN+1(CH) ;GET THE MACPDP VALUE AT TIME IT WAS ENTERED.
TLZ CH,40
CAME CH,MACPDP ;ARE WE POPPING THAT LEVEL?
RET
TSC CH,ITRPTR ;YES. WHICH IS IT - AN ERRSET OR AN ITERATION?
TRNN CH,-1
TYPRE [ERP] ;AN ERRSET.
TYPRE [UTI] ;AN ITERATION.
SUBTTL ERRORS
;FE -- INSERT A "TECO ERROR" FILE IN THE BUFFER BEFORE PT.
;:FE -- INSERT A LIST OF NAMES OF FS FLAGS.
;<N>FE -- INSERT IN BUFFER THE 3-LETTER CODE
;AND MESSAGE ASSOCIATED WITH ERROR CODE <N>
;@FE<CHARS>$ -- RETURNS THE ERROR CODE ASSOCIATED WITH THE 3-CHAR
;MESSAGE <CHARS>.
FECMD: TRZE FF,FRUPRW
JRST FECMU
MOVSI T,-LERTAB
MOVEI A,TYOM ;TYPEOUT INTO BUFFER AT PT.
HRRM A,LISTF5
CALL GAPSLP
TRNE FF,FRCLN ;:FE - INSERT LIST OF FS FLAGS.
JRST FECMD3
TRZN FF,FRARG
JRST FECMD2 ;NO ARG, INSERT A LINE FOR EACH ERROR.
MOVE A,C ;AN ARG (ERROR CODE) IS JUST A STRING, SO GET IT.
FECMD6: CALL QGET3
JRST CRR1
FECMD2: SAVE PT ;SAVE CURRENT PT SO CAN SET UP INSLEN.
FECMD5: MOVE A,ERRTAB(T)
HRLI A,400000 ;MAKE STRING PTR TO NEXT ERROR MESSAGE.
SAVE T
CALL FECMD6 ;INSERT EACH ERROR MESSAGE IN THE BUFFER.
REST T
AOBJN T,FECMD5
REST C ;C GETS OLD PT.
SUB C,PT
MOVNM C,INSLEN ;FKD WILL DELETE THE WHOLE TABLE.
RET
FECMD3: MOVSI T,-FLAGSL
FECMD4: MOVE E,FLAGS(T) ;GET THE NEXT FLAG'S NAME
CALL TYPR ;AND TYPE IT OUT INTO BUFFER.
CALL CRR1 ;EACH NAME GOES ON A LINE.
AOBJP T,CPOPJ ;WHEN THRU, UNBIND LISTF5 AND DONE.
AOJA T,FECMD4 ;HANDLE NEXT FLAG NAME.
;HANDLE @FE.
FECMU: CALL FSIXR ;READ ARG, MAKE SIXBIT WORD IN A.
JFCL
HLRZ C,A
MOVSI A,-LERTAB ;NOW SEARCH ERROR TABLE FOR THIS ERROR.
FECMU2: HLRZ TT,ERRTAB(A)
CAIE TT,(C)
AOBJN A,FECMU2 ;STOP WHEN FIND IT, OR AT END OF ERRTAB.
CAIN A,LERTAB ;IS IT THE END?
JRST NRET0 ;YES, NO SUCH ERROR MESSAGE, RETURN 0.
HRRZ A,ERRTAB(A)
HRLI A,400000 ;ELSE RETURN POINTER TO THE ERROR STRING.
JRST POPJ1
;READ IN A STRING , AND RETURN CONVERTED TO SIXBIT IN A. IGNORE CONTROL CHARS.
;SKIPS.
FSIXR: MOVE OUT,[440600,,A]
SETZ A,
FSIXRL: CALL LRCH
CAIN CH,ALTMOD
SKIPE SQUOTP
CAIA
JRST POPJ1
CAIL CH,40
TLNN OUT,770000
JRST FSIXRL
SUBI CH,40
IDPB CH,OUT
JRST FSIXRL
;ROUTINE FOR FS ERR$.
FSERR: MOVE A,LASTER
TRNN FF,FRARG
JRST POPJ1 ;READING ONLY - RETURN LAST ERROR'S CODE.
MOVEM C,LASTER
JRST DISTOE
;FG -- MAKE A STANDARD ERROR REPORT (USEFUL IN ERROR HANDLER MACROS).
;IF ARG, PRINT STANDARD ERROR MESSAGE FOR THAT ERROR CODE.
;AND IF ":", DO IT AT TOP OF SCREEN.
;Q..H IS NOT CHANGED BY FG EVEN IF IT DOES TYPEOUT.
;IF "@", THROW AWAY TYPE AHEAD.
;IN ANY CASE, TYPE A BELL.
FGCMD: MOVE A,QRB..
SAVE .QVWFL(A)
TRZE FF,FRARG
CALL FGCMDP
MOVE A,QRB..
REST .QVWFL(A)
SKIPE ERRECH ;IF WE TYPED THE ERR MSG IN THE ECHO AREA,
SETZM ECHACT
TRZN FF,FRUPRW
JRST TYPBEL
IFN ITS,.RESET CHTTYI,
IFN TNX,[MOVEI A,.PRIIN ;CLEAR INPUT
CFIBF]
SETZM TSINAL
SETZM TSALTC
SETOM UNRCHC
TYPBEL: SKIPE TYISNK
HRRZM P,MODCHG ;IF CLEARING TYISNK, REMOVE "DEF" FROM EMACS MODE LINE.
SETZM TYISNK
SETZM TYISRC
IFN ITS,[
SKIPE ERRECH
.IOT CHECHO,[^G]
SKIPN ERRECH
.IOT CHTTYO,[^G]
]
IFN TNX,[
SAVE CH
MOVEI CH,^G
SKIPE ERRECH
CALL ECHOCH
SKIPN ERRECH
CALL TYOINV
REST CH
]
JRST FSECO6
FGCMDP: JUMPE C,CPOPJ ;THERE WS NO ERROR => DON'T PRINT ERROR MESSAGE.
TRZE FF,FRCLN
CALL [ SKIPN ERRECH
JRST [ CALL DPYIVI ;IF IN M.P. AREA, USE INVERSE VIDEO.
JRST DISTOT]
SKIPGE PJATY ;IF SCREEN MUST BE REDISPLAYED, CLEAR IT NOW RATHER THAN
CALL DISIN0 ;AFTER THE ERROR MESSAGE IS PRINTED.
MOVEI CH,^M
JRST FSECO1]
MOVE D,VERBOS
FGCMD3: HRRZM P,ERRFL1 ;DON'T LET FS ERRFLG$ STOP THIS FROM PRINTING.
MOVEI A,TYOA
SKIPE ERRECH ;IF SPECIFIED, TYPE IN ECHO AREA.
MOVEI A,FSECO1
HRRM A,LISTF5
CALL FGCMD1
MOVEI CH,"?
CALL @LISTF5
SKIPE ERRECH
RET
CALL DISFLS
CALL DPYIVC
MOVE E,TOPLIN
SUB E,CHCTVP ;HOW MANY LINES WERE USED?
SOS E
MOVEM E,ERRFL1 ;MAKE SURE THOSE LINES AREN'T ERASED BY REDISPLAY.
RET
FGCMD1: MOVE A,C ;PRINT CONTENTS OF STRING IN C.
CALL QLGET0
RET
FGCMD2: JUMPE B,CPOPJ
ILDB CH,BP
CAIN CH,^I ;IF D IS ZERO, STOP AT FIRST TAB.
JUMPE D,CPOPJ
CALL @LISTF5
SOJA B,FGCMD2
;HANDLE TOP-LEVEL ^X COMMAND: PRINT THE FULL EROR MESSAGE FOR THE LAST ERROR.
FECMD8: MOVE C,LASTER
SETO D,
JRST FGCMD3
;COME HERE TO REPORT SYSTEM CALL ERROR, ASSUMING THE FILE NAMES ARE IN DEFFIL.
IFN ITS,[
OPNER1: .SUSET [.RBCHN,,CH] ;GET # OF CHANNEL IN ERROR,
LSH CH,27
IOR CH,[.STATUS CH]
XCT CH ;READ THE ERROR CODE,
LDB CH,[220600,,CH]
OPNER4: SAVE CH ;ENTER HERE WITH ERRCODE IN RH(CH), TO PRETEND I.T.S GAVE AN ERROR.
HRLZS (P)
MOVEI C,70. ;WRITE A STRING CONTAINING FILENAMES AND I.T.S. ERROR MESSAGE.
CALL QOPEN ;MAKE SURE ENOUGH SPACE, SET UP BP AND LISTF5 TO STORE INTO STRING.
MOVSI E,'OPN
CALL SIXNTY ;FIRST IN THE STRING GOES "OPN" FOLLOWED BY 3-DIGIT ERROR CODE.
LDB CH,[.BP (700),(P)]
CALL DGPT
LDB CH,[.BP (70),(P)]
CALL DGPT
LDB CH,[.BP (7),(P)]
CALL DGPT
MOVEI CH,40
REPEAT 2,XCT LISTF5 ;THEN 2 SPACES.
MOVE A,[440700,,DEFFIL]
CALL ASCIND ;THEN THE FILENAMES.
MOVEI CH,40
REPEAT 3,XCT LISTF5 ;3 SPACES.
REST E
SYSCAL OPEN,[%CLIMM,,CHERRI ? ['ERR,,] ? %CLIMM,,3 ? E]
JRST .-1
OPNER2: .IOT CHERRI,CH ;COPY INTO STRING, STOPPING AT CRLF OR FF.
CAIE CH,^M
CAIN CH,^L
JRST [.CLOSE CHERRI,
JRST OPNER3]
XCT LISTF5
JRST OPNER2
]
IFN TNX,[
OPNER0: SKIPE A,OPNJFN
RLJFN
JFCL
SETZM OPNJFN
OPNER1: TRZA FF,FRNOT ;PRINT DEFAULTS IN ERROR MESSAGE
OPNER2: TRO FF,FRNOT
MOVEI A,.FHSLF ;GET THIS FORKS LAST JSYS ERROR MESSAGE
IFN 10X\FNX,[MOVE C,[4,,BAKTAB+4]
BLT C,BAKTAB+10 ;GETER ON TENEX SMASHES 4-10
]
GETER
IFN 10X\FNX,[MOVS C,[4,,BAKTAB+4]
BLT C,10
]
CAIA
OPNER4: TRZ FF,FRNOT ;PRINT ERROR MESSAGE
OPNER6: PUSH P,2 ;ENTER HERE TO FAKE ERROR FROM 2
MOVEI C,70. ;MAKE ENOUGH STRING SPACE
CALL QOPEN
MOVSI E,'OPN ;INSERT OPN
CALL SIXNTY
POP P,2
LDB CH,[110300,,2]
CALL DGPT
LDB CH,[060300,,2]
CALL DGPT
LDB CH,[030300,,2]
CALL DGPT
LDB CH,[000300,,2]
CALL DGPT
MOVEI CH,40 ;AND TWO SPACES
REPEAT 2,XCT LISTF5
TRZE FF,FRNOT ;PRINT FILENAME DEFAULTS?
JRST OPNER5
MOVEI E,DEFDEV
CALL FSDFR1 ;INSERT DEFAULTS
MOVEI CH,40
REPEAT 3,XCT LISTF5
OPNER5: MOVE A,[440700,,BAKTAB]
SETZ C,
ERSTR
JFCL
JFCL
IFN 10X\FNX,IDPB C,A ;STUPID 10X JSYS DOESNT MAKE ASCIZ
MOVEI A,BAKTAB
CALL ASCIND ;AND INSERT IT TOO
]
OPNER3: CALL QCLOSV ;NOW FINISH THE STRING'S HEADER, AND RETURN POINTER IN A.
MOVEM A,LASTER ;REMEMBER IT AS THE MOST RECENT ERROR'S CODE.
JRST DISTOE ;NOW GET CAUGHT BY ERRSET INVOKE ERROR HANDLER.
;TYPR4 UUO (TYPRE MACRO) COMES HERE.
ETYP2A: HRRZ CH,@40 ;ERROR, AND IT CAN BE HANDLED NORMALLY; GET THE ERROR CODE.
HRLI CH,400000
MOVEM CH,LASTER ;REMEMBER AS CODE OF MOST RECENT ERROR.
JRST DISTOE ;GET CAUGHT BY ERRSET OR POP.
IMMQIT: SETOM IMQUIT ;ALLOW QUITS TO HAPPEN AT ANY TIME,
SKIPL STOPF ;AND QUIT IF ALREADY PENDING.
RET
QUIT0: ;CALL HERE IF STOPF IS SET, WHEN IT IS ACCEPTABLE TO QUIT.
QUIT1: SETZM ORESET ;RE-ALLOW TYPEOUT NOW THAT WE GOT THRU WITH THE COMMAND
SKIPLE NOQUIT
SKIPLE IMQUIT
CAIA ;NOQUIT POSITIVE => NO QUITTING AT ALL (UNLESS IMQUIT OVERRIDES)
RET
SETZM STOPF ;ELSE QUIT, AND CLEAR FLAG SAYING WE NEED TO QUIT.
IFN 20X,[MOVEI A,.TICTI ;UNARM ANY INPUT INTERRUPT
DTI
]
CALL DISRST ;THROW AWAY ANYTHING IN DISBUF.
SKIPG IMQUIT ;IMQUIT POSITIVE ONLY AT STARTUP AND IN COMMAND READER
SKIPN NOQUIT ;IF QUITTING SHOULD GO TO TOP LEVEL, DO SO.
CAIA
TYPRE [QIT] ;NOQUIT NEGATIVE WANTS TO SIGNAL AN ERROR.
CIS ;CLEAR ANY INTERRUPTS IN PROGRESS.
SETOM RROVPO
CALL TYPBEL
SETZM ECHACT
MOVEI CH,"^
CALL ECHOC1
MOVEI CH,"G
CALL ECHOC1
JRST GOX1
DELQIT: SETZM IMQUIT ;STOP ALLOWING QUITS INSIDE COMMANDS, AND EXIT.
RET
;CALL HERE TO SIGNAL AN ERROR, AFTER SETTING LASTER.
;DISTOE RETURNS TO AN ERRSET IF THERE IS ONE; OTHERWISE, IT GOES TO
;GOX1 TO ENTER A BREAK LOOP, INVOKE THE ERROR HANDLER, OR POP TO ^R OR TOP LVL.
DISTOE: MOVE Q,PT ;ERROR CHECK: IS PT OUT OF BUFFER BOUNDS?
CAMG Q,ZV
CAMGE Q,BEGV
.VALUE
TRNN P,-1
.VALUE
HRRZ Q,ER$UJC
HRLI Q,400000 ;IF UJC ERROR, STOP REPLAYING THE JOURNAL FILE.
MOVEI E,JRNIN
TRO FF,FRCLN
CAMN Q,LASTER
CALL FSJRNX
CIS
SKIPL ERRFLG ;WERE WE ALREADY INVOLVED IN STARTING TO HANDLE AN ERROR?
JRST DISTOW
MOVE CH,[-LPDL,,PDL-1]
CAME CH,P ;YES; GIVE UP TRYING TO RECOVER AND POP ALL THE WAY UP,
PUSHJ CH,SETP ;SINCE TRYING TO HANDLE THIS ERROR NORMALLY WILL PROBABLY
;CAUSE ANOTHER ERROR.
SETZM ERRFL1 ;PREVENT TYPEOUT OF THE MESSAGE FROM BEING SUPPRESSED.
CALL DISTOT
MOVEI CH,TYOA
HRRM CH,LISTF5 ;NOT CAUGHT BY ERRSET, PREPARE FOR TYPEOUT.
MOVEI A,[ASCIZ/ERROR WHILE ENTERING ERROR HANDLER! POPPING TO TOP LEVEL.
/]
CALL ASCIND
CALL ERESET
JRST CTLW
DISTOW: SETOM ERRFLG
CALL ERESET
HLRZ Q,ITRPTR
JUMPE Q,GOX1 ;IF WITHIN AN ERRSET
MOVE CH,MFMACP-MFBLEN+1(Q)
TLNE CH,MFERS1 ;WHICH IS NOT REALLY AN ERROR CATCH (:@< ... >),
JRST GOX1
HLRZ CH,MFPF-MFBLEN+1(Q)
HRRZ A,DISPRR ;AND WHICH HAS NO ^R INSIDE IT
SKIPE A
CAIG A,(CH)
JRST ERRP3 ;THEN THROW TO THE ERRSET.
JRST GOX1 ;ELSE GIVE TO THE ^R OR TO ERROR HANDLER.
;COME WHEN ERROR IS CAUGHT BY ERRSET.
ERRP3: CALL UNWIND ;POP SOME STUFF OF MACRO PDL, ETC.
JRST ERRP4 ;DOESN'T SKIP IF HAVE FINISHED UNWINDING; CH = RH(ITRPTR)
JRST ERRP3 ;SKIPS 1 AFTER POPPING MACRO CALLED BY "M" CMD.
MOVE CH,MACXP
POP CH,MACXP
POP CH,MACPTR
PUSHJ CH,SETP ;SKIPS 2 AFTER POPPING A MACXQ OR MACXCW.
JRST ERRP3
ERRP4: HRROI Q,MFCSTR-MFBLEN+1(CH)
POP Q,CSTR ;POSITION AT THE FRONT OF THE ERRSET
POP Q,CPTR
POP Q,COMCNT
JRST INCMA0 ;THEN SEARCH FOR THE >.
;CLEAN UP WHEN ERROR OR QUIT HAPPENS, IN CASE VARIABLES WERE SCREWED.
;THIS STUFF DONE REGARDLESS OF WHETHER ERROR WAS CAUGHT BY ERRSET.
ERESET: SKIPE GCPTR ;ERROR IN GC: WE MAY HAVE BEEN USING THE PAGE JUST BELOW LIBRARIES.
CALL FLSCOR ;IF SO, MAKE SURE WE FLUSH IT.
IFN ITS,CALL SEQPGQ ;TURN OFF SEQUENTIAL PAGING, IF IT IS ON.
SETZM GCPTR
SETOM INSBP
SETZM DISFLF
SETZM IMQUIT
SETZM INSINP
SETZM INSBP
SETZM TRCOUT
SETZM BRC1
SETZM SLPNCR
IFN ITS,.CLOSE CHRAND, ;IN CASE WE QUIT OUT OF READING FILE DIR.
MOVE A,QRB.. ;MAKE SURE BFRPTR AND BFRSTR AGREE WITH ..O.
MOVE C,.QBUFR(A) ;A PDL OVERFLOW IN CERTAIN PLACES CAN CONFUSE THEM.
JRST BFRSET
;FS ERR THROW - THROW TO INNERMOST ERROR-CATCHING COMMAND LOOP.
;IT CAN BE EITHER A TECO COMMAND LOOP, A ^R, OR AN ERROR CATCH (:@< ... >).
FSERTH: HLRZ Q,ITRPTR
FSERT0: JUMPE Q,FSERT1 ;IF WITHIN AN ERRSET
MOVE CH,MFMACP-MFBLEN+1(Q)
TLNE CH,MFERS1 ;WHICH IS REALLY AN ERROR CATCH (:@< ... >),
JRST FSERT2 ;THEN MAYBE THROW TO IT.
HLRZ Q,(Q) ;IF INNERMOST ERRSET ISN'T AN ERROR CATCH,
JRST FSERT0 ;MAYBE THE NEXT ERRSET OUT IS ONE.
FSERT2: HLRZ CH,MFPF-MFBLEN+1(Q)
HRRZ A,DISPRR ;FOUND AN ERROR CATCH; USE IT ONLY IF NO ^R WITHIN IT.
SKIPE A
CAIG A,(CH)
JRST [ ;THEN THROW TO THE ERROR CATCH.
MOVEM C,LASTER ;MAKE IT RETURN FS ERR THROW'S ARG.
SETOM ERRFLG
JRST FSERT3]
FSERT1: SKIPN A,DISPRR ;OTHERWISE, IF INSIDE A ^R, RETURN TO THAT ^R.
JRST GO
TRZ FF,FRARG+FRARG2
SKIPE MACXP
CAML A,MACXP ;IF DON'T WANT A BREAK LOOP AND INSIDE A ^R, RETURN TO THAT ^R.
JRST [SETZM RREBEG
JRST RRTHRW] ;HOW TO DO IT DEPENDS ON WHETHER WE CALLED ANY MACROS FROM IT.
JRST FSCRTH
;THROW TO THE INNERMOST ERROR CATCH (WE ALREADY CHECKED THAT THERE IS ONE).
FSERT3: CALL UNWIND ;POP SOME STUFF OF MACRO PDL, ETC.
JRST FSERT4 ;NO SKIP IF HAVE REACHED ERRSET OR ERROR CATCH; CH = RH(ITRPTR)
JRST FSERT3 ;SKIPS 1 AFTER POPPING MACRO CALLED BY "M" CMD.
MOVE CH,MACXP
POP CH,MACXP
POP CH,MACPTR
PUSHJ CH,SETP ;SKIPS 2 AFTER POPPING A MACXQ OR MACXCW.
JRST FSERT3
FSERT4: MOVE Q,MFMACP-MFBLEN+1(CH)
TLNN Q,MFERS1 ;IF THIS IS A RANDOM ERRSET, NOT AN ERROR CATCH, KEEP UNWINDING.
JRST [ CALL ITRPOP
JRST FSERT3]
HRROI Q,MFCSTR-MFBLEN+1(CH)
POP Q,CSTR ;POSITION AT THE FRONT OF THE ERRSET
POP Q,CPTR
POP Q,COMCNT
JRST INCMA0 ;THEN SEARCH FOR THE >.
;TRY TO UNWIND MACRO PDL AND ITERATIONS UNTIL REACH INNERMOST ERRSET.
;DON'T SKIP IF REACH THERE. SKIP 1 IF POP AN ORDINARY MACR (IN WHICH CASE
;UNWINDING ISN'T FINISHED). SKIP 2 AFTER POPPING A MACRO CALLED
;BY A MACXQ.
UNWIND: HRRO A,ITRPTR ;FIND INNERMOST ERRSET OR ITERATION,
SKIPN ITRPTR ;[ ;IF NO ITERATION, POP ANY MACRO OR ^]^X.
SKIPA CH,[400,,MACPDL-1]
MOVE CH,MFMACP-MFBLEN+1(A)
TLZ CH,40
CAMN CH,MACPDP ;[ ;ANY MACRO OR ^]^X CALLS INSIDE IT => POP THEM.
JRST UNWINI ;ELSE HANDLE THE ERRSET OR ITERATION.
UNWINM: LDB CH,MACPDP ;[ ;IS IT A MACRO? OR A ^]^X?
CAIN CH,10
JRST UNWIN2 ;IT'S A NULL, THROW IT AWAY.
TRNE CH,10
JRST UNWIN1 ;[ ;IT'S A ^]^X.
SKIPN MACPTR
.VALUE ;MACPDP AND MACPTR OUT OF PHASE??
CALL DECDCH ;IT'S A MACRO CALL, RESTORE SQUOTP, ETC.
CALL POPMAC ;POP STRING PTR, ETC.
AOS (P) ;SKIP 1 OR 2 DEPENDING.
SKIPGE MACPTR
AOS (P)
JRST POPMP
UNWIN1: CALL DECDCH ;[ ;POP A ^]^X.
CALL POPCTX
CALL PUSMAC
UNWIN2: CALL POPMP
JRST UNWIND
UNWINI: SKIPN ITRPTR ;TRYING TO UNWIND WHEN NO ITERATION OR MACRO =>
.VALUE ;UNWIND'S CALLER'S END TEST FAILED.
HLRZ CH,ITRPTR ;IS THIS AN ERRSET OR AN ITERATION?
CAIN CH,(A)
RET ;REACHED AN ERRSET.
CALL ITRPOP ;AN ITERATION - POP IT
JRST UNWIND ;AND LOOK AT THE NEXT ONE OUT.
;FS ^R EXIT - WITHIN A MACRO CALLED FROM ^R, RETURN FROM THE ^R.
;FS ^R THROW - WITHIN A MACRO CALLED FROM ^R, RETURN TO ^R.
FSCREX: SKIPA Q,[FSCRE1,,MEXIT1]
FSCRTH: MOVE Q,[FSCRT1,,MEXIT1]
SKIPN DISPRR ;NOT INSIDE ^R => ERROR.
TYPRE [N%R]
JRST MEXIT1
;FS BACK RETURN$: RETURN TO A SPECIFIED FRAME (SPECIFIED A LA FS BACK ARGS$).
FSBKRT: CALL BACKTR ;A GETS A POINTER TO THE FRAME TO RETURN TO.
MOVE Q,[FSBKR2,,FSBKR1]
SOS A ;REMEMBER ADDR OF FRAME (MINUS 1,
MOVEM A,BKRTLV ; AS IT WILL BE WHEN ON THE FREELIST).
JRST MEXIT1
FSBKR1: SKIPA B,[CD] ;AFTER POPPING A MACRO FRAME, B GETS HOW TO RETURN
FSBKR2: MOVEI B,CPOPJ ;TO THAT FRAME, DEPENDING ON WHETHER IT WAS A MACXQ.
MOVE A,BKRTLV
CAME A,MFFREE ;IF THE FRAME JUST POPPED INTO AND FREED WAS THE RIGHT ONE,
JRST MEXIT1 ;RETURN TO IT. ELSE, KEEP POPPING.
JRST (B)
;^\ - IN A MACRO, RETURN FROM IT, POPPING QREGS AND ITERATIONS.
;:^\ DOESN'T POP QREGS.
MEXIT: SKIPN MACPTR
TYPRE [NIM] ;"EXIT MACRO" IF NOT INSIDE ONE?
MOVE Q,[CPOPJ,,CD5A]
;RH(Q) HAS WHERE TO GO AFTER POPPING A MACRO CALLED BY "M".
;LH(Q) HAS WHERE TO GO AFTER POPPING A MACXQ.
MEXIT1: MOVE C,MACSPF ;PLACE TO POP TO.
TRZN FF,FRCLN ;POP THE QREG PDL UNLESS :^\.
JRST [ SAVE Q
CALL FSQPU0
REST Q
JRST .+1]
MEXIT2: CALL UNWIND ;POP A MACRO OR ITERATION.
JRST [ CALL ITRPOP ;HERE IF ENCOUNTER AN ERRSET.
JRST MEXIT2]
JRST (Q) ;POPPED AN ORDINARY MACRO.
MOVE CH,MACXP ;POPPED A MACRO CALLED BY A MACXQ.
POP CH,MACXP
POP CH,MACPTR
PUSHJ CH,SETP ;SET P FROM CH, UNWIND STUFF, THEN POPJ P,
HLRZ CH,Q
JRST (CH)
FSCRE1: SKIPA C,[RREXI0]
FSCRT1: MOVEI C,RRTHRW
SKIPE A,MACXP ;WE HAVE JUST POPPED THE MACRO CALLED FROM ^R, IF
CAMG A,DISPRR ;THE NEXT POSSIBLE CANDIDATE MACRO FRAME
JRST (C) ;IS TOO FAR OUT ON THE CONTROL STACK.
JRST MEXIT1 ;NO, POP THE INNERMOST MACRO AGAIN.
SUBTTL QUIT/ERROR REINITIALIZATION
;COME HERE ON INITIALIZATION, QUIT, AND ^W COMMAND.
CTLW: SETOM GOXFLS ;POP TO TOP LEVEL; DON'T INVOKE ERROR HANDLER OR MAKE BREAK LOOP
;COME HERE ON ERROR.
;IMQUIT IS POSITIVE IF WE QUIT OUT OF LIS (TECO COMMAND READER). IT MEANS
;WE SHOULD STAY IN THE COMMAND LEVEL THAT WAS CALLING LIS.
;OTHERWISE, IF $QERRH (Q..P) IS NONZERO, IT IS THE ERROR HANDLER MACRO TO CALL.
;OTHERWISE, IF UNWINF (FS*RSET$) IS NONZERO, CREATE A BREAK LOOP.
GOX1: SKIPN CH,LEV ;COMPUTE THE PDL LEVEL AT THE INNERMOST
MOVE CH,[-LPDL,,PDL-1]
SKIPN Q,MACXP ;INVOCATION OF THE COMMAND LOOP OR ^R.
MOVE Q,[-LPDL,,PDL-1]
CAMGE CH,Q ;NAMELY, MUST BE INSIDE ALL OPEN-PARENS,
MOVE CH,Q ;INSIDE ALL MACXQ'S, ABOVE BOTTOM OF STACK,
SKIPN Q,DISPRR ;AND ABOVE DISPRR.
MOVE Q,[-LPDL,,PDL-1]
CAMGE CH,Q
MOVE CH,Q
SKIPGE GOXFLS ;MAYBE WE HAVE BEEN RQ'D TO POP ALL THE WAY TO TOP.
MOVE CH,[-LPDL,,PDL-1]
CAME P,CH ;MUSTN'T PUSHJ CH, IF CH=P, SINCE RET. ADDR WOULD BE UNPROTECTED
PUSHJ CH,SETP ;SET P FROM CH, UNWINDING SOME STUFF; THEN POPJ P,
SKIPL TYOFLG ;IF TYPEOUT IN PROGRESS, FORCE IT OUT.
CALL DISFLS
SETZM CTLCF
SKIPE CPTR
CALL ERRP2 ;MARK THE CURRENT PC FOR "?" TO DISPLAY.
MOVE C,IMQUIT
SETZM IMQUIT
MOVE TT,BEG
SKIPN E,RREBEG ;MUSTN'T RUN OUTSIDE ^R WITH RREBEG ZERO.
MOVEM TT,RREBEG
SKIPL ERRFLG
SETZM LASTER ;IF NO ERROR, MAKE SURE FS ERROR IS 0.
HRRZM P,ERRFL1 ;AS YET, NO ERROR MESSAGE PRINTED (THOUGH MAY CHANGE)
SKIPN GOXFLS ;IF WE'RE POPPING TO TOP, DON'T PUSH NOW.
SKIPLE C ;IF THIS IS TECO STARTUP, OR QUIT OUT OF COMMAND READER,
JRST GOX4 ;THERE'S REALLY NOTHING TO PUSH NOW.
SKIPN UNWINF ;ENTER BREAK LOOP?
SKIPE $QERRH ;OR HAVE AN ERROR HANDLER?
CAIA
JRST GOX4 ;NEITHER; NO NEED TO PUSH.
JUMPN E,GOX5 ;IF ERROR OCCURRED ACTUALLY INSIDE ^R (NOT WITHIN A MACRO)
SAVE [[ MOVE P,DISPRR
REST A
JRST RRLP]] ;THEN SIMULATE A MACXQ CALL WHICH, WHEN RETURNED FROM, WILL
SAVE MACPTR ;RETURN TO ^R.
SAVE MACXP
SETOM MACPTR
MOVEM P,MACXP
GOX5: JSP T,OPEN1 ;NOW PUSH VALUES
CALL PUSMAC ;AND THE CURRENT MACRO (THAT ERRED).
CALL FLGENC ;ENCODE AND SAVE SQUOTP AND RCHALT
IDPB CH,MACPDP
MOVE CH,PF ;REMEMBER THE QREG PDL LEVEL ON ENTRY TO THE ERROR HANDLER.
MOVEM CH,MACSPF
SETZM SQUOTP
CALL GOCPY ;IF CBUF IS ON MACRO PDL, COPY IT TO A STRING
;SINCE CBUF IS LIKELY TO BE OVERWRITTEN NOW.
SKIPE A,$QERRH ;IF THE USER HAS AN ERROR HANDLER, GO TO IT.
JRST [ TRO FF,FRCLN ;WE ALREADY PUSHED THE ERRING MACRO; NO NEED TO PUSH AGAIN.
SETZM ERRFLG ;ERROR PROCESSING NOW FINISHED.
JRST MAC5] ;NOW RUN THE ERROR HANDLER.
GOX4: TRO FF,FRARG\FRCLN\FRUPRW
SKIPGE GOXFLS ;GOXFLS AND ERRFLG IMPLY THIS IS "ERROR ENTERING ERROR HANDLER"
TRZ FF,FRCLN ;SO DON'T OVERWRITE THAT LINE WITH THE ERROR MSG.
SKIPE C,LASTER ;NO USER ERROR-HANDLER, SO IF RESPONDING TO AN ERROR,
CALL FGCMD ;PRINT STANDARD ERROR MESSAGE, FLUSH TYPEAHEAD, AND TYPE A BELL.
SETOM UNRCHC ;IF WE ARE ^G-QUITTING BACK TO TECO CMD LOOP, FLUSH THE ^G.
SETZM TYISRC
SETZM TYISNK
SETOM TYOFLG ;FORCE TYPEOUT TO RE-INIT.
SKIPN RGETTY
CALL CRR
SETZM ERRFLG ;ERROR PROCESSING NOW FINISHED.
SKIPN GOXFLS ;IF POPPING ALL TEH WAY OUT, ENTER A TECO COMMAND LOOP.
SKIPE UNWINF ;IF *RSET IS ON, ENTER A TECO COMMAND LOOP.
JRST GO
JRST FSERTH ;OTHERWISE EXIT TO INNERMOST ^R OR ERROR CATCH.
;ALTMODE AS COMMAND.
ALTCMD: SKIPGE NOOPAL ;FS NOOPALT NEGATIVE => IGNORE ALTMODE.
JRST CD5
SKIPN NOOPAL ;POSITIVE => ALTMODE IS LIKE ^_.
TYPRE [DCD] ;ERROR IN MACROS, IGNORE AT TOP LEVEL.
LGOGO:
;COME HERE WHEN EXECUTE ^_, PERHAPS ALTMODE.
CALL FLSOUT ;EMPTY OUTPUT BUFFER INTO OUTPUT FILE.
IFN ITS,[
.SUSET [.RJNAM,,A]
CAME A,['HACTRN]
.LOGOUT
]
AOSN CTLCF ;IF READ ^C,
CALL FSEXI1 ;RETURN TO DDT.
HRRZM P,ERRFL1
GO: MOVE A,GOXFLS ;IF WE'RE REQUESTED TO POP ALL THE WAY
SETZM GOXFLS
SKIPE UNWINF ;OR NOT IN *RSET MODE,
JUMPGE A,GO2
MOVE CH,[-LPDL,,PDL-1]
CAME CH,P
PUSHJ CH,SETP ;SET P FROM CH, UNWINDING OUT OF ^R OR SORT OR PARENS.
SETZM MACXP
SETZM NOQUIT
SETZM MACPTR
SETZM MACDEP
SETZM CTXPTR
SETZM ITRPTR
MOVE A,[400,,MACPDL-1]
MOVEM A,MACPDP
MOVEI A,MFSTRT-1 ;NOW PUT ALL CELLS ON THE FREE LIST.
SETZM MFFREE
MOVE B,MFEND
GO1: SKIPL MFBEG+1(A) .SEE MFBFR ;FREE ALL MACRO FRAMES, EXCEPT THOSE OF BUFFERS.
CALL FLSFRM ;FREE IT.
ADDI A,MFBLEN
CAIGE A,-1(B)
JRST GO1
MOVE C,PFINI ;UNWIND QREG PDL.
CALL FSQPU0
GO2: MOVEI A,(JFCL)
HRLM A,RCHALT
SETZM SQUOTP
SETZM MACBTS ;THERE ARE NO MACRO ARGS IN TOP-LEVEL CMD STRING.
CALL FLSCM1 ;FLUSH SOME CORE, AND FORCE OUT OUTPUT BUFFER.
SKIPL TYOFLG ;FORCE ALL TYPEOUT TO BE PRINTED.
CALL DISFLS
SETZM IMQUIT
SKIPN ECHOFL
CALL SETTTM ;TURN ECHOING BACK ON IF NECESSARY.
SKIPE MORFLF ;IF PREVIOUS COMMAND FLUSHED,
SETOM TYOFLG ;NEXT TYPEOUT WILL REINIT AND UN-FLUSH.
SETZM MORFLF
MOVE C,QRB..
MOVE C,.QPT1(C) ;GET WHAT . WAS WHEN LAST CMD STRING STARTED.
CALL FSPSPT ;PUSH ON . RING BUFFER.
MOVE CH,QRB.. ;MACRO ..L IF THAT'S APPROPRIATE.
MOVE A,.QRSTR(CH)
AOSN INITF1
JUMPN A,GOXX
CALL VIEW2 ;NOW GO TRY TO DISPLAY DIR. OR BUFFER.
JRST LIS
GOXX: TRO FF,FRCLN ;DO A :M TO ..L, MAKING IT THE TOP LEVEL MACRO FRAME
JRST MAC5 ;LEAVING MACPDL EMPTY.
;FIND THE MACRO FRAME THAT IS EXECUTING OUT OF CBUF, COPY THE CONTENTS
;OF CBUF INTO A STRING, AND MAKE THE MACRO FRAME POINT TO THAT STRING INSTEAD.
;THE GOAL IS TO FREE UP CBUF FOR RE-USE WHEN COMMAND READER IS ENTERED
;IN A BREAK LOOP.
;DOESN'T PROMISE TO RPESERVE ANY ACS.
GOCPY: MOVEI A,MFSTRT
GOCPY1: SKIPGE MFBEG(A) .SEE MFBFR ;DONT CONSIDER BUFFER FRAMES.
JRST GOCPY2
HRRZ C,MFCPTR(A) ;WHERE DOES B.P. OF MACRO FRAME POINT?
JUMPE C,GOCPY2 ;IGNORE FREE CELLS; THERE MAY BE SOME -> CBUF.
CAIL C,@CBUFLO
CAIL C,@CBUFH
JRST GOCPY2
JRST GOCPY3 ;CPTR OF THIS FRAME POINTS WITHIN CBUF!
GOCPY2: ADDI A,MFBLEN
CAMGE A,MFEND ;SCAN ALL FRAMES.
JRST GOCPY1
RET ;NO FRAME POINTS IN CBUF - NO COPYING NEED BE DONE.
GOCPY3: HRRZ E,CBMAX ;HOW LONG IS USED PART OF CBUF?
MOVEI C,4(E) ;GET THAT MUCH SPACE, PLUS SOME FOR STRING HEADER
CALL SLPQGT
MOVEI B,QRSTR
MOVEI C,4(E)
CALL QHDRW1 ;WRITE HEADER OF STRING; B.P. RETURNED IN BP TO IDPB TEXT.
MOVE C,E
MOVE IN,CBUFLO ;AND GET B.P. TO ILDB TEXT TO COPY.
GOCPY4: ILDB CH,IN
IDPB CH,BP
SOJG C,GOCPY4
MOVE BP,QRWRT
SUB BP,QRBUF
TLO BP,400000
MOVEM BP,MFCSTR(A) ;STORE STRING POINTER TO NEWLY CONSTRUCTED STRING IN MACRO FRAME.
MOVEI BP,4(E)
ADDB BP,QRWRT ;CLOSE THE FINISHED STRING; ET CHAR ADDR 1 + LAST CHAR.
SUB BP,MFCCNT(A) ;GET NEW CHAR ADDR OF CHAR CPTR SHOULD ILDB NEXT
CALL GETIBP ;AND SET UP CPTR -> SAME CHARACTER IN ITS NEW HOME.
MOVEM BP,MFCPTR(A)
RET
SUBTTL F? COMMAND
;F? COMMAND - MBOX CONTROL.
;ARGUMENT IS BIT-DECODED. NO ARG, OR ARG=0, IMPLIES ARG=30 .
;BIT 1.1 - CLOSE GAP. MAY BE NEEDED FOR COMMUNICATION WITH OTHER PROGRAMS
; THAT DON'T UNDERSTAND THE GAP.
;BIT 1.2 - GC STRING SPACE. USEFUL BEFORE DUMPING OUT OR IF IT IS SUSPECTED
; MANY STRINGS HAVE RECENTLY BEEN DISCARDED.
;BIT 1.3 - SWEEP THE JUMP CACHE. NECESSARY IF A STRING'S CONTENTS HAVE BEEN
; ALTERED BY THE F^E COMMAND, AND IT IS A MACRO THAT MIGHT
; HAVE CONTAINED "O" COMMANDS.
;BIT 1.4 - FLUSH UNOCCUPIED CORE. GOOD TO DO EVERY SO OFTEN, OR IF IT IS
; LIKELY THE BUFFER HAS JUST SHRUNK.
;BIT 1.5 - CLOSE THE GAP, IF IT IS > 5000 CHARACTERS. GOOD TO DO EVERY SO
; OFTEN, IN CASE USER DELETES LARGE AMOUNTS OF TEXT; SAY,
; WHENEVER EXCESS CORE IS FLUSHED.
FLSCMD: ARGDFL
SKIPE C
TRNN FF,FRARG ;NO ARG SAME AS ARG OF 30.
FLSCM1: MOVEI C,30
HRLM C,(P)
CALL FLSOUT ;FIRST, FORCE OUT OUTPOUT BUFFER.
HLRZ C,(P)
MOVE A,EXTRAC
TRNE C,20
CAIG A,5000 ;"20" BIT MEANS CLOSE GAP IF VERY LARGE.
TRNE C,1 ;"1" BIT MEANS CLOSE GAP IN ANY CASE.
CALL SLPSHT
TRNE C,2 ;IF "2" BIT IS SET IN ARG, DO A GC,
JRST GCC ;THAT INCLUDES FLUSHING CORE AND SWEEPING CACHE.
TRNN C,4 ;"4" BIT MEANS SWEEP JUMP CACHE.
JRST FLSCM2
CLEARM STABP
MOVE T,[STABP,,STABP+1]
BLT T,SYMEND-1
FLSCM2: TRNN C,10 ;"10" BIT MEANS FLUSH UNUSED CORE.
RET
FLSCOR: SAVE A
SAVE B
SAVE C
MOVE A,BFRTOP ;OTHERWISE JUST FLUSH CORE.
CAMN A,BFRBOT ;DON'T FLUSH ALL PAGES, ELSE THE
ADDI A,1 ;GAP BETWEEN IMPURE STRINGS AND BUFFER WOULD FILL UP.
ADDI A,2000*5-1
IDIVI A,5*2000 ;A_ # PAGES WE'RE REALLY USING.
MOVE C,MEMT ;C_ # OF LAST PAGE WE HAVE.
SUBM A,C ;C HAS -<# PAGES TO FLUSH>
JUMPE C,POPCBA
MOVE J,A
IFN ITS,[
HRLM C,A ;A HAS AOBJN -> PAGES TO BE FLUSHED.
SKIPGE A ;WE'RE TRYING TO CORE UP???
SYSCAL CORBLK,[%CLIMM,,0 ? %CLIMM,,%JSELF ? A]
.VALUE
]
IFN TNX,[
MOVEI B,(A) ;FIRST BLOCK TO DO
ASH B,1 ;MAKE A PAGE NUMBER
HRLI B,.FHSLF
SETO A, ;SAY UNMAP
ASH C,1
IFN 20X,[MOVM C,C ;NUMBER OF PAGES
HRLI C,(PM%CNT)
PMAP ;UNMAP THEM
]
.ELSE [ PMAP ;TENEX -- NO MULTIPLE PMAPS
AOJGE C,.+2
AOJA B,.-2
]]
MOVEM J,MEMT ;UPDATE # OF FIRST K OF NXM.
CAML J,LHIPAG ;WE SHOULD HAVE A 1K GAP BETWEEN BUFFER SPACE AND LIBRARIES.
.VALUE
JRST POPCBA
SUBTTL TECO COMMAND STRING READER
LISCRF: CALL ECHOCR
LIS: HRRZM P,IMQUIT ;^G DURING TYPEIN QUITS IMMEDIATELY.
SETZM NOQUIT
SKIPGE STOPF ;PERFORM ANY PENDING QUIT.
CALL QUIT0
SKIPN ECHOFL
CALL SETTTM ;MAKE SURE ECHOING IS ON.
SETZM RCHSFF
.I CASE=CASNRM ;REINIT THE INPUT CASE.
TTYACT ;TO SET "ACTIVATE ON NEXT CHAR REGARDLESS" AGAIN
CALL VBDACU
JFCL
SETZM CTLBRF
MOVE C,QRB..
SETZM .QVWFL(C)
MOVE B,CBUFLO ;BP TO BEFORE CMD BUFF.
MOVE TT,CBMAX ;WAS THE PREVIOUS CMD STRING A LONG ONE?
CAIGE TT,10.
JRST LISSRT ;NO, IT WAS SHORT.
MOVEM TT,SAVCMX ;YES, THIS IS CMD STRING FOR ^Y TO INSERT.
MOVEI TT,SAVCW1-1 ;SO SAVE INFO ON IT SO SHORT CMDS
PUSH TT,1(B) ;WON'T CLOBBER THE BEGINNING OF IT.
PUSH TT,2(B)
PUSH TT,3(B)
.I SAVCPT=CPTR
LISSRT: SETZM CBMAX ;CBMAX COUNTS CHARS IN CMD STRING BEING READ IN
SETZM COMCNT
MOVEM B,CPTR ;INIT CPTR FOR EXECUTION OF THE CMD STRING
MOVEM B,CSTR
MOVE C,CBUFH
;HANDLE ":TECO FOO BAR" FROM DDT
SKIPGE CMFLFL ;READING FROM INIT FILE => GO YANK AND XCT IT.
JRST LISINI
LI1: SKIPE RGETTY ;IF NO DISPLAY,
JRST LILUP
SKIPE CH,PROMCH ;PROMPT UNLESS PROMPTING DISABLED.
CALL TYANOW
;FALLS THROUGH TO READ THE FIRST CHARACTER.
;FALLS THROUGH.
;LOOP AFTER HANDLING A CHAR OTHER THAN ALTMODE.
LILUP: TRZ FF,FRALT ;SAY THE PRECEDING CHAR WASN'T ALTMODE.
LI2: MOVE C,CBUFH
CAILE C,(B) ;LOOP BACK HERE AFTER ALTMODE, WITH FRALT SET.
JRST LI3
ADDI C,100 ;IF WE'VE FILLED THE COMMAND BUFFER, MAKE IT BIGGER.
SAVE C
MOVEI C,500 ;MAKE SURE WHEN IMPURE STRING SPACE IS MOVED UP
CALL SLPQGT ;IT WON'T REACH BUFFER SPACE.
REST C
MOVE E,QRWRT ;LAST WD TO MOVE UP IS LAST IN IMPURE STRING SPACE.
IDIVI E,5
MOVE J,QRBUF
IDIVI J,5
SUBM E,J
MOVE CH,(E)
MOVEM CH,100(E)
SOS E
SOJGE J,.-3
MOVEI T,500
ADDM T,QRBUF
ADDM T,QRWRT
LI3: MOVEM C,CBUFH
SETZM CTLCF
CALL TYI ;READ CHARACTER FROM TERMINAL.
CALL TYINRM
MOVEI TT,^J ;PRETEND THAT EVERY CR IS FOLLOWED BY A LF.
CAIN CH,^M
MOVEM TT,UNRCHC
SKIPL CTLBRF ;[ ;LET ^]^Q QUOTE A ^C
IFN ITS, CAIE CH,^C
IFN TNX, CAIE CH,^Z ;^C IMPLIES GO
JRST LI3Z
SETOM CTLCF ;BACK TO DDT IF FINISH COMMAND STRING WITHOUT ERROR.
JRST LISEOF ;IT ALSO TERMINATES THE COMMAND STRING.
LI3Z: CAME B,CBUFLO ;IF THIS IS 1ST CHAR, SOME CHARS ARE SPECIAL.
JRST LI3D1 ;NO, NORMAL.
JRST LISFST
;COME HERE AFTER READING A CHAR, WHEN THE CMD BUFFER IS EMPTY.
LISFST: CAIN CH,^R
JRST RRIMMD
IFN CTRLT,[
CAIN CH,^T
JRST EDIT
]
CAIN CH,^U ;^U => DISPLAY FILE DIR USING USER'S MACRO.
JRST [ MOVE CH,QRB..
SETZM .QVWFL(CH)
TLO FF,FLDIRDPY
SETZM IMQUIT
JRST GO]
CAIN CH,^V
JRST [ MOVE CH,QRB..
SETZM .QVWFL(CH) ;ALLOW BUFFER DISPLAY.
CALL POPPT ;POP . RING BUFFER.
JFCL
MOVE CH,QRB..
MOVEM A,.QPT1(CH) ;PREVENT AUTOMATIC RE-PUSH.
JRST GO]
CAIN CH,^X
SKIPN LASTER
CAIA
JRST [CALL FECMD8 ? JRST GO]
CAIN CH,^Y
JRST LISCY
TRNN FF,FRQMRK
JRST LI3D1
CAIN CH,"?
JRST ERRTYP
LI3D1: PUSHJ P,CKCH
JRST LISCRF ;RUBOUT ON AN EMPTY BUFFER.
JRST [SETZM CTLBRF ? JRST LILUP] ;A CHAR WAS RUBBED.
LISTOR: AOS CBMAX
IDPB CH,B
AOSE CTLBRF ;[[ ;WAS THIS CHAR PRECEDED BY ^] OR ^]^Q?
JRST LISBR1 ;NO.
CAIN CH,^Q ;YES, ^Q=> NEXT CHAR ALSO QUOTED.
LISBRC: SETOM CTLBRF
JRST LILUP ;[ ;QUOTED ^] AND ALTMODE AREN'T SPECIAL.
;[[ BRACKETS MUST BALANCE FOR CONDITIONALS.
LISBR1: CAIN CH,^] ;NOT QUOTED, ^] QUOTES NEXT CHAR.
JRST LISBRC
CAIE CH,ALTMOD ;ALTMODE => CHECK FOR ALT-ALT, MAYBE END STRING.
JRST LILUP
TRON FF,FRALT ;SAY JUST SAW AN ALTMODE,
JRST LI2
JRST LISDUN ;PREV. CHAR ALSO ALTMODE => END STRING.
CKCH: CAIE CH,177
JRST POPJ2 ;OK CHAR - RETURN, SKIPPING TWO
CAMN B,CBUFLO
POPJ P, ;RUBBED TO BEGINNING - NO SKIP
LDB CH,B
PUSHJ P,FSECOR
DBP7 B
SOS CBMAX
JRST POPJ1 ;RUBBED ONE CHAR - RETURN, SKIPPING ONE
;COME HERE ON ^C ON TTY.
LISEOF: MOVEI CH,ALTMOD ;DUMMY UP TWO ALTMODES.
IDPB CH,B
AOS CBMAX
IDPB CH,B
AOS CBMAX
;COME HERE AFTER HANDLING AND STORING ALTMODE-ALTMODE
LISDUN: MOVEI CH,^_ ;^_ TO STOP EXECUTION OF CMD STRING.
IDPB CH,B
AOS TT,CBMAX
MOVEM TT,COMCNT
;INITIALIZE RANDOM STUFF FOR ANOTHER CMD STRING.
SETZM IMQUIT
SETZM ERRFLG ;DON'T IGNORE 1ST LINE OF NEXT V-COMMAND.
IFN TNX,SETZM ECHOP ;NOT IN ECHO AREA ANY MORE
SKIPN RGETTY
PUSHJ P,CRR
TRZ FF,#FRTRACE
MOVE A,PT ;Q..I _ . .
SUB A,BEG
MOVE CH,QRB..
SETZM .QVWFL(CH) ;ALLOW BUFFER DISPLAY.
MOVEM A,.QPT1(CH) ;PUT . INTO Q..I.
JRST CD
POPJ2: AOS (P)
CPOPJ1:
POPJ1:
AOS (P)
POPJ P,
LISINI: CALL RRED1 ;INIT FILE OPEN ON CHFILI; PREPARE TO YANK IT.
MOVE CH,QRB..
SETZM .QVWFL(CH) ;ALLOW A BUFFER DISPLAY TO SHOW RESULTS.
MOVEI A,[ASCIZ /@Y :M(HFX*)/]
SETZM CMFLFL ;COMMAND FILE HAS BEEN HANDLED (ALMOST)
SETZM IMQUIT
CALL MACXCW ;XCT THAT STRING, TO YANK AND XCT THE INIT FILE.
JRST GO
;CONTROL-Y WAS 1ST CHAR TYPED --
; INSERT LAST COMMAND STRING INTO BUFFER, THEN REDISPLAY.
LISCY: MOVE CH,QRB..
SETZM .QVWFL(CH) ;ALLOW A BUFFER DISPLAY TO SHOW RESULTS OF ^Y.
SETOM SQUOTP ;[ ;DON'T LET ^] EXPAND WHEN WE REREAD CMD STRING.
SETOM BRC1
.I COMCNT=SAVCMX
HRROI TT,SAVCW3 ;RESTORE THE LAST LONG (>7 CHARS) CMD STRING
POP TT,3(B) ;.I <3RD WD OF CMD BUFFER>=SAVCW3
POP TT,2(B)
POP TT,1(B)
MOVE B,SAVCPT
SETO OUT,
LISCY1: CALL SKRCH ;READ CHAR FROM CMD STRING, DON'T TRACE.
MOVE C,COMCNT ;IF WE'VE REACHED THE $$^_ AT THE END,
CAIGE C,3 ;DON'T PUT THE $ IN THE BUFFER.
JRST [JUMPL OUT,GO ;IF CMD STRING WASN'T ALL READ,
MOVEM OUT,PT ;PUT PT AFTER LAST CHAR THAT WAS.
JRST GO]
CALL TYOMGS ;INSERT NEXT CHAR OF CMD STRING INTO BUFFER.
CAMN B,CPTR ;THE PTR SHOULD END UP AT THE POINT
MOVE OUT,PT ;COMMAND STRING READING STOPPED.
JRST LISCY1
;? WAS 1ST CHAR TYPED AFTER ERR MSG, RETYPE LAST FEW CHARS.
ERRTYP: HRRZM P,ERRFL1 ;DON'T LET ERRFL1 PREVENT OUR TYPEOUT FROM APPEARING.
MOVE B,ERR2
MOVEI C,8*5
SUBI B,8
ILDB CH,B
CAMG C,ERR1
PUSHJ P,TYO
CAME B,ERR2
SOJA C,.-4
JRST GO
;MARK THE CURRENT MACRO PC FOR ERRTYP TO TYPE OUT.
ERRP2: MOVEI A,COMCNT
CALL MFBEGP ;C GETS CURRENT PC IN CHARS IN CURRENT MACRO.
TRO FF,FRQMRK
MOVEM C,ERR1 ;SAVE THAT, AND B.P. TO LAST CHAR READ.
MOVE A,CPTR
MOVEM A,ERR2
RET
SUBTTL ^R MODE
;GET LENGTH CODE OF CHAR IN CH INTO A.
;SKIP IF NOT A CTL CHAR. NOTE THAT CALLING DISAD6 MAY BE
;EQUIVALENT TO DOING CALL .+1 .
DEFINE RRCHRG
SKIPE CASDIS ;IN -1F$ MODE, HANDLE SLASHIFICATION.
CALL DISAD6
MOVEI A,(CH)
IDIVI A,6
LDB A,RRCHBP(B)
CAIN CH,177 ;RUBOUT PRINTS AS ^? OR AS INTEGRAL SIGN, SO TREAT IT AS A CTL CHAR.
SKIPA A,[1]
CAIGE CH,40
TERMIN
;ENTRY FOR ^R 1ST CHAR TYPED IN CMD STRING.
RRIMMD: SAVE [GO]
MOVE TT,QRB..
SETZM .QVWFL(TT) ;ALLOW A BUFFER DISPLAY TO SHOW RESULTS OF ^R.
SETZM IMQUIT
;^R EXECUTED AS A COMMAND.
RRENTR: .I CASE=CASNRM
TLZA FF,FLNOIN ;SAY INPUT IS ACCEPTIBLE.
;@V COMMAND WITHIN A MACRO CALLED FROM ^R MODE COMES HERE.
RRNOIN: TLO FF,FLNOIN ;ENTRY TO DISPLAY ONCE AND RETURN, PROCESSING NO INPUT.
CALL RREARG ;PROCESS ARGS IF ANY, DECIDE WHAT REDISPLAY NEEDED.
;ALSO MAKE SURE RRHPOS AND RRVPOS ARE REASONABLE.
SAVE FF ;REMEMBER WHETHER THIS IS ^R OR @V, FOR RREAR0.
SAVE PF ;SAVE QPDL PTR SO EXITING ^R CAN POP WHAT FS ^R ENTER PUSHES.
SAVE DISPRR
CALL [MOVEM P,DISPRR ;SET UP PDL RESTORATION POINT
RET] ;FOR ERRORS CAUGHT BY ^R.
JUMPL FF,RRNOI2
SKIPE A,RRENTM
CALL RRMACR
RRNOI2::SETOM ECHCHR ;ENTERING ^R SHOULDN'T ECHO A COMMAND. @V SHOUDLN'T ECHO ONE.
TLNN FF,FLNOIN
SETOM RRLAST
;DROPS THROUGH.
SUBTTL ^R MODE REDISPLAY
;DROPS THROUGH.
;MAIN LOOP OF ^R EDIT: ROUTINES DISPATCHED TO WILL POPJ TO HERE.
RRLP: CAIA
CALL RRTTY1 ;BUILT-IN COMMANDS SKIP TO "RETURN ONE VALUE", SO SCAN CURSOR MOTION.
CALL RRTTYE ;PRINTING TTY IN SCAN MODE, IF COMMAND DOESN'T TYPE OUT, ECHO IT.
SETZM STOPF
SETZM ORESET
JUMPL FF,RRLP6 ;THIS IS ^R AS OPPOSED TO @V
CALL RRARGF ;THEN FLUSH ARGS IF COMMAND WASN'T AN ARG-SETTER.
SKIPN RRLAST ;AND IF THE LAST COMMAND WAS NOT AN ARG-SETTER,
JRST RRLP6B
MOVE CH,INCHCT ;THEN A COMMAND HAS JUST ENDED, SO SAVE FS TYI COUNT IN FS TYI BEG.
SKIPL UNRCHC ;BUT DON'T INCLUDE ANY CHARACTER THA<T'S GOING TO BE REREAD.
SOS CH
MOVEM CH,INCHRR
SKIPE ECHFLS
SKIPGE PJATY ;IF WHOLE SCREEN IS ABOUT TO BE CLEARED ANYWAY, DON'T BOTHER.
JRST RRLP6B
SKIPN C,ECHACT ;IF ECHO AREA SHOULD BE CLEARED, DO SO.
JRST RRLP6B
JUMPG C,[SETOM ECHACT ;IF IT SHOULD BE CLEARED NEXT TIME BUT NOT THIS TIME,
JRST RRLP6B] ;REMEMBER THAT.
SETZM ECHACT ;INDICATE ECHO AREA NO LONGER OCCUPIED.
SKIPN RGETTY
JRST RRLP6B
MOVEI C,^P
CALL FSECDS
MOVEI C,"C
CALL FSECDS ;FSECDS SETS RROVPO SO WE WILL REPOSITION THE CURSOR WHEN WE CAN.
SETZM ECHACT ;RE-CLEAR SINCE FSECDS SET IT AGAIN.
RRLP6B: SKIPLE RRMCCT ;AND IF FS ^RMDLY ISN'T 0,
SOSLE RRMCC1 ;THEN IF IT IS ALREADY TIME TO INVOKE SECY, DO SO.
JRST RRLP6
MOVE CH,QRB.. ;IF THERE IS ONE. IF THERE IS NONE, RRMCC1 IS NEGATIVE SO AS
SKIPN A,.QCRMC(CH) ;SOON AS THERE IS ONE AGAIN IT WILL BE RUN.
JRST RRLP6
CALL RRMACR ;DO SO.
MOVE A,RRMCCT ;AND REINIT # CHARS TO EXECUTE BEFORE
MOVEM A,RRMCC1 ;NEXT INVOKATION.
RRLP6: SETO OUT, ;WE HAVEN'T RUN THE FS ^R DISPLAY MACRO YET.
RRLP6A: SKIPN RGETTY
JRST [ SKIPGE GEA ;ON PRINTING TTY, REDISPLAY ONLY AFTER A ^L.
JRST RRLP4
JRST RRLP1] ;OTHERWISE JUST READ ANOTHER COMMAND.
SKIPE RRINHI ;IF DISPLAYING IS INHIBITED, READ ANOTHER COMMAND WITHOUT DISPLAYING
JRST [ MOVE T,MORESW ;BUT DO UPDATE THE MODE-LINE.
CAIE T,MS%FLS ;AND DON'T TRY TO LEAVE IT SAYING "FLUSHED".
SETZ T,
CALL DISMD
JRST RRLP1]
SKIPE DFORCE
JRST RRLP6C
SKIPGE UNRCHC ;ANY BUFFERED INPUT TO PROCESS?
SKIPE TYISRC
JRST RRLP1
LISTEN TT
JUMPN TT,RRLP1
RRLP6C: SETOM TYOFLG ;DOING ^R DISPLAY FORCES TYPEOUT TO RE-INIT.
SKIPGE GEA ;^L OR F+ HAS CLEARED THE SCREEN => REDISPLAY
JRST RRLP4
SKIPL PJATY ;SCREEN GOT CLOBBERED, OR LOTS OF CHANGES HAPPENED, =>
SKIPGE RRMNVP ;MUST CHECK THE WINDOW BEFORE DISPLAYING ANYTHING.
JRST RRLP4
CALL RRWBLS ;IS OLD WINDOW STILL GOOD?
CALL [ TRO FF,FRUPRW ;NO => CHOOSE A NEW ONE FROM SCRATCH, AND
JRST RRALT6] ;TRY SCROLLING THE TEXT WITH INSERT/DELETE LINE.
SKIPGE PJATY ;RRALT6 CAN SET THIS ON NOCEOL TERMINALS.
JRST RRLP4
MOVE A,RRMAXP ;RRMAXP=1 IS SET TO INHIBIT UPDATING IN RRDLB AND RRINSC.
CAIN A,1 ;IT DOESN'T INDICATE ANY CHANGES HAVE ACTUALLY OCCURRED.
SETZM RRMAXP
SKIPN RRMAXP ;ANY REDISPLAY REQUIRED?
SKIPL RRMSNG
CAIA
JRST RRLP3 ;NO, JUST MOVE CURSOR IF NEC.
MOVE A,RRMNVP
CAML A,BOTLIN ;IF ALL REQUIRED REDISPLAY IS REALLY OFF BOTTOM OF SCREEN,
JRST [ CALL RRDIS2 ;SAY IT'S BEEN DONE, AND MOVE THE CURSOR IF NEC.
JRST RRLP3]
JUMPE OUT,RRLP2F ;RUN FS ^R DISPLAY, UNLESS WE JUST FINISHED RUNNING IT.
SKIPN A,RRDISM ;ABOUT TO DISPLAY; FIRST CALL USER'S MACRO.
JRST RRLP2F
CALL RRMACR
SETZ OUT, ;MARK FS ^R DISPLAY AS RUN, THIS TIME, TO AVOID INFINITE LOOP.
TRNN FF,FRARG2 ;IF 0 OR 2 VALUES, RECONSIDER WHAT DISPLAY TO DO
TRNN FF,FRARG
SETO OUT,
JRST RRLP6A
;HERE IF PART OF THE SCREEN NEEDS REDISPLAY BUT NOT WHOLE SCREEN.
RRLP2F: SETOM RRIDLB ;IF NO INSERT/DELETE LINE, CAUSE ASSOCIATED CODE TO DO NOTHING.
SKIPE LID ;IF THE TERMINAL HAS INSERT/DELETE LINE, SEE HOW MANY LINES OF
CALL RRLID ;BOTTOM OF WINDOW WILL STILL BE GOOD IF SHIFTED A FEW LINES.
CALL CHCTI0 ;INIT. FOR CALLING DISAD.
SETOM TYOFLG
SETZM CHCTBP
AOS CHCTBP ;(MUSTN'T BE 0, OR CHCTHC WOULDN'T BE SET)
HLLOS DISBFC
MOVEI TT,CPOPJ
MOVEM TT,CHCTAD ;MAKE SURE DISLIN NOT CALLED, IN CASE STRAY CR OR BS.
.I RRDHPS=RRHPOS ;SAVE INFO FOR DEBUGGING.
.I RRDVPS=RRVPOS
.I RRDMHP=RRMNHP
.I RRDMVP=RRMNVP
SAVE PT
SAVE RRHPOS
SAVE RRVPOS
RRLP2G: MOVE A,RRMNVP ;FIND THE 1ST CHAR IN THE 1ST LINE
MOVEM A,RRVPOS
LDB TT,[3300,,LINBEG(A)] ;WHICH WAS ALTERED,
MOVEM TT,PT
MOVE TT,LINBEG(A)
ASH TT,-33
MOVEM TT,RRHPOS ;AND WHAT COLUMN IT WAS TYPED IN.
MOVEM TT,CHCTHP ;IN CASE LINE DOESN'T START AT LEFT MARGIN
;(DUE PERHAPS TO LF WITHOUT CR)
CALL CHCTL4 ;INIT CHCTHC WITH SPACES.
SETZ T, ;T GETS THE LARGEST HPOS THAT ACTUALLY EXISTS ON THE LINE.
;IF THE LINE ENDS SHORT OF RRMNHP, WE RESET RRMNHP TO THAT AND RETRY.
RRLP2B: MOVE TT,RRHPOS ;MOVE FORWARD TILL WE FIND 1ST CHAR
CAML TT,RRMNHP ;THAT FALLS IN THE 1ST ALTERED COLUMN.
JRST RRLP2C
MOVE TT,PT
CAML TT,ZV
JRST RRLP2C
CALL RRFORW
CAMGE T,RRHPOS
MOVE T,RRHPOS
MOVE TT,RRVPOS
CAME TT,RRMNVP ;BUT DON'T LET US MOVE PAST THE END OF
JRST RRLP2D ;THE LINE WE'RE SUPPOSED TO START ON.
CALL DISAD2 ;PUT THE CHARACTERS WE SKIP OVER INTO THE LINE'S HASH CODE.
JRST RRLP2B
RRLP2D: MOVEM T,RRMNHP ;HERE IF THE LINE DOESN'T EXTEND AS FAR RIGHT AS RRMNHP SAYS.
CALL CHCTI0 ;SET RRMNHP BACK TO THE LARGEST HPOS ON THE LINE, AND TRY AGAIN.
JRST RRLP2G ;SO WE DISPLAY FROM THE VERY END OF THE LINE.
RRLP2C: MOVE IN,PT ;CHAR ADDR 1ST CHAR TO BE OUTPUT.
AOSN CHCTCF
CALL CHCT5 ;FORCE OUT SAVED-UP CR.
CAML IN,BEGV
CAMLE IN,ZV
.VALUE
MOVEM IN,RRDPT ;REMEMBER WHERE OUTPUT STARTD, FOR DEBUGGING.
.I DISVP1=CHCTVP=DISVP=RRVPOS=RRMNVP
CALL DISLI6
MOVEI TT,DISLIN
MOVEM TT,CHCTAD
.I CHCTVS=BOTLIN
SETZM MORNXT
;NOW THINK ABOUT REDISPLAYING ONLY PART OF A LINE, MAYBE USING I/D CHAR.
MOVE A,RRMAXP
MOVE BP,RRMNVP ;NOW IS THE LAST THING THAT CHANGED
MOVEI TT,1(BP) ;THIS WON'T WORK ON THE LAST LINE ON THE SCREEN
CAML TT,BOTLIN ;BECAUSE THERE ISN'T A LINBEG GIVING ITS END ADDRESS.
JRST RRLP2H
SUB A,ZV ;ON THE SAME LINE AS THE FIRST CHANGE?
ADD A,RROLZV
ADDI A,2 ;CHANGES MUST END BEFORE THE CRLF BEFORE THE NEXT LINE.
SAVE CHCTHP
CAMGE A,LINBEG+1(BP)
CALL RRLCHG ;IF SO, USE MORE EFFICIENT PARTIAL-LINE UPDATING PROCEDURE.
CAIA
JRST [ ;IF IT WINS, WE ARE FINISHED!
SUB P,[1,,1]
REST RRVPOS
REST RRHPOS
REST PT
SKIPL RRMSNG
JRST RRLP6
JRST RRLP5]
REST CHCTHP
.I RRHPOS=CHCTHP
.I RRVPOS=RRMNVP
RRLP2H: MOVE TT,RRMNVP
CAME TT,BOTLIN ;UNLESS IT'S THE --MORE-- LINE,
SKIPN CHCTHP ;IF WE'RE DISPLAYING A WHOLE LINE, DON'T CLEAR UNLESS CHECKSUM
JRST [ SETOM DISVP ;SAYS IT HAS ACTUALLY CHANGED.
SETOM DISVP1
JRST RRLP2E]
MOVE CH,INCHCT ;IF "DISPLAYING" PRE-ECHOED CHARS, DON'T ACTUALLY OUTPUT.
CAMG CH,INCHEC
JRST RRLP2E
CALL RRMVC ;DISPLAYING ONLY PART OF A LINE: CHECKSUM MECHANISM WOULD LOSE,
SETOM HCDS(TT) ;SO DISABLE THE CHECKSUM MECHANISM TO FORCE OUTPUTTING.
SKIPN NOCEOL ;IF NOCEOL, THE FIRST DISLIN WILL CLEAR IT ANYWA.
CALL CLREOL
RRLP2E: REST RRVPOS
REST RRHPOS
REST PT
SETOM RROVPO ;WHEN WE STOP DISPLAYING, MUST REPOSITION PHYSICAL CURSOR.
CALL VBDOK3 ;DO THE DISPLAYING. ALL PREPARATIONS NECESSARY FOR VBDOK3
;SHOULD BE DONE BEFORE THE CALL TO RRLCHG.
CALL RRDIS2 ;INDICATE NOW REDISPLAY NOT NEEDED.
JRST RRLP5
;REDISPLAY CHANGES ENTIRELY WITHIN ONE LINE.
;IN CONTAINS THE CHAR ADDR AT WHICH CHANGES START. WE DON'T CLOBBER IN.
;SKIP IF WE SUCCEED IN BEING ABLE TO DO ANYTHING.
;OTHERWISE, NOTHING HAS BEEN DONE TO THE SCREEN
;AND THE MORE GENERAL TECHNIQUE MUST BE USED.
RRLCHG: MOVE BP,RRMNVP
MOVE T,RRMSNG ;DON'T ACT IF THE CHANGED LINE
CAML BP,T ; MIGHT NOT HAVE BEEN CORRECT ON THE SCREEN.
JUMPGE T,CPOPJ
MOVEM BP,RRVPOS
PUSH P,IN
MOVE T,LINEND(BP) ;IF LINE USED TO BE CONTINUED, GIVE UP.
CAMLE T,NHLNS ;WE CAN TELL BECAUSE ITS END HPOS WILL BE PAST THE ! COLUMN.
JRST RRLCHQ
SETZ D, ;D BECOMES NONZERO AFTER WE ENCOUNTER THE FIRST TAB.
SETO T,
RRLCH1: CAMN IN,RRMAXP ;WHEN WE REACH THE CHARACTER AT WHICH CHANGES STOP,
MOVE T,RRHPOS ;REMEMBER THE HPOS.
CAMLE T,RRHPOS ;IF ANYTHING PAST END OF CHANGES BACKSPACES AND OVERSTRIKES
JRST RRLCHQ ;WITH THE CHANGED STUFF, WE CAN'T WIN WITH I/D CHAR.
CALL RREOLT
JRST RRLCH2 ;WHEN WE REACH THE END OF THE LINE, WANT THE HPOS THERE TOO.
CALL RRFORW
JUMPL T,RRLCHC
CAIE CH,^I ;IF WE FIND A TAB AFTER THE END OF THE CHANGES,
JRST RRLCHC
JUMPL D,RRLCHC ;THEN WE MUST INCLUDE EVERYTHING UP THRU THE FIRST SUCH TAB
MOVEM IN,RRMAXP ;AS TEXT TO BE REDISPLAYED, AS IF IT HAD ALL BEEN CHANGED.
SETO D, ;SET D TO SAY WE HAVE FOUND ONE TAB SO MORE TABS NO TROUBLE.
;TEXT CONTAINING TABS CAN'T BE COUNTED ON TO MOVE RIGIDLY WHEN STUFF IS
;INSERTED OR DELETED BEFORE IT, UNLESS A TAB IMMEDIATELY PRECEDES IT.
RRLCHC: MOVE TT,RRVPOS
CAME TT,RRMNVP ;GIVE UP IF THE LINE IS CONTINUED.
JRST RRLCHQ
JRST RRLCH1
RRLCH2: JUMPL T,RRLCHQ ;IF HAVEN'T FOUND END OF CHANGES, A CRLF HAS BEEN INSERTED,
;SO GIVE UP. WE WIN ONLY IF THE LINE IS STILL ONE LINE.
MOVE A,RRHPOS ;GET CURRENT NEEDED END-HPOS OF TEXT FOLLOWING THE CHANGE.
MOVE BP,RRVPOS
SUB A,LINEND(BP) ;SUBTRACT OLD END-HPOS TO GET DISTANCE TO MOVE RIGHT.
;WE NOW HAVE GATHERED ALL THE INFORMATION.
;DECIDE WHETHER IT IS FASTER TO REWRITE ONLY PART OF THE LINE.
MOVE B,RRHPOS
SUB B,T ;GET NUMBER OF CHARS THAT WE COULD AVOID REPRINTING.
LSH B,-1 ;WE WIN IF THAT'S MORE THAN TWICE THE NUMBER OF
MOVM TT,A
CAMGE B,TT ;INSERTS OR DELETES WE MUST DO.
JRST RRLCHQ
SKIPN CID ;IF TERMINAL CAN'T DO INSERT OR DELETE CHARACTER,
JUMPN A,RRLCHQ ;WE WIN ONLY IN THE CASE THAT NONE ARE NECESSARY.
SKIPL A
SUB T,A ;GET MINIMUM OF DESIRED STARTING HPOS AND OLD STARTING HPOS.
CAMGE T,RRMNHP ;BUT CAN'T MOVE ANYTHING THAT DOES OR WILL OVERLAP
;WITH THE TEXT TO THE LEFT OF THE CHANGED AREA
JRST RRLCHQ ;(PATHOLOGICAL CASE OF INSERTING OR DELETING A BACKSPACE).
ADDM A,LINEND(BP)
MOVE TT,INCHCT ;IF PROCESSING A PRE-ECHOED CHANGE,
CAMG TT,INCHEC ;DON'T ACTUALLY OUTPUT ANYTHING.
JRST RRLCH7
MOVE TT,TTYOPT ;IF NO CHANGE IN NUMBER OF CHARS, AND NO OVERPRINTING,
TLNN TT,%TOOVR ;JUST MOVE CURSOR ONCE.
JUMPE A,RRLCH5
HRLZS BP
HRR BP,T
CALL SETCUR ;MOVE CURSOR THERE.
JUMPL A,RRLCH4
JUMPE A,RRLCH3
CALL INSCHR ;INSERT OR DELETE CHARACTERS, MOVING TEXT AFTER THE CHANGE
JRST RRLCH3 ;TO ITS DESIRED LOCATION.
RRLCH4: MOVMS A
CALL DELCHR
RRLCH3:
;; NOW, ON A TERMINAL THAT CAN OVERPRINT, WE MUST ERASE THE REMAINING CHANGED AREA.
;; WE CAN DO THAT BY BACKSPACING OVER THE AREA DOING %TDDLF'S.
;; ON A TERMINAL THAT CANNOT OVERPRINT, WE NEED ONLY MOVE THE CURSOR BACK TO THAT POINT.
;; THE CURRENT CURSOR HPOS IS IN T. THE DESIRED ONE IS IN RRMNHP.
MOVE TT,TTYOPT
TLNN TT,%TOOVR
JRST RRLCH5
RRLCH6: CAMN T,RRMNHP ;TILL WE BACK UP TO THE STARTING POSITION,
JRST RRLCH7
MOVEI CH,^H ;FOR EACH POSITION, DO ONE BACKSPACE AND ONE ERASE-CHAR.
CALL TYOINV
CALL ERSCHR
SOJA T,RRLCH6
RRLCH5: HRLZ BP,RRVPOS
HRR BP,RRMNHP ;GET POSITION OF START OF CHANGES.
CALL SETCUR
RRLCH7: MOVE IN,(P) ;GET RANGE CONTAINING NEW TEXT, AND TYPE IT OUT.
MOVE BP,RRVPOS
SAVE LINEND(BP)
SAVE LINBEG+1(BP) ;DISLIN WOULD WANT TO CLOBBER THESE!
RRLCH8: CAMN IN,RRMAXP
JRST RRLCH9
CALL GETINC
CALL DISAD
JRST RRLCH8
RRLCH9: SETZM LINEND(BP) ;PREVENT LINE-CLEARING ON NOCEOL TERMINALS.
SETCM TT,CHCTHC ;IF TTY CAN OVERPRINT, THEN WE HAVE ALREADY CLOBBERED
MOVE TT1,TTYOPT ;THE TEXT ON THE SCREEN EVEN IF WE DID NO I/D,
TLNE TT1,%TOOVR ;SO PREVENT A HASH MATCH FROM PREVENTING
MOVEM TT,HCDS(BP) ;THE LINE FROM BEING OUTPUT.
CALL DISFLS ;FORCE OUT WHAT WE HAVE SENT THROUGH DISAD.
SETOM TYOFLG
SETZM CHCTBP ;NOW SET UP FOR JUST COMPUTING HASH CODE, NOT OUTPUTTING.
AOS CHCTBP ;(MUSTN'T BE 0, OR CHCTHC WOULDN'T BE SET)
HLLOS DISBFC
MOVEI TT,CPOPJ
MOVEM TT,CHCTAD ;MAKE SURE DISLIN NOT CALLED, IN CASE STRAY CR OR BS.
RRLCHA: CALL RREOLT ;NOW FINISH "OUTPUTTING" UP TO THE END OF THE LINE,
JRST RRLCHB
CALL GETINC ;BUT SINCE CHCTAD IS A NO-OP NOTHING WILL COME OUT.
CALL DISAD ;HOWEVER, THE HASH CODE FOR THE LINE WILL BE CALCULATED.
JRST RRLCHA
RRLCHB: MOVE BP,RRVPOS
MOVE T,CHCTHC
MOVEM T,HCDS(BP) ;STORE THE NEW CORRECT HASH CODE.
REST LINBEG+1(BP)
REST LINEND(BP)
MOVE T,ZV
SUB T,RROLZV ;UPDATE LINBEGS OF ALL FOLLOWING LINES.
CALL RRINS3
SETZM RRMAXP ;NO CHANGES REMAIN TO BE DISPLAYED.
SKIPGE RRMSNG ;IF NO LINES ARE MISSING AT THE END, NO DISPLAY IS NEEDED.
CALL RRDIS2
SETZM RRMNHP ;OTHERWISE, START THINKING AT START OF LINE.
SETOM RROVPO ;WHEN WE STOP DISPLAYING, MUST REPOSITION PHYSICAL CURSOR.
AOS -1(P) ;WE HAVE WON - RETURN SKIPPING.
RRLCHQ: REST IN ;WE HAVE LOST - RETURN NON-SKIPPING.
RET
;TEST THE WINDOW FOR VALIDITY, ASSUMING RRVPOS IS CORRECT.
;MUCH FASTER THAN AN ACTUAL VBDBLS.
;CLOBBERS A, IN, TT, TT1.
RRWBLS: MOVE A,RRVPOS
SKIPN GEA
JRST RRWBL1
CAMGE A,RRTOPM ;CURSOR TOO NEAR TOP => NEW WINDOW.
RET
RRWBL1: MOVE TT,MORESW
TRNN TT,MS%DWN ;IF THERE'S STUFF PAST THE SCREEN BOTTOM,
JRST RRWBL2 ;WE DON'T WANT CURSOR TOO NEAR BOTTOM.
CAML A,RRBOTM
RET
RRWBL2: CAMGE A,BOTLIN ;IF CURSOR'S BELOW BOTTOM, WE MUST SHIFT THE WINDOW.
JRST POPJ1 ;ELSE, OLD WINDOW IS STILL GOOD.
MOVE IN,PT ;EXCEPTION: CURSOR AT FRONT OF --MORE-- LINE
CAMG A,BOTLIN ;AT END OF BUFFER AFTER A CRLF,
CAME IN,ZV ;IS CONSIDERED AT THE END, RATHER THAN BELOW IT.
RET
SUBI IN,2
CALL RREOLT ;SO CHECK FOR THE CRLF.
JRST POPJ1
RET
;COME HERE HAVING DETERMINED THAT A FULL SCREEN REDISPLAY IS NEEDED.
RRLP4: MOVE A,RRDISM ;DO FULL REDISPLAY, TESTING PREVIOUS WINDOW.
JUMPE A,RRLP5A
CALL RRMACR
SKIPL GEA ;ON RETURN, IS REDISPLAY STILL NEEDED OR WAS IT ALREADY DONE?
SKIPGE RRMAXP
JRST RRLP5A
SKIPGE PJATY ;IF SEEMS TO HAVE BEEN DONE, MAYBE WE SHOULDN'T DO IT.
SKIPL RRMSNG
CAIA
JRST RRLP6
RRLP5A: SETOM RROVPO ;WHEN WE STOP DISPLAYING, MUST REPOSITION PHYSICAL CURSOR.
.I RRERFL=ERRFL1
SETOM RRIDLB ;IN FULL REDISPLAY, NONE OF THE TEXT ALREADY ON THE SCREEN CAN BE REUSED.
CALL RRDISP ;NORMAL (VBD) DISPLAY, MAYBE CHANGING WINDOW.
CALL RRDIS2 ;REDISPLAY NOW NOT NEEDED,
SKIPL RRERFL ;UNLESS THIS REDISPLAY DIDN'T DISPLAY THE TOP LINE
JRST RRLP5
.I RRMNVP=TOPLIN ;(PRESERVING AN ERR MSG) IN WHICH CASE REDISPLAY AFTER NEXT CMD.
SETZM RRMNHP
.I RRMAXP=GEA+BEGV
RRLP5: .I RROLZV=ZV
AOSN RRNCCR ;IF CHAR BEFORE PT WAS A CR, RRHPOS WASN'T SET
;(DUE TO THE FACT THAT A CR ISN'T OUTPUT UNTIL THE
;NEXT CHAR IS SEEN)
CALL [ SOS PT ;HPOS AND VPOS ARE CORRECT FOR BEFORE
JRST RRFORW] ;THE CR, SO SPACE OVER IT.
MOVE A,RRHPOS ;DON'T LET THE CURSOR BE OVER THE "!"
CALL RRFOR3 ;OF A CONTINUATION.
RRLP3: MOVE T,MORESW
CALL DISMD ;REDISPLAY Q..J IF IT HAS CHANGED, NOT CHANGING --MORE-- STATUS.
SKIPE RGETTY
CALL RRMVC ;PUT THE HARDWARE CURSOR AT THE POINTER.
JRST RRLP1
RRDISX: MOVEI T,RRLP1 ;COME HERE TO QUIT DISPLAYING BECAUSE INPUT WAITING.
MOVE CH,DISPRR ;BP HAS VPOS OF LINE WE WOULD HAVE DISPLAYED NEXT
MOVEM T,(CH) ;PREVENT RRARGF FROM BEING CALLED.
;COME HERE IF STOP DISPLAYING SINCE KNOW NO MORE DISPLAY NEEDED.
;BP HAS VPOS OF LINE WE WOULD HAVE DISPLAYED NEXT (LAST LINE
;WITH VALID LINBEG).
RRDISF: MOVE P,DISPRR
MOVE T,ZV
SUB T,RROLZV
ADDM T,RROLZV
RRDISG: MOVE A,T ;NOW UPDATE THE LINBEG WORDS OF THE REMAINING SCREEN LINES.
AOS TT,BP
CAMLE TT,BOTLIN
.VALUE
JRST RRFXR1
RRDISP: SKIPN RGETTY
JRST RRDIS3
.I RRMNVP=TOPLIN ;IF DISPLAYING IS INTERRUPTED, MAKE
SETZM RRMNHP ;WE RESTART THE RIGHT WAY.
SETZM RRMSNG ;SAY WE CAN'T STOP DISPLAYING AT RRMAXP.
JRST VBDRR
RRDIS1: MOVE CH,CHCTHP ;CALL HERE WHEN CURSOR IS OUTPUT,
MOVEM CH,RRHPOS ;OR AT END OF BUFFER IF PT IS THERE.
MOVE CH,CHCTCF ;IF THE LAST CHAR WAS CR,
MOVEM CH,RRNCCR ;SAY WE DON'T KNOW CORRECT HPOS.
MOVE CH,CHCTVP
MOVEM CH,RRVPOS ;REMEMBER SCREEN POS. OF CURSOR.
POPJ P,
RRDIS2: SETZM RRMAXP ;HERE TO DECLARE THAT NO REDISPLAY IS NEEDED.
SETOM RRMSNG
HRLOI TT,377777
MOVEM TT,RRMNVP
MOVEM TT,RRMNHP
POPJ P,
;MOVE THE CURSOR TO THE PLACE SPECIFIED BY RRVPOS AND RRHPOS.
;ASSUMES THAT RROHPO, RROVPO HOLD CURRENT ACTUAL LOCATION OF CURSOR,
;OR -1 IF THE OLD POSITION IS NOT KNOWN. CLOBBERS Q.
RRMVC: MOVE Q,RRHPOS
SKIPN RGETTY
MOVEM Q,CHCTHP
SKIPE RGETTY
CAME Q,RROHPO ;IF NEITHER COORD NEEDS TO BE CHANGED,
JRST RRMVC1
MOVE Q,RRVPOS
CAMN Q,RROVPO
RET ;DON'T BOTHER TO DO ANYTHING.
RRMVC1: SAVE BP
HRRZ BP,RRHPOS
HRL BP,RRVPOS
HRRZM BP,RROHPOS
HLRZM BP,RROVPOS
MOVE Q,INCHCT ;IF "DISPLAYING" PRE-ECHOED INPUT,
CAMLE Q,INCHEC ;DON'T ACTUALLY OUTPUT ANYTHING.
CALL SETCUR
JRST POPBPJ
;HERE TO SEE IF ANY OF THE TEXT ON THE SCREEN, PAST ALL CHANGES WE MUST DISPLAY,
;CAN STILL BE USED IF WE CAN MOVE IT TO THE RIGHT LINE ON THE SCREEN
;(USING INSERT/DELETE LINE). SOMETIMES WE ACTUALLY MOVE THE TEXT AND BLT THE TABLES.
;USUALLY WE JUST SET RRIDVP TO THAT LINE'S VPOS AND RRIDLB TO ITS LINBEG WORD
;(RELOCATED TO CONTAIN A CURRENT ADDRESS RATHER THAN A HISTORICAL ONE).
;RRIDBK IS SET TO THE NUMBER OF BLANK LINES WHICH NOW PRECEDE THAT STILL-USEFUL LINE.
;IT IS USED IN RECOGNIZING WHERE THAT LINE IS GOING TO BE WANTED ON THE SCREEN
;AS SOON AS THE FIRST BLANK LINE IS REACHED IN TYPEOUT. THIS REDUCES WASTEFUL DISPLAY.
RRLID: CALL RRLID2 ;FIND THE TEXT TO BE PRESERVED, SET RRIDLB AND RRDVP.
RET ;NO SKIP MEANS NO TEXT ON SCREEN MAY BE PRESERVED.
MOVE BP,RRMNVP
MOVE TT1,RRIDLB
CAME TT1,LINBEG(BP) ;IF THAT TEXT OUGHT TO BE MOVED UP TO WHERE WE WILL START
RET ;DISPLAYING (IE, WE ARE DISPLAYING THAT SOME LINES WERE KILLED)
;DELETE LINES OF TEXT FROM C(BP) TO C(RRIDVP).
SOS BP
CALL DSLID ;MOVE THE STUFF UP, RIGHT NOW. BP HAS -1 PLUS LINE WE ARE "AT".
RET ;IF DSLID DECIDED TO ABORT, THAT'S OK.
SETZM RRMAXP ;ALL CHANGES ARE BEING HANDLED BY THE LINE-DELETE, SO THERE AREN'T ANY MORE.
;; OTHER PLACES JUMP TO RRLID5, AFTER CALLING DSLID TO MOVE TEXT UP, WITH VPOS-1 IN BP.
RRLID5: MOVE TT,RRIDLB ;MAKE LINBEG OF LINE MOVED UP BE RIGHT.
MOVEM TT,LINBEG+1(BP)
SKIPE RRMAXP ;IF BUFFER HAS CHANGES, DON'T TRY TO JUMP RRMNVP FORWARD,
RET
MOVE BP,RRMSNG ;NO CHANGES, SO RRMSNG GIVES FIRST VPOS THAT NEEDS REDISPLAY;
SOS BP ;BUT THE PREVIOUS LINE IS THE LAST ONE WHOSE LINBEG IS CORRECT,
CAMGE BP,RRMNVP ;SO START DISPLAYING THERE. NOTE RRMSNG CAN BE LESS THAN TOPLIN,
MOVE BP,RRMNVP ;BUT IN THAT CASE ITS VALUE IS NOT MEANINGFUL.
CAMN BP,[SETZ-1]
.VALUE ;RRMNVP SHOULD NOT BE INFINITY, HERE.
EXCH BP,RRMNVP
SETZM RRMNHP
MOVE CH,ZV
SUB CH,RROLZV ;NOW RELOCATE LINBEGS OF ALL LINES PAST OLD RRMNVP THRU NEW RRMNVP,
JUMPE CH,RRLID6 ;SINCE LINBEGS OF ALL LINES ABOVE RRMNVP ARE SUPPOSED TO BE
;Version 1112: changed to add to all LINBEGs, not just those above RRMNVP,
;and to add to RROLZV as well. This fixes the ugly display bug that used
;to happen when there were three ^D's in a row, deleting CRLFs, and twice
;display was pre-empted during the last call to DISLIN.
RRLID4: AOS BP ;CORRECT WITHOUT NEEDING RELOCATION.
CAML BP,BOTLIN ;ALSO RELOCATE THE REST, DOWN TO BOTLIN, AND UPDATE RROLZV
JRST RRLID6 ;SAYING NO RELOCATION NECESSARY. THAT'S CAUSE WE DON'T KNOW FOR
ADDM CH,LINBEG(BP) ;SURE WHERE RRMNVP WILL END UP.
JRST RRLID4
RRLID6: ADDM CH,RROLZV
MOVE CH,ZV ;DON'T LEAVE RRMNVP POINTING PAST THE END OF THE BUFFER.
RRLID7: MOVE BP,RRMNVP ;IF THE LINE IT POINTS AT IS AT OR AFTER THE END OF BUFFER,
CAMLE BP,TOPLIN ;MOVE IT BACK TO THE LINE THAT ACTUALLY FOLLOWS THE END.
CAME CH,LINBEG(BP) ;CHANGED FROM LINBEG-1(BP) SO DOESN'T LOSE ON A BUFFER
RET ;WHICH DOES NOT END WITH A CRLF.
SOS RRMNVP
JRST RRLID7
;DETERMINE WHETHER ANY OF THE LINES AT THE BOTTOM OF THE SCREEN CAN BE PRESERVED
;(PERHAPS MOVING THEM UP OR DOWN WITH INSERT/DELETE LINE).
;SKIP IF THERE ARE ANY, SETTING RRIDVP TO THE VPOS OF THE FIRST, AND RRIDLB
;TO THAT LINE'S LINBEG (UPDATED TO BE CORRECT WITH CURRENT ZV, RATHER THAN RROLZV).
RRLID2: SETOM RRIDLB
SETZM RRIDBK
MOVE OUT,RROLZV
SUB OUT,ZV ;COMPUTE ADDRESS BEYOND WHICH NO BUFFER CHANGES HAVE OCCURRED,
ADD OUT,RRMAXP ;RELOCATED TO MATCH OLD LINBEG WORDS.
MOVE BP,TOPLIN
RRLID1: CAMN BP,BOTLIN
RET ;REACH END OF WINDOW => NO EXISTING TEXT STILL GOOD. DON'T SET RRIDLB.
LDB TT1,[3300,,LINBEG(BP)]
CAMLE OUT,TT1 ;SEE WHICH LINE IS THE FIRST TO START AFTER THAT POINT.
AOJA BP,RRLID1
ADD TT1,ZV
SUB TT1,RROLZV
CAMN TT1,BEGV ;A LINE IS ACCEPTABLE ONLY IF ITS TEXT IS STILL AT THE FRONT OF A LINE.
JRST RRLID3 ;SO REQUIRE THAT IT BE AT FRONT OF BUFFER OR AFTER A CRLF.
MOVE IN,TT1
SUBI IN,2
CALL GETINC
CAIE CH,^M
AOJA BP,RRLID1 ;IF THIS LINE NOT GOOD FOR THIS REASON, NEXT LINE PROBABLY STILL GOOD.
CALL GETCHR
CAIE CH,^J
AOJA BP,RRLID1
RRLID3: MOVEM BP,RRIDVP ;RRIDVP POINTS AT 1ST LINE NOT INVALIDATED, OR AT BOTLIN IF ALL INVALID
MOVE TT1,LINBEG(BP)
ADD TT1,ZV ;GET ADDR OF BEGINNING OF TEXT THAT CAN BE SAVED IF MOVED UP OR DOWN,
SUB TT1,RROLZV ;RELOCATED TO BE THE CURRENT ADDRESS, NOT THE ADDR IT HAD
MOVE TT,TT1
TLZ TT,777000 ;DON'T TRY TO MOVE FOLLOWING TEXT IF IT IS NULL (IT STARTS AT Z).
CAMN TT,ZV
RET
MOVEM TT1,RRIDLB ;WHEN LAST DISPLAYED.
MOVE IN,TT
SETOM RRIDBK ;NOW HOW MANY BLANK LINES ARE THERE BEFORE THAT POINT?
RRLID8: SOS IN ;SCAN BACKWARDS COUNTING THEM AND PUT NUMBER IN RRIDBK.
CAMGE IN,BEGV ;IF REACH BEG OF BFR JUST BEFORE A CRLF, THEN EACH CRLF WE PASSED
JRST [ AOS RRIDBK ;COUNTS FOR ONE BLANK LINE.
JRST POPJ1]
CALL GETCHR
CAIE CH,^J ;OTHERWISE, THE LAST CRLF WE FIND IS REALLY THE END OF A NONBLANK LINE
JRST POPJ1 ;AND SHOULDN'T COUNT. TO ARRANGE THAT, WE START COUNTING AT -1.
CAMG IN,BEGV
JRST POPJ1
SOS IN
CALL GETCHR
CAIE CH,^M
JRST POPJ1
AOS RRIDBK
JRST RRLID8
SUBTTL PRINTING TERMINAL ^R DISPLAY
;DISPLAY CURRENT LINE AND PUT TTY CURSOR IN RIGHT PLACE, FOR PRINTING TTY SCAN MODE.
RRDIS3: SKIPN RRSCAN
RET
CALL RRBTCR
SETZM RRVPOS ;TYPE LINE UP TO POINT (0T)
SETZM RUBENC
CALL DISTOT
SETZ C,
CALL GETAG7 ;FIND RANGE (0F^@).
JFCL
.I GEA=E-BEGV
CALL TYPE2 ;TYPE IT.
TRO FF,FRCLN
MOVEI C,1
CALL GETAG7 ;NOW TYPE TO END OF LINE.
JFCL
CAMN C,E
RET
CALL TYPE2 ;AND BS OVER IT, SAYING MUST DO A LF IF WE ARE AT THE END OF THE LINE.
JRST RRTTY2
;HERE TO HANDLE CURSOR MOTION, ON PRINTING TERMINAL IN SCAN MODE.
RRTTY: SKIPN RRSCAN
JRST RRBTCR
TRNN FF,FRARG ;IF WE KNOW NOTHING ABOUT THIS OPERATION,
JRST [ SKIPE A,RRTTM1 ;DON'T DISPLAY (BUT LET USER'S HANDLER DISPLAY).
CALL RRMACR
JRST RRBTCR]
TRNE FF,FRARG2
JRST RRTTID ;JUMP IF IT'S AN INSERT/DELETE OPERATION.
MOVE CH,ECHCHR ;DON'T DO IT OUR WAY IF COMMAND HAS ALREADY TYPED OUT.
AOJE CH,CPOPJ
CALL RRMAC3
SKIPGE RRMNVP
RET
RRTTY1: SKIPN RGETTY ;HERE TO SCAN MOTION CAUSED BY BUILT-IN ^F, ETC.
SKIPN RRSCAN
RET
MOVE A,RRVPOS ;SHOW THE USER THE CURSOR MOTION IN SOME NICE WAY.
SUB A,RREVPS ;IF WE'RE ON THE SAME LINE, OR THE NEXT ONE,
JUMPL A,RRTTY5 ;OTHERWISE, LET USER HANDLE DISPLAY.
CAIL A,2 ;(OR JUST ECHO THE COMMAND, IF NO HANDLER).
JRST RRTTY5
MOVE C,PT
MOVE E,RREPT ;FORWARD HORIZONTAL MOTION => TYPE CHARS MOVED OVER.
RRTTY4: CAMGE E,C
JRST RRTTYF
CAMG E,C ;NO MOTION, EVEN, => STILL PREVENT ECHOING.
JRST RRTTY3
RRTTY2: SKIPE A,RUBENC ;NO NEED TO LF BETWEEN TWO BACKWARD MOTION CMDS.
CAIN A,^J ;ASIDE FROM THAT, IF LAST THING DONE WANTED STUFF TYPED,
CAIA ;TYPE IT.
CALL RUBEND
CALL RRMVC ;BUT IF BACKWARD MOTION, JUST MOVE BACK TO HPOS, BUT
MOVEI A,^J
SKIPN BSNOLF
MOVEM A,RUBENC ;MAKE SURE WE TYPE A LF BEFORE TYPING ANYTHING ON THIS LINE.
RRTTY3: SETOM ECHCHR ;MAKE THIS COMMAND NOT BE ECHOED.
RET
RRTTYF: SAVE DISPCR ;HERE TO SCAN FORWARD MOTION: TYPE CHARS MOVED OVER,
SETOM DISPCR ;WITH FS ^M PRINT$ SET TO -1 SO THAT STRAY CR AND LF
CALL TYPE2 ;COME OUT AS THEMSELVES.
REST DISPCR
RET
RRTTY5: MOVE C,RREPT
MOVEM C,NUM
SKIPE A,RRTTM1 ;MOTION TOO FAR TO JUST ECHO OR BACK UP;
JRST RRMAC6 ;CALL THE USER'S MACRO TO HANDLE IT,
RET ;OR DO NOTHING (AND COMMAND WILL ECHO).
;COME HERE AFTER A COMMAND. IF IN SCAN MODE ON PRINTING TTY, AND COMMAND DIDN'T
;TYPE ANYTHING, ECHO IT (BY TYPING THE CHAR OR STRING IN FS ECHO CHAR$).
RRTTYE: MOVE CH,ECHCHR
CAME CH,[-1]
SKIPE RGETTY
RET
SKIPGE GEA ;DON'T ECHO A ^L OR SIMILAR CHAR.
RET
SKIPE RRSCAN
SKIPN RRLAST ;DON'T ECHO ARG-SETTING COMMANDS.
RET
CAIL CH,
CALL TYINRM ;IF IT'S A CHAR (NOT A STRING) CONVERT TO 7-BIT.
JRST FSECO1
RUBEND: SAVE CH ;AND IF THERE'S ANYTHING TO TYPE (SUCH AS LF AFTER
SKIPE CH,RUBENC ;BACKWARD MOTION IN ^R MODE), TYPE IT.
CALL FSECOR
SETZM RUBENC
JRST POPCHJ
;COME HERE TO HANDLE A COMMAND THAT RETURNED 2 VALUES, ON A PRINTING TTY IN SCAN MODE.
RRTTID: MOVE CH,ECHCHR ;DON'T HACK REDISPLAY IF COMMAND TYPED SOMETHING.
AOJE CH,RRBTCR
MOVE C,NUM
MOVE E,SARG
CAML E,C
EXCH C,E
CALL GETANU ;E, C GET THE CHAR ADDRS OF START AND END OF CHANGED RANGE.
CAME C,PT ;WE DON'T KNOW HOW TO HANDLE IT UNLESS POINT WAS PUT AT END.
JRST RRTTI2
.I C-E
CAML TT,RRTTMX ;IS SIZE OF RANGE CHANGED BELOW THRESHHOLD?
JRST RRTTI2 ;TOO MANY CHANGES => DON'T PRINT THEM.
CAMN E,RREPT ;DID CHANGES START AT THE OLD POINT?
JRST RRTTI1
SAVE C ;IF NOT, MOVE BACK TO WHERE CHANGES STARTED.
SAVE E
SAVE PT
MOVEM E,PT ;MOVE RRVPOS, RRHPOS TO THE POSITION OF THAT PLACE.
CALL RRMAC3
REST PT ;BUT DON'T REALLY SET PT THERE.
MOVE C,(P)
MOVE E,RREPT ;NOW "MOVE BACK" THERE "FROM" WHERE PT USED TO BE.
CALL RRTTY4
REST E
REST C
RRTTI1: CALL RRBTCR
CAME E,C ;NOW TYPE ALL THE NEW TEXT, LEAVING CURSOR AT POINT
JRST RRTTYF ;SINCE POINT IS WHERE THE NEW TEXT ENDS.
RET
;IF WE CAN'T HANDLE THIS INSERT OR DELETE, EITHER BECAUSE IT'S TOO LONG,
;OR BECAUSE POINT IS NOT AT THE END OF IT, CALL USER'S HANDLER
;PASSING TWO ARGUMENTS (A RANGE OF THE BUFFER).
RRTTI2: TRO FF,FRARG+FRARG2
CALL RRMAC7
JRST RRBTCR
SUBTTL ^R COMMAND DISPATCH
;COME HERE TO HANDLE INPUT (NO DISPLAY NEEDED OR INPUT KNOWN TO BE WAITING).
RRLP1: TLNE FF,FLNOIN ;IF WE'RE DOING AN @V, RETURN
CALL RREXIT ;(DOESN'T COME BACK) AFTER DISPLAYING ONCE.
IFN ITS,CALL RRSYNC
IFN <ITS + <20X*TEXTIF>>,[ ;[wew] TOPS20 NOW DOES SMART TEXTI, MAYBE
CALL RRECIN ;HAVE SYSTEM ECHO AND INSERT PRINTING CHARACTERS, MAYBE
]; ITS + TNX*TEXTIF
IFE <20X*TEXTIF>,CALL TYIW0 ;READ A CHARACTER
IFN <20X*TEXTIF>,CALL TYIWTX ;[wew] READ A CHARACTER
CAIN CH,TOP+"H ;IGNORE "HELP" (FS HELPMAC$ ALREADY RUN, IF
;APPROPRIATE),
JRST RRLP ;BUT DO GO TO RRLP SO SPACE WILL FLUSH HELPMAC'S TYPEOUT.
ANDI CH,777
MOVEM CH,$Q..0 ;PUT CHAR WHERE USER MACRO DEFINITION CAN FIND IT.
MOVEM CH,RRLAST ;ALSO PUT IT IN FS ^R LAST$.
MOVEM CH,ECHCHR ;FOR PRINTING TTY, REMEMBER WHICH CHAR TO ECHO.
SKIPN RGETTY
SKIPE RRECHO ;DECIDE WHETHER TO ECHO ^R INPUT.
SKIPGE RRECHO
CALL [CALL TYINRM ;MUST NORMALIZE CHARACTER BEFORE OUTPUTTING,
JRST FSECO1]
MOVE CH,$Q..0 ;(IN CASE WE CALLED TYINRM).
SAVE [RRLP]
CALL RRARGD ;PUT VALUE OF COMMAND'S ARG IN C.
RRLP7: CALL RRLEA2 ;NOW SET UP "RRE" VARS IN CASE RRTTY CALLED AFTER CMD.
MOVE TT,QRB..
SETZM .QVWFL(TT) ;COMMAND WILL SET ..H TO SAY ^R SHOULD WAIT BEFORE DISPLAYING.
CAMN CH,CASSFT ;F$ CASE CTL CHRS DON'T HAVE FIXED VALUES.
JRST RRSFT
CAMN CH,CASLOK ;SO THE DISPATCH TABLE CAN'T CHECK FOR THEM.
JRST RRLOK
CALL RRCASC ;IF IN F$ MODE, DO CASE CONVERSION.
TRNN CH,META
JRST RRLP7I
TRNE CH,CONTRL ;META NON-CONTROL CHARACTERS ALL SELF-INSERT
JRST RRLP7J
SKIPLE RRRPLC ;IF IN FS ^R REPLACE$ > 0 MODE.
JRST RRXINS
RRLP7J: TRNE CH,CONTRL ;CONTROL-META LETTERS SELF INSERT IF FS CTLMTA$ NEGATIVE.
TRNN CH,100
JRST RRLP7I
SKIPGE RRCMQT
JRST RRXINS
RRLP7I:
;"INDIRECT" (RRINDR) DEFINITIONS LOOP BACK HERE.
RRIND1: MOVE E,RRMACT(CH) ;GET CURRENT DEFINITION OF CHARACTER.
SKIPL RRALQT ;UNLESS DEFINITIONS ARE SUPPRESSED,
SKIPGE RRUNQT
JRST RRLP7D ;USE THE DEFINITION
CAME CH,RRALQT ;ELSE IF THIS IS NOT THE UNQUOTING CHAR,
JRST RRLP7B ;MAKE IT SELF-INSERTING.
SETOM RRUNQT ;IF IT IS, REENABLE DEFINITIONS FOR 1 COMMAND.
SETZM RRLAST ;DON'T FLUSH NEXT COMMAND'S ARGUMENT.
RET
;DEFINITION OF "NORMAL SELF-INSERTING" CHARACTERS.
RRXINS: SKIP
SKIPN E,RRXINV ;GET THE DEFINITION INTENDED FOR SUCH CHARACTERS
MOVE E,[RRDINS,,RRREPI] ;OR THE DEFAULT DEFINITION,
SAVE C
SAVE CH
CALL RRLP7D ;AND RUN IT.
TRNE FF,FRARG
AOS -2(P)
CALL SKNBCP ;IF THE CHARACTER HAS THE LISP SYNTAX OF CLOSEPAREN,
REST A
REST C
JUMPE C,RRXIN1 ;AND OUR ARGUMENT WAS NOT ZERO,
ILDB CH,SKNBPT
SKIPE RGETTY
SKIPN A,RRPARN
JRST RRXIN1
CAIN CH,")
CALL RRMACR ;THEN RUN THE CLOSEPAREN MATCHING MACRO.
JFCL
RRXIN1: SETZ A,
RET
;HANDLE A CHARACTER IN SUPPRESS MODE.
RRLP7B: JUMPL E,RRLP7E ;IF ITS DEF. IS A MACRO, SEE WHETHER IT STARTS WITH "W".
MOVEI A,(E)
CAIE A,RRINDR
CAIN CH,177
JRST RRLP7D ;RUBOUT WORKS EVEN IN SUPPRESS MODE.
RRLP7F: CAIN CH,CONTRL+"M ;OTHER CHARS BECOME SELF-INSERTING.
SKIPA E,[RRCRLF,,RRREPT]
JRST RRXINS
RRLP7D: SKIPGE A,E ;COME HERE TO USE WHATEVER DEFINITION IS IN E.
JRST RRMAC0 ;EITHER A MACRO OR A BUILT-IN FUNCTION.
RRLP7H: TRZ FF,FRCLN\FRUPRW
LDB A,[331100,,(E)] ;BUILT-INS MUST START WITH A "SKIP" (THAT DOESN'T SKIP EVER).
IFN ITS,CAIE A,.BREAK_-33 ;DON'T BE CONFUSED BY BREAKPOINTS.
IFN TNX,CAIE A,JSYS_-33 ;BPT MAYBE?
CAIN A,SKIP_-33
JRST (E)
TYPRE [M%R]
RRLP7E: MOVE A,E ;MACRO-CHAR. TYPED IN SUPPRESS MODE.
CALL QLGET1
JRST RRLP7F
ILDB TT,BP ;WHAT IS ITS 1ST CHARACTER?
CAIE TT,"W+40
CAIN TT,"W ;IF IT DOESN'T START WITH A "W" THEN THE DEFINITION IS SUPPRESSED.
JUMPG B,RRLP7D ;IF IT STARTS WITH "W", THEN EXECUTE DEFINITION EVEN IN SUPPRESS MODE.
JRST RRLP7F
;TELL THE TERMINAL WHEN (AND HOW) TO DO LOCAL EDITING.
IFN ITS,[
RRSYNC: SKIPN LEDEFS ;IF FS LEDEFS IS CLEARED, IMMEDIATELY STOP
;USING LEP.
RET
SKIPE INCHSY ;IF TERMINAL IS DOING SYNCHRONIZATION,
SKIPN MODIFF ;AND BUFFER ALREADY MODIFIED SO NO NEED TO
;WRITE A STAR,
JRST RRSYNX
SKIPGE UNRCHC ;AND THERE IS NO INTERNALLY GENERATED INPUT
SKIPE TYISRC ;AVAILABLE
RET
SKIPE JRNIN
SKIPE JRNINH
CAIA
RET
MOVE CH,INCHCT ;BUT THE LAST INPUT CHARACTER WAS NOT PRE-ECHOED,
CAMG CH,INCHEC
RET
SUBI CH,210.
CAML CH,INCHSY ;AND THE LAST RESYNCH WE RECEIVED WAS RECENT ENOUGH
JRST RRSYNX ;(OTHERWISE WE SHOULD ASK FOR A NEW ONE),
.STATUS CHTTYI,CH ;AND THERE IS NO TTY INPUT AVAILABLE,
ANDI CH,2000
JUMPE CH,CPOPJ
;OK, WE CAN REQUEST LOCAL ECHO NOW.
;FIRST, TELL TERMINAL ABOUT ANY COMMANDS THAT HAVE BEEN REDEFINED.
RRSYN0: MOVE C,LEDEFS
TRO FF,FRARG
CALL FDATTY
.VALUE
JUMPL A,CPOPJ ;VALUE IS A NUMBER. GIVE UP.
CAIE A,1
JRST [ MOVE A,LEDEFS ;VALUE IS A STRING. EXECUTE IT AND LOOK AGAIN.
CALL RRMAC0 ;THE STRING SHOULD SET LEDEFS TO A QVECTOR.
JFCL
JRST RRSYN0]
MOVE C,LEDEFS
CALL QBGET ;IT'S A QVECTOR. FIND ITS DATA.
MOVE IN,MFBEG(B) ;GET STARTING AND ENDING WORD ADDRESS
TLZ IN,777700
IDIVI IN,5 ;IN IN AND OUT.
MOVE OUT,MFZ(B)
IDIVI OUT,5
SKIPL LEINIT ;IF MUST REINIT EVERYTHING, SEND COMMAND TO DO SO.
JRST RRSYN6
.IOT CHSIO,[%TDEDF]
.IOT CHSIO,[33_2] ;THEN, INSTEAD OF SENDING FOR ALL CHANGED CHARS,
.IOT CHSIO,[0] ;SEND ALL CHARS WHOSE DEFNS ARE NOT IN THE INITIAL STATE.
SETZM WRDMSK ;SET WRDMSK TO REFLECT WHAT THE TERMINAL WILL DO TO IT
MOVE A,[<1777_26.>_-20] ;AFTER IT RECEIVES THAT %TDEDF TO RESET EVERYTHING.
MOVEM A,WRDMSK+1 ;THAT IS TO SAY, JUST DIGITS AND LETTERS GO IN WORDS.
MOVE A,[377777,,777000]
MOVEM A,WRDMSK+2
MOVEM A,WRDMSK+3
MOVEI A,1 ;RESETTING TERMINAL PUTS IT INTO INSERT MODE.
MOVEM A,INSMOD
SETZM TBOTMAR
;NOW SEND OUT DEFINITIONS FOR ALL COMMAND CHARS
;WHICH EITHER 1) HAVE CHANGED (IF THIS IS NOT THE FIRST RESYNCH REPLY)
;OR 2) DON'T MATCH THE STANDARD INITIAL DEFINITIONS (IF THIS IS THE FIRST TIME).
RRSYN6: CALL SKNBCP ;SET UP SKNBPT TO LDB LISP SYNTAXES.
IBP SKNBPT
SETZ A, ;A COUNTS CHAR WE ARE CONSIDERING.
MOVE B,[040100,,RDFMSK-1] ;B IS BP TO FETCH FROM RDFMSK.
RRSYN1: TRNN A,37
SUB B,[040000,,] ;DON'T USE LOW 4 BITS OF EACH RDFMSK WORD.
ILDB C,B
SKIPL LEINIT ;OR ARE WE REINITIALIZING?
JUMPE C,RRSYN2 ;OR HAS THIS CHAR BEEN REDEFINED?
MOVE CH,RRMACT(A) ;GET THE NEW DEFINITION AND LOOK IT UP IN LEDEFS.
MOVE Q,IN
RRSYN4: CAML Q,OUT
JRST [ SETZ CH, ;DEFN IS NOT LISTED - USE FUNCTION CODE 0
JRST RRSYN3] ;(NO LOCAL EDITING POSSIBLE).
CAME CH,(Q)
AOJA Q,[AOJA Q,RRSYN4]
MOVE CH,1(Q) ;WE FOUND IT - GET CORRESP %TDEDF FUNCTION CODE.
LDB C,[0700,,A]
LDB D,SKNBPT
CAIN D,") ;CLOSEPAREN CHARS CAN'T BE HANDLED LOCALLY
SKIPN RRPARN ;IF THEY ARE SUPPOSED TO DISPLAY WHAT THEY MATCH.
CAIA
JRST RRSYND
CAIE C,177 ;IF IT'S A RUBOUT
CAIGE C,40 ;OR A CONTROL CHAR, DON'T ALLOW SELF-INSERT
CAIN C,33 ;UNLESS IT'S AN ALTMODE.
JRST RRSYN3
RRSYND: CAIN CH,7 ;REPLACE SELF-INSERTING WITH "NO LOCAL HANDLING".
SETZ CH,
RRSYN3: SKIPL LEINIT ;IF WE ARE REPORTING INCREMENTAL CHANGES,
JRST RRSYN5 ;CERTAINLY REPORT THIS CHAR -- IT CHANGED.
MOVEI Q,7
CAIL A,40 ;IF WE ARE REINITIALIZING, REPORT CHAR
CAIL A,177 ;ONLY IF ITS STATE DOES NOT MATCH THE INITIAL ONE.
SETZ Q,
CAIL C,"0 ;DIGITS WITH CONTROL OR META ARE ARG-SPECIFIERS.
CAILE C,"9
JRST RRSYNA
TRNE A,600 ;BUT NOT PLAIN DIGITS.
MOVEI Q,27
RRSYNA: CAIL C,"a ;LOWER CASE LETTERS, PLUS ANY CONTROL/META BITS,
CAILE C,"z ;ARE DEFINED AS EQUIVALENCES IN THE INITIAL STATE.
CAIA
MOVEI Q,22
CAMN CH,Q
JRST RRSYN2
RRSYN5: LSH CH,9
ADD CH,A ;MERGE CHARACTER AND FUNCTION CODE TOGETHER,
LDB Q,[070700,,CH] ;MAKE TWO 7-BIT BYTES, AND SEND A %TDEDF.
ANDI CH,177
.IOT CHSIO,[%TDEDF]
.IOT CHSIO,Q
.IOT CHSIO,CH
RRSYN2: CAIE A,777 ;CONSIDER NEXT CHARACTER.
AOJA A,RRSYN1
SETZM RDFMSK ;ALL NEW DEFINITIONS REPORTED; SO
MOVE A,[RDFMSK,,RDFMSK+1] ;MARK ALL CHARS AS UP-TO-DATE.
BLT A,RDFMSK+17
;NOW TELL THE TERMINAL ANY WORD SYNTAXES THAT HAVE CHANGED
;FROM THE PREVIOUS SETTING OR THE INITIAL SETTING.
CALL SKNBCP ;SET UP SKNBPT TO LDB WORD SYNTAXES.
SETZ A,
MOVE IN,[040100,,WRDMSK-1]
RRSYN7: TRNN A,37 ;SKIP OVER BOTTOM 4 BITS IN EACH WRDMSK WORD.
SUB IN,[040000,,]
LDB B,SKNBPT ;GET WORD SYNTAX OF NEXT CHAR.
SETZ C, ;CONVERT TO 1 IF PART OF WORD, 0 IF SEPARATOR, IN C.
CAIN B,"A
MOVEI C,1
ILDB CH,IN ;GET TERMINAL'S IDEA OF WORD SYNTAX,
DPB C,IN ;RECORD NEW SYNTAX.
CAMN C,CH ;IF THEY DON'T MATCH, TELL THE TERMINAL.
JRST RRSYN8
.IOT CHSIO,[%TDEDF]
ADDI C,31_2
.IOT CHSIO,C
.IOT CHSIO,A
RRSYN8: CAIE A,177
AOJA A,RRSYN7
;NOW TELL THE TERMINAL WHETHER WE ARE IN INSERT MODE,
;IF IT HAS CHANGED.
MOVEI A,2
SKIPN RRRPLC
MOVEI A,1
SKIPE RRXINV ;IF FS ^R NORMAL IS NONZERO,
SETZ A, ;"SELF-INSERTING" CHARACTERS CAN'T BE HANDLED BY TERMINAL.
EXCH A,INSMOD
CAMN A,INSMOD
JRST RRSYN9
.IOT CHSIO,[%TDEDF]
.IOT CHSIO,[32_2]
.IOT CHSIO,INSMOD
RRSYN9: MOVE A,NVLNS
SUB A,BOTLIN
EXCH A,TBOTMAR
CAMN A,TBOTMAR
JRST RRSYNB
.IOT CHSIO,[%TDEDF] ;TELL THE TERMINAL HOW MANY LINES AT SCREEN
.IOT CHSIO,[34_2+3] ;BOTTOM ARE NOT BEING USED FOR EDITING.
.IOT CHSIO,TBOTMAR
RRSYNB:
;NOW TERMINAL KNOWS THE RIGHT COMMANDS; TELL IT TO START LOCAL EDITING.
.IOT CHSIO,[%TDSYN] ;OUTPUT A SYNCH MARKER AND SAY HOW MANY
.IOT CHSIO,INSYNC ;CHARS OF INPUT WE HAVE READ SINCE
MOVE CH,INCHCT ;WE RECEIVED THE REQUEST FOR ONE.
SUB CH,INCHSY
.IOT CHSIO,CH
SETZM LEINIT ;WE HAVE FINISHED REINITTING (IF WE WERE).
RET
RRSYNX: SETZM INCHSY ;IF NO RECENT RESYNCH, FORGET ALL RESYNCHS,
SETOM INCHEC ;CERTAINLY NOT PROCESSING PRE-ECHOED CHARS ANY MORE.
SETOM LEINIT ;IF WE GET SYNCHED AGAIN, MUST RE-INIT ALL CHAR DEFNS.
MOVE CH,TTYSMT
TRNN CH,%TRLED ;BUT IF THE TERMINAL HAS THE CAPABILITY,
RET ;ASK FOR A RESYNCH.
MOVE CH,INCHCT
CAMG CH,INCHRQ ;BUT DON'T ASK TOO OFTEN!
RET
ADDI CH,1000. ;NO MORE THAN EVERY 1000 CHARS.
MOVEM CH,INCHRQ
.IOT CHSIO,[%TDECO]
SYSCAL SCPOS,[%CLIMM,,CHTTYI ? %CLBIT,,1]
.LOSE %LSFIL ;TELL ITS TO ALLOW TOP-E AND TOP=S THROUGH AS INPUT.
RET
]
SUBTTL ^R CHARACTER FORWARD/BACKWARD
;^B - MOVE BACKWARDS ONE CHARACTER.
;UPDATES RRHPOS AND RRVPOS. LEAVES THE CHAR MOVED OVER IN CH.
;LEAVES PT IN IN. CLOBBERS OUT, TT, TT1, A, B, C.
RRBACK: MOVE IN,BEGV ;ERROR IF AT BEGINNING OF BUFFER.
CAML IN,PT
JRST RRERR
RRBAC4: SOS IN,PT ;GET THE CHAR BEFORE THE PTR
CALL GETCHR
RRBAC0: RRCHRG ;GET CHAR'S DISPATCH TYPE CODE IN A. CLOBBERS B.
XCT RRBACT(A)
RRBAC1: SOS A,RRHPOS
JUMPGE A,CPOPJ
RRBAC3: ADD A,NHLNS ;MOVED OVER LINE-CONTINUATION.
MOVEM A,RRHPOS ;GO BACK TO PREV. LINE'S END.
RRBACV: SOS RRVPOS
POPJ P,
RRBACT: SOSA A,RRHPOS ;ORD. CHAR., BACK 1 POS.
JRST RRBACC ;NON-FORMATTING CONTROL CHARS.
JRST RRBACH ;^H, CHECK ^HPRINT FLAG.
JRST RRBACR ;^M, SPECIAL.
JRST RRBACL ;^J, UP 1 LINE.
SAVE [RRBTCR] ;TAB, COMPUTE RRHPOS BY MOVING FWD
;FROM PREVIOUS CR.
JRST RRBAC2 ;2-POS CTL CHARS NO AFFECTED BY FS SAIL (^P AND ^C).
RRBACR: ADDI IN,1 ;CR: IS IT FOLLOWED BY LF?
CALL GETCHR
MOVEI A,(CH)
MOVEI CH,^M
CAMGE IN,ZV
CAIE A,^J ;IF THIS CR REALLY CAME OUT AS CR,
SKIPGE DISPCR
JRST RRBTCR ;COMPUTE HPOS THE HARD WAY.
SUBI IN,1
RRBAC2: SOS RRHPOS ;IF IT CAME OUT AS UPARROW-M,
JRST RRBAC1 ;TREAT AS 2-POS CTL CHAR.
RRBACL: SUBI IN,1 ;LF: SEE IF PREV. CHAR IS CR.
CALL GETINC
MOVEI A,(CH)
MOVEI CH,^J
CAML IN,BEGV
CAIE A,^M ;BASED ON THAT AND ON DISPCR, DECIDE HOW LF WAS PRINTED OUT.
SKIPGE DISPCR
JRST RRBACV
JRST RRBAC2
RRBACH: SKIPL DISPBS ;MOVE BACK OVER ^H - IF IT CAME OUT AS
JRST RRBACC ;UPARROW-H, TREAT AS ORDINARY CTL CHAR.
MOVE A,RRHPOS ;ELSE, IF WE KNOW IT CAME OUT AS A BACKSPACE, IT'S SIMPLE.
CAIG A,2
JRST RRBTCR ;NEAR MARGIN, WE CAN'T BE SURE, SO MUST SCAN FORWARD.
AOS RRHPOS
RET
;NON-FORMATTING CONTROL CHARS, CHECK SAIL FLAG.
RRBACC: SKIPN DISSAI
JRST RRBAC2 ;NORMALLY, MOVE BACK 2 POS.
JRST RRBAC1 ;IN SAIL MODE, MOVE 1 POS.
;^F -- MOVE FWD 1 CHAR. SEE THE COMMENTS BEFORE RRBACK.
RRFORW: MOVE IN,PT ;ERROR IF AT END OF BUFFER.
CAML IN,ZV
JRST RRERR
CALL GETINC
RRFOR0: AOS PT
RRCHRG
XCT RRFORT(A) ;DISPATCH ON TYPE OF CHAR.
RRFOR1: AOS A,RRHPOS
RRFOR3: CAMGE A,NHLNS ;HAVE WE MOVED PAST RIGHT MARGIN?
POPJ P,
CAMN A,NHLNS ;CHECK FOR JUST REACHING THE RIGHT MARGIN.
JRST [ SAVE CH ;IF REACH RIGHT MARGIN, MUST
MOVE IN,PT ;CONTINUE PROVIDED WE'RE NOT AT
CALL RREOLT ;THE END OF THE LINE.
JRST POPCHJ ;AT END OF LINE, NOTHING TO DO.
REST CH ;NOT AT EOL, CONTINUE.
MOVE A,RRHPOS
JRST .+1]
SUB A,NHLNS
MOVEM A,RRHPOS
RRFORV: AOS RRVPOS
POPJ P,
RRFORT: AOSA A,RRHPOS ;ORDINARY CHAR, MOVE FWD 1 POS.
JRST RRFORC ;NON-FORMATTING CONTROLS.
JRST RRFORH ;MOVE FWD OVER ^H - CHECK ^HPRINT FLAG.
JRST RRFWCR ;^M, SPECIAL.
JRST RRFORL ;^J, DOWN 1 LINE.
JRST RRFOTB ;^I
JRST RRFOR2 ;2-POS CTL CHRS NOT AFFECTED BY FS SAIL (^P AND ^C).
RRFOTB: MOVE TT,RRHPOS
MOVE A,TT
CAMN TT,NHLNS
SETZ A,
ADD A,TABWID
IDIV A,TABWID
IMUL A,TABWID ;A GETS POSITION OF NEXT TAB STOP.
CAMLE A,NHLNS ;BUT IF THAT'S OFF THE SCREEN, TAB STOP IS RIGHT MARGIN
MOVE A,NHLNS
CAMN TT,NHLNS ;IF WE STARTED AT THE MARGIN, TREAT MARGIN AS COLUMN 0.
ADD A,NHLNS
MOVEM A,RRHPOS
JRST RRFOR3
RRFWCR: SKIPGE DISPCR
JRST RRFWC1
CALL GETCHR ;CR - SEE IF NEXT CHAR IS LF.
MOVEI A,(CH)
MOVEI CH,^M ;MAKE SURE WE RETURN CHAR BEING PASSED IN CH.
CAMGE IN,ZV
CAIE A,^J
JRST RRFOR2 ;NO, CR CAME OUT AS UPARROW-M
RRFWC1: SETOM RRHPOS ;(RRHPOS WILL BE AOS'D TO 0)
JRST RRFOR1
RRFORL: SKIPGE DISPCR ;LF: BASED ON WHETHER A CR PRECEDES IT AND ON DISPCR,
JRST RRFORV
SUBI IN,2
CALL GETCHR ;DECIDE HOW THE LF CAME OUT AND THEREFORE
MOVEI A,(CH)
MOVEI CH,^J
MOVE TT,IN
ADDI IN,2
CAML TT,BEGV
CAIE A,^M ;HOW TO MOVE OVER IT.
JRST RRFOR2
JRST RRFORV
RRFORH: SKIPGE DISPBS ;MOVING FWD OVER ^H -IF CAME OUT AS
SKIPN RRHPOS
JRST RRFORC
JRST RRBAC1 ;REAL ^H, MOVE BACK 1 POS
;NON-FORMATTING CONTROLS, CHECK FS SAIL FLAG.
RRFORC: SKIPE DISSAI ;IN SAIL MODE, THEY'RE 1-POS GRAPHICS.
JRST RRFOR1
RRFOR2: AOS RRHPOS ;ELSE TREAT AS 2-POS CTL CHAR.
JRST RRFOR1
;MAKE SURE RRHPOS IS CORRECT BY MOVING BACK TO THE LAST CR THAT
;REALLY CAME OUT AS A CR, AND MOVING FORWARD AGAIN. PT IS UNCHANGED.
;THE LARGEST HPOS THAT OCCURS ON THE LINE UP TO PT IS RETURNED IN OUT.
;PT IS RETURNED IN IN. CLOBBERS TT, TT1.
;A CONTAINS ADDR OF THE CR WE WENT BACK TO (+1), AND B HAS VPOS DIFFERENCE FROM THERE.
RRBTCR: SAVE CH
SAVE RRVPOS ;VPOS WILL BE ALTERED WHILE WE MOVE FWD
;BUT WE REALLY DON'T WANT IT CHANGED.
RRBTC5: SAVE PT ;REMEMBER WHERE TO STOP WHEN MOVE FWD AGAIN.
MOVE A,GEA ;1ST, FIGURE OUT WHERE TO STOP MOVING BACKWARD
ADD A,BEGV ;IF WE DON'T FIND A CR. 1ST CHAR ON SCREEN
;IS ONE PLACE. BEGINNING OF BFR IS ANOTHER.
SKIPL GEA
CAMLE A,PT ;(AT BOTH PLACES, HPOS MUST BE 0)
MOVE A,BEGV ;USE WHICHEVER WE'LL REACH SOONER.
MOVE B,PT ;STOP IN ANY CASE AFTER MOVING BACK 10000 CHARS.
SUBI B,10000. ;AT THAT POINT, BETTER TO CHOOSE A NEW WINDOW AND START OVER!
CAMG B,A ;NOW B GETS WHICHEVER OF THOSE TWO STOPPING POINTS IS REACHED FIRST.
MOVE B,A
SETZ OUT, ;ON 1ST PASS OUT=-1 => AN LF HAS BEEN PASSED GOING BACKWARDS.
RRBTC0: MOVE IN,PT
CAMG IN,B ;REACHED A STOPPING POINT => WHICH KIND?
JRST [ CAMN B,A ;A LEGITIMATE ONE (BEG OR TOP OF SCREEN) =>
JRST RRBTC1 ;WE CAN JUST SCAN FORWARD FROM THERE.
REST PT
CALL [ CALL SAVACS
SETO A,
CALL VBDBLS ;ELSE, COMPUTE A NEW TOP OF SCREEN
JRST RSTACS]
JRST RRBTC5] ;AND TRY AGAIN.
SOS IN,PT
CALL GETINC ;ELSE, KEEP GOING BACK.
CAIN CH,^J
SETO OUT, ;REACHED LF => SAY NOT ON LINE WE STARTED ON.
CAIE CH,^M ;REACHED CR => SEE WHETHER IT CAME OUT AS ONE.
JRST RRBTC0
JUMPE OUT,RRBTC0 ;BUT DON'T STOP AT ANY CR IF WE HAVEN'T GONE UP AT LEAST ONE LINE.
SKIPGE DISPCR
JRST RRBTC4
CALL GETCHR
CAIE CH,^J
JRST RRBTC0
AOS PT ;START AFTER THE CR AND THE LF.
RRBTC4: AOS PT ;START AFTER THE CR.
RRBTC1: SETZB OUT,RRHPOS ;AT THE CR, KNOW HPOS IS 0.
SAVE PT ;REMEMBER WHERE WE WENT BACK TO, TO RETURN IT IN A.
SAVE RRVPOS
RRBTC2: MOVE IN,PT ;REACHED WHERE WE STARTED?
CAMN IN,-2(P)
JRST RRBTC3 ;YES, FLUSH STACK & EXIT.
CALL RRFORW ;MOVE FWD TILL GET THERE.
MOVE A,RRVPOS ;IF WE'VE MOVED TO ANOTHER LINE,
CAME A,(P)
JRST [ MOVEM A,(P) ;THEN THE CHARS SEEN SO FAR ARE NOT ON THE SAME
SETZ OUT, ;LINE RRBTCR STARTED ON, SO THEY DON'T COUNT
JRST RRBTC2] ;IN OUT'S VALUE.
CAML OUT,RRHPOS ;IF CURRENT HPOS IS > LARGEST SO FAR,
JRST RRBTC2
MOVE OUT,RRHPOS ;UPDATE MAXIMUM-HPOS-ON-CURRENT-LINE.
JRST RRBTC2
RRBTC3: REST B ;RETURN IN B THE VPOS DIFFERENCE WE MOVED OVER.
REST A ;RETURN IN A THE ADDR OF WHERE WE WENT BACK TO.
SUB P,[1,,1]
REST RRVPOS
SUB B,RRVPOS
JRST POPCHJ
SUBTTL ^R MODE SYSTEM ECHO FOR SELF-INSERTING CHARACTERS
IFN <ITS + 20X*TEXTIF>,[
RRECIN: SKIPN RRMAXP ;SYSTEM ECHO CAN'T BE USED IF WE HAVE PENDING REDISPLAY.
SKIPL RRMSNG
RET
SKIPN INCHRQ ;IF WE ARE OR EXPECT TO BE ALLOWING TERMINAL LOCAL EDITING,
SKIPE INCHSY ;DON'T USE ECHOIN, OR IT WOULD GOBBLE THE TOP-S RESYNCH.
RET
IFN 20X,[
SKIPE FCITYI ;[wew] DOES TERMINAL HAVE META/EDIT KEY?
RET ;[wew] YES, CAN'T BREAK ON METANESS, SO RETURN.
]; IFN 20X
MOVE A,RRVPOS ;CAN'T SYSTEM ECHO IF THERE'S AN ARGUMENT,
SKIPN RRARGP ;OR IF ON A SCREEN LINE WHICH DOESN'T REALLY EXIST.
CAML A,BOTLIN
RET
SKIPE MODIFF ;NOT MODIFIED => FIRST INSERTION MUST CHANGE MODE LINE.
SKIPE READON ;DON'T ALLOW INSERTION IN READ-ONLY BUFFER.
RET
MOVE IN,PT
CAMN IN,GPT ;ECHOING ALLOWED ONLY IF THE GAP IS AT POINT, AND NONEMPTY,
SKIPN EXTRAC
RET
SKIPE CASNRM ;CAN'T USE ECHOIN IF CASE CONVERSION DESIRED.
RET
SKIPGE CASSFT
SKIPL CASLOK
RET
MOVE D,NHLNS ;COMPUTE HPOS AT WHICH SYSTEM ECHOING MUST STOP
MOVE A,RRMACT+40 ;(WHICH DEPENDS ON WHETHER AUTO-FILL IS ON.
CAMN A,RRECSD ; CHECK THE DEFINITION OF SPACE TO FIND OUT).
MOVE D,ADLINE
CAMLE D,RRHPOS ;CAN'T USE SYSTEM ECHOING IF AT OR PAST THAT POINT.
SKIPE TYISNK ;CAN'T USE ECHOING WHILE DEFINING A KEYBOARD MACRO.
RET ;(WE COULD MAKE RRECI5 HANDLE IT, BUT WHAT IF
; TYI SINK GETS AN ERROR ON ONE OF THE CHARS?
; YOU SHOULD FIND OUT RIGHT AWAY).
CAME A,RRECSD ;IF WE ARE USING AUTO-FILL SPACE,
JRST RRECIA
MOVE IN,RRVPOS ;CAN'T SYSTEM ECHO IF IN A CONTINUATION LINE.
MOVE IN,LINBEG(IN)
SUBI IN,2 ;LOOK AT THE TWO CHARACTERS BEFORE START OF THIS SCREEN LINE
CAMGE IN,BEGV ;(IF STARTS AT BEG OF BUFFER, IT CAN'T BE A CONTINUATION)
JRST RRECIA
CALL GETINC ;IF THE CHARS ARE NOT CRLF, WE CAN'T SYSTEM ECHO.
CAIE CH,^M
RET
CALL GETCHR
CAIE CH,^J
RET
RRECIA: SKIPGE UNRCHC ;CAN'T SYSTEM ECHO IF ALREADY HAVE INPUT TO PROCESS.
SKIPE JRNIN ;DON'T READ FROM TTY WHILE READING A JOURNAL FILE.
RET
SKIPN TYISRC ;CAN'T USE ECHOIN IF EXECUTING A KBD MACRO (!)
SKIPE RRXINV ;CAN'T USE ECHOIN IF ALL "NORMAL" CHARACTERS ARE NOW FUNNY.
RET
MOVE IN,PT
CALL RREOLT ;ECHOING IS GOOD ONLY AT THE END OF A LINE.
CAIA
RET
LISTEN A ;WAIT FOR OUTPUT TO FINISH. IF THERE IS OUTPUT
;WAITING, THEN ECHOING MIGHT BE DELAYED, AND A
;BREAK CHARACTER COULD COME IN, AND ITS OUTPUT
;MIGHT HAPPEN BEFORE THE ECHOING!
JUMPN A,CPOPJ ;DON'T BOTHER COMPUTING BREAK TABLES IF NON-ECHOED INPUT HERE.
;COMPUTE THE BREAK TABLE.
IFN TEXTIF&0,[ ;IT IS SILLY TO RECOMPUTE THE ENTIRE BREAK
SKIPN BRKVLD ;TABLE EVERY TIME WE DO A TEXTI, SINCE USUALLY
JRST RRECI0 ;IT WONT CHANGE MUCH.
PUSH P,BRKTAB
PUSH P,BRKTAB+1 ;PUT BREAK TABLE ON STACK WHERE WE WANT IT.
PUSH P,BRKTAB+2
PUSH P,BRKTAB+3
JRST RRECI9 ;AND CONTINUE.
RRECI0:
];IFN TEXTIF&0
SETZM SKNBPT
SKIPE RRPARN ;IF WE HAVE A CLOSEPAREN MACRO TO BE HACKED,
CALL SKNBCP ;GET POINTER TO LDB LISP SYNTAX OF CHAR IN A.
IBP SKNBPT
SETZ A, ;A SAYS WHICH ASCII CHARACTER.
RRECI1: MOVSI B,400000 ;B IS THE BIT FOR THAT CHARACTER.
SETO C, ;C IS THE BIT MASK BEING CONSTRUCTED.
MOVEI TT,RRXINS ;TT IS WHAT A NORMAL CHARACTER'S DEFINITION LOOKS LIKE.
RRECI2: CAMN TT,RRMACT(A) ;PROCESS 32 CHARS. MAKE A BIT MASK SAYING
ANDCM C,B ;WHICH OF THEM ARE NOT NORMAL SELF-INSERTING CHARACTERS.
LDB CH,SKNBPT ;IF CLOSEPAREN CHARS RUN A MACRO, AND THIS CHAR IS ONE,
CAIN CH,") ;THEN IT CAN'T BE ECHOED. NOTE THAT IF THERE IS NO MACRO,
IOR C,B ;SKNBPT WILL BE ZERO SO CH WILL BE ZERO.
LSH B,-1
AOS A
TRNE A,37
JRST RRECI2
PUSH P,C ;PUSH THE NEXT WORD OF BIT MASK ON THE STACK,
CAIE A,140 ;THEN MAKE ANOTHER WORD FOR THE NEXT 32 CHARACTERS.
JRST RRECI1
MOVSI B,400000 ;LOWER CASE ARE DIFFERENT SINCE THEY CAN BE INDIRECT.
MOVE TT1,[40,,RRINDR]
RRECI3: CAME TT1,RRMACT(A) ;SO START FROM THE WORD FOR UPPER CASE CHARS, AND TURN ON
IOR C,B ;THE BIT FOR ANY LOWER CASE CHAR THAT FAILS TO INDIRECT.
CAMN TT,RRMACT(A) ;BUT TURN IT OFF FOR ANY THAT IS SELF INSERTING
ANDCM C,B ;IN ITS OWN RIGHT (SUCH AS BRACES, TILDE, ETC).
LDB CH,SKNBPT ;IF CLOSEPAREN CHARS RUN A MACRO, AND THIS CHAR IS ONE,
CAIN CH,") ;THEN IT CAN'T BE ECHOED. NOTE THAT IF THERE IS NO MACRO,
IOR C,B ;SKNBPT WILL BE ZERO SO CH WILL BE ZERO.
LSH B,-1
AOS A
CAIE A,200
JRST RRECI3
PUSH P,C
SKIPN DISSAI ;IF NOT IN SAIL MODE, CHARS 0-37 CAN'T BE INSERTED BY ECHOIN.
SETOM -3(P)
MOVSI A,400000 ;IF SPACE'S DEFINITION EQUALS FS ^R EC SP, WE CAN ECHO IT.
MOVE B,RRMACT+40
CAMN B,RRECSD
ANDCAM A,-2(P)
IFN TEXTIF&0,[ ;SAVE THE BREAK TABLE SO THAT WE DONT HAVE TO
HRLI B,-3(P) ;CALCUALATE IT AGAIN UNLESS IT CHANGES
HRRI B,BRKTAB
BLT B,BRKTAB+3 ;SAVE 4 WORDS
SETOM BRKVLD ;FLAG THE BREAK TABLE AS BEING VALID
RRECI9:
];IFN TEXTIF&0
;THE BREAK TABLE IS PUSHED. HOW MANY CHARACTERS CAN WE HANDLE?
MOVE B,D
SUB B,RRHPOS ;B GETS MAX NUMBER OF CHARACTERS TO HANDLE,
CAML B,EXTRAC ;WHICH CAN'T BE MORE THAN SIZE OF GAP.
MOVE B,EXTRAC
MOVE E,QRB..
SKIPE .QCRMC(E) ;IF WE HAVE A ..F MACRO,
SKIPG E,RRMCCT ;DON'T DO ECHOIN PAST TIME WHEN IT SHOULD RUN.
JRST RRECI6
CAML B,RRMCC1
MOVE B,RRMCC1
RRECI6: MOVE BP,PT
CALL GETIBP ;BP GETS B.P. TO WHERE TO PUT THEM.
MOVEM BP,RRECBP ;SAVE OLD VALUE SO WE CAN SEE, AFTERWARD, WHAT
;GOT INSERTED.
MOVE E,PT
;THIS LABEL USED BY INTERRUPT ROUTINES TO SEE IF WE ARE INSIDE THE ECHOIN, AND
;EXIT IT IF SO.
IFN ITS,[
;[wew] CHANNEL BP CNT BREAK TABLE BUFFER BLK
RRECI7: SYSCAL ECHOIN,[%CLIMM,,CHTTYI ? BP ? B ? %CLIMM,,-3(P) ? %CLIMM,,BEG]
JFCL
];IFN ITS
IFN <20X & TEXTIF>,[ ;[wew] IF TOPS20 WITH NEW TEXTI SUPPORT
PUSH P,A
PUSH P,B
MOVE A,BP
MOVEM A,TXTIBK+.RDDBP ;[wew] SET UP DESTINATION
MOVE A,(P) ;[wew] COUNT WAS IN B
MOVEM A,TXTIBK+.RDDBC ;[wew] SET UP COUNT
MOVEI A,-5(P)
MOVEM A,TXTIBK+.RDBRK ;[wew] AND FINALLY THE BREAK MASK
MOVSI A,(RD%RND+RD%JFN+RD%SUI+RD%EMC)
MOVEM A,TXTIBK+.RDFLG ;[wew] SAVE RANDOM FLAGS.
MOVEI A,TXTIBK
TEXTI ;[wew] DO THE TEXTI JSYS
RRECI7: ERJMP TXTIER
MOVE A,TXTIBK+.RDFLG
TLNN A,(RD%BTM) ;[wew] INPUT TERMINATED BY BREAK CHARACTER?
JRST RREC7A ;[wew] NO, WE CAN CONTINUE
LDB A,TXTIBK+.RDDBP ;[wew] GET THE BREAK CHARACTER.
HRLI A,377777
MOVEM A,UNRCHC ;[wew] SAVE IT AS AN UNREAD CHARACTER.
AOS TXTIBK+.RDDBC ;[wew] ALSO DECREMENT BYTES RECEIVED COUNT.
RREC7A: MOVE A,(P) ;[wew] GET COUNT OF CHARS WE HAD TO BEGIN
SUB A,TXTIBK+.RDDBC ;[wew] SEE HOW MANY CHARACTERS WERE READ.
MOVEI B,BEG ;[wew] GET ADDRESS OF TECO BUFFER BLOCK
ADDM A,2(B) ;[wew] UPDATE VARIOUS COUNTERS IN BUFFER BLK
ADDM A,3(B)
ADDM A,4(B)
ADDM A,5(B)
ADDM A,TTLPOS ;[wew] "REAL" HORIZONTAL CURSOR POSITION
MOVN A,A ;[wew] LAST WORD GETS DECREMENTED
ADDM A,6(B) ;[wew] BUFFER BLOCK SHOULD NOW BE UPDATED.
TXTIER: POP P,B ;[wew] RESTORE SOME REGS
POP P,A
]; IFN 20X & TEXTIF
MOVE T,PT
SUB T,E ;T HAS NUMBER OF CHARACTERS INSERTED.
JUMPE T,RRECIX ;0 => CAN JUST EXIT, BUT MAKE SURE RRECBP IS 0.
MOVE A,T
MOVE TT,RRECBP
MOVE BP,RRVPOS
RRECI8: ILDB CH,TT ;SCAN THE CHARACTERS INSERTED,
CALL CHCTHI ;ADDING THEM TO HACH CODE
AOS RRHPOS ;AND INCREMENTING THE HPOS.
SOJG A,RRECI8
CALL RRINS3 ;UPDATE LINBEGS OF FOLLOWING LINES. ARGS ARE BP AND T.
MOVE TT,RRHPOS
MOVE BP,RRVPOS ;UPDATE HPOS OF END OF LINE.
MOVEM TT,LINEND(BP)
MOVEM TT,RROHPO ;ALSO NOTE THAT THE TERMINAL CURSOR IS WHERE IT OUGHT TO BE.
CALL RRECI5 ;PUT INSERTED CHARS INTO THE TYPE-IN RING BUFFER.
MOVE TT,INCHCT ;COUNT ALL OF THESE CHARACTERS AS PROCESSED BY ^R,
MOVEM TT,INCHRR ;SO THAT THE NEXT COMMAND DOESN'T ECHO THEM.
RRECIX: SETZM RRECBP ;CLEAR THIS, OR ELSE ^Z $G WOULD DO RANDOM THINGS.
POP4J: SUB P,[4,,4]
RET
;FIND ALL THE CHARS JUST INSERTED BY AN ECHOIN, AND PUT THEM IN THE TYI BUFFER.
;THIS IS CALLED ON RESTART AND BY QUITTING, IF RRECBP IS NONZERO.
RRECI5: MOVE A,RRECBP
MOVE BP,PT
CALL GETIBP
SETZM RRECBP
RRECI4: CAMN A,BP ;SIMULATE TYPING THE INSERTED CHARACTERS IN
RET
ILDB B,A ;BY PUTTING THEM IN THE TYI BUFFER RING
MOVEM B,RRPRVC
IDPB B,TYIBFP ;SO FS .TYINXT$ WILL SEE THEM.
CALL TYI1
MOVE CH,B
SKIPE JRNOUT ;AND PUTTING THEM IN THE JOURNAL OUTPUT FILE.
CALL JRNOCH
SETOM MODIFF ;ANY CHARACTERS INSERTED => BUFFER IS MODIFIED NOW.
SETOM MODIFM
SKIPLE RRMCCT
SOS RRMCC1 ;ADVANCE TOWARD RUNNING SECRETARY MACRO.
JRST RRECI4
] ;IFN ITS
SUBTTL ^R MODE ARGUMENT PROCESSING
;^U - MULTIPLY REPEAT COUNT OR WHATEVER BY 4.
RR4TIM: SKIP
AOS RR4TCT
MOVEI TT,1
JRST RRNXI2 ;SET RRARGP TO SAY NON-NULL ARG.
;^V - READ IN A NUMERIC ARGUMENT.
;THE CHARS OF THE ARG ARE ECHOED IN THE ECHO AREA.
;^G CANCELS THE ARG. ANY OTHER NON-DIGIT IS TREATED AS A COMMAND
;WHICH USES THE ARG (THIS INCLUDES RUBOUT). THE ARG IS LEFT IN RRRPCT.
RRARG: SKIP C,[0] ;WE'LL COMPUTE ARG'S VALUE IN C.
CALL RRECSP ;TYPE A SPACE AT BOTTOM OF SCREEN.
RRARG0: CALL TYIW0 ;READ CHAR: EITHER PART OF ARG, OR NEXT COMMAND.
MOVEM CH,$Q..0 ;IF THE LATTER, IT WILL EXPECT TO BE IN Q..0.
CAIN CH,"-
JUMPE C,[SAVE [RRARGN] ;1ST CHAR IS "-" => NEGATE ARG.
JRST RRARG1]
CAIL CH,"0
CAILE CH,"9
JRST RRARGX ;NON-DIGIT: TERMINATE ARG.
IMUL C,IBASE ;DIGIT: PUT IT IN ARG.
ADDI C,-"0(CH)
RRARG1: CALL FSECO1 ;AND PRINT IT IN THE ECHO AREA.
JRST RRARG0
RRARGX: MOVEM C,RRRPCT ;SAVE AWAY THE ARG WE READ.
MOVEM CH,UNRCHC ;REPROCESS THE ARG-TERMINATING CHAR AS A COMMAND WITH THAT ARG
JRST RRNXIT ;SAY THERE'S AN ARG IN RRRPCT.
RRARGN: MOVNS RRRPCT
RET
RRCMNS: SKIP ;CONTROL-MINUS: SET BIT SAYING NEGATE THE ARGUMENT.
MOVEI TT,5
JRST RRNXI2
RRCDGT: SKIP TT,RRRPCT ;CONTROL-DIGITS: ACCUMULATE AN ARGUMENT.
IMUL TT,IBASE
ANDI CH,77 ;WIN FOR META DIGITS AND C-M-DIGITS.
ADDI TT,-60(CH)
MOVEM TT,RRRPCT
RRNXIT: MOVEI TT,3
RRNXI2: IORM TT,RRARGP
SETZM RRLAST ;SAY THIS IS ARG-SETTING COMMAND SO WON'T CLOBBER RRPRVC OR FLUSH ARG.
JRST POPJ1 ;SKIPPING IS LIKE RETURNING ONE VALUE TO ^R.
;COMMANDS THAT WANT TO BE REPEATED A NUMBER OF TIMES EQUAL
;TO THE NUMERIC ARG DISPATCH THRU HERE.
;(THAT IS, THE DISPATCH WD HOLDS <CMD-RTN>,,RRREPT )
RRREPT: SKIP ;TELL RRLP7H ERROR-CHECK WE'RE GOOD GUYS.
HLRZS E ;PUT <CMD-RTN> IN RH.
RRREP1: JUMPLE C,POPJ1 ;C HAS <VALUE OF ARG>-<# TIMES ALREADY DONE>
CAIN C,1 ;IF CALLING FOR THE LAST TIME, THEN IF COMMAND SKIPS WE SHOULD.
JRST (E) ;(THUS RETURNING 1 VAL IF CALLED WITH M COMMAND, OR TRIGGERING RRTTY).
SAVE E
HRLM CH,(P) ;SAVE CMD RTN ADDR AND THE CHAR.
SAVE C ;AND # TIMES REMAINING.
CALL (E) ;DO IT ONCE
JFCL
SKIPGE STOPF ;LET USER QUIT OUT OF C-U 100000 C-F.
CALL QUIT1
REST C
REST E
HLRZ CH,E
SOJA C,RRREP1
;LIKE RRREPT, BUT IF REPEAT COUNT IS > 8 THEN SAY IN ADVANCE THAT
;REDISPLAY IS NEEDED (TO INHIBIT UPDATING).
;USED TO REPEAT INSERT COMMANDS, SO THAT ^U^UA DOESN'T
;RUN SLOWLY BY TYPING OUT AN A AT A TIME.
RRREPI: SKIP
HLRZS E
RRREP2: CAIG C,8
JRST RRREP1
SKIPN RRMAXP ;RRMAXP=1 INHIBITS UPDATING BUT DOESN'T MARK ANY ACTUAL PART
AOS RRMAXP ;OF THE BUFFER AS NEEDING REDISPLAY. THE INSERT RTN WILL CHANGE
JRST RRREP1 ;RRMAXP TO INCLUDE WHAT IT INSERTS.
;COMPUTE THE ARGUMENT FROM THE EXPLICIT ARGUMENT AND
;THE POWER-OF-4. RETURN IN C.
RRARGD: MOVE TT,RRARGP ;GET THE EXPLICIT ARG, OR 1 IF NONE SPEC'D.
TRNE TT,2
SKIPA C,RRRPCT
MOVEI C,1
TRNE TT,4 ;IF ^- SET THE 4 BIT, NEGATE THE ARG.
MOVNS C
MOVE TT,RR4TCT ;THEN MULTIPLY BY 4 FOR EACH ^U.
SOJGE TT,[LSH C,2 ? JRST .]
RET
;AFTER A COMMAND, IF IT DIDN'T IDENTIFY ITSELF AS AN ARGUMENT-SETTING COMMAND
;(BY CLEARING RRLAST), FLUSH THE ARGUMENT THAT THE COMMAND USED.
RRARGF: SKIPN TT,RRLAST ;IF THE LAST COMMAND DIDN'T PRESERVE OR MAKE AN ARG,
RET
MOVEM TT,RRPRVC ;REMEMBER IT AS "PREVIOUS COMMAND" FOR NEXT COMMAND,
SETZM RRARGP ;SAY TO GIVE NEXT COMMAND THE DEFAULT ARG (1)
SETZM RR4TCT ;AND CLEAR ARG ACCUMULATION VARIABLES.
SETZM RRRPCT
SETZM RRUNQT
RET
;COME HERE FOR ^G.
RRQUIT: SKIP TT,CASNRM ;NOTE: THIS RTN IS CALLABLE BY RRLP7H, SO NEED "SKIP"
MOVEM TT,CASE ;IN F$ MODE, UNDO ANY CASE-LOCKAGE.
SETOM RRMKPT ;ELIMINATE THE MARK.
SKIPE NELNS
CALL ECHOCL ;GO TO NEW LINE IN ECHO REGION
SETOM RROVPO ;FORCE CURSOR REPOSITIONING
;ERROR DETECTED BY RR EDIT:
RRERR: SKIP
SKIPE RREBEG ;IF NOT INSIDE ^R, GIVE A TECO ERROR.
TYPRE [BEL]
MOVE P,DISPRR
JRST TYPBEL ;TYPE A BELL AND REENTER MAIN LOOP.
;"UNDEFINED" ^R COMMAND CHARACTERS HAVE THIS DEFINITION, WHICH TYPES A BELL
;AND RETURNS 1 VALUE. THIS AVOIDS GETTING A "BEL" ERROR, IF UNDEFINED CHAR
;IS RUN WITH M^R<CHAR>.
RRUNDF: SKIP
AOS (P)
JRST TYPBEL
;EXPECT CHAR ADDR IN "IN", SKIP UNLESS IT POINTS TO THE END
;OF THE BUFFER OR THE END OF A LINE. CLOBBERS TT, TT1
RREOLT: CAMN IN,ZV
POPJ P, ;AT EOF.
SAVE CH
CALL GETINC
CAIN CH,^M
CAMN IN,ZV
SOJA IN,POPCH1 ;BEFORE A CR THAT'S THE LAST CHAR.
CALL GETCHR
SUBI IN,1
CAIE CH,^J
POPCH1: AOS -1(P) ;BEFORE A STRAY CR => NOT AT EOL.
JRST POPCHJ ;BEFORE A CRLF => EOL.
;IF A CHARACTER <C>'S DEFINITION IS <N>,,RRINDR, IT IS AN INDIRECT PTR
;TO THE DEFINITION OF THE CHARACTER <C>-<N>. USED TO HANDLE
;THE LOWER CASE CONTROL CHARACTERS SUCH AS 341 = CTL-LOWERCASE-A.
;ALSO USED TO MAKE CONTROL-H EQUIVALENT TO BACKSPACE; SIMILAR FOR TAB & LF.
RRINDR: SKIP
HLRZS E ;GET <N>
SUB CH,E
JRST RRIND1 ;GO USE DEF'N OF <C>-<N>.
SUBTTL ^R MODE SINGLE CHARACTER DELETION AND INSERTION
RRDLNB: MOVNS C ;HERE FOR DELETE BACKWARD WITH NEGATIVE ARG. SKIPS.
JRST RRCTD1
;^D -- DELETE FORWARD. (D)
RRCTLD: SKIP
JUMPGE C,RRCTD1
MOVNS C
MOVEM C,RRRPCT ;IF NEGATIVE ARG, SET ITS NEGATION UP AS ARG
.I RRARGP=3
SETZM RR4TCT
MOVEI CH,177 ;AND TURN INTO RUBOUT.
JRST RRIND1
RRCTD1: SKIPE RRARGP ;IF WE HAVE AN EXPLICIT ARGUMENT,
SKIPN A,RUBMAC ;CALL THE SUPPLIED MULTI-CHARACTER DELETE MACRO.
CAIA
JRST [ MOVNS C ;CALL WITH NEGATIVE ARG (NUMBER TO RUB OUT).
AOS (P)
JRST RRMAC0]
JSP E,RRREP1 ;ELSE REPEAT WHAT FOLLOWS THAT MANY TIMES:
AOS (P)
MOVE IN,PT
CAML IN,ZV
JRST RRERR
JSP E,RRTYPP ;ON PRINTING TTY, MAYBE TYPE SCAN INFO
CALL [ SETCM E,TTYOPT
CALL GETCHR ;GET CHARACTER ABOUT TO DELETE
MOVEI A,(CH)
MOVEI CH,"/
TLNE E,%TOOVR\%TOMVB ;IF CAN BACKSPACE AND OVERPRINT, OVERPINT A SLASH.
CAIN A,^M ;ABOUT TO DELETE A CRLF, TYPE A SLASH.
CALL FSECOR
MOVEI CH,^H ;BS OVER IT IF OVERPRINTING
TLNN E,%TOOVR\%TOMVB
CALL FSECOR
MOVEI CH,(A) ;GET CHARACTER AGAIN
CALL FSECOR
SKIPN BSNOLF
RET
JRST RRMVC] ;THEN ECHO THE CHAR BEING DELETED.
SKIPN RUBCRL ;IF FS RUBCRLF$ NONZERO,
JRST RRDLF
CALL RREOLT ;IF BEFORE A CRLF, DELETE BOTH CHARS.
JRST [ CALL GAPSLP
CALL DEL1F ;DELETE THEM AT ONCE, AND DON'T TRY TO DO UPDATING.
CALL DEL1F
MOVE BP,RRVPOS
MOVE T,RRHPOS
MOVNI A,2
JRST RRFXM1]
;INTERNAL ROUTINE TO DELETE FORWARD.
RRDLF: CALL RRFORW ;MOVE OVER THE CHAR, THEN DELETE IT BACKWARD.
;INTERNAL ROUTINE TO DELETE BACKWARD (-D). DELETED CHAR LEFT IN CH.
;CLOBBERS A,B,IN,OUT,TT,TT1,Q, T, BP
RRDLB: SETOM RRMKPT
MOVE IN,PT ;ERROR AT BEGINNING OF BUFFER.
CAMG IN,BEGV
JRST RRERR
SAVE RRVPOS ;REMEMBER VPOS TO RIGHT OF CHARACTER.
CALL RRBACK ;ACCOUNT FOR CURSOR POS CHANGE DUE TO DELETION.
CALL GAPSLP
CALL RRCRDI
CALL DEL1F ;DELETE FORWARD FROM BUFFER, NO CURSOR HACKERY.
CAIE CH,^H ;DELETING CHARS THAT MOVE LEFT IS HARD.
CAIN CH,^M
JRST RRDLB4
CAIN CH,^J
JRST RRDLB4
CAIE CH,^I
SKIPN DISSAI
CAIL CH,40 ;BETTER NOT BE DIFFICULT CHARACTER
CAIN CH,177
JRST RRDLB4 ;IF IT IS, JUST REDISPLAY
CALL RRICHK ;SEE WHETHER IT'S EASY TO UPDATE SCREEN.
REST A
CAMN A,BP ;IF EFFECTS OF CHANGE REACH PREV. LINE,
SKIPE RRMAXP ;OR IF REDISPLAY WILL BE DONE ANYWAY.
JRST RRDLB1 ;DON'T BOTHER TO DO IT HERE.
CALL RRMVC ;UPDATE THE SCREEN NOW:
MOVNI T,1 ;UPDATE LINBEG WORDS OF ALL LINES
CALL RRINS3 ;BELOW THIS ONE.
MOVE BP,RRVPOS
SKIPGE T,RRCIDP
JRST [ SETOM HCDS(BP) ;IF MOVING CHARS TO NEW HPOSES, WE CAN'T FIX THE HASHCODE.
SOS LINEND(BP)
MOVE A,INCHCT ;IF "DISPLAYING" PRE-ECHOED INPUT,
CAMG A,INCHEC ;DON'T ACTUALY OUTPUT ANYTHING, JUST PRETEND WE DID.
RET
MOVEI A,1
JRST DELCHR]
CALL CHCTHR ;ELSE REMOVE THIS CHARACTER FROM THE HASH CODE; RRHPOS IS HPOS.
MOVE A,INCHCT ;IF "DISPLAYING" PRE-ECHOED INPUT,
CAMG A,INCHEC ;DON'T ACTUALY OUTPUT ANYTHING, JUST PRETEND WE DID.
JRST [ JUMPLE T,CPOPJ
MOVE T,RRHPOS
MOVEM T,LINEND(BP) ;AT END OF LINE => CURRENT POS IS NEW END-OF-LINE POS.
RET]
JUMPG T,ERSCHR ;NOW GO CLEAR OUT THE APPROPRIATE PARTS OF THE SCREEN.
MOVE T,RRHPOS
MOVEM T,LINEND(BP) ;AT END OF LINE => CURRENT POS IS NEW END-OF-LINE POS.
JRST CLREOL
RRDLB4: SUB P,[1,,1] ;FLUSH SAVED VPOS. FROM STACK.
SKIPGE DISPCR
SETZ T, ;DELETING A REAL STRAY CR => MUST REDISPLAY WHOLE LINE
;TO GET RID OF OVERSTRUCK CHAR IN POSITION 0.
RRDLB1: MOVNI A,1 ;1 CHAR DELETED AT VPOS, HPOS IN BP,T.
JRST RRFXM1
FSRRRU: ARGDFL Z ;FS ^R RUBOUT$
SAVE [RRLEA1] ;AFTERWARDS SET RREPT, RREHPS, RREVPS.
JSP E,RRREP2
JRST RRDLB ;RUB OUT SPEC'D # OF CHARS WITH NO TAB OR CRLF HACKS.
;BUILT-IN DEFINITION OF RUBOUT: DECODE ARGUMENT.
RRRUB: SKIP
JUMPL C,RRDLNB ;NEGATIVE ARG => REALLY DELETE FORWARD.
SKIPE RRARGP ;ELSE, EXPLICIT ARG MEANS CALL
SKIPN A,RUBMAC ;THE MULTI-CHAR DELETE MACRO, IF ANY.
CAIA
JRST [
AOS (P)
JRST RRMAC0]
JSP E,RRREP2 ;REPEAT ARG TIMES WHAT FOLLOWS (BUT FIRST OTHER STUFF)
AOS (P)
RRRUBD: SKIPN RRRPLC ;RUBOUT IN OVERWRITE MODE MEANS
JRST RRRUB1
MOVE IN,PT ;REPLACE PREVIOUS CHARACTER WITH A SPACE.
CAMG IN,BEGV ;BUT THERE MUST BE A PREVIOUS CHARACTER,
JRST RRRUB1
SOS IN
CALL GETCHR
CAIE CH,^J ;AND IT MUSTN'T BE ONE OF THESE FUNNY ONES.
CAIN CH,^M
JRST RRRUB1
CAIE CH,^I
CAIN CH,^H
JRST RRRUB1
CAIN CH,^L
JRST RRRUB1
CALL RRBACK ;SO REPLACE PREV. CHAR WITH A SPACE BY BACKING UP
MOVEI CH,40 ;AND DOING AN OVERWRITE-MODE INSRT OF A SPACE.
MOVEM CH,$Q..0
CALL RRDINS
JFCL
JRST RRBACK ;THEN BACK UP OVER THE SPACE AGAIN.
RRRUB1: CALL RRDLB ;DELETE ONE CHAR BACKWARD
SKIPE RUBCRL ;AND THEN IF FS RUBCRLF$ NONZERO, AFTER RUBBING OUT A ^J
CAIE CH,^J
JRST RRRUBP
MOVE IN,PT ;FLUSH A CR BEFORE IT, TOO.
SOS IN
CAMGE IN,BEGV
JRST RRRUBP
CALL GETCHR
CAIN CH,^M
CALL RRDLB
RRRUBP: JSP E,RRTYPP ;ON PRINTING TTY, IF SCANNING, TYPE THE RUBBED CHARACTER.
CAIA ;NOTICE THAT IF RUBBING A CRLF WE COME HERE FOR THE CR
RET ;WHICH WILL ECHO AS CRLF.
MOVE E,TTYOPT
TLNE E,%TOMVB ;ON TTY THAT CAN'T BS, SURROUND RUBBED STUFF WITH \'S.
JRST RRRUBB
MOVEI IN,"\
SAVE CH
MOVEI CH,"\
CAME IN,RUBENC ;IF NOT YET INSIDE A \ PAIR, START ONE.
CALL FSECO1
SETZM RUBENC ;IF INSIDE ONE ALREADY, DON'T END IT YET.
REST CH
CALL FSECOR ;TYPE THE RUBBED CHARACTER.
MOVEM IN,RUBENC ;FOLLOW WITH A \ WHEN WE STOP RUBBING OUT.
RET
RRRUBB: CALL RRTTY2 ;MOVE CURSOR TO RIGHT PLACE. THIS KING OF RUBOUT CAN INTERMIX
MOVEI CH,"/ ;WITH BACKWARD MOTION.
CALL FSECOR ;OVERSTRIKE A / (MAY ERASE OR NOT, WHO CARES?)
JRST RRMVC
;CTL-RUBOUT: LIKE RUBOUT, BUT CONVERTS TABS INTO SPACES FIRST.
RRCRUB: SKIP
JUMPL C,RRDLNB ;NEGATIVE ARG => REALLY DELETE FORWARD.
SKIPE RRARGP ;ELSE, EXPLICIT ARG MEANS CALL
SKIPN A,RUBMAC ;THE MULTI-CHAR DELETE MACRO, IF ANY.
JRST RRCRU2
AOS (P)
MOVEM C,NUM
SETOM SARG ;FOR TAB-HACKING, GIVE IT -1 AS ^X ARG.
TRO FF,FRARG2
JRST RRMAC7 ;FRARG2 WON'T BE SET, BUT THAT DOESN'T MATTER.
RRCRU2: JSP E,RRREP2 ;REPEAT THE FOLLOWING ARG TIMES:
AOS (P)
SAVE RRHPOS
CALL RRBACK ;WE NEED HPOS BOTH BEFORE AND AFTER CHAR TO BE FLUSHED,
REST E ;IF IT'S A TAB.
CAIE CH,^I
JRST [ CALL RRFORW ;NOT TAB => UNDO THE RRBACK
JRST RRRUBD] ;AND DO A NORMAL RUBOUT.
CALL GAPSLP
SAVE PT
AOS (P)
CALL DEL1F ;ELSE FLUSH THE TAB AND PUT IN APPRO. # OF SPACES
SUB E,RRHPOS
RRCRU1: MOVEI CH,40
CALL TYOM
SOS PT
CALL RRFORW ;MOVING FORWARD OVER THEM
SOJG E,RRCRU1 ;LEAVING US IN INITIAL STATE EXCEPT TAB REPLACED BY SPACES.
REST T
SUB T,PT
MOVNS T ;T HAS CHANGE IN PT DUE TO OUR INSERTION.
SKIPE RREPT ;IF WE ARE CALLED FROM TECO CODE, UPDATE RREPT
ADDM T,RREPT ;TO CORRESPOND TO THE SPACES INSTEAD OF THE TABS.
MOVE BP,RRVPOS
CAMGE BP,TOPLIN ;IF THE CHANGE IS ABOVE THE SCREEN, RELOCATE ALL LINBEGS IN THE WINDOW.
MOVE BP,TOPLIN
CAMGE BP,BOTLIN ;IF THIS CHANGE IS OFF THE END OF THE SCREEN, WE ARE DONE.
CALL RRINS3 ;RELOCATE LINBEG TABLE FOR WHAT WE HAVE DONE.
JRST RRRUBD ;THEN DELETE THE LAST SPACE.
;COME HERE WHEN CASE-SHIFT IS READ.
RRSFT: MOVNS CASE ;READ NEXT CHAR IN ABNORMAL CASE.
AOSE RCHSFF
SETOM RCHSFF ;RESTORE TO NORMAL AFTER NEXT CHAR.
SKIPN RCHSFF ;ALLOW THE CASE-SHIFT TO QUOTE ITSELF.
JRST RRLP7J
;TYPE THE CHAR IN Q..0 AS A PROMPT, IF THERE IS NO INPUT AVAILABLE.
RRECO1: SKIPE RGETTY
SKIPGE RRECHO ;ON DISPLAY TTY, IF NOT ECHOING THE COMMAND,
RET
MOVEI A,[ASCIZ /0@V @:FT ..00 /]
JRST RRMACR
;COME HERE FOR CASE-LOCK AS A COMMAND.
RRLOK: MOVNS CASE
POPJ P,
;^O - INSERT CRLF, THEN BACK UP OVER IT.
RRCTLO: CALL RRCRL1 ;INSERT CRLF
JFCL
AOS (P)
CALL RRBACK ;THEN BACK OVER IT.
JRST RRBACK
;^M - INSERT ^M AND ^J.
RRCRLF: CALL RRCMRU ;REMOVE TAB-SEMI'S FROM LINE WE'RE ON.
RRCRL1: MOVEI CH,^M
CALL RRINS ;INSERT THE ^M.
MOVEI CH,^J
JRST RRINSQ ;INSERT THE ^J.
;^Q -- READ NEXT CHAR AND INSERT IT.
RRQUOT: SKIP
SAVE C
CALL RRECO1 ;FINISH DISPLAYING, MAYBE PROMPT WITH A "^Q".
CALL TYI ;READ THE CHAR TO BE QUOTED.
CALL TYINRM
REST C
JSP E,RRREP1 ;NOTE ^Q MUST DO ITS OWN REPETITION.
JRST RRINSQ ;OTHERWISE ^V5^Q WOULD READ AND INSERT 5 CHARS.
;INSTEAD OF READING 1 CHAR AND INSERTING
;IT 5 TIMES.
;THIS IS THE DEFAULT DEFINITION OF "SELF-INSERTING" CHARACTERS:
;NORMALLY, JUST INSERT. META-CHARS INSERT. IF FS ^R REPLACE$ NONZERO,
;NON-META CHARS REPLACE INSTEAD (BUT AT END OF LINE, THEY INSERT).
RRDINS: MOVE CH,$Q..0
TRNN CH,META
SKIPN RRRPLC
JRST RRINSC
MOVE IN,PT
CAML IN,ZV ;AT END OF BUFFER, JUST INSERT.
JRST RRINSC
CALL GETCHR ;HERE IF SUPPOSED TO TRY TO REPLACE.
CAIE CH,^M ;AT END OF LINE?
CAIN CH,^J
JRST RRINSC ;YES => INSERT, DON'T REPLACE.
CAIE CH,^H
CAIN CH,^L
JRST RRINSC
CAIN CH,^I
JRST RRDINT
RRDIN0: AOS (P)
CALL RRICH9 ;CHECK FOR VARIOUS CONDITIONS PROHIBITING UPDATING.
CALL RRFORW
SAVE RRHPOS ;WHAT IS HPOS AFTER THE CHAR WE ARE REPLACING??
CALL RRBACK ;DELETE THAT CHARACTER.
SAVE CH
SAVE RRHPOS
CALL GAPSLP
CALL DEL1F
MOVE CH,$Q..0
CALL TYOM ;INSERT THE NEW CHARACTER.
SOS PT
MOVE BP,RRVPOS
CALL RRFORW ;WHAT IS THE HPOS AFTER THE NEW CHARACTER?
REST T ;T GETS HPOS BEFORE THIS CHARACTER.
REST B ;B HAS CHAR WE ARE REPLACING.
REST A ;A GETS HPOS AFTER CHAR WE REPLACED.
CAMN A,RRHPOS ;HPOS AFTER THIS CHAR SAME AS AFTER OLD => WE CAN REWRITE ON SCREEN,
CAME BP,RRVPOS ;AS LONG AS IT DOESN'T CONTINUE THE LINE.
JRST RRDIN3
CAIE CH,ALTMOD ;EITHER CHAR IS ALTMODE => CAN'T UPDATE.
CAIN B,ALTMOD
JRST RRDIN3
SKIPE RRMAXP
JRST RRDIN3
EXCH T,RRHPOS ;T GETS HPOS AFTER (LIKE A), RRHPOS GETS HPOS BEFORE CHAR.
EXCH CH,B
CAIN CH,11
MOVEI CH,40
CALL CHCTHR ;UPDATE HASH CODE OF LINE FOR CHAR BEING REPLACED.
MOVE CH,B
CALL CHCTHI ;UPDATE THE HASH CODE OF THE LINE FOR CHAR BEING INSERTED.
CALL RRMVC ;MOVE TO HPOS OF START OF CHARACTER.
SUB A,RRHPOS ;A GETS NUMBER OF POSITIONS THE CHARACTER TAKES.
CAIE A,1
SETOM HCDS(BP) ;MORE THAN 1 => WE CAN'T FIX THE HASH CODE, SO CALL FOR REDISPLAY.
MOVE TT,INCHCT ;IF "DISPLAYING" PRE-ECHOED INPUT,
CAMG TT,INCHEC ;DON'T ACTUALLY OUTPUT ANYTHING,
JRST [ MOVEM T,RRHPOS ;JUST PRETEND WE DID.
MOVEM T,RROHPO
RET]
MOVE TT,TTYOPT
TLNN TT,%TOOVR ;IF TERMINAL CAN OVERPRINT, WE MUST CLEAR THE SPOTS.
JRST RRDIN2
RRDIN1: SAVE A
CALL ERSCHR ;CLEAR OUT THAT MANY POSITIONS.
REST A
MOVEI CH,40
CALL TYOINV
SOJG A,RRDIN1
SETOM RROHPO
CALL RRMVC ;THEN RESTORE CURSOR POSITION.
RRDIN2: MOVEM T,RRHPOS ;SET HPOS TO ITS VALUE AFTER THE NEW CHARACTER.
MOVEM T,RROHPO
MOVE CH,$Q..0 ;NOW PRINT THE NEW CHARACTER AT THE DESIRED PLACE.
SKIPE CASDIS
CALL DISAD6
JRST TYOINV
RRDIN3: SETZ A, ;HERE TO UPDATE RRMNVP, RRMNHP, RRMAXP IF CAN'T UPDATE SCREEN.
JRST RRFXM1 ;T HAS HPOS OF CHAR, BP HAS VPOS.
RRDINT: .I RRHPOS+1 ;BEFORE A TAB => INSERT UNLESS TAB NOW TAKING ONLY 1 SPACE.
IDIV TT,TABWID
JUMPE TT1,RRDIN0
RRINSC: MOVE CH,$Q..0
RRINSQ: AOS (P)
TRZ FF,FRARG2
JRST RRINS
FSRRINS:MOVE CH,C ;USER-INTERFACE TO RRINS: FS ^R INSERT$
;INSERT CHAR IN CH.
;CLOBBERS A, B, IN, OUT, TT, TT1, CH, Q, T, BP
RRINS: CALL TYINRM ;CONVERT CHARACTER TO ASCII.
SETOM RRMKPT
MOVE A,TABWID
CAIN A,8
CAIE CH,^I ;INSERTING ANY CTL CHAR IS HARD EXCEPT 8-SPACE TAB.
CAIA
SKIPE LEABLE ;AND TAB IS HARD TOO IF TERMINAL CAN DO LOCAL EDITING.
SKIPE RRMAXP
JRST RRINS2
CAIL CH,40
CAIN CH,177
AOSA RRMAXP
RRINS2: CALL RRICHK ;SEE IF OBVIOUSLY CAN'T UPDATE SCREEN NOW.
CALL RRCRDI
CALL [ CALL TYOMGS ;INSERT CHAR AFTER PT.
SOS PT
POPJ P,]
MOVE Q,RRHPOS
CALL RRFORW ;THEN MOVE FORWARD OVER IT.
MOVEI A,1 ;(FOR RRFXM1) 1 CHAR INSERTED.
CAMN BP,RRVPOS ;CHAR MOVED TO NEXT LINE => MUST REDISPLAY
SKIPE RRMAXP ;IF REDISPLAY ALREADY NEEDED, DON'T TRY TO UPDATE FOR THIS.
JRST RRFXM1
SKIPE RRCIDP ;IF GOING TO DO SOMETHING WITH CHAR I/D
CAIE CH,^I ;MUST BE AN EASY CHAR
CAIA
JRST RRFXM1 ;FOR TABS REDISPLAY REQUIRED
MOVE T,Q
EXCH T,RRHPOS ;POSITION CURSOR AT HPOS BEFORE THE CHARACTER.
CALL RRMVC
CALL CHCTHI ;USE THAT HPOS TO UPDATE LINE'S HASH CODE.
CAIN CH,^I ;AFTER A TAB, THE HASH CODE WAS NOT UPDATED PROPERLY.
SETOM HCDS(BP)
MOVEM T,RRHPOS
MOVEM T,RROHPO
MOVEI T,1 ;UPDATE LINBEG WDS OF ALL LINES
CALL RRINS3 ;BELOW THIS LINE.
MOVE BP,RRVPOS
SKIPN CASDIS ;IF CASE FLAGGING MIGHT BE HAPPENING,
SKIPGE RRCIDP ;OR IF WE ARE MOVING OTHER CHARACTERS AROUND,
SETOM HCDS(BP) ;THEN UPDATING THE HASH CODE LOST, SO CALL FOR REDISPLAY OF LINE.
SKIPG RRCIDP ;IF AT END OF LINE OR INSERTING, UPDATE REMEMBERED LINE-END-HPOS.
AOS LINEND(BP)
MOVE TT,RRHPOS
SKIPN RRCIDP ;INSERTING AT END OF LINE => CURRENT HPOS IS NEW END-OF-LINE HPOS.
MOVEM TT,LINEND(BP) ;THIS IS USUALLY SAME AS AOS'ING BUT NOT WHEN TAB IS INSERTED!
MOVE A,INCHCT ;IF "DISPLAYING" PRE-ECHOED INSERTING CHARS,
CAMG A,INCHEC ;DON'T ACTUALLY OUTPUT ANYTHING NOW.
RET
MOVEI A,1
SKIPGE RRCIDP ;IF USING CHAR I/D FOR THIS
CALL INSCHR ;INSERT THE SPACE FOR IT FIRST
SKIPE CASDIS ;OUTPUT CHARACTER, WITH CASE-SHIFT IF ANY.
CALL DISAD6
JRST TYOINV
RRINS3: ADDM T,RROLZV
JRST RRDISG
;CHECK FOR SOME OF THE THINGS THAT WOULD RULE OUT UPDATING THE
;SCREEN IMMEDIATELY FOR AN INSERT OR DELETE. IF ANY IS
;FOUND, LEAVE RRMAXP NONZERO (THIS WON'T CONFUSE RRLP BECAUSE
;WE'LL SET RRMAXP ANYWAY IN ORDER TO CAUSE REDISPLAY)
;REDISPLAY WILL ALWAYS WORK, BUT UPDATING IS FASTER.
;CLOBBERS A, B, IN, OUT, TT, TT1
RRICHK: HRROS (P) ;SET SIGN FOR CHECKING INSERTION AND DELETION.
CAIA
RRICH9: HRRZS (P) ;CLEAR SIGN FOR CHECKING FOR REPLACEMENT.
SETZM RRCIDP ;SO FAR NO TAB OR CHAR I/D STUFF APPEARS TO BE NECESSARY.
SKIPE RRMAXP ;REDISPLAY NECESSARY ANYWAY =>
RET ;IT WILL FIX SCREEN; WE NEEDN'T.
SKIPL RRINHI
SKIPL RRMSNG
JRST RRICH2
SAVE CH
SKIPN RGETTY
JRST RRICH1 ;CAN'T UPDATE IF THERE'S A CURSOR STRING.
MOVE CH,RRVPOS ;IF CURSOR IS OFF SCREEN,
CAML CH,TOPLIN
CAML CH,BOTLIN ;DON'T UPDATE, REDISPLAY IS NEEDED.
JRST RRICH1
SKIPL -1(P)
JRST RRICH4
MOVE IN,PT
CALL RREOLT ;UPDATING FOR INSERT/DELETE POSSIBLE ONLY AT END OF LINE.
CAIA
JRST RRICH3 ;UNLESS BEFORE TAB OR CHAR I/D CAN BE USED
RRICH4: SKIPE TYISRC
JRST RRICH1
LISTEN A ;MANY UPDATES DON'T BEAT 1 REDISPLAY.
CAIL A,5
JRST RRICH1
SKIPL DISPCR ;IF THERE ARE NO REAL BS'S OR STRAY CR'S
SKIPGE DISPBS
CAIA
JRST POPCHJ ;NO NEED FOR THE NEXT TEST.
CALL RRBTCR ;PERHAPS, DUE TO BACKSPACES, SOMETHING
CAMG OUT,RRHPOS ;EARLIER IN THE LINE APPEARS FARTHER
JRST POPCHJ ;RIGHT ON THE SCREEN (EG ABC<BS>/\)
RRICH1: REST CH
RRICH2: AOS RRMAXP ;CAUSE CALLER NOT TO TRY UPDATING.
RET
;CHECK FOR CONDITIONS THAT MIGHT ALLOW US TO AVOID REDISPLAY EVEN IF
;NOT AT THE END OF THE LINE, IF RETURNS SUCCESSFUL, RRCIDP WILL BE
;POSITIVE IF WE ARE BEFORE A TAB THAT TAKES MORE THAN 1 SPACE AND SO
;CAN INSERT BY OVERWRITING, OR NEGATIVE IF WE ARE TO USE CHAR I/D
RRICH3: SKIPE CASDIS ;DONT GET SCREWED BY FLAGGING
JRST RRICH1 ;JUST REDISPLAY IN THAT CASE
CALL GETINC ;GET NEXT CHAR
CAIE CH,^I ;IS IT A TAB?
JRST RRICH5 ;NO, TRY CHAR I/D MAYBE
.I RRHPOS+1 ;GET NUMBER OF CHARS IT USES
IDIV TT,TABWID
JUMPE TT1,RRICH1 ;JUMP IF ONLY ONE.
AOS RRCIDP ;SAY HACKING A TAB,
JRST RRICH4 ;AND GO CONTINUE CHECKS
RRICH5: SKIPE CID ;TRY TO USE CHAR I/D?
CALL RRNTBP ;CHECK THAT THE LINE HAS NO TABS AFTER THIS IN IT
JRST RRICH1 ;NO, FORGET IT, MUST REDISPLAY
SETOM RRCIDP ;SAY USE CHAR I/D FOR THIS ONE
JRST RRICH4 ;AND CONTINUE CHECKING
;CONVERT LOWER CASE TO UPPER OR VICE VERSA, ACC. TO FS CASE $
;FOR SHIFT OR LOCK CHARS, RCHSFT AND RCHLOK MIGHT GET CALLED!
RRCASC: TRNE CH,CONTRL+META
RET
CAIL CH,100 ;[ ;XCTING WOULD LOSE ON ALTMODE, ^].
XCT RCHDTB(CH) ;SKIPS FOR CHARS WHOSE CASE IS WRONG.
CAIA
XORI CH,40 ;CHANGE TO THE OTHER CASE.
MOVEM CH,$Q..0
AOSN RCHSFF
MOVNS CASE ;IF PREV. CHAR WAS CASE SHIFT, UN-COMPLIMENT CASE.
POPJ P,
;CHECK IF THE CURRENT LINE HAS TABS IN IT AFTER PT, WHICH MIGHT MAKE
;AVOIDING REDISPLAY TOO HARD, SKIP IF NONE FOUND AND BUFFER LINE DOES NOT
;WRAP AROUND TO SEVERAL SCREEN LINES
RRNTBP: SAVE BP
MOVE IN,PT
CALL GETIBI ;GET POINTER TO CURRENT POSITION
RRNTB1: CAMN IN,ZV
JRST RRNTB3 ;AT THE VERY END, OK NO TABS THEN
CAMN IN,GPT
CALL FEQGAP ;MOVE OVER GAP
ILDB CH,BP
RRNTB2: CAIN CH,^I ;IS IT A TAB?
JRST POPBPJ ;YES, FAILURE THEN
CAIE CH,^M ;GOT TO CR?
AOJA IN,RRNTB1 ;NO, KEEP LOOKING
AOJ IN,
CAMN IN,ZV
JRST RRNTB3
CAMN IN,GPT
CALL FEQGAP
ILDB CH,BP
CAIE CH,^J ;REALLY AT CRLF?
JRST RRNTB2 ;NO, IT WAS STRAY CR. MAYBE THIS CHAR IS A TAB.
SUBI IN,1 ;CHECK HPOS JUST BEFORE THE CR.
RRNTB3: SKIPGE DISTRN ;IF WE ARE JUST TO TRUNCATE LONG LINES
JRST POPBP1 ;THAT'S ENOUGH CHECKING, SKIP RETURN
INSIRP PUSH P,RRHPOS RRVPOS PT E
MOVE E,IN
CALL RRMOV ;FIND POSITION OF END OF LINE (AS OF LAST REDISPLAY)
MOVE TT,RRHPOS ;GET NEW VALUES
MOVE TT1,RRVPOS
INSIRP POP P,E PT RRVPOS RRHPOS
CAME TT1,RRVPOS ;ON THE SAME LINE?
JRST POPBPJ ;NO, MUST REDISPLAY THEN
CAMGE TT,NHLNS ;ALSO IF THIS WOULD BE DISPLAYED PAST END OF LINE
POPBP1: AOS -1(P) ;SUCCESS RETURN
JRST POPBPJ
;TAKE CARE OF THE POSSIBILITY THAT CHANGING THE BUFFER AFTER PT MAY
;CHANGE WHAT APPEARS ON THE SCREEN BEFORE PT. (FOR EXAMPLE,
;INSERTING OR DELETING A LF AFTER A CR.)
;FOLLOW A CALL TO RRCRDI WITH AN INSN THAT CHANGES THE BUFFER
;AFTER PT, BUT DOESN'T CHANGE PT, AND DOESN'T CLOBBER BP OR T.
;ON RETURN, PT IS UNCHANGED, RRHPOS AND RRVPOS
;ARE CORRECT, AND BP,T CONTAIN THE V AND HPOS OF A PLACE ON THE SCREEN
;BEFORE WHICH NOTHING NEEDS TO CHANGE.
;CLOBBERS A,B,TT,TT1,IN,OUT
RRCRDI: SAVE CH
SAVE PT
CALL RRCRDB ;MOVE BACK TO BEFORE ALL BEFORE-EFFECTS.
MOVE IN,PT
CAMN IN,(P) ;IF WE DIDN'T MOVE BACK AT ALL, NO PROBLEM.
JRST RRCRDX
SUB IN,BEG ;ELSE REMEMBER HOW FAR BACK WE MOVED,
EXCH IN,(P) ;RELATIVE TO BEG IN CASE BUFFER MOVES.
MOVEM IN,PT ;GIVE PT THE RIGHT VALUE FOR USER'S RTN,
MOVE CH,-1(P) ;AND CH.
MOVE T,RRHPOS ;GET HPOS AND VPOS OF PLACE WE MOVED BACK TO,
MOVE BP,RRVPOS ;TO RETURN TO OUR CALLER.
XCT @-2(P) ;DO WHAT CALLER WANTED DONE.
MOVE IN,(P) ;SET PT TO WHERE WE MOVED BACK TO
ADD IN,BEG
EXCH IN,PT ;BUT REMEMBER ITS REAL VALUE.
MOVEM IN,(P)
RRCRD1: CALL RRFORW ;THEN MOVE FWD OVER WHAT WE MOVED
CAME IN,(P) ;BACK OVER.
JRST RRCRD1
SUB P,[1,,1]
JRST POPCH1
RRCRDX: MOVE T,RRHPOS ;NO PROBLEM OF BEFORE-EFFECTS, JUST
MOVE BP,RRVPOS ;RETURN THE HPOS AND VPOS, AND EXIT
SUB P,[1,,1] ;TO THE USER'S BUFFER-MUNGING INSN.
JRST POPCHJ
RRCRDB: MOVE IN,PT
SUBI IN,1 ;ARE WE AFTER A CR? IF SO, IT MAY CHANGE FORM.
CAMGE IN,BEGV
POPJ P, ;AT BEGINNING OF BUFFER, NO PROBLEM.
CALL GETCHR ;ARE WE AFTER A CR?
CAIN CH,^M ;IF SO, IT MIGHT CHANGE FORM.
CALL [ SKIPL DISPCR ;IF IT CAN COME OUT AS "^M"
JRST RRBACK ;THEN IT CAN PROPAGATE BEFORE-EFFECTS.
JRST POP1J] ;ELSE, IT GUARANTEES NO BEFORE-EFFECTS.
MOVE IN,PT
SUBI IN,2 ;IF IN HORIZ. POS. 0, AND
SKIPG RRHPOS
CAMGE IN,BEGV ;NOT NEAR THE BEGINNING OF BUFFER,
POPJ P,
CALL GETINC ;AND NOT SHORTLY AFTER A CR (NOTE THIS
CAIN CH,^M ;CATCHES A PRECEDING CRLF)
RET
CALL GETCHR
SKIPGE DISPBS ;AND NOT RIGHT AFTER A ^H THAT REALLY BACKSPACES (THEN MOVING BACK
CAIE CH,^H ;OVER IT WOULD UNDERESTIMATE!)
CALL RRBACK ;THEN MAYBE "!" MUST BE WRITTEN OR ERASED AT END OF PREVIOUS LINE.
POPJ P,
SUBTTL LEAVE ^R, UPWARD OR DOWNWARD
;ALTMODE - LEAVE ^R MODE.
RREXIT: SKIP A,RREBEG
JUMPN A,FSCREX ;IF COMING FROM M.^R$, DO A FS^REXIT$.
RREXI0: MOVE CH,QRB.. ;DON'T INHIBIT REDISPLAY AT NEXT OPPORTUNITY (UNLESS RRLEVM TYPES)
SETZM .QVWFL(CH)
TLO FF,FLNOIN ;EXECUTING COMMANDS CLOBBERS FLNOIN, SO RESTORE IT
MOVE A,DISPRR
SKIPGE -3(A)
JRST RREXI2 ;@V - LEAVE FLNOIN ON.
SKIPE A,RRLEVM ;IF EXITING ^R, RUN FS ^R LEAVE$.
CALL RRMACR
TLZ FF,FLNOIN
RREXI2: MOVE P,DISPRR
SUB P,[1,,1] ;POP OFF RET ADDR AT RRLP
REST DISPRR
CALL RRLEAV ;SET UP "RRE" VARIABLES.
SETOM ECHCHR ;A ^R COMMAND WHICH CALLS ^R SHOULDN'T HAVE ECHOING WHEN IT RETURNS.
ANDCMI FF,FRARG+FRARG2
SKIPE DISPRR ;IF EXITING THE OUTERMOST LEVEL OF ^R,
JRST RREXI1
CALL SETTTM ;TURN ON SYSTEM ECHOING AGAIN.
MOVE CH,QRB..
SKIPE A,.QCRMC(CH) ;EXECUTE THE SECRETARY MACRO IF ANY.
CALL MACXQ
RREXI1: REST C ;POP QREG PDL PTR SAVED AT ENTRY TO ^R
CALL FSQPU0 ;UNWIND PDL DOWN TO THAT LEVEL.
JRST POP1J
RRTHRW: MOVE CH,DISPRR ;RETURN TO ^R MAIN LOOP.
PUSHJ CH,SETP
MOVEI TT,RRLP ;RETURN TO IT AT NORMAL RETURN, NO MATTER WHERE WE LEFT IT FROM.
MOVEM TT,(P)
.I RRLAST=RRPRVC ;MAKE SURE ARGS GET FLUSHED.
JRST RREAR0 ;WE'RE COMING FROM OUTSIDE ^R, SO MUST OFFICIALLY RE-ENTER.
RRLEAV: .I RREZ=Z
.I RREBEG=BEG
RRLEA1:
RRLEA2: .I RREPT=PT
.I RREHPS=RRHPOS
.I RREVPS=RRVPOS
.I RREBUF=BFRSTR
RET
;[ ;HANDLE THE ^] COMMAND IN ^R MODE.
;CLOBBERS ALL ACS. SKIPS.
RRBRC: SKIP
MOVEI A,[ASCIZ /[0[1 MU0:I1
<@V@:FT 0 FIU0 :I1 1 0 Q0- ."N0;'>
F@:M(:I* F@:M 1(]1]0) ) /]
RRMAC0: SKIP ;SUPPLY ^R-STYLE NUMERIC ARG AS ARG TO MACRO.
MOVEM C,NUM ;SUPPLY THE COMMAND'S ARG, OR 1 (THE DEFAULT), TO THE MACRO,
TRZ FF,FRARG
SKIPE RRARGP
RRMAC6: IORI FF,FRARG ;AND TELL IT IT HAS AN ARG IF THE ARG IS NON-DEFAULTED.
JRST RRMAC5
;CALL THE MACRO IN A WITH NO ARG., AND LOOK AT ITS RETURNED VALUES TO DECIDE
;HOW TO UPDATE THE ^R-MODE VARIABLES.
RRMACR: ANDCMI FF,FRARG
SETZM NUM
RRMAC5: SETZM SARG
TRZ FF,FRARG2 ;IN ANY CASE THE MACRO DOESN'T HAVE 2 ARGS.
RRMAC7: ANDCMI FF,FRCLN\FRSYL\FROP ;TURN OFF RANDOM FLAGS.
SKIPE RREBEG ;IF WE HAPPEN TO BE CALLED FROM TECO COMMANDS, NOT ^R ITSELF,
JRST MACXQW ;DON'T INTERFERE WITH THE "RRE" VARIABLES. JUST CALL THE MACRO.
CALL RRLEAV ;SET UP THE "RRE" VARIABLES.
CALL MACXQW ;EXECUTE THE MACRO.
JRST RREAR0
SUBTTL PROCESS ARGUMENTS/VALUES GIVEN TO ^R
RREAR0: TLO FF,FLNOIN ;EXECUTING COMMANDS CLOBBERS FLNOIN, SO RESTORE IT
MOVE A,DISPRR
SKIPL -3(A)
TLZ FF,FLNOIN ;TO SAY WHETHER THIS IS ^R OR @V.
RREARG: SKIPE ECHOFL
CALL NOECHO
RREAR1: CALL VBDACU ;MAKE SURE FS ALTCOUNT IS IN PHASE WITH REALITY
JFCL
MOVE C,NLINES
CALL WINSET ;COMPUTE SIZE AND POS OF WINDOW, SET RRTOPM. RRBOTM, BOTLIN, VSIZE.
MOVMS DISTRN ;TRUNCATION SCREWS ^R-MODE.
MOVE T,BFRSTR
CAME T,RREBUF ;IF BUFFER HAS BEEN SWITCHED ON US, RECOMPUTE THE DISPLAY!
SETOM RRMNVP
.I RRHPOS=RREHPS
.I RRVPOS=RREVPS
MOVE A,BEG ;RELOCATE ALL ^R-MODE POINTERS INTO BUFFER.
SUB A,RREBEG
SETZM RREBEG ;DECLARE ^R IN CONTROL; PREVENT ^G INT LVL QUIT.
ADDM A,RREPT
ADDM A,RREZ
SKIPN RGETTY
JRST RRTTY
CALL RRFXRL ;RELOCATE LINBEG TABLE BY A.
MOVE BP,TOPLIN
MOVE T,GEA ;IF CURRENT FS WINDOW$ IS NOT CONSISTENT WITH LINBEGS,
ADD T,BEGV ;WE SHOULDN'T HAVE BEEN FED ANY ARGS,
LDB B,[3300,,LINBEG(BP)]
CAMN B,T
CAMLE B,ZV ;SO FLUSH THEM. SAME GOES IF FS WINDOW$ IS IMPOSSIBLE.
TRZ FF,FRARG
MOVE C,QRB..
SKIPE TT,MORFLF ;IF OUR MACRO RAN INTO A --MORE--FLUSHED,
SETOM TYOFLG ;DON'T LET IT STAY AROUND TO PLAGUE NEXT COMMAND,
; SKIPE MORFLF
; SETZM .QVWFL(C) ;AND WE CAN ALSO REDISPLAY RIGHT NOW.
;REMOVED SO THAT FLUSHING WITH A RUBOUT WILL CAUSE REDISPLAY AFTER THE NEXT INPUT CHAR.
;IS NOT EXPECTED TO AFFECT WHAT HAPPENS WHEN YOU FLUSH WITH NON-RUBOUT.
SETZM MORFLF
MOVEM TT,OLDFLF
MOVE TT,MORESW
SKIPN .QVWFL(C) ;DOES STUFF ON SCREEN WANT TO BE PRESERVED?
JRST [ CAIE TT,MS%FLS ;NO: BUT IF MODE LINE SAYS --MORE--FLUSHED,
JRST RREAR2 ;WE MUST ACT TO PREVENT LOSS AT RRLP3.
JRST RREAR4]
SETZM .QVWFL(C)
CALL TYINH ;YES: WAIT TILL USER TYPES A CHARACTER SAYING
CAIE CH,40
MOVEM CH,UNRCHC ;HE HAS READ THE STUFF (DON'T FLUSH THE CHARACTER UNLESS IT'S A SPACE)
RREAR4: CALL RRLRDS ;NOW MAKE SURE THAT THE BUFFER IS REDISPLAYED AFTER THIS CHARACTER
SETZM RRMSNG ;NOTE LINES MAY NEED REDISPLAY EVEN THOUGH AFTER RRMAXP.
SETZM ERRFL1 ;NO NEED TO PROTECT AN ERROR MESSAGE PAST NEXT INPUT CHARACTER.
RREAR2: MOVE C,NUM ;GETARG WANTS 2ND VALUE IN C.
MOVE E,SARG ;AND 1ST VALUE IN E.
SKIPL RRMNVP ;*IF THIS IS A SCREW, AT LEAST DO THIS IN RREAR3*
TRNN FF,FRARG ;MACRO RETURNED NO ARG =>
JRST RRMAC1 ;DON'T ASSUME ANYTHING.
SKIPGE GEA ;PREVENT CONFUSION IF ALREADY KNOW GOING TO DO FULL REDISPLAY.
JRST RRMAC1
TRNN FF,FRARG2 ;1 ARG => ONLY PT HAS CHANGED.
JRST RREAR5
CAML E,C ;2 ARGS.
EXCH C,E ;DO F^@ - PREVENT 2<1 ERROR BY ORDERING THE ARGS PROPERLY.
CALL GETANU ;TURN MACRO'S VALUES INTO CHAR ADDRS.
CALL RRLMOV ;FIND VPOS IN BP OF LOWEST UNCHANGED LINE.
JRST RRMAC3 ; CHANGES ARE BELOW SCREEN, NOTHING TO DO.
CAMGE BP,TOPLIN
JRST RREAR3 ;IF CHANGES REACH PAST TOP, SCROLL DOWN.
MOVE TT,Z
SUBM TT,RREZ ;RREZ _ CHANGE IN # CHARS IN BUFFER.
SAVE PT
CALL RRHMOV
CALL RRCRDB ;MOVE BACK TO ELIMINATE BEFORE-EFFECTS.
REST E ;WE ARE JUST BEFORE 1ST PLACE ON SCREEN
MOVE BP,RRVPOS ;THAT WAS CHANGED. MARK THIS AS PLACE
MOVE T,RRHPOS ;THAT REDISPLAY MUST START BEFORE.
CALL RRDLB2 ;UPDATE RRMNVP AND RRMNHP.
CALL RRQMOV ;GET BACK CORRECT PT, MOVE FWD TO THERE, GETTING CORRECT HPOS AND VPOS.
MOVE E,C
MOVE A,RREZ
JRST RRFXMX ;UPDATE RRMAXP.
;COME HERE IF ONE ARG (ONLY POINT HAS CHANGED). IN CASE THAT ASSUMPTION IS FALSE,
;CHECK IT JUST ENOUGH TO AVOID CRASHING IF IT'S EXTREMELY FALSE.
RREAR5: MOVE TT,RRMNVP ;IF TEXT HAS BEEN CHANGED ENOUGH THAT
CAIGE TT,777777 ;THE TEXT WE EXPECT TO START DISPLAY AT
JRST RREAR6
MOVE TT,BOTLIN
SUBI TT,1
RREAR6: LDB TT,[003300,,LINBEG(TT)]
CAMLE TT,ZV ;IS NOW A NONEXISTENT ADDRESS,
JRST RRMAC1 ;THEN DO FULL REDISPLAY SO WE DON'T CRASH LATER.
JRST RRMAC3 ;OTHERWISE NO ADDITIONAL REDISPLAY IS NEEDED.
;HERE FOR CHANGES THAT REACH PAST TOP OF SCREEN.
;FIGURE OUT WHERE CHANGES STOP, AND CHOOSE A NEW WINDOW TO PUT THAT POINT
;ON THE SAME LINE WHERE IT IS NOW, THUS AVOIDING REDISPLAYING THE UNCHANGED TEXT.
RREAR3: MOVE A,Z
SUB A,RREZ
MOVE E,C ;FIRST, ADJUST RRMAXP FOR THE CHANGES MADE.
CALL RRFXMX
CALL RRLID2 ;THEN, FIND 1ST UNALTERED LINE'S POS IN BUFFER AND SCREEN
JRST RRMAC1 ;THERE IS NONE => DO FULL REDISPLAY.
MOVE A,RRIDVP ;A GETS THAT LINE'S VPOS.
SUB A,TOPLIN
LDB E,[014300,,A]
ADD A,E ;IF IT IS IN THE BOTTOM 1/3 OF THE SCREEN,
ADD A,TOPLIN
CAML A,BOTLIN ;MIGHT AS WELL RE-CENTER THE WHOLE THING.
JRST RRMAC1
SAVE PT
LDB A,[3300,,RRIDLB]
MOVEM A,PT ;OTHERWISE, PICK A WINDOW THAT DOESN'T REQUIRE IT TO MOVE.
MOVE A,RRIDVP ;CALCULATE WINDOW PUTTING PT AT VPOS IN A.
CALL VBDBL1
MOVEM B,RRVPOS
MOVE A,RRIDLB ;OK, POINT OF LAST CHANGE HASN'T MOVED ON SCREEN,
ASH A,-33 ;BUT CURSOR MIGHT NOT BE AT THE END OF CHANGED REGION.
MOVEM A,RRHPOS ;SO FIGURE OUT WHERE THE CURSOR IS.
REST E
CALL RRMOV
;HERE TO SAY REDISPLAY MUST START AT THE TOP OF THE SCREEN, BUT NOT REQUIRE TESTING THE WINDOW.
;SAYS NOTHING ABOUT WHERE REDISPLAY NEEDS TO END.
RRLRDS: MOVE TT,TOPLIN ;NOW THAT WINDOW HAS BEENCHANGED, EVERY LINE NEEDS REDISPLAY.
CAMGE TT,RRMNVP ;IF RRMNVP IS -1, DON'T FORGET THAT FACT!
MOVEM TT,RRMNVP
SETZM RRMNHP
MOVE A,GEA ;AND WE MUST SET UP FIRT LINE'S LINBEG SO DISPLAY STARTS OFF RIGHT.
ADD A,BEGV ;WE COULD JUST SETOM RRMNVP, BUT THEN THE WINDOW, WHICH WE KNOW IS
MOVEM A,LINBEG(TT) ;VALID, WOULD BE WASTEFULLY REBLESSED.
RET
;FIGURE OUT CURRENT CURSOR POSITION OF CHAR ADDR IN E.
;USES THE OLD LINBEGS AND RRMNVP, AS A SHORTCUT.
RRQMOV: CALL RRLMOV
JFCL
CAMGE BP,TOPLIN
MOVE BP,TOPLIN
;ASSUMES BP WAS SET UP BY CALLING RRLMOV.
RRHMOV: MOVEM BP,RRVPOS ;SET PT, RRVPOS AND RRHPOS TO VALUES
LDB TT,[3300,,LINBEG(BP)]
MOVEM TT,PT ;AT START OF LINE ON WHICH 1ST CHANGE LIES.
MOVE TT,LINBEG(BP) ;THOSE ARE STILL VALID, SINCE NOTHING CHANGED ABOVE THEM.
ASH TT,-33
MOVEM TT,RRHPOS
JRST RRMOV ;THEN SCAN FROM THERE TO THE DESIRED POINT.
;FIND IN BP THE VERTICAL POSITION OF THE LOWEST LINE
;WHICH, AS OF LAST DISPLAY (NOT, NOT, NOW) BEGAN BEFORE THE CHAR ADDR IN E.
RRLMOV: MOVE BP,RRMNVP
CAMN BP,[377777,,777777]
JRST RRLMO1
LDB TT,[3300,,LINBEG(BP)]
CAMGE TT,E
JRST POPJ1
RRLMO1: MOVE BP,TOPLIN
SOS BP
RRMAC2: MOVEI TT,1(BP)
CAME BP,RRMNVP ;WE CAN'T USE A VPOS WHOSE LINBEG DOESN'T EXIST OR ISN'T VALID.
CAMN TT,BOTLIN
JRST POPJ1
LDB TT,[3300,,LINBEG+1(BP)]
CAML TT,RROLZV ;IF CHANGES WERE INSERTION AT END OF BFR, WE WANT TO FIND THE LINE
JRST [ CAMGE BP,TOPLIN ;WHICH CONTAINS THE LAST OF THE OLD TEXT CHARACTERS.
MOVE BP,TOPLIN ;INSERTION INTO EMPTY BUFFER IS A CHANGE STARTING WITH LINE 0.
JRST POPJ1]
;IF CHANGES START AT 1ST CHAR OF NEXT LINE, WE NEED NOT SCAN THIS LINE,
CAMN TT,E ;UNLESS NEXT LINE STARTS IN MID-CHARACTER,
SKIPL LINBEG+1(BP) ;IN WHICH CASE THE CHAR REALLY BEGINS ON THIS LINE.
CAMLE TT,E ;IF CHANGES START BEFORE NEXT LINE, MUST SCAN THIS LINE.
JRST POPJ1
;THIS CHANGED FROM CAML SO THAT ^K'ING TOP LINE OF SCREEN
;WOULD NOT END UP SAYING CHANGES REACH PAST TOP OF SCREEN, ETC.
AOJA BP,RRMAC2 ;IF CHANGES START AFTER END OF LINE, NEED NOT SEARCH IT.
;UPDATE THE "MINIMUM SCREEN POSITION THAT CHANGED"
;USING DICTIONARY ORDER ON RRVPOS, RRHPOS.
;TAKES VPOS, HPOS OF START OF NEW CHANGE IN BP, T.
;CLOBBERS T.
RRDLB2: CAML BP,BOTLIN ;DON'T EVER LET RRMNVP BECOME AS LARGE AS BOTLIN.
JRST [ MOVE BP,BOTLIN
SOJA BP,.+1]
CAMLE BP,RRMNVP
POPJ P,
CAMGE BP,TOPLIN ;DON'T ALLOW RRMNVP TO BECOME LESS THAN TOPLIN.
SETO BP, ;MAKE IT -1 (WHICH IS SPECIAL) IF CHANGES GO OFF TOP.
EXCH BP,RRMNVP
CAMG BP,RRMNVP
CAMG T,RRMNHP
MOVEM T,RRMNHP
CAMN BP,RRMNVP
RET
MOVE T,RRMAXP ;IT CAN LEGITIMATELY HAPPEN THAT LINBEGS BEFORE
CAILE T,1 ;THE OLD RRMNVP ARE SMALLER THAN THE OLD RRMAXP.
CAMLE T,LINBEG(BP) ;IF SO, IF WE MOVE RRMNVP UP AND DON'T CHANGE
RET
SKIPL RRMSNG ;RRMAXP MUCH OR AT ALL, WE COULD FORGET ABOUT
CAMG BP,RRMSNG ;THE CHANGES BELOW THE OLD RRMNVP.
MOVEM BP,RRMSNG ;SO USE RRMSNG TO REMEMBER THEM.
POPJ P,
RRFXM1: MOVE E,PT
CALL RRDLB2
;UPDATE RRMAXP. SIGNED # CHARS INSERTED OR DELETED IN A,
;PLACE INSERTED OR DELETED IN E.
RRFXMX: MOVE T,RRMAXP ;NOTE RRMAXP MAY HAVE THE SPECIAL VALUE INFINITY (LARGEST POS NUMBER)
AOS T
CAILE T,1 ;IN WHICH CASE IT SHOULDN'T BE RELOCATED.
ADDM A,RRMAXP ;RELOCATE OLD VALUE IN CASE IT'S ABOVE WHERE CHANGE HAPPENED.
CAML E,RRMAXP
MOVEM E,RRMAXP ;MAKE SURE RRMAXP IS ABOVE PLACE CHANGE HAPPENED.
POPJ P,
;SET PT TO VALUE IN E, UPDATING CURSOR POS.
;CLOBBERS A,B,TT,TT1,IN,OUT
RRMOV: CAMN E,PT ;PT SAME AS MARK => DO NOTHING.
POPJ P,
MOVE A,E
SUB A,PT ;MOVING A LONG DISTANCE => DON'T BOTHER TO KEEP TRACK OF
MOVMS A ;CHANGES IN VPOS AND HPOS. JUST GO THERE AND RECOMPUTE HPOS.
CAIL A,10000.
SKIPN RGETTY
CAIA
JRST RRMOVL
CAML E,PT
JRST RRMOVF ;PT BEFORE DESIRED PT => GO FWD.
RRMOVB: CALL RRBACK
CAMN E,IN ;REACHED THE DESIRED PT YET?
RET
SKIPL A,RRVPOS ;GONE ABOVE TOP OF SCREEN?
JRST RRMOVB
MOVNS A ;ON TERMINAL WITH INSERT/DELETE LINE, KEEP TRACK OF VPOS
ADD A,TOPLIN
CAMGE A,VSIZE ;TILL WE GET A SCREEN HEIGHT ABOVE THE TOP OF THE SCREEN.
SKIPN LID ;UNTIL THAT POINT, THERE MAY BE SOME ADVANTAGE IN SCROLLING
CAIA ;THE SCREEN DOWN, AND FOR THAT WE NEED TO KEEP THE VPOS.
JRST RRMOVB
RRMOVL: MOVEM E,PT ;IT'S PROBABLY FASTER TO REQUEST COMPLETE RECOMPUTATION.
JRST RRMAC1
RRMOVF: MOVE TT,RRVPOS
ADDI TT,3
SAVE TT
RRMOVG: CALL RRFORW
CAMN E,IN
JRST POP1J
MOVE TT,RRVPOS
MOVE TT1,(P) ;IF GO AT LEAST 3 LINES (FOR RRTTY'S SAKE, TO AVOID HAVING LONG JUMPS
CAML TT,TT1 ;LOOK LIKE MOTION TO NEXT LINE) AND
CAMG TT,BOTLIN ;GONE BELOW BOTTOM OF SCREEN, THEN DON'T BOTHER SCANNING IT OUT.
JRST RRMOVG
SUB TT,BOTLIN ;ON TTY WITH INSERT/DELETE LINE, KEEP TRACK OF VPOS
CAMGE TT,VSIZE ;TILL A SCREEN HEIGHT BELOW THE BOTTOM, IN CASE WE CAN
SKIPN LID ;SAVE DISPLAY BY SCROLLING THE TEXT UPWARD.
CAIA
JRST RRMOVG
SUB P,[1,,1]
JRST RRMOVL
;<M>,<N>F^R - REPORT CHANGES BETWEEN <M>,<N> TO ^R WITHOUT DISPLAYING ANYTHING.
;F^R TELLS ^R NOT TO REMEMBER ANYTHING FROM ITS PREVIOUS DISPLAYING.
;:F^R FORCES A VALID FS WINDOW$ TO BE CALCULATED NOW.
;SET FS WINDOW TO -1 FIRST, TO FORCE A NEW WINDOW TO BE COMPUTED FROM SCRATCH.
;DO A F^R FIRST TO AVOID ASSUMING THAT FS ^R VPOS$ IS VALID.
;<VPOS>:F^R CHOOSES A WINDOW THAT PUTS POINT ON LINE <VPOS>+FS TOPLIN$
;A NEGATIVE <VPOS> COUNTS FROM THE BOTTOM OF THE USABLE WINDOW.
;IF THE WINDOW IS CHANGED, THAT FACT IS REPORTED TO ^R IMMEDIATELY,
;SO YOU CAN RETURN ONE VALUE TO ^R IF YOU ARE SURE YOU DON'T INVALIDATE IT.
;@:F^R IS LIKE :F^R EXCEPT THAT, IF INSERT/DELETE LINE ARE AVAILABLE,
;IT IMMEDIATELY SHIFTS STUFF ON THE SCREEN TO REDUCE EVENTUAL REDISPLAY.
;<TOP>,<BOTTOM>@ F^R SAYS LINES FROM TOP (INCLUSIVE) TO BOTTOM (EXCLUSIVE) NEED REDISPLAY.
RRALTR: TRNE FF,FRCLN
JRST RRALT1
TRNE FF,FRUPRW ;@F^R IS FOR EXITING THE MINIBUFFER.
JRST RRMNX
TRNN FF,FRARG ;NO ARG => SAY ALL HAS CHANGED.
JRST RRMAC1
TRNN FF,FRARG2 ;1 ARG => SAY NOTHING HAS. ^R WILL KNOW ANYWAY
RET ;IF POINT HAS BEEN CHANGED.
MOVE C,NLINES
CALL WINSET ;COMPUTE SIZE AND POS OF WINDOW, SET RRTOPM. RRBOTM, BOTLIN, VSIZE.
MOVE A,BEG ;2 ARGS => REPORT MODIFICATIONS TO PART OF BUFFER.
SUBM A,RREBEG
EXCH A,RREBEG
CALL RRFXRL
CALL [ SKIPE RGETTY
JRST RREAR2
JRST RRTTY]
.I RREZ=Z
JRST RRLEA2
RRALT1: SKIPGE C ; :F^R COMES HERE.
ADD C,VSIZE ;A NEGATIVE ARG COUNTS FROM WINDOW BOTTOM.
ADD C,TOPLIN ;ALL ARGS ARE RELATIVE TO WINDOW, NOT ABSOLUTE ON SCREEN.
MOVE A,C
TRNE FF,FRARG ;NO ARG => TEST OLD WINDOW, BASED ON RRVPOS.
JRST RRALT2
SKIPL GEA ;OLD WINDOW NOT KNOWN OR RRVPOS REPORTED SUSPECT =>
SKIPGE RRMNVP
JRST RRALT7 ;SKIP THE FAST CHECK, AND DO ORDINARY BLESSING.
MOVE B,PT ;THE FAST CHECK IS ONLY APPLICABLE WHEN POINT IS
CAME B,RREPT ;AT THE PLACE WE HAVE REMEMBERED THE VPOS OF.
JRST RRALT7
CALL RRWBLS
CAIA ;FAST CHECK APPLICABLE AND LOSES => NEW WINDOW CERTAINLY NEEDED,
RET
RRALT6: SETOB A,GEA ; SO TELL VBDBLS NOT TO BOTHER WITH THE OLD ONE.
RRALT2: CAML A,TOPLIN
CAML A,BOTLIN
RRALT7: SETO A,
SAVE GEA
SAVE RRVPOS
CALL VBDBLS
REST E ;E HAS PREVIOUS VPOS OF POINT.
REST A ;A HAS PREVIOUS ADDRESS OF TOP LINE.
MOVEM B,RREVPS ;B HAS NEW VPOS OF POINT.
MOVEM B,RRVPOS
.I RREHPS=CHCTHP
.I RREPT=PT ;WHEN WE RETURN TO ^R IT SHOULD KNOW WHICH POINT RREVPS REFERS TO.
CAMN A,GEA ;IF THE WINDOW IS ACTUALY CHANGED,
RET
SKIPE LID ;AND WE CAN'T OR SHOULDN'T MOVE THE TEXT,
TRNN FF,FRUPRW
JRST RRALT5
SKIPL RRMNVP
JRST RRALT3
RRALT5: SETZM RRMSNG ;JUST TELL ^R THAT EVERY LINE NEEDS REDISPLAY BUT WINDOW IS OK.
SKIPN TOPLIN
SKIPE NLINES
JRST RRLRDS
SKIPE NOCEOL ;IF TTY HAS NO CLEOL, IT IS FASTER TO CLEAR THE SCREEN FIRST.
SETOM PJATY
JRST RRLRDS
;HERE TO TRY TO MOVE TEXT ON THE SCREEN WITH INSERT/DELETE LINE
RRALT3: MOVN C,B ;HOW FAR ARE WE MOVING TEXT, AND WHICH WAY?
ADD C,E
MOVM E,C ;GET MAGNITUDE OF DISTANCE MOVED.
CAML E,VSIZE ;MOVING MORE THAN SCREEN HEIGHT => ALL OF OLD WINDOW GOING OFF SCREEN
JRST RRALT5 ;SO DON'T BOTHER WITH THIS.
MOVE BP,TOPLIN ;THE LINE THAT WILL MOVE TO POSITION TOPLIN
MOVE E,C ;IS NOW ON THE SCREEN AT POSITION TOPLIN+C(C).
ADD E,BP ;TELL DSLID WHAT THAT POSITION IS.
MOVEM E,RRIDVP ;FOR DOWNWARD MOTION, THAT LINE IS FICTITIOUS, BUT DSLID KNOWS THAT.
JUMPL C,RRALT4
;MOVING UP => PRETEND DELETED THE FIRST FEW LINES ON THE SCREEN.
CAML E,RRMNVP ;CAN'T WIN IF CHANGES TO TEXT EXTEND ABOVE WHAT WILL BECOME
JRST RRALT5 ;THE FIRST LINE ON THE SCREEN, SINCE IN THAT CASE ITS LINBEG IS WRONG.
MOVE TT,LINBEG(E)
MOVEM TT,RRIDLB ;RRIDLB GETS LINBEG OF WHAT WILL BECOME THE TOP LINE ON SCREEN.
MOVE TT,RRMNVP ;RRMNVP MOVES UP WITH THE TEXT.
CAMN TT,[SETZ-1]
MOVE TT,BOTLIN ;IF RRMNVP HAD BEEN INFINITE, SET IT TO THE FIRST OF THE NEWLY
SUB TT,C ;INSERTED BLANK LINES ABOVE THE MODE LINE.
SOS TT ;DECREMENT AGAIN TO REACH LOWEST LINE THAT HAS A VALID LINBEG.
MOVEM TT,RRMNVP ;NOTE IT CAN'T GO PAST TOPLIN, DUE TO CAML E,RRMNVP ABOVE.
SOS BP
CALL DSLID ;MOVE THE STUFF UP, RIGHT NOW. BP HAS -1 PLUS LINE WE ARE "AT".
JRST RRALT5 ;IF DSLID DECIDED TO ABORT, THAT'S OK. JUST REDISPLAY.
JRST RRLID5 ;GO DO BOOKKEEPING FOR MOTION JUST DONE.
RRALT4: AOS RRIDVP ;COMPENSATE FOR DIFFERENT MEANING OF THIS AND BP IF MOVING TEXT DOWN.
CALL DSLID ;MOVE IT.
JFCL
MOVE CH,RRIDLB ;SAY THAT CHANGES REACH PAST ALL THE BLANK LINES JUST MADE
TLZ CH,777000 ;AT THE TOP OF THE SCREEN. JUST SETTING RRMSNG DOESN'T WORK
ADDI CH,1 ;SINCE RRLID RUNS AND THINKS THAT THOSE BLANK LINES CONTAIN
CAML CH,RRMAXP ;VALID TEXT. BUT RRMAXP AS SET HERE SAYS THAT TEXT IS USELESS.
MOVEM CH,RRMAXP
JRST RRLRDS ;THEN SAY EVERY LINE MIGHT NEED REDISPLAY.
;HERE FOR <TOP>,<BOTTOM>@ F^R SAYING LINES FROM TOP (INCLUSIVE) TO BOTTOM (EXCLUSIVE)
;NEED REDISPLAY.
RRMNX: CAML C,RRMNVP ;HANDLE END OF RANGE OF VPOS'S BY SETTING RRMAXP TO CORRESPOND TO IT,
JRST RRMNX1 ;OR, IF LINBEGS AROUND THERE ARE UNKNOWN, BY SETTING RRMSNG.
LDB T,[3300,,LINBEG(C)]
MOVEM T,RRMAXP
JRST RRMNX2
RRMNX1: MOVEM E,RRMSNG ;HERE, SAY ALL LINES PAST TOP OF RANGE MIGHT NEED REDISPLAY.
RRMNX2: MOVE BP,E ;HANDLE BEGINNING OF RANGE OF VPOS'S BY SETTING RRMNVP THERE.
SETZ T,
JRST RRDLB2
;<M>,<N>FM - MOVE DOWN TO HPOS <N>, <M> LINES DOWN.
;<M>,<N>@FM - MOVE UP TO HPOS <N>, -<M> LINES UP.
;NORMALLY, EXACT VALUE OF HPOS IS NEEDED TO STOP SCAN.
;BUT COLON MODIFYER => ANY LARGER HPOS IS ALSO OK.
;IF SCAN DOESN'T FIND AN ACCEPTABLE HPOS ON THE DESIRED LINE
;THEN EITHER A NIB ERROR OR A NHP ERROR WILL RESULT.
;FM TRIES TO AVOID STOPPING BETWEEN A CR AND ITS LF.
FMCMD: TRNE FF,FRARG2
TRNN FF,FRARG
TYPRE [WNA]
CALL RRBTCR ;MAKE SURE RRHPOS IS CORRECT FOR CURRENT BUFFER AND PT.
ADD E,RRVPOS ;E IS DESTINATION VPOS.
MOVE IN,PT
TRNE FF,FRUPRW
JRST FMBACK ;NOW FORWARD AND BACKWARD MOTION DIVERGE.
FMFWD: CAMGE E,RRVPOS ;IF WENT PAST TARGET LINE, WITHOUT STOPPING ON IT, BARF.
JRST [ CALL RRBCRL ;MOVE BACK TO END OF DESIRED LINE.
TYPRE [NHP]]
CAME E,RRVPOS ;IF HAVE REACHED TARGET VPOS,
JRST FMFWD1
TRNE FF,FRCLN
CAML C,RRHPOS ;AND HAVE REACHED TARGET HPOS,
CAMN C,RRHPOS
RET
FMFWD1: CAML IN,ZV
TYPRE [NIB] ;AT END OF BUFFER WITHOUT REACHING TARGET => BARF.
CALL RRFORW
JRST FMFWD
FMBACK: CAMLE E,RRVPOS ;WENT PAST TARGET VPOS WITHOUT FINDING TARGET HPOS => BARF.
JRST [ CALL RRFCRL ;RETURN TO DESIRED LINE BEFORE COMPLAINING.
TYPRE [NHP]]
CAME E,RRVPOS ;REACHED TARGET VPOS
JRST FMBAC1
TRNE FF,FRCLN
CAML C,RRHPOS
CAMN C,RRHPOS
RET
FMBAC1: CAMG IN,BEGV
TYPRE [NIB]
CALL RRBCRL
JRST FMBACK
;MOVE FORWARD OVER EITHER A SINGLE CHAR OR A CRLF.
RRFCRL: CALL RRFORW
CAIE CH,^M
RET
CALL GETCHR
CAIE CH,^J
RET
JRST RRFORW
;MOVE BACKWARD OVER EITHER A SINGLE CHAR OR A CR-LF PAIR.
RRBCRL: CALL RRBACK ;MOVE BACK 1 CHAR,
CAIE CH,^J ;AND IF THAT LEAVES US BETWEEN A CR AND ITS LF,
RET ;MOVE BACK 1 MORE.
SOS IN
CALL GETINC
CAIE CH,^M
RET
JRST RRBACK
SUBTTL ^R COMMAND DISPATCH TABLE MANAGEMENT
;<CHAR>FS ^R INIT$ RETURNS THE INITIAL SETTING OF <CHAR>FS ^R CMAC$.
;THE UPARROW FLAG HAS THE SAME MEANING AS FOR FS ^R CMAC$.
FSCRIN: TRZN FF,FRARG
TYPRE [WNA]
CALL TYIABN ;IF DON'T HAVE UPARROW FLAG, CONVERT ASCII ARG TO 9-BIT.
MOVEI CH,(C)
TRZN CH,META
TRNN C,CONTRL
SKIPA A,[RRXINS] ;META OR NON-CONTROL CHARS ARE SELF-INSERTING (EXCEPT RUBOUT)
MOVEI A,RRUNDF ;MOST CONTROLS ARE ERRORS.
LDB Q,[.BP 177,CH]
CAIL Q,40+"A
CAILE Q,40+"Z
CAIA ;IF THE ASCII PART IS LOWER CASE,
MOVE A,[40,,RRINDR] ;IT IS A "RRINDR" CHAR (INDIRECT).
CAIN CH,CONTRL+33 ;CONTROL-ALTMODE GOES INDIRECT THROUGH ALTMODE.
MOVE A,[200,,RRINDR] ;AND SIMILAR FOR CONTROL-META-ALTMODE.
CAIL CH,CONTRL+^H ;SIMILAR FOR CONTROL-BS, CONTROL-TAB, CONTROL-LF,
CAILE CH,CONTRL+^J ;CONTROL-CR, AND META EQUIVALENTS.
CAIN CH,CONTRL+^M
MOVE A,[200,,RRINDR]
CAIL CH,CONTRL+"H
CAILE CH,CONTRL+"J
JRST FSCRI1
MOVE A,[300,,RRINDR]
JRST POPJ1
FSCRI1: CAIN C,33 ;ALTMODE ON TV IS NOT SAME AS CTL-[ ;]
MOVEI A,RREXIT
CAIN C,^M ;SIMILARLY, HANDLE CR (WHICH IS NOT CTL-M)
MOVE A,[RRCRLF,,RRREPT]
CAIL C,^H
CAILE C,^J
CAIA
MOVE A,[RRINSC,,RRREPI]
CAIL Q,"0 ;CONTROL, META AND C-M-DIGITS ALL ADD TO ARGUMENT TO NEXT CMD.
CAILE Q,"9
JRST FSCRI2
TRNE C,CONTRL+META
MOVEI A,RRCDGT
FSCRI2: CAIE Q,"- ;C-MINUS, M-MINUS AND C-M-MINUS ALL SET "NEGATE ARG" FLAG
JRST FSCRI3
TRNE C,CONTRL+META
MOVEI A,RRCMNS
FSCRI3: CAIN C,177 ;RUBOUT IS A RUBOUT.
MOVEI A,RRRUB
CAIN C,CONTRL+177 ;CTL-RUBOUT IS TAB-HACKING RUBOUT.
MOVEI A,RRCRUB
CAIL C,CONTRL+"@
CAILE C,CONTRL+"_
JRST POPJ1
SUBI C,CONTRL+"@ ;AS A LAST RESORT, LOOK CHAR UP IN RRITAB.
ROT C,-1
HRRZ A,RRITAB(C) ;INDEX TO HALFWORD OF INITIAL VALUE TABLE.
SKIPL C
HLRZ A,RRITAB(C)
TRZN A,400000 ;400000 BIT => DEFINITION GOES THROUGH RRREPT.
JRST POPJ1
HRLZS A
HRRI A,RRREPT
JRST POPJ1
;TABLE OF INITIAL ^R-MODE DEFINITIONS OF CONTROL CHARACTERS.
.SEE RRMACT ;CHANGE RRMACT WHEN YOU CHANGE THIS.
.BYTE 22
RRITAB: RRUNDF ;^@
RRBEG ;^A
RRCTLB ;^B
RRCMSW ;^C
RRCTLD ;^D
RREND ;^E
RRCTLF ;^F
RRQUIT ;^G
RRINDR ;CONTROL-H (THIS ENTRY NOT ACTUALLY USED)
RRINDR ;CONTROL-I "
RRINDR ;CONTROL-J "
RRKILL ;^K
RRCTLL ;^L
400000+RRINSC ;CONTROL M
RRNEXT ;^N
400000+RRCTLO ;^O
RRPREV ;^P
RRQUOT ;^Q
RRCMCS ;^R
RRSRCH ;^S
RRMARK ;^T
RR4TIM ;^U
RRARG ;^V
RRFX ;^W
RREXCH ;^X
RRUNDF ;^Y
RRUNDF ;^Z
RRUNDF ;CONTROL-[ ;]
RRUNDF ;^\
RRBRC ;[ ;^]
RRUNDF ;^^
RRUNDF ;^_
.BYTE
;GET OR SET THE MACRO ASSOCIATED WITH A CHARACTER
;(IF A CHAR HAS AN ASSOCIATED MACRO, WHEN THAT CHAR IS READ IN
;^R-MODE, THE MACRO IS CALLED INSTEAD OF THE USUAL ACTION FOR
;THAT CHARACTER.)
;^^<CHAR>FS^RCMAC$ GETS, Q<QREG>,^^<CHAR>FS^RCMAC$ SETS.
;CHARACTER IS ASSUMED TO BE ASCII. IF UPARROW FLAG IS ON,
;THE CHARACTER IS TREATED AS 9-BIT INSTEAD.
;DEPOSITS IN -1(P)! ASSUMES THE CALLER WAS THE FS COMMAND DISPATCH!
FSCRMA: TRZN FF,FRARG
TYPRE [WNA]
TRZE FF,FRARG2
IORI FF,FRARG ;2 ARGS => SETTING, ELSE GETTING.
CALL TYIABN ;IF FRUPRW OFF, CONVERT ASCII ARG TO 9-BIT.
MOVE E,C
MOVE C,SARG
CAIGE E,RRMACL ;LAST ARG OUT OF RANGE => ERROR.
SKIPGE E
TYPRE [AOR]
ADDI E,RRMACT ;E -> WORD TO BE SET OR GOTTEN.
HRLM E,-1(P) .SEE FSCALL
IFN TEXTIF&0,[
SETZM BRKVLD ;INDICATE THAT WE WILL HAVE TO CHANGE THE BREAK TABLE
];IFN TEXTIF&0
TRNN FF,FRARG ;IF CHAR IS BEING REDEFINED,
JRST FSNOR1
MOVE CH,E ;SET THE BIT IN RDFMSK FOR THIS CHARACTER
CALL USE5
JRST FSNOR1
TYIABN: TRZN FF,FRUPRW ;IF FRUPRW IS OFF, CONVERT ASCII CHAR IN C TO 9-BIT.
CAIL C,40
RET
CAIE C,33
CAIN C,^M
RET
CAIL C,^H
CAILE C,^J
ADDI C,300
RET
;<N> FS ^R IND RETURNS THE CHAR CODE THAT <N> INDIRECTS TO (MAY BE <N> ITSELF).
FSINDT: TRZ FF,FRARG ;FLUSH ARG OR WE WILL ADD TO IT.
CAIGE C,512.
CAIGE C,0
TYPRE [AOR]
HRRZ A,C ;INITIALLY ASSUME CHAR NOT INDIRECT.
FSIND1: HRRZ T,RRMACT(A)
CAIE T,RRINDR
JRST POPJ1 ;NOT INDIRECT => RETURN IT.
HLRE T,RRMACT(A) ;ELSE COMPUTE THE CHAR IT INDIRECTS TO.
SUB A,T
JRST FSIND1
;<START>,<VAL> F^S <Q> SEARCHES BUFFER IN <Q> STARTING AT WORD <START>
;FOR A WORD CONTAINING <VAL>. RETURNS IDX OF FIRST SUCH, OR -1 IF NONE.
;<START>,<VA.> :F^S SEARCHES ^R DEFINITION TABLE.
TABSRC: TRNN FF,FRARG
TYPRE [WNA]
MOVE J,[-RRMACL,,RRMACT]
TRNE FF,FRCLN ;COLON => SEARCH ^R DEFINITION TABLE.
JRST TABSR1
CALL QREGX ; ELSE READ QREG NAME
CALL QLGET0 ; GET BYTE POINTER AND LENGTH
TYPRE [QNS]
IBP BP ; INSURE WORD ALIGNED
HLRZ A,BP
CAIE A,350700
TYPRE [ARG]
MOVE T,B ; CONVERT BYTE COUNT TO WORD COUNT
IDIVI T,5
HRLOI J,-1(T) ; GET AOBJN POINTER
EQVI J,(BP) ; ...
TABSR1: HRLS E
ADD E,J ;1ST ARG IS # OF ENTRIES AT FRONT OF TABLE NOT TO TEST.
CAME C,(E)
AOBJN E,.-1
TRZ FF,FRARG\FRARG2\FRCLN\FRUPRW
JUMPGE E,NRETM1 ;RETURN -1 IF DON'T FIND THE OBJECT.
SUB E,J
HRRZ A,E
JRST POPJ1 ;ELSE RETURN INDEX FIRST FIND IT AT.
SUBTTL MISCELANEOUS ^R MODE COMMANDS
RRCTLL: SKIP ;^L COMMAND.
SKIPN RGETTY ;^L WITH ARG PRINTS SPEC'D # OF LINES (FOR PRINTING TTY'S).
JRST RRDISL
CALL CTLL
RRMAC1: SETOM RRMNVP ;CAUSE WINDOW TO BE TESTED,
SETZM RRMSNG ;AND THE WHOLE BUFFER TO BE REDISPLAYED.
JRST RRBTCR ;IN CASE THAT DOESN'T HAPPEN FOR A WHILE
;MAKE SURE WE HAVE A REASONABLE RRHPOS.
RRDISL: SETZM RUBENC ;HERE FOR <N>^L; DISPLAY <N> LINES OF BUFFER.
CALL CRR
CALL CRR
CALL WINSET ;SET WINDOW SIZE TO <N> LINES.
CALL VBDRR ;DO THE DISPLAY.
CALL RRDIS3 ;THEN DO A 0T SO USER SEES WHERE CURSOR IS.
MOVE C,NLINES ;RESTORE NORMAL WINDOW SIZE.
JRST WINSET
RRMAC3: ADDB A,RREPT ;RELOCATE OLD PT FOR BUFFER MOTION.
CAML A,BEGV ;OLD CURSOR-LOCATION NO LONGER INSIDE BUFFER =>
CAMLE A,ZV ;CAN'T MOVE FROM THERE, MUST REDISPLAY SLOW WAY.
JRST RRMAC1
MOVE E,PT
SKIPN RGETTY ;ELSE, USE EITHER RRMOV OR RRQMOV TO DETERMINE NEW VPOS/HPOS,
JRST RRMOV1 ;GUESSING WHICH ONE WILL BE FASTER; BUT ON TTY'S USE ONLY RRMOV.
MOVE TT,A
SUB TT,PT
MOVMS TT
CAIL TT,30.
JRST RRQMOV
RRMOV1: MOVEM A,PT ;THAT IS WHERE RRHPOS AND RRVPOS ARE RIGHT FOR.
JRST RRMOV
RRERST: SAVE Q
RRERS1: CAML CH,DISPRR ;POPPING OUT OF A MACXQ: POPPING OUT OF A ^R-INVOCATION?
JRST POPQJ
SOS Q,DISPRR ;IF SO, RESTORE DISPRR'S VALUE OUTSIDE THAT INVOCATION.
POP Q,DISPRR
SKIPE DISPRR ;IF THIS ^R WAS THE OUTERMOST,
JRST RRERS1
SAVE TT
SAVE TT1
SAVE CH
CALL SETTTM ;RESTORE NORMAL TTYSET.
REST CH
REST TT1
REST TT
JRST POPQJ
;RTNS TO HANDLE THE MARK.
;SET THE MARK AT PT.
RRMARK: SKIP
SKIPE RR4TCT ;^U^T EXCHANGES MARK WITH PT.
JRST RREXCH
RRMRK1: .I RRMKPT=PT-BEG
POPJ P,
;EXCHANGE THE MARK AND PT.
RREXCH: SKIP
SKIPGE E,RRMKPT
JRST RRERR ;NO MARK => CAN'T EXCHANGE.
ADD E,BEG ;TURN INTO CHAR ADDR.
SAVE PT ;REMEMBER NEW VALUE OF MARK.
CALL RRMOV ;MOVE PT TO OLD MARK.
REST TT ;SET MARK TO OLD PT.
SUB TT,BEG
MOVEM TT,RRMKPT
JRST RRTTY ;ON PRINTING TERMINAL, GO SHOW CURSOR MOTION.
;DO FX..K ON EVERYTHING FROM PT TO THE MARK.
RRFX: SKIP
SKIPGE A,RRMKPT
JRST RRERR
ADD A,BEG
CAMN A,PT ;DELETING NO CHARS =>
JRST RRFXXT ;DON'T CLOBBER QREG ..K.
CAMG A,PT
CALL RREXCH ;MAKE SURE PT IS BEFORE MARK.
MOVE E,PT
MOVE A,RRMKPT
ADD A,BEG
MOVE C,A
SUBM E,A
CALL RRFXMX ;SET RRMAXP
CALL RRCRDI ;WORRY ABOUT BEFORE-EFFECTS.
CALL [ CALL RRDLB2 ;SET RRMNVP, RRMNHP FROM T,BP.
MOVE CH,QRB..
ADDI CH,.QRRBF
CALL FXCMD2 ;DO THE FX. D _ AMOUNT BEG CHANGED.
MOVE A,D
JRST RRFXRL] ;RELOCATE VARIOUS PTRS THAT MUCH
RRFXXT: SETOM RRMKPT ;ELIMINATE THE MARK.
POPJ P,
;RELOCATE RR MODE'S VARIOUS PTR THAT ARE KEPT AS CHAR ADDRS,
;BY THE AMOUNT IN A. (IN CASE THE BUFFER WAS MOVED)
;CLOBBERS TT
RRFXRL: MOVE TT,RRMAXP ;NOTE THAT IF RRMAXP IS INFINITY IT SHOULDN'T BE CHANGED.
AOS TT
CAILE TT,1 ;ALSO IF IT IS ZERO.
ADDM A,RRMAXP
ADDM A,RROLZV
MOVE TT,TOPLIN
RRFXR1: CAMLE TT,BOTLIN
.VALUE
JUMPE A,[
MOVE TT,BOTLIN
RET]
RRFXR2: CAML TT,BOTLIN
RET
ADDM A,LINBEG(TT)
AOJA TT,RRFXR2
;KILL <ARG> LINES STARTING AT PT, AND PUT IN QREG ..K.
RRKILL: SKIP
CALL RRMRK1
CALL RRNEX1
JRST RRFX
;^S -- READ CHAR, AND SEARCH FOR THAT CHAR.
RRSRCH: SKIP
SAVE C
CALL RRECO1 ;MAYBE PROMPT WITH A ^S.
REST NUM
MOVEI A,[ASCIZ/FIU..0 :S ..0 /]
JRST RRMAC6
RRCTLB: SKIP ;^B MOVES BACKWARD - IT IS -^F.
MOVNS C
RRCTLF: SKIP ;^F MOVES FORWARD, BUT ON PRINTING TTY IT ECHOES.
AOS (P)
JUMPL C,RRCB1 ;WORK FOR NEGATIVE ARGS.
JSP E,RRREP1
MOVE IN,PT
CALL RREOLT
CALL RRFORW
JRST RRFORW
RRCB1: MOVNS C
JSP E,RRREP1
CALL RRBACK ;MOVE BACK AT LEAST ONE CHARACTER.
SOS IN
CAMLE IN,BEGV ;IF IT IS A LF, AND THE PRECEDING CHAR IS A CR,
CAIE CH,^J
RET
CALL GETCHR
CAIE CH,^M
RET
JRST RRBACK ;MOVE BACK OVER THAT AS WELL.
;JSP E,RRTYPP SKIPS UNLESS WE ARE SCANNING (SHOULD PRINT SCANNED CHARACTERS).
RRTYPP: SKIPN RGETTY
SKIPN RRSCAN
JRST 1(E)
JRST (E)
;^P -- WITH ARGUMENT <N>, DOES -<N>@L.
RRPREV: SKIP ;CALCULATE <N>,
MOVNS C
JRST RRNEX2 ;<N> IS -<N>.
;^A -- MOVE TO BEGINNING OF LINE.
;WITH ARGUMENT <N>, DOES <N>-1@L.
RRBEG: SKIP
SOJA C,RREND2
;^E -- MOVE TO END OF LINE (:@L). WITH ARGUMENT <N>, DO :<N>@L.
RREND: SKIP
RREND1: TRO FF,FRCLN
RREND2: AOS (P)
JRST RRNEX1
;^N -- MOVE TO BEGINNING OF NEXT LINE. (@L)
;WITH ARGUMENT <N>, DOES <N>@L.
RRNEXT: SKIP
RRNEX2: AOS (P)
SAVE [RRCMIN] ;DO COMMENT-MODE STUFF AT START AND FINISH OF MOTION.
CALL RRCMRU
RRNEX1: MOVE IN,PT
TRO FF,FRUPRW
CALL GETAG4 ;COMPUTE WHERE WE'RE GOING TO.
JFCL
ADD E,C ;THE WAY THE L COMMAND DOES.
SUB E,PT
JRST RRMOV ;THEN GO THERE.
;CALL HERE WHEN LEAVING A LINE.
;IN COMMENT MODE, TAB-SEMI'S ARE REMOVED BY THIS RTN.
RRCMRU: SKIPGE RRCMMT
POPJ P, ;DO NOTHING IF NOT COMMENT MODE.
RRCMR1: SAVE C
MOVEI C,1
CALL RREND1
JFCL
REST C
MOVE IN,PT
CAMG IN,BEGV
POPJ P, ;DO NOTHING AT BEGINNING OF BUFFER.
SOS IN
CALL GETCHR ;IF CHAR BEFORE PT IS A SEMI,
CAIE CH,";
POPJ P,
RRCMR0: CALL RRDLB ;DELETE IT, AND ANY TABS BEFORE IT.
MOVE IN,PT
CAMG IN,BEGV
POPJ P,
SOS IN
CALL GETCHR
CAIE CH,^I
CAIN CH,40
JRST RRCMR0
POPJ P,
RRCMS1: SETZ C,
CALL RRNEX1
;CALL HERE WHEN ENTER A LINE.
;IN COMMENT MODE, TAB-SEMI WILL BE INSERTED.
RRCMIN: SKIPGE RRCMMT
RET ;NOT COMMENT MODE.
RRCMI0: MOVE IN,PT ;MOVE UP TO EXISTING COMMENT
CALL RREOLT ;OR END OF LINE.
JRST RRCMI1 ;REACHED END, INSERT TAB-SEMI.
CALL GETCHR
CAIN CH,";
JRST RRFORW ;REACHED SEMI, STOP AFTER IT.
CALL RRFORW
JRST RRCMI0 ;ELSE KEEP LOOKING.
RRCMI1: MOVEI CH,^I ;INSERT TABS TILL REACH COMMENT COLUMN
CALL RRINS
MOVE A,RRHPOS
CAMGE A,RRCCOL ;REACHED THE COMMENT COLUMN?
JRST RRCMI1 ;NO, MORE TABS TO INSERT.
MOVEI CH,"; ;YES, INSERT THE SEMI.
JRST RRINS
;^C -- COMPLEMENT COMMENT MODE.
RRCMSW: SKIP ;IF NUMERIC ARG, IT IS SETTING OF COMMENT COLUMN.
CAIE C,1
MOVEM C,RRCCOL
AOSE A,RRCMMT ;IF WAS -1, MAKE IT 0.
SETOB A,RRCMMT ;WAS >=0, MAKE IT -1.
CALL RRECSP ;THEN INDICATE WHICH MODE WE'RE IN.
MOVE CH,(A)1+[ "T ? "C ]
CALL FSECO1
XCT (A)1+[CALL RRCMR1 ;LEAVING COMMENT MODE, REMOVE SEMI.
CALL RRCMS1] ;WHEN ENTER COMMENT MD, INSERT SEMI.
;TYPE A SPACE IN THE ECHO REGION, MAKING SURE CURSOR WILL
;BE REPOSITIONED IN THE DISPLAY REGION. PRESERVE ALL ACS.
RRECSP: SAVE CH
MOVEI CH,40
CALL FSECO1
JRST POPCHJ
;^R -- SET COMMENT COLUMN FROM CURRENT HPOS.
RRCMCS: SKIP A,RRHPOS
SKIPGE RRCMMT ;NO EFFECT UNLESS IN COMMENT MODE.
POPJ P,
MOVEM A,RRCCOL
POPJ P,
;TABLES USED BY RRCHRG. THE ENTRY FOR EACH
;CHARACTER IS AN INDEX INTO RRFORT OR RRBACT.
RRCHBP: REPEAT 6,<360600-<6*.RPCNT>_12.>,,RRCHTB(A)
;CODES IN RRCHTB ARE:
;0 - 1-POSITION CHARACTER.
;1 - ORDINARY CTL CHAR - USUALLY 2-POSITION, BUT 1-POSITION IN SAIL MODE.
;2 - BACKSPACE.
;3 - CR
;4 - LF
;5 - TAB.
;6 - SPECIAL CTL CHARACTER - 2-POSITION EVEN IN SAIL MODE.
RRCHTB: .BYTE 6
1 ;^@
1 ;^A
1 ;^B
1 ;^C
1 ;^D
1 ;^E
1 ;^F
1 ;^G
2 ;^H
5 ;^I
4 ;^J
1 ;^K
1 ;^L
3 ;^M
1 ;^N
1 ;^O
1 ;^P
1 ;^Q
1 ;^R
1 ;^S
1 ;^T
1 ;^U
1 ;^V
1 ;^W
1 ;^X
1 ;^Y
1 ;^Z
0 ;ALTMODE, 1 POSITION.
1 ;[ ;^]
1 ;^\
1 ;^^
1 ;^_
.BYTE
IFN CTRLT,[
SUBTTL OBSOLETE ^T COMMAND
EDIT: CALL GAPSLP
SKIPE ECHOFL
CALL NOECHO
TRZ FF,FRARG+FRARG2+FRUPRW ;FRARG ON = INSERT MODE, OFF = OVERWRITE MODE
;FRARG2 ON = IN IS POINTING TO CR
;FRUPRW ON = BACKWARDS RUB MODE
SETZM COMCNT
MOVE B,CBUFLO
SKIPA IN,PT
ED0.0: POP P,A ;PURGE EXTRA PUSHJ P,
ED0: PUSHJ P,CRR
TRZ FF,FRUPRW ;TURN OFF "\" FLAG
ED1: PUSHJ P,DISFLS
PUSHJ P,TYI
CALL TYINRM
MOVE A,CH
MOVEI CH,"\
CAIL A,40
JRST EDLIS
SKIPL C,EDDPTB(A) ;IS IT A RUBBACK COMMAND
JRST ED11 ;NO
TRON FF,FRUPRW ;TURN ON "\" FLAG
ED12: PUSHJ P,TYOA ;AND IF WAS OFF, TYPE "\"
ED13: MOVE CH,A
PUSHJ P,@C
PUSHJ P,TYO
JRST ED1
ED11: TRZE FF,FRUPRW ;TURN OFF "\" FLAG
JRST ED12 ;IF IT WAS ON, PRINT "\"
JRST ED13
BELL: CALL TYPBEL
JRST CPOPJ1
EDLIS: CAIE A,177
JRST EDLIS1
TRON FF,FRUPRW
PUSHJ P,TYOA
JRST .+3
EDLIS1: TRZE FF,FRUPRW
PUSHJ P,TYOA
MOVE CH,A
PUSHJ P,CKCH
JRST ED0
JRST ED1
PUSHJ P,EDOV
JUMPL CH,ED1
PUSHJ P,TYO
JRST ED1
ED%: MOVEI CH,"#
PUSHJ P,TYO
PUSH P,IN
PUSH P,FF
ED%1: PUSHJ P,CGETIN
JUMPL CH,ED%2 ;END OF LINE OR BUFFER
PUSHJ P,TYO
JRST ED%1
ED%2: POP P,FF
POP P,IN
PUSHJ P,CRR
MOVE A,COMCNT
JUMPLE A,CPOPJ1
MOVE B,CBUFLO
ILDB CH,B
PUSHJ P,TYO
SOJG A,.-2
JRST CPOPJ1
EDOV: MOVE A,CH
TRNN FF,FRARG ;IN INSERT MODE
PUSHJ P,CGETIN ;NO
SKIPA CH,A
EDCPY: PUSHJ P,CGETIN
JUMPL CH,CPOPJ
EDCPY1: IDPB CH,B
AOS COMCNT
POPJ P,
CGETIN: MOVNI CH,1
TRNE FF,FRARG2
POPJ P,
CAML IN,ZV ;AT END OF BUFFER
JRST CGETI1
PUSHJ P,GETCHR
CAIN CH,15
CGETI1: TROA FF,FRARG2
AOJA IN,CPOPJ
MOVNI CH,1
POPJ P,
EDCR: PUSHJ P,CRR
EDCR2: TRNE FF,FRARG2
JRST EDCR1
PUSHJ P,CGETIN
JRST EDCR2
EDCR1: MOVE C,IN ;GET ADDR AFTER END OF OLD LINE,
MOVE E,PT ;GET ADDR OF START OF IT,
CALL DELET1 ;TURN THAT INTO GAP.
MOVE C,COMCNT ;NOW INSERT SPACE FOR NEW LINE,
CALL SLPGET ;BP GETS BP TO IDPB INTO SPACE.
MOVE A,COMCNT
JUMPE A,EDCR3
MOVE B,CBUFLO
ILDB CH,B
IDPB CH,BP
SOJG A,.-2
EDCR3: TRZ FF,FRARG+FRUPRW+FRARG2
SETZM COMCNT
SETOM UNRCHC
PUSHJ P,SETTTM
JRST GO
RTYI: PUSHJ P,TYI
CALL TYINRM
CAIE CH,177
POPJ P,
MOVEI CH,"\
TRON FF,FRUPRW
PUSHJ P,TYOA
MOVE CH,A
SUB P,[1,,1]
POPJ P,
EDD: PUSHJ P,CGETIN ;DELETE NEXT CHAR
JUMPL CH,BELL ;BELL IF NONE
MOVEI CH,"%
POPJ P,
EDP: MOVEI CH,"< ;COMPLEMENT STATE OF INSERT/OVERWRITE MODE
TRCE FF,FRARG
MOVEI CH,">
POPJ P,
EDS: PUSHJ P,RTYI ;COPY THRU "T"
MOVE A,CH
PUSH P,IN
PUSH P,FF
EDS1: PUSHJ P,CGETIN
TRNE FF,FRARG2
JRST EDS2 ;AT EOL AND NOT FOUND
CAME CH,A
JRST EDS1 ;KEEP LOOKING
POP P,FF
POP P,IN
JRST EDN1
EDN: PUSHJ P,EDCPY ;COPY THRU 1ST SPACE AFTER 1ST NON-SPACE OR TO EOL
JUMPL CH,CPOPJ1
PUSHJ P,TYO
CAIN CH,"
JRST EDN
MOVEI A,"
EDN1: PUSHJ P,EDCPY
JUMPL CH,CPOPJ1
PUSHJ P,TYO
CAME CH,A
JRST EDN1
JRST CPOPJ1
EDS2: POP P,FF
POP P,IN
JRST BELL
EDQ: PUSHJ P,RTYI ;QUOTE NEXT CHAR
JRST EDOV
EDT: PUSHJ P,RTYI ;DELETE THRU "T"
MOVE A,CH
PUSH P,IN
PUSH P,FF
EDT1: PUSHJ P,CGETIN
TRNE FF,FRARG2
JRST EDS2 ;AT EOL AND NOT FOUND
CAME CH,A
JRST EDT1
POP P,FF
POP P,IN
JRST EDO1
EDO: PUSHJ P,CGETIN ;DELETE THRU NEXT SPACE AFTER 1ST NON-SPACE OR TO EOL
JUMPL CH,CPOPJ1
MOVE A,CH
MOVEI CH,"%
PUSHJ P,TYO
CAIN A,"
JRST EDO
MOVEI A,"
EDO1: PUSHJ P,CGETIN
JUMPL CH,CPOPJ1
CAMN CH,A
SETOM A
MOVEI CH,"%
PUSHJ P,TYO
JUMPL A,CPOPJ1
JRST EDO1
EDR: TROA FF,FRARG+FRUPRW ;FRARG ON = ECHO
EDL: TRZ FF,FRARG+FRUPRW ;FRUPRW ON = DONT END EDIT
EDL1: TRNE FF,FRARG2
JRST EDL2
PUSHJ P,EDCPY
JUMPL CH,EDL2
TRNE FF,FRARG
PUSHJ P,TYO
JRST EDL1
EDL2: TRZ FF,FRARG
TRZE FF,FRUPRW
JRST CPOPJ1 ;DON'T END EDIT
PUSHJ P,CRR ;CR-LF THEN END EDIT
JRST EDCR1
EDW: LDB CH,B ;RUBBACK TO 1ST NON-SPACE, THEN BACK TO 1ST SPACE
CAIE CH,"
JRST EDW1
MOVEI CH,177
PUSHJ P,CKCH
JRST ED0.0
JRST EDW
EDW1: LDB CH,B
CAIN CH,"
JRST CPOPJ1 ;FOUND SPACE, QUIT
MOVEI CH,177 ;TO TELL CKCH TO RUBBACK
PUSHJ P,CKCH
JRST ED0.0 ;NOTHING TO RUB
JRST EDW1
.VALUE ;SHOULD NEVER GET HERE
EDALT: TRO FF,FRARG ;COPY REST W/ ECHO AND END EDIT
TRZ FF,FRUPRW
JRST EDL1
] ;IFN CTRLT
SUBTTL TECO COMMAND DISPATCH / ARGUMENT ARITHMETIC
CD: SETZM NUM ;FLUSH ANY ARGUMENT, OR : OR @.
SETZM SARG
TRZA FF,FRARG+FRARG2+FROP+FRUPRW+FRCLN+FRSYL
CD2B: TROA FF,FROP+FRARG ;COME HERE FROM ARITH OPS, NEED 2ND ARG.
CD2A: MOVSI A,(ADD C,);SET UP DLIM FOR THE DEFAULT
;CONDITION OF ADDING THE OLD VALUE
;WITH ANY NEW NUMBER ENTERED
HLLM A,DLIM ;PUT THE APPROPRIATE OPERATOR AWAY
CLEARM SYL ;CLEAR THE NEW NUMBER ENTERED
CLEARM OSYL ;ALSO CLEAR ITS OCTAL INTERPRETATION
CD5: MOVE A,QRWRT ;IF IMPURE STRING SPACE HAS INCREASED BY
CAML A,QRGCMX ;GCOFTN CHARS SINCE PREVIOUS GC,
PUSHJ P,GC ;GC THE IMPURE STRINGS.
CD5A: SKIPGE STOPF ;IF THE USER HAS ^G'ED, TRY TO QUIT,
CALL QUIT0 ;TRY TO QUIT (CHECK NOQUIT).
CALL RCH ;GET THE NEXT COMMAND CHARACTER
CDRCH: TRNE CH,100 ;CONVERT LOWER CASE TO UPPER.
ANDCMI CH,40
SETZB B,SQUOTP
TRZ FF,FRNOT ;RESET MORE FLAGS
XCT DTB(CH) ;EXECUTE THE ENTRY FROM THE DISPATCH TABLE
CD5B: TLZ FF,FLDIRDPY ;RESET THE "DISPLAY THE FILE DIRECTORY BIT", THIS INSURES
;THAT AN E COMMAND WILL ONLY DISPLAY THEBUFFER IF IT IS THE LAST COMMAND
MOVE C,NUM ;GET THE OLD VALUE
TRZN FF,FRSYL
JRST CD5C
XCT DLIM ;THEN PERFORM THE SAVED OPERATION
MOVEM C,NUM ;AND MAKE IT THE NEW OLD VALUE
CD5C: MOVE E,SARG ;GET THE SECOND ARGUMENT TO THE COMMAND (IF ANY)
JUMPGE B,(B) ;IF B POSITIVE, THEN JUMP TO IT.
PUSHJ P,(B) ;IF B NEGATIVE, PUSHJ
CDRET: JRST CD ;NON-SKIP RETURNING COMMANDS DON'T RETURN VALUE
VALREC: TROE FF,FRARG ;IF HAVE ARG FROM BEFORE, NOT GOBBLED,
JRST VALRET ;DO ARITH. WITH IT & THIS CMD'S VALUE.
MOVEM A,NUM ;IF NO ARG OR THIS CMD USED IT, ITS
TRZ FF,FROP ;VALUE IS ALL THE ARG WE HAVE.
JRST CD2A
CDNUM: JFCL 10,.+1 ;CLEAR OVERFLOW FLAG.
MOVE A,OSYL ;ASSEMBLE THIS DIGIT INTO A NUMBER
IMUL A,I.BASE ;(USUALLY OCTAL)
JFCL 10,[TLC A,400000 ;ALLOW OVERFLOW INTO SIGN BIT.
JRST .+1]
ADDI A,-60(CH)
MOVEM A,OSYL
JFCL 10,.+1
MOVE A,SYL
IMUL A,IBASE ;AND IN DECIMAL (USUALLY)
JFCL 10,[TLC A,400000 ;ALLOW OVERFLOW INTO SIGN BIT.
JRST .+1]
ADDI A,-60(CH)
VALRET: MOVEM A,SYL ;SAVE IT AS A VALUE
TRZ FF,FROP ;DON'T HAVE ARITH OP WAITING FOR 2ND ARG
CD7: TRO FF,FRARG+FRSYL ;DECLARE THAT THERE IS AN ARGUMENT AND A CURRENT VALUE
JRST CD5 ;AND RETURN
;ARGDFL MACRO CALLS HERE IF FROP WAS SET, AFTER CLEARING IT.
;ARGDFL IS USED TO DEFAULT "-" TO "-1", ETC.
ARGDF0: SETZM SYL ;PRETEND A "1" HAD PRECEDED THIS CMD,
AOS SYL ;AFTER THE OPERATOR THAT NEEDS 2ND ARG,
XCT DLIM ;DO THE ARITHMETIC,
POPJ P,
PNT: MOVE A,OSYL
TRNE FF,FRSYL
JRST VALRET
MOVE A,PT
SUB A,BEG
JRST VALRET
CNTRAT: ARGDFL Z, ;^@ - TAKES 1 ARG, RETURNS .,.+ARG OR .+ARG,. .
TRZE FF,FRARG2
JRST [ TRZE FF,FRCLN ;M,N:^@ RETURNS N,M.
JRST [ MOVE B,C
MOVE A,E
JRST 2VALS]
MOVE A,C ;M,N^@ RETURNS N-M.
SUB A,E
JRST POPJ1]
MOVE B,PT
ADD C,PT
MOVE A,C
CAMG A,B ;MAKE SURE ARGS ARE IN RIGHT ORDER.
EXCH A,B
JRST HOLE0
HOLE: MOVE B,BEGV
MOVE A,ZV
HOLE0: SUB B,BEG ;RETURN 2 CHAR ADDRS AS VALUES.
SUB A,BEG ;CHANGE THEM TO CHARACTER NUMBERS (REL TO BEG, THAT IS)
2VALS: MOVEM B,SARG ;RETURN 2 VALUES IN B, A.
TRO FF,FRARG2
JRST POPJ1
END1: SKIPA A,ZV
BCMD: MOVE A,BEGV
FSROC1: SUB A,BEG
JRST POPJ1
;F^X COMMAND - WITHIN MACRO, RETURN THE MACRO ARGS
;(AS MANY AS IT WAS CALLED WITH).
FCTLX: MOVE A,MARG2 ;GET THE VALUES THE MACRO'S ARGS HAVE IF THEY EXIST.
MOVE B,MARG1
MOVE C,MACBTS ;GET THE BITS THAT SAY WHETHER THEY DO.
;ENTER HERE DO F^X ON SOME OLD MACRO FRAME, WITH ITS DATA IN A, B, C.
FCTLX2: TRZ FF,FRARG+FRARG2+FROP+FRSYL
SETZM NUM ;FLUSH ALL TRACES OF ARGUMENTS.
SUB P,[1,,1] ;THROW AWAY RET ADDR (VALREC-1); WE WILL JUMP INTO COMMAND LOOP.
TLNN C,MFBA1 ;IF THERE'S A 1ST ARG,
JRST FCTLX1
MOVEM B,SARG ;PUT IT AWAY
TRO FF,FRARG2 ;AND SAY THERE IS ONE.
FCTLX1: TLNE C,MFBA2
JRST VALREC ;IF THERE'S A 2ND ARG, SET IT UP AS CURRENT VALUE.
JRST CD2A ;IF THERE ISN'T, SET UP NO CURRENT VALUE BUT DON'T CLEAR FRARG2.
;F^Y COMMAND - TAKES 0,1 OR 2 ARGS, AND RETURNS 0 IF NO ARGS, 1 IF ONLY A 2ND ARG,
;2 IF ONLY A 1ST ARG (EG 1,F), 3 IF TWO ARGS (EG 1,2F).
;IN ADDITION, 4 IS ADDED TO THE RESULT IF THE COLON FLAG IS SET,
;AND 8 IS ADDED TO THE RESULT IF THE ATSIGN FLAG IS SET.
FCTLY: LDB A,[.BP FRARG+FRARG2+FRCLN+FRUPRW,FF]
TRZ FF,FRARG+FRARG2+FRUPRW+FRCLN
JRST POPJ1
;^M - FLUSH CURRENT VALUE
CTLM: MOVE A,CPTR ;^M. IF NEXT CHAR IS ^J, READ IT NOW.
ILDB CH,A
CAIN CH,^J
SKIPN COMCNT ;THIS IS SO THAT, IF FS STEP CALLS A MACRO,
CAIA ;THE POINTER IN AN FS BACKTRACE$ IS AT A NICE-LOOKING PLACE.
CALL RCH
CTLM2: SKIPN A,STEPFL
RET
MOVE B,STEPDE ;DON'T STEP IF DEEPER IN MACRO CALLS THAN USER-SUPPLIED LIMIT.
CAMGE B,MACDEP
JUMPGE B,CPOPJ
SETZ C, ;(DON'T GIVE THE STEP MACRO A NONZERO ARG)
CALL QLGET0
CAIA ;IF FS STEP IS A NONZERO NUMBER, DO OUR BUILT-IN STEPPING.
JRST MACXCP ;IF IT'S A STRING, MACRO IT AND RETURN ITS VALUE.
MOVE A,QRB..
SKIPE .QVWFL(A)
JRST CTLM1
TRZ FF,FRARG+FRARG2+FRCLN
TRO FF,FRUPRW ;IN LINE-STEPPING MODE (SEE FS STEP$),
CALL VIEW1B ;DO @VW, AND DECODE VALUE OF CHARACTER READ
CTLM1: MOVE A,QRB..
SETZM .QVWFL(A) ;AND ALLOW BUFFER DISPLAY AFTER COMMAND.
TRZ FF,FRUPRW+FRCLN
CALL FTYI
JFCL
CAIN A,^F
JRST [ SETZM NOQUIT ;^F QUITS EVEN WHEN QUITTING NOT ALLOWED.
SETOM STOPF
RET]
CAIN A,^R
JRST [ CALL RRENTR ; ENTER ^R MODE
JRST CTLM1] ;THEN DECODE ANOTHER CHARACTER.
CAIN A,^P
SETZM STEPFL ;OR TURN OFF STEPPING
RET
CAND: MOVSI A,(AND C,)
JRST CD2B
COR: MOVSI A,(IOR C,)
JRST CD2B
BAKARR: HRROI B,SERCHA ;_ IS EITHER SEARCH-AND-YANK OR SAME AS -.
SKIPLE NLAROW ;FS _DISABLE POSITIVE => "_" IS ERROR.
TYPRE [DCD] ;"DISABLED COMMAND"
SKIPN NLAROW ;FS _DISABLE IS NEGATIVE => "_" IS TREATED AS "-".
JRST CD5B ;FS _DISABLE IS 0 => "_" IS SEARCH-AND-YANK.
MINUS: MOVSI A,(SUB C,)
JRST CD2B
TIMES: MOVSI A,(IMUL C,)
JRST CD2B
SLASH: MOVSI A,(IDIV C,)
JRST CD2B
CXOR: MOVSI A,(XOR C,)
JRST CD2B
PLUS: MOVSI A,(ADD C,)
JRST CD2B
SPACE: TRNE FF,FROP ;SPACE BETWEEN NUMBERS IS LIKE PLUS,
JRST CD5A ;BUT SPACE NEXT TO AN ARITHMETIC OPERATOR IS IGNORED.
JRST CD2A
COMMA: TRZN FF,FRARG
JRST COMMA1
MOVEM C,SARG
TROE FF,FRARG2
TYPRE [WNA]
COMMA1: SETZM NUM ;NO ACCUMULATED 1ST ARG ANYMORE,
JRST CD2A ;INIT. FOR NEW ARG, DON'T CLEAR FRCLN.
ASLSL: TROA FF,FRUPRW ;TURN ON THE UPARROW FLAG
ACOLON: TRO FF,FRCLN ;TURN ON THE COLON FLAG
JRST CD5A ;AND GO BACK FOR MORE
;HANDLE (, ), F(, F)
FOPEN: SUB P,[1,,1] ;F( - PUSH VALUES BUT DON'T FLUSH THEM.
SKIPA T,[CD5A]
OPEN: MOVEI T,CD ;( - PUSH AND FLUSH VALUES.
OPEN1: TRZ FF,FRQPRN ;SAY THIS ( ISN'T A QREG NAME.
OPEN2: SAVE NUM
HLLZ CH,DLIM
HRR CH,FF ;REMEMBER CURRENT FRCLN, FRUPRW, FRARG2.
TRNE FF,FRARG2
SAVE SARG ;SAVE 2ND ARG IF THEE IS ONE.
SAVE CH
SAVE LEV
MOVEM P,LEV
JRST (T)
FCLOSE: SUB P,[1,,1] ;F) - POP AND THROW AWAY VALUES. CALLED WITH PUSHJ.
SKIPA T,[CD5A]
CLOSE: HRROI T,CD5A ;) - POP AND RETURN VALUES. RH(T) IS RET. ADDR., SIGN=0 => THROW AWAY.
CLOSE2: CAME P,LEV
TYPRE [UMC] ;NOT ALLOWED IF TOP OF STACK DOESN'T HAVE SOME PUSHED VALS.
SKIPN Q,ITRPTR
JRST CLOSE1
HLRZ Q,-1(Q)
CAIN Q,(P)
TYPRE [UMC] ;DON'T ALLOW SEQUENCE "(<)" - WOULD SCREW UP ">".
CLOSE1: REST LEV
REST CH
ANDCMI CH,#FRARG2#FRCLN#FRUPRW#FROP#FRARG#FRQPRN
TRNE CH,FRARG2
REST B
REST A
TRNN CH,FRQPRN
JUMPGE T,(T) ;FOR F), DO NOTHING WITH THE POPPED STUFF.
EXCH A,NUM ;ELSE RESTORE SAVED ARG VALUES AND OPERATOR.
HLLM CH,DLIM
TRNE CH,FRARG2
MOVEM B,SARG
TRZE CH,FRQPRN ;FOR Q( - ), WE HANDLE THE FLAGS A SPECIAL WAY.
JRST QREGXR
TRNE FF,FRARG ;NORMALLY, WE SET UP THE VALUE WITHIN THE PARENS AS A SYLLABLE
TRZ CH,FROP ;TO DO ARITHMETIC ON. SO THE PREVIOUS OPERATOR GETS A RIGHT OPERAND.
TRNE FF,FRARG
IORI FF,FRSYL
MOVEM A,SYL
IORI FF,(CH)
JRST (T)
;SET P FROM CH, AND FORGET ABOUT ALL ('S
;THAT WERE IN THE PART OF THE STACK THAT HAS BEEN FLUSHED.
;ALSO PERFORM APPROPRIATE ACTIONS IN CASE POPPING PAST A ^R OR A SORT.
;THEN EXIT WITH POPJ P, (NOTE P HAS CHANGED, SO CALL WITH PUSHJ CH,
;BUT DON'T DARE DO THAT IF P=CH, SINCETHAT WOULD LEAVE THE RETURN
;POINTER ON STACK ABOVE P, CAUSING TIMING ERROR WITH INT. LEVEL).
SETP: MOVEM P,SETPP
CAMLE CH,P
.VALUE ;MOVING PDL POINTER UPWARDS??
SKIPE DISPRR ;IF POPPING OUT OF A ^R,
CALL RRERST ;UNBIND SOME STUFF.
CAMGE CH,PSSAVP
SETZM PSSAVP ;DETECT ERRING OUT THROUGH A ^P, AND RELEASE SORT TABLES.
SETP1: SKIPE LEV ;IF THERE IS AN (,
CAML CH,LEV ;AND IT'S NO LONGER BENEATH P,
JRST [ MOVE P,CH ? RET]
HRRZ P,LEV
CAIL P,PDL
CAIL P,PDL+LPDL
.VALUE
MOVE P,LEV ;FLUSH THE INNERMOST "("
REST LEV
JRST SETP1 ;AND EXAMINE THE NEXT ONE.
SUBTTL VIRTUAL CHARACTER ADDRESS SUBROUTINES
CHKC: CAML E,BEGV ;BARF IF E NOT IN BUFFER.
CAMLE E,ZV
TYPRE [NIB]
RET
CHK: CAMG C,ZV
CAMGE C,BEGV
TYPRE [NIB]
RET
CHK1: CAMG E,BEGV
MOVE E,BEGV
CAML C,ZV
MOVE C,ZV
CAMLE E,C
TYPRE [2%1] ;2<1
RET
CHK1A: CAMG E,BEG
MOVE E,BEG
CAML C,Z
MOVE C,Z
CAMLE E,C
TYPRE [2%1] ;2<1
RET
GETIBI: SKIPA BP,IN
GETIB.: MOVE BP,PT
GETIBV: CAML BP,GPT
ADD BP,EXTRAC
GETIBP: SOSA TT,BP
GETBP: MOVE TT,BP
IDIVI TT,5
MOVE BP,BTAB(TT1)
HRRI BP,(TT)
TLZ BP,17
POPJ P,
;CONVERT THE BYTE POINTER IN BP TO A CHARACTER ADDRESS
GETCA: LDB TT,[360600,,BP] ;GET POSITION FIELD IN TT
MOVEI BP,1(BP) ;CLEAR OUT LH OF BYTE POINTER
IMULI BP,5
IDIVI TT,7
SUBI BP,1(TT)
POPJ P,
GETINC: MOVE TT,IN
AOSA IN
GETCHR: MOVE TT,IN
CAML TT,GPT
ADD TT,EXTRAC
IDIVI TT,5
LDB CH,BTAB(TT1)
POPJ P,
PUTINC: MOVE TT,OUT
AOSA OUT
PUT: MOVE TT,OUT
CAML TT,GPT
ADD TT,EXTRAC
IDIVI TT,5
DPB CH,BTAB(TT1)
POPJ P,
440700+TT,, ;FOR SORT
BTAB: 350700+TT,,
260700+TT,,
170700+TT,,
100700+TT,,
10700+TT,,
;CALL GETARG TO DECODE 0,1 OR 2 ARGS AS "T", "K", "X", ETC. DO.
;RETURNS IN E,C THE CHAR ADDRS OF BEGINNING AND END OF RANGE.
;SKIPS IF THERE WERE 0 OR 1 ARG; DOESN'T SKIP IF WERE 2.
;THE CALL TO GETARG SHOULD BE FOLLOWED BY A CALL TO CHK1
;OR CHK1A, TO MAKE SURE THE ARGS ARE IN RANGE, IF THERE ARE 2 ARGS.
;NOTE: ^G CAN QUIT OUT OF THE MIDDLE OF THESE ROUTINES!
;HERE TO AVOID LOOKING AT THE UPARROW FLAG. ALSO, CHECK RANGE USING VIRTUAL BOUNDS.
GETANU: SAVE FF
ANDCMI FF,FRUPRW
CALL GETARG
CALL CHK1
REST FF
ANDCMI FF,FRCLN
RET
;WITH THE UPARROW MODIFIER, WE STOP ONLY AT CRLFS, NOT STRAY LF'S.
GETARG: TRNE FF,FRARG2
JRST GETAG6
ARGDFL O
CALL IMMQIT ;ALLOW QUITTING UNTIL WE RETURN.
AOS (P)
SAVE [DELQIT-1] ;THIS WILL BE INCREMENTED
;GETAG7 AND GETAG4 ARE USED AS ENTRY POINTS
;BY THINGS THAT WANT TO PARSE A FEW LINES FORWARD OR BACK.
GETAG7: MOVE IN,PT
GETAG4: SAVE CH
SAVE A ;A = Saved Last Character
SAVE B
JUMPLE C,GETAG2
MOVE BP,IN
CAML BP,GPT
ADD BP,EXTRAC
CALL GETIBP
SETO CH, ;Saved Last Character
GETAR1: MOVE A,CH ;Store Saved Last Character
CAMN IN,ZV
JRST GETAG5
CAMN IN,GPT ;REACHING THE GAP => MOVE OVER IT.
CALL FEQGAP
ILDB CH,BP
CAIE CH,^J ;SCN UNTIL THE NEXT LF.
AOJA IN,GETAR1
TRNN FF,FRUPRW ;IF WE HAVE THE UPARROW FLAG,
AOJA IN,GETAR2
TRNE FF,FRCLN ;IF WE HAVE COLON FLAG, WE WILL STOP BEFORE THE CR,
CAME IN,PT ;SO INSIST THAT THE CR ITSELF BE AFTER OUR STARTING POINT.
CAIE A,^M ;Saved Last Character
AOJA IN,GETAR1
AOJ IN,
GETAR2: SOJG C,GETAR1 ;FOUND LF OR CRLF AS APPROPRIATE. IN POINTS AFTER THE LF.
GETAG1: TRZE FF,FRCLN
CALL GETAG8
CAMG IN,BEGV
MOVE IN,BEGV
GETAG5: REST B
REST A
REST CH
MOVE E,PT
MOVE C,IN
TRZ FF,FRCLN\FRUPRW ;TURN IT OFF IF NOT ALREADY DONE
TLZE FF,FLNEG
EXCH C,E
AOS (P)
RET
GETAG8: SUBI IN,2
PUSHJ P,GETCHR
CAIE CH,15
AOJA IN,GETAG9
POPJ P,
GETAG9: PUSHJ P,GETCHR
CAIE CH,12
AOJ IN,
POPJ P,
GETAG6: ADD C,BEG
ADD E,BEG
TRZ FF,FRCLN\FRUPRW
POPJ P,
GETAG2: SOS IN
GETAG0: CAMGE IN,BEGV
AOJA IN,GETAG3
PUSHJ P,GETCHR
CAIE CH,12
SOJA IN,GETAG0
TRNN FF,FRUPRW
JRST GETAR3
CAMN IN,BEGV
JRST GETAG3
SUBI IN,1
CALL GETINC
CAIE CH,^M
SOJA IN,GETAG0
GETAR3: AOJLE C,GETAG2
AOJ IN,
GETAG3: TLO FF,FLNEG
JRST GETAG1
SUBTTL FUNDAMENTAL TECO COMMANDS
REVERS: TRNE FF,FRARG2 ;<N>R MOVES BACK N CHARACTERS.
JRST LINE ;MAKE FLR MOVE RIGHT OVER A LIST.
ARGDFL Z
MOVNS C
JRST REVER1
CHARAC: ARGDFL Z
REVER1: ADD C,PT
JMP1: CAML C,BEGV ;IS THE SPEC'D POS. WITHIN BFR'S LIMITS?
CAMLE C,ZV
JRST [TRZE FF,FRCLN ;NO, FOR :C, ETC.
JRST NRET0 ;RETURN FAILURE.
TYPRE [NIB]] ;NO :, THIS IS ERROR.
MOVEM C,PT
TRZE FF,FRCLN
JRST NRETM1 ;FOR :C, ETC. SAY SUCCESSFUL.
POPJ P,
JMP: TRZN FF,FRARG
SKIPA C,BEGV
ADD C,BEG
JRST JMP1
LINE: CALL GETARG ;GET PT AND DESIRED PT IN C,E. DO GOBBLE UPARROW FLAG.
CALL CHK1 ;MAKE SURE ARGS ARE WITHIN VIRT. BUFFER.
ADD C,E
SUB C,PT ;IF EITHER ARG EQUALED PT, PT IS NOW THE OTHER ONE.
JRST JMP1
KILL: PUSHJ P,GETARG
PUSHJ P,CHK1
JRST DELET1
DELETE: ARGDFL Z
DELET0: JUMPE C,CPOPJ ;DELETING 0 CHARS.
MOVE E,PT
ADD C,PT ;C,E HAVE 2 ENDS OF RANGE TO DELETE.
CALL CHK ;MAKE SURE C IS IN THE BUFFER.
;MAIN DELETE RTN. C,E VIRTUAL CHAR ADDRS -> ENDS OF STUFF TO DELETE
;SETS PT TO PLACE DELETED FROM, LEAVES GAP THERE TOO.
.SEE FXCMD ;MUSTN'T CLOBBER A OR D.
DELET1: CAMG C,E ;GET UPPER END IN C, LOWER IN E.
EXCH C,E
MOVEM E,PT ;TELL GAPSLP WHERE TO PUT GAP (IF CALL IT)
SKIPE READON ;IF NOT ALLOWED TO MODIFY BUFFER
TYPRE [RDO] ;BARF OUT HERE
CAML C,GPT ;IF THE GAP IS IN OR NEXT TO
CAMLE E,GPT ;THE AREA BEING DELETED, OK.
CALL GAPSLP ;ELSE MOVE IT TO BE SO.
MOVEM E,GPT ;NOW TURN THE AREA INTO GAP.
SUB C,E
DELETB: SETOM MODIFF ;WE ARE CHANGING THE BUFFER CONTENTS.
SETOM MODIFM
ADDM C,EXTRAC
MOVNS C
ADDM C,ZV
ADDM C,Z
POPJ P,
DEL1B: SOS PT ;DELETE 1 CHARACTER BACKWARDS FROM PT.
SOS GPT
DEL1F: SOS ZV ;DELETE 1 FORWARDS FROM PT.
SOS Z
AOS EXTRAC
RET
SUBTTL F^E REPLACE CHARACTERS COMMAND
;<N>F^E<STRING>$ - REPLACE STRING INTO BUFFER STARTING AT POSITION <N>.
;<N>:F^E<Q><STRING>$ - REPLACE IN QREG <Q> (EITHER STRING OR BUFFER WORKS).
;REPLACING IS LIKE INSERTING AND THEN DELETING AS MANY CHARS AS WERE INSERTED.
FCECMD: ARGDFL
TRZN FF,FRCLN
JRST FCE1 ;INSERT IN BUFFER?
TRZN FF,FRARG
TYPRE [WNA]
CALL QREGX ;NO, QREG. WHICH ONE?
CALL QLGET0 ;LENGTHH IN B, B.P. TO ILDB IN BP.
TYPRE [QNS]
SKIPL C
CAMLE C,B ;MAKE SURE ARG IS IN RANGE
TYPRE [AOR]
CALL GETCA
ADD BP,C ;ADJUST B.P. TO PLACE TO START REPLACING AT.
CALL GETBP
SETZ A, ;THERE'S NO GAP TO WORRY ABOUT.
JRST FCE2
FCE1: SKIPE READON ;ALLOWED TO MUNGE THIS BUFFER?
TYPRE [RDO] ;NO
SETOM MODIFF ;HERE WE ARE CHANGING THE CURRENT BUFFER'S CONTENTS.
SETOM MODIFM
TRZE FF,FRARG ;NO ARG, AND REPLACING IN BUFFER => USE ".".
JRST FCE5
MOVE C,PT
SUB C,BEG
FCE5: MOVE BP,GPT ;REPLACE IN BUFFER.
CALL GETIBP ;MAKE B.P. TO START OF GAP SO WE CAN TELL WHEN WE REACH GAP.
MOVE A,BP
MOVE BP,BEG
ADD BP,C ;GET VIRT. CHAR ADDR OF WHERE TO START REPLACING
CAML BP,BEGV
CAMLE BP,ZV
TYPRE [AOR]
CALL GETIBV ;TURN INTO REAL CHAR ADDR, THEN BP.
ADD C,BEG ;TURN STOP ADRD IN C INTO ADDR REL. TO VIRTUAL BEG,
SUB C,BEGV ;SINCE MUST BE COMPARED WITH VIRTUAL SIZE.
MOVE B,ZV
SUB B,BEGV ;GET LENGTH OF BUFFER.
FCE2: SUB B,C ;C HAS CHARS FROM PLACE WE START TO END OF BUFFER OR QREG.
SETZM INSBP ;MAKE SURE BP IS RELOCATED IF BUFFER MOVES.
MOVEI CH,ALTMOD
TRZE FF,FRUPRW ;FIND OUT WHAT STRING ARG DELIMITER WE'RE USING.
CALL RCH
MOVEM CH,INSDLM
FCE3: CALL RCH ;THIS IS THE INNER LOOP OF FCE
SKIPE SQUOTP
JRST FCE4
CAMN CH,INSDLM ;CHECK CHAR FOR DELIMITERNESS UNLESS SUPERQUOTED, ETC.
JRST FCEEND
FCE4: SOJL B,[TYPRE [STL]] ;CHECK FOR END OF BUFFER OR QREG.
CAMN A,BP
CALL FEQGAP ;CHECK FOR GAP - MOVE B.P. IN BP OVER IT.
IDPB CH,BP
JRST FCE3
FCEEND: SETOM INSBP
RET
SUBTTL INSERTION COMMANDS
;INSERT ASCIZ STRING <- BP IN A, INTO Q-REG IN CH.
INSASC: TRO FF,FRCLN ;SAY INSERT IN Q-REG.
SAVE CH
SAVE [0]
SETZM INSDLM ;DELIMITER IS THE ^@ ENDING THE ASCIZ.
MOVE CH,[ILDB CH,A]
MOVEM CH,INSRCH ;GET CHARS BY ILDB-ING BP.
JRST INSAS1
FNCMD: MOVE CH,[CALL RCH] ;FN = [..N:I..N BUT PREVENTS QUIT IN BETWEEN. ;]
MOVEM CH,INSRCH
MOVE CH,QRB..
ADDI CH,.QUNWN
CALL OPENB2
JRST PSI
CNTRLF: MOVN C,INSLEN ;^F -- SAME AS "FKDI".
CALL DELET0
TRZ FF,FRARG ;MAKE SURE <N>^F DOESN'T INSERT ASCII(N).
JRST INSERT
TAB: HRROI B,TAB0 ;HERE FOR TAB. DECIDE WHETHER IT'S
SKIPLE TABMOD
TYPRE [DCD] ;DISABLED,
SKIPE TABMOD
MOVEI B,SPACE ;IGNORED (LIKE SPACE, ACTUALLY),
JRST CD5B ;OR ENABLED (IN WHICH CASE COME BACK TO TAB0).
TAB0: PUSHJ P,TYOMGS ;USED FOR ENTRY FROM SELF-INSERTING CHARACTERS
ANDCMI FF,FRCLN\FRUPRW\FRARG\FRARG2
INSERT: TRNE FF,FRARG ;IF GIVEN AN ARG,
JRST INS1C ;THEN JUST INSERT THAT CHARACTER
MOVE OUT,[CALL RCH] ;SAY TO USE RCH TO GET CHARACTERS TO INSERT
MOVEM OUT,INSRCH
TRNN FF,FRCLN ;IF NOT GOING TO A Q REG
JRST INS1 ;THEN SKIP THIS STUFF
PUSHJ P,QREGVS ;OTHERWISE GET THE Q-REG NAME
JUMPE B,INS0 ;IS THE QREG SUBSCRIPTED? (:I:Q(IDX))
JSP TT,QREGVA ;IF SO, EXTRA HAIR IN CASE OUR CONSING
;MOVES THE Q-VECTOR CONTAINING THE Q-REG.
;CALLS PSI, THEN RETURNS TO INSERT'S CALLER.
JRST INS0
;PSI IS USED BY THINGS THAT WANT TO INSERT A STRING ARG INTO A SPECIFIC QREG.
;THE QREG ADDRESS SHOULD BE IN CH.
PSI: SETZ B,
TRO FF,FRCLN
INS0: SAVE CH ;REMEMBER WHICH QREG TO STORE IN.
SAVE B
CAIA
INS1: PUSHJ P,GAPSLP ;GET THE GAP AROUND THE HOME COUNTRY
MOVEI CH,ALTMOD ;GET THE TEMPORARY APROX-
;IMATION TO THE DELIMITER
TRZE FF,FRUPRW ;IF IT ISN'T RIGHT (THE UPARROW
;INDICATOR IS TURNED ON)
PUSHJ P,RCH ;THEN GET THE RIGHT ONE
MOVEM CH,INSDLM ;AND SAVE IT AS THE ONE TO USE
TRNN FF,FRCLN ;IF NOT INTO A Q-REG, THEN JUMP
JRST INS2 ;FORWARD
INSAS1: MOVE C,BFRBOT ;GET # CHARS UNUSED AFTER IMPURE STRING SPACE,
SUB C,QRWRT
SUBI C,4 ;WE'LL CERTAINLY NEED 4 FOR HEADER OF NEW STRING.
;INS5 WILL PUT THAT IN TOTALC, # CHARS FREE TO USE.
MOVE BP,QRWRT ;START STRING AT START OF FREE SPACE,
ADDI BP,4 ;BEGIN THE TEXT AFTER WHERE HEADER'LL GO.
JRST INS5
INS2: MOVE BP,PT ;NEXT, GET THE POINTER ADDRESS
MOVE C,EXTRAC ;# CHARS FREE TO STORE IN IS GAP SIZE.
INS5: MOVEM C,TOTALC
CALL GETIBP ;GET BP FOR IDPB INTO GAP.
MOVEM P,INSINP .SEE INSCHK ;GO TO INSDUN ON CNM ERROR, TO CLEAN UP.
SETZM INSBP ;MAKE SURE BP IS RELOCATED IF BUFFER MOVES INSIDE GETFRM INSIDE RCH.
;HERE IS THE LOOP THAT GETS CHARACTERS AND PUTS THEM IN THE BUFFER
INSLUP: XCT INSRCH ;GET A CHARACTER (RCH AUTOMATICALLY
;[ ;TAKES CARE OF ALL ^] CALLS AND MACRO
;RETURNS)
INSDCK: SKIPE SQUOTP ;UNLESS WITHIN QUOTED MACRO,
JRST INSDIR
CAMN CH,INSDLM ;THEN SEE IF IT IS THE DELIMITER
JRST INSDUN ;IF SO, YOU'RE ALMOST DONE
INSDIR: SOSGE TOTALC
CALL INSSL1
IDPB CH,BP
JRST INSLUP
INSSL1: SETOM INSBP .SEE BFRRL3 ;FAKE OUT THE ERROR CHECK AT BFRRL3+EPSILON
CALL INSSLP
SETZM INSBP
RET
INSSLP: MOVN C,TOTALC ;HOW MANY CHARS ALREADY KNOWN NEEDED.?
TRNE FF,FRCLN
JRST SLPQRG ;:I, MOVE UP BUFFER AT LEAST THAT MUCH.
ADD C,EXTRAC
JRST SLPSAV ;ELSE MAKE GAP > THAT MUCH BIGGER.
INSDUN: SETOM INSBP
CALL GETCA
AOS OUT,BP ;CHAR ADDR 1ST PLACE NOT STORED IN.
TRNN FF,FRCLN ;IF YOU'RE NOT USING A Q-REG
JRST INS4 ;THEN EVERYTHING IS MUCH SIMPLER
SKIPGE TOTALC ;IF INSERTING 0 CHARS, MAKE SURE SPACE FOR HEADER.
CALL INSSL1
INSDU1: MOVE C,BP ;GET END OF STRING,
MOVE BP,QRWRT ;AND PLACE START OF HEADER SHOULD BE.
SUB C,BP ;# CHARS WE USED (TEXT SIZE +4)
MOVEI B,QRSTR ;THIS IS THE CHAR TO START THE HEADER
CALL QHDRW0 ;WRITE A STRING HEADER AT <- CHAR ADDR IN BP.
INS3: REST B ;GET BACK INFO ON QREG.
REST CH ;GET BACK ADDR OF QREG TO STORE IN.
CALL QCLOSE ;STORE IN IT; OUT HAS CHAR ADDR END OF STRING.
;QRWRT HAS CHAR ADDR OF BEINNING. UPDATES ALL PTRS.
JRST INSRT1
INS4: MOVEM BP,PT
MOVEM BP,GPT
MOVE CH,TOTALC ;# CHARS OF GAP WE DIDN'T USE.
EXCH CH,EXTRAC ;IS WHAT'S LEFT OF THE GAP.
SUB CH,EXTRAC ;AMOUNT WE DID USE
MOVEM CH,INSLEN ;IS # CHARS INSERTED.
ADDM CH,Z ;THAT MANY MORE CHARS NOW.
ADDM CH,ZV
INSRT1: SKIPN INSINP ;0 => WAS CLEARED BY INSCHK, WAS CNM ERROR.
TYPRE [CNM]
SETZM INSINP ;NO LONGER IN MIDDLE OF INSERT.
TRZ FF,FRCLN+FRUPRW ;IF THIS IS :I*, WE ARE RETURNING VALUE SO MUST CLEAR THESE
RET ;BY HAND.
INS1C: ARGDFL
TRNN FF,FRARG2 ;<N>,<CH>I - INSERT <CH> <N> TIMES.
MOVEI E,1
SKIPGE E
TYPAOR: TYPRE [AOR]
TRZE FF,FRCLN
JRST INS1CQ ;INTO QREG?
MOVE CH,NUM ;INTO BUFFER.
ANDCMI FF,FRCLN
PUSHJ P,GAPSLP
SKIPN C,E
RET
CALL SLPGET ;GET C(C) CHARS SPACE, AND B.P. IN BP.
IDPB CH,BP
SOJG C,.-1
RET
TYOMGS: CALL GAPSLP
TYOM: SAVE C
PUSH P,TT
PUSH P,TT1
SAVE BP
MOVEI C,1
CALL SLPGE1
IDPB CH,BP
REST BP
POP P,TT1
POP P,TT
POPCJ: REST C
RET
;<CH>:I<Q> -- INSERT 1 CHAR IN QREG.
;<N>,<CH>:I<Q> -- INSERT <N> COPIES OF CHARACTER.
;<CH>:I* -- RETURNS A STRING CONTAINING THE CHARACTER <CH>.
INS1CQ: CALL QREGVS ;GET ADDR OF QREG IN CH.
TRZ FF,FRARG\FRARG2\FRCLN\FRUPRW
;FLUSH ARG IN CASE :I* - OTHERWISE WOULD ADD ARG TO VALUE.
JUMPE B,INS1CR ;IS THE QREG SUBSCRIPTED? (:I:Q(IDX))
JSP TT,QREGVA ;IF SO, EXTRA HAIR IN CASE OUR CONSING
;MOVES THE Q-VECTOR CONTAINING THE Q-REG.
;CALLS INS1CR, THEN RETURNS TO INSERT'S CALLER.
INS1CR: SAVE B
MOVEI C,4(E) ;NEED 4 CHARS FOR HEADER, + CONTENTS.
CALL SLPQGT ;MOVE BUFFER UP IF NEC.
MOVEI B,QRSTR ;1ST CHARACTER, FOR HEADER.
MOVEI C,4(E) ;LENGTH, FOR HEADER.
CALL QHDRW1 ;WRITE THE STRING HEADER, LEAVE BP IN BP.
MOVE C,E
MOVE A,NUM
IDPB A,BP
SOJG C,.-1
MOVEI OUT,4(E) ;GET ADDR 1ST CHAR THIS NEW STRING DOESN'T USE.
ADD OUT,QRWRT
REST B
JRST QCLOSE ;UPDATE QRWRT; STORE STRING IN QREG <- CH.
SUBTTL GAP CONTROL
IFNDEF SLPAMT,SLPAMT==SLPWRD*5 ;MAKE GAP IN UNITS OF THIS MANY CHARS.
IFNDEF SLPQAM,SLPQAM==SLPQWR*5 ;MOVE BUFFER UP IN UNITS OF THIS MANY.
;MAKE SOME SPACE BY MOVING A SEGMENT OF MEMORY UPWARD.
;REAL CHARACTER ADDR. OF BOTTOM CHAR. OF SEGMENT TO MOVE IN BP
;REAL CHAR ADDR OF SEGMENT IN TT.
;MINIMUM AMOUNT OF SPACE (# OF CHRS) IN C.
;SPACE IS MADE ONLY IN MULTIPLES OF A WORD.
SLPN00: MOVE D,BFRTOP
SUB D,BEG ;GET NUMBER OF CHARS WE WILL HAVE TO MOVE.
CAIL D,2000*5*5 ;IF MORE THAN 5K WORDS, IT PAYS TO MAKE LOTS OF SPACE.
SKIPA D,[2000] ;SO MAKE IT A K AT A TIME, AND USE PAGE-MAPPING.
MOVEI D,200 ;ELSE JUST MAKE 200 WORDS AT A TIME.
MOVE E,@BFRPTR
TLNE E,MFQVEC ;IN A QVECTOR, MAKE ONLY 200 WORDS OF SPACE
MOVEI D,200 ;SINCE THEY NEVER GET VERY BIG.
MOVE E,D
IMULI D,5
ADDI C,-1(D) ;ROUND C, THE NUMBER OF CHARS OF SPACE WE NEED,
IDIV C,D ;UP TO A MULTIPLE OF WHAT'S IN D,
IMUL C,E ;BUT CONVERT IT TO WORDS INSTEAD OF CHARACTERS.
;HERE TO MAKE SPACE FOR IMPURE STRING SPACE.
SLPN0Q: ADDI TT,4
IDIVI TT,5
MOVE E,TT
ADD E,C ;ADDR OF LAST WD TO MOVE INTO, + 1.
SKIPE PSSAVP ;IF SORTING,
CAMGE E,PSMEM ;IF WE'D BE CLOBBERING SORT TABLES, MOVE THEM TOO.
JRST SLPN01
MOVE TT,PSMEMT ;LAST WD TO MOVE UP IS LAST WD OF SORT TABLES,
ADDI TT,3
ADDM C,PSMEM ;RELOCATE POINTERS TO SORT TABLES.
ADDM C,PSMEMT
MOVE E,TT
ADD E,C
SLPN01: ADDI E,2000
LSH E,-10.
CAML E,LHIPAG ;DON'T IMPINGE ON PURE STRING SPACE! LEAVE 1K EMPTY IN BETWEEN.
TYPRE [URK]
IDIVI BP,5
IFN ITS,[
TRNN C,1777 ;IF MAKING SPACE IN UNITS OF A K, DO IT BY PAGE MAPPING
SKIPE PSSAVP ;BUT ONLY IF NO SORT TABLE.
CAIA
JRST SLPN0P ;TO AVOID HAVING TO SWAP EVERYTHING IN.
SLPN0W: SAVE TT
MOVE Q,TT ;IF WE DO HAVE TO SWAP IT IN, USE SEQUENTIAL PAGING.
ADD Q,C
IMULI Q,5
MOVE TT,C
IMULI TT,5
MOVE CH,BP
CALL SEQPAG
REST TT
]
SUBM TT,BP ;BP _ # WDS TO MOVE.
HRLI TT,-1 ;TT HAS -1,,LAST WD + 1.
SUB TT,[1,,1] ;MAKE -> LAST WD (1ST POP WILL MOVE IT)
MOVEI D,(C)
HRLI D,(POP TT,(TT))
MOVE E,[SOJGE BP,D]
MOVE J,[JRST SLPN02]
JRST E
SLPN02: MOVE E,C ;GET BACK # WDS ADDED,
IMULI E,5
ADDM E,TOTALC
IFN ITS,JRST SEQPGX
.ELSE RET
IFN ITS,[
SLPN0P: CAILE TT,2000(BP) ;MAKE SURE WE HAVE AT LEAST A K LEFT TO DO!
SKIPE PSSAVP ;USE PAGE-MAPPING ONLY IF NO SORT TABLE! WE'D CLOBBER IT!
JRST SLPN0W
SLPN03: MOVEI D,-1(TT)
LSH D,-10. ;COMPUTE # OF TOP PAGE TO MOVE,
MOVEI E,1777(TT)
ADD E,C ;AND # OF PAGE TO MOVE IT INTO, + 1.
LSH E,-10.
CAMLE E,MEMT ;SINCE WE ARE MOVING UP THE BOUNDARY OF BUFFER SPACE MEMORY,
MOVEM E,MEMT ;WE MUST REMEMBER THAT.
SUBI E,1 ;NOW CONVERT TO EXACT PAGE TO MOVE INTO.
SYSCAL CORBLK,[%CLIMM,,%CBNDW ? %CLIMM,,%JSELF ? E ? %CLIMM,,%JSELF ? D]
.LOSE %LSSYS
SUBI TT,1
ANDI TT,-2000 ;SET TT TO TOP OF WHAT STILL NEEDS TO BE MOVED.
CAILE TT,2000(BP) ;KEEP MOVING PAGES UNTIL LESS THAN A PAGE REMAINS.
JRST SLPN03
SLPN0R: CAMG E,D ;NOW, MAKE FRESH PAGES WHERE THE NEWLY CREATED GAP IS.
JRST SLPN0W
SOS E ;ENOUGH TO MAKE SURE WE DON'T HAVE ANYTHING IN THE MAP TWICE
SYSCAL CORBLK,[%CLIMM,,%CBNDW ? %CLIMM,,%JSELF ? E ? %CLIMM,,%JSNEW]
.LOSE %LSSYS ;IS EXACTLY THE RIGHT NUMBER.
JRST SLPN0R
] ;IFN ITS
;MAKE SURE GAP AT LEAST SOME MINIMUM SIZE
;(# CHARS IN C)
SLPSAV: CAMG C,EXTRAC
RET
CALL SAVACS
SUB C,EXTRAC ;HOW MANY MORE CHARS NEEDED?
MOVE BP,GPT ;GET ACTUAL ADDR OF END OF GAP.
ADD BP,EXTRAC
MOVE TT,BFRTOP ;GET ACTUAL ADDR OF END OF BUFFER.
SAVE Z
SAVE MEMT
PUSHJ P,SLPN00
MOVEI D,@D ;GET ADDR LAST WD OF NEWLY MADE GAP.
REST BP ;DON'T NEED TO CLEAR NEWLY OBTAINED CORE.
LSH BP,10.
CAML D,BP
SOS D,BP
MOVEI BP,1 ;PREPARE TO CLEAR LOW BITS OF WDS THAT NEED IT.
REST A ;ANY WD PREVIOUSLY PART OF THIS BUFFER DOESN'T NEED IT.
IDIVI A,5
SLPSA2: CAMGE D,A
JRST SLPSA1
ANDCAM BP,(D)
SOJA D,SLPSA2
SLPSA1: ADDM E,EXTRAC
MOVE T,E
MOVE TT,Z
CALL BFRRLC
JRST RSTACS
;LIKE SLPGET, BUT FOR COMMANDS THAT EITHER INSERT IN THE BUFFER
;OR CONS UP AND RETURN A STRING. SUCH COMMANDS SHOULD ALSO EXIT THRU SLPXIT.
SLP: TRNE FF,FRCLN
JRST QOPEN
;INSERT C(C) CHARS AT PT, MAKING SPACE IF NEC.
;PUTS PT AFTER THEM. BRINGS THE GAP TO PT.
;DON'T ACTUALLY PUT ANYTHING IN THOSE CHARS,
;RATHER RETURN IN BP A BP. TO IDPB INTO THEM.
;CLOBBERS TT, TT1. PRESERVES C!
SLPGET: CALL GAPSLP
SLPGE1: CAMLE C,EXTRAC ;HAVE ENOUGH ROOM FOR THE CHARS?
CALL SLPSAV ;NO, STRETCH GAP.
MOVE BP,PT
ADDM C,PT ;UPDATE VARS FOR INSERTION OF THOSE CHARS.
ADDM C,GPT
MOVNS C ;DELETE -<N> CHARS TO UPDATE Z, ZV, EXTRAC.
CALL DELETB ;DELETB NEGATES C.
SOJA BP,GETBP ;MAKE REMEMBERED PT (IN BP) INTO BP.
;MAKE SURE UNUSED SPACE AFTER IMPURE STRING SPACE AT LEAST C(C) CHARS.
;MAY MOVE BUFFER, IN WHICH CASE ALL BUFFER POINTERS WILL
;BE UPDATED AS NECESSARY.
SLPQGT: ADD C,QRWRT ;CHAR ADDR LAST CHAR WE'LL NEED.
SUB C,BFRBOT ;THAT CHAR IN BUFFER?
JUMPL C,CPOPJ ;NO, HVE ENOUGH ROOM.
;GET AT LEAST C(C) MORE UNUSED SPACE FOR IMPURE STRINGS.
;WILL MOVE BUFFER AND UPDATE ALL BUFFER POINTERS.
SLPQRG: CALL SAVACS
MOVE BP,BFRBOT ;MOVE ENTIRE BUFFER.
MOVE TT,BFRTOP ;GET REAL ADDR. END OF BUFFER.
ADDI C,SLPQAM-1
IDIVI C,SLPQAM ;# OF UNIT INCREMENTS WE NEED.
IMULI C,SLPQWR ;# OF WDS TO MOVE THE BUFFER.
CALL SLPN0Q ;MOVE IT.
MOVE BP,BFRBOT
IDIVI BP,5
SLPQR1: SETZM (BP) ;CLEAR ALL WORDS OF SPACE JUST MADE.
AOJ BP, ;NOTE THAT BFRBOT HAS NOT BEEN RELOCATED YET, SO IT POINTS AT
SOJG C,SLPQR1 ;THE BOTTOM OF THE SPACE JUST MADE.
MOVE T,E
CALL BFRMOV ;RELOCATE ALL PTRS TO BUFFER.
JRST RSTACS
;WRITE A STRING HEADER. B HAS INITIAL CHARACTER (QRSTR OR QRBFR),
;C HAS CONTENTS (LENGTH OR BUFFER FRAME ADDRESS).
;BP IS LEFT WITH A B.P. TO LAST CHAR. OF HEADER.
;CLOBBERS C,T,TT.
QHDRW1: MOVE BP,QRWRT ;WRITE HEADER IN FIRST FREE SPOT.
QHDRW0: CALL GETBP ;ASSUME BP HAS CHAR ADDR OF PLACE TO WRITE.
DPB B,BP
IDPB C,BP
LSH C,-7
IDPB C,BP
LSH C,-7
IDPB C,BP
RET
QCLOSV: CALL GETCA ;WHERE DID WE STOP IDPB'ING?
AOS BP
MOVE C,BP
MOVE BP,QRWRT ;BP GETS PLACE TO WRITE HEADER.
MOVE OUT,C ;OUT GETS NEW VALUE FOR QRWRT.
SUB C,BP ;C GETS LENGTH OF WHAT WE JUST WROTE (INCL HEADER)
MOVEI B,QRSTR
CALL QHDRW0 ;WRITE THE HEADER
MOVEI CH,A ;TELL QCLOSE TO STORE INTO A,
SETZ B, ;WHICH IS NOT A NAMED VARIABLE.
JRST QCLOSE
;MAKE SURE THERE IS SPACE IN IMPURE STRING SPACE FOR C(C) CHARS,
;THEN SET UP LISTF5 TO IDPB THRU BP INTO IMPURE STRING SPACE.
QOPEN: SAVE C
ADDI C,4 ;HEADER OF STRING NEDS SPACE TOO.
CALL SLPQGT ;MAKE SURE EXISTS ENOUGH SPACE.
REST C
MOVE BP,QRWRT ;START WRITING INTO UNUSED IMPURE STRING SPACE
ADDI BP,4 ;SKIPPING ROOM FOR THE NEW STRING'S HEADER-TO-BE.
CALL GETIBP
MOVEI A,[IDPB CH,BP ? RET]
HRRM A,LISTF5
POPJ P,
;ASSUME A STRING HAS BEEN STORED IN THE AREA ABOVE QRWRT,
;UPDATE QRWRT AND STORE STRING PTR IN QREG.
QCLOSQ: TDZA B,B ;QREG ADDR IN CH, AND CERTAINLY NOT A NAMED VARIABLE.
QCLOSP: REST CH ;QREG ADDR IS ON STACK. B IS AS RETURNED BY QREGX.
QCLOSE: EXCH OUT,QRWRT ;QREG ADDR IN CH. B IS AS RETURNED BY QREGX.
SUB OUT,QRBUF
TLO OUT,400000
MOVE C,OUT
JRST USE2 ;STORE VALUE IN QREG, WITH ERROR CHECKING ETC.
;CLOSE UP THE GAP, AND SAY IT IS AT PT. CLOBBERS NO ACS. DOESN'T SET MODIFF.
SLPSHT: SKIPN EXTRAC ;NOTHING TO DO IF NO GAP.
JRST GAPSLN
SAVE Q
MOVE Q,Z
CAMN Q,GPT
JRST SLPSH2
EXCH Q,PT
SAVE Q
CALL GAPSL0 ;THEN MOVE THE GAP TO PT. DON'T SET MODIFF.
REST PT
SLPSH2: REST Q
CALL GAPKIL ;NOW GAP IS AT END, JUST FORGET ABOUT IT.
GAPSLN: SAVE PT ;GAP LENGTH IS 0, MAKES NO DIFFERENCE WHERE
REST GPT ;WE SAY THE GAP IS LOCATED.
RET
;ASSUMING THAT THE GAP IS AT THE END OF THE CURRENT BUFFER,
;CLOSE IT UP. CLOBBERS NO ACS. RELOCATES ALL NECESSARY POINTERS
;IN BUFFER FRAMES (AND BFRTOP).
GAPKIL: SAVE A
SAVE B
SAVE C
MOVE A,Z
ADD A,EXTRAC
IDIVI A,5 ;WHAT WORD DOES THE THING AFTER THE BUFFER
MOVE C,A ;ACTUALLY START IN?
IMULI A,5
ADDI A,5
CAML A,BFRTOP ;IF THERE'S NOTHING AFTER THE BUFFER, JUST CHANGE A FEW POINTERS
JRST [ MOVE A,Z ;IN PARTICULAR BFRTOP POINTED AFTER GAP,
IDIVI A,5
IMULI A,5 ;MAKE IT -> CHAR ADDR OF WORD BNDRY
ADDI A,5 ;AFTER THE END OF THE BUFFER.
MOVEM A,BFRTOP
JRST GAPKI1]
IFN ITS,[
INSIRP PUSH P,TT TT1 CH Q
MOVE TT,Z ;ARRANGE FOR SEQUENTIAL PAGING AS WE DO THE BLT.
ADD TT,EXTRAC
MOVE Q,BEG
MOVE CH,BFRTOP
CALL SEQPAG
INSIRP POP P,Q CH TT1 TT
]
SAVE C ;THERE'S ANOTHER BUFFER AFTER THIS ONE.
MOVE A,Z
IDIVI A,5 ;WHAT WORD SHOULD IT START IN (ACTUALLY 1 LESS THAN)
HRL A,(P) ;AND -1+<WHERE IT DOES START>
HRRZ C,A
SUB C,(P) ;C HAS -<HOW FAR DOWN IT'S MOVING>
ADD A,[1,,1] ;<WHERE IT STARTS>,,<WHERE IT SHOULD>
MOVEM A,(P)
MOVE A,BFRTOP
IDIVI A,5 ;WORD FOR BLT TO STOP MOVING OUT OF (PLUS 1)
ADDI A,-1(C)
EXCH C,(P)
BLT C,(A)
IFN ITS,CALL SEQPGX
EXCH T,(P) ;GET # WORDS THINGS MOVED BY.
IMULI T,5
SAVE TT
MOVE TT,Z
ADD TT,EXTRAC
CALL BFRRLC ;RELOCATE PTRS TO BUFFERS WE MOVED.
REST TT
REST T
GAPKI1: SETZM EXTRAC
POPCBA: REST C
POPBAJ: REST B
POPAJ: REST A
RET
;MOVE THE GAP TO PT.
GAPSLP: SKIPE READON ;ALLOWED TO MODIFY?
TYPRE [RDO]
SETOM MODIFF ;IF WE CARE WHERE GAP IS, WE MUST BE ABOUT TO MUNG THE BUFFER.
SETOM MODIFM
GAPSL0: SKIPN EXTRAC ;NO GAP REALLY =>
JRST GAPSLN ;JUST SAY IT'S AT PT, REALLY DOESN'T MATTER.
SAVE Q
MOVE Q,PT
CAMN Q,GPT ;GAP ALREADY AT PT => NOTHING TO DO.
JRST POPQJ
IFN STANSW,[
SAVE A
MOVE A, $QBUFR
CAMN A, TOPBUF ;IF WE ARE IN TOP LEVEL BUFFER,
CALL NEWCNG ; NOTE THE PREVIOUS CHANGES (TRASHES A).
REST A
SKIPN EXTRAC ;NO GAP REALLY =>
JRST [MOVEM Q, GPT ;JUST SAY IT'S AT PT, REALLY DOESN'T MATTER.
JRST POPQJ]
];IFN STANSW
CAMG Q,GPT ;MOVING GAP DOWN => DIFFERENT.
JRST GAPDN
REST Q
CALL SAVACS
GAPUP3: MOVE BP,GPT ;MOVE 1ST FEW CHARS 1 AT A TIME.
CAMN BP,PT ;(WHEN GET HERE 2ND TIME,
JRST RSTACS ;MIGHT BE NOTHING TO MOVE)
ADD BP,EXTRAC ;GET FETCHING PTR -> ABOVE GAP.
CALL GETIBP
MOVE TT,GPT
IDIVI TT,5 ;GET STORING PTR -> BELOW GAP.
MOVE A,PT
SUB A,GPT ;GET TOTAL # CHARS TO BE MOVED.
JUMPE TT1,[SOJA TT,GAPUP2]
GAPUP0: SUBI TT1,5 ;(WILL INCREM. TO 0 WHEN REACH WD BNDRY)
GAPUP1: ILDB IN,BP ;GET A CHAR FROM ABOVE GAP,
DPB IN,BTAB+5(TT1) ;PUT IT BELOW GAP,
AOS GPT ;SAY GAP HAS MOVED UP 1 CHAR.
SOJLE A,RSTACS ;GAP HAS REACHED PT => DONE.
AOJN TT1,GAPUP1 ;EFFECTIVELY IBP THE STORING PTR.
GAPUP2: CAIGE A,5 ;BOTTOM OF GAP NOW ON WD BNDRY,
AOJA TT,GAPUP0 ;< 1 WDS LEFT => KEEP GOING CHAR BY CHAR.
MOVEI C,1(TT) ;GET ADDR 1ST WD TO MOVE DOWN INTO.
IFN ITS,[
MOVE Q,GPT ;SET UP SEQUENTIAL PAGING IN AREA TO MOVE.
ADD Q,EXTRAC
MOVE CH,PT
MOVE TT,EXTRAC
CALL SEQPAG
]
MOVE 10,PT
ADD 10,EXTRAC ;REAL ADDR 1ST CHAR NOT TO MOVE DOWN.
SUBI 10,5 ;DON'T MOVE THE LAST 5 CHARS WITH FAST LOOP (CAN GARBAGE).
IDIVI 10,5 ;10 -> HIGHEST WD TO MOVE DOWN FROM. NOTE 10 = T.
MOVN 12,EXTRAC
IDIVI 12,5 ;12 GETS <# WDS OF GAP, ROUNDED UP>. 13 <- # CHARS ROUNDED BY.
JUMPE 13,[ ;HERE IF CAN USE BLT (ALL ON WORD BNDRYS).
ADD 10,12 ;10 GETS ADDR OF LAST WD TO MOVE DOWN TO.
SUBM C,12 ;12 GETS 1ST ADDR TO MOVE FROM.
MOVEI 11,1(10)
SUB 11,C ;11 GETS # OF WORDS TO MOVE.
IMULI 11,5
ADDM 11,GPT ;UPDATE GPT FOR WHAT WE'RE DOING HERE.
HRLI C,(12)
BLT C,(10)
JRST GAPUP4]
ADDI 12,-1(10) ;12 -> HIGHEST WD TO MOVE DOWN INTO.
MOVNM 13,11
IMULI 11,7
MOVNI 14,-43(11)
SUBI C,1(12) ;C HAS MINUS # WDS TO MOVE
JUMPE C,[AOS TT,12 ;WOULD MOVE 0 WORDS (CAN HAPPEN) => DO REST BY CHARS.
SETZ TT1,
IFN ITS,CALL SEQPGX
JRST GAPUP0]
MOVN 15,C ;UPDATE GPT FOR THE WDS WE'RE MOVING.
IMULI 15,5
ADDM 15,GPT
MOVE 13,12
HRLI 10,(MOVE B,(C))
HRLI 11,(LSHC A,)
MOVE 12,[LSH A,1]
HRLI 13,(MOVEM A,(C))
HRLI 14,(LSHC A,)
MOVE 16,[JRST GAPUP4]
MOVE A,@10
ROT A,-1
MOVE 15,.+1
AOJLE C,10
GAPUP4:
IFN ITS,CALL SEQPGX
JRST GAPUP3
;MOVE THE GAP DOWN (IE MOVE CHARS FROM PT TO GPT UP). Q IS ON THE STACK.
GAPDN:
IFN ITS,[ ;ON TNX, PAGE MAPPING GAP MAKING IS NOT IMPLEMENTED.
MOVE Q,@BFRPTR
TLNE Q,MFQVEC ;IN A QVECTOR, PAGE MAPPING WOULDN'T BE USED
JRST GAPDN7 ;SO THIS HACK WOULD SLOW THINGS DOWN.
MOVE Q,PT
ADD Q,BFRTOP ;COMPUTE AVERAGE OF PT AND BFRTOP.
LSH Q,-1
ADDI Q,5*2000*5 ;IF GAP IS AT LEAST 10K CLOSER TO BFRTOP,
CAMG Q,GPT ;WE WILL SWAP IN 10 FEWER PAGES
JRST [ REST Q ;IF WE KILL THE GAP AND RECREATE IT A PAGE LONG,
JRST SLPSHT] ;BECAUSE GAP CREATION IS DONE WITH PAGE MAPPING.
GAPDN7: ]
MOVE Q,PT
ADD Q,Z
ADD Q,Z
ADD Q,Z ;COMPUTE WEIGHTED AVERAGE OF PT AND Z, THEN COMPARE WITH GPT
LSH Q,-2
CAMG Q,GPT ;IS GPT CLOSER TO PT, OR TO Z?
CALL [ SAVE PT ;GPT IS MUCH CLOSER TO Z THAN TO POINT. SO FASTEST THING
MOVE Q,Z ;IS TO MOVE GAP TO Z, ADJUST WITH GAPADJ, AND
MOVEM Q,PT ;MOVE IT DOWN AGAIN USING A POP-LOOP.
CALL GAPSLP
REST PT
RET]
REST Q ;GPT CLOSER TO PT; FASTER TO MOVE GAP DIRECTLY TO POINT.
CALL SAVACS
MOVE BP,GPT
CAMN BP,Z ;IF GAP IS AT END OF BUFFER, WE CAN ADJUST ITS SIZE A LITTLE
CALL GAPADJ ;AND THEREBY ENABLE WHAT FOLLOWS TO USE A BLT.
GAPDN3: MOVE BP,GPT ;MOVE THE 1ST FEW CHARS UP,
CAMN BP,PT ;(FOR GETTING HERE 2ND TIME WITH
JRST RSTACS ;TO BE MOVED)
CALL GETBP ;GET PTR FOR FETCHING CHARS BELOW GAP,
MOVE TT,GPT
ADD TT,EXTRAC ;GET PTR FOR STORING ABOVE GAP.
IDIVI TT,5
MOVE A,GPT ;GET TOTAL # CHARS MUST MOVE UP.
SUB A,PT
SOJL TT1,GAPDN2 ;ALREADY MOVING TO WD BNDRY.
GAPDN1: DBP7 BP ;GET PTR -> LAST CHAR BELOW GAP.
LDB CH,BP
DPB CH,BTAB(TT1) ;MOVE IT BELOW TOP OF GAP.
SOS GPT ;GAP HAS MOVED DOWN 1 CHAR.
SOJLE A,RSTACS ;GAP HAS REACHED PT => DONE.
SOJGE TT1,GAPDN1 ;EFFECTIVELY DBP7 THE OUTPUT BP.
GAPDN2: CAIGE A,5 ;TOP OF GAP NOW ON WD BNDRY
GAPDN5: SOJA TT,[ADDI TT1,5 ;< 1 WD LEFT, KEEP
JRST GAPDN1] ;CHAR AT A TIME.
IFN ITS,[
MOVE Q,GPT ;SET UP SEQUENTIAL PAGING IN AREA TO MOVE.
ADD Q,EXTRAC
MOVE CH,PT
MOVE TT,EXTRAC
CALL SEQPAG
]
MOVE 13,EXTRAC ;MOVE AS MUCH AS CAN, WD AT A TIME.
IDIVI 13,5
IMULI 14,7
MOVN 11,14
MOVEI 14,-43(14)
MOVE B,PT
ADDI B,4
IDIVI B,5
MOVE 15,GPT
IDIVI 15,5
MOVEI C,(15)
SUB C,B
JUMPE C,[MOVE TT,GPT ;IF CAN'T MOVE ANYTHING WORD-WISE AFTER ALL,
ADD TT,EXTRAC ;REENTER CHAR-AT-A-TIME LOOP
IDIVI TT,5
IFN ITS,CALL SEQPGX
SOJA TT1,GAPDN5]
MOVE 7,B
MOVN 15,C ;MAKE GPT REFLECT THE MOTION OF GAP
IMULI 15,5 ;THAT IS NOW ABOUT TO BE DONE.
ADDM 15,GPT
JUMPE 11,GAPDN4 ;(TRANSLATING BY INTEGRAL # OF WDS.)
ADDI 13,1(7)
HRLI 7,(MOVE A,(C))
HRLOI 10,(LSH A,)
HRLI 11,(LSHC A,)
MOVE 12,[ANDCMI B,1]
HRLI 13,(MOVEM B,(C))
HRLI 14,(LSHC A,)
MOVE 16,[JRST GAPDN6]
MOVE B,@7
MOVE 15,.+1
SOJGE C,7
GAPDN4: HRLI 13,(POP 7,(7)) ;EXTRAC = 0 MOD 5, NEED NOT ROTATE
ADDI 7,-1(C) ;-> HIGHEST WD TO MOVE FROM
HRLI 7,-1 ;PREVENT PDL OV.
MOVE 15,[JRST GAPDN6] ;INSN THAT EXITS LOOP.
MOVE 14,.+1
SOJGE C,13 ;C HAS # WDS TO MOVE.
GAPDN6:
IFN ITS,CALL SEQPGX
JRST GAPDN3
;WHEN THE GAP IS AT Z, WE CAN ADJUST ITS SIZE WITHIN A RANGE OF 5 WITHOUT MOVING ANYTHING.
;IF WE WANT TO MOVE THE GAP DOWN, ADJUSTING ITS SIZE TO A MULTIPLE OF 5
;WILL ENABLE US TO USE A POP-LOOP INSTEAD OF A SLOWER LOOP.
GAPADJ: MOVE A,Z
IDIVI A,5 ;IF EXTRAC IS A MULTPLE OF 5, REAL Z (Z+EXTRAC) MOD 5 IS THIS REMAINDER
MOVE IN,Z
ADD IN,EXTRAC ;SO GET REAL Z
IDIVI IN,5
IMULI IN,5 ;AND ADJUST IT TO EQUAL THAT, MOD 5,
ADD IN,B ;WITHOUT CHANGING WHICH WORD IT POINTS AT.
SUB IN,Z ;BUT Z CAN'T CHANGE, SO THE CHANGE IN REAL Z
MOVEM IN,EXTRAC ;MUST ALL BE DUE TO CHANGE IN EXTRAC.
RET
IFN ITS,[
;MAKE USE OF SEQUENTIAL PAGING WHILE SCANNING THROUGH CORE.
;THE LENGTH IN CHARACTERS OF THE REGION TO BE USED AT ANY INSTANT
;SHOULD BE IN TT.
;THE STARTING CHARACTER ADDRESS OF THE SCAN SHOULD BE IN Q.
;THE STOPPING CHARACTER ADDRESS SHOULD BE IN CH.
;BOTH ARGUMENTS CLOBBERED. CLOBBERS TT1 AND Q ALSO.
;TO STOP USING SEQUENTIAL PAGING, CALL SEQPGX.
;WHILE SEQUENTIAL PAGING IS IN USE, IT CAN BE REQUESTED AGAIN.
;THE INNER REQUESTS ARE IGNORED BUT COUNTED SO THAT THE
;OUTER REQUEST IS NOT TURNED OFF UNTIL THE MATCHING SEQPGX.
;SEQPGV IS LIKE SEQPAG BUT TAKES TWO VIRTUAL ADDRESSES.
SEQPGV: CAMLE Q,GPT
ADD Q,EXTRAC
CAML CH,GPT
ADD CH,EXTRAC
SEQPAG: SKIPE SEQPGE ;CHECK WHETHER PAGE AHEAD IS ENABLED.
AOSE SEQPGC ;DO NOTHING IF ALREADY IN USE.
RET
SETOM SEQPGF ;PAGE AHEAD OFFICIALLY "ON" - BUT USE ONLY IF WORTH WHILE.
ADDI TT,2*5*2000-1
IDIVI TT,5*2000 ;COMPUTE NUMBER OF PAGES WE NEED TO LOOK AT AT ONCE.
HRLZ TT1,SEQPGE ;LH(TT1) HAS PAGE-AHEAD DISTANCE.
CAML Q,CH ;NEGATE PAGE-AHEAD IF MOVING DOWNWARD,
MOVNS TT1
CAMG Q,CH ;NEGATE PAGE-BEHIND IF MOVING UPWARD.
MOVNS TT
CAML Q,CH
EXCH Q,CH ;Q NOW HAS THE LOW END OF THE RANGE TO BE SCANNED, CH HAS HIGH END.
HRR TT1,TT ;TT1 HAS PAGE AHEAD DISTANCE,,PAGE BEHIND DISTANCE.
MOVE TT,Q
ADDI Q,5*2000*3 ;IF TOTAL DISTANCE TO SCAN IS LESS THAN 3 PAGES,
CAML Q,CH ;DON'T BOTHER WITH SEQUENTIAL PAGING.
RET
.SUSET [.SPAGAHD,,TT1]
IDIVI TT,5*2000 ;CONVERT THAT TO PAGE NUMBER.
IDIVI CH,5*2000 ;CONVERT HIGH END TO PAGE NUMBER.
HRL CH,TT
.SUSET [.SPAGRAN,,CH]
SETOM SEQPGN ;PAGE AHEAD IS ACTUALLY ON.
RET
;TURN OFF SEQUENTIAL PAGING.
;MULTIPLE TURN-ONS REQUIRE MULTIPLE TURN-OFFS.
SEQPGX: SKIPE SEQPGF ;ALLOW TURN-OFF WITHOUT TURN-ON.
SOSL SEQPGC ;IF NOT AS MANY TURN-OFFS AS TURN-ONS, DO NOTHING.
RET
SEQPGQ: SETOM SEQPGC
SETZM SEQPGF ;NOW OFFICIALLY "OFF"
SKIPN SEQPGN ;BUT IF IT WASN'T REALLY ON, SAVE THE SYSTEM CALL.
RET
SETZM SEQPGN
.SUSET [.SPAGRAN,,[0]]
.SUSET [.SPAGAHD,,[0]]
RET
];ITS
SUBTTL STRING SPACE GARBAGE COLLECTION
GC:
GCC: SETZM GCNRLC
CAIA
GCNRL: SETOM GCNRLC ;GC TO RECLAIM MACRO FRAMES. DON'T MOVE IMPURE STRINGS.
;(THEREFORE, CAN BE CALLED IN MID-COMMAND)
CALL SAVACS
IFN ITS,[
MOVE A,[-2,,[.SWHO1,,[.BYTE 2,3,3 ? 1 ? 6 ? 6]
.SWHO2,,[SIXBIT/QR GC/]]]
.SUSET A
]
MOVEI A,1000. ;IN CASE WE GET AN URK ERROR IN THIS GC,
SKIPN GCNRLC ;ALLOW SOME CONSING BEFORE NEXT ATTEMPT TO GC.
ADDM A,QRGCMX
MOVEI A,MFSTRT ;LOOK AT ALL BUFFER FRAMES,
MOVSI B,MFMARK
GCC6: MOVE T,MFBEG(A) ;AND CLEAR THE MARK BITS.
TLNE T,MFBFR
ANDCAM B,MFBEG(A)
ADDI A,MFBLEN
CAMGE A,MFEND
JRST GCC6
CALL MEMTOP ;A -> 1ST UNUSED WORD ABOVE BFR & SORT TABLES.
HRLI A,4400
MOVEM A,GCPTR ;GCPTR HAS B.P. TO IDPB INTO HIGH CORE.
PUSH P,A ;REMEMBER WHAT ITS STARTING VALUE WAS.
MOVE C,BFRPTR ;COPY BEG, ETC. INTO CURRENT BUFFER'S
CALL NEWBFR ;FRAME, SO THE LATTER IS UP TO DATE.
CLEARM STABP
MOVE T,[STABP,,STABP+1]
BLT T,SYMEND-1 ;CLEAR THE JUMP CACHE, SINCE IT WILL NOW BECOME INVALID.
MOVEI T,CSTR ;MARK CSTR
PUSHJ P,GCMA
GCC1: MOVEI T,MFSTRT+MFCSTR ;MARK ALL MACRO FRAMES' STRINGS.
GCC2: SKIPGE MFBEG-MFCSTR(T) ;DON'T MARK BUFFER FRAMES THIS WAY.
JRST GCC4
ADDI T,MFARG1-MFCSTR
CALL GCM ;MARK MACRO ARG 1 (MAY BE A STRING POINTER)
ADDI T,MFARG2-MFARG1
CALL GCM ;MARK MACRO ARG 2
SUBI T,MFARG2-MFCSTR ;POINT TO CSTR AGAIN
SKIPE (T)
PUSHJ P,GCMA
GCC4: ADDI T,MFBLEN
CAMGE T,MFEND
JRST GCC2
GCC3: HRRZ T,PF ;MARK THE QREG PDL.
CAIL T,PFL ;MARK BOTH VALUES AND ADDRS, SINCE "ADDR" MIGHT BE A NAME-STRING.
GCC5: CALL GCM
CAILE T,PFL
SOJA T,GCC5
HRRZ T,LEV ;NOW MARK ALL SAVED VALUES
GCC7: SKIPN A,T ;OF ALL PAREN'S.
JRST GCC8 ;WE'VE REACHED THE OUTERMOST; WE'RE DONE.
SUBI T,2 ;GET ADDR OF LAST SAVED VALUE.
CALL GCM
SUBI T,1 ;GET ADDR OF 1ST (IF THERE ARE 2)
MOVE TT,2(T) ;GET THE WORD WHICH SAYS HOW MANY.
TRNE TT,FRARG2 ;IF THERE ARE 2, MARK THE 1ST.
CALL GCM
MOVE T,(A) ;NOW HANDLE NEXT PAREN OUT.
JRST GCC7
GCC8: MOVE T,[-NQREG,,QTAB]
CALL GCM
AOBJN T,.-1
IFN TEXTIF&0,[ ;IM NOT SURE WE NEED THIS HERE, BUT...
SETZM BRKVLD ;INDICATE THAT WE WILL HAVE TO CHANGE THE BREAK TABLE
];IFN TEXTIF&0
MOVE T,[-RRMACL,,RRMACT]
CALL GCM
AOBJN T,.-1
IRPS XX,,DISOMD SBFRS BFRSTR MARG1 MARG2 SARG NUM SYL RRXINV RRENTM RRLEVM RRDISM REFRSH LASTER STEPFL HELPMAC ECHCHR CLKMAC TYISNK TYISRC RREBUF MODMAC TTYMAC RUBMAC RRECSD RRPARN RRTTM1 SUPHND LEDEFS CNGBUF TOPBUF
MOVEI T,XX
CALL GCM
TERMIN
IFN 20X,[
MOVEI T,FRKJCL
CALL GCM
]
POP P,A
MOVE T,A ;STARTING GCPTR MINUS CURRENT
SUB T,GCPTR ;GIVES -<# WDS IDPB'D>
HRLM T,A ;AOBJN -> TABLE OF POINTERS.
ADDI A,1
MOVEM A,GCPTR
JUMPGE A,GCE ;NO ENTRIES => NO IMPURE STRINGS TO GC.
SKIPE GCNRLC ;IF SHOULDN'T MOVE IMPURE STRINGS, SKIP THAT PART.
JRST GCE5
CALL GCSORT ;ELSE SORT POINTERS INTO ORDER STRINGS APPEAR IN MEMORY.
CALL GCSWP ;COMPRESS STRING SPACE, USING GCPTR TABLE TO RELOCATE POINTERS.
MOVE IN,B ;IN GETS NEW VALUE FOR QRWRT.
JRST GCE1 ;GO FLUSH EXCESS PAGES, MAYBE MOVING BUFFER SPACE DOWNWARD.
;MARK THE TECO OBJECT POINTER IN THE WORD WHICH RH(T) POINTS AT.
;IF THE OBJECT IS A POINTER, WE PUSH AN ENTRY ONTO GCPTR.
GCM: MOVE IN,(T)
TLZE IN,400000 ;RETURN IF NOT A STRING POINTER OR IF POINTS AT THE ERROR MESSAGES.
CAIGE IN,EREND*5-INIQRB
RET ;NO NEED TO MARK BUILT-IN ERROR MESSAGES SINCE NOT SWEPT.
ADD IN,QRBUF
GCM3: CAML IN,QRBUF
CAML IN,QRWRT ;FINISH CHECKING THAT IT REALLY POINTS INTO IMPURE STRING SPACE.
RET
CALL GETCHR ;DOES IT POINT AT A 177 OR 176?
CAIN CH,QRBFR
JRST GCMB ;176 => THIS IS A BUFFER.
CAIE CH,QRSTR ;177 => THIS IS A STRING.
RET ;ANYTHING ELSE => THIS IS NEITHER. DON'T MARK IT.
;PUSH A GCPTR ENTRY FOR POINTER LOCATION RH(T) AND STRING ADDRESS C(IN).
GCM2: IDPB IN,GCPTR
IDPB T,GCPTR
POPJ P,
;FOUND A POINTER TO A BUFFER.
GCMB: MOVE BP,IN
CALL GCM2 ;MARK THE 4-CHAR STRING THAT WE GO INDIRECT THROUGH,
CALL GETBP ;GO INDIRECT THROUGH IT TO GET FRAME ADDRESS
CALL QLGET4 ;RETURNS <FRAME ADDR>-4
JUMPL B,CPOPJ ;DEAD BUFFER HAS NO BUFFER FRAME.
MOVSI IN,MFMARK ;AND MARK THE BUFFER FRAME AS LIVING.
IOR IN,4(B)
EXCH IN,4(B)
TLNN IN,MFMARK ;IF THE FRAME WASN'T ALREADY MARKED,
TLNN IN,MFQVEC ;AND MUST BE MARKED THROUGH, DO SO.
RET
SAVE T
MOVE T,MFBEG+4(B)
TLZ T,MFBBTS
IDIVI T,5 ;FIRST, MARK BELOW THE GAP.
MOVE TT,MFGPT+4(B)
CALL GCMBR
MOVE T,MFGPT+4(B)
ADD T,MFEXTR+4(B)
IDIVI T,5 ;THEN MARK ABOVE GAP (GPT+EXTRAC TO Z+EXTRAC)
MOVE TT,MFZ+4(B)
ADD TT,MFEXTR+4(B)
CALL GCMBR
POPTJ: REST T
RET
;MARK INDIRECT THROUGH A RANGE OF WORDS (IN A QVECTOR).
GCMBR: SAVE B ;T HAS WORD ADDR, TT CHAR ADDR.
IDIVI TT,5 ;MARK ALL TEH WORDS FROM T TO TT.
SUBM T,TT
HRL T,TT
SKIPGE T
CALL GCM
AOBJN T,.-1
REST B
RET
;HERE TO MARK A BYTE POINTER, SUCH AS CPTR. T POINTS AT THE CSTR WORD OF A
;COMCNT, CPTR, CSTR TRIPLE. IF THE POINTER POINTS INTO IMPURE STRING SPACE,
;WE PUSH A GCPTR ENTRY POINTING AT THE CPTR WORD BUT GIVING THE CHAR ADDR EQUIVALENT
;AS ITS STRING ADDRESS.
GCMA: SAVE GCPTR
CALL GCM ;MARK THE CSTR WORD, AS AN ORDINARY TECO OBJECT.
REST TT
CAMN TT,GCPTR ;IF IT DOESN'T NEED RELOCATION, NEITHER DOES CPTR.
RET
HRRZ IN,CPTR-CSTR(T)
IMULI IN,5 ;WATCH OUT! IF EXECUTING CONTENTS OF BUFFER,
CAML IN,BFRBOT ;CSTR POINTS AT IMPURE STRING SPACE, BUT NOT CPTR!
RET
MOVE IN,1(TT) ;IF CSTR NEEDS IT, SO DOES CPTR; PUSH A MARKER FOR CPTR
IDPB IN,GCPTR ;GIVING THE SAME "CHAR ADDR TO RELOCATE ACCORDING TO"
MOVEI IN,CPTR-CSTR(T)
IDPB IN,GCPTR ;WHICH THE CSTR USED, BUT POINTING AT THE CPTR INSTEAD OF THE CSTR.
RET
;SORT THE POINTER TABLE TO FACILITATE SWEEPING.
;THE POINTERS GO IN THE SAME ORDER AS THE STRINGS THEY POINT AT.
GCSORT: HRRZ A,GCPTR
HLRE B,GCPTR
SUBM A,B
MOVSI C,10
;RECURSIVE RADIX-EXCHANGE SORT.
;A POINTS TO FIRST ENTRY IN THIS SUB-SORT.
;B POINTS TO LAST ENTRY + 1
;C HAS ONE BIT SET, THAT BIT MOST SIGNIFICANT BIT TO SORT ON FOR THIS SUB-SORT.
GCSWPS==2 ;2 WORDS PER TABLE ENTRY.
GCSRT: HRLM B,(P) ;SAVE UPPER BOUND
CAIL A,-GCSWPS(B)
JRST GCSRT7 ;ONE OR ZERO ENTRIES
PUSH P,A ;SAVE LOWER BOUND
GCSRT3: TDNN C,(A) ;BIT SET IN LOWER ENTRY?
JRST GCSRT4 ;NO, INCREMENT TO NEXT AND MAYBE TRY AGAIN
SUBI B,GCSWPS ;YES, NOW BACK UP UPPER POINT
TDNE C,(B) ;BIT CLEAR IN UPPER ENTRY?
JRST GCSRT5 ;NO, CHECK FOR END, DECREMENT B, AND TRY AGAIN
REPEAT GCSWPS,[ ;BIT SET IN LOWER ENTRY AND CLEAR IN UPPER => EXCHANGE ENTRIES
MOVE D,.RPCNT(A)
EXCH D,.RPCNT(B)
MOVEM D,.RPCNT(A)
]
GCSRT4: ADDI A,GCSWPS ;INCREMENT LOWER BOUND POINTER TO NEXT ENTRY
GCSRT5: CAME A,B ;ANY MORE ENTRIES LEFT?
JRST GCSRT3 ;YES, GO PROCESS THEM
;A AND B NOW BOTH POINT TO FIRST ENTRY WITH BIT SET
ROT C,-1 ;ROTATE BIT INDICATOR TO NEXT (LESS SIGNIFICANT) BIT
POP P,A ;RESTORE LOWER BOUND OF ENTIRE SORT
JUMPL C,GCSRT6 ;JUMP IF NO MORE KEY TO SORT ON
PUSHJ P,GCSRT ;SORT BOTTOM PART OF TABLE
HLRZ B,(P) ;RESTORE UPPER BOUND (SORT CLOBBERED A TO MIDDLE)
PUSHJ P,GCSRT ;SORT TOP PART OF TABLE
GCSRT6: ROT C,1 ;BACK UP KEY AGAIN SO AS TOO "NOT CLOBBER C"
GCSRT7: HLRZ A,(P) ;MAKE A POINT ABOVE TABLE ENTRIES SORTED
RET
;SWEEP THE IMPURE STRING SPACE, DISCARDING GARBAGE BY MOVING THE GOOD STUFF DOWN.
GCSWP: MOVE IN,QRBUF
ADDI IN,EREND*5-INIQRB
IDIVI IN,5 ;IN GETS PLACE WE EXPECT NEXT OLD STRING (GARBAGE OR NOT) TO START.
MOVE OUT,IN ;OUT GETS PLACE TO PUT NEXT NON-GARBAGE STRING.
MOVE Q,GCPTR ;Q IS USED TO STEP THROUGH THE POINTER TABLE.
SETZ BP, ;THERE IS NO PENDING BLT, YET.
;WHEN BP IS NONZERO, IT IS THE AC FOR A PENDING BLT. WHEN WE SEE A NON-GARBAGE STRING,
;WE KNOW IT NEEDS TO BE BLT'ED (USUALLY), BUT WE DON'T DO THE BLT UNTIL WE COME
;TO SOME ACTUAL GARBAGE. THAT WAY WE BLT CONTIGUOUS NON-GARBAGE STRINGS TOGETHER.
;INSTEAD OF BLT'ING, WE SET UP BP AS THE BLT AC (OLD START,,NEW START) AS A REMINDER.
;B CONTAINS CHAR ADDR PAST END OF LAST STRING PROCESSED.
MOVE B,QRWRT
;COME HERE TO EXAMINE THE NEXT POINTER AND SEE WHETHER WE HAVE FOUND A GAP OF GARBAGE.
GCSWPL: JUMPGE Q,GCBLT ;NO MORE POINTERS => FINISHED SWEEPING. DO ANY PENDING BLT.
MOVE A,(Q) ;WHERE DOES THE NEXT NON-GARBAGE STRING START?
IDIVI A,5
JUMPE BP,GCSWP2
CAMG A,IN ;STARTS IN THE EXPECTED PLACE => IT IS CONTIGUOUS WITH
JRST GCSWP1 ;PREVIOUS NON-GARBAGE, SO DON'T BLT NOW.
CALL GCBLT ;NOT CONTIGUOUS => BETTER BLT THE OLD STUFF.
;HERE FOR THE BEGINNING OF A CONTIGUOUS RUN OF NON-GARBAGE; SET BP NONZERO
GCSWP2: MOVE IN,A
HRRZ BP,OUT ;AND MAKE BP DESCRIBE HOW THIS STUFF WILL HAVE TO BE BLT'ED.
HRL BP,A
GCSWP1: SAVE BP ;NOW FIND OUT WHERE THIS STRING ENDS.
SETZ B, ;B GETS (EVENTUALLY) LENGTH OF STRING-OBJECT
MOVE BP,(Q)
CALL GETBP ;WHICH IS IT? A BUFFER OR A STRING?
LDB CH,BP
CAIN CH,QRBFR ;IF IT'S A BUFFER, THERE'S REALLY JUST A 4-CHAR HEADER HERE.
JRST GCSWP3
CAIE CH,QRSTR ;IF IT'S A STRING, THERE'S THE HEADER PLUS DATA.
.VALUE
CALL QLGET4 ;HOW MUCH DATA?
GCSWP3: ADDI B,3 ;B GETS LENGTH OF HEADER + (DATA IF ANY) - 1.
MOVE BP,(Q)
ADDB BP,B ;BOTH B AND BP HAVE CHAR ADDR OF LAST CHAR.
CALL GETBP ;BP GETS BP TO LDB LAST CHAR.
MOVEI A,1(BP) ;A GETS ADDR OF WORD AFTER THE END OF THIS STRING.
REST BP
SUB A,IN ;NOW INCREASE IN TO EQUAL THAT, AND INCREASE OUT THE SAME AMOUNT.
ADD IN,A ;NEW VALUE OF IN IS WHERE THE NEXT STRING SHOULD START IF IT IS CONTIG.
ADD OUT,A ;ACTUALLY, IT CAN START IN THE PREVIOUS WORD IF IT IS REALLY CONTIG.
;THE CAMG ABOVE WILL NOT SKIP IN EITHER CASE.
;NOW RELOCATE ALL THE POINTERS INTO THIS STRING.
;B IS CHAR ADDR REL QRBUF OF LAST CHAR OF STRING.
;ALL POINTERS LESS THAN OR EQUAL TO THAT POINT INTO THIS STRING.
MOVE C,OUT
SUB C,IN ;C GETS # OF WORDS (NEGATIVE ALWAYS) THIS STRING IS MOVING BY.
MOVE D,C
IMULI D,5 ;D GETS # OF CHARACTERS.
GCSWPR: CAMGE B,(Q) ;AFTER THE LAST POINTER INTO THIS STRING,
JRST GCSWPX ;GO EXAMINE THE NEXT AND MAYBE BLT THIS ONE, ETC.
MOVE A,1(Q)
SKIPL (A) ;ELSE RELOCATE. RELOCATE POSITIVE QTYS (B.P.S) BY WORDS,
ADDM C,(A)
SKIPGE (A) ;RELOCATE NEGATIVE ONES (TECO OBJECTS) BY CHARS.
ADDM D,(A)
AOBJN Q,.+1
AOBJN Q,GCSWPR ;LOOK AT ALL PTRS. IF RUN OUT, DO ANY PENDING BLT AND WE'RE DONE.
GCSWPX: ADD B,D ;B NOW HAS NEW CHAR ADDR OF LAST CHAR, NOT OLD CHAR ADDR.
AOJA B,GCSWPL ;NOW IT HAS ADDR OF CHAR AFTER THE END.
;DO THE PENDING BLT DESCRIBED BY BP. OUT, THE PLACE TO START THE NEXT GOOD STRING,
;TELLS US WHERE THE BLT SHOULD STOP.
GCBLT: JUMPE BP,CPOPJ
CAIN OUT,(BP)
.VALUE
MOVS C,BP
CAME C,BP ;DON'T DO THE BLT IF IT IS SHIFTING BY 0 WORDS.
BLT BP,-1(OUT)
SETZ BP,
RET
GCE5: SKIPA IN,QRWRT
GCE: MOVE IN,QRBUF
GCE1: MOVE CH,IN ;GC AGAIN AFTER GCOFTN CHARS
ADDI CH,GCOFTN ;OF IMPURE STRING ARE CREATED.
SKIPL GCNRLC
MOVEM CH,QRGCMX
MOVE A,QRWRT ;REMEMBER OLD TOP OF IMPURE STRING SPACE FOR SAKE OF LOW BIT CLEARING.
CAMGE A,IN ;GC PRODUCED NEGATIVE FREE SPACE?
.VALUE
MOVEM IN,QRWRT ;CHAR ADDR ABOVE END OF STRING SPACE.
ADDI IN,SLPQAM*2 ;LEAVE 2*SLPQAM CHARS SPACE TO WRITE MORE STRINGS INTO,
MOVE CH,IN
ADDI CH,SLPQAM
CAML CH,BFRBOT ;AND IF BUFFER SPACE STARTS AT LEAST SLPQAM ABOVE THAT POINT,
MOVE IN,BFRBOT ;MOVE IT DOWN TO THAT POINT. ELSE DON'T MOVE IT.
IDIVI IN,5
IFN ITS,[
MOVE CH,QRWRT
ADDI CH,2000*5-1 ;COMPUTE 1ST PAGE IMPURE STRINGS DON'T NEED.
IDIVI CH,2000*5
LDB Q,[121000,,IN] ;AND 1ST PAGE BUFFER NEEDS.
SUBM CH,Q ;-<# PAGES WE CAN FLUSH>
JUMPE Q,GCE2
SKIPL Q
.VALUE
SAVE CH
HRLI CH,(Q) ;AOBJN -> PAGES TO FLUSH.
SYSCAL CORBLK,[%CLIMM,,0 ? %CLIMM,,%JSELF ? CH]
.LOSE %LSSYS
REST CH
IMULI CH,2000*5
CAML A,CH ;BETTER NOT CLEAR LOW BITS IN THE PAGES WE JUST FLUSHED.
MOVE A,CH
GCE2:
]
SAVE A
MOVEI A,MFSTRT ;LOOK AT ALL BUFFER FRAMES,
GCE3: MOVE T,MFBEG(A) ;AND RELEASE ALL THE DEAD ONES.
TLNN T,MFBFR
JRST GCE4 ;THIS IS A MACRO CALL, NOT A BUFFER.
TLZN T,MFMARK
JRST [ CALL KILBFR ;THIS ONE IS DEAD.
JRST GCE4]
MOVEM T,MFBEG(A) ;CLEAR THE MARK-BIT.
GCE4: ADDI A,MFBLEN
CAMGE A,MFEND
JRST GCE3
REST A
IDIVI A,5
CAML A,IN ;DON'T CLEAR LOW BITS IN CORE THAT BUFFERS WILL OCCUPY.
MOVE A,IN
MOVE T,QRWRT ;NOW, CLEAR LOW BITS BY CLEARING ALL OF THE EXISTING
ADDI T,4 ;CORE FROM THE TOP OF THE OCCUPIED PORTION OF
IDIVI T,5 ;IMPURE STRING SPACE UP TO BUFFER SPACE.
CAMG A,T
JRST GCE7
MOVE C,[SIXBIT /LBCLR/]
MOVEM C,(T) ;STORE THIS RECOGNIZABLE CONSTANT TO CLEAR THE LOW BIT
HRL T,T ;(FOR SAKE OF DEBUGGING).
ADDI T,1
CAIL A,1(T)
BLT T,-1(A)
GCE7: MOVE T,BFRBOT ;C(IN) IS THE PLACE BUFFER SPACE
IDIVI T,5 ;SHOULD START; MOVE IT DOWN IF NEC.
CAMG T,IN
JRST GCE6
SUBM IN,T
HRLS IN
SUB IN,T
MOVSS IN
MOVE C,BFRTOP
IDIVI C,5
ADDI C,(T)
BLT IN,(C)
CALL BFRMVW
GCE6: CALL FLSCOR
IFN ITS,.SUSET [.SWHO1,,[0]]
JRST RSTACS
;PUSHJ HERE, AND IT RETURNS WITH ACS 0-16 SAVED.
IFN P-17,.ERR PDL POINTER NOT AC17
.SEE CIRC ;THIS DEPENDS ON THE ORDER OF THE AC'S
SAVACS: ADD P,[16,,16] ;MAKE ROOM ON STACK FOR 1 THRU 16.
MOVEM 1,-15(P) ;SAVE 1
MOVEI 1,-14(P)
HRLI 1,2
BLT 1,(P) ;USE 1 TO SAVE THE REST
MOVE 1,-15(P) ;RESTORE 1.
SKIPL P
TYPRE [PDL]
SAVE -16(P) ;PUT RETURN PC ON TOP OF STACK,
MOVEM 0,-17(P) ;SAVE AC 0 IN ITS PLACE,
RET
;JRST RSTACS TO UNDO A SAVACS, THEN POPJ OUT OF THE ROUTINE THAT CALLED THE SAVACS.
RSTACS: MOVSI 16,-16(P) ;GET START OF WHERE THEY ARE
HRRI 16,0
BLT 16,16 ;RESTORE THE REST
SUB P,[17,,17]
RET
RST321: REST C ;JSP A,RST321 TO POP ACS 3 2 AND 1 OFF THE STACK
REST B
EXCH A,(P)
RET
SUBTTL BUFFER SELECTION, CREATION AND KILLING
;A -> BUFFER FRAME; FREE THE FRAME AND THE SPACE IT POINTS TO.
;CLOBBERS C,E,T,TT.
KILBFR: MOVSI C,MFREADO
ANDCAM C,(A) ;MAKE READ-ONLY BUFFER WRITEABLE SO WE DON'T GET ERROR EMPTYING IT.
MOVEI C,(A)
SAVE BFRPTR
CALL NEWBFR ;SELECT THAT BUFFER FRAME AS CURRENT.
MOVE C,Z
MOVE E,BEG
CALL DELET1 ;DELETE ALL THE TEXT IN IT.
MOVEI C,5 ;FAKE GAPKIL INTO CLOSING UP THE 1-WORD INTER-BUFFER
ADDM C,EXTRAC ;GAP, AS WELL AS THE ACTUAL SPACE OCCUPIED BY THIS BFR.
MOVNI C,5
ADDM C,Z
CALL GAPKIL ;FLUSH ALL SPACE IN BUFFER AREA USED BY THIS BUFFER.
SETZM MFBEG(A) ;FREE THE BUFFER FRAME BY CLEARING MFBFR BIT
SAVE A
SOJ A,
CALL FLSFRM ;AND PUTTING ON FREELIST (WHOSE POINTERS -> FRAME-1)
REST A
REST C ;NOW RESELECT THE BUFFER THAT WAS CURRENT AT CALL.
;WITH OUT DESELECTING THE NOW-DEAD BUFFER
JRST NEWBF1 ;(THE IDEA IS TO AVOID SETTING ITS MFBFR BIT).
;C -> BUFFER FRAME; SELECT IT AS CURRENT. SETS UP BEG, ETC.
;CLOBBERS C,T,TT.
NEWBFR: MOVE T,BFRPTR ;COPY BEG, ETC. BACK INTO THE FRAME
MOVE TT,T ;THEY CAME FROM.
HRLI T,BEG ;(THAT IS, THE ONE CEASING TO BE CURRENT)
HLL C,MFBEG(TT) ;DON'T CLOBBER THE MFBFR AND MFMARK BITS.
BLT T,MFEXTR(TT)
HLLZ T,C ;WE SAVE THE BITS IN LH(C) TO AVOID USING ANY STACK.
ANDI C,-1 ;A PDL OV IN HERE WOULD BE HORRIBLE.
AND T,[MFBBTS-MFMODIF-MFREADO-MFMODM,,]
SKIPE MODIFF
TLO T,MFMODIF ;STORE MODIFF OF DESELECTED BUFFER AS A BIT.
SKIPE MODIFM
TLO T,MFMODM ;STORE MODIFM ALSO.
SKIPE READON
TLO T,MFREADO ;AND FS READ ONLY$
IORM T,MFBEG(TT)
NEWBF1: MOVEM C,BFRPTR ;REMEMBER WHICH FRAME NOW CURRENT.
SKIPL T,(C) ;SELECTING A FRAME WHICH ISN'T A BUFFER?
.VALUE
LDB TT,[.BP (MFREADO),T]
MOVEM TT,READON ;RESTORE READONLY FLAG
LDB TT,[.BP (MFMODM),T]
MOVEM TT,MODIFM
AND T,[MFMODIF,,]
MOVEM T,MODIFF ;RESTORE THE MODIFF OF THE BUFFER BEING SELECTED.
MOVSS C
HRRI C,BEG
BLT C,EXTRAC ;SET UP VARS FOR IT.
MOVSI T,MFBBTS ;BUFFER FLAG BITS SHOULD BE IN MFBEG BUT NOT BEG.
ANDCAM T,BEG
RET
;<N>FSWORD$ RETURNS WORD OF BUFFER CONTAINING CHARACTER AFTER <N>
;<W>,<N>FSWORD$ ALSO SETS THAT WORD TO <W>. NOTE THAT NO WORD EVER
;CONTAINS PART OF 2 DIFFERENT BUFFERS, BECAUSE OF FSBCREATE$'S ALLOCATION POLICY.
FSWORD: TRZN FF,FRARG
TYPRE [WNA]
TRZE FF,FRARG2
IORI FF,FRARG ;2 ARGS => WRITING; ELSE READING.
ADD C,BEG ;GET VIRT CHAR ADDRESS OF A CHAR IN DESIRED WORD.
CALL CHK ;"NIB" IF OUTSIDE BUFFER BOUNDS.
TRNN FF,FRARG ;WRITING IN FS WORD$ MODIFIES BUFFER CONTENTS.
JRST FSWRD1
SKIPE READON ;ALLOWED TO MODIFY THIS BUFFER?
TYPRE [RDO]
SETOM MODIFF
SETOM MODIFM
FSWRD1: CAML C,GPT ;CONVERT VIRTUAL ADDRESS TO REAL ADDRESS.
ADD C,EXTRAC
IDIVI C,5 ;GET ADDRESS OF WORD CONTAINING CHAR AFTER SPEC'D CHAR ADDR.
MOVE E,C ;PUT ADDRESS OF FLAG-WORD IN E FOR FSNORM
MOVE C,SARG ;AND VALUE TO STORE (IF ANY) IN C, THE ARGUMENT TO FSNORM.
JRST FSNOR1 ;NOW READ AND MAYBE WRITE THE BUFFER WORD.
BFRMVW: IMULI T,5
BFRMOV: MOVE TT,BFRBOT
ADDM T,BFRBOT
ADDM T,BEG
ADDM T,BEGV
ADDM T,PT
ADDM T,GPT
ADDM T,ZV
ADDM T,Z
JRST BFRRLC
;RELOCATE POINTERS INTO BUFFER SPACE WHEN PART OF IT MOVES.
;ALL POINTERS IN ALL BUFFER FRAMES ARE CHANGED IF THEY ARE
;LARGER THAN C(TT) WHICH IS PRESUMABLY THE CHAR ADDR AT WHICH
;SOMETHING GREW OR SHRANK. C(T) IS THE AMOUNT TO ADD TO EACH
;POINTER. DOES NOT RELOCATE BEG, BEGV, PT, GPT, ZV OR Z.
;BYTE POINTERS IN MACRO FRAMES, AND CPTR AND INSBP, ARE ALSO RELOCATED.
;CLOBBERS A,C. RELOCATES BFRTOP PROPERLY.
BFRRLC: SKIPL @BFRPTR ;CURRENT BUFFER HEADER ISN'T A BUFFER HEADER?
.VALUE
SAVE BP
MOVE A,BFRTOP ;TO SAVE TIME, IF WE CAN FIGURE OUT THAT THE CHANGE
SUBI A,5 ;TOOK PLACE IN THE UPPERMOST BUFFER, THEN WE KNOW NO
CAMLE TT,A ;BUFFER HAS TO BE RELOCATED.
JRST BFRRL3 ;SO WE DON'T HAVE TO TEST THEM ALL.
MOVEI A,MFSTRT ;SCAN ALL BUFFER FRAMES.
BFRRL1: SKIPL C,MFBEG(A) .SEE MFBFR
JRST BFRRL4 ;THIS FRAME ISN'T A BUFFER FRAME.
TLZ C,MFBBTS ;IT IS A BUFFER FRAME.
CAME A,BFRPTR
CAMGE C,TT ;IS IT HIGH ENOUGH IN MEMORY TO BE RELOCATED?
JRST BFRRL2
INSIRP ADDM T(A),MFBEG MFBEGV MFPT MFGPT MFZV MFZ
ADD C,T
CAMGE C,BFRBOT ;BUFFER RELOCATED TO BELOW BUFFER SPACE?
.VALUE
BFRRL2: ADDI A,MFBLEN
CAMGE A,MFEND
JRST BFRRL1
BFRRL3: MOVE BP,CPTR ;RELOCATE CPTR - MAYBE WE'RE EXECUTING OUT OF A BUFFER NOW.
CALL BFRRL5
MOVEM BP,CPTR
SKIPE INSINP
SKIPE INSBP
CAIA
.VALUE ;IN INSERT, AND INSBP ISN'T SAVING IT??
MOVE BP,INSBP
CALL BFRRL5
MOVEM BP,INSBP
ADDM T,BFRTOP
SKIPL @BFRPTR
.VALUE
POPBPJ: REST BP
RET
BFRRL4: MOVE BP,MFCPTR(A) ;MACRO FRAME FOUND: IF THE CPTR POINTS AT A BUFFER,
JUMPE BP,BFRRL2
CALL BFRRL5 ;RELOCATE IT IF THAT BUFFER IS MOVING.
MOVEM BP,MFCPTR(A)
JRST BFRRL2
BFRRL5: SAVE TT ;BP HAS A B.P. EITHER RELOCATE IT, OR SKIP IF IT'S UNCHANGED.
CALL GETCA
REST TT
CAMGE BP,BFRTOP
CAMGE BP,TT
JRST POPJ1 ;IF WE SKIP, BP IS CLOBBERED, BUT CALLER SHOULD ASSUME UNCHANGED.
ADD BP,T ;RELOCATE THE POINTER IF NEC.
SAVE TT
CALL GETBP
REST TT
RET
BFRSE2: MOVEM B,PF ;SPECIAL ENTRY FROM FSQPUN
;STORE BACK QREG PDL PTR; OTHERWISE ERROR QNB WOULD
;CAUSE A LOOP DUE TO AUTOMATIC UNWIND.
;SELECT THE BUFFER IN THE Q-REG CH POINTS AT (PRESUMABLY ..O), PROVIDED IT IS LEGITIMATE.
;OTHERWISE, CLOBBER THE QREG BACK TO THE CURRENTLY SELECTED BUFFER.
BFRSE1: SAVE C
MOVE C,BFRSTR
EXCH C,(CH)
CALL BFRSET ;WHILE WE SELECT IT, KEEP THE OLD, GOOD BUFFER IN ..O.
MOVEM C,(CH) ;THEN PUT NEW ONE BACK IN ..O WHEN ERROR CAN'T HAPPEN.
JRST POPCJ
;ASSUME C HAS A STRING PTR TO A BUFFER'S POINTER STRING;
;MAKE THAT BUFFER CURRENT. CLOBBERS BP,T,TT.
BFRSET: SAVE C
SAVE CH
SAVE B
SAVE C
CALL QBGET
SKIPN C,B
TYPRE [QNB] ;SELECTING A KILLED BUFFER?
REST BFRSTR
REST B
CALL NEWBFR
REST CH
JRST POPCJ
;C HAS STRING PTR TO PTR STRING OF BUFFER.
;RETURN IN B THE ADDR OF THE FRAME.
;RETURN IN CH A BP TO 1ST CHAR OF POINTER STRING.
;CLOBBERS BP,T,TT.
QBGET: MOVE BP,C
QBGET2: ADD BP,QRBUF
TLZE BP,400000
CAML BP,QRWRT
TYPRE [QNB]
CALL GETBP
LDB CH,BP
CAIE CH,QRBFR
TYPRE [QNB]
MOVE CH,BP
CALL QLGET4 ;FORM NEXT 3 CHARS INTO NUMBER IN B
ADDI B,4 ;QLGET4 SUBTRACTS 4; WE MUST COMPENSATE.
RET
;HERE TO DECODE A BUFFER POINTER IN BP, AND ALSO MAKE SURE, IN CASE IT IS THE
;SELECTED BUFFER, THAT THE WORDS IN THE BUFFER BLOCK ARE UP TO DATE.
QBGET1: CAME BP,BFRSTR
JRST QBGET2
SAVE C
MOVE C,BFRPTR
CALL NEWBFR
REST C
JRST QBGET2
;FS BCREATE$ -- CREATE A NEW BUFFER, AND MAKE IT CURRENT.
FSCRBF: CALL FSCRB1
MOVEI CH,$QBUFR ;ADDR OF QREG TO STORE IN.
CALL QCLOSQ
MOVEM OUT,BFRSTR ;SET INTERNAL Q..O AS WELL.
MOVE C,A
JRST NEWBFR ;SET PREDIGESTED Q..O (BFRPTR) AS WELL.
;FS BCONS$ -- RETURNS A NEWLY CREATED BUFFER.
FSBCON: CALL FSCRB1
FSBCO1: MOVEI CH,A
CALL QCLOSQ
JRST POPJ1
;FS QVECTOR$ -- RETURNS A QREG VECTOR BUFFER.
FSQVEC: CALL FSCRB1
MOVSI T,MFQVEC
IORM T,(A) ;NOTE A -> BUFFER FRAME.
JRST FSBCO1
FSCRB1: TRZN FF,FRARG
SETZ C, ;C HAS # OF CHARS OF SPACE TO MAKE IN THE BUFFER.
SAVE C ;(SPACE IS NOT INITIALIZED).
MOVEI C,4
CALL SLPQGT ;GET SPACE FOR POINTER-STRING.
;NOW THE BUFFERS WON'T MOVE, SO WE CAN SET
;UP THE POINTERS IN THE FRAME.
CALL GETFRM ;OBTAIN FRAME FOR BUFFER; ADDR IN A.
MOVEI A,1(A) ;GETFRM ACTUALLY GIVES ADDR OF FRAME MINUS 1.
SETZM MFEXTR(A)
MOVE C,BFRTOP ;PUT THIS NEW BUFFER AT TOP OF MEM.
INSIRP MOVEM C(A),MFBEGV MFPT MFGPT MFZV MFZ
TLO C,MFBFR ;MARK THIS FRAME AS A BUFFER FRAME
MOVEM C,MFBEG(A)
TLZ C,MFBFR
IDIVI C,5 ;FIND WHICH WORD WE START IN
HRLZ TT,C ;MAKE A BLT POINTER TO ZERO STARTING FROM THERE.
HRRI TT,1(C)
REST C ;HOW MUCH SPACE DO WE WANT?
ADDM C,MFZV(A) ;INCLUDE IT IN THE BUFFER BY SETTING Z AND ZV.
ADDB C,MFZ(A)
IDIVI C,5 ;WHICH WORD DO WE END IN?
SETZM -1(TT) ;ZERO ALL THE SPACE, INCLUDING THAT WORD.
CAIE C,-1(TT)
BLT TT,(C)
IMULI C,5 ;FIND THE NEXT WORD BOUNDARY, FOR NEW TOP OF BUFFER SPACE.
ADDI C,5
MOVEM C,BFRTOP ;EACH BUFFER GETS A WORD OF SPACE SO THEY'RE SEPARATED.
MOVEI B,QRBFR ;NOW CREATE THE POINTER STRING IN SPACE ALREADY RESERVED.
MOVE C,A ;IT SHOULD CONTAIN THE ADDR OF THE BUFFER FRAME.
CALL QHDRW1
MOVEI OUT,4
ADD OUT,QRWRT
RET
;FS BKILL$ -- TAKES ARG = STRING POINTER TO PTR STRING OF BUFFER,
;AND KILLS THAT BUFFER. THAT IS, THE BUFFER FRAME AND TEXT ARE FREED,
;AND THE PTR STRING IS CHANGED TO BE A DEAD BUFFER. IF NO ARG,
;[ ;DO " Q..O(]..O[A)UA QA-Q..O"NFSBKILL$' ]A ".
FSKILB: TRZE FF,FRARG ;IF THERE'S AN ARG, USE IT.
JRST FSKIL1
SAVE $QBUFR ;OTHERWISE, POP QREG PDL INTO Q..O,
MOVEI CH,$QBUFR
CALL CLOSB2
REST C ;AND IF POPPED VALUE DIFFERS FROM PREV. CONTENTS,
CAMN C,$QBUFR ;KILL THE PREVIOUS CONTENTS.
RET
FSKIL1: SKIPN KILMOD
RET ;ALLOW THIS TO BE DISABLED FOR DEBUGGING.
CALL QBGET ;GET ADDR OF FRAME IN B.
CAMN B,BFRPTR
TYPRE [KCB] ;KILL A BUFFER WHILE IT'S SELECTED?
SKIPN A,B
RET ;KILLING A DEAD BUFFER.
SETZ Q,
IDPB Q,CH ;STORE 0'S IN BUFFER-FRAME-ADDR IN PTR STRING.
IDPB Q,CH
IDPB Q,CH
JRST KILBFR ;FREE FRAME AND TEXT.
;F[B BIND$ -- PUSH THE CURRENT BUFFER. F]B BIND$ -- POP IT.
FSBBIN: TRNN FF,FRARG
JRST FSBBI3 ;NO ARG => MUST BE PUSHING.
JUMPGE C,FSBBI3 ;ARG IS POSITIVE => MUST BE SIZE OF BUFFER TO MAKE, SO WE'RE PUSHING.
SAVE BFRSTR ;ARG => POPPING. REMEMBER THE INNER BINDING BEING FLUSHED.
MOVEM C,$QBUFR
CALL BFRSET ;SELECT THE OLD BINDING (IN C)
REST C ;KILL THE INNER BINDING AFTER THAT SUCCEEDS.
JRST FSKIL1
FSBBI3: TRO FF,FRARG
CALL FSBCONS ;PUSHING THE SEARCH TABLE: MAKE A NEW ONE,
JFCL
SAVE BFRSTR ;SAVE THE OLD ONE TO RETURN, AND SELECT NEW ONE.
MOVE C,A
CALL BFRSET
MOVEM A,$QBUFR
POPAJ1: REST A ;THEN RETURN THE OLD ONE (TO GO ON QREG PDL).
JRST POPJ1
;EMACS BUFFER SWITCH LOCAL VARIABLE SWAPPING
;<M>,<N>F^G<Q> - DO A LOCAL VARIABLE SWAP FOR THE EMACS BUFFER TABLE.
;<Q> IS THE BUFFER WHICH IS THE EMACS BUFFER TABLE.
;<M> IS THE WORD OFFSET (VIRTUAL) OF AN ENTRY IN IT.
;<N> IS THE POSITION WITHIN THAT ENTRY OF THE FIRST LOCAL VARIABLE.
;LOCAL VARIABLES FILL ALL THE REST OF THE ENTRY FROM THERE
; (THE TOTAL LENGTH OF THE ENTRY IS ITS FIRST WORD).
;EACH LOCAL VARIABLE TAKES TWO WORDS:
; THE FIRST IS THE NAME AS A STRING POINTER, OR THE :FSQPHOME$ OF A ^R COMMAND SLOT OR Q-REG,
; AND THE SECOND IS THE SWAPPED-OUT VALUE.
;@F^G ONLY STORES THE CURRENT VALUES INTO THE BUFFER TABLE.
;:F^G ONLY GETS NEW VALUES OUT OF THE BUFFER TABLE.
;NOTE: WE ASSUME THAT THE GAP IN THE BUFFER TABLE IS NOT IN THE MIDDLE OF THIS ENTRY!
;IT IS OK IF IT IS DIRECTLY IN FRONT OR BEHIND THE ENTRY.
FCTLG: EXCH C,E ;HAHA I THOUGHT <M>,<N> PUT <M> IN C AND <N> IN E, SO MAKE IT THAT WAY.
CALL QREGX ;READ QREG CONTAINING THE BUFFER TABLE.
MOVE BP,A
CALL QBGET1 ;B GETS PTR TO BUFFER TABLE'S BUFFER FRAME.
IMULI C,5 ;C HAS CHARACTER POINTER TO START OF EMACS BUFFER'S ENTRY.
ADD C,MFBEGV(B)
CAML C,MFGPT(B)
ADD C,MFEXTR(B)
IDIVI C,5 ;C NOW HAS WORD ADDRESS OF START OF ENTRY.
MOVE D,(C) ;D HAS LENGTH OF ENTRY.
ADD C,E ;C NOW GETS POINTER TO FIRST LOCAL VARIABLE ENTRY.
SUB D,E ;D HAS # OF WORDS LEFT (TWICE NUMBER OF LOCAL VARS).
JUMPLE D,CPOPJ
;HACK THE NEXT LOCAL VAR. C POINTS TO THE WORD IN THE BUFFER TABLE HOLDING ITS NAME.
;D HAS THE NUMBER OF WORDS OF LOCAL VARS LEFT TO HACK IN THIS BUFFER.
FCTLG1: MOVE A,(C)
CALL FCTLG2 ;LOAD NAME OF NEXT LOCAL VAR INTO BAKTAB.
JRST FCTLG4 ;IT ISN'T A STRING => IT IS ADDRESS IN RRMACT.
MOVE IN,QRB.. ;GET STRING POINTER TO SYMBOL TABLE.
MOVE A,.QSYMT(IN)
SAVE C
SAVE D
SAVE FF
TRZ FF,FRCLN\FRUPRW\FRARG\FRARG2
TRO FF,FRUPRW ;INSIST ON EXACT MATCH IN LOCAL VARIABLE NAME.
CALL FOCMD3 ;LOOK UP THAT VARIABLE IN THE SYMBOL TABLE. IN GETS S.T.E. ADDRESS.
TYPRE [UVN]
REST FF
MOVEI CH,1(IN) ;CH GETS ADDR OF VALUE WORD IN S.T.E.
MOVE IN,-1(P) ;IN GETS ADDR OF LOCAL VARIABLE ENTRY./
MOVE D,(CH) ;BEGIN THE EXCHANGE,
MOVE C,1(IN)
TRNN FF,FRCLN ;COLON MEANS DON'T STORE IN THE BUFFER TABLE.
MOVEM D,1(IN)
TRNN FF,FRUPRW ;ATSIGN MEANS DON'T SET THE VARIABLE.
CALL [ SKIPE VARMAC ;IF SETTING THE VAR CAN CALL A MACRO,
JRST USE3 ;USE USE3 TO DO IT SO THAT THE MACRO GETS CALLED.
MOVEM C,(CH) ;OTHERWISE JUST STORE.
RET]
REST D
REST C
JRST FCTLG6
FCTLG4: MOVE IN,A ;HERE IF A LOCAL'S "NAME" ISN'T A STRING.
CAIGE IN,RRMACT+1000 ;IT SHOULD POINT INTO RRMACT OR AT A Q-REG.
CAIGE IN,RRMACT
CAIGE IN,QTAB+NQREG
CAIGE IN,QTAB
CAIA ;SKIP IF NOT THE ADDRESS OF A LEGITIMATE LOCAL Q-REGISTER.
JRST FCTLG5 ;GO SWAP THE CONTENTS OF THAT WORD.
TRNN IN,1
CAIL IN,FLAGSL*2 ;IF IT ISN'T A LOCAL Q-REG, MAYBE IT'S AN FS FLAG.
TYPRE [ILN] ;THEY ARE REPRESENTED BY INDICES INTO THE TABLE FLAGS.
SAVE C
SAVE D
MOVE B,IN ;GET ADDRESS OF FLAG ROUTINE, FOR FSFND.
MOVE C,1(C) ;GET VALUE TO SWAP IN AS ARG TO FLAG ROUTINE.
SAVE FF
TRZ FF,FRCLN+FRARG+FRARG2
TRZN FF,FRUPRW ;IF NO ATSIGN, SET THE FLAG.
TRO FF,FRARG
CALL FSFND ;IN ANY CASE, CALL FLAG ROUTINE SO WE GET THE OLD VALUE
TYPRE [WNA] ;DIDN'T RETURN A VALUE
REST FF
REST D
REST C
TRNN FF,FRCLN ;WHICH, IF NO COLON, WE STORE IN THE BUFFER TABLE.
MOVEM A,1(C)
JRST FCTLG6
FCTLG5: MOVE CH,(IN) ;FETCH BOTH VALUES, TO EXCHANGE THEM.
MOVE Q,1(C)
TRNN FF,FRCLN ;IF NO COLON, STORE IN THE BUFFER TABLE.
MOVEM CH,1(C)
TRNE FF,FRUPRW ;IF NO ATSIGN, SET THE Q-REG.
JRST FCTLG6
MOVEM Q,(IN)
CAIL IN,RRMACT
CAIL IN,RRMACT+1000
JRST FCTLG6
MOVE CH,IN ;IF SETTING ^R CHAR DEFN TO A DIFFERENT VALUE,
CAME CH,Q ;SET THE FLAG SAYING THIS CHAR HAS CHANGED.
CALL USE5
FCTLG6: ADDI C,2 ;MOVE PAST THIS LOCAL VAR AND DECREMENT COUNT OF REMAINING ONES.
SUBI D,2
JUMPG D,FCTLG1
RET ;AFTER HACKING ALL LOCAL VARS, WE ARE DONE.
;GIVEN A STRING POINTER IN A, LOAD THE STRING INTO BAKTAB WITH J POINTING AT THE END.
;SKIPS UNLESS THE OBJECT IN A REALLY IS A STRING.
;CLOBBERS B,BP,CH,TT,TT1.
FCTLG2: CALL QLGET0 ;GET BP TO VAR NAME STRING IN BP AND LENGTH IN B.
RET
MOVEI J,BAKTAB-1
JUMPE B,POPJ1
FCTLG3: ILDB CH,BP ;FETCH NEXT CHAR OF VARIABLE NAME STRING
CAIL CH,"A+40 ;CONVERT LETTERS TO UPPER CASE.
CAILE CH,"Z+40
CAIA
SUBI CH,40
CAMN J,[LTABS,,BAKTAB+LTABS-1]
TYPRE [STL]
PUSH J,CH ;AND STORE IN BAKTAB FOR OUR LOOKUP.
SOJG B,FCTLG3
JRST POPJ1
SUBTTL SEARCH COMMANDS
;GET ARGUMENTS TO SEARCH
GSARG: TRZ FF,FRBACK ;CLEAR SOME FLAGS
ARGDFL Z, ;GET ARGUMENT OR OPERATOR CONVERTED TO VALUE
MOVMM C,SEARG ;STORE # OCCURRENCES TO LOOK FOR.
JUMPL C,GSARGN ;J IF SEARCHING BACKWARDS.
MOVE E,PT ;ELSE RANGE TO SEARCH IS PT TO ZV.
MOVE C,ZV
GSARG2: MOVEI B,SLP1I ;GET-CHAR RTN FOR MOVING FWD.
GSARG1: HRRM B,SLP1P ;STORE GET CHAR RTN ADDR.
GSAPCH: MOVE BP,E ;CHAR ADDR BOTTOM OF RANGE.
CAML E,GPT ;IF CHAR ADDRESSED IS ABOVY RANGE, PT TO IT.
ADD BP,EXTRAC
CALL GETBP
MOVEM BP,BBP ;SAVE BP'S TO BOTTOM OF RANGE.
MOVEM BP,BBP1
MOVE BP,C ;MAKE PTR TO TOP OF RANGE:
CAMG C,GPT ;IF IT IS BEYOND GAP,
CAML E,GPT ;OR BOTTOM IS AT GAP,
ADD BP,EXTRAC ;RELOCATE TO PT ABOVE GAP,
CALL GETBP
MOVEM BP,ZBP
MOVEM BP,ZBP1
CAMGE E,GPT ;IS THE GAP WITHIN RANGE OF SEARCH?
CAMG C,GPT
JRST GSARG7
TRNN FF,FRBACK
JRST GSARG4
MOVE BP,GPT ;IN BACKWARD SEARCH, MUST STOP AT GAP
ADD BP,EXTRAC ;TO MOVE OVER IT.
CALL GETBP
MOVEM BP,BBP1
GSARG4: MOVE BP,GPT ;FOR MOVING FWD OVER GAP,
CALL GETBP
MOVEM BP,ZBP1 ;NEED BP TO START OF GAP.
GSARG7: SUB E,BEG
SUB C,BEG
MOVEM E,SRCBEG ;REMEMBER RANGE SEARCHED, FOR ^B COMMAND.
MOVEM C,SRCEND
POPJ P,
GSARGN: MOVE E,BEGV ;BACKWARDS, RANGE IS BEGV TO PT.
MOVE C,PT
GSARG6: TRO FF,FRBACK
MOVEI B,SLP1D ;RTN TO GET CHARS BACKWARDS.
SETZM PNCHFG ;NEVER READ FROM FILE IF BACKWARD SEARCH FAILS.
JRST GSARG1
GSARGB: TRZ FF,FRBACK ;BOUNDED SEARCH.
MOVEI J,1 ;GO ONLY ONCE.
MOVEM J,SEARG
TRNE FF,FRARG2
CAMG E,C ;IF FB HAS 2 ARGS, IN REVERSE ORDER,
JRST GSARG5
EXCH C,E ;THEN DO BACKWARDS BOUNDED SEARCH.
CALL GETARG
CALL CHK1
JRST GSARG6
GSARG5: CALL GETARG ;GET RANGE IN C,E.
CALL CHK1
JRST GSARG2
;SEARCH COMMANDS
SERCHA: HRRZM P,PNCHFG ;_ COMMAND. PNCHFG POSITIVE.
CAIA
SERCHP: SETOM PNCHFG ;N COMMAND. PNCHFG NEGATIVE.
CAIA
SERCH: SETZM PNCHFG ;S COMMAND. PNCHFG ZERO.
CALL GSARG ;HANDLE ARG, SET UP DISPATCHES.
JRST SERCH1
;FB -- BOUNDED SEARCH. ARGS LIKE K,T. (:FB IS LIKE :S, NOT :K).
FBCMD: SAVE FF ;SAVE FRCLN.
ANDCMI FF,FRCLN\FRUPRW
CALL GSARGB ;GET RANGE OF BUFFER, SET UP DISPATCHES.
SETZM PNCHFG
REST A
ANDI A,FRCLN\FRUPRW ;RESTORE: FLAG SO IT WILL SAY WHETHER TO RETURN A VALUE.
IORI FF,(A)
SERCH1: MOVEI CH,ALTMOD ;NOW TO CHOOSE A TEXT TERMINATOR, DEFAULT IS ALTMODE
TRNE FF,FRUPRW ;UPARROW TYPED?
CALL RCH ;YES, GET NEXT CHARACTER INSTEAD
HRRM CH,INSDLM ;STORE AS DELIMITER
MOVE E,SBFRP ;ADDRESS OF SEARCH BUFFER HEADER BLOCK.
MOVE TT,MFZ(E)
MOVE E,MFBEGV(E) ;CHAR ADDRS OF BEGINNING AND END OF SEARCH BUFFER.
IDIVI E,5
AOS E
MOVEM E,STBLP ;WORD ADDRESS OF SEARCH BUFFER BODY, + 1 (START OF DATA)
HRLM E,STBLPX
IDIVI TT,5
SUBM E,TT ;-<LENGTH OF SEARCH BUFFER, IN WORDS>
HRLI E,-1(TT) ;AOBJN -> SEARCH BUFFER
SETO D, ;SAY THERE ISN'T A CHAR TO BE REREAD.
TRZE FF,FRUPRW
JRST SERCH2
CALL RCH ;IF NOT AN @-TYPE ARG, CHECK FOR NULL ARG
SKIPE SQUOTP
JRST SERCH3 ;DON'T BE CONFUSED BY SUPERQUOTED ALTMODES.
CAIN CH,ALTMOD ;WHICH MEANS REPEAT PREVIOUS SEARCH.
JRST SRLC
SERCH3: MOVE D,CH ;ELSE CAUSE THE CHAR TO BE REREAD.
TLZ D,4^5 ;DON'T LET IT BE NEGATIVE.
JRST SERCH2
;REPEAT THE PREVIOUS SEARCH. THE SEARCH BUFFER CONTAINS POINTERS INTO ITSELF.
;ALL THOSE POINTERS MUST BE RELOCATED IF THE SEAECH BUFFER HAS MOVED SINCE THE LAST
;TIME IT WAS USED. E -> BUFFER BODY BOTTOM. CLOBBERS E,D,TT.
SRLC: SKIPN -1(E) ;DOES BUFFER SAY IT IS VALID?
TYPRE [SNR]
HRRZ TT,(E) ;RH OF 1ST WORD OF TABLE SHOULD POINT TO 2ND.
SUBI TT,1(E) ;SUBTRACT REAL ADDR OF 2ND, GIVES AMOUNT BUFFER HAS MOVED.
MOVNS TT
HRLZ TT1,TT ;WE MAY WANT TO RELOCATE LH'S AS WELL AS RH'S.
JUMPE TT,SRN3 ;DON'T BOTHER RELOCATING IF RLOC. AMOUNT IS 0.
SRLC1: ADDM TT1,(E) ;LH OF EACH SUBSTRING HEADER IS A POINTER.
HRRZ D,(E)
CAIN D,SLP1P ;REACHED END OF TABLE?
JRST SRN3
ADDM TT,(E) ;NO; RH IS ALSO A POINTER.
HLRZ E,(E) ;FIND NEXT SUBSTRING.
JRST SRLC1
;NOW COMPILE SEARCH TABLE
SERCH2: SETZM -1(E) ;WHILE WE SET UP STBL IT IS INVALID.
SCPL: HRRZ C,E ;SAVE LOCATION OF BEGINNING OF BLOCK (LOOP POINT FOR CONTROL O)
MOVEI CH,1(E) ;GET RIGHT HALF OF UPCOMING HEADER
PUSHJ P,SDEP ;DEPOSIT IN TABLE
SCPL1: TDZA A,A ;CLEAR INDEX AND FALL INTO LOOP
SCNOT: TRC A,1 ;CONTROL N, COMPLEMENT 1 BIT INDEX
SKIPGE CH,D ;IF THERE'S A CHAR TO REREAD, USE IT.
CALL RCH ;ELSE GET NEXT CHARACTER.
SETO D, ;FLUSH THE SAVED CHAR IF ANY.
SKIPGE SQUOTP
JRST SCNSP ;SUPERQUOTED CHAR.
SKIPE SQUOTP
JRST SCNDL ;DELIM-PROTECTED CHAR.
CAMN CH,INSDLM ;IF TEXT TERMINATOR (RH MODIFIED),
JRST SCPX ;THEN DONE COMPILING, GO DO IT
SCNDL: CAILE CH,^X
JRST SCNSP
CAIN CH,^X ;IF CONTROL X (FOR "ANY CHARACTER"),
ADDI A,XSER ;THEN SET INDEX
CAIN CH,^B ;IF CONTROL B (FOR BREAK CHARACTER)
ADDI A,BSER ;THEN SET INDEX
CAIN CH,^S
ADDI A,SSER
CAIN CH,^N ;IF CONTROL N (FOR "NOT")
JRST SCNOT ;THEN CLOBBER INDEX AND GET NEXT CHARACTER
CAIN CH,^O ;IF CONTROL O ("OR"),
JRST SCPOR ;THEN GENERATE NEW HEADER
CAIN CH,^Q ;IF CONTROL Q (QUOTES THE NEXT CHARACTER),
CALL RCH ;THEN REALLY USE NEXT CHARACTER, SKIPPING ABOVE TESTS
SCNSP: SKIPE BOTHCA ;BOTHCASE=0 => CASES ARE DISTINCT.
TRNN CH,100 ;BOTHCASE=1 => CASE IGNORED FOR LETTERS ONLY.
JRST SCNSP1 ;BOTHCASE=-1 => CASE IGNORED FOR ALL CHARS > 100 .
ANDI CH,-1 ;SUPERQUOTED CHARS STIL GET CONVERTED.
CAIL CH,"A+40 ;IF IGNORING CASE FOR A CHARACTER, CONVERT IT TO
CAILE CH,"Z+40 ;UPPER CASE HERE, ND ALSO WHIE SEARCHING THE BUFFER.
SKIPG BOTHCA
ANDCMI CH,40
SCNSP1: TRNE A,-2 ;IF INDEX CLOBBERED,
SKIPA CH,(A) ;THEN GET TABLE ENTRY
HLL CH,CHSER(A) ;INDEX NOT CLOBBERED OUT OF EXISTENCE, TURN INTO CAIE OR CAIN
CALL SDEP ;DEPOSIT TABLE ENTRY
CAME CH,SSER
CAMN CH,SSER+1 ;IF IT WAS A ^S OR ^N^S ENTRY,
CALL [CALL RCH ;READ FOLLOWING CHAR AND DEPOSIT AS NEXT TABLE ENTRY.
JRST SDEP]
JRST SCPL1 ;LOOP
SDEP: MOVEM CH,(E) ;ADD AN ENTRY TO THE SEARCH TABLE
AOBJN E,CPOPJ ;RETURN IF TABLE NOT FULL
TYPRE [STL]
SCPX: TDZA B,B ;TEXT TERMINATOR ENCOUNTERED
SCPOR: MOVEI B,SCPL ;CONTROL O
MOVE CH,[JRST WIN] ;SET FINAL TABLE ENTRY (EXECUTED => THIS STRING FOUND)
CAIN C,-1(E)
HRRI CH,WINNL1 ;BUT FOR NULL STRINGS, USE WINNL1 INSTEAD WIN.
PUSHJ P,SDEP ;DEPOSIT
HRLM E,(C) ;STORE POINTER TO THIS HEADER IN LH(LAST HEADER)
JUMPN B,(B) ;JUMP IF NOT TEXT TERMINATOR
MOVS A,STBLPX ;GET LIST CIRCULIZER/POINTER TO ROUTINE TO READ NEXT CHAR.
MOVSM A,(E) ;STORE IN TABLE (THIS LAST ENTRY, DON'T INCREMENT E OR CHECK FOR OVERFLOW)
SETOM -1(A) ;SEARCH TABLE NOW COMPILED.
MOVEI E,1(E)
IMULI E,5
MOVE A,SBFRP
MOVEM E,MFZV(A) ;ZV OF SEARCH BUFER POINTS TO END OF REGION BEING USED.
JRST SRN3
;TABLES FOR COMPILING SEARCH TABLE
XSER: JFCL ;CONTROL X
CAIA ;NOT CONTROL X
BSER: PUSHJ P,SKNBRK ;CONTROL B
PUSHJ P,SKBRK ;NOT CONTROL B
CHSER: CAIN A, ;NORMAL CHARACTERS (HLL'ED WITH CHAR. IN RIGHT HALF)
CAIE A, ;NOT CHAR.
SSER: PUSHJ P,SKNLSY ;CONTROL S
PUSHJ P,SKLSYN ;NOT CONTROL S.
;THE FOLLOWING WORD OF SEARCH TABLE
;WILL CONTAIN THE CHAR TO COMPARE THE SYNTAX WITH.
;SEARCH TABLE FORMAT
;FOLLOWING IS COMPILATION OF "SFOO SP()"
;EVERY WORD ASSEMBLED WITH ",," IS A SUBSTRING HEADER.
;STBLP POINTS HERE:
;TEM: .+5,,.+1 ;HEADER, LH POINTS TO NEXT COMPARISON STRING
;RH POINTS TO TABLE THIS COMPARISON STRING
; CAIN A,"F ;IF THE TEST IS TO SUCCEED THEN THE INSTRUCTION SHOULD NOT SKIP
; CAIE A,"O ;THE CHARACTERS ARE IN A
; CAIN A,"O
; JRST WIN ;DOES JRST WIN IF ENTIRE STRING HAS BEEN FOUND
; .+10,,.+1 ;THIS LAST COMPARISON STRING BUT LH STILL POINTS SOMEWHERE
; CAIN A,40
; CAIE A,"S
; CAIN A,"P
; PUSHJ P,SKLSYN ;^N^S( ARGS IN THE SEARCH TABLE MUST HAVE OPCODE 0! SEE SLP1Z2.
; "(
; PUSHJ P,SKBRK ;SKBRK => , SKNBRK =>
; JFCL
; CAIN A,")
; JRST WIN
; .+2,,.+1
; JRST WINNL1
; TEM,,SLP1P ;FINAL HEADER, LH POINTS TO FIRST HEADER MAKING LIST CIRCULAR
;RH POINTS TO A JRA B,<ROUTINE TO GET NEXT CHARACTER>
;MAIN SEARCH LOOP
SLP2LC: OFFSET 17-9-.
SLP2::
LDB A,C ;GET CHARACTER
XCT (B) ;COMPARE WITH FIRST CHARACTER THIS COMPARISON STRING
;SKIP => THIS CHARACTER LOSES, TRY NEXT COMPARISON STRING
;NO SKIP => THIS CHARACTER WINS, TRY NEXT ONE
;WIN ON STRING => JRST WIN
;THIS CHARACTER TOTALLY LOSES ON ALL COMPARISON STRINGS => EXECUTE SLP1P
;^ => B := FIRST HEADER IN SEARCH TABLE
SLP2A:: SKIPA E,C ;WIN THIS CHARACTER, GET POINTER FOR CHECKING FUTURE CHARACTERS
JRA B,.-2 ;LOSE THIS COMPARISON STRING, TRY NEXT
SLP3::
ILDB A,E ;GET NEXT CHARACTER
XCT 1(B) ;EXECUTE NEXT TABLE ENTRY
CAMN E,ZBP ;IT CLAIMS TO HAVE WON; WAS IT AT END OF BUFFER?
SLP4:: JRA B,SLP2 ;LOSE, TRY NEXT COMPARISON STRING
AOJA B,SLP3 ;WIN THIS CHARACTER, TRY NEXT
IFN .-17,.ERR SLP2 WRONG TABLE LENGTH
OFFSET 0
;FALLS THROUGH.
;ASSUMING THE SEARCH TABLE IS SET UP, DO THE SEARCHING.
SRN3: TRZ FF,FRARG+FRARG2
SETOB A,SFINDF ;A NULL SEARCH OR SEARCHING 0 TIMES SHOULD STATE THAT IT WON.
SKIPE SEARG ;IF ARGUMENT ZERO, (ENTRY FOR "AGAIN" COMMAND)
JRST SRN2
TRNE FF,FRCLN ;THEN WIN, DON'T BOTHER ACTUALLY SEARCHING.
JRST POPJ1 ;RETURN -1 AS VALUE IF ONE IS WANTED.
RET
;WE7RE FINISHED SETTING UP THE SEARCH TABLE AND BOUNDS. NOW REALLY SEARCH.
SRN2: CALL SKNBCP ;SET UP SKNBPT FROM Q..D, FOR SKNBRK'S SAKE.
IFN ITS,[
MOVE TT,SBFRP ;GET LENGTH OF CONTENTS OF SEARCH BUFFER,
MOVE TT,MFZV(TT) ;WHICH IS UPPER BOUND ON NUMBER OF CONSECUTIVE
SUB TT,STBLP ;CHARACTERS WE MAY NEED TO EXAMINE AT ONCE.
MOVE Q,SRCBEG ;TURN ON SEQUENTIAL PAGING.
MOVE CH,SRCEND
CALL SEQPGV
];ITS
SETZM TEM2 ;NO WINNING SEARCHES FOR SRCV TO DOCUMENT
MOVE C,BBP ;GET PLACE TO START; NORMALLY LOW END
TRNE FF,FRBACK
MOVE C,ZBP ;BUT HIGH END IF REVERSE.
;FOR SEARCH WITH REPEAT COUNT, REPETITIONS COME BACK HERE.
SRN2RP: MOVE E,C ;INIT. BP TO END OF STRING IN CASE FIND NULL STRING.
MOVS 16,[SLP2,,SLP2LC] ;GET POINTER FOR BLTING IN MAIN LOOP
BLT 16,16 ;BLT IN MAIN LOOP
SKIPGE BOTHCA ;IN BOTH-CASES MODE,
MOVE SLP2,[JRST SLPLO1]
SKIPGE BOTHCA ;IGNORE THE CASE OF THE CHARS SEARCHING.
MOVE SLP3,[JRST SLPLOW]
SKIPLE BOTHCA ;BOTHCA POSITIVE => IGNORE CASE OF LETTERS ONLY.
MOVE SLP2,[JRST SLPLO3]
SKIPLE BOTHCA
MOVE SLP3,[JRST SLPLO2]
CALL IMMQIT ;IT'S OK TO QUIT OUT OF MIDDLE OF SEARCH.
MOVE B,ZBP
TRNN FF,FRBACK ;IF GAP IS IN THE RANGE
CAMN B,ZBP1 ;AND WE'RE STARTING BEFORE IT,
JRST SRN1
MOVE SLP4,[JRST SLP1Z] ;TEMP. PTR ADVANCE
HRRI SLP4-1,ZBP1 ;WILL ENCOUNTER GAP BEFORE END.
MOVEM SLP4,SLP4N
MOVEM SLP4-1,SLP4N1
SRN1: MOVE B,@STBLP ;INITIALIZE LIST POINTER
HLRZ A,B
TRNE FF,FRBACK ;IF BACKWARDS, ENTER NORMAL LOOP.
JRST WINNUL
HRRZ A,(A) ;IF THERE IS ONLY ONE ALTERNATIVE IN THE SEARCH STRING
CAIE A,SLP1P
JRST SRN5
HLRZ A,(B) ;AND THE 1ST CHAR OF SEARCH STRING
CAIE A,(CAIN A,) ;IS NOT A SPECIAL SEARCH CHARACTER,
JRST SRN5
MOVEI A,SFAST ;THEN WE CAN GO FAST
HRRM A,SLP1P ;USE THE GET-NEXT-CHAR ROUTINE THAT CAN SKIP FAST
HRRZ A,(B) ;OVER UNINTERESTING REGIONS.
MOVEI D,SFAFN0 ;WHICH MAIN LOOP SHOULD WE USE?
SKIPE BOTHCA ;SFAFC0 IGNORES THE 40 BIT; SFAFN0 DOESN'T.
CAIGE A,100 ;IS THE 1ST CHAR ONE WHOSE CASE WE WANT TO IGNORE?
JRST SRN4 ;NO.
CAIL A,"A
CAILE A,"Z
SKIPG BOTHCA
MOVEI D,SFAFC0 ;YES.
SRN4: MOVEM D,SFASAD ;TELL SFAST WHERE TO GO.
REPEAT 4,[ROT A,7 ;GENERATE AN ASCII CONSTANT WITH 1ST CHAR OF SEARCH
TRO A,@(B) ;REPEATED 5 TIMES.
]
LSH A,1
MOVEM A,SFXOR
SRN5: CAMN C,ZBP
JRST WINNUL
JRST SLP1K
;ROUTINE TO GET NEXT CHARACTER GOING FORWARD UNDER SPECIAL CIRCUMSTANCES.
;MAY SKIP FAST OVER MANY CHARACTERS BEFORE FINALLY STOPPING WITH A CHARACTER IT CAN'T
;QUICKLY RULE OUT.
SFAST: TLNE C,760000
JRST SLP1I ;GO SLOW IF NOT STARTING NEW WORD.
HRRZ A,ZBP1
CAIN A,(C) ;OR IF NEAR GAP OR END OF RANGE
JRST SLP1I
SUBM C,A
HRL C,A ;AOBJN -> RANGE OF WORDS WE CAN SCAN FAST.
JRST @SFASAD ;TO SFAFN0 OR SFAFC0.
;THIS IS THE SFAST MAIN LOOP THAT DOESN'T IGNORE THE 40 BIT OF THE CHARACTER.
SFAFNL: MOVE A,(C)
XOR A,SFXOR ;XOR NEXT WORD WITH ASCII/QQQQQ/ WHERE Q IS CHAR WE'RE LOOKING FOR.
TLNN A,(177_35) ;IS 1ST CHAR OF WORD THE ONE WE WANT?
JRST SFAF1
TLNN A,(177_26) ;OR THE 2ND?
JRST SFAF2
TDNN A,[177_17]
JRST SFAF3
TRNN A,177_10
JRST SFAF4
TRNN A,177_1
JRST SFAF5
SFAFN0: AOBJN C,SFAFNL ;NO NEED TO STOP IN THIS WORD; LOOK AT NEXT.
HRLI C,350700 ;APPROACHING GAP OR END OF RANGE; SLOW DOWN.
JRST SLP1K ;ONLY THE SLOW ROUTINE KNOWS HOW TO HANDLE THEM.
;MAIN LOOP THAT IGNORES THE 40 BIT.
SFAFCL: MOVE A,(C)
XOR A,SFXOR
TLNN A,(137_35) ;ONLY DIFFERENCE IS THAT EACH MASK OMITS THE 40 BIT.
JRST SFAF1
TLNN A,(137_26)
JRST SFAF2
TDNN A,[137_17]
JRST SFAF3
TRNN A,137_10
JRST SFAF4
TRNN A,137_1
JRST SFAF5
SFAFC0: AOBJN C,SFAFCL ;NO NEED TO STOP IN THIS WORD; LOOK AT NEXT.
HRLI C,350700 ;APPROACHING GAP OR END OF RANGE; SLOW DOWN.
JRST SLP1K ;ONLY THE SLOW ROUTINE KNOWS HOW TO HANDLE THEM.
SFAF1: HRLI C,350700 ;MUST EXAMINE 1ST CHAR THIS WORD - SO DROP INTO
JRST SLP2A ;MAIN SEARCH LOOP.
SFAF2: HRLI C,260700
JRST SLP2A
SFAF3: HRLI C,170700
JRST SLP2A
SFAF4: HRLI C,100700
JRST SLP2A
SFAF5: HRLI C,010700
JRST SLP2A
;GET NEXT CHARACTER SEARCHING BACKWARDS
SLP1E: MOVEM C,ZBP ;INITIALIZATION, SET CEILING FOR SEARCH
SLP1D: CAMN C,BBP1 ;AT BEGINNING OF BUFFER OR END OF GAP?
JRST SLP1F ;YES, FIGURE OUT WHICH.
ADD C,[70000,,] ;NO, DECREMENT C,
JUMPGE C,SLP2 ;AND GO BACK INTO LOOP
SUB C,[430000,,1]
JRST SLP2
SLP1F: CAMN C,BBP
JRST LOSE ;REALLY AT START OF RANGE, SEARCH FAILED.
JRST SLP1G ;MOVED BACK TO GAP, GO OVER IT.
;GET NEXT CHARACTER SEARCHING FORWARDS
SLP1I: IBP C ;INCREMENT TO NEXT CHARACTER
SLP1K: CAME C,ZBP1 ;AT START OF GAP OR END OF RANGE?
JRST SLP2 ;NO, KEEP GOING
CAMN C,ZBP ;WHICH ONE IS IT?
JRST LOSE ;IT'S END OF RANGE.
;MOVE OVER GAP TO GET NEXT CHARACTER
SLP1G: INSIRP PUSH P,BP TT TT1
MOVE BP,GPT ;COMPUTE A B.P. TO OTHER SIDE OF GAP.
TRNE FF,FRBACK
AOSA BP ;BACKWARD => 1ST CHAR OF GAP,
ADD BP,EXTRAC ;FWD => LAST CHAR OF GAP.
CALL GETIBP
MOVE C,BP
MOVE BP,BBP ;ALREADY PASSED GAP SOLOOK FOR BNDRYS
MOVEM BP,BBP1 ;OF RANGE INSTEAD.
MOVE BP,ZBP
TRNN FF,FRBACK
MOVEM BP,ZBP1
XORI SLP4-1,ZBP#ZBP1
MOVEM SLP4-1,SLP4N1
XOR SLP4,[<JRA B,SLP2>#<JRST SLP1Z>]
MOVEM SLP4,SLP4N
INSIRP POP P,TT1 TT BP
HRRZ A,SLP1P ;NOW WE'RE ACROSS GAP SO RETRY FETCHING NEXT CHAR.
JRST (A)
;WHEN WE COME HERE, EITHER THIS ALTERNATIVE HAS FAILED
;OR WE HAVE MET THE GAP, ON A CHARACTER OTHER THAN THE FIRST ONE
;OF THE ALTERNATIVE.
SLP1Z: XCT SLP4-1 ;WHICH ONE? IF NOT GAP YET, IT'S A SIMPLE FAILURE.
CAIA
JRA B,SLP2
;WE HAVE MET THE GAP. THE TEST OJUST DONE WAS INVALID SINCE
;IT WAS TESTING A RANDOM CHAR OF GAP, SO WE MUST DO IT OVER
;AFTER ADVANCING THE POINTER IN E OVER THE GAP.
;ALSO, FROM NOW ON, WE MUST TEST FOR REACHING Z RATHER THAN THE GAP.
;IF THIS ALTERNATIVE FAILS LATER ON, WE WILL BE BACKING UP TO BEFORE THE GAP,
;SO IN THAT CASE GO TO SLP1Z1 TO UNDO WHAT WE ARE DOING NOW.
MOVE SLP4-1,[CAMN E,ZBP] ;FROM NOW ON, IN THIS ALTERNATIVE, TEST FOR Z.
MOVE SLP4,[JRA B,SLP1Z1]
INSIRP PUSH P,BP TT TT1
MOVE BP,GPT ;ADVANCE POINTER PAST THE GAP.
ADD BP,EXTRAC
CALL GETIBP
MOVE E,BP
SLP1Z2: MOVE BP,1(B) ;BACK UP B OVER ARGUMENTS
TLNN BP,777000 ;TO THE LAST SEARCH PREDICATE
SOJA B,SLP1Z2 ;SO WE RE-EXECUTE THE SEARCH PREDICATE.
INSIRP POP P,TT1 TT BP
JRST SLP3 ;FETCH THE CHAR AGAIN AND RETRY COMPARISON.
SLP1Z1: MOVE SLP4-1,SLP4N1
MOVE SLP4,SLP4N
JRST SLP2
SLPLOW: ILDB A,E ;COME HERE FROM SLP3 IN BOTHCASES MODE.
CAIL A,140
SUBI A,40
JRST SLP3+1
SLPLO1: LDB A,C ;SIMILAR, FOR SLP2.
CAIL A,140
SUBI A,40
JRST SLP2+1
SLPLO2: ILDB A,E ;COME HERE FROM SLP3 WHEN IGNORING CASE FOR LETTERS ONLY.
CAIL A,"A+40
CAILE A,"Z+40
JRST SLP3+1
SUBI A,40
JRST SLP3+1
SLPLO3: LDB A,C ;SIMILAR, FOR SLP2.
CAIL A,"A+40
CAILE A,"Z+40
JRST SLP2+1
SUBI A,40
JRST SLP2+1
;HERE IF SEARCH FAILS TO FIND THE STRING. EITHER READ NEXT PAGE, OR COMMAND HAS FAILED.
LOSE:
IFN ITS,CALL SEQPGX ;TURN OFF SEQUENTIAL PAGING USED DURING SEARCH.
SKIPE PNCHFG ;IS IT AN N OR _ COMMAND?
SKIPL LASTPA ;IF SO, AND NOT AT EOF, TRY READING MORE FROM FILE.
JRST LOSE2 ;OTHERWISE, SEARCH HAS REALLY FAILED.
MOVEI C,1 ;MAYBE PUNCH ONCE
SETZM IMQUIT ;DON'T QUIT OUT OF I-O - MIGHT GARBLE FILE.
TRZ FF,FRARG
CALL [ SKIPGE PNCHFG ;PUNCH?
JRST PUNCHA ;YES
JRST YANK] ;NO
MOVE E,BEGV ;GET RANGE TO SEARCH = WHOLE BUFFER,
MOVE C,ZV
CALL GSAPCH ;SET BBP, ZBP.
JRST SRN2 ;SEARCH NEW BUFFER
LOSE2: SETZM SFINDF ;SEARCH LOST, CLEAR FLAG FOR SEMICOLON
PUSHJ P,SRCV ;SET PT (IF THIS WAS REPEATED SEARCH, MAYBE WE FOUND IT ONCE).
TRZE FF,FRCLN ;IF COLON TYPED FOR SEARCH,
JRST NRET0 ;THEN RETURN 0 AS VALUE
MOVE TT,ITRPTR ;ARE WE WITHIN AN ITERATION?
TSC TT,ITRPTR ;(BUT ERRSETS DON'T COUNT).
TRNN TT,-1
SKIPE PSSAVP ;OR ARE WE WITHIN A ^P-SORT?
SKIPE SRCERR ;YES. IF SRCERR IS 0, INHIBIT THE ERROR.
TYPRE [SFL]
RET
;SEARCHING STARTING AT END OF BUFFER, DON'T WIN FOR FORWARD NON-NULL SEARCH
WINNUL: MOVE A,[JRST WINNL1] ;SET UP A AS CONSTANT FOR COMPARISON AGAINST MEMORY
WINNL2: CAMN A,(B) ;IF AGREEMENT,
JRST WINNL1 ;THEN NULL COMPARISON STRING, WIN, KIND OF
CAME B,STBLPX ;IF THIS ISN'T LAST ENTRY IN TABLE,
JRA B,WINNL2 ;THEN TRY NEXT ONE
TRNN FF,FRBACK ;NO NON-NULL COMPARISON STRINGS, IF SEARCHING FORWARD,
JRST LOSE ;THEN LOSE
JRA B,SLP1E ;SEARCHING BACKWARDS => RE-INITIALIZE LIST POINTER, FALL IN
WINNL1: MOVE E,C ;NULL SEARCH STRING FOUND.
;ALL SUCCESSFUL SEARCHES COME HERE.
WIN: MOVEM C,TEM1 ;SAVE C, (BYTE POINTER TO FIRST CHARACTER IN FOUND STRING)
MOVEM E,TEM2 ;AND E, ( " TO LAST CHARACTER IN FOUND STRING)
SOSLE SEARG ;THIS LAST SEARCH?
JRST WIN3 ;NO, KEEP GOING
WIN1:
IFN ITS,CALL SEQPGX ;TURN OFF SEQUENTIAL PAGING USED DURING SEARCH.
PUSHJ P,SRCV ;PICK UP THE PIECES (ENTRY FOR FOUND NULL STRING AT END OF BUFFER)
TRZ B,-1 ;YES, CHASE DOWN LIST LOOKING FOR THIS LIST POINTER
MOVE C,@STBLP ;GET INITIAL POINTER
MOVNI A,1 ;INITIALIZE COUNT
WIN2: TRZ C,-1 ;CLEAR OUT RIGHT HALF OF THIS LIST ENTRY
CAME C,B ;IS THIS THE ONE?
JRA C,[SOJA A,WIN2] ;NO, TRY NEXT
MOVEM A,SFINDF ;STORE FS SVALUE$
TRZE FF,FRCLN ;RETURN SFINDF AS VALUE IFF IT'S A ":S".
AOS (P)
RET
;HERE TO SEARCH OVER AGAIN. CLEAN UP FOR RE-ENTERING SEARCH LOOP.
WIN3: TRNE FF,FRBACK
JRST WIN3R
MOVE BP,E
CALL GETCA ;BP GETS REAL CHAR ADDR CORRESPONDING TO END OF INSTANCE FOUND.
MOVE C,ZBP ;IF FORWARD, THEN START FROM END OF THE INSTANCE WE JUST FOUND (IN E),
CAMLE BP,GPT ;AND IF THAT MEANS SKIPPING OVER THE GAP, FIX UP ZBP1 TO MATCH ZBP.
MOVEM C,ZBP1
MOVE C,E
JRST SRN2RP
WIN3R: MOVE E,ZBP ;IF BACKWARD, START FROM BEGINNING OF WHAT WE FOUND,
MOVEM C,ZBP ;BUT PREVENT OVERLAP BY SETTING END OF RANGE TO THERE.
MOVE BP,C
CALL GETCA
CAME E,ZBP1 ;IF THE GAP WASN'T OR IS NO LONGER IN THE RANGE,
CAMGE BP,GPT
MOVEM C,ZBP1 ;THEN ZBP1 SHOULD EQUAL ZBP.
JRST SRN2RP
;PICK UP PIECES FROM SEARCH; COMPUTE NEW VALUE OF PT.
SRCV: SETZM IMQUIT
SKIPN BP,TEM2 ;GET POINTER TO LAST CHARACTER IN FOUND STRING
JRST SRCVX ;NO WINNERS THIS BUFFER
MOVE C,TEM1 ;GET POINTER TO FIRST CHARACTER IN FOUND STRING
TRNE FF,FRBACK ;IF SEARCH WAS BACKWARDS,
EXCH C,BP ;THEN REALLY WANT THEM INTERCHANGED
;BP NOW HAS TECO'S . IN BYTE POINTER FORM
;C HAS BYTE POINTER TO OTHER END OF STRING FOUND
PUSHJ P,GETCA ;CONVERT BP TO CHARACTER ADDRESS
EXCH BP,C ;GET OTHER BYTE POINTER IN BP
PUSHJ P,GETCA ;CONVERT TO CHARACTER ADDRESS
CAMLE C,GPT ;CONVERT CHAR ADDR OF END TO VIRTUAL,
SUB C,EXTRAC
CAMLE BP,GPT ;CONVERT CHAR ADDR OF END TO VIRTUAL.
SUB BP,EXTRAC
SUB BP,C ;DIFFERENCE = LENGTH OF LAST SEARCH STRING FOUND.
MOVEM C,PT ;GO THERE.
SRCVX: MOVNM BP,INSLEN ;STORE SIGNED LENGTH OF LAST SEARCH STRING FOUND
;SIGN OF LLSSF IS OPPOSITE THAT OF ARG TO SEARCH FROM WHICH IT WAS SET
POPJ P,
FKCMD: MOVN A,INSLEN ;"FK" -<LENGTH OF LAST STRING FOUND OR INSERTED>
JRST POPJ1
;FS S STRING$ - READ OR SET THE DEFAULT SEARCH STRING.
FSSSTR: CALL FSSSTV ;FIRST, CONS UP A STRING CONTAINING THE OLD VALUE.
TRZE FF,FRARG ;THEN, IF WE HAVE AN ARG, SET THE DEFAULT FROM IT:
CAMN C,[-1] ;ARG OF -1 MEANS "INVALID SEARCH STRING"; JUST DON'T SET.
JRST POPJ1
JSP T,GCPUSA ;MUST SET. PUSH VALUE TO RETURN WHERE GC WILL RELOCATE IT.
MOVEI A,[ASCIZ /[0 U0 0@S| 0| ]0/]
SAVE SFINDF
CALL MACXCP ;SET SEARCH STRING DEFAULT BY PASSING ARG TO AN S COMMAND.
REST SFINDF
;POP A GCPUSA'D VALUE AND RETURN IT AS COMMAND'S VALUE.
GCPOPV: REST LEV
SUB P,[1,,1]
JRST POPAJ1
GCPUSA: SAVE A ;PUSH THE VALUE IN A AND ARRANGE FOR GC TO RELOCATE IT
SAVE [0] ;WHILE IT IS ON THE STACK. THIS IS DONE BY MAKING
SAVE LEV ;IT LOOK LIKE A "(" BLOCK.
MOVEM P,LEV
JRST (T)
;RETURN IN A A STRING CONTAINING THE CURRENT DEFAULT SEARCH STRING. PRESERVE C.
FSSSTV: MOVE E,SBFRP
MOVE CH,MFZV(E)
MOVE E,MFBEGV(E)
IDIVI E,5 ;GET WORD ADDR'S OF START AND END OF SEARCH TABLE.
IDIVI CH,5
AOS E ;SKIP OVER THE VALID-WORD AT THE START.
SETO A,
SKIPN -1(E) ;BUT IF THE TABLE'S CONTENTS AREN'T VALID, RETURN -1.
POPJ P,
SAVE C ;ELSE WE'LL RETURN A STRING. WHAT'S A BOUND ON LENGTH WE NEED?
SAVE [POPCJ]
MOVE C,CH
SUB C,E ;TWICE LENGTH OF SEARCH TABLE IS ENOUGH.
LSH C,1
CALL QOPEN ;ALLOCATE THAT SPACE, SET UP LISTF5 TO STORE INTO STRING.
AOS E ;SKIP THE FIRST POINTER-PAIR IN THE SEARCH TABLE.
FSSSTL: SETZ B, ;WE ARE NOT JUST AFTER A ^S OR ^N^S.
FSSST5: SETZ C,
HLRZ TT,(E) ;GET LH AND RH OF NEXT SEARCH TABLE WORD.
HRRZ TT1,(E)
CAIN TT1,SLP1P ;SLP1P IN RH IDENTIFIES END OF SEARCH TABLE
JRST QCLOSV ;SO FINISH UP THE STRING'S HEADER AND RETURN IT.
CAIL TT1,HUSED ;AN RH THAT'S AN ADDRESS IN BUFFER SPACE
JRST [ MOVEI CH,^O ;INDICATES A DIVISION BETWEEN ALTERNATIVE STRINGS,
JRST FSSST2] ;SO WE NEED A ^O FOR IT.
CAIN TT,(JRST) ;JRST INSN MUST BE JRST WIN OR WINNUL, WHICH IS AT THE END OF
AOJA E,FSSSTL ;EVERY ALTERNATIVE. IT CORRESPONDS TO NO CHAR IN USER'S ARG.
CAIN TT,(JFCL)
MOVSI C,(ASCII //) ;JFCL IS GENERATED BY A ^X.
CAIN TT,(CAIA)
MOVSI C,(ASCII //) ;CAIA COMES FROM A ^N^X.
CAIN TT1,SKNBRK
MOVSI C,(ASCII //) ;CALL SKNBRK COMES FROM ^B.
CAIN TT1,SKBRK
MOVSI C,(ASCII //) ;CALL SKBRK COMES FROM ^N^B.
CAIN TT1,SKNLSY
MOVSI C,(ASCII //) ;CALL SKNLSY COMES FROM ^S
CAIN TT1,SKLSYN
MOVSI C,(ASCII //) ;CALL SKLSYN COMES FROM ^N^S.
JUMPE C,FSSST1 ;ANYTHING ELSE MUST BE ORDINARY, OR A ^N.
;HERE FOR SPECIAL SEARCH CHARACTER.
SETZ B,
CAIE TT1,SKNLSY ;SET FLAG FOR NEXT CHAR: B IS -1
CAIN TT1,SKLSYN ;IF NEXT CHAR IS FOLLOWING A ^S.
SETO B,
MOVEI A,C
CALL ASCIND ;OUTPUT THE SPECIAL CHAR, WITH ITS ^N IF APPRO.
AOJA E,FSSST5
FSSST1: JUMPL B,FSSST6 ;THE CHAR AFTER A ^S SHOULDN'T GET ^N OR ^Q.
MOVEI CH,^N
CAIN TT,(CAIE A,) ;DECIDE BETWEEN ORDINARY CHAR AND ^N'D CHARACTER.
XCT LISTF5
MOVEI CH,^Q ;IF CHAR IS ONE THAT WOULD BE SPECIAL, MUST QUOTE IT.
CAIE TT1,^B
CAIN TT1,^X
XCT LISTF5
CAIE TT1,^Q
CAIN TT1,^O
XCT LISTF5
CAIE TT1,^S
CAIN TT1,^N
XCT LISTF5
FSSST6: MOVE CH,TT1 ;[
CAIN CH,^]
XCT LISTF5 ;[ ;^] HAS ITS OWN WAY TO BE QUOTED.
FSSST2: XCT LISTF5
AOJA E,FSSSTL
SUBTTL ..D DELIMITER DISPATCH USAGE
;SKNBRK SKIPS UNLESS THE CHARACTER IN A IS A DELIMITER CHARACTER.
;THE SET OF DELIMITERS IS DEFINED BY THE CONTENTS OF QREG ..D,
;WHICH SHOULD BE A STRING CONTAINING 5*128. CHARACTERS, FORMING A
;DISPATCH TABLE. EACH ASCII CHAR HAS A 5-CHAR DISPATCH ENTRY WHOSE
;FIRST TWO CHARACTERS ONLY ARE SIGNIFICANT.
;THE FIRST CHARACTER IS THE MOST GENERAL: IF IT IS NOT A SPACE, THEN
;THE CHARACTER WHOSE ENTRY IT IS IS NOT A DELIMITER.
;INITIALLY ALL NON-SQUOZE CHARACTERS ARE DELIMITERS.
;THE SECOND CHARACTER SAYS HOW LISP HANDLES THE CHAR BEING HANDLED.
;THE POSSIBLE DISPATCH CHARS ARE "(", ")", "/", "|", "A" AND " ".
;SKNBRK ASSUMES THAT SKNBPT HAS BEEN SET UP BY SKNBCP ALREADY.
;CLOBBERS D.
SKNBRK: LDB D,SKNBPT
CAIN D,"A
AOS (P)
RET
DQT3: CALL SKNBCP ;SKIP IF CHAR IN C IS DELIMITER; RECOMPUTES SKNBPT.
MOVE A,C
SKBRK: LDB D,SKNBPT ;SKIP IF CHAR IN A IS DELIM. SKNBCP SHOULD HAVE BEEN CALLED.
CAIE D,"A
AOS (P)
RET
;LOOK AT QREG ..D, AND SET UP SKNBPT FOR USE BY SKNBRK.
SKNBCP: MOVE CH,QRB..
ADDI CH,.QDLIM
CALL QLGET ;BP _ BP TO TEXT.
TYPRE [QNS]
CAIGE B,5*200 ;NOT LONG ENOUGH => ERROR.
TYPRE [STS]
IBP BP ;BP HAS BP TO LDB 1ST CHAR.
TLO BP,A ;LDB BP TO GET DISPATCH OF CHAR IN A.
MOVEM BP,SKNBPT
RET
;SKIP IF LISP SYNTAX OF CHAR DOESN'T MATCH FOLLOWING WORD OF SEARCH TABLE.
SKNLSY: MOVE D,(P) ;GET OUR RETURN ADDRESS.
AOS B ;GO INDIRECT THRU THE XCT THAT POINTED AT
PUSH P,@-1(D) ;THE CALL TO THIS INSN, TO FIND THE SYNTAX CHAR.
MOVE D,SKNBPT ;THEN GET THE SYNTAX OF THE BUFFER CHAR IN CH.
IBP D
LDB D,D
CAME D,(P)
AOS -1(P)
SUB P,[1,,1]
RET
;SKIP IF LISP SYNTAX OF CHAR MATCHES FOLLOWING WORD OF SEARCH TABLE.
SKLSYN: MOVE D,(P) ;GET OUR RETURN ADDRESS.
AOS B ;GO INDIRECT THRU THE XCT THAT POINTED AT
PUSH P,@-1(D) ;THE CALL TO THIS INSN, TO FIND THE SYNTAX CHAR.
MOVE D,SKNBPT ;THEN GET THE SYNTAX OF THE BUFFER CHAR IN CH.
IBP D
LDB D,D
CAMN D,(P)
AOS -1(P)
SUB P,[1,,1]
RET
;; ^B COMMAND: GO TO BEGINNING OF BUFFER IF LAST SEARCH WAS BACKWARD AND FAILED,
;; OR TO END IF LAST SEARCH WAS FORWARD AND FAILED. SET FS INSLEN$ TO 0 EITHER WAY.
;; IF LAST SEARCH SUCCEEDED, DON'T MOVE, AND DON'T CHANGE FS INSLEN$.
;; WITH COLON FLAG, IF SEARCH WAS SUCCESSFUL DO FKC.
CTLB: TRZ FF,FRARG\FRARG2
MOVN C,INSLEN
SKIPE SFINDF
JRST [ TRZE FF,FRCLN
JRST REVER1
RET]
SETZM INSLEN
HRRZ A,SLP1P
CAIE A,SLP1D ;WAS LAST SEARCH FORWARD?
SKIPA A,SRCEND ;IF SO, GO TO END
MOVE A,SRCBEG ;ELSE GO TO BEGINNING.
ADD A,BEG
MOVEM A,PT
RET
SUBTTL F AND FS COMMAND DISPATCH
;F-COMMAND SUBDISPATCH.
FCMD: PUSHJ P,LRCH
XCT FDTB(CH)
POPJ P,
JRST POPJ1
;FS COMMAND.
FSET: MOVE B,[440600,,D]
MOVE E,[440600,,J]
SETO BP,
SETZB D,J
;D GETS THE SPEC'D NAME; J GETS MASK TO THOSE CHARS IN THE WORD WHICH WERE SPEC'D.
FSLUP: CALL RCH
ANDI CH,-1
TRNE CH,100
ANDCMI CH,40 ;CONVERT TO LOWER CASE.
CAILE CH,40
JRST FSCHAR ;NON-CONTROLS ARE FOR REAL.
CAIN CH,ALTMOD
SKIPGE SQUOTP ;ALTMODE ENDS NAME UNLESS SUPERQUOTED.
CAIA ;OTHERWISE, ^X IS TREATED AS IF IT WERE AN UPARROW AND AN X.
JRST FSLKUP
MOVEI TT,'^
CAIE CH,40 ;SPACE, UNLIKE CTL CHARS, IS JUST IGNORED.
TLNN B,770000 ;CTL CHARS ALSO IGNORED IF ALREADY HAVE 6 CHARS.
JRST FSLUP
IDPB TT,B
IDPB BP,E
FSCHAR: HRREI CH,-40(CH) ;GET SIXBIT, IGNORING LH SINCE MIGHT BE -1
TLNE B,770000 ;[ ;IF THE CHAR WAS QUOTED WITH ^]^Q
IDPB CH,B
TLNE E,770000
IDPB BP,E
JRST FSLUP
FSLKUP: MOVE B,[-FLAGSL*2,,FLAGS]
;BINARY SEARCH IN VECTOR OF FLAGS <- AOBJN IN B
;FOR VALUE IN D. CLOBBERS B,E,TT.
FSLUKB: HLRE E,B
HRLI B,E ;B IS INDEX OF E.
MOVNS TT,E
;B -> INSIDE AREA, IDX OF E.
;E = SIZE OF LAST STEP.
;TT = # WDS LEFT IN PART OF AREA AFTER B.
;LEAVES B POINTING TO LAST FLAG WHOSE NAME IS < DESIRED NAME
;(NOTE: IF ALL FLAGS ARE >= DESIRED NAME, B -> 1ST FLAG).
;THEN GOES TO FSLUK1.
FSLUK0: CAILE E,(TT) ;E_MAX(LAST STEP,SPACE LEFT)
MOVEI E,(TT)
CAIN E,2 ;ONLY 1 ENTRY TO SEARCH THRU => DONE.
JRST FSLUK1
LSH E,-1 ;STEP = .5* SIZE OF STUFF TO SEARCH.
TRZE E,1 ;ROUND UP TO EVEN NUMBER.
ADDI E,2
CAMG D,@B ;E.A. IS RH(B)+STEP.
JRST FSLUK0 ;THAT'S TOO FAR, DON'T MOVE B.
HRRI B,@B ;NOT TOO FAR, SET PTR THERE.
SUBI TT,(E) ;WE'RE CLOSER TO END NOW.
JRST FSLUK0
FSLUK1: CAMLE D,(B) ;(THIS PREVENTS LOSSAGE IF SUPPOSED TO FIND 1ST FLAG IN TABLE)
ADDI B,2
MOVEI B,-FLAGS(B) ;POINT TO 1ST FLAG GREATER THAN OR EQUAL TO DESIRED.
MOVE E,FLAGS(B)
AND E,J ;IF THIS FLAG DOESN'T MATCH SPEC'D NAME, NONE DOES.
CAME D,E
TYPRE [IFN]
CAMN D,FLAGS(B) ;EXACT MATCH IS NEVER CONSIDERED AMBIGUOUS.
JRST FSFND
MOVE E,FLAGS+2(B) ;ELSE, DOES THE NEXT FLAG AFTER THE ONE FOUND
AND E,J ;ALSO MATCH THE SPECIFIED NAME?
CAMN D,E
TYPRE [AFN] ;YES - SPEC'D NAME IS AMBIGUOUS.
FSFND: MOVS E,FLAGD(B)
HRLM B,(P)
FSCALL: CALL (E) ;SOME ROUTINES WILL DEPOSIT IN -1(P)! THEY ALL CREF FSCALL.
RET ;(THEIR GOAL IS TO FAKE OUT FPUSH VIA THE INSN AT .+1)
HLRZ E,(P) ;FOR FLAGS THAT RETURN VALUE, MAKE SURE INDEX OF FLAG IS
JRST POPJ1 ;IN E, FOR FPUSH TO WORK.
SUBTTL FS FLAG ROUTINES
;[ ;F]<FLAGNAME>$ POPS QREG PDL INTO THAT FLAG.
;[ ;<CH>F]^RCMAC$ WORKS, ETC.
FPOP: MOVEI CH,E ;CH HAS ADDR TO POP INTO.
CALL CLOSB2
TRON FF,FRARG
SKIPA C,E ;MAKE POPPED VALUE COME BEFORE ANY SPEC'D ARG.
TRO FF,FRARG2
CALL FSET ;SET THE FLAG, RETURNING THE OLD VALUE OF THE FLAG.
JFCL
RET ;RETURN NO VALUE.
;F[<FLAGNAME>$ PUSHES THAT FLAG ONTO THE QREG PDL.
;<CH>F[^RCMAC$, ETC., WORK. ;]]
FPUSH: MOVE B,PF ;IF WE ARE ABOUT TO OVERFLOW QREG PDL, DETECT THAT
CAMN B,PFTOP ;BEFORE SETTING THE FLAG.
JRST OPENB1
CALL FSET ;DO FS<FLAG>$, WHICH LEAVES INDEX IN FLAGD IN E.
TYPRE [WNA] ;FLAG HAS NO VALUE, AND YOU WANT TO PUSH IT??
TRNE FF,FRARG2 ;BARF IF TRY TO PUSH FS BOUNDARIES$, SINCE IT DOESN'T WIN.
TYPRE [WNA]
MOVEI CH,A
CALL OPENB2 ;PUSH THE VALUE FROM A, WHERE FSET LEFT IT,
MOVEM E,(B) ;THEN SET "WHERE PUSHED FROM" FIELD TO THE INDEX OF THIS
;FLAG IN THE FLAGS TABLE,
;THUS TELLING AUTO-UNWIND TO POP THE FLAG BY DOING FPOP.
RET
;HERE ARE THE COMMONLY USED FS FLAG ROUTINES.
IFN ITS,FSNQIT:: FSDIRH::
IFN TNX,FSFVER::
FSNORM: HLRZS E ;HERE TO READ/SET NORMAL FLAG; E -> WORD HOLDING VALUE.
FSNOR1: MOVE A,(E)
FSNOR2: ARGDFL
TRZN FF,FRARG
JRST POPJ1
MOVEM C,(E)
CAIE E,CASNRM ;IF SET CASNRM, ALSO SET CASDIS.
JRST POPJ1
ANDI C,1
MOVEM C,CASDIS
JRST POPJ1
FSVAL: HLRZ A,E ;HERE TO RETURN CONSTANT VALUE (AS FOR FS VERSIO$)
JRST POPJ1
IFN ITS,[
FSRSYS: HRRI E,A ;HERE TO READ A PARTICULAR .SUSET VAR (AS FOR FS OPTION$)
.SUSET E
JRST POPJ1
FSOPTL: .SUSET [.ROPTIO,,B] ;READ BIT IN LH OF .OPTION. C SAYS WHICH BIT.
JRST FSBIT1
]
FSRNLY: MOVE A,E ;READ-ONLY FLAG'S ADDR IN LH(E)
JRA A,POPJ1
FSROCA: MOVE A,E ;READ ONLY CHAR. ADDR, RETURN RELATIVE TO BEG.
JRA A,FSROC1
FSWBIT: ARGDFL
HRRI E,FF ;HERE IF WE WANT TO BE ABLE TO WRITE A BIT AS WELL AS READ IT.
MOVE B,FF ;LH(E) HAS B.P. L.H., AND WE ASSUME THE BIT IS IN FF.
SKIPE C ;WE MUST SAVE THE OLD FF SO WE CAN RETURN THE OLD SETTING OF THE BIT.
SETO C, ;ANY NONZERO ARG MEANS TURN THE BIT TO 1.
TRNE FF,FRARG
DPB C,E
CAMN E,[.BP FRTRACE]
CALL QUEST1 ;IF THE BIT JUST CHANGED IS FRTRACE, SET TRACS TOO.
JRST FSBIT1
FSBIT: SKIPA B,FF ;LH(E) HAS B.P. L.H., TO FETCH BIT IN FF.
FSTTOL: HLLZ B,TTYOPT ;TEST BIT IN LH(TTYOPT).
FSBIT1: HRRI E,B
LDB E,E ;FETCH THE DESIRED BIT.
SKIPN E
NRET0: TDZA A,A ;VALUE IS 0 IF BIT CLEAR,
NRETM1: SETO A, ;-1 IF SET.
JRST POPJ1
;ALTCOUNT FLAG, # COMMAND STRINGS TYPED AHEAD BY USER.
FSALTC: CALL VBDACU ;DO LISTEN TO UPDATE TSALTC,
JFCL
JRST FSNORM ;THEN DO NORMAL FS ON TSALTC.
;READ OR SET # OF COMMAND LINES.
FSECLS: MOVE A,NELNS ;GET CURRENT # OF CMD LINES,
ARGDFL
TRZE FF,FRARG
CALL FSECL1 ;AND SET IT IF NEC.
JRST POPJ1
;DESIRED # ECHO LINES IN C. (OR -<N> => NO ECHO, BUT <N>-1 ECHO LINES)
FSECL1: SKIPGE E,C ;GET ARG IF POSITIVE,
SETCA E, ;OR -1-ARG IF NEGATIVE.
CAML E,NVLNS ;VALUE TOO LARGE => WOULD CRASH TECO.
TYPRE [AOR]
SKIPN RGETTY
JRST FSECL3
MOVE T,NVLNS
SUB T,NELNS ;IN CASE WE ARE REDUCING NELNS, ZERO OUT HASH CODES OF ALL LINES
FSECL2: CAML T,NVLNS
JRST FSECL3
SETOM HCDS-1(T) ;THAT WERE PREVIOUSLY THE ECHO AREA AND THE MODE LINE.
AOJA T,FSECL2
FSECL3: MOVEM C,NELNS
MOVE C,NVLNS ;TOTAL # LINES - # ECHO LINES
SUB C,E
IFN TNX,[
MOVEM C,ECHOL0 ;SAVE FIRST LINE OF ECHO AREA
HRLZM C,ECHOPS ;AND SET UP AS NEW ECHO POSITION
]
SUBI C,1 ;DEDUCT 1 LINE FOR THE --MORE--
MOVEM C,USZ ;= # LINES FOR BUFFER DISPLAY.
SETOM DISOMD ;MUST NOW REDISPLAY MODE LINE.
IFN ITS,[
SYSCAL SCML,[%CLIMM,,CHTTYI ? E]
.LOSE %LSFIL
]
SKIPE ECHOFL ;IF ECHOING NOMINALLY "ON" (THAT IS, NOT OFF DUE TO ^R OR ^T)
CALL SETTTM ;THEN MAYBE CHANGING THIS FLAG TURNS IT OFF OR ON.
SETOM TYOFLG ;USZ HAS CHANGED, SO MAKE SURE TYPEOUT KNOWS ABOUT IT.
RET
;READ OR SET FS TOP LINE$. DON'T LET IT BE SET OUT OF RANGE.
;DON'T LET IT BE NONZERO ON A PRINTING TERMINAL.
FSTPLN: TRNN FF,FRARG
JRST FSNORM
SKIPN RGETTY
JUMPN C,FSTPLL
CAMGE C,USZ
JUMPGE C,FSNORM
FSTPLL: TYPRE [AOR]
FSWIDTH:TRNE FF,FRARG
CAIG C,MXNHLS
JRST FSNORM
TYPRE [AOR]
IFN 20X,[
FSTTPG: MOVE A,PAGMOD ;GET CURRENT PAGE MODE STATE
TRNE FF,FRARG ;IF ANY ARG
MOVEM C,PAGMOD ;SETUP NEW ONE
JUMPGE C,CPOPJ1 ;AND IF NOT -1, DONT NEED TO CHANGE YET
SAVE A
MOVEI A,.CTTRM
RFMOD
TRON B,TT%PGM ;TURN ON PAGE MODE WHILE IN TECO
STPAR
REST A
JRST CPOPJ1
]
FSRUNT:
IFN ITS,[
.SUSET [.RRUNT,,A]
MULI A,4069. ;CONVERT TO NANOSEC.,
DIV A,[1.^6] ;THEN TO MILLISEC.
]
IFN TNX,[
MOVEI A,.FHSLF ;THIS FORK
RUNTM ;RUNTIME IN MS.
]
JRST POPJ1
FSUPTI:
IFN ITS,.RDTIME A, ;RETURN THE SYSTEM UP TIME - FS UPTIME $
IFN TNX,TIME ;SYSTEM UPTIME IN MS.
JRST POPJ1
FSSWIT:
IFN ITS,.RDSW A,
IFN TNX,SWTCH ;FOR WHAT ITS WORTH
JRST POPJ1 ;RETURN PDP10 CONSOLE SWITCHES.
FSDDFS:
IFN ITS,[ ;RETURN -1 IF DEFAULT DEVICE IS "FAST".
MOVE D,[440700,,DEFFIL]
MOVE B,[440600,,CH]
SETZ CH,
ILDB A,D
CAIGE A,140
SUBI A,40
SUBI A,40
IDPB A,B
ILDB A,D
CAIGE A,140
SUBI A,40
SUBI A,40
IDPB A,B
ILDB A,D
CAIN A,":
CAME CH,MACHIN
JRST NRET0
]
JRST NRETM1 ;ONLY ITS HAS ANY SLOW DEVICES.
IFN ITS,[
..RHSNAM==16 ? ..RMAIL==17
;<ITS>,<USER>FS U HSNAME$ RETURNS IN SIXBIT THE HSNAME OF <USER> ON MACHINE <ITS>.
;BOTH ARGS SHOULD BE SIXBIT. <ITS> CAN BE OMITTED FOR THE CURRENT MACHINE.
FSUHSN: MOVE A,SARG
MOVE B,C
TRNN FF,FRARG
.SUSET [.RXUNAM,,B]
.BREAK 12,[..RHSNAM,,A]
MOVE A,B
TRZ FF,FRARG\FRARG2
JRST POPJ1
;<ITS>,<USER>FS UMAIL$ SETS DEFAULT FILENAMES TO MAIL FILE OF <USER> ON <ITS>.
;BOTH ARGS SHOULD BE SIXBIT. <ITS> CAN BE OMITTED MEANING USE THAT USER'S HOME MACHINE.
FSUML: MOVE A,SARG
MOVE B,C
TRNN FF,FRARG
.SUSET [.RXUNAM,,B]
.BREAK 12,[..RMAIL,,A]
SAVE C
SAVE B
MOVE D,[440700,,DEFFIL] ;STORE AS ASCIZ STRING IN DEFFIL.
CALL STRGE1
MOVEI B,":
IDPB B,D
MOVEI B,40
IDPB B,D
REST A
CALL STRGE1
MOVEI B,";
IDPB B,D
MOVEI B,40
IDPB B,D
REST A
CALL STRGE1
MOVEI B,40
IDPB B,D
MOVE A,[SIXBIT /MAIL/]
CALL STRGE1
SETZ B,
IDPB B,D
RET
];IFN ITS
FSEJPG: MOVE A,LHIPAG ;READ OR WRITE FS :EJ PAGE$.
ARGDFL
TRZN FF,FRARG
JRST POPJ1
CAML C,LHIPAG ;ILLEGAL TO SET IT TO A SMALLER VALUE SINCE PAGES DON'T EXIST.
CAILE C,LHIMAX ;ILLEGAL TO SET ABOVE TOP OF ADDRESS SPACE.
TYPRE [AOR]
EXCH C,LHIPAG
;NOW FLUSH THE PAGES WE HAVE REMOVED FROM PURE STRING SPACE.
IFN ITS,[
MOVE B,C
SUB B,LHIPAG ;B GETS MINUS NUMBER OF PAGES FS :EJPAGE$ HAS ADVANCED OVER.
JUMPE B,POPJ1
HRL C,B ;C GETS AOBJN TO PAGES TO BE FLUSHED.
SYSCAL CORBLK,[%CLIMM,,0 ? %CLIMM,,%JSELF ? C]
.LOSE %LSSYS
];IFN ITS
IFN TNX,[
MOVE B,C
SUB C,LHIPAG ;NEGATIVE NUMBER OF K
JUMPE C,POPJ1
MOVM C,C
LSHC B,1 ;TRANSLATE FROM K TO PAGES.
HRLI B,.FHSLF ;THIS FORK
SAVE A ;PRESERVE WHAT FS EJPAGE IS GOING TO RETURN.
SETO A,
IFN 20X,[
HRLI C,(PM%CNT) ;COUNT GIVEN
PMAP
];IFN 20X
.ELSE [
FSEJP1: PMAP
SOJLE C,FSEJP2
AOJA B,FSEJP1
FSEJP2:
];ELSE
REST A
];IFN TNX
JRST POPJ1
;RETURN CURRENT DATE/TIME IN DISK FILE DATE FORMAT.
FSDATE:
IFN ITS,[
SYSCAL RQDATE,[%CLOUT,,A]
.LOSE %LSSYS
]
IFN TNX,GTAD ;GET TIME IN SYSTEM INTERNAL FORMAT (ASSUME WILL
JRST POPJ1 ;BE PASSED ALONG TO FS F DCONV$ UNMUNGED)
FSFDAT:
IFN ITS,[
HLRZS E ;CREATION DATE OF FILE ON CHNL IN LH(E)
ARGDFL
SYSCAL RFDATE,[E ? %CLOUT,,A]
JRST OPNER1
TRZN FF,FRARG
JRST POPJ1
SYSCAL SFDATE,[E ? C]
JRST OPNER1
JRST POPJ1
]
IFN TNX,[
HLRZS E
SKIPG A,(E) ;GET THE JFN
JRST [ CAIN E,CHFILI
TYPRE [NFI]
TYPRE [NDO]
]
ARGDFL
SAVE C ;SAVE ANY ARG
MOVE B,[1,,.FBWRT]
MOVEI C,A
GTFDB ;GET THE OLD WRITE DATE
ERJMP OPNER1
REST C
TRZN FF,FRARG ;WRITING ON THIS FLAG?
JRST POPJ1 ;NO, JUST RETURN
FSFDT2: SAVE A
MOVE A,(E)
SETO B,
HRLI A,.FBWRT
CHFDB ;YES, CHANGE IT
REST A ;AND RETURN OLD VALUE
JRST POPJ1
]
;"FS FDCONV $" IS LIKE "\" BUT HANDLES FILE DATES INSTEAD NUMBERS.
FSDCNV: TRNE FF,FRARG
JRST FSDCN2 ;ARG => GO TURN IT INTO STRING IN BUFFER
JRST FSDCNI ;ELSE PARSE A DATE OUT OF THE BUFFER.
IFN ITS,[
FSDCNI: SAVE [0] ;PUSH WORD TO ACCUM. THE DATE IN.
FSDCN0: MOVE OUT,[-6,, [40,, ;MONTH
1,, ;DAY
1000,, ;YEAR
3600.*2 ;HOUR (IN TERMS OF 1/2 SEC)
60.*2 ;MINUTE
2]] ;SECOND
JRST FSDCN4
FSDCN3: MOVE IN,PT
CAMN IN,ZV ;AT END OF BUFFER => RETURN WHAT WE HAVE
JRST FSDCN1
CALL GETINC
CAIN CH,^M ;STOP BEFORE A CR.
JRST FSDCN1
AOS PT ;ELSE MOVE OVER DELIMITER
FSDCN4: MOVE Q,PT
SAVE OUT
CALL BAKSL ;READ THE NEXT NUMBER
JFCL
REST OUT
CAMN Q,PT
JRST FSDCN1 ;NO NUMBER => FINISHED.
IMUL A,(OUT) ;ELSE PUT THIS # IN RIGHT PLACE
ADDM A,(P) ;IN THE DATE BEING ACCUMULATED.
AOBJN OUT,FSDCN3 ;HAVEN'T READ ALL 6 YET => KEEP GOING.
FSDCN1: REST A ;A HAS DATE TO RETURN.
CAMN OUT,@FSDCN0 ;IF DATE IN BUFFER WAS NULL,
SETO A, ;RETURN -1
JRST POPJ1
FSDCN2: MOVEM C,PTLFCD
MOVEI TT,TYOM
HRRM TT,LISTF5 ;PRINT THE DATE INTO MEMORY.
CALL [ TRNN FF,FRCLN
JRST GAPSLP
MOVEI C,18.
JRST QOPEN]
SKIPL PTLFCD ;DATE IS -1 => LEAVE EMPTY.
CALL PTLAB9
JRST SLPXIT
] ;IFN ITS
IFN TNX,[
FSDCNI: CALL GAPSL0 ;MOVE GAP TO PT, BUT ARENT MUNGING BUFFER
CALL GETIB. ;GET BYTE POINTER TO .
MOVE A,BP
SETZ B,
IDTIM ;READ IN TIME
SETO B,
IFN 20X,DBP7 A ;MAKE RESULTING BYTE POSITIONS CONSISTANT
MOVE BP,A ;GET UPDATED BYTE POINTER
CALL GETCA ;GET CHARACTER ADDR
SUB BP,EXTRAC ;MOVE OVER GAP
MOVEM BP,PT ;UPDATE .
MOVE A,B ;VALUE TO RETURN
JRST POPJ1
FSDCN2: MOVEI A,TYOM ;INTO BUFFER
HRRM A,LISTF5
HRROI A,BAKTAB ;STRING SPACE
MOVE B,C
TRNE FF,FRARG2
SKIPA C,SARG ;USE ANY SECOND ARG AS THE FORMAT
MOVSI C,(OT%NMN\OT%DAM\OT%SLA) ;ELSE DEFAULT TO DD/MM/YY HH:MM:SS
ODTIM
LDB C,[350700,,BAKTAB] ;IF ITS FORMAT, MUST MAKE UP FOR ODTIM LOSSAGE
TRNN FF,FRARG2
CAIE C,40
JRST FSDCN3
MOVEI C,"0 ;BY CONVERTING LEADING SPACE TO 0
DPB C,[350700,,BAKTAB]
FSDCN3: MOVEI C,20. ;MAKE ENOUGH ROOM
CALL [ TRNN FF,FRCLN
JRST GAPSLP
JRST QOPEN]
MOVEI A,BAKTAB
CALL ASCIND ;INSERT IT
JRST SLPXIT
FSJOBN: GJINF ;GET JOB NUMBER
MOVEI A,(C)
JRST CPOPJ1
FSGXNM: SKIPE JCLNAM ;FS XJNAME, USE NAME FROM JCL IF THERE IS ONE
JRST [ MOVEI E,JCLNAM
JRST FSSTR0]
FSGTNM: GETNM ;GET SIXBIT JOB NAME
MOVE C,A ;SET UP AS AN ARG
JRST FSIXST ;AND GO MAKE A STRING OF IT
FSMACH:
IFDEF HSTNAM,[
MOVEI E,[HSTNAM]
JRST FSSTR0
];HSTNAM
.ELSE [
IFE STANSW,[ ;;THIS CODE NO LONGER WORKS
MOVE A,[SIXBIT/LHOSTN/] ; SYSGT ARG: SIXBIT TABLE NAME
SYSGT ; GET LOCAL HOST NO.
JUMPE B,FSMAC1 ; TRY ALTERNATIVE METHOD IF NO LHOSTN
JUMPL A,FSMAC1 ; OR IF LHOSTN IS NEGATIVE (TOPS-20 RELEASE 3
; HAS A LHOSTN ENTRY ON ALL SYSTEMS)
MOVE B,A
HRROI A,BAKTAB
CVHST ; CONVERT HOST NO. TO NAME
JRST FSMAC1 ; NO STRING FOR THAT HOST
];IFE STANSW
IFN STANSW,[
MOVEI A,2 ; .GTHNS - GET HOST NAME
HRROI B,BAKTAB ; PUT STRING HERE
SETO C, ; WANT HOST NAME
GTDOM
ERJMP .+2
JRST FSMAC0
MOVEI A,2 ; .GTHNS - GET HOST NAME
HRROI B,BAKTAB ; PUT STRING HERE
SETO C, ; WANT HOST NAME
GTHST ; BBN STYLE TCP
JRST FSMAC1
FSMAC0:
];IFN STANSW
MOVEI B,0 ; MAKE SURE STRING IS ASCIZ
IDPB B,A ; ...
JRST FSSTR3
FSMAC1:
IFN 20X,[
MOVEI A,.NDGLN ;TRY DECNET NODE NAME
MOVEI B,C
HRROI C,BAKTAB
NODE
ERJMP FSMAC2
JRST FSSTR3 ;BAKTAB NOW HAS ASCIZ NODE NAME
];20X
FSMAC2: SETZM BAKTAB ; FOR THE MOMENT RETURN 0
JRST FSSTR3
];HSTNAM
FSCCLF: SKIPN A,CCLJFN ;FS CCL FNA$ - IF STARTED AT +2, ...
JRST CPOPJ1 ;NOT, RETURN 0
MOVEI B,(A)
HRROI A,BAKTAB ;RETURN STRING OF JFN GIVEN
MOVE C,[111110,,000001] ;AS DSK:<DIR>NAM.EXT.GEN
JFNS
TRZE FF,FRUPRW ;IF ATSIGN,
JRST FSSTR3 ; THEN DON'T RELEASE THE JFN
MOVEI A,(B)
RLJFN
JFCL
SETZM CCLJFN ;DONT HAVE STRAY JFNS AROUND LATER
JRST FSSTR3 ;MOVE STRING FROM BAKTAB AND RETURN STRING POINTER
FSNQIT: MOVE A,NOQUIT ;GET PREVIOUS SETTING
ARGDFL
TRZN FF,FRARG ;IF NO ARG,
JRST POPJ1 ;RETURN IT
MOVEM C,NOQUIT ;SETUP NEW ONE
JUMPG A,FSNQT2 ;CHANGING FROM POSITIVE
JUMPLE C,POPJ1 ;IF NOT CHANGING TO POSITIVE, NOTHING TO DO
SAVE A
MOVEI A,.TICCG
DTI ;ELSE TURN OFF ^G INTERRUPT
JRST POPAJ1
FSNQT2: JUMPG C,POPJ1 ;NOTHING IF CHANGING TO POSITIVE
SAVE A
MOVSI A,.TICCG ;ELSE RE-ASSIGN ^G INTERRUPT
ATI
JRST POPAJ1
FSLOAD: MOVE A,[SIXBIT/SYSTAT/] ; SYSGT ARG: SIXBIT TABLE NAME
SYSGT ; FIND TABLE NO. OF SYSTAT TABLE
JUMPE B,FSLOA1 ; IF NOT FOUND THEN RETURN ZERO
MOVEI A,(B) ; GETAB ARG: TABLE NO. IN RH
HRLI A,14 ; AND OFFSET IN LH
GETAB ; GET ENTRY 14 OF SYSTAT TABLE: 1 MINUTE LOAD
; AVERAGE
TDZA B,B ; IF ERROR RETURN ZERO
MOVE B,A
FSLOA1: HRROI A,BAKTAB
MOVE C,[FL%ONE\FL%PNT\020200]
JSYS 233 ;FLOUT MAYBE SHOULD BE RENAMED
SETZM BAKTAB
JRST FSSTR3
];IFN TNX
IFN TNX,[
FSDIRH: MOVE B,HSNAME ;HOME DIRECTORY
JRST FSDIR3
FSDIR2: GJINF
MOVE B,A ;LOGIN DIR
JRST FSDIR3
FSDIRS: TRZE FF,FRARG ; IF ARGUMENT
JRST FSDIR4 ; THEN CONNECT TO DIRECTORY
GJINF ;CONNECTED DIR
FSDIR3: HRROI A,BAKTAB
DIRST ;INTO STRING SPACE
SETZM BAKTAB
FSSTR3: MOVEI E,BAKTAB
FSSTR0: MOVEI C,10 ;GET ENOUGH STRING
CALL QOPEN
MOVEI A,(E)
CALL ASCIND ;INSERT IT
FSSTR2: CALL QCLOSV ;AND RETURN STRING POINTER
JRST POPJ1
; HERE TO HANDLE <VALUE>FSMSNAME
FSDIR4: MOVE A,C ; CONVERT OUR STRING ARGUMENT TO ASCIZ IN BAKTAB
MOVE C,[440700,,BAKTAB] ; ...
CALL STRASC ; ...
PUSH P,[0] ; 0 IF NO PASSWORD
TRZN FF,FRARG2 ; PRE-COMMA ARGUMENT?
JRST FSDIR7 ; NO
MOVEM C,(P) ; YES, SET PASSWORD POINTER NONZERO
MOVE A,SARG ; CONVERT PRE-COMMA STRING ARGUMENT TO ASCIZ
CALL STRASC ; ...
FSDIR7:
IFN 20X,[
MOVE A,[AC%CON+3] ; ACCES ARG: A = FLAGS,,ARGUMENT BLOCK LENGTH
MOVEI B,C ; ACCES ARG: B = ARGUMENT BLOCK ADDRESS
HRROI C,BAKTAB ; ARGUMENT BLOCK + 0: DIRECTORY NAME
POP P,D ; ARGUMENT BLOCK + 1: PASSWORD
MOVNI E,1 ; ARGUMENT BLOCK + 2: JOB NUMBER
ACCES ; CONNECT TO DIRECTORY
ERJMP OPNER2 ; GIVE FILENAMELESS ERROR
]
.ELSE [
HRROI B,BAKTAB ; STDIR ARG: B = DIRECTORY NAME
STDIR ; TRANSLATE DIRECTORY NAME TO NUMBER
; +2 RETURN NOT POSSIBLE IF ASKING FOR EXACT MATCH, SO CAN ASSUME
; ERROR, IF ANY, WILL GO TO +1
MOVE B,[.FHSLF,,600075] ; ERSTR ARG: FORK,,ERROR CODE
JRST [ TRO FF,FRNOT ; NO FILENAME
JRST OPNER6 ] ; GIVE NO SUCH DIRECTORY ERROR
HRRZ A,A ; CNDIR ARG: A = DIRECTORY NUMBER
POP P,B ; CNDIR ARG: B = PASSWORD STRING POINTER
CNDIR ; CONNECT TO DIRECTORY
JRST OPNER2 ; GIVE FILENAMELESS ERROR
]
RET
STRASC: CALL QLGET0
TYPRE [QNS]
JUMPE B,FSDIR6
FSDIR5: ILDB A,BP
IDPB A,C
SOJG B,FSDIR5
FSDIR6: MOVEI A,0
IDPB A,C
RET
FSDSNM: TRO FF,FRNOT ;FLAG TO FLUSH DIRST PUNCTUATION
FSSTRR: HLRZS E ;GET DESIRED ADDRESS
PUSH P,C ;SAVE ARG IN CASE NEED IT
CALL FSSTR0 ;GET STRING TO RETURN
JFCL
EXCH A,(P)
TRZN FF,FRARG ;ANY ARG?
JRST FSST1A ;NO, JUST RETURN IT
HRLI E,440700 ;MAKE BYTE POINTER
SKIPGE A ;GET ARG - SHOULD BE A STRING
CALL QLGET0 ;GET BYTE POINTER AND SIZE OF STRING
TYPRE [ARG] ;NOT A STRING?
FSSTR1: ILDB CH,BP
CAIL CH,"a
CAILE CH,"z
CAIA
SUBI CH,"a-"A ;MAKE SURE IS UPPERCASE
CAIN CH,": ;LOOK LIKE STRUCTURE PUNCTUATION FROM DIRST
TRNN FF,FRNOT ;AND ON THE LOOKOUT FOR THAT?
CAIA
JRST FSDSN2 ;YES, GO HANDLE THAT
CAIE CH,"<
CAIN CH,"> ;IF PART OF DIRECTORY PUNCTUATION
TRNN FF,FRNOT ;AND LOOKING FOR IT - SKIP MOVING CHAR
IDPB CH,E
SOJG B,FSSTR1 ;MOVE STRING INTO DESIRED PLACE
MOVEI CH,^@ ;AND END WITH A NULL
IDPB CH,E
FSST1A: POP P,A
JRST CPOPJ1 ;RETURN OLD VALUE
FSDSN2: MOVEI CH,^@
IDPB CH,E
MOVE CH,DEFDIR ;IF : SEEN IN DIRECTORY, MOVE STRUCTURE
MOVEM CH,DEFDEV ;OVER TO DEVICE
MOVE CH,DEFDIR+1
MOVEM CH,DEFDEV+1
MOVE E,[440700,,DEFDIR] ;AND RESET POINTER TO DIRECTORY
SOJA B,FSSTR1
;EXPUNGE CONNECTED DIRECTORY
FSEXPU:
IFN 20X,[
GJINF ;GET CONNECTED DIRECTORY INTO B
SETZ A, ;NO FLAGS
];20X
DELDF
ERJMP OPNER2
RET
] ;IFN TNX
;RETURN THE HORIZ POS. OF THE CURRENT POINTER SETTING,
;ASSUMING THAT BACKSPACES AND STRAY CR'S COME OUT AS SUCH.
; ^HPRINT AND ^MPRINT FLAGS ARE NOT LOOKED AT.
;FS TABWID IS OBEYED.
FSHPOS: MOVE BP,BEGV
SOS C,BP
SETZ A,
MOVE BP,PT
CAMN BP,BEGV
JRST POPJ1
MOVE IN,BP
SOS BP
FSHPOL: SOS IN
CALL GETCHR
CAIE CH,^M
CAMN C,IN
JRST FSHPOT
JRST FSHPOL
FSHPOD: AOS IN
CALL GETCHR
CAIE CH,^J
CAIN CH,GLITCH
JRST FSHPOT
CAIN CH,^I
JRST [ ADD A,TABWID
IDIV A,TABWID
IMUL A,TABWID
JRST FSHPOT]
CAIN CH,ALTMOD
AOJA A,FSHPOT
CAIN CH,^H
SOJA A,FSHPOT
CAIGE CH,"
AOJ A,
AOJ A,
FSHPOT: CAME IN,BP
JRST FSHPOD
JRST POPJ1
;RETURN HPOS COUNTING CTL CHARS AS THEY APPEAR, BUT NOT COUNTING CONTINUATION.
FSSHPS: SAVE NHLNS
.I NHLNS=1000000.
CALL RRBTCR
MOVE A,RRHPOS
REST NHLNS
SAVE A
CALL RRBTCR
REST A
JRST POPJ1
;READ OR SET THE VIRTUAL BUFFER BOUNDARIES - THE RANGE OF
;BUFFER THAT ALL OTHER COMMANDS ARE ALLOWED TO TOUCH.
FSBOUN: TRNN FF,FRARG
JRST HOLE ;NO ARG => RETURN BOUNDS, LIKE H COMMAND
MOVE E,SARG
CALL GETARG ;ELSE CALCULATE NEW BOUNDS,
CALL CHK1A
CALL HOLE ;SET UP THE VALUES TO BE RETURNED,
JFCL
FSBOU1: CALL CHK1A ;MAKE SURE BEG<C<E<Z, IN CASE COMING FROM FSVB OR FSVZ.
MOVEM C,ZV ;STORE NEW BOUNDS (HOLE LOOKED AT OLD ONES)
MOVEM E,BEGV
CAMG C,PT ;MOVE PT INTO THE RANGE NOW
MOVEM C,PT ;BEING EDITED, IN CASE IT IS OUTSIDE IT.
CAML E,PT
MOVEM E,PT
VALRTA: TRZ FF,FRARG ;RETURN VALUE, FLUSHING ARGUMENTS.
JRST POPJ1
FSVB: MOVE A,BEGV ;GET C AS REL. CHAR ADDR.
SUB A,BEG
TRZN FF,FRARG ;IF NO ARG, JUST RETURN THAT.
JRST POPJ1
ADD C,BEG ;ELSE TURN ARG INTO ABS CHAR ADDR, TO SET BEGV.
MOVE E,C ;GET IN C NEW VALUE OF ZV (SAME AS OLD
CAMG C,ZV ;UNLESS THAT WOUL DBE LESS THAN NEW BEGV).
MOVE C,ZV
JRST FSBOU1 ;GO SET THEM BOTH (AND MAYBE PT).
FSVZ: MOVE A,Z ;GET Z-ZV TO RETURN.
SUB A,ZV
TRZN FF,FRARG ;IF ARG, IT IS DESIRED Z-ZV
JRST POPJ1
MOVE E,Z
SUBB E,C ;SO COMPUTE DESIRED ZV FROM IT
CAML E,BEGV
MOVE E,BEGV ;AND IF NECESSARY CHANGE BEGV AS WELL.
JRST FSBOU1
SUBTTL F6 COMMAND - SIXBIT CONVERSION
IFN TNX,[
;ON TWENEX, "SIXBIT" VALUES ARE REALLY STRINGS. SO THE F6 COMMAND IS TRIVIAL.
FSIXB: TRZN FF,FRARG
JRST FCTLK0 ;NO ARG => CONVERT STRING ARG TO "SIXBIT", SAME AS :I*.
MOVE A,C
TRZE FF,FRUPRW+FRCLN
JRST POPJ1 ;:F6 CONVERTS "SIXBIT" TO STRING: RETURN THE ARG.
JRST QGET4 ;F6 INSERTS "SIXBIT" ARG IN BUFFER: ENTER "G" COMMAND.
]
IFN ITS,[
;F6 COMMAND.
FSIXB: TRZN FF,FRARG ;NO ARG => READ IN STRING AND CONVERT TO SIXBIT
JRST FSIXR
TRZE FF,FRUPRW+FRCLN ; :F6 RETURNS STRING CONTAINING THE CHARS OF THE SIXBIT.
JRST FSIXST
MOVE A,C ;ELSE INSERT ARG IN BUFFER.
CALL QLGET0 ;IF ARG IS ACTUALLY A STRING, GO TO G COMMAND.
CAIA
JRST QGET4
MOVE E,C ;TREAT ARG AS WD OF SIXBIT AND INSERT IN BUFFER.
MOVEI A,TYOM
HRRM A,LISTF5
CALL GAPSLP
JRST SIXNTY ;GO INSERT THE SIXBIT.
]
FSIXST: AOS (P) ;HERE TO CONVERT SIXBIT TO STRING.
MOVE A,C
CALL QLGET0
CAIA
RET ;IF ARG IS STRING ALREADY, JUST RETURN IT.
SAVE C
MOVEI C,12. ;WE WILL NEED AT MOST 12 CHARS - MAKE SURE SPACE IS THERE.
CALL QOPEN
REST E ;NOW OUTPUT THE SIXBIT INTO STRING SPACE (LISTF5 AND BP
CALL SIXNTY ;SET UP BY QOPEN).
JRST QCLOSV ;WRITE THE HEADER AND RETURN THE STRING POINTER.
FSIXFL: AOS (P) ;CONVERT SIXBIT TO STRING, PUTTING "FS" IN FRONT AND ALTMODE BEHIND.
SAVE C
MOVEI C,15. ;WORKS ALMOST LIKE FSIXST.
CALL QOPEN
MOVEI CH,"F ;BUT PUT IN THE "FS" NOW.
IDPB CH,BP
MOVEI CH,"S
IDPB CH,BP
REST E
CALL SIXNTY
MOVEI CH,ALTMOD ;PUT IN THE ALTMODE AT THE END.
IDPB CH,BP
JRST QCLOSV
IFN ITS,[
FSFDEV: MOVSI CH,(LFN"DEVFLG)
JRST FSFNC
FSFDIR: MOVSI CH,(LFN"DIRFLG)
JRST FSFNC
FSFFN1: MOVE CH,[LFN"NAMFLG 1]
JRST FSFNC
FSFFN2: MOVE CH,[LFN"NAMFLG 2]
;JRST FSFNC
;Get the CH component of lh(E). If arg given, replace the component with it.
FSFNC: SAVE E
CALL FSRFNC
SAVE CH
MOVEI E,TMPFIL
CALL FSDFR1 ;Make a Teco string
REST CH
REST E
TRZN FF,FRARG
JRST POPJ1
SAVE A
MOVE D,[440700,,BAKTAB]
MOVEI B,^X
TRNE CH,2
IDPB B,D
CALL STRGET
MOVEI B,":
TLNN CH,(LFN"DEVFLG)
MOVEI B,";
TLNE CH,(LFN"DEVFLG\LFN"DIRFLG)
IDPB B,D
SETZ B,
IDPB B,D
CALL FSSFNC
JRST POPAJ1
;Replace the CH component of lh(E) with arg in BAKTAB
FSSFNC: SAVE C
SAVE E
MOVE A,[-FNBLEN,,BAKTAB+F10LEN]
HLRZ D,E
CALL LFN"PARFN
JFCL
SAVE A
MOVE A,[-FNBLEN,,BAKTAB+F10LEN+FNBLEN]
MOVEI D,BAKTAB
CALL LFN"PARFN
JFCL
REST B
MOVEI C,TMPFIL
MOVEI D,FNMLEN*5
SETO E,
CALL LFN"SMERGE
TYPRE [FTL]
REST E
HLR D,E ;Put it back into default
HRLI D,TMPFIL
MOVEI B,FNMLEN-1(D)
BLT D,(B)
JRST POPCJ
;Read filename component specified by CH from filename in lh(E) into TMPFIL.
;Clobbers A,D,E
FSRFNC: SAVE C
MOVE A,[-FNBLEN,,BAKTAB+F10LEN]
HLRZ D,E
CALL LFN"PARFN
JFCL
MOVEI C,TMPFIL
MOVEI D,FNMLEN*5
MOVE E,CH
CALL LFN"SGNAME
TYPRE [FTL]
SKIPG D
IBP C
SETZ D,
DPB D,C ;Flush terminator
JRST POPCJ
;Given a sixbit word or TECO string pointer in C,
;turn it into ASCII and send it down BP in D with filename quoting.
STRGET: MOVE A,C
CALL QLGET0
JRST STRGE1
JUMPE B,CPOPJ
CAILE B,FNMLEN*5-2
TYPRE [FTL]
STRGE2: ILDB TT,BP
IDPB TT,D
SOJG B,STRGE2
RET
STRGE1: JUMPE A,CPOPJ
SETZ B,
ROTC A,6
ADDI B,40
MOVEI TT,^Q
CAIE B,":
CAIN B,";
IDPB TT,D
CAIN B,40
IDPB TT,D
IDPB B,D
JRST STRGE1
];ITS
IFN ITS,[
;FS D VERSI$ - RETURN OR SET DEFAULT VERSION NUMBERS
FSDVER: SAVE C
CALL FSFVER ;GET VALUE IN A CORRESPONDING TO OLD VALUE OF DEFAULT FN2.
JFCL
EXCH A,(P)
TRZN FF,FRARG ;ANY ARG GIVEN?
JRST POPAJ1 ;NO, GO RETURN DEFAULT
MOVSI T,(SIXBIT/>/) ;Convert arg to sixbit
JUMPE A,FSDVR1
MOVSI T,(SIXBIT/</)
CAMN A,[-2]
JRST FSDVR1
JUMPL A,POPAJ1 ;ARG IS -1 => DON'T CHANGE ANYTHING.
CAMLE A,[999999.]
TYPRE [ARG] ;ELSE MUST BE REASONABLE VERSION NUMBER.
CALL DPTSIX
FSDVR1: MOVE A,[-FNBLEN,,BAKTAB+F10LEN] ;Check out default
MOVEI D,DEFFIL
CALL LFN"PARFN
JFCL
MOVEI D,(E) ;Get number of filenames
JUMPG D,FSDVR2
;No default filenames and wants to set the version! What to do???
;Make it ^Xvers and hope he sets the filename somewhere along the way.
HRRZ B,A
HLRE C,A
SUB B,C
MOVE C,[440700,,[ASCIZ ""]]
MOVEM C,(B)
MOVE C,[LFN"NAMFLG 1]
MOVEM C,1(B)
SUB A,[2,,0]
FSDVR2: SOJG D,FSDVR3
HRRZ B,A ;Here if one filename, make version the new
HLRE C,A ;second filename
SUB B,C ;Point to end of name
SUB A,[2,,0] ;Gonna make one more
JRST FSDVR5
FSDVR3: MOVSI E,(LFN"NAMFLG) ;Here if at least two names, gonna replace
SKIPA B,A ;the last one, so find it.
FSDVR4: ADD B,[2,,2]
TDNN E,1(B)
JRST FSDVR4
SOJGE D,FSDVR4
FSDVR5: MOVEM T,(B) ;Save version
HRLOI T,(LFN"NAMFLG) ;Mark as sixbit name
MOVEM T,1(B)
MOVEI C,TMPFIL
MOVEI D,FNMLEN*5
CALL LFN"PFNMCH
TYPRE [FTL]
MOVE A,[TMPFIL,,DEFFIL]
BLT A,DEFFIL+FNMLEN-1
JRST POPAJ1
DPTSIX: SETZ T,
MOVE TT,[440600,,T]
DPTSX0: IDIVI A,10.
HRLM B,(P)
SKIPE A
CALL DPTSX0
HLRZ B,(P)
ADDI B,'0
IDPB B,T
POPJ P,
;FS IF VERS$ - RETURN VERSION NUMBER OF INPUT FILE AS A NUMBER.
;FS OF VERS$ - RETURN VERSION NUMBER OF LAST OUTPUT FILE CLOSED.
;FS D VERSION$, READING HALF - RETURN DEFAULT FN2 AS NUMBER.
;EXPECTS ADDRESS OF FILENAME STRING IN LH(E).
; RETURN -1 IF THE FN2 IS NOT NUMERIC.
; -2 FOR "<" AND 0 FOR ">" (FS D VERSION$ ONLY)
FSFVER: MOVE A,[-FNBLEN,,BAKTAB+F10LEN]
HLRZ D,E
CALL LFN"PARFN
JFCL
TLZ E,-1 ;Get # of names.
JUMPE E,NRETM1 ;None, return -1
SOJE E,NRET0 ;Only one, so second name is the default (">")
HRLOI E,(LFN"NAMFLG) ;More than one, so look at the last name entry
MOVE C,[-2,,TT]
CALL LFN"BGNAME
JFCL
HRRZ E,TT1
CAIE E,1 ;One char long?
JRST FSFVR1
MOVE D,TT ;Yea, check for < >.
ILDB D,D
CAIN D,">
JRST NRET0
CAIE D,"<
JRST FSFVR1
HRROI A,-2
JRST POPJ1
FSFVR1: SETZ A,
FSFVR2: ILDB D,TT
CAIL D,"0
CAILE D,"9 ;ALLOW ONLY DIGITS
JRST NRETM1 ;RETURN -1 OTHERWISE
IMULI A,10.
ADDI A,-"0(D)
SOJG E,FSFVR2
JRST POPJ1 ;NO NON-DIGITS => RETURN THE NUMBER.
] ;IFN ITS
IFN TNX,[
;FS D VERSION$ IS LIKE FSNORM ON DEFFN3 EXCEPT THAT IT REFERS TO THE SIGN-EXTENDED RH.
FSDVER: HRRZS C
HLRZS E
HRRE A,(E)
JRST FSNOR2
] ;IFN TNX
SUBTTL FA (FILL / JUSTIFY) COMMAND
;FA COMMAND (TEXT JUSTIFICATION). ARGS SPEC RANGE OF BUFFER.
;THE LINE SIZE IS KEPT IN ADLINE (FS ADLINE).
;A CRLF FOLLOWED BY A CRLF OR SPACE CAUSES A BREAK.
;OTHERWISE, CRLFS ARE REPLACED BY SPACES, UNLESS THEY END BLANK LINES.
;EXCESS SPACES (OR CRLFS TURNED INTO SPACES) ARE NOT REMOVED
;UNLESS A CRLF IS INSERTED JUST BEFORE THEM. IN THAT CASE, THEY MUST
;BE REMOVED TO AVOID CREATING A BREAK.
;SPACES AT THE BEGINNING OF A LINE ARE TREATED AS PART OF
;THE FIRST WORD OF THE LINE FOR JUSTIFICATION PURPOSES,
;TO PREVENT INDENTATION OF PARAGRAPHS FROM CHANGING.
;THE LAST PART-LINE OF STUFF TO BE JUSTIFIED
;IS CONSIDERED TO HAVE A BREAK AFTER IT.
;SPACE-BACKSPACE-SPACE ACTS LIKE A SINGLE ORDINARY CHAR.
;THIS MAKES IT POSSIBLE TO PUT A SPACE INTO A WORD.
;@FA IS LIKE FA BUT ONLY FILLS - IT DOESN'T JUSTIFY.
;FRALT => IF NEXT CHAR IS SPACE OR CR, IT SHOULD BREAK.
;FRNOT => NO NON-SPACE HAS BEEN SEEN YET ON THIS LINE
;(SO SPACES SHOULD BE LIKE ORDINARY CHARS)
;FRFIND => PREVIOUS CHAR WAS ^H SO SPACE IS ORDINARY.
;FRSPAC => PREV. CHAR WAS SPACE, SO SPACE SHOULD BE ORDINARY AFTER IT
ADJUST: PUSHJ P,GETANU
EXCH C,E ;THROUGHOUT THE CMD, E -> 1ST CHAR AFTER RANGE TO JUSTIFY.
MOVEM C,PT
CALL GAPSLP
SAVE [0] ;THIS WD HAS STARTING HPOS OF LINE.
;COME HERE TO PRODUCE 1 MORE LINE OF JUSTIFIED TEXT.
ADJLP0: ANDCMI FF,FRALT
MOVE IN,PT
MOVE D,IN ;D -> 1ST CHAR THAT MIGHT NOT FIT (DON'T KNOW YET)
ANDCMI FF,FRFIND+FRSPAC ;PREV. CHAR WASN'T ^H. OR SPACE.
TRO FF,FRNOT ;NO NON-SPACE HAS BEEN SEEN SO FAR.
MOVE J,(P) ;J HAS HPOS IN OUTPUT LINE,
SETZ OUT, ;OUT IS # WDS FOUND SO FAR.
SETZ Q, ;Q IS 0 IF WE HAVEN'T PASSED A CRLF, OR CHAR ADDR AFTER LAST CRLF.
SETZ C, ;C HAS # WDS AS OF LAST CRLF WE PASSED.
SAVE J ;(P) HAS WHAT J HAD WHEN IN HAD WHAT D HAS.
MOVE BP,IN
ADD BP,EXTRAC
CALL GETIBP ;WE WILL FETCH CHARS VIA BP.
ADJLP1: CAML IN,E
JRST ADJEN1 ;PRETEND THERE'S A SPACE AFTER RANGE TO WORK ON.
ILDB CH,BP
AOJ IN,
CAIG CH,40
JRST ADJCTL
ADJNRM: ANDCMI FF,FRALT\FRNOT\FRFIND\FRSPAC ;NORMAL CHAR ON PASS 1 OF FA.
AOJA J,ADJLP1
ADJEN1: TRNE FF,FRNOT ;HERE IF WE REACH END OF REGION TO BE FILLED.
JRST ADJSKP ;IF LAST LINE IS JUST SPACES, LEAVE IT ALONE.
JUMPE J,ADJSKP ;IF IT IS EMPTY, LEAVE IT ALONE.
JUMPE OUT,ADJSP2 ;IF IT IS JUST ONE WORD, LEAVE IT ALONE.
CAMLE J,ADLINE ;ELSE MAY HAVE TO BREAK IT IF IT IS TOO LONG.
JRST ADJGO
JRST ADJBRK ;IF IT FITS IN ONE LINE, REMOVE ANY OLD CRLFS FROM IT.
ADJCTL: CAIN CH,40
JRST ADJSPC ;SPACE ENDS A WORD.
CAIN CH,^M
JRST ADJCR ;CR ENDS A WORD.
CAIN CH,^I
JRST ADJTAB
CAIN CH,^L ;^L MAKES A BREAK BEFORE AND AFTER THE LINE CONTAINING IT.
JRST ADJFF
CAIE CH,^H
JRST ADJNRM
TRZ FF,FRALT\FRNOT\FRSPAC
IORI FF,FRFIND
SOJGE J,ADJLP1
AOJA J,ADJLP1
ADJFF: JUMPN Q,ADJFF1 ;^L: IF IT'S NOT ON THE LINE WE STARTED HACKING ON THIS CYCLE,
;FILL UP TO THE CRLF BEFORE THE ^L, THEN CONSIDER IT AGAIN.
JRST ADJSK1 ;JUST SKIP OVER THE ^L, AND WHAT PRECEDES IT ON THE LINE.
ADJTAB: TRNE FF,FRALT ;COME HERE FOR TAB
SOJA IN,ADJBRK ;TAB AT START OF LINE BREAKS.
SAVE BP
ADD J,TABWID ;ADVANCE J TO NEXT TAB STOP.
IDIV J,TABWID
IMUL J,TABWID
REST BP
MOVEM J,-1(P) ;SAY NEXT OUTPUT LINE STARTS AT THAT STOP
JUMPE Q,ADJSK1 ;IF WE HAVEN'T PASSED A CRLF THIS TIME, SKIP PAST ALL BEFORE TAB.
ADJFF1: MOVE IN,Q ;ELSE BACK UP TO THE CRLF AND FILL UP TO IT.
MOVE OUT,C ;THEN NEXT TIME WE'LL SKIP ALL FROM CRLF TO THE TAB.
JRST ADJBRK
;COME HERE ON SPACE
ADJSPC: TRNE FF,FRALT ;IF 1ST CHAR ON LINE, IT IS A BREAK.
JRST ADJSP1
TRNN FF,FRFIND\FRSPAC\FRNOT ;ELSE IF SPACE FOLLOWS A WORD,
SKIPA B,BP ;THEN UNLESS
JRST ADJNSP
ILDB B,B ;IT IS FOLLOWED BY A BACKSPACE, WE END A WORD.
CAIE B,^H
JRST ADJSP1
ADJNSP: TRZ FF,FRFIND\FRALT
AOJA J,ADJLP1
ADJCR: TRZE FF,FRFIND ;COME HERE ON CR.
AOJA IN,ADJBRK ;CR PRECEDED BY ^H CAUSES BREAK AFTER FOLLOWING LF.
TRNE FF,FRALT ;THIS CR ENDS NULL LINE => BREAK
SOJA IN,ADJBRK ;BEFORE IT.
;THE PARAGRAPH WILL BE ENDED, AND WE'LL
;COME BACK HERE WITH FRALT CLEAR,
;AND DO THE JUMPE J, BELOW.
TRNE FF,FRNOT ;LINE OF ONLY SPACES IS A BREAK.
AOJA IN,ADJSKP
IBP BP ;SKIP THE LF ASSUMED TO FOLLOW THE CR.
AOS IN
MOVE Q,IN ;REMEMBER CHAR ADDR AND # WDS AS OF MOST RECENT CRLF.
MOVE C,OUT
JUMPE J,ADJSKP ;NULL LINE AT BEGINNING => PASS OVER IT.
ADJSP1: TRNE FF,FRALT ;SPACE AFTER CRLF; BREAK BEFORE THE SPACE
SOJA IN,ADJBRK ;SO SPACE WILL BE REPROCESSED FOR NEXT LINE.
JUMPE OUT,ADJSP2 ;PREVENT LOSSAGE FROM SUPERLONG WORD.
CAMLE J,ADLINE
JRST ADJGO ;WORD JUST ENDED WON'T FIT =>JUSTIFY THE OTHERS & NEW LINE.
ADJSP2: CAIN CH,^M
TRO FF,FRALT ;AFTER ^M, ANOTHER SPACE BREAKS.
TROE FF,FRSPAC ;AFTER A SPACE, DON'T COUNT A NEW WORD, BUT DO ADVANCE HPOS.
AOJA J,ADJLP1
MOVEM J,(P) ;REMEMBER HOW FAR WE GOT IN BUFFER AND LINE.
MOVE D,IN
AOS J ;IF NEXT WD FITS, WILL NEED 1 POS FOR SPACE.
AOJA OUT,ADJLP1
ADJSKP: SETZM -1(P)
ADJSK1: MOVEM IN,PT ;PASS OVER SOME TEXT, NOT FILLING.
SUB P,[1,,1]
CALL GAPSLP
JRST ADJBR3
ADJBRK: SETZM (P) ;FILL THE LINE BEFORE A BREAK BUT NOJUST.
MOVE D,IN
TRO FF,FRALT ;INDICATE WE STOPPED AT A BREAK.
JRST ADJBR1
;COME HERE AFTER DELIMITING WHAT WILL BECOME ONE LINE, TO JUSTIFY IT.
ADJGO: MOVN J,(P)
ADD J,ADLINE
TRNE FF,FRUPRW ;JUST FILLING => INSERT NO SPACES.
SETZ J,
TRZ FF,FRALT ;WE DID NOT STOP AT A BREAK.
MOVEM J,(P) ;# SPACES MUST SCATTER THRU LINE.
;(P) HAS # OF SPACES WE MUST INSERT TO JUSTIFY
;(0 IF STOPPED AT A BREAK, IN WHICH CASE FRALT SET)
;OUT HAS # OF WORD-BREAKS IN THE LINE.
;-1(P) STILL HAS HPOS TO START NEXT LINE AT.
;E STILL HAS 1ST CHAR NOT TO BE PROCESSED BY THE FA COMMAND.
;D HAS CHAR ADDR OF 1ST CHAR NOT TO BE INCLUDED.
;IF FRALT IS SET (BREAK FOLLOWS), D IS EXACT.
;THE CRLF BEFORE D MAY HAVE PRECEDING SPACES, WHICH ARE DELETED.
;OTHERWISE, D POINTS AFTER THE SPACE OR CRLF AFTER THE LAST WORD TO INCLUDE.
;IN THIS CASE, THERE MAY BE MORE SPACES FOLLOWING, WHICH OUGHT TO BE DELETED.
;A CRLF AFTER THE SPACES SHOULD ALSO BE DELETED.
ADJBR1: SETZ J,
SOSG OUT
MOVEI OUT,1
ANDCMI FF,FRFIND+FRSPAC
TRO FF,FRNOT ;NO NON-SPACE CHAR SEEN YET.
MOVE IN,PT ;IN IS CHAR ADDR FOR TAKING FROM ABOVE GAP,
MOVE BP,PT
CALL GETIBP ;BP IS BP FOR IDPBNG INTO BOTTOM OF GAP.
ADJGL: CAML IN,E
JRST POP2J ;AT END OF RANGE IN MID-LINE => DON'T PUT IN A CRLF.
CALL GETINC
CAIN CH,^M
JRST ADJGCR
CAIN CH,40
JRST ADJGS
ADJGS4: CAMLE IN,D ;AT END OF THIS OUTPUT LINE & PAST ALL TRAILING SPACES
JRST ADJDUN ;=> INSERT THE CRLF AND HACK NEXT LINE.
ANDCMI FF,FRNOT+FRSPAC ;NON-SPACE SEEN.
CAIN CH,^H
TROA FF,FRFIND
ADJGS1: ANDCMI FF,FRFIND
IDPB CH,BP ;ORD. CHR., JUST COPY TO BELOW THE GAP.
AOS GPT
AOS PT
JRST ADJGL
ADJGS: CAME E,IN ;SPACE AT END OF RANGE => DON'T CHECK FOLLOWING CHAR.
TRNE FF,FRNOT+FRFIND
JRST ADJGS1 ;SPACE AFTER BS OR BEFORE 1ST WD IS NORMAL CHAR.
CALL GETINC ;ELSE SEE IF FOLLOWED BY BS.
CAIE CH,^H
SOJA IN,[ ;NO, IT IS A WORD DELIMITER.
TRNN FF,FRALT ;IF LINE DOESN'T END WITH A BREAK,
JRST ADJCR1 ;MAKE SURE EXTRA SPACES PAST END ARE DELETED.
JRST ADJCR2]
MOVEI CH,40
SOJA IN,ADJGS4 ;YES, IT IS ORDINARY.
ADJGCR: ANDCMI FF,FRFIND ;CR: DELETE FOLLOWING LF IF ANY.
CALL GETCHR
CAIN CH,^J
CALL ADJDLC
ADJCR2: CAMGE IN,D ;CRLF (OR SPACE, IF THERE'S A BREAK HERE) PAST THE END OF THE LINE
JRST ADJCR1 ;MEANS WE HAVE FINISHED SKIPPING THE EXCESS MULTIPLE SPACES
CALL ADJDLC ;AND WE SHOULD JUST FLUSH THIS ONE AND PREVIOUS ONES
JRST ADJDUN ;AND PUT IN THE CRLF.
ADJCR1: MOVEI CH,40 ;ALSO REPLACE THE CR WITH A SPACE.
TROE FF,FRSPAC ;A SPACE OR CR WHICH FOLLOWS A SPACE
JRST ADJGS1 ;SHOULD NOT HAVE SPACES INSERTED AFTER IT FOR JUSTIFICATION.
CAMGE IN,D
ADD J,(P)
ADJGS2: CAMGE J,OUT
JRST ADJGS1
IBP BP ;TIME TO GENERATE A SPACE.
SUB J,OUT
AOS E
AOS D ;RELOC OUR PTRS TO BUFFER SINCE INSERTING CHAR.
AOS IN
CALL TYOM
JRST ADJGS2 ;SEE IF SHOULD INSERT ANOTHER SPACE.
;COME HERE WHEN WE HAVE DONE PASS 2 ON A WHOLE LINE
ADJDUN: SUBI IN,2 ;WE HAVE JUST PASSED AT LEAST ONE SPACE INTO THE OUTPUT LINE.
JRST ADJEND ;MAKE IN POINT AT IT. IN SHOULD BE GPT-1 NOW.
ADJDUD: CALL ADJDLB
ADJEND: CALL GETCHR ;DELETE ANY SPACES WHICH WOULD OTHERWISE BE LEFT AT
CAIN CH,40 ;THE END OF THE LINE, BEFORE THE CRLF WE ARE ABOUT TO MAKE.
JRST ADJDUD
ADJDU1: REST J
MOVEI CH,^M ;PRODUCED A LINE, PUT CRLF AFTER IT, REPLACING THE SPACE THERE.
CALL TYOM
MOVEI CH,^J
CALL TYOM
ADDI E,2 ;RELOCATE PTR TO BUFFER ABOVE PLACE INSERTED IN.
SETZM (P) ;NEXT LINE STARTS IN COLUMN 0.
ADJBR3: CAMLE E,PT ;MORE CHARS TO HANDLE =>
JRST ADJLP0 ;DO ANOTHER LINE.
JRST POP1J
ADJDLB: SOS PT
SOS GPT
SOS IN
ADJDLC: AOS EXTRAC ;DELETE THE CHAR AT PT.
SOS Z
SOS E
SOS ZV
SOJA D,CPOPJ
SUBTTL F^A DISPATCH-TABLE COMMAND
;"F^A" SCAN THROUGH THE BUFFER, DISPATCHING THROUGH A
;USER-SUPPLIED TABLE ON EACH CHARACTER.
;"@F^A" SCANS BACKWARDS.
FCACMD: CALL QREGX ;GET DISPATCH TABLE IN A.
LDB OUT,[.BP FRCLN,FF]
TRZ FF,FRCLN
CALL GETANU ;E,C HAVE RANGE TO SCAN.
DPB OUT,[.BP FRCLN,FF]
TRNE FF,FRUPRW
EXCH C,E ;E HAS PLACE TO START; C HAS PLACE TO STOP.
MOVEM E,PT
MOVEI TT,FCA1 ;LOOP POINT IF FCA1 FOR FORWARD SCAN.
TRZE FF,FRUPRW
MOVEI TT,FCA3 ;FCA3 FOR BACKWARD SCAN.
SAVE FF
SAVE TT
MOVE OUT,QRB.. ;SAVE DISPATCH TABLE STRING IN .Q..3
MOVEM A,.Q..3(OUT)
FCA0: CALL QLGET1 ;GET LENGTH IN B, BP IN BP.
TYPRE [QNS]
CAIGE B,128.*5
TYPRE [STS] ;STRING TOO SHORT.
JRST @(P) ;FCA1 OR FCA3
;LOOP POINT FOR FORWARD SCAN.
;BP HAS BP TO ILDB TABLE;
;C HAS CHAR ADDR OF LAST CHAR TO SCAN + 1.
FCA1: MOVE IN,PT
CAML IN,C
JRST POP2J ;FINISHED SCAN => RETURN.
CALL GETINC
MOVEM IN,PT
FCA4: TRNE FF,FRTRACE
CALL FCATRC ;PRINT PRETTY INFO IF TRACING.
MOVEM CH,.Q..0(OUT) ;SAVE CHAR IN CASE MACRO WANTS IT.
ADD CH,BP ;FIND THE 5 CHARS OF TABLE FOR THIS CHR.
ILDB A,CH ;IS THE FIRST A SPACE?
CAIE A,40
JRST FCA2 ;NO, MACRO THE 5 CHARS.
ILDB A,CH ;YES, THE NEXT CHAR HOLDS THE WIDTH
SUBI A,100
ADDM A,.Q..1(OUT) ;OF THIS CHAR, PLUS 100 .
ILDB A,CH ;GET THE 3RD CHAR OF THE FIVE.
CAIN A,40 ;"(" AND ")" ARE SPECIAL, " " IS NORMAL.
JRST @(P) ;FCA1 OR FCA3
HRRZ CH,(P) ;IT'S SPECIAL. WHICH DIRECTION ARE WE SCANNING?
CAIE A,") ;IF CODE IS ")",
JRST FCAOPN
SKIPGE .Q..1(OUT) ;STOP IF COUNT < 0 AND GOING FORWARD.
CAIE CH,FCA1
JRST (CH)
JRST POP2J
FCAOPN: SKIPLE .Q..1(OUT) ;CODE IS "("; STOP IF COUNT > 0 AND GOING BACKWARD.
CAIE CH,FCA3
JRST (CH)
JRST POP2J
FCA3: MOVE IN,PT ;LOOP POINT FOR SCANNING BACKWARDS
CAMG IN,C
JRST POP2J
SOS IN,PT
CALL GETCHR
JRST FCA4
;IN TRACE MODE, CALL HERE TO PRINT !<CHAR>! FOR EACH CHAR WE PASS.
FCATRC: SAVE CH
MOVEI CH,"!
CALL TYOS
MOVE CH,(P)
CALL TYOS
MOVEI CH,"!
CALL TYOS
JRST POPCHJ
;HERE FOR A CHAR WHICH REQUIRES THAT WE ACTUALLY MACRO SOME STUFF.
FCA2: MOVN TT,(P)
ADDI TT,FCA1 ;TT IS POS. IFF SCANNING FORWARD.
IFL FCA3-FCA1,.ERR
ASH TT,-43 ;-1 IFF BACKWARD, 0 IFF FORWARD.
IORI TT,1 ;-1 IFF BACKWARD, 1 IFF FORWARD.
MOVEM TT,INSLEN ;MAKE "^F" REPLACE THE CHAR SCANNED.
JUMPG TT,[ SUB C,ZV ;IF FORWARD, STORE END OF RANGE AS DISTANCE FROM Z.
MOVNM C,.Q..2(OUT)
JRST FCA5]
SUB C,BEGV ;GOING BACKWARD, STORE DISTANCE FROM C.
MOVEM C,.Q..2(OUT)
FCA5: MOVE B,.Q..0(OUT)
ADD BP,B
MOVE E,-1(P)
TRNE E,FRCLN ;:F^A TREATS DISPATCH TABLE AS A QVECTOR.
JRST [ IBP BP ;IT EXTRACTS A WORD, AND TREATS IT AS A STRING POINTER TO A MACRO.
MOVE A,(BP)
CALL MACXQ
JRST FCA7]
MOVE A,.Q..3(OUT)
MOVEI B,5 ;MACRO A STRING THAT IS AN INITIAL
;SEGMENT OF THE DISPATCH TABLE, ENDING AFTER THE
;FIFTH OF THE CHARS FOR THE CHAR JUST SCANNED.
;WANT TO SET COMCNT TO 5.
CALL MACXC2 ;EXECUTE THEM.
FCA7: MOVE OUT,QRB..
MOVE TT,(P)
CAIN TT,FCA1
JRST [ MOVN C,.Q..2(OUT)
ADD C,ZV ;SEE HOW THE MACRO HAS CHANGED END OF RANGE.
JRST FCA6] ;MUST USE DIFFERENT CODE DEPENDING ON HOW IT WAS STORED.
MOVE C,.Q..2(OUT)
ADD C,BEGV
FCA6: CAMGE C,BEGV ;DON'T LET END OF RANGE GET OUTSIDE VIRTUAL BOUNDARIES.
MOVE C,BEGV
CAMLE C,ZV
MOVE C,ZV
MOVE A,.Q..3(OUT)
JRST FCA0
POP2J: SUB P,[2,,2]
POPJ P,
SUBTTL F^B COMMAND
;<CH>F^B<STRING>$ - RETURNS -1 IF <CH> DOES NOT OCCUR IN <STRING>;
; OTHERWISE RETURNS THE POSITION OF THE FIRST OCCURRENCE
; (0 IF <CH> IS THE FIRST CHARACTER OF <STRING>).
;AT CALL, <CH> IS IN C. THIS COULD BE SMARTER:
; IF <CH> IS FOUND IN THE MIDDLE OF A SUBSTITUTED QREG WITHIN <STRING>,
; WE COULD JUST POP OUT OF IT RATHER THAN READING THROUGH IT.
;<POS>,<CH>F^B<STRING>$ SKIPS <POS> CHARS OF <STRING> BEFORE LOOKING FOR <CH>.
FMEMQ: TRNE FF,FRUPRW
JRST FFIND
TRZN FF,FRARG
TYPRE [WNA]
TRZN FF,FRARG2
SETZ E, ;E IS PLACE TO START SEARCHING (0, FOR 1ST CHAR, IF NO ARG).
MOVE B,MACPDP
SETZ A, ;A COUNTS THE CHARS WHICH AREN'T <CH>.
FMEMQ1: CALL RCH
SKIPN SQUOTP ;NO; REACHED END OF STRING?
CAIE CH,ALTMOD
CAIA ;NO, SEE IF REACHED DESIRED CHARACTER (OUR NUMERIC ARG)
JRST NRETM1 ;YES, RETURN -1
CAIE C,(CH)
AOJA A,FMEMQ1 ;DIDN'T REACH CHAR BEING SEARCHED FOR.
CAMGE A,E
AOJA A,FMEMQ1 ;REACHED IT, BUT BEFORE WHERE WE ARE SUPPOSED TO BE LOOKING.
CALL FNOOP ;FOUND <CH>. NOW IGNORE REST OF STRING
JRST POPJ1 ;AND RETURN THE VALUE, ALREADY IN A.
;HERE FOR @F^B<STRING>$ - FIND NEXT OCCURRENCE IN THE BUFFER
;OF A CHARACTER NOT IN <STRING>, AND RETURN .,<ADDR OF THAT OCCURRENCE>.
;@:F^B<STRING>$ RETURNS .,<ADDR OF NEXT CHAR WHICH IS IN STRING>.
;AN ARGUMENT OF -1 CAUSES SCANNING TO GO BACKWARDS INSTEAD.
;THUS, @F^B $K KILLS ALL SPACES AFTER POINT, AND @-F^B $K KILLS ALL THOSE BEFORE.
;WITH 2 ARGS <X>,<Y>, WE JUMP TO <X> AND THEN SCAN TOWARD <Y>.
FFIND: JSP BP,FLCMD1 ;FLCMD1 CALLS US TO MOVE POINT TO OTHER END OF RANGE,
;THEN CALCULATES AND RETURNS THE RANGE AS TWO VALUES.
CALL INDARG ;READ IN THE STRING. ST+1 HAS 1ST CHAR.
TRNN FF,FRARG2
JRST FFINDA
ADD C,BEG ;2 ARGS GIVE RANGE TO SCAN. CONVERT TO INTERNAL CHAR ADDRS.
ADD E,BEG
CALL CHKC ;BARF IF E NOT IN BUFFER.
CALL CHK ;BARF IF C NOT IN BUFFER.
MOVEM E,PT ;1ST ARG SAYS WHERE TO START THE SCAN.
MOVE OUT,C ;2ND ARG SAYS WHERE TO STOP.
SUB C,E ;SIGN OF C GETS DIRECTION OF SEARCH (AS IF JUST 1 ARG).
JRST FFINDZ
FFINDA: SKIPL C ;HERE FOR JUST 1 ARG. OUT GETS PLACE TO STOP SCAN.
SKIPA OUT,ZV
MOVE OUT,BEGV
FFINDZ: MOVE IN,PT ;J POINTS AT WORD AFTER THE LAST CHAR IN BAKTAB.
CALL GETIBI ;GOING FWD => GET B.P. TO ILDB CHAR AFTER POINT.
JUMPL C,FFINDB ;GOING BACKWARD => ALTER THAT.
FFINDC: CAMN IN,OUT ;IN AND PT ARE THE SAME. BP HAS B.P. TO ILDB CHAR AT PT.
RET
CAMN IN,GPT ;HANDLE MOVING ACROSS THE GAP.
CALL FEQGAP
ILDB CH,BP
FFINDS: MOVEI A,BAKTAB ;HERE FOR EITHER FWD OR BACKWD SCAN, TO SEE IF CHAR IS IN
FFIND1: CAMN A,J ;THE STRING.
JRST [ TRNN FF,FRCLN ;NO => FOR NON-COLON, WE HAVE FOUND END OF RANGE.
RET
JRST FFIND2]
CAME CH,(A)
AOJA A,FFIND1
TRNE FF,FRCLN ;YES => FOR @:F^B WE HAVE FOUND THE END OF THE RANGE.
RET
FFIND2: JUMPL C,FFINDD ;NOT AT END => MOVE TO NEXT CHARACTER.
AOS IN,PT
JRST FFINDC
FFINDB: IBP BP ;MOVE BACKWARRD, THE FIRST TIME.
CAIA
FFINDD: SOS IN,PT ;MOVE BACKWARD AGAIN.
CAMN IN,OUT
RET
CAMN IN,GPT
CALL DWNGAP
DBP7 BP
LDB CH,BP
JRST FFINDS
;READ IN A STRING ARG, AND SAVE IT 1 CHAR PER WORD IN BAKTAB.
;LEAVE J -> LAST WORD USED IN BAKTAB + 1. USED BY @F^B.
;CLOBBERS A, CH.
INDARG: MOVEI J,BAKTAB
INDA1: CALL RCH
SKIPE SQUOTP
JRST INDA2
CAIN CH,ALTMOD
RET
INDA2: CAIN J,BAKTAB+LTABS
TYPRE [STL]
HRRZM CH,(J)
AOJA J,INDA1
SUBTTL WORD AND LIST PARSING COMMANDS
FWCMD: MOVEI BP,WORDSP
JRST .+2
FLCMD: MOVEI BP,LISTSP
FLCMD1: ARGDFL Z
CALL IMMQIT ;ALLOW IMMEDIATE QUITTING IN CASE WE HAVE FAR TO SEARCH.
SAVE PT
SETZM SEXPFL
CALL (BP)
MOVE E,PT
REST C
MOVEM C,PT
CAMGE C,E
EXCH C,E
SUB C,BEG
SUB E,BEG
MOVEM E,SARG
MOVE A,C
TRZ FF,FRUPRW+FRCLN
TRO FF,FRARG2
SETZM IMQUIT ;STOP ALLOWING IMMEDIATE QUITTING.
JRST POPJ1
FUCMD: JSP BP,FLCMD1
SETZM DOWNF
MOVM D,C
MOVNS D
FUCMD1: JUMPE D,CPOPJ
HLRES C
JRST LISTSQ
FDCMD: JSP BP,FLCMD1
SETOM DOWNF
MOVM D,C
JRST FUCMD1
;THIS ROUTINE TAKES ARG IN C, AND DOES <ARG>FWL.
;FS INSLEN IS SET TO LENGTH OF LAST WORD OR INTER-WORD-SPACE SEEN
;(NOTE IF YOU START WITHIN A WORD, FS INSLEN$ MIGHT NOT BE WHAT YOU WANT).
;IF SEXPFL IS SET, ASSUMES WAS REACHED FROM @FL, AND GOES BACK THERE
;AFTER FINDING ONE WORD.
;THE UPARROW FLAG CAUSES SCANNING TO BE FOR LISP ATOMS INSTEAD OF WORDS.
WORDSP: CALL SKNBCP ;INITIALIZE SO WE CAN CALL SKNBRK.
TRNE FF,FRUPRW
IBP SKNBPT ;FOR LISP, USE 2ND CHAR OF DISPATCH ENTRY RATHER THAN 1ST.
JUMPL C,WBACK
JUMPE C,CPOPJ
CALL LFINIT ;SET UP E, IN, BP.
WFVBA1: SKIPE SEXPFL ;HERE TO START WORD-GAP, TREATING LAST CHAR SEEN AS PART OF PREV. WORD.
JRST LFLOOP
MOVE B,E ;SAVE E IN B EVERY SO OFTEN. E-B WILL BE VALUE OF INSLEN.
SOSA B
WFSBEG: MOVE B,E ;LIKE WFVBA1, BUT COUNT LAST TERMINATOR AS PART OF THIS GAP.
SKIPE SEXPFL
JRST LFDSP
WFSLUP: SOJLE E,WFSEOB
CAMN E,IN ;IF WE'VE REACHED THE GAP,
CALL FEQGAP ;MAKE BP POINT ABOVE IT.
ILDB A,BP
LDB A,SKNBPT
CAIE A,";
CAIN A,"A
JRST WFSEND
CAIN A,"+
JRST WFSEND
CAIE A,"/
CAIN A,"|
JRST WFSEND
JRST WFSLUP
WFSEND: TRNE FF,FRCLN
WFVBA2: SOJLE C,WFDONC
MOVE B,E
CAIN A,"|
JRST WFVBAR ;WIN IN CASES LIKE |FOO||BAR|
JRST WFWDSP ;NOW PROCESS CHAR THAT STARTS THE WORD AS IF FOUND IT INSIDE WORD
;HERE WHEN A :FW FINDS START OF WORD AND THINK'S IT IS FINISHED.
WFDONC: TRNN FF,FRUPRW ;IF IT WAS AN @:FW, AND LAST CHAR WAS A ', BACK UP OVER IT.
JRST WFDONE
CAMN E,IN
CALL DWNGAP
AOS E ;AND KEEP BACKING UP PAST ALL '-TYPE CHARS.
DBP7 BP
LDB A,BP
LDB A,SKNBPT
CAIN A,"'
JRST WFDONC
SOJA E,WFDONE
WFWLUP: SOJLE E,WFWEOB
CAMN E,IN ;IF WE'VE REACHED THE GAP,
CALL FEQGAP ;MAKE BP POINT ABOVE IT.
ILDB A,BP
LDB A,SKNBPT
WFWDSP: CAIE A,";
CAIN A,"A
JRST WFWLUP
CAIN A,"+
JRST WFWLUP
CAIN A,"' ;' CHARS CAN CONTINUE A WORD, BUT NOT START ONE.
JRST WFWLUP
CAIN A,"/
JRST WFSLSH
CAIN A,"| ;| INSIDE WORD IS CASE OF FOO|BAR|, WHICH IS 2 WORDS,
JRST [ TRNE FF,FRCLN ;SO END THIS WORD AND IMMEDIATELY START ANOTHER.
MOVE B,E
JRST WFVBA2]
WFWEND: TRNE FF,FRCLN
JRST WFSBEG
SOJG C,WFSBEG
WFDONE: SUB B,E
SUB E,ZV
MOVNS E
JRST WORD12
WFSEOB: TRC FF,FRCLN ;WENT FWD PAST Z, BETWEEN WORDS.
WFWEOB: SOJG C,TYPNIB ;WENT FWD PAST Z, IN MIDDLE OF WORD.
TRNE FF,FRCLN
JRST TYPNIB
JRST WFDONE
WFSLSH: CALL LFSLSH ;HANDLE A SLASH-CHARACTER GOING FORWARD.
JRST WFWLUP
WFVBAR: CALL LFVBAR ;VERTICAL BAR: SKIP TO MATCHING ONE.
TRNN FF,FRCLN ;IF TIME TO STOP MOVING, MAKE SURE CLOSING VBAR
SOJLE C,[SOJA E,WFDONE] ;COUNTS AS PART OF WORD, NOT PART OF GAP.
;IF MUST KEEP GOING, DO SO, BUT DON'T COUNT
JRST WFVBA1 ;THE VBAR AS PART OF THE GAP THAT'S STARTING.
;MOVE BACKWARDS OVER WORDS.
WBACK: MOVMS C
CALL LBINIT ;SET UP BP, E, IN.
WBVBA1: SKIPE SEXPFL
JRST LBLOOP
MOVE B,E
SOSA B
WBSBEG: MOVE B,E
SKIPE SEXPFL
JRST LBDSP
WBSLUP: SOJL E,WBSEOB
CAMN E,IN ;IF WE'VE REACHED THE GAP,
CALL DWNGAP ;MAKE BP POINT BELOW IT.
DBP7 BP
LDB A,BP
LDB A,SKNBPT
CAIE A,"A
CAIN A,"|
JRST WBSEND
CAIE A,"+
CAIN A,";
JRST WBSEND
CAIE A,"/
JRST WBSLUP
WBSLSH: SAVE E ;FOUND A SLASH GOING BACKWARD.
SAVE BP ;IF IT'S SLASHED, IT ENDS A WORD; ELSE FOLLOWING CHAR
CALL REALP ;IS SLASHED AND ENDS THE WORD.
JFCL ;BIT 1.1 OF CH IS 1 IF SLASH IS SLASHED.
REST BP
REST E
TRNE CH,1
JRST WBSEND
IBP BP
AOJ E,
WBSEND: TRNE FF,FRCLN
WBVBA2: SOJLE C,WBDONE
MOVE B,E
CAIN A,"|
JRST WBVBAR
JRST WBWDSP
WBWLUP: SOJL E,WBWEOB
CAMN E,IN ;IF WE'VE REACHED THE GAP,
CALL DWNGAP ;MAKE BP POINT BELOW IT.
DBP7 BP
LDB A,BP
LDB A,SKNBPT
WBWDSP: CAIE A,";
CAIN A,"A
JRST WBWLUP
CAIN A,"+
JRST WBWLUP
CAIN A,"|
JRST [ TRNE FF,FRCLN
MOVE B,E
JRST WBVBA2]
CAIE A,"'
CAIN A,"/
JRST WBWLUP
SAVE BP
SAVE E
CALL REALP
JFCL
REST E
REST BP
TRNE CH,1
JRST WBWLUP
WBWEND: TRNE FF,FRCLN
JRST WBSBEG
SOJG C,WBSBEG
WBDONE: SUBM E,B
AOJ E,
ADD E,BEGV
WORD12: MOVEM E,PT
MOVEM B,INSLEN
TRZ FF,FRCLN+FRUPRW
RET
WBSEOB: TRC FF,FRCLN
WBWEOB: SOJG C,TYPNIB
TRNE FF,FRCLN
JRST TYPNIB
JRST WBDONE
WBVBAR: CALL LBVBAR ;MOVE BACK OVER A VERTICAL BAR GROUPING.
WBVBA4: JUMPE E,WBVBA3 ;THEN BACK OVER ALL ' CHARACTERS BEFORE IT.
SAVE E
SAVE BP
SOJ E,
CAMN E,IN ;IF WE'VE REACHED THE GAP,
CALL DWNGAP ;MAKE BP POINT BELOW IT.
DBP7 BP
LDB A,BP
LDB A,SKNBPT
CAIN A,"'
JRST [ SUB P,[2,,2]
JRST WBVBA4]
REST BP
REST E
WBVBA3: TRNN FF,FRCLN ;IF IT'S TIME TO STOP MOVING, SAY WE STOPPED AFTER PASSING THE
SOJLE C,[SOJA E,WBDONE] ;VBAR, INSTEAD OF BEFORE, AS WE WOULD STOP AT A SPACE.
JRST WBVBA1 ;IF KEEP MOVING, DON'T INCLUDE THE VBAR IN THE NEW GAP.
LISTSP: TRNE FF,FRUPRW
SETOM SEXPFL
SETZB D,DOWNF
JUMPE C,CPOPJ
LISTSQ: CALL SKNBCP ;SET UP SKNBPT FROM ..D
IBP SKNBPT
JUMPL C,LBACK
CALL LFINIT ;SET UP BP, E, IN.
LFLOOP: SOJLE E,LFEOB ;AFTER THIS INSN E HAS # CHARS LEFT TO SCAN.
CAMN E,IN ;IF WE'RE ABOUT TO ILDB INTO THE GAP, CROSS IT:
CALL FEQGAP ;(BP <- BP TO ILDB 1ST CHAR AFTER GAP).
ILDB A,BP
LDB A,SKNBPT ;GET DISPATCH ENTRY OF THIS CHARACTER.
LFDSP: CAIN A,"/
JRST [ TRNE FF,FRUPRW ;FOR @FL, REMEMBER SLASH STARTS AN ATOM.
JUMPE D,WFSEND
CALL LFSLSH
JRST LFLOOP]
CAIN A,"|
JRST [ TRNE FF,FRUPRW
JUMPE D,WFSEND
CALL LFVBAR
JRST LFLOOP]
CAIE A,";
CAIN A,"A ;SEMICOLON AND LETTERS START ATOMS.
TRNN FF,FRUPRW
JRST LFFOO1
JUMPE D,WFSEND
LFFOO1: CAIN A,"(
JRST LFLPAR
CAIE A,")
JRST LFLOOP
SKIPE DOWNF
AOJA D,LFLOOP
AOJL D,LFLOOP
SETZ D, ;MAKE SURE 2FLL SAME AS FLL FLL.
SOJG C,LFLOOP
LFDONE: SUB E,ZV
TRC FF,FRCLN
JRST LISTX
LFEOB: JUMPL D,[TYPRE [UBP]] ;UNBALANCED PARENTHESES
TYPNIB: TYPRE [NIB]
LFSLSH: SOJLE E,TYPUEB ;HANDLE "/" GOING FORWARD.
CAMN E,IN ;IF WE'VE REACHED THE GAP, MAKE BP CROSS IT.
CALL FEQGAP
IBP BP
RET
TYPUEB: TYPRE [UEB]
LFLPAR: TRNE FF,FRCLN ;:FL => STOP BEFORE ( INSTEAD OF AFTER IT AS FOR FD.
JUMPE D,[SOJE C,LFCDON ;ALSO, :FL BACKS OVER ''S WHILE FD DOESN'T.
AOJA C,.+1]
SKIPN DOWNF
SOJA D,LFLOOP
SOJG D,LFLOOP
JRST LFDONE
LFCDON: MOVNS E
ADD E,ZV ;TURN INTO CHAR ADDR OF THE (.
TRZ FF,FRCLN ;DON'T LET LISTX MUNG IT.
TRNE FF,FRUPRW ;FOR @:FL,
LFCDO1: CAMG E,BEGV ;SCAN BACKWARD PAST ANY QUOTES BEFORE THE (.
JRST LISTX
DBP7 BP
LDB A,BP
LDB A,SKNBPT
CAIN A,"'
SOJA E,LFCDO1
JRST LISTX
LFVBAR: SOJLE E,TYPUEB ;HANDLE "|" GOING FORWARD.
CAMN E,IN
CALL FEQGAP ;WHEN REACH GAP, MOVE OVER IT.
ILDB A,BP
LDB A,SKNBPT ;DECODE NEXT CHARACTER.
CAIN A,"/
JRST [ CALL LFSLSH ;SLASH => DON'T CHECK NEXT CHAR FOR BEING A "|".
JRST LFVBAR]
CAIE A,"|
JRST LFVBAR ;FIRST UNSLASHIFIED "|" ENDS THE STRING.
RET
;MOVE BACKWARD OVER LISTS.
LBACK: MOVMS C
CALL LBINIT ;SET UP BP, E, IN.
LBLOOP: SOJL E,LFEOB
CAMN E,IN ;IF ABOUT TO DLDB INTO LAST CHAR OF GAP,
CALL DWNGAP ;MAKE BP -> LOWEST CHAR. OF GAP.
DBP7 BP
LBDSP: LDB A,BP
LDB A,SKNBPT
CAIN A,"|
JRST [ TRNE FF,FRUPRW
JUMPE D,WBSEND
CALL LBVBAR
JRST LBLOOP]
TRNN FF,FRUPRW ;IF @FL, NOTE THAT LETTERS AND SLASH START ATOMS
JRST LBFOO1
CAIN A,"A
JUMPE D,WBSEND
CAIN A,"/ ;FOR SLASH, THE CHAR AFTER IT (ALREADY SCANNED)
JUMPE D,WBSLSH ;IS ALSO PART OF THE ATOM.
LBFOO1: CAIN A,")
JRST LBRPAR
CAIE A,"(
JRST LBLOOP
CALL REALP
JRST LBQOTD
SKIPE DOWNF
AOJA D,LBLOOP
AOJL D,LBLOOP
SETZ D,
SOJG C,LBLOOP
TRNN FF,FRUPRW ;FOUND MATCHING OPENPAREN. NOW, IF PASSING SEXPS,
JRST LBDONE
LBQOT1: MOVE B,E ;SKIP OVER ANY NO-SLASHIFIED '-LIKE CHARACTERS
SOJL E,LBQOT2 ;THAT PRECEDE THE OPENPAREN.
CAMN E,IN
CALL DWNGAP
DBP7 BP
LDB A,BP
LDB A,SKNBPT
CAIN A,"'
CALL REALP
LBQOT2: SKIPA E,B
JRST LBQOT1
LBDONE: ADD E,BEGV
LISTX: MOVMM E,PT
TRZE FF,FRCLN
AOS PT
POPJ P,
LBVBAR: CALL REALP ;HANDLE "|" GOING BACKWARDS.
RET
LBVBLP: SOJL E,TYPUEB
CAMN E,IN
CALL DWNGAP
DBP7 BP
LDB A,BP
LDB A,SKNBPT
CAIN A,"|
CALL REALP
JRST LBVBLP
RET
LBRPAR: CALL REALP ;HANDLE ")", MOVING BACKWARD.
JRST LBQOTD
TRNE FF,FRCLN
JUMPE D,[SOJE C,LBDONE
AOJA C,.+1]
SKIPN DOWNF
SOJA D,LBLOOP
SOJG D,LBLOOP
JRST LBDONE
LBQOTD: MOVEI A,"A ;SLASHIFIED PAREN HAS "ALPHABETIC" SYNTAX
TRNE FF,FRUPRW ;AND CAN START (END?) AN ATOM.
JUMPE D,WBSEND
JRST LBLOOP
;INITIALIZATION AND AUXILIARY ROUTINES FOR FW AND FL.
;SET UP BP, E, IN FOR GOING FORWARD.
LFINIT: MOVE BP,PT
CAML BP,GPT
ADD BP,EXTRAC ;GET REAL CHAR ADDR OF CHAR AFTER PT.
CALL GETIBP
MOVE IN,ZV
SUB IN,GPT ;THIS IS WHAT E WILL HAVE WHEN GAP IS REACHED.
MOVE E,ZV
SUB E,PT
AOJA E,CPOPJ
;BP GETS A B.P. TO THE 1ST CHARACTER OF THE GAP, TO DLDB INTO THE REGION
;BELOW THE GAP.
DWNGAP: MOVE BP,GPT
JRST GETBP
;SET UP BP, E, IN FOR GOING BACKWARD.
LBINIT: MOVE BP,PT
CAMLE BP,GPT ;BP GETS REAL CHAR ADDR +1 OF CHAR BEFORE PT.
ADD BP,EXTRAC
CALL GETBP ;BP SET UP FOR DLDB.
MOVE E,PT
SUB E,BEGV
MOVE IN,GPT ;IN USED FOR DETECTING THAT GAP IS REACHED.
SUB IN,BEGV ;CHECK: IF PT = GPT NOW, E WILL = IN THE FIRST TIME THRU.
SOJA IN,CPOPJ
;DURING BACKWARD SCAN, CHECK WHETHER THE CHAR JUST REACHED WAS SLASHIFIED.
;MOVES BP AND E BACK OVER THE SLASHES, LEAVES THEM AS IF 1ST OF THE SLASHES
;WAS JUST GOBBLED. IF # SLASHES IS EVEN (CHAR IS NOT SLASHIFIED),
;BIT 1.1 OF CH WILL BE 0, AND REALP WILL SKIP.
REALP: SETZI CH,
REALP3: SOJL E,REALP1
CAMN IN,E
CALL DWNGAP
DBP7 BP
LDB A,BP
LDB A,SKNBPT
CAIN A,"/
AOJA CH,REALP3
IBP BP
REALP1: AOJ E,
TRNN CH,1
AOS (P)
POPJ P,
;F^F IS TH HAIRY FORWARD-ONLY LIST PARSER.
;IT TAKES A "STATE" WHICH INCLUDES THE PAREN DEPTH AS AN ARGUMENT,
;PARSES FROM POINT TO A SPECIFIED PLACE, AND RETURNS THE UPDATED STATE.
;DO <OLD STATE>,<PLACE TO STOP PARSING>F^F AND IT RETURNS THE NEW STATE.
;THE STATE'S RH IS TH PAREN DEPTH. THE LH IS BITS, AS FOLLOWS:
; 100,, => INSIDE A COMMENT.
; 4,, => INSIDE VERTICAL BARS.
; 2,, => INSIDE OR RIGHT AFTER AN ATOM.
; 1,, => SLASHIFIED.
;WE ARE INSIDE (AS OPPOSED TO ADJACENT TO) AN ATOM IF 4,, OR 1,, IS SET,
;OR IF 2,, IS SET AND THH NEXT CHARACTER HAS A OR / SYNTAX.
;WHEN WE RETURN, Q..0 GETS THE ADDRESS AFTER THE LAST OPEN-| OR ; SEEN;
;Q..1 GETS THE ADDRESS OF THE LAST UNMATCHED (, OR -1;
;Q..2 GETS THE ADDRESS OF THE START OF THH LAST SEXP, OR -1.
;SCANNING STOPS WHEN IT REACHES THE SPECIFIED ADDRESS,
; OR WHEN THE PAREN DEPTH REACHES 0.
;FOR :F^F, SCAN ALSO STOPS WHEN AFTER ANY ATOM-START CHARACTER.
FCTLF: TRZE FF,FRARG
TRZN FF,FRARG2
TYPRE [WNA] ;WE MUST HAVE 2 ARGS. AND DISCARD THEM.
SETZ OUT,
TRZE FF,FRCLN ;OUT GETS BITS OF STATE WHICH ARE TERMINATING CONDITIONS.
MOVSI OUT,7
ADD C,BEG
CALL CHK ;CALCULATE AND VALIDATE ADDRESS TO STOP SCANNING AT.
CALL SKNBCP
IBP SKNBPT ;SKNBPT IS B.P. TO LDB LISP SYNTAX OF CHAR IN CH.
MOVEI TT,CH ;PUT "CH" IN INDEX FIELD TO MAKE THAT TRUE.
DPB TT,[220600,,SKNBPT]
SKIPGE A,E ;KEEP THE STATE IN A. NEGATIVE NUMBER AS ARG
ANDI A,-1 ;MEANS A NEGATIVE PAREN DEPTH, WITH STATE BITS 0.
MOVE CH,QRB..
SETOM .Q..0(CH) ;SO FAR WE HAVE NOT SEEN ANY ( OR |.
MOVE IN,PT
CALL GETIBI ;IN GETS SCAN POINT AS VIRT ADDR, BP GETS BP TO ILDB.
CAMLE IN,C
TYPRE [2%1]
MOVE Q,P
SETZB D,B ;D HAS ADDR+1 OF START OF SEXP THHT ENDED LAST, OR 0.
;B HAS STATE BEFORE LAST CHARACTER SCANNED.
FCTLFL: TLNN B,7 ;IF LAST CHAR WASN'T IN OR AFTER AN ATOM,
TLNN A,7 ;AND THIS ONE WAS,
CAIA ;THEN WE HAVE JUST STARTED AN ATOM,
MOVE D,IN ;SO REMEMBER . AS ADDR+1 OF LAST SEXP'S START.
MOVE B,A
TDNN A,OUT ;STOP CONDITION MET OR REACHED END OF RANGE =>
CAMN IN,C ;RETURN, SETTING APPRO. Q-REGS.
JRST FCTLFX
CAMN IN,GPT
CALL FEQGAP ;WHEN WE COME TO TH GAP, MOVE TH B.P. OVER IT.
AOS IN,PT
ILDB CH,BP
TLZE A,1 ;PREVIOUS CHARACTER WAS SLASH => DON'T CHECK THIS ONE.
JRST FCTLFL
TLZ A,2
LDB CH,SKNBPT
TLNE A,100 ;INSIDE A COMMENT, ONLY CR IS INTERESTING.
JRST [ CAIN CH,^M
TLZ A,100
JRST FCTLFL]
CAIN CH,"/
JRST [ TLO A,3
JRST FCTLFL]
CAIN CH,"|
JRST [ MOVE CH,IN ;| => COMPLEMENT IN-|-NESS,
SUB CH,BEG ;AND IF THIS IS ENTERING A PAIR,
TLCN A,4 ; REMEMBER THE ADDRESS IN Q..0.
MOVEM CH,@QRB..
JRST FCTLFL]
TLNE A,4
JRST FCTLFL ;WITHIN VERTICAL BARS => ONLY | AND / ARE SPECIAL.
CAIN CH,";
JRST [ MOVE CH,IN ;ELSE ; STARTS A COMMENT, AND REMEMBER ITS ADDRESS.
SUB CH,BEG
MOVEM CH,@QRB..
TLO A,100
JRST FCTLFL]
CAIN CH,"A
TLO A,2
CAIN CH,"(
JRST [ HRRI A,1(A) ;( => PUSH ITS ADDRESS+1 SO WE CAN
PUSH P,IN ;FIND THE LAST UNMATCHED ONE.
JRST FCTLF1] ;ALSO INCREMENT THE DEPTH COUNTER.
CAIE CH,")
JRST FCTLFL
CAME Q,P ;) => POP ADDR+1 OF THE MATCHING (, IF ANY.
POP P,D ;IT BECOMES THE ADDR+1 OF THE LAST SEXP TO START.
HRRI A,-1(A) ;DECREMENT THE DEPTH.
FCTLF1: TRNE A,-1 ;IF THE DEPTH EVER BECOMES 0 AFTER A PAREN, EXIT.
JRST FCTLFL
FCTLFX: CAME Q,P ;EXIT: GET ADDRESS OF LAST UNMATCHED (,
SOSA IN,(P) ;OR -1 IF THERE IS NONE.
SKIPA IN,[-1]
SUB IN,BEG
MOVE CH,QRB..
MOVEM IN,.Q..1(CH) ;STORE THAT IN Q..1
SOSLE D
SUB D,BEG ;TURN D INTO REL CHAR ADDR OF
MOVEM D,.Q..2(CH) ;THE START OF THE LAST SEXP. PUT IN Q..2
MOVE P,Q ;FLUSH SAVED ( ADDRESSES FROM THE STACK.
JRST POPJ1 ;RETURN THE NEW STATE, WHICH IS IN A.
SUBTTL MISCELANEOUS F- COMMANDS
;FX<Q> - PUT TEXT INTO <Q> AND DELETE IT. FX* RETURNS THE TEXT.
;AC D HAS # CHARS BUFFER WAS MOVED (BY CREATION OF THE STRING)
FXCMD: CALL QREGVS ;THIS CAN MAKE US SKIP!
CALL GETANU ;TAKES ARGS LIKE X, K, ETC.
SKIPA
FXCMD2: SETZ B, ;HERE WITH CH POINTING AT QREG, ASSUMED NOT IN A QVECTOR.
SAVE C
SAVE E ;REMEMBER BOTH ON PDL.
SAVE BEG ;X10 MAY MOVE BUFFER, MUST KNOW HOW MUCH.
CALL X12 ;GO PUT IN QREG (WHICH MIGHT BE AC A - SEE QREGVS)
REST D
SUB D,BEG ;-<# CHARS BUFFER MOVED UP>
REST E
REST C ;GET THE ENDS BACK,
MOVNS D
ADD E,D ;RELOCATE REMEMBERED PTRS.
ADD C,D
MOVEM C,PT
JRST DELET1
FTYI: CALL DISMDI ;UPDATE MODE DISPLAY (Q..J) IF NEC.
SKIPL UNRCHC
JRST FTYI1
TTYACT ;MAKE SURE NEXT CHARACTER ACTIVATES - UNLESS WE ALREADY HAVE IT.
FTYI1: CALL TYI
TRZE FF,FRCLN ;:FI READS CHAR AND DOESN'T GOBBLE.
MOVEM CH,UNRCHC
TRZN FF,FRUPRW ;@FI RETURNS UNNORMALIZED CHARACTER.
CALL TYINRM ;NORMAL FI RETURNS NORMAILZED CHARACTER.
MOVE A,CH
JRST POPJ1
CNTRUP: CALL RCH ;^^ - RETURN ASCII FOR NEXT CHAR IN CMD STRING. [
MOVEI A,(CH) ;DISCARD LH, WHICH IS NONZERO FOR ^]^Q'D CHAR.
JRST POPJ1
;? COMMAND, COMPLEMENT TRACE MODE. :? TURNS OFF TRACE MODE.
QUESTN: TRNE FF,FRCLN
TRZA FF,FRTRACE
TRC FF,FRTRACE
QUEST1: MOVSI A,(JRST)
TRNN FF,FRTRACE
MOVSI A,(RET)
HRRI A,TYOS
MOVEM A,TRACS
POPJ P,
FCTLAT: CALL GETARG ;F^@ - TAKES RANGE OF BUFFER,
JFCL
CAMG C,E ;RETURNS 2 ARGS DELIMITING THAT RANGE
EXCH C,E ;IN NUMERIC ORDER. 2,1F^@ GIVES 1,2.
MOVE B,E
MOVE A,C
ANDCMI FF,FRARG+FRARG2
JRST HOLE0
;F*<STRING>$ -- NO-OP.
;[ ;MAINLY USEFUL FOR F*^]^X$
FNOOP: JSP B,RDALTC
POPJ P,
JRST FNOOP
;READ 1 CHAR OF STRING ARG, TURNING UNQUOTED DOLLARSIGNS TO ALTMODES.
;AT END OF ARG, FAIL TO SKIP.
RDALTC: PUSHJ P,RCH
SKIPE SQUOTP
JRST 1(B)
CAIN CH,ALTMOD
JRST (B)
CAIN CH,"$
MOVEI CH,ALTMOD
JRST 1(B)
;^V WITH ARG -- PUSH ARGUMENT ON RING BUFFER OF PT. RETURNS NO VALUE.
;NORMALLY, DOESN'T PUSH IF ARG SAME AS CURRENT TOP. :^V PUSHES IN ANY CASE.
FSPSPT: MOVE E,FSPSPP ;GET RING BUFFER POINTER.
LDB CH,E ;GET LAST VALUE PUSHED.
TRZE FF,FRCLN ;UNLESS THIS IS :^V,
JRST FSPSP1
CAMN C,CH
RET ;DON'T PUSH THE SAME THING TWICE IN A ROW.
FSPSP1: CAMN E,[4400,,FSPSPB+FSPSPL-1]
SUBI E,FSPSPL ;AT END, RING AROUND TO BEGINNING.
IDPB C,E
MOVEM E,FSPSPP
RET
;^V COMMAND -- WITHOUT ARG, POP TOP OF RING BUFFER OF PT INTO PT;
;THEN RETURN WHAT REMAINS ON TOP OF RING BUFFER (IF THAT VALUE IS
;PUT IN Q..I, THE TOP-LEVEL WILL AVOID PUSHING WHEN IT IS NEXT ENTERED).
;:^V RETURNS VALUE ON TOP OF RING BUFFER.
;^V WITH ARG PUSHES - SEE ABOVE.
CTLV: TRNE FF,FRARG
JRST FSPSPT
POPPT: MOVE E,FSPSPP
MOVE A,(E) ;GET LAST THING PUSHED.
TRZE FF,FRCLN
JRST POPJ1 ;:^V JUST RETURNS VALUE ON TOP OF RING BUFFER.
ADD A,BEG ;PREPARE TO SET PT FROM IT.
SUBI E,1 ;DECREMENT THE RING BUFFER POINTER.
CAMN E,[4400,,FSPSPB-1]
ADDI E,FSPSPL
MOVEM E,FSPSPP
MOVE C,A ;TAKE THE VALUE JUST POPPED.
CALL CHK ;ERR OUT IF IT ISN'T INSIDE THE BUFFER.
MOVEM A,PT ;JUMP THERE IF IT IS.
MOVE A,(E) ;RETURN WHAT IS NOW AT THE TOP.
JRST POPJ1
;<N>^Z -- INSERT <N> RANDOM LETTERS BEFORE PT.
;^Z WITHOUT ARG -- RETURN A RANDOM NUMBER.
RANDOM: ARGDFL
JUMPE C,RNDNUM
JUMPLE C,CPOPJ
CALL SLPGET ;INSERT C(C) CHARS, RET. BP. IN BP.
RNDLUP: MOVSI A,123467
FMPB A,RDMNMS
IDIVI A,26.
MOVEI CH,"A(B)
IDPB CH,BP
SOJG C,RNDLUP
POPJ P,
RNDNUM: MOVSI A,132476
FMPB A,RDMNMS
TLZ A,400000
JRST POPJ1
SUBTTL COMMUNICATION WITH SUPERIOR JOB
FSEXI1: TLZ FF,FLDIRDPY ;COME HERE TO HANDLE ^C TYPED AT TECO COMMAND READER.
MOVEI C,100000
FSEXIT: MOVEI B,BEG .SEE CIRC
IFN ITS,.BREAK 16,(C) ;FS EXIT
IFN TNX,JRST .EXIT
RET
SUPCMD: MOVE C,SUPARG ;JUMP HERE IF SUPERIOR STARTS TECO AT BFR BLOCK + 7.
MOVEM C,NUM ;FETCH THE ARG IN BFR BLOCK + 8, AND MAKE IT CURRENT ARGUMENT.
TRO FF,FRARG
SKIPE A,SUPHND ;IF TECO MACRO HANDLER SUPPLIED, RUN IT GIVING IT
JRST MAC5 ;THE ARG OUR SUPERIOR GAVE.
CALL GAPSLP
SKIPLE C ;OTHERWISE, IF ARG IS POSITIVE INSURE AT LEAST THAT MUCH GAP.
CALL SLPGET
MOVEI C,500000 ;DO AN $X RETURN IN CASE $X'ING FROM DDT.
JRST FSEXIT
;^K<STRING>$ -- VALRET <STRING>.
DECDMP: CALL DECDMX ;FORMULATE STRING
MOVEI B,BEG .SEE CIRC
SKIPGE PJATY ;MAKE SURE WE DON'T CLEAR PJATY IF IT WAS ALREADY ON.
TRZ FF,FRUPRW
IFN ITS,.VALUE (A) ;SUPERIOR EXPECTS 2 TO POINT TO BEG
IFN TNX,[
HRLI A,440700
IFN 20X,[
RSCAN ;BEST WAY WE HAVE TO RETURN A STRING TO THE EXEC
TDN
SETZ A,
RSCAN
TDN
]
.ELSE [
MOVE CH,A ;BYTE POINTER TO CHARS TO DO
MOVEI A,.CTTRM
DECDM2: ILDB B,CH
JUMPE B,DECDM3
STI ;STUFF INTO TERMINAL'S INPUT BUFFER
JRST DECDM2
DECDM3:
]
CALL .EXIT
]
TRZE FF,FRUPRW
SETZM PJATY ;@ FLAG => SUPPRESS AUTOMATIC REDISPLAY.
POPJ P,
DECDMX: CALL MEMTOP ;GET ADDR OF 1ST WD ABOVE BFR IN A.
AOS OUT,A
IMULI OUT,5 ;GET CHAR ADDR 1ST CHAR IN THAT WD.
SUB OUT,EXTRAC ;SINCE PUTINC WILL ADD EXTRAC.
JSP B,RDALTC
JRST DECDM1
CALL PUTINC ;STUFF CHARS THERE, ABOVE BUFFER.
JRST RDALTC
DECDM1: SETZ CH, ;AFTER STRING, PUT ^@
CALL PUTINC ;TO TELL DDT IT'S THE END.
SETZM 1(TT) ;ZERO NEXT WD SO DDT WILL STOP FETCHING.
RET
;FZ - MANIPULATE INFERIOR PROCESS
;
; FZ<STRING>$ CREATE FORK, RETURNS FORK INDEX
; TAKES EVERYTHING UP TO THE FIRST SPACE (NOT QUOTED BY ^V) AS
; THE FILE SPECIFICATION (NO DEFAULTS ALLOWED). THE STRING IS
; PLACED IN THE RESCAN BUFFER IN THE SAME FORMAT EXEC USES.
; IE. "FILENAME JCL<CR><LF>".
; 0FZ<STRING>$ "PUSH" USING EXISTING EXEC FORK IF PRESENT. THE STRING IS
; PLACED IN THE RESCAN BUFFER AND THE RESCAN BUFFER IS SET
; FOR READING.
;-1,0FZ<STRING>$ AS ABOVE BUT THE EXISTING EXEC FORK (IF PRESENT) IS KILLED
; FIRST, AND STRING IS INTERPRETED AS FOR AN ORDINARY FORK.
; FZ$ "PUSH" USE EXISTING INFERIOR EXEC FORK IF PRESENT.
; NFZ<STRING>$ RESUME FORK N PLACING THE STRING IN THE RESCAN BUFFER.
; -NFZ$ KILL FORK N
;
; A PRE-COMMA ARGUMENT MAY BE SPECIFIED:
; +VE -- INDICATES THE POSITION IN THE ENTRY VECTOR AT WHICH TO START THE FORK
; -VE -- INDICATES THAT THE RESCAN BUFFER IS TO BE SET UP FOR READ BY .CTTRM
; BEFORE THE SUB FORK IS STARTED. (THE CURRENT LOCATION OR THE PRIMARY
; START ADDRESS IS USED DEPENDING IF THE FORK ALREADY EXISTS OR NOT.)
; A -VE PRE-COMMA ARGUMENT TO AN EXEC FORK IS AN EXCEPTION (SEE ABOVE).
IFN TNX,[
FZCMD: CALL DECDMX ;BUFFER STRING
MOVEM A,FZSTR ; SAVE THE POINTER
HRRO B,A
MOVE A,0(B) ; SEE IF NULL STRING ARG
TLNN A,774000 ;
SETZM FZSTR ; YES SAY NO RESCAN STUFF
GETNM ; GET THE CURRENT NAME SO WE CAN PUT IT BACK LATER
MOVEM A,FZNAM ; AND SAVE IT
TRZE FF,FRARG ;ARG GIVEN?
JRST FZCMD3 ;YES - MORE CHECKING
SKIPN FZSTR ; NO - SEE IF NULL STRING ARG
JRST .PUSH ;YES - DO PUSH
CALL FZSEP ; ELSE - SEPARATE FILE NAME AND RESCAN STUFF
CALL NEWFRK ;CREATE NEW FORK
MOVEM B,RUNFRK ;SAVE FORK INDEX
FZCMD1: CALL SETFRK ;SET FORK TTY STATE
IFN 20X,CALL FZRSCN ; PUT STUFF IN RESCAN BUFFER IF NECESSARY
FZCMD2: CALL GOFRK ;START UP FORK
MOVE A,RUNFRK ;NO - RETURN FORK INDEX
TRZ FF,FRARG2
JRST POPJ1 ;RETURN OK
FZCMD3: SKIPN A,NUM ;EXPLICIT 0?
JRST .PUSH0 ;YES - MAYBE KILL OLD EXEC THEN "PUSH"
JUMPL A,KILFRK ;IF NEGATIVE, THEN KILL FORK
MOVEM A,RUNFRK ;SAVE FORK INDEX
CAILE A,NFKS ;CHECK VALIDITY
TYPRE [AOR]
SKIPN A,FRKTAB-1(A)
TYPRE [ARG]
CALL SETFRK ;SET FORK STATES
IFN 20X,CALL FZRSCN ; PUT STUFF IN RESCAN BUFFER IF NECESSARY
TRNN FF,FRARG2 ; HAVE PRE-COMMA ARG.?
JRST FZCMD6 ; NO, JUST GO START FORK
SKIPL SARG ; IS IT NEGATIVE?
JRST FZCMD4 ; NO, USE IT AS POINTER INTO ENTRY VECT.
IFN 20X,[
SKIPN FZSTR ; IS THERE A STRING IN RESCAN?
JRST FZCMD6 ; NO, JUST START FORK
SAVE A
SETZ A,
RSCAN ; SAY WE WANT TO READ RESCAN STUFF
TDN
REST A
];20X
JRST FZCMD6 ; AND GO START FORK
FZCMD4: SAVE A
SAVE B
MOVE B,SARG ; GET PRE-COMMA ARG.
SFRKV ; TRY AND START THE FORK
REST B
REST A
FZCMD6: SAVE C ; SAVE AC
SAVE A ; SAVE FORK HANDLE
RFSTS ; GET FORK STATUS AND PC
HLRZ C,A ; COPY FORK STATUS
REST A ; RESTORE FORK HANDLE
TRZE C,(RF%FRZ) ; FORK FROZEN?
RFORK ; YES, WARM IT UP
CAIE C,.RFHLT ; HALTED?
CAIN C,.RFFPT
SFORK ; YES, START IT AT PC RETURNED BY RFSTS
REST C ; RESTORE AC
JRST WAITA ;WAIT FOR TERMINATION
; USE RESCAN BUFFER TO COMMUNICATE WITH INFERIOR
; SEPARATE THE FILE NAME AND THE JCL FOR CREATING THE FORK
FZSEP: SKIPN FZSTR ; NOTHING HERE?
RET ; YES, JUST RETURN
SAVE B ; SEPARATE FILE NAME AND RESCAN STUFF
MOVSI A,440700
HRR A,FZSTR ; MAKE A BYTE POINTER TO STRING
FZSEP1: ILDB B,A ; GET A BYTE FROM STRING
CAIN B,26 ; IS IT A QUOTE (^V) CHAR?
JRST FZSEP2 ; YES, SKIP NEXT CHAR.
CAIN B,0 ; IS IT A NULL?
JRST FZSEP3 ; YES, ONLY FILE NAME PRESENT.
CAIN B,40 ; IS IT A SPACE?
JRST FZSEP4 ; YES, THATS THE END OF THE FILE SPEC.
JRST FZSEP1 ; NONE OF THE ABOVE SO LOOP.
FZSEP2: IBP A ; SKIP A CHARACTER
JRST FZSEP1 ; AND LOOP
FZSEP3: SETZM FZSTR+1 ; MARK NO JCL STUFF
JRST FZSEP5 ; AND QUIT
FZSEP4: SETZ B, ; CLEAR OUT SPACE
DPB B,A ; AND REPLACE IT WITH A NULL
MOVEM A,FZSTR+1 ; NEW STARTING BYTE POINTER FOR RESCAN
ILDB B,A ; CHECK IF THERE IS ANY STUFF FOR RSCAN
CAIN B,0 ; IS FIRST BYTE NULL?
SETZM FZSTR+1 ; YES, NO RESCAN STUFF IS THERE
FZSEP5: REST B
RET
; FIX RESCAN STUFF TO CONFORM WITH EXECUTIVE CONVENTION
FZFIX: SKIPN FZSTR+1 ; ANYTHING AT ALL FOR RESCAN?
JRST [ SETZM FZSTR ;NO, CLEAR FLAG
RET]
JSR SAVABC
SAVE D
MOVEI B,(A) ; PUT THE FORK HANDLE IN B
HRRO A,FZSTR
MOVE C,[001000,,000000] ; RETURN FILE NAME
JFNS ; SO GET IT INTO STRING
TRNN FF,FRARG2 ; DO WE HAVE A PRE COMMA ARG?
JRST FZFIXA ; NO, DO THE FIX UP
SKIPL SARG ; IS IT NEGATIVE
JRST FZFIXA ; NO, DO THE FIX UP
SKIPN FZSTR+1 ; ANYTHING TO PUT IN RESCAN
JRST FZFIX3 ; NO, JUST QUIT
MOVSI A,440700 ; MAKE A BYTE POINTER
HRR A,FZSTR ; TO THE START OF BUFFER
JRST FZFIX2 ; MOVE THE STRING TO THE START OF BUFFER
FZFIXA: SKIPE FZSTR+1 ; ANY JCL TO ADD TO LINE?
JRST FZFIX1 ; YES, GO DO IT
MOVEI B,12
IDPB B,A ; PUT IN A ^J
SETZ B,
IDPB B,A ; AND A ZERO BYTE
JRST FZFIX3 ; AND QUIT
FZFIX1: MOVEI B,40
IDPB B,A ; AND PUT IN A SPACE
FZFIX2: ILDB B,FZSTR+1 ; GET A BYTE FROM THE JCL STRING
IDPB B,A ; AND MOVE IT DOWN IN STRING
SKIPLE B ; WAS THAT A NULL?
JRST FZFIX2 ; NO, SO DO IT AGAIN
FZFIX3: SETZM FZSTR+1
REST D
JRST POPCBA
IFN 20X,[
;PUT STRING IN THE RESCAN BUFFER (IF A STRING IS PRESENT)
FZRSCN: SAVE A
SKIPN A,FZSTR ; GET POINTER TO RESCAN STUFF
MOVE A,[440700,,FZSTR ] ; NO, SET UP TO CLEAR RESCAN BUFFER
TLNN A,770700 ; IS IT A BYTE POINTER ALREADY?
HRLI A,440700 ; NO, SO MAKE IT ONE.
RSCAN ; PUT IT IN THE RESCAN BUFFER
TDN
REST A
RET
];20X
;RUN AN EXEC PROCESS
.PUSH0: TRNE FF,FRARG2 ; DO WE HAVE A PRE-COMMA ARGUMENT?
SKIPL SARG ; IS IT NEGATIVE?
JRST .PUSH ; NO, JUST DO A .PUSH
SKIPG A,EXECFK ; HAVE AN EXEC?
JRST .PUSHE
KFORK
IFN 20X\FNX, ERJMP .+1
SETOM EXECFK ;SAY NO EXEC
.PUSHE: CALL FZSEP ;GET FILENAME TO RUN
SKIPN FZSTR ;USE DEFAULT UNLESS THERE WAS STRING THERE
.PUSH:
IFN 20X, HRROI B,[ASCIZ /SYSTEM:EXEC.EXE/]
.ELSE HRROI B,[ASCIZ /<SYSTEM>EXEC.SAV/]
SETZM RUNFRK ;0 - EXEC FORK INDEX
SKIPLE A,EXECFK ;HAVE EXEC?
JRST FZCMD1 ;YES - USE IT
SETZM EXECFK ;FLAG TO SAVE FORK HANDLE
CALL NEWFRK ;CREATE AN EXEC FORK
JRST FZCMD1 ;RUN EXEC AND RETURN
;KILL FORK (INDEX IN A)
KILFRK: MOVN B,A ;GET POSITIVE INDEX
CAILE B,NFKS ;CHECK VALIDITY
TYPRE [AOR]
SKIPN A,FRKTAB-1(B)
TYPRE [ARG]
KFORK ;KILL OFF FORK
IFN 20X\FNX, ERJMP .+1
SETZM FRKTAB-1(B)
CALL FRKTIN ;RESET TTY MODES TO DEFAULTS
RET ;RETURN NO VALUE.
;SET UP TTY MODES FOR RUNNING INFERIOR
SETFRK: SKIPGE PJATY ;DON'T CLEAR THIS IF ALREADY ON
TRZ FF,FRUPRW
SAVE A ;SAVE FORK HANDLE
IFN EXITCL,[
TRNN FF,FRUPRW ;UNLESS DISPLAY WILL BE LEFT ALONE
CALL CLRSCN ;CLEAR THE SCREEN BEFORE STARTING SUB-FORK
];EXITCL
TRNN FF,FRUPRW ;UNLESS DISPLAY WILL BE LEFT ALONE
CALL DPYRST ;RESET TERMINAL (IF DPY)
MOVE C, RUNFRK ;GET THE FORK INDEX
MOVE A,FRKLST(C) ;GET THE SIXBIT NAME TO CALL THE FORK
SETNM ;AND SET THE PROGRAM NAME
MOVEI A,.CTTRM ;CONTROLLING TERMINAL
RFMOD ;SET SAVMOD FOR RETURN
MOVEM B,SAVMOD
RFCOC ;AND SAVE THE CCOC WORDS
MOVEM B,SAVMOD+1
MOVEM C,SAVMOD+2
MOVE C,RUNFRK ;GET THE FORK INDEX
IMULI C,3 ;AND CONVERT TO AN OFFSET
MOVE B,FRKTTY(C) ;RESTORE TTY MODES
SFMOD
STPAR
IFN TEXTIF,[
PUSH P,C ;[wew] IF TEXTI CODE WAS INCLUDED, MUST
MOVE C,ORGWID ;[wew] SET THE PAGE WIDTH BACK TO WHAT
MOVEI B,.MOSLW ;[wew] IT USED TO BE.
MTOPR
POP P,C
];IFN TEXTIF
MOVE B,FRKTTY+1(C) ;COULD BE DMOVE EXCEPT FOR KA10 TYPES
MOVE C,FRKTTY+2(C)
SFCOC
IFN SUMTTF,[
MOVE A,HLDCHR ;RESTORE HOLD CHARACTER
STCHA
];SUMTTF
MOVEI A,.FHJOB ;SETUP TERMINAL INTERUPT WORD
SETO B,
SETZ C,
STIW
MOVEI A,.TICCG ;CTRL-G
DTI ;TURN IT OFF
JRST POPAJ ;RESTORE FORK HANDLE AND EXIT
;START INFERIOR (HANDLE IN A)
GOFRK: SETZ B, ; ASSUME NEGATIVE OR NO PRE-COMMA ARG.
TRNN FF,FRARG2 ; HAVE PRE-COMMA ARG.?
JRST GOFRK1 ; NO, GO CHECK FOR EXEC
SKIPGE SARG ; IS IT POSITIVE?
JRST GOFRK2 ; NO, SAY WE WANT RESCAN READ
MOVE B,SARG ; YES, SET ENTRY IN STARTING VECTOR
GOFRK1:
IFN 20X,[
SKIPE FZSTR ; ANYTHING TO READ FROM RSCAN
CAME A,EXECFK ; IS THIS THE EXEC FORK?
JRST GOFRK3 ; NO, START THE FORK
GOFRK2: SAVE A
SETZ A,
RSCAN ; SAY WE WANT THE RESCAN BUFFER READ
TDN
REST A
GOFRK3:
];IFN 20X
.ELSE GOFRK2:
SFRKV ;START INFERIOR
WAITA: WFORK ;WAIT FOR FORK TO TERMINATE
WAITX: ;SPECIAL LABEL FOR TSINT
RETFRK: SAVE A ;SAVE FORK HANDLE
SAVE D
MOVE D,RUNFRK ; GET THE INDEX OF THE FORK WE JUST EXITED
IMULI D,3 ; AND CONVERT TO AN OFFSET
MOVEI A,.CTTRM
RFMOD ; AND READ THE MODES WE FIND NOW
MOVEM B,FRKTTY(D) ; SAVE THEM IN CASE WE WANT FORK AGAIN
RFCOC ; SAME FOR CCOC WORDS
MOVEM B,FRKTTY+1(D)
MOVEM C,FRKTTY+2(D)
REST D
SKIPN B,SAVMOD ; RESTORE TTY MODES IF REQUESTED (WAS IN TSINT)
JRST RETFR2 ; NO
MOVEI A,.CTTRM
SFMOD
IFN TEXTIF, TLZ B,(TT%WID) ;[wew] SET 0 WIDTH
STPAR
MOVE B,SAVMOD+1 ; RESTORE THE CCOC WORDS ON FORK EXIT
MOVE C,SAVMOD+2
SFCOC
SETZM SAVMOD ; SAY NO MODE TO RESTORE
RETFR2: MOVE A,FZNAM ; RESET JOB NAME
SETNM
IFN SUMTTF,[
SETZ A, ; ZERO = OFF
STCHA
SKIPE A
MOVEM A,HLDCHR
];SUMTTF
SETOM PJATY ; SAY WE MESSED UP THE DISPLAY
TRNE FF,FRUPRW ;RES
SETZM PJATY ;@ FLAG => SUPPRESS AUTO REDISPLAY
MOVSI A,.TICCG ;MAKE SURE ^G ASSIGNED ON CHANNEL 0
ATI
CALL DOSTIW ;GET RID OF ANY INTERRUPT CHARACTERS DUE TO INFERIOR
TRZN FF,FRUPRW ; UNLESS DISPLAY NOT TOUCHED
CALL DPYINI ; RE-INIT THOSE TTY'S THAT NEED IT. (VT100 ETC.)
SETZM FZSTR ; CLEAN UP FLAGS AND POINTERS
JRST POPAJ ;RESTORE HANDLE AND EXIT
;CREATE A NEW FORK FOR PROGRAM NAMED BY POINTER IN B
;IF EXECFK IS 0, WE WANT TO CREATE AN EXEC FORK.
;OTHERWISE, WE ALLOCATE AN INDEX AND RETURN IT IN B.
NEWFRK: MOVSI A,(GJ%SHT\GJ%OLD)
GTJFN
JRST OPNER2
MOVEM A,FRKJFN ; SAVE THE JFN FOR MORE STUFF LATER
SAVE A ;SAVE JFN
SKIPE EXECFK ; IS THIS TO BE AN EXEC FORK?
CALL FZFIX ; NO, GO PUT RESCAN JCL IN STANDARD EXEC FORMAT
MOVSI A,(CR%CAP) ;PASS ON CAPABILITIES
CFORK
JRST FRKC3
EXCH A,0(P) ;SAVE FORK HANDLE GET JFN
SKIPN FRKJCL ;WANTS JCL?
JRST NEWFR1
MOVEI B,(A) ;YES, GET JFN
HRROI A,BAKTAB
MOVSI C,001000
JFNS
PUSH P,B ;SAVE JFN AGAIN
MOVEI B,40
IDPB B,A
PUSH P,A ;SAVE STRING POINTER
SKIPL A,FRKJCL ;GET JCL - SHOULD BE A STRING
CAIA
CALL QLGET0 ;GET BYTE POINTER AND SIZE OF STRING
JRST [ POP P,(P) ;NOT A STRING
POP P,A ;JFN
RLJFN
JFCL
POP P,A ;FORK
KFORK
SETZM FRKJCL ;DONT GET IT AGAIN
TYPRE [ARG]]
POP P,A
NEWFR4: ILDB CH,BP
IDPB CH,A
SOJG B,NEWFR4
MOVEI B,12
IDPB B,A
MOVEI B,0
IDPB B,A
HRROI A,BAKTAB ;STICK IN THE JCL
MOVEM A,FZSTR ;TAKING PRECEDENCE
SETZM FRKJCL ;DONT GET IT AGAIN
POP P,A ;NOW GET THE JFN AGAIN
NEWFR1: HRL A,0(P) ;FORK,,JFN
GET ;GET FILE
IFN 20X\FNX, ERJMP FRKC4
REST A ;RESTORE FORK HANDLE
SKIPN EXECFK ;WANT THIS HANDLE?
JRST NEWFRE ;ITS AN EXEC FORK
MOVSI B,-NFKS
SKIPE FRKTAB(B) ;IN USE?
AOBJN B,.-1 ;YES - TRY NEXT
JUMPG B,FRKC5 ;TABLE FULL?
MOVEM A,FRKTAB(B) ;SAVE NEW HANDLE
MOVEI B,1(B) ;RETURN NEW INDEX IN B
CALL FRKTIN ; INIT. TTY MODES FOR A NEW FORK
JSR SAVABC ; SAVE SOME WORKING AC'S
SAVE D ;
SETZ A, ; ZERO THE SUBJOB NAME
MOVEM A,FRKLST(B) ; (IE. SET IT TO BLANKS)
HRRI A,FRKLST(B) ; MAKE A BYTE POINTER TO IT
HRLI A,440600 ; SIX BIT BYTES
HRR B,FZSTR ; AND A BYTE POINTER TO THE START OF THE FILE
HRLI B,440700 ; NAME STRING POINTED TO BY FZSTR
MOVEI D,6 ; MAX OF SIX CHARS IN THE SUBJOB NAME
NEWFR2: ILDB C,B ; GET A BYTE
CAIE C,15 ; IF ITS A CARRAGE RETURN QUIT
SKIPN C ; WAS IT A NULL?
JRST NEWFR3 ; YES, SO QUIT
SUBI C,40 ; MAKE IT SIXBIT
SKIPN C ; IF IT WAS A SPACE WE'RE DONE AS WELL
JRST NEWFR3 ; DONE
ANDI C,77 ; JUST MAKE SURE ITS SIXBIT
IDPB C,A ; PUT IT IN THE SUBJOB NAME
SOJG D,NEWFR2 ; HAVE WE DONE SIX YET, IF NOT LOOP
NEWFR3: REST D ; GET THE STUFF BACK AGAIN
JRST POPCBA
NEWFRE: MOVEM A,EXECFK
SAVE B
SETZ B, ; SET EXEC INDEX
CALL FRKTIN ; AND INITIALIZE TTY MODES FOR NEW EXEC
REST B
RET
FRKTIN: SAVE A
SAVE B
IMULI B,3 ; AND CONVERT TO AN OFFSET
HRRI A,FRKTTY(B) ; GET STARTING ADDRESS IN DESTINATION TABLE
HRLI A,ITTYMD ; GET STARTING ADDRESS IN SOURCE TABLE
BLT A,FRKTTY+2(B) ; AND TRANSFER THE DEFAULT TTY STATUS WORDS
JRST POPBAJ
FRKC3: REST A ;JFN ON STACK
RLJFN ;RELEASE JFN IN A
JFCL
JRST OPNER2
FRKC4: TLZ A,-1 ;JFN
RLJFN
JFCL
REST A ;FORK HANDLE ON STACK
KFORK ;FLUSH FORK
IFN 20X\FNX, ERJMP .+1
JRST OPNER2
FRKC5: KFORK ;KILL OFF FORK
IFN 20X\FNX, ERJMP .+1
MOVEI B,CFRKX3
JRST OPNER4
];TNX (FZ COMMAND)
;FJ -- INSERT THE CMD STRING FROM DDT IN THE BUFFER.
;IF NO STRING, INSERTS NOTHING. STRING WILL USUALLY END WITH CRLF.
FJCL: PUSHJ P,FJCLRD ;READ IN THE COMMAND STRING,
SKIPN BAKTAB
POPJ P, ;NOTHING TO DO IF STRING NULL.
MOVE A,[BP7,,BAKTAB]
MOVEI C, ;COUNT THE CHARS IN E.
FJCL1: ILDB CH,A
JUMPE CH,FJCL2
CAIE CH,^M ;^M AND ^@ END THE STRING.
AOJA C,FJCL1
ADDI C,2 ;^M COUNTS AS 2 CHARS, ^@ AS NONE.
FJCL2: CALL SLPGET ;INSERT C(C) CHARS, BP IN BP FOR IDPB.
MOVE A,[BP7,,BAKTAB]
FJCL3: ILDB CH,A ;COPY THE CHARS INTO THE SPACE.
JUMPE CH,CPOPJ ;STOP BEFORE A ^@.
IDPB CH,BP
CAIE CH,^M ;AFTER ^M, STORE ^J AND DONE.
JRST FJCL3
MOVEI CH,^J
IDPB CH,BP
POPJ P,
;READ THE CMD STRING FROM DDT INTO BAKTAB.
FJCLRD:
IFN TNX,[
IFN 10X\FNX,[
HRROI A,[ASCIZ \DSK\] ;Get/save dev designator for DSK
STDEV
.VALUE ;???
PUSH P,B
MOVEI A,.PRIIN ;Now check charact. of primary input
DVCHR
POP P,B ;Is it a disk file?
CAME A,B
JRST FJCLR6 ;No
MOVEI A,.PRIIN ;Yes - JCL file, get its size
SIZEF
.VALUE
JUMPLE C,FJCLR5 ;If null file, quit
MOVN C,B ;c := neg char count
];10X\FNX
IFN 20X,[
SETZB A,BAKTAB
RSCAN ;GET RSCAN BUFFER
TDN
MOVN C,A ;GET NUMBER OF CHARACTERS IN IT
];20X
MOVE B,[BP7,,BAKTAB]
FJCLR2: JUMPGE C,FJCLR5 ;If no chars rescanned, we have no JCL.
PBIN ;Flush the first word of the rscan line.
CAIL A,"A+40 ;Make it upper case
CAILE A,"Z+40 ;For easy reading later
TRNA
SUBI A,40
IDPB A,B
CAILE A,40 ;Find end of invoking field
AOJA C,FJCLR2
AOJGE C,FJCLR5 ;Reached end already => no JCL for us.
TRZN A,40 ;Is separator?
JRST FJCLR3 ;No, a terminator. Ignore the JCL.
DPB A,B ;Stick in null
MOVE B,BAKTAB ;Look at first word
CAME B,[ASCII/RUN/] ;Should anything more follow?
CAMN B,[ASCII/R/]
JRST FJCLR3 ;R or RUN means ignore the JCL.
MOVEM B,JCLNAM ;Save the name of the program in JCL
MOVE B,BAKTAB+1
TRZ B,177_1 ;Only get 9 characters
MOVEM B,JCLNAM+1
IFN 20X, JRST FJCLR4
IFN 10X\FNX,[
CALL FJCLR4 ;Read rest of JCL
;;; JRST FJCLR
; Now divert primary output back to controlling TTY
FJCLR7: MOVEI A,.FHSLF
MOVE B,[.CTTRM,,.CTTRM]
SPJFN
RET
];10X\FNX
FJCLR3: CALL FJCLR4 ;Ignore the JCL: read it all in,
FJCLR5:
IFN 10X\FNX,[
CALL FJCLR7 ;Reset primary i/o
FJCLR6:
];10X\FNX
SETZM BAKTAB ;but say there was none.
SETZM JCLNAM
RET
FJCLR4:
];TNX
SETZM BAKTAB
MOVE A,[BAKTAB,,BAKTAB+1]
BLT A,BAKTAB+LTABS-2
IFN ITS,[
MOVEM A,BAKTAB+LTABS-1 ;LAST WD NOT 0 TO STOP STORING.
;FIRST, RETURN WITH BAKTAB ZEROED IF THERE IS NO JCL.
.SUSET [.ROPTIO,,A]
TLNN A,OPTCMD ;HAS SUPERIOR SAID IT HAS CMD STRING?
POPJ P, ;NO, RETURN AS IF READ 0 FROM IT.
;THERE IS JCL, SO READ IT INTO BAKTAB.
.BREAK 12,[5,,BAKTAB]
]
IFN TNX,[
MOVEI A,.PRIIN ;READ FROM PRIMARY INPUT
HRROI B,BAKTAB
SIN ;THE REST OF THE RSCAN STRING
];TNX
RET
SUBTTL F=, F~ STRING COMPARISON
;F=<QREG><STRING>$ OR <BUFFER-RANGE>F=<STRING>$
;COMPARES THE STRINGS AND RETURNS A NUMBER WHOSE SIGN IS NEGATIVE
;IF QREG OR BUFFER RANGE IS LESS; POSITIVE, IF GREATER; 0, IF THE
;TWO STRINGS ARE EQUAL.
;IF THE VALUE IS NONZERO, ITS ABS VALUE IS 1 + THE POSITION OF THE FIRST
;DIFFERENCE; I.E., 1 IF THE FIRST CHARACTERS DIFFER.
;A STRING IS GREATER THAN ANY INITIAL SEGMENT OF IT.
;F~ (OR F^) COMPARES SIMILARLY BUT IGNORES CASE DIFFERENCES.
FAPPRX: TRO FF,FRNOT
FEQ: TRNE FF,FRARG\FRCLN
JRST FEQ0 ;NUMERIC ARG => USE BUFFER RANGE.
SAVE FF ;PRESERVE FRNOT OVER QREGX.
CALL QREGX ;ELSE READ NAME OF QREG.
REST FF
CALL QLGET0 ;GET LENGTH IN B, BP TO ILDB IN BP.
TYPRE [QNS]
SETZB D,IN ;THERE'S NO GAP TO SKIP OVER.
AOJA IN,FEQ1
FEQ0: CALL GETANU ;DECODE 1 OR 2 ARGS AS FOR K, T, X ETC.
MOVE D,GPT ;D GETS CHAR ADDR OF START OF GAP.
MOVE B,C ;B GETS # CHARS,
SUB B,E
MOVE BP,E
CAML E,GPT
ADD BP,EXTRAC ;IN CASE RANGE STARTS AFTER GAP.
MOVE IN,BP
CALL GETIBP ;BP GETS BP TO ILDB 1ST CHAR.
FEQ1: SETZ A, ;ORDER OF STRINGS NOT KNOWN YET.
;WHEN ORDER IS DETERMINED, A WILL GET 1 OR -1.
MOVE E,B ;REMEMBER INITIAL VALUE OF B.
SETZM INSBP ;MAKE SURE RCH RELOCATES BP.
MOVEI CH,ALTMOD
TRZE FF,FRUPRW ;UPARROW SAYS USE DELIMITER OTHER THAN ALTMD.
CALL RCH
MOVEM CH,INSDLM ;REMEMBER THE DELIMITER.
TRZ FF,FRARG+FRCLN+FRARG2
;GET THE NEXT CHAR FROM THE STRING ARG.
FEQLUP: CALL RCH ;READ IT.
SKIPE SQUOTP ;IF NOT QUOTED OR DELIM-PROTECTED,
JRST FEQLU1
CAMN CH,INSDLM ;SEE IF IT IS THE DELIMITER.
JRST FEQEND
FEQLU1: JUMPN A,FEQLUP ;INEQUALITY SEEN => JUST SKIPPING TO END OF STRING ARG NOW.
SOJL B,FEQEN1 ;END OF QREG BUT NOT END OF STRING ARG => QREG IS LESS.
CAMN D,IN ;ELSE GET NEXT CHAR OF QREG OR BUFFER.
CALL FEQGAP ;SKIP OVER GAP IF HAVE REACHED IT.
AOS IN
ILDB C,BP
CAIN C,(CH) ;CHARS EQUAL => NO DECISION YET,
JRST FEQLUP ;KEEP LOOKING.
TRNN FF,FRNOT ;NO MATCH => IF F^, TRY IGNORING CASE.
JRST FEQNE
CAIL C,"A+40
CAILE C,"Z+40
CAIA
SUBI C,40
CAIL CH,"A+40
CAILE CH,"Z+40
CAIA
SUBI CH,40
CAMN C,CH
JRST FEQLUP
FEQNE: CAIL C,(CH) ;QREG OR BUFFER GREATER =>
AOJA A,FEQLUP ;RETURN POSITIVE; ELSE NEGATIVE.
FEQEN1: SOJA A,FEQLUP ;EITHER WAY, SKIP OVER REST OF STRING ARG.
FEQEND: SETOM INSBP
JUMPN A,FEQEN2 ;END OF STRING ARG: RETURN ANSWER IF KNOWN.
SOJL B,POPJ1 ;ELSE QREG ENDING NOW TOO => EQUAL.
AOJ A, ;STRING ARG FINISHED, OTHER NOT => STRING ARG IS SMALLER.
FEQEN2: SUB E,B ;INITIAL VALUE OF B - CURRENT
IMUL A,E ;GIVES 1+POSITION OF 1ST DIFFERENCE.
JRST POPJ1
FEQGAP: MOVE BP,GPT ; BP GETS BP TO ILDB 1ST CHAR AFTER GAP.
ADD BP,EXTRAC
JRST GETIBP
SUBTTL CASE CONVERSION
;FC - TAKES ARGS LIKE K, CONVERTS AREA OF BUFFER TO LOWER CASE
;PT GOES BEFORE THE SAME CHARACTER BEFORE AND AFTER.
;@FC CONVERTS TO UPPER CASE.
;<CH>:FC RETURNS <CH>, CONVERTED TO UPPER CASE.
LOWCON: TRZE FF,FRCLN
JRST LOWCO3 ;:FC GOES OFF.
PUSHJ P,GETANU
MOVE IN,E
SUB C,IN
SKIPE READON
TYPRE [RDO]
SETOM MODIFF ;WE ARE ABOUT TO CHANGE THE BUFFER CONTENTS.
SETOM MODIFM
CALL GETIBI ;GET IN BP B.P. TO ILDB CHARS STARTING WHERE IN POINTS.
LOWCO1: SOJL C,CPOPJ
CAMN IN,GPT ;WHEN REACH GAP, MOVE B.P. OVER IT.
CALL FEQGAP
ILDB CH,BP
TRNE FF,FRUPRW
JRST LOWCO5
CAIG CH,"Z
CAIGE CH,"A
JRST LOWCO2
LOWCO6: XORI CH,40
LOWCO2: DPB CH,BP ;PUT CHAR INTO FRONT OF GAP,
AOJA IN,LOWCO1
LOWCO5: CAIG CH,40+"Z ;CONVERTING TO UPPER CASE:
CAIGE CH,40+"A
JRST LOWCO2
JRST LOWCO6 ;LOWER CASE CHARS GET SHIFTED,
LOWCO3: TRZN FF,FRARG
TYPRE [WNA]
MOVE A,C ;HANDLE :FC. TO GET VALUE, START WITH ARG,
TRZ FF,FRUPRW ;DON'T LEAVE @ FLAG ON; DON'T LET ARG INTERFERE WITH VALUE.
CALL QLGET0 ;ARG IS STRING => CONVERT ALL CHARS OF THE STRING.
CAIA
JRST LOWCO4
ANDI C,177
CAIG C,40+"Z
CAIGE C,40+"A
CAIA
XORI A,40
JRST POPJ1
LOWCO4: AOS (P)
MOVE C,B ;ARG IS STRING; MAKE NEW STRING = OLD ONE CONVERTED TO U.C.
MOVE E,BP ;SAVE PTR TO OLD STRING; QOPEN RETURNS PTR TO NEW ONE IN BP.
CALL QOPEN ;MEANWHILE C HAS SIZE NEEDED FOR NEW ONE, = SIZE OF OLD.
JUMPE B,QCLOSV
LOWCO7: ILDB TT,E ;COPY OLD STRING
CAIL TT,"A+40
CAILE TT,"Z+40
CAIA
SUBI TT,40 ;CONVERT EACH CHARACTER IF NECESSARY.
IDPB TT,BP ;STORE INTO THE NEW STRING.
SOJG B,LOWCO7
JRST QCLOSV ;THEN FINISH THE NEW STRING'S HEADER AND RETURN IT.
NEWAS: ARGDFL ;DOLLARSIGN COMMAND.
CALL FSCASF ;UNLESS IN -1$, NO CASE SHIFT OR LOCK.
SKIPGE C
MOVEI IN,"/ ;-1$, USE / AS THE CASE-SHIFT, NO CASE-LOCK.
JRST FSCAS1
FSCASV: MOVE A,CASNRM ;COMPUTE VALUE FOR FS CASE TO RETURN.
SKIPL CH,CASSFT ;IF THERE'S A CASE-SHIFT, PUT IT IN BUFFER..
CALL TYOMGS
SKIPL CH,CASLOK ;SAME FOR CASE-LOCK.
CALL TYOM
JRST POPJ1
FSCASE: TRNN FF,FRARG ;FS CASE -- NO ARG => RETURN STATUS INFO.
JRST FSCASV
ARGDFL
CALL FSCASF ;READ THE STRING ARG WITH NO CASE SHIFT OR CASE LOCK.
CALL RCH ;READ WHAT MIGHT BE THE CASE-SHIFT.
CAIN CH,ALTMOD ;NULL STRING ARG => NEITHER.
JRST FSCAS1 ;(NOTE IN, OUT HOLD -1)
MOVEI IN,(CH) ;ELSE 1ST CHAR OF ARG IS CASE-:SHIFT.
CALL RCH ;AND THERE MAY BE A CASE-LOCK.
CAIN CH,ALTMOD
JRST FSCAS1 ;NO MORE CHARS IN ARG => NO CASE-LOCK.
MOVEI OUT,(CH)
FSCAS0: JSP B,RDALTC ;IGNORE REST OF STRING ARG.
CAIA
JRST FSCAS0
FSCAS1: CAMN IN,OUT ;TRYING TO MAKE SAME CHAR SHIFT & LOCK?
SETO IN, ;JUST USE IT AS LOCK.
MOVEM C,CASNRM ;SIGN OF ARG IS NORMAL INPUT CASE.
MOVEM C,CASE ;SET CURRENT CASE TO NEW NORMAL.
ANDI C,1
MOVEM C,CASDIS ;ARG ODD => FLAG ON OUTPUT.
MOVEM IN,CASSFT ;THEN STORE AWAY NEW SHIFT AND LOCK CHARS,
MOVEM OUT,CASLOK
MOVE TT,[CALL RCHSFT] ;ACTUALLY MAKE THE NEW CASE-SHIFT
SKIPL IN ;(IF ANY)
EXCH TT,RCHDTB(IN) ;ACT LIKE ONE.
MOVEM TT,RCHSFD ;MAKE SURE CAN UNDO THAT EXCH.
MOVE TT,[CALL RCHLOK]
SKIPL OUT ;SIMILAR FOR THE NEW CASE-LOCK.
EXCH TT,RCHDTB(OUT)
MOVEM TT,RCHLOD
POPJ P,
;CAUSE THE CASE-SHIFT AND CASE-LOCK, IF ANY, TO BECOME NORMAL.
;CHARACTERS AGAIN, WITH NO CASE-SHIFT OR -LOCK IN EXISTENCE.
;SETOM'S IN, OUT. CLOBBERS TT, TT1.
FSCASF: MOVE TT,RCHLOD ;FIRST TURN THE OLD SHIFT AND LOCK CHARS
SKIPL TT1,CASLOK ;INTO NORMAL CHARS.
MOVEM TT,RCHDTB(TT1)
MOVE TT,RCHSFD
SKIPL TT1,CASSFT
MOVEM TT,RCHDTB(TT1)
SETOB IN,CASSFT ;THEN SAY THERE ARE NONE.
SETOB OUT,CASLOK
POPJ P,
SUBTTL Q-REGISTER NAME READERS
;ROUTINES TO READ IN SUFFIX QREG ARGS:
;THERE ARE SEVERAL TYPES OF SUFFIX QREGS, AND VARIOUS ROUTINES ALLOW CERTAIN SUBSETS.
;A LETTER (OR DOTS AND A LETTER, OR A ^R OR ^^ NAME) NAMES A FIXED LOCATION IN TECO.
;AN EXPRESSION IN PARENTHESES IS A READ-ONLY QREG "CONTAINING" THE VALUE OF THE EXP.
;A * IS A WRITE-ONLY QREG AND WHAT IS WRITTEN IN IT IS THE COMMAND'S VALUE.
;:<Q>(<IDX>) WHERE <Q> IS A QREG CONTAINING A Q-VECTOR, IS A SUBSCRIPTING EXPRESSION.
; IN THIS CASE, THE QREG IS ONE WORD IN THE QVECTOR.
;<NAME> IS A LONG-NAME QREG. THE NAME IS LOOKED UP IN THE SYMBOL TABLE
; (A QVECTOR IN ..Q) WITH FO TO FIND THE WORD IN THAT QVECTOR HOLDING THE VALUE.
;THE REASON THERE ARE SEVERAL ROUTINES IS THAT ONLY READING-ONLY COMMANDS
;ALLOW (-) QREGS, AND ONLY WRITING-ONLY COMMANDS ALLOW *.
;QREGS IS THE BASIC ROUTINE (NEITHER * NOR PARENS), QREGX ALLOWS PARENS,
;AND QREGVS ALLOWS *.
;THE ROUTINES HAVE SIMILAR VALUE CONVENTIONS:
;A CONTAINS THE CONTENTS OF THE QREG,
;CH CONTAINS ITS ADDRESS (BAKTAB, FOR PAREN-QREGS WHICH CAN'T BE WRITTEN)
;B CONTAINS AN INDICATION OF WHICH TYPE OF NAME WAS READ.
;NORMALLY, IT IS ZERO. FOR :<Q>(<IDX>), IT IS POSITIVE; FOR NAME, IT IS NEGATIVE.
;IN EITHER OF THOSE TWO CASES, THE RH POINTS AT THE BUFFER BLOCK OF THE QVECTOR
;CONTAINING THE SLOT. THAT IS SO THAT COMMANDS LIKE :I CAN TELL IF THAT QVECTOR
;IS RELOCATED AND CORRECT ACCORDINGLY (SEE QREGVA).
;IN, FOR A NAME QREG (B IS NEGATIVE), CONTAINS A TECO STRING POINTER TO THE
;INTERNED NAME OF THE QREG AS FOUND IN THE SYMBOL TABLE.
;READ EITHER A QREG NAME OR AN EXPRESSION IN PARENS, WHOSE VALUE
;IS USED AS THE "CONTENTS" OF THE QREG. CONTENTS RETURNED IN A. CLOBBERS ALL ACS
;EXCEPT C,E. ALSO ALLOWS SUBSCRIPTED QVECTORS, LIKE QREGS.
QREGX: CALL SKRCH
CAIE CH,"(
JRST QREGS0
TRO FF,FRQPRN ;MARK THIS ( AS BEING FROM QREGX.
MOVEI T,CD
JRST OPEN2 ;SAVE ARGS, ETC; WILL COME BACK WHEN ")" IS SEEN
QREGXR: MOVE C,NUM ;TO HERE. A HAS VALUE WITHIN THE PARENS.
MOVE E,SARG ;RESTORE THE SAVED ARGS.
TRZ FF,FRARG\FRARG2\FRCLN\FRUPRW
IORI FF,(CH)
SETZ B, ;RETURN B AS 0 TO SHOW THIS WASN'T A SUBSCTRIPTED QREG.
MOVEI CH,BAKTAB ;MAKE SURE, IF CALLER TRIES TO WRITE OUR QREG, NO HARM DONE.
RET
;HERE TAKE CARE OF "SIMPLE" (..A OR ...^RX) TYPE QREG NAMES.
QREGXX: SETZB A,B
CALL QNMGE2 ;HERE FROM QREGX OR QREGS IF IT'S AN ORDINARY QREG NAME AFTER ALL.
TYPRE [IQN]
MOVE A,(CH)
POPJ P,
;HERE TO READ EITHER QREG NAME OR "*" MEANING RETURN AS VALUE INSTEAD OF SETTING QREG.
;ASSUMES -1(P) IS CALLER'S RETURN ADDRESS, AND AOS'S IT SO CALLER RETURNS THE VALUE.
QREGVS: CALL SKRCH ;HERE TO ALLOW EITHER * OR SUBSCRIPTING.
CAIE CH,"*
JRST QREGS0
MOVEI CH,A ;SUPPLY AC A AS ADDR OF "QREG".
SETZB A,B ;SAY ITS VALUE IS 0 (FOR THINGS LIKE @X).
AOS -1(P) ;MAKE OUR CALLER SKIP-RETURN
RET
;READ IN A QREG NAME, ALLOWING SUBSCRIPTING (AS IN Q:.Q(10) = 10TH ELT OF Q-VECTOR IN .Q)
;ON RETURN FROM THIS OR ANY OTHER QREG-READING ROUTINE, IF B IS NONZERO
;THEN THE QREG WAS SUBSCRIPTED, AND B POINTS AT THE BUFFER BLOCK OF THE Q-VECTOR.
;WE ALSO HANDLE "LONG QREG NAMES" AS IN QFOO, SINCE THAT IS IMPLEMENTED
;BY MEANS OF INDEXING (INTO THE SYMBOL TABLE QVECTOR).
QREGS: CALL SKRCH
QREGS0: CAIN CH,ALTMOD
JRST QREGN ;CHECK FOR Q$FOO$ CONSTRUCT.
CAIE CH,":
JRST QREGXX
CALL QREGX ;FIRST, READ THE QREG WHICH IS THE Q-VECTOR TO SUBSCRIPT.
SAVE A ;SAVE IT AS IF IN A (.
SAVE [0]
SAVE LEV
MOVEM P,LEV
CALL QREGX ;THEN READ THE VALUE OF THE INDEX.
MOVE IN,A
MOVEI T,.+2
JRST CLOSE2 ;POP STUFF OFF, LEAVING Q-VECTOR IN A.
MOVE BP,A
CALL QBGET1 ;GET BUFFER-BLOCK ADDR IN B.
SKIPN B
TYPRE [QNB]
IMULI IN,5 ;GET VIRTUAL CHAR ADDR INSIDE Q-VECTOR OF DESIRED WORD.
ADD IN,MFBEG(B)
TLZ IN,MFBBTS
CAML IN,MFBEGV(B) ;COMPLAIN IF NOT INSIDE VIRTUAL BOUNDS.
CAML IN,MFZV(B)
TYPRE [NIB]
CAML IN,MFGPT(B)
ADD IN,MFEXTR(B) ;TURN INTO REAL ADDRESS.
IDIVI IN,5
MOVE A,(IN) ;FETCH CONTENTS OF WORD,
MOVE CH,IN ;AND ALSO RETURN ITS ADDRESS, FOR "U", ETC.
RET
;COMMANDS THAT DO CONSING, AFTER CALLING QREGVS, SHOULD, IF B IS NONZERO,
;DO A JSP TT,QREGVA TO WORRY ABOUT CHANCE THAT CONSING WILL MOVE THE Q-VECTOR.
;QREGVA SAVES STUFF, CALLS BACK TO DO THE WORK, THEN FIXES UP AND RETURNS TO COMMAND'S CALLER.
;IF B IS NEGATIVE, THE QREG IS A NAMED VARIABLE, AND WE MAY NEED TO CALL A MACRO
;WHEN ITS VALUE CHANGES. WE PRESERVE B FOR USE2 TO ACCOMPLISH THAT.
QREGVA: SAVE B ;REMEMBER ADDR OF BUFFER BLOCK OF QVECTOR
SAVE CH ;REMEMBER ADDRESS OF WORD IN QVECTOR.
MOVE CH,MFBEGV(B)
IDIVI CH,5 ;BUT CONVERT IT INTO AN INDEX RELATIVE TO QVECTOR'S B.
MOVNS CH
ADDM CH,(P)
MOVEI CH,A ;NOW CALL THE COMMAND BACK, GETTING RESULT IN A.
SETZ B,
CALL (TT)
MOVE B,-1(P) ;NOW CONVERT REL. IDX. INTO QVECTOR BACK INTO ADDRESS.
MOVE CH,MFBEGV(B)
IDIVI CH,5
ADD CH,(P)
SUB P,[2,,2]
MOVE C,A ;NOW GO STORE VALUE IN QREG.
JRST USE2
;HERE AFTER SEEING A QREG NAME STARTS WITH AN ALTMODE, AS IN QFOO. [
QREGN: SETZM SQUOTP ;Q^]A WHERE A HOLDS $FOO$ SHOULD WIN.
SAVE C
SAVE E ;FO CLOBBERS ALL ACS
SAVE FF
MOVE A,QRB..
MOVE A,.QSYMT(A) ;GET THE PTR TO THE QVECTOR USED AS SYMBOL TABLE.
MOVE BP,A
CALL QBGET1
SAVE B
TRZ FF,FRCLN\FRARG\FRARG2\FRUPRW
CALL FOCMD0 ;DO FO TO READ IN THE "FOO" AND SEARCH SYMBOL TABLE.
JFCL ;PUTS VAL IN A AND ADDR OF S.T.E. IN IN.
MOVEI CH,1(IN) ;CH GETS ADDR OF SLOT IN QVECTOR HOLDING THE VALUE.
MOVE IN,(IN) ;IN GETS THE STRING WHICH IS THE FULL NAME.
REST B ;RETURN IN B THE BUFFER BLOCK OF THE QVECTOR
TLO B,400000
REST FF ;(FOR RELOCATION HACKERY IN QREGVA FOR :I AND X).
REST E
JRST POPCJ
;SKIP IF CHAR IN CH IS A LETTER OR A DIGIT. ALSO, CONVERT LOWER
;CASE LETETRS TO UPPER CASE.
QRVTST: CAIL CH,"0
CAILE CH,"9
CAIA
JRST POPJ1
CAIL CH,"A
CAILE CH,"Z
CAIA
JRST POPJ1
CAIL CH,"A+40
CAILE CH,"Z+40
POPJ P,
SUBI CH,40
JRST POPJ1
;READ IN A QREG NAME, AND RETURN IN CH THE ADDRESS OF THE QREG.
;CLOBBERS A AND CH.
QNMGET: SETZI A,
CALL SKRCH
QNMGE2: CAIN CH,".
AOJA A,QNMGET+1
CAIE CH,^R
CAIN CH,^^
JRST QNMGE3
CALL QRVTST
RET
CAILE A,NQSETS-1
RET
AOS (P)
QNMGE1: MOVEI CH,-"0(CH)
CAILE CH,9
SUBI CH,"A-"9-1
ADD CH,QRB(A)
RET
QNMGE3: LSH A,7 ;HANDLE QREG NAME CONTAINING "^R" OR "^^":
CAIN CH,^^
XORI A,100
QNMGE5: SETZM BRCUAV ;[ ;IF A ^]^V IS DONE, BRCUAV WILL BECOME NEGATIVE.
CALL SKRCH ;READ IN NAME OF ^R-MODE CHARACTER
SKIPGE BRCUAV ;[ ;THE POINT OF THIS IS THAT ^]^V TRUNCATES TO 7 BITS,
HRRZ CH,BRCUAV ;BUT WE HAVE TO GET BACK THE 9-BIT VALUE.
XOR CH,A ;GET THE SPECIFIED CHAR. IN TV CHAR SET.
ANDI CH,777
ADDI CH,RRMACT ;THE "QREG" IS THE RRMACT ENTRY FOR THE CHARACTER.
JRST POPJ1
;F^^ -- CONVERT A ^R-COMMAND NAME INTO A NUMBER (F^^.^R. RETURNS 174. = 256)
;<STRING>:F^^ -- IF <STRING> IS A VALID Q-REG NAME, RETURN THE
;:FSQPHOME$ OF THE Q-REG. OTHERWISE, RETURN 0.
FCTLUP: TRZE FF,FRCLN
JRST FCUP1
CALL QNMGET
TYPRE [ARG]
MOVEI A,-RRMACT(CH)
CAIL A,1000
TYPRE [ARG]
JRST POPJ1
FCUP1: TRZ FF,FRARG
MOVE A,C ;<STRING>:F^^.
CALL QLGET0 ;DECODE THE STRING, B.P. IN BP AND LENGTH IN B.
JRST NRET0
SETZ A, ;COUNT NUMBER OF DOTS IN A.
FCUP2: SOJL B,NRET0 ;STRING EXHAUSTED => NOT VALID.
ILDB CH,BP
CAIN CH,". ;NEXT CHAR IS A DOT => JUST COUNT IT.
AOJA A,FCUP2
CAIE CH,^R ;NON-DOT => WE'RE NEAR THE END NOW.
CAIN CH,^^
JRST FCUP3 ;^R CHARACTER DEFN NAMES ARE OK TOO.
CALL QNMGE2 ;ELSE FIGURE OUT THE QREG NAME,
SETZ CH, ;NO SKIP MEANS IT ISN'T A VALID ONE, SO RETURN 0.
MOVE A,CH ;ELSE QNMGE2 LEFT THE DESIRED VALUE IN CH.
JUMPN B,NRET0 ;WE WIN PROVIDED STRING IS NOW EXHAUSTED.
JRST POPJ1
FCUP3: LSH A,7 ;^R CHARACTER DEFN NAME => PUT DOTS IN CTL AND META BITS,
CAIN CH,^^
XORI A,100 ;FOR ^^ CONTROLIFY WHAT FOLLOWS.
SOJL B,NRET0 ;STRING EXHAUSTED RIGHT AFTER THE ^R OR ^^ => LOSE.
ILDB CH,BP
XOR A,CH ;ELSE MERGE CHAR WITH DOTS AND RETURN.
ANDI A,777
ADDI A,RRMACT
JUMPN B,NRET0 ;WE WIN PROVIDED STRING IS NOW EXHAUSTED.
JRST POPJ1
;FO COMMAND - BINARY SEARCH A TABLE FOR A GIVEN STRING.
;FOLLOW BY QREG WHICH POINTS TO A STRING OR BUFFER CONTAINING THE TABLE
;(MUST BE ON A WORD BOUNDARY, SO USELESS WITH IMPURE STRINGS).
;AFTER THE QREG NAME COMES THE STRING TO SEARCH FOR.
;THE FIRST WORD OF THE TABLE MUST CONTAIN THE SIZE (IN WORDS) OF
;ALL THE ENTRIES; AFTER IT COME THE ENTRIES. THE FIRST WORD OF EACH ENTRY
;IS ASSUMED TO BE THE POINTER TO THE NAME-STRING TO SEARCH FOR.
;IF THE TABLE IS A PURE STRING, THAT PONTER IS RELATIVE TO THE TABLE ITSELF.
;PLAIN FO GETS AN ERROR (UVN OR AVN) IF THE TARGET NAME IS MISSING OR AMBIGUOUS;
;OTHERWISE, IT RETURNS THE VALUE IN THE SECOND WORD OF THE ENTRY.
;:FO RETURNS THE OFFSET OF THE ENTRY FOUND; IF THE TARGET IS NOT FOUND
;OR AMBIGUOUS, MINUS THE OFFSET OF THE ENTRY TO INSERT BEFORE IS RETURNED.
;<ARG>FO RETURNS THE VALUE OF THE VARIABLE IF IT IS DEFINED, <ARG> OTHERWISE.
;"@" MODIFIER => DON'T ALLOW ABBREVIATIONS, JUST EXACT MATCHES.
FOCMD: CALL QREGX ;READ THE QREG NAME.
FOCMD0: MOVEI J,BAKTAB-1 ;THEN ACCUMULATE STRING TO SEARCH FOR IN BAKTAB.
MOVEI B,40 ;B HOLDS PREVIOUS CHARACTER, FOR COMPRESSING SPACES.
TRZ FF,FRNOT
FOCMD1: CALL ORCH ;READ CHAR, CONVERT LETTERS TO U.C.
CAIN CH,ALTMOD
SKIPE SQUOTP
CAIA
JRST FOCMD2
SKIPGE SQUOTP ;ALLOW FOR SUPERQUOTED SPACES
HRLI CH,-1
CAIN CH,^I
MOVEI CH,40 ;CONVERT ALL TABS TO SPACES.
CAIN CH,40 ;CHECK FOR MULTIPLE OR LEADING WHITESPACE.
CAIE B,40 ;IF THIS CHAR AND PREVIOUS BOTH SPACING, IGNORE THIS ONE.
CAIA
JRST FOCMD1
MOVE B,CH ;REMEMBER THIS CHAR AS PREVIOUS FOR NEXT.
HRRZS CH
CAMN J,[LTABS,,BAKTAB+LTABS-1]
TYPRE [STL]
PUSH J,CH ;REMEMBER CHAR IN BAKTAB.
JRST FOCMD1
FOCMD2: CAIN B,40 ;FLUSH TRAILING SPACES.
SOS J
;ENTER HERE FROM F^G COMMAND.
FOCMD3: CALL QLGET0 ;GET TABLE LENGTH IN CHARS IN B, B.P. TO ILDB IN BP.
TYPRE [QNS]
IBP BP
HLRZ A,BP
CAIE A,350700 ;TABLE MUST START ON WORD BOUNDARY.
TYPRE [ARG]
MOVE C,(BP) ;C GETS ENTRY SIZE IN WORDS, FROM 1ST WORD OF TABLE.
MOVE OUT,B
IDIVI OUT,5 ;SIZE MUST BE INTEGRAL # OF WORDS.
SKIPE OUT+1 .SEE CH
TYPRE [ARG]
SOS CH,OUT ;OUT GETS TABLE SIZE, NOT COUNTING 1ST WORD (SIZE PER ENTRY).
IDIV CH,C
SKIPE CH+1 .SEE Q
TYPRE [ARG] ;TABLE MUST BE INTEGRAL NUMBER OF ENTRIES.
MOVEI IN,1(BP) ;IN -> 1ST WORD (NOT COUNTING ENTRY-SIZE WORD AT FRONT).
ADD OUT,IN ;OUT -> LAST WORD + 1
HRRZ E,BP
IMULI E,5 ;E GETS CHAR ADDR OF START OF TABLE (INCLUDING DOPE WORD).
CAML E,BFRTOP ;IF TABLE IS A PURE STRING, SET FRNOT, INDICATING
TRO FF,FRNOT ;NAME POINTERS ARE RELATIVE TO BOTTOM OF STRING (NEED E ADDED).
SUBI E,4
TLO E,400000
MOVE T,OUT ;SAVE BOUNDS OF WHOLE TABLE AS [E,T) ;]
HRRZS J ;J POINTS AT END OF STUFF IN BAKTAB.
CAIGE J,BAKTAB
JRST FOCMDU ;ARG NULL AFTER HACKING IT => NO GOOD.
JRST FOCMDN
;NOW TRY TO NARROW THE RANGE [IN,OUT) WHICH THE OBJECT MIGHT BE IN. ;]
;E HAS CHAR ADDR START OF TABLE MINUS 4 (WITH SIGN SET),
;T -> WORD AFTER END, C HAS ENTRY SIZE IN WORDS,
;J POINTS TO LAST USED WORD IN BAKTAB.
FOCMDN: MOVE CH,OUT
SUB CH,IN
CAMG CH,C
JRST FOCMDF ;NARROWED TO ONE ENTRY => IT'S THAT OR NOTHING.
IDIV CH,C ;HOW MANY ENTRIES THEN?
MOVE D,CH
LSH D,-1 ;BINARY SEARCH STEP IS HALF THAT MANY.
IMUL D,C
ADD D,IN ;GET PTR TO MIDDLE OF RANGE; COMPARE THAT POINT WITH TARGET.
CALL FOCMP
JRST [ MOVE OUT,D ;TARGET IS LESS => NARROW TO BOTTOM HALF-RANGE.
JRST FOCMDN]
JRST [ MOVE IN,D ;TARGET IS MORE => NARROW TO TOP HALF-RANGE.
JRST FOCMDN]
MOVE IN,D
JRST FOCMDW ;TARGET IS EQUAL => WE CERTAINLY WIN.
;NARROWED TO JUST ONE ENTRY; IS IT GOOD?
FOCMDF: CAML IN,T
JRST FOCMDU
MOVE D,IN ;FIRST OF ALL, THIS ENTRY IS THAT LAST ONE L.E. TARGET.
CALL FOCMP ;SO ADVANCE TO THE FIRST ONE G.E. THE TARGET
CAIA
ADD IN,C ;SINCE THE TARGET MIGHT BE ABBREVIATION FOR THAT ONE.
CAML IN,T ;DETECT CASE THAT TARGET IS GREATER THAN ALL SYMBOLS
JRST FOCMDU
MOVE OUT,IN
ADD OUT,C
MOVE A,(IN)
CALL FOCMDA ;DOES TARGET ABBREVIATE ENTRY'S NAME?
JRST FOCMDU ;NO => TARGET NOT FOUND, RETURN 0.
JUMPE B,FOCMDW ;YES, MAY BE GOOD. IF EXACT MATCH, CERTAINLY GOOD.
TRNE FF,FRUPRW ;"@" AND NOT EXACT MATCH => IT'S "UNDEFINED".
JRST FOCMDU
CAMN OUT,T
JRST FOCMDW ;NO FOLLOWING ENTRY => NAME CAN'T BE AMGIBUOUS.
MOVE A,(OUT) ;DOES FOLLOWING ENTRY ALSO WIN?
CALL FOCMDA
JRST FOCMDW ;NO => THIS ENTRY WINS!
TRNE FF,FRARG ;AMBIGUOUS NAME. IF HAVE DEFAULT (ARG), RETURN IT.
JRST FOCMDU
TRZN FF,FRCLN ;OR ELSE MAYBE GIVE ERROR,
TYPRE [AVN]
FOCMDL: MOVEI A,-1(IN) ;MAYBE RETURN MINUS THE PLACE TO PUT THE NAME.
TRZ FF,FRARG\FRUPRW
TLZ E,400000
IDIVI E,5 ;E GETS WORD BEFORE THE WORD TABLE STARTS IN.
SUBM E,A
JRST POPJ1
FOCMDU: TRZE FF,FRARG ;HERE IF NAME IS UNDEFINED; IN -> PLACE TO INSERT IT.
JRST [ TRZ FF,FRCLN\FRUPRW
MOVE A,NUM
JRST POPJ1]
TRZN FF,FRCLN
TYPRE [UVN]
JRST FOCMDL
FOCMDW: MOVE A,1(IN) ;FOUND THE TARGET. RETURN EITHER 2ND WORD OF ENTRY
TRZ FF,FRARG\FRUPRW
TLZ E,400000
TRZN FF,FRCLN
JRST POPJ1
MOVEI A,-1(IN)
IDIVI E,5
SUB A,E
JRST POPJ1 ;OR THE INDEX OF THE ENTRY.
;SKIP IF THE STRING IN BAKTAB IS AN ABBREVIATION FOR THE STRING A POINTS TO
;(A HOLDS TECO STRING POINTER).
FOCMDA: TRNE FF,FRNOT ;IF TABLE IS PURE STRING, "NAME POINTERS" ARE
ADD A,E ;ACTUALLY RELATIVE.
CALL QLGET0 ;SKIP IF TARGET ABBREVIATES THE STRING A POINTS TO.
TYPRE [QNS]
MOVEI Q,BAKTAB
FOCMDG: CAMLE Q,J
JRST POPJ1 ;JUMP IF TARGET ABBREVIATES ENTRY'S NAME.
JUMPE B,CPOPJ ;TARGET DOESN'T ABBREVIATE ENTRY'S NAME => TARGET NOT FOUND.
ILDB CH,BP
CAIL CH,"A+40
CAILE CH,"Z+40
CAIA
SUBI CH,40
CAME CH,(Q)
RET
SOS B
AOJA Q,FOCMDG
;COMPARE STRING IN BAKTAB (TARGET) WITH STRING THAT @(D) POINTS TO. SKIP ONCE
;IF TARGET BIGGER, SKIP TWICE IF EQUAL.
FOCMP: MOVE A,(D) ;GET THIS ENTRY'S NAME.
TRNE FF,FRNOT ;IF TABLE IS PURE STRING, "NAME POINTERS" ARE
ADD A,E ;ACTUALLY RELATIVE.
CALL QLGET0 ;DECODE AS STRING.
TYPRE [QNS]
MOVEI Q,BAKTAB ;Q SCANS TARGET, BP SCANS THIS ENTRY'S NAME.
FOCMPL: JUMPE B,[CAMLE Q,J
JRST POPJ2 ;IF BOTH STRINGS EXHAUSTED, THEUY ARE EQUAL.
JRST POPJ1] ;TARGET HAS MORE => IT IS BIGGER.
CAMLE Q,J
RET ;TARGET EMPTY, BUT THIS ENTRY NAME HAS MORE => TARGET LESS.
ILDB CH,BP
CAIL CH,"A+40
CAILE CH,"Z+40
CAIA
SUBI CH,40
CAMGE CH,(Q)
JRST POPJ1 ;TARGET IS BIGGER.
CAMLE CH,(Q)
RET ;TARGET SMALLER.
SOS B
AOJA Q,FOCMPL ;EQUAL SO FAR, KEEP LOOKING.
SUBTTL DECODE A STRING POINTER
;CH HAS QREG IDX; DON'T SKIP IF QREG NOT STRING.
;ELSE SKIP WITH B HOLDING # CHARS OF TEXT IN STRING (NOT INCLUDING HEADER),
;BP HOLDING A B.P. TO ILDB THE TEXT. CLOBBERS TT, TT1.
QLGET: MOVE A,(CH)
QLGET0: CAML A,[SETZ+LHIMAX*5*2000]
RET ;CAN'T BE EITHER PURE OR IMPURE SPACE.
QLGET1: MOVE BP,A
TLZ BP,400000 ;FLUSH THE SIGN BIT (SET IN ALL POINTERS)
CAMGE BP,BFRTOP ;IF IT'S IMPURE SPACE,
ADD BP,QRBUF ;POINTER IS RELATIVE TO START OF IMPURE SPACE.
QLGET2: PUSHJ P,GETBP
QLGET3: LDB B,BP
CAIN B,QRBFR
JRST QLGET5
CAIE B,QRSTR
RET
AOS (P)
QLGET4: ILDB B,BP
ILDB TT,BP
ROT TT,7
IOR B,TT
ILDB TT,BP
LSH TT,14.
IOR B,TT
SUBI B,4
RET
;HANDLE THE CASE IN WHICH QLGET IS CALLED ON QREG HOLDING A BUFFER.
QLGET5: CALL QLGET4 ;GET ADDR OF HEADER, MINUS 4, IN B.
ADDI B,4
JUMPE B,POPJ1 ;GIVE 0 AS LENGTH OF DEAD BUFFER
SAVE T
SAVE C
MOVEI C,(B) ;IF THIS BUFFER IS CURRENT, THE VALUES IN ITS HEADER
CAMN C,BFRPTR ;MAY BE OUT OF DATE. UPDATE THEM BY RESELECTING.
CALL NEWBFR
MOVE BP,MFGPT(B)
CAMG BP,MFBEGV(B)
JRST QLGET6
CAML BP,MFZV(B) ;IF THE GAP IS WHERE IT WILL DO HARM, THEN MOVE IT TO WHERE IT WON'T.
JRST QLGET6
SAVE BFRPTR ;PUSH CURRENT BUFFER,
MOVEI C,(B) ;SELECT THE ONE BEING QLGET'ED
CALL NEWBFR
SAVE PT
MOVE BP,ZV
MOVEM BP,PT ;PUT PT WHERE WE WANT THE GAP TO BE
CALL GAPSL0 ;AND MOVE THE GAP THERE. (WITHOUT SETTING MODIFF, NOT REALLY MODIFYING)
REST PT
REST C ;POP THE SELECTED BUFFER.
CALL NEWBFR
QLGET6: REST C
MOVE BP,MFBEGV(B) ;GET VIRT ADDR OF BEGINNING OF BUFFER
MOVE T,MFZV(B)
SUB T,BP ;GET LENGTH OF BUFFER.
CAML BP,MFGPT(B)
ADD BP,MFEXTR(B) ;CONVERT VIRT ADDR TO REAL ADDR.
MOVE B,T
REST T
AOS (P)
JRST GETIBP ;RETURN IN BP, B.P. TO ILDB BUFFER.
SUBTTL Q-REGISTER COMMANDS
;FQ<Q> - RETURN LENGTH OF TEXT IN <Q>, OR -1 IF NOT TEXT.
QLEN: PUSHJ P,QREGX
PUSHJ P,QLGET0
RETM1A: SKIPA A,[-1]
MOVE A,B
JRST POPJ1
;Q<Q> - RETURN CONTENTS OF QREG <Q> AS A NUMBER.
QREG: AOS (P)
JRST QREGX
;%<Q> - INCREMENT <Q>, RETURN NEW VALUE.
PCNT: CALL QREGS ;READ QREG NAME, GET IDX IN CH.
AOS C,A ;INCREMENT. PUT IN C FOR USE2 AND IN A TO RETURN.
AOS (P) ;WE ALWAYS RETURN A VALUE.
JRST USE2 ;GO STORE BACK IN QREG.
;U<Q> - PUT NUMERIC ARG IN <Q>. 2 ARGS => USE 2ND, RETURN 1ST.
USE: TRZN FF,FRARG
TYPRE [WNA]
ARGDFL
CALL QREGS
USE1: CAIN CH,A ;MAKE SURE U* IS A NO-OP.
JRST POPJ1
TRZN FF,FRARG2 ;M,NUQ SHOULD RETURN M.
JRST USE2
MOVE A,E
AOS (P)
;STORE THE CONTENTS OF C INTO THE QREG IN CH.
;B IS ASSUMED TO CONTAIN WHAT QREGX LEAVES THERE.
USE2: CAIN CH,$QBUFR ;SELECT A NEW BUFFER BEFORE! SETTING ..O, IN CASE IT GETS ERROR.
CALL BFRSET
SKIPE VARMAC
JUMPL B,USE3 ;IF SETTING A NAMED VARIABLE, SEE IF THERE'S A MACRO TO RUN.
CAIL CH,RRMACT
CAIL CH,RRMACT+1000
CAIA
CALL USE5
MOVEM C,(CH)
RET
;SETTING A ^R CHARACTER DEFINITION.
;SET THE RDFMSK BIT FOR THIS CHARACTER
;TO RECORD THAT IT HAS CHANGED.
USE5: SAVE A
SAVE B
SAVE C
IFN TEXTIF&0,[
SETZM BRKVLD ;INDICATE THAT WE WILL HAVE TO CHANGE THE BREAK TABLE
];IFN TEXTIF&0
MOVEI A,-RRMACT(CH)
IDIVI A,32.
MOVNS B
MOVSI C,400000
LSH C,(B)
IORM C,RDFMSK(A)
JRST POPCBA
USE3: SAVE A
SAVE B
SKIPN A,1(CH) ;LOOK AT THE THIRD WORD OF THE NAMED VARIABLE'S DATA BLOCK.
JRST USE4 ;(IF VARMAC IS SET, WE ASSUME THAT WORD EXISTS).
CALL QLGET0 ;IS IT A STRING?
JRST USE4
ILDB B,BP ;DOES IT START WITH "!"?
CAIN B,"!
CALL [ CALL SAVACS ;BOTH YES => CALL IT WITH NEW VALUE OF VARIABLE AS ARG.
CALL MACXCP
JRST RSTACS]
USE4: MOVEM C,(CH) ;THEN, OR IN ANY CASE, SET THE VARIABLE.
JRST POPBAJ
;<ARG>FP RETURNS AN INDICATION OF <ARG>'S DATA TYPE:
;-4 => NUMBER (NOT IN RANGE FOR PURE OR IMPURE STRING SPACE)
;-3 => PURE OBJECT WITH MEANINGLESS HEADER
;-2 => IMPURE OBJECT WITH MEANINGLESS HEADER
;-1 => DEAD BUFFER
;0 => LIVING BUFFER
;1 => Q-VECTOR.
;100 => PURE STRING
;101 => IMPURE STRING
FDATTY: MOVNI A,4
TRZN FF,FRARG
TYPRE [WNA]
TLZN C,400000 ;MUST BE CLOSE TO 400000,, TO BE ANYTHING BUT A NUMBER.
JRST POPJ1
MOVE BP,C
CAML C,BFRBOT ;IS IT IN RANGE FOR IMURE SPACE?
JRST [ MOVE D,LHIPAG
IMULI D,5*2000
CAMGE C,[LHIMAX*5*2000] ;NO, WHAT ABOUT PURE SPACE?
CAMGE C,D
JRST POPJ1 ;NO, ORDINARY NUMBER
AOJA A,FDATT2] ;YES, SEE WHAT KIND OBJECT (A _ -3)
ADD BP,QRBUF ;ADDR'S IN IMPURE SPACE ARE REL. TO QRBUF.
MOVNI A,2
;A HAS -2 FOR IMPURE SPACE, -3 FOR PURE SPACE.
;SEE IF OBJECT IS STRING, BUFFER OR NOTHING.
FDATT2: CALL GETIBP
ILDB B,BP
CAIN B,QRSTR ;STRING => RETURN 100. OR 101.
JRST [ ADDI A,103.
JRST POPJ1]
CAME A,[-3] ;PURE AND NOT STRING => RETURN -3.
CAIE B,QRBFR ;IF IMPURE, MAYBE IT IS A BUFFER OR QVECTOR.
JRST POPJ1 ;NOTHING => RETURN -3 OR -2.
CALL QLGET4 ;BUFFER: IS IT STILL ALIVE?
ADDI B,4 ;B GETS BUFFER BLOCK ADDR, OR 0 IF DEAD BUFFER.
JUMPE B,RETM1A ;RETURN -1 IF DEAD.
MOVEI A,0
MOVE C,(B)
TLNE C,MFQVEC
AOS A ;IF Q-VECTOR, RETURN 1, ELSE 0.
JRST POPJ1
QGET3: TRZ FF,FRARG\FRARG2
JRST QGET4
;G<Q> COMMAND -- INSERT QREG <Q> IN BUFFER BEFORE PT.
;<M>,<N>G<Q> -- GET RANGE OF CHARS <M>,<N> FROM QREG.
;FS INSLEN$ IS SET TO # CHARS INSERTED.
;<M>:G<Q> -- RETURN THE <M>'TH CHARACTER OF <Q>.
QGET: CALL QREGX
QGET4: CALL QLGET0
JRST [ MOVE C,A ? JRST BAKSL1]
TRNN FF,FRARG
SETZ C,
CAMLE C,B ;MAKE SURE UNCOMMA'D ARG, IF ANY, IS WITHIN RANGE
MOVE C,B ;[0 , <LENGTH OF STRING>]
SKIPGE C
SETZ C,
TRNE FF,FRARG ;DETECT THE 1-ARG CASE (ONLY LEGAL WITH COLON).
TRNE FF,FRARG2
CAIA
JRST QGET7
TRNN FF,FRARG2 ;(IF NO ARGS, C AND E MAY BE RANDOM. PREVENT 2<1 ERROR).
SETZB C,E
SKIPGE E
SETZ E,
CAMLE E,C ;MAKE SURE ARGS ARE IN INCREASING ORDER.
TYPRE [2%1]
TRNN FF,FRARG2
SKIPA C,B ;IF NO ARGS, # CHARS TO INSERT IS LENGTH OF QREG.
SUB C,E ;IF ARGS, IT IS DIFFERENCE BETWEEN ARGS.
MOVEM C,INSLEN
QGETI: SAVE A
CALL SLP ;INSERT BUFFER SPACE OR PREPARE TO WRITE AT QRWRT. LEAVE BP. IN BP.
MOVE IN,BP
REST A
JUMPE C,SLPXIT
CALL QLGET0 ;IN CASE QREG IS BUFFER AND WAS MOVED BY SLPGET,
.VALUE ;RECOMPUTE THE BYTE PTR TO IT.
JUMPE E,QGET1 ;IF NOT STARTING AT BEGINNING OF STRING,
CALL GETCA ;MAKE B.P. -> ARG1'TH CHAR OF QREG.
ADD BP,E
CALL GETBP
QGET1: HLRZ CH,BP
HLRZ D,IN
CAIN CH,010700
CAIE D,010700 ;IF WE'RE AT A WORD BOUNDARY IN BOTH QREG AND BUFFER,
JRST QGET2
CAIGE C,5 ;AND TRANSFERING AT LEAST 1 WORD,
JRST QGET2
IDIVI C,5 ;DO A BLT TO AVOID LOSING LOW BITS.
MOVEI CH,1(IN)
HRLI CH,1(BP)
ADD BP,C ;AND UPDATE BOTH B.P.'S TO POINT AFTER WHAT WE'RE BLT'ING.
ADD IN,C
BLT CH,(IN)
SKIPN C,D ;# CHARS NOT TRANSFERED BY THE BLT.
JRST QGET6
QGET2: ILDB CH,BP
IDPB CH,IN
SOJG C,QGET2
QGET6: MOVE BP,IN ;IF WRITING A STRING, SLPXIT REQUIRES B.P. TO LAST CHAR IN BP.
SLPXIT: TRZN FF,FRCLN ;WRITING IN BUFFER => FINISHED.
RET
TRZ FF,FRUPRW+FRARG+FRARG2 ;WRITING A STRING => FINISH CONSING AND RETURN IT.
AOS (P)
JRST QCLOSV
QGET7: TRZN FF,FRCLN ;1 ARG TO G IS BAD NUMBER UNLESS WE HAVE A COLON.
TYPRE [WNA]
CAML C,B
TYPRE [ARG]
TRZ FF,FRUPRW+FRARG
CALL GETCA ;INCREMENT THE B.P. IN BP BY THE # CHARS WHICH IS THE ARG.
ADD BP,C
CALL GETBP
ILDB A,BP ;AND FETCH THAT CHARACTER AND RETURN IT AS VALUE OF <N>:G<Q>.
JRST POPJ1
X: CALL QREGVS
CALL GETANU ;X COMMAND, GET ENDS OF AREA IN C,E.
X12: TRZ FF,FRARG\FRARG2 ;FLUSH ARG; AVOIDS LOSSAGE FOR X* WHICH RETURNS VALUE.
JUMPE B,X10 ;IS THE QREG SUBSCRIPTED? (X:Q(IDX))
JSP TT,QREGVA ;IF SO, EXTRA HAIR IN CASE OUR CONSING
;MOVES THE Q-VECTOR CONTAINING THE Q-REG.
;CALLS X10, THEN RETURNS TO INSERT'S CALLER.
X10: SAVE CH
SAVE B
TRZE FF,FRUPRW
PUSHJ P,QLGET0 ;APPENDING TO QREG-GET PREVIOUS LENGTH/LOCATION
SETZB B,BP
SAVE B
SAVE BP
CALL CHK1
SUB C,E ;C HAS # CHARS TO X AWAY
ADDI C,4 ;THEN INCLUDE 4 CHARS FOR HEADER.
ADD C,-1(P) ;HOW MUCH SPACE, INCLUDING OLD STRING WE ARE APPENDING TO?
SAVE C
MOVN J,BEG
CALL SLPQGT ;MAKE SURE HAVE ENOUGH SPACE IN IMPURE STRING SPACE.
ADD J,BEG ;CHANGE IN BEG = AMOUNT BUFFER MOVED.
ADD E,J ;RELOCATE ADDR OF START OF AREA OF BUFFER TO X FROM.
MOVE C,(P) ;GET LENGTH INCL. HEADER.
MOVEI B,QRSTR ;AND 1ST CHAR FOR HEADER.
CALL QHDRW1 ;WRITE THE HEADER IN BOTTOM OF FREE AREA.
REST C
SUBI C,4 ;C HAS LENGTH NOT INCL. HEADER.
CALL IMMQIT ;ALLOW QUITTING OUT OF COPYING THE CHARACTERS.
MOVE D,BP ;D HAS BP FOR STUFFING CHARS DOWN.
SKIPN J,-1(P) ;ANY CHARS TO APPEND TO?
JRST X8
SUB C,J ;YES, COUNT OFF THAT MANY AS INSERTED,
MOVE OUT,(P) ;GET BP TO ILDB OLD TEXT TO APPEND TO,
X7: ILDB CH,OUT ;AND COPY INTO NEW STRING.
IDPB CH,D
SOJG J,X7
X8: MOVE BP,E ;BP GETS BP TO FETCH FROM BUFFER.
MOVE IN,BP ;IN GETS CHAR ADDR OF WHAT WE ARE FETCHING.
CALL GETIBV
X1: SOJL C,X2 ;INSERT THE CHARS FROM THE BUFFER INTO THE STRING.
CAMN IN,GPT ;MOVE BP ACROSS THE GAP WHEN WE REACH IT.
CALL FEQGAP
ILDB CH,BP
IDPB CH,D
AOJA IN,X1
X2: CALL DELQIT
MOVE BP,D ;FIND CHAR ADDR OF WHERE WE STOPPED WRITING THE STRING
CALL GETCA
AOS OUT,BP ;GET CHAR ADDR OF LAST+1.
TRZ FF,FRCLN\FRUPRW
SUB P,[2,,2] ;FLUSH INFO ON OLD STRING TO APPEND TO.
REST B
JRST QCLOSP ;POP QREG ADDR AND STORE STRING IN IT.
SUBTTL Q-REGISTER PDL
;[<Q> - PUSH <Q> ONTO QREG PDL. ;]
OPENB: ARGDFL ;MAKE -[0 THE SAME AS -1[0 ;]]
CALL QREGX ;READ THE QREG VALUE IN A AND ADDR IN CH.
SAVE CH
SKIPLE B ;IF THIS QREG IS REALLY AN ELT OF A QVECTOR,
TYPRE [IQN] ;AUTO-UNWIND WOULD LOSE, SO COMPLAIN.
SKIPGE B
MOVE CH,IN ;FOR NAME QREGS, PUSH INTERNED NAME-STRING AS QREG ADDR.
SAVE B ;PRESERVE FLAG FOR USE1.
MOVE B,PF
CAMN B,PFTOP ;CHECK FOR OVERFLOW BEFORE WRITING ANYTHING.
TYPRE [QRP]
PUSH B,A ;THEN PUSH OLD CONTENTS
CALL OPENB3 ;GO PUSH ADDR OF QREG (FOR UNWINDING) AND RETURN.
REST B
REST CH ;GET BACK ACTUAL LOCATION OF QREG
TRZN FF,FRARG ;AND IF WE HAVE ARG, STORE ARG INTO IT.
RET
JRST USE1 ;DO IT VIA USE SO THAT STORING INTO ..O WORKS.
OPENB2: MOVE B,PF
CAMN B,PFTOP ;DETECT OVERPUSH BEFORE A PDLOV INT HAPPENS.
OPENB1: TYPRE [QRP]
PUSH B,(CH)
OPENB3: PUSH B,CH
FSQPU2: MOVEM B,PF
POPJ P,
;[[ ;]<Q> - POP FROM QREG PDL INTO <Q>. ]* POPS AND RETURNS AS VALUE.
CLOSEB: CALL QREGVS ;CAN MAKE US SKIP!
CAIA
;POP INTO ADDRESS SUPPLIED IN CH. ASSUME IT'S NOT A NAMED VARIABLE.
CLOSB2: SETZ B, ;B SUPPLIES INFORMATION TO USE2.
MOVE A,PF
CAMN A,PFINI ;DETECT UNDERFLOW FIRST THING.
TYPRE [QRP]
POP A,C
POP A,C ;C GETS VALUE POPPED FROM SLOT.
MOVEM A,PF ;MARK SLOT GONE BEFORE WE STORE, SINCE USE2 CAN ERR.
JRST USE2
;FS QPPTR $ -- GET OR SET QREG PDL POINTER.
;TAKES AND RETURNS # ENTRIES ON STACK.
FSQPPT: HRRZ A,PF
SUBI A,PFL-1 ;GET 2*<# ENTRIES NOW ON STACK>
LSH A,-1 ;A HAS VALUE TO RETURN.
TRZN FF,FRARG
JRST POPJ1 ;NO ARG => JUST RETURN THE VALUE.
CALL FSQPRG ;CONVERT ARG TO NEW PDL PTR.
MOVEM C,PF ;STORE NEW CONTENTS.
JRST POPJ1
;HANDLE ARGUMENT DECODING FOR FS QP SLOT, FS QP PTR, AND FS QP UNWIND.
FSQPRG: ARGDFL
JUMPL C,FSQPR1
LSH C,1 ;ARG -> PTR TRANSFORMATION IS INVERSE OF
HRLI C,(C) ;PTR -> VALUE TRANSFORMATION DONE ABOVE.
ADD C,PFINI
CAMLE C,PF
JRST TYPAOR ;DON'T ALLOW REF. TO CELLS ABOVE CURRENT POINTER POS.
RET
FSQPR1: LSH C,1 ;NEGATIVE ARG IS RELATIVE TO CURRENT POINTER.
HRLI C,-1(C)
ADD C,PF
CAMGE C,PFINI ;DON'T ALLOW REF BELOW BOTTOM OF QREG PDL.
JRST TYPAOR
RET
PFINI: -LPF-1,,PFL-1
PFTOP: -1,,PFL+LPF-1
;<N>FS QP HOME$ RETURNS A STRING WHICH IS THE NAME OF THE Q-REG THAT WAS
;PUSHED INTO PDL SLOT <N>. <N>:FSQP HOME$ RETURNS A NUMBER THAT ENCODES
;THAT NAME - SUCH NUMBERS ARE USEFUL IN THAT, IN A GIVEN TECO, EACH QREG
;HAS A UNIQUE NUMBER. WITH NO COLON, IF THE SLOT WAS PUSHED WITH
;F[FOO$, WE RETURN "FSFOO$". ;]
;@FS QPHOME$ CONVERTS AN NUMBER WHICH IS A :FSQPHOME VALUE INTO A
;DESCRIPTIVE FSQPHOME$-STYLE STRING. SO <N>:FSQPHOME$ @FSQPHOME$ = <N>FSQPHOME$.
FSQPHO: TRZN FF,FRARG
TYPRE [WNA]
TRZE FF,FRUPRW
JRST FSQPH2
CALL FSQPRG ;FIND SLOT <N>.
CAML C,PF ;FSQPGR ALLOWS CURRENT PDL PTR AS ARG, BUT THAT ISN'T
TYPRE [AOR] ;LEGAL AS THE NUMBER OF A SLOT.
MOVE C,2(C) ;GET WHERE PUSHED FROM.
MOVE A,C
FSQPH2: TRZE FF,FRCLN ;NUMERIC FORM MAY BE WHAT WE WANT.
JRST POPJ1 ;OTHERWISE, MUST DECODE AND TURN INTO STRING:
;ALREADY A STRING => IT IS VARIABLE NAME; PUT ALTMODES AROUND IT.
JUMPL C,[ MOVEM C,NUM
MOVEI A,[ASCIZ /[0 :I*Q 0 /] ;]
JRST MACXQV] ;THAT'S DONE MOST EASILY BY TECO COMMANDS.
MOVEI A,[ASCIZ /:I** /]
CAIN C,BAKTAB ;IF A [(...) PUSHED THIS SLOT, RETURN "*". ;]
JRST MACXQV
CAIGE C,FLAGSL*2 ;IF AN F[ PUSHED THIS, ;]
JRST [ MOVE C,FLAGS(C) ;RETURN NAME OF FLAG IN ASCII.
JRST FSIXFL]
MOVE E,C
MOVEI C,6 ;OTHERWISE IT WAS A NORMAL QREG OR A ^R COMMAND DEFINITION.
CALL QOPEN ;SO START CONSING UP A STRING WITH THE NAME.
MOVEI CH,"Q
IDPB CH,BP
CAIGE E,RRMACT
JRST FSQPH1
SUBI E,RRMACT ;IT WAS A ^R COMMAND. WHAT WAS 9-BIT CHARACTER?
IDIVI E,200
CALL FSQPH. ;PUT OUT 1 DOT FOR CTL, 2 FOR META, 3 FOR BOTH.
MOVEI CH,^R
IDPB CH,BP
FSQPH3: IDPB J,BP ;THEN THE ASCII PART OF THE CHARACTER.
AOS (P)
JRST QCLOSV ;INISH CONSING THE STRING AND RETURN IT.
FSQPH1: SUBI E,QTAB ;ORDINARY OLD-FASHIONED QREG.
IDIVI E,36. ;HOW MANY DOTS?
CALL FSQPH.
ADDI J,"0 ;CONVERT WHAT'S LEFT TO A LETTER OR DIGIT.
CAILE J,"9 ;(STARTS OUT AS IDX IN QRB, QRB. OR QRB..).
ADDI J,"A-"0-10.
JRST FSQPH3
FSQPH.: MOVEI CH,". ;OUTPUT DOTS THRU BP IN BP. J SAYS HOW MANY.
JUMPE E,CPOPJ
IDPB CH,BP
SOJA E,FSQPH.
MACXQV: CALL MACXQW ;EXECUTE A MACRO IN A AND RETURN THE VALUE IT RETURNS.
MOVE A,NUM
TRZ FF,FRARG\FRARG2\FRUPRW\FRCLN
JRST POPJ1
;<N> FS QPSLOT $ -- RETURNS CONTENTS OF SLOT <N>.
;<M>,<N>FS QPSLOT $ ALSO SETS THE SLOT TO <M>.
FSQPSL: MOVE E,SARG
TRZN FF,FRARG ;MUST HAVE ARG TO KNOW WHICH SLOT.
TYPRE [WNA]
TRZE FF,FRARG2 ;IF 1 ARG, IT'S SLOT #, IN C.
TRO FF,FRARG ;IF 2, SLOT #'S IN C, NEW VALUE IN E.
CALL FSQPRG ;FIND ADDRESS OF DESIRED SLOT IN C.
CAML C,PF ;FSQPGR ALLOWS CURRENT PDL PTR AS ARG, BUT THAT ISN'T
TYPRE [AOR] ;LEGAL AS THE NUMBER OF A SLOT.
EXCH C,E
AOJA E,FSNOR1 ;WORD TO GET OR SET IS 2ND WORD OF SLOT.
;<N> FS QPUNWIND $ -- UNWINDS QREG PDL TO LEVEL <N>.
;THAT IS, POPS EACH ENTRY BACK INTO THE QREG IT WAS PUSHED FROM.
FSQPUN: TRZN FF,FRARG ;NO ARG => ASSUME 0.
SETZ C,
PUSHJ P,FSQPRG ;COMPUTE LEVEL TO UNWIND TO FROM ARG.
FSQPU0: SAVE STOPF ;DON'T QUIT WHILE UNWINDING!!
SETZM STOPF ;MIGHT WANT TO SET NOQUIT INSTEAD, BUT THIS IS SAFER.
FSQPU7: MOVE B,PF
FSQPU1: CAMG B,C ;DOWN TO DESIRED LEVEL?
JRST [ REST STOPF
JRST FSQPU2] ;JUST SET PF & EXIT
POP B,CH ;POP 1 ENTRY
JUMPL CH,FSQPU5 ;JUMP IF "QREG ADDR" IS A STRING - MEANS IT IS QREG NAME, A LA QFOO.
IF2 IFG FLAGSL*2-QTAB,.ERR QRP CAN'T TELL [ FROM F[
;]]
CAIGE CH,FLAGSL*2 ;IF ENTRY WAS MADE BY AN F[, POP INTO FLAG. ;]
JRST FSQPU4
CAIN CH,$QUNWN ;IF UNWINDING Q..N,
JRST [ MOVE A,(CH)
POP B,(CH) ;POP IT, STORING OR SAVING ALL TEMPS,
JRST FSQPU3];AND GO MACRO IT.
POP B,(CH)
CAIN CH,$QBUFR ;IF UNWINDING Q..O, WE'RE SELECTING A NEW BUFFER.
CALL BFRSE2
CAIL CH,RRMACT
CAIL CH,RRMACT+1000
CAIA ;UNWINDING A ^R CHAR DEFINITION => RECORD THIS FACT
CALL USE5 ;TO TELL TERMINAL LATER (FOR LOCAL EDITING).
JRST FSQPU1
FSQPU4: SAVE C ;HANDLE UNWINDING AN FS FLAG.
POP B,C ;GET OLD FLAG VALUE, AS ARG.
MOVS E,FLAGD(CH)
SAVE FF
IORI FF,FRARG ;SAY THERE'S AN ARG.
MOVEM B,PF
CALL (E) ;SET THE FLAG.
JFCL
REST FF ;DON'T LET THE ROUTINE CLOBBER THE VALUES.
REST C
JRST FSQPU7
FSQPU3: JUMPE A,FSQPU1
JSP T,OPEN1 ;HANDLE UNWINDING Q..N; MUST PRESERVE TEMPS.
FSQPU6: SAVE C
SAVE BKRTLV
MOVEM B,PF
CALL MACXQW ;EXECUTE THE INNER BINDING OF ..N (WHICH IS IN A).
REST BKRTLV
REST C
HRROI T,FSQPU7
TRZ FF,FRARG+FRARG2+FRSYL+FROP
JRST CLOSE2 ;POP WHAT OPEN PUSHED, AND GO TO FSQPU0
FSQPU5: MOVE A,CH ;POP INTO LONG-NAMED QREG WHOSE NAME IS IN CH.
JSP T,OPEN1
MOVEM A,SARG
TRO FF,FRARG\FRARG2
TRZ FF,FRCLN\FRUPRW\FRSYL\FROP
POP B,NUM
MOVEI A,[ASCIZ /[0 U 0/] ;]
JRST FSQPU6
SUBTTL M SUBROUTINE CALL COMMAND
;M<Q> SAVES CURRENT EXECUTION POINTERS AND THEN EXECUTES CONTENTS OF <Q>.
;<Q> MAY CONTAIN TEXT OR THE ADDRESS OF A BUILT-IN FUNCTION.
;:M<Q> JUMPS INTO THE STRING IN <Q> AND DOESN'T RETURN - BUILT-IN FUNCTIONS NOT ALLOWED.
MAC: CALL QREGX ;GET A NAME AND PUT ITS ENTRY IN A
CAIL CH,RRMACT ;FOR M^R ETC, PUT THE CHARACTER WHOSE DEFINITION IS BEING RUN
CAIL CH,RRMACT+1000
JRST MAC6
SUBI CH,RRMACT ;IN Q..0.
MOVEM CH,$Q..0
MAC6: MOVE CH,$Q..0
MAC5: CALL QLGET0 ;REALLY TEXT? IF SO, LENGTH IN B, BP TO ILDB TEXT IN BP.
JSP T,MACN ;NOT REALLY TEXT; USE AS BUILT-IN FUNCTION ADDRESS.
TRNE FF,FRCLN ;IF YOU ARE DOING A :M, DON'T PUSH THE CALLING STRING
JRST MAC3
MAC2: MOVEM BP,INSBP ;ELSE PUSH THE STRING CONTAINING THE "M" BEFORE JUMPING.
CALL PUSMAC ;WE SAVE THE B.P. TO THE MACRO BEING CALLED IN INSBP
MOVE BP,INSBP ;SO IT WILL BE RELOCATED BY GETFR2.
MOVEI CH,0
IDPB CH,MACPDP ;PUSH A 0 (MACRO CALL) ENTRY.
.I MACSPF=PF ;REMEMBER QREG PDL LEVEL FOR THIS FRAME TO POP TO.
SETZM MACBTS
MAC3: MOVEM A,CSTR ;STORE TECO OBJECT POINTER TO WHAT WE'RE CALLING.
SETZ TT, ;PUT IN MACBTS INDICATIONS OF HOW MANY ARGS THERE ARE.
TRNE FF,FRARG ;MFBA1 AND MFBA2 ARE SIMPLY SET.
TLO TT,MFBA2
TRNE FF,FRARG2
TLO TT,MFBA1
TRNE FF,FRUPRW ;MFBATSN IS SET TO WHETHER THERE WAS AN @, EXCEPT
TLO TT,MFBATSN
MOVSI C,MFBATSN ;THAT :M WITH NO @ DOES NOT CLEAR MFBATSN IF IT WAS SET.
ANDM C,MACBTS
IORM TT,MACBTS
MOVEI C,1
TRZE FF,FRUPRW ;GET THE FIRST MACRO ARGUMENT (OR, IF NONE,
TRNE FF,FRARG ;EITHER 0 OR (IF FRUPRW) 1).
MOVE C,NUM
ARGDFL
MOVEM C,MARG2 ;SAVE IT AS THE THING ^Y GETS
MOVE C,SARG ;TRY FOR A SECOND ARGUMENT
TRNN FF,FRARG2
MOVEI C,0 ;IF NONE, THEN 0
MOVEM C,MARG1 ;SIGH
MOVEM B,COMCNT ;STORE LENGTH OF TEXT AS LENGTH OF MACRO.
MOVEM BP,CPTR ;GIVE RCH THE BP TO THE TEXT.
ILDB CH,BP ;NOW, START EXECUTING THE MACRO, BUT FIRST
CAIE CH,"W+40 ;UNLESS THE FIRST CHARACTER IS "W", MAYBE INVOKE FS STEPMAC$
CAIN CH,"W
JUMPN B,CD
CALL CTLM2
JRST CD
;A IS ADDR 1ST WD ASCIZ STRING, EXECUTE STRING AS MACRO.
MACXCW: HRLI A,BP7
MACXCT: SETO B, ;A IS BP -> STRING.
MOVE BP,A ;MUST COUNT # CHARS IN STRING.
MACXC1: ILDB CH,A
AOJ B,
JUMPN CH,MACXC1
MOVE A,BP ;GIVE THE BYTE POINTER AS THE FS BACK STR$ SINCE THERE'S NO
JRST MACXC2 ;ACTUAL TECO OBJECT POINTER WE CAN USE.
MACXQW: JUMPGE A,MACXCW ;EXECUTE EITHER A QREG OR AN ASSEMBLED-IN ASCII STRING.
;DISTINGUISH THEM SINCE STRING QREGS ARE NEGATIVE.
;A HAS CONTENTS OF A QREG; PUSHJ HERE TO EXECUTE IT, POPJ'ING AFTER IT FINISHES.
MACXQ: CALL QLGET0 ;GET LENGTH AND STARTING BP OF STRING.
JSP T,MACN1 ;(QREG CONTAINS A NUMBER; PUSHJ TO THAT LOCATION).
MACXC2: TRZ FF,FRUPRW
SAVE MACPTR
SAVE MACXP
MOVEM P,MACXP .SEE RCH2
SETOM MACPTR ;-1 SAYS CALLED FROM MACXP.
JRST MAC2
MACN: TRNN FF,FRCLN ;HERE WHEN AN "M" COMMAND CALLS A BUILT-IN FUNCTION.
JRST MACN2
MOVE T,[440700,,[ASCIZ / /]]
MOVEM T,CPTR ;IF IT'S A ":M", THEN DISCARD REST OF CALLING STRING
MOVEM T,CSTR ;REPLACING IT WITH A ^\ TO POP ITS QREGS.
MOVEI T,1
MOVEM T,COMCNT
MACN2: SAVE [CDRET] ;POPJ TO EITHER (JRST TO) CD, OR VALREC IF SKIP.
MOVEI T,2+[ SUB P,[1,,1] ? JRST MAC5]
;T HAS 2+ ADDR TO GO TO IF THIS NUMBER "TURNS OUT" TO BE A STRING AFTER ALL.
;2+ IS SO CAN JSP AFTER A FAILING CALL TO QLGET0.
MACN1: ARGDFL ;MACROING A QREG CONTAINING A NUMBER.
TRNN FF,FRARG
MOVEI C,1
MOVE E,A
ANDI A,-1
CAIE A,RRINDR ;TRACE THRU INDIRECTD DEFINITIONS HERE, SO THAT
JRST [ TRZ FF,FRCLN
JRST RRLP7H]
HLRE A,E ;IF THE ULTIMATE TARGET IS A STRING, WE CAN MACRO IT
SUB CH,A ;WITH OUT GOING THROUGH RRMACR.
MOVE A,RRMACT(CH)
JRST -2(T)
;<N>FSBACKTRACE$ - INSERT IN THE BUFFER THE TEXT OF THE MACRO IN FRAME <N>.
;LEAVE POINT AT THE PC OF THAT FRAME.
FSBAKT: CALL BACKTR ;FIND THE FRAME THE USER SPECIFIED.
FSBAK1: CALL MFBEGP ;GET STARTING B.P. IN B AND CURRENT PC IN C.
SAVE B
ADD C,MFCCNT(A) ;C GETS TOTAL SIZE OF MACRO.
MOVEM C,INSLEN ;INSERT SPACE IN BUFFER TO HOLD THE STRING.
CALL SLPGET
MOVN A,MFCCNT(A)
ADDM A,PT
MOVE IN,BP
REST BP
JRST QGET1
;<N>FS BACK PC$ - RETURN RELATIVE PC (OFFSET FROM 1ST CHAR) OF MACRO IN FRAME <N>.
;<PC>,<N>FS BACK PC$ - SET RELATIVE PC OF THAT FRAME TO <PC>.
; SETTIN THE PC TO A VERY LARGE NUMBER PUTS IT AT THE END OF THE STRING.
FSBAKP: CALL BACKTR
CALL MFBEGP ;C GETS CURRENT RELATIVE PC.
SAVE C
TRZN FF,FRARG2 ;DO WE WANT TO CHANGE IT?
JRST POPAJ1
ADD C,MFCCNT(A)
MOVE E,SARG
CAMLE E,C ;IF ARG IS GREATER THAN # OF CHARS IN STRING, MAKE POINT AT END.
MOVE E,C
SKIPGE E ;NEGATIVE PC'S ARE MEANINGLESS.
TYPRE [AOR]
ADD BP,E ;IF SO, ADD DESIRED PC TO CHAR ADDR OF START
CALL GETBP ;CONVERT TO B.P. AND STORE AS THE FETCH POINTER.
MOVEM BP,MFCPTR(A)
SUB E,(P) ;GET THE DIFFERENCE BETWEEN NEW PC AND OLD
MOVNS E
ADDM E,MFCCNT(A) ;AND UPDATE NUMBER-OF-CHARS-TO-GO BY THAT MUCH.
JRST POPAJ1
;<N>FS BACK QP PTR$ - RETURN FS QP PTR$ OF BOTTOM OF QP FRAME
;BELONGING TO MACRO FRAME <N>. THIS IS THE QP PTR WHICH
;^\'ING THAT FRAME WOULD UNWIND TO.
FSBAKQ: CALL BACKTR
HRRZ A,MFPF(A) ;GET SAVED QREG PDL POINTER,
SUBI A,PFL-1 ;CONVERT IT TO A PDL DEPTH INDEX.
LSH A,-1
JRST POPJ1
;<N>FS BACK ARGS$ - RETURN ARGS OF MACRO FRAME <N>.
FSBAKA: CALL BACKTR ;GET POINTER TO FRAME IN A.
MOVE C,MFLINK(A) ;GET FRAME'S SAVED MACBTS, MARG1, MARG2
MOVE B,MFARG1(A)
MOVE A,MFARG2(A)
JRST FCTLX2 ;AND RETURN APPROPRIATE VALUES, A LA F^X.
;<N>FS BACK STRING$ - RETURN STRING POINTER TO MACRO BEING EXECUTED IN FRAME <N>.
;IF THAT MACRO ISN'T A STRING, WE RETURN A BYTE POINTER (A NUMBER).
;THERE IS NO WAY TO DECODE SUCH BYTE POINTERS, BUT THEY CAN BE COMPARED RELIABLY.
FSBAKS: CALL BACKTR ;GET FRAME POINTER IN A.
MOVE A,MFCSTR(A)
JRST POPJ1
;SUBROUTINES FOR FS BACK WHATEVER.
;A POINTS AT A MACRO FRAME (OR AT COMCNT); RETURN IN B A B.P. TO THE MACRO'S START,
;AND IN C THE DISTANCE IN CHARACTERS OF THE CURRENT PC FROM THE START.
MFBEGP: MOVE BP,MFCPTR(A)
CALL GETCA
MOVE C,BP
SAVE A
MOVE A,MFCSTR(A)
CALL QLGET0
MOVE BP,A
MOVE B,BP ;B GETS B.P. TO START OF MACRO.
CALL GETCA ;BP GETS CHAR ADDR OF IT.
SUB C,BP
JRST POPAJ
;RETURN IN A A POINTER TO THE MACRO FRAME SPECIFIED BY THE DEPTH IN C.
;IF C IS POSITIVE, IT IS COUNTING FROM THE BOTTOM OF THE STACK
;(0 = OUTERMOST FRAME). IF IT IS NEGATIVE, IT COUNTS DOWN FROM THE
;CURRENT FRAME (-1 = THIS FRAME'S CALLER).
BACKTR: ARGDFL Z
MOVNS C
SKIPG C
ADD C,MACDEP ;C NOW HAS NUMBER OF FRAMES TO GO OUT FROM CURRENT ONE.
SOJL C,TYPAOR ;ILLEGAL TO REFER TO CURRENT FRAME, SINCE IT ISN'T STORED THE SAME WAY.
MOVE B,MACXP
HRRE A,MACPTR ;START WITH TOP OF MACPTR STACK (CURRENT MACRO'S CALLER).
BACKT0: JUMPGE A,BACKT2
HRRE A,-1(B) ;WHENEVER A MACXQ CALL IS FOUND, GO BACK THROUGH IT.
MOVE B,(B)
JRST BACKT0
BACKT2: JUMPE A,TYPAOR
JUMPE C,[ ;HAVE WE GONE OUT ENOUGH FRAMES?
SUBI A,MFLINK
RET]
HRRE A,(A) ;NO, GO OUT ONE FRAME MORE.
SOJA C,BACKT0
GMARG2: SKIPA A,MARG2
GMARG1: MOVE A,MARG1
JRST POPJ1
SUBTTL CONVERT NUMBERS TO STRINGS
BAKSL: TRZ FF,FRUPRW
TRZE FF,FRARG
JRST BAKS1A
SETZ A,
MOVE IN,PT
PUSHJ P,GETINC
TRZE FF,FRCLN
CAIE CH,"-
JRST BAKSL7
TRO FF,FRARG
BAKSLA: PUSHJ P,GETINC
BAKSL7: CAMLE IN,ZV
JRST BAKSL3
BAKSL6: CAIG CH,"9
CAIGE CH,"0
SOJA IN,BAKSL2
JFCL 10,.+1
IMUL A,IBASE
JFCL 10,[TLC A,400000 ? JRST .+1] ;MAKE OVERFLOW ACT AS IF UNSIGNED MULTIPLY.
ADDI A,-60(CH)
JRST BAKSLA
BAKSL3: MOVE IN,ZV
BAKSL2: TRZE FF,FRARG
MOVNS A
MOVEM IN,PT
JRST POPJ1
;<N>\ WRITE <N> IN BASE IN ..E, INTO BUFFER. :<N>\ CONS INTO STRING AND RETURN IT.
;<M>,<N>\ USE <M> COLUMNS, MAKING LEADING SPACES IF NEEDED.
BAKS1A: MOVEI TT,40
HRRM TT,DPT5
TRZN FF,FRARG2
JRST BAKSL1
CAIL E,LTABS*5 ;DON'T ALLOW USELESSLY LARGE 1ST ARGS
TYPRE [AOR] ;SINCE MAKING THEM WORK PROPERLY WOULD BE A PAIN.
SOS TT,E
SKIPA BP,[DPT1]
BAKSL1: MOVEI BP,DPT
MOVE T,[(700)BAKTAB-1]
MOVEI E,0
MOVEI CH,[IDPB CH,T ? AOJA E,CPOPJ]
HRRM CH,LISTF5
PUSHJ P,(BP)
MOVE C,E
MOVEM C,INSLEN
CALL SLP ;INSERT THEM, OR PREPARE TO WRITE STRING. GET BP IN BP.
MOVE T,[440700,,BAKTAB]
BAKSLL: ILDB CH,T ;COPY THE PRINTED STUFF INTO INSERTED SPACE.
IDPB CH,BP
SOJG C,BAKSLL
JRST SLPXIT ;IN CASE OF :\, FINISH CONSING THE STRING.
SUBTTL CONTROL CONSTRUCTS
FDQUOT: SUB P,[1,,1] ;F" LIKE " BUT ARGUMENT REMAINS AS WELL AS BEING TESTED.
SKIPA A,[CD2A]
DQUOTE: MOVEI A,CD
CALL LRCH ;READ THE CONDITION NAME (B, C, G, L, E, N, #)
CAIN CH,"# ;IS THIS AN "ELSE"?
JRST [ CALL NOGO ;YES, FAIL: SKIP TO THE ',
JRST CD2A] ;RETURN WITHOUT FLUSHING VALUE.
CAIN CH,"'
JRST VCOND
SAVE A ;REMEMBER RETURN ADDRESS (CD OR CD2A).
CALL CONDIT ;DECODE THE CONDITION,
XCT A ;TEST IT,
TRC FF,FRCLN ;TAKE THE EQV OF ITS SUCCESS AND THE COLON FLAG.
TRZN FF,FRCLN
JRST CTLM2 ;NON-: CONDITION WON OR :-CONDITION LOST, INVOKE STEPPER AND RETURN.
NOGO: MOVEI A,0 ;CONDITION FAILED. SKIP TO THE ' AND CHECK FOR AN ELSE.
MOVE C,COMCNT ;REMEMBER WHERE STARTING FROM, SO IF HAVE UTC ERROR
MOVE E,CPTR ;CAN SIGNAL IT AT THE ".
NOGO1: SOSGE COMCNT
JRST [ MOVEM C,COMCNT
MOVEM E,CPTR
TYPRE [UTC]]
ILDB CH,CPTR
CAIN CH,""
AOJA A,NOGO1
CAIE CH,"'
JRST NOGO1
SOJGE A,NOGO1
CALL TRACS ;FOUND THE TERMINATING '. MENTION IT IF TRACING.
MOVE A,COMCNT
MOVE BP,CPTR
NOGO2: SOJL A,CPOPJ ;AFTER THE MATCHING ', CHECK FOR AN ELSE ("#)
ILDB CH,BP ;IS THE NEXT CHAR A DOUBLEQUOTE?
CAIE CH,^M
CAIN CH,^J ;ALLOW CRLFS TO INTERVENE BEFORE THE DOUBLEQUOTE.
JRST NOGO2 ;JUST PASS THEM BY.
SKIPGE TABMOD
CAIE CH,^I
CAIN CH,40
JRST NOGO2 ;ALSO ALLOW SPACES BETWEEN.
CAIN CH,"! ;ALSO ALLOW TAGS BETWEEN.
JRST NOGO3
CAIE CH,""
RET ;NO - THERE IS NO "ELSE"
SOJL A,CPOPJ ;MAKE SURE A "#" FOLLOWS THE """".
ILDB B,BP
CAIE B,"#
RET
CALL TRACS ;THERE IS AN ELSE - TRACE THE " AND #.
MOVEI CH,"#
CALL TRACS
MOVEM BP,CPTR ;RESUME EXECUTION INSIDE THE ELSE CLAUSE.
MOVEM A,COMCNT
JRST CTLM2 ;WE HAVE JUST ENETERED AN ELSE CLAUSE, SO INVOKE STEPPER.
NOGO3: SOJL A,CPOPJ
ILDB CH,BP ;SKIP UNTIL THE NEXT "!", THEN CONTINUE LOOKING FOR '"#'.
CAIE CH,"!
JRST NOGO3
JRST NOGO2
;READ THE NAME OF A CONDITION, AND RETURN IN A
;AN INSTRUCTION TO SKIP IF THE CONDITION IS TRUE.
CONDIT: TRNN FF,FRARG
TYPRE [WNA] ;THIS IS A NUMERIC CONDITIONAL: SNARF THE ARG.
MOVEI A,C
IRPC Z,,[GLNE]
CAIN CH,"Z
HRLI A,(SKIP!Z)
TERMIN
CAIN CH,"A
MOVE A,[CALL DQTLET]
CAIN CH,"D
MOVE A,[CALL DQTDGT]
CAIN CH,"U
MOVE A,[CALL DQTUC]
CAIN CH,"C
MOVE A,[CALL DQT1]
CAIN CH,"B
MOVE A,[CALL DQT3] ;B => GET INSN TO SKIP IF GIVEN A BREAK CHARACTER.
TLNN A,-1 ;IF WE DIDN'T RECOGNIZE THE CONDITION, SIGNAL AN ERROR.
TYPRE [BD%]
RET
DQT1: PUSHJ P,DQT3 ;SKIP IF CHAR IN C IS NOT A BREAK CHARACTER.
AOS (P)
RET
DQTLET: CAIG C,"Z+40 ;SKIP IF CHARACTER IN C IS A LETTER.
CAIGE C,"A+40
DQTUC: CAIG C,"Z ;SKIP IF THE CHARACTER IN C IS AN UPPER-CASE LETTER.
CAIGE C,"A
RET
JRST POPJ1
DQTDGT: CAIG C,"9 ;SKIP IF THE CHARACTER IN C IS A DIGIT.
CAIGE C,"0
RET
JRST POPJ1
VCOND: CALL LRCH ;"' COMMAND: TEST A CONDITION,
CALL CONDIT ;BUT RETURN -1 IF IT SUCCEEDS, OR ELSE 0.
XCT A ;THUS, 0"'N RETURNS 0 BUT 1"'N RETURNS -1.
TRC FF,FRCLN
TRZ FF,FRARG
SAVE [CDRET]
TRZN FF,FRCLN
JRST NRETM1
JRST NRET0
EXCLAM: SETOM BRC1 ;HANDLE "!" AS A COMMAND.
CALL SKRCH ;[ ;SKIP UNTIL THE NEXT "!". BRC1 INHIBITS MOST ^] FORMS.
CAIE CH,"!
JRST .-2
SETZM BRC1
CALL TRACS ;IN TRACE MODE, TRACE A SECOND "!" TO MINIMIZE USER CONFUSION.
JRST CD5A
LRCH: PUSHJ P,RCH
TRNE CH,100
ANDCMI CH,40
POPJ P,
;HANDLE THE "O" COMMAND: O<TAG>$ JUMPS TO !<TAG>!. ":O" DOES NOT ERR IF TAG UNFOUND.
OG: MOVE A,CPTR ;FIRST, LOOK IN THE JUMP CACHE FOR ADDR OF "O" CMD.
MOVE C,A
ANDI C,16 ;GET INDEX IN CACHE OF ENTRY PAIR THAT'S APPRO.
CAMN A,SYMS(C) ;IS FIRST ENTRY FOR THIS "O"?
JRST OGFND
CAMN A,SYMS+1(C) ;IS THE SECOND?
AOJA C,OGFND ;IF FOUND, GET PLACE TO JUMP TO FROM CACHE ENTRY.
;THIS JUMP NOT IN CACHE; MUST ACTUALLY SEARCH.
SAVE CPTR ;PUSH INFO ON WHERE TO STORE INTO CACHE WHEN FIND TAG.
SAVE C ;THESE 2 WORDS ARE NOT USED FOR ANY OTHER PURPOSE.
CALL OARG ;READ IN THE STRING ARG.
MOVEI A,COMCNT
CALL MFBEGP ;FIND START OF CURRENT MACRO.
EXCH BP,B ;NOW BP HAS BP TO START, B HAS STRING POINTER TO MACRO,
ADD C,COMCNT ;C HAS TOTAL SIZE OF MACRO.
CAMGE B,BFRTOP
CAMGE B,QRWRT ;ARE WE IN A STRING? OR IN A BUFFER OR CBUF?
CAMGE B,QRBUF
SETOM BRCFLG ;JUMPS IN BUFFERS AND CBUF AREN'T CACHED,
;SINCE THE DATA AT A GIVEN LOCATION IS LIKELY TO CHANGE.
;NOW SEARCH FOR THE DESIRED LABEL.
TRNE FF,FRUPRW
SOS J
OG4: MOVEI D,BAKTAB
OG5: CAIN D,1(J)
JRST OG3
SOJL C,OGUGT ;COMPARE MACRO CHAR BY CHAR AGAINST TAG.
ILDB CH,BP
CAIL CH,"A+40 ;CONVERT TO UPPER CASE.
CAILE CH,"Z+40
CAIA
SUBI CH,40
CAMN CH,(D)
AOJA D,OG5
TLNE BP,760000 ;AT WORD BOUNDARY => TRY TO SKIP WORDS FAST.
JRST OG4
OG6: SUBI C,5
JUMPL C,OG7 ;NOT A WHOLE WORD LEFT TO SCAN => CAN'T GO FAST.
MOVE D,1(BP) ;ELSE GET THE NEXT WORD
XOR D,[ASCII /!!!!!/] ;AND SEE IF THERE ARE ANY !'S IN IT.
TLNE D,(177_35)
TLNN D,(177_26)
JRST OG7
TRNE D,177_1
TRNN D,177_10
JRST OG7
TDNN D,[177_17]
JRST OG7
AOJA BP,OG6 ;THERE ARE NONE, SO WKIP THIS WORD.
OG7: ADDI C,5 ;FOUND AN !, SO SCAN SLOWLY TO LOCALIZE IT.
JRST OG4
;COME HERE WHEN WE HAVE FOUND THE TAG BY SEARCHING.
OG3: MOVEM C,COMCNT ;SET COMMAND-READING POINT TO WHERE WE FOUND THE TAG.
MOVEM BP,CPTR
REST A ;REMEMBER IDX OF CACHE ENTRY TO STORE IN.
REST B ;REMEMBER CPTR OF "O" TO PUT IN CACHE
SKIPE BRCFLG
JRST OGXIT ;BUT MAYBE CACHE IS INHIBITED FOR THIS JUMP.
EXCH B,SYMS(A) ;STORE THIS JUMP IN 1ST ENTRY OF PAIR, AND MOVE
MOVEM B,SYMS+1(A) ;OLD CONTENTS OF 1ST ENTRY INTO 2ND.
MOVE B,COMCNT
EXCH B,CNTS(A) ;CACHE ENTRY CONTAINS CPTR OF "O",
MOVEM B,CNTS+1(A) ;CPTR OF TAG, AND COMCNT OF TAG.
MOVE BP,CPTR
EXCH BP,VALS(A)
MOVEM BP,VALS+1(A)
JRST OGXIT
OGFND: TRNE FF,FRTRACE
CALL OARG ;IF TRACING, READ IN ARGUMENT SO IT WILL SHOW IN TRACE.
MOVE A,VALS(C) ;COME HERE WHEN THE JUMP IS FOUND IN THE CACHE.
MOVEM A,CPTR
MOVE A,CNTS(C)
MOVEM A,COMCNT
OGXIT: TRZ FF,FRCLN
TRZN FF,FRUPRW
JRST CD
MOVEI CH,"!
CALL TRACS
JRST EXCLAM ;@ O => WE'RE INSIDE A LABEL, SO WE MUST SKIP TO THE END.
OGUGT: TRZN FF,FRCLN ;COME HERE IF TAG IS NOT FOUND.
TYPRE [UGT]
SUB P,[2,,2]
JRST CD
;READ IN A STRING ARG, AND SAVE IT 1 CHAR PER WORD
;IN BAKTAB, WITH AN ! BEFORE AND AFTER. LEAVE J -> LAST
;WORD USED IN BAKTAB. USED BY "O" AND "F;". ;[
;BRCFLG LEFT NONZERO IFF SOME UNPREDICTABLE ^] CALLS TOOK PLACE.
;CLOBBERS A, CH.
OARG: MOVEI J,BAKTAB+1
MOVEI A,41
MOVEM A,-1(J)
SETZM BRCFLG ;[ ;ANY ^] CALLS WE WORRY ABOUT WILL SET BRCFLG.
OGNF1: CAIN J,BAKTAB+LTABS
TYPRE [STL]
CALL ORCH
HRRZM CH,(J)
SKIPN SQUOTP
CAIE CH,ALTMOD
AOJA J,OGNF1
MOVEM A,(J)
RET
ORCH: CALL RCH ;READ CHAR AND CONVERT L.C. LETTERS (ONLY) TO U.C.
CAIL CH,"A+40
CAILE CH,"Z+40
RET
SUBI CH,40
RET
;SEMICOLON AND ITERATIONS.
SEMICL: SKIPN ITRPTR
TYPRE [SNI]
TRNN FF,FRARG
MOVE C,SFINDF
TRNN FF,FRUPRW ;UNLESS THE @ FLAG IS SET, CONVERT SIGN TO NONZERO-NESS.
ASH C,-35.
MOVE A,[JUMPN C,CD] ;THEN WIN (KEEP ITERATING) IF NONZERO,
TRNE FF,FRCLN ;OR, IF COLON, WIN IF ZERO.
HRLI A,(JUMPE C,)
XCT A
INCMA0: MOVEI CH,"> ;"TRACE" A ">" TO HELP USER UNDERSTAND.
CALL TRACS
MOVEI A,0
MOVE BP,CPTR
MOVE C,COMCNT ;SEARCH FOR THE ">" THAT ENDS THIS ITERATION.
INCMA1: SOJL C,[HRRO A,ITRPTR
CALL ITRPOP
TYPRE [UTI]]
ILDB CH,BP
CAIN CH,"<
AOJA A,INCMA1
CAIE CH,">
JRST INCMA1
SOJGE A,INCMA1
MOVEM BP,CPTR
MOVEM C,COMCNT
;HERE THE CODE FOR ">", ";", "F;", AND ERRORS INSIDE ERRSETS,
;MERGES INTO ONE.
INCMA2: HRRO A,ITRPTR ;PTR TO INNERMOST ITER OR ERRSET.
HLRZ TT,ITRPTR ;TO INNERMOST ERRSET.
MOVEI E,(A)
CALL FSEMIP ;SKIP IF THIS ITERATION WAS A CATCH.
CAIN TT,(A) ;SKIP UNLESS IT WAS AN ERRSET.
SKIPA TT,[-1] ;TT HAS -1 IF CATCH OR ERRSET,
SETZ TT, ;0 FOR ORDINARY ITERATION.
CALL ITRPOP ;POP THE ITERATION FRAME.
JUMPE TT,CD ;FOR ORDINARY ITER'S, THAT'S ALL.
;EXITING A CATCH OR ERRSET: 1ST, WE MAY HAVE JUST UNWOUND
;AND NEED TO RESET PDLS. 2ND, WE MUST RETURN A VALUE SAYING
;WHETHER WE EXITED NORMALLY.
TRZ FF,FRARG+FRARG2+FROP+FRSYL+FRCLN+FRUPRW
AOS A,ERRFLG ;EXITING ERRSET, WAS THERE ERROR?
JUMPN A,[SETZ A, ? JRST VALREC] ;RETURN 0 IF NO ERROR.
HLRZ CH,C
HRLI CH,1-PDL-LPDL(CH)
CAME P,CH ;IF CH=P, SETP IS NOT NEEDED, AND RET. ADDR WOULD BE ABOVE P!
PUSHJ CH,SETP ;MOVE P,CH , CHECK FOR UNWINDING PARENS, SORT OR ^R, THEN POPJ P,
HRLI C,1-PFL-LPF(C)
CALL FSQPU0 ;ON ERROR IN ERRSET, UNWIND QREG PDL
MOVE A,LASTER
JRST VALREC
;A CONTAINS ITRPTR'S RH; POP OFF AN ITERATION.
ITRPOP: POP A,ITRPTR
POP A,C
POP A,(A)
POP A,ITERCT
MOVEI A,-MFICNT(A)
JRST FLSFRM
;> AS COMMAND RETURNS TO THE MATCHING < (END ITERATION).
GRTH: SKNTOP ITRPTR
TYPRE [UMC]
TRZE FF,FRUPRW ;@> IGNORES ITERATION COUNT, AND ALWAYS LOOPS BACK.
JRST GRTH1 ;THIS IS FOR THE SAKE OF THE !<!@> CONSTRUCT.
SOSN ITERCT ;OTHERWISE, DECREMENT COUNT AND DON'T LOOP IF IT RUNS OUT.
JRST INCMA2
GRTH1: HRRO A,ITRPTR
MOVE CH,MFMACP-MFBLEN+1(A)
TLZ CH,40
CAME CH,MACPDP ;IF MATCHED < WAS AT A DIFFERENT STACK LEVEL,
TYPRE [UMC] ;THIS IS AN ERROR.
SUBI A,MFBLEN-MFCPTR-1
POP A,CPTR ;OTHERWISE, RESTORE THE "PC" SAVED BY THE <.
POP A,COMCNT
MOVEI CH,^M ;THEN IF WE ARE IN TRACE MODE MAKE THE TRACE LOOK GOOD.
CALL TRACS
MOVEI CH,^J
CALL TRACS
MOVEI CH,"<
CALL TRACS
JRST CD
FLSSTH: SUB P,[1,,1]
LSSTH: PUSHJ P,GETFRM
MOVE TT,PF
HRLI TT,(P)
MOVE TT1,MACPDP ;IN WITH MACPDP, SET BIT MFERS1 TO REMEMBER THE @ FLAG.
TRZE FF,FRUPRW
TLO TT1,MFERS1
INSIRP PUSH A,COMCNT CPTR CSTR ITERCT TT1 TT ITRPTR
HRRM A,ITRPTR ;STORE PTR TO INNERMOST ITER OR ERRSET.
TRZE FF,FRCLN ;IF THIS IS ERRSET, SET PTR TO
HRLM A,ITRPTR ;INNERMOST ERRSET.
TRZE FF,FRARG
JRST LSSTH2
SETOM ITERCT
JRST CD
LSSTH2: JUMPLE C,INCMA0
MOVEM C,ITERCT
JRST CD
CNTRLN: SETOM GEA
TRNE FF,FRARG
MOVEM C,NLINES
TRZN FF,FRCLN
RET
AOSE TTMODE
SETOM TTMODE
POPJ P,
;<ARG>F;<TAG>$ - THROW TO <TAG>, RETURNING 1 (OR F;'S ARG, IF ANY) FROM THE F<...>.
FSEMIC: TRZN FF,FRARG
MOVEI C,1
SAVE C
CALL OARG ;READ <TAG> INTO BAKTAB, WITH "!"'S.
;NOW LOOK AT ALL ITERATIONS, INNERMOST FIRST, FOR ONE WHICH
;IS A CATCH WITH THE APPROPRIATE TAG.
HRRZ E,ITRPTR
FSEMI1: JUMPE E,[TYPRE [UCT]] ;UNSEEN CATCH TAG.
CALL FSEMIP ;IS THIS ITERATION A CATCH?
JRST FSEMI2 ;NO, LOOK AT NEXT ONE OUT.
IBP BP
MOVEI D,BAKTAB ;YES, COMPARE ITS TAB WITH <TAG>.
MOVE A,MFCCNT-MFBLEN+1(E)
FSEMI3: SOJL A,FSEMI2 ;F< TAG ENDED TOO SOON - MISMATCH.
ILDB TT,BP
CAIL TT,"A+40 ;CONVERT L.C. LETTERS TO U.C.
CAILE TT,"Z+40
CAIA
SUBI TT,40
CAME TT,(D)
JRST FSEMI2 ;THE CHARS DIFFER.
ADDI D,1 ;ADVANCE TO NEXT CHAR IN <TAG>
CAME D,J
JRST FSEMI3
;WE'VE FOUND A CATCH WITH OUR TAG!
REST LASTER ;VALUE TO BE RETURNED FROM F<...>, WHERE ERRP3 WANTS IT.
SETOM ERRFLG ;FAKE INCMA2 INTO RETURNING NEGATIVE.
FSEMI4: HRRO A,ITRPTR ;POP OFF ALL ITERATIONS INSIDE THE
CAIN E,(A) ;CATCH WE'RE POPPING TO.
JRST [ HRLM E,ITRPTR ;THEN PRETEND THIS CATCH WAS AN ERRSET
JRST ERRP3] ;AND ERR OUT OF IT.
CALL ITRPOP
JRST FSEMI4
;COME HERE IF ITERATION ISN'T A CATCH, OR HAS WRONG TAG.
FSEMI2: HRRZ E,MFLINK-MFBLEN+1(E)
JRST FSEMI1
;E -> AN ITERATION FRAME. SKIP IF THAT ITERATION IS REALLUY A
;CATCH. IN THAT CASE, RETURN IN BP B.P. TO ILDB THE "<".
FSEMIP: MOVE BP,MFCPTR-MFBLEN+1(E)
SUBI BP,1 ;BACK UP BP BY 2 CHARS.
REPEAT 3,IBP BP
ILDB C,BP ;FETCH THE CHAR BEFORE THE "<"
CAIE C,"F+40
CAIN C,"F ;IF IT'S "F", THIS ITERATION'S A CATCH.
AOS (P)
RET
SUBTTL ^P SORT COMMAND
;THE SORT TABLE IS A TABLE OF POINTERS TO SORT RECORDS.
;PSMEM POINTS AT THE FIRST ENTRY. PSMEMT POINTS PAST THE LAST ONE.
;EACH ENTRY IS 4 (LPSDBK) WORDS LONG.
;THE 1ST WORD OF AN ENTRY IS EITHER A B.P. TO THE START OF THE RECORD'S KEY
;OR THE KEY ITSELF IF IT IS A NUMBER.
;THE SECOND WORD'S RH IS THE LENGTH OF THE KEY IF THE KEY IS A STRING,
;OR -1 IF THE KEY IS A NUMBER.
;THE SECOND WORD'S LH IS MINUS THE LENGTH OF THE RECORD IN CHARACTERS.
;THE THIRD WORD IS THE CHAR ADDR OF THE START OF THE RECORD.
;THE FOURTH WORD POINTS TO THE NEXT ENTRY (IN ORIGINAL ORDER BEFORE SORT,
;IN SORTED ORDER AFTER. THIS IS THE LINK FOR A LIST SORT).
PSORT: ISKERR ;CAN'T SORT WITHIN SORT.
SAVE FF ;REMEMBER FRCLN (PSI SETS IT)
MOVE CH,[JRST [
CALL RCH ;READ CHAR,
SKIPGE SQUOTP ;SUPERQUOTED =>
JRST INSDIR ;JUST INSERT.
CAIE CH,"$ ;ELSE REPLACE $ BY ALTMODE
JRST INSDCK
MOVEI CH,ALTMOD
JRST INSDIR]] ;AND CHECK FOR DELIMITER UNLESS DELIM PROTECTED.
MOVEM CH,INSRCH
MOVE CH,QRB..
ADDI CH,.QKS ;GET ARGS
CALL PSI ;IN PSEUDO Q-REGS
MOVE CH,QRB..
ADDI CH,.QKE
CALL PSI
MOVE CH,QRB..
ADDI CH,.QDL
CALL PSI
CALL MEMTOP
MOVEM P,PSSAVP ;INDICATE A SORT IS IN PROGRESS.
MOVEM A,PSMEM
MOVEM A,PSMEMT
MOVE T,A
SETZM PSZF
MOVE TT,ZV
SUB TT,BEGV ;# CHARS IN RANGE BEING EDITED.
JUMPE TT,PSXIT ;SORTING NO CHARS IS NOOP.
MOVE C,BEGV ;START FROM BEGINNING
MOVEM C,PT
;DROPS THROUGH.
;DROPS THROUGH.
;LOOP HERE TO DELIMIT THE NEXT RECORD AND ITS KEY.
PS4: SUB C,BEG ;KEEP ALL ADDRS RELATIVE TO BEG IN CASE IMPURE STRINGS MOVE BUFFER.
MOVEM C,2(T) ;3RD WORD OF POINTER: CHAR ADDR OF RECORD.
PUSH P,C
MOVE A,QRB..
MOVE A,.QKS(A) ;FIND BEGINNING OF KEY
CALL MACXQ
MOVE T,PSMEMT
MOVE C,PT
SUB C,BEG ;FOR NOW, KEEP CHAR ADDR REL BUFFER, WILL CHANGE TO BP LATER.
PUSH P,C
MOVEM C,(T) ;IS 1ST POINTER WORD
MOVE A,QRB..
MOVE A,.QKE(A) ;FIND END OF KEY
PUSHJ P,PS2
SKIPGE C ;BARF IF THE KEY IS NEGATIVE IN LENGTH (WOULD THINK IT WAS NUMERIC).
TYPRE [ISK]
TRNN FF,FRARG ;IF "END OF KEY" MACRO RETURNS A VALUE, THAT VALUE IS THE KEY.
JRST PS8
MOVE A,NUM ;STORE IT INSTEAD OF THE CHAR ADDR OF THE KEY.
MOVEM A,(T) ;STORE -1 AS "KEY LENGTH" TO IDENTIFY THIS KEY AS NUMBER
MOVNI C,1 ;INSTEAD OF A STRING.
PS8: MOVEM C,1(T) ;#CHARS IN KEY FOR RH(2ND WORD OF TABLE ENTRY)
MOVE A,QRB..
MOVE A,.QDL(A) ;FIND NEXT RECORD
PUSHJ P,PS1
PS7: MOVNS C
SKIPL C
TYPRE [ESR] ;SORT-RECORD WITH NO CHARACTERS (OR NEGATIVE NUMBER???)
HRLM C,1(T) ;-LENGTH OF RECORD FOR AOBJN
ADDI T,LPSDBK ;NEXT POINTER
MOVEM T,PSMEMT
MOVE C,PT
SKIPL PSZF ;DID WE RUN OUT
JRST PS4 ;NO
MOVE A,ZV
MOVEM A,PT
CALL GAPSLP
MOVEI C,20. ;MAKE SURE THERE'S A GAP AFTER RANGE BEING
CALL SLPSAV ;SORTED, SO BLT OF SORTED STUFF WON'T CLOBBER A FEW CHARS.
MOVE A,PSMEM ;LOWER BOUND
MOVE B,PSMEMT ;UPPER BOUND.
PS7A: CAMN A,B ;NOW CONVERT ADDRS REL. TO BEG TO WHAT WE REALLY WANT.
JRST PS7B ;ALL RECORDS HANDLED.
HRRE E,1(A)
JUMPL E,PS7C ;IF THE KEY IS A STRING, NOT A NUMBER,
MOVE E,(A) ;GET ADDR START OF KEY,
ADD E,BEG
IDIVI E,5 ;CONVERT TO BP. TO 1ST BIT.
ADD E,BTAB-1(J)
TLZ E,17
MOVEM E,(A)
PS7C: ADDI A,LPSDBK
MOVE E,A
SUB E,PSMEM
MOVEM E,-1(A) ;MAKE ENTRY'S 3RD WD POINT TO NEXT ENTRY.
JRST PS7A ;DO NEXT RECORD.
PS1: SKIPGE PSZF ;ALREADY AT END => NOOP INSTEAD OF USER'S MACRO.
JRST PS2A
PS2: CALL MACXQ
PS2A: MOVE T,PSMEMT
POP P,J ;RETURN POINT
POP P,E ;OLD PT-BEG
ADD E,BEG
MOVE C,PT
CAML C,ZV ;IF WE'RE AT THE END OF THE BUFFER
SETOM PSZF ;THEN THIS RECORD IS THE LAST ONE.
SUB C,E ;# CHARS IN C
JRST (J)
;RETURN IN A A PTR TO THE 1ST UNUSED WORD OF HIGH MEM.
MEMTOP: MOVE A,BFRTOP
IDIVI A,5
SUBI A,3
SKIPE PSSAVP
MOVE A,PSMEMT
ADDI A,4
POPJ P,
PS7B: SETOM -1(A) ;LAST ENTRY'S LINK WORD IS NIL.
MOVE A,(P) ;RESTORE FRCLN AS IT WAS AT CALL TO PSORT.
TRNE A,FRCLN
IORI FF,FRCLN
HRRZ J,PSMEMT ;DYNAMICALLY ALLOCATED PDL
PUSHJ J,PS3 ;SORT POINTERS
HRRZ J,PSMEMT ;ZERO OUT THE CORE WE WILL COPY THE SORTED RECORDS INTO
HRLS J ;SO THAT THE LOW BITS WILL NOT BE SET.
SETZM (J)
ADDI J,1
MOVE T,MEMT
LSH T,10.
BLT J,-1(T)
MOVE T,BEGV ;SET UP FOR LATER BLTING DOWN THE COPIED RECORDS INTO THE
IDIVI T,5 ;ORIGINAL SPACE.
HRRM T,J ;DESTINATION = WORD CONTAINING BEGV
MOVE CH,(T) ;MUST HAVE CHARS BEFORE BEGV IN WD
HLL C,BTAB-1(TT) ;GET BPT TO NEW BUFFER AREA
TLZ C,77
HRR C,PSMEMT ;WHICH OVERWRITES SORT PDL
HRLM C,J ;SOURCE FOR BLT
MOVEM CH,(C) ;SAVE CHARS
PS6: ADD A,PSMEM ;CHANGE REL PTR TO ABS, -> NEXT TAB ENTRY.
HLRE E,1(A) ;- # CHARS IN RECORD.
JUMPE E,PS5
MOVE BP,2(A) ;CHAR ADDR START OF RECORD.
ADD BP,BEG
CALL GETIBP
PS6A: ILDB CH,BP ;MOVE THE RECORD.
IDPB CH,C
AOJL E,PS6A
PS5: MOVE A,3(A) ;GET PTR TO NEXT RECORD'S ENTRY.
JUMPGE A,PS6 ;IF THERE IS ANOTHER, LOOP BACK.
MOVE A,ZV
IDIVI A,5
BLT J,1(A) ;DONE, MOVE IT DOWN
CALL FLSCOR
PSXIT: SETZM PSSAVP ;TURN OFF SORT FLAG.
MOVE A,BEGV
MOVEM A,PT
JRST POP1J
;ACTUALLY SORT THE LIST OF SORT TABLE ENTRIES,
;BY REARRANGING THE LINK WORDS SO THAT THEY ARE LINKED
;IN SORTED ORDER.
PS3: SETZ E, ;POINT TO THE HEAD OF THE LIST O SORT.
MOVE C,PSMEMT ;C _ LENGTH(E)
SUB C,PSMEM
LSH C,-2
;(DEFUN NSORT (N) (COND ((= N 1) (CHOP1))
; (T (MERGE (NSORT (/ N 2)) (NSORT (- N (/ N 2)))))))
;E HOLDS L, C HOLDS N, J USED AS PDL PTR, VALUE RETURNED IN A.
PS3NSORT: CAIN C,1
JRST PS3NS1
PUSH J,C
LSH C,-1 ;THIS IS N/2
PUSHJ J,PS3NSORT ;(NSORT (/ N 2))
POP J,C
PUSH J,A
AOJ C,
LSH C,-1 ;(- N (/ N 2))
PUSHJ J,PS3NSORT ;(NSORT (- N (/ N 2)))
POP J,C ;A, C HAVE ARGS TO MERGE.
MOVEI B,D ;B -> TAIL OF ACCUMULATED MERGED LIST,
;D WILL EVENTUALLY POINT TO ITS HEAD.
PS3MRG: JUMPL C,PS3TK1 ;1ST ARG EMPTY => TAKE FROM 2ND.
JUMPL A,PS3TKB ;2ND EXHAUSTED => TAKE FROM FIRST.
MOVE TT,PSMEM ;ELSE GET PTRS TO AND SIZES OF THE KEYS
MOVE TT1,PSMEM
ADD TT,A ;BELONGING TO THE HEADS OF 1ST AND 2ND ARG.
ADD TT1,C
TRNE FF,FRCLN ;@ ^P - SORT IN REVERSE ORDER.
EXCH TT,TT1
MOVE CH,(TT) ;CH IS BP TO ILDB KEY OF 2ND,
MOVE Q,(TT1) ;Q, FOR 1ST.
HRRE TT,1(TT) ;# CHARS IN KEY OF 2ND,
HRRE TT1,1(TT1) ;SAME FOR 1ST.
JUMPGE TT1,PS3CM3
JUMPGE TT,PS3TKB ;1ST KEY A NUMBER, 2ND A STRING => 1ST IS LESS.
CAMLE Q,CH
JRST PS3TKA ;BOTH NUMBERS => 1ST KEY NUMBER GREATER => TAKE 2ND.
JRST PS3TKB
PS3CM3: JUMPL TT,PS3TKA ;2ND KEY A NUMBER, 1ST A STRING => 2ND IS LESS.
;COMPARE TWO KEYS WHICH ARE STRINGS, GO TO PS3TKA IF 2ND KEY IS LESS, ELSE PS3TKB.
PS3CMP: SOJL TT1,PS3TKB ;FIRST KEY ENDED, IT IS .LE., SO USE IT.
SOJL TT,PS3TKA ;2ND KEY ENDED, IT IS .L., TAKE 2ND.
ILDB T,CH ;ELSE LOOK AT NEXT CHAR OF EACH.
ILDB BP,Q
SKIPN PSCASE ;IF WE SHOULD IGNORE CASE,
JRST PS3CM1
CAIGE T,"A+40
JRST PS3CM2
CAIG T,"Z+40
SUBI T,40
PS3CM2: CAIGE BP,"A+40
JRST PS3CM1
CAIG BP,"Z+40
SUBI BP,40
PS3CM1: CAIN T,(BP)
JRST PS3CMP ;CHARS EQUAL => KEEP LOOKING.
CAIG T,(BP)
JRST PS3TKA ;CHAR FROM 2ND IS LESS, TAKE 2ND.
PS3TKB: MOVEM C,(B) ;"TAKE 1ST"; ENTRY AT HEAD OF 1ST ARG
ADD C,PSMEM ;IS LESS THAN THAT AT HEAD OF 2ND, SO
MOVEI B,3(C) ;TRANSFER IT TO TAIL OF MERGED LIST
MOVE C,(B) ;AND ADVANCE DOWN THE 1ST ARG.
JRST PS3MRG
PS3TKA: MOVEM A,(B) ;"TAKE 2ND"; LIKE "TAKE 1ST" BUT FOR 2ND ARG.
ADD A,PSMEM
MOVEI B,3(A)
MOVE A,(B)
JRST PS3MRG
PS3TK1: JUMPGE A,PS3TKA ;1ST EXHAUSTED; 2ND ISN'T => TAKE 2ND.
SETOM (B) ;BOTH ARGS EXHAUSTED => MERGE FINISHED, TERMINATE LIST.
MOVE A,D ;RETURN VALUE IN A.
POPJ J,
PS3NS1: MOVEI A,(E) ;(NSORT 1) COMES HERE.
ADD E,PSMEM ;RETURN THE HEAD OF LIST TO BE SORTED,
MOVE T,E
MOVE E,3(T) ;REPLACING THAT LIST WITH ITS CDR,
SETOM 3(T) ;AND MAKING THE HEAD'S CDR NIL.
POPJ J,
SUBTTL INPUT FROM FILES
APPEND: ARGDFL
TRZE FF,FRCLN
JRST APPNDL
TRZN FF,FRARG
JRST YANK2
ADD C,PT
SOS IN,C
CAMGE IN,ZV
CAMGE IN,BEGV
JRST APPND2 ;J IF OUT OF RANGE OF BUFFER.
ANDCMI FF,FRARG2
PUSHJ P,GETCHR
MOVE A,CH
JRST POPJ1
APPND2: TRZN FF,FRARG2 ;IF ONLY ARG, OUT OF RANGE IS ERROR.
TYPRE [NIB]
MOVE A,E ;2 ARGS => RETURN 1ST ARG.
JRST POPJ1
APPNDL: TRNN FF,FRARG ;<N>:A - APPEND <N> LINES, OR TO ^L,
MOVEI C,1 ;WHICHEVER COMES FIRST.
TLNN FF,FLIN
RET
SAVE PT
MOVE OUT,ZV ;TEMPORARILY PUT PT AT END SO
MOVEM OUT,PT ;TYOM WILL INSERT AT END.
CALL GAPSLP
APPNL2: PUSHJ P,UTYI
SKIPN FFMODE
CAIE CH,^L
SKIPL LASTPA ;AT EOF => UTYI WAS RETURNING DUMMY CHARS; IGNORE THEM.
JRST APPNL1
PUSHJ P,TYOM
CAIN CH,^L
JRST APPNL1
CAIE CH,^J ;END OF LINE
JRST APPNL2
SOJG C,APPNL2
APPNL1: REST PT
CAIE CH,^L
RET
AOS PAGENU
;CLOSE THE INPUT FILE IF IT IS EMPTY EXCEPT FOR PADDING.
APPNL4: CALL UTYI ;READ AHEAD 1 CHAR TO SEE IF ANYTHING
SKIPL LASTPA ;IS LEFT IN THE FILE.
RET ;NO => LEAVE FILE MARKED "EOF".
MOVE A,UTYIP ;ELSE ARRANGE TO RE-READ THAT CHAR.
DBP7 A
MOVEM A,UTYIP
POPJ P,
;Y => READ ONE PAGE FROM THE OPEN INPUT FILE,
;DESTROYING PREVIOUS CONTENTS OF BUFFER.
;IF NO FILE OPEN, JUST EMPTY THE BUFFER.
;THE FS YDISABLE$ FLAG MAY TURN Y INTO AN ERROR.
;@ Y READS IN ALL THE REST OF THE FILE.
YANK: SKIPGE YDISAB
IORI FF,FRUPRW ;YDISAB NEGATIVE => Y IS @Y.
SKIPLE YDISAB
TYPRE [DCD] ;FS YDISABLE POSITIVE => "Y" IS ILLEGAL.
YANKEE: MOVE E,BEGV
MOVE C,ZV ;FIRST, KILL CURRENT CONTENTS.
CALL DELET1
YANK2: TLNN FF,FLIN
JRST UTLSTP ;NO FILE OPEN => INSERT NOTHING.
TRNE FF,FRUPRW
JRST YANKAL ;"@ Y" IS HANDLED SEPARATELY.
MOVE BP,ZV ;GET PLACE TO INSERT AT.
EXCH BP,PT ;GET GAP THERE.
CALL GAPSLP
MOVEM BP,PT
MOVE BP,BEG
CAME BP,Z ;IF BUFFER IS EMPTY NOW,
JRST YANK3
MOVE BP,BEG ;ADJUST VALUE OF BEG SO THAT
IDIVI BP,5 ;THE BUFFER STARTS IN THE SAME PART OF A WORD
;AS THE EMPTY PART OF UTOBUF FOR ORDINARY Y.
HLL BP,UTYOP ;(MAKES IT MORE LIKELY THAT PW CAN GO FAST)
TLNN BP,760000 ;MAKE SURE WE DON'T MOVE BEG TO
SUBI BP,1 ;A DIFFERENT WORD.
CALL GETCA ;TURN INTO CHAR ADDR OF LAST CHAR BEFORE BUFFER
SUB BP,BEG
AOS TT,BP ;TURN INTO DISPLACEMENT OF NEW BEG FROM OLD
ADDB TT,BEG ;UPDATE BEG.
CAMGE TT,BFRBOT ;NEW BEG ISN'T SUPPOSED TO BE OUTSIDE BUFFER SPACE.
.VALUE
ADDM BP,BEGV ;SHIFT ALL THE OTHER BUFFER POINTERS JUST LIKE BEG
ADDM BP,PT
ADDM BP,GPT
ADDM BP,Z
ADDM BP,ZV
MOVNS BP
ADDM BP,EXTRAC
YANK3: MOVE BP,ZV
AOS PAGENU
SAVE D
PUSHJ P,GETIBP
MOVE OUT,BP
MOVE IN,[YPG,,A]
BLT IN,BP
MOVE IN,UTYIP
SKIPN Q,EXTRAC
JRST YPGNRM
JRST A
YPG: ILDB CH,IN ;A
CAIE CH,EOFCHR ;B
CAIN CH,14 ;C
JRST YPG1 ;D
IDPB CH,OUT ;E
SOJG Q,A ;J
JRST YPGNRM ;BP
YPG1: MOVEM IN,UTYIP ;WE JUST ILDB'D ^C OR ^L.
HRRZ TT,IN
CAIN TT,UTIBE
JRST YPG2 ;JUST END OF UTIBUF - RELOAD IT.
CAIE CH,EOFCHR
JRST YPG3 ;IT WAS A ^L - GO INSERT IT AND RETURN.
CAME IN,UTRLDT
JRST E ;^C INSIDE THE FILE - INSERT IT AND KEEP GOING.
CALL UTLSTP ;EOF - MARK FILE AS AT EOF.
YPG1A: MOVE BP,OUT
CALL GETCA
AOS BP
MOVE E,ZV ;GET PLACE WHERE INSERTED FILE STARTS, FOR YANKX'S USE.
CALL YPG1B ;UPDATE BUFFER BLOCK FOR CHARS WE HAVE READ IN.
REST D
JRST YANKX ;NOW MAYBE DELETE PADDING OR A TRAILING ^L.
YPG1B: MOVEM BP,GPT
SUB BP,ZV ;# CHARS YANKED.
ADDM BP,Z
ADDM BP,ZV
MOVNS BP
ADDM BP,EXTRAC
POPJ P,
YPG3: IDPB CH,OUT ;ENCOUNTERED A ^L - INSERT IT,
CALL APPNL4 ;MARK THE FILE CLOSED IF THERE'S NOTHING LEFT IN IT
JRST YPG1A ;THEN FINISH UP AS IF REACHED EOF.
YPG2: CALL UTRLD2 ;EOB AND CAN'T GO FAST, RELOAD UTIBUF.
MOVE IN,UTYIP
JRST A ;TRY AGAIN TO READ A CHARACTER.
YPGNRM: SAVE C ;COME HERE WHEN RUN OUT OF GAP TO YANK INTO.
MOVE C,EXTRAC
ADDI C,5*<UTIBE-UTIBUF> ;C <- AMOUNT OF GAP WE WANT.
MOVN Q,EXTRAC
CALL SLPSAV
REST C
ADD Q,EXTRAC
JRST A
;HANDLE "@Y" AND "@A" - READ IN ALL OF INPUTR FILE, THEN
;REMOVE PADDING FROM END, AND MAYBE REMOVE A TRAILING ^L.
YANKAL: MOVE C,ZV
SAVE C ;MOVE POINT TO ZV, SAVING ZV AND OLD POINT.
EXCH C,PT
SAVE C
CALL FYCMDA ;THEN INSERT THE WHOLE FILE THERE.
CALL GAPSLP ;AND MOVE THE GAP TO THE END OF WHAT WAS INSERTED.
REST PT ;POINT IS NOW SAME AS AT ENTRY, BUT GPT = ZV.
REST E ;THIS IS OLD VALUE OF ZV - WHERE THE FILE STARTS.
CALL UICLS
CALL YANKX ;DELETE PADDING CHARS AT END.
JRST FLSCM1 ;FLUSH EXCESS CORE.
;DELETE BACKWARDS FROM GPT ALL CONSECUTIVE ^C'S AND ^@'S;
;THEN, IF FS ^LINSERT$ IS 0, DELETE A FORMFEED IF ANY.
;REFUSES TO DELETE BACK PAST WHERE E POINTS.
YANKX: MOVE IN,GPT
YANKX1: MOVEI C,1
CAMN E,IN
RET
SOS IN
CALL GETCHR
CAIE CH,^C
JUMPN CH,YANKX2
SOS GPT
CALL DELETB ;DELETE 1 CHAR AFTER GPT (SINCE C HAS 1).
JRST YANKX1
YANKX2: CAIN CH,^L ;GOT ALL ^C'S AND ^@'S - NOW MAYBE TAKE A ^L.
SKIPE FFMODE
RET
SOS GPT
JRST DELETB
;INSERT ALL OF THE OPEN INPUT FILE BEFORE POINT.
;FY WITH NO ARGUMENT USES THIS, AS DOES "@Y".
FYCMDA: CALL FSIFLEN ;HOW MUCH SPACE DO WE NEED?
JFCL
JUMPL A,FYCMD7
MOVE C,A ;SAVE FILE SIZE FOR FYPMAP.
IFN ITS,[
SYSCAL RFPNTR,[%CLIMM,,CHFILI ? %CLOUT,,B]
SETZ B,
];ITS
IFN TNX,[
MOVE A,CHFILI
RFPTR
TDZA B,B ;FAILED, ASSUME 0 BUT DONT PMAP
JUMPE B,FYPMAP ;IF AT START OF FILE STILL, CAN READ IT IN FAST
]
IMULI B,5 ;IF WE ARE NOT POINTING AT THE FRONT OF THE FILE, WE DON'T
SUB C,B ;HAVE AS MUCH TO READ, SO WE DON'T NEED AS MUCH SPACE.
SKIPGE C ;IF KNOW HOW MUCH SPACE, READ WHOLE FILE AT ONCE.
FYCMD7: MOVEI C,2000*5 ;ELSE GET 1K AT A TIME.
CALL FYCMD6 ;READ THAT MUCH.
SKIPE LASTPA ;IS THERE ANY MORE IN THE FILE?
JRST FYCMD7 ;YES, SO GET MORE.
RET
IFN TNX,[
;THIS CODE WORKS ON ITS, BUT LOSES IF DSK IS TRANSLATED,
;AND PROVES TO OFFER NO IMPROVEMENT IN EFFICIENCY ON ITS.
;MAP IN INPUT FILE USING PAGING. ASSUMES FILE IS ON DISK
;AND THAT WE ARE MAPPING THE WHOLE FILE. C HAS FILE SIZE IN CHARS.
FYPMAP: CALL GAPSLP ;MOVE GAP TO PT
SAVE C ;SAVE SIZE OF INPUT FILE
MOVE A,GPT
IDIVI A,PAGSIZ*5 ;GET PAGE TO START MAPPING INTO
JUMPE B,.+2 .SEE CIRC
AOJ A,
SAVE A ;SAVE PAGE NUMBER
IMULI A,PAGSIZ*5 ;GET CHARACTER ADDRESS
IDIVI C,PAGSIZ*5 ;GET NUMBER OF PAGES IN INPUT FILE
JUMPE D,FYPMA1 .SEE CIRC
AOJ C,
SUBI D,PAGSIZ*5 ;D IS -<NUMBER OF CHARACTERS AFTER FILE TO END OF PAGE>
FYPMA1: SAVE C ;SAVE IT
IMULI C,PAGSIZ*5 ;BACK INTO CHARACTERS
SUB C,GPT ;GET SIZE OF GAP WE WILL NEED FOR ALL THIS
ADDB C,A ;END OF LAST PAGE TO BE MAPPED
CALL SLPSAV ;MAKE SURE THERE IS THAT MUCH ROOM FOR IT
SUB A,EXTRAC ;COMPUTE SIZE OF GAP AFTER END OF NEW PAGES
ADD D,A ;D IS -<TOTAL ROOM AFTER END OF NEW TEXT>
MOVE B,-1(P) ;FIRST PROCESS PAGE
IFN ITS,[
REST C
MOVNS C
HRL B,C ;B GETS -NPAGES,,FIRSTPAGE
SYSCAL CORBLK,[%CLIMM,,%CBCPY+%CBWRT ? %CLIMM,,%JSELF ? B ?%CLIMM,,CHFILI]
.LOSE %LSSYS
]
IFN TNX,[
IFN 20X,[
HRLZ A,CHFILI ;GET INPUT FILE AGAIN
HRLI B,.FHSLF
REST C ;NUMBER OF PAGES AGAIN
HRLI C,(PM%CNT\PM%RD\PM%CPY\PM%PLD) ;READ, COPY, PRELOAD
PMAP ;READ IN THE WHOLE FILE.
]
.ELSE [
HRLZ A,CHFILI ;GET INPUT FILE AGAIN
HRLI B,.FHSLF
REST T ;COUNT OF PAGES TO MAP
JUMPE T,FYPMA3 ;EMPTY FILE DOES NO PMAPS
MOVSI C,(PM%RD\PM%EX\PM%CPY) ;THIS IS THE SECOND BIGGEST CROCK
FYPMA2: PMAP
SOJLE T,FYPMA3
AOJ A,
AOJA B,FYPMA2
FYPMA3:
];NOT 20X
];TNX
REST A ;GET FIRST PAGE AGAIN
IMULI A,PAGSIZ*5 ;GET CHARACTER ADDRESS OF START OF MAPPED IN FILE
SUB A,GPT ;COMPUTE NEW SIZE OF GAP ON THIS END
MOVEM A,EXTRAC
REST A ;SIZE OF INPUT FILE AGAIN
ADDM A,PT ;PT TO END OF STUFF JUST INSERTED
ADDM A,ZV
SUB A,D ;FOR NOW SET END HIGH SO GETS BLTED ALONG WITH REST OF
ADDM A,Z
CALL SLPSHT ;CLOSE UP THE LOWER GAP
ADDM D,Z ;FIX UP END OF BUFFER
MOVNM D,EXTRAC ;SIZE OF UPPER GAP
JRST UTLSTP ;TELL EVERYONE AT EOF NOW
];TNX
;<N>FY - READ <N> CHARACTERS FROM THE INPUT FILE, OR UNTIL EOF,
;AND INSERT THEM IN THE BUFFER BEFORE POINT. NO PADDING CHARACTERS ARE
;FLUSHED, SO ALL IS UNDER PROGRAMMER CONTROL. IF THE TRANSFER GOES TO A WORD
;BOUNDARY, AND STARTS AT A WORD BOUNDARY IN THE FILE, THEN IT IS
;SUITABLE FOR READING IN BINARY DATA. TO MAKE THAT HAPPEN, WE SOMETIMES
;INSERT SOME SPACES IN THE BUFFER TO PRODUCE CORRECT ALIGNMENT,
;AND THEN DELETE THEM WHEN FINISHED READING.
FYCMD: TLNN FF,FLIN
TYPRE [NFI]
TRNN FF,FRARG
JRST FYCMDA ;NO ARG => READ THE WHOLE FILE.
JUMPL C,TYPAOR ;NEGATIVE ARG NOT ALLOWED.
FYCMD6: SAVE C
MOVE BP,UTYIP ;FOR SPEED, LEAVE ENOUGH SPACE BEFORE INSERTING THE FILE
CALL GETCA ;TO ENABLE TRANSFER TO GO WORDWISE.
MOVEI BP,1(BP)
SUB BP,PT
IDIVI BP,5
SKIPE BP,T
ADDI BP,5
SAVE BP
ADD C,BP ;THAT MUCH, PLUS # CHARS BEING READ, IS AMT OF SPACE WE NEED.
CALL GAPSLP ;GET GAP TO POINT.
CALL SLPSAV ;MAKE SURE THERE'S ENOUGH SPACE.
CALL IMMQIT ;ALLOW QUITTING IF WE HANG UP DOING THE I/O
MOVE C,-1(P)
MOVE BP,PT
ADD BP,(P) ;LEAVE THE FEW CHARS OF SPACE TO REACH PROPER ALIGNMENT.
CALL GETIBP ;CREATE B.P. FOR IDPB'ING INTO THE GAP.
FYCMD0: JUMPE C,FYCMDE
MOVE A,UTYIP ;AND LOOK AT B.P. WE'LL ILDB FROM.
HRRZ B,UTRLDT
ADD B,[(010700)-1]
FYCMDW: TLNN A,760000
JRST FYCMD1 ;JUMP IF CAN START GOING WORD-WISE.
FYCMDS: CAMN A,B
JRST FYCMDR ;IF UTIBUF EXHAUSTED, MUST RELOAD IT.
ILDB CH,A ;OTHERWISE, TRANSFER ONE MORE CHARACTER
IDPB CH,BP
SOJG C,FYCMDW
MOVEM A,UTYIP
FYCMDE: CALL UTEOF ;IF THERE'S NOTHING LEFT IN THE INPUT FILE, MARK IT "AT EOF".
CALL DELQIT
MOVE E,-1(P)
SUB E,C ;# CHARS ACTUALLY READ IN
ADD E,(P) ;PLUS # CHARS OF SPACE LEFT AT FRONT.
ADDM E,GPT ;"INSERT" THE DATA AND THE SPACE AT FRONT.
ADDM E,ZV ;BUT DON'T CHANGE POINT, YET.
ADDM E,Z
SUBM E,EXTRAC
MOVNS EXTRAC
REST C ;C HAS # CHARS OF SPACE THAT'S NOW IN THE BUFFER
SUB P,[1,,1]
JUMPE C,FYCMD8
SUB E,C ;E HAS # CHARS OF REAL DATA NOW INSERTED.
CALL GAPSLP ;GET GAP TO POINT, WHICH STILL POINTS VBEFORE THE SPACE
CALL DELETB ;AND DELETE THE SPACE.
FYCMD8: ADDM E,PT ;NOW MAKE POINT GO AFTER THE INSERTED DATA.
RET
FYCMDR: CAME A,[010700,,UTIBE-1]
JRST FYCMDE ;IF LAST INPUT BUFFER WASN'T FULL, THIS IS EOF.
CALL UTRLD2 ;ELSE, READ ANOTHER INPUT BUFFER AND CONTINUE TRANSFERING.
JRST FYCMD0
;HERE TO ATTEMPT A WORD-WISE TRANSFER.
FYCMD1: MOVEM A,UTYIP
CAIGE C,5 ;DON'T BOTHER TRYING TO GO FAST IF < 1 WHOLE WORD LEFT.
JRST FYCMDS
IDIVI C,5 .SEE D
IBP BP
SUB B,A ;IF THEER'S ANYTHING LEFT IN UTIBUF, MUST USE IT FIRST.
JUMPE B,FYCMDI ;LH'S CANCEL SINCE BOTH ARE 010700.
IBP A
HRL BP,A
CAMLE B,C ;# WORDS TO TRANSFER RIGHT NOW =
MOVE B,C ;MIN (<WORDS LEFT IN UTIBUF>, <WORDS WANTED>).
ADDM B,UTYIP ;REMOVE THAT MANY WORDS FROM THE BUFFER.
SUB C,B ;# WORDS THAT WILL BE LEFT EMPTY AFTER USING UP UTIBUF?
ADD B,BP
BLT BP,-1(B) ;TRANSFER WHAT'S LEFT OF UTIBUF.
IMULI C,5
HRRZ BP,B
JRST FYCMD2
;GOING WORD AT A TIME, AND UTIBUF IS EMPTY, SO GET DIRECTLY FROM FILE.
FYCMDI:
IFN ITS,[
CAIGE C,100000 ;DON'T TRY TO IOT MORE THAN 32K AT A TIME.
JRST FYCMD4
IMULI C,5
ADD D,C ;SO PUT TOTAL # CHARS TO GET, MINUS 32K OF CHARS, IN D,
SUBI D,5*100000
MOVEI C,100000 ;AND GET ONLY 32K RIGHT NOW.
FYCMD4: MOVNS C
HRL BP,C ;AOBJN -> BUFFER WORDS TO TRANSFER INTO.
.IOT CHFILI,BP
HLRE C,BP
]
IFN TNX,[
SAVE B
MOVE A,CHFILI ;INPUT FILE
MOVEI B,(BP) ;FIRST WORD TO READ INTO
HRLI B,444400
MOVNS C
SIN
MOVEI BP,1(B) ;UPDATE FIRST WORD NOT READ INTO
HRL BP,C ;UPDATE COUNT LEFT TO DO
REST B
]
IMUL C,[-5]
FYCMD2: ADD C,D ;# CHARS WE WERE SUPPOSED TO TRANSFER BUT HAVEN'T YET.
JUMPL BP,FYCMD3 ;EOF => WE WILL NEVER GET THEM, SO INSERT WHAT WE HAVE GOT.
ADD BP,[(010700)-1] ;GET BACK B.P. TO IDPB THE REST OF THE DATA
JRST FYCMD0 ;RELOAD BUFFER TO XFER LAST FEW CHARS 1 AT A TIME.
FYCMD3: CALL UTLSTP
JRST FYCMDE
;READ NEXT CHARACTER FROM OPEN INPUT FILE, AND RETURN IT IN CH.
;UP TO A WORD OF ^C'S OR ^@'S BEFORE THE END OF THE FILE WILL BE IGNORED.
;IF TRY TO READ PAST EOF, FS LASTPAGE$ WILL BE SET TO 0, AND ^L WILL BE RETURNED.
UTYI: ILDB CH,UTYIP
CAILE CH,EOFCHR
RET
CAIE CH,EOFCHR
JUMPN CH,CPOPJ
HRRZ CH,UTYIP
CAIN CH,UTIBE
JRST UTYIR ;EXHAUSTED BUFFER => REALOD IT AND TRY AGAIN.
UTYI4: MOVE CH,UTYIP
CAMN CH,UTRLDT
JRST UTYIE ;READ PAST EOF => CLOSE FILE AND RETURN A ^L.
;^C OR ^@ INSIDE THE FILE - IS IT PADDING BEFORE EOF?
HRLI CH,010700
IBP CH
CAME CH,UTRLDT ;MORE THAN 1 WORD FROM THE END => IT ISN'T PADDING.
JRST UTYI5
ANDI CH,-1
CAIE CH,UTIBE ;THIS LAST WORD OF INPUT BUFFER => WE DON'T KNOW WHETHER
JRST UTYI1 ;THERE ARE MORE WORDS IN THE FILE,
MOVE CH,UTIBE-1 ;SO FIND OUT BY PUTTING THIS WORD AT BEGINNING OF BUFFER
MOVEM CH,UTIBUF ;AND FILLING UP THE REST IF POSSIBLE.
MOVE CH,UTIBE
MOVEM CH,UTIBUF+1
MOVNI CH,UTIBE-UTIBUF-1
ADDM CH,UTYIP
ADDM CH,UTRLDT
CALL UTRLD3 ;NOW TRY FILLING REST OF INPUT BUFFER.
JRST UTYI4 ;WE NOW HAVE ENOUGH INFO TO ANSWER OUR QUESTION.
;COME HERE WHEN A ^C OR ^@ IS FOUND IN THE LAST WORD OF THE FILE, TO LOOK
;AHEAD AND SEE IF REST OF THE CHARS IN LAST WORD ARE ALL ^C OR ^@.
UTYI1: SAVE UTYIP
UTYI3: ILDB CH,UTYIP
CAIE CH,^C
JUMPN CH,UTYI2
MOVE CH,UTYIP
CAME CH,UTRLDT
JRST UTYI3
SUB P,[1,,1] ;ALL ARE ^C OR ^@ => RETURN CLOSING FILE.
UTYIE: CALL UTLSTP
MOVEI CH,^L
RET
UTYI2: REST UTYIP ;NOT ALL PADDING => THIS ^C OR ^@ IS REALLY DATA, AND SO ARE THE REST.
UTYI5: LDB CH,UTYIP
RET
UTYIR: CALL UTRLD2
JRST UTYI ;GO BACK AND TRY AGAIN
;"EC" COMMAND -- CLOSE THE INPUT FILE AND MARK IT CLOSED.
UICLS: CALL UTLSTP ;FIRST, SET "AT EOF" SO ATTEMPTS TO READ WILL GET ^C'S.
IFN ITS,[
CLOSEF CHFILI
TLZ FF,FLIN
]
.ELSE [
MOVE A,CHFILI
TLZN FF,FLIN
JRST [ JUMPE A,CPOPJ
RLJFN
JFCL
JRST .+3]
CLOSF
JFCL
SETZM CHFILI
]
RET
;REFILL THE INPUT BUFFER.
UTRLD2: MOVE CH,[10700,,UTIBUF-1]
MOVEM CH,UTYIP
IFN ITS,[
SKIPA CH,[UTIBUF-UTIBE,,UTIBUF]
UTRLD3: MOVE CH,[UTIBUF+1-UTIBE,,UTIBUF+1]
.IOT CHFILI,CH
HRRM CH,UTRLDT ;FIRST ADR. NOT LOADED BY SYS
JUMPGE CH,CPOPJ
MOVEI CH,EOFCHR
DPB CH,UTRLDT ;STORE EOF THERE
POPJ P,
]
IFN TNX,[
JSR SAVABC ;SAVE ACS
MOVE B,[444400,,UTIBUF] ;POINTER TO BUFFER
MOVNI C,UTIBE-UTIBUF ;COUNT TO READ
UTRLD4: MOVE A,CHFILI ;INPUT FILE
SIN
AOJ B, ;WILL BE OF THE FORM 004400,,ADDR-1
HRRM B,UTRLDT ;FIRST ADDR NOT LOADED
JUMPE C,POPCBA ;HAVE WE REACHED EOF?
MOVEI CH,EOFCHR ;YES
DPB CH,UTRLDT
JRST POPCBA
UTRLD3: JSR SAVABC
MOVE B,[444400,,UTIBUF+1] ;TRY TO FILL THE REST OF THE BUFFER
MOVNI C,UTIBE-UTIBUF-1
JRST UTRLD4
]
;SEE IF THE INPUT FILE IS AT EOF. IF SO, SET FS LASTPA, ETC.
;TO TELL THE USER THAT IT IS.
UTEOF: SKIPL LASTPA
RET ;ALREADY AT EOF => NO CHANGE.
MOVE CH,UTYIP
IBP CH
CAME CH,UTRLDT ;MORE LEFT IN INPUT BUFFER => NOT EOF
RET
ANDI CH,-1
CAIE CH,UTIBE ;NONE LEFT IN INPUT BUFFER, AND BUFFER WASN'T A FULL ONE,
JRST UTLSTP ;=> CLEARLY AT EOF.
CALL UTRLD2 ;AT END OF BUFFER => TRY READING SOME MORE TO SEE
JRST UTEOF ;IF AT EOF.
;INDICATE THAT THE INPUT FILE IS AT EOF. ALL ATTEMPTS TO READ MORE
;WILL JUST ENCOUNTER ANOTHER EOF.
UTLSTP: SETZM LASTPA ;SAY "EOF" TO ANYONE WHO ASKS.
MOVE CH,[010700,,[.BYTE 7 ? EOFCHR]-1]
MOVEM CH,UTYIP ;SET UP BUFFER TO APPEAR TO BE JUST BEFORE AN EOF
IBP CH ;SO THAT ANY ATTEMPT TO READ A CHARACTER WILL SEE EOF
MOVEM CH,UTRLDT ;AND COME RIGHT BACK HERE.
RET
;FS IF LENGTH$ - READ LENGTH OF OPEN INPUT FILE.
FSIFLEN:TLNN FF,FLIN
TYPRE [NFI]
MOVEI A,CHFILI
IFN ITS,[
FSIFL1: SYSCAL FILLEN,[A ? %CLOUT,,A]
SKIPA A,[-1]
]
IFN TNX,[
FSIFL1: MOVE A,(A) ;INPUT FILE
MOVE B,[2,,.FBBYV]
MOVEI C,A
GTFDB
EXCH A,B
LDB C,[.BP FB%BSZ,B] ;GET BYTE SIZE
CAIN C,7 ;IF 7, ALREADY HAVE WHAT WE WANT
JRST POPJ1
CAIN C,36. ;IF 36, KNOW HOW MANY WORDS ALREADY
JRST .+4
MOVEI B,36.
IDIVI B,(C) ;GET NUNBER OF BYTES IN A WORD
IDIVI A,(B) ;GET NUMBER OF WORDS
]
IMULI A,5 ;INTO CHARACTERS
JRST POPJ1
FSOFLEN:TLNN FF,FLOUT
TYPRE [NDO]
MOVEI A,CHFILO
JRST FSIFL1
;SET INPUT FILE ACCESS POINTER TO CHAR # IN C.
FSIFAC: TLNN FF,FLIN
TYPRE [NFI]
IFN ITS,[
MOVEI A,CHFILI
.CALL RFACCB
TYPRE [NRA] ;NOT RANDOM ACCESS FILE.
IDIVI C,5 ;CHANGE ARG TO WORD #.
.ACCES CHFILI,C ;FIND THAT WORD.
]
IFN TNX,[
IDIVI C,5 ;CONVERT TO WORD #
MOVE A,CHFILI
MOVE B,C ;GET ARG
SFPTR
TYPRE [NRA]
]
SETOM LASTPA ;EVEN IF FILE WAS AT EOF, IT WON'T BE ANY MORE.
CALL UTRLD2 ;FILL UP THE INPUT BUFFER
HRRZ CH,UTRLDT
CAIN CH,UTIBUF ;DID WE GET ANYTHING?
JRST UTLSTP ;NO, .ACCESS WENT TO EOF.
JUMPE D,CPOPJ ;YES, ADVANCE IN WORD TO SPEC'D CHARACTER IF IT ISN'T THE 1ST.
IBP UTYIP
SOJG D,.-1
RET
SUBTTL OUTPUT TO FILES
;THIS IS THE HIGHER LEVELS OF THE P COMMAND.
PUNCH: SKIPGE OUTFLG ;CHECK FOR OUTPUT DISABLED OR NO FILE OPEN.
RET
TLNN FF,FLOUT
TYPRE [NDO]
TRNE FF,FRARG2
JRST PUNCHB ;2-ARG P COMMAND.
MOVE T,CPTR
ILDB T,T ;ELSE PEEK AT NEXT CHAR TO SEE IF IT IS W.
ANDCMI T,40
SKIPE COMCNT
CAIE T,"W
PUNCHA: SETZ T, ;ENTER HERE FOR N AND EE COMMANDS.
SKIPGE OUTFLG ;IF T IS NONZERO, DON'T READ, JUST OUTPUT.
RET
TLNN FF,FLOUT
TYPRE [NDO]
MOVE D,C ;D HAS NUMBER OF PAGES TO OUTPUT.
JUMPL D,CPOPJ
PUN1: SAVE D
SAVE T
PUSHJ P,PUNCHR
TRZ FF,FRARG
SKIPN (P)
CALL YANKEE
REST T
REST D
MOVE E,ZV
CAMN E,BEGV ;KEEP FEEDING PAGES THROUGH UNTIL COUNT RUNS OUT
SKIPE LASTPA ;OR WE ARE AT EOF WITH AN EMPTY BUFFER.
SOJG D,PUN1
CPOPJ: POPJ P,VIEW1
PUNCHR: SKIPGE STOPF ;IN BETWEEN PAGES,
CALL QUIT0 ;TRY TO QUIT IF DESIRED (CHECKS NOQUIT).
MOVE E,BEGV
MOVE C,ZV
TRZ FF,FRUPRW
SKIPE FFMODE ;IN FFMODE, ANY ^L DESIRED IS ALREADY IN BFR.
JRST PUNCHF
CALL PUNCHF ;IF ^L'S READ GET THROWN AWAY,
MOVEI CH,^L ;MUST REGENERATE THEM ON OUTPUT.
JRST PPA
;FORCE OUT CONTENTS OF OUTPUT BUFFER. CLOBBERS A, B, C.
FLSOUT: TLNN FF,FLOUT
RET ;NO OUTPUT FILE.
MOVE B,UTYOP
IBP B ;-> WD NEXT OUTPUT CHAR WILL GO IN.
MOVEI A,@B
MOVNI C,-UTOBUF(A) ;# WDS FILLED UP IN FRONT END OF BFR.
JUMPE C,CPOPJ
IFN ITS,[
HRLZI A,(C)
HRRI A,UTOBUF ;AOBJN -> FILLED PART.
.IOT CHFILO,A
]
IFN TNX,[
SAVE C
SAVE B
MOVE A,CHFILO ;OUTPUT FILE
MOVE B,[444400,,UTOBUF] ;POINTER TO BUFFER
SOUT
REST B
REST C
]
MOVE A,(B) ;GET THE PARTIALLY FILLED WORD.
MOVEM A,UTOBUF ;PUT IT IN 1ST WD OF BUFFER,
ADDM C,UTYOP ;BACK THE BP UP THE RIGHT # WDS.
IMULI C,5
ADDM C,UTYOCT ;MORE SPACE IN OUTPUT BUFFER NOW.
POPJ P,
;P COMMAND WITH 2 ARGS.
PUNCHB: SAVE FF
TRZ FF,FRUPRW
CALL GETARG ;DECODE THE TWO ARGS, BUT DON'T PROCESS THE @ FLAG NOW.
CALL CHK1A ;SAVE IT FOR LATER.
REST FF
TRZ FF,FRCLN
;OUTPUT RANGE SPEC'D BY C,E.
PUNCHF:
IFN ITS,[ ;TURN ON SEQUENTIAL PAGING FOR RANGE TO BE WRITTEN.
MOVEI TT,5*2000*5
MOVE Q,E
CAMLE Q,GPT
ADD Q,EXTRAC
MOVE CH,C
CAML CH,GPT
ADD CH,EXTRAC
CALL SEQPAG
SAVE [SEQPGX] ;REMEMBER TO TURN OFF SEQUENTIAL PAGING LATER.
];ITS
CAMGE E,GPT
CAMG C,GPT ;IF GAP IS INSIDE RANGE TO BE PUNCHED, WE MUST BE CAREFUL.
JRST PUNCHG
PUSH P,C
MOVE C,GPT
CALL PUNCHG ;FIRST, PUNCH EVERYTHING UP TO THE GAP.
MOVE E,GPT
MOVE TT,EXTRAC
IDIVI TT,5
JUMPE TT1,[ ;IF GAP DOESN'T DESTROY ALIGNMENT, JUST PUNCH EVERYTHING AFTER THE GAP.
POP P,C
JRST PUNCHG]
PUNCHJ: MOVE E,GPT ;GAP DESTROYS ALIGNMENT; IT IS FASTEST TO ADJUST ALIGNMENT OURSELVES
MOVE C,E ;BY MOVING THE GAP UP PAST THE TEXT TO BE OUTPUT.
ADDI C,4*5*2000 ;MOVE THE GAP PAST AT MOST 4K AT A TIME
SUB C,UTYOCT ;(PLUS ENOUGH TO FILL OUTPUT BUFFER, TO INSURE IT'S EMPTY AT NEXT STOP)
MOVE T,(P) ;AND THEN OUTPUT THAT 4K.
CAMG T,C ;WHEN LESS THAN 4K REMAIN TO BE DONE,
JRST [ POP P,C ;WE DO WHAT IS LEFT AND EXIT.
JRST PUNCHH]
CALL PUNCHH
JRST PUNCHJ
;OUTPUT RANGE FROM C(E) TO C(C), MOVING GAP PAST IT FIRST.
PUNCHH: SAVE PT ;MOVE THE GAP UP PAST END OF RANGE TO BE TRANSFERRED NOW,
MOVEM C,PT
CALL GAPSL0 ;WITHOUT MARKING THE BUFFER AS MODIFIED, HOWEVER.
REST PT
;OUTPUT RANGE FROM C(E) TO C(C), OF VIRTUAL ADDRESSES,
;ASSUMING THE GAP IS NOT IN THE WAY.
PUNCHG: MOVE IN,E
MOVE BP,IN
SUBM C,IN ;IN GETS COUNT OF CHARS REMAINING.
JUMPLE IN,CPOPJ
PUSHJ P,GETIBV ;BP GETS BP TO FETCH FROM BUFFER.
PCHF1: MOVE TT,UTYOP
HLRZ OUT,BP
CAMN TT,[010700,,UTOBUF-1] ;UTOBUF EMPTY AND
CAIE OUT,010700 ;NEXT CHR IN BUFFER IS 1ST IN A WD =>
JRST PCHF2
PCHF3: CAIGE IN,5 ;TRY .IOTING OUT OF BUFFER.
JRST PCHF2
ADDI BP,1
MOVE CH,IN ;GET # WDS FULL IN BUFFER AFTER WHERE WE ARE.
IDIVI CH,5
CAIL CH,4000
MOVEI CH,4000 ;DON'T OUTPUT MORE THAN 2K AT ONCE.
TRNE FF,FRUPRW
JRST PCHF4
SAVE BP ;UNLESS THIS IS @P,
MOVN Q,CH ;CLEAR THE LOW BITS IN THIS 2K.
HRL BP,Q ;WE GET BETTER PAGING BEHAVIOR IF WE CLEAR AND THEN OUTPUT
MOVEI Q,1 ;2K AT A TIME.
ANDCAM Q,(BP)
AOBJN BP,.-1
REST BP
PCHF4:
IFN ITS,[
MOVNS CH
HRLI BP,(CH) ;BP HAS AOBJN -> WDS IN BUFFER.
.IOT CHFILO,BP
]
IFN TNX,[
JSR SAVABC ;SAVE ACS
MOVNS C,CH ;NUMBER OF CHARS
MOVEI B,(BP) ;FIRST WORD
HRLI B,444400
MOVE A,CHFILO ;OUTPUT FILE
SOUT
HRRI BP,1(B) ;FIRST ADDR NOT WRITTEN
JSP A,RST321 ;RESTORE ACS
]
IMULI CH,5 ;# CHARS JUST OUTPUT.
ADD IN,CH ;THAT MANY FEWER LEFT.
SUBI BP,1 ;CHANGE BP BACK TO BP TO NEXT CHAR.
HRLI BP,010700
JRST PCHF3 ;HANDLE REMAINING CHARS.
PCHF2: MOVN OUT,UTYOCT
CAMLE OUT,IN
MOVE OUT,IN ;OUT GETS # OF CHARS TO XFER INTO OUTPUT BUFFER.
PUSH P,OUT
JUMPE OUT,PPG1
MOVE E,[PPG,,A]
BLT E,D
JRST A
; General consensus seems to be that if you have cache, then putting a loop in
; the ACs is not worth the effort of BLTing it in there. This code has been
; updated to reflect that, and we shall see...
PPG: ILDB CH,BP ;A
IDPB CH,TT ;B
SOJG OUT,A ;C
JRST PPG1 ;D
PPG1: POP P,OUT
MOVEM TT,UTYOP
ADDM OUT,UTYOCT ;UPDATE MINUS NUMBER OF FREE CHARS REMAINING IN BUFFER.
SKIPL UTYOCT
CALL UTYOA
SUB IN,OUT
JUMPG IN,PCHF1
RET
POPDJ: POP P,D
POPJ P,
;OUTPUT CHAR IN CH TO OUTPUT FILE, IF ANY.
PPA:
PPA2: SKIPGE OUTFLG
RET
TLNE FF,FLOUT
JRST UTYO
RET
UTYO: IDPB CH,UTYOP
AOSGE UTYOCT
POPJ P,
UTYOA: MOVEM CH,UTYOP
MOVNI CH,<UTOBE-UTOBUF>*5
MOVEM CH,UTYOCT
IFN ITS,[
MOVE CH,[UTOBUF-UTOBE,,UTOBUF]
.IOT CHFILO,CH
MOVE CH,[10700,,UTOBUF-1]
EXCH CH,UTYOP
POPJ P,
]
IFN TNX,[
JSR SAVABC ;SAVE ACS
MOVE A,CHFILO ;OUTPUT FILE
MOVE B,[444400,,UTOBUF] ;POINTER TO BUFFER
MOVNI C,UTOBE-UTOBUF ;COUNT
SOUT
MOVE CH,[10700,,UTOBUF-1] ;UPDATE BUFFER POINTER
EXCH CH,UTYOP
JRST POPCBA ;RESTORE ACS AND RETURN
] ;IFN TNX
;SET ACCESS POINTER OF OUTPUT FILE TO CHAR # IN C,
;WHICH MUST BE A MULTIPLE OF 5. ERROR IF ANY CHARS IN OUTPUT
;BUFFER ARE LOST (WHICH WILL BE THE CASE UNLESS OUTPUT STOPPED
;ON A WORD BOUNDARY).
FSOFAC: TLNN FF,FLOUT
TYPRE [NDO]
IFN ITS,[
MOVEI A,CHFILO
.CALL RFACCB
TYPRE [NRA]
]
SAVE C
CALL FLSOUT ;FORCE OUT THE OUTPUT BUFFER.
REST C
MOVN A,UTYOCT ;ANYTHING NOT FORCED OUT??
CAIE A,UTBSZ*5
TYPRE [WLO]
IDIVI C,5 ;GET WORD # IN FILE OF DESIRED POSITION.
SKIPE D
TYPRE [ARG] ;ARG NOT MULTIPLE OF 5??
IFN ITS,.ACCES CHFILO,C
IFN TNX,[
MOVE A,CHFILO ;OUTPUT FILE
MOVE B,C
SFPTR ;SET POINTER
TYPRE [NRA]
]
RET
SUBTTL I/O COMMANDS
ECMD: TLO FF,FLDIRDPY ;DISPATCH FOR E-COMMANDS.
PUSHJ P,LRCH
ANDI CH,-1
CAIN CH,^U
JRST EUHACK
CAIGE CH,"? ;IF CHARACTER BEYOND "?, DISPATCH ON IT.
TYPRE [IEC]
XCT ETAB-"?(CH)
RLTCLK: CALL SAVACS ;RUN THE REAL TIME CLOCK HANDLER. DON'T CLOBBER ANYTHING.
SAVE SQUOTP
SAVE RCHALT
MOVE A,[JFCL ENDARG]
MOVEM A,RCHALT
SETZM CLKFLG
SKIPE A,CLKMAC
CALL MACXCP
SETZM CLKFLG
REST RCHALT
REST SQUOTP
JRST RSTACS
IFN ITS,[.SEE %%TNX% ;WHERE THIS MOBY CONDITIONAL ENDS
ASLEEP: CALL IMMQIT
TRZE FF,FRCLN
JRST ASLEE1
TRZE FF,FRARG
.SLEEP C,
JRST DELQIT
ASLEE1: AOS (P) ;<DUR>:^S 1) RETURNS RESULT OF FS LISTEN$
ASLEE4: TRZ FF,FRARG ; 2) SLEEPS ONLY AS LONG AS THERE IS NO INPUT AVAIL.
SKIPN TYISRC
SKIPL UNRCHC
SKIPA A,[1]
LISTEN A
JUMPN A,DELQIT
JUMPE C,DELQIT
CALL TTYAC2
ASLEE2: .SLEEP C,
JRST ASLEE4
EQMRK: CALL FFRRDD ;E?<FILE>$ 0 IF FILE EXISTS, ELSE (NUMERIC) ERROR CODE.
MOVE A,[.BAI+10,,CHRAND] ;THE 10 MEANS DON'INSIST ON EXISTING JOB,
;OR DON'T SET THE REF DATE FOR A DISK FILE.
CALL IMMQIT
.CALL RREDB ;TRY TO OPEN; A GETS 0 OR I.T.S. ERROR CODE
JFCL
SETZM IMQUIT
.CLOSE CHRAND,
JRST POPJ1
;FS CLK INTERVAL$ - SET REAL TIME CLOCK INTERVAL IN 60THS. VALUE SAVED IN CLKINT BY FSNORM.
FSCLKI: TRNN FF,FRARG
JRST FSNORM
SKIPE C ;OR TURN OFF REAL TIME CLOCK, WITH ARG OF 0.
FSCLK0: SKIPA A,[%RLSET,,C]
MOVSI A,%RLFLS
.REALT A,
JRST FSNORM
SUBTTL EG COMMAND
EGET: PUSH P,LISTF5
MOVEI A,TYOM
HRRM A,LISTF5
CALL GAPSLP
TLZ FF,FLDIRDPY ;EGET TO INSERT IN THE BUFFER
PUSHJ P,GDATIM
JFCL
PUSHJ P,GLPDTM
SKIPG E,DATE ;THE DATE
SETZ E, ;IF SYSTEM DOESN'T KNOW DATE, USE 6 SPACES.
CALL TYPR
CALL CRR1
SKIPG E,TIME
SETZ E,
CALL TYPR ;INSERT TIME FROM SIXBIT WORD,
CALL CRR1
MOVSI CH,(LFN"DIRFLG) ;Get default directory into TMPFIL
MOVSI E,DEFFIL
CALL FSRFNC
MOVEI A,TMPFIL
CALL ASCIND
CALL CRR1
MOVEI A,DEFFIL
CALL ASCIND ;INSERT CURRENT DEFAULT FILE NAMES.
CALL CRR1
TLNN FF,FLIN ;THE NAMES OF THE FILE OPEN FOR READING (IF ANY)
JRST EGET2 ;(NONE, LEAVE BLANK LINE - EVENTUALLY REPLACE THIS CRUFT WITH .RCHST)
MOVEI A,INFILE
CALL ASCIND
EGET2: CALL CRR1
SKIPL TIME
PUSHJ P,SYMDAT ;THE DATE IN STANDARD SYMBOLIC FORM
PUSHJ P,CRR1
LDB CH,[320300,,YEAR] ;A THREE DIGIT NUMBER
PUSHJ P,DGPT ;FIRST DIGIT DAY OF WEEK (0 => SUNDAY)
LDB CH,[270300,,YEAR] ;SECOND DIGIT DAY OF WEEK OF BEGINNING OF YEAR
PUSHJ P,DGPT
LDB CH,[410300,,YEAR] ;THIRD DIGIT 3 BITS
;4 BIT 1 => NORMAL YEAR AFTER 2/28
;2 BIT 1 => LEAP YEAR
;1 BIT 1 => DAYLIGHT SAVINGS TIME IN EFFECT
PUSHJ P,DGPT
PUSHJ P,CRR1
PUSHJ P,POM ;THE PHASE OF THE MOON
PUSHJ P,CRR1
POP P,LISTF5
POPJ P,
;VARIOUS TIME GETTING ROUTINES
GDATIM: .RDATIM A, ;GET TIME IN A, DATE IN B
MOVEM A,TIME ;STORE SIXBIT TIME
MOVEM B,DATE ;STORE SIXBIT DATE
JUMPGE A,POPJ1 ;IF TIME AVAILABLE THEN SKIP-RETURN
POPJ P, ;NOT AVAILABLE, DON'T SKIP (BUT LEAVE TIME AND DATE NEGATIVE)
GLPDTM: .RLPDT A, ;GET VARIOUS TIMES IN BINARY
MOVEM B,YEAR ;SAVE YEAR AND FLAGS
MOVEM A,LPDTIM ;SAVE LOCALIZED # SECONDS SINCE BEGINNING OF YEAR
TLNE B,400000 ;IF NORMAL YEAR AFTER FEB 28,
SUBI A,SPD ;THEN BACK UP A DAY
TLNE B,100000 ;IF DAYLIGHT SAVINGS TIME IN EFFECT,
SUBI A,3600. ;THEN BACK UP AN HOUR
MOVEM A,PDTIME ;SAVE # SECONDS SINCE BEGINNING OF YEAR
POPJ P,
;TYPE OUT (THROUGH LISTF5) THE DATE IN ENGLISH
SYMDAT: PUSHJ P,DOW ;TYPE DAY OF WEEK
REPEAT 2,PUSHJ P,SPSP ;TYPE TWO SPACES
MOVE E,DATE ;GET DATE
DPB E,[221400,,CDATE] ;DEPOSIT SIXBIT FOR DAY OF MONTH
LDB CH,[220100,,DATE] ;GET FIRST DIGIT OF MONTH
LDB E,[140400,,DATE] ;GET SECOND DIGIT OF MONTH
IMULI CH,10. ;MULTIPLY THE FIRST DIGIT TO ITS PROPER WEIGHTING
ADD E,CH ;ADD TOGETHER TO GET MONTH
MOVE E,MONTHS-1(E) ;GET MONTH IN SIXBIT
PUSHJ P,SIXNTY ;TYPE OUT MONTH
MOVE E,CDATE ;GET FIRST PART OF DATE
PUSHJ P,TYPR ;TYPE OUT
MOVE E,DATE ;GET DATE
MOVEI IN,2 ;LIMIT TYPEOUT TO TWO CHARACTERS
JRST TYPR3 ;TYPE OUT LAST TWO DIGITS OF YEAR AND RETURN
MONTHS: IRPS S,,[JAN FEB MARCH APRIL
MAY JUNE JULY AUG SEPT OCT NOV DEC]
SIXBIT /S/
TERMIN
;TYPE OUT DAY OF WEEK
DOW: LDB A,[320300,,YEAR] ;GET DAY OF WEEK (0 => SUNDAY)
MOVE A,DOWTBL(A) ;GET SIXBIT FOR DAY (EXCEPT FOR THE "DAY")
PUSHJ P,SIXIN1 ;TYPE OUT
MOVSI A,(SIXBIT /DAY/) ;NOW FOR THE "DAY"
JRST SIXIN1 ;TYPE IT OUT AND RETURN
DOWTBL: IRPS DAY,,[SUN MON TUES WEDNES THURS FRI SATUR]
SIXBIT /DAY/
TERMIN
;TYPE OUT THE PHASE OF THE MOON
POM: PUSHJ P,GNDS0 ;GET NUMBER OF DAYS SINCE 1/1/0000
MULI A,SPD ;CONVERT TO SECONDS IN A AND B
JFCL 17,.+1 ;CLEAR FLAGS FOR FOLLOWING
ADD B,PDTIME ;# SECONDS SINCE BEGINNING OF YEAR
ADD B,SYNOFS ;THE MOON DOESN'T QUITE BELIEVE IN THE GREGORIAN CALENDAR SYSTEM
JFCL 4,[AOJA A,.+1] ;CRY1
ASHC A,2 ;CONVERT TO QUARTER SECONDS
DIV A,SYNP ;DIVIDE BY NUMBER OF SECONDS IN A PERIOD TO GET NUMBER OF QUARTERS SINCE THEN
ASH B,-2 ;CONVERT REMAINDER TO SECONDS (# SECONDS INTO THIS QUARTER)
PUSH P,B ;SAVE REMAINDER
IDIVI A,4 ;GET QUARTER IN B
MOVE A,[SIXBIT /NM+ FQ+ FM+ LQ+/](B) ;GET SIXBIT CRUFT IN A (I REFUSE TO CHANGE THE 1Q!!!)
PUSHJ P,SIXIN1 ;TYPE IT OUT
POP P,B ;RESTORE # SECONDS INTO THIS PERIOD
TDHMS: MOVEI E,TDHMST ;SET POINTER TO TABLE
TDHMS1: IDIVI B,@(E)
JUMPE B,TDHMS2
HRLM C,(P)
PUSHJ P,[AOJA E,TDHMS1] ;INCREMENT INDEX WHILE RECURSING
HLRZ C,(P)
TDHMS2: PUSHJ P,DPT ;TYPE OUT IN DECIMAL
HLLZ A,(E) ;GET SIXBIT CRUFT
SOJA E,SIXIN1 ;BACK UP INDEX, TYPE OUT, AND RETURN
TDHMST: SIXBIT /S./+60. ;SECONDS
SIXBIT /M./+60. ;MINUTES
SIXBIT /H./+24. ;HOURS
SIXBIT /D./+<,-1> ;DAYS
SYNP: 2551443.
SYNOFS: 690882.
;GET NUMBER OF DAYS SINCE 1/1/0000 (AS OF 1/1/CURRENT YEAR) IN A
GNDS0: MOVEI C,@YEAR ;GET YEAR
MOVEI A,-1(C) ;ALSO GET YEAR-1 IN A
IMULI C,365. ;FIRST APPROXIMATION
IDIVI A,4
ADD C,A ;ADD NUMBER OF YEARS DIVISIBLE BY 4
IDIVI A,25.
SUB C,A ;SUBTRACT NUMBER OF YEARS DIVISIBLE BY 100
IDIVI A,4
ADD A,C ;ADD CRUD ALREADY CALCULATED TO NUMBER OF YEARS DIVISIBLE BY 400
AOJA A,CPOPJ
SUBTTL FILENAME READER FOR ITS
;Read in a filename, merge in the defaults from DEFFIL,
;and store the results back in DEFFIL.
ETCMD:
FFRRDD: CALL FRD
MOVE A,[TMPFIL,,DEFFIL]
BLT A,DEFFIL+FNMLEN-1
RET
;Read in a filename and leave it in TMPFIL. Don't change DEFFIL.
FRD: MOVE D,[441000,,BAKTAB]
FF2: PUSHJ P,LRCH
SKIPGE SQUOTP ;If char is superquoted, set 200 bit to make compares
TRO CH,200 ;with special syntax chars fail to match.
SKIPN SQUOTP ;The 200 bit will be dropped in the PFNMCH below.
CAIE CH,ALTMOD
CAIA
JRST FFTRM
CAME D,[141000,,BAKTAB+F10LEN-1]
IDPB CH,D ;Store the arg as a string in BAKTAB.
JRST FF2
FFTRM: SETZ B, ;Make the string asciz.
IDPB B,D
MOVE D,[441000,,BAKTAB]
;Merge the filenames from the BP in D with the current defaults
;and put the results in TMPFIL. Clobbers A, B, C.
FFMRG: MOVE C,[440700,,DEFFIL]
FFMRG1: SAVE E
SAVE C
MOVE A,[-FNBLEN,,BAKTAB+F10LEN]
CALL LFN"PARFN ;Parse into a filename block.
JFCL
REST D ;Get back default string
MOVE B,A ;Save first filename block ptr
MOVE A,[-FNBLEN,,BAKTAB+F10LEN+FNBLEN]
CALL LFN"PARFN ;Parse the defaults into another filename block
JFCL
EXCH A,B
MOVEI C,TMPFIL
MOVEI D,FNMLEN*5
MOVEI E,1
SKIPL FNAMSY
MOVEI E,2
CALL LFN"SMERGE
TYPRE [FTL]
REST E
POPJ P,
LFN"$$PARSE==1
LFN"$$GNAME==1
LFN"$$MERGE==1
LFN"$$PFNMCH==1
LFN"$$MNAME==1
;Insert filename reader library.
.INSRT SYSENG;LFN
;Subroutines called by RFN and PFN.
PFNTRM:
RFNTRM: RET
FSIFILE:SKIPA E,[INFILE] ;FS I FILE$ - DESCRIBE OPEN INPUT FILE.
FSOFIL: MOVEI E,OUTFIL ;FS O FILE$ - DESCRIBE LAST CLOSED OUTPUT FILE.
AOSA (P)
FSDFRD: MOVEI E,DEFFIL
FSDFR1: SAVE C
MOVEI C,FNMLEN*5 ;UPPER BOUND ON SPACE REQUIRED.
CALL QOPEN ;MAKE SURE ENOUGH SPACE, SET UP BP AND LISTF5 TO STORE INTO STRING.
MOVE A,E
CALL ASCIND ;OUTPUT DATA COPIED OUT OF FILENAME INTO STRING SPACE.
CALL QCLOSV ;MAKE THE STRING HEADER.
JRST POPCJ
;FILE COPY
FCOPY: PUSHJ P,FFRRDD
MOVE A,[.BAI,,CHRAND]
CALL IMMQIT
.CALL RREDB ;OPEN FOR INPUT, NAMES IN DEFFIL
JRST OPNER1
TRNN FF,FRUPRW ;@ E_ => XFER REAL FILENAMES OF SOURCE TO DEFAULTS.
JRST FCOPY3
SYSCAL RFNAME,[ %CLIMM,,%JSELF ? %CLIMM,,CHRAND
[440700,,DEFFIL] ? %CLIMM,,FNMLEN*5]
.LOSE %LSFIL
FCOPY3: PUSHJ P,FFRRDD ;READ OUTPUT FILENAME INTO DEFFIL.N
MOVE D,[440700,,[ASCIZ /_TECO_ OUTPUT/]]
CALL FFMRG ;CONSTRUCT TEMP FILE NAME IN TMPFIL
SYSCAL SOPEN,[[.BAO,,CHERRI] ? [440700,,TMPFIL]]
JRST OPNER1
TRNN FF,FRCLN ;:E_ => TRANSFER INPUT FILE DATE TO OUTPUT FILE.
JRST FCOPY2
SYSCAL RFDATE,[%CLIMM,,CHRAND ? %CLOUT,,Q]
SETOM Q
SYSCAL SFDATE,[%CLIMM,,CHERRI ? Q]
JFCL
SYSCAL RAUTH,[%CLIMM,,CHRAND ? %CLOUT,,Q]
JRST FCOPY2
SYSCAL SAUTH,[%CLIMM,,CHERRI ? Q]
JFCL
FCOPY2: MOVE T,[-LTABS,,BAKTAB]
.IOT CHRAND,T
JUMPL T,FCOPY4
MOVE T,[-LTABS,,BAKTAB]
.IOT CHERRI,T
JRST FCOPY2
FCOPY4: .CLOSE CHRAND,
MOVSI T,-BAKTAB-1(T)
EQVI T,-1#BAKTAB
.IOT CHERRI,T
SYSCAL RENMWO,[%CLIMM,,CHERRI ? [440700,,DEFFIL]]
.VALUE
.CLOSE CHERRI,
JRST DELQIT
BPNTRD: PUSHJ P,.OPNRD
TRZ FF,FRARG
JRST .FNPNT
.OPNRD: PUSHJ P,FFRRDD
RRED: TLZ FF,FLIN ;IN CASE OPEN FAILS, INDICATE NOTHING IS OPEN.
CALL UTLSTP
MOVE A,[2,,CHFILI]
MOVE C,NUM
TRNE FF,FRARG ;IF HAVE ARG, IOR IT INTO OPEN-MODE.
TLO A,(C)
TRZE FF,FRARG2 ;PRE-COMMA ARG MEANS DON'T UPDATE REFERENCE DATES
TLO A,10
CALL IMMQIT
TLZ A,1 ;MAKE SURE MODE USED FOR INPUT OPEN IS EVEN!
.CALL RREDB ;OPEN NAMES IN DEFFIL, MODE,,CHNL IN A.
JRST OPNER1 ;FAILURE.
SETZM IMQUIT
SETZM PAGENU ;HAVE READ 0 PAGES SO FAR.
SETOM LASTPA ;NOT ON LAST PAGE AS FAR AS TECO KNOWS.
CALL RREDGN ;DO .RCHST, SET UP ERDEV, ERSNM, RUTF1, RUTF2.
;COME HERE TO START "OFFICIALLY" READING A FILE ALREADY OPEN.
RRED1: TLO FF,FLIN
MOVEI CH,^C
DPB CH,[350700,,UTIBE]
MOVE CH,[010700,,UTIBE-1]
MOVEM CH,UTYIP
AOS CH
HRRM CH,UTRLDT
POPJ P,
RREDB: SETZ ? SIXBIT/SOPEN/ ? A ? [440700,,DEFFIL] ? 403000,,A
RREDGN: SYSCAL RFNAME,[%CLIMM,,%JSELF ? %CLIMM,,CHFILI ? [440700,,BAKTAB] ? %CLIMM,,FNMLEN*5]
.LOSE %LSFIL
MOVE D,[440700,,BAKTAB]
CALL FFMRG
MOVE A,[TMPFIL,,INFILE]
BLT A,INFILE+FNMLEN-1
RET
;IO PUSH-DOWN COMMANDS
;E[ => PUSH INPUT CHANNEL
PSHIC: TLZ FF,FLDIRDPY ;DON'T TRY TO CONTROL U
MOVEI CH,CHFILI ;SET ARG TO FOLLOWING
TLNN FF,FLIN ;IF FILE NOT OPEN,
JRST PSHIC2
PUSHJ P,PSHCK ;E := WORD ADR OR DIE BECAUSE NOT RANDOM ACCESS
MOVE A,UTYIP ;GET BYTE POINTER
IBP A ;MAKE SURE IT POINTS *TO* THE WORD TO GET THE NEXT BYTE FROM
MOVEI T,(A)
SUB T,UTRLDT
HRREI T,(T) ;GET -<# WORDS TO GO TO END OF BUFFER>
JUMPE T,PSHIC2 ;JUMP IF AT END OF BUFFER, DON'T NEED TO DO .ACCESS
ADD E,T ;CALCULATE DESIRED WORD ADDRESS
.ACCESS CHFILI,E ;CLOBBER TO DESIRED
PSHIC2: MOVE E,PAGENU ;SAVE PAGENU AND LASTPA.
LSH E,1
SUB E,LASTPA ;LASTPA HOLDS 0 OR -1.
LSH E,2
TLNE FF,FLIN ;SAVE STATE OF FLIN TOO.
ADDI E,2
HRRI A,1(E) ;LOW BIT SET SAYS INPUT CHNL.
PUSHJ P,CHPSH ;DO THE PUSH
JRST UICLS ;CLOBBER POINTERS AND RETURN
;E] => POP INTO INPUT CHANNEL
POPIC: TLZ FF,FLDIRDPY ;DON'T DISPLAY DIRECTORY.
PUSHJ P,UICLS ;CLOBBER POINTERS FIRST
MOVE CH,[TRNN T,CHFILI] ;TRNN SKIPS IF THIS RIGHT KIND OF PDL ENTRY, CHFILI CHANNEL TO POP INTO
PUSHJ P,CHPOP ;POP INTO THE CHANNEL
LDB CH,[020100,,A]
MOVNM CH,LASTPA
LDB CH,[031700,,A]
MOVEM CH,PAGENU
.STATUS CHFILI,CH ;GET CHANNEL STATUS
TRNE CH,77 ;IF NO DEVICE OPEN NOW
TRNN A,2 ;OR NONE WAS OPEN THEN,
JRST UTLSTP ;SAY WE'RE AT END OF FILE (MUST ALWAYS SAY THAT IF FLIN OFF)
TLO FF,FLIN ;OTHERWISE, SAY A FILE IS OPEN
CALL UTRLD2 ;RE-FILL INPUT BUFFER.
HRRI A,UTIBUF ;CONVERT BACK TO BYTE POINTER
DBP7 A ;DECREMENT TO GET RELOCATED ORIGINAL POINTER.
MOVEM A,UTYIP ;STORE AS POINTER
JRST RREDGN ;DO RFNAME; SET UP ERDEV, ERSNM, RUTF1, RUTF2.
;CHECK THE VALIDITY OF THE INPUT FILE OPEN ON CHANNEL SPECIFIED BY CH
PSHCK: HRRZ A,CH ;GET CHANNEL
.CALL RFACCB
TYPRE [NRA]
RET
RFACCB: SETZ ? 'RFPNTR ? A ? MOVEM E ((SETZ))
;E\ => PUSH OUTPUT CHANNEL
PSHOC: TLZ FF,FLDIRDPY ;DON'T TRY TO CONTROL U
CALL FLSOUT ;FORCE OUT BUFFER, EXCEPT 1 WD (LEFT IN 1ST WD OF BUFFER)
MOVE B,UTYOP ;GET B.P. TO SHIFT POS. FIELD INTO A.
IBP B ;GET BP TO PLACE NEXT CHAR GOES (RH = UTOBUF).
LDB A,[73500,,UTOBUF] ;GET 1ST 4 CHRS FROM THAT WD
;(5TH CAN'T BE USED, SINCE FLSOUT WOULD HAVE OUTPUT THE WD)
LSHC A,7 ;LEFT-JUSTIFY CHARACTERS AND SHIFT MEAT OF BYTE POINTER IN, LEAVE BIT 1.1 BLANK (=> OUTPUT)
MOVEI CH,CHFILO ;PUT CHANNEL SPECIFICATION IN CH
PUSHJ P,CHPSH ;PUSH THE CHANNEL (ALSO PUSH A ONTO LOCAL PDL)
TLZ FF,FLOUT
RET ;CLOBBER BUFFER POINTERS AND RETURN
;E^ => POP INTO OUTPUT CHANNEL
POPOC: TLZ FF,FLDIRDPY\FLOUT ;DON'T TRY TO CONTROL U
MOVE CH,[TRNE T,CHFILO] ;GET CHANNEL AND TEST INSTRUCTION IN T (INSTRUCTION SKIPS IF THIS RIGHT PDL ENTRY)
PUSHJ P,CHPOP ;POP INTO THE CHANNEL
.STATUS CHFILO,C
TRNN C,77
POPJ P, ;POPPED AN UNOPENED CHANNEL.
MOVEM A,UTOBUF ;STORE BACK PARTIALLY FILLED WORD
MOVE C,[700,,UTOBUF] ;GET BYTE POINTER LESS POSITION FIELD IN C
DPB A,[350700,,C] ;DEPOSIT POS FIELD + EXTRA LOW BIT
DBP7 C
MOVEM C,UTYOP ;STORE BACK NEW POINTER
ANDI A,177 ;MASK A TO POSITION FIELD_1
IDIVI A,7_1 ;GET # CHARACTERS STILL TO BE PROCESSED THIS WORD - 1 IN A
ADDI A,<UTOBE-UTOBUF>*5-4 ;CONVERT TO NUMBER OF CHARACTERS YET TO OUTPUT
MOVNM A,UTYOCT ;STORE AS COUNT REMAINING
TLO FF,FLOUT ;FILE OPEN
RET
;PUSH THE IO CHANNEL SPECIFIED BY CH
CHPSH: MOVE C,IOP ;GET IO PDL POINTER
PUSHJ P,CHPSH1 ;DO THE PUSH
MOVEM C,IOP ;STORE BACK UPDATED POINTER
POPJ P,
CHPSH1: PUSH C,A
MOVE Q,[.IOPUS]
DPB CH,[270400,,Q]
XCT Q
POPJ P,
CHPOP2: MOVE Q,[.IOPOP]
DPB E,[270400,,Q]
XCT Q
RET
;IO POP INTO THE CHANNEL SPECIFIED BY CH
CHPOP: HLLM CH,CHPOPX ;STORE VALIDITY CHECKING INSTRUCTION
HRRM CH,GCHN2 ;STORE CHANNEL IN CHANNEL SEARCH ROUTINE (MAKE IT SKIP OVER IT)
MOVEI E,17 ;SET FIRST CHANEL FOR GCHN TO TRY
MOVE C,IOP ;GET IO PDL POINTER
HRRZ A,C ;GET RH IN A
MOVE B,[TYPRE [NOP]
] ;NOT ON PDL: EXECUTED IF SPECIFIED TYPE OF CHANNEL HASN'T BEEN PUSHED
PUSHJ P,CHPOP1 ;DO THE POP
XCT B ;LOST, DO THE APPROPRIATE THING
MOVEM C,IOP ;STORE BACK UPDATED POINTER
MOVE A,B ;PUT RETURN LOCAL PDL WORD IN A FOR ROUTINE THAT CALLED THIS ONE
MOVE CH,E ;RESTORE CH FOR CALLING ROUTINE
POPJ P,
;ENTRY ON TOP OF PDL WRONG TYPE, POP IT SOMEWHERE ELSE, RECURSE, THEN PUSH IT BACK
CHPOP3: PUSH P,T ;SAVE LOCAL DESCRIPTOR WORD ON MAIN PDL
PUSHJ P,GCHN ;GET A FREE CHANNEL TO POP INTO
JRST POPAJ ;NO CHANNELS AVAILABLE
PUSHJ P,CHPOP2 ;POP INTO CHANNEL
HRLM E,-1(P) ;SAVE CHANNEL NUMBER POPPED INTO
PUSHJ P,[SOJA A,CHPOP1] ;TRY AGAIN ON ORIGINAL TASK
SOS -1(P) ;LOSE, CAUSE RETURN NOT TO SKIP
HLRZ CH,-1(P) ;RESTORE CHANNEL NUMBER, THIS TIME IN CH FOR PUSH BACK
POP P,A ;RESTORE LOCAL PDL ENTRY, BUT IN A
AOS (P) ;CAUSE RETURN TO SKIP
JRST CHPSH1 ;PUSH BACK CHANNEL AND RETURN
CHPOP1: CAIGE A,IOPDL ;IF A DOESN'T POINT INTO PDL,
RET ;THEN NOT ON PDL , UNSCREW PDL AND DO TYPRE [NOP]
POP C,T ;POP LOCAL PDL ENTRY INTO T
XCT CHPOPX ;SKIP IF THIS THE RIGHT KIND OF PDL ENTRY
JRST CHPOP3 ;WRONG KIND OF ENTRY, POP IT SOMEWHERE ELSE, RECURSE, THEN PUSH IT BACK
MOVE E,CH ;RIGHT KIND OF ENTRY, SAVE ORIGINAL CHANNEL SPECIFICATION IN E
MOVE B,T ;WIN, SAVE LOCAL PDL ENTRY FOR TOP LEVEL
AOS (P) ;CAUSE RETURN TO SKIP
JRST CHPOP2
;FIND A FREE CHANNEL TO POP INTO
GCHN: ;GCHN NAME OF ENTRY TRANSFERED TO, GCHN2 NAME OF INSTRUCTION TO ADDRESS MODIFY
XCT GCHN2 ;RH MODIFIED, CHANNEL REALLY TRYING TO POP INTO SO LEAVE IT ALONE
JRST GCHN3 ;DON'T POP INTO THIS CHANNEL
MOVE T,[.STATUS T]
DPB E,[270400,,T]
XCT T ;GET STATUS OF CHNL CONSIDERING POPPING INTO.
TRNN T,77 ;DEVICE OPEN ON CHANNEL?
JRST POPJ1 ;NO, RETURN WINNING
GCHN3: SOJGE E,GCHN ;LOSE, TRY NEXT CHANNEL
MOVE B,[TYPRE [NFC]
] ;NO FREE CHANNELS TO POP INTO
POPJ P, ;NON-SKIP RETURN
EXITE: HRLOI C,377777 ;INFINITY
TRO FF,FRARG
MOVE E,BEGV ;PUNCH OUT IF BUFFER NONEMPTY
CAMN E,ZV
SKIPE LASTPA ;OR AN INPUT FILE IS OPEN
PUSHJ P,PUNCHA
CALL UICLS
JRST EFCMD
;EF COMMAND - CLOSE OUTPUT FILE.
EFCMD: PUSHJ P,FFRRDD ;READ FILENAMES TO CLOSE UNDER.
TLNN FF,FLOUT
TYPRE [NDO]
CAIA
EFCMDA: CALL UTYO ;PAD WITH THE CHARACTER IN FS FILEPAD TO WORD BNDRY.
MOVE CH,UTYOP
HRR CH,FILEPAD
TLNE CH,760000
JRST EFCMDA
CALL FLSOUT ;FORCE OUT THE BUFFER (INCL. PADDING).
TRZE FF,FRCLN
JRST EFCMD2
SYSCAL RENMWO,[%CLIMM,,CHFILO ? [440700,,DEFFIL]] ;GIVE FILE ITS ULTIMATE SPEC'D NAME.
JRST OPNER1
EFCMD2: SYSCAL RFNAME,[%CLIMM,,%JSELF ? %CLIMM,,CHFILO
[440700,,OUTFIL] ? %CLIMM,,FNMLEN*5]
.LOSE %LSFIL ;SET FS OFILE$ SO USER CAN FIND WHICH VERSION # IT WAS.
.CLOSE CHFILO,
TLZ FF,FLOUT
POPJ P,
;EJ - OPEN FILE FOR READING AND LOAD IMPURE AREAS AS DUMPED IN FILE.
;TAKES A FILENAME ARGUMENT. DOES NOT ALTER THE DEFAULT SNAME.
;AFTER LOADING, TECO IS RESTARTED, WHICH MEANS M..L WILL BE DONE.
;@EJ - WRITE ALL IMPURE AREAS INTO A FILE OPEN FOR WRITING, AND
;FILE IT AWAY AS SPEC'D NAMES.
;FORMAT OF FILE:
;1ST WORD: SIXBIT/TECO/+1 (FOR ERROR CHECKING)
;2ND WORD: .FVERS OF TECO DOING THE DUMPING.
;PREVENTS TECOS FROM LOADING DUMP FILES OF OTHER VERSIONS.
;3RD WORD: JRST 1, AS REQUIRED TO MARK THE BEGINNING OF SBLK DATA IN A BIN FILE
;THEN COME SBLK DATA BLOCKS SPECIFYING RANGES OF CORE TO LOAD,
;AND THEN TWO COPIES OF THE START ADDRESS (BOOT).
;: EJ - OPEN FILE FOR READING AND MAP IT INTO CORE JUST UNDER LHIPAG.
;LHIPAG IS SET TO POINT AT THE BEGINNING OF THE FILE, AND A PURE
;STRING POINTER TO THE START OF THE FILE IS RETURNED. THIS COMMAND
;DOES NOT USE THE FILE FORMAT USED BY PLAIN EJ AND @EJ; IN FACT,
;THE FILE IS JUST A CORE IMAGE.
EJCMD: TRZN FF,FRUPRW
JRST EJCMDR
TLNN FF,FLOUT ;@EJ.
TYPRE [NDO]
MOVE A,[-3,,[SIXBIT /TECO/+1
.FVERS
JRST 1]]
.IOT CHFILO,A ;SAY THIS IS A TECO DUMP FILE, AND WHAT
;TECO VERSION DUMPED IT.
HRROI A,P
JSP T,EJWBLK
MOVE A,[20-HCDS,,20]
JSP T,EJWBLK ;DUMP LOW IMPURE.
MOVE A,[HCDSE-LIMPUR,,HCDSE]
JSP T,EJWBLK ;EXCEPT FOR THE SCREEN-LINE HASH CODES.
MOVE A,QRWRT
ADDI A,4
IDIVI A,5 ;ADDR LAST WORD OF IMPURE STRING SPACE.
SUBI A,HIMPUR ;LENGTH OF HIGH IMPURE.
MOVNS A
HRLZS A
HRRI A,HIMPUR
JSP T,EJWBLK ;DUMP OUT HIGH IMPURE.
MOVE A,BFRBOT
IDIVI A,5
MOVE C,BFRTOP
IDIVI C,5
SUBM A,C ;-<LENGTH OF BUFFER SPACE>
HRL A,C ;AOBJN TO BUFFER SPACE.
JSP T,EJWBLK ;DUMP OUT BUFFER SPACE.
HRROI A,[JRST BOOT]
.IOT CHFILO,A ;OUTPUT THE STARTING ADDRESS
MOVE TT,[-4,,2] ;OUTPUT AN INDIRECT SYMBOL TABLE POINTER BLOCK,
RADIX 10.
MOVE A,[-4,,[SIXBIT /DSK/ ? SIXBIT /TECPUR/ ? SIXBNM \.FVERS
SIXBIT /.TECO./]]
RADIX 8
JSP T,EJWBL1 ;WHICH NEEDS A CHECKSUM LIKE ALL OTHERS.
HRROI A,[JRST BOOT]
.IOT CHFILO,A ;AND THEN ANOTHER COPY, THUS MARKING OFF A NULL SYMBOL TABLE.
JRST EFCMD ;RENAME AND CLOSE FILE.
;A HAS AOBJN POINTER TO RANGE OF DATA; WRITE AN SBLK DESCRIBING IT.
EJWBLK: MOVE TT,A
;HERE IF TT CONTAINS BLOCK HEADER, DISTINCT FROM THE POINTER TO THE DATA.
EJWBL1: HRROI C,TT ;FIRST WE NEED TO WRITE THE AOBJN ITSELF.
.IOT CHFILO,C
.IOT CHFILO,A ;THEN WRITE THE DATA IN THAT RANGE.
MOVE TT1,TT ;THEN COMPUTE THE CHECKSUM IN TT, INCLUDING THE AOBJN WORD
ROT TT,1
ADD TT,(TT1) ;AND THEN THE DATA WORDS.
AOBJN TT1,.-2
HRROI C,TT
.IOT CHFILO,C ;OUTPUT THE CHECKSUM.
JRST (T)
;EJ AND :EJ COMMANDS (THE INPUT VERSIONS OF EJ).
EJCMDR: TRZ FF,FRARG ;DON'T PASS ANY ARG TO .OPNRD; USE BLOCK ASCII MODE ALWAYS.
CALL .OPNRD ;READ FILE SPEC & OPEN FILE
TRZN FF,FRCLN ;:EJ?
JRST EJCMD2
SYSCAL FILLEN,[%CLIMM,,CHFILI ? %CLOUT,,A]
JRST OPNER1
ADDI A,1777 ;HOW MANY PAGES LONG IS THE FILE?
LSH A,-10.
MOVNS C,A
ADD C,LHIPAG ;IF IT WILL END JUST BELOW LHIPAG, WHERE SHOULD IT START?
CAMG C,MEMT ;LEAVE AT LEAST ONE EMPTY PAGE ABOVE BUFFER SPACE.
CALL [ CALL FLSCOR ;NO ROOM - CAN WE FLUSH SOME WASTAGE FROM BUFFER SPACE?
CAMG C,MEMT
TYPRE [URK] ;NO, THERE'S REALLY NO ROOM.
RET]
HRL C,A
SYSCAL CORBLK,[%CLIMM,,200000 ? %CLIMM,,%JSELF ? C ? %CLIMM,,CHFILI]
JRST OPNER1
CALL UICLS ;ALL PAGES MAPPED; DON'T NEED THE FILE NOW.
ADDB A,LHIPAG ;ADJUST LHIPAG FOR PAGES WE HAVE GOBBLED.
IMULI A,5*2000
TLO A,400000 ;RETURN A STRING POINTER TO BOTTOM OF FILE.
JRST POPJ1
EJCMD2: MOVE A,[-3,,C] ;ORDINARY "EJ". CHECK FIRST 3 WORDS OF FILE.
.IOT CHFILI,A .SEE IDIVI ;CONSECUTIVE AC'S USED HERE.
CAMN C,[SIXBIT/TECO/+1]
CAME D,[.FVERS] ;DUMPED BY DIFFERENT TECO VERSION,
TYPRE [AOR] ;OR NOT A TECO DUMP FILE.
CAME E,[JRST 1]
TYPRE [AOR]
.SUSET [.SMSK2,,[0]] ;INTERRUPT MIGHT DO TTYSET FROM NEWLY CLOBBERED VARS.
MOVE E,LHIPAG ;SINCE WE AREN'T OVERWRITING PURE STRING SPACE
;MUSTN'T FORGET WHERE IT STARTS.
MOVE D,MSNAME ;ALSO DON'T CLOBBER MSNAME.
MOVE T,MEMT ;.IOT'S CAN MAKE MEMORY BUT CAN'T FLUSH ANY.
MOVE J,INITFL
EJCMD1: HRROI A,C
.IOT CHFILI,A ;READ NEXT BLOCK HEADER
JUMPGE C,EJCMD3 ;POSITIVE => END OF BLOCK DATA; RESTART TECO, RUNNING Q..L.
.IOT CHFILI,C ;LOAD DATA OF BLOCK,
EJCMD4: HRROI A,C .SEE TSINT4 ;MPV HERE OK EVEN IF BELOW QRWRT.
.IOT CHFILI,A ;SKIP THE CHECKSUM.
JRST EJCMD1 ;READ NEXT BLOCK.
EJCMD3: MOVEM E,LHIPAG
INSIRP MOVEM D,MSNAME
MOVE A,D ;CONVERT MSNAME FROM SIXBIT TO ASCII IN BAKTAB.
MOVE D,[440700,,BAKTAB]
CALL STRGE1
MOVEI C,"; ;ADD SEMICOLON, AND NULL TO TERMINATE ASCIZ.
IDPB C,D
SETZ C,
IDPB C,D
MOVE D,[440700,,BAKTAB]
CALL FFMRG ;USE THAT TO SET THE DEFAULTS.
MOVE A,[TMPFIL,,DEFFIL]
BLT A,DEFFIL+FNMLEN-1
CAMLE T,MEMT
MOVEM T,MEMT
MOVEM J,INITFL ;FS LISPT$ SHOULD NOT BE CHANGED BY AN EJ.
.I SAVCMX=CBMAX=1
.CLOSE CHFILI,
JRST INIT
RENAM: PUSHJ P,FFRRDD
PUSHJ P,FRD
CALL IMMQIT
SYSCAL RENAME,[[440700,,DEFFIL] ? [440700,,TMPFIL]]
JRST OPNER1
MOVE A,[TMPFIL,,DEFFIL]
BLT A,TMPFIL+FNMLEN-1
JRST DELQIT
;RETURN -1 IF CURRENT INPUT FILE WAS REACHED VIA LINKS WHEN OPENED.
FSIFLN: SYSCAL LNKEDP,[%CLIMM,,CHFILI ? %CLOUT,,A]
SETZ A,
JUMPN A,NRETM1
JRST NRET0
ALINK: PUSHJ P,FFRRDD ;GET LINK NAME
CAME A,[SIXBIT/>/]
CAMN B,[SIXBIT/>/]
JRST ALINK1 ;MAKING LINK FROM FOO > WON'T DELETE ANYTHING.
MOVEI A,CHRAND
CALL IMMQIT
.CALL RREDB ;ELSE SEE IF ANY FILE WITH THAT NAME.
JRST ALINK1
MOVEI CH,%EEXFL ;GET ERROR CODE FOR "FILE ALREADY EXISTS",
JRST OPNER4 ;SIGNAL AN ERROR WITH MESSAGE READ FROM SYSTEM.
ALINK1: SETZM IMQUIT
CALL FRD ;READ NAMES LINKED TO.
MOVE A,[TMPFIL,,TMPF1]
BLT A,TMPF1+FNMLEN-1
MOVE A,TMPF1 ;COPY THEM INTO TMPF1.
AND A,[.BYTE 7 ? 177 ? 177 ? 177 ? 177]
SETZ D, ;IF DEVICE IS SYS: OR COM:, CHANGE DIR TO
CAMN A,[ASCIZ /COM:/] ;SYS; OR COMMON; BEFORE TRYING TO MAKE THE LINK.
MOVE D,[440700,,[ASCIZ /DSK: COMMON;/]]
CAMN A,[ASCIZ /SYS:/]
MOVE D,[440700,,[ASCIZ /DSK: SYS;/]]
MOVE C,[440700,,TMPF1]
SKIPE B
CALL FFMRG1
CALL IMMQIT
SYSCAL MLINK,[[440700,,DEFFIL] ? [440700,,TMPFIL]]
JRST OPNER1
JRST DELQIT
UNREAP==2
;READ OR WRITE DON'T-REAP BIT OF FILE OPEN ON CHANNEL IN LH(E).
FSREAP: HLRZS E
SYSCAL FILBLK,[E ? %CLOUT,,A ? %CLOUT,,A ? %CLOUT,,A]
JRST OPNER1
LDB A,[.BP (UNREAP),A]
MOVE B,['SREAPB]
JRST FSREA1
;READ OR WRITE DUMPED BIT OF FILE OPEN ON CHANNEL IN LH(E).
FSDUMP: HLRZS E
SYSCAL RDMPBT,[E ? %CLOUT,,A]
JRST OPNER1
MOVE B,['SDMPBT]
FSREA1: TRZN FF,FRARG
JRST POPJ1
SYSCAL CALL,[B ? E ? C]
JRST OPNER1
JRST POPJ1
WWINIT: CALL FFRRDD ;Set default filenames.
EICMD:
WINIT: MOVE A,[DEFFIL,,TMPFIL]
BLT A,TMPFIL+FNMLEN-1
TRZE FF,FRCLN ;:EW, :EI USE SPEC'D NAMES TO OPEN AS,
JRST WINIT1
MOVE D,[440700,,[ASCIZ /_TECO_ OUTPUT/]]
CALL FFMRG
WINIT1: TLZ FF,FLOUT
CALL IMMQIT
HRLI T,100000\.BAO ;@EW OPENS IN WRITE-OVER MODE.
TRZN FF,FRUPRW
WINIT2: HRLI T,.BAO ;OTHERWISE, USE NORMAL WRITE.
HRRI T,CHFILO
SYSCAL SOPEN,[T ? [440700,,TMPFIL]]
JRST WINIT3
SETZM IMQUIT
JSP T,FHAK ;INIT. BUFFER POINTERS.
TLO FF,FLOUT
POPJ P,
WINIT3: TLNN T,100000
JRST OPNER1
.STATUS CHFILO,D ;IF WRITE-OVER OPEN FAILS FOR "FILE NOT FOUND"
LDB D,[220600,,D]
CAIN D,%ENSFL
JRST WINIT2 ;THEN USE NORMAL WRITE OPEN INSTEAD.
JRST OPNER1
FHAK: TLO FF,FLOUT
MOVE CH,[10700,,UTOBUF-1]
MOVEM CH,UTYOP
MOVNI CH,<UTOBE-UTOBUF>*5
MOVEM CH,UTYOCT
JRST 1(T)
;DO .MTAPE ON CHANNEL IN E, WITH ARGS IN C AND SARG.
FSMTAP: HRLZS E
HRRI E,C ;E GETS CHANNEL,,ADDRESS
HRL C,SARG ;LH(C) GETS COUNT (DEFAULT IS 1).
TRNN FF,FRARG2
HRLI C,1
.MTAPE E,
JFCL
MOVE A,C
JRST POPJ1
DELE: TRZE FF,FRCLN
JRST DELE1 ; :ED IS DELETE INPUT FILE.
PUSHJ P,FFRRDD
SYSCAL DELETE,[[440700,,DEFFIL]]
JRST OPNER1
POPJ P,
DELE1: TLZN FF,FLIN
TYPRE [NFI]
SYSCAL DELEWO,[%CLIMM,,CHFILI]
.LOSE %LSFIL
POPJ P,
LISTF: CALL FFRRDD ;EY COMMAND - READ DEV NAME.
CNTRU1: CALL VBDACU ;IF THERE'S A CMD STRING PENDING,
RET ;DON'T BOTHER OPENING THE DIR.
SETZ CH,
CALL DISINI
SKIPA OUT,[CHCT]
LISTFM: MOVEI OUT,TYOM ;EZ AND EM COMMANDS.
TRNE CH,20
CALL FFRRDD
TLZ FF,FLDIRDPY
HRRM OUT,LISTF5
CALL AOFDIR
LISTF2: HRRZ OUT,LISTF5
CALL GFDBLK
CAIN OUT,TYOM ;IF DUMPING CRUD INTO BUFFER,
JRST LSTF3 ;THEN DO IT FAST
LISTF6: ILDB CH,FDRP
CAIE CH,EOFCHR
CAIN CH,14
JRST LISTF%
CALL @LISTF5
JRST LISTF6
LSTF3: ANDI CH,-1
CAIE CH,FDRBUF ;DONT ALLOW TO BACK UP BEFORE BEGINNING
SUBI CH,1 ;BACK UP TO LAST WORD .IOT'ED INTO
CAIE CH,FDRBUF ;IF NOT POINTING TO BEGINNING OF BUFFER,
SUBI CH,1 ;THEN BACK UP A WORD FOR "FORM FEED AT END OF LAST WORD" SCREW
MOVEI E,-FDRBUF(CH) ;GET INDEX INTO BUFFER IN E
IMULI E,5 ;CONVERT E TO NUMBER OF CHARACTERS UP TO THIS WORD
HRLI CH,440700 ;CONVERT TO BYTE POINTER TO WORD
LSTF4: ILDB A,CH ;GET CHARACTER FROM LAST WORD (DOES THIS LOOK BACKWARDS TO YOU?)
CAIE A,14 ;IF FORM FEED,
CAIN A,EOFCHR ;OR IF EOF CHARACTER,
JRST .+2 ;THEN FOUND END
AOJA E,LSTF4 ;HAVEN'T FOUND END YET, LOOP BACK
JUMPE E,CPOPJ ;IF NO CHARACTERS THEN THAT'S ALL FOR THIS ROUTINE
MOVEI C,(E)
CALL SLPGET ;INSERT THAT MANY CHARS, GET IDPB BP IN BP.
ILDB CH,FDRP ;NOW GET CHARACTER TO COPY
IDPB CH,BP ;COPY IT
SOJG E,.-2 ;DO IT THE APPROPRIATE NUMBER OF TIMES
IBP FDRP ;INCREMENT FDRP TO MAKE IT APPEAR THAT THE ACTUAL EOF CHARACTER WAS ENCOUNTERED
;PROCESS THE NEXT BLOCK OF THE FILE DIRECTORY BEING LISTED
LISTF%: SKIPN MORFLF
JRST LSTF%2
HRRZ A,LISTF5 ;USER HAS "FLUSHED", SEE IF TYPING OUT
CAIN A,CHCT
JRST LSTF%3 ;TYPING OUT, STOP NOW
LSTF%2: HRRZ CH,FDRP
CAIN CH,FDRBFE
JRST LISTF2 ;MORE TO COME
LSTF%3: .CLOSE CHRAND,
HRRZ A,LISTF5
CAIN A,CHCT
JRST DISCLG
POPJ P,
IFN 0,%%TNX%:
] ;END IFN ITS CONDTIONAL
SUBTTL TWENEX FILE COMMANDS
IFN TNX,[.SEE %%TNX. ;END OF THIS CONDITIONAL
ASLEEP: TRZN FF,FRARG
SETZ C,
LSH C,5 ;CONVERT 30THS OF A SECONDS TO MS (MORE OR LESS)
TRZE FF,FRCLN ;:^S?
JRST ASLEE1 ;YES
CALL IMMQIT ;SLEEP FOR N 30TH'S OF A SECOND
MOVE A,C
DISMS
JRST DELQIT
ASLEE1: JUMPE C,FSLISN ;0:^S IS JUST LIKE FSLISTEN$, SO SAVE TIME THAT ATI, DTI WOULD TAKE.
CALL IMMQIT ;ELSE SLEEP FOR N 30TH'S OF A SECOND
ASLEE5: MOVEI B,1
SKIPGE UNRCHC
SKIPE TYISRC ;IF WE ALREADY KNOW THE ANSWER,
JRST ASLEE4 ;DON'T WASTE TIME ENABLING INTERRUPT.
MOVEI A,.PRIIN
SIBE ;NO SKIP => SETS B TO # CHARS AVAILABLE.
JRST ASLEE4
IFN 20X,[
MOVE A,[.TICTI,,1]
ATI ;ASSIGN ANY TYPEIN TO CHANNEL 1
MOVE A,C
DISMS ;SLEEP OR GET AWAKENED
SETZ B, ;RETURN 0
JRST ASLEE3
ASLEE2: CIS ;FLUSH INTERRUPTS
MOVEI A,.PRIIN
SIBE ;RETURN FS LISTEN
CAIA
SETZ B, ;NOTHING WAITING
ASLEE3: MOVEI A,.TICTI ;UNARM ANY INPUT INTERRUPT
DTI
]
.ELSE [
CAIGE C,50. ;TENEX DOESNT HAVE TYPEIN INTERRUPT, SO TAKE 50. MS NAPS
SKIPA A,C ;LESS THAN INCREMENT, SLEEP FOR REMAINDER
MOVEI A,50. ;ELSE JUST FOR 50.
DISMS
SUBI C,50.
JUMPG C,ASLEE5 ;STILL TIME TO GO
SETZ B, ;TIME RAN OUT, RETURN 0
]
ASLEE4: SETZM IMQUIT
MOVE A,B
JRST CPOPJ1
EQMRK: MOVSI A,(GJ%OLD)
CALL FRD ;E? RETURN 0 IF FILE EXISTS
JRST CPOPJ1 ;IT DOESNT, JUST RETURN ERROR CODE THEN
IFN 10X\FNX,[
MOVE B,[1,,.FBCTL]
MOVEI C,D
GTFDB
];IFN 10X\FNX
RLJFN ;GET RID OF THE JFN
JFCL
IFN 10X\FNX,[
TLNN D,(FB%NXF) ;FILE DOES NOT EXIST?
TDZA A,A ;IT DOES, RETURN SUCCESS
MOVEI A,OPNX2
];IFN 10X\FNX
.ELSE SETZ A, ;RETURN 0 FOR SUCCESS
JRST CPOPJ1
IFN 10X,[ ;STUPID TENICES CANT STANDARDIZE THIS
IF1 [
PRINTX \IIT JSYS TYPE (0 - NONE, 1 - BBN, 2 - SUMEX): \
.TTYMAC FOO
.IIT==FOO
TERMIN
]]
IFN FNX,.IIT==2
IFNDEF .IIT,.IIT==0
IFE .IIT-1,IIT=JSYS 247 ;NOT EVEN THE SAME JSYS NUMBER
IFE .IIT-2,IIT=JSYS 630
;FS CLK INTERVAL$ - SET REAL TIME CLOCK INTERVAL IN 60THS OF SECONDS. VALUE SAVED IN CLKINT.
FSCLKI: TRNN FF,FRARG
JRST FSNORM
FSCLK0: SAVE C ;PRESERVE ARG.
IFN 20X,[
MOVE A,[.FHSLF,,.TIMAL] ;DELETE ALL TIMERS FOR THIS FORK
MOVEI C,3 ;LOSING SYSTEM CHECKS CHANNEL EVEN WHEN NOT USED FOR ANYTHING
TIMER
]
IFE .IIT-1,[
MOVE A,[100000,,.FHSLF] ;DELETE ALL BEFORE THIS TIME
HRLOI B,377777 ;INFINITY
IIT
]
JFCL ;IGNORE ERRORS
REST C
SAVE CLKINT ;GET OLD SETTING, TO RETURN IT.
MOVEM C,CLKINT
CALL FSCLK2 ;SET UP NEXT INTERRUPT, IF DESIRED.
REST A
JRST POPJ1 ;RETURN VALUE.
FSCLK2: SKIPN B,CLKINT ;GET LENGTH OF REAL-TIME INTERVAL
RET ;NO MORE TO DO IF 0
LSH B,4 ;CONVERT TO MSEC, APPROXIMATELY.
IFN 20X,[
MOVE A,[.FHSLF,,.TIMEL] ;SET ELAPSED TIME
MOVEI C,3 ;ON CHANNEL 3
TIMER
]
IFE .IIT-1,[
MOVE A,[400000,,.FHSLF]
IIT
]
IFE .IIT-2,[
MOVE C,B ;NUMBER OF MS UNTIL TIME
MOVEI A,.FHSLF
MOVSI B,10 ;ON CHAN 14.
IIT
]
JFCL ;IGNORE ERROR HERE AS WELL
RET
IFN TEXTIF,[ ;;;[wew] CODE TO CAUSE A TEXTI CALL TO RETURN IMMEDIATELY
XTXTI2: AOSA INTPC2 ;[wew] NOTE THAT IT DOESN'T MATTER IF WE ALSO
XTXTI1: AOSA INTPC1 ;[wew] INCREMENT THE RETURN PC FOR LOWER LEVEL
XTXTI: AOS INTPC ;[wew] INTERRUPTS, SINCE THEY CANNOT OCCUR
PUSH P,A
PUSH P,B
PUSH P,C
MOVEI A,.PRIOU
RFMOD
TRZ B,TT%WK0+TT%DAM ;[wew] RESET TO BINARY MODE
SFMOD
SIBE ;SEE HOW MANY CHARACTERS THERE ARE
TRNA
JRST XTXTI3 ;NO CHARACTERS, RETURN
MOVN C,B
ADDM C,TXTIBK+.RDDBC ;UPDATE BYTE COUNT
MOVE B,TXTIBK+.RDDBP
SIN ;INPUT THE WAITING CHARACTERS
MOVEM B,TXTIBK+.RDDBP ;SAVE UPDATE BYTE POINTER
XTXTI3: POP P,C
POP P,B
POP P,A
RET
];TEXTIF
TSINTC: SETOM CLKFLG ;REAL-TIME INTERRUPT, SAY IT IS TIME TO RUN HANDLER
INSIRP PUSH P,A B C
HRRZ A,INTPC2 ;GET WHERE INTERRUPT CAME FROM
IFN TEXTIF,[
CAIE A,RRECI7 ;[wew] WAITING FOR INPUT?
JRST .+3
CALL XTXTI2 ;[wew] CAUSE TEXTI TO END IMMEDIATELY
SETOM RROHPO ;[wew] SAY WE DON'T KNOW WHERE THE CURSOR IS
];TEXTIF
CAIN A,TYIIOT ;WAITING FOR INPUT?
CALL [ SUBI A,1 ;YES, RUN THE HANDLER NOW, BUT IN CASE AN ERRSET GOES OFF
MOVEM A,INTPC2 ;DURING THE MACRO EXECUTION, ENSURE WE RESTART THE PBIN
JRST RLTCLK] ;AND DONT EVER FALL THROUGH WITH GARBAGE USER DIDNT TYPE
CALL FSCLK2 ;SETUP NEW TIMER FOR NEXT TIME
INSIRP POP P,C B A
DEBRK
IFN 20X\FNX, ERJMP .+1
JRST @INTPC2
EGET: SAVE LISTF5 ;EG - INSERT STUFF INTO BUFFER
MOVEI A,TYOM
HRRM A,LISTF5
CALL GAPSLP
TLZ FF,FLDIRDPY
HRROI A,BAKTAB
SETO B, ;CURRENT TIME
MOVSI C,(OT%NMN\OT%DAM)
ODTIM
MOVE A,[350700,,BAKTAB+1]
MOVEI C,1
CALL EGETYP
MOVE A,[440700,,BAKTAB]
MOVEI C,2
CALL EGETYP
CALL CRR1
MOVE A,[100700,,BAKTAB+1]
MOVEI C,3
CALL EGETYP
CALL CRR1
GJINF ;CONNECTED DIRECTORY
HRROI A,BAKTAB
DIRST
SETZM BAKTAB
MOVEI A,BAKTAB
CALL ASCIND
CALL CRR1
MOVEI E,DEFDEV
CALL FSDFR1 ;INSERT CURRENT FILENAME DEFAULTS
CALL CRR1
TLNN FF,FLIN ;HAVE AN OPEN INPUT FILE?
JRST EGET2
MOVEI E,ERDEV ;YES, INSERT IT'S REAL NAME
CALL FSDFR1
EGET2: CALL CRR1
HRROI A,BAKTAB ;CURRENT DATE IN ENGLISH FORMAT
SETO B,
MOVSI C,(OT%DAY\OT%FDY\OT%4YR\OT%DAM\OT%SPA\OT%NTM\OT%SCL)
ODTIM ;"MONDAY, NOV 28 1977"
MOVE A,[440700,,BAKTAB]
MOVEI C,3 ;REPLACE THIRD SPACE WITH COMMA
ILDB B,A
CAIE B,40
JRST .-2
SOJG C,.-3
MOVEI B,",
DPB B,A
MOVEI A,BAKTAB
CALL ASCIND
CALL CRR1
CALL CRR1
CALL POM ;THE PHASE OF THE MOON (CLOSE)
CALL CRR1
REST LISTF5 ;RESTORE THINGS
RET
EGETYP: ILDB CH,A ;INSERT 2 CHARS AND THEN FLUSH THE NEXT ONE C TIMES
CAIN CH,40
MOVEI CH,"0
XCT LISTF5
ILDB CH,A
XCT LISTF5
SOJLE C,CPOPJ
IBP A
JRST EGETYP
;TYPE OUT PHASE OF THE MOON
POM: GTAD
SUB A,SYNOFS ;OFFSET TO NEAREST NEW MOON TO DAY 0
IDIV A,SYNP ;DIVIDE INTO QUARTER PERIODS
ANDI A,3 ;GET PERIOD
MOVEI A,PHSNMS(A)
CALL ASCIND ;TYPE ITS NAME
MULI B,24.*60.*60. ;CONVERT TO SECONDS
LSH C,1 ;FLUSH DUPLICATE SIGN BIT
LSHC B,17. ;GET ONE WORD PRODUCT
MOVEI E,TDHMST
TDHMS1: IDIVI B,@(E)
JUMPE B,TDHMS2
HRLM C,(P)
CALL [AOJA E,TDHMS1] ;INCREMENT AND RECURSE
HLRZ C,(P)
TDHMS2: CALL DPT ;TYPE IN IN DECIMAL
HLLZ A,(E)
SOJA E,SIXIN1 ;BACK UP, TYPE AND RETURN
; USE SOME OTHER OUTPUT ROUTINE, SUCH AS SIXNTY OR ASCIND.
PHSNMS: ASCII /NM+/
ASCII /FQ+/
ASCII /FM+/
ASCII /LQ+/
TDHMST: SIXBIT /S./+60.
SIXBIT /M./+60.
SIXBIT /H./+24.
SIXBIT /D./+<,-1>
SYNP: <29.53059&<777,,-1>>_-6 ;LENGTH OF QUARTER IN GTAD UNITS
SYNOFS: 22,,253553 ;18 DAYS AND A BIT
FRDOLD: MOVSI A,(GJ%OLD) ;INSIST ON OLD FILE
CALL FRD
JRST OPNER1 ;DOESNT EXIST, ERROR
IFN 10X\FNX,[ ;THIS IS EXTREMELY DISTASTEFUL
SKIPN DEFFN2 ;IS THERE SUPPOSED TO BE AN EXTENSION?
RET ;NO, OK THEN
MOVE B,A ;YES, WE MUST CHECK FOR A GROSS MISFEATURE IN THE TENEX FILESYSTEM,
HRROI A,BAKTAB ;WHEREBY IF FILE WITH DEFAULT FN2 DOES NOT EXIST BUT A FILE WITH A NULL
MOVSI C,000200 ;FN2 DOES, IT WILL STILL BE FOUND
JFNS ;SEE WHAT THE EXTENSION OF THE FILE WE GOT IS
MOVE A,B
LDB B,[350700,,BAKTAB]
JUMPN B,CPOPJ ;NON-NULL, OK
RLJFN ;FOO! WE HAVE BEEN SCREWED, GET RID OF LOSING JFN
JFCL
MOVEI 2,GJFX19
JRST OPNER4 ;AND FAKE NO SUCH EXTENSION ERROR
]
.ELSE RET
FRD0: TDZA A,A
FRDFOU: MOVSI A,(GJ%FOU)
; GET A JFN FROM A FOLLOWING STRING, USING THE CURRENT DEFAULTS
; TAKES GTJFN FLAGS IN 1 RETURNS +1 A/ ERROR CODE OR +2 A/ JFN
FRD: CALL FFRRDD ;CONVERT STRING TO FILESPEC FORMAT
FF5: SETZ B,
FF5A: MOVE C,[.NULIO,,.NULIO]
SETO D, ;USE ALL DEFAULT FIELDS
CALL FF4
MOVEI A,BAKTAB
GTJFN
RET ;SINGLE RETURN
JRST CPOPJ1 ;SKIP RETURN WITH THE JFN
FFRRTS: TRNN FF,FRARG ;:ET - GET FROM TTY IN ECHO AREA
TLZA A,-1
HRLZ A,C ;ANY ARGUMENT IS THE GTJFN FLAGS
IFN COMNDF,TLO A,(GJ%FLG) ;RETURN FLAGS AS WELL
.ELSE TLO A,(GJ%FLG\GJ%CFM) ;ASSURE CONFIRMED
SETZ B, ;NO STRING
MOVE C,[.PRIIN,,.PRIOU] ;FROM TTY:
MOVE D,ETMODE ;WITH FS :ET MODE MASK OF DEFAULTS TO USE
FF4: MOVEM C,BAKTAB+.GJSRC
TRNN D,1 ;DEFAULT GENERATION NUMBER?
TRZA A,-1 ;NO, USE 0 THEN
HRR A,DEFFN3 ;GET DEFAULT GENERATION NUMBER
TLO A,4 ;SET GJ%XTN BIT ON.
MOVEM A,BAKTAB+.GJGEN
.GJFN1==.GJNAM
.GJFN2==.GJEXT
IRPS STR,,[FN2 FN1 DIR DEV]
ROT D,-1
TRNE D,1 ;DEFAULT THIS FIELD?
SKIPN DEF!STR ;AND HAVE A DEFAULT?
TDZA A,A ;NO OR NO
HRROI A,DEF!STR ;YES, GET IT
MOVEM A,BAKTAB+.GJ!STR
TERMIN
SETZM BAKTAB+.GJPRO ;CLEAR OUT THE REMAINDER OF THE BLOCK
MOVE A,[BAKTAB+.GJPRO,,BAKTAB+.GJPRO+1]
IFN COMNDF,GTBEND==BAKTAB+.GJATR
.ELSE GTBEND==BAKTAB+.GJACT
BLT A,GTBEND
MOVE A,GJBITS ;GET GJ%XTN BITS
MOVEM A,BAKTAB+.GJF2 ;AND SAVE INTO LONG FORM JFN BLOCK
SETZM GJBITS ;AND CLEAR FOR NEXT TIME...
RET
;READ A FILESPEC, SETTING DEFAULTS FROM IT
FFRRDD: SAVE A
CALL MEMTOP ;GET A POINTER TO START OF FREE BUFFER SPACE
HRLI A,440700 ;MAKE IT A BYTE POINTER
SAVE A ;SAVE IT FOR LATER
SETZ B, ;RESET FLAGS
FFST0: SETZB TT,(A) ;ZERO LAST CHARACTER INSERTED
MOVSI C,(A)
HRRI C,1(A)
BLT C,17(A) ;AND AREA WE WILL BE INSERTING INTO
FFST1: CALL RCH ;GET A CHARACTER
SKIPGE SQUOTP ;SUPERQUOTED?
JRST FFSTQ1 ;YES, INSERT IT QUOTED THEN
CAIL CH,"a
CAILE CH,"z
CAIA
SUBI CH,"a-"A
SKIPN SQUOTP ;NOT A TERMINATOR?
CAIE CH,33 ;ELSE ALTMODE TERMINATES
CAIA
JRST FFST4
TLNE B,040000 ;PARSING DIRECTORY NAME?
JRST FFSTDR ;YES, INSERT IT THEN
CAIE CH,^A
CAIN CH,^X ;WANTS FIRST NAME DEFAULT?
JRST FFSCTX
CAIE CH,^B
CAIN CH,^Y ;WANTS SECOND NAME DEFAULT?
JRST FFSCTY
CAIE CH,^V ;^V OR ...
CAIN CH,^Q ;^Q QUOTES ANOTHER CHARACTER
JRST FFSTQT
CAIN CH,40 ;TRANSLATE SPACE TO DOT
JRST FFSTSP
CAIN CH,": ;END OF DEVICE NAME
JRST FFSTCL
CAIN CH,"< ;MAYBE PART OF DIRECTORY
JRST FFSTLT
CAIN CH,"> ;DITTO
JRST FFSTGT
CAIN CH,". ;NOTICE WHEN WE GET THE DOT
JRST FFSTDT
CAIN CH,"; ;MAYBE PART OF DIRECTORY FOR ITS
JRST FFSTSM
IFN 20X,[CAIE CH,"[ ;THESE NEED TO BE QUOTED
CAIN CH,"]
]
.ELSE CAIN CH,"_ ;THIS NEEDS TO BE QUOTED ON TENEX
JRST FFSTQ2
CAIE CH,"(
CAIN CH,")
JRST FFSTQ2
CAIE CH,"@
CAIN CH,"^
JRST FFSTQ2
FFST2: MOVEI TT,(CH) ;SAVE LAST CHAR INSERTED
FFST3: IDPB CH,A ;STICK IT IN
JRST FFST1 ;AND GET ANOTHER CHAR
FFSTQT: CALL RCH ;^Q QUOTES NEXT CHAR
FFSTQ1: CAIL CH,"A ;DON'T NEED TO QUOTE UPPERCASE
CAILE CH,"Z
JRST FFSTQ2
JRST FFST2
FFSTQ2: MOVEI C,^V
CAIE TT,^V ;UNLESS ^V WAS LAST TO GO IN
IDPB C,A ;INSERT ONE
HRROI TT,(CH) ;SAY CHAR WAS QUOTED
JRST FFST3 ;AND INSERT IT
FFSTDR: CAIE CH,"> ;WAITING FOR DIRECTORY
JRST FFST2
TLZ B,040000
FFSTB4:
IFN EMCSDV\INFODV,[ ;IF CERTAIN DIRECTORIES ARE SPECIAL
MOVE C,DEFDEV ;THEY ARE SPECIAL ONLY IF NO DEVICE SPECIFIED, OR DSK:.
TLNE B,010000 ;DID USER SPECIFY DEVICE?
CAMN C,[ASCII/DSK/] ;YES. DID SHE SPECIFY DSK:? (NECESSARY!!!)
SKIPA
JRST FFSTB5 ;THE DIR NAME IS NOT SPECIAL. SO FUNNY-STR:<EMACS> WORKS.
HRRZ A,(P) ;GET ADDRESS OF STRING
MOVE C,(A) ;AND FIRST WORD THEREOF
IFN EMCSDV,[
CAMN C,[ASCII /EMACS/] ;STARTS WITH EMACS
SKIPE 1(A) ;AND ENDS RIGHT AWAY?
IFE INFODV,SKIPA
]
IFN INFODV,CAMN C,[ASCIZ /INFO/]
JRST [ MOVEM C,DEFDEV ;MAKE THAT THE DEFAULT DEVICE AS WELL
SETZM DEFDEV+1
JRST FFSTB6]
FFSTB5: SKIPE DEFDEV+1
JRST FFSTB6
MOVE C,DEFDEV ;IF NEW DIRECTORY IS NOT A SPECIAL ONE,
CAME C,[ASCII /INFO/] ;THEN IF THE DEVICE IS EMACS: OR INFO:
CAMN C,[ASCII /EMACS/]
TLNE B,010000 ;AND WASN'T JUST SPECIFIED EXPLICITLY,
JRST FFSTB6
MOVE C,[ASCIZ /DSK/] ;RESET IT TO DSK.
MOVEM C,DEFDEV
] ;END EMCSDV\INFODV
FFSTB6: SKIPA A,[DEFDIR]
FFSTB0: MOVEI A,DEFFN1
FFSTB1: HRL A,(P) ;GET START OF WHERE IT IS
FFSTB2: MOVEI C,17(A) ;GET END
BLT A,(C) ;MOVE THE DEFAULT IN
FFSTB3: MOVE A,(P) ;GET FRESH STRING POINTER
JRST FFST0 ;AND CONTINUE
FFSCTX: SKIPA A,[DEFFN1,,0] ;INSERT DEFAULT FN1
FFSCTY: MOVSI A,DEFFN2 ;INSERT FN2
TLO B,400000 ;THESE ARE ITS CONSTRUCTS
JUMPE TT,FFSCT2 ;UNLESS NOTHING SEEN YET,
MOVEI C,DEFFN1 ;SET UP WHAT WE HAVE AS FN1
HRL C,(P)
MOVEI CH,17(C)
BLT C,(CH)
FFSCT2: HRRI A,DEFFN1 ;ASSUME SETTING FN1
TLOE B,200000 ;UNLESS DOT SEEN ALREADY
HRRI A,DEFFN2 ;IN WHICH CASE, FN2
JRST FFSTB2 ;GO SET THEM AND CONTINUE
FFSTSP: JUMPE TT,FFST1 ;SPACE - IF NOTHING YET, FLUSH IT IN ALL CASES
TLO B,400000 ;ELSE IT IS ITS STYLE
TLOE B,200000 ;IF ALREADY HAVE A DOT,
JRST FFST1 ;JUST FLUSH IT
JRST FFSTB0 ;ELSE GO SET FN1 FROM WHAT WE HAVE
FFSTCL: HRRZ A,(P) ;: - GET FIRST WORD FOR DEVICE
TLO B,010000 ;USER SPECIFIED A DEVICE
MOVE C,(A)
MOVEM C,DEFDEV
MOVE C,1(A)
MOVEM C,DEFDEV+1
JRST FFSTB3 ;AND GO GET MORE
FFSTLT: JUMPGE B,FFSTL2 ;< - IF NOT ITS, MUST BE DIRECTORY
SKIPA C,[.GJLEG] ;ELSE WANT OLDEST VERSION
FFSTGT: MOVEI C,.GJDEF ;> - WANT NEWEST VERSION
MOVEM C,DEFFN3 ;SET UP DEFAULT GEN NUMBER
SETZM DEFFN2 ;AND DEFAULT FN2 TO NULL
TLOA B,320000 ;BOTH NAMES SEEN
FFSTL2: TLO B,040000 ;LOOK FOR DIRECTORY NAME
JRST FFST1
FFSTDT: JUMPL B,FFSTQ2 ;QUOTE IT IF ITS STYLE
TLOE B,200000 ;ALREADY HAVE A DOT?
JRST FFSTD2 ;YES, MUST BE END OF FN2 OR GENERATION NUMBER
JUMPN TT,FFSTB0 ;NON NULL STRING, MUST TERMINATE FN1
TLO B,400000 ;ELSE ITS STYLE,
JRST FFSTQ2 ;SO INSERT IT QUOTED
FFSTD2: TLOE B,100000 ;ALREADY HAVE BOTH DOTS?
JRST FFSTD3 ;YES, MUST BE END OF GENERATION NUMBER THEN
MOVEI A,DEFFN2 ;ELSE, SET DEFAULT FN2
JRST FFSTB1 ;AND RETURN
FFSTD3: TLOE B,020000 ;EVERYTHING SEEN
JRST FFST1 ;ALREADY ALL SEEN, FLUSH IT THEN
CALL FFSGEN ;GET GENERATION NUMBER FROM STRING
JRST FFSTB3 ;AND RETURN
FFSTSM: TLNE B,200000 ;IF DOT SEEN ALREADY,
JRST FFSTD2 ;TREAT IT AS A DOT NOW
TLO B,400000 ;ELSE, ITS'S ITS STYLE
JRST FFSTB4 ;AND THE DIRECTORY
FFST4: POP P,A ;GET BACK STRING POINTER
TLNE B,020000 ;IF EVERYTHING SEEN ALREADY,
JRST POPAJ ;DONE
TLNE B,300000 ;IF EITHER FN1 OR FN2 SEEN,
SETZM DEFFN3 ;RESET THE GENERATION NUMBER
JUMPE TT,[TLNN B,100000
TLNN B,200000
JRST POPAJ ;NOT PARSING FN2, DONE
JRST FFST4B]
TLNE B,040000 ;IF WAITING FOR DIR,
JRST FFST4D ;FINISH IT UP
TLNE B,100000 ;IF PARSING GENERATION NUMBER
JRST FFST4G ;GO DO THAT
TLNE B,200000 ;IF PARSING FN2,
JRST FFST4B
SKIPLE C,FNAMSY ;FS FNAM SYNTAX$ > 0 => DEFAULT FN1
JRST FFST4A ;GO SET FN1
JUMPE C,FFST4B ;0 => GO SET FN2
SETZM DEFFN2 ;DEFAULT TO FOO..0
FFST4A: SKIPA C,[DEFFN1] ;SETTING DEFFN1
FFST4B: MOVEI C,DEFFN2 ;SETTING DEFFN2
FFST4C: HRLI C,(A) ;SOURCE
MOVEI A,17(C)
BLT C,(A) ;SET IT UP
JRST POPAJ ;AND RETURN
FFST4D: MOVEI C,DEFDIR ;SETTING DIRECTORY
JRST FFST4C
FFST4G: CALL FFSGN0 ;SET GENERATION NUMBER
JRST POPAJ ;AND RETURN
FFSGEN: MOVE A,-1(P) ;GET STARTING POINTER
FFSGN0: SETZB TT,C ;INIT NUMBER
ILDB CH,A ;PEEK FIRST CHAR
CAIN CH,"*
JRST [ MOVNI TT,3
JRST FFSGN4]
CAIE CH,"- ;NEGATIVE?
JRST FFSGN2 ;NO
SETO C, ;SAY NEGATIVE NUMBER
FFSGN1: ILDB CH,A ;GET CHARACTER
FFSGN2: CAIL CH,"0
CAILE CH,"9
JRST FFSGN3
IMULI TT,10.
ADDI TT,-"0(CH)
JRST FFSGN1
FFSGN3: SKIPGE C ;NEGATIVE?
MOVNS TT ;YES
FFSGN4: MOVEM TT,DEFFN3 ;SET UP DEFAULT GEN NUMBER
RET
;SET UP DEFAULTS FROM STRING FOLLOWING
ETCMD: TRZN FF,FRCLN ;:ET?
JRST FFRRDD ;NO
FFRRTT:
IFE COMNDF,[
TRZN FF,FRARG2 ;WAS THERE A STRING TOO?
JRST FFRRT4 ;NOPE
MOVE CH,SARG ;YES, GET IT
CALL FSECO1 ;TYPE IT OUT IN THE ECHO AREA
FFRRT4:
];COMNDF
CALL ECOPOS ;POSITION TO CURRENT PLACE IN ECHO AREA
CALL DPYRSS ;RESET DISPLAY MODE
MOVEI A,.CTTRM
RFMOD
SETOM IMQUIT ;ALLOW ^G'ING OUT OF GTJFN
MOVEM B,SAVMOD ;SAVE TTY MODE (ALSO FOR ^G TO USE)
IFN 20X,[
MOVE CH,RGETTY ;DON'T CHANGE MODES WITH VTS
CAIN CH,VTSI
JRST FFRRT0
]
TRO B,1_6\TT%ECO ;MAKE SURE ECHO ON AND DATA MODE OK
SFMOD
IFN 20X,[
MOVE B,TTLPOS
SFPOS ;MAKE SURE MONITOR KNOWS HORIZONTAL POSITION
BKJFN
JRST FFRRT0
BIN ;GET THE LAST CHARACTER TYPED
CAIN B,15 ;WAS IT CR?
BIN ;YES, READ LF TOO
FFRRT0: ];20X
CALL FFRRTS ;SET UP BAKTAB AS GTJFN ARG BLOCK.
IFN COMNDF,[
CMDBF==GTBEND+1 ;STATE BLOCK FOR COMND JSYS
CMDBFT==CMDBF+12 ;TEXT BUFFER FOR COMND JSYS. HOLDS 200. CHARS.
CMDBFA==CMDBFT+<200./5> ;ATOM BUFFER. HOLDS 200. CHARS.
CMDRTY==CMDBFA+<200./5> ;PROMPT STRING
IFL BAKTAB+LTABS-CMDRTY-10,.ERR BAKTAB TOO SHORT
MOVE A,[CM%XIF+FFRRTE] ;REPARSE ADDRESS
MOVEM A,CMDBF+.CMFLG
MOVE A,[.PRIIN,,.PRIOU]
MOVEM A,CMDBF+.CMIOJ
HRROI A,CMDBFT
MOVEM A,CMDBF+.CMBFP
MOVEM A,CMDBF+.CMPTR
MOVEI A,200.
MOVEM A,CMDBF+.CMCNT
MOVEM A,CMDBF+.CMABC
SETZM CMDBF+.CMINC
HRROI A,CMDBFA
MOVEM A,CMDBF+.CMABP
MOVEI A,BAKTAB
MOVEM A,CMDBF+.CMGJB
MOVE A,[440700,,CMDRTY] ;POINTER FOR PROMPT STRING
MOVEM A,CMDBF+.CMRTY
TRZN FF,FRARG2 ;WAS THERE A PRE-COMMA ARG?
JRST FFRRT9 ;NO, USE NULL STRING THEN
SKIPL A,SARG ;GET ARG, SHOULD BE BYTE POINTER
CAIA
CALL QLGET0 ;GET BYTE POINTER AND SIZE OF STRING
TYPRE [ARG]
MOVE A,CMDBF+.CMRTY ;GET WHERE TO PUT IT AGAIN
FFRRT8: ILDB CH,BP
IDPB CH,A
SOJG B,FFRRT8 ;MOVE IT ALL IN
FFRRT9: MOVEI CH,0 ;END WITH NULL
IDPB CH,A
MOVEI A,CMDBF
MOVEI B,[.BYTE 9 ? .CMINI] ;INITIALIZE COMND STATE BLOCK
COMND
FFRRTA: MOVEI D,[FFRRT7] ;NORMALLY FAILURE OF COMND MEANS AN ERROR.
MOVE C,BAKTAB ;LOOK AT GTJFN FLAGS. C IS TEMP HERE.
TLNE C,GJ%NEW ;IF NO REQUEST FOR OLD OR NEW FILE,
JRST FFRRT4
IFE STANSW,[
MOVE C,ETMODE ;AND EXTENSION DEFAULTING IS WANTED,
TRNN C,20
JRST FFRRT4
MOVEI D,FFRRT3 ;THEN RETRY A FEW TIMES WITH DIFFERENT FLAGS
;AND DEFAULTS.
];IFE STANSW
IFN STANSW,[
MOVEI D,FFRRT3 ;GET READY TO TRY FLUSHING DEFAULTS
MOVE C,ETMODE ;GET FLAGS
TRNN C,20 ;SEE IF EXTENSION DEFAULTING
MOVEI D,[FFRRTZ ;NO EXTENSION DEFAULT - SET UP TO TRY FOR OLD
FFRRT7] ; FILE THEN NEW FILE THEN GIVE UP
];IFN STANSW
MOVSI C,(GJ%OLD)
IORB C,BAKTAB+.GJGEN
TLNN C,(GJ%IFG) ;UNLESS PARSING WILDCARDS
HLLZS BAKTAB+.GJGEN ;DON'T ACTUALLY GIVE GTJFN A NONZERO DEFAULT VERSION.
SKIPA B,[CMDFOC] ;FILE OR CONFIRM
FFRRT4: MOVEI B,[.BYTE 9 ? .CMFIL] ;FILE ONLY
MOVEI A,CMDBF
COMND
TLNE A,(CM%NOP) ;DID IT PARSE OK?
AOJA D,@(D) ;NO, TRY SOMETHING ELSE
HRRZS C ;GET THE ONE PARSED SUCCESSFULLY
CAIN C,CMDCFM ;WAS IT A FILE WE GOT?
JRST FFRRT1 ;NO, NO JFN THEN, CAN RETURN
HRRZ C,CMDBF+.CMCNT ;GET CHARACTERS LEFT IN THE BUFFER
CAIL C,200. ;IF NOTHING TYPED YET
JRST [ MOVE A,B
RLJFN ;DON'T LEAVE AROUND JFNS
JFCL
JRST FFRRT1] ;JUST LEAVE DEFAULTS ALONE IN THIS CASE
MOVE D,B ;B HAS <GTJFN FLAGS>,,JFN
MOVEI A,CMDBF
MOVEI B,CMDCFM ;NOW CONFIRM THE SELECTION
COMND
CFMPC: EXCH D,A ;RECOVER JFN
TLNE D,(CM%NOP) ;NOT CONFIRMED?
JRST [ RLJFN
JFCL
JRST FFRRT7]
FFRRTB:
] ;COMNDF
.ELSE [
MOVEI A,BAKTAB
GTJFN
JRST FFRRT7
]
PUSH P,A ;SAVE FLAGS
CALL FFSET ;SET UP DEFAULTS FROM JFN
ANDI A,-1
RLJFN ;FLUSH REAL JFN
JFCL
POP P,A ;GET BACK JFN FLAGS
TLNE A,(GJ%VER) ;IF VERSION NUMBER HAD WILDCARDS
JRST [ HRROI B,-3
MOVEM B,DEFFN3 ;SET IT TO DEFAULT RIGHT
JRST FFRRT1]
SKIPL BAKTAB+.GJGEN ;FOR OUTPUT USE?
JRST [ TLNE A,(GJ%UHV) ;NO, HIGHEST EXISTING = 0
JRST .+2
JRST .+3]
TLNE A,(GJ%NHV) ;YES, NEXT HIGHER = 0
SETZM DEFFN3 ;SETUP VERSION NUMBER DEFAULT RIGHT
FFRRT1: SETZM IMQUIT ;NO MORE ^G AFTER THIS
MOVE B,SAVMOD ;RESTORE TTY MODE AFTER GTJFN
IFN 20X,[
MOVE CH,RGETTY
CAIN CH,VTSI
JRST FFRT2A
]
FFRRT2: MOVEI A,.CTTRM
SFMOD
FFRT2A: SETZM SAVMOD ;AND NO MODE TO RESTORE
JRST DPYINI
IFN COMNDF,[
;TABLE OF PLACES TO GO IF COMND FAILS.
FFRRT3: FFRRT5 ;AFTER FIRST TRY, TRY WITHOUT DEFAULT EXT
FFRRTF ;NEXT FLUSH DEFAULT FILENAME, PUT BACK EXTENSION.
FFRRT5 ;NEXT FLUSH BOTH DEFAULTS.
FFRRT6 ;NEXT ALLOW A NEW FILE AND TRY AGAIN, WITH DEFAULTS
FFRRT7 ;FAILS AGAIN => REALLY LOSES.
FFRRT5: SETZM BAKTAB+.GJEXT ;THIS TIME NO DEFAULT EXTENSION
JRST FFRRT4
FFRRTF: SKIPE A,DEFFN2 ;GET THE DEFAULT EXTENSION AGAIN
HRROI A,DEFFN2
MOVEM A,BAKTAB+.GJEXT
SETZM BAKTAB+.GJNAM ;BUT FLUSH THE DEFAULT FILENAME.
JRST FFRRT4
FFRRT6: MOVE A,NUM ;TRY NEW FILE NEXT.
TRNE A,4 ;BUT NOT IFUSER WANTS ONLY EXISTING FILE.
JRST FFRRT7
SKIPE A,DEFFN2 ;GET THE DEFAULT EXTENSION AGAIN
HRROI A,DEFFN2
MOVEM A,BAKTAB+.GJEXT
SKIPE A,DEFFN1 ;GET THE DEFAULT FILENAME AGAIN.
HRROI A,DEFFN1
MOVEM A,BAKTAB+.GJNAM
MOVSI C,(GJ%OLD) ;STOP INSISTING ON AN EXISTING FILE.
ANDCAM C,BAKTAB
JRST FFRRT4
IFN STANSW,[
FFRRTZ: MOVSI C,(GJ%OLD) ;ACCEPT NEW FILE NOW, NO DEFAULTS
ANDCAM C,BAKTAB
JRST FFRRT4
];IFN STANSW
FFRRTE: MOVE A,D ;REPARSE, IF THERE IS A JFN, FLUSH IT
TLZE A,-1
RLJFN
JFCL
MOVE C,NUM ;RESET GTJFN BLOCK
CALL FFRRTS
JRST FFRRTA ;AND TRY AGAIN FROM THE BEGINNING
CMDFOC: <.BYTE 9 ? 0 ? 0 ? .CMFIL>,,CMDCFM ;PARSE FILE OR CONFIRM
CMDCFM: <.BYTE 9 ? .CMCFM>
] ;COMNDF
;HERE IF WE GIVE UP ON FLUSHING DEFAULTS -- REALLY MAKE AN ERROR.
FFRRT7: CALL FFRRT1 ;RESTORE TTY MODE FIRST
JRST OPNER2 ;THEN REPORT ERROR
;SET UP FILENAME DEFAULTS FROM A JFN IN 1
ROUNMS: MOVEI E,ROUDEV ;GIVE FILENAMES FOR LAST REAL OUTPUT FILE
JRST FFSET1
RREDGN: SKIPA E,[ERDEV] ;FOR LAST READ FILE
FFSET: MOVEI E,DEFDEV ;FOR CURRENT DEFAULTS
FFSET1: SETZM (E)
MOVSI C,(E)
HRRI C,1(E)
BLT C,ERDEV-1-DEFDEV(E) ;ZERO OUT BLOCK FIRST
SAVE A ;SAVE JFN TO SET THEM FROM
ANDI A,-1
MOVE B,[1,,.FBGEN]
MOVEI C,C
GTFDB
ERJMP FFSET2 ;FAILED, LEAVE AT 0
HLRZM C,DEFFN3-DEFDEV(E) ;GENERATION NUMBER
FFSET2: MOVE B,(P)
JS%FN1==JS%NAM
JS%FN2==JS%TYP
IRPS STR,,[DEV DIR FN1 FN2]
HRROI A,DEF!STR-DEFDEV(E)
MOVSI C,(JS%!STR)&101100
JFNS
TERMIN
JRST POPAJ
FFSET3: MOVEI E,DEFDEV ;SETUP DEFAULTS
SAVE A
JRST FFSET2
FSIFIL: SKIPA E,[ERDEV] ;DESCRIBE INPUT FILE
FSOFIL: MOVEI E,ROUDEV ;DESCRIBE LAST OUTPUT FILE
AOSA (P)
FSDFRD: MOVEI E,DEFDEV ;DESCRIBE DEFAULTS
SAVE C
MOVEI C,140. ;BE SURE LONG ENOUGH
CALL QOPEN
CALL FSDFR1
FSDFRT: CALL QCLOSV ;CLOSE UP Q REG SPACE AND GIVE STRING
JRST POPCJ
;PRODUCE STRING OF DEFAULTS CONTAINED IN BLOCK POINTED TO BY E
FSDFR1:
;PRODUCE STRING OF DEFAULTS CONTAINED IN BLOCK POINTED TO BY E
FSDFR1: MOVEI A,DEFDEV-DEFDEV(E)
CALL ASCIND ;DEVICE
MOVEI CH,":
LDB A,[350705,,DEFDEV-DEFDEV]
SKIPE A ;NO USELESS PUNCTUATION.
CALL @LISTF5
LDB A,[350705,,DEFDIR-DEFDEV] ;IS THERE A DIRECTORY TO BE MENTIONED?
JUMPE A,FSDFR2
MOVEI CH,"<
CALL @LISTF5
MOVEI A,DEFDIR-DEFDEV(E) ;DIRECTORY
CALL ASCIND
MOVEI CH,">
CALL @LISTF5
FSDFR2: MOVEI A,DEFFN1-DEFDEV(E) ;NAME
CALL ASCIND
MOVEI CH,".
CALL @LISTF5
MOVEI A,DEFFN2-DEFDEV(E) ;EXTENSION
CALL ASCIND
IFN 20X,MOVEI CH,".
.ELSE MOVEI CH,";
CALL @LISTF5
HRRE C,DEFFN3-DEFDEV(E) ;GENERATION NUMBER
JRST DPT
;FILE COPY
FCOPY: CALL FRDOLD ;GET FIRST FILENAME
MOVE B,[7_30.+OF%RD] ;OPEN FOR 7 BIT READ
MOVEM A,OPNJFN
OPENF
JRST OPNER0
SETZM OPNJFN
SAVE A
CALL FRDFOU ;GET SECOND ONE
JRST OPNER1
MOVE B,[7_30.+OF%WR]
MOVEM A,OPNJFN
OPENF
JRST [ POP P,A
RLJFN
JFCL
JRST OPNER0
]
SETZM OPNJFN
TRNN FF,FRCLN ;: E_ XFER INPUT FILE DATES TOO
JRST FCOPY2
EXCH A,(P) ;INPUT FILE
IFN 20X,[
MOVEI B,T
MOVEI C,1
RFTAD
EXCH A,(P)
SFTAD
]
.ELSE [
MOVE B,[1,,.FBWRT]
MOVEI C,C
GTFDB
EXCH A,(P)
HRLI A,.FBWRT
SETO B,
CHFDB
ANDI A,-1
]
FCOPY2: EXCH A,(P) ;GET INPUT FILE
MOVE B,[440700,,BAKTAB]
MOVNI C,LTABS*5
SIN
ADDI C,LTABS*5 ;GET NUMBER OF WORDS REALLY TRANSFERED
JUMPE C,FCOPY4 ;NONE, EOF
MOVN C,C
MOVE B,[440700,,BAKTAB]
EXCH A,(P) ;OUTPUT FILE
SOUT
JRST FCOPY2
FCOPY4: CLOSF ;CLOSE INPUT FILE
JFCL
REST A ;FILE JUST WRITTEN
CLOSF
JFCL
JRST DELQIT
;OPEN INPUT FILE AND BIGPRINT NAME ON OUTPUT DEVICE
BPNTRD: CALL .OPNRD
TRZ FF,FRARG
JRST .FNPNT
;OPEN FILE FOR READ
.OPNRD: CALL FRDOLD
MOVEM A,OPNJFN
SETZ A,
EXCH A,CHFILI
TLZN FF,FLIN ;JUST IN CASE
JRST [ JUMPE A,RRED2
RLJFN
JFCL
JRST RRED2]
CLOSF
JFCL
RRED2: MOVE A,OPNJFN
IFN 20X\SUMTTF,MOVE B,[36._30.+OF%RD]
.ELSE MOVE B,[36._30.+OF%RD+OF%EX] ;THIS IS THE BIGGEST CROCK
TRNE FF,FRARG
TDO B,NUM
TRZN FF,FRARG2 ;PRE-COMMA ARG?
JRST RRED3
MOVE C,SARG
TRNE C,1 ;1 BIT MEANS DON'T UPDATE REFERENCE DATES
TRO B,OF%PDT
TRNE C,2 ;2 BIT MEANS OPEN IN THAWED MODE
IFN DREA, TRO B,OF%THW\OF%WR ;AND OPEN FOR WRITE AS WELL
.ELSE TRO B,OF%THW
TRNE C,4 ;4 BIT MEANS DON'T REALLY OPEN
JRST RREDGN ;JUST SET REAL NAMES AND RETURN
RRED3: CALL IMMQIT
OPENF
JRST OPNER0
SETZM OPNJFN
MOVEM A,CHFILI
SETZM IMQUIT
SETZM PAGENU
SETOM LASTPA
CALL RREDGN ;SET UP REAL FILENAMES OF INPUT FILE
;HERE TO ACTUALLY START READING FROM IT
RRED1: TLO FF,FLIN
MOVEI CH,EOFCHR
DPB CH,[350700,,UTIBE]
MOVE CH,[010700,,UTIBE-1]
MOVEM CH,UTYIP
AOJ CH,
HRRM CH,UTRLDT
RET
; I/O PDL COMMANDS
;E[ - PUSH INPUT JFN AND STATE
PSHIC: TLZ FF,FLDIRDPY
TLNN FF,FLIN ;ANYTHING OPEN NOW?
JRST PSHIC2
MOVE A,CHFILI ;GET CURRENT POSITION
RFPTR
TYPRE [NRA]
MOVE C,UTYIP ;GET CURRENT POINTER
IBP C ;FIGURE HOW MANY WORDS WE HAVENT USED
MOVEI T,(C)
SUB T,UTRLDT
HRREI T,(T)
JUMPE T,PSHIC2
ADD B,T ;RESET BYTE POSITION BEFORE THEM
SFPTR
TYPRE [NRA]
PSHIC2: MOVE E,PAGENU ;SAVE PAGENU AND LASTPA
LSH E,1
SUB E,LASTPA
LSH E,2
TLNE FF,FLIN ;AND STATE OF FLIN
ADDI E,2
HRRI C,1(E)
MOVE A,INIOP ;GET INPUT PDL POINTER
PUSH A,CHFILI ;PUSH JFN
PUSH A,C ;PUSH STATE THEREOF
MOVEM A,INIOP ;UPDATE PDL POINTER
TLZ FF,FLIN
SETZM CHFILI ;FORGET JFN
JRST UTLSTP ;SET TO SEE EOF
;E] - POP INPUT JFN
POPIC: TLZ FF,FLDIRDPY
CALL UICLS ;CLOSE ANYTHING WE HAVE NOW
MOVE C,INIOP ;GET INPUT PDL POINTER
POP C,CH ;GET STATE FLAGS
LDB A,[020100,,CH]
MOVNM A,LASTPA ;STATE OF LASTPA
LDB A,[031700,,CH]
MOVEM A,PAGENU ;STATE OF PAGENU
POP C,A ;GET JFN
MOVEM C,INIOP ;UPDATE PDL POINTER
GTSTS
TLNE B,(GS%OPN) ;IS IT OPEN?
TRNN CH,2 ;AND WE THOUGHT ONE WAS TOO?
RET ;NO OR NO, FORGET IT
TLO FF,FLIN ;YES, SAY ONE IS NOW
MOVEM A,CHFILI ;STORE AWAY JFN
SAVE CH
CALL UTRLD2 ;GET A BUFFER FULL
REST CH
HRRI CH,UTIBUF
DBP7 CH
MOVEM CH,UTYIP ;UPDATE BUFFER POINTER
JRST RREDGN ;AND SET REAL FILENAMES
;E\ - PUSH OUTPUT JFN
PSHOC: TLZ FF,FLDIRDPY
CALL FLSOUT ;FLUSH ANY CURRENT OUTPUT THRU
MOVE B,UTYOP ;GET POINTER TO OUTPUT BUFFER
IBP B
LDB A,[073500,,UTOBUF]
LSHC A,7
MOVE C,OUTIOP ;GET OUTPUT PDL
PUSH C,CHFILO ;SAVE JFN
PUSH C,A ;SAVE STATE OF JFN
MOVEM C,OUTIOP ;UPDATE PDL POINTER
TLZ FF,FLOUT ;SAY NO FILE TO WRITE ON NOW
RET
;E^ - POP OUTPUT CHANNEL
POPOC: TLZ FF,FLDIRDPY\FLOUT ;PERHAPS NO FILE TO WRITE
MOVE C,OUTIOP ;GET OUTPUT PDL POINTER
POP C,CH ;GET STATE
POP C,A ;GET JFN
MOVEM C,OUTIOP ;UPDATE PDL POINTER
GTSTS
TLNN B,(GS%OPN) ;FILE NOW OPEN?
RET ;NO, DONE THEN
MOVEM A,CHFILO ;YES, UPDATE BUFFER POINTERS
MOVEM CH,UTOBUF
MOVE C,[000700,,UTOBUF]
DPB CH,[350700,,C]
DBP7 C
MOVEM C,UTYOP
ANDI CH,177
IDIVI CH,7_1
ADDI CH,<UTOBE-UTOBUF>*5-4
MOVNM CH,UTYOCT ;AND COUNT OF REMAINING BYTES
TLO FF,FLOUT ;SAY WE HAVE AN OUTPUT FILE NOW
RET
EXITE: HRLOI C,377777 ;EE - WRITE OUT FILE AND CLOSE IT
TRO FF,FRARG
MOVE E,BEGV ;ANYTHING IN THE BUFFER?
CAMN E,ZV
SKIPE LASTPA ;OR THE INPUT FILE?
CALL PUNCHA ;YES, WRITE IT OUT THEN
CALL UICLS ;CLOSE ANY INPUT FILE
JRST EFCMD ;AND GO CLOSE AND RENAME OUTPUT FILE
EXITX: TLNN FF,FLOUT ;IF NO OUTPUT FILE
CALL FFRRDD ;STILL READ AND SET DEFAULTS
TLNE FF,FLOUT ;IF HAVE AN OUTPUT FILE,
CALL EXITE ;FINISH IT UP
IFN 20X,[
MOVE A,[.PRAST,,.FHSLF] ;SET THIS FORK
MOVEI B,[1 ;MAGIC FOR THE EXEC
400740,,2
0]
MOVEI C,3 ;LENGTH
PRARG ;SET PROCESS ARG BLOCK
]
.ELSE [ ;THIS IS THE ONLY WAY TO GET BACK CCL FOR 10X
RUN==47000,,35 ;1050 UUO
MOVE A,[1,,[SIXBIT /SYS/
SIXBIT /CCL/
0 ? 0 ? 0 ? 0]]
RUN A, ;SWAP IN CCL AND DO LAST COMMAND AGAIN
JFCL
]
JRST .EXIT ;AND QUIT BACK TO EXEC
EFCMD: CALL FFRRDD ;GET FILE DEFAULTS FOR REAL OUTPUT
TLNN FF,FLOUT ;MUST HAVE AN OUTPUT FILE
TYPRE [NDO]
TDZA A,A ;RESET COUNT OF FILLER BYTES
EFCMDA: CALL UTYO
MOVE CH,UTYOP
HRR CH,FILEPA ;PAD TO EVEN WORD WITH FILEPAD
TLNE CH,760000
AOJA A,EFCMDA
PUSH P,A ;SAVE COUNT OF FILLER BYTES
CALL FLSOUT ;FLUSH OUT LAST OF BUFFER
MOVE A,CHFILO
RFPTR ;GET WHERE WE ARE
SETZ B,
IMULI B,5 ;INTO CHARS
SUBM B,(P) ;LESS FILLERS
TLO A,(CO%NRJ) ;CLOSE, BUT SAVE JFN
CLOSF
JFCL
IFN 10X,[
HRRZS CH,A ;SAVE JFN
DVCHR
HRRI A,(CH) ;GET JFN BACK INTO RH
TLNE A,(DV%TYP) ;CHECK FOR DSK:
JRST EFCMD5 ;DO NOT ATTEMPT CHFDB IF NOT
;20X OR FNX WILL TAKE ERJMP
]
HRLI A,.FBSIZ ;SET FILE SIZE
SETO B,
POP P,C ;TO NOT INCLUDE FILLERS
CHFDB
ERJMP EFCMD5 ;MAYBE ONLY WRITE ACCESS, NO FDB
HRLI A,.FBBYV ;AND SET BYTE SIZE
MOVSI B,(FB%BSZ)
MOVSI C,000700 ;TO BE 7-BIT
CHFDB
EFCMD5: MOVSI C,DEFDEV-ERDEV ;SEE IF FILENAME DEFAULTS HAVE CHANGED
EFCMD4: MOVE B,DEFDEV(C)
CAME B,ROUDEV(C)
JRST EFCMD3 ;DIFFERENT, MUST DO RENAME
AOBJN C,EFCMD4
ANDI A,-1 ;GET JUST JFN
EFCMD2: CALL ROUNMS ;SET UP REAL NAMES OF OUTPUT FILE
RLJFN ;THRU WITH THE JFN
JFCL
TLZ FF,FLOUT ;NO MORE OUTPUT FILE
SETZM CHFILO
RET
EFCMD3: MOVSI A,(GJ%FOU)
CALL FF5 ;GET JFN FOR NEW NAME
JRST OPNER1
MOVEI B,(A)
MOVE A,CHFILO ;RENAME OUTPUT FILE TO IT
RNAMF
JRST [ MOVE A,CHFILO
RLJFN
JFCL
MOVE A,B
RLJFN
JFCL
JRST OPNER1]
MOVEI A,(B)
JRST EFCMD2
;EJ - LOAD IMPURE PORTIONS FROM FILE
;:EJ LOAD LIBRARY FILE INTO PURE STRING SPACE.
;@EJ - WRITE OUT IMPURE PORTIONS IN A BOOTABLE FORMAT
;DUMP FILES CAN BE IDENTIFIED BECAUSE THEY HAVE 'TEC,,VERSION-NUMBER
;IN THE .FBUSW WORD IN THE FDB.
EJCMD: TRZN FF,FRUPRW
JRST EJCMDR ;READ IN
TLZN FF,FLOUT ;@EJ
TYPRE [NDO] ;MUST HAVE AN OUTPUT FILE ALREADY
MOVEM P,BOOTP ;SSAVE DOESNT SAVE AC'S
MOVE A,CHFILO
TLO A,(CO%NRJ)
CLOSF
JFCL ;CLOSE FAKE OUTPUT FILE
HRLI A,(DF%EXP)
DELF ;AND GET RID OF IT
JFCL
SETZM CHFILO ;DONT HAVE THIS SET IN THE DUMPED OUT FILE
SETZM FRKTAB
MOVE A,[FRKTAB,,FRKTAB+1]
BLT 1,FRKTAB+NFKS-1 ;FORGET ANY INFERIORS
CALL FRDFOU ;GET REAL OUTPUT FILE
JRST OPNER1
CALL ROUNMS ;SET UP REAL OUTPUT NAMES
HRLI A,.FBUSW
SETO B,
MOVE C,[SIXBIT /TEC/+.FVERS] ;TO IDENTIFY A DUMP FILE
CHFDB
IFN 20X,[
IFDEF .FBKEP,[
HRLI A,.FBCTL
MOVSI B,(FB%FCF)
MOVSI C,(<.DPB .FBKEP,<.BP FB%FCF>,0>) ;MAKE FILE AUTOKEEP
CHFDB
ERJMP .+1
]];IFN 20X
MOVE TT,[-<<LIMPUR+1>_-9>,,SS%CPY\SS%RD\SS%EXE+0]
MOVEM TT,BAKTAB ;LOW IMPURE
MOVE TT,QRWRT
ADDI TT,4
IDIVI TT,5000
SUBI TT,HIMPUR_-9
MOVNI TT,1(TT) ;NEGATIVE OF NUMBER OF PAGES
HRLI TT,SS%CPY\SS%RD\SS%EXE+HIMPUR_-9
MOVSM TT,BAKTAB+1 ;START OF HIGH IMPURE
MOVE B,BFRBOT
IDIVI B,5000 ;STARTING PAGE OF BUFFER SPACE
MOVE C,BFRTOP
IDIVI C,5000
SUBM B,C ;-LENGTH
HRLI B,-1(C) ;-<NUMBER OF PAGES>
TRO B,SS%CPY\SS%RD\SS%EXE
MOVEM B,BAKTAB+2
HRLI A,.FHSLF
MOVEI B,BAKTAB
SETZB C,BAKTAB+3
SETZM LIMPUR ;MAKE SURE THE EJ FILE LOADS TECPUR IF RUN
SSAVE ;SAVE THOSE IMPURE PAGES
SETOM LIMPUR
RET
;INPUT VERSIONS
EJCMDR: CALL FRDOLD ;GET FILE
TRZN FF,FRCLN
JRST EJCMD2 ;EJ - MAP IN IMPURE AREAS
MOVE B,[36._30.+OF%RD]
MOVEM A,OPNJFN
OPENF
JRST OPNER0
SETZM OPNJFN
SIZEF
TYPRE [URK] ;SOME SORT OF ERROR HERE
ASH C,-1 ;CONVERT PAGES TO BLOCKS
MOVNI B,(C)
ADD B,LHIPAG ;WITHIN RANGE?
CAMG B,MEMT ;LEAVE AT LEAST ONE BLANK PAGE ABOVE BUFFER SPACE.
CALL [ CALL FLSCOR ;BUT SEE IF THERE IS ANYTHING WASTED WE CAN FLUSH
CAMG B,MEMT ;BEFORE DECIDING IT'S FATAL.
TYPRE [URK]
RET]
MOVEM B,LHIPAG ;UPDATE BOTTOM PAGE
ASHC B,1 ;CONVERT BACK TO BLOCKS
HRLI B,.FHSLF
HRLZS A ;JFN
HRLI C,(PM%CNT\PM%RD) ;DON'T ALLOW COPY ON WRITE
;ELSE BUFFER SPACE COULD UNKNOWINGLY OVERWRITE IT.
IFN 20X,PMAP ;MAP IN THOSE PAGES
.ELSE [
MOVEI D,(C)
PMAP ;10X - NO MULTIPLE PMAP'S
SOJLE D,.+3
AOJ A,
AOJA B,.-3
]
HLRZ A,A
CLOSF
JFCL
HRRZ A,LHIPAG ;RETURN POINTER
IMULI A,12000
TLO A,400000
JRST POPJ1
EJCMD2: MOVE B,[1,,.FBUSW] ;CHECK USER SETTABLE WORD
MOVEI C,C
GTFDB
CAME C,[SIXBIT /TEC/+.FVERS] ;A COMPATIBLE DUMP FILE?
TYPRE [AOR] ;NOPE
IFN 20X,[
PUSH P,A
MOVEI A,.CTTRM
RFMOD
SKIPE PAGMOD
TROE B,TT%PGM
CAIA
STPAR
POP P,A
]
MOVE E,LHIPAG
MOVE T,MEMT
MOVE J,INITFL ;SAVE THESE GUYS
HRLI A,.FHSLF
GET ;THIS SHOULD ONLY HAVE IMPURE PAGES
MOVEM E,LHIPAG
MOVE B,D
HRROI A,DEFDIR
DIRST
JFCL
CAMLE T,MEMT
MOVEM T,MEMT
MOVEM J,INITFL
.I SAVCMX=CBMAX=1 ;RESTORE THEM
SETOM PJATY ;WE JUST LOADED INVALID HCDS, SO NEED ALL LINES REDISPLAYED.
JRST INIT ;RESTART OURSELVES
;RENAME FILE 1 TO FILE 2
RENAM: CALL FRDOLD ;GET FIRST FILE
SAVE A
CALL FRDFOU ;GET SECOND FILE
JRST OPNER1
CALL IMMQIT
MOVEI B,(A)
REST A
RNAMF ;DO THE RENAME
JRST OPNER1
MOVEI A,(B)
RLJFN
JFCL
JRST DELQIT
;DELETE A FILE
DELE: TRZE FF,FRCLN
JRST DELE1 ; :ED IS DELETE INPUT FILE.
CALL FRDOLD ;GET OLD FILE JFN
TRNE FF,FRUPRW ;@ED MEANS EXPUNGE THE FILE TOO.
HRLI A,(DF%EXP)
DELF ;DELETE IT
JRST OPNER1
IFN 10X\FNX,[
RLJFN ;ON TENEX, MUST GET RID OF JFN TOO.
JFCL
];10X\FNX
RET
DELE1: TLZN FF,FLIN
TYPRE [NFI]
MOVEI A,0
EXCH A,CHFILI
DELF ;DELETE IT
JRST OPNER1
CLOSF ;CLOSE IT
JFCL
RET
WWINIT: CALL FFRRDD ;EW - GET FILENAME DEFAULTS
EICMD: SKIPG A,CHFILO
JRST WWINI0
TLO A,(CZ%ABT) ;GET RID OF ANY OLD FILE
CLOSF
JFCL
WWINI0: TRNE FF,FRUPRW ;@EW MEANS CAN OVERWRITE
TDZA A,A ;NO GTJFN FLAGS THEN
MOVSI A,(GJ%FOU) ;OTHERWISE USER OUTPUT DEFAULTS
TRNE FF,FRARG2 ;PRECOMMA ARG?
TLO A,(GJ%DEL\GJ%FOU) ;YES. DELETED OK. CREATE FILE ALSO.
CALL FF5 ;GET JFN FROM DEFAULTS
JRST OPNER1
MOVEM A,CHFILO
MOVE B,[36._30.+OF%WR] ;OPEN FOR WRITE
TRNE FF,FRUPRW ;AND IF IN OVERWRITE MODE,
TRO B,OF%RD ;READ TOO, SO FILE NOT CLOBBERED
TRNE FF,FRARG ;POSTCOMMA ARG?
MOVE B,NUM ;YES. USE USER BITS THEN.
CALL IMMQIT
MOVEM A,OPNJFN
OPENF
JRST OPNER0
SETZM OPNJFN
SETZM IMQUIT
TLO FF,FLOUT ;SAY WE HAVE ONE
MOVE CH,[DEFDEV,,ROUDEV] ;SAVE CURRENT FILENAME DEFAULTS
BLT CH,ROUDEV+ERDEV-DEFDEV-1
MOVE CH,[010700,,UTOBUF-1] ;REINIT BUFFER POINTER
MOVEM CH,UTYOP
MOVNI CH,<UTOBE-UTOBUF>*5
MOVEM CH,UTYOCT ;AND BUFFER COUNT
RET
; DO MTOPR ON JFN FROM LH E, WITH ARGS IN C AND SARG
FSMTAP: HLRZS E
MOVE A,(E)
MOVE C,SARG
MTOPR
ERJMP OPNER1
MOVE A,C ;ANY ARG RETURNED IN 3
JRST POPJ1
; READ OR MODIFY FDB FOR INPUT FILE
FSIFDB: TLNN FF,FLIN
TYPRE [NFI]
JRST FSXFDB
FSOFDB: TLNN FF,FLOUT
TYPRE [NDO]
FSXFDB: TRZN FF,FRARG
TYPRE [WNA]
HLRZS E
MOVE A,(E)
MOVEI B,(C) ;FIRST WORD TO DO
HRLI B,1 ;ONE WORD
MOVEI C,D ;WHERE TO PUT IT
GTFDB
TRZN FF,FRARG2 ;WAS THERE A SECOND ARGUMENT?
JRST FSFDB2 ;NO, JUST RETURN OLD VALUE
HRLI A,(B) ;WORD TO CHANGE
MOVE C,SARG ;NEW VALUE
MOVE B,C
XOR B,D ;GENERATE MASK FOR NEW VALUES
CHFDB
ERJMP OPNER1
FSFDB2: MOVE A,D
JRST CPOPJ1
;DIRECTORY DISPLAY COMMANDS
LISTF: CALL LSTFRD ;GET FILESPEC FROM FOLLOWING STRING
CNTRU1: CALL LSTFR2 ;USE DEFAULT (DEV:<DIR>*.*.*)
CALL VBDACU ;SEE IF THERE IS ANY COMMAND WAITING
RET ;RETURN RIGHT AWAY
SETZ CH,
CALL DISINI ;INIT DISPLAY
MOVEI OUT,CHCT ;TYPE OUT
JRST LISTF1
LISTFM: SETZM GJBITS
MOVEI OUT,TYOM ;TYPE INTO MEMORY
TRNE CH,20 ;EZ?
CALL LSTFRD ;YES, READ FROM USER
CALL LSTFR2 ;NO, USE DEFAULTS
LISTF1: SAVE A ;SAVE THE JFN
TLZ FF,FLDIRDPY ;DONT NEED IT AGAIN
HRRM OUT,LISTF5
LISTF2: HRROI A,FDRBUF ;ADDRESS OF SPACE TO KEEP DATA IN.
HRRZ B,(P)
TRNE FF,FRARG ;USE USERS FORMAT IF AN ARGUMENT OF IT
SKIPA C,NUM
MOVE C,[1_27.+1_24.+1_21.+JS%SIZ+JS%LWR+JS%LRD+JS%PSD+JS%PAF]
TRNE FF,FRUPRW ;@?
TRO C,JS%OFL ;YES. SHOW OFFLINE ATTRIBUTE
JFNS ;ALONG WITH SIZE AND READ AND WRITE DATES
TRNE FF,FRARG2 ;WHAT ABOUT 'GIVE AUTHOR' ARG?
JRST LISTFE ;ANY ARG MEANS DON'T GIVE AUTHOR
MOVEI CH,",
IDPB CH,A
EXCH A,B
IFN 20X,[
HRLI A,.GFLWR ;AND THE LAST WRITER TOO
GFUST
ERJMP [DBP7 B ;DON'T LEAVE TRAILING COMMA
JRST .+1]
EXCH A,B
]
.ELSE [
SAVE A
SAVE B
MOVE B,[1,,.FBUSE] ;LAST USER WHO WROTE
MOVEI C,2 ;PUT DIRECTORY NUMBER IN B<LH>
GTFDB
REST A
HLRZ B,B ;MAKE IT ACCEPTABLE
DIRST ;PUT DIRECTORY NUMBER THERE
ERJMP [DBP7 A
JRST .+1]
REST B
]
LISTFE: MOVEI CH,^M ;AND A CRLF
IDPB CH,A
MOVEI CH,^J
IDPB CH,A
MOVEI CH,^@
IDPB CH,A ;END WITH NULL
HRRZ OUT,LISTF5 ;GET WHERE IT GOES
CAIN OUT,TYOM ;INTO MEMORY?
JRST LISTF8 ;YES, DO IT FAST THEN
MOVEI A,FDRBUF ;START OF WHERE STRING IS
CALL ASCIND ;TYPE THIS LINE OUT
SKIPL MORFLF ;--MORE-- FLUSHED?
JRST LISTF3 ;NO
POP P,A ;GET BACK JFN
RLJFN ;GET RID OF IT
JFCL
JRST LISTF7 ;DONE
LISTF8: HRRZ C,A
SUBI C,FDRBUF ;NUMBER OF WORDS
IMULI C,5
LSH A,-30.
HRREI A,-36.+7(A) ;NULL DOESNT COUNT
IDIVI A,7
SUB C,A ;GET TOTAL NUMBER OF CHARS USED
CALL SLPGET ;MAKE THAT MUCH ROOM
MOVE A,[440700,,FDRBUF]
LISTF6: ILDB CH,A ;INSERT GIVEN NUMBER OF CHARACTERS
IDPB CH,BP
SOJG C,LISTF6
LISTF3: MOVE A,(P) ;GET BACK MULTI JFN
GNJFN ;GET NEXT FILE
CAIA ;NONE LEFT
JRST LISTF2 ;TAKE CARE OF IT TOO
POP P,A ;FLUSH JFN
LISTF7: HRRZ A,LISTF5 ;IF OUTPUT IS GOING TO DISPLAY AREA,
CAIN A,CHCT
JRST DISCLG ;FINISH UP DISPLAY
RET
LSTFRD: AOSA (P) ;GET A FILENAME FROM THE USER
LSTFR2: TLZA FF,FRNOT ;GET JUST DEFAULTS
TLO FF,FRNOT
SAVE OUT
CALL LSTFR0
JFCL
REST OUT
MOVE A,OPNJFN
RET
LSTFR0: CALL FSDFRD ;GET CURRENT DEFAULTS
JSP T,GCPUSA ;SAVE IN A GC PROTECTED WAY
MOVSI A,(<ASCII /*/>)
MOVEM A,DEFFN1 ;SET THEM UP
MOVEM A,DEFFN2
MOVEI A,-3 ;AND .*
HRRM A,DEFFN3
SETZ A,
TRNE FF,FRUPRW ;ATSIGN?
MOVSI A,(G1%IIN) ;YES. INVISIBLE OK.
MOVEM A,GJBITS ;SAVE FOR GTJFN CALL.
MOVSI A,(GJ%IFG\GJ%OLD) ;ALLOW MULTIPLE INPUT FILESPECS
TRNE FF,FRCLN ;COLON?
MOVSI A,(GJ%IFG\GJ%OLD\GJ%DEL) ;YES. DELETED OK.
TLNE FF,FRNOT ;READING FROM STRING?
JRST LSTFR4 ;YES, GET IT
IFN 20X,HRROI B,[ASCIZ /*.*.*/] ;DEFAULT STRING IF NOT FOM USER
.ELSE HRROI B,[ASCIZ /*.*;*/]
LSTFR5: CALL FF5A
JRST OPNER1
LSTFR3: MOVEM A,OPNJFN ;SAVE THE JFN
MOVE C,-2(P) ;GET OLD DEFAULTS
JRST FSDFL1 ;AND RESTORE THEM
LSTFR4: CALL FFRRDD ;READ FILESPEC STRING
JRST LSTFR5
IFN 0,%%TNX.:
] ;END IFN TNX CONDITIONAL
;FS DFILE$ -- THE DEFAULT FILE NAMES, AS A STRING. CAN BE READ OR SET.
FSDFILE:CALL FSDFRD ;FIRST GET VALUE TO RETURN FROM OLD FILENAMES.
TRZN FF,FRARG ;IF HAVE ARG, SET FILENAMES TO IT BY INSERTING IT
JRST POPJ1 ;INTO AN ET COMMAND.
JSP T,GCPUSA ;MEANWHILE, KEEP VALUE WHERE IT WILL BE RELOCATED.
FSDFL1: MOVEI A,[ASCIZ /[0 U0 ET 0 ]0/]
CALL MACXCP
JRST GCPOPV
;HERE TO MACRO STRING PTR OR ASCIZ ADDR IN A, WITH ARG IN C, SAVING CURRENT VALUE STATUS.
MACXCP: JSP T,OPEN1
JUMPGE A,.+3 ;IF ITS A POINTER, NOT AN ASCIZ STRING, THEN
CALL QLGET0 ;IF NOT GOOD STRING POINTER, GET ERROR NOW, BECAUSE PAST RRMAC5
TYPRE [QNS] ;WE WILL NOT BE IN SAFE STATE FOR GETTING ERRORS.
MOVEM C,NUM
CALL RRMAC5 ;USE RRMAC5, NOT MACXQW, IN CASE WE ARE CALLED BY ^R.
TRZ FF,FRARG\FRARG2\FRCLN\FRUPRW\FROP\FRSYL
HRROI T,CPOPJ
JRST CLOSE2
SUBTTL OUTPUT ROUTINES THAT USE LISTF5
;COME HERE FOR DPT OF NEGATIVE NUMBER.
DPT2: CAMN C,[SETZ] ;CAN'T NEGATE THIS! MUST WORK SPECIALLY
JRST DPTMNF
MOVNS C ;OTHERWISE PRINT THE MAGNITUDE, PRECEDED BY A "-".
TLO FF,FLNEG
RDPT: SOJA TT,DPT6
DPT: TDZA TT,TT ;DECIMAL PRINT, NO LEADING ZEROS.
SLDPT: MOVEI TT,2 ;DECIMAL PRINT, WITH AT LEAST 3 POSITIONS USED.
DPT1: JUMPL C,DPT2
DPT6: MOVE D,QRB..
MOVM CH,.QBASE(D)
SOJLE CH,[
MOVEI C,10. ;IF ..E HOLDS 0, 1 OR -1, REPLACE BY 10.
MOVEM C,.QBASE(D)
TYPRE [..E]]
IDIV C,.QBASE(D)
DPT8: HRLM D,(P)
JUMPGE D,DPT7 ;HANDLE NEGATIVE REMAINDER (IMPLIES NEG. RADIX).
MOVE D,QRB..
HRLZ D,.QBASE(D)
MOVNS D
ADDM D,(P)
AOS C
DPT7: SKIPE C
CALL RDPT
TLZE FF,FLNEG
SAVE ["--"0,,DPT3]
DPT3: JUMPLE TT,DPT4
XCT DPT5
PUSHJ P,@LISTF5
SOJG TT,.-1
DPT4: HLRE CH,(P)
DGPT: ADDI CH,"0
CAILE CH,"9 ;FOR "DIGITS" ABOVE 9, USE LETTERS.
ADDI CH,"A-"9-1
JRST @LISTF5
DPTMNF: MOVE D,QRB.. ;HANDLE PRINTING OF 400000,,
MOVE D,.QBASE(D)
CAIE D,8 ;PRINT IT WITH A "-" SIGN, EXCEPT IN OCTAL.
TLO FF,FLNEG
SAVE D
LSHC C,-35. ;NOTE LOW BIT OF E IS 0, SINCE QRB.. ISN'T TOO BIG.
DIV C,(P)
SUB P,[1,,1]
JRST DPT8
;<ARG>= PRINTS <ARG><CR>.
;<ARG>,= PRINTS <ARG>,<CR>.
;<ARG>,<ARG1>= PRINTS <ARG>,<ARG1><CR>.
;@ => PRINT IN ECHO AREA. : => OMIT THE <CR>.
PRNT: ARGDFL ;-= MEANS -1=.
TRNN FF,FRARG+FRARG2
TYPRE [WNA]
TRNN FF,FRARG2
JRST PRNT2
EXCH C,E ;= WITH 2 ARGS:
CALL PRNT3 ;PRINT THE 1ST ARG,
MOVEI CH,",
CALL @LISTF5 ;A COMMA,
EXCH C,E ;AND THE SECOND ARG.
TRNE FF,FRARG
PRNT2: PUSHJ P,PRNT3
TRNN FF,FRUPRW
SAVE [DISFLS] ;IF ORDINARY TYPEOUT, MUST FORCE IT OUT WHEN DONE.
TRNE FF,FRCLN
RET
JRST CRR1
PRNT3: MOVEI A,TYO
TRNE FF,FRUPRW
MOVEI A,FSECO2
HRRM A,LISTF5
JRST DPT
CRR: MOVEI CH,TYO
HRRM CH,LISTF5
PUSHJ P,CRR1
JRST DISFLS
CRR1: MOVEI CH,15
PUSHJ P,@LISTF5
MOVEI CH,12
JRST @LISTF5
CTLQM: SKIPA CH,[^Q]
SPSP: MOVEI CH,40
JRST @LISTF5
FORMF: MOVEI CH,^M
CALL @LISTF5
MOVEI CH,^L
JRST @LISTF5
;OUTPUT A WORD OF SIXBIT, WITH ^Q'S AS NEC. SO TECO CAN READ BACK IN AS FILENAME.
SIXIN1: JUMPE A,CPOPJ
MOVEI B,0
ROTC A,6
IFN ITS,[
JUMPE B,SIXIN2
CAIE B,':
CAIN B,';
SIXIN2: PUSHJ P,CTLQM
]
MOVEI CH,40(B)
PUSHJ P,@LISTF5
JRST SIXIN1
SIXINT: PUSHJ P,SIXIN1 ;INSERT IN THE BUFFER THE SIXBIT WORD IN A
MOVE CH,C ;AND THE ASCII CHAR IN C
JRST @LISTF5
SIXINS: PUSHJ P,SIXIN1
JRST CRR1 ;END WITH CRLF
;OUTPUT ASCIZ STRING <- A, THRU LISTF5.
ASCIND: HRLI A,BP7 ;GET BP TO STRING.
ASCIN1: ILDB CH,A
JUMPE CH,CPOPJ
XCT LISTF5
JRST ASCIN1
SIXNTY: PUSH P,OUT
MOVE OUT,E
SIXNT1: SETZ CH,
ROTC OUT,6
ADDI CH,40
CALL @LISTF5
JUMPN OUT,SIXNT1
REST OUT
POPJ P,
TYPR: MOVEI IN,6
TYPR3: MOVE OUT,[(600)E-1]
ILDB CH,OUT
ADDI CH,40
XCT LISTF5
SOJG IN,.-3
TYPR2A: POPJ P,LISTF4
SLTAB: LISTF4:
MOVEI CH,^I
JRST @LISTF5
SUBTTL TERMINAL I/O FS FLAGS
;FS LISTEN$ - RETURN NONZERO IFF INPUT IS AVAILABLE.
;IF NONZERO ARG, THEN IF NO INPUT AVAILABLE PRINT IT AS ASCII CHAR IN ECHO AREA.
FSLISN: SKIPN TYISRC
SKIPL A,UNRCHC ;RETURN -1 IF INPUT IS AVAILABLE FROM ANY SOURCE.
JRST POPJ1
LISTEN A
JUMPG A,NRETM1
TRZE FF,FRARG ;OTHERWISE, IF THERE'S AN ARG,
SKIPN RGETTY
JRST POPJ1
AOS (P)
JRST FSECOT ;TYPE IT IN ECHO MODE (ON DISPLAYS ONLY)
IFN ITS,[
;FS MP DISPLAY$ - OUTPUT CHARACTER OR STRING TO M.P. AREA IN DISPLAY MODE.
FSMPDS: SKIPGE CH,C
JSP CH,FSMPD1
SYSCAL IOT,[%CLIMM,,CHTTYO ? CH ? %CLBIT,,%TJDIS]
.LOSE %LSFIL
RET
]
;TO HANDLE A STRING BY LOOPING OVER THE CHARACTERS, OR HANDLE A SINGLE CHARACTER, DO
; SKIPGE CH,C
; JSP CH,FSMPD1
; ... HANDLE ONE CHARACTER IN CH.
FSMPD1: HRRM CH,LISTF5
SETO D,
JRST FGCMD1
;FS ECHO DISPLAY$ - OUTPUT CHAR OR STRING IN DISPLAY MODE (^P IS SPECIAL) TO THE ECHO AREA.
;ARG IN C; CLOBBERS CH.
FSECDS: SKIPGE CH,NELNS
SETCM CH,NELNS
JUMPE CH,CPOPJ ;DO NOTHING IF THERE'S NO ECHO AREA.
CALL FSECO7 ;IF PJATY SET, CLEAR SCREEN NOW SO DON'T LOSE ECHO AREA TYPEOUT.
SKIPGE CH,C
JRST [ JSP CH,FSMPD1 ;IF ARG IS A STRING, TYPE THE CHARS IN IT.
CAIN CH,^M ;FSMPD1 CALLS BACK HERE WITH SUCCESSIVE CHARS.
JRST FSECD2 ;BUT IN A STRING, CR SHOULD COME OUT AS A STRAY CR, NOT CRLF.
JRST .+1]
CALL ECHODP ;OUTPUT TO ECHO AREA IN DISPLAY MODE.
JRST FSECO5
IFN TNX,FSMPDS: ;CLOSEST WE CAN COME - NOTHING SHOULD DO IT ANYWAY
FSIMAG: SKIPGE CH,C ;FS IMAGE OUT$ - OUTPUT CHARACTER OR STRING IN SUPER-IMAGE MODE.
JSP CH,FSMPD1 ;IF IT'S A STRING, CALL .+1 FOR EACH CHARACTER.
IFN ITS,.IOT CHSIO,CH
IFN TNX,[
MOVEI A,(CH)
PBOUT
]
JRST FSECO6
;OUTPUT CHAR TO ECHO AREA; ^M COMES OUT AS STRAY CR.
FSECO2: CALL FSECO7 ;IF PJATY SET, CLEAR SCREEN NOW SO DON'T LOSE ECHO AREA TYPEOUT.
SKIPN RGETTY ;ON PRINTING TTY, MUST TYPE USING NORMAL MECHANISM; OTHERWISE
JRST TYO ;CHCTHP WOULD NOT BE UPDATED AND SPURIOUS CONTINUATIONS WOULD HAPPEN
SKIPE RUBENC ;IF PREVIOUS COMMAND WANTED A CHAR TYPED BY US, TYPE IT.
CALL RUBEND
FSECD2: CALL ECHOC0 ;OUTPUT CHAR IN ECHO AREA BUT NOT IN ECHO MODE.
JRST FSECO5
;FS ECHO OUT - OUTPUT ARG IN ECHO MODE (WRITE-ONLY)
FSECOT: MOVE CH,C ;OUTPUT CHAR TO ECHO AREA; ^M COMES OUT AS CRLF.
;INTERNAL ENTRY POINT WITH CHARACTER IN CH. THIS MUST PRESERVE ALL ACS EXCEPT CH AND Q.
FSECO1: SKIPN RGETTY ;ON PRINTING TTY, WE WILL USE NORMAL TYPEOUT, WHICH MEANS
SAVE [DISFLS] ;THAT AFTERWARD WE MUST FORCE IT OUT.
CALL FSECO7 ;IF PJATY SET, CLEAR SCREEN NOW SO DON'T LOSE ECHO AREA TYPEOUT.
JUMPL CH,[ ;IF ARG IS A STRING, TYPE OUT ALL ITS CHARACTERS.
CALL SAVACS
SAVE [RSTACS]
MOVE C,CH
JSP CH,FSMPD1
JRST FSECO2] ;USE FSECO2 SO CR COMES OUT A A STRAY CR.
SKIPN RGETTY
JRST [ SETOM ECHACT
CAIN CH,^M
JRST CRR
JRST TYO]
SKIPE RUBENC ;IF PREVIOUS COMMAND WANTED A CHAR TYPED BY US, TYPE IT.
CALL RUBEND
FSECOR: CALL ECHOCH ;OUTPUT CHAR IN CH IN ECHO MODE.
FSECO5: SKIPG ECHACT
SETOM ECHACT ;MAKE SURE ECHO AREA IS CLEARED.
FSECO6: SETOM RROVPO ;IN CASE IN ^R MODE,
SETOM RROHPO ;MAKE SURE CURSOR GETS REPOSITIONED.
SETOM ECHCHR
RET
FSECO7: AOSE PJATY ;CLEAR SCREEN IF IT SAYS IT NEEDS TO BE CLEARED SOON.
JRST [ SKIPL ECHONL ;ELSE GO TO FRESH CLEAR LINE IF THAT'S PENDING.
RET
JRST ECHOCL]
CALL CTLL1
SETZM RRMSNG ;MAKE SURE ^R REDISPLAYS EVERYTHING NEXT TIME.
JRST RRLRDS
;GO TO FRESH LINE IN ECHO AREA AND CLEAR IT.
ECHOCL: SETZM ECHONL ;CLEAR THE FLAG SAYING TO DO THIS LATER.
SAVE CH
MOVEI CH,^P
CALL ECHODP
MOVEI CH,"A
CALL ECHODP
MOVEI CH,^P
CALL ECHODP
MOVEI CH,"]
CALL ECHODP
JRST POPCHJ
SUBTTL TERMINAL OUTPUT COMMANDS
;FV<STRING>$ -- DISPLAY <STRING>
FVIEW: TROE FF,FRCLN ;:FV DOESN'T START AT TOP OF SCREEN.
JRST FVIEW1 ;AND IT DOES TYPEOUT INSTEAD OF DISPLAY.
CALL DISINI
JRST FVIEW1
;FT<STRING>$ -- TYPE <STRING>
FTYPE: TRNE FF,FRUPRW ;@FT TYPES STRING IN ECHO AREA.
JRST [ TRNN FF,FRCLN ;@:FT DOES DOES SO ONLY IF NO INPUT AVAILABLE.
JRST FTYECH
SKIPGE UNRCHC
SKIPE TYISRC
JRST FNOOP
LISTEN A
JUMPE A,FTYECH
JRST FNOOP] ;THERE'S INPUT; IGNORE STRING INSTEAD TYPING IT.
TRZE FF,FRCLN ;:FT STARTS AT TOP OF SCREEN.
SETOM TYOFLG
CALL DISINT
FVIEW1: MOVEI BP,CHCT
FTYLUP: CALL RCH
SKIPN SQUOTP
CAIE CH,33
CAIA
JRST FTEND
SKIPGE STOPF
CALL QUIT0
FTYCHR: ANDI CH,177
CALL (BP)
JRST FTYLUP
FTEND: TRNE FF,FRCLN
JRST DISCLG
SKIPGE TYOFLG
RET
JRST DISFLS
FTYEC1: ANDI CH,-1 ;REMEMBER SUPRQUTED CHARS HAVE L.H. SET!
CALL [ CAIE CH,^M
CAIN CH,^J
JRST FSECO2
JRST FSECO1]
FTYECH: SKIPGE STOPF
CALL QUIT0
CALL RCH
SKIPN SQUOTP
CAIE CH,33
JRST FTYEC1
SKIPN RGETTY
JRST DISFLS
RET
;V COMMAND, AND ALL VARIATIONS THEREOF. EXIT WITH JRST RET.
VIEW: TRZE FF,FRUPRW
JRST [ CALL VIEW1B ;"@V" - DO APPRO. KIND OF DISPLAY
JRST VIEW1A] ;THEN CHECK FOR FOLLOWING W.
SKIPN RGETTY
JRST VIEW1A
PUSHJ P,GETARG
PUSHJ P,DISINI
SETOM VREMEM ;TRY TO DISPLAY BFR AT SAME PLACE
CALL CHK1A
MOVE A,E
SUB A,BEGV
SKIPGE A
SETO A,
MOVEM A,GEA
.I DISADP=PT+1 ;TELL DISAD WHERE TO PUT CURSOR.
MOVEI J,DISAD
PUSHJ P,TYPE1
VIEW1: PUSHJ P,DISCLG
VIEW1A: MOVE T,CPTR
ILDB C,T
CAIE C,"W
CAIN C,"W+40
SKIPN COMCNT
POPJ P,
CALL RCH ;FLUSH THE "W" OF "VW".
TRZ FF,FRARG2+FRARG+FRCLN
JRST FTYI ;READ IN CHAR, RETURN AS NUMBER.
VIEW1B: SKIPE DISPRR ;"@V": IN ^R MODE, DO A ^R-STYLE DISPLAY
JRST RRNOIN
JRST VIEW3A ;ELSE DO STANDARD DISPLAY.
EUHACK: CALL FFRRDD ;E^U -- READ FILENAME, THEN DO
JRST CNTRLU ;WHATEVER DIR DISPLAY THE USER WANTS.
;COME HERE FROM GO, AFTER THE END OF A COMMAND STRING
;(WHETHER IT ENDED SUCCESSFULLY OR NOT)
;DECIDE WHETHER AND HOW TO DISPLAY.
VIEW2: ANDCMI FF,FRCLN
TLZE FF,FLDIRDPY ;FRCLN _ FLDIRDPY
;^U COMMAND - DO USER'S SELECTED TYPE OF DIRECTORY DISPLAY.
CNTRLU: IORI FF,FRCLN
MOVE CH,QRB..
TRNN FF,FRCLN
SKIPA A,.QBFDS(CH) ;FLDIRDPY WAS OFF, WE WANT BUFFER DISPLAY.
MOVE A,.QFDDS(CH) ;IT WAS ON, WE WANT DIR DISPLAY.
JUMPE A,VIEW3B ;USER HASN'T SUPPLIED MACRO: DO @V OR :@V.
JRST MACXQ ;DO THE MACRO.
TYPE: PUSHJ P,GETANU ;T COMMAND: DECODE ARGS.
MOVEI J,FSECO2 ;@T TYPES IN ECHO AREA.
TRZN FF,FRUPRW
TYPE2: MOVEI J,TYO ;TYPE RANE IN E,C.
TYPE1: MOVE IN,E
TYPE3: SKIPN MORFLF
SKIPE STOPF
RET
CAML IN,C
JRST TYPE5
PUSHJ P,GETINC
PUSHJ P,(J)
JRST TYPE3
TYPE5: CAIE J,TYO
SKIPN RGETTY
SKIPGE TYOFLG
POPJ P,
JRST DISFLS ;FORCE THE TYPEOUT OUT, IF THE M.P. AREA TYPEOUT MECHANISM WAS USED.
SUBTTL BUFFER DISPLAY
;COME HERE AFTER EACH CMD STRING,
;IF USER HAS NOT SUPPLIED A MACRO TO BE INVOKED.
VIEW3B: TRZ FF,FRARG
MOVE TT,QRB..
SKIPE .QVWFL(TT)
POPJ P, ;DON'T DISPLAY IF CMDS IN STRING INHIBITED IT.
SKIPE RGETTY ;SHOULD WE EVER DISPLAY ON THIS TERMINAL
JRST VIEW3A
TRNN FF,FRCLN ;ELSE, ON PRINTING TTY, NO DISPLAY OF DIRS,
SKIPN TTMODE ;BUFFER DISPLAYED ONLY IN :^N MODE.
RET
VIEW3A: TRZE FF,FRCLN
JRST CNTRU1
CALL VBDACU ;UPDATE TSALTC, SKIP IF OK TO DISPLAY.
POPJ P,
VBD: SETO A,
CALL VBDBLS ;MAKE SURE WE HAVE A VALID WINDOW (BLESS IT)
JRST VBDDIS ;THEN DISPLAY FROM THERE.
VBDRR: SETO A,
CALL VBDBL1 ;HERE TO DISPLAY FOR ^R, WITH OUTPUT AND WINDOW SET UP. ON DISPLAYS ONLY!
MOVEM B,RRVPOS
JRST VBDDIS
;A/ -1 => MAKE SURE THAT WE HAVE A VALID WINDOW.
;A/ VPOS => CHOOSE WINDOW TO PUT PT AT THAT VPOS.
VBDBLS: MOVE C,NLINES
CALL WINSET
VBDBL1: SETOM TYOFLG ;SINCE WE ARE SCREWING UP VPOS AND HPOS, TYPEOUT SHOULD REINIT.
;ALSO, TYOFLG POSITIVE WITH CHCTBP ZERO CAN CAUSE CRASH IN DISFLS.
SAVE %END
SAVE CHCTVS ;ON PRINTING TTY'S WE MUSTN'T CHANGE THE WINDOW SIZE FOR GOOD.
.I CHCTVS=BOTLIN ;BUT DURING BUFFER DISPLAY, RESTRICT TO # LINES.
CALL VBDRR2 ;CALCULATE NEW ABSOLUTE WINDOW ADDRESS IN A.
.I GEA=A-BEGV
REST CHCTVS
REST %END
RET
VBDRR2: JUMPGE A,[ SETOM %END ;IF VPOS FOR PT SPEC'D EXPLICITLY, USE IT.
JRST VBDN5] ;ALSO TURN OFF MARGIN CHECKING FOR ZV.
SKIPE RGETTY ;NOT DATAPOINT => NO DESIRE TO DISPLAY FROM SAME PLACE.
SKIPGE IN,GEA ;OR NO OLD PLACE TO START FROM =>
JRST VBDNEW ;START FROM SCRATCH.
ADD IN,BEGV ;TRY THE OLD START.
CAMLE IN,PT ;NO GOOD TO START AFTER POINTER.
JRST VBDNEW
JRST VBDTRY ;ELSE SEE IF OLD WINDOW STILL GOOD.
;SET THE VARIABLES THAT DESCRIBE THE SIZE AND POSITION OF THE WINDOW
;AND THE MARGINS (REGIONS WHERE WE DON'T WANT THE POINTER TO BE); NAMELY,
;RRTOPM, RRBOTM, BOTLIN, AND VSIZE.
;C SHOULD CONTAIN NLINES (OR SOMETHING TO USE INSTEAD).
WINSET: SAVE D
SKIPGE C
SETZ C, ;NEGATIVE # LINES NOT ALLOWED.
SAVE J
SKIPL J,TOPLIN
CAML J,USZ
SETZM TOPLIN ;IF FS TOP LINE$ IS INVALID, SET IT TO 0 INSTEAD.
REST J
SKIPE C
ADD C,TOPLIN ;C HAS DESIRED LAST LINE (+1) TO USE, OR 0 FOR WHOLE SCREEN.
CAML C,USZ
SETZ C, ;CAN'T USE MORE LINES THAN WE HAVE.
SKIPN C
MOVE C,USZ ;NO SPECIFICATION, OR BAD SPEC, => USE TILL SCREEN BOTTOM.
CAIL C,MXNVLS ;IF THAT'S INFINITELY MANY LINES, USE 2 LINES.
MOVEI C,2
MOVEM C,BOTLIN ;STORE DESIRED LAST LINE (+1) IN BOTLIN.
SUB C,TOPLIN
MOVEM C,VSIZE
IMUL C,%TOP ;COMPUTE MARGINS THAT CURSOR MUSN'T GO OUTSIDE.
IDIVI C,100.
ADD C,TOPLIN
MOVEM C,RRTOPM
MOVE C,VSIZE
IMUL C,%BOTTO
IDIVI C,100.
SUB C,BOTLIN
MOVNM C,RRBOTM
JRST POPDJ
;TRY TO MAKE SURE TSALTC IS UP TO DATE. TSALTC CAN GET WRONG IF TTY IS
;RETURNED TO DDT AND IT THROWS AWAY ALL THE INPUT.
VBDACU: SKIPN TSALTC ;UPDATE TSALTC (IN CASE DDT HAS FLUSHED
SKIPE TSINAL ;THE $$'S THAT INT'D US) (SKIP IF ENDS UP 0)
CAIA
JRST POPJ1
LISTEN CH
JUMPN CH,CPOPJ
SETZM TSALTC ;NO INPUT CHARS WAITING => NO $$'S.
SETZM TSINAL ;AND NO STRAY $.
HRROS LTYICH
JRST POPJ1
;COME HERE TO SEE IF THE PREVIOUS WINDOW (ADDR IN IN) CAN BE REUSED (GEA > -1).
;IN THIS CASE, CAN GO TO VBDNEW IF THE WINDOW IS BAD, OR CAN RETURN WINDOW IN A.
;COME HERE FROM VBDNEW WITH A TENTATIVE WINDOW ADDRESS IN IN (WHICH MAY BE TOO
;CLOSE TO BEG) TO FIND A MORE PRECISE WINDOW (GEA = -1).
;IN THIS CASE, C HOLDS -<DESIRED # LINES ABOVE CURSOR>, AND WE ALWAYS RETURN.
;WE ALWAYS RETURN THE NEW VPOS OF POINT IN B.
;WE SHOULD NEVER BE CALLED WITH A WINDOW THAT IS AFTER POINT.
VBDTRY: CALL CHCTI0 ;INIT VARIOUS TEMPS FOR TYPEOUT.
SETZ T, ;INITIAL HPOS IS 0 (VBDL UPDATES)
SETZM MORFLF ;THIS MIGHT HAVE STOPPED LAST VBDTRY.
CALL MEMTOP ;OUT GETS ADDR OF FREE STORAGE,
MOVE OUT,A ;FOR TABLE OF LINE-BEGINNING ADDRESSES.
MOVE A,IN ;A _ THE START WE'RE TRYING NOW.
CAMLE A,PT
.VALUE
CALL GETIBI ;BP IN BP TO FETCH CHARS TO TYPE, STARTING AT IN.
MOVEI TT,VBDL ;CALL VBDL TO "OUTPUT" A LINE.
MOVEM TT,CHCTAD
SETZB TT,CHCTBP ;TELL CHCT TO THROW AWAY CHARS.
HLLOM TT,DISBFC ;IT WILL NEVER FILL UP ITS INFINITE SINK.
MOVE TT,TOPLIN ;START "PRINTING" WHERE WE WILL LATER REALLY START PRINTING.
MOVEM TT,CHCTVP
ADD TT,OUT ;STORE BEGINNING OF 1ST LINE DISPLAYED AS 1ST CHAR DISPLAYED.
MOVEM IN,(OUT)
VBD0: CAMN IN,PT ;REACHED PT =>
JRST VBDPT ;CHECK WHETHER THIS WINDOW IS OK.
VBDPT2: CAMN IN,ZV ;(COMES BACK IF CAN'T TELL YET,
;NEAR END OF SCREEN BUT OK IF END OF BUFFER FITS)
JRST VBD3 ;AT END, SEE IF MADE IT ON TO SCREEN.
CAMN IN,GPT ;IF AT GAP, MOVE BP OVER IT.
CALL FEQGAP
ILDB CH,BP
ADDI IN,1
CALL DISAD2 ;OUTPUT NEXT CHAR.
SKIPN MORFLF
JRST VBD0
JRST VBDNEW ;OFF END OF SCREEN AND PT TOO LOW.
VBD3: MOVE TT,CHCTVP ;REACHED ZV BEFORE FLUSHING,
CAMN TT,BOTLIN ;WINDOW OK IF ZV IS ON SCREEN ABOVE --MORE-- LINE
CAMN T,CHCTHP ;OR IF ZV IS ON IT BUT NO CHARS TYPED ON IT
CAIA
JRST VBDNEW
;REACHED PT DURING VBD0 LOOP.
VBDPT: SKIPGE GEA ;CAME TO VBDTRY FROM VBDNEW =>
JRST VBDDWN ;ZERO IN ON BEST WINDOW.
CAMN A,BEGV ;TRYING TO RE-USE WINDOW =>
JRST VBDPT1 ;UNLESS WE STARTED AT START OF BUFFER,
MOVE TT,RRTOPM
CAMLE TT,CHCTVP ;SHOULDN'T HAVE PT < %TOP PERCENT OF SCREEN FROM TOP.
JRST VBDNEW
VBDPT1: MOVE B,CHCTVP ;MIGHT BE OK, REMRMBER # OF LINE WITH PT.
CAMN B,BOTLIN ;IF WE'RE ON THE --MORE-- LINE
CAMN T,CHCTHP ;WE'RE REALLY OFF BOTTOM, BAD WINDOW.
CAIA
JRST VBDNEW
CAML B,RRBOTM ;NOT IN LAST %BOTTOM PERCENT OF SCREEN OR
CAMN IN,ZV ;ALREADY AT BUFFER END =>
RET ;CAN'T BE TO NEAR BOTTOM. IT'S GOOD; RETURN IT.
CALL DISBAR
JRST VBDPT2 ;ELSE SEE IF END OF BUFFER FITS ON SCREEN.
;CHCT CALLS HERE WITH EACH LINE DURING VBDTRY.
;SETS UP THE LINE-BEGINNING ADDRESS ENTRY FOR THE LINE.
;LEAVES HORIZ POS. START OF NEXT LINE IN T.
VBDL: MOVE Q,CHCTVP
MOVE TT1,Q
ADD TT1,OUT
MOVE T,CHCTNL ;STORE ADDRESS OF 1ST CHAR ON LINE.
MOVEM T,1(TT1)
MOVE T,CHCTHP ;RETURN H.P. AFTER LINE.
MOVE TT1,GEA ;IF GOING TO GO TO VDBDWN,
AOJE TT1,CPOPJ ;MAKE SURE ALL THE LINE'S STARTS ARE STORED.
CAMN Q,BOTLIN ;AT BOTTOM OF SCREEN =>
SETOM MORFLF ;STOP THE LOOP AT VBDTRY.
POPJ P,
;START FROM SCRATCH, FIGURING OUT A NEW WINDOW.
;RETURN THE NEW WINDOW ADDRESS IN A, AND THE NEW VPOS OF POINT IN B.
VBDNEW: SKIPGE DISTRN
JRST VIEW2A ;IN TRUNCATE MODE, EVERYTHING EASIER.
MOVE A,VSIZE ;PRETEND WE'RE STARTING AT MIDDLE OF SCREEN.
IMUL A,%CENTER
IDIVI A,100.
SKIPGE A
SETZ A,
MOVE T,VSIZE
CAMG T,A
MOVEI A,-1(T)
ADD A,TOPLIN
;HERE FROM RREAR3; A HAS DESIRED VPOS OF PT.
VBDN5: SETOM GEA ;SO NEXT TIME REACH VBDPT WON'T COME HERE AGAIN.
CALL CHCTI0
SETZM CHCTBP ;MAKE SURE WE DON'T TRY USING UP INFINITE AMOUNTS OF DISBUF.
MOVEM A,CHCTVP
SETZB T,MORFLF
MOVE BP,PT
CAMN BP,BEGV ;IF PT = BEGV, WINDOW MUST START AT BEGV.
JRST [ MOVE A,BP
MOVE B,TOPLIN
RET]
MOVEI C,CPOPJ ;TELL DISAD NOT TO DO ANYTHING WITH THE LINES IT CONSTRUCTS.
MOVEM C,CHCTAD
SAVE CHCTVP ;SAVE TOPLINE+#CENTER.
MOVE TT,VSIZE
IMUL TT,%END
JUMPL TT,VBDN6
IDIVI TT,100.
SAVE TT ;REMEMBER #END (TOTAL*%END/100)
IMUL TT,NHLNS ;ARE WE WITHIN #END*WIDTH*2 CHARS OF END OF BUFFER?
LSH TT,1
CAIL TT,1000. ;IF NOT FOR THIS, SMALL %END'S WOULD BE IGNORED UNLESS PT VERY NEAR Z.
MOVEI TT,1000. ;RATHER, THEY MEAN "PUT Z VERY NEAR SCREEN END, IF IT'S ON SCREEN AT ALL"
ADD TT,BP
CAMGE TT,ZV ;IF SO, DON'T LEAVE MORE THAN #END BLANK LINES AT BOTTOM.
JRST VBDN4 ;IF NOT, ASSUME WE WON'T LEAVE THEM & DON'T WASTE TIME.
CAMN BP,ZV ;WE'RE AT END OF BUFFER =>
JRST [SOS IN,BP ;NEED FULL SCREEN ABOVE PT.
CALL GETCHR ;IF LAST CHAR ISN'T LF,
CAIE CH,^J ;MAKE SURE THE LAST UNTERMINATED LINE
AOS CHCTVP ;DOESN'T END UP OFF SCREEN BOTTOM.
JRST VBDN2]
CAMLE BP,GPT
ADD BP,EXTRAC
CALL GETIBP ;SEE HOW MANY LINESOF TEXT THERE ARE BETWEEN PT AND BUFFER END.
MOVE IN,PT
SKIPE RGETTY
SKIPE RREBEG
CALL DISBAR ;STARTING AT THE PTR SO MAKE CURSOR (EXCEPT IN ^R ON DISPLAY TTY).
MOVE E,BOTLIN ;IF WE GET DOWN TO VPOS = TOTAL-#END, WE CAN PUT CURSOR
SUB E,(P) ;AT THE USUAL PLACE (#CENTER), SO STOP COUNTING LINES.
VBDN1: CAMN IN,ZV
JRST VBDN2 ;ALL USED UP, SEE HOW MANY LINES THAT MADE.
CAMG E,CHCTVP
JRST VBDN4
CAMN IN,GPT ;WHEN AT GAP, MOVE BP OVER GAP.
CALL FEQGAP
ILDB CH,BP
ADDI IN,1
CALL DISAD2
JRST VBDN1
VBDN2: MOVE C,CHCTVP ;REACHED END OF BFR WITHOUT REACHING VPOS = TOTAL-#END.
CAME T,CHCTHP ;MAYBE WE STARTED ANOTHER LINE NOT COUNTED IN VPOS. COUNT IT TOO
JRST [ CAME C,BOTLIN ;UNLESS IT'S REALLY OFF
AOS C ;BOTTOM OF SCREEN.
JRST .+1]
SUB C,A ;# LINES WE PRINTED IN VBDN1 LOOP.
ADD C,(P) ;PLUS MAX # BLANK LINES TO LEAVE BELOW THEM,
MOVNS C ;GIVES MAX # LINES WE CAN ALLOW BELOW PT.
ADD C,BOTLIN ;SUBTRACT FROM WINDOW BOTTOM TO GIVE MIN VPOS FOR PT.
MOVEM C,-1(P) ;(SMALLER THAN AND INSTEAD OF TOPLIN+#CENTER WHICH WE SAVED).
VBDN4: SUB P,[1,,1] ;NO LONGER NEED #END.
VBDN6: MOVNS C,(P) ;GET BACK #CENTER OR CORRECTED # OF LINES WE WANT ABOVE PT.
ADD C,TOPLIN ;-<# LINES NEEDED ABOVE PT>
CALL VBDN7 ;IN GETS PLACE WHERE THOSE LINES START.
REST C ;- <MINIMUM VPOS WE WANT PT TO APPEAR AT>.
JRST VBDTRY
;RETURN IN IN THE CHAR ADDR OF A SPOT C(C) LINES UP FROM POINT.
;MORE PRECISELY, IT MUST BE AT LEAST C(C) SCREEN LINES UP, BUT MAY BE MORE,
;BUT SHOULDN'T BE TOO MUCH MORE FOR THE SAKE OF EFFICIENCY.
;LIKE DOING -<N>@L BUT WITH CUTOFF IN CASE THERE ARE NO CRLFS IN THE BUFFER.
VBDN7: MOVE E,C ;FIND PLACE BACK FROM POINT FAR ENOUGH
SUBI E,2 ;TO FILL UP THAT MANY SCREEN LINES (PLUS 2)
IMUL E,NHLNS ;WITH JUST CONTINUATION LINES.
ADD E,PT
CAMGE E,BEGV ;THERE, OR BEGINNING OF BUFFER, IS WHERE WE CUT OFF.
MOVE E,BEGV
MOVE IN,PT ;NOW, LOOK BACK THAT MANY LINES FROM POINT, BUT NOT PAST THERE.
VBDN7L: SOS IN ;LOOP HERE OVER LINES.
VBDN7C: CAMGE IN,E ;LOOP HERE OVER CHARACTERS.
AOJA IN,CPOPJ
CALL GETCHR ;EXAMINE NEXT CHAR BACK FOR BEING A LF.
CAIE CH,^J
SOJA IN,VBDN7C
CAMN IN,E
RET
SUBI IN,1 ;IF SO, SEE IF WHAT PRECEDES IT IS A CR.
CALL GETINC
CAIE CH,^M
SOJA IN,VBDN7C
AOJLE C,VBDN7L ;IF SO, THAT'S ONE LINE DOWN.
AOJA IN,CPOPJ ;WHEN WE'VE GONE ENOUGH LINES, LEAVE IN -> CHAR AFTER THE LF.
;COME HERE IN VBDTRY TO SEE WHETHER OUR GUESS FOR GEA WAS GOOD.
;IT'S NO GOOD IF POINT WOULD APPEAR FARTHER DOWN THE SCREEN THAN EXPECTED/
;SINCE WE REMEMBERED WHERE IN THE BUFFER EACH SCREEN LINE STARTED,
;WE CAN IMMEDIATELY FIND THE CHARACTER THE RIGHT NUMBER OF LINES UP FROM POINT.
;C HAS THE NUMBER OF SCREEN LINES DESIRED ABOVE POINT.
VBDDWN: SAVE A
SAVE RRHPOS
SAVE RRVPOS ;FIRST WORRY ABOUT THINGS LIKE:
.I RRHPOS=CHCTHP
.I RRVPOS=CHCTVP
AOSN RRNCCR ;WHAT IF POINT IS RIGHT AFTER A CR? IN THAT CASE
CALL [ SOS PT ;THE CR HASN'T REALLY BEEN OUTPUT YET.
JRST RRFORW] ;SO ADJUST OUR SCREEN POSITION TO BE AFTER THE CR.
MOVE A,RRHPOS
CALL RRFOR3 ;ALSO, MAYBE THE NEXT CHARACTER WOULD CAUSE A CONTINUATION.
MOVE A,RRHPOS
MOVEM A,CHCTHP
MOVE A,RRVPOS ;ADJUST SCREEN POSITION FOR THAT, IF NECESSARY.
EXCH A,CHCTVP
ADD A,OUT ;IN CASE WE DO START A CONTINUATION LINE,
PUSH A,PT ;ENTER IN THE TABLE WHERE THAT CONTINUATION STARTS.
REST RRVPOS
REST RRHPOS
REST A
MOVN B,C
CAMLE B,CHCTVP
MOVE B,CHCTVP
ADD C,CHCTVP ;(C STILL HAD - # LINES WANTED ABOVE PTR)
JUMPLE C,CPOPJ ;NOT MORE THAN MAX, OK.
ADD C,TOPLIN
ADD C,OUT
MOVE A,(C) ;ELSE FIND 1ST CHAR ON THE LINE WE SHOULD START WITH.
RET
;DISPLAY THE BUFFER STARTING AT THE WINDOW IN GEA.
VBDDIS: SAVE CHCTVS
SAVE [[ REST CHCTVS
RET]]
SAVE BOTLIN
CALL DISINI ;SET UP FOR DISPLAY.
REST BOTLIN ;DISINI RESETS BOTLIN IGNORING FS LINES, WHICH IS WRONG.
.I CHCTVS=BOTLIN
MOVE TT,QRB.. ;DISPLAY SHOULDN'T INHIBIT ANOTHER DISPLAY OF SAME STUFF.
SETZM .QVWFL(TT)
SETOM VREMEM
MOVE TT,TOPLIN
MOVEM TT,CHCTVP
MOVE IN,GEA
ADD IN,BEGV
MOVEM IN,LINBEG(TT)
VBDOK3: MOVEM IN,CHCTBL ;REMEMBER CHAR ADDR START OF 1ST LINE
;(DISAD WILL SET CHCTBL FOR LATER LINES)
CALL GETIBI
SETZM MORNXT
VBDOK1: CAMN IN,ZV ;STOP IF NO MORE CHARS.
JRST DISCLG
MOVE TT,CHCTVP ;STOP IF PAST END OF SCREEN.
CAML TT,CHCTVS
CALL DISMOR ;DO IT VIA DISMOR SO WE RETURN TO ^R PROPERLY.
SKIPN MORFLF
SKIPGE ORESET ;STOP IF FLUSHED OR QUITTING.
JRST DISCLG
CAMN IN,PT ;OUTPUT THE CURSOR IF BEFORE PT.
CALL DISBAR
CAMN IN,GPT ;IF AT GAP, MOVE B.P. IN BP OVER IT.
CALL FEQGAP
MOVE TT,CHCTHP
CAME TT,NHLNS ;IF ABOUT TO CONTINUE A LINE
SKIPN DISBFC ;OR IF THE BUFFER IS FULL,
JRST VBDSLO ;OUTPUT 1 CHARACTER SLOWLY TO CONTINUE OR EMPTY THE BUFFER.
SKIPGE DISTRN
JRST VBDSLO
SKIPE CASDIS ;IF WE NEED CASE-FLAGGING, OR
JRST VBDSLO
SKIPL CHCTCF ;IF WE HAVE AN UNPROCESSED CR,
JRST VBDFAS ;MUST GO THRU DISAD SINCE ONLY DISAD KNOWS HOW TO HACK ONE.
VBDSLO: ILDB CH,BP
AOS IN
VBDSL1: .I RRCCHP=CHCTHP
CALL DISAD2 ;OUTPUT THE CHAR.
JRST VBDOK1
;IF WE GET HERE, WE KNOW WE CAN GO AT LEAST 1 CHAR BEFORE REACHING PT, GPT, ZV,
;THE RIGHT MARGIN, OR THE END OF DISBUF.
;A HAS THE HPOS TIMES 7, E HAS THE HASH CODE, BP HAS THE BP AND IN HAS THE CHAR ADDRESS.
;TT HAS THE HPOS TO STOP AT, TIMES 7. OUT HAS THE BP TO STOP AT. CH HOLDS THE CHAR.
VBDFAS: MOVE OUT,BP
MOVE BP,ZV ;CONSIDER PT, GPT AND ZV; BP GETS WHICHEVER IS SMALLEST
CAMGE IN,GPT
CAMG BP,GPT
CAIA
MOVE BP,GPT ;YET BEYOND WHERE IN IS NOW.
CAMGE IN,PT
CAMG BP,PT
CAIA
MOVE BP,PT
SOS BP ;CONVERT CHAR ADDR IN BP TO THE B.P. TO LDB THE PREVIOUS CHAR.
CALL GETIBV
IBP BP ;(GETIBV FOLLOWED BY IBP = GETBV).
EXCH OUT,BP
MOVE A,CHCTHP ;A GETS 7 TIMES THE HPOS. WE USE IT FOR SHIFTING FOR THE HASH CODE.
IMULI A,7 ;ALSO, TT GETS 7 TIMES THE LINE WIDTH AND THAT IS AN END TEST.
MOVE TT,NHLNS
IMULI TT,7
MOVE E,CHCTHC ;E IS WHERE WE ACCUMULATE THE CHECKSUM.
VBDFLP: ILDB CH,BP
XCT VBDTBL(CH) ;FOR FUNNY CHARS, GO SOMEPLACE ELSE.
VBDNRM: IDPB CH,CHCTBP ;STORE CHAR INTO OUTPUT.
ROT CH,(A)
ADD E,CH ;UPDATE THE HASH CODE OF THE LINE.
VBDTRT: ADDI A,7
CAME BP,OUT ;STOP IF REACH PT, GPT OR ZV.
CAMN A,TT ;STOP IF REACH RIGHT MARGIN.
CAIA ;IN EITHER CASE, INCREMENT HPOS FOR CHAR WE JUST DID.
JRST VBDFLP
;HERE EITHER IN = PT,GPT OR ZV, OR ELSE WE ARE ABOUT TO CONTINUE A LINE.
;SO VBDOK1 IS GUARANTEED TO DO 1 CHAR THE SLOW WAY BEFORE VBDFAS IS REACHED.
VBDOUT: CALL VBDSTO ;STORE BACK CHCTHC, CHCTHP, AND IN
JRST VBDOK1
VBDTBL: JRST VBDCTL ;^@
REPEAT 6,JRST VBDCTL ;^A THRU ^F
JRST VBDCTL ;^G
JRST VBDBS ;^H
JRST VBDTAB ;^I
JRST VBDLF ;^J
REPEAT 2,JRST VBDCTL ;^K, ^L
JRST VBDCR ;^M
REPEAT 13.,JRST VBDCTL ;^N THRU ^Z
JRST VBDALT ;ALTMODE
REPEAT 4,JRST VBDCTL ;^\ THRU ^_
REPEAT 137,JFCL ;NORMAL GRAPHICS CHARACTERS
JRST VBDCTL ;RUBOUT IS LIKE A CTL CHAR.
IFN .-VBDTBL-200,.ERR WRONG TABLE LENGTH
VBDSTO: IDIVI A,7 ;CONVERT A BACK TO HPOS TIMES 1.
EXCH A,CHCTHP ;A IS UPDATED CHCTHP
SUB A,CHCTHP ;OLD CHCTHP MINUS NEW CHCTHP (A NEGATIVE NUMBER)
ADDM A,DISBFC ;IS ALSO - <# OF CHARS IDPB'D>.
MOVEM E,CHCTHC
SAVE BP
CALL GETCA
AOS IN,BP
CAMLE IN,GPT
SUB IN,EXTRAC
REST BP
RET
VBDCR: SETOM CHCTCF ;CR => SET FLAG FOR NEXT CHAR AND HANDLE IT WITH DISAD.
JRST VBDOUT
VBDCTL: SKIPE DISSAI ;MOST CONTROL CHARS ARE NORMAL IN SAIL MODE, LOSING OTHERWISE.
JRST VBDNRM
VBDBS:: VBDLF::
VBDLOS: CALL VBDSTO ;HERE FOR A CHAR THAT MUST BE HANDLED WITH DISAD.
JRST VBDSL1 ;WE KNOW THAT IN DOESN'T = PT, GPT, OR ZV, OR WE WOULN'T HAVE
;GOT EVEN THIS FAR, SO IT'S SAFE TO GO STRAIGHT TO VBDSLO.
VBDALT: MOVE TT1,TTYOPT
TLNN TT1,%TOSAI
MOVEI CH,"$
JRST VBDNRM
VBDTAB: SAVE B
VBDTA1: MOVEI CH,40 ;OUTPUT SPACES OR %TDTSP (THE LATTER FOR LOCAL EDITING TERMINALS)
SKIPE LEABLE
MOVEI CH,%TDTSP
IDPB CH,CHCTBP
MOVEI CH,40 ;IN EITHER CASE, A SPACE GOES IN OUR HASH CODE.
ROT CH,(A)
ADD E,CH
ADDI A,7 ;AND INCREMENTING THE HPOS
SAVE A
IDIVI A,7
IDIV A,TABWID ;TILL WE REACH A TAB STOP.
REST A
CAME A,TT ;THE END OF THE LINE COUNTS AS A TAB STOP.
JUMPN B,VBDTA1
REST B
SUBI A,7
JRST VBDTRT ;RE-ENTER NORMAL LOOP, EXIT IF REACHED OBSTACLE.
VIEW2A: MOVE C,VSIZE
ADDI C,1 ;(IF C ODD, WANT LINE WITH PT CENTERED)
LSH C,-1
SAVE FF
TRZ FF,FRCLN\FRUPRW
PUSHJ P,GETAG7 ;GET 1 + LAST CHAR ADR TO PRINT IN E
JFCL
MOVN C,VSIZE
CAMN IN,BEGV ;IF BUFFER NOT EMPTY,
JRST VIEW2B
SOS IN
CALL GETINC ;LOOK AT LAST CHAR, NOT CHANGING IN.
CAIE CH,^J ;IF NOT LF, IT COUNTS AS A LINE.
AOS C
VIEW2B: PUSHJ P,GETAG4 ;THEN MOVE 2*N BACKWARD FROM THERE, GET 1ST TO DISPLAY.
JFCL
MOVE A,E ;DISPLAY AS MUCH AS WILL FIT.
REST FF
RET
SUBTTL SINGLE CHARACTER TERMINAL OUTPUT, BUFFERED
;OUTPUT ROUTINES. OUTPUT CHAR IN CH AS DESCRIBED, CLOBBERING ONLY Q.
;IN SHOULD CONTAIN 1 PLUS CHAR ADDR OF CHAR BEING OUTPUT.
;"DISPLAY" - OUTPUT CURSOR, DO CASE-FLAGGING.
DISAD: MOVE Q,CHCTHP
MOVEM Q,RRCCHP
CAMN IN,DISADP ;IF THIS CHAR COMES AFTER POINTER,
CALL DISBAR ;OUTPUT CURSOR.
;DON'T OUTPUT CURSOR, DO CASE-FLAGGING.
DISAD2: SKIPN CASDIS ;IF IN -1F$ MODE
JRST CHCT
SAVE .-1 ;DO CASE-FLAGGING: ROUTINE FOR 1 CHAR IS CHCT.
;CALL DISAD6 ? OUTPUT 1 CHAR ? POPJ P, ;TO OUTPUT A CASESHIFT IF NEC.
DISAD6: SKIPGE CASSFT ;DON'T TRY OUTPUTTING CASESHIFT
POPJ P, ;IF THERE ISN'T ANY.
CAME CH,CASSFT ;PUT CASE-SHIFTS BEFORE
CAMN CH,CASLOK ;CASE-SHIFTS AND CASE-:LOCKS.
JRST DISAD3
CAILE CH,"Z+40 ;LOWER CASE SPECIAL CHARACTERS ALWAYS NEED CASESHIFTS.
CAIN CH,177
CAIN CH,"@+40
JRST DISAD3
CAIL CH,"A+40 ;LOWER CASE LETTERS NEED THEM IS NORMAL CASE IS UPPER.
CAILE CH,"Z+40
JRST DISAD4
SKIPG CASNRM
RET
JRST DISAD3 ;PUT SLASHES BEFORE LOWER.
DISAD4: SKIPL CASNRM ;IF NORMAL CASE IS LOWER,
RET
CAIL CH,"A ;PUT CASE-SHIFTS BEFORE UPPER CASE.
CAILE CH,"Z
RET
DISAD3: SAVE [DISAD5] ;CASESHIFT NEEDED; ARRANGE TO OUTPUT IT,
SAVE -1(P) ;THEN POPJ TO OUTPUT ORIGINAL CHAR.
HRLM CH,-2(P)
MOVE CH,CASSFT
POPJ P, ;PDL HAS 1-CHAR-RTN ? DISAD5 ? CHAR,,1-CHAR-RTN.
;OUTPUT A CURSOR.
DISBAR: PUSH P,CH
SKIPE RREBEG
JRST DISBA1
CALL RRDIS1
SKIPE RGETTY
JRST POPCHJ
DISBA1:
INSIRP PUSH P,TT TT1 BP A B
MOVE CH,QRB.. ;GET ADDR OF CURSOR QREG
ADDI CH,.QCRSR
CALL QLGET
JRST DISBA2 ;NOT TEXT, NO CURSOR.
AOSN CHCTCF ;FORCE OUT ANY BUFFERED CR BEFORE THE CURSOR.
CALL CHCT5
MOVE A,BP
DISBA3: SOJL B,DISBA2 ;LENGTH OF TEXT WAS IN B,
ILDB CH,A ;GET AND OUTPUT CHARS OF CURSOR.
CALL [ CAIN CH,^H
JRST DISBBS ;OUTPUT BS AS REAL BACKSPACE.
CAIL CH,40 ;OUTPUT CTL CHARS OTHER THAN ^H IN IMAGE MODE.
JRST CHCT
JRST CHCT4]
JRST DISBA3
DISBA2: INSIRP POP P,B A BP TT1 TT
POPCHJ: POP P,CH
POPJ P,
;TTY AND DISPLAY ROUTINES.
;"TYPEOUT" - DON'T TYPE CURSOR, DO NOTICE CASDIS.
TYO: PUSHJ P,DISINT ;INIT. TYPEOUT.
JRST DISAD2
TYANOW: PUSHJ P,TYOA ;TYPEOUT, NO CURSOR, NO SLASH.
JRST DISFLS ;FORCE IT OUT IMMEDIATELY.
TYOA: PUSHJ P,DISINT ;"TYPEOUT"
;NO CURSOR, DON'T DO CASE FLAGGING.
CHCT: SKIPE MORNXT
CALL DISMOR
SKIPN ORESET
SKIPE MORFLF ;DON'T OUTPUT AFTER -FLUSHED.
POPJ P,
CAIN CH,^J
JRST CHCTLF ;LF => OUTPUT LINE.
AOSN CHCTCF ;ELSE FORCE OUT SAVED UP CR.
CALL CHCT5B
CAIN CH,177
JRST CHCT0A ;RUBOUT COMES OUT AS ^? .
CAIL CH,40 ;NON-CTL CHARS. ONE POSITION.
JRST CHCT1A
CAIN CH,^I ;TAB => OUTPUT SEVERAL SPACES.
JRST CHCTTB
CAIN CH,^H
JRST CHCTBS
CAIN CH,^M ;REMEMBER A CR, NEXT CHAR WILL DECIDE.
JRST [SETOM CHCTCF ? POPJ P,]
CAIN CH,33 ;ALTMODE => OUTPUT.
JRST [ SKIPE INCHSY ;USING LOCAL EDITING => SEND REAL ALTMODE.
JRST CHCT1A
MOVE Q,TTYOPT
TLNN Q,%TOSAI ;ON TERMINALS WHICH CAN HANDLE ONE, SEND REAL ALTMODE.
MOVEI CH,"$ ;OTHERWISE SEND DOLLARSIGN.
CALL CHCT1A
JRST RET33] ;IN EITHER CASE DON'T CLOBBER CH.
CHCT0A: SKIPE DISSAI ;IN SAIL MODE, CTL CHARS OUTPUT AS THEMSELVES
JRST CHCT1A ;AND ASSUMED TO TAKE 1 POS. ON SCREEN.
CHCT0B: HRLM CH,(P)
SKIPN INCHSY
JRST CHCT0C
MOVEI CH,%TDMLT
CALL CHCT4
MOVEI CH,2
CALL CHCT4
HLRZ CH,(P)
CALL CHCT4
CHCT0C: MOVEI CH,"^ ;OTHER CTL CHARS => OUTPUT "^"
MOVE Q,TTYOPT
TLNE Q,%TOSAI
MOVEI CH,13 ;(OR UPARROW, ON TTY'S WITH SAIL CHAR SET)
CALL CHCT1A
HLRZ CH,(P)
XORI CH,100 ;AND UN-CTLED CHAR.
CALL CHCT
DISAD5: HLRZ CH,(P)
POPJ P,
;OUTPUT AN ORDINARY PRINTING CHARACTER.
;WHEN A FULL LINE HAS BEEN ACCUMULATED, CALL @CHCTAD
;WITH HASH CODE IN CHCTHC, VERT. POS. IN CHCTVP,
;HORIZ. POS. AFTER LINE IN CHCTHP.
CHCT1A: MOVE Q,CHCTHP
CAMGE Q,NHLNS ;IF FILLED LINE, CONTINUE IT.
JRST CHCT2
PUSH P,CH
SKIPGE DISTRN ;TRUNCATING MEANS IGNORING CHARS TILL NEXT CR.
JRST [ MOVEI CH,"! ;IF WE'VE JUST BEGUN TO TRUNCATE,
SKIPL CHCIGN ;PUT IN AN EXCL.
CALL CHCT4
SETOM CHCIGN ;START IGNORING MOST CHARS.
JRST CHCT1B]
MOVEI CH,"!
CALL CHCT4 ;PUT A ! AT END OF LINE.
AOS CHCTHP
MOVEM IN,CHCTNL
SOS CHCTNL ;ADDR OF 1ST CHAR OF NEXT LINE.
SETZM CHCTCF
CALL CHCTL0 ;NOW DO A CRLF.
CHCT1B: POP P,CH
CHCT2: SKIPL CHCTHP
CALL CHCT4 ;OUTPUT THE CHAR IF NECESSARY,
AOS CHCTHP
RET
;PUT THE CHAR IN CH INTO THE BUFFER AND THE HASH-CODE.
;IF THE BUFFER (<- CHCTBP) IS FULL, OUTPUT IT FIRST.
CHCT4: SKIPL CHCIGN
SKIPN CHCTBP
POPJ P,
SOSG DISBFC ;IF BUFFER FULL,FLUSH IT
JRST [ PUSH P,CH
SETOM CHCTNL
MOVE CH,CHCTHP
MOVEM CH,CHCRHP
PUSHJ P,@CHCTAD
POP P,CH
JRST .+1]
IDPB CH,CHCTBP ;STORE CHAR IN CALLER'S BUFFER.
CAIN CH,%TDTSP
MOVEI CH,40
;MERGE CHARACTER IN CH INTO THE HASH CODE FOR THIS LINE.
;THE HASHING DEPENDS ON THE HPOS. WE GET IT FROM CHCTHP.
CHCTH: HRLM CH,(P)
MOVE Q,CHCTHP
IMULI Q,7
ROT CH,(Q)
ADDM CH,CHCTHC
HLRZ CH,(P)
RET
;HERE WE GET THE HPOS FROM RRHPOS. USED FOR INSERTION OF
;SINGLE CHARACTERS, TO UPDATE THE HCODE OF THE LINE AT VPOS IN BP.
CHCTHI: HRLM CH,(P)
MOVE Q,RRHPOS
IMULI Q,7
ROT CH,(Q)
ADDM CH,HCDS(BP)
HLRZ CH,(P)
RET
;HERE WE GET THE HPOS FROM RRHPOS. USED FOR DELETION OF
;SINGLE CHARACTERS, TO UPDATE THE HCODE OF THE LINE AT VPOS IN BP.
CHCTHR: HRLM CH,(P)
MOVE Q,RRHPOS
IMULI Q,7
ROT CH,(Q)
MOVNS CH
ADDM CH,HCDS(BP)
HLRZ CH,(P)
RET
CHCTTB: MOVEI CH,40 ;TAB: OUTPUT SPACES.
SKIPE LEABLE ;(OR, FOR LOCAL EDITING TERMINALS, OUTPUT %TDTSP
MOVEI CH,%TDTSP ;SO THE TERMINAL CAN TELL WHERE THE TABS WERE).
PUSHJ P,CHCT1A
MOVE CH,CHCTHP ;NOT AT TAB STOP =>
SKIPN MORFLF ;GO OUTPUT ANOTHER UNLESS FLUSHED
CAMN CH,NHLNS ;OR WE ARE AT MARGIN, OR AT A TAB STOP.
JRST CHCTT1
IDIV CH,TABWID
JUMPN Q,CHCTTB
CHCTT1: MOVEI CH,11
RET
;INIT. FOR CHCT.
CHCTI0: SETZM CHCTCF ;NO PENDING ^M.
SETZM CHCOVP
SETZM CHCTHP
SETZM CHCIGN ;NOT BEYOND RIGHT MARGIN.
CHCTI1: AOS CHCTVP
SETZM CHCTHC ;INIT. ACCUMULATION OF HASH CODE.
POPJ P,
;FORCE OUT CR BECAUSE FOLLOWING CHAR IS NOT LF.
;IN CONTAINS 2 PLUS CHAR ADDR OF THE CR.
CHCT5B: SOS IN
CALL CHCT5
AOS IN
RET
;OUTPUT A STRAY CR. ;IN SHOULD HAVE 1 PLUS ADDR OF THE CR.
CHCT5: PUSH P,CH
SKIPL DISPCR ;-1 => DO REAL CR.
JRST CHCT5A
MOVE CH,CHCTHP
MOVEM CH,CHCRHP
SETZM CHCTHP ;REAL CR: ZERO HORIZ POSITION,
SETZM CHCIGN ;NO LONGER PAST RIGHT MARGIN.
MOVEI CH,^M ;NOW FORCE OUT THE BUFFER, AND,
CALL CHCTIM ;ON PRINTING TTY, OUTPUT A REAL CR.
JRST POPCHJ
CHCT5A: MOVEI CH,"^ ;SHOULDN'T OVERPRINT, PRINT AS ^M.
MOVE Q,TTYOPT
TLNE Q,%TOSAI
MOVEI CH,13 ;(OR UPARROW, ON TTY'S WITH SAIL CHAR SET)
CALL CHCT1A
MOVEI CH,"M
CALL CHCT1A
MOVE CH,CHCTHP ;IF WE CONTINUE THE LINE RIGHT AFTER THE ^M, WE SHOULD REALIZE
MOVEM CH,RRCCHP ;THAT THE NEXT CHAR STARTS IN COLUMN 0 OF NEXT LINE, NOT COLUMN -2!
JRST POPCHJ
CHCTBS: SKIPL DISPBS ;DISPBS < 0 => PRINT AS BS.
JRST CHCT0A
DISBBS: SKIPN CHCTHP ;CAN'T DO ANYTHING AT LEFT MARGIN.
JRST CHCT0A ;^H AT COLUMN 0 => TYPE ^H.
MOVE Q,CHCTHP
MOVEM Q,CHCRHP
SOS CHCTHP
MOVEI CH,^H ;IF WE'RE REALLY PRINTING, OUTPUT REAL ^H.
CHCTIM: SAVE CH
SETOM CHCTNL
SETOM DISFLF
CALL @CHCTAD ;SEND WHAT WE HAVE SO FAR.
SETZM DISFLF
REST CH
CHCTI9: SAVE CH
MOVE CH,CHCTAD
CAIE CH,DISLIN ;DON'T SEND THE ^H OR ^M IF WE'RE NOT REALLY TYPING.
JRST POPCHJ
MOVE CH,CHCTVP ;NO NEED TO SEND CR NOW IF WILL MOVE DOWN ANYWAY,
CAME CH,DISVP ;SINCE IN THAT CASE THE CURSOR MOTION WILL BE DONE BEFORE NEXT LINE.
JRST POPCHJ
REST CH
SETOM CHCOVP ;INDICATE DOING OVERPRINTING: NEXT DISLIN MUSTN'T %TDMV1 (IMLAX LOSE).
JRST TYOINV
;COME HERE TO OUTPUT A LF. CALLED BY THE ROUTINE TO OUTPUT STRAY CR.
;CLOBBERS ONLY Q. LEAVES A ^J IN CH.
CHCTLF: MOVEM IN,CHCTNL
AOSE CHCTCF ;IF HAVE UNPROCESSED CR, OUTPUT IT.
JRST [ SKIPL DISPCR ;NO CR; WHAT DO WE DO FOR STRAY LF?
JRST CHCT0B ;MAYBE OUTPUT AS ^ AND J.
MOVE Q,CHCTHP
MOVEM Q,CHCRHP
JRST CHCTL1]
SETZM RRCCHP
CHCTL0: SETZM CHCIGN ;STOP IGNORING CHARS IF HAD TRUNCATED LINE.
MOVE Q,CHCTHP
MOVEM Q,CHCRHP
SETZM CHCTHP ;REFLECT IT IN HORIZ. POS.
CHCTL1: PUSHJ P,@CHCTAD ;LF ENDS LINE, TELL CALLER ABOUT IT.
MOVEI CH,^M ;ON NON-DISPLAY, MUST ACTUALLY DO THE CR IF WANTED.
SKIPN CHCTCF
SKIPE RGETTY
CAIA
CALL CHCTI9
PUSHJ P,CHCTI1 ;INIT NEW LINE.
SKIPL CH,CHCTNL
MOVEM CH,CHCTBL
MOVE CH,CHCTVP ;IF NOW PAST END OF SCREEN, NEXT CHARACTER MUST DO A --MORE--.
CAMN CH,CHCTVS
SETOM MORNXT
CHCTL4: SKIPG CH,CHCTHP
JRST CHCTL3
MOVE Q,CHCTHC ;PUT SPACES IN HASH CODE.
CHCTL2: ROT Q,7 ;FOR THE INDENT IN LINE WE'RE STARTING WITH.
ADDI Q,40
SOJG CH,CHCTL2
MOVEM Q,CHCTHC
CHCTL3: MOVEI CH,^J
POPJ P,
SUBTTL HANDLE BOTTOM-OF-SCREEN CONDITION
;PRINT --MORE--, RETURN SETTING MORFLF IF FLUSHED, CLOBBERING ONLY Q.
;IN ^R MODE, EXIT RESTORING P FROM DISPRR.
DISMOR: MOVE Q,CHCTAD
CAIE Q,DISLIN ;IF NOT REALLY PRINTING OUT, DON'T DO --MORE--ING.
RET
SKIPN RREBEG
JRST [ MOVE P,DISPRR ;IN ^R MODE: WE WANT TO POP BACK TO ^R PDL LEVEL.
SKIPN RGETTY ;^R MODE ON PRINTING TTY: WE'RE ALREADY IN POSITION.
RET
MOVEI T,MS%DWN ;^R ON DISPLAY: CHOOSE AMONG --TOP--, --MIDDLE--
SKIPE GEA
TRO T,MS%UP
SKIPE RRMORF ;AND --MORE-- IF FS ^R MORE IS > 0.
MOVEI T,MS%MOR
SKIPGE RRMORF ;USE NONE AT ALL IF FS ^R MORE IS < 0.
SETZ T,
SETZ A,
TRNE T,MS%UP ;IF NOT SAYING --MORE-- AND HAVE TEXT ABOVE AND BELOW SCREEN,
CALL DISMO6 ;COMPUTE FRACTION OF TEXT ABOVE
HRLM A,T ;AND INCLUDE THAT IN THE MODE LINE.
JRST DISMD] ;UPDATE --MORE-- LINE AND RETURN TO ^R.
SKIPN RGETTY
JRST [ CALL DISFLS ;ON PRINTING TTY, JUST ASSUME FLUSHED.
SETOM MORFLF ;AFTER PRINTING THE LF THAT CAUSED THE --MORE--
RET]
SKIPN ORESET
SKIPE MORFLF
RET ;ALREADY FLUSHED.
SAVE CH
SAVE T
SAVE LISTF5
SETZM MORESW
MOVEI T,MS%MOR ;REDISPLAY --MORE-- LINE AND PUT --MORE-- ON IT.
CALL DISMD
SKIPGE CTLCF ;^C IMPLIES FLUSH IT.
JRST DISMO2
TTYACT
IFN TNX,[SAVE ECHOF2
SETZM ECHOF2] ;DONT ECHO IT NOW
PUSHJ P,TYINH
IFN TNX,REST ECHOF2
CAIN CH,40 ;READ A SPACE =>
JRST [ SAVE CHCTHP
SAVE CHCTHC
PUSHJ P,DISTOP ;TOP OF SCREEN, THEN TRY AGAIN.
REST CHCTHC
REST CHCTHP
SKIPL VREMEM ;IF DISPLAYING STUFF THAT'S IN BUFFER,
JRST DISMOX
MOVE Q,CHCTBL ;REMEMBER WHERE THIS SCREENFULL STARTED,
SUB Q,BEGV ;NEXT BUFFER DISPLAY WILL TRY TO START AT SAME PLACE.
MOVEM Q,GEA
JRST DISMOX]
CAIE CH,177 ;ELSE RE-READ UNLESS RUBOUT.
MOVEM CH,UNRCHC
HRRZM P,MORFLF
CAIE CH,177 ;SET MORFLF (FS FLUSHED$) TO NONZERO, POSITIVE IFF RUBOUT.
DISMO2: SETOM MORFLF
DISSTR /-FLUSHED/
CALL DPYIVI ; INIT INVERSE VIDEO
PUSHJ P,DISIOT ;PUT FLUSHED ON THE --MORE-- LINE
CALL DPYIVC ; CANCEL INVERSE VIDEO
MOVEI T,MS%FLS
MOVEM T,MORESW ;AND REMEMBER THAT THAT IS WHAT'S THERE.
IFN TNX,[SKIPE ECHOF2
CALL ECHOCH] ;ECHO IT NOW
DISMOX: REST LISTF5
REST T
REST CH
RET
;A GETS PERCENT OF BUFFER ABOVE START OF WINDOW.
DISMO6: SAVE B
MOVE A,GEA
ADD A,BEGV
SUB A,BEG ;GET WINDOW START REL. TO BEG.
MOVE B,Z
SUB B,BEG ;GET Z REL. TO BEG.
IMULI A,100.
IDIV A,B ;A GETS WINDOW AS PERCENT OF Z.
POPBJ: REST B
RET
SUBTTL SEND THE TERMINAL OUTPUT BUFFER
;CALL HERE TO FORCE OUT BUFFERED OUTPUT.
;CALL AFTER EACH TECO COMMAND THAT DOES OUTPUT.
DISFLS: SETOM DISFLF ;FORCE DISLIN TO MOVE CURSOR
DISFL1: AOSN CHCTCF ;FORCE OUT ANY UNPROCESSED CR.
CALL CHCT5 ;THIS CAN BE A SCREW IF BETWEEN THAT CR AND A LF!
SETOM CHCTNL
MOVE Q,CHCTHP
MOVEM Q,CHCRHP
PUSHJ P,DISLIN ;.IOT IT.
SETZM DISFLF
POPJ P,
;OUTPUT THE BUFFER.
DISLIN: SKIPE TSALTC ;IF A CMD STRING IS WAITING TO BE READ,
SETOM MORFLF ;GIVE UP TYPEING OUT.
SKIPN ORESET
SKIPE MORFLF
JRST DISRST
SAVE T
SAVE BP
DISLI7: SKIPN BP,CHCTVP ;IF ABOUT TO WRITE ON TOP LINE
JRST [ SKIPN TRCOUT ;BECAUSE OF TRACE MODE,
JRST .+1
DISSTR /
/
CALL DISIOT ;CLEAR 1ST LINE AND USE SECOND INSTEAD.
AOS BP,CHCTVP ;THIS WAY ERROR MESSAGES DON'T CLOBBER ANY TRACE OUTPUT.
SETZM HCDS
JRST .+1]
MOVE CH,CHCTHC
SKIPN RGETTY
JRST DISLI0 ;ON PRINTING TTY, NO OLD LINE REMAINS ON SCREEN.
;; SET UP LINBEG OF FOLLOWING LINE, AND MAYBE MOVE TEXT BELOW UP OR DOWN ON SCREEN.
CAML BP,CHCTVS ;IF WE'RE WITHIN THE SCREEN AREA,
JRST DISLI8
SKIPN RREBEG
SKIPGE CHCTNL ;IN ^R, IF AFTER THIS BUFFERFULL STARTS A NEW LINE,
JRST DISLI8 ;COMPUTE THE LINBEG WORD FOR THE LINE THAT WILL FOLLOW THIS ONE:
MOVE T,RRCCHP ;STARTING HPOS IS CURRENT HPOS UNLESS
CAME T,CHCTHP ;WE ARE CONTINUING IN MIDDLE OF A CHAR,
SUB T,NHLNS ;IN WHICH CASE IT IS MINUS THE NUMBER
;OF POSITIONS USED ON PREV. LINE BY THIS CHAR.
LSH T,33 ;PUT STARTING HPOS IN TOP 9 BITS.
ADD T,CHCTNL ;PUT STARTING PT OF LINE IN LOW 33 BITS.
SKIPG Q,RRIDLB ;IF CAN INSERT/DELETE, SEE IF THAT TEXT IS PRESENT ON THE SCREEN
JRST DISLI8
CAMN Q,T
JRST DISLI9 ;AND IF SO, MOVE IT TO THE LINE AFTER THIS ONE.
CAML T,Q ;IF WE HAVE ALREADY HACKED RRIDLB AND PASSED IT, DO NOTHING NOW.
JRST DISLI8
SUB Q,RRIDBK ;ELSE MAYBE WE HAVE REACHED THE BLANK LINES PRECEDING RRIDLB.
SUB Q,RRIDBK
CAMG T,Q
JRST DISLI8
SUB T,Q ;IF SO, FIGURE OUT FROM RRIDBK HOW MANY BLANK LINES REMAIN
ASH T,-1 ;TO BE PRINTED, AND FROM THAT, WHAT VPOS TO COPY RRIDLB TO.
SUB T,RRIDBK ;BUT THERE IS A FUNNY WAY TO TELL DSLID THAT.
ADDM T,RRIDVP
DISLI9: CALL DSLID ;MOVE THE TEXT ACCORDING TO Q AND BP.
JFCL
SETOM RRIDLB ;DON'T TRY TO MOVE IT AGAIN; WOULD GET CONFUSED.
;; WE ARE NOW FINISHED WORRYING ABOUT MOVING THE TEXT BELOW THIS LINE ON THE SCREEN.
DISLI8:
IFN ITS,[MOVE Q,[.BYTE 8 ? %TDNOP ? %TDNOP ? %TDNOP ? %TDNOP]
MOVEM Q,DISBF1 ;INITIALLY ASSUME NO POSITIONING NEEDED
MOVEM Q,DISBF1+1
]
IFN TNX,[
SETZM DISBF1 ;CLEAR OUT CURSOR POSITIONING
MOVE Q,[DISBF1,,DISBF1+1]
BLT Q,DISBF1+5
]
CAML BP,CHCTVS ;IF MOVING CURSOR TO BOTTOM OF SCREEN, DON'T CLEAR THE LINE.
JRST [ MOVEM BP,DISVP
MOVEM BP,DISVP1
JRST DISLI4]
AOSG CHCOVP
JRST DISLI1
AOSG ERRFL1 ;IF ERRFL1 (FS ERRFLG$) IS <0, IT IS - # LINE OF ERROR MSGS ON SCREEN,
JRST DISLN5 ;SO COUNT OFF THAT MANY LINES BEFORE OUTPUTTING.
CAME CH,HCDS(BP) ;IF HASH CODE DOESN'T MATCH, OUTPUT THE LINE.
JRST DISLI4
CAME BP,DISVP ;ELSE IF DISFLF IS SET AND CURSOR NOT ON PROPER LINE ALREADY,
SKIPN DISFLF ;OUTPUT ANYWAY.
JRST DISLN5
DISLI4: SKIPE NOCEOL ;IF WE SHOULD CLEAR THE LINE,
JRST [ MOVE T,CHCRHP ;BUT TERMINAL DOESN'T KNOW HOW,
SUB T,LINEND(BP) ;DO IT BY OUTPUTTING EXTRA SPACES AT THE END
MOVEM T,EOLFLG ; COMPUTE HOW MANY SPACES TO USE.
MOVEM BP,DISVP ;IF EOLFLG IS >0, NO CLEARING IS DONE.
;IN THIS CASE, WE CLEAR EVEN IF BP=DISVP
;FOR THE SAKE OF RRLP2C. RRLCHG SETS THE LINEND WORD TO 0
;TO INHIBIT THE CLEARING.
JRST .+1]
IFN ITS,[
DPB BP,[DISCPV] ;PREPARE TO SET VERT. POS.
DPB BP,[DISC1V]
MOVE Q,DISCM1 ;IF SAME LINE AS BEFORE, JUST MOVE CURSOR; DON'T CLEAR.
MOVEM Q,DISBF1+1
CAMN BP,DISVP
JRST DISLN3
MOVE Q,DISCMV
LDB T,[DISCPH]
JUMPN T,[ ;IF NOT STARTING IN COL 0, MUST GO TO COL 0, CLEAR, THEN SET CURSOR.
MOVEM Q,DISBF1
JRST DISLN3]
MOVEM Q,DISBF1+1 ;IF STARTING IN COL 0, JUST GO TO COL 0 AND CLEAR.
JUMPE BP,DISLN3
IFN LINSAV,[
SKIPE LBLLIM ;IF WE MIGHT CALL SAVLIN, WHICH WOULD MOVE THE CURSOR,
JRST DISLN3 ;DON'T USE A RELATIVE MOTION OPERATION.
]
MOVEI T,-1(BP) ;IF MOVING DOWN 1 LINE, AND GOING TO COL 0, DO IT WITH A %TDCRL.
MOVE Q,[.BYTE 8 ? %TDNOP ? %TDNOP ? %TDNOP ? %TDCRL]
CAMN T,DISVP1
MOVEM Q,DISBF1+1
DISLN3:
]
IFN TNX,[
MOVEI Q,DISMOV ;ASSUME CLEAR TOO
CAMN BP,DISVP
MOVEI Q,DISMV1 ;DONT NEED TO
CALL (Q) ;SET UP DISBF1 RIGHT
]
MOVEM BP,DISVP1 ;REMEMBER WHAT LINE THE CURSOR IS ON.
JRST DISLN4 ;GO OUTPUT POSITIONING & LINE.
DISLI0: SKIPL DISVP ;ON PRINTING TTY,
CAMN BP,DISVP ;IF NOT SAME LINE AS BEFORE, LINEFEED.
JRST DISLI1
IFN ITS,[HRROI Q,[ASCIC/
/]
CALL DISIOT
]
IFN TNX,CALL ECHLF2
JRST DISLN4
DISLN4: SKIPN RGETTY ;HERE WHEN WE KNOW WE MUST OUTPUT THE LINE.
JRST DISLI1
MOVE T,INCHCT ;IF "DISPLAYING" PRE-ECHOED INPUT,
CAMG T,INCHEC ;DON'T ACTUALLY OUTPUT ANYTHING. JUST PRETEND WE DID.
JRST DISLI3
IFN LINSAV,[
SKIPE LBLLIM ;SAVE OLD CONTENTS OF LINE,
CALL SAVLIN ;TO BE BROUGHT BACK ONTO SCREEN LATER WHEN WE WANT TO.
SKIPE LBLLIM
CALL RSTLIN ;IF THE NEW CONTENTS ARE STORED UNDER A LABEL, RESTORE.
]
SKIPN INCHSY
JRST DISLI1
MOVEI Q,%TDCTE ;IF LINE IS CONTINUED AT END, OUTPUT A %TDCTE WITH IT.
MOVE T,CHCRHP
CAMLE T,NHLNS
IDPB Q,CHCTBP
MOVEI Q,%TDCTB
MOVE T,LINEND-1(BP)
CAME BP,TOPLIN ;IF LINE IS A CONTINUATION, OR IS TOP LINE AND THEREFORE
CAMLE T,NHLNS ;MIGHT BE A CONTINUATION, OUTPUT A %TDCTB WITH IT.
IDPB Q,CHCTBP
DISLI1: SKIPGE Q,CHCTBP ;GET THE STUFFING B.P. AND MAKE NORMALIZE IT
SUB Q,[400000,,1] ;BY CONVERTING 441000,,FOO TO 041000,,FOO-1
SETZ T,
DISLI2: TLNE Q,700000 ;COUNT THE NUMBER OF UNUSED BYTES IN THE LAST WORD
AOJA T,[IBP Q ? JRST DISLI2] ;OF THE OUTPUT BUFFER.
MOVEI Q,1-DISBF1(Q)
LSH Q,2
SUBM Q,T ;# OF CHARS TO BE OUTPUT.
CALL DISSIOT ;OUTPUT THAT MANY CHARS STARTING AT DISBF1
DISLI3: SKIPE RGETTY
CAML BP,CHCTVS ;STORE NEW HASHCODE.
JRST DISLN5
MOVE T,CHCRHP ;RECORD HPOS OF END OF LINE.
MOVEM T,LINEND(BP)
MOVE CH,CHCTHC
MOVEM CH,HCDS(BP)
DISLN5: MOVEM BP,DISVP ;INDICATE WHERE WE HAVE PUT THE CURSOR.
MOVEI T,1(BP)
SKIPE RGETTY ;ON A DISPLAY, CONSIDER STOPPING OUTPUT BECAUSE OF INPUT AVAIL.
CAML T,CHCTVS ;AVOID BOUNDARY LOSSAGE: DON'T STOP ON --MORE-- LINE
JRST DISLN1 ;OR THE LINE BEFORE IT (WOULD SET --MORE-- LINE'S LINBEG).
SKIPN RREBEG
SKIPGE CHCTNL ;IF AFTER THIS BUFFERFULL STARTS A NEW LINE,
JRST DISLN1
;SET UP LINBEG WORD FOR LINE AFTER THIS ONE, IN CASE WE DECIDE TO STOP DISPLAYING NOW.
;IF WE DO, THE LINBEG WORD FOR THE NEXT LINE IS NECESSARY FOR STARTING UP AGAIN.
MOVE T,RRCCHP ;STARTING HPOS IS CURRENT HPOS UNLESS
CAME T,CHCTHP ;WE ARE CONTINUING IN MIDDLE OF A CHAR,
SUB T,NHLNS ;IN WHICH CASE IT IS MINUS THE NUMBER
;OF POSITIONS USED ON PREV. LINE BY THIS CHAR.
LSH T,33 ;PUT STARTING HPOS IN TOP 9 BITS.
ADD T,CHCTNL ;PUT STARTING PT OF LINE IN LOW 33 BITS.
SETZM DISFLF ;IN CASE WE EXIT, MAKE SURE DISFLF DOESN'T STAY SET.
MOVE Q,CHCTNL
CAMLE Q,RRMAXP ;IF NEXT LINE STARTS PAST THE END OF ALL CHANGES,
SKIPL RRMSNG ;AND ALL UNCHANGED LINES ARE PROPERLY ON THE SCREEN, MAYBE WE CAN STOP.
JRST DISLN2
MOVE Q,LINBEG+1(BP)
ADD Q,ZV ;IF WE ARE ABOUT TO DISPLAY THE SAME CHARACTERS THAT ARE ON THE LINE
SUB Q,RROLZV ;ALREADY (TAKING INTO ACCOUNT INSERTIONS AND DELETIONS SINCE
CAMN T,Q ;OLD LINBEG WAS STORED), THEN WE NEED NOT REALLY REDISPLAY.
JRST RRDISF ;SO STOP DISPLAYING AND RETURN TO ^R.
DISLN2: AOS BP
MOVEM T,LINBEG(BP)
MOVEM BP,RRMNVP ;IF THERE IS INPUT, STOP DISPLAYING; LATER START FROM NEXT LINE.
SKIPL RRMSNG ;IF WE ARE MOVING PAST THE RRMSNG LINE, MOVE RRMSNG ALONG.
CAMG BP,RRMSNG
CAIA
MOVEM BP,RRMSNG
SETZM RRMNHP ;THUS MAKE SURE REDISPLAY STARTS THIS FAR UP AT LEAST.
SKIPE DFORCE ;FS DFORCE$ MEANS FINISH DISPLAY EVEN IF INPUT IS WAITING.
JRST DISLN1
CAMN BP,RRIDVP ;DON'T STOP DISPLAY JUST AFTER CLOBBERING LINBEG RECORDING
SKIPG RRIDLB ;THE TEXT WE WANT TO MOVE ON THE SCREEN.
CAIA ;ELSE COULD CAUSE I/D LINE NOT TO BE USED IN AUTO FILL
JRST DISLN1 ;IF WE STOP DISPLAY HERE NOW AND AGAIN ONE LINE LOWER.
MOVE T,INCHCT
CAMN T,INCHEC ;DON'T PRE-EMPT DURING "DISPLAY" CALCULATIONS
JRST DISLN1 ;AFTER INPUT THAT WAS PRE-ECHOED, SO IT DOESN'T MIX
;WITH INPUT THAT WE REALLY DO HAVE TO OUTPUT FOR.
IFN ITS,[
SKIPE DWAIT ;FOR VERY SLOW TTYS, WAIT BETWEEN LINES SO WE STOP DISPLAYING FAST
LISTEN T ;WHEN THERE IS TYPE-IN.
.STATUS CHTTYI,T ;ARE CHARS AVAILABLE FOR ^R TO PROCESS?
ANDI T,2000 ;IF SO, STOP DISPLAYING AND PROCESS THEM.
]
IFN TNX,[
SAVE A
SAVE B
MOVEI A,.CTTRM
SKIPE DWAIT ;DO DOBE ONLY IF SLOW TERMINAL
DOBE ;(DONT USE LISTEN MACRO)
SIBE ;ANY CHARACTERS FOR ^R TO PROCESS?
TDZA T,T ;YES
SETO T, ;NO
REST B
REST A
]
JUMPN T,DISLN1
;WE HAVE INPUT; STOP DISPLAY.
CALL DBGBFI ;SAVE UP SOME INFO FOR DEBUGGING.
SKIPE LID ;IF CAN DO INSERT/DELETE, SET RRMSNG INSTEAD OF UPPING RRMAXP
JRST [ MOVE T,BOTLIN ;SINCE LATTER WOULD PREVENT THIS INPUT CHAR
SKIPL RRMSNG ;FROM INSERTING OR DELETING LINES.
CAMGE T,RRMSNG
MOVEM T,RRMSNG
JRST RRDISX]
MOVE T,CHCTNL ;MAKE SURE NEXT REDISPLAY DOESN'T
CAMLE T,RRMAXP ;STOP BEFORE REACHING THIS FAR DOWN.
MOVEM T,RRMAXP ;WITHOUT THIS, <CR> <RUB> <RUB> LOSES IF THE TWO
JRST RRDISX ;RUBOUTS STOP DISPLAY, 1ST AT LINE 15 (SAY), THEN AT LINE 12.
DISLN1: REST BP
REST T
DISLI6: MOVE Q,CHCTHP ;REMEMBER STARTING HORIZ POS. OF NEXT LINE.
IFN ITS,DPB Q,[DISCPH]
IFN TNX,MOVEM Q,DISCPH
DISRST: MOVE Q,[441000,,DISBUF]
MOVEM Q,CHCTBP ;RE-INIT BUFFERING.
MOVEI Q,4*DISBFC-6
MOVEM Q,DISBFC
POPJ P,
;HERE IN REDISPLAY ON TERMINALS WITH INSERT/DELETE LINE
;WHEN WHAT'S LEFT ON THE SCREEN BELOW CURSOR IS VALUABLE, IF MOVED TO THE RIGHT PLACE.
;WE MOVE IT THERE AND THEN RESUME DISPLAYING.
;BP HAS VPOS OF LINE ABOUT TO BE OUTPUT, WHEN CALLED FROM DISLIN.
;THIS MEANS THAT FOR UPWARD MOTION WE MOVE THINGS UP TO LINES STARTING FROM 1(BP),
;WHEREAS FOR DOWNWARD MOTION WE MOVE DOWN FROM LINES STARTING FROM (BP).
;THE DISTANCE THAT LINES MOVE ACROSS IS (RRIDVP)-(BP)-1 IN EITHER CASE.
;OTHER CALLERS MUST ARRANGE BP AND RRIDVP ACCORDINGLY.
;WE CLOBBER ONLY Q.
;SKIPS IF WE REALLY DO MOVE TEXT.
DSLID: MOVE Q,RRIDVP ;GET OLD POSITION OF TEXT WE WANT TO MOVE UP OR DOWN.
SUBI Q,1(BP) ;Q GETS # LINES TO MOVE IT UP (OR - # TO MOVE IT DOWN).
;Q=0 IS A SPECIAL CASE- NO MOTION OF THE STUFF ON THE SCREEN IS NECESSARY!
JUMPE Q,CPOPJ ;THE NON-INSERT-DELETE MECHANISMS FOR RROLZV WILL WIN IN THIS CASE.
IFN ITS,[SAVE 0 ;PUSH THE CURRENT CURSOR POS SO WE CAN AVOID CHANGING IT.
SYSCAL RCPOS,[%CLIMM,,CHTTYO ? %CLOUT,,(P)]
.LOSE %LSFIL
]
.ELSE SAVE TTLPOS
SAVE Q
SAVE BP
JUMPL Q,DSLIDD
;WE WANT TO MOVE STUFF UP.
AOS BP
ADD BP,-1(P) ;CHECK FOR SCREW CASE THAT THERE REALLY AREN'T ANY USEFUL LINES
CAML BP,BOTLIN ;LEFT TO MOVE UP. IF WE DIDN'T CHECK, DSLID5 WOULD CLOBBER LOW CORE.
JRST DSLID4
SUB BP,BOTLIN
MOVNS BP ;HOW MANY LINES ARE WE PRESERVING?
IMULI BP,5 ;IF IT'S NOT AT LEAST 1/5 AS MANY AS HOW FAR WE ARE MOVING THEM,
CAMGE BP,Q ;GIVE UP AND REWRITE THEM ALL.
JRST DSLID4
MOVE BP,INCHCT ;IF "DISPLAYING" PRE-ECHOED INPUT,
CAMG BP,INCHEC ;DON'T ACTUALLY OUTPUT ANYTHING.
JRST DSLID8
IFN LINSAV,[
SKIPN LBLLIM
JRST DSLIDE
MOVE BP,(P)
AOS BP
DSLIDB: CALL SAVLIN ;TELL TERMINAL TO REMEMBER THE LINES WE ARE
CAMG BP,RRIDVP ;PUSHING OFF THE SCREEN.
AOJA BP,DSLIDB
DSLIDE:] ;LINSAV
MOVE BP,(P)
AOS BP
SKIPGE LID ;TERMINAL CAN SCROLL MIDDLE OF SCREEN?
JRST [CALL SCRLUP ;YES, SCROLL Q LINES UP THEN
JRST DSLID8]
CALL DELLIN ;DELETE THAT MANY LINES BELOW WHERE CURSOR IS NOW.
MOVE BP,BOTLIN
SUB BP,-1(P)
MOVE Q,-1(P) ;NOW GO THAT MANY LINES ABOVE MODE LINE (TO WHERE TEXT OF MODE LINE IS)
CALL INSLIN ;AND INSERT EMPTY LINES TO PUSH MODE LINE BACK TO RIGHT PLACE.
DSLID8: MOVE Q,(P)
AOS BP,Q ;Q GETS NEW VPOS OF UPPERMOST LINE MOVED UP.
ADD BP,-1(P) ;BP GETS THE VPOS IT CAME FROM.
SAVE A
DSLID5: MOVE A,LINBEG(BP) ;COPY UP THE LINBEGS FOR THE LINES MOVED UP.
MOVEM A,LINBEG(Q)
MOVE A,LINEND(BP)
MOVEM A,LINEND(Q)
IFN LINSAV,[
MOVE A,LINLBL(BP)
MOVEM A,LINLBL(Q)
]
MOVE A,HCDS(BP)
MOVEM A,HCDS(Q) ;ALSO COPY THE HASH CODES OF THE COPIED LINES.
AOS BP
AOS Q
CAMGE BP,BOTLIN ;STOP WHEN BP POINTS AT THE WINDOW END, WHICH WASN'T MOVED UP.
JRST DSLID5
SKIPGE RRMSNG
JRST DSLIDA
MOVN A,-2(P) ;RRMSNG, IF NOT -1, MUST RELOCATE WITH THE TEXT IT REFERS TO.
ADDM A,RRMSNG
SKIPGE RRMSNG ;BUT DON'T LET RELOCATION MAKE IT NEGATIVE, SINCE THAT IS DIFFERENT.
SETZM RRMSNG
DSLIDA: SKIPL RRMSNG
CAMGE Q,RRMSNG ;THE INSERTED BLANK LINES NEED REDISPLAY,
MOVEM Q,RRMSNG ;EVEN THOUGH THERE MAY BE NO CHANGES TO THE BUFFER THAT FAR DOWN.
REST A
DSLID6: SETZM HCDS(Q) ;ZERO THE HASH CODES FOR THE INSERTED BLANK LINES.
IFN LINSAV,SETOM LINLBL(Q)
SETZM LINEND(Q)
AOS Q
CAMGE Q,BOTLIN
JRST DSLID6
DSLID3: MOVE BP,-2(P) ;NOW RESTORE CURSOR TO POSITION IT HAD ON ENTRY TO DSLID.
CALL SETCU1
AOS -3(P)
DSLID4: REST BP ;SO THAT WE FILL IN THOSE BLANK LINES.
REST Q
JRST POP1J
;HERE TO MOVE TEXT DOWNWARD.
DSLIDD: MOVMS -1(P) ;GET POSITIVE # OF LINES TO MOVE DOWN.
MOVE BP,BOTLIN
SUB BP,-1(P)
MOVE Q,BP
SOS Q
CAMG Q,(P) ;DETECT FUNNY CASE WHERE THE NUMBER OF LINES LEFT IS LESS THAN
JRST DSLID4 ;THE DISTANCE DOWN WE MUST MOVE THEM. GIVE UP IN THAT CASE.
SUB Q,(P) ;GET NUMBER OF LINES TO BE PRESERVED.
IMULI Q,5 ;IF THAT ISN'T AT LEAST 1/5 THE DISTANCE THEY ARE MOVING, DON'T BOTHER.
CAMGE Q,-1(P)
JRST DSLID4
MOVE Q,INCHCT ;IF "DISPLAYING" PRE-ECHOED INPUT,
CAMG Q,INCHEC ;DON'T ACTUALLY OUTPUT ANYTHING.
JRST DSLID9
IFN LINSAV,[
SKIPN LBLLIM
JRST DSLIDF
SAVE BP
DSLIDC: CALL SAVLIN ;TELL TERMINAL TO REMEMBER THE LINES WE ARE
CAMGE BP,BOTLIN ;PUSHING OFF THE SCREEN.
AOJA BP,DSLIDC
REST BP
DSLIDF:] ;LINSAV
MOVE Q,-1(P)
SKIPGE LID ;TERMINAL CAN SCROLL MIDDLE?
JRST [MOVE BP,(P) ;YES, GET TOP LINE AGAIN
CALL SCRLDN ;SCROLL Q LINES DOWN
JRST DSLID9]
CALL DELLIN ;FIRST, DELETE SOME LINES JUST ABOVE THE MODE LINE.
MOVE BP,(P)
MOVE Q,-1(P)
CALL INSLIN ;THEN, INSERT THE SAME NUMBER JUST BELOW THIS LINE.
DSLID9: MOVE Q,BOTLIN
SOS Q
MOVE BP,Q
SUB BP,-1(P)
SAVE A
SAVE LINBEG+1(BP) ;REMEMBER LINBEG OF FIRST LINE THAT MOVES OFF SCREEN BOTTOM.
DSLID1: MOVE A,LINBEG(BP) ;COPY DOWN THE LINBEGS FOR THE LINES MOVED DOWN.
MOVEM A,LINBEG(Q)
MOVE A,LINEND(BP)
MOVEM A,LINEND(Q)
IFN LINSAV,[
MOVE A,LINLBL(BP)
MOVEM A,LINLBL(Q)
]
MOVE A,HCDS(BP)
MOVEM A,HCDS(Q) ;ALSO COPY THE HASH CODES OF THE COPIED LINES.
SOS BP
SOS Q
CAML BP,-2(P) ;STOP AFTER MOVING THE HIGHEST LINE TO BE MOVED.
JRST DSLID1
LDB A,[3300,,LINBEG+1(Q)] ;PREVENT DISPLAY FROM STOPPING INSIDE THE
ADD A,ZV ;NEWLY CREATED BLANK SCREEN LINES
SUB A,RROLZV ;BY SETTING RRMAXP TO A VALUE JUST HIGH ENOUGH
CAMLE A,RRMAXP ;TO PREVENT STOPPING THERE.
MOVEM A,RRMAXP
DSLID7: MOVE A,LINBEG+1(BP) ;FILL THE LINBEGS OF THE NEWLY CREATED BLANK LINES WITH
MOVEM A,LINBEG(Q) ;SOMETHING MEANINGFUL: THE LINBEG OF THE FIRST FOLLOWING LINE.
SETZM HCDS(Q) ;CLEAR THE HASHCODES OF THE NEWLY MADE BLANK LINES.
SETZM LINEND(Q)
IFN LINSAV,SETOM LINLBL(Q)
CAIE Q,1(BP)
SOJA Q,DSLID7
REST A ;GET BACK LINBEG OF LINE MOVED OFF BOTTOM OF SCREEN.
SKIPN DFORCE ;DFORCE => MODE LINE SHOULD NOT BE UPDATED BY THIS REDISPLAY.
SKIPL RRMSNG ;IF RRMSNG IS SET THEN THE LINBEGS AREN'T EVEN VALID FOR
JRST DSLID2 ;WHAT FOLLOWS, BUT SOMEONE ELSE WILL HANDLE IT.
SKIPL RRMORF
CAMN A,RROLZV ;IF THERE WAS DISPLAYED TEXT ON THAT LINE,
JRST DSLID2
MOVE A,MORESW ;THEN THERE IS NOW TEXT PAST BOTTOM.
TRON A,MS%DWN ;THIS FACT MUST GO IN MORESW FOR RRWBLS EVEN IF NO REDISLPLAY.
TRO A,MS%LOS ;BUT IF MODE LINE IS NOW OBSOLETE, MAKE IT GET REDISPLAYED.
TRO A,MS%PCT ;MAKE SURE --NN%-- IS RECALCULATED IN CASE CHANGED.
SKIPE RRMORF
MOVEI A,MS%MOR
MOVEM A,MORESW
DSLID2: REST A
JRST DSLID3
SUBTTL INITIALIZE DISPLAY OUTPUT
;INIT FOR DISPLAY OUTPUT.
DISINI: SETOM TYOFLG ;"TYPEOUT" NO LONGER INITTED.
SETOM ECHCHR ;IF ^R COMMAND DOES DISPLAYING IT SHOULDN'T BE ECHOED ON PRINTING TTY.
MOVE Q,QRB..
SETOM .QVWFL(Q)
DISIN0: SETZM VREMEM
DISTO1: PUSHJ P,CHCTI0 ;INIT FOR CHCT.
MOVEI Q,DISLIN ;TELL IT TO CALL DISLIN EACH LINE.
MOVEM Q,CHCTAD
PUSHJ P,DISLI6 ;INIT. BUFFERING.
;MOVE TO TOP OF SCREEN. CLOBBERS ONLY Q.
DISTOP: AOSN PJATY
JRST [ CALL CTLL1
JRST DISTO1 ] ;REINIT IN CASE FS REDISPLAY$ DID SOME TYPEOUT.
SETZM MORFLF ;UNDO A FLUSHED.
SETZM MORNXT
SETZM OLDFLF
SETOM DISVP
SETZM DISVP1
MOVE Q,USZ
MOVEM Q,CHCTVS
SKIPN RGETTY
JRST [ SETZM TOPLIN
SKIPE RUBENC ;ON PRINTING TTY, NORMALLY ADVANCE TO CLEAN LINE,
JRST RUBEND ;BUT DO SOMETHING SPECIAL IF WAS PREARRANGED.
JRST CRIF]
SAVE C
MOVE C,NLINES ;SET UP WINDOW SIZE FROM USER-SETTABLE FLAGS (LINES AND TOPLINE).
CALL WINSET
REST C
MOVE Q,TOPLIN
MOVEM Q,CHCTVP
MOVE Q,BOTLIN
SKIPN RGETTY
MOVE Q,USZ
MOVEM Q,CHCTVS
SKIPGE ERRFL1
RET
JRST HOMCUR ;BRING CURSOR TO TOP LEFT.
;START "TYPEOUT" AT TOP OF SCREEN.
DISTOT: SETOM TYOFLG ;FORCE RE-INIT.
;INIT FOR TYPEOUT, PREVENT BUFFER DISPLAY.
;ALL TYPEOUT ROUTINES MUST COME HERE.
DISINT: MOVE Q,QRB..
SETOM .QVWFL(Q)
SETOM ECHCHR ;IF ^R COMMAND DOES TYPEOUT IT SHOULDN'T BE ECHOED ON PRINTING TTY.
AOSN TYOFLG ;IF NO PREVIOUS TYPEOUT,
JRST DISIN0
SKIPE RUBENC
CALL RUBEND
RET
CTLL: SKIPLE CLRMOD ;SCREEN-CLEARING MAY BE DISABLED.
RET
MOVE Q,QRB..
SETZM .QVWFL(Q) ;ALLOW BUFFER DISPLAY.
SETOM TYOFLG ;NEXT TYPEOUT WILL START AT TOP OF SCREEN.
SETOM GEA ;ALLOW NEW TEXT WINDOW TO BE CHOSEN.
SETZM MORFLF ;FLUSHING A --MORE-- DOESN'T LAST PAST CLEARING THE SCREEN.
SETZM OLDFLF
SKIPGE PJATY
JRST CTLL1
SKIPE RGETTY
SKIPN NLINES ;IF NOT USING WHOLE SCREEN FOR WINDOW NOW,
SKIPE TOPLIN ;CLEAR JUST WHAT'S IN THE WINDOW.
JRST CTLL2
JRST CTLL3
;HERE TO DO A REAL CLEAR-SCREEN BECAUSE TTY WAS TAKEN AWAY.
CTLL1: SETZM INCHSY ;TERMINAL HAS STOPPED USING LOCAL EDITING;
SETZM INCHRQ ;WE MUST ASK IT TO RESYNCH WITH US.
SETOM INCHEC ;NOT PROCESSING PRE-ECHOED CHARS NOW.
CTLL3: SETZM PJATY ;HERE TO CLEAR WHOLE SCREEN.
SETZM MORESW ;BE AWARE THAT --MORE-- IS BEING ERASED.
SETZM ECHACT ;ECHO AREA IS NOW CLEAR.
SETZM ECHONL
CALL ECHOHU ;HOME UP ECHO AREA CURSOR
;DO IT BEFORE CLRSCN SO CURSOR DOESN'T ACTUALLY
;MOVE THERE ON ITS.
CALL CLRSCN ;CLEAR SCREEN.
SETOM RROVPO ;SHOW RRTTY THAT IT NEEDN'T ECHO THE COMMAND.
SETOM DISOMD ;REDISPLAY THE "MODE" ON THE --MORE-- LINE.
SETZM HCDS ;SET HASH CODES TO 0
MOVE Q,[HCDS,,HCDS+1]
BLT Q,HCDSE-1 ;SINCE 0 IS CODE FOR A NULL LINE
SETZM LINEND ;STORE LINE END HPOS AS 0 FOR EACH LINE.
MOVE Q,[LINEND,,LINEND+1]
BLT Q,LINEND+MXNVLS-1
SKIPN REFRSH ;IF USER HAS A REFRESH ROUTINE, RUN IT.
RET
CALL SAVACS ;SAVING ALL ACS, AND DOING A (-) AROUND IT.
MOVE A,REFRSH
CALL MACXCP
JRST RSTACS
CTLL2: SKIPE RGETTY ;ON DISPLAYS, EFFECTIVELY CLEAR ECHO AREA WITH A CR.
CALL ECHOCL
CALL DISINI ;CLEAR WINDOW AREA BY DOING A "BUFFER DISPLAY" OF NO CHARACTERS.
SETO IN,
CALL DISCLR ;NOW "REST OF SCREEN", MEANING ALL OF WINDOW.
MOVE Q,QRB..
SETZM .QVWFLA(Q)
RET
;"CLOSE" A BUNCH OF DISPLAY OUTPUT - CLEAR LINES FROM CURSOR TO END OF WINDOW.
DISCLG: CAME IN,PT
JRST DISCL3
SKIPN RREBEG
CALL RRDIS1
DISCL3: SETZM VREMEM
SETOM TYOFLG ;FORCE NEXT TYPEOUT TO CALL DISINT
CALL DISFL1 ;FORCE OUT ANY INCOMPLETE LINE.
SKIPN ORESET
SKIPE MORFLF ;IF WE WERE FLUSHED AT A --MORE--, JUST UN-FLUSH.
RET
SKIPN RGETTY ;ELSE, ON DISPLAY TTY, CLEAR REST OF SCREEN
RET
AOS CHCTVP
CALL DISCLR ;CLEAR OUT REST OF LINES IN DISPLAY AREA. SET LINBEGS FROM IN.
;MAKE SURE THE --MORE-- LINE DOESN'T SAY "--MORE--", AND HAS THE
;CORRECT MODE DISPLAYED ON IT.
DISCLJ: MOVEI T,MS%UP
SKIPE GEA ;FIGURE OUT WHETHER WE WANT AN EMPTY --MORE-- FIELD, OR A --BOT--.
SKIPE RREBEG
SETZ T,
SKIPE RRMORF
SETZ T,
JRST DISMD ;AND UPDATE THE --MORE-- LINE IF IT ISN'T WHAT WE WANT.
;CLEAR LINES FROM CHCTVP DOWN TO END OF DISPLAY AREA.
;IN CAN HAVE ADDRESS OF END OF BUFFER, IF PREVIOUS LINES HOLD DATA FROM BUFFER.
;IF IN CONTAINS -1, WE CLEAR LINES EVEN IF ALREADY CLEAR.
DISCLR: MOVE BP,CHCTVP
CAML BP,CHCTVS ;STOP CLEARING AT END OF WINDOW, OR END OF SCREEN.
RET
SKIPLE IN
MOVEM IN,LINBEG(BP) ;ABOUT TO CLEAR A LINE: SET ITS LINBEG TO END OF BUFFER.
SKIPN HCDS(BP) ;LINE ALREADY CLEAR => DON'T CLEAR IT.
JUMPGE IN,DISCL1
SETZM HCDS(BP) ;CLEAR A LINE BY CLEARING THE HASH CODE,
HRLZS BP ;MOVING TO THE LINE
CALL SETCUR
CALL CLREOL ;AND CLEARING VIA THE SYSTEM.
DISCL1: AOS CHCTVP
JRST DISCLR
;<HASH>,<VPOS>FS TYO HASH$ SETS HASH CODE OF LINE.
FSHCD: TRZN FF,FRARG
TYPRE [AOR]
MOVE E,SARG
SKIPL C ;REQUIRE VPOS TO BE IN RANGE.
CAML C,USZ
TYPRE [AOR]
MOVE A,HCDS(C)
TRZE FF,FRARG2
MOVEM E,HCDS(C)
JRST POPJ1
SUBTTL MODE LINE DISPLAY
FRCMD: TRZE FF,FRCLN
JRST CLRMOR ;:FR => CLEAR THE MORE LINE ENTIRELY.
SKIPN RGETTY ;FR => ON PRINTING TTY, MAYBE TYPE OUT THE MODE.
JRST DISMDP ;FOR IMPLICIT FR'S SUCH AS FI AND ^R, WE NEVER DO THAT.
;REDISPLAY THE MODE LINE AND RETURN CURSOR TO WHERE IT IS,
;PROVIDED THERE IS NO INPUT AVAILABLE.
DISMDI: MOVE Q,$QMODE ;UPDATE MODE DISPLAY IF IT IS NECESSARY
SKIPN RGETTY ;ON PRINTING TTY, WE DISPLAY IT DIFFERENTLY.
RET
MOVE T,PFINI
SUB T,PF ;COMPARE -2*(FS QP PTR$) WITH FS MODE CHANGE$
HRRES T
CAMG T,MODCHG ;IF FS MODE CHANGE$ LESS, WE MUST RUN FS MODE MAC$
SKIPLE MODCHG ;IF FS MODE CHANGE$ IS POS, WE MUST RUN FS MODE MAC$
JRST .+3
CAMN Q,DISOMD
RET
SKIPN TYISRC
SKIPL UNRCHC
RET
LISTEN Q
JUMPN Q,CPOPJ ;DON'T UPDATE MODE LINE IF INPUT AVAILABLE.
MOVE T,MORESW ;DON'T CHANGE THE --MORE-- OR WHATEVER,
CAIN T,MS%FLS ;EXCEPT GET RID OF A "FLUSHED".
MOVEI T,MS%MOR
IFN ITS,[
HRROI Q,[ASCIC/S/] ;AVOID CLOBBERING CURSOR POSITION.
CALL DISIOT
CALL DISMD ;NO INPUT: DISPLAY THE NEW "MODE"
HRROI Q,[ASCIC/R/]
JRST DISIOT
]
IFN TNX,[
SAVE B
MOVE B,TTLPOS ;MOVE CURSOR BACK WHERE IT WAS BEFORE
CALL DISMD
JRST SETCU3
]
DISMDP: SKIPN SHOMOD ;ONLY DISPLAY MODE ON PRINTING TTY IF FS SHOWMODE$ IS SET.
RET
MOVEM Q,DISOMD ;AND THEN ALWAYS SHOW IT EVEN IF HAVE INPUT.
CALL CRIF ;GET FRESH LINE
CALL DISMD2 ;TYPE OUT MODE
JRST CRIF ;AND ANOTHER NEW LINE
;UPDATE, IF NECESSARY, THE "MODE" DISPLAYED ON THE --MORE-- LINE.
;THE "MODE" IS A TEXT STRING STORED IN Q..J. THE CONTENTS OF THAT QREG ARE
;ALWAYS VISIBLE ON THE --MORE-- LINE. THE IDEA IS FOR THE USER TO BE
;ABLE TO TELL IMMEDIATELY WHAT MODE HE IS IN (WHERE THE MODES ARE DEFINED
;BY HIS MACROS PACKAGE).
;T SHOULD HAVE THE DESIRED MORESW VALUE SAYING WHETHER WE WANT --MORE-- OR --TOP-- OR WHAT.
DISMD: MOVE Q,PFINI
SUB Q,PF ;COMPARE -2*(FS QP PTR$) WITH FS MODE CHANGE$
HRRES Q
CAMG Q,MODCHG ;IF FS MODE CHANGE$ IS LESS, WE MUST RUN FS MODE MAC$
SKIPLE MODCHG ;IF IT IS POSITIVE, WE MUST RUN IT TOO.
CALL [
CALL SAVACS
SAVE SQUOTP
SAVE RCHALT
MOVE A,[JFCL ENDARG]
MOVEM A,RCHALT
SETZM MODCHG ;CLEAR THE FLAG.
SETZB C,E ;PASS 0 AS ARG TO USER'S MACRO.
SKIPE A,MODMAC
CALL MACXCP ;CALL USER'S MACRO TO RECOMPUTE IT
REST RCHALT
REST SQUOTP
JRST RSTACS]
SKIPN RGETTY ;NO MODE IS SHOWN ON PRINTING TTY'S.
RET
SKIPE DFORCE ;DON'T UPDATE MODE IF FS D FORCE$ IS SET.
RET
TRZE T,MS%LOS ;MS%LOS SET IN T MEANS WE GOT T FROM MORESW AND MODE LINE DOESN'T
SETOM MORESW ;MATCH IT, SO MAKE SURE WE REDISPLAY THE MODE LINE --NN%--.
TRZN T,MS%PCT
JRST DISMDM
TRNE T,MS%UP ;IF MS%PCT WAS SET, WE SHOULD RECOMPUTE PERCENTAGE ABOVE SCREEN,
TRNN T,MS%DWN ;PROVIDED WE WANT TO DISPLAY IT AT ALL (NOT --TOP-- OR --BOT--).
JRST DISMDM
SAVE A
CALL DISMO6 ;COMPUTE IT, PUT IT IN LH(T).
HRL T,A
REST A
DISMDM: TRO T,MS%MOD ;DECIDE WHETHER WE WANT A STAR FOR "BUFFER MODIFIED".
SKIPE MODIFF
SKIPE RRMORF
TRZ T,MS%MOD
SKIPE RRSTAR
TRNE T,MS%MOR
TRZ T,MS%MOD
MOVE Q,$QMODE ;IF THE DESIRED MODE STRING IS CHANGED, REDISPLAY THE ENTIRE LINE.
CAME Q,DISOMD
JRST DISMD2
CAMN T,MORESW ;IF ONLY THE DESIRED STATE OF --MORE-- OR --TOP-- IS CHANGED,
RET ;REDISPLAY FOR THAT.
DISMD2: SETOM RROHPO ;REMEMBER THAT I.T.S. CURSOR POS. IS BEING CLOBBERED.
SETOM RROVPO
INSIRP PUSH P,A B TT TT1 BP CH
MOVE TT,NHLNS ;FIND HPOS TO TRUNCATE ..J AT SO THAT --MORE-- OR WHATEVER WILL FIT.
SKIPE T
SUBI TT,7 ;TOGETHER WITH THE --TOP-- OR WHATEVER.
TRNE T,MS%MOR ;OR, IF IT MIGHT BE --MORE---FLUSHED,
SUBI TT,9 ;LEAVE ROOM FOR THAT.
TRNE T,MS%MOD ;IF IT SHOULD HAVE A STAR, LEAVE ROOM FOR THAT TOO.
SUBI TT,2
MOVE Q,$QMODE ;ON DISPLAY TTY, IF ..J IS UNCHANGED, DISPLAY ONLY THE --TOP--.
CAMN Q,DISOMD
SKIPN RGETTY
CAIA
JRST DISMD9
MOVEM Q,DISOMD
MOVE A,Q
CALL CLRMOR ;CLEAR THE WHOLE --MORE-- LINE.
MOVE Q,TT
CALL DPYIVI ; INIT INVERSE VIDEO
CALL QLGET0
JRST DISMD1 ;MODE STRING IS NULL?
DISMD3: SOJL B,DISMD1 ;DISPLAY THE ..J STRING, COUNTING DOWN LENGTH IN B.
SOJL Q,DISMD1 ;Q HAS MAX # COLUMNS TO USE.
ILDB CH,BP
CAIE CH,177 ;COUNT TWO POSITIONS FOR CTL CHARS. THEY MIGHT POSSIBLY
CAIGE CH,40 ;USE ONLY ONE, BUT BETTER TO ERR CONSERVATIVELY.
SOJL Q,DISMD1
IFN ITS,[ ;OUTPUT WITH %TJECH SET SO CTL CHARS DON'T COME OUT IN IMAGE MODE.
SYSCAL IOT,[%CLIMM,,CHTTYO ? CH ? %CLBIT,,%TJECH]
.LOSE %LSFIL
]
.ELSE CALL TYOIN1
JRST DISMD3
;WE HAVE WRITTEN OUT ..J (OR PART OF IT). NOW SAVE THE HPOS WHERE IT ENDS,
;AND THEN WRITE OUT --TOP--, --NN%-- OR WHATEVER SHOULD GO AT THE END.
DISMD1:
CALL DPYIVC ; CLEAR INVERSE VIDEO
IFN ITS,[
SYSCAL RCPOS,[%CLIMM,,CHTTYO ? %CLOUT,,CH]
.LOSE %LSFIL
]
.ELSE MOVE CH,TTLPOS
HRRZM CH,MOREHP
JRST DISMD8
DISMD9: HRRZ BP,MOREHP ;REDISPLAY ONLY THE --TOP-- OR WHATEVER:
CAML BP,TT ;MUST MOVE HORIZONTALLY TO SKIP THE ..J STRING,
MOVE BP,TT ;BUT NOT SO FA THAT --TOP-- OR WHATEVER WON'T FIT ON THE LINE.
MOVEM BP,MOREHP
HRL BP,USZ
CALL SETCUR
CALL CLREOL
DISMD8:
CALL DPYIVI ; INIT INVERSE VIDEO.
MOVEM T,MORESW
TRZ T,MS%MOD
JUMPE T,DISMD6 ;IF WE ARE SUPPOSED TO HAVE --MORE-- OR SOMETHING, WRITE IT.
SKIPN RGETTY
JRST DISMD6
TLNN T,-1 ;IF % ABOVE SCREEN IN LH IS NONZERO, PRINT THAT.
CAIN T,3 ;IF IN MIDDLE OF BUFFER BUT PERCENT IS 0, PRINT 1%.
JRST DISMD5
CAIL T,5 ;WE SHOULDN'T GET HERE WANTING TO DISPLAY --MORE--FLUSHED!
.VALUE
MOVE Q,DISMD4-1(T)
IFN ITS,HRLI Q,-2
IFN TNX,HRLI Q,-1
CALL DISIOT
DISMD6: MOVE T,MORESW ;PUT A STAR ON THE END, IF MORESW SAYS SO.
TRNN T,MS%MOD
JRST DISMD7
MOVEI CH,40
CALL TYOINV
MOVEI CH,"*
CALL TYOINV
DISMD7:
CALL DPYIVC ;TURN OFF INVERSE VIDEO.
INSIRP POP P,CH BP TT1 TT B A
RET
DISMD4:
IFN ITS,[
[ASCIC *--BOT--*]
[ASCIC *--TOP--*]
0
[ASCIC /--MORE--/]
]
IFN TNX,[
[ASCIZ *--BOT--*]
[ASCIZ *--TOP--*]
0
[ASCIZ /--MORE--/]
]
;OUTPUT --NN%-- WHERE N IS IN LH(T).
DISMD5: DISSTR /--/
CALL DISIOT
HLRZ CH,T
SKIPN CH ;PRINT 01% INSTEAD OF 00%, SINCE 00% WHEN NOT AT TOP
MOVEI CH,1 ;MIGHT BE PARADOXICAL.
IDIVI CH,10.
ADDI CH,"0
CALL TYOINV
MOVEI CH,"0(Q)
CALL TYOINV
DISSTR /%--/
CALL DISIOT
JRST DISMD6
;CLEAR THE --MORE-- LINE.
CLRMOR: SETZM MOREHP
HRLZ BP,USZ
CALL SETCUR
JRST CLREOL
SUBTTL CURSOR CONTROL SUBROUTINES
IFN ITS,[
;SCROLL LINES IN WINDOW FROM BP TO BELOW BOTLIN UP Q LINES.
SCRLUP: CALL SCRLU2
.IOT CHSIO,[%TDRSU]
JRST SCRLU1
;SCROLL LINES IN WINDOW FROM BP TO BELOW BOTLIN DOWN Q LINES.
SCRLDN: CALL SCRLU2
.IOT CHSIO,[%TDRSD]
SCRLU1: SAVE A
MOVE A,BOTLIN
SUB A,BP
.IOT CHSIO,A
.IOT CHSIO,Q
JRST POPAJ
;MOVE CURSOR TO BEGINNING OF LINE WHOSE VPOS IS IN BP. CLOBBERS DISBUF.
SCRLU2: SAVE Q
SAVE BP
HRLZS BP
CALL SETCUR
REST BP
JRST POPQJ
;DELETE # OF LINES IN Q AT VPOS IN BP.
DELLIN: SAVE [%TDDLP]
JRST DELLI1
;INSERT # LINES IN Q AT VPOS IN BP.
INSLIN: SAVE [%TDILP]
DELLI1: SAVE [440800,,DISBF1] ;ACCUMULATE STRING IN DISBF1.
SAVE A
MOVEI A,%TDMV0 ;FIRST A COMAND TO SET DESIRED VPOS, AND HPOS 0.
IDPB A,-1(P)
IDPB BP,-1(P)
SETZ A,
IDPB A,-1(P)
MOVEI A,3 ;IF INSERTING/DELETING 0 LINES, JUST MOVE THE CURSOR.
JUMPE Q,DELLI2 ;DON'T PUT IN A %TDILP OR %TDDLP.
MOVE A,-2(P) ;THEN A COMMAND TO INSERT OR DELETE
IDPB A,-1(P)
IDPB Q,-1(P) ;THE SPECIFIED NUMBER OF LINES.
MOVEI A,5
DELLI2: SAVE Q
MOVE Q,[441000,,DISBF1] ;THEN OUTPUT THE STRING.
SYSCAL SIOT,[%CLIMM,,CHSIO ? Q ? A]
.LOSE %LSFIL
REST Q
REST A
SUB P,[2,,2]
RET
;OUTPUT C(T) CHARS STARTING AT DISBF1, WITH SUPER-IMAGE SIOT.
DISSIOT:MOVE Q,[441000,,DISBF1]
SKIPN RGETTY
MOVE Q,[441000,,DISBUF]
SKIPN RGETTY
SUBI T,4*<DISBUF-DISBF1>
DISLI5: ILDB CH,Q ;SKIP ALL %TDNOP'S AT THE BEGINNING.
CAIN CH,%TDNOP
SOJG T,DISLI5
JUMPE T,CPOPJ ;NO CHARS REALLY NEED TO BE SENT => RETURN.
ADD Q,[100000,,]
MOVEI CH,CHSIO
SKIPN RGETTY ;ON PRINTING TTYS, DON'T USE SUPER-IMAGE MODE.
MOVEI CH,CHTTYO
DISSI1: SYSCAL SIOT,[CH ? Q ? T]
.LOSE %LSFIL
SKIPN RGETTY
RET
MOVE Q,NHLNS
CAML Q,CHCRHP
MOVE Q,CHCRHP
SYSCAL SCPOS,[CH ? BP ? Q]
.LOSE %LSFIL
RET
;MOVE CURSOR AND TELL ITS WHERE IT IS. ON A PRINTING TTY, DON'T ACTUALLY CHANGE
;THE VERTICAL POSITION, IN CASE THE TTY IS A STORAGE TUBE. CLOBBERS BP AND Q.
SETCUR: SKIPE RGETTY
JRST SETCU2
SYSCAL RCPOS,[%CLIMM,,CHTTYO ? %CLOUT,,Q]
.LOSE %LSFIL
HLL BP,Q
SETCU2: CALL SETCU1
HLRZ Q,BP
ANDI BP,-1
SYSCAL SCPOS,[%CLIMM,,CHTTYO ? Q ? BP]
.LOSE %LSFIL
RET
;MOVE CURSOR USING SUPERIMAGE MODE TO POSITION SPECD AS VPOS,,HPOS IN BP.
;CLOBBERS Q.
SETCU1: SAVE BP
SAVE [441000,,DISBF1]
SAVE A
MOVEI A,%TDMV0
IDPB A,-1(P)
HLRZ Q,BP
IDPB Q,-1(P)
IDPB BP,-1(P)
MOVEI A,3
JRST DELLI2
;OUTPUT CHAR IN CH TO ECHO AREA BUT NOT ECHO MODE OUTPUT.
ECHOC0: SYSCAL IOT,[%CLIMM,,CHECHO ? CH ? %CLBIT,,%TJECH]
.LOSE %LSFIL
RET
;OUTPUT CHAR IN CH TO ECHO AREA.
ECHOC1:
ECHOCH: .IOT CHECHO,CH
RET
;OUTPUT CHAR IN CH TO ECHO AREA, PROCESSING ^P.
ECHODP: SYSCAL IOT,[%CLIMM,,CHECHO ? CH ? %CLBIT,,%TJDIS\%TJCTN]
.LOSE %LSFIL
RET
;CRLF IN ECHO AREA.
ECHOCR: .IOT CHECHO,[^M]
RET
;HOME UP ECHO AREA CURSOR.
ECHOHU: SAVE CH
MOVEI CH,^P ;DOESN'T USE DISIOT BECAUSE WE MUST MOVE
CALL ECHODP ;THE ECHO AREA CURSOR, NOT THE M.P. CURSOR.
MOVEI CH,"T
CALL ECHODP
JRST POPCHJ
CLRSCN: HRROI Q,[ASCIC/C/]
JRST DISIOT
HOMCUR: HRROI Q,[ASCIC/T/]
JRST DISIOT
ERSCHR: HRROI Q,[ASCIC/K/]
JRST DISIOT
;INSERT CHARACTERS. THE NUMBER TO INSERT IS IN A.
INSCHR: JUMPE A,CPOPJ
.IOT CHSIO,[%TDICP]
.IOT CHSIO,A
RET
;DELETE CHARACTERS. THE NUMBER TO DELETE IS IN A.
DELCHR: JUMPE A,CPOPJ
.IOT CHSIO,[%TDDCP]
.IOT CHSIO,A
RET
CRIF: HRROI Q,[ASCIC /A/]
JRST DISIOT
CLREOL: HRROI Q,[ASCIC/L/]
DISIOT: .IOT CHDPYO,Q
RET
;IMMEDIATE TYPEOUT, NO HASH-CODING.
TYOINV: .IOT CHTTYO,CH
POPJ P,
; INVERSE VIDEO START.
DPYIVI: SKIPE INVMOD
.IOT CHSIO,[%TDBOW]
RET
; INVERSE VIDEO END.
DPYIVC: SKIPE INVMOD
.IOT CHSIO,[%TDRST]
RET
IFN LINSAV,[
;"SAVE" THE CURRENT LINE (VPOS IN BP) WITH A LABEL.
;TELL THE TERMINAL TO REMEMBER THE CURRENT CONTENTS UNDER THE
;LABEL IN LBLNXT.
SAVLIN: SAVE A ;JUNK, SINCE DELLI2 WANTS TO POP 2 THINGS.
MOVE A,LINEND(BP)
CAIGE A,20 ;DON'T BOTHER SAVING A LINE WITH LITTLE TEXT.
JRST POPAJ
REST A
SAVE DISBF1 ;IF CALLED FROM DISLIN, DON'T CLOBBER BUFFER.
SAVE Q
CALL SAVLI1
REST Q
REST DISBF1
RET
SAVLI1: SAVE A ;PUSH JUNK WORD FOR DELLI2 TO FLUSH.
SAVE BP ;MOVE CURSOR TO THE LINE WE WANT TO SAVE.
HRLZS BP
CALL SETCU1
REST BP
SAVE [441000,,DISBF1]
SAVE A
SAVE HCDS(BP) ;REMEMBER WHAT HASH CODE WENT WITH THE DATA
MOVE A,LBLNXT ;SAVED UNDER THIS LABEL.
REST LBLHCD(A)
MOVEI A,%TDSVL ;PRODUCE THE OUTPUT CODE TO SAVE THE LINE.
IDPB A,-1(P)
MOVEI A,1
IDPB A,-1(P)
LDB A,[.BP 177,LBLNXT]
IDPB A,-1(P)
LDB A,[.BP 177_7,LBLNXT]
IDPB A,-1(P)
AOS LBLNXT ;INCREMENT THE NEXT LABEL, WITH WRAPAROUND.
MOVN A,LBLLIM
ANDCAM A,LBLNXT
MOVEI A,4 ;GO AND OUTPUT 4 CHARS.
JRST DELLI2
;WHEN WE ARE ABOUT TO OUTPUT A LINE,
;SEE IF THE DESIRED CONTENTS ARE SAVED IN THE TERMINAL UNDER A LABEL.
;IF SO, REPLACE THE LINE CONTENTS WITH A COMMAND TO RESTORE THAT LABEL.
;DISBF1 ALREADY CONTAINS THE CURSOR POSITIONING COMMANDS. DON'T CHANGE THEM.
RSTLIN: SAVE A
SAVE B
MOVE A,CHCRHP ;SINCE WE DON'T SAVE LINES LESS THAN 20 CHARS LONG,
CAIGE A,20 ;IF THE NEW LINE IS SHORT, DON'T EVEN LOOK FOR LABEL.
JRST POPBAJ
MOVE A,CHCTHC
MOVN B,LBLLIM
HRLZS B
RSTLI1: CAME A,LBLHCD(B) ;SEARCH HASH CODES ASSOCIATED WITH LABELS
AOBJN B,RSTLI1 ;FOR ONE WHICH MATCHES WHAT WE ARE ABOUT TO WRITE.
JUMPGE B,POPBAJ
ANDI B,-1 ;IF WE FIND ONE, RECORD THAT IT WAS USED TO
MOVEM B,LINLBL(BP) ;OUTPUT THIS LINE,
MOVE A,[441000,,DISBUF]
MOVEM A,CHCTBP ;AND REPLACE THE LINE CONTENTS IN DISBUF
MOVEI A,%TDRSL ;WITH THE COMMAND TO RESTORE THE LABEL.
IDPB A,CHCTBP
MOVEI A,1
IDPB A,CHCTBP
LDB A,[.BP 177,B]
IDPB A,CHCTBP
LDB A,[.BP 177_7,B]
IDPB A,CHCTBP
JRST POPBAJ
];LINSAV
] ;IFN ITS
IFN TNX,[
;FUNDAMENTAL DISPLAY OPERATIONS, ON A TERMINAL-INDEPENDANT BASIS.
IFNDEF DEFOSP,DEFOSP==9600. ;DEFAULT SPEED TO ASSUME FOR PADDING CALCULATIONS.
;THE TTYTYP TABLE TRANSLATES TWENEX TERMINAL TYPE CODES TO TECO INTERNAL TERMINAL TYPES.
;THE TECO INTERNAL TYPE IS WHAT LIVES IN RGETTY. USING FS TTYINIT$ WITH ARG,
;THE USER CAN SET THIS TO ANY DESIRED VALUE.
;Internal types 0 and 1 are for printing ttys and glass ttys.
;Higher type codes are for displays. The index-symbol (such as VT100I)
;has the internal type as its value.
;A name of the terminal type, such as "VT100",
;can be 0 to omit the code for that terminal,
;-1 to assemble the code,
;or the Twenex terminal type number for that terminal.
;These symbols should be assigned in the CONFIG file.
DEFINE DEFTYP TYPE,TABLE,SYMBOL
IFNDEF TYPE,TYPE=-1
IFG TYPE-NTTYPE+1,.ERR TYPE is too large to be a GTTYP index
%%TYPE==%%TYPE+1
IFN TYPE,TABLE
.ELSE PRINTB
SYMBOL==:%%TYPE
IFG TYPE,[
%%TMP==.
LOC TTYTYP+TYPE
%%TYPE
LOC %%TMP
]
TERMIN
NTTYPE==69. ;1+ LARGEST TWENEX TERMINAL TYPE. SIZE OF TTYTYP TABLE
TTYTYP: BLOCK NTTYPE ;INTERNAL TYPE (RGETTY), INDEXED BY GTTYP TYPE
;DEFTYP FILLS IN THE WORDS OF THIS TABLE.
IF2 [
GLASCD TYPE,[
IFG TYPE-NTTYPE+1,.ERR TYPE is too large to be a GTTYP index
LOC TTYTYP+TYPE
1
]
LOC TTYTYP+NTTYPE
]
;DEVICE DEPENDANT ROUTINE DISPATCH TABLE, INDEXED BY RGETTY
TTYTBS: PRINTB
GLASTB
%%TYPE==1
DEFTYP DM2500,DM25TB,DM25I
DEFTYP H1500,HZ15TB,HZ15I
DEFTYP VT52,VT52TB,VT52I
DEFTYP DM1520,DM15TB,DM15I
DEFTYP IMLAC,IMLCTB,IMLCI
DEFTYP VT05,VT05TB,VT05I
DEFTYP TK4025,TK40TB,TK40I
DEFTYP VT61,VT61TB,VT61I
DEFTYP TL4041,TL40TB,TL40I
DEFTYP FOX,FOXTB,FOXI
DEFTYP HP2645,HPTB,HPI
DEFTYP I400,I400TB,I400I
DEFTYP TK4023,TK43TB,TK43I
DEFTYP ANNARB,AATB,AAI
DEFTYP C100,C100TB,C100I
DEFTYP IQ120,IQ12TB,IQ12I
DEFTYP VT100,VT10TB,VT100I
DEFTYP I100,I100TB,I100I
DEFTYP TL1061,TL40TB,TL106I
DEFTYP HEATH,HTHTB,HTHI
DEFTYP VC404,VC44TB,VC44I ;Volker-Craig.
DEFTYP CNCPT,CNCPTB,CNCPI ;CN Railroad Stupid Terminal.
DEFTYP TVI912,TVITB,TVII ;TeleVideo. May be ADM-2.
DEFTYP OWL,OWLTB,OWLI
DEFTYP BANTAM,BANTB,BANTI
DEFTYP DM3045,DM34TB,DM34I
DEFTYP DM3052,DM35TB,DM35I
DEFTYP HMOD1,HZM1TB,HMD1I ;Hazeltine Modular One
DEFTYP H1510,HZ15TB,HZ151I ;Hazeltine 1510 (same for our purposes as 1500).
DEFTYP ADM3A,ADM3TB,ADM3I
DEFTYP VT100V,VT15TB,VT152I ;VT100 IN VT52 MODE
DEFTYP SIMLAC,SIMLTB,SIMLCI ;I.T.S. VIRTUAL DISPLAY TERMINAL.
DEFTYP VT100W,VT1WTB,VT10WI ;VT100 IN VT52 MODE OUTSIDE AND ANSI MODE INSIDE
DEFTYP VT100X,VT1XTB,VT10XI ;VT100 IN ANSI MODE OUTSIDE AND VT52 MODE INSIDE
DEFTYP ADM42,ADM42T,ADM42I ;ADM42 Also good for ADM31.
DEFTYP NIH5200,NH52TB,NH52I ;NIH (Delta Data modified) 5200
DEFTYP V200,V200TB,V200I ;Visual 200
DEFTYP PTV,PTVTB,PTVI ;MIT-Plasma TV system emulating a large VT52
DEFTYP E19,E19TB,E19I ;Edmond's modified H19
DEFTYP VTS,VTSTB,VTSI ;VTS virtual terminal
DEFTYP ACT4,ACT4TB,ACT4I ;ACT-IV terminal.
DEFTYP IM3101,IM31TB,IM31I ;IBM 3101
DEFTYP GILL,GILLTB,GILLI ;Hazeltine w/ John Gill's custom ROM
DEFTYP DM3025,DM32TB,DM32I ;Datamedia 3025
DEFTYP AMBASS,AMBATB,AMBASI ;Ann Arbor Ambassador
DEFTYP MIME2A,MI2ATB,MIM2AI ;Mime2a in VT52 enhanced emulation mode
DEFTYP DG132,DG13TB,DG13I ;Datagraphics 132
DEFTYP IIMLAC,IIMLTB,IIMLCI ;IMLAC WITH FCI USING ITP
DEFTYP BUR80,BUR80T,BUR80I ;Modified version of Burroughs TD850
DEFTYP INTEXT,INTXTB,INTXI ;INtext (modified OWL-1200)
DEFTYP VT132,V132TB,VT132I ;VT132 (just implements char I/D)
DEFTYP ADVPT,ADVPTB,ADVPTI ;ADDS Viewpoint
DEFTYP NH7000,NH70TB,NH70I ;NIH (Delta Data modified) 7000
DEFTYP BEE2,BEE2TB,BEE2I ;MICROBEE 2
DEFTYP GIGI,GIGITB,GIGII
DEFTYP FR100,FREETB,FRDI ;Freedom-100
DEFTYP ESPRIT,ESPRTB,ESPRI ;Hazeltine Esprit
DEFTYP FR200,FRE2TB,FRD2I ;Freedom-200
DEFTYP ANSI,V132TB,ANSIT ;ANSI (is presently a synonym for VT132)
DEFTYP TVI950,TV5TB,TV9I ;TeleVideo (tvi912 -padding +%tolid)
DEFTYP BITGRA,BBNTB,BBNI ;BBN Bitgraph
DEFTYP AJ510,AJ510T,AJ510I ;Anderson Jacobson 510 [Joshua Brodsky @UDC]
DEFTYP AVT,AVTTB,AVTI ;HDS Concept AVT
DEFTYP SUN,SUNTB,SUNI ;SUN workstation with VT100 emulator
DEFTYP AVTX,AVTXTB,AVTXI ;experimental AVT code.
DEFTYP VT102,V132TB,VT102I ;DEC VT102 (is presently a synonym for VT132)
MAXTTY==%%TYPE+1
PRINTB: 377777,,79. ;PRINTING TERMINAL DISPATCH VECTOR
(%TOOVR+%TOMVB+%TOLWR)
REPEAT 22,JFCL
GLASTB: 377777,,79. ;"GLASS TTY" DISPATCH VECTOR
(%TOMVB+%TOLWR)
REPEAT 22,JFCL
;SET CURSOR POSITION TO VPOS,,HPOS IN 2
CURPOS: SETOM ECHOP
CURPS0: SAVE B ;SAVE DESIRED POSITION
CALL CURPS1 ;DO WORK FIRST
REST TTLPOS
RET
CURPS1: SAVE A
JSP A,DDPYTB ;DISPATCH FOR CURSOR POSITIONING
CURPSX: 2(T) ;ENTRY 2 IN DEVICE TABLE
;DISPATCH BY RGETTY INTO TABLE INDEXED BY POINTER AFTER CALLER
DDPYTB: SAVE T
SAVE B
MOVE T,RGETTY ;GET INTERNAL TERMINAL TYPE
MOVE T,TTYTBS(T) ;GET DISPATCH VECTOR
XCT @(A) ;CALL APPROPRIATE ROUTINE
IFN STANSW,CALL %TFLSH ;[wew] DUMP BUFFERED CHARACTERS, IF ANY
REST B
REST T
JRST POPAJ
;CLEAR TO END OF LINE
CLREOL: SAVE A
JSP A,DDPYTB ;DISPATCH FOR CLEAR EOL
3(T) ;ENTRY 3 IN TABLE
;CLEAR TO END OF SCREEN
CLREOS: SAVE A
JSP A,DDPYTB ;DISPATCH FOR CLEAR EOS
4(T) ;ENTRY 4 IN TABLE
;CLEAR SCREEN
CLRSCN: SAVE A
IFN STANSW, CALL XICFIX ;FINISH UP INSERT CHAR OPERATION
SETZM TTLPOS ;SAY WE ARE AT HOME
SETOM ECHOP
MOVE A,ECHOL0 ;FIRST LINE OF ECHO AREA
HRLZM A,ECHOPS ;RESET ECHO POSITION
JSP A,DDPYTB
5(T) ;CLEAR SCREEN ENTRY 5 IN TABLE
;INSERT LINES
INSLIN: SAVE A
JSP A,DDPYTB ;DISPATCH FOR INSERT LINE
11(T) ;ENTRY 11 IN TABLE
;DELETE LINES
DELLIN: SAVE A
JSP A,DDPYTB ;DISPATCH FOR DELETE LINE
12(T) ;ENTRY 12 IN TABLE
;INSERT C(A) CHARACTERS
INSCHR: SAVE Q
MOVE Q,A
CALL INSCH1
JRST POPQJ
;INSERT C(Q) CHARACTERS. CLOBBERS Q.
INSCH1: JUMPE Q,CPOPJ
SAVE A
JSP A,DDPYTB ;DISPATCH FOR INSERT CHAR
13(T) ;ENTRY 13 IN TABLE
;DELETE C(A) CHARACTERS
DELCHR: SAVE Q
IFN STANSW, CALL XICFIX ;FINISH UP INSERT CHAR OPERATION
MOVE Q,A
CALL DELCH1
JRST POPQJ
;DELETE C(Q) CHARACTERS. CLOBBERS Q.
DELCH1: JUMPE Q,CPOPJ
IFN STANSW, CALL XICFIX ;FINISH UP INSERT CHAR OPERATION
SAVE A
JSP A,DDPYTB ;DISPATCH FOR DELETE CHAR
14(T) ;ENTRY 14 IN TABLE
;SET UP DISBF1 TO CLEAR LINE FIRST
DISMOV: SAVE A
JSP A,DDPYTB ;DISPATCH FOR DISMOV
7(T) ;ENTRY 7 IN TABLE
;DONT CLEAR IT, JUST GO THERE
DISMV1: SAVE A
JSP A,DDPYTB ;DISPATCH FOR DISMV1
10(T) ;ENTRY 10 IN TABLE
;TAKE TERMINAL OUT OF DISPLAY MODE, AND CLEAR FUNNY STUFF SUCH AS REVERSE
; VIDEO FROM SCREEN. USED ONLY FOR FAIRLY FINAL EXITS, WHEN THE USER IS
; GOING TO REDISPLAY THE SCREEN IF HE EVER GETS BACK.
DPYRST: SAVE A
JSP A,DDPYTB ;DISPATCH FOR TERMINAL RESET
15(T) ;ENTRY 15 IN TABLE
;TAKE TERMINAL OUT OF DISPLAY MODE TEMPORARILY FOR :ET COMMAND.
DPYRSS: SAVE A
JSP A,DDPYTB ;DISPATCH FOR TERMINAL RESET
21(T) ;ENTRY 21 IN TABLE
;SCROLL LINES IN WINDOW FROM BP TO BELOW BOTLIN UP Q LINES.
SCRLUP: SAVE A
JSP A,DDPYTB
16(T)
;SCROLL LINES IN WINDOW FROM BP TO BELOW BOTLIN DOWN Q LINES.
SCRLDN: SAVE A
JSP A,DDPYTB
17(T)
;INITIALIZE TERMINAL CHARACTERISTICS
DPYINI: SAVE A
JSP A,DDPYTB ;DISPATCH FOR TERMINAL INIT
20(T) ;ENTRY 20 IN TABLE
; INVERSE VIDEO START
DPYIVI: SKIPN INVMOD ; DOES HE WANT INVERSE VIDEO?
RET
SAVE A
JSP A,DDPYTB ; DISPATCH FOR START INVERSE VIDEO CODE
22(T)
; INVERSE VIDEO END.
DPYIVC: SKIPN INVMOD
RET
SAVE A
JSP A,DDPYTB
23(T)
;LOW LEVEL INTERFACES TO DEVICE DEPENDANT ROUTINES
DISSIO: JSR SAVABC ;SAVE ACS
SKIPN RGETTY
JRST [ MOVE B,[441000,,DISBUF]
SUBI T,4*<DISBUF-DISBF1>
JUMPG T,DISSI2
JRST POPCBA]
MOVE B,[441000,,DISBF1]
DISSI2: ILDB CH,B
JUMPN CH,DISSI3 ;FLUSH INITIAL NULLS
SOJG T,DISSI2
JRST DISSI4 ;NOTHING TO DO
DISSI3: MOVEI A,.PRIOU
ADD B,[100000,,0] ;MAKE BYTE POINTER
MOVNI C,(T) ;NUMBER OF CHARACTERS TO OUTPUT
IFN STANSW, CALL XICFIX ;MAYBE INSERT CHARACTER POSITIONS
SOUT
SETOM ECHOP ;NO LONGER IN ECHO AREA IF WE WERE
SKIPN RGETTY ;DONE IF PRINTING
JRST POPCBA
MOVE B,NHLNS
CAML B,CHCRHP
MOVE B,CHCRHP ;UPDATE HORIZONTAL POSITION
HRLI B,(BP)
MOVEM B,TTLPOS ;UPDATE CURSOR POSITION
DISSI4: SKIPN NOCEOL
JRST POPCBA
SKIPGE EOLFLG ;POSTPONED CLEARING NEEDED?
CALL CLREOL ;YES, FAKE IT
JRST POPCBA
;SET CURSOR POS TO VPOS,,HPOS IN BP. CLOBBERS AT MOST Q.
SETCU1::
SETCUR: SKIPN RGETTY ;ON PRINTING TERMINAL
JRST SETCU2 ;USE BS OR SPACE TO DO WHAT WE CAN
SAVE B ;SAVE ACS
MOVE B,BP ;GET DESIRED POSITION
SETCU3: CALL CURPOS ;GO THERE
JRST POPBJ
SETCU2: SAVE A ;HANDLE "CURSOR MOTION" ON PRINTING TTY
TRNN BP,-1 ;MOVE TO START OF LINE?
JRST [MOVEI A,^M ;YES, DO IT FAST
PBOUT
JRST POPAJ]
SAVE B
MOVEI A,.PRIOU
RFPOS ;GET CURRENT POSITION
ANDI B,-1 ;SHOULD ONLY BE ASKED TO HANDLE HORIZ MOTION
SUBI B,(BP) ;GET DIFFERENCE
JUMPE B,POPBAJ ;ALREADY THERE, NOTHING TO DO
MOVEI A,^H ;USE BS IF MOVING LEFT
JUMPL B,[MOVMS B ;BUT IF MOVING RIGHT
MOVEI A,40 ;USE SPACE
JRST .+1]
PBOUT
SOJG B,.-1
JRST POPBAJ
;RETURN CURSOR TO UPPER LEFT CORNER OF SCREEN.
HOMCUR: SAVE B
SETZ B,
CALL CURPOS
JRST POPBJ
;OUTPUT ASCIZ STRING Q POINTS AT.
DISIOT: EXCH A,Q
IFN STANSW, CALL XICFIX ;MAYBE INSERT CHARACTER POSITIONS
PSOUT
EXCH A,Q
RET
;OUTPUT A CHARACTER, PUTTING UPARROW BEFORE CONTROL CHARS AND RUBOUT. FOR THE MODE LINE.
TYOIN1: CAIN CH,ALTMOD
MOVEI CH,"$
CAIE CH,177
CAIGE CH,40 ;IN MODE LINE, IT'S GOOD FOR CR AND LF TO BE PRINTED WITH UPARROWS TOO.
CAIN CH,^I ;BUT NOT TAB, SINCE THAT CAN WORK OK AS A FORMATTER.
JRST TYOINV
SAVE A
MOVEI A,"^
PBOUT
MOVE A,CH
XORI A,100
PBOUT
MOVEI A,2
ADDM A,TTLPOS
JRST POPAJ
;ITS-STYLE ASCII MODE OUTPUT.
TYOINV: SKIPN RGETTY ;SIMPLE ON PRINTING TERMINAL
JRST [ EXCH A,CH
PBOUT
EXCH A,CH
RET ]
SAVE A
SAVE B
CAIN CH,^G
JRST TYOIV2 ;BELL - ZERO WIDTH
MOVEI A,.PRIOU
MOVE B,TTLPOS
CAIN CH,^I
JRST TYOIVT
CAIN CH,^J
ADD B,[1,,0] ;LF - MOVE TO NEXT LINE
CAIN CH,^M
TRZ B,-1 ;CR - MOVE TO START OF LINE
CAIN CH,^H
SOJ B, ;BS - MOVE BACK ONE
CAIL CH,40
AOJ B, ;PRINTING CHAR, COUNT ONE POSITION
MOVEM B,TTLPOS
TYOIV2: MOVE A,RGETTY
CAIE A,IIMLCI
CAIN A,SIMLCI
JRST TYOIVI
TYOIV1:
IFN STANSW,[
SKIPN INSFLG ;ARE WE CURRENTLY IN INSERT MODE?
JRST TYOIV3 ;NO, JUST CONTINUE
CAIGE CH,40 ;IS IT A PRINTING CHARACTER?
JRST [CALL XICFIX ;FIX UP ANY CHARS THAT STILL NEED INSERTING
JRST TYOIV3] ;THEN OUTPUT THE FUNNY CHARACTER
SOSGE A,INSCNT ;UPDATE NUMBER OF CHARS TO BE INSERTED
CALL INSCHR ;IF LESS THAN 0, TAKE US OUT OF INSERT MODE
TYOIV3:
];IFN STANSW
MOVE A,CH
PBOUT
JRST POPBAJ
TYOIVT: ADDI B,10 ;TAB - MOVE TO NEXT TAB STOP.
TRZ B,7 ;USE 8-CHAR TABS FOR THIS
TYOIVP: CALL CURPS0 ;BECAUSE ON ITS WE JUST OUTPUT THE CHAR
JRST POPBAJ ;AND ITS WOULD USE 8-CHAR TAB STOPS.
;TYPEOUT ON FUNNY IMLACS, SOME FORMAT EFFECTORS ARE REALLY PRINTING
TYOIVI: CAIE CH,^M
CAIN CH,^J
JRST TYOIVP ;POSITIONING COMMANDS REALLY
CAIN CH,^H
JRST TYOIVP
CAIE CH,^G
JRST TYOIV1 ;LOOKS SAFE TO JUST TYPE IT OUT
MOVE A,[440800,,[.BYTE 8 ? 177 ? 221-176 ? 0]] ;%TDBEL
TOIVI1: PSOUT
JRST POPBAJ
;GET FRESH LINE
CRIF: SAVE A
SAVE B
IFN STANSW, CALL XICFIX ;MAYBE INSERT CHARACTER POSITIONS
MOVEI A,.PRIOU
RFPOS
HRROI A,[ASCIZ/
/]
TRNE B,-1
PSOUT
JRST POPBAJ
SUBTTL SIMULATE ITS ECHO AND ^P FOR TWENEX
;ECHO CHARACTER IN CH, IN THE ECHO AREA.
ECHOC0: HRROS (P) ;FLAG THAT CR SHOULD COME OUT AS STRAY ONE
CAIA
ECHOCH: HRRZS (P)
SAVE CH
TRZE CH,CONTRL
TRZ CH,100
ANDI CH,177 ;CLEAR OTHER RANDOM BITS
CAIN CH,177 ;RUBOUTS DONT ECHO
JRST POPCHJ
CAIN CH,^J ;LF?
JRST ECHOLF
CAIN CH,^M ;CR?
JRST ECOCR0
CAIN CH,33 ;ESC COMES OUT AS $
MOVEI CH,"$
CAIN CH,^I ;TAB?
JRST ECHOTB
CAIN CH,^H ;BS?
JRST ECHOBS
CAIE CH,^G ;THIS ALWAYS BEEPS
CAIL CH,40 ;CONTROL-MUMBLE?
JRST ECHOC3
MOVEI CH,"^ ;YES, PRINT ^-MUMBLE
CALL ECHOC1
MOVE CH,(P)
TRO CH,100
ECHOC3: CALL ECHOC1 ;PRINT SINGLE CHARACTER
JRST POPCHJ
ECHOLF: SKIPN RGETTY
JRST ECHLF3
ECHLF1: CALL ECHOC2 ;ADVANCE TO NEXT LINE
JRST POPCHJ
ECHLF3: CALL ECHLF2
JRST POPCHJ
ECHLF2: SAVE A
SAVE B
MOVEI A,.PRIOU ;MONITOR WONT LET US TYPE A BARE LF, SO...
IFN 20X,[
RFPOS
SAVE B
TRZ B,-1 ;FIRST PRETEND WE ARE AT THE LEFT MARGIN ALREADY
SFPOS
]
MOVEI B,^J ;THEN TYPE IT
BOUT
IFN 20X,[
RFPOS ;GET LINE IT THINKS THAT PUTS US ON
HLLM B,(P)
REST B ;AND SET UP TO REALLY BE IN MIDDLE OF IT
SFPOS
]
JRST POPBAJ
ECHOCR: HRRZS (P) ;ALWAYS CRLF
SAVE CH
MOVEI CH,^M
ECOCR0: SKIPN RGETTY
JRST [CALL ECHOC1 ;ON PRINTING TTY, JUST TYPE IT
JRST POPCHJ] ;AND RETURN
HLLZS ECHOPS ;GO TO START OF THIS LINE
SKIPGE -1(P) ;OUTPUT STRAY CR?
JRST ECOTB2 ;YES, JUST GO TO START OF LINE THEN
JRST ECHLF1 ;ELSE ADVANCE A LINE AND CLEAR IT
ECHOC1: SKIPE RGETTY
CALL ECOPOS
CALL TYOINV ;DO TYPEOUT WITH SPECIAL CHECKS FOR ^G, ETC. THIS WILL CHANGE TTLPOS
;IN WAYS THAT WE DON'T REALLY CARE ABOUT.
CAIE CH,^G ;THIS HAS NO WIDTH
SKIPN RGETTY
RET
AOS CH,ECHOPS
ANDI CH,-1 ;GET HPOS
CAMGE CH,NHLNS
JRST ECHOC4 ;STILL WITHIN RANGE
HLLZS ECHOPS ;START OF NEW LINE
ECHOC2: HLRZ CH,ECHOPS
AOJ CH,
CAML CH,NVLNS
HRRZ CH,ECHOL0
HRLM CH,ECHOPS
CALL ECOPS0
JRST CLREOL
ECHOC4: MOVE CH,ECHOPS ;MAKE SURE KNOW OUR POSITION RIGHT
MOVEM CH,TTLPOS
RET
ECHOTB: SKIPN RGETTY
JRST ECHOC3
HRRZ CH,ECHOPS
ADDI CH,8
TRZ CH,7
CAML CH,NHLNS
SETZ CH,
HRRM CH,ECHOPS
JUMPE CH,ECHLF1 ;ADVANCE TO NEXT LINE IF WRAP AROUND
ECOTB2: CALL ECOPS0
JRST POPCHJ
ECHOBS: SKIPN RGETTY
JRST ECHOC3
SOS CH,ECHOPS ;DECREMENT POSITION
TRNE CH,400000 ;BUT DON'T WRAP AROUND
AOS ECHOPS
JRST ECOTB2
ECOPS0: SETOM ECHOP ;HERE TO BE SURE WE GO THERE FIRST
ECOPOS: AOSE ECHOP
RET
SAVE A
SAVE B
MOVE B,ECHOPS
CALL CURPS0
JRST POPBAJ
;SIMULATE DISPLAY TYPEOUT IN ECHO AREA (IE INTERPRET ^P CODES)
ECHODP: AOSG ECODPF ;HAD A ^P LAST TIME?
JRST ECODP0 ;YES, OF SOME SORT
CAIE CH,^P ;^P NOW?
JRST ECHOC1 ;NO, JUST OUTPUT THIS CHARACTER.
SETOM ECODPF ;YES, SAY SO FOR NEXT TIME
RET
ECODP0: SAVE C
MOVE C,ECODPF
SETZM ECODPF
AOJLE C,ECODP1 ;^PH OR ^PV?
SKIPGE C,ECODTB-"A(CH)
CALL ECOPOS ;SEE IF WE SHOULD MOVE TO RIGHT SPOT FIRST
CALL (C) ;DISPATCH FOR THIS ONE
JRST POPCJ
ECODP1: AOJLE C,ECODP2 ;FOLLOWING A ^PV?
MOVEI C,-10(CH) ;NO, ^PH. GET DESIRED HPOS
CAMLE C,NHLNS
MOVE C,NHLNS
HRRM C,ECHOPS ;MAKE IT THE "CURRENT ECHO HPOS"
ECODP3: REST C
JRST ECOPS0 ;MOVE THE CURSOR THERE
ECODP2: MOVEI C,-10(CH) ;GET DESIRED VPOS
SETZM ECODPF
CAMGE C,ECHOL0
MOVE C,ECHOL0
CAMLE C,NVLNS
MOVE C,NVLNS ;GET IT IN RANGE
HRLM C,ECHOPS ;MAKE IT CURRENT POS AND GO THERE.
JRST ECODP3
ECODTB: ECODPA ;A - ADVANCE TO FRESH LINE
ECODPB ;B - MOVE BACKWARD
ECODPC ;C - CLEAR ECHO AREA
ECHOC2 ;D - MOVEM DOWN
-1,,CLREOS ;E - CLEAR TO END OF SCREEN
ECODF0 ;F - MOVE FORWARD
CPOPJ ;G
ECODPH ;H - SET HORIZONTAL POSITION
CPOPJ ;I
CPOPJ ;J
-1,,ECODPK ;K - ERASE CURRENT CHARACTER POSITION
-1,,CLREOL ;L - CLEAR TO END OF LINE
CPOPJ ;M - MORE - SHOULNDT BE DOING THAT, RIGHT?
CPOPJ ;N - DITTO
CPOPJ ;O
ECODPP ;P - OUTPUT ^P
ECODPQ ;Q - OUTPUT ^C
[MOVE C,ECODPS ? MOVEM C,ECHOPS ? JRST ECOPS0] ;R - RESTORE POSITION
[MOVE C,ECHOPS ? MOVEM C,ECODPS ? RET] ;S - SAVE POSITION
ECODPT ;T - GO TO TOP OF ECHO AREA
ECODPU ;U - MOVE UP
ECODPV ;V - SET VERTICAL POSITION
CPOPJ ;W
ECODPX ;X - BACKSPACE AND ERASE CHARACTER
CPOPJ ;Y
ECODPZ ;Z - HOME DOWN
-1,,INSLIN ;[ INSERT LINE
-1,,DELLIN ;\ DELETE LINE
-1,,CLREOL ;] SAME AS ^PL
-1,,INSCHR ;^ INSERT CHARACTER
-1,,DELCHR ;_ DELETE CHARACTER
ECODPA: MOVE C,ECHOPS ;^PA - MOVE TO FRESH LINE
TRNN C,-1 ;AT START OF A LINE NOW?
RET ;YES
JRST ECHOCR ;NO, TYPE CRLF
ECODPB: HRRZ C,ECHOPS ;^PB - MOVE BACKWARD
SOJL C,ECODB2
ECODB1: HRRM C,ECHOPS ;STILL WITHIN RANGE, GO THERE
JRST ECOPS0
ECODB2: MOVE C,NHLNS ;MOVE TO LAST LINE - 2
SUBI C,2
HRRM C,ECHOPS
JRST ECODPU ;AND UP A LINE
ECODPC: SKIPN RGETTY ;^PC - CLEAR ECHO AREA
JRST ECHOCR ;TYPE CRLF ON PRINTING TERMINAL
CALL ECODPT ;MOVE TO TOP OF ECHO AREA
JRST CLREOS ;AND CLEAR TO END OF SCREEN
ECODF0: HRRZ C,ECHOPS ;^PF - MOVE FORWARD
AOJ C,
CAMLE C,NHLNS
SETZ C, ;WRAP AROUND ON THE SAME LINE
JRST ECODB1 ;GO THERE
ECODPH: SKIPA C,[-2] ;^PH - SET HORIZONTAL POSITION
ECODPV: MOVNI C,3 ;^PV - SET VERTICAL POSITION
MOVEM C,ECODPF
RET
ERSCHR:
ECODPK:
IFN PTV\IMLAC\SIMLAC\IIMLAC\VTS,MOVE A,RGETTY
IFN PTV,[
CAIN A,PTVI ;Plasma TV?
JRST [ HRROI A,[.BYTE 7 ? 33 ? "E] ;Yes, it needs this for
JRST ECODK0 ] ; erase char (BS will overwrite)
]
IFN IMLAC\SIMLAC\IIMLAC,[
CAIN A,IIMLCI
JRST .+3
CAIE A,IMLCI ;BS OVERWRITES ON IMLAX
CAIN A,SIMLCI
JRST [ HRROI A,[.BYTE 7 ? 177 ? 204-176 ? 0]
JRST ECODK0]
]
IFN VTS,[
CAIN A,VTSI ;VTS virtual terminal?
JRST [ HRROI A,[.BYTE 7 ? ^P ? "K ] ;Yes, let monitor decide
JRST ECODK0 ]
]
HRROI A,[.BYTE 7 ? 40 ? 10 ? 0] ;^PK - ERASE CURRENT CHAR
ECODK0: PSOUT
RET
ECODPP: SKIPA CH,[^P] ;^PP - TYPE ^P
ECODPQ: MOVEI CH,^C ;^PQ - TYPE ^C
JRST ECHOC1 ;JUST TYPE IT OUT
ECODPZ: MOVE C,NVLNS ;^PZ - HOME DOWN
SOSA C ;NUMBER OF LINES -1
ECODPT: MOVE C,ECHOL0 ;^PT MOVE TO TOP
HRLZM C,ECHOPS
JRST ECOPS0 ;GO THERE
ECHOHU: MOVE Q,ECHOL0 ;HOME UP ECHO AREA CURSOR
HRLZM Q,ECHOPS ;BUT DON'T ACTUALLY MOVE THERE NOW.
RET
ECODU2: SKIPA C,NVLNS ;GO TO BOTTOM LINE
ECODPU: HLRZ C,ECHOPS ;^PU - MOVE UP
SOJL C,ECODU2 ;STILL IN RANGE?
HRLM C,ECHOPS
JRST ECOPS0 ;YES, GO THERE
ECODPX: MOVE C,ECHOPS ;^PX ERASE LAST CHARACTER
TRNN C,-1 ;AT START OF LINE?
JRST ECODX2
CALL ECOPOS
SOJ C,
MOVEM C,ECHOPS
MOVEI CH,^H
CALL TYOINV
JRST ECODPK
ECODX2: HRR C,NHLNS
SUB C,[1,,2]
MOVEM C,ECHOPS
CALL ECOPS0 ;MOVE TO LAST COL -2 OF LAST LINE
JRST CLREOL ;AND CLEAR TO END
;;; "TERMCAP" FILE FOR VARIOUS TERMINALS NOW IN SEPARATE FILE FOR
;;; EASE OF EDITING AND CONSERVATION OF EDITING SPACE...
.INSRT TECTRM.MID ;GET TERMINAL HANDLERS
];IFN TNX
SUBTTL INTERRUPT HANDLERS
IFN ITS,[
TSINTP: MOVEM 16,INTACS+16 ;SAVE ALL ACS.
MOVEI 16,INTACS
BLT 16,INTACS+15
MOVE C,TSINT
TSIL: HRRZ A,TSINT+1 ;GET THE PC IN CASE THE INTERRUPT ROUTINE WANTS TO CHECK IT FOR TYIIOT
JUMPL C,TSIN2 ;INT IN SECOND WORD
TLZE C,%PJATY
JRST TSINTA
TLZE C,%PJRLT
JRST TSINTC
TLZE C,%PJWRO
TYPRE [PUR]
TRZE C,%PIMPV ;MPV => CREATE THE NONEXISTENT CORE AND RETRY.
JRST TSINT4
TRZE C,%PIPDL
TYPRE [PDL]
TSIN2A: MOVSI 16,INTACS
BLT 16,16
.SUSET [.SJPC,,INTJPC]
.DISMI TSINT+1
TSINTA: CAIN A,RRECI7 ;TTY GIVEN BACK TO TECO INTERRUPT.
AOS TSINT+1 ;IF INSIDE AN ECHOIN, FINISH IT NOW, SO WE CAN CLEAR THE SCREEN.
SKIPE RGETTY
SKIPL CLRMOD ;THIS FEATURE CAN BE DISABLED FOR DEBUGGING.
JRST TSIL
SETOM PJATY ;SAY THAT WE SHOULD CLEAR THE SCREEN AND REDISPLAY COMPLETELY.
SETOM DISOMD
JRST TSIL
TSINTC: SETOM CLKFLG ;REAL-TIME CLOCK INTERRUPT. SAY IT'S TIME TO RUN THE HANDLER.
CAIN A,RRECI7 ;IF IN MIDDLE OF AN ECHOIN, RETURN FROM IT.
AOS TSINT+1 ;THEN ^R WILL CALL TYI AND THAT WILL RUN THE HANDLER.
CAIE A,TYIIOT ;IF WE ARE NOW WAITING FOR INPUT, RUN IT RIGHT AWAY,
JRST TSIL
MOVEI A,TSINTD
MOVEM A,TSINT+1 ;BUT FIRST EXIT FROM INTERRUPT LEVEL AND RESTORE ACS.
JRST TSIL
TSINTD: CALL RLTCLK
JRST TYIIOT
TSINT4: SOS TSINT+1
CAIL A,HUSED ;MPV INT: CATCH JUMPS TO RANDOMNESS.
.VALUE
CAIN A,QLGET3+1 ;IF DECODING A STRING POINTER, GIVE PROPER ERROR.
TYPRE [QNS]
.SUSET [.RMPVA,,C] ;GET ADR START OF MISSING PAGE.
LSH C,-12
CAIN A,EJCMD4
JRST TSIN4A
MOVE B,C
IMULI B,2000*5
CAMGE B,QRWRT ;ALL OF IMPURE STRING SPACE MARKED AS EXISTING SHOULD
.VALUE ;REALLY EXIST, OR THERE'S A BUG.
TSIN4A: MOVE A,C
SKIPN GCPTR ;NORMALLY, DON'T ALLOW USE OF LAST PAGE BLW PURE SPACE
AOS A ;BUT ALLOW GC TO USE IT FOR RELOCATION DATA.
CAML A,LHIPAG
TYPRE [URK]
SYSCAL CORBLK,[%CLIMM,,%CBWRT ? %CLIMM,,%JSELF ? C ? %CLIMM,,%JSNEW]
.LOSE %LSSYS
MOVEI A,1(C)
CAMLE A,MEMT ;IF THIS PAGE IS ABOVE ALL OTHERS, ADJUST MEMT.
MOVEM A,MEMT
JRST TSIL
TSINT6: SKIPE DISPRR ;HANDLE INTERRUPT FROM ALTMODE
JRST TSIL ;DO NOTHING IF INSIDE ^R.
SETCMM TSINAL ;REMEMBER PARITY OF ALTMODES,
SKIPN TSINAL ;IF SECOND, STOP DISPLAYING BUFFER.
JRST [ AOS TSALTC ;COUNT NUMBER OF $$ PAIRS SEEN.
JRST TSIL]
CALL TTYAC2 ;IF FIRST ALTMODE, SAY THAT NEXT CHARACTER MUST INTERRUPT
JRST TSIL ;SO WE CAN TELL AT INT. LEVEL. WHETHER THIS IS A $$ PAIR.
TSIN2: TRZN C,TYPIN ;SECOND WORD INTERRUPT. IS IT TYPE-IN?
JRST TSIN2A ;THAT'S ALL THERE IS.
TSINT1: MOVEI A,CHTTYI
.ITYIC A,
JRST TSIL
HRRZ CH,TSINT+1
CAIN CH,ASLEE2 ;IF M.P. IS INSIDE A :^S, WAKE IT UP
AOS TSINT+1 ;(IT HAS ARRANGED FOR ALL CHARS TO INTERRUPT)
TRZ A,SHIFT+SHIFTL
HRRZ CH,A
ANDI CH,177
CAIN CH,33 ;ALTMODE => MUST SEE IF FOLLOWING CHAR IS AN ALTMODE.
JRST TSINT6
SETZM TSINAL ;ELSE TELL NEXT CHAR (IF ALTMODE) THAT PREV. CHAR. WASN'T ONE.
CAIE A,^G
CAIN A,CONTRL+"G
JRST TSINT3 ;NOW CHECK FOR ALL FORMS OF ^G.
CAIE A,CONTRL+"G+40
JRST TSIL
TSINT3: TLNN FF,FLNOIN ;UNLESS IT IS JUST DISPLAYING, ...
SKIPE RREBEG ;DONT SET IF IN A ^R
SETOM STOPF
MOVEI CH,CONTRL+"G
CALL TYI4 ;PUT THE ^G IN THE TYPE-IN RING BUFFER.
HRRZ A,TSINT+1
SKIPE JRNOUT
SKIPGE NOQUIT ;IF NOQUIT NEGATIVE (CAUSE ERROR), DON'T RECORD THE
JRST TSINT2 ;QUIT: IT IS UP TO THE ONE HANDLING THE ERROR TO DO THAT.
CAIN A,TYIIOT ;IF WAITING FOR INPUT, REPRESENT IT AS ":^G" IN THE JOURNAL
.IOT CHJRNO,[":] ;WHICH MEANS NO NEED FOR HAIR WHEN WE REPLAY.
.IOT CHJRNO,[^G] ;IF ASYNCHRONOUS, REPRESENT AS JUST ^G.
TSINT2: SKIPE JRNINH
JRST TSINT8
SKIPE JRNIN ;STOP REPLAYING AN INPUT JOURNAL FILE.
.CLOSE CHJRNI,
SETZM JRNIN
TSINT8: SKIPLE CH,NOQUIT ;THAT'S ALL, IF NO QUITTING RIGHT NOW.
JRST TSIL
CAIN A,RRECI7 ;DON'T RETURN TO AN ECHOIN SYSTEM CALL.
AOS A,TSINT+1
AOJL CH,TSINT5 ;-2FSNOQUIT$ => DON'T FLUSH INPUT & OUTPUT.
SKIPE RGETTY
JRST TSINT7 ;ON DISPLAYS, CAN'T .RESET MAIN OUTPUT SINCE COULD LOSE TRACK OF SCREEN
HLRZ CH,(A)
ANDI CH,777740
CAIN A,DISSI1
AOSA A,TSINT+1
CAIN CH,(.IOT CHDPYO,) ;ON PRINTING TTY DON'T RETURN TO HUNG OUTPUT .IOT
AOS A,TSINT+1
.RESET CHDPYO,
.RESET CHTTYO,
TSINT7: .RESET CHTTYI,
SETOM UNRCHC
SETZM TYISRC ;FLUSH ANY EXECUTING KBD MACRO.
SKIPE TYISNK
HRRZM P,MODCHG ;MAKE MODE LINE RECOMPUTE SO IT WON'T SAY WE ARE DEFINING.
SETZM TYISNK ;FLUSH DEFINING A KBD MACRO.
MOVE CH,QRB.. ;STUFF ON SCREEN CAN GO AWAY.
SETZM .QVWFL(CH)
MOVEI CH,TYI
CAIN A,TYIIOT
MOVEM CH,TSINT+1
MOVEI CH,CONTRL+"G ;IF NOW INSIDE ^R, STICK A ^G IN AS INPUT
SKIPN RREBEG ;INSTEAD OF SETTING STOPF (WHICH WE AVOIDED DOING).
MOVEM CH,UNRCHC
SKIPE RREBEG
SETOM ORESET ;SIGNAL TYPEOUT ROUTINES TO STOP TYPING
TSINT5: SKIPN RREBEG
JRST TSIL
CAIE A,TYIIOT
SKIPE IMQUIT
CALL QUIT0 ;QUIT, ERR, OR DO NOTHING ACCORDING TO NOQUIT.
JRST TSIL
]
IFN TNX,[
;^G INTERRUPT COMES HERE
TSINT: MOVEM 16,INTACS+16 ;SAVE ACS
MOVEI 16,INTACS
BLT 16,INTACS+15
TSINT3: TLNN FF,FLNOIN
SKIPE RREBEG ;SET STOPF, UNLESS INSIDE ^R (@V DOESN7T COUNT AS ^R).
SETOM STOPF
IFN COMNDF,[
HRRZ A,INTPC1
CAIN A,CFMPC
JRST [ HRRZ A,INTACS+D ;DON'T LEAVE AROUND STRAY JFNS
RLJFN
JFCL
JRST .+1]
];COMNDF
IFN TEXTIF,[
CAIN A,RRECI7 ;[wew] CAUSE TEXTI TO RETURN IMMEDIATELY
CALL XTXTI1
];TEXTIF
SKIPE B,SAVMOD ;RESTORE TTY MODE REQUESTED?
CALL FFRRT2 ;YES, DO IT THEN
MOVEI CH,CONTRL+"G
CALL TYI4 ;PUT THE ^G IN THE TYPE-IN RING BUFFER.
SKIPN JRNOUT
JRST TSINT6
MOVE A,JRNOUT ;WRITE A ^G TO A JOURNAL FILE BEING WRITTEN.
HRRZ C,INTPC1
IFN 20X\FNX,[
IFN TEXTIF, CAIE C,RRECI7+1 ;[wew] WILL HAVE BEEN UPDATED BY XTXTI1
CAIN C,VTSIOT ;RECOGNIZE OTHER POSSIBILITY FOR TYPEIN
MOVEI C,TYIIOT
];IFN 20X\FNX
CAIE C,TYIIOT ;IF ^G TYPED WHILE NOT WAITING FOR INPUT
SKIPL NOQUIT ;AND NOQUIT NEGATIVE (CAUSE ERROR), DON'T RECORD THE
CAIA ;QUIT: IT IS UP TO THE ONE HANDLING THE ERROR TO DO THAT.
JRST TSINT6
MOVEI B,":
CAIN C,TYIIOT
BOUT ;IF WE WERE WAITING FOR INPUT, PUT ":^G" IN JOURNAL FILE.
MOVEI B,^G ;OTHERWISE PUT JUST "^G" IN JOURNAL FILE.
BOUT
TSINT6: SKIPN JRNINH
SKIPN JRNIN ;IF REPLAYING A JOURNAL, STOP.
JRST TSINT7
CLOSEF JRNIN
TSINT7: SKIPLE B,NOQUIT ;QUIT NOT ALLOWED?
JRST TSIL ;YES, RETURN RIGHT AWAY
MOVEI CH,CONTRL+"G
AOJL B,TSINT5 ;WANTS CLEAR INPUT?
MOVEI A,.PRIIN ;YES
IFN TEXTIF,[
HRRZ C,INTPC1
CAIE C,RRECI7+1 ;[wew] DON'T FLUSH CHARS WAITING FOR TEXTI
];TEXTIF
CFIBF
SETOM UNRCHC ;NOTHING WAITING
SETZM TYISRC
SKIPE TYISNK
HRRZM P,MODCHG ;MAKE MODE LINE RECOMPUTE SO IT WON'T SAY WE ARE DEFINING.
SETZM TYISNK
MOVE A,QRB.. ;STUFF ON SCREEN CAN GO AWAY.
SETZM .QVWFL(A)
SKIPE RREBEG
SETOM ORESET
SKIPN RREBEG ;IF FROM ^R, ...
TSINT5: MOVEM CH,UNRCHC ;PRETEND TO READ IT RATHER THAN SETTING STOPF
HRRZ A,INTPC1
MOVEI CH,TYI
IFN 20X\FNX,[
CAIN A,VTSIOT
JRST [ ADJSP P,-2 .SEE VTSIO1
MOVEI A,TYIIOT
JRST .+2]
]
CAIN A,TYIIOT
MOVEM CH,INTPC1 ;DONT GET HUNG UP ON READING FROM TTY
SKIPN RREBEG ;RETURN IF FROM ^R
JRST TSIL
CAIE A,TYIIOT
SKIPE IMQUIT
CALL QUIT0 ;QUIT IF REQUESTED
TSIL: MOVSI 16,INTACS ;RETURN
BLT 16,16
DEBRK
NXPINT: MOVEM 16,INTACS+16
MOVEI 16,INTACS
BLT 16,INTACS+15
HRRZ A,INTPC1
CAIE A,QLGET3
CAIN A,QLGET3+1 ;IF MPV HAPPENS TRYING TO LOOK AT A STRING POINTER,
TYPRE [QNS] ;GIVE "QREG NOT STRING" ERROR, NOT "URK".
MOVEI 1,.FHSLF
GTRPW
HRRZS B,A ;GET WORD THAT GOT PAGE FAULT
LSH A,-12
IMULI B,5
CAMGE B,QRWRT
.VALUE
SKIPN GCPTR ;NORMALLY, REQUIRE ONE PAGE OF GAP BELOW PURE STRING SPACE,
AOS A ;BUT ALLOW GC TO USE THAT SPACE FOR ITS RELOCATION DATA.
CAML A,LHIPAG
TYPRE [URK]
SKIPE GCPTR ;DO THE AOS NOW IF WE DIDN'T BEFORE.
AOS A
CAMLE A,MEMT ;IF THIS PAGE IS ABOVE ALL OTHERS, ADJUST MEMT.
MOVEM A,MEMT
JRST TSIL
CNTRLC: MOVEM 16,INTACS+16
MOVEI 16,INTACS
BLT 16,INTACS+15
IFN TEXTIF,[
HRRZ A,INTPC
CAIN A,RRECI7 ;[wew] WAITING FOR INPUT?
CALL XTXTI ;[wew] READ IN WAITING CHARACTERS
];IFN TEXTIF
MOVEI CH,^C
CALL ECHOCH
HRRZ A,INTPC
CAIN A,WAITX ;RUNNING AN INFERIOR?
JRST [ MOVEM A,INTPC ;FORCE JSYS RETURN
MOVE A,INTACS+A ;GET FORK HANDLE
FFORK ;FREEZE IT
JRST TSIL] ;DEBRK TO PROCESS TERMINATION CODE
CALL .EXIT ;OTHERWISE EXIT TO EXEC
JRST TSIL
IFN EXITCL,[
.EXIT1:
IFN DREA,TRNN FF,FRUPRW ;DON'T CLEAR IF @ MODIFIER IS SET
CALL CLRSCN
JRST DPYRST
];EXITCL
.ELSE .EXIT1==DPYRST
.EXIT: SKIPN SAVMOD ;UNLESS FROM INSIDE GTJFN
CALL .EXIT1 ;TAKE TERMINAL OUT OF DISPLAY MODE
MOVEI A,.CTTRM ;TENEX EXEC DOESNT KNOW ALWAYS KNOW
RFMOD
IFN 20X,[SKIPE PAGMOD ;WAS PAGE MODE IN EFFECT?
TROE B,TT%PGM ;YES, IS IT NOW?
CAIA
STPAR
IFN TEXTIF,[ ;[wew] IF TEXTI CODE WAS INCLUDED, MUST
PUSH P,C ;[wew] SET THE PAGE WIDTH BACK TO WHAT
MOVE C,ORGWID ;[wew] IT USED TO BE.
MOVEI B,.MOSLW
MTOPR
POP P,C
];IFN TEXTIF
];20X
IFN 20X\SUMTTF,[
IFE STANSW,[
MOVE B,TTLPOS ;LET MONITOR KNOW WHERE WE ARE ON THE LINE
];IFE STANSW
IFN STANSW,[
HRRZ B,TTLPOS ;AT STANFORD, FORGET LINE NUMBER
];IFN STANSW
MOVE CH,RGETTY
CAIE CH,VTSI
SFPOS
];20X\SUMTTF
IFN 10X\FNX,[
IFE SUMTTF,[
CALL ECHOCR ;CANNOT TELL MONITOR POSITION, SO GO TO BOL
TRON B,100 ;ABOUT RESTORING ASCII DATA MODE
SFMOD
];SUMTTF
IFN SUMTTF,[
MOVE A,HLDCHR
STCHA
];SUMTTF
MOVEI A,.FHJOB
SETO B, ;AND JOB TERMINAL INTERRUPT MASK
STIW
]
MOVEI B,BEG .SEE CIRC
HALTF ;STOP HERE
PUSHJ P,DPYINI ;RE-INIT TERMINAL
PAGON: SKIPGE CLRMOD
SETOM PJATY ;MUST ASSUME WE MESSED UP THE SCREEN
IFN 20X,[
IFE TEXTIF,[ ;[wew] MUST RESET FIELD WIDTH IF TEXTIF
SKIPGE PAGMOD ;IF NOT MESSING WITH PAGE MODE
JRST DOSTIW
];TEXTIF
];20X
MOVEI A,.CTTRM
RFMOD
IFN 20X,[
LDB C,[.BP TT%PGM,B]
MOVEM C,PAGMOD ;SAVE CURRENT PAGE MODE SETTING FIRST
];20X
MOVEI C,TT%PGM ;MAKE SURE PAGE MODE TURNED OFF
SKIPE SAVMOD
JRST PAGON1 ;FROM INSIDE GTJFN, JUST AFFECT PAGE MODE
SKIPE CH,RGETTY ;RESET MODES
CAIN CH,VTSI ;IF VTS OR PRINTING,
SKIPA ;NO BINARY MODE CHANGES
TRO C,TT%DAM
PAGON1:
IFE TEXTIF, TRZN B,(C) ;[wew] OLD CODE
IFN TEXTIF, TRZA B,(C) ;[wew] ALWAYS DO STPAR TO RESET FIELD WIDTH
JRST DOSTIW
SFMOD
IFN TEXTIF, TLZ B,177 ;[wew] SET TERMINAL WIDTH TO 0 TO PREVENT WRAP
STPAR
IFN SUMTTF,[
SETZ A,
STCHA
SKIPE A
MOVEM A,HLDCHR
];SUMTTF
DOSTIW: MOVEI A,.FHSLF
RPCAP
JUMPGE C,CPOPJ ;NO ^C CAPABILITY
MOVEI A,.FHJOB ;RESTORE INTERRUPT MASKS
IFN 10X\FNX,TLO A,400000
MOVE B,[042000,,000060] ;^C & ^G
MOVE C,RRMACT+CONTRL+"T ;IF ^T NOT ASSIGNED AS COMMAND
CAIN C,RRUNDF
TRO B,100000 ;ALLOW IT AS INTERRUPT TO SYSTEM
MOVSI C,040000 ;^C DEFERRED
STIW
RET
LEVTAB: INTPC
INTPC1
INTPC2
CHNTAB: 2,,TSINT ;^G
IFN 20X,3,,ASLEE2 ;ANYTHING TO WAKE FROM :^S
.ELSE 0
1,,CNTRLC ;CONTROL-C INTERRUPT
IFN 20X,3,,TSINTC ;CLOCK INTERRUPT
BLOCK .ICPOV-<.-CHNTAB>
1,,[CIS ? TYPRE [PDL] ] ;PUSHDOWN OVERFLOW
BLOCK .ICTOD-<.-CHNTAB>
IFN 10X\FNX,3,,TSINTC ;10X IIT INTERRUPT
BLOCK .ICNXP-<.-CHNTAB>
2,,NXPINT ;NEW PAGE CREATED
BLOCK 36.-<.-CHNTAB>
];END IFN TNX
SUBTTL BIGPRINTING
.FNPNT:
IFN ITS,[SYSCAL RFDATE,[%CLIMM,,CHFILI ? %CLOUT,,PTLFCD]
SETOM PTLFCD
]
MOVEI A,PPA
HRRM A,LISTF5
PUSHJ P,.+1 ;PRINT THE BIGPRINT TWICE.
IFN ITS,[
MOVSI E,INFILE
.BPNT: SAVE E
MOVE CH,[LFN"NAMFLG 1]
CALL .FNPT2
REST E
MOVE CH,[LFN"NAMFLG 2]
CALL .FNPT2
]
.ELSE,[
MOVEI A,ERDEV+DEFFN1-DEFDEV ;FN1
CALL .FNPT2
MOVEI A,ERDEV+DEFFN2-DEFDEV ;FN2
CALL .FNPT2
]
JRST FORMF
;BIGPRINT THE FILENAME WHOSE ADDRESS IS IN A
.FNPT2:
IFN ITS,CALL FSRFNC
IFN ITS,MOVEI A,TMPFIL
IFN TNX,MOVE C,A
CALL .ST26B
PUSH P,A
TRNN FF,FRARG
PUSHJ P,PTLAB
.FN3: MOVE A,(P)
MOVEI C,4
PUSHJ P,CRR1
SOJN C,.-1
MOVEI TT1,7
.FN239: MOVEI J,3
.FN249: SETZM B
ROTC A,6
MOVEI T,3
.FN259: XCT LDBT1-1(T)
IMULI B,10101
SETZM E
TRNE TT,2
HRLM B,E
CAIG T,1
JRST .FN269
TRNE TT,1
HRRM B,E
.FN269: PUSHJ P,[JUMPN A,TYPR
CAIE T,1 ;DON'T PRINT TRAILING SPACES.
JRST TYPR
JRST SIXNTY]
IDIVI B,10101
SOJN T,.FN259
JUMPE A,.FN279
MOVEI CH,40
REPEAT 3,PUSHJ P,PPA
JRST .FN249
.FN279: MOVE A,(P)
PUSHJ P,CRR1
SOJN J,.FN249
SOJN TT1,.FN239
JRST POPAJ
IFN ITS,[
PTLAB: PUSHJ P,CRR1
MOVSI CH,(LFN"DEVFLG) ;OUTPUT DEVICE NAME
MOVSI E,DEFFIL
CALL FSRFNC
MOVEI A,TMPFIL
CALL ASCIND
MOVEI CH,(LFN"DIRFLG) ;AND THE SNAME
MOVSI E,DEFFIL
CALL FSRFNC
MOVEI A,TMPFIL
CALL ASCIND
CALL LISTF4
.SUSET [.RUNAM,,E]
PUSHJ P,TYPR
PUSHJ P,LISTF4
PUSHJ P,GDATIM ;GET DATE AND TIME
POPJ P, ;SYSTEM DOESN'T HAVE THEM, QUIT HERE
PUSHJ P,GLPDTM ;WIN, ALSO GET CRUD FOR PHASE OF MOON
MOVE E,TIME ;GET TIME FOR PRINTING OUT
DPB E,[301400,,CTIME+1]
LSH E,-14
DPB E,[61400,,CTIME]
LSH E,-14
DPB E,[301400,,CTIME]
MOVE E,CTIME
PUSHJ P,TYPR
MOVE E,CTIME+1
PUSHJ P,SIXNTY
PUSHJ P,LISTF4
PUSHJ P,SYMDAT ;TYPE OUT DATE
PUSHJ P,LISTF4 ;TYPE ANOTHER TAB
PUSHJ P,POM ;PUSH OUT PHASE OF MOON
SKIPG PTLFCD
POPJ P,
PUSHJ P,LISTF4
MOVEI A,[ASCIZ \CREATED \]
PUSHJ P,ASCIND
PTLAB9: MOVEI A,"0
HRRM A,DPT5
TLZ FF,FLNEG
IRPS Q,R,[270400/220500/330700]
LDB C,[Q,,PTLFCD]
MOVEI TT,1
PUSHJ P,DPT1
IFSE R,/,[ MOVEI CH,"/
PUSHJ P,@LISTF5
]
TERMIN
CALL SPSP
HRRZ A,PTLFCD
LSH A,-1
IRPS Q,R,[6:6:0]
IDIVI A,12
PUSH P,B
IFN Q,[ IDIVI A,Q
PUSH P,B
PUSH P,["R-"0]
]
.ELSE PUSH P,A
TERMIN
MOVEI IN,10
PTLAB3: POP P,CH
ADDI CH,"0
PUSHJ P,@LISTF5
SOJG IN,PTLAB3
POPJ P,
]
IFN TNX,[
PTLAB: PUSHJ P,CRR1
MOVEI A,ERDEV
CALL ASCIND
MOVEI CH,": ;DEVICE:
XCT LISTF5
MOVEI CH,"<
XCT LISTF5
MOVEI A,ERDEV+DEFDIR-DEFDEV
CALL ASCIND ;DIRECTORY
MOVEI CH,">
XCT LISTF5
CALL LISTF4 ;TYPE TAB
GJINF
MOVEI B,(A) ;LOGIN DIRECTORY
HRROI A,BAKTAB
DIRST
SETZM BAKTAB
MOVEI A,BAKTAB
CALL ASCIND
CALL LISTF4
HRROI A,BAKTAB
SETOB B,C
ODTIM
MOVEI A,BAKTAB
CALL ASCIND
CALL LISTF4
CALL POM ;INSERT PHASE OF MOON
SKIPG PTLFCD
RET
CALL LISTF4
MOVEI A,[ASCIZ /Last written /]
CALL ASCIND
MOVE A,CHFILI
IFN 20X,[
MOVEI B,B
MOVEI C,1
RFTAD
]
.ELSE [
MOVE B,[1,,.FBWRT]
MOVEI C,B
GTFDB
]
HRROI A,BAKTAB
SETZ C,
ODTIM
MOVEI A,BAKTAB
JRST ASCIND
]
.ST26B: SETZ A,
MOVE OUT,[440600,,A]
MOVEI IN,6
HRLI C,440700
.ST26C: ILDB CH,C
JUMPE CH,CPOPJ
SUBI CH,40
IDPB CH,OUT
SOJG IN,.ST26C
RET
IFN ITS,[
AOFDIR: MOVE D,[440700,,[ASCIZ /.FILE. (DIR)/]]
CALL FFMRG
SYSCAL SOPEN,[[.BAI,,CHRAND] ? [440700,,TMPFIL]]
JRST OPNER1
POPJ P,
GFDBLK: MOVE CH,[440700,,FDRBUF]
MOVEM CH,FDRP
HRLI CH,-FDRBFL
SKIPN NOQUIT
SKIPL STOPF ;CHECK FOR QUIT; IF SO, PLAY LIKE EOF
.IOT CHRAND,CH
HRLI CH,EOFCHR_<18.-7>
HLLZM CH,(CH)
POPJ P,
]
IFN ITS,[
SYMLST: MOVEI CH,PPA
HRRM CH,LISTF5
PUSHJ P,FRD
SETZM PTLFCD
MOVSI E,TMPFIL
JRST .BPNT
]
IFN TNX,[
SYMLST: MOVEI CH,PPA
HRRM CH,LISTF5
SETZM PTLFCD
CALL FRD0 ;GET FILESPEC
JRST OPNER1
PUSH P,A
MOVSI C,001000
CALL SYMLS2 ;PRINT FILENAME
MOVSI C,000100
CALL SYMLS2 ;AND EXTENSION
POP P,A
RLJFN ;GET RID OF IT
JFCL
JRST FORMF
SYMLS2: HRROI A,BAKTAB
MOVE B,-1(P)
JFNS
MOVEI A,BAKTAB
JRST .FNPT2 ;AND BIGPRINT IT
]
LDBT1: REPEAT 3,LDB TT,LDBT2-1+.RPCNT*7(TT1)
LDBT2: REPEAT 21.,[%T1==.RPCNT/7
%T2==.RPCNT-%T1*7
CH5.7T(B+200+<2*%T1+5*%T2>_12.)
]
CH5.7T: 0 ;SP
DEFINE .. A,B,C,D,E,F,G,H
IFSN H,,[PRINTC /CH5.7T LOSE!
/]
A_31.+B_26.+C_21.+D_16.+E_11.+F_6+G_1
TERMIN
.. 4,4,4,4,4,0,4,, ;!
.. 12,12,12,0,0,0,0,, ;"
.. 12,12,37,12,37,12,12,, ;#
.. 4,17,24,16,5,36,4,, ;$
.. 36,31,2,4,10,23,3,, ;%
.. 4,12,4,10,25,22,15,, ;&
.. 4,4,4,0,0,0,0,, ;'
.. 2,4,10,10,10,4,2,, ;(
.. 10,4,2,2,2,4,10,, ;)
.. 0,25,16,33,16,25,0,, ;*
.. 0,0,4,33,4,0,0,, ;+
.. 0,0,0,0,14,4,10,, ;,
.. 0,0,0,16,0,0,0,, ;-
.. 0,0,0,0,0,14,14,, ;.
.. 0,1,2,4,10,20,0,, ;/
.. 16,21,23,25,31,21,16,, ;0
.. 4,14,4,4,4,4,16,, ;1
.. 16,21,1,2,4,10,37,, ;2
.. 16,21,1,6,1,21,16,, ;3
.. 2,6,12,37,2,2,2,, ;4 . . . OK, BEELER?
.. 37,20,36,1,1,21,16,, ;5
.. 16,21,20,36,21,21,16,, ;6
.. 37,1,2,4,10,20,20,, ;7
.. 16,21,16,21,21,21,16,, ;8
.. 16,21,21,17,1,21,16,, ;9
.. 0,14,14,0,14,14,0,, ;:
.. 0,14,14,0,14,4,10,, ; ;
.. 0,2,4,10,4,2,0,, ;<
.. 0,0,37,0,37,0,0,, ;=
.. 0,10,4,2,4,10,0,, ;>
.. 16,21,2,4,4,0,4,, ;?
.. 16,21,27,25,27,20,17,, ;@
.. 16,21,21,37,21,21,21,, ;A
.. 36,21,21,36,21,21,36,, ;B
.. 16,21,20,20,20,21,16,, ;C
.. 36,21,21,21,21,21,36,, ;D
.. 37,20,20,36,20,20,37,, ;E
.. 37,20,20,36,20,20,20,, ;F
.. 16,21,20,20,23,21,16,, ;G
.. 21,21,21,37,21,21,21,, ;H
.. 16,4,4,4,4,4,16,, ;I
.. 7,1,1,1,1,21,16,, ;J
.. 21,22,24,34,22,21,21,, ;K
.. 20,20,20,20,20,20,37,, ;L
.. 21,33,25,21,21,21,21,, ;M
.. 21,21,31,25,23,21,21,, ;N
.. 16,21,21,21,21,21,16,, ;O
.. 36,21,21,36,20,20,20,, ;P
.. 16,21,21,21,25,22,15,, ;Q
.. 36,21,21,36,21,21,21,, ;R
.. 16,21,20,16,1,21,16,, ;S
.. 37,4,4,4,4,4,4,, ;T
.. 21,21,21,21,21,21,16,, ;U
.. 21,21,21,21,21,12,4,, ;V
.. 21,21,21,21,21,25,12,, ;W
.. 21,21,12,4,12,21,21,, ;X
.. 21,21,12,4,4,4,4,, ;Y
.. 37,2,4,16,4,10,37,, ;Z
.. 6,4,4,4,4,4,6,, ;[
.. 0,20,10,4,2,1,0,, ;\
.. 14,4,4,4,4,4,14,, ;]
.. 4,16,25,4,4,4,4,, ;^
.. 0,4,10,37,10,4,0,, ;_
IFN .-CH5.7T-64.,.. ,,,,,,,69
SUBTTL DISPATCH TABLES
IFN CTRLT,[
;^T DISPATCH TABLE
EDDPTB:
REPEAT 3., BELL ;^@ - ^B
EDCPY ;^C COPY NEXT CHAR
EDD ;^D DELETE NEXT CHAR
BELL ;^E
ED% ;^F HELP TYPE REST OF THIS LINE, CR-LF, WHAT'S BEEN DONE SO FAR
BELL ;^G QUIT (NEVER GETS HERE)
BELL ;^H
EDOV ;^I TAB, TAKE AS CHAR
EDOV ;^J LINEFEED TAKE AS CHAR
BELL ;^K
EDL ;^L COPY REST OF LINE W/O ECHO AND END EDIT
EDCR ;^M CR - END EDIT
EDN ;^N COPY THRU NEXT SPACE OR EOL
EDO ;^O DELETE THRU NEXT SPACE
EDP ;^P ENTER/LEAVE PUT(INSERT) MODE
EDQ ;^Q TAKE "T" AS CHAR ("T" IS CHAR FOLLOWING ^P IN TYPIN STRING)
EDR ;^R COPY REST OF LINE
EDS ;^S COPY TO CHAR "T"
EDT ;^T DELETE TO CHAR "T"
REPEAT 2,BELL ;^U - ^V
400000,,EDW ;^W DELETE TO LAST SPACE
REPEAT 3, BELL ;^X - ^Z
EDALT ;^[ (ALTMODE) COPY REST WITH ECHO AND END EDIT ;]
REPEAT 4, BELL ; ^[, ^\, ^], ^^ AND ^_
] ;IFN CTRLT
;THE ERROR TABLE: EACH WORD HAS THE 3-CHAR MESSAGE IN LH,
;POINTER TO ASCIZ STRING IN RH.
;THE TABLE IS SORTED WITH THE 3-CHAR MESSAGE AS THE KEY.
;THE FIRST ARG TO ERRDEF IS THE 3-CHAR MESSAGE. IT MUST
;CONSIST OF 3 SIXBIT CHARACTERS.
;THE SECOND ARG TO ERRDEF IS WHAT SHOULD BE GIVEN AS THE ARG
;TO THE TYPRE MACRO. IT MUST CONSIST OF 3 SQUOZE CHARS.
;IN TECO LISTINGS, CROSS-REFS GO UNDER THE NAME WHICH
;IS THE ARG TO ERRDEF. IN CREFS, THEY ARE UNDER THE LABEL ACTUALLY
;USED, WHICH HAS AN "ER$" CONCATENATED ON TO THE FRONT.
;OF TYPRE TO CHECK FOR THEM.
IF1 [
ERTOTL==0 ;ON PASS 1, ERTOTL ACCUMULATES AMOUNT OF STRING SPACE NEEDED FOR MESSAGES.
;ALSO DEFINE THE LABELS FOR THE WORDS IN THIS TABLE.
DEFINE ERRDEF A,B,C/
ER$!B ERTOTL==ERTOTL+<5+4+.LENGTH |C|+4>/5
BLOCK 1
TERMIN
]
IF2 [
ERNEXT==ERSTRT ;ON PASS 2, PUT THE STRINGS WHERE THEY BELONG, AND THE 3-CHAR NAMES HERE.
DEFINE ERRDEF A,B,C/
ER$!B SIXBIT /A/ ERNEXT*5-INIQRB+1
ERTMP==.
.=ERNEXT
.BYTE 7
0
QRSTR
ERLEN==<4+4+.LENGTH |C|>
ERLEN&177
<ERLEN/200>&177
0
.BYTE
ASCII |A C|
ERNEXT==.
.=ERTMP
TERMIN
]
ERRTAB: ERRDEF [..E]..E:,Bad value in q-reg ..E (output radix)
ERRDEF [2<1]2%1:,The second argument was less than the first
ERRDEF [AFN]AFN:,Ambiguous FS flag name
ERRDEF [AOR]AOR:,Argument out of range
ERRDEF [ARG]ARG:,Bad argument
ERRDEF [AVN]AVN:,Ambiguous variable or macro name.
ERRDEF [BD"]BD%:,Bad condition after " -- should be G,L,N,E,B,C,D,A or U
ERRDEF [BEL]BEL:,A built-in ^R command called from macro signaled an error
ERRDEF [CMD]CMD:,A char that isn't a TECO command was executed
ERRDEF [CNM]CNM:,Caller wasn't a macro (it was TECO internal code)
ERRDEF [DCD]DCD:,A disabled command was executed
ERRDEF [DSI]DSI:,Damned screw infinitely
ERRDEF [ERP]ERP:,Attempted :< ... ^\ with no closing > first
ERRDEF [ESR]ESR:,Empty sort record
ERRDEF [FTL]FTL:,Filename too long
;[
ERRDEF [ICB]ICB:,Illegal ^] command
ERRDEF [IEC]IEC:,Illegal "E" command
ERRDEF [IFC]IFC:,Illegal "F" command
ERRDEF [IFN]IFN:,Illegal FS flag name
ERRDEF [IQN]IQN:,Invalid q-register name
ERRDEF [ILN]ILN:,Invalid local q-register number
ERRDEF [ISK]ISK:,Invalid sort key - "^P" command
ERRDEF [KCB]KCB:,Kill currently selected buffer
ERRDEF [M^R]M%R:,Attempted to macro a meaningless number
ERRDEF [NDO]NDO:,No device open for output - try "EW"
ERRDEF [NFC]NFC:,No free channels to pop into
ERRDEF [NFI]NFI:,No file open for input - try doing "ER"
ERRDEF [NHP]NHP:,Nonexistent horizontal position
ERRDEF [NIB]NIB:,You have addressed a character not in the buffer
ERRDEF [NIM]NIM:,Not inside a macro
ERRDEF [NOP]NOP:,Specified type of IO channel hasn't been pushed
ERRDEF [NRA]NRA:,File not random access
ERRDEF [N^R]N%R:,Not in ^R - command meaningful only inside ^R
ERRDEF [PDL]PDL:,Pushdown stack full
ERRDEF [PUR]PUR:,Attempted write in pure page
ERRDEF [RDO]RDO:,Attempt to modify a read-only buffer
ERRDEF [QIT]QIT:,^G typed on TTY and FS NOQUIT$ was negative
ERRDEF [QNB]QNB:,Q-register not buffer - attempt to select a string or number
ERRDEF [QNN]QNN:,Q-register not numeric
ERRDEF [QNS]QNS:,Q-register not string or buffer
ERRDEF [QRF]QRF:,Q-regs failed, probably TECO bug
ERRDEF [QRP]QRP:,Q-register PDL overflow or underflow
ERRDEF [SFL]SFL:,Search failed
ERRDEF [SNI]SNI:,Semicolon not in iteration
ERRDEF [SNR]SNR:,There is no valid search string to repeat
ERRDEF [STL]STL:,String argument too long
ERRDEF [STS]STS:,Dispatch string too short
;[[[
ERRDEF [TMN]TMN:,Too many macro, ^]q-register, ^]^X, or ^]^Y nestings
ERRDEF [UBP]UBP:,Unbalanced parentheses found with an FL-type command
ERRDEF [UCT]UCT:,Unseen catch tag
ERRDEF [UEB]UEB:,FL-type command encountered end of buffer.
ERRDEF [UEC]UEC:,Unexpected end of command
ERRDEF [UGT]UGT:,Unseen go-tag
ERRDEF [UJC]UJC:,Undefined journal file characters
ERRDEF [UMC]UMC:,Unmatched ")" or ">" as a command
ERRDEF [URK]URK:,Buffer space or library space exhausted
ERRDEF [UTC]UTC:,Unterminated conditional
ERRDEF [UTI]UTI:,Unterminated iteration or errset (missing ">"?)
ERRDEF [UVN]UVN:,Undefined variable or macro name
ERRDEF [WLO]WLO:,FS OFACCP$ when old access pointer wasn't multiple of 5
ERRDEF [WNA]WNA:,Wrong number of arguments
LERTAB==.-ERRTAB
IF2 IFN ERNEXT-EREND,.ERR LOSSAGE IN ERRTAB.
; E COMMANDS DISPATCH TABLES
ETAB: JRST EQMRK ;?
TYPRE [IEC] ;@
TYPRE [IEC] ;A
TYPRE [IEC] ;B
JRST UICLS ;C
JRST DELE ;D
JRST EXITE ;E
JRST EFCMD ;F
JRST EGET ;G
TYPRE [IEC] ;H
JRST EICMD ;I
JRST EJCMD ;J
TYPRE [IEC] ;K
JRST CNTRU1 ;L
JRST LISTFM ;M
JRST RENAM ;N
TYPRE [IEC] ;O
JRST BPNTRD ;P
IFN ITS,JRST ALINK ;Q
IFN TNX,TYPRE [IEC] ;Q
JRST .OPNRD ;R
TYPRE [IEC] ;S
JRST ETCMD ;T
TYPRE [IEC] ;U
TYPRE [IEC] ;V
JRST WWINIT ;W
IFN TNX,JRST EXITX ;X
.ELSE TYPRE [IEC]
JRST LISTF ;Y
JRST LISTFM ;Z
JRST PSHIC ;[
JRST PSHOC ;\
JRST POPIC ;]
JRST POPOC ;^
JRST FCOPY ;_
LETAB==.-ETAB
;MUST BE SORTED BY FLAG NAME
DEFINE FLG A,B,C
.1STWD SIXBIT/A/
IFB C,[FSNORM,,]IFNB C,[C,,]B+IFB B,A
TERMIN
FLAGS: FLG ADLINE, ;SIZE OF LINE ADJUST FILLS (FA)
FLG ALTCOU,TSALTC,FSALTC ;# CMD STRINGS WAITING TO BE READ.
FLG BACKAR,0,FSBAKA ;RETURN ARGS OF OLD MACRO FRAME
FLG BACKDE,MACDEP,FSRNLY ;DEPTH OF MACRO PDL.
FLG BACKPC,0,FSBAKP ;RETURN RELATIVE PC OF OLD MACRO FRAME
FLG BACKQP,0,FSBAKQ ;RETURN QPDL UNWIND POINTER OF OLD MACRO FRAME
FLG BACKRE,0,FSBKRT ;RETURN CONTROL TO SPECIFIED FRAME.
FLG BACKST,0,FSBAKS ;RETURN STRING POINTER TO MACRO ON MACRO PDL.
FLG BACKTR,0,FSBAKT ;TRACES BACK THE MACRO PDL.
FLG BBIND,0,FSBBIND ;PUSH OR POP CURRENT BUFFER CONVENIENTLY.
FLG BCONS,0,FSBCON ;RETURN A NEW BUFFER.
FLG BCREAT,0,FSCRBF ;CREATE NEW BUFFER (AND SELECT IT).
FLG BKILL,0,FSKILB ;ARG = POINTER TO BUFFER TO BE KILLED.
FLG BOTHCA, ;NONZERO => SEARCHES IGNORE CASE DISTINCTIONS.
FLG BOUNDA,0,FSBOUN ;BOUNDARIES OF PART OF BUFFER BEING EDITED.
FLG BSNOLF ;NOT 0 => BACKWARD MOTION SHOULDN'T BE FOLLOWED BY A LF.
FLG CASE,CASNRM ;SET CASE-SHIFTING MODE.
FLG CASENO,CASE ;SET CURRENT CASE-LOCK STATE.
IFN TNX,FLG CCLFNA,0,FSCCLF ;RETURN STRING FOR JFN IN 1 AT NORMAL ENTRY+2
FLG CLKINT,CLKINT,FSCLKI ;SET CLOCK INTERVAL.
FLG CLKMAC,CLKMAC ;CLOCK HANDLER ROUTINE.
IFN STANSW,FLG CNGBUF ;List of inserts & deletes to emacs buffer.
FLG CTLMTA,RRCMQT ;NEGATIVE => CONTROL-META-LETTER SSELF INSERTING.
FLG DATASW,0,FSSWIT ;PDP10 CONSOLE SWITCHES.
FLG DATE,0,FSDATE ;RETURN CURRENT DATE IN DISK FORMAT.
IFN TNX,FLG DDEVICE,DEFDEV,FSSTRR ;DEFAULT DEVICE AND FILENAMES.
IFN ITS,FLG DDEVICE,DEFFIL,FSFDEV
FLG DDFAST,0,FSDDFS ;-1 IF DEFAULT DEVICE IS "FAST".
FLG DFILE,0,FSDFILE ;DEFAULT FILE'S NAMES, AS STRING.
IFN TNX,FLG DFN1,DEFFN1,FSSTRR
IFN ITS,FLG DFN1,DEFFIL,FSFFN1
IFN TNX,FLG DFN2,DEFFN2,FSSTRR
IFN ITS,FLG DFN2,DEFFIL,FSFFN2
FLG DFORCE, ;NOT 0 => FINISH DISPLAY DESPITE PENDING INPUT, DON'T UPDATE MODE LINE.
IFN TNX,FLG DSNAME,DEFDIR,FSDSNM
IFN ITS,FLG DSNAME,DEFFIL,FSFDIR
IFN TNX,FLG DVERSI,DEFFN3,FSDVER ;DEFAULT FN2 AS NUMBER < AND > SPECIAL
IFN ITS,FLG DVERSI,DEFFIL,FSDVER
FLG DWAIT ;NONZERO => DON'T ALLOW MUCH STUFF IN TTY OUTPUT BUFFER.
FLG ECHOAC,ECHACT ;-1 => ECHO AREA IS ACTIVE (CRUFT SHOULD BE CLEARED BY ^R).
FLG ECHOCH,ECHCHR ;NONZERO => INHIBIT SCAN-ECHOING THIS ^R COMMAND.
FLG ECHODI,0,FSECDS ;(WRITE-ONLY) ECHO-MODE DISPLAY-MODE OUTPUT OF ARG.
FLG ECHOER,ERRECH ;NONZERO => TYPE ERR MSGS IN ECHO AREA.
FLG ECHOFL,ECHFLS ;NONZERO => CLEAR ECHO AREA AFTER EACH COMPLETE ^R COMMAND.
FLG ECHOLI,0,FSECLS ;# OF COMMAND LINES.
FLG ECHOOU,0,FSECOT ;(WRITE-ONLY) ECHO-MODE OUTPUT OF ARGUMENT.
FLG ERR,LASTER,FSERR ;SIGNAL AN ARBITRARY ERROR.
FLG ERRFLG,ERRFL1 ;WHEN ..B OR ..G MACROED, THIS
;HAS 0 OR ERROR CODE OF CMD STRING JUST ENDED.
FLG ERROR,LASTER, ;ERROR CODE OF MOST RECENT ERROR.
FLG ERRTHROW,0,FSERTH ;THROW TO ERROR-CATCHING COMMAND LOOP (^R OR :@<).
FLG EXIT,0,FSEXIT ;DO .BREAK 16, TO INTERUPT SUPERIOR.
IFN TNX,FLG EXPUNG,0,FSEXPU ;EXPUNGE CONNECTED DIRECTORY
FLG FDCONV,0,FSDCNV ;CONVERT NUMERIC TO ASCII FILE DATES.
FLG FILEPA, ;CHAR TO PAD LAST WD OF OUTPUT FILE WITH.
FLG FLUSHED,MORFLF ;0 => NOT AFTER --FLUSHED, 1 => RUBOUT, -1 => OTHER FLUSHAGE.
FLG FNAMSY, ;0 => IF ONLY ONE FILENAME, IT IS FN2.
;> 0 => ONLY ONE FILENAME IS FN1.
;< 0 => ONLY ONE FNAME IS FN1, AND FN2 IS ">".
IFN 20X,FLG FORKJC,FRKJCL ;JCL FOR THE GIVEN FORK
FLG GAPLEN,EXTRAC,FSRNLY ;SIZE OF GAP.
FLG GAPLOC,GPT,FSROCA ;CHAR ADDR OF GAP.
FLG HEIGHT,NVLNS,FSRNLY ;NUMBER OF LINES TO DISPLAY
FLG HELPCH, ;CHARACTER TO INVOKE "HELP" MACRO
FLG HELPMAC, ;MACRO TO CALL IF USER TYPES "HELP" KEY.
FLG HPOSIT,0,FSHPOS ;PHYSICAL POSITION OF A 2741 TYPEBALL IF IT TYPED FROM THE PREVOUS CARRET
FLG HSNAME,,FSDIRH ;HOME DIRECTORY NAME.
FLG I&DCHR,CID ;NONZERO => TRY TO USE CHAR I/D.
FLG I&DLIN,LID ;NONZERO => TRY TO INSERT AND DELETE LINES.
FLG I.BASE, ;INPUT RADIX FOR #S FOLLOWED BY ".".
FLG IBASE, ;ORDINARY INPUT RADIX.
FLG IFACCE,0,FSIFAC ;(WRITE-ONLY) SET INPUT FILE ACCESS PTR
FLG IFCDAT,CHFILI,FSFDAT ;NUMERIC CREATION DATE OF INPUT FILE.
IFN TNX,FLG IFDEVI,ERDEV,FSSTRR ;DEVICE NOW READING FROM.
IFN ITS,FLG IFDEVI,INFILE,FSFDEV
IFN ITS,FLG IFDUMP,CHFILI,FSDUMP ;FILE HAS BEEN DUMPED BIT.
IFN TNX,FLG IFFDB,CHFILI,FSIFDB ;READ OR MODIFY FILE DESCRIPTOR BLOCK
IFN TNX,FLG IFFN1,<ERDEV+DEFFN1-DEFDEV>,FSSTRR ;FN1 OF FILE NOW OPEN FOR READING.
IFN ITS,FLG IFFN1,INFILE,FSFFN1
IFN TNX,FLG IFFN2,<ERDEV+DEFFN2-DEFDEV>,FSSTRR ;FN2 OF FILE NOW OPEN FOR READING.
IFN ITS,FLG IFFN2,INFILE,FSFFN2
FLG IFILE,0,FSIFILE ;FILENAMES OF FILE NOW READING , AS STRING.
FLG IFLENG,0,FSIFLEN ;(R-O) LENGTH OF INPUT FILE.
IFN ITS,FLG IFLINK,0,FSIFLN ;(R-O) -1 IF LAST INPUT FILE WAS REACHED VIA LINKS.
IFN TNX,FLG IFLINK,0,FSVAL
FLG IFMTAP,CHFILI,FSMTAP ;DO .MTAPE ON INPUT FILE.
IFN ITS,FLG IFREAP,CHFILI,FSREAP ;DON'T REAP BIT.
IFN 20X,FLG IFREAP,CHFILI,FSREAP
IFN TNX,FLG IFSNAM,<ERDEV+DEFDIR-DEFDEV>,FSSTRR ;SNAME OF FILE NOW READING FROM.
IFN ITS,FLG IFSNAM,INFILE,FSFDIR
IFN TNX,FLG IFVERS,<ERDEV+DEFFN3-DEFDEV>,FSFVER ;VERSION OF FILE OPEN FOR READING.
IFN ITS,FLG IFVERS,INFILE,FSFVER
FLG IMAGEO,0,FSIMAG ;(WRITE-ONLY) IMAGE MODE OUTPUT OF ARG
FLG INCOUN,INCHCT ;NUMBER OF INPUT CHARACTERS SO FAR.
FLG INSLEN,INSLEN ;LENGTH OF THE LAST INSERT STRING
FLG INVMOD ; INVERSE VIDEO MODE LINE
IFN ITS,FLG JNAME,.RJNAM,FSRSYS ;GET TECO'S JNAME.
IFN TNX,FLG JNAME,0,FSGTNM
FLG JRNEXE,0,FSJRNX ;OPEN AND EXECUTE A JOURNAL FILE. USES DEFAULT NAMES.
FLG JRNIN,,FSRNLY ;NON-ZERO IF JOURNAL FILE BEING RE-EXECUTED.
FLG JRNINH ;NONZERO TO READ FROM TTY IN MIDDLE OF REDOING JOURNAL FILE.
FLG JRNINT,JRNOIVL ;INTERVAL BETWEEN FORCING OUT JOURNAL OUTPUT FILE.
FLG JRNMAC ;MACRO CALLED TO HANDLE "::" SEEN IN INPUT JOURNAL FILE.
FLG JRNOPE,0,FSJRNO ;OPEN AN OUTPUT JOURNAL FILE. USES DEFAULT NAMES.
FLG JRNOUT,,FSRNLY ;NON-ZERO IF JOURNAL FILE BEING WRITTEN.
FLG JRNREA,0,FSJRNR ;READ CHARACTER FROM JOURNAL INPUT FILE.
FLG JRNUPD,0,JRNFRC ;UPDATE JOURNAL FILE.
FLG JRNWRI,0,FSJRNW ;WRITE CHARACTER TO JOURNAL OUTPUT FILE.
FLG LASTPA,,FSRNLY ;SET BY TECO TO 0 AFTER READING LAST PAGE OF INPUT FILE.
FLG LEDEFS .SEE RRSYNC
FLG LINES,NLINES ;NUMBER OF LINES TO DISPLAY
FLG LISPT,INITFL ;NONZERO => TECO WAS STARTED AT ALTERNATE ENTRY
;POINT SIGNIFYING THAT SUPERIOR IS A LISP.
FLG LISTEN,0,FSLISN ;DO .LISTEN, MAYBE PROMPT VIA FS ECHOT.
IFN TNX,FLG LOADAV,0,FSLOAD ;1 MINUTE LOAD AVERAGE
IFN ITS,FLG MACHIN,,FSRNLY ;READ MACHINE NAME
IFN TNX,FLG MACHIN,0,FSMACH
FLG MODECH,MODCHG ;NONZERO SAYS MODMAC MUST BE CALLED.
FLG MODEMA,MODMAC ;NONZERO => IS MACRO TO RECOMPUTE ..J WHEN NECESSARY.
FLG MODIFI,MODIFF ;SET NONZERO WHEN BUFFER WRITTEN IN.
IFN ITS,FLG MPDISP,0,FSMPDS ;DISPLAY OUTPUT TO M.P. AREA.
IFN ITS,FLG MSNAME ;READ WORKING DIRECTORY NAME
IFN TNX,FLG MSNAME,0,FSDIRS ;READ CURRENT CONNECTED DIRECTORY
IFN STANSW,FLG NEWCNG,0,NEWCNG ;Call this when new change record created.
FLG NLAROW, ;<>0=> DON'T ALLOW _ COMMAND
FLG NOCEOL ;NONZERO MEANS TERMINAL HAS NO CL-EOL OPERATION
FLG NOOPAL, ;SAY WHAT TO TO WITH ALTMODES AS COMMANDS.
;0 => ERROR, -1 => IGNORE, 1 => LIKE ^_.
FLG NOQUIT,,FSNQIT ;0 => ^G QUITS NORMALLY.
;POS => ^G JUST SETS STOPF; NO QUITTING.
;NEG => ^G CAUSES ERRSETABLE "QIT" ERROR.
FLG OFACCE,0,FSOFAC ;(WRITE-ONLY) SET OUTPUT FILE ACCESS POINTER
FLG OFCDAT,CHFILO,FSFDAT ;DATE OF OUTPUT FILE (NUMERIC)
IFN TNX,FLG OFFDB,CHFILO,FSOFDB ;MUNG OUTPUT FILE'S FDB
FLG OFILE,0,FSOFILE ;REAL NAMES OF LAST OUTPUT FILE CLOSED.
FLG OFLENG,0,FSOFLEN ;LENGTH OF OUTPUT FILE.
FLG OFMTAP,CHFILO,FSMTAP ;DO .MTAPE ON OUTPUT FILE.
IFN TNX,FLG OFVERS,<ROUDEV+DEFFN3-DEFDEV>,FSFVER ;VERSION LAST OUTPUT FILE
IFN ITS,FLG OFVERS,OUTFIL,FSFVER
FLG OLDFLU,OLDFLF ;OLD VALUE OF FS FLUSHED, IN NEXT ^R COMMAND AFTER THE FLUSHED ONE.
FLG OLDMOD,DISOMD ;LAST ..J VALUE DISPLAYED.
IFN STANSW,FLG OLDZ ;Z AS OF LAST GAPSLP.
FLG OSPEED ;OUTPUT SPEED IN BAUD, OR 0 IF UNKNOWN.
FLG OSTECO,TNX+10X\FNX,FSVAL ;OPERATING SYSTEM, 0 => ITS,
;1 => TWENEX, 2 => TENEX
FLG OUTPUT,OUTFLG ;-1 => OUTPUT TO FILE DISABLED.
IFN TNX,FLG PADCHR ;-1 => USE DELAY INSTEAD OF PADDING.
FLG PAGENU, ;PAGE # IN CURRENT INPUT FILE.
FLG PJATY ;NONZERO => SCREEN NEEDS REFRESHING.
FLG PROMPT,PROMCH ;0, OR ASCII VALUE OF PROMPT CHAR.
FLG PUSHPT,0,FSPSPT ;DO <ARG>^V
FLG QPHOME,0,FSQPHO ;QREG PDL SLOT - WHERE IT WAS PUSHED FROM.
FLG QPPTR,0,FSQPPT ;QREG PDL PTR
FLG QPSLOT,0,FSQPSL ;QREG PDL SLOT (ARG SAYS WHICH ONE)
FLG QPUNWI,0,FSQPUN ;UNWIND QREG PDL.
FLG QUIT,STOPF ;NEGATIVE => A ^G-QUIT HAS BEEN REQUESTED.
FLG QVECTO,0,FSQVEC ;RETURN A NEW QREG VECTOR BUFFER.
FLG RANDOM,RDMNMS ;RANDOM # GENERATOR'S SEED.
FLG READON ;NON-0 => DONT ALLOW MODIFICATION OF THIS BUFFER
FLG REALAD,BEG,FSRNLY ;PHYS CHAR ADDR OF BEGINNING OF BUFFER.
FLG REFRES,REFRSH ;MACRO TO REDISPLAY WHOLE SCREEN.
FLG REREAD,UNRCHC ;-1, OR TTY CHARACTER TO RE-READ.
FLG RGETTY,RGETTY,FSRNLY ;NON-0=> DISPLAY TERMINAL
FLG RUBCRL ;NON-0 => RUBOUT AND ^D DELETE A WHOLE CRLF AT ONCE.
FLG RUBMAC ;MACRO TO DO DELETE IN ^R OF MORE THAN ONE CHAR.
FLG RUNTIM,0,FSRUNT ;NUMBER OF MICROSECONDS OF CPU TIME USED
FLG SAIL,DISSAI ;NON0 => TTY ASSUMED TO PRINT SAIL CHAR SET.
FLG SCRINV,SCINV,FSCRIV ; TURN INVERSE MODE ON/OFF
FLG SCROLL,TTYOPT,FSSCRO
FLG SEARCH,SFINDF ;VALUE RETURNED BY THE LAST SEARCH
FLG SERROR,SRCERR ;NONZERO => FAILING SERACHES ARE ERRORS EVEN IN ITERATIONS.
FLG SHOWMO,SHOMOD ;NOT 0 => FR SHOULD PRINT ..J ON PRINTING TTY.
FLG SHPOS,0,FSSHPS ;LIKE FS HPOS BUT CTL CHARS APPEAR AS ON SCREEN.
FLG SSTRING,0,FSSSTR ;CURRENT SEARCH STRING, AS A STRING.
FLG STEPDE,STEPDE ;MAXIMUM MACRO PDL DEPTH FOR STEPPING TO GO ON.
FLG STEPMA,STEPFL ;NONZERO => SINGLE STEP MACROS, LINE AT A TIME.
FLG SUPERI,SUPHND ;MACRO TO HANDLE REQUESTS FROM SUPERIOR.
FLG SVALUE,SFINDF ;VALUE RETURNED BY LAST SEARCH.
FLG TABWID ;WIDTH OF TAB.
IFN STANSW,FLG TOPBUF ;Copy of ..O for buf selcted by Select Buffer.
FLG TOPLIN,TOPLIN,FSTPLN ;1ST LINE TO USE FOR BUFFER DISPLAY.
FLG TRACE,<(.BP FRTRACE)>,FSWBIT ; -1 IFF IN TRACE MODE.
FLG TRUNCA,DISTRN ;CONTROLS TRUNCATION VS. CONTINUATION OF TYPED LINES.
;NEGATIVE => TRUNCATE, ELSE CONTINUE.
FLG TTMODE,TTMODE
IFN 20X,FLG TTPAGM,PAGMOD,FSTTPG ;PAGE MODE HANDLING (^Q/^S)
IFN TNX,FLG TTYFCI,FCITYI ;POSITIVE, TERMINAL HAS META KEY
;NEGATIVE, TERMINAL CAN DO 12-BIT INPUT
FLG TTYINI,0,FSTTYI ;RE-INIT THE VARS RELATING TO TYPE OF TTY.
FLG TTYMAC,TTYMAC ;MACRO FOR FS TTY INIT$ TO CALL.
IFN 20X,FLG TTYNBR, ;TTY'S .CTTRM NUMBER FOR 20X
FLG TTYOPT, ;TTY'S TTYOPT VARIABLE.
IFN 20X,FLG TTYPAG,PAGMOD,FSTTPG ;PAGE MODE HANDLING (^Q/^S)
FLG TTYSMT, ;TTY'S TTYSMT VARIABLE.
FLG TYIBEG,INCHRR
FLG TYICOU,INCHCT
FLG TYISIN,TYISNK ;MACRO CALLED WITH EACH INPUT CHARACTER, FOR DEFINING KBD MACRO
FLG TYISOU,TYISRC ;MACRO CALLED TO GET INPUT CHARS FROM KBD MACRO.
FLG TYOHAS,0,FSHCD ;HASH CODE OF SCREEN LINE.
FLG TYOHPO,CHCTHP,FSRNLY ;HPOS OF TYPEOUT, AT THE MOMENT.
FLG TYOVPO,CHCTVP,FSRNLY ;VPOS OF TYPEOUT, AT THE MOMENT.
FLG TYPEOU,TYOFLG ;-1 => NEXT TYPEOUT GOES AT SCREEN TOP.
;ELSE TYPEOUT HAS BEEN DONE AND MORE TYPEOUT FOLLOWS IT.
IFN ITS,FLG UHSNAM,0,FSUHSN ;GET HSNAME OF A USER FROM DDT.
IFN ITS,FLG UINDEX,.RUIND,FSRSYS ;GET TECO'S JOB NUMBER.
IFN TNX,FLG UINDEX,0,FSJOBN
IFN ITS,FLG UMAILF,0,FSUML ;GET FILENAME OF A USER'S MAIL FILE FROM DDT.
IFN 20X,FLG UMAILF,0,FSUML ;TOPS-20 MAIL FILE
IFN ITS,FLG UNAME,.RUNAME,FSRSYS ;GET TECO'S UNAME.
IFN TNX,FLG UNAME,0,FSDIR2
FLG UPTIME,0,FSUPTI ;SYSTEM UP TIME IN 60'TH'S.
FLG UREAD,<(.BP (FLIN))>,FSBIT ;-1 IF INPUT FILE, ELSE 0.
IFN 20X,FLG USRNUM,0,FSUSRN ;20X USER NUMBER
FLG UWRITE,<(.BP (FLOUT))>,FSBIT ;-1 IFF OUTPUT FILE OPEN, ELSE 0.
FLG VARMAC, ;NONZERO => ENABLE FEATURE TO RUN MACRO WHEN VARIABLE CHANGES.
FLG VB,0,FSVB ;BEGV, BUT CAN BE PUSHED/POPPED.
FLG VERBOS,VERBOS ;<>0=> DISPLAY MOBY ERROR MESSAGES
FLG VERSIO,.FVERS,FSVAL ;VERSION NUMBER OF THIS TECO
FLG VZ,0,FSVZ ;Z-ZV, BUT CAN BE PUSHED/POPPED.
FLG WIDTH,NHLNS,FSWIDTH ;SIZE OF THE TYPED\DISPLAYED LINE
FLG WINDOW,GEA ;CHAR ADDR (REL BEGV) OF 1ST CHAR IN WINDOW
FLG WORD,0,FSWORD ;GET OR SET SOME WORD IN THE CURRNET BUFFER.
IFN ITS,FLG XJNAME,.RXJNA,FSRSYS ;INSERT .XJNAME IN BUFFER
IFN TNX,FLG XJNAME,0,FSGXNM
FLG XMODIF,MODIFM ;LONG-TERM VERSION OF FS MODIFIED.
FLG XPROMP,RUBENC ;0, OR CHAR TO TYPE NEXT TIME DISINI DONE.
IFN ITS,FLG XUNAME,.RXUNA,FSRSYS ;INSERT .XUNAME IN BUFFER
IFN TNX,FLG XUNAME,0,FSDIR2
IFN TNX,FLG XUSRNU,0,FSXUSR
FLG YDISAB, ;DISABLES Y COMMAND IN VARIOUS WAYS
FLG Z,Z,FSROCA ;# CHARS IN BUFFER (Z COMMAND IS 1 + # OF LAST CHAR IN RANGE BEING EDITED.)
FLG ^HPRIN,DISPBS ;PRINT BS AS BS? NEGATIVE => YES.
FLG ^IDISA,TABMOD ;0 => TABS INSERT 1 => ERROR -1 => IGNORE.
FLG ^LINSE,FFMODE ;NON0 => ^L'S READ FROM FILE GO IN BUFFER.
FLG ^MPRIN,DISPCR ;STRAY CR CAN COME OUT AS CR? NEGATIVE => YES.
FLG ^PCASE,PSCASE ;NONZERO => ^P SORT IGNORES CASE.
FLG ^RARG,RRRPCT ;BASIC ^R-MODE ARGUMENT (SET BY ^V)
FLG ^RARGP,RRARGP ;0 => USE 1 INSTEAD OF FS ^RARG$.
FLG ^RCCOL,RRCCOL ;COMMENT COLUMN FOR ^R MODE.
FLG ^RCMAC,0,FSCRMA ;MACROS ASSOCIATED WITH CHARS.
FLG ^RDISP,RRDISM ;MACRO TO RUN WHEN ABOUT TO DO NONTRIVIAL REDISPLAY.
FLG ^RECHO,RRECHO ;CONTROLS ECHOING OF CHARACTERS READ IN BY ^R.
FLG ^RECSD,RRECSD ;IF SPACE'S DEFINITION EQUALS THIS, RRECIN CAN ECHO SPACES.
FLG ^RENTER,RRENTM ;MACROED WHEN ^R IS ENTERED.
FLG ^REXIT,0,FSCREX ;EXIT FROM ^R WHEN EXECUTED.
FLG ^REXPT,RR4TCT ;EXPONENT-OF-4, INCREMENTED BY ^U.
FLG ^RHMIN,RRMNHP ;HPOS OF FIRST CHANGE ON SCREEN NEEDING REDISPLAY.
FLG ^RHPOS,RRHPOS ;HPOS OF CURSOR IN ^R MODE.
FLG ^RINCO,INCHRR ;TOTAL # OF INPUT CHARS, AT START OF LAST ^R COMMAND.
FLG ^RINDI,0,FSINDT ;TRACE ^R INDIRECT COMMAND DEFINITIONS.
FLG ^RINHI,RRINHI ;NONZERO INHIBITS ALL DISPLAY UPDATING.
FLG ^RINIT,0,FSCRIN ;INITIAL VALUE OF FS ^R CMACRO$
FLG ^RINSE,0,FSRRINS ;INTERNAL ^R 1-CHAR INSERT ROUTINE.
FLG ^RLAST,RRLAST ;MOST RECENT ^R-MODE CHAR (EXCEPT ARG-SETTING CHARS)
FLG ^RLEAVE,RRLEVM ;MACROED WHEN ^R EXITS (BUT NOT IF ERR'D OR THROWN THRU)
FLG ^RMARK,RRMKPT ;THE ^R-MODE MARK, SET BY ^T. -1 => NO MARK NOW.
FLG ^RMAX,RRTTMX ;MAX # CHARS OF INSERT OR DELETE TO TYPE OUT.
FLG ^RMCNT,RRMCC1 ;THE COUNTER USED TO TELL WHEN TO CALL SEC'Y MACRO.
;INITTED FROM FS ^RMDLY, COUNTED DOWN TO 0.
FLG ^RMDLY,RRMCCT ;# OF ^R CMDS TO DO BETWEEN INVOCATIONS OF SEC'Y MACRO.
FLG ^RMODE,DISPRR,FSRNLY ;NONZERO IN ^R MODE.
FLG ^RMORE,RRMORF ;> 0 SAYS USE --MORE-- INSTEAD OF --TOP-- IN ^R MODE.
;< 0 SAYS USE NEITHER --MORE-- NOR --TOP--.
FLG ^RNORM,RRXINV ;THIS IS THE REAL DEFINITION OF ANY ^R-MD CHAR DEFINED
;TO BE "SELF-INSERTING". ZERO MEANS ACTUALLY SELF-INSERT.
FLG ^RPAREN,RRPARN ;THIS GETS RUN FOR SELF-INSERTING CHARS THAT HAVE ")" SYNTAX.
FLG ^RPREV,RRPRVC ;THE ^R-MODE COMMAND CHAR BEFORE THE ONE IN ^R LAST.
FLG ^RREPL,RRRPLC ;CONTROLS INSERTION VS REPLACEMENT BY NORMAL CHARS.
FLG ^RRUBO,0,FSRRRUB ;INTERNAL ^R RUBOUT ROUTINE.
FLG ^RSCAN,RRSCAN ;NONZERO => ^R ON PRINTING TTY PRINTS CHARS MOVED OVER.
FLG ^RSTAR,RRSTAR ;NONZERO => DISPLAY STAR IN MODE LINE.
FLG ^RSUPP,RRALQT ;NONZERO SUPPRESSES BUILTIN COMMANDS
FLG ^RTHRO,0,FSCRTH ;THROW TO INNERMOST ^R INVOCATION.
FLG ^RTTM1,RRTTM1 ;MACRO TO HANDLE LONG CURSOR MOTION ON PRINTING TTY.
FLG ^RUNSU,RRUNQT
FLG ^RVMIN,RRMNVP ;VPOS OF FIRST CHANGE ON SCREEN NEEDING REDISPLAY.
FLG ^RVPOS,RRVPOS ;VPOS OF CURSOR IN ^R MODE.
FLG _DISAB,NLAROW
FLG %BOTTO, ;PERCENT AT BOTTOM BARRED TO CURSOR.
FLG %CENTE, ;PERCENT FROM TOP TO PREFERRED LOCATION FOR CURSOR (WHEN WINDOW CHOSEN)
FLG %END, ;PERCENT AT BOTTOM BARRED TO CURSOR WHEN WINDOW CHOSEN.
IFN ITS,FLG %OPLSP,<(.BP (%OPLSP))>,FSOPTL ;VALUE OF JOB'S %OPLSP BIT (SUPERIOR IS LISP).
FLG %TOCID,<(.BP (%TOCID))>,FSTTOL ;VALUE OF TTY'S %TOCID BIT.
FLG %TOFCI,<(.BP (%TOFCI))>,FSTTOL ;VALUE OF TTY'S %TOFCI BIT.
FLG %TOHDX,<(.BP (%TOHDX))>,FSTTOL ;VALUE OF TTY'S %TOHDX BIT.
FLG %TOLID,<(.BP (%TOLID))>,FSTTOL ;VALUE OF TTY'S %TOLID BIT.
FLG %TOLWR,<(.BP (%TOLWR))>,FSTTOL ;VALUE OF TTY'S %TOLWR BIT.
FLG %TOMOR,<(.BP (%TOMOR))>,FSTTOL ;VALUE OF TTY'S %TOMOR BIT.
FLG %TOOVR,<(.BP (%TOOVR))>,FSTTOL ;VALUE OF TTY'S %TOOVR BIT.
FLG %TOP, ;PERCENT OF SCREEN AT TOP BARRED TO CURSOR.
FLG %TOROL,<(.BP (%TOROL))>,FSTTOL ;VALUE OF TTY'S %TOROL BIT.
FLG %TOSAI,<(.BP (%TOSAI))>,FSTTOL ;VALUE OF TTY'S %TOSAI BIT.
FLG %TPMTA,<(.BP %TPMTA)>,FSTTOL ;VALUE OF TTY'S %TPMTA BIT.
FLG *RSET,UNWINF ;NONZERO PREVENTS AUTOMATIC QRP UNWINDING.
FLG .CLRMO,CLRMOD ;NONZERO => CLEAR SCREEN WHEN TTY GIVEN BACK BY SUPERIOR.
FLG .KILMO,KILMOD ;(NORMALLY NON-0) 0 MAKES FSBKILL$ A NOOP.
FLG .TYIBA,0,FSTBBK ;DECREMENT THE FS .TYIPT$ POINTER.
FLG .TYINX,0,FSTBNXT ;ILDB THAT POINTER AND RING IT AROUND TO GET NEXT OLD TYI CHAR.
FLG .TYIPT,TYIBFQ,FSRNLY ;POINTER TO NEXT TYI CHARACTER IN RING BUFFER.
FLG :EJPAG,LHIPAG,FSEJPG ;# OF LOWEST PAGE IN USE BY PURE STRING SPACE
IFN TNX,FLG :ETMOD,ETMODE ;BITMASK OF FIELDS TO DEFAULT IN :ET COMMAND
FLAGSL==<.-FLAGS>/2
FLAGD==FLAGS+1
<-1>_-1 ;THIS TERMINATES THE AMBIGUITY TEST AT FSFND.
BLOCK 4 ;FOR PATCHING (HARD BUT POSSIBLE)
IFCERR==TYPRE [IFC]
FDTB: JRST FCTLAT ;^@
JRST FCACMD ;^A
JRST FMEMQ ;^B
TYPIFC: IFCERR ;^C
IFCERR ;^D
JRST FCECMD ;^E
JRST FCTLF ;^F
JRST FCTLG ;^G
IFCERR ;^H
IFCERR ;^I
IFCERR ;^J
JRST FCTLK ;^K
REPEAT ^R-^K-1,IFCERR
JRST RRALTR ;^R
JRST TABSRC ;^S
REPEAT ^X-^S-1,IFCERR
JRST FCTLX ;^X
JRST FCTLY ;^Y ;[
REPEAT 4,IFCERR ;^Z - ^]
JRST FCTLUP ;^^
IFCERR ;^_
IFCERR ;SPACE
IFCERR ;!
JRST FDQUOT ;"
IFCERR ;#
JRST FSCASE ;$
REPEAT 3,IFCERR ;%-'
JRST FOPEN ;(
JRST FCLOSE ;)
JRST FNOOP ;*
JRST CTLL ;+
REPEAT "6-"+-1,IFCERR
JRST FSIXB ;6
REPEAT ";-"6-1,IFCERR
JRST FSEMIC ;;
JRST FLSSTH ;<
JRST FEQ ;=
IFCERR ;>
JRST FLSCMD ;?
IFCERR ;@
JRST ADJUST ;A
JRST FBCMD ;B
JRST LOWCON ;C
JRST FDCMD ;D
JRST FECMD ;E
IFCERR ;F
JRST FGCMD ;G
IFCERR ;H
JRST FTYI ;I
JRST FJCL ;J
JRST FKCMD ;K
JRST FLCMD ;L
JRST FMCMD ;M
JRST FNCMD ;N
JRST FOCMD ;O
JRST FDATTY ;P
JRST QLEN ;Q
JRST FRCMD ;R
JRST FSET ;S
JRST FTYPE ;T
JRST FUCMD ;U
JRST FVIEW ;V
JRST FWCMD ;W
JRST FXCMD ;X
JRST FYCMD ;Y
IFE TNX,IFCERR ;Z
IFN TNX,JRST FZCMD ;Z
JRST FPUSH ;[
IFCERR ;\
JRST FPOP ;]
JRST FAPPRX ;^
JRST SERCHA ;_, LIKE NORMAL _ CMD.
IFN .-FDTB-140,[PRINTX \FDTB LOSS
\]
DTB: HRROI B,CNTRAT ;^@
MOVEI B,COR ;^A
HRROI B,CTLB ;^B
TYPRE [CMD] ;^C
TYPRE [CMD] ;^D
TYPRE [CMD] ;^E
HRROI B,CNTRLF ;^F
TYPRE [CMD] ;^G - TS QUIT
TYPRE [CMD] ;^H - BACKSPACE
JRST TAB ;^I - TAB
MOVEI B,CD ;^J - LINE FEED
HRROI B,DECDMP ;^K - VALRET SOMETHING
HRROI B,CTLL ;^L - FORM FEED
HRROI B,CTLM ;^M - CARR RET
HRROI B,CNTRLN ;^N
HRROI B,SYMLST ;^O
HRROI B,PSORT ;^P
TYPRE [CMD] ;^Q
HRROI B,RRENTR ;^R
HRROI B,ASLEEP ;^S
IFN CTRLT,HRROI B,EDIT ;^T
.ELSE TYPRE [CMD] ;^T
HRROI B,CNTRLU ;^U
HRROI B,CTLV ;^V
JRST CTLW ;^W
HRROI B,GMARG1 ;^X
HRROI B,GMARG2 ;^Y
HRROI B,RANDOM ;^Z
JRST ALTCMD ;ALTMODE
MOVEI B,MEXIT ;^\
TYPRE [CMD] ;[ ;^]
HRROI B,CNTRUP ;^^
JRST LGOGO ;^_
MOVEI B,SPACE ;
MOVEI B,EXCLAM ;!
MOVEI B,DQUOTE ;"
MOVEI B,CXOR ;#
HRROI B,NEWAS ;$
HRROI B,PCNT ;%
MOVEI B,CAND ;&
JRST CD5A ;'
MOVEI B,OPEN ;(
MOVEI B,CLOSE ;)
MOVEI B,TIMES ;*
MOVEI B,PLUS ;+
MOVEI B,COMMA ;,
MOVEI B,MINUS ;-
JRST PNT ;.
MOVEI B,SLASH ;/
REPEAT 12,JRST CDNUM ;DIGITS 0 - 9.
JRST ACOLON ;:
MOVEI B,SEMICL ; ;
MOVEI B,LSSTH ;<
HRROI B,PRNT ;=
JRST GRTH ;>
HRROI B,QUESTN ;?
JRST ASLSL ;@
HRROI B,APPEND ;A
HRROI B,BCMD ;B
HRROI B,CHARAC ;C
HRROI B,DELETE ;D
HRROI B,ECMD ;E
HRROI B,FCMD ;F
HRROI B,QGET ;G
HRROI B,HOLE ;H
HRROI B,INSERT ;I
HRROI B,JMP ;J
HRROI B,KILL ;K
HRROI B,LINE ;L
MOVEI B,MAC ;M
HRROI B,SERCHP ;N
MOVEI B,OG ;O
HRROI B,PUNCH ;P
HRROI B,QREG ;Q
HRROI B,REVERS ;R
HRROI B,SERCH ;S
HRROI B,TYPE ;T
HRROI B,USE ;U
HRROI B,VIEW ;V
MOVEI B,CD ;W
HRROI B,X ;X
HRROI B,YANK ;Y
HRROI B,END1 ;Z
HRROI B,OPENB ;[
HRROI B,BAKSL ;\
HRROI B,CLOSEB ;]
JRST ASLSL ;^
JRST BAKARR ;_
IFN .-DTB-140,.ERR DTB WRONG # ENTRIES.
CONSTANTS
PAT:
PATCH": BLOCK 200
PATCHE": 0
HUSED: INFORM [TOP OF PURE]\.-1
LOC <.+1777>&776000
HIMPUR::
VARIABLES
;IF ^R VARIABLES DON'T FIT IN LOW IMPURE, PUT THEM HERE.
IFG <RRVARX&1777>+RRVARL-1777, RRVARB:: BLOCK RRVARL
IFN LINSAV,[
;VARIABLES FOR LINE SAVING PROTOCOL.
;Highest label (+ 1) that we can use.
;Zero if line saving is not available on our terminal.
LBLLIM: 0
;Beginning of region to clear at tty init time.
LBLBEG::
;Hash code of what was saved under each label.
;-1 for unused label.
LBLHCD: BLOCK MAXLBL
;Indexed by screen line, gives label last used to restore that line
;or -1 if it was output explicitly, or was cleared and not output yet.
LINLBL: BLOCK MXNVLS
;Next label to allocate when we save another line.
LBLNXT: 0
;End of region to clear at tty init time.
LBLEND::
;Label we used for restoring the last line that wanted restoring.
;-1 if no label was available.
;For successive lines, successive labels is a good guess.
LBLRST: -1
];LINSAV
;^R-MODE COMMAND DISPATCH TABLE. POSITIVE => BUILTIN COMMAND;
;RH IS DISP. ADDR, LH IS EXTRA INFO (SECONDARY DISP. ADDR).
;NEGATIVE => IT IS STRING POINTER TO MACRO.
RRMACT:
;NON-CONTROL, NON-META CHARACTERS:
REPEAT ^H,RRXINS ;^@ - ^G
REPEAT 3,RRINSC,,RRREPI ;^H, ^I, ^J NEVER REPLACE, REGARDLESS OF FS ^R REPLACE$
RRXINS ;^K
RRXINS ;^L
RRCRLF,,RRREPT ;^M
REPEAT 33-^M-1,RRXINS ;^N - ^Z
RREXIT ;ALTMODE
REPEAT "A+40-ALTMOD-1,RRXINS ;^\ - `
REPEAT 26.,40,,RRINDR ;LOWERCASE LETTERS.
REPEAT 4,RRXINS ;LOWERCASE SPECIAL CHARACTERS.
RRRUB
.SEE RRITAB ;MUST BE CHANGED WHEN THE ENTRIES BELOW ARE CHANGED.
;CONTROL, NON-META CHARACTERS:
REPEAT ^H,RRUNDF ;CONTROL-^@ TO CONTROL-^G
REPEAT 3,200,,RRINDR ;CONTROL-BS TO CONTROL-LF.
REPEAT 2,RRUNDF ;CONTROL-^K AND CONTROL-^L.
200,,RRINDR ;CONTROL-CR
REPEAT 33-^M-1,RRUNDF ;CONTROL-^N THROUGH CONTROL-^Z.
200,,RRINDR ;CONTROL-ALTMODE.
REPEAT "--33-1,RRUNDF ;CONTROL-^\ TO CONTROL-,
RRCMNS ;CONTROL-MINUS
REPEAT "0-"--1,RRUNDF ;CONTROL-. TO CONTROL-/
REPEAT 10.,RRCDGT ;CONTROL-0 THRU CONTROL-9
REPEAT 100-"9-1,RRUNDF ;CONTROL-: TO CONTROL-?
RRUNDF ;^@
RRBEG ;^A
RRCTLB ;^B
RRCMSW ;^C
RRCTLD ;^D
RREND ;^E
RRCTLF ;^F
RRQUIT ;^G
300,,RRINDR ;^H
300,,RRINDR ;^I
300,,RRINDR ;^J
RRKILL ;^K
RRCTLL ;^L
RRINSC,,RRREPI ;^M
RRNEXT ;^N
RRCTLO,,RRREPT ;^O
RRPREV ;^P
RRQUOT ;^Q
RRCMCS ;^R
RRSRCH ;^S
RRMARK ;^T
RR4TIM ;^U
RRARG ;^V
RRFX ;^W
RREXCH ;^X
RRUNDF ;^Y
RRUNDF ;^Z
RRUNDF ;^[
RRUNDF ;^\
RRBRC ;^]
RRUNDF ;^^
RRUNDF ;^_
RRUNDF ;^`
REPEAT 32,40,,RRINDR ;^<LOWERCASE LETTERS>
REPEAT 4,RRUNDF ;^{ ^| ^} ^~
RRCRUB ;CONTROL-RUBOUT.
IFN .-RRMACT-400,,.ERR
;META CHARS:
REPEAT "-,RRXINS
RRCMNS
REPEAT "0-"--1,RRXINS
REPEAT 10.,RRCDGT
REPEAT "A+40-"9-1,RRXINS
REPEAT 26.,40,,RRINDR ;LOWERCASE LETTERS INDIRECT THRU UPPERCASE.
REPEAT 5,RRXINS
;CONTROL-META CHARS: MOSTLY SELF-INSERTING, BUT SOME ARE INDIRECT THROUGH OTHERS.
REPEAT ^H,RRXINS ;^@ THRU ^G
REPEAT 3,200,,RRINDR ;^H THRU ^J
REPEAT 2,RRXINS ;^K, ^L
200,,RRINDR ;^M
REPEAT 33-^M-1,RRXINS ;^N TO ^Z
200,,RRINDR ;ALTMODE
REPEAT "--33-1,RRXINS ;^\ TO COMMA
RRCMNS ;MINUS SIGN
REPEAT "0-"--1,RRXINS ;. TO /
REPEAT 10.,RRCDGT ;0 TO 9
REPEAT "H-"9-1,RRXINS ;: TO G
REPEAT 3,300,,RRINDR ;H, I, J
REPEAT "`-"J,RRXINS ;K TO `
REPEAT 32,40,,RRINDR ;a to z
REPEAT 200-172-1,RRXINS ;{ TO RUBOUT.
IFN .-RRMACT-1000,.ERR
RRMACL==1000 ;LENGTH OF RRMACT
SUBTTL INITIAL CONTENTS OF STRING AND BUFFER SPACE
;; BUFFER AND MACRO CALL FRAMES. MORE CAN BE CREATED, PUSHING COMMAND BUFFER UP.
MFSTRT: REPEAT MFNUM-3, REPEAT MFBLEN-1,[ 0 ?] .
REPEAT MFBLEN, 0
MFBUF1: MFBFR,,INIBEG ;BUFFER FRAME FOR INITIALLY SELECTED BUFFER.
REPEAT MFBLEN-2,INIBEG
0
MFSBUF: MFBFR,,INISRB ;THIS BUFFER HOLDS THE COMPILED SEARCH STRING.
REPEAT 4,INISRB
INISRE
0
MFEND1::
CBUF: BLOCK CBUFSZ ;COMMAND BUFFER FOR NON-^R MAIN LOOP.
;INITIAL CONTENTS OF STRING SPACE:
INIQRB==5*.
ERSTRT: BLOCK ERTOTL ;STRINGS FOR ERROR MESSAGES GO HERE.
EREND::
INIDLM::
<.BYTE 7 ? 177 ? QRSTR ? 4 ? 5 ? 0>
REPEAT ^M, ASCII / /
ASCII./ ENDS COMMENTS IN LISP.
REPEAT 33-^M-1, ASCII / /
ASCII / A / ;ALTMODE
REPEAT 40-33, ASCII / / ;34 THRU SPACE
ASCII / A / ;!
ASCII / A / ;"
ASCII / A / ;#
REPEAT "%-"$+1, ASCII /AA / ;$, %.
ASCII / A / ;&
ASCII / ' / ;'
ASCII / ( / ;(
ASCII / ) / ;)
ASCII / A / ;*
ASCII / A / ;+
ASCII / / ;,
ASCII / A / ;-
ASCII /AA / ;.
ASCII . / . ;/
REPEAT "0-"/-1, ASCII / A /
REPEAT "9-"0+1, ASCII /AA /
REPEAT ";-"9-1, ASCII / A /
ASCII / ; /
REPEAT "A-";-1, ASCII / A /
REPEAT "Z-"A+1, ASCII /AA /
REPEAT "a-"Z-1, ASCII / A /
REPEAT "z-"a+1, ASCII /AA /
REPEAT "|-"z-1, ASCII / A /
ASCII / | /
REPEAT 176-"|, ASCII / A /
ASCII / /
IFN .-INIDLM-201,.ERR WRONG TABLE LENGTH
INI..O==5*.
<.BYTE 7 ? QRBFR ? MFBUF1&177 ? MFBUF1_<-7>&177
MFBUF1_<-14.>&177>
INISRS==5*.
<.BYTE 7 ? QRBFR ? MFSBUF&177 ? MFSBUF_<-7>&177 ? MFSBUF_<-16>&177>
INIQRW==5*.
;INITIAL CONTENTS OF BUFFER SPACE.
INIBUF==5*<<INIQRB/5+SLPQWR>&<-2000>>
INISRB==INIBUF
INISRE==INISRB+5*<1+STBLSZ>
INIBEG==INISRE+5
INITOP==INIBEG+5
;;;ITS TECO and EMACS should serve as a lesson to all of what can be achieved
;;;when programmers' creativity is not crushed by administrators whose main
;;;concern is stifling humor, stamping out all possibility of enthusiasm, and
;;;forbidding everything that isn't compulsory.
;;;They were produced in a humane anarchy where one man designs, implements,
;;;and then documents the feature that inspires him. They were produced by
;;;people who could laugh enough to name many years of effort the Incompatible
;;;Timesharing System. Of course, the whole story is imaginary. Working
;;;conditions which do not crush the spirit can't be practical. You can't run
;;;a team that way if you expect to meet the deadline. TECO doesn't really
;;;exist; you were only dreaming it.
;;;You owe your improvements to us in return for what you see here. If anyone
;;;asks you for a copy, make sure he gets in touch with the MIT AI Lab so he
;;;can get the latest stuff.
END BOOT