From c188e800f6da9801245ef305d0919d2b35a3c5ad Mon Sep 17 00:00:00 2001 From: Lars Brinkhoff Date: Tue, 1 Nov 2016 10:42:50 +0100 Subject: [PATCH] TECO source code. --- src/_teco_/*.teco | 28 + src/_teco_/teco.1212 | 23444 +++++++++++++++++++++++++++++++++++++++++ src/syseng/lfn.3 | 655 ++ 3 files changed, 24127 insertions(+) create mode 100755 src/_teco_/*.teco create mode 100755 src/_teco_/teco.1212 create mode 100755 src/syseng/lfn.3 diff --git a/src/_teco_/*.teco b/src/_teco_/*.teco new file mode 100755 index 00000000..75953763 --- /dev/null +++ b/src/_teco_/*.teco @@ -0,0 +1,28 @@ +!THIS IS THE DEFAULT TECO INIT FILE, USED FOR USERS WHO DO NOT HAVE THEIR OWN! +![Comments created 5/11/81 by Joe Kesselman (JKESS@MC)]! + +FJ ."E -1U..H ' !Get job command string. If null, block! + ! buffer display and exit! +J :S"E !If string doesnt contain ALTMODE,! + :S "E :S;"N 1A-13"E HFXA !Then: if string doesnt contain SPACE! + ! then: if string contains SEMI! + ! then: if SEMI is followed by RETURN! + ! then: copy JCL to QA and clear buffer.! + 1:"L !Using error trap, try to use as dir to get! + ! init file from.! + .,(GA-S;ZK).FXA ER(INIT);A .TECO.' !If error, try as username in! + ! (INIT) directory! + ^ YHFXA :JCL !If either succeeds, read file into QA, wipe! + ! buffer,! +$P:MA''' !valret a :JCL setting the job command! + ! string to ^V, and execute QA, tail-! + ! recursively.! + ZJ IEIERY' !If string DID contain space, append $EIER$Y! + ! to it.! +1FSFNAMSYW [..N :I..N 0FSFNAMSY  !Set filename syntax convention, set! + ! things so this resets itself automatically! + ! upon exiting from this macro level.! +J I0UA ET HFXA :MA !Finish off the command line: Clear QA, set! + ! default filename to the JCL passed to us.! + ! Copy it into QA and tail-recurse to it.! + \ No newline at end of file diff --git a/src/_teco_/teco.1212 b/src/_teco_/teco.1212 new file mode 100755 index 00000000..bf92a7af --- /dev/null +++ b/src/_teco_/teco.1212 @@ -0,0 +1,23444 @@ +; -*-MIDAS-*- +;[MIT-OZ]OZ: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. +;[WASHINGTON]PS: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 9733. ;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 TO EMACS: FOR 20X. +IFNDEF INFODV,INFODV==0 +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 +.DECSAV +IFN .OSMIDAS-SIXBIT/TENEX/,[ + IFN .OSMIDAS-SIXBIT/TWENEX/,[ + IF1 [ + .INSRT SYS:TNXDFS + .TNXDF + .INSRT SYS:TWXBTS + ]]] +] + +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_ +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 SAYS NEXT SCREEN POSITIONS REPRESENT ONE TEXT CHAR . +%TDSVL==250 ;%TDSVL SAVE N LINES STARTING AT CURSOR + ;UNDER LABELS STARTING WITH *7+ +%TDRSL==251 ;INVERSE OPERATION: RESTORE 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 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 , 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:: + +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 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: _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 <*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 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: 37 ;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 ;{|}~ +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,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 ) +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 ^] 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 + ;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 + ;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 + +;ITERATION OR ERRSET (:< -- >)CELL +;THESE FORM A LIST POINTED TO BY ITRPTR. + ;COMCNT + ;CPTR + ;CSTR +MFICNT==3 ;ITERCT +MFMACP==4 ;MACPDP + 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 + +;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 +;[ ;^] 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 (-) =. PROTECT 1ST 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. + +SUBTTL BOOTSTRAP FOR EJ FILES + +IF2 PURP1==INIT/2000 ;# OF 1ST PURE CODE PAGE +IF2 PURPL==/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:TECPUR.EXE.]\.FNAM3 ] +] +.ELSE HRROI 2,[STRCNC [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: 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 4,TTYNBR ;SAVE .CTTRM NUMBER + TLNE 1,-1 + TLO 1,040000 ; MAKE SURE THIS LOOKS LIKE A DIRECTORY + MOVEM 1,HSNAME ; HSNAME IS DIRECTORY CORRESPONDING TO USER + MOVSI 1,(GJ%OFG\GJ%SHT) ; PARSE ONLY + HRROI 2,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 + MOVEI C,.FVERS + CALL DPT +IFN ITS,[ + .SUSET [.RXUNAME,,C] + .CALL GOZO1 ; OPEN ; TECO + CAIA + JRST GOZ7 + MOVSI C,(SIXBIT/*/) + .CALL GOZO1 ; OPEN ;* 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 + 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 +IFN SUMTTF,[ + MOVEM C,NHLNS +];SUMTTF +IFE SUMTTF,[ + MOVEI B,.MORLW ;WORKS FOR ALL TTY WIDTHS + MTOPR + ERJMP .+1 + MOVEM C,NHLNS + 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 +];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:=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 + SKIPE CH,RGETTY ; PRINTING? + TRZA 2,TT%DAM ; NO, BINARY MODE THEN + TRO 2,1_6\TT%ECO ; YES, MAKE SURE DATA MODE NORMAL +IFN 20X,[ + CAIN CH,VTSI ; IF RUNNING UNDER VTS + TRO 2,1_7 ; TURN ON OUTPUT TRANSLATION +] + SFMOD +IFN 20X,[ + SKIPGE PAGMOD ; WANT PAGE MODE LEFT ON? + JRST .+4 ; YES, DONT MESS WITH IT + TRZE 2,TT%PGM ; TURN OFF PAGE MODE ON DISPLAY + STPAR + 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. + +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 + 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 +];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 PURIFY + +IFN ITS,[ +;DUMPIT$G TO DO $Y 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+] + 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 +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+*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 +;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 F^K$. IF YOU WERE CALLED BY A MACRO, IT WILL ACT LIKE ;[ +; :I*^]^X$, GOBBLING A STRING ARG FROM THAT MACRO. +;OTHERWISE, IT ACTS LIKE M$*F^K HOOK*$$, +; 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 . + 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. +;FE -- INSERT IN BUFFER THE 3-LETTER CODE + ;AND MESSAGE ASSOCIATED WITH ERROR CODE +;@FE$ -- RETURNS THE ERROR CODE ASSOCIATED WITH THE 3-CHAR + ;MESSAGE . +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 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,CALL RRECIN ;HAVE SYSTEM ECHO AND INSERT PRINTING CHARACTERS, MAYBE. + CALL TYIW0 ;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,[ +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 + 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. + 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) +;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. +RRECI7: SYSCAL ECHOIN,[%CLIMM,,CHTTYI ? BP ? B ? %CLIMM,,-3(P) ? %CLIMM,,BEG] + JFCL + 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 ,,RRREPT ) +RRREPT: SKIP ;TELL RRLP7H ERROR-CHECK WE'RE GOOD GUYS. + HLRZS E ;PUT IN RH. +RRREP1: JUMPLE C,POPJ1 ;C HAS -<# 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. +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 'S DEFINITION IS ,,RRINDR, IT IS AN INDIRECT PTR +;TO THE DEFINITION OF THE CHARACTER -. 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 + SUB CH,E + JRST RRIND1 ;GO USE DEF'N OF -. + +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/\) +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[1MU0:I1 +<@V@:FT0 FIU0 :I110 Q0-."N0;'> +F@:M(:I* F@:M1(]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 + +;,F^R - REPORT CHANGES BETWEEN , 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. +;:F^R CHOOSES A WINDOW THAT PUTS POINT ON LINE +FS TOPLIN$ +;A NEGATIVE 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. + +;,@ 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 ,@ 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 + +;,FM - MOVE DOWN TO HPOS , LINES DOWN. +;,@FM - MOVE UP TO HPOS , - 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 + +;FS ^R INIT$ RETURNS THE INITIAL SETTING OF 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.) +;^^FS^RCMAC$ GETS, Q,^^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 + 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 + +; FS ^R IND RETURNS THE CHAR CODE THAT INDIRECTS TO (MAY BE 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 + +;, F^S SEARCHES BUFFER IN STARTING AT WORD +;FOR A WORD CONTAINING . RETURNS IDX OF FIRST SUCH, OR -1 IF NONE. +;, :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 ^L; DISPLAY LINES OF BUFFER. + CALL CRR + CALL CRR + CALL WINSET ;SET WINDOW SIZE TO 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 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 , DOES -@L. +RRPREV: SKIP ;CALCULATE , + MOVNS C + JRST RRNEX2 ; IS -. + +;^A -- MOVE TO BEGINNING OF LINE. +;WITH ARGUMENT , DOES -1@L. +RRBEG: SKIP + SOJA C,RREND2 + +;^E -- MOVE TO END OF LINE (:@L). WITH ARGUMENT , DO :@L. +RREND: SKIP +RREND1: TRO FF,FRCLN +RREND2: AOS (P) + JRST RRNEX1 + +;^N -- MOVE TO BEGINNING OF NEXT LINE. (@L) +;WITH ARGUMENT , DOES @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 ;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 + +;F^E$ - REPLACE STRING INTO BUFFER STARTING AT POSITION . +;:F^E$ - REPLACE IN QREG (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 ^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 ;,I - INSERT 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 + +;:I -- INSERT 1 CHAR IN QREG. +;,:I -- INSERT COPIES OF CHARACTER. +;:I* -- RETURNS A STRING CONTAINING THE CHARACTER . +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 - 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+ + HRRZ C,A + SUB C,(P) ;C HAS - + ADD A,[1,,1] ;,, + 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 + 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 + 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 + 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 -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 + +;FSWORD$ RETURNS WORD OF BUFFER CONTAINING CHARACTER AFTER +;,FSWORD$ ALSO SETS THAT WORD TO . 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 + +;,F^G - DO A LOCAL VARIABLE SWAP FOR THE EMACS BUFFER TABLE. +; IS THE BUFFER WHICH IS THE EMACS BUFFER TABLE. +; IS THE WORD OFFSET (VIRTUAL) OF AN ENTRY IN IT. +; 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 , PUT IN C AND 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 ;- + 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, + +;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,[#] + 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" - + 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]$ POPS QREG PDL INTO THAT FLAG. +;[ ;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[$ PUSHES THAT FLAG ONTO THE QREG PDL. +;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$, 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 - => NO ECHO, BUT -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 + +;,FS U HSNAME$ RETURNS IN SIXBIT THE HSNAME OF ON MACHINE . +;BOTH ARGS SHOULD BE SIXBIT. 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 + +;,FS UMAIL$ SETS DEFAULT FILENAMES TO MAIL FILE OF ON . +;BOTH ARGS SHOULD BE SIXBIT. 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 [ + 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 + 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: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 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 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/ 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 !! 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 + +;F^B$ - RETURNS -1 IF DOES NOT OCCUR IN ; +; OTHERWISE RETURNS THE POSITION OF THE FIRST OCCURRENCE +; (0 IF IS THE FIRST CHARACTER OF ). +;AT CALL, IS IN C. THIS COULD BE SMARTER: +; IF IS FOUND IN THE MIDDLE OF A SUBSTITUTED QREG WITHIN , +; WE COULD JUST POP OUT OF IT RATHER THAN READING THROUGH IT. +;,F^B$ SKIPS CHARS OF BEFORE LOOKING FOR . +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 . +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 . NOW IGNORE REST OF STRING + JRST POPJ1 ;AND RETURN THE VALUE, ALREADY IN A. + +;HERE FOR @F^B$ - FIND NEXT OCCURRENCE IN THE BUFFER +;OF A CHARACTER NOT IN , AND RETURN .,. +;@:F^B$ RETURNS .,. +;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 ,, WE JUMP TO AND THEN SCAN TOWARD . +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 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 ,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 - PUT TEXT INTO 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*$ -- 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 + +;^Z -- INSERT 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$ -- VALRET . +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$ 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". +; 0FZ$ "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$ 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$ 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 /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 + 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 + 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=$ OR F=$ +;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. +;:FC RETURNS , 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. +;:() WHERE IS A QREG CONTAINING A Q-VECTOR, IS A SUBSCRIPTING EXPRESSION. +; IN THIS CASE, THE QREG IS ONE WORD IN THE QVECTOR. +; 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 :(), 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) +;:F^^ -- IF 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 ;: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. +;FO RETURNS THE VALUE OF THE VARIABLE IF IT IS DEFINED, 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 - RETURN LENGTH OF TEXT IN , OR -1 IF NOT TEXT. +QLEN: PUSHJ P,QREGX + PUSHJ P,QLGET0 +RETM1A: SKIPA A,[-1] + MOVE A,B + JRST POPJ1 + +;Q - RETURN CONTENTS OF QREG AS A NUMBER. +QREG: AOS (P) + JRST QREGX + +;% - INCREMENT , 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 - PUT NUMERIC ARG IN . 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 + 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 + +;FP RETURNS AN INDICATION OF '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 COMMAND -- INSERT QREG IN BUFFER BEFORE PT. +;,G -- GET RANGE OF CHARS , FROM QREG. +;FS INSLEN$ IS SET TO # CHARS INSERTED. +;:G -- RETURN THE 'TH CHARACTER OF . +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 , ] + 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 :G. + 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 + +;[ - PUSH 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, + +;[[ ;] - POP FROM QREG PDL INTO . ]* 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 + +;FS QP HOME$ RETURNS A STRING WHICH IS THE NAME OF THE Q-REG THAT WAS +;PUSHED INTO PDL SLOT . :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 :FSQPHOME$ @FSQPHOME$ = FSQPHOME$. +FSQPHO: TRZN FF,FRARG + TYPRE [WNA] + TRZE FF,FRUPRW + JRST FSQPH2 + CALL FSQPRG ;FIND SLOT . + 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*Q0/] ;] + 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 + +; FS QPSLOT $ -- RETURNS CONTENTS OF SLOT . +;,FS QPSLOT $ ALSO SETS THE SLOT TO . +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. + +; FS QPUNWIND $ -- UNWINDS QREG PDL TO LEVEL . +;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 U0/] ;] + JRST FSQPU6 + +SUBTTL M SUBROUTINE CALL COMMAND + +;M SAVES CURRENT EXECUTION POINTERS AND THEN EXECUTES CONTENTS OF . + ; MAY CONTAIN TEXT OR THE ADDRESS OF A BUILT-IN FUNCTION. +;:M JUMPS INTO THE STRING IN 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) + +;FSBACKTRACE$ - INSERT IN THE BUFFER THE TEXT OF THE MACRO IN FRAME . +;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 + +;FS BACK PC$ - RETURN RELATIVE PC (OFFSET FROM 1ST CHAR) OF MACRO IN FRAME . +;,FS BACK PC$ - SET RELATIVE PC OF THAT FRAME TO . +; 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 + +;FS BACK QP PTR$ - RETURN FS QP PTR$ OF BOTTOM OF QP FRAME +;BELONGING TO MACRO FRAME . 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 + +;FS BACK ARGS$ - RETURN ARGS OF MACRO FRAME . +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. + +;FS BACK STRING$ - RETURN STRING POINTER TO MACRO BEING EXECUTED IN FRAME . +;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 + +;\ WRITE IN BASE IN ..E, INTO BUFFER. :\ CONS INTO STRING AND RETURN IT. +;,\ USE 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$ JUMPS TO !!. ":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, + +;F;$ - THROW TO , RETURNING 1 (OR F;'S ARG, IF ANY) FROM THE F<...>. +FSEMIC: TRZN FF,FRARG + MOVEI C,1 + SAVE C + CALL OARG ;READ 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 . + 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 + 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 ;:A - APPEND 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* ;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 - +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 - + 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 + +;FY - READ 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 (, ). + 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 + +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,*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) ;:^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?$ 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,*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 ;- + 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,*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 + +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 + 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: 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 + 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. + 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 ,,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 + +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 + 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,*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,[-<_-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) ;- + 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,*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:*.*.*) + 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 + 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,() + 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 ET0 ]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 + +;= PRINTS . +;,= PRINTS ,. +;,= PRINTS ,. +;@ => PRINT IN ECHO AREA. : => OMIT THE . +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$ -- DISPLAY +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$ -- TYPE +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 -, 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 ;- . + 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 -@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, 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 + +;,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* +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==50. ;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 TVI950,TV5TB,TV9I ;TeleVideo (tvi912 -padding +%tolid) +DEFTYP BITGRA,BBNTB,BBNI ;BBN Bitgraph +DEFTYP AJ510,AJ510T,AJ510I ;Anderson Jacobson 510 [Joshua Brodsky @UDC] +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 + 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 + 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 + MOVE Q,A + CALL DELCH1 + JRST POPQJ + +;DELETE C(Q) CHARACTERS. CLOBBERS Q. +DELCH1: JUMPE Q,CPOPJ + 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* + 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 + 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 + 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: 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 + 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 +.INSRT TECTRM.MID ;GET TERMINAL HANDLERS + +OUTNSP: MOVEI A,40 +OUTN: SAVE Q + PBOUT + SOJG Q,.-1 + REST Q + RET + +;OUTPUT AN ALTMODE FOLLOWED BY THE CHARACTER IN A, PRESERVING ALL ACS. +OUTESC: SAVE A + SAVE B + MOVSI B,(ASCII//) + DPB A,[260700,,B] + HRROI A,B + PSOUT + JRST POPBAJ + +;PAD WITH A SPECIFIC NUMBER OF RUBOUTS (IN A). +EXPPAD: SAVE B + CALL EXPPD1 ;OUTPUT THEM ALL. + JRST POPBJ + +;PAD FOR A SPECIFIC LENGTH OF TIME. +;A CONTAINS THE NUMBER OF MSEC. WE CLOBBER A AND B. +TIMPAD: SKIPGE B,PADCHR ;PADCHR NONZERO MEANS WAIT INSTEAD OF PADDING. + JRST [ SAVE A + MOVEI A,.PRIOU + DOBE + REST A + DISMS + RET] + IMUL B,[<.BYTE 7 ? 1 ? 1 ? 1 ? 1 ? 1>_-1] + LSH B,1 + CAME B,TIMPDS ;CHECK THAT WE HAVE THE RIGHT PAD CHARACTER + JRST [ MOVEM B,TIMPDS + MOVE B,[TIMPDS,,TIMPDS+1] + BLT B,TIMPDE-1 + JRST .+1] + SKIPN B,OSPEED + MOVEI B,DEFOSP ;IF UNKNOWN, USE DEFAULT + IMUL A,B + CAIGE A,8000. ;IF MUCH LESS THAN 1 CHAR NEEDED, DON'T SEND ANY. + RET + ADDI A,10000.-1 + IDIVI A,10000. ;GET NUMBER OF CHARS TO SEND +EXPPD1: CAIL A,100. ;WE ONLY HAVE 100. RUBOUTS, + JRST [ SAVE A ;SO IF WE NEED MORE THAN THAT, + MOVEI A,100. ;SEND 100. AT A TIME. + CALL EXPPD2 + REST A + SUBI A,100. + JRST .-1] +EXPPD2: JUMPE A,CPOPJ + PUSH P,C + MOVN C,A + MOVEI A,.PRIOU ;NUMBER OF RUBOUTS TO OUTPUT + HRROI B,TIMPDS + SOUT + JRST POPCJ + +; SIMULATE CLEAR-TO-EOL ON A TERMINAL WHICH DOESN'T HAVE IT. +; THE DISPATCH VECTOR ENTRY FOR CLEAR-TO-EOL (AND THE ONE FOR CLEAR EOS, +; IF THAT IS ALSO MISSING) SHOULD CALL THIS ROUTINE. + +;IF EOLFLG IS NEGATIVE, IT IS MINUS THE NUMBER OF COLUMNS THAT REALLY NEED CLEARING. +;THIS IS USED WHEN IT IS KNOWN THAT THE LINE USED TO BE BLANK PAST +;A CERTAIN POINT. +EOLSIM: JSR SAVABC ; SAVE ACs + SKIPGE C,EOLFLG ; NO. OF SPACES SET? + JRST EOLSI1 ; YES, USE THAT + HRRZ C,TTLPOS ; GET CURRENT POSITION + SUB C,NHLNS + SUBI C,1 +EOLSI1: HRROI B,SPACES + MOVEI A,.PRIOU + SOUT + SETZM EOLFLG + MOVE B,TTLPOS + XCT @CURPSX + JRST POPCBA + +SPACES: ASCII / / +];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 + 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,[ + 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 + 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 + 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: 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 +];20X +IFN 20X\SUMTTF,[ + MOVE B,TTLPOS ;LET MONITOR KNOW WHERE WE ARE ON THE LINE + 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,[ + SKIPGE PAGMOD ;IF NOT MESSING WITH PAGE MODE + JRST DOSTIW +];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: TRZN B,(C) + JRST DOSTIW + SFMOD + 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 + &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. + 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,,FSSTRR ;FN1 OF FILE NOW OPEN FOR READING. +IFN ITS,FLG IFFN1,INFILE,FSFFN1 +IFN TNX,FLG IFFN2,,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,,FSSTRR ;SNAME OF FILE NOW READING FROM. +IFN ITS,FLG IFSNAM,INFILE,FSFDIR +IFN TNX,FLG IFVERS,,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 + 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,,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. + 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 ^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. + 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 +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 ;^ +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 / î / ;CR. 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*<&<-2000>> +INISRB==INIBUF +INISRE==INISRB+5*<1+STBLSZ> +INIBEG==INISRE+5 +INITOP==INIBEG+5 + +END BOOT diff --git a/src/syseng/lfn.3 b/src/syseng/lfn.3 new file mode 100755 index 00000000..ea638a15 --- /dev/null +++ b/src/syseng/lfn.3 @@ -0,0 +1,655 @@ +.BEGIN LFN ;-*- Midas -*- + +SUBTTL Routines for parsing and printing filenames + +;Basic conventions: +;We assume that there are ACs A, B, C, D and E, not necessarily consecutive, +;and that the stack is in P. No routine touches any other acs. +;No routine clobbers ACs other than the ones it is documented to clobber. +;All code generated is pure, some local storage is allocated with .SCALAR. + +;Most of the routines deal with 'filename blocks'. +;A filename block consists of any number of two-word entries. Each entry +;describes one component of a filename. The component may either be sixbit, in +;which case word 1 has the sixbit word and word 2 has -1 in rhs; or it can be +;ascii, in which case word 1 has a bp and word 2 has the length in rhs. Either +;way, lhs of word 2 has the component type: NAMFLG if this is a name component, +;DIRFLG if this is a directory component, DEVFLG if this is a device component. +;None of the entries include the terminating character (i.e. the : or ; or +;whatever). +;Filename blocks are described by aobjn pointers: "-2*N,,address" where +;N is the number of entries starting at the address. +;Main routines in this package are: + +;IFN $$PARSE: parsing routine +;PARFN(D/byte pointer, A/aobjn pointer to space available in filename block) +; Parse filename from string in D to block in A. +; D is advanced (so ldb x,d gets the terminating byte), A gets an aobjn +; pointer to the space actually used in the block. lh(E) gets flags (i.e. +; NAMFLG,DIRFLG,DEVFLG) of all the components present, and rh(E) gets the +; number of NAME components. +; Skips unless data was lost because there were more components than slots in +; the block. +; If A is 0, we don't actually write anything, just count the words that would +; be required (and return with A/-N,,0). This case always skips. +; +; Requires RFNTRM to be a routine which skips if the character in A should +; terminate the filename or start switches. It must not change any AC's. It +; will never be called with ":", ";", space, tab, ^Q, ^A, ^X, ^B, ^Y or ^@. +; For reading JCL, a typical RFNTRM might skip for ^C,^M and ^_. For parsing +; asciz strings, RFNTRM: RET would be sufficient. +; +; If $$SWITCH is on, and if RFNTRM skips for "/" or "(", it will start a +; switch rather than terminating the filespec. In that case you must define +; a routine SWITCH to process a switch. It will be called with the first +; char of the switch in A, and may read more characters off of D. +; If it skips, PARFN will re-read the character D points to. +; SWITCH may clobber A,B,C,E and may advance D as appropriate. + +;IFN $$MERGE: merging routines +;All merging routines take an input filename block in A, a default filename +;block in B and a count in E which specifies how to to do the merging for NAME +;components. It is the count of how many NAMEs are 'normal'. If A has n < E +;names, than A and B are merged by taking first the n names from A and then +;(n+1)st and so on from B. If A has n >= E names, than only A's names are +;used, and B is ignored. The idea is that a filespec with at least E names is +;fully specified by itself and thus should not be merged. +;E may be -1, meaning infinity. +;The merging of DIR and DEV components is always done with a 'merging count' +;of 1. +;A "^X" or "^A" in the input block refers to the first NAME in the default +;block, and a "^Y" or "^B" refers to the second NAME. +; +;BMERGE(A/input,B/default, C/output block, E/NAME merging count) +; Merge the two blocks into the output block in C. C should be an aobjn +; pointer to space available in the block, and on return it will describe the +; space used. BMERGE skips if there was enough room for all components. +; If C is 0, we don't actually write anything, just count the words that would +; be required (and return with C/-N,,0). This case never skips. +;SMERGE(A/input,B/default, C/output BP, D/byte count, E/NAME merging count) +; Merge the two blocks and print the result, followed by a null, into the +; BP in C. D should be the size of the output buffer (including room for the +; null). On return, C points to the terminating null and D contains the +; number of bytes written (including the null). SMERGE skips if there +; was enough room in the buffer. Note that the output is guaranteed to be +; null-terminated, even if SMERGE doesn't skip due to truncation. +;MCOUNT(A/input,B/default, E/NAME merging count) +; Count the space required for the merge. On return C contains the +; number of words which would be necessary to do a BMERGE, and D the +; number of bytes necessary to do an SMERGE. MCOUNT never skips. + +;IFN $$GNAME: routines for selecting parts of a name. +;All selecting routines take a filename block in A and a description of +;the components to select in E. lh(E) should have DEVFLG or DIRFLG or +;NAMFLG. If rh(E) is 0, all components of the type given in lh(E) are +;selected. If rh(E) is positive, it is the number of the component to +;select (1 = first, etc.). If rh(E) is negative, it is the number from the +;end of the component to select (-1 = last, etc.). +; +;BGNAME(A/input, C/output block, E/selector) +; Copy the specified component(s) into C. C should be an aobjn pointer +; to space available in the block, and on return it will describe the +; space used. BGNAME skips if there was enough room in C for all the +; components. If C=0, we don't actually write anything, just count the +; words that would be required (and return with C/-N,,0). This case never +; skips. +;SGNAME(A/input block, C/output BP, D/byte count, E/selector) +; Print the specified component(s) into the BP in C, followed by +; a terminator char (":" or ";" or " "). On return, C points to the +; last byte and D contains the number of bytes written (which will be +; 0 if no matching components were found). SGNAME skips if there was +; enough room in the buffer. Note that SGNAME does *not* write a terminating +; null. +;GCOUNT(A/input block, E/selector) +; Count the space required for the specified component(s). Returns with +; C containing the number of words which would be necessary to do a BGNAME, +; and D the number of bytes necessary to do an SGNAME. GCOUNT never skips. + +;Printing routines: +;IFN $$PFNRAW: +;RAWPFN(A/input block, C/output BP, D/byte count) +; Print the filename into buffer, in the order of components specified in +; A, followed by a null. On return C points to the null and D contains the +; number of bytes written (including the null). Skips if there was enough +; room in the buffer (but note that the terminating null is written even if +; truncation occured). +;IFN $$PFN: +;PFN(A/input block, C/output BP, D/byte count) +; Like RAWPFN but always writes the components in the standard order (all +; devices first, then directories, and finally the filenames). +;IFN $$PFNMCH: +;PFNMCH(A/input block, C/output BP, D/byte count) +; Like PFN, except if the first device component is "DSK" (case independent) +; we output the machine name instead. If $$MNAME is set, the user must define +; MNAME to point to a word holding this machine's name in sixbit. Otherwise, +; we look it up from the system. + +IFNDEF $$SWITCH,$$SWITCH==0 +IFNDEF $$PARSE,$$PARSE==0 +IFNDEF $$MERGE,$$MERGE==0 +IFNDEF $$GNAME,$$GNAME==0 +IFNDEF $$PFNRAW,$$PFNRAW==0 +IFNDEF $$PFN,$$PFN==0 +IFNDEF $$PFNMCH,$$PFNMCH==0 +IFNDEF $$MNAME,$$MNAME==0 + +IFN $$SWITCH,$$PARSE==1 +IFN $$PFNMCH,$$PFN==1 + +NAMFLG==:1_35. +DIRFLG==:1_34. +DEVFLG==:1_33. + +SIXFLG==:1_17. + +.AUXIL + +;PRINT VERSION NUMBER +.TYO6 .IFNM1 +.TYO 40 +.TYO6 .IFNM2 +PRINTX/ included in this assembly. +/ + +IFN $$PARSE,[ +;PARFN(D/bp,A/block) -> A/filled-in block, E/flags,,NAME count, D/advanced +;Skips if block big enuff. +PARFN: push p,[0] ;Final E + push p,c + push p,b + + push p,a ;Save original block + move b,a ;B= current block aobjn pointer + tlnn d,-1 ;D= input bp + hrli d,440700 +parfn0: setz e, ;E= component length + move c,d ;C= start of component +parfn1: ildb a,d + caie a,": + cain a,"; + jrst parfs + caie a,40 + cain a,^I + jrst parfs + caie a,^X + cain a,^Y + jrst parfnx + caie a,^A + cain a,^B + jrst parfnx + caie a,^Q + jrst parfn2 + move a,d ;Peek ahead + ildb a,a + jumpe a,parfn3 ;Null terminates even if quoted + ibp d ;Else accept the quoted char + addi e,2 + jrst parfn1 +parfn2: jumpe a,parfn3 + pushj p,RFNTRM + aoja e,parfn1 +parfn3: jumpg e,parfs +ifn $$switch,[ + cain a,"/ + jrst parssw + cain a,"( + jrst parpsw +] + hrri b,0 + pop p,a + skipe a ;If was 0 to start with, always enough room + jumpg b,parfn4 + sub a,b + aos -3(p) +parfn4: pop p,b + pop p,c + pop p,e + popj p, + +parfnx: jumpg e,parfs ;Here when got ^X/^Y + ildb a,d ;Allow "^X:" etc. + aoja e,parfs + +parfs: jumpe e,parfn0 ;Here to save a component + hrli e,(NAMFLG) + cain a,": + hrli e,(DEVFLG) + cain a,"; + hrli e,(DIRFLG) + jumpge b,.+3 + movem c,(b) + movem e,1(b) + add b,[2,,2] + trz e,-1 + iorm e,-3(p) + tlne e,(NAMFLG) + aos -3(p) +parfs2: ldb e,[300600,,d] ;Back up to re-read terminator + lsh e,30. + add d,e + jrst parfn0 + +ifn $$SWITCH,[ +;Here to parse a /switch +parssw: push p,b ;Give him free reign over b + ildb a,d + caie a,0 + cain a,^M + jrst parss1 + cail a,140 ;Switches get upcased + subi a,40 + pushj p,SWITCH + jrst parss2 +parss1: pop p,b ;Here to re-read last char + jrst parfs2 +parss2: pop p,b ;Here to keep reading + jrst parfn0 + +;Here to parse a (switch) +parpsw: push p,b +parps0: ildb a,d +parps1: cain a,") + jrst parss2 + caie a,0 + cain a,^M + jrst parss1 ;CR ends even in switch list + cail a,140 ;Switches get upcased + subi a,40 + pushj p,switch + jrst parps0 + ldb a,d ;He skipped to re-read last char + jrst parps1 +];$$SWITCH + +];$$PARSE + +IFN $$MERGE\$$PFN,[ +IFN $$MERGE,[ +;MCOUNT: count size of merged filename +;A/input block, B/Default block, E/NAME merging count +;Return: C/# block words D/# string bytes +mcount: setzm mrgcnt + setz c, + movei d,savcnt + pushj p,merge0 + skipn mrgcnt ;If nothing there, + sos mrgcnt ;will write at least a null +cexit: tlz c,-1 + movn d,mrgcnt + popj p, + +;BMERGE: merge into block +;A/input block B/default block, C/output block, E/NAME merging count +;Return: C updated, skip if big enuff +bmerge: push p,d + push p,c + movei d,savaob + pushj p,merge0 +bexit: pop p,d + hrri c,0 + jumpe d,.+3 + jumpge c,.+3 + aos -1(p) + sub d,c + move c,d +popdj: pop p,d + popj p, +];$$MERGE + +;SMERGE: merge into string +;A/input block, B/default block, C/BP, D/size, E/NAME merging +;Return: C,D advanced. +smerge: push p,d + movem d,mrgcnt + tlnn c,-1 + hrli c,440700 + movei d,savstr + pushj p,merge0 + move d,(p) + came d,mrgcnt + jrst .+3 + ibp c + sos mrgcnt + setz d, + dpb d,c +sexit: pop p,d + skipge mrgcnt + popj p, + sub d,mrgcnt +popj1: aos (p) + popj p, + +;MERGE0: A/input block, B/default block, E/NAME merging count +;D/output routine, C/parameter for output routine +;Clobbers D + .scalar mrgdef +merge0: push p,e + movem b,mrgdef +IFN $$MERGE\$$GNAME,movem d,mrgout + movsi e,(DEVFLG) + movei d,1 + pushj p,mergef + movsi e,(DIRFLG) + movei d,1 + pushj p,mergef + movsi e,(NAMFLG) + move d,(p) + pushj p,mergef + move b,mrgdef +popej: pop p,e + popj p, + +;Merge components of type E from block in A, default in mrgdef, +;according to count in D. Output/count routine in mrgout, parameter in C. +;Clobbers B,D. +mergef: push p,a + tlz d,400000 ;Convert -1 to positive infinity + push p,mrgcnt ;Remember so can tell if got anything + pushj p,msrcha + move b,mrgdef + pushj p,msrchb +mergf1: jumpl a,mergf2 + jumple d,mergfx + move a,b ;Hit end before limit, switch to B + seto d, ;No more limit + jrst mergf1 +mergf2: pushj p,mcopnm + pushj p,nsrcha ;Advance A + pushj p,nsrchb ;Advance B + soja d,mergf1 +mergfx: pop p,d + tlnn e,(NAMFLG) ;Doing filenames + camn d,mrgcnt ;or didn't get anything, or not using mrgcnt + jrst popaj ;Ok as is. + movei d,40 ;Add a space, so get like + sosl mrgcnt ; DEV:DEV: DIR;DIR;DIR;DIR; NAME... + idpb d,c + jrst popaj + +;Might as well, exch a,b type thing is almost as long +msrchb: skipge b + tdne e,1(b) + popj p, +nsrchb: add b,[2,,2] + jrst msrchb +];$$MERGE\$$PFN + +IFN $$GNAME,[ + +;GCOUNT(A/block, E/selector) +gcount: movei d,savcnt + setzb c,mrgcnt + pushj p,gname0 +IFN $$MERGE,jrst cexit +.ELSE,[ +cexit: tlz c,-1 + movn d,mrgcnt + popj p, +] + +;BGNAME(A/block, C/output block, E/selector) +bgname: push p,d + push p,c + movei d,savaob + pushj p,gname0 +IFN $$MERGE,jrst bexit +.ELSE,[ +bexit: pop p,d + hrri c,0 + jumpe d,.+3 + jumpge c,.+3 + aos -1(p) + sub d,c + move c,d +popdj: pop p,d + popj p, +] + +;SGNAME(A/block, C/bp, D/size, E/selector) +sgname: push p,d + movem d,mrgcnt + tlnn c,-1 + hrli c,440700 + movei d,savstr + pushj p,gname0 +IFN $$MERGE\$$PFN,jrst sexit +.ELSE,[ +sexit: pop p,d + skipge mrgcnt + popj p, + sub d,mrgcnt +popj1: aos (p) + popj p, +] + +gname0: push p,a + push p,e +IFN $$MERGE,setzm mrgdef ;No default + movem d,mrgout + hrre d,e + trz e,-1 + jumpge d,gname3 +gname1: jumpge a,gname2 ;From end, so count first + tdne e,1(a) + aoj d, + add a,[2,,2] + jrst gname1 +gname2: move a,-1(p) + aojle d,popeaj +gname3: pushj p,msrcha + jumpge a,popeaj + sosg d + pushj p,mcopnm + add a,[2,,2] + jumpn d,gname3 + jrst popeaj +];$$GNAME + +IFN $$PFNRAW,[ +;;pfnraw(a/input,c/bp,d/count) +pfnraw: push p,d + push p,a + movem d,mrgcnt + tlnn c,-1 + hrli c,440700 +IFN $$MERGE,setzm mrgdef +pfnra1: jumpge a,pfnra3 + pushj p,mcopnm + move d,1(a) + tlnn d,(NAMFLG) + sosge mrgcnt + jrst pfnra2 + movei d,40 + idpb d,c +pfnra2: add a,[2,,2] + jrst pfnra1 +pfnra3: pop p,a +IFN $$MERGE,jrst sexit0 +.ELSE,[ move d,(p) + came d,mrgcnt + jrst .+3 + ibp c + sos mrgcnt + setz d, + dpb d,c +IFN $$GNAME,jrst sexit +.ELSE,[ pop p,d + skipge mrgcnt + popj p, + sub d,mrgcnt + aos (p) + popj p, +]] +];$$PFNRAW + +IFN $$PFN,[ +pfn: push p,b + push p,e +pfn1: setz b, + setz e, + pushj p,smerge + caia + aos -2(p) + pop p,e + pop p,b + popj p, +];$$PFN + +IFN $$PFNMCH,[ +pfnmc1: pop p,a + jrst pfn1 + +pfnmch: push p,b + push p,e + push p,a + pushj p,pfnmcp + jrst pfnmc1 +IFN $$MNAME,move b,mname +.ELSE [ .call [sixbit/sstatu/ ? repeat 5,[%clout,,b ? ] setzm b] + .lose %lssys +] + hrloi e,(DEVFLG) + exch b,(a) + exch e,1(a) + exch a,(p) + pushj p,pfn + caia + aos -3(p) + exch a,(p) + movem e,1(a) + movem b,(a) + pop p,a + pop p,e + pop p,b + popj p, + +pfnmcp: movsi e,(DEVFLG) + pushj p,msrcha + jumpge a,pfnmpx + move b,(a) + hrr e,1(a) + jumpge e,pfnmp1 + camn b,[sixbit/DSK/] + aos (p) +pfnmpx: popj p, + +pfnmp1: caie e,3 + popj p, + ildb e,b + caie e,"D + cain e,"d + caia + popj p, + ildb e,b + caie e,"S + cain e,"s + caia + popj p, + ildb e,b + caie e,"K + cain e,"k + aos (p) + popj p, +];$$PFNMCH + + +IFN $$MERGE\$$GNAME\$$PFN\$$PFNRAW,[ + +msrcha: skipge a + tdne e,1(a) + popj p, +nsrcha: add a,[2,,2] + jrst msrcha + +IFN $$MERGE\$$GNAME,.scalar mrgout + +;;Copy entry from A to C via @mrgout +;;If $$MERGE, process ^X/^Y via mrgdef. +mcopnm: push p,a + push p,e + push p,d +IFE $$MERGE,[ + move d,(a) + move e,1(a) +] +.ELSE [ + hrre e,1(a) + jumple e,mcopnx ;sixbit or empty, can't be ^X/^Y + move d,(a) + ildb d,d + cain d,^A + movei d,^X + cain d,^B + movei d,^Y + caie d,^X + cain d,^Y + skipn a,mrgdef + jrst mcopn1 + movsi e,(NAMFLG) + pushj p,msrcha + caie d,^X + pushj p,nsrcha + jumpl a,mcopnx +mcopn1: move a,-2(p) ;Hmm, no name in mrgdef, just copy the "^X" +mcopnx: move d,(a) + move e,-2(p) ;Get the type from original + move e,1(e) + hrr e,1(a) ;But count from actual +] +IFN $$MERGE\$$GNAME,pushj p,@mrgout +.ELSE pushj p,savstr + pop p,d +popeaj: pop p,e +popaj: pop p,a + popj p, + +IFN $$MERGE\$$GNAME,[ +;Do count, mrgcnt has -, C has fake aobjn pointer for block count +savcnt: pushj p,savstr ;Count string + ;jrst savaob ;Count block + +;Save to a block +savaob: jumpge c,savao1 + movem d,(c) + movem e,1(c) +savao1: add c,[2,,2] + popj p, +];$$MERGE\$$GNAME + +;Save to a string, mrgcnt has count, C has bp +;Clobbers A,D,E. + .scalar mrgcnt +savstr: push p,b + hrre b,e + jumpge b,savnm1 ;String + movei b,^Q ;Else sixbit. Remember that can't assume any +savnm6: ldb a,[360600,,d] ;acs are consecutive. + caie a,': + cain a,'; + caia + jumpn a,savnm7 + sosl mrgcnt + idpb b,c +savnm7: addi a,40 + sosl mrgcnt + idpb a,c + lsh d,6 + jumpn d,savnm6 +savnmx: movei d,40 + tlne e,(DEVFLG) + movei d,": + tlne e,(DIRFLG) + movei d,"; + sosl mrgcnt + idpb d,c + pop p,b + popj p, + +savnm1: sojl b,savnmx ;Here to do a string + ildb a,d + sosl mrgcnt + idpb a,c + jrst savnm1 +];$$MERGE\$$GNAME\$$PFN\$$PFNRAW + +.END LFN