; -*-MIDAS-*- ;ITS TECO and EMACS should serve as a lesson to all ;of what can be achieved when programmers' creativity is not crushed ;by administrators whose main concern is stifling humor, ;stamping out all possibility of enthusiasm, and forbidding ;everything that isn't compulsory. ;They were produced in a humane anarchy where one man designs, ;implements, and then documents the feature that inspires him. ;They were produced by people who could laugh enough to ;name many years of effort the Incompatible Timesharing System. ;Of course, the whole story is imaginary. Working conditions ;which do not crush the spirit can't be practical. ;You can't run a team that way if you expect to meet the deadline. ;TECO doesn't really exist; you were only dreaming it. ;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. ;You owe your improvements to us in return for what you see here. ;If anyone asks you for a copy, make sure he gets in touch with ;the MIT AI Lab so he can get the latest stuff. .SYMTAB 8001. ;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 20X, 20X==0 IFG ITS+10X+20X-1, .FATAL TWO OPERATING SYSTEMS SPECIFIED ; IF NO SYSTEM SPECIFIED THEN DEFAULT TO THE ONE WE'RE ASSEMBLING ON. IFE ITS\10X\20X,[ IFE .OSMIDAS-SIXBIT/ITS/, ITS==1 IFE .OSMIDAS-SIXBIT/TENEX/, 10X==1 IFE .OSMIDAS-SIXBIT/TWENEX/,20X==1 ] IFE ITS\10X\20X, .FATAL NO OPERATING SYSTEM SPECIFIED TNX==:10X\20X ; TNX MEANS EITHER TENEX OR TWENEX IFN ITS,COMNDF==0 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 .DECSAV IFN .OSMIDAS-SIXBIT/TENEX/,[ IFN .OSMIDAS-SIXBIT/TWENEX/,[ IF1 [ .INSRT SYS:TNXDFS .TNXDF .INSRT SYS:TWXBTS ]]] ] GLITCH==177 ALTMOD==33 IFN ITS,EOFCHR==3 ;PADDING CHARACTER FOR FILES. IFN TNX,EOFCHR==0 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 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==40 ;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 GCTBL,GCTBL==100 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. 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 TSOPEN A,B .OPEN A,B .LOSE %LSFIL TERMIN DEFINE SYSCAL A,B .CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))] TERMIN DEFINE UTFARG DEFDEV ? DEFFN1 ? DEFFN2 ? DEFDIR TERMIN DEFINE 4WDARG (START) START ? START+1 ? START+2 ? START+3 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 ] 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. 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$. 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 IFNDEF DISBFL,DISBFL==MXNHLS/4+1 ;LENGTH OF TTY IOT BUFFER. IFN TNX,[ SGTTYP: 0 ;PLACE TO SAVE GTTYP TERMINAL INDEX PADCHR: 177 ;CHARACTER FOR PADDING, -1 => USE DELAY INSTEAD OF PADDING. TIMPDS: .BYTE 7 ;ASCIZ STRING OF RUBOUTS OR WHATEVER REPEAT 100.,177 .BYTE TIMPDE:: C1PADF:: ;USED BY C100 FOR HOLDING PAD MULTIPLIER VT1BUF:: ;USED ALSO BY VT100 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. 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: 0 ;NONZERO => ENABLE USE OF SEQUENTIAL PAGING (.PAGAHD). SEQPGF: 0 ;NONZERO => SEQUENTIAL PAGING IN USE AT THE MOMENT. 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. 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. MACHIN: 0 ;SIXBIT NAME OF MACHINE. FDRBUF: BLOCK FDRBFL ;BUFFER FOR READING FROM CHRAND. FDRBFE: _29. FDRP: 0 ;BYTE POINTER TO FDRBUF 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) ] 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 ECODPF: 0 ;FS ECHO DISPLAY: WAS ^P LAST CHARACTER SEEN? 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) OPNJFN: 0 ;JFN BEFORE OPENF CHFILI: 0 ;INPUT FILE JFN CHFILO: 0 ;OUTPUT FILE JFN DEFDEV: ASCII /DSK/ ;DEFAULT DEVICE 0 DEFDIR: BLOCK 20 ;DIRECTORY NUMBER 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. ] ;[ 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. 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: ;"\" COMMAND WITH ARG "PRINTS" INTO THESE WORDS. IFN COMNDF,LTABS==120. .ELSE LTABS==100. STAB: ;HOLDS STRING ARG DURING MANY COMMANDS (O, FO, F^B, F^G ...) GCTAB: BLOCK GCTBL IFG LTABS-GCTBL,BLOCK LTABS-GCTBL ;USES OF GCTAB: ;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] ? [.FNAM2] ? ['.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 ] ] IFN 10X, HRROI 2,[STRCNC [TECPUR.SAV;]\.FNAM3 ] RADIX 8 GTJFN .VALUE IFN 20X,[IOR 1,[.FHSLF,,GT%ADR] MOVE 2,[PURP1*2,,PURPL*2] ] IFN 10X,HRLI 1,.FHSLF GET ] 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. RROLDZ: 0 ;VALUE OF Z, AT TIME OF LAST REDISPLAY THAT WASN'T INTERRUPTED BY TYPEIN. RROLZV: 0 ;VALUE OF ZV, AT THAT TIME. 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. 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,,Q ? .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, MOVEM Q,MSNAME ;THEN OUR .SNAME IS THE MSNAME. MOVEM Q,DEFDIR ;AND ALSO SHOULD BE OUR DEFAULT SNAME. 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 SYSCAL SSTATU,[REPEAT 6,[ ? %CLOUT,,MACHIN ]] .LOSE %LSSYS .I DEFDEV=MACHIN ];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 IFN 10X,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: IFN TNX,[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 A,[.BP TT%PGM,B] MOVEM A,PAGMOD ; SAVE INITIAL TERMINAL PAGE MODE SETTING ];20X ];TNX JUMPN CH,GOZ4B GJINF IFN 20X,[ 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 ] IFN 10X,[ 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 SAS. 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 MOVE A,OSPEED CAIGE A,10 ;AVOID LOSING ON OLD ITS ON WHICH OSPEED IS A SPEED CODE. SETZM OSPEED SYSCAL TTYVAR,[%CLIMM,,CHTTYO ? ['SMARTS] ? %CLOUT,,TTYSMT] SETZM TTYSMT .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] 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,[MOVEI A,.CTTRM RFMOD LDB C,[.BP TT%LEN,B] ;TERMINAL LENGTH MOVEM C,NVLNS LDB C,[.BP TT%WID,B] ;TERMINAL WIDTH MOVEM C,NHLNS MOVEI B,.MORSP ;READ TTY'S SPEED MTOPR 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 ] IFN 10X,SETZM OSPEED MOVE C,TTYTBS(CH) ;GET DISPATCH VECTOR FOR TERMINAL IFN 20X,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 MOVEM A,TTYOPT IFN 20X,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 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,[ LDB C,[.BP (%TOFCI),A] ;CAN IT GENERATE BONA FIDE HIGH ORDER BITS? MOVEM C,FCITYI ;YES, DONT MISTAKE THEM FOR PARITY THEN ] 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. CALL ECHOCR ;FRESH LINE IN ECHO AREA. SKIPE A,TTYMAC ;RUN FS TTY MAC$ TO RESET PARAMETERS. JRST MACXQ RET SUBTTL ECHOING CONTROL IFN ITS,[ ;REINITIALIZE TTYSTS, TTYST1, TTYST2; ;TURN ON ECHOING, AND SET ECHOFL TO INDICATE THAT WAS DONE. SETTTM: .CALL RTTYS1 .VALUE MOVE TT,TTYST1 MOVE TT1,TTYST2 ANDCM TT,[202020,,202020] ;HAVE ECHOING ON IFF ANDCM TT1,[202020,,202020] ;FS ECHOLINES $ IS >=0. SKIPL NELNS IOR TT,[202020,,202020] SKIPL NELNS IOR TT1,[202020,,200020] TLO Q,%TSCLE+%TSACT+%TSMOR SKIPN RGETTY TLZ Q,%TSMOR TLZ Q,%TSNEA\%TSINT\%TSSAI .CALL STTYS1 .VALUE SETOM ECHOFL MOVEM Q,TTYSTS RET TTYAC2: HRROS (P) ;INTERRUPT ON NEXT INPUT CHARACTER. CAIA TTYAC1: HRRZS (P) ;ACTIVATE ON NEXT INPUT CHARACTER. TTYAC4: SAVE Q SAVE TT SAVE TT1 SAVE CH .CALL RTTYS1 .LOSE %LSFIL TLZ Q,%TSINT TLO Q,%TSACT SKIPGE -4(P) TLO Q,%TSINT .CALL STTYS1 .LOSE %LSFIL REST CH REST TT1 REST TT JRST POPQJ RSSB: SETZ SIXBIT /CNSGET/ %CLIMM,,CHDPYO %CLOUT,,NVLNS %CLOUT,,NHLNS %CLOUT,,TT ;TCTYP %CLOUT,,TT ;TTYCOM 400000+%CLOUT,,TTYOPT RTTYS1: SETZ SIXBIT \TTYGET\ %CLIMM,,CHTTYI %CLOUT,,TT %CLOUT,,TT1 %CLOUT,,Q %CLOUT,,CH 400000+%CLOUT,,CH ;TCTYP VARIABLE STTYS1: SETZ SIXBIT \TTYSET\ %CLIMM,,CHTTYI TT TT1 SETZ Q ] IFN TNX,[ ;RETURN TECO INTERNAL TTY TYPE IN CH. RTTYTP: MOVEI 1,.CTTRM GTTYP ; GET TERMINAL TYPE MOVEM B,SGTTYP ; SAVE TYPE FOR DPYRST CAMN 2,[SIXBIT /4023/] ; BBN'S WAY OF DOING TTY TYPES MOVEI 2,TK4023 CAME 2,[SIXBIT /4024/] ; SAME THING AS 4025 CAMN 2,[SIXBIT /4025/] MOVEI 2,TK4025 CAMN 2,[SIXBIT /HP/] MOVEI 2,HP2645 CAMN B,[SIXBIT /C100/ ] MOVEI B,C100 CAMN B,[SIXBIT /T1061/] MOVEI B,TL1061 MOVE CH,TTYTYP(2) ; 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 SFMOD IFN 20X,[ SKIPGE PAGMOD ; WANT PAGE MODE LEFT ON? JRST .+4 ; YES, DONT MESS WITH IT JUMPE CH,SETTM1 TRZE 2,TT%PGM ; TURN OFF PAGE MODE ON DISPLAY STPAR ] 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 10X,MOVE C,[.BYTE 2 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 3 ? 1 ? 1 ? 1 ? 3] .ELSE MOVE C,[.BYTE 2 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 3 ? 1 ? 1 ? 1 ? 1] 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 IFN TNX,[ EXCH A,CH PBIN TYIIOT: SKIPN RGETTY ;ON PRINTING TERMINAL IFN 10X, CAIE A,37 ;ON 10X CONVERT 37 TO CR IFN 20X, CAIE A,^M ;ON 20X, AFTER A CR, JRST TYI5 IFN 20X,PBIN ;FLUSH THE LF 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 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 FSTBBK: IBP TYIBFQ ;FS .TYIBACK$: BACK UP TYIBFP ONE CHARACTER. IBP TYIBFQ ;ADVANCE IT TWICE, THEN BACK UP A WORD. SOS A,TYIBFQ CAMN A,[001400,,TYIBUF-1] ADDI CH,TYIBSZ ;IF BACK BEFORE START OF BUFFER, WRAP TO END. MOVEM A,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 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 RFPTR SETZ B, ADDI B,4999. SAVE C IDIVI B,5000. ;GET NUMBER OF PAGES IN FILE REST C SAVE A 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 MOVE A,[.FNAM2] .VALUE [ASCIZ \ A/ ..UFILE+2/ 1Q ..UFILE+3/ 1'.TECO. ..UFILE+1/ 1'TECPUR :Purified  :PDUMP\] JRST INIT ] IFN TNX,[ PURIFY: SKIPE RUNFLG .VALUE SETOM PUREFL MOVSI 1,(GJ%SHT) ;FIRST WRITE OUT SYMBOL TABLE RADIX 10. IFN 10X,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 10X,HRROI 2,[STRCNC [TECO.SAV;]\.FNAM3 ] .ELSE HRROI 2,[STRCNC [TECO.EXE.]\.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 10X,HRROI 2,[STRCNC [TECPUR.SAV;]\.FNAM3 ] .ELSE HRROI 2,[STRCNC [TECPUR.EXE.]\.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 JRST SETP1 ;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 ;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 A MOVEI A,^G PBOUT REST A] JRST FSECO6 FGCMDP: JUMPE C,CPOPJ ;THERE WS NO ERROR => DON'T PRINT ERROR MESSAGE. TRZE FF,FRCLN CALL [ SKIPN ERRECH 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 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 DEFDEV, ETC. 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. CALL LFILE ;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: MOVE A,OPNJFN RLJFN JFCL 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,[MOVE C,[4,,BAKTAB+4] BLT C,BAKTAB+10 ;GETER ON TENEX SMASHES 4-10 ] GETER IFN 10X,[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,[070100,,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,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 IFN ITS,[.IOT CHECHO,["^] .IOT CHECHO,["G] ] IFN TNX,[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,SETP1 ;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. 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,SETP1 ;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,SETP1 ;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 ] IFN 10X,[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. 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. 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,Z ;ON THE SAME LINE AS THE FIRST CHANGE? ADD A,RROLDZ 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] 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 JRST [ CALL CLREOL ; AND CLEAR THE PART WE WANT TO CLEAR, JRST RRLP2E] MOVE T,CHCRHP ; OR ARRANGE FOR IT TO BE CLEARED WITH SPACES SUB T,LINEND(BP) ; AFTER THE LINE IS OUTPUT. MOVEM T,EOLFLG 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,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: 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,Z SUB T,RROLDZ ;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 RROLDZ=Z .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 MOVEM T,(CH) ;PREVENT RRARGF FROM BEING CALLED. ;COME HERE IF STOP DISPLAYING SINCE KNOW NO MORE DISPLAY NEEDED. RRDISF: MOVE P,DISPRR .I RROLZV=ZV MOVE T,Z SUB T,RROLDZ ADDM T,RROLDZ 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 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,Z SUB CH,RROLDZ ;NOW RELOCATE LINBEGS OF ALL LINES PAST OLD RRMNVP THRU NEW RRMNVP, JUMPE CH,RRLID6 RRLID4: AOS BP CAMLE BP,RRMNVP ;SINCE LINBEGS OF ALL LINES ABOVE RRMNVP ARE SUPPOSED TO BE JRST RRLID6 ;CORRECT WITHOUT NEEDING RELOCATION. ADDM CH,LINBEG(BP) JRST RRLID4 RRLID6: 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 Z, RATHER THAN RROLDZ). RRLID2: SETOM RRIDLB SETZM RRIDBK MOVE OUT,RROLDZ SUB OUT,Z ;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,Z SUB TT1,RROLDZ 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,Z ;GET ADDR OF BEGINNING OF TEXT THAT CAN BE SAVED IF MOVED UP OR DOWN, SUB TT1,RROLDZ ;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, DON'T DISPLAY. JRST RRBTCR ;WE COULDN'T DO ANYTHING BUT ^L; LET USER DECIDE ON THAT. TRNE FF,FRARG2 JRST RRTTID ;JUMP IF IT'S AN INSERT/DELETE OPERATION. CALL RRMAC3 SKIPGE RRMNVP RET MOVE CH,ECHCHR ;DON'T DO IT OUR WAY IF COMMAND HAS ALREADY TYPED OUT. AOJE CH,CPOPJ 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 ;UNLESS WE'RE ON THE SAME LINE, OR THE NEXT ONE, JUMPL A,CPOPJ CAIL A,2 ;DON'T JUST GO OFF AND PRINT LOTS OF GARBAGE; RET ;LET USER DECIDE WHETHER TO REDISPLAY THE BUFFER. 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 ;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 DO IT OUR WAY IF COMMAND HAS ALREADY TYPED OUT. 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 RRBTCR .I C-E CAML TT,RRTTMX ;IS SIZE OF RANGE CHANGED BELOW THRESHHOLD? JRST RRBTCR ;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 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 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 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 MOVEI A,10(TT) ANDCMI A,7 ;A HAS NEXT TAB STOP'S POSITION. CAMLE A,NHLNS ;BUT IF THAT'S OFF THE SCREEN, TAB STOP IS RIGHT MARGIN, CAMN TT,NHLNS ;UNLESS WE'RE ALREADY AT THE MARGIN, IN WHICH CASE CAIA ;WE CAN TAB 8 SPACES INTO NEXT LINE VIA CONTINUATION. MOVE 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 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 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 ECHOCR ;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) MOVEI A,1 JRST DELCHR] CALL CHCTHR ;ELSE REMOVE THIS CHARACTER FROM THE HASH CODE; RRHPOS IS HPOS. 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. 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,TTYOPT TLNN TT,%TOOVR ;IF TERMINAL CAN OVERPRINT, WE MUST CLEAR THE SPOTS. JRST RRDIN2 RRDIN1: CALL ERSCHR ;CLEAR OUT THAT MANY POSITIONS. 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. TRNN TT,7 JRST 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 SKIPN RRMAXP CAIN CH,^I ;INSERTING ANY CTL CHAR BUT TAB IS HARD. 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. MOVEI A,1 SKIPGE RRCIDP ;IF USING CHAR I/D FOR THIS CALL INSCHR ;INSERT THE SPACE FOR IT FIRST 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. SKIPE CASDIS ;OUTPUT CHARACTER, WITH CASE-SHIFT IF ANY. CALL DISAD6 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! JRST TYOINV RRINS3: ADDM T,RROLDZ 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 TRNN TT,7 ;IF MORE THAN ONE JRST RRICH1 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? AOJA IN,RRNTB2 ;NO, STRAY CR 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,SETP1 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 CAMN T,RREBUF ;IF BUFFER HAS BEEN SWITCHED ON US, RECOMPUTE THE DISPLAY! JRST RREAR5 SETOM RRMNVP SKIPN TOPLIN SKIPE NLINES JRST RREAR5 SKIPE NOCEOL ;IF TERMINAL HAS NO CLEOL, IT IS MORE EFFICIENT TO CLEAR SCREEN FIRST. SETOM PJATY RREAR5: .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 RRMAC3 CAML E,C 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. ;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. 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 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 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 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,RROLDZ MOVE TT,TOPLIN RRFXR1: CAMN TT,BOTLIN RET ADDM A,LINBEG(TT) AOJA TT,RRFXR1 ;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. ;HERE IF KNOWN NOT TO BE EXITING A ^R OR ^P. 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 B JUMPLE C,GETAG2 MOVE BP,IN CAML BP,GPT ADD BP,EXTRAC CALL GETIBP GETAR1: 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 MOVE CH,BP ;CHECK THAT BEFORE THIS LF THERE IS A CR. DBP7 CH LDB CH,CH 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 CH,^M 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 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. 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 SLPN0W: ] 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. SLPSHT: SKIPN EXTRAC ;NOTHING TO DO IF NO GAP. JRST GAPSLN SAVE Q SLPSH1: MOVE Q,Z CAMN Q,GPT JRST SLPSH2 EXCH Q,PT SAVE Q CALL GAPSLP ;THEN MOVE THE GAP TO PT. 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: IFN ITS,CALL SEQPGX 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 CH,GPT ;SET UP SEQUENTIAL PAGING IN AREA TO MOVE. ADD CH,EXTRAC MOVE Q,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 GAPUP3] 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 GAPUP3] MOVE A,@10 ROT A,-1 MOVE 15,.+1 AOJLE C,10 ;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 GAPDN6 ;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. GAPDN6: ] 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: IFN ITS,CALL SEQPGX 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 GAPDN3] 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 GAPDN3] ;INSN THAT EXITS LOOP. MOVE 14,.+1 SOJGE C,13 ;C HAS # WDS TO MOVE. ;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. SEQPAG: SKIPN SEQPGE RET ADDI TT,2*5*2000-1 IDIVI TT,5*2000 ;COMPUTE NUMBER OF PAGES WE NEED TO LOOK AT AT ONCE. MOVSI TT1,2 ;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 ADD Q,5*2000*3 ;IF TOTAL DISTANCE TO SCAN IS LESS THAN 3 PAGES, CAML Q,CH ;DON'T BOTHER WITH SEQUENTIAL PAGING. JRST SEQPGX .SUSET [.PAGAHD,,TT1] IDIVI TT,5*2000 ;CONVERT THAT TO PAGE NUMBER. IDIVI CH,5*2000 ;CONVERT HIGH END TO PAGE NUMBER. HRL TT,CH .SUSET [.PAGRAN,,TT] SETOM SEQPGF RET ;TURN OFF SEQUENTIAL PAGING. SEQPGX: SKIPN SEQPGF ;IF IT ISN'T ON, DON'T WASTE TIME WITH SUSETS. RET SETZM SEQPGF .SUSET [.PAGRAN,,[0]] .SUSET [.PAGAHD,,[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 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 GCTAB 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 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: CAMLE 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, 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 GCTAB. 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 FCTLG5: MOVE CH,1(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) TRNN FF,FRUPRW ;IF NO ATSIGN, SET THE Q-REG. MOVEM Q,1(IN) 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 STAB 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,STAB-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,,STAB+LTABS-1] TYPRE [STL] PUSH J,CH ;AND STORE IN STAB FOR OUR LOOKUP. SOJG B,FCTLG3 JRST POPJ1 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. SOJA IN,FCTLG5 ;GO SWAP THE CONTENTS OF THAT WORD. 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 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,^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 PUSHJ P,SDEP ;DEPOSIT TABLE ENTRY 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. ;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,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 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 SRN2: CALL SKNBCP ;SET UP SKNBPT FROM Q..D, FOR SKNBRK'S SAKE. 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 SLP2+2 ;MAIN SEARCH LOOP. SFAF2: HRLI C,260700 JRST SLP2+2 SFAF3: HRLI C,170700 JRST SLP2+2 SFAF4: HRLI C,100700 JRST SLP2+2 SFAF5: HRLI C,010700 JRST SLP2+2 ;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) SLP1Z: XCT SLP4-1 CAIA JRA B,SLP2 MOVE SLP4-1,[CAMN E,ZBP] MOVE SLP4,[JRA B,SLP1Z1] INSIRP PUSH P,BP TT TT1 MOVE BP,GPT ADD BP,EXTRAC CALL GETIBP MOVE E,BP INSIRP POP P,TT1 TT BP JRST SLP3 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: 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 WINNL1: MOVE E,C ;NULL SEARCH STRING FOUND. ;THIS SEARCH WINS, MAYBE DO SOME MORE 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: 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 ;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 ;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 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. JUMPE C,FSSST1 ;ANYTHING ELSE MUST BE ORDINARY, OR A ^N. MOVEI A,C CALL ASCIND ;IF ^X OR ^B, OR ^N OF ONE, STORE IN STRING THE STUFF IN C. AOJA E,FSSSTL FSSST1: 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 CAIN TT1,^N XCT LISTF5 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 ;; ^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,FSSTRR:: FSDSNM:: 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,[ MOVE A,DEFDEV ;RETURN -1 IF DEFAULT DEVICE IS "FAST". CAME A,MACHINE 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 .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 .BREAK 12,[..RMAIL,,A] MOVEM A,DEFDEV MOVEM B,DEFFN1 MOVEM C,DEFDIR MOVE A,[SIXBIT /MAIL/] MOVEM A,DEFFN2 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 IFN 10X,[ FSEJP1: PMAP SOJLE C,FSEJP2 AOJA B,FSEJP1 FSEJP2: ];IFN 10X 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 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: 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 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 JRST FSDIR4 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 FSDIR4: MOVE A,C MOVE C,[440700,,BAKTAB] CALL STRASC PUSH P,[0] TRZN FF,FRARG2 JRST FSDIR7 MOVE A,SARG MOVEM C,(P) CALL STRASC FSDIR7: HRROI B,BAKTAB STDIR MOVE B,[.FHSLF,,600075] JRST [ TRO FF,FRNOT JRST OPNER6 ] HRRZ A,A POP P,B CNDIR JRST OPNER2 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 TRZN FF,FRARG ;ANY ARG? JRST FSSTR0 ;NO, RETURN THE STRING THEN HRLI E,440700 ;MAKE BYTE POINTER SKIPL A,C ;GET ARG - SHOULD BE A STRING CAIA CALL QLGET0 ;GET BYTE POINTER AND SIZE OF STRING TYPRE [ARG] ;NOT A STRING? FSSTR1: ILDB CH,BP TRNE CH,100 ;MAKE SURE IS UPPERCASE TRZ CH,40 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 RET 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 ] ;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. 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 [ ADDI A,10 TRZ A,7 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 JRST FSIXR ;NO ARG => READ IN STRING AND CONVERT TO SIXBIT. TRZE FF,FRUPRW+FRCLN ; :F6 RETURNS STRING CONTAINING THE CHARS OF THE SIXBIT. JRST FSIXST 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. ] ;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 JRST POPJ1 CAIL CH,40 TLNN OUT,770000 JRST FSIXRL SUBI CH,40 IDPB CH,OUT JRST FSIXRL FSIXST: AOS (P) ;HERE TO CONVERT SIXBIT TO STRING. 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,[ ;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 REST T TRZN FF,FRARG ;ANY ARG GIVEN? JRST POPJ1 ;NO, GO RETURN DEFAULT JUMPE T,FSDVR3 ;0 = > CAMN T,[-2] ;-2 = < JRST FSDVR4 JUMPL T,POPJ1 ;ARG IS -1 => DON'T CHANGE ANYTHING. CAMLE T,[999999.] TYPRE [ARG] ;ELSE MUST BE REASONABLE VERSION NUMBER. SETZ C, ;ACCUMULATE IT HERE FSDVR1: IDIVI T,10. IORI C,'0(TT) ROT C,-6 JUMPN T,FSDVR1 ;KEEP GOING IF MORE NUMBER TO DO FSDVR2: MOVEM C,DEFFN3 JRST POPJ1 ;OK, WE SET THE DEFAULT, NOW RETURN PREVIOUS VALUE STILL IN A. FSDVR3: SKIPA C,[SIXBIT />/] ;0 = > FSDVR4: MOVE C,[SIXBIT /" (FS D VERSION$ ONLY) FSFVER: HLRZS E SKIPN C,(E) ;GET SECOND FILENAME JRST FSFVR2 ;BLANK ISNT A NUMBER SETZ A, ;ACCUMULATE NUMBER HERE CAMN C,[SIXBIT />/] ;CHECK FOR SPECIAL "NUMBERS" JRST POPJ1 ;> = 0 CAMN C,[SIXBIT / 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. IORI J,7 ;ELSE ADVANCE HPOS TO TAB STOP ADDI J,1 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 STAB. 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,STAB ;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 STAB. ;LEAVE J -> LAST WORD USED IN STAB + 1. USED BY @F^B. ;CLOBBERS A, CH. INDARG: MOVEI J,STAB INDA1: CALL RCH SKIPE SQUOTP JRST INDA2 CAIN CH,ALTMOD RET INDA2: CAIN J,STAB+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 ] IFN 10X,[ 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: 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 MOVE A,FZSTR ; GET POINTER TO RESCAN STUFF CAIN A,0 ; ANYTHING TO PUT IN RESCAN BUFFER? MOVE A,[.BP 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, 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/] IFN 10X, 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, 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 MOVEI A,.FHJOB ;SETUP TERMINAL INTERUPT WORD SETO B, SETZ C, STIW MOVEI A,.TICCG ;CTRL-G MOVE B,0(P) ;FORK HANDLE CAMN B, EXECFK ;THIS THE EXEC? DTI ;YES - TURN OFF C-G 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 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 OPNER1 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, 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 REST B REST A RET FRKC3: REST A ;JFN ON STACK RLJFN ;RELEASE JFN IN A JFCL JRST OPNER1 FRKC4: TLZ A,-1 ;JFN RLJFN JFCL REST A ;FORK HANDLE ON STACK KFORK ;FLUSH FORK IFN 20X, ERJMP .+1 JRST OPNER1 FRKC5: KFORK ;KILL OFF FORK IFN 20X, 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 GCTAB POPJ P, ;NOTHING TO DO IF STRING NULL. MOVE A,[BP7,,GCTAB] 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,,GCTAB] 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 GCTAB. FJCLRD: IFN 20X,[ SETZB A,B RSCAN ;GET RSCAN BUFFER TDN SETZ B, MOVE B,[BP7,,GCTAB] SETZM GCTAB MOVN C,A ;GET NUMBER OF CHARACTERS IN IT 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. CAIGE A,40 ;Is separator? JRST FJCLR3 ;No, a terminator. Ignore the JCL. MOVE B,GCTAB ;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. JRST FJCLR4 FJCLR3: CALL FJCLR4 ;Ignore the JCL: read it all in, FJCLR5: SETZM GCTAB ;but say there was none. RET FJCLR4: ] SETZM GCTAB MOVE A,[GCTAB,,GCTAB+1] BLT A,GCTAB+GCTBL-2 IFN ITS,[ MOVEM A,GCTAB+GCTBL-1 ;LAST WD NOT 0 TO STOP STORING. ;FIRST, RETURN WITH GCTAB 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 GCTAB. .BREAK 12,[5,,GCTAB] ] IFN 20X,[ MOVEI A,-1 ;READ FROM CONTROLLING TERMINAL HRROI B,GCTAB SIN ;THE REST OF THE RSCAN STRING ] 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,STAB-1 ;THEN ACCUMULATE STRING TO SEARCH FOR IN STAB. 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,,STAB+LTABS-1] TYPRE [STL] PUSH J,CH ;REMEMBER CHAR IN STAB. 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 STAB. CAIGE J,STAB 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 STAB. 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 STAB 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,STAB 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 STAB (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,STAB ;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,CPOPJ ;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. MOVEM C,(CH) RET 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 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,STAB 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 STAB, WITH AN ! BEFORE AND AFTER. LEAVE J -> LAST ;WORD USED IN STAB. USED BY "O" AND "F;". ;[ ;BRCFLG LEFT NONZERO IFF SOME UNPREDICTABLE ^] CALLS TOOK PLACE. ;CLOBBERS A, CH. OARG: MOVEI J,STAB+1 MOVEI A,41 MOVEM A,-1(J) SETZM BRCFLG ;[ ;ANY ^] CALLS WE WORRY ABOUT WILL SET BRCFLG. OGNF1: CAIN J,STAB+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 STAB, 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,STAB ;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 IFN ITS,[ SYSCAL RFPNTR,[%CLIMM,,CHFILI ? %CLOUT,,C] SETZ C, IMULI C,5 ;IF WE ARE NOT POINTING AT THE FRONT OF THE FILE, WE DON'T SUB A,C ;HAVE AS MUCH TO READ, SO WE DON'T NEED AS MUCH SPACE. SKIPGE C,A ;IF KNOW HOW MUCH SPACE, READ WHOLE FILE AT ONCE. ] IFN TNX,[ MOVE C,A ;SAVE SIZE OF FILE 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 SUB C,B SKIPGE C ] 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,[ ;MAP IN INPUT FILE USING PMAP'S FYPMAP: CALL GAPSLP ;MOVE GAP TO PT SAVE C ;SAVE SIZE OF INPUT FILE MOVE A,GPT IDIVI A,1000*5 ;GET PAGE TO START MAPPING INTO JUMPE B,.+2 .SEE CIRC AOJ A, SAVE A ;SAVE PAGE NUMBER IMULI A,1000*5 ;GET CHARACTER ADDRESS IDIVI C,1000*5 ;GET NUMBER OF PAGES IN INPUT FILE JUMPE D,FYPMA1 .SEE CIRC AOJ C, SUBI D,1000*5 ;D IS - FYPMA1: SAVE C ;SAVE IT IMULI C,1000*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 - HRLZ A,CHFILI ;GET INPUT FILE AGAIN MOVE B,-1(P) ;FIRST PROCESS PAGE HRLI B,.FHSLF IFN 20X,[ 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. ] IFN 10X,[ 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: ] REST A ;GET FIRST PAGE AGAIN IMULI A,1000*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 ] ;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. CLOSEF CHFILI TLZ FF,FLIN 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,,[ASCIC//]-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 ;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 PUNCHF: ;PUNCH OUT RANGE SPEC'D BY C,E. 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 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 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, ;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, ;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. SETZM CLKFLG SKIPE A,CLKMAC CALL MACXCP SETZM CLKFLG 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 MOVE A,DEFDIR ;THE CURRENT SYSTEM NAME PUSHJ P,SIXINS CALL LFILE ;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) MOVE A,ERSNM MOVEI C,"; PUSHJ P,SIXINT MOVE A,ERDEV MOVEI C,": PUSHJ P,SIXINT MOVE A,RUTF1 MOVEI C,40 PUSHJ P,SIXINT SKIPA A,RUTF2 EGET2: SETZI A, PUSHJ P,SIXINS 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 ;FILENAME PARSING ROUTINES. FFRDEV READS DEV AND SNAME ONLY. ;FFRRDD (ET CMD) READS ENTIRE NAME. ;FRD LEAVES THE NAMES IN A, B NOT SETTING DEFFN1 AND DEFFN2. FFRDEV: TROA FF,FRNOT FRD: TRZ FF,FRNOT TROA FF,FRALT ETCMD: FFRRDD: TRZ FF,FRALT+FRNOT MOVE A,DEFFN1 MOVE B,DEFFN2 SETOM FFRRCT TRO FF,FRFIND FF1: MOVEI E,0 MOVE C,[440600,,E] FF2: PUSHJ P,LRCH SKIPGE SQUOTP JRST FF3 SKIPN SQUOTP CAIE CH,ALTMOD CAIN CH,40 JRST FFTRM CAIN CH,^I JRST FFTRM CAIE CH,^X CAIN CH,^A ;^A OR ^X REFERS TO DEFAULT FIRST FILENAME. JRST FFCTLX CAIE CH,^Y CAIN CH,^B ;^B OR ^Y REFERS TO SECOND DEFAULT FILE NAME JRST FFCTLY CAIN CH,"; JRST FFSYSN CAIN CH,": JRST FFDEVN CAIN CH,^Q PUSHJ P,LRCH ;^Q QUOTES NEXT CHAR. FF3: HRREI CH,-40(CH) JUMPL CH,FF2 ;IGNORE CONTROL CHARACTERS. TLNE C,770000 IDPB CH,C JRST FF2 ;STORE NAME IN E AS SNAME, AND RESET DEVICE TO DSK IF APPROPRIATE. FFSYSN: SKIPE E MOVEM E,DEFDIR .SUSET [.SSNAM,,E] TRNN FF,FRFIND JRST FF1 ;DEVICE HAS BEEN SPECIFIED LDB C,[301400,,DEFDEV] CAIE C,' ML CAIN C,' AI JRST FF1 CAIE C,' MC CAIN C,' ML JRST FF1 CALL FFDEV2 JRST FF1 FFDEVN: PUSH P,[FFEND] FFDEV1: JUMPE E,CPOPJ ;STORE THE CONTENTS OF E AS A DEVICE NAME, IF NOT NULL. TRZ FF,FRFIND CAMN E,['DSK,,] FFDEV2: MOVE E,MACHIN MOVEM E,DEFDEV RET FFCTLX: CALL FFSTOR ;STORE AWAY ANY NAME TERMINATED BY THE ^X, MOVE E,DEFFN1 ;GET THE DEFAULT FN1, JRST FFTRM ;AND STORE IT AS A NAME. FFCTLY: CALL FFSTOR ;STORE AWAY ANY NAME TERMINATED BY THE ^Y, MOVE E,DEFFN2 ;GET THE DEFAULT FN2, JRST FFTRM ;AND STORE IT TOO. ;STORE AWAY A "NORMAL FILENAME", IN E. IGNORE IT IF NULL. FFSTOR: JUMPE E,CPOPJ TRNE FF,FRNOT JRST FFDEV1 AOSE FFRRCT MOVE A,B MOVE B,E RET ;HERE AFTER A NAME IS TERMINATED WITH SOMETHING OTHER THAN : OR ; (IT'S A NORMAL NAME). FFTRM: CALL FFSTOR FFEND: CAIE CH,ALTMOD JRST FF1 SKIPL FNAMSY SKIPA E,DEFFN2 MOVSI E,'>_14 SKIPE FNAMSY ;NONZERO FNAMSY SAYS SKIPE FFRRCT ;IF ONLY ONE FILENAME CAIA JRST FFTRM ;USE ">" OR PREVIOUS DEFAULT AS SECOND. TRZE FF,FRALT RET MOVEM A,DEFFN1 MOVEM B,DEFFN2 RET FSIFILE:SKIPA E,[ERDEV] ;FS I FILE$ - DESCRIBE OPEN INPUT FILE. FSOFIL: MOVEI E,ROUDEV ;FS O FILE$ - DESCRIBE LAST CLOSED OUTPUT FILE. AOSA (P) FSDFRD: MOVEI E,DEFDEV SAVE C MOVEI C,14.*4 ;14 CHARS PER FILENAME >> ENOUGH CALL QOPEN ;MAKE SURE ENOUGH SPACE, SET UP BP AND LISTF5 TO STORE INTO STRING. MOVE A,3(E) ;WRITE THE DATA THROUGH THAT BYTE POINTER. MOVEI C,"; CALL SIXINT ;FIRST SNAME AND ";" AND A TAB MOVEI CH,40 IDPB CH,BP MOVE A,(E) MOVEI C,": ;THEN DEVICE NAME, ":", AND A TAB CALL SIXINT MOVEI CH,40 IDPB CH,BP MOVE A,1(E) ;THEN FN1 AND A TAB MOVEI C,40 CALL SIXINT MOVE A,2(E) ;AND THE FN2. CALL SIXIN1 CALL QCLOSV JRST POPCJ ;FILE COPY FCOPY: PUSHJ P,FFRRDD MOVE A,[.BAI,,CHRAND] CALL IMMQIT .CALL RREDB ;OPEN FOR INPUT, NAMES IN DEFDEV ETC. JRST OPNER1 TRNN FF,FRUPRW ;@ E_ => XFER REAL FILENAMES OF SOURCE TO DEFAULTS. JRST FCOPY3 SYSCAL RFNAME,[ %CLIMM,,CHRAND ? 4WDARG( <%CLOUT,,DEFDEV>)] .LOSE %LSFIL FCOPY3: PUSHJ P,FFRRDD SYSCAL OPEN,[[.BAO,,CHERRI] ? DEFDEV ? [SIXBIT/_TECO_/] ? [SIXBIT/_COPY_/] ? DEFDIR] 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 FCOPY2: MOVE T,[-GCTBL,,GCTAB] .IOT CHRAND,T JUMPL T,FCOPY4 MOVE T,[-GCTBL,,GCTAB] .IOT CHERRI,T JRST FCOPY2 FCOPY4: .CLOSE CHRAND, MOVSI T,-GCTAB-1(T) EQVI T,-1#GCTAB .IOT CHERRI,T SYSCAL RENMWO,[%CLIMM,,CHERRI ? DEFFN1 ? DEFFN2] .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 DEFDEV ETC, 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/OPEN/ ? A ? UTFARG ? 403000,,A RREDGN: MOVE A,DEFDIR SYSCAL RFNAME,[%CLIMM,,CHFILI ? 4WDARG( <%CLOUT,,ERDEV>)] .VALUE SKIPN ERSNM ;IF DEVICE DOESN'T USE SNAME, GIVE CURRENT SNAME. MOVEM A,ERSNM 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,FRD ;READ FILENAMES TO CLOSE UNDER. EFCMD1: MOVEM A,DEFFN1 MOVEM B,DEFFN2 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 ? DEFFN1 ? DEFFN2] ;GIVE FILE ITS ULTIMATE SPEC'D NAME. JRST OPNER1 EFCMD2: SYSCAL RFNAME,[%CLIMM,,CHFILO ? 4WDARG( <%CLOUT,,ROUDEV>)] .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, MOVE A,[-4,,[SIXBIT /DSK/ ? SIXBIT /TECPUR/ ? .FNAM2 ? SIXBIT /.TECO./]] 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 DEFDIR 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,[UTFARG ? A ? B] JRST OPNER1 MOVEM A,DEFFN1 MOVEM B,DEFFN2 JRST DELQIT 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 MOVE A,[DEFDEV,,GCTAB] BLT A,GCTAB+3 ;SAVE THE LINK NAMES, CALL FFRRDD ;READ NAMES LINKED TO. CALL ALINK2 ;GET CORRECT SNAME TO LINK TO IN C. MOVE T,[GCTAB,,DEFDEV] BLT T,DEFDIR ;BRING BACK LINK NAMES, CALL IMMQIT SYSCAL MLINK,[UTFARG ? A ? B ? C] JRST OPNER1 JRST DELQIT ALINK2: MOVE C,DEFDIR MOVS T,DEFDEV ;CONVERT COM: TO COMMON;, ETC. CAIN T,'COM MOVE C,['COMMON] CAIN T,'SYS MOVSI C,'SYS CAIN T,'TPL MOVE C,['.LPTR.] RET 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: TRNN FF,FRCLN CALL FFRDEV ;SET DEFAULT DEV AND SNAME TRNE FF,FRCLN CALL FFRRDD ;OR SET DEFAULT DEV, SNAME AND FILENAMES. EICMD: WINIT: MOVE A,DEFFN1 MOVE B,DEFFN2 TRZE FF,FRCLN ;:EW, :EI USE SPEC'D NAMES TO OPEN AS, JRST WINIT1 MOVE A,[SIXBIT/_TECO_/] ;WITHOUT COLON, OPEN AS _TECO_ OUTPUT. MOVE B,['OUTPUT] WINIT1: TLZ FF,FLOUT CALL IMMQIT MOVEI T,100000 ;@EW OPENS IN WRITE-OVER MODE. TRZN FF,FRUPRW WINIT2: MOVEI T,0 ;OTHERWISE, USE NORMAL WRITE. SYSCAL OPEN,[[3,,CHFILO] ? DEFDEV ? A ? B ? DEFDIR ? 4000,,T] JRST WINIT3 SETZM IMQUIT JSP T,FHAK ;INIT. BUFFER POINTERS. TLO FF,FLOUT POPJ P, WINIT3: .STATUS CHFILO,D ;IF WRITE-OVER OPEN FAILS FOR "FILE NOT FOUND" LDB D,[220600,,D] CAIN D,%ENSFL JUMPN T,WINIT2 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,[UTFARG] JRST OPNER1 POPJ P, DELE1: TLNN FF,FLIN TYPRE [NFI] SYSCAL DELEWO,[%CLIMM,,CHFILI] .LOSE %LSFIL POPJ P, LISTF: CALL FFRDEV ;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 FFRDEV 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 ;SLEEP FOR N 30TH'S OF A SECOND ASLEE5: MOVEI A,.PRIIN ;ALSO IF WE ALREADY KNOW THE ANSWER SIBE JRST ASLEE4 ;DONT EVEN GO TO SLEEP SKIPGE UNRCHC SKIPE TYISRC JRST ASLEE4 IFN 10X,[ 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 ] 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 ] 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 RLJFN ;GET RID OF THE JFN JFCL SETZ A, ;RETURN 0 FOR SUCCESS JRST CPOPJ1 ;SOMEONE SHOULD DEFINE THESE IN TWXBTS .TIMAL==5 .TIMEL==1 IFN 10X,[ ;STUPID TENICES CANT STANDARDIZE THIS IF1 [ PRINTX \IIT JSYS TYPE (0 - NONE, 1 - BBN, 2 - SUMEX): \ .TTYMAC FOO .IIT==FOO TERMIN IFE .IIT-1,IIT=JSYS 247 ;NOT EVEN THE SAME JSYS NUMBER IFE .IIT-2,IIT=JSYS 630 ]] .ELSE .IIT==0 ;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 ERJMP .+1 ;(No-op on Tenex, needed on Twenex). 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,[ ;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 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 RET ;READ A FILESPEC, SETTING DEFAULTS FROM IT FFRDEV: 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 TRNE CH,100 ;UPPERCASE UNQUOTED LETTERS ANDCMI CH,40 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,"] ] IFN 10X,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 SKIPN 1(P) ;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,POPAJ ;IF NOTHING YET, DONE 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 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 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 MOVEM B,SAVMOD ;SAVE TTY MODE (ALSO FOR ^G TO USE) TRO B,1_6\TT%ECO ;MAKE SURE ECHO ON AND DATA MODE OK SFMOD HRRZ B,TTLPOS SFPOS ;MAKE SURE MONITOR KNOWS HORIZONTAL POSITION IFN 20X,[ BKJFN JRST FFRRT0 BIN ;GET THE LAST CHARACTER TYPED CAIN B,15 ;CR? BIN ;YES, READ THE LF TOO FFRRT0: ];20X SETOM IMQUIT ;ALLOW ^G'ING OUT OF GTJFN 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%OLD\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) IORM C,BAKTAB 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%UHV\GJ%NHV) ;IF THE VERSION CAME FROM GTJFN, FROM "0" OR "-1", SETZM DEFFN3 ;SETUP VERSION NUMBER DEFAULT RIGHT TLNN A,(GJ%VER) ;IF VERSION NUMBER HAD WILDCARDS JRST FFRRT1 HRROI B,-3 MOVEM B,DEFFN3 ;SET IT TO DEFAULT RIGHT FFRRT1: SETZM IMQUIT ;NO MORE ^G AFTER THIS MOVE B,SAVMOD ;RESTORE TTY MODE AFTER GTJFN FFRRT2: MOVEI A,.CTTRM SFMOD 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: 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 C,NUM ;ON REPARSE, 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 10X,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 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 ] 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 ] IFN 10X,[ 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,,GCTAB] MOVNI C,GCTBL*5 SIN ADDI C,GCTBL*5 ;GET NUMBER OF WORDS REALLY TRANSFERED JUMPE C,FCOPY4 ;NONE, EOF MOVN C,C MOVE B,[440700,,GCTAB] 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 TLZN FF,FLIN ;JUST IN CASE JRST RRED2 EXCH A,CHFILI CLOSF JFCL SKIPA A,CHFILI RRED2: MOVEM A,CHFILI IFN 20X,MOVE B,[36._30.+OF%RD] IFN 10X,MOVE B,[36._30.+OF%RD+OF%EX] ;THIS IS THE BIGGEST CROCK 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 RRED3: CALL IMMQIT MOVEM A,OPNJFN OPENF JRST OPNER0 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 ] IFN 10X,[ ;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 EFCMD1: 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 ] 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 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 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 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 10X,[ MOVEI D,(C) PMAP ;10X - NO MULTIPLE PMAP'S SOJLE D,.+3 AOJ A, AOJA B,.-3 ] .ELSE PMAP ;MAP IN THOSE PAGES 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 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: 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,[ RLJFN ;ON TENEX, MUST GET RID OF JFN TOO. JFCL ];10X RET WWINIT: CALL FFRRDD ;EW - GET FILENAME DEFAULTS EICMD: TRNE FF,FRUPRW ;@EW MEANS CAN OVERWRITE TDZA A,A ;NO GTJFN FLAGS THEN MOVSI A,(GJ%FOU) ;OTHERWISE USER OUTPUT DEFAULTS CALL FF5 ;GET JFN FROM DEFAULTS JRST OPNER1 EXCH A,CHFILO JUMPLE A,WWINI0 TLO A,(CZ%ABT) ;GET RID OF ANY OLD FILE CLOSF JFCL WWINI0: MOVE 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 CALL IMMQIT MOVEM A,OPNJFN OPENF JRST OPNER0 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: TRZN FF,FRARG TYPRE [WNA] TLNN FF,FLIN TYPRE [NFI] 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: 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,BAKTAB ;INTO FREE SPACE 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] 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 ] IFN 10X,[ 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,BAKTAB ;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: MOVEI C,-BAKTAB(A) ;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,,BAKTAB] 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 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 DEFFN1 ;TEMPROARILY USE *.* SAVE DEFFN2 SAVE DEFFN3 MOVSI A,() MOVEM A,DEFFN1 ;SET THEM UP MOVEM A,DEFFN2 MOVEI A,-3 ;AND .* HRRM A,DEFFN3 MOVSI A,(GJ%IFG\GJ%OLD) ;ALLOW MULTIPLE INPUT FILESPECS TLNE FF,FRNOT ;READING FROM STRING? JRST LSTFR4 ;YES, GET IT IFN 10X,HRROI B,[ASCIZ /*.*;*/] .ELSE HRROI B,[ASCIZ /*.*.*/] ;DEFAULT STRING IF NOT FOM USER LSTFR5: CALL FF5A JRST OPNER1 LSTFR3: REST DEFFN3 REST DEFFN2 REST DEFFN1 RET 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. 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 IFN ITS,[ LFILE: MOVE A,DEFDIR MOVEI C,"; PUSHJ P,SIXINT MOVE A,DEFDEV MOVEI C,": PUSHJ P,SIXINT MOVE A,DEFFN1 MOVEI C,40 PUSHJ P,SIXINT MOVE A,DEFFN2 ] ;IFN ITS ;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] IFN ITS,[ SYSCAL IOT,[%CLIMM,,CHECHO ? CH ? %CLBIT,,%TJDIS\%TJCTN] .LOSE %LSFIL ] IFN TNX,CALL ECHODP ;OUTPUT ^P CODE IN ECHO AREA 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: IFN ITS,[ SYSCAL IOT,[%CLIMM,,CHECHO ? CH ? %CLBIT,,%TJECH] .LOSE %LSFIL ] IFN TNX,CALL ECHOC0 ;OUTPUT CHARACTER IN ECHO AREA 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: IFN ITS,.IOT CHECHO,CH ;ARG IS CHAR IN CH; OUTPUT IN ECHO MODE. IFN TNX,CALL ECHOCH 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. RET CALL CTLL1 SETZM RRMSNG ;MAKE SURE ^R REDISPLAYS EVERYTHING NEXT TIME. JRST RRLRDS 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 [ CALL IMMQIT 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 CALL IMMQIT FTYLUP: CALL RCH SKIPN SQUOTP CAIE CH,33 CAIA JRST FTEND FTYCHR: ANDI CH,177 CALL (BP) JRST FTYLUP FTEND: CALL DELQIT 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: CALL RCH SKIPN SQUOTP CAIE CH,33 JRST FTYEC1 CALL DELQIT 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 FFRDEV ;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: MOVEI CH,40 ;OUTPUT SPACES IDPB CH,CHCTBP ROT CH,(A) ;UPDATING HASH CODE OF LINE ADD E,CH ADDI A,7 ;AND INCREMENTING THE HPOS TRNE A,7 ;TILL WE REACH A TAB STOP. NOTE 7*HPOS IS A MULTIPLE OF 8 IFF HPOS IS. CAMN A,TT ;THE END OF THE LINE COUNTS AS A TAB STOP. CAIA JRST VBDTAB 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. ;"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 CHCT5 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 [ 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) 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 LINE AFTER THIS ONE. 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. ;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 A SPACE. PUSHJ P,CHCT1A MOVE CH,CHCTHP ;NOT AT TAB STOP => SKIPN MORFLF ;GO OUTPUT ANOTHER UNLESS FLUSHED TRNN CH,7 JRST CHCTT1 CAME CH,NHLNS JRST 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, CHCT5: PUSH P,CH ;FORCE OUT CR FOLLOWED BY OTHER THAN LF. 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 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 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 DISLI3 ;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 DISLI3 DISLI4: SKIPE NOCEOL JRST [ MOVE T,CHCRHP ;IF TERMINAL HAS NO CLEAR-TO-EOL, SUB T,LINEND(BP) ; THEN DON'T ASK FOR ONE NOW; MOVEM T,EOLFLG ; INSTEAD, SET FLAG SO IT WILL BE CLEARED MOVEM BP,DISVP ; AFTER THE LINE IS OUTPUT. 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 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 JRST DISLI1 CAMGE BP,CHCTVS ;HERE WHEN WE KNOW WE MUST OUTPUT THE LINE. STORE NEW HASHCODE. MOVEM CH,HCDS(BP) MOVE T,CHCRHP ;RECORD HPOS OF END OF LINE. MOVEM T,LINEND(BP) 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: 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,Z ;IF WE ARE ABOUT TO DISPLAY THE SAME CHARACTERS THAT ARE ON THE LINE SUB Q,RROLDZ ;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 JRST DISLN6 ;FS DFORCE$ MEANS FINISH DISPLAY EVEN IF INPUT IS WAITING. 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 ] DISLN6: JUMPE T,[SKIPE LID ;IF CAN DO INSERT/DELETE, SET RRMSNG INSTEAD OF UPPING RRMAXP JRST [ MOVE T,BOTLIN SKIPL RRMSNG CAMGE T,RRMSNG MOVEM T,RRMSNG ;SINCE LATTER WOULD PREVENT THIS INPUT CHAR JRST RRDISX] ;FROM INSERTING OR DELETING LINES. MOVE T,CHCTNL ;MAKE SURE NEXT REDISPLAY DOESN'T CAMLE T,RRMAXP ;STOP BEFORE REACHING THIS FAR DOWN. MOVEM T,RRMAXP ;WITHOUT THIS, JRST RRDISX] ;LOSES IF TYPED QUICKLY. 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 RROLDZ 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,(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) 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. 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,-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) 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 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) 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. SKIPN 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. 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. 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 ;HERE TO DO A REAL CLEAR-SCREEN. CTLL1: SETZM PJATY ;HERE TO CLEAR WHOLE SCREEN. SETZM MORESW ;BE AWARE THAT --MORE-- IS BEING ERASED. SETZM ECHACT ;ECHO AREA IS NOW CLEAR. CALL CLRSCN 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 ECHOCR 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 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 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? CAML B,Q MOVE B,Q DISMD3: SOJL B,DISMD1 ;DISPLAY THE ..J STRING, OR AS MANY CHARS OF IT AS B SAYS. 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 B,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: MOVE Q,[441000,,DISBF1] ;THEN OUTPUT THE STRING. SYSCAL SIOT,[%CLIMM,,CHSIO ? Q ? A] .LOSE %LSFIL 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 ECHOCR: .IOT CHECHO,[^M] RET 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 ITS IFN TNX,[ ;FUNDAMENTAL DISPLAY OPERATIONS, ON A TERMINAL-INDEPENDANT BASIS. IFNDEF DEFOSP,[ ;THE DEFAULT OUTPUT SPEED FOR TERMINALS IFN 10X,[ PRINTX \Maximum output speed for any terminal = \ .TTYMAC FOO RADIX 10. DEFOSP==FOO RADIX 8 TERMIN ] .ELSE DEFOSP==9600. ] ;THE TTYTYP TABLE TRANSLATES TWENEX TERMINAL TYPE CODES TO TECO INTERNAL TERMINAL TYPES. ;THE TECO INTERNAL TYPE IS WHAT LIVES IN RGETTY. BY SETTING FS RGETTY, THE USER ;CAN CHOOSE ANY TERMINAL TYPE HE LIKES. ;INTERNAL TYPES 0 AND 1 ARE FOR PRINTING TTYS AND GLASS TTYS. ;HIGHER TYPE CODES ARE FOR DISPLAYS. DEFINE DEFTYP TYPE,TABLE,SYMBOL IFNDEF TYPE,[ PRINTX \GTTYP index for TYPE = \ .TTYMAC FOO IFB FOO,TYPE==-1 .ELSE TYPE==FOO IFG TYPE-NTTYPE+1,.ERR FOO is too large to be a GTTYP index TERMIN ] %%TYPE==%%TYPE+1 TABLE SYMBOL==:%%TYPE IFG TYPE,[ %%TMP==. LOC TTYTYP+TYPE %%TYPE LOC %%TMP ] TERMIN NTTYPE==31. ; 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 [ PRINTX /GTTYP indices for "glass ttys", separated by commas: / .TTYMAC TYPES IRPS TYPE,,TYPES IFG TYPE-NTTYPE+1,.ERR TYPE is too large to be a GTTYP index LOC TTYTYP+TYPE 1 TERMIN TERMIN 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 ;LISP MACHINE (OR SOMETHING) SIMULATING AN IMLAC 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 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 ;;; HERE IS WHAT A TERMINAL TYPE TABLE LOOKS LIKE. IFN 0,[ ;;; DISPATCH VECTOR FOR FOO TERMINAL. FOOTB: 3000+24.,,79. ; 24 LINES, 79 COLS NOT INCLUDING CONTINUATION COLUMN. ; 3 MSEC PER LINE MOVED FOR I/D LINE OPERATIONS. ; THIS IS THE TOTAL FOR INSERTION PLUS DELETION. ; IT WILL SOMEDAY BE USED FOR OPTIMIZATION CALCULATIONS. (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID+%TOFCI) ; BITS SAYING WHAT TERMINAL CAN DO. ;;; REMAINING ENTRIES ARE INSTRUCTIONS WHICH MAY NOT CLOBBER ANYTHING BUT A ;;; UNLESS IT SAYS OTHERWISE FOR THE PARTICULAR ENTRY. CALL FOOCPS ; MOVE CURSOR. B CONTAINS VPOS,,HPOS. CAN CLOBBER A,B. CALL FOCEOL ; CLEAR TO END OF LINE. CALL FOCEOS ; CLEAR TO END OF SCREEN (NOT VERY IMPORTANT). CALL FOCLRS ; CLEAR SCREEN AND HOME CURSOR. JFCL ; SLOT NOW UNUSED. CALL FODSMV ; DEPOSIT APPROPRIATE CHARACTERS IN DISBF1. ; GIVEN A VPOS IN BP AND HPOS IN DISCPH, STORES CHARACTERS ; IN DISBF1 THROUGH DISBF1+5 TO MOVE THE CURSOR ; TO THAT POSITION AND CLEAR THE ENTIRE LINE. ; THIS WILL USUALLY INVOLVE MOVING TO THE FRONT OF THE LINE, ; CLEARING TO END OF LINE, THEN MOVING TO THE FINAL SPOT. ; IT IS MOST EFFICIENT TO USE THE LAST FEW WORDS OF DISBF1 ; (AS MANY AS NECESSARY) LEAVING THE FIRST FEW WDS ALONE. CALL FODMV1 ; LIKE THE PREVIOUS ROUTINE EXCEPT DON'T CLEAR THE LINE. CALL FOINSL ; INSERT LINES. BP SAYS WHICH VPOS, Q SAYS HOW MANY. ; MAY CLOBBER A AND B. CALL FODELL ; DELETE LINES. ARGS AS ABOVE. MAY CLOBBER A AND B. CALL FOINSC ; INSERT CHARACTER AFTER THE CURSOR. CALL FODELC ; DELETE CHARACTER AFTER THE CURSOR. CALL FOORST ; TAKE TERMINAL OUT OF DISPLAY MODES USED BY TECO ; (FOR RETURNING TO EXEC, ETC.). CALL FOOSUP ; SCROLL UP, FOR THOSE TERMINALS WHICH CAN ; PARTS OF SCREEN AROUND. CALL FOOSDN ; SCROLL DOWN, FOR THOSE TERMINALS WHICH CAN ; MOVE PARTS OF SCREEN AROUND CALL FOOINI ; INITIALIZE TERMINALS (ON RETURN FROM FZ ; ETC.) FOR THOSE TERMINALS WHICH NEED IT. CALL FOORSS ; RESET DISPLAY MODES TEMPORARILY, ; NOT EXPECTING TO CHANGE THE SCREEN. ; USED FOR :ET. CALL FOOIVI ; TO INIT FOO'S INVERSE CHARACTER MODE CALL FOOIVC ; TO CLEAR INVERSE VIDEO MODE. ] ;IFN 0 ;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 MOVE T,RGETTY ;GET INTERNAL TERMINAL TYPE MOVE T,TTYTBS(T) ;GET DISPATCH VECTOR XCT @(A) ;CALL APPROPRIATE ROUTINE 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 MOVEI A,.PRIOU MOVE B,TTLPOS CAIN CH,^I JRST [ADDI B,10 ;TAB - MOVE TO NEXT TAB STOP TRZ B,7 CALL CURPS0 JRST POPBAJ] CAIN CH,^J ADD B,[1,,0] ;LF - MOVE TO NEXT LINE CAIN CH,^M TRZ B,-1 ;CR - MOVE TO START OF LINE EXCH B,CH BOUT EXCH B,CH CAIL CH,40 AOJ B, ;PRINT CHAR, COUNT ONE POSITION MOVEM B,TTLPOS 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 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 EXCH CH,A PBOUT EXCH CH,A 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 C,ECODPF ;HAD A ^P LAST TIME? JRST ECODP0 ;YES, OF SOME SORT CAIE CH,^P ;^P NOW? JRST ECHOC1 ;THAT WAS EASY ENUF SETOM ECODPF ;YES, SAY SO FOR NEXT TIME RET ECODP0: AOJLE C,ECODP1 ;^PH OR ^PV? SETZM ECODPF SKIPGE C,ECODTB-"A(CH) CALL ECOPOS ;SEE IF WE SHOULD MOVE TO RIGHT SPOT FIRST JRST (C) ;DISPATCH FOR THIS ONE ECODP1: AOJLE C,ECODP2 ;^PV SEEN? MOVEI C,-10(CH) ;GET DESIRED HPOS CAMLE C,NHLNS MOVE C,NHLNS HRRM C,ECHOPS ECODP3: SETZM ECODPF 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 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, 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,[ CAIE A,IMLCI ;BS OVERWRITES ON IMLAX CAIN A,SIMLCI SKIPA A,[-1,,[.BYTE 7 ? 177 ? 204-176 ? 0]] ] 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 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 A,^H PBOUT 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 IFN DM2500,[ SUBTTL DM2500 DM25TB: 2000+24.,,79. (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID+%TOFCI) CALL DMCPS CALL DMCEOL CALL DMCEOL ;CLOSEST WE CAN COME CALL DMCLRS JFCL CALL DMDSMV CALL DMDMV1 CALL DMINSL CALL DMDELL CALL DMINSC CALL DMDELC CALL DMRST REPEAT 3,JFCL CALL DMRST REPEAT 2,JFCL DMCPS: JUMPE B,[MOVEI A,^B ;HOME IS EASY PBOUT RET] MOVEI A,^L ;ELSE ^L PBOUT HRRZ A,B XORI A,"` PBOUT HLRZ A,B XORI A,"` DMCP2: PBOUT RET DMCEOL: MOVEI A,^W JRST DMCP2 DMCLRS: MOVEI A,^^ PBOUT ;[ DMRST: MOVEI A,^] ;RESTORE ROLL MODE JRST DMCP2 DMINSL: SAVE C SAVE B CALL DMINS1 ;POSITION RIGHT AND ENTER I/D MODE MOVEI A,30. ;COMPUTE AMOUNT OF FILL NEEDED SUBI A,(BP) ;((30.-(BP))*OSPEED-2400.)/14400. JUMPL A,[SETZ B, JRST DMINS2] SKIPN B,OSPEED ;SPEED OF OUTPUT MOVEI B,DEFOSP ;ASSUME MAX IF UNKNOWN IMULI B,(A) SUBI B,2400. IDIVI B,14400. ;MAGIC NUMBER IN B DMINS2: MOVEI A,^J ;INSERT A LINE PBOUT MOVE A,B ;PAD WITH RUBOUTS; NUMBER IN A. CALL EXPPAD SOJG Q,DMINS2 ;REPEAT FOR NUMBER OF LINES REQUESTED REST B DMINS3: REST C MOVEI A,^X JRST DMCP2 DMDELL: SAVE C CALL DMINS1 DMDEL2: MOVEI A,^Z ;DELETE A LINE PBOUT MOVEI A,177 ;ONE FILL CHAR SKIPN C,OSPEED MOVEI C,DEFOSP CAIL C,9600. PBOUT ;ONLY FOR 9600 BAUD OR MORE THOUGH SOJG Q,DMDEL2 JRST DMINS3 DMINS1: HRROI A,[.BYTE 7 ? ^L ? "` ? 0] PSOUT MOVEI A,(BP) XORI A,"` PBOUT MOVEI A,^P PBOUT RET DMDSMV: SAVE B SETZB A,B MOVEI B,(BP) ;DESIRED VPOS LSH B,8+4 XOR B,[.BYTE 8 ? ^L ? "` ? "` ? ^W] SKIPN DISCPH ;DESIRED HPOS = 0? JRST DMDSM2 ;YES, DONT NEED SECOND CURSOR ADDRESS THEN LSHC A,16.-4 CALL DMDSM1 LSH A,4 DMDSM2: MOVEM A,DISBF1+4 MOVEM B,DISBF1+5 JRST POPBJ DMDSM1: IOR B,DISCPH LSHC A,8. IORI B,(BP) LSHC A,4 XOR B,[.BYTE 8 ? 0 ? ^L ? "` ? "`] RET DMDMV1: SAVE B SETZB A,B CALL DMDSM1 JRST DMDSM2 DMINSC: SAVE C HRROI A,[.BYTE 7 ? ^P ? ^\ ? ^X ? 0] SKIPN C,OSPEED MOVEI C,DEFOSP CAIL C,9600. ;IF AT 9600 OR MORE, HRROI A,[.BYTE 7 ? ^P ? 40 ? 177 ? ^X ? ^H ? 40 ? ^H] ;USE HAIRY ONE PSOUT REST C SOJG Q,DMINSC RET DMDELC: SAVE C HRROI A,[.BYTE 7 ? ^P ? ^H ? ^X ? 0] SKIPN C,OSPEED MOVEI C,DEFOSP CAIL C,9600. ;IF AT 9600 OR MORE, HRROI A,[.BYTE 7 ? ^P ? ^H ? 177 ? ^X ? 0] PSOUT REST C SOJG Q,DMDELC RET ] ;DM2500 IFN H1500\HMOD1\H1510,[ SUBTTL H1500 AND HAZELTIME MODULAR ONE IFN HMOD1,[ HZM1TB: 8.*1000+24.,,79. ;DISPATCH VECTOR FOR HZ1500 (%TOMVB+%TOMVU+%TOLWR+%TOLID) CALL HZCPS CALL HZ1EOL CALL HZ1EOS CALL HZCLRS JFCL .VALUE CALL HZDMV1 CALL HZINSL CALL HZDELL REPEAT 9.,JFCL ] ;HMOD1 IFN H1500\H1510,[ HZ15TB: 8.*1000+24.,,79. ;DISPATCH VECTOR FOR HZ1500 (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID) CALL HZCPS CALL HZCEOL CALL HZCEOS CALL HZCLRS JFCL CALL HZDSMV CALL HZDMV1 CALL HZINSL CALL HZDELL REPEAT 9.,JFCL ];H1500\H1510 HZCPS: SAVE C MOVE C,[.BYTE 7 ? 176 ? ^Q ? "` ? "` ? 0] HRRZ A,B ADDI A,140 CAIL A,177 SUBI A,140 DPB A,[170700,,C] HLRZ A,B LSH A,7+1 IOR C,A HRROI A,C PSOUT REST C RET IFN H1500\H1510,[ ;THE STUPID MODULAR ONE DOESN'T HAVE THESE FUNCTIONS. HZCEOL: HRROI A,[.BYTE 7 ? 176 ? ^O ? 177 ?0] PSOUT RET HZCEOS: HRROI A,[.BYTE 7 ? 176? ^X ?177?177?177?177?177?0] PSOUT RET ];H1500\H1510 IFN HMOD1,[ HZ1EOS: ;CEOL IS AS CLOSE AS WE CAN COME TO CEOS HZ1EOL: JSR SAVABC ;CLEAR TO END OF SCREEN - WE PUT OUT ; ENOUGH SPACES TO GET TO END OF LINE ; EXCEPT IF AT LEFT HAND, KILL THE LINE SKIPGE C,EOLFLG ; NO. OF SPACES SET? JRST HZ1EO1 ; YES, USE THAT HRRZ C,TTLPOS ;C _ CURRENT POSITION JUMPE C,HZ1DIL ;IF C = 0 THEN DELETE; INSERT SUBI C,80. ;C _ - (80 - CURPOS) = NO. SPACES NEEDED HZ1EO1: HRROI B,SPACES MOVEI A,.PRIOU SOUT ;PUT OUT THAT MANY SPACES SETZM EOLFLG MOVE B,TTLPOS ;GO BACK WHERE WE WERE BEFORE CALL HZCPS JRST POPCBA HZ1DIL: HRROI A,[.BYTE 7 ? 176 ? 19. ? 176 ? 26. ? 0] ;DELETE, INSERT LINE PSOUT JRST POPCBA ] ;HMOD1 HZCLRS: HRROI A,[.BYTE 7 ? 176? ^\ ?177?177?177?177?0] PSOUT RET HZINSL: CALL HZIDPS HZINS1: HRROI A,[.BYTE 7 ? 176 ? ^Z ? 0] PSOUT MOVEI A,32. CALL EXPPAD SOJG Q,HZINS1 RET HZDELL: CALL HZIDPS HZDEL1: HRROI A,[.BYTE 7 ? 176 ? ^S ? 0] PSOUT MOVEI A,4 CALL EXPPAD SOJG Q,HZDEL1 RET HZIDPS: SAVE C MOVEI C,140(BP) LSH C,7+1 IOR C,[.BYTE 7 ? 176 ? ^Q ? "` ? "` ? 0] HRROI A,C PSOUT REST C RET IFN H1500\H1510,[ ;MOVE TO LINE START, CEOL, MOVE TO HPOS ON SAME LINE HZDSMV: SAVE B MOVEI A,(BP) ;DESIRED VPOS LSH A,4 IOR A,[.BYTE 8 ? 176 ? ^Q ? "` ? "`] ;MOVE TO LINE START MOVE B,[.BYTE 8 ? 176 ? ^O ? 177 ? 177] ;CEOL MOVEM A,DISBF1+3 MOVEM B,DISBF1+4 SETZM DISBF1+5 ;ASSUME NO HORIZ POSITIONING NECSY SKIPN DISCPH ;DESIRED HPOS = 0? JRST POPBJ ;YES, DONT NEED SECOND CURSOR ADDRESS THEN HZDSM2: MOVE A,[.BYTE 8 ? 176 ? ^Q ? "` ? "`] CALL HZDSM1 MOVEM A,DISBF1+5 JRST POPBJ ] ;H1500\H1510 HZDSM1: SAVE A DPB BP,[041000+P,,] ;VPOS MOVE B,DISCPH DPB B,[141000+P,,] ;HPOS JRST POPAJ HZDMV1: SAVE B SETZM DISBF1+3 ? SETZM DISBF1+4 JRST HZDSM2 ] ;H1500\H1510\HMOD1 IFN VT52\VT61\VT100\VT100V\VT100W\VT100X\TL4041\TL1061\HEATH\V200\PTV,[ SUBTTL VT52S OF VARIOUS SORTS IFN VT52,[ VT52TB: 24.,,79. ;DISPATCH VECTOR FOR VIRGIN VT52 (%TOERS+%TOMVB+%TOMVU+%TOLWR) CALL VTCPS CALL VTCEOL CALL VTCEOS CALL VTCLRS JFCL CALL VTDSMV CALL VTDMV1 REPEAT 11.,JFCL ] ;VT52 IFN VT61,[ VT61TB: 24.,,79. ;DISPATCH VECTOR FOR VT61 (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID) CALL VTCPS CALL VTCEOL CALL VTCEOS CALL VTCLRS JFCL CALL VTDSMV CALL VTDMV1 CALL VTINSL CALL VTDELL CALL VTINSC CALL VTDELC REPEAT 7,JFCL ;THE VT61 FLAVOUR OF I/D LINE/CHAR FOR A VT52 VTINSL: SKIPA A,["F] ;$PF - INSERT LINE VTDELL: MOVEI A,"D ;$PD - DELETE LINE SAVE A MOVEI A,"Y CALL OUTESC MOVEI A,40(BP) PBOUT MOVEI A,40 PBOUT VTINS1: MOVEI A,"P CALL OUTESC MOVE A,(P) ;GET DESIRED FUNCTION AGAIN PBOUT SOJG Q,VTINS1 JRST POPAJ VTDELC: HRROI A,[.BYTE 7 ? 33 ? "P ? "S ? 0] PSOUT SOJG Q,VTDELC RET VTINSC: HRROI A,[.BYTE 7 ? 33 ? "P ? "I ? 40 ? 33 ? "P ? "I+40 ? 10 ? 0] PSOUT SOJG Q,VTINSC RET ] ;VT61 IFN PTV,[ ;Plasma TV system version of VT52 PTVTB: 49.,,84. ;(Note hook in ^PK handler) (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOOVR+%TOFCI) CALL VTCPS CALL VTCEOL CALL VTCEOS CALL VTCLRS JFCL CALL VTDSMV CALL VTDMV1 REPEAT 11.,JFCL ] ;PTV IFN V200,[ V200TB: 24.,,79. ;DISPATCH VECTOR FOR VISUAL 200 (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID) CALL VTCPS CALL VTCEOL CALL V2CEOS CALL VTCLRS JFCL CALL VTDSMV CALL VTDMV1 CALL V2INSL CALL V2DELL CALL V2INSC CALL V2DELC REPEAT 7,JFCL V2CEOS: MOVEI A,"J ;CLEAR EOS NEEDS 2 PAD CHARS AT 9600 BAUD. CALL OUTESC MOVE A,OSPEED CAIGE A,9600. RET HRROI A,[.BYTE 7 ? 177 ? 177] PSOUT RET ;THE V200 FLAVOUR OF I/D LINE/CHAR FOR A VT52 V2INSL: SKIPA A,["L] ;$L - INSERT LINE V2DELL: MOVEI A,"M ;$M - DELETE LINE SAVE A MOVEI A,"Y ;FIRST GET TO THE RIGHT PLACE CALL OUTESC MOVEI A,40(BP) PBOUT MOVEI A,40 PBOUT V2INS1: MOVE A,(P) ;DESIRED FUNCTION CALL OUTESC MOVE A,OSPEED ;PADDING ONLY IF 9600 CAIGE A,9600. JRST V2INS2 HRROI A,[.BYTE 7 ? 177 ? 177 ? 0] ;TWO PAD CHARS PSOUT V2INS2: SOJG Q,V2INS1 JRST POPAJ V2DELC: MOVEI A,"O CALL OUTESC SOJG Q,.-1 RET V2INSC: HRROI A,[.BYTE 7 ? 33 ? "i ? 0] ;start insert PSOUT PUSH P,Q MOVEI A,40 ;make space PBOUT SOJG Q,.-1 ;once per char POP P,Q HRROI A,[.BYTE 7 ? 33 ? "j ? 0] ;end insert PSOUT MOVEI A,10 ;now go back to start PBOUT SOJG Q,.-1 RET ] ;V200 IFN TL4041\TL1061,[ TL40TB: 8.*1000+24.,,79. ;DISPATCH VECTOR FOR TELERAY 4041 (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID+%TOFCI) CALL VTCPS CALL VTCEOL CALL VTCEOS CALL VTCLRS JFCL CALL VTDSMV CALL VTDMV1 CALL TLINSL CALL TLDELL CALL TLINSC CALL TLDELC REPEAT 7,JFCL ;THE TELERAY 4041 VERSION OF I/D LINE/CHAR TLINSL: SKIPA A,["L] ;$L - INSERT LINE TLDELL: MOVEI A,"M ;$M - DELETE LINE SAVE A MOVEI A,"Y CALL OUTESC MOVEI A,40(BP) PBOUT MOVEI A,40 PBOUT REST A ;GET DESIRED FUNCTION AGAIN TLDEL1: CALL OUTESC SAVE A MOVE A,RGETTY CAIE A,TL106I JRST TLDEL2 MOVEI A,50. CALL TIMPAD TLDEL2: REST A SOJG Q,TLDEL1 RET TLDELC: MOVEI A,"Q CALL OUTESC SOJG Q,TLDELC RET TLINSC: MOVEI A,"P CALL OUTESC SOJG Q,TLINSC RET ] ;TL4041,TL1061 IFN VT100\VT100V\VT100W\VT100X,[ VT10TB: 24.,,79. ;DISPATCH VECTOR FOR VT100 IN ANSI MODE %TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID,,%TPRSC CALL VT1CPS CALL VT1CEL CALL VT1CES CALL VT1CLR JFCL CALL VT1DSM CALL VT1DMV REPEAT 4,JFCL ;LID ROUTINES NEVER GET CALLED CALL VT1RST CALL VT1SUP CALL VT1SDN CALL VT1INI CALL VT1RST REPEAT 2,JFCL VT15TB: 24.,,79. ;DISPATCH VECTOR FOR VT100 IN VT52 MODE %TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID,,%TPRSC CALL VTCPS CALL VTCEOL CALL VTCEOS CALL VT15CL JFCL CALL VTDSMV CALL VTDMV1 REPEAT 4,JFCL ;LID ROUTINES NEVER GET CALLED CALL VT15RS CALL VT1SUP CALL VT1SDN CALL VT15IN CALL VT15RS REPEAT 2,JFCL VT1WTB: 24.,,79. ;DISPATCH VECTOR FOR VT100 IN ANSI MODE INSIDE, VT52 OUTSIDE %TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID,,%TPRSC CALL VT1CPS CALL VT1CEL CALL VT1CES CALL VT1CLR JFCL CALL VT1DSM CALL VT1DMV REPEAT 4,JFCL ;LID ROUTINES NEVER GET CALLED CALL VT15RS CALL VT1SUP CALL VT1SDN CALL VT1INI CALL VT15RS REPEAT 2,JFCL VT1XTB: 24.,,79. ;DISPATCH VECTOR FOR VT100 IN VT52 MODE INSIDE, ANSI OUTSIDE %TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID,,%TPRSC CALL VTCPS CALL VTCEOL CALL VTCEOS CALL VT15CL JFCL CALL VTDSMV CALL VTDMV1 REPEAT 4,JFCL ;LID ROUTINES NEVER GET CALLED CALL VT1RST CALL VT1SUP CALL VT1SDN CALL VT15IN CALL VT1RST REPEAT 2,JFCL ; V1CPS - OUTPUT VT-100 CURSOR POSITIONING COMMANDS TO TERMINAL. ; ARGUMENT: ; B LINE,,COLUMN VT1CPS: SAVE B ; HRROI A,[ASCIZ /[/] ;] PSOUT ; JUMPE B,VT1CP8 ; SKIP ALL THIS FOR HOMING HLRZ A,B ; VERTICAL POS AOS A ; USES 1 BASED ADDRESSING CALL VT1PAR ; HRRZ A,B ; JUMPE A,VT1CP8 ; SAVE A ; MOVEI A,"; ; PBOUT ; REST A ; AOS A ; CALL VT1PAR ; VT1CP8: MOVEI A,"H ; PBOUT ; REST B ; RET ; ; VT1ESC - OUTPUT ANSII CONTROL SEQUENCE INTRODUCER (CSI) VT1ESC: SAVE A HRROI A,[ASCIZ /[/] ;] PSOUT ; REST A ; PBOUT ; RET ; ; VT1PAR - OUTPUT ASCII STRING EQUIVALENT TO NUMBER IN A ; ARGUMENT: ; A NUMBER TO BE CONVERTED TO A STRING OF ASCII DIGITS ; ASSUMES SCREEN WIDTH OF LESS THAN 999! (IE. 132 COL MODE WORKS) VT1PAR: SAVE B ; IDIVI A,10. ; SAVE B ; JUMPE A,VT1PA1 ; IDIVI A,10. ; JUMPE A,VT1PA2 ; ADDI A,"0 ; PBOUT ; VT1PA2: MOVEI A,"0(B) ; PBOUT ; VT1PA1: REST B ; MOVEI A,"0(B) ; PBOUT ; REST B ; RET ; ; VT1CEL - CLEAR FROM CURSOR TO END OF LINE VT1CEL: MOVEI A,"K ; JRST VT1ESC ; ; VT1CES - CLEAR FROM CURSOR TO END OF SCREEN VT1CES: MOVEI A,"J ; JRST VT1ESC ; ; VT1CLR - CLEAR WHOLE SCREEN VT1CLR: HRROI A,[ASCIZ //] ;]] PSOUT ; clear screen RET ; ; VT1DSM - CALC. VT-100 COMMANDS TO MOVE TO THE SPECIFIED POSITION AND ; CLEAR THE WHOLE LINE. THE COMMANDS ARE PUT IN DISBF1, AS CLOSE TO DISBUF ; AS POSSIBLE. 8 BIT BYTES ARE USED. ; ARGUMENTS: ; BP LINE NO. ; DISCPH COLUMN NO. VT1DSM: MOVEI A,2 ; SET UP INDEX INTO DISBF1 CALL VT1DAA ; GO PUT COMMANDS TO MOVE INTO DISBF1 MOVE A,[.BYTE 8 ? 33 ? "[ ? "2 ? "K] ;] SET UP TO CLEAR A LINE MOVEM A,DISBF1+5 ; CLEAR GOES AT END RET ; VT1DMV - SAME AS VT1DSM EXCEPT DOESN'T CLEAR. ; ARGUMENTS: ; BP LINE NO. ; DISCPH COLMN NO. VT1DMV: MOVEI A,3 ; SET UP INDEX INTO DISBF1 CALL VT1DAA ; GO PUT MOVE IN DISBF1 RET ; ; VT1DAA - PUT COMMAND TO MOVE TO A LOCATION, IN DISBF1 (INDEXED BY A) ; ARGUMENTS: ; A INDEX TO STARTING WORD OF STRING IN DISBF1 ; BP LINE NO. ; DISCPH COLUMN NO. VT1DAA: SAVE B ; SAVE C ; MOVE C,[.BYTE 8 ? 0 ? 0 ? 0 ? 33] ; FIRST LINE MOVEM C,DISBF1(A) ; AND PUT IT IN AOS A ; AND POINT TO NEXT SAVE A ; HIDE INDEX MOVE A,BP ;GET TARGET LINE AOS A ; ONE BASED ADDRESSING IDIVI A,10. ; GET TWO DIGITS (ASSUME LINE NO. <99) LSH A,8. ; MOVE MSD UP 1 CHAR ADDI B,(A) ; AND ADD IN LSD LSH B,8.+4 ; AND MOVE TO CORRECT POSITION IN WORD ADD B,[.BYTE 8 ? "[ ? "0 ? "0 ? ";] ;] AND ADD OTHER CHARS. REST A ; GET BACK INDEX MOVEM B,DISBF1(A) ; AND PUT STRING IN DISBF1 AOS A ; BUMP INDEX SAVE A ; AND HIDE IT AGAIN UNTILL WE GET COL. MOVE A,DISCPH ; GET COL. NO. AOS A ; AND ADD 1 IDIVI A,10. ; AND SPLIT OFF 10'S AND 100'S SAVE B ; HIDE UNITS IDIVI A,10. ; SEPARATE 100'S AND 10'S LSH A,8. ; SHIFT UP 100'S ADDI A,(B) ; AND ADD BACK IN 10'S LSH A,8. ; SHIFT THEM UP REST B ; GET BACK UNITS ADDI A,(B) ; AND ADD THEM IN MOVEM A,B ; LSH B,8.+4 ; AND PUT THEM IN THE RIGHT POSITION ADD B,[.BYTE 8 ? "0 ? "0 ? "0 ? "H] ; ADD IN ASCII STRING REST A ; GET INDEX BACK MOVEM B,DISBF1(A) ; AND PUT STRING IN DISBF1 REST C ; REST B ; RET ; VT1RST: HRROI A,[ASCIZ /<78/] ;] RESET SCROLL REGION PSOUT RET VT15CL: HRROI A,[ASCIZ "<[?2lHJ"] ;] PSOUT RET VT15RS: HRROI A,[ASCIZ /<78[?2l/] ;]] RESET SCROLL REGION PSOUT RET ;SCROLL Q LINES STARTING WITH LINE IN BP UP VT1SUP: PUSH P,["D] ;INDEX NEEDED TO CAUSE SCROLLING (DOESNT TAKE ARGUMENT) JSP A,VT1SCR ;SETUP SCROLL REGION AND BYTE POINTER IN A MOVE B,BOTLIN ;POSITION TO BOTTOM OF SCROLL REGION, OFFSET VT1UP2: CALL VT1ARG MOVEI B,"H IDPB B,A MOVEI B,0 IDPB B,A ;MAKE ASCIZ OF POSITIONING STUFF HRROI A,VT1BUF PSOUT ;TYPE IT ALL OUT VT1UP3: MOVE A,-2(P) ;GET CURSOR COMMAND CALL OUTESC ;SCROLL RIGHT DIRECTION MOVEI A,10. CALL EXPPAD SOJG Q,VT1UP3 MOVE A,RGETTY CAIE A,VT152I CAIN A,VT10XI SKIPA JRST POPCBA HRROI A,[ASCIZ /[?2l/] ;] BACK INTO VT52 MODE PSOUT JRST POPCBA ;ALSO FLUSH SCROLLING COMMAND VT1SDN: PUSH P,["M] ;REVERSE INDEX TO SCROLL JSP A,VT1SCR ;SETUP SCROLL REGION MOVEI B,1(BP) ;MOVE TO TOP LINE, OFFSET JRST VT1UP2 VT1SCR: PUSH P,B PUSH P,C PUSH P,A ;SAVE RETURN ADDRESS AS WELL MOVE A,[440700,,VT1BUF] ;MAKE STRING POINTER MOVE B,RGETTY CAIE B,VT152I CAIN B,VT10XI SKIPA JRST VT1SC1 MOVEI B,33 IDPB B,A MOVEI B,"< ;ENTER ANSI MODE IDPB B,A VT1SC1: MOVEI B,1(BP) ;STARTING LINE, OFFSET CALL VT1ARG MOVEI B,"; IDPB B,A MOVE B,BOTLIN ;BOTTOM LINE, OFFSET CALL VT1AR1 MOVEI B,"r ;SET SCROLL REGION IDPB B,A RET VT1INI: HRROI A,[ASCIZ "<"] ; FORCE ANSII MODE PSOUT RET VT15IN: HRROI A,[ASCIZ "<[?2l"] ;] FORCE VT52 MODE PSOUT RET VT1ARG: MOVEI C,33 IDPB C,A MOVEI C,"[ ;] IDPB C,A VT1AR1: IDIVI B,10. JUMPE B,VT1AR2 ;NO TENS DIGIT ADDI B,"0 IDPB B,A ;ELSE PUT IT IN VT1AR2: ADDI C,"0 IDPB C,A ;AND DIGITS RET ];VT100\VT100V\VT100W\VT100X IFN HEATH,[ HTHTB: 5*1000+24.,,79. (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID) CALL VTCPS CALL VTCEOL CALL VTCEOS CALL VTCLRS JFCL CALL VTDSMV CALL VTDMV1 CALL HTINSL CALL HTDELL CALL HTINSC CALL HTDELC REPEAT 5,JFCL CALL HTINVI ; FOR THE INVERSE VIDEO STUFF CALL HTINVC HTINVI: SAVE A HRROI A,[ASCIZ/p/] PSOUT JRST POPAJ HTINVC: SAVE A HRROI A,[ASCIZ/q/] PSOUT JRST POPAJ HTINSC: MOVEI A,"@ CALL OUTESC CALL OUTNSP MOVEI A,^H CALL OUTN MOVEI A,"O JRST OUTESC HTDELC: MOVEI A,"N CALL OUTESC SOJG Q,HTDELC RET HTINSL: SKIPA A,["L] HTDELL: MOVEI A,"M SETZM PADCHR ;MUST USE NULLS FOR PADDING SAVE A MOVEI A,"Y CALL OUTESC MOVEI A,40(BP) PBOUT MOVEI A,40 PBOUT CAILE Q,3 ;;;IF OVER 2 JRST HTANSI ;USE ANSI MODE HTINS1: MOVE A,(P) CALL OUTESC MOVEI A,30 CALL TIMPAD SOJG Q,HTINS1 JRST POPAJ HTANSI: HRROI A,[ASCIZ "<["] ; ] PSOUT MOVE A,Q IDIVI A,10. ADDI A,"0 CAIE A,"0 PBOUT MOVEI A,"0(B) PBOUT REST A PBOUT HTANS1: MOVEI A,30 IMULI A,(Q) CALL TIMPAD HRROI A,[ASCIZ "[?2h"] ; ] PSOUT RET ] ;IFN HEATH VTCPS: JUMPE B,[MOVEI A,"H ;HOME IS EASY JRST OUTESC] MOVEI A,"Y ;ELSE SEND $Y CALL OUTESC HLRZ A,B ADDI A,40 ;+40 PBOUT MOVEI A,40(B) ;+40 PBOUT RET VTCEOL: MOVEI A,"K ;CLEAR EOL JRST OUTESC VTCLRS: MOVEI A,"H ;CLEAR SCREEN CALL OUTESC VTCEOS: MOVEI A,"J ;CLEAR EOS CALL OUTESC MOVE A,RGETTY CAIE A,VT52I ;REAL VT52 NEEDS PADDING AFTER CLEAR SCREEN RET SAVE C SKIPN A,OSPEED ;ABOVE 4800 BAUD, TO AVOID ^S^Q LOSSAGE. MOVEI A,DEFOSP SETZ C, CAIN A,9600. MOVEI C,26. ;26 RUBOUTS AT 9600 BAUD, 5 AT 4800 CAIE A,4800. ;(EMPIRICALLY DETERMINED. DON'T ASK ME WHY). MOVEI C,5 SKIPE A,C CALL EXPPAD JRST POPCJ VTDSMV: SAVE B MOVEI B,40(BP) LSH B,24.+4 IOR B,[.BYTE 8 ? 0 ? 40 ? 33 ? "K] MOVE A,[.BYTE 8 ? 0 ? 0 ? 33 ? "Y] SKIPE DISCPH ;DESIRED HPOS = 0? JRST VTDSM2 ;NO, MUST GO THERE AFTERWARDS MOVEM A,DISBF1+4 ;JUST $Y ? $K MOVEM B,DISBF1+5 JRST POPBJ VTDSM2: MOVEM A,DISBF1+3 ;NEED HPOS TOO, USE $Y ? $K ? ... MOVEM B,DISBF1+4 CALL VTDMV1 JRST POPBJ VTDMV1: MOVEI A,(BP) ;DESIRED VPOS LSH A,8 IOR A,DISCPH LSH A,4 ADD A,[.BYTE 8 ? 33 ? "Y ? 40 ? 40] MOVEM A,DISBF1+5 ;$Y RET ] ;VT52 IFN FOX\OWL\BANTAM,[ SUBTTL FOX AND OWL IFN FOX,[ FOXTB: 24.,,79. ;DISPATCH VECTOR FOR PERKIN-ELMER FOX (%TOERS+%TOMVB+%TOMVU+%TOLWR) CALL FXCPS CALL FXCEOL CALL FXCEOS CALL FXCLRS JFCL CALL FXDSMV CALL FXDMV1 REPEAT 11.,JFCL ];FOX IFN OWL,[ OWLTB: 24.,,79. ;DISPATCH VECTOR FOR PERKIN-ELMER OWL (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID) CALL FXCPS CALL FXCEOL CALL OWCEOS CALL OWCLRS JFCL CALL FXDSMV CALL FXDMV1 CALL OWINSL CALL OWDELL CALL OWINSC CALL OWDELC REPEAT 7,JFCL ];OWL IFN BANTAM,[ BANTB: 24.,,79. ;DISPATCH VECTOR FOR PERKIN-ELMER BANTAM (%TOERS+%TOMVB+%TOMVU+%TOLWR) CALL FXCPS CALL BTCEOL ; ONLY THESE THREE ARE DIFFERENT CALL BTCEOS ; ... CALL BTCLRS ; ... JFCL CALL FXDSMV CALL FXDMV1 REPEAT 11.,JFCL ];BANTAM FXCPS: JUMPE B,[MOVEI A,"H ;HOME IS EASY JRST OUTESC] MOVEI A,"X ;ELSE SEND $X CALL OUTESC HLRZ A,B ADDI A,40 ;+40 PBOUT MOVEI A,"Y ;$Y CALL OUTESC MOVEI A,40(B) ;+40 PBOUT RET FXCEOL: MOVEI A,"I ;CLEAR EOL JRST OUTESC FXCLRS: MOVEI A,"H ;CLEAR SCREEN CALL OUTESC MOVEI A,"J ;FOX NEEDS DELAY LIKE VT52 CALL OUTESC ;TO ALLOW CLEAR TO WORK SKIPN A,OSPEED ;CHECK SPEED MOVEI A,DEFOSP CAIG A,2400. ;HIGH SPEED? RET ;NO, EASY WAY MOVEI A,100. ;DELAY 100 MSEC DISMS ;PADDING MESSES UP THE SCREEN. RET FXCEOS: MOVEI A,"J ;CLEAR EOS JRST OUTESC IFN OWL,[ OWCLRS: MOVEI A,"H ;CLEAR SCREEN CALL OUTESC OWCEOS: MOVEI A,"J ;CLEAR EOS CALL OUTESC SAVE BP MOVEI BP,0 ;OWL NEEDS PADDING FOR THIS. CALL OWIDPD JRST POPBPJ ];OWL FXDSMV: SAVE B MOVEI B,(BP) ;DESIRED VPOS SKIPE A,DISCPH ;DESIRED HPOS = 0? JRST FXDSM2 ;NO, MUST GO THERE AFTERWARDS LSH B,8+4 ADD B,[.BYTE 8 ? 33 ? "X ? 40 ? 33] ;$X$ MOVE A,[.BYTE 8 ? "Y ? 40 ? 33 ? "I] ;Y$I FXDSM1: MOVEM B,DISBF1+4 MOVEM A,DISBF1+5 JRST POPBJ FXDSM2: LSHC A,4 ADD B,[.BYTE 8 ? 0 ? 33 ? "X ? 40] ;$X MOVEM B,DISBF1+3 MOVE B,[.BYTE 8 ? 33 ? "Y ? 40 ? 33] ;$Y<0>$ ADD A,[.BYTE 8 ? "I ? 33 ? "Y ? 40] ;I$Y JRST FXDSM1 FXDMV1: MOVE A,[.BYTE 8 ? 0 ? 0 ? 33 ? "X] MOVEM A,DISBF1+4 ;$X MOVEI A,(BP) ;DESIRED VPOS LSH A,24. IOR A,DISCPH LSH A,4 ADD A,[.BYTE 8 ? 40 ? 33 ? "Y ? 40] MOVEM A,DISBF1+5 ;$Y RET IFN OWL,[ ; OWINSL - OUTPUT OWL COMMANDS TO INSERT SEVERAL BLANK LINES. ; ARGUMENTS: ; BP LINE NO. AT WHICH TO INSERT ; Q NO. OF LINES TO INSERT OWINSL: MOVEI A,"L ; $L - INSERT LINE JRST OWDEL1 ; OWDELL - OUTPUT OWL COMMANDS TO DELETE SEVERAL LINES. ; ARGUMENTS: ; BP LINE NO. AT WHICH TO DELETE ; Q NO. OF LINES TO DELETE OWDELL: MOVEI A,"M ; $M - DELETE LINE OWDEL1: SAVE B ; SAVE AC MOVS B,BP ; HPCPS ARG: LINE NO.,,COLUMN NO. SAVE A CALL FXCPS ; MOVE TO DESIRED LINE NO. REST A MOVEI B,33 ; ESC OWID1: EXCH A,B PBOUT ; OUTPUT ESC EXCH A,B PBOUT ; OUTPUT "L" OR "M" CALL OWIDPD ;PAD THE INSERT/DELETE. SOJG Q,OWID1 JRST POPBJ ;PAD AN INSERT OR DELETE LINE OPERATION. ;EACH OPERATION REQUIRES 5MS PADDING PER LINE MOVED. ;THE VPOS OF THE LINE WE ARE OPERATING ON IS IN BP. OWIDPD: SAVE A MOVE A,NVLNS SUB A,BP ;NUMBER OF LINES BEING MOVED. IMULI A,5 CALL TIMPAD JRST POPAJ OWDELC: HRROI A,[ASCIZ "O"] PSOUT SOJG Q,OWDELC RET OWINSC: HRROI A,[.BYTE 7 ? " ? "N ? 40 ? 177 ? 177 ? 177 ? 177 ? ^H ? 0] PSOUT SOJG Q,OWINSC RET ];OWL IFN BANTAM,[ BTCEOS: ; HAVE TO JUST FAKE CLEAR TO EOS WITH CEOL BTCEOL: SKIPA A,["I] ; CLEAR EOL BTCLRS: MOVEI A, "K ; CLEAR SCREEN, NO MOVEMENT NEEDED CALL OUTESC ; DO IT MOVEI A,20. ; MUST PAD FOR 20 MS JRST TIMPAD ] ;BANTAM ] ;FOX, OWL AND BANTAM IFN DM1520,[ SUBTTL DM1520 DM15TB: 24.,,79. ;DISPATCH VECTOR FOR DATAMEDIA 1520 (%TOERS+%TOMVB+%TOMVU+%TOLWR) CALL D1CPS CALL D1CEOL CALL D1CEOS CALL D1CLRS JFCL CALL D1DSMV CALL D1DMV1 REPEAT 11.,JFCL D1CPS: JUMPE B,[MOVEI A,^Y ;HOME IS EASY PBOUT RET] MOVEI A,^^ ;ELSE ^^ PBOUT MOVEI A,40(B) PBOUT HLRZ A,B ADDI A,40 D1CP2: PBOUT RET D1CEOS: MOVEI A,^K ;ERASE EOS JRST D1CP2 ;[ D1CEOL: MOVEI A,^] ;ERASE EOL JRST D1CP2 D1CLRS: MOVEI A,^L ;ERASE SCREEN JRST D1CP2 D1DSMV: SAVE B SETZB A,B MOVEI B,(BP) ;DESIRED VPOS LSH B,8+4 ;[ ADD B,[.BYTE 8 ? ^^ ? 40 ? 40 ? ^] ] SKIPN DISCPH ;DESIRED HPOS = 0? JRST D1DSM2 ;YES, DONT NEED SECOND CURSOR ADDRESS THEN LSHC A,16.-4 CALL D1DSM1 LSH A,4 D1DSM2: MOVEM A,DISBF1+4 MOVEM B,DISBF1+5 JRST POPBJ D1DSM1: IOR B,DISCPH LSHC A,8. IORI B,(BP) LSHC A,4 ADD B,[.BYTE 8 ? 0 ? ^^ ? 40 ? 40] RET D1DMV1: SAVE B SETZB A,B CALL D1DSM1 JRST D1DSM2 ] ;DM1520 IFN DM3052,[ DM35TB: 24.,,79. ;DISPATCH VECTOR FOR DATAMEDIA 3000 (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID) CALL VTCPS CALL VTCEOL CALL VTCEOS CALL VTCLRS JFCL CALL VTDSMV CALL VTDMV1 CALL D5INSL CALL D5DELL CALL D5INSC CALL D5DELC REPEAT 7,JFCL D5DELC: HRROI A,[.BYTE 7 ? 33 ? "P ? 33 ? "D ? 33 ? "Q ? 0] PSOUT SOJG Q,D5DELC RET D5INSC: MOVEI A,"P CALL OUTESC ;ENTER INSERT MODE CALL OUTNSP ;INSERT SPACES MOVEI A,"Q ;LEAVE INSERT MODE CALL OUTESC MOVEI A,^H ;BACK OVER THEM. JRST OUTN D5INSL: SAVE B ;SAVE AC MOVS B,BP ;VTCPS ARG CALL VTCPS ;MOVE TO LOCATION MOVEI A,"P ;TURN INSERT DELETE MODE ON CALL OUTESC MOVEI A,12 ;LINE FEED GETS US INSERT LINE CALL OUTN MOVEI A,"Q ;TURN OFF INSERT DELETE MODE CALL OUTESC JRST POPBJ D5DELL: SAVE B ;SAVE AC MOVS B,BP ;VTCPS ARG CALL VTCPS ;MOVE TO LOCATION MOVEI A,"P ;TURN INSERT DELETE MODE ON CALL OUTESC D5DL1: MOVEI A,"A ; A DELETES A LINE CALL OUTESC SOJG Q,D5DL1 ;MORE LINES... MOVEI A,"Q ;TURN OFF INSERT DELETE MODE CALL OUTESC JRST POPBJ ] ;DM3052 IFN DM3045,[ SUBTTL DM3045 DM34TB: 24.,,79. ;DISPATCH VECTOR FOR DATAMEDIA 3000 (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOCID) ;KNOW HE HAS THESE CALL D3CPS CALL D3CEOL CALL D3CEOS CALL D3CLRS JFCL CALL D3DSMV CALL D3DMV1 JFCL JFCL CALL D3INSC CALL D3DELC REPEAT 7,JFCL D3CPS: JUMPE B,[MOVEI A,"H ;HOME IS EASY JRST OUTESC] MOVEI A,"Y ;ELSE SEND $Y CALL OUTESC HRRZ A,B ADDI A,40 ;+40 PBOUT HLRZ A,B ADDI A,40 ;+40 PBOUT RET D3CEOL: MOVEI A,"K ;CLEAR EOL JRST OUTESC D3CLRS: MOVEI A,"H ;CLEAR SCREEN CALL OUTESC D3CEOS: MOVEI A,"J ;CLEAR EOS JRST OUTESC D3DSMV: SAVE B MOVEI B,40(BP) LSH B,16.+4 IOR B,[.BYTE 8 ? 40 ? 0 ? 33 ? "K] MOVE A,[.BYTE 8 ? 0 ? 0 ? 33 ? "Y] SKIPE DISCPH ;DESIRED HPOS = 0? JRST D3DSM2 ;NO, MUST GO THERE AFTERWARDS MOVEM A,DISBF1+4 ;JUST $Y ? $K MOVEM B,DISBF1+5 JRST POPBJ D3DSM2: MOVEM A,DISBF1+3 ;NEED HPOS TOO, USE $Y ? $K ? ... MOVEM B,DISBF1+4 CALL D3DMV1 JRST POPBJ D3DMV1: MOVE A,DISCPH ;DESIRED HPOS LSH A,8 IOR A,BP LSH A,4 ADD A,[.BYTE 8 ? 33 ? "Y ? 40 ? 40] MOVEM A,DISBF1+5 ;$Y RET D3DELC: MOVEI A,"B CALL OUTESC SOJG Q,D3DELC RET D3INSC: MOVEI A,"R CALL OUTESC SOJG Q,D3INSC RET ] ;DM3045 IFN IMLAC\SIMLAC,[ SUBTTL IMLAX IMLCTB: 44.,,88. ;DISPATCH TABLE FOR IMLAX (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID+%TOOVR) CALL IMCPS CALL IMCEOL CALL IMCEOS CALL IMCLRS JFCL CALL IMDSMV CALL IMDMV1 CALL IMINSL CALL IMDELL CALL IMINSC CALL IMDELC REPEAT 7,JFCL SIMLTB: 61.,,94. ;DISPATCH TABLE FOR SIMULATED IMLAX %TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID+%TOOVR+%TOFCI+%TOSAI,,%TPRSC CALL IMCPS CALL IMCEOL CALL IMCEOS CALL IMCLRS JFCL CALL IMDSMV CALL IMDMV1 CALL IMINSL CALL IMDELL CALL IMINSC CALL IMDELC JFCL CALL IMLWUP CALL IMLWDN JFCL JFCL JFCL JFCL IMCPS: MOVEI A,217 ;%TDMV0 CALL IMCEO2 HLRZ A,B ;VPOS PBOUT MOVEI A,(B) ;HPOS IMCPS2: PBOUT RET IMCEOS: MOVEI A,202 ;%TDEOF IMCEO2: SAVE A MOVEI A,177 ;SEND > 200 BY ESCAPING FIRST PBOUT REST A SUBI A,176 ;SEND REST JRST IMCPS2 IMCEOL: MOVEI A,203 ;%TDEOL JRST IMCEO2 IMCLRS: MOVEI A,220 ;%TDCLR JRST IMCEO2 IMINSL: SKIPA A,[223] ;%TDILP IMDELL: MOVEI A,224 ;%TDDLP SAVE A ;SAVE DESIRED FUNCTION MOVEI A,217 ;%TDMV0 TO BEGINNING OF DESIRED LINE CALL IMCEO2 MOVEI A,(BP) ;VPOS PBOUT MOVEI A,0 PBOUT REST A ;GET BACK DESIRED FUNCTION CALL IMCEO2 MOVEI A,(Q) ;GET REPEAT COUNT JRST IMCPS2 IMLWUP: SKIPA A,[232] ;%TDRSU IMLWDN: MOVEI A,233 ;%TDRSD SAVE A MOVEI A,217 ;%TDMV0 TO THE BEGINNING OF THE DESIRED LINE CALL IMCEO2 MOVE A,BP PBOUT MOVEI A,0 PBOUT REST A CALL IMCEO2 MOVE A,BOTLIN SUB A,BP PBOUT MOVE A,Q JRST IMCPS2 IMINSC: SKIPA A,[225] ;%TDICP IMDELC: MOVEI A,226 ;%TDDCP CALL IMCEO2 MOVE A,Q ;NUMBER OF CHARS TO INSERT/DELETE JRST IMCPS2 IMDSMV: SAVE B MOVEI B,(BP) LSH B,24.+4 IOR B,[.BYTE 8 ? 0 ? 0 ? 177 ? 203-176] MOVE A,[.BYTE 8 ? 0 ? 0 ? 177 ? 217-176] SKIPE DISCPH ;DESIRED HPOS = 0? JRST IMDSM2 ;NO, MUST GO THERE AFTERWARDS MOVEM A,DISBF1+4 ;JUST %TDMV0 ? %TDEOL MOVEM B,DISBF1+5 JRST POPBJ IMDSM2: MOVEM A,DISBF1+3 ;HPOS TOO, %TDMV0 ? %TDEOL ? ... MOVEM B,DISBF1+4 IMDMV1: MOVEI A,(BP) ;DESIRED VPOS LSH A,8 IOR A,DISCPH LSH A,4 ADD A,[.BYTE 8 ? 177 ? 217-176 ? 0 ? 0] MOVEM A,DISBF1+5 ;%TDMV0 RET ] IFN VT05,[ SUBTTL VT05 VT05TB: 20.,,71. ;DISPATCH VECTOR FOR VT05 (%TOERS+%TOMVB+%TOMVU) ;CANT EVEN DISPLAY LOWERCASE CALL V0CPS CALL V0CEOL CALL V0CEOS CALL V0CLRS JFCL CALL V0DSMV CALL V0DMV1 REPEAT 11.,JFCL ;[ V0CPS: JUMPE B,[MOVEI A,^] ;HOME IS EASY JRST V0EOS2] ;WELL, AS EASY AS ANYTHING ELSE MOVEI A,^N PBOUT HLRZ A,B ADDI A,40 CALL V0EOS2 ;TYPE YPOS+40 AND FILL (MUST FILL IN THE MIDDLE OF IT!) MOVEI A,40(B) ;THEN XPOS+40 PBOUT RET ;[ V0CLRS: MOVEI A,^] ;HOME CALL V0EOS2 ;WITH FILL V0CEOS: MOVEI A,^_ ;CLEAR EOS V0EOS2: PBOUT V0FILL: SETZ A, ;NEEDS 4 NULLS (CANT BE RUBOUTS CAUSE SENT IN MIDDLE REPEAT 4,PBOUT ;OF THE CURSOR ADDRESSING) RET V0CEOL: MOVEI A,^^ JRST V0EOS2 V0DSMV: SAVE B MOVEI A,40(BP) LSH A,16.+4 TLO A,(.BYTE 8 ? ^N ? 0) MOVE B,[.BYTE 8 ? 0 ? 0 ? 40 ? ^^] SKIPE DISCPH ;ANY HPOS? JRST V0DSM2 ;YES MOVEM A,DISBF1+3 MOVEM B,DISBF1+4 JRST POPBJ V0DSM2: MOVEM A,DISBF1+1 MOVEM B,DISBF1+2 V0DSM3: MOVEM A,DISBF1+4 MOVE B,DISCPH ;GET HPOS ADDI B,40 LSH B,8+4 MOVEM B,DISBF1+5 JRST POPBJ V0DMV1: SAVE B MOVEI A,40(BP) LSH A,16.+4 TLO A,(.BYTE 8 ? ^N ? 0) JRST V0DSM3 ] ;IFN VT05 IFN TK4025,[ SUBTTL TEKTRONIX 4025S ; BECAUSE OF THE LOOSING FEATURE OF THE 4025 TERMINALS THAT WILL NOT ALLOW IT ; TO INSERT A LINE ABOVE THE TOP LINE, WE HAVE TO FAKE IT INTO THINKING IT ; HAS ONLY 33 LINES, STARTING ONE FROM THE TOP. TK40TB: 33.,,78. ;DISPATCH TABLE FOR TEKTRONIX 4025 (%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID) CALL TKCPS CALL TKCEOL CALL TKCEOS CALL TKCLRS JFCL .VALUE CALL TKDMV1 CALL TKINSL CALL TKDELL CALL TKINSC CALL TKDELC REPEAT 7,JFCL ; TKCPS - OUTPUT TEK4025 CURSOR POSITIONING COMMANDS TO TERMINAL. ; ARGUMENT: ; B LINE,,COLUMN TKCPS: JUMPE B,[HRROI A,[ASCIZ / `UP34;`DOW;/] JRST TKCLR2] ;IF HOME, BE SURE TO RESYNCH SAVE B ;SAVE DESIRED POSITION SAVE TTLPOS ;WHERE WE ARE NOW. HLRZ B,TTLPOS ;JUST ROW CAIL B,28. ;CAN'T TRUST IT IF AT MODE LINE OR BELOW JRST TKCPS8 ;SO USE FUDGED ABSOLUTE HLRZ A,-1(P) ;GET NEW SUBI B,(A) ;GET OLD-NEW JUMPE B,TKCPS1 ;NO DIFF THERE HRROI A,[ASCIZ /`DOW/] ;ASSUME NEGATIVE => DOWN SKIPL B HRROI A,[ASCIZ /`UP/] ;POSITIVE => UP PSOUT CALL TKCPS7 TKCPS1: REST B ;GET BACK OLD ANDI B,-1 ;JUST COL HRRZ A,(P) ;GET NEW SUBI B,(A) JUMPE B,POPBJ JUMPE A,[MOVEI A,^M ;FASTER IF GOING TO BEGINNING OF LINE PBOUT JRST POPBJ] HRROI A,[ASCIZ /`RIG/] ;ASSUME NEGATIVE => RIGHT SKIPL B HRROI A,[ASCIZ /`LEF/] PSOUT CALL TKCPS7 JRST POPBJ TKCPS7: MOVM A,B SOJE A,TKCPS3 TKCPS2: CALL TKCPS4 TKCPS3: MOVEI A,"; PBOUT RET TKCPS4: SAVE [PBOUT] TKCPS5: SAVE B AOJ A, ;OFFSET TO 1,1 AS ORIGIN IDIVI A,10. JUMPE A,TKCPS6 MOVEI A,"0(A) XCT -1(P) TKCPS6: MOVEI A,"0(B) XCT -1(P) JRST POPBAJ TKCPS8: HRROI A,[ASCIZ / `UP34;/] PSOUT REST B ;POP OFF OLD STUFF HLRZ B,(P) ;GET LINE AOJ B, ;THE REAL LINE IS ONE LOWER HRROI A,[ASCIZ /`DOW/] PSOUT CALL TKCPS7 TKCPS9: HRRZ B,(P) JUMPE B,POPBJ HRROI A,[ASCIZ /`RIG/] PSOUT CALL TKCPS7 JRST POPBJ TKCEOS: ; CLOSE ENOUGH FOR MOST THINGS TKCEOL: JSR SAVABC ; SAVE ACs SKIPGE C,EOLFLG ; NO. OF SPACES SET? JRST TKCEO1 ; YES, USE THAT HRRZ C,TTLPOS ; GET CURRENT POSITION SUBI C,79. ; MAKE HPOS-79 FOR NEGATIVE COUNT TKCEO1: HRROI B,SPACES MOVEI A,.PRIOU SOUT SETZM EOLFLG MOVEI A,^M PBOUT ; BACK TO LEFT HRRZ B,TTLPOS ; GET BACK OLD POS JUMPE B,POPCBA HRROI A,[ASCIZ /`RIG/] PSOUT CALL TKCPS7 JRST POPCBA TKCLRS: HRROI A,[ASCIZ /`ERA;/] TKCLR2: PSOUT RET TKINSC: HRROI A,[ASCIZ "`ICH;"] PSOUT CALL OUTNSP HRROI A,[ASCIZ "`LEF"] PSOUT SOSE A,Q JRST TKCPS2 JRST TKCPS3 TKDELC: HRROI A,[ASCIZ /`DCH;/] PSOUT SOJG Q,TKDELC RET ; TKDELL - OUTPUT TEK4025 COMMANDS TO DELETE SEVERAL LINES. ; ARGUMENTS: ; BP LINE NO. AT WHICH TO DELETE ; Q NO. OF LINES TO DELETE TKDELL: MOVS B,BP CALL TKCPS MOVEM B,TTLPOS HRROI A,[ASCIZ /`DLI/] PSOUT MOVEI A,(Q) SOJA A,TKCPS2 ;ACCOUNT FOR INCREMENTING THAT WILL BE DONE ; TKINSL - OUTPUT TEK4025 COMMANDS TO INSERT SEVERAL BLANK LINES. ; ARGUMENTS: ; BP LINE NO. AT WHICH TO INSERT ; Q NO. OF LINES TO INSERT TKINSL: MOVSI B,-1(BP) JUMPGE B,.+2 MOVEI B,0 ; THIS WILL LOSE BUT ITS BETTER THAN NOTHING CALL TKCPS MOVEM B,TTLPOS SKIPN BP ;IF NOT THE TOP LINE, WE CAN SKIP THIS CALL [HRROI A,[ASCIZ /`UP;/] PSOUT ;DON'T ASK, IT IS THE DUMB TERMINAL'S FAULT RET] HRROI A,[ASCIZ /`ILI/] PSOUT MOVEI A,(Q) SOS A CALL TKCPS2 HRROI A,[ASCIZ /`UP/] ;REPOSITION CURSOR PSOUT MOVEI A,(Q) SOJA A,TKCPS2 TKDMV1: MOVE A,[141000,,DISBF1+1] SKIPE DISCPH ;ANY HPOS? MOVE A,[441000,,DISBF1] ;YES, WILL NEED WHOLE BUFFER SAVE A SAVE B MOVE B,TTLPOS MOVEI A,^M TRNE B,-1 ;IF NOT THERE ALREADY... IDPB A,-1(P) ;START AT BEGINNING OF CURRENT LINE HLRZS B ;GET CURRENT ROW SUBI B,(BP) ;GET OLD-NEW JUMPE B,TKDSM5 ;ALREADY ON RIGHT LINE MOVEI A,[ASCIZ /`DOW /] ;ASSUME NEGATIVE => DOWN SKIPL B MOVEI A,[ASCIZ /`UP /] CALL TKDSMS MOVM A,B CALL TKDSMN MOVEI A,"; IDPB A,-1(P) TKDSM5: SKIPN DISCPH ;GET HPOS IF ANY JRST POPBAJ MOVEI A,[ASCIZ /`RIG /] CALL TKDSMS MOVE A,DISCPH CALL TKDSMN MOVEI A,"; IDPB A,-1(P) JRST POPBAJ TKDSMS: SAVE B HRLI A,440700 TKDSS2: ILDB B,A JUMPE B,POPBJ IDPB B,-3(P) JRST TKDSS2 TKDSMN: SOJE A,CPOPJ SAVE [IDPB A,-4(P)] JRST TKCPS5 ] IFN HP2645,[ SUBTTL HP2645 HPTB: 24.,,79. ;DISPATCH VECTOR FOR HP2645 (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID) CALL HPCPS CALL HPCEOL CALL HPCEOS CALL HPCLRS JFCL CALL HPDSMV CALL HPDMV1 CALL HPINSL CALL HPDELL CALL HPINSC CALL HPDELC REPEAT 7,JFCL ; HPCPS - OUTPUT HP2645 CURSOR POSITIONING COMMANDS TO TERMINAL. ; ARGUMENT: ; B LINE,,COLUMN HPCPS: SAVE A ; SAVE AC MOVE A,[440700,,HPBUF] ; HPMOVE ARG: B.P. TO BUFFER CALL HPMOVE ; GET COMMANDS TO DO CURSOR MOVEMENT MOVE A,[440700,,HPBUF] ; SEND COMMANDS PSOUT ; ... JRST POPAJ ; HPMOVE - CALCULATE HP2645 CURSOR POSITIONING COMMANDS. ; ARGUMENTS: ; A B.P. TO OUTPUT BUFFER (UPDATED ON RETURN) ; B LINE,,COLUMN HPMOVE: SAVE B ; SAVE ACS SAVE C ; ... JUMPE B,[ ; SIMPLE HOME MOVEI C,33 ; $H WILL DO IDPB C,A MOVEI C,"H IDPB C,A JRST HPMOV1 ] IRP X,,[33,"&,"a] ; SEND THE START OF THE CURSOR POSITIONING MOVEI C,X ; SEQUENCE IDPB C,A TERMIN HLRZ B,-1(P) ; GET LINE NO. CALL HPNO ; OUTPUT AS DECIMAL NO. HRRZ B,-1(P) ; GET COLUMN NO. JUMPE B,[ ; IF COLUMN NO. IS ZERO THEN USE DIRECT MOVEI C,"R ; CURSOR POSITION FOR LINE NO. ONLY IDPB C,A MOVEI C,^M ; THEN FOLLOW WITH A CR IDPB C,A ; ... JRST HPMOV1 ] MOVEI C,"r ; TERMINATE LINE NO. IDPB C,A ; ... CALL HPNO ; OUTPUT COLUMN NO. AS DECIMAL NO. MOVEI C,"C ; TERMINATE COLUMN NO. IDPB C,A ; ... HPMOV1: MOVEI C,0 ; TERMINATE WITH A NULL IDPB C,A ; ... REST C ; RESTORE ACS JRST POPBJ ; INTERNAL SUBROUTINE - OUTPUT B AS DECIMAL NO. HPNO: IDIVI B,10. ; CONVERT TO TENS AND ONES DIGITS JUMPE B,HPN1 ; SKIP TENS DIGIT IF ZERO ADDI B,"0 ; CONVERT TENS DIGIT TO ASCII IDPB B,A ; OUTPUT TENS DIGIT HPN1: ADDI C,"0 ; CONVERT ONES DIGIT TO ASCII IDPB C,A ; OUTPUT ONES DIGIT RET ; HPCEOL - OUTPUT HP2645 COMMANDS TO CLEAR TO END OF LINE. HPCEOL: MOVEI A,"K JRST OUTESC ; HPCEOS - OUTPUT HP2645 COMMANDS TO CLEAR TO END OF SCREEN. HPCEOS: MOVEI A,"J JRST OUTESC ; HPCLRS - OUTPUT HP2645 COMMANDS TO CLEAR THE SCREEN. HPCLRS: HRROI A,[ASCIZ "HJ"] PSOUT RET ; HPINSL - OUTPUT HP2645 COMMANDS TO INSERT SEVERAL BLANK LINES. ; ARGUMENTS: ; BP LINE NO. AT WHICH TO INSERT ; Q NO. OF LINES TO INSERT HPINSL: MOVEI A,"L ; $L - INSERT LINE JRST HPDEL1 ; HPDELL - OUTPUT HP2645 COMMANDS TO DELETE SEVERAL LINES. ; ARGUMENTS: ; BP LINE NO. AT WHICH TO DELETE ; Q NO. OF LINES TO DELETE HPDELL: MOVEI A,"M ; $M - DELETE LINE HPDEL1: SAVE B ; SAVE AC MOVS B,BP ; HPCPS ARG: LINE NO.,,COLUMN NO. CALL HPCPS ; MOVE TO DESIRED LINE NO. MOVEI B,33 ; ESC HPID1: EXCH A,B PBOUT ; OUTPUT ESC EXCH A,B PBOUT ; OUTPUT "L" OR "M" SOJG Q,HPID1 JRST POPBJ ; RESTORE AC HPDELC: MOVEI A,"P CALL OUTESC SOJG Q,HPDELC RET HPINSC: MOVEI A,"Q CALL OUTESC CALL OUTNSP MOVEI A,"R CALL OUTESC MOVEI A,^H JRST OUTN ; HPDSMV - CALCULATE HP2645 COMMANDS TO MOVE TO THE SPECIFIED POSITION AND ; CLEAR THE WHOLE LINE. THE COMMANDS ARE PUT IN DISBF1, AS CLOSE TO DISBUF ; AS POSSIBLE. 8 BIT BYTES ARE USED. ; ARGUMENTS: ; BP LINE NO. ; DISCPH COLUMN NO. HPDSMV: JSR SAVABC ; SAVE ACS MOVE A,[441000,,HPBUF] ; HPMOVE ARG: B.P. TO BUFFER HRLZ B,BP ; HPMOVE ARG: LINE NO.,,COLUMN NO. CALL HPMOVE ; MOVE TO BEGINNING OF SPECIFIED LINE MOVEI B,33 ; CLOBBER TERMINATING ZERO BYTE WITH DPB B,A ; AN ESCAPE - 1ST PART OF CLEOL SEQUENCE MOVEI B,"K ; PUT IN "K" - 2ND PART OF CLEOL SEQUENCE IDPB B,A ; ... SKIPN B,DISCPH ; DESIRED COLUMN ZERO? JRST HPDSM1 ; YES, ALREADY THERE IRP X,,[33,"&,"a] ; SEND THE START OF THE CURSOR POSITIONING MOVEI C,X ; SEQUENCE IDPB C,A TERMIN CALL HPNO ; OUTPUT COLUMN NO. AS DECIMAL NO. MOVEI B,"C ; TERMINATE COLUMN NO. AND CURSOR POSITIONING IDPB B,A HPDSM1: MOVEI B,0 ; TERMINATE WITH ZERO BYTE IDPB B,A ; ... HPDSM2: SUBI A,HPBUF ; CALCULATE NO. OF BYTES WE'VE GENERATED MULI A,4 ; (SEE HAKMEM NOTE 165) SUBI B,1-4(A) ; ... MOVNI A,(B) ; CALCULATE BYTE ADDRESS TO START AT, ADD A,[DISBUF*4] ; I.E. DISBUF*4-NBYTES IDIVI A,4 ; CONVERT TO B.P. HRL A,(B)[441000 ? 341000 ? 241000 ? 141000] ; ... MOVE B,[441000,,HPBUF] ; B.P. TO BUFFER HPDSM3: ILDB C,B ; GET BYTE FROM HPBUF JUMPE C,POPCBA ; ZERO BYTE TERMINATES IDPB C,A ; PUT INTO DISBF1 JRST HPDSM3 JRST POPCBA ; HPDMV1 IS JUST LIKE HPDSMV, EXCEPT THAT IT DOES NOT CLEAR. HPDMV1: JSR SAVABC ; SAVE ACS MOVE A,[441000,,HPBUF] ; HPMOVE ARG: B.P. TO BUFFER MOVE B,DISCPH ; HPMOVE ARG: LINE NO.,,COLUMN NO. HRL B,BP ; ... CALL HPMOVE ; MOVE TO SPECIFIED POSITION JRST HPDSM2 ];IFN HP2645 IFN I400,[ SUBTTL INFOTON 400 I400TB: 4*1000+24.,,79. (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOCID+%TOLID) CALL I4CPS CALL I4CEOL CALL I4CEOS CALL I4CLRS JFCL CALL I4DSMV CALL I4DMV1 CALL I4INSL CALL I4DELL CALL I4INSC CALL I4DELC CALL I4RST REPEAT 2,JFCL CALL I4INI CALL I4RSS REPEAT 2,JFCL I4CPS: MOVEI A,33 PBOUT JUMPE B,I4CPS8 ; SKIP ALL THIS FOR HOMING HLRZ A,B ; VERTICAL POS AOS A ; USES 1 BASED ADDRESSING CALL I4PAR HRRZ A,B JUMPE A,I4CPS8 PUSH P,A MOVEI A,"; PBOUT POP P,A AOS A CALL I4PAR I4CPS8: MOVEI A,"H PBOUT RET I4PAR: SAVE B IDIVI A,10. JUMPE A,I4PAR1 ADDI A,"0 PBOUT I4PAR1: MOVEI A,"0(B) PBOUT JRST POPBJ I4CEOL: MOVEI A,"N JRST OUTESC I4CEOS: HRROI A,"J JRST outesc ;[R] I4CLRS: HRROI A,[ASCIZ /6h2Q2J6l/] ;[R] set erase all mode, edit field PSOUT ;[R] erase all, reset erase all mode SAVE B HRLZ B,USZ ; GO TO MORE LINE CALL I4CPS REST B HRROI A,[ASCIZ /7mH/] ;[R] set reverse video; home PSOUT ;[R] RET ;Put into DISBF1 code to go to a cursor position and clear the line. ;DSMV puts the code to clear the current line into DISBF1+5, and ;then calls DMV3 to put code to go to the position into DISBF1+4. ;That causes the cursor pos. to happen first, and then the clear line. I4DSMV: SAVE C MOVEI C,5 ; INDEX INTO DISBF1 MOVE A,[.BYTE 8 ? 33 ? "2 ? "N ] ;clear entire current line MOVEM A,DISBF1(C) SOS C ; causes position code to go in PREVIOUS word JRST I4DMV3 ; generate code to cursor position. ;Put into DISBF1 code to go to a cursor position. I4DMV1: SAVE C MOVEI C,5 ; INDEX INTO DISBF1 I4DMV3: MOVE A,DISCPH ; create second coordinate AOS A IDIVI A,10. LSH A,8 ADDI A,(B) LSH A,8+4 ADD A,[.BYTE 8 ? "; ? "0 ? "0 ? "H ] MOVEM A,DISBF1(C) SOS C MOVEI A,1(BP) IDIVI A,10. LSH A,8 ADDI A,(B) LSH A,4 ADD A,[.BYTE 8 ? 33 ? "[ ? "0 ? "0 ] ;] MOVEM A,DISBF1(C) REST C RET ;Note: line operations require roll mode. Character operations require ; non-roll mode. Hence we leave it in non-roll mode by default, since ; character operations are done more often and require faster response. I4INSL: HRLZ B,BP ;GET TARGET LINE PUSHJ P,I4CPS ;POSTION CURSOR TO IT I4INS1: HRROI A,[ASCIZ /Q/] PSOUT MOVE A,Q ;PUT OUT NUMBER OF LINES CALL I4PAR MOVEI A,"L ;AND THE INSERT COMMAND PBOUT JRST I4PAD I4DELL: HRLZ B,BP ;GET TARGET LINE PUSHJ P,I4CPS ;POSITION CURSOR TO IT I4DEL1: HRROI A,[ASCIZ /Q/] PSOUT MOVE A,Q ;PUT OUT NUMBER OF LINES CALL I4PAR MOVEI A,"M ;DELETE LINES PBOUT JRST I4PAD ;I4PAD IS ASSUMED TO BE DONE AFTER A LINE OPERATION, SO IT PUTS OUT ; A $2Q AFTER THE PADDING, TO CLEAR ROLL MODE. AC Q ; CONTAINS THE NUMBER OF LINES INSERTED OR DELETED. I4PAD: MOVEI A,18. ;PAD 16 MSEC. IMULI A,(Q) ;TIMES NUMBER OF LINES CALL TIMPAD HRROI A,[ASCIZ /2Q/] ;PUT BACK IN CHAR MODE PSOUT RET ;Insert Q characters - the Q is used in OUTNSP and OUTN, both of which ; garbage A and preserve Q. We must be in non-roll mode for this. That ; is true by default. I4INSC: HRROI A,[ASCIZ /4h/] PSOUT ;ENTER INSERT MODE CALL OUTNSP ;INSERT SPACES HRROI A,[ASCIZ /4l/] ;LEAVE INSERT MODE. PSOUT MOVEI A,^H ;BACK OVER THEM. JRST OUTN I4DELC: MOVEI A,"P CALL OUTESC SOJG Q,I4DELC RET ;Reset - clear funny modes for return to monitor. Set roll mode. I4RST: SAVE B HRLZ B,USZ ADD B,[-1,,79.] ;GO TO CHAR BEFORE MODE LINE CALL I4CPS REST B HRROI A,[asciz /6hJ6lQ /] ;set erase all mode, eos PSOUT ;reset erase all mode, edit display mode RET ;Temporary reset - for doing normal monitor read, but leave mode line. I4RSS: MOVEI A,"Q JRST OUTESC ;Initialize modes - in this case clear roll mode so that char ins/del changes ; only one line. I4INI: HRROI A,[ASCIZ /2Q/] ;non-roll mode PSOUT RET ] ;IFN I400 IFN I100,[ SUBTTL INFOTON 100 I100TB: 24.,,79. ;DISPATCH VECTOR FOR I100 (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID) CALL I1CPS CALL I1CEOL CALL I1CEOS CALL I1CLRS JFCL CALL I1DSMV CALL I1DMV1 CALL I1INSL CALL I1DELL JFCL JFCL JFCL REPEAT 6,JFCL I1INSL: SKIPA A,["L] ;$L - INSERT LINE I1DELL: MOVEI A,"M ;$M - DELETE LINE SAVE A MOVEI A,"f CALL OUTESC MOVEI A,40 PBOUT MOVEI A,40(BP) PBOUT I1INS1: MOVE A,(P) ; GET DESIRED FUNCTION AGAIN CALL OUTESC SOJG Q,I1INS1 JRST POPAJ I1CPS: JUMPE B,[MOVEI A,"H ;HOME IS EASY JRST OUTESC] MOVEI A,"f ;ELSE SEND $f CALL OUTESC MOVEI A,40(B) ;+40 PBOUT HLRZ A,B ADDI A,40 ;+40 PBOUT RET I1CEOL: MOVEI A,"K ;CLEAR EOL JRST OUTESC I1CLRS: MOVEI A,"H ;CLEAR SCREEN CALL OUTESC I1CEOS: MOVEI A,"J ;CLEAR EOS JRST OUTESC I1DSMV: SAVE B MOVEI B,40(BP) LSH B,16.+4 IOR B,[.BYTE 8 ? 40 ? 0 ? 33 ? "K] MOVE A,[.BYTE 8 ? 0 ? 0 ? 33 ? "f] SKIPE DISCPH ;DESIRED HPOS = 0? JRST I1DSM2 ;NO, MUST GO THERE AFTERWARDS MOVEM A,DISBF1+4 ;JUST $f ? $K MOVEM B,DISBF1+5 JRST POPBJ I1DSM2: MOVEM A,DISBF1+3 ;NEED HPOS TOO, USE $f ? $K ? ... MOVEM B,DISBF1+4 CALL I1DMV1 JRST POPBJ I1DMV1: MOVE A,DISCPH ; GET WANTED HPOS LSH A,8 IORI A,(BP) ;DESIRED VPOS LSH A,4 ADD A,[.BYTE 8 ? 33 ? "f ? 40 ? 40] MOVEM A,DISBF1+5 ;$f RET ] ;I100 IFN TK4023,[ SUBTTL TEKTRONIX 402 (UGH) 3 ; Note - this currently runs with the screen (except the mode line) in ; inverse video, for greater readability. If you don't like this see ; T3CLRS for how to fix it. TK43TB: 24.,,77. (%TOERS+%TOMVB+%TOMVU+%TOLWR) CALL T3CPS CALL T3CEOL CALL T3CEOS CALL T3CLRS JFCL CALL T3DSMV CALL T3DMV1 REPEAT 11.,JFCL T3CPS: MOVEI A,28. PBOUT MOVEI A,41(B) ; X POS PBOUT HLRZ A,B ; Y POS ADDI A,40 PBOUT RET T3CLRS: JSR SAVABC MOVEI A,33 ; ESCAPE PBOUT MOVEI A,^L ; FORMFEED PBOUT MOVSI C,-24. ; AOBJN PTR T3CLR1: HRLOI B,(C) ; GO TO X = -1 CALL T3CPS MOVEI A,31. ; SET A PROTECTED ATTRIBUTE PBOUT MOVEI A,"J ; NOTE - MAKE THIS "B FOR NON-INVERT SCREEN PBOUT AOBJN C,T3CLR1 SETZ B, ; GO BACK HOME CALL T3CPS JRST POPCBA T3DSMV: SAVE B MOVE B,[[.BYTE 8 ? 28. ? 41 ? 40 ? 31. "@ ? 33 ? "O ? 0 0 ? 0 ? 0 ? 28. 41 ? 40 ? 40 ? ^H],,DISBF1+2] BLT B,DISBF1+5 MOVE B,DISCPH LSH B,8 ADDI B,(BP) LSH B,8+4 ADDM B,DISBF1+2 LSH B,8 ADDM B,DISBF1+5 JRST POPBJ T3DMV1: SAVE B MOVE B,DISCPH ; X POS LSH B,8. ADDI B,40(BP) ; Y POS LSH B,4 ADD B,[.BYTE 8 ? 0 ? 28. ? 41 ? 0] MOVEM B,DISBF1+5 JRST POPBJ T3CEOS: T3CEOL: JSR SAVABC HRROI A,[.BYTE 7 ? 31. ? "H ? 33 ? "O] PSOUT SKIPN C,OSPEED ; GOTTA PAD? MOVEI C,DEFOSP SETZ A, CAIL C,4800. HRROI A,[.BYTE 7 ? 1 ? 1] CAIL C,9600. HRROI A,[.BYTE 7 ? 1 ? 1 ? 1 ? 1] SKIPE A PSOUT MOVE B,TTLPOS ; MUST REPOSITION CURSOR CALL T3CPS HRROI A,[.BYTE 7 ? 40 ? ^H] PSOUT JRST POPCBA ] ;IFN TK4023 IFN ANNARB,[ SUBTTL ANN ARBOR AATB: 40.,,78. ;DISPATCH TABLE FOR ANN ARBOR (%TOMVB+%TOMVU+%TOLWR) CALL AACPS ;NOTE: WIDTH MUST BE 78 DUE TO CRETINOUS CALL EOLSIM ;AUTO CRLF AND SCROLL AFTER WRITING IN COLUMN 79. CALL EOLSIM ;SO THE "!" MUST GO IN COLUMN 78. CALL AACLRS JFCL .VALUE CALL AADMV1 JFCL JFCL JFCL JFCL JFCL REPEAT 6,JFCL ; AACPS - OUTPUT ANN ARBOR CURSOR POSITIONING COMMANDS TO TERMINAL. ; ARGUMENT: ; B LINE,,COLUMN AACPS: JUMPE B,[MOVEI A,^K ; SIMPLE HOME? PBOUT ; YES, USE HOME COMMAND INSTEAD OF ABSOLUTE RET] ; POSITIONING MOVEI A,^O ; SEND START OF ABSOLUTE CURSOR POSITION PBOUT ; SEQUENCE SAVE B ; SAVE LINE,,COLUMN MOVEI A,(B) ; GET COLUMN NO. IDIVI A,10. ; CONVERT TO FUNNY BCD REPRESENTATION LSH A,4 ; ... IOR A,B ; ... PBOUT ; OUTPUT HLRZ A,(P) ; GET LINE NO. CAIL A,20. ; THIS IS WEIRD ADDI A,12. ; ... ADDI A,100 PBOUT JRST POPBJ ; RESTORE CURSOR POSITION AACLRS: MOVEI A,^L PBOUT RET ; AADMV1 - CALCULATE ANN ARBOR COMMANDS TO MOVE TO THE SPECIFIED POSITION ; THE COMMANDS ARE PUT IN DISBF1, AS CLOSE TO DISBUF ; AS POSSIBLE. 8 BIT BYTES ARE USED. ; ARGUMENTS: ; BP LINE NO. ; DISCPH COLUMN NO. AADMV1: SAVE B ; SAVE AC MOVE A,DISCPH ; GET COLUMN NO. IDIVI A,10. LSH A,4 IORI A,^O_8.(B) LSH A,8. ADDI A,100(BP) CAIL BP,20. ADDI A,12. LSH A,4 ; SHIFT INTO HIGH 32 BITS OF THE WORD MOVEM A,DISBF1+5 ; ^O COLUMN LINE JRST POPBJ ; RESTORE AC ] ; IFN ANNARB IFN C100,[ SUBTTL HDS C100 ; SUPPORT FOR THE HUMAN DESIGNED SYSTEMS' CONCEPT-100 AND CONCEPT-APL ; TERMINALS. ; ; NOTES: THESE TERMINALS MUST BE IN `PROGRAMMER MODE' FOR THINGS LIKE ; CURSOR ADDRESSING TO WORK; WE ALWAYS PUT THE TERMINAL IN THIS MODE, ; WHICH IS THE CORRECT ONE FOR FULL-DUPLEX SYSTEMS, AT EACH SCREEN CLEAR, ; UNDER THE ASSUMPTION THAT THE FIRST USEFUL THING DONE BY EMACS IS TO CLEAR ; THE SCREEN. LEAVING THE TERMINAL IN THIS MODE CAN'T HURT. ; ; THE CONCEPT SERIES NEEDS A FAIR AMOUNT OF FILL CHARACTERS FOR MOST ; OF THE MORE COMPLICATED FUNCTIONS; AT WORST, 50 MS. OF FILL WOULD BE ; NEEDED (EG, FOR AN INSERT-CHARACTER FUNCTION AT THE START OF A FULL ; SCREEN). IN THIS CODE, WE'VE TRIED TO PARAMETRIZE THE FILL FACTOR ; FOR EACH FUNCTION, AND COMPUTE THE ACTUAL AMOUNT OF FILL (NULS ARE ; USED), DEPENDING ON THE SPEED. NOTE THAT WE CAN ONLY USE 79. COLUMNS ; ON THE CONCEPT, AS PROBLEMS OCCUR WITH LINE FEEDS IF AUTO-CRLF HAS ; HAPPENED ON THE LAST LINE OF THE WINDOW (IT'S TOO UGLY TO DESCRIBE ; HERE). C100TB: 24.,,78. ; CONCEPT DESCRIPTOR TABLE: SIZE, %TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID,,%TPRSC ; CAPABILITIES, CALL CPCPS ; ROUTINES: CURSOR POSITIONING CALL CPCEOL ; CLEAR TO END OF LINE CALL CPCEOS ; CLEAR TO END OF SCREEN CALL CPCLRS ; CLEAR SCREEN JFCL ; UNUSED AS OF NOW. CALL CPDSMV ; SET UP DISBF1 FOR MOVING TO, CLEARING LINE CALL CPDMV1 ; DITTO, BUT DON'T DO ANY CLEARING CALL CPINSL ; INSERT SOME LINES CALL CPDELL ; DELETE 'EM, TOO CALL CPINSC ; INSERT A CHAR CALL CPDELC ; AND MAYBE DELETE ONE CALL CPTRST ; RESET THE TERMINAL (RESET WINDOW) CALL CPWUP ; MOVE LINES VIA WINDOWING UP CALL CPWDN ; DOWN CALL CPINI ; PUT THE C100 IN PROGRAMMER MODE CALL CPTRST ; RESET THE TERMINAL (RESET WINDOW) CALL CPINVI ; ENTER REVERSE VIDEO CALL CPINVC ; EXIT REVERSE VIDEO ; FUNCTION CODES (FOR DELAY CALCULATIONS); IF YOU EVER CHANGE THESE, CHANGE ; THE DELAY TABLE IN CPFILC, TOO. %FCIDL==0 ; INSERT/DELETE LINE %FCIDC==1 ; I/D CHAR, CLEAR EOL & EOW %FCCLW==2 ; CLEAR SCREEN WITH ^L ; POSITION CURSOR TO (VERTICAL POSTION,,HORIZONTAL POSTION) IN B CPCPS: JUMPE B,[MOVEI A,"? ; GOING HOME IS EASY JRST OUTESC ] ; OUTPUT `$?' SAVE C ; SAVE WORK REG MOVE C, [.BYTE 7 ? 33 ? "a ? 40 ? 40 ? 0] ; BUILD POSITIONER IN C HLRZ A, B ; GET VERTICAL POSITION LSH A, 7 ; MOVE IT INTO POSITION IORI A, (B) ; FOLLOWED BY THE HORIZONTAL LSH A, 7+1 ; POSITION ADD C, A ; DROP IT IN HRROI A, C ; FINALLY, OUTPUT IT ALL PSOUT ; ... JRST POPCJ ; CLEAR TO END OF SCREEN CPCEOS: MOVEI A,^E ; OUTPUT CLEAR-ALL TO CALL OUTESC ; END OF WINDOW PUSH P,[24.] ; WORST CASE ASSUMED MOVEI A,%FCIDC ; AND FILL APPROPRIATELY CALL CPFILL ; FOR THIS FUNCTION AND SPEED RET ; EVERYONE'S HAPPY ; CLEAR TO END OF LINE CPCEOL: MOVEI A,^U ; OUTPUT CLEAR-ALL TO CALL OUTESC ; END OF LINE MOVEI A,%FCIDC ; FILL FOR THIS FUNCTION PUSH P,[1] ; NO MULTIPLIER NEEDED CALL CPFILL RET ; ALL OK ; CLEAR SCREEN ENTIRELY (SEE NOTE ABOVE) CPCLRS: HRROI A, [.BYTE 7 ? ^L ? 0] ; CLEAR SCREEN. ASSUMES PSOUT ; PROGRAMMER MODE IS SET (SEE CPINI) MOVEI A, %FCCLW ; DELAY APPROPRIATELY PUSH P, [24.] ; ASSUME WORST CASE CALL CPFILL RET ; CPDSMV - CALCULATE C100 COMMANDS TO MOVE TO THE SPECIFIED POSITION AND ; CLEAR THE WHOLE LINE. THE COMMANDS ARE PUT IN DISBF1, AS CLOSE TO DISBUF ; AS POSSIBLE. 8 BIT BYTES ARE USED. ; ARGUMENTS: ; BP LINE NO. ; DISCPH COLUMN NO. CPDSMV: SAVE B SAVE C SAVE D MOVEI B,1 ; MULITPLIER FOR FILLS MOVEI A,%FCIDC ; AND SET UP FOR FILLS CALL CPFILC ; COMPUTE FILLS NEEDED MOVE D,A ; !! SKIPE DISCPH ; DESIRED HPOS = 0 ADDI D,4 ; NO? COUNT 4 EXTRA CHARS CAILE D,18. ; GET MIN D AND 18. MOVEI D,18. ; INTO D (SKIMPS A BIT AT 9600 BAUD) MOVNI B,6(D) ; -TOTAL CHAR COUNT INTO B ADD B,[DISBUF*4] ; BYTE ADDRESS OF START IDIVI B,4 ; CONVERT TO BYTE POINTER HRL B,[441000 ? 341000 ? 241000 ? 141000](C) MOVEI C,33 ; START WITH IDPB C,B MOVEI C,"a ; CURSOR ADDRESS IDPB C,B MOVEI C,40(BP) ; GET DESIRED VPOS IDPB C,B MOVEI C,40 ; HPOS = 0 IDPB C,B MOVEI C,33 ; START OF CEOL IDPB C,B MOVEI C,^U IDPB C,B JUMPLE D,.+4 MOVEI C,177 ; USE DEL FOR FILL IDPB C,B SOJG D,.-1 ; LOOP BACK SKIPE DISCPH ; DESIRED HPOS = 0 CALL CPDMV1 ; NO? THEN GO THERE REST D REST C JRST POPBJ ; SET UP DISBF1 TO MOVE TO POSITION AS CODED BY (BP, DISCPH); DON'T ; CLEAR ANYTHING. CPDMV1: SETZM DISBF1+3 ; CLEAR OUT UNUSED PART OF DISPLAY SETZM DISBF1+4 ; BUFFER MOVEI A, (BP) ; GET VERTICAL POSITION LSH A, 8 ; MAKE ROOM FOR HORIZONTAL IOR A, DISCPH ; POSITION LSH A, 4 ; ACCOUNT FOR POSITION OF 4 8.-BIT BYTES ADD A, [.BYTE 8 ? 33 ? "a ? 40 ? 40] ; BUILD POSITIONER MOVEM A, DISBF1+5 ; AND DROP INTO ITS FINAL RESTING PLACE RET ; ALL DONE ; INSERT AND DELETE C(Q) LINES (AT THE VERTICAL POSITION IN BP); ON ; CONCEPT'S, THE CURSOR DOESN'T MOVE. ; ENTER HERE WITH SCREEN SIZE IN A CPINSW: SAVE B ; (USED BY CPWIN ROUTINE ONLY) PUSH P, A ; AND PUT IT WHERE USED LATER JRST CPINS5 ; GO JOIN COMMON CODE CPINSL: SAVE B ; SAVE A WORK REG PUSH P, [24.] ; AT THIS POINT, ASSUME FULL SCREEN CPINS5: MOVEI B, 40(BP) ; FIRST, GO TO THE LINE ASKED FOR LSH B, 7+7+1 ADD B, [.BYTE 7 ? 33 ? "a ? 0 ? 40 ? 0] HRROI A, B PSOUT POP P,B ; GET WINDOW SIZE INTO B SUBI B,(BP) ; AND COMPUTE NUMBER OF LINES BEING MOVED ADDI B,1 ; +1 FOR LINE CLEARED CPINS1: MOVEI A,^R ; FOR EACH LINE TO BE CALL OUTESC ; INSERTED, `$^R' DOES IT PUSH P,B ; PASS # LINES FOR FILL ACTION MOVEI A,%FCIDL ; AND DELAY APPROPRIATELY CALL CPFILL MOVEI A,"< ; NOW, GO ONTO NEXT LINE CALL OUTESC SUBI B,1 ; BUMP DOWN NUMBER OF LINES BEING SHOVED DOWN SOJG Q,CPINS1 ; DO FOR NUMBER OF LINES REQUESTED JRST POPBJ CPDELL: SAVE B ; SAVE A WORK REG MOVEI B, 40(BP) ; FIRST, GO TO THE LINE ASKED FOR LSH B, 7+7+1 ADD B, [.BYTE 7 ? 33 ? "a ? 0 ? 40 ? 0] HRROI A, B PSOUT MOVEI B,25. ; COMPUTE NUMBER OF LINES SUBI B,(BP) ; BEING AFFECTED CPDEL1: MOVEI A,^B ; DELETE A LINE CALL OUTESC ; ... PUSH P,B ; PASS # LINES FOR FILL ACTION, AND MOVEI A,%FCIDL ; WAIT FOR THIS SLOW CALL CPFILL ; TERMINAL SOJG Q,CPDEL1 ; DO IT NUMBER OF TIMES REQUESTED JRST POPBJ ; INSERT AND DELETE CHARACTER; THE INSERT-CHARACTER WORKS BY ACTUALLY ; ENTERING INSERT MODE, DROPPING IN A SPACE TO MAKE ROOM, AND LEAVING ; INSERT MODE; THEN, MOVE BACK OVER THE SPACE. CPINSC: MOVEI A,^P ; ENTER INSERT CHARACTER MODE CALL OUTESC ; ... SAVE Q ; SAVE INSERT COUNT CPIC1: MOVEI A,40 ; INSERT SPACES PBOUT ; ... MOVEI A,%FCIDC ; FILL FOR THIS FUNCTION PUSH P,[1] ; NO MULTIPLIER NEEDED CALL CPFILL SOJG Q,CPIC1 REST Q ; RESTORE INSERT COUNT MOVEI A,33 ; EXIT INSERT CHARACTER MODE PBOUT ; ... MOVEI A,0 ; ... PBOUT ; ... MOVEI A,^H ; BACK OVER INSERTED SPACES JRST OUTN ; ... CPDELC: MOVEI A,^Q ; DELETE CHARACTER IN LINE CALL OUTESC ; ... MOVEI A,%FCIDC ; FILL FOR THIS FUNCTION PUSH P,[1] ; NO MULTIPLIER NEEDED CALL CPFILL SOJG Q,CPDELC RET ; ROUTINE TO FILL APPROPRIATELY FOR ANY GIVEN FUNCTION ; (AS CODED BY %FCXXX, ABOVE). THE FUNCTION CODE IS IN A. ; CLOBBERS A. THE FILL FACTOR (E.G., NUMBER OF LINES AFFECTED) IS ; AT -1(P), AND IS PEELED OFF THE STACK. CPFILL: EXCH B,(P) ; GET RETURN ADDRESS, SAVE WORK REG EXCH B,-1(P) ; GET FILL FACTOR, SAVE RETURN ADDRESS CALL CPFILC ; COMPUTE HOW MANY NULS ARE NEEDED (TO A) CALL EXPPD1 ; SEND THAT MANY RUBOUTS JRST POPBJ ; CPFILC - CALCULATE # OF FILLS REQUIRED FOR C100 AND CAPL ; ARGUMENTS: ; %FCXX CODE IS IN A (IE. WHAT OPERATION) ; FILL FACTOR IS IN B (IE. HOW MANY CHARS/LINES AFFECTED) ; RETURNS RESULT IN A (THE NO. OF NULLS REQ'D) ; ; %FCIDL==0 CORRESPONDS TO A MULTIPLIER OF .75 (I/D LINE) ; %FCIDC==1 CORRESPONDS TO A MULTIPLIER OF 4.0 (I/D CHAR, CLEAR EOL & EOW) ; %FCCLW==2 CORRESPONDS TO A MULTIPLIER OF 0.5 (CLEAR SCREEN WITH ^L) ; THE FILL FACTOR (FF) CORRESPONDS TO THE NUMBER OF LINES/CHARS. AFFECTED. ; ; NFILL = MULT*FF*OSPEED/(1.E4*(1.0-(0.45+(0.30*OSPEED/9600.)))) CPFILC: FSC B,233 FMPR B,(A)[ .00075 ; %FCIDL .004 ; %FCIDC .0005 ; %FCCLW ] FMPR B,C1PADF MOVE A,B FADR A,[0.5] MULI A,400 ; FIX B,A ASH B,-243(A) ; ... MOVE A,B RET ; MOVE LINES AROUND ON SCREEN USING HARDWARE WINDOWING TO WIN ON SPEED. ; (SIGH; THIS CODE WILL PROBABLY BE USELESS WHEN THEY SPEED UP INSERT/ ; DELETE LINE). SEE MOVWIN ROUTINE FOR INPUTS. CPWDN: SAVE B ; SAVE WORK REG MOVEI B, (BP) ; GET DESTINATION LINE (TOP LINE OF WINDOW) MOVE A, BOTLIN ; GET # OF LINES IN SUBI A, (B) ; HARDWARE WINDOW CALL CPSETW ; SET UP THE WINDOW SETZ BP, ; WANNA INSERT C(Q) LINES AT TOP OF SCREEN CALL CPINSW ; GO INSERT THEM CALL CPWRST ; RESET THE HARDWARE WINDOW TO WHOLE SCREEN JRST POPBJ ; RESTORE B AND GET OUT ; HERE TO MOVE A GROUP OF LINES UP CPWUP: JSR SAVABC MOVE B, BP ; GET DESTINATION LINE (TOP OF NEW WINDOW) MOVE A, BOTLIN ; GET # OF LINES SUBI A, (B) ; IN WINDOW CALL CPSETW ; SET THE WINDOW MOVEI B, (A) ; GET # OF LAST LINE IN WINDOW SUBI B, 1 ; ... HRLZ B, B ; MAKE INTO (VPOS,,HPOS) OF LAST LINE CALL CPCPS ; GO THERE MOVEI A, .PRIOU ; TTY OUT PORT HRROI B, [.BYTE 7 ; MAKE LOTS OF S WITH PADDING REPEAT 24., ^J ? 177 ? 177 ? 177 ? 177 ? 177 ? 177 ] MOVNI C, (Q) ; GET NEGATIVE # OF LINES TO MOVE UP IMULI C, 7 ; TIME # CHARS PER LINE SHIFT SOUT ; SCROLL IT UP WITH S CALL CPWRST ; RESET WINDOW JRST POPCBA ; WINDOW-SETTING UTILITY ROUTINES ; SET UP A WINDOW; A/ # OF LINES WANTED ON SCREEN, B/ LINE # OF HOME CPSETW: JSR SAVABC ; SAVE WORK REGS SAVE D SAVE E MOVE D,[.BYTE 7 ? 33 ? "v ? 40 ? 40 ? 40] MOVE E,[.BYTE 7 ? 80.+40 ? 177 ? 177 ? 177 ? 177] ; GET SKELETON LSH B, 7+7+1 ; GET STARTING LINE AND LSH A, 1 ; LENGTH INTO POSITION ADD D, B ; AND DROP THEM IN ADD D, A MOVEI A, .PRIOU HRROI B, D ; NOW SET THE WINDOW MOVNI C, 10. SOUT REST E REST D JRST POPCBA ; RESTORE WORK REGS ; RESET THE HARDWARE WINDOW TO ITS FULL (?) GLORY CPWRST: JSR SAVABC ; SAVE WORK REGS MOVEI A,.PRIOU HRROI B,[.BYTE 7 ? 33 ? "v ? 40 ? 40 ? 24.+40 ? 80.+40 ? 177 ? 177 ? 177 ? 177] MOVNI C,10. SOUT ; OUTPUT WINDOW-RESET SEQUENCE JRST POPCBA ; ALL DONE ; RESET THE WHOLE TERMINAL, UPON EXIT. CPTRST: SAVE B ; SAVE WORK REG CALL CPWRST ; RESET THE WINDOW MOVE B,TTLPOS ; BACK TO OLD POSITION CALL CPCPS ; ... JRST POPBJ ; RESTORE B AND GET OUT ;CPINI -- INITIALIZE THE TERMINAL TO PROGRAMMER MODE ON ENTRY CPINI: SAVE A SAVE B HRROI A,[.BYTE 7 ? 33 ? "U ? 0] PSOUT SKIPN A,OSPEED ; GET OUTPUT SPEED IN BPS MOVEI A,DEFOSP ; UNKNOWN, USE DEFAULT IDIVI A,10. ; CONVERT TO CPS FSC A,233 ; FLOAT IT MOVE B,A FDVR B,[-3200.0] ; .3*(OSPEED/960.) FADR B,[.55] ; 1.0 - (.45 + .3*(OSPEED/960.)) FDVR A,B ; OSPEED/(1.0 - (.45 + .3*(OSPEED/960.))) MOVEM A,C1PADF ; SAVE FOR USE JRST POPBAJ CPINVI: SAVE A MOVEI A,"D CALL OUTESC JRST POPAJ CPINVC: SAVE A MOVEI A,"d CALL OUTESC JRST POPAJ ] ;C100 IFN VC404,[ SUBTTL VC404 VC44TB: 24.,,79. ;DISPATCH VECTOR FOR VC404 (%TOERS+%TOMVB+%TOMVU+%TOLWR) ;CANT EVEN DISPLAY LOWERCASE CALL VCCPS CALL VCCEOL CALL VCCEOS CALL VCCLRS JFCL CALL VCDSMV CALL VCDMV1 REPEAT 11.,JFCL VCCPS: JUMPE B,[MOVEI A,^Y ;HOME IS EASY JRST VCEOS2] ;WELL, AS EASY AS ANYTHING ELSE MOVEI A,^P PBOUT HLRZ A,B ADDI A,40 PBOUT MOVEI A,40(B) PBOUT RET VCCLRS: MOVEI A,^X ;HOME JRST VCEOS2 ;WITH FILL VCCEOS: MOVEI A,^W ;CLEAR EOS VCEOS2: PBOUT VCFILL: SETZ A, ;NEEDS 4 NULLS (CANT BE RUBOUTS CAUSE SENT IN MIDDLE REPEAT 2,PBOUT ;OF THE CURSOR ADDRESSING) RET VCCEOL: MOVEI A,^V JRST VCEOS2 VCDSMV: SAVE B MOVEI A,40(BP) LSH A,16.+4 TLO A,(.BYTE 8 ? ^P ? 0) IOR A,[.BYTE 8 ? 0 ? 0 ? 40 ? ^V] SKIPE DISCPH ;ANY HPOS? JRST VCDSM2 ;YES MOVEM A,DISBF1+3 SETZM DISBF1+4 JRST POPBJ VCDSM2: MOVEM A,DISBF1+1 SETZM DISBF1+2 VCDSM3: MOVE B,DISCPH ;GET HPOS ADDI B,40 LSH B,8+4 TDZN A,[.BYTE 8 ? 0 ? 0 ? 377] IOR A,B MOVEM A,DISBF1+4 SETZM DISBF1+5 JRST POPBJ VCDMV1: SAVE B MOVEI A,40(BP) LSH A,16.+4 TLO A,(.BYTE 8 ? ^P ? 0) JRST VCDSM3 ] ;IFN VC404 IFN CNCPT,[ SUBTTL CN/CP TERMINAL (INFOTON 130) CNCPTB: 24.,,79. (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOCID+%TOLID) CALL CNCPS CALL CNCEOL CALL CNCEOS CALL CNCLRS JFCL CALL CNDSMV CALL CNDMV1 CALL CNINSL CALL CNDELL CALL CNINSC CALL CNDELC REPEAT 7,JFCL CNCPS: JUMPE B,[MOVEI A,"H JRST OUTESC] MOVEI A,"Y CALL OUTESC HLRZ A,B ; VERTICAL POS CALL CNPAR HRRZ A,B JRST CNPAR CNPAR: SAVE B IDIVI A,16. CAIL A,10. ADDI A,7 ;A HEX DIGIT OF 10. SHOULD BE "A, NOT "9+1. ADDI A,"0 PBOUT CAIL B,10. ADDI B,7 ;A HEX DIGIT OF 10. SHOULD BE "A, NOT "9+1. MOVEI A,"0(B) PBOUT JRST POPBJ CNCEOL: MOVEI A,"K JRST OUTESC CNCEOS: MOVEI A,"J JRST OUTESC CNCLRS: MOVEI A,14 PBOUT RET CNDSMV: MOVEI C,5 ; INDEX INTO DISBF1 MOVE A,[.BYTE 8 ? 33 ? "K ] MOVEM A,DISBF1(C) SOS C JRST CNDMV3 ; ENTER REST OF CODE CNDMV1: MOVEI C,5 ; INDEX INTO DISBF1 CNDMV3: MOVE A,DISCPH IDIVI A,16. CAIL A,10. ADDI A,7 ;A HEX DIGIT OF 10. SHOULD BE "A, NOT "9+1. LSH A,8 CAIL B,10. ADDI B,7 ADDI A,(B) LSH A,16.+4 ADD A,[.BYTE 8 ? "0 ? "0 ] MOVEM A,DISBF1(C) SOS C CNDSM2: MOVEI A,(BP) IDIVI A,16. CAIL A,10. ADDI A,7 LSH A,8 CAIL B,10. ADDI B,7 ADDI A,(B) LSH A,4 ADD A,[.BYTE 8 ? 33 ? "Y ? "0 ? "0 ] MOVEM A,DISBF1(C) RET CNINSL: HRLZ B,BP ;GET TARGET LINE PUSHJ P,CNCPS ;POSTION CURSOR TO IT CNINS1: MOVEI A,"L CALL OUTESC PUSHJ P,CNPAD ;PAD THE INSERT SOJG Q,CNINS1 ;AND LOOP IF MORE TO DO RET CNDELL: HRLZ B,BP ;GET TARGET LINE PUSHJ P,CNCPS ;POSITION CURSOR TO IT CNDEL1: MOVEI A,"M ;HAVE TO SWITCH MODES AND BACK CALL OUTESC PUSHJ P,CNPAD ;PAD FOR THE DELETION SOJG Q,CNDEL1 ;AND LOOP IF MORE TO DO RET ;PAD 16 MSEC CNPAD: MOVEI A,16. JRST TIMPAD CNINSC: HRROI A,[ASCIZ /E /] ;ALTMODE E SPACE BACKSPACE. PSOUT SOJG Q,CNINSC RET CNDELC: MOVEI A,"F CALL OUTESC SOJG Q,CNDELC RET ] ;IFN CNCPT IFN TVI912,[ SUBTTL TVI-912/920 TVITB: 24.,,79. (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOCID) ;No %TOLID since too slow. CALL TVCPS CALL TVCEOL CALL TVCEOS CALL TVCLRS JFCL CALL TVDSMV CALL TVDMV1 CALL TVINSL CALL TVDELL CALL TVINSC CALL TVDELC REPEAT 7,JFCL TVCPS: JUMPE B,[MOVEI A,36 ;IF ADDRESS IS HOME, PBOUT ; SEND ^^ RET] MOVEI A,"= CALL OUTESC HLRZ A,B ADDI A,40 PBOUT MOVEI A,40(B) PBOUT JRST TVPAD2 TVCEOL: MOVEI A,"t JRST OUTESC TVCEOS: MOVEI A,"y CALL OUTESC PUSH P,B CALL TVPAD2 JRST POPBJ TVCLRS: MOVEI A,"* CALL OUTESC ;PAD 1/10 SECOND. TVPAD2: MOVEI A,100. JRST TIMPAD TVINSL: HRLZ B,BP ;GET TO LINE CALL TVCPS TVINS1: MOVEI A,"E CALL OUTESC CALL TVPAD SOJG Q,TVINS1 RET TVDELL: HRLZ B,BP ;GET TO LINE CALL TVCPS TVDEL1: MOVEI A,"R CALL OUTESC CALL TVPAD SOJG Q,TVDEL1 RET TVDELC: MOVEI A,"W CALL OUTESC SOJG Q,TVDELC RET TVINSC: MOVEI A,"Q CALL OUTESC SOJG Q,TVINSC RET TVDSMV: SAVE B MOVEI A,40(BP) LSH A,8+4 IOR A,[.BYTE 8 ? 33 ? "= ? 40 ? 40] MOVEM A,DISBF1+0 MOVE A,[.BYTE 8 ? 177 ? 177 ? 177 ? 177] MOVEM A,DISBF1+1 MOVE B,[.BYTE 8 ? 33 ? "t ? 177 ? 177] MOVEM B,DISBF1+2 MOVE B,[.BYTE 8 ? 177 ? 177 ? 177 ? 177] MOVEM B,DISBF1+3 SKIPE B,DISCPH CALL TVDMV1 JRST POPBJ TVDMV1: MOVEI A,(BP) LSH A,8 IOR A,DISCPH LSH A,4 ADD A,[.BYTE 8 ? 33 ? "= ? 40 ? 40] MOVEM A,DISBF1+4 MOVE A,[.BYTE 8 ? 177 ? 177 ? 177 ? 177] MOVEM A,DISBF1+5 RET ;PAD FOR 1/2 SECOND. TVPAD: MOVEI A,500. JRST TIMPAD ] ;TVI912 IFN ADM3A,[ SUBTTL ADM3 ADM3TB: 24.,,79. ; DISPATCH TABLE FOR ADM3 (%TOMVB+%TOMVU+%TOLWR) CALL A3CPS CALL EOLSIM CALL EOLSIM CALL A3CLRS JFCL .VALUE CALL A3DMV1 REPEAT 11.,JFCL ; A3CPS - OUTPUT ADM3 CURSOR POSITIONING COMMANDS TO THE TERMINAL. ; ARGUMENT: ; B LINE,,COLUMN A3CPS: JUMPE B,[MOVEI A,^^ ; SIMPLE HOME? PBOUT ; YES, GO HOME INSTEAD RET] ; OF DIRECT CURSOR MOVE. MOVEI A,^[ ;] ; START SEQUENCE WITH "ESC" PBOUT ; AND AN MOVEI A,"= ; "=". PBOUT HLRZ A,B ; GET LINE # ADDI A,40 ; ADJUST IT PBOUT ; AND OUTPUT IT HRRZ A,B ; GET COL # ADDI A,40 ; ADJUST IT PBOUT ; AND OUTPUT THAT RET ; RETURN A3CLRS: MOVEI A,^Z ; THIS IS AN EASY ONE PBOUT RET ; RETURN ; A3DSM1 - SUPPOSED TO CALCULATE COMMANDS TO MOVE TO SPECIFIED POSITION ; AND STORE THEM IN DISBF1 AS CLOSE AS POSSIBLE TO DISBUF. ; ARGUMENTS: ; BP LINE # ; DISCPH COLUMN # A3DMV1: MOVEI A,(BP) ; GET LINE # LSH A,8. ; MOVE IT A BYTE IOR A,DISCPH ; OR IN COLUMN # LSH A,4 ; POSITION THEM ADD A,[.BYTE 8 ? ^[ ? "= ? 40 ? 40] ; ADD CONTROLS ;] MOVEM A,DISBF1+5 ; AND STORE IT RET ; RETURN ] ; IFN ADM3A IFN ADM42\IQ120,[ IQ12TB: 24.,,79. ;DISPATCH VECTOR FOR SOROC IQ120. (%TOERS+%TOMVB+%TOMVU+%TOLWR) CALL A42CPS CALL A42EOL CALL A42EOS CALL A42CLR JFCL CALL A42DMV CALL A42DM1 REPEAT 11.,JFCL ADM42T: 24.,,79. ;DISPATCH VECTOR FOR ADM 42 (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID) CALL A42CPS CALL A42EOL CALL A42EOS CALL A42CLR JFCL CALL A42DMV CALL A42DM1 CALL A42INL CALL A42DLL CALL A42INC CALL A42DLC CALL A42RST JFCL JFCL CALL A42INI CALL A42RST REPEAT 2,JFCL A42CPS: JUMPE B,[MOVEI A,^^ ;HOME IS EASY PBOUT RET] MOVEI A,"= ;ELSE SEND = CALL OUTESC HLRZ A,B ADDI A,40 ;+40 PBOUT MOVEI A,40(B) ;+40 PBOUT RET A42EOL: MOVEI A,"T JRST OUTESC A42EOS: MOVEI A,"Y JRST OUTESC A42CLR: MOVEI A,"+ ;CLEAR ALL TO SPACES. JRST OUTESC A42DMV: SAVE B MOVEI B,40(BP) LSH B,24.+4 IOR B,[.BYTE 8 ? 0 ? 40 ? 33 ? "T] MOVE A,[.BYTE 8 ? 0 ? 0 ? 33 ? "=] SKIPE DISCPH ;DESIRED HPOS = 0? JRST A42DM2 ;NO, MUST GO THERE AFTERWARDS MOVEM A,DISBF1+4 ;JUST $= ? $T MOVEM B,DISBF1+5 JRST POPBJ A42DM2: MOVEM A,DISBF1+3 ;NEED HPOS TOO, USE $= ? $T ? ... MOVEM B,DISBF1+4 CALL A42DM1 JRST POPBJ A42DM1: MOVEI A,(BP) ;DESIRED VPOS LSH A,8 IOR A,DISCPH LSH A,4 ADD A,[.BYTE 8 ? 33 ? "= ? 40 ? 40] MOVEM A,DISBF1+5 ;$= RET A42INL: SKIPA A,["E] ;$E - INSERT LINE A42DLL: MOVEI A,"R ;$R - DELETE LINE SAVE A MOVEI A,"= CALL OUTESC MOVEI A,40(BP) PBOUT MOVEI A,40 PBOUT REST A ;GET DESIRED FUNCTION AGAIN A42IN1: CALL OUTESC SAVE A MOVE A,NVLNS ;PADDING IS 3 MSEC PER LINE MOVED. SUB A,BP ;COMPUTE NUMBER OF LINES MOVED. IMULI A,3 CALL TIMPAD ;PAD THAT LONG. REST A SOJG Q,A42IN1 ;DO THIS FOR HOWEVER MANY LINES TO INSERT OR DELETE. RET A42DLC: MOVEI A,"W CALL OUTESC SOJG Q,A42DLC RET A42INC: MOVEI A,"Q CALL OUTESC SOJG Q,A42INC RET A42RST: RET A42INI: MOVEI A,"Z JRST OUTESC ] ;END ADM42 SUBTTL NIH5200 IFN NIH5200,[ NH52TB: 2000+27.,,79. (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID) CALL NHCPS CALL NHCEOL CALL NHCEOL ; CLOSEST WE CAN COME CALL NHCLRS JFCL CALL NHDSMV CALL NHDMV1 CALL NHINSL CALL NHDELL CALL NHINSC CALL NHDELC REPEAT 7,JFCL NHCPS: JUMPE B,NHOME MOVEI A,^A ; ELSE ^A PBOUT HRRZ A,B XORI A,177 PBOUT HLRZ A,B XORI A,177 NHPBR: PBOUT RET NHOME: HRROI A,[ASCIZ /Q/] PSOUT RET NHCEOL: HRROI A,[ASCIZ /U/] NHPSDL: PSOUT JRST NHMPAD NHCLRS: HRROI A,[ASCIZ /Re /] PSOUT CALL NHMPAD JRST NHOME NHINSL: HRLZ B,BP CALL NHCPS NHINL1: HRROI A,[ASCIZ /M/] PSOUT SOJG Q,NHINL1 RET NHDELL: HRLZ B,BP CALL NHCPS NHDEL1: HRROI A,[ASCIZ /L/] CALL NHPSDL SOJG Q,NHDEL1 RET NHMPAD: SAVE A SAVE B MOVEI A,<80.*1440.+2850.>/1000. SETZM PADCHR CALL TIMPAD JRST POPBAJ NHDSMV: SAVE B MOVE B,[441000,,DISBF1] CALL NHDSM1 MOVEI A,^N IDPB A,B MOVEI A,"U IDPB A,B JRST POPBJ NHDSM1: MOVEI A,^A IDPB A,B HRRZ A,DISCPH XORI A,177 IDPB A,B HRRZ A,BP XORI A,177 IDPB A,B RET NHDMV1: SAVE B MOVE B,[441000,,DISBF1+4] CALL NHDSM1 SETZ A, IDPB A,B IDPB A,B JRST POPBJ NHINSC: HRROI A,[ASCIZ /Y/] PSOUT SAVE Q NHINC1: MOVEI A,40 ; SPACE PBOUT SOJG Q,NHINC1 REST Q NHINC2: MOVEI A,^H PBOUT SOJG Q,NHINC2 MOVEI A,^R JRST NHPBR NHDELC: HRROI A,[ASCIZ /V/] PSOUT SOJG Q,NHDELC RET ] ; NIH5200 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 HRRZ A,INTPC1 CAIN A,WAITX ;NOT INPUT IF RUNNING INFERIOR JRST TSINT7 IFN COMNDF,[ 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 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 CAIN A,TYIIOT MOVEM CH,INTPC1 ;DONT GET HUNG UP ON READING FROM TTY SKIPN RREBEG ;RETURN IF FROM ^R JRST TSIL CAIN A,WAITX ;RUNNING AN INFERIOR? JRST [ SETZM STOPF ;DON'T QUIT OUT OF FZ MOVEM A,INTPC1 ;SAVE RETURN PC MOVEI A,^G ;RING CHIMES PBOUT MOVE A,INTACS+A ;GET FORK HANDLE FFORK ;FREEZE IT JRST TSIL] ;DEBRK TO PROCESS TERMINATION CODE 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 CALL .EXIT 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 HRRZ B,TTLPOS ;LET MONITOR KNOW WHERE WE ARE ON THE LINE SFPOS ] IFN 10X,[CALL ECHOCR ;CANNOT TELL MONITOR POSITION, SO GO TO BOL TRON B,100 ;ABOUT RESTORING ASCII DATA MODE SFMOD MOVEI A,.FHJOB SETO B, ;AND JOB TERMINAL INTERRUPT MASK STIW ] MOVEI B,BEG .SEE CIRC HALTF ;STOP HERE 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 TRZE B,TT%PGM\TT%DAM ;MAKE SURE PAGE MODE TURNED OFF SKIPN RGETTY ;ON DISPLAYS JRST DOSTIW SFMOD STPAR DOSTIW: MOVEI A,.FHSLF RPCAP JUMPGE C,CPOPJ ;NO ^C CAPABILITY MOVEI A,.FHJOB ;RESTORE INTERRUPT MASKS IFN 10X,TLO A,400000 MOVE B,[042000,,000020] ;^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,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. 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 TNX,MOVE C,A IFN TNX,CALL .ST26B IFN ITS,MOVE A,(A) 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 MOVE E,DEFDEV CALL SIXNTY ;OUTPUT DEVICE NAME MOVEI CH,": XCT LISTF5 MOVE E,DEFDIR CALL SIXNTY ;AND THE SNAME MOVEI CH,"; XCT LISTF5 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 ] IFN 10X,[ 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: SYSCAL OPEN,[[.BAI,,CHRAND] ? DEFDEV ? ['.FILE.] ? [SIXBIT/(DIR)/] ? DEFDIR] 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 PUSH P,B SETZM PTLFCD PUSHJ P,.FNPT2 POP P,A PUSHJ P,.FNPT2 JRST FORMF ] 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 [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. FLG DDEVICE,DEFDEV,FSSTRR ;DEFAULT DEVICE AND FILENAMES. FLG DDFAST,0,FSDDFS ;-1 IF DEFAULT DEVICE IS "FAST". FLG DFILE,0,FSDFILE ;DEFAULT FILE'S NAMES, AS STRING. FLG DFN1,DEFFN1,FSSTRR FLG DFN2,DEFFN2,FSSTRR FLG DFORCE, ;NOT 0 => FINISH DISPLAY DESPITE PENDING INPUT, DON'T UPDATE MODE LINE. FLG DSNAME,DEFDIR,FSDSNM FLG DVERSI,DEFFN3,FSDVER ;DEFAULT FN2 AS NUMBER < AND > SPECIAL 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. 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. FLG IFDEVI,ERDEV,FSSTRR ;DEVICE NOW READING FROM. IFN ITS,FLG IFDUMP,CHFILI,FSDUMP ;FILE HAS BEEN DUMPED BIT. IFN TNX,FLG IFFDB,CHFILI,FSIFDB ;READ OR MODIFY FILE DESCRIPTOR BLOCK FLG IFFN1,,FSSTRR ;FN1 OF FILE NOW OPEN FOR READING. FLG IFFN2,,FSSTRR ;FN2 OF FILE NOW OPEN FOR READING. FLG IFILE,0,FSIFILE ;FILENAMES OF FILE NOW READING , AS STRING. FLG IFLENG,0,FSIFLEN ;(R-O) LENGTH OF INPUT FILE. FLG IFMTAP,CHFILI,FSMTAP ;DO .MTAPE ON INPUT FILE. IFN ITS,FLG IFREAP,CHFILI,FSREAP ;DON'T REAP BIT. FLG IFSNAM,,FSSTRR ;SNAME OF FILE NOW READING FROM. FLG IFVERS,,FSFVER ;VERSION OF FILE OPEN FOR READING. 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 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 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 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) 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. FLG OFVERS,,FSFVER ;VERSION LAST OUTPUT FILE 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,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 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 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 ;WHETHER OR NOT TO FLUSH HIGH ORDER BIT FLG TTYINI,0,FSTTYI ;RE-INIT THE VARS RELATING TO TYPE OF TTY. FLG TTYMAC,TTYMAC ;MACRO FOR FS TTY INIT$ TO CALL. 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 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. 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,FSGTNM 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 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 ^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 *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 VARIABLES IFN .&1777, .ERR VARIABLES! HIMPUR:: ;IF ^R VARIABLES DON'T FIT IN LOW IMPURE, PUT THEM HERE. IFG +RRVARL-1777, RRVARB:: BLOCK RRVARL ;^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